diff --git a/.docker/debian/lean/Dockerfile b/.docker/debian/lean/Dockerfile index e43de629063d2..c04ea2ba15661 100644 --- a/.docker/debian/lean/Dockerfile +++ b/.docker/debian/lean/Dockerfile @@ -26,7 +26,10 @@ RUN python3 -m pip install --user mathlibtools # now install `pyinstaller`, and run it on the installed copy of `leanproject` RUN python3 -m pip install --user pyinstaller WORKDIR /home/lean/.local/bin -RUN pyinstaller --onefile --noconfirm leanproject +# We need the `--hidden-import` flag here due to PyInstaller not knowing the dependencies +# of PyNaCl (https://github.com/pyinstaller/pyinstaller/issues/3525), which is itself a transitive +# dependency of mathlibtools via PyGithub. +RUN pyinstaller --onefile --noconfirm --hidden-import _cffi_backend leanproject # this has created `/home/lean/.local/bin/dist/leanproject`, # which we'll now copy to a fresh container diff --git a/.github/CODEOWNERS b/.github/CODEOWNERS new file mode 100644 index 0000000000000..07aee9c516613 --- /dev/null +++ b/.github/CODEOWNERS @@ -0,0 +1,19 @@ +# By default, the mathlib maintainers own everything in the repo. +# Later matches will take precedence over this match. + +# Disabled until we have better coverage by other patterns. Reenable in the future. +# * @leanprover-community/mathlib-maintainers + +src/category_theory/ @leanprover-community/mathlib-CT + +src/measure_theory/ @leanprover-community/mathlib-meas + +src/algebraic_topology/ @leanprover-community/mathlib-CT # for now the category theory team can take care of this + +src/algebraic_geometry/ @leanprover-community/mathlib-AG + +src/combinatorics/ @leanprover-community/mathlib-CO + +src/probability/ @leanprover-community/mathlib-PR + +src/tactic/ @leanprover-community/mathlib-meta diff --git a/.github/workflows/add_port_comment.yml b/.github/workflows/add_port_comment.yml new file mode 100644 index 0000000000000..d00eabc7f42d0 --- /dev/null +++ b/.github/workflows/add_port_comment.yml @@ -0,0 +1,51 @@ +name: Add mathlib4 porting comments + +on: + schedule: + - cron: "0 0 * * *" + workflow_dispatch: + +jobs: + build: + name: Update comments + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + + - name: install Python + uses: actions/setup-python@v4 + with: + python-version: 3.8 + + - name: install latest mathlibtools + run: | + pip install git+https://github.com/leanprover-community/mathlib-tools + + # multiline outputs are only supported in javascript + - name: update docstrings and generate message + uses: actions/github-script@v5 + id: generate-message + with: + script: | + proc = await exec.getExecOutput("python", ["./scripts/add_port_comments.py"]); + console.log(proc.stdout); + core.setOutput("FILE_LIST", proc.stdout); + + - name: Create Pull Request + uses: peter-evans/create-pull-request@v4 + with: + base: master + commit-message: "chore(*): add mathlib4 synchronization comments" + title: "chore(*): add mathlib4 synchronization comments" + author: leanprover-community-bot + body: | + Regenerated from the [port status wiki page](https://github.com/leanprover-community/mathlib/wiki/mathlib4-port-status). + Relates to the following files: + ${{ steps.generate-message.outputs.FILE_LIST }} + + --- + I am a bot; please check that I have not put a comment in a bad place before running `bors merge`! + labels: | + easy + awaiting-review + mathlib4-synchronization diff --git a/.github/workflows/add_ported_warnings.yml b/.github/workflows/add_ported_warnings.yml new file mode 100644 index 0000000000000..689dd520f3ac4 --- /dev/null +++ b/.github/workflows/add_ported_warnings.yml @@ -0,0 +1,54 @@ +name: Add mathlib4 porting warnings + +on: + pull_request: + +jobs: + build: + name: Check for modifications to ported files + runs-on: ubuntu-latest + steps: + - uses: actions/checkout@v3 + + - name: install Python + uses: actions/setup-python@v4 + with: + python-version: 3.8 + + - name: install latest mathlibtools + run: | + pip install git+https://github.com/leanprover-community/mathlib-tools + + # TODO: is this really faster than just calling git from python? + - name: Get changed files + id: changed-files + uses: Ana06/get-changed-files@v2.2.0 + + - name: run the script + id: script + run: | + python scripts/detect_ported_files.py ${{ steps.changed-files.outputs.all }} + + - id: PR + uses: 8BitJonny/gh-get-current-pr@2.2.0 + # TODO: this may not work properly if the same commit is pushed to multiple branches: + # https://github.com/8BitJonny/gh-get-current-pr/issues/8 + with: + github-token: ${{ secrets.GITHUB_TOKEN }} + sha: ${{ github.event.pull_request.head.sha }} + # Only return if PR is still open + filterOutClosed: true + + - if: steps.script.outputs.modifies_ported == 'True' + id: add_label + name: add "modifies-synchronized-file" + # we use curl rather than octokit/request-action so that the job won't fail + # (and send an annoying email) if the labels don't exist + run: | + curl -L \ + -X POST \ + -H "Accept: application/vnd.github+json" \ + -H "Authorization: Bearer ${{ secrets.GITHUB_TOKEN }}"\ + -H "X-GitHub-Api-Version: 2022-11-28" \ + https://api.github.com/repos/${{ github.repository }}/issues/${{ steps.PR.outputs.number }}/labels \ + -d '{"labels":["modifies-synchronized-file"]}' diff --git a/.github/workflows/bors.yml b/.github/workflows/bors.yml index 5a2e9fed9d73d..15b70725de7a1 100644 --- a/.github/workflows/bors.yml +++ b/.github/workflows/bors.yml @@ -22,7 +22,7 @@ jobs: runs-on: ubuntu-latest # timeout-minutes: 3 steps: - - uses: styfle/cancel-workflow-action@0.9.0 + - uses: styfle/cancel-workflow-action@0.11.0 with: all_but_latest: true access_token: ${{ github.token }} @@ -32,18 +32,28 @@ jobs: name: Lint style runs-on: bors steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 + + - name: Install bibtool + if: ${{ 'bors' == 'ubuntu-latest' }} + run: | + sudo apt-get update + sudo apt-get install -y bibtool - name: install Python if: ${{ 'bors' == 'ubuntu-latest' }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: 3.8 - - name: lint + - name: lint style run: | ./scripts/lint-style.sh + - name: lint references.bib + run: | + ./scripts/lint-bib.sh + build: if: github.repository == 'leanprover-community/mathlib' name: Build mathlib @@ -54,7 +64,7 @@ jobs: outputs: artifact_name: ${{ steps.setup_precompiled.outputs.artifact_name }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: fetch-depth: ${{ env.GIT_HISTORY_DEPTH }} @@ -68,7 +78,7 @@ jobs: - name: install Python if: ${{ ! 1 }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 @@ -78,10 +88,11 @@ jobs: - name: leanpkg build id: build run: | + set -o pipefail leanpkg configure - echo "::set-output name=started::true" - lean --json -T100000 --make src | python3 scripts/detect_errors.py + echo "started=true" >> $GITHUB_OUTPUT lean --json -T100000 --make src | python3 scripts/detect_errors.py + lean --json -T400000 --make src | python3 scripts/detect_errors.py - name: push release to azure if: always() && github.repository == 'leanprover-community/mathlib' && steps.build.outputs.started == 'true' @@ -100,7 +111,7 @@ jobs: touch workspace.tar tar -cf workspace.tar --exclude=*.tar* . git_hash="$(git log -1 --pretty=format:%h)" - echo "::set-output name=artifact_name::precompiled-mathlib-$short_lean_version-$git_hash" + echo "artifact_name=precompiled-mathlib-$short_lean_version-$git_hash" >> $GITHUB_OUTPUT - name: upload precompiled mathlib zip file if: always() && steps.build.outputs.started == 'true' @@ -132,7 +143,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -169,7 +180,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -185,19 +196,32 @@ jobs: - name: install Python if: ${{ ! 1 }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 - name: install Python dependencies if: ${{ ! 1 }} - run: python3 -m pip install --upgrade pip pyyaml + run: python3 -m pip install --upgrade pip pyyaml requests mathlibtools - name: tests run: | set -o pipefail lean --json -T100000 --make docs archive roadmap test counterexamples | python3 scripts/detect_errors.py + - name: check archive and counterexample directories have unique identifiers + run: | + pip install mathlibtools + (cd archive && python -m mathlibtools.leanproject mk-all && mv all.lean archive_all.lean) + (cd counterexamples && python -m mathlibtools.leanproject mk-all && mv all.lean counterexamples_all.lean) + python -m mathlibtools.leanproject mk-all + echo "import all" >> all_all.lean + echo "import counterexamples_all" >> all_all.lean + echo "import archive_all" >> all_all.lean + echo "path ./archive" >> leanpkg.path + echo "path ./counterexamples" >> leanpkg.path + lean --json -T100000 --make all_all.lean | python3 scripts/detect_errors.py + - uses: actions/setup-java@v2 if: ${{ ! 1 }} with: @@ -233,10 +257,10 @@ jobs: needs: [style_lint, build, lint, tests] runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - id: PR - uses: 8BitJonny/gh-get-current-pr@1.2.0 + uses: 8BitJonny/gh-get-current-pr@2.2.0 # TODO: this may not work properly if the same commit is pushed to multiple branches: # https://github.com/8BitJonny/gh-get-current-pr/issues/8 with: diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 7914e3a217905..34f6945efa691 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -30,7 +30,7 @@ jobs: runs-on: ubuntu-latest # timeout-minutes: 3 steps: - - uses: styfle/cancel-workflow-action@0.9.0 + - uses: styfle/cancel-workflow-action@0.11.0 with: all_but_latest: true access_token: ${{ github.token }} @@ -40,18 +40,28 @@ jobs: name: Lint style runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 + + - name: Install bibtool + if: ${{ 'ubuntu-latest' == 'ubuntu-latest' }} + run: | + sudo apt-get update + sudo apt-get install -y bibtool - name: install Python if: ${{ 'ubuntu-latest' == 'ubuntu-latest' }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: 3.8 - - name: lint + - name: lint style run: | ./scripts/lint-style.sh + - name: lint references.bib + run: | + ./scripts/lint-bib.sh + build: if: github.repository == 'leanprover-community/mathlib' name: Build mathlib @@ -62,7 +72,7 @@ jobs: outputs: artifact_name: ${{ steps.setup_precompiled.outputs.artifact_name }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: fetch-depth: ${{ env.GIT_HISTORY_DEPTH }} @@ -76,7 +86,7 @@ jobs: - name: install Python if: ${{ ! 1 }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 @@ -86,10 +96,11 @@ jobs: - name: leanpkg build id: build run: | + set -o pipefail leanpkg configure - echo "::set-output name=started::true" - lean --json -T100000 --make src | python3 scripts/detect_errors.py + echo "started=true" >> $GITHUB_OUTPUT lean --json -T100000 --make src | python3 scripts/detect_errors.py + lean --json -T400000 --make src | python3 scripts/detect_errors.py - name: push release to azure if: always() && github.repository == 'leanprover-community/mathlib' && steps.build.outputs.started == 'true' @@ -108,7 +119,7 @@ jobs: touch workspace.tar tar -cf workspace.tar --exclude=*.tar* . git_hash="$(git log -1 --pretty=format:%h)" - echo "::set-output name=artifact_name::precompiled-mathlib-$short_lean_version-$git_hash" + echo "artifact_name=precompiled-mathlib-$short_lean_version-$git_hash" >> $GITHUB_OUTPUT - name: upload precompiled mathlib zip file if: always() && steps.build.outputs.started == 'true' @@ -140,7 +151,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -177,7 +188,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -193,19 +204,32 @@ jobs: - name: install Python if: ${{ ! 1 }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 - name: install Python dependencies if: ${{ ! 1 }} - run: python3 -m pip install --upgrade pip pyyaml + run: python3 -m pip install --upgrade pip pyyaml requests mathlibtools - name: tests run: | set -o pipefail lean --json -T100000 --make docs archive roadmap test counterexamples | python3 scripts/detect_errors.py + - name: check archive and counterexample directories have unique identifiers + run: | + pip install mathlibtools + (cd archive && python -m mathlibtools.leanproject mk-all && mv all.lean archive_all.lean) + (cd counterexamples && python -m mathlibtools.leanproject mk-all && mv all.lean counterexamples_all.lean) + python -m mathlibtools.leanproject mk-all + echo "import all" >> all_all.lean + echo "import counterexamples_all" >> all_all.lean + echo "import archive_all" >> all_all.lean + echo "path ./archive" >> leanpkg.path + echo "path ./counterexamples" >> leanpkg.path + lean --json -T100000 --make all_all.lean | python3 scripts/detect_errors.py + - uses: actions/setup-java@v2 if: ${{ ! 1 }} with: @@ -241,10 +265,10 @@ jobs: needs: [style_lint, build, lint, tests] runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - id: PR - uses: 8BitJonny/gh-get-current-pr@1.2.0 + uses: 8BitJonny/gh-get-current-pr@2.2.0 # TODO: this may not work properly if the same commit is pushed to multiple branches: # https://github.com/8BitJonny/gh-get-current-pr/issues/8 with: diff --git a/.github/workflows/build.yml.in b/.github/workflows/build.yml.in index 4a28319cc146a..44b295b967665 100644 --- a/.github/workflows/build.yml.in +++ b/.github/workflows/build.yml.in @@ -8,7 +8,7 @@ jobs: runs-on: ubuntu-latest # timeout-minutes: 3 steps: - - uses: styfle/cancel-workflow-action@0.9.0 + - uses: styfle/cancel-workflow-action@0.11.0 with: all_but_latest: true access_token: ${{ github.token }} @@ -18,18 +18,28 @@ jobs: name: Lint styleJOB_NAME runs-on: STYLE_LINT_RUNNER steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 + + - name: Install bibtool + if: ${{ 'STYLE_LINT_RUNNER' == 'ubuntu-latest' }} + run: | + sudo apt-get update + sudo apt-get install -y bibtool - name: install Python if: ${{ 'STYLE_LINT_RUNNER' == 'ubuntu-latest' }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: 3.8 - - name: lint + - name: lint style run: | ./scripts/lint-style.sh + - name: lint references.bib + run: | + ./scripts/lint-bib.sh + build: if: github.repository MAIN_OR_FORK 'leanprover-community/mathlib' name: Build mathlibJOB_NAME @@ -40,7 +50,7 @@ jobs: outputs: artifact_name: ${{ steps.setup_precompiled.outputs.artifact_name }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: fetch-depth: ${{ env.GIT_HISTORY_DEPTH }} @@ -54,7 +64,7 @@ jobs: - name: install Python if: ${{ ! IS_SELF_HOSTED }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 @@ -64,10 +74,11 @@ jobs: - name: leanpkg build id: build run: | + set -o pipefail leanpkg configure - echo "::set-output name=started::true" - lean --json -T100000 --make src | python3 scripts/detect_errors.py + echo "started=true" >> $GITHUB_OUTPUT lean --json -T100000 --make src | python3 scripts/detect_errors.py + lean --json -T400000 --make src | python3 scripts/detect_errors.py - name: push release to azure if: always() && github.repository == 'leanprover-community/mathlib' && steps.build.outputs.started == 'true' @@ -86,7 +97,7 @@ jobs: touch workspace.tar tar -cf workspace.tar --exclude=*.tar* . git_hash="$(git log -1 --pretty=format:%h)" - echo "::set-output name=artifact_name::precompiled-mathlib-$short_lean_version-$git_hash" + echo "artifact_name=precompiled-mathlib-$short_lean_version-$git_hash" >> $GITHUB_OUTPUT - name: upload precompiled mathlib zip file if: always() && steps.build.outputs.started == 'true' @@ -118,7 +129,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -155,7 +166,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -171,19 +182,32 @@ jobs: - name: install Python if: ${{ ! IS_SELF_HOSTED }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 - name: install Python dependencies if: ${{ ! IS_SELF_HOSTED }} - run: python3 -m pip install --upgrade pip pyyaml + run: python3 -m pip install --upgrade pip pyyaml requests mathlibtools - name: tests run: | set -o pipefail lean --json -T100000 --make docs archive roadmap test counterexamples | python3 scripts/detect_errors.py + - name: check archive and counterexample directories have unique identifiers + run: | + pip install mathlibtools + (cd archive && python -m mathlibtools.leanproject mk-all && mv all.lean archive_all.lean) + (cd counterexamples && python -m mathlibtools.leanproject mk-all && mv all.lean counterexamples_all.lean) + python -m mathlibtools.leanproject mk-all + echo "import all" >> all_all.lean + echo "import counterexamples_all" >> all_all.lean + echo "import archive_all" >> all_all.lean + echo "path ./archive" >> leanpkg.path + echo "path ./counterexamples" >> leanpkg.path + lean --json -T100000 --make all_all.lean | python3 scripts/detect_errors.py + - uses: actions/setup-java@v2 if: ${{ ! IS_SELF_HOSTED }} with: @@ -219,10 +243,10 @@ jobs: needs: [style_lint, build, lint, tests] runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - id: PR - uses: 8BitJonny/gh-get-current-pr@1.2.0 + uses: 8BitJonny/gh-get-current-pr@2.2.0 # TODO: this may not work properly if the same commit is pushed to multiple branches: # https://github.com/8BitJonny/gh-get-current-pr/issues/8 with: diff --git a/.github/workflows/build_fork.yml b/.github/workflows/build_fork.yml index 07e788387667d..ecc2a12a2f0fd 100644 --- a/.github/workflows/build_fork.yml +++ b/.github/workflows/build_fork.yml @@ -28,7 +28,7 @@ jobs: runs-on: ubuntu-latest # timeout-minutes: 3 steps: - - uses: styfle/cancel-workflow-action@0.9.0 + - uses: styfle/cancel-workflow-action@0.11.0 with: all_but_latest: true access_token: ${{ github.token }} @@ -38,18 +38,28 @@ jobs: name: Lint style (fork) runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 + + - name: Install bibtool + if: ${{ 'ubuntu-latest' == 'ubuntu-latest' }} + run: | + sudo apt-get update + sudo apt-get install -y bibtool - name: install Python if: ${{ 'ubuntu-latest' == 'ubuntu-latest' }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: 3.8 - - name: lint + - name: lint style run: | ./scripts/lint-style.sh + - name: lint references.bib + run: | + ./scripts/lint-bib.sh + build: if: github.repository != 'leanprover-community/mathlib' name: Build mathlib (fork) @@ -60,7 +70,7 @@ jobs: outputs: artifact_name: ${{ steps.setup_precompiled.outputs.artifact_name }} steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 with: fetch-depth: ${{ env.GIT_HISTORY_DEPTH }} @@ -74,7 +84,7 @@ jobs: - name: install Python if: ${{ ! 0 }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 @@ -84,10 +94,11 @@ jobs: - name: leanpkg build id: build run: | + set -o pipefail leanpkg configure - echo "::set-output name=started::true" - lean --json -T100000 --make src | python3 scripts/detect_errors.py + echo "started=true" >> $GITHUB_OUTPUT lean --json -T100000 --make src | python3 scripts/detect_errors.py + lean --json -T400000 --make src | python3 scripts/detect_errors.py - name: push release to azure if: always() && github.repository == 'leanprover-community/mathlib' && steps.build.outputs.started == 'true' @@ -106,7 +117,7 @@ jobs: touch workspace.tar tar -cf workspace.tar --exclude=*.tar* . git_hash="$(git log -1 --pretty=format:%h)" - echo "::set-output name=artifact_name::precompiled-mathlib-$short_lean_version-$git_hash" + echo "artifact_name=precompiled-mathlib-$short_lean_version-$git_hash" >> $GITHUB_OUTPUT - name: upload precompiled mathlib zip file if: always() && steps.build.outputs.started == 'true' @@ -138,7 +149,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -175,7 +186,7 @@ jobs: run: rm -rf ./* ./.??* - name: retrieve build - uses: actions/download-artifact@v2 + uses: actions/download-artifact@v3 with: name: ${{ needs.build.outputs.artifact_name }} @@ -191,19 +202,32 @@ jobs: - name: install Python if: ${{ ! 0 }} - uses: actions/setup-python@v1 + uses: actions/setup-python@v4 with: python-version: 3.8 - name: install Python dependencies if: ${{ ! 0 }} - run: python3 -m pip install --upgrade pip pyyaml + run: python3 -m pip install --upgrade pip pyyaml requests mathlibtools - name: tests run: | set -o pipefail lean --json -T100000 --make docs archive roadmap test counterexamples | python3 scripts/detect_errors.py + - name: check archive and counterexample directories have unique identifiers + run: | + pip install mathlibtools + (cd archive && python -m mathlibtools.leanproject mk-all && mv all.lean archive_all.lean) + (cd counterexamples && python -m mathlibtools.leanproject mk-all && mv all.lean counterexamples_all.lean) + python -m mathlibtools.leanproject mk-all + echo "import all" >> all_all.lean + echo "import counterexamples_all" >> all_all.lean + echo "import archive_all" >> all_all.lean + echo "path ./archive" >> leanpkg.path + echo "path ./counterexamples" >> leanpkg.path + lean --json -T100000 --make all_all.lean | python3 scripts/detect_errors.py + - uses: actions/setup-java@v2 if: ${{ ! 0 }} with: @@ -239,10 +263,10 @@ jobs: needs: [style_lint, build, lint, tests] runs-on: ubuntu-latest steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - id: PR - uses: 8BitJonny/gh-get-current-pr@1.2.0 + uses: 8BitJonny/gh-get-current-pr@2.2.0 # TODO: this may not work properly if the same commit is pushed to multiple branches: # https://github.com/8BitJonny/gh-get-current-pr/issues/8 with: diff --git a/.github/workflows/dependent-issues.yml b/.github/workflows/dependent-issues.yml index 0efb065dc44c4..682c5311f52b0 100644 --- a/.github/workflows/dependent-issues.yml +++ b/.github/workflows/dependent-issues.yml @@ -10,7 +10,7 @@ jobs: runs-on: ubuntu-latest # timeout-minutes: 3 steps: - - uses: styfle/cancel-workflow-action@0.9.0 + - uses: styfle/cancel-workflow-action@0.11.0 with: all_but_latest: true access_token: ${{ github.token }} diff --git a/.github/workflows/lint_self_test.yml b/.github/workflows/lint_self_test.yml index fdbe6c5be4988..235bf36b45a96 100644 --- a/.github/workflows/lint_self_test.yml +++ b/.github/workflows/lint_self_test.yml @@ -26,9 +26,9 @@ jobs: - name: 3.8 - name: 3.9 steps: - - uses: actions/checkout@v2 + - uses: actions/checkout@v3 - name: Set up Python ${{ matrix.python-version.name }} - uses: actions/setup-python@v2 + uses: actions/setup-python@v4 with: python-version: ${{ matrix.python-version.name }} diff --git a/.github/workflows/maintainer_merge_comment.yml b/.github/workflows/maintainer_merge_comment.yml new file mode 100644 index 0000000000000..d691f2841e484 --- /dev/null +++ b/.github/workflows/maintainer_merge_comment.yml @@ -0,0 +1,42 @@ +name: Maintainer merge (comment) + +on: + issue_comment: + types: [created, edited] + +jobs: + ping_zulip: + name: Ping maintainers on Zulip + if: (github.event.issue.pull_request != 'null') && (startsWith(github.event.comment.body, 'maintainer merge') || contains(toJSON(github.event.comment.body), '\r\nmaintainer merge')) + runs-on: ubuntu-latest + steps: + - name: Check whether user is part of mathlib-reviewers team + uses: TheModdingInquisition/actions-team-membership@v1.0 + with: + organization: 'leanprover-community' + team: 'mathlib-reviewers' # required. The team to check for + token: ${{ secrets.MATHLIB_REVIEWERS_TEAM_KEY }} # required. Personal Access Token with the `read:org` permission + comment: 'You seem to not be authorized' # optional. A comment to post if the user is not part of the team. + # This feature is only applicable in an issue (or PR) context + exit: true # optional. If the action should exit if the user is not part of the team. Defaults to true. + + - name: Send message on Zulip + uses: zulip/github-actions-zulip/send-message@v1 + with: + api-key: ${{ secrets.ZULIP_API_KEY }} + email: 'github-bot@leanprover.zulipchat.com' + organization-url: 'https://leanprover.zulipchat.com' + to: 'mathlib reviewers' + type: 'stream' + topic: 'maintainer merge' + content: | + ${{ format('{0} requested a maintainer merge on PR [#{1}]({2}):', github.event.comment.user.login, github.event.issue.number, github.event.issue.html_url) }} + + > ${{ github.event.issue.title }} + + - name: Add comment to PR + uses: GrantBirki/comment@v2.0.1 + with: + issue-number: ${{ github.event.issue.number }} + body: | + 🚀 Pull request has been placed on the maintainer queue by ${{ github.event.comment.user.login }}. diff --git a/.github/workflows/maintainer_merge_review.yml b/.github/workflows/maintainer_merge_review.yml new file mode 100644 index 0000000000000..21cc34de067ea --- /dev/null +++ b/.github/workflows/maintainer_merge_review.yml @@ -0,0 +1,40 @@ +name: Maintainer merge (review) + +on: + pull_request_review: + types: [submitted, edited] + +jobs: + ping_zulip: + name: Ping maintainers on Zulip + if: (startsWith(github.event.review.body, 'maintainer merge') || contains(toJSON(github.event.review.body), '\r\nmaintainer merge')) + runs-on: ubuntu-latest + steps: + - name: Check whether user is part of mathlib-reviewers team + uses: TheModdingInquisition/actions-team-membership@v1.0 + with: + organization: 'leanprover-community' + team: 'mathlib-reviewers' # required. The team to check for + token: ${{ secrets.MATHLIB_REVIEWERS_TEAM_KEY }} # required. Personal Access Token with the `read:org` permission + exit: true # optional. If the action should exit if the user is not part of the team. Defaults to true. + + - name: Send message on Zulip + uses: zulip/github-actions-zulip/send-message@v1 + with: + api-key: ${{ secrets.ZULIP_API_KEY }} + email: 'github-bot@leanprover.zulipchat.com' + organization-url: 'https://leanprover.zulipchat.com' + to: 'mathlib reviewers' + type: 'stream' + topic: 'maintainer merge' + content: | + ${{ format('{0} requested a maintainer merge on PR [#{1}]({2}):', github.event.review.user.login, github.event.pull_request.number, github.event.pull_request.html_url) }} + + > ${{ github.event.pull_request.title }} + + - name: Add comment to PR + uses: GrantBirki/comment@v2.0.1 + with: + issue-number: ${{ github.event.pull_request.number }} + body: | + 🚀 Pull request has been placed on the maintainer queue by ${{ github.event.review.user.login }}. diff --git a/.github/workflows/maintainer_merge_review_comment.yml b/.github/workflows/maintainer_merge_review_comment.yml new file mode 100644 index 0000000000000..a3f3b0d627889 --- /dev/null +++ b/.github/workflows/maintainer_merge_review_comment.yml @@ -0,0 +1,40 @@ +name: Maintainer merge (review comment) + +on: + pull_request_review_comment: + types: [created, edited] + +jobs: + ping_zulip: + name: Ping maintainers on Zulip + if: (startsWith(github.event.comment.body, 'maintainer merge') || contains(toJSON(github.event.comment.body), '\r\nmaintainer merge')) + runs-on: ubuntu-latest + steps: + - name: Check whether user is part of mathlib-reviewers team + uses: TheModdingInquisition/actions-team-membership@v1.0 + with: + organization: 'leanprover-community' + team: 'mathlib-reviewers' # required. The team to check for + token: ${{ secrets.MATHLIB_REVIEWERS_TEAM_KEY }} # required. Personal Access Token with the `read:org` permission + exit: true # optional. If the action should exit if the user is not part of the team. Defaults to true. + + - name: Send message on Zulip + uses: zulip/github-actions-zulip/send-message@v1 + with: + api-key: ${{ secrets.ZULIP_API_KEY }} + email: 'github-bot@leanprover.zulipchat.com' + organization-url: 'https://leanprover.zulipchat.com' + to: 'mathlib reviewers' + type: 'stream' + topic: 'maintainer merge' + content: | + ${{ format('{0} requested a maintainer merge on PR [#{1}]({2}):', github.event.comment.user.login, github.event.pull_request.number, github.event.pull_request.html_url) }} + + > ${{ github.event.pull_request.title }} + + - name: Add comment to PR + uses: GrantBirki/comment@v2.0.1 + with: + issue-number: ${{ github.event.pull_request.number }} + body: | + 🚀 Pull request has been placed on the maintainer queue by ${{ github.event.comment.user.login }}. diff --git a/.github/workflows/merge_conflicts.yml b/.github/workflows/merge_conflicts.yml index 0fd7c969ce3d0..68b53db526dad 100644 --- a/.github/workflows/merge_conflicts.yml +++ b/.github/workflows/merge_conflicts.yml @@ -1,13 +1,8 @@ +name: Merge conflicts + on: - # So that PRs touching the same files as the push are updated - push: - branches: - - master - # So that the `dirtyLabel` is removed if conflicts are resolve - # We recommend `pull_request_target` so that github secrets are available. - # In `pull_request` we wouldn't be able to change labels of fork PRs - pull_request_target: - types: [synchronize] + schedule: + - cron: '*/15 * * * *' # run every 15 minutes jobs: main: diff --git a/.gitignore b/.gitignore index 889a3819ca4e8..a7798b842bb80 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ *.olean /_target -/leanpkg.path +leanpkg.path _cache __pycache__ all.lean @@ -9,3 +9,4 @@ all.lean *~ .DS_Store *.lock +port_status.yaml diff --git a/CITATION.md b/CITATION.md new file mode 100644 index 0000000000000..32d35af3bb51e --- /dev/null +++ b/CITATION.md @@ -0,0 +1,43 @@ + +# Citing Mathlib + +You can cite `mathlib` using the following BibTeX entry: + +```bib +@InProceedings{ mathlib2020, + author = {The mathlib Community}, + title = {The Lean Mathematical Library}, + year = {2020}, + isbn = {9781450370974}, + publisher = {Association for Computing Machinery}, + address = {New York, NY, USA}, + url = {https://doi.org/10.1145/3372885.3373824}, + doi = {10.1145/3372885.3373824}, + booktitle = {Proceedings of the 9th ACM SIGPLAN International + Conference on Certified Programs and Proofs}, + pages = {367-381}, + numpages = {15}, + keywords = {formal proof, formal library, Lean, mathlib}, + location = {New Orleans, LA, USA}, + series = {CPP 2020} +} +``` + +The `mathlib` project is actively maintained and updated. In the interest of reproducibility, you may want to manage your code's dependency on `mathlib` using the [`leanproject`](https://leanprover-community.github.io/leanproject.html) command-line tool. This will help ensure others can retrieve the right version of `mathlib` for your project. + +Lean was introduced in the paper ["The Lean Theorem Prover"](https://www.semanticscholar.org/paper/The-Lean-Theorem-Prover-(System-Description)-Moura-Kong/2a441a46e228ed0ea2251a4e61be6c7025b45766), by de Moura et al., which you can cite using: + +```bib +@InProceedings{ demoura2015lean, + author = {de Moura, Leonardo and Kong, Soonho and Avigad, Jeremy and + van Doorn, Floris and von Raumer, Jakob}, + editor = {Felty, Amy P. and Middeldorp, Aart}, + title = {The Lean Theorem Prover (System Description)}, + booktitle = {Automated Deduction - CADE-25}, + year = {2015}, + publisher = {Springer International Publishing}, + address = {Cham}, + pages = {378--388}, + isbn = {978-3-319-21401-6} +} +``` diff --git a/OLD_README.md b/OLD_README.md new file mode 100644 index 0000000000000..53d8c3defebf5 --- /dev/null +++ b/OLD_README.md @@ -0,0 +1,115 @@ +# Lean 3's mathlib + +> [!WARNING] +> Lean 3 and Mathlib 3 are no longer actively maintained. +> It is strongly recommended that you use [mathlib4](https://github.com/leanprover-community/mathlib4) for Lean 4 instead. + +![](https://github.com/leanprover-community/mathlib/workflows/continuous%20integration/badge.svg?branch=master) +[![Bors enabled](https://bors.tech/images/badge_small.svg)](https://app.bors.tech/repositories/24316) +[![project chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://leanprover.zulipchat.com) +[![Gitpod Ready-to-Code](https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod)](https://gitpod.io/#https://github.com/leanprover-community/mathlib) + +[Mathlib](https://leanprover-community.github.io) is a user maintained library for the [Lean 3 theorem prover](https://github.com/leanprover-community/lean). +It contains both programming infrastructure and mathematics, +as well as tactics that use the former and allow to develop the latter. + +## Installation + +You can find detailed instructions to install Lean 3, mathlib 3, and supporting tools on [our website](https://leanprover-community.github.io/lean3/get_started.html). + +## Experimenting + +Got everything installed? Why not start with the [tutorial project](https://leanprover-community.github.io/lean3/install/project.html)? + +For more pointers, see [Learning Lean](https://leanprover-community.github.io/lean3/learn.html). + +## Documentation + +Besides the installation guides above and [Lean's general +documentation](https://leanprover.github.io/lean3/documentation/), the documentation +of mathlib consists of: + +- [The mathlib docs](https://leanprover-community.github.io/mathlib_docs): documentation [generated + automatically](https://github.com/leanprover-community/doc-gen) from the source `.lean` files. + In addition to the pages generated for each file in the library, the docs also include pages on: + - [tactics](https://leanprover-community.github.io/mathlib_docs/tactics.html), + - [commands](https://leanprover-community.github.io/mathlib_docs/commands.html), + - [hole commands](https://leanprover-community.github.io/mathlib_docs/hole_commands.html), and + - [attributes](https://leanprover-community.github.io/mathlib_docs/attributes.html). +- A description of [currently covered theories](https://leanprover-community.github.io/theories.html), + as well as an [overview](https://leanprover-community.github.io/lean3/mathlib-overview.html) for mathematicians. +- A couple of [tutorial Lean files](docs/tutorial/) +- Some [extra Lean documentation](https://leanprover-community.github.io/lean3/learn.html) not specific to mathlib (see "Miscellaneous topics") +- Documentation for people who would like to [contribute to mathlib3](https://leanprover-community.github.io/lean3/contribute/index.html) + +Much of the discussion surrounding mathlib occurs in a +[Zulip chat room](https://leanprover.zulipchat.com/). Since this +chatroom is only visible to registered users, we provide an +[openly accessible archive](https://leanprover-community.github.io/archive/) +of the public discussions. This is useful for quick reference; for a +better browsing interface, and to participate in the discussions, we strongly +suggest joining the chat. Questions from users at all levels of expertise are +welcomed. + +## Contributing + +> [!WARNING] +> Contributions are no longer accepted to mathlib 3; contribute to mathlib 4 instead! + +The complete documentation for contributing to ``mathlib`` is located +[on the community guide contribute to mathlib](https://leanprover-community.github.io/lean3/contribute/index.html) + +The process is different from other projects where one should not fork the repository. +Instead write permission for non-master branches should be requested on [Zulip](https://leanprover.zulipchat.com) +by introducing yourself, providing your GitHub handle and what contribution you are planning on doing. + +### Guidelines + +Mathlib has the following guidelines and conventions that must be followed + + - The [style guide](https://leanprover-community.github.io/lean3/contribute/style.html) + - A guide on the [naming convention](https://leanprover-community.github.io/lean3/contribute/naming.html) + - The [documentation style](https://leanprover-community.github.io/lean3/contribute/doc.html) + - The [commit naming conventions](https://github.com/leanprover-community/lean/blob/master/doc/commit_convention.md) + +Note: the title of a PR should follow the commit naming convention. + +### Using ``leanproject`` to contribute + +Running the ``leanproject get -b mathlib:shiny_lemma`` command will create a new worktree ``mathlib_shiny_lemma`` +with a local branch called ``shiny_lemma`` which has a copy of mathlib to work on. + +``leanproject build`` will check that nothing broke. +Be warned that this will take some time if a fundamental file was changed. + +## Maintainers: + +* Anne Baanen (@Vierkantor): algebra, number theory, tactics +* Reid Barton (@rwbarton): category theory, topology +* Riccardo Brasca (@riccardobrasca): algebra, number theory, algebraic geometry, category theory +* Mario Carneiro (@digama0): lean formalization, tactics, type theory, proof engineering +* Bryan Gin-ge Chen (@bryangingechen): documentation, infrastructure +* Johan Commelin (@jcommelin): algebra, number theory, category theory, algebraic geometry +* Rémy Degenne (@RemyDegenne): probability, measure theory, analysis +* Floris van Doorn (@fpvandoorn): measure theory, model theory, tactics +* Frédéric Dupuis (@dupuisf): linear algebra, functional analysis +* Gabriel Ebner (@gebner): tactics, infrastructure, core, formal languages +* Sébastien Gouëzel (@sgouezel): topology, calculus, geometry, analysis, measure theory +* Markus Himmel (@TwoFX): category theory +* Chris Hughes (@ChrisHughes24): algebra +* Yury G. Kudryashov (@urkud): analysis, topology, measure theory +* Robert Y. Lewis (@robertylewis): tactics, documentation +* Heather Macbeth (@hrmacbeth): geometry, analysis +* Patrick Massot (@patrickmassot): documentation, topology, geometry +* Bhavik Mehta (@b-mehta): category theory, combinatorics +* Kyle Miller (@kmill): combinatorics, documentation +* Scott Morrison (@semorrison): category theory, tactics +* Oliver Nash (@ocfnash): algebra, geometry, topology +* Adam Topaz (@adamtopaz): algebra, category theory, algebraic geometry +* Eric Wieser (@eric-wieser): algebra, infrastructure + +## Emeritus maintainers: + +* Jeremy Avigad (@avigad): analysis +* Johannes Hölzl (@johoelzl): measure theory, topology +* Simon Hudon (@cipher1024): tactics diff --git a/README.md b/README.md index 88b3c18f3ccbe..f850c525cc3b0 100644 --- a/README.md +++ b/README.md @@ -1,108 +1,7 @@ -# Lean mathlib +# Lean 3's mathlib -![](https://github.com/leanprover-community/mathlib/workflows/continuous%20integration/badge.svg?branch=master) -[![Bors enabled](https://bors.tech/images/badge_small.svg)](https://app.bors.tech/repositories/24316) -[![project chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://leanprover.zulipchat.com) -[![Gitpod Ready-to-Code](https://img.shields.io/badge/Gitpod-ready--to--code-blue?logo=gitpod)](https://gitpod.io/#https://github.com/leanprover-community/mathlib) +> [!WARNING] +> Lean 3 and Mathlib 3 are no longer actively maintained. +> It is strongly recommended that you use [mathlib4](https://github.com/leanprover-community/mathlib4) for Lean 4 instead. -[Mathlib](https://leanprover-community.github.io) is a user maintained library for the [Lean theorem prover](https://leanprover.github.io). -It contains both programming infrastructure and mathematics, -as well as tactics that use the former and allow to develop the latter. - -## Installation - -You can find detailed instructions to install Lean, mathlib, and supporting tools on [our website](https://leanprover-community.github.io/get_started.html). - -## Experimenting - -Got everything installed? Why not start with the [tutorial project](https://leanprover-community.github.io/install/project.html)? - -For more pointers, see [Learning Lean](https://leanprover-community.github.io/learn.html). - -## Documentation - -Besides the installation guides above and [Lean's general -documentation](https://leanprover.github.io/documentation/), the documentation -of mathlib consists of: - -- [The mathlib docs](https://leanprover-community.github.io/mathlib_docs): documentation [generated - automatically](https://github.com/leanprover-community/doc-gen) from the source `.lean` files. - In addition to the pages generated for each file in the library, the docs also include pages on: - - [tactics](https://leanprover-community.github.io/mathlib_docs/tactics.html), - - [commands](https://leanprover-community.github.io/mathlib_docs/commands.html), - - [hole commands](https://leanprover-community.github.io/mathlib_docs/hole_commands.html), and - - [attributes](https://leanprover-community.github.io/mathlib_docs/attributes.html). -- A description of [currently covered theories](https://leanprover-community.github.io/theories.html), - as well as an [overview](https://leanprover-community.github.io/mathlib-overview.html) for mathematicians. -- A couple of [tutorial Lean files](docs/tutorial/) -- Some [extra Lean documentation](https://leanprover-community.github.io/learn.html) not specific to mathlib (see "Miscellaneous topics") -- Documentation for people who would like to [contribute to mathlib](https://leanprover-community.github.io/contribute/index.html) - -Much of the discussion surrounding mathlib occurs in a -[Zulip chat room](https://leanprover.zulipchat.com/). Since this -chatroom is only visible to registered users, we provide an -[openly accessible archive](https://leanprover-community.github.io/archive/) -of the public discussions. This is useful for quick reference; for a -better browsing interface, and to participate in the discussions, we strongly -suggest joining the chat. Questions from users at all levels of expertise are -welcomed. - -## Contributing - -The complete documentation for contributing to ``mathlib`` is located -[on the community guide contribute to mathlib](https://leanprover-community.github.io/contribute/index.html) - -The process is different from other projects where one should not fork the repository. -Instead write permission for non-master branches should be requested on [Zulip](https://leanprover.zulipchat.com) -by introducing yourself, providing your GitHub handle and what contribution you are planning on doing. - -### Guidelines - -Mathlib has the following guidelines and conventions that must be followed - - - The [style guide](https://leanprover-community.github.io/contribute/style.html) - - A guide on the [naming convention](https://leanprover-community.github.io/contribute/naming.html) - - The [documentation style](https://leanprover-community.github.io/contribute/doc.html) - - The [commit naming conventions](https://github.com/leanprover-community/lean/blob/master/doc/commit_convention.md) - -Note: the title of a PR should follow the commit naming convention. - -### Using ``leanproject`` to contribute - -Running the ``leanproject get -b mathlib:shiny_lemma`` command will create a new worktree ``mathlib_shiny_lemma`` -with a local branch called ``shiny_lemma`` which has a copy of mathlib to work on. - -``leanproject build`` will check that nothing broke. -Be warned that this will take some time if a fundamental file was changed. - -## Maintainers: - -* Anne Baanen (@Vierkantor): algebra, number theory, tactics -* Reid Barton (@rwbarton): category theory, topology -* Riccardo Brasca (@riccardobrasca): algebra, number theory, algebraic geometry, category theory -* Mario Carneiro (@digama0): lean formalization, tactics, type theory, proof engineering -* Bryan Gin-ge Chen (@bryangingechen): documentation, infrastructure -* Johan Commelin (@jcommelin): algebra, number theory, category theory, algebraic geometry -* Rémy Degenne (@RemyDegenne): probability, measure theory, analysis -* Floris van Doorn (@fpvandoorn): measure theory, model theory, tactics -* Frédéric Dupuis (@dupuisf): linear algebra, functional analysis -* Gabriel Ebner (@gebner): tactics, infrastructure, core, formal languages -* Sébastien Gouëzel (@sgouezel): topology, calculus, geometry, analysis, measure theory -* Markus Himmel (@TwoFX): category theory -* Chris Hughes (@ChrisHughes24): algebra -* Yury G. Kudryashov (@urkud): analysis, topology, measure theory -* Robert Y. Lewis (@robertylewis): tactics, documentation -* Heather Macbeth (@hrmacbeth): geometry, analysis -* Patrick Massot (@patrickmassot): documentation, topology, geometry -* Bhavik Mehta (@b-mehta): category theory, combinatorics -* Kyle Miller (@kmill): combinatorics, documentation -* Scott Morrison (@semorrison): category theory, tactics -* Oliver Nash (@ocfnash): algebra, geometry, topology -* Adam Topaz (@adamtopaz): algebra, category theory, algebraic geometry -* Eric Wieser (@eric-wieser): algebra, infrastructure - -## Emeritus maintainers: - -* Jeremy Avigad (@avigad): analysis -* Johannes Hölzl (@johoelzl): measure theory, topology -* Simon Hudon (@cipher1024): tactics +(If you need to read the old `README.md`, please see `OLD_README.md`.) diff --git a/archive/100-theorems-list/16_abel_ruffini.lean b/archive/100-theorems-list/16_abel_ruffini.lean deleted file mode 100644 index 3b6d17fced1b4..0000000000000 --- a/archive/100-theorems-list/16_abel_ruffini.lean +++ /dev/null @@ -1,179 +0,0 @@ -/- -Copyright (c) 2021 Thomas Browning. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Thomas Browning --/ -import field_theory.abel_ruffini -import analysis.calculus.local_extr -import ring_theory.eisenstein_criterion -/-! -Construction of an algebraic number that is not solvable by radicals. - -The main ingredients are: - * `solvable_by_rad.is_solvable'` in `field_theory/abel_ruffini` : - an irreducible polynomial with an `is_solvable_by_rad` root has solvable Galois group - * `gal_action_hom_bijective_of_prime_degree'` in `field_theory/polynomial_galois_group` : - an irreducible polynomial of prime degree with 1-3 non-real roots has full Galois group - * `equiv.perm.not_solvable` in `group_theory/solvable` : the symmetric group is not solvable - -Then all that remains is the construction of a specific polynomial satisfying the conditions of -`gal_action_hom_bijective_of_prime_degree'`, which is done in this file. - --/ - -namespace abel_ruffini - -open function polynomial polynomial.gal ideal -open_locale polynomial - -local attribute [instance] splits_ℚ_ℂ - -variables (R : Type*) [comm_ring R] (a b : ℕ) - -/-- A quintic polynomial that we will show is irreducible -/ -noncomputable def Φ : R[X] := X ^ 5 - C ↑a * X + C ↑b - -variables {R} - -@[simp] lemma map_Phi {S : Type*} [comm_ring S] (f : R →+* S) : (Φ R a b).map f = Φ S a b := -by simp [Φ] - -@[simp] lemma coeff_zero_Phi : (Φ R a b).coeff 0 = ↑b := -by simp [Φ, coeff_X_pow] - -@[simp] lemma coeff_five_Phi : (Φ R a b).coeff 5 = 1 := -by simp [Φ, coeff_X, coeff_C, -C_eq_nat_cast, -map_nat_cast] - -variables [nontrivial R] - -lemma degree_Phi : (Φ R a b).degree = ↑5 := -begin - suffices : degree (X ^ 5 - C ↑a * X) = ↑5, - { rwa [Φ, degree_add_eq_left_of_degree_lt], - convert degree_C_le.trans_lt (with_bot.coe_lt_coe.mpr (nat.zero_lt_bit1 2)) }, - rw degree_sub_eq_left_of_degree_lt; rw degree_X_pow, - exact (degree_C_mul_X_le _).trans_lt (with_bot.coe_lt_coe.mpr (nat.one_lt_bit1 two_ne_zero)), -end - -lemma nat_degree_Phi : (Φ R a b).nat_degree = 5 := -nat_degree_eq_of_degree_eq_some (degree_Phi a b) - -lemma leading_coeff_Phi : (Φ R a b).leading_coeff = 1 := -by rw [polynomial.leading_coeff, nat_degree_Phi, coeff_five_Phi] - -lemma monic_Phi : (Φ R a b).monic := -leading_coeff_Phi a b - -lemma irreducible_Phi (p : ℕ) (hp : p.prime) (hpa : p ∣ a) (hpb : p ∣ b) (hp2b : ¬ p ^ 2 ∣ b) : - irreducible (Φ ℚ a b) := -begin - rw [←map_Phi a b (int.cast_ring_hom ℚ), ←is_primitive.int.irreducible_iff_irreducible_map_cast], - apply irreducible_of_eisenstein_criterion, - { rwa [span_singleton_prime (int.coe_nat_ne_zero.mpr hp.ne_zero), int.prime_iff_nat_abs_prime] }, - { rw [leading_coeff_Phi, mem_span_singleton], - exact_mod_cast mt nat.dvd_one.mp (hp.ne_one) }, - { intros n hn, - rw mem_span_singleton, - rw [degree_Phi, with_bot.coe_lt_coe] at hn, - interval_cases n with hn; - simp only [Φ, coeff_X_pow, coeff_C, int.coe_nat_dvd.mpr, hpb, if_true, coeff_C_mul, if_false, - nat.zero_ne_bit1, eq_self_iff_true, coeff_X_zero, hpa, coeff_add, zero_add, mul_zero, - int.nat_cast_eq_coe_nat, coeff_sub, sub_self, nat.one_ne_zero, add_zero, coeff_X_one, mul_one, - zero_sub, dvd_neg, nat.one_eq_bit1, bit0_eq_zero, neg_zero, nat.bit0_ne_bit1, - dvd_mul_of_dvd_left, nat.bit1_eq_bit1, nat.one_ne_bit0, nat.bit1_ne_zero], }, - { simp only [degree_Phi, ←with_bot.coe_zero, with_bot.coe_lt_coe, nat.succ_pos'] }, - { rw [coeff_zero_Phi, span_singleton_pow, mem_span_singleton, int.nat_cast_eq_coe_nat], - exact mt int.coe_nat_dvd.mp hp2b }, - all_goals { exact monic.is_primitive (monic_Phi a b) }, -end - -lemma real_roots_Phi_le : fintype.card ((Φ ℚ a b).root_set ℝ) ≤ 3 := -begin - rw [←map_Phi a b (algebra_map ℤ ℚ), Φ, ←one_mul (X ^ 5), ←C_1], - refine (card_root_set_le_derivative _).trans - (nat.succ_le_succ ((card_root_set_le_derivative _).trans (nat.succ_le_succ _))), - suffices : ((C ((algebra_map ℤ ℚ) 20) * X ^ 3).root_set ℝ).subsingleton, - { norm_num [fintype.card_le_one_iff_subsingleton, ← mul_assoc, *] at * }, - rw root_set_C_mul_X_pow; norm_num, -end - -lemma real_roots_Phi_ge_aux (hab : b < a) : - ∃ x y : ℝ, x ≠ y ∧ aeval x (Φ ℚ a b) = 0 ∧ aeval y (Φ ℚ a b) = 0 := -begin - let f := λ x : ℝ, aeval x (Φ ℚ a b), - have hf : f = λ x, x ^ 5 - a * x + b := by simp [f, Φ], - have hc : ∀ s : set ℝ, continuous_on f s := λ s, (Φ ℚ a b).continuous_on_aeval, - have ha : (1 : ℝ) ≤ a := nat.one_le_cast.mpr (nat.one_le_of_lt hab), - have hle : (0 : ℝ) ≤ 1 := zero_le_one, - have hf0 : 0 ≤ f 0 := by norm_num [hf], - by_cases hb : (1 : ℝ) - a + b < 0, - { have hf1 : f 1 < 0 := by norm_num [hf, hb], - have hfa : 0 ≤ f a, - { simp_rw [hf, ←sq], - refine add_nonneg (sub_nonneg.mpr (pow_le_pow ha _)) _; norm_num }, - obtain ⟨x, ⟨-, hx1⟩, hx2⟩ := intermediate_value_Ico' hle (hc _) (set.mem_Ioc.mpr ⟨hf1, hf0⟩), - obtain ⟨y, ⟨hy1, -⟩, hy2⟩ := intermediate_value_Ioc ha (hc _) (set.mem_Ioc.mpr ⟨hf1, hfa⟩), - exact ⟨x, y, (hx1.trans hy1).ne, hx2, hy2⟩ }, - { replace hb : (b : ℝ) = a - 1 := by linarith [show (b : ℝ) + 1 ≤ a, by exact_mod_cast hab], - have hf1 : f 1 = 0 := by norm_num [hf, hb], - have hfa := calc f (-a) = a ^ 2 - a ^ 5 + b : by norm_num [hf, ← sq] - ... ≤ a ^ 2 - a ^ 3 + (a - 1) : by refine add_le_add (sub_le_sub_left - (pow_le_pow ha _) _) _; linarith - ... = -(a - 1) ^ 2 * (a + 1) : by ring - ... ≤ 0 : by nlinarith, - have ha' := neg_nonpos.mpr (hle.trans ha), - obtain ⟨x, ⟨-, hx1⟩, hx2⟩ := intermediate_value_Icc ha' (hc _) (set.mem_Icc.mpr ⟨hfa, hf0⟩), - exact ⟨x, 1, (hx1.trans_lt zero_lt_one).ne, hx2, hf1⟩ }, -end - -lemma real_roots_Phi_ge (hab : b < a) : 2 ≤ fintype.card ((Φ ℚ a b).root_set ℝ) := -begin - have q_ne_zero : Φ ℚ a b ≠ 0 := (monic_Phi a b).ne_zero, - obtain ⟨x, y, hxy, hx, hy⟩ := real_roots_Phi_ge_aux a b hab, - have key : ↑({x, y} : finset ℝ) ⊆ (Φ ℚ a b).root_set ℝ, - { simp [set.insert_subset, mem_root_set q_ne_zero, hx, hy] }, - convert fintype.card_le_of_embedding (set.embedding_of_subset _ _ key), - simp only [finset.coe_sort_coe, fintype.card_coe, finset.card_singleton, - finset.card_insert_of_not_mem (mt finset.mem_singleton.mp hxy)] -end - -lemma complex_roots_Phi (h : (Φ ℚ a b).separable) : fintype.card ((Φ ℚ a b).root_set ℂ) = 5 := -(card_root_set_eq_nat_degree h (is_alg_closed.splits_codomain _)).trans (nat_degree_Phi a b) - -lemma gal_Phi (hab : b < a) (h_irred : irreducible (Φ ℚ a b)) : - bijective (gal_action_hom (Φ ℚ a b) ℂ) := -begin - apply gal_action_hom_bijective_of_prime_degree' h_irred, - { norm_num [nat_degree_Phi] }, - { rw [complex_roots_Phi a b h_irred.separable, nat.succ_le_succ_iff], - exact (real_roots_Phi_le a b).trans (nat.le_succ 3) }, - { simp_rw [complex_roots_Phi a b h_irred.separable, nat.succ_le_succ_iff], - exact real_roots_Phi_ge a b hab }, -end - -theorem not_solvable_by_rad (p : ℕ) (x : ℂ) (hx : aeval x (Φ ℚ a b) = 0) (hab : b < a) - (hp : p.prime) (hpa : p ∣ a) (hpb : p ∣ b) (hp2b : ¬ p ^ 2 ∣ b) : - ¬ is_solvable_by_rad ℚ x := -begin - have h_irred := irreducible_Phi a b p hp hpa hpb hp2b, - apply mt (solvable_by_rad.is_solvable' h_irred hx), - introI h, - refine equiv.perm.not_solvable _ (le_of_eq _) - (solvable_of_surjective (gal_Phi a b hab h_irred).2), - rw_mod_cast [cardinal.mk_fintype, complex_roots_Phi a b h_irred.separable], -end - -theorem not_solvable_by_rad' (x : ℂ) (hx : aeval x (Φ ℚ 4 2) = 0) : - ¬ is_solvable_by_rad ℚ x := -by apply not_solvable_by_rad 4 2 2 x hx; norm_num - -/-- **Abel-Ruffini Theorem** -/ -theorem exists_not_solvable_by_rad : ∃ x : ℂ, is_algebraic ℚ x ∧ ¬ is_solvable_by_rad ℚ x := -begin - obtain ⟨x, hx⟩ := exists_root_of_splits (algebra_map ℚ ℂ) - (is_alg_closed.splits_codomain (Φ ℚ 4 2)) - (ne_of_eq_of_ne (degree_Phi 4 2) (mt with_bot.coe_eq_coe.mp (nat.bit1_ne_zero 2))), - exact ⟨x, ⟨Φ ℚ 4 2, (monic_Phi 4 2).ne_zero, hx⟩, not_solvable_by_rad' x hx⟩, -end - -end abel_ruffini diff --git a/archive/100-theorems-list/37_solution_of_cubic.lean b/archive/100-theorems-list/37_solution_of_cubic.lean deleted file mode 100644 index c5c80de571087..0000000000000 --- a/archive/100-theorems-list/37_solution_of_cubic.lean +++ /dev/null @@ -1,186 +0,0 @@ -/- -Copyright (c) 2022 Jeoff Lee. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeoff Lee --/ -import tactic.linear_combination -import ring_theory.roots_of_unity -import ring_theory.polynomial.cyclotomic.basic - -/-! -# The Solution of a Cubic - -This file proves Theorem 37 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). - -In this file, we give the solutions to the cubic equation `a * x^3 + b * x^2 + c * x + d = 0` -over a field `K` that has characteristic neither 2 nor 3, that has a third primitive root of -unity, and in which certain other quantities admit square and cube roots. - -This is based on the [Cardano's Formula](https://en.wikipedia.org/wiki/Cubic_equation#Cardano's_formula). - -## Main statements - -- `cubic_eq_zero_iff` : gives the roots of the cubic equation -where the discriminant `p = 3 * a * c - b^2` is nonzero. -- `cubic_eq_zero_iff_of_p_eq_zero` : gives the roots of the cubic equation -where the discriminant equals zero. - -## References - -Originally ported from Isabelle/HOL. The -[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL-ex/Cubic_Quartic.html) was written by Amine Chaieb. - -## Tags - -polynomial, cubic, root --/ - -section field - -open polynomial - -variables {K : Type*} [field K] -variables [invertible (2 : K)] [invertible (3 : K)] -variables (a b c d : K) -variables {ω p q r s t : K} - -lemma cube_root_of_unity_sum (hω : is_primitive_root ω 3) : 1 + ω + ω^2 = 0 := -begin - convert hω.is_root_cyclotomic (nat.succ_pos _), - rw [cyclotomic_eq_geom_sum nat.prime_three, eval_geom_sum], - simp only [geom_sum_succ, geom_sum_zero], - ring, -end - -/-- The roots of a monic cubic whose quadratic term is zero and whose discriminant is nonzero. -/ -lemma cubic_basic_eq_zero_iff - (hω : is_primitive_root ω 3) - (hp_nonzero : p ≠ 0) - (hr : r^2 = q^2 + p^3) - (hs3 : s^3 = q + r) - (ht : t * s = p) - (x : K) : - x^3 + 3 * p * x - 2 * q = 0 ↔ - x = s - t ∨ - x = s * ω - t * ω^2 ∨ - x = s * ω^2 - t * ω := -begin - have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0, - { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] }, - rw h₁, - refine eq.congr _ rfl, - have hs_nonzero : s ≠ 0, - { contrapose! hp_nonzero with hs_nonzero, - linear_combination (ht, -1) (hs_nonzero, t) }, - rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero), - have H := cube_root_of_unity_sum hω, - linear_combination - (hr, 1) - (hs3, - q + r + s ^ 3) - (ht, -3 * x * s ^ 3 - (t * s) ^ 2 - (t * s) * p - p ^ 2) - (H, (x ^ 2 * (s - t) + x * (- ω * (s ^ 2 + t ^ 2) + s * t * (3 + ω ^ 2 - ω)) - - (-(s ^ 3 - t ^ 3) * (ω - 1) + s^2 * t * ω ^ 2 - s * t^2 * ω ^ 2)) * s ^ 3), -end - -/-- Roots of a monic cubic whose discriminant is nonzero. -/ -lemma cubic_monic_eq_zero_iff - (hω : is_primitive_root ω 3) - (hp : p = (3 * c - b^2) / 9) - (hp_nonzero : p ≠ 0) - (hq : q = (9 * b * c - 2 * b^3 - 27 * d) / 54) - (hr : r^2 = q^2 + p^3) - (hs3 : s^3 = q + r) - (ht : t * s = p) - (x : K) : - x^3 + b * x^2 + c * x + d = 0 ↔ - x = s - t - b / 3 ∨ - x = s * ω - t * ω^2 - b / 3 ∨ - x = s * ω^2 - t * ω - b / 3 := -begin - let y := x + b / 3, - have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _, - have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _, - have h9 : (9 : K) = 3^2 := by norm_num, - have h54 : (54 : K) = 2*3^3 := by norm_num, - have h₁ : x^3 + b * x^2 + c * x + d = y^3 + 3 * p * y - 2 * q, - { dsimp only [y], - rw [hp, hq], - field_simp [h9, h54], ring, }, - rw [h₁, cubic_basic_eq_zero_iff hω hp_nonzero hr hs3 ht y], - dsimp only [y], - simp_rw [eq_sub_iff_add_eq], -end - -/-- **The Solution of Cubic**. - The roots of a cubic polynomial whose discriminant is nonzero. -/ -theorem cubic_eq_zero_iff (ha : a ≠ 0) - (hω : is_primitive_root ω 3) - (hp : p = (3 * a * c - b^2) / (9 * a^2)) - (hp_nonzero : p ≠ 0) - (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3)) - (hr : r^2 = q^2 + p^3) - (hs3 : s^3 = q + r) - (ht : t * s = p) - (x : K) : - a * x^3 + b * x^2 + c * x + d = 0 ↔ - x = s - t - b / (3 * a) ∨ - x = s * ω - t * ω^2 - b / (3 * a) ∨ - x = s * ω^2 - t * ω - b / (3 * a) := -begin - have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _, - have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _, - have h9 : (9 : K) = 3^2 := by norm_num, - have h54 : (54 : K) = 2*3^3 := by norm_num, - have h₁ : a * x^3 + b * x^2 + c * x + d = a * (x^3 + b/a * x^2 + c/a * x + d/a), - { field_simp, ring }, - have h₂ : ∀ x, a * x = 0 ↔ x = 0, { intros x, simp [ha], }, - have hp' : p = (3 * (c/a) - (b/a) ^ 2) / 9, { field_simp [hp, h9], ring_nf }, - have hq' : q = (9 * (b/a) * (c/a) - 2 * (b/a) ^ 3 - 27 * (d/a)) / 54, - { field_simp [hq, h54], ring_nf }, - rw [h₁, h₂, cubic_monic_eq_zero_iff (b/a) (c/a) (d/a) hω hp' hp_nonzero hq' hr hs3 ht x], - have h₄ := calc b / a / 3 = b / (a * 3) : by { field_simp [ha] } - ... = b / (3 * a) : by rw mul_comm, - rw [h₄], -end - -/-- the solution of the cubic equation when p equals zero. -/ -lemma cubic_eq_zero_iff_of_p_eq_zero (ha : a ≠ 0) - (hω : is_primitive_root ω 3) - (hpz : 3 * a * c - b^2 = 0) - (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3)) - (hs3 : s^3 = 2 * q) - (x : K) : - a * x^3 + b * x^2 + c * x + d = 0 ↔ - x = s - b / (3 * a) ∨ - x = s * ω - b / (3 * a) ∨ - x = s * ω^2 - b / (3 * a) := -begin - have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0, - { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] }, - have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _, - have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _, - have h54 : (54 : K) = 2*3^3 := by norm_num, - have hb2 : b^2 = 3 * a * c, { rw sub_eq_zero at hpz, rw hpz }, - have hb3 : b^3 = 3 * a * b * c, { rw [pow_succ, hb2], ring }, - have h₂ := - calc a * x^3 + b * x^2 + c * x + d - = a * (x + b/(3*a))^3 + (c - b^2/(3*a)) * x + (d - b^3*a/(3*a)^3) - : by { field_simp, ring } - ... = a * (x + b/(3*a))^3 + (d - (9*a*b*c-2*b^3)*a/(3*a)^3) - : by { simp only [hb2, hb3], field_simp, ring } - ... = a * ((x + b/(3*a))^3 - s^3) - : by { rw [hs3, hq], field_simp [h54], ring, }, - have h₃ : ∀ x, a * x = 0 ↔ x = 0, { intro x, simp [ha] }, - have h₄ : ∀ x : K, x^3 - s^3 = (x - s) * (x - s * ω) * (x - s * ω^2), - { intro x, - calc x^3 - s^3 - = (x - s) * (x^2 + x*s + s^2) : by ring - ... = (x - s) * (x^2 - (ω+ω^2)*x*s + (1+ω+ω^2)*x*s + s^2) : by ring - ... = (x - s) * (x^2 - (ω+ω^2)*x*s + ω^3*s^2) - : by { rw [hω.pow_eq_one, cube_root_of_unity_sum hω], simp, } - ... = (x - s) * (x - s * ω) * (x - s * ω^2) : by ring }, - rw [h₁, h₂, h₃, h₄ (x + b/(3*a))], - ring_nf, -end - -end field diff --git a/archive/100-theorems-list/42_inverse_triangle_sum.lean b/archive/100-theorems-list/42_inverse_triangle_sum.lean deleted file mode 100644 index bb722ed24db98..0000000000000 --- a/archive/100-theorems-list/42_inverse_triangle_sum.lean +++ /dev/null @@ -1,35 +0,0 @@ -/- -Copyright (c) 2020. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jalex Stark, Yury Kudryashov --/ -import data.real.basic - -/-! -# Sum of the Reciprocals of the Triangular Numbers - -This file proves Theorem 42 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). - -We interpret “triangular numbers” as naturals of the form $\frac{k(k+1)}{2}$ for natural `k`. -We prove that the sum of the reciprocals of the first `n` triangular numbers is $2 - \frac2n$. - -## Tags - -discrete_sum --/ - -open_locale big_operators -open finset - -/-- **Sum of the Reciprocals of the Triangular Numbers** -/ -lemma inverse_triangle_sum : - ∀ n, ∑ k in range n, (2 : ℚ) / (k * (k + 1)) = if n = 0 then 0 else 2 - (2 : ℚ) / n := -begin - refine sum_range_induction _ _ (if_pos rfl) _, - rintro (_|n), { rw [if_neg, if_pos]; norm_num }, - simp_rw [if_neg (nat.succ_ne_zero _), nat.succ_eq_add_one], - have A : (n + 1 + 1 : ℚ) ≠ 0, by { norm_cast, norm_num }, - push_cast, - field_simp [nat.cast_add_one_ne_zero], - ring -end diff --git a/archive/100-theorems-list/45_partition.lean b/archive/100-theorems-list/45_partition.lean deleted file mode 100644 index 1470aa2598d58..0000000000000 --- a/archive/100-theorems-list/45_partition.lean +++ /dev/null @@ -1,547 +0,0 @@ -/- -Copyright (c) 2020 Bhavik Mehta, Aaron Anderson. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bhavik Mehta, Aaron Anderson --/ -import ring_theory.power_series.basic -import combinatorics.partition -import data.nat.parity -import data.finset.nat_antidiagonal -import data.fin.tuple.nat_antidiagonal -import tactic.interval_cases -import tactic.apply_fun - -/-! -# Euler's Partition Theorem - -This file proves Theorem 45 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). - -The theorem concerns the counting of integer partitions -- ways of -writing a positive integer `n` as a sum of positive integer parts. - -Specifically, Euler proved that the number of integer partitions of `n` -into *distinct* parts equals the number of partitions of `n` into *odd* -parts. - -## Proof outline - -The proof is based on the generating functions for odd and distinct partitions, which turn out to be -equal: - -$$\prod_{i=0}^\infty \frac {1}{1-X^{2i+1}} = \prod_{i=0}^\infty (1+X^{i+1})$$ - -In fact, we do not take a limit: it turns out that comparing the `n`'th coefficients of the partial -products up to `m := n + 1` is sufficient. - -In particular, we - -1. define the partial product for the generating function for odd partitions `partial_odd_gf m` := - $$\prod_{i=0}^m \frac {1}{1-X^{2i+1}}$$; -2. prove `odd_gf_prop`: if `m` is big enough (`m * 2 > n`), the partial product's coefficient counts - the number of odd partitions; -3. define the partial product for the generating function for distinct partitions - `partial_distinct_gf m` := $$\prod_{i=0}^m (1+X^{i+1})$$; -4. prove `distinct_gf_prop`: if `m` is big enough (`m + 1 > n`), the `n`th coefficient of the - partial product counts the number of distinct partitions of `n`; -5. prove `same_coeffs`: if m is big enough (`m ≥ n`), the `n`th coefficient of the partial products - are equal; -6. combine the above in `partition_theorem`. - -## References -https://en.wikipedia.org/wiki/Partition_(number_theory)#Odd_parts_and_distinct_parts --/ - -open power_series -noncomputable theory - -variables {α : Type*} - -open finset -open_locale big_operators -open_locale classical - -/-- -The partial product for the generating function for odd partitions. -TODO: As `m` tends to infinity, this converges (in the `X`-adic topology). - -If `m` is sufficiently large, the `i`th coefficient gives the number of odd partitions of the -natural number `i`: proved in `odd_gf_prop`. -It is stated for an arbitrary field `α`, though it usually suffices to use `ℚ` or `ℝ`. --/ -def partial_odd_gf (m : ℕ) [field α] := ∏ i in range m, (1 - (X : power_series α)^(2*i+1))⁻¹ - -/-- -The partial product for the generating function for distinct partitions. -TODO: As `m` tends to infinity, this converges (in the `X`-adic topology). - -If `m` is sufficiently large, the `i`th coefficient gives the number of distinct partitions of the -natural number `i`: proved in `distinct_gf_prop`. -It is stated for an arbitrary commutative semiring `α`, though it usually suffices to use `ℕ`, `ℚ` -or `ℝ`. --/ -def partial_distinct_gf (m : ℕ) [comm_semiring α] := -∏ i in range m, (1 + (X : power_series α)^(i+1)) - -/-- -Functions defined only on `s`, which sum to `n`. In other words, a partition of `n` indexed by `s`. -Every function in here is finitely supported, and the support is a subset of `s`. -This should be thought of as a generalisation of `finset.nat.antidiagonal_tuple` where -`antidiagonal_tuple k n` is the same thing as `cut (s : finset.univ (fin k)) n`. --/ -def cut {ι : Type*} (s : finset ι) (n : ℕ) : finset (ι → ℕ) := -finset.filter (λ f, s.sum f = n) ((s.pi (λ _, range (n+1))).map - ⟨λ f i, if h : i ∈ s then f i h else 0, - λ f g h, by { ext i hi, simpa [dif_pos hi] using congr_fun h i }⟩) - -lemma mem_cut {ι : Type*} (s : finset ι) (n : ℕ) (f : ι → ℕ) : - f ∈ cut s n ↔ s.sum f = n ∧ ∀ i ∉ s, f i = 0 := -begin - rw [cut, mem_filter, and_comm, and_congr_right], - intro h, - simp only [mem_map, exists_prop, function.embedding.coe_fn_mk, mem_pi], - split, - { rintro ⟨_, _, rfl⟩ _ _, - simp [dif_neg H] }, - { intro hf, - refine ⟨λ i hi, f i, λ i hi, _, _⟩, - { rw [mem_range, nat.lt_succ_iff, ← h], - apply single_le_sum _ hi, - simp }, - { ext, - rw [dite_eq_ite, ite_eq_left_iff, eq_comm], - exact hf x } } -end - -lemma cut_equiv_antidiag (n : ℕ) : - equiv.finset_congr (equiv.bool_arrow_equiv_prod _) (cut univ n) = nat.antidiagonal n := -begin - ext ⟨x₁, x₂⟩, - simp_rw [equiv.finset_congr_apply, mem_map, equiv.to_embedding, function.embedding.coe_fn_mk, - ←equiv.eq_symm_apply], - simp [mem_cut, add_comm], -end - -lemma cut_univ_fin_eq_antidiagonal_tuple (n : ℕ) (k : ℕ) : - cut univ n = nat.antidiagonal_tuple k n := -by { ext, simp [nat.mem_antidiagonal_tuple, mem_cut] } - -/-- There is only one `cut` of 0. -/ -@[simp] -lemma cut_zero {ι : Type*} (s : finset ι) : - cut s 0 = {0} := -begin - -- In general it's nice to prove things using `mem_cut` but in this case it's easier to just - -- use the definition. - rw [cut, range_one, pi_const_singleton, map_singleton, function.embedding.coe_fn_mk, - filter_singleton, if_pos, singleton_inj], - { ext, split_ifs; refl }, - rw sum_eq_zero_iff, - intros x hx, - apply dif_pos hx, -end - -@[simp] -lemma cut_empty_succ {ι : Type*} (n : ℕ) : - cut (∅ : finset ι) (n+1) = ∅ := -begin - apply eq_empty_of_forall_not_mem, - intros x hx, - rw [mem_cut, sum_empty] at hx, - cases hx.1, -end - -lemma cut_insert {ι : Type*} (n : ℕ) (a : ι) (s : finset ι) (h : a ∉ s) : - cut (insert a s) n = - (nat.antidiagonal n).bUnion - (λ (p : ℕ × ℕ), (cut s p.snd).map - ⟨λ f, f + λ t, if t = a then p.fst else 0, add_left_injective _⟩) := -begin - ext f, - rw [mem_cut, mem_bUnion, sum_insert h], - split, - { rintro ⟨rfl, h₁⟩, - simp only [exists_prop, function.embedding.coe_fn_mk, mem_map, - nat.mem_antidiagonal, prod.exists], - refine ⟨f a, s.sum f, rfl, λ i, if i = a then 0 else f i, _, _⟩, - { rw [mem_cut], - refine ⟨_, _⟩, - { rw [sum_ite], - have : (filter (λ x, x ≠ a) s) = s, - { apply filter_true_of_mem, - rintro i hi rfl, - apply h hi }, - simp [this] }, - { intros i hi, - rw ite_eq_left_iff, - intro hne, - apply h₁, - simp [not_or_distrib, hne, hi] } }, - { ext, - obtain rfl|h := eq_or_ne x a, - { simp }, - { simp [if_neg h] } } }, - { simp only [mem_insert, function.embedding.coe_fn_mk, mem_map, nat.mem_antidiagonal, prod.exists, - exists_prop, mem_cut, not_or_distrib], - rintro ⟨p, q, rfl, g, ⟨rfl, hg₂⟩, rfl⟩, - refine ⟨_, _⟩, - { simp [sum_add_distrib, if_neg h, hg₂ _ h, add_comm] }, - { rintro i ⟨h₁, h₂⟩, - simp [if_neg h₁, hg₂ _ h₂] } } -end - -lemma coeff_prod_range - [comm_semiring α] {ι : Type*} (s : finset ι) (f : ι → power_series α) (n : ℕ) : - coeff α n (∏ j in s, f j) = ∑ l in cut s n, ∏ i in s, coeff α (l i) (f i) := -begin - revert n, - apply finset.induction_on s, - { rintro ⟨_ | n⟩, - { simp }, - simp [cut_empty_succ, if_neg (nat.succ_ne_zero _)] }, - intros a s hi ih n, - rw [cut_insert _ _ _ hi, prod_insert hi, coeff_mul, sum_bUnion], - { apply sum_congr rfl _, - simp only [prod.forall, sum_map, pi.add_apply, - function.embedding.coe_fn_mk, nat.mem_antidiagonal], - rintro i j rfl, - simp only [prod_insert hi, if_pos rfl, ih, mul_sum], - apply sum_congr rfl _, - intros x hx, - rw mem_cut at hx, - rw [hx.2 a hi, zero_add], - congr' 1, - apply prod_congr rfl, - intros k hk, - rw [if_neg, add_zero], - exact ne_of_mem_of_not_mem hk hi }, - { simp only [set.pairwise_disjoint, set.pairwise, prod.forall, not_and, ne.def, - nat.mem_antidiagonal, disjoint_left, mem_map, exists_prop, function.embedding.coe_fn_mk, - exists_imp_distrib, not_exists, finset.mem_coe], - rintro p₁ q₁ rfl p₂ q₂ h t x hx, - simp only [finset.inf_eq_inter, finset.mem_map, finset.mem_inter, mem_cut, exists_prop, - function.embedding.coe_fn_mk] at hx, - rcases hx with ⟨⟨p, ⟨hp, hp2⟩, hp3⟩, ⟨q, ⟨hq, hq2⟩, hq3⟩⟩, - have z := hp3.trans hq3.symm, - have := sum_congr (eq.refl s) (λ x _, function.funext_iff.1 z x), - obtain rfl : q₁ = q₂, - { simpa [sum_add_distrib, hp, hq, if_neg hi] using this }, - obtain rfl : p₂ = p₁, - { simpa using h }, - exact (t rfl).elim } -end - -/-- A convenience constructor for the power series whose coefficients indicate a subset. -/ -def indicator_series (α : Type*) [semiring α] (s : set ℕ) : power_series α := -power_series.mk (λ n, if n ∈ s then 1 else 0) - -lemma coeff_indicator (s : set ℕ) [semiring α] (n : ℕ) : - coeff α n (indicator_series _ s) = if n ∈ s then 1 else 0 := -coeff_mk _ _ -lemma coeff_indicator_pos (s : set ℕ) [semiring α] (n : ℕ) (h : n ∈ s): - coeff α n (indicator_series _ s) = 1 := -by rw [coeff_indicator, if_pos h] -lemma coeff_indicator_neg (s : set ℕ) [semiring α] (n : ℕ) (h : n ∉ s): - coeff α n (indicator_series _ s) = 0 := -by rw [coeff_indicator, if_neg h] -lemma constant_coeff_indicator (s : set ℕ) [semiring α] : - constant_coeff α (indicator_series _ s) = if 0 ∈ s then 1 else 0 := -rfl - -lemma two_series (i : ℕ) [semiring α] : - (1 + (X : power_series α)^i.succ) = indicator_series α {0, i.succ} := -begin - ext, - simp only [coeff_indicator, coeff_one, coeff_X_pow, set.mem_insert_iff, set.mem_singleton_iff, - map_add], - cases n with d, - { simp [(nat.succ_ne_zero i).symm] }, - { simp [nat.succ_ne_zero d], }, -end - -lemma num_series' [field α] (i : ℕ) : - (1 - (X : power_series α)^(i+1))⁻¹ = indicator_series α { k | i + 1 ∣ k } := -begin - rw power_series.inv_eq_iff_mul_eq_one, - { ext, - cases n, - { simp [mul_sub, zero_pow, constant_coeff_indicator] }, - { simp only [coeff_one, if_neg n.succ_ne_zero, mul_sub, mul_one, - coeff_indicator, linear_map.map_sub], - simp_rw [coeff_mul, coeff_X_pow, coeff_indicator, boole_mul, sum_ite, filter_filter, - sum_const_zero, add_zero, sum_const, nsmul_eq_mul, mul_one, sub_eq_iff_eq_add, - zero_add, filter_congr_decidable], - symmetry, - split_ifs, - { suffices : - ((nat.antidiagonal n.succ).filter (λ (a : ℕ × ℕ), i + 1 ∣ a.fst ∧ a.snd = i + 1)).card = 1, - { simp only [set.mem_set_of_eq], rw this, norm_cast }, - rw card_eq_one, - cases h with p hp, - refine ⟨((i+1) * (p-1), i+1), _⟩, - ext ⟨a₁, a₂⟩, - simp only [mem_filter, prod.mk.inj_iff, nat.mem_antidiagonal, mem_singleton], - split, - { rintro ⟨a_left, ⟨a, rfl⟩, rfl⟩, - refine ⟨_, rfl⟩, - rw [nat.mul_sub_left_distrib, ← hp, ← a_left, mul_one, nat.add_sub_cancel] }, - { rintro ⟨rfl, rfl⟩, - cases p, - { rw mul_zero at hp, cases hp }, - rw hp, - simp [nat.succ_eq_add_one, mul_add] } }, - { suffices : - (filter (λ (a : ℕ × ℕ), i + 1 ∣ a.fst ∧ a.snd = i + 1) (nat.antidiagonal n.succ)).card = 0, - { simp only [set.mem_set_of_eq], rw this, norm_cast }, - rw card_eq_zero, - apply eq_empty_of_forall_not_mem, - simp only [prod.forall, mem_filter, not_and, nat.mem_antidiagonal], - rintro _ h₁ h₂ ⟨a, rfl⟩ rfl, - apply h, - simp [← h₂] } } }, - { simp [zero_pow] }, -end - -def mk_odd : ℕ ↪ ℕ := ⟨λ i, 2 * i + 1, λ x y h, by linarith⟩ - --- The main workhorse of the partition theorem proof. -lemma partial_gf_prop - (α : Type*) [comm_semiring α] (n : ℕ) (s : finset ℕ) - (hs : ∀ i ∈ s, 0 < i) (c : ℕ → set ℕ) (hc : ∀ i ∉ s, 0 ∈ c i) : - (finset.card - ((univ : finset (nat.partition n)).filter - (λ p, (∀ j, p.parts.count j ∈ c j) ∧ ∀ j ∈ p.parts, j ∈ s)) : α) = - (coeff α n) (∏ (i : ℕ) in s, indicator_series α ((* i) '' c i)) := -begin - simp_rw [coeff_prod_range, coeff_indicator, prod_boole, sum_boole], - congr' 1, - refine finset.card_congr (λ p _ i, multiset.count i p.parts • i) _ _ _, - { simp only [mem_filter, mem_cut, mem_univ, true_and, exists_prop, and_assoc, and_imp, - smul_eq_zero, function.embedding.coe_fn_mk, exists_imp_distrib], - rintro ⟨p, hp₁, hp₂⟩ hp₃ hp₄, - dsimp only at *, - refine ⟨_, _, _⟩, - { rw [←hp₂, ←sum_multiset_count_of_subset p s (λ x hx, hp₄ _ (multiset.mem_to_finset.mp hx))] }, - { intros i hi, - left, - exact multiset.count_eq_zero_of_not_mem (mt (hp₄ i) hi) }, - { exact λ i hi, ⟨_, hp₃ i, rfl⟩ } }, - { intros p₁ p₂ hp₁ hp₂ h, - apply nat.partition.ext, - simp only [true_and, mem_univ, mem_filter] at hp₁ hp₂, - ext i, - rw function.funext_iff at h, - specialize h i, - cases i, - { rw multiset.count_eq_zero_of_not_mem, - rw multiset.count_eq_zero_of_not_mem, - intro a, exact nat.lt_irrefl 0 (hs 0 (hp₂.2 0 a)), - intro a, exact nat.lt_irrefl 0 (hs 0 (hp₁.2 0 a)) }, - { rwa [nat.nsmul_eq_mul, nat.nsmul_eq_mul, nat.mul_left_inj i.succ_pos] at h } }, - { simp only [mem_filter, mem_cut, mem_univ, exists_prop, true_and, and_assoc], - rintros f ⟨hf₁, hf₂, hf₃⟩, - refine ⟨⟨∑ i in s, multiset.repeat i (f i / i), _, _⟩, _, _, _⟩, - { intros i hi, - simp only [exists_prop, mem_sum, mem_map, function.embedding.coe_fn_mk] at hi, - rcases hi with ⟨t, ht, z⟩, - apply hs, - rwa multiset.eq_of_mem_repeat z }, - { simp_rw [multiset.sum_sum, multiset.sum_repeat, nat.nsmul_eq_mul, ←hf₁], - refine sum_congr rfl (λ i hi, nat.div_mul_cancel _), - rcases hf₃ i hi with ⟨w, hw, hw₂⟩, - rw ← hw₂, - exact dvd_mul_left _ _ }, - { intro i, - simp_rw [multiset.count_sum', multiset.count_repeat, sum_ite_eq], - split_ifs with h h, - { rcases hf₃ i h with ⟨w, hw₁, hw₂⟩, - rwa [← hw₂, nat.mul_div_cancel _ (hs i h)] }, - { exact hc _ h } }, - { intros i hi, - rw mem_sum at hi, - rcases hi with ⟨j, hj₁, hj₂⟩, - rwa multiset.eq_of_mem_repeat hj₂ }, - { ext i, - simp_rw [multiset.count_sum', multiset.count_repeat, sum_ite_eq], - split_ifs, - { apply nat.div_mul_cancel, - rcases hf₃ i h with ⟨w, hw, hw₂⟩, - apply dvd.intro_left _ hw₂ }, - { rw [zero_smul, hf₂ i h] } } }, -end - -lemma partial_odd_gf_prop [field α] (n m : ℕ) : - (finset.card ((univ : finset (nat.partition n)).filter - (λ p, ∀ j ∈ p.parts, j ∈ (range m).map mk_odd)) : α) = coeff α n (partial_odd_gf m) := -begin - rw partial_odd_gf, - convert partial_gf_prop α n ((range m).map mk_odd) _ (λ _, set.univ) (λ _ _, trivial) using 2, - { congr' 2, - simp only [true_and, forall_const, set.mem_univ] }, - { rw finset.prod_map, - simp_rw num_series', - apply prod_congr rfl, - intros, - congr' 1, - ext k, - split, - { rintro ⟨p, rfl⟩, - refine ⟨p, ⟨⟩, _⟩, - apply mul_comm }, - rintro ⟨a_w, -, rfl⟩, - apply dvd.intro_left a_w rfl }, - { intro i, - rw mem_map, - rintro ⟨a, -, rfl⟩, - exact nat.succ_pos _ }, -end - -/-- If m is big enough, the partial product's coefficient counts the number of odd partitions -/ -theorem odd_gf_prop [field α] (n m : ℕ) (h : n < m * 2) : - (finset.card (nat.partition.odds n) : α) = coeff α n (partial_odd_gf m) := -begin - rw [← partial_odd_gf_prop], - congr' 2, - apply filter_congr, - intros p hp, - apply ball_congr, - intros i hi, - have hin : i ≤ n, - { simpa [p.parts_sum] using multiset.single_le_sum (λ _ _, nat.zero_le _) _ hi }, - simp only [mk_odd, exists_prop, mem_range, function.embedding.coe_fn_mk, mem_map], - split, - { intro hi₂, - have := nat.mod_add_div i 2, - rw nat.not_even_iff at hi₂, - rw [hi₂, add_comm] at this, - refine ⟨i / 2, _, this⟩, - rw nat.div_lt_iff_lt_mul _ _ zero_lt_two, - exact lt_of_le_of_lt hin h }, - { rintro ⟨a, -, rfl⟩, - rw even_iff_two_dvd, - apply nat.two_not_dvd_two_mul_add_one }, -end - -lemma partial_distinct_gf_prop [comm_semiring α] (n m : ℕ) : - (finset.card - ((univ : finset (nat.partition n)).filter - (λ p, p.parts.nodup ∧ ∀ j ∈ p.parts, j ∈ (range m).map ⟨nat.succ, nat.succ_injective⟩)) : α) = - coeff α n (partial_distinct_gf m) := -begin - rw partial_distinct_gf, - convert partial_gf_prop α n - ((range m).map ⟨nat.succ, nat.succ_injective⟩) _ (λ _, {0, 1}) (λ _ _, or.inl rfl) using 2, - { congr' 2, - ext p, - congr' 2, - apply propext, - rw multiset.nodup_iff_count_le_one, - apply forall_congr, - intro i, - rw [set.mem_insert_iff, set.mem_singleton_iff], - split, - { intro hi, - interval_cases (multiset.count i p.parts), - { left, assumption }, - { right, assumption } }, - { rintro (h | h), - { rw h, norm_num }, - { rw h } } }, - { rw finset.prod_map, - apply prod_congr rfl, - intros, - rw two_series, - congr' 1, - simp [set.image_pair] }, - { simp only [mem_map, function.embedding.coe_fn_mk], - rintro i ⟨_, _, rfl⟩, - apply nat.succ_pos } -end - -/-- -If m is big enough, the partial product's coefficient counts the number of distinct partitions --/ -theorem distinct_gf_prop [comm_semiring α] (n m : ℕ) (h : n < m + 1) : - ((nat.partition.distincts n).card : α) = coeff α n (partial_distinct_gf m) := -begin - erw [← partial_distinct_gf_prop], - congr' 2, - apply filter_congr, - intros p hp, - apply (and_iff_left _).symm, - intros i hi, - have : i ≤ n, - { simpa [p.parts_sum] using multiset.single_le_sum (λ _ _, nat.zero_le _) _ hi }, - simp only [mk_odd, exists_prop, mem_range, function.embedding.coe_fn_mk, mem_map], - refine ⟨i-1, _, nat.succ_pred_eq_of_pos (p.parts_pos hi)⟩, - rw tsub_lt_iff_right (nat.one_le_iff_ne_zero.mpr (p.parts_pos hi).ne'), - exact lt_of_le_of_lt this h, -end - -/-- -The key proof idea for the partition theorem, showing that the generating functions for both -sequences are ultimately the same (since the factor converges to 0 as m tends to infinity). -It's enough to not take the limit though, and just consider large enough `m`. --/ -lemma same_gf [field α] (m : ℕ) : - partial_odd_gf m * (range m).prod (λ i, (1 - (X : power_series α)^(m+i+1))) = - partial_distinct_gf m := -begin - rw [partial_odd_gf, partial_distinct_gf], - induction m with m ih, - { simp }, - - rw nat.succ_eq_add_one, - - set π₀ : power_series α := ∏ i in range m, (1 - X ^ (m + 1 + i + 1)) with hπ₀, - set π₁ : power_series α := ∏ i in range m, (1 - X ^ (2 * i + 1))⁻¹ with hπ₁, - set π₂ : power_series α := ∏ i in range m, (1 - X ^ (m + i + 1)) with hπ₂, - set π₃ : power_series α := ∏ i in range m, (1 + X ^ (i + 1)) with hπ₃, - rw ←hπ₃ at ih, - - have h : constant_coeff α (1 - X ^ (2 * m + 1)) ≠ 0, - { rw [ring_hom.map_sub, ring_hom.map_pow, constant_coeff_one, constant_coeff_X, - zero_pow (2 * m).succ_pos, sub_zero], - exact one_ne_zero }, - - calc (∏ i in range (m + 1), (1 - X ^ (2 * i + 1))⁻¹) * - ∏ i in range (m + 1), (1 - X ^ (m + 1 + i + 1)) - = π₁ * (1 - X ^ (2 * m + 1))⁻¹ * (π₀ * (1 - X ^ (m + 1 + m + 1))) : - by rw [prod_range_succ _ m, ←hπ₁, prod_range_succ _ m, ←hπ₀] - ... = π₁ * (1 - X ^ (2 * m + 1))⁻¹ * (π₀ * ((1 + X ^ (m + 1)) * (1 - X ^ (m + 1)))) : - by rw [←sq_sub_sq, one_pow, add_assoc _ m 1, ←two_mul (m + 1), pow_mul'] - ... = π₀ * (1 - X ^ (m + 1)) * (1 - X ^ (2 * m + 1))⁻¹ * (π₁ * (1 + X ^ (m + 1))) : - by ring - ... = (∏ i in range (m + 1), (1 - X ^ (m + 1 + i))) * (1 - X ^ (2 * m + 1))⁻¹ * - (π₁ * (1 + X ^ (m + 1))) : - by { rw [prod_range_succ', add_zero, hπ₀], simp_rw ←add_assoc } - ... = π₂ * (1 - X ^ (m + 1 + m)) * (1 - X ^ (2 * m + 1))⁻¹ * (π₁ * (1 + X ^ (m + 1))) : - by { rw [add_right_comm, hπ₂, ←prod_range_succ], simp_rw [add_right_comm] } - ... = π₂ * (1 - X ^ (2 * m + 1)) * (1 - X ^ (2 * m + 1))⁻¹ * (π₁ * (1 + X ^ (m + 1))) : - by rw [two_mul, add_right_comm _ m 1] - ... = (1 - X ^ (2 * m + 1)) * (1 - X ^ (2 * m + 1))⁻¹ * π₂ * (π₁ * (1 + X ^ (m + 1))) : - by ring - ... = π₂ * (π₁ * (1 + X ^ (m + 1))) : by rw [power_series.mul_inv_cancel _ h, one_mul] - ... = π₁ * π₂ * (1 + X ^ (m + 1)) : by ring - ... = π₃ * (1 + X ^ (m + 1)) : by rw ih - ... = _ : by rw prod_range_succ, -end - -lemma same_coeffs [field α] (m n : ℕ) (h : n ≤ m) : - coeff α n (partial_odd_gf m) = coeff α n (partial_distinct_gf m) := -begin - rw [← same_gf, coeff_mul_prod_one_sub_of_lt_order], - rintros i -, - rw order_X_pow, - exact_mod_cast nat.lt_succ_of_le (le_add_right h), -end - -theorem partition_theorem (n : ℕ) : - (nat.partition.odds n).card = (nat.partition.distincts n).card := -begin - -- We need the counts to live in some field (which contains ℕ), so let's just use ℚ - suffices : ((nat.partition.odds n).card : ℚ) = (nat.partition.distincts n).card, - { exact_mod_cast this }, - rw distinct_gf_prop n (n+1) (by linarith), - rw odd_gf_prop n (n+1) (by linarith), - apply same_coeffs (n+1) n n.le_succ, -end diff --git a/archive/100-theorems-list/57_herons_formula.lean b/archive/100-theorems-list/57_herons_formula.lean deleted file mode 100644 index fc62c68b265a5..0000000000000 --- a/archive/100-theorems-list/57_herons_formula.lean +++ /dev/null @@ -1,63 +0,0 @@ -/- -Copyright (c) 2021 Matt Kempster. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Matt Kempster --/ -import geometry.euclidean.triangle - -/-! -# Freek № 57: Heron's Formula - -This file proves Theorem 57 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/), -also known as Heron's formula, which gives the area of a triangle based only on its three sides' -lengths. - -## References - -* https://en.wikipedia.org/wiki/Herons_formula - --/ - -open real euclidean_geometry -open_locale real euclidean_geometry - -local notation `√` := real.sqrt - -variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P] - [normed_add_torsor V P] - -include V - -/-- **Heron's formula**: The area of a triangle with side lengths `a`, `b`, and `c` is - `√(s * (s - a) * (s - b) * (s - c))` where `s = (a + b + c) / 2` is the semiperimeter. - We show this by equating this formula to `a * b * sin γ`, where `γ` is the angle opposite - the side `c`. - -/ -theorem heron {p1 p2 p3 : P} (h1 : p1 ≠ p2) (h2 : p3 ≠ p2) : - let a := dist p1 p2, b := dist p3 p2, c := dist p1 p3, s := (a + b + c) / 2 in - 1/2 * a * b * sin (∠ p1 p2 p3) = √(s * (s - a) * (s - b) * (s - c)) := -begin - intros a b c s, - let γ := ∠ p1 p2 p3, - obtain := ⟨(dist_pos.mpr h1).ne', (dist_pos.mpr h2).ne'⟩, - have cos_rule : cos γ = (a * a + b * b - c * c) / (2 * a * b) := by field_simp [mul_comm, a, - dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle p1 p2 p3], - let numerator := (2*a*b)^2 - (a*a + b*b - c*c)^2, - let denominator := (2*a*b)^2, - have split_to_frac : 1 - cos γ ^ 2 = numerator / denominator := by field_simp [cos_rule], - have numerator_nonneg : 0 ≤ numerator, - { have frac_nonneg: 0 ≤ numerator / denominator := by linarith [split_to_frac, cos_sq_le_one γ], - cases div_nonneg_iff.mp frac_nonneg, - { exact h.left }, - { simpa [h1, h2] using le_antisymm h.right (sq_nonneg _) } }, - have ab2_nonneg : 0 ≤ (2 * a * b) := by norm_num [mul_nonneg, dist_nonneg], - calc 1/2 * a * b * sin γ - = 1/2 * a * b * (√numerator / √denominator) : by rw [sin_eq_sqrt_one_sub_cos_sq, - split_to_frac, sqrt_div numerator_nonneg]; - simp [angle_nonneg, angle_le_pi] - ... = 1/4 * √((2*a*b)^2 - (a*a + b*b - c*c)^2) : by { field_simp [ab2_nonneg], ring } - ... = 1/4 * √(s * (s-a) * (s-b) * (s-c) * 4^2) : by { simp only [s], ring_nf } - ... = √(s * (s-a) * (s-b) * (s-c)) : by rw [sqrt_mul', sqrt_sq, div_mul_eq_mul_div, - one_mul, mul_div_cancel]; - norm_num, -end diff --git a/archive/100-theorems-list/70_perfect_numbers.lean b/archive/100-theorems-list/70_perfect_numbers.lean deleted file mode 100644 index e399fc20d8cda..0000000000000 --- a/archive/100-theorems-list/70_perfect_numbers.lean +++ /dev/null @@ -1,129 +0,0 @@ -/- -Copyright (c) 2020 Aaron Anderson. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Aaron Anderson --/ - -import number_theory.arithmetic_function -import number_theory.lucas_lehmer -import algebra.geom_sum -import ring_theory.multiplicity - -/-! -# Perfect Numbers - -This file proves Theorem 70 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). - -The theorem characterizes even perfect numbers. - -Euclid proved that if `2 ^ (k + 1) - 1` is prime (these primes are known as Mersenne primes), - then `2 ^ k * 2 ^ (k + 1) - 1` is perfect. - -Euler proved the converse, that if `n` is even and perfect, then there exists `k` such that - `n = 2 ^ k * 2 ^ (k + 1) - 1` and `2 ^ (k + 1) - 1` is prime. - -## References -https://en.wikipedia.org/wiki/Euclid%E2%80%93Euler_theorem --/ - -lemma odd_mersenne_succ (k : ℕ) : ¬ 2 ∣ mersenne (k + 1) := -by simp [← even_iff_two_dvd, ← nat.even_succ, nat.succ_eq_add_one] with parity_simps - -namespace nat -open arithmetic_function finset -open_locale arithmetic_function - -lemma sigma_two_pow_eq_mersenne_succ (k : ℕ) : σ 1 (2 ^ k) = mersenne (k + 1) := -by simpa [mersenne, prime_two, ← geom_sum_mul_add 1 (k+1)] - - -/-- Euclid's theorem that Mersenne primes induce perfect numbers -/ -theorem perfect_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) : - perfect ((2 ^ k) * mersenne (k + 1)) := -begin - rw [perfect_iff_sum_divisors_eq_two_mul, ← mul_assoc, ← pow_succ, ← sigma_one_apply, mul_comm, - is_multiplicative_sigma.map_mul_of_coprime - (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)), - sigma_two_pow_eq_mersenne_succ], - { simp [pr, nat.prime_two] }, - { apply mul_pos (pow_pos _ k) (mersenne_pos (nat.succ_pos k)), - norm_num } -end - -lemma ne_zero_of_prime_mersenne (k : ℕ) (pr : (mersenne (k + 1)).prime) : - k ≠ 0 := -begin - intro H, - simpa [H, mersenne, not_prime_one] using pr, -end - -theorem even_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) : - even ((2 ^ k) * mersenne (k + 1)) := -by simp [ne_zero_of_prime_mersenne k pr] with parity_simps - -lemma eq_two_pow_mul_odd {n : ℕ} (hpos : 0 < n) : - ∃ (k m : ℕ), n = 2 ^ k * m ∧ ¬ even m := -begin - have h := (multiplicity.finite_nat_iff.2 ⟨nat.prime_two.ne_one, hpos⟩), - cases multiplicity.pow_multiplicity_dvd h with m hm, - use [(multiplicity 2 n).get h, m], - refine ⟨hm, _⟩, - rw even_iff_two_dvd, - have hg := multiplicity.is_greatest' h (nat.lt_succ_self _), - contrapose! hg, - rcases hg with ⟨k, rfl⟩, - apply dvd.intro k, - rw [pow_succ', mul_assoc, ← hm], -end - -/-- **Perfect Number Theorem**: Euler's theorem that even perfect numbers can be factored as a - power of two times a Mersenne prime. -/ -theorem eq_two_pow_mul_prime_mersenne_of_even_perfect {n : ℕ} (ev : even n) (perf : perfect n) : - ∃ (k : ℕ), prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) := -begin - have hpos := perf.2, - rcases eq_two_pow_mul_odd hpos with ⟨k, m, rfl, hm⟩, - use k, - rw even_iff_two_dvd at hm, - rw [perfect_iff_sum_divisors_eq_two_mul hpos, ← sigma_one_apply, - is_multiplicative_sigma.map_mul_of_coprime (nat.prime_two.coprime_pow_of_not_dvd hm).symm, - sigma_two_pow_eq_mersenne_succ, ← mul_assoc, ← pow_succ] at perf, - rcases nat.coprime.dvd_of_dvd_mul_left - (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)) (dvd.intro _ perf) with ⟨j, rfl⟩, - rw [← mul_assoc, mul_comm _ (mersenne _), mul_assoc] at perf, - have h := mul_left_cancel₀ (ne_of_gt (mersenne_pos (nat.succ_pos _))) perf, - rw [sigma_one_apply, sum_divisors_eq_sum_proper_divisors_add_self, ← succ_mersenne, add_mul, - one_mul, add_comm] at h, - have hj := add_left_cancel h, - cases sum_proper_divisors_dvd (by { rw hj, apply dvd.intro_left (mersenne (k + 1)) rfl }), - { have j1 : j = 1 := eq.trans hj.symm h_1, - rw [j1, mul_one, sum_proper_divisors_eq_one_iff_prime] at h_1, - simp [h_1, j1] }, - { have jcon := eq.trans hj.symm h_1, - rw [← one_mul j, ← mul_assoc, mul_one] at jcon, - have jcon2 := mul_right_cancel₀ _ jcon, - { exfalso, - cases k, - { apply hm, - rw [← jcon2, pow_zero, one_mul, one_mul] at ev, - rw [← jcon2, one_mul], - exact even_iff_two_dvd.mp ev }, - apply ne_of_lt _ jcon2, - rw [mersenne, ← nat.pred_eq_sub_one, lt_pred_iff, ← pow_one (nat.succ 1)], - apply pow_lt_pow (nat.lt_succ_self 1) (nat.succ_lt_succ (nat.succ_pos k)) }, - contrapose! hm, - simp [hm] } -end - -/-- The Euclid-Euler theorem characterizing even perfect numbers -/ -theorem even_and_perfect_iff {n : ℕ} : - (even n ∧ perfect n) ↔ ∃ (k : ℕ), prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) := -begin - split, - { rintro ⟨ev, perf⟩, - exact eq_two_pow_mul_prime_mersenne_of_even_perfect ev perf }, - { rintro ⟨k, pr, rfl⟩, - exact ⟨even_two_pow_mul_mersenne_of_prime k pr, perfect_two_pow_mul_mersenne_of_prime k pr⟩ } -end - -end nat diff --git a/archive/100-theorems-list/73_ascending_descending_sequences.lean b/archive/100-theorems-list/73_ascending_descending_sequences.lean deleted file mode 100644 index c51a69870e2ec..0000000000000 --- a/archive/100-theorems-list/73_ascending_descending_sequences.lean +++ /dev/null @@ -1,162 +0,0 @@ -/- -Copyright (c) 2020 Bhavik Mehta. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bhavik Mehta --/ -import tactic.basic -import data.fintype.basic - -/-! -# Erdős–Szekeres theorem - -This file proves Theorem 73 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/), also -known as the Erdős–Szekeres theorem: given a sequence of more than `r * s` distinct -values, there is an increasing sequence of length longer than `r` or a decreasing sequence of length -longer than `s`. - -We use the proof outlined at -https://en.wikipedia.org/wiki/Erdos-Szekeres_theorem#Pigeonhole_principle. - -## Tags - -sequences, increasing, decreasing, Ramsey, Erdos-Szekeres, Erdős–Szekeres, Erdős-Szekeres --/ - -variables {α : Type*} [linear_order α] {β : Type*} - -open function finset -open_locale classical - -/-- -**Erdős–Szekeres Theorem**: Given a sequence of more than `r * s` distinct values, there is an -increasing sequence of length longer than `r` or a decreasing sequence of length longer than `s`. - -Proof idea: -We label each value in the sequence with two numbers specifying the longest increasing -subsequence ending there, and the longest decreasing subsequence ending there. -We then show the pair of labels must be unique. Now if there is no increasing sequence longer than -`r` and no decreasing sequence longer than `s`, then there are at most `r * s` possible labels, -which is a contradiction if there are more than `r * s` elements. --/ -theorem erdos_szekeres {r s n : ℕ} {f : fin n → α} (hn : r * s < n) (hf : injective f) : - (∃ (t : finset (fin n)), r < t.card ∧ strict_mono_on f ↑t) ∨ - (∃ (t : finset (fin n)), s < t.card ∧ strict_anti_on f ↑t) := -begin - -- Given an index `i`, produce the set of increasing (resp., decreasing) subsequences which ends - -- at `i`. - let inc_sequences_ending_in : fin n → finset (finset (fin n)) := - λ i, univ.powerset.filter (λ t, finset.max t = some i ∧ strict_mono_on f ↑t), - let dec_sequences_ending_in : fin n → finset (finset (fin n)) := - λ i, univ.powerset.filter (λ t, finset.max t = some i ∧ strict_anti_on f ↑t), - -- The singleton sequence is in both of the above collections. - -- (This is useful to show that the maximum length subsequence is at least 1, and that the set - -- of subsequences is nonempty.) - have inc_i : ∀ i, {i} ∈ inc_sequences_ending_in i := λ i, by simp [strict_mono_on], - have dec_i : ∀ i, {i} ∈ dec_sequences_ending_in i := λ i, by simp [strict_anti_on], - -- Define the pair of labels: at index `i`, the pair is the maximum length of an increasing - -- subsequence ending at `i`, paired with the maximum length of a decreasing subsequence ending - -- at `i`. - -- We call these labels `(a_i, b_i)`. - let ab : fin n → ℕ × ℕ, - { intro i, - apply (max' ((inc_sequences_ending_in i).image card) (nonempty.image ⟨{i}, inc_i i⟩ _), - max' ((dec_sequences_ending_in i).image card) (nonempty.image ⟨{i}, dec_i i⟩ _)) }, - -- It now suffices to show that one of the labels is 'big' somewhere. In particular, if the - -- first in the pair is more than `r` somewhere, then we have an increasing subsequence in our - -- set, and if the second is more than `s` somewhere, then we have a decreasing subsequence. - suffices : ∃ i, r < (ab i).1 ∨ s < (ab i).2, - { obtain ⟨i, hi⟩ := this, - apply or.imp _ _ hi, - work_on_goal 1 { have : (ab i).1 ∈ _ := max'_mem _ _ }, - work_on_goal 2 { have : (ab i).2 ∈ _ := max'_mem _ _ }, - all_goals - { intro hi, - rw mem_image at this, - obtain ⟨t, ht₁, ht₂⟩ := this, - refine ⟨t, by rwa ht₂, _⟩, - rw mem_filter at ht₁, - apply ht₁.2.2 } }, - -- Show first that the pair of labels is unique. - have : injective ab, - { apply injective_of_lt_imp_ne, - intros i j k q, - injection q with q₁ q₂, - -- We have two cases: `f i < f j` or `f j < f i`. - -- In the former we'll show `a_i < a_j`, and in the latter we'll show `b_i < b_j`. - cases lt_or_gt_of_ne (λ _, ne_of_lt ‹i < j› (hf ‹f i = f j›)), - work_on_goal 1 { apply ne_of_lt _ q₁, have : (ab i).1 ∈ _ := max'_mem _ _ }, - work_on_goal 2 { apply ne_of_lt _ q₂, have : (ab i).2 ∈ _ := max'_mem _ _ }, - all_goals - { -- Reduce to showing there is a subsequence of length `a_i + 1` which ends at `j`. - rw nat.lt_iff_add_one_le, - apply le_max', - rw mem_image at this ⊢, - -- In particular we take the subsequence `t` of length `a_i` which ends at `i`, by definition - -- of `a_i` - rcases this with ⟨t, ht₁, ht₂⟩, - rw mem_filter at ht₁, - -- Ensure `t` ends at `i`. - have : i ∈ t.max, - simp [ht₁.2.1], - -- Now our new subsequence is given by adding `j` at the end of `t`. - refine ⟨insert j t, _, _⟩, - -- First make sure it's valid, i.e., that this subsequence ends at `j` and is increasing - { rw mem_filter, - refine ⟨_, _, _⟩, - { rw mem_powerset, apply subset_univ }, - -- It ends at `j` since `i < j`. - { convert max_insert, - rw [ht₁.2.1, option.lift_or_get_some_some, max_eq_left, with_top.some_eq_coe], - apply le_of_lt ‹i < j› }, - -- To show it's increasing (i.e., `f` is monotone increasing on `t.insert j`), we do cases - -- on what the possibilities could be - either in `t` or equals `j`. - simp only [strict_mono_on, strict_anti_on, coe_insert, set.mem_insert_iff, - mem_coe], - -- Most of the cases are just bashes. - rintros x ⟨rfl | _⟩ y ⟨rfl | _⟩ _, - { apply (irrefl _ ‹j < j›).elim }, - { exfalso, - apply not_le_of_lt (trans ‹i < j› ‹j < y›) (le_max_of_mem ‹y ∈ t› ‹i ∈ t.max›) }, - { apply lt_of_le_of_lt _ ‹f i < f j› <|> apply lt_of_lt_of_le ‹f j < f i› _, - rcases lt_or_eq_of_le (le_max_of_mem ‹x ∈ t› ‹i ∈ t.max›) with _ | rfl, - { apply le_of_lt (ht₁.2.2 ‹x ∈ t› (mem_of_max ‹i ∈ t.max›) ‹x < i›) }, - { refl } }, - { apply ht₁.2.2 ‹x ∈ t› ‹y ∈ t› ‹x < y› } }, - -- Finally show that this new subsequence is one longer than the old one. - { rw [card_insert_of_not_mem, ht₂], - intro _, - apply not_le_of_lt ‹i < j› (le_max_of_mem ‹j ∈ t› ‹i ∈ t.max›) } } }, - -- Finished both goals! - -- Now that we have uniqueness of each label, it remains to do some counting to finish off. - -- Suppose all the labels are small. - by_contra q, - push_neg at q, - -- Then the labels `(a_i, b_i)` all fit in the following set: `{ (x,y) | 1 ≤ x ≤ r, 1 ≤ y ≤ s }` - let ran : finset (ℕ × ℕ) := ((range r).image nat.succ).product ((range s).image nat.succ), - -- which we prove here. - have : image ab univ ⊆ ran, - -- First some logical shuffling - { rintro ⟨x₁, x₂⟩, - simp only [mem_image, exists_prop, mem_range, mem_univ, mem_product, true_and, prod.mk.inj_iff], - rintros ⟨i, rfl, rfl⟩, - specialize q i, - -- Show `1 ≤ a_i` and `1 ≤ b_i`, which is easy from the fact that `{i}` is a increasing and - -- decreasing subsequence which we did right near the top. - have z : 1 ≤ (ab i).1 ∧ 1 ≤ (ab i).2, - { split; - { apply le_max', - rw mem_image, - refine ⟨{i}, by solve_by_elim, card_singleton i⟩ } }, - refine ⟨_, _⟩, - -- Need to get `a_i ≤ r`, here phrased as: there is some `a < r` with `a+1 = a_i`. - { refine ⟨(ab i).1 - 1, _, nat.succ_pred_eq_of_pos z.1⟩, - rw tsub_lt_iff_right z.1, - apply nat.lt_succ_of_le q.1 }, - { refine ⟨(ab i).2 - 1, _, nat.succ_pred_eq_of_pos z.2⟩, - rw tsub_lt_iff_right z.2, - apply nat.lt_succ_of_le q.2 } }, - -- To get our contradiction, it suffices to prove `n ≤ r * s` - apply not_le_of_lt hn, - -- Which follows from considering the cardinalities of the subset above, since `ab` is injective. - simpa [nat.succ_injective, card_image_of_injective, ‹injective ab›] using card_le_of_subset this, -end diff --git a/archive/100-theorems-list/81_sum_of_prime_reciprocals_diverges.lean b/archive/100-theorems-list/81_sum_of_prime_reciprocals_diverges.lean deleted file mode 100644 index a3631a5eb4bc1..0000000000000 --- a/archive/100-theorems-list/81_sum_of_prime_reciprocals_diverges.lean +++ /dev/null @@ -1,248 +0,0 @@ -/- -Copyright (c) 2021 Manuel Candales. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Manuel Candales --/ -import topology.instances.ennreal -import algebra.squarefree - -/-! -# Divergence of the Prime Reciprocal Series - -This file proves Theorem 81 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). -The theorem states that the sum of the reciprocals of all prime numbers diverges. -The formalization follows Erdős's proof by upper and lower estimates. - -## Proof outline - -1. Assume that the sum of the reciprocals of the primes converges. -2. Then there exists a `k : ℕ` such that, for any `x : ℕ`, the sum of the reciprocals of the primes - between `k` and `x + 1` is less than 1/2 (`sum_lt_half_of_not_tendsto`). -3. For any `x : ℕ`, we can partition `range x` into two subsets (`range_sdiff_eq_bUnion`): - * `M x k`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller - than or equal to `k`; - * `U x k`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`. -4. Then `|U x k|` is bounded by the sum over the primes `p > k` of the number of multiples of `p` - in `(k, x]`, which is at most `x / p`. It follows that `|U x k|` is at most `x` times the sum of - the reciprocals of the primes between `k` and `x + 1`, which is less than 1/2 as noted in (2), so - `|U x k| < x / 2` (`card_le_mul_sum`). -5. By factoring `e + 1 = (m + 1)² * (r + 1)`, `r + 1` squarefree and `m + 1 ≤ √x`, and noting that - squarefree numbers correspond to subsets of `[1, k]`, we find that `|M x k| ≤ 2 ^ k * √x` - (`card_le_two_pow_mul_sqrt`). -6. Finally, setting `x := (2 ^ (k + 1))²` (`√x = 2 ^ (k + 1)`), we find that - `|M x k| ≤ 2 ^ k * 2 ^ (k + 1) = x / 2`. Combined with the strict bound for `|U k x|` from (4), - `x = |M x k| + |U x k| < x / 2 + x / 2 = x`. - -## References - -https://en.wikipedia.org/wiki/Divergence_of_the_sum_of_the_reciprocals_of_the_primes --/ - -open_locale big_operators -open_locale classical -open filter finset - -/-- -The primes in `(k, x]`. --/ -noncomputable def P (x k : ℕ) := {p ∈ range (x + 1) | k < p ∧ nat.prime p} - -/-- -The union over those primes `p ∈ (k, x]` of the sets of `e < x` for which `e + 1` is a multiple -of `p`, i.e., those `e < x` for which there is a prime `p ∈ (k, x]` that divides `e + 1`. --/ -noncomputable def U (x k : ℕ) := finset.bUnion (P x k) (λ p, {e ∈ range x | p ∣ e + 1}) - -/-- -Those `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to `k`. --/ -noncomputable def M (x k : ℕ) := {e ∈ range x | ∀ p : ℕ, (nat.prime p ∧ p ∣ e + 1) → p ≤ k} - -/-- -If the sum of the reciprocals of the primes converges, there exists a `k : ℕ` such that the sum of -the reciprocals of the primes greater than `k` is less than 1/2. - -More precisely, for any `x : ℕ`, the sum of the reciprocals of the primes between `k` and `x + 1` -is less than 1/2. --/ -lemma sum_lt_half_of_not_tendsto - (h : ¬ tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top) : - ∃ k, ∀ x, ∑ p in P x k, 1 / (p : ℝ) < 1 / 2 := -begin - have h0 : (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) - = λ n, ∑ p in range n, ite (nat.prime p) (1 / (p : ℝ)) 0, - { simp only [sum_filter, filter_congr_decidable, sep_def] }, - - have hf : ∀ n : ℕ, 0 ≤ ite (nat.prime n) (1 / (n : ℝ)) 0, - { intro n, split_ifs, - { simp only [one_div, inv_nonneg, nat.cast_nonneg] }, - { exact le_rfl } }, - - rw [h0, ← summable_iff_not_tendsto_nat_at_top_of_nonneg hf, summable_iff_vanishing] at h, - obtain ⟨s, h⟩ := h (set.Ioo (-1) (1/2)) (is_open_Ioo.mem_nhds (by norm_num)), - obtain ⟨k, hk⟩ := exists_nat_subset_range s, - use k, - intro x, - - rw [P, sep_def, filter_congr_decidable, ←filter_filter, sum_filter], - refine (h _ _).2, - rw disjoint_iff_ne, - simp_intros a ha b hb only [mem_filter], - exact ((mem_range.mp (hk hb)).trans ha.2).ne', -end - -/-- -Removing from {0, ..., x - 1} those elements `e` for which `e + 1` is a product of powers of primes -smaller than or equal to `k` leaves those `e` for which there is a prime `p > k` that divides -`e + 1`, or the union over those primes `p > k` of the sets of `e`s for which `e + 1` is a multiple -of `p`. --/ -lemma range_sdiff_eq_bUnion {x k : ℕ} : range x \ M x k = U x k := -begin - ext e, - simp only [mem_bUnion, not_and, mem_sdiff, sep_def, mem_filter, mem_range, U, M, P], - push_neg, - split, - { rintros ⟨hex, hexh⟩, - obtain ⟨p, ⟨hpp, hpe1⟩, hpk⟩ := hexh hex, - refine ⟨p, _, ⟨hex, hpe1⟩⟩, - exact ⟨(nat.le_of_dvd e.succ_pos hpe1).trans_lt (nat.succ_lt_succ hex), hpk, hpp⟩ }, - { rintros ⟨p, hpfilter, ⟨hex, hpe1⟩⟩, - rw imp_iff_right hex, - exact ⟨hex, ⟨p, ⟨hpfilter.2.2, hpe1⟩, hpfilter.2.1⟩⟩ }, -end - -/-- -The number of `e < x` for which `e + 1` has a prime factor `p > k` is bounded by `x` times the sum -of reciprocals of primes in `(k, x]`. --/ -lemma card_le_mul_sum {x k : ℕ} : (card (U x k) : ℝ) ≤ x * ∑ p in P x k, 1 / p := -begin - let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p}, - let N := λ p, {e ∈ range x | p ∣ e + 1}, - have h : card (finset.bUnion P N) ≤ ∑ p in P, card (N p) := card_bUnion_le, - - calc (card (finset.bUnion P N) : ℝ) - ≤ ∑ p in P, card (N p) : by assumption_mod_cast - ... ≤ ∑ p in P, x * (1 / p) : sum_le_sum (λ p hp, _) - ... = x * ∑ p in P, 1 / p : mul_sum.symm, - simp only [mul_one_div, N, sep_def, filter_congr_decidable, card_multiples, nat.cast_div_le], -end - -/-- -The number of `e < x` for which `e + 1` is a squarefree product of primes smaller than or equal to -`k` is bounded by `2 ^ k`, the number of subsets of `[1, k]`. --/ -lemma card_le_two_pow {x k : ℕ} : card {e ∈ M x k | squarefree (e + 1)} ≤ 2 ^ k := -begin - let M₁ := {e ∈ M x k | squarefree (e + 1)}, - let f := λ s, finset.prod s (λ a, a) - 1, - let K := powerset (image nat.succ (range k)), - - -- Take `e` in `M x k`. If `e + 1` is squarefree, then it is the product of a subset of `[1, k]`. - -- It follows that `e` is one less than such a product. - have h : M₁ ⊆ image f K, - { intros m hm, - simp only [M₁, M, sep_def, mem_filter, mem_range, mem_powerset, mem_image, exists_prop] at hm ⊢, - obtain ⟨⟨-, hmp⟩, hms⟩ := hm, - use (m + 1).factors, - { rwa [multiset.coe_nodup, ← nat.squarefree_iff_nodup_factors m.succ_ne_zero] }, - refine ⟨λ p, _, _⟩, - { suffices : p ∈ (m + 1).factors → ∃ a : ℕ, a < k ∧ a.succ = p, { simpa }, - simp_intros hp only [nat.mem_factors m.succ_ne_zero], - exact ⟨p.pred, (nat.pred_lt (nat.prime.ne_zero hp.1)).trans_le ((hmp p) hp), - nat.succ_pred_eq_of_pos (nat.prime.pos hp.1)⟩ }, - { simp_rw f, simp [nat.prod_factors m.succ_ne_zero, m.succ_sub_one] } }, - - -- The number of elements of `M x k` with `e + 1` squarefree is bounded by the number of subsets - -- of `[1, k]`. - calc card M₁ ≤ card (image f K) : card_le_of_subset h - ... ≤ card K : card_image_le - ... ≤ 2 ^ card (image nat.succ (range k)) : by simp only [K, card_powerset] - ... ≤ 2 ^ card (range k) : pow_le_pow one_le_two card_image_le - ... = 2 ^ k : by rw card_range k, -end - -/-- -The number of `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to -`k` is bounded by `2 ^ k * nat.sqrt x`. --/ -lemma card_le_two_pow_mul_sqrt {x k : ℕ} : card (M x k) ≤ 2 ^ k * nat.sqrt x := -begin - let M₁ := {e ∈ M x k | squarefree (e + 1)}, - let M₂ := M (nat.sqrt x) k, - let K := finset.product M₁ M₂, - let f : ℕ × ℕ → ℕ := λ mn, (mn.2 + 1) ^ 2 * (mn.1 + 1) - 1, - - -- Every element of `M x k` is one less than the product `(m + 1)² * (r + 1)` with `r + 1` - -- squarefree and `m + 1 ≤ √x`, and both `m + 1` and `r + 1` still only have prime powers - -- smaller than or equal to `k`. - have h1 : M x k ⊆ image f K, - { intros m hm, - simp only [M, M₁, M₂, mem_image, exists_prop, prod.exists, mem_product, sep_def, mem_filter, - mem_range] at hm ⊢, - have hm' := m.zero_lt_succ, - obtain ⟨a, b, hab₁, hab₂⟩ := nat.sq_mul_squarefree_of_pos' hm', - obtain ⟨ham, hbm⟩ := ⟨dvd.intro_left _ hab₁, dvd.intro _ hab₁⟩, - refine ⟨a, b, ⟨⟨⟨_, λ p hp, _⟩, hab₂⟩, ⟨_, λ p hp, _⟩⟩, by simp_rw [f, hab₁, m.succ_sub_one]⟩, - { exact (nat.succ_le_succ_iff.mp (nat.le_of_dvd hm' ham)).trans_lt hm.1 }, - { exact hm.2 p ⟨hp.1, hp.2.trans ham⟩ }, - { calc b < b + 1 : lt_add_one b - ... ≤ (m + 1).sqrt : by simpa only [nat.le_sqrt, pow_two] using nat.le_of_dvd hm' hbm - ... ≤ x.sqrt : nat.sqrt_le_sqrt (nat.succ_le_iff.mpr hm.1) }, - { exact hm.2 p ⟨hp.1, hp.2.trans (nat.dvd_of_pow_dvd one_le_two hbm)⟩ } }, - - have h2 : card M₂ ≤ nat.sqrt x, - { rw ← card_range (nat.sqrt x), apply card_le_of_subset, simp [M₂, M] }, - - calc card (M x k) ≤ card (image f K) : card_le_of_subset h1 - ... ≤ card K : card_image_le - ... = card M₁ * card M₂ : card_product M₁ M₂ - ... ≤ 2 ^ k * x.sqrt : mul_le_mul' card_le_two_pow h2, -end - -theorem real.tendsto_sum_one_div_prime_at_top : - tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top := -begin - -- Assume that the sum of the reciprocals of the primes converges. - by_contradiction h, - - -- Then there is a natural number `k` such that for all `x`, the sum of the reciprocals of primes - -- between `k` and `x` is less than 1/2. - obtain ⟨k, h1⟩ := sum_lt_half_of_not_tendsto h, - - -- Choose `x` sufficiently large for the argument below to work, and use a perfect square so we - -- can easily take the square root. - let x := 2 ^ (k + 1) * 2 ^ (k + 1), - - -- We will partition `range x` into two subsets: - -- * `M`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller - -- than or equal to `k`; - set M := M x k with hM, - - -- * `U`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`. - let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p}, - set U := U x k with hU, - - -- This is indeed a partition, so `|U| + |M| = |range x| = x`. - have h2 : x = card U + card M, - { rw [← card_range x, hU, hM, ← range_sdiff_eq_bUnion], - exact (card_sdiff_add_card_eq_card (finset.filter_subset _ _)).symm }, - - -- But for the `x` we have chosen above, both `|U|` and `|M|` are less than or equal to `x / 2`, - -- and for U, the inequality is strict. - have h3 := - calc (card U : ℝ) ≤ x * ∑ p in P, 1 / p : card_le_mul_sum - ... < x * (1 / 2) : mul_lt_mul_of_pos_left (h1 x) (by norm_num) - ... = x / 2 : mul_one_div x 2, - - have h4 := - calc (card M : ℝ) ≤ 2 ^ k * x.sqrt : by exact_mod_cast card_le_two_pow_mul_sqrt - ... = 2 ^ k * ↑(2 ^ (k + 1)) : by rw nat.sqrt_eq - ... = x / 2 : by field_simp [x, mul_right_comm, ← pow_succ'], - - refine lt_irrefl (x : ℝ) _, - calc (x : ℝ) = (card U : ℝ) + (card M : ℝ) : by assumption_mod_cast - ... < x / 2 + x / 2 : add_lt_add_of_lt_of_le h3 h4 - ... = x : add_halves ↑x, -end diff --git a/archive/100-theorems-list/82_cubing_a_cube.lean b/archive/100-theorems-list/82_cubing_a_cube.lean deleted file mode 100644 index 1f94ec93cee2c..0000000000000 --- a/archive/100-theorems-list/82_cubing_a_cube.lean +++ /dev/null @@ -1,531 +0,0 @@ -/- -Copyright (c) 2019 Floris van Doorn. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Floris van Doorn --/ -import data.fin.tuple -import data.real.basic -import data.set.intervals -import data.set.pairwise -import set_theory.cardinal.basic - -/-! -Proof that a cube (in dimension n ≥ 3) cannot be cubed: -There does not exist a partition of a cube into finitely many smaller cubes (at least two) -of different sizes. - -We follow the proof described here: -http://www.alaricstephen.com/main-featured/2017/9/28/cubing-a-cube-proof --/ - - -open real set function fin -open_locale cardinal - -noncomputable theory - -variable {n : ℕ} - -/-- Given three intervals `I, J, K` such that `J ⊂ I`, - neither endpoint of `J` coincides with an endpoint of `I`, `¬ (K ⊆ J)` and - `K` does not lie completely to the left nor completely to the right of `J`. - Then `I ∩ K \ J` is nonempty. -/ -lemma Ico_lemma {α} [linear_order α] {x₁ x₂ y₁ y₂ z₁ z₂ w : α} - (h₁ : x₁ < y₁) (hy : y₁ < y₂) (h₂ : y₂ < x₂) - (hz₁ : z₁ ≤ y₂) (hz₂ : y₁ ≤ z₂) (hw : w ∉ Ico y₁ y₂ ∧ w ∈ Ico z₁ z₂) : - ∃w, w ∈ Ico x₁ x₂ ∧ w ∉ Ico y₁ y₂ ∧ w ∈ Ico z₁ z₂ := -begin - simp only [not_and, not_lt, mem_Ico] at hw, - refine ⟨max x₁ (min w y₂), _, _, _⟩, - { simp [le_refl, lt_trans h₁ (lt_trans hy h₂), h₂] }, - { simp [hw, lt_irrefl, not_le_of_lt h₁] {contextual := tt} }, - { simp [hw.2.1, hw.2.2, hz₁, lt_of_lt_of_le h₁ hz₂] at ⊢ } -end - -/-- A (hyper)-cube (in standard orientation) is a vector `b` consisting of the bottom-left point -of the cube, a width `w` and a proof that `w > 0`. We use functions from `fin n` to denote vectors. --/ -structure cube (n : ℕ) : Type := -(b : fin n → ℝ) -- bottom-left coordinate -(w : ℝ) -- width -(hw : 0 < w) - -namespace cube -lemma hw' (c : cube n) : 0 ≤ c.w := le_of_lt c.hw - -/-- The j-th side of a cube is the half-open interval `[b j, b j + w)` -/ -def side (c : cube n) (j : fin n) : set ℝ := -Ico (c.b j) (c.b j + c.w) - -@[simp] lemma b_mem_side (c : cube n) (j : fin n) : c.b j ∈ c.side j := -by simp [side, cube.hw, le_refl] - -def to_set (c : cube n) : set (fin n → ℝ) := -{ x | ∀j, x j ∈ side c j } - -def to_set_subset {c c' : cube n} : c.to_set ⊆ c'.to_set ↔ ∀j, c.side j ⊆ c'.side j := -begin - split, intros h j x hx, - let f : fin n → ℝ := λ j', if j' = j then x else c.b j', - have : f ∈ c.to_set, - { intro j', by_cases hj' : j' = j; simp [f, hj', if_pos, if_neg, hx] }, - convert h this j, { simp [f, if_pos] }, - intros h f hf j, exact h j (hf j) -end - -def to_set_disjoint {c c' : cube n} : disjoint c.to_set c'.to_set ↔ - ∃j, disjoint (c.side j) (c'.side j) := -begin - split, intros h, classical, by_contra h', - simp only [not_disjoint_iff, classical.skolem, not_exists] at h', - cases h' with f hf, - apply not_disjoint_iff.mpr ⟨f, _, _⟩ h; intro j, exact (hf j).1, exact (hf j).2, - rintro ⟨j, hj⟩, rw [set.disjoint_iff], rintros f ⟨h1f, h2f⟩, - apply not_disjoint_iff.mpr ⟨f j, h1f j, h2f j⟩ hj -end - -lemma b_mem_to_set (c : cube n) : c.b ∈ c.to_set := -by simp [to_set] - -protected def tail (c : cube (n+1)) : cube n := -⟨tail c.b, c.w, c.hw⟩ - -lemma side_tail (c : cube (n+1)) (j : fin n) : c.tail.side j = c.side j.succ := rfl - -def bottom (c : cube (n+1)) : set (fin (n+1) → ℝ) := -{ x | x 0 = c.b 0 ∧ tail x ∈ c.tail.to_set } - -lemma b_mem_bottom (c : cube (n+1)) : c.b ∈ c.bottom := -by simp [bottom, to_set, side, cube.hw, le_refl, cube.tail] - -def xm (c : cube (n+1)) : ℝ := -c.b 0 + c.w - -lemma b_lt_xm (c : cube (n+1)) : c.b 0 < c.xm := by simp [xm, hw] -lemma b_ne_xm (c : cube (n+1)) : c.b 0 ≠ c.xm := ne_of_lt c.b_lt_xm - -def shift_up (c : cube (n+1)) : cube (n+1) := -⟨cons c.xm $ tail c.b, c.w, c.hw⟩ - -@[simp] lemma tail_shift_up (c : cube (n+1)) : c.shift_up.tail = c.tail := -by simp [shift_up, cube.tail] - -@[simp] lemma head_shift_up (c : cube (n+1)) : c.shift_up.b 0 = c.xm := rfl - -def unit_cube : cube n := -⟨λ _, 0, 1, by norm_num⟩ - -@[simp] lemma side_unit_cube {j : fin n} : unit_cube.side j = Ico 0 1 := -by norm_num [unit_cube, side] - -end cube -open cube - -variables {ι : Type} [fintype ι] {cs : ι → cube (n+1)} {i i' : ι} - -/-- A finite family of (at least 2) cubes partitioning the unit cube with different sizes -/ -def correct (cs : ι → cube n) : Prop := -pairwise (disjoint on (cube.to_set ∘ cs)) ∧ -(⋃(i : ι), (cs i).to_set) = unit_cube.to_set ∧ -injective (cube.w ∘ cs) ∧ -2 ≤ #ι ∧ -3 ≤ n - -variable (h : correct cs) - -include h -lemma to_set_subset_unit_cube {i} : (cs i).to_set ⊆ unit_cube.to_set := -by { rw [←h.2.1], exact subset_Union _ i } - -lemma side_subset {i j} : (cs i).side j ⊆ Ico 0 1 := -by { have := to_set_subset_unit_cube h, rw [to_set_subset] at this, - convert this j, norm_num [unit_cube] } - -lemma zero_le_of_mem_side {i j x} (hx : x ∈ (cs i).side j) : 0 ≤ x := -(side_subset h hx).1 - -lemma zero_le_of_mem {i p} (hp : p ∈ (cs i).to_set) (j) : 0 ≤ p j := -zero_le_of_mem_side h (hp j) - -lemma zero_le_b {i j} : 0 ≤ (cs i).b j := -zero_le_of_mem h (cs i).b_mem_to_set j - -lemma b_add_w_le_one {j} : (cs i).b j + (cs i).w ≤ 1 := -by { have := side_subset h, rw [side, Ico_subset_Ico_iff] at this, convert this.2, simp [hw] } - -/-- The width of any cube in the partition cannot be 1. -/ -lemma w_ne_one (i : ι) : (cs i).w ≠ 1 := -begin - intro hi, - have := h.2.2.2.1, rw [cardinal.two_le_iff' i] at this, cases this with i' hi', - let p := (cs i').b, - have hp : p ∈ (cs i').to_set := (cs i').b_mem_to_set, - have h2p : p ∈ (cs i).to_set, - { intro j, split, - transitivity (0 : ℝ), - { rw [←add_le_add_iff_right (1 : ℝ)], convert b_add_w_le_one h, rw hi, rw zero_add }, - apply zero_le_b h, apply lt_of_lt_of_le (side_subset h $ (cs i').b_mem_side j).2, - simp [hi, zero_le_b h] }, - apply not_disjoint_iff.mpr ⟨p, hp, h2p⟩, - apply h.1, exact hi'.symm -end - -/-- The top of a cube (which is the bottom of the cube shifted up by its width) must be covered by - bottoms of (other) cubes in the family. -/ -lemma shift_up_bottom_subset_bottoms (hc : (cs i).xm ≠ 1) : - (cs i).shift_up.bottom ⊆ ⋃(i : ι), (cs i).bottom := -begin - intros p hp, cases hp with hp0 hps, rw [tail_shift_up] at hps, - have : p ∈ (unit_cube : cube (n+1)).to_set, - { simp only [to_set, forall_fin_succ, hp0, side_unit_cube, mem_set_of_eq, mem_Ico, - head_shift_up], refine ⟨⟨_, _⟩, _⟩, - { rw [←zero_add (0 : ℝ)], apply add_le_add, apply zero_le_b h, apply (cs i).hw' }, - { exact lt_of_le_of_ne (b_add_w_le_one h) hc }, - intro j, exact side_subset h (hps j) }, - rw [←h.2.1] at this, rcases this with ⟨_, ⟨i', rfl⟩, hi'⟩, - rw [mem_Union], use i', refine ⟨_, λ j, hi' j.succ⟩, - have : i ≠ i', { rintro rfl, apply not_le_of_lt (hi' 0).2, rw [hp0], refl }, - have := h.1 i i' this, rw [on_fun, to_set_disjoint, exists_fin_succ] at this, - rcases this with h0|⟨j, hj⟩, - rw [hp0], symmetry, apply eq_of_Ico_disjoint h0 (by simp [hw]) _, - convert hi' 0, rw [hp0], refl, - exfalso, apply not_disjoint_iff.mpr ⟨tail p j, hps j, hi' j.succ⟩ hj -end -omit h - -/-- A valley is a square on which cubes in the family of cubes are placed, so that the cubes - completely cover the valley and none of those cubes is partially outside the square. - We also require that no cube on it has the same size as the valley (so that there are at least - two cubes on the valley). - This is the main concept in the formalization. - We prove that the smallest cube on a valley has another valley on the top of it, which - gives an infinite sequence of cubes in the partition, which contradicts the finiteness. - A valley is characterized by a cube `c` (which is not a cube in the family cs) by considering - the bottom face of `c`. -/ -def valley (cs : ι → cube (n+1)) (c : cube (n+1)) : Prop := -c.bottom ⊆ (⋃(i : ι), (cs i).bottom) ∧ -(∀i, (cs i).b 0 = c.b 0 → (∃x, x ∈ (cs i).tail.to_set ∩ c.tail.to_set) → - (cs i).tail.to_set ⊆ c.tail.to_set) ∧ -∀(i : ι), (cs i).b 0 = c.b 0 → (cs i).w ≠ c.w - -variables {c : cube (n+1)} (v : valley cs c) - -/-- The bottom of the unit cube is a valley -/ -lemma valley_unit_cube (h : correct cs) : valley cs unit_cube := -begin - refine ⟨_, _, _⟩, - { intro v, - simp only [bottom, and_imp, mem_Union, mem_set_of_eq], - intros h0 hv, - have : v ∈ (unit_cube : cube (n+1)).to_set, - { dsimp only [to_set, unit_cube, mem_set_of_eq], - rw [forall_fin_succ, h0], split, norm_num [side, unit_cube], exact hv }, - rw [←h.2.1] at this, rcases this with ⟨_, ⟨i, rfl⟩, hi⟩, - use i, - split, { apply le_antisymm, rw h0, exact zero_le_b h, exact (hi 0).1 }, - intro j, exact hi _ }, - { intros i hi h', rw to_set_subset, intro j, convert side_subset h using 1, simp [side_tail] }, - { intros i hi, exact w_ne_one h i } -end - -/-- the cubes which lie in the valley `c` -/ -def bcubes (cs : ι → cube (n+1)) (c : cube (n+1)) : set ι := -{ i : ι | (cs i).b 0 = c.b 0 ∧ (cs i).tail.to_set ⊆ c.tail.to_set } - -/-- A cube which lies on the boundary of a valley in dimension `j` -/ -def on_boundary (hi : i ∈ bcubes cs c) (j : fin n) : Prop := -c.b j.succ = (cs i).b j.succ ∨ (cs i).b j.succ + (cs i).w = c.b j.succ + c.w - -lemma tail_sub (hi : i ∈ bcubes cs c) : ∀j, (cs i).tail.side j ⊆ c.tail.side j := -by { rw [←to_set_subset], exact hi.2 } - -lemma bottom_mem_side (hi : i ∈ bcubes cs c) : c.b 0 ∈ (cs i).side 0 := -by { convert b_mem_side (cs i) _ using 1, rw hi.1 } - -lemma b_le_b (hi : i ∈ bcubes cs c) (j : fin n) : c.b j.succ ≤ (cs i).b j.succ := -(tail_sub hi j $ b_mem_side _ _).1 - -lemma t_le_t (hi : i ∈ bcubes cs c) (j : fin n) : - (cs i).b j.succ + (cs i).w ≤ c.b j.succ + c.w := -begin - have h' := tail_sub hi j, dsimp only [side] at h', rw [Ico_subset_Ico_iff] at h', - exact h'.2, simp [hw] -end - -include h v -/-- Every cube in the valley must be smaller than it -/ -lemma w_lt_w (hi : i ∈ bcubes cs c) : (cs i).w < c.w := -begin - apply lt_of_le_of_ne _ (v.2.2 i hi.1), - have j : fin n := ⟨1, nat.le_of_succ_le_succ h.2.2.2.2⟩, - rw [←add_le_add_iff_left ((cs i).b j.succ)], - apply le_trans (t_le_t hi j), rw [add_le_add_iff_right], apply b_le_b hi, -end - -open cardinal -/-- There are at least two cubes in a valley -/ -lemma two_le_mk_bcubes : 2 ≤ #(bcubes cs c) := -begin - rw [two_le_iff], - rcases v.1 c.b_mem_bottom with ⟨_, ⟨i, rfl⟩, hi⟩, - have h2i : i ∈ bcubes cs c := - ⟨hi.1.symm, v.2.1 i hi.1.symm ⟨tail c.b, hi.2, λ j, c.b_mem_side j.succ⟩⟩, - let j : fin (n+1) := ⟨2, h.2.2.2.2⟩, - have hj : 0 ≠ j := by { simp only [fin.ext_iff, ne.def], contradiction }, - let p : fin (n+1) → ℝ := λ j', if j' = j then c.b j + (cs i).w else c.b j', - have hp : p ∈ c.bottom, - { split, { simp only [bottom, p, if_neg hj] }, - intro j', simp only [tail, side_tail], - by_cases hj' : j'.succ = j, - { simp [p, -add_comm, if_pos, side, hj', hw', w_lt_w h v h2i] }, - { simp [p, -add_comm, if_neg hj'] }}, - rcases v.1 hp with ⟨_, ⟨i', rfl⟩, hi'⟩, - have h2i' : i' ∈ bcubes cs c := ⟨hi'.1.symm, v.2.1 i' hi'.1.symm ⟨tail p, hi'.2, hp.2⟩⟩, - refine ⟨⟨i, h2i⟩, ⟨i', h2i'⟩, _⟩, - intro hii', cases congr_arg subtype.val hii', - apply not_le_of_lt (hi'.2 ⟨1, nat.le_of_succ_le_succ h.2.2.2.2⟩).2, - simp only [-add_comm, tail, cube.tail, p], - rw [if_pos, add_le_add_iff_right], - { exact (hi.2 _).1 }, - refl -end - -/-- There is a cube in the valley -/ -lemma nonempty_bcubes : (bcubes cs c).nonempty := -begin - rw [←set.ne_empty_iff_nonempty], intro h', have := two_le_mk_bcubes h v, rw h' at this, - apply not_lt_of_le this, rw mk_emptyc, norm_cast, norm_num -end - -/-- There is a smallest cube in the valley -/ -lemma exists_mi : ∃(i : ι), i ∈ bcubes cs c ∧ ∀(i' ∈ bcubes cs c), - (cs i).w ≤ (cs i').w := -by simpa - using (bcubes cs c).exists_min_image (λ i, (cs i).w) (finite.of_fintype _) (nonempty_bcubes h v) - -/-- We let `mi` be the (index for the) smallest cube in the valley `c` -/ -def mi : ι := classical.some $ exists_mi h v - -variables {h v} -lemma mi_mem_bcubes : mi h v ∈ bcubes cs c := -(classical.some_spec $ exists_mi h v).1 - -lemma mi_minimal (hi : i ∈ bcubes cs c) : (cs $ mi h v).w ≤ (cs i).w := -(classical.some_spec $ exists_mi h v).2 i hi - -lemma mi_strict_minimal (hii' : mi h v ≠ i) (hi : i ∈ bcubes cs c) : - (cs $ mi h v).w < (cs i).w := -by { apply lt_of_le_of_ne (mi_minimal hi), apply h.2.2.1.ne, apply hii' } - -/-- The top of `mi` cannot be 1, since there is a larger cube in the valley -/ -lemma mi_xm_ne_one : (cs $ mi h v).xm ≠ 1 := -begin - apply ne_of_lt, rcases (two_le_iff' _).mp (two_le_mk_bcubes h v) with ⟨⟨i, hi⟩, h2i⟩, - swap, exact ⟨mi h v, mi_mem_bcubes⟩, - apply lt_of_lt_of_le _ (b_add_w_le_one h), exact i, exact 0, - rw [xm, mi_mem_bcubes.1, hi.1, _root_.add_lt_add_iff_left], - apply mi_strict_minimal _ hi, intro h', apply h2i, rw subtype.ext_iff_val, exact h' -end - -/-- If `mi` lies on the boundary of the valley in dimension j, then this lemma expresses that all - other cubes on the same boundary extend further from the boundary. - More precisely, there is a j-th coordinate `x : ℝ` in the valley, but not in `mi`, - such that every cube that shares a (particular) j-th coordinate with `mi` also contains j-th - coordinate `x` -/ -lemma smallest_on_boundary {j} (bi : on_boundary (mi_mem_bcubes : mi h v ∈ _) j) : - ∃(x : ℝ), x ∈ c.side j.succ \ (cs $ mi h v).side j.succ ∧ - ∀{{i'}} (hi' : i' ∈ bcubes cs c), i' ≠ mi h v → - (cs $ mi h v).b j.succ ∈ (cs i').side j.succ → x ∈ (cs i').side j.succ := -begin - let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes, - cases bi, - { refine ⟨(cs i).b j.succ + (cs i).w, ⟨_, _⟩, _⟩, - { simp [side, bi, hw', w_lt_w h v hi] }, - { intro h', simpa [i, lt_irrefl] using h'.2 }, - intros i' hi' i'_i h2i', split, - apply le_trans h2i'.1, { simp [hw'] }, - apply lt_of_lt_of_le (add_lt_add_left (mi_strict_minimal i'_i.symm hi') _), - simp [bi.symm, b_le_b hi'] }, - let s := bcubes cs c \ { i }, - have hs : s.nonempty, - { rcases (two_le_iff' (⟨i, hi⟩ : bcubes cs c)).mp (two_le_mk_bcubes h v) with ⟨⟨i', hi'⟩, h2i'⟩, - refine ⟨i', hi', _⟩, simp only [mem_singleton_iff], intro h, apply h2i', simp [h] }, - rcases set.exists_min_image s (w ∘ cs) (finite.of_fintype _) hs with ⟨i', ⟨hi', h2i'⟩, h3i'⟩, - rw [mem_singleton_iff] at h2i', - let x := c.b j.succ + c.w - (cs i').w, - have hx : x < (cs i).b j.succ, - { dsimp only [x], rw [←bi, add_sub_assoc, add_lt_iff_neg_left, sub_lt_zero], - apply mi_strict_minimal (ne.symm h2i') hi' }, - refine ⟨x, ⟨_, _⟩, _⟩, - { simp only [side, x, -add_comm, -add_assoc, neg_lt_zero, hw, add_lt_iff_neg_left, and_true, - mem_Ico, sub_eq_add_neg], - rw [add_assoc, le_add_iff_nonneg_right, ←sub_eq_add_neg, sub_nonneg], - apply le_of_lt (w_lt_w h v hi') }, - { simp only [side, not_and_distrib, not_lt, add_comm, not_le, mem_Ico], left, exact hx }, - intros i'' hi'' h2i'' h3i'', split, swap, apply lt_trans hx h3i''.2, - simp only [x], rw [le_sub_iff_add_le], - refine le_trans _ (t_le_t hi'' j), rw [add_le_add_iff_left], apply h3i' i'' ⟨hi'', _⟩, - simp [mem_singleton, h2i''] -end - -variables (h v) -/-- `mi` cannot lie on the boundary of the valley. Otherwise, the cube adjacent to it in the `j`-th - direction will intersect one of the neighbouring cubes on the same boundary as `mi`. -/ -lemma mi_not_on_boundary (j : fin n) : ¬on_boundary (mi_mem_bcubes : mi h v ∈ _) j := -begin - let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes, - rcases (two_le_iff' j).mp _ with ⟨j', hj'⟩, swap, - { rw [mk_fin, ←nat.cast_two, nat_cast_le], apply nat.le_of_succ_le_succ h.2.2.2.2 }, - intro hj, - rcases smallest_on_boundary hj with ⟨x, ⟨hx, h2x⟩, h3x⟩, - let p : fin (n+1) → ℝ := cons (c.b 0) (λ j₂, if j₂ = j then x else (cs i).b j₂.succ), - have hp : p ∈ c.bottom, - { suffices : ∀ (j' : fin n), ite (j' = j) x ((cs i).b j'.succ) ∈ c.side j'.succ, - { simpa [bottom, p, to_set, tail, side_tail] }, - intro j₂, - by_cases hj₂ : j₂ = j, { simp [hj₂, hx] }, - simp only [hj₂, if_false], apply tail_sub hi, apply b_mem_side }, - rcases v.1 hp with ⟨_, ⟨i', rfl⟩, hi'⟩, - have h2i' : i' ∈ bcubes cs c := ⟨hi'.1.symm, v.2.1 i' hi'.1.symm ⟨tail p, hi'.2, hp.2⟩⟩, - have i_i' : i ≠ i', { rintro rfl, simpa [p, side_tail, i, h2x] using hi'.2 j }, - have : nonempty ↥((cs i').tail.side j' \ (cs i).tail.side j'), - { apply nonempty_Ico_sdiff, apply mi_strict_minimal i_i' h2i', apply hw }, - rcases this with ⟨⟨x', hx'⟩⟩, - let p' : fin (n+1) → ℝ := - cons (c.b 0) (λ j₂, if j₂ = j' then x' else (cs i).b j₂.succ), - have hp' : p' ∈ c.bottom, - { suffices : ∀ (j : fin n), ite (j = j') x' ((cs i).b j.succ) ∈ c.side j.succ, - { simpa [bottom, p', to_set, tail, side_tail] }, - intro j₂, - by_cases hj₂ : j₂ = j', simp [hj₂], apply tail_sub h2i', apply hx'.1, - simp only [if_congr, if_false, hj₂], apply tail_sub hi, apply b_mem_side }, - rcases v.1 hp' with ⟨_, ⟨i'', rfl⟩, hi''⟩, - have h2i'' : i'' ∈ bcubes cs c := ⟨hi''.1.symm, v.2.1 i'' hi''.1.symm ⟨tail p', hi''.2, hp'.2⟩⟩, - have i'_i'' : i' ≠ i'', - { rintro ⟨⟩, - have : (cs i).b ∈ (cs i').to_set, - { simp only [to_set, forall_fin_succ, hi.1, bottom_mem_side h2i', true_and, mem_set_of_eq], - intro j₂, by_cases hj₂ : j₂ = j, - { simpa [side_tail, p', hj', hj₂] using hi''.2 j }, - { simpa [hj₂] using hi'.2 j₂ } }, - apply not_disjoint_iff.mpr ⟨(cs i).b, (cs i).b_mem_to_set, this⟩ (h.1 i i' i_i') }, - have i_i'' : i ≠ i'', { intro h, induction h, simpa [hx'.2] using hi''.2 j' }, - apply not.elim _ (h.1 i' i'' i'_i''), - simp only [on_fun, to_set_disjoint, not_disjoint_iff, forall_fin_succ, not_exists, comp_app], - refine ⟨⟨c.b 0, bottom_mem_side h2i', bottom_mem_side h2i''⟩, _⟩, - intro j₂, - by_cases hj₂ : j₂ = j, - { cases hj₂, refine ⟨x, _, _⟩, - { convert hi'.2 j, simp [p] }, - apply h3x h2i'' i_i''.symm, convert hi''.2 j, simp [p', hj'] }, - by_cases h2j₂ : j₂ = j', - { cases h2j₂, refine ⟨x', hx'.1, _⟩, convert hi''.2 j', simp }, - refine ⟨(cs i).b j₂.succ, _, _⟩, - { convert hi'.2 j₂, simp [hj₂] }, - { convert hi''.2 j₂, simp [h2j₂] } -end - -variables {h v} -/-- The same result that `mi` cannot lie on the boundary of the valley written as inequalities. -/ -lemma mi_not_on_boundary' (j : fin n) : c.tail.b j < (cs (mi h v)).tail.b j ∧ - (cs (mi h v)).tail.b j + (cs (mi h v)).w < c.tail.b j + c.w := -begin - have := mi_not_on_boundary h v j, - simp only [on_boundary, not_or_distrib] at this, cases this with h1 h2, - split, - apply lt_of_le_of_ne (b_le_b mi_mem_bcubes _) h1, - apply lt_of_le_of_ne _ h2, - apply ((Ico_subset_Ico_iff _).mp (tail_sub mi_mem_bcubes j)).2, - simp [hw] -end - -/-- The top of `mi` gives rise to a new valley, since the neighbouring cubes extend further upward - than `mi`. -/ -def valley_mi : valley cs ((cs (mi h v)).shift_up) := -begin - let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes, - refine ⟨_, _, _⟩, - { intro p, apply shift_up_bottom_subset_bottoms h mi_xm_ne_one }, - { rintros i' hi' ⟨p2, hp2, h2p2⟩, simp only [head_shift_up] at hi', classical, by_contra h2i', - rw [tail_shift_up] at h2p2, simp only [not_subset, tail_shift_up] at h2i', - rcases h2i' with ⟨p1, hp1, h2p1⟩, - have : ∃p3, p3 ∈ (cs i').tail.to_set ∧ p3 ∉ (cs i).tail.to_set ∧ p3 ∈ c.tail.to_set, - { simp only [to_set, not_forall, mem_set_of_eq] at h2p1, cases h2p1 with j hj, - rcases Ico_lemma (mi_not_on_boundary' j).1 (by simp [hw]) (mi_not_on_boundary' j).2 - (le_trans (hp2 j).1 $ le_of_lt (h2p2 j).2) - (le_trans (h2p2 j).1 $ le_of_lt (hp2 j).2) ⟨hj, hp1 j⟩ with ⟨w, hw, h2w, h3w⟩, - refine ⟨λ j', if j' = j then w else p2 j', _, _, _⟩, - { intro j', by_cases h : j' = j, - { simp only [if_pos h], convert h3w }, - { simp only [if_neg h], exact hp2 j' } }, - { simp only [to_set, not_forall, mem_set_of_eq], use j, rw [if_pos rfl], convert h2w }, - { intro j', by_cases h : j' = j, - { simp only [if_pos h, side_tail], convert hw }, - { simp only [if_neg h], apply hi.2, apply h2p2 } } }, - rcases this with ⟨p3, h1p3, h2p3, h3p3⟩, - let p := @cons n (λ_, ℝ) (c.b 0) p3, - have hp : p ∈ c.bottom, { refine ⟨rfl, _⟩, rwa [tail_cons] }, - rcases v.1 hp with ⟨_, ⟨i'', rfl⟩, hi''⟩, - have h2i'' : i'' ∈ bcubes cs c, - { use hi''.1.symm, apply v.2.1 i'' hi''.1.symm, - use tail p, split, exact hi''.2, rw [tail_cons], exact h3p3 }, - have h3i'' : (cs i).w < (cs i'').w, - { apply mi_strict_minimal _ h2i'', rintro rfl, apply h2p3, convert hi''.2, rw [tail_cons] }, - let p' := @cons n (λ_, ℝ) (cs i).xm p3, - have hp' : p' ∈ (cs i').to_set, - { simpa [to_set, forall_fin_succ, p', hi'.symm] using h1p3 }, - have h2p' : p' ∈ (cs i'').to_set, - { simp only [to_set, forall_fin_succ, p', cons_succ, cons_zero, mem_set_of_eq], - refine ⟨_, by simpa [to_set, p] using hi''.2⟩, - have : (cs i).b 0 = (cs i'').b 0, { rw [hi.1, h2i''.1] }, - simp [side, hw', xm, this, h3i''] }, - apply not_disjoint_iff.mpr ⟨p', hp', h2p'⟩, - apply h.1, rintro rfl, apply (cs i).b_ne_xm, rw [←hi', ←hi''.1, hi.1], refl }, - { intros i' hi' h2i', - dsimp only [shift_up] at h2i', - replace h2i' := h.2.2.1 h2i'.symm, - induction h2i', - exact b_ne_xm (cs i) hi' } -end - -variables (h) -omit v - -/-- We get a sequence of cubes whose size is decreasing -/ -noncomputable def sequence_of_cubes : ℕ → { i : ι // valley cs ((cs i).shift_up) } -| 0 := let v := valley_unit_cube h in ⟨mi h v, valley_mi⟩ -| (k+1) := let v := (sequence_of_cubes k).2 in ⟨mi h v, valley_mi⟩ - -def decreasing_sequence (k : ℕ) : ℝ := (cs (sequence_of_cubes h k).1).w - -lemma strict_anti_sequence_of_cubes : strict_anti $ decreasing_sequence h := -strict_anti_nat_of_succ_lt $ λ k, -begin - let v := (sequence_of_cubes h k).2, dsimp only [decreasing_sequence, sequence_of_cubes], - apply w_lt_w h v (mi_mem_bcubes : mi h v ∈ _), -end - -omit h -/-- The infinite sequence of cubes contradicts the finiteness of the family. -/ -theorem not_correct : ¬correct cs := -begin - intro h, apply (lt_omega_of_fintype ι).not_le, - rw [omega, lift_id], fapply mk_le_of_injective, exact λ n, (sequence_of_cubes h n).1, - intros n m hnm, apply (strict_anti_sequence_of_cubes h).injective, - dsimp only [decreasing_sequence], rw hnm -end - -/-- **Dissection of Cubes**: A cube cannot be cubed. -/ -theorem cannot_cube_a_cube : - ∀{n : ℕ}, n ≥ 3 → -- In ℝ^n for n ≥ 3 - ∀{ι : Type} [fintype ι] {cs : ι → cube n}, -- given a finite collection of (hyper)cubes - 2 ≤ #ι → -- containing at least two elements - pairwise (disjoint on (cube.to_set ∘ cs)) → -- which is pairwise disjoint - (⋃(i : ι), (cs i).to_set) = unit_cube.to_set → -- whose union is the unit cube - injective (cube.w ∘ cs) → -- such that the widths of all cubes are different - false := -- then we can derive a contradiction -begin - intros n hn ι hι cs h1 h2 h3 h4, resetI, - rcases n, cases hn, - exact not_correct ⟨h2, h3, h4, h1, hn⟩ -end diff --git a/archive/100-theorems-list/83_friendship_graphs.lean b/archive/100-theorems-list/83_friendship_graphs.lean deleted file mode 100644 index 0e4f03120b234..0000000000000 --- a/archive/100-theorems-list/83_friendship_graphs.lean +++ /dev/null @@ -1,338 +0,0 @@ -/- -Copyright (c) 2020 Aaron Anderson. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Aaron Anderson, Jalex Stark, Kyle Miller --/ -import combinatorics.simple_graph.adj_matrix -import linear_algebra.matrix.charpoly.finite_field -import data.int.modeq -import data.zmod.basic -import tactic.interval_cases - -/-! -# The Friendship Theorem - -## Definitions and Statement -- A `friendship` graph is one in which any two distinct vertices have exactly one neighbor in common -- A `politician`, at least in the context of this problem, is a vertex in a graph which is adjacent - to every other vertex. -- The friendship theorem (Erdős, Rényi, Sós 1966) states that every finite friendship graph has a - politician. - -## Proof outline -The proof revolves around the theory of adjacency matrices, although some steps could equivalently -be phrased in terms of counting walks. -- Assume `G` is a finite friendship graph. -- First we show that any two nonadjacent vertices have the same degree -- Assume for contradiction that `G` does not have a politician. -- Conclude from the last two points that `G` is `d`-regular for some `d : ℕ`. -- Show that `G` has `d ^ 2 - d + 1` vertices. -- By casework, show that if `d = 0, 1, 2`, then `G` has a politician. -- If `3 ≤ d`, let `p` be a prime factor of `d - 1`. -- If `A` is the adjacency matrix of `G` with entries in `ℤ/pℤ`, we show that `A ^ p` has trace `1`. -- This gives a contradiction, as `A` has trace `0`, and thus `A ^ p` has trace `0`. - -## References -- [P. Erdős, A. Rényi, V. Sós, *On A Problem of Graph Theory*][erdosrenyisos] -- [C. Huneke, *The Friendship Theorem*][huneke2002] - --/ - -open_locale classical big_operators -noncomputable theory - -open finset simple_graph matrix - -universes u v -variables {V : Type u} {R : Type v} [semiring R] - -section friendship_def -variables (G : simple_graph V) - -/-- -This property of a graph is the hypothesis of the friendship theorem: -every pair of nonadjacent vertices has exactly one common friend, -a vertex to which both are adjacent. --/ -def friendship [fintype V] : Prop := ∀ ⦃v w : V⦄, v ≠ w → fintype.card (G.common_neighbors v w) = 1 - -/-- -A politician is a vertex that is adjacent to all other vertices. --/ -def exists_politician : Prop := ∃ (v : V), ∀ (w : V), v ≠ w → G.adj v w - -end friendship_def - -variables [fintype V] {G : simple_graph V} {d : ℕ} (hG : friendship G) -include hG - -namespace friendship - -variables (R) -/-- One characterization of a friendship graph is that there is exactly one walk of length 2 - between distinct vertices. These walks are counted in off-diagonal entries of the square of - the adjacency matrix, so for a friendship graph, those entries are all 1. -/ -theorem adj_matrix_sq_of_ne {v w : V} (hvw : v ≠ w) : - ((G.adj_matrix R) ^ 2) v w = 1 := -begin - rw [sq, ← nat.cast_one, ← hG hvw], - simp [common_neighbors, neighbor_finset_eq_filter, finset.filter_filter, finset.filter_inter, - and_comm, ← neighbor_finset_def], -end - -/-- This calculation amounts to counting the number of length 3 walks between nonadjacent vertices. - We use it to show that nonadjacent vertices have equal degrees. -/ -lemma adj_matrix_pow_three_of_not_adj {v w : V} (non_adj : ¬ G.adj v w) : - ((G.adj_matrix R) ^ 3) v w = degree G v := -begin - rw [pow_succ, mul_eq_mul, adj_matrix_mul_apply, degree, card_eq_sum_ones, nat.cast_sum], - apply sum_congr rfl, - intros x hx, - rw [adj_matrix_sq_of_ne _ hG, nat.cast_one], - rintro ⟨rfl⟩, - rw mem_neighbor_finset at hx, - exact non_adj hx, -end - -variable {R} - -/-- As `v` and `w` not being adjacent implies - `degree G v = ((G.adj_matrix R) ^ 3) v w` and `degree G w = ((G.adj_matrix R) ^ 3) v w`, - the degrees are equal if `((G.adj_matrix R) ^ 3) v w = ((G.adj_matrix R) ^ 3) w v` - - This is true as the adjacency matrix is symmetric. -/ -lemma degree_eq_of_not_adj {v w : V} (hvw : ¬ G.adj v w) : - degree G v = degree G w := -begin - rw [← nat.cast_id (G.degree v), ← nat.cast_id (G.degree w), - ← adj_matrix_pow_three_of_not_adj ℕ hG hvw, - ← adj_matrix_pow_three_of_not_adj ℕ hG (λ h, hvw (G.symm h))], - conv_lhs {rw ← transpose_adj_matrix}, - simp only [pow_succ, sq, mul_eq_mul, ← transpose_mul, transpose_apply], - simp only [← mul_eq_mul, mul_assoc], -end - -/-- Let `A` be the adjacency matrix of a graph `G`. - If `G` is a friendship graph, then all of the off-diagonal entries of `A^2` are 1. - If `G` is `d`-regular, then all of the diagonal entries of `A^2` are `d`. - Putting these together determines `A^2` exactly for a `d`-regular friendship graph. -/ -theorem adj_matrix_sq_of_regular (hd : G.is_regular_of_degree d) : - ((G.adj_matrix R) ^ 2) = λ v w, if v = w then d else 1 := -begin - ext v w, by_cases h : v = w, - { rw [h, sq, mul_eq_mul, adj_matrix_mul_self_apply_self, hd], simp, }, - { rw [adj_matrix_sq_of_ne R hG h, if_neg h], }, -end - -lemma adj_matrix_sq_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) - (hd : G.is_regular_of_degree d) : - (G.adj_matrix (zmod p)) ^ 2 = λ _ _, 1 := -by simp [adj_matrix_sq_of_regular hG hd, dmod] - -section nonempty - -variable [nonempty V] - -/-- If `G` is a friendship graph without a politician (a vertex adjacent to all others), then - it is regular. We have shown that nonadjacent vertices of a friendship graph have the same degree, - and if there isn't a politician, we can show this for adjacent vertices by finding a vertex - neither is adjacent to, and then using transitivity. -/ -theorem is_regular_of_not_exists_politician (hG' : ¬exists_politician G) : - ∃ (d : ℕ), G.is_regular_of_degree d := -begin - have v := classical.arbitrary V, - use G.degree v, - intro x, - by_cases hvx : G.adj v x, swap, { exact (degree_eq_of_not_adj hG hvx).symm, }, - dunfold exists_politician at hG', - push_neg at hG', - rcases hG' v with ⟨w, hvw', hvw⟩, - rcases hG' x with ⟨y, hxy', hxy⟩, - by_cases hxw : G.adj x w, - swap, { rw degree_eq_of_not_adj hG hvw, exact degree_eq_of_not_adj hG hxw }, - rw degree_eq_of_not_adj hG hxy, - by_cases hvy : G.adj v y, - swap, { exact (degree_eq_of_not_adj hG hvy).symm }, - rw degree_eq_of_not_adj hG hvw, - apply degree_eq_of_not_adj hG, - intro hcontra, - rcases finset.card_eq_one.mp (hG hvw') with ⟨⟨a, ha⟩, h⟩, - have key : ∀ {x}, x ∈ G.common_neighbors v w → x = a, - { intros x hx, - have h' := mem_univ (subtype.mk x hx), - rw [h, mem_singleton] at h', - injection h', }, - apply hxy', - rw [key ((mem_common_neighbors G).mpr ⟨hvx, G.symm hxw⟩), - key ((mem_common_neighbors G).mpr ⟨hvy, G.symm hcontra⟩)], -end - -/-- Let `A` be the adjacency matrix of a `d`-regular friendship graph, and let `v` be a vector - all of whose components are `1`. Then `v` is an eigenvector of `A ^ 2`, and we can compute - the eigenvalue to be `d * d`, or as `d + (fintype.card V - 1)`, so those quantities must be equal. - - This essentially means that the graph has `d ^ 2 - d + 1` vertices. -/ -lemma card_of_regular (hd : G.is_regular_of_degree d) : - d + (fintype.card V - 1) = d * d := -begin - have v := classical.arbitrary V, - transitivity ((G.adj_matrix ℕ) ^ 2).mul_vec (λ _, 1) v, - { rw [adj_matrix_sq_of_regular hG hd, mul_vec, dot_product, ← insert_erase (mem_univ v)], - simp only [sum_insert, mul_one, if_true, nat.cast_id, eq_self_iff_true, - mem_erase, not_true, ne.def, not_false_iff, add_right_inj, false_and], - rw [finset.sum_const_nat, card_erase_of_mem (mem_univ v), mul_one], { refl }, - intros x hx, simp [(ne_of_mem_erase hx).symm], }, - { rw [sq, mul_eq_mul, ← mul_vec_mul_vec], - simp [adj_matrix_mul_vec_const_apply_of_regular hd, neighbor_finset, - card_neighbor_set_eq_degree, hd v], } -end - -/-- The size of a `d`-regular friendship graph is `1 mod (d-1)`, and thus `1 mod p` for a - factor `p ∣ d-1`. -/ -lemma card_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) (hd : G.is_regular_of_degree d) : - (fintype.card V : zmod p) = 1 := -begin - have hpos : 0 < fintype.card V := fintype.card_pos_iff.mpr infer_instance, - rw [← nat.succ_pred_eq_of_pos hpos, nat.succ_eq_add_one, nat.pred_eq_sub_one], - simp only [add_left_eq_self, nat.cast_add, nat.cast_one], - have h := congr_arg (λ n, (↑n : zmod p)) (card_of_regular hG hd), - revert h, simp [dmod], -end - -end nonempty - -omit hG - -lemma adj_matrix_sq_mul_const_one_of_regular (hd : G.is_regular_of_degree d) : - (G.adj_matrix R) * (λ _ _, 1) = λ _ _, d := -by { ext x, simp [← hd x, degree] } - -lemma adj_matrix_mul_const_one_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) - (hd : G.is_regular_of_degree d) : - (G.adj_matrix (zmod p)) * (λ _ _, 1) = λ _ _, 1 := -by rw [adj_matrix_sq_mul_const_one_of_regular hd, dmod] - -include hG - -/-- Modulo a factor of `d-1`, the square and all higher powers of the adjacency matrix - of a `d`-regular friendship graph reduce to the matrix whose entries are all 1. -/ -lemma adj_matrix_pow_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) - (hd : G.is_regular_of_degree d) {k : ℕ} (hk : 2 ≤ k) : - (G.adj_matrix (zmod p)) ^ k = λ _ _, 1 := -begin - iterate 2 {cases k with k, { exfalso, linarith, }, }, - induction k with k hind, - { exact adj_matrix_sq_mod_p_of_regular hG dmod hd, }, - rw [pow_succ, hind (nat.le_add_left 2 k)], - exact adj_matrix_mul_const_one_mod_p_of_regular dmod hd, -end - -variable [nonempty V] - -/-- This is the main proof. Assuming that `3 ≤ d`, we take `p` to be a prime factor of `d-1`. - Then the `p`th power of the adjacency matrix of a `d`-regular friendship graph must have trace 1 - mod `p`, but we can also show that the trace must be the `p`th power of the trace of the original - adjacency matrix, which is 0, a contradiction. --/ -lemma false_of_three_le_degree (hd : G.is_regular_of_degree d) (h : 3 ≤ d) : false := -begin - -- get a prime factor of d - 1 - let p : ℕ := (d - 1).min_fac, - have p_dvd_d_pred := (zmod.nat_coe_zmod_eq_zero_iff_dvd _ _).mpr (d - 1).min_fac_dvd, - have dpos : 0 < d := by linarith, - have d_cast : ↑(d - 1) = (d : ℤ) - 1 := by norm_cast, - haveI : fact p.prime := ⟨nat.min_fac_prime (by linarith)⟩, - have hp2 : 2 ≤ p := (fact.out p.prime).two_le, - have dmod : (d : zmod p) = 1, - { rw [← nat.succ_pred_eq_of_pos dpos, nat.succ_eq_add_one, nat.pred_eq_sub_one], - simp only [add_left_eq_self, nat.cast_add, nat.cast_one], - exact p_dvd_d_pred, }, - have Vmod := card_mod_p_of_regular hG dmod hd, - -- now we reduce to a trace calculation - have := zmod.trace_pow_card (G.adj_matrix (zmod p)), - contrapose! this, clear this, - -- the trace is 0 mod p when computed one way - rw [trace_adj_matrix, zero_pow (fact.out p.prime).pos], - -- but the trace is 1 mod p when computed the other way - rw adj_matrix_pow_mod_p_of_regular hG dmod hd hp2, - dunfold fintype.card at Vmod, - simp only [matrix.trace, matrix.diag, mul_one, nsmul_eq_mul, linear_map.coe_mk, sum_const], - rw [Vmod, ← nat.cast_one, zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.dvd_one, - nat.min_fac_eq_one_iff], - linarith, -end - -/-- If `d ≤ 1`, a `d`-regular friendship graph has at most one vertex, which is - trivially a politician. -/ -lemma exists_politician_of_degree_le_one (hd : G.is_regular_of_degree d) (hd1 : d ≤ 1) : - exists_politician G := -begin - have sq : d * d = d := by { interval_cases d; norm_num }, - have h := card_of_regular hG hd, - rw sq at h, - have : fintype.card V ≤ 1, - { cases fintype.card V with n, - { exact zero_le _, }, - { have : n = 0, - { rw [nat.succ_sub_succ_eq_sub, tsub_zero] at h, - linarith }, - subst n, } }, - use classical.arbitrary V, - intros w h, exfalso, - apply h, - apply fintype.card_le_one_iff.mp this, -end - -/-- If `d = 2`, a `d`-regular friendship graph has 3 vertices, so it must be complete graph, - and all the vertices are politicians. -/ -lemma neighbor_finset_eq_of_degree_eq_two (hd : G.is_regular_of_degree 2) (v : V) : - G.neighbor_finset v = finset.univ.erase v := -begin - apply finset.eq_of_subset_of_card_le, - { rw finset.subset_iff, - intro x, - rw [mem_neighbor_finset, finset.mem_erase], - exact λ h, ⟨(G.ne_of_adj h).symm, finset.mem_univ _⟩ }, - convert_to 2 ≤ _, - { convert_to _ = fintype.card V - 1, - { have hfr:= card_of_regular hG hd, - linarith }, - { exact finset.card_erase_of_mem (finset.mem_univ _), }, }, - { dsimp [is_regular_of_degree, degree] at hd, - rw hd, } -end - -lemma exists_politician_of_degree_eq_two (hd : G.is_regular_of_degree 2) : - exists_politician G := -begin - have v := classical.arbitrary V, - use v, - intros w hvw, - rw [← mem_neighbor_finset, neighbor_finset_eq_of_degree_eq_two hG hd v, finset.mem_erase], - exact ⟨hvw.symm, finset.mem_univ _⟩, -end - -lemma exists_politician_of_degree_le_two (hd : G.is_regular_of_degree d) (h : d ≤ 2) : - exists_politician G := -begin - interval_cases d, - iterate 2 { apply exists_politician_of_degree_le_one hG hd, norm_num }, - { exact exists_politician_of_degree_eq_two hG hd }, -end - -end friendship - -/-- **Friendship theorem**: We wish to show that a friendship graph has a politician (a vertex - adjacent to all others). We proceed by contradiction, and assume the graph has no politician. - We have already proven that a friendship graph with no politician is `d`-regular for some `d`, - and now we do casework on `d`. - If the degree is at most 2, we observe by casework that it has a politician anyway. - If the degree is at least 3, the graph cannot exist. -/ -theorem friendship_theorem [nonempty V] : exists_politician G := -begin - by_contradiction npG, - rcases hG.is_regular_of_not_exists_politician npG with ⟨d, dreg⟩, - cases lt_or_le d 3 with dle2 dge3, - { exact npG (hG.exists_politician_of_degree_le_two dreg (nat.lt_succ_iff.mp dle2)) }, - { exact hG.false_of_three_le_degree dreg dge3 }, -end diff --git a/archive/100-theorems-list/93_birthday_problem.lean b/archive/100-theorems-list/93_birthday_problem.lean deleted file mode 100644 index ead237087de6e..0000000000000 --- a/archive/100-theorems-list/93_birthday_problem.lean +++ /dev/null @@ -1,26 +0,0 @@ -/- -Copyright (c) 2021 Eric Rodriguez. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Eric Rodriguez --/ -import data.fintype.card_embedding - -/-! -# Birthday Problem - -This file proves Theorem 93 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). - -As opposed to the standard probabilistic statement, we instead state the birthday problem -in terms of injective functions. The general result about `fintype.card (α ↪ β)` which this proof -uses is `fintype.card_embedding_eq`. --/ - -local notation `‖` x `‖` := fintype.card x - -/-- **Birthday Problem** -/ -theorem birthday : - 2 * ‖fin 23 ↪ fin 365‖ < ‖fin 23 → fin 365‖ ∧ 2 * ‖fin 22 ↪ fin 365‖ > ‖fin 22 → fin 365‖ := -begin - simp only [nat.desc_factorial, fintype.card_fin, fintype.card_embedding_eq, fintype.card_fun], - norm_num -end diff --git a/archive/100-theorems-list/9_area_of_a_circle.lean b/archive/100-theorems-list/9_area_of_a_circle.lean deleted file mode 100644 index 771f6b2d9f1a6..0000000000000 --- a/archive/100-theorems-list/9_area_of_a_circle.lean +++ /dev/null @@ -1,116 +0,0 @@ -/- -Copyright (c) 2021 James Arthur, Benjamin Davidson, Andrew Souther. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: James Arthur, Benjamin Davidson, Andrew Souther --/ -import measure_theory.integral.interval_integral -import analysis.special_functions.sqrt -import analysis.special_functions.trigonometric.inverse_deriv - -/-! -# Freek № 9: The Area of a Circle - -In this file we show that the area of a disc with nonnegative radius `r` is `π * r^2`. The main -tools our proof uses are `volume_region_between_eq_integral`, which allows us to represent the area -of the disc as an integral, and `interval_integral.integral_eq_sub_of_has_deriv_at'_of_le`, the -second fundamental theorem of calculus. - -We begin by defining `disc` in `ℝ × ℝ`, then show that `disc` can be represented as the -`region_between` two functions. - -Though not necessary for the main proof, we nonetheless choose to include a proof of the -measurability of the disc in order to convince the reader that the set whose volume we will be -calculating is indeed measurable and our result is therefore meaningful. - -In the main proof, `area_disc`, we use `volume_region_between_eq_integral` followed by -`interval_integral.integral_of_le` to reduce our goal to a single `interval_integral`: - `∫ (x : ℝ) in -r..r, 2 * sqrt (r ^ 2 - x ^ 2) = π * r ^ 2`. -After disposing of the trivial case `r = 0`, we show that `λ x, 2 * sqrt (r ^ 2 - x ^ 2)` is equal -to the derivative of `λ x, r ^ 2 * arcsin (x / r) + x * sqrt (r ^ 2 - x ^ 2)` everywhere on -`Ioo (-r) r` and that those two functions are continuous, then apply the second fundamental theorem -of calculus with those facts. Some simple algebra then completes the proof. - -Note that we choose to define `disc` as a set of points in `ℝ × ℝ`. This is admittedly not ideal; it -would be more natural to define `disc` as a `metric.ball` in `euclidean_space ℝ (fin 2)` (as well as -to provide a more general proof in higher dimensions). However, our proof indirectly relies on a -number of theorems (particularly `measure_theory.measure.prod_apply`) which do not yet exist for -Euclidean space, thus forcing us to use this less-preferable definition. As `measure_theory.pi` -continues to develop, it should eventually become possible to redefine `disc` and extend our proof -to the n-ball. --/ - -open set real measure_theory interval_integral -open_locale real nnreal - -/-- A disc of radius `r` is defined as the collection of points `(p.1, p.2)` in `ℝ × ℝ` such that - `p.1 ^ 2 + p.2 ^ 2 < r ^ 2`. - Note that this definition is not equivalent to `metric.ball (0 : ℝ × ℝ) r`. This was done - intentionally because `dist` in `ℝ × ℝ` is defined as the uniform norm, making the `metric.ball` - in `ℝ × ℝ` a square, not a disc. - See the module docstring for an explanation of why we don't define the disc in Euclidean space. -/ -def disc (r : ℝ) := {p : ℝ × ℝ | p.1 ^ 2 + p.2 ^ 2 < r ^ 2} - -variable (r : ℝ≥0) - -/-- A disc of radius `r` can be represented as the region between the two curves - `λ x, - sqrt (r ^ 2 - x ^ 2)` and `λ x, sqrt (r ^ 2 - x ^ 2)`. -/ -lemma disc_eq_region_between : - disc r = region_between (λ x, -sqrt (r^2 - x^2)) (λ x, sqrt (r^2 - x^2)) (Ioc (-r) r) := -begin - ext p, - simp only [disc, region_between, mem_set_of_eq, mem_Ioo, mem_Ioc, pi.neg_apply], - split; - intro h, - { cases abs_lt_of_sq_lt_sq' (lt_of_add_lt_of_nonneg_left h (sq_nonneg p.2)) r.2, - rw [add_comm, ← lt_sub_iff_add_lt] at h, - exact ⟨⟨left, right.le⟩, sq_lt.mp h⟩ }, - { rw [add_comm, ← lt_sub_iff_add_lt], - exact sq_lt.mpr h.2 }, -end - -/-- The disc is a `measurable_set`. -/ -theorem measurable_set_disc : measurable_set (disc r) := -by apply measurable_set_lt; apply continuous.measurable; continuity - -/-- **Area of a Circle**: The area of a disc with radius `r` is `π * r ^ 2`. -/ -theorem area_disc : volume (disc r) = nnreal.pi * r ^ 2 := -begin - let f := λ x, sqrt (r ^ 2 - x ^ 2), - let F := λ x, (r:ℝ) ^ 2 * arcsin (r⁻¹ * x) + x * sqrt (r ^ 2 - x ^ 2), - have hf : continuous f := by continuity, - suffices : ∫ x in -r..r, 2 * f x = nnreal.pi * r ^ 2, - { have h : integrable_on f (Ioc (-r) r) := - hf.integrable_on_Icc.mono_set Ioc_subset_Icc_self, - calc volume (disc r) - = volume (region_between (λ x, -f x) f (Ioc (-r) r)) : by rw disc_eq_region_between - ... = ennreal.of_real (∫ x in Ioc (-r:ℝ) r, (f - has_neg.neg ∘ f) x) : - volume_region_between_eq_integral - h.neg h measurable_set_Ioc (λ x hx, neg_le_self (sqrt_nonneg _)) - ... = ennreal.of_real (∫ x in (-r:ℝ)..r, 2 * f x) : by simp [two_mul, integral_of_le] - ... = nnreal.pi * r ^ 2 : by rw_mod_cast [this, ← ennreal.coe_nnreal_eq], }, - obtain ⟨hle, (heq | hlt)⟩ := ⟨nnreal.coe_nonneg r, hle.eq_or_lt⟩, { simp [← heq] }, - have hderiv : ∀ x ∈ Ioo (-r:ℝ) r, has_deriv_at F (2 * f x) x, - { rintros x ⟨hx1, hx2⟩, - convert ((has_deriv_at_const x ((r:ℝ)^2)).mul ((has_deriv_at_arcsin _ _).comp x - ((has_deriv_at_const x (r:ℝ)⁻¹).mul (has_deriv_at_id' x)))).add - ((has_deriv_at_id' x).mul (((has_deriv_at_id' x).pow.const_sub ((r:ℝ)^2)).sqrt _)), - { have h : sqrt (1 - x ^ 2 / r ^ 2) * r = sqrt (r ^ 2 - x ^ 2), - { rw [← sqrt_sq hle, ← sqrt_mul, sub_mul, sqrt_sq hle, div_mul_eq_mul_div_comm, - div_self (pow_ne_zero 2 hlt.ne'), one_mul, mul_one], - simpa [sqrt_sq hle, div_le_one (pow_pos hlt 2)] using sq_le_sq' hx1.le hx2.le }, - field_simp, - rw [h, mul_left_comm, ← sq, neg_mul_eq_mul_neg, mul_div_mul_left (-x^2) _ two_ne_zero, - add_left_comm, div_add_div_same, tactic.ring.add_neg_eq_sub, div_sqrt, two_mul] }, - { suffices : -(1:ℝ) < r⁻¹ * x, by exact this.ne', - calc -(1:ℝ) = r⁻¹ * -r : by simp [hlt.ne'] - ... < r⁻¹ * x : by nlinarith [inv_pos.mpr hlt] }, - { suffices : (r:ℝ)⁻¹ * x < 1, by exact this.ne, - calc (r:ℝ)⁻¹ * x < r⁻¹ * r : by nlinarith [inv_pos.mpr hlt] - ... = 1 : inv_mul_cancel hlt.ne' }, - { nlinarith } }, - have hcont := (by continuity : continuous F).continuous_on, - calc ∫ x in -r..r, 2 * f x - = F r - F (-r) : integral_eq_sub_of_has_deriv_at_of_le (neg_le_self r.2) - hcont hderiv (continuous_const.mul hf).continuous_on.interval_integrable - ... = nnreal.pi * r ^ 2 : by norm_num [F, inv_mul_cancel hlt.ne', ← mul_div_assoc, mul_comm π], -end diff --git a/archive/arithcc.lean b/archive/arithcc.lean index 9de0770bbd8f2..f1feb07fa6173 100644 --- a/archive/arithcc.lean +++ b/archive/arithcc.lean @@ -9,6 +9,9 @@ import tactic.basic /-! # A compiler for arithmetic expressions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A formalization of the correctness of a compiler from arithmetic expressions to machine language described by McCarthy and Painter, which is considered the first proof of compiler correctness. diff --git a/archive/examples/mersenne_primes.lean b/archive/examples/mersenne_primes.lean index 2c5a28bdbea00..af4166ff31ebc 100644 --- a/archive/examples/mersenne_primes.lean +++ b/archive/examples/mersenne_primes.lean @@ -8,6 +8,9 @@ import number_theory.lucas_lehmer /-! # Explicit Mersenne primes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We run some Lucas-Lehmer tests to prove some Mersenne primes are prime. See the discussion at the end of [src/number_theory/lucas_lehmer.lean] diff --git a/archive/examples/prop_encodable.lean b/archive/examples/prop_encodable.lean index 64da2837b4f0b..d2436fd06f034 100644 --- a/archive/examples/prop_encodable.lean +++ b/archive/examples/prop_encodable.lean @@ -9,6 +9,9 @@ import data.W.basic /-! # W types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The file `data/W.lean` shows that if `α` is an an encodable fintype and for every `a : α`, `β a` is encodable, then `W β` is encodable. @@ -24,6 +27,8 @@ We mark the auxiliary constructions `private`, since their only purpose is to show encodability. -/ +namespace prop_encodable + /-- Propositional formulas with labels from `α`. -/ inductive prop_form (α : Type*) | var : α → prop_form @@ -61,7 +66,7 @@ namespace prop_form private def constructors (α : Type*) := α ⊕ unit ⊕ unit ⊕ unit -local notation `cvar` a := sum.inl a +local notation `cvar ` a := sum.inl a local notation `cnot` := sum.inr (sum.inl unit.star) local notation `cand` := sum.inr (sum.inr (sum.inr unit.star)) local notation `cor` := sum.inr (sum.inr (sum.inl unit.star)) @@ -96,3 +101,5 @@ begin end end prop_form + +end prop_encodable diff --git a/archive/imo/imo1959_q1.lean b/archive/imo/imo1959_q1.lean index 750f25078a713..fe34d1b143489 100644 --- a/archive/imo/imo1959_q1.lean +++ b/archive/imo/imo1959_q1.lean @@ -10,6 +10,9 @@ import data.nat.prime /-! # IMO 1959 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Prove that the fraction `(21n+4)/(14n+3)` is irreducible for every natural number `n`. Since Lean doesn't have a concept of "irreducible fractions" per se, we just formalize this @@ -18,11 +21,17 @@ as saying the numerator and denominator are relatively prime. open nat +namespace imo1959_q1 + lemma calculation (n k : ℕ) (h1 : k ∣ 21 * n + 4) (h2 : k ∣ 14 * n + 3) : k ∣ 1 := have h3 : k ∣ 2 * (21 * n + 4), from h1.mul_left 2, have h4 : k ∣ 3 * (14 * n + 3), from h2.mul_left 3, have h5 : 3 * (14 * n + 3) = 2 * (21 * n + 4) + 1, by ring, (nat.dvd_add_right h3).mp (h5 ▸ h4) +end imo1959_q1 + +open imo1959_q1 + theorem imo1959_q1 : ∀ n : ℕ, coprime (21 * n + 4) (14 * n + 3) := assume n, coprime_of_dvd' $ λ k hp h1 h2, calculation n k h1 h2 diff --git a/archive/imo/imo1960_q1.lean b/archive/imo/imo1960_q1.lean index 7caef8294f29b..eccc3abb782e8 100644 --- a/archive/imo/imo1960_q1.lean +++ b/archive/imo/imo1960_q1.lean @@ -9,6 +9,9 @@ import data.nat.digits /-! # IMO 1960 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Determine all three-digit numbers $N$ having the property that $N$ is divisible by 11, and $\dfrac{N}{11}$ is equal to the sum of the squares of the digits of $N$. @@ -22,6 +25,8 @@ The strategy here is roughly brute force, checking the possible multiples of 11. open nat +namespace imo1960_q1 + def sum_of_squares (L : list ℕ) : ℕ := (L.map (λ x, x * x)).sum def problem_predicate (n : ℕ) : Prop := @@ -98,5 +103,9 @@ Now we just need to prove the equivalence, for the precise problem statement. lemma left_direction (n : ℕ) (spn : solution_predicate n) : problem_predicate n := by rcases spn with (rfl | rfl); norm_num [problem_predicate, sum_of_squares] +end imo1960_q1 + +open imo1960_q1 + theorem imo1960_q1 (n : ℕ) : problem_predicate n ↔ solution_predicate n := ⟨right_direction, left_direction n⟩ diff --git a/archive/imo/imo1962_q1.lean b/archive/imo/imo1962_q1.lean index 7bd2c6f015d7c..bd586605533fb 100644 --- a/archive/imo/imo1962_q1.lean +++ b/archive/imo/imo1962_q1.lean @@ -9,6 +9,9 @@ import data.nat.digits /-! # IMO 1962 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Find the smallest natural number $n$ which has the following properties: (a) Its decimal representation has 6 as the last digit. @@ -21,6 +24,8 @@ we define the problem as a predicate, and then prove a particular number is the of a set satisfying it. -/ +namespace imo1962_q1 + open nat def problem_predicate (n : ℕ) : Prop := @@ -154,5 +159,9 @@ begin exact h5.ge, }, }, end +end imo1962_q1 + +open imo1962_q1 + theorem imo1962_q1 : is_least {n | problem_predicate n} 153846 := ⟨satisfied_by_153846, no_smaller_solutions⟩ diff --git a/archive/imo/imo1962_q4.lean b/archive/imo/imo1962_q4.lean index 42bf061c48fb1..87996b4246960 100644 --- a/archive/imo/imo1962_q4.lean +++ b/archive/imo/imo1962_q4.lean @@ -9,6 +9,9 @@ import analysis.special_functions.trigonometric.complex /-! # IMO 1962 Q4 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Solve the equation `cos x ^ 2 + cos (2 * x) ^ 2 + cos (3 * x) ^ 2 = 1`. Since Lean does not have a concept of "simplest form", we just express what is @@ -17,6 +20,8 @@ in fact the simplest form of the set of solutions, and then prove it equals the open real open_locale real +namespace imo1962_q4 + noncomputable theory def problem_equation (x : ℝ) : Prop := cos x ^ 2 + cos (2 * x) ^ 2 + cos (3 * x) ^ 2 = 1 @@ -80,6 +85,10 @@ begin split; intro; linarith end +end imo1962_q4 + +open imo1962_q4 + /- The final theorem is now just gluing together our lemmas. -/ @@ -90,6 +99,7 @@ begin exact exists_or_distrib.symm end +namespace imo1962_q4 /- We now present a second solution. The key to this solution is that, when the identity is @@ -120,6 +130,10 @@ begin split; intro; linarith end +end imo1962_q4 + +open imo1962_q4 + /- Again, the final theorem is now just gluing together our lemmas. -/ diff --git a/archive/imo/imo1964_q1.lean b/archive/imo/imo1964_q1.lean index ac90068a7afb6..f381845902b31 100644 --- a/archive/imo/imo1964_q1.lean +++ b/archive/imo/imo1964_q1.lean @@ -10,6 +10,9 @@ import data.nat.modeq /-! # IMO 1964 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + (a) Find all positive integers $n$ for which $2^n-1$ is divisible by $7$. (b) Prove that there is no positive integer $n$ for which $2^n+1$ is divisible by $7$. @@ -24,6 +27,8 @@ integers which are a multiple of 3. open nat +namespace imo1964_q1 + lemma two_pow_three_mul_mod_seven (m : ℕ) : 2 ^ (3 * m) ≡ 1 [MOD 7] := begin rw pow_mul, @@ -79,6 +84,10 @@ begin apply two_pow_three_mul_mod_seven } end +end imo1964_q1 + +open imo1964_q1 + theorem imo1964_q1b (n : ℕ) : ¬ (7 ∣ 2 ^ n + 1) := begin let t := n % 3, diff --git a/archive/imo/imo1969_q1.lean b/archive/imo/imo1969_q1.lean index a2ccb8cca33e6..b1e47a6bef7aa 100644 --- a/archive/imo/imo1969_q1.lean +++ b/archive/imo/imo1969_q1.lean @@ -11,12 +11,17 @@ import data.set.finite /-! # IMO 1969 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Prove that there are infinitely many natural numbers $a$ with the following property: the number $z = n^4 + a$ is not prime for any natural number $n$. -/ open int nat +namespace imo1969_q1 + /-- `good_nats` is the set of natural numbers satisfying the condition in the problem statement, namely the `a : ℕ` such that `n^4 + a` is not prime for any `n : ℕ`. -/ def good_nats : set ℕ := {a : ℕ | ∀ n : ℕ, ¬ nat.prime (n^4 + a)} @@ -67,6 +72,10 @@ in the `strict_mono` namespace. -/ lemma a_choice_strict_mono : strict_mono a_choice := ((strict_mono_id.const_add 2).nat_pow (dec_trivial : 0 < 4)).const_mul (dec_trivial : 0 < 4) +end imo1969_q1 + +open imo1969_q1 + /-- We conclude by using the fact that `a_choice` is an injective function from the natural numbers to the set `good_nats`. -/ theorem imo1969_q1 : set.infinite {a : ℕ | ∀ n : ℕ, ¬ nat.prime (n^4 + a)} := diff --git a/archive/imo/imo1972_q5.lean b/archive/imo/imo1972_q5.lean index 7bd89bacc97d6..8dbb28ff56f04 100644 --- a/archive/imo/imo1972_q5.lean +++ b/archive/imo/imo1972_q5.lean @@ -10,55 +10,60 @@ import analysis.normed_space.basic /-! # IMO 1972 Q5 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Problem: `f` and `g` are real-valued functions defined on the real line. For all `x` and `y`, `f(x + y) + f(x - y) = 2f(x)g(y)`. `f` is not identically zero and `|f(x)| ≤ 1` for all `x`. Prove that `|g(x)| ≤ 1` for all `x`. -/ +namespace imo1972_q5 + /-- -This proof begins by introducing the supremum of `f`, `k ≤ 1` as well as `k' = k / ∥g y∥`. We then +This proof begins by introducing the supremum of `f`, `k ≤ 1` as well as `k' = k / ‖g y‖`. We then suppose that the conclusion does not hold (`hneg`) and show that `k ≤ k'` (by -`2 * (∥f x∥ * ∥g y∥) ≤ 2 * k` obtained from the main hypothesis `hf1`) and that `k' < k` (obtained +`2 * (‖f x‖ * ‖g y‖) ≤ 2 * k` obtained from the main hypothesis `hf1`) and that `k' < k` (obtained from `hneg` directly), finally raising a contradiction with `k' < k'`. (Authored by Stanislas Polu inspired by Ruben Van de Velde). -/ example (f g : ℝ → ℝ) (hf1 : ∀ x, ∀ y, (f(x+y) + f(x-y)) = 2 * f(x) * g(y)) - (hf2 : ∀ y, ∥f(y)∥ ≤ 1) + (hf2 : ∀ y, ‖f(y)‖ ≤ 1) (hf3 : ∃ x, f(x) ≠ 0) (y : ℝ) : - ∥g(y)∥ ≤ 1 := + ‖g(y)‖ ≤ 1 := begin - set S := set.range (λ x, ∥f x∥), + set S := set.range (λ x, ‖f x‖), -- Introduce `k`, the supremum of `f`. let k : ℝ := Sup (S), - -- Show that `∥f x∥ ≤ k`. - have hk₁ : ∀ x, ∥f x∥ ≤ k, + -- Show that `‖f x‖ ≤ k`. + have hk₁ : ∀ x, ‖f x‖ ≤ k, { have h : bdd_above S, from ⟨1, set.forall_range_iff.mpr hf2⟩, intro x, exact le_cSup h (set.mem_range_self x), }, - -- Show that `2 * (∥f x∥ * ∥g y∥) ≤ 2 * k`. - have hk₂ : ∀ x, 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k, + -- Show that `2 * (‖f x‖ * ‖g y‖) ≤ 2 * k`. + have hk₂ : ∀ x, 2 * (‖f x‖ * ‖g y‖) ≤ 2 * k, { intro x, - calc 2 * (∥f x∥ * ∥g y∥) - = ∥2 * f x * g y∥ : by simp [real.norm_eq_abs, abs_mul, mul_assoc] - ... = ∥f (x + y) + f (x - y)∥ : by rw hf1 - ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : norm_add_le _ _ + calc 2 * (‖f x‖ * ‖g y‖) + = ‖2 * f x * g y‖ : by simp [abs_mul, mul_assoc] + ... = ‖f (x + y) + f (x - y)‖ : by rw hf1 + ... ≤ ‖f (x + y)‖ + ‖f (x - y)‖ : norm_add_le _ _ ... ≤ k + k : add_le_add (hk₁ _) (hk₁ _) ... = 2 * k : (two_mul _).symm, }, -- Suppose the conclusion does not hold. by_contra' hneg, - set k' := k / ∥g y∥, + set k' := k / ‖g y‖, -- Demonstrate that `k' < k` using `hneg`. have H₁ : k' < k, { have h₁ : 0 < k, { obtain ⟨x, hx⟩ := hf3, calc 0 - < ∥f x∥ : norm_pos_iff.mpr hx + < ‖f x‖ : norm_pos_iff.mpr hx ... ≤ k : hk₁ x }, rw div_lt_iff, apply lt_mul_of_one_lt_right h₁ hneg, @@ -67,8 +72,8 @@ begin -- Demonstrate that `k ≤ k'` using `hk₂`. have H₂ : k ≤ k', { have h₁ : ∃ x : ℝ, x ∈ S, - { use ∥f 0∥, exact set.mem_range_self 0, }, - have h₂ : ∀ x, ∥f x∥ ≤ k', + { use ‖f 0‖, exact set.mem_range_self 0, }, + have h₂ : ∀ x, ‖f x‖ ≤ k', { intros x, rw le_div_iff, { apply (mul_le_mul_left zero_lt_two).mp (hk₂ x) }, @@ -95,28 +100,30 @@ This is a more concise version of the proof proposed by Ruben Van de Velde. -/ example (f g : ℝ → ℝ) (hf1 : ∀ x, ∀ y, (f (x+y) + f(x-y)) = 2 * f(x) * g(y)) - (hf2 : bdd_above (set.range (λ x, ∥f x∥))) + (hf2 : bdd_above (set.range (λ x, ‖f x‖))) (hf3 : ∃ x, f(x) ≠ 0) (y : ℝ) : - ∥g(y)∥ ≤ 1 := + ‖g(y)‖ ≤ 1 := begin obtain ⟨x, hx⟩ := hf3, - set k := ⨆ x, ∥f x∥, - have h : ∀ x, ∥f x∥ ≤ k := le_csupr hf2, + set k := ⨆ x, ‖f x‖, + have h : ∀ x, ‖f x‖ ≤ k := le_csupr hf2, by_contra' H, - have hgy : 0 < ∥g y∥, + have hgy : 0 < ‖g y‖, by linarith, have k_pos : 0 < k := lt_of_lt_of_le (norm_pos_iff.mpr hx) (h x), - have : k / ∥g y∥ < k := (div_lt_iff hgy).mpr (lt_mul_of_one_lt_right k_pos H), - have : k ≤ k / ∥g y∥, - { suffices : ∀ x, ∥f x∥ ≤ k / ∥g y∥, from csupr_le this, + have : k / ‖g y‖ < k := (div_lt_iff hgy).mpr (lt_mul_of_one_lt_right k_pos H), + have : k ≤ k / ‖g y‖, + { suffices : ∀ x, ‖f x‖ ≤ k / ‖g y‖, from csupr_le this, intro x, - suffices : 2 * (∥f x∥ * ∥g y∥) ≤ 2 * k, - by { rwa [le_div_iff hgy, ←mul_le_mul_left zero_lt_two], apply_instance }, - calc 2 * (∥f x∥ * ∥g y∥) - = ∥2 * f x * g y∥ : by simp [abs_mul, mul_assoc] - ... = ∥f (x + y) + f (x - y)∥ : by rw hf1 - ... ≤ ∥f (x + y)∥ + ∥f (x - y)∥ : abs_add _ _ + suffices : 2 * (‖f x‖ * ‖g y‖) ≤ 2 * k, + by { rwa [le_div_iff hgy, ←mul_le_mul_left (zero_lt_two : (0 : ℝ) < 2)] }, + calc 2 * (‖f x‖ * ‖g y‖) + = ‖2 * f x * g y‖ : by simp [abs_mul, mul_assoc] + ... = ‖f (x + y) + f (x - y)‖ : by rw hf1 + ... ≤ ‖f (x + y)‖ + ‖f (x - y)‖ : abs_add _ _ ... ≤ 2 * k : by linarith [h (x+y), h (x -y)] }, linarith, end + +end imo1972_q5 diff --git a/archive/imo/imo1975_q1.lean b/archive/imo/imo1975_q1.lean new file mode 100644 index 0000000000000..b135b1806671d --- /dev/null +++ b/archive/imo/imo1975_q1.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2022 Mantas Bakšys. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mantas Bakšys +-/ +import data.real.basic +import data.nat.interval +import algebra.order.rearrangement +import algebra.big_operators.ring + +/-! +# IMO 1975 Q1 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `x₁, x₂, ... , xₙ` and `y₁, y₂, ... , yₙ` be two sequences of real numbers, such that +`x₁ ≥ x₂ ≥ ... ≥ xₙ` and `y₁ ≥ y₂ ≥ ... ≥ yₙ`. Prove that if `z₁, z₂, ... , zₙ` is any permutation +of `y₁, y₂, ... , yₙ`, then `∑ (xᵢ - yᵢ)^2 ≤ ∑ (xᵢ - zᵢ)^2` + +# Solution + +Firstly, we expand the squares withing both sums and distribute into separate finite sums. Then, +noting that `∑ yᵢ ^ 2 = ∑ zᵢ ^ 2`, it remains to prove that `∑ xᵢ * zᵢ ≤ ∑ xᵢ * yᵢ`, which is true +by the Rearrangement Inequality +-/ + +open_locale big_operators + +/- Let `n` be a natural number, `x` and `y` be as in the problem statement and `σ` be the +permutation of natural numbers such that `z = y ∘ σ` -/ +variables (n : ℕ) (σ : equiv.perm ℕ) (hσ : {x | σ x ≠ x} ⊆ finset.Icc 1 n) (x y : ℕ → ℝ) +variables (hx : antitone_on x (finset.Icc 1 n)) +variables (hy : antitone_on y (finset.Icc 1 n)) +include hx hy hσ + +theorem imo1975_q1 : + ∑ i in finset.Icc 1 n, (x i - y i) ^ 2 ≤ ∑ i in finset.Icc 1 n, (x i - y (σ i)) ^ 2 := +begin + simp only [sub_sq, finset.sum_add_distrib, finset.sum_sub_distrib], + -- a finite sum is invariant if we permute the order of summation + have hσy : ∑ (i : ℕ) in finset.Icc 1 n, y i ^ 2 = ∑ (i : ℕ) in finset.Icc 1 n, y (σ i) ^ 2, + { rw ← equiv.perm.sum_comp σ (finset.Icc 1 n) _ hσ }, + -- let's cancel terms appearing on both sides + norm_num [hσy, mul_assoc, ← finset.mul_sum], + -- what's left to prove is a version of the rearrangement inequality + apply monovary_on.sum_mul_comp_perm_le_sum_mul _ hσ, + -- finally we need to show that `x` and `y` 'vary' together on `[1, n]` and this is due to both of + -- them being `decreasing` + exact antitone_on.monovary_on hx hy +end diff --git a/archive/imo/imo1977_q6.lean b/archive/imo/imo1977_q6.lean index 1c65f6af0c855..8d3d44c050769 100644 --- a/archive/imo/imo1977_q6.lean +++ b/archive/imo/imo1977_q6.lean @@ -8,6 +8,9 @@ import data.pnat.basic /-! # IMO 1977 Q6 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Suppose `f : ℕ+ → ℕ+` satisfies `f(f(n)) < f(n + 1)` for all `n`. Prove that `f(n) = n` for all `n`. @@ -15,6 +18,8 @@ We first prove the problem statement for `f : ℕ → ℕ` then we use it to prove the statement for positive naturals. -/ +namespace imo1977_q6 + theorem imo1977_q6_nat (f : ℕ → ℕ) (h : ∀ n, f (f n) < f (n + 1)) : ∀ n, f n = n := begin @@ -33,6 +38,10 @@ begin exact nat.eq_of_le_of_lt_succ (hf _) (hf_mono.lt_iff_lt.mp (h _)) end +end imo1977_q6 + +open imo1977_q6 + theorem imo1977_q6 (f : ℕ+ → ℕ+) (h : ∀ n, f (f n) < f (n + 1)) : ∀ n, f n = n := begin diff --git a/archive/imo/imo1981_q3.lean b/archive/imo/imo1981_q3.lean index ea34d76d03bf2..10a40331f2eec 100644 --- a/archive/imo/imo1981_q3.lean +++ b/archive/imo/imo1981_q3.lean @@ -10,6 +10,9 @@ import tactic.linarith /-! # IMO 1981 Q3 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Determine the maximum value of `m ^ 2 + n ^ 2`, where `m` and `n` are integers in `{1, 2, ..., 1981}` and `(n ^ 2 - m * n - m ^ 2) ^ 2 = 1`. @@ -24,7 +27,7 @@ We first generalize the problem to `{1, 2, ..., N}` and specialize to `N = 1981` -/ open int nat set -section +namespace imo1981_q3 variable (N : ℕ) -- N = 1981 @[mk_iff] structure problem_predicate (m n : ℤ) : Prop := @@ -189,7 +192,9 @@ theorem solution_greatest (H : problem_predicate N (fib K) (fib (K + 1))) : is_greatest (specified_set N) M := ⟨⟨fib K, fib (K+1), by simp [HM], H⟩, λ k h, solution_bound HK HM h⟩ -end +end imo1981_q3 + +open imo1981_q3 /- Now we just have to demonstrate that 987 and 1597 are in fact the largest Fibonacci diff --git a/archive/imo/imo1987_q1.lean b/archive/imo/imo1987_q1.lean index 5e7a5e4396f57..ffae4fbd202d7 100644 --- a/archive/imo/imo1987_q1.lean +++ b/archive/imo/imo1987_q1.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import data.fintype.card +import data.fintype.big_operators +import data.fintype.perm +import data.fintype.prod import dynamics.fixed_points.basic /-! # Formalization of IMO 1987, Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let $p_{n, k}$ be the number of permutations of a set of cardinality `n ≥ 1` that fix exactly `k` elements. Prove that $∑_{k=0}^n k p_{n,k}=n!$. @@ -25,20 +30,21 @@ variables (α : Type*) [fintype α] [decidable_eq α] open_locale big_operators nat open equiv fintype function finset (range sum_const) set (Iic) -namespace imo_1987_q1 +namespace imo1987_q1 /-- The set of pairs `(x : α, σ : perm α)` such that `σ x = x` is equivalent to the set of pairs `(x : α, σ : perm {x}ᶜ)`. -/ def fixed_points_equiv : - {σx : α × perm α | σx.2 σx.1 = σx.1} ≃ Σ x : α, perm ({x}ᶜ : set α) := -calc {σx : α × perm α | σx.2 σx.1 = σx.1} ≃ Σ x : α, {σ : perm α | σ x = x} : set_prod_equiv_sigma _ -... ≃ Σ x : α, {σ : perm α | ∀ y : ({x} : set α), σ y = equiv.refl ↥({x} : set α) y} : + {σx : α × perm α // σx.2 σx.1 = σx.1} ≃ Σ x : α, perm ({x}ᶜ : set α) := +calc {σx : α × perm α // σx.2 σx.1 = σx.1} ≃ Σ x : α, {σ : perm α // σ x = x} : + set_prod_equiv_sigma _ +... ≃ Σ x : α, {σ : perm α // ∀ y : ({x} : set α), σ y = equiv.refl ↥({x} : set α) y} : sigma_congr_right (λ x, equiv.set.of_eq $ by { simp only [set_coe.forall], dsimp, simp }) ... ≃ Σ x : α, perm ({x}ᶜ : set α) : sigma_congr_right (λ x, by apply equiv.set.compl) theorem card_fixed_points : - card {σx : α × perm α | σx.2 σx.1 = σx.1} = card α * (card α - 1)! := + card {σx : α × perm α // σx.2 σx.1 = σx.1} = card α * (card α - 1)! := by simp [card_congr (fixed_points_equiv α), card_perm, finset.filter_not, finset.card_sdiff, finset.filter_eq', finset.card_univ] @@ -60,12 +66,12 @@ It is easy to see that the cardinality of the LHS is given by `∑ k : fin (card α + 1), k * p α k`. -/ def fixed_points_equiv' : (Σ (k : fin (card α + 1)) (σ : fiber α k), fixed_points σ.1) ≃ - {σx : α × perm α | σx.2 σx.1 = σx.1} := + {σx : α × perm α // σx.2 σx.1 = σx.1} := { to_fun := λ p, ⟨⟨p.2.2, p.2.1⟩, p.2.2.2⟩, inv_fun := λ p, ⟨⟨card (fixed_points p.1.2), (card_subtype_le _).trans_lt (nat.lt_succ_self _)⟩, ⟨p.1.2, rfl⟩, ⟨p.1.1, p.2⟩⟩, - left_inv := λ ⟨⟨k, hk⟩, ⟨σ, hσ⟩, ⟨x, hx⟩⟩, by { simp only [mem_fiber, subtype.coe_mk] at hσ, + left_inv := λ ⟨⟨k, hk⟩, ⟨σ, hσ⟩, ⟨x, hx⟩⟩, by { simp only [mem_fiber, fin.coe_mk] at hσ, subst k, refl }, right_inv := λ ⟨⟨x, σ⟩, h⟩, rfl } @@ -86,4 +92,4 @@ theorem main {n : ℕ} (hn : 1 ≤ n) : ∑ k in range (n + 1), k * p (fin n) k = n! := by rw [main₀, nat.mul_factorial_pred (zero_lt_one.trans_le hn)] -end imo_1987_q1 +end imo1987_q1 diff --git a/archive/imo/imo1988_q6.lean b/archive/imo/imo1988_q6.lean index a7c1b02a90224..4e2699c0f61d9 100644 --- a/archive/imo/imo1988_q6.lean +++ b/archive/imo/imo1988_q6.lean @@ -5,13 +5,17 @@ Authors: Johan Commelin -/ import data.nat.prime -import data.rat.basic +import data.rat.defs import order.well_founded import tactic.linarith +import tactic.wlog /-! # IMO 1988 Q6 and constant descent Vieta jumping +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Question 6 of IMO1988 is somewhat (in)famous. Several expert problem solvers could not tackle the question within the given time limit. The problem lead to the introduction of a new proof technique, @@ -27,6 +31,8 @@ To illustrate the technique, we also prove a similar result. local attribute [instance] classical.prop_decidable local attribute [simp] sq +namespace imo1988_q6 + /-- Constant descent Vieta jumping. This proof technique allows one to prove an arbitrary proposition `claim`, @@ -69,7 +75,8 @@ lemma constant_descent_vieta_jumping (x y : ℕ) {claim : Prop} {H : ℕ → ℕ begin -- First of all, we may assume that x ≤ y. -- We justify this using H_symm. - wlog hxy : x ≤ y, swap, { rw H_symm at h₀, solve_by_elim }, + wlog hxy : x ≤ y, + { rw H_symm at h₀, apply this y x h₀ B C base _ _ _ _ _ _ (le_of_not_le hxy), assumption' }, -- In fact, we can easily deal with the case x = y. by_cases x_eq_y : x = y, {subst x_eq_y, exact H_diag h₀}, -- Hence we may assume that x < y. @@ -111,8 +118,8 @@ begin -- And hence we are done by H_zero and H_diag. solve_by_elim } }, -- To finish the main proof, we need to show that the exceptional locus is nonempty. - -- So we assume that the exceptional locus is empty, and work towards dering a contradiction. - rw ← set.ne_empty_iff_nonempty, + -- So we assume that the exceptional locus is empty, and work towards deriving a contradiction. + rw set.nonempty_iff_ne_empty, assume exceptional_empty, -- Observe that S is nonempty. have S_nonempty : S.nonempty, @@ -127,8 +134,8 @@ begin have m_mem : m ∈ S := well_founded.min_mem nat.lt_wf S S_nonempty, have m_min : ∀ k ∈ S, ¬ k < m := λ k hk, well_founded.not_lt_min nat.lt_wf S S_nonempty hk, -- It suffices to show that there is point (a,b) with b ∈ S and b < m. - suffices hp' : ∃ p' : ℕ × ℕ, p'.2 ∈ S ∧ p'.2 < m, - { rcases hp' with ⟨p', p'_mem, p'_small⟩, solve_by_elim }, + rsuffices ⟨p', p'_mem, p'_small⟩ : ∃ p' : ℕ × ℕ, p'.2 ∈ S ∧ p'.2 < m, + { solve_by_elim }, -- Let (m_x, m_y) be a point on the upper branch that projects to m ∈ S -- and that does not lie in the exceptional locus. rcases m_mem with ⟨⟨mx, my⟩, ⟨⟨hHm, mx_lt_my⟩, h_base⟩, m_eq⟩, @@ -181,6 +188,10 @@ begin -- Hence p' = (c, m_x) lies on the upper branch, and we are done. end +end imo1988_q6 + +open imo1988_q6 + /--Question 6 of IMO1988. If a and b are two natural numbers such that a*b+1 divides a^2 + b^2, show that their quotient is a perfect square.-/ lemma imo1988_q6 {a b : ℕ} (h : (a*b+1) ∣ a^2 + b^2) : @@ -205,7 +216,7 @@ begin { -- Show that the claim is true if a = b. intros x hx, suffices : k ≤ 1, - { rw [nat.le_add_one_iff, nat.le_zero_iff] at this, + { rw [nat.le_add_one_iff, le_zero_iff] at this, rcases this with rfl|rfl, { use 0, simp }, { use 1, simp } }, @@ -226,9 +237,9 @@ begin { rw [← sub_eq_zero, ← h_root], ring, }, rw hzx at hpos, - replace hpos : z * x + 1 > 0 := pos_of_mul_pos_right hpos (int.coe_zero_le k), + replace hpos : z * x + 1 > 0 := pos_of_mul_pos_left hpos (int.coe_zero_le k), replace hpos : z * x ≥ 0 := int.le_of_lt_add_one hpos, - apply nonneg_of_mul_nonneg_right hpos (by exact_mod_cast hx), }, + apply nonneg_of_mul_nonneg_left hpos (by exact_mod_cast hx), }, { contrapose! hV₀ with x_lt_z, apply ne_of_gt, calc z * y > x*x : by apply mul_lt_mul'; linarith @@ -264,14 +275,14 @@ begin have x_sq_dvd : x*x ∣ x*x*k := dvd_mul_right (x*x) k, rw ← hx at x_sq_dvd, obtain ⟨y, hy⟩ : x * x ∣ 1 := by simpa only [nat.dvd_add_self_left, add_assoc] using x_sq_dvd, - obtain ⟨rfl,rfl⟩ : x = 1 ∧ y = 1 := by simpa [nat.mul_eq_one_iff] using hy.symm, + obtain ⟨rfl,rfl⟩ : x = 1 ∧ y = 1 := by simpa [mul_eq_one] using hy.symm, simpa using hx.symm, }, { -- Show the descent step. intros x y x_lt_y hx h_base h z h_root hV₁ hV₀, split, { have zy_pos : z * y ≥ 0, { rw hV₀, exact_mod_cast (nat.zero_le _) }, - apply nonneg_of_mul_nonneg_right zy_pos, + apply nonneg_of_mul_nonneg_left zy_pos, linarith }, { contrapose! hV₀ with x_lt_z, apply ne_of_gt, @@ -286,11 +297,11 @@ begin end, } }, { -- Show the base case. intros x y h h_base, - obtain rfl|rfl : x = 0 ∨ x = 1 := by rwa [nat.le_add_one_iff, nat.le_zero_iff] at h_base, + obtain rfl|rfl : x = 0 ∨ x = 1 := by rwa [nat.le_add_one_iff, le_zero_iff] at h_base, { simpa using h, }, { simp only [mul_one, one_mul, add_comm, zero_add] at h, have y_dvd : y ∣ y * k := dvd_mul_right y k, rw [← h, ← add_assoc, nat.dvd_add_left (dvd_mul_left y y)] at y_dvd, - obtain rfl|rfl := (nat.dvd_prime nat.prime_two).mp y_dvd; apply nat.eq_of_mul_eq_mul_left, - exacts [zero_lt_one, h.symm, zero_lt_two, h.symm] } } + obtain rfl|rfl := (nat.dvd_prime nat.prime_two).mp y_dvd; apply mul_left_cancel₀, + exacts [one_ne_zero, h.symm, two_ne_zero, h.symm] } } end diff --git a/archive/imo/imo1994_q1.lean b/archive/imo/imo1994_q1.lean index 07c78f44c9bb9..89b584ee3ebce 100644 --- a/archive/imo/imo1994_q1.lean +++ b/archive/imo/imo1994_q1.lean @@ -5,7 +5,7 @@ Authors: Antoine Labelle -/ import algebra.big_operators.basic import algebra.big_operators.order -import data.fintype.card +import data.fintype.big_operators import data.finset.sort import data.fin.interval import tactic.linarith @@ -14,6 +14,9 @@ import tactic.by_contra /-! # IMO 1994 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `m` and `n` be two positive integers. Let `a₁, a₂, ..., aₘ` be `m` different numbers from the set `{1, 2, ..., n}` such that for any two indices `i` and `j` with `1 ≤ i ≤ j ≤ m` and `aᵢ + aⱼ ≤ n`, @@ -32,6 +35,8 @@ open_locale big_operators open finset +namespace imo1994_q1 + lemma tedious (m : ℕ) (k : fin (m+1)) : m - (m + (m + 1 - ↑k)) % (m + 1) = ↑k := begin cases k with k hk, @@ -43,6 +48,10 @@ begin linarith end +end imo1994_q1 + +open imo1994_q1 + theorem imo1994_q1 (n : ℕ) (m : ℕ) (A : finset ℕ) (hm : A.card = m + 1) (hrange : ∀ a ∈ A, 0 < a ∧ a ≤ n) (hadd : ∀ (a b ∈ A), a + b ≤ n → a + b ∈ A) : (m + 1) * (n + 1) ≤ 2 * ∑ x in A, x := diff --git a/archive/imo/imo1998_q2.lean b/archive/imo/imo1998_q2.lean index b914c0fc5f137..7ce14e5cf3214 100644 --- a/archive/imo/imo1998_q2.lean +++ b/archive/imo/imo1998_q2.lean @@ -3,7 +3,7 @@ Copyright (c) 2020 Oliver Nash. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Oliver Nash -/ -import data.fintype.basic +import data.fintype.prod import data.int.parity import algebra.big_operators.order import tactic.ring @@ -11,6 +11,9 @@ import tactic.noncomm_ring /-! # IMO 1998 Q2 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. In a competition, there are `a` contestants and `b` judges, where `b ≥ 3` is an odd integer. Each judge rates each contestant as either "pass" or "fail". Suppose `k` is a number such that, for any two judges, their ratings coincide for at most `k` contestants. Prove that `k / a ≥ (b - 1) / (2b)`. @@ -38,6 +41,11 @@ Rearranging gives the result. -/ open_locale classical + +variables {C J : Type*} (r : C → J → Prop) + +namespace imo1998_q2 + noncomputable theory /-- An ordered pair of judges. -/ @@ -46,8 +54,6 @@ abbreviation judge_pair (J : Type*) := J × J /-- A triple consisting of contestant together with an ordered pair of judges. -/ abbreviation agreed_triple (C J : Type*) := C × (judge_pair J) -variables {C J : Type*} (r : C → J → Prop) - /-- The first judge from an ordered pair of judges. -/ abbreviation judge_pair.judge₁ : judge_pair J → J := prod.fst @@ -138,7 +144,7 @@ lemma norm_bound_of_odd_sum {x y z : ℤ} (h : x + y = 2*z + 1) : 2*z*z + 2*z + 1 ≤ x*x + y*y := begin suffices : 4*z*z + 4*z + 1 + 1 ≤ 2*x*x + 2*y*y, - { rw ← mul_le_mul_left (@zero_lt_two _ _ int.nontrivial), convert this; ring, }, + { rw ← mul_le_mul_left (zero_lt_two' ℤ), convert this; ring, }, have h' : (x + y) * (x + y) = 4*z*z + 4*z + 1, { rw h, ring, }, rw [← add_sq_add_sq_sub, h', add_le_add_iff_left], suffices : 0 < (x - y) * (x - y), { apply int.add_one_le_of_lt this, }, @@ -190,18 +196,20 @@ end end -local notation x `/` y := (x : ℚ) / y - lemma clear_denominators {a b k : ℕ} (ha : 0 < a) (hb : 0 < b) : - (b - 1) / (2 * b) ≤ k / a ↔ (b - 1) * a ≤ k * (2 * b) := + (b - 1 : ℚ) / (2 * b) ≤ k / a ↔ (b - 1) * a ≤ k * (2 * b) := by rw div_le_div_iff; norm_cast; simp [ha, hb] +end imo1998_q2 + +open imo1998_q2 + theorem imo1998_q2 [fintype J] [fintype C] (a b k : ℕ) (hC : fintype.card C = a) (hJ : fintype.card J = b) (ha : 0 < a) (hb : odd b) (hk : ∀ (p : judge_pair J), p.distinct → (agreed_contestants r p).card ≤ k) : - (b - 1) / (2 * b) ≤ k / a := + (b - 1 : ℚ) / (2 * b) ≤ k / a := begin - rw clear_denominators ha (nat.odd_gt_zero hb), + rw clear_denominators ha hb.pos, obtain ⟨z, hz⟩ := hb, rw hz at hJ, rw hz, have h := le_trans (A_card_lower_bound r hJ) (A_card_upper_bound r hk), rw [hC, hJ] at h, diff --git a/archive/imo/imo2001_q2.lean b/archive/imo/imo2001_q2.lean index c3548c9849ebb..346adc3db71fd 100644 --- a/archive/imo/imo2001_q2.lean +++ b/archive/imo/imo2001_q2.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Tian Chen -/ -import analysis.special_functions.pow +import analysis.special_functions.pow.real /-! # IMO 2001 Q2 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let $a$, $b$, $c$ be positive reals. Prove that $$ \frac{a}{\sqrt{a^2 + 8bc}} + @@ -30,6 +33,8 @@ open real variables {a b c : ℝ} +namespace imo2001_q2 + lemma denom_pos (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : 0 < a ^ 4 + b ^ 4 + c ^ 4 := add_pos (add_pos (pow_pos ha 4) (pow_pos hb 4)) (pow_pos hc 4) @@ -64,11 +69,15 @@ have h₂ : c ^ 4 + a ^ 4 + b ^ 4 = a ^ 4 + b ^ 4 + c ^ 4, calc _ ≥ _ : add_le_add (add_le_add (bound ha hb hc) (bound hb hc ha)) (bound hc ha hb) ... = 1 : by rw [h₁, h₂, ← add_div, ← add_div, div_self $ ne_of_gt $ denom_pos ha hb hc] +end imo2001_q2 + +open imo2001_q2 + theorem imo2001_q2 (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : 1 ≤ a / sqrt (a ^ 2 + 8 * b * c) + b / sqrt (b ^ 2 + 8 * c * a) + c / sqrt (c ^ 2 + 8 * a * b) := have h3 : ∀ {x : ℝ}, 0 < x → (x ^ (3 : ℝ)⁻¹) ^ 3 = x := - λ x hx, show ↑3 = (3 : ℝ), by norm_num ▸ rpow_nat_inv_pow_nat hx.le zero_lt_three, + λ x hx, show ↑3 = (3 : ℝ), by norm_num ▸ rpow_nat_inv_pow_nat hx.le three_ne_zero, calc 1 ≤ _ : imo2001_q2' (rpow_pos_of_pos ha _) (rpow_pos_of_pos hb _) (rpow_pos_of_pos hc _) ... = _ : by rw [h3 ha, h3 hb, h3 hc] diff --git a/archive/imo/imo2001_q6.lean b/archive/imo/imo2001_q6.lean index 1033cecd787ee..4b96c07090e1c 100644 --- a/archive/imo/imo2001_q6.lean +++ b/archive/imo/imo2001_q6.lean @@ -3,13 +3,15 @@ Copyright (c) 2021 Sara Díaz Real. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sara Díaz Real -/ -import data.int.basic import algebra.associated import tactic.linarith import tactic.linear_combination /-! # IMO 2001 Q6 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Let $a$, $b$, $c$, $d$ be integers with $a > b > c > d > 0$. Suppose that $$ a*c + b*d = (a + b - c + d) * (-a + b + c + d). $$ @@ -31,7 +33,7 @@ begin -- the key step is to show that `a*c + b*d` divides the product `(a*b + c*d) * (a*d + b*c)` have dvd_mul : a*c + b*d ∣ (a*b + c*d) * (a*d + b*c), { use b^2 + b*d + d^2, - linear_combination (h, b*d) }, + linear_combination b*d*h }, -- since `a*b + c*d` is prime (by assumption), it must divide `a*c + b*d` or `a*d + b*c` obtain (h1 : a*b + c*d ∣ a*c + b*d) | (h2 : a*c + b*d ∣ a*d + b*c) := h0.left_dvd_or_dvd_right_of_dvd_mul dvd_mul, diff --git a/archive/imo/imo2005_q3.lean b/archive/imo/imo2005_q3.lean index 9f7559da9f278..9d4ef279453ea 100644 --- a/archive/imo/imo2005_q3.lean +++ b/archive/imo/imo2005_q3.lean @@ -4,9 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Manuel Candales -/ import data.real.basic +import tactic.positivity /-! # IMO 2005 Q3 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Let `x`, `y` and `z` be positive real numbers such that `xyz ≥ 1`. Prove that: `(x^5 - x^2)/(x^5 + y^2 + z^2) + (y^5 - y^2)/(y^5 + z^2 + x^2) + (z^5 - z^2)/(z^5 + x^2 + y^2) ≥ 0` @@ -17,24 +21,22 @@ factoring `(x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2))` into a non-n and then making use of `xyz ≥ 1` to show `(x^5-x^2)/(x^3*(x^2+y^2+z^2)) ≥ (x^2-y*z)/(x^2+y^2+z^2)`. -/ +namespace imo2005_q3 + lemma key_insight (x y z : ℝ) (hx : x > 0) (hy : y > 0) (hz : z > 0) (h : x*y*z ≥ 1) : (x^5-x^2)/(x^5+y^2+z^2) ≥ (x^2-y*z)/(x^2+y^2+z^2) := begin - have h₁ : 0 < x^5+y^2+z^2, linarith [pow_pos hx 5, pow_pos hy 2, pow_pos hz 2], - have h₂ : 0 < x^3, exact pow_pos hx 3, - have h₃ : 0 < x^2+y^2+z^2, linarith [pow_pos hx 2, pow_pos hy 2, pow_pos hz 2], - have h₄ : 0 < x^3*(x^2+y^2+z^2), exact mul_pos h₂ h₃, + have h₁ : 0 < x^5+y^2+z^2 := by positivity, + have h₂ : 0 < x^3 := by positivity, + have h₃ : 0 < x^2+y^2+z^2 := by positivity, + have h₄ : 0 < x^3*(x^2+y^2+z^2) := by positivity, have key : (x^5-x^2)/(x^5+y^2+z^2) - (x^5-x^2)/(x^3*(x^2+y^2+z^2)) = ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))), { field_simp [h₁.ne', h₄.ne'], ring }, - have h₅ : ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))) ≥ 0, - { refine div_nonneg _ _, - refine mul_nonneg (mul_nonneg (sq_nonneg _) (sq_nonneg _)) _, - exact add_nonneg (sq_nonneg _) (sq_nonneg _), - exact le_of_lt (mul_pos h₁ h₄) }, + have h₅ : ((x^3 - 1)^2*x^2*(y^2 + z^2))/((x^5+y^2+z^2)*(x^3*(x^2+y^2+z^2))) ≥ 0 := by positivity, calc (x^5-x^2)/(x^5+y^2+z^2) ≥ (x^5-x^2)/(x^3*(x^2+y^2+z^2)) : by linarith [key, h₅] @@ -45,6 +47,10 @@ begin by { field_simp [h₂.ne', h₃.ne'], ring }, end +end imo2005_q3 + +open imo2005_q3 + theorem imo2005_q3 (x y z : ℝ) (hx : x > 0) (hy : y > 0) (hz : z > 0) (h : x*y*z ≥ 1) : (x^5-x^2)/(x^5+y^2+z^2) + (y^5-y^2)/(y^5+z^2+x^2) + (z^5-z^2)/(z^5+x^2+y^2) ≥ 0 := begin diff --git a/archive/imo/imo2005_q4.lean b/archive/imo/imo2005_q4.lean index 76ea4b2f299f6..ac90ef53f0bcc 100644 --- a/archive/imo/imo2005_q4.lean +++ b/archive/imo/imo2005_q4.lean @@ -8,6 +8,9 @@ import field_theory.finite.basic /-! # IMO 2005 Q4 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Problem: Determine all positive integers relatively prime to all the terms of the infinite sequence `a n = 2 ^ n + 3 ^ n + 6 ^ n - 1`, for `n ≥ 1`. @@ -15,6 +18,8 @@ This is quite an easy problem, in which the key point is a modular arithmetic ca the sequence `a n` relative to an arbitrary prime. -/ +namespace imo2005_q4 + /-- The sequence considered in the problem, `2 ^ n + 3 ^ n + 6 ^ n - 1`. -/ def a (n : ℕ) : ℤ := 2 ^ n + 3 ^ n + 6 ^ n - 1 @@ -53,8 +58,12 @@ begin ... = 0 : by ring, end +end imo2005_q4 + +open imo2005_q4 + /-- Main statement: The only positive integer coprime to all terms of the sequence `a` is `1`. -/ -example {k : ℕ} (hk : 0 < k) : (∀ n : ℕ, 1 ≤ n → is_coprime (a n) k) ↔ k = 1 := +theorem imo2005_q4 {k : ℕ} (hk : 0 < k) : (∀ n : ℕ, 1 ≤ n → is_coprime (a n) k) ↔ k = 1 := begin split, rotate, { -- The property is clearly true for `k = 1` @@ -80,7 +89,7 @@ begin have hp : nat.prime p := nat.min_fac_prime hk', -- So `3 ≤ p` have hp₃ : 3 ≤ p, - { have : 2 ≠ p := by rwa nat.coprime_primes (by norm_num : nat.prime 2) hp at hp₂, + { have : 2 ≠ p := by rwa nat.coprime_primes nat.prime_two hp at hp₂, apply nat.lt_of_le_and_ne hp.two_le this, }, -- Testing the special property of `k` for the `p - 2`th term of the sequence, we see that `p` is -- coprime to `a (p - 2)`. diff --git a/archive/imo/imo2006_q3.lean b/archive/imo/imo2006_q3.lean index 4b6f9377eecb3..8e3a0862d3ad4 100644 --- a/archive/imo/imo2006_q3.lean +++ b/archive/imo/imo2006_q3.lean @@ -9,6 +9,9 @@ import analysis.special_functions.sqrt /-! # IMO 2006 Q3 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Determine the least real number $M$ such that $$ \left| ab(a^2 - b^2) + bc(b^2 - c^2) + ca(c^2 - a^2) \right| @@ -29,6 +32,8 @@ It involves making the substitution open real +namespace imo2006_q3 + /-- Replacing `x` and `y` with their average increases the left side. -/ lemma lhs_ineq {x y : ℝ} (hxy : 0 ≤ x * y) : 16 * x ^ 2 * y ^ 2 * (x + y) ^ 2 ≤ ((x + y) ^ 2) ^ 3 := @@ -65,7 +70,7 @@ lemma zero_lt_32 : (0 : ℝ) < 32 := by norm_num theorem subst_wlog {x y z s : ℝ} (hxy : 0 ≤ x * y) (hxyz : x + y + z = 0) : 32 * |x * y * z * s| ≤ sqrt 2 * (x^2 + y^2 + z^2 + s^2)^2 := -have hz : (x + y)^2 = z^2 := neg_eq_of_add_eq_zero hxyz ▸ (neg_sq _).symm, +have hz : (x + y)^2 = z^2 := neg_eq_of_add_eq_zero_right hxyz ▸ (neg_sq _).symm, have hs : 0 ≤ 2 * s ^ 2 := mul_nonneg zero_le_two (sq_nonneg s), have this : _ := calc (2 * s^2) * (16 * x^2 * y^2 * (x + y)^2) @@ -82,25 +87,23 @@ le_of_pow_le_pow _ (mul_nonneg (sqrt_nonneg _) (sq_nonneg _)) nat.succ_pos' $ ... ≤ 32 * ((2 * (x^2 + y^2 + (x + y)^2) + 2 * s^2)^4 / 4^4) : mul_le_mul_of_nonneg_left this zero_lt_32.le ... = (sqrt 2 * (x^2 + y^2 + z^2 + s^2)^2)^2 : - by rw [← div_mul_eq_mul_div_comm, mul_pow, sq_sqrt zero_le_two, - hz, ← pow_mul, ← mul_add, mul_pow, ← mul_assoc]; - exact congr (congr_arg _ $ by norm_num) rfl + by rw [mul_pow, sq_sqrt zero_le_two, hz, ←pow_mul, ←mul_add, mul_pow, ←mul_comm_div, + ←mul_assoc, show 32 / 4 ^ 4 * 2 ^ 4 = (2 : ℝ), by norm_num, show 2 * 2 = 4, by refl] /-- Proof that `M = 9 * sqrt 2 / 32` works with the substitution. -/ theorem subst_proof₁ (x y z s : ℝ) (hxyz : x + y + z = 0) : |x * y * z * s| ≤ sqrt 2 / 32 * (x^2 + y^2 + z^2 + s^2)^2 := begin - wlog h' := mul_nonneg_of_three x y z using [x y z, y z x, z x y] tactic.skip, + wlog h' : 0 ≤ x * y generalizing x y z, swap, { rw [div_mul_eq_mul_div, le_div_iff' zero_lt_32], exact subst_wlog h' hxyz }, - { intro h, - rw [add_assoc, add_comm] at h, - rw [mul_assoc x, mul_comm x, add_assoc (x^2), add_comm (x^2)], - exact this h }, - { intro h, - rw [add_comm, ← add_assoc] at h, - rw [mul_comm _ z, ← mul_assoc, add_comm _ (z^2), ← add_assoc], - exact this h } + cases (mul_nonneg_of_three x y z).resolve_left h' with h h, + { specialize this y z x _ h, + { rw ← hxyz, ring, }, + { convert this using 2; ring } }, + { specialize this z x y _ h, + { rw ← hxyz, ring, }, + { convert this using 2; ring } }, end lemma lhs_identity (a b c : ℝ) : @@ -135,6 +138,10 @@ begin { exact mul_nonneg (mul_nonneg (sq_nonneg _) zero_le_two) (sqrt_nonneg _) } end +end imo2006_q3 + +open imo2006_q3 + theorem imo2006_q3 (M : ℝ) : (∀ a b c : ℝ, |a * b * (a^2 - b^2) + b * c * (b^2 - c^2) + c * a * (c^2 - a^2)| ≤ diff --git a/archive/imo/imo2006_q5.lean b/archive/imo/imo2006_q5.lean new file mode 100644 index 0000000000000..ec9929b2d4c1c --- /dev/null +++ b/archive/imo/imo2006_q5.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ + +import data.polynomial.ring_division +import dynamics.periodic_pts + +/-! +# IMO 2006 Q5 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let $P(x)$ be a polynomial of degree $n>1$ with integer coefficients, and let $k$ be a positive +integer. Consider the polynomial $Q(x) = P(P(\ldots P(P(x))\ldots))$, where $P$ occurs $k$ times. +Prove that there are at most $n$ integers $t$ such that $Q(t)=t$. + +## Sketch of solution + +The following solution is adapted from +https://artofproblemsolving.com/wiki/index.php/2006_IMO_Problems/Problem_5. + +Let $P^k$ denote the polynomial $P$ composed with itself $k$ times. We rely on a key observation: if +$P^k(t)=t$, then $P(P(t))=t$. We prove this by building the cyclic list +$(P(t)-t,P^2(t)-P(t),\ldots)$, and showing that each entry divides the next, which by transitivity +implies they all divide each other, and thus have the same absolute value. + +If the entries in this list are all pairwise equal, then we can show inductively that for positive +$n$, $P^n(t)-t$ must always have the same sign as $P(t)-t$. Substituting $n=k$ gives us $P(t)=t$ and +in particular $P(P(t))=t$. + +Otherwise, there must be two consecutive entries that are opposites of one another. This means +$P^{n+2}(t)-P^{n+1}(t)=P^n(t)-P^{n+1}(t)$, which implies $P^{n+2}(t)=P^n(t)$ and $P(P(t))=t$. + +With this lemma, we can reduce the problem to the case $k=2$. If every root of $P(P(t))-t$ is also a +root of $P(t)-t$, then we're done. Otherwise, there exist $a$ and $b$ with $a\ne b$ and $P(a)=b$, +$P(b)=a$. For any root $t$ of $P(P(t))-t$, defining $u=P(t)$, we easily verify $a-t\mid b-u$, +$b-u\mid a-t$, $a-u\mid b-t$, $b-t\mid a-u$, which imply $|a-t|=|b-u|$ and $|a-u|=|b-t|$. By casing +on these equalities, we deduce $a+b=t+u$. This means that every root of $P(P(t))-t$ is a root of +$P(t)+t-a-b$, and we're again done. +-/ + +open function polynomial + +namespace imo2006_q5 +/-- If every entry in a cyclic list of integers divides the next, then they all have the same +absolute value. -/ + +theorem int.nat_abs_eq_of_chain_dvd {l : cycle ℤ} {x y : ℤ} (hl : l.chain (∣)) + (hx : x ∈ l) (hy : y ∈ l) : x.nat_abs = y.nat_abs := +begin + rw cycle.chain_iff_pairwise at hl, + exact int.nat_abs_eq_of_dvd_dvd (hl x hx y hy) (hl y hy x hx) +end + +theorem int.add_eq_add_of_nat_abs_eq_of_nat_abs_eq {a b c d : ℤ} (hne : a ≠ b) + (h₁ : (c - a).nat_abs = (d - b).nat_abs) (h₂ : (c - b).nat_abs = (d - a).nat_abs) : + a + b = c + d := +begin + cases int.nat_abs_eq_nat_abs_iff.1 h₁ with h₁ h₁, + { cases int.nat_abs_eq_nat_abs_iff.1 h₂ with h₂ h₂, + { exact (hne $ by linarith).elim }, + { linarith } }, + { linarith } +end + +/-- The main lemma in the proof: if $P^k(t)=t$, then $P(P(t))=t$. -/ +theorem polynomial.is_periodic_pt_eval_two {P : polynomial ℤ} {t : ℤ} + (ht : t ∈ periodic_pts (λ x, P.eval x)) : is_periodic_pt (λ x, P.eval x) 2 t := +begin + -- The cycle [P(t) - t, P(P(t)) - P(t), ...] + let C : cycle ℤ := (periodic_orbit (λ x, P.eval x) t).map (λ x, P.eval x - x), + have HC : ∀ {n : ℕ}, (λ x, P.eval x)^[n + 1] t - ((λ x, P.eval x)^[n] t) ∈ C, + { intro n, + rw [cycle.mem_map, function.iterate_succ_apply'], + exact ⟨_, iterate_mem_periodic_orbit ht n, rfl⟩ }, + + -- Elements in C are all divisible by one another. + have Hdvd : C.chain (∣), + { rw [cycle.chain_map, periodic_orbit_chain' _ ht], + intro n, + convert sub_dvd_eval_sub ((λ x, P.eval x)^[n + 1] t) ((λ x, P.eval x)^[n] t) P; + rw function.iterate_succ_apply' }, + + -- Any two entries in C have the same absolute value. + have Habs : ∀ m n : ℕ, ((λ x, P.eval x)^[m + 1] t - ((λ x, P.eval x)^[m] t)).nat_abs = + ((λ x, P.eval x)^[n + 1] t - ((λ x, P.eval x)^[n] t)).nat_abs := + λ m n, int.nat_abs_eq_of_chain_dvd Hdvd HC HC, + + -- We case on whether the elements on C are pairwise equal. + by_cases HC' : C.chain (=), + { -- Any two entries in C are equal. + have Heq : ∀ m n : ℕ, (λ x, P.eval x)^[m + 1] t - ((λ x, P.eval x)^[m] t) = + ((λ x, P.eval x)^[n + 1] t - ((λ x, P.eval x)^[n] t)) := + λ m n, cycle.chain_iff_pairwise.1 HC' _ HC _ HC, + + -- The sign of P^n(t) - t is the same as P(t) - t for positive n. Proven by induction on n. + have IH : ∀ n : ℕ, ((λ x, P.eval x)^[n + 1] t - t).sign = (P.eval t - t).sign, + { intro n, + induction n with n IH, + { refl }, + { apply eq.trans _ (int.sign_add_eq_of_sign_eq IH), + have H := Heq n.succ 0, + dsimp at H ⊢, + rw [←H, sub_add_sub_cancel'] } }, + + -- This implies that the sign of P(t) - t is the same as the sign of P^k(t) - t, which is 0. + -- Hence P(t) = t and P(P(t)) = P(t). + rcases ht with ⟨(_ | k), hk, hk'⟩, + { exact (irrefl 0 hk).elim }, + { have H := IH k, + rw [hk'.is_fixed_pt.eq, sub_self, int.sign_zero, eq_comm, int.sign_eq_zero_iff_zero, + sub_eq_zero] at H, + simp [is_periodic_pt, is_fixed_pt, H] } }, + { -- We take two nonequal consecutive entries. + rw [cycle.chain_map, periodic_orbit_chain' _ ht] at HC', + push_neg at HC', + cases HC' with n hn, + + -- They must have opposite sign, so that P^{k + 1}(t) - P^k(t) = P^{k + 2}(t) - P^{k + 1}(t). + cases int.nat_abs_eq_nat_abs_iff.1 (Habs n n.succ) with hn' hn', + { apply (hn _).elim, + convert hn'; + simp only [function.iterate_succ_apply'] }, + + -- We deduce P^{k + 2}(t) = P^k(t) and hence P(P(t)) = t. + { rw [neg_sub, sub_right_inj] at hn', + simp only [function.iterate_succ_apply'] at hn', + exact @is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate _ _ t 2 n ht hn'.symm } } +end + +theorem polynomial.iterate_comp_sub_X_ne {P : polynomial ℤ} (hP : 1 < P.nat_degree) {k : ℕ} + (hk : 0 < k) : P.comp^[k] X - X ≠ 0 := +by { rw sub_ne_zero, apply_fun nat_degree, simpa using (one_lt_pow hP hk.ne').ne' } + +/-- We solve the problem for the specific case k = 2 first. -/ +theorem imo2006_q5' {P : polynomial ℤ} (hP : 1 < P.nat_degree) : + (P.comp P - X).roots.to_finset.card ≤ P.nat_degree := +begin + -- Auxiliary lemmas on degrees. + have hPX : (P - X).nat_degree = P.nat_degree, + { rw nat_degree_sub_eq_left_of_nat_degree_lt, + simpa using hP }, + have hPX' : P - X ≠ 0, + { intro h, + rw [h, nat_degree_zero] at hPX, + rw ←hPX at hP, + exact (zero_le_one.not_lt hP).elim }, + + -- If every root of P(P(t)) - t is also a root of P(t) - t, then we're done. + by_cases H : (P.comp P - X).roots.to_finset ⊆ (P - X).roots.to_finset, + { exact (finset.card_le_of_subset H).trans ((multiset.to_finset_card_le _).trans + ((card_roots' _).trans_eq hPX)) }, + + -- Otherwise, take a, b with P(a) = b, P(b) = a, a ≠ b. + { rcases finset.not_subset.1 H with ⟨a, ha, hab⟩, + replace ha := is_root_of_mem_roots (multiset.mem_to_finset.1 ha), + simp [sub_eq_zero] at ha, + simp [mem_roots hPX'] at hab, + set b := P.eval a, + rw sub_eq_zero at hab, + + -- More auxiliary lemmas on degrees. + have hPab : (P + X - a - b).nat_degree = P.nat_degree, + { rw [sub_sub, ←int.cast_add], + have h₁ : (P + X).nat_degree = P.nat_degree, + { rw nat_degree_add_eq_left_of_nat_degree_lt, + simpa using hP }, + rw nat_degree_sub_eq_left_of_nat_degree_lt; + rwa h₁, + rw nat_degree_int_cast, + exact zero_lt_one.trans hP }, + have hPab' : P + X - a - b ≠ 0, + { intro h, + rw [h, nat_degree_zero] at hPab, + rw ←hPab at hP, + exact (zero_le_one.not_lt hP).elim }, + + -- We claim that every root of P(P(t)) - t is a root of P(t) + t - a - b. This allows us to + -- conclude the problem. + suffices H' : (P.comp P - X).roots.to_finset ⊆ (P + X - a - b).roots.to_finset, + { exact (finset.card_le_of_subset H').trans ((multiset.to_finset_card_le _).trans $ + (card_roots' _).trans_eq hPab) }, + + { -- Let t be a root of P(P(t)) - t, define u = P(t). + intros t ht, + replace ht := is_root_of_mem_roots (multiset.mem_to_finset.1 ht), + simp [sub_eq_zero] at ht, + simp only [mem_roots hPab', sub_eq_iff_eq_add, multiset.mem_to_finset, is_root.def, eval_sub, + eval_add, eval_X, eval_C, eval_int_cast, int.cast_id, zero_add], + + -- An auxiliary lemma proved earlier implies we only need to show |t - a| = |u - b| and + -- |t - b| = |u - a|. We prove this by establishing that each side of either equation divides + -- the other. + apply (int.add_eq_add_of_nat_abs_eq_of_nat_abs_eq hab _ _).symm; + apply int.nat_abs_eq_of_dvd_dvd; + set u := P.eval t, + { rw [←ha, ←ht], apply sub_dvd_eval_sub }, + { apply sub_dvd_eval_sub }, + { rw ←ht, apply sub_dvd_eval_sub }, + { rw ←ha, apply sub_dvd_eval_sub } } } +end + +end imo2006_q5 + +open imo2006_q5 + +/-- The general problem follows easily from the k = 2 case. -/ +theorem imo2006_q5 {P : polynomial ℤ} (hP : 1 < P.nat_degree) {k : ℕ} (hk : 0 < k) : + (P.comp^[k] X - X).roots.to_finset.card ≤ P.nat_degree := +begin + apply (finset.card_le_of_subset $ λ t ht, _).trans (imo2006_q5' hP), + have hP' : P.comp P - X ≠ 0 := by simpa using polynomial.iterate_comp_sub_X_ne hP zero_lt_two, + replace ht := is_root_of_mem_roots (multiset.mem_to_finset.1 ht), + simp only [sub_eq_zero, is_root.def, eval_sub, iterate_comp_eval, eval_X] at ht, + simpa [mem_roots hP', sub_eq_zero] using polynomial.is_periodic_pt_eval_two ⟨k, hk, ht⟩ +end diff --git a/archive/imo/imo2008_q2.lean b/archive/imo/imo2008_q2.lean index 570dca94bad69..43c6b652cb127 100644 --- a/archive/imo/imo2008_q2.lean +++ b/archive/imo/imo2008_q2.lean @@ -8,6 +8,9 @@ import data.set.finite /-! # IMO 2008 Q2 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. (a) Prove that ``` x^2 / (x-1)^2 + y^2 / (y-1)^2 + z^2 / (z-1)^2 ≥ 1 @@ -26,6 +29,8 @@ using `c`, `m` and `n`. We factor `LHS - 1` as a square, which finishes the proo set of rational solutions to the equation, and that `W` is infinite. -/ +namespace imo2008_q2 + lemma subst_abc {x y z : ℝ} (h : x*y*z = 1) : ∃ a b c : ℝ, a ≠ 0 ∧ b ≠ 0 ∧ c ≠ 0 ∧ x = a/b ∧ y = b/c ∧ z = c /a := begin @@ -128,7 +133,9 @@ begin have hK_inf : set.infinite K, { intro h, apply hK_not_bdd, exact set.finite.bdd_above h }, - exact set.infinite_of_infinite_image g hK_inf }, + exact hK_inf.of_image g }, exact hW_inf.mono hW_sub_S, end + +end imo2008_q2 diff --git a/archive/imo/imo2008_q3.lean b/archive/imo/imo2008_q3.lean index ce940546064a3..ce1470e753e1b 100644 --- a/archive/imo/imo2008_q3.lean +++ b/archive/imo/imo2008_q3.lean @@ -12,6 +12,9 @@ import tactic.linear_combination /-! # IMO 2008 Q3 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Prove that there exist infinitely many positive integers `n` such that `n^2 + 1` has a prime divisor which is greater than `2n + √(2n)`. @@ -28,12 +31,14 @@ Then `p = 2n + k ≥ 2n + √(p - 4) = 2n + √(2n + k - 4) > √(2n)` and we ar open real +namespace imo2008_q3 + lemma p_lemma (p : ℕ) (hpp : nat.prime p) (hp_mod_4_eq_1 : p ≡ 1 [MOD 4]) (hp_gt_20 : p > 20) : ∃ n : ℕ, p ∣ n ^ 2 + 1 ∧ (p : ℝ) > 2 * n + sqrt(2 * n) := begin haveI := fact.mk hpp, have hp_mod_4_ne_3 : p % 4 ≠ 3, { linarith [(show p % 4 = 1, by exact hp_mod_4_eq_1)] }, - obtain ⟨y, hy⟩ := (zmod.exists_sq_eq_neg_one_iff p).mpr hp_mod_4_ne_3, + obtain ⟨y, hy⟩ := zmod.exists_sq_eq_neg_one_iff.mpr hp_mod_4_ne_3, let m := zmod.val_min_abs y, let n := int.nat_abs m, @@ -56,7 +61,7 @@ begin { use (p:ℤ) - 4 * n + 4 * x, have hcast₁ : (k:ℤ) = p - 2 * n, { assumption_mod_cast }, have hcast₂ : (n:ℤ) ^ 2 + 1 = p * x, { assumption_mod_cast }, - linear_combination (hcast₁, (k:ℤ) + p - 2 * n) (hcast₂, 4) }, + linear_combination ((k:ℤ) + p - 2 * n)*hcast₁ + 4*hcast₂ }, assumption_mod_cast }, have hnat₆ : k ^ 2 + 4 ≥ p := nat.le_of_dvd (k ^ 2 + 3).succ_pos hnat₅, @@ -66,22 +71,26 @@ begin have hreal₃ : (k:ℝ) ^ 2 + 4 ≥ p, { assumption_mod_cast }, have hreal₅ : (k:ℝ) > 4, - { apply lt_of_pow_lt_pow 2 k.cast_nonneg, + { refine lt_of_pow_lt_pow 2 k.cast_nonneg _, linarith only [hreal₂, hreal₃] }, have hreal₆ : (k:ℝ) > sqrt (2 * n), - { apply lt_of_pow_lt_pow 2 k.cast_nonneg, + { refine lt_of_pow_lt_pow 2 k.cast_nonneg _, rw sq_sqrt (mul_nonneg zero_le_two n.cast_nonneg), linarith only [hreal₁, hreal₃, hreal₅] }, exact ⟨n, hnat₁, by linarith only [hreal₆, hreal₁]⟩, end +end imo2008_q3 + +open imo2008_q3 + theorem imo2008_q3 : ∀ N : ℕ, ∃ n : ℕ, n ≥ N ∧ ∃ p : ℕ, nat.prime p ∧ p ∣ n ^ 2 + 1 ∧ (p : ℝ) > 2 * n + sqrt(2 * n) := begin intro N, - obtain ⟨p, hpp, hineq₁, hpmod4⟩ := nat.exists_prime_ge_modeq_one (N ^ 2 + 21) zero_lt_four, + obtain ⟨p, hpp, hineq₁, hpmod4⟩ := nat.exists_prime_gt_modeq_one (N ^ 2 + 20) four_ne_zero, obtain ⟨n, hnat, hreal⟩ := p_lemma p hpp hpmod4 (by linarith [hineq₁, nat.zero_le (N ^ 2)]), have hineq₂ : n ^ 2 + 1 ≥ p := nat.le_of_dvd (n ^ 2).succ_pos hnat, diff --git a/archive/imo/imo2008_q4.lean b/archive/imo/imo2008_q4.lean index 3ccccb23b5d75..c1cae17f559fa 100644 --- a/archive/imo/imo2008_q4.lean +++ b/archive/imo/imo2008_q4.lean @@ -10,6 +10,9 @@ import tactic.linear_combination /-! # IMO 2008 Q4 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Find all functions `f : (0,∞) → (0,∞)` (so, `f` is a function from the positive real numbers to the positive real numbers) such that ``` @@ -23,10 +26,16 @@ The desired theorem is that either `f = λ x, x` or `f = λ x, 1/x` open real +namespace imo2008_q4 + lemma abs_eq_one_of_pow_eq_one (x : ℝ) (n : ℕ) (hn : n ≠ 0) (h : x ^ n = 1) : |x| = 1 := by rw [← pow_left_inj (abs_nonneg x) zero_le_one (pos_iff_ne_zero.2 hn), one_pow, pow_abs, h, abs_one] +end imo2008_q4 + +open imo2008_q4 + theorem imo2008_q4 (f : ℝ → ℝ) (H₁ : ∀ x > 0, f(x) > 0) : @@ -44,7 +53,7 @@ begin have hy2z2 : y ^ 2 + z ^ 2 ≠ 0 := ne_of_gt (add_pos (pow_pos hy 2) (pow_pos hz 2)), have hz2y2 : z ^ 2 + y ^ 2 ≠ 0 := ne_of_gt (add_pos (pow_pos hz 2) (pow_pos hy 2)), have hp2 : w ^ 2 * x ^ 2 = y ^ 2 * z ^ 2, - { linear_combination (hprod, w * x + y * z) }, + { linear_combination (w * x + y * z)*hprod }, field_simp [ne_of_gt hw, ne_of_gt hx, ne_of_gt hy, ne_of_gt hz, hy2z2, hz2y2, hp2], ring } }, @@ -66,7 +75,7 @@ begin have hx_ne_0 : x ≠ 0 := ne_of_gt hx, have hfx_ne_0 : f(x) ≠ 0, { specialize H₁ x hx, exact ne_of_gt H₁ }, field_simp at H₂ ⊢, - linear_combination (H₂, 1/2) }, + linear_combination 1/2 * H₂ }, have h₃ : ∀ x > 0, f(x) = x ∨ f(x) = 1 / x, { simpa [sub_eq_zero] using h₂ }, @@ -90,14 +99,14 @@ begin -- f(ab) = ab → b^4 = 1 → b = 1 → f(b) = b → false { field_simp [hab₁] at H₂, field_simp [ne_of_gt hb] at H₂, - have hb₁ : b ^ 4 = 1 := by linear_combination (H₂, -1), + have hb₁ : b ^ 4 = 1 := by linear_combination -H₂, obtain hb₂ := abs_eq_one_of_pow_eq_one b 4 (show 4 ≠ 0, by norm_num) hb₁, rw abs_of_pos hb at hb₂, rw hb₂ at hfb₁, exact hfb₁ h₁ }, -- f(ab) = 1/ab → a^4 = 1 → a = 1 → f(a) = 1/a → false { have hb_ne_0 : b ≠ 0 := ne_of_gt hb, field_simp [hab₂] at H₂, - have H₃ : 2 * b ^ 4 * (a ^ 4 - 1) = 0 := by linear_combination H₂, + have H₃ : 2 * b ^ 4 * (a ^ 4 - 1) = 0 := by linear_combination (H₂), have h2b4_ne_0 : 2 * (b ^ 4) ≠ 0 := mul_ne_zero two_ne_zero (pow_ne_zero 4 hb_ne_0), have ha₁ : a ^ 4 = 1, { simpa [sub_eq_zero, h2b4_ne_0] using H₃ }, obtain ha₂ := abs_eq_one_of_pow_eq_one a 4 (show 4 ≠ 0, by norm_num) ha₁, diff --git a/archive/imo/imo2011_q3.lean b/archive/imo/imo2011_q3.lean index c3e5dfc5d8361..67b4845b53018 100644 --- a/archive/imo/imo2011_q3.lean +++ b/archive/imo/imo2011_q3.lean @@ -9,6 +9,9 @@ import data.real.basic /-! # IMO 2011 Q3 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let f : ℝ → ℝ be a function that satisfies f(x + y) ≤ y * f(x) + f(f(x)) diff --git a/archive/imo/imo2011_q5.lean b/archive/imo/imo2011_q5.lean index 92d259f5d184f..5bb51b977d729 100644 --- a/archive/imo/imo2011_q5.lean +++ b/archive/imo/imo2011_q5.lean @@ -3,12 +3,14 @@ Copyright (c) 2021 Alain Verberkmoes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Alain Verberkmoes -/ - -import data.int.basic +import data.int.dvd.basic /-! # IMO 2011 Q5 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `f` be a function from the set of integers to the set of positive integers. Suppose that, for any two integers `m` and `n`, the difference `f(m) - f(n)` is divisible by @@ -48,7 +50,7 @@ begin { -- d = 0 exact hd }, { -- d < 0 - have h₁ : f n ≤ -d, from le_of_dvd (neg_pos.mpr hd) ((dvd_neg _ _).mpr h_fn_dvd_d), + have h₁ : f n ≤ -d, from le_of_dvd (neg_pos.mpr hd) h_fn_dvd_d.neg_right, have h₂ : ¬ f n ≤ -d, from not_le.mpr h_neg_d_lt_fn, contradiction } }, have h₁ : f m = f (m - n), from sub_eq_zero.mp h_d_eq_zero, diff --git a/archive/imo/imo2013_q1.lean b/archive/imo/imo2013_q1.lean index 0b6b4680cc777..842d2de4c36f5 100644 --- a/archive/imo/imo2013_q1.lean +++ b/archive/imo/imo2013_q1.lean @@ -13,6 +13,9 @@ import tactic.field_simp /-! # IMO 2013 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Prove that for any pair of positive integers k and n, there exist k positive integers m₁, m₂, ..., mₖ (not necessarily different) such that @@ -27,6 +30,8 @@ We prove a slightly more general version where k does not need to be strictly po open_locale big_operators +namespace imo2013_q1 + lemma arith_lemma (k n : ℕ) : 0 < 2 * n + 2^k.succ := calc 0 < 2 : zero_lt_two ... = 2^1 : (pow_one 2).symm @@ -43,6 +48,10 @@ begin simp [finset.mem_range.mp hi] end +end imo2013_q1 + +open imo2013_q1 + theorem imo2013_q1 (n : ℕ+) (k : ℕ) : (∃ m : ℕ → ℕ+, (1 : ℚ) + (2^k - 1) / n = (∏ i in finset.range k, (1 + 1 / m i))) := begin diff --git a/archive/imo/imo2013_q5.lean b/archive/imo/imo2013_q5.lean index 68c7ac627ae83..16f7cdf6c6ab6 100644 --- a/archive/imo/imo2013_q5.lean +++ b/archive/imo/imo2013_q5.lean @@ -5,12 +5,16 @@ Authors: David Renshaw -/ import algebra.geom_sum -import data.rat.basic +import data.rat.defs import data.real.basic +import tactic.positivity /-! # IMO 2013 Q5 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `ℚ>₀` be the positive rational numbers. Let `f : ℚ>₀ → ℝ` be a function satisfying the conditions @@ -28,6 +32,8 @@ https://www.imo-official.org/problems/IMO2013SL.pdf open_locale big_operators +namespace imo2013_q5 + lemma le_of_all_pow_lt_succ {x y : ℝ} (hx : 1 < x) (hy : 1 < y) (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) : x ≤ y := @@ -102,13 +108,13 @@ begin ... = ((q.num.nat_abs : ℤ) : ℝ) : congr_arg coe (int.nat_abs_of_nonneg num_pos.le).symm ... ≤ f q.num.nat_abs : H4 q.num.nat_abs (int.nat_abs_pos_of_ne_zero num_pos.ne') - ... = f q.num : by { rw ←int.nat_abs_of_nonneg num_pos.le, norm_cast } + ... = f q.num : by rw [nat.cast_nat_abs, abs_of_nonneg num_pos.le] ... = f (q * q.denom) : by rw ←rat.mul_denom_eq_num ... ≤ f q * f q.denom : H1 q q.denom hq (nat.cast_pos.mpr q.pos), have h_f_denom_pos := calc (0 : ℝ) < q.denom : nat.cast_pos.mpr q.pos ... ≤ f q.denom : H4 q.denom q.pos, - exact pos_of_mul_pos_right hmul_pos h_f_denom_pos.le, + exact pos_of_mul_pos_left hmul_pos h_f_denom_pos.le, end lemma fx_gt_xm1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 ≤ x) @@ -142,7 +148,7 @@ begin { simp only [pow_one] }, have hpn' := hpn pn.succ_pos, rw [pow_succ' x (pn + 1), pow_succ' (f x) (pn + 1)], - have hxp : 0 < x := zero_lt_one.trans hx, + have hxp : 0 < x := by positivity, calc f ((x ^ (pn+1)) * x) ≤ f (x ^ (pn+1)) * f x : H1 (x ^ (pn+1)) x (pow_pos hxp (pn+1)) hxp ... ≤ (f x) ^ (pn+1) * f x : (mul_le_mul_right (f_pos_of_pos hxp H1 H4)).mpr hpn' @@ -180,10 +186,10 @@ begin ≤ f x + ((a^N - x) : ℚ) : add_le_add_right (H5 x hx) _ ... ≤ f x + f (a^N - x) : add_le_add_left (H5 _ h_big_enough) _, - have hxp : 0 < x := zero_lt_one.trans hx, + have hxp : 0 < x := by positivity, have hNp : 0 < N, - { by_contra' H, rw [nat.le_zero_iff.mp H] at hN, linarith }, + { by_contra' H, rw [le_zero_iff.mp H] at hN, linarith }, have h2 := calc f x + f (a^N - x) ≤ f (x + (a^N - x)) : H2 x (a^N - x) hxp (zero_lt_one.trans h_big_enough) @@ -195,6 +201,10 @@ begin linarith [H5 x hx, H5 _ h_big_enough] end +end imo2013_q5 + +open imo2013_q5 + theorem imo2013_q5 (f : ℚ → ℝ) (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y) @@ -209,15 +219,17 @@ begin { exact (lt_irrefl 0 hn).elim }, induction n with pn hpn, { simp only [one_mul, nat.cast_one] }, - calc (↑pn + 1 + 1) * f x - = ((pn : ℝ) + 1) * f x + 1 * f x : add_mul (↑pn + 1) 1 (f x) + calc ↑(pn + 2) * f x + = (↑pn + 1 + 1) * f x : by norm_cast + ... = ((pn : ℝ) + 1) * f x + 1 * f x : add_mul (↑pn + 1) 1 (f x) ... = (↑pn + 1) * f x + f x : by rw one_mul ... ≤ f ((↑pn.succ) * x) + f x : by exact_mod_cast add_le_add_right (hpn pn.succ_pos) (f x) ... ≤ f ((↑pn + 1) * x + x) : by exact_mod_cast H2 _ _ (mul_pos pn.cast_add_one_pos hx) hx ... = f ((↑pn + 1) * x + 1 * x) : by rw one_mul - ... = f ((↑pn + 1 + 1) * x) : congr_arg f (add_mul (↑pn + 1) 1 x).symm }, + ... = f ((↑pn + 1 + 1) * x) : congr_arg f (add_mul (↑pn + 1) 1 x).symm + ... = f (↑(pn + 2) * x) : by norm_cast }, have H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n, { intros n hn, have hf1 : 1 ≤ f 1, @@ -242,7 +254,7 @@ begin H1 H2 H4 ... ≤ (f x)^n : pow_f_le_f_pow hn hx H1 H4 }, have hx' : 1 < (x : ℝ) := by exact_mod_cast hx, - have hxp : 0 < x := zero_lt_one.trans hx, + have hxp : 0 < x := by positivity, exact le_of_all_pow_lt_succ' hx' (f_pos_of_pos hxp H1 H4) hxnm1 }, have h_f_commutes_with_pos_nat_mul : ∀ n : ℕ, 0 < n → ∀ x : ℚ, 0 < x → f (n * x) = n * f x, diff --git a/archive/imo/imo2019_q1.lean b/archive/imo/imo2019_q1.lean index a173ee614757a..0226474656c48 100644 --- a/archive/imo/imo2019_q1.lean +++ b/archive/imo/imo2019_q1.lean @@ -3,14 +3,14 @@ Copyright (c) 2020 Kevin Buzzard. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kevin Buzzard -/ -import algebra.group.pi -import algebra.group.commute -import data.int.basic import tactic.linarith /-! # IMO 2019 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Determine all functions `f : ℤ → ℤ` such that, for all integers `a` and `b`, `f(2a) + 2f(b) = f(f(a+b))`. @@ -22,7 +22,7 @@ Note that there is a much more compact proof of this fact in Isabelle/HOL - http://downthetypehole.de/paste/4YbGgqb4 -/ -theorem imo2019Q1 (f : ℤ → ℤ) : +theorem imo2019_q1 (f : ℤ → ℤ) : (∀ a b : ℤ, f (2 * a) + 2 * (f b) = f (f (a + b))) ↔ (f = 0) ∨ ∃ c, f = λ x, 2 * x + c := begin diff --git a/archive/imo/imo2019_q2.lean b/archive/imo/imo2019_q2.lean new file mode 100644 index 0000000000000..b93b1046604ed --- /dev/null +++ b/archive/imo/imo2019_q2.lean @@ -0,0 +1,602 @@ +/- +Copyright (c) 2022 Joseph Myers. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Myers +-/ +import geometry.euclidean.angle.sphere +import geometry.euclidean.sphere.second_inter + +/-! +# IMO 2019 Q2 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In triangle `ABC`, point `A₁` lies on side `BC` and point `B₁` lies on side `AC`. Let `P` and +`Q` be points on segments `AA₁` and `BB₁`, respectively, such that `PQ` is parallel to `AB`. +Let `P₁` be a point on line `PB₁`, such that `B₁` lies strictly between `P` and `P₁`, and +`∠PP₁C = ∠BAC`. Similarly, let `Q₁` be a point on line `QA₁`, such that `A₁` lies strictly +between `Q` and `Q₁`, and `∠CQ₁Q = ∠CBA`. + +Prove that points `P`, `Q`, `P₁`, and `Q₁` are concyclic. + +We follow Solution 1 from the +[official solutions](https://www.imo2019.uk/wp-content/uploads/2018/07/solutions-r856.pdf). +Letting the rays `AA₁` and `BB₁` intersect the circumcircle of `ABC` at `A₂` and `B₂` +respectively, we show with an angle chase that `P`, `Q`, `A₂`, `B₂` are concyclic and let `ω` be +the circle through those points. We then show that `C`, `Q₁`, `A₂`, `A₁` are concyclic, and +then that `Q₁` lies on `ω`, and similarly that `P₁` lies on `ω`, so the required four points are +concyclic. + +Note that most of the formal proof is actually proving nondegeneracy conditions needed for that +angle chase / concyclicity argument, where an informal solution doesn't discuss those conditions +at all. Also note that (as described in `geometry.euclidean.angle.oriented.basic`) the oriented +angles used are modulo `2 * π`, so parts of the angle chase that are only valid for angles modulo +`π` (as used in the informal solution) are represented as equalities of twice angles, which we write +as `(2 : ℤ) • ∡ _ _ _ = (2 : ℤ) • _ _ _`. +-/ + +/-- +We apply the following conventions for formalizing IMO geometry problems. A problem is assumed +to take place in the plane unless that is clearly not intended, so it is not required to prove +that the points are coplanar (whether or not that in fact follows from the other conditions). +Angles in problem statements are taken to be unoriented. A reference to an angle `∠XYZ` is taken +to imply that `X` and `Z` are not equal to `Y`, since choices of junk values play no role in +informal mathematics, and those implications are included as hypotheses for the problem whether +or not they follow from the other hypotheses. Similar, a reference to `XY` as a line is taken to +imply that `X` does not equal `Y` and that is included as a hypothesis, and a reference to `XY` +being parallel to something is considered a reference to it as a line. However, such an implicit +hypothesis about two points being different is included only once for any given two points (even +if it follows from more than one reference to a line or an angle), if `X ≠ Y` is included then +`Y ≠ X` is not included separately, and such hypotheses are not included in the case where there +is also a reference in the problem to a triangle including those two points, or to strict +betweenness of three points including those two. If betweenness is stated, it is taken to be +strict betweenness. However, segments and sides are taken to include their endpoints (unless +this makes a problem false), although those degenerate cases might not necessarily have been +considered when the problem was formulated and contestants might not have been expected to deal +with them. A reference to a point being on a side or a segment is expressed directly with `wbtw` +rather than more literally with `affine_segment`. +-/ +library_note "IMO geometry formalization conventions" + +open affine affine.simplex euclidean_geometry finite_dimensional +open_locale affine euclidean_geometry real + +local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ + +variables (V : Type*) (Pt : Type*) +variables [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space Pt] +variables [normed_add_torsor V Pt] [hd2 : fact (finrank ℝ V = 2)] +include hd2 + +namespace imo2019_q2 + +noncomputable theory + +/-- A configuration satisfying the conditions of the problem. We define this structure to avoid +passing many hypotheses around as we build up information about the configuration; the final +result for a statement of the problem not using this structure is then deduced from one in terms +of this structure. -/ +@[nolint has_nonempty_instance] +structure imo2019q2_cfg := +(A B C A₁ B₁ P Q P₁ Q₁ : Pt) +(affine_independent_ABC : affine_independent ℝ ![A, B, C]) +(wbtw_B_A₁_C : wbtw ℝ B A₁ C) +(wbtw_A_B₁_C : wbtw ℝ A B₁ C) +(wbtw_A_P_A₁ : wbtw ℝ A P A₁) +(wbtw_B_Q_B₁ : wbtw ℝ B Q B₁) +(PQ_parallel_AB : line[ℝ, P, Q] ∥ line[ℝ, A, B]) +-- A hypothesis implicit in the named line. +(P_ne_Q : P ≠ Q) +(sbtw_P_B₁_P₁ : sbtw ℝ P B₁ P₁) +(angle_PP₁C_eq_angle_BAC : ∠ P P₁ C = ∠ B A C) +-- A hypothesis implicit in the first named angle. +(C_ne_P₁ : C ≠ P₁) +(sbtw_Q_A₁_Q₁ : sbtw ℝ Q A₁ Q₁) +(angle_CQ₁Q_eq_angle_CBA : ∠ C Q₁ Q = ∠ C B A) +-- A hypothesis implicit in the first named angle. +(C_ne_Q₁ : C ≠ Q₁) + +/-- A default choice of orientation, for lemmas that need to pick one. -/ +def some_orientation : module.oriented ℝ V (fin 2) := +⟨basis.orientation (fin_basis_of_finrank_eq _ _ hd2.out)⟩ + +variables {V Pt} + +namespace imo2019q2_cfg + +variables (cfg : imo2019q2_cfg V Pt) + +/-- The configuration has symmetry, allowing results proved for one point to be applied for +another (where the informal solution says "similarly"). -/ +def symm : imo2019q2_cfg V Pt := +{ A := cfg.B, + B := cfg.A, + C := cfg.C, + A₁ := cfg.B₁, + B₁ := cfg.A₁, + P := cfg.Q, + Q := cfg.P, + P₁ := cfg.Q₁, + Q₁ := cfg.P₁, + affine_independent_ABC := begin + rw ←affine_independent_equiv (equiv.swap (0 : fin 3) 1), + convert cfg.affine_independent_ABC using 1, + ext x, + fin_cases x; + refl + end, + wbtw_B_A₁_C := cfg.wbtw_A_B₁_C, + wbtw_A_B₁_C := cfg.wbtw_B_A₁_C, + wbtw_A_P_A₁ := cfg.wbtw_B_Q_B₁, + wbtw_B_Q_B₁ := cfg.wbtw_A_P_A₁, + PQ_parallel_AB := set.pair_comm cfg.P cfg.Q ▸ set.pair_comm cfg.A cfg.B ▸ cfg.PQ_parallel_AB, + P_ne_Q := cfg.P_ne_Q.symm, + sbtw_P_B₁_P₁ := cfg.sbtw_Q_A₁_Q₁, + angle_PP₁C_eq_angle_BAC := + angle_comm cfg.C cfg.Q₁ cfg.Q ▸ angle_comm cfg.C cfg.B cfg.A ▸ cfg.angle_CQ₁Q_eq_angle_CBA, + C_ne_P₁ := cfg.C_ne_Q₁, + sbtw_Q_A₁_Q₁ := cfg.sbtw_P_B₁_P₁, + angle_CQ₁Q_eq_angle_CBA := + angle_comm cfg.P cfg.P₁ cfg.C ▸ angle_comm cfg.B cfg.A cfg.C ▸ cfg.angle_PP₁C_eq_angle_BAC, + C_ne_Q₁ := cfg.C_ne_P₁ } + +/-! ### Configuration properties that are obvious from the diagram, and construction of the +points `A₂` and `B₂` -/ + +lemma A_ne_B : cfg.A ≠ cfg.B := cfg.affine_independent_ABC.injective.ne + (dec_trivial : (0 : fin 3) ≠ 1) + +lemma A_ne_C : cfg.A ≠ cfg.C := cfg.affine_independent_ABC.injective.ne + (dec_trivial : (0 : fin 3) ≠ 2) + +lemma B_ne_C : cfg.B ≠ cfg.C := cfg.affine_independent_ABC.injective.ne + (dec_trivial : (1 : fin 3) ≠ 2) + +lemma not_collinear_ABC : ¬collinear ℝ ({cfg.A, cfg.B, cfg.C} : set Pt) := +affine_independent_iff_not_collinear_set.1 cfg.affine_independent_ABC + +/-- `ABC` as a `triangle`. -/ +def triangle_ABC : triangle ℝ Pt := ⟨_, cfg.affine_independent_ABC⟩ + +lemma A_mem_circumsphere : cfg.A ∈ cfg.triangle_ABC.circumsphere := +cfg.triangle_ABC.mem_circumsphere 0 + +lemma B_mem_circumsphere : cfg.B ∈ cfg.triangle_ABC.circumsphere := +cfg.triangle_ABC.mem_circumsphere 1 + +lemma C_mem_circumsphere : cfg.C ∈ cfg.triangle_ABC.circumsphere := +cfg.triangle_ABC.mem_circumsphere 2 + +lemma symm_triangle_ABC : cfg.symm.triangle_ABC = cfg.triangle_ABC.reindex (equiv.swap 0 1) := +by { ext i, fin_cases i; refl } + +lemma symm_triangle_ABC_circumsphere : + cfg.symm.triangle_ABC.circumsphere = cfg.triangle_ABC.circumsphere := +by rw [symm_triangle_ABC, affine.simplex.circumsphere_reindex] + +/-- `A₂` is the second point of intersection of the ray `AA₁` with the circumcircle of `ABC`. -/ +def A₂ : Pt := cfg.triangle_ABC.circumsphere.second_inter cfg.A (cfg.A₁ -ᵥ cfg.A) + +/-- `B₂` is the second point of intersection of the ray `BB₁` with the circumcircle of `ABC`. -/ +def B₂ : Pt := cfg.triangle_ABC.circumsphere.second_inter cfg.B (cfg.B₁ -ᵥ cfg.B) + +lemma A₂_mem_circumsphere : cfg.A₂ ∈ cfg.triangle_ABC.circumsphere := +(sphere.second_inter_mem _).2 cfg.A_mem_circumsphere + +lemma B₂_mem_circumsphere : cfg.B₂ ∈ cfg.triangle_ABC.circumsphere := +(sphere.second_inter_mem _).2 cfg.B_mem_circumsphere + +lemma symm_A₂ : cfg.symm.A₂ = cfg.B₂ := +by { simp_rw [A₂, B₂, symm_triangle_ABC_circumsphere], refl } + +lemma QP_parallel_BA : line[ℝ, cfg.Q, cfg.P] ∥ line[ℝ, cfg.B, cfg.A] := +by { rw [set.pair_comm cfg.Q, set.pair_comm cfg.B], exact cfg.PQ_parallel_AB } + +lemma A_ne_A₁ : cfg.A ≠ cfg.A₁ := +begin + intro h, + have h' := cfg.not_collinear_ABC, + rw [h, set.insert_comm] at h', + exact h' cfg.wbtw_B_A₁_C.collinear +end + +lemma collinear_PAA₁A₂ : collinear ℝ ({cfg.P, cfg.A, cfg.A₁, cfg.A₂} : set Pt) := +begin + rw [A₂, + (cfg.triangle_ABC.circumsphere.second_inter_collinear cfg.A cfg.A₁).collinear_insert_iff_of_ne + (set.mem_insert _ _) (set.mem_insert_of_mem _ (set.mem_insert _ _)) cfg.A_ne_A₁, + set.insert_comm], + exact cfg.wbtw_A_P_A₁.collinear +end + +lemma A₁_ne_C : cfg.A₁ ≠ cfg.C := +begin + intro h, + have hsbtw := cfg.sbtw_Q_A₁_Q₁, + rw h at hsbtw, + have ha := hsbtw.angle₂₃₁_eq_zero, + rw [angle_CQ₁Q_eq_angle_CBA, angle_comm] at ha, + exact (angle_ne_zero_of_not_collinear cfg.not_collinear_ABC) ha +end + +lemma B₁_ne_C : cfg.B₁ ≠ cfg.C := cfg.symm.A₁_ne_C + +lemma Q_not_mem_CB : cfg.Q ∉ line[ℝ, cfg.C, cfg.B] := +begin + intro hQ, + have hQA₁ : line[ℝ, cfg.Q, cfg.A₁] ≤ line[ℝ, cfg.C, cfg.B] := + affine_span_pair_le_of_mem_of_mem hQ cfg.wbtw_B_A₁_C.symm.mem_affine_span, + have hQ₁ : cfg.Q₁ ∈ line[ℝ, cfg.C, cfg.B], + { rw affine_subspace.le_def' at hQA₁, + exact hQA₁ _ cfg.sbtw_Q_A₁_Q₁.right_mem_affine_span }, + have hc : collinear ℝ ({cfg.C, cfg.Q₁, cfg.Q} : set Pt), + { have hc' : collinear ℝ ({cfg.B, cfg.C, cfg.Q₁, cfg.Q} : set Pt), + { rw [set.insert_comm cfg.B, set.insert_comm cfg.B, set.pair_comm, set.insert_comm cfg.C, + set.insert_comm cfg.C], + exact collinear_insert_insert_of_mem_affine_span_pair hQ₁ hQ }, + exact hc'.subset (set.subset_insert _ _) }, + rw [collinear_iff_eq_or_eq_or_angle_eq_zero_or_angle_eq_pi, cfg.angle_CQ₁Q_eq_angle_CBA, + or_iff_right cfg.C_ne_Q₁, or_iff_right cfg.sbtw_Q_A₁_Q₁.left_ne_right, angle_comm] at hc, + exact cfg.not_collinear_ABC (hc.elim collinear_of_angle_eq_zero collinear_of_angle_eq_pi) +end + +lemma Q_ne_B : cfg.Q ≠ cfg.B := +begin + intro h, + have h' := cfg.Q_not_mem_CB, + rw h at h', + exact h' (right_mem_affine_span_pair _ _ _) +end + +lemma s_opp_side_CB_Q_Q₁ : line[ℝ, cfg.C, cfg.B].s_opp_side cfg.Q cfg.Q₁ := +cfg.sbtw_Q_A₁_Q₁.s_opp_side_of_not_mem_of_mem cfg.Q_not_mem_CB cfg.wbtw_B_A₁_C.symm.mem_affine_span + +/-! ### Relate the orientations of different angles in the configuration -/ + +section oriented + +variables [module.oriented ℝ V (fin 2)] + +lemma oangle_CQ₁Q_sign_eq_oangle_CBA_sign : + (∡ cfg.C cfg.Q₁ cfg.Q).sign = (∡ cfg.C cfg.B cfg.A).sign := +by rw [←cfg.sbtw_Q_A₁_Q₁.symm.oangle_eq_right, + cfg.s_opp_side_CB_Q_Q₁.oangle_sign_eq_neg (left_mem_affine_span_pair ℝ cfg.C cfg.B) + cfg.wbtw_B_A₁_C.symm.mem_affine_span, ←real.angle.sign_neg, ←oangle_rev, + cfg.wbtw_B_A₁_C.oangle_sign_eq_of_ne_right cfg.Q cfg.A₁_ne_C, oangle_rotate_sign, + cfg.wbtw_B_Q_B₁.oangle_eq_right cfg.Q_ne_B, + cfg.wbtw_A_B₁_C.symm.oangle_sign_eq_of_ne_left cfg.B cfg.B₁_ne_C.symm] + +lemma oangle_CQ₁Q_eq_oangle_CBA : ∡ cfg.C cfg.Q₁ cfg.Q = ∡ cfg.C cfg.B cfg.A := +oangle_eq_of_angle_eq_of_sign_eq cfg.angle_CQ₁Q_eq_angle_CBA cfg.oangle_CQ₁Q_sign_eq_oangle_CBA_sign + +end oriented + +/-! ### More obvious configuration properties -/ + +lemma A₁_ne_B : cfg.A₁ ≠ cfg.B := +begin + intro h, + have hwbtw := cfg.wbtw_A_P_A₁, + rw h at hwbtw, + have hPQ : line[ℝ, cfg.P, cfg.Q] = line[ℝ, cfg.A, cfg.B], + { rw affine_subspace.eq_iff_direction_eq_of_mem (left_mem_affine_span_pair _ _ _) + hwbtw.mem_affine_span, + exact cfg.PQ_parallel_AB.direction_eq }, + haveI := some_orientation V, + have haQ : (2 : ℤ) • ∡ cfg.C cfg.B cfg.Q = (2 : ℤ) • ∡ cfg.C cfg.B cfg.A, + { rw [collinear.two_zsmul_oangle_eq_right _ cfg.A_ne_B cfg.Q_ne_B], + rw [set.pair_comm, set.insert_comm], + refine collinear_insert_of_mem_affine_span_pair _, + rw ←hPQ, + exact right_mem_affine_span_pair _ _ _ }, + have ha : (2 : ℤ) • ∡ cfg.C cfg.B cfg.Q = (2 : ℤ) • ∡ cfg.C cfg.Q₁ cfg.Q, + { rw [oangle_CQ₁Q_eq_oangle_CBA, haQ] }, + have hn : ¬collinear ℝ ({cfg.C, cfg.B, cfg.Q} : set Pt), + { rw [collinear_iff_of_two_zsmul_oangle_eq haQ, set.pair_comm, set.insert_comm, set.pair_comm], + exact cfg.not_collinear_ABC }, + have hc := cospherical_of_two_zsmul_oangle_eq_of_not_collinear ha hn, + have hBQ₁ : cfg.B ≠ cfg.Q₁, { rw [←h], exact cfg.sbtw_Q_A₁_Q₁.ne_right }, + have hQQ₁ : cfg.Q ≠ cfg.Q₁ := cfg.sbtw_Q_A₁_Q₁.left_ne_right, + have hBQ₁Q : affine_independent ℝ ![cfg.B, cfg.Q₁, cfg.Q] := + hc.affine_independent_of_mem_of_ne (set.mem_insert_of_mem _ (set.mem_insert _ _)) + (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert _ _))) + (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ + (set.mem_singleton _)))) hBQ₁ cfg.Q_ne_B.symm hQQ₁.symm, + rw affine_independent_iff_not_collinear_set at hBQ₁Q, + refine hBQ₁Q _, + rw [←h, set.pair_comm, set.insert_comm], + exact cfg.sbtw_Q_A₁_Q₁.wbtw.collinear +end + +lemma sbtw_B_A₁_C : sbtw ℝ cfg.B cfg.A₁ cfg.C := ⟨cfg.wbtw_B_A₁_C, cfg.A₁_ne_B, cfg.A₁_ne_C⟩ + +lemma sbtw_A_B₁_C : sbtw ℝ cfg.A cfg.B₁ cfg.C := cfg.symm.sbtw_B_A₁_C + +lemma sbtw_A_A₁_A₂ : sbtw ℝ cfg.A cfg.A₁ cfg.A₂ := +begin + refine sphere.sbtw_second_inter cfg.A_mem_circumsphere _, + convert cfg.sbtw_B_A₁_C.dist_lt_max_dist _, + change _ = max (dist (cfg.triangle_ABC.points 1) _) (dist (cfg.triangle_ABC.points 2) _), + simp_rw [circumsphere_center, circumsphere_radius, dist_circumcenter_eq_circumradius, max_self] +end + +lemma sbtw_B_B₁_B₂ : sbtw ℝ cfg.B cfg.B₁ cfg.B₂ := +by { rw ←cfg.symm_A₂, exact cfg.symm.sbtw_A_A₁_A₂ } + +lemma A₂_ne_A : cfg.A₂ ≠ cfg.A := cfg.sbtw_A_A₁_A₂.left_ne_right.symm + +lemma A₂_ne_P : cfg.A₂ ≠ cfg.P := (cfg.sbtw_A_A₁_A₂.trans_wbtw_left_ne cfg.wbtw_A_P_A₁).symm + +lemma A₂_ne_B : cfg.A₂ ≠ cfg.B := +begin + intro h, + have h₁ := cfg.sbtw_A_A₁_A₂, + rw h at h₁, + refine cfg.not_collinear_ABC _, + have hc : collinear ℝ ({cfg.A, cfg.C, cfg.B, cfg.A₁} : set Pt) := + collinear_insert_insert_of_mem_affine_span_pair h₁.left_mem_affine_span + cfg.sbtw_B_A₁_C.right_mem_affine_span, + refine hc.subset _, + rw [set.pair_comm _ cfg.A₁, set.insert_comm _ cfg.A₁, set.insert_comm _ cfg.A₁, set.pair_comm], + exact set.subset_insert _ _ +end + +lemma A₂_ne_C : cfg.A₂ ≠ cfg.C := +begin + intro h, + have h₁ := cfg.sbtw_A_A₁_A₂, + rw h at h₁, + refine cfg.not_collinear_ABC _, + have hc : collinear ℝ ({cfg.A, cfg.B, cfg.C, cfg.A₁} : set Pt) := + collinear_insert_insert_of_mem_affine_span_pair h₁.left_mem_affine_span + cfg.sbtw_B_A₁_C.left_mem_affine_span, + refine hc.subset (set.insert_subset_insert (set.insert_subset_insert _)), + rw set.singleton_subset_iff, + exact set.mem_insert _ _ +end + +lemma B₂_ne_B : cfg.B₂ ≠ cfg.B := by { rw ←symm_A₂, exact cfg.symm.A₂_ne_A } + +lemma B₂_ne_Q : cfg.B₂ ≠ cfg.Q := by { rw ←symm_A₂, exact cfg.symm.A₂_ne_P } + +lemma B₂_ne_A₂ : cfg.B₂ ≠ cfg.A₂ := +begin + intro h, + have hA : sbtw ℝ (cfg.triangle_ABC.points 1) cfg.A₁ (cfg.triangle_ABC.points 2) := + cfg.sbtw_B_A₁_C, + have hB : sbtw ℝ (cfg.triangle_ABC.points 0) cfg.B₁ (cfg.triangle_ABC.points 2) := + cfg.sbtw_A_B₁_C, + have hA' : cfg.A₂ ∈ line[ℝ, cfg.triangle_ABC.points 0, cfg.A₁] := + sphere.second_inter_vsub_mem_affine_span _ _ _, + have hB' : cfg.A₂ ∈ line[ℝ, cfg.triangle_ABC.points 1, cfg.B₁], + { rw ←h, exact sphere.second_inter_vsub_mem_affine_span _ _ _ }, + exact (sbtw_of_sbtw_of_sbtw_of_mem_affine_span_pair dec_trivial hA hB hA' hB').symm.not_rotate + cfg.sbtw_A_A₁_A₂.wbtw +end + +lemma wbtw_B_Q_B₂ : wbtw ℝ cfg.B cfg.Q cfg.B₂ := cfg.sbtw_B_B₁_B₂.wbtw.trans_left cfg.wbtw_B_Q_B₁ + +/-! ### The first equality in the first angle chase in the solution -/ + +section oriented + +variables [module.oriented ℝ V (fin 2)] + +lemma two_zsmul_oangle_QPA₂_eq_two_zsmul_oangle_BAA₂ : + (2 : ℤ) • ∡ cfg.Q cfg.P cfg.A₂ = (2 : ℤ) • ∡ cfg.B cfg.A cfg.A₂ := +begin + refine two_zsmul_oangle_of_parallel cfg.QP_parallel_BA _, + convert affine_subspace.parallel.refl _ using 1, + rw [cfg.collinear_PAA₁A₂.affine_span_eq_of_ne + (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ + (set.mem_singleton _)))) + (set.mem_insert_of_mem _ (set.mem_insert _ _)) cfg.A₂_ne_A, + cfg.collinear_PAA₁A₂.affine_span_eq_of_ne + (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ + (set.mem_singleton _)))) + (set.mem_insert _ _) cfg.A₂_ne_P] +end + +end oriented + +/-! ### More obvious configuration properties -/ + +lemma not_collinear_QPA₂ : ¬ collinear ℝ ({cfg.Q, cfg.P, cfg.A₂} : set Pt) := +begin + haveI := some_orientation V, + rw [collinear_iff_of_two_zsmul_oangle_eq cfg.two_zsmul_oangle_QPA₂_eq_two_zsmul_oangle_BAA₂, + ←affine_independent_iff_not_collinear_set], + have h : cospherical ({cfg.B, cfg.A, cfg.A₂} : set Pt), + { refine cfg.triangle_ABC.circumsphere.cospherical.subset _, + simp [set.insert_subset, cfg.A_mem_circumsphere, cfg.B_mem_circumsphere, + cfg.A₂_mem_circumsphere] }, + exact h.affine_independent_of_ne cfg.A_ne_B.symm cfg.A₂_ne_B.symm cfg.A₂_ne_A.symm +end + +lemma Q₁_ne_A₂ : cfg.Q₁ ≠ cfg.A₂ := +begin + intro h, + have h₁ := cfg.sbtw_Q_A₁_Q₁, + rw h at h₁, + refine cfg.not_collinear_QPA₂ _, + have hA₂ := cfg.sbtw_A_A₁_A₂.right_mem_affine_span, + have hA₂A₁ : line[ℝ, cfg.A₂, cfg.A₁] ≤ line[ℝ, cfg.A, cfg.A₁] := + affine_span_pair_le_of_left_mem hA₂, + have hQ : cfg.Q ∈ line[ℝ, cfg.A, cfg.A₁], + { rw affine_subspace.le_def' at hA₂A₁, + exact hA₂A₁ _ h₁.left_mem_affine_span }, + exact collinear_triple_of_mem_affine_span_pair hQ cfg.wbtw_A_P_A₁.mem_affine_span hA₂ +end + +lemma affine_independent_QPA₂ : affine_independent ℝ ![cfg.Q, cfg.P, cfg.A₂] := +affine_independent_iff_not_collinear_set.2 cfg.not_collinear_QPA₂ + +lemma affine_independent_PQB₂ : affine_independent ℝ ![cfg.P, cfg.Q, cfg.B₂] := +by { rw ←symm_A₂, exact cfg.symm.affine_independent_QPA₂ } + +/-- `QPA₂` as a `triangle`. -/ +def triangle_QPA₂ : triangle ℝ Pt := ⟨_, cfg.affine_independent_QPA₂⟩ + +/-- `PQB₂` as a `triangle`. -/ +def triangle_PQB₂ : triangle ℝ Pt := ⟨_, cfg.affine_independent_PQB₂⟩ + +lemma symm_triangle_QPA₂ : cfg.symm.triangle_QPA₂ = cfg.triangle_PQB₂ := +by { simp_rw [triangle_PQB₂, ←symm_A₂], ext i, fin_cases i; refl } + +/-- `ω` is the circle containing `Q`, `P` and `A₂`, which will be shown also to contain `B₂`, +`P₁` and `Q₁`. -/ +def ω : sphere Pt := cfg.triangle_QPA₂.circumsphere + +lemma P_mem_ω : cfg.P ∈ cfg.ω := cfg.triangle_QPA₂.mem_circumsphere 1 + +lemma Q_mem_ω : cfg.Q ∈ cfg.ω := cfg.triangle_QPA₂.mem_circumsphere 0 + +/-! ### The rest of the first angle chase in the solution -/ + +section oriented + +variables [module.oriented ℝ V (fin 2)] + +lemma two_zsmul_oangle_QPA₂_eq_two_zsmul_oangle_QB₂A₂ : + (2 : ℤ) • ∡ cfg.Q cfg.P cfg.A₂ = (2 : ℤ) • ∡ cfg.Q cfg.B₂ cfg.A₂ := +calc (2 : ℤ) • ∡ cfg.Q cfg.P cfg.A₂ = (2 : ℤ) • ∡ cfg.B cfg.A cfg.A₂ : + cfg.two_zsmul_oangle_QPA₂_eq_two_zsmul_oangle_BAA₂ + ... = (2 : ℤ) • ∡ cfg.B cfg.B₂ cfg.A₂ : + sphere.two_zsmul_oangle_eq cfg.B_mem_circumsphere cfg.A_mem_circumsphere + cfg.B₂_mem_circumsphere cfg.A₂_mem_circumsphere cfg.A_ne_B cfg.A₂_ne_A.symm + cfg.B₂_ne_B cfg.B₂_ne_A₂ + ... = (2 : ℤ) • ∡ cfg.Q cfg.B₂ cfg.A₂ : + by rw cfg.wbtw_B_Q_B₂.symm.oangle_eq_left cfg.B₂_ne_Q.symm + +end oriented + +/-! ### Conclusions from that first angle chase -/ + +lemma cospherical_QPB₂A₂ : cospherical ({cfg.Q, cfg.P, cfg.B₂, cfg.A₂} : set Pt) := +begin + haveI := some_orientation V, + exact cospherical_of_two_zsmul_oangle_eq_of_not_collinear + cfg.two_zsmul_oangle_QPA₂_eq_two_zsmul_oangle_QB₂A₂ cfg.not_collinear_QPA₂ +end + +lemma symm_ω_eq_triangle_PQB₂_circumsphere : cfg.symm.ω = cfg.triangle_PQB₂.circumsphere := +by rw [ω, symm_triangle_QPA₂] + +lemma symm_ω : cfg.symm.ω = cfg.ω := +begin + rw [symm_ω_eq_triangle_PQB₂_circumsphere, ω], + refine circumsphere_eq_of_cospherical hd2.out cfg.cospherical_QPB₂A₂ _ _, + { simp only [triangle_PQB₂, matrix.range_cons, matrix.range_empty, set.singleton_union, + insert_emptyc_eq], + rw set.insert_comm, + refine set.insert_subset_insert (set.insert_subset_insert _), + simp }, + { simp only [triangle_QPA₂, matrix.range_cons, matrix.range_empty, set.singleton_union, + insert_emptyc_eq], + refine set.insert_subset_insert (set.insert_subset_insert _), + simp } +end + +/-! ### The second angle chase in the solution -/ + +section oriented + +variables [module.oriented ℝ V (fin 2)] + +lemma two_zsmul_oangle_CA₂A₁_eq_two_zsmul_oangle_CBA : + (2 : ℤ) • ∡ cfg.C cfg.A₂ cfg.A₁ = (2 : ℤ) • ∡ cfg.C cfg.B cfg.A := +calc (2 : ℤ) • ∡ cfg.C cfg.A₂ cfg.A₁ = (2 : ℤ) • ∡ cfg.C cfg.A₂ cfg.A : + by rw cfg.sbtw_A_A₁_A₂.symm.oangle_eq_right + ... = (2 : ℤ) • ∡ cfg.C cfg.B cfg.A : + sphere.two_zsmul_oangle_eq cfg.C_mem_circumsphere cfg.A₂_mem_circumsphere + cfg.B_mem_circumsphere cfg.A_mem_circumsphere cfg.A₂_ne_C cfg.A₂_ne_A cfg.B_ne_C + cfg.A_ne_B.symm + +lemma two_zsmul_oangle_CA₂A₁_eq_two_zsmul_oangle_CQ₁A₁ : + (2 : ℤ) • ∡ cfg.C cfg.A₂ cfg.A₁ = (2 : ℤ) • ∡ cfg.C cfg.Q₁ cfg.A₁ := +calc (2 : ℤ) • ∡ cfg.C cfg.A₂ cfg.A₁ = (2 : ℤ) • ∡ cfg.C cfg.B cfg.A : + cfg.two_zsmul_oangle_CA₂A₁_eq_two_zsmul_oangle_CBA + ... = (2 : ℤ) • ∡ cfg.C cfg.Q₁ cfg.Q : by rw oangle_CQ₁Q_eq_oangle_CBA + ... = (2 : ℤ) • ∡ cfg.C cfg.Q₁ cfg.A₁ : by rw cfg.sbtw_Q_A₁_Q₁.symm.oangle_eq_right + +end oriented + +/-! ### Conclusions from that second angle chase -/ + +lemma not_collinear_CA₂A₁ : ¬collinear ℝ ({cfg.C, cfg.A₂, cfg.A₁} : set Pt) := +begin + haveI := some_orientation V, + rw [collinear_iff_of_two_zsmul_oangle_eq cfg.two_zsmul_oangle_CA₂A₁_eq_two_zsmul_oangle_CBA, + set.pair_comm, set.insert_comm, set.pair_comm], + exact cfg.not_collinear_ABC +end + +lemma cospherical_A₁Q₁CA₂ : cospherical ({cfg.A₁, cfg.Q₁, cfg.C, cfg.A₂} : set Pt) := +begin + haveI := some_orientation V, + rw [set.insert_comm cfg.Q₁, set.insert_comm cfg.A₁, set.pair_comm, set.insert_comm cfg.A₁, + set.pair_comm], + exact cospherical_of_two_zsmul_oangle_eq_of_not_collinear + cfg.two_zsmul_oangle_CA₂A₁_eq_two_zsmul_oangle_CQ₁A₁ cfg.not_collinear_CA₂A₁ +end + +/-! ### The third angle chase in the solution -/ + +section oriented + +variables [module.oriented ℝ V (fin 2)] + +lemma two_zsmul_oangle_QQ₁A₂_eq_two_zsmul_oangle_QPA₂ : + (2 : ℤ) • ∡ cfg.Q cfg.Q₁ cfg.A₂ = (2 : ℤ) • ∡ cfg.Q cfg.P cfg.A₂ := +calc (2 : ℤ) • ∡ cfg.Q cfg.Q₁ cfg.A₂ = (2 : ℤ) • ∡ cfg.A₁ cfg.Q₁ cfg.A₂ : + by rw cfg.sbtw_Q_A₁_Q₁.symm.oangle_eq_left + ... = (2 : ℤ) • ∡ cfg.A₁ cfg.C cfg.A₂ : + cfg.cospherical_A₁Q₁CA₂.two_zsmul_oangle_eq cfg.sbtw_Q_A₁_Q₁.right_ne cfg.Q₁_ne_A₂ + cfg.A₁_ne_C.symm cfg.A₂_ne_C.symm + ... = (2 : ℤ) • ∡ cfg.B cfg.C cfg.A₂ : by rw cfg.sbtw_B_A₁_C.symm.oangle_eq_left + ... = (2 : ℤ) • ∡ cfg.B cfg.A cfg.A₂ : + sphere.two_zsmul_oangle_eq cfg.B_mem_circumsphere cfg.C_mem_circumsphere + cfg.A_mem_circumsphere cfg.A₂_mem_circumsphere cfg.B_ne_C.symm cfg.A₂_ne_C.symm cfg.A_ne_B + cfg.A₂_ne_A.symm + ... = (2 : ℤ) • ∡ cfg.Q cfg.P cfg.A₂ : cfg.two_zsmul_oangle_QPA₂_eq_two_zsmul_oangle_BAA₂.symm + +end oriented + +/-! ### Conclusions from that third angle chase -/ + +lemma Q₁_mem_ω : cfg.Q₁ ∈ cfg.ω := +begin + haveI := some_orientation V, + exact affine.triangle.mem_circumsphere_of_two_zsmul_oangle_eq (dec_trivial : (0 : fin 3) ≠ 1) + (dec_trivial : (0 : fin 3) ≠ 2) dec_trivial cfg.two_zsmul_oangle_QQ₁A₂_eq_two_zsmul_oangle_QPA₂ +end + +lemma P₁_mem_ω : cfg.P₁ ∈ cfg.ω := by { rw ←symm_ω, exact cfg.symm.Q₁_mem_ω } + +theorem result : concyclic ({cfg.P, cfg.Q, cfg.P₁, cfg.Q₁} : set Pt) := +begin + refine ⟨_, coplanar_of_fact_finrank_eq_two _⟩, + rw cospherical_iff_exists_sphere, + refine ⟨cfg.ω, _⟩, + simp only [set.insert_subset, set.singleton_subset_iff], + exact ⟨cfg.P_mem_ω, cfg.Q_mem_ω, cfg.P₁_mem_ω, cfg.Q₁_mem_ω⟩ +end + +end imo2019q2_cfg + +end imo2019_q2 + +open imo2019_q2 + +theorem imo2019_q2 (A B C A₁ B₁ P Q P₁ Q₁ : Pt) + (affine_independent_ABC : affine_independent ℝ ![A, B, C]) + (wbtw_B_A₁_C : wbtw ℝ B A₁ C) (wbtw_A_B₁_C : wbtw ℝ A B₁ C) (wbtw_A_P_A₁ : wbtw ℝ A P A₁) + (wbtw_B_Q_B₁ : wbtw ℝ B Q B₁) (PQ_parallel_AB : line[ℝ, P, Q] ∥ line[ℝ, A, B]) (P_ne_Q : P ≠ Q) + (sbtw_P_B₁_P₁ : sbtw ℝ P B₁ P₁) (angle_PP₁C_eq_angle_BAC : ∠ P P₁ C = ∠ B A C) + (C_ne_P₁ : C ≠ P₁) (sbtw_Q_A₁_Q₁ : sbtw ℝ Q A₁ Q₁) + (angle_CQ₁Q_eq_angle_CBA : ∠ C Q₁ Q = ∠ C B A) (C_ne_Q₁ : C ≠ Q₁) : + concyclic ({P, Q, P₁, Q₁} : set Pt) := +(⟨A, B, C, A₁, B₁, P, Q, P₁, Q₁, affine_independent_ABC, wbtw_B_A₁_C, wbtw_A_B₁_C, wbtw_A_P_A₁, + wbtw_B_Q_B₁, PQ_parallel_AB, P_ne_Q, sbtw_P_B₁_P₁, angle_PP₁C_eq_angle_BAC, C_ne_P₁, + sbtw_Q_A₁_Q₁, angle_CQ₁Q_eq_angle_CBA, C_ne_Q₁⟩ : imo2019q2_cfg V Pt).result diff --git a/archive/imo/imo2019_q4.lean b/archive/imo/imo2019_q4.lean index 9399020bc73bc..05af48d4acb6e 100644 --- a/archive/imo/imo2019_q4.lean +++ b/archive/imo/imo2019_q4.lean @@ -5,12 +5,14 @@ Authors: Floris van Doorn -/ import tactic.interval_cases import algebra.big_operators.order -import algebra.big_operators.enat import data.nat.multiplicity /-! # IMO 2019 Q4 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Find all pairs `(k, n)` of positive integers such that ``` k! = (2 ^ n - 1)(2 ^ n - 2)(2 ^ n - 4)···(2 ^ n - 2 ^ (n - 1)) @@ -27,20 +29,22 @@ individually. open_locale nat big_operators open finset multiplicity nat (hiding zero_le prime) -theorem imo2019_q4_upper_bound {k n : ℕ} (hk : k > 0) +namespace imo2019_q4 + +theorem upper_bound {k n : ℕ} (hk : k > 0) (h : (k! : ℤ) = ∏ i in range n, (2 ^ n - 2 ^ i)) : n < 6 := begin have prime_2 : prime (2 : ℤ), { exact prime_iff_prime_int.mp prime_two }, have h2 : n * (n - 1) / 2 < k, { suffices : multiplicity 2 (k! : ℤ) = (n * (n - 1) / 2 : ℕ), - { rw [← enat.coe_lt_coe, ← this], change multiplicity ((2 : ℕ) : ℤ) _ < _, + { rw [← part_enat.coe_lt_coe, ← this], change multiplicity ((2 : ℕ) : ℤ) _ < _, simp_rw [int.coe_nat_multiplicity, multiplicity_two_factorial_lt hk.lt.ne.symm] }, - rw [h, multiplicity.finset.prod prime_2, ← sum_range_id, ← sum_nat_coe_enat], + rw [h, multiplicity.finset.prod prime_2, ← sum_range_id, nat.cast_sum], apply sum_congr rfl, intros i hi, rw [multiplicity_sub_of_gt, multiplicity_pow_self_of_prime prime_2], rwa [multiplicity_pow_self_of_prime prime_2, multiplicity_pow_self_of_prime prime_2, - enat.coe_lt_coe, ←mem_range] }, + part_enat.coe_lt_coe, ←mem_range] }, rw [←not_le], intro hn, apply ne_of_lt _ h.symm, suffices : (∏ i in range n, 2 ^ n : ℤ) < ↑k!, @@ -68,6 +72,8 @@ begin convert add_le_add_left (add_le_add_left h5 (2 * n')) (n' * n') using 1, ring end +end imo2019_q4 + theorem imo2019_q4 {k n : ℕ} (hk : k > 0) (hn : n > 0) : (k! : ℤ) = (∏ i in range n, (2 ^ n - 2 ^ i)) ↔ (k, n) = (1, 1) ∨ (k, n) = (3, 2) := begin @@ -77,10 +83,10 @@ begin norm_num [prod_range_succ, succ_mul] }, intro h, /- We know that n < 6. -/ - have := imo2019_q4_upper_bound hk h, + have := imo2019_q4.upper_bound hk h, interval_cases n, /- n = 1 -/ - { left, congr, norm_num at h, norm_cast at h, rw [factorial_eq_one] at h, apply antisymm h, + { left, congr, norm_num at h, rw [factorial_eq_one] at h, apply antisymm h, apply succ_le_of_lt hk }, /- n = 2 -/ { right, congr, norm_num [prod_range_succ] at h, norm_cast at h, rw [← factorial_inj], diff --git a/archive/imo/imo2020_q2.lean b/archive/imo/imo2020_q2.lean index beea58a78ff17..54938a0afb1ec 100644 --- a/archive/imo/imo2020_q2.lean +++ b/archive/imo/imo2020_q2.lean @@ -9,6 +9,9 @@ import analysis.mean_inequalities /-! # IMO 2020 Q2 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The real numbers `a`, `b`, `c`, `d` are such that `a ≥ b ≥ c ≥ d > 0` and `a + b + c + d = 1`. Prove that `(a + 2b + 3c + 4d) a^a b^b c^c d^d < 1`. diff --git a/archive/imo/imo2021_q1.lean b/archive/imo/imo2021_q1.lean index 2555d8cc6fddc..397823fa856e1 100644 --- a/archive/imo/imo2021_q1.lean +++ b/archive/imo/imo2021_q1.lean @@ -14,6 +14,9 @@ import tactic.ring_exp /-! # IMO 2021 Q1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `n≥100` be an integer. Ivan writes the numbers `n, n+1,..., 2n` each on different cards. He then shuffles these `n+1` cards, and divides them into two piles. Prove that at least one of the piles contains two cards such that the sum of their numbers is a perfect square. @@ -43,6 +46,8 @@ which finishes the proof. open real +namespace imo2021_q1 + lemma lower_bound (n l : ℕ) (hl : 2 + sqrt (4 + 2 * n) ≤ 2 * l) : n + 4 * l ≤ 2 * l * l := begin @@ -91,9 +96,8 @@ end lemma exists_numbers_in_interval (n : ℕ) (hn : 107 ≤ n) : ∃ (l : ℕ), (n + 4 * l ≤ 2 * l * l ∧ 2 * l * l + 4 * l ≤ 2 * n) := begin - suffices : ∃ (l : ℕ), 2 + sqrt (4 + 2 * n) ≤ 2 * (l : ℝ) ∧ (l : ℝ) ≤ sqrt (1 + n) - 1, - { cases this with l t, - exact ⟨l, lower_bound n l t.1, upper_bound n l t.2⟩ }, + rsuffices ⟨l, t⟩ : ∃ (l : ℕ), 2 + sqrt (4 + 2 * n) ≤ 2 * (l : ℝ) ∧ (l : ℝ) ≤ sqrt (1 + n) - 1, + { exact ⟨l, lower_bound n l t.1, upper_bound n l t.2⟩ }, let x := sqrt (1 + n) - 1, refine ⟨⌊x⌋₊, _, _⟩, { transitivity 2 * (x - 1), @@ -151,7 +155,11 @@ begin rintros d (rfl|rfl|rfl); split; linarith only [hna, hab, hbc, hcn], }, end -theorem IMO_2021_Q1 : ∀ (n : ℕ), 100 ≤ n → ∀ (A ⊆ finset.Icc n (2 * n)), +end imo2021_q1 + +open imo2021_q1 + +theorem imo2021_q1 : ∀ (n : ℕ), 100 ≤ n → ∀ (A ⊆ finset.Icc n (2 * n)), (∃ (a b ∈ A), a ≠ b ∧ ∃ (k : ℕ), a + b = k * k) ∨ (∃ (a b ∈ finset.Icc n (2 * n) \ A), a ≠ b ∧ ∃ (k : ℕ), a + b = k * k) := begin diff --git a/archive/leanpkg.toml b/archive/leanpkg.toml new file mode 100644 index 0000000000000..a89c0e895b5f7 --- /dev/null +++ b/archive/leanpkg.toml @@ -0,0 +1,7 @@ +[package] +name = "mathlib-archive" +version = "0.1" +path = "." + +[dependencies] +mathlib = {path = ".."} diff --git a/archive/miu_language/basic.lean b/archive/miu_language/basic.lean index f4ca4329c312d..ad139d96ffe3b 100644 --- a/archive/miu_language/basic.lean +++ b/archive/miu_language/basic.lean @@ -8,6 +8,9 @@ import tactic.linarith /-! # An MIU Decision Procedure in Lean +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The [MIU formal system](https://en.wikipedia.org/wiki/MU_puzzle) was introduced by Douglas Hofstadter in the first chapter of his 1979 book, [Gödel, Escher, Bach](https://en.wikipedia.org/wiki/G%C3%B6del,_Escher,_Bach). diff --git a/archive/miu_language/decision_nec.lean b/archive/miu_language/decision_nec.lean index bce4122c11fbe..c6c5b287d1d28 100644 --- a/archive/miu_language/decision_nec.lean +++ b/archive/miu_language/decision_nec.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Gihan Marasingha -/ import .basic +import data.list.count import data.nat.modeq import tactic.ring /-! # Decision procedure: necessary condition +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce a condition `decstr` and show that if a string `en` is `derivable`, then `decstr en` holds. @@ -57,7 +61,7 @@ begin cases h2, { rw h2, exact h1, }, { cases h1, - { right, simpa [h2,mul_mod,h1], }, + { right, simp [h2,mul_mod,h1, nat.succ_lt_succ] }, { left, simpa [h2,mul_mod,h1], }, }, end diff --git a/archive/miu_language/decision_suf.lean b/archive/miu_language/decision_suf.lean index 6ead3de8bc3ff..8625a706de47b 100644 --- a/archive/miu_language/decision_suf.lean +++ b/archive/miu_language/decision_suf.lean @@ -9,6 +9,9 @@ import tactic.linarith /-! # Decision procedure - sufficient condition and decidability +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We give a sufficient condition for a string to be derivable in the MIU language. Together with the necessary condition, we use this to prove that `derivable` is an instance of `decidable_pred`. @@ -52,11 +55,11 @@ open miu_atom list nat We start by showing that an `miustr` `M::w` can be derived, where `w` consists only of `I`s and where `count I w` is a power of 2. -/ -private lemma der_cons_repeat (n : ℕ) : derivable (M::(repeat I (2^n))) := +private lemma der_cons_replicate (n : ℕ) : derivable (M::(replicate (2^n) I)) := begin induction n with k hk, { constructor, }, -- base case - { rw [succ_eq_add_one, pow_add, pow_one 2, mul_two,repeat_add], -- inductive step + { rw [succ_eq_add_one, pow_add, pow_one 2, mul_two,replicate_add], -- inductive step exact derivable.r2 hk, }, end @@ -81,16 +84,16 @@ an even number of `U`s and `z` is any `miustr`. Any number of successive occurrences of `"UU"` can be removed from the end of a `derivable` `miustr` to produce another `derivable` `miustr`. -/ -lemma der_of_der_append_repeat_U_even {z : miustr} {m : ℕ} (h : derivable (z ++ repeat U (m*2))) - : derivable z := +lemma der_of_der_append_replicate_U_even {z : miustr} {m : ℕ} + (h : derivable (z ++ replicate (m*2) U)) : derivable z := begin induction m with k hk, { revert h, - simp only [list.repeat, zero_mul, append_nil, imp_self], }, + simp only [list.replicate, zero_mul, append_nil, imp_self], }, { apply hk, - simp only [succ_mul, repeat_add] at h, - change repeat U 2 with [U,U] at h, - rw ←(append_nil (z ++ repeat U (k*2) )), + simp only [succ_mul, replicate_add] at h, + change replicate 2 U with [U,U] at h, + rw ←(append_nil (z ++ replicate (k*2) U)), apply derivable.r4, simp only [append_nil, append_assoc,h], }, end @@ -106,24 +109,24 @@ In fine-tuning my application of `simp`, I issued the following commend to deter We may replace several consecutive occurrences of `"III"` with the same number of `"U"`s. In application of the following lemma, `xs` will either be `[]` or `[U]`. -/ -lemma der_cons_repeat_I_repeat_U_append_of_der_cons_repeat_I_append (c k : ℕ) - (hc : c % 3 = 1 ∨ c % 3 = 2) (xs : miustr) (hder : derivable (M ::(repeat I (c+3*k)) ++ xs)) : - derivable (M::(repeat I c ++ repeat U k) ++ xs) := +lemma der_cons_replicate_I_replicate_U_append_of_der_cons_replicate_I_append (c k : ℕ) + (hc : c % 3 = 1 ∨ c % 3 = 2) (xs : miustr) (hder : derivable (M ::(replicate (c+3*k) I) ++ xs)) : + derivable (M::(replicate c I ++ replicate k U) ++ xs) := begin revert xs, induction k with a ha, - { simp only [list.repeat, mul_zero, add_zero, append_nil, forall_true_iff, imp_self],}, + { simp only [list.replicate, mul_zero, add_zero, append_nil, forall_true_iff, imp_self],}, { intro xs, specialize ha (U::xs), intro h₂, - simp only [succ_eq_add_one, repeat_add], -- We massage the goal + simp only [succ_eq_add_one, replicate_add], -- We massage the goal rw [←append_assoc, ←cons_append], -- into a form amenable - change repeat U 1 with [U], -- to the application of + change replicate 1 U with [U], -- to the application of rw [append_assoc, singleton_append], -- ha. apply ha, apply derivable.r3, - change [I,I,I] with repeat I 3, - simp only [cons_append, ←repeat_add], + change [I,I,I] with replicate 3 I, + simp only [cons_append, ←replicate_add], convert h₂, }, end @@ -178,62 +181,67 @@ end end arithmetic -lemma repeat_pow_minus_append {m : ℕ} : M :: repeat I (2^m - 1) ++ [I] = M::(repeat I (2^m)) := +lemma replicate_pow_minus_append {m : ℕ} : + M :: replicate (2^m - 1) I ++ [I] = M::(replicate (2^m) I) := begin - change [I] with repeat I 1, - rw [cons_append, ←repeat_add, tsub_add_cancel_of_le (one_le_pow' m 1)], + change [I] with replicate 1 I, + rw [cons_append, ←replicate_add, tsub_add_cancel_of_le (one_le_pow' m 1)], end /-- -`der_repeat_I_of_mod3` states that `M::y` is `derivable` if `y` is any `miustr` consisiting just of -`I`s, where `count I y` is 1 or 2 modulo 3. +`der_replicate_I_of_mod3` states that `M::y` is `derivable` if `y` is any `miustr` consisiting just +of `I`s, where `count I y` is 1 or 2 modulo 3. -/ -lemma der_repeat_I_of_mod3 (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2): - derivable (M::(repeat I c)) := +lemma der_replicate_I_of_mod3 (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2): + derivable (M::(replicate c I)) := begin - -- From `der_cons_repeat`, we can derive the `miustr` `M::w` described in the introduction. + -- From `der_cons_replicate`, we can derive the `miustr` `M::w` described in the introduction. cases (le_pow2_and_pow2_eq_mod3 c h) with m hm, -- `2^m` will be the number of `I`s in `M::w` - have hw₂ : derivable (M::(repeat I (2^m)) ++ repeat U ((2^m -c)/3 % 2)), + have hw₂ : derivable (M::(replicate (2^m) I) ++ replicate ((2^m -c)/3 % 2) U), { cases mod_two_eq_zero_or_one ((2^m -c)/3) with h_zero h_one, - { simp only [der_cons_repeat m, append_nil,list.repeat, h_zero], }, -- `(2^m - c)/3 ≡ 0 [MOD 2]` - { rw [h_one, ←repeat_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]` + { -- `(2^m - c)/3 ≡ 0 [MOD 2]` + simp only [der_cons_replicate m, append_nil,list.replicate, h_zero], }, + { rw [h_one, ←replicate_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]` apply derivable.r1, - rw repeat_pow_minus_append, - exact (der_cons_repeat m), }, }, - have hw₃ : derivable (M::(repeat I c) ++ repeat U ((2^m-c)/3) ++ repeat U ((2^m-c)/3 % 2)), - { apply der_cons_repeat_I_repeat_U_append_of_der_cons_repeat_I_append c ((2^m-c)/3) h, + rw replicate_pow_minus_append, + exact (der_cons_replicate m), }, }, + have hw₃ : + derivable (M::(replicate c I) ++ replicate ((2^m-c)/3) U ++ replicate ((2^m-c)/3 % 2) U), + { apply der_cons_replicate_I_replicate_U_append_of_der_cons_replicate_I_append c ((2^m-c)/3) h, convert hw₂, -- now we must show `c + 3 * ((2 ^ m - c) / 3) = 2 ^ m` rw nat.mul_div_cancel', { exact add_tsub_cancel_of_le hm.1 }, { exact (modeq_iff_dvd' hm.1).mp hm.2.symm } }, - rw [append_assoc, ←repeat_add _ _] at hw₃, + rw [append_assoc, ←replicate_add _ _] at hw₃, cases add_mod2 ((2^m-c)/3) with t ht, rw ht at hw₃, - exact der_of_der_append_repeat_U_even hw₃, + exact der_of_der_append_replicate_U_even hw₃, end example (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2): - derivable (M::(repeat I c)) := + derivable (M::(replicate c I)) := begin - -- From `der_cons_repeat`, we can derive the `miustr` `M::w` described in the introduction. + -- From `der_cons_replicate`, we can derive the `miustr` `M::w` described in the introduction. cases (le_pow2_and_pow2_eq_mod3 c h) with m hm, -- `2^m` will be the number of `I`s in `M::w` - have hw₂ : derivable (M::(repeat I (2^m)) ++ repeat U ((2^m -c)/3 % 2)), + have hw₂ : derivable (M::(replicate (2^m) I) ++ replicate ((2^m -c)/3 % 2) U), { cases mod_two_eq_zero_or_one ((2^m -c)/3) with h_zero h_one, - { simp only [der_cons_repeat m, append_nil, list.repeat,h_zero], }, -- `(2^m - c)/3 ≡ 0 [MOD 2]` - { rw [h_one, ←repeat_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]` + { -- `(2^m - c)/3 ≡ 0 [MOD 2]` + simp only [der_cons_replicate m, append_nil, list.replicate, h_zero] }, + { rw [h_one, ←replicate_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]` apply derivable.r1, - rw repeat_pow_minus_append, - exact (der_cons_repeat m), }, }, - have hw₃ : derivable (M::(repeat I c) ++ repeat U ((2^m-c)/3) ++ repeat U ((2^m-c)/3 % 2)), - { apply der_cons_repeat_I_repeat_U_append_of_der_cons_repeat_I_append c ((2^m-c)/3) h, + rw replicate_pow_minus_append, + exact (der_cons_replicate m), }, }, + have hw₃ : + derivable (M::(replicate c I) ++ replicate ((2^m-c)/3) U ++ replicate ((2^m-c)/3 % 2) U), + { apply der_cons_replicate_I_replicate_U_append_of_der_cons_replicate_I_append c ((2^m-c)/3) h, convert hw₂, -- now we must show `c + 3 * ((2 ^ m - c) / 3) = 2 ^ m` rw nat.mul_div_cancel', { exact add_tsub_cancel_of_le hm.1 }, { exact (modeq_iff_dvd' hm.1).mp hm.2.symm } }, - rw [append_assoc, ←repeat_add _ _] at hw₃, + rw [append_assoc, ←replicate_add _ _] at hw₃, cases add_mod2 ((2^m-c)/3) with t ht, rw ht at hw₃, - exact der_of_der_append_repeat_U_even hw₃, + exact der_of_der_append_replicate_U_even hw₃, end /-! @@ -278,14 +286,12 @@ begin rcases (exists_cons_of_ne_nil this) with ⟨y,ys,rfl⟩, rw head at mhead, rw mhead at *, - suffices : ∃ c, repeat I c = ys ∧ (c % 3 = 1 ∨ c % 3 = 2), - { rcases this with ⟨c, hysr, hc⟩, - rw ←hysr, - exact der_repeat_I_of_mod3 c hc, }, + rsuffices ⟨c, rfl, hc⟩ : ∃ c, replicate c I = ys ∧ (c % 3 = 1 ∨ c % 3 = 2), + { exact der_replicate_I_of_mod3 c hc, }, { simp only [count] at *, use (count I ys), refine and.intro _ hi, - apply repeat_count_eq_of_count_eq_length, + apply replicate_count_eq_of_count_eq_length, exact count_I_eq_length_of_count_U_zero_and_neg_mem hu nmtail, }, end diff --git a/archive/oxford_invariants/2021summer/week3_p1.lean b/archive/oxford_invariants/2021summer/week3_p1.lean index e6c9599da8f9d..cf1d4fe0e3ed0 100644 --- a/archive/oxford_invariants/2021summer/week3_p1.lean +++ b/archive/oxford_invariants/2021summer/week3_p1.lean @@ -5,11 +5,15 @@ Authors: Yaël Dillies, Bhavik Mehta -/ import algebra.big_operators.order import algebra.big_operators.ring +import algebra.char_zero.lemmas import data.rat.cast /-! # The Oxford Invariants Puzzle Challenges - Summer 2021, Week 3, Problem 1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Original statement Let `n ≥ 3`, `a₁, ..., aₙ` be strictly positive integers such that `aᵢ ∣ aᵢ₋₁ + aᵢ₊₁` for @@ -21,7 +25,7 @@ Mathlib is based on type theory, so saying that a rational is a natural doesn't we ask that there exists `b : ℕ` whose cast to `α` is the sum we want. In mathlib, `ℕ` starts at `0`. To make the indexing cleaner, we use `a₀, ..., aₙ₋₁` instead of -`a₁, ..., aₙ`. Similarly, it's nicer to not use substraction of naturals, so we replace +`a₁, ..., aₙ`. Similarly, it's nicer to not use subtraction of naturals, so we replace `aᵢ ∣ aᵢ₋₁ + aᵢ₊₁` by `aᵢ₊₁ ∣ aᵢ + aᵢ₊₂`. We don't actually have to work in `ℚ` or `ℝ`. We can be even more general by stating the result for @@ -71,7 +75,7 @@ open_locale big_operators variables {α : Type*} [linear_ordered_field α] -theorem week3_p1 (n : ℕ) (a : ℕ → ℕ) (a_pos : ∀ i ≤ n, 0 < a i) +theorem oxford_invariants.week3_p1 (n : ℕ) (a : ℕ → ℕ) (a_pos : ∀ i ≤ n, 0 < a i) (ha : ∀ i, i + 2 ≤ n → a (i + 1) ∣ a i + a (i + 2)) : ∃ b : ℕ, (b : α) = ∑ i in finset.range n, (a 0 * a n)/(a i * a (i + 1)) := begin @@ -82,10 +86,10 @@ begin { exact ⟨0, by rw [nat.cast_zero, finset.sum_range_zero]⟩ }, -- `⟨Claim it, Prove it⟩` /- Case `n ≥ 1`. We replace `n` by `n + 1` everywhere to make this inequality explicit Set up the stronger induction hypothesis -/ - suffices h : ∃ b : ℕ, (b : α) = ∑ i in finset.range (n + 1), (a 0 * a (n + 1))/(a i * a (i + 1)) - ∧ a (n + 1) ∣ a n * b - a 0, - { obtain ⟨b, hb, -⟩ := h, - exact ⟨b, hb⟩ }, + rsuffices ⟨b, hb, -⟩ : + ∃ b : ℕ, (b : α) = ∑ i in finset.range (n + 1), (a 0 * a (n + 1)) / (a i * a (i + 1)) + ∧ a (n + 1) ∣ a n * b - a 0, + { exact ⟨b, hb⟩ }, simp_rw ←@nat.cast_pos α at a_pos, /- Declare the induction `ih` will be the induction hypothesis -/ @@ -105,7 +109,7 @@ begin obtain ⟨b, hb, han⟩ := ih (λ i hi, ha i $ nat.le_succ_of_le hi) (λ i hi, a_pos i $ nat.le_succ_of_le hi), specialize ha n le_rfl, - have ha₀ : a 0 ≤ a n * b, -- Needing this is an artifact of `ℕ`-substraction. + have ha₀ : a 0 ≤ a n * b, -- Needing this is an artifact of `ℕ`-subtraction. { rw [←@nat.cast_le α, nat.cast_mul, hb, ←div_le_iff' (a_pos _ $ n.le_succ.trans $ nat.le_succ _), ←mul_div_mul_right _ _ (a_pos _ $ nat.le_succ _).ne'], suffices h : ∀ i, i ∈ finset.range (n + 1) → 0 ≤ (a 0 : α) * a (n + 1) / (a i * a (i + 1)), diff --git a/archive/sensitivity.lean b/archive/sensitivity.lean index b0dfa141ff98a..1bd54993a14c4 100644 --- a/archive/sensitivity.lean +++ b/archive/sensitivity.lean @@ -15,6 +15,9 @@ import data.real.sqrt /-! # Huang's sensitivity theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A formalization of Hao Huang's sensitivity theorem: in the hypercube of dimension n ≥ 1, if one colors more than half the vertices then at least one vertex has at least √n colored neighbors. @@ -33,6 +36,8 @@ The project was developed at https://github.com/leanprover-community/lean-sensit archived at https://github.com/leanprover-community/mathlib/blob/master/archive/sensitivity.lean -/ +namespace sensitivity + /-! The next two lines assert we do not want to give a constructive proof, but rather use classical logic. -/ noncomputable theory @@ -43,7 +48,7 @@ open_locale big_operators notation `√` := real.sqrt -open function bool linear_map fintype finite_dimensional dual_pair +open function bool linear_map fintype finite_dimensional module.dual_bases /-! ### The hypercube @@ -217,9 +222,11 @@ begin rwa show p = π q, by { ext, simp [q, fin.succ_ne_zero, π] } } } end +open module + /-- `e` and `ε` are dual families of vectors. It implies that `e` is indeed a basis and `ε` computes coefficients of decompositions of vectors on that basis. -/ -def dual_pair_e_ε (n : ℕ) : dual_pair (@e n) (@ε n) := +def dual_bases_e_ε (n : ℕ) : dual_bases (@e n) (@ε n) := { eval := duality, total := @epsilon_total _ } @@ -228,15 +235,15 @@ since this cardinal is finite, as a natural number in `finrank_V` -/ lemma dim_V : module.rank ℝ (V n) = 2^n := have module.rank ℝ (V n) = (2^n : ℕ), - by { rw [dim_eq_card_basis (dual_pair_e_ε _).basis, Q.card]; apply_instance }, + by { rw [rank_eq_card_basis (dual_bases_e_ε _).basis, Q.card]; apply_instance }, by assumption_mod_cast instance : finite_dimensional ℝ (V n) := -finite_dimensional.of_fintype_basis (dual_pair_e_ε _).basis +finite_dimensional.of_fintype_basis (dual_bases_e_ε _).basis lemma finrank_V : finrank ℝ (V n) = 2^n := have _ := @dim_V n, -by rw ←finrank_eq_dim at this; assumption_mod_cast +by rw ←finrank_eq_rank at this; assumption_mod_cast /-! ### The linear map -/ @@ -332,7 +339,7 @@ In this section, in order to enforce that `n` is positive, we write it as `m + 1` for some natural number `m`. -/ /-! `dim X` will denote the dimension of a subspace `X` as a cardinal. -/ -notation `dim` X:70 := module.rank ℝ ↥X +notation `dim ` X:70 := module.rank ℝ ↥X /-! `fdim X` will denote the (finite) dimension of a subspace `X` as a natural number. -/ notation `fdim` := finrank ℝ @@ -341,7 +348,7 @@ notation `Span` := submodule.span ℝ /-! `Card X` will denote the cardinal of a subset of a finite type, as a natural number. -/ -notation `Card` X:70 := X.to_finset.card +notation `Card ` X:70 := X.to_finset.card /-! In the following, `⊓` and `⊔` will denote intersection and sums of ℝ-subspaces, equipped with their subspace structures. The notations come from the general @@ -357,25 +364,25 @@ begin let img := (g m).range, suffices : 0 < dim (W ⊓ img), { simp only [exists_prop], - exact_mod_cast exists_mem_ne_zero_of_dim_pos this }, + exact_mod_cast exists_mem_ne_zero_of_rank_pos this }, have dim_le : dim (W ⊔ img) ≤ 2^(m + 1), - { convert ← dim_submodule_le (W ⊔ img), + { convert ← rank_submodule_le (W ⊔ img), apply dim_V }, have dim_add : dim (W ⊔ img) + dim (W ⊓ img) = dim W + 2^m, - { convert ← dim_sup_add_dim_inf_eq W img, - rw ← dim_eq_of_injective (g m) g_injective, + { convert ← submodule.rank_sup_add_rank_inf_eq W img, + rw ← rank_eq_of_injective (g m) g_injective, apply dim_V }, have dimW : dim W = card H, { have li : linear_independent ℝ (H.restrict e), - { convert (dual_pair_e_ε _).basis.linear_independent.comp _ subtype.val_injective, - rw (dual_pair_e_ε _).coe_basis }, - have hdW := dim_span li, + { convert (dual_bases_e_ε _).basis.linear_independent.comp _ subtype.val_injective, + rw (dual_bases_e_ε _).coe_basis }, + have hdW := rank_span li, rw set.range_restrict at hdW, convert hdW, - rw [← (dual_pair_e_ε _).coe_basis, cardinal.mk_image_eq (dual_pair_e_ε _).basis.injective, + rw [← (dual_bases_e_ε _).coe_basis, cardinal.mk_image_eq (dual_bases_e_ε _).basis.injective, cardinal.mk_fintype] }, - rw ← finrank_eq_dim ℝ at ⊢ dim_le dim_add dimW, - rw [← finrank_eq_dim ℝ, ← finrank_eq_dim ℝ] at dim_add, + rw ← finrank_eq_rank ℝ at ⊢ dim_le dim_add dimW, + rw [← finrank_eq_rank ℝ, ← finrank_eq_rank ℝ] at dim_add, norm_cast at ⊢ dim_le dim_add dimW, rw pow_succ' at dim_le, rw set.to_finset_card at hH, @@ -387,28 +394,28 @@ theorem huang_degree_theorem (H : set (Q (m + 1))) (hH : Card H ≥ 2^m + 1) : ∃ q, q ∈ H ∧ √(m + 1) ≤ Card (H ∩ q.adjacent) := begin rcases exists_eigenvalue H hH with ⟨y, ⟨⟨y_mem_H, y_mem_g⟩, y_ne⟩⟩, - have coeffs_support : ((dual_pair_e_ε (m+1)).coeffs y).support ⊆ H.to_finset, + have coeffs_support : ((dual_bases_e_ε (m+1)).coeffs y).support ⊆ H.to_finset, { intros p p_in, rw finsupp.mem_support_iff at p_in, rw set.mem_to_finset, - exact (dual_pair_e_ε _).mem_of_mem_span y_mem_H p p_in }, + exact (dual_bases_e_ε _).mem_of_mem_span y_mem_H p p_in }, obtain ⟨q, H_max⟩ : ∃ q : Q (m+1), ∀ q' : Q (m+1), |(ε q' : _) y| ≤ |ε q y|, - from fintype.exists_max _, + from finite.exists_max _, have H_q_pos : 0 < |ε q y|, { contrapose! y_ne, exact epsilon_total (λ p, abs_nonpos_iff.mp (le_trans (H_max p) y_ne)) }, - refine ⟨q, (dual_pair_e_ε _).mem_of_mem_span y_mem_H q (abs_pos.mp H_q_pos), _⟩, + refine ⟨q, (dual_bases_e_ε _).mem_of_mem_span y_mem_H q (abs_pos.mp H_q_pos), _⟩, let s := √(m+1), suffices : s * |ε q y| ≤ ↑(_) * |ε q y|, from (mul_le_mul_right H_q_pos).mp ‹_›, - let coeffs := (dual_pair_e_ε (m+1)).coeffs, + let coeffs := (dual_bases_e_ε (m+1)).coeffs, calc s * |ε q y| = |ε q (s • y)| : by rw [map_smul, smul_eq_mul, abs_mul, abs_of_nonneg (real.sqrt_nonneg _)] ... = |ε q (f (m+1) y)| : by rw [← f_image_g y (by simpa using y_mem_g)] - ... = |ε q (f (m+1) (lc _ (coeffs y)))| : by rw (dual_pair_e_ε _).lc_coeffs y + ... = |ε q (f (m+1) (lc _ (coeffs y)))| : by rw (dual_bases_e_ε _).lc_coeffs y ... = |(coeffs y).sum (λ (i : Q (m + 1)) (a : ℝ), a • ((ε q) ∘ (f (m + 1)) ∘ λ (i : Q (m + 1)), e i) i)| : by erw [(f $ m + 1).map_finsupp_total, (ε q).map_finsupp_total, finsupp.total_apply] @@ -433,3 +440,5 @@ begin convert finset.inter_subset_inter_right coeffs_support end end + +end sensitivity diff --git a/archive/100-theorems-list/README.md b/archive/wiedijk_100_theorems/README.md similarity index 100% rename from archive/100-theorems-list/README.md rename to archive/wiedijk_100_theorems/README.md diff --git a/archive/wiedijk_100_theorems/abel_ruffini.lean b/archive/wiedijk_100_theorems/abel_ruffini.lean new file mode 100644 index 0000000000000..16e3595a8dbf8 --- /dev/null +++ b/archive/wiedijk_100_theorems/abel_ruffini.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2021 Thomas Browning. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Thomas Browning +-/ +import analysis.calculus.local_extr +import data.nat.prime_norm_num +import field_theory.abel_ruffini +import ring_theory.roots_of_unity.minpoly +import ring_theory.eisenstein_criterion + +/-! +# Construction of an algebraic number that is not solvable by radicals. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The main ingredients are: + * `solvable_by_rad.is_solvable'` in `field_theory/abel_ruffini` : + an irreducible polynomial with an `is_solvable_by_rad` root has solvable Galois group + * `gal_action_hom_bijective_of_prime_degree'` in `field_theory/polynomial_galois_group` : + an irreducible polynomial of prime degree with 1-3 non-real roots has full Galois group + * `equiv.perm.not_solvable` in `group_theory/solvable` : the symmetric group is not solvable + +Then all that remains is the construction of a specific polynomial satisfying the conditions of +`gal_action_hom_bijective_of_prime_degree'`, which is done in this file. + +-/ + +namespace abel_ruffini + +open function polynomial polynomial.gal ideal +open_locale polynomial + +local attribute [instance] splits_ℚ_ℂ + +variables (R : Type*) [comm_ring R] (a b : ℕ) + +/-- A quintic polynomial that we will show is irreducible -/ +noncomputable def Φ : R[X] := X ^ 5 - C ↑a * X + C ↑b + +variables {R} + +@[simp] lemma map_Phi {S : Type*} [comm_ring S] (f : R →+* S) : (Φ R a b).map f = Φ S a b := +by simp [Φ] + +@[simp] lemma coeff_zero_Phi : (Φ R a b).coeff 0 = ↑b := +by simp [Φ, coeff_X_pow] + +@[simp] lemma coeff_five_Phi : (Φ R a b).coeff 5 = 1 := +by simp [Φ, coeff_X, coeff_C, -C_eq_nat_cast, -map_nat_cast] + +variables [nontrivial R] + +lemma degree_Phi : (Φ R a b).degree = ↑5 := +begin + suffices : degree (X ^ 5 - C ↑a * X) = ↑5, + { rwa [Φ, degree_add_eq_left_of_degree_lt], + convert degree_C_le.trans_lt (with_bot.coe_lt_coe.mpr (nat.zero_lt_bit1 2)) }, + rw degree_sub_eq_left_of_degree_lt; rw degree_X_pow, + exact (degree_C_mul_X_le _).trans_lt (with_bot.coe_lt_coe.mpr (nat.one_lt_bit1 two_ne_zero)), +end + +lemma nat_degree_Phi : (Φ R a b).nat_degree = 5 := +nat_degree_eq_of_degree_eq_some (degree_Phi a b) + +lemma leading_coeff_Phi : (Φ R a b).leading_coeff = 1 := +by rw [polynomial.leading_coeff, nat_degree_Phi, coeff_five_Phi] + +lemma monic_Phi : (Φ R a b).monic := +leading_coeff_Phi a b + +lemma irreducible_Phi (p : ℕ) (hp : p.prime) (hpa : p ∣ a) (hpb : p ∣ b) (hp2b : ¬ p ^ 2 ∣ b) : + irreducible (Φ ℚ a b) := +begin + rw [←map_Phi a b (int.cast_ring_hom ℚ), ←is_primitive.int.irreducible_iff_irreducible_map_cast], + apply irreducible_of_eisenstein_criterion, + { rwa [span_singleton_prime (int.coe_nat_ne_zero.mpr hp.ne_zero), int.prime_iff_nat_abs_prime] }, + { rw [leading_coeff_Phi, mem_span_singleton], + exact_mod_cast mt nat.dvd_one.mp (hp.ne_one) }, + { intros n hn, + rw mem_span_singleton, + rw [degree_Phi, with_bot.coe_lt_coe] at hn, + interval_cases n with hn; + simp only [Φ, coeff_X_pow, coeff_C, int.coe_nat_dvd.mpr, hpb, if_true, coeff_C_mul, if_false, + nat.zero_ne_bit1, eq_self_iff_true, coeff_X_zero, hpa, coeff_add, zero_add, mul_zero, + coeff_sub, sub_self, nat.one_ne_zero, add_zero, coeff_X_one, mul_one, + zero_sub, dvd_neg, nat.one_eq_bit1, bit0_eq_zero, neg_zero, nat.bit0_ne_bit1, + dvd_mul_of_dvd_left, nat.bit1_eq_bit1, nat.one_ne_bit0, nat.bit1_ne_zero], }, + { simp only [degree_Phi, ←with_bot.coe_zero, with_bot.coe_lt_coe, nat.succ_pos'] }, + { rw [coeff_zero_Phi, span_singleton_pow, mem_span_singleton], + exact mt int.coe_nat_dvd.mp hp2b }, + all_goals { exact monic.is_primitive (monic_Phi a b) }, +end + +lemma real_roots_Phi_le : fintype.card ((Φ ℚ a b).root_set ℝ) ≤ 3 := +begin + rw [←map_Phi a b (algebra_map ℤ ℚ), Φ, ←one_mul (X ^ 5), ←C_1], + refine (card_root_set_le_derivative _).trans + (nat.succ_le_succ ((card_root_set_le_derivative _).trans (nat.succ_le_succ _))), + suffices : ((C ((algebra_map ℤ ℚ) 20) * X ^ 3).root_set ℝ).subsingleton, + { norm_num [fintype.card_le_one_iff_subsingleton, ← mul_assoc, *] at * }, + rw root_set_C_mul_X_pow; norm_num, +end + +lemma real_roots_Phi_ge_aux (hab : b < a) : + ∃ x y : ℝ, x ≠ y ∧ aeval x (Φ ℚ a b) = 0 ∧ aeval y (Φ ℚ a b) = 0 := +begin + let f := λ x : ℝ, aeval x (Φ ℚ a b), + have hf : f = λ x, x ^ 5 - a * x + b := by simp [f, Φ], + have hc : ∀ s : set ℝ, continuous_on f s := λ s, (Φ ℚ a b).continuous_on_aeval, + have ha : (1 : ℝ) ≤ a := nat.one_le_cast.mpr (nat.one_le_of_lt hab), + have hle : (0 : ℝ) ≤ 1 := zero_le_one, + have hf0 : 0 ≤ f 0 := by norm_num [hf], + by_cases hb : (1 : ℝ) - a + b < 0, + { have hf1 : f 1 < 0 := by norm_num [hf, hb], + have hfa : 0 ≤ f a, + { simp_rw [hf, ←sq], + refine add_nonneg (sub_nonneg.mpr (pow_le_pow ha _)) _; norm_num }, + obtain ⟨x, ⟨-, hx1⟩, hx2⟩ := intermediate_value_Ico' hle (hc _) (set.mem_Ioc.mpr ⟨hf1, hf0⟩), + obtain ⟨y, ⟨hy1, -⟩, hy2⟩ := intermediate_value_Ioc ha (hc _) (set.mem_Ioc.mpr ⟨hf1, hfa⟩), + exact ⟨x, y, (hx1.trans hy1).ne, hx2, hy2⟩ }, + { replace hb : (b : ℝ) = a - 1 := by linarith [show (b : ℝ) + 1 ≤ a, by exact_mod_cast hab], + have hf1 : f 1 = 0 := by norm_num [hf, hb], + have hfa := calc f (-a) = a ^ 2 - a ^ 5 + b : by norm_num [hf, ← sq] + ... ≤ a ^ 2 - a ^ 3 + (a - 1) : by refine add_le_add (sub_le_sub_left + (pow_le_pow ha _) _) _; linarith + ... = -(a - 1) ^ 2 * (a + 1) : by ring + ... ≤ 0 : by nlinarith, + have ha' := neg_nonpos.mpr (hle.trans ha), + obtain ⟨x, ⟨-, hx1⟩, hx2⟩ := intermediate_value_Icc ha' (hc _) (set.mem_Icc.mpr ⟨hfa, hf0⟩), + exact ⟨x, 1, (hx1.trans_lt zero_lt_one).ne, hx2, hf1⟩ }, +end + +lemma real_roots_Phi_ge (hab : b < a) : 2 ≤ fintype.card ((Φ ℚ a b).root_set ℝ) := +begin + have q_ne_zero : Φ ℚ a b ≠ 0 := (monic_Phi a b).ne_zero, + obtain ⟨x, y, hxy, hx, hy⟩ := real_roots_Phi_ge_aux a b hab, + have key : ↑({x, y} : finset ℝ) ⊆ (Φ ℚ a b).root_set ℝ, + { simp [set.insert_subset, mem_root_set_of_ne q_ne_zero, hx, hy] }, + convert fintype.card_le_of_embedding (set.embedding_of_subset _ _ key), + simp only [finset.coe_sort_coe, fintype.card_coe, finset.card_singleton, + finset.card_insert_of_not_mem (mt finset.mem_singleton.mp hxy)] +end + +lemma complex_roots_Phi (h : (Φ ℚ a b).separable) : fintype.card ((Φ ℚ a b).root_set ℂ) = 5 := +(card_root_set_eq_nat_degree h (is_alg_closed.splits_codomain _)).trans (nat_degree_Phi a b) + +lemma gal_Phi (hab : b < a) (h_irred : irreducible (Φ ℚ a b)) : + bijective (gal_action_hom (Φ ℚ a b) ℂ) := +begin + apply gal_action_hom_bijective_of_prime_degree' h_irred, + { norm_num [nat_degree_Phi] }, + { rw [complex_roots_Phi a b h_irred.separable, nat.succ_le_succ_iff], + exact (real_roots_Phi_le a b).trans (nat.le_succ 3) }, + { simp_rw [complex_roots_Phi a b h_irred.separable, nat.succ_le_succ_iff], + exact real_roots_Phi_ge a b hab }, +end + +theorem not_solvable_by_rad (p : ℕ) (x : ℂ) (hx : aeval x (Φ ℚ a b) = 0) (hab : b < a) + (hp : p.prime) (hpa : p ∣ a) (hpb : p ∣ b) (hp2b : ¬ p ^ 2 ∣ b) : + ¬ is_solvable_by_rad ℚ x := +begin + have h_irred := irreducible_Phi a b p hp hpa hpb hp2b, + apply mt (solvable_by_rad.is_solvable' h_irred hx), + introI h, + refine equiv.perm.not_solvable _ (le_of_eq _) + (solvable_of_surjective (gal_Phi a b hab h_irred).2), + rw_mod_cast [cardinal.mk_fintype, complex_roots_Phi a b h_irred.separable], +end + +theorem not_solvable_by_rad' (x : ℂ) (hx : aeval x (Φ ℚ 4 2) = 0) : + ¬ is_solvable_by_rad ℚ x := +by apply not_solvable_by_rad 4 2 2 x hx; norm_num + +/-- **Abel-Ruffini Theorem** -/ +theorem exists_not_solvable_by_rad : ∃ x : ℂ, is_algebraic ℚ x ∧ ¬ is_solvable_by_rad ℚ x := +begin + obtain ⟨x, hx⟩ := exists_root_of_splits (algebra_map ℚ ℂ) + (is_alg_closed.splits_codomain (Φ ℚ 4 2)) + (ne_of_eq_of_ne (degree_Phi 4 2) (mt with_bot.coe_eq_coe.mp (nat.bit1_ne_zero 2))), + exact ⟨x, ⟨Φ ℚ 4 2, (monic_Phi 4 2).ne_zero, hx⟩, not_solvable_by_rad' x hx⟩, +end + +end abel_ruffini diff --git a/archive/wiedijk_100_theorems/area_of_a_circle.lean b/archive/wiedijk_100_theorems/area_of_a_circle.lean new file mode 100644 index 0000000000000..e22a6274e698f --- /dev/null +++ b/archive/wiedijk_100_theorems/area_of_a_circle.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2021 James Arthur, Benjamin Davidson, Andrew Souther. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: James Arthur, Benjamin Davidson, Andrew Souther +-/ +import analysis.special_functions.sqrt +import analysis.special_functions.trigonometric.inverse_deriv +import measure_theory.integral.fund_thm_calculus +import measure_theory.measure.lebesgue.integral + +/-! +# Freek № 9: The Area of a Circle + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we show that the area of a disc with nonnegative radius `r` is `π * r^2`. The main +tools our proof uses are `volume_region_between_eq_integral`, which allows us to represent the area +of the disc as an integral, and `interval_integral.integral_eq_sub_of_has_deriv_at'_of_le`, the +second fundamental theorem of calculus. + +We begin by defining `disc` in `ℝ × ℝ`, then show that `disc` can be represented as the +`region_between` two functions. + +Though not necessary for the main proof, we nonetheless choose to include a proof of the +measurability of the disc in order to convince the reader that the set whose volume we will be +calculating is indeed measurable and our result is therefore meaningful. + +In the main proof, `area_disc`, we use `volume_region_between_eq_integral` followed by +`interval_integral.integral_of_le` to reduce our goal to a single `interval_integral`: + `∫ (x : ℝ) in -r..r, 2 * sqrt (r ^ 2 - x ^ 2) = π * r ^ 2`. +After disposing of the trivial case `r = 0`, we show that `λ x, 2 * sqrt (r ^ 2 - x ^ 2)` is equal +to the derivative of `λ x, r ^ 2 * arcsin (x / r) + x * sqrt (r ^ 2 - x ^ 2)` everywhere on +`Ioo (-r) r` and that those two functions are continuous, then apply the second fundamental theorem +of calculus with those facts. Some simple algebra then completes the proof. + +Note that we choose to define `disc` as a set of points in `ℝ × ℝ`. This is admittedly not ideal; it +would be more natural to define `disc` as a `metric.ball` in `euclidean_space ℝ (fin 2)` (as well as +to provide a more general proof in higher dimensions). However, our proof indirectly relies on a +number of theorems (particularly `measure_theory.measure.prod_apply`) which do not yet exist for +Euclidean space, thus forcing us to use this less-preferable definition. As `measure_theory.pi` +continues to develop, it should eventually become possible to redefine `disc` and extend our proof +to the n-ball. +-/ + +open set real measure_theory interval_integral +open_locale real nnreal + +namespace theorems_100 + +/-- A disc of radius `r` is defined as the collection of points `(p.1, p.2)` in `ℝ × ℝ` such that + `p.1 ^ 2 + p.2 ^ 2 < r ^ 2`. + Note that this definition is not equivalent to `metric.ball (0 : ℝ × ℝ) r`. This was done + intentionally because `dist` in `ℝ × ℝ` is defined as the uniform norm, making the `metric.ball` + in `ℝ × ℝ` a square, not a disc. + See the module docstring for an explanation of why we don't define the disc in Euclidean space. -/ +def disc (r : ℝ) := {p : ℝ × ℝ | p.1 ^ 2 + p.2 ^ 2 < r ^ 2} + +variable (r : ℝ≥0) + +/-- A disc of radius `r` can be represented as the region between the two curves + `λ x, - sqrt (r ^ 2 - x ^ 2)` and `λ x, sqrt (r ^ 2 - x ^ 2)`. -/ +lemma disc_eq_region_between : + disc r = region_between (λ x, -sqrt (r^2 - x^2)) (λ x, sqrt (r^2 - x^2)) (Ioc (-r) r) := +begin + ext p, + simp only [disc, region_between, mem_set_of_eq, mem_Ioo, mem_Ioc, pi.neg_apply], + split; + intro h, + { cases abs_lt_of_sq_lt_sq' (lt_of_add_lt_of_nonneg_left h (sq_nonneg p.2)) r.2, + rw [add_comm, ← lt_sub_iff_add_lt] at h, + exact ⟨⟨left, right.le⟩, sq_lt.mp h⟩ }, + { rw [add_comm, ← lt_sub_iff_add_lt], + exact sq_lt.mpr h.2 }, +end + +/-- The disc is a `measurable_set`. -/ +theorem measurable_set_disc : measurable_set (disc r) := +by apply measurable_set_lt; apply continuous.measurable; continuity + +/-- **Area of a Circle**: The area of a disc with radius `r` is `π * r ^ 2`. -/ +theorem area_disc : volume (disc r) = nnreal.pi * r ^ 2 := +begin + let f := λ x, sqrt (r ^ 2 - x ^ 2), + let F := λ x, (r:ℝ) ^ 2 * arcsin (r⁻¹ * x) + x * sqrt (r ^ 2 - x ^ 2), + have hf : continuous f := by continuity, + suffices : ∫ x in -r..r, 2 * f x = nnreal.pi * r ^ 2, + { have h : integrable_on f (Ioc (-r) r) := + hf.integrable_on_Icc.mono_set Ioc_subset_Icc_self, + calc volume (disc r) + = volume (region_between (λ x, -f x) f (Ioc (-r) r)) : by rw disc_eq_region_between + ... = ennreal.of_real (∫ x in Ioc (-r:ℝ) r, (f - has_neg.neg ∘ f) x) : + volume_region_between_eq_integral + h.neg h measurable_set_Ioc (λ x hx, neg_le_self (sqrt_nonneg _)) + ... = ennreal.of_real (∫ x in (-r:ℝ)..r, 2 * f x) : by simp [two_mul, integral_of_le] + ... = nnreal.pi * r ^ 2 : by rw_mod_cast [this, ← ennreal.coe_nnreal_eq], }, + obtain ⟨hle, (heq | hlt)⟩ := ⟨nnreal.coe_nonneg r, hle.eq_or_lt⟩, { simp [← heq] }, + have hderiv : ∀ x ∈ Ioo (-r:ℝ) r, has_deriv_at F (2 * f x) x, + { rintros x ⟨hx1, hx2⟩, + convert ((has_deriv_at_const x ((r:ℝ)^2)).mul ((has_deriv_at_arcsin _ _).comp x + ((has_deriv_at_const x (r:ℝ)⁻¹).mul (has_deriv_at_id' x)))).add + ((has_deriv_at_id' x).mul ((((has_deriv_at_id' x).pow 2).const_sub ((r:ℝ)^2)).sqrt _)), + { have h : sqrt (1 - x ^ 2 / r ^ 2) * r = sqrt (r ^ 2 - x ^ 2), + { rw [← sqrt_sq hle, ← sqrt_mul, sub_mul, sqrt_sq hle, mul_comm_div, + div_self (pow_ne_zero 2 hlt.ne'), one_mul, mul_one], + simpa [sqrt_sq hle, div_le_one (pow_pos hlt 2)] using sq_le_sq' hx1.le hx2.le }, + field_simp, + rw [h, mul_left_comm, ← sq, neg_mul_eq_mul_neg, mul_div_mul_left (-x^2) _ two_ne_zero, + add_left_comm, div_add_div_same, tactic.ring.add_neg_eq_sub, div_sqrt, two_mul] }, + { suffices : -(1:ℝ) < r⁻¹ * x, by exact this.ne', + calc -(1:ℝ) = r⁻¹ * -r : by simp [hlt.ne'] + ... < r⁻¹ * x : by nlinarith [inv_pos.mpr hlt] }, + { suffices : (r:ℝ)⁻¹ * x < 1, by exact this.ne, + calc (r:ℝ)⁻¹ * x < r⁻¹ * r : by nlinarith [inv_pos.mpr hlt] + ... = 1 : inv_mul_cancel hlt.ne' }, + { nlinarith } }, + have hcont := (by continuity : continuous F).continuous_on, + calc ∫ x in -r..r, 2 * f x + = F r - F (-r) : integral_eq_sub_of_has_deriv_at_of_le (neg_le_self r.2) + hcont hderiv (continuous_const.mul hf).continuous_on.interval_integrable + ... = nnreal.pi * r ^ 2 : by norm_num [F, inv_mul_cancel hlt.ne', ← mul_div_assoc, mul_comm π], +end + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/ascending_descending_sequences.lean b/archive/wiedijk_100_theorems/ascending_descending_sequences.lean new file mode 100644 index 0000000000000..14232f57243c4 --- /dev/null +++ b/archive/wiedijk_100_theorems/ascending_descending_sequences.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2020 Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bhavik Mehta +-/ +import data.fintype.powerset + +/-! +# Erdős–Szekeres theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 73 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/), also +known as the Erdős–Szekeres theorem: given a sequence of more than `r * s` distinct +values, there is an increasing sequence of length longer than `r` or a decreasing sequence of length +longer than `s`. + +We use the proof outlined at +https://en.wikipedia.org/wiki/Erdos-Szekeres_theorem#Pigeonhole_principle. + +## Tags + +sequences, increasing, decreasing, Ramsey, Erdos-Szekeres, Erdős–Szekeres, Erdős-Szekeres +-/ + +variables {α : Type*} [linear_order α] {β : Type*} + +open function finset + +namespace theorems_100 + +/-- +**Erdős–Szekeres Theorem**: Given a sequence of more than `r * s` distinct values, there is an +increasing sequence of length longer than `r` or a decreasing sequence of length longer than `s`. + +Proof idea: +We label each value in the sequence with two numbers specifying the longest increasing +subsequence ending there, and the longest decreasing subsequence ending there. +We then show the pair of labels must be unique. Now if there is no increasing sequence longer than +`r` and no decreasing sequence longer than `s`, then there are at most `r * s` possible labels, +which is a contradiction if there are more than `r * s` elements. +-/ +theorem erdos_szekeres {r s n : ℕ} {f : fin n → α} (hn : r * s < n) (hf : injective f) : + (∃ (t : finset (fin n)), r < t.card ∧ strict_mono_on f ↑t) ∨ + (∃ (t : finset (fin n)), s < t.card ∧ strict_anti_on f ↑t) := +begin + -- Given an index `i`, produce the set of increasing (resp., decreasing) subsequences which ends + -- at `i`. + let inc_sequences_ending_in : fin n → finset (finset (fin n)) := + λ i, univ.powerset.filter (λ t, finset.max t = i ∧ strict_mono_on f ↑t), + let dec_sequences_ending_in : fin n → finset (finset (fin n)) := + λ i, univ.powerset.filter (λ t, finset.max t = i ∧ strict_anti_on f ↑t), + -- The singleton sequence is in both of the above collections. + -- (This is useful to show that the maximum length subsequence is at least 1, and that the set + -- of subsequences is nonempty.) + have inc_i : ∀ i, {i} ∈ inc_sequences_ending_in i := λ i, by simp [strict_mono_on], + have dec_i : ∀ i, {i} ∈ dec_sequences_ending_in i := λ i, by simp [strict_anti_on], + -- Define the pair of labels: at index `i`, the pair is the maximum length of an increasing + -- subsequence ending at `i`, paired with the maximum length of a decreasing subsequence ending + -- at `i`. + -- We call these labels `(a_i, b_i)`. + let ab : fin n → ℕ × ℕ, + { intro i, + apply (max' ((inc_sequences_ending_in i).image card) (nonempty.image ⟨{i}, inc_i i⟩ _), + max' ((dec_sequences_ending_in i).image card) (nonempty.image ⟨{i}, dec_i i⟩ _)) }, + -- It now suffices to show that one of the labels is 'big' somewhere. In particular, if the + -- first in the pair is more than `r` somewhere, then we have an increasing subsequence in our + -- set, and if the second is more than `s` somewhere, then we have a decreasing subsequence. + rsuffices ⟨i, hi⟩ : ∃ i, r < (ab i).1 ∨ s < (ab i).2, + { apply or.imp _ _ hi, + work_on_goal 1 { have : (ab i).1 ∈ _ := max'_mem _ _ }, + work_on_goal 2 { have : (ab i).2 ∈ _ := max'_mem _ _ }, + all_goals + { intro hi, + rw mem_image at this, + obtain ⟨t, ht₁, ht₂⟩ := this, + refine ⟨t, by rwa ht₂, _⟩, + rw mem_filter at ht₁, + apply ht₁.2.2 } }, + -- Show first that the pair of labels is unique. + have : injective ab, + { apply injective_of_lt_imp_ne, + intros i j k q, + injection q with q₁ q₂, + -- We have two cases: `f i < f j` or `f j < f i`. + -- In the former we'll show `a_i < a_j`, and in the latter we'll show `b_i < b_j`. + cases lt_or_gt_of_ne (λ _, ne_of_lt ‹i < j› (hf ‹f i = f j›)), + work_on_goal 1 { apply ne_of_lt _ q₁, have : (ab i).1 ∈ _ := max'_mem _ _ }, + work_on_goal 2 { apply ne_of_lt _ q₂, have : (ab i).2 ∈ _ := max'_mem _ _ }, + all_goals + { -- Reduce to showing there is a subsequence of length `a_i + 1` which ends at `j`. + rw nat.lt_iff_add_one_le, + apply le_max', + rw mem_image at this ⊢, + -- In particular we take the subsequence `t` of length `a_i` which ends at `i`, by definition + -- of `a_i` + rcases this with ⟨t, ht₁, ht₂⟩, + rw mem_filter at ht₁, + -- Ensure `t` ends at `i`. + have : t.max = i, + simp [ht₁.2.1], + -- Now our new subsequence is given by adding `j` at the end of `t`. + refine ⟨insert j t, _, _⟩, + -- First make sure it's valid, i.e., that this subsequence ends at `j` and is increasing + { rw mem_filter, + refine ⟨_, _, _⟩, + { rw mem_powerset, apply subset_univ }, + -- It ends at `j` since `i < j`. + { convert max_insert, + rw [ht₁.2.1, max_eq_left], + apply with_bot.coe_le_coe.mpr (le_of_lt ‹i < j›) }, + -- To show it's increasing (i.e., `f` is monotone increasing on `t.insert j`), we do cases + -- on what the possibilities could be - either in `t` or equals `j`. + simp only [strict_mono_on, strict_anti_on, coe_insert, set.mem_insert_iff, + mem_coe], + -- Most of the cases are just bashes. + rintros x ⟨rfl | _⟩ y ⟨rfl | _⟩ _, + { apply (irrefl _ ‹j < j›).elim }, + { exfalso, + apply not_le_of_lt (trans ‹i < j› ‹j < y›) (le_max_of_eq ‹y ∈ t› ‹t.max = i›) }, + { apply lt_of_le_of_lt _ ‹f i < f j› <|> apply lt_of_lt_of_le ‹f j < f i› _, + rcases lt_or_eq_of_le (le_max_of_eq ‹x ∈ t› ‹t.max = i›) with _ | rfl, + { apply le_of_lt (ht₁.2.2 ‹x ∈ t› (mem_of_max ‹t.max = i›) ‹x < i›) }, + { refl } }, + { apply ht₁.2.2 ‹x ∈ t› ‹y ∈ t› ‹x < y› } }, + -- Finally show that this new subsequence is one longer than the old one. + { rw [card_insert_of_not_mem, ht₂], + intro _, + apply not_le_of_lt ‹i < j› (le_max_of_eq ‹j ∈ t› ‹t.max = i›) } } }, + -- Finished both goals! + -- Now that we have uniqueness of each label, it remains to do some counting to finish off. + -- Suppose all the labels are small. + by_contra q, + push_neg at q, + -- Then the labels `(a_i, b_i)` all fit in the following set: `{ (x,y) | 1 ≤ x ≤ r, 1 ≤ y ≤ s }` + let ran : finset (ℕ × ℕ) := (range r).image nat.succ ×ˢ (range s).image nat.succ, + -- which we prove here. + have : image ab univ ⊆ ran, + -- First some logical shuffling + { rintro ⟨x₁, x₂⟩, + simp only [mem_image, exists_prop, mem_range, mem_univ, mem_product, true_and, prod.mk.inj_iff], + rintros ⟨i, rfl, rfl⟩, + specialize q i, + -- Show `1 ≤ a_i` and `1 ≤ b_i`, which is easy from the fact that `{i}` is a increasing and + -- decreasing subsequence which we did right near the top. + have z : 1 ≤ (ab i).1 ∧ 1 ≤ (ab i).2, + { split; + { apply le_max', + rw mem_image, + refine ⟨{i}, by solve_by_elim, card_singleton i⟩ } }, + refine ⟨_, _⟩, + -- Need to get `a_i ≤ r`, here phrased as: there is some `a < r` with `a+1 = a_i`. + { refine ⟨(ab i).1 - 1, _, nat.succ_pred_eq_of_pos z.1⟩, + rw tsub_lt_iff_right z.1, + apply nat.lt_succ_of_le q.1 }, + { refine ⟨(ab i).2 - 1, _, nat.succ_pred_eq_of_pos z.2⟩, + rw tsub_lt_iff_right z.2, + apply nat.lt_succ_of_le q.2 } }, + -- To get our contradiction, it suffices to prove `n ≤ r * s` + apply not_le_of_lt hn, + -- Which follows from considering the cardinalities of the subset above, since `ab` is injective. + simpa [nat.succ_injective, card_image_of_injective, ‹injective ab›] using card_le_of_subset this, +end + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/ballot_problem.lean b/archive/wiedijk_100_theorems/ballot_problem.lean new file mode 100644 index 0000000000000..f539b407b87e4 --- /dev/null +++ b/archive/wiedijk_100_theorems/ballot_problem.lean @@ -0,0 +1,441 @@ +/- +Copyright (c) 2022 Bhavik Mehta, Kexing Ying. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bhavik Mehta, Kexing Ying +-/ +import probability.cond_count + +/-! +# Ballot problem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 30 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). + +The ballot problem asks, if in an election, candidate A receives `p` votes whereas candidate B +receives `q` votes where `p > q`, what is the probability that candidate A is strictly ahead +throughout the count. The probability of this is `(p - q) / (p + q)`. + +## Main definitions + +* `counted_sequence`: given natural numbers `p` and `q`, `counted_sequence p q` is the set of + all lists containing `p` of `1`s and `q` of `-1`s representing the votes of candidate A and B + respectively. +* `stays_positive`: is the set of lists of integers which suffix has positive sum. In particular, + the intersection of this set with `counted_sequence` is the set of lists where candidate A is + strictly ahead. + +## Main result + +* `ballot`: the ballot problem. + +-/ + +open set probability_theory measure_theory + +namespace ballot + +/-- The set of nonempty lists of integers which suffix has positive sum. -/ +def stays_positive : set (list ℤ) := {l | ∀ l₂, l₂ ≠ [] → l₂ <:+ l → 0 < l₂.sum} + +@[simp] lemma stays_positive_nil : [] ∈ stays_positive := +λ l hl hl₁, (hl (list.eq_nil_of_suffix_nil hl₁)).elim + +lemma stays_positive_cons_pos (x : ℤ) (hx : 0 < x) (l : list ℤ) : + (x :: l) ∈ stays_positive ↔ l ∈ stays_positive := +begin + split, + { intros hl l₁ hl₁ hl₂, + apply hl l₁ hl₁ (hl₂.trans (list.suffix_cons _ _)) }, + { intros hl l₁ hl₁ hl₂, + rw list.suffix_cons_iff at hl₂, + rcases hl₂ with (rfl | hl₂), + { rw list.sum_cons, + apply add_pos_of_pos_of_nonneg hx, + cases l with hd tl, + { simp }, + { apply le_of_lt (hl (hd :: tl) (list.cons_ne_nil hd tl) (hd :: tl).suffix_refl) } }, + { apply hl _ hl₁ hl₂ } } +end + +/-- +`counted_sequence p q` is the set of lists of integers for which every element is `+1` or `-1`, +there are `p` lots of `+1` and `q` lots of `-1`. + +This represents vote sequences where candidate `+1` receives `p` votes and candidate `-1` receives +`q` votes. +-/ +def counted_sequence (p q : ℕ) : set (list ℤ) := +{l | l.count 1 = p ∧ l.count (-1) = q ∧ ∀ x ∈ l, x = (1 : ℤ) ∨ x = -1} + +/-- An alternative definition of `counted_sequence` that uses `list.perm`. -/ +lemma mem_counted_sequence_iff_perm {p q l} : + l ∈ counted_sequence p q ↔ l ~ list.replicate p (1 : ℤ) ++ list.replicate q (-1) := +begin + rw [list.perm_replicate_append_replicate], + { simp only [counted_sequence, list.subset_def, mem_set_of_eq, list.mem_cons_iff, + list.mem_singleton] }, + { norm_num1 } +end + +@[simp] lemma counted_right_zero (p : ℕ) : counted_sequence p 0 = {list.replicate p 1} := +by { ext l, simp [mem_counted_sequence_iff_perm] } + +@[simp] lemma counted_left_zero (q : ℕ) : counted_sequence 0 q = {list.replicate q (-1)} := +by { ext l, simp [mem_counted_sequence_iff_perm] } + +lemma mem_of_mem_counted_sequence {p q} {l} (hl : l ∈ counted_sequence p q) {x : ℤ} (hx : x ∈ l) : + x = 1 ∨ x = -1 := +hl.2.2 x hx + +lemma length_of_mem_counted_sequence {p q} {l : list ℤ} (hl : l ∈ counted_sequence p q) : + l.length = p + q := +by simp [(mem_counted_sequence_iff_perm.1 hl).length_eq] + +lemma counted_eq_nil_iff {p q : ℕ} {l : list ℤ} (hl : l ∈ counted_sequence p q) : + l = [] ↔ p = 0 ∧ q = 0 := +list.length_eq_zero.symm.trans $ by simp [length_of_mem_counted_sequence hl] + +lemma counted_ne_nil_left {p q : ℕ} (hp : p ≠ 0) {l : list ℤ} (hl : l ∈ counted_sequence p q) : + l ≠ [] := +by simp [counted_eq_nil_iff hl, hp] + +lemma counted_ne_nil_right {p q : ℕ} (hq : q ≠ 0) {l : list ℤ} (hl : l ∈ counted_sequence p q) : + l ≠ [] := +by simp [counted_eq_nil_iff hl, hq] + +lemma counted_succ_succ (p q : ℕ) : counted_sequence (p + 1) (q + 1) = + list.cons 1 '' counted_sequence p (q + 1) ∪ list.cons (-1) '' counted_sequence (p + 1) q := +begin + ext l, + rw [counted_sequence, counted_sequence, counted_sequence], + split, + { intro hl, + have hlnil := counted_ne_nil_left (nat.succ_ne_zero p) hl, + obtain ⟨hl₀, hl₁, hl₂⟩ := hl, + obtain hlast | hlast := hl₂ l.head (list.head_mem_self hlnil), + { refine or.inl ⟨l.tail, ⟨_, _, _⟩, _⟩, + { rw [list.count_tail l 1 (list.length_pos_of_ne_nil hlnil), hl₀, if_pos, + nat.add_succ_sub_one, add_zero], + rw [list.nth_le_zero, hlast] }, + { rw [list.count_tail l (-1) (list.length_pos_of_ne_nil hlnil), hl₁, if_neg, nat.sub_zero], + rw [list.nth_le_zero, hlast], + norm_num }, + { exact λ x hx, hl₂ x (list.mem_of_mem_tail hx) }, + { rw [← hlast, list.cons_head_tail hlnil] } }, + { refine or.inr ⟨l.tail, ⟨_, _, _⟩, _⟩, + { rw [list.count_tail l 1 (list.length_pos_of_ne_nil hlnil), hl₀, if_neg, nat.sub_zero], + rw [list.nth_le_zero, hlast], + norm_num }, + { rw [list.count_tail l (-1) (list.length_pos_of_ne_nil hlnil), hl₁, if_pos, + nat.add_succ_sub_one, add_zero], + rw [list.nth_le_zero, hlast] }, + { exact λ x hx, hl₂ x (list.mem_of_mem_tail hx) }, + { rw [← hlast, list.cons_head_tail hlnil] } } }, + { rintro (⟨t, ⟨ht₀, ht₁, ht₂⟩, rfl⟩ | ⟨t, ⟨ht₀, ht₁, ht₂⟩, rfl⟩), + { refine ⟨_, _, _⟩, + { rw [list.count_cons, if_pos rfl, ht₀] }, + { rw [list.count_cons, if_neg, ht₁], + norm_num }, + { rintro x (hx | hx), + exacts [or.inl hx, ht₂ x hx] } }, + { refine ⟨_, _, _⟩, + { rw [list.count_cons, if_neg, ht₀], + norm_num }, + { rw [list.count_cons, if_pos rfl, ht₁] }, + { rintro x (hx | hx), + exacts [or.inr hx, ht₂ x hx] } } } +end + +lemma counted_sequence_finite : ∀ (p q : ℕ), (counted_sequence p q).finite +| 0 q := by simp +| (p + 1) 0 := by simp +| (p + 1) (q + 1) := + begin + rw [counted_succ_succ, set.finite_union, set.finite_image_iff (list.cons_injective.inj_on _), + set.finite_image_iff (list.cons_injective.inj_on _)], + exact ⟨counted_sequence_finite _ _, counted_sequence_finite _ _⟩ + end + +lemma counted_sequence_nonempty : ∀ (p q : ℕ), (counted_sequence p q).nonempty +| 0 q := by simp +| (p + 1) 0 := by simp +| (p + 1) (q + 1) := + begin + rw [counted_succ_succ, union_nonempty, nonempty_image_iff], + exact or.inl (counted_sequence_nonempty _ _), + end + +lemma sum_of_mem_counted_sequence {p q} {l : list ℤ} (hl : l ∈ counted_sequence p q) : + l.sum = p - q := +by simp [(mem_counted_sequence_iff_perm.1 hl).sum_eq, sub_eq_add_neg] + +lemma disjoint_bits (p q : ℕ) : + disjoint (list.cons 1 '' counted_sequence p (q + 1)) + (list.cons (-1) '' counted_sequence (p + 1) q) := +begin + simp_rw [disjoint_left, mem_image, not_exists, exists_imp_distrib], + rintros _ _ ⟨_, rfl⟩ _ ⟨_, _, _⟩, +end + +open measure_theory.measure + +private def measureable_space_list_int : measurable_space (list ℤ) := ⊤ + +local attribute [instance] measureable_space_list_int + +private lemma measurable_singleton_class_list_int : measurable_singleton_class (list ℤ) := +{ measurable_set_singleton := λ s, trivial } + +local attribute [instance] measurable_singleton_class_list_int + +private lemma list_int_measurable_set {s : set (list ℤ)} : measurable_set s := +trivial + +lemma count_counted_sequence : ∀ p q : ℕ, count (counted_sequence p q) = (p + q).choose p +| p 0 := by simp [counted_right_zero, count_singleton] +| 0 q := by simp [counted_left_zero, count_singleton] +| (p + 1) (q + 1) := + begin + rw [counted_succ_succ, measure_union (disjoint_bits _ _) list_int_measurable_set, + count_injective_image list.cons_injective, count_counted_sequence, + count_injective_image list.cons_injective, count_counted_sequence], + { norm_cast, + rw [add_assoc, add_comm 1 q, ← nat.choose_succ_succ, nat.succ_eq_add_one, add_right_comm] }, + all_goals { try { apply_instance } }, + end + +lemma first_vote_pos : + ∀ p q, 0 < p + q → + cond_count (counted_sequence p q : set (list ℤ)) {l | l.head = 1} = p / (p + q) +| (p + 1) 0 h := + begin + rw [counted_right_zero, cond_count_singleton], + simp [ennreal.div_self _ _], + end +| 0 (q + 1) _ := + begin + rw [counted_left_zero, cond_count_singleton], + simpa, + end +| (p + 1) (q + 1) h := + begin + simp_rw [counted_succ_succ], + rw [← cond_count_disjoint_union ((counted_sequence_finite _ _).image _) + ((counted_sequence_finite _ _).image _) (disjoint_bits _ _), ← counted_succ_succ, + cond_count_eq_one_of ((counted_sequence_finite p (q + 1)).image _) + (nonempty_image_iff.2 (counted_sequence_nonempty _ _))], + { have : list.cons (-1) '' counted_sequence (p + 1) q ∩ {l : list ℤ | l.head = 1} = ∅, + { ext, + simp only [mem_inter_iff, mem_image, mem_set_of_eq, mem_empty_iff_false, iff_false, not_and, + forall_exists_index, and_imp], + rintro l _ rfl, + norm_num }, + have hint : counted_sequence (p + 1) (q + 1) ∩ list.cons 1 '' counted_sequence p (q + 1) = + list.cons 1 '' counted_sequence p (q + 1), + { rw [inter_eq_right_iff_subset, counted_succ_succ], + exact subset_union_left _ _ }, + rw [(cond_count_eq_zero_iff $ (counted_sequence_finite _ _).image _).2 this, + cond_count, cond_apply _ list_int_measurable_set, hint, + count_injective_image list.cons_injective, count_counted_sequence, count_counted_sequence, + one_mul, zero_mul, add_zero, nat.cast_add, nat.cast_one], + { rw [mul_comm, ← div_eq_mul_inv, ennreal.div_eq_div_iff], + { norm_cast, + rw [mul_comm _ (p + 1), ← nat.succ_eq_add_one p, nat.succ_add, + nat.succ_mul_choose_eq, mul_comm] }, + all_goals { simp [(nat.choose_pos $ (le_add_iff_nonneg_right _).2 zero_le').ne.symm] } }, + all_goals { apply_instance } }, + { simp }, + { apply_instance } + end + +lemma head_mem_of_nonempty {α : Type*} [inhabited α] : + ∀ {l : list α} (hl : l ≠ []), l.head ∈ l +| [] h := h rfl +| (x :: l) _ := or.inl rfl + +lemma first_vote_neg (p q : ℕ) (h : 0 < p + q) : + cond_count (counted_sequence p q) {l | l.head = 1}ᶜ = q / (p + q) := +begin + have := cond_count_compl {l : list ℤ | l.head = 1}ᶜ + (counted_sequence_finite p q) (counted_sequence_nonempty p q), + rw [compl_compl, first_vote_pos _ _ h] at this, + rw [(_ : (q / (p + q) : ennreal) = 1 - p / (p + q)), ← this, ennreal.add_sub_cancel_right], + { simp only [ne.def, ennreal.div_eq_top, nat.cast_eq_zero, add_eq_zero_iff, + ennreal.nat_ne_top, false_and, or_false, not_and], + intros, + contradiction }, + rw [eq_comm, ennreal.eq_div_iff, ennreal.mul_sub, ennreal.mul_div_cancel'], + all_goals { simp, try { rintro rfl, rw zero_add at h, exact h.ne.symm } }, +end + +lemma ballot_same (p : ℕ) : cond_count (counted_sequence (p + 1) (p + 1)) stays_positive = 0 := +begin + rw [cond_count_eq_zero_iff (counted_sequence_finite _ _), eq_empty_iff_forall_not_mem], + rintro x ⟨hx, t⟩, + apply ne_of_gt (t x _ x.suffix_refl), + { simpa using sum_of_mem_counted_sequence hx }, + { refine list.ne_nil_of_length_pos _, + rw length_of_mem_counted_sequence hx, + exact nat.add_pos_left (nat.succ_pos _) _ }, +end + +lemma ballot_edge (p : ℕ) : cond_count (counted_sequence (p + 1) 0) stays_positive = 1 := +begin + rw counted_right_zero, + refine cond_count_eq_one_of (finite_singleton _) (singleton_nonempty _) _, + { intros l hl, + rw mem_singleton_iff at hl, + subst hl, + refine λ l hl₁ hl₂, list.sum_pos _ (λ x hx, _) hl₁, + rw list.eq_of_mem_replicate (list.mem_of_mem_suffix hx hl₂), + norm_num }, +end + +lemma counted_sequence_int_pos_counted_succ_succ (p q : ℕ) : + (counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1} = + (counted_sequence p (q + 1)).image (list.cons 1) := +begin + rw [counted_succ_succ, union_inter_distrib_right, + (_ : list.cons (-1) '' counted_sequence (p + 1) q ∩ {l | l.head = 1} = ∅), union_empty]; + { ext, + simp only [mem_inter_iff, mem_image, mem_set_of_eq, and_iff_left_iff_imp, mem_empty_iff_false, + iff_false, not_and, forall_exists_index, and_imp], + rintro y hy rfl, + norm_num } +end + +lemma ballot_pos (p q : ℕ) : + cond_count ((counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1}) stays_positive = + cond_count (counted_sequence p (q + 1)) stays_positive := +begin + rw [counted_sequence_int_pos_counted_succ_succ, cond_count, cond_count, + cond_apply _ list_int_measurable_set, cond_apply _ list_int_measurable_set, + count_injective_image list.cons_injective], + all_goals { try { apply_instance } }, + congr' 1, + have : (counted_sequence p (q + 1)).image (list.cons 1) ∩ stays_positive = + (counted_sequence p (q + 1) ∩ stays_positive).image (list.cons 1), + { ext t, + simp only [mem_inter_iff, mem_image], + split, + { simp only [and_imp, exists_imp_distrib], + rintro l hl rfl t, + refine ⟨l, ⟨hl, _⟩, rfl⟩, + rwa stays_positive_cons_pos at t, + norm_num }, + { simp only [and_imp, exists_imp_distrib], + rintro l hl₁ hl₂ rfl, + refine ⟨⟨_, hl₁, rfl⟩, _⟩, + rwa stays_positive_cons_pos, + norm_num } }, + rw [this, count_injective_image], + exact list.cons_injective, +end + +lemma counted_sequence_int_neg_counted_succ_succ (p q : ℕ) : + (counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1}ᶜ = + (counted_sequence (p + 1) q).image (list.cons (-1)) := +begin + rw [counted_succ_succ, union_inter_distrib_right, + (_ : list.cons 1 '' counted_sequence p (q + 1) ∩ {l : list ℤ | l.head = 1}ᶜ = ∅), empty_union]; + { ext, + simp only [mem_inter_iff, mem_image, mem_set_of_eq, and_iff_left_iff_imp, mem_empty_iff_false, + iff_false, not_and, forall_exists_index, and_imp], + rintro y hy rfl, + norm_num } +end + +lemma ballot_neg (p q : ℕ) (qp : q < p) : + cond_count ((counted_sequence (p + 1) (q + 1)) ∩ {l | l.head = 1}ᶜ) stays_positive = + cond_count (counted_sequence (p + 1) q) stays_positive := +begin + rw [counted_sequence_int_neg_counted_succ_succ, cond_count, cond_count, + cond_apply _ list_int_measurable_set, cond_apply _ list_int_measurable_set, + count_injective_image list.cons_injective], + all_goals { try { apply_instance } }, + congr' 1, + have : (counted_sequence (p + 1) q).image (list.cons (-1)) ∩ stays_positive = + ((counted_sequence (p + 1) q) ∩ stays_positive).image (list.cons (-1)), + { ext t, + simp only [mem_inter_iff, mem_image], + split, + { simp only [and_imp, exists_imp_distrib], + rintro l hl rfl t, + exact ⟨_, ⟨hl, λ l₁ hl₁ hl₂, t l₁ hl₁ (hl₂.trans (list.suffix_cons _ _))⟩, rfl⟩ }, + { simp only [and_imp, exists_imp_distrib], + rintro l hl₁ hl₂ rfl, + refine ⟨⟨l, hl₁, rfl⟩, λ l₁ hl₃ hl₄, _⟩, + rw list.suffix_cons_iff at hl₄, + rcases hl₄ with (rfl | hl₄), + { simp [list.sum_cons, sum_of_mem_counted_sequence hl₁, sub_eq_add_neg, ← add_assoc, qp] }, + exact hl₂ _ hl₃ hl₄ } }, + rw [this, count_injective_image], + exact list.cons_injective +end + +theorem ballot_problem' : + ∀ q p, q < p → (cond_count (counted_sequence p q) stays_positive).to_real = (p - q) / (p + q) := +begin + classical, + apply nat.diag_induction, + { intro p, + rw ballot_same, + simp }, + { intro p, + rw ballot_edge, + simp only [ennreal.one_to_real, nat.cast_add, nat.cast_one, nat.cast_zero, sub_zero, add_zero], + rw div_self , + exact nat.cast_add_one_ne_zero p }, + { intros q p qp h₁ h₂, + haveI := cond_count_is_probability_measure + (counted_sequence_finite p (q + 1)) (counted_sequence_nonempty _ _), + haveI := cond_count_is_probability_measure + (counted_sequence_finite (p + 1) q) (counted_sequence_nonempty _ _), + have h₃ : p + 1 + (q + 1) > 0 := nat.add_pos_left (nat.succ_pos _) _, + rw [← cond_count_add_compl_eq {l : list ℤ | l.head = 1} _ (counted_sequence_finite _ _), + first_vote_pos _ _ h₃, first_vote_neg _ _ h₃, ballot_pos, ballot_neg _ _ qp], + rw [ennreal.to_real_add, ennreal.to_real_mul, ennreal.to_real_mul, ← nat.cast_add, + ennreal.to_real_div, ennreal.to_real_div, ennreal.to_real_nat, ennreal.to_real_nat, + ennreal.to_real_nat, h₁, h₂], + { have h₄ : (↑(p + 1) + ↑(q + 1)) ≠ (0 : ℝ), + { apply ne_of_gt, + assumption_mod_cast }, + have h₅ : (↑(p + 1) + ↑q) ≠ (0 : ℝ), + { apply ne_of_gt, + norm_cast, + linarith }, + have h₆ : (↑p + ↑(q + 1)) ≠ (0 : ℝ), + { apply ne_of_gt, + norm_cast, + linarith }, + field_simp [h₄, h₅, h₆] at *, + ring }, + all_goals { refine (ennreal.mul_lt_top (measure_lt_top _ _).ne _).ne, + simp [ne.def, ennreal.div_eq_top] } } +end + +/-- The ballot problem. -/ +theorem ballot_problem : + ∀ q p, q < p → cond_count (counted_sequence p q) stays_positive = (p - q) / (p + q) := +begin + intros q p qp, + haveI := cond_count_is_probability_measure + (counted_sequence_finite p q) (counted_sequence_nonempty _ _), + have : (cond_count (counted_sequence p q) stays_positive).to_real = + ((p - q) / (p + q) : ennreal).to_real, + { rw ballot_problem' q p qp, + rw [ennreal.to_real_div, ← nat.cast_add, ← nat.cast_add, ennreal.to_real_nat, + ennreal.to_real_sub_of_le, ennreal.to_real_nat, ennreal.to_real_nat], + exacts [nat.cast_le.2 qp.le, ennreal.nat_ne_top _] }, + rwa ennreal.to_real_eq_to_real (measure_lt_top _ _).ne at this, + { simp only [ne.def, ennreal.div_eq_top, tsub_eq_zero_iff_le, nat.cast_le, + not_le, add_eq_zero_iff, nat.cast_eq_zero, ennreal.add_eq_top, ennreal.nat_ne_top, + or_self, not_false_iff, and_true], + push_neg, + exact ⟨λ _ _, by linarith, (lt_of_le_of_lt tsub_le_self (ennreal.nat_ne_top p).lt_top).ne⟩ }, + apply_instance, +end + +end ballot diff --git a/archive/wiedijk_100_theorems/birthday_problem.lean b/archive/wiedijk_100_theorems/birthday_problem.lean new file mode 100644 index 0000000000000..4c0ee761bc19f --- /dev/null +++ b/archive/wiedijk_100_theorems/birthday_problem.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2021 Eric Rodriguez. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Rodriguez +-/ +import data.fintype.card_embedding +import probability.cond_count +import probability.notation + +/-! +# Birthday Problem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 93 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). + +As opposed to the standard probabilistic statement, we instead state the birthday problem +in terms of injective functions. The general result about `fintype.card (α ↪ β)` which this proof +uses is `fintype.card_embedding_eq`. +-/ + +namespace theorems_100 + +local notation (name := finset.card) `|` x `|` := finset.card x +local notation (name := fintype.card) `‖` x `‖` := fintype.card x + +/-- **Birthday Problem**: set cardinality interpretation. -/ +theorem birthday : + 2 * ‖fin 23 ↪ fin 365‖ < ‖fin 23 → fin 365‖ ∧ 2 * ‖fin 22 ↪ fin 365‖ > ‖fin 22 → fin 365‖ := +begin + simp only [nat.desc_factorial, fintype.card_fin, fintype.card_embedding_eq, fintype.card_fun], + norm_num +end + +section measure_theory + +open measure_theory probability_theory +open_locale probability_theory ennreal + +variables {n m : ℕ} + +/- In order for Lean to understand that we can take probabilities in `fin 23 → fin 365`, we must +tell Lean that there is a `measurable_space` structure on the space. Note that this instance +is only for `fin m` - Lean automatically figures out that the function space `fin n → fin m` +is _also_ measurable, by using `measurable_space.pi`, and furthermore that all sets are measurable, +from `measurable_singleton_class.pi`. -/ +instance : measurable_space (fin m) := ⊤ +instance : measurable_singleton_class (fin m) := ⟨λ _, trivial⟩ + +/- We then endow the space with a canonical measure, which is called ℙ. +We define this to be the conditional counting measure. -/ +noncomputable instance : measure_space (fin n → fin m) := ⟨cond_count set.univ⟩ + +/- The canonical measure on `fin n → fin m` is a probability measure (except on an empty space). -/ +instance : is_probability_measure (ℙ : measure (fin n → fin (m + 1))) := +cond_count_is_probability_measure set.finite_univ set.univ_nonempty + +lemma fin_fin.measure_apply {s : set $ fin n → fin m} : + ℙ s = (|s.to_finite.to_finset|) / ‖fin n → fin m‖ := +by erw [cond_count_univ, measure.count_apply_finite] + +/-- **Birthday Problem**: first probabilistic interpretation. -/ +theorem birthday_measure : ℙ {f : fin 23 → fin 365 | function.injective f} < 1 / 2 := +begin + -- most of this proof is essentially converting it to the same form as `birthday`. + rw [fin_fin.measure_apply], + generalize_proofs hfin, + have : |hfin.to_finset| = 42200819302092359872395663074908957253749760700776448000000, + { transitivity ‖fin 23 ↪ fin 365‖, + { simp_rw [←fintype.card_coe, set.finite.coe_sort_to_finset, set.coe_set_of], + exact fintype.card_congr (equiv.subtype_injective_equiv_embedding _ _) }, + { simp only [fintype.card_embedding_eq, fintype.card_fin, nat.desc_factorial], + norm_num } }, + rw [this, ennreal.lt_div_iff_mul_lt, mul_comm, mul_div, ennreal.div_lt_iff], + rotate, iterate 2 { right, norm_num }, iterate 2 { left, norm_num }, + norm_cast, + simp only [fintype.card_pi, fintype.card_fin], + norm_num +end + +end measure_theory + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/cubing_a_cube.lean b/archive/wiedijk_100_theorems/cubing_a_cube.lean new file mode 100644 index 0000000000000..f26ce9402eb3d --- /dev/null +++ b/archive/wiedijk_100_theorems/cubing_a_cube.lean @@ -0,0 +1,529 @@ +/- +Copyright (c) 2019 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import data.real.basic +import data.set.finite +import data.set.intervals.disjoint + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Proof that a cube (in dimension n ≥ 3) cannot be cubed: +There does not exist a partition of a cube into finitely many smaller cubes (at least two) +of different sizes. + +We follow the proof described here: +http://www.alaricstephen.com/main-featured/2017/9/28/cubing-a-cube-proof +-/ + +open real set function fin + +namespace theorems_100 + +noncomputable theory + +namespace «82» + +variable {n : ℕ} + +/-- Given three intervals `I, J, K` such that `J ⊂ I`, + neither endpoint of `J` coincides with an endpoint of `I`, `¬ (K ⊆ J)` and + `K` does not lie completely to the left nor completely to the right of `J`. + Then `I ∩ K \ J` is nonempty. -/ +lemma Ico_lemma {α} [linear_order α] {x₁ x₂ y₁ y₂ z₁ z₂ w : α} + (h₁ : x₁ < y₁) (hy : y₁ < y₂) (h₂ : y₂ < x₂) + (hz₁ : z₁ ≤ y₂) (hz₂ : y₁ ≤ z₂) (hw : w ∉ Ico y₁ y₂ ∧ w ∈ Ico z₁ z₂) : + ∃w, w ∈ Ico x₁ x₂ ∧ w ∉ Ico y₁ y₂ ∧ w ∈ Ico z₁ z₂ := +begin + simp only [not_and, not_lt, mem_Ico] at hw, + refine ⟨max x₁ (min w y₂), _, _, _⟩, + { simp [le_refl, lt_trans h₁ (lt_trans hy h₂), h₂] }, + { simp [hw, lt_irrefl, not_le_of_lt h₁] {contextual := tt} }, + { simp [hw.2.1, hw.2.2, hz₁, lt_of_lt_of_le h₁ hz₂] at ⊢ } +end + +/-- A (hyper)-cube (in standard orientation) is a vector `b` consisting of the bottom-left point +of the cube, a width `w` and a proof that `w > 0`. We use functions from `fin n` to denote vectors. +-/ +structure cube (n : ℕ) : Type := +(b : fin n → ℝ) -- bottom-left coordinate +(w : ℝ) -- width +(hw : 0 < w) + +namespace cube +lemma hw' (c : cube n) : 0 ≤ c.w := le_of_lt c.hw + +/-- The j-th side of a cube is the half-open interval `[b j, b j + w)` -/ +def side (c : cube n) (j : fin n) : set ℝ := +Ico (c.b j) (c.b j + c.w) + +@[simp] lemma b_mem_side (c : cube n) (j : fin n) : c.b j ∈ c.side j := +by simp [side, cube.hw, le_refl] + +def to_set (c : cube n) : set (fin n → ℝ) := +{ x | ∀j, x j ∈ side c j } + +lemma side_nonempty (c : cube n) (i : fin n) : (side c i).nonempty := by simp [side, c.hw] + +lemma univ_pi_side (c : cube n) : pi univ (side c) = c.to_set := ext $ λ x, mem_univ_pi + +lemma to_set_subset {c c' : cube n} : c.to_set ⊆ c'.to_set ↔ ∀j, c.side j ⊆ c'.side j := +by simp only [← univ_pi_side, univ_pi_subset_univ_pi_iff, (c.side_nonempty _).ne_empty, + exists_false, or_false] + +lemma to_set_disjoint {c c' : cube n} : disjoint c.to_set c'.to_set ↔ + ∃ j, disjoint (c.side j) (c'.side j) := +by simp only [← univ_pi_side, disjoint_univ_pi] + +lemma b_mem_to_set (c : cube n) : c.b ∈ c.to_set := +by simp [to_set] + +protected def tail (c : cube (n+1)) : cube n := +⟨tail c.b, c.w, c.hw⟩ + +lemma side_tail (c : cube (n+1)) (j : fin n) : c.tail.side j = c.side j.succ := rfl + +def bottom (c : cube (n+1)) : set (fin (n+1) → ℝ) := +{ x | x 0 = c.b 0 ∧ tail x ∈ c.tail.to_set } + +lemma b_mem_bottom (c : cube (n+1)) : c.b ∈ c.bottom := +by simp [bottom, to_set, side, cube.hw, le_refl, cube.tail] + +def xm (c : cube (n+1)) : ℝ := +c.b 0 + c.w + +lemma b_lt_xm (c : cube (n+1)) : c.b 0 < c.xm := by simp [xm, hw] +lemma b_ne_xm (c : cube (n+1)) : c.b 0 ≠ c.xm := ne_of_lt c.b_lt_xm + +def shift_up (c : cube (n+1)) : cube (n+1) := +⟨cons c.xm $ tail c.b, c.w, c.hw⟩ + +@[simp] lemma tail_shift_up (c : cube (n+1)) : c.shift_up.tail = c.tail := +by simp [shift_up, cube.tail] + +@[simp] lemma head_shift_up (c : cube (n+1)) : c.shift_up.b 0 = c.xm := rfl + +def unit_cube : cube n := +⟨λ _, 0, 1, by norm_num⟩ + +@[simp] lemma side_unit_cube {j : fin n} : unit_cube.side j = Ico 0 1 := +by norm_num [unit_cube, side] + +end cube +open cube + +variables {ι : Type} {cs : ι → cube (n+1)} {i i' : ι} + +/-- A finite family of (at least 2) cubes partitioning the unit cube with different sizes -/ +@[protect_proj] structure correct (cs : ι → cube n) : Prop := +(pairwise_disjoint : pairwise (disjoint on (cube.to_set ∘ cs))) +(Union_eq : (⋃(i : ι), (cs i).to_set) = unit_cube.to_set) +(injective : injective (cube.w ∘ cs)) +(three_le : 3 ≤ n) + +namespace correct + +variable (h : correct cs) +include h + +lemma to_set_subset_unit_cube {i} : (cs i).to_set ⊆ unit_cube.to_set := +h.Union_eq ▸ subset_Union _ i + +lemma side_subset {i j} : (cs i).side j ⊆ Ico 0 1 := +by simpa only [side_unit_cube] using to_set_subset.1 h.to_set_subset_unit_cube j + +lemma zero_le_of_mem_side {i j x} (hx : x ∈ (cs i).side j) : 0 ≤ x := +(side_subset h hx).1 + +lemma zero_le_of_mem {i p} (hp : p ∈ (cs i).to_set) (j) : 0 ≤ p j := +zero_le_of_mem_side h (hp j) + +lemma zero_le_b {i j} : 0 ≤ (cs i).b j := +zero_le_of_mem h (cs i).b_mem_to_set j + +lemma b_add_w_le_one {j} : (cs i).b j + (cs i).w ≤ 1 := +by { have := side_subset h, rw [side, Ico_subset_Ico_iff] at this, convert this.2, simp [hw] } + +lemma nontrivial_fin : nontrivial (fin n) := +fin.nontrivial_iff_two_le.2 (nat.le_of_succ_le_succ h.three_le) + +/-- The width of any cube in the partition cannot be 1. -/ +lemma w_ne_one [nontrivial ι] (i : ι) : (cs i).w ≠ 1 := +begin + intro hi, + cases exists_ne i with i' hi', + let p := (cs i').b, + have hp : p ∈ (cs i').to_set := (cs i').b_mem_to_set, + have h2p : p ∈ (cs i).to_set, + { intro j, split, + transitivity (0 : ℝ), + { rw [←add_le_add_iff_right (1 : ℝ)], convert b_add_w_le_one h, rw hi, rw zero_add }, + apply zero_le_b h, apply lt_of_lt_of_le (side_subset h $ (cs i').b_mem_side j).2, + simp [hi, zero_le_b h] }, + exact (h.pairwise_disjoint hi').le_bot ⟨hp, h2p⟩ +end + +/-- The top of a cube (which is the bottom of the cube shifted up by its width) must be covered by + bottoms of (other) cubes in the family. -/ +lemma shift_up_bottom_subset_bottoms (hc : (cs i).xm ≠ 1) : + (cs i).shift_up.bottom ⊆ ⋃(i : ι), (cs i).bottom := +begin + intros p hp, cases hp with hp0 hps, rw [tail_shift_up] at hps, + have : p ∈ (unit_cube : cube (n+1)).to_set, + { simp only [to_set, forall_fin_succ, hp0, side_unit_cube, mem_set_of_eq, mem_Ico, + head_shift_up], refine ⟨⟨_, _⟩, _⟩, + { rw [←zero_add (0 : ℝ)], apply add_le_add, apply zero_le_b h, apply (cs i).hw' }, + { exact lt_of_le_of_ne (b_add_w_le_one h) hc }, + intro j, exact side_subset h (hps j) }, + rw [← h.2, mem_Union] at this, rcases this with ⟨i', hi'⟩, + rw [mem_Union], use i', refine ⟨_, λ j, hi' j.succ⟩, + have : i ≠ i', { rintro rfl, apply not_le_of_lt (hi' 0).2, rw [hp0], refl }, + have := h.1 this, rw [on_fun, to_set_disjoint, exists_fin_succ] at this, + rcases this with h0|⟨j, hj⟩, + rw [hp0], symmetry, apply eq_of_Ico_disjoint h0 (by simp [hw]) _, + convert hi' 0, rw [hp0], refl, + exfalso, apply not_disjoint_iff.mpr ⟨tail p j, hps j, hi' j.succ⟩ hj +end + +end correct + +/-- A valley is a square on which cubes in the family of cubes are placed, so that the cubes + completely cover the valley and none of those cubes is partially outside the square. + We also require that no cube on it has the same size as the valley (so that there are at least + two cubes on the valley). + This is the main concept in the formalization. + We prove that the smallest cube on a valley has another valley on the top of it, which + gives an infinite sequence of cubes in the partition, which contradicts the finiteness. + A valley is characterized by a cube `c` (which is not a cube in the family cs) by considering + the bottom face of `c`. -/ +def valley (cs : ι → cube (n+1)) (c : cube (n+1)) : Prop := +c.bottom ⊆ (⋃(i : ι), (cs i).bottom) ∧ +(∀i, (cs i).b 0 = c.b 0 → (∃x, x ∈ (cs i).tail.to_set ∩ c.tail.to_set) → + (cs i).tail.to_set ⊆ c.tail.to_set) ∧ +∀(i : ι), (cs i).b 0 = c.b 0 → (cs i).w ≠ c.w + +variables {c : cube (n+1)} (h : correct cs) (v : valley cs c) + +/-- The bottom of the unit cube is a valley -/ +lemma valley_unit_cube [nontrivial ι] (h : correct cs) : valley cs unit_cube := +begin + refine ⟨_, _, _⟩, + { intro v, + simp only [bottom, and_imp, mem_Union, mem_set_of_eq], + intros h0 hv, + have : v ∈ (unit_cube : cube (n+1)).to_set, + { dsimp only [to_set, unit_cube, mem_set_of_eq], + rw [forall_fin_succ, h0], split, norm_num [side, unit_cube], exact hv }, + rw [← h.2, mem_Union] at this, rcases this with ⟨i, hi⟩, + use i, + split, { apply le_antisymm, rw h0, exact h.zero_le_b, exact (hi 0).1 }, + intro j, exact hi _ }, + { intros i hi h', rw to_set_subset, intro j, convert h.side_subset using 1, simp [side_tail] }, + { intros i hi, exact h.w_ne_one i } +end + +/-- the cubes which lie in the valley `c` -/ +def bcubes (cs : ι → cube (n+1)) (c : cube (n+1)) : set ι := +{ i : ι | (cs i).b 0 = c.b 0 ∧ (cs i).tail.to_set ⊆ c.tail.to_set } + +/-- A cube which lies on the boundary of a valley in dimension `j` -/ +def on_boundary (hi : i ∈ bcubes cs c) (j : fin n) : Prop := +c.b j.succ = (cs i).b j.succ ∨ (cs i).b j.succ + (cs i).w = c.b j.succ + c.w + +lemma tail_sub (hi : i ∈ bcubes cs c) : ∀j, (cs i).tail.side j ⊆ c.tail.side j := +by { rw [←to_set_subset], exact hi.2 } + +lemma bottom_mem_side (hi : i ∈ bcubes cs c) : c.b 0 ∈ (cs i).side 0 := +by { convert b_mem_side (cs i) _ using 1, rw hi.1 } + +lemma b_le_b (hi : i ∈ bcubes cs c) (j : fin n) : c.b j.succ ≤ (cs i).b j.succ := +(tail_sub hi j $ b_mem_side _ _).1 + +lemma t_le_t (hi : i ∈ bcubes cs c) (j : fin n) : + (cs i).b j.succ + (cs i).w ≤ c.b j.succ + c.w := +begin + have h' := tail_sub hi j, dsimp only [side] at h', rw [Ico_subset_Ico_iff] at h', + exact h'.2, simp [hw] +end + +include h v +/-- Every cube in the valley must be smaller than it -/ +lemma w_lt_w (hi : i ∈ bcubes cs c) : (cs i).w < c.w := +begin + apply lt_of_le_of_ne _ (v.2.2 i hi.1), + have j : fin n := ⟨1, nat.le_of_succ_le_succ h.three_le⟩, + rw [←add_le_add_iff_left ((cs i).b j.succ)], + apply le_trans (t_le_t hi j), rw [add_le_add_iff_right], apply b_le_b hi, +end + +/-- There are at least two cubes in a valley -/ +lemma nontrivial_bcubes : (bcubes cs c).nontrivial := +begin + rcases v.1 c.b_mem_bottom with ⟨_, ⟨i, rfl⟩, hi⟩, + have h2i : i ∈ bcubes cs c := + ⟨hi.1.symm, v.2.1 i hi.1.symm ⟨tail c.b, hi.2, λ j, c.b_mem_side j.succ⟩⟩, + let j : fin (n+1) := ⟨2, h.three_le⟩, + have hj : 0 ≠ j := by { simp only [fin.ext_iff, ne.def], contradiction }, + let p : fin (n+1) → ℝ := λ j', if j' = j then c.b j + (cs i).w else c.b j', + have hp : p ∈ c.bottom, + { split, { simp only [bottom, p, if_neg hj] }, + intro j', simp only [tail, side_tail], + by_cases hj' : j'.succ = j, + { simp [p, -add_comm, if_pos, side, hj', hw', w_lt_w h v h2i] }, + { simp [p, -add_comm, if_neg hj'] }}, + rcases v.1 hp with ⟨_, ⟨i', rfl⟩, hi'⟩, + have h2i' : i' ∈ bcubes cs c := ⟨hi'.1.symm, v.2.1 i' hi'.1.symm ⟨tail p, hi'.2, hp.2⟩⟩, + refine ⟨i, h2i, i', h2i', _⟩, + rintro rfl, + apply not_le_of_lt (hi'.2 ⟨1, nat.le_of_succ_le_succ h.three_le⟩).2, + simp only [tail, cube.tail, p], + rw [if_pos, add_le_add_iff_right], + { exact (hi.2 _).1 }, + refl +end + +/-- There is a cube in the valley -/ +lemma nonempty_bcubes : (bcubes cs c).nonempty := +(nontrivial_bcubes h v).nonempty + +variables [finite ι] + +/-- There is a smallest cube in the valley -/ +lemma exists_mi : ∃ i ∈ bcubes cs c, ∀ i' ∈ bcubes cs c, + (cs i).w ≤ (cs i').w := +(bcubes cs c).exists_min_image (λ i, (cs i).w) (set.to_finite _) (nonempty_bcubes h v) + +/-- We let `mi` be the (index for the) smallest cube in the valley `c` -/ +def mi : ι := classical.some $ exists_mi h v + +variables {h v} +lemma mi_mem_bcubes : mi h v ∈ bcubes cs c := +(classical.some_spec $ exists_mi h v).fst + +lemma mi_minimal (hi : i ∈ bcubes cs c) : (cs $ mi h v).w ≤ (cs i).w := +(classical.some_spec $ exists_mi h v).snd i hi + +lemma mi_strict_minimal (hii' : mi h v ≠ i) (hi : i ∈ bcubes cs c) : + (cs $ mi h v).w < (cs i).w := +(mi_minimal hi).lt_of_ne $ h.injective.ne hii' + +/-- The top of `mi` cannot be 1, since there is a larger cube in the valley -/ +lemma mi_xm_ne_one : (cs $ mi h v).xm ≠ 1 := +begin + apply ne_of_lt, rcases (nontrivial_bcubes h v).exists_ne (mi h v) with ⟨i, hi, h2i⟩, + apply lt_of_lt_of_le _ h.b_add_w_le_one, exact i, exact 0, + rw [xm, mi_mem_bcubes.1, hi.1, _root_.add_lt_add_iff_left], + exact mi_strict_minimal h2i.symm hi +end + +/-- If `mi` lies on the boundary of the valley in dimension j, then this lemma expresses that all + other cubes on the same boundary extend further from the boundary. + More precisely, there is a j-th coordinate `x : ℝ` in the valley, but not in `mi`, + such that every cube that shares a (particular) j-th coordinate with `mi` also contains j-th + coordinate `x` -/ +lemma smallest_on_boundary {j} (bi : on_boundary (mi_mem_bcubes : mi h v ∈ _) j) : + ∃(x : ℝ), x ∈ c.side j.succ \ (cs $ mi h v).side j.succ ∧ + ∀ ⦃i'⦄ (hi' : i' ∈ bcubes cs c), i' ≠ mi h v → + (cs $ mi h v).b j.succ ∈ (cs i').side j.succ → x ∈ (cs i').side j.succ := +begin + let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes, + cases bi, + { refine ⟨(cs i).b j.succ + (cs i).w, ⟨_, _⟩, _⟩, + { simp [side, bi, hw', w_lt_w h v hi] }, + { intro h', simpa [i, lt_irrefl] using h'.2 }, + intros i' hi' i'_i h2i', split, + apply le_trans h2i'.1, { simp [hw'] }, + apply lt_of_lt_of_le (add_lt_add_left (mi_strict_minimal i'_i.symm hi') _), + simp [bi.symm, b_le_b hi'] }, + let s := bcubes cs c \ { i }, + have hs : s.nonempty, + { rcases (nontrivial_bcubes h v).exists_ne i with ⟨i', hi', h2i'⟩, + exact ⟨i', hi', h2i'⟩ }, + rcases set.exists_min_image s (w ∘ cs) (set.to_finite _) hs with ⟨i', ⟨hi', h2i'⟩, h3i'⟩, + rw [mem_singleton_iff] at h2i', + let x := c.b j.succ + c.w - (cs i').w, + have hx : x < (cs i).b j.succ, + { dsimp only [x], rw [←bi, add_sub_assoc, add_lt_iff_neg_left, sub_lt_zero], + apply mi_strict_minimal (ne.symm h2i') hi' }, + refine ⟨x, ⟨_, _⟩, _⟩, + { simp only [side, x, -add_comm, -add_assoc, neg_lt_zero, hw, add_lt_iff_neg_left, and_true, + mem_Ico, sub_eq_add_neg], + rw [add_assoc, le_add_iff_nonneg_right, ←sub_eq_add_neg, sub_nonneg], + apply le_of_lt (w_lt_w h v hi') }, + { simp only [side, not_and_distrib, not_lt, add_comm, not_le, mem_Ico], left, exact hx }, + intros i'' hi'' h2i'' h3i'', split, swap, apply lt_trans hx h3i''.2, + simp only [x], rw [le_sub_iff_add_le], + refine le_trans _ (t_le_t hi'' j), rw [add_le_add_iff_left], apply h3i' i'' ⟨hi'', _⟩, + simp [mem_singleton, h2i''] +end + +variables (h v) +/-- `mi` cannot lie on the boundary of the valley. Otherwise, the cube adjacent to it in the `j`-th + direction will intersect one of the neighbouring cubes on the same boundary as `mi`. -/ +lemma mi_not_on_boundary (j : fin n) : ¬on_boundary (mi_mem_bcubes : mi h v ∈ _) j := +begin + let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes, + haveI := h.nontrivial_fin, + rcases exists_ne j with ⟨j', hj'⟩, swap, + intro hj, + rcases smallest_on_boundary hj with ⟨x, ⟨hx, h2x⟩, h3x⟩, + let p : fin (n+1) → ℝ := cons (c.b 0) (λ j₂, if j₂ = j then x else (cs i).b j₂.succ), + have hp : p ∈ c.bottom, + { suffices : ∀ (j' : fin n), ite (j' = j) x ((cs i).b j'.succ) ∈ c.side j'.succ, + { simpa [bottom, p, to_set, tail, side_tail] }, + intro j₂, + by_cases hj₂ : j₂ = j, { simp [hj₂, hx] }, + simp only [hj₂, if_false], apply tail_sub hi, apply b_mem_side }, + rcases v.1 hp with ⟨_, ⟨i', rfl⟩, hi'⟩, + have h2i' : i' ∈ bcubes cs c := ⟨hi'.1.symm, v.2.1 i' hi'.1.symm ⟨tail p, hi'.2, hp.2⟩⟩, + have i_i' : i ≠ i', { rintro rfl, simpa [p, side_tail, i, h2x] using hi'.2 j }, + have : nonempty ↥((cs i').tail.side j' \ (cs i).tail.side j'), + { apply nonempty_Ico_sdiff, apply mi_strict_minimal i_i' h2i', apply hw }, + rcases this with ⟨⟨x', hx'⟩⟩, + let p' : fin (n+1) → ℝ := + cons (c.b 0) (λ j₂, if j₂ = j' then x' else (cs i).b j₂.succ), + have hp' : p' ∈ c.bottom, + { suffices : ∀ (j : fin n), ite (j = j') x' ((cs i).b j.succ) ∈ c.side j.succ, + { simpa [bottom, p', to_set, tail, side_tail] }, + intro j₂, + by_cases hj₂ : j₂ = j', simp [hj₂], apply tail_sub h2i', apply hx'.1, + simp only [if_congr, if_false, hj₂], apply tail_sub hi, apply b_mem_side }, + rcases v.1 hp' with ⟨_, ⟨i'', rfl⟩, hi''⟩, + have h2i'' : i'' ∈ bcubes cs c := ⟨hi''.1.symm, v.2.1 i'' hi''.1.symm ⟨tail p', hi''.2, hp'.2⟩⟩, + have i'_i'' : i' ≠ i'', + { rintro ⟨⟩, + have : (cs i).b ∈ (cs i').to_set, + { simp only [to_set, forall_fin_succ, hi.1, bottom_mem_side h2i', true_and, mem_set_of_eq], + intro j₂, by_cases hj₂ : j₂ = j, + { simpa [side_tail, p', hj'.symm, hj₂] using hi''.2 j }, + { simpa [hj₂] using hi'.2 j₂ } }, + apply not_disjoint_iff.mpr ⟨(cs i).b, (cs i).b_mem_to_set, this⟩ (h.1 i_i') }, + have i_i'' : i ≠ i'', { intro h, induction h, simpa [hx'.2] using hi''.2 j' }, + apply not.elim _ (h.1 i'_i''), + simp only [on_fun, to_set_disjoint, not_disjoint_iff, forall_fin_succ, not_exists, comp_app], + refine ⟨⟨c.b 0, bottom_mem_side h2i', bottom_mem_side h2i''⟩, _⟩, + intro j₂, + by_cases hj₂ : j₂ = j, + { cases hj₂, refine ⟨x, _, _⟩, + { convert hi'.2 j, simp [p] }, + apply h3x h2i'' i_i''.symm, convert hi''.2 j, simp [p', hj'.symm] }, + by_cases h2j₂ : j₂ = j', + { cases h2j₂, refine ⟨x', hx'.1, _⟩, convert hi''.2 j', simp }, + refine ⟨(cs i).b j₂.succ, _, _⟩, + { convert hi'.2 j₂, simp [hj₂] }, + { convert hi''.2 j₂, simp [h2j₂] } +end + +variables {h v} +/-- The same result that `mi` cannot lie on the boundary of the valley written as inequalities. -/ +lemma mi_not_on_boundary' (j : fin n) : c.tail.b j < (cs (mi h v)).tail.b j ∧ + (cs (mi h v)).tail.b j + (cs (mi h v)).w < c.tail.b j + c.w := +begin + have := mi_not_on_boundary h v j, + simp only [on_boundary, not_or_distrib] at this, cases this with h1 h2, + split, + apply lt_of_le_of_ne (b_le_b mi_mem_bcubes _) h1, + apply lt_of_le_of_ne _ h2, + apply ((Ico_subset_Ico_iff _).mp (tail_sub mi_mem_bcubes j)).2, + simp [hw] +end + +/-- The top of `mi` gives rise to a new valley, since the neighbouring cubes extend further upward + than `mi`. -/ +lemma valley_mi : valley cs ((cs (mi h v)).shift_up) := +begin + let i := mi h v, have hi : i ∈ bcubes cs c := mi_mem_bcubes, + refine ⟨_, _, _⟩, + { intro p, apply h.shift_up_bottom_subset_bottoms mi_xm_ne_one }, + { rintros i' hi' ⟨p2, hp2, h2p2⟩, simp only [head_shift_up] at hi', classical, by_contra h2i', + rw [tail_shift_up] at h2p2, simp only [not_subset, tail_shift_up] at h2i', + rcases h2i' with ⟨p1, hp1, h2p1⟩, + have : ∃p3, p3 ∈ (cs i').tail.to_set ∧ p3 ∉ (cs i).tail.to_set ∧ p3 ∈ c.tail.to_set, + { simp only [to_set, not_forall, mem_set_of_eq] at h2p1, cases h2p1 with j hj, + rcases Ico_lemma (mi_not_on_boundary' j).1 (by simp [hw]) (mi_not_on_boundary' j).2 + (le_trans (hp2 j).1 $ le_of_lt (h2p2 j).2) + (le_trans (h2p2 j).1 $ le_of_lt (hp2 j).2) ⟨hj, hp1 j⟩ with ⟨w, hw, h2w, h3w⟩, + refine ⟨λ j', if j' = j then w else p2 j', _, _, _⟩, + { intro j', by_cases h : j' = j, + { simp only [if_pos h], convert h3w }, + { simp only [if_neg h], exact hp2 j' } }, + { simp only [to_set, not_forall, mem_set_of_eq], use j, rw [if_pos rfl], convert h2w }, + { intro j', by_cases h : j' = j, + { simp only [if_pos h, side_tail], convert hw }, + { simp only [if_neg h], apply hi.2, apply h2p2 } } }, + rcases this with ⟨p3, h1p3, h2p3, h3p3⟩, + let p := @cons n (λ_, ℝ) (c.b 0) p3, + have hp : p ∈ c.bottom, { refine ⟨rfl, _⟩, rwa [tail_cons] }, + rcases v.1 hp with ⟨_, ⟨i'', rfl⟩, hi''⟩, + have h2i'' : i'' ∈ bcubes cs c, + { use hi''.1.symm, apply v.2.1 i'' hi''.1.symm, + use tail p, split, exact hi''.2, rw [tail_cons], exact h3p3 }, + have h3i'' : (cs i).w < (cs i'').w, + { apply mi_strict_minimal _ h2i'', rintro rfl, apply h2p3, convert hi''.2, rw [tail_cons] }, + let p' := @cons n (λ_, ℝ) (cs i).xm p3, + have hp' : p' ∈ (cs i').to_set, + { simpa [to_set, forall_fin_succ, p', hi'.symm] using h1p3 }, + have h2p' : p' ∈ (cs i'').to_set, + { simp only [to_set, forall_fin_succ, p', cons_succ, cons_zero, mem_set_of_eq], + refine ⟨_, by simpa [to_set, p] using hi''.2⟩, + have : (cs i).b 0 = (cs i'').b 0, { rw [hi.1, h2i''.1] }, + simp [side, hw', xm, this, h3i''] }, + apply not_disjoint_iff.mpr ⟨p', hp', h2p'⟩, + apply h.1, rintro rfl, apply (cs i).b_ne_xm, rw [←hi', ←hi''.1, hi.1], refl }, + { intros i' hi' h2i', + dsimp only [shift_up] at h2i', + replace h2i' := h.injective h2i'.symm, + induction h2i', + exact b_ne_xm (cs i) hi' } +end + +variables (h) [nontrivial ι] +omit v + +/-- We get a sequence of cubes whose size is decreasing -/ +noncomputable def sequence_of_cubes : ℕ → { i : ι // valley cs ((cs i).shift_up) } +| 0 := let v := valley_unit_cube h in ⟨mi h v, valley_mi⟩ +| (k+1) := let v := (sequence_of_cubes k).2 in ⟨mi h v, valley_mi⟩ + +def decreasing_sequence (k : ℕ) : ℝ := (cs (sequence_of_cubes h k).1).w + +lemma strict_anti_sequence_of_cubes : strict_anti $ decreasing_sequence h := +strict_anti_nat_of_succ_lt $ λ k, +begin + let v := (sequence_of_cubes h k).2, dsimp only [decreasing_sequence, sequence_of_cubes], + apply w_lt_w h v (mi_mem_bcubes : mi h v ∈ _), +end + +lemma injective_sequence_of_cubes : injective (sequence_of_cubes h) := +@injective.of_comp _ _ _ (λ x : {i : ι // _}, (cs x.1).w) _ + (strict_anti_sequence_of_cubes h).injective + +omit h + +/-- The infinite sequence of cubes contradicts the finiteness of the family. -/ +theorem not_correct : ¬correct cs := +λ h, (finite.of_injective _ $ injective_sequence_of_cubes h).false + +/-- **Dissection of Cubes**: A cube cannot be cubed. -/ +theorem cannot_cube_a_cube : + ∀ {n : ℕ}, n ≥ 3 → -- In ℝ^n for n ≥ 3 + ∀ {s : set (cube n)}, s.finite → -- given a finite collection of (hyper)cubes + s.nontrivial → -- containing at least two elements + s.pairwise_disjoint cube.to_set → -- which is pairwise disjoint + (⋃ c ∈ s, cube.to_set c) = unit_cube.to_set → -- whose union is the unit cube + inj_on cube.w s → -- such that the widths of all cubes are different + false := -- then we can derive a contradiction +begin + intros n hn s hfin h2 hd hU hinj, + cases n, + { cases hn }, + exact @not_correct n s coe hfin.to_subtype h2.coe_sort + ⟨hd.subtype _ _, (Union_subtype _ _).trans hU, hinj.injective, hn⟩ +end + +end «82» + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/friendship_graphs.lean b/archive/wiedijk_100_theorems/friendship_graphs.lean new file mode 100644 index 0000000000000..222ca67a633ba --- /dev/null +++ b/archive/wiedijk_100_theorems/friendship_graphs.lean @@ -0,0 +1,345 @@ +/- +Copyright (c) 2020 Aaron Anderson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aaron Anderson, Jalex Stark, Kyle Miller +-/ +import combinatorics.simple_graph.adj_matrix +import linear_algebra.matrix.charpoly.finite_field +import data.int.modeq +import data.zmod.basic +import tactic.interval_cases + +/-! +# The Friendship Theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Definitions and Statement +- A `friendship` graph is one in which any two distinct vertices have exactly one neighbor in common +- A `politician`, at least in the context of this problem, is a vertex in a graph which is adjacent + to every other vertex. +- The friendship theorem (Erdős, Rényi, Sós 1966) states that every finite friendship graph has a + politician. + +## Proof outline +The proof revolves around the theory of adjacency matrices, although some steps could equivalently +be phrased in terms of counting walks. +- Assume `G` is a finite friendship graph. +- First we show that any two nonadjacent vertices have the same degree +- Assume for contradiction that `G` does not have a politician. +- Conclude from the last two points that `G` is `d`-regular for some `d : ℕ`. +- Show that `G` has `d ^ 2 - d + 1` vertices. +- By casework, show that if `d = 0, 1, 2`, then `G` has a politician. +- If `3 ≤ d`, let `p` be a prime factor of `d - 1`. +- If `A` is the adjacency matrix of `G` with entries in `ℤ/pℤ`, we show that `A ^ p` has trace `1`. +- This gives a contradiction, as `A` has trace `0`, and thus `A ^ p` has trace `0`. + +## References +- [P. Erdős, A. Rényi, V. Sós, *On A Problem of Graph Theory*][erdosrenyisos] +- [C. Huneke, *The Friendship Theorem*][huneke2002] + +-/ + +open_locale classical big_operators +namespace theorems_100 + +noncomputable theory + +open finset simple_graph matrix + +universes u v +variables {V : Type u} {R : Type v} [semiring R] + +section friendship_def +variables (G : simple_graph V) + +/-- +This property of a graph is the hypothesis of the friendship theorem: +every pair of nonadjacent vertices has exactly one common friend, +a vertex to which both are adjacent. +-/ +def friendship [fintype V] : Prop := ∀ ⦃v w : V⦄, v ≠ w → fintype.card (G.common_neighbors v w) = 1 + +/-- +A politician is a vertex that is adjacent to all other vertices. +-/ +def exists_politician : Prop := ∃ (v : V), ∀ (w : V), v ≠ w → G.adj v w + +end friendship_def + +variables [fintype V] {G : simple_graph V} {d : ℕ} (hG : friendship G) +include hG + +namespace friendship + +variables (R) +/-- One characterization of a friendship graph is that there is exactly one walk of length 2 + between distinct vertices. These walks are counted in off-diagonal entries of the square of + the adjacency matrix, so for a friendship graph, those entries are all 1. -/ +theorem adj_matrix_sq_of_ne {v w : V} (hvw : v ≠ w) : + ((G.adj_matrix R) ^ 2) v w = 1 := +begin + rw [sq, ← nat.cast_one, ← hG hvw], + simp [common_neighbors, neighbor_finset_eq_filter, finset.filter_filter, + and_comm, ← neighbor_finset_def], +end + +/-- This calculation amounts to counting the number of length 3 walks between nonadjacent vertices. + We use it to show that nonadjacent vertices have equal degrees. -/ +lemma adj_matrix_pow_three_of_not_adj {v w : V} (non_adj : ¬ G.adj v w) : + ((G.adj_matrix R) ^ 3) v w = degree G v := +begin + rw [pow_succ, mul_eq_mul, adj_matrix_mul_apply, degree, card_eq_sum_ones, nat.cast_sum], + apply sum_congr rfl, + intros x hx, + rw [adj_matrix_sq_of_ne _ hG, nat.cast_one], + rintro ⟨rfl⟩, + rw mem_neighbor_finset at hx, + exact non_adj hx, +end + +variable {R} + +/-- As `v` and `w` not being adjacent implies + `degree G v = ((G.adj_matrix R) ^ 3) v w` and `degree G w = ((G.adj_matrix R) ^ 3) v w`, + the degrees are equal if `((G.adj_matrix R) ^ 3) v w = ((G.adj_matrix R) ^ 3) w v` + + This is true as the adjacency matrix is symmetric. -/ +lemma degree_eq_of_not_adj {v w : V} (hvw : ¬ G.adj v w) : + degree G v = degree G w := +begin + rw [← nat.cast_id (G.degree v), ← nat.cast_id (G.degree w), + ← adj_matrix_pow_three_of_not_adj ℕ hG hvw, + ← adj_matrix_pow_three_of_not_adj ℕ hG (λ h, hvw (G.symm h))], + conv_lhs {rw ← transpose_adj_matrix}, + simp only [pow_succ, sq, mul_eq_mul, ← transpose_mul, transpose_apply], + simp only [← mul_eq_mul, mul_assoc], +end + +/-- Let `A` be the adjacency matrix of a graph `G`. + If `G` is a friendship graph, then all of the off-diagonal entries of `A^2` are 1. + If `G` is `d`-regular, then all of the diagonal entries of `A^2` are `d`. + Putting these together determines `A^2` exactly for a `d`-regular friendship graph. -/ +theorem adj_matrix_sq_of_regular (hd : G.is_regular_of_degree d) : + ((G.adj_matrix R) ^ 2) = λ v w, if v = w then d else 1 := +begin + ext v w, by_cases h : v = w, + { rw [h, sq, mul_eq_mul, adj_matrix_mul_self_apply_self, hd], simp, }, + { rw [adj_matrix_sq_of_ne R hG h, if_neg h], }, +end + +lemma adj_matrix_sq_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) + (hd : G.is_regular_of_degree d) : + (G.adj_matrix (zmod p)) ^ 2 = λ _ _, 1 := +by simp [adj_matrix_sq_of_regular hG hd, dmod] + +section nonempty + +variable [nonempty V] + +/-- If `G` is a friendship graph without a politician (a vertex adjacent to all others), then + it is regular. We have shown that nonadjacent vertices of a friendship graph have the same degree, + and if there isn't a politician, we can show this for adjacent vertices by finding a vertex + neither is adjacent to, and then using transitivity. -/ +theorem is_regular_of_not_exists_politician (hG' : ¬exists_politician G) : + ∃ (d : ℕ), G.is_regular_of_degree d := +begin + have v := classical.arbitrary V, + use G.degree v, + intro x, + by_cases hvx : G.adj v x, swap, { exact (degree_eq_of_not_adj hG hvx).symm, }, + dunfold theorems_100.exists_politician at hG', + push_neg at hG', + rcases hG' v with ⟨w, hvw', hvw⟩, + rcases hG' x with ⟨y, hxy', hxy⟩, + by_cases hxw : G.adj x w, + swap, { rw degree_eq_of_not_adj hG hvw, exact degree_eq_of_not_adj hG hxw }, + rw degree_eq_of_not_adj hG hxy, + by_cases hvy : G.adj v y, + swap, { exact (degree_eq_of_not_adj hG hvy).symm }, + rw degree_eq_of_not_adj hG hvw, + apply degree_eq_of_not_adj hG, + intro hcontra, + rcases finset.card_eq_one.mp (hG hvw') with ⟨⟨a, ha⟩, h⟩, + have key : ∀ {x}, x ∈ G.common_neighbors v w → x = a, + { intros x hx, + have h' := mem_univ (subtype.mk x hx), + rw [h, mem_singleton] at h', + injection h', }, + apply hxy', + rw [key ((mem_common_neighbors G).mpr ⟨hvx, G.symm hxw⟩), + key ((mem_common_neighbors G).mpr ⟨hvy, G.symm hcontra⟩)], +end + +/-- Let `A` be the adjacency matrix of a `d`-regular friendship graph, and let `v` be a vector + all of whose components are `1`. Then `v` is an eigenvector of `A ^ 2`, and we can compute + the eigenvalue to be `d * d`, or as `d + (fintype.card V - 1)`, so those quantities must be equal. + + This essentially means that the graph has `d ^ 2 - d + 1` vertices. -/ +lemma card_of_regular (hd : G.is_regular_of_degree d) : + d + (fintype.card V - 1) = d * d := +begin + have v := classical.arbitrary V, + transitivity ((G.adj_matrix ℕ) ^ 2).mul_vec (λ _, 1) v, + { rw [adj_matrix_sq_of_regular hG hd, mul_vec, dot_product, ← insert_erase (mem_univ v)], + simp only [sum_insert, mul_one, if_true, nat.cast_id, eq_self_iff_true, + mem_erase, not_true, ne.def, not_false_iff, add_right_inj, false_and], + rw [finset.sum_const_nat, card_erase_of_mem (mem_univ v), mul_one], { refl }, + intros x hx, simp [(ne_of_mem_erase hx).symm], }, + { rw [sq, mul_eq_mul, ← mul_vec_mul_vec], + simp [adj_matrix_mul_vec_const_apply_of_regular hd, neighbor_finset, + card_neighbor_set_eq_degree, hd v], } +end + +/-- The size of a `d`-regular friendship graph is `1 mod (d-1)`, and thus `1 mod p` for a + factor `p ∣ d-1`. -/ +lemma card_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) (hd : G.is_regular_of_degree d) : + (fintype.card V : zmod p) = 1 := +begin + have hpos : 0 < fintype.card V := fintype.card_pos_iff.mpr infer_instance, + rw [← nat.succ_pred_eq_of_pos hpos, nat.succ_eq_add_one, nat.pred_eq_sub_one], + simp only [add_left_eq_self, nat.cast_add, nat.cast_one], + have h := congr_arg (λ n, (↑n : zmod p)) (card_of_regular hG hd), + revert h, simp [dmod], +end + +end nonempty + +omit hG + +lemma adj_matrix_sq_mul_const_one_of_regular (hd : G.is_regular_of_degree d) : + (G.adj_matrix R) * (λ _ _, 1) = λ _ _, d := +by { ext x, simp [← hd x, degree] } + +lemma adj_matrix_mul_const_one_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) + (hd : G.is_regular_of_degree d) : + (G.adj_matrix (zmod p)) * (λ _ _, 1) = λ _ _, 1 := +by rw [adj_matrix_sq_mul_const_one_of_regular hd, dmod] + +include hG + +/-- Modulo a factor of `d-1`, the square and all higher powers of the adjacency matrix + of a `d`-regular friendship graph reduce to the matrix whose entries are all 1. -/ +lemma adj_matrix_pow_mod_p_of_regular {p : ℕ} (dmod : (d : zmod p) = 1) + (hd : G.is_regular_of_degree d) {k : ℕ} (hk : 2 ≤ k) : + (G.adj_matrix (zmod p)) ^ k = λ _ _, 1 := +begin + iterate 2 {cases k with k, { exfalso, linarith, }, }, + induction k with k hind, + { exact adj_matrix_sq_mod_p_of_regular hG dmod hd, }, + rw [pow_succ, hind (nat.le_add_left 2 k)], + exact adj_matrix_mul_const_one_mod_p_of_regular dmod hd, +end + +variable [nonempty V] + +/-- This is the main proof. Assuming that `3 ≤ d`, we take `p` to be a prime factor of `d-1`. + Then the `p`th power of the adjacency matrix of a `d`-regular friendship graph must have trace 1 + mod `p`, but we can also show that the trace must be the `p`th power of the trace of the original + adjacency matrix, which is 0, a contradiction. +-/ +lemma false_of_three_le_degree (hd : G.is_regular_of_degree d) (h : 3 ≤ d) : false := +begin + -- get a prime factor of d - 1 + let p : ℕ := (d - 1).min_fac, + have p_dvd_d_pred := (zmod.nat_coe_zmod_eq_zero_iff_dvd _ _).mpr (d - 1).min_fac_dvd, + have dpos : 0 < d := by linarith, + have d_cast : ↑(d - 1) = (d : ℤ) - 1 := by norm_cast, + haveI : fact p.prime := ⟨nat.min_fac_prime (by linarith)⟩, + have hp2 : 2 ≤ p := (fact.out p.prime).two_le, + have dmod : (d : zmod p) = 1, + { rw [← nat.succ_pred_eq_of_pos dpos, nat.succ_eq_add_one, nat.pred_eq_sub_one], + simp only [add_left_eq_self, nat.cast_add, nat.cast_one], + exact p_dvd_d_pred, }, + have Vmod := card_mod_p_of_regular hG dmod hd, + -- now we reduce to a trace calculation + have := zmod.trace_pow_card (G.adj_matrix (zmod p)), + contrapose! this, clear this, + -- the trace is 0 mod p when computed one way + rw [trace_adj_matrix, zero_pow (fact.out p.prime).pos], + -- but the trace is 1 mod p when computed the other way + rw adj_matrix_pow_mod_p_of_regular hG dmod hd hp2, + dunfold fintype.card at Vmod, + simp only [matrix.trace, matrix.diag, mul_one, nsmul_eq_mul, linear_map.coe_mk, sum_const], + rw [Vmod, ← nat.cast_one, zmod.nat_coe_zmod_eq_zero_iff_dvd, nat.dvd_one, + nat.min_fac_eq_one_iff], + linarith, +end + +/-- If `d ≤ 1`, a `d`-regular friendship graph has at most one vertex, which is + trivially a politician. -/ +lemma exists_politician_of_degree_le_one (hd : G.is_regular_of_degree d) (hd1 : d ≤ 1) : + exists_politician G := +begin + have sq : d * d = d := by { interval_cases d; norm_num }, + have h := card_of_regular hG hd, + rw sq at h, + have : fintype.card V ≤ 1, + { cases fintype.card V with n, + { exact zero_le _, }, + { have : n = 0, + { rw [nat.succ_sub_succ_eq_sub, tsub_zero] at h, + linarith }, + subst n, } }, + use classical.arbitrary V, + intros w h, exfalso, + apply h, + apply fintype.card_le_one_iff.mp this, +end + +/-- If `d = 2`, a `d`-regular friendship graph has 3 vertices, so it must be complete graph, + and all the vertices are politicians. -/ +lemma neighbor_finset_eq_of_degree_eq_two (hd : G.is_regular_of_degree 2) (v : V) : + G.neighbor_finset v = finset.univ.erase v := +begin + apply finset.eq_of_subset_of_card_le, + { rw finset.subset_iff, + intro x, + rw [mem_neighbor_finset, finset.mem_erase], + exact λ h, ⟨(G.ne_of_adj h).symm, finset.mem_univ _⟩ }, + convert_to 2 ≤ _, + { convert_to _ = fintype.card V - 1, + { have hfr:= card_of_regular hG hd, + linarith }, + { exact finset.card_erase_of_mem (finset.mem_univ _), }, }, + { dsimp [is_regular_of_degree, degree] at hd, + rw hd, } +end + +lemma exists_politician_of_degree_eq_two (hd : G.is_regular_of_degree 2) : + exists_politician G := +begin + have v := classical.arbitrary V, + use v, + intros w hvw, + rw [← mem_neighbor_finset, neighbor_finset_eq_of_degree_eq_two hG hd v, finset.mem_erase], + exact ⟨hvw.symm, finset.mem_univ _⟩, +end + +lemma exists_politician_of_degree_le_two (hd : G.is_regular_of_degree d) (h : d ≤ 2) : + exists_politician G := +begin + interval_cases d, + iterate 2 { apply exists_politician_of_degree_le_one hG hd, norm_num }, + { exact exists_politician_of_degree_eq_two hG hd }, +end + +end friendship + +/-- **Friendship theorem**: We wish to show that a friendship graph has a politician (a vertex + adjacent to all others). We proceed by contradiction, and assume the graph has no politician. + We have already proven that a friendship graph with no politician is `d`-regular for some `d`, + and now we do casework on `d`. + If the degree is at most 2, we observe by casework that it has a politician anyway. + If the degree is at least 3, the graph cannot exist. -/ +theorem friendship_theorem [nonempty V] : exists_politician G := +begin + by_contradiction npG, + rcases hG.is_regular_of_not_exists_politician npG with ⟨d, dreg⟩, + cases lt_or_le d 3 with dle2 dge3, + { exact npG (hG.exists_politician_of_degree_le_two dreg (nat.lt_succ_iff.mp dle2)) }, + { exact hG.false_of_three_le_degree dreg dge3 }, +end + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/herons_formula.lean b/archive/wiedijk_100_theorems/herons_formula.lean new file mode 100644 index 0000000000000..0fb04262d0fe8 --- /dev/null +++ b/archive/wiedijk_100_theorems/herons_formula.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2021 Matt Kempster. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Matt Kempster +-/ +import geometry.euclidean.triangle + +/-! +# Freek № 57: Heron's Formula + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 57 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/), +also known as Heron's formula, which gives the area of a triangle based only on its three sides' +lengths. + +## References + +* https://en.wikipedia.org/wiki/Herons_formula + +-/ + +open real euclidean_geometry +open_locale real euclidean_geometry + +namespace theorems_100 + +local notation `√` := real.sqrt + +variables {V : Type*} {P : Type*} + [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] + +include V + +/-- **Heron's formula**: The area of a triangle with side lengths `a`, `b`, and `c` is + `√(s * (s - a) * (s - b) * (s - c))` where `s = (a + b + c) / 2` is the semiperimeter. + We show this by equating this formula to `a * b * sin γ`, where `γ` is the angle opposite + the side `c`. + -/ +theorem heron {p1 p2 p3 : P} (h1 : p1 ≠ p2) (h2 : p3 ≠ p2) : + let a := dist p1 p2, b := dist p3 p2, c := dist p1 p3, s := (a + b + c) / 2 in + 1/2 * a * b * sin (∠ p1 p2 p3) = √(s * (s - a) * (s - b) * (s - c)) := +begin + intros a b c s, + let γ := ∠ p1 p2 p3, + obtain := ⟨(dist_pos.mpr h1).ne', (dist_pos.mpr h2).ne'⟩, + have cos_rule : cos γ = (a * a + b * b - c * c) / (2 * a * b) := by field_simp [mul_comm, a, + dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle p1 p2 p3], + let numerator := (2*a*b)^2 - (a*a + b*b - c*c)^2, + let denominator := (2*a*b)^2, + have split_to_frac : 1 - cos γ ^ 2 = numerator / denominator := by field_simp [cos_rule], + have numerator_nonneg : 0 ≤ numerator, + { have frac_nonneg: 0 ≤ numerator / denominator := by linarith [split_to_frac, cos_sq_le_one γ], + cases div_nonneg_iff.mp frac_nonneg, + { exact h.left }, + { simpa [h1, h2] using le_antisymm h.right (sq_nonneg _) } }, + have ab2_nonneg : 0 ≤ (2 * a * b) := by norm_num [mul_nonneg, dist_nonneg], + calc 1/2 * a * b * sin γ + = 1/2 * a * b * (√numerator / √denominator) : by rw [sin_eq_sqrt_one_sub_cos_sq, + split_to_frac, sqrt_div numerator_nonneg]; + simp [angle_nonneg, angle_le_pi] + ... = 1/4 * √((2*a*b)^2 - (a*a + b*b - c*c)^2) : by { field_simp [ab2_nonneg], ring } + ... = 1/4 * √(s * (s-a) * (s-b) * (s-c) * 4^2) : by { simp only [s], ring_nf } + ... = √(s * (s-a) * (s-b) * (s-c)) : by rw [sqrt_mul', sqrt_sq, div_mul_eq_mul_div, + one_mul, mul_div_cancel]; + norm_num, +end + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/inverse_triangle_sum.lean b/archive/wiedijk_100_theorems/inverse_triangle_sum.lean new file mode 100644 index 0000000000000..b2a77cc1c4be9 --- /dev/null +++ b/archive/wiedijk_100_theorems/inverse_triangle_sum.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2020. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jalex Stark, Yury Kudryashov +-/ +import algebra.big_operators.basic +import data.real.basic + +/-! +# Sum of the Reciprocals of the Triangular Numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 42 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). + +We interpret “triangular numbers” as naturals of the form $\frac{k(k+1)}{2}$ for natural `k`. +We prove that the sum of the reciprocals of the first `n` triangular numbers is $2 - \frac2n$. + +## Tags + +discrete_sum +-/ + +open_locale big_operators +open finset + +/-- **Sum of the Reciprocals of the Triangular Numbers** -/ +lemma theorem_100.inverse_triangle_sum : + ∀ n, ∑ k in range n, (2 : ℚ) / (k * (k + 1)) = if n = 0 then 0 else 2 - (2 : ℚ) / n := +begin + refine sum_range_induction _ _ (if_pos rfl) _, + rintro (_|n), { rw [if_neg, if_pos]; norm_num }, + simp_rw [if_neg (nat.succ_ne_zero _), nat.succ_eq_add_one], + have A : (n + 1 + 1 : ℚ) ≠ 0, by { norm_cast, norm_num }, + push_cast, + field_simp [nat.cast_add_one_ne_zero], + ring +end diff --git a/archive/wiedijk_100_theorems/konigsberg.lean b/archive/wiedijk_100_theorems/konigsberg.lean new file mode 100644 index 0000000000000..fe5abdbe02a38 --- /dev/null +++ b/archive/wiedijk_100_theorems/konigsberg.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import combinatorics.simple_graph.trails +import tactic.derive_fintype + +/-! +# The Königsberg bridges problem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that a graph that represents the islands and mainlands of Königsberg and seven bridges +between them has no Eulerian trail. +-/ + +namespace konigsberg + +/-- The vertices for the Königsberg graph; four vertices for the bodies of land and seven +vertices for the bridges. -/ +@[derive [decidable_eq, fintype], nolint has_inhabited_instance] +inductive verts : Type +| V1 | V2 | V3 | V4 -- The islands and mainlands +| B1 | B2 | B3 | B4 | B5 | B6 | B7 -- The bridges + +open verts + +/-- Each of the connections between the islands/mainlands and the bridges. +These are ordered pairs, but the data becomes symmetric in `konigsberg.adj`. -/ +def edges : list (verts × verts) := +[ (V1, B1), (V1, B2), (V1, B3), (V1, B4), (V1, B5), + (B1, V2), (B2, V2), (B3, V4), (B4, V3), (B5, V3), + (V2, B6), (B6, V4), + (V3, B7), (B7, V4) ] + +/-- The adjacency relation for the Königsberg graph. -/ +def adj (v w : verts) : bool := ((v, w) ∈ edges) || ((w, v) ∈ edges) + +/-- The Königsberg graph structure. While the Königsberg bridge problem +is usually described using a multigraph, the we use a "mediant" construction +to transform it into a simple graph -- every edge in the multigraph is subdivided +into a path of two edges. This construction preserves whether a graph is Eulerian. + +(TODO: once mathlib has multigraphs, either prove the mediant construction preserves the +Eulerian property or switch this file to use multigraphs. -/ +@[simps] +def graph : simple_graph verts := +{ adj := λ v w, adj v w, + symm := begin + dsimp [symmetric, adj], + dec_trivial, + end, + loopless := begin + dsimp [irreflexive, adj], + dec_trivial + end } + +instance : decidable_rel graph.adj := λ a b, decidable_of_bool (adj a b) iff.rfl + +/-- To speed up the proof, this is a cache of all the degrees of each vertex, +proved in `konigsberg.degree_eq_degree`. -/ +@[simp] +def degree : verts → ℕ +| V1 := 5 | V2 := 3 | V3 := 3 | V4 := 3 +| B1 := 2 | B2 := 2 | B3 := 2 | B4 := 2 | B5 := 2 | B6 := 2 | B7 := 2 + +@[simp] lemma degree_eq_degree (v : verts) : graph.degree v = degree v := by cases v; refl + +/-- The Königsberg graph is not Eulerian. -/ +theorem not_is_eulerian {u v : verts} (p : graph.walk u v) (h : p.is_eulerian) : false := +begin + have : {v | odd (graph.degree v)} = {verts.V1, verts.V2, verts.V3, verts.V4}, + { ext w, + simp only [degree_eq_degree, nat.odd_iff_not_even, set.mem_set_of_eq, set.mem_insert_iff, + set.mem_singleton_iff], + cases w; simp, }, + have h := h.card_odd_degree, + simp_rw [this] at h, + norm_num at h, +end + +end konigsberg diff --git a/archive/wiedijk_100_theorems/partition.lean b/archive/wiedijk_100_theorems/partition.lean new file mode 100644 index 0000000000000..ac3d5f6c41d05 --- /dev/null +++ b/archive/wiedijk_100_theorems/partition.lean @@ -0,0 +1,530 @@ +/- +Copyright (c) 2020 Bhavik Mehta, Aaron Anderson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bhavik Mehta, Aaron Anderson +-/ +import ring_theory.power_series.basic +import combinatorics.partition +import data.nat.parity +import data.finset.nat_antidiagonal +import data.fin.tuple.nat_antidiagonal +import tactic.interval_cases +import tactic.apply_fun +import tactic.congrm + +/-! +# Euler's Partition Theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 45 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). + +The theorem concerns the counting of integer partitions -- ways of +writing a positive integer `n` as a sum of positive integer parts. + +Specifically, Euler proved that the number of integer partitions of `n` +into *distinct* parts equals the number of partitions of `n` into *odd* +parts. + +## Proof outline + +The proof is based on the generating functions for odd and distinct partitions, which turn out to be +equal: + +$$\prod_{i=0}^\infty \frac {1}{1-X^{2i+1}} = \prod_{i=0}^\infty (1+X^{i+1})$$ + +In fact, we do not take a limit: it turns out that comparing the `n`'th coefficients of the partial +products up to `m := n + 1` is sufficient. + +In particular, we + +1. define the partial product for the generating function for odd partitions `partial_odd_gf m` := + $$\prod_{i=0}^m \frac {1}{1-X^{2i+1}}$$; +2. prove `odd_gf_prop`: if `m` is big enough (`m * 2 > n`), the partial product's coefficient counts + the number of odd partitions; +3. define the partial product for the generating function for distinct partitions + `partial_distinct_gf m` := $$\prod_{i=0}^m (1+X^{i+1})$$; +4. prove `distinct_gf_prop`: if `m` is big enough (`m + 1 > n`), the `n`th coefficient of the + partial product counts the number of distinct partitions of `n`; +5. prove `same_coeffs`: if m is big enough (`m ≥ n`), the `n`th coefficient of the partial products + are equal; +6. combine the above in `partition_theorem`. + +## References +https://en.wikipedia.org/wiki/Partition_(number_theory)#Odd_parts_and_distinct_parts +-/ + +open power_series +namespace theorems_100 + +noncomputable theory + +variables {α : Type*} + +open finset +open_locale big_operators +open_locale classical + +/-- +The partial product for the generating function for odd partitions. +TODO: As `m` tends to infinity, this converges (in the `X`-adic topology). + +If `m` is sufficiently large, the `i`th coefficient gives the number of odd partitions of the +natural number `i`: proved in `odd_gf_prop`. +It is stated for an arbitrary field `α`, though it usually suffices to use `ℚ` or `ℝ`. +-/ +def partial_odd_gf (m : ℕ) [field α] := ∏ i in range m, (1 - (X : power_series α)^(2*i+1))⁻¹ + +/-- +The partial product for the generating function for distinct partitions. +TODO: As `m` tends to infinity, this converges (in the `X`-adic topology). + +If `m` is sufficiently large, the `i`th coefficient gives the number of distinct partitions of the +natural number `i`: proved in `distinct_gf_prop`. +It is stated for an arbitrary commutative semiring `α`, though it usually suffices to use `ℕ`, `ℚ` +or `ℝ`. +-/ +def partial_distinct_gf (m : ℕ) [comm_semiring α] := +∏ i in range m, (1 + (X : power_series α)^(i+1)) + +/-- +Functions defined only on `s`, which sum to `n`. In other words, a partition of `n` indexed by `s`. +Every function in here is finitely supported, and the support is a subset of `s`. +This should be thought of as a generalisation of `finset.nat.antidiagonal_tuple` where +`antidiagonal_tuple k n` is the same thing as `cut (s : finset.univ (fin k)) n`. +-/ +def cut {ι : Type*} (s : finset ι) (n : ℕ) : finset (ι → ℕ) := +finset.filter (λ f, s.sum f = n) ((s.pi (λ _, range (n+1))).map + ⟨λ f i, if h : i ∈ s then f i h else 0, + λ f g h, by { ext i hi, simpa [dif_pos hi] using congr_fun h i }⟩) + +lemma mem_cut {ι : Type*} (s : finset ι) (n : ℕ) (f : ι → ℕ) : + f ∈ cut s n ↔ s.sum f = n ∧ ∀ i ∉ s, f i = 0 := +begin + rw [cut, mem_filter, and_comm, and_congr_right], + intro h, + simp only [mem_map, exists_prop, function.embedding.coe_fn_mk, mem_pi], + split, + { rintro ⟨_, _, rfl⟩ _ _, + simp [dif_neg H] }, + { intro hf, + refine ⟨λ i hi, f i, λ i hi, _, _⟩, + { rw [mem_range, nat.lt_succ_iff, ← h], + apply single_le_sum _ hi, + simp }, + { ext, + rw [dite_eq_ite, ite_eq_left_iff, eq_comm], + exact hf x } } +end + +lemma cut_equiv_antidiag (n : ℕ) : + equiv.finset_congr (equiv.bool_arrow_equiv_prod _) (cut univ n) = nat.antidiagonal n := +begin + ext ⟨x₁, x₂⟩, + simp_rw [equiv.finset_congr_apply, mem_map, equiv.to_embedding, function.embedding.coe_fn_mk, + ←equiv.eq_symm_apply], + simp [mem_cut, add_comm], +end + +lemma cut_univ_fin_eq_antidiagonal_tuple (n : ℕ) (k : ℕ) : + cut univ n = nat.antidiagonal_tuple k n := +by { ext, simp [nat.mem_antidiagonal_tuple, mem_cut] } + +/-- There is only one `cut` of 0. -/ +@[simp] +lemma cut_zero {ι : Type*} (s : finset ι) : + cut s 0 = {0} := +begin + -- In general it's nice to prove things using `mem_cut` but in this case it's easier to just + -- use the definition. + rw [cut, range_one, pi_const_singleton, map_singleton, function.embedding.coe_fn_mk, + filter_singleton, if_pos, singleton_inj], + { ext, split_ifs; refl }, + rw sum_eq_zero_iff, + intros x hx, + apply dif_pos hx, +end + +@[simp] +lemma cut_empty_succ {ι : Type*} (n : ℕ) : + cut (∅ : finset ι) (n+1) = ∅ := +begin + apply eq_empty_of_forall_not_mem, + intros x hx, + rw [mem_cut, sum_empty] at hx, + cases hx.1, +end + +lemma cut_insert {ι : Type*} (n : ℕ) (a : ι) (s : finset ι) (h : a ∉ s) : + cut (insert a s) n = + (nat.antidiagonal n).bUnion + (λ (p : ℕ × ℕ), (cut s p.snd).map + ⟨λ f, f + λ t, if t = a then p.fst else 0, add_left_injective _⟩) := +begin + ext f, + rw [mem_cut, mem_bUnion, sum_insert h], + split, + { rintro ⟨rfl, h₁⟩, + simp only [exists_prop, function.embedding.coe_fn_mk, mem_map, + nat.mem_antidiagonal, prod.exists], + refine ⟨f a, s.sum f, rfl, λ i, if i = a then 0 else f i, _, _⟩, + { rw [mem_cut], + refine ⟨_, _⟩, + { rw [sum_ite], + have : (filter (λ x, x ≠ a) s) = s, + { apply filter_true_of_mem, + rintro i hi rfl, + apply h hi }, + simp [this] }, + { intros i hi, + rw ite_eq_left_iff, + intro hne, + apply h₁, + simp [not_or_distrib, hne, hi] } }, + { ext, + obtain rfl|h := eq_or_ne x a, + { simp }, + { simp [if_neg h] } } }, + { simp only [mem_insert, function.embedding.coe_fn_mk, mem_map, nat.mem_antidiagonal, prod.exists, + exists_prop, mem_cut, not_or_distrib], + rintro ⟨p, q, rfl, g, ⟨rfl, hg₂⟩, rfl⟩, + refine ⟨_, _⟩, + { simp [sum_add_distrib, if_neg h, hg₂ _ h, add_comm] }, + { rintro i ⟨h₁, h₂⟩, + simp [if_neg h₁, hg₂ _ h₂] } } +end + +lemma coeff_prod_range + [comm_semiring α] {ι : Type*} (s : finset ι) (f : ι → power_series α) (n : ℕ) : + coeff α n (∏ j in s, f j) = ∑ l in cut s n, ∏ i in s, coeff α (l i) (f i) := +begin + revert n, + apply finset.induction_on s, + { rintro ⟨_ | n⟩, + { simp }, + simp [cut_empty_succ, if_neg (nat.succ_ne_zero _)] }, + intros a s hi ih n, + rw [cut_insert _ _ _ hi, prod_insert hi, coeff_mul, sum_bUnion], + { congrm finset.sum _ (λ i, _), + simp only [sum_map, pi.add_apply, function.embedding.coe_fn_mk, prod_insert hi, if_pos rfl, ih, + mul_sum], + apply sum_congr rfl _, + intros x hx, + rw mem_cut at hx, + rw [hx.2 a hi, zero_add], + congrm _ * _, + apply prod_congr rfl, + intros k hk, + rw [if_neg, add_zero], + exact ne_of_mem_of_not_mem hk hi }, + { simp only [set.pairwise_disjoint, set.pairwise, prod.forall, not_and, ne.def, + nat.mem_antidiagonal, disjoint_left, mem_map, exists_prop, function.embedding.coe_fn_mk, + exists_imp_distrib, not_exists, finset.mem_coe, function.on_fun, mem_cut, and_imp], + rintro p₁ q₁ rfl p₂ q₂ h t x p hp hp2 hp3 q hq hq2 hq3, + have z := hp3.trans hq3.symm, + have := sum_congr (eq.refl s) (λ x _, function.funext_iff.1 z x), + obtain rfl : q₁ = q₂, + { simpa [sum_add_distrib, hp, hq, if_neg hi] using this }, + obtain rfl : p₂ = p₁, + { simpa using h }, + exact (t rfl).elim } +end + +/-- A convenience constructor for the power series whose coefficients indicate a subset. -/ +def indicator_series (α : Type*) [semiring α] (s : set ℕ) : power_series α := +power_series.mk (λ n, if n ∈ s then 1 else 0) + +lemma coeff_indicator (s : set ℕ) [semiring α] (n : ℕ) : + coeff α n (indicator_series _ s) = if n ∈ s then 1 else 0 := +coeff_mk _ _ +lemma coeff_indicator_pos (s : set ℕ) [semiring α] (n : ℕ) (h : n ∈ s): + coeff α n (indicator_series _ s) = 1 := +by rw [coeff_indicator, if_pos h] +lemma coeff_indicator_neg (s : set ℕ) [semiring α] (n : ℕ) (h : n ∉ s): + coeff α n (indicator_series _ s) = 0 := +by rw [coeff_indicator, if_neg h] +lemma constant_coeff_indicator (s : set ℕ) [semiring α] : + constant_coeff α (indicator_series _ s) = if 0 ∈ s then 1 else 0 := +rfl + +lemma two_series (i : ℕ) [semiring α] : + (1 + (X : power_series α)^i.succ) = indicator_series α {0, i.succ} := +begin + ext, + simp only [coeff_indicator, coeff_one, coeff_X_pow, set.mem_insert_iff, set.mem_singleton_iff, + map_add], + cases n with d, + { simp [(nat.succ_ne_zero i).symm] }, + { simp [nat.succ_ne_zero d], }, +end + +lemma num_series' [field α] (i : ℕ) : + (1 - (X : power_series α)^(i+1))⁻¹ = indicator_series α { k | i + 1 ∣ k } := +begin + rw power_series.inv_eq_iff_mul_eq_one, + { ext, + cases n, + { simp [mul_sub, zero_pow, constant_coeff_indicator] }, + { simp only [coeff_one, if_neg n.succ_ne_zero, mul_sub, mul_one, + coeff_indicator, linear_map.map_sub], + simp_rw [coeff_mul, coeff_X_pow, coeff_indicator, boole_mul, sum_ite, filter_filter, + sum_const_zero, add_zero, sum_const, nsmul_eq_mul, mul_one, sub_eq_iff_eq_add, + zero_add, filter_congr_decidable], + symmetry, + split_ifs, + { suffices : + ((nat.antidiagonal n.succ).filter (λ (a : ℕ × ℕ), i + 1 ∣ a.fst ∧ a.snd = i + 1)).card = 1, + { simp only [set.mem_set_of_eq], rw this, norm_cast }, + rw card_eq_one, + cases h with p hp, + refine ⟨((i+1) * (p-1), i+1), _⟩, + ext ⟨a₁, a₂⟩, + simp only [mem_filter, prod.mk.inj_iff, nat.mem_antidiagonal, mem_singleton], + split, + { rintro ⟨a_left, ⟨a, rfl⟩, rfl⟩, + refine ⟨_, rfl⟩, + rw [nat.mul_sub_left_distrib, ← hp, ← a_left, mul_one, nat.add_sub_cancel] }, + { rintro ⟨rfl, rfl⟩, + cases p, + { rw mul_zero at hp, cases hp }, + rw hp, + simp [nat.succ_eq_add_one, mul_add] } }, + { suffices : + (filter (λ (a : ℕ × ℕ), i + 1 ∣ a.fst ∧ a.snd = i + 1) (nat.antidiagonal n.succ)).card = 0, + { simp only [set.mem_set_of_eq], rw this, norm_cast }, + rw card_eq_zero, + apply eq_empty_of_forall_not_mem, + simp only [prod.forall, mem_filter, not_and, nat.mem_antidiagonal], + rintro _ h₁ h₂ ⟨a, rfl⟩ rfl, + apply h, + simp [← h₂] } } }, + { simp [zero_pow] }, +end + +def mk_odd : ℕ ↪ ℕ := ⟨λ i, 2 * i + 1, λ x y h, by linarith⟩ + +-- The main workhorse of the partition theorem proof. +lemma partial_gf_prop + (α : Type*) [comm_semiring α] (n : ℕ) (s : finset ℕ) + (hs : ∀ i ∈ s, 0 < i) (c : ℕ → set ℕ) (hc : ∀ i ∉ s, 0 ∈ c i) : + (finset.card + ((univ : finset (nat.partition n)).filter + (λ p, (∀ j, p.parts.count j ∈ c j) ∧ ∀ j ∈ p.parts, j ∈ s)) : α) = + (coeff α n) (∏ (i : ℕ) in s, indicator_series α ((* i) '' c i)) := +begin + simp_rw [coeff_prod_range, coeff_indicator, prod_boole, sum_boole], + congr' 1, + refine finset.card_congr (λ p _ i, multiset.count i p.parts • i) _ _ _, + { simp only [mem_filter, mem_cut, mem_univ, true_and, exists_prop, and_assoc, and_imp, + smul_eq_zero, function.embedding.coe_fn_mk, exists_imp_distrib], + rintro ⟨p, hp₁, hp₂⟩ hp₃ hp₄, + dsimp only at *, + refine ⟨_, _, _⟩, + { rw [←hp₂, ←sum_multiset_count_of_subset p s (λ x hx, hp₄ _ (multiset.mem_to_finset.mp hx))] }, + { intros i hi, + left, + exact multiset.count_eq_zero_of_not_mem (mt (hp₄ i) hi) }, + { exact λ i hi, ⟨_, hp₃ i, rfl⟩ } }, + { intros p₁ p₂ hp₁ hp₂ h, + apply nat.partition.ext, + simp only [true_and, mem_univ, mem_filter] at hp₁ hp₂, + ext i, + rw function.funext_iff at h, + specialize h i, + cases i, + { rw multiset.count_eq_zero_of_not_mem, + rw multiset.count_eq_zero_of_not_mem, + intro a, exact nat.lt_irrefl 0 (hs 0 (hp₂.2 0 a)), + intro a, exact nat.lt_irrefl 0 (hs 0 (hp₁.2 0 a)) }, + { rwa [nat.nsmul_eq_mul, nat.nsmul_eq_mul, mul_left_inj' i.succ_ne_zero] at h } }, + { simp only [mem_filter, mem_cut, mem_univ, exists_prop, true_and, and_assoc], + rintros f ⟨hf₁, hf₂, hf₃⟩, + refine ⟨⟨∑ i in s, multiset.replicate (f i / i) i, _, _⟩, _, _, _⟩, + { intros i hi, + simp only [exists_prop, mem_sum, mem_map, function.embedding.coe_fn_mk] at hi, + rcases hi with ⟨t, ht, z⟩, + apply hs, + rwa multiset.eq_of_mem_replicate z }, + { simp_rw [multiset.sum_sum, multiset.sum_replicate, nat.nsmul_eq_mul, ←hf₁], + refine sum_congr rfl (λ i hi, nat.div_mul_cancel _), + rcases hf₃ i hi with ⟨w, hw, hw₂⟩, + rw ← hw₂, + exact dvd_mul_left _ _ }, + { intro i, + simp_rw [multiset.count_sum', multiset.count_replicate, sum_ite_eq], + split_ifs with h h, + { rcases hf₃ i h with ⟨w, hw₁, hw₂⟩, + rwa [← hw₂, nat.mul_div_cancel _ (hs i h)] }, + { exact hc _ h } }, + { intros i hi, + rw mem_sum at hi, + rcases hi with ⟨j, hj₁, hj₂⟩, + rwa multiset.eq_of_mem_replicate hj₂ }, + { ext i, + simp_rw [multiset.count_sum', multiset.count_replicate, sum_ite_eq], + split_ifs, + { apply nat.div_mul_cancel, + rcases hf₃ i h with ⟨w, hw, hw₂⟩, + apply dvd.intro_left _ hw₂ }, + { rw [zero_smul, hf₂ i h] } } }, +end + +lemma partial_odd_gf_prop [field α] (n m : ℕ) : + (finset.card ((univ : finset (nat.partition n)).filter + (λ p, ∀ j ∈ p.parts, j ∈ (range m).map mk_odd)) : α) = coeff α n (partial_odd_gf m) := +begin + rw partial_odd_gf, + convert partial_gf_prop α n ((range m).map mk_odd) _ (λ _, set.univ) (λ _ _, trivial) using 2, + { congrm card (filter (λ p, _) _), + simp only [true_and, forall_const, set.mem_univ] }, + { rw finset.prod_map, + simp_rw num_series', + congrm finset.prod _ (λ x, indicator_series α _), + ext k, + split, + { rintro ⟨p, rfl⟩, + refine ⟨p, ⟨⟩, _⟩, + apply mul_comm }, + rintro ⟨a_w, -, rfl⟩, + apply dvd.intro_left a_w rfl }, + { intro i, + rw mem_map, + rintro ⟨a, -, rfl⟩, + exact nat.succ_pos _ }, +end + +/-- If m is big enough, the partial product's coefficient counts the number of odd partitions -/ +theorem odd_gf_prop [field α] (n m : ℕ) (h : n < m * 2) : + (finset.card (nat.partition.odds n) : α) = coeff α n (partial_odd_gf m) := +begin + rw [← partial_odd_gf_prop], + congrm card (filter (λ p, (_ : Prop)) _), + apply ball_congr, + intros i hi, + have hin : i ≤ n, + { simpa [p.parts_sum] using multiset.single_le_sum (λ _ _, nat.zero_le _) _ hi }, + simp only [mk_odd, exists_prop, mem_range, function.embedding.coe_fn_mk, mem_map], + split, + { intro hi₂, + have := nat.mod_add_div i 2, + rw nat.not_even_iff at hi₂, + rw [hi₂, add_comm] at this, + refine ⟨i / 2, _, this⟩, + rw nat.div_lt_iff_lt_mul zero_lt_two, + exact lt_of_le_of_lt hin h }, + { rintro ⟨a, -, rfl⟩, + rw even_iff_two_dvd, + apply nat.two_not_dvd_two_mul_add_one }, +end + +lemma partial_distinct_gf_prop [comm_semiring α] (n m : ℕ) : + (finset.card + ((univ : finset (nat.partition n)).filter + (λ p, p.parts.nodup ∧ ∀ j ∈ p.parts, j ∈ (range m).map ⟨nat.succ, nat.succ_injective⟩)) : α) = + coeff α n (partial_distinct_gf m) := +begin + rw partial_distinct_gf, + convert partial_gf_prop α n + ((range m).map ⟨nat.succ, nat.succ_injective⟩) _ (λ _, {0, 1}) (λ _ _, or.inl rfl) using 2, + { congrm card (filter (λ p, _ ∧ _) _), + rw multiset.nodup_iff_count_le_one, + congrm ∀ (i : ℕ), (_ : Prop), + rcases multiset.count i p.parts with _|_|ms; + simp }, + { simp_rw [finset.prod_map, two_series], + congrm finset.prod _ (λ i, indicator_series _ _), + simp [set.image_pair] }, + { simp only [mem_map, function.embedding.coe_fn_mk], + rintro i ⟨_, _, rfl⟩, + apply nat.succ_pos } +end + +/-- +If m is big enough, the partial product's coefficient counts the number of distinct partitions +-/ +theorem distinct_gf_prop [comm_semiring α] (n m : ℕ) (h : n < m + 1) : + ((nat.partition.distincts n).card : α) = coeff α n (partial_distinct_gf m) := +begin + erw [← partial_distinct_gf_prop], + congrm card (filter (λ p, _) _), + apply (and_iff_left _).symm, + intros i hi, + have : i ≤ n, + { simpa [p.parts_sum] using multiset.single_le_sum (λ _ _, nat.zero_le _) _ hi }, + simp only [mk_odd, exists_prop, mem_range, function.embedding.coe_fn_mk, mem_map], + refine ⟨i-1, _, nat.succ_pred_eq_of_pos (p.parts_pos hi)⟩, + rw tsub_lt_iff_right (nat.one_le_iff_ne_zero.mpr (p.parts_pos hi).ne'), + exact lt_of_le_of_lt this h, +end + +/-- +The key proof idea for the partition theorem, showing that the generating functions for both +sequences are ultimately the same (since the factor converges to 0 as m tends to infinity). +It's enough to not take the limit though, and just consider large enough `m`. +-/ +lemma same_gf [field α] (m : ℕ) : + partial_odd_gf m * (range m).prod (λ i, (1 - (X : power_series α)^(m+i+1))) = + partial_distinct_gf m := +begin + rw [partial_odd_gf, partial_distinct_gf], + induction m with m ih, + { simp }, + + rw nat.succ_eq_add_one, + + set π₀ : power_series α := ∏ i in range m, (1 - X ^ (m + 1 + i + 1)) with hπ₀, + set π₁ : power_series α := ∏ i in range m, (1 - X ^ (2 * i + 1))⁻¹ with hπ₁, + set π₂ : power_series α := ∏ i in range m, (1 - X ^ (m + i + 1)) with hπ₂, + set π₃ : power_series α := ∏ i in range m, (1 + X ^ (i + 1)) with hπ₃, + rw ←hπ₃ at ih, + + have h : constant_coeff α (1 - X ^ (2 * m + 1)) ≠ 0, + { rw [ring_hom.map_sub, ring_hom.map_pow, constant_coeff_one, constant_coeff_X, + zero_pow (2 * m).succ_pos, sub_zero], + exact one_ne_zero }, + + calc (∏ i in range (m + 1), (1 - X ^ (2 * i + 1))⁻¹) * + ∏ i in range (m + 1), (1 - X ^ (m + 1 + i + 1)) + = π₁ * (1 - X ^ (2 * m + 1))⁻¹ * (π₀ * (1 - X ^ (m + 1 + m + 1))) : + by rw [prod_range_succ _ m, ←hπ₁, prod_range_succ _ m, ←hπ₀] + ... = π₁ * (1 - X ^ (2 * m + 1))⁻¹ * (π₀ * ((1 + X ^ (m + 1)) * (1 - X ^ (m + 1)))) : + by rw [←sq_sub_sq, one_pow, add_assoc _ m 1, ←two_mul (m + 1), pow_mul'] + ... = π₀ * (1 - X ^ (m + 1)) * (1 - X ^ (2 * m + 1))⁻¹ * (π₁ * (1 + X ^ (m + 1))) : + by ring + ... = (∏ i in range (m + 1), (1 - X ^ (m + 1 + i))) * (1 - X ^ (2 * m + 1))⁻¹ * + (π₁ * (1 + X ^ (m + 1))) : + by { rw [prod_range_succ', add_zero, hπ₀], simp_rw ←add_assoc } + ... = π₂ * (1 - X ^ (m + 1 + m)) * (1 - X ^ (2 * m + 1))⁻¹ * (π₁ * (1 + X ^ (m + 1))) : + by { rw [add_right_comm, hπ₂, ←prod_range_succ], simp_rw [add_right_comm] } + ... = π₂ * (1 - X ^ (2 * m + 1)) * (1 - X ^ (2 * m + 1))⁻¹ * (π₁ * (1 + X ^ (m + 1))) : + by rw [two_mul, add_right_comm _ m 1] + ... = (1 - X ^ (2 * m + 1)) * (1 - X ^ (2 * m + 1))⁻¹ * π₂ * (π₁ * (1 + X ^ (m + 1))) : + by ring + ... = π₂ * (π₁ * (1 + X ^ (m + 1))) : by rw [power_series.mul_inv_cancel _ h, one_mul] + ... = π₁ * π₂ * (1 + X ^ (m + 1)) : by ring + ... = π₃ * (1 + X ^ (m + 1)) : by rw ih + ... = _ : by rw prod_range_succ, +end + +lemma same_coeffs [field α] (m n : ℕ) (h : n ≤ m) : + coeff α n (partial_odd_gf m) = coeff α n (partial_distinct_gf m) := +begin + rw [← same_gf, coeff_mul_prod_one_sub_of_lt_order], + rintros i -, + rw order_X_pow, + exact_mod_cast nat.lt_succ_of_le (le_add_right h), +end + +theorem partition_theorem (n : ℕ) : + (nat.partition.odds n).card = (nat.partition.distincts n).card := +begin + -- We need the counts to live in some field (which contains ℕ), so let's just use ℚ + suffices : ((nat.partition.odds n).card : ℚ) = (nat.partition.distincts n).card, + { exact_mod_cast this }, + rw distinct_gf_prop n (n+1) (by linarith), + rw odd_gf_prop n (n+1) (by linarith), + apply same_coeffs (n+1) n n.le_succ, +end + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/perfect_numbers.lean b/archive/wiedijk_100_theorems/perfect_numbers.lean new file mode 100644 index 0000000000000..191b9bd62c36e --- /dev/null +++ b/archive/wiedijk_100_theorems/perfect_numbers.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2020 Aaron Anderson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aaron Anderson +-/ + +import number_theory.arithmetic_function +import number_theory.lucas_lehmer +import algebra.geom_sum +import ring_theory.multiplicity + +/-! +# Perfect Numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 70 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). + +The theorem characterizes even perfect numbers. + +Euclid proved that if `2 ^ (k + 1) - 1` is prime (these primes are known as Mersenne primes), + then `2 ^ k * 2 ^ (k + 1) - 1` is perfect. + +Euler proved the converse, that if `n` is even and perfect, then there exists `k` such that + `n = 2 ^ k * 2 ^ (k + 1) - 1` and `2 ^ (k + 1) - 1` is prime. + +## References +https://en.wikipedia.org/wiki/Euclid%E2%80%93Euler_theorem +-/ + +namespace theorems_100 + +lemma odd_mersenne_succ (k : ℕ) : ¬ 2 ∣ mersenne (k + 1) := +by simp [← even_iff_two_dvd, ← nat.even_add_one] with parity_simps + +namespace nat +open nat.arithmetic_function finset +open_locale arithmetic_function + +lemma sigma_two_pow_eq_mersenne_succ (k : ℕ) : σ 1 (2 ^ k) = mersenne (k + 1) := +by simp [sigma_one_apply, mersenne, nat.prime_two, ← geom_sum_mul_add 1 (k+1)] + +/-- Euclid's theorem that Mersenne primes induce perfect numbers -/ +theorem perfect_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) : + nat.perfect ((2 ^ k) * mersenne (k + 1)) := +begin + rw [nat.perfect_iff_sum_divisors_eq_two_mul, ← mul_assoc, ← pow_succ, ← sigma_one_apply, mul_comm, + is_multiplicative_sigma.map_mul_of_coprime + (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)), + sigma_two_pow_eq_mersenne_succ], + { simp [pr, nat.prime_two, sigma_one_apply] }, + { apply mul_pos (pow_pos _ k) (mersenne_pos (nat.succ_pos k)), + norm_num } +end + +lemma ne_zero_of_prime_mersenne (k : ℕ) (pr : (mersenne (k + 1)).prime) : + k ≠ 0 := +begin + intro H, + simpa [H, mersenne, nat.not_prime_one] using pr, +end + +theorem even_two_pow_mul_mersenne_of_prime (k : ℕ) (pr : (mersenne (k + 1)).prime) : + even ((2 ^ k) * mersenne (k + 1)) := +by simp [ne_zero_of_prime_mersenne k pr] with parity_simps + +lemma eq_two_pow_mul_odd {n : ℕ} (hpos : 0 < n) : + ∃ (k m : ℕ), n = 2 ^ k * m ∧ ¬ even m := +begin + have h := (multiplicity.finite_nat_iff.2 ⟨nat.prime_two.ne_one, hpos⟩), + cases multiplicity.pow_multiplicity_dvd h with m hm, + use [(multiplicity 2 n).get h, m], + refine ⟨hm, _⟩, + rw even_iff_two_dvd, + have hg := multiplicity.is_greatest' h (nat.lt_succ_self _), + contrapose! hg, + rcases hg with ⟨k, rfl⟩, + apply dvd.intro k, + rw [pow_succ', mul_assoc, ← hm], +end + +/-- **Perfect Number Theorem**: Euler's theorem that even perfect numbers can be factored as a + power of two times a Mersenne prime. -/ +theorem eq_two_pow_mul_prime_mersenne_of_even_perfect {n : ℕ} (ev : even n) (perf : nat.perfect n) : + ∃ (k : ℕ), nat.prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) := +begin + have hpos := perf.2, + rcases eq_two_pow_mul_odd hpos with ⟨k, m, rfl, hm⟩, + use k, + rw even_iff_two_dvd at hm, + rw [nat.perfect_iff_sum_divisors_eq_two_mul hpos, ← sigma_one_apply, + is_multiplicative_sigma.map_mul_of_coprime (nat.prime_two.coprime_pow_of_not_dvd hm).symm, + sigma_two_pow_eq_mersenne_succ, ← mul_assoc, ← pow_succ] at perf, + rcases nat.coprime.dvd_of_dvd_mul_left + (nat.prime_two.coprime_pow_of_not_dvd (odd_mersenne_succ _)) (dvd.intro _ perf) with ⟨j, rfl⟩, + rw [← mul_assoc, mul_comm _ (mersenne _), mul_assoc] at perf, + have h := mul_left_cancel₀ (ne_of_gt (mersenne_pos (nat.succ_pos _))) perf, + rw [sigma_one_apply, nat.sum_divisors_eq_sum_proper_divisors_add_self, ← succ_mersenne, add_mul, + one_mul, add_comm] at h, + have hj := add_left_cancel h, + cases nat.sum_proper_divisors_dvd (by { rw hj, apply dvd.intro_left (mersenne (k + 1)) rfl }), + { have j1 : j = 1 := eq.trans hj.symm h_1, + rw [j1, mul_one, nat.sum_proper_divisors_eq_one_iff_prime] at h_1, + simp [h_1, j1] }, + { have jcon := eq.trans hj.symm h_1, + rw [← one_mul j, ← mul_assoc, mul_one] at jcon, + have jcon2 := mul_right_cancel₀ _ jcon, + { exfalso, + cases k, + { apply hm, + rw [← jcon2, pow_zero, one_mul, one_mul] at ev, + rw [← jcon2, one_mul], + exact even_iff_two_dvd.mp ev }, + apply ne_of_lt _ jcon2, + rw [mersenne, ← nat.pred_eq_sub_one, nat.lt_pred_iff, ← pow_one (nat.succ 1)], + apply pow_lt_pow (nat.lt_succ_self 1) (nat.succ_lt_succ (nat.succ_pos k)) }, + contrapose! hm, + simp [hm] } +end + +/-- The Euclid-Euler theorem characterizing even perfect numbers -/ +theorem even_and_perfect_iff {n : ℕ} : + (even n ∧ nat.perfect n) ↔ + ∃ (k : ℕ), nat.prime (mersenne (k + 1)) ∧ n = 2 ^ k * mersenne (k + 1) := +begin + split, + { rintro ⟨ev, perf⟩, + exact nat.eq_two_pow_mul_prime_mersenne_of_even_perfect ev perf }, + { rintro ⟨k, pr, rfl⟩, + exact ⟨even_two_pow_mul_mersenne_of_prime k pr, perfect_two_pow_mul_mersenne_of_prime k pr⟩ } +end + +end nat + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/solution_of_cubic.lean b/archive/wiedijk_100_theorems/solution_of_cubic.lean new file mode 100644 index 0000000000000..57e17a74e712f --- /dev/null +++ b/archive/wiedijk_100_theorems/solution_of_cubic.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2022 Jeoff Lee. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeoff Lee +-/ +import tactic.linear_combination +import ring_theory.polynomial.cyclotomic.roots + +/-! +# The Solution of a Cubic + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 37 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). + +In this file, we give the solutions to the cubic equation `a * x^3 + b * x^2 + c * x + d = 0` +over a field `K` that has characteristic neither 2 nor 3, that has a third primitive root of +unity, and in which certain other quantities admit square and cube roots. + +This is based on the [Cardano's Formula](https://en.wikipedia.org/wiki/Cubic_equation#Cardano's_formula). + +## Main statements + +- `cubic_eq_zero_iff` : gives the roots of the cubic equation +where the discriminant `p = 3 * a * c - b^2` is nonzero. +- `cubic_eq_zero_iff_of_p_eq_zero` : gives the roots of the cubic equation +where the discriminant equals zero. + +## References + +Originally ported from Isabelle/HOL. The +[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL-ex/Cubic_Quartic.html) was written by Amine Chaieb. + +## Tags + +polynomial, cubic, root +-/ + +namespace theorems_100 + +section field + +open polynomial + +variables {K : Type*} [field K] +variables [invertible (2 : K)] [invertible (3 : K)] +variables (a b c d : K) +variables {ω p q r s t : K} + +lemma cube_root_of_unity_sum (hω : is_primitive_root ω 3) : 1 + ω + ω^2 = 0 := +begin + convert hω.is_root_cyclotomic (nat.succ_pos _), + simp only [cyclotomic_prime, eval_geom_sum], + simp [finset.sum_range_succ] +end + +/-- The roots of a monic cubic whose quadratic term is zero and whose discriminant is nonzero. -/ +lemma cubic_basic_eq_zero_iff + (hω : is_primitive_root ω 3) + (hp_nonzero : p ≠ 0) + (hr : r^2 = q^2 + p^3) + (hs3 : s^3 = q + r) + (ht : t * s = p) + (x : K) : + x^3 + 3 * p * x - 2 * q = 0 ↔ + x = s - t ∨ + x = s * ω - t * ω^2 ∨ + x = s * ω^2 - t * ω := +begin + have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0, + { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] }, + rw h₁, + refine eq.congr _ rfl, + have hs_nonzero : s ≠ 0, + { contrapose! hp_nonzero with hs_nonzero, + linear_combination -1*ht + t*hs_nonzero }, + rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero), + have H := cube_root_of_unity_sum hω, + linear_combination + hr + + (- q + r + s ^ 3) * hs3 - + (3 * x * s ^ 3 + (t * s) ^ 2 + (t * s) * p + p ^ 2) * ht + + ((x ^ 2 * (s - t) + x * (- ω * (s ^ 2 + t ^ 2) + s * t * (3 + ω ^ 2 - ω)) + - (-(s ^ 3 - t ^ 3) * (ω - 1) + s^2 * t * ω ^ 2 - s * t^2 * ω ^ 2)) * s ^ 3) * H, + +end + +/-- Roots of a monic cubic whose discriminant is nonzero. -/ +lemma cubic_monic_eq_zero_iff + (hω : is_primitive_root ω 3) + (hp : p = (3 * c - b^2) / 9) + (hp_nonzero : p ≠ 0) + (hq : q = (9 * b * c - 2 * b^3 - 27 * d) / 54) + (hr : r^2 = q^2 + p^3) + (hs3 : s^3 = q + r) + (ht : t * s = p) + (x : K) : + x^3 + b * x^2 + c * x + d = 0 ↔ + x = s - t - b / 3 ∨ + x = s * ω - t * ω^2 - b / 3 ∨ + x = s * ω^2 - t * ω - b / 3 := +begin + let y := x + b / 3, + have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _, + have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _, + have h9 : (9 : K) = 3^2 := by norm_num, + have h54 : (54 : K) = 2*3^3 := by norm_num, + have h₁ : x^3 + b * x^2 + c * x + d = y^3 + 3 * p * y - 2 * q, + { dsimp only [y], + rw [hp, hq], + field_simp [h9, h54], ring, }, + rw [h₁, cubic_basic_eq_zero_iff hω hp_nonzero hr hs3 ht y], + dsimp only [y], + simp_rw [eq_sub_iff_add_eq], +end + +/-- **The Solution of Cubic**. + The roots of a cubic polynomial whose discriminant is nonzero. -/ +theorem cubic_eq_zero_iff (ha : a ≠ 0) + (hω : is_primitive_root ω 3) + (hp : p = (3 * a * c - b^2) / (9 * a^2)) + (hp_nonzero : p ≠ 0) + (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3)) + (hr : r^2 = q^2 + p^3) + (hs3 : s^3 = q + r) + (ht : t * s = p) + (x : K) : + a * x^3 + b * x^2 + c * x + d = 0 ↔ + x = s - t - b / (3 * a) ∨ + x = s * ω - t * ω^2 - b / (3 * a) ∨ + x = s * ω^2 - t * ω - b / (3 * a) := +begin + have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _, + have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _, + have h9 : (9 : K) = 3^2 := by norm_num, + have h54 : (54 : K) = 2*3^3 := by norm_num, + have h₁ : a * x^3 + b * x^2 + c * x + d = a * (x^3 + b/a * x^2 + c/a * x + d/a), + { field_simp, ring }, + have h₂ : ∀ x, a * x = 0 ↔ x = 0, { intros x, simp [ha], }, + have hp' : p = (3 * (c/a) - (b/a) ^ 2) / 9, { field_simp [hp, h9], ring_nf }, + have hq' : q = (9 * (b/a) * (c/a) - 2 * (b/a) ^ 3 - 27 * (d/a)) / 54, + { field_simp [hq, h54], ring_nf }, + rw [h₁, h₂, cubic_monic_eq_zero_iff (b/a) (c/a) (d/a) hω hp' hp_nonzero hq' hr hs3 ht x], + have h₄ := calc b / a / 3 = b / (a * 3) : by { field_simp [ha] } + ... = b / (3 * a) : by rw mul_comm, + rw [h₄], +end + +/-- the solution of the cubic equation when p equals zero. -/ +lemma cubic_eq_zero_iff_of_p_eq_zero (ha : a ≠ 0) + (hω : is_primitive_root ω 3) + (hpz : 3 * a * c - b^2 = 0) + (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3)) + (hs3 : s^3 = 2 * q) + (x : K) : + a * x^3 + b * x^2 + c * x + d = 0 ↔ + x = s - b / (3 * a) ∨ + x = s * ω - b / (3 * a) ∨ + x = s * ω^2 - b / (3 * a) := +begin + have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0, + { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] }, + have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _, + have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _, + have h54 : (54 : K) = 2*3^3 := by norm_num, + have hb2 : b^2 = 3 * a * c, { rw sub_eq_zero at hpz, rw hpz }, + have hb3 : b^3 = 3 * a * b * c, { rw [pow_succ, hb2], ring }, + have h₂ := + calc a * x^3 + b * x^2 + c * x + d + = a * (x + b/(3*a))^3 + (c - b^2/(3*a)) * x + (d - b^3*a/(3*a)^3) + : by { field_simp, ring } + ... = a * (x + b/(3*a))^3 + (d - (9*a*b*c-2*b^3)*a/(3*a)^3) + : by { simp only [hb2, hb3], field_simp, ring } + ... = a * ((x + b/(3*a))^3 - s^3) + : by { rw [hs3, hq], field_simp [h54], ring, }, + have h₃ : ∀ x, a * x = 0 ↔ x = 0, { intro x, simp [ha] }, + have h₄ : ∀ x : K, x^3 - s^3 = (x - s) * (x - s * ω) * (x - s * ω^2), + { intro x, + calc x^3 - s^3 + = (x - s) * (x^2 + x*s + s^2) : by ring + ... = (x - s) * (x^2 - (ω+ω^2)*x*s + (1+ω+ω^2)*x*s + s^2) : by ring + ... = (x - s) * (x^2 - (ω+ω^2)*x*s + ω^3*s^2) + : by { rw [hω.pow_eq_one, cube_root_of_unity_sum hω], simp, } + ... = (x - s) * (x - s * ω) * (x - s * ω^2) : by ring }, + rw [h₁, h₂, h₃, h₄ (x + b/(3*a))], + ring_nf, +end + +end field + +end theorems_100 diff --git a/archive/wiedijk_100_theorems/sum_of_prime_reciprocals_diverges.lean b/archive/wiedijk_100_theorems/sum_of_prime_reciprocals_diverges.lean new file mode 100644 index 0000000000000..f52c458f2a87a --- /dev/null +++ b/archive/wiedijk_100_theorems/sum_of_prime_reciprocals_diverges.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2021 Manuel Candales. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Manuel Candales +-/ +import topology.instances.ennreal +import data.nat.squarefree + +/-! +# Divergence of the Prime Reciprocal Series + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Theorem 81 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/). +The theorem states that the sum of the reciprocals of all prime numbers diverges. +The formalization follows Erdős's proof by upper and lower estimates. + +## Proof outline + +1. Assume that the sum of the reciprocals of the primes converges. +2. Then there exists a `k : ℕ` such that, for any `x : ℕ`, the sum of the reciprocals of the primes + between `k` and `x + 1` is less than 1/2 (`sum_lt_half_of_not_tendsto`). +3. For any `x : ℕ`, we can partition `range x` into two subsets (`range_sdiff_eq_bUnion`): + * `M x k`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller + than or equal to `k`; + * `U x k`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`. +4. Then `|U x k|` is bounded by the sum over the primes `p > k` of the number of multiples of `p` + in `(k, x]`, which is at most `x / p`. It follows that `|U x k|` is at most `x` times the sum of + the reciprocals of the primes between `k` and `x + 1`, which is less than 1/2 as noted in (2), so + `|U x k| < x / 2` (`card_le_mul_sum`). +5. By factoring `e + 1 = (m + 1)² * (r + 1)`, `r + 1` squarefree and `m + 1 ≤ √x`, and noting that + squarefree numbers correspond to subsets of `[1, k]`, we find that `|M x k| ≤ 2 ^ k * √x` + (`card_le_two_pow_mul_sqrt`). +6. Finally, setting `x := (2 ^ (k + 1))²` (`√x = 2 ^ (k + 1)`), we find that + `|M x k| ≤ 2 ^ k * 2 ^ (k + 1) = x / 2`. Combined with the strict bound for `|U k x|` from (4), + `x = |M x k| + |U x k| < x / 2 + x / 2 = x`. + +## References + +https://en.wikipedia.org/wiki/Divergence_of_the_sum_of_the_reciprocals_of_the_primes +-/ + +open_locale big_operators +open_locale classical +open filter finset + +namespace theorems_100 + +/-- +The primes in `(k, x]`. +-/ +noncomputable def P (x k : ℕ) := {p ∈ range (x + 1) | k < p ∧ nat.prime p} + +/-- +The union over those primes `p ∈ (k, x]` of the sets of `e < x` for which `e + 1` is a multiple +of `p`, i.e., those `e < x` for which there is a prime `p ∈ (k, x]` that divides `e + 1`. +-/ +noncomputable def U (x k : ℕ) := finset.bUnion (P x k) (λ p, {e ∈ range x | p ∣ e + 1}) + +/-- +Those `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to `k`. +-/ +noncomputable def M (x k : ℕ) := {e ∈ range x | ∀ p : ℕ, (nat.prime p ∧ p ∣ e + 1) → p ≤ k} + +/-- +If the sum of the reciprocals of the primes converges, there exists a `k : ℕ` such that the sum of +the reciprocals of the primes greater than `k` is less than 1/2. + +More precisely, for any `x : ℕ`, the sum of the reciprocals of the primes between `k` and `x + 1` +is less than 1/2. +-/ +lemma sum_lt_half_of_not_tendsto + (h : ¬ tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top) : + ∃ k, ∀ x, ∑ p in P x k, 1 / (p : ℝ) < 1 / 2 := +begin + have h0 : (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) + = λ n, ∑ p in range n, ite (nat.prime p) (1 / (p : ℝ)) 0, + { simp only [sum_filter, filter_congr_decidable, sep_def] }, + + have hf : ∀ n : ℕ, 0 ≤ ite (nat.prime n) (1 / (n : ℝ)) 0, + { intro n, split_ifs, + { simp only [one_div, inv_nonneg, nat.cast_nonneg] }, + { exact le_rfl } }, + + rw [h0, ← summable_iff_not_tendsto_nat_at_top_of_nonneg hf, summable_iff_vanishing] at h, + obtain ⟨s, h⟩ := h (set.Ioo (-1) (1/2)) (is_open_Ioo.mem_nhds (by norm_num)), + obtain ⟨k, hk⟩ := exists_nat_subset_range s, + use k, + intro x, + + rw [P, sep_def, filter_congr_decidable, ←filter_filter, sum_filter], + refine (h _ _).2, + rw disjoint_iff_ne, + simp_intros a ha b hb only [mem_filter], + exact ((mem_range.mp (hk hb)).trans ha.2).ne', +end + +/-- +Removing from {0, ..., x - 1} those elements `e` for which `e + 1` is a product of powers of primes +smaller than or equal to `k` leaves those `e` for which there is a prime `p > k` that divides +`e + 1`, or the union over those primes `p > k` of the sets of `e`s for which `e + 1` is a multiple +of `p`. +-/ +lemma range_sdiff_eq_bUnion {x k : ℕ} : range x \ M x k = U x k := +begin + ext e, + simp only [mem_bUnion, not_and, mem_sdiff, sep_def, mem_filter, mem_range, U, M, P], + push_neg, + split, + { rintros ⟨hex, hexh⟩, + obtain ⟨p, ⟨hpp, hpe1⟩, hpk⟩ := hexh hex, + refine ⟨p, _, ⟨hex, hpe1⟩⟩, + exact ⟨(nat.le_of_dvd e.succ_pos hpe1).trans_lt (nat.succ_lt_succ hex), hpk, hpp⟩ }, + { rintros ⟨p, hpfilter, ⟨hex, hpe1⟩⟩, + rw imp_iff_right hex, + exact ⟨hex, ⟨p, ⟨hpfilter.2.2, hpe1⟩, hpfilter.2.1⟩⟩ }, +end + +/-- +The number of `e < x` for which `e + 1` has a prime factor `p > k` is bounded by `x` times the sum +of reciprocals of primes in `(k, x]`. +-/ +lemma card_le_mul_sum {x k : ℕ} : (card (U x k) : ℝ) ≤ x * ∑ p in P x k, 1 / p := +begin + let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p}, + let N := λ p, {e ∈ range x | p ∣ e + 1}, + have h : card (finset.bUnion P N) ≤ ∑ p in P, card (N p) := card_bUnion_le, + + calc (card (finset.bUnion P N) : ℝ) + ≤ ∑ p in P, card (N p) : by assumption_mod_cast + ... ≤ ∑ p in P, x * (1 / p) : sum_le_sum (λ p hp, _) + ... = x * ∑ p in P, 1 / p : mul_sum.symm, + simp only [mul_one_div, N, sep_def, filter_congr_decidable, nat.card_multiples, nat.cast_div_le], +end + +/-- +The number of `e < x` for which `e + 1` is a squarefree product of primes smaller than or equal to +`k` is bounded by `2 ^ k`, the number of subsets of `[1, k]`. +-/ +lemma card_le_two_pow {x k : ℕ} : card {e ∈ M x k | squarefree (e + 1)} ≤ 2 ^ k := +begin + let M₁ := {e ∈ M x k | squarefree (e + 1)}, + let f := λ s, finset.prod s (λ a, a) - 1, + let K := powerset (image nat.succ (range k)), + + -- Take `e` in `M x k`. If `e + 1` is squarefree, then it is the product of a subset of `[1, k]`. + -- It follows that `e` is one less than such a product. + have h : M₁ ⊆ image f K, + { intros m hm, + simp only [M₁, M, sep_def, mem_filter, mem_range, mem_powerset, mem_image, exists_prop] at hm ⊢, + obtain ⟨⟨-, hmp⟩, hms⟩ := hm, + use (m + 1).factors, + { rwa [multiset.coe_nodup, ← nat.squarefree_iff_nodup_factors m.succ_ne_zero] }, + refine ⟨λ p, _, _⟩, + { suffices : p ∈ (m + 1).factors → ∃ a : ℕ, a < k ∧ a.succ = p, { simpa }, + simp_intros hp only [nat.mem_factors m.succ_ne_zero], + exact ⟨p.pred, (nat.pred_lt (nat.prime.ne_zero hp.1)).trans_le ((hmp p) hp), + nat.succ_pred_eq_of_pos (nat.prime.pos hp.1)⟩ }, + { simp_rw f, simp [nat.prod_factors m.succ_ne_zero, m.succ_sub_one] } }, + + -- The number of elements of `M x k` with `e + 1` squarefree is bounded by the number of subsets + -- of `[1, k]`. + calc card M₁ ≤ card (image f K) : card_le_of_subset h + ... ≤ card K : card_image_le + ... ≤ 2 ^ card (image nat.succ (range k)) : by simp only [K, card_powerset] + ... ≤ 2 ^ card (range k) : pow_le_pow one_le_two card_image_le + ... = 2 ^ k : by rw card_range k, +end + +/-- +The number of `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to +`k` is bounded by `2 ^ k * nat.sqrt x`. +-/ +lemma card_le_two_pow_mul_sqrt {x k : ℕ} : card (M x k) ≤ 2 ^ k * nat.sqrt x := +begin + let M₁ := {e ∈ M x k | squarefree (e + 1)}, + let M₂ := M (nat.sqrt x) k, + let K := M₁ ×ˢ M₂, + let f : ℕ × ℕ → ℕ := λ mn, (mn.2 + 1) ^ 2 * (mn.1 + 1) - 1, + + -- Every element of `M x k` is one less than the product `(m + 1)² * (r + 1)` with `r + 1` + -- squarefree and `m + 1 ≤ √x`, and both `m + 1` and `r + 1` still only have prime powers + -- smaller than or equal to `k`. + have h1 : M x k ⊆ image f K, + { intros m hm, + simp only [M, M₁, M₂, mem_image, exists_prop, prod.exists, mem_product, sep_def, mem_filter, + mem_range] at hm ⊢, + have hm' := m.zero_lt_succ, + obtain ⟨a, b, hab₁, hab₂⟩ := nat.sq_mul_squarefree_of_pos' hm', + obtain ⟨ham, hbm⟩ := ⟨dvd.intro_left _ hab₁, dvd.intro _ hab₁⟩, + refine ⟨a, b, ⟨⟨⟨_, λ p hp, _⟩, hab₂⟩, ⟨_, λ p hp, _⟩⟩, by simp_rw [f, hab₁, m.succ_sub_one]⟩, + { exact (nat.succ_le_succ_iff.mp (nat.le_of_dvd hm' ham)).trans_lt hm.1 }, + { exact hm.2 p ⟨hp.1, hp.2.trans ham⟩ }, + { calc b < b + 1 : lt_add_one b + ... ≤ (m + 1).sqrt : by simpa only [nat.le_sqrt, pow_two] using nat.le_of_dvd hm' hbm + ... ≤ x.sqrt : nat.sqrt_le_sqrt (nat.succ_le_iff.mpr hm.1) }, + { exact hm.2 p ⟨hp.1, hp.2.trans (nat.dvd_of_pow_dvd one_le_two hbm)⟩ } }, + + have h2 : card M₂ ≤ nat.sqrt x, + { rw ← card_range (nat.sqrt x), apply card_le_of_subset, simp [M₂, M] }, + + calc card (M x k) ≤ card (image f K) : card_le_of_subset h1 + ... ≤ card K : card_image_le + ... = card M₁ * card M₂ : card_product M₁ M₂ + ... ≤ 2 ^ k * x.sqrt : mul_le_mul' card_le_two_pow h2, +end + +theorem real.tendsto_sum_one_div_prime_at_top : + tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top := +begin + -- Assume that the sum of the reciprocals of the primes converges. + by_contradiction h, + + -- Then there is a natural number `k` such that for all `x`, the sum of the reciprocals of primes + -- between `k` and `x` is less than 1/2. + obtain ⟨k, h1⟩ := sum_lt_half_of_not_tendsto h, + + -- Choose `x` sufficiently large for the argument below to work, and use a perfect square so we + -- can easily take the square root. + let x := 2 ^ (k + 1) * 2 ^ (k + 1), + + -- We will partition `range x` into two subsets: + -- * `M`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller + -- than or equal to `k`; + set M := M x k with hM, + + -- * `U`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`. + let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p}, + set U := U x k with hU, + + -- This is indeed a partition, so `|U| + |M| = |range x| = x`. + have h2 : x = card U + card M, + { rw [← card_range x, hU, hM, ← range_sdiff_eq_bUnion], + exact (card_sdiff_add_card_eq_card (finset.filter_subset _ _)).symm }, + + -- But for the `x` we have chosen above, both `|U|` and `|M|` are less than or equal to `x / 2`, + -- and for U, the inequality is strict. + have h3 := + calc (card U : ℝ) ≤ x * ∑ p in P, 1 / p : card_le_mul_sum + ... < x * (1 / 2) : mul_lt_mul_of_pos_left (h1 x) (by norm_num) + ... = x / 2 : mul_one_div x 2, + + have h4 := + calc (card M : ℝ) ≤ 2 ^ k * x.sqrt : by exact_mod_cast card_le_two_pow_mul_sqrt + ... = 2 ^ k * ↑(2 ^ (k + 1)) : by rw nat.sqrt_eq + ... = x / 2 : by field_simp [x, mul_right_comm, ← pow_succ'], + + refine lt_irrefl (x : ℝ) _, + calc (x : ℝ) = (card U : ℝ) + (card M : ℝ) : by assumption_mod_cast + ... < x / 2 + x / 2 : add_lt_add_of_lt_of_le h3 h4 + ... = x : add_halves ↑x, +end + +end theorems_100 diff --git a/bors.toml b/bors.toml index 35731eca652b4..2291ce6fe6256 100644 --- a/bors.toml +++ b/bors.toml @@ -6,4 +6,5 @@ use_squash_merge = true timeout_sec = 28800 block_labels = ["not-ready-to-merge", "WIP", "blocked-by-other-PR", "merge-conflict", "awaiting-CI"] delete_merged_branches = true +update_base_for_deletes = true cut_body_after = "---" diff --git a/counterexamples/canonically_ordered_comm_semiring_two_mul.lean b/counterexamples/canonically_ordered_comm_semiring_two_mul.lean index 7474e07b53681..624471d03aeb5 100644 --- a/counterexamples/canonically_ordered_comm_semiring_two_mul.lean +++ b/counterexamples/canonically_ordered_comm_semiring_two_mul.lean @@ -5,7 +5,7 @@ Authors: Damiano Testa -/ import data.zmod.basic import ring_theory.subsemiring.basic -import algebra.order.monoid +import algebra.order.monoid.basic /-! A `canonically_ordered_comm_semiring` with two different elements `a` and `b` such that @@ -21,8 +21,13 @@ multiplication cannot be strengthened to **strict** monotonicity. Reference: https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/canonically_ordered.20pathology + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ +namespace counterexample + namespace from_Bhavik /-- Bhavik Mehta's example. There are only the initial definitions, but no proofs. The Type @@ -50,7 +55,7 @@ end from_Bhavik lemma mem_zmod_2 (a : zmod 2) : a = 0 ∨ a = 1 := begin - rcases a with ⟨_ | _ | _ | _ | a_val, _ | ⟨_, _ | ⟨_, ⟨⟩⟩⟩⟩, + rcases a with ⟨_|_, _|_|_|_⟩, { exact or.inl rfl }, { exact or.inr rfl }, end @@ -124,7 +129,7 @@ begin { exact or.inr (by simpa using bc) } end -lemma zero_le_one : (0 : ℕ × zmod 2) ≤ 1 := dec_trivial +instance : zero_le_one_class (ℕ × zmod 2) := ⟨dec_trivial⟩ lemma mul_lt_mul_of_pos_left : ∀ (a b c : ℕ × zmod 2), a < b → 0 < c → c * a < c * b := λ a b c ab c0, lt_def.mpr ((mul_lt_mul_left (lt_def.mp c0)).mpr (lt_def.mp ab)) @@ -132,7 +137,7 @@ lemma mul_lt_mul_of_pos_left : ∀ (a b c : ℕ × zmod 2), a < b → 0 < c → lemma mul_lt_mul_of_pos_right : ∀ (a b c : ℕ × zmod 2), a < b → 0 < c → a * c < b * c := λ a b c ab c0, lt_def.mpr ((mul_lt_mul_right (lt_def.mp c0)).mpr (lt_def.mp ab)) -instance ocsN2 : ordered_comm_semiring (ℕ × zmod 2) := +instance socsN2 : strict_ordered_comm_semiring (ℕ × zmod 2) := { add_le_add_left := add_le_add_left, le_of_add_le_add_left := le_of_add_le_add_left, zero_le_one := zero_le_one, @@ -140,7 +145,8 @@ instance ocsN2 : ordered_comm_semiring (ℕ × zmod 2) := mul_lt_mul_of_pos_right := mul_lt_mul_of_pos_right, ..Nxzmod_2.csrN2_1, ..(infer_instance : partial_order (ℕ × zmod 2)), - ..(infer_instance : comm_semiring (ℕ × zmod 2)) } + ..(infer_instance : comm_semiring (ℕ × zmod 2)), + ..pullback_nonzero prod.fst prod.fst_zero prod.fst_one } end Nxzmod_2 @@ -209,37 +215,24 @@ begin exact nat.succ_pos _ } end -instance order_bot : order_bot L := -{ bot := 0, - bot_le := bot_le, - ..(infer_instance : partial_order L) } +instance order_bot : order_bot L := ⟨0, bot_le⟩ -lemma le_iff_exists_add : ∀ (a b : L), a ≤ b ↔ ∃ (c : L), b = a + c := +lemma exists_add_of_le : ∀ a b : L, a ≤ b → ∃ c, b = a + c := begin - rintros ⟨⟨an, a2⟩, ha⟩ ⟨⟨bn, b2⟩, hb⟩, - rw subtype.mk_le_mk, - refine ⟨λ h, _, λ h, _⟩, - { rcases h with ⟨rfl, rfl⟩ | h, - { exact ⟨(0 : L), (add_zero _).symm⟩ }, - { refine ⟨⟨⟨bn - an, b2 + a2⟩, _⟩, _⟩, - { rw [ne.def, prod.mk.inj_iff, not_and_distrib], - exact or.inl (ne_of_gt (tsub_pos_of_lt h)) }, - { congr, - { exact (add_tsub_cancel_of_le h.le).symm }, - { change b2 = a2 + (b2 + a2), - rw [add_comm b2, ← add_assoc, add_self_zmod_2, zero_add] } } } }, - { rcases h with ⟨⟨⟨c, c2⟩, hc⟩, abc⟩, - injection abc with abc, - rw [prod.mk_add_mk, prod.mk.inj_iff] at abc, - rcases abc with ⟨rfl, rfl⟩, - cases c, - { refine or.inl _, - rw [ne.def, prod.mk.inj_iff, eq_self_iff_true, true_and] at hc, - rcases mem_zmod_2 c2 with rfl | rfl, - { rw [add_zero, add_zero] }, - { exact (hc rfl).elim } }, - { refine or.inr _, - exact (lt_add_iff_pos_right _).mpr c.succ_pos } } + rintro a ⟨b, _⟩ (⟨rfl, rfl⟩ | h), + { exact ⟨0, (add_zero _).symm⟩ }, + { exact ⟨⟨b - a.1, λ H, (tsub_pos_of_lt h).ne' (prod.mk.inj_iff.1 H).1⟩, + subtype.ext $ prod.ext (add_tsub_cancel_of_le h.le).symm (add_sub_cancel'_right _ _).symm⟩ } +end + +lemma le_self_add : ∀ a b : L, a ≤ a + b := +begin + rintro a ⟨⟨bn, b2⟩, hb⟩, + obtain rfl | h := nat.eq_zero_or_pos bn, + { obtain rfl | rfl := mem_zmod_2 b2, + { exact or.inl (prod.ext (add_zero _).symm (add_zero _).symm) }, + { exact (hb rfl).elim } }, + { exact or.inr ((lt_add_iff_pos_right _).mpr h) } end lemma eq_zero_or_eq_zero_of_mul_eq_zero : ∀ (a b : L), a * b = 0 → a = 0 ∨ b = 0 := @@ -260,7 +253,8 @@ begin end instance can : canonically_ordered_comm_semiring L := -{ le_iff_exists_add := le_iff_exists_add, +{ exists_add_of_le := exists_add_of_le, + le_self_add := le_self_add, eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero, ..(infer_instance : order_bot L), ..(infer_instance : ordered_comm_semiring L) } @@ -276,3 +270,5 @@ begin end end ex_L + +end counterexample diff --git a/counterexamples/char_p_zero_ne_char_zero.lean b/counterexamples/char_p_zero_ne_char_zero.lean index cc29182b28553..a567d155f59ec 100644 --- a/counterexamples/char_p_zero_ne_char_zero.lean +++ b/counterexamples/char_p_zero_ne_char_zero.lean @@ -7,6 +7,9 @@ import algebra.char_p.basic /-! # `char_p R 0` and `char_zero R` need not coincide for semirings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For rings, the two notions coincide. In fact, `char_p.of_char_zero` shows that `char_zero R` implies `char_p R 0` for any `char_zero` @@ -16,16 +19,17 @@ The reverse implication holds for any `add_left_cancel_monoid R` with `1`, by `c This file shows that there are semiring `R` for which `char_p R 0` holds and `char_zero R` does not. The example is `{0, 1}` with saturating addition. ---/ +-/ -local attribute [semireducible] with_zero +namespace counterexample -@[simp] lemma add_one_eq_one : ∀ (x : with_zero unit), x + 1 = 1 -| 0 := rfl -| 1 := rfl +@[simp] lemma add_one_eq_one (x : with_zero unit) : x + 1 = 1 := +with_zero.cases_on x (by refl) (λ h, by refl) lemma with_zero_unit_char_p_zero : char_p (with_zero unit) 0 := ⟨λ x, by cases x; simp⟩ lemma with_zero_unit_not_char_zero : ¬ char_zero (with_zero unit) := λ ⟨h⟩, h.ne (by simp : 1 + 1 ≠ 0 + 1) (by simp) + +end counterexample diff --git a/counterexamples/cyclotomic_105.lean b/counterexamples/cyclotomic_105.lean index 60c3b5b7e56e8..9499e39f118ac 100644 --- a/counterexamples/cyclotomic_105.lean +++ b/counterexamples/cyclotomic_105.lean @@ -9,18 +9,22 @@ import ring_theory.polynomial.cyclotomic.basic /-! # Not all coefficients of cyclotomic polynomials are -1, 0, or 1 +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that not all coefficients of cyclotomic polynomials are equal to `0`, `-1` or `1`, in the theorem `not_forall_coeff_cyclotomic_neg_one_zero_one`. We prove this with the counterexample `coeff_cyclotomic_105 : coeff (cyclotomic 105 ℤ) 7 = -2`. -/ -section computation +open nat (proper_divisors) finset -lemma prime_3 : nat.prime 3 := by norm_num +namespace counterexample -lemma prime_5 : nat.prime 5 := by norm_num +section computation -lemma prime_7 : nat.prime 7 := by norm_num +instance nat.fact_prime_five : fact (nat.prime 5) := ⟨by norm_num⟩ +instance nat.fact_prime_seven : fact (nat.prime 7) := ⟨by norm_num⟩ lemma proper_divisors_15 : nat.proper_divisors 15 = {1, 3, 5} := rfl @@ -35,32 +39,17 @@ end computation open polynomial lemma cyclotomic_3 : cyclotomic 3 ℤ = 1 + X + X ^ 2 := -begin - refine ((eq_cyclotomic_iff (show 0 < 3, by norm_num) _).2 _).symm, - rw nat.prime.proper_divisors prime_3, - simp only [finset.prod_singleton, cyclotomic_one], - ring -end +by simp only [cyclotomic_prime, sum_range_succ, range_one, sum_singleton, pow_zero, pow_one] lemma cyclotomic_5 : cyclotomic 5 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 := -begin - refine ((eq_cyclotomic_iff (nat.prime.pos prime_5) _).2 _).symm, - rw nat.prime.proper_divisors prime_5, - simp only [finset.prod_singleton, cyclotomic_one], - ring -end +by simp only [cyclotomic_prime, sum_range_succ, range_one, sum_singleton, pow_zero, pow_one] lemma cyclotomic_7 : cyclotomic 7 ℤ = 1 + X + X ^ 2 + X ^ 3 + X ^ 4 + X ^ 5 + X ^ 6 := -begin - refine ((eq_cyclotomic_iff (nat.prime.pos prime_7) _).2 _).symm, - rw nat.prime.proper_divisors prime_7, - simp only [finset.prod_singleton, cyclotomic_one], - ring -end +by simp only [cyclotomic_prime, sum_range_succ, range_one, sum_singleton, pow_zero, pow_one] lemma cyclotomic_15 : cyclotomic 15 ℤ = 1 - X + X ^ 3 - X ^ 4 + X ^ 5 - X ^ 7 + X ^ 8 := begin - refine ((eq_cyclotomic_iff (show 0 < 15, by norm_num) _).2 _).symm, + refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm, rw [proper_divisors_15, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton, cyclotomic_one, cyclotomic_3, cyclotomic_5], ring, @@ -70,7 +59,7 @@ end lemma cyclotomic_21 : cyclotomic 21 ℤ = 1 - X + X ^ 3 - X ^ 4 + X ^ 6 - X ^ 8 + X ^ 9 - X ^ 11 + X ^ 12 := begin - refine ((eq_cyclotomic_iff (show 0 < 21, by norm_num) _).2 _).symm, + refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm, rw [proper_divisors_21, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton, cyclotomic_one, cyclotomic_3, cyclotomic_7], ring, @@ -81,7 +70,7 @@ lemma cyclotomic_35 : cyclotomic 35 ℤ = 1 - X + X ^ 5 - X ^ 6 + X ^ 7 - X ^ 8 + X ^ 10 - X ^ 11 + X ^ 12 - X ^ 13 + X ^ 14 - X ^ 16 + X ^ 17 - X ^ 18 + X ^ 19 - X ^ 23 + X ^ 24 := begin - refine ((eq_cyclotomic_iff (show 0 < 35, by norm_num) _).2 _).symm, + refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm, rw [proper_divisors_35, finset.prod_insert _, finset.prod_insert _, finset.prod_singleton, cyclotomic_one, cyclotomic_5, cyclotomic_7], ring, @@ -94,7 +83,7 @@ lemma cyclotomic_105 : cyclotomic 105 ℤ = X ^ 34 + X ^ 35 + X ^ 36 - X ^ 39 - X ^ 40 - 2 * X ^ 41 - X ^ 42 - X ^ 43 + X ^ 46 + X ^ 47 + X ^ 48 := begin - refine ((eq_cyclotomic_iff (show 0 < 105, by norm_num) _).2 _).symm, + refine ((eq_cyclotomic_iff (by norm_num) _).2 _).symm, rw proper_divisors_105, repeat {rw finset.prod_insert _}, rw [finset.prod_singleton, cyclotomic_one, cyclotomic_3, cyclotomic_5, cyclotomic_7, @@ -112,7 +101,9 @@ lemma not_forall_coeff_cyclotomic_neg_one_zero_one : ¬∀ n i, coeff (cyclotomic n ℤ) i ∈ ({-1, 0, 1} : set ℤ) := begin intro h, - replace h := h 105 7, + specialize h 105 7, rw coeff_cyclotomic_105 at h, norm_num at h end + +end counterexample diff --git a/counterexamples/direct_sum_is_internal.lean b/counterexamples/direct_sum_is_internal.lean index ce95221bf503c..08d293d5e7eb4 100644 --- a/counterexamples/direct_sum_is_internal.lean +++ b/counterexamples/direct_sum_is_internal.lean @@ -5,19 +5,25 @@ Authors: Eric Wieser, Kevin Buzzard -/ import algebra.direct_sum.module +import algebra.group.conj_finite import tactic.fin_cases /-! # Not all complementary decompositions of a module over a semiring make up a direct sum +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This shows that while `ℤ≤0` and `ℤ≥0` are complementary `ℕ`-submodules of `ℤ`, which in turn implies as a collection they are `complete_lattice.independent` and that they span all of `ℤ`, they do not form a decomposition into a direct sum. -This file demonstrates why `direct_sum.submodule_is_internal_of_independent_of_supr_eq_top` must +This file demonstrates why `direct_sum.is_internal_submodule_of_independent_of_supr_eq_top` must take `ring R` and not `semiring R`. -/ +namespace counterexample + lemma units_int.one_ne_neg_one : (1 : ℤˣ) ≠ -1 := dec_trivial /-- Submodules of positive and negative integers, keyed by sign. -/ @@ -46,7 +52,8 @@ begin { apply submodule.disjoint_def.2, intros x hx hx', exact le_antisymm (mem_with_sign_neg_one.mp hx') (mem_with_sign_one.mp hx), }, - { intros x hx, + { rw codisjoint_iff_le_sup, + intros x hx, obtain hp | hn := (le_refl (0 : ℤ)).le_or_le x, exact submodule.mem_sup_left (mem_with_sign_one.mpr hp), exact submodule.mem_sup_right (mem_with_sign_neg_one.mpr hn), } @@ -89,5 +96,7 @@ begin end /-- And so they do not represent an internal direct sum. -/ -lemma with_sign.not_internal : ¬direct_sum.submodule_is_internal with_sign := +lemma with_sign.not_internal : ¬direct_sum.is_internal with_sign := with_sign.not_injective ∘ and.elim_left + +end counterexample diff --git a/counterexamples/girard.lean b/counterexamples/girard.lean index 218c892caa71e..de764493e7027 100644 --- a/counterexamples/girard.lean +++ b/counterexamples/girard.lean @@ -8,6 +8,9 @@ import logic.basic /-! # Girard's paradox +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Girard's paradox is a proof that `Type : Type` entails a contradiction. We can't say this directly in Lean because `Type : Type 1` and it's not possible to give `Type` a different type via an axiom, so instead we axiomatize the behavior of the Pi type and application if the typing rule for Pi was @@ -24,6 +27,8 @@ Based on Watkins' LF implementation of Hurkens' simplification of Girard's parad * `girard`: there are no Girard universes. -/ +namespace counterexample + /-- **Girard's paradox**: there are no universes `u` such that `Type u : Type u`. Since we can't actually change the type of Lean's `Π` operator, we assume the existence of `pi`, `lam`, `app` and the `beta` rule equivalent to the `Π` and `app` constructors of type theory. @@ -43,3 +48,5 @@ let ω : set (set U) := {p | ∀ x, p ∈ σ x → x ∈ p} in let δ (S : set (set U)) := ∀ p, p ∈ S → τ S ∈ p in have δ ω := λ p d, d (τ ω) $ στ.2 $ λ x h, d (τ (σ x)) (στ.2 h), this {y | ¬ δ (σ y)} (λ x e f, f _ e (λ p h, f _ (στ.1 h))) (λ p h, this _ (στ.1 h)) + +end counterexample diff --git a/counterexamples/homogeneous_prime_not_prime.lean b/counterexamples/homogeneous_prime_not_prime.lean index 0374a5f9d06c0..41e0b98c88cdc 100644 --- a/counterexamples/homogeneous_prime_not_prime.lean +++ b/counterexamples/homogeneous_prime_not_prime.lean @@ -10,6 +10,9 @@ import tactic.derive_fintype /-! # A homogeneous prime that is homogeneously prime but not prime +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In `src/ring_theory/graded_algebra/radical.lean`, we assumed that the underline grading is indexed by a `linear_ordered_cancel_add_comm_monoid` to prove that a homogeneous ideal is prime if and only if it is homogeneously prime. This file is aimed to show that even if this assumption isn't strictly @@ -30,6 +33,8 @@ prime. But it is homogeneously prime, i.e. if `(a, b), (c, d)` are two homogeneo homogeneous, prime -/ +namespace counterexample + namespace counterexample_not_prime_but_homogeneous_prime open direct_sum @@ -74,7 +79,7 @@ lemma grading.mul_mem : ∀ ⦃i j : two⦄ {a b : (R × R)} (ha : a ∈ grading end -notation `R` := zmod 4 +local notation `R` := zmod 4 /-- `R² ≅ {(a, a) | a ∈ R} ⨁ {(0, b) | b ∈ R}` by `(x, y) ↦ (x, x) + (0, y - x)`. -/ def grading.decompose : (R × R) →+ direct_sum two (λ i, grading R i) := @@ -83,15 +88,14 @@ def grading.decompose : (R × R) →+ direct_sum two (λ i, grading R i) := map_zero' := by { ext1 (_|⟨⟨⟩⟩); refl }, map_add' := begin rintros ⟨a1, b1⟩ ⟨a2, b2⟩, - have H : b1 + b2 - (a1 + a2) = b1 - a1 + (b2 - a2), by abel, - ext (_|⟨⟨⟩⟩) : 3; - simp only [prod.fst_add, prod.snd_add, add_apply, submodule.coe_add, prod.mk_add_mk, H]; - repeat { erw of_eq_same }; repeat { erw of_eq_of_ne }; try { apply option.no_confusion }; - dsimp; simp only [zero_add, add_zero]; refl, + rw [add_add_add_comm, ←map_add, ←map_add], + dsimp only [prod.mk_add_mk], + simp_rw [add_sub_add_comm], + congr, end } -lemma grading.left_inv : - function.left_inverse grading.decompose (submodule_coe (grading R)) := λ zz, +lemma grading.right_inv : + function.right_inverse (coe_linear_map (grading R)) grading.decompose := λ zz, begin induction zz using direct_sum.induction_on with i zz d1 d2 ih1 ih2, { simp only [map_zero],}, @@ -100,12 +104,12 @@ begin { simp only [map_add, ih1, ih2], }, end -lemma grading.right_inv : - function.right_inverse grading.decompose (submodule_coe (grading R)) := λ zz, +lemma grading.left_inv : + function.left_inverse (coe_linear_map (grading R)) grading.decompose := λ zz, begin cases zz with a b, unfold grading.decompose, - simp only [add_monoid_hom.coe_mk, map_add, submodule_coe_of, subtype.coe_mk, prod.mk_add_mk, + simp only [add_monoid_hom.coe_mk, map_add, coe_linear_map_of, subtype.coe_mk, prod.mk_add_mk, add_zero, add_sub_cancel'_right], end @@ -119,14 +123,18 @@ instance : graded_algebra (grading R) := /-- The counterexample is the ideal `I = span {(2, 2)}`. -/ def I : ideal (R × R) := ideal.span {((2, 2) : (R × R))}. +set_option class.instance_max_depth 34 + lemma I_not_prime : ¬ I.is_prime := begin rintro ⟨rid1, rid2⟩, apply rid1, clear rid1, revert rid2, simp only [I, ideal.mem_span_singleton, ideal.eq_top_iff_one], - dec_trivial, + dec_trivial, -- this is what we change the max instance depth for, it's only 2 above the default end +set_option class.instance_max_depth 32 + lemma I_is_homogeneous : I.is_homogeneous (grading R) := begin rw ideal.is_homogeneous.iff_exists, @@ -149,3 +157,5 @@ begin end end counterexample_not_prime_but_homogeneous_prime + +end counterexample diff --git a/counterexamples/leanpkg.toml b/counterexamples/leanpkg.toml new file mode 100644 index 0000000000000..814d73c4e45c1 --- /dev/null +++ b/counterexamples/leanpkg.toml @@ -0,0 +1,7 @@ +[package] +name = "mathlib-counterexamples" +version = "0.1" +path = "." + +[dependencies] +mathlib = {path = ".."} diff --git a/counterexamples/linear_order_with_pos_mul_pos_eq_zero.lean b/counterexamples/linear_order_with_pos_mul_pos_eq_zero.lean index ae5f6b37a1bf2..b83f9dca5525b 100644 --- a/counterexamples/linear_order_with_pos_mul_pos_eq_zero.lean +++ b/counterexamples/linear_order_with_pos_mul_pos_eq_zero.lean @@ -4,7 +4,8 @@ All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin, Damiano Testa, Kevin Buzzard -/ -import algebra.order.monoid +import algebra.order.monoid.defs +import algebra.order.monoid.with_zero.defs /-! An example of a `linear_ordered_comm_monoid_with_zero` in which the product of two positive @@ -15,8 +16,13 @@ The order is `0 < ε < 1`. Since `ε ^ 2 = 0`, the product of strictly positive Relevant Zulip chat: https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/mul_pos + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ +namespace counterexample + /-- The three element monoid. -/ @[derive [decidable_eq]] inductive foo @@ -31,7 +37,7 @@ instance inhabited : inhabited foo := ⟨zero⟩ instance : has_zero foo := ⟨zero⟩ instance : has_one foo := ⟨one⟩ -notation `ε` := eps +local notation `ε` := eps /-- The order on `foo` is the one induced by the natural order on the image of `aux1`. -/ def aux1 : foo → ℕ @@ -47,7 +53,7 @@ lemma aux1_inj : function.injective aux1 := by boom instance : linear_order foo := -linear_order.lift aux1 $ aux1_inj +linear_order.lift' aux1 aux1_inj /-- Multiplication on `foo`: the only external input is that `ε ^ 2 = 0`. -/ def mul : foo → foo → foo @@ -84,3 +90,5 @@ end example : 0 < ε ∧ ε * ε = 0 := by boom end foo + +end counterexample diff --git a/counterexamples/map_floor.lean b/counterexamples/map_floor.lean new file mode 100644 index 0000000000000..105a24f6e9574 --- /dev/null +++ b/counterexamples/map_floor.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.order.hom.ring +import data.polynomial.reverse + +/-! +# Floors and ceils aren't preserved under ordered ring homomorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Intuitively, if `f : α → β` is an ordered ring homomorphism, then floors and ceils should be +preserved by `f` because: +* `f` preserves the naturals/integers in `α` and `β` because it's a ring hom. +* `f` preserves what's between `n` and `n + 1` because it's monotone. + +However, there is a catch. Potentially something whose floor was `n` could +get mapped to `n + 1`, and this has floor `n + 1`, not `n`. Note that this is at most an off by one +error. + +This pathology disappears if you require `f` to be strictly monotone or `α` to be archimedean. + +## The counterexample + +Consider `ℤ[ε]` (`int_with_epsilons`), the integers with infinitesimals adjoined. This is a linearly +ordered commutative floor ring (`int_with_epsilons.linear_ordered_comm_ring`, +`int_with_epsilons.floor_ring`). + +The map `f : ℤ[ε] → ℤ` that forgets about the epsilons (`int_with_epsilons.forget_epsilons`) is an +ordered ring homomorphism. + +But it does not preserve floors (nor ceils) as `⌊-ε⌋ = -1` while `⌊f (-ε)⌋ = ⌊0⌋ = 0` +(`int_with_epsilons.forget_epsilons_floor_lt`, `int_with_epsilons.lt_forget_epsilons_ceil`). +-/ + +namespace counterexample + +noncomputable theory + +open function int polynomial +open_locale polynomial + +/-- The integers with infinitesimals adjoined. -/ +@[derive [comm_ring, nontrivial, inhabited]] def int_with_epsilon := ℤ[X] + +local notation `ℤ[ε]` := int_with_epsilon + +local notation `ε` := (X : ℤ[ε]) + +namespace int_with_epsilon + +instance : linear_order ℤ[ε] := linear_order.lift' (to_lex ∘ coeff) coeff_injective + +instance : ordered_add_comm_group ℤ[ε] := +by refine (to_lex.injective.comp coeff_injective).ordered_add_comm_group _ _ _ _ _ _ _; + refl <|> intros; ext; simp [←nsmul_eq_mul, ←zsmul_eq_mul] + +lemma pos_iff {p : ℤ[ε]} : 0 < p ↔ 0 < p.trailing_coeff := +begin + rw trailing_coeff, + refine ⟨_, λ h, + ⟨p.nat_trailing_degree, λ m hm, (coeff_eq_zero_of_lt_nat_trailing_degree hm).symm, h⟩⟩, + rintro ⟨n, hn⟩, + convert hn.2, + exact (nat_trailing_degree_le_of_ne_zero hn.2.ne').antisymm + (le_nat_trailing_degree (by { rintro rfl, cases hn.2.false }) $ λ m hm, (hn.1 _ hm).symm), +end + +instance : linear_ordered_comm_ring ℤ[ε] := +{ zero_le_one := or.inr ⟨0, by simp⟩, + mul_pos := λ p q, by { simp_rw [pos_iff, trailing_coeff_mul], exact mul_pos }, + ..int_with_epsilon.linear_order, ..int_with_epsilon.comm_ring, + ..int_with_epsilon.ordered_add_comm_group, ..int_with_epsilon.nontrivial } + +instance : floor_ring ℤ[ε] := +floor_ring.of_floor _ (λ p, if (p.coeff 0 : ℤ[ε]) ≤ p then p.coeff 0 else p.coeff 0 - 1) $ λ p q, + begin + simp_rw [←not_lt, not_iff_not], + split, + { split_ifs, + { rintro ⟨_ | n, hn⟩, + { refine (sub_one_lt _).trans _, + simpa using hn }, + { dsimp at hn, + simp [hn.1 _ n.zero_lt_succ] } }, + { exact λ h', cast_lt.1 ((not_lt.1 h).trans_lt h') } }, + { split_ifs, + { exact λ h', h.trans_le (cast_le.2 $ sub_one_lt_iff.1 h') }, + { exact λ h', ⟨0, by simpa using h'⟩ } } + end + +/-- The ordered ring homomorphisms from `ℤ[ε]` to `ℤ` that "forgets" the `ε`s. -/ +def forget_epsilons : ℤ[ε] →+*o ℤ := +{ to_fun := λ p, coeff p 0, + map_zero' := coeff_zero _, + map_one' := coeff_one_zero, + map_add' := λ _ _, coeff_add _ _ _, + map_mul' := mul_coeff_zero, + monotone' := monotone_iff_forall_lt.2 begin + rintro p q ⟨n, hn⟩, + cases n, + { exact hn.2.le }, + { exact (hn.1 _ n.zero_lt_succ).le } + end } + +@[simp] lemma forget_epsilons_apply (p : ℤ[ε]) : forget_epsilons p = coeff p 0 := rfl + +/-- The floor of `n - ε` is `n - 1` but its image under `forget_epsilons` is `n`, whose floor is +itself. -/ +lemma forget_epsilons_floor_lt (n : ℤ) : + forget_epsilons ⌊(n - ε : ℤ[ε])⌋ < ⌊forget_epsilons (n - ε)⌋ := +begin + suffices : ⌊(n - ε : ℤ[ε])⌋ = n - 1, + { simp [this] }, + have : (0 : ℤ[ε]) < ε := ⟨1, by simp⟩, + exact (if_neg $ by simp [this]).trans (by simp), +end + +/-- The ceil of `n + ε` is `n + 1` but its image under `forget_epsilons` is `n`, whose ceil is +itself. -/ +lemma lt_forget_epsilons_ceil (n : ℤ) : + ⌈forget_epsilons (n + ε)⌉ < forget_epsilons ⌈(n + ε : ℤ[ε])⌉ := +begin + rw [←neg_lt_neg_iff, ←map_neg, ←cast_neg, ←floor_neg, ←floor_neg, ←map_neg, neg_add', ←cast_neg], + exact forget_epsilons_floor_lt _, +end + +end int_with_epsilon + +end counterexample diff --git a/counterexamples/phillips.lean b/counterexamples/phillips.lean index e060882cfc7d0..9ef4b12c2300f 100644 --- a/counterexamples/phillips.lean +++ b/counterexamples/phillips.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ -import analysis.normed_space.hahn_banach -import measure_theory.measure.lebesgue +import analysis.normed_space.hahn_banach.extension +import measure_theory.integral.set_integral +import measure_theory.measure.lebesgue.basic +import topology.continuous_function.bounded /-! # A counterexample on Pettis integrability +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + There are several theories of integration for functions taking values in Banach spaces. Bochner integration, requiring approximation by simple functions, is the analogue of the one-dimensional theory. It is very well behaved, but only works for functions with second-countable range. @@ -70,6 +75,8 @@ on a discrete copy of the original type, as mathlib only contains the space of a continuous functions (which is the useful one). -/ +namespace counterexample + universe u variables {α : Type u} open set bounded_continuous_function measure_theory @@ -212,7 +219,7 @@ def restrict (f : bounded_additive_measure α) (t : set α) : bounded_additive_m /-- There is a maximal countable set of positive measure, in the sense that any countable set not intersecting it has nonpositive measure. Auxiliary lemma to prove `exists_discrete_support`. -/ lemma exists_discrete_support_nonpos (f : bounded_additive_measure α) : - ∃ (s : set α), countable s ∧ (∀ t, countable t → f (t \ s) ≤ 0) := + ∃ (s : set α), s.countable ∧ (∀ t : set α, t.countable → f (t \ s) ≤ 0) := begin /- The idea of the proof is to construct the desired set inductively, adding at each step a countable set with close to maximal measure among those points that have not already been chosen. @@ -223,46 +230,49 @@ begin We argue from the start by contradiction, as this means that our inductive construction will never be stuck, so we won't have to consider this case separately. + + In this proof, we use explicit coercions `↑s` for `s : A` as otherwise the system tries to find + a `has_coe_to_fun` instance on `↥A`, which is too costly. -/ by_contra' h, -- We will formulate things in terms of the type of countable subsets of `α`, as this is more -- convenient to formalize the inductive construction. - let A : set (set α) := {t | countable t}, + let A : set (set α) := {t | t.countable}, let empty : A := ⟨∅, countable_empty⟩, haveI : nonempty A := ⟨empty⟩, -- given a countable set `s`, one can find a set `t` in its complement with measure close to -- maximal. - have : ∀ (s : A), ∃ (t : A), (∀ (u : A), f (u \ s) ≤ 2 * f (t \ s)), + have : ∀ (s : A), ∃ (t : A), (∀ (u : A), f (↑u \ ↑s) ≤ 2 * f (↑t \ ↑s)), { assume s, - have B : bdd_above (range (λ (u : A), f (u \ s))), + have B : bdd_above (range (λ (u : A), f (↑u \ ↑s))), { refine ⟨f.C, λ x hx, _⟩, rcases hx with ⟨u, hu⟩, rw ← hu, exact f.le_bound _ }, - let S := supr (λ (t : A), f (t \ s)), + let S := supr (λ (t : A), f (↑t \ ↑s)), have S_pos : 0 < S, { rcases h s.1 s.2 with ⟨t, t_count, ht⟩, apply ht.trans_le, let t' : A := ⟨t, t_count⟩, - change f (t' \ s) ≤ S, + change f (↑t' \ ↑s) ≤ S, exact le_csupr B t' }, rcases exists_lt_of_lt_csupr (half_lt_self S_pos) with ⟨t, ht⟩, refine ⟨t, λ u, _⟩, - calc f (u \ s) ≤ S : le_csupr B _ + calc f (↑u \ ↑s) ≤ S : le_csupr B _ ... = 2 * (S / 2) : by ring - ... ≤ 2 * f (t \ s) : mul_le_mul_of_nonneg_left ht.le (by norm_num) }, + ... ≤ 2 * f (↑t \ ↑s) : mul_le_mul_of_nonneg_left ht.le (by norm_num) }, choose! F hF using this, -- iterate the above construction, by adding at each step a set with measure close to maximal in -- the complement of already chosen points. This is the set `s n` at step `n`. - let G : A → A := λ u, ⟨u ∪ F u, u.2.union (F u).2⟩, + let G : A → A := λ u, ⟨(↑u : set α) ∪ ↑(F u), u.2.union (F u).2⟩, let s : ℕ → A := λ n, G^[n] empty, -- We will get a contradiction from the fact that there is a countable set `u` with positive -- measure in the complement of `⋃ n, s n`. - rcases h (⋃ n, s n) (countable_Union (λ n, (s n).2)) with ⟨t, t_count, ht⟩, - let u : A := ⟨t \ ⋃ n, s n, t_count.mono (diff_subset _ _)⟩, - set ε := f u with hε, + rcases h (⋃ n, ↑(s n)) (countable_Union (λ n, (s n).2)) with ⟨t, t_count, ht⟩, + let u : A := ⟨t \ ⋃ n, ↑(s n), t_count.mono (diff_subset _ _)⟩, + set ε := f (↑u) with hε, have ε_pos : 0 < ε := ht, - have I1 : ∀ n, ε / 2 ≤ f (s (n+1) \ s n), + have I1 : ∀ n, ε / 2 ≤ f (↑(s (n+1)) \ ↑(s n)), { assume n, rw [div_le_iff' (show (0 : ℝ) < 2, by norm_num), hε], convert hF (s n) u using 3, @@ -271,26 +281,27 @@ begin simp only [not_exists, mem_Union, mem_diff], tauto }, { simp only [s, function.iterate_succ', subtype.coe_mk, union_diff_left] } }, - have I2 : ∀ (n : ℕ), (n : ℝ) * (ε / 2) ≤ f (s n), + have I2 : ∀ (n : ℕ), (n : ℝ) * (ε / 2) ≤ f (↑(s n)), { assume n, induction n with n IH, { simp only [s, bounded_additive_measure.empty, id.def, nat.cast_zero, zero_mul, function.iterate_zero, subtype.coe_mk], }, - { have : (s (n+1) : set α) = (s (n+1) \ s n) ∪ s n, + { have : (↑(s (n+1)) : set α) = (↑(s (n+1)) \ ↑(s n)) ∪ ↑(s n), by simp only [s, function.iterate_succ', union_comm, union_diff_self, subtype.coe_mk, union_diff_left], rw [nat.succ_eq_add_one, this, f.additive], - swap, { rw disjoint.comm, apply disjoint_diff }, - calc ((n + 1) : ℝ) * (ε / 2) = ε / 2 + n * (ε / 2) : by ring - ... ≤ f ((s (n + 1)) \ (s n)) + f (s n) : add_le_add (I1 n) IH } }, + swap, { exact disjoint_sdiff_self_left }, + calc ((n + 1 : ℕ) : ℝ) * (ε / 2) = ε / 2 + n * (ε / 2) : by simp only [nat.cast_succ]; ring + ... ≤ f (↑(s (n + 1 : ℕ)) \ ↑(s n)) + f (↑(s n)) : + add_le_add (I1 n) IH } }, rcases exists_nat_gt (f.C / (ε / 2)) with ⟨n, hn⟩, have : (n : ℝ) ≤ f.C / (ε / 2), by { rw le_div_iff (half_pos ε_pos), exact (I2 n).trans (f.le_bound _) }, - exact lt_irrefl _ (this.trans_lt hn), + exact lt_irrefl _ (this.trans_lt hn) end lemma exists_discrete_support (f : bounded_additive_measure α) : - ∃ (s : set α), countable s ∧ (∀ t, countable t → f (t \ s) = 0) := + ∃ s : set α, s.countable ∧ (∀ t : set α, t.countable → f (t \ s) = 0) := begin rcases f.exists_discrete_support_nonpos with ⟨s₁, s₁_count, h₁⟩, rcases (-f).exists_discrete_support_nonpos with ⟨s₂, s₂_count, h₂⟩, @@ -312,10 +323,10 @@ def discrete_support (f : bounded_additive_measure α) : set α := (exists_discrete_support f).some lemma countable_discrete_support (f : bounded_additive_measure α) : - countable f.discrete_support := + f.discrete_support.countable := (exists_discrete_support f).some_spec.1 -lemma apply_countable (f : bounded_additive_measure α) (t : set α) (ht : countable t) : +lemma apply_countable (f : bounded_additive_measure α) (t : set α) (ht : t.countable) : f (t \ f.discrete_support) = 0 := (exists_discrete_support f).some_spec.2 t ht @@ -335,7 +346,7 @@ begin simp only [discrete_part, continuous_part, restrict_apply], rw [← f.additive, ← inter_distrib_right], { simp only [union_univ, union_diff_self, univ_inter] }, - { have : disjoint f.discrete_support (univ \ f.discrete_support) := disjoint_diff, + { have : disjoint f.discrete_support (univ \ f.discrete_support) := disjoint_sdiff_self_right, exact this.mono (inter_subset_left _ _) (inter_subset_left _ _) } end @@ -343,7 +354,7 @@ lemma discrete_part_apply (f : bounded_additive_measure α) (s : set α) : f.discrete_part s = f (f.discrete_support ∩ s) := rfl lemma continuous_part_apply_eq_zero_of_countable (f : bounded_additive_measure α) - (s : set α) (hs : countable s) : f.continuous_part s = 0 := + (s : set α) (hs : s.countable) : f.continuous_part s = 0 := begin simp [continuous_part], convert f.apply_countable s hs using 2, @@ -352,12 +363,12 @@ begin end lemma continuous_part_apply_diff (f : bounded_additive_measure α) - (s t : set α) (hs : countable s) : f.continuous_part (t \ s) = f.continuous_part t := + (s t : set α) (hs : s.countable) : f.continuous_part (t \ s) = f.continuous_part t := begin conv_rhs { rw ← diff_union_inter t s }, rw [additive, self_eq_add_right], { exact continuous_part_apply_eq_zero_of_countable _ _ (hs.mono (inter_subset_right _ _)) }, - { exact disjoint.mono_right (inter_subset_right _ _) (disjoint.comm.1 disjoint_diff) }, + { exact disjoint.mono_right (inter_subset_right _ _) disjoint_sdiff_self_left }, end end bounded_additive_measure @@ -371,7 +382,7 @@ section -/ lemma norm_indicator_le_one (s : set α) (x : α) : - ∥(indicator s (1 : α → ℝ)) x∥ ≤ 1 := + ‖(indicator s (1 : α → ℝ)) x‖ ≤ 1 := by { simp only [indicator, pi.one_apply], split_ifs; norm_num } /-- A functional in the dual space of bounded functions gives rise to a bounded additive measure, @@ -379,18 +390,18 @@ by applying the functional to the indicator functions. -/ def _root_.continuous_linear_map.to_bounded_additive_measure [topological_space α] [discrete_topology α] (f : (α →ᵇ ℝ) →L[ℝ] ℝ) : bounded_additive_measure α := -{ to_fun := λ s, f (of_normed_group_discrete (indicator s 1) 1 (norm_indicator_le_one s)), +{ to_fun := λ s, f (of_normed_add_comm_group_discrete (indicator s 1) 1 (norm_indicator_le_one s)), additive' := λ s t hst, begin - have : of_normed_group_discrete (indicator (s ∪ t) 1) 1 (norm_indicator_le_one (s ∪ t)) - = of_normed_group_discrete (indicator s 1) 1 (norm_indicator_le_one s) - + of_normed_group_discrete (indicator t 1) 1 (norm_indicator_le_one t), + have : of_normed_add_comm_group_discrete (indicator (s ∪ t) 1) 1 (norm_indicator_le_one _) + = of_normed_add_comm_group_discrete (indicator s 1) 1 (norm_indicator_le_one s) + + of_normed_add_comm_group_discrete (indicator t 1) 1 (norm_indicator_le_one t), by { ext x, simp [indicator_union_of_disjoint hst], }, rw [this, f.map_add], end, - exists_bound := ⟨∥f∥, λ s, begin - have I : ∥of_normed_group_discrete (indicator s 1) 1 (norm_indicator_le_one s)∥ ≤ 1, - by apply norm_of_normed_group_le _ zero_le_one, + exists_bound := ⟨‖f‖, λ s, begin + have I : ‖of_normed_add_comm_group_discrete (indicator s 1) 1 (norm_indicator_le_one s)‖ ≤ 1, + by apply norm_of_normed_add_comm_group_le _ zero_le_one, apply le_trans (f.le_op_norm _), simpa using mul_le_mul_of_nonneg_left I (norm_nonneg f), end⟩ } @@ -410,7 +421,7 @@ lemma to_functions_to_measure [measurable_space α] (μ : measure α) [is_finite μ.extension_to_bounded_functions.to_bounded_additive_measure s = (μ s).to_real := begin change μ.extension_to_bounded_functions - (of_normed_group_discrete (indicator s (λ x, 1)) 1 (norm_indicator_le_one s)) = (μ s).to_real, + (of_normed_add_comm_group_discrete (indicator s 1) 1 (norm_indicator_le_one s)) = (μ s).to_real, rw extension_to_bounded_functions_apply, { change ∫ x, s.indicator (λ y, (1 : ℝ)) x ∂μ = _, simp [integral_indicator hs] }, @@ -449,7 +460,7 @@ We need the continuum hypothesis to construct it. -/ theorem sierpinski_pathological_family (Hcont : #ℝ = aleph 1) : - ∃ (f : ℝ → set ℝ), (∀ x, countable (univ \ f x)) ∧ (∀ y, countable {x | y ∈ f x}) := + ∃ (f : ℝ → set ℝ), (∀ x, (univ \ f x).countable) ∧ (∀ y, {x : ℝ | y ∈ f x}.countable) := begin rcases cardinal.ord_eq ℝ with ⟨r, hr, H⟩, resetI, @@ -477,10 +488,10 @@ contained in only countably many of them. -/ def spf (Hcont : #ℝ = aleph 1) (x : ℝ) : set ℝ := (sierpinski_pathological_family Hcont).some x -lemma countable_compl_spf (Hcont : #ℝ = aleph 1) (x : ℝ) : countable (univ \ spf Hcont x) := +lemma countable_compl_spf (Hcont : #ℝ = aleph 1) (x : ℝ) : (univ \ spf Hcont x).countable := (sierpinski_pathological_family Hcont).some_spec.1 x -lemma countable_spf_mem (Hcont : #ℝ = aleph 1) (y : ℝ) : countable {x | y ∈ spf Hcont x} := +lemma countable_spf_mem (Hcont : #ℝ = aleph 1) (y : ℝ) : {x | y ∈ spf Hcont x}.countable := (sierpinski_pathological_family Hcont).some_spec.2 y /-! @@ -488,7 +499,7 @@ lemma countable_spf_mem (Hcont : #ℝ = aleph 1) (y : ℝ) : countable {x | y We construct a function `f` from `[0,1]` to a complete Banach space `B`, which is weakly measurable (i.e., for any continuous linear form `φ` on `B` the function `φ ∘ f` is measurable), bounded in -norm (i.e., for all `x`, one has `∥f x∥ ≤ 1`), and still `f` has no Pettis integral. +norm (i.e., for all `x`, one has `‖f x‖ ≤ 1`), and still `f` has no Pettis integral. This construction, due to Phillips, requires the continuum hypothesis. We will take for `B` the space of all bounded functions on `ℝ`, with the supremum norm (no measure here, we are really @@ -500,7 +511,7 @@ which is large (it has countable complement), as in the Sierpinski pathological taking values in `{0, 1}`), indexed by a real parameter `x`, corresponding to the characteristic functions of the different fibers of the Sierpinski pathological family -/ def f (Hcont : #ℝ = aleph 1) (x : ℝ) : (discrete_copy ℝ →ᵇ ℝ) := -of_normed_group_discrete (indicator (spf Hcont x) 1) 1 (norm_indicator_le_one _) +of_normed_add_comm_group_discrete (indicator (spf Hcont x) 1) 1 (norm_indicator_le_one _) lemma apply_f_eq_continuous_part (Hcont : #ℝ = aleph 1) (φ : (discrete_copy ℝ →ᵇ ℝ) →L[ℝ] ℝ) (x : ℝ) @@ -511,12 +522,12 @@ begin have : φ (f Hcont x) = ψ (spf Hcont x) := rfl, have U : univ = spf Hcont x ∪ (univ \ spf Hcont x), by simp only [union_univ, union_diff_self], rw [this, eq_add_parts, discrete_part_apply, hx, ψ.empty, zero_add, U, - ψ.continuous_part.additive _ _ (disjoint_diff), + ψ.continuous_part.additive _ _ disjoint_sdiff_self_right, ψ.continuous_part_apply_eq_zero_of_countable _ (countable_compl_spf Hcont x), add_zero], end lemma countable_ne (Hcont : #ℝ = aleph 1) (φ : (discrete_copy ℝ →ᵇ ℝ) →L[ℝ] ℝ) : - countable {x | φ.to_bounded_additive_measure.continuous_part univ ≠ φ (f Hcont x)} := + {x | φ.to_bounded_additive_measure.continuous_part univ ≠ φ (f Hcont x)}.countable := begin have A : {x | φ.to_bounded_additive_measure.continuous_part univ ≠ φ (f Hcont x)} ⊆ {x | φ.to_bounded_additive_measure.discrete_support ∩ spf Hcont x ≠ ∅}, @@ -528,7 +539,7 @@ begin ⊆ ⋃ y ∈ φ.to_bounded_additive_measure.discrete_support, {x | y ∈ spf Hcont x}, { assume x hx, dsimp at hx, - rw [← ne.def, ne_empty_iff_nonempty] at hx, + rw [← ne.def, ←nonempty_iff_ne_empty] at hx, simp only [exists_prop, mem_Union, mem_set_of_eq], exact hx }, apply countable.mono (subset.trans A B), @@ -542,7 +553,7 @@ begin apply ae_restrict_of_ae, refine measure_mono_null _ ((countable_ne Hcont φ).measure_zero _), assume x, - simp only [imp_self, mem_set_of_eq, mem_compl_eq], + simp only [imp_self, mem_set_of_eq, mem_compl_iff], end lemma integrable_comp (Hcont : #ℝ = aleph 1) (φ : (discrete_copy ℝ →ᵇ ℝ) →L[ℝ] ℝ) : @@ -578,8 +589,8 @@ begin end /-- The function `f Hcont : ℝ → (discrete_copy ℝ →ᵇ ℝ)` is uniformly bounded by `1` in norm. -/ -lemma norm_bound (Hcont : #ℝ = aleph 1) (x : ℝ) : ∥f Hcont x∥ ≤ 1 := -norm_of_normed_group_le _ zero_le_one _ +lemma norm_bound (Hcont : #ℝ = aleph 1) (x : ℝ) : ‖f Hcont x‖ ≤ 1 := +norm_of_normed_add_comm_group_le _ zero_le_one _ /-- The function `f Hcont : ℝ → (discrete_copy ℝ →ᵇ ℝ)` has no Pettis integral. -/ theorem no_pettis_integral (Hcont : #ℝ = aleph 1) : @@ -600,3 +611,5 @@ begin end end phillips_1940 + +end counterexample diff --git a/counterexamples/pseudoelement.lean b/counterexamples/pseudoelement.lean index 5b2c551cacfcd..a05f885f332ae 100644 --- a/counterexamples/pseudoelement.lean +++ b/counterexamples/pseudoelement.lean @@ -5,9 +5,13 @@ Authors: Riccardo Brasca -/ import category_theory.abelian.pseudoelements +import algebra.category.Module.biproducts /-! # Pseudoelements and pullbacks + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Borceux claims in Proposition 1.9.5 that the pseudoelement constructed in `category_theory.abelian.pseudoelement.pseudo_pullback` is unique. We show here that this claim is false. This means in particular that we cannot have an extensionality principle for pullbacks in @@ -30,23 +34,19 @@ given by `t ↦ (t, 2 * t)` and `y : ℚ ⟶ ℚ ⊞ ℚ` given by `t ↦ (t, t) open category_theory.abelian category_theory category_theory.limits Module linear_map +namespace counterexample + noncomputable theory -namespace category_theory.abelian.pseudoelement +open category_theory.abelian.pseudoelement /-- `x` is given by `t ↦ (t, 2 * t)`. -/ def x : over ((of ℤ ℚ) ⊞ (of ℤ ℚ)) := -begin - constructor, - exact biprod.lift (of_hom id) (of_hom (2 * id)), -end +over.mk (biprod.lift (of_hom id) (of_hom (2 * id))) /-- `y` is given by `t ↦ (t, t)`. -/ def y : over ((of ℤ ℚ) ⊞ (of ℤ ℚ)) := -begin - constructor, - exact biprod.lift (of_hom id) (of_hom id), -end +over.mk (biprod.lift (of_hom id) (of_hom id)) /-- `biprod.fst ≫ x` is pseudoequal to `biprod.fst y`. -/ lemma fst_x_pseudo_eq_fst_y : pseudo_equal _ (app biprod.fst x) (app biprod.fst y) := @@ -66,9 +66,7 @@ begin category_struct.id.epi (of ℤ ℚ), _, _⟩, { refine (Module.epi_iff_surjective _).2 (λ a, ⟨(a/2 : ℚ), _⟩), simp only [two_smul, add_apply, of_hom_apply, id_coe, id.def], - convert add_halves' _, - change char_zero ℚ, - apply_instance }, + exact add_halves' (show ℚ, from a) }, { dsimp [x, y], exact concrete_category.hom_ext _ _ (λ a, by simpa) } end @@ -97,7 +95,7 @@ begin simp only [ha₁, this, biprod.lift_snd, of_hom_apply, id_coe, id.def, preadditive.add_comp, category.assoc, biprod.inl_snd, limits.comp_zero, biprod.inr_snd, category.comp_id, zero_add, mul_apply, self_eq_add_left] at ha₂, - exact @one_ne_zero ℚ _ _ ha₂, + exact one_ne_zero' ℚ ha₂, end local attribute [instance] pseudoelement.setoid @@ -126,4 +124,4 @@ lemma exist_ne_and_fst_eq_fst_and_snd_eq_snd : ∃ x y : (of ℤ ℚ) ⊞ (of (biprod.snd : (of ℤ ℚ) ⊞ (of ℤ ℚ) ⟶ _) x = (biprod.snd : (of ℤ ℚ) ⊞ (of ℤ ℚ) ⟶ _) y:= ⟨⟦x⟧, ⟦y⟧, mk_x_ne_mk_y, fst_mk_x_eq_fst_mk_y, snd_mk_x_eq_snd_mk_y⟩ -end category_theory.abelian.pseudoelement +end counterexample diff --git a/counterexamples/quadratic_form.lean b/counterexamples/quadratic_form.lean new file mode 100644 index 0000000000000..50214d8f685dd --- /dev/null +++ b/counterexamples/quadratic_form.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import linear_algebra.quadratic_form.basic +import algebra.char_p.two +import data.zmod.basic + +/-! +# `quadratic_form R M` and `subtype bilin_form.is_symm` are distinct notions in characteristic 2 + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The main result of this file is `bilin_form.not_inj_on_to_quadratic_form_is_symm`. + +The counterexample we use is $B (x, y) (x', y') ↦ xy' + x'y$ where `x y x' y' : zmod 2`. +-/ + +variables (F : Type*) [nontrivial F] [comm_ring F] [char_p F 2] + +open bilin_form + +namespace counterexample + +/-- The bilinear form we will use as a counterexample, over some field `F` of characteristic two. -/ +def B : bilin_form F (F × F) := +bilin_form.lin_mul_lin (linear_map.fst _ _ _) (linear_map.snd _ _ _) + + bilin_form.lin_mul_lin (linear_map.snd _ _ _) (linear_map.fst _ _ _) + +@[simp] +lemma B_apply (x y : F × F) : B F x y = x.1 * y.2 + x.2 * y.1 := rfl + +lemma is_symm_B : (B F).is_symm := λ x y, by simp [mul_comm, add_comm] + +lemma is_alt_B : (B F).is_alt := λ x, by simp [mul_comm, char_two.add_self_eq_zero (x.1 * x.2)] + +lemma B_ne_zero : B F ≠ 0 := λ h, by simpa using bilin_form.congr_fun h (1, 0) (1, 1) + +/-- `bilin_form.to_quadratic_form` is not injective on symmetric bilinear forms. + +This disproves a weaker version of `quadratic_form.associated_left_inverse`. +-/ +lemma {u} bilin_form.not_inj_on_to_quadratic_form_is_symm : + ¬∀ {R M : Type u} [semiring R] [add_comm_monoid M], + by exactI ∀ [module R M], + by exactI set.inj_on + (to_quadratic_form : bilin_form R M → quadratic_form R M) + { B | B.is_symm }:= +begin + intro h, + let F := ulift.{u} (zmod 2), + apply B_ne_zero F, + apply h (is_symm_B F) (is_symm_zero), + rw [bilin_form.to_quadratic_form_zero, bilin_form.to_quadratic_form_eq_zero], + exact is_alt_B F, +end + +end counterexample diff --git a/counterexamples/seminorm_lattice_not_distrib.lean b/counterexamples/seminorm_lattice_not_distrib.lean index 0e2d4456eb63d..ca9b74e8f6934 100644 --- a/counterexamples/seminorm_lattice_not_distrib.lean +++ b/counterexamples/seminorm_lattice_not_distrib.lean @@ -7,6 +7,9 @@ import analysis.seminorm /-! # The lattice of seminorms is not distributive +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide an example of three seminorms over the ℝ-vector space ℝ×ℝ which don't satisfy the lattice distributivity property `(p ⊔ q1) ⊓ (p ⊔ q2) ≤ p ⊔ (q1 ⊓ q2)`. @@ -17,13 +20,12 @@ This proves the lattice `seminorm ℝ (ℝ × ℝ)` is not distributive. * https://en.wikipedia.org/wiki/Seminorm#Examples -/ -namespace seminorm_not_distrib +open seminorm open_locale nnreal -private lemma bdd_below_range_add {𝕜 E : Type*} [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] - (x : E) (p q : seminorm 𝕜 E) : - bdd_below (set.range (λ (u : E), p u + q (x - u))) := -by { use 0, rintro _ ⟨x, rfl⟩, exact add_nonneg (p.nonneg _) (q.nonneg _) } +namespace counterexample + +namespace seminorm_not_distrib @[simps] noncomputable def p : seminorm ℝ (ℝ×ℝ) := (norm_seminorm ℝ ℝ).comp (linear_map.fst _ _ _) ⊔ (norm_seminorm ℝ ℝ).comp (linear_map.snd _ _ _) @@ -36,10 +38,9 @@ by { use 0, rintro _ ⟨x, rfl⟩, exact add_nonneg (p.nonneg _) (q.nonneg _) } lemma eq_one : (p ⊔ (q1 ⊓ q2)) (1, 1) = 1 := begin - dsimp [-seminorm.inf_apply], - rw [sup_idem, norm_one, sup_eq_left], - apply cinfi_le_of_le (bdd_below_range_add _ _ _) ((0, 1) : ℝ×ℝ), dsimp, - simp only [norm_zero, smul_zero, sub_self, add_zero, zero_le_one] + suffices : (⨅ x : ℝ × ℝ, q1 x + q2 (1 - x)) ≤ 1, by simpa, + apply cinfi_le_of_le bdd_below_range_add ((0, 1) : ℝ×ℝ), dsimp [q1, q2], + simp only [abs_zero, smul_zero, sub_self, add_zero, zero_le_one], end /-- This is a counterexample to the distributivity of the lattice `seminorm ℝ (ℝ × ℝ)`. -/ @@ -57,7 +58,7 @@ begin ... ≤ 4 * |1 - x.snd| : (mul_le_mul_left zero_lt_four).mpr (le_abs_self _) ... = q2 ((1, 1) - x) : rfl ... ≤ (p ⊔ q2) ((1, 1) - x) : le_sup_right - ... ≤ (p ⊔ q1) x + (p ⊔ q2) ((1, 1) - x) : le_add_of_nonneg_left ((p ⊔ q1).nonneg _) }, + ... ≤ (p ⊔ q1) x + (p ⊔ q2) ((1, 1) - x) : le_add_of_nonneg_left (map_nonneg _ _) }, { calc 4/3 = 2/3 + (1 - 1/3) : by norm_num ... ≤ x.snd + (1 - x.fst) : add_le_add (le_of_lt h2) (sub_le_sub_left h1 _) ... ≤ |x.snd| + |1 - x.fst| : add_le_add (le_abs_self _) (le_abs_self _) @@ -68,7 +69,9 @@ begin ... ≤ 4 * |x.fst| : (mul_le_mul_left zero_lt_four).mpr (le_abs_self _) ... = q1 x : rfl ... ≤ (p ⊔ q1) x : le_sup_right - ... ≤ (p ⊔ q1) x + (p ⊔ q2) ((1, 1) - x) : le_add_of_nonneg_right ((p ⊔ q2).nonneg _) } + ... ≤ (p ⊔ q1) x + (p ⊔ q2) ((1, 1) - x) : le_add_of_nonneg_right (map_nonneg _ _) } end end seminorm_not_distrib + +end counterexample diff --git a/counterexamples/sorgenfrey_line.lean b/counterexamples/sorgenfrey_line.lean new file mode 100644 index 0000000000000..ac740f1bb34da --- /dev/null +++ b/counterexamples/sorgenfrey_line.lean @@ -0,0 +1,303 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import topology.instances.irrational +import topology.algebra.order.archimedean +import topology.paracompact +import topology.metric_space.metrizable +import topology.metric_space.emetric_paracompact +import data.set.intervals.monotone + +/-! +# Sorgenfrey line + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `sorgenfrey_line` (notation: `ℝₗ`) to be the Sorgenfrey line. It is the real +line with the topology space structure generated by half-open intervals `set.Ico a b`. + +We prove that this line is a completely normal Hausdorff space but its product with itself is not a +normal space. In particular, this implies that the topology on `ℝₗ` is neither metrizable, nor +second countable. + +## Notations + +- `ℝₗ`: Sorgenfrey line. + +## TODO + +Prove that the Sorgenfrey line is a paracompact space. + +-/ + +open set filter topological_space +open_locale topology filter +namespace counterexample + +noncomputable theory + +/-- The Sorgenfrey line. It is the real line with the topology space structure generated by +half-open intervals `set.Ico a b`. -/ +@[derive [conditionally_complete_linear_order, linear_ordered_field, archimedean]] +def sorgenfrey_line : Type := ℝ + +localized "notation (name := sorgenfrey_line) `ℝₗ` := sorgenfrey_line" in sorgenfrey_line + +namespace sorgenfrey_line + +/-- Ring homomorphism between the Sorgenfrey line and the standard real line. -/ +def to_real : ℝₗ ≃+* ℝ := ring_equiv.refl ℝ + +instance : topological_space ℝₗ := +topological_space.generate_from {s : set ℝₗ | ∃ a b : ℝₗ, Ico a b = s} + +lemma is_open_Ico (a b : ℝₗ) : is_open (Ico a b) := +topological_space.generate_open.basic _ ⟨a, b, rfl⟩ + +lemma is_open_Ici (a : ℝₗ) : is_open (Ici a) := +Union_Ico_right a ▸ is_open_Union (is_open_Ico a) + +lemma nhds_basis_Ico (a : ℝₗ) : (𝓝 a).has_basis (λ b, a < b) (λ b, Ico a b) := +begin + rw topological_space.nhds_generate_from, + haveI : nonempty {x // x ≤ a} := set.nonempty_Iic_subtype, + have : (⨅ (x : {i // i ≤ a}), 𝓟 (Ici ↑x)) = 𝓟 (Ici a), + { refine (is_least.is_glb _).infi_eq, + exact ⟨⟨⟨a, le_rfl⟩, rfl⟩, forall_range_iff.2 $ + λ b, principal_mono.2 $ Ici_subset_Ici.2 b.2⟩, }, + simp only [mem_set_of_eq, infi_and, infi_exists, @infi_comm _ (_ ∈ _), + @infi_comm _ (set ℝₗ), infi_infi_eq_right], + simp_rw [@infi_comm _ ℝₗ (_ ≤ _), infi_subtype', ← Ici_inter_Iio, ← inf_principal, ← inf_infi, + ← infi_inf, this, infi_subtype], + suffices : (⨅ x ∈ Ioi a, 𝓟 (Iio x)).has_basis ((<) a) Iio, from this.principal_inf _, + refine has_basis_binfi_principal _ nonempty_Ioi, + exact directed_on_iff_directed.2 (directed_of_inf $ λ x y hxy, Iio_subset_Iio hxy), +end + +lemma nhds_basis_Ico_rat (a : ℝₗ) : + (𝓝 a).has_countable_basis (λ r : ℚ, a < r) (λ r, Ico a r) := +begin + refine ⟨(nhds_basis_Ico a).to_has_basis (λ b hb, _) (λ r hr, ⟨_, hr, subset.rfl⟩), + set.to_countable _⟩, + rcases exists_rat_btwn hb with ⟨r, har, hrb⟩, + exact ⟨r, har, Ico_subset_Ico_right hrb.le⟩ +end + +lemma nhds_basis_Ico_inv_pnat (a : ℝₗ) : + (𝓝 a).has_basis (λ n : ℕ+, true) (λ n, Ico a (a + n⁻¹)) := +begin + refine (nhds_basis_Ico a).to_has_basis (λ b hb, _) + (λ n hn, ⟨_, lt_add_of_pos_right _ (inv_pos.2 $ nat.cast_pos.2 n.pos), subset.rfl⟩), + rcases exists_nat_one_div_lt (sub_pos.2 hb) with ⟨k, hk⟩, + rw [one_div] at hk, + rw [← nat.cast_add_one] at hk, + exact ⟨k.succ_pnat, trivial, Ico_subset_Ico_right (le_sub_iff_add_le'.1 hk.le)⟩ +end + +lemma nhds_countable_basis_Ico_inv_pnat (a : ℝₗ) : + (𝓝 a).has_countable_basis (λ n : ℕ+, true) (λ n, Ico a (a + n⁻¹)) := +⟨nhds_basis_Ico_inv_pnat a, set.to_countable _⟩ + +lemma nhds_antitone_basis_Ico_inv_pnat (a : ℝₗ) : + (𝓝 a).has_antitone_basis (λ n : ℕ+, Ico a (a + n⁻¹)) := +⟨nhds_basis_Ico_inv_pnat a, monotone_const.Ico $ + antitone.const_add (λ k l hkl, inv_le_inv_of_le (nat.cast_pos.2 k.pos) (nat.mono_cast hkl)) _⟩ + +lemma is_open_iff {s : set ℝₗ} : is_open s ↔ ∀ x ∈ s, ∃ y > x, Ico x y ⊆ s := +is_open_iff_mem_nhds.trans $ forall₂_congr $ λ x hx, (nhds_basis_Ico x).mem_iff + +lemma is_closed_iff {s : set ℝₗ} : is_closed s ↔ ∀ x ∉ s, ∃ y > x, disjoint (Ico x y) s := +by simp only [← is_open_compl_iff, is_open_iff, mem_compl_iff, subset_compl_iff_disjoint_right] + +lemma exists_Ico_disjoint_closed {a : ℝₗ} {s : set ℝₗ} (hs : is_closed s) (ha : a ∉ s) : + ∃ b > a, disjoint (Ico a b) s := +is_closed_iff.1 hs a ha + +@[simp] lemma map_to_real_nhds (a : ℝₗ) : map to_real (𝓝 a) = 𝓝[≥] (to_real a) := +begin + refine ((nhds_basis_Ico a).map _).eq_of_same_basis _, + simpa only [to_real.image_eq_preimage] using nhds_within_Ici_basis_Ico (to_real a) +end + +lemma nhds_eq_map (a : ℝₗ) : 𝓝 a = map to_real.symm (𝓝[≥] a.to_real) := +by simp_rw [← map_to_real_nhds, map_map, (∘), to_real.symm_apply_apply, map_id'] + +lemma nhds_eq_comap (a : ℝₗ) : 𝓝 a = comap to_real (𝓝[≥] a.to_real) := +by rw [← map_to_real_nhds, comap_map to_real.injective] + +@[continuity] lemma continuous_to_real : continuous to_real := +continuous_iff_continuous_at.2 $ λ x, + by { rw [continuous_at, tendsto, map_to_real_nhds], exact inf_le_left } + +instance : order_closed_topology ℝₗ := +⟨is_closed_le_prod.preimage (continuous_to_real.prod_map continuous_to_real)⟩ + +instance : has_continuous_add ℝₗ := +begin + refine ⟨continuous_iff_continuous_at.2 _⟩, + rintro ⟨x, y⟩, + simp only [continuous_at, nhds_prod_eq, nhds_eq_map, nhds_eq_comap (x + y), prod_map_map_eq, + tendsto_comap_iff, tendsto_map'_iff, (∘), ← nhds_within_prod_eq], + exact (continuous_add.tendsto _).inf (maps_to.tendsto $ λ x hx, add_le_add hx.1 hx.2) +end + +lemma is_clopen_Ici (a : ℝₗ) : is_clopen (Ici a) := ⟨is_open_Ici a, is_closed_Ici⟩ + +lemma is_clopen_Iio (a : ℝₗ) : is_clopen (Iio a) := +by simpa only [compl_Ici] using (is_clopen_Ici a).compl + +lemma is_clopen_Ico (a b : ℝₗ) : is_clopen (Ico a b) := +(is_clopen_Ici a).inter (is_clopen_Iio b) + +instance : totally_disconnected_space ℝₗ := +⟨λ s hs' hs x hx y hy, le_antisymm (hs.subset_clopen (is_clopen_Ici x) ⟨x, hx, le_rfl⟩ hy) + (hs.subset_clopen (is_clopen_Ici y) ⟨y, hy, le_rfl⟩ hx)⟩ + +instance : first_countable_topology ℝₗ := ⟨λ x, (nhds_basis_Ico_rat x).is_countably_generated⟩ + +/-- Sorgenfrey line is a completely normal Hausdorff topological space. -/ +instance : t5_space ℝₗ := +begin + /- Let `s` and `t` be disjoint closed sets. For each `x ∈ s` we choose `X x` such that + `set.Ico x (X x)` is disjoint with `t`. Similarly, for each `y ∈ t` we choose `Y y` such that + `set.Ico y (Y y)` is disjoint with `s`. Then `⋃ x ∈ s, Ico x (X x)` and `⋃ y ∈ t, Ico y (Y y)` are + disjoint open sets that include `s` and `t`. -/ + refine ⟨λ s t hd₁ hd₂, _⟩, + choose! X hX hXd + using λ x (hx : x ∈ s), exists_Ico_disjoint_closed is_closed_closure (disjoint_left.1 hd₂ hx), + choose! Y hY hYd + using λ y (hy : y ∈ t), exists_Ico_disjoint_closed is_closed_closure (disjoint_right.1 hd₁ hy), + refine disjoint_of_disjoint_of_mem _ + (bUnion_mem_nhds_set $ λ x hx, (is_open_Ico x (X x)).mem_nhds $ left_mem_Ico.2 (hX x hx)) + (bUnion_mem_nhds_set $ λ y hy, (is_open_Ico y (Y y)).mem_nhds $ left_mem_Ico.2 (hY y hy)), + simp only [disjoint_Union_left, disjoint_Union_right, Ico_disjoint_Ico], + intros y hy x hx, + cases le_total x y with hle hle, + { calc min (X x) (Y y) ≤ X x : min_le_left _ _ + ... ≤ y : not_lt.1 (λ hyx, (hXd x hx).le_bot ⟨⟨hle, hyx⟩, subset_closure hy⟩) + ... ≤ max x y : le_max_right _ _ }, + { calc min (X x) (Y y) ≤ Y y : min_le_right _ _ + ... ≤ x : not_lt.1 $ λ hxy, (hYd y hy).le_bot ⟨⟨hle, hxy⟩, subset_closure hx⟩ + ... ≤ max x y : le_max_left _ _ } +end + +lemma dense_range_coe_rat : dense_range (coe : ℚ → ℝₗ) := +begin + refine dense_iff_inter_open.2 _, + rintro U Uo ⟨x, hx⟩, + rcases is_open_iff.1 Uo _ hx with ⟨y, hxy, hU⟩, + rcases exists_rat_btwn hxy with ⟨z, hxz, hzy⟩, + exact ⟨z, hU ⟨hxz.le, hzy⟩, mem_range_self _⟩ +end + +instance : separable_space ℝₗ := ⟨⟨_, countable_range _, dense_range_coe_rat⟩⟩ + +lemma is_closed_antidiagonal (c : ℝₗ) : is_closed {x : ℝₗ × ℝₗ | x.1 + x.2 = c} := +is_closed_singleton.preimage continuous_add + +lemma is_clopen_Ici_prod (x : ℝₗ × ℝₗ) : is_clopen (Ici x) := +(Ici_prod_eq x).symm ▸ (is_clopen_Ici _).prod (is_clopen_Ici _) + +/-- Any subset of an antidiagonal `{(x, y) : ℝₗ × ℝₗ| x + y = c}` is a closed set. -/ +lemma is_closed_of_subset_antidiagonal {s : set (ℝₗ × ℝₗ)} {c : ℝₗ} + (hs : ∀ x : ℝₗ × ℝₗ, x ∈ s → x.1 + x.2 = c) : is_closed s := +begin + rw [← closure_subset_iff_is_closed], + rintro ⟨x, y⟩ H, + obtain rfl : x + y = c, + { change (x, y) ∈ {p : ℝₗ × ℝₗ | p.1 + p.2 = c}, + exact closure_minimal (hs : s ⊆ {x | x.1 + x.2 = c}) (is_closed_antidiagonal c) H }, + rcases mem_closure_iff.1 H (Ici (x, y)) (is_clopen_Ici_prod _).1 le_rfl + with ⟨⟨x', y'⟩, ⟨hx : x ≤ x', hy : y ≤ y'⟩, H⟩, + convert H, + { refine hx.antisymm _, + rwa [← add_le_add_iff_right, hs _ H, add_le_add_iff_left] }, + { refine hy.antisymm _, + rwa [← add_le_add_iff_left, hs _ H, add_le_add_iff_right] } +end + +lemma nhds_prod_antitone_basis_inv_pnat (x y : ℝₗ) : + (𝓝 (x, y)).has_antitone_basis (λ n : ℕ+, Ico x (x + n⁻¹) ×ˢ Ico y (y + n⁻¹)) := +begin + rw [nhds_prod_eq], + exact (nhds_antitone_basis_Ico_inv_pnat x).prod (nhds_antitone_basis_Ico_inv_pnat y) +end + +/-- The product of the Sorgenfrey line and itself is not a normal topological space. -/ +lemma not_normal_space_prod : ¬normal_space (ℝₗ × ℝₗ) := +begin + have h₀ : ∀ {n : ℕ+}, (0 : ℝ) < n⁻¹, from λ n, inv_pos.2 (nat.cast_pos.2 n.pos), + have h₀' : ∀ {n : ℕ+} {x : ℝ}, x < x + n⁻¹, from λ n x, lt_add_of_pos_right _ h₀, + introI, + /- Let `S` be the set of points `(x, y)` on the line `x + y = 0` such that `x` is rational. + Let `T` be the set of points `(x, y)` on the line `x + y = 0` such that `x` is irrational. + These sets are closed, see `sorgenfrey_line.is_closed_of_subset_antidiagonal`, and disjoint. -/ + set S := {x : ℝₗ × ℝₗ | x.1 + x.2 = 0 ∧ ∃ r : ℚ, ↑r = x.1}, + set T := {x : ℝₗ × ℝₗ | x.1 + x.2 = 0 ∧ irrational x.1.to_real}, + have hSc : is_closed S, from is_closed_of_subset_antidiagonal (λ x hx, hx.1), + have hTc : is_closed T, from is_closed_of_subset_antidiagonal (λ x hx, hx.1), + have hd : disjoint S T, + { rw disjoint_iff_inf_le, + rintro ⟨x, y⟩ ⟨⟨-, r, rfl : _ = x⟩, -, hr⟩, + exact r.not_irrational hr }, + /- Consider disjoint open sets `U ⊇ S` and `V ⊇ T`. -/ + rcases normal_separation hSc hTc hd with ⟨U, V, Uo, Vo, SU, TV, UV⟩, + /- For each point `(x, -x) ∈ T`, choose a neighborhood + `Ico x (x + k⁻¹) ×ˢ Ico (-x) (-x + k⁻¹) ⊆ V`. -/ + have : ∀ x : ℝₗ, irrational x.to_real → + ∃ k : ℕ+, Ico x (x + k⁻¹) ×ˢ Ico (-x) (-x + k⁻¹) ⊆ V, + { intros x hx, + have hV : V ∈ 𝓝 (x, -x), from Vo.mem_nhds (@TV (x, -x) ⟨add_neg_self x, hx⟩), + exact (nhds_prod_antitone_basis_inv_pnat _ _).mem_iff.1 hV }, + choose! k hkV, + /- Since the set of irrational numbers is a dense Gδ set in the usual topology of `ℝ`, there + exists `N > 0` such that the set `C N = {x : ℝ | irrational x ∧ k x = N}` is dense in a nonempty + interval. In other words, the closure of this set has a nonempty interior. -/ + set C : ℕ+ → set ℝ := λ n, closure {x | irrational x ∧ k (to_real.symm x) = n}, + have H : {x : ℝ | irrational x} ⊆ ⋃ n, C n, + from λ x hx, mem_Union.2 ⟨_, subset_closure ⟨hx, rfl⟩⟩, + have Hd : dense (⋃ n, interior (C n)) := + is_Gδ_irrational.dense_Union_interior_of_closed dense_irrational (λ _, is_closed_closure) H, + obtain ⟨N, hN⟩ : ∃ n : ℕ+, (interior $ C n).nonempty, from nonempty_Union.mp Hd.nonempty, + /- Choose a rational number `r` in the interior of the closure of `C N`, then choose `n ≥ N > 0` + such that `Ico r (r + n⁻¹) × Ico (-r) (-r + n⁻¹) ⊆ U`. -/ + rcases rat.dense_range_cast.exists_mem_open is_open_interior hN with ⟨r, hr⟩, + have hrU : ((r, -r) : ℝₗ × ℝₗ) ∈ U, from @SU (r, -r) ⟨add_neg_self _, r, rfl⟩, + obtain ⟨n, hnN, hn⟩ : ∃ n (hnN : N ≤ n), Ico (r : ℝₗ) (r + n⁻¹) ×ˢ Ico (-r : ℝₗ) (-r + n⁻¹) ⊆ U, + from ((nhds_prod_antitone_basis_inv_pnat _ _).has_basis_ge N).mem_iff.1 (Uo.mem_nhds hrU), + /- Finally, choose `x ∈ Ioo (r : ℝ) (r + n⁻¹) ∩ C N`. Then `(x, -r)` belongs both to `U` and `V`, + so they are not disjoint. This contradiction completes the proof. -/ + obtain ⟨x, hxn, hx_irr, rfl⟩ : + ∃ x : ℝ, x ∈ Ioo (r : ℝ) (r + n⁻¹) ∧ irrational x ∧ k (to_real.symm x) = N, + { have : (r : ℝ) ∈ closure (Ioo (r : ℝ) (r + n⁻¹)), + { rw [closure_Ioo h₀'.ne, left_mem_Icc], exact h₀'.le }, + rcases mem_closure_iff_nhds.1 this _ (mem_interior_iff_mem_nhds.1 hr) with ⟨x', hx', hx'ε⟩, + exact mem_closure_iff.1 hx' _ is_open_Ioo hx'ε }, + refine UV.le_bot (_ : (to_real.symm x, -↑r) ∈ _), + refine ⟨hn ⟨_, _⟩, hkV (to_real.symm x) hx_irr ⟨_, _⟩⟩, + { exact Ioo_subset_Ico_self hxn }, + { exact left_mem_Ico.2 h₀' }, + { exact left_mem_Ico.2 h₀' }, + { refine (nhds_antitone_basis_Ico_inv_pnat (-x)).2 hnN ⟨neg_le_neg hxn.1.le, _⟩, + simp only [add_neg_lt_iff_le_add', lt_neg_add_iff_add_lt], + exact hxn.2 } +end + +/-- Topology on the Sorgenfrey line is not metrizable. -/ +lemma not_metrizable_space : ¬metrizable_space ℝₗ := +begin + introI, + letI := metrizable_space_metric ℝₗ, + exact not_normal_space_prod infer_instance +end + +/-- Topology on the Sorgenfrey line is not second countable. -/ +lemma not_second_countable_topology : ¬second_countable_topology ℝₗ := +by { introI, exact not_metrizable_space (metrizable_space_of_t3_second_countable _) } + +end sorgenfrey_line + +end counterexample diff --git a/counterexamples/zero_divisors_in_add_monoid_algebras.lean b/counterexamples/zero_divisors_in_add_monoid_algebras.lean new file mode 100644 index 0000000000000..8b52293f1958d --- /dev/null +++ b/counterexamples/zero_divisors_in_add_monoid_algebras.lean @@ -0,0 +1,239 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import algebra.geom_sum +import algebra.group.unique_prods +import algebra.monoid_algebra.basic +import data.finsupp.lex +import data.zmod.basic + +/-! +# Examples of zero-divisors in `add_monoid_algebra`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains an easy source of zero-divisors in an `add_monoid_algebra`. +If `k` is a field and `G` is an additive group containing a non-zero torsion element, then +`add_monoid_algebra k G` contains non-zero zero-divisors: this is lemma `zero_divisors_of_torsion`. + +There is also a version for periodic elements of an additive monoid: `zero_divisors_of_periodic`. + +The converse of this statement is +[Kaplansky's zero divisor conjecture](https://en.wikipedia.org/wiki/Kaplansky%27s_conjectures). + +The formalized example generalizes in trivial ways the assumptions: the field `k` can be any +nontrivial ring `R` and the additive group `G` with a torsion element can be any additive monoid +`A` with a non-zero periodic element. + +Besides this example, we also address a comment in `data.finsupp.lex` to the effect that the proof +that addition is monotone on `α →₀ N` uses that it is *strictly* monotone on `N`. + +The specific statement is about `finsupp.lex.covariant_class_le_left` and its analogue +`finsupp.lex.covariant_class_le_right`. We do not need two separate counterexamples, since the +operation is commutative. + +The example is very simple. Let `F = {0, 1}` with order determined by `0 < 1` and absorbing +addition (which is the same as `max` in this case). We denote a function `f : F → F` (which is +automatically finitely supported!) by `[f 0, f 1]`, listing its values. Recall that the order on +finitely supported function is lexicographic, matching the list notation. The inequality +`[0, 1] ≤ [1, 0]` holds. However, adding `[1, 0]` to both sides yields the *reversed* inequality +`[1, 1] > [1, 0]`. +-/ +open finsupp add_monoid_algebra + +namespace counterexample + +/-- This is a simple example showing that if `R` is a non-trivial ring and `A` is an additive +monoid with an element `a` satisfying `n • a = a` and `(n - 1) • a ≠ a`, for some `2 ≤ n`, +then `add_monoid_algebra R A` contains non-zero zero-divisors. The elements are easy to write down: +`[a]` and `[a] ^ (n - 1) - 1` are non-zero elements of `add_monoid_algebra R A` whose product +is zero. + +Observe that such an element `a` *cannot* be invertible. In particular, this lemma never applies +if `A` is a group. -/ +lemma zero_divisors_of_periodic {R A} [nontrivial R] [ring R] [add_monoid A] {n : ℕ} (a : A) + (n2 : 2 ≤ n) (na : n • a = a) (na1 : (n - 1) • a ≠ 0) : + ∃ f g : add_monoid_algebra R A, f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 := +begin + refine ⟨single a 1, single ((n - 1) • a) 1 - single 0 1, by simp, _, _⟩, + { exact sub_ne_zero.mpr (by simpa [single_eq_single_iff]) }, + { rw [mul_sub, add_monoid_algebra.single_mul_single, add_monoid_algebra.single_mul_single, + sub_eq_zero, add_zero, ← succ_nsmul, nat.sub_add_cancel (one_le_two.trans n2), na] }, +end + +lemma single_zero_one {R A} [semiring R] [has_zero A] : + single (0 : A) (1 : R) = (1 : add_monoid_algebra R A) := rfl + +/-- This is a simple example showing that if `R` is a non-trivial ring and `A` is an additive +monoid with a non-zero element `a` of finite order `oa`, then `add_monoid_algebra R A` contains +non-zero zero-divisors. The elements are easy to write down: +`∑ i in finset.range oa, [a] ^ i` and `[a] - 1` are non-zero elements of `add_monoid_algebra R A` +whose product is zero. + +In particular, this applies whenever the additive monoid `A` is an additive group with a non-zero +torsion element. -/ +lemma zero_divisors_of_torsion {R A} [nontrivial R] [ring R] [add_monoid A] (a : A) + (o2 : 2 ≤ add_order_of a) : + ∃ f g : add_monoid_algebra R A, f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 := +begin + refine ⟨(finset.range (add_order_of a)).sum (λ (i : ℕ), (single a 1) ^ i), + single a 1 - single 0 1, _, _, _⟩, + { apply_fun (λ x : add_monoid_algebra R A, x 0), + refine ne_of_eq_of_ne (_ : (_ : R) = 1) one_ne_zero, + simp_rw finset.sum_apply', + refine (finset.sum_eq_single 0 _ _).trans _, + { intros b hb b0, + rw [single_pow, one_pow, single_eq_of_ne], + exact nsmul_ne_zero_of_lt_add_order_of' b0 (finset.mem_range.mp hb) }, + { simp only [(zero_lt_two.trans_le o2).ne', finset.mem_range, not_lt, le_zero_iff, + false_implies_iff] }, + { rw [single_pow, one_pow, zero_smul, single_eq_same] } }, + { apply_fun (λ x : add_monoid_algebra R A, x 0), + refine sub_ne_zero.mpr (ne_of_eq_of_ne (_ : (_ : R) = 0) _), + { have a0 : a ≠ 0 := ne_of_eq_of_ne (one_nsmul a).symm + (nsmul_ne_zero_of_lt_add_order_of' one_ne_zero (nat.succ_le_iff.mp o2)), + simp only [a0, single_eq_of_ne, ne.def, not_false_iff] }, + { simpa only [single_eq_same] using zero_ne_one, } }, + { convert commute.geom_sum₂_mul _ (add_order_of a), + { ext, rw [single_zero_one, one_pow, mul_one] }, + { rw [single_pow, one_pow, add_order_of_nsmul_eq_zero, single_zero_one, one_pow, sub_self] }, + { simp only [single_zero_one, commute.one_right] } }, +end + +example {R} [ring R] [nontrivial R] (n : ℕ) (n0 : 2 ≤ n) : + ∃ f g : add_monoid_algebra R (zmod n), f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 := +zero_divisors_of_torsion (1 : zmod n) (n0.trans_eq (zmod.add_order_of_one _).symm) + +/-- `F` is the type with two elements `zero` and `one`. We define the "obvious" linear order and +absorbing addition on it to generate our counterexample. -/ +@[derive [decidable_eq, inhabited]] inductive F | zero | one + +/-- The same as `list.get_rest`, except that we take the "rest" from the first match, rather than +from the beginning, returning `[]` if there is no match. For instance, +```lean +#eval [1,2].drop_until [3,1,2,4,1,2] -- [4, 1, 2] +``` +-/ +def list.drop_until {α} [decidable_eq α] : list α → list α → list α +| l [] := [] +| l (a::as) := ((a::as).get_rest l).get_or_else (l.drop_until as) + +/-- `guard_decl_in_file na loc` makes sure that the declaration with name `na` is in the file with +relative path `"src/" ++ "/".intercalate loc ++ ".lean"`. +```lean +#eval guard_decl_in_file `nat.nontrivial ["data", "nat", "basic"] -- does nothing + +#eval guard_decl_in_file `nat.nontrivial ["not", "in", "here"] +-- fails giving the location 'data/nat/basic.lean' +``` + +This test makes sure that the comment referring to this example is in the file claimed in the +doc-module to this counterexample. -/ +meta def guard_decl_in_file (na : name) (loc : list string) : tactic unit := +do env ← tactic.get_env, + some fil ← pure $ env.decl_olean na | fail!"the instance `{na}` is not imported!", + let path : string := ⟨list.drop_until "/src/".to_list fil.to_list⟩, + let locdot : string := ".".intercalate loc, + guard (fil.ends_with ("src/" ++ "/".intercalate loc ++ ".lean")) <|> + fail!("instance `{na}` is no longer in `{locdot}`.\n\n" ++ + "Please, update the doc-module and this check with the correct location:\n\n'{path}'\n") + +#eval guard_decl_in_file `finsupp.lex.covariant_class_le_left ["data", "finsupp", "lex"] +#eval guard_decl_in_file `finsupp.lex.covariant_class_le_right ["data", "finsupp", "lex"] + +namespace F + +instance : has_zero F := ⟨F.zero⟩ + +/-- `1` is not really needed, but it is nice to use the notation. -/ +instance : has_one F := ⟨F.one⟩ + +/-- A tactic to prove trivial goals by enumeration. -/ +meta def boom : tactic unit := +`[ repeat { rintro ⟨⟩ }; dec_trivial ] + +/-- `val` maps `0 1 : F` to their counterparts in `ℕ`. +We use it to lift the linear order on `ℕ`. -/ +def val : F → ℕ +| 0 := 0 +| 1 := 1 + +instance : linear_order F := linear_order.lift' val (by boom) + +@[simp] lemma z01 : (0 : F) < 1 := by boom + +/-- `F` would be a `comm_semiring`, using `min` as multiplication. Again, we do not need this. -/ +instance : add_comm_monoid F := +{ add := max, + add_assoc := by boom, + zero := 0, + zero_add := by boom, + add_zero := by boom, + add_comm := by boom } + +/-- The `covariant_class`es asserting monotonicity of addition hold for `F`. -/ +instance covariant_class_add_le : covariant_class F F (+) (≤) := ⟨by boom⟩ +example : covariant_class F F (function.swap (+)) (≤) := by apply_instance + +/-- The following examples show that `F` has all the typeclasses used by +`finsupp.lex.covariant_class_le_left`... -/ +example : linear_order F := by apply_instance +example : add_monoid F := by apply_instance + +/-- ... except for the strict monotonicity of addition, the crux of the matter. -/ +example : ¬ covariant_class F F (+) (<) := λ h, lt_irrefl 1 $ (h.elim : covariant F F (+) (<)) 1 z01 + +/-- A few `simp`-lemmas to take care of trivialities in the proof of the example below. -/ +@[simp] lemma f1 : ∀ (a : F), 1 + a = 1 := by boom +@[simp] lemma f011 : of_lex (single (0 : F) (1 : F)) 1 = 0 := single_apply_eq_zero.mpr (λ h, h) +@[simp] lemma f010 : of_lex (single (0 : F) (1 : F)) 0 = 1 := single_eq_same +@[simp] lemma f111 : of_lex (single (1 : F) (1 : F)) 1 = 1 := single_eq_same +@[simp] lemma f110 : of_lex (single (1 : F) (1 : F)) 0 = 0 := single_apply_eq_zero.mpr (λ h, h.symm) + +/-- Here we see that (not-necessarily strict) monotonicity of addition on `lex (F →₀ F)` is not +a consequence of monotonicity of addition on `F`. Strict monotonicity of addition on `F` is +enough and is the content of `finsupp.lex.covariant_class_le_left`. -/ +example : ¬ covariant_class (lex (F →₀ F)) (lex (F →₀ F)) (+) (≤) := +begin + rintro ⟨h⟩, + refine not_lt.mpr (h (single (0 : F) (1 : F)) (_ : single 1 1 ≤ single 0 1)) ⟨1, _⟩, + { exact or.inr ⟨0, by simp [(by boom : ∀ j : F, j < 0 ↔ false)]⟩ }, + { simp only [(by boom : ∀ j : F, j < 1 ↔ j = 0), of_lex_add, coe_add, pi.to_lex_apply, + pi.add_apply, forall_eq, f010, f1, eq_self_iff_true, f011, f111, zero_add, and_self] }, +end + +example {α} [ring α] [nontrivial α] : + ∃ f g : add_monoid_algebra α F, f ≠ 0 ∧ g ≠ 0 ∧ f * g = 0 := +zero_divisors_of_periodic (1 : F) le_rfl (by simp [two_smul]) (z01.ne') + +example {α} [has_zero α] : 2 • (single 0 1 : α →₀ F) = single 0 1 ∧ (single 0 1 : α →₀ F) ≠ 0 := +⟨smul_single _ _ _, by simpa only [ne.def, single_eq_zero] using z01.ne⟩ + +end F + +/-- A Type that does not have `unique_prods`. -/ +example : ¬ unique_prods ℕ := +begin + rintros ⟨h⟩, + refine not_not.mpr (h (finset.singleton_nonempty 0) (finset.insert_nonempty 0 {1})) _, + suffices : (∃ (x : ℕ), (x = 0 ∨ x = 1) ∧ ¬x = 0) ∧ ∃ (x : ℕ), (x = 0 ∨ x = 1) ∧ ¬x = 1, + { simpa [unique_mul] }, + exact ⟨⟨1, by simp⟩, ⟨0, by simp⟩⟩, +end + +/-- Some Types that do not have `unique_sums`. -/ +example (n : ℕ) (n2 : 2 ≤ n): ¬ unique_sums (zmod n) := +begin + haveI : fintype (zmod n) := @zmod.fintype n ⟨(zero_lt_two.trans_le n2).ne'⟩, + haveI : nontrivial (zmod n) := char_p.nontrivial_of_char_ne_one (one_lt_two.trans_le n2).ne', + rintros ⟨h⟩, + refine not_not.mpr (h finset.univ_nonempty finset.univ_nonempty) _, + suffices : ∀ (x y : zmod n), ∃ (x' y' : zmod n), x' + y' = x + y ∧ (x' = x → ¬y' = y), + { simpa [unique_add] }, + exact λ x y, ⟨x - 1, y + 1, sub_add_add_cancel _ _ _, by simp⟩, +end + +end counterexample diff --git a/docs/100.yaml b/docs/100.yaml index 4003c7c42a912..c6c0079297bcf 100644 --- a/docs/100.yaml +++ b/docs/100.yaml @@ -17,11 +17,13 @@ 5: title : Prime Number Theorem 6: - title : Godel’s Incompleteness Theorem + title : Gödel’s Incompleteness Theorem 7: title : Law of Quadratic Reciprocity - decl : zmod.quadratic_reciprocity - author : Chris Hughes + decls : + - legendre_sym.quadratic_reciprocity + - jacobi_sym.quadratic_reciprocity + author : Chris Hughes (first) and Michael Stoll (second) 8: title : The Impossibility of Trisecting the Angle and Doubling the Cube 9: @@ -43,10 +45,8 @@ title : Polyhedron Formula 14: title : Euler’s Summation of 1 + (1/2)^2 + (1/3)^2 + …. - author : Marc Masdeu - links : - result : https://github.com/mmasdeu/euler/blob/main/src/euler.lean#L712 - website: https://github.com/mmasdeu/euler + decl : has_sum_zeta_two + author : Marc Masdeu, David Loeffler 15: title : Fundamental Theorem of Integral Calculus decls : @@ -109,6 +109,9 @@ title : Feuerbach’s Theorem 30: title : The Ballot Problem + author : Bhavik Mehta, Kexing Ying + links : + mathlib archive : https://github.com/leanprover-community/mathlib/blob/master/archive/100-theorems-list/30_ballot_problem.lean 31: title : Ramsey’s Theorem author : Bhavik Mehta @@ -124,8 +127,15 @@ author : Anatole Dedecker, Yury Kudryashov 35: title : Taylor’s Theorem + decls : + - taylor_mean_remainder_lagrange + - taylor_mean_remainder_cauchy + author : Moritz Doll 36: title : Brouwer Fixed Point Theorem + author : Brendan Seamas Murphy + links : + result: https://github.com/Shamrock-Frost/BrouwerFixedPoint/blob/master/src/brouwer_fixed_point.lean 37: title : The Solution of a Cubic author : Jeoff Lee @@ -137,11 +147,15 @@ author : Yury G. Kudryashov 39: title : Solutions to Pell’s Equation - decl : pell.eq_pell - author : Mario Carneiro - note : "`d` is defined to be `a*a - 1` for an arbitrary `a > 1`." + decls : + - pell.eq_pell + - pell.exists_of_not_is_square + author : Mario Carneiro (first), Michael Stoll (second) + note : "In `pell.eq_pell`, `d` is defined to be `a*a - 1` for an arbitrary `a > 1`." 40: title : Minkowski’s Fundamental Theorem + decl : measure_theory.exists_ne_zero_mem_lattice_of_measure_mul_two_pow_lt_measure + author : Alex J. Best, Yaël Dillies 41: title : Puiseux’s Theorem 42: @@ -183,7 +197,10 @@ 53: title : Pi is Transcendental 54: - title : Konigsberg Bridges Problem + title : Königsberg Bridges Problem + links: + mathlib archive: https://github.com/leanprover-community/mathlib/blob/master/archive/100-theorems-list/54_konigsberg.lean + author : Kyle Miller 55: title : Product of Segments of Chords decl : euclidean_geometry.mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi @@ -203,6 +220,8 @@ author : mathlib 59: title : The Laws of Large Numbers + decl : probability_theory.strong_law_ae + author : Sébastien Gouëzel 60: title : Bezout’s Theorem decl : nat.gcd_eq_gcd_ab @@ -228,7 +247,7 @@ 66: title : Sum of a Geometric Series decls : - - geom_sum + - geom_sum_Ico - nnreal.has_sum_geometric author : Sander R. Dahmen (finite) and Johannes Hölzl (infinite) 67: @@ -283,8 +302,8 @@ 76: title : Fourier Series decls : - - fourier_series_repr - - has_sum_fourier_series + - fourier_coeff + - has_sum_fourier_series_L2 author : Heather Macbeth 77: title : Sum of kth powers @@ -296,7 +315,7 @@ title : The Cauchy-Schwarz Inequality decls : - inner_mul_inner_self_le - - abs_inner_le_norm + - norm_inner_le_norm author : Zhouhang Zhou 79: title : The Intermediate Value Theorem @@ -354,6 +373,9 @@ author : Chris Hughes 90: title : Stirling’s Formula + decls : + - stirling.tendsto_stirling_seq_sqrt_pi + author : mathlib (Moritz Firsching, Fabian Kruse, Nikolas Kuhn, Heather Macbeth) 91: title : The Triangle Inequality decl : norm_add_le @@ -362,7 +384,6 @@ title : Pick’s Theorem 93: title : The Birthday Problem - decl : fintype.card_embedding_eq links : mathlib archive: https://github.com/leanprover-community/mathlib/blob/master/archive/100-theorems-list/93_birthday_problem.lean author : Eric Rodriguez @@ -385,6 +406,8 @@ author : Anne Baanen 98: title : Bertrand’s Postulate + decl : nat.bertrand + author : Bolton Bailey, Patrick Stevens 99: title : Buffon Needle Problem 100: diff --git a/docs/overview.yaml b/docs/overview.yaml index 0e0148deb8825..ecc7271289e99 100644 --- a/docs/overview.yaml +++ b/docs/overview.yaml @@ -46,6 +46,7 @@ General algebra: cyclic group: 'is_cyclic' nilpotent group: 'group.is_nilpotent' permutation group of a type: 'equiv.perm' + structure of fintely generated abelian groups: 'add_comm_group.equiv_free_prod_direct_sum_zmod' Rings: ring: 'ring' @@ -126,7 +127,7 @@ General algebra: Number theory: sum of two squares: 'nat.prime.sq_add_sq' sum of four squares: 'nat.sum_four_squares' - quadratic reciprocity: 'zmod.quadratic_reciprocity' + quadratic reciprocity: 'legendre_sym.quadratic_reciprocity' "solutions to Pell's equation": 'pell.pell' "Matiyasevič's theorem": 'pell.matiyasevic' arithmetic functions: 'nat.arithmetic_function' @@ -136,7 +137,13 @@ General algebra: ring of Witt vectors: 'witt_vector' perfection of a ring: 'ring.perfection' Transcendental numbers: - Liouville's theorem on existence of transcendental numbers: liouville.is_transcendental + Liouville's theorem on existence of transcendental numbers: 'transcendental_liouville_number' + + Representation theory: + representation : 'representation' + category of finite dimensional representations : 'fdRep' + character : 'fdRep.character' + orthogonality of characters : 'fdRep.char_orthonormal' Linear algebra: Fundamentals: @@ -158,6 +165,8 @@ Linear algebra: finite-dimensionality : 'finite_dimensional' isomorphism with $K^n$: 'basis.equiv_fun' isomorphism with bidual: 'module.eval_equiv' + Finitely generated modules over a PID: + structure theorem: 'module.equiv_free_prod_direct_sum' Matrices: ring-valued matrix: 'matrix' matrix representation of a linear map: 'linear_map.to_matrix' @@ -180,7 +189,7 @@ Linear algebra: polar form of a quadratic: 'quadratic_form.polar' Finite-dimensional inner product spaces (see also Hilbert spaces, below): existence of orthonormal basis: 'orthonormal_basis' - diagonalization of self-adjoint endomorphisms: 'inner_product_space.is_self_adjoint.diagonalization_basis_apply_self_apply' + diagonalization of self-adjoint endomorphisms: 'linear_map.is_symmetric.diagonalization_basis_apply_self_apply' Topology: General topology: @@ -202,7 +211,8 @@ Topology: connectedness: 'connected_space' compact open topology: 'continuous_map.compact_open' Stone-Cech compactification: 'stone_cech' - topological fiber bundle: 'is_topological_fiber_bundle' + topological fiber bundle: 'fiber_bundle' + topological vector bundle: 'vector_bundle' Urysohn's lemma: 'exists_continuous_zero_one_of_closed' Stone-Weierstrass theorem: 'continuous_map.subalgebra_topological_closure_eq_top_of_separates_points' Uniform notions: @@ -230,8 +240,8 @@ Topology: Metric spaces: metric space: 'metric_space' ball: 'metric.ball' - sequential compactness is equivalent to compactness (Bolzano-Weierstrass): 'uniform_space.compact_iff_seq_compact' - Heine-Borel theorem (proper metric space version): 'metric.compact_iff_closed_bounded' + sequential compactness is equivalent to compactness (Bolzano-Weierstrass): 'uniform_space.is_compact_iff_is_seq_compact' + Heine-Borel theorem (proper metric space version): 'metric.is_compact_iff_is_closed_bounded' Lipschitz continuity: 'lipschitz_with' Hölder continuity: 'holder_with' contraction mapping theorem: 'contracting_with.exists_fixed_point' @@ -264,12 +274,13 @@ Analysis: Hilbert spaces: Inner product space, over $R$ or $C$: 'inner_product_space' Cauchy-Schwarz inequality: 'inner_mul_inner_self_le' - self-adjoint endomorphism: 'inner_product_space.is_self_adjoint' + adjoint operator: 'linear_pmap.adjoint' + self-adjoint operator: 'is_self_adjoint' orthogonal projection: 'orthogonal_projection' reflection: 'reflection' orthogonal complement: 'submodule.orthogonal' existence of Hilbert basis: 'exists_hilbert_basis' - eigenvalues from Rayleigh quotient: 'inner_product_space.is_self_adjoint.has_eigenvector_of_is_local_extr_on' + eigenvalues from Rayleigh quotient: 'is_self_adjoint.has_eigenvector_of_is_local_extr_on' Fréchet-Riesz representation of the dual of a Hilbert space: 'inner_product_space.to_dual' Lax-Milgram theorem: 'is_coercive.continuous_linear_equiv_of_bilin' @@ -279,6 +290,7 @@ Analysis: derivative of the inverse of a function: 'has_fderiv_at.of_local_left_inverse' Rolle's theorem: 'exists_deriv_eq_zero' mean value theorem: 'exists_ratio_deriv_eq_ratio_slope' + Taylor's theorem: 'analysis/calculus/taylor.html' $C^k$ function: 'cont_diff' Leibniz formula: 'fderiv_mul' local extrema: 'is_local_min.fderiv_eq_zero' @@ -317,6 +329,7 @@ Analysis: monotone convergence theorem: 'measure_theory.lintegral_infi_ae' Fatou's lemma: 'measure_theory.lintegral_liminf_le' vector-valued integrable function (Bochner integral): 'measure_theory.integrable' + uniform integrability: 'measure_theory.uniform_integrable' $L^p$ space: 'measure_theory.Lp' Bochner integral: 'measure_theory.integral' dominated convergence theorem: 'measure_theory.tendsto_integral_of_dominated_convergence' @@ -324,6 +337,56 @@ Analysis: fundamental theorem of calculus, part 2: 'interval_integral.integral_eq_sub_of_has_deriv_right_of_le' Fubini's theorem: 'measure_theory.integral_prod' product of finitely many measures: 'measure_theory.measure.pi' + convolution: 'convolution' + approximation by convolution: 'cont_diff_bump.convolution_tendsto_right' + regularization by convolution: 'has_compact_support.cont_diff_convolution_left' + change of variables formula: 'measure_theory.integral_image_eq_integral_abs_det_fderiv_smul' + divergence theorem: 'measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable' + + Complex analysis: + Cauchy integral formula: 'diff_cont_on_cl.circle_integral_sub_inv_smul' + Liouville theorem: 'differentiable.apply_eq_apply_of_bounded' + maximum modulus principle: 'complex.eventually_eq_of_is_local_max_norm' + principle of isolated zeros: 'analytic_at.eventually_eq_zero_or_eventually_ne_zero' + principle of analytic continuation: 'analytic_on.eq_on_of_preconnected_of_frequently_eq' + analyticity of holomorphic functions: 'differentiable_on.analytic_at' + Schwarz lemma: 'complex.abs_le_abs_of_maps_to_ball_self' + removable singularity: 'complex.differentiable_on_update_lim_insert_of_is_o' + Phragmen-Lindelöf principle: 'phragmen_lindelof.horizontal_strip' + fundamental theorem of algebra: 'complex.is_alg_closed' + + Distribution theory: + Schwartz space: 'schwartz_map' + +Probability Theory: + Definitions in probability theory: + probability measure: 'measure_theory.is_probability_measure' + independent events: 'probability_theory.Indep_set' + independent sigma-algebras: 'probability_theory.Indep' + conditional probability: 'probability_theory.cond' + conditional expectation: 'measure_theory.condexp' + Random variables and their laws: + discrete law: 'pmf' + probability density function: 'measure_theory.has_pdf' + variance of a real-valued random variable: 'probability_theory.variance' + independence of random variables: 'probability_theory.Indep_fun' + Kolmogorov's $0$-$1$ law: 'probability_theory.measure_zero_or_one_of_measurable_set_limsup_at_top' + mean of product of independent random variables: 'probability_theory.indep_fun.integral_mul_of_integrable' + moment of a random variable: 'probability_theory.moment' + Bernoulli law: 'pmf.bernoulli' + Convergence of a sequence of random variables: + convergence in probability: 'measure_theory.tendsto_in_measure' + $\mathrm{L}^p$ convergence: 'measure_theory.Lp' + almost sure convergence: 'measure_theory.measure.ae' + convergence in distribution: 'measure_theory.probability_measure.tendsto_iff_forall_integral_tendsto' + Markov inequality: 'measure_theory.mul_meas_ge_le_lintegral' + Chebychev inequality: 'probability_theory.meas_ge_le_variance_div_sq' + strong law of large numbers: 'probability_theory.strong_law_ae' + Stochastic Processes: + martingale: 'measure_theory.martingale' + optional stopping theorem: 'measure_theory.submartingale_iff_expected_stopped_value_mono' + stopping time: 'measure_theory.is_stopping_time' + hitting time: 'measure_theory.hitting' Geometry: Affine and Euclidean geometry: @@ -331,7 +394,7 @@ Geometry: affine function: 'affine_map' affine subspace: 'affine_subspace' barycenter: 'finset.affine_combination' - affine span: 'span_points' + affine span: 'affine_span' Euclidean affine space: 'normed_add_torsor' angle: ' inner_product_geometry.angle' @@ -358,7 +421,7 @@ Combinatorics: adjacency matrix: 'simple_graph.adj_matrix' Pigeonhole principles: finite: 'fintype.exists_ne_map_eq_of_card_lt' - infinite: 'fintype.exists_infinite_fiber' + infinite: 'finite.exists_infinite_fiber' strong pigeonhole principle: 'fintype.exists_lt_card_fiber_of_mul_lt_card' Transversals: Hall's marriage theorem: 'finset.all_card_le_bUnion_card_iff_exists_injective' @@ -383,8 +446,8 @@ Data structures: difference list: 'dlist' lazy list: 'lazy_list' stream: 'stream' - sequence: 'seq' - weak sequence: 'wseq' + sequence: 'stream.seq' + weak sequence: 'stream.wseq' Sets: set: 'set' @@ -424,3 +487,4 @@ Logic and computation: definable set: 'set.definable' elementary embedding: 'first_order.language.elementary_embedding' Compactness theorem: 'first_order.language.Theory.is_satisfiable_iff_is_finitely_satisfiable' + Löwenheim-Skolem: 'first_order.language.exists_elementary_embedding_card_eq' diff --git a/docs/references.bib b/docs/references.bib index 35eae3137cecd..ece945a541bf9 100644 --- a/docs/references.bib +++ b/docs/references.bib @@ -8,6 +8,19 @@ # To link to an entry in `references.bib`, use the following formats: # [Author, *Title* (optional location)][bibkey] +@InProceedings{ adhesive2004, + author = {S. Lack and P. Soboci{\'n}ski}, + title = {Adhesive categories}, + booktitle = {Foundations of Software Science and Computation + Structures, {FoSSaCS '04}}, + series = {LNCS}, + volume = {2987}, + pages = {273--288}, + publisher = {Springer}, + year = {2004}, + url = {https://www.ioc.ee/~pawel/papers/adhesive.pdf} +} + @Article{ ahrens2017, author = {Benedikt Ahrens and Peter LeFanu Lumsdaine}, year = {2019}, @@ -18,6 +31,43 @@ @Article{ ahrens2017 doi = {10.23638/LMCS-15(1:20)2019} } +@Article{ aigner1999proofs, + author = {Aigner, Martin and Ziegler, G{\"u}nter M}, + title = {Proofs from THE BOOK}, + journal = {Berlin. Germany}, + year = {1999}, + publisher = {Springer} +} + +@Article{ alfseneffros1972, + author = {Erik M. {Alfsen} and Edward G. {Effros}}, + title = {{Structure in real Banach spaces. I and II}}, + fjournal = {{Annals of Mathematics. Second Series}}, + journal = {{Ann. Math. (2)}}, + issn = {0003-486X}, + volume = {96}, + pages = {98--173}, + year = {1972}, + publisher = {Princeton University, Mathematics Department, Princeton, + NJ}, + language = {English}, + doi = {10.2307/1970895}, + msc2010 = {46L05 46B10 46K05 46E15 46B99 46A40}, + zbl = {0248.46019} +} + +@Book{ alfsenshultz2003, + author = {Erik M. {Alfsen} and Frederic W. {Shultz}}, + title = {{Geometry of state spaces of operator algebras}}, + isbn = {0-8176-4319-2}, + pages = {xiii + 467}, + year = {2003}, + publisher = {Boston, MA: Birkh\"auser}, + language = {English}, + msc2010 = {46-02 46L05 46L10 46L70 46L30 17C65}, + zbl = {1042.46001} +} + @Book{ aluffi2016, title = {Algebra: Chapter 0}, author = {Aluffi, Paolo}, @@ -95,6 +145,32 @@ @Book{ beals2004 year = {2004} } +@Book{ behrends1979, + author = {Ehrhard {Behrends}}, + title = {{M-structure and the Banach-Stone theorem}}, + fjournal = {{Lecture Notes in Mathematics}}, + journal = {{Lect. Notes Math.}}, + issn = {0075-8434}, + volume = {736}, + year = {1979}, + publisher = {Springer, Cham}, + language = {English}, + msc2010 = {46B20 46-02 46E40 46A40}, + zbl = {0436.46013} +} + +@Book{ berger1987, + author = {Marcel Berger}, + title = {Geometry I}, + publisher = {Springer Berlin}, + year = 1987, + issn = {0172-5939}, + pages = {XIV, 432}, + series = {Universitext}, + address = {Heidelberg}, + edition = 1 +} + @Article{ bernstein1912, author = {Bernstein, S.}, year = {1912}, @@ -160,6 +236,15 @@ @Article{ birkhoff1942 url = {https://doi.org/10.2307/1968871} } +@Book{ bollobas1986, + author = {Bollob\'{a}s, B\'{e}la}, + title = {Combinatorics: Set Systems, Hypergraphs, Families of + Vectors, and Combinatorial Probability}, + year = {1986}, + isbn = {0521330599}, + publisher = {Cambridge University Press} +} + @Book{ borceux-vol1, title = {Handbook of Categorical Algebra: Volume 1, Basic Category Theory}, @@ -189,6 +274,16 @@ @Book{ borceux-vol3 publisher = {Cambridge University Press} } +@Book{ bosch-guntzer-remmert, + title = {Non-Archimedean Analysis : A Systematic Approach to Rigid + Analytic Geometry}, + author = {S. Bosch and U. G{\"{u}}ntzer and R. Remmert}, + series = {Grundlehren der mathematischen Wissenschaften}, + volume = {261}, + year = {1984}, + publisher = {Springer-Verlag Berlin } +} + @Book{ bourbaki1966, author = {Bourbaki, Nicolas}, title = {Elements of mathematics. {G}eneral topology. {P}art 1}, @@ -200,6 +295,17 @@ @Book{ bourbaki1966 mrnumber = {0205210} } +@Book{ bourbaki1966b, + author = {Bourbaki, Nicolas}, + title = {Elements of mathematics. {G}eneral topology. {P}art 2}, + publisher = {Hermann, Paris; Addison-Wesley Publishing Co., Reading, + Mass.-London-Don Mills, Ont.}, + year = {1966}, + pages = {iv+363}, + mrclass = {54-02 (00A05 54-01)}, + mrnumber = {979295} +} + @Book{ bourbaki1968, author = {Bourbaki, Nicolas}, title = {Lie groups and {L}ie algebras. {C}hapters 4--6}, @@ -271,6 +377,60 @@ @Book{ bourbaki1987 url = {https://doi.org/10.1007/978-3-642-61715-7} } +@Book{ bourbaki2007, + author = {Bourbaki, Nicolas}, + edition = {Réimpression inchangée de l'édition originale de 1959}, + series = {Eléments de mathématique}, + title = {Algèbre. {C}hapitre IX}, + isbn = {978-3-540-35338-6}, + language = {fr}, + number = {2}, + publisher = {Springer}, + year = {2007} +} + +@Book{ boydVandenberghe2004, + author = {Stephen P. Boyd and Lieven Vandenberghe}, + title = {Convex Optimization}, + publisher = {Cambridge University Press}, + year = {2004}, + isbn = {978-0-521-83378-3}, + url = {https://web.stanford.edu/~boyd/cvxbook/bv_cvxbook.pdf} +} + +@Book{ brodmannsharp13, + author = {Brodmann, M. P. and Sharp, R. Y.}, + title = {Local cohomology}, + series = {Cambridge Studies in Advanced Mathematics}, + volume = {136}, + edition = {Second}, + note = {An algebraic introduction with geometric applications}, + publisher = {Cambridge University Press, Cambridge}, + year = {2013}, + pages = {xxii+491}, + isbn = {978-0-521-51363-0}, + mrclass = {13D45 (13-01)} +} + +@Book{ cabreragarciarodriguezpalacios2014, + author = {Miguel {Cabrera Garc\'{\i}a} and \'Angel {Rodr\'{\i}guez + Palacios}}, + title = {{Non-associative normed algebras. Volume 1. The + Vidav-Palmer and Gelfand-Naimark theorems}}, + fjournal = {{Encyclopedia of Mathematics and Its Applications}}, + journal = {{Encycl. Math. Appl.}}, + issn = {0953-4806}, + volume = {154}, + isbn = {978-1-107-04306-0; 978-1-107-33776-3}, + pages = {xxii + 712}, + year = {2014}, + publisher = {Cambridge: Cambridge University Press}, + language = {English}, + doi = {10.1017/CBO9781107337763}, + msc2010 = {46-02 17-02 46H70 46K70 46L70 17A15 17A80 17C65}, + zbl = {1322.46003} +} + @Article{ cadiou1972, title = {Recursive definitions of partial functions and their computations}, @@ -292,6 +452,28 @@ @Book{ calugareanu doi = {10.1007/978-94-015-9588-9} } +@Article{ CARBONI1993145, + author = {Aurelio Carboni and Stephen Lack and R.F.C. Walters}, + doi = {https://doi.org/10.1016/0022-4049(93)90035-R}, + issn = {0022-4049}, + journal = {Journal of Pure and Applied Algebra}, + number = {2}, + pages = {145-158}, + title = {Introduction to extensive and distributive categories}, + url = {https://www.sciencedirect.com/science/article/pii/002240499390035R}, + volume = {84}, + year = {1993}, + bdsk-url-1 = {https://www.sciencedirect.com/science/article/pii/002240499390035R}, + bdsk-url-2 = {https://doi.org/10.1016/0022-4049(93)90035-R} +} + +@Article{ carneiro2015arithmetic, + title = {Arithmetic in Metamath, Case Study: Bertrand's Postulate}, + author = {Carneiro, Mario}, + journal = {arXiv preprint arXiv:1503.02349}, + year = {2015} +} + @Misc{ carneiro2018matiyasevic, title = {A {L}ean formalization of {M}atiyasevi{\v c}'s theorem}, author = {Mario Carneiro}, @@ -321,12 +503,36 @@ @InProceedings{ carneiro2019 bibsource = {dblp computer science bibliography, https://dblp.org} } +@Article{ cassels1950, + author = {Cassels, J. W. S.}, + title = {Some metrical theorems in {D}iophantine approximation. + {I}}, + journal = {Proc. Cambridge Philos. Soc.}, + fjournal = {Proceedings of the Cambridge Philosophical Society}, + volume = {46}, + year = {1950}, + pages = {209--218}, + issn = {0008-1981}, + mrclass = {10.0X}, + mrnumber = {36787}, + mrreviewer = {P. Erd\H{o}s}, + doi = {10.1017/s0305004100025676}, + url = {https://doi.org/10.1017/s0305004100025676} +} + @Book{ cassels1967algebraic, - title = {Algebraic number theory: proceedings of an instructional - conference}, - author = {Cassels, John William Scott and Fr{\"o}lich, Albrecht}, + title = {Algebraic number theory}, + author = {Cassels, John William Scott and Fr{\"o}hlich, Albrecht}, + booktitle = {Proceedings of an instructional conference organized by + the {L}ondon {M}athematical {S}ociety (a {NATO} {A}dvanced + {S}tudy {I}nstitute) with the support of the + {I}nternational {M}athematical {U}nion}, + editor = {Cassels, John William Scott and Fr\"{o}hlich, Albrecht}, + publisher = {Academic Press, London; Thompson Book Co., Inc., + Washington, D.C.}, year = {1967}, - publisher = {Academic Pr} + pages = {xviii+366}, + mrclass = {00.04 (10.00)} } @InProceedings{ Chou1994, @@ -342,6 +548,22 @@ @InProceedings{ Chou1994 isbn = {978-3-540-48803-3} } +@Book{ chu2012, + author = {Cho-Ho {Chu}}, + title = {{Jordan structures in geometry and analysis}}, + fjournal = {{Cambridge Tracts in Mathematics}}, + journal = {{Camb. Tracts Math.}}, + issn = {0950-6284}, + volume = {190}, + isbn = {978-1-107-01617-0}, + pages = {x + 261}, + year = {2012}, + publisher = {Cambridge: Cambridge University Press}, + language = {English}, + msc2010 = {17-02 17C65 17C37 46H70 53C35 46K70 32M15}, + zbl = {1238.17001} +} + @InProceedings{ CL21, author = {Commelin, Johan and Lewis, Robert Y.}, title = {Formalizing the Ring of Witt Vectors}, @@ -381,6 +603,12 @@ @InProceedings{ CL21 series = {CPP 2021} } +@Book{ clark_gon, + author = {Pete L. Clark}, + title = {Geometry of Numbers with Applications to Number Theory}, + url = {http://alpha.math.uga.edu/~pete/geometryofnumbers.pdf} +} + @Book{ conway2001, author = {Conway, J. H.}, title = {On numbers and games}, @@ -393,6 +621,35 @@ @Book{ conway2001 mrnumber = {1803095} } +@Book{ coxlittleoshea1997, + author = {David A. Cox and John Little and Donal O'Shea}, + title = {Ideals, varieties, and algorithms - an introduction to + computational algebraic geometry and commutative algebra + {(2.} ed.)}, + series = {Undergraduate texts in mathematics}, + publisher = {Springer}, + year = {1997}, + isbn = {978-0-387-94680-1} +} + +@Article{ crans2017, + author = {Crans, Alissa S. and Mukherjee, Sujoy and Przytycki, + J\'{o}zef H.}, + title = {On homology of associative shelves}, + journal = {J. Homotopy Relat. Struct.}, + fjournal = {Journal of Homotopy and Related Structures}, + volume = {12}, + year = {2017}, + number = {3}, + pages = {741--763}, + issn = {2193-8407}, + mrclass = {18G60 (20M32 20N02 57M25)}, + mrnumber = {3691304}, + mrreviewer = {Mahender Singh}, + doi = {10.1007/s40062-016-0164-9}, + url = {https://doi.org/10.1007/s40062-016-0164-9} +} + @Book{ davey_priestley, author = {Davey, B. A. and Priestley, H. A.}, title = {Introduction to lattices and order}, @@ -421,6 +678,19 @@ @InProceedings{ deligne_formulaire mrreviewer = {Jacques Velu} } +@InProceedings{ demoura2015lean, + author = {de Moura, Leonardo and Kong, Soonho and Avigad, Jeremy and + van Doorn, Floris and von Raumer, Jakob}, + editor = {Felty, Amy P. and Middeldorp, Aart}, + title = {The Lean Theorem Prover (System Description)}, + booktitle = {Automated Deduction - CADE-25}, + year = {2015}, + publisher = {Springer International Publishing}, + address = {Cham}, + pages = {378--388}, + isbn = {978-3-319-21401-6} +} + @Article{ dold1958, author = {Dold, Albrecht}, title = {Homology of symmetric products and other functors of @@ -468,6 +738,19 @@ @Book{ EinsiedlerWard2017 doi = {10.1007/978-3-319-58540-6} } +@Book{ Eisenbud1995, + title = "Commutative algebra", + author = "Eisenbud, David", + publisher = "Springer", + series = "Graduate Texts in Mathematics", + month = mar, + year = 1995, + address = "New York, NY", + language = "en", + isbn = {978-0-387-94268-1}, + doi = {10.1007/978-1-4612-5350-1} +} + @Book{ Elephant, title = {Sketches of an Elephant – A Topos Theory Compendium}, author = {Peter Johnstone}, @@ -475,7 +758,7 @@ @Book{ Elephant publisher = {Oxford University Press} } -@book{ engel1997, +@Book{ engel1997, title = {Sperner theory}, author = {Engel, Konrad}, publisher = {Cambridge University Press}, @@ -493,6 +776,24 @@ @Article{ erdosrenyisos url = {https://www.renyi.hu/~p_erdos/1966-06.pdf} } +@Article{ etemadi_strong_law, + author = {Etemadi, Nasrollah}, + title = {An elementary proof of the strong law of large numbers}, + journal = {Z. Wahrsch. Verw. Gebiete}, + fjournal = {Zeitschrift f\"{u}r Wahrscheinlichkeitstheorie und + Verwandte Gebiete}, + volume = {55}, + year = {1981}, + number = {1}, + pages = {119--122}, + issn = {0044-3719}, + mrclass = {60F15 (60B12)}, + mrnumber = {606010}, + mrreviewer = {Robert L. Taylor}, + doi = {10.1007/BF01013465}, + url = {https://doi.org/10.1007/BF01013465} +} + @Book{ Federer1996, author = {Herbert Federer}, title = {Geometric Measure Theory}, @@ -572,6 +873,31 @@ @Book{ fremlin_vol4 year = {2003} } +@Book{ freyd1964abelian, + title = {Abelian categories}, + author = {Freyd, Peter J}, + series = {Harper's Series in Modern Mathematics}, + year = {1964}, + publisher = {Harper \& Row New York} +} + +@Book{ friedmanscarr2005, + author = {Yaakov {Friedman}}, + title = {{Physical applications of homogeneous balls. With the + assistance of Tzvi Scarr}}, + fjournal = {{Progress in Mathematical Physics}}, + journal = {{Prog. Math. Phys.}}, + issn = {1544-9998}, + volume = {40}, + isbn = {0-8176-3339-1}, + pages = {xxiv + 279}, + year = {2005}, + publisher = {Boston, MA: Birkh\"auser}, + language = {English}, + msc2010 = {46-02 17C65 46L60 46G20 46L70 83A05}, + zbl = {1080.46001} +} + @Book{ fuchs1963, author = {Fuchs, L.}, title = {Partially ordered algebraic systems}, @@ -623,6 +949,32 @@ @Article{ furedi-loeb1994 zbl = {0802.28002} } +@Book{ gabriel-zisman-1967, + author = {Gabriel, P. and Zisman, M.}, + title = {Calculus of fractions and homotopy theory}, + series = {Ergebnisse der Mathematik und ihrer Grenzgebiete, Band + 35}, + publisher = {Springer-Verlag New York, Inc., New York}, + year = {1967}, + pages = {x+168} +} + +@Article{ Gallagher1961, + author = {Gallagher, Patrick}, + title = {Approximation by reduced fractions}, + journal = {J. Math. Soc. Japan}, + fjournal = {Journal of the Mathematical Society of Japan}, + volume = {13}, + year = {1961}, + pages = {342--345}, + issn = {0025-5645}, + mrclass = {10.30}, + mrnumber = {133297}, + mrreviewer = {J. W. S. Cassels}, + doi = {10.2969/jmsj/01340342}, + url = {https://doi.org/10.2969/jmsj/01340342} +} + @InProceedings{ Gallier2011Notes, title = {Notes on Differential Geometry and Lie Groups}, author = {J. Gallier and J. Quaintance}, @@ -630,6 +982,12 @@ @InProceedings{ Gallier2011Notes url = {https://www.cis.upenn.edu/~cis610/diffgeom-n.pdf} } +@Unpublished{ gartnerMatousek, + title = {Cone Programming}, + author = {B. G{\"{a}}rtner and J. Matousek}, + url = {https://ti.inf.ethz.ch/ew/lehre/ApproxSDP09/notes/conelp.pdf} +} + @Article{ ghys87:groupes, author = {Étienne Ghys}, title = {Groupes d'homéomorphismes du cercle et cohomologie @@ -673,6 +1031,21 @@ @Book{ GierzEtAl1980 mrreviewer = {James W. Lea, Jr.} } +@Article{ gleason1958, + author = {Gleason, Andrew M.}, + title = {Projective topological spaces}, + journal = {Illinois J. Math.}, + fjournal = {Illinois Journal of Mathematics}, + volume = {2}, + year = {1958}, + pages = {482--489}, + issn = {0019-2082}, + mrclass = {54.00}, + mrnumber = {121775}, + mrreviewer = {Dana Scott}, + url = {http://projecteuclid.org/euclid.ijm/1255454110} +} + @Book{ goerss-jardine-2009, author = {Goerss, Paul G. and Jardine, John F.}, title = {Simplicial homotopy theory}, @@ -724,6 +1097,15 @@ @Book{ Gratzer2011 mrnumber = {2768581} } +@Unpublished{ grinberg_clifford_2016, + title = {The {Clifford} algebra and the {Chevalley} map- a + computational approach (summary version 1)}, + url = {http://mit.edu/~darij/www/algebra/chevalleys.pdf}, + author = {Grinberg, D.}, + month = jun, + year = {2016} +} + @Book{ gunter1992, title = {Semantics of Programming Languages: Structures and Techniques}, @@ -822,6 +1204,37 @@ @Book{ hardy2008introduction publisher = {Oxford University Press} } +@Book{ harmandwernerwerner1993, + author = {Peter {Harmand} and Dirk {Werner} and Wend {Werner}}, + title = {{\(M\)-ideals in Banach spaces and Banach algebras}}, + fjournal = {{Lecture Notes in Mathematics}}, + journal = {{Lect. Notes Math.}}, + issn = {0075-8434}, + volume = {1547}, + isbn = {3-540-56814-X}, + pages = {viii + 387}, + year = {1993}, + publisher = {Berlin: Springer-Verlag}, + language = {English}, + doi = {10.1007/BFb0084355}, + msc2010 = {46B20 46B25 46B22 46-02 46B28}, + zbl = {0789.46011} +} + +@Book{ hartshorne61, + author = {Hartshorne, Robin}, + title = {Local cohomology}, + series = {Lecture Notes in Mathematics, No. 41}, + note = {A seminar given by A. Grothendieck, Harvard University, + Fall, 1961}, + publisher = {Springer-Verlag, Berlin-New York}, + year = {1967}, + pages = {vi+106}, + mrclass = {14.55 (18.00)}, + mrnumber = {0224620}, + mrreviewer = {F. Oort} +} + @Article{ Haze09, title = {Witt vectors. Part 1}, isbn = {9780444532572}, @@ -846,6 +1259,12 @@ @Article{ Higman52 year = {1952} } +@Unpublished{ hochsterunpublished, + title = {Local cohomology}, + author = {Hochster, Mel}, + url = {https://dept.math.lsa.umich.edu/~hochster/615W11/loc.pdf} +} + @Book{ Hodges97, author = {Hodges, Wilfrid}, title = {A Shorter Model Theory}, @@ -898,6 +1317,90 @@ @Article{ huneke2002 url = {https://doi.org/10.1080/00029890.2002.11919853} } +@InProceedings{ hyman1973, + author = "Bass, Hyman", + editor = "Bass, Hyman", + title = "Unitary algebraic K-theory", + booktitle = "Hermitian K-Theory and Geometric Applications", + year = "1973", + publisher = "Springer Berlin Heidelberg", + address = "Berlin, Heidelberg", + pages = "57--265", + isbn = "978-3-540-37773-3" +} + +@Book{ iordanescu2003, + author = {Radu {Iord\u{a}nescu}}, + title = {{Jordan structures in geometry and physics. With an + appendix on Jordan structures in analysis}}, + isbn = {973-27-0956-1}, + pages = {201}, + year = {2003}, + publisher = {Bucharest: Editura Academiei Rom\^ane}, + language = {English}, + msc2010 = {17C50 17-02 17C65 32M15 35Q58 51A35 53C35 46H70 46K70 + 81R12 81R50}, + zbl = {1073.17014} +} + +@Book{ IrelandRosen1990, + author = {Ireland, Kenneth and Rosen, Michael}, + title = {A classical introduction to modern number theory}, + series = {Graduate Texts in Mathematics}, + volume = {84}, + edition = {Second}, + publisher = {Springer-Verlag, New York}, + year = {1990}, + pages = {xiv+389}, + isbn = {0-387-97329-X}, + doi = {10.1007/978-1-4757-2103-4}, + url = {https://doi.org/10.1007/978-1-4757-2103-4} +} + +@Book{ iyengaretal07, + author = {Iyengar, Srikanth B. and Leuschke, Graham J. and Leykin, + Anton and Miller, Claudia and Miller, Ezra and Singh, + Anurag K. and Walther, Uli}, + title = {Twenty-four hours of local cohomology}, + series = {Graduate Studies in Mathematics}, + volume = {87}, + publisher = {American Mathematical Society, Providence, RI}, + year = {2007}, + pages = {xviii+282}, + isbn = {978-0-8218-4126-6}, + mrclass = {13D45 (14B15 55N30)}, + doi = {10.1090/gsm/087}, + url = {https://doi-org.www2.lib.ku.edu/10.1090/gsm/087} +} + +@Article{ izhakian2016, + title = {Supertropical quadratic forms I}, + journal = {Journal of Pure and Applied Algebra}, + volume = {220}, + number = {1}, + pages = {61-93}, + year = {2016}, + issn = {0022-4049}, + doi = {10.1016/j.jpaa.2015.05.043}, + url = {https://www.sciencedirect.com/science/article/pii/S0022404915001589}, + author = {Zur Izhakian and Manfred Knebusch and Louis Rowen} +} + +@Book{ Jacobson1956, + author = {Jacobson, Nathan}, + title = {Structure of rings}, + fseries = {Colloquium Publications. American Mathematical Society}, + series = {Colloq. Publ., Am. Math. Soc.}, + issn = {0065-9258}, + volume = {37}, + year = {1956}, + publisher = {American Mathematical Society (AMS), Providence, RI}, + language = {English}, + keywords = {16-02}, + zbmath = {3121681}, + zbl = {0073.02002} +} + @Book{ james1999, author = {James, Ioan}, title = {Topologies and uniformities}, @@ -915,6 +1418,20 @@ @Book{ james1999 url = {https://doi.org/10.1007/978-1-4471-3994-2} } +@Article{ Jordan1935, + title = "On inner products in linear, metric spaces", + author = "Jordan, P. and von Neumann, J.", + fjournal = {{Annals of Mathematics}}, + journal = "Ann. Math.", + volume = 36, + number = 3, + pages = "719-723", + month = jul, + year = 1935, + url = "http://www.mathematik.uni-muenchen.de/~michel/jordan-von_neumann_-_parallelogram_identity.pdf", + doi = {10.2307/1968653} +} + @Article{ joyal1977, author = {André Joyal}, title = {Remarques sur la théorie des jeux à deux personnes}, @@ -948,6 +1465,20 @@ @Article{ Joyce1982 publisher = {Elsevier {BV}} } +@Book{ kallenberg2021, + author = {Olav Kallenberg}, + title = {Foundations of modern probability}, + series = {Probability Theory and Stochastic Modelling}, + volume = {99}, + publisher = {Springer Nature Switzerland}, + edition = {Third Edition}, + year = {2021}, + pages = {193}, + isbn = {978-3-030-61870-4; 978-3-030-61871-1}, + doi = {10.1007/978-3-030-61871-1}, + url = {https://doi.org/10.1007/978-3-030-61871-1} +} + @Book{ katz_mazur, author = {Katz, Nicholas M. and Mazur, Barry}, title = {Arithmetic moduli of elliptic curves}, @@ -980,6 +1511,18 @@ @Book{ kechris1995 url = {https://doi.org/10.1007/978-1-4612-4190-4} } +@Article{ kelleyVaught1953, + author = {Kelley, J. L. and Vaught, R. L.}, + title = {The positive cone in {Banach} algebras}, + journal = {Trans. Am. Math. Soc.}, + issn = {0002-9947}, + volume = {74}, + pages = {44--55}, + year = {1953}, + language = {English}, + doi = {10.2307/1990847} +} + @Article{ kleiman1979, author = {Kleiman, Steven Lawrence}, title = {Misconceptions about {$K\_X$}}, @@ -991,6 +1534,56 @@ @Article{ kleiman1979 url = {http://dx.doi.org/10.5169/seals-50379} } +@Article{ kleitman1966, + author = {Kleitman, D. J.}, + title = {Families of non-disjoint subsets}, + journal = {J. Comb. Theory}, + fjournal = {Journal of Combinatorial Theory}, + issn = {0097-3165}, + volume = {1}, + year = {1966}, + pages = {153--155}, + language = {English}, + doi = {10.1016/S0021-9800(66)80012-1}, + zbl = {0141.00801} +} + +@Article{ KoukoulopoulosMaynard2020, + author = {Koukoulopoulos, Dimitris and Maynard, James}, + title = {On the {D}uffin-{S}chaeffer conjecture}, + journal = {Ann. of Math. (2)}, + fjournal = {Annals of Mathematics. Second Series}, + volume = {192}, + year = {2020}, + number = {1}, + pages = {251--307}, + issn = {0003-486X}, + mrclass = {11J83 (05C40)}, + mrnumber = {4125453}, + mrreviewer = {Sam Chow}, + doi = {10.4007/annals.2020.192.1.5}, + url = {https://doi.org/10.4007/annals.2020.192.1.5} +} + +@Article{ kozen1994, + title = {A Completeness Theorem for Kleene Algebras and the Algebra + of Regular Events}, + journal = {Information and Computation}, + volume = {110}, + number = {2}, + pages = {366-390}, + year = {1994}, + issn = {0890-5401}, + doi = {https://doi.org/10.1006/inco.1994.1037}, + url = {https://www.sciencedirect.com/science/article/pii/S0890540184710376}, + author = {D. Kozen}, + abstract = {We give a finitary axiomatization of the algebra of + regular events involving only equations and equational + implications. Unlike Salomaa′s axiomatizations, the + axiomatization given here is sound for all interpretations + over Kleene algebras.} +} + @Article{ lazarus1973, author = {Michel Lazarus}, title = {Les familles libres maximales d'un module ont-elles le @@ -1064,7 +1657,25 @@ @Article{ markowsky1976 author = {Markowsky, George}, year = {1976}, month = {Dec}, - pages = {53–68} + pages = {53-68} +} + +@InProceedings{ mathlib2020, + author = {The mathlib Community}, + title = {The Lean Mathematical Library}, + year = {2020}, + isbn = {9781450370974}, + publisher = {Association for Computing Machinery}, + address = {New York, NY, USA}, + url = {https://doi.org/10.1145/3372885.3373824}, + doi = {10.1145/3372885.3373824}, + booktitle = {Proceedings of the 9th ACM SIGPLAN International + Conference on Certified Programs and Proofs}, + pages = {367-381}, + numpages = {15}, + keywords = {formal proof, formal library, Lean, mathlib}, + location = {New Orleans, LA, USA}, + series = {CPP 2020} } @InProceedings{ mcbride1996, @@ -1076,6 +1687,31 @@ @InProceedings{ mcbride1996 organization = {Springer} } +@Book{ mccrimmon2004, + author = {Kevin {McCrimmon}}, + title = {{A taste of Jordan algebras}}, + fjournal = {{Universitext}}, + journal = {{Universitext}}, + issn = {0172-5939}, + isbn = {0-387-95447-3}, + pages = {xxvi + 562}, + year = {2004}, + publisher = {New York, NY: Springer}, + language = {English}, + doi = {10.1007/b97489}, + msc2010 = {17-01 17Cxx}, + zbl = {1044.17001} +} + +@Misc{ melikhov2011, + title = {Metrizable uniform spaces}, + author = {Sergey A. Melikhov}, + year = {2011}, + eprint = {1106.3249}, + archiveprefix = {arXiv}, + primaryclass = {math.GT} +} + @Book{ MeyerNieberg1991, author = {Meyer-Nieberg, Peter}, title = {Banach lattices}, @@ -1323,6 +1959,23 @@ @Article{ orosi2018faulhaber zbl = {1411.41023} } +@InCollection{ petridis2014, + author = {Petridis, G.}, + title = {The {Pl{\"u}nnecke}-{Ruzsa} inequality: an overview}, + booktitle = {Combinatorial and additive number theory. Selected papers + based on the presentations at the conferences CANT 2011 and + 2012, New York, NY, USA, May 2011 and May 2012}, + isbn = {978-1-4939-1600-9; 978-1-4939-1601-6}, + pages = {229--241}, + year = {2014}, + publisher = {New York, NY: Springer}, + language = {English}, + doi = {10.1007/978-1-4939-1601-6_16}, + keywords = {11B30}, + zblath = {6463830}, + zbl = {1371.11029} +} + @Article{ phillips1940, author = {Phillips, Ralph S.}, title = {Integration in a convex linear topological space}, @@ -1367,6 +2020,12 @@ @Book{ riehl2017 url = {http://www.math.jhu.edu/~eriehl/context.pdf} } +@Misc{ RisingSea, + author = "Vakil, Ravi", + title = "{The Rising Sea: Foundations Of Algebraic Geometry Notes}", + url = "https://math.stanford.edu/~vakil/216blog/" +} + @Book{ rudin2006real, title = {Real and Complex Analysis}, author = {Rudin, Walter}, @@ -1376,6 +2035,21 @@ @Book{ rudin2006real isbn = {0-07-100276-6} } +@Article{ salwinski2018, + author = {Salwinski, David}, + title = {Euler's sine product formula: an elementary proof}, + journal = {College Math. J.}, + fjournal = {The College Mathematics Journal}, + volume = {49}, + year = {2018}, + number = {2}, + pages = {126--135}, + issn = {0746-8342}, + mrclass = {26A06 (00A05)}, + mrnumber = {3766700}, + doi = {10.1080/07468342.2018.1419703} +} + @Book{ samuel1967, author = {Samuel, Pierre}, title = {Th\'{e}orie alg\'{e}brique des nombres}, @@ -1423,6 +2097,22 @@ @Book{ seligman1967 mrreviewer = {R. E. Block} } +@Article{ serre1951, + author = {Serre, Jean-Pierre}, + title = {Homologie singuli\`ere des espaces fibr\'{e}s. + {A}pplications}, + journal = {Ann. of Math. (2)}, + year = {1951}, + volume = {54}, + pages = {425--505}, + issn = {0003-486X}, + doi = {10.2307/1969485}, + fjournal = {Annals of Mathematics. Second Series}, + mrclass = {56.0X}, + mrnumber = {0045386}, + mrreviewer = {W. S. Massey} +} + @Book{ serre1965, author = {Serre, Jean-Pierre}, title = {Complex semisimple {L}ie algebras}, @@ -1433,8 +2123,15 @@ @Book{ serre1965 isbn = {0-387-96569-6}, mrclass = {17-01 (17B20)}, mrnumber = {914496}, - doi = {10.1007/978-1-4757-3910-7}, - url = {https://doi.org/10.1007/978-1-4757-3910-7} + doi = {10.1007/978-1-4757-3910-7} +} + +@Book{ silverman2009, + author = {Silverman, Joseph}, + publisher = {Springer New York, NY}, + series = {Graduate Texts in Mathematics}, + title = {The Arithmetic of Elliptic Curves}, + year = {2009} } @Book{ simon2011, @@ -1448,6 +2145,17 @@ @Book{ simon2011 collection = {Cambridge Tracts in Mathematics} } +@Article{ skoda2006, + author = {{\v{S}}koda, Zoran}, + title = {Noncommutative localization in noncommutative geometry}, + journal = {London Math. Soc. Lecture Note Series}, + fjournal = {London Mathematical Society Lecture Note Series}, + volume = {330}, + pages = {220--313}, + year = {2006}, + url = {https://doi.org/10.48550/arXiv.math/0403276} +} + @Book{ soare1987, author = {Soare, Robert I.}, title = {Recursively enumerable sets and degrees}, @@ -1464,7 +2172,30 @@ @Book{ soare1987 doi = {10.1007/978-3-662-02460-7} } -@book{ stanley2012, +@InProceedings{ srl_itp, + author = {Dillies, Ya\"{e}l and Mehta, Bhavik}, + title = {{Formalising Szemer\'{e}di’s Regularity Lemma in Lean}}, + booktitle = {13th International Conference on Interactive Theorem + Proving (ITP 2022)}, + pages = {9:1--9:19}, + series = {Leibniz International Proceedings in Informatics + (LIPIcs)}, + isbn = {978-3-95977-252-5}, + issn = {1868-8969}, + year = {2022}, + volume = {237}, + editor = {Andronick, June and de Moura, Leonardo}, + publisher = {Schloss Dagstuhl -- Leibniz-Zentrum f{\"u}r Informatik}, + address = {Dagstuhl, Germany}, + url = {https://drops.dagstuhl.de/opus/volltexte/2022/16718}, + urn = {urn:nbn:de:0030-drops-167185}, + doi = {10.4230/LIPIcs.ITP.2022.9}, + annote = {Keywords: Lean, formalisation, formal proof, graph theory, + combinatorics, additive combinatorics, Szemer\'{e}di’s + Regularity Lemma, Roth’s Theorem} +} + +@Book{ stanley2012, author = {Stanley, Richard P.}, title = {Enumerative combinatorics}, place = {Cambridge}, @@ -1472,6 +2203,19 @@ @book{ stanley2012 year = {2012} } +@Book{ stern2009, + author = {Stern, Manfred}, + title = {Semimodular lattices. {Theory} and applications}, + edition = {Reprint of the 1999 hardback ed.}, + isbn = {978-0-521-11884-2}, + year = {2009}, + publisher = {Cambridge: Cambridge University Press}, + language = {English}, + keywords = {06C10,06-02,06A07}, + zbmath = {5610899}, + zbl = {1175.06002} +} + @Article{ Stone1935, author = {Stone, M. H.}, year = {1935}, @@ -1499,6 +2243,21 @@ @Article{ Stone1979 mrreviewer = {J. Segal} } +@Book{ tao-vu, + author = {Tao, Terence and Vu, Van H.}, + title = {Additive combinatorics}, + fseries = {Cambridge Studies in Advanced Mathematics}, + series = {Camb. Stud. Adv. Math.}, + volume = {105}, + isbn = {0-521-85386-9}, + year = {2006}, + publisher = {Cambridge: Cambridge University Press}, + language = {English}, + keywords = {11-02,05-02,05D10,05D40,11B75,11B13,11N13,11P70,11K31,11P82,28D05,37A45}, + zbmath = {5066399}, + zbl = {1127.11002} +} + @Book{ tao2010, author = {Tao, Terence}, title = {An Epsilon of Room, I: Real Analysis: Pages from Year @@ -1519,6 +2278,33 @@ @Book{ Tent_Ziegler collection = {Lecture Notes in Logic} } +@Article{ tochiori_bertrand, + author = {Tochiori, Shigenori}, + title = {Considering the Proof of "There is a Prime between n and + 2n"}, + subtitle = {Proof by a stronger estimation than the Bertrand-Chebyshev + theorem}, + language = {Japanese}, + url = {https://www.chart.co.jp/subject/sugaku/suken_tsushin/76/76-8.pdf} +} + +@Book{ upmeier1987, + author = {Harald {Upmeier}}, + title = {{Jordan algebras in analysis, operator theory, and quantum + mechanics}}, + fjournal = {{Regional Conference Series in Mathematics}}, + journal = {{Reg. Conf. Ser. Math.}}, + issn = {0160-7642}, + volume = {67}, + isbn = {0-8218-0717-X}, + pages = {viii + 85}, + year = {1987}, + publisher = {Providence, RI: American Mathematical Society (AMS)}, + language = {English}, + msc2010 = {17-02 46-02 17C65 46H70 32M15 46G20 46L70 47B35 81Q99}, + zbl = {0608.17013} +} + @Article{ Vaisala_2003, author = {Jussi Väisälä}, title = {A Proof of the Mazur-Ulam Theorem}, @@ -1568,6 +2354,24 @@ @Misc{ wedhorn_adic eprint = {arXiv:1910.05934} } +@Book{ weidmann_linear, + author = {Weidmann, Joachim}, + title = {Linear operators in {H}ilbert spaces}, + isbn = {0-387-90427-1}, + series = {Graduate Texts in Mathematics}, + volume = {68}, + note = {Translated from the German by Joseph Sz\"{u}cs}, + publisher = {Springer}, + year = {1980}, + pages = {xiii+402} +} + +@Misc{ welzl_garter, + author = {Emo Welzl and Bernd G\"{a}rtner}, + title = {Cone Programming}, + url = {https://ti.inf.ethz.ch/ew/lehre/ApproxSDP09/notes/conelp.pdf} +} + @TechReport{ zaanen1966, author = {Zaanen, A. C.}, title = {Lectures on "Riesz Spaces"}, diff --git a/docs/tutorial/category_theory/Ab.lean b/docs/tutorial/category_theory/Ab.lean index cc6dc64ffed42..f62da617aa52d 100644 --- a/docs/tutorial/category_theory/Ab.lean +++ b/docs/tutorial/category_theory/Ab.lean @@ -3,7 +3,7 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import algebra.category.Group +import algebra.category.Group.abelian import category_theory.limits.shapes.kernels noncomputable theory diff --git a/docs/tutorial/category_theory/calculating_colimits_in_Top.lean b/docs/tutorial/category_theory/calculating_colimits_in_Top.lean index d7d33ac9f1391..5892030933eb5 100644 --- a/docs/tutorial/category_theory/calculating_colimits_in_Top.lean +++ b/docs/tutorial/category_theory/calculating_colimits_in_Top.lean @@ -1,5 +1,4 @@ -import topology.category.Top.limits -import category_theory.limits.shapes +import topology.category.Top.limits.basic import topology.instances.real import topology.tactic diff --git a/docs/tutorial/representation_theory/etingof.lean b/docs/tutorial/representation_theory/etingof.lean new file mode 100644 index 0000000000000..61e788b05c04f --- /dev/null +++ b/docs/tutorial/representation_theory/etingof.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import category_theory.simple +import category_theory.subobject.basic +import category_theory.preadditive.schur +import algebra.algebra.restrict_scalars +import algebra.algebra.tower +import algebra.category.Module.algebra +import algebra.category.Module.images +import algebra.category.Module.biproducts +import algebra.category.Module.simple +import linear_algebra.matrix.finite_dimensional +import data.mv_polynomial.basic +import algebra.free_algebra +import data.complex.module + +/-! +# "Introduction to representation theory" by Etingof + +This tutorial file follows along with the lecture notes "Introduction to representation theory", +by Pavel Etingof and other contributors. + +These lecture notes are available freely online at . + +This tutorial is (extremely) incomplete at present. +The goal is to work through the lecture notes, +showing how to use the definitions and results from mathlib +to establish the results in Etingof's notes. (We are not giving separate proofs here!) + +Our intention is (sadly) to skip all the problems, and many of the examples. + +Often results are proved by reference to (much) more general facts in mathlib. +-/ + +axiom skipped {p : Sort*} : p + +universes u +open category_theory finite_dimensional + +noncomputable theory + +/-! +## Chapter 2 "Basic notions of representation theory" +-/ + +/-! +### 2.2 "Algebras" +-/ + +-- Definition 2.2.1: An associative algebra. +variables {k : Type*} [field k] +variables {A : Type*} [ring A] [algebra k A] + +-- Etingof uses the word "unit" to refer to the identity in an algebra. +-- Currently in mathlib all algebras are unital +-- (although non-unital rings exists as `non_unital_ring`) +-- Thus we skip Definition 2.2.2 and Proposition 2.2.3 + +-- Example 2.2.4 (1)-(5) +example : algebra k k := by apply_instance +example {X : Type*} [fintype X] : algebra k (mv_polynomial X k) := by apply_instance +example {V : Type*} [add_comm_group V] [module k V] : algebra k (V →ₗ[k] V) := by apply_instance +example {X : Type*} : algebra k (free_algebra k X) := by apply_instance +example {G : Type*} [group G] : algebra k (monoid_algebra k G) := by apply_instance + +-- Definition 2.2.5: A commutative algebra is described as: +example {A : Type*} [comm_ring A] [algebra k A] := true + +-- Definition 2.2.6: algebra homomorphisms: +example {B : Type*} [ring B] [algebra k B] (f : A →ₐ[k] B) := true + +/-! +## 2.3 "Representations" +-/ + +-- Definition 2.3.1 +-- A representation (of an associative algebra) will usually be described as a module. +variables {M : Type*} [add_comm_group M] [module k M] [module A M] [is_scalar_tower k A M] + +-- or we can use `Module A`, for a "bundled" `A`-module, +-- which is useful when we want access to the category theory library. +variables (N : Module.{u} A) + +-- We can translate between these easily: +-- "bundle" a type with appropriate typeclasses +example : Module A := Module.of A M +-- a "bundled" module has a coercion to `Type`, +-- that comes equipped with the appropriate typeclasses: +example : module A N := by apply_instance + +-- Remark 2.3.2: Right `A`-modules are handled as left `Aᵐᵒᵖ`-modules: +example : Module Aᵐᵒᵖ := Module.of Aᵐᵒᵖ A +-- Right modules are not extensively developed in mathlib at this point, +-- and you may run into difficulty using them. + +-- It is helpful when working with `Module` to run +open_locale Module +-- which adds some instances. + +-- Example 2.3.3 +-- (1) The zero module +example : Module A := Module.of A punit +-- (2) The left regular module +example : Module A := Module.of A A +-- (3) Modules over a field are vector spaces. +-- (Because we handle vector spaces as modules in mathlib, this is empty of content.) +example (V : Type*) [add_comm_group V] [module k V] : Module k := Module.of k V +-- (4) is trickier, +-- and we would probably want to formalise as an equivalence of categories, +-- because "it's hard to get back to where we started". +example (X : Type*) : Module (free_algebra k X) ≃ Σ (V : Module k), X → (V ⟶ V) := skipped + +-- Definition 2.3.4 +-- A subrepresentation can be described using `submodule`, +variables (S : submodule A M) +-- or using the category theory library either as a monomorphism +variables (S' : Module.{u} A) (i : S' ⟶ N) [mono i] +-- or a subobject (defined as an isomorphism class of monomorphisms) +variables (S'' : subobject N) + +-- Definition 2.3.5: We express that a representation is "irreducible" using `simple`. +example (N : Module A) : Prop := simple N +-- there's also a predicate for unbundled modules: +example : simple (Module.of A M) ↔ is_simple_module A M := simple_iff_is_simple_module + +-- Definition 2.3.6: homomorphisms, intertwiners, isomorphisms +-- For unbundled representations, we use linear maps: +variables {M' : Type*} [add_comm_group M'] [module k M'] [module A M'] [is_scalar_tower k A M'] +variables (f : M →ₗ[A] M') +-- while for bundled representations we use the categorical morphism arrow: +variables (N₁ N₂ : Module.{u} A) (g : N₁ ⟶ N₂) +-- For isomorphisms, use one of +variables (e : M ≃ₗ[A] M') (j : N₁ ≅ N₂) + +-- Definition 2.3.7: direct sum +example : module A (M × M') := by apply_instance +example (N₁ N₂ : Module.{u} A) : Module.{u} A := N₁ ⊞ N₂ +example (N₁ N₂ : Module.{u} A) : N₁ ⊞ N₂ ≅ Module.of A (N₁ × N₂) := Module.biprod_iso_prod N₁ N₂ + +-- Definition 2.3.8: indecomposable +example (N : Module A) : Prop := indecomposable N +example (N : Module A) [simple N] : indecomposable N := indecomposable_of_simple N + +-- Proposition 2.3.9 (Schur's lemma) +example (N₁ N₂ : Module.{u} A) [simple N₁] (f : N₁ ⟶ N₂) (w : f ≠ 0) : mono f := +mono_of_nonzero_from_simple w +example (N₁ N₂ : Module.{u} A) [simple N₂] (f : N₁ ⟶ N₂) (w : f ≠ 0) : epi f := +epi_of_nonzero_to_simple w +example (N₁ N₂ : Module.{u} A) [simple N₁] [simple N₂] (f : N₁ ⟶ N₂) (w : f ≠ 0) : is_iso f := +is_iso_of_hom_simple w + +-- Corollary 2.3.10 (Schur's lemma over an algebraically closed field) +-- Unfortunately these can't be global instances +example [is_alg_closed k] (V : Module.{u} A) [simple V] [finite_dimensional k V] (f : V ⟶ V) : + ∃ φ : k, φ • 𝟙 V = f := +endomorphism_simple_eq_smul_id k f +-- Note that some magic is going on behind the scenes in this proof. +-- We're using a version of Schur's lemma that applies to any `k`-linear category, +-- and its hypotheses include `finite_dimensional k (V ⟶ V)` +-- rather than `finite_dimensional k V` (because `V` need not even be a vector space). +-- Typeclass inference is automatically generating this fact. + +-- Remark 2.3.11 (Schur's lemma doesn't hold over a non-algebraically closed field) +example : simple (Module.of ℂ ℂ) := simple_of_finrank_eq_one (finrank_self ℂ) +example : finite_dimensional ℝ (Module.of ℂ ℂ) := by { dsimp, apply_instance, } +example : + let V := Module.of ℂ ℂ in + ∃ (f : V ⟶ V), ∀ φ : ℝ, (φ : ℂ) • 𝟙 V ≠ f := +⟨algebra.lsmul ℂ ℂ complex.I, + λ φ w, by simpa using congr_arg complex.im (linear_map.congr_fun w (1 : ℂ))⟩ + +-- Corollary 2.3.12 +-- Every irreducible finite dimensional representation of a commutative algebra is 1-dimensional +example (A : Type*) [comm_ring A] [algebra k A] (V : Module A) [finite_dimensional k V] [simple V] : + finrank k V = 1 := +skipped + +-- Remark 2.3.13: Every 1-dimensional representation is irreducible +example (V : Module A) [finite_dimensional k V] (h : finrank k V = 1) : simple V := +simple_of_finrank_eq_one h + +-- Example 2.3.14: skipped (1 and 3 we can do, 2 requires Jordan normal form) + +/-! +## 2.4 "Ideals" +-/ + +-- To be continued... diff --git a/docs/undergrad.yaml b/docs/undergrad.yaml index 3b3c790f4345b..3008a9394dd97 100644 --- a/docs/undergrad.yaml +++ b/docs/undergrad.yaml @@ -9,7 +9,7 @@ Linear algebra: vector subspace: 'subspace' quotient space: 'submodule.has_quotient' sum of subspaces: 'submodule.complete_lattice' - direct sum: 'direct_sum.submodule_is_internal' + direct sum: 'direct_sum.is_internal' complementary subspaces: 'submodule.exists_is_compl' linear independence: 'linear_independent' generating sets: 'submodule.span' @@ -28,7 +28,7 @@ Linear algebra: Finite-dimensional vector spaces: finite-dimensionality : 'finite_dimensional' isomorphism with $K^n$: 'basis.equiv_fun' - rank of a linear map: 'rank' + rank of a linear map: 'linear_map.rank' rank of a set of vectors: 'set.finrank' rank of a system of linear equations: 'https://www.math.tamu.edu/~fnarc/psfiles/rank2005.pdf' isomorphism with bidual: 'module.eval_equiv' @@ -51,7 +51,7 @@ Linear algebra: Gaussian elimination: 'https://en.wikipedia.org/wiki/Gaussian_elimination' row-reduced matrices: 'https://en.wikipedia.org/wiki/Row_echelon_form#Reduced_row_echelon_form' Endomorphism polynomials: - annihilating polynomials: 'https://en.wikipedia.org/wiki/Minimal_polynomial_(linear_algebra)#Formal_definition' + annihilating polynomials: 'polynomial.ann_ideal' minimal polynomial: 'minpoly' characteristic polynomial: 'matrix.charpoly' Cayley-Hamilton theorem: 'matrix.aeval_self_charpoly' @@ -67,7 +67,7 @@ Linear algebra: Jordan normal form: 'https://en.wikipedia.org/wiki/Jordan_normal_form' Linear representations: irreducible representation: 'https://en.wikipedia.org/wiki/Irreducible_representation' - Schur's lemma: 'https://en.wikipedia.org/wiki/Schur%27s_lemma' + Schur's lemma: 'fdRep.finrank_hom_simple_simple' examples: '' Exponential: endomorphism exponential: '' @@ -92,7 +92,7 @@ Group Theory: conjugacy classes: 'conj_classes' Abelian group: cyclic group: 'is_cyclic' - finite type abelian groups: 'https://en.wikipedia.org/wiki/Finitely_generated_abelian_group#Classification' + finite type abelian groups: 'add_comm_group.equiv_free_prod_direct_sum_zmod' complex roots of unity: 'complex.mem_roots_of_unity' primitive complex roots of unity: 'complex.is_primitive_root_iff' Permutation group: @@ -111,12 +111,12 @@ Group Theory: Representation theory of finite groups: representations of abelian groups: 'https://proofwiki.org/wiki/Irreducible_Representations_of_Abelian_Group' dual groups: 'https://kconrad.math.uconn.edu/blurbs/grouptheory/charthy.pdf' - Maschke theorem: 'https://en.wikipedia.org/wiki/Maschke%27s_theorem' - orthogonality of irreducible characters: 'https://en.wikipedia.org/wiki/Schur_orthogonality_relations' + Maschke theorem: 'monoid_algebra.submodule.exists_is_compl' + orthogonality of irreducible characters: 'fdRep.char_orthonormal' Fourier transform for finite abelian groups: 'https://en.wikipedia.org/wiki/Fourier_transform_on_finite_groups#Fourier_transform_for_finite_abelian_groups' convolution: 'https://en.wikipedia.org/wiki/Fourier_transform_on_finite_groups#Transform_of_a_convolution' class function over a group: 'https://en.wikipedia.org/wiki/Class_function' - characters of a finite dimensional representation: 'https://en.wikipedia.org/wiki/Character_theory' + characters of a finite dimensional representation: 'fdRep.character' orthonormal basis of irreducible characters: 'https://en.wikipedia.org/wiki/Character_theory#Orthogonality_relations' examples of groups with small cardinality: '' @@ -162,7 +162,7 @@ Ring Theory: polynomial algebra in one or several indeterminates over a commutative ring: 'mv_polynomial' roots of a polynomial: 'polynomial.roots' multiplicity: 'polynomial.root_multiplicity' - relationship between the coefficients and the roots of a split polynomial: 'https://en.wikipedia.org/wiki/Vieta%27s_formulas' + relationship between the coefficients and the roots of a split polynomial: 'polynomial.coeff_eq_esymm_roots_of_card' Newton's identities: 'https://en.wikipedia.org/wiki/Newton%27s_identities' polynomial derivative: 'polynomial.derivative' decomposition into sums of homogeneous polynomials: 'mv_polynomial.sum_homogeneous_component' @@ -216,16 +216,16 @@ Bilinear and Quadratic Forms Over a Vector Space: dual isomorphism in the euclidean case: 'inner_product_space.to_dual' orthogonal complement: 'submodule.orthogonal' Cauchy-Schwarz inequality: 'inner_mul_inner_self_le' - norm: 'inner_product_space.of_core.to_has_norm' + norm: 'inner_product_space.core.to_has_norm' orthonormal bases: 'maximal_orthonormal_iff_basis_of_finite_dimensional' Endomorphisms: - orthogonal group: '' - unitary group: '' + orthogonal group: 'matrix.orthogonal_group' + unitary group: 'matrix.unitary_group' special orthogonal group: '' special unitary group: '' - self-adjoint endomorphism: 'inner_product_space.is_self_adjoint' + self-adjoint endomorphism: 'is_self_adjoint' normal endomorphism: 'https://en.wikipedia.org/wiki/Normal_operator' - diagonalization of a self-adjoint endomorphism: 'inner_product_space.is_self_adjoint.diagonalization_basis_apply_self_apply' + diagonalization of a self-adjoint endomorphism: 'linear_map.is_symmetric.diagonalization_basis_apply_self_apply' diagonalization of normal endomorphisms: 'https://en.wikipedia.org/wiki/Spectral_theorem#Normal_matrices' simultaneous diagonalization of two real quadratic forms, with one positive-definite: 'https://fr.wikipedia.org/wiki/Th%C3%A9or%C3%A8me_spectral#Formalisation_alg%C3%A9brique' decomposition of an orthogonal transformation as a product of reflections: 'linear_isometry_equiv.reflections_generate' @@ -244,7 +244,7 @@ Affine and Euclidean Geometry: affine function: 'affine_map' affine subspace: 'affine_subspace' barycenter: 'finset.affine_combination' - affine span: 'span_points' + affine span: 'affine_span' equations of affine subspace: '' affine groups: 'affine_equiv.group' affine property: 'https://en.wikipedia.org/wiki/Affine_transformation#Properties' @@ -263,7 +263,7 @@ Affine and Euclidean Geometry: angles between vectors: 'inner_product_geometry.angle' angles between planes: '' inscribed angle theorem: '' - cocyclicity: '' + cocyclicity: 'euclidean_geometry.concyclic' group of isometries stabilizing a subset of the plane or of space: '' regular polygons: '' metric relations in the triangle: '' @@ -289,7 +289,7 @@ Single Variable Real Analysis: metric structure: 'real.metric_space' completeness of R: 'real.complete_space' Bolzano-Weierstrass theorem: 'tendsto_subseq_of_bounded' - compact subsets of $\R$: 'metric.compact_iff_closed_bounded' + compact subsets of $\R$: 'metric.is_compact_iff_is_closed_bounded' connected subsets of $\R$: 'set_of_is_preconnected_eq_of_ordered' additive subgroups of $\R$: 'real.subgroup_dense_or_cyclic' Numerical series: @@ -323,7 +323,7 @@ Single Variable Real Analysis: Taylor-like theorems: Taylor's theorem with little-o remainder: "https://en.wikipedia.org/wiki/Taylor%27s_theorem#Taylor's_theorem_in_one_real_variable" Taylor's theorem with integral form for remainder: 'https://en.wikipedia.org/wiki/Taylor%27s_theorem#Explicit_formulas_for_the_remainder' - Taylor's theorem with Lagrange form for remainder: 'https://en.wikipedia.org/wiki/Taylor%27s_theorem#Explicit_formulas_for_the_remainder' + Taylor's theorem with Lagrange form for remainder: 'taylor_mean_remainder_lagrange' Taylor series expansions: 'https://en.wikipedia.org/wiki/Taylor_series' Elementary functions (trigonometric, rational, $\exp$, $\log$, etc): polynomial functions: 'polynomial.eval' @@ -337,20 +337,21 @@ Single Variable Real Analysis: inverse hyperbolic trigonometric functions: 'real.arsinh' Integration: integral over a segment of piecewise continuous functions: '' - antiderivatives: 'https://en.wikipedia.org/wiki/Antiderivative' Riemann sums: 'box_integral.integral_sum' - antiderivative of a continuous function: 'interval_integral.integral_has_strict_deriv_at_of_tendsto_ae_right' + antiderivative of a continuous function: 'continuous.deriv_integral' change of variable: 'interval_integral.integral_comp_smul_deriv' integration by parts: 'interval_integral.integral_mul_deriv_eq_deriv_mul' improper integrals: 'https://en.wikipedia.org/wiki/Improper_integral' absolute vs conditional convergence of improper integrals: 'https://en.wikipedia.org/wiki/Conditional_convergence' comparison test for improper integrals: 'https://mathbooks.unl.edu/Calculus/sec-5-11-comparison.html' Sequences and series of functions: - pointwise convergence: 'https://en.wikipedia.org/wiki/Pointwise_convergence' + pointwise convergence: 'tendsto_pi_nhds' uniform convergence: 'tendsto_uniformly' normal convergence: 'https://en.wikipedia.org/wiki/Normal_convergence' - continuity of the limit: 'continuous_of_uniform_approx_of_continuous' - differentiability of the limit: 'https://en.wikipedia.org/wiki/Uniform_convergence#To_differentiability' + continuity of the limit of a sequence of functions: 'continuous_of_uniform_approx_of_continuous' + continuity of the sum of a series of functions: 'continuous_tsum' + differentiability of the limit of a sequence of functions: 'has_fderiv_at_of_tendsto_uniformly' + differentiability of the sum of a series of functions: 'differentiable_tsum' Weierstrass polynomial approximation theorem: 'polynomial_functions_closure_eq_top' Weierstrass trigonometric approximation theorem: 'span_fourier_closure_eq_top' Convexity: @@ -368,27 +369,32 @@ Single Variable Complex Analysis: differentiability with respect to the complex variable: 'has_fpower_series_on_ball.differentiable_on' antiderivative: '' complex exponential: 'complex.exp' - extension of trigonometric functions to the complex plane: 'complex.sin' - power series expansion of elementary functions: '' + extension of trigonometric functions to the complex plane: + cos: 'complex.cos' + sin: 'complex.sin' + power series expansion of elementary functions: + cos: 'complex.has_sum_cos' + sin: 'complex.has_sum_sin' + log: '' Functions on one complex variable: - holomorphic functions: '' + holomorphic functions: 'differentiable_on' Cauchy-Riemann conditions: '' contour integrals of continuous functions in $\C$: '' antiderivatives of a holomorphic function: '' representations of the $\log$ function on $\C$: '' theorem of holomorphic functions under integral domains: '' winding number of a closed curve in $\C$ with respect to a point: '' - Cauchy formulas: '' - analyticity of a holomorphic function: '' - principle of isolated zeros: '' - principle of analytic continuation: '' - maximum principle: '' + Cauchy formulas: 'complex.two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable' + analyticity of a holomorphic function: 'differentiable_on.analytic_at' + principle of isolated zeros: 'analytic_at.eventually_eq_zero_or_eventually_ne_zero' + principle of analytic continuation: 'analytic_on.eq_on_of_preconnected_of_frequently_eq' + maximum principle: 'complex.eventually_eq_of_is_local_max_norm' isolated singularities: '' Laurent series: '' meromorphic functions: '' residue theorem: '' sequences and series of holomorphic functions: '' - holomorphic stability under uniform convergence: '' + holomorphic stability under uniform convergence: 'tendsto_locally_uniformly_on.differentiable_on' # 8. Topology: @@ -401,7 +407,7 @@ Topology: continuous functions: 'continuous' homeomorphisms: 'homeomorph' compactness in terms of open covers (Borel-Lebesgue): 'is_compact_iff_finite_subcover' - sequential compactness is equivalent to compactness (Bolzano-Weierstrass): 'uniform_space.compact_iff_seq_compact' + sequential compactness is equivalent to compactness (Bolzano-Weierstrass): 'uniform_space.is_compact_iff_is_seq_compact' connectedness: 'connected_space' connected components: 'connected_component' path connectedness: 'is_path_connected' @@ -435,7 +441,7 @@ Topology: inner product space $L^2$: 'measure_theory.L2.inner_product_space' its completeness: 'measure_theory.Lp.complete_space' Hilbert bases: 'hilbert_basis' # the document specifies "in the separable case" but we don't require this - example, the Hilbert basis of trigonometric polynomials: 'fourier_series' + example, the Hilbert basis of trigonometric polynomials: 'fourier_basis' example, classical Hilbert bases of orthogonal polynomials: '' Lax-Milgram theorem: 'is_coercive.continuous_linear_equiv_of_bilin' $H^1_0([0,1])$ and its application to the one-dimensional Dirichlet problem: '' @@ -464,7 +470,7 @@ Multivariable calculus: inverse function theorem: 'has_strict_deriv_at.to_local_inverse' implicit function theorem: 'implicit_function_data.implicit_function' Differential equations: - Cauchy-Lipschitz Theorem: 'exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous' + Cauchy-Lipschitz Theorem: 'exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof' maximal solutions: '' Grönwall lemma: 'norm_le_gronwall_bound_of_norm_deriv_right_le' exit theorem of a compact subspace: '' @@ -499,7 +505,7 @@ Measures and integral calculus: Lebesgue measure: 'measure_theory.measure_space' product measure: 'measurable_space.pi' measurable functions: 'measurable' - approximation by step functions: 'measure_theory/simple_func_dense.html' + approximation by step functions: 'measure_theory.simple_func.tendsto_approx_on' Integration: integral of positive measurable functions: 'measure_theory.lintegral' monotone convergence theorem: 'measure_theory.lintegral_infi_ae' @@ -514,17 +520,18 @@ Measures and integral calculus: Holder's inequality: 'nnreal.lintegral_mul_le_Lp_mul_Lq' Fubini's theorem: 'measure_theory.integral_prod' change of variables for multiple integrals: 'measure_theory.integral_image_eq_integral_abs_det_fderiv_smul' - change of variables to polar co-ordinates: '' + change of variables to polar co-ordinates: 'integral_comp_polar_coord_symm ' change of variables to spherical co-ordinates: '' - convolution: '' - regularization and approximation by convolution: '' + convolution: 'convolution' + approximation by convolution: 'cont_diff_bump.convolution_tendsto_right' + regularization by convolution: 'has_compact_support.cont_diff_convolution_left' Fourier analysis: - Fourier series of locally integrable periodic real-valued functions: '' - Riemann-Lebesgue lemma: '' + Fourier series of locally integrable periodic real-valued functions: 'fourier_basis' + Riemann-Lebesgue lemma: 'tendsto_integral_exp_smul_cocompact' convolution product of periodic functions: '' Dirichlet theorem: '' Fejer theorem: '' - Parseval theorem: 'tsum_sq_fourier_series_repr' + Parseval theorem: 'tsum_sq_fourier_coeff' Fourier transforms on $\mathrm{L}^1(\R^d)$ and $\mathrm{L}^2(\R^d)$: '' Plancherel’s theorem: '' @@ -536,9 +543,9 @@ Probability Theory: independent events: 'probability_theory.Indep_set' sigma-algebra: 'measurable_space' independent sigma-algebra: 'probability_theory.Indep' - $0$-$1$ law: '' + $0$-$1$ law: 'probability_theory.measure_zero_or_one_of_measurable_set_limsup_at_top' Borel-Cantelli lemma (easy direction): 'measure_theory.measure_limsup_eq_zero' - Borel-Cantelli lemma (difficult direction): '' + Borel-Cantelli lemma (difficult direction): 'probability_theory.measure_limsup_eq_one' conditional probability: 'probability_theory.cond' law of total probability: '' Random variables and their laws: @@ -547,9 +554,10 @@ Probability Theory: probability density function: 'measure_theory.has_pdf' law of joint probability: '' independence of random variables: 'probability_theory.Indep_fun' - mean and variance of a real-valued random variable: '' + mean of a random variable: 'measure_theory.integral' + variance of a real-valued random variable: 'probability_theory.variance' transfer theorem: '' - moments: '' + moments: 'probability_theory.moment' Bernoulli law: 'pmf.bernoulli' binomial law: '' geometric law: '' @@ -560,7 +568,7 @@ Probability Theory: characteristic function: '' probability generating functions: '' applications of probability generating functions to sums of independent random variables: '' - Convergence of series of random variables: + Convergence of a sequence of random variables: convergence in probability: 'measure_theory.tendsto_in_measure' $\mathrm{L}^p$ convergence: 'measure_theory.Lp' almost surely convergence: 'measure_theory.measure.ae' @@ -568,7 +576,7 @@ Probability Theory: Chebychev inequality: 'probability_theory.meas_ge_le_variance_div_sq' Levy's theorem: '' weak law of large numbers: '' - strong law of large numbers: '' + strong law of large numbers: 'probability_theory.strong_law_ae' central limit theorem: '' # 12. @@ -581,16 +589,18 @@ Distribution calculus: constructing approximations of probability density functions in spaces of common functions (trig, exp, rational, log, etc): '' Distributions on $\R^d$: definition of distributions: '' - locally integrable functions: '' + locally integrable functions as distributions: '' + derivative of a distribution: '' Dirac measures: '' + derivatives of Dirac measures: '' + derivative of the Heaviside function: '' Cauchy principal values: '' multiplication by a smooth function: '' - probability distribution function from a dataset: '' - convergent distribution series: '' + convergence of sequences of distributions: '' support of a distribution: '' Spaces $\mathcal{S}(\R^d)$: - Schwartz space of rapidly decreasing functions: '' - stability by derivation: '' + Schwartz space of rapidly decreasing functions: 'schwartz_map' + stability by derivation: 'schwartz_map.fderiv_clm' stability by multiplication by a slowly growing smooth function: '' gaussian functions: '' Fourier transforms on $\mathcal{S}(\R^d)$: '' diff --git a/leanpkg.toml b/leanpkg.toml index fd2566a831ddc..fe8a559a3a6f7 100644 --- a/leanpkg.toml +++ b/leanpkg.toml @@ -1,7 +1,7 @@ [package] name = "mathlib" version = "0.1" -lean_version = "leanprover-community/lean:3.42.1" +lean_version = "leanprover-community/lean:3.51.1" path = "src" [dependencies] diff --git a/roadmap/topology/paracompact.lean b/roadmap/topology/paracompact.lean index a5a4d718bb9ba..f0e05be5efbfd 100644 --- a/roadmap/topology/paracompact.lean +++ b/roadmap/topology/paracompact.lean @@ -55,7 +55,7 @@ lemma paracompact_of_compact {X : Type u} [topological_space X] [compact_space X begin refine ⟨λ α u uo uc, _⟩, obtain ⟨s, _, sf, sc⟩ := - compact_univ.elim_finite_subcover_image (λ a _, uo a) (by rwa [univ_subset_iff, bUnion_univ]), + is_compact_univ.elim_finite_subcover_image (λ a _, uo a) (by rwa [univ_subset_iff, bUnion_univ]), refine ⟨s, λ b, u b.val, λ b, uo b.val, _, _, λ b, ⟨b.val, subset.refl _⟩⟩, { todo }, { intro x, diff --git a/roadmap/topology/shrinking_lemma.lean b/roadmap/topology/shrinking_lemma.lean index 9996716905781..5b7f6e108871d 100644 --- a/roadmap/topology/shrinking_lemma.lean +++ b/roadmap/topology/shrinking_lemma.lean @@ -34,7 +34,7 @@ cover so that the closure of each new open set is contained in the corresponding set. -/ lemma roadmap.shrinking_lemma {X : Type u} [topological_space X] [normal_space X] {s : set X} (hs : is_closed s) {α : Type v} (u : α → set X) (uo : ∀ a, is_open (u a)) - (uf : ∀ x, finite {a | x ∈ u a}) (su : s ⊆ Union u) : + (uf : ∀ x, {a | x ∈ u a}.finite) (su : s ⊆ Union u) : ∃ v : α → set X, s ⊆ Union v ∧ ∀ a, is_open (v a) ∧ closure (v a) ⊆ u a := todo /- diff --git a/scripts/add_port_comments.py b/scripts/add_port_comments.py new file mode 100644 index 0000000000000..366942aa8640f --- /dev/null +++ b/scripts/add_port_comments.py @@ -0,0 +1,133 @@ +from mathlibtools.file_status import PortStatus, FileStatus +from pathlib import Path + +import re +from dataclasses import asdict, dataclass +from typing import Any, Dict, Optional, Union +import textwrap + +import requests +import yaml + +status = PortStatus.deserialize_old() + +src_path = Path(__file__).parent.parent / 'src' +archive_path = Path(__file__).parent.parent / 'archive' +counterexamples_path = Path(__file__).parent.parent / 'counterexamples' + +def make_comment(fstatus): + return textwrap.dedent(f"""\ + > THIS FILE IS SYNCHRONIZED WITH MATHLIB4. + > Any changes to this file require a corresponding PR to mathlib4.""") + +def replace_range(src: str, pos: int, end_pos: int, new: str) -> str: + return src[:pos] + new + src[end_pos:] + +def find_module_comment(s: str) -> Optional[re.Match]: + """ find a doc-comment, even if it contains nested comments """ + start_marker = re.compile('/-!').search(s) + if not start_marker: + return None + + depth = 1 + ind = start_marker.end() + while depth > 0: + marker = re.compile(r'(/-)|(-/)').search(s, pos=ind) + if not marker: + raise ValueError('Could not find end of comment') + ind = marker.end() + if marker.group(1): + depth += 1 + else: + depth -= 1 + + # Create a new match with sensible captures + m = re.compile('/-!(.*)-/', re.MULTILINE | re.DOTALL).fullmatch(s, start_marker.start(), marker.end()) + assert m, s[start_marker.start():marker.end()] + return m + + +class NoModuleDocstringError(ValueError): pass + +def add_port_status(fcontent: str, fstatus: FileStatus) -> str: + module_comment = find_module_comment(fcontent) + if not module_comment: + raise NoModuleDocstringError() + + module_comment_start = module_comment.start(1) + module_comment_end = module_comment.end(1) + module_comment = module_comment.group(1) + + # replace any markers that appear at the start of the docstring + module_comment = re.compile( + r"\A\n((?:> )?)THIS FILE IS SYNCHRONIZED WITH MATHLIB4\." + r"(?:\n\1[^\n]+)*\n?", + re.MULTILINE + ).sub('', module_comment) + + # markers which appear with two blank lines before + module_comment = re.compile( + r"\n{,2}((?:> )?)THIS FILE IS SYNCHRONIZED WITH MATHLIB4\." + r"(?:\n\1[^\n]+)*", + re.MULTILINE + ).sub('', module_comment) + + # find the header + header_re = re.compile('(#[^\n]*)', re.MULTILINE) + existing_header = header_re.search(module_comment) + if existing_header: + # insert a comment below the header + module_comment = replace_range(module_comment, existing_header.end(1), existing_header.end(1), + "\n\n" + make_comment(f_status)) + else: + # insert the comment at the top + module_comment = "\n" + make_comment(f_status) + "\n" + module_comment + + # and insert the new module docstring + fcontent = replace_range(fcontent, module_comment_start, module_comment_end, module_comment) + + return fcontent + +def fname_for(import_path: str) -> Path: + for root in [src_path, archive_path, counterexamples_path]: + p = root / Path(*import_path.split('.')).with_suffix('.lean') + if p.exists(): + return p + # used only for error messages, a best-guess + return src_path / Path(*import_path.split('.')).with_suffix('.lean') + + +missing_docstrings = [] +missing_files = [] +for iname, f_status in status.file_statuses.items(): + if f_status.ported: + fname = fname_for(iname) + try: + with open(fname) as f: + fcontent = f.read() + except FileNotFoundError: + missing_files.append((iname, fname)) + continue + try: + new_fcontent = add_port_status(fcontent, f_status) + except NoModuleDocstringError: + missing_docstrings.append((iname, fname)) + continue + if new_fcontent == fcontent: + continue + print(f'* `{iname}`') + with open(fname, 'w') as f: + f.write(new_fcontent) +if missing_docstrings: + print('\n---') + print('The following files have no module docstring, so I have not added a message in this PR') + for iname, fname in missing_docstrings: + print(f'* [`{iname}`](https://github.com/leanprover-community/mathlib/blob/master/{fname})') + print('\nPlease make a PR to add a module docstring (for Lean3 and Lean4!), then I will add the freeze comment next time.') +if missing_files: + print('\n---') + print('The following files no longer exist in Lean 3\' mathlib, so I have not added a message in this PR') + for iname, fname in missing_files: + f_status = status.file_statuses[iname] + print(f'* [`{iname}`](https://github.com/leanprover-community/mathlib/blob/{f_status.mathlib3_hash}/{fname})') + print('\nIn future we should find where they moved to, and check that the files are still in sync.') diff --git a/scripts/detect_errors.py b/scripts/detect_errors.py index 1a57dc5ca1d93..395638defebc4 100644 --- a/scripts/detect_errors.py +++ b/scripts/detect_errors.py @@ -11,10 +11,9 @@ def encode_msg_text_for_github(msg): def format_msg(msg): # Formatted for https://github.com/actions/toolkit/blob/master/docs/commands.md#log-level - # mapping between lean severity levels and github levels. - # github does not support info levels, which are emitted by `#check` etc: + # See also # https://docs.github.com/en/actions/reference/workflow-commands-for-github-actions#setting-a-debug-message - severity_map = {'information': 'warning'} + severity_map = {'information': 'notice'} severity = msg.get('severity') severity = severity_map.get(severity, severity) diff --git a/scripts/detect_ported_files.py b/scripts/detect_ported_files.py new file mode 100644 index 0000000000000..869ad027e7b9f --- /dev/null +++ b/scripts/detect_ported_files.py @@ -0,0 +1,33 @@ +# this script is only intended to be run by CI +import sys +import os +from pathlib import Path + +from mathlibtools.file_status import PortStatus, FileStatus + +status = PortStatus.deserialize_old() + +src_path = Path(__file__).parent.parent / 'src' + +def encode_msg_text_for_github(msg): + # even though this is probably url quoting, we match the implementation at + # https://github.com/actions/toolkit/blob/af821474235d3c5e1f49cee7c6cf636abb0874c4/packages/core/src/command.ts#L36-L94 + return msg.replace('%', '%25').replace('\r', '%0D').replace('\n', '%0A') + +def fname_for(import_path: str) -> Path: + return src_path / Path(*import_path.split('.')).with_suffix('.lean') + +if __name__ == '__main__': + files = [Path(f) for f in sys.argv[1:]] + modifies_ported = False + for iname, f_status in status.file_statuses.items(): + if f_status.ported: + fname = fname_for(iname) + if fname in files: + modifies_ported = True + msg = ("Changes to this file will need to be ported to mathlib 4!\n" + "Please consider retracting the changes to this file unless you are willing " + "to immediately forward-port them." ) + print(f"::warning file={fname},line=1,col=1::{encode_msg_text_for_github(msg)}") + with open(os.environ['GITHUB_OUTPUT'], 'a') as fh: + print(f'modifies_ported={modifies_ported}', file=fh) diff --git a/scripts/lint-bib.sh b/scripts/lint-bib.sh new file mode 100755 index 0000000000000..630f64c625db2 --- /dev/null +++ b/scripts/lint-bib.sh @@ -0,0 +1,8 @@ +#!/usr/bin/env bash + +set -exo pipefail +# https://leanprover-community.github.io/contribute/doc.html#citing-other-works +cp docs/references.bib docs/references.bib.old +bibtool --preserve.key.case=on --preserve.keys=on --pass.comments=on --print.use.tab=off -s \ + -i docs/references.bib -o docs/references.bib +diff -U8 docs/references.bib.old docs/references.bib diff --git a/scripts/lint-style.py b/scripts/lint-style.py index 85b83a6edc72c..c644ebe292a35 100755 --- a/scripts/lint-style.py +++ b/scripts/lint-style.py @@ -44,6 +44,7 @@ ERR_UNF = 10 # unfreeze_local_instances WRN_IND = 11 # indentation WRN_BRC = 12 # curly braces +ERR_NST = 13 # explicit reference to instance vars (_inst_1, etc) exceptions = [] @@ -80,6 +81,8 @@ exceptions += [(WRN_IND, path)] if errno == "WRN_BRC": exceptions += [(WRN_BRC, path)] + if errno == "ERR_NST": + exceptions += [(ERR_NST, path)] new_exceptions = False @@ -127,6 +130,13 @@ def small_alpha_vrachy_check(lines, path): errors += [(ERR_SAV, line_nr, path)] return errors +def instance_check(lines, path): + errors = [] + for line_nr, line in skip_string(skip_comments(enumerate(lines, 1))): + if re.search(r'\b(? 0 and in_prf == 0: @@ -206,7 +216,7 @@ def indent_check(lines, path): check_rest_of_block = False indent_lvl += 2 in_prf += 1 - if re.match("\bend\b", line) is not None: + if re.search("\bend\b", line) is not None: indent_lvl -= 2 in_prf -= 1 indent_lvl += 2 * line.count('{') # potential innocent(?) clash with set-builder notation @@ -356,6 +366,8 @@ def format_errors(errors): output_message(path, line_nr, "WRN_IND", "Probable indentation mistake in proof") if errno == WRN_BRC: output_message(path, line_nr, "WRN_BRC", "Probable misformatting of curly braces") + if errno == ERR_NST: + output_message(path, line_nr, "ERR_NST", "Explicit reference to implicit instance variable name (e.g. _inst_1)") def lint(path): with path.open(encoding="utf-8") as f: @@ -382,6 +394,8 @@ def lint(path): format_errors(errs) errs = unfreeze_local_instances_check(lines, path) format_errors(errs) + errs = instance_check(lines, path) + format_errors(errs) for filename in sys.argv[1:]: lint(Path(filename)) diff --git a/scripts/list-attributes.sh b/scripts/list-attributes.sh new file mode 100755 index 0000000000000..eb83da538a10c --- /dev/null +++ b/scripts/list-attributes.sh @@ -0,0 +1,15 @@ +#!/usr/bin/env bash + +# This script generates the data for mathlib#18164 + +URL_BASE="https://github.com/leanprover-community/mathlib/blob" +SHA=$(git rev-parse HEAD) + +IFS=":" +git grep -n "local attribute \[semireducible\]\|attribute \[irreducible\]" | \ + grep -v 'src/tactic\|src/meta\|test' | \ + while read fn ln rest; do + grep --silent "SYNCHRONIZED WITH MATHLIB4" $fn || \ + echo "$URL_BASE/$SHA/$fn#L$ln" + done + diff --git a/scripts/mk_all.sh b/scripts/mk_all.sh index b9679e7211308..718163249628e 100755 --- a/scripts/mk_all.sh +++ b/scripts/mk_all.sh @@ -18,9 +18,9 @@ fi # remove an initial `./` # replace an initial `../test/` with just `.` (similarly for `roadmap`/`archive`/...) -# replace all `/` with `.` -# strip the `.lean` suffix -# prepend `import ` +# replace all `/` with `».«` +# replace the `.lean` suffix with `»` +# prepend `import «` find "$dir" -name \*.lean -not -name all.lean \ - | sed 's,^\./,,;s,^\.\./[^/]*,,;s,/,.,g;s,\.lean$,,;s,^,import ,' \ + | sed 's,^\./,,;s,^\.\./[^/]*,,;s,/,».«,g;s,\.lean$,»,;s,^,import «,' \ | sort >"$dir"/all.lean diff --git a/scripts/modules_used.lean b/scripts/modules_used.lean new file mode 100644 index 0000000000000..43348c2a6b221 --- /dev/null +++ b/scripts/modules_used.lean @@ -0,0 +1,103 @@ +import all +import system.io +import tactic.algebra + +/-! +# Find all imported modules which are used by the declarations in the target module. + +``` +lean --run scripts/modules_used.lean data.nat.order.basic +``` + +returns + +``` +order.synonym +order.rel_classes +order.monotone.basic +order.lattice +order.heyting.basic +order.bounded_order +order.boolean_algebra +order.basic +logic.nontrivial +logic.nonempty +logic.is_empty +logic.function.basic +logic.equiv.defs +logic.basic +data.subtype +data.set.basic +data.nat.order.basic +data.nat.cast.defs +data.nat.basic +algebra.ring.defs +algebra.order.zero_le_one +algebra.order.sub.defs +algebra.order.sub.canonical +algebra.order.ring.lemmas +algebra.order.ring.defs +algebra.order.ring.canonical +algebra.order.monoid.lemmas +algebra.order.monoid.defs +algebra.order.monoid.canonical.defs +algebra.order.monoid.cancel.defs +algebra.group_with_zero.defs +algebra.group.defs +algebra.group.basic +algebra.covariant_and_contravariant +``` + +This is useful for finding imports which might be removable. +-/ + +open tactic declaration environment io io.fs + +meta def tactic.get_decls_used (env : environment) : name → name_set → tactic name_set +| n ns := if ns.contains n then pure ns else (do + d ← env.get n, + -- Add `n` to the accumulated name set. + let ns := ns.insert n, + -- Run `get_decls_used` on any ancestors of `n` (if `n` is a structure) + ancestors ← get_ancestors n, + ns ← ancestors.mfoldl (λ ns n, tactic.get_decls_used n ns) ns, + -- Now traverse the body of the declaration, processing any constants. + let process (v : expr) : tactic (name_set) := + v.fold (pure ns) $ λ e _ r, r >>= λ ns, + if e.is_constant then tactic.get_decls_used e.const_name ns else pure ns, + match d with + | (declaration.defn _ _ _ v _ _) := process v + | (declaration.thm _ _ _ v) := process v.get + | _ := pure ns + end) <|> (do + trace format!"Error while processing: {n}", + pure ns) + +meta def tactic.get_modules_used_by_theorems_in (tgt : string) : tactic (list string) := +do env ← tactic.get_env, + ns ← env.fold (pure mk_name_set) (λ d r, + if env.decl_olean d.to_name = some tgt then + r >>= tactic.get_decls_used env d.to_name + else r), + let mods := ns.fold native.mk_rb_set (λ n mods, + match env.decl_olean n with + | some mod := mods.insert mod + | none := mods + end), + pure mods.to_list.reverse + +meta def main : io unit := do + [arg] ← io.cmdline_args, + tgt' ← io.run_tactic ((lean.parser.ident).run_with_input arg), + let tgt := module_info.resolve_module_name tgt', + let home_len := tgt.length - (tgt'.length + 5), + let project := ((tgt.to_list.take home_len)).as_string, + run_tactic $ do + files ← tactic.get_modules_used_by_theorems_in tgt, + -- Only return files in the same project. + let files := (files.filter_map (λ s, s.get_rest project)), + -- Convert paths to imports, e.g. `data/nat/order/basic.lean` -> `data.nat.order.basic`. + -- ... the string library is not exactly featureful. + let files := files.map (λ s, ((s.to_list.reverse.drop 5).reverse.as_string.split_on '/').foldl + (λ n s, name.mk_string s n) name.anonymous), + files.mmap' trace diff --git a/scripts/nolints.txt b/scripts/nolints.txt index 90505df64e22a..c9d8104dc89b1 100644 --- a/scripts/nolints.txt +++ b/scripts/nolints.txt @@ -1,53 +1,12 @@ import .all run_cmd tactic.skip --- algebra/big_operators/fin.lean -apply_nolint fin.prod_univ_cast_succ to_additive_doc -apply_nolint fin.prod_univ_succ to_additive_doc -apply_nolint fin.prod_univ_succ_above to_additive_doc - --- algebra/category/Group/limits.lean -apply_nolint CommGroup.category_theory.forget₂.category_theory.creates_limit to_additive_doc -apply_nolint CommGroup.forget_preserves_limits to_additive_doc -apply_nolint CommGroup.forget₂_CommMon_preserves_limits to_additive_doc -apply_nolint CommGroup.forget₂_Group_preserves_limits to_additive_doc -apply_nolint CommGroup.has_limits to_additive_doc - -- algebra/free_algebra.lean apply_nolint free_algebra.semiring check_reducibility --- algebra/hom/freiman.lean -apply_nolint freiman_hom.has_coe_to_fun to_additive_doc - --- algebra/hom/group.lean -apply_nolint monoid_hom.ext_iff to_additive_doc -apply_nolint monoid_hom.map_inv to_additive_doc -apply_nolint monoid_hom.map_mul_inv to_additive_doc -apply_nolint mul_hom.ext_iff to_additive_doc -apply_nolint one_hom.comp_assoc to_additive_doc - --- algebra/order/group.lean -apply_nolint left.inv_le_one_iff to_additive_doc -apply_nolint left.inv_lt_one_iff to_additive_doc -apply_nolint left.one_le_inv_iff to_additive_doc -apply_nolint left.one_lt_inv_iff to_additive_doc -apply_nolint right.inv_le_one_iff to_additive_doc -apply_nolint right.one_le_inv_iff to_additive_doc - --- algebra/order/lattice_group.lean -apply_nolint lattice_ordered_comm_group.mabs_mul_le to_additive_doc - -- category_theory/limits/filtered_colimit_commutes_finite_limit.lean apply_nolint category_theory.limits.colimit_limit_to_limit_colimit_is_iso fails_quickly --- combinatorics/additive/salem_spencer.lean -apply_nolint mul_salem_spencer.decidable to_additive_doc - --- combinatorics/hindman.lean -apply_nolint hindman.FP.mul to_additive_doc -apply_nolint hindman.FP_partition_regular to_additive_doc -apply_nolint hindman.exists_FP_of_finite_cover to_additive_doc - -- computability/partrec.lean apply_nolint computable doc_blame apply_nolint computable₂ doc_blame @@ -59,12 +18,10 @@ apply_nolint partrec doc_blame apply_nolint partrec₂ doc_blame -- computability/primrec.lean -apply_nolint nat.cases doc_blame -apply_nolint nat.elim doc_blame -apply_nolint nat.primrec'.vec doc_blame -apply_nolint nat.unpaired doc_blame -apply_nolint primcodable.of_equiv doc_blame -apply_nolint primcodable.subtype doc_blame +apply_nolint primrec.dom_fintype fintype_finite + +-- computability/turing_machine.lean +apply_nolint turing.TM1to1.exists_enc_dec fintype_finite -- control/basic.lean apply_nolint is_comm_applicative doc_blame @@ -96,8 +53,6 @@ apply_nolint monoid.mfoldr.of_free_monoid doc_blame apply_nolint traversable.fold_map doc_blame apply_nolint traversable.foldl doc_blame apply_nolint traversable.foldr doc_blame -apply_nolint traversable.free.map doc_blame -apply_nolint traversable.free.mk doc_blame apply_nolint traversable.length doc_blame apply_nolint traversable.map_fold doc_blame apply_nolint traversable.mfoldl doc_blame @@ -105,7 +60,7 @@ apply_nolint traversable.mfoldr doc_blame -- control/monad/cont.lean apply_nolint cont doc_blame -apply_nolint cont_t has_inhabited_instance doc_blame +apply_nolint cont_t has_nonempty_instance doc_blame apply_nolint cont_t.map doc_blame apply_nolint cont_t.monad_lift doc_blame apply_nolint cont_t.run doc_blame @@ -115,7 +70,7 @@ apply_nolint except_t.mk_label doc_blame apply_nolint is_lawful_monad_cont doc_blame apply_nolint monad_cont doc_blame apply_nolint monad_cont.goto doc_blame -apply_nolint monad_cont.label has_inhabited_instance doc_blame +apply_nolint monad_cont.label has_nonempty_instance doc_blame apply_nolint option_t.call_cc doc_blame apply_nolint option_t.mk_label doc_blame apply_nolint reader_t.call_cc doc_blame @@ -131,7 +86,7 @@ apply_nolint except_t.pass_aux doc_blame apply_nolint option_t.pass_aux doc_blame apply_nolint swap_right doc_blame apply_nolint writer doc_blame -apply_nolint writer_t has_inhabited_instance doc_blame +apply_nolint writer_t has_nonempty_instance doc_blame apply_nolint writer_t.adapt doc_blame apply_nolint writer_t.bind doc_blame apply_nolint writer_t.ext unused_arguments @@ -168,29 +123,16 @@ apply_nolint tactic.interactive.traverse_constructor unused_arguments apply_nolint tactic.interactive.traverse_field unused_arguments apply_nolint tactic.interactive.with_prefix doc_blame --- data/analysis/filter.lean -apply_nolint cfilter has_inhabited_instance -apply_nolint cfilter.to_realizer doc_blame -apply_nolint filter.realizer has_inhabited_instance -apply_nolint filter.realizer.of_eq doc_blame - --- data/analysis/topology.lean -apply_nolint compact.realizer has_inhabited_instance doc_blame unused_arguments -apply_nolint ctop has_inhabited_instance -apply_nolint ctop.realizer has_inhabited_instance -apply_nolint ctop.realizer.id doc_blame -apply_nolint ctop.realizer.nhds doc_blame -apply_nolint ctop.realizer.nhds_F unused_arguments -apply_nolint ctop.realizer.nhds_σ unused_arguments -apply_nolint ctop.realizer.of_equiv doc_blame -apply_nolint ctop.to_realizer doc_blame -apply_nolint locally_finite.realizer has_inhabited_instance doc_blame - --- data/finset/noncomm_prod.lean -apply_nolint finset.noncomm_prod_union_of_disjoint to_additive_doc - --- data/fintype/card.lean -apply_nolint fin.prod_univ_eq_prod_range to_additive_doc +-- data/fintype/card_embedding.lean +apply_nolint fintype.card_embedding_eq_of_infinite fintype_finite + +-- data/fintype/order.lean +apply_nolint directed.fintype_le fintype_finite +apply_nolint fintype.bdd_above_range fintype_finite +apply_nolint fintype.exists_le fintype_finite + +-- data/fintype/small.lean +apply_nolint small_of_fintype fintype_finite -- data/fp/basic.lean apply_nolint fp.div_nat_lt_two_pow doc_blame unused_arguments @@ -225,7 +167,7 @@ apply_nolint int.shift2 doc_blame -- data/holor.lean apply_nolint holor.assoc_left doc_blame apply_nolint holor.assoc_right doc_blame -apply_nolint holor_index has_inhabited_instance +apply_nolint holor_index has_nonempty_instance apply_nolint holor_index.assoc_left doc_blame apply_nolint holor_index.assoc_right doc_blame apply_nolint holor_index.drop doc_blame @@ -237,13 +179,14 @@ apply_nolint list.sublists_aux doc_blame apply_nolint list.sublists_aux₁ doc_blame apply_nolint list.traverse doc_blame --- data/list/perm.lean -apply_nolint list.perm.prod_eq' to_additive_doc +-- data/matrix/basis.lean +apply_nolint matrix.induction_on fintype_finite +apply_nolint matrix.induction_on' fintype_finite -- data/multiset/functor.lean apply_nolint multiset.traverse doc_blame --- data/nat/basic.lean +-- data/nat/order/lemmas.lean apply_nolint nat.subtype.order_bot fails_quickly -- data/num/bitwise.lean @@ -354,7 +297,6 @@ apply_nolint rbnode.is_bad_red_black doc_blame apply_nolint computation.bind.F doc_blame apply_nolint computation.bind.G doc_blame apply_nolint computation.bisim_o doc_blame -apply_nolint computation.cases_on doc_blame apply_nolint computation.corec.F doc_blame apply_nolint computation.is_bisimulation doc_blame apply_nolint computation.lift_rel_aux doc_blame @@ -368,29 +310,6 @@ apply_nolint computation.parallel.aux1 doc_blame apply_nolint computation.parallel.aux2 doc_blame apply_nolint computation.parallel_rec doc_blame --- data/seq/seq.lean -apply_nolint seq.bisim_o doc_blame -apply_nolint seq.cases_on doc_blame -apply_nolint seq.corec.F doc_blame -apply_nolint seq.is_bisimulation doc_blame -apply_nolint seq.mem doc_blame - --- data/seq/wseq.lean -apply_nolint wseq.bisim_o doc_blame -apply_nolint wseq.cases_on doc_blame -apply_nolint wseq.destruct_append.aux doc_blame -apply_nolint wseq.destruct_join.aux doc_blame -apply_nolint wseq.drop.aux doc_blame -apply_nolint wseq.lift_rel_o doc_blame -apply_nolint wseq.mem doc_blame -apply_nolint wseq.tail.aux doc_blame -apply_nolint wseq.think_congr unused_arguments - --- data/set/pointwise.lean -apply_nolint set.set_semiring.comm_semiring check_reducibility -apply_nolint set.set_semiring.non_assoc_semiring check_reducibility -apply_nolint set.set_semiring.non_unital_non_assoc_semiring check_reducibility - -- data/stream/defs.lean apply_nolint stream.corec doc_blame apply_nolint stream.corec' doc_blame @@ -400,88 +319,12 @@ apply_nolint stream.unfolds doc_blame -- data/stream/init.lean apply_nolint stream.is_bisimulation doc_blame --- deprecated/group.lean -apply_nolint is_group_hom.comp to_additive_doc -apply_nolint is_group_hom.id to_additive_doc -apply_nolint is_group_hom.injective_iff to_additive_doc -apply_nolint is_group_hom.inv to_additive_doc -apply_nolint is_group_hom.map_inv to_additive_doc -apply_nolint is_group_hom.map_one to_additive_doc -apply_nolint is_group_hom.mk' to_additive_doc -apply_nolint is_group_hom.mul to_additive_doc -apply_nolint is_group_hom.to_is_monoid_hom to_additive_doc -apply_nolint is_monoid_hom.comp to_additive_doc -apply_nolint is_monoid_hom.id to_additive_doc -apply_nolint is_monoid_hom.inv to_additive_doc -apply_nolint is_monoid_hom.map_mul to_additive_doc -apply_nolint is_mul_hom.inv to_additive_doc -apply_nolint is_mul_hom.mul to_additive_doc -apply_nolint is_mul_hom.to_is_monoid_hom to_additive_doc -apply_nolint mul_equiv.is_monoid_hom to_additive_doc -apply_nolint mul_equiv.is_mul_hom to_additive_doc - --- deprecated/subfield.lean -apply_nolint is_subfield doc_blame - --- deprecated/subring.lean -apply_nolint ring.closure doc_blame - --- group_theory/coset.lean -apply_nolint subgroup.card_subgroup_dvd_card to_additive_doc - --- group_theory/group_action/basic.lean -apply_nolint mul_action.quotient_preimage_image_eq_union_mul to_additive_doc - --- group_theory/group_action/defs.lean -apply_nolint comp_smul_left to_additive_doc -apply_nolint has_mul.to_has_scalar to_additive_doc -apply_nolint mul_action.regular.is_pretransitive to_additive_doc -apply_nolint mul_smul_comm to_additive_doc -apply_nolint one_smul_eq_id to_additive_doc - --- group_theory/group_action/group.lean -apply_nolint mul_action.to_perm_injective to_additive_doc - --- group_theory/group_action/opposite.lean -apply_nolint has_mul.to_has_opposite_scalar to_additive_doc -apply_nolint left_cancel_monoid.to_has_faithful_opposite_scalar to_additive_doc -apply_nolint monoid.to_opposite_mul_action to_additive_doc - --- group_theory/group_action/pi.lean -apply_nolint function.has_scalar to_additive_doc -apply_nolint function.smul_comm_class to_additive_doc -apply_nolint pi.has_faithful_scalar_at to_additive_doc - -- group_theory/group_action/sub_mul_action.lean apply_nolint sub_mul_action.has_zero fails_quickly --- group_theory/order_of_element.lean -apply_nolint image_range_order_of to_additive_doc -apply_nolint is_of_fin_order_iff_coe to_additive_doc -apply_nolint order_of_eq_of_pow_and_pow_div_prime to_additive_doc -apply_nolint pow_gcd_card_eq_one_iff to_additive_doc - --- group_theory/specific_groups/cyclic.lean -apply_nolint is_cyclic_of_prime_card to_additive_doc -apply_nolint is_simple_group_of_prime_card to_additive_doc - --- group_theory/subgroup/basic.lean -apply_nolint monoid_hom.eq_on_closure to_additive_doc -apply_nolint subgroup.bot_or_exists_ne_one to_additive_doc -apply_nolint subgroup.bot_or_nontrivial to_additive_doc -apply_nolint subgroup.commute_of_normal_of_disjoint to_additive_doc -apply_nolint subgroup.is_commutative.comm_group to_additive_doc -apply_nolint subgroup.map_injective_of_ker_le to_additive_doc - --- group_theory/submonoid/basic.lean -apply_nolint monoid_hom.eq_on_mclosure to_additive_doc - --- group_theory/sylow.lean -apply_nolint sylow.fixed_points_mul_left_cosets_equiv_quotient doc_blame - --- linear_algebra/affine_space/affine_subspace.lean -apply_nolint affine_span.nonempty fails_quickly -apply_nolint affine_subspace.to_add_torsor fails_quickly +-- linear_algebra/affine_space/matrix.lean +apply_nolint affine_basis.affine_independent_of_to_matrix_right_inv fintype_finite +apply_nolint affine_basis.affine_span_eq_top_of_to_matrix_left_inv fintype_finite -- logic/relator.lean apply_nolint relator.bi_total doc_blame @@ -492,24 +335,6 @@ apply_nolint relator.lift_fun doc_blame apply_nolint relator.right_total doc_blame apply_nolint relator.right_unique doc_blame --- measure_theory/group/prod.lean -apply_nolint measure_theory.map_prod_inv_mul_eq to_additive_doc -apply_nolint measure_theory.map_prod_inv_mul_eq_swap to_additive_doc -apply_nolint measure_theory.map_prod_mul_inv_eq to_additive_doc -apply_nolint measure_theory.measure_lintegral_div_measure to_additive_doc -apply_nolint measure_theory.measure_mul_lintegral_eq to_additive_doc - --- measure_theory/measure/haar.lean -apply_nolint measure_theory.measure.haar.haar_content_self to_additive_doc -apply_nolint measure_theory.measure.haar.index_defined to_additive_doc -apply_nolint measure_theory.measure.haar.is_left_invariant_haar_content to_additive_doc -apply_nolint measure_theory.measure.haar_measure_unique to_additive_doc -apply_nolint measure_theory.measure.is_haar_measure_haar_measure to_additive_doc -apply_nolint measure_theory.measure.map_haar_inv to_additive_doc -apply_nolint measure_theory.measure.regular_haar_measure to_additive_doc -apply_nolint measure_theory.measure.regular_of_is_mul_left_invariant to_additive_doc -apply_nolint measure_theory.measure.sigma_finite_haar_measure to_additive_doc - -- meta/coinductive_predicates.lean apply_nolint monotonicity doc_blame apply_nolint tactic.add_coinductive_predicate doc_blame @@ -535,19 +360,23 @@ apply_nolint tactic.coinductive_predicate doc_blame apply_nolint tactic.interactive.coinduction doc_blame apply_nolint tactic.mono doc_blame --- order/filter/at_top_bot.lean -apply_nolint filter.map_at_top_finset_prod_le_of_prod_eq to_additive_doc +-- model_theory/direct_limit.lean +apply_nolint first_order.language.direct_limit.exists_quotient_mk_sigma_mk_eq fintype_finite +apply_nolint first_order.language.direct_limit.exists_unify_eq fintype_finite + +-- number_theory/class_number/admissible_absolute_value.lean +apply_nolint absolute_value.is_admissible.exists_partition fintype_finite -- order/prime_ideal.lean apply_nolint order.ideal.is_prime.is_maximal fails_quickly --- ring_theory/witt_vector/basic.lean -apply_nolint witt_vector.comm_ring check_reducibility +-- ring_theory/trace.lean +apply_nolint algebra.trace_comp_trace_of_basis fintype_finite -- set_theory/lists.lean apply_nolint finsets doc_blame --- set_theory/zfc.lean +-- set_theory/zfc/basic.lean apply_nolint Set.map_definable_aux unused_arguments -- tactic/abel.lean @@ -557,6 +386,9 @@ apply_nolint tactic.abel.eval_add doc_blame apply_nolint tactic.abel.eval_atom doc_blame apply_nolint tactic.abel.eval_neg doc_blame apply_nolint tactic.abel.eval_smul doc_blame +apply_nolint tactic.abel.int_smul_instg doc_blame +apply_nolint tactic.abel.nat_smul_inst doc_blame +apply_nolint tactic.abel.nat_smul_instg doc_blame apply_nolint tactic.abel.normal_expr doc_blame apply_nolint tactic.abel.normal_expr.e doc_blame apply_nolint tactic.abel.normal_expr.pp doc_blame @@ -573,15 +405,6 @@ apply_nolint tactic.abel.term doc_blame apply_nolint tactic.abel.termg doc_blame apply_nolint tactic.interactive.abel.mode doc_blame --- tactic/alias.lean -apply_nolint tactic.alias.alias_attr doc_blame -apply_nolint tactic.alias.alias_direct doc_blame -apply_nolint tactic.alias.alias_iff doc_blame -apply_nolint tactic.alias.get_alias_target doc_blame -apply_nolint tactic.alias.get_lambda_body doc_blame -apply_nolint tactic.alias.make_left_right doc_blame -apply_nolint tactic.alias.mk_iff_mp_app doc_blame - -- tactic/chain.lean apply_nolint tactic.abstract_if_success doc_blame apply_nolint tactic.chain doc_blame @@ -1027,53 +850,4 @@ apply_nolint tactic.tidy.run_tactics doc_blame -- tactic/transfer.lean apply_nolint tactic.transfer doc_blame apply_nolint transfer.analyse_decls doc_blame -apply_nolint transfer.compute_transfer doc_blame - --- tactic/wlog.lean -apply_nolint tactic.wlog doc_blame - --- topology/algebra/const_mul_action.lean -apply_nolint fintype.properly_discontinuous_smul to_additive_doc -apply_nolint is_open_map_quotient_mk_mul to_additive_doc -apply_nolint t2_space_of_properly_discontinuous_smul_of_t2_space to_additive_doc - --- topology/algebra/constructions.lean -apply_nolint mul_opposite.topological_space to_additive_doc -apply_nolint units.topological_space to_additive_doc - --- topology/algebra/continuous_monoid_hom.lean -apply_nolint continuous_monoid_hom.has_coe_to_fun to_additive_doc - --- topology/algebra/filter_basis.lean -apply_nolint group_filter_basis.is_topological_group to_additive_doc - --- topology/algebra/group.lean -apply_nolint filter.tendsto.inv to_additive_doc -apply_nolint group_topology.complete_semilattice_Inf to_additive_doc -apply_nolint group_topology.continuous_inv' to_additive_doc -apply_nolint group_topology.continuous_mul' to_additive_doc -apply_nolint group_topology.has_Inf to_additive_doc -apply_nolint group_topology.partial_order to_additive_doc -apply_nolint separable_locally_compact_group.sigma_compact_space to_additive_doc -apply_nolint topological_space.positive_compacts.locally_compact_space_of_group to_additive_doc - --- topology/algebra/nonarchimedean/basic.lean -apply_nolint nonarchimedean_group.nonarchimedean_of_emb to_additive_doc -apply_nolint nonarchimedean_group.prod.nonarchimedean_group to_additive_doc -apply_nolint nonarchimedean_group.prod_self_subset to_additive_doc -apply_nolint nonarchimedean_group.prod_subset to_additive_doc - --- topology/algebra/order/compact.lean -apply_nolint continuous.exists_forall_ge_of_has_compact_mul_support to_additive_doc -apply_nolint continuous.exists_forall_le_of_has_compact_mul_support to_additive_doc - --- topology/category/Top/open_nhds.lean -apply_nolint topological_space.open_nhds.map doc_blame - --- topology/uniform_space/completion.lean -apply_nolint Cauchy.extend doc_blame -apply_nolint Cauchy.gen doc_blame -apply_nolint uniform_space.completion.completion_separation_quotient_equiv doc_blame -apply_nolint uniform_space.completion.cpkg doc_blame -apply_nolint uniform_space.completion.extension₂ doc_blame -apply_nolint uniform_space.completion.map₂ doc_blame \ No newline at end of file +apply_nolint transfer.compute_transfer doc_blame \ No newline at end of file diff --git a/scripts/polyrith_sage.py b/scripts/polyrith_sage.py new file mode 100644 index 0000000000000..23f5d0d4a09d5 --- /dev/null +++ b/scripts/polyrith_sage.py @@ -0,0 +1,84 @@ +# This file is part of the `polyrith` tactic in `src/tactic/polyrith.lean`. +# It interfaces between Lean and the Sage web interface. + +import requests +import json +import sys +from os.path import join, dirname + +# These functions are used to format the output of Sage for parsing in Lean. +# They are stored here as a string since they are passed to Sage via the web API. +with open(join(dirname(__file__), "polyrith_sage_helper.py"), encoding='utf8') as f: + polynomial_formatting_functions = f.read() + +# future extensions may change behavior depending on the base type +def type_str(type): + return "QQ" + +def create_query(type: str, n_vars: int, eq_list, goal_type): + """ Create a query to invoke Sage's `MPolynomial_libsingular.lift`. See + https://github.com/sagemath/sage/blob/f8df80820dc7321dc9b18c9644c3b8315999670b/src/sage/rings/polynomial/multi_polynomial_libsingular.pyx#L4472-L4518 + for a description of this method. """ + var_list = ", ".join([f"var{i}" for i in range(n_vars)]) + query = f''' +import json +P = PolynomialRing({type_str(type)}, 'var', {n_vars!r}) +[{var_list}] = P.gens() +gens = {eq_list} +p = P({goal_type}) +I = ideal(gens) +coeffs = p.lift(I) +print(json.dumps([polynomial_to_string(c) for c in coeffs])) +''' + return query + +class EvaluationError(Exception): + def __init__(self, ename, evalue, message='Error in Sage communication'): + self.ename = ename + self.evalue = evalue + self.message = message + super().__init__(self.message) + +def evaluate_in_sage(query: str) -> str: + data = {'code': query} + headers = {'content-type': 'application/x-www-form-urlencoded'} + response = requests.post('https://sagecell.sagemath.org/service', data, headers=headers).json() + if response['success']: + return json.loads(response.get('stdout')) + elif 'execute_reply' in response and 'ename' in response['execute_reply'] and 'evalue' in response['execute_reply']: + raise EvaluationError(response['execute_reply']['ename'], response['execute_reply']['evalue']) + else: + raise Exception(response) + +def main(): + '''The system args contain the following: + 0 - the path to this python file + 1 - a string containing "tt" or "ff" depending on whether polyrith was called with trace enabled + 2 - a string representing the base type of the target + 3 - the number of variables used + 4 - a list of the polynomial hypotheses/proof terms in terms of the variables + 5 - a single polynomial representing the target + + This returns a json object with format: + ``` + { success: bool, + data: Optional[list[str]], + trace: Optional[str], + error_name: Optional[str], + error_value: Optional[str] } + ``` + ''' + command = create_query(sys.argv[2], int(sys.argv[3]), sys.argv[4], sys.argv[5]) + final_query = polynomial_formatting_functions + "\n" + command + if sys.argv[1] == 'tt': # trace dry run enabled + output = dict(success=True, trace=command) + else: + try: + output = dict(success=True, data=evaluate_in_sage(final_query)) + except EvaluationError as e: + output = dict(success=False, error_name=e.ename, error_value=e.evalue) + print(json.dumps(output)) + + +if __name__ == "__main__": + main() diff --git a/scripts/polyrith_sage_helper.py b/scripts/polyrith_sage_helper.py new file mode 100644 index 0000000000000..8da7c5d0c881b --- /dev/null +++ b/scripts/polyrith_sage_helper.py @@ -0,0 +1,67 @@ +# this file will be run by the remote sage server, so should not import local files. +from functools import reduce +from typing import Optional, Iterator +from attr import dataclass +from sage.rings.polynomial.polydict import ETuple + +def mk_app(*args: str) -> str: + return "(" + " ".join(args) + ")" + +def const_to_string(coeff: QQ) -> str: + return mk_app("poly.const", str(coeff.numerator()) + "/" + str(coeff.denominator())) + +def power_to_string(var: int, pow: int) -> str: + assert pow != 0 + var_s = mk_app("poly.var", str(var)) + if pow == 1: + return var_s + return mk_app("poly.pow", var_s, str(pow)) + +@dataclass +class MonomForm: + """ + `MonomForm` stores the string representation of a monomial. + + To cleanly format sums of monomials, we need to be careful with negation: + if the first monomial in a sum is negative, we print the negation symbol; + if a subsequent monomial is negative, we subtract the non-negated version. + `MonomForm` always stores the *positive* representation of a monomial in the `pos_form` field. + If the monomial is in fact negative, it also stores the full (negative) representation + in the `neg_form` field. For instance, putting `-2*x` into a `MonomForm` would store + the representation of `2*x` in `pos_form` and `-2*x` in `neg_form`. + """ + pos_form: str + neg_form: Optional[str] = None + +def sum_to_string(terms: Iterator[MonomForm]) -> str: + try: + first = next(terms) + except StopIteration: + return const_to_string(QQ(0)) + else: + first_form = first.neg_form if first.neg_form is not None else first.pos_form + return reduce( + lambda old, nxt: mk_app("poly.sub" if nxt.neg_form is not None else "poly.add", old, nxt.pos_form), + terms, first_form) + +def monomial_to_string(etuple: ETuple, coeff: QQ) -> MonomForm: + etuple = list(etuple.sparse_iter()) + if abs(coeff) == 1 and len(etuple) > 0: + powforms = [power_to_string(t[0], t[1]) for t in etuple] + pos_form = reduce( + lambda s, t: mk_app("poly.mul", s, t), powforms) + return MonomForm(pos_form, mk_app("poly.neg", pos_form) if coeff < 0 else None) + else: + pos_form = reduce( + lambda s, t: mk_app("poly.mul", s, power_to_string(t[0], t[1])), + etuple, + const_to_string(abs(coeff))) + neg_form = reduce( + lambda s, t: mk_app("poly.mul", s, power_to_string(t[0], t[1])), + etuple, + const_to_string(coeff)) if coeff < 0 else None + return MonomForm(pos_form, neg_form) + + +def polynomial_to_string(p) -> str: + return sum_to_string(monomial_to_string(pows, coeff) for pows, coeff in p.dict().items()) diff --git a/scripts/port_status.py b/scripts/port_status.py new file mode 100755 index 0000000000000..42766e5c9809b --- /dev/null +++ b/scripts/port_status.py @@ -0,0 +1,130 @@ +#!/usr/bin/env python3 +import os +import re +import yaml +import networkx as nx +import subprocess +from urllib.request import urlopen +from mathlibtools.lib import PortStatus, LeanProject, FileStatus +from sys import argv +from pathlib import Path +import shlex + +import_re = re.compile(r"^import ([^ ]*)") +synchronized_re = re.compile(r".*SYNCHRONIZED WITH MATHLIB4.*") +hash_re = re.compile(r"[0-9a-f]*") + +# Not using re.compile as this is passed to git which uses a different regex dialect: +# https://www.sjoerdlangkemper.nl/2021/08/13/how-does-git-diff-ignore-matching-lines-work/ +comment_git_re = r'\`(' + r'|'.join([ + re.escape("> THIS FILE IS SYNCHRONIZED WITH MATHLIB4."), + re.escape("> https://github.com/leanprover-community/mathlib4/pull/") + r"[0-9]*", + re.escape("> Any changes to this file require a corresponding PR to mathlib4."), + r"", +]) + r")" + "\n" + +proj = LeanProject.from_path(Path(__file__).parent.parent) + +def mk_label(path: Path) -> str: + rel = path.relative_to(Path('src')) + return str(rel.with_suffix('')).replace(os.sep, '.') + +graph = nx.DiGraph() + +for path in Path('src').glob('**/*.lean'): + if path.parts[1] in ['tactic', 'meta']: + continue + graph.add_node(mk_label(path)) + +synchronized = dict() + +for path in Path('src').glob('**/*.lean'): + if path.parts[1] in ['tactic', 'meta']: + continue + label = mk_label(path) + for line in path.read_text().split('\n'): + m = import_re.match(line) + if m: + imported = m.group(1) + if imported.startswith('tactic.') or imported.startswith('meta.'): + continue + if imported not in graph.nodes: + if imported + '.default' in graph.nodes: + imported = imported + '.default' + else: + imported = 'lean_core.' + imported + graph.add_edge(imported, label) + if synchronized_re.match(line): + synchronized[label] = True + + +data = PortStatus.deserialize_old().file_statuses +# First make sure all nodes exists in the data set +for node in graph.nodes: + data.setdefault(node, FileStatus()) +yaml.dump(data, Path('port_status.yaml').open('w')) + +allDone = dict() +parentsDone = dict() +verified = dict() +touched = dict() +for node in graph.nodes: + if data[node].mathlib3_hash: + verified[node] = data[node].mathlib3_hash + find_blobs_command = ['git', 'cat-file', '-t', data[node].mathlib3_hash] + hash_type = subprocess.check_output(find_blobs_command) + # the hash_type should be commits mostly, we are not interested in blobs + if b'blob\n' == hash_type: + break + git_command = ['git', 'diff', '--quiet', + f'--ignore-matching-lines={comment_git_re}', + data[node].mathlib3_hash + "..HEAD", "--", "src" + os.sep + node.replace('.', os.sep) + ".lean"] + result = subprocess.run(git_command) + if result.returncode == 1: + git_command.remove('--quiet') + touched[node] = git_command + elif data[node].ported: + print("Bad status for " + node) + print("Expected 'Yes MATHLIB4-PR MATHLIB-HASH'") + ancestors = nx.ancestors(graph, node) + if all(data[imported].ported for imported in ancestors) and not data[node].ported: + allDone[node] = (len(nx.descendants(graph, node)), data[node].comments or "") + else: + if all(data[imported].ported for imported in graph.predecessors(node)) and not data[node].ported: + parentsDone[node] = (len(nx.descendants(graph, node)), data[node].comments or "") + +print('# The following files have all dependencies ported already, and should be ready to port:') +print('# Earlier items in the list are required in more places in mathlib.') +allDone = dict(sorted(allDone.items(), key=lambda item: -item[1][0])) +for k, v in allDone.items(): + if v[1] == "": + print(k) + else: + print(k + " -- " + v[1]) + +print() +print('# The following files have their immediate dependencies ported already, and may be ready to port:') +parentsDone = dict(sorted(parentsDone.items(), key=lambda item: -item[1][0])) +for k, v in parentsDone.items(): + if v[1] == "": + print(k) + else: + print(k + " -- " + v[1]) + +print() +print('# The following files are marked as ported, but do not have a SYNCHRONIZED WITH MATHLIB4 label.') +for node in graph.nodes: + if data[node].ported and not node in synchronized: + print(node + " -- mathlib4#" + str(data[node].mathlib4_pr)) + +print() +print('# The following files are marked as ported, but have not been verified against a commit hash from mathlib.') +for node in graph.nodes: + if data[node].ported and not node in verified: + print(node) + +if len(touched) > 0: + print() + print('# The following files have been modified since the commit at which they were verified.') + for v in touched.values(): + print(' '.join(shlex.quote(vi) for vi in v)) diff --git a/scripts/required_imports.lean b/scripts/required_imports.lean new file mode 100644 index 0000000000000..842868dac3c5d --- /dev/null +++ b/scripts/required_imports.lean @@ -0,0 +1,28 @@ +import all +import system.io + +meta def decls_used_in : declaration → name_set → name_set +| d ns := + let process (v : expr) : name_set := + v.fold ns $ λ e _ ns, if e.is_constant then ns.insert e.const_name else ns in + match d with + | (declaration.defn _ _ _ v _ _) := process v + | (declaration.thm _ _ _ v) := process v.get + | _ := ns + end + +meta def main : io unit := do + env ← io.run_tactic tactic.get_env, + let map := env.fold (native.rb_map.mk string name_set) (λ d map, + match env.decl_olean d.to_name with + | some tgt := map.insert tgt (decls_used_in d ((map.find tgt).get_or_else mk_name_set)) + | none := map + end), + map.mfold () $ λ mod ns _, do + io.print_ln sformat!"module: {mod}", + let mods := ns.fold (native.mk_rb_set) (λ n mods, match env.decl_olean n with + | some tgt := mods.insert tgt + | none := mods + end), + mods.mfold () $ λ mod _, do + io.print_ln sformat!"needs: {mod}" diff --git a/scripts/style-exceptions.txt b/scripts/style-exceptions.txt index bf4a542d5bb7f..c04c94940278a 100644 --- a/scripts/style-exceptions.txt +++ b/scripts/style-exceptions.txt @@ -1,35 +1,25 @@ -src/category_theory/limits/cones.lean : line 11 : ERR_MOD : Module docstring missing, or too late -src/category_theory/limits/creates.lean : line 8 : ERR_MOD : Module docstring missing, or too late -src/category_theory/limits/types.lean : line 10 : ERR_MOD : Module docstring missing, or too late -src/category_theory/monad/adjunction.lean : line 9 : ERR_MOD : Module docstring missing, or too late -src/category_theory/monad/basic.lean : line 10 : ERR_MOD : Module docstring missing, or too late -src/control/basic.lean : line 9 : ERR_MOD : Module docstring missing, or too late +src/control/basic.lean : line 10 : ERR_MOD : Module docstring missing, or too late src/control/monad/cont.lean : line 13 : ERR_MOD : Module docstring missing, or too late src/control/monad/writer.lean : line 11 : ERR_MOD : Module docstring missing, or too late -src/control/traversable/derive.lean : line 10 : ERR_MOD : Module docstring missing, or too late -src/data/analysis/filter.lean : line 9 : ERR_MOD : Module docstring missing, or too late -src/data/analysis/topology.lean : line 10 : ERR_MOD : Module docstring missing, or too late +src/control/traversable/derive.lean : line 11 : ERR_MOD : Module docstring missing, or too late src/data/array/lemmas.lean : line 9 : ERR_MOD : Module docstring missing, or too late src/data/bitvec/basic.lean : line 11 : ERR_MOD : Module docstring missing, or too late src/data/buffer/basic.lean : line 12 : ERR_MOD : Module docstring missing, or too late -src/data/qpf/multivariate/basic.lean : line 73 : ERR_LIN : Line has more than 100 characters -src/data/qpf/univariate/basic.lean : line 35 : ERR_LIN : Line has more than 100 characters +src/data/qpf/multivariate/basic.lean : line 76 : ERR_LIN : Line has more than 100 characters +src/data/qpf/univariate/basic.lean : line 38 : ERR_LIN : Line has more than 100 characters src/data/rbmap/basic.lean : line 8 : ERR_MOD : Module docstring missing, or too late src/data/rbmap/default.lean : line 9 : ERR_MOD : Module docstring missing, or too late -src/data/rbtree/basic.lean : line 9 : ERR_MOD : Module docstring missing, or too late +src/data/rbtree/basic.lean : line 10 : ERR_MOD : Module docstring missing, or too late src/data/rbtree/default_lt.lean : line 6 : ERR_MOD : Module docstring missing, or too late src/data/rbtree/find.lean : line 7 : ERR_MOD : Module docstring missing, or too late src/data/rbtree/init.lean : line 7 : ERR_MOD : Module docstring missing, or too late src/data/rbtree/insert.lean : line 7 : ERR_MOD : Module docstring missing, or too late -src/data/rbtree/main.lean : line 10 : ERR_MOD : Module docstring missing, or too late +src/data/rbtree/main.lean : line 11 : ERR_MOD : Module docstring missing, or too late src/data/rbtree/min_max.lean : line 7 : ERR_MOD : Module docstring missing, or too late -src/data/seq/computation.lean : line 12 : ERR_MOD : Module docstring missing, or too late +src/data/seq/computation.lean : line 11 : ERR_MOD : Module docstring missing, or too late src/data/seq/parallel.lean : line 14 : ERR_MOD : Module docstring missing, or too late -src/data/seq/seq.lean : line 11 : ERR_MOD : Module docstring missing, or too late -src/data/seq/wseq.lean : line 10 : ERR_MOD : Module docstring missing, or too late -src/deprecated/subfield.lean : line 8 : ERR_MOD : Module docstring missing, or too late -src/deprecated/subring.lean : line 10 : ERR_MOD : Module docstring missing, or too late -src/logic/relator.lean : line 11 : ERR_MOD : Module docstring missing, or too late +src/data/seq/seq.lean : line 12 : ERR_MOD : Module docstring missing, or too late +src/data/seq/wseq.lean : line 9 : ERR_MOD : Module docstring missing, or too late src/meta/coinductive_predicates.lean : line 8 : ERR_MOD : Module docstring missing, or too late src/tactic/apply_fun.lean : line 8 : ERR_MOD : Module docstring missing, or too late src/tactic/auto_cases.lean : line 8 : ERR_MOD : Module docstring missing, or too late @@ -69,7 +59,6 @@ src/tactic/omega/nat/preterm.lean : line 7 : ERR_MOD : Module docstring missing, src/tactic/omega/nat/sub_elim.lean : line 7 : ERR_MOD : Module docstring missing, or too late src/tactic/omega/prove_unsats.lean : line 7 : ERR_MOD : Module docstring missing, or too late src/tactic/omega/term.lean : line 7 : ERR_MOD : Module docstring missing, or too late -src/tactic/push_neg.lean : line 11 : ERR_MOD : Module docstring missing, or too late src/tactic/restate_axiom.lean : line 8 : ERR_MOD : Module docstring missing, or too late src/tactic/rewrite.lean : line 9 : ERR_MOD : Module docstring missing, or too late src/tactic/rewrite_all/basic.lean : line 8 : ERR_MOD : Module docstring missing, or too late @@ -84,4 +73,3 @@ src/tactic/tidy.lean : line 10 : ERR_MOD : Module docstring missing, or too late src/tactic/transfer.lean : line 6 : ERR_MOD : Module docstring missing, or too late src/tactic/transform_decl.lean : line 8 : ERR_MOD : Module docstring missing, or too late src/tactic/trunc_cases.lean : line 9 : ERR_MOD : Module docstring missing, or too late -src/tactic/wlog.lean : line 10 : ERR_MOD : Module docstring missing, or too late diff --git a/scripts/yaml_check.py b/scripts/yaml_check.py index 04a07ea84fea4..5f1d1634231b7 100644 --- a/scripts/yaml_check.py +++ b/scripts/yaml_check.py @@ -1,18 +1,25 @@ -from typing import Dict, Optional, Tuple, List +from typing import Dict, Optional, Union, Tuple, List import yaml import sys -def tiered_extract(db: Dict[str, Dict[str, Dict[str, Optional[str]]]]) -> List[Tuple[str, str]]: - """From a three-level deep nested dictionary, return a list of (key, values) +TieredDict = Dict[str, Union[Optional[str], 'TieredDict']] + +def tiered_extract(db: TieredDict) -> List[Tuple[List[str], str]]: + """From a nested dictionary, return a list of (key_path, values) of the deepest level.""" out = [] - for entry in db.values(): - for values in entry.values(): - for name, decl in values.items(): - if decl and '/' not in decl: - out.append((name, decl)) + for name, entry in db.items(): + if isinstance(entry, dict): + for subname, value in tiered_extract(entry): + out.append(([name] + subname, value)) + else: + if entry and '/' not in entry: + out.append(([name], entry)) return out +def flatten_names(data: List[Tuple[List[str], str]]) -> List[Tuple[str, str]]: + return [(' :: '.join(id), v) for id, v in data] + def print_list(fn: str, pairs: List[Tuple[str, str]]) -> None: with open(fn, 'w') as out: for (id, val) in pairs: @@ -38,7 +45,12 @@ def print_list(fn: str, pairs: List[Tuple[str, str]]) -> None: hundred_decls = hundred_decls + [(index, d) for d in entry['decls']] overview_decls = tiered_extract(overview) +assert all(len(n) == 3 for n, _ in overview_decls) +overview_decls = flatten_names(overview_decls) + undergrad_decls = tiered_extract(undergrad) +assert all(len(n) >= 3 for n, _ in undergrad_decls) +undergrad_decls = flatten_names(undergrad_decls) print_list('100.txt', hundred_decls) print_list('overview.txt', overview_decls) diff --git a/src/algebra/abs.lean b/src/algebra/abs.lean index 3bb84fb2fd731..a7ed47f3b95ca 100644 --- a/src/algebra/abs.lean +++ b/src/algebra/abs.lean @@ -7,6 +7,9 @@ Authors: Christopher Hoskin /-! # Absolute value +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a notational class `has_abs` which adds the unary operator `abs` and the notation `|.|`. The concept of an absolute value occurs in lattice ordered groups and in GL and GM spaces. diff --git a/src/algebra/add_torsor.lean b/src/algebra/add_torsor.lean index 305ab5b51135e..6b72f08f2be91 100644 --- a/src/algebra/add_torsor.lean +++ b/src/algebra/add_torsor.lean @@ -3,11 +3,14 @@ Copyright (c) 2020 Joseph Myers. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Myers, Yury Kudryashov -/ -import data.set.pointwise +import data.set.pointwise.smul /-! # Torsors of additive group actions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines torsors of additive group actions. ## Notations @@ -128,7 +131,7 @@ end of subtracting them. -/ @[simp] lemma neg_vsub_eq_vsub_rev (p1 p2 : P) : -(p1 -ᵥ p2) = (p2 -ᵥ p1) := begin - refine neg_eq_of_add_eq_zero (vadd_right_cancel p1 _), + refine neg_eq_of_add_eq_zero_right (vadd_right_cancel p1 _), rw [vsub_add_vsub_cancel, vsub_self], end @@ -335,7 +338,7 @@ def const_vadd_hom : multiplicative G →* equiv.perm P := variable {P} -open function +open _root_.function /-- Point reflection in `x` as a permutation. -/ def point_reflection (x : P) : perm P := (const_vsub x).trans (vadd_const x) diff --git a/src/algebra/algebra/basic.lean b/src/algebra/algebra/basic.lean index 1b2127603a6e8..518dfad84113e 100644 --- a/src/algebra/algebra/basic.lean +++ b/src/algebra/algebra/basic.lean @@ -4,13 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau, Yury Kudryashov -/ import algebra.module.basic +import algebra.module.ulift +import algebra.ne_zero +import algebra.punit_instances import algebra.ring.aut -import linear_algebra.span +import algebra.ring.ulift +import algebra.char_zero.lemmas +import linear_algebra.basic +import ring_theory.subring.basic import tactic.abel /-! # Algebras over commutative semirings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define associative unital `algebra`s over commutative (semi)rings, algebra homomorphisms `alg_hom`, and algebra equivalences `alg_equiv`. @@ -24,27 +33,18 @@ See the implementation notes for remarks about non-associative and non-unital al ## Main definitions: * `algebra R A`: the algebra typeclass. -* `alg_hom R A B`: the type of `R`-algebra morphisms from `A` to `B`. -* `alg_equiv R A B`: the type of `R`-algebra isomorphisms between `A` to `B`. * `algebra_map R A : R →+* A`: the canonical map from `R` to `A`, as a `ring_hom`. This is the - preferred spelling of this map. -* `algebra.linear_map R A : R →ₗ[R] A`: the canonical map from `R` to `A`, as a `linear_map`. -* `algebra.of_id R A : R →ₐ[R] A`: the canonical map from `R` to `A`, as n `alg_hom`. + preferred spelling of this map, it is also available as: + * `algebra.linear_map R A : R →ₗ[R] A`, a `linear_map`. + * `algebra.of_id R A : R →ₐ[R] A`, an `alg_hom` (defined in a later file). * Instances of `algebra` in this file: * `algebra.id` - * `pi.algebra` - * `prod.algebra` * `algebra_nat` * `algebra_int` * `algebra_rat` * `mul_opposite.algebra` * `module.End.algebra` -## Notations - -* `A →ₐ[R] B` : `R`-algebra homomorphism from `A` to `B`. -* `A ≃ₐ[R] B` : `R`-algebra equivalence from `A` to `B`. - ## Implementation notes Given a commutative (semi)ring `R`, there are two ways to define an `R`-algebra structure on a @@ -54,7 +54,7 @@ Given a commutative (semi)ring `R`, there are two ways to define an `R`-algebra * By requiring `A` be an `R`-module such that the action associates and commutes with multiplication as `r • (a₁ * a₂) = (r • a₁) * a₂ = a₁ * (r • a₂)`. -We define `algebra R A` in a way that subsumes both definitions, by extending `has_scalar R A` and +We define `algebra R A` in a way that subsumes both definitions, by extending `has_smul R A` and requiring that this scalar action `r • x` must agree with left multiplication by the image of the structure morphism `algebra_map R A r * x`. @@ -103,16 +103,16 @@ open_locale big_operators section prio -- We set this priority to 0 later in this file set_option extends_priority 200 /- control priority of -`instance [algebra R A] : has_scalar R A` -/ +`instance [algebra R A] : has_smul R A` -/ /-- An associative unital `R`-algebra is a semiring `A` equipped with a map into its center `R → A`. See the implementation notes in this file for discussion of the details of this definition. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] class algebra (R : Type u) (A : Type v) [comm_semiring R] [semiring A] - extends has_scalar R A, R →+* A := + extends has_smul R A, R →+* A := (commutes' : ∀ r x, to_fun r * x = x * to_fun r) (smul_def' : ∀ r x, r • x = to_fun r * x) end prio @@ -121,6 +121,92 @@ end prio def algebra_map (R : Type u) (A : Type v) [comm_semiring R] [semiring A] [algebra R A] : R →+* A := algebra.to_ring_hom +namespace algebra_map + +def has_lift_t (R A : Type*) [comm_semiring R] [semiring A] [algebra R A] : + has_lift_t R A := ⟨λ r, algebra_map R A r⟩ + +attribute [instance, priority 900] algebra_map.has_lift_t + +section comm_semiring_semiring + +variables {R A : Type*} [comm_semiring R] [semiring A] [algebra R A] + +@[simp, norm_cast] lemma coe_zero : (↑(0 : R) : A) = 0 := map_zero (algebra_map R A) +@[simp, norm_cast] lemma coe_one : (↑(1 : R) : A) = 1 := map_one (algebra_map R A) +@[norm_cast] lemma coe_add (a b : R) : (↑(a + b : R) : A) = ↑a + ↑b := +map_add (algebra_map R A) a b +@[norm_cast] lemma coe_mul (a b : R) : (↑(a * b : R) : A) = ↑a * ↑b := +map_mul (algebra_map R A) a b +@[norm_cast] lemma coe_pow (a : R) (n : ℕ) : (↑(a ^ n : R) : A) = ↑a ^ n := +map_pow (algebra_map R A) _ _ + +end comm_semiring_semiring + +section comm_ring_ring + +variables {R A : Type*} [comm_ring R] [ring A] [algebra R A] + +@[norm_cast] lemma coe_neg (x : R) : (↑(-x : R) : A) = -↑x := +map_neg (algebra_map R A) x + +end comm_ring_ring + +section comm_semiring_comm_semiring + +variables {R A : Type*} [comm_semiring R] [comm_semiring A] [algebra R A] + +open_locale big_operators + +-- direct to_additive fails because of some mix-up with polynomials +@[norm_cast] lemma coe_prod {ι : Type*} {s : finset ι} (a : ι → R) : + (↑( ∏ (i : ι) in s, a i : R) : A) = ∏ (i : ι) in s, (↑(a i) : A) := +map_prod (algebra_map R A) a s + +-- to_additive fails for some reason +@[norm_cast] lemma coe_sum {ι : Type*} {s : finset ι} (a : ι → R) : + ↑(( ∑ (i : ι) in s, a i)) = ∑ (i : ι) in s, (↑(a i) : A) := +map_sum (algebra_map R A) a s + +attribute [to_additive] coe_prod + +end comm_semiring_comm_semiring + +section field_nontrivial +variables {R A : Type*} [field R] [comm_semiring A] [nontrivial A] [algebra R A] + +@[norm_cast, simp] lemma coe_inj {a b : R} : (↑a : A) = ↑b ↔ a = b := +(algebra_map R A).injective.eq_iff + +@[norm_cast, simp] lemma lift_map_eq_zero_iff (a : R) : (↑a : A) = 0 ↔ a = 0 := +map_eq_zero_iff _ (algebra_map R A).injective + +end field_nontrivial + +section semifield_semidivision_ring +variables {R : Type*} (A : Type*) [semifield R] [division_semiring A] [algebra R A] + +@[norm_cast] lemma coe_inv (r : R) : ↑(r⁻¹) = ((↑r)⁻¹ : A) := +map_inv₀ (algebra_map R A) r + +@[norm_cast] lemma coe_div (r s : R) : ↑(r / s) = (↑r / ↑s : A) := +map_div₀ (algebra_map R A) r s + +@[norm_cast] lemma coe_zpow (r : R) (z : ℤ) : ↑(r ^ z) = (↑r ^ z : A) := +map_zpow₀ (algebra_map R A) r z + +end semifield_semidivision_ring + +section field_division_ring +variables (R A : Type*) [field R] [division_ring A] [algebra R A] + +@[norm_cast] lemma coe_rat_cast (q : ℚ) : ↑(q : R) = (q : A) := +map_rat_cast (algebra_map R A) q + +end field_division_ring + +end algebra_map + /-- Creating an algebra from a morphism to the center of a semiring. -/ def ring_hom.to_algebra' {R S} [comm_semiring R] [semiring S] (i : R →+* S) (h : ∀ c x, i c * x = x * i c) : @@ -177,7 +263,7 @@ section semiring variables [comm_semiring R] [comm_semiring S] variables [semiring A] [algebra R A] [semiring B] [algebra R B] -/-- We keep this lemma private because it picks up the `algebra.to_has_scalar` instance +/-- We keep this lemma private because it picks up the `algebra.to_has_smul` instance which we set to priority 0 shortly. See `smul_def` below for the public version. -/ private lemma smul_def'' (r : R) (x : A) : r • x = algebra_map R A r * x := algebra.smul_def' r x @@ -193,7 +279,7 @@ lemma algebra_ext {R : Type*} [comm_semiring R] {A : Type*} [semiring A] (P Q : by { haveI := Q, exact algebra_map R A r }) : P = Q := begin - unfreezingI { rcases P with ⟨⟨P⟩⟩, rcases Q with ⟨⟨Q⟩⟩ }, + unfreezingI { rcases P with @⟨⟨P⟩⟩, rcases Q with @⟨⟨Q⟩⟩ }, congr, { funext r a, replace w := congr_arg (λ s, s * a) (w r), @@ -216,7 +302,7 @@ instance to_module : module R A := -- From now on, we don't want to use the following instance anymore. -- Unfortunately, leaving it in place causes deterministic timeouts later in mathlib. -attribute [instance, priority 0] algebra.to_has_scalar +attribute [instance, priority 0] algebra.to_has_smul lemma smul_def (r : R) (x : A) : r • x = algebra_map R A r * x := algebra.smul_def' r x @@ -259,6 +345,11 @@ search (and was here first). -/ (r • x) * y = r • (x * y) := smul_mul_assoc r x y +@[simp] +lemma _root_.smul_algebra_map {α : Type*} [monoid α] [mul_distrib_mul_action α A] + [smul_comm_class α R A] (a : α) (r : R) : a • algebra_map R A r = algebra_map R A r := +by rw [algebra_map_eq_smul_one, smul_comm a r (1 : A), smul_one] + section variables {r : R} {a : A} @@ -325,21 +416,22 @@ instance _root_.punit.algebra : algebra R punit := end punit -section prod -variables (R A B) +section ulift -instance _root_.prod.algebra : algebra R (A × B) := -{ commutes' := by { rintro r ⟨a, b⟩, dsimp, rw [commutes r a, commutes r b] }, - smul_def' := by { rintro r ⟨a, b⟩, dsimp, rw [smul_def r a, smul_def r b] }, - .. prod.module, - .. ring_hom.prod (algebra_map R A) (algebra_map R B) } +instance _root_.ulift.algebra : algebra R (ulift A) := +{ to_fun := λ r, ulift.up (algebra_map R A r), + commutes' := λ r x, ulift.down_injective $ algebra.commutes r x.down, + smul_def' := λ r x, ulift.down_injective $ algebra.smul_def' r x.down, + .. ulift.module', + .. (ulift.ring_equiv : ulift A ≃+* A).symm.to_ring_hom.comp (algebra_map R A) } -variables {R A B} +lemma _root_.ulift.algebra_map_eq (r : R) : + algebra_map R (ulift A) r = ulift.up (algebra_map R A r) := rfl -@[simp] lemma algebra_map_prod_apply (r : R) : - algebra_map R (A × B) r = (algebra_map R A r, algebra_map R B r) := rfl +@[simp] lemma _root_.ulift.down_algebra_map (r : R) : + (algebra_map R (ulift A) r).down = algebra_map R A r := rfl -end prod +end ulift /-- Algebra over a subsemiring. This builds upon `subsemiring.module`. -/ instance of_subsemiring (S : subsemiring R) : algebra S A := @@ -376,8 +468,8 @@ lemma algebra_map_of_subring_apply {R : Type*} [comm_ring R] (S : subring R) (x /-- Explicit characterization of the submonoid map in the case of an algebra. `S` is made explicit to help with type inference -/ def algebra_map_submonoid (S : Type*) [semiring S] [algebra R S] - (M : submonoid R) : (submonoid S) := -submonoid.map (algebra_map R S : R →* S) M + (M : submonoid R) : submonoid S := +M.map (algebra_map R S) lemma mem_algebra_map_submonoid_of_mem {S : Type*} [semiring S] [algebra R S] {M : submonoid R} (x : M) : (algebra_map R S x) ∈ algebra_map_submonoid S M := @@ -419,56 +511,6 @@ end ring end algebra -namespace no_zero_smul_divisors - -variables {R A : Type*} - -open algebra - -section ring - -variables [comm_ring R] - -/-- If `algebra_map R A` is injective and `A` has no zero divisors, -`R`-multiples in `A` are zero only if one of the factors is zero. - -Cannot be an instance because there is no `injective (algebra_map R A)` typeclass. --/ -lemma of_algebra_map_injective - [semiring A] [algebra R A] [no_zero_divisors A] - (h : function.injective (algebra_map R A)) : no_zero_smul_divisors R A := -⟨λ c x hcx, (mul_eq_zero.mp ((smul_def c x).symm.trans hcx)).imp_left - ((injective_iff_map_eq_zero (algebra_map R A)).mp h _)⟩ - -variables (R A) -lemma algebra_map_injective [ring A] [nontrivial A] - [algebra R A] [no_zero_smul_divisors R A] : - function.injective (algebra_map R A) := -suffices function.injective (λ (c : R), c • (1 : A)), -by { convert this, ext, rw [algebra.smul_def, mul_one] }, -smul_left_injective R one_ne_zero - -variables {R A} -lemma iff_algebra_map_injective [ring A] [is_domain A] [algebra R A] : - no_zero_smul_divisors R A ↔ function.injective (algebra_map R A) := -⟨@@no_zero_smul_divisors.algebra_map_injective R A _ _ _ _, - no_zero_smul_divisors.of_algebra_map_injective⟩ - -end ring - -section field - -variables [field R] [semiring A] [algebra R A] - -@[priority 100] -- see note [lower instance priority] -instance algebra.no_zero_smul_divisors [nontrivial A] [no_zero_divisors A] : - no_zero_smul_divisors R A := -no_zero_smul_divisors.of_algebra_map_injective (algebra_map R A).injective - -end field - -end no_zero_smul_divisors - namespace mul_opposite variables {R A : Type*} [comm_semiring R] [semiring A] [algebra R A] @@ -478,7 +520,7 @@ instance : algebra R Aᵐᵒᵖ := smul_def' := λ c x, unop_injective $ by { dsimp, simp only [op_mul, algebra.smul_def, algebra.commutes, op_unop] }, commutes' := λ r, mul_opposite.rec $ λ x, by dsimp; simp only [← op_mul, algebra.commutes], - .. mul_opposite.has_scalar A R } + .. mul_opposite.has_smul A R } @[simp] lemma algebra_map_apply (c : R) : algebra_map R Aᵐᵒᵖ c = op (algebra_map R A c) := rfl @@ -501,745 +543,68 @@ lemma algebra_map_End_eq_smul_id (a : R) : ((algebra_map K (End K V)) a).ker = ⊥ := linear_map.ker_smul _ _ ha -end module - -set_option old_structure_cmd true -/-- Defining the homomorphism in the category R-Alg. -/ -@[nolint has_inhabited_instance] -structure alg_hom (R : Type u) (A : Type v) (B : Type w) - [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] extends ring_hom A B := -(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r) - -run_cmd tactic.add_doc_string `alg_hom.to_ring_hom "Reinterpret an `alg_hom` as a `ring_hom`" - -infixr ` →ₐ `:25 := alg_hom _ -notation A ` →ₐ[`:25 R `] ` B := alg_hom R A B - -namespace alg_hom - -variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁} - -section semiring - -variables [comm_semiring R] [semiring A] [semiring B] [semiring C] [semiring D] -variables [algebra R A] [algebra R B] [algebra R C] [algebra R D] - -instance : has_coe_to_fun (A →ₐ[R] B) (λ _, A → B) := ⟨alg_hom.to_fun⟩ - -initialize_simps_projections alg_hom (to_fun → apply) - -@[simp] lemma to_fun_eq_coe (f : A →ₐ[R] B) : f.to_fun = f := rfl - -instance : ring_hom_class (A →ₐ[R] B) A B := -{ coe := to_fun, - coe_injective' := λ f g h, by { cases f, cases g, congr' }, - map_add := map_add', - map_zero := map_zero', - map_mul := map_mul', - map_one := map_one' } - -instance coe_ring_hom : has_coe (A →ₐ[R] B) (A →+* B) := ⟨alg_hom.to_ring_hom⟩ - -instance coe_monoid_hom : has_coe (A →ₐ[R] B) (A →* B) := ⟨λ f, ↑(f : A →+* B)⟩ - -instance coe_add_monoid_hom : has_coe (A →ₐ[R] B) (A →+ B) := ⟨λ f, ↑(f : A →+* B)⟩ - -@[simp, norm_cast] lemma coe_mk {f : A → B} (h₁ h₂ h₃ h₄ h₅) : - ⇑(⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := rfl - --- make the coercion the simp-normal form -@[simp] lemma to_ring_hom_eq_coe (f : A →ₐ[R] B) : f.to_ring_hom = f := rfl - -@[simp, norm_cast] lemma coe_to_ring_hom (f : A →ₐ[R] B) : ⇑(f : A →+* B) = f := rfl - -@[simp, norm_cast] lemma coe_to_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →* B) = f := rfl - -@[simp, norm_cast] lemma coe_to_add_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →+ B) = f := rfl - -variables (φ : A →ₐ[R] B) - -theorem coe_fn_injective : @function.injective (A →ₐ[R] B) (A → B) coe_fn := fun_like.coe_injective - -theorem coe_fn_inj {φ₁ φ₂ : A →ₐ[R] B} : (φ₁ : A → B) = φ₂ ↔ φ₁ = φ₂ := fun_like.coe_fn_eq - -theorem coe_ring_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+* B)) := -λ φ₁ φ₂ H, coe_fn_injective $ show ((φ₁ : (A →+* B)) : A → B) = ((φ₂ : (A →+* B)) : A → B), - from congr_arg _ H - -theorem coe_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →* B)) := -ring_hom.coe_monoid_hom_injective.comp coe_ring_hom_injective - -theorem coe_add_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+ B)) := -ring_hom.coe_add_monoid_hom_injective.comp coe_ring_hom_injective - -protected lemma congr_fun {φ₁ φ₂ : A →ₐ[R] B} (H : φ₁ = φ₂) (x : A) : φ₁ x = φ₂ x := -fun_like.congr_fun H x -protected lemma congr_arg (φ : A →ₐ[R] B) {x y : A} (h : x = y) : φ x = φ y := -fun_like.congr_arg φ h - -@[ext] -theorem ext {φ₁ φ₂ : A →ₐ[R] B} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ := fun_like.ext _ _ H - -theorem ext_iff {φ₁ φ₂ : A →ₐ[R] B} : φ₁ = φ₂ ↔ ∀ x, φ₁ x = φ₂ x := fun_like.ext_iff - -@[simp] theorem mk_coe {f : A →ₐ[R] B} (h₁ h₂ h₃ h₄ h₅) : - (⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := ext $ λ _, rfl - -@[simp] -theorem commutes (r : R) : φ (algebra_map R A r) = algebra_map R B r := φ.commutes' r - -theorem comp_algebra_map : (φ : A →+* B).comp (algebra_map R A) = algebra_map R B := -ring_hom.ext $ φ.commutes - -lemma map_add (r s : A) : φ (r + s) = φ r + φ s := map_add _ _ _ -lemma map_zero : φ 0 = 0 := map_zero _ -lemma map_mul (x y) : φ (x * y) = φ x * φ y := map_mul _ _ _ -lemma map_one : φ 1 = 1 := map_one _ -lemma map_pow (x : A) (n : ℕ) : φ (x ^ n) = (φ x) ^ n := -map_pow _ _ _ - -@[simp] lemma map_smul (r : R) (x : A) : φ (r • x) = r • φ x := -by simp only [algebra.smul_def, map_mul, commutes] - -lemma map_sum {ι : Type*} (f : ι → A) (s : finset ι) : - φ (∑ x in s, f x) = ∑ x in s, φ (f x) := -φ.to_ring_hom.map_sum f s - -lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) : - φ (f.sum g) = f.sum (λ i a, φ (g i a)) := -φ.map_sum _ _ - -lemma map_bit0 (x) : φ (bit0 x) = bit0 (φ x) := map_bit0 _ _ -lemma map_bit1 (x) : φ (bit1 x) = bit1 (φ x) := map_bit1 _ _ - -/-- If a `ring_hom` is `R`-linear, then it is an `alg_hom`. -/ -def mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : A →ₐ[R] B := -{ to_fun := f, - commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, h, f.map_one], - .. f } - -@[simp] lemma coe_mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : ⇑(mk' f h) = f := rfl - -section - -variables (R A) -/-- Identity map as an `alg_hom`. -/ -protected def id : A →ₐ[R] A := -{ commutes' := λ _, rfl, - ..ring_hom.id A } - -@[simp] lemma coe_id : ⇑(alg_hom.id R A) = id := rfl - -@[simp] lemma id_to_ring_hom : (alg_hom.id R A : A →+* A) = ring_hom.id _ := rfl - -end - -lemma id_apply (p : A) : alg_hom.id R A p = p := rfl - -/-- Composition of algebra homeomorphisms. -/ -def comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : A →ₐ[R] C := -{ commutes' := λ r : R, by rw [← φ₁.commutes, ← φ₂.commutes]; refl, - .. φ₁.to_ring_hom.comp ↑φ₂ } - -@[simp] lemma coe_comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : ⇑(φ₁.comp φ₂) = φ₁ ∘ φ₂ := rfl - -lemma comp_apply (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) (p : A) : φ₁.comp φ₂ p = φ₁ (φ₂ p) := rfl - -lemma comp_to_ring_hom (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : - ⇑(φ₁.comp φ₂ : A →+* C) = (φ₁ : B →+* C).comp ↑φ₂ := rfl - -@[simp] theorem comp_id : φ.comp (alg_hom.id R A) = φ := -ext $ λ x, rfl - -@[simp] theorem id_comp : (alg_hom.id R B).comp φ = φ := -ext $ λ x, rfl - -theorem comp_assoc (φ₁ : C →ₐ[R] D) (φ₂ : B →ₐ[R] C) (φ₃ : A →ₐ[R] B) : - (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) := -ext $ λ x, rfl - -/-- R-Alg ⥤ R-Mod -/ -def to_linear_map : A →ₗ[R] B := -{ to_fun := φ, - map_add' := φ.map_add, - map_smul' := φ.map_smul } - -@[simp] lemma to_linear_map_apply (p : A) : φ.to_linear_map p = φ p := rfl - -theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A →ₗ[R] B)) := -λ φ₁ φ₂ h, ext $ linear_map.congr_fun h - -@[simp] lemma comp_to_linear_map (f : A →ₐ[R] B) (g : B →ₐ[R] C) : - (g.comp f).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl - -@[simp] lemma to_linear_map_id : to_linear_map (alg_hom.id R A) = linear_map.id := -linear_map.ext $ λ _, rfl - -/-- Promote a `linear_map` to an `alg_hom` by supplying proofs about the behavior on `1` and `*`. -/ -@[simps] -def of_linear_map (f : A →ₗ[R] B) (map_one : f 1 = 1) (map_mul : ∀ x y, f (x * y) = f x * f y) : - A →ₐ[R] B := -{ to_fun := f, - map_one' := map_one, - map_mul' := map_mul, - commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, f.map_smul, map_one], - .. f.to_add_monoid_hom } - -@[simp] lemma of_linear_map_to_linear_map (map_one) (map_mul) : - of_linear_map φ.to_linear_map map_one map_mul = φ := -by { ext, refl } - -@[simp] lemma to_linear_map_of_linear_map (f : A →ₗ[R] B) (map_one) (map_mul) : - to_linear_map (of_linear_map f map_one map_mul) = f := -by { ext, refl } - -@[simp] lemma of_linear_map_id (map_one) (map_mul) : - of_linear_map linear_map.id map_one map_mul = alg_hom.id R A := -ext $ λ _, rfl - -lemma map_smul_of_tower {R'} [has_scalar R' A] [has_scalar R' B] - [linear_map.compatible_smul A B R' R] (r : R') (x : A) : φ (r • x) = r • φ x := -φ.to_linear_map.map_smul_of_tower r x - -lemma map_list_prod (s : list A) : - φ s.prod = (s.map φ).prod := -φ.to_ring_hom.map_list_prod s - -section prod - -/-- First projection as `alg_hom`. -/ -def fst : A × B →ₐ[R] A := -{ commutes' := λ r, rfl, .. ring_hom.fst A B} - -/-- Second projection as `alg_hom`. -/ -def snd : A × B →ₐ[R] B := -{ commutes' := λ r, rfl, .. ring_hom.snd A B} - -end prod - -lemma algebra_map_eq_apply (f : A →ₐ[R] B) {y : R} {x : A} (h : algebra_map R A y = x) : - algebra_map R B y = f x := -h ▸ (f.commutes _).symm - -end semiring - -section comm_semiring - -variables [comm_semiring R] [comm_semiring A] [comm_semiring B] -variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B) - -lemma map_multiset_prod (s : multiset A) : - φ s.prod = (s.map φ).prod := -φ.to_ring_hom.map_multiset_prod s - -lemma map_prod {ι : Type*} (f : ι → A) (s : finset ι) : - φ (∏ x in s, f x) = ∏ x in s, φ (f x) := -φ.to_ring_hom.map_prod f s - -lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) : - φ (f.prod g) = f.prod (λ i a, φ (g i a)) := -φ.map_prod _ _ - -end comm_semiring - -section ring - -variables [comm_semiring R] [ring A] [ring B] -variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B) - -lemma map_neg (x) : φ (-x) = -φ x := map_neg _ _ -lemma map_sub (x y) : φ (x - y) = φ x - φ y := map_sub _ _ _ - -@[simp] lemma map_int_cast (n : ℤ) : φ n = n := -φ.to_ring_hom.map_int_cast n - -end ring - -section division_ring - -variables [comm_semiring R] [division_ring A] [division_ring B] -variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B) - -@[simp] lemma map_inv (x) : φ (x⁻¹) = (φ x)⁻¹ := -φ.to_ring_hom.map_inv x - -@[simp] lemma map_div (x y) : φ (x / y) = φ x / φ y := -φ.to_ring_hom.map_div x y - -end division_ring - -end alg_hom - -@[simp] lemma rat.smul_one_eq_coe {A : Type*} [division_ring A] [algebra ℚ A] (m : ℚ) : - m • (1 : A) = ↑m := -by rw [algebra.smul_def, mul_one, ring_hom.eq_rat_cast] - -set_option old_structure_cmd true -/-- An equivalence of algebras is an equivalence of rings commuting with the actions of scalars. -/ -structure alg_equiv (R : Type u) (A : Type v) (B : Type w) - [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] - extends A ≃ B, A ≃* B, A ≃+ B, A ≃+* B := -(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r) - -attribute [nolint doc_blame] alg_equiv.to_ring_equiv -attribute [nolint doc_blame] alg_equiv.to_equiv -attribute [nolint doc_blame] alg_equiv.to_add_equiv -attribute [nolint doc_blame] alg_equiv.to_mul_equiv - -notation A ` ≃ₐ[`:50 R `] ` A' := alg_equiv R A A' - -namespace alg_equiv - -variables {R : Type u} {A₁ : Type v} {A₂ : Type w} {A₃ : Type u₁} - -section semiring - -variables [comm_semiring R] [semiring A₁] [semiring A₂] [semiring A₃] -variables [algebra R A₁] [algebra R A₂] [algebra R A₃] -variables (e : A₁ ≃ₐ[R] A₂) - -instance : ring_equiv_class (A₁ ≃ₐ[R] A₂) A₁ A₂ := -{ coe := to_fun, - inv := inv_fun, - coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' }, - map_add := map_add', - map_mul := map_mul', - left_inv := left_inv, - right_inv := right_inv } - -/-- Helper instance for when there's too many metavariables to apply -`fun_like.has_coe_to_fun` directly. -/ -instance : has_coe_to_fun (A₁ ≃ₐ[R] A₂) (λ _, A₁ → A₂) := ⟨alg_equiv.to_fun⟩ - -@[ext] -lemma ext {f g : A₁ ≃ₐ[R] A₂} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h - -protected lemma congr_arg {f : A₁ ≃ₐ[R] A₂} {x x' : A₁} : x = x' → f x = f x' := -fun_like.congr_arg f - -protected lemma congr_fun {f g : A₁ ≃ₐ[R] A₂} (h : f = g) (x : A₁) : f x = g x := -fun_like.congr_fun h x - -protected lemma ext_iff {f g : A₁ ≃ₐ[R] A₂} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff - -lemma coe_fun_injective : @function.injective (A₁ ≃ₐ[R] A₂) (A₁ → A₂) (λ e, (e : A₁ → A₂)) := -fun_like.coe_injective - -instance has_coe_to_ring_equiv : has_coe (A₁ ≃ₐ[R] A₂) (A₁ ≃+* A₂) := ⟨alg_equiv.to_ring_equiv⟩ - -@[simp] lemma coe_mk {to_fun inv_fun left_inv right_inv map_mul map_add commutes} : - ⇑(⟨to_fun, inv_fun, left_inv, right_inv, map_mul, map_add, commutes⟩ : A₁ ≃ₐ[R] A₂) = to_fun := -rfl - -@[simp] theorem mk_coe (e : A₁ ≃ₐ[R] A₂) (e' h₁ h₂ h₃ h₄ h₅) : - (⟨e, e', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂) = e := ext $ λ _, rfl - -@[simp] lemma to_fun_eq_coe (e : A₁ ≃ₐ[R] A₂) : e.to_fun = e := rfl - -@[simp] lemma to_equiv_eq_coe : e.to_equiv = e := rfl - -@[simp] lemma to_ring_equiv_eq_coe : e.to_ring_equiv = e := rfl - -@[simp, norm_cast] lemma coe_ring_equiv : ((e : A₁ ≃+* A₂) : A₁ → A₂) = e := rfl -lemma coe_ring_equiv' : (e.to_ring_equiv : A₁ → A₂) = e := rfl - -lemma coe_ring_equiv_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ ≃+* A₂)) := -λ e₁ e₂ h, ext $ ring_equiv.congr_fun h - -protected lemma map_add : ∀ x y, e (x + y) = e x + e y := map_add e -protected lemma map_zero : e 0 = 0 := map_zero e -protected lemma map_mul : ∀ x y, e (x * y) = (e x) * (e y) := map_mul e -protected lemma map_one : e 1 = 1 := map_one e - -@[simp] lemma commutes : ∀ (r : R), e (algebra_map R A₁ r) = algebra_map R A₂ r := - e.commutes' - -@[simp] lemma map_smul (r : R) (x : A₁) : e (r • x) = r • e x := -by simp only [algebra.smul_def, map_mul, commutes] - -lemma map_sum {ι : Type*} (f : ι → A₁) (s : finset ι) : - e (∑ x in s, f x) = ∑ x in s, e (f x) := -e.to_add_equiv.map_sum f s - -lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) : - e (f.sum g) = f.sum (λ i b, e (g i b)) := -e.map_sum _ _ - -/-- Interpret an algebra equivalence as an algebra homomorphism. - -This definition is included for symmetry with the other `to_*_hom` projections. -The `simp` normal form is to use the coercion of the `has_coe_to_alg_hom` instance. -/ -def to_alg_hom : A₁ →ₐ[R] A₂ := -{ map_one' := e.map_one, map_zero' := e.map_zero, ..e } - -instance has_coe_to_alg_hom : has_coe (A₁ ≃ₐ[R] A₂) (A₁ →ₐ[R] A₂) := -⟨to_alg_hom⟩ - -@[simp] lemma to_alg_hom_eq_coe : e.to_alg_hom = e := rfl - -@[simp, norm_cast] lemma coe_alg_hom : ((e : A₁ →ₐ[R] A₂) : A₁ → A₂) = e := -rfl - -lemma coe_alg_hom_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ →ₐ[R] A₂)) := -λ e₁ e₂ h, ext $ alg_hom.congr_fun h - -/-- The two paths coercion can take to a `ring_hom` are equivalent -/ -lemma coe_ring_hom_commutes : ((e : A₁ →ₐ[R] A₂) : A₁ →+* A₂) = ((e : A₁ ≃+* A₂) : A₁ →+* A₂) := -rfl - -protected lemma map_pow : ∀ (x : A₁) (n : ℕ), e (x ^ n) = (e x) ^ n := e.to_alg_hom.map_pow -protected lemma injective : function.injective e := equiv_like.injective e -protected lemma surjective : function.surjective e := equiv_like.surjective e -protected lemma bijective : function.bijective e := equiv_like.bijective e - -/-- Algebra equivalences are reflexive. -/ -@[refl] def refl : A₁ ≃ₐ[R] A₁ := {commutes' := λ r, rfl, ..(1 : A₁ ≃+* A₁)} - -instance : inhabited (A₁ ≃ₐ[R] A₁) := ⟨refl⟩ - -@[simp] lemma refl_to_alg_hom : ↑(refl : A₁ ≃ₐ[R] A₁) = alg_hom.id R A₁ := rfl - -@[simp] lemma coe_refl : ⇑(refl : A₁ ≃ₐ[R] A₁) = id := rfl - -/-- Algebra equivalences are symmetric. -/ -@[symm] -def symm (e : A₁ ≃ₐ[R] A₂) : A₂ ≃ₐ[R] A₁ := -{ commutes' := λ r, by { rw ←e.to_ring_equiv.symm_apply_apply (algebra_map R A₁ r), congr, - change _ = e _, rw e.commutes, }, - ..e.to_ring_equiv.symm, } - -/-- See Note [custom simps projection] -/ -def simps.symm_apply (e : A₁ ≃ₐ[R] A₂) : A₂ → A₁ := e.symm - -initialize_simps_projections alg_equiv (to_fun → apply, inv_fun → symm_apply) - -@[simp] lemma inv_fun_eq_symm {e : A₁ ≃ₐ[R] A₂} : e.inv_fun = e.symm := rfl - -@[simp] lemma symm_symm (e : A₁ ≃ₐ[R] A₂) : e.symm.symm = e := -by { ext, refl, } - -lemma symm_bijective : function.bijective (symm : (A₁ ≃ₐ[R] A₂) → (A₂ ≃ₐ[R] A₁)) := -equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩ - -@[simp] lemma mk_coe' (e : A₁ ≃ₐ[R] A₂) (f h₁ h₂ h₃ h₄ h₅) : - (⟨f, e, h₁, h₂, h₃, h₄, h₅⟩ : A₂ ≃ₐ[R] A₁) = e.symm := -symm_bijective.injective $ ext $ λ x, rfl - -@[simp] theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅) : - (⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm = - { to_fun := f', inv_fun := f, - ..(⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm } := rfl - -@[simp] -theorem refl_symm : (alg_equiv.refl : A₁ ≃ₐ[R] A₁).symm = alg_equiv.refl := rfl - -/-- Algebra equivalences are transitive. -/ -@[trans] -def trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : A₁ ≃ₐ[R] A₃ := -{ commutes' := λ r, show e₂.to_fun (e₁.to_fun _) = _, by rw [e₁.commutes', e₂.commutes'], - ..(e₁.to_ring_equiv.trans e₂.to_ring_equiv), } - -@[simp] lemma apply_symm_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e (e.symm x) = x := - e.to_equiv.apply_symm_apply - -@[simp] lemma symm_apply_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e.symm (e x) = x := - e.to_equiv.symm_apply_apply - -@[simp] lemma symm_trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₃) : - (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl - -@[simp] lemma coe_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : - ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl - -@[simp] lemma trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₁) : - (e₁.trans e₂) x = e₂ (e₁ x) := rfl - -@[simp] lemma comp_symm (e : A₁ ≃ₐ[R] A₂) : - alg_hom.comp (e : A₁ →ₐ[R] A₂) ↑e.symm = alg_hom.id R A₂ := -by { ext, simp } - -@[simp] lemma symm_comp (e : A₁ ≃ₐ[R] A₂) : - alg_hom.comp ↑e.symm (e : A₁ →ₐ[R] A₂) = alg_hom.id R A₁ := -by { ext, simp } - -theorem left_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.left_inverse e.symm e := e.left_inv - -theorem right_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.right_inverse e.symm e := e.right_inv - -/-- If `A₁` is equivalent to `A₁'` and `A₂` is equivalent to `A₂'`, then the type of maps -`A₁ →ₐ[R] A₂` is equivalent to the type of maps `A₁' →ₐ[R] A₂'`. -/ -def arrow_congr {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] [algebra R A₁'] [algebra R A₂'] - (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : (A₁ →ₐ[R] A₂) ≃ (A₁' →ₐ[R] A₂') := -{ to_fun := λ f, (e₂.to_alg_hom.comp f).comp e₁.symm.to_alg_hom, - inv_fun := λ f, (e₂.symm.to_alg_hom.comp f).comp e₁.to_alg_hom, - left_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, symm_comp], - simp only [←alg_hom.comp_assoc, symm_comp, alg_hom.id_comp, alg_hom.comp_id] }, - right_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, comp_symm], - simp only [←alg_hom.comp_assoc, comp_symm, alg_hom.id_comp, alg_hom.comp_id] } } - -lemma arrow_congr_comp {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃'] - [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') - (e₃ : A₃ ≃ₐ[R] A₃') (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₃) : - arrow_congr e₁ e₃ (g.comp f) = (arrow_congr e₂ e₃ g).comp (arrow_congr e₁ e₂ f) := -by { ext, simp only [arrow_congr, equiv.coe_fn_mk, alg_hom.comp_apply], - congr, exact (e₂.symm_apply_apply _).symm } - -@[simp] lemma arrow_congr_refl : - arrow_congr alg_equiv.refl alg_equiv.refl = equiv.refl (A₁ →ₐ[R] A₂) := -by { ext, refl } - -@[simp] lemma arrow_congr_trans {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃'] - [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₂) (e₁' : A₁' ≃ₐ[R] A₂') - (e₂ : A₂ ≃ₐ[R] A₃) (e₂' : A₂' ≃ₐ[R] A₃') : - arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') := -by { ext, refl } - -@[simp] lemma arrow_congr_symm {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] - [algebra R A₁'] [algebra R A₂'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : - (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm := -by { ext, refl } - -/-- If an algebra morphism has an inverse, it is a algebra isomorphism. -/ -def of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ : f.comp g = alg_hom.id R A₂) - (h₂ : g.comp f = alg_hom.id R A₁) : A₁ ≃ₐ[R] A₂ := -{ to_fun := f, - inv_fun := g, - left_inv := alg_hom.ext_iff.1 h₂, - right_inv := alg_hom.ext_iff.1 h₁, - ..f } - -lemma coe_alg_hom_of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) : - ↑(of_alg_hom f g h₁ h₂) = f := alg_hom.ext $ λ _, rfl - -@[simp] -lemma of_alg_hom_coe_alg_hom (f : A₁ ≃ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) : - of_alg_hom ↑f g h₁ h₂ = f := ext $ λ _, rfl - -lemma of_alg_hom_symm (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) : - (of_alg_hom f g h₁ h₂).symm = of_alg_hom g f h₂ h₁ := rfl - -/-- Promotes a bijective algebra homomorphism to an algebra equivalence. -/ -noncomputable def of_bijective (f : A₁ →ₐ[R] A₂) (hf : function.bijective f) : A₁ ≃ₐ[R] A₂ := -{ .. ring_equiv.of_bijective (f : A₁ →+* A₂) hf, .. f } - -@[simp] lemma coe_of_bijective {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} : - (alg_equiv.of_bijective f hf : A₁ → A₂) = f := rfl - -lemma of_bijective_apply {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} (a : A₁) : - (alg_equiv.of_bijective f hf) a = f a := rfl - -/-- Forgetting the multiplicative structures, an equivalence of algebras is a linear equivalence. -/ -@[simps apply] def to_linear_equiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ₗ[R] A₂ := -{ to_fun := e, - map_smul' := e.map_smul, - inv_fun := e.symm, - .. e } - -@[simp] lemma to_linear_equiv_refl : - (alg_equiv.refl : A₁ ≃ₐ[R] A₁).to_linear_equiv = linear_equiv.refl R A₁ := rfl - -@[simp] lemma to_linear_equiv_symm (e : A₁ ≃ₐ[R] A₂) : - e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl - -@[simp] lemma to_linear_equiv_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : - (e₁.trans e₂).to_linear_equiv = e₁.to_linear_equiv.trans e₂.to_linear_equiv := rfl - -theorem to_linear_equiv_injective : function.injective (to_linear_equiv : _ → (A₁ ≃ₗ[R] A₂)) := -λ e₁ e₂ h, ext $ linear_equiv.congr_fun h - -/-- Interpret an algebra equivalence as a linear map. -/ -def to_linear_map : A₁ →ₗ[R] A₂ := -e.to_alg_hom.to_linear_map - -@[simp] lemma to_alg_hom_to_linear_map : - (e : A₁ →ₐ[R] A₂).to_linear_map = e.to_linear_map := rfl - -@[simp] lemma to_linear_equiv_to_linear_map : - e.to_linear_equiv.to_linear_map = e.to_linear_map := rfl - -@[simp] lemma to_linear_map_apply (x : A₁) : e.to_linear_map x = e x := rfl - -theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A₁ →ₗ[R] A₂)) := -λ e₁ e₂ h, ext $ linear_map.congr_fun h - -@[simp] lemma trans_to_linear_map (f : A₁ ≃ₐ[R] A₂) (g : A₂ ≃ₐ[R] A₃) : - (f.trans g).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl - -section of_linear_equiv - -variables (l : A₁ ≃ₗ[R] A₂) - (map_mul : ∀ x y : A₁, l (x * y) = l x * l y) - (commutes : ∀ r : R, l (algebra_map R A₁ r) = algebra_map R A₂ r) - -/-- -Upgrade a linear equivalence to an algebra equivalence, -given that it distributes over multiplication and action of scalars. --/ -@[simps apply] -def of_linear_equiv : A₁ ≃ₐ[R] A₂ := -{ to_fun := l, - inv_fun := l.symm, - map_mul' := map_mul, - commutes' := commutes, - ..l } - -@[simp] -lemma of_linear_equiv_symm : - (of_linear_equiv l map_mul commutes).symm = of_linear_equiv l.symm - ((of_linear_equiv l map_mul commutes).symm.map_mul) - ((of_linear_equiv l map_mul commutes).symm.commutes) := -rfl - -@[simp] lemma of_linear_equiv_to_linear_equiv (map_mul) (commutes) : - of_linear_equiv e.to_linear_equiv map_mul commutes = e := -by { ext, refl } - -@[simp] lemma to_linear_equiv_of_linear_equiv : - to_linear_equiv (of_linear_equiv l map_mul commutes) = l := -by { ext, refl } - -end of_linear_equiv - -@[simps mul one {attrs := []}] instance aut : group (A₁ ≃ₐ[R] A₁) := -{ mul := λ ϕ ψ, ψ.trans ϕ, - mul_assoc := λ ϕ ψ χ, rfl, - one := refl, - one_mul := λ ϕ, ext $ λ x, rfl, - mul_one := λ ϕ, ext $ λ x, rfl, - inv := symm, - mul_left_inv := λ ϕ, ext $ symm_apply_apply ϕ } - -@[simp] lemma one_apply (x : A₁) : (1 : A₁ ≃ₐ[R] A₁) x = x := rfl - -@[simp] lemma mul_apply (e₁ e₂ : A₁ ≃ₐ[R] A₁) (x : A₁) : (e₁ * e₂) x = e₁ (e₂ x) := rfl - -/-- An algebra isomorphism induces a group isomorphism between automorphism groups -/ -@[simps apply] -def aut_congr (ϕ : A₁ ≃ₐ[R] A₂) : (A₁ ≃ₐ[R] A₁) ≃* (A₂ ≃ₐ[R] A₂) := -{ to_fun := λ ψ, ϕ.symm.trans (ψ.trans ϕ), - inv_fun := λ ψ, ϕ.trans (ψ.trans ϕ.symm), - left_inv := λ ψ, by { ext, simp_rw [trans_apply, symm_apply_apply] }, - right_inv := λ ψ, by { ext, simp_rw [trans_apply, apply_symm_apply] }, - map_mul' := λ ψ χ, by { ext, simp only [mul_apply, trans_apply, symm_apply_apply] } } - -@[simp] lemma aut_congr_refl : aut_congr (alg_equiv.refl) = mul_equiv.refl (A₁ ≃ₐ[R] A₁) := -by { ext, refl } - -@[simp] lemma aut_congr_symm (ϕ : A₁ ≃ₐ[R] A₂) : (aut_congr ϕ).symm = aut_congr ϕ.symm := rfl - -@[simp] lemma aut_congr_trans (ϕ : A₁ ≃ₐ[R] A₂) (ψ : A₂ ≃ₐ[R] A₃) : - (aut_congr ϕ).trans (aut_congr ψ) = aut_congr (ϕ.trans ψ) := rfl - -/-- The tautological action by `A₁ ≃ₐ[R] A₁` on `A₁`. - -This generalizes `function.End.apply_mul_action`. -/ -instance apply_mul_semiring_action : mul_semiring_action (A₁ ≃ₐ[R] A₁) A₁ := -{ smul := ($), - smul_zero := alg_equiv.map_zero, - smul_add := alg_equiv.map_add, - smul_one := alg_equiv.map_one, - smul_mul := alg_equiv.map_mul, - one_smul := λ _, rfl, - mul_smul := λ _ _ _, rfl } - -@[simp] protected lemma smul_def (f : A₁ ≃ₐ[R] A₁) (a : A₁) : f • a = f a := rfl - -instance apply_has_faithful_scalar : has_faithful_scalar (A₁ ≃ₐ[R] A₁) A₁ := -⟨λ _ _, alg_equiv.ext⟩ - -instance apply_smul_comm_class : smul_comm_class R (A₁ ≃ₐ[R] A₁) A₁ := -{ smul_comm := λ r e a, (e.map_smul r a).symm } - -instance apply_smul_comm_class' : smul_comm_class (A₁ ≃ₐ[R] A₁) R A₁ := -{ smul_comm := λ e r a, (e.map_smul r a) } - -@[simp] lemma algebra_map_eq_apply (e : A₁ ≃ₐ[R] A₂) {y : R} {x : A₁} : - (algebra_map R A₂ y = e x) ↔ (algebra_map R A₁ y = x) := -⟨λ h, by simpa using e.symm.to_alg_hom.algebra_map_eq_apply h, - λ h, e.to_alg_hom.algebra_map_eq_apply h⟩ - -end semiring - -section comm_semiring - -variables [comm_semiring R] [comm_semiring A₁] [comm_semiring A₂] -variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂) - -lemma map_prod {ι : Type*} (f : ι → A₁) (s : finset ι) : - e (∏ x in s, f x) = ∏ x in s, e (f x) := -e.to_alg_hom.map_prod f s - -lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) : - e (f.prod g) = f.prod (λ i a, e (g i a)) := -e.to_alg_hom.map_finsupp_prod f g - -end comm_semiring - -section ring - -variables [comm_semiring R] [ring A₁] [ring A₂] -variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂) - -protected lemma map_neg (x) : e (-x) = -e x := map_neg e x -protected lemma map_sub (x y) : e (x - y) = e x - e y := map_sub e x y - -end ring - -section division_ring - -variables [comm_ring R] [division_ring A₁] [division_ring A₂] -variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂) - -@[simp] lemma map_inv (x) : e (x⁻¹) = (e x)⁻¹ := -e.to_alg_hom.map_inv x - -@[simp] lemma map_div (x y) : e (x / y) = e x / e y := -e.to_alg_hom.map_div x y - -end division_ring - -end alg_equiv - -namespace mul_semiring_action - -variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A] - section -variables [monoid M] [mul_semiring_action M A] [smul_comm_class M R A] -/-- Each element of the monoid defines a algebra homomorphism. - -This is a stronger version of `mul_semiring_action.to_ring_hom` and -`distrib_mul_action.to_linear_map`. -/ -@[simps] -def to_alg_hom (m : M) : A →ₐ[R] A := -alg_hom.mk' (mul_semiring_action.to_ring_hom _ _ m) (smul_comm _) - -theorem to_alg_hom_injective [has_faithful_scalar M A] : - function.injective (mul_semiring_action.to_alg_hom R A : M → A →ₐ[R] A) := -λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_hom.ext_iff.1 h r +variables {R M} + +lemma End_is_unit_apply_inv_apply_of_is_unit {f : module.End R M} (h : is_unit f) (x : M) : + f (h.unit.inv x) = x := +show (f * h.unit.inv) x = x, by simp + +lemma End_is_unit_inv_apply_apply_of_is_unit {f : module.End R M} (h : is_unit f) (x : M) : + h.unit.inv (f x) = x := +(by simp : (h.unit.inv * f) x = x) + +lemma End_is_unit_iff (f : module.End R M) : + is_unit f ↔ function.bijective f := +⟨λ h, function.bijective_iff_has_inverse.mpr $ + ⟨h.unit.inv, ⟨End_is_unit_inv_apply_apply_of_is_unit h, + End_is_unit_apply_inv_apply_of_is_unit h⟩⟩, + λ H, let e : M ≃ₗ[R] M := { ..f, ..(equiv.of_bijective f H)} in + ⟨⟨_, e.symm, linear_map.ext e.right_inv, linear_map.ext e.left_inv⟩, rfl⟩⟩ + +lemma End_algebra_map_is_unit_inv_apply_eq_iff + {x : R} (h : is_unit (algebra_map R (module.End R M) x)) (m m' : M) : + h.unit⁻¹ m = m' ↔ m = x • m' := +{ mp := λ H, ((congr_arg h.unit H).symm.trans (End_is_unit_apply_inv_apply_of_is_unit h _)).symm, + mpr := λ H, H.symm ▸ + begin + apply_fun h.unit using ((module.End_is_unit_iff _).mp h).injective, + erw [End_is_unit_apply_inv_apply_of_is_unit], + refl, + end } + +lemma End_algebra_map_is_unit_inv_apply_eq_iff' + {x : R} (h : is_unit (algebra_map R (module.End R M) x)) (m m' : M) : + m' = h.unit⁻¹ m ↔ m = x • m' := +{ mp := λ H, ((congr_arg h.unit H).trans (End_is_unit_apply_inv_apply_of_is_unit h _)).symm, + mpr := λ H, H.symm ▸ + begin + apply_fun h.unit using ((module.End_is_unit_iff _).mp h).injective, + erw [End_is_unit_apply_inv_apply_of_is_unit], + refl, + end } end -section -variables [group G] [mul_semiring_action G A] [smul_comm_class G R A] +end module -/-- Each element of the group defines a algebra equivalence. +namespace linear_map -This is a stronger version of `mul_semiring_action.to_ring_equiv` and -`distrib_mul_action.to_linear_equiv`. -/ -@[simps] -def to_alg_equiv (g : G) : A ≃ₐ[R] A := -{ .. mul_semiring_action.to_ring_equiv _ _ g, - .. mul_semiring_action.to_alg_hom R A g } +variables {R : Type*} {A : Type*} {B : Type*} [comm_semiring R] [semiring A] [semiring B] + [algebra R A] [algebra R B] -theorem to_alg_equiv_injective [has_faithful_scalar G A] : - function.injective (mul_semiring_action.to_alg_equiv R A : G → A ≃ₐ[R] A) := -λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_equiv.ext_iff.1 h r +/-- An alternate statement of `linear_map.map_smul` for when `algebra_map` is more convenient to +work with than `•`. -/ +lemma map_algebra_map_mul (f : A →ₗ[R] B) (a : A) (r : R) : + f (algebra_map R A r * a) = algebra_map R B r * f a := +by rw [←algebra.smul_def, ←algebra.smul_def, map_smul] -end +lemma map_mul_algebra_map (f : A →ₗ[R] B) (a : A) (r : R) : + f (a * algebra_map R A r) = f a * algebra_map R B r := +by rw [←algebra.commutes, ←algebra.commutes, map_algebra_map_mul] -end mul_semiring_action +end linear_map section nat @@ -1263,60 +628,34 @@ namespace ring_hom variables {R S : Type*} -/-- Reinterpret a `ring_hom` as an `ℕ`-algebra homomorphism. -/ -def to_nat_alg_hom [semiring R] [semiring S] (f : R →+* S) : - R →ₐ[ℕ] S := -{ to_fun := f, commutes' := λ n, by simp, .. f } - -/-- Reinterpret a `ring_hom` as a `ℤ`-algebra homomorphism. -/ -def to_int_alg_hom [ring R] [ring S] [algebra ℤ R] [algebra ℤ S] (f : R →+* S) : - R →ₐ[ℤ] S := -{ commutes' := λ n, by simp, .. f } - -- note that `R`, `S` could be `semiring`s but this is useless mathematically speaking - -- a ℚ-algebra is a ring. furthermore, this change probably slows down elaboration. @[simp] lemma map_rat_algebra_map [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] (f : R →+* S) (r : ℚ) : f (algebra_map ℚ R r) = algebra_map ℚ S r := ring_hom.ext_iff.1 (subsingleton.elim (f.comp (algebra_map ℚ R)) (algebra_map ℚ S)) r -/-- Reinterpret a `ring_hom` as a `ℚ`-algebra homomorphism. -/ -def to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] (f : R →+* S) : - R →ₐ[ℚ] S := -{ commutes' := f.map_rat_algebra_map, .. f } - end ring_hom section rat instance algebra_rat {α} [division_ring α] [char_zero α] : algebra ℚ α := -(rat.cast_hom α).to_algebra' $ λ r x, r.cast_commute x +{ smul := (•), + smul_def' := division_ring.qsmul_eq_mul', + to_ring_hom := rat.cast_hom α, + commutes' := rat.cast_commute } + +/-- The two `algebra ℚ ℚ` instances should coincide. -/ +example : algebra_rat = algebra.id ℚ := rfl @[simp] theorem algebra_map_rat_rat : algebra_map ℚ ℚ = ring_hom.id ℚ := subsingleton.elim _ _ --- TODO[gh-6025]: make this an instance once safe to do so -lemma algebra_rat_subsingleton {α} [semiring α] : +instance algebra_rat_subsingleton {α} [semiring α] : subsingleton (algebra ℚ α) := ⟨λ x y, algebra.algebra_ext x y $ ring_hom.congr_fun $ subsingleton.elim _ _⟩ end rat -namespace algebra -open module - -variables (R : Type u) (A : Type v) - -variables [comm_semiring R] [semiring A] [algebra R A] - -/-- `algebra_map` as an `alg_hom`. -/ -def of_id : R →ₐ[R] A := -{ commutes' := λ _, rfl, .. algebra_map R A } -variables {R} - -theorem of_id_apply (r) : of_id R A r = algebra_map R A r := rfl - -end algebra - section int variables (R : Type*) [ring R] @@ -1330,7 +669,7 @@ variables (R : Type*) [ring R] smul_def' := λ _ _, zsmul_eq_mul _ _, to_ring_hom := int.cast_ring_hom R } -/-- A special case of `ring_hom.eq_int_cast'` that happens to be true definitionally -/ +/-- A special case of `eq_int_cast'` that happens to be true definitionally -/ @[simp] lemma algebra_map_int_eq : algebra_map ℤ R = int.cast_ring_hom R := rfl variables {R} @@ -1340,104 +679,63 @@ instance int_algebra_subsingleton : subsingleton (algebra ℤ R) := end int -/-! -The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra. +namespace no_zero_smul_divisors + +variables {R A : Type*} + +open algebra + +/-- If `algebra_map R A` is injective and `A` has no zero divisors, +`R`-multiples in `A` are zero only if one of the factors is zero. -We couldn't set this up back in `algebra.pi_instances` because this file imports it. +Cannot be an instance because there is no `injective (algebra_map R A)` typeclass. -/ -namespace pi - -variable {I : Type u} -- The indexing type -variable {R : Type*} -- The scalar type -variable {f : I → Type v} -- The family of types already equipped with instances -variables (x y : Π i, f i) (i : I) -variables (I f) - -instance algebra {r : comm_semiring R} - [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] : - algebra R (Π i : I, f i) := -{ commutes' := λ a f, begin ext, simp [algebra.commutes], end, - smul_def' := λ a f, begin ext, simp [algebra.smul_def], end, - ..(pi.ring_hom (λ i, algebra_map R (f i)) : R →+* Π i : I, f i) } - -@[simp] lemma algebra_map_apply {r : comm_semiring R} - [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) (i : I) : - algebra_map R (Π i, f i) a i = algebra_map R (f i) a := rfl - --- One could also build a `Π i, R i`-algebra structure on `Π i, A i`, --- when each `A i` is an `R i`-algebra, although I'm not sure that it's useful. - -variables {I} (R) (f) - -/-- `function.eval` as an `alg_hom`. The name matches `pi.eval_ring_hom`, `pi.eval_monoid_hom`, -etc. -/ -@[simps] -def eval_alg_hom {r : comm_semiring R} [Π i, semiring (f i)] [Π i, algebra R (f i)] (i : I) : - (Π i, f i) →ₐ[R] f i := -{ to_fun := λ f, f i, commutes' := λ r, rfl, .. pi.eval_ring_hom f i} - -variables (A B : Type*) [comm_semiring R] [semiring B] [algebra R B] - -/-- `function.const` as an `alg_hom`. The name matches `pi.const_ring_hom`, `pi.const_monoid_hom`, -etc. -/ -@[simps] -def const_alg_hom : B →ₐ[R] (A → B) := -{ to_fun := function.const _, - commutes' := λ r, rfl, - .. pi.const_ring_hom A B} - -/-- When `R` is commutative and permits an `algebra_map`, `pi.const_ring_hom` is equal to that -map. -/ -@[simp] lemma const_ring_hom_eq_algebra_map : const_ring_hom A R = algebra_map R (A → R) := -rfl +lemma of_algebra_map_injective + [comm_semiring R] [semiring A] [algebra R A] [no_zero_divisors A] + (h : function.injective (algebra_map R A)) : no_zero_smul_divisors R A := +⟨λ c x hcx, (mul_eq_zero.mp ((smul_def c x).symm.trans hcx)).imp_left + (map_eq_zero_iff (algebra_map R A) h).mp⟩ -@[simp] lemma const_alg_hom_eq_algebra_of_id : const_alg_hom R A R = algebra.of_id R (A → R) := -rfl +variables (R A) +lemma algebra_map_injective [comm_ring R] [ring A] [nontrivial A] + [algebra R A] [no_zero_smul_divisors R A] : + function.injective (algebra_map R A) := +suffices function.injective (λ (c : R), c • (1 : A)), +by { convert this, ext, rw [algebra.smul_def, mul_one] }, +smul_left_injective R one_ne_zero -end pi +lemma _root_.ne_zero.of_no_zero_smul_divisors (n : ℕ) [comm_ring R] [ne_zero (n : R)] [ring A] + [nontrivial A] [algebra R A] [no_zero_smul_divisors R A] : ne_zero (n : A) := +ne_zero.nat_of_injective $ no_zero_smul_divisors.algebra_map_injective R A -/-- A special case of `pi.algebra` for non-dependent types. Lean struggles to elaborate -definitions elsewhere in the library without this, -/ -instance function.algebra {R : Type*} (I : Type*) (A : Type*) [comm_semiring R] - [semiring A] [algebra R A] : algebra R (I → A) := -pi.algebra _ _ +variables {R A} +lemma iff_algebra_map_injective [comm_ring R] [ring A] [is_domain A] [algebra R A] : + no_zero_smul_divisors R A ↔ function.injective (algebra_map R A) := +⟨@@no_zero_smul_divisors.algebra_map_injective R A _ _ _ _, + no_zero_smul_divisors.of_algebra_map_injective⟩ -namespace alg_equiv +@[priority 100] -- see note [lower instance priority] +instance char_zero.no_zero_smul_divisors_nat [semiring R] [no_zero_divisors R] [char_zero R] : + no_zero_smul_divisors ℕ R := +no_zero_smul_divisors.of_algebra_map_injective $ (algebra_map ℕ R).injective_nat -/-- A family of algebra equivalences `Π j, (A₁ j ≃ₐ A₂ j)` generates a -multiplicative equivalence between `Π j, A₁ j` and `Π j, A₂ j`. +@[priority 100] -- see note [lower instance priority] +instance char_zero.no_zero_smul_divisors_int [ring R] [no_zero_divisors R] [char_zero R] : + no_zero_smul_divisors ℤ R := +no_zero_smul_divisors.of_algebra_map_injective $ (algebra_map ℤ R).injective_int -This is the `alg_equiv` version of `equiv.Pi_congr_right`, and the dependent version of -`alg_equiv.arrow_congr`. --/ -@[simps apply] -def Pi_congr_right {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R] - [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] - (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Π i, A₁ i) ≃ₐ[R] Π i, A₂ i := -{ to_fun := λ x j, e j (x j), - inv_fun := λ x j, (e j).symm (x j), - commutes' := λ r, by { ext i, simp }, - .. @ring_equiv.Pi_congr_right ι A₁ A₂ _ _ (λ i, (e i).to_ring_equiv) } +section field -@[simp] -lemma Pi_congr_right_refl {R ι : Type*} {A : ι → Type*} [comm_semiring R] - [Π i, semiring (A i)] [Π i, algebra R (A i)] : - Pi_congr_right (λ i, (alg_equiv.refl : A i ≃ₐ[R] A i)) = alg_equiv.refl := rfl +variables [field R] [semiring A] [algebra R A] -@[simp] -lemma Pi_congr_right_symm {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R] - [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] - (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Pi_congr_right e).symm = (Pi_congr_right $ λ i, (e i).symm) := rfl +@[priority 100] -- see note [lower instance priority] +instance algebra.no_zero_smul_divisors [nontrivial A] [no_zero_divisors A] : + no_zero_smul_divisors R A := +no_zero_smul_divisors.of_algebra_map_injective (algebra_map R A).injective -@[simp] -lemma Pi_congr_right_trans {R ι : Type*} {A₁ A₂ A₃ : ι → Type*} [comm_semiring R] - [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, semiring (A₃ i)] - [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] [Π i, algebra R (A₃ i)] - (e₁ : Π i, A₁ i ≃ₐ[R] A₂ i) (e₂ : Π i, A₂ i ≃ₐ[R] A₃ i) : - (Pi_congr_right e₁).trans (Pi_congr_right e₂) = (Pi_congr_right $ λ i, (e₁ i).trans (e₂ i)) := -rfl +end field -end alg_equiv +end no_zero_smul_divisors section is_scalar_tower @@ -1452,6 +750,10 @@ by rw [←(one_smul A m), ←smul_assoc, algebra.smul_def, mul_one, one_smul] @[simp] lemma algebra_map_smul (r : R) (m : M) : ((algebra_map R A) r) • m = r • m := (algebra_compatible_smul A r m).symm +lemma int_cast_smul {k V : Type*} [comm_ring k] [add_comm_group V] [module k V] (r : ℤ) (x : V) : + (r : k) • x = r • x := +algebra_map_smul k r x + lemma no_zero_smul_divisors.trans (R A M : Type*) [comm_ring R] [ring A] [is_domain A] [algebra R A] [add_comm_group M] [module R M] [module A M] [is_scalar_tower R A M] [no_zero_smul_divisors R A] [no_zero_smul_divisors A M] : no_zero_smul_divisors R M := @@ -1478,6 +780,11 @@ instance is_scalar_tower.to_smul_comm_class : smul_comm_class R A M := instance is_scalar_tower.to_smul_comm_class' : smul_comm_class A R M := smul_comm_class.symm _ _ _ +@[priority 200] -- see Note [lower instance priority] +instance algebra.to_smul_comm_class {R A} [comm_semiring R] [semiring A] [algebra R A] : + smul_comm_class R A A := +is_scalar_tower.to_smul_comm_class + lemma smul_algebra_smul_comm (r : R) (a : A) (m : M) : a • r • m = r • a • m := smul_comm _ _ _ @@ -1513,7 +820,7 @@ are all defined in `linear_algebra/basic.lean`. -/ section module open module -variables (R S M N : Type*) [semiring R] [semiring S] [has_scalar R S] +variables (R S M N : Type*) [semiring R] [semiring S] [has_smul R S] variables [add_comm_monoid M] [module R M] [module S M] [is_scalar_tower R S M] variables [add_comm_monoid N] [module R N] [module S N] [is_scalar_tower R S N] @@ -1526,41 +833,6 @@ rfl end module -namespace submodule - -variables (R A M : Type*) -variables [comm_semiring R] [semiring A] [algebra R A] [add_comm_monoid M] -variables [module R M] [module A M] [is_scalar_tower R A M] - -/-- If `A` is an `R`-algebra such that the induced morhpsim `R →+* A` is surjective, then the -`R`-module generated by a set `X` equals the `A`-module generated by `X`. -/ -lemma span_eq_restrict_scalars (X : set M) (hsur : function.surjective (algebra_map R A)) : - span R X = restrict_scalars R (span A X) := -begin - apply (span_le_restrict_scalars R A X).antisymm (λ m hm, _), - refine span_induction hm subset_span (zero_mem _) (λ _ _, add_mem) (λ a m hm, _), - obtain ⟨r, rfl⟩ := hsur a, - simpa [algebra_map_smul] using smul_mem _ r hm -end - -end submodule - -namespace alg_hom - -variables {R : Type u} {A : Type v} {B : Type w} {I : Type*} - -variables [comm_semiring R] [semiring A] [semiring B] -variables [algebra R A] [algebra R B] - -/-- `R`-algebra homomorphism between the function spaces `I → A` and `I → B`, induced by an -`R`-algebra homomorphism `f` between `A` and `B`. -/ -@[simps] protected def comp_left (f : A →ₐ[R] B) (I : Type*) : (I → A) →ₐ[R] (I → B) := -{ to_fun := λ h, f ∘ h, - commutes' := λ c, by { ext, exact f.commutes' c }, - .. f.to_ring_hom.comp_left I } - -end alg_hom - example {R A} [comm_semiring R] [semiring A] [module R A] [smul_comm_class R A A] [is_scalar_tower R A A] : algebra R A := algebra.of_module smul_mul_assoc mul_smul_comm diff --git a/src/algebra/algebra/bilinear.lean b/src/algebra/algebra/bilinear.lean index ab8021367987b..45a9fb400d793 100644 --- a/src/algebra/algebra/bilinear.lean +++ b/src/algebra/algebra/bilinear.lean @@ -5,153 +5,190 @@ Authors: Kenny Lau, Yury Kudryashov -/ import algebra.algebra.basic import algebra.hom.iterate +import algebra.hom.non_unital_alg import linear_algebra.tensor_product /-! # Facts about algebras involving bilinear maps and tensor products +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We move a few basic statements about algebras out of `algebra.algebra.basic`, in order to avoid importing `linear_algebra.bilinear_map` and `linear_algebra.tensor_product` unnecessarily. -/ -universes u v w - -namespace algebra - open_locale tensor_product open module -section +namespace linear_map -variables (R A : Type*) [comm_semiring R] [semiring A] [algebra R A] +section non_unital_non_assoc + +variables (R A : Type*) [comm_semiring R] [non_unital_non_assoc_semiring A] + [module R A] [smul_comm_class R A A] [is_scalar_tower R A A] -/-- The multiplication in an algebra is a bilinear map. +/-- The multiplication in a non-unital non-associative algebra is a bilinear map. A weaker version of this for semirings exists as `add_monoid_hom.mul`. -/ -def lmul : A →ₐ[R] (End R A) := -{ map_one' := by { ext a, exact one_mul a }, - map_mul' := by { intros a b, ext c, exact mul_assoc a b c }, - map_zero' := by { ext a, exact zero_mul a }, - commutes' := by { intro r, ext a, dsimp, rw [smul_def] }, - .. (show A →ₗ[R] A →ₗ[R] A, from linear_map.mk₂ R (*) - (λ x y z, add_mul x y z) - (λ c x y, by rw [smul_def, smul_def, mul_assoc _ x y]) - (λ x y z, mul_add x y z) - (λ c x y, by rw [smul_def, smul_def, left_comm])) } +def mul : A →ₗ[R] A →ₗ[R] A := linear_map.mk₂ R (*) add_mul smul_mul_assoc mul_add mul_smul_comm -variables {R A} +/-- The multiplication map on a non-unital algebra, as an `R`-linear map from `A ⊗[R] A` to `A`. -/ +def mul' : A ⊗[R] A →ₗ[R] A := +tensor_product.lift (mul R A) + +variables {A} -@[simp] lemma lmul_apply (p q : A) : lmul R A p q = p * q := rfl +/-- The multiplication on the left in a non-unital algebra is a linear map. -/ +def mul_left (a : A) : A →ₗ[R] A := mul R A a +/-- The multiplication on the right in an algebra is a linear map. -/ +def mul_right (a : A) : A →ₗ[R] A := (mul R A).flip a -variables (R) +/-- Simultaneous multiplication on the left and right is a linear map. -/ +def mul_left_right (ab : A × A) : A →ₗ[R] A := (mul_right R ab.snd).comp (mul_left R ab.fst) -/-- The multiplication on the left in an algebra is a linear map. -/ -def lmul_left (r : A) : A →ₗ[R] A := -lmul R A r +@[simp] lemma mul_left_to_add_monoid_hom (a : A) : + (mul_left R a : A →+ A) = add_monoid_hom.mul_left a := rfl -@[simp] lemma lmul_left_to_add_monoid_hom (r : A) : - (lmul_left R r : A →+ A) = add_monoid_hom.mul_left r := -fun_like.coe_injective rfl +@[simp] lemma mul_right_to_add_monoid_hom (a : A) : + (mul_right R a : A →+ A) = add_monoid_hom.mul_right a := rfl -/-- The multiplication on the right in an algebra is a linear map. -/ -def lmul_right (r : A) : A →ₗ[R] A := -(lmul R A).to_linear_map.flip r +variables {R} -@[simp] lemma lmul_right_to_add_monoid_hom (r : A) : - (lmul_right R r : A →+ A) = add_monoid_hom.mul_right r := -fun_like.coe_injective rfl +@[simp] lemma mul_apply' (a b : A) : mul R A a b = a * b := rfl +@[simp] lemma mul_left_apply (a b : A) : mul_left R a b = a * b := rfl +@[simp] lemma mul_right_apply (a b : A) : mul_right R a b = b * a := rfl +@[simp] lemma mul_left_right_apply (a b x : A) : mul_left_right R (a, b) x = a * x * b := rfl -/-- Simultaneous multiplication on the left and right is a linear map. -/ -def lmul_left_right (vw: A × A) : A →ₗ[R] A := -(lmul_right R vw.2).comp (lmul_left R vw.1) +@[simp] lemma mul'_apply {a b : A} : mul' R A (a ⊗ₜ b) = a * b := rfl -lemma commute_lmul_left_right (a b : A) : - commute (lmul_left R a) (lmul_right R b) := -by { ext c, exact (mul_assoc a c b).symm, } +@[simp] lemma mul_left_zero_eq_zero : + mul_left R (0 : A) = 0 := +(mul R A).map_zero + +@[simp] lemma mul_right_zero_eq_zero : + mul_right R (0 : A) = 0 := +(mul R A).flip.map_zero + +end non_unital_non_assoc + +section non_unital + +variables (R A : Type*) [comm_semiring R] [non_unital_semiring A] + [module R A] [smul_comm_class R A A] [is_scalar_tower R A A] + +/-- The multiplication in a non-unital algebra is a bilinear map. -/-- The multiplication map on an algebra, as an `R`-linear map from `A ⊗[R] A` to `A`. -/ -def lmul' : A ⊗[R] A →ₗ[R] A := -tensor_product.lift (lmul R A).to_linear_map +A weaker version of this for non-unital non-associative algebras exists as `linear_map.mul`. -/ +def _root_.non_unital_alg_hom.lmul : A →ₙₐ[R] (End R A) := +{ map_mul' := by { intros a b, ext c, exact mul_assoc a b c }, + map_zero' := by { ext a, exact zero_mul a }, + .. (mul R A) } variables {R A} -@[simp] lemma lmul'_apply {x y : A} : lmul' R (x ⊗ₜ y) = x * y := -by simp only [algebra.lmul', tensor_product.lift.tmul, alg_hom.to_linear_map_apply, lmul_apply] +@[simp] +lemma _root_.non_unital_alg_hom.coe_lmul_eq_mul : ⇑(non_unital_alg_hom.lmul R A) = mul R A := rfl + +lemma commute_mul_left_right (a b : A) : + commute (mul_left R a) (mul_right R b) := +by { ext c, exact (mul_assoc a c b).symm, } + +@[simp] lemma mul_left_mul (a b : A) : + mul_left R (a * b) = (mul_left R a).comp (mul_left R b) := +by { ext, simp only [mul_left_apply, comp_apply, mul_assoc] } + +@[simp] lemma mul_right_mul (a b : A) : + mul_right R (a * b) = (mul_right R b).comp (mul_right R a) := +by { ext, simp only [mul_right_apply, comp_apply, mul_assoc] } -@[simp] lemma lmul_left_apply (p q : A) : lmul_left R p q = p * q := rfl -@[simp] lemma lmul_right_apply (p q : A) : lmul_right R p q = q * p := rfl -@[simp] lemma lmul_left_right_apply (vw : A × A) (p : A) : - lmul_left_right R vw p = vw.1 * p * vw.2 := rfl +end non_unital -@[simp] lemma lmul_left_one : lmul_left R (1:A) = linear_map.id := -by { ext, simp only [linear_map.id_coe, one_mul, id.def, lmul_left_apply] } +section semiring -@[simp] lemma lmul_left_mul (a b : A) : - lmul_left R (a * b) = (lmul_left R a).comp (lmul_left R b) := -by { ext, simp only [lmul_left_apply, linear_map.comp_apply, mul_assoc] } +variables (R A : Type*) [comm_semiring R] [semiring A] [algebra R A] -@[simp] lemma lmul_right_one : lmul_right R (1:A) = linear_map.id := -by { ext, simp only [linear_map.id_coe, mul_one, id.def, lmul_right_apply] } +/-- The multiplication in an algebra is an algebra homomorphism into the endomorphisms on +the algebra. -@[simp] lemma lmul_right_mul (a b : A) : - lmul_right R (a * b) = (lmul_right R b).comp (lmul_right R a) := -by { ext, simp only [lmul_right_apply, linear_map.comp_apply, mul_assoc] } +A weaker version of this for non-unital algebras exists as `non_unital_alg_hom.mul`. -/ +def _root_.algebra.lmul : A →ₐ[R] (End R A) := +{ map_one' := by { ext a, exact one_mul a }, + map_mul' := by { intros a b, ext c, exact mul_assoc a b c }, + map_zero' := by { ext a, exact zero_mul a }, + commutes' := by { intro r, ext a, exact (algebra.smul_def r a).symm, }, + .. (linear_map.mul R A) } -@[simp] lemma lmul_left_zero_eq_zero : - lmul_left R (0 : A) = 0 := -(lmul R A).map_zero +variables {R A} -@[simp] lemma lmul_right_zero_eq_zero : - lmul_right R (0 : A) = 0 := -(lmul R A).to_linear_map.flip.map_zero +@[simp] lemma _root_.algebra.coe_lmul_eq_mul : ⇑(algebra.lmul R A) = mul R A := rfl -@[simp] lemma lmul_left_eq_zero_iff (a : A) : - lmul_left R a = 0 ↔ a = 0 := +@[simp] lemma mul_left_eq_zero_iff (a : A) : + mul_left R a = 0 ↔ a = 0 := begin split; intros h, - { rw [← mul_one a, ← lmul_left_apply a 1, h, linear_map.zero_apply], }, - { rw h, exact lmul_left_zero_eq_zero, }, + { rw [← mul_one a, ← mul_left_apply a 1, h, linear_map.zero_apply], }, + { rw h, exact mul_left_zero_eq_zero, }, end -@[simp] lemma lmul_right_eq_zero_iff (a : A) : - lmul_right R a = 0 ↔ a = 0 := +@[simp] lemma mul_right_eq_zero_iff (a : A) : + mul_right R a = 0 ↔ a = 0 := begin split; intros h, - { rw [← one_mul a, ← lmul_right_apply a 1, h, linear_map.zero_apply], }, - { rw h, exact lmul_right_zero_eq_zero, }, + { rw [← one_mul a, ← mul_right_apply a 1, h, linear_map.zero_apply], }, + { rw h, exact mul_right_zero_eq_zero, }, end -@[simp] lemma pow_lmul_left (a : A) (n : ℕ) : - (lmul_left R a) ^ n = lmul_left R (a ^ n) := -((lmul R A).map_pow a n).symm +@[simp] lemma mul_left_one : mul_left R (1:A) = linear_map.id := +by { ext, simp only [linear_map.id_coe, one_mul, id.def, mul_left_apply] } -@[simp] lemma pow_lmul_right (a : A) (n : ℕ) : - (lmul_right R a) ^ n = lmul_right R (a ^ n) := -linear_map.coe_injective $ ((lmul_right R a).coe_pow n).symm ▸ (mul_right_iterate a n) +@[simp] lemma mul_right_one : mul_right R (1:A) = linear_map.id := +by { ext, simp only [linear_map.id_coe, mul_one, id.def, mul_right_apply] } +@[simp] lemma pow_mul_left (a : A) (n : ℕ) : + (mul_left R a) ^ n = mul_left R (a ^ n) := +by simpa only [mul_left, ←algebra.coe_lmul_eq_mul] using ((algebra.lmul R A).map_pow a n).symm + +@[simp] lemma pow_mul_right (a : A) (n : ℕ) : + (mul_right R a) ^ n = mul_right R (a ^ n) := +begin + simp only [mul_right, ←algebra.coe_lmul_eq_mul], + exact linear_map.coe_injective + (((mul_right R a).coe_pow n).symm ▸ (mul_right_iterate a n)), end -section +end semiring -variables {R A : Type*} [comm_semiring R] [ring A] [algebra R A] +section ring -lemma lmul_left_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) : - function.injective (lmul_left R x) := -by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› }, - exact mul_right_injective₀ hx } +variables {R A : Type*} [comm_semiring R] [ring A] [algebra R A] -lemma lmul_right_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) : - function.injective (lmul_right R x) := -by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› }, - exact mul_left_injective₀ hx } +lemma mul_left_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) : + function.injective (mul_left R x) := +begin + letI : nontrivial A := ⟨⟨x, 0, hx⟩⟩, + letI := no_zero_divisors.to_is_domain A, + exact mul_right_injective₀ hx, +end -lemma lmul_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) : - function.injective (lmul R A x) := -by { letI : is_domain A := { exists_pair_ne := ⟨x, 0, hx⟩, ..‹ring A›, ..‹no_zero_divisors A› }, - exact mul_right_injective₀ hx } +lemma mul_right_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) : + function.injective (mul_right R x) := +begin + letI : nontrivial A := ⟨⟨x, 0, hx⟩⟩, + letI := no_zero_divisors.to_is_domain A, + exact mul_left_injective₀ hx, +end +lemma mul_injective [no_zero_divisors A] {x : A} (hx : x ≠ 0) : + function.injective (mul R A x) := +begin + letI : nontrivial A := ⟨⟨x, 0, hx⟩⟩, + letI := no_zero_divisors.to_is_domain A, + exact mul_right_injective₀ hx, end -end algebra +end ring + +end linear_map diff --git a/src/algebra/algebra/equiv.lean b/src/algebra/algebra/equiv.lean new file mode 100644 index 0000000000000..09a946d990821 --- /dev/null +++ b/src/algebra/algebra/equiv.lean @@ -0,0 +1,528 @@ +/- +Copyright (c) 2018 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau, Yury Kudryashov +-/ +import algebra.algebra.hom + +/-! +# Isomorphisms of `R`-algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines bundled isomorphisms of `R`-algebras. + +## Main definitions + +* `alg_equiv R A B`: the type of `R`-algebra isomorphisms between `A` and `B`. + +## Notations + +* `A ≃ₐ[R] B` : `R`-algebra equivalence from `A` to `B`. +-/ + +open_locale big_operators + +universes u v w u₁ v₁ + +set_option old_structure_cmd true +/-- An equivalence of algebras is an equivalence of rings commuting with the actions of scalars. -/ +structure alg_equiv (R : Type u) (A : Type v) (B : Type w) + [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] + extends A ≃ B, A ≃* B, A ≃+ B, A ≃+* B := +(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r) + +attribute [nolint doc_blame] alg_equiv.to_ring_equiv +attribute [nolint doc_blame] alg_equiv.to_equiv +attribute [nolint doc_blame] alg_equiv.to_add_equiv +attribute [nolint doc_blame] alg_equiv.to_mul_equiv + +notation A ` ≃ₐ[`:50 R `] ` A' := alg_equiv R A A' + +/-- `alg_equiv_class F R A B` states that `F` is a type of algebra structure preserving + equivalences. You should extend this class when you extend `alg_equiv`. -/ +class alg_equiv_class (F : Type*) (R A B : out_param Type*) + [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] + extends ring_equiv_class F A B := +(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r) + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] alg_equiv_class.to_ring_equiv_class + +namespace alg_equiv_class + +@[priority 100] -- See note [lower instance priority] +instance to_alg_hom_class (F R A B : Type*) + [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] + [h : alg_equiv_class F R A B] : alg_hom_class F R A B := +{ coe := coe_fn, + coe_injective' := fun_like.coe_injective, + map_zero := map_zero, + map_one := map_one, + .. h } + +@[priority 100] +instance to_linear_equiv_class (F R A B : Type*) + [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] + [h : alg_equiv_class F R A B] : linear_equiv_class F R A B := +{ map_smulₛₗ := λ f, map_smulₛₗ f, + ..h } + +instance (F R A B : Type*) [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] + [h : alg_equiv_class F R A B] : has_coe_t F (A ≃ₐ[R] B) := +{ coe := λ f, + { to_fun := f, + inv_fun := equiv_like.inv f, + commutes' := alg_hom_class.commutes f, + .. (f : A ≃+* B) } } + +end alg_equiv_class + +namespace alg_equiv + +variables {R : Type u} {A₁ : Type v} {A₂ : Type w} {A₃ : Type u₁} + +section semiring + +variables [comm_semiring R] [semiring A₁] [semiring A₂] [semiring A₃] +variables [algebra R A₁] [algebra R A₂] [algebra R A₃] +variables (e : A₁ ≃ₐ[R] A₂) + +instance : alg_equiv_class (A₁ ≃ₐ[R] A₂) R A₁ A₂ := +{ coe := to_fun, + inv := inv_fun, + coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' }, + map_add := map_add', + map_mul := map_mul', + commutes := commutes', + left_inv := left_inv, + right_inv := right_inv } + +/-- Helper instance for when there's too many metavariables to apply +`fun_like.has_coe_to_fun` directly. -/ +instance : has_coe_to_fun (A₁ ≃ₐ[R] A₂) (λ _, A₁ → A₂) := ⟨alg_equiv.to_fun⟩ + +@[simp, protected] lemma coe_coe {F : Type*} [alg_equiv_class F R A₁ A₂] (f : F) : + ⇑(f : A₁ ≃ₐ[R] A₂) = f := rfl + +@[ext] +lemma ext {f g : A₁ ≃ₐ[R] A₂} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h + +protected lemma congr_arg {f : A₁ ≃ₐ[R] A₂} {x x' : A₁} : x = x' → f x = f x' := +fun_like.congr_arg f + +protected lemma congr_fun {f g : A₁ ≃ₐ[R] A₂} (h : f = g) (x : A₁) : f x = g x := +fun_like.congr_fun h x + +protected lemma ext_iff {f g : A₁ ≃ₐ[R] A₂} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff + +lemma coe_fun_injective : @function.injective (A₁ ≃ₐ[R] A₂) (A₁ → A₂) (λ e, (e : A₁ → A₂)) := +fun_like.coe_injective + +instance has_coe_to_ring_equiv : has_coe (A₁ ≃ₐ[R] A₂) (A₁ ≃+* A₂) := ⟨alg_equiv.to_ring_equiv⟩ + +@[simp] lemma coe_mk {to_fun inv_fun left_inv right_inv map_mul map_add commutes} : + ⇑(⟨to_fun, inv_fun, left_inv, right_inv, map_mul, map_add, commutes⟩ : A₁ ≃ₐ[R] A₂) = to_fun := +rfl + +@[simp] theorem mk_coe (e : A₁ ≃ₐ[R] A₂) (e' h₁ h₂ h₃ h₄ h₅) : + (⟨e, e', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂) = e := ext $ λ _, rfl + +@[simp] lemma to_fun_eq_coe (e : A₁ ≃ₐ[R] A₂) : e.to_fun = e := rfl + +@[simp] lemma to_equiv_eq_coe : e.to_equiv = e := rfl + +@[simp] lemma to_ring_equiv_eq_coe : e.to_ring_equiv = e := rfl + +@[simp, norm_cast] lemma coe_ring_equiv : ((e : A₁ ≃+* A₂) : A₁ → A₂) = e := rfl + +lemma coe_ring_equiv' : (e.to_ring_equiv : A₁ → A₂) = e := rfl + +lemma coe_ring_equiv_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ ≃+* A₂)) := +λ e₁ e₂ h, ext $ ring_equiv.congr_fun h + +protected lemma map_add : ∀ x y, e (x + y) = e x + e y := map_add e +protected lemma map_zero : e 0 = 0 := map_zero e +protected lemma map_mul : ∀ x y, e (x * y) = (e x) * (e y) := map_mul e +protected lemma map_one : e 1 = 1 := map_one e + +@[simp] lemma commutes : ∀ (r : R), e (algebra_map R A₁ r) = algebra_map R A₂ r := + e.commutes' + +@[simp] lemma map_smul (r : R) (x : A₁) : e (r • x) = r • e x := +by simp only [algebra.smul_def, map_mul, commutes] + +lemma map_sum {ι : Type*} (f : ι → A₁) (s : finset ι) : + e (∑ x in s, f x) = ∑ x in s, e (f x) := +e.to_add_equiv.map_sum f s + +lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) : + e (f.sum g) = f.sum (λ i b, e (g i b)) := +e.map_sum _ _ + +/-- Interpret an algebra equivalence as an algebra homomorphism. + +This definition is included for symmetry with the other `to_*_hom` projections. +The `simp` normal form is to use the coercion of the `alg_hom_class.has_coe_t` instance. -/ +def to_alg_hom : A₁ →ₐ[R] A₂ := +{ map_one' := e.map_one, map_zero' := e.map_zero, ..e } + +@[simp] lemma to_alg_hom_eq_coe : e.to_alg_hom = e := rfl + +@[simp, norm_cast] lemma coe_alg_hom : ((e : A₁ →ₐ[R] A₂) : A₁ → A₂) = e := +rfl + +lemma coe_alg_hom_injective : function.injective (coe : (A₁ ≃ₐ[R] A₂) → (A₁ →ₐ[R] A₂)) := +λ e₁ e₂ h, ext $ alg_hom.congr_fun h + +/-- The two paths coercion can take to a `ring_hom` are equivalent -/ +lemma coe_ring_hom_commutes : ((e : A₁ →ₐ[R] A₂) : A₁ →+* A₂) = ((e : A₁ ≃+* A₂) : A₁ →+* A₂) := +rfl + +protected lemma map_pow : ∀ (x : A₁) (n : ℕ), e (x ^ n) = (e x) ^ n := map_pow _ +protected lemma injective : function.injective e := equiv_like.injective e +protected lemma surjective : function.surjective e := equiv_like.surjective e +protected lemma bijective : function.bijective e := equiv_like.bijective e + +/-- Algebra equivalences are reflexive. -/ +@[refl] def refl : A₁ ≃ₐ[R] A₁ := {commutes' := λ r, rfl, ..(1 : A₁ ≃+* A₁)} + +instance : inhabited (A₁ ≃ₐ[R] A₁) := ⟨refl⟩ + +@[simp] lemma refl_to_alg_hom : ↑(refl : A₁ ≃ₐ[R] A₁) = alg_hom.id R A₁ := rfl + +@[simp] lemma coe_refl : ⇑(refl : A₁ ≃ₐ[R] A₁) = id := rfl + +/-- Algebra equivalences are symmetric. -/ +@[symm] +def symm (e : A₁ ≃ₐ[R] A₂) : A₂ ≃ₐ[R] A₁ := +{ commutes' := λ r, by { rw ←e.to_ring_equiv.symm_apply_apply (algebra_map R A₁ r), congr, + change _ = e _, rw e.commutes, }, + ..e.to_ring_equiv.symm, } + +/-- See Note [custom simps projection] -/ +def simps.symm_apply (e : A₁ ≃ₐ[R] A₂) : A₂ → A₁ := e.symm + +initialize_simps_projections alg_equiv (to_fun → apply, inv_fun → symm_apply) + +@[simp] lemma coe_apply_coe_coe_symm_apply {F : Type*} [alg_equiv_class F R A₁ A₂] + (f : F) (x : A₂) : f ((f : A₁ ≃ₐ[R] A₂).symm x) = x := equiv_like.right_inv f x + +@[simp] lemma coe_coe_symm_apply_coe_apply {F : Type*} [alg_equiv_class F R A₁ A₂] + (f : F) (x : A₁) : (f : A₁ ≃ₐ[R] A₂).symm (f x) = x := equiv_like.left_inv f x + +@[simp] lemma inv_fun_eq_symm {e : A₁ ≃ₐ[R] A₂} : e.inv_fun = e.symm := rfl + +@[simp] lemma symm_symm (e : A₁ ≃ₐ[R] A₂) : e.symm.symm = e := +by { ext, refl, } + +lemma symm_bijective : function.bijective (symm : (A₁ ≃ₐ[R] A₂) → (A₂ ≃ₐ[R] A₁)) := +equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩ + +@[simp] lemma mk_coe' (e : A₁ ≃ₐ[R] A₂) (f h₁ h₂ h₃ h₄ h₅) : + (⟨f, e, h₁, h₂, h₃, h₄, h₅⟩ : A₂ ≃ₐ[R] A₁) = e.symm := +symm_bijective.injective $ ext $ λ x, rfl + +@[simp] theorem symm_mk (f f') (h₁ h₂ h₃ h₄ h₅) : + (⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm = + { to_fun := f', inv_fun := f, + ..(⟨f, f', h₁, h₂, h₃, h₄, h₅⟩ : A₁ ≃ₐ[R] A₂).symm } := rfl + +@[simp] theorem refl_symm : (alg_equiv.refl : A₁ ≃ₐ[R] A₁).symm = alg_equiv.refl := rfl + +--this should be a simp lemma but causes a lint timeout +lemma to_ring_equiv_symm (f : A₁ ≃ₐ[R] A₁) : (f : A₁ ≃+* A₁).symm = f.symm := rfl + +@[simp] lemma symm_to_ring_equiv : (e.symm : A₂ ≃+* A₁) = (e : A₁ ≃+* A₂).symm := rfl + +/-- Algebra equivalences are transitive. -/ +@[trans] +def trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : A₁ ≃ₐ[R] A₃ := +{ commutes' := λ r, show e₂.to_fun (e₁.to_fun _) = _, by rw [e₁.commutes', e₂.commutes'], + ..(e₁.to_ring_equiv.trans e₂.to_ring_equiv), } + +@[simp] lemma apply_symm_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e (e.symm x) = x := + e.to_equiv.apply_symm_apply + +@[simp] lemma symm_apply_apply (e : A₁ ≃ₐ[R] A₂) : ∀ x, e.symm (e x) = x := + e.to_equiv.symm_apply_apply + +@[simp] lemma symm_trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₃) : + (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl + +@[simp] lemma coe_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : + ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl + +@[simp] lemma trans_apply (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) (x : A₁) : + (e₁.trans e₂) x = e₂ (e₁ x) := rfl + +@[simp] lemma comp_symm (e : A₁ ≃ₐ[R] A₂) : + alg_hom.comp (e : A₁ →ₐ[R] A₂) ↑e.symm = alg_hom.id R A₂ := +by { ext, simp } + +@[simp] lemma symm_comp (e : A₁ ≃ₐ[R] A₂) : + alg_hom.comp ↑e.symm (e : A₁ →ₐ[R] A₂) = alg_hom.id R A₁ := +by { ext, simp } + +theorem left_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.left_inverse e.symm e := e.left_inv + +theorem right_inverse_symm (e : A₁ ≃ₐ[R] A₂) : function.right_inverse e.symm e := e.right_inv + +/-- If `A₁` is equivalent to `A₁'` and `A₂` is equivalent to `A₂'`, then the type of maps +`A₁ →ₐ[R] A₂` is equivalent to the type of maps `A₁' →ₐ[R] A₂'`. -/ +def arrow_congr {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] [algebra R A₁'] [algebra R A₂'] + (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : (A₁ →ₐ[R] A₂) ≃ (A₁' →ₐ[R] A₂') := +{ to_fun := λ f, (e₂.to_alg_hom.comp f).comp e₁.symm.to_alg_hom, + inv_fun := λ f, (e₂.symm.to_alg_hom.comp f).comp e₁.to_alg_hom, + left_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, symm_comp], + simp only [←alg_hom.comp_assoc, symm_comp, alg_hom.id_comp, alg_hom.comp_id] }, + right_inv := λ f, by { simp only [alg_hom.comp_assoc, to_alg_hom_eq_coe, comp_symm], + simp only [←alg_hom.comp_assoc, comp_symm, alg_hom.id_comp, alg_hom.comp_id] } } + +lemma arrow_congr_comp {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃'] + [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') + (e₃ : A₃ ≃ₐ[R] A₃') (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₃) : + arrow_congr e₁ e₃ (g.comp f) = (arrow_congr e₂ e₃ g).comp (arrow_congr e₁ e₂ f) := +by { ext, simp only [arrow_congr, equiv.coe_fn_mk, alg_hom.comp_apply], + congr, exact (e₂.symm_apply_apply _).symm } + +@[simp] lemma arrow_congr_refl : + arrow_congr alg_equiv.refl alg_equiv.refl = equiv.refl (A₁ →ₐ[R] A₂) := +by { ext, refl } + +@[simp] lemma arrow_congr_trans {A₁' A₂' A₃' : Type*} [semiring A₁'] [semiring A₂'] [semiring A₃'] + [algebra R A₁'] [algebra R A₂'] [algebra R A₃'] (e₁ : A₁ ≃ₐ[R] A₂) (e₁' : A₁' ≃ₐ[R] A₂') + (e₂ : A₂ ≃ₐ[R] A₃) (e₂' : A₂' ≃ₐ[R] A₃') : + arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') := +by { ext, refl } + +@[simp] lemma arrow_congr_symm {A₁' A₂' : Type*} [semiring A₁'] [semiring A₂'] + [algebra R A₁'] [algebra R A₂'] (e₁ : A₁ ≃ₐ[R] A₁') (e₂ : A₂ ≃ₐ[R] A₂') : + (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm := +by { ext, refl } + +/-- If an algebra morphism has an inverse, it is a algebra isomorphism. -/ +def of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ : f.comp g = alg_hom.id R A₂) + (h₂ : g.comp f = alg_hom.id R A₁) : A₁ ≃ₐ[R] A₂ := +{ to_fun := f, + inv_fun := g, + left_inv := alg_hom.ext_iff.1 h₂, + right_inv := alg_hom.ext_iff.1 h₁, + ..f } + +lemma coe_alg_hom_of_alg_hom (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) : + ↑(of_alg_hom f g h₁ h₂) = f := alg_hom.ext $ λ _, rfl + +@[simp] +lemma of_alg_hom_coe_alg_hom (f : A₁ ≃ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) : + of_alg_hom ↑f g h₁ h₂ = f := ext $ λ _, rfl + +lemma of_alg_hom_symm (f : A₁ →ₐ[R] A₂) (g : A₂ →ₐ[R] A₁) (h₁ h₂) : + (of_alg_hom f g h₁ h₂).symm = of_alg_hom g f h₂ h₁ := rfl + +/-- Promotes a bijective algebra homomorphism to an algebra equivalence. -/ +noncomputable def of_bijective (f : A₁ →ₐ[R] A₂) (hf : function.bijective f) : A₁ ≃ₐ[R] A₂ := +{ .. ring_equiv.of_bijective (f : A₁ →+* A₂) hf, .. f } + +@[simp] lemma coe_of_bijective {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} : + (alg_equiv.of_bijective f hf : A₁ → A₂) = f := rfl + +lemma of_bijective_apply {f : A₁ →ₐ[R] A₂} {hf : function.bijective f} (a : A₁) : + (alg_equiv.of_bijective f hf) a = f a := rfl + +/-- Forgetting the multiplicative structures, an equivalence of algebras is a linear equivalence. -/ +@[simps apply] def to_linear_equiv (e : A₁ ≃ₐ[R] A₂) : A₁ ≃ₗ[R] A₂ := +{ to_fun := e, + map_smul' := e.map_smul, + inv_fun := e.symm, + .. e } + +@[simp] lemma to_linear_equiv_refl : + (alg_equiv.refl : A₁ ≃ₐ[R] A₁).to_linear_equiv = linear_equiv.refl R A₁ := rfl + +@[simp] lemma to_linear_equiv_symm (e : A₁ ≃ₐ[R] A₂) : + e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl + +@[simp] lemma to_linear_equiv_trans (e₁ : A₁ ≃ₐ[R] A₂) (e₂ : A₂ ≃ₐ[R] A₃) : + (e₁.trans e₂).to_linear_equiv = e₁.to_linear_equiv.trans e₂.to_linear_equiv := rfl + +theorem to_linear_equiv_injective : function.injective (to_linear_equiv : _ → (A₁ ≃ₗ[R] A₂)) := +λ e₁ e₂ h, ext $ linear_equiv.congr_fun h + +/-- Interpret an algebra equivalence as a linear map. -/ +def to_linear_map : A₁ →ₗ[R] A₂ := +e.to_alg_hom.to_linear_map + +@[simp] lemma to_alg_hom_to_linear_map : + (e : A₁ →ₐ[R] A₂).to_linear_map = e.to_linear_map := rfl + +@[simp] lemma to_linear_equiv_to_linear_map : + e.to_linear_equiv.to_linear_map = e.to_linear_map := rfl + +@[simp] lemma to_linear_map_apply (x : A₁) : e.to_linear_map x = e x := rfl + +theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A₁ →ₗ[R] A₂)) := +λ e₁ e₂ h, ext $ linear_map.congr_fun h + +@[simp] lemma trans_to_linear_map (f : A₁ ≃ₐ[R] A₂) (g : A₂ ≃ₐ[R] A₃) : + (f.trans g).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl + +section of_linear_equiv + +variables (l : A₁ ≃ₗ[R] A₂) + (map_mul : ∀ x y : A₁, l (x * y) = l x * l y) + (commutes : ∀ r : R, l (algebra_map R A₁ r) = algebra_map R A₂ r) + +/-- +Upgrade a linear equivalence to an algebra equivalence, +given that it distributes over multiplication and action of scalars. +-/ +@[simps apply] +def of_linear_equiv : A₁ ≃ₐ[R] A₂ := +{ to_fun := l, + inv_fun := l.symm, + map_mul' := map_mul, + commutes' := commutes, + ..l } + +@[simp] +lemma of_linear_equiv_symm : + (of_linear_equiv l map_mul commutes).symm = of_linear_equiv l.symm + ((of_linear_equiv l map_mul commutes).symm.map_mul) + ((of_linear_equiv l map_mul commutes).symm.commutes) := +rfl + +@[simp] lemma of_linear_equiv_to_linear_equiv (map_mul) (commutes) : + of_linear_equiv e.to_linear_equiv map_mul commutes = e := +by { ext, refl } + +@[simp] lemma to_linear_equiv_of_linear_equiv : + to_linear_equiv (of_linear_equiv l map_mul commutes) = l := +by { ext, refl } + +end of_linear_equiv + +section of_ring_equiv + +/-- Promotes a linear ring_equiv to an alg_equiv. -/ +@[simps] +def of_ring_equiv {f : A₁ ≃+* A₂} + (hf : ∀ x, f (algebra_map R A₁ x) = algebra_map R A₂ x) : A₁ ≃ₐ[R] A₂ := +{ to_fun := f, + inv_fun := f.symm, + commutes' := hf, + .. f } + +end of_ring_equiv + +@[simps mul one {attrs := []}] instance aut : group (A₁ ≃ₐ[R] A₁) := +{ mul := λ ϕ ψ, ψ.trans ϕ, + mul_assoc := λ ϕ ψ χ, rfl, + one := refl, + one_mul := λ ϕ, ext $ λ x, rfl, + mul_one := λ ϕ, ext $ λ x, rfl, + inv := symm, + mul_left_inv := λ ϕ, ext $ symm_apply_apply ϕ } + +@[simp] lemma one_apply (x : A₁) : (1 : A₁ ≃ₐ[R] A₁) x = x := rfl + +@[simp] lemma mul_apply (e₁ e₂ : A₁ ≃ₐ[R] A₁) (x : A₁) : (e₁ * e₂) x = e₁ (e₂ x) := rfl + +/-- An algebra isomorphism induces a group isomorphism between automorphism groups -/ +@[simps apply] +def aut_congr (ϕ : A₁ ≃ₐ[R] A₂) : (A₁ ≃ₐ[R] A₁) ≃* (A₂ ≃ₐ[R] A₂) := +{ to_fun := λ ψ, ϕ.symm.trans (ψ.trans ϕ), + inv_fun := λ ψ, ϕ.trans (ψ.trans ϕ.symm), + left_inv := λ ψ, by { ext, simp_rw [trans_apply, symm_apply_apply] }, + right_inv := λ ψ, by { ext, simp_rw [trans_apply, apply_symm_apply] }, + map_mul' := λ ψ χ, by { ext, simp only [mul_apply, trans_apply, symm_apply_apply] } } + +@[simp] lemma aut_congr_refl : aut_congr (alg_equiv.refl) = mul_equiv.refl (A₁ ≃ₐ[R] A₁) := +by { ext, refl } + +@[simp] lemma aut_congr_symm (ϕ : A₁ ≃ₐ[R] A₂) : (aut_congr ϕ).symm = aut_congr ϕ.symm := rfl + +@[simp] lemma aut_congr_trans (ϕ : A₁ ≃ₐ[R] A₂) (ψ : A₂ ≃ₐ[R] A₃) : + (aut_congr ϕ).trans (aut_congr ψ) = aut_congr (ϕ.trans ψ) := rfl + +/-- The tautological action by `A₁ ≃ₐ[R] A₁` on `A₁`. + +This generalizes `function.End.apply_mul_action`. -/ +instance apply_mul_semiring_action : mul_semiring_action (A₁ ≃ₐ[R] A₁) A₁ := +{ smul := ($), + smul_zero := alg_equiv.map_zero, + smul_add := alg_equiv.map_add, + smul_one := alg_equiv.map_one, + smul_mul := alg_equiv.map_mul, + one_smul := λ _, rfl, + mul_smul := λ _ _ _, rfl } + +@[simp] protected lemma smul_def (f : A₁ ≃ₐ[R] A₁) (a : A₁) : f • a = f a := rfl + +instance apply_has_faithful_smul : has_faithful_smul (A₁ ≃ₐ[R] A₁) A₁ := +⟨λ _ _, alg_equiv.ext⟩ + +instance apply_smul_comm_class : smul_comm_class R (A₁ ≃ₐ[R] A₁) A₁ := +{ smul_comm := λ r e a, (e.map_smul r a).symm } + +instance apply_smul_comm_class' : smul_comm_class (A₁ ≃ₐ[R] A₁) R A₁ := +{ smul_comm := λ e r a, (e.map_smul r a) } + +@[simp] lemma algebra_map_eq_apply (e : A₁ ≃ₐ[R] A₂) {y : R} {x : A₁} : + (algebra_map R A₂ y = e x) ↔ (algebra_map R A₁ y = x) := +⟨λ h, by simpa using e.symm.to_alg_hom.algebra_map_eq_apply h, + λ h, e.to_alg_hom.algebra_map_eq_apply h⟩ + +end semiring + +section comm_semiring + +variables [comm_semiring R] [comm_semiring A₁] [comm_semiring A₂] +variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂) + +lemma map_prod {ι : Type*} (f : ι → A₁) (s : finset ι) : + e (∏ x in s, f x) = ∏ x in s, e (f x) := +map_prod _ f s + +lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A₁) : + e (f.prod g) = f.prod (λ i a, e (g i a)) := +map_finsupp_prod _ f g + +end comm_semiring + +section ring + +variables [comm_semiring R] [ring A₁] [ring A₂] +variables [algebra R A₁] [algebra R A₂] (e : A₁ ≃ₐ[R] A₂) + +protected lemma map_neg (x) : e (-x) = -e x := map_neg e x +protected lemma map_sub (x y) : e (x - y) = e x - e y := map_sub e x y + +end ring + +end alg_equiv + +namespace mul_semiring_action + +variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A] + +section +variables [group G] [mul_semiring_action G A] [smul_comm_class G R A] + +/-- Each element of the group defines a algebra equivalence. + +This is a stronger version of `mul_semiring_action.to_ring_equiv` and +`distrib_mul_action.to_linear_equiv`. -/ +@[simps] +def to_alg_equiv (g : G) : A ≃ₐ[R] A := +{ .. mul_semiring_action.to_ring_equiv _ _ g, + .. mul_semiring_action.to_alg_hom R A g } + +theorem to_alg_equiv_injective [has_faithful_smul G A] : + function.injective (mul_semiring_action.to_alg_equiv R A : G → A ≃ₐ[R] A) := +λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_equiv.ext_iff.1 h r + +end + +end mul_semiring_action diff --git a/src/algebra/algebra/hom.lean b/src/algebra/algebra/hom.lean new file mode 100644 index 0000000000000..d2338f7e7720c --- /dev/null +++ b/src/algebra/algebra/hom.lean @@ -0,0 +1,384 @@ +/- +Copyright (c) 2018 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau, Yury Kudryashov +-/ +import algebra.algebra.basic + +/-! +# Homomorphisms of `R`-algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines bundled homomorphisms of `R`-algebras. + +## Main definitions + +* `alg_hom R A B`: the type of `R`-algebra morphisms from `A` to `B`. +* `algebra.of_id R A : R →ₐ[R] A`: the canonical map from `R` to `A`, as an `alg_hom`. + +## Notations + +* `A →ₐ[R] B` : `R`-algebra homomorphism from `A` to `B`. +-/ + +open_locale big_operators + +universes u v w u₁ v₁ + +set_option old_structure_cmd true +/-- Defining the homomorphism in the category R-Alg. -/ +@[nolint has_nonempty_instance] +structure alg_hom (R : Type u) (A : Type v) (B : Type w) + [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] extends ring_hom A B := +(commutes' : ∀ r : R, to_fun (algebra_map R A r) = algebra_map R B r) + +run_cmd tactic.add_doc_string `alg_hom.to_ring_hom "Reinterpret an `alg_hom` as a `ring_hom`" + +infixr ` →ₐ `:25 := alg_hom _ +notation A ` →ₐ[`:25 R `] ` B := alg_hom R A B + +/-- `alg_hom_class F R A B` asserts `F` is a type of bundled algebra homomorphisms +from `A` to `B`. -/ +class alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) (B : out_param Type*) + [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] + extends ring_hom_class F A B := +(commutes : ∀ (f : F) (r : R), f (algebra_map R A r) = algebra_map R B r) + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] alg_hom_class.to_ring_hom_class + +attribute [simp] alg_hom_class.commutes + +namespace alg_hom_class + +variables {R : Type*} {A : Type*} {B : Type*} [comm_semiring R] [semiring A] [semiring B] + [algebra R A] [algebra R B] + +@[priority 100] -- see Note [lower instance priority] +instance {F : Type*} [alg_hom_class F R A B] : linear_map_class F R A B := +{ map_smulₛₗ := λ f r x, by simp only [algebra.smul_def, map_mul, commutes, ring_hom.id_apply], + ..‹alg_hom_class F R A B› } + +instance {F : Type*} [alg_hom_class F R A B] : has_coe_t F (A →ₐ[R] B) := +{ coe := λ f, + { to_fun := f, + commutes' := alg_hom_class.commutes f, + .. (f : A →+* B) } } + +end alg_hom_class + +namespace alg_hom + +variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁} + +section semiring + +variables [comm_semiring R] [semiring A] [semiring B] [semiring C] [semiring D] +variables [algebra R A] [algebra R B] [algebra R C] [algebra R D] + +instance : has_coe_to_fun (A →ₐ[R] B) (λ _, A → B) := ⟨alg_hom.to_fun⟩ + +initialize_simps_projections alg_hom (to_fun → apply) + +@[simp, protected] lemma coe_coe {F : Type*} [alg_hom_class F R A B] (f : F) : + ⇑(f : A →ₐ[R] B) = f := rfl + +@[simp] lemma to_fun_eq_coe (f : A →ₐ[R] B) : f.to_fun = f := rfl + +instance : alg_hom_class (A →ₐ[R] B) R A B := +{ coe := to_fun, + coe_injective' := λ f g h, by { cases f, cases g, congr' }, + map_add := map_add', + map_zero := map_zero', + map_mul := map_mul', + map_one := map_one', + commutes := λ f, f.commutes' } + +instance coe_ring_hom : has_coe (A →ₐ[R] B) (A →+* B) := ⟨alg_hom.to_ring_hom⟩ + +instance coe_monoid_hom : has_coe (A →ₐ[R] B) (A →* B) := ⟨λ f, ↑(f : A →+* B)⟩ + +instance coe_add_monoid_hom : has_coe (A →ₐ[R] B) (A →+ B) := ⟨λ f, ↑(f : A →+* B)⟩ + +@[simp, norm_cast] lemma coe_mk {f : A → B} (h₁ h₂ h₃ h₄ h₅) : + ⇑(⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := rfl + +-- make the coercion the simp-normal form +@[simp] lemma to_ring_hom_eq_coe (f : A →ₐ[R] B) : f.to_ring_hom = f := rfl + +@[simp, norm_cast] lemma coe_to_ring_hom (f : A →ₐ[R] B) : ⇑(f : A →+* B) = f := rfl + +@[simp, norm_cast] lemma coe_to_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →* B) = f := rfl + +@[simp, norm_cast] lemma coe_to_add_monoid_hom (f : A →ₐ[R] B) : ⇑(f : A →+ B) = f := rfl + +variables (φ : A →ₐ[R] B) + +theorem coe_fn_injective : @function.injective (A →ₐ[R] B) (A → B) coe_fn := fun_like.coe_injective + +theorem coe_fn_inj {φ₁ φ₂ : A →ₐ[R] B} : (φ₁ : A → B) = φ₂ ↔ φ₁ = φ₂ := fun_like.coe_fn_eq + +theorem coe_ring_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+* B)) := +λ φ₁ φ₂ H, coe_fn_injective $ show ((φ₁ : (A →+* B)) : A → B) = ((φ₂ : (A →+* B)) : A → B), + from congr_arg _ H + +theorem coe_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →* B)) := +ring_hom.coe_monoid_hom_injective.comp coe_ring_hom_injective + +theorem coe_add_monoid_hom_injective : function.injective (coe : (A →ₐ[R] B) → (A →+ B)) := +ring_hom.coe_add_monoid_hom_injective.comp coe_ring_hom_injective + +protected lemma congr_fun {φ₁ φ₂ : A →ₐ[R] B} (H : φ₁ = φ₂) (x : A) : φ₁ x = φ₂ x := +fun_like.congr_fun H x +protected lemma congr_arg (φ : A →ₐ[R] B) {x y : A} (h : x = y) : φ x = φ y := +fun_like.congr_arg φ h + +@[ext] +theorem ext {φ₁ φ₂ : A →ₐ[R] B} (H : ∀ x, φ₁ x = φ₂ x) : φ₁ = φ₂ := fun_like.ext _ _ H + +theorem ext_iff {φ₁ φ₂ : A →ₐ[R] B} : φ₁ = φ₂ ↔ ∀ x, φ₁ x = φ₂ x := fun_like.ext_iff + +@[simp] theorem mk_coe {f : A →ₐ[R] B} (h₁ h₂ h₃ h₄ h₅) : + (⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →ₐ[R] B) = f := ext $ λ _, rfl + +@[simp] +theorem commutes (r : R) : φ (algebra_map R A r) = algebra_map R B r := φ.commutes' r + +theorem comp_algebra_map : (φ : A →+* B).comp (algebra_map R A) = algebra_map R B := +ring_hom.ext $ φ.commutes + +protected lemma map_add (r s : A) : φ (r + s) = φ r + φ s := map_add _ _ _ +protected lemma map_zero : φ 0 = 0 := map_zero _ +protected lemma map_mul (x y) : φ (x * y) = φ x * φ y := map_mul _ _ _ +protected lemma map_one : φ 1 = 1 := map_one _ +protected lemma map_pow (x : A) (n : ℕ) : φ (x ^ n) = (φ x) ^ n := map_pow _ _ _ + +@[simp] protected lemma map_smul (r : R) (x : A) : φ (r • x) = r • φ x := map_smul _ _ _ + +protected lemma map_sum {ι : Type*} (f : ι → A) (s : finset ι) : + φ (∑ x in s, f x) = ∑ x in s, φ (f x) := map_sum _ _ _ + +protected lemma map_finsupp_sum {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) : + φ (f.sum g) = f.sum (λ i a, φ (g i a)) := map_finsupp_sum _ _ _ + +protected lemma map_bit0 (x) : φ (bit0 x) = bit0 (φ x) := map_bit0 _ _ +protected lemma map_bit1 (x) : φ (bit1 x) = bit1 (φ x) := map_bit1 _ _ + +/-- If a `ring_hom` is `R`-linear, then it is an `alg_hom`. -/ +def mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : A →ₐ[R] B := +{ to_fun := f, + commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, h, f.map_one], + .. f } + +@[simp] lemma coe_mk' (f : A →+* B) (h : ∀ (c : R) x, f (c • x) = c • f x) : ⇑(mk' f h) = f := rfl + +section + +variables (R A) +/-- Identity map as an `alg_hom`. -/ +protected def id : A →ₐ[R] A := +{ commutes' := λ _, rfl, + ..ring_hom.id A } + +@[simp] lemma coe_id : ⇑(alg_hom.id R A) = id := rfl + +@[simp] lemma id_to_ring_hom : (alg_hom.id R A : A →+* A) = ring_hom.id _ := rfl + +end + +lemma id_apply (p : A) : alg_hom.id R A p = p := rfl + +/-- Composition of algebra homeomorphisms. -/ +def comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : A →ₐ[R] C := +{ commutes' := λ r : R, by rw [← φ₁.commutes, ← φ₂.commutes]; refl, + .. φ₁.to_ring_hom.comp ↑φ₂ } + +@[simp] lemma coe_comp (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : ⇑(φ₁.comp φ₂) = φ₁ ∘ φ₂ := rfl + +lemma comp_apply (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) (p : A) : φ₁.comp φ₂ p = φ₁ (φ₂ p) := rfl + +lemma comp_to_ring_hom (φ₁ : B →ₐ[R] C) (φ₂ : A →ₐ[R] B) : + (φ₁.comp φ₂ : A →+* C) = (φ₁ : B →+* C).comp ↑φ₂ := rfl + +@[simp] theorem comp_id : φ.comp (alg_hom.id R A) = φ := +ext $ λ x, rfl + +@[simp] theorem id_comp : (alg_hom.id R B).comp φ = φ := +ext $ λ x, rfl + +theorem comp_assoc (φ₁ : C →ₐ[R] D) (φ₂ : B →ₐ[R] C) (φ₃ : A →ₐ[R] B) : + (φ₁.comp φ₂).comp φ₃ = φ₁.comp (φ₂.comp φ₃) := +ext $ λ x, rfl + +/-- R-Alg ⥤ R-Mod -/ +def to_linear_map : A →ₗ[R] B := +{ to_fun := φ, + map_add' := map_add _, + map_smul' := map_smul _ } + +@[simp] lemma to_linear_map_apply (p : A) : φ.to_linear_map p = φ p := rfl + +theorem to_linear_map_injective : function.injective (to_linear_map : _ → (A →ₗ[R] B)) := +λ φ₁ φ₂ h, ext $ linear_map.congr_fun h + +@[simp] lemma comp_to_linear_map (f : A →ₐ[R] B) (g : B →ₐ[R] C) : + (g.comp f).to_linear_map = g.to_linear_map.comp f.to_linear_map := rfl + +@[simp] lemma to_linear_map_id : to_linear_map (alg_hom.id R A) = linear_map.id := +linear_map.ext $ λ _, rfl + +/-- Promote a `linear_map` to an `alg_hom` by supplying proofs about the behavior on `1` and `*`. -/ +@[simps] +def of_linear_map (f : A →ₗ[R] B) (map_one : f 1 = 1) (map_mul : ∀ x y, f (x * y) = f x * f y) : + A →ₐ[R] B := +{ to_fun := f, + map_one' := map_one, + map_mul' := map_mul, + commutes' := λ c, by simp only [algebra.algebra_map_eq_smul_one, f.map_smul, map_one], + .. f.to_add_monoid_hom } + +@[simp] lemma of_linear_map_to_linear_map (map_one) (map_mul) : + of_linear_map φ.to_linear_map map_one map_mul = φ := +by { ext, refl } + +@[simp] lemma to_linear_map_of_linear_map (f : A →ₗ[R] B) (map_one) (map_mul) : + to_linear_map (of_linear_map f map_one map_mul) = f := +by { ext, refl } + +@[simp] lemma of_linear_map_id (map_one) (map_mul) : + of_linear_map linear_map.id map_one map_mul = alg_hom.id R A := +ext $ λ _, rfl + +lemma map_smul_of_tower {R'} [has_smul R' A] [has_smul R' B] + [linear_map.compatible_smul A B R' R] (r : R') (x : A) : φ (r • x) = r • φ x := +φ.to_linear_map.map_smul_of_tower r x + +lemma map_list_prod (s : list A) : + φ s.prod = (s.map φ).prod := +φ.to_ring_hom.map_list_prod s + +@[simps mul one {attrs := []}] instance End : monoid (A →ₐ[R] A) := +{ mul := comp, + mul_assoc := λ ϕ ψ χ, rfl, + one := alg_hom.id R A, + one_mul := λ ϕ, ext $ λ x, rfl, + mul_one := λ ϕ, ext $ λ x, rfl } + +@[simp] lemma one_apply (x : A) : (1 : A →ₐ[R] A) x = x := rfl + +@[simp] lemma mul_apply (φ ψ : A →ₐ[R] A) (x : A) : (φ * ψ) x = φ (ψ x) := rfl + +lemma algebra_map_eq_apply (f : A →ₐ[R] B) {y : R} {x : A} (h : algebra_map R A y = x) : + algebra_map R B y = f x := +h ▸ (f.commutes _).symm + +end semiring + +section comm_semiring + +variables [comm_semiring R] [comm_semiring A] [comm_semiring B] +variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B) + +protected lemma map_multiset_prod (s : multiset A) : + φ s.prod = (s.map φ).prod := map_multiset_prod _ _ + +protected lemma map_prod {ι : Type*} (f : ι → A) (s : finset ι) : + φ (∏ x in s, f x) = ∏ x in s, φ (f x) := map_prod _ _ _ + +protected lemma map_finsupp_prod {α : Type*} [has_zero α] {ι : Type*} (f : ι →₀ α) (g : ι → α → A) : + φ (f.prod g) = f.prod (λ i a, φ (g i a)) := map_finsupp_prod _ _ _ + +end comm_semiring + +section ring + +variables [comm_semiring R] [ring A] [ring B] +variables [algebra R A] [algebra R B] (φ : A →ₐ[R] B) + +protected lemma map_neg (x) : φ (-x) = -φ x := map_neg _ _ +protected lemma map_sub (x y) : φ (x - y) = φ x - φ y := map_sub _ _ _ + +end ring + +end alg_hom + + +namespace ring_hom +variables {R S : Type*} + +/-- Reinterpret a `ring_hom` as an `ℕ`-algebra homomorphism. -/ +def to_nat_alg_hom [semiring R] [semiring S] (f : R →+* S) : + R →ₐ[ℕ] S := +{ to_fun := f, commutes' := λ n, by simp, .. f } + +/-- Reinterpret a `ring_hom` as a `ℤ`-algebra homomorphism. -/ +def to_int_alg_hom [ring R] [ring S] [algebra ℤ R] [algebra ℤ S] (f : R →+* S) : + R →ₐ[ℤ] S := +{ commutes' := λ n, by simp, .. f } + +/-- Reinterpret a `ring_hom` as a `ℚ`-algebra homomorphism. This actually yields an equivalence, +see `ring_hom.equiv_rat_alg_hom`. -/ +def to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] (f : R →+* S) : + R →ₐ[ℚ] S := +{ commutes' := f.map_rat_algebra_map, .. f } + +@[simp] +lemma to_rat_alg_hom_to_ring_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] + (f : R →+* S) : ↑f.to_rat_alg_hom = f := +ring_hom.ext $ λ x, rfl + +end ring_hom + +section +variables {R S : Type*} + +@[simp] +lemma alg_hom.to_ring_hom_to_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] + (f : R →ₐ[ℚ] S) : (f : R →+* S).to_rat_alg_hom = f := +alg_hom.ext $ λ x, rfl + +/-- The equivalence between `ring_hom` and `ℚ`-algebra homomorphisms. -/ +@[simps] +def ring_hom.equiv_rat_alg_hom [ring R] [ring S] [algebra ℚ R] [algebra ℚ S] : + (R →+* S) ≃ (R →ₐ[ℚ] S) := +{ to_fun := ring_hom.to_rat_alg_hom, + inv_fun := alg_hom.to_ring_hom, + left_inv := ring_hom.to_rat_alg_hom_to_ring_hom, + right_inv := alg_hom.to_ring_hom_to_rat_alg_hom, } + +end + +namespace algebra +variables (R : Type u) (A : Type v) +variables [comm_semiring R] [semiring A] [algebra R A] + +/-- `algebra_map` as an `alg_hom`. -/ +def of_id : R →ₐ[R] A := +{ commutes' := λ _, rfl, .. algebra_map R A } +variables {R} + +theorem of_id_apply (r) : of_id R A r = algebra_map R A r := rfl + +end algebra + +namespace mul_semiring_action +variables {M G : Type*} (R A : Type*) [comm_semiring R] [semiring A] [algebra R A] +variables [monoid M] [mul_semiring_action M A] [smul_comm_class M R A] + +/-- Each element of the monoid defines a algebra homomorphism. + +This is a stronger version of `mul_semiring_action.to_ring_hom` and +`distrib_mul_action.to_linear_map`. -/ +@[simps] +def to_alg_hom (m : M) : A →ₐ[R] A := +{ to_fun := λ a, m • a, + commutes' := smul_algebra_map _, + ..mul_semiring_action.to_ring_hom _ _ m } + +theorem to_alg_hom_injective [has_faithful_smul M A] : + function.injective (mul_semiring_action.to_alg_hom R A : M → A →ₐ[R] A) := +λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, alg_hom.ext_iff.1 h r + +end mul_semiring_action diff --git a/src/algebra/algebra/operations.lean b/src/algebra/algebra/operations.lean index 12fe8dc2ee777..492885cb7f309 100644 --- a/src/algebra/algebra/operations.lean +++ b/src/algebra/algebra/operations.lean @@ -4,18 +4,27 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ import algebra.algebra.bilinear -import algebra.module.submodule_pointwise +import algebra.algebra.equiv +import algebra.module.submodule.pointwise +import algebra.module.submodule.bilinear import algebra.module.opposites +import algebra.order.kleene import data.finset.pointwise +import data.set.semiring +import data.set.pointwise.big_operators +import group_theory.group_action.sub_mul_action.pointwise /-! # Multiplication and division of submodules of an algebra. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An interface for multiplication and division of sub-R-modules of an R-algebra A is developed. ## Main definitions -Let `R` be a commutative ring (or semiring) and aet `A` be an `R`-algebra. +Let `R` be a commutative ring (or semiring) and let `A` be an `R`-algebra. * `1 : submodule R A` : the R-submodule R of the R-algebra A * `has_mul (submodule R A)` : multiplication of two sub-R-modules M and N of A is defined to be @@ -25,6 +34,9 @@ Let `R` be a commutative ring (or semiring) and aet `A` be an `R`-algebra. It is proved that `submodule R A` is a semiring, and also an algebra over `set A`. +Additionally, in the `pointwise` locale we promote `submodule.pointwise_distrib_mul_action` to a +`mul_semiring_action` as `submodule.pointwise_mul_semiring_action`. + ## Tags multiplication of submodules, division of submodules, submodule semiring @@ -36,6 +48,17 @@ open algebra set mul_opposite open_locale big_operators open_locale pointwise +namespace sub_mul_action +variables {R : Type u} {A : Type v} [comm_semiring R] [semiring A] [algebra R A] + +lemma algebra_map_mem (r : R) : algebra_map R A r ∈ (1 : sub_mul_action R A) := +⟨r, (algebra_map_eq_smul_one r).symm⟩ + +lemma mem_one' {x : A} : x ∈ (1 : sub_mul_action R A) ↔ ∃ y, algebra_map R A y = x := +exists_congr $ λ r, by rw algebra_map_eq_smul_one + +end sub_mul_action + namespace submodule variables {ι : Sort uι} @@ -53,11 +76,21 @@ instance : has_one (submodule R A) := theorem one_eq_range : (1 : submodule R A) = (algebra.linear_map R A).range := rfl +lemma le_one_to_add_submonoid : + 1 ≤ (1 : submodule R A).to_add_submonoid := +begin + rintros x ⟨n, rfl⟩, + exact ⟨n, map_nat_cast (algebra_map R A) n⟩, +end + lemma algebra_map_mem (r : R) : algebra_map R A r ∈ (1 : submodule R A) := linear_map.mem_range_self _ _ @[simp] lemma mem_one {x : A} : x ∈ (1 : submodule R A) ↔ ∃ y, algebra_map R A y = x := -by simp only [one_eq_range, linear_map.mem_range, algebra.linear_map_apply] +iff.rfl + +@[simp] lemma to_sub_mul_action_one : (1 : submodule R A).to_sub_mul_action = 1 := +set_like.ext $ λ x, mem_one.trans sub_mul_action.mem_one'.symm theorem one_eq_span : (1 : submodule R A) = R ∙ 1 := begin @@ -66,6 +99,8 @@ begin simp only [mem_one, mem_span_singleton, algebra.smul_def, mul_one] end +theorem one_eq_span_one_set : (1 : submodule R A) = span R 1 := one_eq_span + theorem one_le : (1 : submodule R A) ≤ P ↔ (1 : A) ∈ P := by simpa only [one_eq_span, span_le, set.singleton_subset_iff] @@ -89,22 +124,21 @@ by rw [←comap_equiv_eq_map_symm, comap_op_one] comap (↑(op_linear_equiv R : A ≃ₗ[R] Aᵐᵒᵖ).symm : Aᵐᵒᵖ →ₗ[R] A) (1 : submodule R A) = 1 := by rw [←map_equiv_eq_comap_symm, map_op_one] + /-- Multiplication of sub-R-modules of an R-algebra A. The submodule `M * N` is the smallest R-submodule of `A` containing the elements `m * n` for `m ∈ M` and `n ∈ N`. -/ -instance : has_mul (submodule R A) := -⟨λ M N, ⨆ s : M, N.map $ algebra.lmul R A s.1⟩ +instance : has_mul (submodule R A) := ⟨submodule.map₂ $ linear_map.mul R A⟩ -theorem mul_mem_mul (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N := -(le_supr _ ⟨m, hm⟩ : _ ≤ M * N) ⟨n, hn, rfl⟩ +theorem mul_mem_mul (hm : m ∈ M) (hn : n ∈ N) : m * n ∈ M * N := apply_mem_map₂ _ hm hn -theorem mul_le : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P := -⟨λ H m hm n hn, H $ mul_mem_mul hm hn, -λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩ +theorem mul_le : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈ N), m * n ∈ P := map₂_le -lemma mul_to_add_submonoid : (M * N).to_add_submonoid = M.to_add_submonoid * N.to_add_submonoid := +lemma mul_to_add_submonoid (M N : submodule R A) : + (M * N).to_add_submonoid = M.to_add_submonoid * N.to_add_submonoid := begin dsimp [has_mul.mul], - simp_rw [←algebra.lmul_left_to_add_monoid_hom R, algebra.lmul_left, ←map_to_add_submonoid], + simp_rw [←linear_map.mul_left_to_add_monoid_hom R, linear_map.mul_left, ←map_to_add_submonoid _ N, + map₂], rw supr_to_add_submonoid, refl, end @@ -130,39 +164,14 @@ begin end variables R -theorem span_mul_span : span R S * span R T = span R (S * T) := -begin - apply le_antisymm, - { rw mul_le, intros a ha b hb, - apply span_induction ha, - work_on_goal 1 { intros, apply span_induction hb, - work_on_goal 1 { intros, exact subset_span ⟨_, _, ‹_›, ‹_›, rfl⟩ } }, - all_goals { intros, simp only [mul_zero, zero_mul, zero_mem, - left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc], - solve_by_elim [add_mem _ _, zero_mem _, smul_mem _ _ _] - { max_depth := 4, discharger := tactic.interactive.apply_instance } } }, - { rw span_le, rintros _ ⟨a, b, ha, hb, rfl⟩, - exact mul_mem_mul (subset_span ha) (subset_span hb) } -end +theorem span_mul_span : span R S * span R T = span R (S * T) := map₂_span_span _ _ _ _ variables {R} - variables (M N P Q) -protected theorem mul_assoc : (M * N) * P = M * (N * P) := -le_antisymm (mul_le.2 $ λ mn hmn p hp, - suffices M * N ≤ (M * (N * P)).comap (algebra.lmul_right R p), from this hmn, - mul_le.2 $ λ m hm n hn, show m * n * p ∈ M * (N * P), from - (mul_assoc m n p).symm ▸ mul_mem_mul hm (mul_mem_mul hn hp)) -(mul_le.2 $ λ m hm np hnp, - suffices N * P ≤ (M * N * P).comap (algebra.lmul_left R m), from this hnp, - mul_le.2 $ λ n hn p hp, show m * (n * p) ∈ M * N * P, from - mul_assoc m n p ▸ mul_mem_mul (mul_mem_mul hm hn) hp) - -@[simp] theorem mul_bot : M * ⊥ = ⊥ := -eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [submodule.mem_bot] at hn ⊢; rw [hn, mul_zero] - -@[simp] theorem bot_mul : ⊥ * M = ⊥ := -eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [submodule.mem_bot] at hm ⊢; rw [hm, zero_mul] + +@[simp] theorem mul_bot : M * ⊥ = ⊥ := map₂_bot_right _ _ + +@[simp] theorem bot_mul : ⊥ * M = ⊥ := map₂_bot_left _ _ @[simp] protected theorem one_mul : (1 : submodule R A) * M = M := by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, one_mul, span_eq] } @@ -172,33 +181,24 @@ by { conv_lhs { rw [one_eq_span, ← span_eq M] }, erw [span_mul_span, mul_one, variables {M N P Q} -@[mono] theorem mul_le_mul (hmp : M ≤ P) (hnq : N ≤ Q) : M * N ≤ P * Q := -mul_le.2 $ λ m hm n hn, mul_mem_mul (hmp hm) (hnq hn) +@[mono] theorem mul_le_mul (hmp : M ≤ P) (hnq : N ≤ Q) : M * N ≤ P * Q := map₂_le_map₂ hmp hnq -theorem mul_le_mul_left (h : M ≤ N) : M * P ≤ N * P := -mul_le_mul h (le_refl P) +theorem mul_le_mul_left (h : M ≤ N) : M * P ≤ N * P := map₂_le_map₂_left h -theorem mul_le_mul_right (h : N ≤ P) : M * N ≤ M * P := -mul_le_mul (le_refl M) h +theorem mul_le_mul_right (h : N ≤ P) : M * N ≤ M * P := map₂_le_map₂_right h variables (M N P) -theorem mul_sup : M * (N ⊔ P) = M * N ⊔ M * P := -le_antisymm (mul_le.2 $ λ m hm np hnp, let ⟨n, hn, p, hp, hnp⟩ := mem_sup.1 hnp in - mem_sup.2 ⟨_, mul_mem_mul hm hn, _, mul_mem_mul hm hp, hnp ▸ (mul_add m n p).symm⟩) -(sup_le (mul_le_mul_right le_sup_left) (mul_le_mul_right le_sup_right)) +theorem mul_sup : M * (N ⊔ P) = M * N ⊔ M * P := map₂_sup_right _ _ _ _ -theorem sup_mul : (M ⊔ N) * P = M * P ⊔ N * P := -le_antisymm (mul_le.2 $ λ mn hmn p hp, let ⟨m, hm, n, hn, hmn⟩ := mem_sup.1 hmn in - mem_sup.2 ⟨_, mul_mem_mul hm hp, _, mul_mem_mul hn hp, hmn ▸ (add_mul m n p).symm⟩) -(sup_le (mul_le_mul_left le_sup_left) (mul_le_mul_left le_sup_right)) +theorem sup_mul : (M ⊔ N) * P = M * P ⊔ N * P := map₂_sup_left _ _ _ _ lemma mul_subset_mul : (↑M : set A) * (↑N : set A) ⊆ (↑(M * N) : set A) := -by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact mul_mem_mul hi hj } +image2_subset_map₂ (algebra.lmul R A).to_linear_map M N protected lemma map_mul {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') : map f.to_linear_map (M * N) = map f.to_linear_map M * map f.to_linear_map N := calc map f.to_linear_map (M * N) - = ⨆ (i : M), (N.map (lmul R A i)).map f.to_linear_map : map_supr _ _ + = ⨆ (i : M), (N.map (linear_map.mul R A i)).map f.to_linear_map : map_supr _ _ ... = map f.to_linear_map M * map f.to_linear_map N : begin apply congr_arg Sup, @@ -262,24 +262,7 @@ open_locale pointwise This is available as an instance in the `pointwise` locale. -/ protected def has_distrib_pointwise_neg {A} [ring A] [algebra R A] : has_distrib_neg (submodule R A) := -{ neg := has_neg.neg, - neg_mul := λ x y, begin - refine le_antisymm - (mul_le.2 $ λ m hm n hn, _) - ((submodule.neg_le _ _).2 $ mul_le.2 $ λ m hm n hn, _); - simp only [submodule.mem_neg, ←neg_mul] at *, - { exact mul_mem_mul hm hn,}, - { exact mul_mem_mul (neg_mem_neg.2 hm) hn }, - end, - mul_neg := λ x y, begin - refine le_antisymm - (mul_le.2 $ λ m hm n hn, _) - ((submodule.neg_le _ _).2 $ mul_le.2 $ λ m hm n hn, _); - simp only [submodule.mem_neg, ←mul_neg] at *, - { exact mul_mem_mul hm hn,}, - { exact mul_mem_mul hm (neg_mem_neg.2 hn) }, - end, - ..submodule.has_involutive_pointwise_neg } +to_add_submonoid_injective.has_distrib_neg _ neg_to_add_submonoid mul_to_add_submonoid localized "attribute [instance] submodule.has_distrib_pointwise_neg" in pointwise @@ -305,21 +288,13 @@ end end decidable_eq lemma mul_eq_span_mul_set (s t : submodule R A) : s * t = span R ((s : set A) * (t : set A)) := -by rw [← span_mul_span, span_eq, span_eq] +map₂_eq_span_image2 _ s t lemma supr_mul (s : ι → submodule R A) (t : submodule R A) : (⨆ i, s i) * t = ⨆ i, s i * t := -begin - suffices : (⨆ i, span R (s i : set A)) * span R t = (⨆ i, span R (s i) * span R t), - { simpa only [span_eq] using this }, - simp_rw [span_mul_span, ← span_Union, span_mul_span, set.Union_mul], -end +map₂_supr_left _ s t lemma mul_supr (t : submodule R A) (s : ι → submodule R A) : t * (⨆ i, s i) = ⨆ i, t * s i := -begin - suffices : span R (t : set A) * (⨆ i, span R (s i)) = (⨆ i, span R t * span R (s i)), - { simpa only [span_eq] using this }, - simp_rw [span_mul_span, ← span_Union, span_mul_span, set.mul_Union], -end +map₂_supr_right _ t s lemma mem_span_mul_finite_of_mem_mul {P Q : submodule R A} {x : A} (hx : x ∈ P * Q) : ∃ (T T' : finset A), (T : set A) ⊆ P ∧ (T' : set A) ⊆ Q ∧ x ∈ span R (T * T' : set A) := @@ -328,34 +303,63 @@ submodule.mem_span_mul_finite_of_mem_span_mul variables {M N P} -/-- Sub-R-modules of an R-algebra form a semiring. -/ -instance : semiring (submodule R A) := +lemma mem_span_singleton_mul {x y : A} : x ∈ span R {y} * P ↔ ∃ z ∈ P, y * z = x := +by { simp_rw [(*), map₂_span_singleton_eq_map, exists_prop], refl } + +lemma mem_mul_span_singleton {x y : A} : x ∈ P * span R {y} ↔ ∃ z ∈ P, z * y = x := +by { simp_rw [(*), map₂_span_singleton_eq_map_flip, exists_prop], refl } + +/-- Sub-R-modules of an R-algebra form an idempotent semiring. -/ +instance : idem_semiring (submodule R A) := { one_mul := submodule.one_mul, mul_one := submodule.mul_one, - mul_assoc := submodule.mul_assoc, zero_mul := bot_mul, mul_zero := mul_bot, left_distrib := mul_sup, right_distrib := sup_mul, + ..to_add_submonoid_injective.semigroup _ (λ m n : submodule R A, mul_to_add_submonoid m n), + ..add_monoid_with_one.unary, ..submodule.pointwise_add_comm_monoid, ..submodule.has_one, - ..submodule.has_mul } + ..submodule.has_mul, + ..(by apply_instance : order_bot (submodule R A)), + ..(by apply_instance : lattice (submodule R A)) } variables (M) +lemma span_pow (s : set A) : ∀ n : ℕ, span R s ^ n = span R (s ^ n) +| 0 := by rw [pow_zero, pow_zero, one_eq_span_one_set] +| (n + 1) := by rw [pow_succ, pow_succ, span_pow, span_mul_span] + +lemma pow_eq_span_pow_set (n : ℕ) : M ^ n = span R ((M : set A) ^ n) := by rw [←span_pow, span_eq] + lemma pow_subset_pow {n : ℕ} : (↑M : set A)^n ⊆ ↑(M^n : submodule R A) := +(pow_eq_span_pow_set M n).symm ▸ subset_span + +lemma pow_mem_pow {x : A} (hx : x ∈ M) (n : ℕ) : x ^ n ∈ M ^ n := +pow_subset_pow _ $ set.pow_mem_pow hx _ + +lemma pow_to_add_submonoid {n : ℕ} (h : n ≠ 0) : + (M ^ n).to_add_submonoid = M.to_add_submonoid ^ n := begin induction n with n ih, - { erw [pow_zero, pow_zero, set.singleton_subset_iff], - rw [set_like.mem_coe, ← one_le], - exact le_rfl }, - { rw [pow_succ, pow_succ], - refine set.subset.trans (set.mul_subset_mul (subset.refl _) ih) _, - apply mul_subset_mul } + { exact (h rfl).elim }, + { rw [pow_succ, pow_succ, mul_to_add_submonoid], + cases n, + { rw [pow_zero, pow_zero, mul_one, ←mul_to_add_submonoid, mul_one] }, + { rw ih n.succ_ne_zero } }, +end + +lemma le_pow_to_add_submonoid {n : ℕ} : + M.to_add_submonoid ^ n ≤ (M ^ n).to_add_submonoid := +begin + obtain rfl | hn := decidable.eq_or_ne n 0, + { rw [pow_zero, pow_zero], exact le_one_to_add_submonoid }, + { exact (pow_to_add_submonoid M hn).ge } end -/-- Dependent version of `submodule.pow_induction_on`. -/ -@[elab_as_eliminator] protected theorem pow_induction_on' +/-- Dependent version of `submodule.pow_induction_on_left`. -/ +@[elab_as_eliminator] protected theorem pow_induction_on_left' {C : Π (n : ℕ) x, x ∈ M ^ n → Prop} (hr : ∀ r : R, C 0 (algebra_map _ _ r) (algebra_map_mem r)) (hadd : ∀ x y i hx hy, C i x hx → C i y hy → C i (x + y) (add_mem ‹_› ‹_›)) @@ -371,17 +375,49 @@ begin (λ x hx y hy Cx Cy, hadd _ _ _ _ _ Cx Cy) hx, end +/-- Dependent version of `submodule.pow_induction_on_right`. -/ +@[elab_as_eliminator] protected theorem pow_induction_on_right' + {C : Π (n : ℕ) x, x ∈ M ^ n → Prop} + (hr : ∀ r : R, C 0 (algebra_map _ _ r) (algebra_map_mem r)) + (hadd : ∀ x y i hx hy, C i x hx → C i y hy → C i (x + y) (add_mem ‹_› ‹_›)) + (hmul : ∀ i x hx, C i x hx → ∀ m ∈ M, + C (i.succ) (x * m) ((pow_succ' M i).symm ▸ mul_mem_mul hx H)) + {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C n x hx := +begin + induction n with n n_ih generalizing x, + { rw pow_zero at hx, + obtain ⟨r, rfl⟩ := hx, + exact hr r, }, + revert hx, + simp_rw pow_succ', + intro hx, + exact submodule.mul_induction_on' + (λ m hm x ih, hmul _ _ hm (n_ih _) _ ih) + (λ x hx y hy Cx Cy, hadd _ _ _ _ _ Cx Cy) hx, +end + /-- To show a property on elements of `M ^ n` holds, it suffices to show that it holds for scalars, is closed under addition, and holds for `m * x` where `m ∈ M` and it holds for `x` -/ -@[elab_as_eliminator] protected theorem pow_induction_on +@[elab_as_eliminator] protected theorem pow_induction_on_left {C : A → Prop} (hr : ∀ r : R, C (algebra_map _ _ r)) (hadd : ∀ x y, C x → C y → C (x + y)) (hmul : ∀ (m ∈ M) x, C x → C (m * x)) {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C x := -submodule.pow_induction_on' M +submodule.pow_induction_on_left' M (by exact hr) (λ x y i hx hy, hadd x y) (λ m hm i x hx, hmul _ hm _) hx +/-- To show a property on elements of `M ^ n` holds, it suffices to show that it holds for scalars, +is closed under addition, and holds for `x * m` where `m ∈ M` and it holds for `x` -/ +@[elab_as_eliminator] protected theorem pow_induction_on_right + {C : A → Prop} + (hr : ∀ r : R, C (algebra_map _ _ r)) + (hadd : ∀ x y, C x → C y → C (x + y)) + (hmul : ∀ x, C x → ∀ (m ∈ M), C (x * m)) + {x : A} {n : ℕ} (hx : x ∈ M ^ n) : C x := +submodule.pow_induction_on_right' M + (by exact hr) (λ x y i hx hy, hadd x y) (λ i x hx, hmul _) hx + /-- `submonoid.map` as a `monoid_with_zero_hom`, when applied to `alg_hom`s. -/ @[simps] def map_hom {A'} [semiring A'] [algebra R A'] (f : A →ₐ[R] A') : @@ -428,12 +464,30 @@ by rw [←comap_equiv_eq_map_symm, ←comap_equiv_eq_map_symm, comap_op_pow] /-- `span` is a semiring homomorphism (recall multiplication is pointwise multiplication of subsets on either side). -/ +@[simps] def span.ring_hom : set_semiring A →+* submodule R A := -{ to_fun := submodule.span R, +{ to_fun := λ s, submodule.span R s.down, map_zero' := span_empty, map_one' := one_eq_span.symm, map_add' := span_union, - map_mul' := λ s t, by erw [span_mul_span, ← image_mul_prod] } + map_mul' := λ s t, by rw [set_semiring.down_mul, span_mul_span, ← image_mul_prod] } + +section +variables {α : Type*} [monoid α] [mul_semiring_action α A] [smul_comm_class α R A] + +/-- The action on a submodule corresponding to applying the action to every element. + +This is available as an instance in the `pointwise` locale. + +This is a stronger version of `submodule.pointwise_distrib_mul_action`. -/ +protected def pointwise_mul_semiring_action : mul_semiring_action α (submodule R A) := +{ smul_mul := λ r x y, submodule.map_mul x y $ mul_semiring_action.to_alg_hom R A r, + smul_one := λ r, submodule.map_one $ mul_semiring_action.to_alg_hom R A r, + ..submodule.pointwise_distrib_mul_action } + +localized "attribute [instance] submodule.pointwise_mul_semiring_action" in pointwise + +end end ring @@ -451,9 +505,9 @@ le_antisymm (mul_le.2 $ λ r hrm s hsn, mul_mem_mul_rev hsn hrm) (mul_le.2 $ λ r hrn s hsm, mul_mem_mul_rev hsm hrn) /-- Sub-R-modules of an R-algebra A form a semiring. -/ -instance : comm_semiring (submodule R A) := +instance : idem_comm_semiring (submodule R A) := { mul_comm := submodule.mul_comm, - .. submodule.semiring } + .. submodule.idem_semiring } lemma prod_span {ι : Type*} (s : finset ι) (M : ι → set A) : (∏ i in s, submodule.span R (M i)) = submodule.span R (∏ i in s, M i) := @@ -473,27 +527,28 @@ variables (R A) /-- R-submodules of the R-algebra A are a module over `set A`. -/ instance module_set : module (set_semiring A) (submodule R A) := -{ smul := λ s P, span R s * P, +{ smul := λ s P, span R s.down * P, smul_add := λ _ _ _, mul_add _ _ _, - add_smul := λ s t P, show span R (s ⊔ t) * P = _, by { erw [span_union, right_distrib] }, - mul_smul := λ s t P, show _ = _ * (_ * _), - by { rw [← mul_assoc, span_mul_span, ← image_mul_prod] }, - one_smul := λ P, show span R {(1 : A)} * P = _, - by { conv_lhs {erw ← span_eq P}, erw [span_mul_span, one_mul, span_eq] }, - zero_smul := λ P, show span R ∅ * P = ⊥, by erw [span_empty, bot_mul], + add_smul := λ s t P, + by simp_rw [has_smul.smul, set_semiring.down_add, span_union, sup_mul, add_eq_sup], + mul_smul := λ s t P, + by simp_rw [has_smul.smul, set_semiring.down_mul, ← mul_assoc, span_mul_span], + one_smul := λ P, + by simp_rw [has_smul.smul, set_semiring.down_one, ←one_eq_span_one_set, one_mul], + zero_smul := λ P, + by simp_rw [has_smul.smul, set_semiring.down_zero, span_empty, bot_mul, bot_eq_zero], smul_zero := λ _, mul_bot _ } - variables {R A} -lemma smul_def {s : set_semiring A} {P : submodule R A} : s • P = span R s * P := rfl +lemma smul_def (s : set_semiring A) (P : submodule R A) : s • P = span R s.down * P := rfl -lemma smul_le_smul {s t : set_semiring A} {M N : submodule R A} (h₁ : s.down ≤ t.down) +lemma smul_le_smul {s t : set_semiring A} {M N : submodule R A} (h₁ : s.down ⊆ t.down) (h₂ : M ≤ N) : s • M ≤ t • N := mul_le_mul (span_mono h₁) h₂ lemma smul_singleton (a : A) (M : submodule R A) : - ({a} : set A).up • M = M.map (lmul_left _ a) := + ({a} : set A).up • M = M.map (linear_map.mul_left R a) := begin conv_lhs {rw ← span_eq M}, change span _ _ * span _ _ = _, diff --git a/src/algebra/algebra/pi.lean b/src/algebra/algebra/pi.lean new file mode 100644 index 0000000000000..444bd8c915fe5 --- /dev/null +++ b/src/algebra/algebra/pi.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2018 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau, Yury Kudryashov +-/ +import algebra.algebra.equiv + +/-! +# The R-algebra structure on families of R-algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra. + +## Main defintions + +* `pi.algebra` +* `pi.eval_alg_hom` +* `pi.const_alg_hom` +-/ +universes u v w + +namespace pi + +variable {I : Type u} -- The indexing type +variable {R : Type*} -- The scalar type +variable {f : I → Type v} -- The family of types already equipped with instances +variables (x y : Π i, f i) (i : I) +variables (I f) + +instance algebra {r : comm_semiring R} + [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] : + algebra R (Π i : I, f i) := +{ commutes' := λ a f, begin ext, simp [algebra.commutes], end, + smul_def' := λ a f, begin ext, simp [algebra.smul_def], end, + ..(pi.ring_hom (λ i, algebra_map R (f i)) : R →+* Π i : I, f i) } + +lemma algebra_map_def {r : comm_semiring R} + [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) : + algebra_map R (Π i, f i) a = (λ i, algebra_map R (f i) a) := rfl + +@[simp] lemma algebra_map_apply {r : comm_semiring R} + [s : ∀ i, semiring (f i)] [∀ i, algebra R (f i)] (a : R) (i : I) : + algebra_map R (Π i, f i) a i = algebra_map R (f i) a := rfl + +-- One could also build a `Π i, R i`-algebra structure on `Π i, A i`, +-- when each `A i` is an `R i`-algebra, although I'm not sure that it's useful. + +variables {I} (R) (f) + +/-- `function.eval` as an `alg_hom`. The name matches `pi.eval_ring_hom`, `pi.eval_monoid_hom`, +etc. -/ +@[simps] +def eval_alg_hom {r : comm_semiring R} [Π i, semiring (f i)] [Π i, algebra R (f i)] (i : I) : + (Π i, f i) →ₐ[R] f i := +{ to_fun := λ f, f i, commutes' := λ r, rfl, .. pi.eval_ring_hom f i} + +variables (A B : Type*) [comm_semiring R] [semiring B] [algebra R B] + +/-- `function.const` as an `alg_hom`. The name matches `pi.const_ring_hom`, `pi.const_monoid_hom`, +etc. -/ +@[simps] +def const_alg_hom : B →ₐ[R] (A → B) := +{ to_fun := function.const _, + commutes' := λ r, rfl, + .. pi.const_ring_hom A B} + +/-- When `R` is commutative and permits an `algebra_map`, `pi.const_ring_hom` is equal to that +map. -/ +@[simp] lemma const_ring_hom_eq_algebra_map : const_ring_hom A R = algebra_map R (A → R) := +rfl + +@[simp] lemma const_alg_hom_eq_algebra_of_id : const_alg_hom R A R = algebra.of_id R (A → R) := +rfl + +end pi + +/-- A special case of `pi.algebra` for non-dependent types. Lean struggles to elaborate +definitions elsewhere in the library without this, -/ +instance function.algebra {R : Type*} (I : Type*) (A : Type*) [comm_semiring R] + [semiring A] [algebra R A] : algebra R (I → A) := +pi.algebra _ _ + +namespace alg_hom + +variables {R : Type u} {A : Type v} {B : Type w} {I : Type*} + +variables [comm_semiring R] [semiring A] [semiring B] +variables [algebra R A] [algebra R B] + +/-- `R`-algebra homomorphism between the function spaces `I → A` and `I → B`, induced by an +`R`-algebra homomorphism `f` between `A` and `B`. -/ +@[simps] protected def comp_left (f : A →ₐ[R] B) (I : Type*) : (I → A) →ₐ[R] (I → B) := +{ to_fun := λ h, f ∘ h, + commutes' := λ c, by { ext, exact f.commutes' c }, + .. f.to_ring_hom.comp_left I } + +end alg_hom + +namespace alg_equiv + +/-- A family of algebra equivalences `Π j, (A₁ j ≃ₐ A₂ j)` generates a +multiplicative equivalence between `Π j, A₁ j` and `Π j, A₂ j`. + +This is the `alg_equiv` version of `equiv.Pi_congr_right`, and the dependent version of +`alg_equiv.arrow_congr`. +-/ +@[simps apply] +def Pi_congr_right {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R] + [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] + (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Π i, A₁ i) ≃ₐ[R] Π i, A₂ i := +{ to_fun := λ x j, e j (x j), + inv_fun := λ x j, (e j).symm (x j), + commutes' := λ r, by { ext i, simp }, + .. @ring_equiv.Pi_congr_right ι A₁ A₂ _ _ (λ i, (e i).to_ring_equiv) } + +@[simp] +lemma Pi_congr_right_refl {R ι : Type*} {A : ι → Type*} [comm_semiring R] + [Π i, semiring (A i)] [Π i, algebra R (A i)] : + Pi_congr_right (λ i, (alg_equiv.refl : A i ≃ₐ[R] A i)) = alg_equiv.refl := rfl + +@[simp] +lemma Pi_congr_right_symm {R ι : Type*} {A₁ A₂ : ι → Type*} [comm_semiring R] + [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] + (e : Π i, A₁ i ≃ₐ[R] A₂ i) : (Pi_congr_right e).symm = (Pi_congr_right $ λ i, (e i).symm) := rfl + +@[simp] +lemma Pi_congr_right_trans {R ι : Type*} {A₁ A₂ A₃ : ι → Type*} [comm_semiring R] + [Π i, semiring (A₁ i)] [Π i, semiring (A₂ i)] [Π i, semiring (A₃ i)] + [Π i, algebra R (A₁ i)] [Π i, algebra R (A₂ i)] [Π i, algebra R (A₃ i)] + (e₁ : Π i, A₁ i ≃ₐ[R] A₂ i) (e₂ : Π i, A₂ i ≃ₐ[R] A₃ i) : + (Pi_congr_right e₁).trans (Pi_congr_right e₂) = (Pi_congr_right $ λ i, (e₁ i).trans (e₂ i)) := +rfl + +end alg_equiv diff --git a/src/algebra/algebra/prod.lean b/src/algebra/algebra/prod.lean new file mode 100644 index 0000000000000..a19cc46ff8b62 --- /dev/null +++ b/src/algebra/algebra/prod.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2018 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau, Yury Kudryashov +-/ +import algebra.algebra.hom + +/-! +# The R-algebra structure on products of R-algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The R-algebra structure on `Π i : I, A i` when each `A i` is an R-algebra. + +## Main defintions + +* `pi.algebra` +* `pi.eval_alg_hom` +* `pi.const_alg_hom` +-/ + +variables {R A B C : Type*} +variables [comm_semiring R] +variables [semiring A] [algebra R A] [semiring B] [algebra R B] [semiring C] [algebra R C] + +namespace prod +variables (R A B) + +open algebra + +instance algebra : algebra R (A × B) := +{ commutes' := by { rintro r ⟨a, b⟩, dsimp, rw [commutes r a, commutes r b] }, + smul_def' := by { rintro r ⟨a, b⟩, dsimp, rw [algebra.smul_def r a, algebra.smul_def r b] }, + .. prod.module, + .. ring_hom.prod (algebra_map R A) (algebra_map R B) } + +variables {R A B} + +@[simp] lemma algebra_map_apply (r : R) : + algebra_map R (A × B) r = (algebra_map R A r, algebra_map R B r) := rfl + +end prod + +namespace alg_hom +variables (R A B) + +/-- First projection as `alg_hom`. -/ +def fst : A × B →ₐ[R] A := +{ commutes' := λ r, rfl, .. ring_hom.fst A B} + +/-- Second projection as `alg_hom`. -/ +def snd : A × B →ₐ[R] B := +{ commutes' := λ r, rfl, .. ring_hom.snd A B} + +variables {R A B} + +/-- The `pi.prod` of two morphisms is a morphism. -/ +@[simps] def prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : (A →ₐ[R] B × C) := +{ commutes' := λ r, by simp only [to_ring_hom_eq_coe, ring_hom.to_fun_eq_coe, ring_hom.prod_apply, + coe_to_ring_hom, commutes, prod.algebra_map_apply], + .. (f.to_ring_hom.prod g.to_ring_hom) } + +lemma coe_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : ⇑(f.prod g) = pi.prod f g := rfl + +@[simp] theorem fst_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : + (fst R B C).comp (prod f g) = f := by ext; refl + +@[simp] theorem snd_prod (f : A →ₐ[R] B) (g : A →ₐ[R] C) : + (snd R B C).comp (prod f g) = g := by ext; refl + +@[simp] theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 := +fun_like.coe_injective pi.prod_fst_snd + +/-- Taking the product of two maps with the same domain is equivalent to taking the product of +their codomains. -/ +@[simps] def prod_equiv : ((A →ₐ[R] B) × (A →ₐ[R] C)) ≃ (A →ₐ[R] B × C) := +{ to_fun := λ f, f.1.prod f.2, + inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f), + left_inv := λ f, by ext; refl, + right_inv := λ f, by ext; refl } + +end alg_hom diff --git a/src/algebra/algebra/restrict_scalars.lean b/src/algebra/algebra/restrict_scalars.lean index 03f6a82c1bb31..ea90c084b2611 100644 --- a/src/algebra/algebra/restrict_scalars.lean +++ b/src/algebra/algebra/restrict_scalars.lean @@ -9,6 +9,9 @@ import algebra.algebra.tower # The `restrict_scalars` type alias +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + See the documentation attached to the `restrict_scalars` definition for advice on how and when to use this type alias. As described there, it is often a better choice to use the `is_scalar_tower` typeclass instead. @@ -89,8 +92,7 @@ variables [semiring S] [add_comm_monoid M] def restrict_scalars.module_orig [I : module S M] : module S (restrict_scalars R S M) := I -variables [comm_semiring R] [algebra R S] [module S M] - +variables [comm_semiring R] [algebra R S] section local attribute [instance] restrict_scalars.module_orig @@ -100,22 +102,38 @@ module structure over `R`. The preferred way of setting this up is `[module R M] [module S M] [is_scalar_tower R S M]`. -/ -instance : module R (restrict_scalars R S M) := +instance [module S M] : module R (restrict_scalars R S M) := module.comp_hom M (algebra_map R S) /-- This instance is only relevant when `restrict_scalars.module_orig` is available as an instance. -/ -instance : is_scalar_tower R S (restrict_scalars R S M) := +instance [module S M] : is_scalar_tower R S (restrict_scalars R S M) := ⟨λ r S M, by { rw [algebra.smul_def, mul_smul], refl }⟩ end +/-- +When `M` is a right-module over a ring `S`, and `S` is an algebra over `R`, then `M` inherits a +right-module structure over `R`. +The preferred way of setting this up is +`[module Rᵐᵒᵖ M] [module Sᵐᵒᵖ M] [is_scalar_tower Rᵐᵒᵖ Sᵐᵒᵖ M]`. +-/ +instance restrict_scalars.op_module [module Sᵐᵒᵖ M] : module Rᵐᵒᵖ (restrict_scalars R S M) := +begin + letI : module Sᵐᵒᵖ (restrict_scalars R S M) := ‹module Sᵐᵒᵖ M›, + exact module.comp_hom M (algebra_map R S).op +end + +instance restrict_scalars.is_central_scalar [module S M] [module Sᵐᵒᵖ M] [is_central_scalar S M] : + is_central_scalar R (restrict_scalars R S M) := +{ op_smul_eq_smul := λ r x, (op_smul_eq_smul (algebra_map R S r) (_ : M) : _)} + /-- The `R`-algebra homomorphism from the original coefficient algebra `S` to endomorphisms of `restrict_scalars R S M`. -/ -def restrict_scalars.lsmul : S →ₐ[R] module.End R (restrict_scalars R S M) := +def restrict_scalars.lsmul [module S M] : S →ₐ[R] module.End R (restrict_scalars R S M) := begin -- We use `restrict_scalars.module_orig` in the implementation, -- but not in the type. @@ -128,17 +146,34 @@ end variables [add_comm_monoid M] /-- `restrict_scalars.add_equiv` is the additive equivalence with the original module. -/ -@[simps] def restrict_scalars.add_equiv : restrict_scalars R S M ≃+ M := +def restrict_scalars.add_equiv : restrict_scalars R S M ≃+ M := add_equiv.refl M variables [comm_semiring R] [semiring S] [algebra R S] [module S M] -lemma restrict_scalars_smul_def (c : R) (x : restrict_scalars R S M) : - c • x = ((algebra_map R S c) • x : M) := rfl +@[simp] lemma restrict_scalars.add_equiv_map_smul (c : R) (x : restrict_scalars R S M) : + restrict_scalars.add_equiv R S M (c • x) + = (algebra_map R S c) • restrict_scalars.add_equiv R S M x := +rfl + +lemma restrict_scalars.smul_def (c : R) (x : restrict_scalars R S M) : + c • x = (restrict_scalars.add_equiv R S M).symm + (algebra_map R S c • restrict_scalars.add_equiv R S M x) := +rfl + +lemma restrict_scalars.add_equiv_symm_map_algebra_map_smul (r : R) (x : M) : + (restrict_scalars.add_equiv R S M).symm (algebra_map R S r • x) + = r • (restrict_scalars.add_equiv R S M).symm x := +rfl + +lemma restrict_scalars.add_equiv_symm_map_smul_smul (r : R) (s : S) (x : M) : + (restrict_scalars.add_equiv R S M).symm ((r • s) • x) + = r • (restrict_scalars.add_equiv R S M ).symm (s • x) := +by { rw [algebra.smul_def, mul_smul], refl, } -@[simp] lemma restrict_scalars.add_equiv_map_smul (t : R) (x : restrict_scalars R S M) : - restrict_scalars.add_equiv R S M (t • x) - = (algebra_map R S t) • restrict_scalars.add_equiv R S M x := +lemma restrict_scalars.lsmul_apply_apply (s : S) (x : restrict_scalars R S M) : + restrict_scalars.lsmul R S M s x = + (restrict_scalars.add_equiv R S M).symm (s • (restrict_scalars.add_equiv R S M x)) := rfl end module diff --git a/src/algebra/algebra/spectrum.lean b/src/algebra/algebra/spectrum.lean index 84d5b91579a33..6b5043020159e 100644 --- a/src/algebra/algebra/spectrum.lean +++ b/src/algebra/algebra/spectrum.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Jireh Loreaux. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jireh Loreaux -/ -import tactic.noncomm_ring -import field_theory.is_alg_closed.basic import algebra.star.pointwise +import algebra.star.subalgebra +import tactic.noncomm_ring /-! # Spectrum of an element in an algebra + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. This file develops the basic theory of the spectrum of an element of an algebra. This theory will serve as the foundation for spectral theory in Banach algebras. @@ -29,14 +32,15 @@ This theory will serve as the foundation for spectral theory in Banach algebras. units (of `R`) in `σ (a*b)` coincide with those in `σ (b*a)`. * `spectrum.scalar_eq`: in a nontrivial algebra over a field, the spectrum of a scalar is a singleton. -* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`, - `spectrum.map_polynomial_aeval_of_nonempty`: variations on the spectral mapping theorem. ## Notations * `σ a` : `spectrum R a` of `a : A` -/ +open set +open_locale pointwise + universes u v section defs @@ -82,7 +86,6 @@ noncomputable def is_unit.sub_inv_smul {r : Rˣ} {s : R} {a : A} end defs namespace spectrum -open_locale polynomial section scalar_semiring @@ -100,6 +103,16 @@ lemma not_mem_iff {r : R} {a : A} : r ∉ σ a ↔ is_unit (↑ₐr - a) := by { apply not_iff_not.mp, simp [set.not_not_mem, mem_iff] } +variables (R) + +lemma zero_mem_iff {a : A} : (0 : R) ∈ σ a ↔ ¬is_unit a := +by rw [mem_iff, map_zero, zero_sub, is_unit.neg_iff] + +lemma zero_not_mem_iff {a : A} : (0 : R) ∉ σ a ↔ is_unit a := +by rw [zero_mem_iff, not_not] + +variables {R} + lemma mem_resolvent_set_of_left_right_inverse {r : R} {a b c : A} (h₁ : (↑ₐr - a) * b = 1) (h₂ : c * (↑ₐr - a) = 1) : r ∈ resolvent_set R a := @@ -165,37 +178,26 @@ end lemma inv_mem_iff {r : Rˣ} {a : Aˣ} : (r : R) ∈ σ (a : A) ↔ (↑r⁻¹ : R) ∈ σ (↑a⁻¹ : A) := -begin - simp only [mem_iff, not_iff_not, ←mem_resolvent_set_iff], - exact ⟨λ h, inv_mem_resolvent_set h, λ h, by simpa using inv_mem_resolvent_set h⟩, -end +not_iff_not.2 $ ⟨inv_mem_resolvent_set, inv_mem_resolvent_set⟩ lemma zero_mem_resolvent_set_of_unit (a : Aˣ) : 0 ∈ resolvent_set R (a : A) := -by { rw [mem_resolvent_set_iff, is_unit.sub_iff], simp } +by simpa only [mem_resolvent_set_iff, ←not_mem_iff, zero_not_mem_iff] using a.is_unit lemma ne_zero_of_mem_of_unit {a : Aˣ} {r : R} (hr : r ∈ σ (a : A)) : r ≠ 0 := λ hn, (hn ▸ hr) (zero_mem_resolvent_set_of_unit a) lemma add_mem_iff {a : A} {r s : R} : - r ∈ σ a ↔ r + s ∈ σ (↑ₐs + a) := -begin - apply not_iff_not.mpr, - simp only [mem_resolvent_set_iff], - have h_eq : ↑ₐ(r + s) - (↑ₐs + a) = ↑ₐr - a, - { simp, noncomm_ring }, - rw h_eq, -end + r + s ∈ σ a ↔ r ∈ σ (-↑ₐs + a) := +by simp only [mem_iff, sub_neg_eq_add, ←sub_sub, map_add] + +lemma add_mem_add_iff {a : A} {r s : R} : + r + s ∈ σ (↑ₐs + a) ↔ r ∈ σ a := +by rw [add_mem_iff, neg_add_cancel_left] lemma smul_mem_smul_iff {a : A} {s : R} {r : Rˣ} : r • s ∈ σ (r • a) ↔ s ∈ σ a := -begin - apply not_iff_not.mpr, - simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one], - have h_eq : (r • s) • (1 : A) = r • s • 1, by simp, - rw [h_eq, ←smul_sub, is_unit_smul_iff], -end - -open_locale pointwise polynomial +by simp only [mem_iff, not_iff_not, algebra.algebra_map_eq_smul_one, smul_assoc, ←smul_sub, + is_unit_smul_iff] theorem unit_smul_eq_smul (a : A) (r : Rˣ) : σ (r • a) = r • σ a := @@ -213,33 +215,22 @@ end theorem unit_mem_mul_iff_mem_swap_mul {a b : A} {r : Rˣ} : ↑r ∈ σ (a * b) ↔ ↑r ∈ σ (b * a) := begin - apply not_iff_not.mpr, - simp only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one], - have coe_smul_eq : ↑r • 1 = r • (1 : A), from rfl, - rw coe_smul_eq, - simp only [is_unit.smul_sub_iff_sub_inv_smul], - have right_inv_of_swap : ∀ {x y z : A} (h : (1 - x * y) * z = 1), - (1 - y * x) * (1 + y * z * x) = 1, from λ x y z h, - calc (1 - y * x) * (1 + y * z * x) = 1 - y * x + y * ((1 - x * y) * z) * x : by noncomm_ring - ... = 1 : by simp [h], - have left_inv_of_swap : ∀ {x y z : A} (h : z * (1 - x * y) = 1), - (1 + y * z * x) * (1 - y * x) = 1, from λ x y z h, - calc (1 + y * z * x) * (1 - y * x) = 1 - y * x + y * (z * (1 - x * y)) * x : by noncomm_ring - ... = 1 : by simp [h], - have is_unit_one_sub_mul_of_swap : ∀ {x y : A} (h : is_unit (1 - x * y)), - is_unit (1 - y * x), from λ x y h, by - { let h₁ := right_inv_of_swap h.unit.val_inv, - let h₂ := left_inv_of_swap h.unit.inv_val, - exact ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, h₁, h₂⟩, rfl⟩, }, - have is_unit_one_sub_mul_iff_swap : ∀ {x y : A}, - is_unit (1 - x * y) ↔ is_unit (1 - y * x), by - { intros, split, repeat {apply is_unit_one_sub_mul_of_swap}, }, - rw [←smul_mul_assoc, ←mul_smul_comm r⁻¹ b a, is_unit_one_sub_mul_iff_swap], + have h₁ : ∀ x y : A, is_unit (1 - x * y) → is_unit (1 - y * x), + { refine λ x y h, ⟨⟨1 - y * x, 1 + y * h.unit.inv * x, _, _⟩, rfl⟩, + calc (1 - y * x) * (1 + y * (is_unit.unit h).inv * x) + = (1 - y * x) + y * ((1 - x * y) * h.unit.inv) * x : by noncomm_ring + ... = 1 : by simp only [units.inv_eq_coe_inv, is_unit.mul_coe_inv, mul_one, sub_add_cancel], + calc (1 + y * (is_unit.unit h).inv * x) * (1 - y * x) + = (1 - y * x) + y * (h.unit.inv * (1 - x * y)) * x : by noncomm_ring + ... = 1 : by simp only [units.inv_eq_coe_inv, is_unit.coe_inv_mul, mul_one, sub_add_cancel]}, + simpa only [mem_iff, not_iff_not, algebra.algebra_map_eq_smul_one, ←units.smul_def, + is_unit.smul_sub_iff_sub_inv_smul, ←smul_mul_assoc, ←mul_smul_comm r⁻¹ b a] + using iff.intro (h₁ (r⁻¹ • a) b) (h₁ b (r⁻¹ • a)), end theorem preimage_units_mul_eq_swap_mul {a b : A} : (coe : Rˣ → R) ⁻¹' σ (a * b) = coe ⁻¹' σ (b * a) := -by { ext, exact unit_mem_mul_iff_mem_swap_mul, } +set.ext $ λ _, unit_mem_mul_iff_mem_swap_mul section star @@ -248,8 +239,8 @@ variables [has_involutive_star R] [star_ring A] [star_module R A] lemma star_mem_resolvent_set_iff {r : R} {a : A} : star r ∈ resolvent_set R a ↔ r ∈ resolvent_set R (star a) := by refine ⟨λ h, _, λ h, _⟩; - simpa only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, star_sub, star_smul, - star_star, star_one] using is_unit.star h + simpa only [mem_resolvent_set_iff, algebra.algebra_map_eq_smul_one, star_sub, star_smul, + star_star, star_one] using is_unit.star h protected lemma map_star (a : A) : σ (star a) = star (σ a) := by { ext, simpa only [set.mem_star, mem_iff, not_iff_not] using star_mem_resolvent_set_iff.symm } @@ -266,24 +257,35 @@ variables [comm_ring R] [ring A] [algebra R A] local notation `σ` := spectrum R local notation `↑ₐ` := algebra_map R A -theorem left_add_coset_eq (a : A) (r : R) : - left_add_coset r (σ a) = σ (↑ₐr + a) := -by { ext, rw [mem_left_add_coset_iff, neg_add_eq_sub, add_mem_iff], - nth_rewrite 1 ←sub_add_cancel x r, } +-- it would be nice to state this for `subalgebra_class`, but we don't have such a thing yet +lemma subset_subalgebra {S : subalgebra R A} (a : S) : spectrum R (a : A) ⊆ spectrum R a := +compl_subset_compl.2 (λ _, is_unit.map S.val) -open polynomial +-- this is why it would be nice if `subset_subalgebra` was registered for `subalgebra_class`. +lemma subset_star_subalgebra [star_ring R] [star_ring A] [star_module R A] {S : star_subalgebra R A} + (a : S) : spectrum R (a : A) ⊆ spectrum R a := +compl_subset_compl.2 (λ _, is_unit.map S.subtype) -lemma exists_mem_of_not_is_unit_aeval_prod [is_domain R] {p : R[X]} {a : A} (hp : p ≠ 0) - (h : ¬is_unit (aeval a (multiset.map (λ (x : R), X - C x) p.roots).prod)) : - ∃ k : R, k ∈ σ a ∧ eval k p = 0 := -begin - rw [←multiset.prod_to_list, alg_hom.map_list_prod] at h, - replace h := mt list.prod_is_unit h, - simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list, - list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at h, - rcases h with ⟨r, r_mem, r_nu⟩, - exact ⟨r, by rwa [mem_iff, ←is_unit.sub_iff], by rwa [←is_root.def, ←mem_roots hp]⟩ -end +lemma singleton_add_eq (a : A) (r : R) : {r} + (σ a) = σ (↑ₐr + a) := +ext $ λ x, + by rw [singleton_add, image_add_left, mem_preimage, add_comm, add_mem_iff, map_neg, neg_neg] + +lemma add_singleton_eq (a : A) (r : R) : (σ a) + {r} = σ (a + ↑ₐr) := +add_comm {r} (σ a) ▸ add_comm (algebra_map R A r) a ▸ singleton_add_eq a r + +lemma vadd_eq (a : A) (r : R) : r +ᵥ (σ a) = σ (↑ₐr + a) := +(singleton_add).symm.trans $ singleton_add_eq a r + +lemma neg_eq (a : A) : -(σ a) = σ (-a) := +set.ext $ λ x, by simp only [mem_neg, mem_iff, map_neg, ←neg_add', is_unit.neg_iff, sub_neg_eq_add] + +lemma singleton_sub_eq (a : A) (r : R) : + {r} - (σ a) = σ (↑ₐr - a) := +by rw [sub_eq_add_neg, neg_eq, singleton_add_eq, sub_eq_add_neg] + +lemma sub_singleton_eq (a : A) (r : R) : + (σ a) - {r} = σ (a - ↑ₐr) := +by simpa only [neg_sub, neg_eq] using congr_arg has_neg.neg (singleton_sub_eq a r) end scalar_ring @@ -307,23 +309,12 @@ begin end @[simp] theorem scalar_eq [nontrivial A] (k : 𝕜) : σ (↑ₐk) = {k} := -begin - have coset_eq : left_add_coset k {0} = {k}, by - { ext, split, - { intro hx, simp [left_add_coset] at hx, exact hx, }, - { intro hx, simp at hx, exact ⟨0, ⟨set.mem_singleton 0, by simp [hx]⟩⟩, }, }, - calc σ (↑ₐk) = σ (↑ₐk + 0) : by simp - ... = left_add_coset k (σ (0 : A)) : by rw ←left_add_coset_eq - ... = left_add_coset k {0} : by rw zero_eq - ... = {k} : coset_eq, -end +by rw [←add_zero (↑ₐk), ←singleton_add_eq, zero_eq, set.singleton_add_singleton, add_zero] @[simp] lemma one_eq [nontrivial A] : σ (1 : A) = {1} := -calc σ (1 : A) = σ (↑ₐ1) : by simp [algebra.algebra_map_eq_smul_one] +calc σ (1 : A) = σ (↑ₐ1) : by rw [algebra.algebra_map_eq_smul_one, one_smul] ... = {1} : scalar_eq 1 -open_locale pointwise - /-- the assumption `(σ a).nonempty` is necessary and cannot be removed without further conditions on the algebra `A` and scalar field `𝕜`. -/ theorem smul_eq_smul [nontrivial A] (k : 𝕜) (a : A) (ha : (σ a).nonempty) : @@ -350,81 +341,10 @@ begin have : k ≠ 0, { simpa only [inv_inv] using inv_ne_zero (ne_zero_of_mem_of_unit hk), }, lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr this, - rw ←units.coe_inv' k at hk, + rw ←units.coe_inv k at hk, exact inv_mem_iff.mp hk }, { lift k to 𝕜ˣ using is_unit_iff_ne_zero.mpr (ne_zero_of_mem_of_unit hk), - simpa only [units.coe_inv'] using inv_mem_iff.mp hk, } -end - -open polynomial -/-- Half of the spectral mapping theorem for polynomials. We prove it separately -because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and -`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/ -theorem subset_polynomial_aeval (a : A) (p : 𝕜[X]) : - (λ k, eval k p) '' (σ a) ⊆ σ (aeval a p) := -begin - rintros _ ⟨k, hk, rfl⟩, - let q := C (eval k p) - p, - have hroot : is_root q k, by simp only [eval_C, eval_sub, sub_self, is_root.def], - rw [←mul_div_eq_iff_is_root, ←neg_mul_neg, neg_sub] at hroot, - have aeval_q_eq : ↑ₐ(eval k p) - aeval a p = aeval a q, - by simp only [aeval_C, alg_hom.map_sub, sub_left_inj], - rw [mem_iff, aeval_q_eq, ←hroot, aeval_mul], - have hcomm := (commute.all (C k - X) (- (q / (X - C k)))).map (aeval a), - apply mt (λ h, (hcomm.is_unit_mul_iff.mp h).1), - simpa only [aeval_X, aeval_C, alg_hom.map_sub] using hk, -end - -/-- The *spectral mapping theorem* for polynomials. Note: the assumption `degree p > 0` -is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side, -assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/ -theorem map_polynomial_aeval_of_degree_pos [is_alg_closed 𝕜] (a : A) (p : 𝕜[X]) - (hdeg : 0 < degree p) : σ (aeval a p) = (λ k, eval k p) '' (σ a) := -begin - /- handle the easy direction via `spectrum.subset_polynomial_aeval` -/ - refine set.eq_of_subset_of_subset (λ k hk, _) (subset_polynomial_aeval a p), - /- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`. -/ - have hprod := eq_prod_roots_of_splits_id (is_alg_closed.splits (C k - p)), - have h_ne : C k - p ≠ 0, from ne_zero_of_degree_gt - (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)]), - have lead_ne := leading_coeff_ne_zero.mpr h_ne, - have lead_unit := (units.map (↑ₐ).to_monoid_hom (units.mk0 _ lead_ne)).is_unit, - /- leading coefficient is a unit so product of linear factors is not a unit; - apply `exists_mem_of_not_is_unit_aeval_prod`. -/ - have p_a_eq : aeval a (C k - p) = ↑ₐk - aeval a p, - by simp only [aeval_C, alg_hom.map_sub, sub_left_inj], - rw [mem_iff, ←p_a_eq, hprod, aeval_mul, - ((commute.all _ _).map (aeval a)).is_unit_mul_iff, aeval_C] at hk, - replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit), - rcases hk with ⟨r, r_mem, r_ev⟩, - exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩, -end - -/-- In this version of the spectral mapping theorem, we assume the spectrum -is nonempty instead of assuming the degree of the polynomial is positive. Note: the -assumption `[nontrivial A]` is necessary for the same reason as in `spectrum.zero_eq`. -/ -theorem map_polynomial_aeval_of_nonempty [is_alg_closed 𝕜] [nontrivial A] (a : A) (p : 𝕜[X]) - (hnon : (σ a).nonempty) : σ (aeval a p) = (λ k, eval k p) '' (σ a) := -begin - refine or.elim (le_or_gt (degree p) 0) (λ h, _) (map_polynomial_aeval_of_degree_pos a p), - { rw eq_C_of_degree_le_zero h, - simp only [set.image_congr, eval_C, aeval_C, scalar_eq, set.nonempty.image_const hnon] }, -end - -variable (𝕜) -/-- -Every element `a` in a nontrivial finite-dimensional algebra `A` -over an algebraically closed field `𝕜` has non-empty spectrum. -/ --- We will use this both to show eigenvalues exist, and to prove Schur's lemma. -lemma nonempty_of_is_alg_closed_of_finite_dimensional [is_alg_closed 𝕜] - [nontrivial A] [I : finite_dimensional 𝕜 A] (a : A) : - ∃ k : 𝕜, k ∈ σ a := -begin - obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) a, - have nu : ¬ is_unit (aeval a p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, }, - rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p)] at nu, - obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu, - exact ⟨k, hk⟩ + simpa only [units.coe_inv] using inv_mem_iff.mp hk, } end end scalar_field @@ -435,32 +355,33 @@ namespace alg_hom section comm_semiring -variables {R : Type*} {A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B] +variables {F R A B : Type*} [comm_semiring R] [ring A] [algebra R A] [ring B] [algebra R B] +variables [alg_hom_class F R A B] local notation `σ` := spectrum R local notation `↑ₐ` := algebra_map R A -lemma mem_resolvent_set_apply (φ : A →ₐ[R] B) {a : A} {r : R} (h : r ∈ resolvent_set R a) : - r ∈ resolvent_set R (φ a) := -by simpa only [map_sub, commutes] using h.map φ +lemma mem_resolvent_set_apply (φ : F) {a : A} {r : R} (h : r ∈ resolvent_set R a) : + r ∈ resolvent_set R ((φ : A → B) a) := +by simpa only [map_sub, alg_hom_class.commutes] using h.map φ -lemma spectrum_apply_subset (φ : A →ₐ[R] B) (a : A) : σ (φ a) ⊆ σ a := +lemma spectrum_apply_subset (φ : F) (a : A) : σ ((φ : A → B) a) ⊆ σ a := λ _, mt (mem_resolvent_set_apply φ) end comm_semiring section comm_ring -variables {R : Type*} {A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B] +variables {F R A B : Type*} [comm_ring R] [ring A] [algebra R A] [ring B] [algebra R B] +variables [alg_hom_class F R A R] local notation `σ` := spectrum R local notation `↑ₐ` := algebra_map R A -lemma apply_mem_spectrum [nontrivial R] (φ : A →ₐ[R] R) (a : A) : φ a ∈ σ a := +lemma apply_mem_spectrum [nontrivial R] (φ : F) (a : A) : φ a ∈ σ a := begin - have h : ↑ₐ(φ a) - a ∈ φ.to_ring_hom.ker, - { simp only [ring_hom.mem_ker, coe_to_ring_hom, commutes, algebra.id.map_eq_id, - to_ring_hom_eq_coe, ring_hom.id_apply, sub_self, map_sub] }, - simp only [spectrum.mem_iff, ←mem_nonunits_iff, - coe_subset_nonunits (φ.to_ring_hom.ker_ne_top) h], + have h : ↑ₐ(φ a) - a ∈ (φ : A →+* R).ker, + { simp only [ring_hom.mem_ker, map_sub, ring_hom.coe_coe, alg_hom_class.commutes, + algebra.id.map_eq_id, ring_hom.id_apply, sub_self], }, + simp only [spectrum.mem_iff, ←mem_nonunits_iff, coe_subset_nonunits ((φ : A →+* R).ker_ne_top) h], end end comm_ring diff --git a/src/algebra/algebra/subalgebra/basic.lean b/src/algebra/algebra/subalgebra/basic.lean index 39a8100e37574..f0ef0af5aec09 100644 --- a/src/algebra/algebra/subalgebra/basic.lean +++ b/src/algebra/algebra/subalgebra/basic.lean @@ -5,11 +5,16 @@ Authors: Kenny Lau, Yury Kudryashov -/ import algebra.algebra.basic import data.set.Union_lift +import linear_algebra.finsupp +import ring_theory.ideal.operations /-! # Subalgebras over Commutative Semiring -In this file we define `subalgebra`s and the usual operations on them (`map`, `comap'`). +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `subalgebra`s and the usual operations on them (`map`, `comap`). More lemmas about `adjoin` can be found in `ring_theory.adjoin`. -/ @@ -66,8 +71,8 @@ to_subsemiring_injective.eq_iff equalities. -/ protected def copy (S : subalgebra R A) (s : set A) (hs : s = ↑S) : subalgebra R A := { carrier := s, - add_mem' := hs.symm ▸ S.add_mem', - mul_mem' := hs.symm ▸ S.mul_mem', + add_mem' := λ _ _, hs.symm ▸ S.add_mem', + mul_mem' := λ _ _, hs.symm ▸ S.mul_mem', algebra_map_mem' := hs.symm ▸ S.algebra_map_mem' } @[simp] lemma coe_copy (S : subalgebra R A) (s : set A) (hs : s = ↑S) : @@ -93,6 +98,9 @@ S.range_subset theorem smul_mem {x : A} (hx : x ∈ S) (r : R) : r • x ∈ S := (algebra.smul_def r x).symm ▸ mul_mem (S.algebra_map_mem r) hx +instance : smul_mem_class (subalgebra R A) R A := +{ smul_mem := λ S r x hx, smul_mem S hx r } + protected theorem one_mem : (1 : A) ∈ S := one_mem S protected theorem mul_mem {x y : A} (hx : x ∈ S) (hy : y ∈ S) : x * y ∈ S := mul_mem hx hy protected theorem pow_mem {x : A} (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S := pow_mem hx n @@ -186,9 +194,15 @@ instance to_comm_ring {R A} instance to_ordered_semiring {R A} [comm_semiring R] [ordered_semiring A] [algebra R A] (S : subalgebra R A) : ordered_semiring S := S.to_subsemiring.to_ordered_semiring +instance to_strict_ordered_semiring {R A} + [comm_semiring R] [strict_ordered_semiring A] [algebra R A] (S : subalgebra R A) : + strict_ordered_semiring S := S.to_subsemiring.to_strict_ordered_semiring instance to_ordered_comm_semiring {R A} [comm_semiring R] [ordered_comm_semiring A] [algebra R A] (S : subalgebra R A) : ordered_comm_semiring S := S.to_subsemiring.to_ordered_comm_semiring +instance to_strict_ordered_comm_semiring {R A} + [comm_semiring R] [strict_ordered_comm_semiring A] [algebra R A] (S : subalgebra R A) : + strict_ordered_comm_semiring S := S.to_subsemiring.to_strict_ordered_comm_semiring instance to_ordered_ring {R A} [comm_ring R] [ordered_ring A] [algebra R A] (S : subalgebra R A) : ordered_ring S := S.to_subring.to_ordered_ring @@ -199,7 +213,9 @@ instance to_ordered_comm_ring {R A} instance to_linear_ordered_semiring {R A} [comm_semiring R] [linear_ordered_semiring A] [algebra R A] (S : subalgebra R A) : linear_ordered_semiring S := S.to_subsemiring.to_linear_ordered_semiring -/-! There is no `linear_ordered_comm_semiring`. -/ +instance to_linear_ordered_comm_semiring {R A} + [comm_semiring R] [linear_ordered_comm_semiring A] [algebra R A] (S : subalgebra R A) : + linear_ordered_comm_semiring S := S.to_subsemiring.to_linear_ordered_comm_semiring instance to_linear_ordered_ring {R A} [comm_ring R] [linear_ordered_ring A] [algebra R A] (S : subalgebra R A) : linear_ordered_ring S := S.to_subring.to_linear_ordered_ring @@ -209,43 +225,42 @@ instance to_linear_ordered_comm_ring {R A} end -/-- Convert a `subalgebra` to `submodule` -/ -def to_submodule : submodule R A := -{ carrier := S, - zero_mem' := (0:S).2, - add_mem' := λ x y hx hy, (⟨x, hx⟩ + ⟨y, hy⟩ : S).2, - smul_mem' := λ c x hx, (algebra.smul_def c x).symm ▸ - (⟨algebra_map R A c, S.range_le ⟨c, rfl⟩⟩ * ⟨x, hx⟩:S).2 } +/-- The forgetful map from `subalgebra` to `submodule` as an `order_embedding` -/ +def to_submodule : subalgebra R A ↪o submodule R A := +{ to_embedding := + { to_fun := λ S, + { carrier := S, + zero_mem' := (0:S).2, + add_mem' := λ x y hx hy, (⟨x, hx⟩ + ⟨y, hy⟩ : S).2, + smul_mem' := λ c x hx, (algebra.smul_def c x).symm ▸ + (⟨algebra_map R A c, S.range_le ⟨c, rfl⟩⟩ * ⟨x, hx⟩:S).2 }, + inj' := λ S T h, ext $ by apply set_like.ext_iff.1 h }, + map_rel_iff' := λ S T, set_like.coe_subset_coe.symm.trans set_like.coe_subset_coe } +/- TODO: bundle other forgetful maps between algebraic substructures, e.g. + `to_subsemiring` and `to_subring` in this file. -/ @[simp] lemma mem_to_submodule {x} : x ∈ S.to_submodule ↔ x ∈ S := iff.rfl @[simp] lemma coe_to_submodule (S : subalgebra R A) : (↑S.to_submodule : set A) = S := rfl -theorem to_submodule_injective : - function.injective (to_submodule : subalgebra R A → submodule R A) := -λ S T h, ext $ λ x, by rw [← mem_to_submodule, ← mem_to_submodule, h] - -theorem to_submodule_inj {S U : subalgebra R A} : S.to_submodule = U.to_submodule ↔ S = U := -to_submodule_injective.eq_iff - section /-! `subalgebra`s inherit structure from their `submodule` coercions. -/ -instance module' [semiring R'] [has_scalar R' R] [module R' A] [is_scalar_tower R' R A] : +instance module' [semiring R'] [has_smul R' R] [module R' A] [is_scalar_tower R' R A] : module R' S := S.to_submodule.module' instance : module R S := S.module' -instance [semiring R'] [has_scalar R' R] [module R' A] [is_scalar_tower R' R A] : +instance [semiring R'] [has_smul R' R] [module R' A] [is_scalar_tower R' R A] : is_scalar_tower R' R S := S.to_submodule.is_scalar_tower -instance algebra' [comm_semiring R'] [has_scalar R' R] [algebra R' A] +instance algebra' [comm_semiring R'] [has_smul R' R] [algebra R' A] [is_scalar_tower R' R A] : algebra R' S := { commutes' := λ c x, subtype.eq $ algebra.commutes _ _, smul_def' := λ c x, subtype.eq $ algebra.smul_def _ _, - .. (algebra_map R' A).cod_srestrict S.to_subsemiring $ λ x, begin + .. (algebra_map R' A).cod_restrict S $ λ x, begin rw [algebra.algebra_map_eq_smul_one, ←smul_one_smul R x (1 : A), ←algebra.algebra_map_eq_smul_one], exact algebra_map_mem S _, @@ -269,15 +284,15 @@ protected lemma coe_neg {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebr {S : subalgebra R A} (x : S) : (↑(-x) : A) = -↑x := rfl protected lemma coe_sub {R : Type u} {A : Type v} [comm_ring R] [ring A] [algebra R A] {S : subalgebra R A} (x y : S) : (↑(x - y) : A) = ↑x - ↑y := rfl -@[simp, norm_cast] lemma coe_smul [semiring R'] [has_scalar R' R] [module R' A] +@[simp, norm_cast] lemma coe_smul [semiring R'] [has_smul R' R] [module R' A] [is_scalar_tower R' R A] (r : R') (x : S) : (↑(r • x) : A) = r • ↑x := rfl -@[simp, norm_cast] lemma coe_algebra_map [comm_semiring R'] [has_scalar R' R] [algebra R' A] +@[simp, norm_cast] lemma coe_algebra_map [comm_semiring R'] [has_smul R' R] [algebra R' A] [is_scalar_tower R' R A] (r : R') : ↑(algebra_map R' S r) = algebra_map R' A r := rfl protected lemma coe_pow (x : S) (n : ℕ) : (↑(x^n) : A) = (↑x)^n := submonoid_class.coe_pow x n -protected lemma coe_eq_zero {x : S} : (x : A) = 0 ↔ x = 0 := add_submonoid_class.coe_eq_zero -protected lemma coe_eq_one {x : S} : (x : A) = 1 ↔ x = 1 := submonoid_class.coe_eq_one +protected lemma coe_eq_zero {x : S} : (x : A) = 0 ↔ x = 0 := zero_mem_class.coe_eq_zero +protected lemma coe_eq_one {x : S} : (x : A) = 1 ↔ x = 1 := one_mem_class.coe_eq_one -- todo: standardize on the names these morphisms -- compare with submodule.subtype @@ -303,7 +318,7 @@ def to_submodule_equiv (S : subalgebra R A) : S.to_submodule ≃ₗ[R] S := linear_equiv.of_eq _ _ rfl /-- Transport a subalgebra via an algebra homomorphism. -/ -def map (S : subalgebra R A) (f : A →ₐ[R] B) : subalgebra R B := +def map (f : A →ₐ[R] B) (S : subalgebra R A) : subalgebra R B := { algebra_map_mem' := λ r, f.commutes r ▸ set.mem_image_of_mem _ (S.algebra_map_mem r), .. S.to_subsemiring.map (f : A →+* B) } @@ -311,9 +326,9 @@ lemma map_mono {S₁ S₂ : subalgebra R A} {f : A →ₐ[R] B} : S₁ ≤ S₂ → S₁.map f ≤ S₂.map f := set.image_subset f -lemma map_injective {S₁ S₂ : subalgebra R A} (f : A →ₐ[R] B) - (hf : function.injective f) (ih : S₁.map f = S₂.map f) : S₁ = S₂ := -ext $ set.ext_iff.1 $ set.image_injective.2 hf $ set.ext $ set_like.ext_iff.mp ih +lemma map_injective {f : A →ₐ[R] B} (hf : function.injective f) : + function.injective (map f) := +λ S₁ S₂ ih, ext $ set.ext_iff.1 $ set.image_injective.2 hf $ set.ext $ set_like.ext_iff.mp ih @[simp] lemma map_id (S : subalgebra R A) : S.map (alg_hom.id R A) = S := set_like.coe_injective $ set.image_id _ @@ -323,7 +338,7 @@ lemma map_map (S : subalgebra R A) (g : B →ₐ[R] C) (f : A →ₐ[R] B) : set_like.coe_injective $ set.image_image _ _ _ lemma mem_map {S : subalgebra R A} {f : A →ₐ[R] B} {y : B} : - y ∈ map S f ↔ ∃ x ∈ S, f x = y := + y ∈ map f S ↔ ∃ x ∈ S, f x = y := subsemiring.mem_map lemma map_to_submodule {S : subalgebra R A} {f : A →ₐ[R] B} : @@ -339,24 +354,24 @@ set_like.coe_injective rfl rfl /-- Preimage of a subalgebra under an algebra homomorphism. -/ -def comap' (S : subalgebra R B) (f : A →ₐ[R] B) : subalgebra R A := +def comap (f : A →ₐ[R] B) (S : subalgebra R B) : subalgebra R A := { algebra_map_mem' := λ r, show f (algebra_map R A r) ∈ S, from (f.commutes r).symm ▸ S.algebra_map_mem r, .. S.to_subsemiring.comap (f : A →+* B) } theorem map_le {S : subalgebra R A} {f : A →ₐ[R] B} {U : subalgebra R B} : - map S f ≤ U ↔ S ≤ comap' U f := + map f S ≤ U ↔ S ≤ comap f U := set.image_subset_iff -lemma gc_map_comap (f : A →ₐ[R] B) : galois_connection (λ S, map S f) (λ S, comap' S f) := +lemma gc_map_comap (f : A →ₐ[R] B) : galois_connection (map f) (comap f) := λ S U, map_le @[simp] lemma mem_comap (S : subalgebra R B) (f : A →ₐ[R] B) (x : A) : - x ∈ S.comap' f ↔ f x ∈ S := + x ∈ S.comap f ↔ f x ∈ S := iff.rfl @[simp, norm_cast] lemma coe_comap (S : subalgebra R B) (f : A →ₐ[R] B) : - (S.comap' f : set A) = f ⁻¹' (S : set B) := + (S.comap f : set A) = f ⁻¹' (S : set B) := rfl instance no_zero_divisors {R A : Type*} [comm_semiring R] [semiring A] [no_zero_divisors A] @@ -434,7 +449,7 @@ set_like.coe_mono (set.range_comp_subset_range f g) /-- Restrict the codomain of an algebra homomorphism. -/ def cod_restrict (f : A →ₐ[R] B) (S : subalgebra R B) (hf : ∀ x, f x ∈ S) : A →ₐ[R] S := { commutes' := λ r, subtype.eq $ f.commutes r, - .. ring_hom.cod_srestrict (f : A →+* B) S.to_subsemiring hf } + .. ring_hom.cod_restrict (f : A →+* B) S hf } @[simp] lemma val_comp_cod_restrict (f : A →ₐ[R] B) (S : subalgebra R B) (hf : ∀ x, f x ∈ S) : S.val.comp (f.cod_restrict S hf) = f := @@ -563,7 +578,7 @@ set.mem_univ x (⊤ : subalgebra R A).to_subring = ⊤ := rfl @[simp] lemma to_submodule_eq_top {S : subalgebra R A} : S.to_submodule = ⊤ ↔ S = ⊤ := -subalgebra.to_submodule_injective.eq_iff' top_to_submodule +subalgebra.to_submodule.injective.eq_iff' top_to_submodule @[simp] lemma to_subsemiring_eq_top {S : subalgebra R A} : S.to_subsemiring = ⊤ ↔ S = ⊤ := subalgebra.to_subsemiring_injective.eq_iff' top_to_subsemiring @@ -639,17 +654,21 @@ theorem eq_top_iff {S : subalgebra R A} : S = ⊤ ↔ ∀ x : A, x ∈ S := ⟨λ h x, by rw h; exact mem_top, λ h, by ext x; exact ⟨λ _, mem_top, λ _, h x⟩⟩ +lemma range_top_iff_surjective (f : A →ₐ[R] B) : + f.range = (⊤ : subalgebra R B) ↔ function.surjective f := +algebra.eq_top_iff + @[simp] theorem range_id : (alg_hom.id R A).range = ⊤ := set_like.coe_injective set.range_id -@[simp] theorem map_top (f : A →ₐ[R] B) : subalgebra.map (⊤ : subalgebra R A) f = f.range := +@[simp] theorem map_top (f : A →ₐ[R] B) : (⊤ : subalgebra R A).map f = f.range := set_like.coe_injective set.image_univ -@[simp] theorem map_bot (f : A →ₐ[R] B) : subalgebra.map (⊥ : subalgebra R A) f = ⊥ := +@[simp] theorem map_bot (f : A →ₐ[R] B) : (⊥ : subalgebra R A).map f = ⊥ := set_like.coe_injective $ by simp only [← set.range_comp, (∘), algebra.coe_bot, subalgebra.coe_map, f.commutes] -@[simp] theorem comap_top (f : A →ₐ[R] B) : subalgebra.comap' (⊤ : subalgebra R B) f = ⊤ := +@[simp] theorem comap_top (f : A →ₐ[R] B) : (⊤ : subalgebra R B).comap f = ⊤ := eq_top_iff.2 $ λ x, mem_top /-- `alg_hom` to `⊤ : subalgebra R A`. -/ @@ -695,41 +714,22 @@ This is the algebra version of `submodule.top_equiv`. -/ @[simps] def top_equiv : (⊤ : subalgebra R A) ≃ₐ[R] A := alg_equiv.of_alg_hom (subalgebra.val ⊤) to_top rfl $ alg_hom.ext $ λ _, subtype.ext rfl --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_subsingleton [subsingleton A] : subsingleton (subalgebra R A) := +instance subsingleton_of_subsingleton [subsingleton A] : subsingleton (subalgebra R A) := ⟨λ B C, ext (λ x, by { simp only [subsingleton.elim x 0, zero_mem B, zero_mem C] })⟩ -/-- -For performance reasons this is not an instance. If you need this instance, add -``` -local attribute [instance] alg_hom.subsingleton subalgebra.subsingleton_of_subsingleton -``` -in the section that needs it. --/ --- TODO[gh-6025]: make this an instance once safe to do so -lemma _root_.alg_hom.subsingleton [subsingleton (subalgebra R A)] : subsingleton (A →ₐ[R] B) := +instance _root_.alg_hom.subsingleton [subsingleton (subalgebra R A)] : subsingleton (A →ₐ[R] B) := ⟨λ f g, alg_hom.ext $ λ a, have a ∈ (⊥ : subalgebra R A) := subsingleton.elim (⊤ : subalgebra R A) ⊥ ▸ mem_top, let ⟨x, hx⟩ := set.mem_range.mp (mem_bot.mp this) in hx ▸ (f.commutes _).trans (g.commutes _).symm⟩ --- TODO[gh-6025]: make this an instance once safe to do so -lemma _root_.alg_equiv.subsingleton_left [subsingleton (subalgebra R A)] : +instance _root_.alg_equiv.subsingleton_left [subsingleton (subalgebra R A)] : subsingleton (A ≃ₐ[R] B) := -begin - haveI : subsingleton (A →ₐ[R] B) := alg_hom.subsingleton, - exact ⟨λ f g, alg_equiv.ext - (λ x, alg_hom.ext_iff.mp (subsingleton.elim f.to_alg_hom g.to_alg_hom) x)⟩, -end +⟨λ f g, alg_equiv.ext (λ x, alg_hom.ext_iff.mp (subsingleton.elim f.to_alg_hom g.to_alg_hom) x)⟩ --- TODO[gh-6025]: make this an instance once safe to do so -lemma _root_.alg_equiv.subsingleton_right [subsingleton (subalgebra R B)] : +instance _root_.alg_equiv.subsingleton_right [subsingleton (subalgebra R B)] : subsingleton (A ≃ₐ[R] B) := -begin - haveI : subsingleton (B ≃ₐ[R] A) := alg_equiv.subsingleton_left, - exact ⟨λ f g, eq.trans (alg_equiv.symm_symm _).symm - (by rw [subsingleton.elim f.symm g.symm, alg_equiv.symm_symm])⟩ -end +⟨λ f g, by rw [← f.symm_symm, subsingleton.elim f.symm g.symm, g.symm_symm]⟩ lemma range_val : S.val.range = S := ext $ set.ext_iff.1 $ S.val.coe_range.trans subtype.range_val @@ -804,12 +804,11 @@ variables (S₁ : subalgebra R B) /-- The product of two subalgebras is a subalgebra. -/ def prod : subalgebra R (A × B) := -{ carrier := (S : set A) ×ˢ (S₁ : set B), +{ carrier := S ×ˢ S₁, algebra_map_mem' := λ r, ⟨algebra_map_mem _ _, algebra_map_mem _ _⟩, .. S.to_subsemiring.prod S₁.to_subsemiring } -@[simp] lemma coe_prod : - (prod S S₁ : set (A × B)) = (S : set A) ×ˢ (S₁ : set B):= rfl +@[simp] lemma coe_prod : (prod S S₁ : set (A × B)) = S ×ˢ S₁ := rfl lemma prod_to_submodule : (S.prod S₁).to_submodule = S.to_submodule.prod S₁.to_submodule := rfl @@ -914,29 +913,34 @@ section actions variables {α β : Type*} /-- The action by a subalgebra is the action by the underlying algebra. -/ -instance [has_scalar A α] (S : subalgebra R A) : has_scalar S α := S.to_subsemiring.has_scalar +instance [has_smul A α] (S : subalgebra R A) : has_smul S α := S.to_subsemiring.has_smul -lemma smul_def [has_scalar A α] {S : subalgebra R A} (g : S) (m : α) : g • m = (g : A) • m := rfl +lemma smul_def [has_smul A α] {S : subalgebra R A} (g : S) (m : α) : g • m = (g : A) • m := rfl instance smul_comm_class_left - [has_scalar A β] [has_scalar α β] [smul_comm_class A α β] (S : subalgebra R A) : + [has_smul A β] [has_smul α β] [smul_comm_class A α β] (S : subalgebra R A) : smul_comm_class S α β := S.to_subsemiring.smul_comm_class_left instance smul_comm_class_right - [has_scalar α β] [has_scalar A β] [smul_comm_class α A β] (S : subalgebra R A) : + [has_smul α β] [has_smul A β] [smul_comm_class α A β] (S : subalgebra R A) : smul_comm_class α S β := S.to_subsemiring.smul_comm_class_right /-- Note that this provides `is_scalar_tower S R R` which is needed by `smul_mul_assoc`. -/ instance is_scalar_tower_left - [has_scalar α β] [has_scalar A α] [has_scalar A β] [is_scalar_tower A α β] (S : subalgebra R A) : + [has_smul α β] [has_smul A α] [has_smul A β] [is_scalar_tower A α β] (S : subalgebra R A) : is_scalar_tower S α β := S.to_subsemiring.is_scalar_tower -instance [has_scalar A α] [has_faithful_scalar A α] (S : subalgebra R A) : - has_faithful_scalar S α := -S.to_subsemiring.has_faithful_scalar +instance is_scalar_tower_mid {R S T : Type*} [comm_semiring R] [semiring S] [add_comm_monoid T] + [algebra R S] [module R T] [module S T] [is_scalar_tower R S T] (S' : subalgebra R S) : + is_scalar_tower R S' T := +⟨λ x y z, (smul_assoc _ (y : S) _ : _)⟩ + +instance [has_smul A α] [has_faithful_smul A α] (S : subalgebra R A) : + has_faithful_smul S α := +S.to_subsemiring.has_faithful_smul /-- The action by a subalgebra is the action by the underlying algebra. -/ instance [mul_action A α] (S : subalgebra R A) : mul_action S α := @@ -1045,16 +1049,59 @@ lemma mem_centralizer_iff {s : set A} {z : A} : z ∈ centralizer R s ↔ ∀ g ∈ s, g * z = z * g := iff.rfl +lemma center_le_centralizer (s) : center R A ≤ centralizer R s := s.center_subset_centralizer + lemma centralizer_le (s t : set A) (h : s ⊆ t) : centralizer R t ≤ centralizer R s := set.centralizer_subset h +@[simp] lemma centralizer_eq_top_iff_subset {s : set A} : centralizer R s = ⊤ ↔ s ⊆ center R A := +set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset + @[simp] lemma centralizer_univ : centralizer R set.univ = center R A := set_like.ext' (set.centralizer_univ A) end centralizer +/-- Suppose we are given `∑ i, lᵢ * sᵢ = 1` in `S`, and `S'` a subalgebra of `S` that contains +`lᵢ` and `sᵢ`. To check that an `x : S` falls in `S'`, we only need to show that +`r ^ n • x ∈ M'` for some `n` for each `r : s`. -/ +lemma mem_of_finset_sum_eq_one_of_pow_smul_mem {S : Type*} [comm_ring S] + [algebra R S] (S' : subalgebra R S) {ι : Type*} (ι' : finset ι) (s : ι → S) (l : ι → S) + (e : ∑ i in ι', l i * s i = 1) + (hs : ∀ i, s i ∈ S') (hl : ∀ i, l i ∈ S') (x : S) + (H : ∀ i, ∃ (n : ℕ), (s i ^ n : S) • x ∈ S') : x ∈ S' := +begin + classical, + suffices : x ∈ (algebra.of_id S' S).range.to_submodule, + { obtain ⟨x, rfl⟩ := this, exact x.2 }, + choose n hn using H, + let s' : ι → S' := λ x, ⟨s x, hs x⟩, + have : ideal.span (s' '' ι')= ⊤, + { rw [ideal.eq_top_iff_one, ideal.span, finsupp.mem_span_iff_total], + refine ⟨(finsupp.of_support_finite (λ i : ι', (⟨l i, hl i⟩ : S')) (set.to_finite _)) + .map_domain $ λ i, ⟨s' i, i, i.2, rfl⟩, S'.to_submodule.injective_subtype _⟩, + rw [finsupp.total_map_domain, finsupp.total_apply, finsupp.sum_fintype, + map_sum, submodule.subtype_apply, subalgebra.coe_one], + { exact finset.sum_attach.trans e }, + { exact λ _, zero_smul _ _ } }, + let N := ι'.sup n, + have hs' := ideal.span_pow_eq_top _ this N, + apply (algebra.of_id S' S).range.to_submodule.mem_of_span_top_of_smul_mem _ hs', + rintros ⟨_, _, ⟨i, hi, rfl⟩, rfl⟩, + change s i ^ N • x ∈ _, + rw [← tsub_add_cancel_of_le (show n i ≤ N, from finset.le_sup hi), pow_add, mul_smul], + refine submodule.smul_mem _ (⟨_, pow_mem (hs i) _⟩ : S') _, + exact ⟨⟨_, hn i⟩, rfl⟩, +end + +lemma mem_of_span_eq_top_of_smul_pow_mem {S : Type*} [comm_ring S] [algebra R S] + (S' : subalgebra R S) (s : set S) (l : s →₀ S) (hs : finsupp.total s S S coe l = 1) + (hs' : s ⊆ S') (hl : ∀ i, l i ∈ S') (x : S) + (H : ∀ r : s, ∃ (n : ℕ), (r ^ n : S) • x ∈ S') : x ∈ S' := +mem_of_finset_sum_eq_one_of_pow_smul_mem S' l.support coe l hs (λ x, hs' x.2) hl x H + end subalgebra section nat @@ -1078,8 +1125,8 @@ variables {R : Type*} [ring R] /-- A subring is a `ℤ`-subalgebra. -/ def subalgebra_of_subring (S : subring R) : subalgebra ℤ R := -{ algebra_map_mem' := λ i, int.induction_on i S.zero_mem - (λ i ih, S.add_mem ih S.one_mem) +{ algebra_map_mem' := λ i, int.induction_on i (by simpa using S.zero_mem) + (λ i ih, by simpa using S.add_mem ih S.one_mem) (λ i ih, show ((-i - 1 : ℤ) : R) ∈ S, by { rw [int.cast_sub, int.cast_one], exact S.sub_mem ih S.one_mem }), .. S } diff --git a/src/algebra/algebra/subalgebra/pointwise.lean b/src/algebra/algebra/subalgebra/pointwise.lean index 70ffd9895815a..a4183947fa4f7 100644 --- a/src/algebra/algebra/subalgebra/pointwise.lean +++ b/src/algebra/algebra/subalgebra/pointwise.lean @@ -11,6 +11,9 @@ import ring_theory.adjoin.basic /-! # Pointwise actions on subalgebras. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `R'` acts on an `R`-algebra `A` (so that `R'` and `R` actions commute) then we get an `R'` action on the collection of `R`-subalgebras. -/ diff --git a/src/algebra/algebra/subalgebra/tower.lean b/src/algebra/algebra/subalgebra/tower.lean new file mode 100644 index 0000000000000..a66175054ee33 --- /dev/null +++ b/src/algebra/algebra/subalgebra/tower.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2020 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau, Anne Baanen +-/ + +import algebra.algebra.subalgebra.basic +import algebra.algebra.tower + +/-! +# Subalgebras in towers of algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove facts about subalgebras in towers of algebra. + +An algebra tower A/S/R is expressed by having instances of `algebra A S`, +`algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the +compatibility condition `(r • s) • a = r • (s • a)`. + +## Main results + + * `is_scalar_tower.subalgebra`: if `A/S/R` is a tower and `S₀` is a subalgebra + between `S` and `R`, then `A/S/S₀` is a tower + * `is_scalar_tower.subalgebra'`: if `A/S/R` is a tower and `S₀` is a subalgebra + between `S` and `R`, then `A/S₀/R` is a tower + * `subalgebra.restrict_scalars`: turn an `S`-subalgebra of `A` into an `R`-subalgebra of `A`, + given that `A/S/R` is a tower + +-/ + +open_locale pointwise +universes u v w u₁ v₁ + +variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁) (M : Type v₁) + +namespace algebra + +variables [comm_semiring R] [semiring A] [algebra R A] +variables [add_comm_monoid M] [module R M] [module A M] [is_scalar_tower R A M] + +variables {A} + +lemma lmul_algebra_map (x : R) : + algebra.lmul R A (algebra_map R A x) = algebra.lsmul R A x := +eq.symm $ linear_map.ext $ smul_def x + +end algebra + +namespace is_scalar_tower + +section semiring +variables [comm_semiring R] [comm_semiring S] [semiring A] +variables [algebra R S] [algebra S A] + +variables (R S A) + +instance subalgebra (S₀ : subalgebra R S) : is_scalar_tower S₀ S A := +of_algebra_map_eq $ λ x, rfl + +variables [algebra R A] [is_scalar_tower R S A] + +instance subalgebra' (S₀ : subalgebra R S) : is_scalar_tower R S₀ A := +@is_scalar_tower.of_algebra_map_eq R S₀ A _ _ _ _ _ _ $ λ _, +(is_scalar_tower.algebra_map_apply R S A _ : _) + +end semiring + +end is_scalar_tower + +namespace subalgebra + +open is_scalar_tower + +section semiring + +variables (R) {S A B} [comm_semiring R] [comm_semiring S] [semiring A] [semiring B] +variables [algebra R S] [algebra S A] [algebra R A] [algebra S B] [algebra R B] +variables [is_scalar_tower R S A] [is_scalar_tower R S B] + +/-- Given a tower `A / ↥U / S / R` of algebras, where `U` is an `S`-subalgebra of `A`, reinterpret +`U` as an `R`-subalgebra of `A`. -/ +def restrict_scalars (U : subalgebra S A) : subalgebra R A := +{ algebra_map_mem' := λ x, by { rw algebra_map_apply R S A, exact U.algebra_map_mem _ }, + .. U } + +@[simp] lemma coe_restrict_scalars {U : subalgebra S A} : + (restrict_scalars R U : set A) = (U : set A) := rfl + +@[simp] lemma restrict_scalars_top : restrict_scalars R (⊤ : subalgebra S A) = ⊤ := +set_like.coe_injective rfl + +@[simp] lemma restrict_scalars_to_submodule {U : subalgebra S A} : + (U.restrict_scalars R).to_submodule = U.to_submodule.restrict_scalars R := +set_like.coe_injective rfl + +@[simp] lemma mem_restrict_scalars {U : subalgebra S A} {x : A} : + x ∈ restrict_scalars R U ↔ x ∈ U := iff.rfl + +lemma restrict_scalars_injective : + function.injective (restrict_scalars R : subalgebra S A → subalgebra R A) := +λ U V H, ext $ λ x, by rw [← mem_restrict_scalars R, H, mem_restrict_scalars] + +/-- Produces an `R`-algebra map from `U.restrict_scalars R` given an `S`-algebra map from `U`. + +This is a special case of `alg_hom.restrict_scalars` that can be helpful in elaboration. -/ +@[simp] +def of_restrict_scalars (U : subalgebra S A) (f : U →ₐ[S] B) : U.restrict_scalars R →ₐ[R] B := +f.restrict_scalars R + +end semiring + +end subalgebra + +namespace is_scalar_tower + +open subalgebra + +variables [comm_semiring R] [comm_semiring S] [comm_semiring A] +variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A] + +theorem adjoin_range_to_alg_hom (t : set A) : + (algebra.adjoin (to_alg_hom R S A).range t).restrict_scalars R = + (algebra.adjoin S t).restrict_scalars R := +subalgebra.ext $ λ z, +show z ∈ subsemiring.closure (set.range (algebra_map (to_alg_hom R S A).range A) ∪ t : set A) ↔ + z ∈ subsemiring.closure (set.range (algebra_map S A) ∪ t : set A), +from suffices set.range (algebra_map (to_alg_hom R S A).range A) = set.range (algebra_map S A), + by rw this, +by { ext z, exact ⟨λ ⟨⟨x, y, h1⟩, h2⟩, ⟨y, h2 ▸ h1⟩, λ ⟨y, hy⟩, ⟨⟨z, y, hy⟩, rfl⟩⟩ } + +end is_scalar_tower diff --git a/src/algebra/algebra/tower.lean b/src/algebra/algebra/tower.lean index fdbf486098571..bbc8bc168af95 100644 --- a/src/algebra/algebra/tower.lean +++ b/src/algebra/algebra/tower.lean @@ -1,15 +1,18 @@ /- Copyright (c) 2020 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kenny Lau +Authors: Kenny Lau, Anne Baanen -/ -import algebra.algebra.subalgebra.basic -import algebra.algebra.bilinear +import algebra.algebra.equiv +import linear_algebra.span /-! # Towers of algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove basic facts about towers of algebra. An algebra tower A/S/R is expressed by having instances of `algebra A S`, @@ -47,10 +50,6 @@ def lsmul : A →ₐ[R] module.End R M := @[simp] lemma lsmul_coe (a : A) : (lsmul R M a : M → M) = (•) a := rfl -lemma lmul_algebra_map (x : R) : - lmul R A (algebra_map R A x) = algebra.lsmul R A x := -eq.symm $ linear_map.ext $ smul_def x - end algebra namespace is_scalar_tower @@ -58,7 +57,7 @@ namespace is_scalar_tower section module variables [comm_semiring R] [semiring A] [algebra R A] -variables [has_scalar R M] [mul_action A M] [is_scalar_tower R A M] +variables [has_smul R M] [mul_action A M] [is_scalar_tower R A M] variables {R} (A) {M} theorem algebra_map_smul (r : R) (x : M) : algebra_map R A r • x = r • x := @@ -84,9 +83,6 @@ of_algebra_map_eq $ ring_hom.ext_iff.1 h variables (R S A) -instance subalgebra (S₀ : subalgebra R S) : is_scalar_tower S₀ S A := -of_algebra_map_eq $ λ x, rfl - variables [algebra R A] [algebra R B] variables [is_scalar_tower R S A] [is_scalar_tower R S B] @@ -98,10 +94,6 @@ ring_hom.ext $ λ x, by simp_rw [ring_hom.comp_apply, algebra.algebra_map_eq_smu theorem algebra_map_apply (x : R) : algebra_map R A x = algebra_map S A (algebra_map R S x) := by rw [algebra_map_eq R S A, ring_hom.comp_apply] -instance subalgebra' (S₀ : subalgebra R S) : is_scalar_tower R S₀ A := -@is_scalar_tower.of_algebra_map_eq R S₀ A _ _ _ _ _ _ $ λ _, -(is_scalar_tower.algebra_map_apply R S A _ : _) - @[ext] lemma algebra.ext {S : Type u} {A : Type v} [comm_semiring S] [semiring A] (h1 h2 : algebra S A) (h : ∀ (r : S) (x : A), (by haveI := h1; exact r • x) = r • x) : h1 = h2 := algebra.algebra_ext _ _ $ λ r, by @@ -142,7 +134,7 @@ of_algebra_map_eq $ λ x, rfl @[nolint instance_priority] instance of_ring_hom {R A B : Type*} [comm_semiring R] [comm_semiring A] [comm_semiring B] [algebra R A] [algebra R B] (f : A →ₐ[R] B) : - @is_scalar_tower R A B _ (f.to_ring_hom.to_algebra.to_has_scalar) _ := + @is_scalar_tower R A B _ (f.to_ring_hom.to_algebra.to_has_smul) _ := by { letI := (f : A →+* B).to_algebra, exact of_algebra_map_eq (λ x, (f.commutes x).symm) } end semiring @@ -202,95 +194,29 @@ end alg_equiv end homs -namespace subalgebra - -open is_scalar_tower - -section semiring - -variables (R) {S A B} [comm_semiring R] [comm_semiring S] [semiring A] [semiring B] -variables [algebra R S] [algebra S A] [algebra R A] [algebra S B] [algebra R B] -variables [is_scalar_tower R S A] [is_scalar_tower R S B] - -/-- Given a scalar tower `R`, `S`, `A` of algebras, reinterpret an `S`-subalgebra of `A` an as an -`R`-subalgebra. -/ -def restrict_scalars (U : subalgebra S A) : subalgebra R A := -{ algebra_map_mem' := λ x, by { rw algebra_map_apply R S A, exact U.algebra_map_mem _ }, - .. U } - -@[simp] lemma coe_restrict_scalars {U : subalgebra S A} : - (restrict_scalars R U : set A) = (U : set A) := rfl - -@[simp] lemma restrict_scalars_top : restrict_scalars R (⊤ : subalgebra S A) = ⊤ := -set_like.coe_injective rfl - -@[simp] lemma restrict_scalars_to_submodule {U : subalgebra S A} : - (U.restrict_scalars R).to_submodule = U.to_submodule.restrict_scalars R := -set_like.coe_injective rfl - -@[simp] lemma mem_restrict_scalars {U : subalgebra S A} {x : A} : - x ∈ restrict_scalars R U ↔ x ∈ U := iff.rfl - -lemma restrict_scalars_injective : - function.injective (restrict_scalars R : subalgebra S A → subalgebra R A) := -λ U V H, ext $ λ x, by rw [← mem_restrict_scalars R, H, mem_restrict_scalars] - -/-- Produces an `R`-algebra map from `U.restrict_scalars R` given an `S`-algebra map from `U`. - -This is a special case of `alg_hom.restrict_scalars` that can be helpful in elaboration. -/ -@[simp] -def of_restrict_scalars (U : subalgebra S A) (f : U →ₐ[S] B) : U.restrict_scalars R →ₐ[R] B := -f.restrict_scalars R - -end semiring - -end subalgebra - -namespace algebra +namespace submodule -variables {R A} [comm_semiring R] [semiring A] [algebra R A] -variables {M} [add_comm_monoid M] [module A M] [module R M] [is_scalar_tower R A M] +variables (R A) {M} +variables [comm_semiring R] [semiring A] [algebra R A] [add_comm_monoid M] +variables [module R M] [module A M] [is_scalar_tower R A M] -lemma span_restrict_scalars_eq_span_of_surjective - (h : function.surjective (algebra_map R A)) (s : set M) : - (submodule.span A s).restrict_scalars R = submodule.span R s := +/-- If `A` is an `R`-algebra such that the induced morphism `R →+* A` is surjective, then the +`R`-module generated by a set `X` equals the `A`-module generated by `X`. -/ +lemma restrict_scalars_span (hsur : function.surjective (algebra_map R A)) (X : set M) : + restrict_scalars R (span A X) = span R X := begin - refine le_antisymm (λ x hx, _) (submodule.span_subset_span _ _ _), - refine submodule.span_induction hx _ _ _ _, - { exact λ x hx, submodule.subset_span hx }, - { exact submodule.zero_mem _ }, - { exact λ x y, submodule.add_mem _ }, - { intros c x hx, - obtain ⟨c', rfl⟩ := h c, - rw is_scalar_tower.algebra_map_smul, - exact submodule.smul_mem _ _ hx }, + refine ((span_le_restrict_scalars R A X).antisymm (λ m hm, _)).symm, + refine span_induction hm subset_span (zero_mem _) (λ _ _, add_mem) (λ a m hm, _), + obtain ⟨r, rfl⟩ := hsur a, + simpa [algebra_map_smul] using smul_mem _ r hm end lemma coe_span_eq_span_of_surjective (h : function.surjective (algebra_map R A)) (s : set M) : (submodule.span A s : set M) = submodule.span R s := -congr_arg coe (algebra.span_restrict_scalars_eq_span_of_surjective h s) +congr_arg coe (submodule.restrict_scalars_span R A h s) -end algebra - -namespace is_scalar_tower - -open subalgebra - -variables [comm_semiring R] [comm_semiring S] [comm_semiring A] -variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A] - -theorem adjoin_range_to_alg_hom (t : set A) : - (algebra.adjoin (to_alg_hom R S A).range t).restrict_scalars R = - (algebra.adjoin S t).restrict_scalars R := -subalgebra.ext $ λ z, -show z ∈ subsemiring.closure (set.range (algebra_map (to_alg_hom R S A).range A) ∪ t : set A) ↔ - z ∈ subsemiring.closure (set.range (algebra_map S A) ∪ t : set A), -from suffices set.range (algebra_map (to_alg_hom R S A).range A) = set.range (algebra_map S A), - by rw this, -by { ext z, exact ⟨λ ⟨⟨x, y, h1⟩, h2⟩, ⟨y, h2 ▸ h1⟩, λ ⟨y, hy⟩, ⟨⟨z, y, hy⟩, rfl⟩⟩ } - -end is_scalar_tower +end submodule section semiring @@ -331,7 +257,7 @@ span_induction hx (λ x hx, let ⟨p, q, hp, hq, hpq⟩ := set.mem_smul.1 hx in (λ x y ihx ihy, by { rw smul_add, exact add_mem ihx ihy }) (λ c x hx, smul_comm c k x ▸ smul_mem _ _ hx) -theorem span_smul {s : set S} (hs : span R s = ⊤) (t : set A) : +theorem span_smul_of_span_eq_top {s : set S} (hs : span R s = ⊤) (t : set A) : span R (s • t) = (span S t).restrict_scalars R := le_antisymm (span_le.2 $ λ x hx, let ⟨p, q, hps, hqt, hpqx⟩ := set.mem_smul.1 hx in hpqx ▸ (span S t).smul_mem p (subset_span hqt)) $ diff --git a/src/algebra/algebra/unitization.lean b/src/algebra/algebra/unitization.lean index b21beee7f5a81..a789b95747b4b 100644 --- a/src/algebra/algebra/unitization.lean +++ b/src/algebra/algebra/unitization.lean @@ -11,6 +11,9 @@ import algebra.hom.non_unital_alg /-! # Unitization of a non-unital algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a non-unital `R`-algebra `A` (given via the type classes `[non_unital_ring A] [module R A] [smul_comm_class R A A] [is_scalar_tower R A A]`) we construct the minimal unital `R`-algebra containing `A` as an ideal. This object `algebra.unitization R A` is @@ -137,18 +140,18 @@ prod.add_comm_monoid instance [add_comm_group R] [add_comm_group A] : add_comm_group (unitization R A) := prod.add_comm_group -instance [has_scalar S R] [has_scalar S A] : has_scalar S (unitization R A) := -prod.has_scalar +instance [has_smul S R] [has_smul S A] : has_smul S (unitization R A) := +prod.has_smul -instance [has_scalar T R] [has_scalar T A] [has_scalar S R] [has_scalar S A] [has_scalar T S] +instance [has_smul T R] [has_smul T A] [has_smul S R] [has_smul S A] [has_smul T S] [is_scalar_tower T S R] [is_scalar_tower T S A] : is_scalar_tower T S (unitization R A) := prod.is_scalar_tower -instance [has_scalar T R] [has_scalar T A] [has_scalar S R] [has_scalar S A] +instance [has_smul T R] [has_smul T A] [has_smul S R] [has_smul S A] [smul_comm_class T S R] [smul_comm_class T S A] : smul_comm_class T S (unitization R A) := prod.smul_comm_class -instance [has_scalar S R] [has_scalar S A] [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ A] +instance [has_smul S R] [has_smul S A] [has_smul Sᵐᵒᵖ R] [has_smul Sᵐᵒᵖ A] [is_central_scalar S R] [is_central_scalar S A] : is_central_scalar S (unitization R A) := prod.is_central_scalar @@ -174,9 +177,9 @@ prod.module @[simp] lemma fst_neg [has_neg R] [has_neg A] (x : unitization R A) : (-x).fst = -x.fst := rfl @[simp] lemma snd_neg [has_neg R] [has_neg A] (x : unitization R A) : (-x).snd = -x.snd := rfl -@[simp] lemma fst_smul [has_scalar S R] [has_scalar S A] (s : S) (x : unitization R A) : +@[simp] lemma fst_smul [has_smul S R] [has_smul S A] (s : S) (x : unitization R A) : (s • x).fst = s • x.fst := rfl -@[simp] lemma snd_smul [has_scalar S R] [has_scalar S A] (s : S) (x : unitization R A) : +@[simp] lemma snd_smul [has_smul S R] [has_smul S A] (s : S) (x : unitization R A) : (s • x).snd = s • x.snd := rfl section @@ -192,7 +195,7 @@ ext rfl (add_zero 0).symm (inl (-r) : unitization R A) = -inl r := ext rfl neg_zero.symm -@[simp] lemma inl_smul [monoid S] [add_monoid A] [has_scalar S R] [distrib_mul_action S A] +@[simp] lemma inl_smul [monoid S] [add_monoid A] [has_smul S R] [distrib_mul_action S A] (s : S) (r : R) : (inl (s • r) : unitization R A) = s • inl r := ext rfl (smul_zero s).symm @@ -211,9 +214,9 @@ ext (add_zero 0).symm rfl (↑(-m) : unitization R A) = -m := ext neg_zero.symm rfl -@[simp] lemma coe_smul [has_zero R] [has_zero S] [smul_with_zero S R] [has_scalar S A] +@[simp] lemma coe_smul [has_zero R] [has_zero S] [smul_with_zero S R] [has_smul S A] (r : S) (m : A) : (↑(r • m) : unitization R A) = r • m := -ext (smul_zero' _ _).symm rfl +ext (smul_zero _).symm rfl end @@ -259,15 +262,15 @@ variables {R A : Type*} instance [has_one R] [has_zero A] : has_one (unitization R A) := ⟨(1, 0)⟩ -instance [has_mul R] [has_add A] [has_mul A] [has_scalar R A] : has_mul (unitization R A) := +instance [has_mul R] [has_add A] [has_mul A] [has_smul R A] : has_mul (unitization R A) := ⟨λ x y, (x.1 * y.1, x.1 • y.2 + y.1 • x.2 + x.2 * y.2)⟩ @[simp] lemma fst_one [has_one R] [has_zero A] : (1 : unitization R A).fst = 1 := rfl @[simp] lemma snd_one [has_one R] [has_zero A] : (1 : unitization R A).snd = 0 := rfl -@[simp] lemma fst_mul [has_mul R] [has_add A] [has_mul A] [has_scalar R A] +@[simp] lemma fst_mul [has_mul R] [has_add A] [has_mul A] [has_smul R A] (x₁ x₂ : unitization R A) : (x₁ * x₂).fst = x₁.fst * x₂.fst := rfl -@[simp] lemma snd_mul [has_mul R] [has_add A] [has_mul A] [has_scalar R A] +@[simp] lemma snd_mul [has_mul R] [has_add A] [has_mul A] [has_smul R A] (x₁ x₂ : unitization R A) : (x₁ * x₂).snd = x₁.fst • x₂.snd + x₂.fst • x₁.snd + x₁.snd * x₂.snd := rfl @@ -345,9 +348,8 @@ instance [comm_monoid R] [non_unital_semiring A] [distrib_mul_action R A] [is_sc abel }, ..unitization.mul_one_class } --- This should work for `non_unital_comm_semiring`s, but we don't seem to have those -instance [comm_monoid R] [comm_semiring A] [distrib_mul_action R A] [is_scalar_tower R A A] - [smul_comm_class R A A] : comm_monoid (unitization R A) := +instance [comm_monoid R] [non_unital_comm_semiring A] [distrib_mul_action R A] + [is_scalar_tower R A A] [smul_comm_class R A A] : comm_monoid (unitization R A) := { mul_comm := λ x₁ x₂, ext (mul_comm x₁.1 x₂.1) $ show x₁.1 • x₂.2 + x₂.1 • x₁.2 + x₁.2 * x₂.2 = x₂.1 • x₁.2 + x₁.1 • x₂.2 + x₂.2 * x₁.2, by rw [add_comm (x₁.1 • x₂.2), mul_comm], @@ -358,8 +360,7 @@ instance [comm_semiring R] [non_unital_semiring A] [module R A] [is_scalar_tower { ..unitization.monoid, ..unitization.non_assoc_semiring } --- This should work for `non_unital_comm_semiring`s, but we don't seem to have those -instance [comm_semiring R] [comm_semiring A] [module R A] [is_scalar_tower R A A] +instance [comm_semiring R] [non_unital_comm_semiring A] [module R A] [is_scalar_tower R A A] [smul_comm_class R A A] : comm_semiring (unitization R A) := { ..unitization.comm_monoid, ..unitization.non_assoc_semiring } diff --git a/src/algebra/algebraic_card.lean b/src/algebra/algebraic_card.lean index cf43779263e5d..1d88761edeca9 100644 --- a/src/algebra/algebraic_card.lean +++ b/src/algebra/algebraic_card.lean @@ -10,8 +10,11 @@ import ring_theory.algebraic /-! ### Cardinality of algebraic numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove variants of the following result: the cardinality of algebraic numbers under -an R-algebra is at most `# polynomial R * ω`. +an R-algebra is at most `# R[X] * ℵ₀`. Although this can be used to prove that real or complex transcendental numbers exist, a more direct proof is given by `liouville.is_transcendental`. @@ -19,15 +22,18 @@ proof is given by `liouville.is_transcendental`. universes u v -open cardinal polynomial -open_locale cardinal +open cardinal polynomial set +open_locale cardinal polynomial namespace algebraic -theorem omega_le_cardinal_mk_of_char_zero (R A : Type*) [comm_ring R] [is_domain R] - [ring A] [algebra R A] [char_zero A] : ω ≤ #{x : A | is_algebraic R x} := -@mk_le_of_injective (ulift ℕ) {x : A | is_algebraic R x} (λ n, ⟨_, is_algebraic_nat n.down⟩) - (λ m n hmn, by simpa using hmn) +lemma infinite_of_char_zero (R A : Type*) [comm_ring R] [is_domain R] + [ring A] [algebra R A] [char_zero A] : {x : A | is_algebraic R x}.infinite := +infinite_of_injective_forall_mem nat.cast_injective is_algebraic_nat + +theorem aleph_0_le_cardinal_mk_of_char_zero (R A : Type*) [comm_ring R] [is_domain R] + [ring A] [algebra R A] [char_zero A] : ℵ₀ ≤ #{x : A // is_algebraic R x} := +infinite_iff.1 (set.infinite_coe_iff.2 $ infinite_of_char_zero R A) section lift @@ -35,52 +41,41 @@ variables (R : Type u) (A : Type v) [comm_ring R] [comm_ring A] [is_domain A] [a [no_zero_smul_divisors R A] theorem cardinal_mk_lift_le_mul : - cardinal.lift.{u v} (#{x : A | is_algebraic R x}) ≤ cardinal.lift.{v u} (#(polynomial R)) * ω := + cardinal.lift.{u} (#{x : A // is_algebraic R x}) ≤ cardinal.lift.{v} #(R[X]) * ℵ₀ := begin rw [←mk_ulift, ←mk_ulift], - let g : ulift.{u} {x : A | is_algebraic R x} → ulift.{v} (polynomial R) := - λ x, ulift.up (classical.some x.1.2), - apply cardinal.mk_le_mk_mul_of_mk_preimage_le g (λ f, _), - suffices : fintype (g ⁻¹' {f}), - { exact @mk_le_omega _ (@fintype.to_encodable _ this) }, - by_cases hf : f.1 = 0, - { convert set.fintype_empty, - apply set.eq_empty_iff_forall_not_mem.2 (λ x hx, _), - simp only [set.mem_preimage, set.mem_singleton_iff] at hx, - apply_fun ulift.down at hx, - rw hf at hx, - exact (classical.some_spec x.1.2).1 hx }, - let h : g ⁻¹' {f} → f.down.root_set A := λ x, ⟨x.1.1.1, (mem_root_set_iff hf x.1.1.1).2 begin - have key' : g x = f := x.2, - simp_rw ← key', - exact (classical.some_spec x.1.1.2).2 - end⟩, - apply fintype.of_injective h (λ _ _ H, _), - simp only [subtype.val_eq_coe, subtype.mk_eq_mk] at H, - exact subtype.ext (ulift.down_injective (subtype.ext H)) + choose g hg₁ hg₂ using λ x : {x : A | is_algebraic R x}, x.coe_prop, + refine lift_mk_le_lift_mk_mul_of_lift_mk_preimage_le g (λ f, _), + rw [lift_le_aleph_0, le_aleph_0_iff_set_countable], + suffices : maps_to coe (g ⁻¹' {f}) (f.root_set A), + from this.countable_of_inj_on (subtype.coe_injective.inj_on _) (f.root_set_finite A).countable, + rintro x (rfl : g x = f), + exact mem_root_set.2 ⟨hg₁ x, hg₂ x⟩ end theorem cardinal_mk_lift_le_max : - cardinal.lift.{u v} (#{x : A | is_algebraic R x}) ≤ max (cardinal.lift.{v u} (#R)) ω := + cardinal.lift.{u} (#{x : A // is_algebraic R x}) ≤ max (cardinal.lift.{v} (#R)) ℵ₀ := (cardinal_mk_lift_le_mul R A).trans $ - (mul_le_mul_right' (lift_le.2 cardinal_mk_le_max) _).trans $ by simp [le_total] + (mul_le_mul_right' (lift_le.2 cardinal_mk_le_max) _).trans $ by simp -theorem cardinal_mk_lift_le_of_infinite [infinite R] : - cardinal.lift.{u v} (#{x : A | is_algebraic R x}) ≤ cardinal.lift.{v u} (#R) := -(cardinal_mk_lift_le_max R A).trans $ by simp +@[simp] lemma cardinal_mk_lift_of_infinite [infinite R] : + cardinal.lift.{u} (#{x : A // is_algebraic R x}) = cardinal.lift.{v} (#R) := +((cardinal_mk_lift_le_max R A).trans_eq (max_eq_left $ aleph_0_le_mk _)).antisymm $ + lift_mk_le'.2 ⟨⟨λ x, ⟨algebra_map R A x, is_algebraic_algebra_map _⟩, + λ x y h, no_zero_smul_divisors.algebra_map_injective R A (subtype.ext_iff.1 h)⟩⟩ -variable [encodable R] +variable [countable R] -@[simp] theorem countable_of_encodable : set.countable {x : A | is_algebraic R x} := +@[simp] protected theorem countable : set.countable {x : A | is_algebraic R x} := begin - rw [←mk_set_le_omega, ←lift_le], + rw [←le_aleph_0_iff_set_countable, ←lift_le], apply (cardinal_mk_lift_le_max R A).trans, simp end -@[simp] theorem cardinal_mk_of_encodable_of_char_zero [char_zero A] [is_domain R] : - #{x : A | is_algebraic R x} = ω := -le_antisymm (by simp) (omega_le_cardinal_mk_of_char_zero R A) +@[simp] theorem cardinal_mk_of_countble_of_char_zero [char_zero A] [is_domain R] : + #{x : A // is_algebraic R x} = ℵ₀ := +(algebraic.countable R A).le_aleph_0.antisymm (aleph_0_le_cardinal_mk_of_char_zero R A) end lift @@ -89,14 +84,14 @@ section non_lift variables (R A : Type u) [comm_ring R] [comm_ring A] [is_domain A] [algebra R A] [no_zero_smul_divisors R A] -theorem cardinal_mk_le_mul : #{x : A | is_algebraic R x} ≤ #(polynomial R) * ω := -by { rw [←lift_id (#_), ←lift_id (#(polynomial R))], exact cardinal_mk_lift_le_mul R A } +theorem cardinal_mk_le_mul : #{x : A // is_algebraic R x} ≤ #R[X] * ℵ₀ := +by { rw [←lift_id (#_), ←lift_id #R[X]], exact cardinal_mk_lift_le_mul R A } -theorem cardinal_mk_le_max : #{x : A | is_algebraic R x} ≤ max (#R) ω := +theorem cardinal_mk_le_max : #{x : A // is_algebraic R x} ≤ max (#R) ℵ₀ := by { rw [←lift_id (#_), ←lift_id (#R)], exact cardinal_mk_lift_le_max R A } -theorem cardinal_mk_le_of_infinite [infinite R] : #{x : A | is_algebraic R x} ≤ #R := -(cardinal_mk_le_max R A).trans $ by simp +@[simp] theorem cardinal_mk_of_infinite [infinite R] : #{x : A // is_algebraic R x} = #R := +lift_inj.1 $ cardinal_mk_lift_of_infinite R A end non_lift diff --git a/src/algebra/associated.lean b/src/algebra/associated.lean index f4482b0afc7b0..a77742482a09d 100644 --- a/src/algebra/associated.lean +++ b/src/algebra/associated.lean @@ -3,13 +3,15 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Jens Wagemaker -/ -import algebra.divisibility +import algebra.divisibility.basic import algebra.group_power.lemmas -import algebra.invertible -import order.atoms +import algebra.parity /-! # Associated, prime, and irreducible elements. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} @@ -128,26 +130,38 @@ begin exact dvd_mul_right _ _, end +lemma prime_pow_succ_dvd_mul {α : Type*} [cancel_comm_monoid_with_zero α] + {p x y : α} (h : prime p) {i : ℕ} (hxy : p ^ (i + 1) ∣ x * y) : + p ^ (i + 1) ∣ x ∨ p ∣ y := +begin + rw or_iff_not_imp_right, + intro hy, + induction i with i ih generalizing x, + { simp only [zero_add, pow_one] at *, + exact (h.dvd_or_dvd hxy).resolve_right hy }, + rw pow_succ at hxy ⊢, + obtain ⟨x', rfl⟩ := (h.dvd_or_dvd (dvd_of_mul_right_dvd hxy)).resolve_right hy, + rw mul_assoc at hxy, + exact mul_dvd_mul_left p (ih ((mul_dvd_mul_iff_left h.ne_zero).mp hxy)), +end + /-- `irreducible p` states that `p` is non-unit and only factors into units. We explicitly avoid stating that `p` is non-zero, this would require a semiring. Assuming only a monoid allows us to reuse irreducible for associated elements. -/ -class irreducible [monoid α] (p : α) : Prop := -(not_unit' : ¬ is_unit p) +structure irreducible [monoid α] (p : α) : Prop := +(not_unit : ¬ is_unit p) (is_unit_or_is_unit' : ∀a b, p = a * b → is_unit a ∨ is_unit b) namespace irreducible -lemma not_unit [monoid α] {p : α} (hp : irreducible p) : ¬ is_unit p := -hp.1 - lemma not_dvd_one [comm_monoid α] {p : α} (hp : irreducible p) : ¬ p ∣ 1 := mt (is_unit_of_dvd_one _) hp.not_unit lemma is_unit_or_is_unit [monoid α] {p : α} (hp : irreducible p) {a b : α} (h : p = a * b) : is_unit a ∨ is_unit b := -irreducible.is_unit_or_is_unit' a b h +hp.is_unit_or_is_unit' a b h end irreducible @@ -176,11 +190,11 @@ theorem of_irreducible_pow {α} [monoid α] {x : α} {n : ℕ} (hn : n ≠ 1) : irreducible (x ^ n) → is_unit x := begin obtain hn|hn := hn.lt_or_lt, - { simp only [nat.lt_one_iff.mp hn, forall_false_left, not_irreducible_one, pow_zero] }, + { simp only [nat.lt_one_iff.mp hn, is_empty.forall_iff, not_irreducible_one, pow_zero] }, intro h, obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_lt hn, rw [pow_succ, add_comm] at h, - exact (or_iff_left_of_imp ((is_unit_pos_pow_iff (nat.succ_pos _)).mp)).mp (of_irreducible_mul h) + exact (or_iff_left_of_imp is_unit_pow_succ_iff.mp).mp (of_irreducible_mul h) end theorem irreducible_or_factor {α} [monoid α] (x : α) (h : ¬ is_unit x) : @@ -194,29 +208,6 @@ begin exact H _ o.1 _ o.2 h.symm end -protected lemma prime.irreducible [cancel_comm_monoid_with_zero α] {p : α} (hp : prime p) : - irreducible p := -⟨hp.not_unit, λ a b hab, - (show a * b ∣ a ∨ a * b ∣ b, from hab ▸ hp.dvd_or_dvd (hab ▸ dvd_rfl)).elim - (λ ⟨x, hx⟩, or.inr (is_unit_iff_dvd_one.2 - ⟨x, mul_right_cancel₀ (show a ≠ 0, from λ h, by simp [*, prime] at *) - $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩)) - (λ ⟨x, hx⟩, or.inl (is_unit_iff_dvd_one.2 - ⟨x, mul_right_cancel₀ (show b ≠ 0, from λ h, by simp [*, prime] at *) - $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩))⟩ - -lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul [cancel_comm_monoid_with_zero α] - {p : α} (hp : prime p) {a b : α} {k l : ℕ} : - p ^ k ∣ a → p ^ l ∣ b → p ^ ((k + l) + 1) ∣ a * b → p ^ (k + 1) ∣ a ∨ p ^ (l + 1) ∣ b := -λ ⟨x, hx⟩ ⟨y, hy⟩ ⟨z, hz⟩, -have h : p ^ (k + l) * (x * y) = p ^ (k + l) * (p * z), - by simpa [mul_comm, pow_add, hx, hy, mul_assoc, mul_left_comm] using hz, -have hp0: p ^ (k + l) ≠ 0, from pow_ne_zero _ hp.ne_zero, -have hpd : p ∣ x * y, from ⟨z, by rwa [mul_right_inj' hp0] at h⟩, -(hp.dvd_or_dvd hpd).elim - (λ ⟨d, hd⟩, or.inl ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩) - (λ ⟨d, hd⟩, or.inr ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩) - /-- If `p` and `q` are irreducible, then `p ∣ q` implies `q ∣ p`. -/ lemma irreducible.dvd_symm [monoid α] {p q : α} (hp : irreducible p) (hq : irreducible q) : p ∣ q → q ∣ p := @@ -276,10 +267,48 @@ end end -lemma pow_not_prime [cancel_comm_monoid_with_zero α] {x : α} {n : ℕ} (hn : n ≠ 1) : - ¬ prime (x ^ n) := +section comm_monoid +variables [comm_monoid α] {a : α} + +lemma irreducible.not_square (ha : irreducible a) : ¬ is_square a := +by { rintro ⟨b, rfl⟩, simp only [irreducible_mul_iff, or_self] at ha, exact ha.1.not_unit ha.2 } + +lemma is_square.not_irreducible (ha : is_square a) : ¬ irreducible a := λ h, h.not_square ha + +end comm_monoid + +section cancel_comm_monoid_with_zero +variables [cancel_comm_monoid_with_zero α] {a p : α} + +protected lemma prime.irreducible (hp : prime p) : irreducible p := +⟨hp.not_unit, λ a b hab, + (show a * b ∣ a ∨ a * b ∣ b, from hab ▸ hp.dvd_or_dvd (hab ▸ dvd_rfl)).elim + (λ ⟨x, hx⟩, or.inr (is_unit_iff_dvd_one.2 + ⟨x, mul_right_cancel₀ (show a ≠ 0, from λ h, by simp [*, prime] at *) + $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩)) + (λ ⟨x, hx⟩, or.inl (is_unit_iff_dvd_one.2 + ⟨x, mul_right_cancel₀ (show b ≠ 0, from λ h, by simp [*, prime] at *) + $ by conv {to_lhs, rw hx}; simp [mul_comm, mul_assoc, mul_left_comm]⟩))⟩ + +lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul (hp : prime p) {a b : α} {k l : ℕ} : + p ^ k ∣ a → p ^ l ∣ b → p ^ ((k + l) + 1) ∣ a * b → p ^ (k + 1) ∣ a ∨ p ^ (l + 1) ∣ b := +λ ⟨x, hx⟩ ⟨y, hy⟩ ⟨z, hz⟩, +have h : p ^ (k + l) * (x * y) = p ^ (k + l) * (p * z), + by simpa [mul_comm, pow_add, hx, hy, mul_assoc, mul_left_comm] using hz, +have hp0: p ^ (k + l) ≠ 0, from pow_ne_zero _ hp.ne_zero, +have hpd : p ∣ x * y, from ⟨z, by rwa [mul_right_inj' hp0] at h⟩, +(hp.dvd_or_dvd hpd).elim + (λ ⟨d, hd⟩, or.inl ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩) + (λ ⟨d, hd⟩, or.inr ⟨d, by simp [*, pow_succ, mul_comm, mul_left_comm, mul_assoc]⟩) + +lemma prime.not_square (hp : prime p) : ¬ is_square p := hp.irreducible.not_square +lemma is_square.not_prime (ha : is_square a) : ¬ prime a := λ h, h.not_square ha + +lemma pow_not_prime {n : ℕ} (hn : n ≠ 1) : ¬ prime (a ^ n) := λ hp, hp.not_unit $ is_unit.pow _ $ of_irreducible_pow hn $ hp.irreducible +end cancel_comm_monoid_with_zero + /-- Two elements of a `monoid` are `associated` if one of them is another one multiplied by a unit on the right. -/ def associated [monoid α] (x y : α) : Prop := ∃u:αˣ, x * u = y @@ -289,12 +318,18 @@ local infix ` ~ᵤ ` : 50 := associated namespace associated @[refl] protected theorem refl [monoid α] (x : α) : x ~ᵤ x := ⟨1, by simp⟩ +instance [monoid α] : is_refl α associated := ⟨associated.refl⟩ @[symm] protected theorem symm [monoid α] : ∀{x y : α}, x ~ᵤ y → y ~ᵤ x | x _ ⟨u, rfl⟩ := ⟨u⁻¹, by rw [mul_assoc, units.mul_inv, mul_one]⟩ +instance [monoid α] : is_symm α associated := ⟨λ a b, associated.symm⟩ + +protected theorem comm [monoid α] {x y : α} : x ~ᵤ y ↔ y ~ᵤ x := +⟨associated.symm, associated.symm⟩ @[trans] protected theorem trans [monoid α] : ∀{x y z : α}, x ~ᵤ y → y ~ᵤ z → x ~ᵤ z | x _ _ ⟨u, rfl⟩ ⟨v, rfl⟩ := ⟨u * v, by rw [units.coe_mul, mul_assoc]⟩ +instance [monoid α] : is_trans α associated := ⟨λ a b c, associated.trans⟩ /-- The setoid of the relation `x ~ᵤ y` iff there is a unit `u` such that `x * u = y` -/ protected def setoid (α : Type*) [monoid α] : setoid α := @@ -342,6 +377,45 @@ lemma associated_unit_mul_right {β : Type*} [comm_monoid β] (a u : β) (hu : i associated a (u * a) := (associated_unit_mul_left a u hu).symm +lemma associated_mul_is_unit_left_iff {β : Type*} [monoid β] {a u b : β} (hu : is_unit u) : + associated (a * u) b ↔ associated a b := +⟨trans (associated_mul_unit_right _ _ hu), trans (associated_mul_unit_left _ _ hu)⟩ + +lemma associated_is_unit_mul_left_iff {β : Type*} [comm_monoid β] {u a b : β} (hu : is_unit u) : + associated (u * a) b ↔ associated a b := +begin + rw mul_comm, + exact associated_mul_is_unit_left_iff hu +end + +lemma associated_mul_is_unit_right_iff {β : Type*} [monoid β] {a b u : β} (hu : is_unit u) : + associated a (b * u) ↔ associated a b := +associated.comm.trans $ (associated_mul_is_unit_left_iff hu).trans associated.comm + +lemma associated_is_unit_mul_right_iff {β : Type*} [comm_monoid β] {a u b : β} (hu : is_unit u) : + associated a (u * b) ↔ associated a b := +associated.comm.trans $ (associated_is_unit_mul_left_iff hu).trans associated.comm + +@[simp] +lemma associated_mul_unit_left_iff {β : Type*} [monoid β] {a b : β} {u : units β} : + associated (a * u) b ↔ associated a b := +associated_mul_is_unit_left_iff u.is_unit + +@[simp] +lemma associated_unit_mul_left_iff {β : Type*} [comm_monoid β] {a b : β} {u : units β} : + associated (↑u * a) b ↔ associated a b := +associated_is_unit_mul_left_iff u.is_unit + +@[simp] +lemma associated_mul_unit_right_iff {β : Type*} [monoid β] {a b : β} {u : units β} : + associated a (b * u) ↔ associated a b := +associated_mul_is_unit_right_iff u.is_unit + +@[simp] +lemma associated_unit_mul_right_iff {β : Type*} [comm_monoid β] {a b : β} {u : units β} : + associated a (↑u * b) ↔ associated a b := +associated_is_unit_mul_right_iff u.is_unit + lemma associated.mul_mul [comm_monoid α] {a₁ a₂ b₁ b₂ : α} : a₁ ~ᵤ b₁ → a₂ ~ᵤ b₂ → (a₁ * a₂) ~ᵤ (b₁ * b₂) | ⟨c₁, h₁⟩ ⟨c₂, h₂⟩ := ⟨c₁ * c₂, by simp [h₁.symm, h₂.symm, mul_assoc, mul_comm, mul_left_comm]⟩ @@ -479,7 +553,6 @@ lemma associated.of_pow_associated_of_prime' [cancel_comm_monoid_with_zero α] { p₁ ~ᵤ p₂ := (h.symm.of_pow_associated_of_prime hp₂ hp₁ hk₂).symm - section unique_units variables [monoid α] [unique αˣ] @@ -502,6 +575,20 @@ by rw [pp.dvd_prime_iff_associated qp, ←associated_eq_eq] end unique_units +section unique_units₀ + +variables {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R} {k₁ k₂ : ℕ} + +lemma eq_of_prime_pow_eq (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₁) (h : p₁ ^ k₁ = p₂ ^ k₂) : + p₁ = p₂ := +by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime hp₁ hp₂ hk₁ } + +lemma eq_of_prime_pow_eq' (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₂) (h : p₁ ^ k₁ = p₂ ^ k₂) : + p₁ = p₂ := +by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime' hp₁ hp₂ hk₁ } + +end unique_units₀ + /-- The quotient of a monoid by the `associated` relation. Two elements `x` and `y` are associated iff there is a unit `u` such that `x * u = y`. There is a natural monoid structure on `associates α`. -/ @@ -805,22 +892,19 @@ instance : no_zero_divisors (associates α) := have a = 0 ∨ b = 0, from mul_eq_zero.1 this, this.imp (assume h, h.symm ▸ rfl) (assume h, h.symm ▸ rfl))⟩ -lemma eq_of_mul_eq_mul_left : - ∀(a b c : associates α), a ≠ 0 → a * b = a * c → b = c := -begin - rintros ⟨a⟩ ⟨b⟩ ⟨c⟩ ha h, - rcases quotient.exact' h with ⟨u, hu⟩, - have hu : a * (b * ↑u) = a * c, { rwa [← mul_assoc] }, - exact quotient.sound' ⟨u, mul_left_cancel₀ (mk_ne_zero.1 ha) hu⟩ -end - -lemma eq_of_mul_eq_mul_right : - ∀(a b c : associates α), b ≠ 0 → a * b = c * b → a = c := -λ a b c bne0, (mul_comm b a) ▸ (mul_comm b c) ▸ (eq_of_mul_eq_mul_left b a c bne0) +instance : cancel_comm_monoid_with_zero (associates α) := +{ mul_left_cancel_of_ne_zero := + begin + rintros ⟨a⟩ ⟨b⟩ ⟨c⟩ ha h, + rcases quotient.exact' h with ⟨u, hu⟩, + rw [mul_assoc] at hu, + exact quotient.sound' ⟨u, mul_left_cancel₀ (mk_ne_zero.1 ha) hu⟩ + end, + .. (infer_instance : comm_monoid_with_zero (associates α)) } lemma le_of_mul_le_mul_left (a b c : associates α) (ha : a ≠ 0) : a * b ≤ a * c → b ≤ c -| ⟨d, hd⟩ := ⟨d, eq_of_mul_eq_mul_left a _ _ ha $ by rwa ← mul_assoc⟩ +| ⟨d, hd⟩ := ⟨d, mul_left_cancel₀ ha $ by rwa ← mul_assoc⟩ lemma one_or_eq_of_le_of_prime : ∀(p m : associates α), prime p → m ≤ p → (m = 1 ∨ m = p) @@ -838,13 +922,9 @@ match h m d dvd_rfl with or.inl $ bot_unique $ associates.le_of_mul_le_mul_left d m 1 ‹d ≠ 0› this end -instance : cancel_comm_monoid_with_zero (associates α) := -{ mul_left_cancel_of_ne_zero := eq_of_mul_eq_mul_left, - mul_right_cancel_of_ne_zero := eq_of_mul_eq_mul_right, - .. (infer_instance : comm_monoid_with_zero (associates α)) } - instance : canonically_ordered_monoid (associates α) := -{ le_iff_exists_mul := λ a b, iff.rfl, +{ exists_mul_of_le := λ a b, id, + le_self_mul := λ a b, ⟨b, rfl⟩, ..associates.cancel_comm_monoid_with_zero, ..associates.bounded_order, ..associates.ordered_comm_monoid} @@ -901,19 +981,6 @@ begin rwa [← mul_assoc, mul_one], end -lemma associates.is_atom_iff [cancel_comm_monoid_with_zero α] {p : associates α} (h₁ : p ≠ 0) : - is_atom p ↔ irreducible p := -⟨λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one] using hp.1, - λ a b h, (eq_bot_or_eq_of_le_atom hp ⟨_, h⟩).cases_on - (λ ha, or.inl (a.is_unit_iff_eq_one.mpr ha)) - (λ ha, or.inr (show is_unit b, by {rw ha at h, apply is_unit_of_associated_mul - (show associated (p * b) p, by conv_rhs {rw h}) h₁ }))⟩, - λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one, associates.bot_eq_one] using hp.1, - λ b ⟨⟨a, hab⟩, hb⟩, (hp.is_unit_or_is_unit hab).cases_on - (λ hb, show b = ⊥, by rwa [associates.is_unit_iff_eq_one, ← associates.bot_eq_one] at hb) - (λ ha, absurd (show p ∣ b, from ⟨(ha.unit⁻¹ : units _), by simp [hab]; rw mul_assoc; - rw is_unit.mul_coe_inv ha; rw mul_one⟩) hb)⟩⟩ - lemma dvd_not_unit.not_associated [cancel_comm_monoid_with_zero α] {p q : α} (h : dvd_not_unit p q) : ¬ associated p q := begin @@ -958,3 +1025,5 @@ begin end end cancel_comm_monoid_with_zero + +assert_not_exists multiset diff --git a/src/algebra/big_operators/associated.lean b/src/algebra/big_operators/associated.lean index 206c06a55e4ae..49c80173ad268 100644 --- a/src/algebra/big_operators/associated.lean +++ b/src/algebra/big_operators/associated.lean @@ -5,12 +5,14 @@ Authors: Johannes Hölzl, Jens Wagemaker, Anne Baanen -/ import algebra.associated -import algebra.big_operators.basic -import data.finsupp.basic +import algebra.big_operators.finsupp /-! # Products of associated, prime, and irreducible elements. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains some theorems relating definitions in `algebra.associated` and products of multisets, finsets, and finsupps. @@ -55,11 +57,8 @@ multiset.induction_on s (by simp [mt is_unit_iff_dvd_one.2 hp.not_unit]) (λ a s ih hs hps, begin rw [multiset.prod_cons] at hps, cases hp.dvd_or_dvd hps with h h, - { use [a, by simp], - cases h with u hu, - cases (((hs a (multiset.mem_cons.2 (or.inl rfl))).irreducible) - .is_unit_or_is_unit hu).resolve_left hp.not_unit with v hv, - exact ⟨v, by simp [hu, hv]⟩ }, + { have hap := hs a (multiset.mem_cons.2 (or.inl rfl)), + exact ⟨a, multiset.mem_cons_self a _, hp.associated_of_dvd hap h⟩ }, { rcases ih (λ r hr, hs _ (multiset.mem_cons.2 (or.inr hr))) h with ⟨q, hq₁, hq₂⟩, exact ⟨q, multiset.mem_cons.2 (or.inr hq₁), hq₂⟩ } end) @@ -110,7 +109,11 @@ section comm_monoid variables [comm_monoid α] theorem prod_mk {p : multiset α} : (p.map associates.mk).prod = associates.mk p.prod := -multiset.induction_on p (by simp; refl) $ assume a s ih, by simp [ih]; refl +multiset.induction_on p (by simp) $ λ a s ih, by simp [ih, associates.mk_mul_mk] + +theorem finset_prod_mk {p : finset β} {f : β → α} : + ∏ i in p, associates.mk (f i) = associates.mk (∏ i in p, f i) := +by rw [finset.prod_eq_multiset_prod, ← multiset.map_map, prod_mk, ← finset.prod_eq_multiset_prod] theorem rel_associated_iff_map_eq_map {p q : multiset α} : multiset.rel associated p q ↔ p.map associates.mk = q.map associates.mk := diff --git a/src/algebra/big_operators/basic.lean b/src/algebra/big_operators/basic.lean index 4c941cb016542..ac6250a471925 100644 --- a/src/algebra/big_operators/basic.lean +++ b/src/algebra/big_operators/basic.lean @@ -3,17 +3,23 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl -/ - +import algebra.big_operators.multiset.lemmas import algebra.group.pi -import algebra.hom.equiv +import algebra.group_power.lemmas +import algebra.hom.equiv.basic import algebra.ring.opposite -import data.finset.fold +import data.finset.sum import data.fintype.basic -import data.set.pairwise +import data.finset.sigma +import data.multiset.powerset +import data.set.pairwise.basic /-! # Big operators +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define products and sums indexed by finite sets (specifically, `finset`). ## Notation @@ -39,7 +45,9 @@ See the documentation of `to_additive.attr` for more information. -/ universes u v w -variables {β : Type u} {α : Type v} {γ : Type w} +variables {ι : Type*} {β : Type u} {α : Type v} {γ : Type w} + +open fin namespace finset @@ -55,6 +63,9 @@ protected def prod [comm_monoid β] (s : finset α) (f : α → β) : β := (s.1 (⟨s, hs⟩ : finset α).prod f = (s.map f).prod := rfl +@[simp, to_additive] lemma prod_val [comm_monoid α] (s : finset α) : s.1.prod = s.prod id := +by rw [finset.prod, multiset.map_id] + end finset /-- @@ -77,15 +88,15 @@ In practice, this means that parentheses should be placed as follows: -/ library_note "operator precedence of big operators" -localized "notation `∑` binders `, ` r:(scoped:67 f, finset.sum finset.univ f) := r" - in big_operators -localized "notation `∏` binders `, ` r:(scoped:67 f, finset.prod finset.univ f) := r" - in big_operators +localized "notation (name := finset.sum_univ) + `∑` binders `, ` r:(scoped:67 f, finset.sum finset.univ f) := r" in big_operators +localized "notation (name := finset.prod_univ) + `∏` binders `, ` r:(scoped:67 f, finset.prod finset.univ f) := r" in big_operators -localized "notation `∑` binders ` in ` s `, ` r:(scoped:67 f, finset.sum s f) := r" - in big_operators -localized "notation `∏` binders ` in ` s `, ` r:(scoped:67 f, finset.prod s f) := r" - in big_operators +localized "notation (name := finset.sum) + `∑` binders ` in ` s `, ` r:(scoped:67 f, finset.sum s f) := r" in big_operators +localized "notation (name := finset.prod) + `∏` binders ` in ` s `, ` r:(scoped:67 f, finset.prod s f) := r" in big_operators open_locale big_operators @@ -95,6 +106,9 @@ variables {s s₁ s₂ : finset α} {a : α} {f g : α → β} @[to_additive] lemma prod_eq_multiset_prod [comm_monoid β] (s : finset α) (f : α → β) : ∏ x in s, f x = (s.1.map f).prod := rfl +@[simp, to_additive] lemma prod_map_val [comm_monoid β] (s : finset α) (f : α → β) : + (s.1.map f).prod = ∏ a in s, f a := rfl + @[to_additive] theorem prod_eq_fold [comm_monoid β] (s : finset α) (f : α → β) : ∏ x in s, f x = s.fold (*) 1 f := @@ -190,8 +204,9 @@ namespace finset section comm_monoid variables [comm_monoid β] -@[simp, to_additive] -lemma prod_empty {f : α → β} : (∏ x in (∅:finset α), f x) = 1 := rfl +@[simp, to_additive] lemma prod_empty : ∏ x in ∅, f x = 1 := rfl +@[to_additive] lemma prod_of_empty [is_empty α] (s : finset α) : ∏ i in s, f i = 1 := +by rw [eq_empty_of_is_empty s, prod_empty] @[simp, to_additive] lemma prod_cons (h : a ∉ s) : (∏ x in (cons a s h), f x) = f a * ∏ x in s, f x := @@ -235,7 +250,7 @@ by rw [prod_insert (not_mem_singleton.2 h), prod_singleton] @[simp, priority 1100, to_additive] lemma prod_const_one : (∏ x in s, (1 : β)) = 1 := -by simp only [finset.prod, multiset.map_const, multiset.prod_repeat, one_pow] +by simp only [finset.prod, multiset.map_const, multiset.prod_replicate, one_pow] @[simp, to_additive] lemma prod_image [decidable_eq α] {s : finset γ} {g : γ → α} : @@ -252,6 +267,20 @@ lemma prod_congr (h : s₁ = s₂) : (∀ x ∈ s₂, f x = g x) → s₁.prod f by rw [h]; exact fold_congr attribute [congr] finset.sum_congr +@[to_additive] +lemma prod_disj_union (h) : ∏ x in s₁.disj_union s₂ h, f x = (∏ x in s₁, f x) * ∏ x in s₂, f x := +by { refine eq.trans _ (fold_disj_union h), rw one_mul, refl } + +@[to_additive] +lemma prod_disj_Union (s : finset ι) (t : ι → finset α) (h) : + ∏ x in s.disj_Union t h, f x = ∏ i in s, ∏ x in t i, f x := +begin + refine eq.trans _ (fold_disj_Union h), + dsimp [finset.prod, multiset.prod, multiset.fold, finset.disj_Union, finset.fold], + congr', + exact prod_const_one.symm, +end + @[to_additive] lemma prod_union_inter [decidable_eq α] : (∏ x in (s₁ ∪ s₂), f x) * (∏ x in (s₁ ∩ s₂), f x) = (∏ x in s₁, f x) * (∏ x in s₂, f x) := @@ -268,7 +297,7 @@ lemma prod_filter_mul_prod_filter_not (s : finset α) (p : α → Prop) [decidab (∏ x in s.filter p, f x) * (∏ x in s.filter (λ x, ¬p x), f x) = ∏ x in s, f x := begin haveI := classical.dec_eq α, - rw [← prod_union (filter_inter_filter_neg_eq p s).le, filter_union_filter_neg_eq] + rw [← prod_union (disjoint_filter_filter_neg _ _ p), filter_union_filter_neg_eq] end section to_list @@ -297,12 +326,13 @@ end finset section open finset -variables [fintype α] [decidable_eq α] [comm_monoid β] +variables [fintype α] [comm_monoid β] @[to_additive] lemma is_compl.prod_mul_prod {s t : finset α} (h : is_compl s t) (f : α → β) : (∏ i in s, f i) * (∏ i in t, f i) = ∏ i, f i := -(finset.prod_union h.disjoint).symm.trans $ by rw [← finset.sup_eq_union, h.sup_eq_top]; refl +(finset.prod_disj_union h.disjoint).symm.trans $ + by { classical, rw [finset.disj_union_eq_union, ← finset.sup_eq_union, h.sup_eq_top]; refl } end @@ -330,52 +360,23 @@ lemma prod_sdiff [decidable_eq α] (h : s₁ ⊆ s₂) : by rw [←prod_union sdiff_disjoint, sdiff_union_of_subset h] @[simp, to_additive] -lemma prod_sum_elim [decidable_eq (α ⊕ γ)] - (s : finset α) (t : finset γ) (f : α → β) (g : γ → β) : - ∏ x in s.map function.embedding.inl ∪ t.map function.embedding.inr, sum.elim f g x = - (∏ x in s, f x) * (∏ x in t, g x) := +lemma prod_disj_sum (s : finset α) (t : finset γ) (f : α ⊕ γ → β) : + ∏ x in s.disj_sum t, f x = (∏ x in s, f (sum.inl x)) * (∏ x in t, f (sum.inr x)) := begin - rw [prod_union, prod_map, prod_map], - { simp only [sum.elim_inl, function.embedding.inl_apply, function.embedding.inr_apply, - sum.elim_inr] }, - { simp only [disjoint_left, finset.mem_map, finset.mem_map], - rintros _ ⟨i, hi, rfl⟩ ⟨j, hj, H⟩, - cases H } + rw [←map_inl_disj_union_map_inr, prod_disj_union, prod_map, prod_map], + refl, end -@[simp, to_additive] -lemma prod_on_sum [fintype α] [fintype γ] (f : α ⊕ γ → β) : - ∏ (x : α ⊕ γ), f x = - (∏ (x : α), f (sum.inl x)) * (∏ (x : γ), f (sum.inr x)) := -begin - haveI := classical.dec_eq (α ⊕ γ), - convert prod_sum_elim univ univ (λ x, f (sum.inl x)) (λ x, f (sum.inr x)), - { ext a, - split, - { intro x, - cases a, - { simp only [mem_union, mem_map, mem_univ, function.embedding.inl_apply, or_false, - exists_true_left, exists_apply_eq_apply, function.embedding.inr_apply, exists_false], }, - { simp only [mem_union, mem_map, mem_univ, function.embedding.inl_apply, false_or, - exists_true_left, exists_false, function.embedding.inr_apply, - exists_apply_eq_apply], }, }, - { simp only [mem_univ, implies_true_iff], }, }, - { simp only [sum.elim_comp_inl_inr], }, -end +@[to_additive] +lemma prod_sum_elim (s : finset α) (t : finset γ) (f : α → β) (g : γ → β) : + ∏ x in s.disj_sum t, sum.elim f g x = (∏ x in s, f x) * (∏ x in t, g x) := +by simp @[to_additive] lemma prod_bUnion [decidable_eq α] {s : finset γ} {t : γ → finset α} (hs : set.pairwise_disjoint ↑s t) : - (∏ x in (s.bUnion t), f x) = ∏ x in s, ∏ i in t x, f i := -begin - haveI := classical.dec_eq γ, - induction s using finset.induction_on with x s hxs ih hd, - { simp_rw [bUnion_empty, prod_empty] }, - { simp_rw [coe_insert, set.pairwise_disjoint_insert, mem_coe] at hs, - have : disjoint (t x) (finset.bUnion s t), - { exact (disjoint_bUnion_right _ _ _).mpr (λ y hy, hs.2 y hy $ λ H, hxs $ H.substr hy) }, - rw [bUnion_insert, prod_insert hxs, prod_union this, ih hs.1] } -end + (∏ x in s.bUnion t, f x) = ∏ x in s, ∏ i in t x, f i := +by rw [←disj_Union_eq_bUnion _ _ hs, prod_disj_Union] /-- Product over a sigma type equals the product of fiberwise products. For rewriting in the reverse direction, use `finset.prod_sigma'`. -/ @@ -384,15 +385,7 @@ in the reverse direction, use `finset.sum_sigma'`"] lemma prod_sigma {σ : α → Type*} (s : finset α) (t : Π a, finset (σ a)) (f : sigma σ → β) : (∏ x in s.sigma t, f x) = ∏ a in s, ∏ s in (t a), f ⟨a, s⟩ := -by classical; -calc (∏ x in s.sigma t, f x) = - ∏ x in s.bUnion (λ a, (t a).map (function.embedding.sigma_mk a)), f x : by rw sigma_eq_bUnion - ... = ∏ a in s, ∏ x in (t a).map (function.embedding.sigma_mk a), f x : - prod_bUnion $ assume a₁ ha a₂ ha₂ h x hx, - by { simp only [inf_eq_inter, mem_inter, mem_map, function.embedding.sigma_mk_apply] at hx, - rcases hx with ⟨⟨y, hy, rfl⟩, ⟨z, hz, hz'⟩⟩, cc } - ... = ∏ a in s, ∏ s in t a, f ⟨a, s⟩ : - prod_congr rfl $ λ _ _, prod_map _ _ _ +by simp_rw [←disj_Union_map_sigma_mk, prod_disj_Union, prod_map, function.embedding.sigma_mk_apply] @[to_additive] lemma prod_sigma' {σ : α → Type*} @@ -442,6 +435,23 @@ begin {intros b hb, use j b hb, use hj b hb, exact (right_inv b hb).symm,}, end +/-- Reindexing a product over a finset along an equivalence. +See `equiv.prod_comp` for the version where `s` and `s'` are `univ`. -/ +@[to_additive /-" Reindexing a sum over a finset along an equivalence. +See `equiv.sum_comp` for the version where `s` and `s'` are `univ`. "-/] +lemma equiv.prod_comp_finset {ι'} [decidable_eq ι] (e : ι ≃ ι') (f : ι' → β) {s' : finset ι'} + {s : finset ι} + (h : s = s'.image e.symm) : + ∏ i' in s', f i' = ∏ i in s, f (e i) := +begin + rw [h], + refine finset.prod_bij' (λ i' hi', e.symm i') (λ a ha, finset.mem_image_of_mem _ ha) + (λ a ha, by simp_rw [e.apply_symm_apply]) (λ i hi, e i) (λ a ha, _) + (λ a ha, e.apply_symm_apply a) (λ a ha, e.symm_apply_apply a), + rcases finset.mem_image.mp ha with ⟨i', hi', rfl⟩, + rwa [e.apply_symm_apply] +end + @[to_additive] lemma prod_finset_product (r : finset (γ × α)) (s : finset γ) (t : γ → finset α) (h : ∀ p : γ × α, p ∈ r ↔ p.1 ∈ s ∧ p.2 ∈ t p.1) {f : γ × α → β} : @@ -481,12 +491,8 @@ lemma prod_fiberwise_of_maps_to [decidable_eq γ] {s : finset α} {t : finset γ (h : ∀ x ∈ s, g x ∈ t) (f : α → β) : (∏ y in t, ∏ x in s.filter (λ x, g x = y), f x) = ∏ x in s, f x := begin - letI := classical.dec_eq α, - rw [← bUnion_filter_eq_of_maps_to h] {occs := occurrences.pos [2]}, - refine (prod_bUnion $ λ x' hx y' hy hne, _).symm, - rw [function.on_fun, disjoint_filter], - rintros x hx rfl, - exact hne + rw [← disj_Union_filter_eq_of_maps_to h] {occs := occurrences.pos [2]}, + rw prod_disj_Union, end @[to_additive] @@ -501,39 +507,49 @@ calc (∏ x in s.image g, f x) = ∏ x in s.image g, ∏ x in s.filter (λ c', g lemma prod_mul_distrib : ∏ x in s, (f x * g x) = (∏ x in s, f x) * (∏ x in s, g x) := eq.trans (by rw one_mul; refl) fold_op_distrib -@[to_additive] -lemma prod_comm {s : finset γ} {t : finset α} {f : γ → α → β} : - (∏ x in s, ∏ y in t, f x y) = (∏ y in t, ∏ x in s, f x y) := -begin - classical, - apply finset.induction_on s, - { simp only [prod_empty, prod_const_one] }, - { intros _ _ H ih, - simp only [prod_insert H, prod_mul_distrib, ih] } -end - @[to_additive] lemma prod_product {s : finset γ} {t : finset α} {f : γ×α → β} : - (∏ x in s.product t, f x) = ∏ x in s, ∏ y in t, f (x, y) := -prod_finset_product (s.product t) s (λ a, t) (λ p, mem_product) + (∏ x in s ×ˢ t, f x) = ∏ x in s, ∏ y in t, f (x, y) := +prod_finset_product (s ×ˢ t) s (λ a, t) (λ p, mem_product) /-- An uncurried version of `finset.prod_product`. -/ @[to_additive "An uncurried version of `finset.sum_product`"] lemma prod_product' {s : finset γ} {t : finset α} {f : γ → α → β} : - (∏ x in s.product t, f x.1 x.2) = ∏ x in s, ∏ y in t, f x y := + (∏ x in s ×ˢ t, f x.1 x.2) = ∏ x in s, ∏ y in t, f x y := prod_product @[to_additive] lemma prod_product_right {s : finset γ} {t : finset α} {f : γ×α → β} : - (∏ x in s.product t, f x) = ∏ y in t, ∏ x in s, f (x, y) := -by rw [prod_product, prod_comm] + (∏ x in s ×ˢ t, f x) = ∏ y in t, ∏ x in s, f (x, y) := +prod_finset_product_right (s ×ˢ t) t (λ a, s) (λ p, mem_product.trans and.comm) /-- An uncurried version of `finset.prod_product_right`. -/ @[to_additive "An uncurried version of `finset.prod_product_right`"] lemma prod_product_right' {s : finset γ} {t : finset α} {f : γ → α → β} : - (∏ x in s.product t, f x.1 x.2) = ∏ y in t, ∏ x in s, f x y := + (∏ x in s ×ˢ t, f x.1 x.2) = ∏ y in t, ∏ x in s, f x y := prod_product_right +/-- Generalization of `finset.prod_comm` to the case when the inner `finset`s depend on the outer +variable. -/ +@[to_additive "Generalization of `finset.sum_comm` to the case when the inner `finset`s depend on +the outer variable."] +lemma prod_comm' {s : finset γ} {t : γ → finset α} {t' : finset α} {s' : α → finset γ} + (h : ∀ x y, x ∈ s ∧ y ∈ t x ↔ x ∈ s' y ∧ y ∈ t') {f : γ → α → β} : + (∏ x in s, ∏ y in t x, f x y) = (∏ y in t', ∏ x in s' y, f x y) := +begin + classical, + have : ∀ z : γ × α, + z ∈ s.bUnion (λ x, (t x).map $ function.embedding.sectr x _) ↔ z.1 ∈ s ∧ z.2 ∈ t z.1, + { rintro ⟨x, y⟩, simp }, + exact (prod_finset_product' _ _ _ this).symm.trans + (prod_finset_product_right' _ _ _ $ λ ⟨x, y⟩, (this _).trans ((h x y).trans and.comm)) +end + +@[to_additive] +lemma prod_comm {s : finset γ} {t : finset α} {f : γ → α → β} : + (∏ x in s, ∏ y in t, f x y) = (∏ y in t, ∏ x in s, f x y) := +prod_comm' $ λ _ _, iff.rfl + @[to_additive] lemma prod_hom_rel [comm_monoid γ] {r : β → γ → Prop} {f : α → β} {g : α → γ} {s : finset α} (h₁ : r 1 1) (h₂ : ∀ a b c, r b c → r (f a * b) (g a * c)) : r (∏ x in s, f x) (∏ x in s, g x) := @@ -710,6 +726,26 @@ lemma prod_subtype {p : α → Prop} {F : fintype (subtype p)} (s : finset α) ∏ a in s, f a = ∏ a : subtype p, f a := have (∈ s) = p, from set.ext h, by { substI p, rw ← prod_coe_sort, congr } +/-- The product of a function `g` defined only on a set `s` is equal to +the product of a function `f` defined everywhere, +as long as `f` and `g` agree on `s`, and `f = 1` off `s`. -/ +@[to_additive "The sum of a function `g` defined only on a set `s` is equal to +the sum of a function `f` defined everywhere, +as long as `f` and `g` agree on `s`, and `f = 0` off `s`."] +lemma prod_congr_set + {α : Type*} [comm_monoid α] {β : Type*} [fintype β] + (s : set β) [decidable_pred (∈s)] (f : β → α) (g : s → α) + (w : ∀ (x : β) (h : x ∈ s), f x = g ⟨x, h⟩) (w' : ∀ (x : β), x ∉ s → f x = 1) : + finset.univ.prod f = finset.univ.prod g := +begin + rw ←@finset.prod_subset _ _ s.to_finset finset.univ f _ (by simp), + { rw finset.prod_subtype, + { apply finset.prod_congr rfl, + exact λ ⟨x, h⟩ _, w x h, }, + { simp, }, }, + { rintro x _ h, exact w' x (by simpa using h), }, +end + @[to_additive] lemma prod_apply_dite {s : finset α} {p : α → Prop} {hp : decidable_pred p} [decidable_pred (λ x, ¬ p x)] (f : Π (x : α), p x → γ) (g : Π (x : α), ¬p x → γ) (h : γ → β) : @@ -772,6 +808,11 @@ lemma prod_extend_by_one [decidable_eq α] (s : finset α) (f : α → β) : ∏ i in s, (if i ∈ s then f i else 1) = ∏ i in s, f i := prod_congr rfl $ λ i hi, if_pos hi +@[simp, to_additive] +lemma prod_ite_mem [decidable_eq α] (s t : finset α) (f : α → β) : + ∏ i in s, (if i ∈ t then f i else 1) = ∏ i in (s ∩ t), f i := +by rw [← finset.prod_filter, finset.filter_mem_eq_inter] + @[simp, to_additive] lemma prod_dite_eq [decidable_eq α] (s : finset α) (a : α) (b : Π x : α, a = x → β) : (∏ x in s, (if h : a = x then b x h else 1)) = ite (a ∈ s) (b a rfl) 1 := @@ -818,19 +859,25 @@ lemma prod_ite_index (p : Prop) [decidable p] (s t : finset α) (f : α → β) apply_ite (λ s, ∏ x in s, f x) _ _ _ @[simp, to_additive] -lemma prod_dite_irrel (p : Prop) [decidable p] (s : finset α) (f : p → α → β) (g : ¬p → α → β): +lemma prod_ite_irrel (p : Prop) [decidable p] (s : finset α) (f g : α → β) : + (∏ x in s, if p then f x else g x) = if p then ∏ x in s, f x else ∏ x in s, g x := +by { split_ifs with h; refl } + +@[simp, to_additive] +lemma prod_dite_irrel (p : Prop) [decidable p] (s : finset α) (f : p → α → β) (g : ¬p → α → β) : (∏ x in s, if h : p then f h x else g h x) = if h : p then ∏ x in s, f h x else ∏ x in s, g h x := by { split_ifs with h; refl } -@[simp] lemma sum_pi_single' {ι M : Type*} [decidable_eq ι] [add_comm_monoid M] - (i : ι) (x : M) (s : finset ι) : - ∑ j in s, pi.single i x j = if i ∈ s then x else 0 := -sum_dite_eq' _ _ _ +@[simp, to_additive] +lemma prod_pi_mul_single' [decidable_eq α] (a : α) (x : β) (s : finset α) : + ∏ a' in s, pi.mul_single a x a' = if a ∈ s then x else 1 := +prod_dite_eq' _ _ _ -@[simp] lemma sum_pi_single {ι : Type*} {M : ι → Type*} - [decidable_eq ι] [Π i, add_comm_monoid (M i)] (i : ι) (f : Π i, M i) (s : finset ι) : - ∑ j in s, pi.single j (f j) i = if i ∈ s then f i else 0 := -sum_dite_eq _ _ _ +@[simp, to_additive] +lemma prod_pi_mul_single {β : α → Type*} + [decidable_eq α] [Π a, comm_monoid (β a)] (a : α) (f : Π a, β a) (s : finset α) : + ∏ a' in s, pi.mul_single a' (f a') a = if a ∈ s then f a else 1 := +prod_dite_eq _ _ _ @[to_additive] lemma prod_bij_ne_one {s : finset α} {t : finset γ} {f : α → β} {g : γ → β} @@ -905,7 +952,7 @@ begin induction m with m hm, { simp }, erw [prod_range_succ, hm], - simp [hu] + simp [hu, @zero_le' ℕ], end @[to_additive] @@ -971,12 +1018,16 @@ begin rw [count_eq_zero_of_not_mem hx, pow_zero], end +lemma sum_filter_count_eq_countp [decidable_eq α] (p : α → Prop) [decidable_pred p] (l : list α) : + ∑ x in l.to_finset.filter p, l.count x = l.countp p := +by simp [finset.sum, sum_map_count_dedup_filter_eq_countp p l] + open multiset @[to_additive] lemma prod_multiset_map_count [decidable_eq α] (s : multiset α) {M : Type*} [comm_monoid M] (f : α → M) : (s.map f).prod = ∏ m in s.to_finset, (f m) ^ (s.count m) := -by { refine quot.induction_on s (λ l, _), simpa [prod_list_map_count l f] } +by { refine quot.induction_on s (λ l, _), simp [prod_list_map_count l f] } @[to_additive] lemma prod_multiset_count [decidable_eq α] [comm_monoid α] (s : multiset α) : @@ -1026,12 +1077,15 @@ lemma prod_induction_nonempty {M : Type*} [comm_monoid M] (f : α → M) (p : M multiset.prod_induction_nonempty p p_mul (by simp [nonempty_iff_ne_empty.mp hs_nonempty]) (multiset.forall_mem_map_iff.mpr p_s) -/-- -For any product along `{0, ..., n-1}` of a commutative-monoid-valued function, we can verify that -it's equal to a different function just by checking ratios of adjacent terms. +/-- For any product along `{0, ..., n - 1}` of a commutative-monoid-valued function, we can verify +that it's equal to a different function just by checking ratios of adjacent terms. + This is a multiplicative discrete analogue of the fundamental theorem of calculus. -/ -lemma prod_range_induction {M : Type*} [comm_monoid M] - (f s : ℕ → M) (h0 : s 0 = 1) (h : ∀ n, s (n + 1) = s n * f n) (n : ℕ) : +@[to_additive "For any sum along `{0, ..., n - 1}` of a commutative-monoid-valued function, we can +verify that it's equal to a different function just by checking differences of adjacent terms. + +This is a discrete analogue of the fundamental theorem of calculus."] +lemma prod_range_induction (f s : ℕ → β) (h0 : s 0 = 1) (h : ∀ n, s (n + 1) = s n * f n) (n : ℕ) : ∏ k in finset.range n, f k = s n := begin induction n with k hk, @@ -1039,46 +1093,36 @@ begin { simp only [hk, finset.prod_range_succ, h, mul_comm] } end -/-- -For any sum along `{0, ..., n-1}` of a commutative-monoid-valued function, -we can verify that it's equal to a different function -just by checking differences of adjacent terms. -This is a discrete analogue -of the fundamental theorem of calculus. --/ -lemma sum_range_induction {M : Type*} [add_comm_monoid M] - (f s : ℕ → M) (h0 : s 0 = 0) (h : ∀ n, s (n + 1) = s n + f n) (n : ℕ) : - ∑ k in finset.range n, f k = s n := -@prod_range_induction (multiplicative M) _ f s h0 h n - -/-- A telescoping sum along `{0, ..., n - 1}` of an additive commutative group valued function -reduces to the difference of the last and first terms.-/ -lemma sum_range_sub {G : Type*} [add_comm_group G] (f : ℕ → G) (n : ℕ) : - ∑ i in range n, (f (i+1) - f i) = f n - f 0 := -by { apply sum_range_induction; simp } - -lemma sum_range_sub' {G : Type*} [add_comm_group G] (f : ℕ → G) (n : ℕ) : - ∑ i in range n, (f i - f (i+1)) = f 0 - f n := -by { apply sum_range_induction; simp } - /-- A telescoping product along `{0, ..., n - 1}` of a commutative group valued function reduces to the ratio of the last and first factors. -/ -@[to_additive] +@[to_additive "A telescoping sum along `{0, ..., n - 1}` of an additive commutative group valued +function reduces to the difference of the last and first terms."] lemma prod_range_div {M : Type*} [comm_group M] (f : ℕ → M) (n : ℕ) : - ∏ i in range n, (f (i+1) * (f i)⁻¹) = f n * (f 0)⁻¹ := -by simpa only [← div_eq_mul_inv] using @sum_range_sub (additive M) _ f n + ∏ i in range n, (f (i + 1) / f i) = f n / f 0 := +by apply prod_range_induction; simp @[to_additive] lemma prod_range_div' {M : Type*} [comm_group M] (f : ℕ → M) (n : ℕ) : - ∏ i in range n, (f i * (f (i+1))⁻¹) = f 0 * (f n)⁻¹ := -by simpa only [← div_eq_mul_inv] using @sum_range_sub' (additive M) _ f n + ∏ i in range n, (f i / f (i + 1)) = f 0 / f n := +by apply prod_range_induction; simp + +@[to_additive] +lemma eq_prod_range_div {M : Type*} [comm_group M] (f : ℕ → M) (n : ℕ) : + f n = f 0 * ∏ i in range n, (f (i + 1) / f i) := +by rw [prod_range_div, mul_div_cancel'_right] + +@[to_additive] +lemma eq_prod_range_div' {M : Type*} [comm_group M] (f : ℕ → M) (n : ℕ) : + f n = ∏ i in range (n + 1), if i = 0 then f 0 else f i / f (i - 1) := +by { conv_lhs { rw [finset.eq_prod_range_div f] }, simp [finset.prod_range_succ', mul_comm] } /-- A telescoping sum along `{0, ..., n-1}` of an `ℕ`-valued function reduces to the difference of the last and first terms when the function we are summing is monotone. -/ -lemma sum_range_sub_of_monotone {f : ℕ → ℕ} (h : monotone f) (n : ℕ) : +lemma sum_range_tsub [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] + [contravariant_class α α (+) (≤)] {f : ℕ → α} (h : monotone f) (n : ℕ) : ∑ i in range n, (f (i+1) - f i) = f n - f 0 := begin refine sum_range_induction _ _ (tsub_self _) (λ n, _) _, @@ -1088,9 +1132,11 @@ begin end @[simp, to_additive] lemma prod_const (b : β) : (∏ x in s, b) = b ^ s.card := -by haveI := classical.dec_eq α; exact -finset.induction_on s (by simp) (λ a s has ih, -by rw [prod_insert has, card_insert_of_not_mem has, pow_succ, ih]) +(congr_arg _ $ s.val.map_const b).trans $ multiset.prod_replicate s.card b + +@[to_additive sum_eq_card_nsmul] lemma prod_eq_pow_card {b : β} (hf : ∀ a ∈ s, f a = b) : + ∏ a in s, f a = b ^ s.card := +(prod_congr rfl hf).trans $ prod_const _ @[to_additive] lemma pow_eq_prod_const (b : β) : ∀ n, b ^ n = ∏ k in range n, b := by simp @@ -1098,8 +1144,7 @@ lemma pow_eq_prod_const (b : β) : ∀ n, b ^ n = ∏ k in range n, b := by simp @[to_additive] lemma prod_pow (s : finset α) (n : ℕ) (f : α → β) : ∏ x in s, f x ^ n = (∏ x in s, f x) ^ n := -by haveI := classical.dec_eq α; exact -finset.induction_on s (by simp) (by simp [mul_pow] {contextual := tt}) +multiset.prod_map_pow @[to_additive] lemma prod_flip {n : ℕ} (f : ℕ → β) : @@ -1144,7 +1189,7 @@ finset.strong_induction_on s if hx1 : f x = 1 then ih' ▸ eq.symm (prod_subset hmem (λ y hy hy₁, - have y = x ∨ y = g x hx, by simp [hy] at hy₁; tauto, + have y = x ∨ y = g x hx, by simpa [hy, not_and_distrib, or_comm] using hy₁, this.elim (λ hy, hy.symm ▸ hx1) (λ hy, h x hx ▸ hy ▸ hx1.symm ▸ (one_mul _).symm))) else by rw [← insert_erase hx, prod_insert (not_mem_erase _ _), @@ -1264,9 +1309,13 @@ begin end /-- Taking a product over `s : finset α` is the same as multiplying the value on a single element -`f a` by the product of `s.erase a`. -/ +`f a` by the product of `s.erase a`. + +See `multiset.prod_map_erase` for the `multiset` version. -/ @[to_additive "Taking a sum over `s : finset α` is the same as adding the value on a single element -`f a` to the sum over `s.erase a`."] +`f a` to the sum over `s.erase a`. + +See `multiset.sum_map_erase` for the `multiset` version."] lemma mul_prod_erase [decidable_eq α] (s : finset α) (f : α → β) {a : α} (h : a ∈ s) : f a * (∏ x in s.erase a, f x) = ∏ x in s, f x := by rw [← prod_insert (not_mem_erase a s), insert_erase h] @@ -1290,6 +1339,31 @@ begin rwa eq_of_mem_of_not_mem_erase hx hnx end +/-- See also `finset.prod_boole`. -/ +@[to_additive "See also `finset.sum_boole`."] +lemma prod_ite_one {f : α → Prop} [decidable_pred f] (hf : (s : set α).pairwise_disjoint f) + (a : β) : + ∏ i in s, ite (f i) a 1 = ite (∃ i ∈ s, f i) a 1 := +begin + split_ifs, + { obtain ⟨i, hi, hfi⟩ := h, + rw [prod_eq_single_of_mem _ hi, if_pos hfi], + exact λ j hj h, if_neg (λ hfj, (hf hj hi h).le_bot ⟨hfj, hfi⟩) }, + { push_neg at h, + rw prod_eq_one, + exact λ i hi, if_neg (h i hi) } +end + +@[to_additive] +lemma prod_erase_lt_of_one_lt {γ : Type*} [decidable_eq α] [ordered_comm_monoid γ] + [covariant_class γ γ (*) (<)] {s : finset α} {d : α} (hd : d ∈ s) {f : α → γ} (hdf : 1 < f d) : + ∏ (m : α) in s.erase d, f m < ∏ (m : α) in s, f m := +begin + nth_rewrite_rhs 0 ←finset.insert_erase hd, + rw finset.prod_insert (finset.not_mem_erase d s), + exact lt_mul_of_one_lt_left' _ hdf, +end + /-- If a product is 1 and the function is 1 except possibly at one point, it is 1 everywhere on the `finset`. -/ @[to_additive "If a sum is 0 and the function is 0 except possibly at one @@ -1319,7 +1393,7 @@ begin classical, apply finset.induction_on' S, { simp }, intros a T haS _ haT IH, - repeat {rw finset.prod_insert haT}, + repeat { rw finset.prod_insert haT }, exact mul_dvd_mul (h a haS) IH, end @@ -1347,21 +1421,19 @@ begin apply sum_congr rfl h₁ end -@[simp] -lemma sum_boole {s : finset α} {p : α → Prop} [non_assoc_semiring β] {hp : decidable_pred p} : - (∑ x in s, if p x then (1 : β) else (0 : β)) = (s.filter p).card := -by simp [sum_ite] +lemma nat_cast_card_filter [add_comm_monoid_with_one β] (p) [decidable_pred p] (s : finset α) : + ((filter p s).card : β) = ∑ a in s, if p a then 1 else 0 := +by simp only [add_zero, sum_const, nsmul_eq_mul, eq_self_iff_true, sum_const_zero, sum_ite, + nsmul_one] -lemma eq_sum_range_sub [add_comm_group β] (f : ℕ → β) (n : ℕ) : - f n = f 0 + ∑ i in range n, (f (i+1) - f i) := -by rw [finset.sum_range_sub, add_sub_cancel'_right] +lemma card_filter (p) [decidable_pred p] (s : finset α) : + (filter p s).card = ∑ a in s, ite (p a) 1 0 := +nat_cast_card_filter _ _ -lemma eq_sum_range_sub' [add_comm_group β] (f : ℕ → β) (n : ℕ) : - f n = ∑ i in range (n + 1), if i = 0 then f 0 else f i - f (i - 1) := -begin - conv_lhs { rw [finset.eq_sum_range_sub f] }, - simp [finset.sum_range_succ', add_comm] -end +@[simp] +lemma sum_boole {s : finset α} {p : α → Prop} [add_comm_monoid_with_one β] {hp : decidable_pred p} : + (∑ x in s, if p x then 1 else 0 : β) = (s.filter p).card := +(nat_cast_card_filter _ _).symm lemma _root_.commute.sum_right [non_unital_non_assoc_semiring β] (s : finset α) (f : α → β) (b : β) (h : ∀ i ∈ s, commute b (f i)) : @@ -1391,30 +1463,48 @@ open mul_opposite end opposite -section comm_group -variables [comm_group β] +section division_comm_monoid +variables [division_comm_monoid β] -@[simp, to_additive] -lemma prod_inv_distrib : (∏ x in s, (f x)⁻¹) = (∏ x in s, f x)⁻¹ := multiset.prod_map_inv' +@[simp, to_additive] lemma prod_inv_distrib : (∏ x in s, (f x)⁻¹) = (∏ x in s, f x)⁻¹ := +multiset.prod_map_inv -@[to_additive zsmul_sum] -lemma prod_zpow (f : α → β) (s : finset α) (n : ℤ) : - (∏ a in s, f a) ^ n = ∏ a in s, (f a) ^ n := -multiset.prod_map_zpow.symm +@[simp, to_additive] +lemma prod_div_distrib : (∏ x in s, f x / g x) = (∏ x in s, f x) / ∏ x in s, g x := +multiset.prod_map_div @[to_additive] -lemma prod_sdiff_div_prod_sdiff [decidable_eq α] : - (∏ (x : α) in s₂ \ s₁, f x) / (∏ (x : α) in s₁ \ s₂, f x) - = (∏ (x : α) in s₂, f x) / (∏ (x : α) in s₁, f x) := +lemma prod_zpow (f : α → β) (s : finset α) (n : ℤ) : ∏ a in s, (f a) ^ n = (∏ a in s, f a) ^ n := +multiset.prod_map_zpow + +end division_comm_monoid + +section comm_group +variables [comm_group β] [decidable_eq α] + +@[simp, to_additive] lemma prod_sdiff_eq_div (h : s₁ ⊆ s₂) : + (∏ x in (s₂ \ s₁), f x) = (∏ x in s₂, f x) / (∏ x in s₁, f x) := +by rw [eq_div_iff_mul_eq', prod_sdiff h] + +@[to_additive] lemma prod_sdiff_div_prod_sdiff : + (∏ x in s₂ \ s₁, f x) / (∏ x in s₁ \ s₂, f x) = (∏ x in s₂, f x) / (∏ x in s₁, f x) := by simp [← finset.prod_sdiff (@inf_le_left _ _ s₁ s₂), ← finset.prod_sdiff (@inf_le_right _ _ s₁ s₂)] +@[simp, to_additive] +lemma prod_erase_eq_div {a : α} (h : a ∈ s) : (∏ x in s.erase a, f x) = (∏ x in s, f x) / f a := +by rw [eq_div_iff_mul_eq', prod_erase_mul _ _ h] + end comm_group @[simp] theorem card_sigma {σ : α → Type*} (s : finset α) (t : Π a, finset (σ a)) : card (s.sigma t) = ∑ a in s, card (t a) := multiset.card_sigma _ _ +@[simp] lemma card_disj_Union (s : finset α) (t : α → finset β) (h) : + (s.disj_Union t h).card = s.sum (λ i, (t i).card) := +multiset.card_bind _ _ + lemma card_bUnion [decidable_eq β] {s : finset α} {t : α → finset β} (h : ∀ x ∈ s, ∀ y ∈ s, x ≠ y → disjoint (t x) (t y)) : (s.bUnion t).card = ∑ u in s, card (t u) := @@ -1441,10 +1531,6 @@ theorem card_eq_sum_card_image [decidable_eq β] (f : α → β) (s : finset α) s.card = ∑ a in s.image f, (s.filter (λ x, f x = a)).card := card_eq_sum_card_fiberwise (λ _, mem_image_of_mem _) -@[simp] lemma sum_sub_distrib [add_comm_group β] : - ∑ x in s, (f x - g x) = (∑ x in s, f x) - (∑ x in s, g x) := -by simpa only [sub_eq_add_neg] using sum_add_distrib.trans (congr_arg _ sum_neg_distrib) - lemma mem_sum {f : α → multiset β} (s : finset α) (b : β) : b ∈ ∑ x in s, f x ↔ ∃ a ∈ s, b ∈ f a := begin @@ -1489,35 +1575,27 @@ by { rw [ne, prod_eq_zero_iff], push_neg } end prod_eq_zero -section comm_group_with_zero -variables [comm_group_with_zero β] - -@[simp] -lemma prod_inv_distrib' : (∏ x in s, (f x)⁻¹) = (∏ x in s, f x)⁻¹ := -begin - classical, - by_cases h : ∃ x ∈ s, f x = 0, - { simpa [prod_eq_zero_iff.mpr h, prod_eq_zero_iff] using h }, - { push_neg at h, - have h' := prod_ne_zero_iff.mpr h, - have hf : ∀ x ∈ s, (f x)⁻¹ * f x = 1 := λ x hx, inv_mul_cancel (h x hx), - apply mul_right_cancel₀ h', - simp [h, h', ← finset.prod_mul_distrib, prod_congr rfl hf] } -end - -end comm_group_with_zero - @[to_additive] lemma prod_unique_nonempty {α β : Type*} [comm_monoid β] [unique α] (s : finset α) (f : α → β) (h : s.nonempty) : (∏ x in s, f x) = f default := -begin - obtain ⟨a, ha⟩ := h, - have : s = {a}, - { ext b, - simpa [subsingleton.elim a b] using ha }, - rw [this, finset.prod_singleton, subsingleton.elim a default] -end +by rw [h.eq_singleton_default, finset.prod_singleton] + +lemma sum_nat_mod (s : finset α) (n : ℕ) (f : α → ℕ) : + (∑ i in s, f i) % n = (∑ i in s, f i % n) % n := +(multiset.sum_nat_mod _ _).trans $ by rw [finset.sum, multiset.map_map] + +lemma prod_nat_mod (s : finset α) (n : ℕ) (f : α → ℕ) : + (∏ i in s, f i) % n = (∏ i in s, f i % n) % n := +(multiset.prod_nat_mod _ _).trans $ by rw [finset.prod, multiset.map_map] + +lemma sum_int_mod (s : finset α) (n : ℤ) (f : α → ℤ) : + (∑ i in s, f i) % n = (∑ i in s, f i % n) % n := +(multiset.sum_int_mod _ _).trans $ by rw [finset.sum, multiset.map_map] + +lemma prod_int_mod (s : finset α) (n : ℤ) (f : α → ℤ) : + (∏ i in s, f i) % n = (∏ i in s, f i % n) % n := +(multiset.prod_int_mod _ _).trans $ by rw [finset.prod, multiset.map_map] end finset @@ -1560,16 +1638,16 @@ prod_bijective e e.bijective f g h variables {f s} @[to_additive] -lemma prod_unique {α β : Type*} [comm_monoid β] [unique α] (f : α → β) : +lemma prod_unique {α β : Type*} [comm_monoid β] [unique α] [fintype α] (f : α → β) : (∏ x : α, f x) = f default := by rw [univ_unique, prod_singleton] -@[to_additive] lemma prod_empty {α β : Type*} [comm_monoid β] [is_empty α] (f : α → β) : +@[to_additive] lemma prod_empty {α β : Type*} [comm_monoid β] [is_empty α] [fintype α] (f : α → β) : (∏ x : α, f x) = 1 := -by rw [eq_empty_of_is_empty (univ : finset α), finset.prod_empty] +finset.prod_of_empty _ -@[to_additive] -lemma prod_subsingleton {α β : Type*} [comm_monoid β] [subsingleton α] (f : α → β) (a : α) : +@[to_additive] lemma prod_subsingleton {α β : Type*} [comm_monoid β] [subsingleton α] [fintype α] + (f : α → β) (a : α) : (∏ x : α, f x) = f a := begin haveI : unique α := unique_of_subsingleton a, @@ -1603,29 +1681,92 @@ end list namespace multiset +lemma disjoint_list_sum_left {a : multiset α} {l : list (multiset α)} : + multiset.disjoint l.sum a ↔ ∀ b ∈ l, multiset.disjoint b a := +begin + induction l with b bs ih, + { simp only [zero_disjoint, list.not_mem_nil, is_empty.forall_iff, forall_const, list.sum_nil], }, + { simp_rw [list.sum_cons, disjoint_add_left, list.mem_cons_iff, forall_eq_or_imp], + simp [and.congr_left_iff, iff_self, ih], }, +end + +lemma disjoint_list_sum_right {a : multiset α} {l : list (multiset α)} : + multiset.disjoint a l.sum ↔ ∀ b ∈ l, multiset.disjoint a b := +by simpa only [disjoint_comm] using disjoint_list_sum_left + +lemma disjoint_sum_left {a : multiset α} {i : multiset (multiset α)} : + multiset.disjoint i.sum a ↔ ∀ b ∈ i, multiset.disjoint b a := +quotient.induction_on i $ λ l, begin + rw [quot_mk_to_coe, multiset.coe_sum], + exact disjoint_list_sum_left, +end + +lemma disjoint_sum_right {a : multiset α} {i : multiset (multiset α)} : + multiset.disjoint a i.sum ↔ ∀ b ∈ i, multiset.disjoint a b := +by simpa only [disjoint_comm] using disjoint_sum_left + +lemma disjoint_finset_sum_left {β : Type*} {i : finset β} {f : β → multiset α} {a : multiset α} : + multiset.disjoint (i.sum f) a ↔ ∀ b ∈ i, multiset.disjoint (f b) a := +begin + convert (@disjoint_sum_left _ a) (map f i.val), + simp [and.congr_left_iff, iff_self], +end + +lemma disjoint_finset_sum_right {β : Type*} {i : finset β} {f : β → multiset α} {a : multiset α} : + multiset.disjoint a (i.sum f) ↔ ∀ b ∈ i, multiset.disjoint a (f b) := +by simpa only [disjoint_comm] using disjoint_finset_sum_left + variables [decidable_eq α] +lemma add_eq_union_left_of_le {x y z : multiset α} (h : y ≤ x) : + z + x = z ∪ y ↔ z.disjoint x ∧ x = y := +begin + rw ←add_eq_union_iff_disjoint, + split, + { intro h0, + rw and_iff_right_of_imp, + { exact (le_of_add_le_add_left $ h0.trans_le $ union_le_add z y).antisymm h, }, + { rintro rfl, + exact h0, } }, + { rintro ⟨h0, rfl⟩, + exact h0, } +end + +lemma add_eq_union_right_of_le {x y z : multiset α} (h : z ≤ y) : + x + y = x ∪ z ↔ y = z ∧ x.disjoint y := +by simpa only [and_comm] using add_eq_union_left_of_le h + +lemma finset_sum_eq_sup_iff_disjoint {β : Type*} {i : finset β} {f : β → multiset α} : + i.sum f = i.sup f ↔ ∀ x y ∈ i, x ≠ y → multiset.disjoint (f x) (f y) := +begin + induction i using finset.cons_induction_on with z i hz hr, + { simp only [finset.not_mem_empty, is_empty.forall_iff, implies_true_iff, + finset.sum_empty, finset.sup_empty, bot_eq_zero, eq_self_iff_true], }, + { simp_rw [finset.sum_cons hz, finset.sup_cons, finset.mem_cons, multiset.sup_eq_union, + forall_eq_or_imp, ne.def, eq_self_iff_true, not_true, is_empty.forall_iff, true_and, + imp_and_distrib, forall_and_distrib, ←hr, @eq_comm _ z], + have := λ x ∈ i, ne_of_mem_of_not_mem H hz, + simp only [this, not_false_iff, true_implies_iff] {contextual := tt}, + simp_rw [←disjoint_finset_sum_left, ←disjoint_finset_sum_right, disjoint_comm, ←and_assoc, + and_self], + exact add_eq_union_left_of_le (finset.sup_le (λ x hx, le_sum_of_mem (mem_map_of_mem f hx))), }, +end + +lemma sup_powerset_len {α : Type*} [decidable_eq α] (x : multiset α) : + finset.sup (finset.range (x.card + 1)) (λ k, x.powerset_len k) = x.powerset := +begin + convert bind_powerset_len x, + rw [multiset.bind, multiset.join, ←finset.range_val, ←finset.sum_eq_multiset_sum], + exact eq.symm (finset_sum_eq_sup_iff_disjoint.mpr + (λ _ _ _ _ h, pairwise_disjoint_powerset_len x h)), +end + @[simp] lemma to_finset_sum_count_eq (s : multiset α) : (∑ a in s.to_finset, s.count a) = s.card := -multiset.induction_on s rfl - (assume a s ih, - calc (∑ x in to_finset (a ::ₘ s), count x (a ::ₘ s)) = - ∑ x in to_finset (a ::ₘ s), ((if x = a then 1 else 0) + count x s) : - finset.sum_congr rfl $ λ _ _, by split_ifs; - [simp only [h, count_cons_self, nat.one_add], simp only [count_cons_of_ne h, zero_add]] - ... = card (a ::ₘ s) : - begin - by_cases a ∈ s.to_finset, - { have : ∑ x in s.to_finset, ite (x = a) 1 0 = ∑ x in {a}, ite (x = a) 1 0, - { rw [finset.sum_ite_eq', if_pos h, finset.sum_singleton, if_pos rfl], }, - rw [to_finset_cons, finset.insert_eq_of_mem h, finset.sum_add_distrib, ih, this, - finset.sum_singleton, if_pos rfl, add_comm, card_cons] }, - { have ha : a ∉ s, by rwa mem_to_finset at h, - have : ∑ x in to_finset s, ite (x = a) 1 0 = ∑ x in to_finset s, 0, from - finset.sum_congr rfl (λ x hx, if_neg $ by rintro rfl; cc), - rw [to_finset_cons, finset.sum_insert h, if_pos rfl, finset.sum_add_distrib, this, - finset.sum_const_zero, ih, count_eq_zero_of_not_mem ha, zero_add, add_comm, card_cons] } - end) +calc (∑ a in s.to_finset, s.count a) = (∑ a in s.to_finset, s.count a • 1) : + by simp only [smul_eq_mul, mul_one] +... = (s.map (λ _, 1)).sum : (finset.sum_multiset_map_count _ _).symm +... = s.card : by simp lemma count_sum' {s : finset β} {a : α} {f : β → multiset α} : count a (∑ x in s, f x) = ∑ x in s, count a (f x) := @@ -1633,17 +1774,7 @@ by { dunfold finset.sum, rw count_sum } @[simp] lemma to_finset_sum_count_nsmul_eq (s : multiset α) : (∑ a in s.to_finset, s.count a • {a}) = s := -begin - apply ext', intro b, - rw count_sum', - have h : count b s = count b (count b s • {b}), - { rw [count_nsmul, count_singleton_self, mul_one] }, - rw h, clear h, - apply finset.sum_eq_single b, - { intros c h hcb, rw count_nsmul, convert mul_zero (count c s), - apply count_eq_zero.mpr, exact finset.not_mem_singleton.mpr (ne.symm hcb) }, - { intro hb, rw [count_eq_zero_of_not_mem (mt mem_to_finset.2 hb), count_nsmul, zero_mul]} -end +by rw [← finset.sum_multiset_map_count, multiset.sum_map_singleton] theorem exists_smul_of_dvd_count (s : multiset α) {k : ℕ} (h : ∀ (a : α), a ∈ s → k ∣ multiset.count a s) : @@ -1677,22 +1808,62 @@ end end multiset -@[simp, norm_cast] lemma nat.cast_sum [add_comm_monoid β] [has_one β] (s : finset α) (f : α → ℕ) : +namespace nat + +@[simp, norm_cast] lemma cast_list_sum [add_monoid_with_one β] (s : list ℕ) : + (↑(s.sum) : β) = (s.map coe).sum := +map_list_sum (cast_add_monoid_hom β) _ + +@[simp, norm_cast] lemma cast_list_prod [semiring β] (s : list ℕ) : + (↑(s.prod) : β) = (s.map coe).prod := +map_list_prod (cast_ring_hom β) _ + +@[simp, norm_cast] lemma cast_multiset_sum [add_comm_monoid_with_one β] (s : multiset ℕ) : + (↑(s.sum) : β) = (s.map coe).sum := +map_multiset_sum (cast_add_monoid_hom β) _ + +@[simp, norm_cast] lemma cast_multiset_prod [comm_semiring β] (s : multiset ℕ) : + (↑(s.prod) : β) = (s.map coe).prod := +map_multiset_prod (cast_ring_hom β) _ + +@[simp, norm_cast] lemma cast_sum [add_comm_monoid_with_one β] (s : finset α) (f : α → ℕ) : ↑(∑ x in s, f x : ℕ) = (∑ x in s, (f x : β)) := -(nat.cast_add_monoid_hom β).map_sum f s +map_sum (cast_add_monoid_hom β) _ _ -@[simp, norm_cast] lemma int.cast_sum [add_comm_group β] [has_one β] (s : finset α) (f : α → ℤ) : - ↑(∑ x in s, f x : ℤ) = (∑ x in s, (f x : β)) := -(int.cast_add_hom β).map_sum f s +@[simp, norm_cast] lemma cast_prod [comm_semiring β] (f : α → ℕ) (s : finset α) : + (↑∏ i in s, f i : β) = ∏ i in s, f i := +map_prod (cast_ring_hom β) _ _ -@[simp, norm_cast] lemma nat.cast_prod {R : Type*} [comm_semiring R] (f : α → ℕ) (s : finset α) : - (↑∏ i in s, f i : R) = ∏ i in s, f i := -(nat.cast_ring_hom R).map_prod _ _ +end nat + +namespace int -@[simp, norm_cast] lemma int.cast_prod {R : Type*} [comm_ring R] (f : α → ℤ) (s : finset α) : +@[simp, norm_cast] lemma cast_list_sum [add_group_with_one β] (s : list ℤ) : + (↑(s.sum) : β) = (s.map coe).sum := +map_list_sum (cast_add_hom β) _ + +@[simp, norm_cast] lemma cast_list_prod [ring β] (s : list ℤ) : + (↑(s.prod) : β) = (s.map coe).prod := +map_list_prod (cast_ring_hom β) _ + +@[simp, norm_cast] lemma cast_multiset_sum [add_comm_group_with_one β] (s : multiset ℤ) : + (↑(s.sum) : β) = (s.map coe).sum := +map_multiset_sum (cast_add_hom β) _ + +@[simp, norm_cast] lemma cast_multiset_prod {R : Type*} [comm_ring R] (s : multiset ℤ) : + (↑(s.prod) : R) = (s.map coe).prod := +map_multiset_prod (cast_ring_hom R) _ + +@[simp, norm_cast] lemma cast_sum [add_comm_group_with_one β] (s : finset α) (f : α → ℤ) : + ↑(∑ x in s, f x : ℤ) = (∑ x in s, (f x : β)) := +map_sum (cast_add_hom β) _ _ + +@[simp, norm_cast] lemma cast_prod {R : Type*} [comm_ring R] (f : α → ℤ) (s : finset α) : (↑∏ i in s, f i : R) = ∏ i in s, f i := (int.cast_ring_hom R).map_prod _ _ +end int + @[simp, norm_cast] lemma units.coe_prod {M : Type*} [comm_monoid M] (f : α → Mˣ) (s : finset α) : (↑∏ i in s, f i : M) = ∏ i in s, f i := (units.coe_hom M).map_prod _ _ @@ -1712,3 +1883,63 @@ begin simp only [his, finset.sum_insert, not_false_iff], exact (int.nat_abs_add_le _ _).trans (add_le_add le_rfl IH) } end + +/-! ### `additive`, `multiplicative` -/ + +open additive multiplicative + +section monoid +variables [monoid α] + +@[simp] lemma of_mul_list_prod (s : list α) : of_mul s.prod = (s.map of_mul).sum := +by simpa [of_mul] + +@[simp] lemma to_mul_list_sum (s : list (additive α)) : + to_mul s.sum = (s.map to_mul).prod := by simpa [to_mul, of_mul] + +end monoid + +section add_monoid +variables [add_monoid α] + +@[simp] lemma of_add_list_prod (s : list α) : of_add s.sum = (s.map of_add).prod := +by simpa [of_add] + +@[simp] lemma to_add_list_sum (s : list (multiplicative α)) : + to_add s.prod = (s.map to_add).sum := by simpa [to_add, of_add] + +end add_monoid + +section comm_monoid +variables [comm_monoid α] + +@[simp] lemma of_mul_multiset_prod (s : multiset α) : + of_mul s.prod = (s.map of_mul).sum := by simpa [of_mul] + +@[simp] lemma to_mul_multiset_sum (s : multiset (additive α)) : + to_mul s.sum = (s.map to_mul).prod := by simpa [to_mul, of_mul] + +@[simp] lemma of_mul_prod (s : finset ι) (f : ι → α) : + of_mul (∏ i in s, f i) = ∑ i in s, of_mul (f i) := rfl + +@[simp] lemma to_mul_sum (s : finset ι) (f : ι → additive α) : + to_mul (∑ i in s, f i) = ∏ i in s, to_mul (f i) := rfl + +end comm_monoid + +section add_comm_monoid +variables [add_comm_monoid α] + +@[simp] lemma of_add_multiset_prod (s : multiset α) : + of_add s.sum = (s.map of_add).prod := by simpa [of_add] + +@[simp] lemma to_add_multiset_sum (s : multiset (multiplicative α)) : + to_add s.prod = (s.map to_add).sum := by simpa [to_add, of_add] + +@[simp] lemma of_add_sum (s : finset ι) (f : ι → α) : + of_add (∑ i in s, f i) = ∏ i in s, of_add (f i) := rfl + +@[simp] lemma to_add_prod (s : finset ι) (f : ι → multiplicative α) : + to_add (∏ i in s, f i) = ∑ i in s, to_add (f i) := rfl + +end add_comm_monoid diff --git a/src/algebra/big_operators/default.lean b/src/algebra/big_operators/default.lean deleted file mode 100644 index 1453249964cf8..0000000000000 --- a/src/algebra/big_operators/default.lean +++ /dev/null @@ -1,9 +0,0 @@ --- Import this file to pull in everything about "big operators". --- When preparing a contribution to mathlib, it is best to minimize the imports you use. -import algebra.big_operators.order -import algebra.big_operators.intervals -import algebra.big_operators.ring -import algebra.big_operators.pi -import algebra.big_operators.finsupp -import algebra.big_operators.nat_antidiagonal -import algebra.big_operators.enat diff --git a/src/algebra/big_operators/enat.lean b/src/algebra/big_operators/enat.lean deleted file mode 100644 index c1d1e9c808f10..0000000000000 --- a/src/algebra/big_operators/enat.lean +++ /dev/null @@ -1,22 +0,0 @@ -/- -Copyright (c) 2020 Floris van Doorn. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Floris van Doorn --/ -import algebra.big_operators.basic -import data.nat.enat - -/-! -# Big operators in `enat` - -A simple lemma about sums in `enat`. --/ -open_locale big_operators -variables {α : Type*} - -namespace finset -lemma sum_nat_coe_enat (s : finset α) (f : α → ℕ) : - (∑ x in s, (f x : enat)) = (∑ x in s, f x : ℕ) := -(enat.coe_hom.map_sum _ _).symm - -end finset diff --git a/src/algebra/big_operators/fin.lean b/src/algebra/big_operators/fin.lean index 42a469db0776c..4182c72eeeb8e 100644 --- a/src/algebra/big_operators/fin.lean +++ b/src/algebra/big_operators/fin.lean @@ -3,19 +3,26 @@ Copyright (c) 2020 Yury Kudryashov, Anne Baanen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov, Anne Baanen -/ -import algebra.big_operators.basic +import data.fintype.big_operators import data.fintype.fin -import data.fintype.card +import data.list.fin_range import logic.equiv.fin + /-! # Big operators and `fin` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Some results about products and sums over the type `fin`. The most important results are the induction formulas `fin.prod_univ_cast_succ` and `fin.prod_univ_succ`, and the formula `fin.prod_const` for the product of a constant function. These results have variants for sums instead of products. +## Main declarations + +* `fin_function_fin_equiv`: An explicit equivalence between `fin n → fin m` and `fin (m ^ n)`. -/ open_locale big_operators @@ -45,7 +52,7 @@ namespace fin @[to_additive] theorem prod_univ_def [comm_monoid β] {n : ℕ} (f : fin n → β) : ∏ i, f i = ((list.fin_range n).map f).prod := -by simp [univ_def, finset.fin_range] +by simp [univ_def] @[to_additive] theorem prod_of_fn [comm_monoid β] {n : ℕ} (f : fin n → β) : @@ -58,43 +65,64 @@ theorem prod_univ_zero [comm_monoid β] (f : fin 0 → β) : ∏ i, f i = 1 := r /-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)` is the product of `f x`, for some `x : fin (n + 1)` times the remaining product -/ -@[to_additive -/- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)` -is the sum of `f x`, for some `x : fin (n + 1)` plus the remaining product -/] -theorem prod_univ_succ_above [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) - (x : fin (n + 1)) : +@[to_additive "A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)` is the sum of `f x`, +for some `x : fin (n + 1)` plus the remaining product"] +theorem prod_univ_succ_above [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) (x : fin (n + 1)) : ∏ i, f i = f x * ∏ i : fin n, f (x.succ_above i) := -begin - rw [fintype.prod_eq_mul_prod_compl x, ← image_succ_above_univ, prod_image], - exact λ _ _ _ _ h, x.succ_above.injective h -end +by rw [univ_succ_above, prod_cons, finset.prod_map, rel_embedding.coe_fn_to_embedding] /-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)` is the product of `f 0` plus the remaining product -/ -@[to_additive -/- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)` -is the sum of `f 0` plus the remaining product -/] +@[to_additive "A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)` is the sum of `f 0` +plus the remaining product"] theorem prod_univ_succ [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) : ∏ i, f i = f 0 * ∏ i : fin n, f i.succ := prod_univ_succ_above f 0 /-- A product of a function `f : fin (n + 1) → β` over all `fin (n + 1)` is the product of `f (fin.last n)` plus the remaining product -/ -@[to_additive -/- A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)` -is the sum of `f (fin.last n)` plus the remaining sum -/] +@[to_additive "A sum of a function `f : fin (n + 1) → β` over all `fin (n + 1)` is the sum of +`f (fin.last n)` plus the remaining sum"] theorem prod_univ_cast_succ [comm_monoid β] {n : ℕ} (f : fin (n + 1) → β) : ∏ i, f i = (∏ i : fin n, f i.cast_succ) * f (last n) := by simpa [mul_comm] using prod_univ_succ_above f (last n) +@[to_additive] lemma prod_cons [comm_monoid β] {n : ℕ} (x : β) (f : fin n → β) : + ∏ i : fin n.succ, (cons x f : fin n.succ → β) i = x * ∏ i : fin n, f i := +by simp_rw [prod_univ_succ, cons_zero, cons_succ] + @[to_additive sum_univ_one] theorem prod_univ_one [comm_monoid β] (f : fin 1 → β) : ∏ i, f i = f 0 := by simp -@[to_additive] theorem prod_univ_two [comm_monoid β] (f : fin 2 → β) : +@[simp, to_additive] theorem prod_univ_two [comm_monoid β] (f : fin 2 → β) : ∏ i, f i = f 0 * f 1 := by simp [prod_univ_succ] +@[to_additive] theorem prod_univ_three [comm_monoid β] (f : fin 3 → β) : + ∏ i, f i = f 0 * f 1 * f 2 := +by { rw [prod_univ_cast_succ, prod_univ_two], refl } + +@[to_additive] theorem prod_univ_four [comm_monoid β] (f : fin 4 → β) : + ∏ i, f i = f 0 * f 1 * f 2 * f 3 := +by { rw [prod_univ_cast_succ, prod_univ_three], refl } + +@[to_additive] theorem prod_univ_five [comm_monoid β] (f : fin 5 → β) : + ∏ i, f i = f 0 * f 1 * f 2 * f 3 * f 4 := +by { rw [prod_univ_cast_succ, prod_univ_four], refl } + +@[to_additive] theorem prod_univ_six [comm_monoid β] (f : fin 6 → β) : + ∏ i, f i = f 0 * f 1 * f 2 * f 3 * f 4 * f 5 := +by { rw [prod_univ_cast_succ, prod_univ_five], refl } + +@[to_additive] theorem prod_univ_seven [comm_monoid β] (f : fin 7 → β) : + ∏ i, f i = f 0 * f 1 * f 2 * f 3 * f 4 * f 5 * f 6 := +by { rw [prod_univ_cast_succ, prod_univ_six], refl } + +@[to_additive] theorem prod_univ_eight [comm_monoid β] (f : fin 8 → β) : + ∏ i, f i = f 0 * f 1 * f 2 * f 3 * f 4 * f 5 * f 6 * f 7 := +by { rw [prod_univ_cast_succ, prod_univ_seven], refl } + lemma sum_pow_mul_eq_add_pow {n : ℕ} {R : Type*} [comm_semiring R] (a b : R) : ∑ s : finset (fin n), a ^ s.card * b ^ (n - s.card) = (a + b) ^ n := by simpa using fintype.sum_pow_mul_eq_add_pow (fin n) a b @@ -103,16 +131,14 @@ lemma prod_const [comm_monoid α] (n : ℕ) (x : α) : ∏ i : fin n, x = x ^ n lemma sum_const [add_comm_monoid α] (n : ℕ) (x : α) : ∑ i : fin n, x = n • x := by simp -@[to_additive] -lemma prod_filter_zero_lt {M : Type*} [comm_monoid M] {n : ℕ} {v : fin n.succ → M} : - ∏ i in univ.filter (λ (i : fin n.succ), 0 < i), v i = ∏ (j : fin n), v j.succ := -by rw [univ_filter_zero_lt, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding] +@[to_additive] lemma prod_Ioi_zero {M : Type*} [comm_monoid M] {n : ℕ} {v : fin n.succ → M} : + ∏ i in Ioi 0, v i = ∏ j : fin n, v j.succ := +by rw [Ioi_zero_eq_map, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding] @[to_additive] -lemma prod_filter_succ_lt {M : Type*} [comm_monoid M] {n : ℕ} (j : fin n) (v : fin n.succ → M) : - ∏ i in univ.filter (λ i, j.succ < i), v i = - ∏ j in univ.filter (λ i, j < i), v j.succ := -by rw [univ_filter_succ_lt, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding] +lemma prod_Ioi_succ {M : Type*} [comm_monoid M] {n : ℕ} (i : fin n) (v : fin n.succ → M) : + ∏ j in Ioi i.succ, v j = ∏ j in Ioi i, v j.succ := +by rw [Ioi_succ, finset.prod_map, rel_embedding.coe_fn_to_embedding, coe_succ_embedding] @[to_additive] lemma prod_congr' {M : Type*} [comm_monoid M] {a b : ℕ} (f : fin b → M) (h : a = b) : @@ -127,7 +153,7 @@ begin rw fintype.prod_equiv fin_sum_fin_equiv.symm f (λ i, f (fin_sum_fin_equiv.to_fun i)), swap, { intro x, simp only [equiv.to_fun_as_coe, equiv.apply_symm_apply], }, - apply prod_on_sum, + apply fintype.prod_sum_type, end @[to_additive] @@ -137,12 +163,213 @@ lemma prod_trunc {M : Type*} [comm_monoid M] {a b : ℕ} (f : fin (a+b) → M) ∏ (i : fin a), f (cast_le (nat.le.intro rfl) i) := by simpa only [prod_univ_add, fintype.prod_eq_one _ hf, mul_one] +section partial_prod + +variables [monoid α] {n : ℕ} + +/-- For `f = (a₁, ..., aₙ)` in `αⁿ`, `partial_prod f` is `(1, a₁, a₁a₂, ..., a₁...aₙ)` in `αⁿ⁺¹`. -/ +@[to_additive "For `f = (a₁, ..., aₙ)` in `αⁿ`, `partial_sum f` is +`(0, a₁, a₁ + a₂, ..., a₁ + ... + aₙ)` in `αⁿ⁺¹`."] +def partial_prod (f : fin n → α) (i : fin (n + 1)) : α := +((list.of_fn f).take i).prod + +@[simp, to_additive] lemma partial_prod_zero (f : fin n → α) : + partial_prod f 0 = 1 := +by simp [partial_prod] + +@[to_additive] lemma partial_prod_succ (f : fin n → α) (j : fin n) : + partial_prod f j.succ = partial_prod f j.cast_succ * (f j) := +by simp [partial_prod, list.take_succ, list.of_fn_nth_val, dif_pos j.is_lt, ←option.coe_def] + +@[to_additive] lemma partial_prod_succ' (f : fin (n + 1) → α) (j : fin (n + 1)) : + partial_prod f j.succ = f 0 * partial_prod (fin.tail f) j := +by simpa [partial_prod] + +@[to_additive] lemma partial_prod_left_inv {G : Type*} [group G] (f : fin (n + 1) → G) : + f 0 • partial_prod (λ i : fin n, (f i)⁻¹ * f i.succ) = f := +funext $ λ x, fin.induction_on x (by simp) (λ x hx, +begin + simp only [coe_eq_cast_succ, pi.smul_apply, smul_eq_mul] at hx ⊢, + rw [partial_prod_succ, ←mul_assoc, hx, mul_inv_cancel_left], +end) + +@[to_additive] lemma partial_prod_right_inv {G : Type*} [group G] + (f : fin n → G) (i : fin n) : + (partial_prod f i.cast_succ)⁻¹ * partial_prod f i.succ = f i := +begin + cases i with i hn, + induction i with i hi generalizing hn, + { simp [-fin.succ_mk, partial_prod_succ] }, + { specialize hi (lt_trans (nat.lt_succ_self i) hn), + simp only [fin.coe_eq_cast_succ, fin.succ_mk, fin.cast_succ_mk] at hi ⊢, + rw [←fin.succ_mk _ _ (lt_trans (nat.lt_succ_self _) hn), ←fin.succ_mk], + simp only [partial_prod_succ, mul_inv_rev, fin.cast_succ_mk], + assoc_rw [hi, inv_mul_cancel_left] } +end + +/-- Let `(g₀, g₁, ..., gₙ)` be a tuple of elements in `Gⁿ⁺¹`. +Then if `k < j`, this says `(g₀g₁...gₖ₋₁)⁻¹ * g₀g₁...gₖ = gₖ`. +If `k = j`, it says `(g₀g₁...gₖ₋₁)⁻¹ * g₀g₁...gₖ₊₁ = gₖgₖ₊₁`. +If `k > j`, it says `(g₀g₁...gₖ)⁻¹ * g₀g₁...gₖ₊₁ = gₖ₊₁.` +Useful for defining group cohomology. -/ +@[to_additive "Let `(g₀, g₁, ..., gₙ)` be a tuple of elements in `Gⁿ⁺¹`. +Then if `k < j`, this says `-(g₀ + g₁ + ... + gₖ₋₁) + (g₀ + g₁ + ... + gₖ) = gₖ`. +If `k = j`, it says `-(g₀ + g₁ + ... + gₖ₋₁) + (g₀ + g₁ + ... + gₖ₊₁) = gₖ + gₖ₊₁`. +If `k > j`, it says `-(g₀ + g₁ + ... + gₖ) + (g₀ + g₁ + ... + gₖ₊₁) = gₖ₊₁.` +Useful for defining group cohomology."] +lemma inv_partial_prod_mul_eq_contract_nth {G : Type*} [group G] + (g : fin (n + 1) → G) (j : fin (n + 1)) (k : fin n) : + (partial_prod g (j.succ.succ_above k.cast_succ))⁻¹ * partial_prod g (j.succ_above k).succ + = j.contract_nth has_mul.mul g k := +begin + rcases lt_trichotomy (k : ℕ) j with (h|h|h), + { rwa [succ_above_below, succ_above_below, partial_prod_right_inv, contract_nth_apply_of_lt], + { assumption }, + { rw [cast_succ_lt_iff_succ_le, succ_le_succ_iff, le_iff_coe_le_coe], + exact le_of_lt h }}, + { rwa [succ_above_below, succ_above_above, partial_prod_succ, cast_succ_fin_succ, ←mul_assoc, + partial_prod_right_inv, contract_nth_apply_of_eq], + { simpa only [le_iff_coe_le_coe, ←h] }, + { rw [cast_succ_lt_iff_succ_le, succ_le_succ_iff, le_iff_coe_le_coe], + exact le_of_eq h }}, + { rwa [succ_above_above, succ_above_above, partial_prod_succ, partial_prod_succ, + cast_succ_fin_succ, partial_prod_succ, inv_mul_cancel_left, contract_nth_apply_of_gt], + { exact le_iff_coe_le_coe.2 (le_of_lt h) }, + { rw [le_iff_coe_le_coe, coe_succ], + exact nat.succ_le_of_lt h }}, +end + +end partial_prod + end fin +/-- Equivalence between `fin n → fin m` and `fin (m ^ n)`. -/ +@[simps] def fin_function_fin_equiv {m n : ℕ} : (fin n → fin m) ≃ fin (m ^ n) := +equiv.of_right_inverse_of_card_le + (le_of_eq $ by simp_rw [fintype.card_fun, fintype.card_fin]) + (λ f, ⟨∑ i, f i * m ^ (i : ℕ), begin + induction n with n ih generalizing f, + { simp }, + cases m, + { exact is_empty_elim (f $ fin.last _) }, + simp_rw [fin.sum_univ_cast_succ, fin.coe_cast_succ, fin.coe_last], + refine (add_lt_add_of_lt_of_le (ih _) $ mul_le_mul_right' (fin.is_le _) _).trans_eq _, + rw [←one_add_mul, add_comm, pow_succ], + end⟩) + (λ a b, ⟨a / m ^ (b : ℕ) % m, begin + cases n, + { exact b.elim0 }, + cases m, + { rw zero_pow n.succ_pos at a, + exact a.elim0 }, + { exact nat.mod_lt _ m.succ_pos } + end⟩) + (λ a, begin + dsimp, + induction n with n ih generalizing a, + { haveI : subsingleton (fin (m ^ 0)) := (fin.cast $ pow_zero _).to_equiv.subsingleton, + exact subsingleton.elim _ _ }, + simp_rw [fin.forall_iff, fin.ext_iff, fin.coe_mk] at ih, + ext, + simp_rw [fin.coe_mk, fin.sum_univ_succ, fin.coe_zero, fin.coe_succ, pow_zero, nat.div_one, + mul_one, pow_succ, ←nat.div_div_eq_div_mul, mul_left_comm _ m, ←mul_sum], + rw [ih _ (nat.div_lt_of_lt_mul a.is_lt), nat.mod_add_div], + end) + +lemma fin_function_fin_equiv_apply {m n : ℕ} (f : fin n → fin m): + (fin_function_fin_equiv f : ℕ) = ∑ (i : fin n), ↑(f i) * m ^ (i : ℕ) := rfl + +lemma fin_function_fin_equiv_single {m n : ℕ} [ne_zero m] (i : fin n) (j : fin m) : + (fin_function_fin_equiv (pi.single i j) : ℕ) = j * m ^ (i : ℕ) := +begin + rw [fin_function_fin_equiv_apply, fintype.sum_eq_single i, pi.single_eq_same], + rintro x hx, + rw [pi.single_eq_of_ne hx, fin.coe_zero, zero_mul], +end + +/-- Equivalence between `Π i : fin m, fin (n i)` and `fin (∏ i : fin m, n i)`. -/ +def fin_pi_fin_equiv {m : ℕ} {n : fin m → ℕ} : + (Π i : fin m, fin (n i)) ≃ fin (∏ i : fin m, n i) := +equiv.of_right_inverse_of_card_le + (le_of_eq $ by simp_rw [fintype.card_pi, fintype.card_fin]) + (λ f, ⟨∑ i, f i * ∏ j, n (fin.cast_le i.is_lt.le j), begin + induction m with m ih generalizing f, + { simp }, + rw [fin.prod_univ_cast_succ, fin.sum_univ_cast_succ], + suffices : ∀ (n : fin m → ℕ) (nn : ℕ) (f : Π i : fin m, fin (n i)) (fn : fin nn), + ∑ i : fin m, ↑(f i) * ∏ j : fin i, n (fin.cast_le i.prop.le j) + ↑fn * ∏ j, n j + < (∏ i : fin m, n i) * nn, + { replace this := this (fin.init n) (n (fin.last _)) (fin.init f) (f (fin.last _)), + rw ←fin.snoc_init_self f, + simp only [←fin.snoc_init_self n] { single_pass := tt }, + simp_rw [fin.snoc_cast_succ, fin.init_snoc, fin.snoc_last, fin.snoc_init_self n], + exact this }, + intros n nn f fn, + cases nn, + { exact is_empty_elim fn }, + refine (add_lt_add_of_lt_of_le (ih _) $ mul_le_mul_right' (fin.is_le _) _).trans_eq _, + rw [←one_add_mul, mul_comm, add_comm], + end⟩) + (λ a b, ⟨a / (∏ j : fin b, n (fin.cast_le b.is_lt.le j)) % n b, begin + cases m, + { exact b.elim0 }, + cases h : n b with nb, + { rw prod_eq_zero (finset.mem_univ _) h at a, + exact is_empty_elim a }, + exact nat.mod_lt _ nb.succ_pos, + end⟩) + (begin + intro a, revert a, dsimp only [fin.coe_mk], + refine fin.cons_induction _ _ n, + { intro a, + haveI : subsingleton (fin (∏ i : fin 0, i.elim0)) := + (fin.cast $ prod_empty).to_equiv.subsingleton, + exact subsingleton.elim _ _ }, + { intros n x xs ih a, + simp_rw [fin.forall_iff, fin.ext_iff, fin.coe_mk] at ih, + ext, + simp_rw [fin.coe_mk, fin.sum_univ_succ, fin.cons_succ], + have := λ i : fin n, fintype.prod_equiv (fin.cast $ fin.coe_succ i).to_equiv + (λ j, (fin.cons x xs : _ → ℕ) (fin.cast_le (fin.is_lt _).le j)) + (λ j, (fin.cons x xs : _ → ℕ) (fin.cast_le (nat.succ_le_succ (fin.is_lt _).le) j)) + (λ j, rfl), + simp_rw [this], clear this, + dsimp only [fin.coe_zero], + simp_rw [fintype.prod_empty, nat.div_one, mul_one, fin.cons_zero, fin.prod_univ_succ], + change _ + ∑ y : _, ((_ / (x * _)) % _) * (x * _) = _, + simp_rw [←nat.div_div_eq_div_mul, mul_left_comm (_ % _ : ℕ), ←mul_sum], + convert nat.mod_add_div _ _, + refine eq.trans _ (ih (a / x) (nat.div_lt_of_lt_mul $ a.is_lt.trans_eq _)), + swap, + { convert fin.prod_univ_succ (fin.cons x xs : (Π _, ℕ)), + simp_rw fin.cons_succ }, + congr' with i, + congr' with j, + { cases j, refl }, + { cases j, refl } } + end) + +lemma fin_pi_fin_equiv_apply {m : ℕ} {n : fin m → ℕ} (f : Π i : fin m, fin (n i)): + (fin_pi_fin_equiv f : ℕ) = ∑ i, f i * ∏ j, n (fin.cast_le i.is_lt.le j) := rfl + +lemma fin_pi_fin_equiv_single {m : ℕ} {n : fin m → ℕ} [Π i, ne_zero (n i)] + (i : fin m) (j : fin (n i)) : + (fin_pi_fin_equiv (pi.single i j : Π i : fin m, fin (n i)) : ℕ) + = j * ∏ j, n (fin.cast_le i.is_lt.le j) := +begin + rw [fin_pi_fin_equiv_apply, fintype.sum_eq_single i, pi.single_eq_same], + rintro x hx, + rw [pi.single_eq_of_ne hx, fin.coe_zero, zero_mul], +end + namespace list +section comm_monoid + +variables [comm_monoid α] + @[to_additive] -lemma prod_take_of_fn [comm_monoid α] {n : ℕ} (f : fin n → α) (i : ℕ) : +lemma prod_take_of_fn {n : ℕ} (f : fin n → α) (i : ℕ) : ((of_fn f).take i).prod = ∏ j in finset.univ.filter (λ (j : fin n), j.val < i), f j := begin have A : ∀ (j : fin n), ¬ ((j : ℕ) < 0) := λ j, not_lt_bot, @@ -152,7 +379,7 @@ begin rw prod_take_succ _ _ this, have A : ((finset.univ : finset (fin n)).filter (λ j, j.val < i + 1)) = ((finset.univ : finset (fin n)).filter (λ j, j.val < i)) ∪ {(⟨i, h⟩ : fin n)}, - by { ext j, simp [nat.lt_succ_iff_lt_or_eq, fin.ext_iff, - add_comm] }, + by { ext ⟨_, _⟩, simp [nat.lt_succ_iff_lt_or_eq] }, have B : _root_.disjoint (finset.filter (λ (j : fin n), j.val < i) finset.univ) (singleton (⟨i, h⟩ : fin n)), by simp, rw [A, finset.prod_union B, IH], @@ -169,7 +396,7 @@ begin end @[to_additive] -lemma prod_of_fn [comm_monoid α] {n : ℕ} {f : fin n → α} : +lemma prod_of_fn {n : ℕ} {f : fin n → α} : (of_fn f).prod = ∏ i, f i := begin convert prod_take_of_fn f n, @@ -178,6 +405,8 @@ begin simp [this] } end +end comm_monoid + lemma alternating_sum_eq_finset_sum {G : Type*} [add_comm_group G] : ∀ (L : list G), alternating_sum L = ∑ i : fin L.length, (-1 : ℤ) ^ (i : ℕ) • L.nth_le i i.is_lt | [] := by { rw [alternating_sum, finset.sum_eq_zero], rintro ⟨i, ⟨⟩⟩ } diff --git a/src/algebra/big_operators/finprod.lean b/src/algebra/big_operators/finprod.lean index 4e2771dd7af7e..03f5e99ad9b87 100644 --- a/src/algebra/big_operators/finprod.lean +++ b/src/algebra/big_operators/finprod.lean @@ -9,6 +9,9 @@ import algebra.indicator_function /-! # Finite products and sums over types and sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define products and sums over types and subsets of types, with no finiteness hypotheses. All infinite products and sums are defined to be junk values (i.e. one or zero). This approach is sometimes easier to use than `finset.sum`, @@ -74,7 +77,7 @@ open function set -/ section sort -variables {M N : Type*} {α β ι : Sort*} [comm_monoid M] [comm_monoid N] +variables {G M N : Type*} {α β ι : Sort*} [comm_monoid M] [comm_monoid N] open_locale big_operators @@ -87,22 +90,24 @@ open_locale classical /-- Sum of `f x` as `x` ranges over the elements of the support of `f`, if it's finite. Zero otherwise. -/ @[irreducible] noncomputable def finsum {M α} [add_comm_monoid M] (f : α → M) : M := -if h : finite (support (f ∘ plift.down)) then ∑ i in h.to_finset, f i.down else 0 +if h : (support (f ∘ plift.down)).finite then ∑ i in h.to_finset, f i.down else 0 /-- Product of `f x` as `x` ranges over the elements of the multiplicative support of `f`, if it's finite. One otherwise. -/ @[irreducible, to_additive] noncomputable def finprod (f : α → M) : M := -if h : finite (mul_support (f ∘ plift.down)) then ∏ i in h.to_finset, f i.down else 1 +if h : (mul_support (f ∘ plift.down)).finite then ∏ i in h.to_finset, f i.down else 1 end -localized "notation `∑ᶠ` binders `, ` r:(scoped:67 f, finsum f) := r" in big_operators +localized "notation (name := finsum) + `∑ᶠ` binders `, ` r:(scoped:67 f, finsum f) := r" in big_operators -localized "notation `∏ᶠ` binders `, ` r:(scoped:67 f, finprod f) := r" in big_operators +localized "notation (name := finprod) + `∏ᶠ` binders `, ` r:(scoped:67 f, finprod f) := r" in big_operators @[to_additive] lemma finprod_eq_prod_plift_of_mul_support_to_finset_subset - {f : α → M} (hf : finite (mul_support (f ∘ plift.down))) {s : finset (plift α)} + {f : α → M} (hf : (mul_support (f ∘ plift.down)).finite) {s : finset (plift α)} (hs : hf.to_finset ⊆ s) : ∏ᶠ i, f i = ∏ i in s, f i.down := begin @@ -191,7 +196,7 @@ lemma one_le_finprod' {M : Type*} [ordered_comm_monoid M] {f : α → M} (hf : finprod_induction _ le_rfl (λ _ _, one_le_mul) hf @[to_additive] lemma monoid_hom.map_finprod_plift (f : M →* N) (g : α → M) - (h : finite (mul_support $ g ∘ plift.down)) : + (h : (mul_support $ g ∘ plift.down).finite) : f (∏ᶠ x, g x) = ∏ᶠ x, f (g x) := begin rw [finprod_eq_prod_plift_of_mul_support_subset h.coe_to_finset.ge, @@ -202,7 +207,7 @@ end @[to_additive] lemma monoid_hom.map_finprod_Prop {p : Prop} (f : M →* N) (g : p → M) : f (∏ᶠ x, g x) = ∏ᶠ x, f (g x) := -f.map_finprod_plift g (finite.of_fintype _) +f.map_finprod_plift g (set.to_finite _) @[to_additive] lemma monoid_hom.map_finprod_of_preimage_one (f : M →* N) (hf : ∀ x, f x = 1 → x = 1) (g : α → M) : @@ -238,19 +243,15 @@ begin exact (smul_add_hom R M c).map_finsum_of_injective (smul_right_injective M hc) _ end -@[to_additive] lemma finprod_inv_distrib {G : Type*} [comm_group G] (f : α → G) : +@[to_additive] lemma finprod_inv_distrib [division_comm_monoid G] (f : α → G) : ∏ᶠ x, (f x)⁻¹ = (∏ᶠ x, f x)⁻¹ := ((mul_equiv.inv G).map_finprod f).symm -lemma finprod_inv_distrib₀ {G : Type*} [comm_group_with_zero G] (f : α → G) : - ∏ᶠ x, (f x)⁻¹ = (∏ᶠ x, f x)⁻¹ := -((mul_equiv.inv₀ G).map_finprod f).symm - end sort section type -variables {α β ι M N : Type*} [comm_monoid M] [comm_monoid N] +variables {α β ι G M N : Type*} [comm_monoid M] [comm_monoid N] open_locale big_operators @@ -281,7 +282,7 @@ begin end @[to_additive] lemma finprod_eq_prod_of_mul_support_to_finset_subset (f : α → M) - (hf : finite (mul_support f)) {s : finset α} (h : hf.to_finset ⊆ s) : + (hf : (mul_support f).finite) {s : finset α} (h : hf.to_finset ⊆ s) : ∏ᶠ i, f i = ∏ i in s, f i := finprod_eq_prod_of_mul_support_subset _ $ λ x hx, h $ hf.mem_to_finset.2 hx @@ -314,7 +315,7 @@ by { classical, rw [finprod_def, dif_pos hf] } @[to_additive] lemma finprod_eq_prod_of_fintype [fintype α] (f : α → M) : ∏ᶠ i : α, f i = ∏ i, f i := -finprod_eq_prod_of_mul_support_to_finset_subset _ (finite.of_fintype _) $ finset.subset_univ _ +finprod_eq_prod_of_mul_support_to_finset_subset _ (set.to_finite _) $ finset.subset_univ _ @[to_additive] lemma finprod_cond_eq_prod_of_cond_iff (f : α → M) {p : α → Prop} {t : finset α} (h : ∀ {x}, f x ≠ 1 → (p x ↔ x ∈ t)) : @@ -330,7 +331,7 @@ begin end @[to_additive] lemma finprod_cond_ne (f : α → M) (a : α) [decidable_eq α] - (hf : finite (mul_support f)) : (∏ᶠ i ≠ a, f i) = ∏ i in hf.to_finset.erase a, f i := + (hf : (mul_support f).finite) : (∏ᶠ i ≠ a, f i) = ∏ i in hf.to_finset.erase a, f i := begin apply finprod_cond_eq_prod_of_cond_iff, intros x hx, @@ -442,18 +443,12 @@ end equals the product of `f i` divided by the product of `g i`. -/ @[to_additive "If the additive supports of `f` and `g` are finite, then the sum of `f i - g i` equals the sum of `f i` minus the sum of `g i`."] -lemma finprod_div_distrib {G : Type*} [comm_group G] {f g : α → G} (hf : (mul_support f).finite) +lemma finprod_div_distrib [division_comm_monoid G] {f g : α → G} (hf : (mul_support f).finite) (hg : (mul_support g).finite) : ∏ᶠ i, f i / g i = (∏ᶠ i, f i) / ∏ᶠ i, g i := by simp only [div_eq_mul_inv, finprod_mul_distrib hf ((mul_support_inv g).symm.rec hg), finprod_inv_distrib] -lemma finprod_div_distrib₀ {G : Type*} [comm_group_with_zero G] {f g : α → G} - (hf : (mul_support f).finite) (hg : (mul_support g).finite) : - ∏ᶠ i, f i / g i = (∏ᶠ i, f i) / ∏ᶠ i, g i := -by simp only [div_eq_mul_inv, finprod_mul_distrib hf ((mul_support_inv₀ g).symm.rec hg), - finprod_inv_distrib₀] - /-- A more general version of `finprod_mem_mul_distrib` that only requires `s ∩ mul_support f` and `s ∩ mul_support g` rather than `s` to be finite. -/ @[to_additive "A more general version of `finsum_mem_add_distrib` that only requires `s ∩ support f` @@ -525,26 +520,18 @@ g.map_finprod_mem' (hs.inter_of_left _) (hs : s.finite) : g (∏ᶠ i ∈ s, f i) = ∏ᶠ i ∈ s, g (f i) := g.to_monoid_hom.map_finprod_mem f hs -@[to_additive] lemma finprod_mem_inv_distrib {G : Type*} [comm_group G] (f : α → G) - (hs : s.finite) : ∏ᶠ x ∈ s, (f x)⁻¹ = (∏ᶠ x ∈ s, f x)⁻¹ := +@[to_additive] lemma finprod_mem_inv_distrib [division_comm_monoid G] (f : α → G) (hs : s.finite) : + ∏ᶠ x ∈ s, (f x)⁻¹ = (∏ᶠ x ∈ s, f x)⁻¹ := ((mul_equiv.inv G).map_finprod_mem f hs).symm -lemma finprod_mem_inv_distrib₀ {G : Type*} [comm_group_with_zero G] (f : α → G) - (hs : s.finite) : ∏ᶠ x ∈ s, (f x)⁻¹ = (∏ᶠ x ∈ s, f x)⁻¹ := -((mul_equiv.inv₀ G).map_finprod_mem f hs).symm - /-- Given a finite set `s`, the product of `f i / g i` over `i ∈ s` equals the product of `f i` over `i ∈ s` divided by the product of `g i` over `i ∈ s`. -/ @[to_additive "Given a finite set `s`, the sum of `f i / g i` over `i ∈ s` equals the sum of `f i` over `i ∈ s` minus the sum of `g i` over `i ∈ s`."] -lemma finprod_mem_div_distrib {G : Type*} [comm_group G] (f g : α → G) (hs : s.finite) : +lemma finprod_mem_div_distrib [division_comm_monoid G] (f g : α → G) (hs : s.finite) : ∏ᶠ i ∈ s, f i / g i = (∏ᶠ i ∈ s, f i) / ∏ᶠ i ∈ s, g i := by simp only [div_eq_mul_inv, finprod_mem_mul_distrib hs, finprod_mem_inv_distrib g hs] -lemma finprod_mem_div_distrib₀ {G : Type*} [comm_group_with_zero G] (f g : α → G) - (hs : s.finite) : ∏ᶠ i ∈ s, f i / g i = (∏ᶠ i ∈ s, f i) / ∏ᶠ i ∈ s, g i := -by simp only [div_eq_mul_inv, finprod_mem_mul_distrib hs, finprod_mem_inv_distrib₀ g hs] - /-! ### `∏ᶠ x ∈ s, f x` and set operations -/ @@ -556,7 +543,7 @@ lemma finprod_mem_empty : ∏ᶠ i ∈ (∅ : set α), f i = 1 := by simp /-- A set `s` is nonempty if the product of some function over `s` is not equal to `1`. -/ @[to_additive "A set `s` is nonempty if the sum of some function over `s` is not equal to `0`."] lemma nonempty_of_finprod_mem_ne_one (h : ∏ᶠ i ∈ s, f i ≠ 1) : s.nonempty := -ne_empty_iff_nonempty.1 $ λ h', h $ h'.symm ▸ finprod_mem_empty +nonempty_iff_ne_empty.2 $ λ h', h $ h'.symm ▸ finprod_mem_empty /-- Given finite sets `s` and `t`, the product of `f i` over `i ∈ s ∪ t` times the product of `f i` over `i ∈ s ∩ t` equals the product of `f i` over `i ∈ s` times the product of `f i` @@ -688,7 +675,7 @@ lemma finprod_mem_image' {s : set β} {g : β → α} (hg : (s ∩ mul_support ( ∏ᶠ i ∈ g '' s, f i = ∏ᶠ j ∈ s, f (g j) := begin classical, - by_cases hs : finite (s ∩ mul_support (f ∘ g)), + by_cases hs : (s ∩ mul_support (f ∘ g)).finite, { have hg : ∀ (x ∈ hs.to_finset) (y ∈ hs.to_finset), g x = g y → x = y, by simpa only [hs.mem_to_finset], rw [finprod_mem_eq_prod _ hs, ← finset.prod_image hg], @@ -750,6 +737,10 @@ end lemma finprod_comp {g : β → M} (e : α → β) (he₀ : function.bijective e) : ∏ᶠ i, g (e i) = ∏ᶠ j, g j := finprod_eq_of_bijective e he₀ (λ x, rfl) +@[to_additive] +lemma finprod_comp_equiv (e : α ≃ β) {f : β → M} : ∏ᶠ i, f (e i) = ∏ᶠ i', f i' := +finprod_comp e e.bijective + @[to_additive] lemma finprod_set_coe_eq_finprod_mem (s : set α) : ∏ᶠ j : s, f j = ∏ᶠ i ∈ s, f i := begin rw [← finprod_mem_range, subtype.range_coe], @@ -764,6 +755,7 @@ finprod_set_coe_eq_finprod_mem {i | p i} (∏ᶠ i ∈ s ∩ t, f i) * ∏ᶠ i ∈ s \ t, f i = ∏ᶠ i ∈ s, f i := begin rw [← finprod_mem_union', inter_union_diff], + rw disjoint_iff_inf_le, exacts [λ x hx, hx.2.2 hx.1.2, h.subset (λ x hx, ⟨hx.1.1, hx.2⟩), h.subset (λ x hx, ⟨hx.1.1, hx.2⟩)], end @@ -794,16 +786,17 @@ finprod_mem_mul_diff' hst (ht.inter_of_left _) @[to_additive "Given a family of pairwise disjoint finite sets `t i` indexed by a finite type, the sum of `f a` over the union `⋃ i, t i` is equal to the sum over all indexes `i` of the sums of `f a` over `a ∈ t i`."] -lemma finprod_mem_Union [fintype ι] {t : ι → set α} (h : pairwise (disjoint on t)) +lemma finprod_mem_Union [finite ι] {t : ι → set α} (h : pairwise (disjoint on t)) (ht : ∀ i, (t i).finite) : ∏ᶠ a ∈ (⋃ i : ι, t i), f a = ∏ᶠ i, ∏ᶠ a ∈ t i, f a := begin + casesI nonempty_fintype ι, lift t to ι → finset α using ht, classical, rw [← bUnion_univ, ← finset.coe_univ, ← finset.coe_bUnion, finprod_mem_coe_finset, finset.prod_bUnion], { simp only [finprod_mem_coe_finset, finprod_eq_prod_of_fintype] }, - { exact λ x _ y _ hxy, finset.disjoint_iff_disjoint_coe.2 (h x y hxy) } + { exact λ x _ y _ hxy, finset.disjoint_coe.1 (h hxy) } end /-- Given a family of sets `t : ι → set α`, a finite set `I` in the index type such that all sets @@ -832,7 +825,7 @@ lemma finprod_mem_sUnion {t : set (set α)} (h : t.pairwise_disjoint id) (ht₀ ∏ᶠ a ∈ ⋃₀ t, f a = ∏ᶠ s ∈ t, ∏ᶠ a ∈ s, f a := by { rw set.sUnion_eq_bUnion, exact finprod_mem_bUnion h ht₀ ht₁ } -@[to_additive] lemma mul_finprod_cond_ne (a : α) (hf : finite (mul_support f)) : +@[to_additive] lemma mul_finprod_cond_ne (a : α) (hf : (mul_support f).finite) : f a * (∏ᶠ i ≠ a, f i) = ∏ᶠ i, f i := begin classical, @@ -876,7 +869,7 @@ finprod_nonneg $ λ x, finprod_nonneg $ hf x @[to_additive] lemma single_le_finprod {M : Type*} [ordered_comm_monoid M] (i : α) {f : α → M} - (hf : finite (mul_support f)) (h : ∀ j, 1 ≤ f j) : + (hf : (mul_support f).finite) (h : ∀ j, 1 ≤ f j) : f i ≤ ∏ᶠ j, f j := by classical; calc f i ≤ ∏ j in insert i hf.to_finset, f j : @@ -885,7 +878,7 @@ calc f i ≤ ∏ j in insert i hf.to_finset, f j : (finprod_eq_prod_of_mul_support_to_finset_subset _ hf (finset.subset_insert _ _)).symm lemma finprod_eq_zero {M₀ : Type*} [comm_monoid_with_zero M₀] (f : α → M₀) (x : α) - (hx : f x = 0) (hf : finite (mul_support f)) : + (hx : f x = 0) (hf : (mul_support f).finite) : ∏ᶠ x, f x = 0 := begin nontriviality, diff --git a/src/algebra/big_operators/finsupp.lean b/src/algebra/big_operators/finsupp.lean index 3f5f0befbb492..3ebc494154044 100644 --- a/src/algebra/big_operators/finsupp.lean +++ b/src/algebra/big_operators/finsupp.lean @@ -4,17 +4,24 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ -import data.finsupp.basic +import data.finsupp.indicator import algebra.big_operators.pi import algebra.big_operators.ring import algebra.big_operators.order +import group_theory.submonoid.membership /-! # Big operators for finsupps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains theorems relevant to big operators in finitely supported functions. -/ +noncomputable theory + +open finset function open_locale big_operators variables {α ι γ A B C : Type*} [add_comm_monoid A] [add_comm_monoid B] [add_comm_monoid C] @@ -22,6 +29,488 @@ variables {t : ι → A → C} (h0 : ∀ i, t i 0 = 0) (h1 : ∀ i x y, t i (x + variables {s : finset α} {f : α → (ι →₀ A)} (i : ι) variables (g : ι →₀ A) (k : ι → A → γ → B) (x : γ) +variables {β M M' N P G H R S : Type*} + +namespace finsupp + +/-! +### Declarations about `sum` and `prod` + +In most of this section, the domain `β` is assumed to be an `add_monoid`. +-/ + +section sum_prod + +/-- `prod f g` is the product of `g a (f a)` over the support of `f`. -/ +@[to_additive "`sum f g` is the sum of `g a (f a)` over the support of `f`. "] +def prod [has_zero M] [comm_monoid N] (f : α →₀ M) (g : α → M → N) : N := +∏ a in f.support, g a (f a) + +variables [has_zero M] [has_zero M'] [comm_monoid N] + +@[to_additive] +lemma prod_of_support_subset (f : α →₀ M) {s : finset α} + (hs : f.support ⊆ s) (g : α → M → N) (h : ∀ i ∈ s, g i 0 = 1) : + f.prod g = ∏ x in s, g x (f x) := +finset.prod_subset hs $ λ x hxs hx, h x hxs ▸ congr_arg (g x) $ not_mem_support_iff.1 hx + +@[to_additive] +lemma prod_fintype [fintype α] (f : α →₀ M) (g : α → M → N) (h : ∀ i, g i 0 = 1) : + f.prod g = ∏ i, g i (f i) := +f.prod_of_support_subset (subset_univ _) g (λ x _, h x) + +@[simp, to_additive] +lemma prod_single_index {a : α} {b : M} {h : α → M → N} (h_zero : h a 0 = 1) : + (single a b).prod h = h a b := +calc (single a b).prod h = ∏ x in {a}, h x (single a b x) : + prod_of_support_subset _ support_single_subset h $ + λ x hx, (mem_singleton.1 hx).symm ▸ h_zero +... = h a b : by simp + +@[to_additive] +lemma prod_map_range_index {f : M → M'} {hf : f 0 = 0} {g : α →₀ M} {h : α → M' → N} + (h0 : ∀a, h a 0 = 1) : (map_range f hf g).prod h = g.prod (λa b, h a (f b)) := +finset.prod_subset support_map_range $ λ _ _ H, + by rw [not_mem_support_iff.1 H, h0] + +@[simp, to_additive] +lemma prod_zero_index {h : α → M → N} : (0 : α →₀ M).prod h = 1 := rfl + +@[to_additive] +lemma prod_comm (f : α →₀ M) (g : β →₀ M') (h : α → M → β → M' → N) : + f.prod (λ x v, g.prod (λ x' v', h x v x' v')) = g.prod (λ x' v', f.prod (λ x v, h x v x' v')) := +finset.prod_comm + +@[simp, to_additive] +lemma prod_ite_eq [decidable_eq α] (f : α →₀ M) (a : α) (b : α → M → N) : + f.prod (λ x v, ite (a = x) (b x v) 1) = ite (a ∈ f.support) (b a (f a)) 1 := +by { dsimp [finsupp.prod], rw f.support.prod_ite_eq, } + +@[simp] lemma sum_ite_self_eq + [decidable_eq α] {N : Type*} [add_comm_monoid N] (f : α →₀ N) (a : α) : + f.sum (λ x v, ite (a = x) v 0) = f a := +begin + classical, + convert f.sum_ite_eq a (λ x, id), + simp [ite_eq_right_iff.2 eq.symm] +end + +/-- A restatement of `prod_ite_eq` with the equality test reversed. -/ +@[simp, to_additive "A restatement of `sum_ite_eq` with the equality test reversed."] +lemma prod_ite_eq' [decidable_eq α] (f : α →₀ M) (a : α) (b : α → M → N) : + f.prod (λ x v, ite (x = a) (b x v) 1) = ite (a ∈ f.support) (b a (f a)) 1 := +by { dsimp [finsupp.prod], rw f.support.prod_ite_eq', } + +@[simp] lemma sum_ite_self_eq' + [decidable_eq α] {N : Type*} [add_comm_monoid N] (f : α →₀ N) (a : α) : + f.sum (λ x v, ite (x = a) v 0) = f a := +begin + classical, + convert f.sum_ite_eq' a (λ x, id), + simp [ite_eq_right_iff.2 eq.symm] +end + +@[simp] lemma prod_pow [fintype α] (f : α →₀ ℕ) (g : α → N) : + f.prod (λ a b, g a ^ b) = ∏ a, g a ^ (f a) := +f.prod_fintype _ $ λ a, pow_zero _ + +/-- If `g` maps a second argument of 0 to 1, then multiplying it over the +result of `on_finset` is the same as multiplying it over the original +`finset`. -/ +@[to_additive "If `g` maps a second argument of 0 to 0, summing it over the +result of `on_finset` is the same as summing it over the original +`finset`."] +lemma on_finset_prod {s : finset α} {f : α → M} {g : α → M → N} + (hf : ∀a, f a ≠ 0 → a ∈ s) (hg : ∀ a, g a 0 = 1) : + (on_finset s f hf).prod g = ∏ a in s, g a (f a) := +finset.prod_subset support_on_finset_subset $ by simp [*] { contextual := tt } + +/-- Taking a product over `f : α →₀ M` is the same as multiplying the value on a single element +`y ∈ f.support` by the product over `erase y f`. -/ +@[to_additive /-" Taking a sum over over `f : α →₀ M` is the same as adding the value on a +single element `y ∈ f.support` to the sum over `erase y f`. "-/] +lemma mul_prod_erase (f : α →₀ M) (y : α) (g : α → M → N) (hyf : y ∈ f.support) : + g y (f y) * (erase y f).prod g = f.prod g := +begin + classical, + rw [finsupp.prod, finsupp.prod, ←finset.mul_prod_erase _ _ hyf, finsupp.support_erase, + finset.prod_congr rfl], + intros h hx, + rw finsupp.erase_ne (ne_of_mem_erase hx), +end + +/-- Generalization of `finsupp.mul_prod_erase`: if `g` maps a second argument of 0 to 1, +then its product over `f : α →₀ M` is the same as multiplying the value on any element +`y : α` by the product over `erase y f`. -/ +@[to_additive /-" Generalization of `finsupp.add_sum_erase`: if `g` maps a second argument of 0 +to 0, then its sum over `f : α →₀ M` is the same as adding the value on any element +`y : α` to the sum over `erase y f`. "-/] +lemma mul_prod_erase' (f : α →₀ M) (y : α) (g : α → M → N) (hg : ∀ (i : α), g i 0 = 1) : + g y (f y) * (erase y f).prod g = f.prod g := +begin + classical, + by_cases hyf : y ∈ f.support, + { exact finsupp.mul_prod_erase f y g hyf }, + { rw [not_mem_support_iff.mp hyf, hg y, erase_of_not_mem_support hyf, one_mul] }, +end + +@[to_additive] +lemma _root_.submonoid_class.finsupp_prod_mem {S : Type*} [set_like S N] [submonoid_class S N] + (s : S) (f : α →₀ M) (g : α → M → N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ s) : f.prod g ∈ s := +prod_mem $ λ i hi, h _ (finsupp.mem_support_iff.mp hi) + +@[to_additive] +lemma prod_congr {f : α →₀ M} {g1 g2 : α → M → N} + (h : ∀ x ∈ f.support, g1 x (f x) = g2 x (f x)) : f.prod g1 = f.prod g2 := +finset.prod_congr rfl h + +end sum_prod + +end finsupp + + +@[to_additive] +lemma map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] {H : Type*} + [monoid_hom_class H N P] (h : H) (f : α →₀ M) (g : α → M → N) : + h (f.prod g) = f.prod (λ a b, h (g a b)) := +map_prod h _ _ + +/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/ +@[to_additive "Deprecated, use `_root_.map_finsupp_sum` instead."] +protected lemma mul_equiv.map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] + (h : N ≃* P) (f : α →₀ M) (g : α → M → N) : h (f.prod g) = f.prod (λ a b, h (g a b)) := +map_finsupp_prod h f g + +/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/ +@[to_additive "Deprecated, use `_root_.map_finsupp_sum` instead."] +protected lemma monoid_hom.map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] + (h : N →* P) (f : α →₀ M) (g : α → M → N) : h (f.prod g) = f.prod (λ a b, h (g a b)) := +map_finsupp_prod h f g + +/-- Deprecated, use `_root_.map_finsupp_sum` instead. -/ +protected lemma ring_hom.map_finsupp_sum [has_zero M] [semiring R] [semiring S] + (h : R →+* S) (f : α →₀ M) (g : α → M → R) : h (f.sum g) = f.sum (λ a b, h (g a b)) := +map_finsupp_sum h f g + +/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/ +protected lemma ring_hom.map_finsupp_prod [has_zero M] [comm_semiring R] [comm_semiring S] + (h : R →+* S) (f : α →₀ M) (g : α → M → R) : h (f.prod g) = f.prod (λ a b, h (g a b)) := +map_finsupp_prod h f g + +@[to_additive] +lemma monoid_hom.coe_finsupp_prod [has_zero β] [monoid N] [comm_monoid P] + (f : α →₀ β) (g : α → β → N →* P) : + ⇑(f.prod g) = f.prod (λ i fi, g i fi) := +monoid_hom.coe_finset_prod _ _ + +@[simp, to_additive] +lemma monoid_hom.finsupp_prod_apply [has_zero β] [monoid N] [comm_monoid P] + (f : α →₀ β) (g : α → β → N →* P) (x : N) : + f.prod g x = f.prod (λ i fi, g i fi x) := +monoid_hom.finset_prod_apply _ _ _ + +namespace finsupp + +lemma single_multiset_sum [add_comm_monoid M] (s : multiset M) (a : α) : + single a s.sum = (s.map (single a)).sum := +multiset.induction_on s (single_zero _) $ λ a s ih, +by rw [multiset.sum_cons, single_add, ih, multiset.map_cons, multiset.sum_cons] + +lemma single_finset_sum [add_comm_monoid M] (s : finset ι) (f : ι → M) (a : α) : + single a (∑ b in s, f b) = ∑ b in s, single a (f b) := +begin + transitivity, + apply single_multiset_sum, + rw [multiset.map_map], + refl +end + +lemma single_sum [has_zero M] [add_comm_monoid N] (s : ι →₀ M) (f : ι → M → N) (a : α) : + single a (s.sum f) = s.sum (λd c, single a (f d c)) := +single_finset_sum _ _ _ + +@[to_additive] +lemma prod_neg_index [add_group G] [comm_monoid M] {g : α →₀ G} {h : α → G → M} + (h0 : ∀a, h a 0 = 1) : + (-g).prod h = g.prod (λa b, h a (- b)) := +prod_map_range_index h0 + +end finsupp + +namespace finsupp + +lemma finset_sum_apply [add_comm_monoid N] (S : finset ι) (f : ι → α →₀ N) (a : α) : + (∑ i in S, f i) a = ∑ i in S, f i a := +(apply_add_hom a : (α →₀ N) →+ _).map_sum _ _ + +@[simp] lemma sum_apply [has_zero M] [add_comm_monoid N] + {f : α →₀ M} {g : α → M → β →₀ N} {a₂ : β} : + (f.sum g) a₂ = f.sum (λa₁ b, g a₁ b a₂) := +finset_sum_apply _ _ _ + +lemma coe_finset_sum [add_comm_monoid N] (S : finset ι) (f : ι → α →₀ N) : + ⇑(∑ i in S, f i) = ∑ i in S, f i := +(coe_fn_add_hom : (α →₀ N) →+ _).map_sum _ _ + +lemma coe_sum [has_zero M] [add_comm_monoid N] (f : α →₀ M) (g : α → M → β →₀ N) : + ⇑(f.sum g) = f.sum (λ a₁ b, g a₁ b) := +coe_finset_sum _ _ + +lemma support_sum [decidable_eq β] [has_zero M] [add_comm_monoid N] + {f : α →₀ M} {g : α → M → (β →₀ N)} : + (f.sum g).support ⊆ f.support.bUnion (λa, (g a (f a)).support) := +have ∀ c, f.sum (λ a b, g a b c) ≠ 0 → (∃ a, f a ≠ 0 ∧ ¬ (g a (f a)) c = 0), + from assume a₁ h, + let ⟨a, ha, ne⟩ := finset.exists_ne_zero_of_sum_ne_zero h in + ⟨a, mem_support_iff.mp ha, ne⟩, +by simpa only [finset.subset_iff, mem_support_iff, finset.mem_bUnion, sum_apply, exists_prop] + +lemma support_finset_sum [decidable_eq β] [add_comm_monoid M] {s : finset α} {f : α → (β →₀ M)} : + (finset.sum s f).support ⊆ s.bUnion (λ x, (f x).support) := +begin + rw ←finset.sup_eq_bUnion, + induction s using finset.cons_induction_on with a s ha ih, + { refl }, + { rw [finset.sum_cons, finset.sup_cons], + exact support_add.trans (finset.union_subset_union (finset.subset.refl _) ih), }, +end + +@[simp] lemma sum_zero [has_zero M] [add_comm_monoid N] {f : α →₀ M} : + f.sum (λa b, (0 : N)) = 0 := +finset.sum_const_zero + +@[simp, to_additive] +lemma prod_mul [has_zero M] [comm_monoid N] {f : α →₀ M} {h₁ h₂ : α → M → N} : + f.prod (λa b, h₁ a b * h₂ a b) = f.prod h₁ * f.prod h₂ := +finset.prod_mul_distrib + +@[simp, to_additive] +lemma prod_inv [has_zero M] [comm_group G] {f : α →₀ M} + {h : α → M → G} : f.prod (λa b, (h a b)⁻¹) = (f.prod h)⁻¹ := +(map_prod ((monoid_hom.id G)⁻¹) _ _).symm + +@[simp] lemma sum_sub [has_zero M] [add_comm_group G] {f : α →₀ M} + {h₁ h₂ : α → M → G} : + f.sum (λa b, h₁ a b - h₂ a b) = f.sum h₁ - f.sum h₂ := +finset.sum_sub_distrib + +/-- Taking the product under `h` is an additive-to-multiplicative homomorphism of finsupps, +if `h` is an additive-to-multiplicative homomorphism on the support. +This is a more general version of `finsupp.prod_add_index'`; the latter has simpler hypotheses. -/ +@[to_additive "Taking the product under `h` is an additive homomorphism of finsupps, +if `h` is an additive homomorphism on the support. +This is a more general version of `finsupp.sum_add_index'`; the latter has simpler hypotheses."] +lemma prod_add_index [decidable_eq α] [add_zero_class M] [comm_monoid N] {f g : α →₀ M} + {h : α → M → N} (h_zero : ∀ a ∈ f.support ∪ g.support, h a 0 = 1) + (h_add : ∀ (a ∈ f.support ∪ g.support) b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : + (f + g).prod h = f.prod h * g.prod h := +begin + rw [finsupp.prod_of_support_subset f (subset_union_left _ g.support) h h_zero, + finsupp.prod_of_support_subset g (subset_union_right f.support _) h h_zero, + ←finset.prod_mul_distrib, + finsupp.prod_of_support_subset (f + g) finsupp.support_add h h_zero], + exact finset.prod_congr rfl (λ x hx, (by apply h_add x hx)), +end + +/-- Taking the product under `h` is an additive-to-multiplicative homomorphism of finsupps, +if `h` is an additive-to-multiplicative homomorphism. +This is a more specialized version of `finsupp.prod_add_index` with simpler hypotheses. -/ +@[to_additive "Taking the sum under `h` is an additive homomorphism of finsupps, +if `h` is an additive homomorphism. +This is a more specific version of `finsupp.sum_add_index` with simpler hypotheses."] +lemma prod_add_index' [add_zero_class M] [comm_monoid N] {f g : α →₀ M} + {h : α → M → N} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : + (f + g).prod h = f.prod h * g.prod h := +by classical; exact prod_add_index (λ a ha, h_zero a) (λ a ha, h_add a) + +@[simp] +lemma sum_hom_add_index [add_zero_class M] [add_comm_monoid N] {f g : α →₀ M} (h : α → M →+ N) : + (f + g).sum (λ x, h x) = f.sum (λ x, h x) + g.sum (λ x, h x) := +sum_add_index' (λ a, (h a).map_zero) (λ a, (h a).map_add) + +@[simp] +lemma prod_hom_add_index [add_zero_class M] [comm_monoid N] {f g : α →₀ M} + (h : α → multiplicative M →* N) : + (f + g).prod (λ a b, h a (multiplicative.of_add b)) = + f.prod (λ a b, h a (multiplicative.of_add b)) * g.prod (λ a b, h a (multiplicative.of_add b)) := +prod_add_index' (λ a, (h a).map_one) (λ a, (h a).map_mul) + + +/-- The canonical isomorphism between families of additive monoid homomorphisms `α → (M →+ N)` +and monoid homomorphisms `(α →₀ M) →+ N`. -/ +def lift_add_hom [add_zero_class M] [add_comm_monoid N] : (α → M →+ N) ≃+ ((α →₀ M) →+ N) := +{ to_fun := λ F, + { to_fun := λ f, f.sum (λ x, F x), + map_zero' := finset.sum_empty, + map_add' := λ _ _, sum_add_index' (λ x, (F x).map_zero) (λ x, (F x).map_add) }, + inv_fun := λ F x, F.comp $ single_add_hom x, + left_inv := λ F, by { ext, simp }, + right_inv := λ F, by { ext, simp }, + map_add' := λ F G, by { ext, simp } } + +@[simp] lemma lift_add_hom_apply [add_comm_monoid M] [add_comm_monoid N] + (F : α → M →+ N) (f : α →₀ M) : + lift_add_hom F f = f.sum (λ x, F x) := +rfl + +@[simp] lemma lift_add_hom_symm_apply [add_comm_monoid M] [add_comm_monoid N] + (F : (α →₀ M) →+ N) (x : α) : + lift_add_hom.symm F x = F.comp (single_add_hom x) := +rfl + +lemma lift_add_hom_symm_apply_apply [add_comm_monoid M] [add_comm_monoid N] + (F : (α →₀ M) →+ N) (x : α) (y : M) : + lift_add_hom.symm F x y = F (single x y) := +rfl + +@[simp] lemma lift_add_hom_single_add_hom [add_comm_monoid M] : + lift_add_hom (single_add_hom : α → M →+ α →₀ M) = add_monoid_hom.id _ := +lift_add_hom.to_equiv.apply_eq_iff_eq_symm_apply.2 rfl + +@[simp] lemma sum_single [add_comm_monoid M] (f : α →₀ M) : + f.sum single = f := +add_monoid_hom.congr_fun lift_add_hom_single_add_hom f + +@[simp] lemma sum_univ_single [add_comm_monoid M] [fintype α] (i : α) (m : M) : + ∑ (j : α), (single i m) j = m := +by simp [single] + +@[simp] lemma sum_univ_single' [add_comm_monoid M] [fintype α] (i : α) (m : M) : + ∑ (j : α), (single j m) i = m := +by simp [single] + +@[simp] lemma lift_add_hom_apply_single [add_comm_monoid M] [add_comm_monoid N] + (f : α → M →+ N) (a : α) (b : M) : + lift_add_hom f (single a b) = f a b := +sum_single_index (f a).map_zero + +@[simp] lemma lift_add_hom_comp_single [add_comm_monoid M] [add_comm_monoid N] (f : α → M →+ N) + (a : α) : + (lift_add_hom f).comp (single_add_hom a) = f a := +add_monoid_hom.ext $ λ b, lift_add_hom_apply_single f a b + +lemma comp_lift_add_hom [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] + (g : N →+ P) (f : α → M →+ N) : + g.comp (lift_add_hom f) = lift_add_hom (λ a, g.comp (f a)) := +lift_add_hom.symm_apply_eq.1 $ funext $ λ a, + by rw [lift_add_hom_symm_apply, add_monoid_hom.comp_assoc, lift_add_hom_comp_single] + +lemma sum_sub_index [add_comm_group β] [add_comm_group γ] {f g : α →₀ β} + {h : α → β → γ} (h_sub : ∀a b₁ b₂, h a (b₁ - b₂) = h a b₁ - h a b₂) : + (f - g).sum h = f.sum h - g.sum h := +(lift_add_hom (λ a, add_monoid_hom.of_map_sub (h a) (h_sub a))).map_sub f g + +@[to_additive] +lemma prod_emb_domain [has_zero M] [comm_monoid N] {v : α →₀ M} {f : α ↪ β} {g : β → M → N} : + (v.emb_domain f).prod g = v.prod (λ a b, g (f a) b) := +begin + rw [prod, prod, support_emb_domain, finset.prod_map], + simp_rw emb_domain_apply, +end + +@[to_additive] +lemma prod_finset_sum_index [add_comm_monoid M] [comm_monoid N] + {s : finset ι} {g : ι → α →₀ M} + {h : α → M → N} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : + ∏ i in s, (g i).prod h = (∑ i in s, g i).prod h := +finset.cons_induction_on s rfl $ λ a s has ih, +by rw [prod_cons, ih, sum_cons, prod_add_index' h_zero h_add] + +@[to_additive] +lemma prod_sum_index + [add_comm_monoid M] [add_comm_monoid N] [comm_monoid P] + {f : α →₀ M} {g : α → M → β →₀ N} + {h : β → N → P} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : + (f.sum g).prod h = f.prod (λa b, (g a b).prod h) := +(prod_finset_sum_index h_zero h_add).symm + +lemma multiset_sum_sum_index + [add_comm_monoid M] [add_comm_monoid N] + (f : multiset (α →₀ M)) (h : α → M → N) + (h₀ : ∀a, h a 0 = 0) (h₁ : ∀ (a : α) (b₁ b₂ : M), h a (b₁ + b₂) = h a b₁ + h a b₂) : + (f.sum.sum h) = (f.map $ λg:α →₀ M, g.sum h).sum := +multiset.induction_on f rfl $ assume a s ih, +by rw [multiset.sum_cons, multiset.map_cons, multiset.sum_cons, sum_add_index' h₀ h₁, ih] + +lemma support_sum_eq_bUnion {α : Type*} {ι : Type*} {M : Type*} [decidable_eq α] + [add_comm_monoid M] + {g : ι → α →₀ M} (s : finset ι) (h : ∀ i₁ i₂, i₁ ≠ i₂ → disjoint (g i₁).support (g i₂).support) : + (∑ i in s, g i).support = s.bUnion (λ i, (g i).support) := +begin + classical, + apply finset.induction_on s, + { simp }, + { intros i s hi, + simp only [hi, sum_insert, not_false_iff, bUnion_insert], + intro hs, + rw [finsupp.support_add_eq, hs], + rw [hs, finset.disjoint_bUnion_right], + intros j hj, + refine h _ _ (ne_of_mem_of_not_mem hj hi).symm } +end + +lemma multiset_map_sum [has_zero M] {f : α →₀ M} {m : β → γ} {h : α → M → multiset β} : + multiset.map m (f.sum h) = f.sum (λa b, (h a b).map m) := +(multiset.map_add_monoid_hom m).map_sum _ f.support + +lemma multiset_sum_sum [has_zero M] [add_comm_monoid N] {f : α →₀ M} {h : α → M → multiset N} : + multiset.sum (f.sum h) = f.sum (λa b, multiset.sum (h a b)) := +(multiset.sum_add_monoid_hom : multiset N →+ N).map_sum _ f.support + + +/-- For disjoint `f1` and `f2`, and function `g`, the product of the products of `g` +over `f1` and `f2` equals the product of `g` over `f1 + f2` -/ +@[to_additive "For disjoint `f1` and `f2`, and function `g`, the sum of the sums of `g` +over `f1` and `f2` equals the sum of `g` over `f1 + f2`"] +lemma prod_add_index_of_disjoint [add_comm_monoid M] {f1 f2 : α →₀ M} + (hd : disjoint f1.support f2.support) {β : Type*} [comm_monoid β] (g : α → M → β) : + (f1 + f2).prod g = f1.prod g * f2.prod g := +have ∀ {f1 f2 : α →₀ M}, disjoint f1.support f2.support → + ∏ x in f1.support, g x (f1 x + f2 x) = f1.prod g := + λ f1 f2 hd, finset.prod_congr rfl (λ x hx, + by simp only [not_mem_support_iff.mp (disjoint_left.mp hd hx), add_zero]), +begin + classical, + simp_rw [← this hd, ← this hd.symm, + add_comm (f2 _), finsupp.prod, support_add_eq hd, prod_union hd, add_apply] +end + +lemma prod_dvd_prod_of_subset_of_dvd [add_comm_monoid M] [comm_monoid N] + {f1 f2 : α →₀ M} {g1 g2 : α → M → N} (h1 : f1.support ⊆ f2.support) + (h2 : ∀ (a : α), a ∈ f1.support → g1 a (f1 a) ∣ g2 a (f2 a)) : + f1.prod g1 ∣ f2.prod g2 := +begin + classical, + simp only [finsupp.prod, finsupp.prod_mul], + rw [←sdiff_union_of_subset h1, prod_union sdiff_disjoint], + apply dvd_mul_of_dvd_right, + apply prod_dvd_prod_of_dvd, + exact h2, +end + +lemma indicator_eq_sum_single [add_comm_monoid M] (s : finset α) (f : Π a ∈ s, M) : + indicator s f = ∑ x in s.attach, single x (f x x.2) := +begin + rw [← sum_single (indicator s f), sum, sum_subset (support_indicator_subset _ _), ← sum_attach], + { refine finset.sum_congr rfl (λ x hx, _), + rw [indicator_of_mem], }, + intros i _ hi, + rw [not_mem_support_iff.mp hi, single_zero], +end + +@[simp, to_additive] +lemma prod_indicator_index [has_zero M] [comm_monoid N] + {s : finset α} (f : Π a ∈ s, M) {h : α → M → N} (h_zero : ∀ a ∈ s, h a 0 = 1) : + (indicator s f).prod h = ∏ x in s.attach, h x (f x x.2) := +begin + rw [prod_of_support_subset _ (support_indicator_subset _ _) h h_zero, ← prod_attach], + refine finset.prod_congr rfl (λ x hx, _), + rw [indicator_of_mem], +end + +end finsupp + + theorem finset.sum_apply' : (∑ k in s, f k) i = ∑ k in s, f k i := (finsupp.apply_add_hom i : (ι →₀ A) →+ A).map_sum f s @@ -40,7 +529,7 @@ by simp_rw [finset.sum_insert has, finsupp.sum_add_index' h0 h1, ih] end section -variables {R S : Type*} [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] +variables [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] lemma finsupp.sum_mul (b : S) (s : α →₀ R) {f : α → R → S} : (s.sum f) * b = s.sum (λ a c, (f a c) * b) := diff --git a/src/algebra/big_operators/intervals.lean b/src/algebra/big_operators/intervals.lean index 8a500766ee19a..32bf54f0133bf 100644 --- a/src/algebra/big_operators/intervals.lean +++ b/src/algebra/big_operators/intervals.lean @@ -8,11 +8,13 @@ import algebra.big_operators.basic import algebra.module.basic import data.nat.interval import tactic.linarith -import tactic.abel /-! # Results about big operators over intervals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove results about big operators over intervals (mostly the `ℕ`-valued `Ico m n`). -/ @@ -33,10 +35,7 @@ variables [comm_monoid β] lemma prod_Ico_add' [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [locally_finite_order α] (f : α → β) (a b c : α) : (∏ x in Ico a b, f (x + c)) = (∏ x in Ico (a + c) (b + c), f x) := -begin - classical, - rw [←image_add_right_Ico, prod_image (λ x hx y hy h, add_right_cancel h)], -end +by { rw [← map_add_right_Ico, prod_map], refl } @[to_additive] lemma prod_Ico_add [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] @@ -234,7 +233,7 @@ section module variables {R M : Type*} [ring R] [add_comm_group M] [module R M] (f : ℕ → R) (g : ℕ → M) {m n : ℕ} open finset -- The partial sum of `g`, starting from zero -local notation `G` n:80 := ∑ i in range n, g i +local notation `G ` n:80 := ∑ i in range n, g i /-- **Summation by parts**, also known as **Abel's lemma** or an **Abel transformation** -/ theorem sum_Ico_by_parts (hmn : m < n) : diff --git a/src/algebra/big_operators/multiset.lean b/src/algebra/big_operators/multiset.lean deleted file mode 100644 index fdeecd970c4e6..0000000000000 --- a/src/algebra/big_operators/multiset.lean +++ /dev/null @@ -1,425 +0,0 @@ -/- -Copyright (c) 2015 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import algebra.group_with_zero.power -import data.list.big_operators -import data.multiset.basic - -/-! -# Sums and products over multisets - -In this file we define products and sums indexed by multisets. This is later used to define products -and sums indexed by finite sets. - -## Main declarations - -* `multiset.prod`: `s.prod f` is the product of `f i` over all `i ∈ s`. Not to be mistaken with - the cartesian product `multiset.product`. -* `multiset.sum`: `s.sum f` is the sum of `f i` over all `i ∈ s`. --/ - -variables {ι α β γ : Type*} - -namespace multiset -section comm_monoid -variables [comm_monoid α] {s t : multiset α} {a : α} {m : multiset ι} {f g : ι → α} - -/-- Product of a multiset given a commutative monoid structure on `α`. - `prod {a, b, c} = a * b * c` -/ -@[to_additive "Sum of a multiset given a commutative additive monoid structure on `α`. - `sum {a, b, c} = a + b + c`"] -def prod : multiset α → α := foldr (*) (λ x y z, by simp [mul_left_comm]) 1 - -@[to_additive] -lemma prod_eq_foldr (s : multiset α) : prod s = foldr (*) (λ x y z, by simp [mul_left_comm]) 1 s := -rfl - -@[to_additive] -lemma prod_eq_foldl (s : multiset α) : prod s = foldl (*) (λ x y z, by simp [mul_right_comm]) 1 s := -(foldr_swap _ _ _ _).trans (by simp [mul_comm]) - -@[simp, norm_cast, to_additive] lemma coe_prod (l : list α) : prod ↑l = l.prod := prod_eq_foldl _ - -@[simp, to_additive] -lemma prod_to_list (s : multiset α) : s.to_list.prod = s.prod := -begin - conv_rhs { rw ←coe_to_list s }, - rw coe_prod, -end - -@[simp, to_additive] lemma prod_zero : @prod α _ 0 = 1 := rfl - -@[simp, to_additive] -lemma prod_cons (a : α) (s) : prod (a ::ₘ s) = a * prod s := foldr_cons _ _ _ _ _ - -@[simp, to_additive] -lemma prod_erase [decidable_eq α] (h : a ∈ s) : a * (s.erase a).prod = s.prod := -by rw [← s.coe_to_list, coe_erase, coe_prod, coe_prod, list.prod_erase ((s.mem_to_list a).2 h)] - -@[simp, to_additive] -lemma prod_singleton (a : α) : prod {a} = a := -by simp only [mul_one, prod_cons, singleton_eq_cons, eq_self_iff_true, prod_zero] - -@[to_additive] -lemma prod_pair (a b : α) : ({a, b} : multiset α).prod = a * b := -by rw [insert_eq_cons, prod_cons, prod_singleton] - -@[simp, to_additive] -lemma prod_add (s t : multiset α) : prod (s + t) = prod s * prod t := -quotient.induction_on₂ s t $ λ l₁ l₂, by simp - -lemma prod_nsmul (m : multiset α) : ∀ (n : ℕ), (n • m).prod = m.prod ^ n -| 0 := by { rw [zero_nsmul, pow_zero], refl } -| (n + 1) := - by rw [add_nsmul, one_nsmul, pow_add, pow_one, prod_add, prod_nsmul n] - -@[simp, to_additive] lemma prod_repeat (a : α) (n : ℕ) : (repeat a n).prod = a ^ n := -by simp [repeat, list.prod_repeat] - -@[to_additive] -lemma pow_count [decidable_eq α] (a : α) : a ^ s.count a = (s.filter (eq a)).prod := -by rw [filter_eq, prod_repeat] - -@[to_additive] -lemma prod_hom [comm_monoid β] (s : multiset α) {F : Type*} [monoid_hom_class F α β] (f : F) : - (s.map f).prod = f s.prod := -quotient.induction_on s $ λ l, by simp only [l.prod_hom f, quot_mk_to_coe, coe_map, coe_prod] - -@[to_additive] -lemma prod_hom' [comm_monoid β] (s : multiset ι) {F : Type*} [monoid_hom_class F α β] (f : F) - (g : ι → α) : (s.map $ λ i, f $ g i).prod = f (s.map g).prod := -by { convert (s.map g).prod_hom f, exact (map_map _ _ _).symm } - -@[to_additive] -lemma prod_hom₂ [comm_monoid β] [comm_monoid γ] (s : multiset ι) (f : α → β → γ) - (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → α) (f₂ : ι → β) : - (s.map $ λ i, f (f₁ i) (f₂ i)).prod = f (s.map f₁).prod (s.map f₂).prod := -quotient.induction_on s $ λ l, - by simp only [l.prod_hom₂ f hf hf', quot_mk_to_coe, coe_map, coe_prod] - -@[to_additive] -lemma prod_hom_rel [comm_monoid β] (s : multiset ι) {r : α → β → Prop} {f : ι → α} {g : ι → β} - (h₁ : r 1 1) (h₂ : ∀ ⦃a b c⦄, r b c → r (f a * b) (g a * c)) : - r (s.map f).prod (s.map g).prod := -quotient.induction_on s $ λ l, - by simp only [l.prod_hom_rel h₁ h₂, quot_mk_to_coe, coe_map, coe_prod] - -@[to_additive] -lemma prod_map_one : prod (m.map (λ i, (1 : α))) = 1 := by rw [map_const, prod_repeat, one_pow] - -@[simp, to_additive] -lemma prod_map_mul : (m.map $ λ i, f i * g i).prod = (m.map f).prod * (m.map g).prod := -m.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _ - -@[to_additive] -lemma prod_map_pow {n : ℕ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n := -m.prod_hom' (pow_monoid_hom n : α →* α) f - -@[to_additive] -lemma prod_map_prod_map (m : multiset β) (n : multiset γ) {f : β → γ → α} : - prod (m.map $ λ a, prod $ n.map $ λ b, f a b) = prod (n.map $ λ b, prod $ m.map $ λ a, f a b) := -multiset.induction_on m (by simp) (λ a m ih, by simp [ih]) - -@[to_additive] -lemma prod_induction (p : α → Prop) (s : multiset α) (p_mul : ∀ a b, p a → p b → p (a * b)) - (p_one : p 1) (p_s : ∀ a ∈ s, p a) : - p s.prod := -begin - rw prod_eq_foldr, - exact foldr_induction (*) (λ x y z, by simp [mul_left_comm]) 1 p s p_mul p_one p_s, -end - -@[to_additive] -lemma prod_induction_nonempty (p : α → Prop) (p_mul : ∀ a b, p a → p b → p (a * b)) - (hs : s ≠ ∅) (p_s : ∀ a ∈ s, p a) : - p s.prod := -begin - revert s, - refine multiset.induction _ _, - { intro h, - exfalso, - simpa using h }, - intros a s hs hsa hpsa, - rw prod_cons, - by_cases hs_empty : s = ∅, - { simp [hs_empty, hpsa a] }, - have hps : ∀ x, x ∈ s → p x, from λ x hxs, hpsa x (mem_cons_of_mem hxs), - exact p_mul a s.prod (hpsa a (mem_cons_self a s)) (hs hs_empty hps), -end - -lemma dvd_prod : a ∈ s → a ∣ s.prod := -quotient.induction_on s (λ l a h, by simpa using list.dvd_prod h) a - -lemma prod_dvd_prod_of_le (h : s ≤ t) : s.prod ∣ t.prod := -begin - obtain ⟨z, rfl⟩ := multiset.le_iff_exists_add.1 h, - simp only [prod_add, dvd_mul_right], -end - -end comm_monoid - -lemma prod_dvd_prod_of_dvd [comm_monoid β] {S : multiset α} (g1 g2 : α → β) - (h : ∀ a ∈ S, g1 a ∣ g2 a) : - (multiset.map g1 S).prod ∣ (multiset.map g2 S).prod := -begin - apply multiset.induction_on' S, { simp }, - intros a T haS _ IH, - simp [mul_dvd_mul (h a haS) IH] -end - - -section add_comm_monoid -variables [add_comm_monoid α] - -/-- `multiset.sum`, the sum of the elements of a multiset, promoted to a morphism of -`add_comm_monoid`s. -/ -def sum_add_monoid_hom : multiset α →+ α := -{ to_fun := sum, - map_zero' := sum_zero, - map_add' := sum_add } - -@[simp] lemma coe_sum_add_monoid_hom : (sum_add_monoid_hom : multiset α → α) = sum := rfl - -end add_comm_monoid - -section comm_monoid_with_zero -variables [comm_monoid_with_zero α] - -lemma prod_eq_zero {s : multiset α} (h : (0 : α) ∈ s) : s.prod = 0 := -begin - rcases multiset.exists_cons_of_mem h with ⟨s', hs'⟩, - simp [hs', multiset.prod_cons] -end - -variables [no_zero_divisors α] [nontrivial α] {s : multiset α} - -lemma prod_eq_zero_iff : s.prod = 0 ↔ (0 : α) ∈ s := -quotient.induction_on s $ λ l, by { rw [quot_mk_to_coe, coe_prod], exact list.prod_eq_zero_iff } - -lemma prod_ne_zero (h : (0 : α) ∉ s) : s.prod ≠ 0 := mt prod_eq_zero_iff.1 h - -end comm_monoid_with_zero - -section comm_group -variables [comm_group α] {m : multiset ι} {f g : ι → α} - -@[simp, to_additive] -lemma prod_map_inv' : (m.map $ λ i, (f i)⁻¹).prod = (m.map f).prod ⁻¹ := -by { convert (m.map f).prod_hom (comm_group.inv_monoid_hom : α →* α), rw map_map, refl } - -@[simp, to_additive] -lemma prod_map_div : (m.map $ λ i, f i / g i).prod = (m.map f).prod / (m.map g).prod := -m.prod_hom₂ (/) mul_div_comm' (div_one' _) _ _ - -@[to_additive] -lemma prod_map_zpow {n : ℤ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n := -by { convert (m.map f).prod_hom (zpow_group_hom _ : α →* α), rw map_map, refl } - -@[simp] lemma coe_inv_monoid_hom : (comm_group.inv_monoid_hom : α → α) = has_inv.inv := rfl - -@[simp, to_additive] -lemma prod_map_inv (m : multiset α) : (m.map has_inv.inv).prod = m.prod⁻¹ := -m.prod_hom (comm_group.inv_monoid_hom : α →* α) - -end comm_group - -section comm_group_with_zero -variables [comm_group_with_zero α] {m : multiset ι} {f g : ι → α} - -@[simp] -lemma prod_map_inv₀ : (m.map $ λ i, (f i)⁻¹).prod = (m.map f).prod ⁻¹ := -by { convert (m.map f).prod_hom (inv_monoid_with_zero_hom : α →*₀ α), rw map_map, refl } - -@[simp] -lemma prod_map_div₀ : (m.map $ λ i, f i / g i).prod = (m.map f).prod / (m.map g).prod := -m.prod_hom₂ (/) (λ _ _ _ _, (div_mul_div_comm₀ _ _ _ _).symm) (div_one _) _ _ - -lemma prod_map_zpow₀ {n : ℤ} : prod (m.map $ λ i, f i ^ n) = (m.map f).prod ^ n := -by { convert (m.map f).prod_hom (zpow_group_hom₀ _ : α →* α), rw map_map, refl } - -end comm_group_with_zero - -section non_unital_non_assoc_semiring -variables [non_unital_non_assoc_semiring α] {a : α} {s : multiset ι} {f : ι → α} - -lemma _root_.commute.multiset_sum_right (s : multiset α) (a : α) (h : ∀ b ∈ s, commute a b) : - commute a s.sum := -begin - induction s using quotient.induction_on, - rw [quot_mk_to_coe, coe_sum], - exact commute.list_sum_right _ _ h, -end - -lemma _root_.commute.multiset_sum_left (s : multiset α) (b : α) (h : ∀ a ∈ s, commute a b) : - commute s.sum b := -(commute.multiset_sum_right _ _ $ λ a ha, (h _ ha).symm).symm - -lemma sum_map_mul_left : sum (s.map (λ i, a * f i)) = a * sum (s.map f) := -multiset.induction_on s (by simp) (λ i s ih, by simp [ih, mul_add]) - -lemma sum_map_mul_right : sum (s.map (λ i, f i * a)) = sum (s.map f) * a := -multiset.induction_on s (by simp) (λ a s ih, by simp [ih, add_mul]) - -end non_unital_non_assoc_semiring - -section semiring -variables [semiring α] - -lemma dvd_sum {a : α} {s : multiset α} : (∀ x ∈ s, a ∣ x) → a ∣ s.sum := -multiset.induction_on s (λ _, dvd_zero _) - (λ x s ih h, by { rw sum_cons, exact dvd_add - (h _ (mem_cons_self _ _)) (ih $ λ y hy, h _ $ mem_cons.2 $ or.inr hy) }) - -end semiring - -/-! ### Order -/ - -section ordered_comm_monoid -variables [ordered_comm_monoid α] {s t : multiset α} {a : α} - -@[to_additive sum_nonneg] -lemma one_le_prod_of_one_le : (∀ x ∈ s, (1 : α) ≤ x) → 1 ≤ s.prod := -quotient.induction_on s $ λ l hl, by simpa using list.one_le_prod_of_one_le hl - -@[to_additive] -lemma single_le_prod : (∀ x ∈ s, (1 : α) ≤ x) → ∀ x ∈ s, x ≤ s.prod := -quotient.induction_on s $ λ l hl x hx, by simpa using list.single_le_prod hl x hx - -@[to_additive sum_le_card_nsmul] -lemma prod_le_pow_card (s : multiset α) (n : α) (h : ∀ x ∈ s, x ≤ n) : s.prod ≤ n ^ s.card := -begin - induction s using quotient.induction_on, - simpa using list.prod_le_pow_card _ _ h, -end - -@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero] -lemma all_one_of_le_one_le_of_prod_eq_one : - (∀ x ∈ s, (1 : α) ≤ x) → s.prod = 1 → ∀ x ∈ s, x = (1 : α) := -begin - apply quotient.induction_on s, - simp only [quot_mk_to_coe, coe_prod, mem_coe], - exact λ l, list.all_one_of_le_one_le_of_prod_eq_one, -end - -@[to_additive] -lemma prod_le_prod_of_rel_le (h : s.rel (≤) t) : s.prod ≤ t.prod := -begin - induction h with _ _ _ _ rh _ rt, - { refl }, - { rw [prod_cons, prod_cons], - exact mul_le_mul' rh rt } -end - -@[to_additive] -lemma prod_map_le_prod (f : α → α) (h : ∀ x, x ∈ s → f x ≤ x) : (s.map f).prod ≤ s.prod := -prod_le_prod_of_rel_le $ rel_map_left.2 $ rel_refl_of_refl_on h - -@[to_additive] -lemma prod_le_sum_prod (f : α → α) (h : ∀ x, x ∈ s → x ≤ f x) : s.prod ≤ (s.map f).prod := -@prod_map_le_prod αᵒᵈ _ _ f h - -@[to_additive card_nsmul_le_sum] -lemma pow_card_le_prod (h : ∀ x ∈ s, a ≤ x) : a ^ s.card ≤ s.prod := -by { rw [←multiset.prod_repeat, ←multiset.map_const], exact prod_map_le_prod _ h } - -end ordered_comm_monoid - -lemma prod_nonneg [ordered_comm_semiring α] {m : multiset α} (h : ∀ a ∈ m, (0 : α) ≤ a) : - 0 ≤ m.prod := -begin - revert h, - refine m.induction_on _ _, - { rintro -, rw prod_zero, exact zero_le_one }, - intros a s hs ih, - rw prod_cons, - exact mul_nonneg (ih _ $ mem_cons_self _ _) (hs $ λ a ha, ih _ $ mem_cons_of_mem ha), -end - -@[to_additive] -lemma prod_eq_one_iff [canonically_ordered_monoid α] {m : multiset α} : - m.prod = 1 ↔ ∀ x ∈ m, x = (1 : α) := -quotient.induction_on m $ λ l, by simpa using list.prod_eq_one_iff l - -@[to_additive] -lemma le_prod_of_mem [canonically_ordered_monoid α] {m : multiset α} {a : α} (h : a ∈ m) : - a ≤ m.prod := -begin - obtain ⟨m', rfl⟩ := exists_cons_of_mem h, - rw [prod_cons], - exact _root_.le_mul_right (le_refl a), -end - -@[to_additive le_sum_of_subadditive_on_pred] -lemma le_prod_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β] - (f : α → β) (p : α → Prop) (h_one : f 1 = 1) (hp_one : p 1) - (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b) - (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hps : ∀ a, a ∈ s → p a) : - f s.prod ≤ (s.map f).prod := -begin - revert s, - refine multiset.induction _ _, - { simp [le_of_eq h_one] }, - intros a s hs hpsa, - have hps : ∀ x, x ∈ s → p x, from λ x hx, hpsa x (mem_cons_of_mem hx), - have hp_prod : p s.prod, from prod_induction p s hp_mul hp_one hps, - rw [prod_cons, map_cons, prod_cons], - exact (h_mul a s.prod (hpsa a (mem_cons_self a s)) hp_prod).trans (mul_le_mul_left' (hs hps) _), -end - -@[to_additive le_sum_of_subadditive] -lemma le_prod_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β] - (f : α → β) (h_one : f 1 = 1) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) : - f s.prod ≤ (s.map f).prod := -le_prod_of_submultiplicative_on_pred f (λ i, true) h_one trivial (λ x y _ _ , h_mul x y) (by simp) - s (by simp) - -@[to_additive le_sum_nonempty_of_subadditive_on_pred] -lemma le_prod_nonempty_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β] - (f : α → β) (p : α → Prop) (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b) - (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hs_nonempty : s ≠ ∅) - (hs : ∀ a, a ∈ s → p a) : - f s.prod ≤ (s.map f).prod := -begin - revert s, - refine multiset.induction _ _, - { intro h, - exfalso, - exact h rfl }, - rintros a s hs hsa_nonempty hsa_prop, - rw [prod_cons, map_cons, prod_cons], - by_cases hs_empty : s = ∅, - { simp [hs_empty] }, - have hsa_restrict : (∀ x, x ∈ s → p x), from λ x hx, hsa_prop x (mem_cons_of_mem hx), - have hp_sup : p s.prod, - from prod_induction_nonempty p hp_mul hs_empty hsa_restrict, - have hp_a : p a, from hsa_prop a (mem_cons_self a s), - exact (h_mul a _ hp_a hp_sup).trans (mul_le_mul_left' (hs hs_empty hsa_restrict) _), -end - -@[to_additive le_sum_nonempty_of_subadditive] -lemma le_prod_nonempty_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β] - (f : α → β) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) (hs_nonempty : s ≠ ∅) : - f s.prod ≤ (s.map f).prod := -le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (by simp [h_mul]) (by simp) s - hs_nonempty (by simp) - -@[simp] lemma sum_map_singleton (s : multiset α) : (s.map (λ a, ({a} : multiset α))).sum = s := -multiset.induction_on s (by simp) (by simp [singleton_eq_cons]) - -lemma abs_sum_le_sum_abs [linear_ordered_add_comm_group α] {s : multiset α} : - abs s.sum ≤ (s.map abs).sum := -le_sum_of_subadditive _ abs_zero abs_add s - -end multiset - -@[to_additive] -lemma map_multiset_prod [comm_monoid α] [comm_monoid β] {F : Type*} [monoid_hom_class F α β] - (f : F) (s : multiset α) : f s.prod = (s.map f).prod := -(s.prod_hom f).symm - -@[to_additive] -protected lemma monoid_hom.map_multiset_prod [comm_monoid α] [comm_monoid β] (f : α →* β) - (s : multiset α) : f s.prod = (s.map f).prod := -(s.prod_hom f).symm diff --git a/src/algebra/big_operators/multiset/basic.lean b/src/algebra/big_operators/multiset/basic.lean new file mode 100644 index 0000000000000..6ca614001b23d --- /dev/null +++ b/src/algebra/big_operators/multiset/basic.lean @@ -0,0 +1,443 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.list.big_operators.basic +import data.multiset.basic + +/-! +# Sums and products over multisets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define products and sums indexed by multisets. This is later used to define products +and sums indexed by finite sets. + +## Main declarations + +* `multiset.prod`: `s.prod f` is the product of `f i` over all `i ∈ s`. Not to be mistaken with + the cartesian product `multiset.product`. +* `multiset.sum`: `s.sum f` is the sum of `f i` over all `i ∈ s`. + +## Implementation notes + +Nov 2022: To speed the Lean 4 port, lemmas requiring extra algebra imports +(`data.list.big_operators.lemmas` rather than `.basic`) have been moved to a separate file, +`algebra.big_operators.multiset.lemmas`. This split does not need to be permanent. +-/ + +variables {ι α β γ : Type*} + +namespace multiset +section comm_monoid +variables [comm_monoid α] {s t : multiset α} {a : α} {m : multiset ι} {f g : ι → α} + +/-- Product of a multiset given a commutative monoid structure on `α`. + `prod {a, b, c} = a * b * c` -/ +@[to_additive "Sum of a multiset given a commutative additive monoid structure on `α`. + `sum {a, b, c} = a + b + c`"] +def prod : multiset α → α := foldr (*) (λ x y z, by simp [mul_left_comm]) 1 + +@[to_additive] +lemma prod_eq_foldr (s : multiset α) : prod s = foldr (*) (λ x y z, by simp [mul_left_comm]) 1 s := +rfl + +@[to_additive] +lemma prod_eq_foldl (s : multiset α) : prod s = foldl (*) (λ x y z, by simp [mul_right_comm]) 1 s := +(foldr_swap _ _ _ _).trans (by simp [mul_comm]) + +@[simp, norm_cast, to_additive] lemma coe_prod (l : list α) : prod ↑l = l.prod := prod_eq_foldl _ + +@[simp, to_additive] +lemma prod_to_list (s : multiset α) : s.to_list.prod = s.prod := +begin + conv_rhs { rw ←coe_to_list s }, + rw coe_prod, +end + +@[simp, to_additive] lemma prod_zero : @prod α _ 0 = 1 := rfl + +@[simp, to_additive] +lemma prod_cons (a : α) (s) : prod (a ::ₘ s) = a * prod s := foldr_cons _ _ _ _ _ + +@[simp, to_additive] +lemma prod_erase [decidable_eq α] (h : a ∈ s) : a * (s.erase a).prod = s.prod := +by rw [← s.coe_to_list, coe_erase, coe_prod, coe_prod, list.prod_erase (mem_to_list.2 h)] + +@[simp, to_additive] +lemma prod_map_erase [decidable_eq ι] {a : ι} (h : a ∈ m) : + f a * ((m.erase a).map f).prod = (m.map f).prod := +by rw [← m.coe_to_list, coe_erase, coe_map, coe_map, coe_prod, coe_prod, + list.prod_map_erase f (mem_to_list.2 h)] + +@[simp, to_additive] +lemma prod_singleton (a : α) : prod {a} = a := +by simp only [mul_one, prod_cons, ←cons_zero, eq_self_iff_true, prod_zero] + +@[to_additive] +lemma prod_pair (a b : α) : ({a, b} : multiset α).prod = a * b := +by rw [insert_eq_cons, prod_cons, prod_singleton] + +@[simp, to_additive] +lemma prod_add (s t : multiset α) : prod (s + t) = prod s * prod t := +quotient.induction_on₂ s t $ λ l₁ l₂, by simp + +lemma prod_nsmul (m : multiset α) : ∀ (n : ℕ), (n • m).prod = m.prod ^ n +| 0 := by { rw [zero_nsmul, pow_zero], refl } +| (n + 1) := + by rw [add_nsmul, one_nsmul, pow_add, pow_one, prod_add, prod_nsmul n] + +@[simp, to_additive] lemma prod_replicate (n : ℕ) (a : α) : (replicate n a).prod = a ^ n := +by simp [replicate, list.prod_replicate] + +@[to_additive] +lemma prod_map_eq_pow_single [decidable_eq ι] (i : ι) (hf : ∀ i' ≠ i, i' ∈ m → f i' = 1) : + (m.map f).prod = f i ^ m.count i := +begin + induction m using quotient.induction_on with l, + simp [list.prod_map_eq_pow_single i f hf], +end + +@[to_additive] +lemma prod_eq_pow_single [decidable_eq α] (a : α) (h : ∀ a' ≠ a, a' ∈ s → a' = 1) : + s.prod = a ^ (s.count a) := +begin + induction s using quotient.induction_on with l, + simp [list.prod_eq_pow_single a h], +end + +@[to_additive] +lemma pow_count [decidable_eq α] (a : α) : a ^ s.count a = (s.filter (eq a)).prod := +by rw [filter_eq, prod_replicate] + +@[to_additive] +lemma prod_hom [comm_monoid β] (s : multiset α) {F : Type*} [monoid_hom_class F α β] (f : F) : + (s.map f).prod = f s.prod := +quotient.induction_on s $ λ l, by simp only [l.prod_hom f, quot_mk_to_coe, coe_map, coe_prod] + +@[to_additive] +lemma prod_hom' [comm_monoid β] (s : multiset ι) {F : Type*} [monoid_hom_class F α β] (f : F) + (g : ι → α) : (s.map $ λ i, f $ g i).prod = f (s.map g).prod := +by { convert (s.map g).prod_hom f, exact (map_map _ _ _).symm } + +@[to_additive] +lemma prod_hom₂ [comm_monoid β] [comm_monoid γ] (s : multiset ι) (f : α → β → γ) + (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → α) (f₂ : ι → β) : + (s.map $ λ i, f (f₁ i) (f₂ i)).prod = f (s.map f₁).prod (s.map f₂).prod := +quotient.induction_on s $ λ l, + by simp only [l.prod_hom₂ f hf hf', quot_mk_to_coe, coe_map, coe_prod] + +@[to_additive] +lemma prod_hom_rel [comm_monoid β] (s : multiset ι) {r : α → β → Prop} {f : ι → α} {g : ι → β} + (h₁ : r 1 1) (h₂ : ∀ ⦃a b c⦄, r b c → r (f a * b) (g a * c)) : + r (s.map f).prod (s.map g).prod := +quotient.induction_on s $ λ l, + by simp only [l.prod_hom_rel h₁ h₂, quot_mk_to_coe, coe_map, coe_prod] + +@[to_additive] +lemma prod_map_one : prod (m.map (λ i, (1 : α))) = 1 := by rw [map_const, prod_replicate, one_pow] + +@[simp, to_additive] +lemma prod_map_mul : (m.map $ λ i, f i * g i).prod = (m.map f).prod * (m.map g).prod := +m.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _ + +@[simp] +lemma prod_map_neg [has_distrib_neg α] (s : multiset α) : + (s.map has_neg.neg).prod = (-1) ^ s.card * s.prod := +by { refine quotient.ind _ s, simp } + +@[to_additive] +lemma prod_map_pow {n : ℕ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n := +m.prod_hom' (pow_monoid_hom n : α →* α) f + +@[to_additive] +lemma prod_map_prod_map (m : multiset β) (n : multiset γ) {f : β → γ → α} : + prod (m.map $ λ a, prod $ n.map $ λ b, f a b) = prod (n.map $ λ b, prod $ m.map $ λ a, f a b) := +multiset.induction_on m (by simp) (λ a m ih, by simp [ih]) + +@[to_additive] +lemma prod_induction (p : α → Prop) (s : multiset α) (p_mul : ∀ a b, p a → p b → p (a * b)) + (p_one : p 1) (p_s : ∀ a ∈ s, p a) : + p s.prod := +begin + rw prod_eq_foldr, + exact foldr_induction (*) (λ x y z, by simp [mul_left_comm]) 1 p s p_mul p_one p_s, +end + +@[to_additive] +lemma prod_induction_nonempty (p : α → Prop) (p_mul : ∀ a b, p a → p b → p (a * b)) + (hs : s ≠ ∅) (p_s : ∀ a ∈ s, p a) : + p s.prod := +begin + revert s, + refine multiset.induction _ _, + { intro h, + exfalso, + simpa using h }, + intros a s hs hsa hpsa, + rw prod_cons, + by_cases hs_empty : s = ∅, + { simp [hs_empty, hpsa a] }, + have hps : ∀ x, x ∈ s → p x, from λ x hxs, hpsa x (mem_cons_of_mem hxs), + exact p_mul a s.prod (hpsa a (mem_cons_self a s)) (hs hs_empty hps), +end + +lemma prod_dvd_prod_of_le (h : s ≤ t) : s.prod ∣ t.prod := +by { obtain ⟨z, rfl⟩ := exists_add_of_le h, simp only [prod_add, dvd_mul_right] } + +end comm_monoid + +lemma prod_dvd_prod_of_dvd [comm_monoid β] {S : multiset α} (g1 g2 : α → β) + (h : ∀ a ∈ S, g1 a ∣ g2 a) : + (multiset.map g1 S).prod ∣ (multiset.map g2 S).prod := +begin + apply multiset.induction_on' S, { simp }, + intros a T haS _ IH, + simp [mul_dvd_mul (h a haS) IH] +end + + +section add_comm_monoid +variables [add_comm_monoid α] + +/-- `multiset.sum`, the sum of the elements of a multiset, promoted to a morphism of +`add_comm_monoid`s. -/ +def sum_add_monoid_hom : multiset α →+ α := +{ to_fun := sum, + map_zero' := sum_zero, + map_add' := sum_add } + +@[simp] lemma coe_sum_add_monoid_hom : (sum_add_monoid_hom : multiset α → α) = sum := rfl + +end add_comm_monoid + +section comm_monoid_with_zero +variables [comm_monoid_with_zero α] + +lemma prod_eq_zero {s : multiset α} (h : (0 : α) ∈ s) : s.prod = 0 := +begin + rcases multiset.exists_cons_of_mem h with ⟨s', hs'⟩, + simp [hs', multiset.prod_cons] +end + +variables [no_zero_divisors α] [nontrivial α] {s : multiset α} + +lemma prod_eq_zero_iff : s.prod = 0 ↔ (0 : α) ∈ s := +quotient.induction_on s $ λ l, by { rw [quot_mk_to_coe, coe_prod], exact list.prod_eq_zero_iff } + +lemma prod_ne_zero (h : (0 : α) ∉ s) : s.prod ≠ 0 := mt prod_eq_zero_iff.1 h + +end comm_monoid_with_zero + +section division_comm_monoid +variables [division_comm_monoid α] {m : multiset ι} {f g : ι → α} + +@[to_additive] lemma prod_map_inv' (m : multiset α) : (m.map has_inv.inv).prod = m.prod⁻¹ := +m.prod_hom (inv_monoid_hom : α →* α) + +@[simp, to_additive] lemma prod_map_inv : (m.map $ λ i, (f i)⁻¹).prod = (m.map f).prod ⁻¹ := +by { convert (m.map f).prod_map_inv', rw map_map } + +@[simp, to_additive] +lemma prod_map_div : (m.map $ λ i, f i / g i).prod = (m.map f).prod / (m.map g).prod := +m.prod_hom₂ (/) mul_div_mul_comm (div_one _) _ _ + +@[to_additive] +lemma prod_map_zpow {n : ℤ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n := +by { convert (m.map f).prod_hom (zpow_group_hom _ : α →* α), rw map_map, refl } + +end division_comm_monoid + +section non_unital_non_assoc_semiring +variables [non_unital_non_assoc_semiring α] {a : α} {s : multiset ι} {f : ι → α} + +lemma sum_map_mul_left : sum (s.map (λ i, a * f i)) = a * sum (s.map f) := +multiset.induction_on s (by simp) (λ i s ih, by simp [ih, mul_add]) + +lemma sum_map_mul_right : sum (s.map (λ i, f i * a)) = sum (s.map f) * a := +multiset.induction_on s (by simp) (λ a s ih, by simp [ih, add_mul]) + +end non_unital_non_assoc_semiring + +section semiring +variables [semiring α] + +lemma dvd_sum {a : α} {s : multiset α} : (∀ x ∈ s, a ∣ x) → a ∣ s.sum := +multiset.induction_on s (λ _, dvd_zero _) + (λ x s ih h, by { rw sum_cons, exact dvd_add + (h _ (mem_cons_self _ _)) (ih $ λ y hy, h _ $ mem_cons.2 $ or.inr hy) }) + +end semiring + +/-! ### Order -/ + +section ordered_comm_monoid +variables [ordered_comm_monoid α] {s t : multiset α} {a : α} + +@[to_additive sum_nonneg] +lemma one_le_prod_of_one_le : (∀ x ∈ s, (1 : α) ≤ x) → 1 ≤ s.prod := +quotient.induction_on s $ λ l hl, by simpa using list.one_le_prod_of_one_le hl + +@[to_additive] +lemma single_le_prod : (∀ x ∈ s, (1 : α) ≤ x) → ∀ x ∈ s, x ≤ s.prod := +quotient.induction_on s $ λ l hl x hx, by simpa using list.single_le_prod hl x hx + +@[to_additive sum_le_card_nsmul] +lemma prod_le_pow_card (s : multiset α) (n : α) (h : ∀ x ∈ s, x ≤ n) : s.prod ≤ n ^ s.card := +begin + induction s using quotient.induction_on, + simpa using list.prod_le_pow_card _ _ h, +end + +@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero] +lemma all_one_of_le_one_le_of_prod_eq_one : + (∀ x ∈ s, (1 : α) ≤ x) → s.prod = 1 → ∀ x ∈ s, x = (1 : α) := +begin + apply quotient.induction_on s, + simp only [quot_mk_to_coe, coe_prod, mem_coe], + exact λ l, list.all_one_of_le_one_le_of_prod_eq_one, +end + +@[to_additive] +lemma prod_le_prod_of_rel_le (h : s.rel (≤) t) : s.prod ≤ t.prod := +begin + induction h with _ _ _ _ rh _ rt, + { refl }, + { rw [prod_cons, prod_cons], + exact mul_le_mul' rh rt } +end + +@[to_additive] +lemma prod_map_le_prod_map {s : multiset ι} (f : ι → α) (g : ι → α) (h : ∀ i, i ∈ s → f i ≤ g i) : + (s.map f).prod ≤ (s.map g).prod := +prod_le_prod_of_rel_le $ rel_map.2 $ rel_refl_of_refl_on h + +@[to_additive] +lemma prod_map_le_prod (f : α → α) (h : ∀ x, x ∈ s → f x ≤ x) : (s.map f).prod ≤ s.prod := +prod_le_prod_of_rel_le $ rel_map_left.2 $ rel_refl_of_refl_on h + +@[to_additive] +lemma prod_le_prod_map (f : α → α) (h : ∀ x, x ∈ s → x ≤ f x) : s.prod ≤ (s.map f).prod := +@prod_map_le_prod αᵒᵈ _ _ f h + +@[to_additive card_nsmul_le_sum] +lemma pow_card_le_prod (h : ∀ x ∈ s, a ≤ x) : a ^ s.card ≤ s.prod := +by { rw [←multiset.prod_replicate, ←multiset.map_const], exact prod_map_le_prod _ h } + +end ordered_comm_monoid + +lemma prod_nonneg [ordered_comm_semiring α] {m : multiset α} (h : ∀ a ∈ m, (0 : α) ≤ a) : + 0 ≤ m.prod := +begin + revert h, + refine m.induction_on _ _, + { rintro -, rw prod_zero, exact zero_le_one }, + intros a s hs ih, + rw prod_cons, + exact mul_nonneg (ih _ $ mem_cons_self _ _) (hs $ λ a ha, ih _ $ mem_cons_of_mem ha), +end + +/-- Slightly more general version of `multiset.prod_eq_one_iff` for a non-ordered `monoid` -/ +@[to_additive "Slightly more general version of `multiset.sum_eq_zero_iff` + for a non-ordered `add_monoid`"] +lemma prod_eq_one [comm_monoid α] {m : multiset α} (h : ∀ x ∈ m, x = (1 : α)) : m.prod = 1 := +begin + induction m using quotient.induction_on with l, + simp [list.prod_eq_one h], +end + +@[to_additive] +lemma le_prod_of_mem [canonically_ordered_monoid α] {m : multiset α} {a : α} (h : a ∈ m) : + a ≤ m.prod := +begin + obtain ⟨m', rfl⟩ := exists_cons_of_mem h, + rw [prod_cons], + exact _root_.le_mul_right (le_refl a), +end + +@[to_additive le_sum_of_subadditive_on_pred] +lemma le_prod_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β] + (f : α → β) (p : α → Prop) (h_one : f 1 = 1) (hp_one : p 1) + (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b) + (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hps : ∀ a, a ∈ s → p a) : + f s.prod ≤ (s.map f).prod := +begin + revert s, + refine multiset.induction _ _, + { simp [le_of_eq h_one] }, + intros a s hs hpsa, + have hps : ∀ x, x ∈ s → p x, from λ x hx, hpsa x (mem_cons_of_mem hx), + have hp_prod : p s.prod, from prod_induction p s hp_mul hp_one hps, + rw [prod_cons, map_cons, prod_cons], + exact (h_mul a s.prod (hpsa a (mem_cons_self a s)) hp_prod).trans (mul_le_mul_left' (hs hps) _), +end + +@[to_additive le_sum_of_subadditive] +lemma le_prod_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β] + (f : α → β) (h_one : f 1 = 1) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) : + f s.prod ≤ (s.map f).prod := +le_prod_of_submultiplicative_on_pred f (λ i, true) h_one trivial (λ x y _ _ , h_mul x y) (by simp) + s (by simp) + +@[to_additive le_sum_nonempty_of_subadditive_on_pred] +lemma le_prod_nonempty_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β] + (f : α → β) (p : α → Prop) (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b) + (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hs_nonempty : s ≠ ∅) + (hs : ∀ a, a ∈ s → p a) : + f s.prod ≤ (s.map f).prod := +begin + revert s, + refine multiset.induction _ _, + { intro h, + exfalso, + exact h rfl }, + rintros a s hs hsa_nonempty hsa_prop, + rw [prod_cons, map_cons, prod_cons], + by_cases hs_empty : s = ∅, + { simp [hs_empty] }, + have hsa_restrict : (∀ x, x ∈ s → p x), from λ x hx, hsa_prop x (mem_cons_of_mem hx), + have hp_sup : p s.prod, + from prod_induction_nonempty p hp_mul hs_empty hsa_restrict, + have hp_a : p a, from hsa_prop a (mem_cons_self a s), + exact (h_mul a _ hp_a hp_sup).trans (mul_le_mul_left' (hs hs_empty hsa_restrict) _), +end + +@[to_additive le_sum_nonempty_of_subadditive] +lemma le_prod_nonempty_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β] + (f : α → β) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) (hs_nonempty : s ≠ ∅) : + f s.prod ≤ (s.map f).prod := +le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (by simp [h_mul]) (by simp) s + hs_nonempty (by simp) + +@[simp] lemma sum_map_singleton (s : multiset α) : (s.map (λ a, ({a} : multiset α))).sum = s := +multiset.induction_on s (by simp) (by simp) + +lemma abs_sum_le_sum_abs [linear_ordered_add_comm_group α] {s : multiset α} : + abs s.sum ≤ (s.map abs).sum := +le_sum_of_subadditive _ abs_zero abs_add s + +lemma sum_nat_mod (s : multiset ℕ) (n : ℕ) : s.sum % n = (s.map (% n)).sum % n := +by induction s using multiset.induction; simp [nat.add_mod, *] + +lemma prod_nat_mod (s : multiset ℕ) (n : ℕ) : s.prod % n = (s.map (% n)).prod % n := +by induction s using multiset.induction; simp [nat.mul_mod, *] + +lemma sum_int_mod (s : multiset ℤ) (n : ℤ) : s.sum % n = (s.map (% n)).sum % n := +by induction s using multiset.induction; simp [int.add_mod, *] + +lemma prod_int_mod (s : multiset ℤ) (n : ℤ) : s.prod % n = (s.map (% n)).prod % n := +by induction s using multiset.induction; simp [int.mul_mod, *] + +end multiset + +@[to_additive] +lemma map_multiset_prod [comm_monoid α] [comm_monoid β] {F : Type*} [monoid_hom_class F α β] + (f : F) (s : multiset α) : f s.prod = (s.map f).prod := +(s.prod_hom f).symm + +@[to_additive] +protected lemma monoid_hom.map_multiset_prod [comm_monoid α] [comm_monoid β] (f : α →* β) + (s : multiset α) : f s.prod = (s.map f).prod := +(s.prod_hom f).symm diff --git a/src/algebra/big_operators/multiset/lemmas.lean b/src/algebra/big_operators/multiset/lemmas.lean new file mode 100644 index 0000000000000..dadbcc8381e52 --- /dev/null +++ b/src/algebra/big_operators/multiset/lemmas.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2019 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Bhavik Mehta, Eric Wieser +-/ +import data.list.big_operators.lemmas +import algebra.big_operators.multiset.basic + +/-! # Lemmas about `multiset.sum` and `multiset.prod` requiring extra algebra imports + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +variables {ι α β γ : Type*} + +namespace multiset + +lemma dvd_prod [comm_monoid α] {s : multiset α} {a : α} : a ∈ s → a ∣ s.prod := +quotient.induction_on s (λ l a h, by simpa using list.dvd_prod h) a + +@[to_additive] +lemma prod_eq_one_iff [canonically_ordered_monoid α] {m : multiset α} : + m.prod = 1 ↔ ∀ x ∈ m, x = (1 : α) := +quotient.induction_on m $ λ l, by simpa using list.prod_eq_one_iff l + +end multiset + +open multiset + +namespace commute +variables [non_unital_non_assoc_semiring α] {a : α} {s : multiset ι} {f : ι → α} + +lemma multiset_sum_right (s : multiset α) (a : α) (h : ∀ b ∈ s, commute a b) : + commute a s.sum := +begin + induction s using quotient.induction_on, + rw [quot_mk_to_coe, coe_sum], + exact commute.list_sum_right _ _ h, +end + +lemma multiset_sum_left (s : multiset α) (b : α) (h : ∀ a ∈ s, commute a b) : + commute s.sum b := +(commute.multiset_sum_right _ _ $ λ a ha, (h _ ha).symm).symm + +end commute diff --git a/src/algebra/big_operators/nat_antidiagonal.lean b/src/algebra/big_operators/nat_antidiagonal.lean index 3a9b8428ab5d3..29f5411651071 100644 --- a/src/algebra/big_operators/nat_antidiagonal.lean +++ b/src/algebra/big_operators/nat_antidiagonal.lean @@ -10,6 +10,9 @@ import algebra.big_operators.basic /-! # Big operators for `nat_antidiagonal` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains theorems relevant to big operators over `finset.nat.antidiagonal`. -/ @@ -23,10 +26,7 @@ namespace nat lemma prod_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → M} : ∏ p in antidiagonal (n + 1), f p = f (0, n + 1) * ∏ p in antidiagonal n, f (p.1 + 1, p.2) := begin - rw [antidiagonal_succ, prod_insert, prod_map], refl, - intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩, - simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2, - apply nat.succ_ne_zero a h2.1, + rw [antidiagonal_succ, prod_cons, prod_map], refl, end lemma sum_antidiagonal_succ {n : ℕ} {f : ℕ × ℕ → N} : diff --git a/src/algebra/big_operators/norm_num.lean b/src/algebra/big_operators/norm_num.lean index f410d99c47343..d950f11219ca6 100644 --- a/src/algebra/big_operators/norm_num.lean +++ b/src/algebra/big_operators/norm_num.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ import algebra.big_operators.basic +import data.int.interval import tactic.norm_num /-! ### `norm_num` plugin for big operators +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This `norm_num` plugin provides support for computing sums and products of lists, multisets and finsets. @@ -83,72 +87,6 @@ meta def list.decide_mem (decide_eq : expr → expr → tactic (bool × expr)) : pf ← i_to_expr ``(list.not_mem_cons %%head_pf %%tail_pf), pure (ff, pf) -lemma finset.insert_eq_coe_list_of_mem {α : Type*} [decidable_eq α] (x : α) (xs : finset α) - {xs' : list α} (h : x ∈ xs') (nd_xs : xs'.nodup) - (hxs' : xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs)) : - insert x xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs) := -have h : x ∈ xs, by simpa [hxs'] using h, -by rw [finset.insert_eq_of_mem h, hxs'] - -lemma finset.insert_eq_coe_list_cons {α : Type*} [decidable_eq α] (x : α) (xs : finset α) - {xs' : list α} (h : x ∉ xs') (nd_xs : xs'.nodup) (nd_xxs : (x :: xs').nodup) - (hxs' : xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs)) : - insert x xs = finset.mk ↑(x :: xs') (multiset.coe_nodup.mpr nd_xxs) := -have h : x ∉ xs, by simpa [hxs'] using h, -by { rw [← finset.val_inj, finset.insert_val_of_not_mem h, hxs'], simp only [multiset.cons_coe] } - -/-- Convert an expression denoting a finset to a list of elements, -a proof that this list is equal to the original finset, -and a proof that the list contains no duplicates. - -We return a list rather than a finset, so we can more easily iterate over it -(without having to prove that our tactics are independent of the order of iteration, -which is in general not true). - -`decide_eq` is a (partial) decision procedure for determining whether two -elements of the finset are equal, for example to parse `{2, 1, 2}` into `[2, 1]`. --/ -meta def eval_finset (decide_eq : expr → expr → tactic (bool × expr)) : - expr → tactic (list expr × expr × expr) -| e@`(has_emptyc.emptyc) := do - eq ← mk_eq_refl e, - nd ← i_to_expr ``(list.nodup_nil), - pure ([], eq, nd) -| e@`(has_singleton.singleton %%x) := do - eq ← mk_eq_refl e, - nd ← i_to_expr ``(list.nodup_singleton %%x), - pure ([x], eq, nd) -| `(@@has_insert.insert (@@finset.has_insert %%dec) %%x %%xs) := do - (exs, xs_eq, xs_nd) ← eval_finset xs, - (is_mem, mem_pf) ← list.decide_mem decide_eq x exs, - if is_mem then do - pf ← i_to_expr ``(finset.insert_eq_coe_list_of_mem %%x %%xs %%mem_pf %%xs_nd %%xs_eq), - pure (exs, pf, xs_nd) - else do - nd ← i_to_expr ``(list.nodup_cons.mpr ⟨%%mem_pf, %%xs_nd⟩), - pf ← i_to_expr ``(finset.insert_eq_coe_list_cons %%x %%xs %%mem_pf %%xs_nd %%nd %%xs_eq), - pure (x :: exs, pf, nd) -| `(@@finset.univ %%ft) := do - -- Convert the fintype instance expression `ft` to a list of its elements. - -- Unfold it to the `fintype.mk` constructor and a list of arguments. - `fintype.mk ← get_app_fn_const_whnf ft - | fail (to_fmt "Unknown fintype expression" ++ format.line ++ to_fmt ft), - [_, args, _] ← get_app_args_whnf ft | fail (to_fmt "Expected 3 arguments to `fintype.mk`"), - eval_finset args -| e@`(finset.range %%en) := do - n ← expr.to_nat en, - eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i), - eq ← mk_eq_refl e, - nd ← i_to_expr ``(list.nodup_range %%en), - pure (eis, eq, nd) -| e@`(finset.fin_range %%en) := do - n ← expr.to_nat en, - eis ← (list.fin_range n).mmap (λ i, expr.of_nat `(fin %%en) i), - eq ← mk_eq_refl e, - nd ← i_to_expr ``(list.nodup_fin_range %%en), - pure (eis, eq, nd) -| e := fail (to_fmt "Unknown finset expression" ++ format.line ++ to_fmt e) - lemma list.map_cons_congr {α β : Type*} (f : α → β) {x : α} {xs : list α} {fx : β} {fxs : list β} (h₁ : f x = fx) (h₂ : xs.map f = fxs) : (x :: xs).map f = fx :: fxs := by rw [list.map_cons, h₁, h₂] @@ -164,6 +102,41 @@ meta def eval_list_map (ef : expr) : list expr → tactic (list expr × expr) eq ← i_to_expr ``(list.map_cons_congr %%ef %%fx_eq %%fxs_eq), pure (fx :: fxs, eq) +lemma list.cons_congr {α : Type*} (x : α) {xs : list α} {xs' : list α} (xs_eq : xs' = xs) : + x :: xs' = x :: xs := +by rw xs_eq + +lemma list.map_congr {α β : Type*} (f : α → β) {xs xs' : list α} + {ys : list β} (xs_eq : xs = xs') (ys_eq : xs'.map f = ys) : + xs.map f = ys := +by rw [← ys_eq, xs_eq] + +/-- Convert an expression denoting a list to a list of elements. -/ +meta def eval_list : expr → tactic (list expr × expr) +| e@`(list.nil) := do + eq ← mk_eq_refl e, + pure ([], eq) +| e@`(list.cons %%x %%xs) := do + (xs, xs_eq) ← eval_list xs, + eq ← i_to_expr ``(list.cons_congr %%x %%xs_eq), + pure (x :: xs, eq) +| e@`(list.range %%en) := do + n ← expr.to_nat en, + eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i), + eq ← mk_eq_refl e, + pure (eis, eq) +| `(@list.map %%α %%β %%ef %%exs) := do + (xs, xs_eq) ← eval_list exs, + (ys, ys_eq) ← eval_list_map ef xs, + eq ← i_to_expr ``(list.map_congr %%ef %%xs_eq %%ys_eq), + pure (ys, eq) +| e@`(@list.fin_range %%en) := do + n ← expr.to_nat en, + eis ← (list.fin_range n).mmap (λ i, expr.of_nat `(fin %%en) i), + eq ← mk_eq_refl e, + pure (eis, eq) +| e := fail (to_fmt "Unknown list expression" ++ format.line ++ to_fmt e) + lemma multiset.cons_congr {α : Type*} (x : α) {xs : multiset α} {xs' : list α} (xs_eq : (xs' : multiset α) = xs) : (list.cons x xs' : multiset α) = x ::ₘ xs := by rw [← xs_eq]; refl @@ -202,6 +175,10 @@ meta def eval_multiset : expr → tactic (list expr × expr) eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i), eq ← mk_eq_refl e, pure (eis, eq) +| `(@@coe (@@coe_to_lift (@@coe_base (multiset.has_coe))) %%exs) := do + (xs, xs_eq) ← eval_list exs, + eq ← i_to_expr ``(congr_arg coe %%xs_eq), + pure (xs, eq) | `(@multiset.map %%α %%β %%ef %%exs) := do (xs, xs_eq) ← eval_multiset exs, (ys, ys_eq) ← eval_list_map ef xs, @@ -209,35 +186,110 @@ meta def eval_multiset : expr → tactic (list expr × expr) pure (ys, eq) | e := fail (to_fmt "Unknown multiset expression" ++ format.line ++ to_fmt e) -lemma list.cons_congr {α : Type*} (x : α) {xs : list α} {xs' : list α} (xs_eq : xs' = xs) : - x :: xs' = x :: xs := -by rw xs_eq +lemma finset.mk_congr {α : Type*} {xs xs' : multiset α} (h : xs = xs') (nd nd') : + finset.mk xs nd = finset.mk xs' nd' := +by congr; assumption -lemma list.map_congr {α β : Type*} (f : α → β) {xs xs' : list α} - {ys : list β} (xs_eq : xs = xs') (ys_eq : xs'.map f = ys) : - xs.map f = ys := -by rw [← ys_eq, xs_eq] +lemma finset.insert_eq_coe_list_of_mem {α : Type*} [decidable_eq α] (x : α) (xs : finset α) + {xs' : list α} (h : x ∈ xs') (nd_xs : xs'.nodup) + (hxs' : xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs)) : + insert x xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs) := +have h : x ∈ xs, by simpa [hxs'] using h, +by rw [finset.insert_eq_of_mem h, hxs'] -/-- Convert an expression denoting a list to a list of elements. -/ -meta def eval_list : expr → tactic (list expr × expr) -| e@`(list.nil) := do +lemma finset.insert_eq_coe_list_cons {α : Type*} [decidable_eq α] (x : α) (xs : finset α) + {xs' : list α} (h : x ∉ xs') (nd_xs : xs'.nodup) (nd_xxs : (x :: xs').nodup) + (hxs' : xs = finset.mk ↑xs' (multiset.coe_nodup.mpr nd_xs)) : + insert x xs = finset.mk ↑(x :: xs') (multiset.coe_nodup.mpr nd_xxs) := +have h : x ∉ xs, by simpa [hxs'] using h, +by { rw [← finset.val_inj, finset.insert_val_of_not_mem h, hxs'], simp only [multiset.cons_coe] } + +/-- For now this only works on types that are contiguous subsets of the integers -/ +meta def eval_finset_interval : + expr → tactic (option (list expr × expr × expr)) +| e@`(@finset.Icc %%α %%inst_1 %%inst_2 %%ea %%eb) := do + a ← expr.to_int ea, + b ← expr.to_int eb, + eis ← (finset.Icc a b).val.unquot.mmap (λ i, expr.of_int α i), eq ← mk_eq_refl e, - pure ([], eq) -| e@`(list.cons %%x %%xs) := do - (xs, xs_eq) ← eval_list xs, - eq ← i_to_expr ``(list.cons_congr %%x %%xs_eq), - pure (x :: xs, eq) -| e@`(list.range %%en) := do + nd ← i_to_expr ``(finset.nodup %%e), + pure (eis, eq, nd) +| e@`(@finset.Ico %%α %%inst_1 %%inst_2 %%ea %%eb) := do + a ← expr.to_int ea, + b ← expr.to_int eb, + eis ← (finset.Ico a b).val.unquot.mmap (λ i, expr.of_int α i), + eq ← mk_eq_refl e, + nd ← i_to_expr ``(finset.nodup %%e), + pure (eis, eq, nd) +| e@`(@finset.Ioc %%α %%inst_1 %%inst_2 %%ea %%eb) := do + a ← expr.to_int ea, + b ← expr.to_int eb, + eis ← (finset.Ioc a b).val.unquot.mmap (λ i, expr.of_int α i), + eq ← mk_eq_refl e, + nd ← i_to_expr ``(finset.nodup %%e), + pure (eis, eq, nd) +| e@`(@finset.Ioo %%α %%inst_1 %%inst_2 %%ea %%eb) := do + a ← expr.to_int ea, + b ← expr.to_int eb, + eis ← (finset.Ioo a b).val.unquot.mmap (λ i, expr.of_int α i), + eq ← mk_eq_refl e, + nd ← i_to_expr ``(finset.nodup %%e), + pure (eis, eq, nd) +| _ := pure none + +/-- Convert an expression denoting a finset to a list of elements, +a proof that this list is equal to the original finset, +and a proof that the list contains no duplicates. + +We return a list rather than a finset, so we can more easily iterate over it +(without having to prove that our tactics are independent of the order of iteration, +which is in general not true). + +`decide_eq` is a (partial) decision procedure for determining whether two +elements of the finset are equal, for example to parse `{2, 1, 2}` into `[2, 1]`. +-/ +meta def eval_finset (decide_eq : expr → expr → tactic (bool × expr)) : + expr → tactic (list expr × expr × expr) +| e@`(finset.mk %%val %%nd) := do + (val', eq) ← eval_multiset val, + eq' ← i_to_expr ``(finset.mk_congr %%eq _ _), + pure (val', eq', nd) +| e@`(has_emptyc.emptyc) := do + eq ← mk_eq_refl e, + nd ← i_to_expr ``(list.nodup_nil), + pure ([], eq, nd) +| e@`(has_singleton.singleton %%x) := do + eq ← mk_eq_refl e, + nd ← i_to_expr ``(list.nodup_singleton %%x), + pure ([x], eq, nd) +| `(@@has_insert.insert (@@finset.has_insert %%dec) %%x %%xs) := do + (exs, xs_eq, xs_nd) ← eval_finset xs, + (is_mem, mem_pf) ← list.decide_mem decide_eq x exs, + if is_mem then do + pf ← i_to_expr ``(finset.insert_eq_coe_list_of_mem %%x %%xs %%mem_pf %%xs_nd %%xs_eq), + pure (exs, pf, xs_nd) + else do + nd ← i_to_expr ``(list.nodup_cons.mpr ⟨%%mem_pf, %%xs_nd⟩), + pf ← i_to_expr ``(finset.insert_eq_coe_list_cons %%x %%xs %%mem_pf %%xs_nd %%nd %%xs_eq), + pure (x :: exs, pf, nd) +| `(@@finset.univ %%ft) := do + -- Convert the fintype instance expression `ft` to a list of its elements. + -- Unfold it to the `fintype.mk` constructor and a list of arguments. + `fintype.mk ← get_app_fn_const_whnf ft + | fail (to_fmt "Unknown fintype expression" ++ format.line ++ to_fmt ft), + [_, args, _] ← get_app_args_whnf ft | fail (to_fmt "Expected 3 arguments to `fintype.mk`"), + eval_finset args +| e@`(finset.range %%en) := do n ← expr.to_nat en, eis ← (list.range n).mmap (λ i, expr.of_nat `(ℕ) i), eq ← mk_eq_refl e, - pure (eis, eq) -| `(@list.map %%α %%β %%ef %%exs) := do - (xs, xs_eq) ← eval_list exs, - (ys, ys_eq) ← eval_list_map ef xs, - eq ← i_to_expr ``(list.map_congr %%ef %%xs_eq %%ys_eq), - pure (ys, eq) -| e := fail (to_fmt "Unknown list expression" ++ format.line ++ to_fmt e) + nd ← i_to_expr ``(list.nodup_range %%en), + pure (eis, eq, nd) +| e := do + -- try some other parsers + some v ← eval_finset_interval e | + fail (to_fmt "Unknown finset expression" ++ format.line ++ to_fmt e), + pure v @[to_additive] lemma list.prod_cons_congr {α : Type*} [monoid α] (xs : list α) (x y z : α) diff --git a/src/algebra/big_operators/option.lean b/src/algebra/big_operators/option.lean index a849bed837424..560824c0e2b79 100644 --- a/src/algebra/big_operators/option.lean +++ b/src/algebra/big_operators/option.lean @@ -10,6 +10,9 @@ import data.finset.option /-! # Lemmas about products and sums over finite sets in `option α` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove formulas for products and sums over `finset.insert_none s` and `finset.erase_none s`. -/ @@ -26,11 +29,11 @@ variables {α M : Type*} [comm_monoid M] by simp [insert_none] @[to_additive] lemma prod_erase_none (f : α → M) (s : finset (option α)) : - ∏ x in s.erase_none, f x = ∏ x in s, option.elim x 1 f := + ∏ x in s.erase_none, f x = ∏ x in s, option.elim 1 f x := by classical; -calc ∏ x in s.erase_none, f x = ∏ x in s.erase_none.map embedding.some, option.elim x 1 f : - (prod_map s.erase_none embedding.some (λ x, option.elim x 1 f)).symm -... = ∏ x in s.erase none, option.elim x 1 f : by rw map_some_erase_none -... = ∏ x in s, option.elim x 1 f : prod_erase _ rfl +calc ∏ x in s.erase_none, f x = ∏ x in s.erase_none.map embedding.some, option.elim 1 f x : + (prod_map s.erase_none embedding.some $ option.elim 1 f).symm +... = ∏ x in s.erase none, option.elim 1 f x : by rw map_some_erase_none +... = ∏ x in s, option.elim 1 f x : prod_erase _ rfl end finset diff --git a/src/algebra/big_operators/order.lean b/src/algebra/big_operators/order.lean index 8c7030a2ecf03..cda6b956aaa63 100644 --- a/src/algebra/big_operators/order.lean +++ b/src/algebra/big_operators/order.lean @@ -5,11 +5,16 @@ Authors: Johannes Hölzl -/ import algebra.order.absolute_value +import algebra.order.ring.with_top import algebra.big_operators.basic +import data.fintype.card /-! # Results about big operators with values in an ordered algebraic structure. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Mostly monotonicity results for the `∏` and `∑` operations. -/ @@ -105,14 +110,8 @@ variables {f g : ι → N} {s t : finset ι} equal to the corresponding factor `g i` of another finite product, then `∏ i in s, f i ≤ ∏ i in s, g i`. -/ @[to_additive sum_le_sum] -lemma prod_le_prod'' (h : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i ≤ ∏ i in s, g i := -begin - classical, - induction s using finset.induction_on with i s hi ihs h, - { refl }, - { simp only [prod_insert hi], - exact mul_le_mul' (h _ (mem_insert_self _ _)) (ihs $ λ j hj, h j (mem_insert_of_mem hj)) } -end +lemma prod_le_prod' (h : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i ≤ ∏ i in s, g i := +multiset.prod_map_le_prod_map f g h /-- In an ordered additive commutative monoid, if each summand `f i` of one finite sum is less than or equal to the corresponding summand `g i` of another finite sum, then @@ -120,14 +119,14 @@ or equal to the corresponding summand `g i` of another finite sum, then add_decl_doc sum_le_sum @[to_additive sum_nonneg] lemma one_le_prod' (h : ∀i ∈ s, 1 ≤ f i) : 1 ≤ (∏ i in s, f i) := -le_trans (by rw prod_const_one) (prod_le_prod'' h) +le_trans (by rw prod_const_one) (prod_le_prod' h) @[to_additive finset.sum_nonneg'] lemma one_le_prod'' (h : ∀ (i : ι), 1 ≤ f i) : 1 ≤ ∏ (i : ι) in s, f i := finset.one_le_prod' (λ i hi, h i) @[to_additive sum_nonpos] lemma prod_le_one' (h : ∀i ∈ s, f i ≤ 1) : (∏ i in s, f i) ≤ 1 := -(prod_le_prod'' h).trans_eq (by rw prod_const_one) +(prod_le_prod' h).trans_eq (by rw prod_const_one) @[to_additive sum_le_sum_of_subset_of_nonneg] lemma prod_le_prod_of_subset_of_one_le' (h : s ⊆ t) (hf : ∀ i ∈ t, i ∉ s → 1 ≤ f i) : @@ -175,7 +174,7 @@ lemma prod_le_pow_card (s : finset ι) (f : ι → N) (n : N) (h : ∀ x ∈ s, begin refine (multiset.prod_le_pow_card (s.val.map f) n _).trans _, { simpa using h }, - { simpa } + { simp } end @[to_additive card_nsmul_le_sum] @@ -368,7 +367,7 @@ begin classical, rcases Hlt with ⟨i, hi, hlt⟩, rw [← insert_erase hi, prod_insert (not_mem_erase _ _), prod_insert (not_mem_erase _ _)], - exact mul_lt_mul_of_lt_of_le hlt (prod_le_prod'' $ λ j hj, Hle j $ mem_of_mem_erase hj) + exact mul_lt_mul_of_lt_of_le hlt (prod_le_prod' $ λ j hj, Hle j $ mem_of_mem_erase hj) end @[to_additive sum_lt_sum_of_nonempty] @@ -417,6 +416,14 @@ lt_of_le_of_lt (by rw prod_const_one) $ prod_lt_prod_of_nonempty' hs h (∏ i in s, f i) < 1 := (prod_lt_prod_of_nonempty' hs h).trans_le (by rw prod_const_one) +@[to_additive sum_pos'] lemma one_lt_prod' (h : ∀ i ∈ s, 1 ≤ f i) (hs : ∃ i ∈ s, 1 < f i) : + 1 < (∏ i in s, f i) := +prod_const_one.symm.trans_lt $ prod_lt_prod' h hs + +@[to_additive] lemma prod_lt_one' (h : ∀ i ∈ s, f i ≤ 1) (hs : ∃ i ∈ s, f i < 1) : + ∏ i in s, f i < 1 := +prod_const_one.le.trans_lt' $ prod_lt_prod' h hs + @[to_additive] lemma prod_eq_prod_iff_of_le {f g : ι → M} (h : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i = ∏ i in s, g i ↔ ∀ i ∈ s, f i = g i := begin @@ -425,7 +432,7 @@ begin refine finset.induction_on s (λ _, ⟨λ _ _, false.elim, λ _, rfl⟩) (λ a s ha ih H, _), specialize ih (λ i, H i ∘ finset.mem_insert_of_mem), rw [finset.prod_insert ha, finset.prod_insert ha, finset.forall_mem_insert, ←ih], - exact mul_eq_mul_iff_eq_and_eq (H a (s.mem_insert_self a)) (finset.prod_le_prod'' + exact mul_eq_mul_iff_eq_and_eq (H a (s.mem_insert_self a)) (finset.prod_le_prod' (λ i, H i ∘ finset.mem_insert_of_mem)), end @@ -440,7 +447,7 @@ theorem exists_lt_of_prod_lt' (Hlt : ∏ i in s, f i < ∏ i in s, g i) : ∃ i ∈ s, f i < g i := begin contrapose! Hlt with Hle, - exact prod_le_prod'' Hle + exact prod_le_prod' Hle end @[to_additive exists_le_of_sum_le] @@ -470,17 +477,12 @@ section ordered_comm_semiring variables [ordered_comm_semiring R] {f g : ι → R} {s t : finset ι} open_locale classical -/- this is also true for a ordered commutative multiplicative monoid -/ +/- this is also true for a ordered commutative multiplicative monoid with zero -/ lemma prod_nonneg (h0 : ∀ i ∈ s, 0 ≤ f i) : 0 ≤ ∏ i in s, f i := prod_induction f (λ i, 0 ≤ i) (λ _ _ ha hb, mul_nonneg ha hb) zero_le_one h0 -/- this is also true for a ordered commutative multiplicative monoid -/ -lemma prod_pos [nontrivial R] (h0 : ∀ i ∈ s, 0 < f i) : - 0 < ∏ i in s, f i := -prod_induction f (λ x, 0 < x) (λ _ _ ha hb, mul_pos ha hb) zero_lt_one h0 - /-- If all `f i`, `i ∈ s`, are nonnegative and each `f i` is less than or equal to `g i`, then the -product of `f i` is less than or equal to the product of `g i`. See also `finset.prod_le_prod''` for +product of `f i` is less than or equal to the product of `g i`. See also `finset.prod_le_prod'` for the case of an ordered commutative multiplicative monoid. -/ lemma prod_le_prod (h0 : ∀ i ∈ s, 0 ≤ f i) (h1 : ∀ i ∈ s, f i ≤ g i) : ∏ i in s, f i ≤ ∏ i in s, g i := @@ -521,22 +523,34 @@ end end ordered_comm_semiring +section strict_ordered_comm_semiring +variables [strict_ordered_comm_semiring R] [nontrivial R] {f : ι → R} {s : finset ι} + +/- This is also true for a ordered commutative multiplicative monoid with zero -/ +lemma prod_pos (h0 : ∀ i ∈ s, 0 < f i) : 0 < ∏ i in s, f i := +prod_induction f (λ x, 0 < x) (λ _ _ ha hb, mul_pos ha hb) zero_lt_one h0 + +end strict_ordered_comm_semiring + section canonically_ordered_comm_semiring variables [canonically_ordered_comm_semiring R] {f g h : ι → R} {s : finset ι} {i : ι} -lemma prod_le_prod' (h : ∀ i ∈ s, f i ≤ g i) : - ∏ i in s, f i ≤ ∏ i in s, g i := +@[simp] +lemma _root_.canonically_ordered_comm_semiring.multiset_prod_pos [nontrivial R] {m : multiset R} : + 0 < m.prod ↔ (∀ x ∈ m, (0 : R) < x) := begin - classical, - induction s using finset.induction with a s has ih h, - { simp }, - { rw [finset.prod_insert has, finset.prod_insert has], - apply mul_le_mul', - { exact h _ (finset.mem_insert_self a s) }, - { exact ih (λ i hi, h _ (finset.mem_insert_of_mem hi)) } } + induction m using quotient.induction_on, + rw [multiset.quot_mk_to_coe, multiset.coe_prod], + exact canonically_ordered_comm_semiring.list_prod_pos, end +/-- Note that the name is to match `canonically_ordered_comm_semiring.mul_pos`. -/ +@[simp] +lemma _root_.canonically_ordered_comm_semiring.prod_pos [nontrivial R] : + 0 < ∏ i in s, f i ↔ (∀ i ∈ s, (0 : R) < f i) := +canonically_ordered_comm_semiring.multiset_prod_pos.trans $ by simp + /-- If `g, h ≤ f` and `g i + h i ≤ f i`, then the product of `f` over `s` is at least the sum of the products of `g` and `h`. This is the version for `canonically_ordered_comm_semiring`. -/ @@ -561,7 +575,7 @@ variables [fintype ι] @[to_additive sum_mono, mono] lemma prod_mono' [ordered_comm_monoid M] : monotone (λ f : ι → M, ∏ i, f i) := -λ f g hfg, finset.prod_le_prod'' $ λ x _, hfg x +λ f g hfg, finset.prod_le_prod' $ λ x _, hfg x attribute [mono] sum_mono @@ -576,34 +590,26 @@ namespace with_top open finset /-- A product of finite numbers is still finite -/ -lemma prod_lt_top [canonically_ordered_comm_semiring R] [nontrivial R] [decidable_eq R] - {s : finset ι} {f : ι → with_top R} (h : ∀ i ∈ s, f i ≠ ⊤) : +lemma prod_lt_top [comm_monoid_with_zero R] [no_zero_divisors R] [nontrivial R] [decidable_eq R] + [has_lt R] {s : finset ι} {f : ι → with_top R} (h : ∀ i ∈ s, f i ≠ ⊤) : ∏ i in s, f i < ⊤ := -prod_induction f (λ a, a < ⊤) (λ a b h₁ h₂, mul_lt_top h₁.ne h₂.ne) (coe_lt_top 1) $ - λ a ha, lt_top_iff_ne_top.2 (h a ha) - -/-- A sum of finite numbers is still finite -/ -lemma sum_lt_top [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} - (h : ∀ i ∈ s, f i ≠ ⊤) : (∑ i in s, f i) < ⊤ := -sum_induction f (λ a, a < ⊤) (λ a b h₁ h₂, add_lt_top.2 ⟨h₁, h₂⟩) zero_lt_top $ - λ i hi, lt_top_iff_ne_top.2 (h i hi) +prod_induction f (λ a, a < ⊤) (λ a b h₁ h₂, mul_lt_top' h₁ h₂) (coe_lt_top 1) $ + λ a ha, with_top.lt_top_iff_ne_top.2 (h a ha) /-- A sum of numbers is infinite iff one of them is infinite -/ -lemma sum_eq_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} : +lemma sum_eq_top_iff [add_comm_monoid M] {s : finset ι} {f : ι → with_top M} : ∑ i in s, f i = ⊤ ↔ ∃ i ∈ s, f i = ⊤ := -begin - classical, - split, - { contrapose!, - exact λ h, (sum_lt_top $ λ i hi, (h i hi)).ne }, - { rintro ⟨i, his, hi⟩, - rw [sum_eq_add_sum_diff_singleton his, hi, top_add] } -end +by induction s using finset.cons_induction; simp [*, or_and_distrib_right, exists_or_distrib] /-- A sum of finite numbers is still finite -/ -lemma sum_lt_top_iff [ordered_add_comm_monoid M] {s : finset ι} {f : ι → with_top M} : +lemma sum_lt_top_iff [add_comm_monoid M] [has_lt M] {s : finset ι} {f : ι → with_top M} : ∑ i in s, f i < ⊤ ↔ ∀ i ∈ s, f i < ⊤ := -by simp only [lt_top_iff_ne_top, ne.def, sum_eq_top_iff, not_exists] +by simp only [with_top.lt_top_iff_ne_top, ne.def, sum_eq_top_iff, not_exists] + +/-- A sum of finite numbers is still finite -/ +lemma sum_lt_top [add_comm_monoid M] [has_lt M] {s : finset ι} {f : ι → with_top M} + (h : ∀ i ∈ s, f i ≠ ⊤) : (∑ i in s, f i) < ⊤ := +sum_lt_top_iff.2 $ λ i hi, with_top.lt_top_iff_ne_top.2 (h i hi) end with_top @@ -614,13 +620,7 @@ variables {S : Type*} lemma absolute_value.sum_le [semiring R] [ordered_semiring S] (abv : absolute_value R S) (s : finset ι) (f : ι → R) : abv (∑ i in s, f i) ≤ ∑ i in s, abv (f i) := -begin - letI := classical.dec_eq ι, - refine finset.induction_on s _ (λ i s hi ih, _), - { simp }, - { simp only [finset.sum_insert hi], - exact (abv.add_le _ _).trans (add_le_add le_rfl ih) }, -end +finset.le_sum_of_subadditive abv (map_zero _) abv.add_le _ _ lemma is_absolute_value.abv_sum [semiring R] [ordered_semiring S] (abv : R → S) [is_absolute_value abv] (f : ι → R) (s : finset ι) : diff --git a/src/algebra/big_operators/pi.lean b/src/algebra/big_operators/pi.lean index 782beadf6e664..ee2f6fc4b94c5 100644 --- a/src/algebra/big_operators/pi.lean +++ b/src/algebra/big_operators/pi.lean @@ -3,12 +3,17 @@ Copyright (c) 2018 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon, Patrick Massot -/ +import data.fintype.card +import algebra.group.prod import algebra.big_operators.basic import algebra.ring.pi /-! # Big operators for Pi Types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains theorems relevant to big operators in binary and arbitrary product of monoids and groups -/ @@ -51,45 +56,47 @@ lemma prod_mk_prod {α β γ : Type*} [comm_monoid α] [comm_monoid β] (s : fin by haveI := classical.dec_eq γ; exact finset.induction_on s rfl (by simp [prod.ext_iff] {contextual := tt}) -section single +section mul_single variables {I : Type*} [decidable_eq I] {Z : I → Type*} -variables [Π i, add_comm_monoid (Z i)] +variables [Π i, comm_monoid (Z i)] --- As we only defined `single` into `add_monoid`, we only prove the `finset.sum` version here. -lemma finset.univ_sum_single [fintype I] (f : Π i, Z i) : - ∑ i, pi.single i (f i) = f := +@[to_additive] +lemma finset.univ_prod_mul_single [fintype I] (f : Π i, Z i) : + ∏ i, pi.mul_single i (f i) = f := by { ext a, simp } -lemma add_monoid_hom.functions_ext [fintype I] (G : Type*) - [add_comm_monoid G] (g h : (Π i, Z i) →+ G) - (w : ∀ (i : I) (x : Z i), g (pi.single i x) = h (pi.single i x)) : g = h := +@[to_additive] +lemma monoid_hom.functions_ext [finite I] (G : Type*) [comm_monoid G] + (g h : (Π i, Z i) →* G) (H : ∀ i x, g (pi.mul_single i x) = h (pi.mul_single i x)) : g = h := begin + casesI nonempty_fintype I, ext k, - rw [← finset.univ_sum_single k, g.map_sum, h.map_sum], - simp only [w] + rw [← finset.univ_prod_mul_single k, g.map_prod, h.map_prod], + simp only [H] end -/-- This is used as the ext lemma instead of `add_monoid_hom.functions_ext` for reasons explained in +/-- This is used as the ext lemma instead of `monoid_hom.functions_ext` for reasons explained in note [partially-applied ext lemmas]. -/ -@[ext] -lemma add_monoid_hom.functions_ext' [fintype I] (M : Type*) [add_comm_monoid M] - (g h : (Π i, Z i) →+ M) - (H : ∀ i, g.comp (add_monoid_hom.single Z i) = h.comp (add_monoid_hom.single Z i)) : +@[ext, to_additive " +This is used as the ext lemma instead of `add_monoid_hom.functions_ext` for reasons explained in +note [partially-applied ext lemmas]."] +lemma monoid_hom.functions_ext' [finite I] (M : Type*) [comm_monoid M] + (g h : (Π i, Z i) →* M) + (H : ∀ i, g.comp (monoid_hom.single Z i) = h.comp (monoid_hom.single Z i)) : g = h := -have _ := λ i, add_monoid_hom.congr_fun (H i), -- elab without an expected type -g.functions_ext M h this +g.functions_ext M h $ λ i, monoid_hom.congr_fun (H i) -end single +end mul_single section ring_hom open pi variables {I : Type*} [decidable_eq I] {f : I → Type*} variables [Π i, non_assoc_semiring (f i)] -@[ext] lemma ring_hom.functions_ext [fintype I] (G : Type*) [non_assoc_semiring G] - (g h : (Π i, f i) →+* G) (w : ∀ (i : I) (x : f i), g (single i x) = h (single i x)) : g = h := +@[ext] lemma ring_hom.functions_ext [finite I] (G : Type*) [non_assoc_semiring G] + (g h : (Π i, f i) →+* G) (H : ∀ (i : I) (x : f i), g (single i x) = h (single i x)) : g = h := ring_hom.coe_add_monoid_hom_injective $ - add_monoid_hom.functions_ext G (g : (Π i, f i) →+ G) h w + @add_monoid_hom.functions_ext I _ f _ _ G _ (g : (Π i, f i) →+ G) h H end ring_hom diff --git a/src/algebra/big_operators/ring.lean b/src/algebra/big_operators/ring.lean index 6fee335bcd610..6a0c5a9dca0dd 100644 --- a/src/algebra/big_operators/ring.lean +++ b/src/algebra/big_operators/ring.lean @@ -5,12 +5,16 @@ Authors: Johannes Hölzl -/ import algebra.big_operators.basic +import algebra.field.defs import data.finset.pi import data.finset.powerset /-! # Results about big operators with values in a (semi)ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove results about big operators that involve some interaction between multiplicative and additive structures on the values being combined. -/ @@ -51,7 +55,7 @@ add_monoid_hom.map_sum (add_monoid_hom.mul_left b) _ s lemma sum_mul_sum {ι₁ : Type*} {ι₂ : Type*} (s₁ : finset ι₁) (s₂ : finset ι₂) (f₁ : ι₁ → β) (f₂ : ι₂ → β) : - (∑ x₁ in s₁, f₁ x₁) * (∑ x₂ in s₂, f₂ x₂) = ∑ p in s₁.product s₂, f₁ p.1 * f₂ p.2 := + (∑ x₁ in s₁, f₁ x₁) * (∑ x₂ in s₂, f₂ x₂) = ∑ p in s₁ ×ˢ s₂, f₁ p.1 * f₂ p.2 := by { rw [sum_product, sum_mul, sum_congr rfl], intros, rw mul_sum } end semiring @@ -69,7 +73,7 @@ by simp end semiring -lemma sum_div [division_ring β] {s : finset α} {f : α → β} {b : β} : +lemma sum_div [division_semiring β] {s : finset α} {f : α → β} {b : β} : (∑ x in s, f x) / b = ∑ x in s, f x / b := by simp only [div_eq_mul_inv, sum_mul] @@ -97,7 +101,7 @@ begin rw [prod_insert ha, pi_insert ha, ih, sum_mul, sum_bUnion h₁], refine sum_congr rfl (λ b _, _), have h₂ : ∀p₁∈pi s t, ∀p₂∈pi s t, pi.cons s a b p₁ = pi.cons s a b p₂ → p₁ = p₂, from - assume p₁ h₁ p₂ h₂ eq, pi_cons_injective ha eq, + assume p₁ h₁ p₂ h₂ eq, pi.cons_injective ha eq, rw [sum_image h₂, mul_sum], refine sum_congr rfl (λ g _, _), rw [attach_insert, prod_insert, prod_image], @@ -248,15 +252,7 @@ end `card s = k`, for `k = 1, ..., card s`"] lemma prod_powerset [comm_monoid β] (s : finset α) (f : finset α → β) : ∏ t in powerset s, f t = ∏ j in range (card s + 1), ∏ t in powerset_len j s, f t := -begin - classical, - rw [powerset_card_bUnion, prod_bUnion], - intros i hi j hj hij, - rw [function.on_fun, powerset_len_eq_filter, powerset_len_eq_filter, disjoint_filter], - intros x hx hc hnc, - apply hij, - rwa ← hc, -end +by rw [powerset_card_disj_Union, prod_disj_Union] lemma sum_range_succ_mul_sum_range_succ [non_unital_non_assoc_semiring β] (n k : ℕ) (f g : ℕ → β) : (∑ i in range (n+1), f i) * (∑ i in range (k+1), g i) = diff --git a/src/algebra/big_operators/ring_equiv.lean b/src/algebra/big_operators/ring_equiv.lean new file mode 100644 index 0000000000000..35864956133cf --- /dev/null +++ b/src/algebra/big_operators/ring_equiv.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2018 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov +-/ + +import algebra.big_operators.basic +import algebra.ring.equiv + +/-! +# Results about mapping big operators across ring equivalences + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +namespace ring_equiv + +open_locale big_operators + +variables {α R S : Type*} + +protected lemma map_list_prod [semiring R] [semiring S] (f : R ≃+* S) (l : list R) : + f l.prod = (l.map f).prod := map_list_prod f l + +protected lemma map_list_sum [non_assoc_semiring R] [non_assoc_semiring S] (f : R ≃+* S) + (l : list R) : f l.sum = (l.map f).sum := map_list_sum f l + +/-- An isomorphism into the opposite ring acts on the product by acting on the reversed elements -/ +protected lemma unop_map_list_prod [semiring R] [semiring S] (f : R ≃+* Sᵐᵒᵖ) (l : list R) : + mul_opposite.unop (f l.prod) = (l.map (mul_opposite.unop ∘ f)).reverse.prod := +unop_map_list_prod f l + +protected lemma map_multiset_prod [comm_semiring R] [comm_semiring S] (f : R ≃+* S) + (s : multiset R) : f s.prod = (s.map f).prod := map_multiset_prod f s + +protected lemma map_multiset_sum [non_assoc_semiring R] [non_assoc_semiring S] + (f : R ≃+* S) (s : multiset R) : f s.sum = (s.map f).sum := map_multiset_sum f s + +protected lemma map_prod [comm_semiring R] [comm_semiring S] (g : R ≃+* S) (f : α → R) + (s : finset α) : g (∏ x in s, f x) = ∏ x in s, g (f x) := +map_prod g f s + +protected lemma map_sum [non_assoc_semiring R] [non_assoc_semiring S] + (g : R ≃+* S) (f : α → R) (s : finset α) : g (∑ x in s, f x) = ∑ x in s, g (f x) := +map_sum g f s + +end ring_equiv diff --git a/src/algebra/bounds.lean b/src/algebra/bounds.lean index 50eab7e89589c..6d0286f9ff436 100644 --- a/src/algebra/bounds.lean +++ b/src/algebra/bounds.lean @@ -3,12 +3,18 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury G. Kudryashov -/ -import data.set.pointwise -import order.conditionally_complete_lattice +import algebra.order.group.order_iso +import algebra.order.monoid.order_dual +import data.set.pointwise.basic +import order.bounds.order_iso +import order.conditionally_complete_lattice.basic /-! # Upper/lower bounds in ordered monoids and groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove a few facts like “`-s` is bounded above iff `s` is bounded below” (`bdd_above_neg`). -/ diff --git a/src/algebra/category/Algebra/basic.lean b/src/algebra/category/Algebra/basic.lean index b0630ea5f9992..f8162553f0040 100644 --- a/src/algebra/category/Algebra/basic.lean +++ b/src/algebra/category/Algebra/basic.lean @@ -11,6 +11,9 @@ import algebra.category.Module.basic /-! # Category instance for algebras over a commutative ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the bundled category `Algebra` of algebras over a fixed commutative ring `R ` along with the forgetful functors to `Ring` and `Module`. We furthermore show that the functor associating to a type the free `R`-algebra on that type is left adjoint to the forgetful functor. diff --git a/src/algebra/category/Algebra/limits.lean b/src/algebra/category/Algebra/limits.lean index dae9981edb01e..abcf7968145a5 100644 --- a/src/algebra/category/Algebra/limits.lean +++ b/src/algebra/category/Algebra/limits.lean @@ -10,6 +10,9 @@ import algebra.category.Ring.limits /-! # The category of R-algebras has all limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Further, these limits are preserved by the forgetful functor --- that is, the underlying types are just the limits in the category of types. -/ @@ -17,7 +20,7 @@ the underlying types are just the limits in the category of types. open category_theory open category_theory.limits -universes v u +universes v w u -- `u` is determined by the ring, so can come last noncomputable theory @@ -26,44 +29,46 @@ namespace Algebra variables {R : Type u} [comm_ring R] variables {J : Type v} [small_category J] -instance semiring_obj (F : J ⥤ Algebra R) (j) : +instance semiring_obj (F : J ⥤ Algebra.{max v w} R) (j) : semiring ((F ⋙ forget (Algebra R)).obj j) := by { change semiring (F.obj j), apply_instance } -instance algebra_obj (F : J ⥤ Algebra R) (j) : +instance algebra_obj (F : J ⥤ Algebra.{max v w} R) (j) : algebra R ((F ⋙ forget (Algebra R)).obj j) := by { change algebra R (F.obj j), apply_instance } /-- The flat sections of a functor into `Algebra R` form a submodule of all sections. -/ -def sections_subalgebra (F : J ⥤ Algebra R) : +def sections_subalgebra (F : J ⥤ Algebra.{max v w} R) : subalgebra R (Π j, F.obj j) := { algebra_map_mem' := λ r j j' f, (F.map f).commutes r, - ..SemiRing.sections_subsemiring (F ⋙ forget₂ (Algebra R) Ring ⋙ forget₂ Ring SemiRing) } + ..SemiRing.sections_subsemiring + (F ⋙ forget₂ (Algebra R) Ring.{max v w} ⋙ forget₂ Ring SemiRing.{max v w}) } -instance limit_semiring (F : J ⥤ Algebra R) : - ring (types.limit_cone (F ⋙ forget (Algebra.{v} R))).X := +instance limit_semiring (F : J ⥤ Algebra.{max v w} R) : + ring (types.limit_cone (F ⋙ forget (Algebra.{max v w} R))).X := begin change ring (sections_subalgebra F), apply_instance, end -instance limit_algebra (F : J ⥤ Algebra R) : - algebra R (types.limit_cone (F ⋙ forget (Algebra.{v} R))).X := +instance limit_algebra (F : J ⥤ Algebra.{max v w} R) : + algebra R (types.limit_cone (F ⋙ forget (Algebra.{max v w} R))).X := begin - have : algebra R (types.limit_cone (F ⋙ forget (Algebra.{v} R))).X + have : algebra R (types.limit_cone (F ⋙ forget (Algebra.{max v w} R))).X = algebra R (sections_subalgebra F), by refl, rw this, apply_instance, end /-- `limit.π (F ⋙ forget (Algebra R)) j` as a `alg_hom`. -/ -def limit_π_alg_hom (F : J ⥤ Algebra.{v} R) (j) : - (types.limit_cone (F ⋙ forget (Algebra R))).X →ₐ[R] (F ⋙ forget (Algebra.{v} R)).obj j := +def limit_π_alg_hom (F : J ⥤ Algebra.{max v w} R) (j) : + (types.limit_cone (F ⋙ forget (Algebra R))).X →ₐ[R] (F ⋙ forget (Algebra.{max v w} R)).obj j := { commutes' := λ r, rfl, - ..SemiRing.limit_π_ring_hom (F ⋙ forget₂ (Algebra R) Ring.{v} ⋙ forget₂ Ring SemiRing.{v}) j } + ..SemiRing.limit_π_ring_hom + (F ⋙ forget₂ (Algebra R) Ring.{max v w} ⋙ forget₂ Ring SemiRing.{max v w}) j } namespace has_limits -- The next two definitions are used in the construction of `has_limits (Algebra R)`. @@ -74,7 +79,7 @@ namespace has_limits Construction of a limit cone in `Algebra R`. (Internal use only; use the limits API.) -/ -def limit_cone (F : J ⥤ Algebra.{v} R) : cone F := +def limit_cone (F : J ⥤ Algebra.{max v w} R) : cone F := { X := Algebra.of R (types.limit_cone (F ⋙ forget _)).X, π := { app := limit_π_alg_hom F, @@ -85,7 +90,7 @@ def limit_cone (F : J ⥤ Algebra.{v} R) : cone F := Witness that the limit cone in `Algebra R` is a limit cone. (Internal use only; use the limits API.) -/ -def limit_cone_is_limit (F : J ⥤ Algebra R) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ Algebra.{max v w} R) : is_limit (limit_cone F) := begin refine is_limit.of_faithful (forget (Algebra R)) (types.limit_cone_is_limit _) @@ -103,36 +108,52 @@ open has_limits /-- The category of R-algebras has all limits. -/ @[irreducible] -instance has_limits : has_limits (Algebra R) := +instance has_limits_of_size : has_limits_of_size.{v v} (Algebra.{max v w} R) := { has_limits_of_shape := λ J 𝒥, by exactI { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } } +instance has_limits : has_limits (Algebra.{w} R) := Algebra.has_limits_of_size.{w w u} + /-- The forgetful functor from R-algebras to rings preserves all limits. -/ -instance forget₂_Ring_preserves_limits : preserves_limits (forget₂ (Algebra R) Ring.{v}) := +instance forget₂_Ring_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ (Algebra R) Ring.{max v w}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) - (by apply Ring.limit_cone_is_limit (F ⋙ forget₂ (Algebra R) Ring)) } } + (by apply Ring.limit_cone_is_limit (F ⋙ forget₂ (Algebra R) Ring.{max v w})) } } + +instance forget₂_Ring_preserves_limits : + preserves_limits (forget₂ (Algebra R) Ring.{w}) := +Algebra.forget₂_Ring_preserves_limits_of_size.{w w} /-- The forgetful functor from R-algebras to R-modules preserves all limits. -/ -instance forget₂_Module_preserves_limits : preserves_limits (forget₂ (Algebra R) (Module.{v} R)) := +instance forget₂_Module_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ (Algebra R) (Module.{max v w} R)) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) - (by apply Module.has_limits.limit_cone_is_limit (F ⋙ forget₂ (Algebra R) (Module R))) } } + (by apply Module.has_limits.limit_cone_is_limit + (F ⋙ forget₂ (Algebra R) (Module.{max v w} R))) } } + +instance forget₂_Module_preserves_limits : preserves_limits (forget₂ (Algebra R) (Module.{w} R)) := +Algebra.forget₂_Module_preserves_limits_of_size.{w w} /-- The forgetful functor from R-algebras to types preserves all limits. -/ -instance forget_preserves_limits : preserves_limits (forget (Algebra R)) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget (Algebra.{max v w} R)) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (types.limit_cone_is_limit (F ⋙ forget _)) } } +instance forget_preserves_limits : preserves_limits (forget (Algebra.{w} R)) := +Algebra.forget_preserves_limits_of_size.{w w} + end Algebra diff --git a/src/algebra/category/BoolRing.lean b/src/algebra/category/BoolRing.lean index 87b85254a8bf9..9ec49984dc885 100644 --- a/src/algebra/category/BoolRing.lean +++ b/src/algebra/category/BoolRing.lean @@ -10,6 +10,9 @@ import order.category.BoolAlg /-! # The category of Boolean rings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `BoolRing`, the category of Boolean rings. ## TODO @@ -59,3 +62,11 @@ end BoolRing @[simps] instance BoolAlg.has_forget_to_BoolRing : has_forget₂ BoolAlg BoolRing := { forget₂ := { obj := λ X, BoolRing.of (as_boolring X), map := λ X Y, bounded_lattice_hom.as_boolring } } + +/-- The equivalence between Boolean rings and Boolean algebras. This is actually an isomorphism. -/ +@[simps functor inverse] def BoolRing_equiv_BoolAlg : BoolRing ≌ BoolAlg := +equivalence.mk (forget₂ BoolRing BoolAlg) (forget₂ BoolAlg BoolRing) + (nat_iso.of_components (λ X, BoolRing.iso.mk $ (ring_equiv.as_boolring_as_boolalg X).symm) $ + λ X Y f, rfl) + (nat_iso.of_components (λ X, BoolAlg.iso.mk $ order_iso.as_boolalg_as_boolring X) $ + λ X Y f, rfl) diff --git a/src/algebra/category/FinVect.lean b/src/algebra/category/FinVect.lean deleted file mode 100644 index ce329a91a8816..0000000000000 --- a/src/algebra/category/FinVect.lean +++ /dev/null @@ -1,115 +0,0 @@ -/- -Copyright (c) 2021 Jakob von Raumer. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jakob von Raumer --/ -import category_theory.monoidal.rigid.basic -import linear_algebra.tensor_product_basis -import linear_algebra.coevaluation -import algebra.category.Module.monoidal - -/-! -# The category of finite dimensional vector spaces - -This introduces `FinVect K`, the category of finite dimensional vector spaces over a field `K`. -It is implemented as a full subcategory on a subtype of `Module K`. -We first create the instance as a category, then as a monoidal category and then as a rigid monoidal -category. - -## Future work - -* Show that `FinVect K` is a symmetric monoidal category. - --/ -noncomputable theory - -open category_theory Module.monoidal_category -open_locale classical big_operators - -universes u - -variables (K : Type u) [field K] - -/-- Define `FinVect` as the subtype of `Module.{u} K` of finite dimensional vector spaces. -/ -@[derive [large_category, λ α, has_coe_to_sort α (Sort*), concrete_category]] -def FinVect := { V : Module.{u} K // finite_dimensional K V } - -namespace FinVect - -instance finite_dimensional (V : FinVect K) : finite_dimensional K V := V.prop - -instance : inhabited (FinVect K) := ⟨⟨Module.of K K, finite_dimensional.finite_dimensional_self K⟩⟩ - -instance : has_coe (FinVect.{u} K) (Module.{u} K) := { coe := λ V, V.1, } - -protected lemma coe_comp {U V W : FinVect K} (f : U ⟶ V) (g : V ⟶ W) : - ((f ≫ g) : U → W) = (g : V → W) ∘ (f : U → V) := rfl - -/-- Lift an unbundled vector space to `FinVect K`. -/ -def of (V : Type u) [add_comm_group V] [module K V] [finite_dimensional K V] : FinVect K := -⟨Module.of K V, by { change finite_dimensional K V, apply_instance }⟩ - -instance : has_forget₂ (FinVect.{u} K) (Module.{u} K) := -by { dsimp [FinVect], apply_instance, } - -instance : full (forget₂ (FinVect K) (Module.{u} K)) := -{ preimage := λ X Y f, f, } - -instance monoidal_category : monoidal_category (FinVect K) := -monoidal_category.full_monoidal_subcategory - (λ V, finite_dimensional K V) - (finite_dimensional.finite_dimensional_self K) - (λ X Y hX hY, by exactI finite_dimensional_tensor_product X Y) - -variables (V : FinVect K) - -/-- The dual module is the dual in the rigid monoidal category `FinVect K`. -/ -def FinVect_dual : FinVect K := -⟨Module.of K (module.dual K V), subspace.module.dual.finite_dimensional⟩ - -instance : has_coe_to_fun (FinVect_dual K V) (λ _, V → K) := -{ coe := λ v, by { change V →ₗ[K] K at v, exact v, } } - -open category_theory.monoidal_category - -/-- The coevaluation map is defined in `linear_algebra.coevaluation`. -/ -def FinVect_coevaluation : 𝟙_ (FinVect K) ⟶ V ⊗ (FinVect_dual K V) := -by apply coevaluation K V - -lemma FinVect_coevaluation_apply_one : FinVect_coevaluation K V (1 : K) = - ∑ (i : basis.of_vector_space_index K V), - (basis.of_vector_space K V) i ⊗ₜ[K] (basis.of_vector_space K V).coord i := -by apply coevaluation_apply_one K V - -/-- The evaluation morphism is given by the contraction map. -/ -def FinVect_evaluation : (FinVect_dual K V) ⊗ V ⟶ 𝟙_ (FinVect K) := -by apply contract_left K V - -@[simp] -lemma FinVect_evaluation_apply (f : (FinVect_dual K V)) (x : V) : - (FinVect_evaluation K V) (f ⊗ₜ x) = f x := -by apply contract_left_apply f x - -private theorem coevaluation_evaluation : - let V' : FinVect K := FinVect_dual K V in - (𝟙 V' ⊗ (FinVect_coevaluation K V)) ≫ (α_ V' V V').inv ≫ (FinVect_evaluation K V ⊗ 𝟙 V') - = (ρ_ V').hom ≫ (λ_ V').inv := -by apply contract_left_assoc_coevaluation K V - -private theorem evaluation_coevaluation : - (FinVect_coevaluation K V ⊗ 𝟙 V) - ≫ (α_ V (FinVect_dual K V) V).hom ≫ (𝟙 V ⊗ FinVect_evaluation K V) - = (λ_ V).hom ≫ (ρ_ V).inv := -by apply contract_left_assoc_coevaluation' K V - -instance exact_pairing : exact_pairing V (FinVect_dual K V) := -{ coevaluation := FinVect_coevaluation K V, - evaluation := FinVect_evaluation K V, - coevaluation_evaluation' := coevaluation_evaluation K V, - evaluation_coevaluation' := evaluation_coevaluation K V } - -instance right_dual : has_right_dual V := ⟨FinVect_dual K V⟩ - -instance right_rigid_category : right_rigid_category (FinVect K) := { } - -end FinVect diff --git a/src/algebra/category/FinVect/limits.lean b/src/algebra/category/FinVect/limits.lean deleted file mode 100644 index fff72cf305aa6..0000000000000 --- a/src/algebra/category/FinVect/limits.lean +++ /dev/null @@ -1,70 +0,0 @@ -/- -Copyright (c) 2022 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import algebra.category.FinVect -import algebra.category.Module.limits -import algebra.category.Module.products -import algebra.category.Module.epi_mono -import category_theory.limits.creates -import category_theory.limits.shapes.finite_limits -import category_theory.limits.constructions.limits_of_products_and_equalizers - -/-! -# `forget₂ (FinVect K) (Module K)` creates all finite limits. - -And hence `FinVect K` has all finite limits. --/ - -noncomputable theory -universes v u - -open category_theory -open category_theory.limits - -namespace FinVect - -variables {J : Type v} [small_category J] [fin_category J] -variables {k : Type v} [field k] - -instance {J : Type v} [fintype J] (Z : J → Module.{v} k) [∀ j, finite_dimensional k (Z j)] : - finite_dimensional k (∏ λ j, Z j : Module.{v} k) := -begin - haveI : finite_dimensional k (Module.of k (Π j, Z j)), { dsimp, apply_instance, }, - exact finite_dimensional.of_injective - (Module.pi_iso_pi _).hom - ((Module.mono_iff_injective _).1 (by apply_instance)), -end - -/-- Finite limits of finite finite dimensional vectors spaces are finite dimensional, -because we can realise them as subobjects of a finite product. -/ -instance (F : J ⥤ FinVect k) : - finite_dimensional k (limit (F ⋙ forget₂ (FinVect k) (Module.{v} k)) : Module.{v} k) := -begin - haveI : ∀ j, finite_dimensional k ((F ⋙ forget₂ (FinVect k) (Module.{v} k)).obj j), - { intro j, change finite_dimensional k (F.obj j), apply_instance, }, - exact finite_dimensional.of_injective - (limit_subobject_product (F ⋙ forget₂ (FinVect k) (Module.{v} k))) - ((Module.mono_iff_injective _).1 (by apply_instance)), -end - -/-- The forgetful functor from `FinVect k` to `Module k` creates all finite limits. -/ -def forget₂_creates_limit (F : J ⥤ FinVect k) : - creates_limit F (forget₂ (FinVect k) (Module.{v} k)) := -creates_limit_of_fully_faithful_of_iso - ⟨(limit (F ⋙ forget₂ (FinVect k) (Module.{v} k)) : Module.{v} k), by apply_instance⟩ - (iso.refl _) - -instance : creates_limits_of_shape J (forget₂ (FinVect k) (Module.{v} k)) := -{ creates_limit := λ F, forget₂_creates_limit F, } - -instance : has_finite_limits (FinVect k) := -{ out := λ J _ _, by exactI - has_limits_of_shape_of_has_limits_of_shape_creates_limits_of_shape - (forget₂ (FinVect k) (Module.{v} k)), } - -instance : preserves_finite_limits (forget₂ (FinVect k) (Module.{v} k)) := -{ preserves_finite_limits := λ J _ _, by exactI infer_instance, } - -end FinVect diff --git a/src/algebra/category/Group/Z_Module_equivalence.lean b/src/algebra/category/Group/Z_Module_equivalence.lean index 5b0097f651da5..d24307095d6e2 100644 --- a/src/algebra/category/Group/Z_Module_equivalence.lean +++ b/src/algebra/category/Group/Z_Module_equivalence.lean @@ -6,6 +6,9 @@ Authors: Scott Morrison import algebra.category.Module.basic /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The forgetful functor from ℤ-modules to additive commutative groups is an equivalence of categories. diff --git a/src/algebra/category/Group/abelian.lean b/src/algebra/category/Group/abelian.lean index e9dd71e2ee605..757ef5fdc8848 100644 --- a/src/algebra/category/Group/abelian.lean +++ b/src/algebra/category/Group/abelian.lean @@ -11,6 +11,9 @@ import category_theory.abelian.basic /-! # The category of abelian groups is abelian + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory @@ -28,12 +31,12 @@ variables {X Y : AddCommGroup.{u}} (f : X ⟶ Y) /-- In the category of abelian groups, every monomorphism is normal. -/ def normal_mono (hf : mono f) : normal_mono f := equivalence_reflects_normal_mono (forget₂ (Module.{u} ℤ) AddCommGroup.{u}).inv $ - Module.normal_mono _ $ right_adjoint_preserves_mono (functor.adjunction _) hf + Module.normal_mono _ infer_instance /-- In the category of abelian groups, every epimorphism is normal. -/ def normal_epi (hf : epi f) : normal_epi f := equivalence_reflects_normal_epi (forget₂ (Module.{u} ℤ) AddCommGroup.{u}).inv $ - Module.normal_epi _ $ left_adjoint_preserves_epi (functor.adjunction _) hf + Module.normal_epi _ infer_instance end diff --git a/src/algebra/category/Group/adjunctions.lean b/src/algebra/category/Group/adjunctions.lean index 2167941a3068a..8aa601a197357 100644 --- a/src/algebra/category/Group/adjunctions.lean +++ b/src/algebra/category/Group/adjunctions.lean @@ -9,6 +9,9 @@ import group_theory.free_abelian_group /-! # Adjunctions regarding the category of (abelian) groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains construction of basic adjunctions concerning the category of groups and the category of abelian groups. @@ -65,6 +68,8 @@ adjunction.mk_of_hom_equiv hom_equiv_naturality_left_symm' := by { intros, ext, refl} } +instance : is_right_adjoint (forget AddCommGroup.{u}) := ⟨_, adj⟩ + /-- As an example, we now give a high-powered proof that the monomorphisms in `AddCommGroup` are just the injective functions. @@ -72,9 +77,7 @@ the monomorphisms in `AddCommGroup` are just the injective functions. (This proof works in all universes.) -/ example {G H : AddCommGroup.{u}} (f : G ⟶ H) [mono f] : function.injective f := -(mono_iff_injective f).1 (right_adjoint_preserves_mono adj (by apply_instance : mono f)) - -instance : is_right_adjoint (forget AddCommGroup.{u}) := ⟨_, adj⟩ +(mono_iff_injective f).1 (show mono ((forget AddCommGroup.{u}).map f), by apply_instance) end AddCommGroup @@ -118,3 +121,57 @@ adjunction.mk_of_hom_equiv hom_equiv_naturality_left_symm' := λ G H A f g, by { ext1, refl } } end abelianization + +/-- The functor taking a monoid to its subgroup of units. -/ +@[simps] +def Mon.units : Mon.{u} ⥤ Group.{u} := +{ obj := λ R, Group.of Rˣ, + map := λ R S f, Group.of_hom $ units.map f, + map_id' := λ X, monoid_hom.ext (λ x, units.ext rfl), + map_comp' := λ X Y Z f g, monoid_hom.ext (λ x, units.ext rfl) } + +/-- The forgetful-units adjunction between `Group` and `Mon`. -/ +def Group.forget₂_Mon_adj : forget₂ Group Mon ⊣ Mon.units.{u} := +{ hom_equiv := λ X Y, + { to_fun := λ f, monoid_hom.to_hom_units f, + inv_fun := λ f, (units.coe_hom Y).comp f, + left_inv := λ f, monoid_hom.ext $ λ _, rfl, + right_inv := λ f, monoid_hom.ext $ λ _, units.ext rfl }, + unit := + { app := λ X, { ..(@to_units X _).to_monoid_hom }, + naturality' := λ X Y f, monoid_hom.ext $ λ x, units.ext rfl }, + counit := + { app := λ X, units.coe_hom X, + naturality' := λ X Y f, monoid_hom.ext $ λ x, rfl }, + hom_equiv_unit' := λ X Y f, monoid_hom.ext $ λ _, units.ext rfl, + hom_equiv_counit' := λ X Y f, monoid_hom.ext $ λ _, rfl } + +instance : is_right_adjoint Mon.units.{u} := +⟨_, Group.forget₂_Mon_adj⟩ + +/-- The functor taking a monoid to its subgroup of units. -/ +@[simps] +def CommMon.units : CommMon.{u} ⥤ CommGroup.{u} := +{ obj := λ R, CommGroup.of Rˣ, + map := λ R S f, CommGroup.of_hom $ units.map f, + map_id' := λ X, monoid_hom.ext (λ x, units.ext rfl), + map_comp' := λ X Y Z f g, monoid_hom.ext (λ x, units.ext rfl) } + +/-- The forgetful-units adjunction between `CommGroup` and `CommMon`. -/ +def CommGroup.forget₂_CommMon_adj : forget₂ CommGroup CommMon ⊣ CommMon.units.{u} := +{ hom_equiv := λ X Y, + { to_fun := λ f, monoid_hom.to_hom_units f, + inv_fun := λ f, (units.coe_hom Y).comp f, + left_inv := λ f, monoid_hom.ext $ λ _, rfl, + right_inv := λ f, monoid_hom.ext $ λ _, units.ext rfl }, + unit := + { app := λ X, { ..(@to_units X _).to_monoid_hom }, + naturality' := λ X Y f, monoid_hom.ext $ λ x, units.ext rfl }, + counit := + { app := λ X, units.coe_hom X, + naturality' := λ X Y f, monoid_hom.ext $ λ x, rfl }, + hom_equiv_unit' := λ X Y f, monoid_hom.ext $ λ _, units.ext rfl, + hom_equiv_counit' := λ X Y f, monoid_hom.ext $ λ _, rfl } + +instance : is_right_adjoint CommMon.units.{u} := +⟨_, CommGroup.forget₂_CommMon_adj⟩ diff --git a/src/algebra/category/Group/basic.lean b/src/algebra/category/Group/basic.lean index 17a1980b15b3d..a03a9c64f8360 100644 --- a/src/algebra/category/Group/basic.lean +++ b/src/algebra/category/Group/basic.lean @@ -9,6 +9,9 @@ import category_theory.endomorphism /-! # Category instances for group, add_group, comm_group, and add_comm_group. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the bundled categories: * `Group` * `AddGroup` diff --git a/src/algebra/category/Group/biproducts.lean b/src/algebra/category/Group/biproducts.lean index 40e72a1a6df96..c11671aab003c 100644 --- a/src/algebra/category/Group/biproducts.lean +++ b/src/algebra/category/Group/biproducts.lean @@ -5,11 +5,14 @@ Authors: Scott Morrison -/ import algebra.group.pi import algebra.category.Group.preadditive -import category_theory.limits.shapes.biproducts +import category_theory.preadditive.biproducts import algebra.category.Group.limits /-! # The category of abelian groups has finite biproducts + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory @@ -17,7 +20,7 @@ open category_theory.limits open_locale big_operators -universe u +universes w u namespace AddCommGroup @@ -38,86 +41,91 @@ Construct limit data for a binary product in `AddCommGroup`, using `AddCommGroup def binary_product_limit_cone (G H : AddCommGroup.{u}) : limits.limit_cone (pair G H) := { cone := { X := AddCommGroup.of (G × H), - π := { app := λ j, walking_pair.cases_on j (add_monoid_hom.fst G H) (add_monoid_hom.snd G H) }}, + π := { app := λ j, discrete.cases_on j + (λ j, walking_pair.cases_on j (add_monoid_hom.fst G H) (add_monoid_hom.snd G H)), + naturality' := by rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟨⟩⟩⟩; refl, }}, is_limit := - { lift := λ s, add_monoid_hom.prod (s.π.app walking_pair.left) (s.π.app walking_pair.right), - fac' := begin rintros s (⟨⟩|⟨⟩); { ext x, simp, }, end, - uniq' := λ s m w, - begin - ext; [rw ← w walking_pair.left, rw ← w walking_pair.right]; refl, + { lift := λ s, add_monoid_hom.prod (s.π.app ⟨walking_pair.left⟩) (s.π.app ⟨walking_pair.right⟩), + fac' := by { rintros s (⟨⟩|⟨⟩); { ext x, simp, } }, + uniq' := λ s m w, begin + ext; [rw ← w ⟨walking_pair.left⟩, rw ← w ⟨walking_pair.right⟩]; refl, end, } } @[simp] lemma binary_product_limit_cone_cone_π_app_left (G H : AddCommGroup.{u}) : - (binary_product_limit_cone G H).cone.π.app walking_pair.left = add_monoid_hom.fst G H := rfl + (binary_product_limit_cone G H).cone.π.app ⟨walking_pair.left⟩ = add_monoid_hom.fst G H := rfl @[simp] lemma binary_product_limit_cone_cone_π_app_right (G H : AddCommGroup.{u}) : - (binary_product_limit_cone G H).cone.π.app walking_pair.right = add_monoid_hom.snd G H := rfl + (binary_product_limit_cone G H).cone.π.app ⟨walking_pair.right⟩ = add_monoid_hom.snd G H := rfl /-- We verify that the biproduct in AddCommGroup is isomorphic to the cartesian product of the underlying types: -/ -@[simps] noncomputable +@[simps hom_apply] noncomputable def biprod_iso_prod (G H : AddCommGroup.{u}) : (G ⊞ H : AddCommGroup) ≅ AddCommGroup.of (G × H) := is_limit.cone_point_unique_up_to_iso (binary_biproduct.is_limit G H) (binary_product_limit_cone G H).is_limit --- Furthermore, our biproduct will automatically function as a coproduct. -example (G H : AddCommGroup.{u}) : has_colimit (pair G H) := by apply_instance +@[simp, elementwise] lemma biprod_iso_prod_inv_comp_fst (G H : AddCommGroup.{u}) : + (biprod_iso_prod G H).inv ≫ biprod.fst = add_monoid_hom.fst G H := +is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.left) -variables {J : Type u} (F : (discrete J) ⥤ AddCommGroup.{u}) +@[simp, elementwise] lemma biprod_iso_prod_inv_comp_snd (G H : AddCommGroup.{u}) : + (biprod_iso_prod G H).inv ≫ biprod.snd = add_monoid_hom.snd G H := +is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.right) namespace has_limit +variables {J : Type w} (f : J → AddCommGroup.{max w u}) /-- The map from an arbitrary cone over a indexed family of abelian groups to the cartesian product of those groups. -/ -def lift (s : cone F) : - s.X ⟶ AddCommGroup.of (Π j, F.obj j) := -{ to_fun := λ x j, s.π.app j x, +@[simps] +def lift (s : fan f) : + s.X ⟶ AddCommGroup.of (Π j,f j) := +{ to_fun := λ x j, s.π.app ⟨j⟩ x, map_zero' := by { ext, simp }, map_add' := λ x y, by { ext, simp }, } -@[simp] lemma lift_apply (s : cone F) (x : s.X) (j : J) : (lift F s) x j = s.π.app j x := rfl - /-- Construct limit data for a product in `AddCommGroup`, using `AddCommGroup.of (Π j, F.obj j)`. -/ -@[simps] def product_limit_cone : limits.limit_cone F := +@[simps] def product_limit_cone : limits.limit_cone (discrete.functor f) := { cone := - { X := AddCommGroup.of (Π j, F.obj j), - π := discrete.nat_trans (λ j, pi.eval_add_monoid_hom (λ j, F.obj j) j), }, + { X := AddCommGroup.of (Π j, f j), + π := discrete.nat_trans (λ j, pi.eval_add_monoid_hom (λ j, f j) j.as), }, is_limit := - { lift := lift F, - fac' := λ s j, by { ext, simp, }, + { lift := lift f, + fac' := λ s j, by { cases j, ext, simp, }, uniq' := λ s m w, begin ext x j, dsimp only [has_limit.lift], simp only [add_monoid_hom.coe_mk], - exact congr_arg (λ f : s.X ⟶ F.obj j, (f : s.X → F.obj j) x) (w j), + exact congr_arg (λ g : s.X ⟶ f j, (g : s.X → f j) x) (w ⟨j⟩), end, }, } end has_limit open has_limit +variables {J : Type} [fintype J] + /-- We verify that the biproduct we've just defined is isomorphic to the AddCommGroup structure on the dependent function type -/ @[simps hom_apply] noncomputable -def biproduct_iso_pi [decidable_eq J] [fintype J] (f : J → AddCommGroup.{u}) : +def biproduct_iso_pi (f : J → AddCommGroup.{u}) : (⨁ f : AddCommGroup) ≅ AddCommGroup.of (Π j, f j) := is_limit.cone_point_unique_up_to_iso (biproduct.is_limit f) - (product_limit_cone (discrete.functor f)).is_limit + (product_limit_cone f).is_limit -@[simp, elementwise] lemma biproduct_iso_pi_inv_comp_π [decidable_eq J] [fintype J] - (f : J → AddCommGroup.{u}) (j : J) : +@[simp, elementwise] lemma biproduct_iso_pi_inv_comp_π (f : J → AddCommGroup.{u}) (j : J) : (biproduct_iso_pi f).inv ≫ biproduct.π f j = pi.eval_add_monoid_hom (λ j, f j) j := -is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _ +is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk j) end AddCommGroup diff --git a/src/algebra/category/Group/colimits.lean b/src/algebra/category/Group/colimits.lean index 037d3b1a50afb..7853b3466a1d9 100644 --- a/src/algebra/category/Group/colimits.lean +++ b/src/algebra/category/Group/colimits.lean @@ -5,13 +5,15 @@ Authors: Scott Morrison -/ import algebra.category.Group.preadditive import group_theory.quotient_group -import category_theory.limits.concrete_category import category_theory.limits.shapes.kernels -import category_theory.limits.shapes.concrete_category +import category_theory.concrete_category.elementwise /-! # The category of additive commutative groups has all colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`. It is a very uniform approach, that conceivably could be synthesised directly by a tactic that analyses the shape of `add_comm_group` and `monoid_hom`. @@ -302,7 +304,7 @@ agrees with the usual group-theoretical quotient. noncomputable def cokernel_iso_quotient {G H : AddCommGroup.{u}} (f : G ⟶ H) : cokernel f ≅ AddCommGroup.of (H ⧸ (add_monoid_hom.range f)) := { hom := cokernel.desc f (mk' _) - (by { ext, apply quotient.sound, fsplit, exact -x, + (by { ext, apply quotient.sound, apply left_rel_apply.mpr, fsplit, exact -x, simp only [add_zero, add_monoid_hom.map_neg], }), inv := quotient_add_group.lift _ (cokernel.π f) (by { intros x H_1, cases H_1, induction H_1_h, @@ -313,8 +315,8 @@ noncomputable def cokernel_iso_quotient {G H : AddCommGroup.{u}} (f : G ⟶ H) : end, inv_hom_id' := begin ext x : 2, - simp only [colimit.ι_desc_apply, id_apply, lift_mk, mk'_apply, - cofork.of_π_ι_app, comp_apply, add_monoid_hom.comp_apply], + simp only [add_monoid_hom.coe_comp, function.comp_app, comp_apply, lift_mk, + cokernel.π_desc_apply, mk'_apply, id_apply], end, } end AddCommGroup diff --git a/src/algebra/category/Group/default.lean b/src/algebra/category/Group/default.lean deleted file mode 100644 index 6ca65b0ef36e4..0000000000000 --- a/src/algebra/category/Group/default.lean +++ /dev/null @@ -1,4 +0,0 @@ -import algebra.category.Group.limits -import algebra.category.Group.colimits -import algebra.category.Group.preadditive -import algebra.category.Group.zero diff --git a/src/algebra/category/Group/epi_mono.lean b/src/algebra/category/Group/epi_mono.lean new file mode 100644 index 0000000000000..c43176e057940 --- /dev/null +++ b/src/algebra/category/Group/epi_mono.lean @@ -0,0 +1,380 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import algebra.category.Group.equivalence_Group_AddGroup +import group_theory.quotient_group + +/-! +# Monomorphisms and epimorphisms in `Group` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +In this file, we prove monomorphisms in category of group are injective homomorphisms and +epimorphisms are surjective homomorphisms. +-/ + +noncomputable theory + +universes u v + +namespace monoid_hom + +open quotient_group + +variables {A : Type u} {B : Type v} + +section +variables [group A] [group B] + +@[to_additive add_monoid_hom.ker_eq_bot_of_cancel] +lemma ker_eq_bot_of_cancel {f : A →* B} (h : ∀ (u v : f.ker →* A), f.comp u = f.comp v → u = v) : + f.ker = ⊥ := +by simpa using _root_.congr_arg range (h f.ker.subtype 1 (by tidy)) + +end + +section +variables [comm_group A] [comm_group B] + +@[to_additive add_monoid_hom.range_eq_top_of_cancel] +lemma range_eq_top_of_cancel {f : A →* B} + (h : ∀ (u v : B →* B ⧸ f.range), u.comp f = v.comp f → u = v) : + f.range = ⊤ := +begin + specialize h 1 (quotient_group.mk' _) _, + { ext1, + simp only [one_apply, coe_comp, coe_mk', function.comp_app], + rw [show (1 : B ⧸ f.range) = (1 : B), from quotient_group.coe_one _, quotient_group.eq, + inv_one, one_mul], + exact ⟨x, rfl⟩, }, + replace h : (quotient_group.mk' _).ker = (1 : B →* B ⧸ f.range).ker := by rw h, + rwa [ker_one, quotient_group.ker_mk] at h, +end + +end + +end monoid_hom + +section + +open category_theory + +namespace Group + +variables {A B : Group.{u}} (f : A ⟶ B) + +@[to_additive AddGroup.ker_eq_bot_of_mono] +lemma ker_eq_bot_of_mono [mono f] : f.ker = ⊥ := +monoid_hom.ker_eq_bot_of_cancel $ λ u v, + (@cancel_mono _ _ _ _ _ f _ (show Group.of f.ker ⟶ A, from u) _).1 + +@[to_additive AddGroup.mono_iff_ker_eq_bot] +lemma mono_iff_ker_eq_bot : mono f ↔ f.ker = ⊥ := +⟨λ h, @@ker_eq_bot_of_mono f h, + λ h, concrete_category.mono_of_injective _ $ (monoid_hom.ker_eq_bot_iff f).1 h⟩ + +@[to_additive AddGroup.mono_iff_injective] +lemma mono_iff_injective : mono f ↔ function.injective f := +iff.trans (mono_iff_ker_eq_bot f) $ monoid_hom.ker_eq_bot_iff f + +namespace surjective_of_epi_auxs + +local notation `X` := set.range (function.swap left_coset f.range.carrier) + +/-- +Define `X'` to be the set of all left cosets with an extra point at "infinity". +-/ +@[nolint has_nonempty_instance] +inductive X_with_infinity +| from_coset : set.range (function.swap left_coset f.range.carrier) → X_with_infinity +| infinity : X_with_infinity + +open X_with_infinity equiv.perm +open_locale coset + +local notation `X'` := X_with_infinity f +local notation `∞` := X_with_infinity.infinity +local notation `SX'` := equiv.perm X' + +instance : has_smul B X' := +{ smul := λ b x, match x with + | from_coset y := from_coset ⟨b *l y, + begin + rw [←subtype.val_eq_coe, ←y.2.some_spec, left_coset_assoc], + use b * y.2.some, + end⟩ + | ∞ := ∞ + end } + +lemma mul_smul (b b' : B) (x : X') : (b * b') • x = b • b' • x := +match x with +| from_coset y := + begin + change from_coset _ = from_coset _, + simp only [←subtype.val_eq_coe, left_coset_assoc], + end +| ∞ := rfl +end + +lemma one_smul (x : X') : (1 : B) • x = x := +match x with +| from_coset y := + begin + change from_coset _ = from_coset _, + simp only [←subtype.val_eq_coe, one_left_coset, subtype.ext_iff_val], + end +| ∞ := rfl +end + +lemma from_coset_eq_of_mem_range {b : B} (hb : b ∈ f.range) : + from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ = + from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ := +begin + congr, + change b *l f.range = f.range, + nth_rewrite 1 [show (f.range : set B) = 1 *l f.range, from (one_left_coset _).symm], + rw [left_coset_eq_iff, mul_one], + exact subgroup.inv_mem _ hb, +end + +lemma from_coset_ne_of_nin_range {b : B} (hb : b ∉ f.range) : + from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ ≠ + from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ := +begin + intros r, + simp only [subtype.mk_eq_mk] at r, + change b *l f.range = f.range at r, + nth_rewrite 1 [show (f.range : set B) = 1 *l f.range, from (one_left_coset _).symm] at r, + rw [left_coset_eq_iff, mul_one] at r, + exact hb (inv_inv b ▸ (subgroup.inv_mem _ r)), +end + +instance : decidable_eq X' := classical.dec_eq _ + +/-- +Let `τ` be the permutation on `X'` exchanging `f.range` and the point at infinity. +-/ +noncomputable def tau : SX' := +equiv.swap (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) ∞ + +local notation `τ` := tau f + +lemma τ_apply_infinity : + τ ∞ = from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ := +equiv.swap_apply_right _ _ + +lemma τ_apply_from_coset : + τ (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = ∞ := +equiv.swap_apply_left _ _ + +lemma τ_apply_from_coset' (x : B) (hx : x ∈ f.range) : + τ (from_coset ⟨x *l f.range.carrier, ⟨x, rfl⟩⟩) = ∞ := +(from_coset_eq_of_mem_range _ hx).symm ▸ τ_apply_from_coset _ + +lemma τ_symm_apply_from_coset : + (equiv.symm τ) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = ∞ := +by rw [tau, equiv.symm_swap, equiv.swap_apply_left] + +lemma τ_symm_apply_infinity : + (equiv.symm τ) ∞ = from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ := +by rw [tau, equiv.symm_swap, equiv.swap_apply_right] + +/-- +Let `g : B ⟶ S(X')` be defined as such that, for any `β : B`, `g(β)` is the function sending +point at infinity to point at infinity and sending coset `y` to `β *l y`. +-/ +def G : B →* SX' := +{ to_fun := λ β, + { to_fun := λ x, β • x, + inv_fun := λ x, β⁻¹ • x, + left_inv := λ x, by { dsimp only, rw [←mul_smul, mul_left_inv, one_smul] }, + right_inv := λ x, by { dsimp only, rw [←mul_smul, mul_right_inv, one_smul] } }, + map_one' := by { ext, simp [one_smul] }, + map_mul' := λ b1 b2, by { ext, simp [mul_smul] } } + +local notation `g` := G f + +/-- +Define `h : B ⟶ S(X')` to be `τ g τ⁻¹` +-/ +def H : B →* SX':= +{ to_fun := λ β, ((τ).symm.trans (g β)).trans τ, + map_one' := by { ext, simp }, + map_mul' := λ b1 b2, by { ext, simp } } + +local notation `h` := H f + +/-! +The strategy is the following: assuming `epi f` +* prove that `f.range = {x | h x = g x}`; +* thus `f ≫ h = f ≫ g` so that `h = g`; +* but if `f` is not surjective, then some `x ∉ f.range`, then `h x ≠ g x` at the coset `f.range`. +-/ + +lemma g_apply_from_coset (x : B) (y : X) : (g x) (from_coset y) = from_coset ⟨x *l y, by tidy⟩ := +rfl + +lemma g_apply_infinity (x : B) : (g x) ∞ = ∞ := rfl + +lemma h_apply_infinity (x : B) (hx : x ∈ f.range) : (h x) ∞ = ∞ := +begin + simp only [H, monoid_hom.coe_mk, equiv.to_fun_as_coe, equiv.coe_trans, function.comp_app], + rw [τ_symm_apply_infinity, g_apply_from_coset], + simpa only [←subtype.val_eq_coe] using τ_apply_from_coset' f x hx, +end + +lemma h_apply_from_coset (x : B) : + (h x) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = + from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩ := +by simp [H, τ_symm_apply_from_coset, g_apply_infinity, τ_apply_infinity] + +lemma h_apply_from_coset' (x : B) (b : B) (hb : b ∈ f.range): + (h x) (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) = + from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩ := +(from_coset_eq_of_mem_range _ hb).symm ▸ h_apply_from_coset f x + +lemma h_apply_from_coset_nin_range (x : B) (hx : x ∈ f.range) (b : B) (hb : b ∉ f.range) : + (h x) (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) = + from_coset ⟨(x * b) *l f.range.carrier, ⟨x * b, rfl⟩⟩ := +begin + simp only [H, tau, monoid_hom.coe_mk, equiv.to_fun_as_coe, equiv.coe_trans, function.comp_app], + rw [equiv.symm_swap, @equiv.swap_apply_of_ne_of_ne X' _ + (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) ∞ + (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) (from_coset_ne_of_nin_range _ hb) (by simp)], + simp only [g_apply_from_coset, ←subtype.val_eq_coe, left_coset_assoc], + refine equiv.swap_apply_of_ne_of_ne (from_coset_ne_of_nin_range _ (λ r, hb _)) (by simp), + convert subgroup.mul_mem _ (subgroup.inv_mem _ hx) r, + rw [←mul_assoc, mul_left_inv, one_mul], +end + +lemma agree : f.range.carrier = {x | h x = g x} := +begin + refine set.ext (λ b, ⟨_, λ (hb : h b = g b), classical.by_contradiction (λ r, _)⟩), + { rintros ⟨a, rfl⟩, + change h (f a) = g (f a), + ext ⟨⟨_, ⟨y, rfl⟩⟩⟩, + { rw [g_apply_from_coset], + by_cases m : y ∈ f.range, + { rw [h_apply_from_coset' _ _ _ m, from_coset_eq_of_mem_range _ m], + change from_coset _ = from_coset ⟨f a *l (y *l _), _⟩, + simpa only [←from_coset_eq_of_mem_range _ (subgroup.mul_mem _ ⟨a, rfl⟩ m), + left_coset_assoc] }, + { rw [h_apply_from_coset_nin_range _ _ ⟨_, rfl⟩ _ m], + simpa only [←subtype.val_eq_coe, left_coset_assoc], }, }, + { rw [g_apply_infinity, h_apply_infinity _ _ ⟨_, rfl⟩], } }, + { have eq1 : (h b) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = + (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) := by simp [H, tau, g_apply_infinity], + have eq2 : (g b) (from_coset ⟨f.range.carrier, ⟨1, one_left_coset _⟩⟩) = + (from_coset ⟨b *l f.range.carrier, ⟨b, rfl⟩⟩) := rfl, + exact (from_coset_ne_of_nin_range _ r).symm (by rw [←eq1, ←eq2, fun_like.congr_fun hb]) } +end + +lemma comp_eq : f ≫ (show B ⟶ Group.of SX', from g) = f ≫ h := +fun_like.ext _ _ $ λ a, + by simp only [comp_apply, show h (f a) = _, from (by simp [←agree] : f a ∈ {b | h b = g b})] + +lemma g_ne_h (x : B) (hx : x ∉ f.range) : g ≠ h := +begin + intros r, + replace r := fun_like.congr_fun (fun_like.congr_fun r x) + ((from_coset ⟨f.range, ⟨1, one_left_coset _⟩⟩)), + rw [H, g_apply_from_coset, monoid_hom.coe_mk, tau] at r, + simp only [monoid_hom.coe_range, subtype.coe_mk, equiv.symm_swap, + equiv.to_fun_as_coe, equiv.coe_trans, function.comp_app] at r, + erw [equiv.swap_apply_left, g_apply_infinity, equiv.swap_apply_right] at r, + exact from_coset_ne_of_nin_range _ hx r, +end + +end surjective_of_epi_auxs + +lemma surjective_of_epi [epi f] : function.surjective f := +begin + by_contra r, + push_neg at r, + rcases r with ⟨b, hb⟩, + exact surjective_of_epi_auxs.g_ne_h f b (λ ⟨c, hc⟩, hb _ hc) + ((cancel_epi f).1 (surjective_of_epi_auxs.comp_eq f)), +end + +lemma epi_iff_surjective : epi f ↔ function.surjective f := +⟨λ h, @@surjective_of_epi f h, concrete_category.epi_of_surjective _⟩ + +lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ := +iff.trans (epi_iff_surjective _) (subgroup.eq_top_iff' f.range).symm + +end Group + +namespace AddGroup +variables {A B : AddGroup.{u}} (f : A ⟶ B) + +lemma epi_iff_surjective : epi f ↔ function.surjective f := +begin + have i1 : epi f ↔ epi (Group_AddGroup_equivalence.inverse.map f), + { refine ⟨_, Group_AddGroup_equivalence.inverse.epi_of_epi_map⟩, + introsI e', + apply Group_AddGroup_equivalence.inverse.map_epi }, + rwa Group.epi_iff_surjective at i1, +end + +lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ := +iff.trans (epi_iff_surjective _) (add_subgroup.eq_top_iff' f.range).symm + +end AddGroup + +namespace Group +variables {A B : Group.{u}} (f : A ⟶ B) + +@[to_additive] +instance forget_Group_preserves_mono : (forget Group).preserves_monomorphisms := +{ preserves := λ X Y f e, by rwa [mono_iff_injective, ←category_theory.mono_iff_injective] at e } + +@[to_additive] +instance forget_Group_preserves_epi : (forget Group).preserves_epimorphisms := +{ preserves := λ X Y f e, by rwa [epi_iff_surjective, ←category_theory.epi_iff_surjective] at e } + +end Group + +namespace CommGroup +variables {A B : CommGroup.{u}} (f : A ⟶ B) + +@[to_additive AddCommGroup.ker_eq_bot_of_mono] +lemma ker_eq_bot_of_mono [mono f] : f.ker = ⊥ := +monoid_hom.ker_eq_bot_of_cancel $ λ u v, + (@cancel_mono _ _ _ _ _ f _ (show CommGroup.of f.ker ⟶ A, from u) _).1 + +@[to_additive AddCommGroup.mono_iff_ker_eq_bot] +lemma mono_iff_ker_eq_bot : mono f ↔ f.ker = ⊥ := +⟨λ h, @@ker_eq_bot_of_mono f h, + λ h, concrete_category.mono_of_injective _ $ (monoid_hom.ker_eq_bot_iff f).1 h⟩ + +@[to_additive AddCommGroup.mono_iff_injective] +lemma mono_iff_injective : mono f ↔ function.injective f := +iff.trans (mono_iff_ker_eq_bot f) $ monoid_hom.ker_eq_bot_iff f + +@[to_additive] +lemma range_eq_top_of_epi [epi f] : f.range = ⊤ := +monoid_hom.range_eq_top_of_cancel $ λ u v h, + (@cancel_epi _ _ _ _ _ f _ (show B ⟶ ⟨B ⧸ monoid_hom.range f⟩, from u) v).1 h + +@[to_additive] +lemma epi_iff_range_eq_top : epi f ↔ f.range = ⊤ := +⟨λ hf, by exactI range_eq_top_of_epi _, + λ hf, concrete_category.epi_of_surjective _ $ monoid_hom.range_top_iff_surjective.mp hf⟩ + +@[to_additive] +lemma epi_iff_surjective : epi f ↔ function.surjective f := +by rw [epi_iff_range_eq_top, monoid_hom.range_top_iff_surjective] + +@[to_additive] +instance forget_CommGroup_preserves_mono : (forget CommGroup).preserves_monomorphisms := +{ preserves := λ X Y f e, by rwa [mono_iff_injective, ←category_theory.mono_iff_injective] at e } + +@[to_additive] +instance forget_CommGroup_preserves_epi : (forget CommGroup).preserves_epimorphisms := +{ preserves := λ X Y f e, by rwa [epi_iff_surjective, ←category_theory.epi_iff_surjective] at e } + +end CommGroup + +end diff --git a/src/algebra/category/Group/equivalence_Group_AddGroup.lean b/src/algebra/category/Group/equivalence_Group_AddGroup.lean new file mode 100644 index 0000000000000..036c5d2170992 --- /dev/null +++ b/src/algebra/category/Group/equivalence_Group_AddGroup.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import algebra.category.Group.basic +import algebra.hom.equiv.type_tags + +/-! +# Equivalence between `Group` and `AddGroup` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains two equivalences: +* `Group_AddGroup_equivalence` : the equivalence between `Group` and `AddGroup` by sending + `X : Group` to `additive X` and `Y : AddGroup` to `multiplicative Y`. +* `CommGroup_AddCommGroup_equivalence` : the equivalence between `CommGroup` and `AddCommGroup` by + sending `X : CommGroup` to `additive X` and `Y : AddCommGroup` to `multiplicative Y`. +-/ + +open category_theory + +namespace Group + +/-- +The functor `Group ⥤ AddGroup` by sending `X ↦ additive X` and `f ↦ f`. +-/ +@[simps] def to_AddGroup : Group ⥤ AddGroup := +{ obj := λ X, AddGroup.of (additive X), + map := λ X Y, monoid_hom.to_additive } + +end Group + +namespace CommGroup + +/-- +The functor `CommGroup ⥤ AddCommGroup` by sending `X ↦ additive X` and `f ↦ f`. +-/ +@[simps] def to_AddCommGroup : CommGroup ⥤ AddCommGroup := +{ obj := λ X, AddCommGroup.of (additive X), + map := λ X Y, monoid_hom.to_additive } + +end CommGroup + +namespace AddGroup + +/-- +The functor `AddGroup ⥤ Group` by sending `X ↦ multiplicative Y` and `f ↦ f`. +-/ +@[simps] def to_Group : AddGroup ⥤ Group := +{ obj := λ X, Group.of (multiplicative X), + map := λ X Y, add_monoid_hom.to_multiplicative } + +end AddGroup + +namespace AddCommGroup + +/-- +The functor `AddCommGroup ⥤ CommGroup` by sending `X ↦ multiplicative Y` and `f ↦ f`. +-/ +@[simps] def to_CommGroup : AddCommGroup ⥤ CommGroup := +{ obj := λ X, CommGroup.of (multiplicative X), + map := λ X Y, add_monoid_hom.to_multiplicative } + +end AddCommGroup + +/-- +The equivalence of categories between `Group` and `AddGroup` +-/ +@[simps] def Group_AddGroup_equivalence : Group ≌ AddGroup := +equivalence.mk Group.to_AddGroup AddGroup.to_Group + (nat_iso.of_components + (λ X, mul_equiv.to_Group_iso (mul_equiv.multiplicative_additive X)) + (λ X Y f, rfl)) + (nat_iso.of_components + (λ X, add_equiv.to_AddGroup_iso (add_equiv.additive_multiplicative X)) + (λ X Y f, rfl)) + +/-- +The equivalence of categories between `CommGroup` and `AddCommGroup`. +-/ +@[simps] def CommGroup_AddCommGroup_equivalence : CommGroup ≌ AddCommGroup := +equivalence.mk CommGroup.to_AddCommGroup AddCommGroup.to_CommGroup + (nat_iso.of_components + (λ X, mul_equiv.to_CommGroup_iso (mul_equiv.multiplicative_additive X)) + (λ X Y f, rfl)) + (nat_iso.of_components + (λ X, add_equiv.to_AddCommGroup_iso (add_equiv.additive_multiplicative X)) + (λ X Y f, rfl)) diff --git a/src/algebra/category/Group/filtered_colimits.lean b/src/algebra/category/Group/filtered_colimits.lean index ff4eaf71c84da..52be1744411f1 100644 --- a/src/algebra/category/Group/filtered_colimits.lean +++ b/src/algebra/category/Group/filtered_colimits.lean @@ -9,6 +9,9 @@ import algebra.category.Mon.filtered_colimits /-! # The forgetful functor from (commutative) (additive) groups preserves filtered colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Forgetful functors from algebraic categories usually don't preserve colimits. However, they tend to preserve _filtered_ colimits. @@ -20,7 +23,7 @@ particular, this implies that `forget Group` preserves filtered colimits. Simila -/ -universe v +universes v u noncomputable theory open_locale classical @@ -37,7 +40,7 @@ open Mon.filtered_colimits (colimit_one_eq colimit_mul_mk_eq) -- We use parameters here, mainly so we can have the abbreviations `G` and `G.mk` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ Group.{v}) +parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ Group.{max v u}) /-- The colimit of `F ⋙ forget₂ Group Mon` in the category `Mon`. @@ -45,7 +48,7 @@ In the following, we will show that this has the structure of a group. -/ @[to_additive "The colimit of `F ⋙ forget₂ AddGroup AddMon` in the category `AddMon`. In the following, we will show that this has the structure of an additive group."] -abbreviation G : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ Group Mon) +abbreviation G : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ Group Mon.{max v u}) /-- The canonical projection into the colimit, as a quotient type. -/ @[to_additive "The canonical projection into the colimit, as a quotient type."] @@ -93,8 +96,9 @@ instance colimit_group : group G := { mul_left_inv := λ x, begin apply quot.induction_on x, clear x, intro x, cases x with j x, - erw [colimit_inv_mk_eq, colimit_mul_mk_eq (F ⋙ forget₂ Group Mon) ⟨j, _⟩ ⟨j, _⟩ j (𝟙 j) (𝟙 j), - colimit_one_eq (F ⋙ forget₂ Group Mon) j], + erw [colimit_inv_mk_eq, + colimit_mul_mk_eq (F ⋙ forget₂ Group Mon.{max v u}) ⟨j, _⟩ ⟨j, _⟩ j (𝟙 j) (𝟙 j), + colimit_one_eq (F ⋙ forget₂ Group Mon.{max v u}) j], dsimp, simp only [category_theory.functor.map_id, id_apply, mul_left_inv], end, @@ -109,12 +113,12 @@ def colimit : Group := Group.of G @[to_additive "The cocone over the proposed colimit additive group."] def colimit_cocone : cocone F := { X := colimit, - ι := { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ Group Mon)).ι } } + ι := { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ Group Mon.{max v u})).ι } } /-- The proposed colimit cocone is a colimit in `Group`. -/ @[to_additive "The proposed colimit cocone is a colimit in `AddGroup`."] def colimit_cocone_is_colimit : is_colimit colimit_cocone := -{ desc := λ t, Mon.filtered_colimits.colimit_desc (F ⋙ forget₂ Group Mon) +{ desc := λ t, Mon.filtered_colimits.colimit_desc (F ⋙ forget₂ Group Mon.{max v u}) ((forget₂ Group Mon).map_cocone t), fac' := λ t j, monoid_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget Group)).fac ((forget Group).map_cocone t) j, @@ -124,15 +128,15 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := @[to_additive forget₂_AddMon_preserves_filtered_colimits] instance forget₂_Mon_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ Group Mon.{v}) := + preserves_filtered_colimits (forget₂ Group Mon.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) - (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ Group Mon.{v})) } } + (colimit_cocone_is_colimit.{u u} F) + (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ Group Mon.{u})) } } @[to_additive] -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget Group) := -limits.comp_preserves_filtered_colimits (forget₂ Group Mon) (forget Mon) +instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget Group.{u}) := +limits.comp_preserves_filtered_colimits (forget₂ Group Mon) (forget Mon.{u}) end @@ -145,7 +149,7 @@ section -- We use parameters here, mainly so we can have the abbreviation `G` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommGroup.{v}) +parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommGroup.{max v u}) /-- The colimit of `F ⋙ forget₂ CommGroup Group` in the category `Group`. @@ -153,12 +157,12 @@ In the following, we will show that this has the structure of a _commutative_ gr -/ @[to_additive "The colimit of `F ⋙ forget₂ AddCommGroup AddGroup` in the category `AddGroup`. In the following, we will show that this has the structure of a _commutative_ additive group."] -abbreviation G : Group := Group.filtered_colimits.colimit (F ⋙ forget₂ CommGroup Group.{v}) +abbreviation G : Group := Group.filtered_colimits.colimit (F ⋙ forget₂ CommGroup Group.{max v u}) @[to_additive] instance colimit_comm_group : comm_group G := { ..G.group, - ..CommMon.filtered_colimits.colimit_comm_monoid (F ⋙ forget₂ CommGroup CommMon.{v}) } + ..CommMon.filtered_colimits.colimit_comm_monoid (F ⋙ forget₂ CommGroup CommMon.{max v u}) } /-- The bundled commutative group giving the filtered colimit of a diagram. -/ @[to_additive "The bundled additive commutative group giving the filtered colimit of a diagram."] @@ -168,14 +172,14 @@ def colimit : CommGroup := CommGroup.of G @[to_additive "The cocone over the proposed colimit additive commutative group."] def colimit_cocone : cocone F := { X := colimit, - ι := { ..(Group.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommGroup Group)).ι } } + ι := { ..(Group.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommGroup Group.{max v u})).ι } } /-- The proposed colimit cocone is a colimit in `CommGroup`. -/ @[to_additive "The proposed colimit cocone is a colimit in `AddCommGroup`."] def colimit_cocone_is_colimit : is_colimit colimit_cocone := { desc := λ t, - (Group.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommGroup Group.{v})).desc - ((forget₂ CommGroup Group.{v}).map_cocone t), + (Group.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommGroup Group.{max v u})).desc + ((forget₂ CommGroup Group.{max v u}).map_cocone t), fac' := λ t j, monoid_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget CommGroup)).fac ((forget CommGroup).map_cocone t) j, @@ -185,15 +189,17 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := @[to_additive forget₂_AddGroup_preserves_filtered_colimits] instance forget₂_Group_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ CommGroup Group.{v}) := + preserves_filtered_colimits (forget₂ CommGroup Group.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) - (Group.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommGroup Group.{v})) } } + (colimit_cocone_is_colimit.{u u} F) + (Group.filtered_colimits.colimit_cocone_is_colimit + (F ⋙ forget₂ CommGroup Group.{u})) } } @[to_additive] -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget CommGroup) := -limits.comp_preserves_filtered_colimits (forget₂ CommGroup Group) (forget Group) +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget CommGroup.{u}) := +limits.comp_preserves_filtered_colimits (forget₂ CommGroup Group) (forget Group.{u}) end diff --git a/src/algebra/category/Group/images.lean b/src/algebra/category/Group/images.lean index 929d2d7082073..a7c6d9101f729 100644 --- a/src/algebra/category/Group/images.lean +++ b/src/algebra/category/Group/images.lean @@ -5,11 +5,13 @@ Authors: Scott Morrison -/ import algebra.category.Group.abelian import category_theory.limits.shapes.images -import category_theory.limits.types /-! # The category of commutative additive groups has images. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Note that we don't need to register any of the constructions here as instances, because we get them from the fact that `AddCommGroup` is an abelian category. -/ diff --git a/src/algebra/category/Group/injective.lean b/src/algebra/category/Group/injective.lean new file mode 100644 index 0000000000000..730283712ca55 --- /dev/null +++ b/src/algebra/category/Group/injective.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import algebra.category.Group.epi_mono +import algebra.category.Module.epi_mono +import algebra.module.injective +import category_theory.preadditive.injective +import group_theory.divisible +import ring_theory.principal_ideal_domain + +/-! +# Injective objects in the category of abelian groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that divisible groups are injective object in category of (additive) abelian +groups. + +-/ + +open category_theory +open_locale pointwise + +universe u + +variables (A : Type u) [add_comm_group A] + +namespace AddCommGroup + +lemma injective_of_injective_as_module [injective (⟨A⟩ : Module ℤ)] : + category_theory.injective (⟨A⟩ : AddCommGroup) := +{ factors := λ X Y g f m, + begin + resetI, + let G : (⟨X⟩ : Module ℤ) ⟶ ⟨A⟩ := + { map_smul' := by { intros, rw [ring_hom.id_apply, g.to_fun_eq_coe, map_zsmul], }, ..g }, + let F : (⟨X⟩ : Module ℤ) ⟶ ⟨Y⟩ := + { map_smul' := by { intros, rw [ring_hom.id_apply, f.to_fun_eq_coe, map_zsmul], }, ..f }, + haveI : mono F, + { refine ⟨λ Z α β eq1, _⟩, + let α' : AddCommGroup.of Z ⟶ X := α.to_add_monoid_hom, + let β' : AddCommGroup.of Z ⟶ X := β.to_add_monoid_hom, + have eq2 : α' ≫ f = β' ≫ f, + { ext, + simp only [category_theory.comp_apply, linear_map.to_add_monoid_hom_coe], + simpa only [Module.coe_comp, linear_map.coe_mk, + function.comp_app] using fun_like.congr_fun eq1 x }, + rw cancel_mono at eq2, + ext, simpa only using fun_like.congr_fun eq2 x, }, + refine ⟨(injective.factor_thru G F).to_add_monoid_hom, _⟩, + ext, convert fun_like.congr_fun (injective.comp_factor_thru G F) x, + end } + +lemma injective_as_module_of_injective_as_Ab [injective (⟨A⟩ : AddCommGroup)] : + injective (⟨A⟩ : Module ℤ) := +{ factors := λ X Y g f m, + begin + resetI, + let G : (⟨X⟩ : AddCommGroup) ⟶ ⟨A⟩ := g.to_add_monoid_hom, + let F : (⟨X⟩ : AddCommGroup) ⟶ ⟨Y⟩ := f.to_add_monoid_hom, + haveI : mono F, + { rw mono_iff_injective, intros _ _ h, exact ((Module.mono_iff_injective f).mp m) h, }, + refine ⟨{map_smul' := _, ..injective.factor_thru G F}, _⟩, + { intros m x, rw [add_monoid_hom.to_fun_eq_coe, ring_hom.id_apply], + induction m using int.induction_on with n hn n hn, + { rw [zero_smul], + convert map_zero _, + convert zero_smul _ x, }, + { simp only [add_smul, map_add, hn, one_smul], }, + { simp only [sub_smul, map_sub, hn, one_smul] }, }, + ext, convert fun_like.congr_fun (injective.comp_factor_thru G F) x, + end } + +instance injective_of_divisible [divisible_by A ℤ] : + category_theory.injective (⟨A⟩ : AddCommGroup) := +@@injective_of_injective_as_module A _ $ +@@module.injective_object_of_injective_module ℤ _ A _ _ $ +module.Baer.injective $ +λ I g, begin + rcases is_principal_ideal_ring.principal I with ⟨m, rfl⟩, + by_cases m_eq_zero : m = 0, + { subst m_eq_zero, + refine ⟨{ to_fun := _, map_add' := _, map_smul' := _ }, λ n hn, _⟩, + { intros n, exact g 0, }, + { intros n1 n2, + simp only [map_zero, add_zero] }, + { intros n1 n2, + simp only [map_zero, smul_zero], }, + { rw [submodule.span_singleton_eq_bot.mpr rfl, submodule.mem_bot] at hn, + simp only [hn, map_zero], + symmetry, + convert map_zero _, }, }, + { set gₘ := g ⟨m, submodule.subset_span (set.mem_singleton _)⟩ with gm_eq, + refine ⟨{ to_fun := _, map_add' := _, map_smul' := _ }, λ n hn, _⟩, + { intros n, + exact n • divisible_by.div gₘ m, }, + { intros n1 n2, simp only [add_smul], }, + { intros n1 n2, + rw [ring_hom.id_apply, smul_eq_mul, mul_smul], }, + { rw submodule.mem_span_singleton at hn, + rcases hn with ⟨n, rfl⟩, + simp only [gm_eq, algebra.id.smul_eq_mul, linear_map.coe_mk], + rw [mul_smul, divisible_by.div_cancel (g ⟨m, _⟩) m_eq_zero, ←linear_map.map_smul], + congr, }, }, +end + +end AddCommGroup diff --git a/src/algebra/category/Group/limits.lean b/src/algebra/category/Group/limits.lean index 77561fbcd2049..dfd5969dd3b2d 100644 --- a/src/algebra/category/Group/limits.lean +++ b/src/algebra/category/Group/limits.lean @@ -6,13 +6,15 @@ Authors: Scott Morrison import algebra.category.Mon.limits import algebra.category.Group.preadditive import category_theory.over -import category_theory.limits.concrete_category -import category_theory.limits.shapes.concrete_category import group_theory.subgroup.basic +import category_theory.concrete_category.elementwise /-! # The category of (commutative) (additive) groups has all limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Further, these limits are preserved by the forgetful functor --- that is, the underlying types are just the limits in the category of types. @@ -21,16 +23,16 @@ the underlying types are just the limits in the category of types. open category_theory open category_theory.limits -universe u +universes v u noncomputable theory -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] namespace Group @[to_additive] -instance group_obj (F : J ⥤ Group) (j) : +instance group_obj (F : J ⥤ Group.{max v u}) (j) : group ((F ⋙ forget Group).obj j) := by { change group (F.obj j), apply_instance } @@ -51,8 +53,8 @@ def sections_subgroup (F : J ⥤ Group) : ..(Mon.sections_submonoid (F ⋙ forget₂ Group Mon)) } @[to_additive] -instance limit_group (F : J ⥤ Group) : - group (types.limit_cone (F ⋙ forget Group.{u})).X := +instance limit_group (F : J ⥤ Group.{max v u}) : + group (types.limit_cone (F ⋙ forget Group)).X := begin change group (sections_subgroup F), apply_instance, @@ -66,16 +68,18 @@ the existing limit. -/ All we need to do is notice that the limit point has an `add_group` instance available, and then reuse the existing limit."] -instance (F : J ⥤ Group) : creates_limit F (forget₂ Group Mon.{u}) := +instance forget₂.creates_limit (F : J ⥤ Group.{max v u}) : + creates_limit F (forget₂ Group.{max v u} Mon.{max v u}) := creates_limit_of_reflects_iso (λ c' t, { lifted_cone := { X := Group.of (types.limit_cone (F ⋙ forget Group)).X, π := - { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ Group Mon.{u}), - naturality' := (Mon.has_limits.limit_cone (F ⋙ forget₂ _ _)).π.naturality, } }, + { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ Group Mon.{max v u}), + naturality' := + (Mon.has_limits.limit_cone (F ⋙ forget₂ Group Mon.{max v u})).π.naturality, } }, valid_lift := by apply is_limit.unique_up_to_iso (Mon.has_limits.limit_cone_is_limit _) t, - makes_limit := is_limit.of_faithful (forget₂ Group Mon.{u}) (Mon.has_limits.limit_cone_is_limit _) - (λ s, _) (λ s, rfl) }) + makes_limit := is_limit.of_faithful (forget₂ Group Mon.{max v u}) + (Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) }) /-- A choice of limit cone for a functor into `Group`. @@ -83,8 +87,8 @@ A choice of limit cone for a functor into `Group`. -/ @[to_additive "A choice of limit cone for a functor into `Group`. (Generally, you'll just want to use `limit F`.)"] -def limit_cone (F : J ⥤ Group) : cone F := -lift_limit (limit.is_limit (F ⋙ (forget₂ Group Mon.{u}))) +def limit_cone (F : J ⥤ Group.{max v u}) : cone F := +lift_limit (limit.is_limit (F ⋙ (forget₂ Group Mon.{max v u}))) /-- The chosen cone is a limit cone. @@ -92,14 +96,17 @@ The chosen cone is a limit cone. -/ @[to_additive "The chosen cone is a limit cone. (Generally, you'll just want to use `limit.cone F`.)"] -def limit_cone_is_limit (F : J ⥤ Group) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ Group.{max v u}) : is_limit (limit_cone F) := lifted_limit_is_limit _ /-- The category of groups has all limits. -/ @[to_additive "The category of additive groups has all limits."] -instance has_limits : has_limits Group := +instance has_limits_of_size : has_limits_of_size.{v v} Group.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI - { has_limit := λ F, has_limit_of_created F (forget₂ Group Mon) } } -- TODO use the above instead? + { has_limit := λ F, has_limit_of_created F (forget₂ Group Mon.{max v u}) } } + +@[to_additive] +instance has_limits : has_limits Group.{u} := Group.has_limits_of_size.{u u} /-- The forgetful functor from groups to monoids preserves all limits. @@ -110,34 +117,44 @@ to additive monoids preserves all limits. This means the underlying additive monoid of a limit can be computed as a limit in the category of additive monoids."] -instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ Group Mon) := +instance forget₂_Mon_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ Group Mon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, { preserves_limit := λ F, by apply_instance } } +@[to_additive] +instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ Group Mon.{u}) := +Group.forget₂_Mon_preserves_limits_of_size.{u u} + /-- The forgetful functor from groups to types preserves all limits. This means the underlying type of a limit can be computed as a limit in the category of types. -/ @[to_additive "The forgetful functor from additive groups to types preserves all limits. This means the underlying type of a limit can be computed as a limit in the category of types."] -instance forget_preserves_limits : preserves_limits (forget Group) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget Group.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ Group Mon) (forget Mon) } } +@[to_additive] +instance forget_preserves_limits : preserves_limits (forget Group.{u}) := +Group.forget_preserves_limits_of_size.{u u} + end Group namespace CommGroup @[to_additive] -instance comm_group_obj (F : J ⥤ CommGroup) (j) : +instance comm_group_obj (F : J ⥤ CommGroup.{max v u}) (j) : comm_group ((F ⋙ forget CommGroup).obj j) := by { change comm_group (F.obj j), apply_instance } @[to_additive] -instance limit_comm_group (F : J ⥤ CommGroup) : - comm_group (types.limit_cone (F ⋙ forget CommGroup.{u})).X := +instance limit_comm_group (F : J ⥤ CommGroup.{max v u}) : + comm_group (types.limit_cone (F ⋙ forget CommGroup.{max v u})).X := @subgroup.to_comm_group (Π j, F.obj j) _ - (Group.sections_subgroup (F ⋙ forget₂ CommGroup Group.{u})) + (Group.sections_subgroup (F ⋙ forget₂ CommGroup Group.{max v u})) /-- We show that the forgetful functor `CommGroup ⥤ Group` creates limits. @@ -145,16 +162,21 @@ We show that the forgetful functor `CommGroup ⥤ Group` creates limits. All we need to do is notice that the limit point has a `comm_group` instance available, and then reuse the existing limit. -/ -@[to_additive] -instance (F : J ⥤ CommGroup) : creates_limit F (forget₂ CommGroup Group.{u}) := +@[to_additive "We show that the forgetful functor `AddCommGroup ⥤ AddGroup` creates limits. + +All we need to do is notice that the limit point has an `add_comm_group` instance available, and +then reuse the existing limit."] +instance forget₂.creates_limit (F : J ⥤ CommGroup.{max v u}) : + creates_limit F (forget₂ CommGroup Group.{max v u}) := creates_limit_of_reflects_iso (λ c' t, { lifted_cone := { X := CommGroup.of (types.limit_cone (F ⋙ forget CommGroup)).X, π := - { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ CommGroup Group.{u} ⋙ forget₂ Group Mon), + { app := Mon.limit_π_monoid_hom + (F ⋙ forget₂ CommGroup Group.{max v u} ⋙ forget₂ Group Mon.{max v u}), naturality' := (Mon.has_limits.limit_cone _).π.naturality, } }, valid_lift := by apply is_limit.unique_up_to_iso (Group.limit_cone_is_limit _) t, - makes_limit := is_limit.of_faithful (forget₂ _ Group.{u} ⋙ forget₂ _ Mon.{u}) + makes_limit := is_limit.of_faithful (forget₂ _ Group.{max v u} ⋙ forget₂ _ Mon.{max v u}) (by apply Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) }) /-- @@ -163,8 +185,8 @@ A choice of limit cone for a functor into `CommGroup`. -/ @[to_additive "A choice of limit cone for a functor into `CommGroup`. (Generally, you'll just want to use `limit F`.)"] -def limit_cone (F : J ⥤ CommGroup) : cone F := -lift_limit (limit.is_limit (F ⋙ (forget₂ CommGroup Group.{u}))) +def limit_cone (F : J ⥤ CommGroup.{max v u}) : cone F := +lift_limit (limit.is_limit (F ⋙ (forget₂ CommGroup Group.{max v u}))) /-- The chosen cone is a limit cone. @@ -172,31 +194,42 @@ The chosen cone is a limit cone. -/ @[to_additive "The chosen cone is a limit cone. (Generally, you'll just wantto use `limit.cone F`.)"] -def limit_cone_is_limit (F : J ⥤ CommGroup) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ CommGroup.{max v u}) : is_limit (limit_cone F) := lifted_limit_is_limit _ /-- The category of commutative groups has all limits. -/ -@[to_additive] -instance has_limits : has_limits CommGroup := +@[to_additive "The category of additive commutative groups has all limits."] +instance has_limits_of_size : has_limits_of_size.{v v} CommGroup.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI - { has_limit := λ F, has_limit_of_created F (forget₂ CommGroup Group) } } + { has_limit := λ F, has_limit_of_created F (forget₂ CommGroup Group.{max v u}) } } + +@[to_additive] +instance has_limits : has_limits CommGroup.{u} := CommGroup.has_limits_of_size.{u u} /-- The forgetful functor from commutative groups to groups preserves all limits. (That is, the underlying group could have been computed instead as limits in the category of groups.) -/ -@[to_additive AddCommGroup.forget₂_AddGroup_preserves_limits] -instance forget₂_Group_preserves_limits : preserves_limits (forget₂ CommGroup Group) := +@[to_additive AddCommGroup.forget₂_AddGroup_preserves_limits +"The forgetful functor from additive commutative groups to groups preserves all limits. +(That is, the underlying group could have been computed instead as limits in the category +of additive groups.)"] +instance forget₂_Group_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ CommGroup Group.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, { preserves_limit := λ F, by apply_instance } } +@[to_additive] +instance forget₂_Group_preserves_limits : preserves_limits (forget₂ CommGroup Group.{u}) := +CommGroup.forget₂_Group_preserves_limits_of_size.{u u} + /-- An auxiliary declaration to speed up typechecking. -/ @[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits_aux "An auxiliary declaration to speed up typechecking."] -def forget₂_CommMon_preserves_limits_aux (F : J ⥤ CommGroup) : +def forget₂_CommMon_preserves_limits_aux (F : J ⥤ CommGroup.{max v u}) : is_limit ((forget₂ CommGroup CommMon).map_cone (limit_cone F)) := CommMon.limit_cone_is_limit (F ⋙ forget₂ CommGroup CommMon) @@ -205,8 +238,12 @@ The forgetful functor from commutative groups to commutative monoids preserves a (That is, the underlying commutative monoids could have been computed instead as limits in the category of commutative monoids.) -/ -@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits] -instance forget₂_CommMon_preserves_limits : preserves_limits (forget₂ CommGroup CommMon) := +@[to_additive AddCommGroup.forget₂_AddCommMon_preserves_limits +"The forgetful functor from additive commutative groups to additive commutative monoids preserves +all limits. (That is, the underlying additive commutative monoids could have been computed instead +as limits in the category of additive commutative monoids.)"] +instance forget₂_CommMon_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ CommGroup CommMon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (forget₂_CommMon_preserves_limits_aux F) } } @@ -215,11 +252,17 @@ instance forget₂_CommMon_preserves_limits : preserves_limits (forget₂ CommGr The forgetful functor from commutative groups to types preserves all limits. (That is, the underlying types could have been computed instead as limits in the category of types.) -/ -@[to_additive AddCommGroup.forget_preserves_limits] -instance forget_preserves_limits : preserves_limits (forget CommGroup) := +@[to_additive AddCommGroup.forget_preserves_limits +"The forgetful functor from additive commutative groups to types preserves all limits. (That is, +the underlying types could have been computed instead as limits in the category of types.)"] +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget CommGroup.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommGroup Group) (forget Group) } } +-- Verify we can form limits indexed over smaller categories. +example (f : ℕ → AddCommGroup) : has_product f := by apply_instance + end CommGroup namespace AddCommGroup @@ -228,7 +271,7 @@ namespace AddCommGroup The categorical kernel of a morphism in `AddCommGroup` agrees with the usual group-theoretical kernel. -/ -def kernel_iso_ker {G H : AddCommGroup} (f : G ⟶ H) : +def kernel_iso_ker {G H : AddCommGroup.{u}} (f : G ⟶ H) : kernel f ≅ AddCommGroup.of f.ker := { hom := { to_fun := λ g, ⟨kernel.ι f g, diff --git a/src/algebra/category/Group/preadditive.lean b/src/algebra/category/Group/preadditive.lean index 41fa01176c83b..f6002036a76f0 100644 --- a/src/algebra/category/Group/preadditive.lean +++ b/src/algebra/category/Group/preadditive.lean @@ -4,10 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel -/ import algebra.category.Group.basic -import category_theory.preadditive +import category_theory.preadditive.basic /-! # The category of additive commutative groups is preadditive. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory diff --git a/src/algebra/category/Group/subobject.lean b/src/algebra/category/Group/subobject.lean index 07506cf2a8e19..47fca85c2d57a 100644 --- a/src/algebra/category/Group/subobject.lean +++ b/src/algebra/category/Group/subobject.lean @@ -8,6 +8,9 @@ import algebra.category.Module.subobject /-! # The category of abelian groups is well-powered + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory diff --git a/src/algebra/category/Group/zero.lean b/src/algebra/category/Group/zero.lean index b613d33acfaad..a58fbfeb33a4b 100644 --- a/src/algebra/category/Group/zero.lean +++ b/src/algebra/category/Group/zero.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import algebra.category.Group.basic -import category_theory.limits.shapes.zero_morphisms +import category_theory.limits.shapes.zero_objects /-! # The category of (commutative) (additive) groups has a zero object. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `AddCommGroup` also has zero morphisms. For definitional reasons, we infer this from preadditivity rather than from the existence of a zero object. -/ diff --git a/src/algebra/category/GroupWithZero.lean b/src/algebra/category/GroupWithZero.lean index 78d5646203052..522d953a2e396 100644 --- a/src/algebra/category/GroupWithZero.lean +++ b/src/algebra/category/GroupWithZero.lean @@ -3,12 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import algebra.category.Group.basic import category_theory.category.Bipointed +import algebra.category.Mon.basic /-! # The category of groups with zero +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `GroupWithZero`, the category of groups with zero. -/ diff --git a/src/algebra/category/Module/abelian.lean b/src/algebra/category/Module/abelian.lean index c5bee70e2efed..f2e94e5b62e50 100644 --- a/src/algebra/category/Module/abelian.lean +++ b/src/algebra/category/Module/abelian.lean @@ -11,6 +11,9 @@ import category_theory.abelian.exact /-! # The category of left R-modules is abelian. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Additionally, two linear maps are exact in the categorical sense iff `range f = ker g`. -/ @@ -19,7 +22,7 @@ open category_theory.limits noncomputable theory -universes v u +universes w v u namespace Module variables {R : Type u} [ring R] {M N : Module.{v} R} (f : M ⟶ N) @@ -68,13 +71,33 @@ def normal_epi (hf : epi f) : normal_epi f := by { ext, refl } } /-- The category of R-modules is abelian. -/ -instance : abelian (Module R) := -{ has_finite_products := ⟨by apply_instance⟩, - has_kernels := by apply_instance, +instance abelian : abelian (Module R) := +{ has_finite_products := ⟨λ n, limits.has_limits_of_shape_of_has_limits⟩, + has_kernels := limits.has_kernels_of_has_equalizers (Module R), has_cokernels := has_cokernels_Module, normal_mono_of_mono := λ X Y, normal_mono, normal_epi_of_epi := λ X Y, normal_epi } +section reflects_limits +/- We need to put this in this weird spot because we need to know that the category of modules + is balanced. -/ + +instance forget_reflects_limits_of_size : + reflects_limits_of_size.{v v} (forget (Module.{max v w} R)) := +reflects_limits_of_reflects_isomorphisms + +instance forget₂_reflects_limits_of_size : + reflects_limits_of_size.{v v} (forget₂ (Module.{max v w} R) AddCommGroup.{max v w}) := +reflects_limits_of_reflects_isomorphisms + +instance forget_reflects_limits : reflects_limits (forget (Module.{v} R)) := +Module.forget_reflects_limits_of_size.{v v} + +instance forget₂_reflects_limits : reflects_limits (forget₂ (Module.{v} R) AddCommGroup.{v}) := +Module.forget₂_reflects_limits_of_size.{v v} + +end reflects_limits + variables {O : Module.{v} R} (g : N ⟶ O) open linear_map diff --git a/src/algebra/category/Module/adjunctions.lean b/src/algebra/category/Module/adjunctions.lean index 6a52ae82bbc3d..0a2b07344bc18 100644 --- a/src/algebra/category/Module/adjunctions.lean +++ b/src/algebra/category/Module/adjunctions.lean @@ -3,13 +3,16 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Johan Commelin -/ -import algebra.category.Module.monoidal +import algebra.category.Module.monoidal.basic import category_theory.monoidal.functorial -import category_theory.monoidal.types +import category_theory.monoidal.types.basic import linear_algebra.direct_sum.finsupp import category_theory.linear.linear_functor /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The functor of forming finitely supported functions on a type with values in a `[ring R]` is the left adjoint of the forgetful functor from `R`-modules to types. @@ -63,13 +66,15 @@ local attribute [ext] tensor_product.ext def ε : 𝟙_ (Module.{u} R) ⟶ (free R).obj (𝟙_ (Type u)) := finsupp.lsingle punit.star +@[simp] lemma ε_apply (r : R) : ε R r = finsupp.single punit.star r := rfl + /-- (Implementation detail) The tensorator for `free R`. -/ -def μ (α β : Type u) : (free R).obj α ⊗ (free R).obj β ⟶ (free R).obj (α ⊗ β) := -(finsupp_tensor_finsupp' R α β).to_linear_map +def μ (α β : Type u) : (free R).obj α ⊗ (free R).obj β ≅ (free R).obj (α ⊗ β) := +(finsupp_tensor_finsupp' R α β).to_Module_iso lemma μ_natural {X Y X' Y' : Type u} (f : X ⟶ Y) (g : X' ⟶ Y') : - ((free R).map f ⊗ (free R).map g) ≫ (μ R Y Y') = - (μ R X X') ≫ (free R).map (f ⊗ g) := + ((free R).map f ⊗ (free R).map g) ≫ (μ R Y Y').hom = + (μ R X X').hom ≫ (free R).map (f ⊗ g) := begin intros, ext x x' ⟨y, y'⟩, @@ -80,7 +85,7 @@ end lemma left_unitality (X : Type u) : (λ_ ((free R).obj X)).hom = - (ε R ⊗ 𝟙 ((free R).obj X)) ≫ μ R (𝟙_ (Type u)) X ≫ map (free R).obj (λ_ X).hom := + (ε R ⊗ 𝟙 ((free R).obj X)) ≫ (μ R (𝟙_ (Type u)) X).hom ≫ map (free R).obj (λ_ X).hom := begin intros, ext, @@ -92,7 +97,7 @@ end lemma right_unitality (X : Type u) : (ρ_ ((free R).obj X)).hom = - (𝟙 ((free R).obj X) ⊗ ε R) ≫ μ R X (𝟙_ (Type u)) ≫ map (free R).obj (ρ_ X).hom := + (𝟙 ((free R).obj X) ⊗ ε R) ≫ (μ R X (𝟙_ (Type u))).hom ≫ map (free R).obj (ρ_ X).hom := begin intros, ext, @@ -103,9 +108,9 @@ begin end lemma associativity (X Y Z : Type u) : - (μ R X Y ⊗ 𝟙 ((free R).obj Z)) ≫ μ R (X ⊗ Y) Z ≫ map (free R).obj (α_ X Y Z).hom = + ((μ R X Y).hom ⊗ 𝟙 ((free R).obj Z)) ≫ (μ R (X ⊗ Y) Z).hom ≫ map (free R).obj (α_ X Y Z).hom = (α_ ((free R).obj X) ((free R).obj Y) ((free R).obj Z)).hom ≫ - (𝟙 ((free R).obj X) ⊗ μ R Y Z) ≫ μ R X (Y ⊗ Z) := + (𝟙 ((free R).obj X) ⊗ (μ R Y Z).hom) ≫ (μ R X (Y ⊗ Z)).hom := begin intros, ext, @@ -116,18 +121,33 @@ end /-- The free R-module functor is lax monoidal. -/ -- In fact, it's strong monoidal, but we don't yet have a typeclass for that. +@[simps] instance : lax_monoidal.{u} (free R).obj := { -- Send `R` to `punit →₀ R` ε := ε R, -- Send `(α →₀ R) ⊗ (β →₀ R)` to `α × β →₀ R` - μ := μ R, + μ := λ X Y, (μ R X Y).hom, μ_natural' := λ X Y X' Y' f g, μ_natural R f g, left_unitality' := left_unitality R, right_unitality' := right_unitality R, associativity' := associativity R, } +instance : is_iso (lax_monoidal.ε (free R).obj) := +⟨⟨finsupp.lapply punit.star, ⟨by { ext, simp, }, by { ext ⟨⟩ ⟨⟩, simp, }⟩⟩⟩ + end free +variables [comm_ring R] + +/-- The free functor `Type u ⥤ Module R`, as a monoidal functor. -/ +def monoidal_free : monoidal_functor (Type u) (Module.{u} R) := +{ ε_is_iso := by { dsimp, apply_instance, }, + μ_is_iso := λ X Y, by { dsimp, apply_instance, }, + ..lax_monoidal_functor.of (free R).obj } + +example (X Y : Type u) : (free R).obj (X × Y) ≅ (free R).obj X ⊗ (free R).obj Y := +((monoidal_free R).μ_iso X Y).symm + end Module namespace category_theory @@ -139,11 +159,14 @@ universes v u we will equip with a category structure where the morphisms are formal `R`-linear combinations of the morphisms in `C`. -/ -@[nolint unused_arguments has_inhabited_instance] +@[nolint unused_arguments has_nonempty_instance] def Free (R : Type*) (C : Type u) := C /-- Consider an object of `C` as an object of the `R`-linear completion. + +It may be preferable to use `(Free.embedding R C).obj X` instead; +this functor can also be used to lift morphisms. -/ def Free.of (R : Type*) {C : Type u} (X : C) : Free R C := X @@ -170,25 +193,20 @@ instance category_Free : category (Free R C) := namespace Free section -local attribute [simp] category_theory.category_Free - -@[simp] -lemma single_comp_single {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (r s : R) : - (single f r ≫ single g s : (Free.of R X) ⟶ (Free.of R Z)) = single (f ≫ g) (r * s) := -by { dsimp, simp, } +local attribute [reducible] category_theory.category_Free instance : preadditive (Free R C) := { hom_group := λ X Y, finsupp.add_comm_group, add_comp' := λ X Y Z f f' g, begin dsimp, - rw [finsupp.sum_add_index]; + rw [finsupp.sum_add_index']; { simp [add_mul], } end, comp_add' := λ X Y Z f g g', begin dsimp, rw ← finsupp.sum_add, congr, ext r h, - rw [finsupp.sum_add_index]; + rw [finsupp.sum_add_index']; { simp [mul_add], }, end, } @@ -207,8 +225,14 @@ instance : linear R (Free R C) := simp [finsupp.smul_sum, mul_left_comm], end, } +lemma single_comp_single {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) (r s : R) : + (single f r ≫ single g s : (Free.of R X) ⟶ (Free.of R Z)) = single (f ≫ g) (r * s) := +by { dsimp, simp, } + end +local attribute [simp] single_comp_single + /-- A category embeds into its `R`-linear completion. -/ @@ -224,7 +248,7 @@ variables (R) {C} {D : Type u} [category.{v} D] [preadditive D] [linear R D] open preadditive linear /-- -A functor to a preadditive category lifts to a functor from its `R`-linear completion. +A functor to an `R`-linear category lifts to a functor from its `R`-linear completion. -/ @[simps] def lift (F : C ⥤ D) : Free R C ⥤ D := @@ -233,29 +257,29 @@ def lift (F : C ⥤ D) : Free R C ⥤ D := map_id' := by { dsimp [category_theory.category_Free], simp }, map_comp' := λ X Y Z f g, begin apply finsupp.induction_linear f, - { simp, }, + { simp only [limits.zero_comp, sum_zero_index] }, { intros f₁ f₂ w₁ w₂, rw add_comp, - rw [finsupp.sum_add_index, finsupp.sum_add_index], - { simp [w₁, w₂, add_comp], }, - { simp, }, + rw [finsupp.sum_add_index', finsupp.sum_add_index'], + { simp only [w₁, w₂, add_comp] }, + { intros, rw zero_smul }, { intros, simp only [add_smul], }, - { simp, }, + { intros, rw zero_smul }, { intros, simp only [add_smul], }, }, { intros f' r, apply finsupp.induction_linear g, - { simp, }, + { simp only [limits.comp_zero, sum_zero_index] }, { intros f₁ f₂ w₁ w₂, rw comp_add, - rw [finsupp.sum_add_index, finsupp.sum_add_index], - { simp [w₁, w₂, add_comp], }, - { simp, }, + rw [finsupp.sum_add_index', finsupp.sum_add_index'], + { simp only [w₁, w₂, comp_add], }, + { intros, rw zero_smul }, { intros, simp only [add_smul], }, - { simp, }, + { intros, rw zero_smul }, { intros, simp only [add_smul], }, }, { intros g' s, erw single_comp_single, - simp [mul_comm r s, mul_smul], } } + simp [mul_comm r s, mul_smul] } } end, } @[simp] @@ -266,7 +290,7 @@ by simp instance lift_additive (F : C ⥤ D) : (lift R F).additive := { map_add' := λ X Y f g, begin dsimp, - rw finsupp.sum_add_index; simp [add_smul] + rw finsupp.sum_add_index'; simp [add_smul] end, } instance lift_linear (F : C ⥤ D) : (lift R F).linear R := diff --git a/src/algebra/category/Module/algebra.lean b/src/algebra/category/Module/algebra.lean new file mode 100644 index 0000000000000..ba74d2d24bfb0 --- /dev/null +++ b/src/algebra/category/Module/algebra.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import algebra.algebra.restrict_scalars +import category_theory.linear.basic +import algebra.category.Module.basic + +/-! +# Additional typeclass for modules over an algebra + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For an object in `M : Module A`, where `A` is a `k`-algebra, +we provide additional typeclasses on the underlying type `M`, +namely `module k M` and `is_scalar_tower k A M`. +These are not made into instances by default. + +We provide the `linear k (Module A)` instance. + +## Note + +If you begin with a `[module k M] [module A M] [is_scalar_tower k A M]`, +and build a bundled module via `Module.of A M`, +these instances will not necessarily agree with the original ones. + +It seems without making a parallel version `Module' k A`, for modules over a `k`-algebra `A`, +that carries these typeclasses, this seems hard to achieve. +(An alternative would be to always require these typeclasses, and remove the original `Module`, +requiring users to write `Module' ℤ A` when `A` is merely a ring.) +-/ + +universes v u w +open category_theory + +namespace Module + +variables {k : Type u} [field k] +variables {A : Type w} [ring A] [algebra k A] + +/-- +Type synonym for considering a module over a `k`-algebra as a `k`-module. +-/ +def module_of_algebra_Module (M : Module.{v} A) : module k M := +restrict_scalars.module k A M + +localized "attribute [instance] Module.module_of_algebra_Module" in Module + +lemma is_scalar_tower_of_algebra_Module (M : Module.{v} A) : is_scalar_tower k A M := +restrict_scalars.is_scalar_tower k A M + +localized "attribute [instance] Module.is_scalar_tower_of_algebra_Module" in Module + +-- We verify that the morphism spaces become `k`-modules. +example (M N : Module.{v} A) : module k (M ⟶ N) := by apply_instance + +instance linear_over_field : linear k (Module.{v} A) := +{ hom_module := λ M N, by apply_instance, } + +end Module diff --git a/src/algebra/category/Module/basic.lean b/src/algebra/category/Module/basic.lean index f5bc120c5a0aa..72ea05ddfb8ad 100644 --- a/src/algebra/category/Module/basic.lean +++ b/src/algebra/category/Module/basic.lean @@ -3,15 +3,19 @@ Copyright (c) 2019 Robert A. Spencer. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Robert A. Spencer, Markus Himmel -/ -import algebra.category.Group.basic -import category_theory.limits.shapes.kernels -import category_theory.linear +import algebra.category.Group.preadditive +import category_theory.linear.basic +import category_theory.elementwise import linear_algebra.basic import category_theory.conj +import category_theory.preadditive.additive_functor /-! # The category of `R`-modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `Module.{v} R` is the category of bundled `R`-modules with carrier in the universe `v`. We show that it is preadditive and show that being an isomorphism, monomorphism and epimorphism is equivalent to being a linear equivalence, an injective linear map and a surjective linear map, @@ -89,10 +93,9 @@ instance has_forget_to_AddCommGroup : has_forget₂ (Module R) AddCommGroup := { obj := λ M, AddCommGroup.of M, map := λ M₁ M₂ f, linear_map.to_add_monoid_hom f } } --- TODO: instantiate `linear_map_class` once that gets defined -instance (M N : Module R) : add_monoid_hom_class (M ⟶ N) M N := +instance (M N : Module R) : linear_map_class (M ⟶ N) R M N := { coe := λ f, f, - .. linear_map.add_monoid_hom_class } + .. linear_map.semilinear_map_class } /-- The object in the category of R-modules associated to an R-module -/ def of (X : Type v) [add_comm_group X] [module R X] : Module R := ⟨X⟩ @@ -123,7 +126,7 @@ instance of_unique {X : Type v} [add_comm_group X] [module R X] [i : unique X] : unique (of R X) := i @[simp] -lemma coe_of (X : Type u) [add_comm_group X] [module R X] : (of R X : Type u) = X := rfl +lemma coe_of (X : Type v) [add_comm_group X] [module R X] : (of R X : Type v) = X := rfl variables {R} @@ -162,19 +165,19 @@ variables {X₁ X₂ : Type v} def Module.as_hom [add_comm_group X₁] [module R X₁] [add_comm_group X₂] [module R X₂] : (X₁ →ₗ[R] X₂) → (Module.of R X₁ ⟶ Module.of R X₂) := id -localized "notation `↟` f : 1024 := Module.as_hom f" in Module +localized "notation (name := Module.as_hom) `↟` f : 1024 := Module.as_hom f" in Module /-- Reinterpreting a linear map in the category of `R`-modules. -/ def Module.as_hom_right [add_comm_group X₁] [module R X₁] {X₂ : Module.{v} R} : (X₁ →ₗ[R] X₂) → (Module.of R X₁ ⟶ X₂) := id -localized "notation `↾` f : 1024 := Module.as_hom_right f" in Module +localized "notation (name := Module.as_hom_right) `↾` f : 1024 := Module.as_hom_right f" in Module /-- Reinterpreting a linear map in the category of `R`-modules. -/ def Module.as_hom_left {X₁ : Module.{v} R} [add_comm_group X₂] [module R X₂] : (X₁ →ₗ[R] X₂) → (X₁ ⟶ Module.of R X₂) := id -localized "notation `↿` f : 1024 := Module.as_hom_left f" in Module +localized "notation (name := Module.as_hom_left) `↿` f : 1024 := Module.as_hom_left f" in Module /-- Build an isomorphism in the category `Module R` from a `linear_equiv` between `module`s. -/ @[simps] @@ -256,6 +259,8 @@ instance : preadditive (Module.{v} R) := comp_add' := λ P Q R f g g', show f ≫ (g + g') = f ≫ g + f ≫ g', by { ext, simp } } +instance forget₂_AddCommGroup_additive : (forget₂ (Module.{v} R) AddCommGroup).additive := {} + section variables {S : Type u} [comm_ring S] diff --git a/src/algebra/category/Module/biproducts.lean b/src/algebra/category/Module/biproducts.lean index ee08a2841074a..c03e3fef42f71 100644 --- a/src/algebra/category/Module/biproducts.lean +++ b/src/algebra/category/Module/biproducts.lean @@ -5,10 +5,14 @@ Authors: Scott Morrison -/ import algebra.group.pi import category_theory.limits.shapes.biproducts -import algebra.category.Module.limits +import algebra.category.Module.abelian +import algebra.homology.short_exact.abelian /-! # The category of `R`-modules has finite biproducts + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory @@ -16,7 +20,7 @@ open category_theory.limits open_locale big_operators -universes v u +universes w v u namespace Module @@ -39,20 +43,25 @@ Construct limit data for a binary product in `Module R`, using `Module.of R (M def binary_product_limit_cone (M N : Module.{v} R) : limits.limit_cone (pair M N) := { cone := { X := Module.of R (M × N), - π := { app := λ j, walking_pair.cases_on j (linear_map.fst R M N) (linear_map.snd R M N) }}, + π := + { app := λ j, discrete.cases_on j + (λ j, walking_pair.cases_on j (linear_map.fst R M N) (linear_map.snd R M N)), + naturality' := by rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟨⟩⟩⟩; refl, }}, is_limit := - { lift := λ s, linear_map.prod (s.π.app walking_pair.left) (s.π.app walking_pair.right), - fac' := by { rintros s (⟨⟩|⟨⟩); { ext x, simp, }, }, + { lift := λ s, linear_map.prod (s.π.app ⟨walking_pair.left⟩) (s.π.app ⟨walking_pair.right⟩), + fac' := by { rintros s (⟨⟩|⟨⟩); { ext x, simp only + [binary_fan.π_app_right, binary_fan.π_app_left, Module.coe_comp, function.comp_app, + linear_map.fst_apply, linear_map.snd_apply, linear_map.prod_apply, pi.prod], }, }, uniq' := λ s m w, begin - ext; [rw ← w walking_pair.left, rw ← w walking_pair.right]; refl, + ext; [rw ← w ⟨walking_pair.left⟩, rw ← w ⟨walking_pair.right⟩]; refl, end, } } @[simp] lemma binary_product_limit_cone_cone_π_app_left (M N : Module.{v} R) : - (binary_product_limit_cone M N).cone.π.app walking_pair.left = linear_map.fst R M N := rfl + (binary_product_limit_cone M N).cone.π.app ⟨walking_pair.left⟩ = linear_map.fst R M N := rfl @[simp] lemma binary_product_limit_cone_cone_π_app_right (M N : Module.{v} R) : - (binary_product_limit_cone M N).cone.π.app walking_pair.right = linear_map.snd R M N := rfl + (binary_product_limit_cone M N).cone.π.app ⟨walking_pair.right⟩ = linear_map.snd R M N := rfl /-- We verify that the biproduct in `Module R` is isomorphic to @@ -66,64 +75,94 @@ is_limit.cone_point_unique_up_to_iso @[simp, elementwise] lemma biprod_iso_prod_inv_comp_fst (M N : Module.{v} R) : (biprod_iso_prod M N).inv ≫ biprod.fst = linear_map.fst R M N := -is_limit.cone_point_unique_up_to_iso_inv_comp _ _ walking_pair.left +is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.left) @[simp, elementwise] lemma biprod_iso_prod_inv_comp_snd (M N : Module.{v} R) : (biprod_iso_prod M N).inv ≫ biprod.snd = linear_map.snd R M N := -is_limit.cone_point_unique_up_to_iso_inv_comp _ _ walking_pair.right - -variables {J : Type v} (F : (discrete J) ⥤ Module.{v} R) +is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk walking_pair.right) namespace has_limit +variables {J : Type w} (f : J → Module.{max w v} R) + /-- The map from an arbitrary cone over a indexed family of abelian groups to the cartesian product of those groups. -/ -def lift (s : cone F) : - s.X ⟶ Module.of R (Π j, F.obj j) := -{ to_fun := λ x j, s.π.app j x, +@[simps] +def lift (s : fan f) : + s.X ⟶ Module.of R (Π j, f j) := +{ to_fun := λ x j, s.π.app ⟨j⟩ x, map_add' := λ x y, by { ext, simp, }, map_smul' := λ r x, by { ext, simp, }, } -@[simp] lemma lift_apply (s : cone F) (x : s.X) (j : J) : (lift F s) x j = s.π.app j x := rfl - /-- Construct limit data for a product in `Module R`, using `Module.of R (Π j, F.obj j)`. -/ -@[simps] def product_limit_cone : limits.limit_cone F := +@[simps] def product_limit_cone : limits.limit_cone (discrete.functor f) := { cone := - { X := Module.of R (Π j, F.obj j), - π := discrete.nat_trans (λ j, (linear_map.proj j : (Π j, F.obj j) →ₗ[R] F.obj j)), }, + { X := Module.of R (Π j, f j), + π := discrete.nat_trans (λ j, (linear_map.proj j.as : (Π j, f j) →ₗ[R] f j.as)), }, is_limit := - { lift := lift F, - fac' := λ s j, by { ext, simp, }, + { lift := lift f, + fac' := λ s j, by { cases j, ext, simp, }, uniq' := λ s m w, begin ext x j, dsimp only [has_limit.lift], simp only [linear_map.coe_mk], - exact congr_arg (λ f : s.X ⟶ F.obj j, (f : s.X → F.obj j) x) (w j), + exact congr_arg (λ g : s.X ⟶ f j, (g : s.X → f j) x) (w ⟨j⟩), end, }, } end has_limit open has_limit +variables {J : Type} (f : J → Module.{v} R) + /-- We verify that the biproduct we've just defined is isomorphic to the `Module R` structure on the dependent function type -/ @[simps hom_apply] noncomputable -def biproduct_iso_pi [decidable_eq J] [fintype J] (f : J → Module.{v} R) : +def biproduct_iso_pi [fintype J] (f : J → Module.{v} R) : (⨁ f : Module.{v} R) ≅ Module.of R (Π j, f j) := is_limit.cone_point_unique_up_to_iso (biproduct.is_limit f) - (product_limit_cone (discrete.functor f)).is_limit + (product_limit_cone f).is_limit -@[simp, elementwise] lemma biproduct_iso_pi_inv_comp_π [decidable_eq J] [fintype J] +@[simp, elementwise] lemma biproduct_iso_pi_inv_comp_π [fintype J] (f : J → Module.{v} R) (j : J) : (biproduct_iso_pi f).inv ≫ biproduct.π f j = (linear_map.proj j : (Π j, f j) →ₗ[R] f j) := -is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _ +is_limit.cone_point_unique_up_to_iso_inv_comp _ _ (discrete.mk j) end Module + +section split_exact + +variables {R : Type u} {A M B : Type v} [ring R] [add_comm_group A] [module R A] + [add_comm_group B] [module R B] [add_comm_group M] [module R M] +variables {j : A →ₗ[R] M} {g : M →ₗ[R] B} +open Module + +/--The isomorphism `A × B ≃ₗ[R] M` coming from a right split exact sequence `0 ⟶ A ⟶ M ⟶ B ⟶ 0` +of modules.-/ +noncomputable def lequiv_prod_of_right_split_exact {f : B →ₗ[R] M} + (hj : function.injective j) (exac : j.range = g.ker) (h : g.comp f = linear_map.id) : + (A × B) ≃ₗ[R] M := +(({ right_split := ⟨as_hom f, h⟩, + mono := (Module.mono_iff_injective $ as_hom j).mpr hj, + exact := (exact_iff _ _).mpr exac } : right_split _ _).splitting.iso.trans $ + biprod_iso_prod _ _).to_linear_equiv.symm + +/--The isomorphism `A × B ≃ₗ[R] M` coming from a left split exact sequence `0 ⟶ A ⟶ M ⟶ B ⟶ 0` +of modules.-/ +noncomputable def lequiv_prod_of_left_split_exact {f : M →ₗ[R] A} + (hg : function.surjective g) (exac : j.range = g.ker) (h : f.comp j = linear_map.id) : + (A × B) ≃ₗ[R] M := +(({ left_split := ⟨as_hom f, h⟩, + epi := (Module.epi_iff_surjective $ as_hom g).mpr hg, + exact := (exact_iff _ _).mpr exac } : left_split _ _).splitting.iso.trans $ + biprod_iso_prod _ _).to_linear_equiv.symm + +end split_exact diff --git a/src/algebra/category/Module/change_of_rings.lean b/src/algebra/category/Module/change_of_rings.lean new file mode 100644 index 0000000000000..327a5e779e98a --- /dev/null +++ b/src/algebra/category/Module/change_of_rings.lean @@ -0,0 +1,525 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import algebra.category.Module.basic +import ring_theory.tensor_product + +/-! +# Change Of Rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `category_theory.Module.restrict_scalars`: given rings `R, S` and a ring homomorphism `R ⟶ S`, + then `restrict_scalars : Module S ⥤ Module R` is defined by `M ↦ M` where `M : S-module` is seen + as `R-module` by `r • m := f r • m` and `S`-linear map `l : M ⟶ M'` is `R`-linear as well. + +* `category_theory.Module.extend_scalars`: given **commutative** rings `R, S` and ring homomorphism + `f : R ⟶ S`, then `extend_scalars : Module R ⥤ Module S` is defined by `M ↦ S ⨂ M` where the + module structure is defined by `s • (s' ⊗ m) := (s * s') ⊗ m` and `R`-linear map `l : M ⟶ M'` + is sent to `S`-linear map `s ⊗ m ↦ s ⊗ l m : S ⨂ M ⟶ S ⨂ M'`. + +* `category_theory.Module.coextend_scalars`: given rings `R, S` and a ring homomorphism `R ⟶ S` + then `coextend_scalars : Module R ⥤ Module S` is defined by `M ↦ (S →ₗ[R] M)` where `S` is seen as + `R-module` by restriction of scalars and `l ↦ l ∘ _`. + +## Main results + +* `category_theory.Module.extend_restrict_scalars_adj`: given commutative rings `R, S` and a ring + homomorphism `f : R →+* S`, the extension and restriction of scalars by `f` are adjoint functors. +* `category_theory.Module.restrict_coextend_scalars_adj`: given rings `R, S` and a ring homomorphism + `f : R ⟶ S` then `coextend_scalars f` is the right adjoint of `restrict_scalars f`. + +## List of notations +Let `R, S` be rings and `f : R →+* S` +* if `M` is an `R`-module, `s : S` and `m : M`, then `s ⊗ₜ[R, f] m` is the pure tensor + `s ⊗ m : S ⊗[R, f] M`. +-/ + + +namespace category_theory.Module + +universes v u₁ u₂ + +namespace restrict_scalars + +variables {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) +variable (M : Module.{v} S) + +/-- Any `S`-module M is also an `R`-module via a ring homomorphism `f : R ⟶ S` by defining + `r • m := f r • m` (`module.comp_hom`). This is called restriction of scalars. -/ +def obj' : Module R := +{ carrier := M, + is_module := module.comp_hom M f } + +/-- +Given an `S`-linear map `g : M → M'` between `S`-modules, `g` is also `R`-linear between `M` and +`M'` by means of restriction of scalars. +-/ +def map' {M M' : Module.{v} S} (g : M ⟶ M') : + obj' f M ⟶ obj' f M' := +{ map_smul' := λ r, g.map_smul (f r), ..g } + +end restrict_scalars + +/-- +The restriction of scalars operation is functorial. For any `f : R →+* S` a ring homomorphism, +* an `S`-module `M` can be considered as `R`-module by `r • m = f r • m` +* an `S`-linear map is also `R`-linear +-/ +def restrict_scalars {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) : + Module.{v} S ⥤ Module.{v} R := +{ obj := restrict_scalars.obj' f, + map := λ _ _, restrict_scalars.map' f, + map_id' := λ _, linear_map.ext $ λ m, rfl, + map_comp' := λ _ _ _ g h, linear_map.ext $ λ m, rfl } + +instance {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) : + category_theory.faithful (restrict_scalars.{v} f) := +{ map_injective' := λ _ _ _ _ h, linear_map.ext $ λ x, by simpa only using fun_like.congr_fun h x } + +@[simp] lemma restrict_scalars.map_apply {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) + {M M' : Module.{v} S} (g : M ⟶ M') (x) : (restrict_scalars f).map g x = g x := rfl + +@[simp] lemma restrict_scalars.smul_def {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) + {M : Module.{v} S} (r : R) (m : (restrict_scalars f).obj M) : r • m = (f r • m : M) := rfl + +lemma restrict_scalars.smul_def' {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) + {M : Module.{v} S} (r : R) (m : M) : (r • m : (restrict_scalars f).obj M) = (f r • m : M) := rfl + +@[priority 100] +instance smul_comm_class_mk {R : Type u₁} {S : Type u₂} [ring R] [comm_ring S] (f : R →+* S) + (M : Type v) [add_comm_group M] [module S M] : + @smul_comm_class R S M ((restrict_scalars.obj' f (Module.mk M)).is_module.to_has_smul) _ := +{ smul_comm := λ r s m, (by simp [←mul_smul, mul_comm] : f r • s • m = s • f r • m) } + +namespace extend_scalars + +open tensor_product + +variables {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) + +section unbundled + +variables (M : Type v) [add_comm_monoid M] [module R M] +-- This notation is necessary because we need to reason about `s ⊗ₜ m` where `s : S` and `m : M`; +-- without this notation, one need to work with `s : (restrict_scalars f).obj ⟨S⟩`. +localized "notation s `⊗ₜ[` R `,` f `]` m := @tensor_product.tmul R _ _ _ _ _ + (module.comp_hom _ f) _ s m" in change_of_rings + +end unbundled + +open_locale change_of_rings + +variables (M : Module.{v} R) + +/-- +Extension of scalars turn an `R`-module into `S`-module by M ↦ S ⨂ M +-/ +def obj' : Module S := +⟨tensor_product R ((restrict_scalars f).obj ⟨S⟩) M⟩ + +/-- +Extension of scalars is a functor where an `R`-module `M` is sent to `S ⊗ M` and +`l : M1 ⟶ M2` is sent to `s ⊗ m ↦ s ⊗ l m` +-/ +def map' {M1 M2 : Module.{v} R} (l : M1 ⟶ M2) : (obj' f M1) ⟶ (obj' f M2) := +-- The "by apply" part makes this require 75% fewer heartbeats to process (#16371). +by apply (@linear_map.base_change R S M1 M2 _ _ ((algebra_map S _).comp f).to_algebra _ _ _ _ l) + +lemma map'_id {M : Module.{v} R} : map' f (𝟙 M) = 𝟙 _ := +linear_map.ext $ λ (x : obj' f M), +begin + dsimp only [map', Module.id_apply], + induction x using tensor_product.induction_on with _ _ m s ihx ihy, + { simp only [map_zero], }, + { rw [linear_map.base_change_tmul, Module.id_apply], }, + { rw [map_add, ihx, ihy] }, +end + +lemma map'_comp {M₁ M₂ M₃ : Module.{v} R} (l₁₂ : M₁ ⟶ M₂) (l₂₃ : M₂ ⟶ M₃) : + map' f (l₁₂ ≫ l₂₃) = map' f l₁₂ ≫ map' f l₂₃ := +linear_map.ext $ λ (x : obj' f M₁), +begin + dsimp only [map'], + induction x using tensor_product.induction_on with _ _ x y ihx ihy, + { refl, }, + { refl, }, + { simp only [map_add, ihx, ihy], }, +end + +end extend_scalars + +/-- +Extension of scalars is a functor where an `R`-module `M` is sent to `S ⊗ M` and +`l : M1 ⟶ M2` is sent to `s ⊗ m ↦ s ⊗ l m` +-/ +def extend_scalars {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) : + Module.{v} R ⥤ Module.{max v u₂} S := +{ obj := λ M, extend_scalars.obj' f M, + map := λ M1 M2 l, extend_scalars.map' f l, + map_id' := λ _, extend_scalars.map'_id f, + map_comp' := λ _ _ _, extend_scalars.map'_comp f } + +namespace extend_scalars + +open_locale change_of_rings + +variables {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) + +@[simp] protected lemma smul_tmul {M : Module.{v} R} (s s' : S) (m : M) : + s • (s' ⊗ₜ[R, f] m : (extend_scalars f).obj M) = (s * s') ⊗ₜ[R, f] m := rfl + +@[simp] lemma map_tmul {M M' : Module.{v} R} (g : M ⟶ M') (s : S) (m : M) : + (extend_scalars f).map g (s ⊗ₜ[R, f] m) = s ⊗ₜ[R, f] g m := rfl + +end extend_scalars + +namespace coextend_scalars + +variables {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) + +section unbundled + +variables (M : Type v) [add_comm_monoid M] [module R M] + +-- We use `S'` to denote `S` viewed as `R`-module, via the map `f`. +local notation `S'` := (restrict_scalars f).obj ⟨S⟩ + +/-- + Given an `R`-module M, consider Hom(S, M) -- the `R`-linear maps between S (as an `R`-module by + means of restriction of scalars) and M. `S` acts on Hom(S, M) by `s • g = x ↦ g (x • s)` + -/ +instance has_smul : has_smul S $ S' →ₗ[R] M := +{ smul := λ s g, + { to_fun := λ (s' : S), g (s' * s : S), + map_add' := λ (x y : S), by simp [add_mul, map_add], + map_smul' := λ r (t : S), by rw [ring_hom.id_apply, @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, + ←linear_map.map_smul, @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, smul_eq_mul, smul_eq_mul, + mul_assoc] } } + +@[simp] lemma smul_apply' (s : S) (g : S' →ₗ[R] M) (s' : S) : + @has_smul.smul _ _ (coextend_scalars.has_smul f _) s g s' = g (s' * s : S) := rfl + +instance mul_action : mul_action S $ S' →ₗ[R] M := +{ one_smul := λ g, linear_map.ext $ λ (s : S), by simp, + mul_smul := λ (s t : S) g, linear_map.ext $ λ (x : S), by simp [mul_assoc], + ..coextend_scalars.has_smul f _ } + +instance distrib_mul_action : distrib_mul_action S $ S' →ₗ[R] M := +{ smul_add := λ s g h, linear_map.ext $ λ (t : S), by simp, + smul_zero := λ s, linear_map.ext $ λ (t : S), by simp, + ..coextend_scalars.mul_action f _ } + +/-- +`S` acts on Hom(S, M) by `s • g = x ↦ g (x • s)`, this action defines an `S`-module structure on +Hom(S, M). + -/ +instance is_module : module S $ S' →ₗ[R] M := +{ add_smul := λ s1 s2 g, linear_map.ext $ λ (x : S), by simp [mul_add], + zero_smul := λ g, linear_map.ext $ λ (x : S), by simp, + ..coextend_scalars.distrib_mul_action f _ } + +end unbundled + +variable (M : Module.{v} R) + +/-- If `M` is an `R`-module, then the set of `R`-linear maps `S →ₗ[R] M` is an `S`-module with +scalar multiplication defined by `s • l := x ↦ l (x • s)`-/ +def obj' : Module S := ⟨(restrict_scalars f).obj ⟨S⟩ →ₗ[R] M⟩ + +instance : has_coe_to_fun (obj' f M) (λ g, S → M) := +{ coe := λ g, g.to_fun } + +/-- If `M, M'` are `R`-modules, then any `R`-linear map `g : M ⟶ M'` induces an `S`-linear map +`(S →ₗ[R] M) ⟶ (S →ₗ[R] M')` defined by `h ↦ g ∘ h`-/ +@[simps] def map' {M M' : Module R} (g : M ⟶ M') : obj' f M ⟶ obj' f M' := +{ to_fun := λ h, g.comp h, + map_add' := λ _ _, linear_map.comp_add _ _ _, + map_smul' := λ s h, linear_map.ext $ λ (t : S), by simpa only [smul_apply'] } + +end coextend_scalars + +/-- +For any rings `R, S` and a ring homomorphism `f : R →+* S`, there is a functor from `R`-module to +`S`-module defined by `M ↦ (S →ₗ[R] M)` where `S` is considered as an `R`-module via restriction of +scalars and `g : M ⟶ M'` is sent to `h ↦ g ∘ h`. +-/ +def coextend_scalars {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) : + Module R ⥤ Module S := +{ obj := coextend_scalars.obj' f, + map := λ _ _, coextend_scalars.map' f, + map_id' := λ M, linear_map.ext $ λ h, linear_map.ext $ λ x, rfl, + map_comp' := λ _ _ _ g h, linear_map.ext $ λ h, linear_map.ext $ λ x, rfl } + +namespace coextend_scalars + +variables {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) + +instance (M : Module R) : has_coe_to_fun ((coextend_scalars f).obj M) (λ g, S → M) := +(infer_instance : has_coe_to_fun (coextend_scalars.obj' f M) _) + +lemma smul_apply (M : Module R) (g : (coextend_scalars f).obj M) (s s' : S) : + (s • g) s' = g (s' * s) := rfl + +@[simp] lemma map_apply {M M' : Module R} (g : M ⟶ M') (x) (s : S) : + (coextend_scalars f).map g x s = g (x s) := rfl + +end coextend_scalars + +namespace restriction_coextension_adj + +variables {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) + +/-- +Given `R`-module X and `S`-module Y, any `g : (restrict_of_scalars f).obj Y ⟶ X` +corresponds to `Y ⟶ (coextend_scalars f).obj X` by sending `y ↦ (s ↦ g (s • y))` +-/ +@[simps] def hom_equiv.from_restriction {X Y} (g : (restrict_scalars f).obj Y ⟶ X) : + Y ⟶ (coextend_scalars f).obj X := +{ to_fun := λ (y : Y), + { to_fun := λ (s : S), g $ (s • y : Y), + map_add' := λ (s1 s2 : S), by simp [add_smul], + map_smul' := λ r (s : S), by rw [ring_hom.id_apply, ←g.map_smul, + @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, smul_eq_mul, mul_smul, + @restrict_scalars.smul_def _ _ _ _ f Y] }, + map_add' := λ (y1 y2 : Y), linear_map.ext $ λ (s : S), + by rw [linear_map.add_apply, linear_map.coe_mk, linear_map.coe_mk, linear_map.coe_mk, + smul_add, map_add], + map_smul' := λ s y, linear_map.ext $ λ (t : S), by simp [mul_smul] } + +/-- +Given `R`-module X and `S`-module Y, any `g : Y ⟶ (coextend_scalars f).obj X` +corresponds to `(restrict_scalars f).obj Y ⟶ X` by `y ↦ g y 1` +-/ +@[simps] def hom_equiv.to_restriction {X Y} (g : Y ⟶ (coextend_scalars f).obj X) : + (restrict_scalars f).obj Y ⟶ X := +{ to_fun := λ (y : Y), (g y).to_fun (1 : S), + map_add' := λ x y, by simp only [g.map_add, linear_map.to_fun_eq_coe, linear_map.add_apply], + map_smul' := λ r (y : Y), by rw [linear_map.to_fun_eq_coe, linear_map.to_fun_eq_coe, + ring_hom.id_apply, ←linear_map.map_smul, restrict_scalars.smul_def f r y, + @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, smul_eq_mul, mul_one, linear_map.map_smul, + coextend_scalars.smul_apply, one_mul], } + +/-- +The natural transformation from identity functor to the composition of restriction and coextension +of scalars. +-/ +@[simps] protected def unit' : 𝟭 (Module S) ⟶ restrict_scalars f ⋙ coextend_scalars f := +{ app := λ Y, + { to_fun := λ (y : Y), + { to_fun := λ (s : S), (s • y : Y), + map_add' := λ s s', add_smul _ _ _, + map_smul' := λ r (s : S), by rw [ring_hom.id_apply, @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, + smul_eq_mul, mul_smul, restrict_scalars.smul_def f] }, + map_add' := λ y1 y2, linear_map.ext $ λ (s : S), by rw [linear_map.add_apply, linear_map.coe_mk, + linear_map.coe_mk, linear_map.coe_mk, smul_add], + map_smul' := λ s (y : Y), linear_map.ext $ λ (t : S), by simp [mul_smul] }, + naturality' := λ Y Y' g, linear_map.ext $ λ (y : Y), linear_map.ext $ λ (s : S), + by simp [coextend_scalars.map_apply] } + +/-- +The natural transformation from the composition of coextension and restriction of scalars to +identity functor. +-/ +@[simps] protected def counit' : coextend_scalars f ⋙ restrict_scalars f ⟶ 𝟭 (Module R) := +{ app := λ X, + { to_fun := λ g, g.to_fun (1 : S), + map_add' := λ x1 x2, by simp [linear_map.to_fun_eq_coe], + map_smul' := λ r (g : (restrict_scalars f).obj ((coextend_scalars f).obj X)), + begin + simp only [linear_map.to_fun_eq_coe, ring_hom.id_apply], + rw [restrict_scalars.smul_def f, coextend_scalars.smul_apply, one_mul, ←linear_map.map_smul, + @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, smul_eq_mul, mul_one], + end }, + naturality' := λ X X' g, linear_map.ext $ λ h, by simp [coextend_scalars.map_apply] } + +end restriction_coextension_adj + +/-- Restriction of scalars is left adjoint to coextension of scalars. -/ +@[simps] def restrict_coextend_scalars_adj {R : Type u₁} {S : Type u₂} [ring R] [ring S] + (f : R →+* S) : restrict_scalars f ⊣ coextend_scalars f := +{ hom_equiv := λ X Y, + { to_fun := restriction_coextension_adj.hom_equiv.from_restriction f, + inv_fun := restriction_coextension_adj.hom_equiv.to_restriction f, + left_inv := λ g, linear_map.ext $ λ (x : X), by simp, + right_inv := λ g, linear_map.ext $ λ x, linear_map.ext $ λ (s : S), by simp }, + unit := restriction_coextension_adj.unit' f, + counit := restriction_coextension_adj.counit' f, + hom_equiv_unit' := λ X Y g, linear_map.ext $ λ y, rfl, + hom_equiv_counit' := λ Y X g, linear_map.ext $ λ (y : Y), by simp } + +instance {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) : + category_theory.is_left_adjoint (restrict_scalars f) := ⟨_, restrict_coextend_scalars_adj f⟩ + +instance {R : Type u₁} {S : Type u₂} [ring R] [ring S] (f : R →+* S) : + category_theory.is_right_adjoint (coextend_scalars f) := ⟨_, restrict_coextend_scalars_adj f⟩ + +namespace extend_restrict_scalars_adj + +open_locale change_of_rings +open tensor_product + +variables {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) + +/-- +Given `R`-module X and `S`-module Y and a map `g : (extend_scalars f).obj X ⟶ Y`, i.e. `S`-linear +map `S ⨂ X → Y`, there is a `X ⟶ (restrict_scalars f).obj Y`, i.e. `R`-linear map `X ⟶ Y` by +`x ↦ g (1 ⊗ x)`. +-/ +@[simps] def hom_equiv.to_restrict_scalars {X Y} (g : (extend_scalars f).obj X ⟶ Y) : + X ⟶ (restrict_scalars f).obj Y := +{ to_fun := λ x, g $ (1 : S) ⊗ₜ[R, f] x, + map_add' := λ _ _, by rw [tmul_add, map_add], + map_smul' := λ r x, + begin + letI : module R S := module.comp_hom S f, + letI : module R Y := module.comp_hom Y f, + rw [ring_hom.id_apply, restrict_scalars.smul_def, ←linear_map.map_smul, tmul_smul], + congr, + end } + +/-- +Given `R`-module X and `S`-module Y and a map `X ⟶ (restrict_scalars f).obj Y`, i.e `R`-linear map +`X ⟶ Y`, there is a map `(extend_scalars f).obj X ⟶ Y`, i.e `S`-linear map `S ⨂ X → Y` by +`s ⊗ x ↦ s • g x`. +-/ +@[simps] def hom_equiv.from_extend_scalars {X Y} (g : X ⟶ (restrict_scalars f).obj Y) : + (extend_scalars f).obj X ⟶ Y := +begin + letI m1 : module R S := module.comp_hom S f, letI m2 : module R Y := module.comp_hom Y f, + refine ⟨λ z, tensor_product.lift ⟨λ s, ⟨_, _, _⟩, _, _⟩ z, _, _⟩, + { exact λ x, s • g x }, + { intros, rw [map_add, smul_add], }, + { intros, rw [ring_hom.id_apply, smul_comm, ←linear_map.map_smul], }, + { intros, ext, simp only [linear_map.coe_mk, linear_map.add_apply], rw ←add_smul, }, + { intros, ext, + simp only [linear_map.coe_mk, ring_hom.id_apply, linear_map.smul_apply, + restrict_scalars.smul_def, smul_eq_mul], + convert mul_smul _ _ _, }, + { intros, rw [map_add], }, + { intros r z, + rw [ring_hom.id_apply], + induction z using tensor_product.induction_on with x y x y ih1 ih2, + { simp only [smul_zero, map_zero], }, + { simp only [linear_map.coe_mk, extend_scalars.smul_tmul, lift.tmul, ←mul_smul], }, + { rw [smul_add, map_add, ih1, ih2, map_add, smul_add], }, }, +end + +/-- +Given `R`-module X and `S`-module Y, `S`-linear linear maps `(extend_scalars f).obj X ⟶ Y` +bijectively correspond to `R`-linear maps `X ⟶ (restrict_scalars f).obj Y`. +-/ +@[simps] +def hom_equiv {X Y} : ((extend_scalars f).obj X ⟶ Y) ≃ (X ⟶ (restrict_scalars f).obj Y) := +{ to_fun := hom_equiv.to_restrict_scalars f, + inv_fun := hom_equiv.from_extend_scalars f, + left_inv := λ g, begin + ext z, + induction z using tensor_product.induction_on with x s z1 z2 ih1 ih2, + { simp only [map_zero], }, + { erw tensor_product.lift.tmul, + simp only [linear_map.coe_mk], + change S at x, + erw [←linear_map.map_smul, extend_scalars.smul_tmul, mul_one x], }, + { rw [map_add, map_add, ih1, ih2], } + end, + right_inv := λ g, + begin + ext, + rw [hom_equiv.to_restrict_scalars_apply, hom_equiv.from_extend_scalars_apply, lift.tmul, + linear_map.coe_mk, linear_map.coe_mk], + convert one_smul _ _, + end } + +/-- +For any `R`-module X, there is a natural `R`-linear map from `X` to `X ⨂ S` by sending `x ↦ x ⊗ 1` +-/ +@[simps] def unit.map {X} : X ⟶ (extend_scalars f ⋙ restrict_scalars f).obj X := +{ to_fun := λ x, (1 : S) ⊗ₜ[R, f] x, + map_add' := λ x x', by { rw tensor_product.tmul_add, }, + map_smul' := λ r x, by { letI m1 : module R S := module.comp_hom S f, tidy } } + +/-- +The natural transformation from identity functor on `R`-module to the composition of extension and +restriction of scalars. +-/ +@[simps] def unit : 𝟭 (Module R) ⟶ extend_scalars f ⋙ restrict_scalars f := +{ app := λ _, unit.map f, naturality' := λ X X' g, by tidy } + +/-- +For any `S`-module Y, there is a natural `R`-linear map from `S ⨂ Y` to `Y` by +`s ⊗ y ↦ s • y` +-/ +@[simps] def counit.map {Y} : (restrict_scalars f ⋙ extend_scalars f).obj Y ⟶ Y := +begin + letI m1 : module R S := module.comp_hom S f, + letI m2 : module R Y := module.comp_hom Y f, + refine ⟨tensor_product.lift ⟨λ (s : S), ⟨λ (y : Y), s • y, smul_add _, _⟩, _, _⟩, _, _⟩, + { intros, rw [ring_hom.id_apply, restrict_scalars.smul_def, ←mul_smul, mul_comm, mul_smul, + restrict_scalars.smul_def], }, + { intros, ext, simp only [linear_map.add_apply, linear_map.coe_mk, add_smul], }, + { intros, ext, + simpa only [ring_hom.id_apply, linear_map.smul_apply, linear_map.coe_mk, + @restrict_scalars.smul_def _ _ _ _ f ⟨S⟩, smul_eq_mul, mul_smul], }, + { intros, rw [map_add], }, + { intros s z, + rw [ring_hom.id_apply], + induction z using tensor_product.induction_on with x s' z1 z2 ih1 ih2, + { simp only [smul_zero, map_zero], }, + { simp only [extend_scalars.smul_tmul, linear_map.coe_mk, tensor_product.lift.tmul, mul_smul] }, + { rw [smul_add, map_add, map_add, ih1, ih2, smul_add], } }, +end + +/-- +The natural transformation from the composition of restriction and extension of scalars to the +identity functor on `S`-module. +-/ +@[simps] def counit : (restrict_scalars f ⋙ extend_scalars f) ⟶ (𝟭 (Module S)) := +{ app := λ _, counit.map f, + naturality' := λ Y Y' g, + begin + ext z, induction z using tensor_product.induction_on, + { simp only [map_zero] }, + { simp only [category_theory.functor.comp_map, Module.coe_comp, function.comp_app, + extend_scalars.map_tmul, restrict_scalars.map_apply, counit.map_apply, lift.tmul, + linear_map.coe_mk, category_theory.functor.id_map, linear_map.map_smulₛₗ, + ring_hom.id_apply] }, + { simp only [map_add, *] }, + end } + +end extend_restrict_scalars_adj + +/-- +Given commutative rings `R, S` and a ring hom `f : R →+* S`, the extension and restriction of +scalars by `f` are adjoint to each other. +-/ +@[simps] +def extend_restrict_scalars_adj {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] + (f : R →+* S) : extend_scalars f ⊣ restrict_scalars f := +{ hom_equiv := λ _ _, extend_restrict_scalars_adj.hom_equiv f, + unit := extend_restrict_scalars_adj.unit f, + counit := extend_restrict_scalars_adj.counit f, + hom_equiv_unit' := λ X Y g, linear_map.ext $ λ x, by simp, + hom_equiv_counit' := λ X Y g, linear_map.ext $ λ x, + begin + induction x using tensor_product.induction_on, + { simp only [map_zero]}, + { simp only [extend_restrict_scalars_adj.hom_equiv_symm_apply, linear_map.coe_mk, + extend_restrict_scalars_adj.hom_equiv.from_extend_scalars_apply, tensor_product.lift.tmul, + extend_restrict_scalars_adj.counit_app, Module.coe_comp, function.comp_app, + extend_scalars.map_tmul, extend_restrict_scalars_adj.counit.map_apply] }, + { simp only [map_add, *], } + end } + +instance {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) : + category_theory.is_left_adjoint (extend_scalars f) := ⟨_, extend_restrict_scalars_adj f⟩ + +instance {R : Type u₁} {S : Type u₂} [comm_ring R] [comm_ring S] (f : R →+* S) : + category_theory.is_right_adjoint (restrict_scalars f) := ⟨_, extend_restrict_scalars_adj f⟩ + +end category_theory.Module diff --git a/src/algebra/category/Module/colimits.lean b/src/algebra/category/Module/colimits.lean index d19e93239f850..1bc29635f615e 100644 --- a/src/algebra/category/Module/colimits.lean +++ b/src/algebra/category/Module/colimits.lean @@ -3,14 +3,15 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import category_theory.limits.concrete_category -import group_theory.quotient_group -import category_theory.limits.shapes.kernels import algebra.category.Module.basic +import category_theory.concrete_category.elementwise /-! # The category of R-modules has all colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`. Note that finite colimits can already be obtained from the instance `abelian (Module R)`. @@ -371,6 +372,12 @@ instance has_colimits_Module : has_colimits (Module.{max v u} R) := { cocone := colimit_cocone F, is_colimit := colimit_cocone_is_colimit F } } } +instance has_colimits_of_size_Module : has_colimits_of_size.{v} (Module.{max v u} R) := +has_colimits_of_size_shrink _ + +instance has_colimits_of_size_zero_Module : has_colimits_of_size.{0} (Module.{max v u} R) := +@has_colimits_of_size_shrink.{0} (Module.{max v u} R) _ Module.colimits.has_colimits_Module + -- We manually add a `has_colimits` instance with universe parameters swapped, for otherwise -- the instance is not found by typeclass search. instance has_colimits_Module' (R : Type u) [ring R] : diff --git a/src/algebra/category/Module/epi_mono.lean b/src/algebra/category/Module/epi_mono.lean index d9642ac984022..88a5c59967586 100644 --- a/src/algebra/category/Module/epi_mono.lean +++ b/src/algebra/category/Module/epi_mono.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import linear_algebra.quotient -import category_theory.epi_mono import algebra.category.Module.basic /-! # Monomorphisms in `Module R` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file shows that an `R`-linear map is a monomorphism in the category of `R`-modules if and only if it is injective, and similarly an epimorphism if and only if it is surjective. -/ @@ -55,4 +57,12 @@ instance mono_as_hom'_subtype (U : submodule R X) : mono ↾U.subtype := instance epi_as_hom''_mkq (U : submodule R X) : epi ↿U.mkq := (epi_iff_range_eq_top _).mpr $ submodule.range_mkq _ +instance forget_preserves_epimorphisms : (forget (Module.{v} R)).preserves_epimorphisms := +{ preserves := λ X Y f hf, by rwa [forget_map_eq_coe, category_theory.epi_iff_surjective, + ← epi_iff_surjective] } + +instance forget_preserves_monomorphisms : (forget (Module.{v} R)).preserves_monomorphisms := +{ preserves := λ X Y f hf, by rwa [forget_map_eq_coe, category_theory.mono_iff_injective, + ← mono_iff_injective] } + end Module diff --git a/src/algebra/category/Module/filtered_colimits.lean b/src/algebra/category/Module/filtered_colimits.lean index 796ad0b6fd8ac..01cb3e6a786ef 100644 --- a/src/algebra/category/Module/filtered_colimits.lean +++ b/src/algebra/category/Module/filtered_colimits.lean @@ -9,6 +9,9 @@ import algebra.category.Module.basic /-! # The forgetful functor from `R`-modules preserves filtered colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Forgetful functors from algebraic categories usually don't preserve colimits. However, they tend to preserve _filtered_ colimits. @@ -38,14 +41,14 @@ section -- We use parameters here, mainly so we can have the abbreviations `M` and `M.mk` below, without -- passing around `F` all the time. parameters {R : Type u} [ring R] {J : Type v} [small_category J] [is_filtered J] -parameters (F : J ⥤ Module.{v} R) +parameters (F : J ⥤ Module.{max v u} R) /-- The colimit of `F ⋙ forget₂ (Module R) AddCommGroup` in the category `AddCommGroup`. In the following, we will show that this has the structure of an `R`-module. -/ abbreviation M : AddCommGroup := -AddCommGroup.filtered_colimits.colimit (F ⋙ forget₂ (Module R) AddCommGroup) +AddCommGroup.filtered_colimits.colimit (F ⋙ forget₂ (Module R) AddCommGroup.{max v u}) /-- The canonical projection into the colimit, as a quotient type. -/ abbreviation M.mk : (Σ j, F.obj j) → M := quot.mk (types.quot.rel (F ⋙ forget (Module R))) @@ -71,7 +74,7 @@ begin end /-- Scalar multiplication in the colimit. See also `colimit_smul_aux`. -/ -instance colimit_has_scalar : has_scalar R M := +instance colimit_has_smul : has_smul R M := { smul := λ r x, begin refine quot.lift (colimit_smul_aux F r) _ x, intros x y h, @@ -125,7 +128,8 @@ def colimit : Module R := Module.of R M /-- The linear map from a given `R`-module in the diagram to the colimit module. -/ def cocone_morphism (j : J) : F.obj j ⟶ colimit := { map_smul' := λ r x, begin erw colimit_smul_mk_eq F r ⟨j, x⟩, refl, end, -.. (AddCommGroup.filtered_colimits.colimit_cocone (F ⋙ forget₂ (Module R) AddCommGroup)).ι.app j } +.. (AddCommGroup.filtered_colimits.colimit_cocone + (F ⋙ forget₂ (Module R) AddCommGroup.{max v u})).ι.app j } /-- The cocone over the proposed colimit module. -/ def colimit_cocone : cocone F := @@ -147,8 +151,8 @@ def colimit_desc (t : cocone F) : colimit ⟶ t.X := exact linear_map.map_smul (t.ι.app j) r x, end, .. (AddCommGroup.filtered_colimits.colimit_cocone_is_colimit - (F ⋙ forget₂ (Module R) AddCommGroup)).desc - ((forget₂ (Module R) AddCommGroup.{v}).map_cocone t) } + (F ⋙ forget₂ (Module R) AddCommGroup.{max v u})).desc + ((forget₂ (Module R) AddCommGroup.{max v u}).map_cocone t) } /-- The proposed colimit cocone is a colimit in `Module R`. -/ def colimit_cocone_is_colimit : is_colimit colimit_cocone := @@ -161,14 +165,15 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := ((forget (Module R)).map_cocone t) m ((λ j, funext $ λ x, linear_map.congr_fun (h j) x)) } instance forget₂_AddCommGroup_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ (Module R) AddCommGroup.{v}) := + preserves_filtered_colimits (forget₂ (Module R) AddCommGroup.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone (colimit_cocone_is_colimit F) (AddCommGroup.filtered_colimits.colimit_cocone_is_colimit - (F ⋙ forget₂ (Module R) AddCommGroup.{v})) } } + (F ⋙ forget₂ (Module.{u} R) AddCommGroup.{u})) } } -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget (Module R)) := +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget (Module.{u} R)) := limits.comp_preserves_filtered_colimits (forget₂ (Module R) AddCommGroup) (forget AddCommGroup) end diff --git a/src/algebra/category/Module/images.lean b/src/algebra/category/Module/images.lean index 77d0c29fcb440..8f1145217cd45 100644 --- a/src/algebra/category/Module/images.lean +++ b/src/algebra/category/Module/images.lean @@ -5,11 +5,13 @@ Authors: Scott Morrison -/ import algebra.category.Module.abelian import category_theory.limits.shapes.images -import category_theory.limits.types /-! # The category of R-modules has images. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Note that we don't need to register any of the constructions here as instances, because we get them from the fact that `Module R` is an abelian category. -/ diff --git a/src/algebra/category/Module/kernels.lean b/src/algebra/category/Module/kernels.lean index 558c9668b0878..80d2b4986e2f7 100644 --- a/src/algebra/category/Module/kernels.lean +++ b/src/algebra/category/Module/kernels.lean @@ -4,10 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel -/ import algebra.category.Module.epi_mono -import category_theory.limits.concrete_category +import category_theory.concrete_category.elementwise /-! # The concrete (co)kernels in the category of modules are (co)kernels in the categorical sense. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory diff --git a/src/algebra/category/Module/limits.lean b/src/algebra/category/Module/limits.lean index 18105eeb1f51b..43f099089be51 100644 --- a/src/algebra/category/Module/limits.lean +++ b/src/algebra/category/Module/limits.lean @@ -10,6 +10,9 @@ import algebra.direct_limit /-! # The category of R-modules has all limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Further, these limits are preserved by the forgetful functor --- that is, the underlying types are just the limits in the category of types. -/ @@ -17,7 +20,7 @@ the underlying types are just the limits in the category of types. open category_theory open category_theory.limits -universes u v +universes v w u -- `u` is determined by the ring, so can come last noncomputable theory @@ -26,18 +29,18 @@ namespace Module variables {R : Type u} [ring R] variables {J : Type v} [small_category J] -instance add_comm_group_obj (F : J ⥤ Module.{v} R) (j) : +instance add_comm_group_obj (F : J ⥤ Module.{max v w} R) (j) : add_comm_group ((F ⋙ forget (Module R)).obj j) := by { change add_comm_group (F.obj j), apply_instance } -instance module_obj (F : J ⥤ Module.{v} R) (j) : +instance module_obj (F : J ⥤ Module.{max v w} R) (j) : module R ((F ⋙ forget (Module R)).obj j) := by { change module R (F.obj j), apply_instance } /-- The flat sections of a functor into `Module R` form a submodule of all sections. -/ -def sections_submodule (F : J ⥤ Module R) : +def sections_submodule (F : J ⥤ Module.{max v w} R) : submodule R (Π j, F.obj j) := { carrier := (F ⋙ forget (Module R)).sections, smul_mem' := λ r s sh j j' f, @@ -47,25 +50,25 @@ def sections_submodule (F : J ⥤ Module R) : rw sh f, end, ..(AddGroup.sections_add_subgroup - (F ⋙ forget₂ (Module R) AddCommGroup.{v} ⋙ forget₂ AddCommGroup AddGroup.{v})) } + (F ⋙ forget₂ (Module R) AddCommGroup.{max v w} ⋙ forget₂ AddCommGroup AddGroup.{max v w})) } -- Adding the following instance speeds up `limit_module` noticeably, -- by preventing a bad unfold of `limit_add_comm_group`. instance limit_add_comm_monoid (F : J ⥤ Module R) : - add_comm_monoid (types.limit_cone (F ⋙ forget (Module.{v} R))).X := + add_comm_monoid (types.limit_cone (F ⋙ forget (Module.{max v w} R))).X := show add_comm_monoid (sections_submodule F), by apply_instance instance limit_add_comm_group (F : J ⥤ Module R) : - add_comm_group (types.limit_cone (F ⋙ forget (Module.{v} R))).X := + add_comm_group (types.limit_cone (F ⋙ forget (Module.{max v w} R))).X := show add_comm_group (sections_submodule F), by apply_instance instance limit_module (F : J ⥤ Module R) : - module R (types.limit_cone (F ⋙ forget (Module.{v} R))).X := + module R (types.limit_cone (F ⋙ forget (Module.{max v w} R))).X := show module R (sections_submodule F), by apply_instance /-- `limit.π (F ⋙ forget Ring) j` as a `ring_hom`. -/ def limit_π_linear_map (F : J ⥤ Module R) (j) : - (types.limit_cone (F ⋙ forget (Module.{v} R))).X →ₗ[R] (F ⋙ forget (Module R)).obj j := + (types.limit_cone (F ⋙ forget (Module.{max v w} R))).X →ₗ[R] (F ⋙ forget (Module R)).obj j := { to_fun := (types.limit_cone (F ⋙ forget (Module R))).π.app j, map_smul' := λ x y, rfl, map_add' := λ x y, rfl } @@ -79,7 +82,7 @@ namespace has_limits Construction of a limit cone in `Module R`. (Internal use only; use the limits API.) -/ -def limit_cone (F : J ⥤ Module.{v} R) : cone F := +def limit_cone (F : J ⥤ Module.{max v w} R) : cone F := { X := Module.of R (types.limit_cone (F ⋙ forget _)).X, π := { app := limit_π_linear_map F, @@ -90,7 +93,7 @@ def limit_cone (F : J ⥤ Module.{v} R) : cone F := Witness that the limit cone in `Module R` is a limit cone. (Internal use only; use the limits API.) -/ -def limit_cone_is_limit (F : J ⥤ Module R) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ Module.{max v w} R) : is_limit (limit_cone F) := by refine is_limit.of_faithful (forget (Module R)) (types.limit_cone_is_limit _) (λ s, ⟨_, _, _⟩) (λ s, rfl); @@ -106,36 +109,46 @@ open has_limits /-- The category of R-modules has all limits. -/ @[irreducible] -instance has_limits : has_limits (Module.{v} R) := +instance has_limits_of_size : has_limits_of_size.{v v} (Module.{max v w} R) := { has_limits_of_shape := λ J 𝒥, by exactI { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } } +instance has_limits : has_limits (Module.{w} R) := Module.has_limits_of_size.{w w u} + /-- An auxiliary declaration to speed up typechecking. -/ -def forget₂_AddCommGroup_preserves_limits_aux (F : J ⥤ Module R) : +def forget₂_AddCommGroup_preserves_limits_aux (F : J ⥤ Module.{max v w} R) : is_limit ((forget₂ (Module R) AddCommGroup).map_cone (limit_cone F)) := -AddCommGroup.limit_cone_is_limit (F ⋙ forget₂ (Module R) AddCommGroup) +AddCommGroup.limit_cone_is_limit (F ⋙ forget₂ (Module R) AddCommGroup.{max v w}) /-- The forgetful functor from R-modules to abelian groups preserves all limits. -/ -instance forget₂_AddCommGroup_preserves_limits : - preserves_limits (forget₂ (Module R) AddCommGroup.{v}) := +instance forget₂_AddCommGroup_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ (Module R) AddCommGroup.{max v w}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (forget₂_AddCommGroup_preserves_limits_aux F) } } +instance forget₂_AddCommGroup_preserves_limits : + preserves_limits (forget₂ (Module R) AddCommGroup.{w}) := +Module.forget₂_AddCommGroup_preserves_limits_of_size.{w w} + /-- The forgetful functor from R-modules to types preserves all limits. -/ -instance forget_preserves_limits : preserves_limits (forget (Module R)) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget (Module.{max v w} R)) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (types.limit_cone_is_limit (F ⋙ forget _)) } } +instance forget_preserves_limits : preserves_limits (forget (Module.{w} R)) := +Module.forget_preserves_limits_of_size.{w w} + section direct_limit open module diff --git a/src/algebra/category/Module/monoidal.lean b/src/algebra/category/Module/monoidal.lean deleted file mode 100644 index 6f8a93b06d79f..0000000000000 --- a/src/algebra/category/Module/monoidal.lean +++ /dev/null @@ -1,319 +0,0 @@ -/- -Copyright (c) 2020 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kevin Buzzard, Scott Morrison, Jakob von Raumer --/ -import category_theory.monoidal.braided -import category_theory.closed.monoidal -import algebra.category.Module.basic -import linear_algebra.tensor_product -import category_theory.linear.yoneda -import category_theory.monoidal.linear - -/-! -# The symmetric monoidal category structure on R-modules - -Mostly this uses existing machinery in `linear_algebra.tensor_product`. -We just need to provide a few small missing pieces to build the -`monoidal_category` instance and then the `symmetric_category` instance. - -Note the universe level of the modules must be at least the universe level of the ring, -so that we have a monoidal unit. -For now, we simplify by insisting both universe levels are the same. - -We then construct the monoidal closed structure on `Module R`. - -If you're happy using the bundled `Module R`, it may be possible to mostly -use this as an interface and not need to interact much with the implementation details. --/ - -universes u - -open category_theory - -namespace Module - -variables {R : Type u} [comm_ring R] - -namespace monoidal_category --- The definitions inside this namespace are essentially private. --- After we build the `monoidal_category (Module R)` instance, --- you should use that API. - -open_locale tensor_product -local attribute [ext] tensor_product.ext - -/-- (implementation) tensor product of R-modules -/ -def tensor_obj (M N : Module R) : Module R := Module.of R (M ⊗[R] N) -/-- (implementation) tensor product of morphisms R-modules -/ -def tensor_hom {M N M' N' : Module R} (f : M ⟶ N) (g : M' ⟶ N') : - tensor_obj M M' ⟶ tensor_obj N N' := -tensor_product.map f g - -lemma tensor_id (M N : Module R) : tensor_hom (𝟙 M) (𝟙 N) = 𝟙 (Module.of R (↥M ⊗ ↥N)) := -by tidy - -lemma tensor_comp {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : Module R} - (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) : - tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) = tensor_hom f₁ f₂ ≫ tensor_hom g₁ g₂ := -by tidy - -/-- (implementation) the associator for R-modules -/ -def associator (M N K : Module R) : tensor_obj (tensor_obj M N) K ≅ tensor_obj M (tensor_obj N K) := -linear_equiv.to_Module_iso (tensor_product.assoc R M N K) - -section - -/-! The `associator_naturality` and `pentagon` lemmas below are very slow to elaborate. - -We give them some help by expressing the lemmas first non-categorically, then using -`convert _aux using 1` to have the elaborator work as little as possible. -/ - -open tensor_product (assoc map) - -private lemma associator_naturality_aux - {X₁ X₂ X₃ : Type*} - [add_comm_monoid X₁] [add_comm_monoid X₂] [add_comm_monoid X₃] - [module R X₁] [module R X₂] [module R X₃] - {Y₁ Y₂ Y₃ : Type*} - [add_comm_monoid Y₁] [add_comm_monoid Y₂] [add_comm_monoid Y₃] - [module R Y₁] [module R Y₂] [module R Y₃] - (f₁ : X₁ →ₗ[R] Y₁) (f₂ : X₂ →ₗ[R] Y₂) (f₃ : X₃ →ₗ[R] Y₃) : - (↑(assoc R Y₁ Y₂ Y₃) ∘ₗ (map (map f₁ f₂) f₃)) = ((map f₁ (map f₂ f₃)) ∘ₗ ↑(assoc R X₁ X₂ X₃)) := -begin - apply tensor_product.ext_threefold, - intros x y z, - refl -end - -variables (R) - -private lemma pentagon_aux - (W X Y Z : Type*) - [add_comm_monoid W] [add_comm_monoid X] [add_comm_monoid Y] [add_comm_monoid Z] - [module R W] [module R X] [module R Y] [module R Z] : - ((map (1 : W →ₗ[R] W) (assoc R X Y Z).to_linear_map).comp (assoc R W (X ⊗[R] Y) Z).to_linear_map) - .comp (map ↑(assoc R W X Y) (1 : Z →ₗ[R] Z)) = - (assoc R W X (Y ⊗[R] Z)).to_linear_map.comp (assoc R (W ⊗[R] X) Y Z).to_linear_map := -begin - apply tensor_product.ext_fourfold, - intros w x y z, - refl -end - -end - -lemma associator_naturality {X₁ X₂ X₃ Y₁ Y₂ Y₃ : Module R} - (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) : - tensor_hom (tensor_hom f₁ f₂) f₃ ≫ (associator Y₁ Y₂ Y₃).hom = - (associator X₁ X₂ X₃).hom ≫ tensor_hom f₁ (tensor_hom f₂ f₃) := -by convert associator_naturality_aux f₁ f₂ f₃ using 1 - -lemma pentagon (W X Y Z : Module R) : - tensor_hom (associator W X Y).hom (𝟙 Z) ≫ (associator W (tensor_obj X Y) Z).hom - ≫ tensor_hom (𝟙 W) (associator X Y Z).hom = - (associator (tensor_obj W X) Y Z).hom ≫ (associator W X (tensor_obj Y Z)).hom := -by convert pentagon_aux R W X Y Z using 1 - -/-- (implementation) the left unitor for R-modules -/ -def left_unitor (M : Module.{u} R) : Module.of R (R ⊗[R] M) ≅ M := -(linear_equiv.to_Module_iso (tensor_product.lid R M) : of R (R ⊗ M) ≅ of R M).trans (of_self_iso M) - -lemma left_unitor_naturality {M N : Module R} (f : M ⟶ N) : - tensor_hom (𝟙 (Module.of R R)) f ≫ (left_unitor N).hom = (left_unitor M).hom ≫ f := -begin - ext x y, simp, - erw [tensor_product.lid_tmul, tensor_product.lid_tmul], - rw linear_map.map_smul, - refl, -end - -/-- (implementation) the right unitor for R-modules -/ -def right_unitor (M : Module.{u} R) : Module.of R (M ⊗[R] R) ≅ M := -(linear_equiv.to_Module_iso (tensor_product.rid R M) : of R (M ⊗ R) ≅ of R M).trans (of_self_iso M) - -lemma right_unitor_naturality {M N : Module R} (f : M ⟶ N) : - tensor_hom f (𝟙 (Module.of R R)) ≫ (right_unitor N).hom = (right_unitor M).hom ≫ f := -begin - ext x y, simp, - erw [tensor_product.rid_tmul, tensor_product.rid_tmul], - rw linear_map.map_smul, - refl, -end - -lemma triangle (M N : Module.{u} R) : - (associator M (Module.of R R) N).hom ≫ tensor_hom (𝟙 M) (left_unitor N).hom = - tensor_hom (right_unitor M).hom (𝟙 N) := -begin - apply tensor_product.ext_threefold, - intros x y z, - change R at y, - dsimp [tensor_hom, associator], - erw [tensor_product.lid_tmul, tensor_product.rid_tmul], - exact (tensor_product.smul_tmul _ _ _).symm -end - -end monoidal_category - -open monoidal_category - -instance monoidal_category : monoidal_category (Module.{u} R) := -{ -- data - tensor_obj := tensor_obj, - tensor_hom := @tensor_hom _ _, - tensor_unit := Module.of R R, - associator := associator, - left_unitor := left_unitor, - right_unitor := right_unitor, - -- properties - tensor_id' := λ M N, tensor_id M N, - tensor_comp' := λ M N K M' N' K' f g h, tensor_comp f g h, - associator_naturality' := λ M N K M' N' K' f g h, associator_naturality f g h, - left_unitor_naturality' := λ M N f, left_unitor_naturality f, - right_unitor_naturality' := λ M N f, right_unitor_naturality f, - pentagon' := λ M N K L, pentagon M N K L, - triangle' := λ M N, triangle M N, } - -/-- Remind ourselves that the monoidal unit, being just `R`, is still a commutative ring. -/ -instance : comm_ring ((𝟙_ (Module.{u} R) : Module.{u} R) : Type u) := -(by apply_instance : comm_ring R) - -namespace monoidal_category - -@[simp] -lemma hom_apply {K L M N : Module.{u} R} (f : K ⟶ L) (g : M ⟶ N) (k : K) (m : M) : - (f ⊗ g) (k ⊗ₜ m) = f k ⊗ₜ g m := rfl - -@[simp] -lemma left_unitor_hom_apply {M : Module.{u} R} (r : R) (m : M) : - ((λ_ M).hom : 𝟙_ (Module R) ⊗ M ⟶ M) (r ⊗ₜ[R] m) = r • m := -tensor_product.lid_tmul m r - -@[simp] -lemma left_unitor_inv_apply {M : Module.{u} R} (m : M) : - ((λ_ M).inv : M ⟶ 𝟙_ (Module.{u} R) ⊗ M) m = 1 ⊗ₜ[R] m := -tensor_product.lid_symm_apply m - -@[simp] -lemma right_unitor_hom_apply {M : Module.{u} R} (m : M) (r : R) : - ((ρ_ M).hom : M ⊗ 𝟙_ (Module R) ⟶ M) (m ⊗ₜ r) = r • m := -tensor_product.rid_tmul m r - -@[simp] -lemma right_unitor_inv_apply {M : Module.{u} R} (m : M) : - ((ρ_ M).inv : M ⟶ M ⊗ 𝟙_ (Module.{u} R)) m = m ⊗ₜ[R] 1 := -tensor_product.rid_symm_apply m - -@[simp] -lemma associator_hom_apply {M N K : Module.{u} R} (m : M) (n : N) (k : K) : - ((α_ M N K).hom : (M ⊗ N) ⊗ K ⟶ M ⊗ (N ⊗ K)) ((m ⊗ₜ n) ⊗ₜ k) = (m ⊗ₜ (n ⊗ₜ k)) := rfl - -@[simp] -lemma associator_inv_apply {M N K : Module.{u} R} (m : M) (n : N) (k : K) : - ((α_ M N K).inv : M ⊗ (N ⊗ K) ⟶ (M ⊗ N) ⊗ K) (m ⊗ₜ (n ⊗ₜ k)) = ((m ⊗ₜ n) ⊗ₜ k) := rfl - -end monoidal_category - -/-- (implementation) the braiding for R-modules -/ -def braiding (M N : Module R) : tensor_obj M N ≅ tensor_obj N M := -linear_equiv.to_Module_iso (tensor_product.comm R M N) - -@[simp] lemma braiding_naturality {X₁ X₂ Y₁ Y₂ : Module.{u} R} (f : X₁ ⟶ Y₁) (g : X₂ ⟶ Y₂) : - (f ⊗ g) ≫ (Y₁.braiding Y₂).hom = - (X₁.braiding X₂).hom ≫ (g ⊗ f) := -begin - apply tensor_product.ext', - intros x y, - refl -end - -@[simp] lemma hexagon_forward (X Y Z : Module.{u} R) : - (α_ X Y Z).hom ≫ (braiding X _).hom ≫ (α_ Y Z X).hom = - ((braiding X Y).hom ⊗ 𝟙 Z) ≫ (α_ Y X Z).hom ≫ (𝟙 Y ⊗ (braiding X Z).hom) := -begin - apply tensor_product.ext_threefold, - intros x y z, - refl, -end - -@[simp] lemma hexagon_reverse (X Y Z : Module.{u} R) : - (α_ X Y Z).inv ≫ (braiding _ Z).hom ≫ (α_ Z X Y).inv = - (𝟙 X ⊗ (Y.braiding Z).hom) ≫ (α_ X Z Y).inv ≫ ((X.braiding Z).hom ⊗ 𝟙 Y) := -begin - apply (cancel_epi (α_ X Y Z).hom).1, - apply tensor_product.ext_threefold, - intros x y z, - refl, -end - -local attribute [ext] tensor_product.ext - -/-- The symmetric monoidal structure on `Module R`. -/ -instance symmetric_category : symmetric_category (Module.{u} R) := -{ braiding := braiding, - braiding_naturality' := λ X₁ X₂ Y₁ Y₂ f g, braiding_naturality f g, - hexagon_forward' := hexagon_forward, - hexagon_reverse' := hexagon_reverse, } - -namespace monoidal_category - -@[simp] lemma braiding_hom_apply {M N : Module.{u} R} (m : M) (n : N) : - ((β_ M N).hom : M ⊗ N ⟶ N ⊗ M) (m ⊗ₜ n) = n ⊗ₜ m := rfl - -@[simp] lemma braiding_inv_apply {M N : Module.{u} R} (m : M) (n : N) : - ((β_ M N).inv : N ⊗ M ⟶ M ⊗ N) (n ⊗ₜ m) = m ⊗ₜ n := rfl - -end monoidal_category - -open opposite - -instance : monoidal_preadditive (Module.{u} R) := -{ tensor_zero' := by { intros, ext, simp, }, - zero_tensor' := by { intros, ext, simp, }, - tensor_add' := by { intros, ext, simp [tensor_product.tmul_add], }, - add_tensor' := by { intros, ext, simp [tensor_product.add_tmul], }, } - -instance : monoidal_linear R (Module.{u} R) := -{ tensor_smul' := by { intros, ext, simp, }, - smul_tensor' := by { intros, ext, simp [tensor_product.smul_tmul], }, } - -/-- -Auxiliary definition for the `monoidal_closed` instance on `Module R`. -(This is only a separate definition in order to speed up typechecking. ) --/ -@[simps] -def monoidal_closed_hom_equiv (M N P : Module.{u} R) : - ((monoidal_category.tensor_left M).obj N ⟶ P) ≃ - (N ⟶ ((linear_coyoneda R (Module R)).obj (op M)).obj P) := -{ to_fun := λ f, linear_map.compr₂ (tensor_product.mk R N M) ((β_ N M).hom ≫ f), - inv_fun := λ f, (β_ M N).hom ≫ tensor_product.lift f, - left_inv := λ f, begin ext m n, - simp only [tensor_product.mk_apply, tensor_product.lift.tmul, linear_map.compr₂_apply, - function.comp_app, coe_comp, monoidal_category.braiding_hom_apply], - end, - right_inv := λ f, begin ext m n, - simp only [tensor_product.mk_apply, tensor_product.lift.tmul, linear_map.compr₂_apply, - symmetric_category.symmetry_assoc], - end, } - -instance : monoidal_closed (Module.{u} R) := -{ closed' := λ M, - { is_adj := - { right := (linear_coyoneda R (Module.{u} R)).obj (op M), - adj := adjunction.mk_of_hom_equiv - { hom_equiv := λ N P, monoidal_closed_hom_equiv M N P, } } } } - --- I can't seem to express the function coercion here without writing `@coe_fn`. -@[simp] -lemma monoidal_closed_curry {M N P : Module.{u} R} (f : M ⊗ N ⟶ P) (x : M) (y : N) : - @coe_fn _ _ linear_map.has_coe_to_fun ((monoidal_closed.curry f : N →ₗ[R] (M →ₗ[R] P)) y) x = - f (x ⊗ₜ[R] y) := -rfl - -@[simp] -lemma monoidal_closed_uncurry {M N P : Module.{u} R} - (f : N ⟶ (M ⟶[Module.{u} R] P)) (x : M) (y : N) : - monoidal_closed.uncurry f (x ⊗ₜ[R] y) = (@coe_fn _ _ linear_map.has_coe_to_fun (f y)) x := -by { simp only [monoidal_closed.uncurry, ihom.adjunction, is_left_adjoint.adj], simp, } - -end Module diff --git a/src/algebra/category/Module/monoidal/basic.lean b/src/algebra/category/Module/monoidal/basic.lean new file mode 100644 index 0000000000000..83862f8481145 --- /dev/null +++ b/src/algebra/category/Module/monoidal/basic.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2020 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin Buzzard, Scott Morrison, Jakob von Raumer +-/ +import algebra.category.Module.basic +import linear_algebra.tensor_product +import category_theory.linear.yoneda +import category_theory.monoidal.linear + +/-! +# The monoidal category structure on R-modules + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Mostly this uses existing machinery in `linear_algebra.tensor_product`. +We just need to provide a few small missing pieces to build the +`monoidal_category` instance. +The `symmetric_category` instance is in `algebra.category.Module.monoidal.symmetric` +to reduce imports. + +Note the universe level of the modules must be at least the universe level of the ring, +so that we have a monoidal unit. +For now, we simplify by insisting both universe levels are the same. + +We construct the monoidal closed structure on `Module R` in +`algebra.category.Module.monoidal.closed`. + +If you're happy using the bundled `Module R`, it may be possible to mostly +use this as an interface and not need to interact much with the implementation details. +-/ + +universes v w x u + +open category_theory + +namespace Module + +variables {R : Type u} [comm_ring R] + +namespace monoidal_category +-- The definitions inside this namespace are essentially private. +-- After we build the `monoidal_category (Module R)` instance, +-- you should use that API. + +open_locale tensor_product +local attribute [ext] tensor_product.ext + +/-- (implementation) tensor product of R-modules -/ +def tensor_obj (M N : Module R) : Module R := Module.of R (M ⊗[R] N) +/-- (implementation) tensor product of morphisms R-modules -/ +def tensor_hom {M N M' N' : Module R} (f : M ⟶ N) (g : M' ⟶ N') : + tensor_obj M M' ⟶ tensor_obj N N' := +tensor_product.map f g + +lemma tensor_id (M N : Module R) : tensor_hom (𝟙 M) (𝟙 N) = 𝟙 (Module.of R (M ⊗ N)) := +by { ext1, refl } + +lemma tensor_comp {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : Module R} + (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) : + tensor_hom (f₁ ≫ g₁) (f₂ ≫ g₂) = tensor_hom f₁ f₂ ≫ tensor_hom g₁ g₂ := +by { ext1, refl } + +/-- (implementation) the associator for R-modules -/ +def associator (M : Module.{v} R) (N : Module.{w} R) (K : Module.{x} R) : + tensor_obj (tensor_obj M N) K ≅ tensor_obj M (tensor_obj N K) := +(tensor_product.assoc R M N K).to_Module_iso + +section + +/-! The `associator_naturality` and `pentagon` lemmas below are very slow to elaborate. + +We give them some help by expressing the lemmas first non-categorically, then using +`convert _aux using 1` to have the elaborator work as little as possible. -/ + +open tensor_product (assoc map) + +private lemma associator_naturality_aux + {X₁ X₂ X₃ : Type*} + [add_comm_monoid X₁] [add_comm_monoid X₂] [add_comm_monoid X₃] + [module R X₁] [module R X₂] [module R X₃] + {Y₁ Y₂ Y₃ : Type*} + [add_comm_monoid Y₁] [add_comm_monoid Y₂] [add_comm_monoid Y₃] + [module R Y₁] [module R Y₂] [module R Y₃] + (f₁ : X₁ →ₗ[R] Y₁) (f₂ : X₂ →ₗ[R] Y₂) (f₃ : X₃ →ₗ[R] Y₃) : + (↑(assoc R Y₁ Y₂ Y₃) ∘ₗ (map (map f₁ f₂) f₃)) = ((map f₁ (map f₂ f₃)) ∘ₗ ↑(assoc R X₁ X₂ X₃)) := +begin + apply tensor_product.ext_threefold, + intros x y z, + refl +end + +variables (R) + +private lemma pentagon_aux + (W X Y Z : Type*) + [add_comm_monoid W] [add_comm_monoid X] [add_comm_monoid Y] [add_comm_monoid Z] + [module R W] [module R X] [module R Y] [module R Z] : + ((map (1 : W →ₗ[R] W) (assoc R X Y Z).to_linear_map).comp (assoc R W (X ⊗[R] Y) Z).to_linear_map) + .comp (map ↑(assoc R W X Y) (1 : Z →ₗ[R] Z)) = + (assoc R W X (Y ⊗[R] Z)).to_linear_map.comp (assoc R (W ⊗[R] X) Y Z).to_linear_map := +begin + apply tensor_product.ext_fourfold, + intros w x y z, + refl +end + +end + +lemma associator_naturality {X₁ X₂ X₃ Y₁ Y₂ Y₃ : Module R} + (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) : + tensor_hom (tensor_hom f₁ f₂) f₃ ≫ (associator Y₁ Y₂ Y₃).hom = + (associator X₁ X₂ X₃).hom ≫ tensor_hom f₁ (tensor_hom f₂ f₃) := +by convert associator_naturality_aux f₁ f₂ f₃ using 1 + +lemma pentagon (W X Y Z : Module R) : + tensor_hom (associator W X Y).hom (𝟙 Z) ≫ (associator W (tensor_obj X Y) Z).hom + ≫ tensor_hom (𝟙 W) (associator X Y Z).hom = + (associator (tensor_obj W X) Y Z).hom ≫ (associator W X (tensor_obj Y Z)).hom := +by convert pentagon_aux R W X Y Z using 1 + +/-- (implementation) the left unitor for R-modules -/ +def left_unitor (M : Module.{u} R) : Module.of R (R ⊗[R] M) ≅ M := +(linear_equiv.to_Module_iso (tensor_product.lid R M) : of R (R ⊗ M) ≅ of R M).trans (of_self_iso M) + +lemma left_unitor_naturality {M N : Module R} (f : M ⟶ N) : + tensor_hom (𝟙 (Module.of R R)) f ≫ (left_unitor N).hom = (left_unitor M).hom ≫ f := +begin + ext x y, dsimp, + erw [tensor_product.lid_tmul, tensor_product.lid_tmul], + rw linear_map.map_smul, + refl, +end + +/-- (implementation) the right unitor for R-modules -/ +def right_unitor (M : Module.{u} R) : Module.of R (M ⊗[R] R) ≅ M := +(linear_equiv.to_Module_iso (tensor_product.rid R M) : of R (M ⊗ R) ≅ of R M).trans (of_self_iso M) + +lemma right_unitor_naturality {M N : Module R} (f : M ⟶ N) : + tensor_hom f (𝟙 (Module.of R R)) ≫ (right_unitor N).hom = (right_unitor M).hom ≫ f := +begin + ext x y, dsimp, + erw [tensor_product.rid_tmul, tensor_product.rid_tmul], + rw linear_map.map_smul, + refl, +end + +lemma triangle (M N : Module.{u} R) : + (associator M (Module.of R R) N).hom ≫ tensor_hom (𝟙 M) (left_unitor N).hom = + tensor_hom (right_unitor M).hom (𝟙 N) := +begin + apply tensor_product.ext_threefold, + intros x y z, + change R at y, + dsimp [tensor_hom, associator], + erw [tensor_product.lid_tmul, tensor_product.rid_tmul], + exact (tensor_product.smul_tmul _ _ _).symm +end + +end monoidal_category + +open monoidal_category + +instance monoidal_category : monoidal_category (Module.{u} R) := +{ -- data + tensor_obj := tensor_obj, + tensor_hom := @tensor_hom _ _, + tensor_unit := Module.of R R, + associator := associator, + left_unitor := left_unitor, + right_unitor := right_unitor, + -- properties + tensor_id' := λ M N, tensor_id M N, + tensor_comp' := λ M N K M' N' K' f g h, tensor_comp f g h, + associator_naturality' := λ M N K M' N' K' f g h, associator_naturality f g h, + left_unitor_naturality' := λ M N f, left_unitor_naturality f, + right_unitor_naturality' := λ M N f, right_unitor_naturality f, + pentagon' := λ M N K L, pentagon M N K L, + triangle' := λ M N, triangle M N, } + +/-- Remind ourselves that the monoidal unit, being just `R`, is still a commutative ring. -/ +instance : comm_ring ((𝟙_ (Module.{u} R) : Module.{u} R) : Type u) := +(by apply_instance : comm_ring R) + +namespace monoidal_category + +@[simp] +lemma hom_apply {K L M N : Module.{u} R} (f : K ⟶ L) (g : M ⟶ N) (k : K) (m : M) : + (f ⊗ g) (k ⊗ₜ m) = f k ⊗ₜ g m := rfl + +@[simp] +lemma left_unitor_hom_apply {M : Module.{u} R} (r : R) (m : M) : + ((λ_ M).hom : 𝟙_ (Module R) ⊗ M ⟶ M) (r ⊗ₜ[R] m) = r • m := +tensor_product.lid_tmul m r + +@[simp] +lemma left_unitor_inv_apply {M : Module.{u} R} (m : M) : + ((λ_ M).inv : M ⟶ 𝟙_ (Module.{u} R) ⊗ M) m = 1 ⊗ₜ[R] m := +tensor_product.lid_symm_apply m + +@[simp] +lemma right_unitor_hom_apply {M : Module.{u} R} (m : M) (r : R) : + ((ρ_ M).hom : M ⊗ 𝟙_ (Module R) ⟶ M) (m ⊗ₜ r) = r • m := +tensor_product.rid_tmul m r + +@[simp] +lemma right_unitor_inv_apply {M : Module.{u} R} (m : M) : + ((ρ_ M).inv : M ⟶ M ⊗ 𝟙_ (Module.{u} R)) m = m ⊗ₜ[R] 1 := +tensor_product.rid_symm_apply m + +@[simp] +lemma associator_hom_apply {M N K : Module.{u} R} (m : M) (n : N) (k : K) : + ((α_ M N K).hom : (M ⊗ N) ⊗ K ⟶ M ⊗ (N ⊗ K)) ((m ⊗ₜ n) ⊗ₜ k) = (m ⊗ₜ (n ⊗ₜ k)) := rfl + +@[simp] +lemma associator_inv_apply {M N K : Module.{u} R} (m : M) (n : N) (k : K) : + ((α_ M N K).inv : M ⊗ (N ⊗ K) ⟶ (M ⊗ N) ⊗ K) (m ⊗ₜ (n ⊗ₜ k)) = ((m ⊗ₜ n) ⊗ₜ k) := rfl + +end monoidal_category + +open opposite + +instance : monoidal_preadditive (Module.{u} R) := +by refine ⟨_, _, _, _⟩; dsimp only [auto_param]; intros; + refine tensor_product.ext (linear_map.ext $ λ x, linear_map.ext $ λ y, _); + simp only [linear_map.compr₂_apply, tensor_product.mk_apply, monoidal_category.hom_apply, + linear_map.zero_apply, tensor_product.tmul_zero, tensor_product.zero_tmul, + linear_map.add_apply, tensor_product.tmul_add, tensor_product.add_tmul] + +instance : monoidal_linear R (Module.{u} R) := +by refine ⟨_, _⟩; dsimp only [auto_param]; intros; + refine tensor_product.ext (linear_map.ext $ λ x, linear_map.ext $ λ y, _); + simp only [linear_map.compr₂_apply, tensor_product.mk_apply, monoidal_category.hom_apply, + linear_map.smul_apply, tensor_product.tmul_smul, tensor_product.smul_tmul] + +end Module diff --git a/src/algebra/category/Module/monoidal/closed.lean b/src/algebra/category/Module/monoidal/closed.lean new file mode 100644 index 0000000000000..1f2577cf89c0f --- /dev/null +++ b/src/algebra/category/Module/monoidal/closed.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2020 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin Buzzard, Scott Morrison, Jakob von Raumer +-/ +import category_theory.closed.monoidal +import algebra.category.Module.monoidal.symmetric + +/-! +# The monoidal closed structure on `Module R`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes v w x u + +open category_theory +open opposite + +namespace Module + +variables {R : Type u} [comm_ring R] + +local attribute [ext] tensor_product.ext + +/-- +Auxiliary definition for the `monoidal_closed` instance on `Module R`. +(This is only a separate definition in order to speed up typechecking. ) +-/ +@[simps] +def monoidal_closed_hom_equiv (M N P : Module.{u} R) : + ((monoidal_category.tensor_left M).obj N ⟶ P) ≃ + (N ⟶ ((linear_coyoneda R (Module R)).obj (op M)).obj P) := +{ to_fun := λ f, linear_map.compr₂ (tensor_product.mk R N M) ((β_ N M).hom ≫ f), + inv_fun := λ f, (β_ M N).hom ≫ tensor_product.lift f, + left_inv := λ f, begin ext m n, + simp only [tensor_product.mk_apply, tensor_product.lift.tmul, linear_map.compr₂_apply, + function.comp_app, coe_comp, monoidal_category.braiding_hom_apply], + end, + right_inv := λ f, begin ext m n, + simp only [tensor_product.mk_apply, tensor_product.lift.tmul, linear_map.compr₂_apply, + symmetric_category.symmetry_assoc], + end, } + +instance : monoidal_closed (Module.{u} R) := +{ closed' := λ M, + { is_adj := + { right := (linear_coyoneda R (Module.{u} R)).obj (op M), + adj := adjunction.mk_of_hom_equiv + { hom_equiv := λ N P, monoidal_closed_hom_equiv M N P, } } } } + +lemma ihom_map_apply {M N P : Module.{u} R} (f : N ⟶ P) (g : Module.of R (M ⟶ N)) : + (ihom M).map f g = g ≫ f := rfl + +-- I can't seem to express the function coercion here without writing `@coe_fn`. +@[simp] +lemma monoidal_closed_curry {M N P : Module.{u} R} (f : M ⊗ N ⟶ P) (x : M) (y : N) : + @coe_fn _ _ linear_map.has_coe_to_fun ((monoidal_closed.curry f : N →ₗ[R] (M →ₗ[R] P)) y) x = + f (x ⊗ₜ[R] y) := +rfl + +@[simp] +lemma monoidal_closed_uncurry {M N P : Module.{u} R} + (f : N ⟶ (M ⟶[Module.{u} R] P)) (x : M) (y : N) : + monoidal_closed.uncurry f (x ⊗ₜ[R] y) = (@coe_fn _ _ linear_map.has_coe_to_fun (f y)) x := +rfl + +/-- Describes the counit of the adjunction `M ⊗ - ⊣ Hom(M, -)`. Given an `R`-module `N` this +should give a map `M ⊗ Hom(M, N) ⟶ N`, so we flip the order of the arguments in the identity map +`Hom(M, N) ⟶ (M ⟶ N)` and uncurry the resulting map `M ⟶ Hom(M, N) ⟶ N.` -/ +lemma ihom_ev_app (M N : Module.{u} R) : + (ihom.ev M).app N = tensor_product.uncurry _ _ _ _ linear_map.id.flip := +begin + ext, + exact Module.monoidal_closed_uncurry _ _ _, +end + +/-- Describes the unit of the adjunction `M ⊗ - ⊣ Hom(M, -)`. Given an `R`-module `N` this should +define a map `N ⟶ Hom(M, M ⊗ N)`, which is given by flipping the arguments in the natural +`R`-bilinear map `M ⟶ N ⟶ M ⊗ N`. -/ +lemma ihom_coev_app (M N : Module.{u} R) : + (ihom.coev M).app N = (tensor_product.mk _ _ _).flip := +rfl + +lemma monoidal_closed_pre_app {M N : Module.{u} R} (P : Module.{u} R) (f : N ⟶ M) : + (monoidal_closed.pre f).app P = linear_map.lcomp R _ f := +rfl + +end Module diff --git a/src/algebra/category/Module/monoidal/symmetric.lean b/src/algebra/category/Module/monoidal/symmetric.lean new file mode 100644 index 0000000000000..177cae80fa58d --- /dev/null +++ b/src/algebra/category/Module/monoidal/symmetric.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2020 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin Buzzard, Scott Morrison, Jakob von Raumer +-/ +import category_theory.monoidal.braided +import algebra.category.Module.monoidal.basic + +/-! +# The symmetric monoidal structure on `Module R`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes v w x u + +open category_theory + +namespace Module + +variables {R : Type u} [comm_ring R] + +/-- (implementation) the braiding for R-modules -/ +def braiding (M N : Module.{u} R) : (M ⊗ N) ≅ (N ⊗ M) := +linear_equiv.to_Module_iso (tensor_product.comm R M N) + +namespace monoidal_category + +@[simp] lemma braiding_naturality {X₁ X₂ Y₁ Y₂ : Module.{u} R} (f : X₁ ⟶ Y₁) (g : X₂ ⟶ Y₂) : + (f ⊗ g) ≫ (Y₁.braiding Y₂).hom = + (X₁.braiding X₂).hom ≫ (g ⊗ f) := +begin + apply tensor_product.ext', + intros x y, + refl +end + +@[simp] lemma hexagon_forward (X Y Z : Module.{u} R) : + (α_ X Y Z).hom ≫ (braiding X _).hom ≫ (α_ Y Z X).hom = + ((braiding X Y).hom ⊗ 𝟙 Z) ≫ (α_ Y X Z).hom ≫ (𝟙 Y ⊗ (braiding X Z).hom) := +begin + apply tensor_product.ext_threefold, + intros x y z, + refl, +end + +@[simp] lemma hexagon_reverse (X Y Z : Module.{u} R) : + (α_ X Y Z).inv ≫ (braiding _ Z).hom ≫ (α_ Z X Y).inv = + (𝟙 X ⊗ (Y.braiding Z).hom) ≫ (α_ X Z Y).inv ≫ ((X.braiding Z).hom ⊗ 𝟙 Y) := +begin + apply (cancel_epi (α_ X Y Z).hom).1, + apply tensor_product.ext_threefold, + intros x y z, + refl, +end + +local attribute [ext] tensor_product.ext + +/-- The symmetric monoidal structure on `Module R`. -/ +instance symmetric_category : symmetric_category (Module.{u} R) := +{ braiding := braiding, + braiding_naturality' := λ X₁ X₂ Y₁ Y₂ f g, braiding_naturality f g, + hexagon_forward' := hexagon_forward, + hexagon_reverse' := hexagon_reverse, } + +@[simp] lemma braiding_hom_apply {M N : Module.{u} R} (m : M) (n : N) : + ((β_ M N).hom : M ⊗ N ⟶ N ⊗ M) (m ⊗ₜ n) = n ⊗ₜ m := rfl + +@[simp] lemma braiding_inv_apply {M N : Module.{u} R} (m : M) (n : N) : + ((β_ M N).inv : N ⊗ M ⟶ M ⊗ N) (n ⊗ₜ m) = m ⊗ₜ n := rfl + +end monoidal_category + +end Module diff --git a/src/algebra/category/Module/products.lean b/src/algebra/category/Module/products.lean index 18c1c7fd3194f..96b8558b7a776 100644 --- a/src/algebra/category/Module/products.lean +++ b/src/algebra/category/Module/products.lean @@ -3,22 +3,25 @@ Copyright (c) 2022 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import algebra.category.Module.epi_mono import linear_algebra.pi +import algebra.category.Module.basic /-! # The concrete products in the category of modules are products in the categorical sense. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory open category_theory.limits -universes u v +universes u v w namespace Module variables {R : Type u} [ring R] -variables {ι : Type v} (Z : ι → Module.{v} R) +variables {ι : Type v} (Z : ι → Module.{max v w} R) /-- The product cone induced by the concrete product. -/ def product_cone : fan Z := @@ -26,14 +29,14 @@ fan.mk (Module.of R (Π i : ι, Z i)) (λ i, (linear_map.proj i : (Π i : ι, Z /-- The concrete product cone is limiting. -/ def product_cone_is_limit : is_limit (product_cone Z) := -{ lift := λ s, (linear_map.pi s.π.app : s.X →ₗ[R] (Π i : ι, Z i)), - fac' := by tidy, - uniq' := λ s m w, by { ext x i, exact linear_map.congr_fun (w i) x, }, } +{ lift := λ s, (linear_map.pi (λ j, s.π.app ⟨j⟩) : s.X →ₗ[R] (Π i : ι, Z i)), + fac' := λ s j, by { cases j, tidy, }, + uniq' := λ s m w, by { ext x i, exact linear_map.congr_fun (w ⟨i⟩) x, }, } -- While we could use this to construct a `has_products (Module R)` instance, -- we already have `has_limits (Module R)` in `algebra.category.Module.limits`. -variables [has_products (Module.{v} R)] +variables [has_product Z] /-- The categorical product of a family of objects in `Module` @@ -51,6 +54,6 @@ limit.iso_limit_cone_inv_π _ _ @[simp, elementwise] lemma pi_iso_pi_hom_ker_subtype (i : ι) : (pi_iso_pi Z).hom ≫ (linear_map.proj i : (Π i : ι, Z i) →ₗ[R] Z i) = pi.π Z i := -is_limit.cone_point_unique_up_to_iso_inv_comp _ (limit.is_limit _) _ +is_limit.cone_point_unique_up_to_iso_inv_comp _ (limit.is_limit _) (discrete.mk i) end Module diff --git a/src/algebra/category/Module/projective.lean b/src/algebra/category/Module/projective.lean index b7f632b8df1c9..6fa327c3db2be 100644 --- a/src/algebra/category/Module/projective.lean +++ b/src/algebra/category/Module/projective.lean @@ -10,6 +10,9 @@ import linear_algebra.finsupp_vector_space /-! # The category of `R`-modules has enough projectives. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes v u @@ -37,7 +40,7 @@ begin end namespace Module -variables {R : Type u} [ring R] {M : Module.{(max u v)} R} +variables {R : Type u} [ring R] {M : Module.{max u v} R} /-- Modules that have a basis are projective. -/ -- We transport the corresponding result from `module.projective`. diff --git a/src/algebra/category/Module/simple.lean b/src/algebra/category/Module/simple.lean index 7ca97e2ef7a9f..1ed951e27ab24 100644 --- a/src/algebra/category/Module/simple.lean +++ b/src/algebra/category/Module/simple.lean @@ -4,13 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Pierre-Alexandre Bazin, Scott Morrison -/ import category_theory.simple -import algebra.category.Module.abelian import algebra.category.Module.subobject +import algebra.category.Module.algebra import ring_theory.simple_module +import linear_algebra.finite_dimensional /-! # Simple objects in the category of `R`-modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove simple modules are exactly simple objects in the category of `R`-modules. -/ @@ -20,6 +24,9 @@ open category_theory Module lemma simple_iff_is_simple_module : simple (of R M) ↔ is_simple_module R M := (simple_iff_subobject_is_simple_order _).trans (subobject_Module (of R M)).is_simple_order_iff +lemma simple_iff_is_simple_module' (M : Module R) : simple M ↔ is_simple_module R M := +(simple.iff_of_iso (of_self_iso M).symm).trans simple_iff_is_simple_module + /-- A simple module is a simple object in the category of modules. -/ instance simple_of_is_simple_module [is_simple_module R M] : simple (of R M) := simple_iff_is_simple_module.mpr ‹_› @@ -27,3 +34,12 @@ simple_iff_is_simple_module.mpr ‹_› /-- A simple object in the category of modules is a simple module. -/ instance is_simple_module_of_simple (M : Module R) [simple M] : is_simple_module R M := simple_iff_is_simple_module.mp (simple.of_iso (of_self_iso M)) + +open finite_dimensional + +local attribute [instance] module_of_algebra_Module is_scalar_tower_of_algebra_Module + +/-- Any `k`-algebra module which is 1-dimensional over `k` is simple. -/ +lemma simple_of_finrank_eq_one {k : Type*} [field k] [algebra k R] + {V : Module R} (h : finrank k V = 1) : simple V := +(simple_iff_is_simple_module' V).mpr (is_simple_module_of_finrank_eq_one h) diff --git a/src/algebra/category/Module/subobject.lean b/src/algebra/category/Module/subobject.lean index 226ba8b43b876..38dd5733b0a9f 100644 --- a/src/algebra/category/Module/subobject.lean +++ b/src/algebra/category/Module/subobject.lean @@ -7,11 +7,13 @@ import algebra.category.Module.epi_mono import algebra.category.Module.kernels import category_theory.subobject.well_powered import category_theory.subobject.limits -import category_theory.limits.concrete_category /-! # Subobjects in the category of `R`-modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We construct an explicit order isomorphism between the categorical subobjects of an `R`-module `M` and its submodules. This immediately implies that the category of `R`-modules is well-powered. @@ -38,6 +40,7 @@ noncomputable def subobject_Module : subobject M ≃o submodule R M := order_iso fapply eq_mk_of_comm, { apply linear_equiv.to_Module_iso'_left, apply linear_equiv.of_bijective (linear_map.cod_restrict S.arrow.range S.arrow _), + split, { simpa only [← linear_map.ker_eq_bot, linear_map.ker_cod_restrict] using ker_eq_bot_of_mono _ }, { rw [← linear_map.range_eq_top, linear_map.range_cod_restrict, diff --git a/src/algebra/category/Module/tannaka.lean b/src/algebra/category/Module/tannaka.lean new file mode 100644 index 0000000000000..03dec3c757f8d --- /dev/null +++ b/src/algebra/category/Module/tannaka.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import algebra.category.Module.basic +import linear_algebra.span + +/-! +# Tannaka duality for rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A ring `R` is equivalent to +the endomorphisms of the additive forgetful functor `Module R ⥤ AddCommGroup`. + +-/ + +universes u + +open category_theory + +/-- +An ingredient of Tannaka duality for rings: +A ring `R` is equivalent to +the endomorphisms of the additive forgetful functor `Module R ⥤ AddCommGroup`. +-/ +def ring_equiv_End_forget₂ (R : Type u) [ring R] : + R ≃+* End (AdditiveFunctor.of (forget₂ (Module.{u} R) AddCommGroup.{u})) := +{ to_fun := λ r, + { app := λ M, by apply distrib_mul_action.to_add_monoid_hom M r, + naturality' := λ M N f, by { ext, exact (f.map_smul _ _).symm, }, }, + inv_fun := λ φ, φ.app (Module.of R R) (1 : R), + left_inv := by { intros r, simp, }, + right_inv := begin + intros φ, ext M x, + simp only [distrib_mul_action.to_add_monoid_hom_apply], + have w := add_monoid_hom.congr_fun + (φ.naturality (Module.as_hom_right (linear_map.to_span_singleton R M x))) (1 : R), + convert w.symm, + exact (one_smul _ _).symm, + end, + map_add' := by { intros, ext, simp [add_smul], }, + map_mul' := by { intros, ext, simpa using mul_smul _ _ _, }, } diff --git a/src/algebra/category/Mon/adjunctions.lean b/src/algebra/category/Mon/adjunctions.lean index a5444e80fbeee..d3e500532d249 100644 --- a/src/algebra/category/Mon/adjunctions.lean +++ b/src/algebra/category/Mon/adjunctions.lean @@ -5,12 +5,15 @@ Authors: Julian Kuelshammer -/ import algebra.category.Mon.basic import algebra.category.Semigroup.basic -import algebra.group.with_one -import algebra.free_monoid +import algebra.group.with_one.basic +import algebra.free_monoid.basic /-! # Adjunctions regarding the category of monoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves the adjunction between adjoining a unit to a semigroup and the forgetful functor from monoids to semigroups. diff --git a/src/algebra/category/Mon/basic.lean b/src/algebra/category/Mon/basic.lean index 198b77989a8e7..33350da6a4ec4 100644 --- a/src/algebra/category/Mon/basic.lean +++ b/src/algebra/category/Mon/basic.lean @@ -3,7 +3,6 @@ Copyright (c) 2018 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import tactic.elementwise import category_theory.concrete_category.bundled_hom import algebra.punit_instances import category_theory.functor.reflects_isomorphisms @@ -11,6 +10,9 @@ import category_theory.functor.reflects_isomorphisms /-! # Category instances for monoid, add_monoid, comm_monoid, and add_comm_monoid. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the bundled categories: * `Mon` * `AddMon` @@ -78,6 +80,8 @@ instance (M : Mon) : monoid M := M.str @[simp, to_additive] lemma coe_of (R : Type u) [monoid R] : (Mon.of R : Type u) = R := rfl +@[to_additive] instance {G : Type*} [group G] : group (Mon.of G) := by assumption + end Mon /-- The category of commutative monoids and monoid morphisms. -/ diff --git a/src/algebra/category/Mon/colimits.lean b/src/algebra/category/Mon/colimits.lean index ca6f7e5c4ad04..b1bbcb32c2f8d 100644 --- a/src/algebra/category/Mon/colimits.lean +++ b/src/algebra/category/Mon/colimits.lean @@ -5,11 +5,14 @@ Authors: Scott Morrison -/ import algebra.category.Mon.basic import category_theory.limits.has_limits -import category_theory.limits.concrete_category +import category_theory.concrete_category.elementwise /-! # The category of monoids has all colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We do this construction knowing nothing about monoids. In particular, I want to claim that this file could be produced by a python script that just looks at the output of `#print monoid`: diff --git a/src/algebra/category/Mon/default.lean b/src/algebra/category/Mon/default.lean deleted file mode 100644 index dabba273e243d..0000000000000 --- a/src/algebra/category/Mon/default.lean +++ /dev/null @@ -1 +0,0 @@ -import algebra.category.Mon.colimits diff --git a/src/algebra/category/Mon/filtered_colimits.lean b/src/algebra/category/Mon/filtered_colimits.lean index 8372540ebe6f1..93d263d8b0941 100644 --- a/src/algebra/category/Mon/filtered_colimits.lean +++ b/src/algebra/category/Mon/filtered_colimits.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Justus Springer -/ import algebra.category.Mon.basic -import category_theory.limits.concrete_category import category_theory.limits.preserves.filtered +import category_theory.concrete_category.elementwise +import category_theory.limits.types /-! # The forgetful functor from (commutative) (additive) monoids preserves filtered colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Forgetful functors from algebraic categories usually don't preserve colimits. However, they tend to preserve _filtered_ colimits. @@ -20,7 +24,7 @@ showing that the forgetful functor `forget Mon` preserves filtered colimits. Sim -/ -universe v +universes v u noncomputable theory open_locale classical @@ -35,7 +39,7 @@ section -- We use parameters here, mainly so we can have the abbreviations `M` and `M.mk` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] (F : J ⥤ Mon.{v}) +parameters {J : Type v} [small_category J] (F : J ⥤ Mon.{max v u}) /-- The colimit of `F ⋙ forget Mon` in the category of types. @@ -43,7 +47,7 @@ In the following, we will construct a monoid structure on `M`. -/ @[to_additive "The colimit of `F ⋙ forget AddMon` in the category of types. In the following, we will construct an additive monoid structure on `M`."] -abbreviation M : Type v := types.quot (F ⋙ forget Mon) +abbreviation M : Type (max v u) := types.quot (F ⋙ forget Mon) /-- The canonical projection into the colimit, as a quotient type. -/ @[to_additive "The canonical projection into the colimit, as a quotient type."] @@ -243,10 +247,10 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := (λ j, funext $ λ x, monoid_hom.congr_fun (h j) x) } @[to_additive] -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget Mon) := +instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget Mon.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) (types.colimit_cocone_is_colimit (F ⋙ forget Mon)) } } + (colimit_cocone_is_colimit.{u u} F) (types.colimit_cocone_is_colimit (F ⋙ forget Mon.{u})) } } end @@ -261,7 +265,7 @@ section -- We use parameters here, mainly so we can have the abbreviation `M` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommMon.{v}) +parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommMon.{max v u}) /-- The colimit of `F ⋙ forget₂ CommMon Mon` in the category `Mon`. @@ -269,7 +273,7 @@ In the following, we will show that this has the structure of a _commutative_ mo -/ @[to_additive "The colimit of `F ⋙ forget₂ AddCommMon AddMon` in the category `AddMon`. In the following, we will show that this has the structure of a _commutative_ additive monoid."] -abbreviation M : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ CommMon Mon.{v}) +abbreviation M : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ CommMon Mon.{max v u}) @[to_additive] instance colimit_comm_monoid : comm_monoid M := @@ -292,13 +296,13 @@ def colimit : CommMon := CommMon.of M @[to_additive "The cocone over the proposed colimit additive commutative monoid."] def colimit_cocone : cocone F := { X := colimit, - ι := { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommMon Mon.{v})).ι } } + ι := { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommMon Mon.{max v u})).ι } } /-- The proposed colimit cocone is a colimit in `CommMon`. -/ @[to_additive "The proposed colimit cocone is a colimit in `AddCommMon`."] def colimit_cocone_is_colimit : is_colimit colimit_cocone := -{ desc := λ t, Mon.filtered_colimits.colimit_desc (F ⋙ forget₂ CommMon Mon.{v}) - ((forget₂ CommMon Mon.{v}).map_cocone t), +{ desc := λ t, Mon.filtered_colimits.colimit_desc (F ⋙ forget₂ CommMon Mon.{max v u}) + ((forget₂ CommMon Mon.{max v u}).map_cocone t), fac' := λ t j, monoid_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget CommMon)).fac ((forget CommMon).map_cocone t) j, uniq' := λ t m h, monoid_hom.coe_inj $ @@ -307,14 +311,15 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := @[to_additive forget₂_AddMon_preserves_filtered_colimits] instance forget₂_Mon_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ CommMon Mon.{v}) := + preserves_filtered_colimits (forget₂ CommMon Mon.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) - (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommMon Mon.{v})) } } + (colimit_cocone_is_colimit.{u u} F) + (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommMon Mon.{u})) } } @[to_additive] -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget CommMon) := +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget CommMon.{u}) := limits.comp_preserves_filtered_colimits (forget₂ CommMon Mon) (forget Mon) end diff --git a/src/algebra/category/Mon/limits.lean b/src/algebra/category/Mon/limits.lean index 53987c4cc4f9c..72d374a402eaa 100644 --- a/src/algebra/category/Mon/limits.lean +++ b/src/algebra/category/Mon/limits.lean @@ -12,6 +12,9 @@ import group_theory.submonoid.operations /-! # The category of (commutative) (additive) monoids has all limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Further, these limits are preserved by the forgetful functor --- that is, the underlying types are just the limits in the category of types. @@ -22,14 +25,14 @@ noncomputable theory open category_theory open category_theory.limits -universe u +universes v u namespace Mon -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] @[to_additive] -instance monoid_obj (F : J ⥤ Mon) (j) : +instance monoid_obj (F : J ⥤ Mon.{max v u}) (j) : monoid ((F ⋙ forget Mon).obj j) := by { change monoid (F.obj j), apply_instance } @@ -38,7 +41,7 @@ The flat sections of a functor into `Mon` form a submonoid of all sections. -/ @[to_additive "The flat sections of a functor into `AddMon` form an additive submonoid of all sections."] -def sections_submonoid (F : J ⥤ Mon) : +def sections_submonoid (F : J ⥤ Mon.{max v u}) : submonoid (Π j, F.obj j) := { carrier := (F ⋙ forget Mon).sections, one_mem' := λ j j' f, by simp, @@ -50,13 +53,13 @@ def sections_submonoid (F : J ⥤ Mon) : end } @[to_additive] -instance limit_monoid (F : J ⥤ Mon) : - monoid (types.limit_cone (F ⋙ forget Mon.{u})).X := +instance limit_monoid (F : J ⥤ Mon.{max v u}) : + monoid (types.limit_cone (F ⋙ forget Mon.{max v u})).X := (sections_submonoid F).to_monoid /-- `limit.π (F ⋙ forget Mon) j` as a `monoid_hom`. -/ @[to_additive "`limit.π (F ⋙ forget AddMon) j` as an `add_monoid_hom`."] -def limit_π_monoid_hom (F : J ⥤ Mon.{u}) (j) : +def limit_π_monoid_hom (F : J ⥤ Mon.{max v u}) (j) : (types.limit_cone (F ⋙ forget Mon)).X →* (F ⋙ forget Mon).obj j := { to_fun := (types.limit_cone (F ⋙ forget Mon)).π.app j, map_one' := rfl, @@ -72,7 +75,7 @@ Construction of a limit cone in `Mon`. (Internal use only; use the limits API.) -/ @[to_additive "(Internal use only; use the limits API.)"] -def limit_cone (F : J ⥤ Mon.{u}) : cone F := +def limit_cone (F : J ⥤ Mon.{max v u}) : cone F := { X := Mon.of (types.limit_cone (F ⋙ forget _)).X, π := { app := limit_π_monoid_hom F, @@ -84,7 +87,7 @@ Witness that the limit cone in `Mon` is a limit cone. (Internal use only; use the limits API.) -/ @[to_additive "(Internal use only; use the limits API.)"] -def limit_cone_is_limit (F : J ⥤ Mon) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ Mon.{max v u}) : is_limit (limit_cone F) := begin refine is_limit.of_faithful (forget Mon) (types.limit_cone_is_limit _) @@ -97,39 +100,46 @@ open has_limits /-- The category of monoids has all limits. -/ @[to_additive "The category of additive monoids has all limits."] -instance has_limits : has_limits Mon := +instance has_limits_of_size : has_limits_of_size.{v} Mon.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } } +@[to_additive] +instance has_limits : has_limits Mon.{u} := Mon.has_limits_of_size.{u u} + /-- The forgetful functor from monoids to types preserves all limits. This means the underlying type of a limit can be computed as a limit in the category of types. -/ @[to_additive "The forgetful functor from additive monoids to types preserves all limits. This means the underlying type of a limit can be computed as a limit in the category of types."] -instance forget_preserves_limits : preserves_limits (forget Mon) := +instance forget_preserves_limits_of_size : preserves_limits_of_size.{v} (forget Mon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (types.limit_cone_is_limit (F ⋙ forget _)) } } +@[to_additive] +instance forget_preserves_limits : preserves_limits (forget Mon.{u}) := +Mon.forget_preserves_limits_of_size.{u u} + end Mon namespace CommMon -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] @[to_additive] -instance comm_monoid_obj (F : J ⥤ CommMon) (j) : +instance comm_monoid_obj (F : J ⥤ CommMon.{max v u}) (j) : comm_monoid ((F ⋙ forget CommMon).obj j) := by { change comm_monoid (F.obj j), apply_instance } @[to_additive] -instance limit_comm_monoid (F : J ⥤ CommMon) : - comm_monoid (types.limit_cone (F ⋙ forget CommMon.{u})).X := +instance limit_comm_monoid (F : J ⥤ CommMon.{max v u}) : + comm_monoid (types.limit_cone (F ⋙ forget CommMon.{max v u})).X := @submonoid.to_comm_monoid (Π j, F.obj j) _ - (Mon.sections_submonoid (F ⋙ forget₂ CommMon Mon.{u})) + (Mon.sections_submonoid (F ⋙ forget₂ CommMon Mon.{max v u})) /-- We show that the forgetful functor `CommMon ⥤ Mon` creates limits. @@ -139,15 +149,16 @@ and then reuse the existing limit. -/ All we need to do is notice that the limit point has an `add_comm_monoid` instance available, and then reuse the existing limit."] -instance (F : J ⥤ CommMon) : creates_limit F (forget₂ CommMon Mon.{u}) := +instance (F : J ⥤ CommMon.{max v u}) : creates_limit F (forget₂ CommMon Mon.{max v u}) := creates_limit_of_reflects_iso (λ c' t, { lifted_cone := { X := CommMon.of (types.limit_cone (F ⋙ forget CommMon)).X, π := - { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ CommMon Mon), - naturality' := (Mon.has_limits.limit_cone (F ⋙ forget₂ _ _)).π.naturality, } }, + { app := Mon.limit_π_monoid_hom (F ⋙ forget₂ CommMon Mon.{max v u}), + naturality' := + (Mon.has_limits.limit_cone (F ⋙ forget₂ CommMon Mon.{max v u})).π.naturality, } }, valid_lift := by apply is_limit.unique_up_to_iso (Mon.has_limits.limit_cone_is_limit _) t, - makes_limit := is_limit.of_faithful (forget₂ CommMon Mon.{u}) + makes_limit := is_limit.of_faithful (forget₂ CommMon Mon.{max v u}) (Mon.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) }) /-- @@ -156,8 +167,8 @@ A choice of limit cone for a functor into `CommMon`. -/ @[to_additive "A choice of limit cone for a functor into `CommMon`. (Generally, you'll just want to use `limit F`.)"] -def limit_cone (F : J ⥤ CommMon) : cone F := -lift_limit (limit.is_limit (F ⋙ (forget₂ CommMon Mon.{u}))) +def limit_cone (F : J ⥤ CommMon.{max v u}) : cone F := +lift_limit (limit.is_limit (F ⋙ (forget₂ CommMon Mon.{max v u}))) /-- The chosen cone is a limit cone. @@ -165,14 +176,17 @@ The chosen cone is a limit cone. -/ @[to_additive "The chosen cone is a limit cone. (Generally, you'll just want to use `limit.cone F`.)"] -def limit_cone_is_limit (F : J ⥤ CommMon) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ CommMon.{max v u}) : is_limit (limit_cone F) := lifted_limit_is_limit _ /-- The category of commutative monoids has all limits. -/ @[to_additive "The category of commutative monoids has all limits."] -instance has_limits : has_limits CommMon := +instance has_limits_of_size : has_limits_of_size.{v v} CommMon.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI - { has_limit := λ F, has_limit_of_created F (forget₂ CommMon Mon) } } + { has_limit := λ F, has_limit_of_created F (forget₂ CommMon Mon.{max v u}) } } + +@[to_additive] +instance has_limits : has_limits CommMon.{u} := CommMon.has_limits_of_size.{u u} /-- The forgetful functor from commutative monoids to monoids preserves all limits. @@ -182,10 +196,15 @@ commutative monoids to additive monoids preserves all limits. This means the underlying type of a limit can be computed as a limit in the category of additive monoids."] -instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ CommMon Mon) := +instance forget₂_Mon_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ CommMon Mon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, { preserves_limit := λ F, by apply_instance } } +@[to_additive] +instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ CommMon Mon.{u}) := +CommMon.forget₂_Mon_preserves_limits_of_size.{u u} + /-- The forgetful functor from commutative monoids to types preserves all limits. This means the underlying type of a limit can be computed as a limit in the category of types. -/ @@ -193,8 +212,13 @@ This means the underlying type of a limit can be computed as a limit in the cate limits. This means the underlying type of a limit can be computed as a limit in the category of types."] -instance forget_preserves_limits : preserves_limits (forget CommMon) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget CommMon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommMon Mon) (forget Mon) } } +@[to_additive] +instance forget_preserves_limits : preserves_limits (forget CommMon.{u}) := +CommMon.forget_preserves_limits_of_size.{u u} + end CommMon diff --git a/src/algebra/category/Ring/adjunctions.lean b/src/algebra/category/Ring/adjunctions.lean index d1d6809d85fea..166a5e3c14e97 100644 --- a/src/algebra/category/Ring/adjunctions.lean +++ b/src/algebra/category/Ring/adjunctions.lean @@ -7,6 +7,9 @@ import algebra.category.Ring.basic import data.mv_polynomial.comm_ring /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Multivariable polynomials on a type is the left adjoint of the forgetful functor from commutative rings to types. -/ diff --git a/src/algebra/category/Ring/basic.lean b/src/algebra/category/Ring/basic.lean index 8f4fdead38b47..3853efd1e88ad 100644 --- a/src/algebra/category/Ring/basic.lean +++ b/src/algebra/category/Ring/basic.lean @@ -5,11 +5,15 @@ Authors: Scott Morrison, Johannes Hölzl, Yury Kudryashov -/ import algebra.category.Group.basic import category_theory.concrete_category.reflects_isomorphisms +import category_theory.elementwise import algebra.ring.equiv /-! # Category instances for semiring, ring, comm_semiring, and comm_ring. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the bundled categories: * `SemiRing` * `Ring` @@ -261,6 +265,13 @@ instance CommRing.forget_reflects_isos : reflects_isomorphisms (forget CommRing. exact ⟨(is_iso.of_iso e.to_CommRing_iso).1⟩, end } +lemma CommRing.comp_eq_ring_hom_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) : + f ≫ g = g.comp f := rfl + +lemma CommRing.ring_hom_comp_eq_comp {R S T : Type*} [comm_ring R] [comm_ring S] + [comm_ring T] (f : R →+* S) (g : S →+* T) : + g.comp f = CommRing.of_hom f ≫ CommRing.of_hom g := rfl + -- It would be nice if we could have the following, -- but it requires making `reflects_isomorphisms_forget₂` an instance, -- which can cause typeclass loops: diff --git a/src/algebra/category/Ring/colimits.lean b/src/algebra/category/Ring/colimits.lean index f786d20f28eb3..c14f79f0734f1 100644 --- a/src/algebra/category/Ring/colimits.lean +++ b/src/algebra/category/Ring/colimits.lean @@ -5,11 +5,14 @@ Authors: Scott Morrison -/ import algebra.category.Ring.basic import category_theory.limits.has_limits -import category_theory.limits.concrete_category +import category_theory.concrete_category.elementwise /-! # The category of commutative rings has all colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file uses a "pre-automated" approach, just as for `Mon/colimits.lean`. It is a very uniform approach, that conceivably could be synthesised directly by a tactic that analyses the shape of `comm_ring` and `ring_hom`. @@ -127,15 +130,11 @@ The underlying type of the colimit of a diagram in `CommRing`. @[derive inhabited] def colimit_type : Type v := quotient (colimit_setoid F) -instance : comm_ring (colimit_type F) := +instance : add_group (colimit_type F) := { zero := begin exact quot.mk _ zero end, - one := - begin - exact quot.mk _ one - end, neg := begin fapply @quot.lift, @@ -163,24 +162,6 @@ instance : comm_ring (colimit_type F) := { exact relation.add_1 _ _ _ r }, { refl } }, end, - mul := - begin - fapply @quot.lift _ _ ((colimit_type F) → (colimit_type F)), - { intro x, - fapply @quot.lift, - { intro y, - exact quot.mk _ (mul x y) }, - { intros y y' r, - apply quot.sound, - exact relation.mul_2 _ _ _ r } }, - { intros x x' r, - funext y, - induction y, - dsimp, - apply quot.sound, - { exact relation.mul_1 _ _ _ r }, - { refl } }, - end, zero_add := λ x, begin induction x, @@ -197,28 +178,71 @@ instance : comm_ring (colimit_type F) := apply relation.add_zero, refl, end, - one_mul := λ x, + add_left_neg := λ x, begin induction x, dsimp, apply quot.sound, - apply relation.one_mul, + apply relation.add_left_neg, refl, end, - mul_one := λ x, + add_assoc := λ x y z, begin induction x, + induction y, + induction z, dsimp, apply quot.sound, - apply relation.mul_one, + apply relation.add_assoc, + refl, + refl, + refl, + end } + +instance : add_group_with_one (colimit_type F) := +{ one := + begin + exact quot.mk _ one + end, + .. colimit_type.add_group F } + +instance : comm_ring (colimit_type F) := +{ one := + begin + exact quot.mk _ one + end, + mul := + begin + fapply @quot.lift _ _ ((colimit_type F) → (colimit_type F)), + { intro x, + fapply @quot.lift, + { intro y, + exact quot.mk _ (mul x y) }, + { intros y y' r, + apply quot.sound, + exact relation.mul_2 _ _ _ r } }, + { intros x x' r, + funext y, + induction y, + dsimp, + apply quot.sound, + { exact relation.mul_1 _ _ _ r }, + { refl } }, + end, + one_mul := λ x, + begin + induction x, + dsimp, + apply quot.sound, + apply relation.one_mul, refl, end, - add_left_neg := λ x, + mul_one := λ x, begin induction x, dsimp, apply quot.sound, - apply relation.add_left_neg, + apply relation.mul_one, refl, end, add_comm := λ x y, @@ -288,7 +312,8 @@ instance : comm_ring (colimit_type F) := refl, refl, refl, - end, } + end, + .. colimit_type.add_group_with_one F } @[simp] lemma quot_zero : quot.mk setoid.r zero = (0 : colimit_type F) := rfl @[simp] lemma quot_one : quot.mk setoid.r one = (1 : colimit_type F) := rfl diff --git a/src/algebra/category/Ring/constructions.lean b/src/algebra/category/Ring/constructions.lean index 9e9dc9e24b503..945151b41057f 100644 --- a/src/algebra/category/Ring/constructions.lean +++ b/src/algebra/category/Ring/constructions.lean @@ -6,15 +6,16 @@ Authors: Andrew Yang import category_theory.limits.shapes.pullbacks import ring_theory.tensor_product import algebra.category.Ring.limits -import algebra.category.Ring.colimits +import algebra.category.Ring.instances import category_theory.limits.shapes.strict_initial import ring_theory.subring.basic -import ring_theory.ideal.local_ring -import category_theory.limits.preserves.limits /-! # Constructions of (co)limits in CommRing +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we provide the explicit (co)cones for various (co)limits in `CommRing`, including * tensor product is the pushout * `Z` is the initial object @@ -145,11 +146,11 @@ binary_fan.mk (CommRing.of_hom $ ring_hom.fst A B) (CommRing.of_hom $ ring_hom.s /-- The product in `CommRing` is the cartesian product. -/ def prod_fan_is_limit : is_limit (prod_fan A B) := -{ lift := λ c, ring_hom.prod (c.π.app walking_pair.left) (c.π.app walking_pair.right), - fac' := λ c j, by { ext, cases j; +{ lift := λ c, ring_hom.prod (c.π.app ⟨walking_pair.left⟩) (c.π.app ⟨walking_pair.right⟩), + fac' := λ c j, by { ext, rcases j with ⟨⟨⟩⟩; simpa only [binary_fan.π_app_left, binary_fan.π_app_right, comp_apply, ring_hom.prod_apply] }, - uniq' := λ s m h, by { ext, { simpa using congr_hom (h walking_pair.left) x }, - { simpa using congr_hom (h walking_pair.right) x } } } + uniq' := λ s m h, by { ext, { simpa using congr_hom (h ⟨walking_pair.left⟩) x }, + { simpa using congr_hom (h ⟨walking_pair.right⟩) x } } } end product @@ -166,7 +167,7 @@ def equalizer_fork_is_limit : is_limit (equalizer_fork f g) := begin fapply fork.is_limit.mk', intro s, - use s.ι.cod_restrict' _ (λ x, (concrete_category.congr_hom s.condition x : _)), + use s.ι.cod_restrict _ (λ x, (concrete_category.congr_hom s.condition x : _)), split, { ext, refl }, { intros m hm, ext x, exact concrete_category.congr_hom hm x } @@ -184,7 +185,7 @@ begin exact ⟨⟨y, this⟩, subtype.eq h₃⟩, end -instance equalizer_ι_is_local_ring_hom (F : walking_parallel_pair.{u} ⥤ CommRing.{u}) : +instance equalizer_ι_is_local_ring_hom (F : walking_parallel_pair ⥤ CommRing.{u}) : is_local_ring_hom (limit.π F walking_parallel_pair.zero) := begin have := lim_map_π (diagram_iso_parallel_pair F).hom walking_parallel_pair.zero, @@ -200,10 +201,10 @@ end open category_theory.limits.walking_parallel_pair opposite open category_theory.limits.walking_parallel_pair_hom -instance equalizer_ι_is_local_ring_hom' (F : walking_parallel_pair.{u}ᵒᵖ ⥤ CommRing.{u}) : +instance equalizer_ι_is_local_ring_hom' (F : walking_parallel_pairᵒᵖ ⥤ CommRing.{u}) : is_local_ring_hom (limit.π F (opposite.op walking_parallel_pair.one)) := begin - have : _ = limit.π F (walking_parallel_pair_op_equiv.{u u}.functor.obj _) := + have : _ = limit.π F (walking_parallel_pair_op_equiv.functor.obj _) := (limit.iso_limit_cone_inv_π ⟨_, is_limit.whisker_equivalence (limit.is_limit F) walking_parallel_pair_op_equiv⟩ walking_parallel_pair.zero : _), erw ← this, @@ -212,4 +213,35 @@ end end equalizer +section pullback + +/-- +In the category of `CommRing`, the pullback of `f : A ⟶ C` and `g : B ⟶ C` is the `eq_locus` of +the two maps `A × B ⟶ C`. This is the constructed pullback cone. +-/ +def pullback_cone {A B C : CommRing.{u}} (f : A ⟶ C) (g : B ⟶ C) : pullback_cone f g := +pullback_cone.mk + (CommRing.of_hom $ (ring_hom.fst A B).comp + (ring_hom.eq_locus (f.comp (ring_hom.fst A B)) (g.comp (ring_hom.snd A B))).subtype) + (CommRing.of_hom $ (ring_hom.snd A B).comp + (ring_hom.eq_locus (f.comp (ring_hom.fst A B)) (g.comp (ring_hom.snd A B))).subtype) + (by { ext ⟨x, e⟩, simpa [CommRing.of_hom] using e }) + +/-- The constructed pullback cone is indeed the limit. -/ +def pullback_cone_is_limit {A B C : CommRing.{u}} (f : A ⟶ C) (g : B ⟶ C) : + is_limit (pullback_cone f g) := +begin + fapply pullback_cone.is_limit.mk, + { intro s, + apply (s.fst.prod s.snd).cod_restrict, + intro x, exact congr_arg (λ f : s.X →+* C, f x) s.condition }, + { intro s, ext x, refl }, + { intro s, ext x, refl }, + { intros s m e₁ e₂, ext, + { exact (congr_arg (λ f : s.X →+* A, f x) e₁ : _) }, + { exact (congr_arg (λ f : s.X →+* B, f x) e₂ : _) } } +end + +end pullback + end CommRing diff --git a/src/algebra/category/Ring/default.lean b/src/algebra/category/Ring/default.lean deleted file mode 100644 index ef2d0c7f26ad5..0000000000000 --- a/src/algebra/category/Ring/default.lean +++ /dev/null @@ -1,3 +0,0 @@ -import algebra.category.Ring.adjunctions -import algebra.category.Ring.limits -import algebra.category.Ring.colimits diff --git a/src/algebra/category/Ring/filtered_colimits.lean b/src/algebra/category/Ring/filtered_colimits.lean index 25ca46a650d8f..c91d378323f14 100644 --- a/src/algebra/category/Ring/filtered_colimits.lean +++ b/src/algebra/category/Ring/filtered_colimits.lean @@ -9,6 +9,9 @@ import algebra.category.Group.filtered_colimits /-! # The forgetful functor from (commutative) (semi-) rings preserves filtered colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Forgetful functors from algebraic categories usually don't preserve colimits. However, they tend to preserve _filtered_ colimits. @@ -20,7 +23,7 @@ Similarly for `CommSemiRing`, `Ring` and `CommRing`. -/ -universe v +universes v u noncomputable theory open_locale classical @@ -38,11 +41,12 @@ section -- We use parameters here, mainly so we can have the abbreviations `R` and `R.mk` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] (F : J ⥤ SemiRing.{v}) +parameters {J : Type v} [small_category J] (F : J ⥤ SemiRing.{max v u}) -- This instance is needed below in `colimit_semiring`, during the verification of the -- semiring axioms. -instance semiring_obj (j : J) : semiring (((F ⋙ forget₂ SemiRing Mon.{v}) ⋙ forget Mon).obj j) := +instance semiring_obj (j : J) : + semiring (((F ⋙ forget₂ SemiRing Mon.{max v u}) ⋙ forget Mon).obj j) := show semiring (F.obj j), by apply_instance variables [is_filtered J] @@ -51,7 +55,7 @@ variables [is_filtered J] The colimit of `F ⋙ forget₂ SemiRing Mon` in the category `Mon`. In the following, we will show that this has the structure of a semiring. -/ -abbreviation R : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ SemiRing Mon) +abbreviation R : Mon := Mon.filtered_colimits.colimit (F ⋙ forget₂ SemiRing Mon.{max v u}) instance colimit_semiring : semiring R := { mul_zero := λ x, begin @@ -97,7 +101,8 @@ instance colimit_semiring : semiring R := refl, end, ..R.monoid, - ..AddCommMon.filtered_colimits.colimit_add_comm_monoid (F ⋙ forget₂ SemiRing AddCommMon) } + ..AddCommMon.filtered_colimits.colimit_add_comm_monoid + (F ⋙ forget₂ SemiRing AddCommMon.{max v u}) } /-- The bundled semiring giving the filtered colimit of a diagram. -/ def colimit : SemiRing := SemiRing.of R @@ -107,8 +112,9 @@ def colimit_cocone : cocone F := { X := colimit, ι := { app := λ j, - { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ SemiRing Mon)).ι.app j, - ..(AddCommMon.filtered_colimits.colimit_cocone (F ⋙ forget₂ SemiRing AddCommMon)).ι.app j }, + { ..(Mon.filtered_colimits.colimit_cocone (F ⋙ forget₂ SemiRing Mon.{max v u})).ι.app j, + ..(AddCommMon.filtered_colimits.colimit_cocone + (F ⋙ forget₂ SemiRing AddCommMon.{max v u})).ι.app j }, naturality' := λ j j' f, (ring_hom.coe_inj ((types.colimit_cocone (F ⋙ forget SemiRing)).ι.naturality f)) } } @@ -116,9 +122,10 @@ def colimit_cocone : cocone F := def colimit_cocone_is_colimit : is_colimit colimit_cocone := { desc := λ t, { .. (Mon.filtered_colimits.colimit_cocone_is_colimit - (F ⋙ forget₂ SemiRing Mon)).desc ((forget₂ SemiRing Mon).map_cocone t), + (F ⋙ forget₂ SemiRing Mon.{max v u})).desc ((forget₂ SemiRing Mon.{max v u}).map_cocone t), .. (AddCommMon.filtered_colimits.colimit_cocone_is_colimit - (F ⋙ forget₂ SemiRing AddCommMon)).desc ((forget₂ SemiRing AddCommMon).map_cocone t), }, + (F ⋙ forget₂ SemiRing AddCommMon.{max v u})).desc + ((forget₂ SemiRing AddCommMon.{max v u}).map_cocone t), }, fac' := λ t j, ring_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget SemiRing)).fac ((forget SemiRing).map_cocone t) j, uniq' := λ t m h, ring_hom.coe_inj $ @@ -126,14 +133,15 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := (λ j, funext $ λ x, ring_hom.congr_fun (h j) x) } instance forget₂_Mon_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ SemiRing Mon.{v}) := + preserves_filtered_colimits (forget₂ SemiRing Mon.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) - (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ SemiRing Mon.{v})) } } + (colimit_cocone_is_colimit.{u u} F) + (Mon.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ SemiRing Mon.{u})) } } -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget SemiRing) := -limits.comp_preserves_filtered_colimits (forget₂ SemiRing Mon) (forget Mon) +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget SemiRing.{u}) := +limits.comp_preserves_filtered_colimits (forget₂ SemiRing Mon) (forget Mon.{u}) end @@ -146,18 +154,18 @@ section -- We use parameters here, mainly so we can have the abbreviation `R` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommSemiRing.{v}) +parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommSemiRing.{max v u}) /-- The colimit of `F ⋙ forget₂ CommSemiRing SemiRing` in the category `SemiRing`. In the following, we will show that this has the structure of a _commutative_ semiring. -/ abbreviation R : SemiRing := -SemiRing.filtered_colimits.colimit (F ⋙ forget₂ CommSemiRing SemiRing) +SemiRing.filtered_colimits.colimit (F ⋙ forget₂ CommSemiRing SemiRing.{max v u}) instance colimit_comm_semiring : comm_semiring R := { ..R.semiring, - ..CommMon.filtered_colimits.colimit_comm_monoid (F ⋙ forget₂ CommSemiRing CommMon) } + ..CommMon.filtered_colimits.colimit_comm_monoid (F ⋙ forget₂ CommSemiRing CommMon.{max v u}) } /-- The bundled commutative semiring giving the filtered colimit of a diagram. -/ def colimit : CommSemiRing := CommSemiRing.of R @@ -165,12 +173,15 @@ def colimit : CommSemiRing := CommSemiRing.of R /-- The cocone over the proposed colimit commutative semiring. -/ def colimit_cocone : cocone F := { X := colimit, - ι := { ..(SemiRing.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommSemiRing SemiRing)).ι } } + ι := + { ..(SemiRing.filtered_colimits.colimit_cocone + (F ⋙ forget₂ CommSemiRing SemiRing.{max v u})).ι } } /-- The proposed colimit cocone is a colimit in `CommSemiRing`. -/ def colimit_cocone_is_colimit : is_colimit colimit_cocone := { desc := λ t, - (SemiRing.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommSemiRing SemiRing)).desc + (SemiRing.filtered_colimits.colimit_cocone_is_colimit + (F ⋙ forget₂ CommSemiRing SemiRing.{max v u})).desc ((forget₂ CommSemiRing SemiRing).map_cocone t), fac' := λ t j, ring_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget CommSemiRing)).fac @@ -180,15 +191,16 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := ((forget CommSemiRing).map_cocone t) m (λ j, funext $ λ x, ring_hom.congr_fun (h j) x) } instance forget₂_SemiRing_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ CommSemiRing SemiRing.{v}) := + preserves_filtered_colimits (forget₂ CommSemiRing SemiRing.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) + (colimit_cocone_is_colimit.{u u} F) (SemiRing.filtered_colimits.colimit_cocone_is_colimit - (F ⋙ forget₂ CommSemiRing SemiRing.{v})) } } + (F ⋙ forget₂ CommSemiRing SemiRing.{u})) } } -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget CommSemiRing) := -limits.comp_preserves_filtered_colimits (forget₂ CommSemiRing SemiRing) (forget SemiRing) +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget CommSemiRing.{u}) := +limits.comp_preserves_filtered_colimits (forget₂ CommSemiRing SemiRing) (forget SemiRing.{u}) end @@ -201,18 +213,19 @@ section -- We use parameters here, mainly so we can have the abbreviation `R` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ Ring.{v}) +parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ Ring.{max v u}) /-- The colimit of `F ⋙ forget₂ Ring SemiRing` in the category `SemiRing`. In the following, we will show that this has the structure of a ring. -/ abbreviation R : SemiRing := -SemiRing.filtered_colimits.colimit (F ⋙ forget₂ Ring SemiRing) +SemiRing.filtered_colimits.colimit (F ⋙ forget₂ Ring SemiRing.{max v u}) instance colimit_ring : ring R := { ..R.semiring, - ..AddCommGroup.filtered_colimits.colimit_add_comm_group (F ⋙ forget₂ Ring AddCommGroup) } + ..AddCommGroup.filtered_colimits.colimit_add_comm_group + (F ⋙ forget₂ Ring AddCommGroup.{max v u}) } /-- The bundled ring giving the filtered colimit of a diagram. -/ def colimit : Ring := Ring.of R @@ -220,12 +233,12 @@ def colimit : Ring := Ring.of R /-- The cocone over the proposed colimit ring. -/ def colimit_cocone : cocone F := { X := colimit, - ι := { ..(SemiRing.filtered_colimits.colimit_cocone (F ⋙ forget₂ Ring SemiRing)).ι } } + ι := { ..(SemiRing.filtered_colimits.colimit_cocone (F ⋙ forget₂ Ring SemiRing.{max v u})).ι } } /-- The proposed colimit cocone is a colimit in `Ring`. -/ def colimit_cocone_is_colimit : is_colimit colimit_cocone := { desc := λ t, - (SemiRing.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ Ring SemiRing)).desc + (SemiRing.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ Ring SemiRing.{max v u})).desc ((forget₂ Ring SemiRing).map_cocone t), fac' := λ t j, ring_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget Ring)).fac ((forget Ring).map_cocone t) j, @@ -234,14 +247,16 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := ((forget Ring).map_cocone t) m (λ j, funext $ λ x, ring_hom.congr_fun (h j) x) } instance forget₂_SemiRing_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ Ring SemiRing.{v}) := + preserves_filtered_colimits (forget₂ Ring SemiRing.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) - (SemiRing.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ Ring SemiRing.{v})) } } + (colimit_cocone_is_colimit.{u u} F) + (SemiRing.filtered_colimits.colimit_cocone_is_colimit + (F ⋙ forget₂ Ring SemiRing.{u})) } } -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget Ring) := -limits.comp_preserves_filtered_colimits (forget₂ Ring SemiRing) (forget SemiRing) +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget Ring.{u}) := +limits.comp_preserves_filtered_colimits (forget₂ Ring SemiRing) (forget SemiRing.{u}) end @@ -254,18 +269,19 @@ section -- We use parameters here, mainly so we can have the abbreviation `R` below, without -- passing around `F` all the time. -parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommRing.{v}) +parameters {J : Type v} [small_category J] [is_filtered J] (F : J ⥤ CommRing.{max v u}) /-- The colimit of `F ⋙ forget₂ CommRing Ring` in the category `Ring`. In the following, we will show that this has the structure of a _commutative_ ring. -/ abbreviation R : Ring := -Ring.filtered_colimits.colimit (F ⋙ forget₂ CommRing Ring) +Ring.filtered_colimits.colimit (F ⋙ forget₂ CommRing Ring.{max v u}) instance colimit_comm_ring : comm_ring R := { ..R.ring, - ..CommSemiRing.filtered_colimits.colimit_comm_semiring (F ⋙ forget₂ CommRing CommSemiRing) } + ..CommSemiRing.filtered_colimits.colimit_comm_semiring + (F ⋙ forget₂ CommRing CommSemiRing.{max v u}) } /-- The bundled commutative ring giving the filtered colimit of a diagram. -/ def colimit : CommRing := CommRing.of R @@ -273,12 +289,12 @@ def colimit : CommRing := CommRing.of R /-- The cocone over the proposed colimit commutative ring. -/ def colimit_cocone : cocone F := { X := colimit, - ι := { ..(Ring.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommRing Ring)).ι } } + ι := { ..(Ring.filtered_colimits.colimit_cocone (F ⋙ forget₂ CommRing Ring.{max v u})).ι } } /-- The proposed colimit cocone is a colimit in `CommRing`. -/ def colimit_cocone_is_colimit : is_colimit colimit_cocone := { desc := λ t, - (Ring.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommRing Ring)).desc + (Ring.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommRing Ring.{max v u})).desc ((forget₂ CommRing Ring).map_cocone t), fac' := λ t j, ring_hom.coe_inj $ (types.colimit_cocone_is_colimit (F ⋙ forget CommRing)).fac ((forget CommRing).map_cocone t) j, @@ -287,14 +303,15 @@ def colimit_cocone_is_colimit : is_colimit colimit_cocone := ((forget CommRing).map_cocone t) m (λ j, funext $ λ x, ring_hom.congr_fun (h j) x) } instance forget₂_Ring_preserves_filtered_colimits : - preserves_filtered_colimits (forget₂ CommRing Ring.{v}) := + preserves_filtered_colimits (forget₂ CommRing Ring.{u}) := { preserves_filtered_colimits := λ J _ _, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone - (colimit_cocone_is_colimit F) - (Ring.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommRing Ring.{v})) } } + (colimit_cocone_is_colimit.{u u} F) + (Ring.filtered_colimits.colimit_cocone_is_colimit (F ⋙ forget₂ CommRing Ring.{u})) } } -instance forget_preserves_filtered_colimits : preserves_filtered_colimits (forget CommRing) := -limits.comp_preserves_filtered_colimits (forget₂ CommRing Ring) (forget Ring) +instance forget_preserves_filtered_colimits : + preserves_filtered_colimits (forget CommRing.{u}) := +limits.comp_preserves_filtered_colimits (forget₂ CommRing Ring) (forget Ring.{u}) end diff --git a/src/algebra/category/Ring/instances.lean b/src/algebra/category/Ring/instances.lean index 55c663a16477d..009b23397c567 100644 --- a/src/algebra/category/Ring/instances.lean +++ b/src/algebra/category/Ring/instances.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ import algebra.category.Ring.basic -import ring_theory.localization.away +import ring_theory.localization.away.basic +import ring_theory.ideal.local_ring /-! # Ring-theoretic results in terms of categorical languages + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory @@ -19,3 +23,31 @@ is_iso.of_iso (is_localization.at_one R (localization.away (1 : R))).to_ring_equ instance localization_unit_is_iso' (R : CommRing) : @is_iso CommRing _ R _ (CommRing.of_hom $ algebra_map R (localization.away (1 : R))) := by { cases R, exact localization_unit_is_iso _ } + +lemma is_localization.epi {R : Type*} [comm_ring R] (M : submonoid R) (S : Type*) [comm_ring S] + [algebra R S] [is_localization M S] : epi (CommRing.of_hom $ algebra_map R S) := +⟨λ T f₁ f₂, @is_localization.ring_hom_ext R _ M S _ _ T _ _ _ _⟩ + +instance localization.epi {R : Type*} [comm_ring R] (M : submonoid R) : epi + (CommRing.of_hom $ algebra_map R $ localization M) := +is_localization.epi M _ + +instance localization.epi' {R : CommRing} (M : submonoid R) : @epi CommRing _ R _ + (CommRing.of_hom $ algebra_map R $ localization M : _) := +by { cases R, exact is_localization.epi M _ } + +instance CommRing.is_local_ring_hom_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) + [is_local_ring_hom g] [is_local_ring_hom f] : + is_local_ring_hom (f ≫ g) := is_local_ring_hom_comp _ _ + +lemma is_local_ring_hom_of_iso {R S : CommRing} (f : R ≅ S) : is_local_ring_hom f.hom := +{ map_nonunit := λ a ha, + begin + convert f.inv.is_unit_map ha, + rw category_theory.iso.hom_inv_id_apply, + end } + +@[priority 100] -- see Note [lower instance priority] +instance is_local_ring_hom_of_is_iso {R S : CommRing} (f : R ⟶ S) [is_iso f] : + is_local_ring_hom f := +is_local_ring_hom_of_iso (as_iso f) diff --git a/src/algebra/category/Ring/limits.lean b/src/algebra/category/Ring/limits.lean index 0de84e5199c3e..c59aaa2422e9d 100644 --- a/src/algebra/category/Ring/limits.lean +++ b/src/algebra/category/Ring/limits.lean @@ -11,6 +11,9 @@ import ring_theory.subring.basic /-! # The category of (commutative) rings has all limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Further, these limits are preserved by the forgetful functor --- that is, the underlying types are just the limits in the category of types. -/ @@ -27,38 +30,39 @@ library_note "change elaboration strategy with `by apply`" open category_theory open category_theory.limits -universe u +universes v u noncomputable theory namespace SemiRing -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] -instance semiring_obj (F : J ⥤ SemiRing) (j) : +instance semiring_obj (F : J ⥤ SemiRing.{max v u}) (j) : semiring ((F ⋙ forget SemiRing).obj j) := by { change semiring (F.obj j), apply_instance } /-- The flat sections of a functor into `SemiRing` form a subsemiring of all sections. -/ -def sections_subsemiring (F : J ⥤ SemiRing) : +def sections_subsemiring (F : J ⥤ SemiRing.{max v u}) : subsemiring (Π j, F.obj j) := { carrier := (F ⋙ forget SemiRing).sections, - ..(AddMon.sections_add_submonoid (F ⋙ forget₂ SemiRing AddCommMon ⋙ forget₂ AddCommMon AddMon)), - ..(Mon.sections_submonoid (F ⋙ forget₂ SemiRing Mon)) } + ..(AddMon.sections_add_submonoid + (F ⋙ forget₂ SemiRing AddCommMon.{max v u} ⋙ forget₂ AddCommMon AddMon.{max v u})), + ..(Mon.sections_submonoid (F ⋙ forget₂ SemiRing Mon.{max v u})) } -instance limit_semiring (F : J ⥤ SemiRing) : - semiring (types.limit_cone (F ⋙ forget SemiRing.{u})).X := +instance limit_semiring (F : J ⥤ SemiRing.{max v u}) : + semiring (types.limit_cone (F ⋙ forget SemiRing.{max v u})).X := (sections_subsemiring F).to_semiring /-- `limit.π (F ⋙ forget SemiRing) j` as a `ring_hom`. -/ -def limit_π_ring_hom (F : J ⥤ SemiRing.{u}) (j) : +def limit_π_ring_hom (F : J ⥤ SemiRing.{max v u}) (j) : (types.limit_cone (F ⋙ forget SemiRing)).X →+* (F ⋙ forget SemiRing).obj j := { to_fun := (types.limit_cone (F ⋙ forget SemiRing)).π.app j, ..AddMon.limit_π_add_monoid_hom - (F ⋙ forget₂ SemiRing AddCommMon.{u} ⋙ forget₂ AddCommMon AddMon) j, - ..Mon.limit_π_monoid_hom (F ⋙ forget₂ SemiRing Mon) j, } + (F ⋙ forget₂ SemiRing AddCommMon.{max v u} ⋙ forget₂ AddCommMon AddMon.{max v u}) j, + ..Mon.limit_π_monoid_hom (F ⋙ forget₂ SemiRing Mon.{max v u}) j, } namespace has_limits -- The next two definitions are used in the construction of `has_limits SemiRing`. @@ -69,7 +73,7 @@ namespace has_limits Construction of a limit cone in `SemiRing`. (Internal use only; use the limits API.) -/ -def limit_cone (F : J ⥤ SemiRing.{u}) : cone F := +def limit_cone (F : J ⥤ SemiRing.{max v u}) : cone F := { X := SemiRing.of (types.limit_cone (F ⋙ forget _)).X, π := { app := limit_π_ring_hom F, @@ -80,7 +84,7 @@ def limit_cone (F : J ⥤ SemiRing.{u}) : cone F := Witness that the limit cone in `SemiRing` is a limit cone. (Internal use only; use the limits API.) -/ -def limit_cone_is_limit (F : J ⥤ SemiRing) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ SemiRing.{max v u}) : is_limit (limit_cone F) := begin refine is_limit.of_faithful (forget SemiRing) (types.limit_cone_is_limit _) @@ -93,65 +97,78 @@ open has_limits /-- The category of rings has all limits. -/ @[irreducible] -instance has_limits : has_limits SemiRing := +instance has_limits_of_size : has_limits_of_size.{v} SemiRing.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } } +instance has_limits : has_limits SemiRing.{u} := SemiRing.has_limits_of_size.{u u} + /-- An auxiliary declaration to speed up typechecking. -/ -def forget₂_AddCommMon_preserves_limits_aux (F : J ⥤ SemiRing) : +def forget₂_AddCommMon_preserves_limits_aux (F : J ⥤ SemiRing.{max v u}) : is_limit ((forget₂ SemiRing AddCommMon).map_cone (limit_cone F)) := -by apply AddCommMon.limit_cone_is_limit (F ⋙ forget₂ SemiRing AddCommMon) +by apply AddCommMon.limit_cone_is_limit (F ⋙ forget₂ SemiRing AddCommMon.{max v u}) /-- The forgetful functor from semirings to additive commutative monoids preserves all limits. -/ -instance forget₂_AddCommMon_preserves_limits : preserves_limits (forget₂ SemiRing AddCommMon) := +instance forget₂_AddCommMon_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ SemiRing AddCommMon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (forget₂_AddCommMon_preserves_limits_aux F) } } +instance forget₂_AddCommMon_preserves_limits : preserves_limits (forget₂ SemiRing AddCommMon.{u}) := +SemiRing.forget₂_AddCommMon_preserves_limits_of_size.{u u} + /-- An auxiliary declaration to speed up typechecking. -/ -def forget₂_Mon_preserves_limits_aux (F : J ⥤ SemiRing) : +def forget₂_Mon_preserves_limits_aux (F : J ⥤ SemiRing.{max v u}) : is_limit ((forget₂ SemiRing Mon).map_cone (limit_cone F)) := -by apply Mon.has_limits.limit_cone_is_limit (F ⋙ forget₂ SemiRing Mon) +by apply Mon.has_limits.limit_cone_is_limit (F ⋙ forget₂ SemiRing Mon.{max v u}) /-- The forgetful functor from semirings to monoids preserves all limits. -/ -instance forget₂_Mon_preserves_limits : - preserves_limits (forget₂ SemiRing Mon) := +instance forget₂_Mon_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ SemiRing Mon.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (forget₂_Mon_preserves_limits_aux F) } } +instance forget₂_Mon_preserves_limits : preserves_limits (forget₂ SemiRing Mon.{u}) := +SemiRing.forget₂_Mon_preserves_limits_of_size.{u u} + /-- The forgetful functor from semirings to types preserves all limits. -/ -instance forget_preserves_limits : preserves_limits (forget SemiRing) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget SemiRing.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (types.limit_cone_is_limit (F ⋙ forget _)) } } +instance forget_preserves_limits : preserves_limits (forget SemiRing.{u}) := +SemiRing.forget_preserves_limits_of_size.{u u} + end SemiRing namespace CommSemiRing -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] -instance comm_semiring_obj (F : J ⥤ CommSemiRing) (j) : +instance comm_semiring_obj (F : J ⥤ CommSemiRing.{max v u}) (j) : comm_semiring ((F ⋙ forget CommSemiRing).obj j) := by { change comm_semiring (F.obj j), apply_instance } -instance limit_comm_semiring (F : J ⥤ CommSemiRing) : - comm_semiring (types.limit_cone (F ⋙ forget CommSemiRing.{u})).X := +instance limit_comm_semiring (F : J ⥤ CommSemiRing.{max v u}) : + comm_semiring (types.limit_cone (F ⋙ forget CommSemiRing.{max v u})).X := @subsemiring.to_comm_semiring (Π j, F.obj j) _ - (SemiRing.sections_subsemiring (F ⋙ forget₂ CommSemiRing SemiRing.{u})) + (SemiRing.sections_subsemiring (F ⋙ forget₂ CommSemiRing SemiRing.{max v u})) /-- We show that the forgetful functor `CommSemiRing ⥤ SemiRing` creates limits. @@ -159,15 +176,17 @@ We show that the forgetful functor `CommSemiRing ⥤ SemiRing` creates limits. All we need to do is notice that the limit point has a `comm_semiring` instance available, and then reuse the existing limit. -/ -instance (F : J ⥤ CommSemiRing) : creates_limit F (forget₂ CommSemiRing SemiRing.{u}) := +instance (F : J ⥤ CommSemiRing.{max v u}) : + creates_limit F (forget₂ CommSemiRing SemiRing.{max v u}) := creates_limit_of_reflects_iso (λ c' t, { lifted_cone := { X := CommSemiRing.of (types.limit_cone (F ⋙ forget _)).X, π := - { app := by apply SemiRing.limit_π_ring_hom (F ⋙ forget₂ CommSemiRing SemiRing), - naturality' := (SemiRing.has_limits.limit_cone (F ⋙ forget₂ _ _)).π.naturality, } }, + { app := by apply SemiRing.limit_π_ring_hom (F ⋙ forget₂ CommSemiRing SemiRing.{max v u}), + naturality' := (SemiRing.has_limits.limit_cone + (F ⋙ forget₂ CommSemiRing SemiRing.{max v u})).π.naturality, } }, valid_lift := by apply is_limit.unique_up_to_iso (SemiRing.has_limits.limit_cone_is_limit _) t, - makes_limit := is_limit.of_faithful (forget₂ CommSemiRing SemiRing.{u}) + makes_limit := is_limit.of_faithful (forget₂ CommSemiRing SemiRing.{max v u}) (by apply SemiRing.has_limits.limit_cone_is_limit _) (λ s, (SemiRing.has_limits.limit_cone_is_limit _).lift ((forget₂ _ SemiRing).map_cone s)) (λ s, rfl) }) @@ -176,61 +195,70 @@ creates_limit_of_reflects_iso (λ c' t, A choice of limit cone for a functor into `CommSemiRing`. (Generally, you'll just want to use `limit F`.) -/ -def limit_cone (F : J ⥤ CommSemiRing) : cone F := -lift_limit (limit.is_limit (F ⋙ (forget₂ CommSemiRing SemiRing.{u}))) +def limit_cone (F : J ⥤ CommSemiRing.{max v u}) : cone F := +lift_limit (limit.is_limit (F ⋙ (forget₂ CommSemiRing SemiRing.{max v u}))) /-- The chosen cone is a limit cone. (Generally, you'll just want to use `limit.cone F`.) -/ -def limit_cone_is_limit (F : J ⥤ CommSemiRing) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ CommSemiRing.{max v u}) : is_limit (limit_cone F) := lifted_limit_is_limit _ /-- The category of rings has all limits. -/ @[irreducible] -instance has_limits : has_limits CommSemiRing.{u} := +instance has_limits_of_size : has_limits_of_size.{v v} CommSemiRing.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI - { has_limit := λ F, has_limit_of_created F (forget₂ CommSemiRing SemiRing.{u}) } } + { has_limit := λ F, has_limit_of_created F (forget₂ CommSemiRing SemiRing.{max v u}) } } + +instance has_limits : has_limits CommSemiRing.{u} := CommSemiRing.has_limits_of_size.{u u} /-- The forgetful functor from rings to semirings preserves all limits. -/ -instance forget₂_SemiRing_preserves_limits : preserves_limits (forget₂ CommSemiRing SemiRing) := +instance forget₂_SemiRing_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ CommSemiRing SemiRing.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, { preserves_limit := λ F, by apply_instance } } +instance forget₂_SemiRing_preserves_limits : preserves_limits (forget₂ CommSemiRing SemiRing.{u}) := +CommSemiRing.forget₂_SemiRing_preserves_limits_of_size.{u u} + /-- The forgetful functor from rings to types preserves all limits. (That is, the underlying types could have been computed instead as limits in the category of types.) -/ -instance forget_preserves_limits : preserves_limits (forget CommSemiRing) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget CommSemiRing.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommSemiRing SemiRing) (forget SemiRing) } } +instance forget_preserves_limits : preserves_limits (forget CommSemiRing.{u}) := +CommSemiRing.forget_preserves_limits_of_size.{u u} end CommSemiRing - namespace Ring -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] -instance ring_obj (F : J ⥤ Ring) (j) : +instance ring_obj (F : J ⥤ Ring.{max v u}) (j) : ring ((F ⋙ forget Ring).obj j) := by { change ring (F.obj j), apply_instance } /-- The flat sections of a functor into `Ring` form a subring of all sections. -/ -def sections_subring (F : J ⥤ Ring) : +def sections_subring (F : J ⥤ Ring.{max v u}) : subring (Π j, F.obj j) := { carrier := (F ⋙ forget Ring).sections, - .. AddGroup.sections_add_subgroup (F ⋙ forget₂ Ring AddCommGroup ⋙ forget₂ AddCommGroup AddGroup), - .. SemiRing.sections_subsemiring (F ⋙ forget₂ Ring SemiRing) } + .. AddGroup.sections_add_subgroup + (F ⋙ forget₂ Ring AddCommGroup.{max v u} ⋙ forget₂ AddCommGroup AddGroup.{max v u}), + .. SemiRing.sections_subsemiring (F ⋙ forget₂ Ring SemiRing.{max v u}) } -instance limit_ring (F : J ⥤ Ring) : - ring (types.limit_cone (F ⋙ forget Ring.{u})).X := +instance limit_ring (F : J ⥤ Ring.{max v u}) : + ring (types.limit_cone (F ⋙ forget Ring.{max v u})).X := (sections_subring F).to_ring /-- @@ -239,15 +267,16 @@ We show that the forgetful functor `CommRing ⥤ Ring` creates limits. All we need to do is notice that the limit point has a `ring` instance available, and then reuse the existing limit. -/ -instance (F : J ⥤ Ring) : creates_limit F (forget₂ Ring SemiRing.{u}) := +instance (F : J ⥤ Ring.{max v u}) : creates_limit F (forget₂ Ring SemiRing.{max v u}) := creates_limit_of_reflects_iso (λ c' t, { lifted_cone := { X := Ring.of (types.limit_cone (F ⋙ forget _)).X, π := - { app := by apply SemiRing.limit_π_ring_hom (F ⋙ forget₂ Ring SemiRing), - naturality' := (SemiRing.has_limits.limit_cone (F ⋙ forget₂ _ _)).π.naturality, } }, + { app := by apply SemiRing.limit_π_ring_hom (F ⋙ forget₂ Ring SemiRing.{max v u}), + naturality' := + (SemiRing.has_limits.limit_cone (F ⋙ forget₂ Ring SemiRing.{max v u})).π.naturality, } }, valid_lift := by apply is_limit.unique_up_to_iso (SemiRing.has_limits.limit_cone_is_limit _) t, - makes_limit := is_limit.of_faithful (forget₂ Ring SemiRing.{u}) + makes_limit := is_limit.of_faithful (forget₂ Ring SemiRing.{max v u}) (by apply SemiRing.has_limits.limit_cone_is_limit _) (λ s, _) (λ s, rfl) }) @@ -255,68 +284,81 @@ creates_limit_of_reflects_iso (λ c' t, A choice of limit cone for a functor into `Ring`. (Generally, you'll just want to use `limit F`.) -/ -def limit_cone (F : J ⥤ Ring) : cone F := -lift_limit (limit.is_limit (F ⋙ (forget₂ Ring SemiRing.{u}))) +def limit_cone (F : J ⥤ Ring.{max v u}) : cone F := +lift_limit (limit.is_limit (F ⋙ (forget₂ Ring SemiRing.{max v u}))) /-- The chosen cone is a limit cone. (Generally, you'll just want to use `limit.cone F`.) -/ -def limit_cone_is_limit (F : J ⥤ Ring) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ Ring.{max v u}) : is_limit (limit_cone F) := lifted_limit_is_limit _ /-- The category of rings has all limits. -/ @[irreducible] -instance has_limits : has_limits Ring := +instance has_limits_of_size : has_limits_of_size.{v v} Ring.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI - { has_limit := λ F, has_limit_of_created F (forget₂ Ring SemiRing) } } + { has_limit := λ F, has_limit_of_created F (forget₂ Ring SemiRing.{max v u}) } } + +instance has_limits : has_limits Ring.{u} := Ring.has_limits_of_size.{u u} /-- The forgetful functor from rings to semirings preserves all limits. -/ -instance forget₂_SemiRing_preserves_limits : preserves_limits (forget₂ Ring SemiRing) := +instance forget₂_SemiRing_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ Ring SemiRing.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, { preserves_limit := λ F, by apply_instance } } +instance forget₂_SemiRing_preserves_limits : preserves_limits (forget₂ Ring SemiRing.{u}) := +Ring.forget₂_SemiRing_preserves_limits_of_size.{u u} + /-- An auxiliary declaration to speed up typechecking. -/ -def forget₂_AddCommGroup_preserves_limits_aux (F : J ⥤ Ring) : +def forget₂_AddCommGroup_preserves_limits_aux (F : J ⥤ Ring.{max v u}) : is_limit ((forget₂ Ring AddCommGroup).map_cone (limit_cone F)) := -by apply AddCommGroup.limit_cone_is_limit (F ⋙ forget₂ Ring AddCommGroup) +by apply AddCommGroup.limit_cone_is_limit (F ⋙ forget₂ Ring AddCommGroup.{max v u}) /-- The forgetful functor from rings to additive commutative groups preserves all limits. -/ -instance forget₂_AddCommGroup_preserves_limits : preserves_limits (forget₂ Ring AddCommGroup) := +instance forget₂_AddCommGroup_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ Ring AddCommGroup.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (forget₂_AddCommGroup_preserves_limits_aux F) } } +instance forget₂_AddCommGroup_preserves_limits : preserves_limits (forget₂ Ring AddCommGroup.{u}) := +Ring.forget₂_AddCommGroup_preserves_limits_of_size.{u u} + /-- The forgetful functor from rings to types preserves all limits. (That is, the underlying types could have been computed instead as limits in the category of types.) -/ -instance forget_preserves_limits : preserves_limits (forget Ring) := +instance forget_preserves_limits_of_size : preserves_limits_of_size.{v v} (forget Ring.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, - limits.comp_preserves_limit (forget₂ Ring SemiRing) (forget SemiRing) } } + limits.comp_preserves_limit (forget₂ Ring SemiRing) (forget SemiRing.{max v u}) } } + +instance forget_preserves_limits : preserves_limits (forget Ring.{u}) := +Ring.forget_preserves_limits_of_size.{u u} end Ring namespace CommRing -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] -instance comm_ring_obj (F : J ⥤ CommRing) (j) : +instance comm_ring_obj (F : J ⥤ CommRing.{max v u}) (j) : comm_ring ((F ⋙ forget CommRing).obj j) := by { change comm_ring (F.obj j), apply_instance } -instance limit_comm_ring (F : J ⥤ CommRing) : - comm_ring (types.limit_cone (F ⋙ forget CommRing.{u})).X := +instance limit_comm_ring (F : J ⥤ CommRing.{max v u}) : + comm_ring (types.limit_cone (F ⋙ forget CommRing.{max v u})).X := @subring.to_comm_ring (Π j, F.obj j) _ - (Ring.sections_subring (F ⋙ forget₂ CommRing Ring.{u})) + (Ring.sections_subring (F ⋙ forget₂ CommRing Ring.{max v u})) /-- We show that the forgetful functor `CommRing ⥤ Ring` creates limits. @@ -324,7 +366,7 @@ We show that the forgetful functor `CommRing ⥤ Ring` creates limits. All we need to do is notice that the limit point has a `comm_ring` instance available, and then reuse the existing limit. -/ -instance (F : J ⥤ CommRing) : creates_limit F (forget₂ CommRing Ring.{u}) := +instance (F : J ⥤ CommRing.{max v u}) : creates_limit F (forget₂ CommRing Ring.{max v u}) := /- A terse solution here would be ``` @@ -337,65 +379,81 @@ creates_limit_of_reflects_iso (λ c' t, { X := CommRing.of (types.limit_cone (F ⋙ forget _)).X, π := { app := by apply - SemiRing.limit_π_ring_hom (F ⋙ forget₂ CommRing Ring.{u} ⋙ forget₂ Ring SemiRing), + SemiRing.limit_π_ring_hom + (F ⋙ forget₂ CommRing Ring.{max v u} ⋙ forget₂ Ring SemiRing.{max v u}), naturality' := (SemiRing.has_limits.limit_cone - (F ⋙ forget₂ _ Ring.{u} ⋙ forget₂ _ SemiRing)).π.naturality } }, + (F ⋙ forget₂ _ Ring.{max v u} ⋙ forget₂ _ SemiRing.{max v u})).π.naturality } }, valid_lift := by apply is_limit.unique_up_to_iso (Ring.limit_cone_is_limit _) t, - makes_limit := is_limit.of_faithful (forget₂ _ Ring.{u}) - (by apply Ring.limit_cone_is_limit (F ⋙ forget₂ CommRing Ring)) - (λ s, (Ring.limit_cone_is_limit _).lift ((forget₂ _ Ring.{u}).map_cone s)) (λ s, rfl) }) + makes_limit := is_limit.of_faithful (forget₂ _ Ring.{max v u}) + (by apply Ring.limit_cone_is_limit (F ⋙ forget₂ CommRing Ring.{max v u})) + (λ s, (Ring.limit_cone_is_limit _).lift ((forget₂ _ Ring.{max v u}).map_cone s)) (λ s, rfl) }) /-- A choice of limit cone for a functor into `CommRing`. (Generally, you'll just want to use `limit F`.) -/ -def limit_cone (F : J ⥤ CommRing) : cone F := -lift_limit (limit.is_limit (F ⋙ (forget₂ CommRing Ring.{u}))) +def limit_cone (F : J ⥤ CommRing.{max v u}) : cone F := +lift_limit (limit.is_limit (F ⋙ (forget₂ CommRing Ring.{max v u}))) /-- The chosen cone is a limit cone. (Generally, you'll just want to use `limit.cone F`.) -/ -def limit_cone_is_limit (F : J ⥤ CommRing) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ CommRing.{max v u}) : is_limit (limit_cone F) := lifted_limit_is_limit _ /-- The category of commutative rings has all limits. -/ @[irreducible] -instance has_limits : has_limits CommRing.{u} := +instance has_limits_of_size : has_limits_of_size.{v v} CommRing.{max v u} := { has_limits_of_shape := λ J 𝒥, by exactI - { has_limit := λ F, has_limit_of_created F (forget₂ CommRing Ring.{u}) } } + { has_limit := λ F, has_limit_of_created F (forget₂ CommRing Ring.{max v u}) } } + +instance has_limits : has_limits CommRing.{u} := CommRing.has_limits_of_size.{u u} /-- The forgetful functor from commutative rings to rings preserves all limits. (That is, the underlying rings could have been computed instead as limits in the category of rings.) -/ -instance forget₂_Ring_preserves_limits : preserves_limits (forget₂ CommRing Ring) := +instance forget₂_Ring_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ CommRing Ring.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, { preserves_limit := λ F, by apply_instance } } +instance forget₂_Ring_preserves_limits : preserves_limits (forget₂ CommRing Ring.{u}) := +CommRing.forget₂_Ring_preserves_limits_of_size.{u u} + /-- An auxiliary declaration to speed up typechecking. -/ -def forget₂_CommSemiRing_preserves_limits_aux (F : J ⥤ CommRing) : +def forget₂_CommSemiRing_preserves_limits_aux (F : J ⥤ CommRing.{max v u}) : is_limit ((forget₂ CommRing CommSemiRing).map_cone (limit_cone F)) := -by apply CommSemiRing.limit_cone_is_limit (F ⋙ forget₂ CommRing CommSemiRing) +by apply CommSemiRing.limit_cone_is_limit (F ⋙ forget₂ CommRing CommSemiRing.{max v u}) /-- The forgetful functor from commutative rings to commutative semirings preserves all limits. (That is, the underlying commutative semirings could have been computed instead as limits in the category of commutative semirings.) -/ -instance forget₂_CommSemiRing_preserves_limits : preserves_limits (forget₂ CommRing CommSemiRing) := +instance forget₂_CommSemiRing_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget₂ CommRing CommSemiRing.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, preserves_limit_of_preserves_limit_cone (limit_cone_is_limit F) (forget₂_CommSemiRing_preserves_limits_aux F) } } +instance forget₂_CommSemiRing_preserves_limits : + preserves_limits (forget₂ CommRing CommSemiRing.{u}) := +CommRing.forget₂_CommSemiRing_preserves_limits_of_size.{u u} + /-- The forgetful functor from commutative rings to types preserves all limits. (That is, the underlying types could have been computed instead as limits in the category of types.) -/ -instance forget_preserves_limits : preserves_limits (forget CommRing) := +instance forget_preserves_limits_of_size : + preserves_limits_of_size.{v v} (forget CommRing.{max v u}) := { preserves_limits_of_shape := λ J 𝒥, by exactI { preserves_limit := λ F, limits.comp_preserves_limit (forget₂ CommRing Ring) (forget Ring) } } +instance forget_preserves_limits : preserves_limits (forget CommRing.{u}) := +CommRing.forget_preserves_limits_of_size.{u u} + end CommRing diff --git a/src/algebra/category/Semigroup/basic.lean b/src/algebra/category/Semigroup/basic.lean index b1437c0212461..7e8666e59eda3 100644 --- a/src/algebra/category/Semigroup/basic.lean +++ b/src/algebra/category/Semigroup/basic.lean @@ -4,13 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Julian Kuelshammer -/ import algebra.pempty_instances -import algebra.hom.equiv +import algebra.hom.equiv.basic import category_theory.concrete_category.bundled_hom import category_theory.functor.reflects_isomorphisms +import category_theory.elementwise /-! # Category instances for has_mul, has_add, semigroup and add_semigroup +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the bundled categories: * `Magma` * `AddMagma` @@ -156,8 +160,8 @@ namespace category_theory.iso def Magma_iso_to_mul_equiv {X Y : Magma} (i : X ≅ Y) : X ≃* Y := { to_fun := i.hom, inv_fun := i.inv, - left_inv := begin rw function.left_inverse, simp end, - right_inv := begin rw function.right_inverse, rw function.left_inverse, simp end, + left_inv := λ x, by simp, + right_inv := λ y, by simp, map_mul' := by simp } /-- Build a `mul_equiv` from an isomorphism in the category `Semigroup`. -/ @@ -166,8 +170,8 @@ def Magma_iso_to_mul_equiv {X Y : Magma} (i : X ≅ Y) : X ≃* Y := def Semigroup_iso_to_mul_equiv {X Y : Semigroup} (i : X ≅ Y) : X ≃* Y := { to_fun := i.hom, inv_fun := i.inv, - left_inv := begin rw function.left_inverse, simp end, - right_inv := begin rw function.right_inverse, rw function.left_inverse, simp end, + left_inv := λ x, by simp, + right_inv := λ y, by simp, map_mul' := by simp } end category_theory.iso diff --git a/src/algebra/category/fgModule/basic.lean b/src/algebra/category/fgModule/basic.lean new file mode 100644 index 0000000000000..118a4688f6a66 --- /dev/null +++ b/src/algebra/category/fgModule/basic.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2021 Jakob von Raumer. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jakob von Raumer +-/ +import category_theory.monoidal.rigid.basic +import category_theory.monoidal.subcategory +import linear_algebra.coevaluation +import linear_algebra.free_module.finite.matrix +import algebra.category.Module.monoidal.closed + +/-! +# The category of finitely generated modules over a ring + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This introduces `fgModule R`, the category of finitely generated modules over a ring `R`. +It is implemented as a full subcategory on a subtype of `Module R`. + +When `K` is a field, `fgModule K` is the category of finite dimensional vector spaces over `K`. + +We first create the instance as a preadditive category. +When `R` is commutative we then give the structure as an `R`-linear monoidal category. +When `R` is a field we give it the structure of a closed monoidal category +and then as a right-rigid monoidal category. + +## Future work + +* Show that `fgModule R` is abelian when `R` is (left)-noetherian. + +-/ +noncomputable theory + +open category_theory Module.monoidal_category +open_locale classical big_operators + +universes u + + +section ring +variables (R : Type u) [ring R] + +/-- Define `fgModule` as the subtype of `Module.{u} R` of finitely generated modules. -/ +@[derive [large_category, concrete_category, preadditive]] +def fgModule := full_subcategory (λ (V : Module.{u} R), module.finite R V) + +end ring + +namespace fgModule + +section ring +variables (R : Type u) [ring R] + +instance finite (V : fgModule R) : module.finite R V.obj := V.property + +instance : inhabited (fgModule R) := ⟨⟨Module.of R R, module.finite.self R⟩⟩ + +/-- Lift an unbundled finitely generated module to `fgModule R`. -/ +def of (V : Type u) [add_comm_group V] [module R V] [module.finite R V] : fgModule R := +⟨Module.of R V, by { change module.finite R V, apply_instance }⟩ + +instance (V : fgModule R) : module.finite R V.obj := V.property + +instance : has_forget₂ (fgModule.{u} R) (Module.{u} R) := +by { dsimp [fgModule], apply_instance, } + +instance : full (forget₂ (fgModule R) (Module.{u} R)) := +{ preimage := λ X Y f, f, } + +variables {R} + +/-- Converts and isomorphism in the category `fgModule R` to a `linear_equiv` between the underlying +modules. -/ +def iso_to_linear_equiv {V W : fgModule R} (i : V ≅ W) : V.obj ≃ₗ[R] W.obj := + ((forget₂ (fgModule.{u} R) (Module.{u} R)).map_iso i).to_linear_equiv + +/-- Converts a `linear_equiv` to an isomorphism in the category `fgModule R`. -/ +@[simps] def _root_.linear_equiv.to_fgModule_iso + {V W : Type u} [add_comm_group V] [module R V] [module.finite R V] + [add_comm_group W] [module R W] [module.finite R W] + (e : V ≃ₗ[R] W) : + fgModule.of R V ≅ fgModule.of R W := +{ hom := e.to_linear_map, + inv := e.symm.to_linear_map, + hom_inv_id' := by {ext, exact e.left_inv x}, + inv_hom_id' := by {ext, exact e.right_inv x} } + + +end ring + +section comm_ring +variables (R : Type u) [comm_ring R] + +instance : linear R (fgModule R) := by dsimp_result { dsimp [fgModule], apply_instance, } + +instance monoidal_predicate_module_finite : + monoidal_category.monoidal_predicate (λ V : Module.{u} R, module.finite R V) := +{ prop_id' := module.finite.self R, + prop_tensor' := λ X Y hX hY, by exactI module.finite.tensor_product R X Y } + +instance : monoidal_category (fgModule R) := +by dsimp_result { dsimp [fgModule], apply_instance, } +instance : symmetric_category (fgModule R) := +by dsimp_result { dsimp [fgModule], apply_instance, } +instance : monoidal_preadditive (fgModule R) := +by dsimp_result { dsimp [fgModule], apply_instance, } +instance : monoidal_linear R (fgModule R) := +by dsimp_result { dsimp [fgModule], apply_instance, } + +/-- The forgetful functor `fgModule R ⥤ Module R` as a monoidal functor. -/ +def forget₂_monoidal : monoidal_functor (fgModule R) (Module.{u} R) := +monoidal_category.full_monoidal_subcategory_inclusion _ + +instance forget₂_monoidal_faithful : faithful (forget₂_monoidal R).to_functor := +by { dsimp [forget₂_monoidal], apply_instance, } + +instance forget₂_monoidal_additive : (forget₂_monoidal R).to_functor.additive := +by { dsimp [forget₂_monoidal], apply_instance, } + +instance forget₂_monoidal_linear : (forget₂_monoidal R).to_functor.linear R := +by { dsimp [forget₂_monoidal], apply_instance, } + + +lemma iso.conj_eq_conj {V W : fgModule R} (i : V ≅ W) (f : End V) : + iso.conj i f = linear_equiv.conj (iso_to_linear_equiv i) f := rfl + +end comm_ring + +section field +variables (K : Type u) [field K] + +instance (V W : fgModule K) : module.finite K (V ⟶ W) := +(by apply_instance : module.finite K (V.obj →ₗ[K] W.obj)) + +instance closed_predicate_module_finite : + monoidal_category.closed_predicate (λ V : Module.{u} K, module.finite K V) := +{ prop_ihom' := λ X Y hX hY, by exactI @module.finite.linear_map K X Y _ _ _ _ _ _ _ hX hY } + +instance : monoidal_closed (fgModule K) := by dsimp_result { dsimp [fgModule], apply_instance, } + +variables (V W : fgModule K) + +@[simp] lemma ihom_obj : (ihom V).obj W = fgModule.of K (V.obj →ₗ[K] W.obj) := rfl + +/-- The dual module is the dual in the rigid monoidal category `fgModule K`. -/ +def fgModule_dual : fgModule K := +⟨Module.of K (module.dual K V.obj), subspace.module.dual.finite_dimensional⟩ + +open category_theory.monoidal_category + +/-- The coevaluation map is defined in `linear_algebra.coevaluation`. -/ +def fgModule_coevaluation : 𝟙_ (fgModule K) ⟶ V ⊗ (fgModule_dual K V) := +by apply coevaluation K V.obj + +lemma fgModule_coevaluation_apply_one : fgModule_coevaluation K V (1 : K) = + ∑ (i : basis.of_vector_space_index K V.obj), + (basis.of_vector_space K V.obj) i ⊗ₜ[K] (basis.of_vector_space K V.obj).coord i := +by apply coevaluation_apply_one K V.obj + +/-- The evaluation morphism is given by the contraction map. -/ +def fgModule_evaluation : (fgModule_dual K V) ⊗ V ⟶ 𝟙_ (fgModule K) := +by apply contract_left K V.obj + +@[simp] +lemma fgModule_evaluation_apply (f : (fgModule_dual K V).obj) (x : V.obj) : + (fgModule_evaluation K V) (f ⊗ₜ x) = f.to_fun x := +by apply contract_left_apply f x + +private theorem coevaluation_evaluation : + let V' : fgModule K := fgModule_dual K V in + (𝟙 V' ⊗ (fgModule_coevaluation K V)) ≫ (α_ V' V V').inv ≫ (fgModule_evaluation K V ⊗ 𝟙 V') + = (ρ_ V').hom ≫ (λ_ V').inv := +by apply contract_left_assoc_coevaluation K V.obj + +private theorem evaluation_coevaluation : + (fgModule_coevaluation K V ⊗ 𝟙 V) + ≫ (α_ V (fgModule_dual K V) V).hom ≫ (𝟙 V ⊗ fgModule_evaluation K V) + = (λ_ V).hom ≫ (ρ_ V).inv := +by apply contract_left_assoc_coevaluation' K V.obj + +instance exact_pairing : exact_pairing V (fgModule_dual K V) := +{ coevaluation := fgModule_coevaluation K V, + evaluation := fgModule_evaluation K V, + coevaluation_evaluation' := coevaluation_evaluation K V, + evaluation_coevaluation' := evaluation_coevaluation K V } + +instance right_dual : has_right_dual V := ⟨fgModule_dual K V⟩ + +instance right_rigid_category : right_rigid_category (fgModule K) := { } + +end field + +end fgModule diff --git a/src/algebra/category/fgModule/limits.lean b/src/algebra/category/fgModule/limits.lean new file mode 100644 index 0000000000000..6c02caa86c100 --- /dev/null +++ b/src/algebra/category/fgModule/limits.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import algebra.category.fgModule.basic +import algebra.category.Module.limits +import algebra.category.Module.products +import algebra.category.Module.epi_mono +import category_theory.limits.creates +import category_theory.limits.shapes.finite_limits +import category_theory.limits.constructions.limits_of_products_and_equalizers + +/-! +# `forget₂ (fgModule K) (Module K)` creates all finite limits. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +And hence `fgModule K` has all finite limits. + +## Future work +After generalising `fgModule` to allow the ring and the module to live in different universes, +generalize this construction so we can take limits over smaller diagrams, +as is done for the other algebraic categories. + +Analogous constructions for Noetherian modules. +-/ + +noncomputable theory +universes v u + +open category_theory +open category_theory.limits + +namespace fgModule + +variables {J : Type} [small_category J] [fin_category J] +variables {k : Type v} [field k] + +instance {J : Type} [fintype J] (Z : J → Module.{v} k) [∀ j, finite_dimensional k (Z j)] : + finite_dimensional k (∏ λ j, Z j : Module.{v} k) := +begin + haveI : finite_dimensional k (Module.of k (Π j, Z j)), { dsimp, apply_instance, }, + exact finite_dimensional.of_injective + (Module.pi_iso_pi _).hom + ((Module.mono_iff_injective _).1 (by apply_instance)), +end + +/-- Finite limits of finite dimensional vectors spaces are finite dimensional, +because we can realise them as subobjects of a finite product. -/ +instance (F : J ⥤ fgModule k) : + finite_dimensional k (limit (F ⋙ forget₂ (fgModule k) (Module.{v} k)) : Module.{v} k) := +begin + haveI : ∀ j, finite_dimensional k ((F ⋙ forget₂ (fgModule k) (Module.{v} k)).obj j), + { intro j, change finite_dimensional k (F.obj j).obj, apply_instance, }, + exact finite_dimensional.of_injective + (limit_subobject_product (F ⋙ forget₂ (fgModule k) (Module.{v} k))) + ((Module.mono_iff_injective _).1 (by apply_instance)), +end + +/-- The forgetful functor from `fgModule k` to `Module k` creates all finite limits. -/ +def forget₂_creates_limit (F : J ⥤ fgModule k) : + creates_limit F (forget₂ (fgModule k) (Module.{v} k)) := +creates_limit_of_fully_faithful_of_iso + ⟨(limit (F ⋙ forget₂ (fgModule k) (Module.{v} k)) : Module.{v} k), by apply_instance⟩ + (iso.refl _) + +instance : creates_limits_of_shape J (forget₂ (fgModule k) (Module.{v} k)) := +{ creates_limit := λ F, forget₂_creates_limit F, } + +instance : has_finite_limits (fgModule k) := +{ out := λ J _ _, by exactI + has_limits_of_shape_of_has_limits_of_shape_creates_limits_of_shape + (forget₂ (fgModule k) (Module.{v} k)), } + +instance : preserves_finite_limits (forget₂ (fgModule k) (Module.{v} k)) := +{ preserves_finite_limits := λ J _ _, by exactI infer_instance, } + +end fgModule diff --git a/src/algebra/char_p/algebra.lean b/src/algebra/char_p/algebra.lean index 1e7990ab1927b..2273ed60cc6ee 100644 --- a/src/algebra/char_p/algebra.lean +++ b/src/algebra/char_p/algebra.lean @@ -11,6 +11,9 @@ import algebra.free_algebra /-! # Characteristics of algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we describe the characteristic of `R`-algebras. In particular we are interested in the characteristic of free algebras over `R` @@ -41,6 +44,10 @@ lemma char_p_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring rw ring_hom.map_zero, end } +lemma char_p_of_injective_algebra_map' (R A : Type*) [field R] [semiring A] [algebra R A] + [nontrivial A] (p : ℕ) [char_p R p] : char_p A p := +char_p_of_injective_algebra_map (algebra_map R A).injective p + /-- If the algebra map `R →+* A` is injective and `R` has characteristic zero then so does `A`. -/ lemma char_zero_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A] (h : function.injective (algebra_map R A)) [char_zero R] : char_zero A := @@ -54,6 +61,36 @@ lemma char_zero_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiri -- `char_p.char_p_to_char_zero A _ (char_p_of_injective_algebra_map h 0)` does not work -- here as it would require `ring A`. +/-! +As an application, a `ℚ`-algebra has characteristic zero. +-/ +section Q_algebra + +variables (R : Type*) [nontrivial R] + +/-- A nontrivial `ℚ`-algebra has `char_p` equal to zero. + +This cannot be a (local) instance because it would immediately form a loop with the +instance `algebra_rat`. It's probably easier to go the other way: prove `char_zero R` and +automatically receive an `algebra ℚ R` instance. +-/ +lemma algebra_rat.char_p_zero [semiring R] [algebra ℚ R] : char_p R 0 := +char_p_of_injective_algebra_map (algebra_map ℚ R).injective 0 + +/-- A nontrivial `ℚ`-algebra has characteristic zero. + +This cannot be a (local) instance because it would immediately form a loop with the +instance `algebra_rat`. It's probably easier to go the other way: prove `char_zero R` and +automatically receive an `algebra ℚ R` instance. +-/ +lemma algebra_rat.char_zero [ring R] [algebra ℚ R] : char_zero R := +@char_p.char_p_to_char_zero R _ (algebra_rat.char_p_zero R) + +end Q_algebra + +/-! +An algebra over a field has the same characteristic as the field. +-/ section variables (K L : Type*) [field K] [comm_semiring L] [nontrivial L] [algebra K L] @@ -61,6 +98,9 @@ variables (K L : Type*) [field K] [comm_semiring L] [nontrivial L] [algebra K L] lemma algebra.char_p_iff (p : ℕ) : char_p K p ↔ char_p L p := (algebra_map K L).char_p_iff_char_p p +lemma algebra.ring_char_eq : ring_char K = ring_char L := +by { rw [ring_char.eq_iff, algebra.char_p_iff K L], apply ring_char.char_p } + end namespace free_algebra @@ -89,7 +129,7 @@ char_p_of_injective_algebra_map (is_fraction_ring.injective R K) p /-- If `R` has characteristic `0`, then so does Frac(R). -/ lemma char_zero_of_is_fraction_ring [char_zero R] : char_zero K := -@char_p.char_p_to_char_zero K _ _ (char_p_of_is_fraction_ring R 0) +@char_p.char_p_to_char_zero K _ (char_p_of_is_fraction_ring R 0) variables [is_domain R] diff --git a/src/algebra/char_p/basic.lean b/src/algebra/char_p/basic.lean index 096e1bac263fc..194a45351e265 100644 --- a/src/algebra/char_p/basic.lean +++ b/src/algebra/char_p/basic.lean @@ -3,20 +3,84 @@ Copyright (c) 2018 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau, Joey van Langen, Casper Putz -/ - -import algebra.hom.iterate import data.int.modeq -import data.nat.choose.dvd -import data.nat.choose.sum +import data.nat.multiplicity import group_theory.order_of_element import ring_theory.nilpotent + /-! # Characteristic of semirings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v -variables (R : Type u) +open finset +open_locale big_operators + +variables {R : Type*} + +namespace commute +variables [semiring R] {p : ℕ} {x y : R} + +protected lemma add_pow_prime_pow_eq (hp : p.prime) (h : commute x y) (n : ℕ) : + (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n + + p * ∑ k in Ioo 0 (p ^ n), x ^ k * y ^ (p ^ n - k) * ↑((p ^ n).choose k / p) := +begin + transitivity + x ^ p ^ n + y ^ p ^ n + ∑ k in Ioo 0 (p ^ n), x ^ k * y ^ (p ^ n - k) * (p ^ n).choose k, + { simp_rw [h.add_pow, ←nat.Ico_zero_eq_range, nat.Ico_succ_right, Icc_eq_cons_Ico (zero_le _), + finset.sum_cons, Ico_eq_cons_Ioo (pow_pos hp.pos _), finset.sum_cons, tsub_self, tsub_zero, + pow_zero, nat.choose_zero_right, nat.choose_self, nat.cast_one, mul_one, one_mul, + ←add_assoc] }, + { congr' 1, + simp_rw [finset.mul_sum, nat.cast_comm, mul_assoc _ _ (p : R), ←nat.cast_mul], + refine finset.sum_congr rfl (λ i hi, _), + rw mem_Ioo at hi, + rw nat.div_mul_cancel (hp.dvd_choose_pow hi.1.ne' hi.2.ne) }, +end + +protected lemma add_pow_prime_eq (hp : p.prime) (h : commute x y) : + (x + y) ^ p = x ^ p + y ^ p + + p * ∑ k in finset.Ioo 0 p, x ^ k * y ^ (p - k) * ↑(p.choose k / p) := +by simpa using h.add_pow_prime_pow_eq hp 1 + +protected lemma exists_add_pow_prime_pow_eq (hp : p.prime) (h : commute x y) (n : ℕ) : + ∃ r, (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n + p * r := +⟨_, h.add_pow_prime_pow_eq hp n⟩ + +protected lemma exists_add_pow_prime_eq (hp : p.prime) (h : commute x y) : + ∃ r, (x + y) ^ p = x ^ p + y ^ p + p * r := +⟨_, h.add_pow_prime_eq hp⟩ + +end commute + +section comm_semiring +variables [comm_semiring R] {p : ℕ} {x y : R} + +lemma add_pow_prime_pow_eq (hp : p.prime) (x y : R) (n : ℕ) : + (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n + + p * ∑ k in finset.Ioo 0 (p ^ n), x ^ k * y ^ (p ^ n - k) * ↑((p ^ n).choose k / p) := +(commute.all x y).add_pow_prime_pow_eq hp n + +lemma add_pow_prime_eq (hp : p.prime) (x y : R) : + (x + y) ^ p = x ^ p + y ^ p + + p * ∑ k in finset.Ioo 0 p, x ^ k * y ^ (p - k) * ↑(p.choose k / p) := +(commute.all x y).add_pow_prime_eq hp + +lemma exists_add_pow_prime_pow_eq (hp : p.prime) (x y : R) (n : ℕ) : + ∃ r, (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n + p * r := +(commute.all x y).exists_add_pow_prime_pow_eq hp n + +lemma exists_add_pow_prime_eq (hp : p.prime) (x y : R) : + ∃ r, (x + y) ^ p = x ^ p + y ^ p + p * r := +(commute.all x y).exists_add_pow_prime_eq hp + +end comm_semiring + +variables (R) /-- The generator of the kernel of the unique homomorphism ℕ → R for a semiring R. @@ -28,18 +92,23 @@ For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorb `char_zero {0, 1}` does not hold and yet `char_p {0, 1} 0` does. This example is formalized in `counterexamples/char_p_zero_ne_char_zero`. -/ -class char_p [add_monoid R] [has_one R] (p : ℕ) : Prop := +@[mk_iff] +class char_p [add_monoid_with_one R] (p : ℕ) : Prop := (cast_eq_zero_iff [] : ∀ x:ℕ, (x:R) = 0 ↔ p ∣ x) -theorem char_p.cast_eq_zero [add_monoid R] [has_one R] (p : ℕ) [char_p R p] : +@[simp] +theorem char_p.cast_eq_zero [add_monoid_with_one R] (p : ℕ) [char_p R p] : (p:R) = 0 := (char_p.cast_eq_zero_iff R p p).2 (dvd_refl p) -@[simp] lemma char_p.cast_card_eq_zero [add_group R] [has_one R] [fintype R] : +@[simp] lemma char_p.cast_card_eq_zero [add_group_with_one R] [fintype R] : (fintype.card R : R) = 0 := by rw [← nsmul_one, card_nsmul_eq_zero] -lemma char_p.int_cast_eq_zero_iff [add_group R] [has_one R] (p : ℕ) [char_p R p] +lemma char_p.add_order_of_one (R) [semiring R] : char_p R (add_order_of (1 : R)) := +⟨λ n, by rw [← nat.smul_one_eq_coe, add_order_of_dvd_iff_nsmul_eq_zero]⟩ + +lemma char_p.int_cast_eq_zero_iff [add_group_with_one R] (p : ℕ) [char_p R p] (a : ℤ) : (a : R) = 0 ↔ (p:ℤ) ∣ a := begin @@ -52,25 +121,31 @@ begin rw [int.cast_coe_nat, char_p.cast_eq_zero_iff R p, int.coe_nat_dvd] } end -lemma char_p.int_coe_eq_int_coe_iff [add_group R] [has_one R] (p : ℕ) [char_p R p] (a b : ℤ) : - (a : R) = (b : R) ↔ a ≡ b [ZMOD p] := -by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub, - char_p.int_cast_eq_zero_iff R p, int.modeq_iff_dvd] +lemma char_p.int_cast_eq_int_cast [add_group_with_one R] (p : ℕ) [char_p R p] {a b : ℤ} : + (a : R) = b ↔ a ≡ b [ZMOD p] := +by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub, char_p.int_cast_eq_zero_iff R p, int.modeq_iff_dvd] -theorem char_p.eq [add_monoid R] [has_one R] {p q : ℕ} (c1 : char_p R p) (c2 : char_p R q) : +lemma char_p.nat_cast_eq_nat_cast [add_group_with_one R] (p : ℕ) [char_p R p] {a b : ℕ} : + (a : R) = b ↔ a ≡ b [MOD p] := +begin + rw [←int.cast_coe_nat, ←int.cast_coe_nat b], + exact (char_p.int_cast_eq_int_cast _ _).trans int.coe_nat_modeq_iff, +end + +theorem char_p.eq [add_monoid_with_one R] {p q : ℕ} (c1 : char_p R p) (c2 : char_p R q) : p = q := nat.dvd_antisymm ((char_p.cast_eq_zero_iff R p q).1 (char_p.cast_eq_zero _ _)) ((char_p.cast_eq_zero_iff R q p).1 (char_p.cast_eq_zero _ _)) -instance char_p.of_char_zero [add_monoid R] [has_one R] [char_zero R] : char_p R 0 := +instance char_p.of_char_zero [add_monoid_with_one R] [char_zero R] : char_p R 0 := ⟨λ x, by rw [zero_dvd_iff, ← nat.cast_zero, nat.cast_inj]⟩ theorem char_p.exists [non_assoc_semiring R] : ∃ p, char_p R p := by letI := classical.dec_eq R; exact classical.by_cases (assume H : ∀ p:ℕ, (p:R) = 0 → p = 0, ⟨0, - ⟨λ x, by rw [zero_dvd_iff]; exact ⟨H x, by rintro rfl; refl⟩⟩⟩) + ⟨λ x, by rw [zero_dvd_iff]; exact ⟨H x, by rintro rfl; simp⟩⟩⟩) (λ H, ⟨nat.find (not_forall.1 H), ⟨λ x, ⟨λ H1, nat.dvd_of_mod_eq_zero (by_contradiction $ λ H2, nat.find_min (not_forall.1 H) @@ -86,7 +161,7 @@ classical.by_cases theorem char_p.exists_unique [non_assoc_semiring R] : ∃! p, char_p R p := let ⟨c, H⟩ := char_p.exists R in ⟨c, H, λ y H2, char_p.eq R H2 H⟩ -theorem char_p.congr {R : Type u} [add_monoid R] [has_one R] {p : ℕ} (q : ℕ) [hq : char_p R q] +theorem char_p.congr {R : Type u} [add_monoid_with_one R] {p : ℕ} (q : ℕ) [hq : char_p R q] (h : q = p) : char_p R p := h ▸ hq @@ -122,35 +197,21 @@ theorem dvd {x : ℕ} (hx : (x : R) = 0) : ring_char R ∣ x := @[simp] lemma eq_zero [char_zero R] : ring_char R = 0 := eq R 0 +@[simp] +lemma nat.cast_ring_char : (ring_char R : R) = 0 := +by rw ring_char.spec + end ring_char -theorem add_pow_char_of_commute [semiring R] {p : ℕ} [fact p.prime] +theorem add_pow_char_of_commute [semiring R] {p : ℕ} [hp : fact p.prime] [char_p R p] (x y : R) (h : commute x y) : (x + y)^p = x^p + y^p := -begin - rw [commute.add_pow h, finset.sum_range_succ_comm, tsub_self, pow_zero, nat.choose_self], - rw [nat.cast_one, mul_one, mul_one], congr' 1, - convert finset.sum_eq_single 0 _ _, - { simp only [mul_one, one_mul, nat.choose_zero_right, tsub_zero, nat.cast_one, pow_zero] }, - { intros b h1 h2, - suffices : (p.choose b : R) = 0, { rw this, simp }, - rw char_p.cast_eq_zero_iff R p, - refine nat.prime.dvd_choose_self (pos_iff_ne_zero.mpr h2) _ (fact.out _), - rwa ← finset.mem_range }, - { intro h1, - contrapose! h1, - rw finset.mem_range, - exact nat.prime.pos (fact.out _) } -end +let ⟨r, hr⟩ := h.exists_add_pow_prime_eq hp.out in by simp [hr] -theorem add_pow_char_pow_of_commute [semiring R] {p : ℕ} [fact p.prime] - [char_p R p] {n : ℕ} (x y : R) (h : commute x y) : +theorem add_pow_char_pow_of_commute [semiring R] {p n : ℕ} [hp : fact p.prime] [char_p R p] + (x y : R) (h : commute x y) : (x + y) ^ (p ^ n) = x ^ (p ^ n) + y ^ (p ^ n) := -begin - induction n, { simp, }, - rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih], - apply add_pow_char_of_commute, apply commute.pow_pow h, -end +let ⟨r, hr⟩ := h.exists_add_pow_prime_pow_eq hp.out n in by simp [hr] theorem sub_pow_char_of_commute [ring R] {p : ℕ} [fact p.prime] [char_p R p] (x y : R) (h : commute x y) : @@ -187,11 +248,6 @@ theorem sub_pow_char_pow [comm_ring R] {p : ℕ} [fact p.prime] (x - y) ^ (p ^ n) = x ^ (p ^ n) - y ^ (p ^ n) := sub_pow_char_pow_of_commute _ _ _ (commute.all _ _) -lemma eq_iff_modeq_int [ring R] (p : ℕ) [char_p R p] (a b : ℤ) : - (a : R) = b ↔ a ≡ b [ZMOD p] := -by rw [eq_comm, ←sub_eq_zero, ←int.cast_sub, - char_p.int_cast_eq_zero_iff R p, int.modeq_iff_dvd] - lemma char_p.neg_one_ne_one [ring R] (p : ℕ) [char_p R p] [fact (2 < p)] : (-1 : R) ≠ (1 : R) := begin @@ -223,11 +279,7 @@ end lemma ring_hom.char_p_iff_char_p {K L : Type*} [division_ring K] [semiring L] [nontrivial L] (f : K →+* L) (p : ℕ) : char_p K p ↔ char_p L p := -begin - split; - { introI _c, constructor, intro n, - rw [← @char_p.cast_eq_zero_iff _ _ _ p _c n, ← f.injective.eq_iff, map_nat_cast f, f.map_zero] } -end +by simp only [char_p_iff, ← f.injective.eq_iff, map_nat_cast f, f.map_zero] section frobenius @@ -324,12 +376,19 @@ theorem frobenius_inj [comm_ring R] [is_reduced R] function.injective (frobenius R p) := λ x h H, by { rw ← sub_eq_zero at H ⊢, rw ← frobenius_sub at H, exact is_reduced.eq_zero _ ⟨_,H⟩ } +/-- If `ring_char R = 2`, where `R` is a finite reduced commutative ring, +then every `a : R` is a square. -/ +lemma is_square_of_char_two' {R : Type*} [finite R] [comm_ring R] [is_reduced R] [char_p R 2] + (a : R) : is_square a := +by { casesI nonempty_fintype R, exact exists_imp_exists (λ b h, pow_two b ▸ eq.symm h) + (((fintype.bijective_iff_injective_and_card _).mpr ⟨frobenius_inj R 2, rfl⟩).surjective a) } + namespace char_p section -variables [ring R] +variables [non_assoc_ring R] -lemma char_p_to_char_zero (R : Type*) [add_left_cancel_monoid R] [has_one R] [char_p R 0] : +lemma char_p_to_char_zero (R : Type*) [add_group_with_one R] [char_p R 0] : char_zero R := char_zero_of_inj_zero $ λ n h0, eq_zero_of_zero_dvd ((cast_eq_zero_iff R 0 n).mp h0) @@ -338,13 +397,39 @@ lemma cast_eq_mod (p : ℕ) [char_p R p] (k : ℕ) : (k : R) = (k % p : ℕ) := calc (k : R) = ↑(k % p + p * (k / p)) : by rw [nat.mod_add_div] ... = ↑(k % p) : by simp [cast_eq_zero] -theorem char_ne_zero_of_fintype (p : ℕ) [hc : char_p R p] [fintype R] : p ≠ 0 := -assume h : p = 0, -have char_zero R := @char_p_to_char_zero R _ _ (h ▸ hc), -absurd (@nat.cast_injective R _ _ this) (not_injective_infinite_fintype coe) +/-- The characteristic of a finite ring cannot be zero. -/ +theorem char_ne_zero_of_finite (p : ℕ) [char_p R p] [finite R] : p ≠ 0 := +begin + unfreezingI { rintro rfl }, + haveI : char_zero R := char_p_to_char_zero R, + casesI nonempty_fintype R, + exact absurd nat.cast_injective (not_injective_infinite_finite (coe : ℕ → R)) +end + +lemma ring_char_ne_zero_of_finite [finite R] : ring_char R ≠ 0 := +char_ne_zero_of_finite R (ring_char R) end +section comm_ring + +variables [comm_ring R] [is_reduced R] {R} + +@[simp] +lemma pow_prime_pow_mul_eq_one_iff (p k m : ℕ) [fact p.prime] + [char_p R p] (x : R) : + x ^ (p ^ k * m) = 1 ↔ x ^ m = 1 := +begin + induction k with k hk, + { rw [pow_zero, one_mul] }, + { refine ⟨λ h, _, λ h, _⟩, + { rw [pow_succ, mul_assoc, pow_mul', ← frobenius_def, ← frobenius_one p] at h, + exact hk.1 (frobenius_inj R p h) }, + { rw [pow_mul', h, one_pow] } } +end + +end comm_ring + section semiring open nat @@ -373,9 +458,9 @@ or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this) have p ∣ e, from (cast_eq_zero_iff R p e).mp he, have e ∣ p, from dvd_of_mul_left_eq d (eq.symm hmul), have e = p, from dvd_antisymm ‹e ∣ p› ‹p ∣ e›, - have h₀ : p > 0, from gt_of_ge_of_gt hp (nat.zero_lt_succ 1), + have h₀ : 0 < p, from two_pos.trans_le hp, have d * p = 1 * p, by rw ‹e = p› at hmul; rw [one_mul]; exact eq.symm hmul, - show d = 1 ∨ d = p, from or.inl (eq_of_mul_eq_mul_right h₀ this)) + show d = 1 ∨ d = p, from or.inl (mul_right_cancel₀ h₀.ne' this)) section nontrivial @@ -388,8 +473,8 @@ match p, hc with | (m+2), hc := or.inl (@char_is_prime_of_two_le R _ _ (m+2) hc (nat.le_add_left 2 m)) end -lemma char_is_prime_of_pos (p : ℕ) [h : fact (0 < p)] [char_p R p] : fact p.prime := -⟨(char_p.char_is_prime_or_zero R _).resolve_right (pos_iff_ne_zero.1 h.1)⟩ +lemma char_is_prime_of_pos (p : ℕ) [ne_zero p] [char_p R p] : fact p.prime := +⟨(char_p.char_is_prime_or_zero R _).resolve_right $ ne_zero.ne p⟩ end nontrivial @@ -399,11 +484,11 @@ end semiring section ring -variables (R) [ring R] [no_zero_divisors R] [nontrivial R] [fintype R] +variables (R) [ring R] [no_zero_divisors R] [nontrivial R] [finite R] theorem char_is_prime (p : ℕ) [char_p R p] : p.prime := -or.resolve_right (char_is_prime_or_zero R p) (char_ne_zero_of_fintype R p) +or.resolve_right (char_is_prime_or_zero R p) (char_ne_zero_of_finite R p) end ring @@ -426,7 +511,7 @@ lemma false_of_nontrivial_of_char_one [nontrivial R] [char_p R 1] : false := false_of_nontrivial_of_subsingleton R lemma ring_char_ne_one [nontrivial R] : ring_char R ≠ 1 := -by { intros h, apply @zero_ne_one R, symmetry, rw [←nat.cast_one, ring_char.spec, h], } +by { intros h, apply zero_ne_one' R, symmetry, rw [←nat.cast_one, ring_char.spec, h], } lemma nontrivial_of_char_ne_one {v : ℕ} (hv : v ≠ 1) [hr : char_p R v] : nontrivial R := @@ -442,7 +527,36 @@ end char_p section -variables (R) [comm_ring R] [fintype R] (n : ℕ) +/-- We have `2 ≠ 0` in a nontrivial ring whose characteristic is not `2`. -/ +@[protected] +lemma ring.two_ne_zero {R : Type*} [non_assoc_semiring R] [nontrivial R] (hR : ring_char R ≠ 2) : + (2 : R) ≠ 0 := +begin + rw [ne.def, (by norm_cast : (2 : R) = (2 : ℕ)), ring_char.spec, nat.dvd_prime nat.prime_two], + exact mt (or_iff_left hR).mp char_p.ring_char_ne_one, +end + +/-- Characteristic `≠ 2` and nontrivial implies that `-1 ≠ 1`. -/ +-- We have `char_p.neg_one_ne_one`, which assumes `[ring R] (p : ℕ) [char_p R p] [fact (2 < p)]`. +-- This is a version using `ring_char` instead. +lemma ring.neg_one_ne_one_of_char_ne_two {R : Type*} [non_assoc_ring R] [nontrivial R] + (hR : ring_char R ≠ 2) : + (-1 : R) ≠ 1 := +λ h, ring.two_ne_zero hR (neg_eq_iff_add_eq_zero.mp h) + +/-- Characteristic `≠ 2` in a domain implies that `-a = a` iff `a = 0`. -/ +lemma ring.eq_self_iff_eq_zero_of_char_ne_two {R : Type*} [non_assoc_ring R] [nontrivial R] + [no_zero_divisors R] (hR : ring_char R ≠ 2) {a : R} : + -a = a ↔ a = 0 := +⟨λ h, (mul_eq_zero.mp $ (two_mul a).trans $ neg_eq_iff_add_eq_zero.mp h).resolve_left + (ring.two_ne_zero hR), + λ h, ((congr_arg (λ x, - x) h).trans neg_zero).trans h.symm⟩ + +end + +section + +variables (R) [non_assoc_ring R] [fintype R] (n : ℕ) lemma char_p_of_ne_zero (hn : fintype.card R = n) (hR : ∀ i < n, (i : R) = 0 → i = 0) : char_p R n := @@ -460,7 +574,7 @@ lemma char_p_of_ne_zero (hn : fintype.card R = n) (hR : ∀ i < n, (i : R) = 0 { rintro ⟨k, rfl⟩, rw [nat.cast_mul, H, zero_mul] } end } -lemma char_p_of_prime_pow_injective (p : ℕ) [hp : fact p.prime] (n : ℕ) +lemma char_p_of_prime_pow_injective (R) [ring R] [fintype R] (p : ℕ) [hp : fact p.prime] (n : ℕ) (hn : fintype.card R = p ^ n) (hR : ∀ i ≤ n, (p ^ i : R) = 0 → i = n) : char_p R (p ^ n) := begin @@ -477,7 +591,7 @@ end section prod -variables (S : Type v) [semiring R] [semiring S] (p q : ℕ) [char_p R p] +variables (S : Type v) [add_monoid_with_one R] [add_monoid_with_one S] (p q : ℕ) [char_p R p] /-- The characteristic of the product of rings is the least common multiple of the characteristics of the two rings. -/ @@ -492,3 +606,50 @@ instance prod.char_p [char_p S p] : char_p (R × S) p := by convert nat.lcm.char_p R S p p; simp end prod + +instance ulift.char_p [add_monoid_with_one R] (p : ℕ) [char_p R p] : char_p (ulift.{v} R) p := +{ cast_eq_zero_iff := λ n, iff.trans (ulift.ext_iff _ _) $ char_p.cast_eq_zero_iff R p n } + +instance mul_opposite.char_p [add_monoid_with_one R] (p : ℕ) [char_p R p] : char_p (Rᵐᵒᵖ) p := +{ cast_eq_zero_iff := λ n, mul_opposite.unop_inj.symm.trans $ char_p.cast_eq_zero_iff R p n } + +section + +/-- If two integers from `{0, 1, -1}` result in equal elements in a ring `R` +that is nontrivial and of characteristic not `2`, then they are equal. -/ +lemma int.cast_inj_on_of_ring_char_ne_two {R : Type*} [non_assoc_ring R] [nontrivial R] + (hR : ring_char R ≠ 2) : + ({0, 1, -1} : set ℤ).inj_on (coe : ℤ → R) := +begin + intros a ha b hb h, + apply eq_of_sub_eq_zero, + by_contra hf, + change a = 0 ∨ a = 1 ∨ a = -1 at ha, + change b = 0 ∨ b = 1 ∨ b = -1 at hb, + have hh : a - b = 1 ∨ b - a = 1 ∨ a - b = 2 ∨ b - a = 2 := by + { rcases ha with ha | ha | ha; rcases hb with hb | hb | hb, + swap 5, swap 9, -- move goals with `a = b` to the front + iterate 3 { rw [ha, hb, sub_self] at hf, tauto, }, -- 6 goals remain + all_goals { rw [ha, hb], norm_num, }, }, + have h' : ((a - b : ℤ) : R) = 0 := by exact_mod_cast sub_eq_zero_of_eq h, + have h'' : ((b - a : ℤ) : R) = 0 := by exact_mod_cast sub_eq_zero_of_eq h.symm, + rcases hh with hh | hh | hh | hh, + { rw [hh, (by norm_cast : ((1 : ℤ) : R) = 1)] at h', exact one_ne_zero h', }, + { rw [hh, (by norm_cast : ((1 : ℤ) : R) = 1)] at h'', exact one_ne_zero h'', }, + { rw [hh, (by norm_cast : ((2 : ℤ) : R) = 2)] at h', exact ring.two_ne_zero hR h', }, + { rw [hh, (by norm_cast : ((2 : ℤ) : R) = 2)] at h'', exact ring.two_ne_zero hR h'', }, +end + +end + +namespace ne_zero + +variables (R) [add_monoid_with_one R] {r : R} {n p : ℕ} {a : ℕ+} + +lemma of_not_dvd [char_p R p] (h : ¬ p ∣ n) : ne_zero (n : R) := +⟨(char_p.cast_eq_zero_iff R p n).not.mpr h⟩ + +lemma not_char_dvd (p : ℕ) [char_p R p] (k : ℕ) [h : ne_zero (k : R)] : ¬ p ∣ k := +by rwa [←char_p.cast_eq_zero_iff R p k, ←ne.def, ←ne_zero_iff] + +end ne_zero diff --git a/src/algebra/char_p/char_and_card.lean b/src/algebra/char_p/char_and_card.lean new file mode 100644 index 0000000000000..52b303e3667de --- /dev/null +++ b/src/algebra/char_p/char_and_card.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2022 Michael Stoll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Michael Stoll +-/ +import algebra.char_p.basic +import group_theory.perm.cycle.type + +/-! +# Characteristic and cardinality + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We prove some results relating characteristic and cardinality of finite rings + +## Tags +characterstic, cardinality, ring +-/ + +/-- A prime `p` is a unit in a commutative ring `R` of nonzero characterstic iff it does not divide +the characteristic. -/ +lemma is_unit_iff_not_dvd_char_of_ring_char_ne_zero (R : Type*) [comm_ring R] (p : ℕ) [fact p.prime] + (hR : ring_char R ≠ 0) : + is_unit (p : R) ↔ ¬ p ∣ ring_char R := +begin + have hch := char_p.cast_eq_zero R (ring_char R), + have hp : p.prime := fact.out p.prime, + split, + { rintros h₁ ⟨q, hq⟩, + rcases is_unit.exists_left_inv h₁ with ⟨a, ha⟩, + have h₃ : ¬ ring_char R ∣ q := + begin + rintro ⟨r, hr⟩, + rw [hr, ← mul_assoc, mul_comm p, mul_assoc] at hq, + nth_rewrite 0 ← mul_one (ring_char R) at hq, + exact nat.prime.not_dvd_one hp ⟨r, mul_left_cancel₀ hR hq⟩, + end, + have h₄ := mt (char_p.int_cast_eq_zero_iff R (ring_char R) q).mp, + apply_fun (coe : ℕ → R) at hq, + apply_fun ((*) a) at hq, + rw [nat.cast_mul, hch, mul_zero, ← mul_assoc, ha, one_mul] at hq, + norm_cast at h₄, + exact h₄ h₃ hq.symm, }, + { intro h, + rcases (hp.coprime_iff_not_dvd.mpr h).is_coprime with ⟨a, b, hab⟩, + apply_fun (coe : ℤ → R) at hab, + push_cast at hab, + rw [hch, mul_zero, add_zero, mul_comm] at hab, + exact is_unit_of_mul_eq_one (p : R) a hab, }, +end + +/-- A prime `p` is a unit in a finite commutative ring `R` +iff it does not divide the characteristic. -/ +lemma is_unit_iff_not_dvd_char (R : Type*) [comm_ring R] (p : ℕ) [fact p.prime] [finite R] : + is_unit (p : R) ↔ ¬ p ∣ ring_char R := +is_unit_iff_not_dvd_char_of_ring_char_ne_zero R p $ char_p.char_ne_zero_of_finite R (ring_char R) + +/-- The prime divisors of the characteristic of a finite commutative ring are exactly +the prime divisors of its cardinality. -/ +lemma prime_dvd_char_iff_dvd_card {R : Type*} [comm_ring R] [fintype R] (p : ℕ) [fact p.prime] : + p ∣ ring_char R ↔ p ∣ fintype.card R := +begin + refine ⟨λ h, h.trans $ int.coe_nat_dvd.mp $ (char_p.int_cast_eq_zero_iff R (ring_char R) + (fintype.card R)).mp $ by exact_mod_cast char_p.cast_card_eq_zero R, λ h, _⟩, + by_contra h₀, + rcases exists_prime_add_order_of_dvd_card p h with ⟨r, hr⟩, + have hr₁ := add_order_of_nsmul_eq_zero r, + rw [hr, nsmul_eq_mul] at hr₁, + rcases is_unit.exists_left_inv ((is_unit_iff_not_dvd_char R p).mpr h₀) with ⟨u, hu⟩, + apply_fun ((*) u) at hr₁, + rw [mul_zero, ← mul_assoc, hu, one_mul] at hr₁, + exact mt add_monoid.order_of_eq_one_iff.mpr + (ne_of_eq_of_ne hr (nat.prime.ne_one (fact.out p.prime))) hr₁, +end + +/-- A prime that does not divide the cardinality of a finite commutative ring `R` +is a unit in `R`. -/ +lemma not_is_unit_prime_of_dvd_card {R : Type*} [comm_ring R] [fintype R] (p : ℕ) [fact p.prime] + (hp : p ∣ fintype.card R) : ¬ is_unit (p : R) := +mt (is_unit_iff_not_dvd_char R p).mp (not_not.mpr ((prime_dvd_char_iff_dvd_card p).mpr hp)) diff --git a/src/algebra/char_p/default.lean b/src/algebra/char_p/default.lean deleted file mode 100644 index f0898fa6bdf41..0000000000000 --- a/src/algebra/char_p/default.lean +++ /dev/null @@ -1,5 +0,0 @@ -import algebra.char_p.algebra -import algebra.char_p.basic -import algebra.char_p.pi -import algebra.char_p.quotient -import algebra.char_p.subring diff --git a/src/algebra/char_p/exp_char.lean b/src/algebra/char_p/exp_char.lean index ca92707f24545..86273305cea30 100644 --- a/src/algebra/char_p/exp_char.lean +++ b/src/algebra/char_p/exp_char.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jakob Scholbach -/ import algebra.char_p.basic -import algebra.char_zero import data.nat.prime /-! # Exponential characteristic +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the exponential characteristic and establishes a few basic results relating it to the (ordinary characteristic). The definition is stated for a semiring, but the actual results are for nontrivial rings diff --git a/src/algebra/char_p/invertible.lean b/src/algebra/char_p/invertible.lean index e54ec5996ea8b..4b265c9f7f510 100644 --- a/src/algebra/char_p/invertible.lean +++ b/src/algebra/char_p/invertible.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ import algebra.invertible -import algebra.field.basic import algebra.char_p.basic /-! # Invertibility of elements given a characteristic +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file includes some instances of `invertible` for specific numbers in characteristic zero. Some more cases are given as a `def`, to be included only when needed. To construct instances for concrete numbers, @@ -40,9 +42,10 @@ def invertible_of_char_p_not_dvd {p : ℕ} [char_p K p] {t : ℕ} (not_dvd : ¬(p ∣ t)) : invertible (t : K) := invertible_of_nonzero (λ h, not_dvd ((char_p.cast_eq_zero_iff K p t).mp h)) -instance invertible_of_pos [char_zero K] (n : ℕ) [h : fact (0 < n)] : - invertible (n : K) := -invertible_of_nonzero $ by simpa [pos_iff_ne_zero] using h.out +-- warning: this could potentially loop with `ne_zero.invertible` - if there is weird type-class +-- loops, watch out for that. +instance invertible_of_pos [char_zero K] (n : ℕ) [ne_zero n] : invertible (n : K) := +invertible_of_nonzero $ ne_zero.out end field diff --git a/src/algebra/char_p/local_ring.lean b/src/algebra/char_p/local_ring.lean new file mode 100644 index 0000000000000..1d284e6a341d9 --- /dev/null +++ b/src/algebra/char_p/local_ring.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2022 Jon Eugster. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jon Eugster +-/ +import algebra.char_p.basic +import ring_theory.ideal.local_ring +import algebra.is_prime_pow +import data.nat.factorization.basic + +/-! +# Characteristics of local rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main result + +- `char_p_zero_or_prime_power`: In a commutative local ring the characteristics is either + zero or a prime power. + +-/ + +/-- In a local ring the characteristics is either zero or a prime power. -/ +theorem char_p_zero_or_prime_power (R : Type*) [comm_ring R] [local_ring R] (q : ℕ) + [char_R_q : char_p R q] : q = 0 ∨ is_prime_pow q := +begin + /- Assume `q := char(R)` is not zero. -/ + apply or_iff_not_imp_left.2, + intro q_pos, + let K := local_ring.residue_field R, + haveI RM_char := ring_char.char_p K, + + let r := ring_char K, + let n := (q.factorization) r, + /- `r := char(R/m)` is either prime or zero: -/ + cases char_p.char_is_prime_or_zero K r with r_prime r_zero, + { let a := q / (r ^ n), + /- If `r` is prime, we can write it as `r = a * q^n` ... -/ + have q_eq_a_mul_rn : q = r ^ n * a := by rw nat.mul_div_cancel' (nat.ord_proj_dvd q r), + have r_ne_dvd_a := nat.not_dvd_ord_compl r_prime q_pos, + + have rn_dvd_q: r ^ n ∣ q := ⟨a, q_eq_a_mul_rn⟩, + rw mul_comm at q_eq_a_mul_rn, + have a_dvd_q : a ∣ q := ⟨r ^ n, q_eq_a_mul_rn⟩, + /- ... where `a` is a unit. -/ + have a_unit : is_unit (a : R) := + begin + by_contradiction g, + rw ←mem_nonunits_iff at g, + rw ←local_ring.mem_maximal_ideal at g, + have a_cast_zero := (ideal.quotient.eq_zero_iff_mem).2 g, + rw map_nat_cast at a_cast_zero, + have r_dvd_a := (ring_char.spec K a).1 a_cast_zero, + exact absurd r_dvd_a r_ne_dvd_a, + end, + /- Let `b` be the inverse of `a`. -/ + cases a_unit.exists_left_inv with a_inv h_inv_mul_a, + have rn_cast_zero : ↑(r ^ n) = (0 : R) := + begin + rw [nat.cast_pow, ←@mul_one R _ (r ^ n), mul_comm, + ←(classical.some_spec a_unit.exists_left_inv), mul_assoc, ←nat.cast_pow, ←nat.cast_mul, + ←q_eq_a_mul_rn, char_p.cast_eq_zero R q], + simp, + end, + have q_eq_rn := nat.dvd_antisymm ((char_p.cast_eq_zero_iff R q (r ^ n)).mp rn_cast_zero) + rn_dvd_q, + have n_pos : n ≠ 0, + from λ n_zero, absurd (by simpa [n_zero] using q_eq_rn) (char_p.char_ne_one R q), + + /- Definition of prime power: `∃ r n, prime r ∧ 0 < n ∧ r ^ n = q`. -/ + exact ⟨r, ⟨n, ⟨r_prime.prime, ⟨pos_iff_ne_zero.mpr n_pos, q_eq_rn.symm⟩⟩⟩⟩}, + { haveI K_char_p_0 := ring_char.of_eq r_zero, + haveI K_char_zero: char_zero K := char_p.char_p_to_char_zero K, + haveI R_char_zero := ring_hom.char_zero (local_ring.residue R), + /- Finally, `r = 0` would lead to a contradiction: -/ + have q_zero := char_p.eq R char_R_q (char_p.of_char_zero R), + exact absurd q_zero q_pos} +end diff --git a/src/algebra/char_p/mixed_char_zero.lean b/src/algebra/char_p/mixed_char_zero.lean new file mode 100644 index 0000000000000..0c17a7d83dc45 --- /dev/null +++ b/src/algebra/char_p/mixed_char_zero.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2022 Jon Eugster. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jon Eugster +-/ +import algebra.char_p.algebra +import algebra.char_p.local_ring +import ring_theory.ideal.quotient +import tactic.field_simp + +/-! +# Equal and mixed characteristic + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In commutative algebra, some statments are simpler when working over a `ℚ`-algebra `R`, in which +case one also says that the ring has "equal characteristic zero". A ring that is not a +`ℚ`-algebra has either positive characteristic or there exists a prime ideal `I ⊂ R` such that +the quotient `R ⧸ I` has positive characteristic `p > 0`. In this case one speaks of +"mixed characteristic `(0, p)`", where `p` is only unique if `R` is local. + +Examples of mixed characteristic rings are `ℤ` or the `p`-adic integers/numbers. + +This file provides the main theorem `split_by_characteristic` that splits any proposition `P` into +the following three cases: + +1) Positive characteristic: `char_p R p` (where `p ≠ 0`) +2) Equal characteristic zero: `algebra ℚ R` +3) Mixed characteristic: `mixed_char_zero R p` (where `p` is prime) + +## Main definitions + +- `mixed_char_zero` : A ring has mixed characteristic `(0, p)` if it has characteristic zero + and there exists an ideal such that the quotient `R ⧸ I` has characteristic `p`. + +## Main results + +- `split_equal_mixed_char` : Split a statement into equal/mixed characteristic zero. + +This main theorem has the following three corollaries which include the positive +characteristic case for convenience: + +- `split_by_characteristic` : Generally consider positive char `p ≠ 0`. +- `split_by_characteristic_domain` : In a domain we can assume that `p` is prime. +- `split_by_characteristic_local_ring` : In a local ring we can assume that `p` is a prime power. + +## TODO + +- Relate mixed characteristic in a local ring to p-adic numbers [number_theory.padics]. + +-/ + +variables (R : Type*) [comm_ring R] + +/-! +### Mixed characteristic +-/ + +/-- +A ring of characteristic zero is of "mixed characteristic `(0, p)`" if there exists an ideal +such that the quotient `R ⧸ I` has caracteristic `p`. + +**Remark:** For `p = 0`, `mixed_char R 0` is a meaningless definition as `R ⧸ ⊥ ≅ R` has by +definition always characteristic zero. +One could require `(I ≠ ⊥)` in the definition, but then `mixed_char R 0` would mean something +like `ℤ`-algebra of extension degree `≥ 1` and would be completely independent from +whether something is a `ℚ`-algebra or not (e.g. `ℚ[X]` would satisfy it but `ℚ` wouldn't). +-/ +class mixed_char_zero (p : ℕ) : Prop := +[to_char_zero : char_zero R] +(char_p_quotient : ∃ (I : ideal R), (I ≠ ⊤) ∧ char_p (R ⧸ I) p) + +namespace mixed_char_zero + +/-- +Reduction to `p` prime: When proving any statement `P` about mixed characteristic rings we +can always assume that `p` is prime. +-/ +lemma reduce_to_p_prime {P : Prop} : + (∀ p > 0, mixed_char_zero R p → P) ↔ + (∀ (p : ℕ), p.prime → mixed_char_zero R p → P) := +begin + split, + { intros h q q_prime q_mixed_char, + exact h q (nat.prime.pos q_prime) q_mixed_char }, + { intros h q q_pos q_mixed_char, + rcases q_mixed_char.char_p_quotient with ⟨I, hI_ne_top, hI_char⟩, + + -- Krull's Thm: There exists a prime ideal `P` such that `I ≤ P` + rcases ideal.exists_le_maximal I hI_ne_top with ⟨M, hM_max, h_IM⟩, + resetI, -- make `hI_char : char_p (R ⧸ I) q` an instance. + + let r := ring_char (R ⧸ M), + have r_pos : r ≠ 0, + { have q_zero := congr_arg (ideal.quotient.factor I M h_IM) (char_p.cast_eq_zero (R ⧸ I) q), + simp only [map_nat_cast, map_zero] at q_zero, + apply ne_zero_of_dvd_ne_zero (ne_of_gt q_pos), + exact (char_p.cast_eq_zero_iff (R ⧸ M) r q).mp q_zero }, + have r_prime : nat.prime r := + or_iff_not_imp_right.1 (char_p.char_is_prime_or_zero (R ⧸ M) r) r_pos, + apply h r r_prime, + haveI : char_zero R := q_mixed_char.to_char_zero, + exact ⟨⟨M, hM_max.ne_top, ring_char.of_eq rfl⟩⟩ } +end + +/-- +Reduction to `I` prime ideal: When proving statements about mixed characteristic rings, +after we reduced to `p` prime, we can assume that the ideal `I` in the definition is maximal. +-/ +lemma reduce_to_maximal_ideal {p : ℕ} (hp : nat.prime p) : + (∃ (I : ideal R), (I ≠ ⊤) ∧ char_p (R ⧸ I) p) ↔ + (∃ (I : ideal R), (I.is_maximal) ∧ char_p (R ⧸ I) p) := +begin + split, + { intro g, + rcases g with ⟨I, ⟨hI_not_top, hI⟩⟩, + + -- Krull's Thm: There exists a prime ideal `M` such that `I ≤ M`. + rcases ideal.exists_le_maximal I hI_not_top with ⟨M, ⟨hM_max, hM⟩⟩, + + use M, + split, + exact hM_max, + { cases char_p.exists (R ⧸ M) with r hr, + convert hr, + resetI, -- make `hr : char_p (R ⧸ M) r` an instance. + + have r_dvd_p : r ∣ p, + { rw ←char_p.cast_eq_zero_iff (R ⧸ M) r p, + convert congr_arg (ideal.quotient.factor I M hM) (char_p.cast_eq_zero (R ⧸ I) p) }, + symmetry, + apply (nat.prime.eq_one_or_self_of_dvd hp r r_dvd_p).resolve_left, + exact char_p.char_ne_one (R ⧸ M) r }}, + { rintro ⟨I, hI_max, hI⟩, + use I, + exact ⟨ideal.is_maximal.ne_top hI_max, hI⟩ } +end + +end mixed_char_zero + +/-! +### Equal characteristic zero + +A commutative ring `R` has "equal characteristic zero" if it satisfies one of the following +equivalent properties: + +1) `R` is a `ℚ`-algebra. +2) The quotient `R ⧸ I` has characteristic zero for any proper ideal `I ⊂ R`. +3) `R` has characteristic zero and does not have mixed characteristic for any prime `p`. + +We show `(1) ↔ (2) ↔ (3)`, and most of the following is concerned with constructing +an explicit algebra map `ℚ →+* R` (given by `x ↦ (x.num : R) /ₚ ↑x.pnat_denom`) +for the direction `(1) ← (2)`. + +Note: Property `(2)` is denoted as `equal_char_zero` in the statement names below. +-/ +section equal_char_zero + +/-- +`ℚ`-algebra implies equal characteristic. +-/ +@[nolint unused_arguments] -- argument `[nontrivial R]` is used in the first line of the proof. +lemma Q_algebra_to_equal_char_zero [nontrivial R] [algebra ℚ R] : + ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I) := +begin + haveI : char_zero R := algebra_rat.char_zero R, + intros I hI, + constructor, + intros a b h_ab, + contrapose! hI, + -- `↑a - ↑b` is a unit contained in `I`, which contradicts `I ≠ ⊤`. + refine I.eq_top_of_is_unit_mem _ (is_unit.map (algebra_map ℚ R) (is_unit.mk0 (a - b : ℚ) _)), + { simpa only [← ideal.quotient.eq_zero_iff_mem, map_sub, sub_eq_zero, map_nat_cast] }, + simpa only [ne.def, sub_eq_zero] using (@nat.cast_injective ℚ _ _).ne hI +end + +section construction_of_Q_algebra + +/-- Internal: Not intended to be used outside this local construction. -/ +lemma equal_char_zero.pnat_coe_is_unit [h : fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] + (n : ℕ+) : is_unit (n : R) := +begin + -- `n : R` is a unit iff `(n)` is not a proper ideal in `R`. + rw ← ideal.span_singleton_eq_top, + -- So by contrapositive, we should show the quotient does not have characteristic zero. + apply not_imp_comm.mp (h.elim (ideal.span {n})), + unfreezingI { intro h_char_zero }, + -- In particular, the image of `n` in the quotient should be nonzero. + apply (h_char_zero.cast_injective).ne n.ne_zero, + -- But `n` generates the ideal, so its image is clearly zero. + rw [←map_nat_cast (ideal.quotient.mk _), nat.cast_zero, ideal.quotient.eq_zero_iff_mem], + exact ideal.subset_span (set.mem_singleton _) +end + +/-- Internal: Not intended to be used outside this local construction. -/ +noncomputable instance equal_char_zero.pnat_has_coe_units + [fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] : has_coe_t ℕ+ Rˣ := +⟨λn, (equal_char_zero.pnat_coe_is_unit R n).unit⟩ + +/-- Internal: Not intended to be used outside this local construction. -/ +lemma equal_char_zero.pnat_coe_units_eq_one [fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] : + ((1 : ℕ+) : Rˣ) = 1 := +begin + apply units.ext, + rw units.coe_one, + change ((equal_char_zero.pnat_coe_is_unit R 1).unit : R) = 1, + rw is_unit.unit_spec (equal_char_zero.pnat_coe_is_unit R 1), + rw [coe_coe, pnat.one_coe, nat.cast_one], +end + +/-- Internal: Not intended to be used outside this local construction. -/ +lemma equal_char_zero.pnat_coe_units_coe_eq_coe + [fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I))] (n : ℕ+) : + ((n : Rˣ) : R) = ↑n := +begin + change ((equal_char_zero.pnat_coe_is_unit R n).unit : R) = ↑n, + simp only [is_unit.unit_spec], +end + +/-- +Equal characteristic implies `ℚ`-algebra. +-/ +noncomputable def equal_char_zero_to_Q_algebra (h : ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) : + algebra ℚ R := +by haveI : fact (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) := ⟨h⟩; exact +ring_hom.to_algebra + { to_fun := λ x, x.num /ₚ ↑(x.pnat_denom), + map_zero' := by simp [divp], + map_one' := by simp [equal_char_zero.pnat_coe_units_eq_one], + map_mul' := + begin + intros a b, + field_simp, + repeat { rw equal_char_zero.pnat_coe_units_coe_eq_coe R }, + transitivity (↑((a * b).num * (a.denom) * (b.denom)) : R), + { simp_rw [int.cast_mul, int.cast_coe_nat, coe_coe, rat.coe_pnat_denom], + ring }, + rw rat.mul_num_denom' a b, + simp + end, + map_add' := + begin + intros a b, + field_simp, + repeat { rw equal_char_zero.pnat_coe_units_coe_eq_coe R }, + transitivity (↑((a + b).num * a.denom * b.denom) : R), + { simp_rw [int.cast_mul, int.cast_coe_nat, coe_coe, rat.coe_pnat_denom], + ring }, + rw rat.add_num_denom' a b, + simp + end } + +end construction_of_Q_algebra + +end equal_char_zero + +/-- +Not mixed characteristic implies equal characteristic. +-/ +lemma not_mixed_char_to_equal_char_zero [char_zero R] (h : ∀ p > 0, ¬mixed_char_zero R p) : + ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I) := +begin + intros I hI_ne_top, + apply char_p.char_p_to_char_zero _, + cases char_p.exists (R ⧸ I) with p hp, + cases p, + { exact hp }, + { have h_mixed : mixed_char_zero R p.succ := ⟨⟨I, ⟨hI_ne_top, hp⟩⟩⟩, + exact absurd h_mixed (h p.succ p.succ_pos) } +end + +/-- +Equal characteristic implies not mixed characteristic. +-/ +lemma equal_char_zero_to_not_mixed_char (h : ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) : + ∀ p > 0, ¬mixed_char_zero R p := +begin + intros p p_pos, + by_contradiction hp_mixed_char, + rcases hp_mixed_char.char_p_quotient with ⟨I, hI_ne_top, hI_p⟩, + replace hI_zero : char_p (R ⧸ I) 0 := @char_p.of_char_zero _ _ (h I hI_ne_top), + exact absurd (char_p.eq (R ⧸ I) hI_p hI_zero) (ne_of_gt p_pos), +end + +/-- +A ring of characteristic zero has equal characteristic iff it does not +have mixed characteristic for any `p`. +-/ +lemma equal_char_zero_iff_not_mixed_char [char_zero R] : + (∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I)) ↔ (∀ p > 0, ¬mixed_char_zero R p) := +⟨equal_char_zero_to_not_mixed_char R, not_mixed_char_to_equal_char_zero R⟩ + +/-- +A ring is a `ℚ`-algebra iff it has equal characteristic zero. +-/ +theorem Q_algebra_iff_equal_char_zero [nontrivial R] : + nonempty (algebra ℚ R) ↔ ∀ (I : ideal R), I ≠ ⊤ → char_zero (R ⧸ I) := +begin + split, + { intro h_alg, + haveI h_alg' : algebra ℚ R := h_alg.some, + apply Q_algebra_to_equal_char_zero }, + { intro h, + apply nonempty.intro, + exact equal_char_zero_to_Q_algebra R h } +end + +/-- +A ring of characteristic zero is not a `ℚ`-algebra iff it has mixed characteristic for some `p`. +-/ +theorem not_Q_algebra_iff_not_equal_char_zero [char_zero R] : + is_empty (algebra ℚ R) ↔ (∃ p > 0, mixed_char_zero R p) := +begin + rw ←not_iff_not, + push_neg, + rw [not_is_empty_iff, ←equal_char_zero_iff_not_mixed_char], + apply Q_algebra_iff_equal_char_zero, +end + +/-! +# Splitting statements into different characteristic + +Statements to split a proof by characteristic. There are 3 theorems here that are very +similar. They only differ in the assumptions we can make on the positive characteristic +case: +Generally we need to consider all `p ≠ 0`, but if `R` is a local ring, we can assume +that `p` is a prime power. And if `R` is a domain, we can even assume that `p` is prime. +-/ +section main_statements + +variable {P : Prop} + +/-- +Split a `Prop` in characteristic zero into equal and mixed characteristic. +-/ +theorem split_equal_mixed_char [char_zero R] + (h_equal : algebra ℚ R → P) + (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P := +begin + by_cases h : ∃ p > 0, mixed_char_zero R p, + { rcases h with ⟨p, ⟨H, hp⟩⟩, + rw ←mixed_char_zero.reduce_to_p_prime at h_mixed, + exact h_mixed p H hp }, + { apply h_equal, + rw [←not_Q_algebra_iff_not_equal_char_zero, not_is_empty_iff] at h, + exact h.some }, +end + +example (n : ℕ) (h : n ≠ 0) :0 < n := zero_lt_iff.mpr h + + +/-- Split any `Prop` over `R` into the three cases: +- positive characteristic. +- equal characteristic zero. +- mixed characteristic `(0, p)`. +-/ +theorem split_by_characteristic + (h_pos : ∀ (p : ℕ), (p ≠ 0 → char_p R p → P)) + (h_equal : algebra ℚ R → P) + (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P := +begin + cases char_p.exists R with p p_char, + by_cases p = 0, + { rw h at p_char, + resetI, -- make `p_char : char_p R 0` an instance. + haveI h0 : char_zero R := char_p.char_p_to_char_zero R, + exact split_equal_mixed_char R h_equal h_mixed }, + exact h_pos p h p_char, +end + +/-- In a `is_domain R`, split any `Prop` over `R` into the three cases: +- *prime* characteristic. +- equal characteristic zero. +- mixed characteristic `(0, p)`. +-/ +theorem split_by_characteristic_domain [is_domain R] + (h_pos : ∀ (p : ℕ), (nat.prime p → char_p R p → P)) + (h_equal : algebra ℚ R → P) + (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P := +begin + refine split_by_characteristic R _ h_equal h_mixed, + introsI p p_pos p_char, + have p_prime : nat.prime p := + or_iff_not_imp_right.mp (char_p.char_is_prime_or_zero R p) p_pos, + exact h_pos p p_prime p_char, +end + +/-- In a `local_ring R`, split any `Prop` over `R` into the three cases: +- *prime power* characteristic. +- equal characteristic zero. +- mixed characteristic `(0, p)`. +-/ +theorem split_by_characteristic_local_ring [local_ring R] + (h_pos : ∀ (p : ℕ), (is_prime_pow p → char_p R p → P)) + (h_equal : algebra ℚ R → P) + (h_mixed : ∀ (p : ℕ), (nat.prime p → mixed_char_zero R p → P)) : P := +begin + refine split_by_characteristic R _ h_equal h_mixed, + introsI p p_pos p_char, + have p_ppow : is_prime_pow (p : ℕ) := + or_iff_not_imp_left.mp (char_p_zero_or_prime_power R p) p_pos, + exact h_pos p p_ppow p_char, +end + +end main_statements diff --git a/src/algebra/char_p/pi.lean b/src/algebra/char_p/pi.lean index 99db45b67779c..b3591a350372b 100644 --- a/src/algebra/char_p/pi.lean +++ b/src/algebra/char_p/pi.lean @@ -9,6 +9,9 @@ import algebra.ring.pi /-! # Characteristic of semirings of functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v diff --git a/src/algebra/char_p/quotient.lean b/src/algebra/char_p/quotient.lean index 12b4c9e2c689b..d6257701ef9c1 100644 --- a/src/algebra/char_p/quotient.lean +++ b/src/algebra/char_p/quotient.lean @@ -9,6 +9,9 @@ import ring_theory.ideal.quotient /-! # Characteristic of quotients rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v @@ -37,3 +40,15 @@ lemma quotient' {R : Type*} [comm_ring R] (p : ℕ) [char_p R p] (I : ideal R) end⟩ end char_p + +lemma ideal.quotient.index_eq_zero {R : Type*} [comm_ring R] (I : ideal R) : + (I.to_add_subgroup.index : R ⧸ I) = 0 := +begin + rw [add_subgroup.index, nat.card_eq], + split_ifs with hq, swap, simp, + by_contra h, + -- TODO: can we avoid rewriting the `I.to_add_subgroup` here? + letI : fintype (R ⧸ I) := @fintype.of_finite _ hq, + have h : (fintype.card (R ⧸ I) : R ⧸ I) ≠ 0 := h, + simpa using h +end diff --git a/src/algebra/char_p/subring.lean b/src/algebra/char_p/subring.lean index 172058f93ef13..7cfaf15dbf084 100644 --- a/src/algebra/char_p/subring.lean +++ b/src/algebra/char_p/subring.lean @@ -9,6 +9,9 @@ import ring_theory.subring.basic /-! # Characteristic of subrings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v diff --git a/src/algebra/char_p/two.lean b/src/algebra/char_p/two.lean index 639cc2e8cbc87..c69cce8d5f6c3 100644 --- a/src/algebra/char_p/two.lean +++ b/src/algebra/char_p/two.lean @@ -8,6 +8,9 @@ import algebra.char_p.basic /-! # Lemmas about rings of characteristic two +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains results about `char_p R 2`, in the `char_two` namespace. The lemmas in this file with a `_sq` suffix are just special cases of the `_pow_char` lemmas diff --git a/src/algebra/char_zero.lean b/src/algebra/char_zero.lean deleted file mode 100644 index 86887715e33d7..0000000000000 --- a/src/algebra/char_zero.lean +++ /dev/null @@ -1,228 +0,0 @@ -/- -Copyright (c) 2014 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ - -import data.nat.cast -import data.fintype.basic -import tactic.wlog - -/-! -# Characteristic zero - -A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered -as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R` -except for the existence of `1` in this file characteristic zero is defined for additive monoids -with `1`. - -## Main definition - -`char_zero` is the typeclass of an additive monoid with one such that the natural homomorphism -from the natural numbers into it is injective. - -## Main statements - -* A linearly ordered semiring has characteristic zero. -* Characteristic zero implies that the additive monoid is infinite. - -## TODO - -* Once order of a group is defined for infinite additive monoids redefine or at least connect to - order of `1` in the additive monoid with one. -* Unify with `char_p` (possibly using an out-parameter) --/ - -/-- Typeclass for monoids with characteristic zero. - (This is usually stated on fields but it makes sense for any additive monoid with 1.) - -*Warning*: for a semiring `R`, `char_zero R` and `char_p R 0` need not coincide. -* `char_zero R` requires an injection `ℕ ↪ R`; -* `char_p R 0` asks that only `0 : ℕ` maps to `0 : R` under the map `ℕ → R`. - -For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorbing), shows that -`char_zero {0, 1}` does not hold and yet `char_p {0, 1} 0` does. -This example is formalized in `counterexamples/char_p_zero_ne_char_zero`. - -/ -class char_zero (R : Type*) [add_monoid R] [has_one R] : Prop := -(cast_injective : function.injective (coe : ℕ → R)) - -theorem char_zero_of_inj_zero {R : Type*} [add_left_cancel_monoid R] [has_one R] - (H : ∀ n:ℕ, (n:R) = 0 → n = 0) : char_zero R := -⟨λ m n, begin - assume h, - wlog hle : m ≤ n, - rcases nat.le.dest hle with ⟨k, rfl⟩, - rw [nat.cast_add, eq_comm, add_right_eq_self] at h, - rw [H k h, add_zero] - end⟩ - -/-- Note this is not an instance as `char_zero` implies `nontrivial`, -and this would risk forming a loop. -/ -lemma ordered_semiring.to_char_zero {R : Type*} [ordered_semiring R] [nontrivial R] : - char_zero R := -⟨nat.strict_mono_cast.injective⟩ - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_semiring.to_char_zero {R : Type*} - [linear_ordered_semiring R] : char_zero R := -ordered_semiring.to_char_zero - -namespace nat -variables {R : Type*} [add_monoid R] [has_one R] [char_zero R] - -theorem cast_injective : function.injective (coe : ℕ → R) := -char_zero.cast_injective - -/-- `nat.cast` as an embedding into monoids of characteristic `0`. -/ -@[simps] -def cast_embedding : ℕ ↪ R := ⟨coe, cast_injective⟩ - -@[simp, norm_cast] theorem cast_inj {m n : ℕ} : (m : R) = n ↔ m = n := -cast_injective.eq_iff - -@[simp, norm_cast] theorem cast_eq_zero {n : ℕ} : (n : R) = 0 ↔ n = 0 := -by rw [←cast_zero, cast_inj] - -@[simp, norm_cast] theorem cast_eq_one {n : ℕ} : (n : R) = 1 ↔ n = 1 := -by rw [←cast_one, cast_inj] - -@[simp] lemma cast_pow_eq_one {R : Type*} [semiring R] [char_zero R] (q : ℕ) (n : ℕ) (hn : n ≠ 0) : - (q : R) ^ n = 1 ↔ q = 1 := -by { rw [←cast_pow, cast_eq_one], exact pow_eq_one_iff hn } - -@[norm_cast] theorem cast_ne_zero {n : ℕ} : (n : R) ≠ 0 ↔ n ≠ 0 := -cast_eq_zero.not - -@[norm_cast] theorem cast_ne_one {n : ℕ} : (n : R) ≠ 1 ↔ n ≠ 1 := -cast_eq_one.not - -lemma cast_add_one_ne_zero (n : ℕ) : (n + 1 : R) ≠ 0 := -by exact_mod_cast n.succ_ne_zero - -@[simp, norm_cast] -theorem cast_div_char_zero {k : Type*} [field k] [char_zero k] {m n : ℕ} - (n_dvd : n ∣ m) : ((m / n : ℕ) : k) = m / n := -begin - rcases eq_or_ne n 0 with rfl | hn, - { simp }, - { exact cast_div n_dvd (cast_ne_zero.2 hn), }, -end - -end nat - -section - -variables (M : Type*) [add_monoid M] [has_one M] [char_zero M] - -@[priority 100] -- see Note [lower instance priority] -instance char_zero.infinite : infinite M := -infinite.of_injective coe nat.cast_injective - -variable {M} - -@[field_simps] lemma two_ne_zero' : (2:M) ≠ 0 := -have ((2:ℕ):M) ≠ 0, from nat.cast_ne_zero.2 dec_trivial, -by rwa [nat.cast_two] at this - -end - -section -variables {R : Type*} [non_assoc_semiring R] [no_zero_divisors R] [char_zero R] - -@[simp] -lemma add_self_eq_zero {a : R} : a + a = 0 ↔ a = 0 := -by simp only [(two_mul a).symm, mul_eq_zero, two_ne_zero', false_or] - -@[simp] -lemma bit0_eq_zero {a : R} : bit0 a = 0 ↔ a = 0 := add_self_eq_zero -@[simp] -lemma zero_eq_bit0 {a : R} : 0 = bit0 a ↔ a = 0 := -by { rw [eq_comm], exact bit0_eq_zero } -end - -section -variables {R : Type*} [non_assoc_ring R] [no_zero_divisors R] [char_zero R] - -lemma neg_eq_self_iff {a : R} : -a = a ↔ a = 0 := -neg_eq_iff_add_eq_zero.trans add_self_eq_zero - -lemma eq_neg_self_iff {a : R} : a = -a ↔ a = 0 := -eq_neg_iff_add_eq_zero.trans add_self_eq_zero - -lemma nat_mul_inj {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) : n = 0 ∨ a = b := -begin - rw [←sub_eq_zero, ←mul_sub, mul_eq_zero, sub_eq_zero] at h, - exact_mod_cast h, -end - -lemma nat_mul_inj' {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) (w : n ≠ 0) : a = b := -by simpa [w] using nat_mul_inj h - -lemma bit0_injective : function.injective (bit0 : R → R) := -λ a b h, begin - dsimp [bit0] at h, - simp only [(two_mul a).symm, (two_mul b).symm] at h, - refine nat_mul_inj' _ two_ne_zero, - exact_mod_cast h, -end - -lemma bit1_injective : function.injective (bit1 : R → R) := -λ a b h, begin - simp only [bit1, add_left_inj] at h, - exact bit0_injective h, -end - -@[simp] lemma bit0_eq_bit0 {a b : R} : bit0 a = bit0 b ↔ a = b := -bit0_injective.eq_iff - -@[simp] lemma bit1_eq_bit1 {a b : R} : bit1 a = bit1 b ↔ a = b := -bit1_injective.eq_iff - -@[simp] -lemma bit1_eq_one {a : R} : bit1 a = 1 ↔ a = 0 := -by rw [show (1 : R) = bit1 0, by simp, bit1_eq_bit1] - -@[simp] -lemma one_eq_bit1 {a : R} : 1 = bit1 a ↔ a = 0 := -by { rw [eq_comm], exact bit1_eq_one } - -end - -section -variables {R : Type*} [division_ring R] [char_zero R] - -@[simp] lemma half_add_self (a : R) : (a + a) / 2 = a := -by rw [← mul_two, mul_div_cancel a two_ne_zero'] - -@[simp] lemma add_halves' (a : R) : a / 2 + a / 2 = a := -by rw [← add_div, half_add_self] - -lemma sub_half (a : R) : a - a / 2 = a / 2 := -by rw [sub_eq_iff_eq_add, add_halves'] - -lemma half_sub (a : R) : a / 2 - a = - (a / 2) := -by rw [← neg_sub, sub_half] - -end - -namespace with_top - -instance {R : Type*} [add_monoid R] [has_one R] [char_zero R] : char_zero (with_top R) := -{ cast_injective := λ m n h, by rwa [← coe_nat, ← coe_nat n, coe_eq_coe, nat.cast_inj] at h } - -end with_top - -section ring_hom - -variables {R S : Type*} [non_assoc_semiring R] [non_assoc_semiring S] - -lemma ring_hom.char_zero (ϕ : R →+* S) [hS : char_zero S] : char_zero R := -⟨λ a b h, char_zero.cast_injective (by rw [←map_nat_cast ϕ, ←map_nat_cast ϕ, h])⟩ - -lemma ring_hom.char_zero_iff {ϕ : R →+* S} (hϕ : function.injective ϕ) : - char_zero R ↔ char_zero S := -⟨λ hR, ⟨λ a b h, by rwa [←@nat.cast_inj R _ _ hR, ←hϕ.eq_iff, map_nat_cast ϕ, map_nat_cast ϕ]⟩, - λ hS, by exactI ϕ.char_zero⟩ - -end ring_hom diff --git a/src/algebra/char_zero/defs.lean b/src/algebra/char_zero/defs.lean new file mode 100644 index 0000000000000..b816a39338632 --- /dev/null +++ b/src/algebra/char_zero/defs.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.int.cast.defs + +/-! +# Characteristic zero + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered +as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R` +except for the existence of `1` in this file characteristic zero is defined for additive monoids +with `1`. + +## Main definition + +`char_zero` is the typeclass of an additive monoid with one such that the natural homomorphism +from the natural numbers into it is injective. + +## TODO + +* Unify with `char_p` (possibly using an out-parameter) +-/ + +/-- Typeclass for monoids with characteristic zero. + (This is usually stated on fields but it makes sense for any additive monoid with 1.) + +*Warning*: for a semiring `R`, `char_zero R` and `char_p R 0` need not coincide. +* `char_zero R` requires an injection `ℕ ↪ R`; +* `char_p R 0` asks that only `0 : ℕ` maps to `0 : R` under the map `ℕ → R`. + +For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorbing), shows that +`char_zero {0, 1}` does not hold and yet `char_p {0, 1} 0` does. +This example is formalized in `counterexamples/char_p_zero_ne_char_zero`. + -/ +class char_zero (R : Type*) [add_monoid_with_one R] : Prop := +(cast_injective : function.injective (coe : ℕ → R)) + +theorem char_zero_of_inj_zero {R : Type*} [add_group_with_one R] + (H : ∀ n:ℕ, (n:R) = 0 → n = 0) : char_zero R := +⟨λ m n h, begin + induction m with m ih generalizing n, { rw H n, rw [← h, nat.cast_zero] }, + cases n with n, { apply H, rw [h, nat.cast_zero], }, + simp_rw [nat.cast_succ, add_right_cancel_iff] at h, rwa ih, +end⟩ + +namespace nat +variables {R : Type*} [add_monoid_with_one R] [char_zero R] + +theorem cast_injective : function.injective (coe : ℕ → R) := +char_zero.cast_injective + +@[simp, norm_cast] theorem cast_inj {m n : ℕ} : (m : R) = n ↔ m = n := +cast_injective.eq_iff + +@[simp, norm_cast] theorem cast_eq_zero {n : ℕ} : (n : R) = 0 ↔ n = 0 := +by rw [← cast_zero, cast_inj] + +@[norm_cast] theorem cast_ne_zero {n : ℕ} : (n : R) ≠ 0 ↔ n ≠ 0 := +not_congr cast_eq_zero + +lemma cast_add_one_ne_zero (n : ℕ) : (n + 1 : R) ≠ 0 := +by exact_mod_cast n.succ_ne_zero + +@[simp, norm_cast] theorem cast_eq_one {n : ℕ} : (n : R) = 1 ↔ n = 1 := +by rw [←cast_one, cast_inj] + +@[norm_cast] theorem cast_ne_one {n : ℕ} : (n : R) ≠ 1 ↔ n ≠ 1 := +cast_eq_one.not + +end nat + +namespace ne_zero + +instance char_zero {M} {n : ℕ} + [ne_zero n] [add_monoid_with_one M] [char_zero M] : ne_zero (n : M) := +⟨nat.cast_ne_zero.mpr out⟩ + +end ne_zero diff --git a/src/algebra/char_zero/infinite.lean b/src/algebra/char_zero/infinite.lean new file mode 100644 index 0000000000000..e204f5bbb4c84 --- /dev/null +++ b/src/algebra/char_zero/infinite.lean @@ -0,0 +1,19 @@ +/- +Copyright (c) 2020 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin +-/ +import algebra.char_zero.defs +import data.fintype.card + +/-! # A characteristic-zero semiring is infinite + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +open set +variables (M : Type*) [add_monoid_with_one M] [char_zero M] + +@[priority 100] -- see Note [lower instance priority] +instance char_zero.infinite : infinite M := +infinite.of_injective coe nat.cast_injective diff --git a/src/algebra/char_zero/lemmas.lean b/src/algebra/char_zero/lemmas.lean new file mode 100644 index 0000000000000..37329fd11dfbd --- /dev/null +++ b/src/algebra/char_zero/lemmas.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ + +import data.nat.cast.field +import algebra.group_power.lemmas + +/-! +# Characteristic zero (additional theorems) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered +as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R` +except for the existence of `1` in this file characteristic zero is defined for additive monoids +with `1`. + +## Main statements + +* Characteristic zero implies that the additive monoid is infinite. +-/ + +namespace nat +variables {R : Type*} [add_monoid_with_one R] [char_zero R] + +/-- `nat.cast` as an embedding into monoids of characteristic `0`. -/ +@[simps] +def cast_embedding : ℕ ↪ R := ⟨coe, cast_injective⟩ + +@[simp] lemma cast_pow_eq_one {R : Type*} [semiring R] [char_zero R] (q : ℕ) (n : ℕ) (hn : n ≠ 0) : + (q : R) ^ n = 1 ↔ q = 1 := +by { rw [←cast_pow, cast_eq_one], exact pow_eq_one_iff hn } + +@[simp, norm_cast] +theorem cast_div_char_zero {k : Type*} [division_semiring k] [char_zero k] {m n : ℕ} + (n_dvd : n ∣ m) : ((m / n : ℕ) : k) = m / n := +begin + rcases eq_or_ne n 0 with rfl | hn, + { simp }, + { exact cast_div n_dvd (cast_ne_zero.2 hn), }, +end + +end nat + +section + +variables (M : Type*) [add_monoid_with_one M] [char_zero M] + +instance char_zero.ne_zero.two : ne_zero (2 : M) := +⟨have ((2:ℕ):M) ≠ 0, from nat.cast_ne_zero.2 dec_trivial, by rwa [nat.cast_two] at this⟩ + +end + +section +variables {R : Type*} [non_assoc_semiring R] [no_zero_divisors R] [char_zero R] {a : R} + +@[simp] +lemma add_self_eq_zero {a : R} : a + a = 0 ↔ a = 0 := +by simp only [(two_mul a).symm, mul_eq_zero, two_ne_zero, false_or] + +@[simp] +lemma bit0_eq_zero {a : R} : bit0 a = 0 ↔ a = 0 := add_self_eq_zero +@[simp] +lemma zero_eq_bit0 {a : R} : 0 = bit0 a ↔ a = 0 := +by { rw [eq_comm], exact bit0_eq_zero } + +lemma bit0_ne_zero : bit0 a ≠ 0 ↔ a ≠ 0 := bit0_eq_zero.not +lemma zero_ne_bit0 : 0 ≠ bit0 a ↔ a ≠ 0 := zero_eq_bit0.not + +end + +section +variables {R : Type*} [non_assoc_ring R] [no_zero_divisors R] [char_zero R] + +lemma neg_eq_self_iff {a : R} : -a = a ↔ a = 0 := +neg_eq_iff_add_eq_zero.trans add_self_eq_zero + +lemma eq_neg_self_iff {a : R} : a = -a ↔ a = 0 := +eq_neg_iff_add_eq_zero.trans add_self_eq_zero + +lemma nat_mul_inj {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) : n = 0 ∨ a = b := +begin + rw [←sub_eq_zero, ←mul_sub, mul_eq_zero, sub_eq_zero] at h, + exact_mod_cast h, +end + +lemma nat_mul_inj' {n : ℕ} {a b : R} (h : (n : R) * a = (n : R) * b) (w : n ≠ 0) : a = b := +by simpa [w] using nat_mul_inj h + +lemma bit0_injective : function.injective (bit0 : R → R) := +λ a b h, begin + dsimp [bit0] at h, + simp only [(two_mul a).symm, (two_mul b).symm] at h, + refine nat_mul_inj' _ two_ne_zero, + exact_mod_cast h, +end + +lemma bit1_injective : function.injective (bit1 : R → R) := +λ a b h, begin + simp only [bit1, add_left_inj] at h, + exact bit0_injective h, +end + +@[simp] lemma bit0_eq_bit0 {a b : R} : bit0 a = bit0 b ↔ a = b := +bit0_injective.eq_iff + +@[simp] lemma bit1_eq_bit1 {a b : R} : bit1 a = bit1 b ↔ a = b := +bit1_injective.eq_iff + +@[simp] +lemma bit1_eq_one {a : R} : bit1 a = 1 ↔ a = 0 := +by rw [show (1 : R) = bit1 0, by simp, bit1_eq_bit1] + +@[simp] +lemma one_eq_bit1 {a : R} : 1 = bit1 a ↔ a = 0 := +by { rw [eq_comm], exact bit1_eq_one } + +end + +section +variables {R : Type*} [division_ring R] [char_zero R] + +@[simp] lemma half_add_self (a : R) : (a + a) / 2 = a := +by rw [← mul_two, mul_div_cancel a two_ne_zero] + +@[simp] lemma add_halves' (a : R) : a / 2 + a / 2 = a := +by rw [← add_div, half_add_self] + +lemma sub_half (a : R) : a - a / 2 = a / 2 := +by rw [sub_eq_iff_eq_add, add_halves'] + +lemma half_sub (a : R) : a / 2 - a = - (a / 2) := +by rw [← neg_sub, sub_half] + +end + +namespace with_top + +instance {R : Type*} [add_monoid_with_one R] [char_zero R] : char_zero (with_top R) := +{ cast_injective := λ m n h, by rwa [← coe_nat, ← coe_nat n, coe_eq_coe, nat.cast_inj] at h } + +end with_top + +section ring_hom + +variables {R S : Type*} [non_assoc_semiring R] [non_assoc_semiring S] + +lemma ring_hom.char_zero (ϕ : R →+* S) [hS : char_zero S] : char_zero R := +⟨λ a b h, char_zero.cast_injective (by rw [←map_nat_cast ϕ, ←map_nat_cast ϕ, h])⟩ + +lemma ring_hom.char_zero_iff {ϕ : R →+* S} (hϕ : function.injective ϕ) : + char_zero R ↔ char_zero S := +⟨λ hR, ⟨by introsI a b h; rwa [← @nat.cast_inj R, ← hϕ.eq_iff, map_nat_cast ϕ, map_nat_cast ϕ]⟩, + λ hS, by exactI ϕ.char_zero⟩ + +lemma ring_hom.injective_nat (f : ℕ →+* R) [char_zero R] : + function.injective f := +subsingleton.elim (nat.cast_ring_hom _) f ▸ nat.cast_injective + +end ring_hom diff --git a/src/algebra/char_zero/quotient.lean b/src/algebra/char_zero/quotient.lean new file mode 100644 index 0000000000000..61ad45384b7d0 --- /dev/null +++ b/src/algebra/char_zero/quotient.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import group_theory.quotient_group + +/-! +# Lemmas about quotients in characteristic zero + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {R : Type*} [division_ring R] [char_zero R] {p : R} + +namespace add_subgroup + +/-- `z • r` is a multiple of `p` iff `r` is `pk/z` above a multiple of `p`, where `0 ≤ k < |z|`. -/ +lemma zsmul_mem_zmultiples_iff_exists_sub_div {r : R} {z : ℤ} (hz : z ≠ 0) : + z • r ∈ add_subgroup.zmultiples p ↔ + ∃ k : fin z.nat_abs, r - (k : ℕ) • (p / z : R) ∈ add_subgroup.zmultiples p:= +begin + rw [add_subgroup.mem_zmultiples_iff], + simp_rw [add_subgroup.mem_zmultiples_iff, div_eq_mul_inv, ←smul_mul_assoc, eq_sub_iff_add_eq], + have hz' : (z : R) ≠ 0 := int.cast_ne_zero.mpr hz, + conv_rhs { simp only [←(mul_right_injective₀ hz').eq_iff] { single_pass := tt}, }, + simp_rw [←zsmul_eq_mul, smul_add, ←mul_smul_comm, zsmul_eq_mul (z : R)⁻¹, mul_inv_cancel hz', + mul_one, ←coe_nat_zsmul, smul_smul, ←add_smul], + split, + { rintro ⟨k, h⟩, + simp_rw ← h, + refine ⟨⟨(k % z).to_nat, _⟩, k / z, _⟩, + { rw [←int.coe_nat_lt, int.to_nat_of_nonneg (int.mod_nonneg _ hz)], + exact (int.mod_lt _ hz).trans_eq (int.abs_eq_nat_abs _) }, + rw [fin.coe_mk, int.to_nat_of_nonneg (int.mod_nonneg _ hz), int.div_add_mod] }, + { rintro ⟨k, n, h⟩, + exact ⟨_, h⟩, }, +end + +lemma nsmul_mem_zmultiples_iff_exists_sub_div {r : R} {n : ℕ} (hn : n ≠ 0) : + n • r ∈ add_subgroup.zmultiples p ↔ + ∃ k : fin n, r - (k : ℕ) • (p / n : R) ∈ add_subgroup.zmultiples p:= +begin + simp_rw [←coe_nat_zsmul r, zsmul_mem_zmultiples_iff_exists_sub_div (int.coe_nat_ne_zero.mpr hn), + int.cast_coe_nat], + refl, +end + +end add_subgroup + +namespace quotient_add_group + +lemma zmultiples_zsmul_eq_zsmul_iff {ψ θ : R ⧸ add_subgroup.zmultiples p} {z : ℤ} (hz : z ≠ 0) : + z • ψ = z • θ ↔ (∃ k : fin z.nat_abs, ψ = θ + (k : ℕ) • (p / z : R)) := +begin + induction ψ using quotient.induction_on', + induction θ using quotient.induction_on', + have : (quotient.mk' : R → R ⧸ add_subgroup.zmultiples p) = coe := rfl, + simp only [this], + simp_rw [←coe_zsmul, ←coe_nsmul, ←coe_add, quotient_add_group.eq_iff_sub_mem, ←smul_sub, + ←sub_sub, add_subgroup.zsmul_mem_zmultiples_iff_exists_sub_div hz], +end + +lemma zmultiples_nsmul_eq_nsmul_iff {ψ θ : R ⧸ add_subgroup.zmultiples p} {n : ℕ} (hz : n ≠ 0) : + n • ψ = n • θ ↔ (∃ k : fin n, ψ = θ + (k : ℕ) • (p / n : R)) := +begin + simp_rw [←coe_nat_zsmul ψ, ←coe_nat_zsmul θ, + zmultiples_zsmul_eq_zsmul_iff (int.coe_nat_ne_zero.mpr hz), int.cast_coe_nat], + refl, +end + +end quotient_add_group diff --git a/src/algebra/continued_fractions/basic.lean b/src/algebra/continued_fractions/basic.lean index 2e61569c0d012..8c04dd961e079 100644 --- a/src/algebra/continued_fractions/basic.lean +++ b/src/algebra/continued_fractions/basic.lean @@ -4,10 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kevin Kappelmann -/ import data.seq.seq -import algebra.field.basic +import algebra.field.defs /-! # Basic Definitions/Theorems for Continued Fractions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We define generalised, simple, and regular continued fractions and functions to evaluate their @@ -47,6 +50,7 @@ variable (α : Type*) protected structure generalized_continued_fraction.pair := (a : α) (b : α) open generalized_continued_fraction +open stream.seq as seq /-! Interlude: define some expected coercions and instances. -/ namespace generalized_continued_fraction.pair @@ -80,17 +84,13 @@ variable (α) /-- A *generalised continued fraction* (gcf) is a potentially infinite expression of the form - - a₀ - h + --------------------------- - a₁ - b₀ + -------------------- - a₂ - b₁ + -------------- - a₃ - b₂ + -------- - b₃ + ... - +$$ + h + \dfrac{a_0} + {b_0 + \dfrac{a_1} + {b_1 + \dfrac{a_2} + {b_2 + \dfrac{a_3} + {b_3 + \dots}}}} +$$ where `h` is called the *head term* or *integer part*, the `aᵢ` are called the *partial numerators* and the `bᵢ` the *partial denominators* of the gcf. We store the sequence of partial numerators and denominators in a sequence of @@ -150,17 +150,13 @@ end generalized_continued_fraction /-- A generalized continued fraction is a *simple continued fraction* if all partial numerators are equal to one. - - 1 - h + --------------------------- - 1 - b₀ + -------------------- - 1 - b₁ + -------------- - 1 - b₂ + -------- - b₃ + ... - +$$ + h + \dfrac{1} + {b_0 + \dfrac{1} + {b_1 + \dfrac{1} + {b_2 + \dfrac{1} + {b_3 + \dots}}}} +$$ -/ def generalized_continued_fraction.is_simple_continued_fraction (g : generalized_continued_fraction α) [has_one α] : Prop := @@ -170,17 +166,13 @@ variable (α) /-- A *simple continued fraction* (scf) is a generalized continued fraction (gcf) whose partial numerators are equal to one. - - 1 - h + --------------------------- - 1 - b₀ + -------------------- - 1 - b₁ + -------------- - 1 - b₂ + -------- - b₃ + ... - +$$ + h + \dfrac{1} + {b_0 + \dfrac{1} + {b_1 + \dfrac{1} + {b_2 + \dfrac{1} + {b_3 + \dots}}}} +$$ For convenience, one often writes `[h; b₀, b₁, b₂,...]`. It is encoded as the subtype of gcfs that satisfy `generalized_continued_fraction.is_simple_continued_fraction`. diff --git a/src/algebra/continued_fractions/computation/approximation_corollaries.lean b/src/algebra/continued_fractions/computation/approximation_corollaries.lean index ebf894c9bd76d..0e8d5fab9f97a 100644 --- a/src/algebra/continued_fractions/computation/approximation_corollaries.lean +++ b/src/algebra/continued_fractions/computation/approximation_corollaries.lean @@ -6,11 +6,15 @@ Authors: Kevin Kappelmann import algebra.continued_fractions.computation.approximations import algebra.continued_fractions.convergents_equiv import algebra.order.archimedean -import topology.algebra.order.basic +import algebra.algebra.basic +import topology.order.basic /-! # Corollaries From Approximation Lemmas (`algebra.continued_fractions.computation.approximations`) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We show that the generalized_continued_fraction given by `generalized_continued_fraction.of` in fact @@ -66,6 +70,14 @@ lemma of_convergents_eq_convergents' : (of v).convergents = (of v).convergents' := @continued_fraction.convergents_eq_convergents' _ _ (continued_fraction.of v) +/-- +The recurrence relation for the `convergents` of the continued fraction expansion +of an element `v` of `K` in terms of the convergents of the inverse of its fractional part. +-/ +lemma convergents_succ (n : ℕ) : + (of v).convergents (n + 1) = ⌊v⌋ + 1 / (of (int.fract v)⁻¹).convergents n := +by rw [of_convergents_eq_convergents', convergents'_succ, of_convergents_eq_convergents'] + section convergence /-! ### Convergence diff --git a/src/algebra/continued_fractions/computation/approximations.lean b/src/algebra/continued_fractions/computation/approximations.lean index 3dda5bacdabcc..09633aa94d4c2 100644 --- a/src/algebra/continued_fractions/computation/approximations.lean +++ b/src/algebra/continued_fractions/computation/approximations.lean @@ -9,6 +9,9 @@ import tactic.solve_by_elim /-! # Approximations for Continued Fraction Computations (`generalized_continued_fraction.of`) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary This file contains useful approximations for the values involved in the continued fractions @@ -275,19 +278,10 @@ lemma le_of_succ_succ_nth_continuants_aux_b {b : K} (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) : b * ((of v).continuants_aux $ n + 1).b ≤ ((of v).continuants_aux $ n + 2).b := begin - set g := of v with g_eq, - obtain ⟨gp_n, nth_s_eq, gpnb_eq_b⟩ : ∃ gp_n, g.s.nth n = some gp_n ∧ gp_n.b = b, from - exists_s_b_of_part_denom nth_part_denom_eq, - subst gpnb_eq_b, - let conts := g.continuants_aux (n + 2), - set pconts := g.continuants_aux (n + 1) with pconts_eq, - set ppconts := g.continuants_aux n with ppconts_eq, - have h1 : 0 ≤ ppconts.b, from zero_le_of_continuants_aux_b, - have h2 : gp_n.b * pconts.b ≤ ppconts.b + gp_n.b * pconts.b, - { solve_by_elim [le_add_of_nonneg_of_le, le_refl] }, - -- use the recurrence of continuants_aux and the fact that gp_n.a = 1 - simp [h1, h2, of_part_num_eq_one (part_num_eq_s_a nth_s_eq), - generalized_continued_fraction.continuants_aux_recurrence nth_s_eq ppconts_eq pconts_eq], + obtain ⟨gp_n, nth_s_eq, rfl⟩ : ∃ gp_n, (of v).s.nth n = some gp_n ∧ gp_n.b = b, + from exists_s_b_of_part_denom nth_part_denom_eq, + simp [of_part_num_eq_one (part_num_eq_s_a nth_s_eq), zero_le_of_continuants_aux_b, + generalized_continued_fraction.continuants_aux_recurrence nth_s_eq rfl rfl] end /-- Shows that `bₙ * Bₙ ≤ Bₙ₊₁`, where `bₙ` is the `n`th partial denominator and `Bₙ₊₁` and `Bₙ` are @@ -305,9 +299,9 @@ theorem of_denom_mono : (of v).denominators n ≤ (of v).denominators (n + 1) := begin let g := of v, cases (decidable.em $ g.partial_denominators.terminated_at n) with terminated not_terminated, - { have : g.partial_denominators.nth n = none, by rwa seq.terminated_at at terminated, + { have : g.partial_denominators.nth n = none, by rwa stream.seq.terminated_at at terminated, have : g.terminated_at n, from - terminated_at_iff_part_denom_none.elim_right (by rwa seq.terminated_at at terminated), + terminated_at_iff_part_denom_none.elim_right (by rwa stream.seq.terminated_at at terminated), have : g.denominators (n + 1) = g.denominators n, from denominators_stable_of_terminated n.le_succ this, rw this }, @@ -515,8 +509,7 @@ begin simp only [stream_nth_fr_ne_zero, conts_eq.symm, pred_conts_eq.symm] at tmp, rw tmp, simp only [denom'], - ring_nf, - ac_refl }, + ring_nf }, rwa this }, -- derive some tedious inequalities that we need to rewrite our goal have nextConts_b_ineq : (fib (n + 2) : K) ≤ (pred_conts.b + gp.b * conts.b), by @@ -574,33 +567,21 @@ Shows that `|v - Aₙ / Bₙ| ≤ 1 / (bₙ * Bₙ * Bₙ)`. This bound is worse -/ lemma abs_sub_convergents_le' {b : K} (nth_part_denom_eq : (of v).partial_denominators.nth n = some b) : - |v - (of v).convergents n| - ≤ 1 / (b * ((of v).denominators n) * ((of v).denominators n)) := + |v - (of v).convergents n| ≤ 1 / (b * ((of v).denominators n) * ((of v).denominators n)) := begin - let g := of v, - let B := g.denominators n, - let nB := g.denominators (n + 1), - have not_terminated_at_n : ¬g.terminated_at n, by - { have : g.partial_denominators.nth n ≠ none, by simp [nth_part_denom_eq], - exact (not_iff_not_of_iff terminated_at_iff_part_denom_none).elim_right this }, - suffices : 1 / (B * nB) ≤ (1 : K) / (b * B * B), by - { have : |v - g.convergents n| ≤ 1 / (B * nB), from abs_sub_convergents_le not_terminated_at_n, - transitivity; - assumption }, - -- derive some inequalities needed to show the claim - have zero_lt_B : 0 < B, by - { have : (fib (n + 1) : K) ≤ B, from - succ_nth_fib_le_of_nth_denom (or.inr $ - mt (terminated_stable n.pred_le) not_terminated_at_n), - exact (lt_of_lt_of_le - (by exact_mod_cast (fib_pos (lt_of_le_of_ne n.succ.zero_le n.succ_ne_zero.symm))) this) }, - have denoms_ineq : b * B * B ≤ B * nB, by - { have : b * B ≤ nB, from le_of_succ_nth_denom nth_part_denom_eq, - rwa [(mul_comm B nB), (mul_le_mul_right zero_lt_B)] }, - have : (0 : K) < b * B * B, by - { have : 0 < b, from lt_of_lt_of_le zero_lt_one (of_one_le_nth_part_denom nth_part_denom_eq), - any_goals { repeat { apply mul_pos } }; assumption }, - exact (div_le_div_of_le_left zero_le_one this denoms_ineq) + have not_terminated_at_n : ¬(of v).terminated_at n, + by simp [terminated_at_iff_part_denom_none, nth_part_denom_eq], + refine (abs_sub_convergents_le not_terminated_at_n).trans _, + -- One can show that `0 < (generalized_continued_fraction.of v).denominators n` but it's easier + -- to consider the case `(generalized_continued_fraction.of v).denominators n = 0`. + rcases zero_le_of_denom.eq_or_gt + with (hB : (generalized_continued_fraction.of v).denominators n = 0) | hB, + { simp only [hB, mul_zero, zero_mul, div_zero] }, + { apply one_div_le_one_div_of_le, + { have : 0 < b := zero_lt_one.trans_le (of_one_le_nth_part_denom nth_part_denom_eq), + apply_rules [mul_pos] }, + { conv_rhs { rw [mul_comm] }, + exact mul_le_mul_of_nonneg_right (le_of_succ_nth_denom nth_part_denom_eq) hB.le } } end end error_term diff --git a/src/algebra/continued_fractions/computation/basic.lean b/src/algebra/continued_fractions/computation/basic.lean index 5780fcc8ca078..a7d533da3b7d2 100644 --- a/src/algebra/continued_fractions/computation/basic.lean +++ b/src/algebra/continued_fractions/computation/basic.lean @@ -5,10 +5,13 @@ Authors: Kevin Kappelmann -/ import algebra.order.floor import algebra.continued_fractions.basic -import algebra.order.field + /-! # Computable Continued Fractions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We formalise the standard computation of (regular) continued fractions for linear ordered floor @@ -31,8 +34,7 @@ For an example, refer to `int_fract_pair.stream`. - `generalized_continued_fraction.int_fract_pair.stream`: computes the stream of integer and fractional parts of a given value as described in the summary. - `generalized_continued_fraction.of`: computes the generalised continued fraction of a value `v`. - In fact, it computes a regular continued fraction that terminates if and only if `v` is rational - (those proofs will be added in a future commit). + In fact, it computes a regular continued fraction that terminates if and only if `v` is rational. ## Implementation Notes @@ -129,8 +131,9 @@ For example, let `(v : ℚ) := 3.4`. The process goes as follows: -/ protected def stream (v : K) : stream $ option (int_fract_pair K) | 0 := some (int_fract_pair.of v) -| (n + 1) := do ap_n ← stream n, - if ap_n.fr = 0 then none else int_fract_pair.of ap_n.fr⁻¹ +| (n + 1) := (stream n).bind $ λ ap_n, + if ap_n.fr = 0 then none else some (int_fract_pair.of ap_n.fr⁻¹) + /-- Shows that `int_fract_pair.stream` has the sequence property, that is once we return `none` at @@ -148,10 +151,11 @@ This is just an intermediate representation and users should not (need to) direc it. The setup of rewriting/simplification lemmas that make the definitions easy to use is done in `algebra.continued_fractions.computation.translations`. -/ -protected def seq1 (v : K) : seq1 $ int_fract_pair K := +protected def seq1 (v : K) : stream.seq1 $ int_fract_pair K := ⟨ int_fract_pair.of v,--the head - seq.tail -- take the tail of `int_fract_pair.stream` since the first element is already in the - -- head create a sequence from `int_fract_pair.stream` + stream.seq.tail -- take the tail of `int_fract_pair.stream` since the first element is already in + -- the head + -- create a sequence from `int_fract_pair.stream` ⟨ int_fract_pair.stream v, -- the underlying stream @stream_is_seq _ _ _ v ⟩ ⟩ -- the proof that the stream is a sequence diff --git a/src/algebra/continued_fractions/computation/correctness_terminating.lean b/src/algebra/continued_fractions/computation/correctness_terminating.lean index 7f976b1e1d255..d8d086b85e8c3 100644 --- a/src/algebra/continued_fractions/computation/correctness_terminating.lean +++ b/src/algebra/continued_fractions/computation/correctness_terminating.lean @@ -12,6 +12,9 @@ import tactic.field_simp /-! # Correctness of Terminating Continued Fraction Computations (`generalized_continued_fraction.of`) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We show the correctness of the diff --git a/src/algebra/continued_fractions/computation/default.lean b/src/algebra/continued_fractions/computation/default.lean deleted file mode 100644 index a35851c11e618..0000000000000 --- a/src/algebra/continued_fractions/computation/default.lean +++ /dev/null @@ -1,14 +0,0 @@ -/- -Copyright (c) 2020 Kevin Kappelmann. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kevin Kappelmann --/ -import algebra.continued_fractions.computation.basic -import algebra.continued_fractions.computation.translations -import algebra.continued_fractions.computation.correctness_terminating -import algebra.continued_fractions.computation.approximations -import algebra.continued_fractions.computation.terminates_iff_rat -import algebra.continued_fractions.computation.approximation_corollaries -/-! -# Default Exports for the Computation of Continued Fractions --/ diff --git a/src/algebra/continued_fractions/computation/terminates_iff_rat.lean b/src/algebra/continued_fractions/computation/terminates_iff_rat.lean index 92de5b24686e4..a559d3f765016 100644 --- a/src/algebra/continued_fractions/computation/terminates_iff_rat.lean +++ b/src/algebra/continued_fractions/computation/terminates_iff_rat.lean @@ -5,11 +5,13 @@ Authors: Kevin Kappelmann -/ import algebra.continued_fractions.computation.approximations import algebra.continued_fractions.computation.correctness_terminating -import algebra.order.archimedean import data.rat.floor /-! # Termination of Continued Fraction Computations (`gcf.of`) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We show that the continued fraction for a value `v`, as defined in `algebra.continued_fractions.computation.basic`, terminates if and only if `v` corresponds to a @@ -29,6 +31,7 @@ rational, continued fraction, termination -/ namespace generalized_continued_fraction +open stream.seq as seq open generalized_continued_fraction (of) @@ -187,8 +190,7 @@ begin rwa [stream_q_nth_eq] at IH, have : (fr : K)⁻¹ = ((fr⁻¹ : ℚ) : K), by norm_cast, have coe_of_fr := (coe_of_rat_eq this), - simp [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq, fr_ne_zero], - exact congr_arg some coe_of_fr } } } + simpa [int_fract_pair.stream, IH.symm, v_eq_q, stream_q_nth_eq, fr_ne_zero] } } } end lemma coe_stream_rat_eq : diff --git a/src/algebra/continued_fractions/computation/translations.lean b/src/algebra/continued_fractions/computation/translations.lean index 59c53e9b5afe3..424eca916db3e 100644 --- a/src/algebra/continued_fractions/computation/translations.lean +++ b/src/algebra/continued_fractions/computation/translations.lean @@ -8,6 +8,9 @@ import algebra.continued_fractions.translations /-! # Basic Translation Lemmas Between Structures Defined for Computing Continued Fractions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary This is a collection of simple lemmas between the different structures used for the computation @@ -38,6 +41,7 @@ of three sections: namespace generalized_continued_fraction open generalized_continued_fraction (of) +open stream.seq as seq /- Fix a discrete linear ordered floor field and a value `v`. -/ variables {K : Type*} [linear_ordered_field K] [floor_ring K] {v : K} @@ -50,6 +54,8 @@ Here we state some lemmas that give us inversion rules and recurrences for the c stream of integer and fractional parts of a value. -/ +lemma stream_zero (v : K) : int_fract_pair.stream v 0 = some (int_fract_pair.of v) := rfl + variable {n : ℕ} lemma stream_eq_none_of_fr_eq_zero {ifp_n : int_fract_pair K} @@ -68,15 +74,8 @@ parts of a value in case of termination. lemma succ_nth_stream_eq_none_iff : int_fract_pair.stream v (n + 1) = none ↔ (int_fract_pair.stream v n = none ∨ ∃ ifp, int_fract_pair.stream v n = some ifp ∧ ifp.fr = 0) := begin - cases stream_nth_eq : (int_fract_pair.stream v n) with ifp, - case option.none : { simp [stream_nth_eq, int_fract_pair.stream] }, - case option.some : - { cases ifp with _ fr, - by_cases h : fr = 0, -- `finish [int_fract_pair.stream]` closes both goals - { simp [int_fract_pair.stream, h, stream_nth_eq] }, - { suffices : ¬ (int_fract_pair.of fr⁻¹: option $ int_fract_pair K) = none, - by simp [int_fract_pair.stream, h, stream_nth_eq, this], - exact λ h, option.no_confusion h } } + rw [int_fract_pair.stream], + cases int_fract_pair.stream v n; simp [imp_false] end /-- @@ -88,30 +87,26 @@ lemma succ_nth_stream_eq_some_iff {ifp_succ_n : int_fract_pair K} : ↔ ∃ (ifp_n : int_fract_pair K), int_fract_pair.stream v n = some ifp_n ∧ ifp_n.fr ≠ 0 ∧ int_fract_pair.of ifp_n.fr⁻¹ = ifp_succ_n := +by simp [int_fract_pair.stream, ite_eq_iff] + +/-- +An easier to use version of one direction of +`generalized_continued_fraction.int_fract_pair.succ_nth_stream_eq_some_iff`. +-/ +lemma stream_succ_of_some {p : int_fract_pair K} + (h : int_fract_pair.stream v n = some p) (h' : p.fr ≠ 0) : + int_fract_pair.stream v (n + 1) = some (int_fract_pair.of (p.fr)⁻¹) := +succ_nth_stream_eq_some_iff.mpr ⟨p, h, h', rfl⟩ + +/-- +The stream of `int_fract_pair`s of an integer stops after the first term. +-/ +lemma stream_succ_of_int (a : ℤ) (n : ℕ) : int_fract_pair.stream (a : K) (n + 1) = none := begin - split, - { assume stream_succ_nth_eq, - have : int_fract_pair.stream v (n + 1) ≠ none, by simp [stream_succ_nth_eq], - have : ¬int_fract_pair.stream v n = none - ∧ ¬(∃ ifp, int_fract_pair.stream v n = some ifp ∧ ifp.fr = 0), by - { have not_none_not_fract_zero, - from (not_iff_not_of_iff succ_nth_stream_eq_none_iff).elim_left this, - exact (not_or_distrib.elim_left not_none_not_fract_zero) }, - cases this with stream_nth_ne_none nth_fr_ne_zero, - replace nth_fr_ne_zero : ∀ ifp, int_fract_pair.stream v n = some ifp → ifp.fr ≠ 0, by - simpa using nth_fr_ne_zero, - obtain ⟨ifp_n, stream_nth_eq⟩ : ∃ ifp_n, int_fract_pair.stream v n = some ifp_n, from - option.ne_none_iff_exists'.mp stream_nth_ne_none, - existsi ifp_n, - have ifp_n_fr_ne_zero : ifp_n.fr ≠ 0, from nth_fr_ne_zero ifp_n stream_nth_eq, - cases ifp_n with _ ifp_n_fr, - suffices : int_fract_pair.of ifp_n_fr⁻¹ = ifp_succ_n, - by simpa [stream_nth_eq, ifp_n_fr_ne_zero], - simp only [int_fract_pair.stream, stream_nth_eq, ifp_n_fr_ne_zero, option.some_bind, if_false] - at stream_succ_nth_eq, - injection stream_succ_nth_eq }, - { rintro ⟨⟨_⟩, ifp_n_props⟩, -- `finish [int_fract_pair.stream, ifp_n_props]` closes this goal - simpa only [int_fract_pair.stream, ifp_n_props, option.some_bind, if_false] } + induction n with n ih, + { refine int_fract_pair.stream_eq_none_of_fr_eq_zero (int_fract_pair.stream_zero (a : K)) _, + simp only [int_fract_pair.of, int.fract_int_cast], }, + { exact int_fract_pair.succ_nth_stream_eq_none_iff.mpr (or.inl ih), } end lemma exists_succ_nth_stream_of_fr_zero {ifp_succ_n : int_fract_pair K} @@ -121,19 +116,32 @@ lemma exists_succ_nth_stream_of_fr_zero {ifp_succ_n : int_fract_pair K} begin -- get the witness from `succ_nth_stream_eq_some_iff` and prove that it has the additional -- properties - rcases (succ_nth_stream_eq_some_iff.elim_left stream_succ_nth_eq) with - ⟨ifp_n, stream_nth_eq, nth_fr_ne_zero, _⟩, - existsi ifp_n, - cases ifp_n with _ ifp_n_fr, - suffices : ifp_n_fr⁻¹ = ⌊ifp_n_fr⁻¹⌋, by simpa [stream_nth_eq], - have : int_fract_pair.of ifp_n_fr⁻¹ = ifp_succ_n := h_right_right, - cases ifp_succ_n with _ ifp_succ_n_fr, - change ifp_succ_n_fr = 0 at succ_nth_fr_eq_zero, - have : int.fract ifp_n_fr⁻¹ = ifp_succ_n_fr, by injection this, - have : int.fract ifp_n_fr⁻¹ = 0, by rwa [succ_nth_fr_eq_zero] at this, - calc - ifp_n_fr⁻¹ = int.fract ifp_n_fr⁻¹ + ⌊ifp_n_fr⁻¹⌋ : by rw (int.fract_add_floor ifp_n_fr⁻¹) - ... = ⌊ifp_n_fr⁻¹⌋ : by simp [‹int.fract ifp_n_fr⁻¹ = 0›] + rcases (succ_nth_stream_eq_some_iff.mp stream_succ_nth_eq) with + ⟨ifp_n, seq_nth_eq, nth_fr_ne_zero, rfl⟩, + refine ⟨ifp_n, seq_nth_eq, _⟩, + simpa only [int_fract_pair.of, int.fract, sub_eq_zero] using succ_nth_fr_eq_zero +end + +/-- +A recurrence relation that expresses the `(n+1)`th term of the stream of `int_fract_pair`s +of `v` for non-integer `v` in terms of the `n`th term of the stream associated to +the inverse of the fractional part of `v`. +-/ +lemma stream_succ (h : int.fract v ≠ 0) (n : ℕ) : + int_fract_pair.stream v (n + 1) = int_fract_pair.stream (int.fract v)⁻¹ n := +begin + induction n with n ih, + { have H : (int_fract_pair.of v).fr = int.fract v := rfl, + rw [stream_zero, stream_succ_of_some (stream_zero v) (ne_of_eq_of_ne H h), H], }, + { cases eq_or_ne (int_fract_pair.stream (int.fract v)⁻¹ n) none with hnone hsome, + { rw hnone at ih, + rw [succ_nth_stream_eq_none_iff.mpr (or.inl hnone), + succ_nth_stream_eq_none_iff.mpr (or.inl ih)], }, + { obtain ⟨p, hp⟩ := option.ne_none_iff_exists'.mp hsome, + rw hp at ih, + cases eq_or_ne p.fr 0 with hz hnz, + { rw [stream_eq_none_of_fr_eq_zero hp hz, stream_eq_none_of_fr_eq_zero ih hz], }, + { rw [stream_succ_of_some hp hnz, stream_succ_of_some ih hnz], } } } end end int_fract_pair @@ -185,16 +193,11 @@ Let's first show how the termination of one sequence implies the termination of lemma of_terminated_at_iff_int_fract_pair_seq1_terminated_at : (of v).terminated_at n ↔ (int_fract_pair.seq1 v).snd.terminated_at n := -begin - rw [terminated_at_iff_s_none, of], - rcases (int_fract_pair.seq1 v) with ⟨head, ⟨st⟩⟩, - cases st_n_eq : st n; - simp [of, st_n_eq, seq.map, seq.nth, stream.map, seq.terminated_at, stream.nth] -end +option.map_eq_none lemma of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none : (of v).terminated_at n ↔ int_fract_pair.stream v (n + 1) = none := -by rw [of_terminated_at_iff_int_fract_pair_seq1_terminated_at, seq.terminated_at, +by rw [of_terminated_at_iff_int_fract_pair_seq1_terminated_at, stream.seq.terminated_at, int_fract_pair.nth_seq1_eq_succ_nth_stream] end termination @@ -241,9 +244,107 @@ lemma nth_of_eq_some_of_nth_int_fract_pair_stream_fr_ne_zero {ifp_n : int_fract_ (stream_nth_eq : int_fract_pair.stream v n = some ifp_n) (nth_fr_ne_zero : ifp_n.fr ≠ 0) : (of v).s.nth n = some ⟨1, (int_fract_pair.of ifp_n.fr⁻¹).b⟩ := have int_fract_pair.stream v (n + 1) = some (int_fract_pair.of ifp_n.fr⁻¹), by - { cases ifp_n, simp [int_fract_pair.stream, stream_nth_eq, nth_fr_ne_zero], refl }, + { cases ifp_n, simp [int_fract_pair.stream, stream_nth_eq, nth_fr_ne_zero] }, nth_of_eq_some_of_succ_nth_int_fract_pair_stream this +open int int_fract_pair + +lemma of_s_head_aux (v : K) : + (of v).s.nth 0 = (int_fract_pair.stream v 1).bind (some ∘ λ p, {a := 1, b := p.b}) := +begin + rw [of, int_fract_pair.seq1, of._match_1], + simp only [seq.map_tail, seq.map, seq.tail, seq.head, seq.nth, stream.map], + rw [← stream.nth_succ, stream.nth, option.map], +end + +/-- +This gives the first pair of coefficients of the continued fraction of a non-integer `v`. +-/ +lemma of_s_head (h : fract v ≠ 0) : (of v).s.head = some ⟨1, ⌊(fract v)⁻¹⌋⟩ := +begin + change (of v).s.nth 0 = _, + rw [of_s_head_aux, stream_succ_of_some (stream_zero v) h, option.bind], + refl, +end + +variables (K) + +/-- +If `a` is an integer, then the coefficient sequence of its continued fraction is empty. +-/ +lemma of_s_of_int (a : ℤ) : (of (a : K)).s = seq.nil := +begin + have h : ∀ n, (of (a : K)).s.nth n = none, + { intro n, + induction n with n ih, + { rw [of_s_head_aux, stream_succ_of_int, option.bind], }, + { exact (of (a : K)).s.prop ih, } }, + exact seq.ext (λ n, (h n).trans (seq.nth_nil n).symm), +end + +variables {K} (v) + +/-- +Recurrence for the `generalized_continued_fraction.of` an element `v` of `K` in terms of +that of the inverse of the fractional part of `v`. +-/ +lemma of_s_succ (n : ℕ) : (of v).s.nth (n + 1) = (of (fract v)⁻¹).s.nth n := +begin + cases eq_or_ne (fract v) 0 with h h, + { obtain ⟨a, rfl⟩ : ∃ a : ℤ, v = a := ⟨⌊v⌋, eq_of_sub_eq_zero h⟩, + rw [fract_int_cast, inv_zero, of_s_of_int, ← cast_zero, of_s_of_int, seq.nth_nil, + seq.nth_nil], }, + cases eq_or_ne ((of (fract v)⁻¹).s.nth n) none with h₁ h₁, + { rwa [h₁, ← terminated_at_iff_s_none, + of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none, stream_succ h, + ← of_terminated_at_n_iff_succ_nth_int_fract_pair_stream_eq_none, + terminated_at_iff_s_none], }, + { obtain ⟨p, hp⟩ := option.ne_none_iff_exists'.mp h₁, + obtain ⟨p', hp'₁, _⟩ := exists_succ_nth_stream_of_gcf_of_nth_eq_some hp, + have Hp := nth_of_eq_some_of_succ_nth_int_fract_pair_stream hp'₁, + rw [← stream_succ h] at hp'₁, + rw [Hp, nth_of_eq_some_of_succ_nth_int_fract_pair_stream hp'₁], } +end + +/-- +This expresses the tail of the coefficient sequence of the `generalized_continued_fraction.of` +an element `v` of `K` as the coefficient sequence of that of the inverse of the +fractional part of `v`. +-/ +lemma of_s_tail : (of v).s.tail = (of (fract v)⁻¹).s := +seq.ext $ λ n, seq.nth_tail (of v).s n ▸ of_s_succ v n + +variables (K) (n) + +/-- +If `a` is an integer, then the `convergents'` of its continued fraction expansion +are all equal to `a`. +-/ +lemma convergents'_of_int (a : ℤ) : (of (a : K)).convergents' n = a := +begin + induction n with n ih, + { simp only [zeroth_convergent'_eq_h, of_h_eq_floor, floor_int_cast], }, + { rw [convergents', of_h_eq_floor, floor_int_cast, add_right_eq_self], + exact convergents'_aux_succ_none ((of_s_of_int K a).symm ▸ seq.nth_nil 0) _, } +end + +variables {K} (v) + +/-- +The recurrence relation for the `convergents'` of the continued fraction expansion +of an element `v` of `K` in terms of the convergents of the inverse of its fractional part. +-/ +lemma convergents'_succ : + (of v).convergents' (n + 1) = ⌊v⌋ + 1 / (of (fract v)⁻¹).convergents' n := +begin + cases eq_or_ne (fract v) 0 with h h, + { obtain ⟨a, rfl⟩ : ∃ a : ℤ, v = a := ⟨⌊v⌋, eq_of_sub_eq_zero h⟩, + rw [convergents'_of_int, fract_int_cast, inv_zero, ← cast_zero, + convergents'_of_int, cast_zero, div_zero, add_zero, floor_int_cast], }, + { rw [convergents', of_h_eq_floor, add_right_inj, convergents'_aux_succ_some (of_s_head h)], + exact congr_arg ((/) 1) (by rw [convergents', of_h_eq_floor, add_right_inj, of_s_tail]), } +end + end values end sequence end generalized_continued_fraction diff --git a/src/algebra/continued_fractions/continuants_recurrence.lean b/src/algebra/continued_fractions/continuants_recurrence.lean index 0b18d9baff751..e3a6f7bf026d5 100644 --- a/src/algebra/continued_fractions/continuants_recurrence.lean +++ b/src/algebra/continued_fractions/continuants_recurrence.lean @@ -7,6 +7,9 @@ import algebra.continued_fractions.translations /-! # Recurrence Lemmas for the `continuants` Function of Continued Fractions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary Given a generalized continued fraction `g`, for all `n ≥ 1`, we prove that the `continuants` diff --git a/src/algebra/continued_fractions/convergents_equiv.lean b/src/algebra/continued_fractions/convergents_equiv.lean index 7ca1a0ffc43ee..1018b2c393850 100644 --- a/src/algebra/continued_fractions/convergents_equiv.lean +++ b/src/algebra/continued_fractions/convergents_equiv.lean @@ -5,12 +5,15 @@ Authors: Kevin Kappelmann -/ import algebra.continued_fractions.continuants_recurrence import algebra.continued_fractions.terminated_stable -import tactic.linarith import tactic.field_simp +import tactic.ring /-! # Equivalence of Recursive and Direct Computations of `gcf` Convergents +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We show the equivalence of two computations of convergents (recurrence relation (`convergents`) vs. @@ -18,16 +21,13 @@ direct evaluation (`convergents'`)) for `gcf`s on linear ordered fields. We foll [hardy2008introduction], Chapter 10. Here's a sketch: Let `c` be a continued fraction `[h; (a₀, b₀), (a₁, b₁), (a₂, b₂),...]`, visually: - a₀ - h + --------------------------- - a₁ - b₀ + -------------------- - a₂ - b₁ + -------------- - a₃ - b₂ + -------- - b₃ + ... - +$$ + c = h + \dfrac{a_0} + {b_0 + \dfrac{a_1} + {b_1 + \dfrac{a_2} + {b_2 + \dfrac{a_3} + {b_3 + \dots}}}} +$$ One can compute the convergents of `c` in two ways: 1. Directly evaluating the fraction described by `c` up to a given `n` (`convergents'`) 2. Using the recurrence (`convergents`): @@ -68,6 +68,7 @@ fractions, recurrence, equivalence variables {K : Type*} {n : ℕ} namespace generalized_continued_fraction +open stream.seq as seq variables {g : generalized_continued_fraction K} {s : seq $ pair K} @@ -111,7 +112,7 @@ squashed into position `n`. -/ lemma squash_seq_nth_of_not_terminated {gp_n gp_succ_n : pair K} (s_nth_eq : s.nth n = some gp_n) (s_succ_nth_eq : s.nth (n + 1) = some gp_succ_n) : (squash_seq s n).nth n = some ⟨gp_n.a, gp_n.b + gp_succ_n.a / gp_succ_n.b⟩ := -by simp [*, squash_seq, (seq.zip_with_nth_some (seq.nats_nth n) s_nth_eq _)] +by simp [*, squash_seq] /-- The values before the squashed position stay the same. -/ lemma squash_seq_nth_of_lt {m : ℕ} (m_lt_n : m < n) : (squash_seq s n).nth m = s.nth m := @@ -123,8 +124,7 @@ begin s.ge_stable n.le_succ s_succ_nth_eq, obtain ⟨gp_m, s_mth_eq⟩ : ∃ gp_m, s.nth m = some gp_m, from s.ge_stable (le_of_lt m_lt_n) s_nth_eq, - simp [*, squash_seq, (seq.zip_with_nth_some (seq.nats_nth m) s_mth_eq _), - (ne_of_lt m_lt_n)] } + simp [*, squash_seq, m_lt_n.ne] } end /-- Squashing at position `n + 1` and taking the tail is the same as squashing the tail of the @@ -141,19 +141,15 @@ begin { obtain ⟨gp_succ_n, s_succ_nth_eq⟩ : ∃ gp_succ_n, s.nth (n + 1) = some gp_succ_n, from s.ge_stable (n + 1).le_succ s_succ_succ_nth_eq, -- apply extensionality with `m` and continue by cases `m = n`. - ext m, + ext1 m, cases decidable.em (m = n) with m_eq_n m_ne_n, { have : s.tail.nth n = some gp_succ_n, from (s.nth_tail n).trans s_succ_nth_eq, - simp [*, squash_seq, seq.nth_tail, (seq.zip_with_nth_some (seq.nats_nth n) this), - (seq.zip_with_nth_some (seq.nats_nth (n + 1)) s_succ_nth_eq)] }, + simp [*, squash_seq] }, { have : s.tail.nth m = s.nth (m + 1), from s.nth_tail m, cases s_succ_mth_eq : s.nth (m + 1), all_goals { have s_tail_mth_eq, from this.trans s_succ_mth_eq }, - { simp only [*, squash_seq, seq.nth_tail, (seq.zip_with_nth_none' s_succ_mth_eq), - (seq.zip_with_nth_none' s_tail_mth_eq)] }, - { simp [*, squash_seq, seq.nth_tail, - (seq.zip_with_nth_some (seq.nats_nth (m + 1)) s_succ_mth_eq), - (seq.zip_with_nth_some (seq.nats_nth m) s_tail_mth_eq)] } } } + { simp only [*, squash_seq, seq.nth_tail, seq.nth_zip_with, option.map₂_none_right] }, + { simp [*, squash_seq] } } } end /-- The auxiliary function `convergents'_aux` returns the same value for a sequence and the diff --git a/src/algebra/continued_fractions/default.lean b/src/algebra/continued_fractions/default.lean deleted file mode 100644 index 74b9c92c2de58..0000000000000 --- a/src/algebra/continued_fractions/default.lean +++ /dev/null @@ -1,14 +0,0 @@ -/- -Copyright (c) 2019 Kevin Kappelmann. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kevin Kappelmann --/ -import algebra.continued_fractions.basic -import algebra.continued_fractions.translations -import algebra.continued_fractions.continuants_recurrence -import algebra.continued_fractions.terminated_stable -import algebra.continued_fractions.convergents_equiv -import algebra.continued_fractions.computation -/-! -# Default Exports for Continued Fractions --/ diff --git a/src/algebra/continued_fractions/terminated_stable.lean b/src/algebra/continued_fractions/terminated_stable.lean index 2e593c632282f..86e0c340ce6f0 100644 --- a/src/algebra/continued_fractions/terminated_stable.lean +++ b/src/algebra/continued_fractions/terminated_stable.lean @@ -7,12 +7,16 @@ import algebra.continued_fractions.translations /-! # Stabilisation of gcf Computations Under Termination +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We show that the continuants and convergents of a gcf stabilise once the gcf terminates. -/ namespace generalized_continued_fraction +open stream.seq as seq variables {K : Type*} {g : generalized_continued_fraction K} {n m : ℕ} @@ -28,22 +32,14 @@ lemma continuants_aux_stable_step_of_terminated (terminated_at_n : g.terminated_ by { rw [terminated_at_iff_s_none] at terminated_at_n, simp only [terminated_at_n, continuants_aux] } -lemma continuants_aux_stable_of_terminated (succ_n_le_m : (n + 1) ≤ m) +lemma continuants_aux_stable_of_terminated (n_lt_m : n < m) (terminated_at_n : g.terminated_at n) : g.continuants_aux m = g.continuants_aux (n + 1) := begin - induction succ_n_le_m with m succ_n_le_m IH, - { refl }, - { have : g.continuants_aux (m + 1) = g.continuants_aux m, by - { have : n ≤ m - 1, from nat.le_pred_of_lt succ_n_le_m, - have : g.terminated_at (m - 1), from terminated_stable this terminated_at_n, - have stable_step : g.continuants_aux (m - 1 + 2) = g.continuants_aux (m - 1 + 1), from - continuants_aux_stable_step_of_terminated this, - have one_le_m : 1 ≤ m, from nat.one_le_of_lt succ_n_le_m, - have : m - 1 + 2 = m + 2 - 1, from tsub_add_eq_add_tsub one_le_m, - have : m - 1 + 1 = m + 1 - 1, from tsub_add_eq_add_tsub one_le_m, - simpa [*] using stable_step }, - exact (eq.trans this IH) } + refine nat.le_induction rfl (λ k hnk hk, _) _ n_lt_m, + rcases nat.exists_eq_add_of_lt hnk with ⟨k, rfl⟩, + refine (continuants_aux_stable_step_of_terminated _).trans hk, + exact terminated_stable (nat.le_add_right _ _) terminated_at_n end lemma convergents'_aux_stable_step_of_terminated {s : seq $ pair K} @@ -67,18 +63,10 @@ lemma convergents'_aux_stable_of_terminated (terminated_at_n : s.terminated_at n) : convergents'_aux s m = convergents'_aux s n := begin - induction n_le_m with m n_le_m IH generalizing s, + induction n_le_m with m n_le_m IH, { refl }, - { cases s_head_eq : s.head with gp_head, - case option.none { cases n; simp only [convergents'_aux, s_head_eq] }, - case option.some - { have : convergents'_aux s (n + 1) = convergents'_aux s n, from - convergents'_aux_stable_step_of_terminated terminated_at_n, - rw [←this], - have : s.tail.terminated_at n, by - simpa only [seq.terminated_at, seq.nth_tail] using (s.le_stable n.le_succ terminated_at_n), - have : convergents'_aux s.tail m = convergents'_aux s.tail n, from IH this, - simp only [convergents'_aux, s_head_eq, this] } } + { refine (convergents'_aux_stable_step_of_terminated _).trans IH, + exact s.terminated_stable n_le_m terminated_at_n } end lemma continuants_stable_of_terminated (n_le_m : n ≤ m) (terminated_at_n : g.terminated_at n) : diff --git a/src/algebra/continued_fractions/translations.lean b/src/algebra/continued_fractions/translations.lean index 5849efbafcf65..ae7b5a8324b5d 100644 --- a/src/algebra/continued_fractions/translations.lean +++ b/src/algebra/continued_fractions/translations.lean @@ -7,6 +7,9 @@ import algebra.continued_fractions.basic /-! # Basic Translation Lemmas Between Functions Defined for Continued Fractions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary Some simple translation lemmas between the different definitions of functions defined in @@ -14,6 +17,7 @@ Some simple translation lemmas between the different definitions of functions de -/ namespace generalized_continued_fraction +open stream.seq as seq section general /-! @@ -119,5 +123,13 @@ lemma zeroth_convergent'_aux_eq_zero {s : seq $ pair K} : convergents'_aux s 0 = @[simp] lemma zeroth_convergent'_eq_h : g.convergents' 0 = g.h := by simp [convergents'] +lemma convergents'_aux_succ_none {s : seq (pair K)} (h : s.head = none) (n : ℕ) : + convergents'_aux s (n + 1) = 0 := +by rw [convergents'_aux, h, convergents'_aux._match_1] + +lemma convergents'_aux_succ_some {s : seq (pair K)} {p : pair K} (h : s.head = some p) (n : ℕ) : + convergents'_aux s (n + 1) = p.a / (p.b + convergents'_aux s.tail n) := +by rw [convergents'_aux, h, convergents'_aux._match_1] + end with_division_ring end generalized_continued_fraction diff --git a/src/algebra/covariant_and_contravariant.lean b/src/algebra/covariant_and_contravariant.lean index 5a904bd7f3a5a..58b4caf68983b 100644 --- a/src/algebra/covariant_and_contravariant.lean +++ b/src/algebra/covariant_and_contravariant.lean @@ -6,12 +6,15 @@ Authors: Damiano Testa import algebra.group.defs import order.basic -import order.monotone +import order.monotone.basic /-! # Covariants and contravariants +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains general lemmas and instances to work with the interactions between a relation and an action on a Type. @@ -142,11 +145,27 @@ begin exact h a⁻¹ bc } end -@[to_additive] -lemma group.covconv [group N] [covariant_class N N (*) r] : +@[priority 100, to_additive] +instance group.covconv [group N] [covariant_class N N (*) r] : contravariant_class N N (*) r := ⟨group.covariant_iff_contravariant.mp covariant_class.elim⟩ +@[to_additive] +lemma group.covariant_swap_iff_contravariant_swap [group N] : + covariant N N (swap (*)) r ↔ contravariant N N (swap (*)) r := +begin + refine ⟨λ h a b c bc, _, λ h a b c bc, _⟩, + { rw [← mul_inv_cancel_right b a, ← mul_inv_cancel_right c a], + exact h a⁻¹ bc }, + { rw [← mul_inv_cancel_right b a, ← mul_inv_cancel_right c a] at bc, + exact h a⁻¹ bc } +end + +@[priority 100, to_additive] +instance group.covconv_swap [group N] [covariant_class N N (swap (*)) r] : + contravariant_class N N (swap (*)) r := +⟨group.covariant_swap_iff_contravariant_swap.mp covariant_class.elim⟩ + section is_trans variables [is_trans N r] (m n : M) {a b c d : N} diff --git a/src/algebra/cubic_discriminant.lean b/src/algebra/cubic_discriminant.lean index a235d3255df21..505ffb3079eb1 100644 --- a/src/algebra/cubic_discriminant.lean +++ b/src/algebra/cubic_discriminant.lean @@ -4,27 +4,30 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: David Kurniadi Angdinata -/ -import field_theory.splitting_field +import data.polynomial.splits /-! # Cubics and discriminants +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines cubic polynomials over a semiring and their discriminants over a splitting field. ## Main definitions -* `cubic`: the structure representing a cubic polynomial. -* `disc`: the discriminant of a cubic polynomial. + * `cubic`: the structure representing a cubic polynomial. + * `cubic.disc`: the discriminant of a cubic polynomial. ## Main statements -* `disc_ne_zero_iff_roots_nodup`: the cubic discriminant is not equal to zero if and only if - the cubic has no duplicate roots. + * `cubic.disc_ne_zero_iff_roots_nodup`: the cubic discriminant is not equal to zero if and only if + the cubic has no duplicate roots. ## References -* https://en.wikipedia.org/wiki/Cubic_equation -* https://en.wikipedia.org/wiki/Discriminant + * https://en.wikipedia.org/wiki/Cubic_equation + * https://en.wikipedia.org/wiki/Discriminant ## Tags @@ -39,6 +42,7 @@ noncomputable theory namespace cubic open cubic polynomial + open_locale polynomial variables {R S F K : Type*} @@ -49,11 +53,21 @@ instance [has_zero R] : has_zero (cubic R) := ⟨⟨0, 0, 0, 0⟩⟩ section basic -variables {P : cubic R} [semiring R] +variables {P Q : cubic R} {a b c d a' b' c' d' : R} [semiring R] /-- Convert a cubic polynomial to a polynomial. -/ def to_poly (P : cubic R) : R[X] := C P.a * X ^ 3 + C P.b * X ^ 2 + C P.c * X + C P.d +theorem C_mul_prod_X_sub_C_eq [comm_ring S] {w x y z : S} : + C w * (X - C x) * (X - C y) * (X - C z) + = to_poly ⟨w, w * -(x + y + z), w * (x * y + x * z + y * z), w * -(x * y * z)⟩ := +by { simp only [to_poly, C_neg, C_add, C_mul], ring1 } + +theorem prod_X_sub_C_eq [comm_ring S] {x y z : S} : + (X - C x) * (X - C y) * (X - C z) + = to_poly ⟨1, -(x + y + z), (x * y + x * z + y * z), -(x * y * z)⟩ := +by rw [← one_mul $ X - C x, ← C_1, C_mul_prod_X_sub_C_eq, one_mul, one_mul, one_mul] + /-! ### Coefficients -/ section coeff @@ -70,49 +84,55 @@ begin repeat { rw [zero_add] } end -@[simp] lemma coeff_gt_three (n : ℕ) (hn : 3 < n) : P.to_poly.coeff n = 0 := coeffs.1 n hn +@[simp] lemma coeff_eq_zero {n : ℕ} (hn : 3 < n) : P.to_poly.coeff n = 0 := coeffs.1 n hn + +@[simp] lemma coeff_eq_a : P.to_poly.coeff 3 = P.a := coeffs.2.1 + +@[simp] lemma coeff_eq_b : P.to_poly.coeff 2 = P.b := coeffs.2.2.1 + +@[simp] lemma coeff_eq_c : P.to_poly.coeff 1 = P.c := coeffs.2.2.2.1 + +@[simp] lemma coeff_eq_d : P.to_poly.coeff 0 = P.d := coeffs.2.2.2.2 -@[simp] lemma coeff_three : P.to_poly.coeff 3 = P.a := coeffs.2.1 +lemma a_of_eq (h : P.to_poly = Q.to_poly) : P.a = Q.a := by rw [← coeff_eq_a, h, coeff_eq_a] -@[simp] lemma coeff_two : P.to_poly.coeff 2 = P.b := coeffs.2.2.1 +lemma b_of_eq (h : P.to_poly = Q.to_poly) : P.b = Q.b := by rw [← coeff_eq_b, h, coeff_eq_b] -@[simp] lemma coeff_one : P.to_poly.coeff 1 = P.c := coeffs.2.2.2.1 +lemma c_of_eq (h : P.to_poly = Q.to_poly) : P.c = Q.c := by rw [← coeff_eq_c, h, coeff_eq_c] -@[simp] lemma coeff_zero : P.to_poly.coeff 0 = P.d := coeffs.2.2.2.2 +lemma d_of_eq (h : P.to_poly = Q.to_poly) : P.d = Q.d := by rw [← coeff_eq_d, h, coeff_eq_d] -lemma a_of_eq {Q : cubic R} (h : P.to_poly = Q.to_poly) : P.a = Q.a := -by rw [← coeff_three, h, coeff_three] +lemma to_poly_injective (P Q : cubic R) : P.to_poly = Q.to_poly ↔ P = Q := +⟨λ h, ext P Q (a_of_eq h) (b_of_eq h) (c_of_eq h) (d_of_eq h), congr_arg to_poly⟩ -lemma b_of_eq {Q : cubic R} (h : P.to_poly = Q.to_poly) : P.b = Q.b := -by rw [← coeff_two, h, coeff_two] +lemma of_a_eq_zero (ha : P.a = 0) : P.to_poly = C P.b * X ^ 2 + C P.c * X + C P.d := +by rw [to_poly, ha, C_0, zero_mul, zero_add] -lemma c_of_eq {Q : cubic R} (h : P.to_poly = Q.to_poly) : P.c = Q.c := -by rw [← coeff_one, h, coeff_one] +lemma of_a_eq_zero' : to_poly ⟨0, b, c, d⟩ = C b * X ^ 2 + C c * X + C d := of_a_eq_zero rfl -lemma d_of_eq {Q : cubic R} (h : P.to_poly = Q.to_poly) : P.d = Q.d := -by rw [← coeff_zero, h, coeff_zero] +lemma of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly = C P.c * X + C P.d := +by rw [of_a_eq_zero ha, hb, C_0, zero_mul, zero_add] -@[simp] lemma to_poly_injective (P Q : cubic R) : P.to_poly = Q.to_poly ↔ P = Q := -⟨λ h, cubic.ext _ _ (a_of_eq h) (b_of_eq h) (c_of_eq h) (d_of_eq h), congr_arg _⟩ +lemma of_b_eq_zero' : to_poly ⟨0, 0, c, d⟩ = C c * X + C d := of_b_eq_zero rfl rfl -@[simp] lemma of_a_eq_zero (ha : P.a = 0) : P.to_poly = C P.b * X ^ 2 + C P.c * X + C P.d := -by rw [to_poly, C_eq_zero.mpr ha, zero_mul, zero_add] +lemma of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.to_poly = C P.d := +by rw [of_b_eq_zero ha hb, hc, C_0, zero_mul, zero_add] -@[simp] lemma of_a_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly = C P.c * X + C P.d := -by rw [of_a_eq_zero ha, C_eq_zero.mpr hb, zero_mul, zero_add] +lemma of_c_eq_zero' : to_poly ⟨0, 0, 0, d⟩ = C d := of_c_eq_zero rfl rfl rfl -@[simp] lemma of_a_b_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.to_poly = C P.d := -by rw [of_a_b_eq_zero ha hb, C_eq_zero.mpr hc, zero_mul, zero_add] +lemma of_d_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) : + P.to_poly = 0 := +by rw [of_c_eq_zero ha hb hc, hd, C_0] -@[simp] lemma of_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) : P.to_poly = 0 := -by rw [of_a_b_c_eq_zero ha hb hc, C_eq_zero.mpr hd] +lemma of_d_eq_zero' : (⟨0, 0, 0, 0⟩ : cubic R).to_poly = 0 := of_d_eq_zero rfl rfl rfl rfl -@[simp] lemma zero : (0 : cubic R).to_poly = 0 := of_zero rfl rfl rfl rfl +lemma zero : (0 : cubic R).to_poly = 0 := of_d_eq_zero' -@[simp] lemma eq_zero_iff : P.to_poly = 0 ↔ P = 0 := by rw [← zero, to_poly_injective] +lemma to_poly_eq_zero_iff (P : cubic R) : P.to_poly = 0 ↔ P = 0 := +by rw [← zero, to_poly_injective] -lemma ne_zero (h0 : ¬P.a = 0 ∨ ¬P.b = 0 ∨ ¬P.c = 0 ∨ ¬P.d = 0) : P.to_poly ≠ 0 := -by { contrapose! h0, rw [eq_zero_iff.mp h0], exact ⟨rfl, rfl, rfl, rfl⟩ } +private lemma ne_zero (h0 : P.a ≠ 0 ∨ P.b ≠ 0 ∨ P.c ≠ 0 ∨ P.d ≠ 0) : P.to_poly ≠ 0 := +by { contrapose! h0, rw [(to_poly_eq_zero_iff P).mp h0], exact ⟨rfl, rfl, rfl, rfl⟩ } lemma ne_zero_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly ≠ 0 := (or_imp_distrib.mp ne_zero).1 ha @@ -125,6 +145,63 @@ lemma ne_zero_of_c_ne_zero (hc : P.c ≠ 0) : P.to_poly ≠ 0 := lemma ne_zero_of_d_ne_zero (hd : P.d ≠ 0) : P.to_poly ≠ 0 := (or_imp_distrib.mp (or_imp_distrib.mp (or_imp_distrib.mp ne_zero).2).2).2 hd +@[simp] lemma leading_coeff_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.leading_coeff = P.a := +leading_coeff_cubic ha + +@[simp] lemma leading_coeff_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).leading_coeff = a := +leading_coeff_of_a_ne_zero ha + +@[simp] lemma leading_coeff_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : + P.to_poly.leading_coeff = P.b := +by rw [of_a_eq_zero ha, leading_coeff_quadratic hb] + +@[simp] lemma leading_coeff_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).leading_coeff = b := +leading_coeff_of_b_ne_zero rfl hb + +@[simp] lemma leading_coeff_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) : + P.to_poly.leading_coeff = P.c := +by rw [of_b_eq_zero ha hb, leading_coeff_linear hc] + +@[simp] lemma leading_coeff_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).leading_coeff = c := +leading_coeff_of_c_ne_zero rfl rfl hc + +@[simp] lemma leading_coeff_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : + P.to_poly.leading_coeff = P.d := +by rw [of_c_eq_zero ha hb hc, leading_coeff_C] + +@[simp] lemma leading_coeff_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).leading_coeff = d := +leading_coeff_of_c_eq_zero rfl rfl rfl + +lemma monic_of_a_eq_one (ha : P.a = 1) : P.to_poly.monic := +begin + nontriviality, + rw [monic, leading_coeff_of_a_ne_zero $ by { rw [ha], exact one_ne_zero }, ha] +end + +lemma monic_of_a_eq_one' : (to_poly ⟨1, b, c, d⟩).monic := monic_of_a_eq_one rfl + +lemma monic_of_b_eq_one (ha : P.a = 0) (hb : P.b = 1) : P.to_poly.monic := +begin + nontriviality, + rw [monic, leading_coeff_of_b_ne_zero ha $ by { rw [hb], exact one_ne_zero }, hb] +end + +lemma monic_of_b_eq_one' : (to_poly ⟨0, 1, c, d⟩).monic := monic_of_b_eq_one rfl rfl + +lemma monic_of_c_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 1) : P.to_poly.monic := +begin + nontriviality, + rw [monic, leading_coeff_of_c_ne_zero ha hb $ by { rw [hc], exact one_ne_zero }, hc] +end + +lemma monic_of_c_eq_one' : (to_poly ⟨0, 0, 1, d⟩).monic := monic_of_c_eq_one rfl rfl rfl + +lemma monic_of_d_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 1) : + P.to_poly.monic := +by rw [monic, leading_coeff_of_c_eq_zero ha hb hc, hd] + +lemma monic_of_d_eq_one' : (to_poly ⟨0, 0, 0, 1⟩).monic := monic_of_d_eq_one rfl rfl rfl rfl + end coeff /-! ### Degrees -/ @@ -140,38 +217,98 @@ section degree begin ext (_ | _ | _ | _ | n); simp only [subtype.coe_mk, coeffs], have h3 : 3 < n + 4 := by linarith only, - rw [coeff_gt_three _ h3, + rw [coeff_eq_zero h3, (degree_le_iff_coeff_zero (f : R[X]) 3).mp f.2 _ $ with_bot.coe_lt_coe.mpr h3] end } -lemma degree (ha : P.a ≠ 0) : P.to_poly.degree = 3 := degree_cubic ha +@[simp] lemma degree_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.degree = 3 := degree_cubic ha + +@[simp] lemma degree_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).degree = 3 := +degree_of_a_ne_zero ha -lemma degree_of_a_eq_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.degree = 2 := +lemma degree_of_a_eq_zero (ha : P.a = 0) : P.to_poly.degree ≤ 2 := +by simpa only [of_a_eq_zero ha] using degree_quadratic_le + +lemma degree_of_a_eq_zero' : (to_poly ⟨0, b, c, d⟩).degree ≤ 2 := degree_of_a_eq_zero rfl + +@[simp] lemma degree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.degree = 2 := by rw [of_a_eq_zero ha, degree_quadratic hb] -lemma degree_of_a_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) : P.to_poly.degree = 1 := -by rw [of_a_b_eq_zero ha hb, degree_linear hc] +@[simp] lemma degree_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).degree = 2 := +degree_of_b_ne_zero rfl hb + +lemma degree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly.degree ≤ 1 := +by simpa only [of_b_eq_zero ha hb] using degree_linear_le + +lemma degree_of_b_eq_zero' : (to_poly ⟨0, 0, c, d⟩).degree ≤ 1 := degree_of_b_eq_zero rfl rfl -lemma degree_of_a_b_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d ≠ 0) : +@[simp] lemma degree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) : + P.to_poly.degree = 1 := +by rw [of_b_eq_zero ha hb, degree_linear hc] + +@[simp] lemma degree_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).degree = 1 := +degree_of_c_ne_zero rfl rfl hc + +lemma degree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.to_poly.degree ≤ 0 := +by simpa only [of_c_eq_zero ha hb hc] using degree_C_le + +lemma degree_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).degree ≤ 0 := degree_of_c_eq_zero rfl rfl rfl + +@[simp] lemma degree_of_d_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d ≠ 0) : P.to_poly.degree = 0 := -by rw [of_a_b_c_eq_zero ha hb hc, degree_C hd] +by rw [of_c_eq_zero ha hb hc, degree_C hd] -lemma degree_of_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) : +@[simp] lemma degree_of_d_ne_zero' (hd : d ≠ 0) : (to_poly ⟨0, 0, 0, d⟩).degree = 0 := +degree_of_d_ne_zero rfl rfl rfl hd + +@[simp] lemma degree_of_d_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) : P.to_poly.degree = ⊥ := -by rw [of_zero ha hb hc hd, degree_zero] +by rw [of_d_eq_zero ha hb hc hd, degree_zero] -lemma leading_coeff (ha : P.a ≠ 0) : P.to_poly.leading_coeff = P.a := leading_coeff_cubic ha +@[simp] lemma degree_of_d_eq_zero' : (⟨0, 0, 0, 0⟩ : cubic R).to_poly.degree = ⊥ := +degree_of_d_eq_zero rfl rfl rfl rfl -lemma leading_coeff_of_a_eq_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.leading_coeff = P.b := -by rw [of_a_eq_zero ha, leading_coeff_quadratic hb] +@[simp] lemma degree_of_zero : (0 : cubic R).to_poly.degree = ⊥ := degree_of_d_eq_zero' -lemma leading_coeff_of_a_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) : - P.to_poly.leading_coeff = P.c := -by rw [of_a_b_eq_zero ha hb, leading_coeff_linear hc] +@[simp] lemma nat_degree_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.nat_degree = 3 := +nat_degree_cubic ha -lemma leading_coeff_of_a_b_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : - P.to_poly.leading_coeff = P.d := -by rw [of_a_b_c_eq_zero ha hb hc, leading_coeff_C] +@[simp] lemma nat_degree_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).nat_degree = 3 := +nat_degree_of_a_ne_zero ha + +lemma nat_degree_of_a_eq_zero (ha : P.a = 0) : P.to_poly.nat_degree ≤ 2 := +by simpa only [of_a_eq_zero ha] using nat_degree_quadratic_le + +lemma nat_degree_of_a_eq_zero' : (to_poly ⟨0, b, c, d⟩).nat_degree ≤ 2 := +nat_degree_of_a_eq_zero rfl + +@[simp] lemma nat_degree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.nat_degree = 2 := +by rw [of_a_eq_zero ha, nat_degree_quadratic hb] + +@[simp] lemma nat_degree_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).nat_degree = 2 := +nat_degree_of_b_ne_zero rfl hb + +lemma nat_degree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly.nat_degree ≤ 1 := +by simpa only [of_b_eq_zero ha hb] using nat_degree_linear_le + +lemma nat_degree_of_b_eq_zero' : (to_poly ⟨0, 0, c, d⟩).nat_degree ≤ 1 := +nat_degree_of_b_eq_zero rfl rfl + +@[simp] lemma nat_degree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) : + P.to_poly.nat_degree = 1 := +by rw [of_b_eq_zero ha hb, nat_degree_linear hc] + +@[simp] lemma nat_degree_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).nat_degree = 1 := +nat_degree_of_c_ne_zero rfl rfl hc + +@[simp] lemma nat_degree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : + P.to_poly.nat_degree = 0 := +by rw [of_c_eq_zero ha hb hc, nat_degree_C] + +@[simp] lemma nat_degree_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).nat_degree = 0 := +nat_degree_of_c_eq_zero rfl rfl rfl + +@[simp] lemma nat_degree_of_zero : (0 : cubic R).to_poly.nat_degree = 0 := nat_degree_of_c_eq_zero' end degree @@ -233,10 +370,11 @@ section split theorem splits_iff_card_roots (ha : P.a ≠ 0) : splits φ P.to_poly ↔ (map φ P).roots.card = 3 := begin - replace ha : (map φ P).a ≠ 0 := (ring_hom.map_ne_zero φ).mpr ha, + replace ha : (map φ P).a ≠ 0 := (_root_.map_ne_zero φ).mpr ha, nth_rewrite_lhs 0 [← ring_hom.id_comp φ], rw [roots, ← splits_map_iff, ← map_to_poly, splits_iff_card_roots, - ← ((degree_eq_iff_nat_degree_eq $ ne_zero_of_a_ne_zero ha).mp $ degree ha : _ = 3)] + ← ((degree_eq_iff_nat_degree_eq $ ne_zero_of_a_ne_zero ha).mp $ + degree_of_a_ne_zero ha : _ = 3)] end theorem splits_iff_roots_eq_three (ha : P.a ≠ 0) : @@ -247,7 +385,7 @@ theorem eq_prod_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) (map φ P).to_poly = C (φ P.a) * (X - C x) * (X - C y) * (X - C z) := begin rw [map_to_poly, eq_prod_roots_of_splits $ (splits_iff_roots_eq_three ha).mpr $ exists.intro x $ - exists.intro y $ exists.intro z h3, leading_coeff ha, ← map_roots, h3], + exists.intro y $ exists.intro z h3, leading_coeff_of_a_ne_zero ha, ← map_roots, h3], change C (φ P.a) * ((X - C x) ::ₘ (X - C y) ::ₘ {X - C z}).prod = _, rw [prod_cons, prod_cons, prod_singleton, mul_assoc, mul_assoc] end @@ -257,9 +395,7 @@ theorem eq_sum_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) begin apply_fun to_poly, any_goals { exact λ P Q, (to_poly_injective P Q).mp }, - rw [eq_prod_three_roots ha h3, to_poly], - simp only [C_neg, C_add, C_mul], - ring1 + rw [eq_prod_three_roots ha h3, C_mul_prod_X_sub_C_eq] end theorem b_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) : @@ -297,10 +433,8 @@ end theorem disc_ne_zero_iff_roots_ne (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) : P.disc ≠ 0 ↔ x ≠ y ∧ x ≠ z ∧ y ≠ z := begin - rw [← ring_hom.map_ne_zero φ, disc_eq_prod_three_roots ha h3, pow_two], - simp only [mul_ne_zero_iff, sub_ne_zero], - rw [ring_hom.map_ne_zero], - tautology + rw [←_root_.map_ne_zero φ, disc_eq_prod_three_roots ha h3, pow_two], + simp_rw [mul_ne_zero_iff, sub_ne_zero, _root_.map_ne_zero, and_self, and_iff_right ha, and_assoc], end theorem disc_ne_zero_iff_roots_nodup (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) : diff --git a/src/algebra/default.lean b/src/algebra/default.lean deleted file mode 100644 index a3d2c358a9bfc..0000000000000 --- a/src/algebra/default.lean +++ /dev/null @@ -1,2 +0,0 @@ -import algebra.group -import algebra.module.basic diff --git a/src/algebra/direct_limit.lean b/src/algebra/direct_limit.lean index 9c55402b38d1b..e30343ee0cee8 100644 --- a/src/algebra/direct_limit.lean +++ b/src/algebra/direct_limit.lean @@ -6,10 +6,13 @@ Authors: Kenny Lau, Chris Hughes import data.finset.order import algebra.direct_sum.module import ring_theory.free_comm_ring -import ring_theory.ideal.operations +import ring_theory.ideal.quotient /-! # Direct limit of modules, abelian groups, rings, and fields. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + See Atiyah-Macdonald PP.32-33, Matsumura PP.269-270 Generalizes the notion of "union", or "gluing", of incomparable modules over the same ring, diff --git a/src/algebra/direct_sum/algebra.lean b/src/algebra/direct_sum/algebra.lean index 1e58cc310470a..e08cc480379f0 100644 --- a/src/algebra/direct_sum/algebra.lean +++ b/src/algebra/direct_sum/algebra.lean @@ -9,6 +9,9 @@ import algebra.direct_sum.ring /-! # Additively-graded algebra structures on `⨁ i, A i` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides `R`-algebra structures on external direct sums of `R`-modules. Recall that if `A i` are a family of `add_comm_monoid`s indexed by an `add_monoid`, then an instance diff --git a/src/algebra/direct_sum/basic.lean b/src/algebra/direct_sum/basic.lean index 7ffa3730b81b8..181c4a6c7f016 100644 --- a/src/algebra/direct_sum/basic.lean +++ b/src/algebra/direct_sum/basic.lean @@ -5,10 +5,12 @@ Authors: Kenny Lau -/ import data.dfinsupp.basic import group_theory.submonoid.operations -import group_theory.subgroup.basic /-! # Direct sum +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the direct sum of abelian groups, indexed by a discrete type. ## Notation @@ -36,7 +38,8 @@ def direct_sum [Π i, add_comm_monoid (β i)] : Type* := Π₀ i, β i instance [Π i, add_comm_monoid (β i)] : has_coe_to_fun (direct_sum ι β) (λ _, Π i : ι, β i) := dfinsupp.has_coe_to_fun -localized "notation `⨁` binders `, ` r:(scoped f, direct_sum _ f) := r" in direct_sum +localized "notation (name := direct_sum) + `⨁` binders `, ` r:(scoped f, direct_sum _ f) := r" in direct_sum namespace direct_sum @@ -49,8 +52,7 @@ variables [Π i, add_comm_group (β i)] instance : add_comm_group (direct_sum ι β) := dfinsupp.add_comm_group variables {β} -@[simp] lemma sub_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ - g₂) i = g₁ i - g₂ i := -dfinsupp.sub_apply _ _ _ +@[simp] lemma sub_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ - g₂) i = g₁ i - g₂ i := rfl end add_comm_group @@ -59,8 +61,7 @@ variables [Π i, add_comm_monoid (β i)] @[simp] lemma zero_apply (i : ι) : (0 : ⨁ i, β i) i = 0 := rfl variables {β} -@[simp] lemma add_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ + g₂) i = g₁ i + g₂ i := -dfinsupp.add_apply _ _ _ +@[simp] lemma add_apply (g₁ g₂ : ⨁ i, β i) (i : ι) : (g₁ + g₂) i = g₁ i + g₂ i := rfl variables (β) include dec_ι @@ -178,8 +179,10 @@ variables {β} omit dec_ι +instance unique [∀ i, subsingleton (β i)] : unique (⨁ i, β i) := dfinsupp.unique + /-- A direct sum over an empty type is trivial. -/ -instance [is_empty ι] : unique (⨁ i, β i) := dfinsupp.unique +instance unique_of_is_empty [is_empty ι] : unique (⨁ i, β i) := dfinsupp.unique_of_is_empty /-- The natural equivalence between `⨁ _ : ι, M` and `M` when `unique ι`. -/ protected def id (M : Type v) (ι : Type* := punit) [add_comm_monoid M] [unique ι] : @@ -223,95 +226,69 @@ variables {α : ι → Type u} {δ : Π i, α i → Type w} [Π i j, add_comm_mo noncomputable def sigma_curry : (⨁ (i : Σ i, _), δ i.1 i.2) →+ ⨁ i j, δ i j := { to_fun := @dfinsupp.sigma_curry _ _ δ _, map_zero' := dfinsupp.sigma_curry_zero, - map_add' := λ f g, dfinsupp.sigma_curry_add f g } + map_add' := λ f g, @dfinsupp.sigma_curry_add _ _ δ _ f g } @[simp] lemma sigma_curry_apply (f : ⨁ (i : Σ i, _), δ i.1 i.2) (i : ι) (j : α i) : - sigma_curry f i j = f ⟨i, j⟩ := dfinsupp.sigma_curry_apply f i j + sigma_curry f i j = f ⟨i, j⟩ := @dfinsupp.sigma_curry_apply _ _ δ _ f i j /--The natural map between `⨁ i (j : α i), δ i j` and `Π₀ (i : Σ i, α i), δ i.1 i.2`, inverse of `curry`.-/ -noncomputable def sigma_uncurry : (⨁ i j, δ i j) →+ ⨁ (i : Σ i, _), δ i.1 i.2 := +def sigma_uncurry [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] : + (⨁ i j, δ i j) →+ ⨁ (i : Σ i, _), δ i.1 i.2 := { to_fun := dfinsupp.sigma_uncurry, map_zero' := dfinsupp.sigma_uncurry_zero, map_add' := dfinsupp.sigma_uncurry_add } -@[simp] lemma sigma_uncurry_apply (f : ⨁ i j, δ i j) (i : ι) (j : α i) : +@[simp] lemma sigma_uncurry_apply [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] + (f : ⨁ i j, δ i j) (i : ι) (j : α i) : sigma_uncurry f ⟨i, j⟩ = f i j := dfinsupp.sigma_uncurry_apply f i j /--The natural map between `⨁ (i : Σ i, α i), δ i.1 i.2` and `⨁ i (j : α i), δ i j`.-/ -noncomputable def sigma_curry_equiv : (⨁ (i : Σ i, _), δ i.1 i.2) ≃+ ⨁ i j, δ i j := +noncomputable def sigma_curry_equiv + [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] : + (⨁ (i : Σ i, _), δ i.1 i.2) ≃+ ⨁ i j, δ i j := { ..sigma_curry, ..dfinsupp.sigma_curry_equiv } end sigma /-- The canonical embedding from `⨁ i, A i` to `M` where `A` is a collection of `add_submonoid M` -indexed by `ι`-/ -def add_submonoid_coe {M : Type*} [decidable_eq ι] [add_comm_monoid M] - (A : ι → add_submonoid M) : (⨁ i, A i) →+ M := -to_add_monoid (λ i, (A i).subtype) - -@[simp] lemma add_submonoid_coe_of {M : Type*} [decidable_eq ι] [add_comm_monoid M] - (A : ι → add_submonoid M) (i : ι) (x : A i) : - add_submonoid_coe A (of (λ i, A i) i x) = x := +indexed by `ι`. + +When `S = submodule _ M`, this is available as a `linear_map`, `direct_sum.coe_linear_map`. -/ +protected def coe_add_monoid_hom {M S : Type*} [decidable_eq ι] [add_comm_monoid M] + [set_like S M] [add_submonoid_class S M] (A : ι → S) : (⨁ i, A i) →+ M := +to_add_monoid (λ i, add_submonoid_class.subtype (A i)) + +@[simp] lemma coe_add_monoid_hom_of {M S : Type*} [decidable_eq ι] [add_comm_monoid M] + [set_like S M] [add_submonoid_class S M] (A : ι → S) (i : ι) (x : A i) : + direct_sum.coe_add_monoid_hom A (of (λ i, A i) i x) = x := to_add_monoid_of _ _ _ -lemma coe_of_add_submonoid_apply {M : Type*} [decidable_eq ι] [add_comm_monoid M] - {A : ι → add_submonoid M} (i j : ι) (x : A i) : +lemma coe_of_apply {M S : Type*} [decidable_eq ι] [add_comm_monoid M] + [set_like S M] [add_submonoid_class S M] {A : ι → S} (i j : ι) (x : A i) : (of _ i x j : M) = if i = j then x else 0 := begin obtain rfl | h := decidable.eq_or_ne i j, { rw [direct_sum.of_eq_same, if_pos rfl], }, - { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, add_submonoid.coe_zero], }, + { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, zero_mem_class.coe_zero], }, end -/-- The `direct_sum` formed by a collection of `add_submonoid`s of `M` is said to be internal if the -canonical map `(⨁ i, A i) →+ M` is bijective. +/-- The `direct_sum` formed by a collection of additive submonoids (or subgroups, or submodules) of +`M` is said to be internal if the canonical map `(⨁ i, A i) →+ M` is bijective. -See `direct_sum.add_subgroup_is_internal` for the same statement about `add_subgroup`s. -/ -def add_submonoid_is_internal {M : Type*} [decidable_eq ι] [add_comm_monoid M] - (A : ι → add_submonoid M) : Prop := -function.bijective (add_submonoid_coe A) +For the alternate statement in terms of independence and spanning, see +`direct_sum.subgroup_is_internal_iff_independent_and_supr_eq_top` and +`direct_sum.is_internal_submodule_iff_independent_and_supr_eq_top`. -/ +def is_internal {M S : Type*} [decidable_eq ι] [add_comm_monoid M] + [set_like S M] [add_submonoid_class S M] (A : ι → S) : Prop := +function.bijective (direct_sum.coe_add_monoid_hom A) -lemma add_submonoid_is_internal.supr_eq_top {M : Type*} [decidable_eq ι] [add_comm_monoid M] +lemma is_internal.add_submonoid_supr_eq_top {M : Type*} [decidable_eq ι] [add_comm_monoid M] (A : ι → add_submonoid M) - (h : add_submonoid_is_internal A) : supr A = ⊤ := + (h : is_internal A) : supr A = ⊤ := begin rw [add_submonoid.supr_eq_mrange_dfinsupp_sum_add_hom, add_monoid_hom.mrange_top_iff_surjective], exact function.bijective.surjective h, end -/-- The canonical embedding from `⨁ i, A i` to `M` where `A` is a collection of `add_subgroup M` -indexed by `ι`-/ -def add_subgroup_coe {M : Type*} [decidable_eq ι] [add_comm_group M] - (A : ι → add_subgroup M) : (⨁ i, A i) →+ M := -to_add_monoid (λ i, (A i).subtype) - -@[simp] lemma add_subgroup_coe_of {M : Type*} [decidable_eq ι] [add_comm_group M] - (A : ι → add_subgroup M) (i : ι) (x : A i) : - add_subgroup_coe A (of (λ i, A i) i x) = x := -to_add_monoid_of _ _ _ - -lemma coe_of_add_subgroup_apply {M : Type*} [decidable_eq ι] [add_comm_group M] - {A : ι → add_subgroup M} (i j : ι) (x : A i) : - (of _ i x j : M) = if i = j then x else 0 := -begin - obtain rfl | h := decidable.eq_or_ne i j, - { rw [direct_sum.of_eq_same, if_pos rfl], }, - { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, add_subgroup.coe_zero], }, -end - -/-- The `direct_sum` formed by a collection of `add_subgroup`s of `M` is said to be internal if the -canonical map `(⨁ i, A i) →+ M` is bijective. - -See `direct_sum.submodule_is_internal` for the same statement about `submodules`s. -/ -def add_subgroup_is_internal {M : Type*} [decidable_eq ι] [add_comm_group M] - (A : ι → add_subgroup M) : Prop := -function.bijective (add_subgroup_coe A) - -lemma add_subgroup_is_internal.to_add_submonoid - {M : Type*} [decidable_eq ι] [add_comm_group M] (A : ι → add_subgroup M) : - add_subgroup_is_internal A ↔ - add_submonoid_is_internal (λ i, (A i).to_add_submonoid) := -iff.rfl - end direct_sum diff --git a/src/algebra/direct_sum/decomposition.lean b/src/algebra/direct_sum/decomposition.lean new file mode 100644 index 0000000000000..de748982c5c8c --- /dev/null +++ b/src/algebra/direct_sum/decomposition.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser, Jujian Zhang +-/ +import algebra.direct_sum.module +import algebra.module.submodule.basic + +/-! +# Decompositions of additive monoids, groups, and modules into direct sums + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `direct_sum.decomposition ℳ`: A typeclass to provide a constructive decomposition from + an additive monoid `M` into a family of additive submonoids `ℳ` +* `direct_sum.decompose ℳ`: The canonical equivalence provided by the above typeclass + + +## Main statements + +* `direct_sum.decomposition.is_internal`: The link to `direct_sum.is_internal`. + +## Implementation details + +As we want to talk about different types of decomposition (additive monoids, modules, rings, ...), +we choose to avoid heavily bundling `direct_sum.decompose`, instead making copies for the +`add_equiv`, `linear_equiv`, etc. This means we have to repeat statements that follow from these +bundled homs, but means we don't have to repeat statements for different types of decomposition. +-/ + + +variables {ι R M σ : Type*} +open_locale direct_sum big_operators +namespace direct_sum + +section add_comm_monoid +variables [decidable_eq ι] [add_comm_monoid M] +variables [set_like σ M] [add_submonoid_class σ M] (ℳ : ι → σ) + +/-- A decomposition is an equivalence between an additive monoid `M` and a direct sum of additive +submonoids `ℳ i` of that `M`, such that the "recomposition" is canonical. This definition also +works for additive groups and modules. + +This is a version of `direct_sum.is_internal` which comes with a constructive inverse to the +canonical "recomposition" rather than just a proof that the "recomposition" is bijective. -/ +class decomposition := +(decompose' : M → ⨁ i, ℳ i) +(left_inv : function.left_inverse (direct_sum.coe_add_monoid_hom ℳ) decompose' ) +(right_inv : function.right_inverse (direct_sum.coe_add_monoid_hom ℳ) decompose') + +include M + +/-- `direct_sum.decomposition` instances, while carrying data, are always equal. -/ +instance : subsingleton (decomposition ℳ) := +⟨λ x y, begin + cases x with x xl xr, + cases y with y yl yr, + congr', + exact function.left_inverse.eq_right_inverse xr yl, +end⟩ + +variables [decomposition ℳ] + +protected lemma decomposition.is_internal : direct_sum.is_internal ℳ := +⟨decomposition.right_inv.injective, decomposition.left_inv.surjective⟩ + +/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as +to a direct sum of components. This is the canonical spelling of the `decompose'` field. -/ +def decompose : M ≃ ⨁ i, ℳ i := +{ to_fun := decomposition.decompose', + inv_fun := direct_sum.coe_add_monoid_hom ℳ, + left_inv := decomposition.left_inv, + right_inv := decomposition.right_inv } + +protected lemma decomposition.induction_on {p : M → Prop} + (h_zero : p 0) (h_homogeneous : ∀ {i} (m : ℳ i), p (m : M)) + (h_add : ∀ (m m' : M), p m → p m' → p (m + m')) : ∀ m, p m := +begin + let ℳ' : ι → add_submonoid M := + λ i, (⟨ℳ i, λ _ _, add_mem_class.add_mem, zero_mem_class.zero_mem _⟩ : add_submonoid M), + haveI t : direct_sum.decomposition ℳ' := + { decompose' := direct_sum.decompose ℳ, + left_inv := λ _, (decompose ℳ).left_inv _, + right_inv := λ _, (decompose ℳ).right_inv _, }, + have mem : ∀ m, m ∈ supr ℳ' := + λ m, (direct_sum.is_internal.add_submonoid_supr_eq_top ℳ' + (decomposition.is_internal ℳ')).symm ▸ trivial, + exact λ m, add_submonoid.supr_induction ℳ' (mem m) (λ i m h, h_homogeneous ⟨m, h⟩) h_zero h_add, +end + +@[simp] lemma decomposition.decompose'_eq : decomposition.decompose' = decompose ℳ := rfl + +@[simp] lemma decompose_symm_of {i : ι} (x : ℳ i) : + (decompose ℳ).symm (direct_sum.of _ i x) = x := +direct_sum.coe_add_monoid_hom_of ℳ _ _ + +@[simp] lemma decompose_coe {i : ι} (x : ℳ i) : + decompose ℳ (x : M) = direct_sum.of _ i x := +by rw [←decompose_symm_of, equiv.apply_symm_apply] + +lemma decompose_of_mem {x : M} {i : ι} (hx : x ∈ ℳ i) : + decompose ℳ x = direct_sum.of (λ i, ℳ i) i ⟨x, hx⟩ := +decompose_coe _ ⟨x, hx⟩ + +lemma decompose_of_mem_same {x : M} {i : ι} (hx : x ∈ ℳ i) : + (decompose ℳ x i : M) = x := +by rw [decompose_of_mem _ hx, direct_sum.of_eq_same, subtype.coe_mk] + +lemma decompose_of_mem_ne {x : M} {i j : ι} (hx : x ∈ ℳ i) (hij : i ≠ j): + (decompose ℳ x j : M) = 0 := +by rw [decompose_of_mem _ hx, direct_sum.of_eq_of_ne _ _ _ _ hij, + zero_mem_class.coe_zero] + +/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as +an additive monoid to a direct sum of components. -/ +@[simps {fully_applied := ff}] +def decompose_add_equiv : M ≃+ ⨁ i, ℳ i := add_equiv.symm +{ map_add' := map_add (direct_sum.coe_add_monoid_hom ℳ), + ..(decompose ℳ).symm } + +@[simp] lemma decompose_zero : decompose ℳ (0 : M) = 0 := map_zero (decompose_add_equiv ℳ) +@[simp] lemma decompose_symm_zero : (decompose ℳ).symm 0 = (0 : M) := +map_zero (decompose_add_equiv ℳ).symm + +@[simp] lemma decompose_add (x y : M) : decompose ℳ (x + y) = decompose ℳ x + decompose ℳ y := +map_add (decompose_add_equiv ℳ) x y +@[simp] lemma decompose_symm_add (x y : ⨁ i, ℳ i) : + (decompose ℳ).symm (x + y) = (decompose ℳ).symm x + (decompose ℳ).symm y := +map_add (decompose_add_equiv ℳ).symm x y + +@[simp] lemma decompose_sum {ι'} (s : finset ι') (f : ι' → M) : + decompose ℳ (∑ i in s, f i) = ∑ i in s, decompose ℳ (f i) := +map_sum (decompose_add_equiv ℳ) f s +@[simp] lemma decompose_symm_sum {ι'} (s : finset ι') (f : ι' → ⨁ i, ℳ i) : + (decompose ℳ).symm (∑ i in s, f i) = ∑ i in s, (decompose ℳ).symm (f i) := +map_sum (decompose_add_equiv ℳ).symm f s + +lemma sum_support_decompose [Π i (x : ℳ i), decidable (x ≠ 0)] (r : M) : + ∑ i in (decompose ℳ r).support, (decompose ℳ r i : M) = r := +begin + conv_rhs { rw [←(decompose ℳ).symm_apply_apply r, + ←sum_support_of (λ i, (ℳ i)) (decompose ℳ r)] }, + rw [decompose_symm_sum], + simp_rw decompose_symm_of, +end + +end add_comm_monoid + +/-- The `-` in the statements below doesn't resolve without this line. + +This seems to a be a problem of synthesized vs inferred typeclasses disagreeing. If we replace +the statement of `decompose_neg` with `@eq (⨁ i, ℳ i) (decompose ℳ (-x)) (-decompose ℳ x)` +instead of `decompose ℳ (-x) = -decompose ℳ x`, which forces the typeclasses needed by `⨁ i, ℳ i` to +be found by unification rather than synthesis, then everything works fine without this instance. -/ +instance add_comm_group_set_like [add_comm_group M] [set_like σ M] [add_subgroup_class σ M] + (ℳ : ι → σ) : add_comm_group (⨁ i, ℳ i) := by apply_instance + +section add_comm_group +variables [decidable_eq ι] [add_comm_group M] +variables [set_like σ M] [add_subgroup_class σ M] (ℳ : ι → σ) +variables [decomposition ℳ] +include M + +@[simp] lemma decompose_neg (x : M) : decompose ℳ (-x) = -decompose ℳ x := +map_neg (decompose_add_equiv ℳ) x +@[simp] lemma decompose_symm_neg (x : ⨁ i, ℳ i) : + (decompose ℳ).symm (-x) = -(decompose ℳ).symm x := +map_neg (decompose_add_equiv ℳ).symm x + +@[simp] lemma decompose_sub (x y : M) : decompose ℳ (x - y) = decompose ℳ x - decompose ℳ y := +map_sub (decompose_add_equiv ℳ) x y +@[simp] lemma decompose_symm_sub (x y : ⨁ i, ℳ i) : + (decompose ℳ).symm (x - y) = (decompose ℳ).symm x - (decompose ℳ).symm y := +map_sub (decompose_add_equiv ℳ).symm x y + +end add_comm_group + +section module +variables [decidable_eq ι] [semiring R] [add_comm_monoid M] [module R M] +variables (ℳ : ι → submodule R M) +variables [decomposition ℳ] +include M + +/-- If `M` is graded by `ι` with degree `i` component `ℳ i`, then it is isomorphic as +a module to a direct sum of components. -/ +@[simps {fully_applied := ff}] +def decompose_linear_equiv : M ≃ₗ[R] ⨁ i, ℳ i := linear_equiv.symm +{ map_smul' := map_smul (direct_sum.coe_linear_map ℳ), + ..(decompose_add_equiv ℳ).symm } + +@[simp] lemma decompose_smul (r : R) (x : M) : decompose ℳ (r • x) = r • decompose ℳ x := +map_smul (decompose_linear_equiv ℳ) r x + +end module + +end direct_sum diff --git a/src/algebra/direct_sum/finsupp.lean b/src/algebra/direct_sum/finsupp.lean index 279482cfa0cb2..e5ba9086e4008 100644 --- a/src/algebra/direct_sum/finsupp.lean +++ b/src/algebra/direct_sum/finsupp.lean @@ -9,6 +9,9 @@ import data.finsupp.to_dfinsupp /-! # Results on direct sums and finitely supported functions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + 1. The linear equivalence between finitely supported functions `ι →₀ M` and the direct sum of copies of `M` indexed by `ι`. -/ diff --git a/src/algebra/direct_sum/internal.lean b/src/algebra/direct_sum/internal.lean index b02cc3edd749a..dc481b2926173 100644 --- a/src/algebra/direct_sum/internal.lean +++ b/src/algebra/direct_sum/internal.lean @@ -11,27 +11,29 @@ import algebra.direct_sum.algebra /-! # Internally graded rings and algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides `gsemiring` and `gcomm_semiring` instances for a collection of subobjects `A` when a `set_like.graded_monoid` instance is available: -* on `add_submonoid R`s: `add_submonoid.gsemiring`, `add_submonoid.gcomm_semiring`. -* on `add_subgroup R`s: `add_subgroup.gsemiring`, `add_subgroup.gcomm_semiring`. -* on `submodule S R`s: `submodule.gsemiring`, `submodule.gcomm_semiring`. +* `set_like.gnon_unital_non_assoc_semiring` +* `set_like.gsemiring` +* `set_like.gcomm_semiring` With these instances in place, it provides the bundled canonical maps out of a direct sum of subobjects into their carrier type: -* `direct_sum.add_submonoid_coe_ring_hom` (a `ring_hom` version of `direct_sum.add_submonoid_coe`) -* `direct_sum.add_subgroup_coe_ring_hom` (a `ring_hom` version of `direct_sum.add_subgroup_coe`) -* `direct_sum.submodule_coe_alg_hom` (an `alg_hom` version of `direct_sum.submodule_coe`) +* `direct_sum.coe_ring_hom` (a `ring_hom` version of `direct_sum.coe_add_monoid_hom`) +* `direct_sum.coe_alg_hom` (an `alg_hom` version of `direct_sum.submodule_coe`) Strictly the definitions in this file are not sufficient to fully define an "internal" direct sum; -to represent this case, `(h : direct_sum.submodule_is_internal A) [set_like.graded_monoid A]` is +to represent this case, `(h : direct_sum.is_internal A) [set_like.graded_monoid A]` is needed. In the future there will likely be a data-carrying, constructive, typeclass version of -`direct_sum.submodule_is_internal` for providing an explicit decomposition function. +`direct_sum.is_internal` for providing an explicit decomposition function. When `complete_lattice.independent (set.range A)` (a weaker condition than -`direct_sum.submodule_is_internal A`), these provide a grading of `⨆ i, A i`, and the +`direct_sum.is_internal A`), these provide a grading of `⨆ i, A i`, and the mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as `direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`. @@ -42,134 +44,240 @@ internally graded ring open_locale direct_sum big_operators -variables {ι : Type*} {S R : Type*} +variables {ι : Type*} {σ S R : Type*} + +instance add_comm_monoid.of_submonoid_on_semiring [semiring R] [set_like σ R] + [add_submonoid_class σ R] (A : ι → σ) : ∀ i, add_comm_monoid (A i) := +λ i, by apply_instance + +instance add_comm_group.of_subgroup_on_ring [ring R] [set_like σ R] + [add_subgroup_class σ R] (A : ι → σ) : ∀ i, add_comm_group (A i) := +λ i, by apply_instance -lemma set_like.has_graded_one.algebra_map_mem [has_zero ι] +lemma set_like.algebra_map_mem_graded [has_zero ι] [comm_semiring S] [semiring R] [algebra S R] (A : ι → submodule S R) [set_like.has_graded_one A] (s : S) : algebra_map S R s ∈ A 0 := begin rw algebra.algebra_map_eq_smul_one, - exact ((A 0).smul_mem s set_like.has_graded_one.one_mem), + exact ((A 0).smul_mem s $ set_like.one_mem_graded _), +end + +lemma set_like.nat_cast_mem_graded [has_zero ι] [add_monoid_with_one R] + [set_like σ R] [add_submonoid_class σ R] (A : ι → σ) [set_like.has_graded_one A] (n : ℕ) : + (n : R) ∈ A 0 := +begin + induction n, + { rw nat.cast_zero, + exact zero_mem (A 0), }, + { rw nat.cast_succ, + exact add_mem n_ih (set_like.one_mem_graded _), }, +end + +lemma set_like.int_cast_mem_graded [has_zero ι] [add_group_with_one R] + [set_like σ R] [add_subgroup_class σ R] (A : ι → σ) [set_like.has_graded_one A] (z : ℤ) : + (z : R) ∈ A 0:= +begin + induction z, + { rw int.cast_of_nat, + exact set_like.nat_cast_mem_graded _ _, }, + { rw int.cast_neg_succ_of_nat, + exact neg_mem (set_like.nat_cast_mem_graded _ _), }, end section direct_sum variables [decidable_eq ι] -/-! #### From `add_submonoid`s -/ +/-! #### From `add_submonoid`s and `add_subgroup`s -/ -namespace add_submonoid +namespace set_like + +/-- Build a `gnon_unital_non_assoc_semiring` instance for a collection of additive submonoids. -/ +instance gnon_unital_non_assoc_semiring [has_add ι] [non_unital_non_assoc_semiring R] + [set_like σ R] [add_submonoid_class σ R] + (A : ι → σ) [set_like.has_graded_mul A] : + direct_sum.gnon_unital_non_assoc_semiring (λ i, A i) := +{ mul_zero := λ i j _, subtype.ext (mul_zero _), + zero_mul := λ i j _, subtype.ext (zero_mul _), + mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _), + add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _), + ..set_like.ghas_mul A } -/-- Build a `gsemiring` instance for a collection of `add_submonoid`s. -/ -instance gsemiring [add_monoid ι] [semiring R] - (A : ι → add_submonoid R) [set_like.graded_monoid A] : +/-- Build a `gsemiring` instance for a collection of additive submonoids. -/ +instance gsemiring [add_monoid ι] [semiring R] [set_like σ R] [add_submonoid_class σ R] + (A : ι → σ) [set_like.graded_monoid A] : direct_sum.gsemiring (λ i, A i) := { mul_zero := λ i j _, subtype.ext (mul_zero _), zero_mul := λ i j _, subtype.ext (zero_mul _), mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _), add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _), + nat_cast := λ n, ⟨n, set_like.nat_cast_mem_graded _ _⟩, + nat_cast_zero := subtype.ext nat.cast_zero, + nat_cast_succ := λ n, subtype.ext (nat.cast_succ n), ..set_like.gmonoid A } -/-- Build a `gcomm_semiring` instance for a collection of `add_submonoid`s. -/ -instance gcomm_semiring [add_comm_monoid ι] [comm_semiring R] - (A : ι → add_submonoid R) [set_like.graded_monoid A] : +/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/ +instance gcomm_semiring [add_comm_monoid ι] [comm_semiring R] [set_like σ R] + [add_submonoid_class σ R] (A : ι → σ) [set_like.graded_monoid A] : direct_sum.gcomm_semiring (λ i, A i) := { ..set_like.gcomm_monoid A, - ..add_submonoid.gsemiring A, } + ..set_like.gsemiring A, } + +/-- Build a `gring` instance for a collection of additive subgroups. -/ +instance gring [add_monoid ι] [ring R] [set_like σ R] [add_subgroup_class σ R] + (A : ι → σ) [set_like.graded_monoid A] : + direct_sum.gring (λ i, A i) := +{ int_cast := λ z, ⟨z, set_like.int_cast_mem_graded _ _⟩, + int_cast_of_nat := λ n, subtype.ext $ int.cast_of_nat _, + int_cast_neg_succ_of_nat := λ n, subtype.ext $ int.cast_neg_succ_of_nat n, + ..set_like.gsemiring A } + +/-- Build a `gcomm_semiring` instance for a collection of additive submonoids. -/ +instance gcomm_ring [add_comm_monoid ι] [comm_ring R] [set_like σ R] + [add_subgroup_class σ R] (A : ι → σ) [set_like.graded_monoid A] : + direct_sum.gcomm_ring (λ i, A i) := +{ ..set_like.gcomm_monoid A, + ..set_like.gring A, } + +end set_like + +namespace direct_sum + +section coe -end add_submonoid +variables [semiring R] [set_like σ R] [add_submonoid_class σ R] (A : ι → σ) /-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/ -def direct_sum.submonoid_coe_ring_hom [add_monoid ι] [semiring R] - (A : ι → add_submonoid R) [h : set_like.graded_monoid A] : (⨁ i, A i) →+* R := -direct_sum.to_semiring (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl) +def coe_ring_hom [add_monoid ι] [set_like.graded_monoid A] : (⨁ i, A i) →+* R := +direct_sum.to_semiring (λ i, add_submonoid_class.subtype (A i)) rfl (λ _ _ _ _, rfl) /-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/ -@[simp] lemma direct_sum.submonoid_coe_ring_hom_of [add_monoid ι] [semiring R] - (A : ι → add_submonoid R) [h : set_like.graded_monoid A] (i : ι) (x : A i) : - direct_sum.submonoid_coe_ring_hom A (direct_sum.of (λ i, A i) i x) = x := +@[simp] lemma coe_ring_hom_of [add_monoid ι] [set_like.graded_monoid A] (i : ι) + (x : A i) : (coe_ring_hom A : _ →+* R) (of (λ i, A i) i x) = x := direct_sum.to_semiring_of _ _ _ _ _ -lemma direct_sum.coe_mul_apply_add_submonoid [add_monoid ι] [semiring R] - (A : ι → add_submonoid R) [set_like.graded_monoid A] - [Π (i : ι) (x : A i), decidable (x ≠ 0)] (r r' : ⨁ i, A i) (i : ι) : - ((r * r') i : R) = - ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support), - r ij.1 * r' ij.2 := +lemma coe_mul_apply [add_monoid ι] [set_like.graded_monoid A] + [Π (i : ι) (x : A i), decidable (x ≠ 0)] (r r' : ⨁ i, A i) (n : ι) : + ((r * r') n : R) = + ∑ ij in (r.support ×ˢ r'.support).filter (λ ij : ι × ι, ij.1 + ij.2 = n), r ij.1 * r' ij.2 := begin - rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply, - add_submonoid_class.coe_finset_sum], - simp_rw [direct_sum.coe_of_add_submonoid_apply, ←finset.sum_filter, set_like.coe_ghas_mul], + rw [mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply, add_submonoid_class.coe_finset_sum], + simp_rw [coe_of_apply, ←finset.sum_filter, set_like.coe_ghas_mul], end -/-! #### From `add_subgroup`s -/ +lemma coe_mul_apply_eq_dfinsupp_sum [add_monoid ι] [set_like.graded_monoid A] + [Π (i : ι) (x : A i), decidable (x ≠ 0)] (r r' : ⨁ i, A i) (n : ι) : + ((r * r') n : R) = r.sum (λ i ri, r'.sum (λ j rj, if i + j = n then ri * rj else 0)) := +begin + simp only [mul_eq_dfinsupp_sum, dfinsupp.sum_apply], + iterate 2 { rw [dfinsupp.sum, add_submonoid_class.coe_finset_sum], congr, ext }, + dsimp only, split_ifs, + { subst h, rw of_eq_same, refl }, + { rw of_eq_of_ne _ _ _ _ h, refl }, +end -namespace add_subgroup +lemma coe_of_mul_apply_aux [add_monoid ι] [set_like.graded_monoid A] {i : ι} + (r : A i) (r' : ⨁ i, A i) {j n : ι} (H : ∀ (x : ι), i + x = n ↔ x = j) : + ((of _ i r * r') n : R) = r * r' j := +begin + classical, + rw coe_mul_apply_eq_dfinsupp_sum, + apply (dfinsupp.sum_single_index _).trans, swap, + { simp_rw [zero_mem_class.coe_zero, zero_mul, if_t_t], exact dfinsupp.sum_zero }, + simp_rw [dfinsupp.sum, H, finset.sum_ite_eq'], + split_ifs, refl, + rw [dfinsupp.not_mem_support_iff.mp h, zero_mem_class.coe_zero, mul_zero], +end -/-- Build a `gsemiring` instance for a collection of `add_subgroup`s. -/ -instance gsemiring [add_monoid ι] [ring R] - (A : ι → add_subgroup R) [h : set_like.graded_monoid A] : - direct_sum.gsemiring (λ i, A i) := -have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h}, -by exactI add_submonoid.gsemiring (λ i, (A i).to_add_submonoid) +lemma coe_mul_of_apply_aux [add_monoid ι] [set_like.graded_monoid A] + (r : ⨁ i, A i) {i : ι} (r' : A i) {j n : ι} (H : ∀ (x : ι), x + i = n ↔ x = j) : + ((r * of _ i r') n : R) = r j * r' := +begin + classical, + rw [coe_mul_apply_eq_dfinsupp_sum, dfinsupp.sum_comm], + apply (dfinsupp.sum_single_index _).trans, swap, + { simp_rw [zero_mem_class.coe_zero, mul_zero, if_t_t], exact dfinsupp.sum_zero }, + simp_rw [dfinsupp.sum, H, finset.sum_ite_eq'], + split_ifs, refl, + rw [dfinsupp.not_mem_support_iff.mp h, zero_mem_class.coe_zero, zero_mul], +end -/-- Build a `gcomm_semiring` instance for a collection of `add_subgroup`s. -/ -instance gcomm_semiring [add_comm_group ι] [comm_ring R] - (A : ι → add_subgroup R) [h : set_like.graded_monoid A] : - direct_sum.gsemiring (λ i, A i) := -have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h}, -by exactI add_submonoid.gsemiring (λ i, (A i).to_add_submonoid) +lemma coe_of_mul_apply_add [add_left_cancel_monoid ι] [set_like.graded_monoid A] + {i : ι} (r : A i) (r' : ⨁ i, A i) (j : ι) : + ((of _ i r * r') (i + j) : R) = r * r' j := +coe_of_mul_apply_aux _ _ _ (λ x, ⟨λ h, add_left_cancel h, λ h, h ▸ rfl⟩) -end add_subgroup +lemma coe_mul_of_apply_add [add_right_cancel_monoid ι] [set_like.graded_monoid A] + (r : ⨁ i, A i) {i : ι} (r' : A i) (j : ι) : + ((r * of _ i r') (j + i) : R) = r j * r' := +coe_mul_of_apply_aux _ _ _ (λ x, ⟨λ h, add_right_cancel h, λ h, h ▸ rfl⟩) -/-- The canonical ring isomorphism between `⨁ i, A i` and `R`. -/ -def direct_sum.subgroup_coe_ring_hom [add_monoid ι] [ring R] - (A : ι → add_subgroup R) [set_like.graded_monoid A] : (⨁ i, A i) →+* R := -direct_sum.to_semiring (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl) +end coe -@[simp] lemma direct_sum.subgroup_coe_ring_hom_of [add_monoid ι] [ring R] - (A : ι → add_subgroup R) [set_like.graded_monoid A] (i : ι) (x : A i) : - direct_sum.subgroup_coe_ring_hom A (direct_sum.of (λ i, A i) i x) = x := -direct_sum.to_semiring_of _ _ _ _ _ +section canonically_ordered_add_monoid + +variables [semiring R] [set_like σ R] [add_submonoid_class σ R] (A : ι → σ) +variables [canonically_ordered_add_monoid ι] [set_like.graded_monoid A] + +lemma coe_of_mul_apply_of_not_le + {i : ι} (r : A i) (r' : ⨁ i, A i) (n : ι) + (h : ¬ i ≤ n) : ((of _ i r * r') n : R) = 0 := +begin + classical, + rw coe_mul_apply_eq_dfinsupp_sum, + apply (dfinsupp.sum_single_index _).trans, swap, + { simp_rw [zero_mem_class.coe_zero, zero_mul, if_t_t], exact dfinsupp.sum_zero }, + { rw [dfinsupp.sum, finset.sum_ite_of_false _ _ (λ x _ H, _), finset.sum_const_zero], + exact h ((self_le_add_right i x).trans_eq H) }, +end -lemma direct_sum.coe_mul_apply_add_subgroup [add_monoid ι] [ring R] - (A : ι → add_subgroup R) [set_like.graded_monoid A] [Π (i : ι) (x : A i), decidable (x ≠ 0)] - (r r' : ⨁ i, A i) (i : ι) : - ((r * r') i : R) = - ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support), - r ij.1 * r' ij.2 := +lemma coe_mul_of_apply_of_not_le + (r : ⨁ i, A i) {i : ι} (r' : A i) (n : ι) + (h : ¬ i ≤ n) : ((r * of _ i r') n : R) = 0 := begin - rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply, - add_submonoid_class.coe_finset_sum], - simp_rw [direct_sum.coe_of_add_subgroup_apply, ←finset.sum_filter, set_like.coe_ghas_mul], + classical, + rw [coe_mul_apply_eq_dfinsupp_sum, dfinsupp.sum_comm], + apply (dfinsupp.sum_single_index _).trans, swap, + { simp_rw [zero_mem_class.coe_zero, mul_zero, if_t_t], exact dfinsupp.sum_zero }, + { rw [dfinsupp.sum, finset.sum_ite_of_false _ _ (λ x _ H, _), finset.sum_const_zero], + exact h ((self_le_add_left i x).trans_eq H) }, end -/-! #### From `submodules`s -/ +variables [has_sub ι] [has_ordered_sub ι] [contravariant_class ι ι (+) (≤)] -namespace submodule +/- The following two lemmas only require the same hypotheses as `eq_tsub_iff_add_eq_of_le`, but we + state them for `canonically_ordered_add_monoid` + the above three typeclasses for convenience. -/ -/-- Build a `gsemiring` instance for a collection of `submodule`s. -/ -instance gsemiring [add_monoid ι] - [comm_semiring S] [semiring R] [algebra S R] - (A : ι → submodule S R) [h : set_like.graded_monoid A] : - direct_sum.gsemiring (λ i, A i) := -have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h}, -by exactI add_submonoid.gsemiring (λ i, (A i).to_add_submonoid) +lemma coe_mul_of_apply_of_le (r : ⨁ i, A i) {i : ι} (r' : A i) (n : ι) + (h : i ≤ n) : ((r * of _ i r') n : R) = r (n - i) * r' := +coe_mul_of_apply_aux _ _ _ (λ x, (eq_tsub_iff_add_eq_of_le h).symm) -/-- Build a `gsemiring` instance for a collection of `submodule`s. -/ -instance gcomm_semiring [add_comm_monoid ι] - [comm_semiring S] [comm_semiring R] [algebra S R] - (A : ι → submodule S R) [h : set_like.graded_monoid A] : - direct_sum.gcomm_semiring (λ i, A i) := -have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h}, -by exactI add_submonoid.gcomm_semiring (λ i, (A i).to_add_submonoid) +lemma coe_of_mul_apply_of_le {i : ι} (r : A i) (r' : ⨁ i, A i) (n : ι) + (h : i ≤ n) : ((of _ i r * r') n : R) = r * r' (n - i) := +coe_of_mul_apply_aux _ _ _ (λ x, by rw [eq_tsub_iff_add_eq_of_le h, add_comm]) + +lemma coe_mul_of_apply (r : ⨁ i, A i) {i : ι} (r' : A i) (n : ι) [decidable (i ≤ n)] : + ((r * of _ i r') n : R) = if i ≤ n then r (n - i) * r' else 0 := +by { split_ifs, exacts [coe_mul_of_apply_of_le _ _ _ n h, coe_mul_of_apply_of_not_le _ _ _ n h] } + +lemma coe_of_mul_apply {i : ι} (r : A i) (r' : ⨁ i, A i) (n : ι) [decidable (i ≤ n)] : + ((of _ i r * r') n : R) = if i ≤ n then r * r' (n - i) else 0 := +by { split_ifs, exacts [coe_of_mul_apply_of_le _ _ _ n h, coe_of_mul_apply_of_not_le _ _ _ n h] } + +end canonically_ordered_add_monoid + +end direct_sum + +/-! #### From `submodule`s -/ + +namespace submodule /-- Build a `galgebra` instance for a collection of `submodule`s. -/ instance galgebra [add_monoid ι] [comm_semiring S] [semiring R] [algebra S R] - (A : ι → submodule S R) [h : set_like.graded_monoid A] : + (A : ι → submodule S R) [set_like.graded_monoid A] : direct_sum.galgebra S (λ i, A i) := { to_fun := ((algebra.linear_map S R).cod_restrict (A 0) $ - set_like.has_graded_one.algebra_map_mem A).to_add_monoid_hom, + set_like.algebra_map_mem_graded A).to_add_monoid_hom, map_one := subtype.ext $ by exact (algebra_map S R).map_one, map_mul := λ x y, sigma.subtype_ext (add_zero 0).symm $ (algebra_map S R).map_mul _ _, commutes := λ r ⟨i, xi⟩, @@ -178,7 +286,7 @@ instance galgebra [add_monoid ι] @[simp] lemma set_like.coe_galgebra_to_fun [add_monoid ι] [comm_semiring S] [semiring R] [algebra S R] - (A : ι → submodule S R) [h : set_like.graded_monoid A] (s : S) : + (A : ι → submodule S R) [set_like.graded_monoid A] (s : S) : ↑(@direct_sum.galgebra.to_fun _ S (λ i, A i) _ _ _ _ _ _ _ s) = (algebra_map S R s : R) := rfl /-- A direct sum of powers of a submodule of an algebra has a multiplicative structure. -/ @@ -191,36 +299,24 @@ instance nat_power_graded_monoid end submodule /-- The canonical algebra isomorphism between `⨁ i, A i` and `R`. -/ -def direct_sum.submodule_coe_alg_hom [add_monoid ι] +def direct_sum.coe_alg_hom [add_monoid ι] [comm_semiring S] [semiring R] [algebra S R] - (A : ι → submodule S R) [h : set_like.graded_monoid A] : (⨁ i, A i) →ₐ[S] R := + (A : ι → submodule S R) [set_like.graded_monoid A] : (⨁ i, A i) →ₐ[S] R := direct_sum.to_algebra S _ (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl) (λ _, rfl) /-- The supremum of submodules that form a graded monoid is a subalgebra, and equal to the range of -`direct_sum.submodule_coe_alg_hom`. -/ +`direct_sum.coe_alg_hom`. -/ lemma submodule.supr_eq_to_submodule_range [add_monoid ι] [comm_semiring S] [semiring R] [algebra S R] (A : ι → submodule S R) [set_like.graded_monoid A] : - (⨆ i, A i) = (direct_sum.submodule_coe_alg_hom A).range.to_submodule := + (⨆ i, A i) = (direct_sum.coe_alg_hom A).range.to_submodule := (submodule.supr_eq_range_dfinsupp_lsum A).trans $ set_like.coe_injective rfl -@[simp] lemma direct_sum.submodule_coe_alg_hom_of [add_monoid ι] +@[simp] lemma direct_sum.coe_alg_hom_of [add_monoid ι] [comm_semiring S] [semiring R] [algebra S R] - (A : ι → submodule S R) [h : set_like.graded_monoid A] (i : ι) (x : A i) : - direct_sum.submodule_coe_alg_hom A (direct_sum.of (λ i, A i) i x) = x := + (A : ι → submodule S R) [set_like.graded_monoid A] (i : ι) (x : A i) : + direct_sum.coe_alg_hom A (direct_sum.of (λ i, A i) i x) = x := direct_sum.to_semiring_of _ rfl (λ _ _ _ _, rfl) _ _ -lemma direct_sum.coe_mul_apply_submodule [add_monoid ι] - [comm_semiring S] [semiring R] [algebra S R] - (A : ι → submodule S R) [Π (i : ι) (x : A i), decidable (x ≠ 0)] - [set_like.graded_monoid A] (r r' : ⨁ i, A i) (i : ι) : - ((r * r') i : R) = - ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support), - r ij.1 * r' ij.2 := -begin - rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply, submodule.coe_sum], - simp_rw [direct_sum.coe_of_submodule_apply, ←finset.sum_filter, set_like.coe_ghas_mul], -end - end direct_sum section homogeneous_element diff --git a/src/algebra/direct_sum/module.lean b/src/algebra/direct_sum/module.lean index 6275b203e2853..6735c5d53901d 100644 --- a/src/algebra/direct_sum/module.lean +++ b/src/algebra/direct_sum/module.lean @@ -9,15 +9,19 @@ import linear_algebra.dfinsupp /-! # Direct sum of modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The first part of the file provides constructors for direct sums of modules. It provides a construction of the direct sum using the universal property and proves its uniqueness (`direct_sum.to_module.unique`). The second part of the file covers the special case of direct sums of submodules of a fixed module -`M`. There is a canonical linear map from this direct sum to `M`, and the construction is -of particular importance when this linear map is an equivalence; that is, when the submodules -provide an internal decomposition of `M`. The property is defined as -`direct_sum.submodule_is_internal`, and its basic consequences are established. +`M`. There is a canonical linear map from this direct sum to `M` (`direct_sum.coe_linear_map`), and +the construction is of particular importance when this linear map is an equivalence; that is, when +the submodules provide an internal decomposition of `M`. The property is defined more generally +elsewhere as `direct_sum.is_internal`, but its basic consequences on `submodule`s are established +in this file. -/ @@ -35,7 +39,7 @@ variables {M : ι → Type w} [Π i, add_comm_monoid (M i)] [Π i, module R (M i instance : module R (⨁ i, M i) := dfinsupp.module instance {S : Type*} [semiring S] [Π i, module S (M i)] [Π i, smul_comm_class R S (M i)] : smul_comm_class R S (⨁ i, M i) := dfinsupp.smul_comm_class -instance {S : Type*} [semiring S] [has_scalar R S] [Π i, module S (M i)] +instance {S : Type*} [semiring S] [has_smul R S] [Π i, module S (M i)] [Π i, is_scalar_tower R S (M i)] : is_scalar_tower R S (⨁ i, M i) := dfinsupp.is_scalar_tower instance [Π i, module Rᵐᵒᵖ (M i)] [Π i, is_central_scalar R (M i)] : @@ -209,7 +213,7 @@ lequiv_congr_left R h f k = f (h.symm k) := equiv_congr_left_apply _ _ _ end congr_left section sigma -variables {α : ι → Type u} {δ : Π i, α i → Type w} +variables {α : ι → Type*} {δ : Π i, α i → Type w} variables [Π i j, add_comm_monoid (δ i j)] [Π i j, module R (δ i j)] /--`curry` as a linear map.-/ @@ -221,15 +225,19 @@ noncomputable def sigma_lcurry : (⨁ (i : Σ i, _), δ i.1 i.2) →ₗ[R] ⨁ i sigma_lcurry R f i j = f ⟨i, j⟩ := sigma_curry_apply f i j /--`uncurry` as a linear map.-/ -noncomputable def sigma_luncurry : (⨁ i j, δ i j) →ₗ[R] ⨁ (i : Σ i, _), δ i.1 i.2 := +def sigma_luncurry [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] : + (⨁ i j, δ i j) →ₗ[R] ⨁ (i : Σ i, _), δ i.1 i.2 := { map_smul' := dfinsupp.sigma_uncurry_smul, ..sigma_uncurry } -@[simp] lemma sigma_luncurry_apply (f : ⨁ i j, δ i j) (i : ι) (j : α i) : +@[simp] lemma sigma_luncurry_apply [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] + (f : ⨁ i j, δ i j) (i : ι) (j : α i) : sigma_luncurry R f ⟨i, j⟩ = f i j := sigma_uncurry_apply f i j /--`curry_equiv` as a linear equiv.-/ -noncomputable def sigma_lcurry_equiv : (⨁ (i : Σ i, _), δ i.1 i.2) ≃ₗ[R] ⨁ i j, δ i j := +noncomputable def sigma_lcurry_equiv + [Π i, decidable_eq (α i)] [Π i j, decidable_eq (δ i j)] : + (⨁ (i : Σ i, _), δ i.1 i.2) ≃ₗ[R] ⨁ i j, δ i j := { ..sigma_curry_equiv, ..sigma_lcurry R } end sigma @@ -258,60 +266,43 @@ variables {M : Type*} [add_comm_monoid M] [module R M] variables (A : ι → submodule R M) /-- The canonical embedding from `⨁ i, A i` to `M` where `A` is a collection of `submodule R M` -indexed by `ι`-/ -def submodule_coe : (⨁ i, A i) →ₗ[R] M := to_module R ι M (λ i, (A i).subtype) +indexed by `ι`. This is `direct_sum.coe_add_monoid_hom` as a `linear_map`. -/ +def coe_linear_map : (⨁ i, A i) →ₗ[R] M := to_module R ι M (λ i, (A i).subtype) -@[simp] lemma submodule_coe_of (i : ι) (x : A i) : submodule_coe A (of (λ i, A i) i x) = x := +@[simp] lemma coe_linear_map_of (i : ι) (x : A i) : + direct_sum.coe_linear_map A (of (λ i, A i) i x) = x := to_add_monoid_of _ _ _ -lemma coe_of_submodule_apply (i j : ι) (x : A i) : - (direct_sum.of _ i x j : M) = if i = j then x else 0 := -begin - obtain rfl | h := decidable.eq_or_ne i j, - { rw [direct_sum.of_eq_same, if_pos rfl], }, - { rw [direct_sum.of_eq_of_ne _ _ _ _ h, if_neg h, submodule.coe_zero], }, -end - -/-- The `direct_sum` formed by a collection of `submodule`s of `M` is said to be internal if the -canonical map `(⨁ i, A i) →ₗ[R] M` is bijective. - -For the alternate statement in terms of independence and spanning, see -`direct_sum.submodule_is_internal_iff_independent_and_supr_eq_top`. -/ -def submodule_is_internal : Prop := function.bijective (submodule_coe A) - -lemma submodule_is_internal.to_add_submonoid : - submodule_is_internal A ↔ add_submonoid_is_internal (λ i, (A i).to_add_submonoid) := -iff.rfl - variables {A} /-- If a direct sum of submodules is internal then the submodules span the module. -/ -lemma submodule_is_internal.supr_eq_top (h : submodule_is_internal A) : supr A = ⊤ := +lemma is_internal.submodule_supr_eq_top (h : is_internal A) : supr A = ⊤ := begin rw [submodule.supr_eq_range_dfinsupp_lsum, linear_map.range_eq_top], exact function.bijective.surjective h, end /-- If a direct sum of submodules is internal then the submodules are independent. -/ -lemma submodule_is_internal.independent (h : submodule_is_internal A) : +lemma is_internal.submodule_independent (h : is_internal A) : complete_lattice.independent A := complete_lattice.independent_of_dfinsupp_lsum_injective _ h.injective /-- Given an internal direct sum decomposition of a module `M`, and a basis for each of the components of the direct sum, the disjoint union of these bases is a basis for `M`. -/ -noncomputable def submodule_is_internal.collected_basis - (h : submodule_is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) : +noncomputable def is_internal.collected_basis + (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) : basis (Σ i, α i) R M := -{ repr := (linear_equiv.of_bijective _ h.injective h.surjective).symm ≪≫ₗ +{ repr := + (linear_equiv.of_bijective (direct_sum.coe_linear_map A) h).symm ≪≫ₗ (dfinsupp.map_range.linear_equiv (λ i, (v i).repr)) ≪≫ₗ (sigma_finsupp_lequiv_dfinsupp R).symm } -@[simp] lemma submodule_is_internal.collected_basis_coe - (h : submodule_is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) : +@[simp] lemma is_internal.collected_basis_coe + (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) : ⇑(h.collected_basis v) = λ a : Σ i, (α i), ↑(v a.1 a.2) := begin funext a, - simp only [submodule_is_internal.collected_basis, to_module, submodule_coe, + simp only [is_internal.collected_basis, to_module, coe_linear_map, add_equiv.to_fun_eq_coe, basis.coe_of_repr, basis.repr_symm_apply, dfinsupp.lsum_apply_apply, dfinsupp.map_range.linear_equiv_apply, dfinsupp.map_range.linear_equiv_symm, dfinsupp.map_range_single, finsupp.total_single, linear_equiv.of_bijective_apply, @@ -321,17 +312,18 @@ begin convert dfinsupp.sum_add_hom_single (λ i, (A i).subtype.to_add_monoid_hom) a.1 (v a.1 a.2), end -lemma submodule_is_internal.collected_basis_mem - (h : submodule_is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) (a : Σ i, α i) : +lemma is_internal.collected_basis_mem + (h : is_internal A) {α : ι → Type*} (v : Π i, basis (α i) R (A i)) (a : Σ i, α i) : h.collected_basis v a ∈ A a.1 := by simp -/-- When indexed by only two distinct elements, `direct_sum.submodule_is_internal` implies +/-- When indexed by only two distinct elements, `direct_sum.is_internal` implies the two submodules are complementary. Over a `ring R`, this is true as an iff, as -`direct_sum.submodule_is_internal_iff_is_compl`. --/ -lemma submodule_is_internal.is_compl {A : ι → submodule R M} {i j : ι} (hij : i ≠ j) - (h : (set.univ : set ι) = {i, j}) (hi : submodule_is_internal A) : is_compl (A i) (A j) := -⟨hi.independent.pairwise_disjoint _ _ hij, eq.le $ hi.supr_eq_top.symm.trans $ +`direct_sum.is_internal_iff_is_compl`. -/ +lemma is_internal.is_compl {A : ι → submodule R M} {i j : ι} (hij : i ≠ j) + (h : (set.univ : set ι) = {i, j}) (hi : is_internal A) : is_compl (A i) (A j) := +⟨hi.submodule_independent.pairwise_disjoint hij, + codisjoint_iff.mpr $ eq.symm $ hi.submodule_supr_eq_top.symm.trans $ by rw [←Sup_pair, supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton]⟩ end semiring @@ -342,47 +334,43 @@ variables {ι : Type v} [dec_ι : decidable_eq ι] include dec_ι variables {M : Type*} [add_comm_group M] [module R M] -lemma submodule_is_internal.to_add_subgroup (A : ι → submodule R M) : - submodule_is_internal A ↔ add_subgroup_is_internal (λ i, (A i).to_add_subgroup) := -iff.rfl - /-- Note that this is not generally true for `[semiring R]`; see `complete_lattice.independent.dfinsupp_lsum_injective` for details. -/ -lemma submodule_is_internal_of_independent_of_supr_eq_top {A : ι → submodule R M} - (hi : complete_lattice.independent A) (hs : supr A = ⊤) : submodule_is_internal A := +lemma is_internal_submodule_of_independent_of_supr_eq_top {A : ι → submodule R M} + (hi : complete_lattice.independent A) (hs : supr A = ⊤) : is_internal A := ⟨hi.dfinsupp_lsum_injective, linear_map.range_eq_top.1 $ (submodule.supr_eq_range_dfinsupp_lsum _).symm.trans hs⟩ -/-- `iff` version of `direct_sum.submodule_is_internal_of_independent_of_supr_eq_top`, -`direct_sum.submodule_is_internal.independent`, and `direct_sum.submodule_is_internal.supr_eq_top`. +/-- `iff` version of `direct_sum.is_internal_submodule_of_independent_of_supr_eq_top`, +`direct_sum.is_internal.independent`, and `direct_sum.is_internal.supr_eq_top`. -/ -lemma submodule_is_internal_iff_independent_and_supr_eq_top (A : ι → submodule R M) : - submodule_is_internal A ↔ complete_lattice.independent A ∧ supr A = ⊤ := -⟨λ i, ⟨i.independent, i.supr_eq_top⟩, - and.rec submodule_is_internal_of_independent_of_supr_eq_top⟩ +lemma is_internal_submodule_iff_independent_and_supr_eq_top (A : ι → submodule R M) : + is_internal A ↔ complete_lattice.independent A ∧ supr A = ⊤ := +⟨λ i, ⟨i.submodule_independent, i.submodule_supr_eq_top⟩, + and.rec is_internal_submodule_of_independent_of_supr_eq_top⟩ /-- If a collection of submodules has just two indices, `i` and `j`, then -`direct_sum.submodule_is_internal` is equivalent to `is_compl`. -/ -lemma submodule_is_internal_iff_is_compl (A : ι → submodule R M) {i j : ι} (hij : i ≠ j) +`direct_sum.is_internal` is equivalent to `is_compl`. -/ +lemma is_internal_submodule_iff_is_compl (A : ι → submodule R M) {i j : ι} (hij : i ≠ j) (h : (set.univ : set ι) = {i, j}) : - submodule_is_internal A ↔ is_compl (A i) (A j) := + is_internal A ↔ is_compl (A i) (A j) := begin have : ∀ k, k = i ∨ k = j := λ k, by simpa using set.ext_iff.mp h k, - rw [submodule_is_internal_iff_independent_and_supr_eq_top, + rw [is_internal_submodule_iff_independent_and_supr_eq_top, supr, ←set.image_univ, h, set.image_insert_eq, set.image_singleton, Sup_pair, complete_lattice.independent_pair hij this], - exact ⟨λ ⟨hd, ht⟩, ⟨hd, ht.ge⟩, λ ⟨hd, ht⟩, ⟨hd, eq_top_iff.mpr ht⟩⟩, + exact ⟨λ ⟨hd, ht⟩, ⟨hd, codisjoint_iff.mpr ht⟩, λ ⟨hd, ht⟩, ⟨hd, ht.eq_top⟩⟩, end /-! Now copy the lemmas for subgroup and submonoids. -/ -lemma add_submonoid_is_internal.independent {M : Type*} [add_comm_monoid M] - {A : ι → add_submonoid M} (h : add_submonoid_is_internal A) : +lemma is_internal.add_submonoid_independent {M : Type*} [add_comm_monoid M] + {A : ι → add_submonoid M} (h : is_internal A) : complete_lattice.independent A := complete_lattice.independent_of_dfinsupp_sum_add_hom_injective _ h.injective -lemma add_subgroup_is_internal.independent {M : Type*} [add_comm_group M] - {A : ι → add_subgroup M} (h : add_subgroup_is_internal A) : +lemma is_internal.add_subgroup_independent {M : Type*} [add_comm_group M] + {A : ι → add_subgroup M} (h : is_internal A) : complete_lattice.independent A := complete_lattice.independent_of_dfinsupp_sum_add_hom_injective' _ h.injective diff --git a/src/algebra/direct_sum/ring.lean b/src/algebra/direct_sum/ring.lean index fdf1ddaf985ef..cca2fd311b35e 100644 --- a/src/algebra/direct_sum/ring.lean +++ b/src/algebra/direct_sum/ring.lean @@ -3,40 +3,49 @@ Copyright (c) 2021 Eric Wieser. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Wieser -/ -import group_theory.subgroup.basic import algebra.graded_monoid import algebra.direct_sum.basic -import algebra.big_operators.pi /-! # Additively-graded multiplicative structures on `⨁ i, A i` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides a set of heterogeneous typeclasses for defining a multiplicative structure over `⨁ i, A i` such that `(*) : A i → A j → A (i + j)`; that is to say, `A` forms an additively-graded ring. The typeclasses are: * `direct_sum.gnon_unital_non_assoc_semiring A` * `direct_sum.gsemiring A` +* `direct_sum.gring A` * `direct_sum.gcomm_semiring A` +* `direct_sum.gcomm_ring A` Respectively, these imbue the external direct sum `⨁ i, A i` with: * `direct_sum.non_unital_non_assoc_semiring`, `direct_sum.non_unital_non_assoc_ring` -* `direct_sum.semiring`, `direct_sum.ring` -* `direct_sum.comm_semiring`, `direct_sum.comm_ring` +* `direct_sum.semiring` +* `direct_sum.ring` +* `direct_sum.comm_semiring` +* `direct_sum.comm_ring` the base ring `A 0` with: * `direct_sum.grade_zero.non_unital_non_assoc_semiring`, `direct_sum.grade_zero.non_unital_non_assoc_ring` -* `direct_sum.grade_zero.semiring`, `direct_sum.grade_zero.ring` -* `direct_sum.grade_zero.comm_semiring`, `direct_sum.grade_zero.comm_ring` +* `direct_sum.grade_zero.semiring` +* `direct_sum.grade_zero.ring` +* `direct_sum.grade_zero.comm_semiring` +* `direct_sum.grade_zero.comm_ring` and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication: -* `direct_sum.grade_zero.has_scalar (A 0)`, `direct_sum.grade_zero.smul_with_zero (A 0)` +* `direct_sum.grade_zero.has_smul (A 0)`, `direct_sum.grade_zero.smul_with_zero (A 0)` * `direct_sum.grade_zero.module (A 0)` * (nothing) +* (nothing) +* (nothing) Note that in the presence of these instances, `⨁ i, A i` itself inherits an `A 0`-action. @@ -95,12 +104,25 @@ variables (A : ι → Type*) /-- A graded version of `semiring`. -/ class gsemiring [add_monoid ι] [Π i, add_comm_monoid (A i)] extends - gnon_unital_non_assoc_semiring A, graded_monoid.gmonoid A + gnon_unital_non_assoc_semiring A, graded_monoid.gmonoid A := +(nat_cast : ℕ → A 0) +(nat_cast_zero : nat_cast 0 = 0) +(nat_cast_succ : ∀ n : ℕ, nat_cast (n + 1) = nat_cast n + graded_monoid.ghas_one.one) /-- A graded version of `comm_semiring`. -/ class gcomm_semiring [add_comm_monoid ι] [Π i, add_comm_monoid (A i)] extends gsemiring A, graded_monoid.gcomm_monoid A +/-- A graded version of `ring`. -/ +class gring [add_monoid ι] [Π i, add_comm_group (A i)] extends gsemiring A := +(int_cast : ℤ → A 0) +(int_cast_of_nat : ∀ n : ℕ, int_cast n = nat_cast n) +(int_cast_neg_succ_of_nat : ∀ n : ℕ, int_cast (-(n+1 : ℕ)) = -nat_cast (n+1 : ℕ)) + +/-- A graded version of `comm_ring`. -/ +class gcomm_ring [add_comm_monoid ι] [Π i, add_comm_group (A i)] extends + gring A, gcomm_semiring A + end defs lemma of_eq_of_graded_monoid_eq {A : ι → Type*} [Π (i : ι), add_comm_monoid (A i)] @@ -214,6 +236,9 @@ instance semiring : semiring (⨁ i, A i) := one_mul := one_mul A, mul_one := mul_one A, mul_assoc := mul_assoc A, + nat_cast := λ n, of _ _ (gsemiring.nat_cast n), + nat_cast_zero := by rw [gsemiring.nat_cast_zero, map_zero], + nat_cast_succ := λ n, by { rw [gsemiring.nat_cast_succ, map_add], refl }, ..direct_sum.non_unital_non_assoc_semiring _, } lemma of_pow {i} (a : A i) (n : ℕ) : @@ -241,21 +266,21 @@ by rw [list.of_fn_eq_map, of_list_dprod] open_locale big_operators +lemma mul_eq_dfinsupp_sum [Π (i : ι) (x : A i), decidable (x ≠ 0)] (a a' : ⨁ i, A i) : + a * a' = a.sum (λ i ai, a'.sum $ λ j aj, direct_sum.of _ _ $ graded_monoid.ghas_mul.mul ai aj) := +begin + change mul_hom _ a a' = _, + simpa only [mul_hom, to_add_monoid, dfinsupp.lift_add_hom_apply, dfinsupp.sum_add_hom_apply, + add_monoid_hom.dfinsupp_sum_apply, flip_apply, add_monoid_hom.dfinsupp_sum_add_hom_apply], +end + /-- A heavily unfolded version of the definition of multiplication -/ lemma mul_eq_sum_support_ghas_mul [Π (i : ι) (x : A i), decidable (x ≠ 0)] (a a' : ⨁ i, A i) : a * a' = - ∑ (ij : ι × ι) in (dfinsupp.support a).product (dfinsupp.support a'), + ∑ ij in dfinsupp.support a ×ˢ dfinsupp.support a', direct_sum.of _ _ (graded_monoid.ghas_mul.mul (a ij.fst) (a' ij.snd)) := -begin - change direct_sum.mul_hom _ a a' = _, - dsimp [direct_sum.mul_hom, direct_sum.to_add_monoid, dfinsupp.lift_add_hom_apply], - simp only [dfinsupp.sum_add_hom_apply, dfinsupp.sum, dfinsupp.finset_sum_apply, - add_monoid_hom.coe_finset_sum, finset.sum_apply, add_monoid_hom.flip_apply, - add_monoid_hom.comp_hom_apply_apply, add_monoid_hom.comp_apply, - direct_sum.gmul_hom_apply_apply], - rw finset.sum_product, -end +by simp only [mul_eq_dfinsupp_sum, dfinsupp.sum, finset.sum_product] end semiring @@ -298,7 +323,7 @@ instance non_assoc_ring : non_unital_non_assoc_ring (⨁ i, A i) := end non_unital_non_assoc_ring section ring -variables [Π i, add_comm_group (A i)] [add_monoid ι] [gsemiring A] +variables [Π i, add_comm_group (A i)] [add_monoid ι] [gring A] /-- The `ring` derived from `gsemiring A`. -/ instance ring : ring (⨁ i, A i) := @@ -307,14 +332,17 @@ instance ring : ring (⨁ i, A i) := zero := 0, add := (+), neg := has_neg.neg, + int_cast := λ z, of _ _ (gring.int_cast z), + int_cast_of_nat := λ z, congr_arg _ $ gring.int_cast_of_nat _, + int_cast_neg_succ_of_nat := λ z, + (congr_arg _ $ gring.int_cast_neg_succ_of_nat _).trans (map_neg _ _), ..(direct_sum.semiring _), ..(direct_sum.add_comm_group _), } - end ring section comm_ring -variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_semiring A] +variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_ring A] /-- The `comm_ring` derived from `gcomm_semiring A`. -/ instance comm_ring : comm_ring (⨁ i, A i) := @@ -372,11 +400,16 @@ variables [Π i, add_comm_monoid (A i)] [add_monoid ι] [gsemiring A] | 0 := by rw [pow_zero, pow_zero, direct_sum.of_zero_one] | (n + 1) := by rw [pow_succ, pow_succ, of_zero_mul, of_zero_pow] +instance : has_nat_cast (A 0) := ⟨gsemiring.nat_cast⟩ + +@[simp] lemma of_nat_cast (n : ℕ) : of A 0 n = n := +rfl + /-- The `semiring` structure derived from `gsemiring A`. -/ instance grade_zero.semiring : semiring (A 0) := function.injective.semiring (of A 0) dfinsupp.single_injective (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A) - (λ x n, dfinsupp.single_smul n x) (λ x n, of_zero_pow _ _ _) + (of A 0).map_nsmul (λ x n, of_zero_pow _ _ _) (of_nat_cast A) /-- `of A 0` is a `ring_hom`, using the `direct_sum.grade_zero.semiring` structure. -/ def of_zero_ring_hom : A 0 →+* (⨁ i, A i) := @@ -401,7 +434,7 @@ variables [Π i, add_comm_monoid (A i)] [add_comm_monoid ι] [gcomm_semiring A] instance grade_zero.comm_semiring : comm_semiring (A 0) := function.injective.comm_semiring (of A 0) dfinsupp.single_injective (of A 0).map_zero (of_zero_one A) (of A 0).map_add (of_zero_mul A) - (λ x n, dfinsupp.single_smul n x) (λ x n, of_zero_pow _ _ _) + (λ x n, dfinsupp.single_smul n x) (λ x n, of_zero_pow _ _ _) (of_nat_cast A) end comm_semiring @@ -425,7 +458,12 @@ function.injective.non_unital_non_assoc_ring (of A 0) dfinsupp.single_injective end ring section ring -variables [Π i, add_comm_group (A i)] [add_monoid ι] [gsemiring A] +variables [Π i, add_comm_group (A i)] [add_monoid ι] [gring A] + +instance : has_int_cast (A 0) := ⟨gring.int_cast⟩ + +@[simp] lemma of_int_cast (n : ℤ) : of A 0 n = n := +rfl /-- The `ring` derived from `gsemiring A`. -/ instance grade_zero.ring : ring (A 0) := @@ -440,11 +478,12 @@ function.injective.ring (of A 0) dfinsupp.single_injective letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance, exact dfinsupp.single_smul n x end) (λ x n, of_zero_pow _ _ _) + (of_nat_cast A) (of_int_cast A) end ring section comm_ring -variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_semiring A] +variables [Π i, add_comm_group (A i)] [add_comm_monoid ι] [gcomm_ring A] /-- The `comm_ring` derived from `gcomm_semiring A`. -/ instance grade_zero.comm_ring : comm_ring (A 0) := @@ -459,6 +498,7 @@ function.injective.comm_ring (of A 0) dfinsupp.single_injective letI : Π i, distrib_mul_action ℤ (A i) := λ i, infer_instance, exact dfinsupp.single_smul n x end) (λ x n, of_zero_pow _ _ _) + (of_nat_cast A) (of_int_cast A) end comm_ring @@ -527,7 +567,7 @@ def lift_ring_hom : f (graded_monoid.ghas_one.one) = 1 ∧ ∀ {i j} (ai : A i) (aj : A j), f (graded_monoid.ghas_mul.mul ai aj) = f ai * f aj} ≃ ((⨁ i, A i) →+* R) := -{ to_fun := λ f, to_semiring f.1 f.2.1 f.2.2, +{ to_fun := λ f, to_semiring (λ _, f.1) f.2.1 (λ _ _, f.2.2), inv_fun := λ F, ⟨λ i, (F : (⨁ i, A i) →+ R).comp (of _ i), begin simp only [add_monoid_hom.comp_apply, ring_hom.coe_add_monoid_hom], @@ -539,7 +579,7 @@ def lift_ring_hom : end⟩, left_inv := λ f, begin ext xi xv, - exact to_add_monoid_of f.1 xi xv, + exact to_add_monoid_of (λ _, f.1) xi xv, end, right_inv := λ F, begin apply ring_hom.coe_add_monoid_hom_injective, @@ -573,7 +613,11 @@ instance non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring /-- A direct sum of copies of a `semiring` inherits the multiplication structure. -/ instance semiring.direct_sum_gsemiring {R : Type*} [add_monoid ι] [semiring R] : direct_sum.gsemiring (λ i : ι, R) := -{ ..non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring ι, ..monoid.gmonoid ι } +{ nat_cast := λ n, n, + nat_cast_zero := nat.cast_zero, + nat_cast_succ := nat.cast_succ, + ..non_unital_non_assoc_semiring.direct_sum_gnon_unital_non_assoc_semiring ι, + ..monoid.gmonoid ι } open_locale direct_sum diff --git a/src/algebra/divisibility.lean b/src/algebra/divisibility.lean deleted file mode 100644 index 10f0d165ec8c6..0000000000000 --- a/src/algebra/divisibility.lean +++ /dev/null @@ -1,321 +0,0 @@ -/- -Copyright (c) 2014 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov, -Neil Strickland, Aaron Anderson --/ - -import algebra.group_with_zero.basic - -/-! -# Divisibility - -This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s -`(_with_zero)`. - -## Main definitions - - * `monoid.has_dvd` - -## Implementation notes - -The divisibility relation is defined for all monoids, and as such, depends on the order of - multiplication if the monoid is not commutative. There are two possible conventions for - divisibility in the noncommutative context, and this relation follows the convention for ordinals, - so `a | b` is defined as `∃ c, b = a * c`. - -## Tags - -divisibility, divides --/ - -variables {α : Type*} - -section semigroup - -variables [semigroup α] {a b c : α} - -/-- There are two possible conventions for divisibility, which coincide in a `comm_monoid`. - This matches the convention for ordinals. -/ -@[priority 100] -instance semigroup_has_dvd : has_dvd α := -has_dvd.mk (λ a b, ∃ c, b = a * c) - --- TODO: this used to not have `c` explicit, but that seems to be important --- for use with tactics, similar to `exists.intro` -theorem dvd.intro (c : α) (h : a * c = b) : a ∣ b := -exists.intro c h^.symm - -alias dvd.intro ← dvd_of_mul_right_eq - -theorem exists_eq_mul_right_of_dvd (h : a ∣ b) : ∃ c, b = a * c := h - -theorem dvd.elim {P : Prop} {a b : α} (H₁ : a ∣ b) (H₂ : ∀ c, b = a * c → P) : P := -exists.elim H₁ H₂ - -local attribute [simp] mul_assoc mul_comm mul_left_comm - -@[trans] theorem dvd_trans : a ∣ b → b ∣ c → a ∣ c -| ⟨d, h₁⟩ ⟨e, h₂⟩ := ⟨d * e, h₁ ▸ h₂.trans $ mul_assoc a d e⟩ - -alias dvd_trans ← has_dvd.dvd.trans - -@[simp] theorem dvd_mul_right (a b : α) : a ∣ a * b := dvd.intro b rfl - -theorem dvd_mul_of_dvd_left (h : a ∣ b) (c : α) : a ∣ b * c := -h.trans (dvd_mul_right b c) - -alias dvd_mul_of_dvd_left ← has_dvd.dvd.mul_right - -theorem dvd_of_mul_right_dvd (h : a * b ∣ c) : a ∣ c := -(dvd_mul_right a b).trans h - -section map_dvd - -variables {M N : Type*} [monoid M] [monoid N] - -lemma map_dvd {F : Type*} [mul_hom_class F M N] (f : F) {a b} : a ∣ b → f a ∣ f b -| ⟨c, h⟩ := ⟨f c, h.symm ▸ map_mul f a c⟩ - -lemma mul_hom.map_dvd (f : M →ₙ* N) {a b} : a ∣ b → f a ∣ f b := map_dvd f - -lemma monoid_hom.map_dvd (f : M →* N) {a b} : a ∣ b → f a ∣ f b := map_dvd f - -end map_dvd - -end semigroup - -section monoid - -variables [monoid α] - -@[refl, simp] theorem dvd_refl (a : α) : a ∣ a := -dvd.intro 1 (mul_one _) - -lemma dvd_rfl {a : α} : a ∣ a := -dvd_refl a - -theorem one_dvd (a : α) : 1 ∣ a := dvd.intro a (one_mul _) - -end monoid - -section comm_semigroup - -variables [comm_semigroup α] {a b c : α} - -theorem dvd.intro_left (c : α) (h : c * a = b) : a ∣ b := -dvd.intro _ (begin rewrite mul_comm at h, apply h end) - -alias dvd.intro_left ← dvd_of_mul_left_eq - -theorem exists_eq_mul_left_of_dvd (h : a ∣ b) : ∃ c, b = c * a := -dvd.elim h (assume c, assume H1 : b = a * c, exists.intro c (eq.trans H1 (mul_comm a c))) - -lemma dvd_iff_exists_eq_mul_left : a ∣ b ↔ ∃ c, b = c * a := -⟨exists_eq_mul_left_of_dvd, by { rintro ⟨c, rfl⟩, exact ⟨c, mul_comm _ _⟩, }⟩ - -theorem dvd.elim_left {P : Prop} (h₁ : a ∣ b) (h₂ : ∀ c, b = c * a → P) : P := -exists.elim (exists_eq_mul_left_of_dvd h₁) (assume c, assume h₃ : b = c * a, h₂ c h₃) - -@[simp] theorem dvd_mul_left (a b : α) : a ∣ b * a := dvd.intro b (mul_comm a b) - -theorem dvd_mul_of_dvd_right (h : a ∣ b) (c : α) : a ∣ c * b := -begin rw mul_comm, exact h.mul_right _ end - -alias dvd_mul_of_dvd_right ← has_dvd.dvd.mul_left - -local attribute [simp] mul_assoc mul_comm mul_left_comm - -theorem mul_dvd_mul : ∀ {a b c d : α}, a ∣ b → c ∣ d → a * c ∣ b * d -| a ._ c ._ ⟨e, rfl⟩ ⟨f, rfl⟩ := ⟨e * f, by simp⟩ - -theorem dvd_of_mul_left_dvd (h : a * b ∣ c) : b ∣ c := -dvd.elim h (λ d ceq, dvd.intro (a * d) (by simp [ceq])) - -end comm_semigroup - -section comm_monoid - -variables [comm_monoid α] {a b : α} - -theorem mul_dvd_mul_left (a : α) {b c : α} (h : b ∣ c) : a * b ∣ a * c := -mul_dvd_mul (dvd_refl a) h - -theorem mul_dvd_mul_right (h : a ∣ b) (c : α) : a * c ∣ b * c := -mul_dvd_mul h (dvd_refl c) - -end comm_monoid - -section semigroup_with_zero - -variables [semigroup_with_zero α] {a : α} - -theorem eq_zero_of_zero_dvd (h : 0 ∣ a) : a = 0 := -dvd.elim h (assume c, assume H' : a = 0 * c, eq.trans H' (zero_mul c)) - -/-- Given an element `a` of a commutative semigroup with zero, there exists another element whose - product with zero equals `a` iff `a` equals zero. -/ -@[simp] lemma zero_dvd_iff : 0 ∣ a ↔ a = 0 := -⟨eq_zero_of_zero_dvd, λ h, by { rw h, use 0, simp, }⟩ - -@[simp] theorem dvd_zero (a : α) : a ∣ 0 := dvd.intro 0 (by simp) - -end semigroup_with_zero - -/-- Given two elements `b`, `c` of a `cancel_monoid_with_zero` and a nonzero element `a`, - `a*b` divides `a*c` iff `b` divides `c`. -/ -theorem mul_dvd_mul_iff_left [cancel_monoid_with_zero α] {a b c : α} - (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c := -exists_congr $ λ d, by rw [mul_assoc, mul_right_inj' ha] - -/-- Given two elements `a`, `b` of a commutative `cancel_monoid_with_zero` and a nonzero - element `c`, `a*c` divides `b*c` iff `a` divides `b`. -/ -theorem mul_dvd_mul_iff_right [cancel_comm_monoid_with_zero α] {a b c : α} (hc : c ≠ 0) : - a * c ∣ b * c ↔ a ∣ b := -exists_congr $ λ d, by rw [mul_right_comm, mul_left_inj' hc] - -/-! -### Units in various monoids --/ - -namespace units - -section monoid -variables [monoid α] {a b : α} {u : αˣ} - -/-- Elements of the unit group of a monoid represented as elements of the monoid - divide any element of the monoid. -/ -lemma coe_dvd : ↑u ∣ a := ⟨↑u⁻¹ * a, by simp⟩ - -/-- In a monoid, an element `a` divides an element `b` iff `a` divides all - associates of `b`. -/ -lemma dvd_mul_right : a ∣ b * u ↔ a ∣ b := -iff.intro - (assume ⟨c, eq⟩, ⟨c * ↑u⁻¹, by rw [← mul_assoc, ← eq, units.mul_inv_cancel_right]⟩) - (assume ⟨c, eq⟩, eq.symm ▸ (dvd_mul_right _ _).mul_right _) - -/-- In a monoid, an element `a` divides an element `b` iff all associates of `a` divide `b`. -/ -lemma mul_right_dvd : a * u ∣ b ↔ a ∣ b := -iff.intro - (λ ⟨c, eq⟩, ⟨↑u * c, eq.trans (mul_assoc _ _ _)⟩) - (λ h, dvd_trans (dvd.intro ↑u⁻¹ (by rw [mul_assoc, u.mul_inv, mul_one])) h) - -end monoid - -section comm_monoid -variables [comm_monoid α] {a b : α} {u : αˣ} - -/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left - associates of `b`. -/ -lemma dvd_mul_left : a ∣ u * b ↔ a ∣ b := by { rw mul_comm, apply dvd_mul_right } - -/-- In a commutative monoid, an element `a` divides an element `b` iff all - left associates of `a` divide `b`.-/ -lemma mul_left_dvd : ↑u * a ∣ b ↔ a ∣ b := -by { rw mul_comm, apply mul_right_dvd } - -end comm_monoid - -end units - -namespace is_unit - -section monoid - -variables [monoid α] {a b u : α} (hu : is_unit u) -include hu - -/-- Units of a monoid divide any element of the monoid. -/ -@[simp] lemma dvd : u ∣ a := by { rcases hu with ⟨u, rfl⟩, apply units.coe_dvd, } - -@[simp] lemma dvd_mul_right : a ∣ b * u ↔ a ∣ b := -by { rcases hu with ⟨u, rfl⟩, apply units.dvd_mul_right, } - -/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/ -@[simp] lemma mul_right_dvd : a * u ∣ b ↔ a ∣ b := -by { rcases hu with ⟨u, rfl⟩, apply units.mul_right_dvd, } - -end monoid - -section comm_monoid -variables [comm_monoid α] (a b u : α) (hu : is_unit u) -include hu - -/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left - associates of `b`. -/ -@[simp] lemma dvd_mul_left : a ∣ u * b ↔ a ∣ b := -by { rcases hu with ⟨u, rfl⟩, apply units.dvd_mul_left, } - -/-- In a commutative monoid, an element `a` divides an element `b` iff all - left associates of `a` divide `b`.-/ -@[simp] lemma mul_left_dvd : u * a ∣ b ↔ a ∣ b := -by { rcases hu with ⟨u, rfl⟩, apply units.mul_left_dvd, } - -end comm_monoid - -end is_unit - -section comm_monoid -variables [comm_monoid α] - -theorem is_unit_iff_dvd_one {x : α} : is_unit x ↔ x ∣ 1 := -⟨by rintro ⟨u, rfl⟩; exact ⟨_, u.mul_inv.symm⟩, - λ ⟨y, h⟩, ⟨⟨x, y, h.symm, by rw [h, mul_comm]⟩, rfl⟩⟩ - -theorem is_unit_iff_forall_dvd {x : α} : - is_unit x ↔ ∀ y, x ∣ y := -is_unit_iff_dvd_one.trans ⟨λ h y, h.trans (one_dvd _), λ h, h _⟩ - -theorem is_unit_of_dvd_unit {x y : α} - (xy : x ∣ y) (hu : is_unit y) : is_unit x := -is_unit_iff_dvd_one.2 $ xy.trans $ is_unit_iff_dvd_one.1 hu - -lemma is_unit_of_dvd_one : ∀a ∣ 1, is_unit (a:α) -| a ⟨b, eq⟩ := ⟨units.mk_of_mul_eq_one a b eq.symm, rfl⟩ - -lemma not_is_unit_of_not_is_unit_dvd {a b : α} (ha : ¬is_unit a) (hb : a ∣ b) : - ¬ is_unit b := -mt (is_unit_of_dvd_unit hb) ha - -end comm_monoid - -section comm_monoid_with_zero - -variable [comm_monoid_with_zero α] - -/-- `dvd_not_unit a b` expresses that `a` divides `b` "strictly", i.e. that `b` divided by `a` -is not a unit. -/ -def dvd_not_unit (a b : α) : Prop := a ≠ 0 ∧ ∃ x, ¬is_unit x ∧ b = a * x - -lemma dvd_not_unit_of_dvd_of_not_dvd {a b : α} (hd : a ∣ b) (hnd : ¬ b ∣ a) : - dvd_not_unit a b := -begin - split, - { rintro rfl, exact hnd (dvd_zero _) }, - { rcases hd with ⟨c, rfl⟩, - refine ⟨c, _, rfl⟩, - rintro ⟨u, rfl⟩, - simpa using hnd } -end - -end comm_monoid_with_zero - -lemma dvd_and_not_dvd_iff [cancel_comm_monoid_with_zero α] {x y : α} : - x ∣ y ∧ ¬y ∣ x ↔ dvd_not_unit x y := -⟨λ ⟨⟨d, hd⟩, hyx⟩, ⟨λ hx0, by simpa [hx0] using hyx, ⟨d, - mt is_unit_iff_dvd_one.1 (λ ⟨e, he⟩, hyx ⟨e, by rw [hd, mul_assoc, ← he, mul_one]⟩), hd⟩⟩, - λ ⟨hx0, d, hdu, hdx⟩, ⟨⟨d, hdx⟩, λ ⟨e, he⟩, hdu (is_unit_of_dvd_one _ - ⟨e, mul_left_cancel₀ hx0 $ by conv {to_lhs, rw [he, hdx]};simp [mul_assoc]⟩)⟩⟩ - -section monoid_with_zero - -variable [monoid_with_zero α] - -theorem ne_zero_of_dvd_ne_zero {p q : α} (h₁ : q ≠ 0) - (h₂ : p ∣ q) : p ≠ 0 := -begin - rcases h₂ with ⟨u, rfl⟩, - exact left_ne_zero_of_mul h₁, -end - -end monoid_with_zero diff --git a/src/algebra/divisibility/basic.lean b/src/algebra/divisibility/basic.lean new file mode 100644 index 0000000000000..3495d550e3400 --- /dev/null +++ b/src/algebra/divisibility/basic.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov, +Neil Strickland, Aaron Anderson +-/ + +import algebra.hom.group + +/-! +# Divisibility + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the basics of the divisibility relation in the context of `(comm_)` `monoid`s. + +## Main definitions + + * `monoid.has_dvd` + +## Implementation notes + +The divisibility relation is defined for all monoids, and as such, depends on the order of + multiplication if the monoid is not commutative. There are two possible conventions for + divisibility in the noncommutative context, and this relation follows the convention for ordinals, + so `a | b` is defined as `∃ c, b = a * c`. + +## Tags + +divisibility, divides +-/ + +variables {α : Type*} + +section semigroup + +variables [semigroup α] {a b c : α} + +/-- There are two possible conventions for divisibility, which coincide in a `comm_monoid`. + This matches the convention for ordinals. -/ +@[priority 100] +instance semigroup_has_dvd : has_dvd α := +has_dvd.mk (λ a b, ∃ c, b = a * c) + +-- TODO: this used to not have `c` explicit, but that seems to be important +-- for use with tactics, similar to `exists.intro` +theorem dvd.intro (c : α) (h : a * c = b) : a ∣ b := +exists.intro c h^.symm + +alias dvd.intro ← dvd_of_mul_right_eq + +theorem exists_eq_mul_right_of_dvd (h : a ∣ b) : ∃ c, b = a * c := h + +theorem dvd.elim {P : Prop} {a b : α} (H₁ : a ∣ b) (H₂ : ∀ c, b = a * c → P) : P := +exists.elim H₁ H₂ + +local attribute [simp] mul_assoc mul_comm mul_left_comm + +@[trans] theorem dvd_trans : a ∣ b → b ∣ c → a ∣ c +| ⟨d, h₁⟩ ⟨e, h₂⟩ := ⟨d * e, h₁ ▸ h₂.trans $ mul_assoc a d e⟩ + +alias dvd_trans ← has_dvd.dvd.trans + +instance : is_trans α (∣) := ⟨λ a b c, dvd_trans⟩ + +@[simp] theorem dvd_mul_right (a b : α) : a ∣ a * b := dvd.intro b rfl + +theorem dvd_mul_of_dvd_left (h : a ∣ b) (c : α) : a ∣ b * c := +h.trans (dvd_mul_right b c) + +alias dvd_mul_of_dvd_left ← has_dvd.dvd.mul_right + +theorem dvd_of_mul_right_dvd (h : a * b ∣ c) : a ∣ c := +(dvd_mul_right a b).trans h + +section map_dvd + +variables {M N : Type*} [monoid M] [monoid N] + +lemma map_dvd {F : Type*} [mul_hom_class F M N] (f : F) {a b} : a ∣ b → f a ∣ f b +| ⟨c, h⟩ := ⟨f c, h.symm ▸ map_mul f a c⟩ + +lemma mul_hom.map_dvd (f : M →ₙ* N) {a b} : a ∣ b → f a ∣ f b := map_dvd f + +lemma monoid_hom.map_dvd (f : M →* N) {a b} : a ∣ b → f a ∣ f b := map_dvd f + +end map_dvd + +end semigroup + +section monoid + +variables [monoid α] {a b : α} + +@[refl, simp] theorem dvd_refl (a : α) : a ∣ a := dvd.intro 1 (mul_one a) +theorem dvd_rfl : ∀ {a : α}, a ∣ a := dvd_refl +instance : is_refl α (∣) := ⟨dvd_refl⟩ + +theorem one_dvd (a : α) : 1 ∣ a := dvd.intro a (one_mul a) + +lemma dvd_of_eq (h : a = b) : a ∣ b := by rw h + +alias dvd_of_eq ← eq.dvd + +end monoid + +section comm_semigroup + +variables [comm_semigroup α] {a b c : α} + +theorem dvd.intro_left (c : α) (h : c * a = b) : a ∣ b := +dvd.intro _ (begin rewrite mul_comm at h, apply h end) + +alias dvd.intro_left ← dvd_of_mul_left_eq + +theorem exists_eq_mul_left_of_dvd (h : a ∣ b) : ∃ c, b = c * a := +dvd.elim h (assume c, assume H1 : b = a * c, exists.intro c (eq.trans H1 (mul_comm a c))) + +lemma dvd_iff_exists_eq_mul_left : a ∣ b ↔ ∃ c, b = c * a := +⟨exists_eq_mul_left_of_dvd, by { rintro ⟨c, rfl⟩, exact ⟨c, mul_comm _ _⟩, }⟩ + +theorem dvd.elim_left {P : Prop} (h₁ : a ∣ b) (h₂ : ∀ c, b = c * a → P) : P := +exists.elim (exists_eq_mul_left_of_dvd h₁) (assume c, assume h₃ : b = c * a, h₂ c h₃) + +@[simp] theorem dvd_mul_left (a b : α) : a ∣ b * a := dvd.intro b (mul_comm a b) + +theorem dvd_mul_of_dvd_right (h : a ∣ b) (c : α) : a ∣ c * b := +begin rw mul_comm, exact h.mul_right _ end + +alias dvd_mul_of_dvd_right ← has_dvd.dvd.mul_left + +local attribute [simp] mul_assoc mul_comm mul_left_comm + +theorem mul_dvd_mul : ∀ {a b c d : α}, a ∣ b → c ∣ d → a * c ∣ b * d +| a ._ c ._ ⟨e, rfl⟩ ⟨f, rfl⟩ := ⟨e * f, by simp⟩ + +theorem dvd_of_mul_left_dvd (h : a * b ∣ c) : b ∣ c := +dvd.elim h (λ d ceq, dvd.intro (a * d) (by simp [ceq])) + +end comm_semigroup + +section comm_monoid + +variables [comm_monoid α] {a b : α} + +theorem mul_dvd_mul_left (a : α) {b c : α} (h : b ∣ c) : a * b ∣ a * c := +mul_dvd_mul (dvd_refl a) h + +theorem mul_dvd_mul_right (h : a ∣ b) (c : α) : a * c ∣ b * c := +mul_dvd_mul h (dvd_refl c) + +theorem pow_dvd_pow_of_dvd {a b : α} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n +| 0 := by rw [pow_zero, pow_zero] +| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) } + +end comm_monoid diff --git a/src/algebra/divisibility/units.lean b/src/algebra/divisibility/units.lean new file mode 100644 index 0000000000000..6cd70984f1a41 --- /dev/null +++ b/src/algebra/divisibility/units.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov, +Neil Strickland, Aaron Anderson +-/ +import algebra.divisibility.basic +import algebra.group.units + +/-! +# Lemmas about divisibility and units + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +namespace units + +section monoid +variables [monoid α] {a b : α} {u : αˣ} + +/-- Elements of the unit group of a monoid represented as elements of the monoid + divide any element of the monoid. -/ +lemma coe_dvd : ↑u ∣ a := ⟨↑u⁻¹ * a, by simp⟩ + +/-- In a monoid, an element `a` divides an element `b` iff `a` divides all + associates of `b`. -/ +lemma dvd_mul_right : a ∣ b * u ↔ a ∣ b := +iff.intro + (assume ⟨c, eq⟩, ⟨c * ↑u⁻¹, by rw [← mul_assoc, ← eq, units.mul_inv_cancel_right]⟩) + (assume ⟨c, eq⟩, eq.symm ▸ (dvd_mul_right _ _).mul_right _) + +/-- In a monoid, an element `a` divides an element `b` iff all associates of `a` divide `b`. -/ +lemma mul_right_dvd : a * u ∣ b ↔ a ∣ b := +iff.intro + (λ ⟨c, eq⟩, ⟨↑u * c, eq.trans (mul_assoc _ _ _)⟩) + (λ h, dvd_trans (dvd.intro ↑u⁻¹ (by rw [mul_assoc, u.mul_inv, mul_one])) h) + +end monoid + +section comm_monoid +variables [comm_monoid α] {a b : α} {u : αˣ} + +/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left + associates of `b`. -/ +lemma dvd_mul_left : a ∣ u * b ↔ a ∣ b := by { rw mul_comm, apply dvd_mul_right } + +/-- In a commutative monoid, an element `a` divides an element `b` iff all + left associates of `a` divide `b`.-/ +lemma mul_left_dvd : ↑u * a ∣ b ↔ a ∣ b := +by { rw mul_comm, apply mul_right_dvd } + +end comm_monoid + +end units + +namespace is_unit + +section monoid + +variables [monoid α] {a b u : α} (hu : is_unit u) +include hu + +/-- Units of a monoid divide any element of the monoid. -/ +@[simp] lemma dvd : u ∣ a := by { rcases hu with ⟨u, rfl⟩, apply units.coe_dvd, } + +@[simp] lemma dvd_mul_right : a ∣ b * u ↔ a ∣ b := +by { rcases hu with ⟨u, rfl⟩, apply units.dvd_mul_right, } + +/-- In a monoid, an element a divides an element b iff all associates of `a` divide `b`.-/ +@[simp] lemma mul_right_dvd : a * u ∣ b ↔ a ∣ b := +by { rcases hu with ⟨u, rfl⟩, apply units.mul_right_dvd, } + +end monoid + +section comm_monoid +variables [comm_monoid α] (a b u : α) (hu : is_unit u) +include hu + +/-- In a commutative monoid, an element `a` divides an element `b` iff `a` divides all left + associates of `b`. -/ +@[simp] lemma dvd_mul_left : a ∣ u * b ↔ a ∣ b := +by { rcases hu with ⟨u, rfl⟩, apply units.dvd_mul_left, } + +/-- In a commutative monoid, an element `a` divides an element `b` iff all + left associates of `a` divide `b`.-/ +@[simp] lemma mul_left_dvd : u * a ∣ b ↔ a ∣ b := +by { rcases hu with ⟨u, rfl⟩, apply units.mul_left_dvd, } + +end comm_monoid + +end is_unit + +section comm_monoid +variables [comm_monoid α] + +theorem is_unit_iff_dvd_one {x : α} : is_unit x ↔ x ∣ 1 := +⟨is_unit.dvd, λ ⟨y, h⟩, ⟨⟨x, y, h.symm, by rw [h, mul_comm]⟩, rfl⟩⟩ + +theorem is_unit_iff_forall_dvd {x : α} : + is_unit x ↔ ∀ y, x ∣ y := +is_unit_iff_dvd_one.trans ⟨λ h y, h.trans (one_dvd _), λ h, h _⟩ + +theorem is_unit_of_dvd_unit {x y : α} + (xy : x ∣ y) (hu : is_unit y) : is_unit x := +is_unit_iff_dvd_one.2 $ xy.trans $ is_unit_iff_dvd_one.1 hu + +lemma is_unit_of_dvd_one : ∀a ∣ 1, is_unit (a:α) +| a ⟨b, eq⟩ := ⟨units.mk_of_mul_eq_one a b eq.symm, rfl⟩ + +lemma not_is_unit_of_not_is_unit_dvd {a b : α} (ha : ¬is_unit a) (hb : a ∣ b) : + ¬ is_unit b := +mt (is_unit_of_dvd_unit hb) ha + +end comm_monoid diff --git a/src/algebra/dual_number.lean b/src/algebra/dual_number.lean index 9e1fee266c46f..31cacf6c8cbeb 100644 --- a/src/algebra/dual_number.lean +++ b/src/algebra/dual_number.lean @@ -9,6 +9,9 @@ import algebra.triv_sq_zero_ext /-! # Dual numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The dual numbers over `R` are of the form `a + bε`, where `a` and `b` are typically elements of a commutative ring `R`, and `ε` is a symbol satisfying `ε^2 = 0`. They are a special case of `triv_sq_zero_ext R M` with `M = R`. @@ -43,8 +46,8 @@ abbreviation dual_number (R : Type*) : Type* := triv_sq_zero_ext R R /-- The unit element $ε$ that squares to zero. -/ def dual_number.eps [has_zero R] [has_one R] : dual_number R := triv_sq_zero_ext.inr 1 -localized "notation `ε` := dual_number.eps" in dual_number -localized "postfix `[ε]`:1025 := dual_number" in dual_number +localized "notation (name := dual_number.eps) `ε` := dual_number.eps" in dual_number +localized "postfix (name := dual_number) `[ε]`:1025 := dual_number" in dual_number open_locale dual_number @@ -56,7 +59,7 @@ open triv_sq_zero_ext @[simp] lemma snd_eps [has_zero R] [has_one R] : snd ε = (1 : R) := snd_inr _ _ /-- A version of `triv_sq_zero_ext.snd_mul` with `*` instead of `•`. -/ -@[simp] lemma snd_mul [semiring R] (x y : R[ε]) : snd (x * y) = fst x * snd y + fst y * snd x := +@[simp] lemma snd_mul [semiring R] (x y : R[ε]) : snd (x * y) = fst x * snd y + snd x * fst y := snd_mul _ _ @[simp] lemma eps_mul_eps [semiring R] : (ε * ε : R[ε]) = 0 := inr_mul_inr _ _ _ diff --git a/src/algebra/dual_quaternion.lean b/src/algebra/dual_quaternion.lean new file mode 100644 index 0000000000000..2937d89336bf2 --- /dev/null +++ b/src/algebra/dual_quaternion.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.dual_number +import algebra.quaternion + +/-! +# Dual quaternions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Similar to the way that rotations in 3D space can be represented by quaternions of unit length, +rigid motions in 3D space can be represented by dual quaternions of unit length. + +## Main results + +* `quaternion.dual_number_equiv`: quaternions over dual numbers or dual + numbers over quaternions are equivalent constructions. + +## References + +* +-/ + +variables {R : Type*} [comm_ring R] + +namespace quaternion + +/-- The dual quaternions can be equivalently represented as a quaternion with dual coefficients, +or as a dual number with quaternion coefficients. + +See also `matrix.dual_number_equiv` for a similar result. -/ +def dual_number_equiv : + quaternion (dual_number R) ≃ₐ[R] dual_number (quaternion R) := +{ to_fun := λ q, + (⟨q.re.fst, q.im_i.fst, q.im_j.fst, q.im_k.fst⟩, + ⟨q.re.snd, q.im_i.snd, q.im_j.snd, q.im_k.snd⟩), + inv_fun := λ d, + ⟨(d.fst.re, d.snd.re), (d.fst.im_i, d.snd.im_i), + (d.fst.im_j, d.snd.im_j), (d.fst.im_k, d.snd.im_k)⟩, + left_inv := λ ⟨⟨r, rε⟩, ⟨i, iε⟩, ⟨j, jε⟩, ⟨k, kε⟩⟩, rfl, + right_inv := λ ⟨⟨r, i, j, k⟩, ⟨rε, iε, jε, kε⟩⟩, rfl, + map_mul' := begin + rintros ⟨⟨xr, xrε⟩, ⟨xi, xiε⟩, ⟨xj, xjε⟩, ⟨xk, xkε⟩⟩, + rintros ⟨⟨yr, yrε⟩, ⟨yi, yiε⟩, ⟨yj, yjε⟩, ⟨yk, ykε⟩⟩, + ext : 1, + { refl }, + { dsimp, + congr' 1; ring }, + end, + map_add' := begin + rintros ⟨⟨xr, xrε⟩, ⟨xi, xiε⟩, ⟨xj, xjε⟩, ⟨xk, xkε⟩⟩, + rintros ⟨⟨yr, yrε⟩, ⟨yi, yiε⟩, ⟨yj, yjε⟩, ⟨yk, ykε⟩⟩, + refl + end, + commutes' := λ r, rfl } + +/-! Lemmas characterizing `quaternion.dual_number_equiv`. -/ + +-- `simps` can't work on `dual_number` because it's not a structure +@[simp] lemma re_fst_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).fst.re = q.re.fst := rfl +@[simp] lemma im_i_fst_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).fst.im_i = q.im_i.fst := rfl +@[simp] lemma im_j_fst_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).fst.im_j = q.im_j.fst := rfl +@[simp] lemma im_k_fst_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).fst.im_k = q.im_k.fst := rfl +@[simp] lemma re_snd_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).snd.re = q.re.snd := rfl +@[simp] lemma im_i_snd_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).snd.im_i = q.im_i.snd := rfl +@[simp] lemma im_j_snd_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).snd.im_j = q.im_j.snd := rfl +@[simp] lemma im_k_snd_dual_number_equiv (q : quaternion (dual_number R)) : + (dual_number_equiv q).snd.im_k = q.im_k.snd := rfl +@[simp] lemma fst_re_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).re.fst = d.fst.re := rfl +@[simp] lemma fst_im_i_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).im_i.fst = d.fst.im_i := rfl +@[simp] lemma fst_im_j_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).im_j.fst = d.fst.im_j := rfl +@[simp] lemma fst_im_k_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).im_k.fst = d.fst.im_k := rfl +@[simp] lemma snd_re_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).re.snd = d.snd.re := rfl +@[simp] lemma snd_im_i_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).im_i.snd = d.snd.im_i := rfl +@[simp] lemma snd_im_j_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).im_j.snd = d.snd.im_j := rfl +@[simp] lemma snd_im_k_dual_number_equiv_symm (d : dual_number (quaternion R)) : + (dual_number_equiv.symm d).im_k.snd = d.snd.im_k := rfl + +end quaternion diff --git a/src/algebra/euclidean_domain.lean b/src/algebra/euclidean_domain.lean deleted file mode 100644 index f0c264783931a..0000000000000 --- a/src/algebra/euclidean_domain.lean +++ /dev/null @@ -1,479 +0,0 @@ -/- -Copyright (c) 2018 Louis Carlin. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Louis Carlin, Mario Carneiro --/ - -import data.int.basic -import algebra.field.basic - -/-! -# Euclidean domains - -This file introduces Euclidean domains and provides the extended Euclidean algorithm. To be precise, -a slightly more general version is provided which is sometimes called a transfinite Euclidean domain -and differs in the fact that the degree function need not take values in `ℕ` but can take values in -any well-ordered set. Transfinite Euclidean domains were introduced by Motzkin and examples which -don't satisfy the classical notion were provided independently by Hiblot and Nagata. - -## Main definitions - -* `euclidean_domain`: Defines Euclidean domain with functions `quotient` and `remainder`. Instances - of `has_div` and `has_mod` are provided, so that one can write `a = b * (a / b) + a % b`. -* `gcd`: defines the greatest common divisors of two elements of a Euclidean domain. -* `xgcd`: given two elements `a b : R`, `xgcd a b` defines the pair `(x, y)` such that - `x * a + y * b = gcd a b`. -* `lcm`: defines the lowest common multiple of two elements `a` and `b` of a Euclidean domain as - `a * b / (gcd a b)` - -## Main statements - -* `gcd_eq_gcd_ab`: states Bézout's lemma for Euclidean domains. -* `int.euclidean_domain`: shows that `ℤ` is a Euclidean domain. -* `field.to_euclidean_domain`: shows that any field is a Euclidean domain. - -## Notation - -`≺` denotes the well founded relation on the Euclidean domain, e.g. in the example of the polynomial -ring over a field, `p ≺ q` for polynomials `p` and `q` if and only if the degree of `p` is less than -the degree of `q`. - -## Implementation details - -Instead of working with a valuation, `euclidean_domain` is implemented with the existence of a well -founded relation `r` on the integral domain `R`, which in the example of `ℤ` would correspond to -setting `i ≺ j` for integers `i` and `j` if the absolute value of `i` is smaller than the absolute -value of `j`. - -## References - -* [Th. Motzkin, *The Euclidean algorithm*][MR32592] -* [J.-J. Hiblot, *Des anneaux euclidiens dont le plus petit algorithme n'est pas à valeurs finies*] - [MR399081] -* [M. Nagata, *On Euclid algorithm*][MR541021] - - -## Tags - -Euclidean domain, transfinite Euclidean domain, Bézout's lemma --/ - -universe u - -/-- A `euclidean_domain` is an non-trivial commutative ring with a division and a remainder, - satisfying `b * (a / b) + a % b = a`. - The definition of a euclidean domain usually includes a valuation function `R → ℕ`. - This definition is slightly generalised to include a well founded relation - `r` with the property that `r (a % b) b`, instead of a valuation. -/ -@[protect_proj without mul_left_not_lt r_well_founded] -class euclidean_domain (R : Type u) extends comm_ring R, nontrivial R := -(quotient : R → R → R) -(quotient_zero : ∀ a, quotient a 0 = 0) -(remainder : R → R → R) -(quotient_mul_add_remainder_eq : ∀ a b, b * quotient a b + remainder a b = a) -(r : R → R → Prop) -(r_well_founded : well_founded r) -(remainder_lt : ∀ a {b}, b ≠ 0 → r (remainder a b) b) -(mul_left_not_lt : ∀ a {b}, b ≠ 0 → ¬r (a * b) a) - -namespace euclidean_domain -variable {R : Type u} -variables [euclidean_domain R] - -local infix ` ≺ `:50 := euclidean_domain.r - -@[priority 70] -- see Note [lower instance priority] -instance : has_div R := ⟨euclidean_domain.quotient⟩ - -@[priority 70] -- see Note [lower instance priority] -instance : has_mod R := ⟨euclidean_domain.remainder⟩ - -theorem div_add_mod (a b : R) : b * (a / b) + a % b = a := -euclidean_domain.quotient_mul_add_remainder_eq _ _ - -lemma mod_add_div (a b : R) : a % b + b * (a / b) = a := -(add_comm _ _).trans (div_add_mod _ _) - -lemma mod_add_div' (m k : R) : m % k + (m / k) * k = m := -by { rw mul_comm, exact mod_add_div _ _ } - -lemma div_add_mod' (m k : R) : (m / k) * k + m % k = m := -by { rw mul_comm, exact div_add_mod _ _ } - -lemma mod_eq_sub_mul_div {R : Type*} [euclidean_domain R] (a b : R) : - a % b = a - b * (a / b) := -calc a % b = b * (a / b) + a % b - b * (a / b) : (add_sub_cancel' _ _).symm -... = a - b * (a / b) : by rw div_add_mod - -theorem mod_lt : ∀ a {b : R}, b ≠ 0 → (a % b) ≺ b := -euclidean_domain.remainder_lt - -theorem mul_right_not_lt {a : R} (b) (h : a ≠ 0) : ¬(a * b) ≺ b := -by { rw mul_comm, exact mul_left_not_lt b h } - -lemma mul_div_cancel_left {a : R} (b) (a0 : a ≠ 0) : a * b / a = b := -eq.symm $ eq_of_sub_eq_zero $ classical.by_contradiction $ λ h, -begin - have := mul_left_not_lt a h, - rw [mul_sub, sub_eq_iff_eq_add'.2 (div_add_mod (a*b) a).symm] at this, - exact this (mod_lt _ a0) -end - -lemma mul_div_cancel (a) {b : R} (b0 : b ≠ 0) : a * b / b = a := -by { rw mul_comm, exact mul_div_cancel_left a b0 } - -@[simp] lemma mod_zero (a : R) : a % 0 = a := -by simpa only [zero_mul, zero_add] using div_add_mod a 0 - -@[simp] lemma mod_eq_zero {a b : R} : a % b = 0 ↔ b ∣ a := -⟨λ h, by { rw [← div_add_mod a b, h, add_zero], exact dvd_mul_right _ _ }, - λ ⟨c, e⟩, begin - rw [e, ← add_left_cancel_iff, div_add_mod, add_zero], - haveI := classical.dec, - by_cases b0 : b = 0, - { simp only [b0, zero_mul] }, - { rw [mul_div_cancel_left _ b0] } - end⟩ - -@[simp] lemma mod_self (a : R) : a % a = 0 := -mod_eq_zero.2 dvd_rfl - -lemma dvd_mod_iff {a b c : R} (h : c ∣ b) : c ∣ a % b ↔ c ∣ a := -by rw [dvd_add_iff_right (h.mul_right _), div_add_mod] - -lemma lt_one (a : R) : a ≺ (1:R) → a = 0 := -by { haveI := classical.dec, exact - not_imp_not.1 (λ h, by simpa only [one_mul] using mul_left_not_lt 1 h) } - -lemma val_dvd_le : ∀ a b : R, b ∣ a → a ≠ 0 → ¬a ≺ b -| _ b ⟨d, rfl⟩ ha := mul_left_not_lt b (mt (by { rintro rfl, exact mul_zero _ }) ha) - -@[simp] lemma mod_one (a : R) : a % 1 = 0 := -mod_eq_zero.2 (one_dvd _) - -@[simp] lemma zero_mod (b : R) : 0 % b = 0 := -mod_eq_zero.2 (dvd_zero _) - -@[simp, priority 900] lemma div_zero (a : R) : a / 0 = 0 := -euclidean_domain.quotient_zero a - -@[simp, priority 900] lemma zero_div {a : R} : 0 / a = 0 := -classical.by_cases - (λ a0 : a = 0, a0.symm ▸ div_zero 0) - (λ a0, by simpa only [zero_mul] using mul_div_cancel 0 a0) - -@[simp, priority 900] lemma div_self {a : R} (a0 : a ≠ 0) : a / a = 1 := -by simpa only [one_mul] using mul_div_cancel 1 a0 - -lemma eq_div_of_mul_eq_left {a b c : R} (hb : b ≠ 0) (h : a * b = c) : a = c / b := -by rw [← h, mul_div_cancel _ hb] - -lemma eq_div_of_mul_eq_right {a b c : R} (ha : a ≠ 0) (h : a * b = c) : b = c / a := -by rw [← h, mul_div_cancel_left _ ha] - -theorem mul_div_assoc (x : R) {y z : R} (h : z ∣ y) : x * y / z = x * (y / z) := -begin - classical, by_cases hz : z = 0, - { subst hz, rw [div_zero, div_zero, mul_zero] }, - rcases h with ⟨p, rfl⟩, - rw [mul_div_cancel_left _ hz, mul_left_comm, mul_div_cancel_left _ hz] -end - -@[simp, priority 900] -- This generalizes `int.div_one`, see note [simp-normal form] -lemma div_one (p : R) : p / 1 = p := -(euclidean_domain.eq_div_of_mul_eq_left (@one_ne_zero R _ _) (mul_one p)).symm - -lemma div_dvd_of_dvd {p q : R} (hpq : q ∣ p) : - p / q ∣ p := -begin - by_cases hq : q = 0, - { rw [hq, zero_dvd_iff] at hpq, - rw hpq, - exact dvd_zero _ }, - use q, - rw [mul_comm, ← euclidean_domain.mul_div_assoc _ hpq, mul_comm, - euclidean_domain.mul_div_cancel _ hq] -end - -lemma dvd_div_of_mul_dvd {a b c : R} (h : a * b ∣ c) : b ∣ c / a := -begin - rcases eq_or_ne a 0 with rfl | ha, - { simp only [div_zero, dvd_zero] }, - rcases h with ⟨d, rfl⟩, - refine ⟨d, _⟩, - rw [mul_assoc, mul_div_cancel_left _ ha] -end - -section -open_locale classical - -@[elab_as_eliminator] -theorem gcd.induction {P : R → R → Prop} : ∀ a b : R, - (∀ x, P 0 x) → - (∀ a b, a ≠ 0 → P (b % a) a → P a b) → - P a b -| a := λ b H0 H1, if a0 : a = 0 then a0.symm ▸ H0 _ else - have h:_ := mod_lt b a0, - H1 _ _ a0 (gcd.induction (b%a) a H0 H1) -using_well_founded {dec_tac := tactic.assumption, - rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]} - -end - -section gcd -variable [decidable_eq R] - -/-- `gcd a b` is a (non-unique) element such that `gcd a b ∣ a` `gcd a b ∣ b`, and for - any element `c` such that `c ∣ a` and `c ∣ b`, then `c ∣ gcd a b` -/ -def gcd : R → R → R -| a := λ b, if a0 : a = 0 then b else - have h:_ := mod_lt b a0, - gcd (b%a) a -using_well_founded {dec_tac := tactic.assumption, - rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]} - -@[simp] theorem gcd_zero_left (a : R) : gcd 0 a = a := -by { rw gcd, exact if_pos rfl } - -@[simp] theorem gcd_zero_right (a : R) : gcd a 0 = a := -by { rw gcd, split_ifs; simp only [h, zero_mod, gcd_zero_left] } - -theorem gcd_val (a b : R) : gcd a b = gcd (b % a) a := -by { rw gcd, split_ifs; [simp only [h, mod_zero, gcd_zero_right], refl]} - -theorem gcd_dvd (a b : R) : gcd a b ∣ a ∧ gcd a b ∣ b := -gcd.induction a b - (λ b, by { rw gcd_zero_left, exact ⟨dvd_zero _, dvd_rfl⟩ }) - (λ a b aneq ⟨IH₁, IH₂⟩, by { rw gcd_val, - exact ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩ }) - -theorem gcd_dvd_left (a b : R) : gcd a b ∣ a := (gcd_dvd a b).left - -theorem gcd_dvd_right (a b : R) : gcd a b ∣ b := (gcd_dvd a b).right - -protected theorem gcd_eq_zero_iff {a b : R} : - gcd a b = 0 ↔ a = 0 ∧ b = 0 := -⟨λ h, by simpa [h] using gcd_dvd a b, - by { rintro ⟨rfl, rfl⟩, exact gcd_zero_right _ }⟩ - -theorem dvd_gcd {a b c : R} : c ∣ a → c ∣ b → c ∣ gcd a b := -gcd.induction a b - (λ _ _ H, by simpa only [gcd_zero_left] using H) - (λ a b a0 IH ca cb, by { rw gcd_val, - exact IH ((dvd_mod_iff ca).2 cb) ca }) - -theorem gcd_eq_left {a b : R} : gcd a b = a ↔ a ∣ b := -⟨λ h, by {rw ← h, apply gcd_dvd_right }, - λ h, by rw [gcd_val, mod_eq_zero.2 h, gcd_zero_left]⟩ - -@[simp] theorem gcd_one_left (a : R) : gcd 1 a = 1 := -gcd_eq_left.2 (one_dvd _) - -@[simp] theorem gcd_self (a : R) : gcd a a = a := -gcd_eq_left.2 dvd_rfl - -/-- -An implementation of the extended GCD algorithm. -At each step we are computing a triple `(r, s, t)`, where `r` is the next value of the GCD -algorithm, to compute the greatest common divisor of the input (say `x` and `y`), and `s` and `t` -are the coefficients in front of `x` and `y` to obtain `r` (i.e. `r = s * x + t * y`). -The function `xgcd_aux` takes in two triples, and from these recursively computes the next triple: -``` -xgcd_aux (r, s, t) (r', s', t') = xgcd_aux (r' % r, s' - (r' / r) * s, t' - (r' / r) * t) (r, s, t) -``` --/ -def xgcd_aux : R → R → R → R → R → R → R × R × R -| r := λ s t r' s' t', -if hr : r = 0 then (r', s', t') - else - have r' % r ≺ r, from mod_lt _ hr, - let q := r' / r in xgcd_aux (r' % r) (s' - q * s) (t' - q * t) r s t -using_well_founded {dec_tac := tactic.assumption, - rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]} - -@[simp] theorem xgcd_zero_left {s t r' s' t' : R} : xgcd_aux 0 s t r' s' t' = (r', s', t') := -by { unfold xgcd_aux, exact if_pos rfl } - -theorem xgcd_aux_rec {r s t r' s' t' : R} (h : r ≠ 0) : - xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - (r' / r) * s) (t' - (r' / r) * t) r s t := -by { conv {to_lhs, rw [xgcd_aux]}, exact if_neg h} - -/-- Use the extended GCD algorithm to generate the `a` and `b` values - satisfying `gcd x y = x * a + y * b`. -/ -def xgcd (x y : R) : R × R := (xgcd_aux x 1 0 y 0 1).2 - -/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/ -def gcd_a (x y : R) : R := (xgcd x y).1 - -/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/ -def gcd_b (x y : R) : R := (xgcd x y).2 - -@[simp] theorem gcd_a_zero_left {s : R} : gcd_a 0 s = 0 := -by { unfold gcd_a, rw [xgcd, xgcd_zero_left] } - -@[simp] theorem gcd_b_zero_left {s : R} : gcd_b 0 s = 1 := -by { unfold gcd_b, rw [xgcd, xgcd_zero_left] } - -@[simp] theorem xgcd_aux_fst (x y : R) : ∀ s t s' t', - (xgcd_aux x s t y s' t').1 = gcd x y := -gcd.induction x y (by { intros, rw [xgcd_zero_left, gcd_zero_left] }) -(λ x y h IH s t s' t', by { simp only [xgcd_aux_rec h, if_neg h, IH], rw ← gcd_val }) - -theorem xgcd_aux_val (x y : R) : xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) := -by rw [xgcd, ← xgcd_aux_fst x y 1 0 0 1, prod.mk.eta] - -theorem xgcd_val (x y : R) : xgcd x y = (gcd_a x y, gcd_b x y) := -prod.mk.eta.symm - -private def P (a b : R) : R × R × R → Prop | (r, s, t) := (r : R) = a * s + b * t - -theorem xgcd_aux_P (a b : R) {r r' : R} : ∀ {s t s' t'}, P a b (r, s, t) → - P a b (r', s', t') → P a b (xgcd_aux r s t r' s' t') := -gcd.induction r r' (by { intros, simpa only [xgcd_zero_left] }) $ λ x y h IH s t s' t' p p', begin - rw [xgcd_aux_rec h], refine IH _ p, unfold P at p p' ⊢, - rw [mul_sub, mul_sub, add_sub, sub_add_eq_add_sub, ← p', sub_sub, - mul_comm _ s, ← mul_assoc, mul_comm _ t, ← mul_assoc, ← add_mul, ← p, - mod_eq_sub_mul_div] -end - -/-- An explicit version of **Bézout's lemma** for Euclidean domains. -/ -theorem gcd_eq_gcd_ab (a b : R) : (gcd a b : R) = a * gcd_a a b + b * gcd_b a b := -by { have := @xgcd_aux_P _ _ _ a b a b 1 0 0 1 - (by rw [P, mul_one, mul_zero, add_zero]) (by rw [P, mul_one, mul_zero, zero_add]), -rwa [xgcd_aux_val, xgcd_val] at this } - -@[priority 70] -- see Note [lower instance priority] -instance (R : Type*) [e : euclidean_domain R] : is_domain R := -by { haveI := classical.dec_eq R, exact -{ eq_zero_or_eq_zero_of_mul_eq_zero := - λ a b h, (or_iff_not_and_not.2 $ λ h0, - h0.1 $ by rw [← mul_div_cancel a h0.2, h, zero_div]), - ..e }} - -end gcd - -section lcm -variables [decidable_eq R] - -/-- `lcm a b` is a (non-unique) element such that `a ∣ lcm a b` `b ∣ lcm a b`, and for - any element `c` such that `a ∣ c` and `b ∣ c`, then `lcm a b ∣ c` -/ -def lcm (x y : R) : R := -x * y / gcd x y - -theorem dvd_lcm_left (x y : R) : x ∣ lcm x y := -classical.by_cases - (assume hxy : gcd x y = 0, by { rw [lcm, hxy, div_zero], exact dvd_zero _ }) - (λ hxy, let ⟨z, hz⟩ := (gcd_dvd x y).2 in ⟨z, eq.symm $ eq_div_of_mul_eq_left hxy $ - by rw [mul_right_comm, mul_assoc, ← hz]⟩) - -theorem dvd_lcm_right (x y : R) : y ∣ lcm x y := -classical.by_cases - (assume hxy : gcd x y = 0, by { rw [lcm, hxy, div_zero], exact dvd_zero _ }) - (λ hxy, let ⟨z, hz⟩ := (gcd_dvd x y).1 in ⟨z, eq.symm $ eq_div_of_mul_eq_right hxy $ - by rw [← mul_assoc, mul_right_comm, ← hz]⟩) - -theorem lcm_dvd {x y z : R} (hxz : x ∣ z) (hyz : y ∣ z) : lcm x y ∣ z := -begin - rw lcm, by_cases hxy : gcd x y = 0, - { rw [hxy, div_zero], rw euclidean_domain.gcd_eq_zero_iff at hxy, rwa hxy.1 at hxz }, - rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩, - suffices : x * y ∣ z * gcd x y, - { cases this with p hp, use p, - generalize_hyp : gcd x y = g at hxy hs hp ⊢, subst hs, - rw [mul_left_comm, mul_div_cancel_left _ hxy, ← mul_left_inj' hxy, hp], - rw [← mul_assoc], simp only [mul_right_comm] }, - rw [gcd_eq_gcd_ab, mul_add], apply dvd_add, - { rw mul_left_comm, exact mul_dvd_mul_left _ (hyz.mul_right _) }, - { rw [mul_left_comm, mul_comm], exact mul_dvd_mul_left _ (hxz.mul_right _) } -end - -@[simp] lemma lcm_dvd_iff {x y z : R} : lcm x y ∣ z ↔ x ∣ z ∧ y ∣ z := -⟨λ hz, ⟨(dvd_lcm_left _ _).trans hz, (dvd_lcm_right _ _).trans hz⟩, -λ ⟨hxz, hyz⟩, lcm_dvd hxz hyz⟩ - -@[simp] lemma lcm_zero_left (x : R) : lcm 0 x = 0 := -by rw [lcm, zero_mul, zero_div] - -@[simp] lemma lcm_zero_right (x : R) : lcm x 0 = 0 := -by rw [lcm, mul_zero, zero_div] - -@[simp] lemma lcm_eq_zero_iff {x y : R} : lcm x y = 0 ↔ x = 0 ∨ y = 0 := -begin - split, - { intro hxy, rw [lcm, mul_div_assoc _ (gcd_dvd_right _ _), mul_eq_zero] at hxy, - apply or_of_or_of_imp_right hxy, intro hy, - by_cases hgxy : gcd x y = 0, - { rw euclidean_domain.gcd_eq_zero_iff at hgxy, exact hgxy.2 }, - { rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩, - generalize_hyp : gcd x y = g at hr hs hy hgxy ⊢, subst hs, - rw [mul_div_cancel_left _ hgxy] at hy, rw [hy, mul_zero] } }, - rintro (hx | hy), - { rw [hx, lcm_zero_left] }, - { rw [hy, lcm_zero_right] } -end - -@[simp] lemma gcd_mul_lcm (x y : R) : gcd x y * lcm x y = x * y := -begin - rw lcm, by_cases h : gcd x y = 0, - { rw [h, zero_mul], rw euclidean_domain.gcd_eq_zero_iff at h, rw [h.1, zero_mul] }, - rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩, - generalize_hyp : gcd x y = g at h hr ⊢, subst hr, - rw [mul_assoc, mul_div_cancel_left _ h] -end - -end lcm - -section div - -lemma mul_div_mul_cancel {a b c : R} (ha : a ≠ 0) (hcb : c ∣ b) : - a * b / (a * c) = b / c := -begin - by_cases hc : c = 0, { simp [hc] }, - refine eq_div_of_mul_eq_right hc (mul_left_cancel₀ ha _), - rw [← mul_assoc, ← mul_div_assoc _ (mul_dvd_mul_left a hcb), - mul_div_cancel_left _ (mul_ne_zero ha hc)] -end - -end div - -end euclidean_domain - -instance int.euclidean_domain : euclidean_domain ℤ := -{ add := (+), - mul := (*), - one := 1, - zero := 0, - neg := has_neg.neg, - quotient := (/), - quotient_zero := int.div_zero, - remainder := (%), - quotient_mul_add_remainder_eq := λ a b, int.div_add_mod _ _, - r := λ a b, a.nat_abs < b.nat_abs, - r_well_founded := measure_wf (λ a, int.nat_abs a), - remainder_lt := λ a b b0, int.coe_nat_lt.1 $ - by { rw [int.nat_abs_of_nonneg (int.mod_nonneg _ b0), ← int.abs_eq_nat_abs], - exact int.mod_lt _ b0 }, - mul_left_not_lt := λ a b b0, not_lt_of_ge $ - by {rw [← mul_one a.nat_abs, int.nat_abs_mul], - exact mul_le_mul_of_nonneg_left (int.nat_abs_pos_of_ne_zero b0) (nat.zero_le _) }, - .. int.comm_ring, - .. int.nontrivial } - -@[priority 100] -- see Note [lower instance priority] -instance field.to_euclidean_domain {K : Type u} [field K] : euclidean_domain K := -{ add := (+), - mul := (*), - one := 1, - zero := 0, - neg := has_neg.neg, - quotient := (/), - remainder := λ a b, a - a * b / b, - quotient_zero := div_zero, - quotient_mul_add_remainder_eq := λ a b, - by { classical, by_cases b = 0; simp [h, mul_div_cancel'] }, - r := λ a b, a = 0 ∧ b ≠ 0, - r_well_founded := well_founded.intro $ λ a, acc.intro _ $ λ b ⟨hb, hna⟩, - acc.intro _ $ λ c ⟨hc, hnb⟩, false.elim $ hnb hb, - remainder_lt := λ a b hnb, by simp [hnb], - mul_left_not_lt := λ a b hnb ⟨hab, hna⟩, or.cases_on (mul_eq_zero.1 hab) hna hnb, - .. ‹field K› } diff --git a/src/algebra/euclidean_domain/basic.lean b/src/algebra/euclidean_domain/basic.lean new file mode 100644 index 0000000000000..026e3911720ba --- /dev/null +++ b/src/algebra/euclidean_domain/basic.lean @@ -0,0 +1,283 @@ +/- +Copyright (c) 2018 Louis Carlin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Louis Carlin, Mario Carneiro +-/ +import algebra.euclidean_domain.defs +import algebra.ring.divisibility +import algebra.ring.regular +import algebra.group_with_zero.divisibility +import algebra.ring.basic + +/-! +# Lemmas about Euclidean domains + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main statements + +* `gcd_eq_gcd_ab`: states Bézout's lemma for Euclidean domains. + +-/ + +universe u + +namespace euclidean_domain +variable {R : Type u} +variables [euclidean_domain R] + +local infix ` ≺ `:50 := euclidean_domain.r + +lemma mul_div_cancel_left {a : R} (b) (a0 : a ≠ 0) : a * b / a = b := +eq.symm $ eq_of_sub_eq_zero $ classical.by_contradiction $ λ h, +begin + have := mul_left_not_lt a h, + rw [mul_sub, sub_eq_iff_eq_add'.2 (div_add_mod (a*b) a).symm] at this, + exact this (mod_lt _ a0) +end + +lemma mul_div_cancel (a) {b : R} (b0 : b ≠ 0) : a * b / b = a := +by { rw mul_comm, exact mul_div_cancel_left a b0 } + +@[simp] lemma mod_eq_zero {a b : R} : a % b = 0 ↔ b ∣ a := +⟨λ h, by { rw [← div_add_mod a b, h, add_zero], exact dvd_mul_right _ _ }, + λ ⟨c, e⟩, begin + rw [e, ← add_left_cancel_iff, div_add_mod, add_zero], + haveI := classical.dec, + by_cases b0 : b = 0, + { simp only [b0, zero_mul] }, + { rw [mul_div_cancel_left _ b0] } + end⟩ + +@[simp] lemma mod_self (a : R) : a % a = 0 := +mod_eq_zero.2 dvd_rfl + +lemma dvd_mod_iff {a b c : R} (h : c ∣ b) : c ∣ a % b ↔ c ∣ a := +by rw [←dvd_add_right (h.mul_right _), div_add_mod] + +@[simp] lemma mod_one (a : R) : a % 1 = 0 := +mod_eq_zero.2 (one_dvd _) + +@[simp] lemma zero_mod (b : R) : 0 % b = 0 := +mod_eq_zero.2 (dvd_zero _) + +@[simp, priority 900] lemma zero_div {a : R} : 0 / a = 0 := +classical.by_cases + (λ a0 : a = 0, a0.symm ▸ div_zero 0) + (λ a0, by simpa only [zero_mul] using mul_div_cancel 0 a0) + +@[simp, priority 900] lemma div_self {a : R} (a0 : a ≠ 0) : a / a = 1 := +by simpa only [one_mul] using mul_div_cancel 1 a0 + +lemma eq_div_of_mul_eq_left {a b c : R} (hb : b ≠ 0) (h : a * b = c) : a = c / b := +by rw [← h, mul_div_cancel _ hb] + +lemma eq_div_of_mul_eq_right {a b c : R} (ha : a ≠ 0) (h : a * b = c) : b = c / a := +by rw [← h, mul_div_cancel_left _ ha] + +theorem mul_div_assoc (x : R) {y z : R} (h : z ∣ y) : x * y / z = x * (y / z) := +begin + classical, by_cases hz : z = 0, + { subst hz, rw [div_zero, div_zero, mul_zero] }, + rcases h with ⟨p, rfl⟩, + rw [mul_div_cancel_left _ hz, mul_left_comm, mul_div_cancel_left _ hz] +end + +protected lemma mul_div_cancel' {a b : R} (hb : b ≠ 0) (hab : b ∣ a) : b * (a / b) = a := +by rw [←mul_div_assoc _ hab, mul_div_cancel_left _ hb] + +@[simp, priority 900] -- This generalizes `int.div_one`, see note [simp-normal form] +lemma div_one (p : R) : p / 1 = p := +(euclidean_domain.eq_div_of_mul_eq_left (one_ne_zero' R) (mul_one p)).symm + +lemma div_dvd_of_dvd {p q : R} (hpq : q ∣ p) : + p / q ∣ p := +begin + by_cases hq : q = 0, + { rw [hq, zero_dvd_iff] at hpq, + rw hpq, + exact dvd_zero _ }, + use q, + rw [mul_comm, ← euclidean_domain.mul_div_assoc _ hpq, mul_comm, + euclidean_domain.mul_div_cancel _ hq] +end + +lemma dvd_div_of_mul_dvd {a b c : R} (h : a * b ∣ c) : b ∣ c / a := +begin + rcases eq_or_ne a 0 with rfl | ha, + { simp only [div_zero, dvd_zero] }, + rcases h with ⟨d, rfl⟩, + refine ⟨d, _⟩, + rw [mul_assoc, mul_div_cancel_left _ ha] +end + +section gcd +variable [decidable_eq R] + +@[simp] theorem gcd_zero_right (a : R) : gcd a 0 = a := +by { rw gcd, split_ifs; simp only [h, zero_mod, gcd_zero_left] } + +theorem gcd_val (a b : R) : gcd a b = gcd (b % a) a := +by { rw gcd, split_ifs; [simp only [h, mod_zero, gcd_zero_right], refl]} + +theorem gcd_dvd (a b : R) : gcd a b ∣ a ∧ gcd a b ∣ b := +gcd.induction a b + (λ b, by { rw gcd_zero_left, exact ⟨dvd_zero _, dvd_rfl⟩ }) + (λ a b aneq ⟨IH₁, IH₂⟩, by { rw gcd_val, + exact ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩ }) + +theorem gcd_dvd_left (a b : R) : gcd a b ∣ a := (gcd_dvd a b).left + +theorem gcd_dvd_right (a b : R) : gcd a b ∣ b := (gcd_dvd a b).right + +protected theorem gcd_eq_zero_iff {a b : R} : + gcd a b = 0 ↔ a = 0 ∧ b = 0 := +⟨λ h, by simpa [h] using gcd_dvd a b, + by { rintro ⟨rfl, rfl⟩, exact gcd_zero_right _ }⟩ + +theorem dvd_gcd {a b c : R} : c ∣ a → c ∣ b → c ∣ gcd a b := +gcd.induction a b + (λ _ _ H, by simpa only [gcd_zero_left] using H) + (λ a b a0 IH ca cb, by { rw gcd_val, + exact IH ((dvd_mod_iff ca).2 cb) ca }) + +theorem gcd_eq_left {a b : R} : gcd a b = a ↔ a ∣ b := +⟨λ h, by {rw ← h, apply gcd_dvd_right }, + λ h, by rw [gcd_val, mod_eq_zero.2 h, gcd_zero_left]⟩ + +@[simp] theorem gcd_one_left (a : R) : gcd 1 a = 1 := +gcd_eq_left.2 (one_dvd _) + +@[simp] theorem gcd_self (a : R) : gcd a a = a := +gcd_eq_left.2 dvd_rfl + +@[simp] theorem xgcd_aux_fst (x y : R) : ∀ s t s' t', + (xgcd_aux x s t y s' t').1 = gcd x y := +gcd.induction x y (by { intros, rw [xgcd_zero_left, gcd_zero_left] }) +(λ x y h IH s t s' t', by { simp only [xgcd_aux_rec h, if_neg h, IH], rw ← gcd_val }) + +theorem xgcd_aux_val (x y : R) : xgcd_aux x 1 0 y 0 1 = (gcd x y, xgcd x y) := +by rw [xgcd, ← xgcd_aux_fst x y 1 0 0 1, prod.mk.eta] + +private def P (a b : R) : R × R × R → Prop | (r, s, t) := (r : R) = a * s + b * t + +theorem xgcd_aux_P (a b : R) {r r' : R} : ∀ {s t s' t'}, P a b (r, s, t) → + P a b (r', s', t') → P a b (xgcd_aux r s t r' s' t') := +gcd.induction r r' (by { intros, simpa only [xgcd_zero_left] }) $ λ x y h IH s t s' t' p p', begin + rw [xgcd_aux_rec h], refine IH _ p, unfold P at p p' ⊢, + rw [mul_sub, mul_sub, add_sub, sub_add_eq_add_sub, ← p', sub_sub, + mul_comm _ s, ← mul_assoc, mul_comm _ t, ← mul_assoc, ← add_mul, ← p, + mod_eq_sub_mul_div] +end + +/-- An explicit version of **Bézout's lemma** for Euclidean domains. -/ +theorem gcd_eq_gcd_ab (a b : R) : (gcd a b : R) = a * gcd_a a b + b * gcd_b a b := +by { have := @xgcd_aux_P _ _ _ a b a b 1 0 0 1 + (by rw [P, mul_one, mul_zero, add_zero]) (by rw [P, mul_one, mul_zero, zero_add]), +rwa [xgcd_aux_val, xgcd_val] at this } + +@[priority 70] -- see Note [lower instance priority] +instance (R : Type*) [e : euclidean_domain R] : no_zero_divisors R := +by { haveI := classical.dec_eq R, exact +{ eq_zero_or_eq_zero_of_mul_eq_zero := + λ a b h, (or_iff_not_and_not.2 $ λ h0, + h0.1 $ by rw [← mul_div_cancel a h0.2, h, zero_div]) }} + +@[priority 70] -- see Note [lower instance priority] +instance (R : Type*) [e : euclidean_domain R] : is_domain R := +{ .. e, .. no_zero_divisors.to_is_domain R } + +end gcd + +section lcm +variables [decidable_eq R] + +theorem dvd_lcm_left (x y : R) : x ∣ lcm x y := +classical.by_cases + (assume hxy : gcd x y = 0, by { rw [lcm, hxy, div_zero], exact dvd_zero _ }) + (λ hxy, let ⟨z, hz⟩ := (gcd_dvd x y).2 in ⟨z, eq.symm $ eq_div_of_mul_eq_left hxy $ + by rw [mul_right_comm, mul_assoc, ← hz]⟩) + +theorem dvd_lcm_right (x y : R) : y ∣ lcm x y := +classical.by_cases + (assume hxy : gcd x y = 0, by { rw [lcm, hxy, div_zero], exact dvd_zero _ }) + (λ hxy, let ⟨z, hz⟩ := (gcd_dvd x y).1 in ⟨z, eq.symm $ eq_div_of_mul_eq_right hxy $ + by rw [← mul_assoc, mul_right_comm, ← hz]⟩) + +theorem lcm_dvd {x y z : R} (hxz : x ∣ z) (hyz : y ∣ z) : lcm x y ∣ z := +begin + rw lcm, by_cases hxy : gcd x y = 0, + { rw [hxy, div_zero], rw euclidean_domain.gcd_eq_zero_iff at hxy, rwa hxy.1 at hxz }, + rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩, + suffices : x * y ∣ z * gcd x y, + { cases this with p hp, use p, + generalize_hyp : gcd x y = g at hxy hs hp ⊢, subst hs, + rw [mul_left_comm, mul_div_cancel_left _ hxy, ← mul_left_inj' hxy, hp], + rw [← mul_assoc], simp only [mul_right_comm] }, + rw [gcd_eq_gcd_ab, mul_add], apply dvd_add, + { rw mul_left_comm, exact mul_dvd_mul_left _ (hyz.mul_right _) }, + { rw [mul_left_comm, mul_comm], exact mul_dvd_mul_left _ (hxz.mul_right _) } +end + +@[simp] lemma lcm_dvd_iff {x y z : R} : lcm x y ∣ z ↔ x ∣ z ∧ y ∣ z := +⟨λ hz, ⟨(dvd_lcm_left _ _).trans hz, (dvd_lcm_right _ _).trans hz⟩, +λ ⟨hxz, hyz⟩, lcm_dvd hxz hyz⟩ + +@[simp] lemma lcm_zero_left (x : R) : lcm 0 x = 0 := +by rw [lcm, zero_mul, zero_div] + +@[simp] lemma lcm_zero_right (x : R) : lcm x 0 = 0 := +by rw [lcm, mul_zero, zero_div] + +@[simp] lemma lcm_eq_zero_iff {x y : R} : lcm x y = 0 ↔ x = 0 ∨ y = 0 := +begin + split, + { intro hxy, rw [lcm, mul_div_assoc _ (gcd_dvd_right _ _), mul_eq_zero] at hxy, + apply or_of_or_of_imp_right hxy, intro hy, + by_cases hgxy : gcd x y = 0, + { rw euclidean_domain.gcd_eq_zero_iff at hgxy, exact hgxy.2 }, + { rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩, + generalize_hyp : gcd x y = g at hr hs hy hgxy ⊢, subst hs, + rw [mul_div_cancel_left _ hgxy] at hy, rw [hy, mul_zero] } }, + rintro (hx | hy), + { rw [hx, lcm_zero_left] }, + { rw [hy, lcm_zero_right] } +end + +@[simp] lemma gcd_mul_lcm (x y : R) : gcd x y * lcm x y = x * y := +begin + rw lcm, by_cases h : gcd x y = 0, + { rw [h, zero_mul], rw euclidean_domain.gcd_eq_zero_iff at h, rw [h.1, zero_mul] }, + rcases gcd_dvd x y with ⟨⟨r, hr⟩, ⟨s, hs⟩⟩, + generalize_hyp : gcd x y = g at h hr ⊢, subst hr, + rw [mul_assoc, mul_div_cancel_left _ h] +end + +end lcm + +section div + +lemma mul_div_mul_cancel {a b c : R} (ha : a ≠ 0) (hcb : c ∣ b) : + a * b / (a * c) = b / c := +begin + by_cases hc : c = 0, { simp [hc] }, + refine eq_div_of_mul_eq_right hc (mul_left_cancel₀ ha _), + rw [← mul_assoc, ← mul_div_assoc _ (mul_dvd_mul_left a hcb), + mul_div_cancel_left _ (mul_ne_zero ha hc)] +end + +lemma mul_div_mul_comm_of_dvd_dvd {a b c d : R} (hac : c ∣ a) (hbd : d ∣ b) : + a * b / (c * d) = a / c * (b / d) := +begin + rcases eq_or_ne c 0 with rfl | hc0, { simp }, + rcases eq_or_ne d 0 with rfl | hd0, { simp }, + obtain ⟨k1, rfl⟩ := hac, + obtain ⟨k2, rfl⟩ := hbd, + rw [mul_div_cancel_left _ hc0, mul_div_cancel_left _ hd0, mul_mul_mul_comm, + mul_div_cancel_left _ (mul_ne_zero hc0 hd0)], +end + +end div + +end euclidean_domain diff --git a/src/algebra/euclidean_domain/defs.lean b/src/algebra/euclidean_domain/defs.lean new file mode 100644 index 0000000000000..18d9d394c8437 --- /dev/null +++ b/src/algebra/euclidean_domain/defs.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2018 Louis Carlin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Louis Carlin, Mario Carneiro +-/ +import logic.nontrivial +import algebra.divisibility.basic +import algebra.group.basic +import algebra.ring.defs + +/-! +# Euclidean domains + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file introduces Euclidean domains and provides the extended Euclidean algorithm. To be precise, +a slightly more general version is provided which is sometimes called a transfinite Euclidean domain +and differs in the fact that the degree function need not take values in `ℕ` but can take values in +any well-ordered set. Transfinite Euclidean domains were introduced by Motzkin and examples which +don't satisfy the classical notion were provided independently by Hiblot and Nagata. + +## Main definitions + +* `euclidean_domain`: Defines Euclidean domain with functions `quotient` and `remainder`. Instances + of `has_div` and `has_mod` are provided, so that one can write `a = b * (a / b) + a % b`. +* `gcd`: defines the greatest common divisors of two elements of a Euclidean domain. +* `xgcd`: given two elements `a b : R`, `xgcd a b` defines the pair `(x, y)` such that + `x * a + y * b = gcd a b`. +* `lcm`: defines the lowest common multiple of two elements `a` and `b` of a Euclidean domain as + `a * b / (gcd a b)` + +## Main statements + +See `algebra.euclidean_domain.basic` for most of the theorems about Euclidean domains, +including Bézout's lemma. + +See `algebra.euclidean_domain.instances` for the fact that `ℤ` is a Euclidean domain, +as is any field. + +## Notation + +`≺` denotes the well founded relation on the Euclidean domain, e.g. in the example of the polynomial +ring over a field, `p ≺ q` for polynomials `p` and `q` if and only if the degree of `p` is less than +the degree of `q`. + +## Implementation details + +Instead of working with a valuation, `euclidean_domain` is implemented with the existence of a well +founded relation `r` on the integral domain `R`, which in the example of `ℤ` would correspond to +setting `i ≺ j` for integers `i` and `j` if the absolute value of `i` is smaller than the absolute +value of `j`. + +## References + +* [Th. Motzkin, *The Euclidean algorithm*][MR32592] +* [J.-J. Hiblot, *Des anneaux euclidiens dont le plus petit algorithme n'est pas à valeurs finies*] + [MR399081] +* [M. Nagata, *On Euclid algorithm*][MR541021] + + +## Tags + +Euclidean domain, transfinite Euclidean domain, Bézout's lemma +-/ + +universe u + +/-- A `euclidean_domain` is an non-trivial commutative ring with a division and a remainder, + satisfying `b * (a / b) + a % b = a`. + The definition of a euclidean domain usually includes a valuation function `R → ℕ`. + This definition is slightly generalised to include a well founded relation + `r` with the property that `r (a % b) b`, instead of a valuation. -/ +@[protect_proj without mul_left_not_lt r_well_founded] +class euclidean_domain (R : Type u) extends comm_ring R, nontrivial R := +(quotient : R → R → R) +(quotient_zero : ∀ a, quotient a 0 = 0) +(remainder : R → R → R) +(quotient_mul_add_remainder_eq : ∀ a b, b * quotient a b + remainder a b = a) +(r : R → R → Prop) +(r_well_founded : well_founded r) +(remainder_lt : ∀ a {b}, b ≠ 0 → r (remainder a b) b) +(mul_left_not_lt : ∀ a {b}, b ≠ 0 → ¬r (a * b) a) + +namespace euclidean_domain +variable {R : Type u} +variables [euclidean_domain R] + +local infix ` ≺ `:50 := euclidean_domain.r + +@[priority 70] -- see Note [lower instance priority] +instance : has_div R := ⟨euclidean_domain.quotient⟩ + +@[priority 70] -- see Note [lower instance priority] +instance : has_mod R := ⟨euclidean_domain.remainder⟩ + +theorem div_add_mod (a b : R) : b * (a / b) + a % b = a := +euclidean_domain.quotient_mul_add_remainder_eq _ _ + +lemma mod_add_div (a b : R) : a % b + b * (a / b) = a := +(add_comm _ _).trans (div_add_mod _ _) + +lemma mod_add_div' (m k : R) : m % k + (m / k) * k = m := +by { rw mul_comm, exact mod_add_div _ _ } + +lemma div_add_mod' (m k : R) : (m / k) * k + m % k = m := +by { rw mul_comm, exact div_add_mod _ _ } + +lemma mod_eq_sub_mul_div {R : Type*} [euclidean_domain R] (a b : R) : + a % b = a - b * (a / b) := +calc a % b = b * (a / b) + a % b - b * (a / b) : (add_sub_cancel' _ _).symm +... = a - b * (a / b) : by rw div_add_mod + +theorem mod_lt : ∀ a {b : R}, b ≠ 0 → (a % b) ≺ b := +euclidean_domain.remainder_lt + +theorem mul_right_not_lt {a : R} (b) (h : a ≠ 0) : ¬(a * b) ≺ b := +by { rw mul_comm, exact mul_left_not_lt b h } + +@[simp] lemma mod_zero (a : R) : a % 0 = a := +by simpa only [zero_mul, zero_add] using div_add_mod a 0 + +lemma lt_one (a : R) : a ≺ (1:R) → a = 0 := +by { haveI := classical.dec, exact + not_imp_not.1 (λ h, by simpa only [one_mul] using mul_left_not_lt 1 h) } + +lemma val_dvd_le : ∀ a b : R, b ∣ a → a ≠ 0 → ¬a ≺ b +| _ b ⟨d, rfl⟩ ha := mul_left_not_lt b (mt (by { rintro rfl, exact mul_zero _ }) ha) + +@[simp, priority 900] lemma div_zero (a : R) : a / 0 = 0 := +euclidean_domain.quotient_zero a + +section +open_locale classical + +@[elab_as_eliminator] +theorem gcd.induction {P : R → R → Prop} : ∀ a b : R, + (∀ x, P 0 x) → + (∀ a b, a ≠ 0 → P (b % a) a → P a b) → + P a b +| a := λ b H0 H1, if a0 : a = 0 then a0.symm ▸ H0 _ else + have h:_ := mod_lt b a0, + H1 _ _ a0 (gcd.induction (b%a) a H0 H1) +using_well_founded {dec_tac := tactic.assumption, + rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]} + +end + +section gcd +variable [decidable_eq R] + +/-- `gcd a b` is a (non-unique) element such that `gcd a b ∣ a` `gcd a b ∣ b`, and for + any element `c` such that `c ∣ a` and `c ∣ b`, then `c ∣ gcd a b` -/ +def gcd : R → R → R +| a := λ b, if a0 : a = 0 then b else + have h:_ := mod_lt b a0, + gcd (b%a) a +using_well_founded {dec_tac := tactic.assumption, + rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]} + +@[simp] theorem gcd_zero_left (a : R) : gcd 0 a = a := +by { rw gcd, exact if_pos rfl } + +/-- +An implementation of the extended GCD algorithm. +At each step we are computing a triple `(r, s, t)`, where `r` is the next value of the GCD +algorithm, to compute the greatest common divisor of the input (say `x` and `y`), and `s` and `t` +are the coefficients in front of `x` and `y` to obtain `r` (i.e. `r = s * x + t * y`). +The function `xgcd_aux` takes in two triples, and from these recursively computes the next triple: +``` +xgcd_aux (r, s, t) (r', s', t') = xgcd_aux (r' % r, s' - (r' / r) * s, t' - (r' / r) * t) (r, s, t) +``` +-/ +def xgcd_aux : R → R → R → R → R → R → R × R × R +| r := λ s t r' s' t', +if hr : r = 0 then (r', s', t') + else + have r' % r ≺ r, from mod_lt _ hr, + let q := r' / r in xgcd_aux (r' % r) (s' - q * s) (t' - q * t) r s t +using_well_founded {dec_tac := tactic.assumption, + rel_tac := λ _ _, `[exact ⟨_, r_well_founded⟩]} + +@[simp] theorem xgcd_zero_left {s t r' s' t' : R} : xgcd_aux 0 s t r' s' t' = (r', s', t') := +by { unfold xgcd_aux, exact if_pos rfl } + +theorem xgcd_aux_rec {r s t r' s' t' : R} (h : r ≠ 0) : + xgcd_aux r s t r' s' t' = xgcd_aux (r' % r) (s' - (r' / r) * s) (t' - (r' / r) * t) r s t := +by { conv {to_lhs, rw [xgcd_aux]}, exact if_neg h} + +/-- Use the extended GCD algorithm to generate the `a` and `b` values + satisfying `gcd x y = x * a + y * b`. -/ +def xgcd (x y : R) : R × R := (xgcd_aux x 1 0 y 0 1).2 + +/-- The extended GCD `a` value in the equation `gcd x y = x * a + y * b`. -/ +def gcd_a (x y : R) : R := (xgcd x y).1 + +/-- The extended GCD `b` value in the equation `gcd x y = x * a + y * b`. -/ +def gcd_b (x y : R) : R := (xgcd x y).2 + +@[simp] theorem gcd_a_zero_left {s : R} : gcd_a 0 s = 0 := +by { unfold gcd_a, rw [xgcd, xgcd_zero_left] } + +@[simp] theorem gcd_b_zero_left {s : R} : gcd_b 0 s = 1 := +by { unfold gcd_b, rw [xgcd, xgcd_zero_left] } + +theorem xgcd_val (x y : R) : xgcd x y = (gcd_a x y, gcd_b x y) := +prod.mk.eta.symm + +end gcd + +section lcm +variables [decidable_eq R] + +/-- `lcm a b` is a (non-unique) element such that `a ∣ lcm a b` `b ∣ lcm a b`, and for + any element `c` such that `a ∣ c` and `b ∣ c`, then `lcm a b ∣ c` -/ +def lcm (x y : R) : R := +x * y / gcd x y + +end lcm + +end euclidean_domain diff --git a/src/algebra/euclidean_domain/instances.lean b/src/algebra/euclidean_domain/instances.lean new file mode 100644 index 0000000000000..994324f38030d --- /dev/null +++ b/src/algebra/euclidean_domain/instances.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2018 Louis Carlin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Louis Carlin, Mario Carneiro +-/ +import algebra.euclidean_domain.defs +import algebra.field.defs +import algebra.group_with_zero.units.lemmas +import data.nat.order.basic +import data.int.order.basic + +/-! +# Instances for Euclidean domains + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +* `int.euclidean_domain`: shows that `ℤ` is a Euclidean domain. +* `field.to_euclidean_domain`: shows that any field is a Euclidean domain. + +-/ + +instance int.euclidean_domain : euclidean_domain ℤ := +{ add := (+), + mul := (*), + one := 1, + zero := 0, + neg := has_neg.neg, + quotient := (/), + quotient_zero := int.div_zero, + remainder := (%), + quotient_mul_add_remainder_eq := λ a b, int.div_add_mod _ _, + r := λ a b, a.nat_abs < b.nat_abs, + r_well_founded := measure_wf (λ a, int.nat_abs a), + remainder_lt := λ a b b0, int.coe_nat_lt.1 $ + by { rw [int.nat_abs_of_nonneg (int.mod_nonneg _ b0), int.coe_nat_abs], + exact int.mod_lt _ b0 }, + mul_left_not_lt := λ a b b0, not_lt_of_ge $ + by {rw [← mul_one a.nat_abs, int.nat_abs_mul], + exact mul_le_mul_of_nonneg_left (int.nat_abs_pos_of_ne_zero b0) (nat.zero_le _) }, + .. int.comm_ring, + .. int.nontrivial } + +@[priority 100] -- see Note [lower instance priority] +instance field.to_euclidean_domain {K : Type*} [field K] : euclidean_domain K := +{ add := (+), + mul := (*), + one := 1, + zero := 0, + neg := has_neg.neg, + quotient := (/), + remainder := λ a b, a - a * b / b, + quotient_zero := div_zero, + quotient_mul_add_remainder_eq := λ a b, + by { classical, by_cases b = 0; simp [h, mul_div_cancel'] }, + r := λ a b, a = 0 ∧ b ≠ 0, + r_well_founded := well_founded.intro $ λ a, acc.intro _ $ λ b ⟨hb, hna⟩, + acc.intro _ $ λ c ⟨hc, hnb⟩, false.elim $ hnb hb, + remainder_lt := λ a b hnb, by simp [hnb], + mul_left_not_lt := λ a b hnb ⟨hab, hna⟩, or.cases_on (mul_eq_zero.1 hab) hna hnb, + .. ‹field K› } diff --git a/src/algebra/expr.lean b/src/algebra/expr.lean new file mode 100644 index 0000000000000..89641583e33bd --- /dev/null +++ b/src/algebra/expr.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import tactic.core + +/-! ### Helpers to invoke functions involving algebra at tactic time + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +It's not clear whether using `instance_cache` is a sensible choice here. +In particular, we need to use these tactics below when the algebraic instances are local variables +that aren't in the "real" instance cache (the one used by `tactic.reset_instance_cache`). +-/ +namespace expr + +/-- Produce a `has_one` instance for the type cached by `t`, such that `1 : expr` is the one of that +type. -/ +meta def has_one (t : tactic.instance_cache) : + tactic (tactic.instance_cache × has_one expr) := +do + (t, one) ← t.mk_app `has_one.one [], + pure (t, { one := one }) + +/-- Produce a `has_zero` instance for the type cached by `t`, such that `0 : expr` is the zero of +that type. -/ +meta def has_zero (t : tactic.instance_cache) : + tactic (tactic.instance_cache × has_zero expr) := +do + (t, zero) ← t.mk_app `has_zero.zero [], + pure (t, { zero := zero }) + +/-- Produce a `has_mul` instance for the type cached by `t`, such that `(*) : expr → expr → expr` is +the multiplication of that type. -/ +meta def has_mul (t : tactic.instance_cache) : + tactic (tactic.instance_cache × has_mul expr) := +do + (t, mul) ← t.mk_app `has_mul.mul [], + pure (t, { mul := λ a b, mul a b }) + +/-- Produce a `has_add` instance for the type cached by `t`, such that `(+) : expr → expr → expr` is +the addition of that type. -/ +meta def has_add (t : tactic.instance_cache) : + tactic (tactic.instance_cache × has_add expr) := +do + (t, add) ← t.mk_app `has_add.add [], + pure (t, { add := λ a b, add a b }) + +end expr diff --git a/src/algebra/field/basic.lean b/src/algebra/field/basic.lean index 39c1e1b51bf55..814b4696d87dc 100644 --- a/src/algebra/field/basic.lean +++ b/src/algebra/field/basic.lean @@ -3,74 +3,73 @@ Copyright (c) 2014 Robert Lewis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro -/ -import algebra.ring.basic +import algebra.field.defs +import algebra.group_with_zero.units.lemmas +import algebra.hom.ring +import algebra.ring.commute /-! -# Fields and division rings +# Lemmas about division (semi)rings and (semi)fields -This file introduces fields and division rings (also known as skewfields) and proves some basic -statements about them. For a more extensive theory of fields, see the `field_theory` folder. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -## Main definitions +-/ -* `division_ring`: introduces the notion of a division ring as a `ring` such that `0 ≠ 1` and - `a * a⁻¹ = 1` for `a ≠ 0` -* `field`: a division ring which is also a commutative ring. -* `is_field`: a predicate on a ring that it is a field, i.e. that the multiplication is commutative, - that it has more than one element and that all non-zero elements have a multiplicative inverse. - In contrast to `field`, which contains the data of a function associating to an element of the - field its multiplicative inverse, this predicate only assumes the existence and can therefore more - easily be used to e.g. transfer along ring isomorphisms. +open function order_dual set -## Implementation details +set_option old_structure_cmd true -By convention `0⁻¹ = 0` in a field or division ring. This is due to the fact that working with total -functions has the advantage of not constantly having to check that `x ≠ 0` when writing `x⁻¹`. With -this convention in place, some statements like `(a + b) * c⁻¹ = a * c⁻¹ + b * c⁻¹` still remain -true, while others like the defining property `a * a⁻¹ = 1` need the assumption `a ≠ 0`. If you are -a beginner in using Lean and are confused by that, you can read more about why this convention is -taken in Kevin Buzzard's -[blogpost](https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/) +universe u +variables {α β K : Type*} -A division ring or field is an example of a `group_with_zero`. If you cannot find -a division ring / field lemma that does not involve `+`, you can try looking for -a `group_with_zero` lemma instead. +section division_semiring +variables [division_semiring α] {a b c d : α} -## Tags +lemma add_div (a b c : α) : (a + b) / c = a / c + b / c := by simp_rw [div_eq_mul_inv, add_mul] -field, division ring, skew field, skew-field, skewfield --/ +@[field_simps] lemma div_add_div_same (a b c : α) : a / c + b / c = (a + b) / c := +(add_div _ _ _).symm -open set +lemma same_add_div (h : b ≠ 0) : (b + a) / b = 1 + a / b := by rw [←div_self h, add_div] +lemma div_add_same (h : b ≠ 0) : (a + b) / b = a / b + 1 := by rw [←div_self h, add_div] +lemma one_add_div (h : b ≠ 0 ) : 1 + a / b = (b + a) / b := (same_add_div h).symm +lemma div_add_one (h : b ≠ 0) : a / b + 1 = (a + b) / b := (div_add_same h).symm -set_option old_structure_cmd true +lemma one_div_mul_add_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) : + (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b := +by rw [mul_add, one_div_mul_cancel ha, add_mul, one_mul, mul_assoc, mul_one_div_cancel hb, mul_one, + add_comm] -universe u -variables {K : Type u} +lemma add_div_eq_mul_add_div (a b : α) (hc : c ≠ 0) : a + b / c = (a * c + b) / c := +(eq_div_iff_mul_eq hc).2 $ by rw [right_distrib, (div_mul_cancel _ hc)] -/-- A `division_ring` is a `ring` with multiplicative inverses for nonzero elements -/ -@[protect_proj, ancestor ring div_inv_monoid nontrivial] -class division_ring (K : Type u) extends ring K, div_inv_monoid K, nontrivial K := -(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1) -(inv_zero : (0 : K)⁻¹ = 0) +@[field_simps] lemma add_div' (a b c : α) (hc : c ≠ 0) : b + a / c = (b * c + a) / c := +by rw [add_div, mul_div_cancel _ hc] -section division_ring -variables [division_ring K] {a b : K} +@[field_simps] lemma div_add' (a b c : α) (hc : c ≠ 0) : a / c + b = (a + b * c) / c := +by rwa [add_comm, add_div', add_comm] -/-- Every division ring is a `group_with_zero`. -/ -@[priority 100] -- see Note [lower instance priority] -instance division_ring.to_group_with_zero : - group_with_zero K := -{ .. ‹division_ring K›, - .. (infer_instance : semiring K) } +protected lemma commute.div_add_div (hbc : commute b c) (hbd : commute b d) (hb : b ≠ 0) + (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) := +by rw [add_div, mul_div_mul_right _ b hd, hbc.eq, hbd.eq, mul_div_mul_right c d hb] + +protected lemma commute.one_div_add_one_div (hab : commute a b) (ha : a ≠ 0) (hb : b ≠ 0) : + 1 / a + 1 / b = (a + b) / (a * b) := +by rw [(commute.one_right a).div_add_div hab ha hb, one_mul, mul_one, add_comm] + +protected lemma commute.inv_add_inv (hab : commute a b) (ha : a ≠ 0) (hb : b ≠ 0) : + a⁻¹ + b⁻¹ = (a + b) / (a * b) := +by rw [inv_eq_one_div, inv_eq_one_div, hab.one_div_add_one_div ha hb] -local attribute [simp] - division_def mul_comm mul_assoc - mul_left_comm mul_inv_cancel inv_mul_cancel +end division_semiring + +section division_monoid +variables [division_monoid K] [has_distrib_neg K] {a b : K} lemma one_div_neg_one_eq_neg_one : (1:K) / (-1) = -1 := have (-1) * (-1) = (1:K), by rw [neg_mul_neg, one_mul], -eq.symm (eq_one_div_of_mul_eq_one this) +eq.symm (eq_one_div_of_mul_eq_one_right this) lemma one_div_neg_eq_neg_one_div (a : K) : 1 / (- a) = - (1 / a) := calc @@ -95,24 +94,25 @@ by simp [neg_div] lemma neg_div_neg_eq (a b : K) : (-a) / (-b) = a / b := by rw [div_neg_eq_neg_div, neg_div, neg_neg] -@[simp] lemma div_neg_self {a : K} (h : a ≠ 0) : a / -a = -1 := -by rw [div_neg_eq_neg_div, div_self h] +lemma neg_inv : - a⁻¹ = (- a)⁻¹ := +by rw [inv_eq_one_div, inv_eq_one_div, div_neg_eq_neg_div] -@[simp] lemma neg_div_self {a : K} (h : a ≠ 0) : (-a) / a = -1 := -by rw [neg_div, div_self h] +lemma div_neg (a : K) : a / -b = -(a / b) := +by rw [← div_neg_eq_neg_div] -@[field_simps] lemma div_add_div_same (a b c : K) : a / c + b / c = (a + b) / c := -by simpa only [div_eq_mul_inv] using (right_distrib a b (c⁻¹)).symm +lemma inv_neg : (-a)⁻¹ = -(a⁻¹) := +by rw neg_inv -lemma same_add_div {a b : K} (h : b ≠ 0) : (b + a) / b = 1 + a / b := -by simpa only [← @div_self _ _ b h] using (div_add_div_same b a b).symm +end division_monoid -lemma one_add_div {a b : K} (h : b ≠ 0 ) : 1 + a / b = (b + a) / b := (same_add_div h).symm +section division_ring +variables [division_ring K] {a b c d : K} -lemma div_add_same {a b : K} (h : b ≠ 0) : (a + b) / b = a / b + 1 := -by simpa only [← @div_self _ _ b h] using (div_add_div_same a b b).symm +@[simp] lemma div_neg_self {a : K} (h : a ≠ 0) : a / -a = -1 := +by rw [div_neg_eq_neg_div, div_self h] -lemma div_add_one {a b : K} (h : b ≠ 0) : a / b + 1 = (a + b) / b := (div_add_same h).symm +@[simp] lemma neg_div_self {a : K} (h : a ≠ 0) : (-a) / a = -1 := +by rw [neg_div, div_self h] lemma div_sub_div_same (a b c : K) : (a / c) - (b / c) = (a - b) / c := by rw [sub_eq_add_neg, ← neg_div, div_add_div_same, sub_eq_add_neg] @@ -127,93 +127,63 @@ by simpa only [← @div_self _ _ b h] using (div_sub_div_same a b b).symm lemma div_sub_one {a b : K} (h : b ≠ 0) : a / b - 1 = (a - b) / b := (div_sub_same h).symm -lemma neg_inv : - a⁻¹ = (- a)⁻¹ := -by rw [inv_eq_one_div, inv_eq_one_div, div_neg_eq_neg_div] - -lemma add_div (a b c : K) : (a + b) / c = a / c + b / c := -(div_add_div_same _ _ _).symm - lemma sub_div (a b c : K) : (a - b) / c = a / c - b / c := (div_sub_div_same _ _ _).symm -lemma div_neg (a : K) : a / -b = -(a / b) := -by rw [← div_neg_eq_neg_div] - -lemma inv_neg : (-a)⁻¹ = -(a⁻¹) := -by rw neg_inv - -lemma one_div_mul_add_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) : - (1 / a) * (a + b) * (1 / b) = 1 / a + 1 / b := -by rw [(left_distrib (1 / a)), (one_div_mul_cancel ha), right_distrib, one_mul, - mul_assoc, (mul_one_div_cancel hb), mul_one, add_comm] +/-- See `inv_sub_inv` for the more convenient version when `K` is commutative. -/ +lemma inv_sub_inv' {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ - b⁻¹ = a⁻¹ * (b - a) * b⁻¹ := +by rw [mul_sub, sub_mul, mul_inv_cancel_right₀ hb, inv_mul_cancel ha, one_mul] lemma one_div_mul_sub_mul_one_div_eq_one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) : (1 / a) * (b - a) * (1 / b) = 1 / a - 1 / b := by rw [(mul_sub_left_distrib (1 / a)), (one_div_mul_cancel ha), mul_sub_right_distrib, one_mul, mul_assoc, (mul_one_div_cancel hb), mul_one] -lemma add_div_eq_mul_add_div (a b : K) {c : K} (hc : c ≠ 0) : a + b / c = (a * c + b) / c := -(eq_div_iff_mul_eq hc).2 $ by rw [right_distrib, (div_mul_cancel _ hc)] - @[priority 100] -- see Note [lower instance priority] instance division_ring.is_domain : is_domain K := -{ ..‹division_ring K›, - ..(by apply_instance : no_zero_divisors K) } +no_zero_divisors.to_is_domain _ + +protected lemma commute.div_sub_div (hbc : commute b c) (hbd : commute b d) (hb : b ≠ 0) + (hd : d ≠ 0) : a / b - c / d = (a * d - b * c) / (b * d) := +by simpa only [mul_neg, neg_div, ←sub_eq_add_neg] using hbc.neg_right.div_add_div hbd hb hd + +protected lemma commute.inv_sub_inv (hab : commute a b) (ha : a ≠ 0) (hb : b ≠ 0) : + a⁻¹ - b⁻¹ = (b - a) / (a * b) := +by simp only [inv_eq_one_div, (commute.one_right a).div_sub_div hab ha hb, one_mul, mul_one] end division_ring -/-- A `field` is a `comm_ring` with multiplicative inverses for nonzero elements -/ -@[protect_proj, ancestor comm_ring div_inv_monoid nontrivial] -class field (K : Type u) extends comm_ring K, div_inv_monoid K, nontrivial K := -(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1) -(inv_zero : (0 : K)⁻¹ = 0) +section semifield +variables [semifield α] {a b c d : α} -section field +lemma div_add_div (a : α) (c : α) (hb : b ≠ 0) (hd : d ≠ 0) : + (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) := +(commute.all b _).div_add_div (commute.all _ _) hb hd -variable [field K] +lemma one_div_add_one_div (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) := +(commute.all a _).one_div_add_one_div ha hb -@[priority 100] -- see Note [lower instance priority] -instance field.to_division_ring : division_ring K := -{ ..show field K, by apply_instance } +lemma inv_add_inv (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ + b⁻¹ = (a + b) / (a * b) := +(commute.all a _).inv_add_inv ha hb -/-- Every field is a `comm_group_with_zero`. -/ -@[priority 100] -- see Note [lower instance priority] -instance field.to_comm_group_with_zero : - comm_group_with_zero K := -{ .. (_ : group_with_zero K), .. ‹field K› } +end semifield -local attribute [simp] mul_assoc mul_comm mul_left_comm +section field -lemma div_add_div (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0) (hd : d ≠ 0) : - (a / b) + (c / d) = ((a * d) + (b * c)) / (b * d) := -by rw [← mul_div_mul_right _ b hd, ← mul_div_mul_left c d hb, div_add_div_same] +variable [field K] -lemma one_div_add_one_div {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : 1 / a + 1 / b = (a + b) / (a * b) := -by rw [div_add_div _ _ ha hb, one_mul, mul_one, add_comm] +local attribute [simp] mul_assoc mul_comm mul_left_comm @[field_simps] lemma div_sub_div (a : K) {b : K} (c : K) {d : K} (hb : b ≠ 0) (hd : d ≠ 0) : (a / b) - (c / d) = ((a * d) - (b * c)) / (b * d) := -begin - simp only [sub_eq_add_neg], - rw [neg_eq_neg_one_mul, ← mul_div_assoc, div_add_div _ _ hb hd, - ← mul_assoc, mul_comm b, mul_assoc, ← neg_eq_neg_one_mul] -end - -lemma inv_add_inv {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ + b⁻¹ = (a + b) / (a * b) := -by rw [inv_eq_one_div, inv_eq_one_div, one_div_add_one_div ha hb] +(commute.all b _).div_sub_div (commute.all _ _) hb hd lemma inv_sub_inv {a b : K} (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ - b⁻¹ = (b - a) / (a * b) := -by rw [inv_eq_one_div, inv_eq_one_div, div_sub_div _ _ ha hb, one_mul, mul_one] - -@[field_simps] lemma add_div' (a b c : K) (hc : c ≠ 0) : b + a / c = (b * c + a) / c := -by simpa using div_add_div b a one_ne_zero hc +(commute.all a _).inv_sub_inv ha hb @[field_simps] lemma sub_div' (a b c : K) (hc : c ≠ 0) : b - a / c = (b * c - a) / c := by simpa using div_sub_div b a one_ne_zero hc -@[field_simps] lemma div_add' (a b c : K) (hc : c ≠ 0) : a / c + b = (a + b * c) / c := -by rwa [add_comm, add_div', add_comm] - @[field_simps] lemma div_sub' (a b c : K) (hc : c ≠ 0) : a / c - b = (a - c * b) / c := by simpa using div_sub_div a b hc one_ne_zero @@ -223,92 +193,11 @@ instance field.is_domain : is_domain K := end field -section is_field - -/-- A predicate to express that a ring is a field. - -This is mainly useful because such a predicate does not contain data, -and can therefore be easily transported along ring isomorphisms. -Additionaly, this is useful when trying to prove that -a particular ring structure extends to a field. -/ -structure is_field (R : Type u) [ring R] : Prop := -(exists_pair_ne : ∃ (x y : R), x ≠ y) -(mul_comm : ∀ (x y : R), x * y = y * x) -(mul_inv_cancel : ∀ {a : R}, a ≠ 0 → ∃ b, a * b = 1) - -/-- Transferring from field to is_field -/ -lemma field.to_is_field (R : Type u) [field R] : is_field R := -{ mul_inv_cancel := λ a ha, ⟨a⁻¹, field.mul_inv_cancel ha⟩, - ..‹field R› } - -@[simp] lemma is_field.nontrivial {R : Type u} [ring R] (h : is_field R) : nontrivial R := -⟨h.exists_pair_ne⟩ - -@[simp] lemma not_is_field_of_subsingleton (R : Type u) [ring R] [subsingleton R] : ¬is_field R := -λ h, let ⟨x, y, h⟩ := h.exists_pair_ne in h (subsingleton.elim _ _) - -open_locale classical - -/-- Transferring from is_field to field -/ -noncomputable def is_field.to_field {R : Type u} [ring R] (h : is_field R) : field R := -{ inv := λ a, if ha : a = 0 then 0 else classical.some (is_field.mul_inv_cancel h ha), - inv_zero := dif_pos rfl, - mul_inv_cancel := λ a ha, - begin - convert classical.some_spec (is_field.mul_inv_cancel h ha), - exact dif_neg ha - end, - .. ‹ring R›, ..h } - -/-- For each field, and for each nonzero element of said field, there is a unique inverse. -Since `is_field` doesn't remember the data of an `inv` function and as such, -a lemma that there is a unique inverse could be useful. --/ -lemma uniq_inv_of_is_field (R : Type u) [ring R] (hf : is_field R) : - ∀ (x : R), x ≠ 0 → ∃! (y : R), x * y = 1 := -begin - intros x hx, - apply exists_unique_of_exists_of_unique, - { exact hf.mul_inv_cancel hx }, - { intros y z hxy hxz, - calc y = y * (x * z) : by rw [hxz, mul_one] - ... = (x * y) * z : by rw [← mul_assoc, hf.mul_comm y x] - ... = z : by rw [hxy, one_mul] } -end - -end is_field - namespace ring_hom -section - -variables {R : Type*} [semiring R] [division_ring K] (f : R →+* K) - -@[simp] lemma map_units_inv (u : Rˣ) : - f ↑u⁻¹ = (f ↑u)⁻¹ := -(f : R →* K).map_units_inv u - -end - -section - -variables {R K' : Type*} [division_ring K] [semiring R] [nontrivial R] [division_ring K'] - (f : K →+* R) (g : K →+* K') {x y : K} - -lemma map_ne_zero : f x ≠ 0 ↔ x ≠ 0 := f.to_monoid_with_zero_hom.map_ne_zero - -@[simp] lemma map_eq_zero : f x = 0 ↔ x = 0 := f.to_monoid_with_zero_hom.map_eq_zero - -variables (x y) - -lemma map_inv : g x⁻¹ = (g x)⁻¹ := g.to_monoid_with_zero_hom.map_inv x - -lemma map_div : g (x / y) = g x / g y := g.to_monoid_with_zero_hom.map_div x y - -protected lemma injective : function.injective f := -(injective_iff_map_eq_zero f).2 $ λ x, f.map_eq_zero.1 - -end +protected lemma injective [division_ring α] [semiring β] [nontrivial β] (f : α →+* β) : + injective f := +(injective_iff_map_eq_zero f).2 $ λ x, (map_eq_zero f).1 end ring_hom @@ -330,34 +219,102 @@ noncomputable def field_of_is_unit_or_eq_zero [hR : comm_ring R] end noncomputable_defs +/-- Pullback a `division_semiring` along an injective function. -/ +@[reducible] -- See note [reducible non-instances] +protected def function.injective.division_semiring [division_semiring β] [has_zero α] [has_mul α] + [has_add α] [has_one α] [has_inv α] [has_div α] [has_smul ℕ α] [has_pow α ℕ] [has_pow α ℤ] + [has_nat_cast α] + (f : α → β) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + division_semiring α := +{ .. hf.group_with_zero f zero one mul inv div npow zpow, + .. hf.semiring f zero one add mul nsmul npow nat_cast } + /-- Pullback a `division_ring` along an injective function. See note [reducible non-instances]. -/ @[reducible] protected def function.injective.division_ring [division_ring K] {K'} - [has_zero K'] [has_mul K'] [has_add K'] [has_neg K'] [has_sub K'] [has_one K'] [has_inv K'] - [has_div K'] [has_scalar ℕ K'] [has_scalar ℤ K'] [has_pow K' ℕ] [has_pow K' ℤ] - (f : K' → K) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) + [has_zero K'] [has_one K'] [has_add K'] [has_mul K'] [has_neg K'] [has_sub K'] [has_inv K'] + [has_div K'] [has_smul ℕ K'] [has_smul ℤ K'] [has_smul ℚ K'] [has_pow K' ℕ] [has_pow K' ℤ] + [has_nat_cast K'] [has_int_cast K'] [has_rat_cast K'] + (f : K' → K) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : + (qsmul : ∀ x (n : ℚ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) (rat_cast : ∀ n : ℚ, f n = n) : division_ring K' := -{ .. hf.group_with_zero f zero one mul inv div npow zpow, - .. hf.ring f zero one add mul neg sub nsmul zsmul npow } +{ rat_cast := coe, + rat_cast_mk := λ a b h1 h2, hf (by erw [rat_cast, mul, inv, int_cast, nat_cast]; + exact division_ring.rat_cast_mk a b h1 h2), + qsmul := (•), + qsmul_eq_mul' := λ a x, hf (by erw [qsmul, mul, rat.smul_def, rat_cast]), + .. hf.group_with_zero f zero one mul inv div npow zpow, + .. hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-- Pullback a `field` along an injective function. -/ +@[reducible] -- See note [reducible non-instances] +protected def function.injective.semifield [semifield β] [has_zero α] [has_mul α] [has_add α] + [has_one α] [has_inv α] [has_div α] [has_smul ℕ α] [has_pow α ℕ] [has_pow α ℤ] + [has_nat_cast α] + (f : α → β) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + semifield α := +{ .. hf.comm_group_with_zero f zero one mul inv div npow zpow, + .. hf.comm_semiring f zero one add mul nsmul npow nat_cast } /-- Pullback a `field` along an injective function. See note [reducible non-instances]. -/ @[reducible] protected def function.injective.field [field K] {K'} [has_zero K'] [has_mul K'] [has_add K'] [has_neg K'] [has_sub K'] [has_one K'] [has_inv K'] - [has_div K'] [has_scalar ℕ K'] [has_scalar ℤ K'] [has_pow K' ℕ] [has_pow K' ℤ] - (f : K' → K) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) + [has_div K'] [has_smul ℕ K'] [has_smul ℤ K'] [has_smul ℚ K'] [has_pow K' ℕ] [has_pow K' ℤ] + [has_nat_cast K'] [has_int_cast K'] [has_rat_cast K'] + (f : K' → K) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : + (qsmul : ∀ x (n : ℚ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) (rat_cast : ∀ n : ℚ, f n = n) : field K' := -{ .. hf.comm_group_with_zero f zero one mul inv div npow zpow, - .. hf.comm_ring f zero one add mul neg sub nsmul zsmul npow } +{ rat_cast := coe, + rat_cast_mk := λ a b h1 h2, hf (by erw [rat_cast, mul, inv, int_cast, nat_cast]; + exact division_ring.rat_cast_mk a b h1 h2), + qsmul := (•), + qsmul_eq_mul' := λ a x, hf (by erw [qsmul, mul, rat.smul_def, rat_cast]), + .. hf.comm_group_with_zero f zero one mul inv div npow zpow, + .. hf.comm_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-! ### Order dual -/ + +instance [h : has_rat_cast α] : has_rat_cast αᵒᵈ := h +instance [h : division_semiring α] : division_semiring αᵒᵈ := h +instance [h : division_ring α] : division_ring αᵒᵈ := h +instance [h : semifield α] : semifield αᵒᵈ := h +instance [h : field α] : field αᵒᵈ := h + +@[simp] lemma to_dual_rat_cast [has_rat_cast α] (n : ℚ) : to_dual (n : α) = n := rfl +@[simp] lemma of_dual_rat_cast [has_rat_cast α] (n : ℚ) : (of_dual n : α) = n := rfl + +/-! ### Lexicographic order -/ + +instance [h : has_rat_cast α] : has_rat_cast (lex α) := h +instance [h : division_semiring α] : division_semiring (lex α) := h +instance [h : division_ring α] : division_ring (lex α) := h +instance [h : semifield α] : semifield (lex α) := h +instance [h : field α] : field (lex α) := h + +@[simp] lemma to_lex_rat_cast [has_rat_cast α] (n : ℚ) : to_lex (n : α) = n := rfl +@[simp] lemma of_lex_rat_cast [has_rat_cast α] (n : ℚ) : (of_lex n : α) = n := rfl diff --git a/src/algebra/field/defs.lean b/src/algebra/field/defs.lean new file mode 100644 index 0000000000000..73ddad343d0d0 --- /dev/null +++ b/src/algebra/field/defs.lean @@ -0,0 +1,225 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro +-/ +import data.rat.init +import algebra.ring.defs + +/-! +# Division (semi)rings and (semi)fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file introduces fields and division rings (also known as skewfields) and proves some basic +statements about them. For a more extensive theory of fields, see the `field_theory` folder. + +## Main definitions + +* `division_semiring`: Nontrivial semiring with multiplicative inverses for nonzero elements. +* `division_ring`: : Nontrivial ring with multiplicative inverses for nonzero elements. +* `semifield`: Commutative division semiring. +* `field`: Commutative division ring. +* `is_field`: Predicate on a (semi)ring that it is a (semi)field, i.e. that the multiplication is + commutative, that it has more than one element and that all non-zero elements have a + multiplicative inverse. In contrast to `field`, which contains the data of a function associating + to an element of the field its multiplicative inverse, this predicate only assumes the existence + and can therefore more easily be used to e.g. transfer along ring isomorphisms. + +## Implementation details + +By convention `0⁻¹ = 0` in a field or division ring. This is due to the fact that working with total +functions has the advantage of not constantly having to check that `x ≠ 0` when writing `x⁻¹`. With +this convention in place, some statements like `(a + b) * c⁻¹ = a * c⁻¹ + b * c⁻¹` still remain +true, while others like the defining property `a * a⁻¹ = 1` need the assumption `a ≠ 0`. If you are +a beginner in using Lean and are confused by that, you can read more about why this convention is +taken in Kevin Buzzard's +[blogpost](https://xenaproject.wordpress.com/2020/07/05/division-by-zero-in-type-theory-a-faq/) + +A division ring or field is an example of a `group_with_zero`. If you cannot find +a division ring / field lemma that does not involve `+`, you can try looking for +a `group_with_zero` lemma instead. + +## Tags + +field, division ring, skew field, skew-field, skewfield +-/ + +open function set + +set_option old_structure_cmd true + +universe u +variables {α β K : Type*} + +/-- The default definition of the coercion `(↑(a : ℚ) : K)` for a division ring `K` +is defined as `(a / b : K) = (a : K) * (b : K)⁻¹`. +Use `coe` instead of `rat.cast_rec` for better definitional behaviour. +-/ +def rat.cast_rec [has_lift_t ℕ K] [has_lift_t ℤ K] [has_mul K] [has_inv K] : ℚ → K +| ⟨a, b, _, _⟩ := ↑a * (↑b)⁻¹ + +/-- +Type class for the canonical homomorphism `ℚ → K`. +-/ +@[protect_proj] +class has_rat_cast (K : Type u) := +(rat_cast : ℚ → K) + +/-- The default definition of the scalar multiplication `(a : ℚ) • (x : K)` for a division ring `K` +is given by `a • x = (↑ a) * x`. +Use `(a : ℚ) • (x : K)` instead of `qsmul_rec` for better definitional behaviour. +-/ +def qsmul_rec (coe : ℚ → K) [has_mul K] (a : ℚ) (x : K) : K := +coe a * x + +/-- A `division_semiring` is a `semiring` with multiplicative inverses for nonzero elements. -/ +@[protect_proj, ancestor semiring group_with_zero] +class division_semiring (α : Type*) extends semiring α, group_with_zero α + +/-- A `division_ring` is a `ring` with multiplicative inverses for nonzero elements. + +An instance of `division_ring K` includes maps `rat_cast : ℚ → K` and `qsmul : ℚ → K → K`. +If the division ring has positive characteristic p, we define `rat_cast (1 / p) = 1 / 0 = 0` +for consistency with our division by zero convention. +The fields `rat_cast` and `qsmul` are needed to implement the +`algebra_rat [division_ring K] : algebra ℚ K` instance, since we need to control the specific +definitions for some special cases of `K` (in particular `K = ℚ` itself). +See also Note [forgetful inheritance]. +-/ +@[protect_proj, ancestor ring div_inv_monoid nontrivial] +class division_ring (K : Type u) extends ring K, div_inv_monoid K, nontrivial K, has_rat_cast K := +(mul_inv_cancel : ∀ {a : K}, a ≠ 0 → a * a⁻¹ = 1) +(inv_zero : (0 : K)⁻¹ = 0) +(rat_cast := rat.cast_rec) +(rat_cast_mk : ∀ (a : ℤ) (b : ℕ) h1 h2, rat_cast ⟨a, b, h1, h2⟩ = a * b⁻¹ . try_refl_tac) +(qsmul : ℚ → K → K := qsmul_rec rat_cast) +(qsmul_eq_mul' : ∀ (a : ℚ) (x : K), qsmul a x = rat_cast a * x . try_refl_tac) + +@[priority 100] -- see Note [lower instance priority] +instance division_ring.to_division_semiring [division_ring α] : division_semiring α := +{ ..‹division_ring α›, ..(infer_instance : semiring α) } + +/-- A `semifield` is a `comm_semiring` with multiplicative inverses for nonzero elements. -/ +@[protect_proj, ancestor comm_semiring division_semiring comm_group_with_zero] +class semifield (α : Type*) extends comm_semiring α, division_semiring α, comm_group_with_zero α + +/-- A `field` is a `comm_ring` with multiplicative inverses for nonzero elements. + +An instance of `field K` includes maps `of_rat : ℚ → K` and `qsmul : ℚ → K → K`. +If the field has positive characteristic p, we define `of_rat (1 / p) = 1 / 0 = 0` +for consistency with our division by zero convention. +The fields `of_rat` and `qsmul are needed to implement the +`algebra_rat [division_ring K] : algebra ℚ K` instance, since we need to control the specific +definitions for some special cases of `K` (in particular `K = ℚ` itself). +See also Note [forgetful inheritance]. +-/ +@[protect_proj, ancestor comm_ring div_inv_monoid nontrivial] +class field (K : Type u) extends comm_ring K, division_ring K + +section division_ring +variables [division_ring K] {a b : K} + +namespace rat + +/-- Construct the canonical injection from `ℚ` into an arbitrary + division ring. If the field has positive characteristic `p`, + we define `1 / p = 1 / 0 = 0` for consistency with our + division by zero convention. -/ +-- see Note [coercion into rings] +@[priority 900] instance cast_coe {K : Type*} [has_rat_cast K] : has_coe_t ℚ K := +⟨has_rat_cast.rat_cast⟩ + +theorem cast_mk' (a b h1 h2) : ((⟨a, b, h1, h2⟩ : ℚ) : K) = a * b⁻¹ := +division_ring.rat_cast_mk _ _ _ _ + +theorem cast_def : ∀ (r : ℚ), (r : K) = r.num / r.denom +| ⟨a, b, h1, h2⟩ := (cast_mk' _ _ _ _).trans (div_eq_mul_inv _ _).symm + +@[priority 100] +instance smul_division_ring : has_smul ℚ K := +⟨division_ring.qsmul⟩ + +lemma smul_def (a : ℚ) (x : K) : a • x = ↑a * x := division_ring.qsmul_eq_mul' a x + +@[simp] lemma smul_one_eq_coe (A : Type*) [division_ring A] (m : ℚ) : + m • (1 : A) = ↑m := +by rw [rat.smul_def, mul_one] + +end rat + +end division_ring + +section field + +variable [field K] + +@[priority 100] -- see Note [lower instance priority] +instance field.to_semifield : semifield K := +{ .. ‹field K›, .. (infer_instance : semiring K) } + +end field + +section is_field + +/-- A predicate to express that a (semi)ring is a (semi)field. + +This is mainly useful because such a predicate does not contain data, +and can therefore be easily transported along ring isomorphisms. +Additionaly, this is useful when trying to prove that +a particular ring structure extends to a (semi)field. -/ +structure is_field (R : Type u) [semiring R] : Prop := +(exists_pair_ne : ∃ (x y : R), x ≠ y) +(mul_comm : ∀ (x y : R), x * y = y * x) +(mul_inv_cancel : ∀ {a : R}, a ≠ 0 → ∃ b, a * b = 1) + +/-- Transferring from `semifield` to `is_field`. -/ +lemma semifield.to_is_field (R : Type u) [semifield R] : is_field R := +{ mul_inv_cancel := λ a ha, ⟨a⁻¹, mul_inv_cancel ha⟩, + ..‹semifield R› } + +/-- Transferring from `field` to `is_field`. -/ +lemma field.to_is_field (R : Type u) [field R] : is_field R := semifield.to_is_field _ + +@[simp] lemma is_field.nontrivial {R : Type u} [semiring R] (h : is_field R) : nontrivial R := +⟨h.exists_pair_ne⟩ + +@[simp] lemma not_is_field_of_subsingleton (R : Type u) [semiring R] [subsingleton R] : + ¬is_field R := +λ h, let ⟨x, y, h⟩ := h.exists_pair_ne in h (subsingleton.elim _ _) + +open_locale classical + +/-- Transferring from `is_field` to `semifield`. -/ +noncomputable def is_field.to_semifield {R : Type u} [semiring R] (h : is_field R) : semifield R := +{ inv := λ a, if ha : a = 0 then 0 else classical.some (is_field.mul_inv_cancel h ha), + inv_zero := dif_pos rfl, + mul_inv_cancel := λ a ha, + begin + convert classical.some_spec (is_field.mul_inv_cancel h ha), + exact dif_neg ha + end, + .. ‹semiring R›, ..h } + +/-- Transferring from `is_field` to `field`. -/ +noncomputable def is_field.to_field {R : Type u} [ring R] (h : is_field R) : field R := +{ .. ‹ring R›, ..is_field.to_semifield h } + +/-- For each field, and for each nonzero element of said field, there is a unique inverse. +Since `is_field` doesn't remember the data of an `inv` function and as such, +a lemma that there is a unique inverse could be useful. +-/ +lemma uniq_inv_of_is_field (R : Type u) [ring R] (hf : is_field R) : + ∀ (x : R), x ≠ 0 → ∃! (y : R), x * y = 1 := +begin + intros x hx, + apply exists_unique_of_exists_of_unique, + { exact hf.mul_inv_cancel hx }, + { intros y z hxy hxz, + calc y = y * (x * z) : by rw [hxz, mul_one] + ... = (x * y) * z : by rw [← mul_assoc, hf.mul_comm y x] + ... = z : by rw [hxy, one_mul] } +end + +end is_field diff --git a/src/algebra/field/opposite.lean b/src/algebra/field/opposite.lean index 2a6f100dcd73b..bb6e07c2a8747 100644 --- a/src/algebra/field/opposite.lean +++ b/src/algebra/field/opposite.lean @@ -3,21 +3,63 @@ Copyright (c) 2018 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ -import algebra.field.basic +import algebra.field.defs import algebra.ring.opposite +import data.int.cast.lemmas /-! -# Field structure on the multiplicative opposite +# Field structure on the multiplicative/additive opposite + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ variables (α : Type*) namespace mul_opposite +@[to_additive] instance [has_rat_cast α] : has_rat_cast αᵐᵒᵖ := ⟨λ n, op n⟩ + +variables {α} + +@[simp, norm_cast, to_additive] +lemma op_rat_cast [has_rat_cast α] (q : ℚ) : op (q : α) = q := rfl + +@[simp, norm_cast, to_additive] +lemma unop_rat_cast [has_rat_cast α] (q : ℚ) : unop (q : αᵐᵒᵖ) = q := rfl + +variables (α) + +instance [division_semiring α] : division_semiring αᵐᵒᵖ := +{ .. mul_opposite.group_with_zero α, .. mul_opposite.semiring α } + instance [division_ring α] : division_ring αᵐᵒᵖ := -{ .. mul_opposite.group_with_zero α, .. mul_opposite.ring α } +{ rat_cast := λ q, op q, + rat_cast_mk := λ a b hb h, by { rw [rat.cast_def, op_div, op_nat_cast, op_int_cast], + exact int.commute_cast _ _ }, + ..mul_opposite.division_semiring α, ..mul_opposite.ring α } + +instance [semifield α] : semifield αᵐᵒᵖ := +{ .. mul_opposite.division_semiring α, .. mul_opposite.comm_semiring α } instance [field α] : field αᵐᵒᵖ := { .. mul_opposite.division_ring α, .. mul_opposite.comm_ring α } end mul_opposite + +namespace add_opposite + +instance [division_semiring α] : division_semiring αᵃᵒᵖ := +{ ..add_opposite.group_with_zero α, ..add_opposite.semiring α } + +instance [division_ring α] : division_ring αᵃᵒᵖ := +{ rat_cast_mk := λ a b hb h, by rw ←div_eq_mul_inv; exact congr_arg op (rat.cast_def _), + ..add_opposite.ring α, ..add_opposite.group_with_zero α, ..add_opposite.has_rat_cast α } + +instance [semifield α] : semifield αᵃᵒᵖ := +{ ..add_opposite.division_semiring α, ..add_opposite.comm_semiring α } + +instance [field α] : field αᵃᵒᵖ := +{ ..add_opposite.division_ring α, ..add_opposite.comm_ring α } + +end add_opposite diff --git a/src/algebra/field/power.lean b/src/algebra/field/power.lean new file mode 100644 index 0000000000000..b02730a6048fb --- /dev/null +++ b/src/algebra/field/power.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Johannes Hölzl, Mario Carneiro +-/ +import algebra.field.defs +import algebra.group_with_zero.power +import algebra.parity + +/-! +# Results about powers in fields or division rings. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file exists to ensure we can define `field` with minimal imports, +so contains some lemmas about powers of elements which need imports +beyond those needed for the basic definition. +-/ + +variables {α : Type*} + +section division_ring +variables [division_ring α] {n : ℤ} + +@[simp] lemma zpow_bit1_neg (a : α) (n : ℤ) : (-a) ^ bit1 n = - a ^ bit1 n := +by rw [zpow_bit1', zpow_bit1', neg_mul_neg, neg_mul_eq_mul_neg] + +lemma odd.neg_zpow (h : odd n) (a : α) : (-a) ^ n = - a ^ n := +by { obtain ⟨k, rfl⟩ := h.exists_bit1, exact zpow_bit1_neg _ _ } + +lemma odd.neg_one_zpow (h : odd n) : (-1 : α) ^ n = -1 := by rw [h.neg_zpow, one_zpow] + +end division_ring diff --git a/src/algebra/field/ulift.lean b/src/algebra/field/ulift.lean new file mode 100644 index 0000000000000..a515210095d80 --- /dev/null +++ b/src/algebra/field/ulift.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2023 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.field.basic +import algebra.ring.ulift + +/-! +# Field instances for `ulift` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines instances for field, semifield and related structures on `ulift` types. + +(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.) +-/ + +universes u v +variables {α : Type u} {x y : ulift.{v} α} + +namespace ulift + +instance [has_rat_cast α] : has_rat_cast (ulift α) := ⟨λ a, up a⟩ + +@[simp, norm_cast] lemma up_rat_cast [has_rat_cast α] (q : ℚ) : up (q : α) = q := rfl +@[simp, norm_cast] lemma down_rat_cast [has_rat_cast α] (q : ℚ) : down (q : ulift α) = q := rfl + +instance division_semiring [division_semiring α] : division_semiring (ulift α) := +by refine down_injective.division_semiring down _ _ _ _ _ _ _ _ _ _; intros; refl + +instance semifield [semifield α] : semifield (ulift α) := +{ ..ulift.division_semiring, ..ulift.comm_group_with_zero } + +instance division_ring [division_ring α] : division_ring (ulift α) := +{ ..ulift.division_semiring, ..ulift.add_group } + +instance field [field α] : field (ulift α) := +{ ..ulift.semifield, ..ulift.division_ring } + +end ulift diff --git a/src/algebra/field_power.lean b/src/algebra/field_power.lean deleted file mode 100644 index 0d3049812c2e0..0000000000000 --- a/src/algebra/field_power.lean +++ /dev/null @@ -1,201 +0,0 @@ -/- -Copyright (c) 2018 Robert Y. Lewis. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Robert Y. Lewis --/ -import algebra.group_with_zero.power -import algebra.ring.equiv -import tactic.linarith - -/-! -# Integer power operation on fields and division rings - -This file collects basic facts about the operation of raising an element of a `division_ring` to an -integer power. More specialised results are provided in the case of a linearly ordered field. --/ - -universe u - -@[simp] lemma ring_hom.map_zpow {K L : Type*} [division_ring K] [division_ring L] (f : K →+* L) : - ∀ (a : K) (n : ℤ), f (a ^ n) = f a ^ n := -f.to_monoid_with_zero_hom.map_zpow - -@[simp] lemma ring_equiv.map_zpow {K L : Type*} [division_ring K] [division_ring L] (f : K ≃+* L) : - ∀ (a : K) (n : ℤ), f (a ^ n) = f a ^ n := -f.to_ring_hom.map_zpow - -@[simp] lemma zpow_bit0_neg {K : Type*} [division_ring K] (x : K) (n : ℤ) : - (-x) ^ (bit0 n) = x ^ bit0 n := -by rw [zpow_bit0', zpow_bit0', neg_mul_neg] - -@[simp] lemma zpow_bit1_neg {K : Type*} [division_ring K] (x : K) (n : ℤ) : - (-x) ^ (bit1 n) = - x ^ bit1 n := -by rw [zpow_bit1', zpow_bit1', neg_mul_neg, neg_mul_eq_mul_neg] - -section ordered_field_power -open int - -variables {K : Type u} [linear_ordered_field K] {a : K} {n : ℤ} - -lemma zpow_nonneg {a : K} (ha : 0 ≤ a) : ∀ (z : ℤ), 0 ≤ a ^ z -| (n : ℕ) := by { rw zpow_coe_nat, exact pow_nonneg ha _ } -| -[1+n] := by { rw zpow_neg_succ_of_nat, exact inv_nonneg.2 (pow_nonneg ha _) } - -lemma zpow_pos_of_pos {a : K} (ha : 0 < a) : ∀ (z : ℤ), 0 < a ^ z -| (n : ℕ) := by { rw zpow_coe_nat, exact pow_pos ha _ } -| -[1+n] := by { rw zpow_neg_succ_of_nat, exact inv_pos.2 (pow_pos ha _) } - -lemma zpow_le_of_le {x : K} (hx : 1 ≤ x) {a b : ℤ} (h : a ≤ b) : x ^ a ≤ x ^ b := -begin - induction a with a a; induction b with b b, - { simp only [of_nat_eq_coe, zpow_coe_nat], - apply pow_le_pow hx, - apply le_of_coe_nat_le_coe_nat h }, - { apply absurd h, - apply not_le_of_gt, - exact lt_of_lt_of_le (neg_succ_lt_zero _) (of_nat_nonneg _) }, - { simp only [zpow_neg_succ_of_nat, one_div, of_nat_eq_coe, zpow_coe_nat], - apply le_trans (inv_le_one _); apply one_le_pow_of_one_le hx }, - { simp only [zpow_neg_succ_of_nat], - apply (inv_le_inv _ _).2, - { apply pow_le_pow hx, - have : -(↑(a+1) : ℤ) ≤ -(↑(b+1) : ℤ), from h, - have h' := le_of_neg_le_neg this, - apply le_of_coe_nat_le_coe_nat h' }, - repeat { apply pow_pos (lt_of_lt_of_le zero_lt_one hx) } } -end - -lemma pow_le_max_of_min_le {x : K} (hx : 1 ≤ x) {a b c : ℤ} (h : min a b ≤ c) : - x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) := -begin - wlog hle : a ≤ b, - have hnle : -b ≤ -a, from neg_le_neg hle, - have hfle : x ^ (-b) ≤ x ^ (-a), from zpow_le_of_le hx hnle, - have : x ^ (-c) ≤ x ^ (-a), - { apply zpow_le_of_le hx, - simpa only [min_eq_left hle, neg_le_neg_iff] using h }, - simpa only [max_eq_left hfle] -end - -lemma zpow_le_one_of_nonpos {p : K} (hp : 1 ≤ p) {z : ℤ} (hz : z ≤ 0) : p ^ z ≤ 1 := -calc p ^ z ≤ p ^ 0 : zpow_le_of_le hp hz - ... = 1 : by simp - -lemma one_le_zpow_of_nonneg {p : K} (hp : 1 ≤ p) {z : ℤ} (hz : 0 ≤ z) : 1 ≤ p ^ z := -calc p ^ z ≥ p ^ 0 : zpow_le_of_le hp hz - ... = 1 : by simp - -theorem zpow_bit0_nonneg (a : K) (n : ℤ) : 0 ≤ a ^ bit0 n := -by { rw zpow_bit0₀, exact mul_self_nonneg _ } - -theorem zpow_two_nonneg (a : K) : 0 ≤ a ^ (2 : ℤ) := -zpow_bit0_nonneg a 1 - -theorem zpow_bit0_pos {a : K} (h : a ≠ 0) (n : ℤ) : 0 < a ^ bit0 n := -(zpow_bit0_nonneg a n).lt_of_ne (zpow_ne_zero _ h).symm - -theorem zpow_two_pos_of_ne_zero (a : K) (h : a ≠ 0) : 0 < a ^ (2 : ℤ) := -zpow_bit0_pos h 1 - -@[simp] theorem zpow_bit1_neg_iff : a ^ bit1 n < 0 ↔ a < 0 := -⟨λ h, not_le.1 $ λ h', not_le.2 h $ zpow_nonneg h' _, - λ h, by rw [bit1, zpow_add_one₀ h.ne]; exact mul_neg_of_pos_of_neg (zpow_bit0_pos h.ne _) h⟩ - -@[simp] theorem zpow_bit1_nonneg_iff : 0 ≤ a ^ bit1 n ↔ 0 ≤ a := -le_iff_le_iff_lt_iff_lt.2 zpow_bit1_neg_iff - -@[simp] theorem zpow_bit1_nonpos_iff : a ^ bit1 n ≤ 0 ↔ a ≤ 0 := -begin - rw [le_iff_lt_or_eq, zpow_bit1_neg_iff], - split, - { rintro (h | h), - { exact h.le }, - { exact (zpow_eq_zero h).le } }, - { intro h, - rcases eq_or_lt_of_le h with rfl|h, - { exact or.inr (zero_zpow _ (bit1_ne_zero n)) }, - { exact or.inl h } } -end - -@[simp] theorem zpow_bit1_pos_iff : 0 < a ^ bit1 n ↔ 0 < a := -lt_iff_lt_of_le_iff_le zpow_bit1_nonpos_iff - -end ordered_field_power - -lemma one_lt_zpow {K} [linear_ordered_field K] {p : K} (hp : 1 < p) : - ∀ z : ℤ, 0 < z → 1 < p ^ z -| (n : ℕ) h := (zpow_coe_nat p n).symm.subst (one_lt_pow hp $ int.coe_nat_ne_zero.mp h.ne') -| -[1+ n] h := ((int.neg_succ_not_pos _).mp h).elim - -section ordered -variables {K : Type*} [linear_ordered_field K] - -lemma nat.zpow_pos_of_pos {p : ℕ} (h : 0 < p) (n:ℤ) : 0 < (p:K)^n := -by { apply zpow_pos_of_pos, exact_mod_cast h } - -lemma nat.zpow_ne_zero_of_pos {p : ℕ} (h : 0 < p) (n:ℤ) : (p:K)^n ≠ 0 := -ne_of_gt (nat.zpow_pos_of_pos h n) - -lemma zpow_strict_mono {x : K} (hx : 1 < x) : - strict_mono (λ n:ℤ, x ^ n) := -strict_mono_int_of_lt_succ $ λ n, -have xpos : 0 < x, from zero_lt_one.trans hx, -calc x ^ n < x ^ n * x : lt_mul_of_one_lt_right (zpow_pos_of_pos xpos _) hx -... = x ^ (n + 1) : (zpow_add_one₀ xpos.ne' _).symm - -lemma zpow_strict_anti {x : K} (h₀ : 0 < x) (h₁ : x < 1) : strict_anti (λ n : ℤ, x ^ n) := -strict_anti_int_of_succ_lt $ λ n, -calc x ^ (n + 1) = x ^ n * x : zpow_add_one₀ h₀.ne' _ -... < x ^ n * 1 : (mul_lt_mul_left $ zpow_pos_of_pos h₀ _).2 h₁ -... = x ^ n : mul_one _ - -@[simp] lemma zpow_lt_iff_lt {x : K} (hx : 1 < x) {m n : ℤ} : - x ^ m < x ^ n ↔ m < n := -(zpow_strict_mono hx).lt_iff_lt - -@[simp] lemma zpow_le_iff_le {x : K} (hx : 1 < x) {m n : ℤ} : - x ^ m ≤ x ^ n ↔ m ≤ n := -(zpow_strict_mono hx).le_iff_le - -lemma min_le_of_zpow_le_max {x : K} (hx : 1 < x) {a b c : ℤ} - (h_max : x ^ (-c) ≤ max (x ^ (-a)) (x ^ (-b)) ) : min a b ≤ c := -begin - rw min_le_iff, - refine or.imp (λ h, _) (λ h, _) (le_max_iff.mp h_max); - rwa [zpow_le_iff_le hx, neg_le_neg_iff] at h -end - -@[simp] lemma pos_div_pow_pos {a b : K} (ha : 0 < a) (hb : 0 < b) (k : ℕ) : 0 < a/b^k := -div_pos ha (pow_pos hb k) - -@[simp] lemma div_pow_le {a b : K} (ha : 0 < a) (hb : 1 ≤ b) (k : ℕ) : a/b^k ≤ a := -(div_le_iff $ pow_pos (lt_of_lt_of_le zero_lt_one hb) k).mpr -(calc a = a * 1 : (mul_one a).symm - ... ≤ a*b^k : (mul_le_mul_left ha).mpr $ one_le_pow_of_one_le hb _) - -lemma zpow_injective {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) : - function.injective ((^) x : ℤ → K) := -begin - intros m n h, - rcases h₁.lt_or_lt with H|H, - { apply (zpow_strict_mono (one_lt_inv h₀ H)).injective, - show x⁻¹ ^ m = x⁻¹ ^ n, - rw [← zpow_neg_one, ← zpow_mul₀, ← zpow_mul₀, mul_comm _ m, mul_comm _ n, zpow_mul₀, zpow_mul₀, - h], }, - { exact (zpow_strict_mono H).injective h, }, -end - -@[simp] lemma zpow_inj {x : K} (h₀ : 0 < x) (h₁ : x ≠ 1) {m n : ℤ} : - x ^ m = x ^ n ↔ m = n := -(zpow_injective h₀ h₁).eq_iff - -end ordered - -section -variables {K : Type*} [division_ring K] - -@[simp, norm_cast] theorem rat.cast_zpow [char_zero K] (q : ℚ) (n : ℤ) : - ((q ^ n : ℚ) : K) = q ^ n := -(rat.cast_hom K).map_zpow q n - -end diff --git a/src/algebra/free.lean b/src/algebra/free.lean index e62e005b0c2c9..943813c801394 100644 --- a/src/algebra/free.lean +++ b/src/algebra/free.lean @@ -4,21 +4,27 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ import algebra.hom.group +import algebra.hom.equiv.basic import control.applicative import control.traversable.basic -import logic.equiv.basic +import logic.equiv.defs +import data.list.basic /-! # Free constructions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `free_magma α`: free magma (structure with binary operation without any axioms) over alphabet `α`, defined inductively, with traversable instance and decidable equality. -* `magma.free_semigroup α`: free semigroup over magma `α`. -* `free_semigroup α`: free semigroup over alphabet `α`, defined as a synonym for `α × list α` - (i.e. nonempty lists), with traversable instance and decidable equality. -* `free_semigroup_free_magma α`: isomorphism between `magma.free_semigroup (free_magma α)` and +* `magma.assoc_quotient α`: quotient of a magma `α` by the associativity equivalence relation. +* `free_semigroup α`: free semigroup over alphabet `α`, defined as a structure with two fields + `head : α` and `tail : list α` (i.e. nonempty lists), with traversable instance and decidable + equality. +* `free_magma_assoc_quotient_equiv α`: isomorphism between `magma.assoc_quotient (free_magma α)` and `free_semigroup α`. * `free_magma.lift`: the universal property of the free magma, expressing its adjointness. -/ @@ -62,6 +68,10 @@ def rec_on_mul {C : free_magma α → Sort l} (x) C x := free_magma.rec_on x ih1 ih2 +@[ext, to_additive] +lemma hom_ext {β : Type v} [has_mul β] {f g : free_magma α →ₙ* β} (h : f ∘ of = g ∘ of) : f = g := +fun_like.ext _ _ $ λ x, rec_on_mul x (congr_fun h) $ by { intros, simp only [map_mul, *] } + end free_magma /-- Lifts a function `α → β` to a magma homomorphism `free_magma α → β` given a magma `β`. -/ @@ -79,56 +89,47 @@ attribute [to_additive free_add_magma.lift_aux] free_magma.lift_aux namespace free_magma -variables {α : Type u} {β : Type v} [has_mul β] (f : α → β) +section lift -@[to_additive] -theorem lift_aux_unique (F : free_magma α →ₙ* β) : ⇑F = lift_aux (F ∘ of) := -funext $ λ x, free_magma.rec_on x (λ x, rfl) $ λ x y ih1 ih2, -(F.map_mul x y).trans $ congr (congr_arg _ ih1) ih2 +variables {α : Type u} {β : Type v} [has_mul β] (f : α → β) /-- The universal property of the free magma expressing its adjointness. -/ -@[to_additive "The universal property of the free additive magma expressing its adjointness."] +@[to_additive "The universal property of the free additive magma expressing its adjointness.", + simps symm_apply] def lift : (α → β) ≃ (free_magma α →ₙ* β) := { to_fun := λ f, { to_fun := lift_aux f, map_mul' := λ x y, rfl, }, inv_fun := λ F, F ∘ of, - left_inv := λ f, by { ext, simp only [lift_aux, mul_hom.coe_mk, function.comp_app], }, - right_inv := λ F, by { ext, rw [mul_hom.coe_mk, lift_aux_unique], } } + left_inv := λ f, by { ext, refl }, + right_inv := λ F, by { ext, refl } } @[simp, to_additive] lemma lift_of (x) : lift f (of x) = f x := rfl +@[simp, to_additive] lemma lift_comp_of : lift f ∘ of = f := rfl -end free_magma +@[simp, to_additive] lemma lift_comp_of' (f : free_magma α →ₙ* β) : lift (f ∘ of) = f := +lift.apply_symm_apply f -/-- The unique magma homomorphism `free_magma α → free_magma β` that sends -each `of x` to `of (f x)`. -/ -def free_magma.map {α : Type u} {β : Type v} (f : α → β) : free_magma α → free_magma β -| (free_magma.of x) := free_magma.of (f x) -| (x * y) := x.map * y.map - -/-- The unique additive magma homomorphism `free_add_magma α → free_add_magma β` that sends -each `of x` to `of (f x)`. -/ -def free_add_magma.map {α : Type u} {β : Type v} (f : α → β) : free_add_magma α → free_add_magma β -| (free_add_magma.of x) := free_add_magma.of (f x) -| (x + y) := x.map + y.map - -attribute [to_additive free_add_magma.map] free_magma.map - -namespace free_magma - -variables {α : Type u} +end lift section map -variables {β : Type v} (f : α → β) +variables {α : Type u} {β : Type v} (f : α → β) + +/-- The unique magma homomorphism `free_magma α →ₙ* free_magma β` that sends +each `of x` to `of (f x)`. -/ +@[to_additive "The unique additive magma homomorphism `free_add_magma α → free_add_magma β` that +sends each `of x` to `of (f x)`."] +def map (f : α → β) : free_magma α →ₙ* free_magma β := lift (of ∘ f) @[simp, to_additive] lemma map_of (x) : map f (of x) = of (f x) := rfl -@[simp, to_additive] lemma map_mul (x y) : map f (x * y) = map f x * map f y := rfl end map section category +variables {α β : Type u} + @[to_additive] instance : monad free_magma := { pure := λ _, of, @@ -141,8 +142,6 @@ protected def rec_on_pure {C : free_magma α → Sort l} (x) C x := free_magma.rec_on_mul x ih1 ih2 -variables {β : Type u} - @[simp, to_additive] lemma map_pure (f : α → β) (x) : (f <$> pure x : free_magma β) = pure (f x) := rfl @@ -261,128 +260,124 @@ attribute [to_additive free_add_magma.repr] free_magma.repr instance {α : Type u} [has_repr α] : has_repr (free_magma α) := ⟨free_magma.repr⟩ /-- Length of an element of a free magma. -/ -def free_magma.length {α : Type u} : free_magma α → ℕ +@[simp] def free_magma.length {α : Type u} : free_magma α → ℕ | (free_magma.of x) := 1 | (x * y) := x.length + y.length /-- Length of an element of a free additive magma. -/ -def free_add_magma.length {α : Type u} : free_add_magma α → ℕ +@[simp] def free_add_magma.length {α : Type u} : free_add_magma α → ℕ | (free_add_magma.of x) := 1 | (x + y) := x.length + y.length attribute [to_additive free_add_magma.length] free_magma.length -/-- Associativity relations for a magma. -/ -inductive magma.free_semigroup.r (α : Type u) [has_mul α] : α → α → Prop -| intro : ∀ x y z, magma.free_semigroup.r ((x * y) * z) (x * (y * z)) -| left : ∀ w x y z, magma.free_semigroup.r (w * ((x * y) * z)) (w * (x * (y * z))) - /-- Associativity relations for an additive magma. -/ -inductive add_magma.free_add_semigroup.r (α : Type u) [has_add α] : α → α → Prop -| intro : ∀ x y z, add_magma.free_add_semigroup.r ((x + y) + z) (x + (y + z)) -| left : ∀ w x y z, add_magma.free_add_semigroup.r (w + ((x + y) + z)) (w + (x + (y + z))) +inductive add_magma.assoc_rel (α : Type u) [has_add α] : α → α → Prop +| intro : ∀ x y z, add_magma.assoc_rel ((x + y) + z) (x + (y + z)) +| left : ∀ w x y z, add_magma.assoc_rel (w + ((x + y) + z)) (w + (x + (y + z))) -attribute [to_additive add_magma.free_add_semigroup.r] magma.free_semigroup.r +/-- Associativity relations for a magma. -/ +@[to_additive add_magma.assoc_rel "Associativity relations for an additive magma."] +inductive magma.assoc_rel (α : Type u) [has_mul α] : α → α → Prop +| intro : ∀ x y z, magma.assoc_rel ((x * y) * z) (x * (y * z)) +| left : ∀ w x y z, magma.assoc_rel (w * ((x * y) * z)) (w * (x * (y * z))) namespace magma -/-- Free semigroup over a magma. -/ -@[to_additive add_magma.free_add_semigroup "Free additive semigroup over an additive magma."] -def free_semigroup (α : Type u) [has_mul α] : Type u := -quot $ free_semigroup.r α +/-- Semigroup quotient of a magma. -/ +@[to_additive add_magma.free_add_semigroup "Additive semigroup quotient of an additive magma."] +def assoc_quotient (α : Type u) [has_mul α] : Type u := quot $ assoc_rel α -namespace free_semigroup +namespace assoc_quotient variables {α : Type u} [has_mul α] -/-- Embedding from magma to its free semigroup. -/ -@[to_additive "Embedding from additive magma to its free additive semigroup."] -def of : α → free_semigroup α := quot.mk _ - @[to_additive] -instance [inhabited α] : inhabited (free_semigroup α) := ⟨of default⟩ - -@[elab_as_eliminator, to_additive] -protected lemma induction_on {C : free_semigroup α → Prop} (x : free_semigroup α) - (ih : ∀ x, C (of x)) : C x := -quot.induction_on x ih +lemma quot_mk_assoc (x y z : α) : quot.mk (assoc_rel α) (x * y * z) = quot.mk _ (x * (y * z)) := +quot.sound (assoc_rel.intro _ _ _) @[to_additive] -theorem of_mul_assoc (x y z : α) : of ((x * y) * z) = of (x * (y * z)) := -quot.sound $ r.intro x y z +lemma quot_mk_assoc_left (x y z w : α) : + quot.mk (assoc_rel α) (x * (y * z * w)) = quot.mk _ (x * (y * (z * w))) := +quot.sound (assoc_rel.left _ _ _ _) @[to_additive] -theorem of_mul_assoc_left (w x y z : α) : of (w * ((x * y) * z)) = of (w * (x * (y * z))) := -quot.sound $ r.left w x y z +instance : semigroup (assoc_quotient α) := +{ mul := λ x y, + begin + refine quot.lift_on₂ x y (λ x y, quot.mk _ (x * y)) _ _, + { rintro a b₁ b₂ (⟨c, d, e⟩ | ⟨c, d, e, f⟩); simp only, + { exact quot_mk_assoc_left _ _ _ _ }, + { rw [← quot_mk_assoc, quot_mk_assoc_left, quot_mk_assoc] } }, + { rintro a₁ a₂ b (⟨c, d, e⟩ | ⟨c, d, e, f⟩); simp only, + { simp only [quot_mk_assoc, quot_mk_assoc_left] }, + { rw [quot_mk_assoc, quot_mk_assoc, quot_mk_assoc_left, quot_mk_assoc_left, + quot_mk_assoc_left, ← quot_mk_assoc c d, ← quot_mk_assoc c d, quot_mk_assoc_left] } } + end, + mul_assoc := λ x y z, quot.induction_on₃ x y z $ λ p q r, quot_mk_assoc p q r } -@[to_additive] -theorem of_mul_assoc_right (w x y z : α) : of (((w * x) * y) * z) = of ((w * (x * y)) * z) := -by rw [of_mul_assoc, of_mul_assoc, of_mul_assoc, of_mul_assoc_left] +/-- Embedding from magma to its free semigroup. -/ +@[to_additive "Embedding from additive magma to its free additive semigroup."] +def of : α →ₙ* assoc_quotient α := ⟨quot.mk _, λ x y, rfl⟩ @[to_additive] -instance : semigroup (free_semigroup α) := -{ mul := λ x y, begin - refine quot.lift_on x (λ p, quot.lift_on y (λ q, (quot.mk _ $ p * q : free_semigroup α)) _) _, - { rintros a b (⟨c, d, e⟩ | ⟨c, d, e, f⟩); change of _ = of _, - { rw of_mul_assoc_left }, - { rw [← of_mul_assoc, of_mul_assoc_left, of_mul_assoc] } }, - { refine quot.induction_on y (λ q, _), - rintros a b (⟨c, d, e⟩ | ⟨c, d, e, f⟩); change of _ = of _, - { rw of_mul_assoc_right }, - { rw [of_mul_assoc, of_mul_assoc, of_mul_assoc_left, of_mul_assoc_left, of_mul_assoc_left, - ← of_mul_assoc c d, ← of_mul_assoc c d, of_mul_assoc_left] } } - end, - mul_assoc := λ x y z, quot.induction_on x $ λ p, quot.induction_on y $ λ q, - quot.induction_on z $ λ r, of_mul_assoc p q r } +instance [inhabited α] : inhabited (assoc_quotient α) := ⟨of default⟩ -@[to_additive] -theorem of_mul (x y : α) : of (x * y) = of x * of y := rfl +@[elab_as_eliminator, to_additive] +protected lemma induction_on {C : assoc_quotient α → Prop} (x : assoc_quotient α) + (ih : ∀ x, C (of x)) : C x := +quot.induction_on x ih section lift -variables {β : Type v} [semigroup β] (f : α → β) +variables {β : Type v} [semigroup β] (f : α →ₙ* β) + +@[ext, to_additive] +lemma hom_ext {f g : assoc_quotient α →ₙ* β} (h : f.comp of = g.comp of) : f = g := +fun_like.ext _ _ $ λ x, assoc_quotient.induction_on x $ fun_like.congr_fun h -/-- Lifts a magma homomorphism `α → β` to a semigroup homomorphism `magma.free_semigroup α → β` +/-- Lifts a magma homomorphism `α → β` to a semigroup homomorphism `magma.assoc_quotient α → β` given a semigroup `β`. -/ @[to_additive "Lifts an additive magma homomorphism `α → β` to an additive semigroup homomorphism -`add_magma.free_add_semigroup α → β` given an additive semigroup `β`."] -def lift (hf : ∀ x y, f (x * y) = f x * f y) : free_semigroup α → β := -quot.lift f $ by rintros a b (⟨c, d, e⟩ | ⟨c, d, e, f⟩); simp only [hf, mul_assoc] +`add_magma.assoc_quotient α → β` given an additive semigroup `β`.", simps symm_apply] +def lift : (α →ₙ* β) ≃ (assoc_quotient α →ₙ* β) := +{ to_fun := λ f, + { to_fun := λ x, quot.lift_on x f $ + by rintros a b (⟨c, d, e⟩ | ⟨c, d, e, f⟩); simp only [map_mul, mul_assoc], + map_mul' := λ x y, quot.induction_on₂ x y (map_mul f) }, + inv_fun := λ f, f.comp of, + left_inv := λ f, fun_like.ext _ _ $ λ x, rfl, + right_inv := λ f, hom_ext $ fun_like.ext _ _ $ λ x, rfl } -@[simp, to_additive] lemma lift_of {hf} (x : α) : lift f hf (of x) = f x := rfl +@[simp, to_additive] lemma lift_of (x : α) : lift f (of x) = f x := rfl -@[simp, to_additive] lemma lift_mul {hf} (x y) : lift f hf (x * y) = lift f hf x * lift f hf y := -quot.induction_on x $ λ p, quot.induction_on y $ λ q, hf p q +@[simp, to_additive] lemma lift_comp_of : (lift f).comp of = f := lift.symm_apply_apply f -@[to_additive] -theorem lift_unique (f : free_semigroup α → β) (hf : ∀ x y, f (x * y) = f x * f y) : - f = lift (f ∘ of) (λ p q, hf (of p) (of q)) := -funext $ λ x, quot.induction_on x $ λ p, rfl +@[simp, to_additive] lemma lift_comp_of' (f : assoc_quotient α →ₙ* β) : + lift (f.comp of) = f := +lift.apply_symm_apply f end lift -variables {β : Type v} [has_mul β] (f : α → β) +variables {β : Type v} [has_mul β] (f : α →ₙ* β) -/-- From a magma homomorphism `α → β` to a semigroup homomorphism -`magma.free_semigroup α → magma.free_semigroup β`. -/ +/-- From a magma homomorphism `α →ₙ* β` to a semigroup homomorphism +`magma.assoc_quotient α →ₙ* magma.assoc_quotient β`. -/ @[to_additive "From an additive magma homomorphism `α → β` to an additive semigroup homomorphism -`add_magma.free_add_semigroup α → add_magma.free_add_semigroup β`."] -def map (hf : ∀ x y, f (x * y) = f x * f y) : free_semigroup α → free_semigroup β := -lift (of ∘ f) (λ x y, congr_arg of $ hf x y) +`add_magma.assoc_quotient α → add_magma.assoc_quotient β`."] +def map : assoc_quotient α →ₙ* assoc_quotient β := lift (of.comp f) -@[simp, to_additive] lemma map_of {hf} (x) : map f hf (of x) = of (f x) := rfl -@[simp, to_additive] lemma map_mul {hf} (x y) : map f hf (x * y) = map f hf x * map f hf y := -lift_mul _ _ _ +@[simp, to_additive] lemma map_of (x) : map f (of x) = of (f x) := rfl -end free_semigroup +end assoc_quotient end magma -/-- Free semigroup over a given alphabet. -(Note: In this definition, the free semigroup does not contain the empty word.) -/ -@[to_additive "Free additive semigroup over a given alphabet."] -def free_semigroup (α : Type u) : Type u := -α × list α +/-- Free additive semigroup over a given alphabet. -/ +@[ext] structure free_add_semigroup (α : Type u) := (head : α) (tail : list α) + +/-- Free semigroup over a given alphabet. -/ +@[ext, to_additive] structure free_semigroup (α : Type u) := (head : α) (tail : list α) namespace free_semigroup @@ -390,42 +385,45 @@ variables {α : Type u} @[to_additive] instance : semigroup (free_semigroup α) := -{ mul := λ L1 L2, (L1.1, L1.2 ++ L2.1 :: L2.2), - mul_assoc := λ L1 L2 L3, prod.ext rfl $ list.append_assoc _ _ _ } +{ mul := λ L1 L2, ⟨L1.1, L1.2 ++ L2.1 :: L2.2⟩, + mul_assoc := λ L1 L2 L3, ext _ _ rfl $ list.append_assoc _ _ _ } -/-- The embedding `α → free_semigroup α`. -/ -@[to_additive "The embedding `α → free_add_semigroup α`."] -def of (x : α) : free_semigroup α := -(x, []) +@[simp, to_additive] lemma head_mul (x y : free_semigroup α) : (x * y).1 = x.1 := rfl -@[to_additive] -instance [inhabited α] : inhabited (free_semigroup α) := ⟨of default⟩ +@[simp, to_additive] lemma tail_mul (x y : free_semigroup α) : (x * y).2 = x.2 ++ (y.1 :: y.2) := +rfl -/-- Recursor for free semigroup using `of` and `*`. -/ -@[elab_as_eliminator, to_additive "Recursor for free additive semigroup using `of` and `+`."] -protected def rec_on {C : free_semigroup α → Sort l} (x) - (ih1 : ∀ x, C (of x)) (ih2 : ∀ x y, C (of x) → C y → C (of x * y)) : - C x := -prod.rec_on x $ λ f s, list.rec_on s ih1 (λ hd tl ih f, ih2 f (hd, tl) (ih1 f) (ih hd)) f +@[simp, to_additive] lemma mk_mul_mk (x y : α) (L1 L2 : list α) : + mk x L1 * mk y L2 = mk x (L1 ++ y :: L2) := rfl -end free_semigroup +/-- The embedding `α → free_semigroup α`. -/ +@[to_additive "The embedding `α → free_add_semigroup α`.", simps] +def of (x : α) : free_semigroup α := ⟨x, []⟩ -/-- Auxiliary function for `free_semigroup.lift`. -/ -def free_semigroup.lift' {α : Type u} {β : Type v} [semigroup β] (f : α → β) : α → list α → β -| x [] := f x -| x (hd::tl) := f x * free_semigroup.lift' hd tl +/-- Length of an element of free semigroup. -/ +@[to_additive "Length of an element of free additive semigroup"] +def length (x : free_semigroup α) : ℕ := x.tail.length + 1 -/-- Auxiliary function for `free_semigroup.lift`. -/ -def free_add_semigroup.lift' {α : Type u} {β : Type v} [add_semigroup β] (f : α → β) : - α → list α → β -| x [] := f x -| x (hd::tl) := f x + free_add_semigroup.lift' hd tl +@[simp, to_additive] lemma length_mul (x y : free_semigroup α) : + (x * y).length = x.length + y.length := +by simp [length, ← add_assoc, add_right_comm] -attribute [to_additive free_add_semigroup.lift'] free_semigroup.lift' +@[simp, to_additive] lemma length_of (x : α) : (of x).length = 1 := rfl -namespace free_semigroup +@[to_additive] instance [inhabited α] : inhabited (free_semigroup α) := ⟨of default⟩ -variables {α : Type u} +/-- Recursor for free semigroup using `of` and `*`. -/ +@[elab_as_eliminator, to_additive "Recursor for free additive semigroup using `of` and `+`."] +protected def rec_on_mul {C : free_semigroup α → Sort l} (x) + (ih1 : ∀ x, C (of x)) (ih2 : ∀ x y, C (of x) → C y → C (of x * y)) : + C x := +free_semigroup.rec_on x $ λ f s, list.rec_on s ih1 (λ hd tl ih f, ih2 f ⟨hd, tl⟩ (ih1 f) (ih hd)) f + +@[ext, to_additive] +lemma hom_ext {β : Type v} [has_mul β] {f g : free_semigroup α →ₙ* β} (h : f ∘ of = g ∘ of) : + f = g := +fun_like.ext _ _ $ λ x, free_semigroup.rec_on_mul x (congr_fun h) $ + λ x y hx hy, by simp only [map_mul, *] section lift @@ -434,22 +432,24 @@ variables {β : Type v} [semigroup β] (f : α → β) /-- Lifts a function `α → β` to a semigroup homomorphism `free_semigroup α → β` given a semigroup `β`. -/ @[to_additive "Lifts a function `α → β` to an additive semigroup homomorphism -`free_add_semigroup α → β` given an additive semigroup `β`."] -def lift (x : free_semigroup α) : β := -lift' f x.1 x.2 +`free_add_semigroup α → β` given an additive semigroup `β`.", simps symm_apply] +def lift : (α → β) ≃ (free_semigroup α →ₙ* β) := +{ to_fun := λ f, + { to_fun := λ x, x.2.foldl (λ a b, a * f b) (f x.1), + map_mul' := λ x y, by simp only [head_mul, tail_mul, ← list.foldl_map f, list.foldl_append, + list.foldl_cons, list.foldl_assoc] }, + inv_fun := λ f, f ∘ of, + left_inv := λ f, rfl, + right_inv := λ f, hom_ext rfl } @[simp, to_additive] lemma lift_of (x : α) : lift f (of x) = f x := rfl -@[to_additive] lemma lift_of_mul (x y) : lift f (of x * y) = f x * lift f y := rfl +@[simp, to_additive] lemma lift_comp_of : lift f ∘ of = f := rfl -@[simp, to_additive] lemma lift_mul (x y) : lift f (x * y) = lift f x * lift f y := -free_semigroup.rec_on x (λ p, rfl) - (λ p x ih1 ih2, by rw [mul_assoc, lift_of_mul, lift_of_mul, mul_assoc, ih2]) +@[simp, to_additive] lemma lift_comp_of' (f : free_semigroup α →ₙ* β) : lift (f ∘ of) = f := +hom_ext rfl -@[to_additive] -theorem lift_unique (f : free_semigroup α → β) (hf : ∀ x y, f (x * y) = f x * f y) : - f = lift (f ∘ of) := -funext $ λ ⟨x, L⟩, list.rec_on L (λ x, rfl) (λ hd tl ih x, - (hf (of x) (hd, tl)).trans $ congr_arg _ $ ih _) x +@[to_additive] lemma lift_of_mul (x y) : lift f (of x * y) = f x * lift f y := +by rw [map_mul, lift_of] end lift @@ -459,12 +459,13 @@ variables {β : Type v} (f : α → β) /-- The unique semigroup homomorphism that sends `of x` to `of (f x)`. -/ @[to_additive "The unique additive semigroup homomorphism that sends `of x` to `of (f x)`."] -def map : free_semigroup α → free_semigroup β := +def map : free_semigroup α →ₙ* free_semigroup β := lift $ of ∘ f @[simp, to_additive] lemma map_of (x) : map f (of x) = of (f x) := rfl -@[simp, to_additive] lemma map_mul (x y) : map f (x * y) = map f x * map f y := -lift_mul _ _ _ + +@[simp, to_additive] lemma length_map (x) : (map f x).length = x.length := +free_semigroup.rec_on_mul x (λ x, rfl) $ λ x y hx hy, by simp only [map_mul, length_mul, *] end map @@ -482,7 +483,7 @@ instance : monad free_semigroup := def rec_on_pure {C : free_semigroup α → Sort l} (x) (ih1 : ∀ x, C (pure x)) (ih2 : ∀ x y, C (pure x) → C y → C (pure x * y)) : C x := -free_semigroup.rec_on x ih1 ih2 +free_semigroup.rec_on_mul x ih1 ih2 @[simp, to_additive] lemma map_pure (f : α → β) (x) : (f <$> pure x : free_semigroup β) = pure (f x) := rfl @@ -490,7 +491,7 @@ lemma map_pure (f : α → β) (x) : (f <$> pure x : free_semigroup β) = pure ( @[simp, to_additive] lemma map_mul' (f : α → β) (x y : free_semigroup α) : (f <$> (x * y)) = (f <$> x * f <$> y) := -map_mul _ _ _ +map_mul (map f) _ _ @[simp, to_additive] lemma pure_bind (f : α → free_semigroup β) (x) : (pure x >>= f) = f x := rfl @@ -498,7 +499,7 @@ map_mul _ _ _ @[simp, to_additive] lemma mul_bind (f : α → free_semigroup β) (x y : free_semigroup α) : (x * y >>= f) = ((x >>= f) * (y >>= f)) := -lift_mul _ _ _ +map_mul (lift f) _ _ @[simp, to_additive] lemma pure_seq {f : α → β} {x : free_semigroup α} : pure f <*> x = f <$> x := rfl @@ -537,8 +538,8 @@ variables [is_lawful_applicative m] traverse F (x * y) = (*) <$> traverse F x <*> traverse F y := let ⟨x, L1⟩ := x, ⟨y, L2⟩ := y in list.rec_on L1 (λ x, rfl) (λ hd tl ih x, - show (*) <$> pure <$> F x <*> traverse F ((hd, tl) * (y, L2) : free_semigroup α) = - (*) <$> ((*) <$> pure <$> F x <*> traverse F (hd, tl)) <*> traverse F (y, L2), + show (*) <$> pure <$> F x <*> traverse F ((mk hd tl) * (mk y L2)) = + (*) <$> ((*) <$> pure <$> F x <*> traverse F (mk hd tl)) <*> traverse F (mk y L2), by rw ih; simp only [(∘), (mul_assoc _ _ _).symm] with functor_norm) x @[simp, to_additive] lemma traverse_mul' : @@ -554,7 +555,7 @@ end @[to_additive] instance : is_lawful_traversable free_semigroup.{u} := -{ id_traverse := λ α x, free_semigroup.rec_on x (λ x, rfl) +{ id_traverse := λ α x, free_semigroup.rec_on_mul x (λ x, rfl) (λ x y ih1 ih2, by rw [traverse_mul, ih1, ih2, mul_map_seq]), comp_traverse := λ F G hf1 hg1 hf2 hg2 α β γ f g x, rec_on_pure x (λ x, by resetI; simp only [traverse_pure, traverse_pure'] with functor_norm) @@ -563,35 +564,54 @@ instance : is_lawful_traversable free_semigroup.{u} := naturality := λ F G hf1 hg1 hf2 hg2 η α β f x, rec_on_pure x (λ x, by simp only [traverse_pure] with functor_norm) (λ x y ih1 ih2, by resetI; simp only [traverse_mul] with functor_norm; rw [ih1, ih2]), - traverse_eq_map_id := λ α β f x, free_semigroup.rec_on x (λ _, rfl) + traverse_eq_map_id := λ α β f x, free_semigroup.rec_on_mul x (λ _, rfl) (λ x y ih1 ih2, by rw [traverse_mul, ih1, ih2, map_mul', mul_map_seq]; refl), .. free_semigroup.is_lawful_monad } end category @[to_additive] -instance [decidable_eq α] : decidable_eq (free_semigroup α) := prod.decidable_eq +instance [decidable_eq α] : decidable_eq (free_semigroup α) := +λ x y, decidable_of_iff' _ (ext_iff _ _) end free_semigroup -/-- Isomorphism between `magma.free_semigroup (free_magma α)` and `free_semigroup α`. -/ +namespace free_magma + +variables {α : Type u} {β : Type v} + +/-- The canonical multiplicative morphism from `free_magma α` to `free_semigroup α`. -/ +@[to_additive "The canonical additive morphism from `free_add_magma α` to `free_add_semigroup α`."] +def to_free_semigroup : free_magma α →ₙ* free_semigroup α := free_magma.lift free_semigroup.of + +@[simp, to_additive] lemma to_free_semigroup_of (x : α) : + to_free_semigroup (of x) = free_semigroup.of x := +rfl + +@[simp, to_additive] lemma to_free_semigroup_comp_of : + @to_free_semigroup α ∘ of = free_semigroup.of := +rfl + +@[to_additive] lemma to_free_semigroup_comp_map (f : α → β) : + to_free_semigroup.comp (map f) = (free_semigroup.map f).comp to_free_semigroup := +by { ext1, refl } + +@[to_additive] lemma to_free_semigroup_map (f : α → β) (x : free_magma α) : + (map f x).to_free_semigroup = free_semigroup.map f x.to_free_semigroup := +fun_like.congr_fun (to_free_semigroup_comp_map f) x + +@[simp, to_additive] lemma length_to_free_semigroup (x : free_magma α) : + x.to_free_semigroup.length = x.length := +free_magma.rec_on_mul x (λ x, rfl) $ λ x y hx hy, + by rw [map_mul, free_semigroup.length_mul, length, hx, hy] + +end free_magma + +/-- Isomorphism between `magma.assoc_quotient (free_magma α)` and `free_semigroup α`. -/ @[to_additive "Isomorphism between -`add_magma.free_add_semigroup (free_add_magma α)` and `free_add_semigroup α`."] -def free_semigroup_free_magma (α : Type u) : - magma.free_semigroup (free_magma α) ≃ free_semigroup α := -{ to_fun := - magma.free_semigroup.lift (free_magma.lift free_semigroup.of) (free_magma.lift _).map_mul, - inv_fun := free_semigroup.lift (magma.free_semigroup.of ∘ free_magma.of), - left_inv := λ x, magma.free_semigroup.induction_on x $ λ p, by rw magma.free_semigroup.lift_of; - exact free_magma.rec_on_mul p - (λ x, by rw [free_magma.lift_of, free_semigroup.lift_of]) - (λ x y ihx ihy, by rw [mul_hom.map_mul, free_semigroup.lift_mul, ihx, ihy, - magma.free_semigroup.of_mul]), - right_inv := λ x, free_semigroup.rec_on x - (λ x, by rw [free_semigroup.lift_of, magma.free_semigroup.lift_of, free_magma.lift_of]) - (λ x y ihx ihy, by rw [free_semigroup.lift_mul, magma.free_semigroup.lift_mul, ihx, ihy]) } - -@[simp, to_additive] lemma free_semigroup_free_magma_mul {α : Type u} (x y) : - free_semigroup_free_magma α (x * y) = free_semigroup_free_magma α x * - free_semigroup_free_magma α y := -magma.free_semigroup.lift_mul _ _ _ +`add_magma.assoc_quotient (free_add_magma α)` and `free_add_semigroup α`."] +def free_magma_assoc_quotient_equiv (α : Type u) : + magma.assoc_quotient (free_magma α) ≃* free_semigroup α := +(magma.assoc_quotient.lift free_magma.to_free_semigroup).to_mul_equiv + (free_semigroup.lift (magma.assoc_quotient.of ∘ free_magma.of)) + (by { ext, refl }) (by { ext1, refl }) diff --git a/src/algebra/free_algebra.lean b/src/algebra/free_algebra.lean index f29bc6e5d3071..d3e5a6ebcd813 100644 --- a/src/algebra/free_algebra.lean +++ b/src/algebra/free_algebra.lean @@ -9,6 +9,9 @@ import algebra.monoid_algebra.basic /-! # Free Algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a commutative semiring `R`, and a type `X`, we construct the free unital, associative `R`-algebra on `X`. @@ -80,13 +83,13 @@ def has_one : has_one (pre R X) := ⟨of_scalar 1⟩ Scalar multiplication defined as multiplication by the image of elements from `R`. Note: Used for notation only. -/ -def has_scalar : has_scalar R (pre R X) := ⟨λ r m, mul (of_scalar r) m⟩ +def has_smul : has_smul R (pre R X) := ⟨λ r m, mul (of_scalar r) m⟩ end pre local attribute [instance] pre.has_coe_generator pre.has_coe_semiring pre.has_mul pre.has_add pre.has_zero - pre.has_one pre.has_scalar + pre.has_one pre.has_smul /-- Given a function from `X` to an `R`-algebra `A`, `lift_fun` provides a lift of `f` to a function @@ -135,7 +138,7 @@ namespace free_algebra local attribute [instance] pre.has_coe_generator pre.has_coe_semiring pre.has_mul pre.has_add pre.has_zero - pre.has_one pre.has_scalar + pre.has_one pre.has_smul instance : semiring (free_algebra R X) := { add := quot.map₂ (+) (λ _ _ _, rel.add_compat_right) (λ _ _ _, rel.add_compat_left), @@ -160,7 +163,7 @@ instance : semiring (free_algebra R X) := instance : inhabited (free_algebra R X) := ⟨0⟩ -instance : has_scalar R (free_algebra R X) := +instance : has_smul R (free_algebra R X) := { smul := λ r, quot.map ((*) ↑r) (λ a b, rel.mul_compat_right) } instance : algebra R (free_algebra R X) := @@ -179,9 +182,10 @@ variables {X} /-- The canonical function `X → free_algebra R X`. -/ -def ι : X → free_algebra R X := λ m, quot.mk _ m +@[irreducible] def ι : X → free_algebra R X := λ m, quot.mk _ m -@[simp] lemma quot_mk_eq_ι (m : X) : quot.mk (free_algebra.rel R X) m = ι R m := rfl +@[simp] lemma quot_mk_eq_ι (m : X) : quot.mk (free_algebra.rel R X) m = ι R m := +by rw [ι] variables {A : Type*} [semiring A] [algebra R A] @@ -230,16 +234,17 @@ private def lift_aux (f : X → A) : (free_algebra R X →ₐ[R] A) := Given a function `f : X → A` where `A` is an `R`-algebra, `lift R f` is the unique lift of `f` to a morphism of `R`-algebras `free_algebra R X → A`. -/ -def lift : (X → A) ≃ (free_algebra R X →ₐ[R] A) := +@[irreducible] def lift : (X → A) ≃ (free_algebra R X →ₐ[R] A) := { to_fun := lift_aux R, inv_fun := λ F, F ∘ (ι R), - left_inv := λ f, by {ext, refl}, + left_inv := λ f, by {ext, rw [ι], refl}, right_inv := λ F, by { ext x, rcases x, induction x, case pre.of : { change ((F : free_algebra R X → A) ∘ (ι R)) _ = _, + rw [ι], refl }, case pre.of_scalar : { change algebra_map _ _ x = F (algebra_map _ _ x), @@ -251,36 +256,35 @@ def lift : (X → A) ≃ (free_algebra R X →ₐ[R] A) := { change lift_aux R (F ∘ ι R) (quot.mk _ _ * quot.mk _ _) = F (quot.mk _ _ * quot.mk _ _), rw [alg_hom.map_mul, alg_hom.map_mul, ha, hb], }, }, } -@[simp] lemma lift_aux_eq (f : X → A) : lift_aux R f = lift R f := rfl +@[simp] lemma lift_aux_eq (f : X → A) : lift_aux R f = lift R f := +by { rw [lift], refl } @[simp] -lemma lift_symm_apply (F : free_algebra R X →ₐ[R] A) : (lift R).symm F = F ∘ (ι R) := rfl +lemma lift_symm_apply (F : free_algebra R X →ₐ[R] A) : (lift R).symm F = F ∘ (ι R) := +by { rw [lift], refl } variables {R X} @[simp] theorem ι_comp_lift (f : X → A) : - (lift R f : free_algebra R X → A) ∘ (ι R) = f := by {ext, refl} + (lift R f : free_algebra R X → A) ∘ (ι R) = f := +by { ext, rw [ι, lift], refl } @[simp] theorem lift_ι_apply (f : X → A) (x) : - lift R f (ι R x) = f x := rfl + lift R f (ι R x) = f x := +by { rw [ι, lift], refl } @[simp] theorem lift_unique (f : X → A) (g : free_algebra R X →ₐ[R] A) : (g : free_algebra R X → A) ∘ (ι R) = f ↔ g = lift R f := -(lift R).symm_apply_eq +by { rw [← (lift R).symm_apply_eq, lift], refl } /-! -At this stage we set the basic definitions as `@[irreducible]`, so from this point onwards one +Since we have set the basic definitions as `@[irreducible]`, from this point onwards one should only use the universal properties of the free algebra, and consider the actual implementation -as a quotient of an inductive type as completely hidden. +as a quotient of an inductive type as completely hidden. -/ -Of course, one still has the option to locally make these definitions `semireducible` if so desired, -and Lean is still willing in some circumstances to do unification based on the underlying -definition. --/ -attribute [irreducible] ι lift -- Marking `free_algebra` irreducible makes `ring` instances inaccessible on quotients. -- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/algebra.2Esemiring_to_ring.20breaks.20semimodule.20typeclass.20lookup/near/212580241 -- For now, we avoid this by not marking it irreducible. @@ -322,7 +326,6 @@ instance [nontrivial R] : nontrivial (free_algebra R X) := equiv_monoid_algebra_free_monoid.surjective.nontrivial section -open_locale classical /-- The left-inverse of `algebra_map`. -/ def algebra_map_inv : free_algebra R X →ₐ[R] R := @@ -344,8 +347,9 @@ map_eq_one_iff (algebra_map _ _) algebra_map_left_inverse.injective -- this proof is copied from the approach in `free_abelian_group.of_injective` lemma ι_injective [nontrivial R] : function.injective (ι R : X → free_algebra R X) := -λ x y hoxy, classical.by_contradiction $ assume hxy : x ≠ y, - let f : free_algebra R X →ₐ[R] R := lift R (λ z, if x = z then (1 : R) else 0) in +λ x y hoxy, classical.by_contradiction $ by classical; exact assume hxy : x ≠ y, + let f : free_algebra R X →ₐ[R] R := + lift R (λ z, if x = z then (1 : R) else 0) in have hfx1 : f (ι R x) = 1, from (lift_ι_apply _ _).trans $ if_pos rfl, have hfy1 : f (ι R y) = 1, from hoxy ▸ hfx1, have hfy0 : f (ι R y) = 0, from (lift_ι_apply _ _).trans $ if_neg hxy, diff --git a/src/algebra/free_monoid.lean b/src/algebra/free_monoid.lean deleted file mode 100644 index 9141a95efce5c..0000000000000 --- a/src/algebra/free_monoid.lean +++ /dev/null @@ -1,124 +0,0 @@ -/- -Copyright (c) 2019 Simon Hudon. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Simon Hudon, Yury Kudryashov --/ -import data.list.big_operators - -/-! -# Free monoid over a given alphabet - -## Main definitions - -* `free_monoid α`: free monoid over alphabet `α`; defined as a synonym for `list α` - with multiplication given by `(++)`. -* `free_monoid.of`: embedding `α → free_monoid α` sending each element `x` to `[x]`; -* `free_monoid.lift`: natural equivalence between `α → M` and `free_monoid α →* M` -* `free_monoid.map`: embedding of `α → β` into `free_monoid α →* free_monoid β` given by `list.map`. --/ - -variables {α : Type*} {β : Type*} {γ : Type*} {M : Type*} [monoid M] {N : Type*} [monoid N] - -/-- Free monoid over a given alphabet. -/ -@[to_additive "Free nonabelian additive monoid over a given alphabet"] -def free_monoid (α) := list α - -namespace free_monoid - -@[to_additive] -instance : monoid (free_monoid α) := -{ one := [], - mul := λ x y, (x ++ y : list α), - mul_one := by intros; apply list.append_nil, - one_mul := by intros; refl, - mul_assoc := by intros; apply list.append_assoc } - -@[to_additive] -instance : inhabited (free_monoid α) := ⟨1⟩ - -@[to_additive] -lemma one_def : (1 : free_monoid α) = [] := rfl - -@[to_additive] -lemma mul_def (xs ys : list α) : (xs * ys : free_monoid α) = (xs ++ ys : list α) := -rfl - -/-- Embeds an element of `α` into `free_monoid α` as a singleton list. -/ -@[to_additive "Embeds an element of `α` into `free_add_monoid α` as a singleton list." ] -def of (x : α) : free_monoid α := [x] - -@[to_additive] -lemma of_def (x : α) : of x = [x] := rfl - -@[to_additive] -lemma of_injective : function.injective (@of α) := -λ a b, list.head_eq_of_cons_eq - -/-- Recursor for `free_monoid` using `1` and `of x * xs` instead of `[]` and `x :: xs`. -/ -@[elab_as_eliminator, to_additive - "Recursor for `free_add_monoid` using `0` and `of x + xs` instead of `[]` and `x :: xs`."] -def rec_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1) - (ih : Π x xs, C xs → C (of x * xs)) : C xs := list.rec_on xs h0 ih - -@[ext, to_additive] -lemma hom_eq ⦃f g : free_monoid α →* M⦄ (h : ∀ x, f (of x) = g (of x)) : - f = g := -monoid_hom.ext $ λ l, rec_on l (f.map_one.trans g.map_one.symm) $ - λ x xs hxs, by simp only [h, hxs, monoid_hom.map_mul] - -/-- Equivalence between maps `α → M` and monoid homomorphisms `free_monoid α →* M`. -/ -@[to_additive "Equivalence between maps `α → A` and additive monoid homomorphisms -`free_add_monoid α →+ A`."] -def lift : (α → M) ≃ (free_monoid α →* M) := -{ to_fun := λ f, ⟨λ l, (l.map f).prod, rfl, - λ l₁ l₂, by simp only [mul_def, list.map_append, list.prod_append]⟩, - inv_fun := λ f x, f (of x), - left_inv := λ f, funext $ λ x, one_mul (f x), - right_inv := λ f, hom_eq $ λ x, one_mul (f (of x)) } - -@[simp, to_additive] -lemma lift_symm_apply (f : free_monoid α →* M) : lift.symm f = f ∘ of := rfl - -@[to_additive] -lemma lift_apply (f : α → M) (l : free_monoid α) : lift f l = (l.map f).prod := rfl - -@[to_additive] -lemma lift_comp_of (f : α → M) : (lift f) ∘ of = f := lift.symm_apply_apply f - -@[simp, to_additive] -lemma lift_eval_of (f : α → M) (x : α) : lift f (of x) = f x := -congr_fun (lift_comp_of f) x - -@[simp, to_additive] -lemma lift_restrict (f : free_monoid α →* M) : lift (f ∘ of) = f := -lift.apply_symm_apply f - -@[to_additive] -lemma comp_lift (g : M →* N) (f : α → M) : g.comp (lift f) = lift (g ∘ f) := -by { ext, simp } - -@[to_additive] -lemma hom_map_lift (g : M →* N) (f : α → M) (x : free_monoid α) : g (lift f x) = lift (g ∘ f) x := -monoid_hom.ext_iff.1 (comp_lift g f) x - -/-- The unique monoid homomorphism `free_monoid α →* free_monoid β` that sends -each `of x` to `of (f x)`. -/ -@[to_additive "The unique additive monoid homomorphism `free_add_monoid α →+ free_add_monoid β` -that sends each `of x` to `of (f x)`."] -def map (f : α → β) : free_monoid α →* free_monoid β := -{ to_fun := list.map f, - map_one' := rfl, - map_mul' := λ l₁ l₂, list.map_append _ _ _ } - -@[simp, to_additive] lemma map_of (f : α → β) (x : α) : map f (of x) = of (f x) := rfl - -@[to_additive] -lemma lift_of_comp_eq_map (f : α → β) : - lift (λ x, of (f x)) = map f := -hom_eq $ λ x, rfl - -@[to_additive] -lemma map_comp (g : β → γ) (f : α → β) : map (g ∘ f) = (map g).comp (map f) := -hom_eq $ λ x, rfl - -end free_monoid diff --git a/src/algebra/free_monoid/basic.lean b/src/algebra/free_monoid/basic.lean new file mode 100644 index 0000000000000..7ccb6fdeddc5f --- /dev/null +++ b/src/algebra/free_monoid/basic.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2019 Simon Hudon. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Simon Hudon, Yury Kudryashov +-/ +import data.list.big_operators.basic + +/-! +# Free monoid over a given alphabet + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `free_monoid α`: free monoid over alphabet `α`; defined as a synonym for `list α` + with multiplication given by `(++)`. +* `free_monoid.of`: embedding `α → free_monoid α` sending each element `x` to `[x]`; +* `free_monoid.lift`: natural equivalence between `α → M` and `free_monoid α →* M` +* `free_monoid.map`: embedding of `α → β` into `free_monoid α →* free_monoid β` given by `list.map`. +-/ + +variables {α : Type*} {β : Type*} {γ : Type*} {M : Type*} [monoid M] {N : Type*} [monoid N] + +/-- Free monoid over a given alphabet. -/ +@[to_additive "Free nonabelian additive monoid over a given alphabet"] +def free_monoid (α) := list α + +namespace free_monoid + +@[to_additive] instance [decidable_eq α] : decidable_eq (free_monoid α) := list.decidable_eq + +/-- The identity equivalence between `free_monoid α` and `list α`. -/ +@[to_additive "The identity equivalence between `free_add_monoid α` and `list α`."] +def to_list : free_monoid α ≃ list α := equiv.refl _ + +/-- The identity equivalence between `list α` and `free_monoid α`. -/ +@[to_additive "The identity equivalence between `list α` and `free_add_monoid α`."] +def of_list : list α ≃ free_monoid α := equiv.refl _ + +@[simp, to_additive] lemma to_list_symm : (@to_list α).symm = of_list := rfl +@[simp, to_additive] lemma of_list_symm : (@of_list α).symm = to_list := rfl +@[simp, to_additive] lemma to_list_of_list (l : list α) : to_list (of_list l) = l := rfl +@[simp, to_additive] lemma of_list_to_list (xs : free_monoid α) : of_list (to_list xs) = xs := rfl +@[simp, to_additive] lemma to_list_comp_of_list : @to_list α ∘ of_list = id := rfl +@[simp, to_additive] lemma of_list_comp_to_list : @of_list α ∘ to_list = id := rfl + +@[to_additive] +instance : cancel_monoid (free_monoid α) := +{ one := of_list [], + mul := λ x y, of_list (x.to_list ++ y.to_list), + mul_one := list.append_nil, + one_mul := list.nil_append, + mul_assoc := list.append_assoc, + mul_left_cancel := λ _ _ _, list.append_left_cancel, + mul_right_cancel := λ _ _ _, list.append_right_cancel } + +@[to_additive] +instance : inhabited (free_monoid α) := ⟨1⟩ + +@[simp, to_additive] lemma to_list_one : (1 : free_monoid α).to_list = [] := rfl +@[simp, to_additive] lemma of_list_nil : of_list ([] : list α) = 1 := rfl + +@[simp, to_additive] +lemma to_list_mul (xs ys : free_monoid α) : (xs * ys).to_list = xs.to_list ++ ys.to_list := rfl + +@[simp, to_additive] +lemma of_list_append (xs ys : list α) : + of_list (xs ++ ys) = of_list xs * of_list ys := +rfl + +@[simp, to_additive] +lemma to_list_prod (xs : list (free_monoid α)) : to_list xs.prod = (xs.map to_list).join := +by induction xs; simp [*, list.join] + +@[simp, to_additive] +lemma of_list_join (xs : list (list α)) : of_list xs.join = (xs.map of_list).prod := +to_list.injective $ by simp + +/-- Embeds an element of `α` into `free_monoid α` as a singleton list. -/ +@[to_additive "Embeds an element of `α` into `free_add_monoid α` as a singleton list." ] +def of (x : α) : free_monoid α := of_list [x] + +@[simp, to_additive] lemma to_list_of (x : α) : to_list (of x) = [x] := rfl +@[to_additive] lemma of_list_singleton (x : α) : of_list [x] = of x := rfl + +@[simp, to_additive] lemma of_list_cons (x : α) (xs : list α) : + of_list (x :: xs) = of x * of_list xs := +rfl + +@[to_additive] lemma to_list_of_mul (x : α) (xs : free_monoid α) : + to_list (of x * xs) = x :: xs.to_list := +rfl + +@[to_additive] lemma of_injective : function.injective (@of α) := list.singleton_injective + +/-- Recursor for `free_monoid` using `1` and `free_monoid.of x * xs` instead of `[]` and +`x :: xs`. -/ +@[elab_as_eliminator, to_additive + "Recursor for `free_add_monoid` using `0` and `free_add_monoid.of x + xs` instead of `[]` and + `x :: xs`."] +def rec_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1) + (ih : Π x xs, C xs → C (of x * xs)) : C xs := list.rec_on xs h0 ih + +@[simp, to_additive] lemma rec_on_one {C : free_monoid α → Sort*} (h0 : C 1) + (ih : Π x xs, C xs → C (of x * xs)) : + @rec_on α C 1 h0 ih = h0 := +rfl + +@[simp, to_additive] lemma rec_on_of_mul {C : free_monoid α → Sort*} (x : α) (xs : free_monoid α) + (h0 : C 1) (ih : Π x xs, C xs → C (of x * xs)) : + @rec_on α C (of x * xs) h0 ih = ih x xs (rec_on xs h0 ih) := +rfl + +/-- A version of `list.cases_on` for `free_monoid` using `1` and `free_monoid.of x * xs` instead of +`[]` and `x :: xs`. -/ +@[elab_as_eliminator, to_additive + "A version of `list.cases_on` for `free_add_monoid` using `0` and `free_add_monoid.of x + xs` + instead of `[]` and `x :: xs`."] +def cases_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1) + (ih : Π x xs, C (of x * xs)) : C xs := list.cases_on xs h0 ih + +@[simp, to_additive] lemma cases_on_one {C : free_monoid α → Sort*} (h0 : C 1) + (ih : Π x xs, C (of x * xs)) : + @cases_on α C 1 h0 ih = h0 := +rfl + +@[simp, to_additive] lemma cases_on_of_mul {C : free_monoid α → Sort*} (x : α) (xs : free_monoid α) + (h0 : C 1) (ih : Π x xs, C (of x * xs)) : + @cases_on α C (of x * xs) h0 ih = ih x xs := +rfl + +@[ext, to_additive] +lemma hom_eq ⦃f g : free_monoid α →* M⦄ (h : ∀ x, f (of x) = g (of x)) : + f = g := +monoid_hom.ext $ λ l, rec_on l (f.map_one.trans g.map_one.symm) $ + λ x xs hxs, by simp only [h, hxs, monoid_hom.map_mul] + +/-- A variant of `list.prod` that has `[x].prod = x` true definitionally. + +The purpose is to make `free_monoid.lift_eval_of` true by `rfl`. -/ +@[to_additive "A variant of `list.sum` that has `[x].sum = x` true definitionally. + +The purpose is to make `free_add_monoid.lift_eval_of` true by `rfl`."] +def prod_aux {M} [monoid M] (l : list M) : M := +l.rec_on 1 (λ x xs (_ : M), list.foldl (*) x xs) + +@[to_additive] +lemma prod_aux_eq : ∀ l : list M, free_monoid.prod_aux l = l.prod +| [] := rfl +| (x :: xs) := congr_arg (λ x, list.foldl (*) x xs) (one_mul _).symm + +/-- Equivalence between maps `α → M` and monoid homomorphisms `free_monoid α →* M`. -/ +@[to_additive "Equivalence between maps `α → A` and additive monoid homomorphisms +`free_add_monoid α →+ A`."] +def lift : (α → M) ≃ (free_monoid α →* M) := +{ to_fun := λ f, ⟨λ l, free_monoid.prod_aux (l.to_list.map f), rfl, + λ l₁ l₂, by simp only [prod_aux_eq, to_list_mul, list.map_append, list.prod_append]⟩, + inv_fun := λ f x, f (of x), + left_inv := λ f, rfl, + right_inv := λ f, hom_eq $ λ x, rfl } + +@[simp, to_additive] +lemma lift_symm_apply (f : free_monoid α →* M) : lift.symm f = f ∘ of := rfl + +@[to_additive] +lemma lift_apply (f : α → M) (l : free_monoid α) : lift f l = (l.to_list.map f).prod := +prod_aux_eq _ + +@[to_additive] lemma lift_comp_of (f : α → M) : lift f ∘ of = f := rfl + +@[simp, to_additive] +lemma lift_eval_of (f : α → M) (x : α) : lift f (of x) = f x := rfl + +@[simp, to_additive] +lemma lift_restrict (f : free_monoid α →* M) : lift (f ∘ of) = f := +lift.apply_symm_apply f + +@[to_additive] +lemma comp_lift (g : M →* N) (f : α → M) : g.comp (lift f) = lift (g ∘ f) := +by { ext, simp } + +@[to_additive] +lemma hom_map_lift (g : M →* N) (f : α → M) (x : free_monoid α) : g (lift f x) = lift (g ∘ f) x := +monoid_hom.ext_iff.1 (comp_lift g f) x + +/-- Define a multiplicative action of `free_monoid α` on `β`. -/ +@[to_additive "Define an additive action of `free_add_monoid α` on `β`."] +def mk_mul_action (f : α → β → β) : mul_action (free_monoid α) β := +{ smul := λ l b, l.to_list.foldr f b, + one_smul := λ x, rfl, + mul_smul := λ xs ys b, list.foldr_append _ _ _ _ } + +@[to_additive] lemma smul_def (f : α → β → β) (l : free_monoid α) (b : β) : + (by haveI := mk_mul_action f; exact l • b = l.to_list.foldr f b) := +rfl + +@[to_additive] lemma of_list_smul (f : α → β → β) (l : list α) (b : β) : + (by haveI := mk_mul_action f; exact (of_list l) • b = l.foldr f b) := +rfl + +@[simp, to_additive] lemma of_smul (f : α → β → β) (x : α) (y : β) : + (by haveI := mk_mul_action f; exact of x • y) = f x y := +rfl + +/-- The unique monoid homomorphism `free_monoid α →* free_monoid β` that sends +each `of x` to `of (f x)`. -/ +@[to_additive "The unique additive monoid homomorphism `free_add_monoid α →+ free_add_monoid β` +that sends each `of x` to `of (f x)`."] +def map (f : α → β) : free_monoid α →* free_monoid β := +{ to_fun := λ l, of_list $ l.to_list.map f, + map_one' := rfl, + map_mul' := λ l₁ l₂, list.map_append _ _ _ } + +@[simp, to_additive] lemma map_of (f : α → β) (x : α) : map f (of x) = of (f x) := rfl + +@[to_additive] lemma to_list_map (f : α → β) (xs : free_monoid α) : + (map f xs).to_list = xs.to_list.map f := +rfl + +@[to_additive] lemma of_list_map (f : α → β) (xs : list α) : + of_list (xs.map f) = map f (of_list xs) := +rfl + +@[to_additive] +lemma lift_of_comp_eq_map (f : α → β) : + lift (λ x, of (f x)) = map f := +hom_eq $ λ x, rfl + +@[to_additive] +lemma map_comp (g : β → γ) (f : α → β) : map (g ∘ f) = (map g).comp (map f) := +hom_eq $ λ x, rfl + +@[simp, to_additive] lemma map_id : map (@id α) = monoid_hom.id (free_monoid α) := +hom_eq $ λ x, rfl + +end free_monoid diff --git a/src/algebra/free_monoid/count.lean b/src/algebra/free_monoid/count.lean new file mode 100644 index 0000000000000..ac642cb2e04ba --- /dev/null +++ b/src/algebra/free_monoid/count.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import algebra.free_monoid.basic +import data.list.count + +/-! +# `list.count` as a bundled homomorphism + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `free_monoid.countp`, `free_monoid.count`, `free_add_monoid.countp`, and +`free_add_monoid.count`. These are `list.countp` and `list.count` bundled as multiplicative and +additive homomorphisms from `free_monoid` and `free_add_monoid`. + +We do not use `to_additive` because it can't map `multiplicative ℕ` to `ℕ`. +-/ + +variables {α : Type*} (p : α → Prop) [decidable_pred p] + +namespace free_add_monoid + +/-- `list.countp` as a bundled additive monoid homomorphism. -/ +def countp (p : α → Prop) [decidable_pred p] : free_add_monoid α →+ ℕ := +⟨list.countp p, list.countp_nil p, list.countp_append _⟩ + +lemma countp_of (x : α) : countp p (of x) = if p x then 1 else 0 := rfl + +lemma countp_apply (l : free_add_monoid α) : countp p l = list.countp p l := rfl + +/-- `list.count` as a bundled additive monoid homomorphism. -/ +def count [decidable_eq α] (x : α) : free_add_monoid α →+ ℕ := countp (eq x) + +lemma count_of [decidable_eq α] (x y : α) : count x (of y) = pi.single x 1 y := +by simp only [count, countp_of, pi.single_apply, eq_comm] + +lemma count_apply [decidable_eq α] (x : α) (l : free_add_monoid α) : + count x l = list.count x l := +rfl + +end free_add_monoid + +namespace free_monoid + +/-- `list.countp` as a bundled multiplicative monoid homomorphism. -/ +def countp (p : α → Prop) [decidable_pred p] : free_monoid α →* multiplicative ℕ := +(free_add_monoid.countp p).to_multiplicative + +lemma countp_of' (x : α) : + countp p (of x) = if p x then multiplicative.of_add 1 else multiplicative.of_add 0 := +rfl + +lemma countp_of (x : α) : countp p (of x) = if p x then multiplicative.of_add 1 else 1 := +by rw [countp_of', of_add_zero] -- `rfl` is not transitive + +lemma countp_apply (l : free_add_monoid α) : + countp p l = multiplicative.of_add (list.countp p l) := +rfl + +/-- `list.count` as a bundled additive monoid homomorphism. -/ +def count [decidable_eq α] (x : α) : free_monoid α →* multiplicative ℕ := countp (eq x) + +lemma count_apply [decidable_eq α] (x : α) (l : free_add_monoid α) : + count x l = multiplicative.of_add (list.count x l) := +rfl + +lemma count_of [decidable_eq α] (x y : α) : + count x (of y) = @pi.mul_single α (λ _, multiplicative ℕ) _ _ x (multiplicative.of_add 1) y := +by simp only [count, countp_of, pi.mul_single_apply, eq_comm] + +end free_monoid diff --git a/src/algebra/free_non_unital_non_assoc_algebra.lean b/src/algebra/free_non_unital_non_assoc_algebra.lean index 3b1a15738d151..4bb1d33b6ebda 100644 --- a/src/algebra/free_non_unital_non_assoc_algebra.lean +++ b/src/algebra/free_non_unital_non_assoc_algebra.lean @@ -9,6 +9,9 @@ import algebra.monoid_algebra.basic /-! # Free algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a semiring `R` and a type `X`, we construct the free non-unital, non-associative algebra on `X` with coefficients in `R`, together with its universal property. The construction is valuable because it can be used to build free algebras with more structure, e.g., free Lie algebras. diff --git a/src/algebra/gcd_monoid/basic.lean b/src/algebra/gcd_monoid/basic.lean index cb092a5eb93c0..8a98908d5908f 100644 --- a/src/algebra/gcd_monoid/basic.lean +++ b/src/algebra/gcd_monoid/basic.lean @@ -6,10 +6,14 @@ Authors: Johannes Hölzl, Jens Wagemaker import algebra.associated import algebra.group_power.lemmas +import algebra.ring.regular /-! # Monoids with normalization functions, `gcd`, and `lcm` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines extra structures on `cancel_comm_monoid_with_zero`s, including `is_domain`s. ## Main Definitions @@ -63,9 +67,6 @@ divisibility, gcd, lcm, normalize variables {α : Type*} - - - /-- Normalization monoid: multiplying with `norm_unit` gives a normal form for associated elements. -/ @[protect_proj] class normalization_monoid (α : Type*) @@ -101,6 +102,14 @@ theorem associated_normalize (x : α) : associated x (normalize x) := theorem normalize_associated (x : α) : associated (normalize x) x := (associated_normalize _).symm +lemma associated_normalize_iff {x y : α} : + associated x (normalize y) ↔ associated x y := +⟨λ h, h.trans (normalize_associated y), λ h, h.trans (associated_normalize y)⟩ + +lemma normalize_associated_iff {x y : α} : + associated (normalize x) y ↔ associated x y := +⟨λ h, (associated_normalize _).trans h, λ h, (normalize_associated _).trans h⟩ + lemma associates.mk_normalize (x : α) : associates.mk (normalize x) = associates.mk x := associates.mk_eq_mk_iff_associated.2 (normalize_associated _) @@ -406,17 +415,22 @@ by { rw mul_comm at H ⊢, exact dvd_gcd_mul_of_dvd_mul H } /-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. - Note: In general, this representation is highly non-unique. -/ +In other words, the nonzero elements of a `gcd_monoid` form a decomposition monoid +(more widely known as a pre-Schreier domain in the context of rings). + +Note: In general, this representation is highly non-unique. + +See `nat.prod_dvd_and_dvd_of_dvd_prod` for a constructive version on `ℕ`. -/ lemma exists_dvd_and_dvd_of_dvd_mul [gcd_monoid α] {m n k : α} (H : k ∣ m * n) : - ∃ d₁ (hd₁ : d₁ ∣ m) d₂ (hd₂ : d₂ ∣ n), k = d₁ * d₂ := + ∃ d₁ d₂, d₁ ∣ m ∧ d₂ ∣ n ∧ k = d₁ * d₂ := begin by_cases h0 : gcd k m = 0, { rw gcd_eq_zero_iff at h0, rcases h0 with ⟨rfl, rfl⟩, - refine ⟨0, dvd_refl 0, n, dvd_refl n, _⟩, + refine ⟨0, n, dvd_refl 0, dvd_refl n, _⟩, simp }, { obtain ⟨a, ha⟩ := gcd_dvd_left k m, - refine ⟨gcd k m, gcd_dvd_right _ _, a, _, ha⟩, + refine ⟨gcd k m, a, gcd_dvd_right _ _, _, ha⟩, suffices h : gcd k m * a ∣ gcd k m * n, { cases h with b hb, use b, @@ -426,9 +440,17 @@ begin exact dvd_gcd_mul_of_dvd_mul H } end +lemma dvd_mul [gcd_monoid α] {k m n : α} : + k ∣ (m * n) ↔ ∃ d₁ d₂, d₁ ∣ m ∧ d₂ ∣ n ∧ k = d₁ * d₂ := +begin + refine ⟨exists_dvd_and_dvd_of_dvd_mul, _⟩, + rintro ⟨d₁, d₂, hy, hz, rfl⟩, + exact mul_dvd_mul hy hz, +end + theorem gcd_mul_dvd_mul_gcd [gcd_monoid α] (k m n : α) : gcd k (m * n) ∣ gcd k m * gcd k n := begin - obtain ⟨m', hm', n', hn', h⟩ := (exists_dvd_and_dvd_of_dvd_mul $ gcd_dvd_right k (m * n)), + obtain ⟨m', n', hm', hn', h⟩ := exists_dvd_and_dvd_of_dvd_mul (gcd_dvd_right k (m * n)), replace h : gcd k (m * n) = m' * n' := h, rw h, have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _, @@ -504,7 +526,7 @@ begin { use 1, rw pow_zero at h ⊢, use units.mk_of_mul_eq_one _ _ h, rw [units.coe_mk_of_mul_eq_one, one_mul] }, have hc : c ∣ a * b, { rw h, exact dvd_pow_self _ hk.ne' }, - obtain ⟨d₁, hd₁, d₂, hd₂, hc⟩ := exists_dvd_and_dvd_of_dvd_mul hc, + obtain ⟨d₁, d₂, hd₁, hd₂, hc⟩ := exists_dvd_and_dvd_of_dvd_mul hc, use d₁, obtain ⟨h0₁, ⟨a', ha'⟩⟩ := pow_dvd_of_mul_eq_pow ha hab h hc hd₁, rw [mul_comm] at h hc, @@ -540,6 +562,28 @@ begin exact associated_of_dvd_dvd (gcd_monoid.dvd_gcd hda hdb) h, end +lemma is_unit_gcd_of_eq_mul_gcd {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α] + {x y x' y' : α} (ex : x = gcd x y * x') (ey : y = gcd x y * y') (h : gcd x y ≠ 0) : + is_unit (gcd x' y') := +begin + rw ← associated_one_iff_is_unit, + refine associated.of_mul_left _ (associated.refl $ gcd x y) h, + convert (gcd_mul_left' _ _ _).symm using 1, + rw [← ex, ← ey, mul_one], +end + +lemma extract_gcd {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α] (x y : α) : + ∃ x' y', x = gcd x y * x' ∧ y = gcd x y * y' ∧ is_unit (gcd x' y') := +begin + by_cases h : gcd x y = 0, + { obtain ⟨rfl, rfl⟩ := (gcd_eq_zero_iff x y).1 h, + simp_rw ← associated_one_iff_is_unit, + exact ⟨1, 1, by rw [h, zero_mul], by rw [h, zero_mul], gcd_one_left' 1⟩ }, + obtain ⟨x', ex⟩ := gcd_dvd_left x y, + obtain ⟨y', ey⟩ := gcd_dvd_right x y, + exact ⟨x', y', ex, ey, is_unit_gcd_of_eq_mul_gcd ex ey h⟩, +end + end gcd section lcm @@ -727,6 +771,37 @@ instance normalization_monoid_of_unique_units : normalization_monoid α := norm_unit_mul := λ x y hx hy, (mul_one 1).symm, norm_unit_coe_units := λ u, subsingleton.elim _ _ } +instance unique_normalization_monoid_of_unique_units : unique (normalization_monoid α) := +{ default := normalization_monoid_of_unique_units, + uniq := λ ⟨u, _, _, _⟩, by simpa only [(subsingleton.elim _ _ : u = λ _, 1)] } + +instance subsingleton_gcd_monoid_of_unique_units : subsingleton (gcd_monoid α) := +⟨λ g₁ g₂, begin + have hgcd : g₁.gcd = g₂.gcd, + { ext a b, + refine associated_iff_eq.mp (associated_of_dvd_dvd _ _); + apply dvd_gcd (gcd_dvd_left _ _) (gcd_dvd_right _ _) }, + have hlcm : g₁.lcm = g₂.lcm, + { ext a b, + refine associated_iff_eq.mp (associated_of_dvd_dvd _ _); + apply lcm_dvd_iff.2 ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩ }, + cases g₁, cases g₂, + dsimp only at hgcd hlcm, + simp only [hgcd, hlcm], +end⟩ + +instance subsingleton_normalized_gcd_monoid_of_unique_units : + subsingleton (normalized_gcd_monoid α) := +⟨begin + intros a b, + cases a with a_norm a_gcd, + cases b with b_norm b_gcd, + have := subsingleton.elim a_gcd b_gcd, + subst this, + have := subsingleton.elim a_norm b_norm, + subst this +end⟩ + @[simp] lemma norm_unit_eq_one (x : α) : norm_unit x = 1 := rfl @[simp] lemma normalize_eq (x : α) : normalize x = x := mul_one x @@ -898,11 +973,11 @@ let exists_gcd := λ a b, lcm_dvd (dvd.intro b rfl) (dvd.intro_left a rfl) in classical.some (exists_gcd a b)), gcd_mul_lcm := λ a b, by { split_ifs, - { rw [h, zero_dvd_iff.1 (dvd_lcm_left _ _), mul_zero, zero_mul] }, - { rw [h_1, zero_dvd_iff.1 (dvd_lcm_right _ _), mul_zero] }, + { rw [h, eq_zero_of_zero_dvd (dvd_lcm_left _ _), mul_zero, zero_mul] }, + { rw [h_1, eq_zero_of_zero_dvd (dvd_lcm_right _ _), mul_zero] }, rw [mul_comm, ←classical.some_spec (exists_gcd a b)] }, - lcm_zero_left := λ a, zero_dvd_iff.1 (dvd_lcm_left _ _), - lcm_zero_right := λ a, zero_dvd_iff.1 (dvd_lcm_right _ _), + lcm_zero_left := λ a, eq_zero_of_zero_dvd (dvd_lcm_left _ _), + lcm_zero_right := λ a, eq_zero_of_zero_dvd (dvd_lcm_right _ _), gcd_dvd_left := λ a b, by { split_ifs with h h_1, { rw h, apply dvd_zero }, @@ -959,8 +1034,8 @@ let exists_gcd := λ a b, dvd_normalize_iff.2 (lcm_dvd (dvd.intro b rfl) (dvd.in classical.some (exists_gcd a b)), gcd_mul_lcm := λ a b, by { split_ifs with h h_1, - { rw [h, zero_dvd_iff.1 (dvd_lcm_left _ _), mul_zero, zero_mul] }, - { rw [h_1, zero_dvd_iff.1 (dvd_lcm_right _ _), mul_zero, mul_zero] }, + { rw [h, eq_zero_of_zero_dvd (dvd_lcm_left _ _), mul_zero, zero_mul] }, + { rw [h_1, eq_zero_of_zero_dvd (dvd_lcm_right _ _), mul_zero, mul_zero] }, rw [mul_comm, ←classical.some_spec (exists_gcd a b)], exact normalize_associated (a * b) }, normalize_lcm := normalize_lcm, @@ -978,8 +1053,8 @@ let exists_gcd := λ a b, dvd_normalize_iff.2 (lcm_dvd (dvd.intro b rfl) (dvd.in refine trans _ (classical.some_spec (exists_gcd a b)), conv_lhs { congr, rw [← normalize_lcm a b] }, erw [← normalize.map_mul, ← classical.some_spec (exists_gcd a b), normalize_idem] }, - lcm_zero_left := λ a, zero_dvd_iff.1 (dvd_lcm_left _ _), - lcm_zero_right := λ a, zero_dvd_iff.1 (dvd_lcm_right _ _), + lcm_zero_left := λ a, eq_zero_of_zero_dvd (dvd_lcm_left _ _), + lcm_zero_right := λ a, eq_zero_of_zero_dvd (dvd_lcm_right _ _), gcd_dvd_left := λ a b, by { split_ifs, { rw h, apply dvd_zero }, diff --git a/src/algebra/gcd_monoid/div.lean b/src/algebra/gcd_monoid/div.lean new file mode 100644 index 0000000000000..bddd821ee1563 --- /dev/null +++ b/src/algebra/gcd_monoid/div.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2022 Riccardo Brasca. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Riccardo Brasca +-/ +import algebra.gcd_monoid.finset +import algebra.gcd_monoid.basic +import ring_theory.int.basic +import ring_theory.polynomial.content + +/-! +# Basic results about setwise gcds on normalized gcd monoid with a division. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main results + +* `finset.nat.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from `s` to + `ℕ`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`. +* `finset.int.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from `s` to + `ℤ`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`. +* `finset.polynomial.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from + `s` to `K[X]`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`. + +## TODO +Add a typeclass to state these results uniformly. + +-/ + +namespace finset + +namespace nat + +/-- Given a nonempty finset `s` and a function `f` from `s` to `ℕ`, if `d = s.gcd`, +then the `gcd` of `(f i) / d` is equal to `1`. -/ +theorem gcd_div_eq_one {β : Type*} {f : β → ℕ} (s : finset β) {x : β} (hx : x ∈ s) + (hfz : f x ≠ 0) : s.gcd (λ b, f b / s.gcd f) = 1 := +begin + obtain ⟨g, he, hg⟩ := finset.extract_gcd f ⟨x, hx⟩, + refine (finset.gcd_congr rfl $ λ a ha, _).trans hg, + rw [he a ha, nat.mul_div_cancel_left], + exact nat.pos_of_ne_zero (mt finset.gcd_eq_zero_iff.1 (λ h, hfz $ h x hx)), +end + +theorem gcd_div_id_eq_one {s : finset ℕ} {x : ℕ} (hx : x ∈ s) (hnz : x ≠ 0) : + s.gcd (λ b, b / s.gcd id) = 1 := +gcd_div_eq_one s hx hnz + +end nat + +namespace int + +/-- Given a nonempty finset `s` and a function `f` from `s` to `ℤ`, if `d = s.gcd`, +then the `gcd` of `(f i) / d` is equal to `1`. -/ +theorem gcd_div_eq_one {β : Type*} {f : β → ℤ} (s : finset β) {x : β} (hx : x ∈ s) + (hfz : f x ≠ 0) : s.gcd (λ b, f b / s.gcd f) = 1 := +begin + obtain ⟨g, he, hg⟩ := finset.extract_gcd f ⟨x, hx⟩, + refine (finset.gcd_congr rfl $ λ a ha, _).trans hg, + rw [he a ha, int.mul_div_cancel_left], + exact mt finset.gcd_eq_zero_iff.1 (λ h, hfz $ h x hx), +end + +theorem gcd_div_id_eq_one {s : finset ℤ} {x : ℤ} (hx : x ∈ s) (hnz : x ≠ 0) : + s.gcd (λ b, b / s.gcd id) = 1 := +gcd_div_eq_one s hx hnz + +end int + +namespace polynomial + +open_locale polynomial classical + +noncomputable theory + +variables {K : Type*} [field K] + +/-- Given a nonempty finset `s` and a function `f` from `s` to `K[X]`, if `d = s.gcd f`, +then the `gcd` of `(f i) / d` is equal to `1`. -/ +theorem gcd_div_eq_one {β : Type*} {f : β → K[X]} (s : finset β) {x : β} (hx : x ∈ s) + (hfz : f x ≠ 0) : s.gcd (λ b, f b / s.gcd f) = 1 := +begin + obtain ⟨g, he, hg⟩ := finset.extract_gcd f ⟨x, hx⟩, + refine (finset.gcd_congr rfl $ λ a ha, _).trans hg, + rw [he a ha, euclidean_domain.mul_div_cancel_left], + exact mt finset.gcd_eq_zero_iff.1 (λ h, hfz $ h x hx), +end + +theorem gcd_div_id_eq_one {s : finset K[X]} {x : K[X]} (hx : x ∈ s) (hnz : x ≠ 0) : + s.gcd (λ b, b / s.gcd id) = 1 := +gcd_div_eq_one s hx hnz + +end polynomial + +end finset diff --git a/src/algebra/gcd_monoid/finset.lean b/src/algebra/gcd_monoid/finset.lean index 496290e35e67b..b0857a36fe7ed 100644 --- a/src/algebra/gcd_monoid/finset.lean +++ b/src/algebra/gcd_monoid/finset.lean @@ -9,6 +9,9 @@ import algebra.gcd_monoid.multiset /-! # GCD and LCM operations on finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions - `finset.gcd` - the greatest common denominator of a `finset` of elements of a `gcd_monoid` @@ -87,6 +90,11 @@ lcm_dvd (λ b hb, (h b hb).trans (dvd_lcm hb)) lemma lcm_mono (h : s₁ ⊆ s₂) : s₁.lcm f ∣ s₂.lcm f := lcm_dvd $ assume b hb, dvd_lcm (h hb) +lemma lcm_image [decidable_eq β] {g : γ → β} (s : finset γ) : (s.image g).lcm f = s.lcm (f ∘ g) := +by { classical, induction s using finset.induction with c s hc ih; simp [*] } + +lemma lcm_eq_lcm_image [decidable_eq α] : s.lcm f = (s.image f).lcm id := eq.symm $ lcm_image _ + theorem lcm_eq_zero_iff [nontrivial α] : s.lcm f = 0 ↔ 0 ∈ f '' s := by simp only [multiset.mem_map, lcm_def, multiset.lcm_eq_zero_iff, set.mem_image, mem_coe, ← finset.mem_def] @@ -147,11 +155,10 @@ dvd_gcd (λ b hb, (gcd_dvd hb).trans (h b hb)) lemma gcd_mono (h : s₁ ⊆ s₂) : s₂.gcd f ∣ s₁.gcd f := dvd_gcd $ assume b hb, gcd_dvd (h hb) -theorem gcd_image {g : γ → β} (s: finset γ) [decidable_eq β] [is_idempotent α gcd_monoid.gcd] : - (s.image g).gcd f = s.gcd (f ∘ g) := by simp [gcd, fold_image_idem] +lemma gcd_image [decidable_eq β] {g : γ → β} (s : finset γ) : (s.image g).gcd f = s.gcd (f ∘ g) := +by { classical, induction s using finset.induction with c s hc ih; simp [*] } -theorem gcd_eq_gcd_image [decidable_eq α] [is_idempotent α gcd_monoid.gcd] : - s.gcd f = (s.image f).gcd id := (@gcd_image _ _ _ _ _ id _ _ _ _).symm +lemma gcd_eq_gcd_image [decidable_eq α] : s.gcd f = (s.image f).gcd id := eq.symm $ gcd_image _ theorem gcd_eq_zero_iff : s.gcd f = 0 ↔ ∀ (x : β), x ∈ s → f x = 0 := begin @@ -204,6 +211,25 @@ begin apply ((normalize_associated a).mul_left _).gcd_eq_right end +lemma extract_gcd' (f g : β → α) (hs : ∃ x, x ∈ s ∧ f x ≠ 0) + (hg : ∀ b ∈ s, f b = s.gcd f * g b) : s.gcd g = 1 := +((@mul_right_eq_self₀ _ _ (s.gcd f) _).1 $ + by conv_lhs { rw [← normalize_gcd, ← gcd_mul_left, ← gcd_congr rfl hg] }).resolve_right $ + by {contrapose! hs, exact gcd_eq_zero_iff.1 hs} + +lemma extract_gcd (f : β → α) (hs : s.nonempty) : + ∃ g : β → α, (∀ b ∈ s, f b = s.gcd f * g b) ∧ s.gcd g = 1 := +begin + classical, + by_cases h : ∀ x ∈ s, f x = (0 : α), + { refine ⟨λ b, 1, λ b hb, by rw [h b hb, gcd_eq_zero_iff.2 h, mul_one], _⟩, + rw [gcd_eq_gcd_image, image_const hs, gcd_singleton, id, normalize_one] }, + { choose g' hg using @gcd_dvd _ _ _ _ s f, + have := λ b hb, _, push_neg at h, + refine ⟨λ b, if hb : b ∈ s then g' hb else 0, this, extract_gcd' f _ h this⟩, + rw [dif_pos hb, hg hb] }, +end + end gcd end finset diff --git a/src/algebra/gcd_monoid/integrally_closed.lean b/src/algebra/gcd_monoid/integrally_closed.lean new file mode 100644 index 0000000000000..ac3990150f937 --- /dev/null +++ b/src/algebra/gcd_monoid/integrally_closed.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebra.gcd_monoid.basic +import ring_theory.integrally_closed +import ring_theory.polynomial.eisenstein.basic + +/-! + +# GCD domains are integrally closed + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +open_locale big_operators polynomial + +variables {R A : Type*} [comm_ring R] [is_domain R] [gcd_monoid R] [comm_ring A] [algebra R A] + +lemma is_localization.surj_of_gcd_domain (M : submonoid R) [is_localization M A] (z : A) : + ∃ a b : R, is_unit (gcd a b) ∧ z * algebra_map R A b = algebra_map R A a := +begin + obtain ⟨x, ⟨y, hy⟩, rfl⟩ := is_localization.mk'_surjective M z, + obtain ⟨x', y', hx', hy', hu⟩ := extract_gcd x y, + use [x', y', hu], + rw [mul_comm, is_localization.mul_mk'_eq_mk'_of_mul], + convert is_localization.mk'_mul_cancel_left _ _ using 2, + { rw [subtype.coe_mk, hy', ← mul_comm y', mul_assoc], conv_lhs { rw hx' } }, + { apply_instance }, +end + +@[priority 100] +instance gcd_monoid.to_is_integrally_closed : is_integrally_closed R := +⟨λ X ⟨p, hp₁, hp₂⟩, begin + obtain ⟨x, y, hg, he⟩ := is_localization.surj_of_gcd_domain (non_zero_divisors R) X, + have := polynomial.dvd_pow_nat_degree_of_eval₂_eq_zero + (is_fraction_ring.injective R $ fraction_ring R) hp₁ y x _ hp₂ (by rw [mul_comm, he]), + have : is_unit y, + { rw [is_unit_iff_dvd_one, ← one_pow], + exact (dvd_gcd this $ dvd_refl y).trans (gcd_pow_left_dvd_pow_gcd.trans $ + pow_dvd_pow_of_dvd (is_unit_iff_dvd_one.1 hg) _) }, + use x * (this.unit⁻¹ : _), + erw [map_mul, ← units.coe_map_inv, eq_comm, units.eq_mul_inv_iff_mul_eq], + exact he, +end⟩ diff --git a/src/algebra/gcd_monoid/multiset.lean b/src/algebra/gcd_monoid/multiset.lean index a97dc728e058e..bfe56ae028968 100644 --- a/src/algebra/gcd_monoid/multiset.lean +++ b/src/algebra/gcd_monoid/multiset.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Aaron Anderson -/ import algebra.gcd_monoid.basic -import data.multiset.lattice +import data.multiset.finset_ops +import data.multiset.fold /-! # GCD and LCM operations on multisets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions - `multiset.gcd` - the greatest common denominator of a `multiset` of elements of a `gcd_monoid` @@ -134,6 +138,17 @@ begin simp [h a (mem_cons_self a s), sgcd (λ x hx, h x (mem_cons_of_mem hx))] } end +lemma gcd_map_mul (a : α) (s : multiset α) : + (s.map ((*) a)).gcd = normalize a * s.gcd := +begin + refine s.induction_on _ (λ b s ih, _), + { simp_rw [map_zero, gcd_zero, mul_zero] }, + { simp_rw [map_cons, gcd_cons, ← gcd_mul_left], rw ih, + apply ((normalize_associated a).mul_right _).gcd_eq_right }, +end + +section + variables [decidable_eq α] @[simp] lemma gcd_dedup (s : multiset α) : (dedup s).gcd = s.gcd := @@ -156,6 +171,29 @@ by { rw [← gcd_dedup, dedup_ext.2, gcd_dedup, gcd_add], simp } (ndinsert a s).gcd = gcd_monoid.gcd a s.gcd := by { rw [← gcd_dedup, dedup_ext.2, gcd_dedup, gcd_cons], simp } +end + +lemma extract_gcd' (s t : multiset α) (hs : ∃ x, x ∈ s ∧ x ≠ (0 : α)) + (ht : s = t.map ((*) s.gcd)) : t.gcd = 1 := +((@mul_right_eq_self₀ _ _ s.gcd _).1 $ by conv_lhs { rw [← normalize_gcd, ← gcd_map_mul, ← ht] }) + .resolve_right $ by { contrapose! hs, exact s.gcd_eq_zero_iff.1 hs } + +lemma extract_gcd (s : multiset α) (hs : s ≠ 0) : + ∃ t : multiset α, s = t.map ((*) s.gcd) ∧ t.gcd = 1 := +begin + classical, + by_cases h : ∀ x ∈ s, x = (0 : α), + { use replicate s.card 1, + rw [map_replicate, eq_replicate, mul_one, s.gcd_eq_zero_iff.2 h, ←nsmul_singleton, ←gcd_dedup], + rw [dedup_nsmul (card_pos.2 hs).ne', dedup_singleton, gcd_singleton], + exact ⟨⟨rfl, h⟩, normalize_one⟩ }, + { choose f hf using @gcd_dvd _ _ _ s, + have := _, push_neg at h, + refine ⟨s.pmap @f (λ _, id), this, extract_gcd' s _ h this⟩, + rw map_pmap, conv_lhs { rw [← s.map_id, ← s.pmap_eq_map _ _ (λ _, id)] }, + congr' with x hx, rw [id, ← hf hx] }, +end + end gcd end multiset diff --git a/src/algebra/gcd_monoid/nat.lean b/src/algebra/gcd_monoid/nat.lean deleted file mode 100644 index 7517a52cfa614..0000000000000 --- a/src/algebra/gcd_monoid/nat.lean +++ /dev/null @@ -1,45 +0,0 @@ -/- -Copyright (c) 2021 Eric Rodriguez. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Eric Rodriguez --/ -import algebra.gcd_monoid.finset -import number_theory.padics.padic_val - -/-! -# Basic results about setwise gcds on ℕ - -This file proves some basic results about `finset.gcd` on `ℕ`. - -## Main results -* `finset.coprime_of_div_gcd`: The elements of a set divided through by their gcd are coprime. - --/ - -instance : is_idempotent ℕ gcd_monoid.gcd := ⟨nat.gcd_self⟩ - -namespace finset - -theorem coprime_of_div_gcd (s : finset ℕ) {x : ℕ} (hx : x ∈ s) (hnz : x ≠ 0) : - s.gcd (/ (s.gcd id)) = 1 := -begin - rw nat.eq_one_iff_not_exists_prime_dvd, - intros p hp hdvd, - haveI : fact p.prime := ⟨hp⟩, - rw dvd_gcd_iff at hdvd, - replace hdvd : ∀ b ∈ s, s.gcd id * p ∣ b, - { intros b hb, - specialize hdvd b hb, - rwa nat.dvd_div_iff at hdvd, - apply gcd_dvd hb }, - have : s.gcd id ≠ 0 := (not_iff_not.mpr gcd_eq_zero_iff).mpr (λ h, hnz $ h x hx), - apply @pow_succ_padic_val_nat_not_dvd p _ _ this.bot_lt, - apply dvd_gcd, - intros b hb, - obtain ⟨k, rfl⟩ := hdvd b hb, - rw [id, mul_right_comm, pow_succ', mul_dvd_mul_iff_right hp.ne_zero], - apply dvd_mul_of_dvd_left, - exact pow_padic_val_nat_dvd -end - -end finset diff --git a/src/algebra/geom_sum.lean b/src/algebra/geom_sum.lean index 97beb92eecca8..69444d3774a38 100644 --- a/src/algebra/geom_sum.lean +++ b/src/algebra/geom_sum.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Neil Strickland -/ -import algebra.group_with_zero.power import algebra.big_operators.order import algebra.big_operators.ring import algebra.big_operators.intervals @@ -14,17 +13,13 @@ import data.nat.parity /-! # Partial sums of geometric series +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file determines the values of the geometric series $\sum_{i=0}^{n-1} x^i$ and $\sum_{i=0}^{n-1} x^i y^{n-1-i}$ and variants thereof. We also provide some bounds on the "geometric" sum of `a/b^i` where `a b : ℕ`. -## Main definitions - -* `geom_sum` defines for each $x$ in a semiring and each natural number $n$ the partial sum - $\sum_{i=0}^{n-1} x^i$ of the geometric series. -* `geom_sum₂` defines for each $x,y$ in a semiring and each natural number $n$ the partial sum - $\sum_{i=0}^{n-1} x^i y^{n-1-i}$ of the geometric series. - ## Main statements * `geom_sum_Ico` proves that $\sum_{i=m}^{n-1} x^i=\frac{x^n-x^m}{x-1}$ in a division ring. @@ -45,60 +40,41 @@ open_locale big_operators section semiring variable [semiring α] -/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i$. -/ -def geom_sum (x : α) (n : ℕ) := -∑ i in range n, x ^ i +lemma geom_sum_succ {x : α} {n : ℕ} : + ∑ i in range (n + 1), x ^ i = x * ∑ i in range n, x ^ i + 1 := +by simp only [mul_sum, ←pow_succ, sum_range_succ', pow_zero] -theorem geom_sum_def (x : α) (n : ℕ) : - geom_sum x n = ∑ i in range n, x ^ i := rfl - -lemma geom_sum_succ {x : α} {n : ℕ} : geom_sum x (n + 1) = x * geom_sum x n + 1 := -by simp only [geom_sum_def, mul_sum, ←pow_succ, sum_range_succ', pow_zero] - -lemma geom_sum_succ' {x : α} {n : ℕ} : geom_sum x (n + 1) = x ^ n + geom_sum x n := +lemma geom_sum_succ' {x : α} {n : ℕ} : + ∑ i in range (n + 1), x ^ i = x ^ n + ∑ i in range n, x ^ i := (sum_range_succ _ _).trans (add_comm _ _) -@[simp] theorem geom_sum_zero (x : α) : - geom_sum x 0 = 0 := rfl +theorem geom_sum_zero (x : α) : + ∑ i in range 0, x ^ i = 0 := rfl -@[simp] theorem geom_sum_one (x : α) : - geom_sum x 1 = 1 := +theorem geom_sum_one (x : α) : + ∑ i in range 1, x ^ i = 1 := by simp [geom_sum_succ'] -@[simp] lemma geom_sum_two {x : α} : geom_sum x 2 = x + 1 := +@[simp] lemma geom_sum_two {x : α} : ∑ i in range 2, x ^ i = x + 1 := by simp [geom_sum_succ'] -@[simp] lemma zero_geom_sum : ∀ {n}, geom_sum (0 : α) n = if n = 0 then 0 else 1 +@[simp] lemma zero_geom_sum : ∀ {n}, ∑ i in range n, (0 : α) ^ i = if n = 0 then 0 else 1 | 0 := by simp | 1 := by simp | (n+2) := by { rw geom_sum_succ', simp [zero_geom_sum] } -@[simp] lemma one_geom_sum (n : ℕ) : geom_sum (1 : α) n = n := -by simp [geom_sum_def] +lemma one_geom_sum (n : ℕ) : ∑ i in range n, (1 : α) ^ i = n := +by simp @[simp] lemma op_geom_sum (x : α) (n : ℕ) : - op (geom_sum x n) = geom_sum (op x) n := -by simp [geom_sum_def] - -/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i y^{n-1-i}$. -/ -def geom_sum₂ (x y : α) (n : ℕ) := -∑ i in range n, x ^ i * (y ^ (n - 1 - i)) - -theorem geom_sum₂_def (x y : α) (n : ℕ) : - geom_sum₂ x y n = ∑ i in range n, x ^ i * y ^ (n - 1 - i) := rfl - -@[simp] theorem geom_sum₂_zero (x y : α) : - geom_sum₂ x y 0 = 0 := rfl - -@[simp] theorem geom_sum₂_one (x y : α) : - geom_sum₂ x y 1 = 1 := -by { have : 1 - 1 - 0 = 0 := rfl, - rw [geom_sum₂_def, sum_range_one, this, pow_zero, pow_zero, mul_one] } + op (∑ i in range n, x ^ i) = ∑ i in range n, (op x) ^ i := +by simp @[simp] lemma op_geom_sum₂ (x y : α) (n : ℕ) : - op (geom_sum₂ x y n) = geom_sum₂ (op y) (op x) n := + op (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = + ∑ i in range n, (op y) ^ i * ((op x) ^ (n - 1 - i)) := begin - simp only [geom_sum₂_def, op_sum, op_mul, op_pow], + simp only [op_sum, op_mul, op_pow], rw ← sum_range_reflect, refine sum_congr rfl (λ j j_in, _), rw [mem_range, nat.lt_iff_add_one_le] at j_in, @@ -107,13 +83,13 @@ begin exact le_tsub_of_add_le_right j_in end -@[simp] theorem geom_sum₂_with_one (x : α) (n : ℕ) : - geom_sum₂ x 1 n = geom_sum x n := +theorem geom_sum₂_with_one (x : α) (n : ℕ) : + ∑ i in range n, x ^ i * (1 ^ (n - 1 - i)) = ∑ i in range n, x ^ i := sum_congr rfl (λ i _, by { rw [one_pow, mul_one] }) /-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/ protected theorem commute.geom_sum₂_mul_add {x y : α} (h : commute x y) (n : ℕ) : - (geom_sum₂ (x + y) y n) * x + y ^ n = (x + y) ^ n := + (∑ i in range n, (x + y) ^ i * (y ^ (n - 1 - i))) * x + y ^ n = (x + y) ^ n := begin let f := λ (m i : ℕ), (x + y) ^ i * y ^ (m - 1 - i), change (∑ i in range n, (f n) i) * x + y ^ n = (x + y) ^ n, @@ -142,18 +118,19 @@ end end semiring -@[simp] lemma neg_one_geom_sum [ring α] {n : ℕ} : geom_sum (-1 : α) n = if even n then 0 else 1 := +@[simp] lemma neg_one_geom_sum [ring α] {n : ℕ} : + ∑ i in range n, (-1 : α) ^ i = if even n then 0 else 1 := begin induction n with k hk, { simp }, - { simp only [geom_sum_succ', nat.even_succ, hk], + { simp only [geom_sum_succ', nat.even_add_one, hk], split_ifs, { rw [h.neg_one_pow, add_zero] }, { rw [(nat.odd_iff_not_even.2 h).neg_one_pow, neg_add_self] } } end theorem geom_sum₂_self {α : Type*} [comm_ring α] (x : α) (n : ℕ) : - geom_sum₂ x x n = n * x ^ (n-1) := + ∑ i in range n, x ^ i * (x ^ (n - 1 - i)) = n * x ^ (n-1) := calc ∑ i in finset.range n, x ^ i * x ^ (n - 1 - i) = ∑ i in finset.range n, x ^ (i + (n - 1 - i)) : by simp_rw [← pow_add] ... = ∑ i in finset.range n, x ^ (n - 1) : finset.sum_congr rfl @@ -163,11 +140,11 @@ calc ∑ i in finset.range n, x ^ i * x ^ (n - 1 - i) /-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/ theorem geom_sum₂_mul_add [comm_semiring α] (x y : α) (n : ℕ) : - (geom_sum₂ (x + y) y n) * x + y ^ n = (x + y) ^ n := + (∑ i in range n, (x + y) ^ i * (y ^ (n - 1 - i))) * x + y ^ n = (x + y) ^ n := (commute.all x y).geom_sum₂_mul_add n theorem geom_sum_mul_add [semiring α] (x : α) (n : ℕ) : - (geom_sum (x + 1) n) * x + 1 = (x + 1) ^ n := + (∑ i in range n, (x + 1) ^ i) * x + 1 = (x + 1) ^ n := begin have := (commute.one_right x).geom_sum₂_mul_add n, rw [one_pow, geom_sum₂_with_one] at this, @@ -175,7 +152,7 @@ begin end protected theorem commute.geom_sum₂_mul [ring α] {x y : α} (h : commute x y) (n : ℕ) : - (geom_sum₂ x y n) * (x - y) = x ^ n - y ^ n := + (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) * (x - y) = x ^ n - y ^ n := begin have := (h.sub_left (commute.refl y)).geom_sum₂_mul_add n, rw [sub_add_cancel] at this, @@ -183,7 +160,7 @@ begin end lemma commute.mul_neg_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) : - (y - x) * (geom_sum₂ x y n) = y ^ n - x ^ n := + (y - x) * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = y ^ n - x ^ n := begin apply op_injective, simp only [op_mul, op_sub, op_geom_sum₂, op_pow], @@ -191,15 +168,38 @@ begin end lemma commute.mul_geom_sum₂ [ring α] {x y : α} (h : commute x y) (n : ℕ) : - (x - y) * (geom_sum₂ x y n) = x ^ n - y ^ n := + (x - y) * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = x ^ n - y ^ n := by rw [← neg_sub (y ^ n), ← h.mul_neg_geom_sum₂, ← neg_mul, neg_sub] theorem geom_sum₂_mul [comm_ring α] (x y : α) (n : ℕ) : - (geom_sum₂ x y n) * (x - y) = x ^ n - y ^ n := + (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) * (x - y) = x ^ n - y ^ n := (commute.all x y).geom_sum₂_mul n +theorem sub_dvd_pow_sub_pow [comm_ring α] (x y : α) (n : ℕ) : x - y ∣ x ^ n - y ^ n := + dvd.intro_left _ (geom_sum₂_mul x y n) + +theorem nat_sub_dvd_pow_sub_pow (x y n : ℕ) : x - y ∣ x ^ n - y ^ n := +begin + cases le_or_lt y x with h, + { have : y ^ n ≤ x ^ n := nat.pow_le_pow_of_le_left h _, + exact_mod_cast sub_dvd_pow_sub_pow (x : ℤ) ↑y n }, + { have : x ^ n ≤ y ^ n := nat.pow_le_pow_of_le_left h.le _, + exact (nat.sub_eq_zero_of_le this).symm ▸ dvd_zero (x - y) } +end + +theorem odd.add_dvd_pow_add_pow [comm_ring α] (x y : α) {n : ℕ} (h : odd n) : + x + y ∣ x ^ n + y ^ n := +begin + have h₁ := geom_sum₂_mul x (-y) n, + rw [odd.neg_pow h y, sub_neg_eq_add, sub_neg_eq_add] at h₁, + exact dvd.intro_left _ h₁, +end + +theorem odd.nat_add_dvd_pow_add_pow (x y : ℕ) {n : ℕ} (h : odd n) : x + y ∣ x ^ n + y ^ n := +by exact_mod_cast odd.add_dvd_pow_add_pow (x : ℤ) ↑y h + theorem geom_sum_mul [ring α] (x : α) (n : ℕ) : - (geom_sum x n) * (x - 1) = x ^ n - 1 := + (∑ i in range n, x ^ i) * (x - 1) = x ^ n - 1 := begin have := (commute.one_right x).geom_sum₂_mul n, rw [one_pow, geom_sum₂_with_one] at this, @@ -207,11 +207,11 @@ begin end lemma mul_geom_sum [ring α] (x : α) (n : ℕ) : - (x - 1) * (geom_sum x n) = x ^ n - 1 := + (x - 1) * (∑ i in range n, x ^ i) = x ^ n - 1 := op_injective $ by simpa using geom_sum_mul (op x) n theorem geom_sum_mul_neg [ring α] (x : α) (n : ℕ) : - (geom_sum x n) * (1 - x) = 1 - x ^ n := + (∑ i in range n, x ^ i) * (1 - x) = 1 - x ^ n := begin have := congr_arg has_neg.neg (geom_sum_mul x n), rw [neg_sub, ← mul_neg, neg_sub] at this, @@ -219,20 +219,35 @@ begin end lemma mul_neg_geom_sum [ring α] (x : α) (n : ℕ) : - (1 - x) * (geom_sum x n) = 1 - x ^ n := + (1 - x) * (∑ i in range n, x ^ i) = 1 - x ^ n := op_injective $ by simpa using geom_sum_mul_neg (op x) n +protected lemma commute.geom_sum₂_comm {α : Type u} [semiring α] {x y : α} (n : ℕ) + (h : commute x y) : + ∑ i in range n, x ^ i * y ^ (n - 1 - i) = ∑ i in range n, y ^ i * x ^ (n - 1 - i) := +begin + cases n, { simp }, + simp only [nat.succ_eq_add_one, nat.add_sub_cancel], + rw ← finset.sum_flip, + refine finset.sum_congr rfl (λ i hi, _), + simpa [nat.sub_sub_self (nat.succ_le_succ_iff.mp (finset.mem_range.mp hi))] using h.pow_pow _ _ +end + +lemma geom_sum₂_comm {α : Type u} [comm_semiring α] (x y : α) (n : ℕ) : + ∑ i in range n, x ^ i * y ^ (n - 1 - i) = ∑ i in range n, y ^ i * x ^ (n - 1 - i) := +(commute.all x y).geom_sum₂_comm n + protected theorem commute.geom_sum₂ [division_ring α] {x y : α} (h' : commute x y) (h : x ≠ y) - (n : ℕ) : (geom_sum₂ x y n) = (x ^ n - y ^ n) / (x - y) := + (n : ℕ) : (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = (x ^ n - y ^ n) / (x - y) := have x - y ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *, by rw [← h'.geom_sum₂_mul, mul_div_cancel _ this] theorem geom₂_sum [field α] {x y : α} (h : x ≠ y) (n : ℕ) : - (geom_sum₂ x y n) = (x ^ n - y ^ n) / (x - y) := + (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = (x ^ n - y ^ n) / (x - y) := (commute.all x y).geom_sum₂ h n theorem geom_sum_eq [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) : - (geom_sum x n) = (x ^ n - 1) / (x - 1) := + (∑ i in range n, x ^ i) = (x ^ n - 1) / (x - 1) := have x - 1 ≠ 0, by simp [*, -sub_eq_add_neg, sub_eq_iff_eq_add] at *, by rw [← geom_sum_mul, mul_div_cancel _ this] @@ -240,7 +255,7 @@ protected theorem commute.mul_geom_sum₂_Ico [ring α] {x y : α} (h : commute (hmn : m ≤ n) : (x - y) * (∑ i in finset.Ico m n, x ^ i * y ^ (n - 1 - i)) = x ^ n - x ^ m * y ^ (n - m) := begin - rw [sum_Ico_eq_sub _ hmn, ← geom_sum₂_def], + rw [sum_Ico_eq_sub _ hmn], have : ∑ k in range m, x ^ k * y ^ (n - 1 - k) = ∑ k in range m, x ^ k * (y ^ (n - m) * y ^ (m - 1 - k)), { refine sum_congr rfl (λ j j_in, _), @@ -252,17 +267,18 @@ begin rw this, simp_rw pow_mul_comm y (n-m) _, simp_rw ← mul_assoc, - rw [← sum_mul, ← geom_sum₂_def, mul_sub, h.mul_geom_sum₂, ← mul_assoc, + rw [← sum_mul, mul_sub, h.mul_geom_sum₂, ← mul_assoc, h.mul_geom_sum₂, sub_mul, ← pow_add, add_tsub_cancel_of_le hmn, sub_sub_sub_cancel_right (x ^ n) (x ^ m * y ^ (n - m)) (y ^ n)], end protected theorem commute.geom_sum₂_succ_eq {α : Type u} [ring α] {x y : α} (h : commute x y) {n : ℕ} : - geom_sum₂ x y (n + 1) = x ^ n + y * (geom_sum₂ x y n) := + ∑ i in range (n + 1), x ^ i * (y ^ (n - i)) = + x ^ n + y * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) := begin - simp_rw [geom_sum₂, mul_sum, sum_range_succ_comm, nat.add_succ_sub_one, add_zero, tsub_self, - pow_zero, mul_one, add_right_inj, ←mul_assoc, (h.symm.pow_right _).eq, mul_assoc, ←pow_succ], + simp_rw [mul_sum, sum_range_succ_comm, tsub_self, pow_zero, mul_one, add_right_inj, ←mul_assoc, + (h.symm.pow_right _).eq, mul_assoc, ←pow_succ], refine sum_congr rfl (λ i hi, _), suffices : n - 1 - i + 1 = n - i, { rw this }, cases n, @@ -272,7 +288,8 @@ begin end theorem geom_sum₂_succ_eq {α : Type u} [comm_ring α] (x y : α) {n : ℕ} : - geom_sum₂ x y (n + 1) = x ^ n + y * (geom_sum₂ x y n) := + ∑ i in range (n + 1), x ^ i * (y ^ (n - i)) = + x ^ n + y * (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) := (commute.all x y).geom_sum₂_succ_eq theorem mul_geom_sum₂_Ico [comm_ring α] (x y : α) {m n : ℕ} (hmn : m ≤ n) : @@ -295,12 +312,12 @@ end theorem geom_sum_Ico_mul [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) : (∑ i in finset.Ico m n, x ^ i) * (x - 1) = x^n - x^m := -by rw [sum_Ico_eq_sub _ hmn, ← geom_sum_def, ← geom_sum_def, sub_mul, +by rw [sum_Ico_eq_sub _ hmn, sub_mul, geom_sum_mul, geom_sum_mul, sub_sub_sub_cancel_right] theorem geom_sum_Ico_mul_neg [ring α] (x : α) {m n : ℕ} (hmn : m ≤ n) : (∑ i in finset.Ico m n, x ^ i) * (1 - x) = x^m - x^n := -by rw [sum_Ico_eq_sub _ hmn, ← geom_sum_def, ← geom_sum_def, sub_mul, +by rw [sum_Ico_eq_sub _ hmn, sub_mul, geom_sum_mul_neg, geom_sum_mul_neg, sub_sub_sub_cancel_left] protected theorem commute.geom_sum₂_Ico [division_ring α] {x y : α} (h : commute x y) (hxy : x ≠ y) @@ -315,7 +332,7 @@ theorem geom_sum₂_Ico [field α] {x y : α} (hxy : x ≠ y) {m n : ℕ} (hmn : theorem geom_sum_Ico [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) : ∑ i in finset.Ico m n, x ^ i = (x ^ n - x ^ m) / (x - 1) := -by simp only [sum_Ico_eq_sub _ hmn, (geom_sum_def _ _).symm, geom_sum_eq hx, div_sub_div_same, +by simp only [sum_Ico_eq_sub _ hmn, geom_sum_eq hx, div_sub_div_same, sub_sub_sub_cancel_right] theorem geom_sum_Ico' [division_ring α] {x : α} (hx : x ≠ 1) {m n : ℕ} (hmn : m ≤ n) : @@ -337,13 +354,13 @@ begin end lemma geom_sum_inv [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) : - (geom_sum x⁻¹ n) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) := + (∑ i in range n, x⁻¹ ^ i) = (x - 1)⁻¹ * (x - x⁻¹ ^ n * x) := have h₁ : x⁻¹ ≠ 1, by rwa [inv_eq_one_div, ne.def, div_eq_iff_mul_eq hx0, one_mul], have h₂ : x⁻¹ - 1 ≠ 0, from mt sub_eq_zero.1 h₁, have h₃ : x - 1 ≠ 0, from mt sub_eq_zero.1 hx1, have h₄ : x * (x ^ n)⁻¹ = (x ^ n)⁻¹ * x := nat.rec_on n (by simp) - (λ n h, by rw [pow_succ, mul_inv_rev₀, ←mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc, + (λ n h, by rw [pow_succ, mul_inv_rev, ←mul_assoc, h, mul_assoc, mul_inv_cancel hx0, mul_assoc, inv_mul_cancel hx0]), begin rw [geom_sum_eq h₁, div_eq_iff_mul_eq h₂, ← mul_right_inj' h₃, @@ -355,12 +372,13 @@ end variables {β : Type*} theorem ring_hom.map_geom_sum [semiring α] [semiring β] (x : α) (n : ℕ) (f : α →+* β) : - f (geom_sum x n) = geom_sum (f x) n := -by simp [geom_sum_def, f.map_sum] + f (∑ i in range n, x ^ i) = ∑ i in range n, (f x) ^ i := +by simp [f.map_sum] theorem ring_hom.map_geom_sum₂ [semiring α] [semiring β] (x y : α) (n : ℕ) (f : α →+* β) : - f (geom_sum₂ x y n) = geom_sum₂ (f x) (f y) n := -by simp [geom_sum₂_def, f.map_sum] + f (∑ i in range n, x ^ i * (y ^ (n - 1 - i))) = + ∑ i in range n, (f x) ^ i * ((f y) ^ (n - 1 - i)) := +by simp [f.map_sum] /-! ### Geometric sum with `ℕ`-division -/ @@ -383,7 +401,7 @@ calc lemma nat.geom_sum_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) : ∑ i in range n, a/b^i ≤ a * b/(b - 1) := begin - refine (nat.le_div_iff_mul_le _ _ $ tsub_pos_of_lt hb).2 _, + refine (nat.le_div_iff_mul_le $ tsub_pos_of_lt hb).2 _, cases n, { rw [sum_range_zero, zero_mul], exact nat.zero_le _ }, @@ -395,7 +413,7 @@ lemma nat.geom_sum_Ico_le {b : ℕ} (hb : 2 ≤ b) (a n : ℕ) : ∑ i in Ico 1 n, a/b^i ≤ a/(b - 1) := begin cases n, - { rw [Ico_eq_empty_of_le zero_le_one, sum_empty], + { rw [Ico_eq_empty_of_le (zero_le_one' ℕ), sum_empty], exact nat.zero_le _ }, rw ←add_le_add_iff_left a, calc @@ -416,17 +434,12 @@ section order variables {n : ℕ} {x : α} -lemma geom_sum_pos [ordered_semiring α] (hx : 0 < x) (hn : n ≠ 0) : 0 < geom_sum x n := -begin - refine nat.le_induction _ _ _ (show 1 ≤ n, from hn.bot_lt), - { simp [@@zero_lt_one _ (nontrivial_of_lt _ _ hx)] }, - intros k hk, - rw [geom_sum_succ'], - apply add_pos (pow_pos hx _) -end +lemma geom_sum_pos [strict_ordered_semiring α] (hx : 0 ≤ x) (hn : n ≠ 0) : + 0 < ∑ i in range n, x ^ i := +sum_pos' (λ k hk, pow_nonneg hx _) ⟨0, mem_range.2 hn.bot_lt, by simp⟩ -lemma geom_sum_pos_and_lt_one [ordered_ring α] (hx : x < 0) (hx' : 0 < x + 1) (hn : 1 < n) : - 0 < geom_sum x n ∧ geom_sum x n < 1 := +lemma geom_sum_pos_and_lt_one [strict_ordered_ring α] (hx : x < 0) (hx' : 0 < x + 1) (hn : 1 < n) : + 0 < ∑ i in range n, x ^ i ∧ ∑ i in range n, x ^ i < 1 := begin refine nat.le_induction _ _ n (show 2 ≤ n, from hn), { rw geom_sum_two, @@ -438,15 +451,30 @@ begin (neg_lt_iff_pos_add'.2 hx') ihn.2.le, mul_neg_of_neg_of_pos hx ihn.1⟩ end -lemma geom_sum_alternating_of_lt_neg_one [ordered_ring α] (hx : x + 1 < 0) (hn : 1 < n) : - if even n then geom_sum x n < 0 else 1 < geom_sum x n := +lemma geom_sum_alternating_of_le_neg_one [strict_ordered_ring α] (hx : x + 1 ≤ 0) (n : ℕ) : + if even n then ∑ i in range n, x ^ i ≤ 0 else 1 ≤ ∑ i in range n, x ^ i := +begin + have hx0 : x ≤ 0 := (le_add_of_nonneg_right zero_le_one).trans hx, + induction n with n ih, + { simp only [even_zero, geom_sum_zero, le_refl] }, + simp only [nat.even_add_one, geom_sum_succ], + split_ifs at ih, + { rw [if_neg (not_not_intro h), le_add_iff_nonneg_left], + exact mul_nonneg_of_nonpos_of_nonpos hx0 ih }, + { rw if_pos h, + refine (add_le_add_right _ _).trans hx, + simpa only [mul_one] using mul_le_mul_of_nonpos_left ih hx0 } +end + +lemma geom_sum_alternating_of_lt_neg_one [strict_ordered_ring α] (hx : x + 1 < 0) (hn : 1 < n) : + if even n then ∑ i in range n, x ^ i < 0 else 1 < ∑ i in range n, x ^ i := begin - have hx0 : x < 0, from ((le_add_iff_nonneg_right _).2 (@zero_le_one α _)).trans_lt hx, + have hx0 : x < 0, from ((le_add_iff_nonneg_right _).2 zero_le_one).trans_lt hx, refine nat.le_induction _ _ n (show 2 ≤ n, from hn), { simp only [geom_sum_two, hx, true_or, even_bit0, if_true_left_eq_or] }, clear hn n, intros n hn ihn, - simp only [nat.even_succ, geom_sum_succ], + simp only [nat.even_add_one, geom_sum_succ], by_cases hn' : even n, { rw [if_pos hn'] at ihn, rw [if_neg, lt_add_iff_pos_left], exact mul_pos_of_neg_of_neg hx0 ihn, exact not_not_intro hn', }, @@ -456,8 +484,19 @@ begin exact this.trans hx } end -lemma geom_sum_pos_of_odd [linear_ordered_ring α] (h : odd n) : - 0 < geom_sum x n := +lemma geom_sum_pos' [linear_ordered_ring α] (hx : 0 < x + 1) (hn : n ≠ 0) : + 0 < ∑ i in range n, x ^ i := +begin + obtain _ | _ | n := n, + { cases hn rfl }, + { simp }, + obtain hx' | hx' := lt_or_le x 0, + { exact (geom_sum_pos_and_lt_one hx' hx n.one_lt_succ_succ).1 }, + { exact geom_sum_pos hx' (by simp only [nat.succ_ne_zero, ne.def, not_false_iff]) } +end + +lemma odd.geom_sum_pos [linear_ordered_ring α] (h : odd n) : + 0 < ∑ i in range n, x ^ i := begin rcases n with (_ | _ | k), { exact ((show ¬ odd 0, from dec_trivial) h).elim }, @@ -467,57 +506,49 @@ begin { have := geom_sum_alternating_of_lt_neg_one hx k.one_lt_succ_succ, simp only [h, if_false] at this, exact zero_lt_one.trans this }, - { simp only [eq_neg_of_add_eq_zero hx, h, neg_one_geom_sum, if_false, zero_lt_one] }, - rcases lt_trichotomy x 0 with hx' | rfl | hx', - { exact (geom_sum_pos_and_lt_one hx' hx k.one_lt_succ_succ).1 }, - { simp only [zero_geom_sum, nat.succ_ne_zero, if_false, zero_lt_one] }, - { exact geom_sum_pos hx' (by simp only [nat.succ_ne_zero, ne.def, not_false_iff]) } + { simp only [eq_neg_of_add_eq_zero_left hx, h, neg_one_geom_sum, if_false, zero_lt_one] }, + { exact geom_sum_pos' hx k.succ.succ_ne_zero } end -lemma geom_sum_pos_iff [linear_ordered_ring α] (hn : 1 < n) : - 0 < geom_sum x n ↔ odd n ∨ 0 < x + 1 := +lemma geom_sum_pos_iff [linear_ordered_ring α] (hn : n ≠ 0) : + 0 < ∑ i in range n, x ^ i ↔ odd n ∨ 0 < x + 1 := begin refine ⟨λ h, _, _⟩, - { suffices : ¬ 0 < x + 1 → odd n, by tauto, - intro hx, - rw not_lt at hx, - contrapose! h, - rw [←nat.even_iff_not_odd] at h, - rcases hx.eq_or_lt with hx | hx, - { rw [←neg_neg (1 : α), add_neg_eq_iff_eq_add, zero_add] at hx, - simp only [hx, neg_one_geom_sum, h, if_true] }, - apply le_of_lt, - simpa [h] using geom_sum_alternating_of_lt_neg_one hx hn }, + { rw [or_iff_not_imp_left, ←not_le, ←nat.even_iff_not_odd], + refine λ hn hx, h.not_le _, + simpa [if_pos hn] using geom_sum_alternating_of_le_neg_one hx n }, { rintro (hn | hx'), - { exact geom_sum_pos_of_odd hn }, - rcases lt_trichotomy x 0 with hx | rfl | hx, - { exact (geom_sum_pos_and_lt_one hx hx' hn).1 }, - { simp only [(zero_lt_one.trans hn).ne', zero_geom_sum, if_false, zero_lt_one] }, - { exact geom_sum_pos hx (zero_lt_one.trans hn).ne' } } + { exact hn.geom_sum_pos }, + { exact geom_sum_pos' hx' hn } } end -lemma geom_sum_eq_zero_iff_neg_one [linear_ordered_ring α] (hn : 1 < n) : - geom_sum x n = 0 ↔ x = -1 ∧ even n := +lemma geom_sum_ne_zero [linear_ordered_ring α] (hx : x ≠ -1) (hn : n ≠ 0) : + ∑ i in range n, x ^ i ≠ 0 := begin - refine ⟨λ h, _, λ ⟨h, hn⟩, by simp only [h, hn, neg_one_geom_sum, if_true]⟩, - contrapose! h, - rcases eq_or_ne x (-1) with rfl | h, - { simp only [h rfl, neg_one_geom_sum, if_false, ne.def, not_false_iff, one_ne_zero] }, - rw [ne.def, eq_neg_iff_add_eq_zero, ←ne.def] at h, - rcases h.lt_or_lt with h | h, - { have := geom_sum_alternating_of_lt_neg_one h hn, + obtain _ | _ | n := n, + { cases hn rfl }, + { simp }, + rw [ne.def, eq_neg_iff_add_eq_zero, ←ne.def] at hx, + obtain h | h := hx.lt_or_lt, + { have := geom_sum_alternating_of_lt_neg_one h n.one_lt_succ_succ, split_ifs at this, { exact this.ne }, { exact (zero_lt_one.trans this).ne' } }, - apply ne_of_gt, - rcases lt_trichotomy x 0 with h' | rfl | h', - { exact (geom_sum_pos_and_lt_one h' h hn).1 }, - { simp only [(pos_of_gt hn).ne', zero_geom_sum, if_false, zero_lt_one] }, - { exact geom_sum_pos h' (pos_of_gt hn).ne' } + { exact (geom_sum_pos' h n.succ.succ_ne_zero).ne' } +end + +lemma geom_sum_eq_zero_iff_neg_one [linear_ordered_ring α] (hn : n ≠ 0) : + ∑ i in range n, x ^ i = 0 ↔ x = -1 ∧ even n := +begin + refine ⟨λ h, _, λ ⟨h, hn⟩, by simp only [h, hn, neg_one_geom_sum, if_true]⟩, + contrapose! h, + obtain rfl | hx := eq_or_ne x (-1), + { simp only [h rfl, neg_one_geom_sum, if_false, ne.def, not_false_iff, one_ne_zero] }, + { exact geom_sum_ne_zero hx hn } end -lemma geom_sum_neg_iff [linear_ordered_ring α] (hn : 1 < n) : - geom_sum x n < 0 ↔ even n ∧ x + 1 < 0 := +lemma geom_sum_neg_iff [linear_ordered_ring α] (hn : n ≠ 0) : + ∑ i in range n, x ^ i < 0 ↔ even n ∧ x + 1 < 0 := by rw [← not_iff_not, not_lt, le_iff_lt_or_eq, eq_comm, or_congr (geom_sum_pos_iff hn) (geom_sum_eq_zero_iff_neg_one hn), nat.odd_iff_not_even, ← add_eq_zero_iff_eq_neg, not_and, not_lt, le_iff_lt_or_eq, eq_comm, diff --git a/src/algebra/graded_monoid.lean b/src/algebra/graded_monoid.lean index 498e2fb4aaa54..454603c0a8341 100644 --- a/src/algebra/graded_monoid.lean +++ b/src/algebra/graded_monoid.lean @@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Wieser -/ import algebra.group.inj_surj -import data.list.big_operators -import data.list.range +import data.list.big_operators.basic +import data.list.fin_range import group_theory.group_action.defs import group_theory.submonoid.basic import data.set_like.basic @@ -14,6 +14,9 @@ import data.sigma.basic /-! # Additively-graded multiplicative structures +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides a set of heterogeneous typeclasses for defining a multiplicative structure over the sigma type `graded_monoid A` such that `(*) : A i → A j → A (i + j)`; that is to say, `A` forms an additively-graded monoid. The typeclasses are: @@ -40,7 +43,7 @@ the base type `A 0` with: and the `i`th grade `A i` with `A 0`-actions (`•`) defined as left-multiplication: * (nothing) -* `graded_monoid.grade_zero.has_scalar (A 0)` +* `graded_monoid.grade_zero.has_smul (A 0)` * `graded_monoid.grade_zero.mul_action (A 0)` * (nothing) @@ -64,16 +67,24 @@ provides the `Prop` typeclasses: * `set_like.has_graded_mul A` (which provides the obvious `graded_monoid.ghas_mul A` instance) * `set_like.graded_monoid A` (which provides the obvious `graded_monoid.gmonoid A` and `graded_monoid.gcomm_monoid A` instances) -* `set_like.is_homogeneous A` (which says that `a` is homogeneous iff `a ∈ A i` for some `i : ι`) + +which respectively provide the API lemmas + +* `set_like.one_mem_graded` +* `set_like.mul_mem_graded` +* `set_like.pow_mem_graded`, `set_like.list_prod_map_mem_graded` Strictly this last class is unecessary as it has no fields not present in its parents, but it is -included for convenience. Note that there is no need for `graded_ring` or similar, as all the -information it would contain is already supplied by `graded_monoid` when `A` is a collection -of additively-closed set_like objects such as `submodules`. These constructions are explored in -`algebra.direct_sum.internal`. +included for convenience. Note that there is no need for `set_like.graded_ring` or similar, as all +the information it would contain is already supplied by `graded_monoid` when `A` is a collection +of objects satisfying `add_submonoid_class` such as `submodule`s. These constructions are explored +in `algebra.direct_sum.internal`. -This file also contains the definition of `set_like.homogeneous_submonoid A`, which is, as the name -suggests, the submonoid consisting of all the homogeneous elements. +This file also defines: + +* `set_like.is_homogeneous A` (which says that `a` is homogeneous iff `a ∈ A i` for some `i : ι`) +* `set_like.homogeneous_submonoid A`, which is, as the name suggests, the submonoid consisting of + all the homogeneous elements. ## tags @@ -222,7 +233,7 @@ variables [add_zero_class ι] [ghas_mul A] /-- `(•) : A 0 → A i → A i` is the value provided in `graded_monoid.ghas_mul.mul`, composed with an `eq.rec` to turn `A (0 + i)` into `A i`. -/ -instance grade_zero.has_scalar (i : ι) : has_scalar (A 0) (A i) := +instance grade_zero.has_smul (i : ι) : has_smul (A 0) (A i) := { smul := λ x y, (zero_add i).rec (ghas_mul.mul x y) } /-- `(*) : A 0 → A 0 → A 0` is the value provided in `graded_monoid.ghas_mul.mul`, composed with @@ -411,9 +422,12 @@ class set_like.has_graded_one {S : Type*} [set_like S R] [has_one R] [has_zero (A : ι → S) : Prop := (one_mem : (1 : R) ∈ A 0) +lemma set_like.one_mem_graded {S : Type*} [set_like S R] [has_one R] [has_zero ι] (A : ι → S) + [set_like.has_graded_one A] : (1 : R) ∈ A 0 := set_like.has_graded_one.one_mem + instance set_like.ghas_one {S : Type*} [set_like S R] [has_one R] [has_zero ι] (A : ι → S) [set_like.has_graded_one A] : graded_monoid.ghas_one (λ i, A i) := -{ one := ⟨1, set_like.has_graded_one.one_mem⟩ } +{ one := ⟨1, set_like.one_mem_graded _⟩ } @[simp] lemma set_like.coe_ghas_one {S : Type*} [set_like S R] [has_one R] [has_zero ι] (A : ι → S) [set_like.has_graded_one A] : ↑(@graded_monoid.ghas_one.one _ (λ i, A i) _ _) = (1 : R) := rfl @@ -423,10 +437,15 @@ class set_like.has_graded_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι (A : ι → S) : Prop := (mul_mem : ∀ ⦃i j⦄ {gi gj}, gi ∈ A i → gj ∈ A j → gi * gj ∈ A (i + j)) +lemma set_like.mul_mem_graded {S : Type*} [set_like S R] [has_mul R] [has_add ι] {A : ι → S} + [set_like.has_graded_mul A] ⦃i j⦄ {gi gj} (hi : gi ∈ A i) (hj : gj ∈ A j) : + gi * gj ∈ A (i + j) := +set_like.has_graded_mul.mul_mem hi hj + instance set_like.ghas_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι] (A : ι → S) [set_like.has_graded_mul A] : graded_monoid.ghas_mul (λ i, A i) := -{ mul := λ i j a b, ⟨(a * b : R), set_like.has_graded_mul.mul_mem a.prop b.prop⟩ } +{ mul := λ i j a b, ⟨(a * b : R), set_like.mul_mem_graded a.prop b.prop⟩ } @[simp] lemma set_like.coe_ghas_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι] (A : ι → S) [set_like.has_graded_mul A] {i j : ι} (x : A i) (y : A j) : @@ -436,35 +455,37 @@ instance set_like.ghas_mul {S : Type*} [set_like S R] [has_mul R] [has_add ι] ( class set_like.graded_monoid {S : Type*} [set_like S R] [monoid R] [add_monoid ι] (A : ι → S) extends set_like.has_graded_one A, set_like.has_graded_mul A : Prop -namespace set_like.graded_monoid +namespace set_like variables {S : Type*} [set_like S R] [monoid R] [add_monoid ι] variables {A : ι → S} [set_like.graded_monoid A] -lemma pow_mem (n : ℕ) {r : R} {i : ι} (h : r ∈ A i) : r ^ n ∈ A (n • i) := +lemma pow_mem_graded (n : ℕ) {r : R} {i : ι} (h : r ∈ A i) : r ^ n ∈ A (n • i) := begin induction n, - { rw [pow_zero, zero_nsmul], exact one_mem }, - { rw [pow_succ', succ_nsmul'], exact mul_mem n_ih h }, + { rw [pow_zero, zero_nsmul], exact one_mem_graded _ }, + { rw [pow_succ', succ_nsmul'], exact mul_mem_graded n_ih h }, end -lemma list_prod_map_mem {ι'} (l : list ι') (i : ι' → ι) (r : ι' → R) (h : ∀ j ∈ l, r j ∈ A (i j)) : +lemma list_prod_map_mem_graded {ι'} (l : list ι') (i : ι' → ι) (r : ι' → R) + (h : ∀ j ∈ l, r j ∈ A (i j)) : (l.map r).prod ∈ A (l.map i).sum := begin induction l, { rw [list.map_nil, list.map_nil, list.prod_nil, list.sum_nil], - exact one_mem }, + exact one_mem_graded _ }, { rw [list.map_cons, list.map_cons, list.prod_cons, list.sum_cons], - exact mul_mem (h _ $ list.mem_cons_self _ _) (l_ih $ λ j hj, h _ $ list.mem_cons_of_mem _ hj) }, + exact mul_mem_graded + (h _ $ list.mem_cons_self _ _) (l_ih $ λ j hj, h _ $ list.mem_cons_of_mem _ hj) }, end -lemma list_prod_of_fn_mem {n} (i : fin n → ι) (r : fin n → R) (h : ∀ j, r j ∈ A (i j)) : +lemma list_prod_of_fn_mem_graded {n} (i : fin n → ι) (r : fin n → R) (h : ∀ j, r j ∈ A (i j)) : (list.of_fn r).prod ∈ A (list.of_fn i).sum := begin rw [list.of_fn_eq_map, list.of_fn_eq_map], - exact list_prod_map_mem _ _ _ (λ _ _, h _), + exact list_prod_map_mem_graded _ _ _ (λ _ _, h _), end -end set_like.graded_monoid +end set_like /-- Build a `gmonoid` instance for a collection of subobjects. -/ instance set_like.gmonoid {S : Type*} [set_like S R] [monoid R] [add_monoid ι] (A : ι → S) @@ -474,7 +495,7 @@ instance set_like.gmonoid {S : Type*} [set_like S R] [monoid R] [add_monoid ι] mul_one := λ ⟨i, a, h⟩, sigma.subtype_ext (add_zero _) (mul_one _), mul_assoc := λ ⟨i, a, ha⟩ ⟨j, b, hb⟩ ⟨k, c, hc⟩, sigma.subtype_ext (add_assoc _ _ _) (mul_assoc _ _ _), - gnpow := λ n i a, ⟨a ^ n, set_like.graded_monoid.pow_mem n a.prop⟩, + gnpow := λ n i a, ⟨a ^ n, set_like.pow_mem_graded n a.prop⟩, gnpow_zero' := λ n, sigma.subtype_ext (zero_nsmul _) (pow_zero _), gnpow_succ' := λ n a, sigma.subtype_ext (succ_nsmul _ _) (pow_succ _ _), ..set_like.ghas_one A, @@ -513,7 +534,7 @@ lemma set_like.list_dprod_eq (A : ι → S) [set_like.graded_monoid A] (fι : α → ι) (fA : Π a, A (fι a)) (l : list α) : (l.dprod fι fA : (λ i, ↥(A i)) _) = ⟨list.prod (l.map (λ a, fA a)), (l.dprod_index_eq_map_sum fι).symm ▸ - list_prod_map_mem l _ _ (λ i hi, (fA i).prop)⟩ := + list_prod_map_mem_graded l _ _ (λ i hi, (fA i).prop)⟩ := subtype.ext $ set_like.coe_list_dprod _ _ _ _ end dprod @@ -533,12 +554,12 @@ def set_like.is_homogeneous (A : ι → S) (a : R) : Prop := ∃ i, a ∈ A i lemma set_like.is_homogeneous_one [has_zero ι] [has_one R] (A : ι → S) [set_like.has_graded_one A] : set_like.is_homogeneous A (1 : R) := -⟨0, set_like.has_graded_one.one_mem⟩ +⟨0, set_like.one_mem_graded _⟩ lemma set_like.is_homogeneous.mul [has_add ι] [has_mul R] {A : ι → S} [set_like.has_graded_mul A] {a b : R} : set_like.is_homogeneous A a → set_like.is_homogeneous A b → set_like.is_homogeneous A (a * b) -| ⟨i, hi⟩ ⟨j, hj⟩ := ⟨i + j, set_like.has_graded_mul.mul_mem hi hj⟩ +| ⟨i, hi⟩ ⟨j, hj⟩ := ⟨i + j, set_like.mul_mem_graded hi hj⟩ /-- When `A` is a `set_like.graded_monoid A`, then the homogeneous elements forms a submonoid. -/ def set_like.homogeneous_submonoid [add_monoid ι] [monoid R] diff --git a/src/algebra/graded_mul_action.lean b/src/algebra/graded_mul_action.lean new file mode 100644 index 0000000000000..041908d6f8e2d --- /dev/null +++ b/src/algebra/graded_mul_action.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang, Eric Wieser +-/ +import algebra.graded_monoid + +/-! +# Additively-graded multiplicative action structures + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This module provides a set of heterogeneous typeclasses for defining a multiplicative structure +over the sigma type `graded_monoid A` such that `(•) : A i → M j → M (i + j)`; that is to say, `A` +has an additively-graded multiplicative action on `M`. The typeclasses are: + +* `graded_monoid.ghas_smul A M` +* `graded_monoid.gmul_action A M` + +With the `sigma_graded` locale open, these respectively imbue: + +* `has_smul (graded_monoid A) (graded_monoid M)` +* `mul_action (graded_monoid A) (graded_monoid M)` + +For now, these typeclasses are primarily used in the construction of `direct_sum.gmodule.module` and +the rest of that file. + +## Internally graded multiplicative actions + +In addition to the above typeclasses, in the most frequent case when `A` is an indexed collection of +`set_like` subobjects (such as `add_submonoid`s, `add_subgroup`s, or `submodule`s), this file +provides the `Prop` typeclasses: + +* `set_like.has_graded_smul A M` (which provides the obvious `graded_monoid.ghas_smul A` instance) + +which provides the API lemma + +* `set_like.graded_smul_mem_graded` + +Note that there is no need for `set_like.graded_mul_action` or similar, as all the information it +would contain is already supplied by `has_graded_smul` when the objects within `A` and `M` have +a `mul_action` instance. + +## tags + +graded action +-/ + +set_option old_structure_cmd true + +variables {ι : Type*} + +namespace graded_monoid + +/-! ### Typeclasses -/ +section defs + +variables (A : ι → Type*) (M : ι → Type*) + +/-- A graded version of `has_smul`. Scalar multiplication combines grades additively, i.e. +if `a ∈ A i` and `m ∈ M j`, then `a • b` must be in `M (i + j)`-/ +class ghas_smul [has_add ι] := +(smul {i j} : A i → M j → M (i + j)) + +/-- A graded version of `has_mul.to_has_smul` -/ +instance ghas_mul.to_ghas_smul [has_add ι] [ghas_mul A] : ghas_smul A A := +{ smul := λ _ _, ghas_mul.mul } + +instance ghas_smul.to_has_smul [has_add ι] [ghas_smul A M] : + has_smul (graded_monoid A) (graded_monoid M) := +⟨λ (x : graded_monoid A) (y : graded_monoid M), ⟨_, ghas_smul.smul x.snd y.snd⟩⟩ + +lemma mk_smul_mk [has_add ι] [ghas_smul A M] {i j} (a : A i) (b : M j) : + mk i a • mk j b = mk (i + j) (ghas_smul.smul a b) := +rfl + +/-- A graded version of `mul_action`. -/ +class gmul_action [add_monoid ι] [gmonoid A] extends ghas_smul A M := +(one_smul (b : graded_monoid M) : (1 : graded_monoid A) • b = b) +(mul_smul (a a' : graded_monoid A) (b : graded_monoid M) : (a * a') • b = a • a' • b) + +/-- The graded version of `monoid.to_mul_action`. -/ +instance gmonoid.to_gmul_action [add_monoid ι] [gmonoid A] : + gmul_action A A := +{ one_smul := gmonoid.one_mul, + mul_smul := gmonoid.mul_assoc, + ..ghas_mul.to_ghas_smul _ } + +instance gmul_action.to_mul_action [add_monoid ι] [gmonoid A] [gmul_action A M] : + mul_action (graded_monoid A) (graded_monoid M) := +{ one_smul := gmul_action.one_smul, + mul_smul := gmul_action.mul_smul } + +end defs + +end graded_monoid + +/-! ### Shorthands for creating instance of the above typeclasses for collections of subobjects -/ + +section subobjects + +variables {R : Type*} + +/-- A version of `graded_monoid.ghas_smul` for internally graded objects. -/ +class set_like.has_graded_smul {S R N M : Type*} [set_like S R] [set_like N M] + [has_smul R M] [has_add ι] (A : ι → S) (B : ι → N) : Prop := +(smul_mem : ∀ ⦃i j : ι⦄ {ai bj}, ai ∈ A i → bj ∈ B j → ai • bj ∈ B (i + j)) + +instance set_like.ghas_smul {S R N M : Type*} [set_like S R] [set_like N M] + [has_smul R M] [has_add ι] (A : ι → S) (B : ι → N) [set_like.has_graded_smul A B] : + graded_monoid.ghas_smul (λ i, A i) (λ i, B i) := +{ smul := λ i j a b, ⟨(a : R) • b, set_like.has_graded_smul.smul_mem a.2 b.2⟩ } + +@[simp] lemma set_like.coe_ghas_smul {S R N M : Type*} [set_like S R] [set_like N M] + [has_smul R M] [has_add ι] (A : ι → S) (B : ι → N) [set_like.has_graded_smul A B] + {i j : ι} (x : A i) (y : B j) : + (@graded_monoid.ghas_smul.smul ι (λ i, A i) (λ i, B i) _ _ i j x y : M) = ((x : R) • y) := +rfl + +/-- Internally graded version of `has_mul.to_has_smul`. -/ +instance set_like.has_graded_mul.to_has_graded_smul [add_monoid ι] [monoid R] + {S : Type*} [set_like S R] (A : ι → S) [set_like.graded_monoid A] : + set_like.has_graded_smul A A := +{ smul_mem := λ i j ai bj hi hj, set_like.graded_monoid.mul_mem hi hj, } + +end subobjects + +section homogeneous_elements + +variables {S R N M : Type*} [set_like S R] [set_like N M] + +lemma set_like.is_homogeneous.graded_smul [has_add ι] [has_smul R M] {A : ι → S} {B : ι → N} + [set_like.has_graded_smul A B] {a : R} {b : M} : + set_like.is_homogeneous A a → set_like.is_homogeneous B b → set_like.is_homogeneous B (a • b) +| ⟨i, hi⟩ ⟨j, hj⟩ := ⟨i + j, set_like.has_graded_smul.smul_mem hi hj⟩ + +end homogeneous_elements diff --git a/src/algebra/group/basic.lean b/src/algebra/group/basic.lean index 2b802531b8dfb..e4d064f28f2aa 100644 --- a/src/algebra/group/basic.lean +++ b/src/algebra/group/basic.lean @@ -5,12 +5,13 @@ Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro -/ import algebra.group.defs -import data.bracket -import logic.function.basic /-! # Basic lemmas about semigroups, monoids, and groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file lists various basic lemmas about semigroups, monoids, and groups. Most proofs are one-liners from the corresponding axioms. For the definitions of semigroups, monoids and groups, see `algebra/group/defs.lean`. @@ -19,7 +20,7 @@ one-liners from the corresponding axioms. For the definitions of semigroups, mon open function universe u -variables {α G : Type*} +variables {α β G : Type*} section associative variables (f : α → α → α) [is_associative α f] (x y : α) @@ -116,6 +117,18 @@ by simp only [mul_left_comm, mul_comm] end comm_semigroup +section add_comm_semigroup +variables {M : Type u} [add_comm_semigroup M] + +lemma bit0_add (a b : M) : bit0 (a + b) = bit0 a + bit0 b := +add_add_add_comm _ _ _ _ +lemma bit1_add [has_one M] (a b : M) : bit1 (a + b) = bit0 a + bit1 b := +(congr_arg (+ (1 : M)) $ bit0_add a b : _).trans (add_assoc _ _ _) +lemma bit1_add' [has_one M] (a b : M) : bit1 (a + b) = bit1 a + bit0 b := +by rw [add_comm, bit1_add, add_comm] + +end add_comm_semigroup + local attribute [simp] mul_assoc sub_eq_add_neg section add_monoid @@ -146,6 +159,9 @@ calc a * b = a ↔ a * b = a * 1 : by rw mul_one @[simp, to_additive] lemma self_eq_mul_right : a = a * b ↔ b = 1 := eq_comm.trans mul_right_eq_self +@[to_additive] lemma mul_right_ne_self : a * b ≠ a ↔ b ≠ 1 := mul_right_eq_self.not +@[to_additive] lemma self_ne_mul_right : a ≠ a * b ↔ b ≠ 1 := self_eq_mul_right.not + end left_cancel_monoid section right_cancel_monoid @@ -159,6 +175,9 @@ calc a * b = b ↔ a * b = 1 * b : by rw one_mul @[simp, to_additive] lemma self_eq_mul_left : b = a * b ↔ a = 1 := eq_comm.trans mul_left_eq_self +@[to_additive] lemma mul_left_ne_self : a * b ≠ b ↔ a ≠ 1 := mul_left_eq_self.not +@[to_additive] lemma self_ne_mul_left : b ≠ a * b ↔ a ≠ 1 := self_eq_mul_left.not + end right_cancel_monoid section has_involutive_inv @@ -178,19 +197,14 @@ inv_involutive.injective @[simp, to_additive] theorem inv_inj {a b : G} : a⁻¹ = b⁻¹ ↔ a = b := inv_injective.eq_iff @[to_additive] -lemma eq_inv_of_eq_inv (h : a = b⁻¹) : b = a⁻¹ := -by simp [h] - -@[to_additive] -theorem eq_inv_iff_eq_inv : a = b⁻¹ ↔ b = a⁻¹ := -⟨eq_inv_of_eq_inv, eq_inv_of_eq_inv⟩ - -@[to_additive] -theorem inv_eq_iff_inv_eq : a⁻¹ = b ↔ b⁻¹ = a := -eq_comm.trans $ eq_inv_iff_eq_inv.trans eq_comm +theorem inv_eq_iff_eq_inv : a⁻¹ = b ↔ a = b⁻¹ := +⟨λ h, h ▸ (inv_inv a).symm, λ h, h.symm ▸ inv_inv b⟩ variables (G) +@[simp, to_additive] lemma inv_comp_inv : has_inv.inv ∘ has_inv.inv = @id G := +inv_involutive.comp_self + @[to_additive] lemma left_inverse_inv : left_inverse (λ a : G, a⁻¹) (λ a, a⁻¹) := inv_inv @[to_additive] lemma right_inverse_inv : left_inverse (λ a : G, a⁻¹) (λ a, a⁻¹) := inv_inv @@ -220,8 +234,7 @@ lemma mul_div_assoc' (a b c : G) : a * (b / c) = (a * b) / c := @[simp, to_additive] lemma one_div (a : G) : 1 / a = a⁻¹ := (inv_eq_one_div a).symm -@[to_additive] -lemma mul_div (a b c : G) : a * (b / c) = a * b / c := +@[to_additive] lemma mul_div (a b c : G) : a * (b / c) = a * b / c := by simp only [mul_assoc, div_eq_mul_inv] @[to_additive] lemma div_eq_mul_one_div (a b : G) : a / b = a * (1 / b) := @@ -229,7 +242,18 @@ by rw [div_eq_mul_inv, one_div] end div_inv_monoid -namespace division_monoid +section div_inv_one_monoid +variables [div_inv_one_monoid G] + +@[simp, to_additive] lemma div_one (a : G) : a / 1 = a := +by simp [div_eq_mul_inv] + +@[to_additive] lemma one_div_one : (1 : G) / 1 = 1 := +div_one _ + +end div_inv_one_monoid + +section division_monoid variables [division_monoid α] {a b c : α} local attribute [simp] mul_assoc div_eq_mul_inv @@ -260,12 +284,14 @@ variables (a b c) @[to_additive] lemma inv_div_left : a⁻¹ / b = (b * a)⁻¹ := by simp @[simp, to_additive] lemma inv_div : (a / b)⁻¹ = b / a := by simp @[simp, to_additive] lemma one_div_div : 1 / (a / b) = b / a := by simp -@[simp, to_additive] lemma inv_one : (1 : α)⁻¹ = 1 := -by simpa only [one_div, inv_inv] using (inv_div (1 : α) 1).symm -@[simp, to_additive] lemma div_one : a / 1 = a := by simp -@[to_additive] lemma one_div_one : (1 : α) / 1 = 1 := div_one _ @[to_additive] lemma one_div_one_div : 1 / (1 / a) = a := by simp +@[priority 100, to_additive subtraction_monoid.to_sub_neg_zero_monoid] +instance division_monoid.to_div_inv_one_monoid : + div_inv_one_monoid α := +{ inv_one := by simpa only [one_div, inv_inv] using (inv_div (1 : α) 1).symm, + ..division_monoid.to_div_inv_monoid α } + variables {a b c} @[simp, to_additive] lemma inv_eq_one : a⁻¹ = 1 ↔ a = 1 := inv_injective.eq_iff' inv_one @@ -285,21 +311,24 @@ by simp only [mul_assoc, mul_inv_rev, div_eq_mul_inv] end division_monoid -namespace division_comm_monoid +lemma bit0_neg [subtraction_monoid α] (a : α) : bit0 (-a) = -bit0 a := (neg_add_rev _ _).symm + +section division_comm_monoid variables [division_comm_monoid α] (a b c d : α) local attribute [simp] mul_assoc mul_comm mul_left_comm div_eq_mul_inv @[to_additive neg_add] lemma mul_inv : (a * b)⁻¹ = a⁻¹ * b⁻¹ := by simp +@[to_additive] lemma inv_div' : (a / b)⁻¹ = a⁻¹ / b⁻¹ := by simp @[to_additive] lemma div_eq_inv_mul : a / b = b⁻¹ * a := by simp @[to_additive] lemma inv_mul_eq_div : a⁻¹ * b = b / a := by simp @[to_additive] lemma inv_mul' : (a * b)⁻¹ = a⁻¹ / b := by simp -@[to_additive] lemma inv_div_inv : (a⁻¹ / b⁻¹) = b / a := by simp +@[simp, to_additive] lemma inv_div_inv : (a⁻¹ / b⁻¹) = b / a := by simp @[to_additive] lemma inv_inv_div_inv : (a⁻¹ / b⁻¹)⁻¹ = a / b := by simp @[to_additive] lemma one_div_mul_one_div : (1 / a) * (1 / b) = 1 / (a * b) := by simp @[to_additive] lemma div_right_comm : a / b / c = a / c / b := by simp -@[to_additive] lemma div_div : a / b / c = a / (b * c) := by simp +@[to_additive, field_simps] lemma div_div : a / b / c = a / (b * c) := by simp @[to_additive] lemma div_mul : a / b * c = a / (b / c) := by simp @[to_additive] lemma mul_div_left_comm : a * (b / c) = b * (a / c) := by simp @[to_additive] lemma mul_div_right_comm : a * b / c = a / c * b := by simp @@ -319,12 +348,6 @@ end division_comm_monoid section group variables [group G] {a b c d : G} -@[to_additive neg_zero] lemma one_inv : 1⁻¹ = (1 : G) := division_monoid.inv_one - -@[to_additive] theorem inv_eq_one : a⁻¹ = 1 ↔ a = 1 := division_monoid.inv_eq_one -@[to_additive] theorem one_eq_inv : 1 = a⁻¹ ↔ a = 1 := division_monoid.one_eq_inv -@[to_additive] theorem inv_ne_one : a⁻¹ ≠ 1 ↔ a ≠ 1 := division_monoid.inv_ne_one - @[simp, to_additive] theorem div_eq_inv_self : a / b = b⁻¹ ↔ a = 1 := by rw [div_eq_mul_inv, mul_left_eq_self] @@ -336,9 +359,6 @@ theorem mul_left_surjective (a : G) : function.surjective ((*) a) := theorem mul_right_surjective (a : G) : function.surjective (λ x, x * a) := λ x, ⟨x * a⁻¹, inv_mul_cancel_right x a⟩ -@[to_additive] -lemma eq_inv_of_mul_eq_one : a * b = 1 → a = b⁻¹ := division_monoid.eq_inv_of_mul_eq_one_left - @[to_additive] lemma eq_mul_inv_of_mul_eq (h : a * c = b) : a = b * c⁻¹ := by simp [h.symm] @@ -373,11 +393,11 @@ by simp [h] @[to_additive] theorem mul_eq_one_iff_eq_inv : a * b = 1 ↔ a = b⁻¹ := -⟨eq_inv_of_mul_eq_one, λ h, by rw [h, mul_left_inv]⟩ +⟨eq_inv_of_mul_eq_one_left, λ h, by rw [h, mul_left_inv]⟩ @[to_additive] theorem mul_eq_one_iff_inv_eq : a * b = 1 ↔ a⁻¹ = b := -by rw [mul_eq_one_iff_eq_inv, eq_inv_iff_eq_inv, eq_comm] +by rw [mul_eq_one_iff_eq_inv, inv_eq_iff_eq_inv] @[to_additive] theorem eq_inv_iff_mul_eq_one : a = b⁻¹ ↔ a * b = 1 := @@ -419,9 +439,6 @@ by simpa only [div_eq_mul_inv] using λ a a' h, mul_left_injective (b⁻¹) h lemma div_right_injective : function.injective (λ a, b / a) := by simpa only [div_eq_mul_inv] using λ a a' h, inv_injective (mul_right_injective b h) -@[to_additive neg_sub] -lemma inv_div' (a b : G) : (a / b)⁻¹ = b / a := division_monoid.inv_div _ _ - @[simp, to_additive sub_add_cancel] lemma div_mul_cancel' (a b : G) : a / b * b = a := by rw [div_eq_mul_inv, inv_mul_cancel_right a b] @@ -434,17 +451,8 @@ by rw [div_eq_mul_inv, mul_right_inv a] lemma mul_div_cancel'' (a b : G) : a * b / b = a := by rw [div_eq_mul_inv, mul_inv_cancel_right a b] -@[to_additive eq_of_sub_eq_zero] -lemma eq_of_div_eq_one' : a / b = 1 → a = b := division_monoid.eq_of_div_eq_one - -@[to_additive] lemma div_ne_one_of_ne : a ≠ b → a / b ≠ 1 := division_monoid.div_ne_one_of_ne - -@[to_additive] -lemma div_inv_eq_mul (a b : G) : a / (b⁻¹) = a * b := division_monoid.div_inv_eq_mul _ _ - -@[to_additive] -lemma div_mul_eq_div_div_swap (a b c : G) : a / (b * c) = a / c / b := -division_monoid.div_mul_eq_div_div_swap _ _ _ +@[simp, to_additive sub_add_cancel''] +lemma div_mul_cancel''' (a b : G) : a / (b * a) = b⁻¹ := by rw [←inv_div, mul_div_cancel''] @[simp, to_additive] lemma mul_div_mul_right_eq_div (a b c : G) : (a * c) / (b * c) = a / b := @@ -480,14 +488,11 @@ by rw [← mul_div_assoc, div_mul_cancel'] @[simp, to_additive sub_sub_sub_cancel_right] lemma div_div_div_cancel_right' (a b c : G) : (a / c) / (b / c) = a / b := -by rw [← inv_div' c b, div_inv_eq_mul, div_mul_div_cancel'] - -@[to_additive] -theorem div_div_assoc_swap : a / (b / c) = a * c / b := division_monoid.div_div_eq_mul_div _ _ _ +by rw [← inv_div c b, div_inv_eq_mul, div_mul_div_cancel'] @[to_additive] theorem div_eq_one : a / b = 1 ↔ a = b := -⟨eq_of_div_eq_one', λ h, by rw [h, div_self']⟩ +⟨eq_of_div_eq_one, λ h, by rw [h, div_self']⟩ alias div_eq_one ↔ _ div_eq_one_of_eq alias sub_eq_zero ↔ _ sub_eq_zero_of_eq @@ -500,10 +505,6 @@ not_congr div_eq_one theorem div_eq_self : a / b = a ↔ b = 1 := by rw [div_eq_mul_inv, mul_right_eq_self, inv_eq_one] --- The unprimed version is used by `group_with_zero`. This is the preferred choice. --- See https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/.60div_one'.60 -@[to_additive sub_zero] lemma div_one' (a : G) : a / 1 = a := division_monoid.div_one _ - @[to_additive eq_sub_iff_add_eq] theorem eq_div_iff_mul_eq' : a = b / c ↔ a * c = b := by rw [div_eq_mul_inv, eq_mul_inv_iff_mul_eq] @@ -552,42 +553,10 @@ variables [comm_group G] {a b c d : G} local attribute [simp] mul_assoc mul_comm mul_left_comm div_eq_mul_inv -@[to_additive neg_add] -lemma mul_inv (a b : G) : (a * b)⁻¹ = a⁻¹ * b⁻¹ := division_comm_monoid.mul_inv _ _ - @[to_additive] lemma div_eq_of_eq_mul' {a b c : G} (h : a = b * c) : a / b = c := by rw [h, div_eq_mul_inv, mul_comm, inv_mul_cancel_left] -@[to_additive] -lemma mul_div_left_comm {x y z : G} : x * (y / z) = y * (x / z) := -division_comm_monoid.mul_div_left_comm _ _ _ - -@[to_additive] -lemma div_mul_div_comm (a b c d : G) : a / b * (c / d) = a * c / (b * d) := -division_comm_monoid.div_mul_div_comm _ _ _ _ - -@[to_additive] -lemma div_div_div_comm (a b c d : G) : (a / b) / (c / d) = (a / c) / (b / d) := -division_comm_monoid.div_div_div_comm _ _ _ _ - -@[to_additive] -lemma div_mul_eq_div_div (a b c : G) : a / (b * c) = a / b / c := -division_comm_monoid.div_mul_eq_div_div _ _ _ - -@[to_additive] -lemma inv_mul_eq_div (a b : G) : a⁻¹ * b = b / a := division_comm_monoid.inv_mul_eq_div _ _ - -@[to_additive sub_add_eq_add_sub] -lemma div_mul_eq_mul_div' (a b c : G) : a / b * c = a * c / b := -division_comm_monoid.div_mul_eq_mul_div _ _ _ - -@[to_additive] -lemma div_div (a b c : G) : a / b / c = a / (b * c) := division_comm_monoid.div_div _ _ _ - -@[to_additive] -lemma div_mul (a b c : G) : a / b * c = a / (b / c) := division_comm_monoid.div_mul _ _ _ - @[simp, to_additive] lemma mul_div_mul_left_eq_div (a b c : G) : (c * a) / (c * b) = a / b := by simp @@ -608,31 +577,15 @@ begin simp [h], rw [mul_comm c, mul_inv_cancel_left] end lemma div_div_self' (a b : G) : a / (a / b) = b := by simpa using mul_inv_cancel_left a b -@[to_additive add_sub_comm] -lemma mul_div_comm' (a b c d : G) : a * b / (c * d) = (a / c) * (b / d) := -division_comm_monoid.mul_div_mul_comm _ _ _ _ - @[to_additive] lemma div_eq_div_mul_div (a b c : G) : a / b = c / b * (a / c) := by simp [mul_left_comm c] -@[to_additive] -lemma inv_inv_div_inv (a b : G) : (a⁻¹ / b⁻¹)⁻¹ = a / b := division_comm_monoid.inv_inv_div_inv _ _ - @[simp, to_additive] lemma div_div_cancel (a b : G) : a / (a / b) = b := div_div_self' a b -@[to_additive sub_eq_neg_add] -lemma div_eq_inv_mul' (a b : G) : a / b = b⁻¹ * a := division_comm_monoid.div_eq_inv_mul _ _ - @[simp, to_additive] lemma div_div_cancel_left (a b : G) : a / b / a = b⁻¹ := by simp -@[to_additive] -theorem inv_mul' (a b : G) : (a * b)⁻¹ = a⁻¹ / b := division_comm_monoid.inv_mul' _ _ - -@[simp, to_additive] -lemma inv_div_inv (a b : G) : a⁻¹ / b⁻¹ = b / a := division_comm_monoid.inv_div_inv _ _ - @[to_additive eq_sub_iff_add_eq'] lemma eq_div_iff_mul_eq'' : a = b / c ↔ c * a = b := by rw [eq_div_iff_mul_eq', mul_comm] @@ -642,8 +595,7 @@ lemma div_eq_iff_eq_mul' : a / b = c ↔ a = b * c := by rw [div_eq_iff_eq_mul, mul_comm] @[simp, to_additive add_sub_cancel'] -lemma mul_div_cancel''' (a b : G) : a * b / a = b := -by rw [div_eq_inv_mul', inv_mul_cancel_left] +lemma mul_div_cancel''' (a b : G) : a * b / a = b := by rw [div_eq_inv_mul, inv_mul_cancel_left] @[simp, to_additive] lemma mul_div_cancel'_right (a b : G) : a * (b / a) = b := @@ -651,7 +603,7 @@ by rw [← mul_div_assoc, mul_div_cancel'''] @[simp, to_additive sub_add_cancel'] lemma div_mul_cancel'' (a b : G) : a / (a * b) = b⁻¹ := -by rw [← inv_div', mul_div_cancel'''] +by rw [← inv_div, mul_div_cancel'''] -- This lemma is in the `simp` set under the name `mul_inv_cancel_comm_assoc`, -- along with the additive version `add_neg_cancel_comm_assoc`, @@ -660,10 +612,6 @@ by rw [← inv_div', mul_div_cancel'''] lemma mul_mul_inv_cancel'_right (a b : G) : a * (b * a⁻¹) = b := by rw [← div_eq_mul_inv, mul_div_cancel'_right a b] -@[to_additive sub_right_comm] -lemma div_right_comm' (a b c : G) : a / b / c = a / c / b := -division_comm_monoid.div_right_comm _ _ _ - @[simp, to_additive] lemma mul_mul_div_cancel (a b c : G) : (a * c) * (b / c) = a * b := by rw [mul_assoc, mul_div_cancel'_right] @@ -682,26 +630,69 @@ by rw [← div_mul, mul_div_cancel'''] @[simp, to_additive] lemma div_div_div_cancel_left (a b c : G) : (c / a) / (c / b) = b / a := -by rw [← inv_div' b c, div_inv_eq_mul, mul_comm, div_mul_div_cancel'] +by rw [← inv_div b c, div_inv_eq_mul, mul_comm, div_mul_div_cancel'] @[to_additive] lemma div_eq_div_iff_mul_eq_mul : a / b = c / d ↔ a * d = c * b := begin - rw [div_eq_iff_eq_mul, div_mul_eq_mul_div', eq_comm, div_eq_iff_eq_mul'], + rw [div_eq_iff_eq_mul, div_mul_eq_mul_div, eq_comm, div_eq_iff_eq_mul'], simp only [mul_comm, eq_comm] end @[to_additive] lemma div_eq_div_iff_div_eq_div : a / b = c / d ↔ a / c = b / d := -by rw [div_eq_iff_eq_mul, div_mul_eq_mul_div', div_eq_iff_eq_mul', mul_div_assoc] +by rw [div_eq_iff_eq_mul, div_mul_eq_mul_div, div_eq_iff_eq_mul', mul_div_assoc] end comm_group -section commutator +section subtraction_comm_monoid +variables {M : Type u} [subtraction_comm_monoid M] -/-- The commutator of two elements `g₁` and `g₂`. -/ -instance commutator_element {G : Type*} [group G] : has_bracket G G := -⟨λ g₁ g₂, g₁ * g₂ * g₁⁻¹ * g₂⁻¹⟩ +lemma bit0_sub (a b : M) : bit0 (a - b) = bit0 a - bit0 b := +sub_add_sub_comm _ _ _ _ +lemma bit1_sub [has_one M] (a b : M) : bit1 (a - b) = bit1 a - bit0 b := +(congr_arg (+ (1 : M)) $ bit0_sub a b : _).trans $ sub_add_eq_add_sub _ _ _ -lemma commutator_element_def {G : Type*} [group G] (g₁ g₂ : G) : - ⁅g₁, g₂⁆ = g₁ * g₂ * g₁⁻¹ * g₂⁻¹ := rfl +end subtraction_comm_monoid + +section multiplicative + +variables [monoid β] (p r : α → α → Prop) [is_total α r] (f : α → α → β) + +@[to_additive additive_of_symmetric_of_is_total] +lemma multiplicative_of_symmetric_of_is_total + (hsymm : symmetric p) (hf_swap : ∀ {a b}, p a b → f a b * f b a = 1) + (hmul : ∀ {a b c}, r a b → r b c → p a b → p b c → p a c → f a c = f a b * f b c) + {a b c : α} (pab : p a b) (pbc : p b c) (pac : p a c) : f a c = f a b * f b c := +begin + suffices : ∀ {b c}, r b c → p a b → p b c → p a c → f a c = f a b * f b c, + { obtain rbc | rcb := total_of r b c, + { exact this rbc pab pbc pac }, + { rw [this rcb pac (hsymm pbc) pab, mul_assoc, hf_swap (hsymm pbc), mul_one] } }, + intros b c rbc pab pbc pac, + obtain rab | rba := total_of r a b, + { exact hmul rab rbc pab pbc pac }, + rw [← one_mul (f a c), ← hf_swap pab, mul_assoc], + obtain rac | rca := total_of r a c, + { rw [hmul rba rac (hsymm pab) pac pbc] }, + { rw [hmul rbc rca pbc (hsymm pac) (hsymm pab), mul_assoc, hf_swap (hsymm pac), mul_one] }, +end + +/-- If a binary function from a type equipped with a total relation `r` to a monoid is + anti-symmetric (i.e. satisfies `f a b * f b a = 1`), in order to show it is multiplicative + (i.e. satisfies `f a c = f a b * f b c`), we may assume `r a b` and `r b c` are satisfied. + We allow restricting to a subset specified by a predicate `p`. -/ +@[to_additive additive_of_is_total "If a binary function from a type equipped with a total relation + `r` to an additive monoid is anti-symmetric (i.e. satisfies `f a b + f b a = 0`), in order to show + it is additive (i.e. satisfies `f a c = f a b + f b c`), we may assume `r a b` and `r b c` + are satisfied. We allow restricting to a subset specified by a predicate `p`."] +lemma multiplicative_of_is_total (p : α → Prop) + (hswap : ∀ {a b}, p a → p b → f a b * f b a = 1) + (hmul : ∀ {a b c}, r a b → r b c → p a → p b → p c → f a c = f a b * f b c) + {a b c : α} (pa : p a) (pb : p b) (pc : p c) : f a c = f a b * f b c := +begin + apply multiplicative_of_symmetric_of_is_total (λ a b, p a ∧ p b) r f (λ _ _, and.swap), + { simp_rw and_imp, exact @hswap }, + { exact λ a b c rab rbc pab pbc pac, hmul rab rbc pab.1 pab.2 pac.2 }, + exacts [⟨pa, pb⟩, ⟨pb, pc⟩, ⟨pa, pc⟩], +end -end commutator +end multiplicative diff --git a/src/algebra/group/commutator.lean b/src/algebra/group/commutator.lean new file mode 100644 index 0000000000000..874c92a99f0e0 --- /dev/null +++ b/src/algebra/group/commutator.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2022 Thomas Browning. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Thomas Browning +-/ + +import algebra.group.defs +import data.bracket + +/-! +# The bracket on a group given by commutator. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +/-- The commutator of two elements `g₁` and `g₂`. -/ +instance commutator_element {G : Type*} [group G] : has_bracket G G := +⟨λ g₁ g₂, g₁ * g₂ * g₁⁻¹ * g₂⁻¹⟩ + +lemma commutator_element_def {G : Type*} [group G] (g₁ g₂ : G) : + ⁅g₁, g₂⁆ = g₁ * g₂ * g₁⁻¹ * g₂⁻¹ := rfl diff --git a/src/algebra/group/commute.lean b/src/algebra/group/commute.lean index aea715cf91e11..b8227479be7cc 100644 --- a/src/algebra/group/commute.lean +++ b/src/algebra/group/commute.lean @@ -8,6 +8,9 @@ import algebra.group.semiconj /-! # Commuting pairs of elements in monoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the predicate `commute a b := a * b = b * a` and provide some operations on terms `(h : commute a b)`. E.g., if `a`, `b`, and c are elements of a semiring, and that `hb : commute a b` and `hc : commute a c`. Then `hb.pow_left 5` proves `commute (a ^ 5) b` and `(hb.pow_right 2).add_right @@ -24,6 +27,8 @@ This file defines only a few operations (`mul_left`, `inv_right`, etc). Other o Most of the proofs come from the properties of `semiconj_by`. -/ +variables {G : Type*} + /-- Two elements commute if `a * b = b * a`. -/ @[to_additive add_commute "Two elements additively commute if `a + b = b + a`"] def commute {S : Type*} [has_mul S] (a b : S) : Prop := semiconj_by a b b @@ -52,6 +57,12 @@ protected lemma symm {a b : S} (h : commute a b) : commute b a := eq.symm h protected theorem symm_iff {a b : S} : commute a b ↔ commute b a := ⟨commute.symm, commute.symm⟩ +@[to_additive] instance : is_refl S commute := ⟨commute.refl⟩ + +-- This instance is useful for `finset.noncomm_prod` +@[to_additive] instance on_is_refl {f : G → S} : is_refl G (λ a b, commute (f a) (f b)) := +⟨λ _, commute.refl _⟩ + end has_mul section semigroup @@ -74,6 +85,10 @@ by simp only [mul_assoc, h.eq] a * (b * c) = b * (a * c) := by simp only [← mul_assoc, h.eq] +@[to_additive] protected lemma mul_mul_mul_comm (hbc : commute b c) (a d : S) : + (a * b) * (c * d) = (a * c) * (b * d) := +by simp only [hbc.left_comm, mul_assoc] + end semigroup @[to_additive] @@ -132,21 +147,26 @@ theorem units_of_coe : commute (u₁ : M) u₂ → commute u₁ u₂ := semiconj @[simp, to_additive] theorem units_coe_iff : commute (u₁ : M) u₂ ↔ commute u₁ u₂ := semiconj_by.units_coe_iff +/-- If the product of two commuting elements is a unit, then the left multiplier is a unit. -/ +@[to_additive "If the sum of two commuting elements is an additive unit, then the left summand is an +additive unit."] +def _root_.units.left_of_mul (u : Mˣ) (a b : M) (hu : a * b = u) (hc : commute a b) : Mˣ := +{ val := a, + inv := b * ↑u⁻¹, + val_inv := by rw [← mul_assoc, hu, u.mul_inv], + inv_val := have commute a u, from hu ▸ (commute.refl _).mul_right hc, + by rw [← this.units_inv_right.right_comm, ← hc.eq, hu, u.mul_inv] } + +/-- If the product of two commuting elements is a unit, then the right multiplier is a unit. -/ +@[to_additive "If the sum of two commuting elements is an additive unit, then the right summand is +an additive unit."] +def _root_.units.right_of_mul (u : Mˣ) (a b : M) (hu : a * b = u) (hc : commute a b) : Mˣ := +u.left_of_mul b a (hc.eq ▸ hu) hc.symm + @[to_additive] lemma is_unit_mul_iff (h : commute a b) : is_unit (a * b) ↔ is_unit a ∧ is_unit b := -begin - refine ⟨_, λ H, H.1.mul H.2⟩, - rintro ⟨u, hu⟩, - have : b * ↑u⁻¹ * a = 1, - { have : commute a u := hu.symm ▸ (commute.refl _).mul_right h, - rw [← this.units_inv_right.right_comm, ← h.eq, ← hu, u.mul_inv] }, - split, - { refine ⟨⟨a, b * ↑u⁻¹, _, this⟩, rfl⟩, - rw [← mul_assoc, ← hu, u.mul_inv] }, - { rw mul_assoc at this, - refine ⟨⟨b, ↑u⁻¹ * a, this, _⟩, rfl⟩, - rw [mul_assoc, ← hu, u.inv_mul] } -end +⟨λ ⟨u, hu⟩, ⟨(u.left_of_mul a b hu.symm h).is_unit, (u.right_of_mul a b hu.symm h).is_unit⟩, + λ H, H.1.mul H.2⟩ @[simp, to_additive] lemma _root_.is_unit_mul_self_iff : is_unit (a * a) ↔ is_unit a := @@ -154,9 +174,37 @@ end end monoid +section division_monoid +variables [division_monoid G] {a b c d : G} + +@[to_additive] protected lemma inv_inv : commute a b → commute a⁻¹ b⁻¹ := semiconj_by.inv_inv_symm +@[simp, to_additive] +lemma inv_inv_iff : commute a⁻¹ b⁻¹ ↔ commute a b := semiconj_by.inv_inv_symm_iff + +@[to_additive] protected lemma mul_inv (hab : commute a b) : (a * b)⁻¹ = a⁻¹ * b⁻¹ := +by rw [hab.eq, mul_inv_rev] + +@[to_additive] protected lemma inv (hab : commute a b) : (a * b)⁻¹ = a⁻¹ * b⁻¹ := +by rw [hab.eq, mul_inv_rev] + +@[to_additive] protected lemma div_mul_div_comm (hbd : commute b d) (hbc : commute b⁻¹ c) : + a / b * (c / d) = a * c / (b * d) := +by simp_rw [div_eq_mul_inv, mul_inv_rev, hbd.inv_inv.symm.eq, hbc.mul_mul_mul_comm] + +@[to_additive] protected lemma mul_div_mul_comm (hcd : commute c d) (hbc : commute b c⁻¹) : + a * b / (c * d) = a / c * (b / d) := +(hcd.div_mul_div_comm hbc.symm).symm + +@[to_additive] protected lemma div_div_div_comm (hbc : commute b c) (hbd : commute b⁻¹ d) + (hcd : commute c⁻¹ d) : a / b / (c / d) = a / c / (b / d) := +by simp_rw [div_eq_mul_inv, mul_inv_rev, inv_inv, hbd.symm.eq, hcd.symm.eq, + hbc.inv_inv.mul_mul_mul_comm] + +end division_monoid + section group -variables {G : Type*} [group G] {a b : G} +variables [group G] {a b : G} @[to_additive] theorem inv_right : commute a b → commute a b⁻¹ := semiconj_by.inv_right @@ -167,11 +215,6 @@ theorem inv_right_iff : commute a b⁻¹ ↔ commute a b := semiconj_by.inv_righ @[simp, to_additive] theorem inv_left_iff : commute a⁻¹ b ↔ commute a b := semiconj_by.inv_symm_left_iff -@[to_additive] -theorem inv_inv : commute a b → commute a⁻¹ b⁻¹ := semiconj_by.inv_inv_symm -@[simp, to_additive] -theorem inv_inv_iff : commute a⁻¹ b⁻¹ ↔ commute a b := semiconj_by.inv_inv_symm_iff - @[to_additive] protected theorem inv_mul_cancel (h : commute a b) : a⁻¹ * b * a = b := by rw [h.inv_left.eq, inv_mul_cancel_right] @@ -194,7 +237,7 @@ end commute section comm_group -variables {G : Type*} [comm_group G] (a b : G) +variables [comm_group G] (a b : G) @[simp, to_additive] lemma mul_inv_cancel_comm : a * b * a⁻¹ = b := (commute.all a b).mul_inv_cancel diff --git a/src/algebra/group/conj.lean b/src/algebra/group/conj.lean index ba3037ca353b0..ba988ce048bf5 100644 --- a/src/algebra/group/conj.lean +++ b/src/algebra/group/conj.lean @@ -1,5 +1,5 @@ /- -Copyright (c) 2018 Patrick Massot. All rights reserved. +Copyright (c) 2018 Patrick Massot. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Massot, Chris Hughes, Michael Howes -/ @@ -7,11 +7,13 @@ import algebra.group.semiconj import algebra.group_with_zero.basic import algebra.hom.aut import algebra.hom.group -import data.fintype.basic /-! # Conjugacy of group elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + See also `mul_aut.conj` and `quandle.conj`. -/ @@ -31,6 +33,9 @@ def is_conj (a b : α) := ∃ c : αˣ, semiconj_by ↑c a b @[symm] lemma is_conj.symm {a b : α} : is_conj a b → is_conj b a | ⟨c, hc⟩ := ⟨c⁻¹, hc.units_inv_symm_left⟩ +lemma is_conj_comm {g h : α} : is_conj g h ↔ is_conj h g := +⟨is_conj.symm, is_conj.symm⟩ + @[trans] lemma is_conj.trans {a b c : α} : is_conj a b → is_conj b c → is_conj a c | ⟨c₁, hc₁⟩ ⟨c₂, hc₂⟩ := ⟨c₂ * c₁, hc₂.mul_left hc₁⟩ @@ -46,9 +51,11 @@ protected lemma monoid_hom.map_is_conj (f : α →* β) {a b : α} : is_conj a b end monoid section cancel_monoid + variables [cancel_monoid α] --- These lemmas hold for either `left_cancel_monoid` or `right_cancel_monoid`, --- with slightly different proofs; so far these don't seem necessary. +-- These lemmas hold for `right_cancel_monoid` with the current proofs, but for the sake of +-- not duplicating code (these lemmas also hold for `left_cancel_monoids`) we leave these +-- not generalised. @[simp] lemma is_conj_one_right {a : α} : is_conj 1 a ↔ a = 1 := ⟨λ ⟨c, hc⟩, mul_right_cancel (hc.symm.trans ((mul_one _).trans (one_mul _).symm)), λ h, by rw [h]⟩ @@ -96,11 +103,11 @@ end group @[simp] lemma is_conj_iff₀ [group_with_zero α] {a b : α} : is_conj a b ↔ ∃ c : α, c ≠ 0 ∧ c * a * c⁻¹ = b := ⟨λ ⟨c, hc⟩, ⟨c, begin - rw [← units.coe_inv', units.mul_inv_eq_iff_eq_mul], + rw [← units.coe_inv, units.mul_inv_eq_iff_eq_mul], exact ⟨c.ne_zero, hc⟩, end⟩, λ ⟨c, c0, hc⟩, ⟨units.mk0 c c0, begin - rw [semiconj_by, ← units.mul_inv_eq_iff_eq_mul, units.coe_inv', units.coe_mk0], + rw [semiconj_by, ← units.mul_inv_eq_iff_eq_mul, units.coe_inv, units.coe_mk0], exact hc end⟩⟩ @@ -168,9 +175,39 @@ begin exact ⟨conj_classes.mk a, rfl⟩, end -instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] : - fintype (conj_classes α) := -quotient.fintype (is_conj.setoid α) +/-- +Certain instances trigger further searches when they are considered as candidate instances; +these instances should be assigned a priority lower than the default of 1000 (for example, 900). + +The conditions for this rule are as follows: + * a class `C` has instances `instT : C T` and `instT' : C T'` + * types `T` and `T'` are both specializations of another type `S` + * the parameters supplied to `S` to produce `T` are not (fully) determined by `instT`, + instead they have to be found by instance search +If those conditions hold, the instance `instT` should be assigned lower priority. + +For example, suppose the search for an instance of `decidable_eq (multiset α)` tries the +candidate instance `con.quotient.decidable_eq (c : con M) : decidable_eq c.quotient`. +Since `multiset` and `con.quotient` are both quotient types, unification will check +that the relations `list.perm` and `c.to_setoid.r` unify. However, `c.to_setoid` depends on +a `has_mul M` instance, so this unification triggers a search for `has_mul (list α)`; +this will traverse all subclasses of `has_mul` before failing. +On the other hand, the search for an instance of `decidable_eq (con.quotient c)` for `c : con M` +can quickly reject the candidate instance `multiset.has_decidable_eq` because the type of +`list.perm : list ?m_1 → list ?m_1 → Prop` does not unify with `M → M → Prop`. +Therefore, we should assign `con.quotient.decidable_eq` a lower priority because it fails slowly. +(In terms of the rules above, `C := decidable_eq`, `T := con.quotient`, +`instT := con.quotient.decidable_eq`, `T' := multiset`, `instT' := multiset.has_decidable_eq`, +and `S := quot`.) + +If the type involved is a free variable (rather than an instantiation of some type `S`), +the instance priority should be even lower, see Note [lower instance priority]. +-/ +library_note "slow-failing instance priority" + +@[priority 900] -- see Note [slow-failing instance priority] +instance [decidable_rel (is_conj : α → α → Prop)] : decidable_eq (conj_classes α) := +quotient.decidable_eq end monoid @@ -244,3 +281,5 @@ lemma carrier_eq_preimage_mk {a : conj_classes α} : set.ext (λ x, mem_carrier_iff_mk_eq) end conj_classes + +assert_not_exists multiset diff --git a/src/algebra/group/conj_finite.lean b/src/algebra/group/conj_finite.lean new file mode 100644 index 0000000000000..3329c47cb2c86 --- /dev/null +++ b/src/algebra/group/conj_finite.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2022 Eric Rodriguez. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Rodriguez +-/ + +import algebra.group.conj +import data.finite.basic +import data.fintype.units + +/-! +# Conjugacy of elements of finite groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} [monoid α] + +local attribute [instance, priority 100] is_conj.setoid + +instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] : + fintype (conj_classes α) := +quotient.fintype (is_conj.setoid α) + +instance [finite α] : finite (conj_classes α) := +quotient.finite _ + +instance [decidable_eq α] [fintype α] : decidable_rel (is_conj : α → α → Prop) := +λ a b, by { delta is_conj semiconj_by, apply_instance } + +instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] {a : α} : fintype (conjugates_of a) := +@subtype.fintype _ _ (‹decidable_rel is_conj› a) _ + +namespace conj_classes + +variables [fintype α] [decidable_rel (is_conj : α → α → Prop)] + +instance {x : conj_classes α} : fintype (carrier x) := +quotient.rec_on_subsingleton x $ λ a, conjugates_of.fintype + +end conj_classes diff --git a/src/algebra/group/default.lean b/src/algebra/group/default.lean deleted file mode 100644 index 8f8bbde514362..0000000000000 --- a/src/algebra/group/default.lean +++ /dev/null @@ -1,15 +0,0 @@ -/- -Copyright (c) 2014 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Michael Howes --/ -import algebra.group.conj -import algebra.group.type_tags -import algebra.group.with_one -import algebra.hom.units - -/-! -# Various multiplicative and additive structures. - -This file `import`s all files in this subdirectory except for `prod`. --/ diff --git a/src/algebra/group/defs.lean b/src/algebra/group/defs.lean index 380882efa4c5a..a33049364eb5d 100644 --- a/src/algebra/group/defs.lean +++ b/src/algebra/group/defs.lean @@ -3,12 +3,15 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro -/ -import algebra.group.to_additive import tactic.basic +import logic.function.basic /-! # Typeclasses for (semi)groups and monoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define typeclasses for algebraic structures with one binary operation. The classes are named `(add_)?(comm_)?(semigroup|monoid|group)`, where `add_` means that the class uses additive notation and `comm_` means that the class assumes that the binary @@ -21,17 +24,17 @@ The file does not contain any lemmas except for For basic lemmas about these classes see `algebra.group.basic`. -We also introduce notation classes `has_scalar` and `has_vadd` for multiplicative and additive +We also introduce notation classes `has_smul` and `has_vadd` for multiplicative and additive actions and register the following instances: - `has_pow M ℕ`, for monoids `M`, and `has_pow G ℤ` for groups `G`; -- `has_scalar ℕ M` for additive monoids `M`, and `has_scalar ℤ G` for additive groups `G`. +- `has_smul ℕ M` for additive monoids `M`, and `has_smul ℤ G` for additive groups `G`. ## Notation - `+`, `-`, `*`, `/`, `^` : the usual arithmetic operations; the underlying functions are `has_add.add`, `has_neg.neg`/`has_sub.sub`, `has_mul.mul`, `has_div.div`, and `has_pow.pow`. -- `a • b` is used as notation for `has_scalar.smul a b`. +- `a • b` is used as notation for `has_smul.smul a b`. - `a +ᵥ b` is used as notation for `has_vadd.vadd a b`. -/ @@ -45,17 +48,17 @@ class has_vadd (G : Type*) (P : Type*) := (vadd : G → P → P) class has_vsub (G : out_param Type*) (P : Type*) := (vsub : P → P → G) /-- Typeclass for types with a scalar multiplication operation, denoted `•` (`\bu`) -/ -@[ext, to_additive has_vadd] -class has_scalar (M : Type*) (α : Type*) := (smul : M → α → α) +@[ext, to_additive] +class has_smul (M : Type*) (α : Type*) := (smul : M → α → α) infix ` +ᵥ `:65 := has_vadd.vadd infix ` -ᵥ `:65 := has_vsub.vsub -infixr ` • `:73 := has_scalar.smul +infixr ` • `:73 := has_smul.smul attribute [to_additive_reorder 1] has_pow attribute [to_additive_reorder 1 4] has_pow.pow -attribute [to_additive has_scalar] has_pow -attribute [to_additive has_scalar.smul] has_pow.pow +attribute [to_additive has_smul] has_pow +attribute [to_additive has_smul.smul] has_pow.pow set_option old_structure_cmd true @@ -84,10 +87,6 @@ variables {G : Type*} to the additive one. -/ -mk_simp_attribute field_simps "The simpset `field_simps` is used by the tactic `field_simp` to -reduce an expression in a field to an expression of the form `n / d` where `n` and `d` are -division-free." - section has_mul variables [has_mul G] @@ -99,6 +98,87 @@ def left_mul : G → G → G := λ g : G, λ x : G, g * x @[to_additive "`right_add g` denotes right addition by `g`"] def right_mul : G → G → G := λ g : G, λ x : G, x * g +/-- A mixin for left cancellative multiplication. -/ +@[protect_proj] class is_left_cancel_mul (G : Type u) [has_mul G] : Prop := + (mul_left_cancel : ∀ a b c : G, a * b = a * c → b = c) + +/-- A mixin for right cancellative multiplication. -/ +@[protect_proj] class is_right_cancel_mul (G : Type u) [has_mul G] : Prop := + (mul_right_cancel : ∀ a b c : G, a * b = c * b → a = c) + +/-- A mixin for cancellative multiplication. -/ +@[protect_proj] class is_cancel_mul (G : Type u) [has_mul G] + extends is_left_cancel_mul G, is_right_cancel_mul G : Prop + +/-- A mixin for left cancellative addition. -/ +@[protect_proj] class is_left_cancel_add (G : Type u) [has_add G] : Prop := + (add_left_cancel : ∀ a b c : G, a + b = a + c → b = c) + +attribute [to_additive] is_left_cancel_mul + +/-- A mixin for right cancellative addition. -/ +@[protect_proj] class is_right_cancel_add (G : Type u) [has_add G] : Prop := + (add_right_cancel : ∀ a b c : G, a + b = c + b → a = c) + +attribute [to_additive] is_right_cancel_mul + +/-- A mixin for cancellative addition. -/ +class is_cancel_add (G : Type u) [has_add G] + extends is_left_cancel_add G, is_right_cancel_add G : Prop + +attribute [to_additive] is_cancel_mul + +section is_left_cancel_mul +variables [is_left_cancel_mul G] {a b c : G} + +@[to_additive] +lemma mul_left_cancel : a * b = a * c → b = c := +is_left_cancel_mul.mul_left_cancel a b c + +@[to_additive] +lemma mul_left_cancel_iff : a * b = a * c ↔ b = c := +⟨mul_left_cancel, congr_arg _⟩ + +@[to_additive] +theorem mul_right_injective (a : G) : function.injective ((*) a) := +λ b c, mul_left_cancel + +@[simp, to_additive] +theorem mul_right_inj (a : G) {b c : G} : a * b = a * c ↔ b = c := +(mul_right_injective a).eq_iff + +@[to_additive] +theorem mul_ne_mul_right (a : G) {b c : G} : a * b ≠ a * c ↔ b ≠ c := +(mul_right_injective a).ne_iff + +end is_left_cancel_mul + +section is_right_cancel_mul + +variables [is_right_cancel_mul G] {a b c : G} + +@[to_additive] +lemma mul_right_cancel : a * b = c * b → a = c := +is_right_cancel_mul.mul_right_cancel a b c + +@[to_additive] +lemma mul_right_cancel_iff : b * a = c * a ↔ b = c := +⟨mul_right_cancel, congr_arg _⟩ + +@[to_additive] +theorem mul_left_injective (a : G) : function.injective (λ x, x * a) := +λ b c, mul_right_cancel + +@[simp, to_additive] +theorem mul_left_inj (a : G) {b c : G} : b * a = c * a ↔ b = c := +(mul_left_injective a).eq_iff + +@[to_additive] +theorem mul_ne_mul_left (a : G) {b c : G} : b * a ≠ c * a ↔ b ≠ c := +(mul_left_injective a).ne_iff + +end is_right_cancel_mul + end has_mul /-- A semigroup is a type with an associative `(*)`. -/ @@ -144,6 +224,40 @@ comm_semigroup.mul_comm instance comm_semigroup.to_is_commutative : is_commutative G (*) := ⟨mul_comm⟩ +/-- Any `comm_semigroup G` that satisfies `is_right_cancel_mul G` also satisfies +`is_left_cancel_mul G`. -/ +@[to_additive add_comm_semigroup.is_right_cancel_add.to_is_left_cancel_add "Any +`add_comm_semigroup G` that satisfies `is_right_cancel_add G` also satisfies +`is_right_cancel_add G`."] +lemma comm_semigroup.is_right_cancel_mul.to_is_left_cancel_mul (G : Type u) [comm_semigroup G] + [is_right_cancel_mul G] : is_left_cancel_mul G := +⟨λ a b c h, mul_right_cancel $ (mul_comm _ _).trans (h.trans $ mul_comm _ _)⟩ + +/-- Any `comm_semigroup G` that satisfies `is_left_cancel_mul G` also satisfies +`is_right_cancel_mul G`. -/ +@[to_additive add_comm_semigroup.is_left_cancel_add.to_is_right_cancel_add "Any +`add_comm_semigroup G` that satisfies `is_left_cancel_add G` also satisfies +`is_left_cancel_add G`."] +lemma comm_semigroup.is_left_cancel_mul.to_is_right_cancel_mul (G : Type u) [comm_semigroup G] + [is_left_cancel_mul G] : is_right_cancel_mul G := +⟨λ a b c h, mul_left_cancel $ (mul_comm _ _).trans (h.trans $ mul_comm _ _)⟩ + +/-- Any `comm_semigroup G` that satisfies `is_left_cancel_mul G` also satisfies +`is_cancel_mul G`. -/ +@[to_additive add_comm_semigroup.is_left_cancel_add.to_is_cancel_add "Any `add_comm_semigroup G` +that satisfies `is_left_cancel_add G` also satisfies `is_cancel_add G`."] +lemma comm_semigroup.is_left_cancel_mul.to_is_cancel_mul (G : Type u) [comm_semigroup G] + [is_left_cancel_mul G] : is_cancel_mul G := +{ .. ‹is_left_cancel_mul G›, .. comm_semigroup.is_left_cancel_mul.to_is_right_cancel_mul G } + +/-- Any `comm_semigroup G` that satisfies `is_right_cancel_mul G` also satisfies +`is_cancel_mul G`. -/ +@[to_additive add_comm_semigroup.is_right_cancel_add.to_is_cancel_add "Any `add_comm_semigroup G` +that satisfies `is_right_cancel_add G` also satisfies `is_cancel_add G`."] +lemma comm_semigroup.is_right_cancel_mul.to_is_cancel_mul (G : Type u) [comm_semigroup G] + [is_right_cancel_mul G] : is_cancel_mul G := +{ .. ‹is_right_cancel_mul G›, .. comm_semigroup.is_right_cancel_mul.to_is_left_cancel_mul G } + end comm_semigroup /-- A `left_cancel_semigroup` is a semigroup such that `a * b = a * c` implies `b = c`. -/ @@ -157,30 +271,11 @@ class add_left_cancel_semigroup (G : Type u) extends add_semigroup G := (add_left_cancel : ∀ a b c : G, a + b = a + c → b = c) attribute [to_additive add_left_cancel_semigroup] left_cancel_semigroup -section left_cancel_semigroup -variables [left_cancel_semigroup G] {a b c : G} - -@[to_additive] -lemma mul_left_cancel : a * b = a * c → b = c := -left_cancel_semigroup.mul_left_cancel a b c - -@[to_additive] -lemma mul_left_cancel_iff : a * b = a * c ↔ b = c := -⟨mul_left_cancel, congr_arg _⟩ - -@[to_additive] -theorem mul_right_injective (a : G) : function.injective ((*) a) := -λ b c, mul_left_cancel - -@[simp, to_additive] -theorem mul_right_inj (a : G) {b c : G} : a * b = a * c ↔ b = c := -(mul_right_injective a).eq_iff - -@[to_additive] -theorem mul_ne_mul_right (a : G) {b c : G} : a * b ≠ a * c ↔ b ≠ c := -(mul_right_injective a).ne_iff - -end left_cancel_semigroup +/-- Any `left_cancel_semigroup` satisfies `is_left_cancel_mul`. -/ +@[priority 100, to_additive "Any `add_left_cancel_semigroup` satisfies `is_left_cancel_add`."] +instance left_cancel_semigroup.to_is_left_cancel_mul (G : Type u) [left_cancel_semigroup G] : + is_left_cancel_mul G := +{ mul_left_cancel := left_cancel_semigroup.mul_left_cancel } /-- A `right_cancel_semigroup` is a semigroup such that `a * b = c * b` implies `a = c`. -/ @[protect_proj, ancestor semigroup, ext] @@ -194,30 +289,11 @@ class add_right_cancel_semigroup (G : Type u) extends add_semigroup G := (add_right_cancel : ∀ a b c : G, a + b = c + b → a = c) attribute [to_additive add_right_cancel_semigroup] right_cancel_semigroup -section right_cancel_semigroup -variables [right_cancel_semigroup G] {a b c : G} - -@[to_additive] -lemma mul_right_cancel : a * b = c * b → a = c := -right_cancel_semigroup.mul_right_cancel a b c - -@[to_additive] -lemma mul_right_cancel_iff : b * a = c * a ↔ b = c := -⟨mul_right_cancel, congr_arg _⟩ - -@[to_additive] -theorem mul_left_injective (a : G) : function.injective (λ x, x * a) := -λ b c, mul_right_cancel - -@[simp, to_additive] -theorem mul_left_inj (a : G) {b c : G} : b * a = c * a ↔ b = c := -(mul_left_injective a).eq_iff - -@[to_additive] -theorem mul_ne_mul_left (a : G) {b c : G} : b * a ≠ c * a ↔ b ≠ c := -(mul_left_injective a).ne_iff - -end right_cancel_semigroup +/-- Any `right_cancel_semigroup` satisfies `is_right_cancel_mul`. -/ +@[priority 100, to_additive "Any `add_right_cancel_semigroup` satisfies `is_right_cancel_add`."] +instance right_cancel_semigroup.to_is_right_cancel_mul (G : Type u) [right_cancel_semigroup G] : + is_right_cancel_mul G := +{ mul_right_cancel := right_cancel_semigroup.mul_right_cancel } /-- Typeclass for expressing that a type `M` with multiplication and a one satisfies `1 * a = a` and `a * 1 = a` for all `a : M`. -/ @@ -264,8 +340,6 @@ instance mul_one_class.to_is_right_id : is_right_id M (*) 1 := end mul_one_class - - section variables {M : Type u} @@ -348,18 +422,18 @@ meta def try_refl_tac : tactic unit := `[intros; refl] An `add_monoid` has a natural `ℕ`-action, defined by `n • a = a + ... + a`, that we want to declare as an instance as it makes it possible to use the language of linear algebra. However, there are often other natural `ℕ`-actions. For instance, for any semiring `R`, the space of polynomials -`polynomial R` has a natural `R`-action defined by multiplication on the coefficients. This means -that `polynomial ℕ` would have two natural `ℕ`-actions, which are equal but not defeq. The same +`R[X]` has a natural `R`-action defined by multiplication on the coefficients. This means +that `ℕ[X]` would have two natural `ℕ`-actions, which are equal but not defeq. The same goes for linear maps, tensor products, and so on (and even for `ℕ` itself). To solve this issue, we embed an `ℕ`-action in the definition of an `add_monoid` (which is by default equal to the naive action `a + ... + a`, but can be adjusted when needed), and declare -a `has_scalar ℕ α` instance using this action. See Note [forgetful inheritance] for more +a `has_smul ℕ α` instance using this action. See Note [forgetful inheritance] for more explanations on this pattern. -For example, when we define `polynomial R`, then we declare the `ℕ`-action to be by multiplication +For example, when we define `R[X]`, then we declare the `ℕ`-action to be by multiplication on each coefficient (using the `ℕ`-action on `R` that comes from the fact that `R` is -an `add_monoid`). In this way, the two natural `has_scalar ℕ (polynomial ℕ)` instances are defeq. +an `add_monoid`). In this way, the two natural `has_smul ℕ ℕ[X]` instances are defeq. The tactic `to_additive` transfers definitions and results from multiplicative monoids to additive monoids. To work, it has to map fields to fields. This means that we should also add corresponding @@ -392,10 +466,10 @@ class monoid (M : Type u) extends semigroup M, mul_one_class M := instance monoid.has_pow {M : Type*} [monoid M] : has_pow M ℕ := ⟨λ x n, monoid.npow n x⟩ -instance add_monoid.has_scalar_nat {M : Type*} [add_monoid M] : has_scalar ℕ M := +instance add_monoid.has_smul_nat {M : Type*} [add_monoid M] : has_smul ℕ M := ⟨add_monoid.nsmul⟩ -attribute [to_additive add_monoid.has_scalar_nat] monoid.has_pow +attribute [to_additive add_monoid.has_smul_nat] monoid.has_pow section @@ -482,8 +556,13 @@ class cancel_comm_monoid (M : Type u) extends left_cancel_monoid M, comm_monoid @[priority 100, to_additive] -- see Note [lower instance priority] instance cancel_comm_monoid.to_cancel_monoid (M : Type u) [cancel_comm_monoid M] : cancel_monoid M := -{ mul_right_cancel := λ a b c h, mul_left_cancel $ by rw [mul_comm, h, mul_comm], - .. ‹cancel_comm_monoid M› } +{ .. ‹cancel_comm_monoid M›, .. comm_semigroup.is_left_cancel_mul.to_is_right_cancel_mul M } + +/-- Any `cancel_monoid M` satisfies `is_cancel_mul M`. -/ +@[priority 100, to_additive "Any `add_cancel_monoid M` satisfies `is_cancel_add M`."] +instance cancel_monoid.to_is_cancel_mul (M : Type u) [cancel_monoid M] : is_cancel_mul M := +{ mul_left_cancel := cancel_monoid.mul_left_cancel, + mul_right_cancel := cancel_monoid.mul_right_cancel } end cancel_monoid @@ -616,10 +695,10 @@ attribute [to_additive sub_neg_monoid] div_inv_monoid instance div_inv_monoid.has_pow {M} [div_inv_monoid M] : has_pow M ℤ := ⟨λ x n, div_inv_monoid.zpow n x⟩ -instance sub_neg_monoid.has_scalar_int {M} [sub_neg_monoid M] : has_scalar ℤ M := +instance sub_neg_monoid.has_smul_int {M} [sub_neg_monoid M] : has_smul ℤ M := ⟨sub_neg_monoid.zsmul⟩ -attribute [to_additive sub_neg_monoid.has_scalar_int] div_inv_monoid.has_pow +attribute [to_additive sub_neg_monoid.has_smul_int] div_inv_monoid.has_pow section div_inv_monoid variables [div_inv_monoid G] {a b : G} @@ -659,6 +738,38 @@ alias div_eq_mul_inv ← division_def end div_inv_monoid +section inv_one_class + +set_option extends_priority 50 + +/-- Typeclass for expressing that `-0 = 0`. -/ +class neg_zero_class (G : Type*) extends has_zero G, has_neg G := +(neg_zero : -(0 : G) = 0) + +/-- A `sub_neg_monoid` where `-0 = 0`. -/ +class sub_neg_zero_monoid (G : Type*) extends sub_neg_monoid G, neg_zero_class G + +/-- Typeclass for expressing that `1⁻¹ = 1`. -/ +@[to_additive] +class inv_one_class (G : Type*) extends has_one G, has_inv G := +(inv_one : (1 : G)⁻¹ = 1) + +attribute [to_additive neg_zero_class.to_has_neg] inv_one_class.to_has_inv +attribute [to_additive neg_zero_class.to_has_zero] inv_one_class.to_has_one + +/-- A `div_inv_monoid` where `1⁻¹ = 1`. -/ +@[to_additive sub_neg_zero_monoid] +class div_inv_one_monoid (G : Type*) extends div_inv_monoid G, inv_one_class G + +attribute [to_additive sub_neg_zero_monoid.to_sub_neg_monoid] div_inv_one_monoid.to_div_inv_monoid +attribute [to_additive sub_neg_zero_monoid.to_neg_zero_class] div_inv_one_monoid.to_inv_one_class + +variables [inv_one_class G] + +@[simp, to_additive] lemma inv_one : (1 : G)⁻¹ = 1 := inv_one_class.inv_one + +end inv_one_class + /-- A `subtraction_monoid` is a `sub_neg_monoid` with involutive negation and such that `-(a + b) = -b + -a` and `a + b = 0 → -a = b`. -/ @[protect_proj, ancestor sub_neg_monoid has_involutive_neg] @@ -672,7 +783,7 @@ involutivity of negation. -/ `(a * b)⁻¹ = b⁻¹ * a⁻¹` and `a * b = 1 → a⁻¹ = b`. This is the immediate common ancestor of `group` and `group_with_zero`. -/ -@[protect_proj, ancestor div_inv_monoid has_involutive_inv, to_additive subtraction_monoid] +@[protect_proj, ancestor div_inv_monoid has_involutive_inv, to_additive] class division_monoid (G : Type u) extends div_inv_monoid G, has_involutive_inv G := (mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹) /- Despite the asymmetry of `inv_eq_of_mul`, the symmetric version is true thanks to the @@ -688,9 +799,6 @@ division_monoid.mul_inv_rev _ _ @[to_additive] lemma inv_eq_of_mul_eq_one_right : a * b = 1 → a⁻¹ = b := division_monoid.inv_eq_of_mul _ _ -@[simp, to_additive] -lemma inv_eq_of_mul_eq_one : a * b = 1 → a⁻¹ = b := division_monoid.inv_eq_of_mul _ _ - end division_monoid /-- Commutative `subtraction_monoid`. -/ @@ -767,7 +875,7 @@ by rw [mul_assoc, mul_right_inv, mul_one] @[simp, to_additive] lemma inv_mul_cancel_right (a b : G) : a * b⁻¹ * b = a := by rw [mul_assoc, mul_left_inv, mul_one] -@[priority 100, to_additive] +@[priority 100, to_additive add_group.to_subtraction_monoid] instance group.to_division_monoid : division_monoid G := { inv_inv := λ a, inv_eq_of_mul (mul_left_inv a), mul_inv_rev := λ a b, inv_eq_of_mul $ by rw [mul_assoc, mul_inv_cancel_left, mul_right_inv], @@ -785,13 +893,7 @@ end group @[to_additive] lemma group.to_div_inv_monoid_injective {G : Type*} : function.injective (@group.to_div_inv_monoid G) := -begin - rintros ⟨⟩ ⟨⟩ h, - replace h := div_inv_monoid.mk.inj h, - dsimp at h, - rcases h with ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩, - refl -end +by { rintros ⟨⟩ ⟨⟩ ⟨⟩, refl } /-- A commutative group is a group with commutative `(*)`. -/ @[protect_proj, ancestor group comm_monoid] @@ -805,13 +907,7 @@ attribute [instance, priority 300] add_comm_group.to_add_comm_monoid @[to_additive] lemma comm_group.to_group_injective {G : Type u} : function.injective (@comm_group.to_group G) := -begin - rintros ⟨⟩ ⟨⟩ h, - replace h := group.mk.inj h, - dsimp at h, - rcases h with ⟨rfl, rfl, rfl, rfl, rfl, rfl⟩, - refl -end +by { rintros ⟨⟩ ⟨⟩ ⟨⟩, refl } section comm_group diff --git a/src/algebra/group/ext.lean b/src/algebra/group/ext.lean index 4371ab068a610..94cd7bb95a965 100644 --- a/src/algebra/group/ext.lean +++ b/src/algebra/group/ext.lean @@ -8,6 +8,9 @@ import algebra.hom.group /-! # Extensionality lemmas for monoid and group structures +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove extensionality lemmas for `monoid` and higher algebraic structures with one binary operation. Extensionality lemmas for structures that are lower in the hierarchy can be found in `algebra.group.defs`. @@ -125,7 +128,7 @@ begin set f := @monoid_hom.mk' G G (by letI := g₁; apply_instance) g₂ id (λ a b, congr_fun (congr_fun h_mul a) b), exact group.to_div_inv_monoid_injective (div_inv_monoid.ext h_mul - (funext $ @monoid_hom.map_inv G G g₁ g₂ f)) + (funext $ @monoid_hom.map_inv G G g₁ (@group.to_division_monoid _ g₂) f)) end @[ext, to_additive] diff --git a/src/algebra/group/inj_surj.lean b/src/algebra/group/inj_surj.lean index adf7573df1312..68f1acbe5576b 100644 --- a/src/algebra/group/inj_surj.lean +++ b/src/algebra/group/inj_surj.lean @@ -5,10 +5,14 @@ Authors: Johan Commelin -/ import algebra.group.defs import logic.function.basic +import data.int.cast.basic /-! # Lifting algebraic data classes along injective/surjective maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides definitions that are meant to deal with situations such as the following: @@ -106,7 +110,7 @@ See note [reducible non-instances]. -/ @[reducible, to_additive "A type endowed with `0` and `+` is an additive monoid, if it admits an injective map that preserves `0` and `+` to an additive monoid. -This version takes a custom `nsmul` as a `[has_scalar ℕ M₁]` argument."] +This version takes a custom `nsmul` as a `[has_smul ℕ M₁]` argument."] protected def monoid [monoid M₂] (f : M₁ → M₂) (hf : injective f) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : monoid M₁ := @@ -115,6 +119,22 @@ protected def monoid [monoid M₂] (f : M₁ → M₂) (hf : injective f) npow_succ' := λ n x, hf $ by erw [npow, pow_succ, mul, npow], .. hf.semigroup f mul, .. hf.mul_one_class f one mul } +/-- A type endowed with `0`, `1` and `+` is an additive monoid with one, +if it admits an injective map that preserves `0`, `1` and `+` to an additive monoid with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_monoid_with_one {M₁} + [has_zero M₁] [has_one M₁] [has_add M₁] [has_smul ℕ M₁] [has_nat_cast M₁] + [add_monoid_with_one M₂] (f : M₁ → M₂) (hf : injective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) : + add_monoid_with_one M₁ := +{ nat_cast := coe, + nat_cast_zero := hf (by erw [nat_cast, nat.cast_zero, zero]), + nat_cast_succ := λ n, hf (by erw [nat_cast, nat.cast_succ, add, one, nat_cast]), + one := 1, .. hf.add_monoid f zero add nsmul } + /-- A type endowed with `1` and `*` is a left cancel monoid, if it admits an injective map that preserves `1` and `*` to a left cancel monoid. See note [reducible non-instances]. -/ @@ -159,6 +179,17 @@ protected def comm_monoid [comm_monoid M₂] (f : M₁ → M₂) (hf : injective comm_monoid M₁ := { .. hf.comm_semigroup f mul, .. hf.monoid f one mul npow } +/-- A type endowed with `0`, `1` and `+` is an additive commutative monoid with one, if it admits an +injective map that preserves `0`, `1` and `+` to an additive commutative monoid with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_comm_monoid_with_one {M₁} [has_zero M₁] [has_one M₁] [has_add M₁] [has_smul ℕ M₁] + [has_nat_cast M₁] [add_comm_monoid_with_one M₂] (f : M₁ → M₂) (hf : injective f) (zero : f 0 = 0) + (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) : + add_comm_monoid_with_one M₁ := +{ ..hf.add_monoid_with_one f zero one add nsmul nat_cast, ..hf.add_comm_monoid f zero add nsmul } + /-- A type endowed with `1` and `*` is a cancel commutative monoid, if it admits an injective map that preserves `1` and `*` to a cancel commutative monoid. See note [reducible non-instances]. -/ @@ -189,8 +220,8 @@ See note [reducible non-instances]. -/ "A type endowed with `0`, `+`, unary `-`, and binary `-` is a `sub_neg_monoid` if it admits an injective map that preserves `0`, `+`, unary `-`, and binary `-` to a `sub_neg_monoid`. -This version takes custom `nsmul` and `zsmul` as `[has_scalar ℕ M₁]` and -`[has_scalar ℤ M₁]` arguments."] +This version takes custom `nsmul` and `zsmul` as `[has_smul ℕ M₁]` and +`[has_smul ℤ M₁]` arguments."] protected def div_inv_monoid [div_inv_monoid M₂] (f : M₁ → M₂) (hf : injective f) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) @@ -206,19 +237,19 @@ protected def div_inv_monoid [div_inv_monoid M₂] /-- A type endowed with `1`, `*`, `⁻¹`, and `/` is a `division_monoid` if it admits an injective map that preserves `1`, `*`, `⁻¹`, and `/` to a `division_monoid`. -/ -@[reducible, to_additive subtraction_monoid +@[reducible, to_additive "A type endowed with `0`, `+`, unary `-`, and binary `-` is a `subtraction_monoid` if it admits an injective map that preserves `0`, `+`, unary `-`, and binary `-` to a `subtraction_monoid`. -This version takes custom `nsmul` and `zsmul` as `[has_scalar ℕ M₁]` and -`[has_scalar ℤ M₁]` arguments."] -- See note [reducible non-instances] +This version takes custom `nsmul` and `zsmul` as `[has_smul ℕ M₁]` and +`[has_smul ℤ M₁]` arguments."] -- See note [reducible non-instances] protected def division_monoid [division_monoid M₂] (f : M₁ → M₂) (hf : injective f) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : division_monoid M₁ := { mul_inv_rev := λ x y, hf $ by erw [inv, mul, mul_inv_rev, mul, inv, inv], - inv_eq_of_mul := λ x y h, hf $ by erw [inv, inv_eq_of_mul_eq_one (by erw [←mul, h, one])], + inv_eq_of_mul := λ x y h, hf $ by erw [inv, inv_eq_of_mul_eq_one_right (by erw [←mul, h, one])], ..hf.div_inv_monoid f one mul inv div npow zpow, ..hf.has_involutive_inv f inv } /-- A type endowed with `1`, `*`, `⁻¹`, and `/` is a `division_comm_monoid` @@ -228,8 +259,8 @@ See note [reducible non-instances]. -/ "A type endowed with `0`, `+`, unary `-`, and binary `-` is a `subtraction_comm_monoid` if it admits an injective map that preserves `0`, `+`, unary `-`, and binary `-` to a `subtraction_comm_monoid`. -This version takes custom `nsmul` and `zsmul` as `[has_scalar ℕ M₁]` and -`[has_scalar ℤ M₁]` arguments."] -- See note [reducible non-instances] +This version takes custom `nsmul` and `zsmul` as `[has_smul ℕ M₁]` and +`[has_smul ℤ M₁]` arguments."] -- See note [reducible non-instances] protected def division_comm_monoid [division_comm_monoid M₂] (f : M₁ → M₂) (hf : injective f) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) @@ -251,6 +282,25 @@ protected def group [group M₂] (f : M₁ → M₂) (hf : injective f) { mul_left_inv := λ x, hf $ by erw [mul, inv, mul_left_inv, one], .. hf.div_inv_monoid f one mul inv div npow zpow } +/-- A type endowed with `0`, `1` and `+` is an additive group with one, +if it admits an injective map that preserves `0`, `1` and `+` to an additive group with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_group_with_one {M₁} [has_zero M₁] [has_one M₁] [has_add M₁] [has_smul ℕ M₁] + [has_neg M₁] [has_sub M₁] [has_smul ℤ M₁] [has_nat_cast M₁] [has_int_cast M₁] + [add_group_with_one M₂] (f : M₁ → M₂) (hf : injective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + add_group_with_one M₁ := +{ int_cast := coe, + int_cast_of_nat := λ n, hf (by simp only [nat_cast, int_cast, int.cast_coe_nat]), + int_cast_neg_succ_of_nat := + λ n, hf (by erw [int_cast, neg, nat_cast, int.cast_neg, int.cast_coe_nat]), + .. hf.add_group f zero add neg sub nsmul zsmul, + .. hf.add_monoid_with_one f zero one add nsmul nat_cast } + /-- A type endowed with `1`, `*` and `⁻¹` is a commutative group, if it admits an injective map that preserves `1`, `*` and `⁻¹` to a commutative group. See note [reducible non-instances]. -/ @@ -264,6 +314,21 @@ protected def comm_group [comm_group M₂] (f : M₁ → M₂) (hf : injective f comm_group M₁ := { .. hf.comm_monoid f one mul npow, .. hf.group f one mul inv div npow zpow } +/-- A type endowed with `0`, `1` and `+` is an additive commutative group with one, if it admits an +injective map that preserves `0`, `1` and `+` to an additive commutative group with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_comm_group_with_one {M₁} [has_zero M₁] [has_one M₁] [has_add M₁] [has_smul ℕ M₁] + [has_neg M₁] [has_sub M₁] [has_smul ℤ M₁] [has_nat_cast M₁] [has_int_cast M₁] + [add_comm_group_with_one M₂] (f : M₁ → M₂) (hf : injective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + add_comm_group_with_one M₁ := +{ ..hf.add_group_with_one f zero one add neg sub nsmul zsmul nat_cast int_cast, + ..hf.add_comm_monoid f zero add nsmul } + end injective /-! @@ -320,7 +385,7 @@ See note [reducible non-instances]. -/ @[reducible, to_additive "A type endowed with `0` and `+` is an additive monoid, if it admits a surjective map that preserves `0` and `+` to an additive monoid. -This version takes a custom `nsmul` as a `[has_scalar ℕ M₂]` argument."] +This version takes a custom `nsmul` as a `[has_smul ℕ M₂]` argument."] protected def monoid [monoid M₁] (f : M₁ → M₂) (hf : surjective f) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : monoid M₂ := @@ -329,6 +394,22 @@ protected def monoid [monoid M₁] (f : M₁ → M₂) (hf : surjective f) npow_succ' := λ n, hf.forall.2 $ λ x, by erw [←npow, pow_succ, ←npow, ←mul], .. hf.semigroup f mul, .. hf.mul_one_class f one mul } +/-- A type endowed with `0`, `1` and `+` is an additive monoid with one, +if it admits a surjective map that preserves `0`, `1` and `*` from an additive monoid with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_monoid_with_one + {M₂} [has_zero M₂] [has_one M₂] [has_add M₂] [has_smul ℕ M₂] [has_nat_cast M₂] + [add_monoid_with_one M₁] (f : M₁ → M₂) (hf : surjective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) : + add_monoid_with_one M₂ := +{ nat_cast := coe, + nat_cast_zero := by { rw [← nat_cast, nat.cast_zero, zero], refl }, + nat_cast_succ := λ n, by { rw [← nat_cast, nat.cast_succ, add, one, nat_cast], refl }, + one := 1, .. hf.add_monoid f zero add nsmul } + /-- A type endowed with `1` and `*` is a commutative monoid, if it admits a surjective map that preserves `1` and `*` from a commutative monoid. See note [reducible non-instances]. -/ @@ -340,6 +421,19 @@ protected def comm_monoid [comm_monoid M₁] (f : M₁ → M₂) (hf : surjectiv comm_monoid M₂ := { .. hf.comm_semigroup f mul, .. hf.monoid f one mul npow } +/-- A type endowed with `0`, `1` and `+` is an additive monoid with one, +if it admits a surjective map that preserves `0`, `1` and `*` from an additive monoid with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_comm_monoid_with_one + {M₂} [has_zero M₂] [has_one M₂] [has_add M₂] [has_smul ℕ M₂] [has_nat_cast M₂] + [add_comm_monoid_with_one M₁] (f : M₁ → M₂) (hf : surjective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) : + add_comm_monoid_with_one M₂ := +{ ..hf.add_monoid_with_one f zero one add nsmul nat_cast, ..hf.add_comm_monoid _ zero _ nsmul } + /-- A type has an involutive inversion if it admits a surjective map that preserves `⁻¹` to a type which has an involutive inversion. -/ @[reducible, to_additive "A type has an involutive negation if it admits a surjective map that @@ -388,6 +482,26 @@ protected def group [group M₁] (f : M₁ → M₂) (hf : surjective f) { mul_left_inv := hf.forall.2 $ λ x, by erw [← inv, ← mul, mul_left_inv, one]; refl, .. hf.div_inv_monoid f one mul inv div npow zpow } +/-- A type endowed with `0`, `1`, `+` is an additive group with one, +if it admits a surjective map that preserves `0`, `1`, and `+` to an additive group with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_group_with_one + {M₂} [has_zero M₂] [has_one M₂] [has_add M₂] [has_neg M₂] [has_sub M₂] + [has_smul ℕ M₂] [has_smul ℤ M₂] [has_nat_cast M₂] [has_int_cast M₂] + [add_group_with_one M₁] (f : M₁ → M₂) (hf : surjective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + add_group_with_one M₂ := +{ int_cast := coe, + int_cast_of_nat := λ n, by rw [← int_cast, int.cast_coe_nat, nat_cast], + int_cast_neg_succ_of_nat := λ n, + by { rw [← int_cast, int.cast_neg, int.cast_coe_nat, neg, nat_cast], refl }, + .. hf.add_monoid_with_one f zero one add nsmul nat_cast, + .. hf.add_group f zero add neg sub nsmul zsmul } + /-- A type endowed with `1`, `*`, `⁻¹`, and `/` is a commutative group, if it admits a surjective map that preserves `1`, `*`, `⁻¹`, and `/` from a commutative group. See note [reducible non-instances]. -/ @@ -401,6 +515,22 @@ protected def comm_group [comm_group M₁] (f : M₁ → M₂) (hf : surjective comm_group M₂ := { .. hf.comm_monoid f one mul npow, .. hf.group f one mul inv div npow zpow } +/-- A type endowed with `0`, `1`, `+` is an additive commutative group with one, if it admits a +surjective map that preserves `0`, `1`, and `+` to an additive commutative group with one. +See note [reducible non-instances]. -/ +@[reducible] +protected def add_comm_group_with_one + {M₂} [has_zero M₂] [has_one M₂] [has_add M₂] [has_neg M₂] [has_sub M₂] + [has_smul ℕ M₂] [has_smul ℤ M₂] [has_nat_cast M₂] [has_int_cast M₂] + [add_comm_group_with_one M₁] (f : M₁ → M₂) (hf : surjective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + add_comm_group_with_one M₂ := +{ ..hf.add_group_with_one f zero one add neg sub nsmul zsmul nat_cast int_cast, + ..hf.add_comm_monoid _ zero add nsmul } + end surjective end function diff --git a/src/algebra/group/opposite.lean b/src/algebra/group/opposite.lean index f481a76f59aa5..11891aa81b415 100644 --- a/src/algebra/group/opposite.lean +++ b/src/algebra/group/opposite.lean @@ -5,11 +5,15 @@ Authors: Kenny Lau -/ import algebra.group.inj_surj import algebra.group.commute -import algebra.hom.equiv +import algebra.hom.equiv.basic import algebra.opposites +import data.int.cast.defs /-! # Group structures on the multiplicative and additive opposites + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v variables (α : Type u) @@ -20,6 +24,9 @@ namespace mul_opposite ### Additive structures on `αᵐᵒᵖ` -/ +@[to_additive] instance [has_nat_cast α] : has_nat_cast αᵐᵒᵖ := ⟨λ n, op n⟩ +@[to_additive] instance [has_int_cast α] : has_int_cast αᵐᵒᵖ := ⟨λ n, op n⟩ + instance [add_semigroup α] : add_semigroup (αᵐᵒᵖ) := unop_injective.add_semigroup _ (λ x y, rfl) @@ -41,6 +48,14 @@ unop_injective.add_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) instance [add_comm_monoid α] : add_comm_monoid αᵐᵒᵖ := unop_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) +instance [add_monoid_with_one α] : add_monoid_with_one αᵐᵒᵖ := +{ nat_cast_zero := show op ((0 : ℕ) : α) = 0, by rw [nat.cast_zero, op_zero], + nat_cast_succ := show ∀ n, op ((n + 1 : ℕ) : α) = op (n : ℕ) + 1, by simp, + .. mul_opposite.add_monoid α, .. mul_opposite.has_one α, ..mul_opposite.has_nat_cast _ } + +instance [add_comm_monoid_with_one α] : add_comm_monoid_with_one αᵐᵒᵖ := +{ .. mul_opposite.add_monoid_with_one α, ..mul_opposite.add_comm_monoid α } + instance [sub_neg_monoid α] : sub_neg_monoid αᵐᵒᵖ := unop_injective.sub_neg_monoid _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) @@ -50,6 +65,16 @@ unop_injective.add_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, instance [add_comm_group α] : add_comm_group αᵐᵒᵖ := unop_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) +instance [add_group_with_one α] : add_group_with_one αᵐᵒᵖ := +{ int_cast := λ n, op n, + int_cast_of_nat := λ n, show op ((n : ℤ) : α) = op n, by rw int.cast_coe_nat, + int_cast_neg_succ_of_nat := λ n, show op _ = op (- unop (op ((n + 1 : ℕ) : α))), + by erw [unop_op, int.cast_neg_succ_of_nat]; refl, + .. mul_opposite.add_monoid_with_one α, .. mul_opposite.add_group α } + +instance [add_comm_group_with_one α] : add_comm_group_with_one αᵐᵒᵖ := +{ .. mul_opposite.add_group_with_one α, ..mul_opposite.add_comm_group α } + /-! ### Multiplicative structures on `αᵐᵒᵖ` @@ -98,7 +123,7 @@ We also generate additive structures on `αᵃᵒᵖ` using `to_additive` @[to_additive] instance [cancel_comm_monoid α] : cancel_comm_monoid αᵐᵒᵖ := { .. mul_opposite.cancel_monoid α, .. mul_opposite.comm_monoid α } -@[to_additive] instance [div_inv_monoid α] : div_inv_monoid αᵐᵒᵖ := +@[to_additive add_opposite.sub_neg_monoid] instance [div_inv_monoid α] : div_inv_monoid αᵐᵒᵖ := { zpow := λ n x, op $ x.unop ^ n, zpow_zero' := λ x, unop_injective $ div_inv_monoid.zpow_zero' x.unop, zpow_succ' := λ n x, unop_injective $ @@ -106,6 +131,16 @@ We also generate additive structures on `αᵃᵒᵖ` using `to_additive` zpow_neg' := λ z x, unop_injective $ div_inv_monoid.zpow_neg' z x.unop, .. mul_opposite.monoid α, .. mul_opposite.has_inv α } +@[to_additive add_opposite.subtraction_monoid] instance [division_monoid α] : + division_monoid αᵐᵒᵖ := +{ mul_inv_rev := λ a b, unop_injective $ mul_inv_rev _ _, + inv_eq_of_mul := λ a b h, unop_injective $ inv_eq_of_mul_eq_one_left $ congr_arg unop h, + .. mul_opposite.div_inv_monoid α, .. mul_opposite.has_involutive_inv α } + +@[to_additive add_opposite.subtraction_comm_monoid] instance [division_comm_monoid α] : + division_comm_monoid αᵐᵒᵖ := +{ ..mul_opposite.division_monoid α, ..mul_opposite.comm_semigroup α } + @[to_additive] instance [group α] : group αᵐᵒᵖ := { mul_left_inv := λ x, unop_injective $ mul_inv_self $ unop x, .. mul_opposite.div_inv_monoid α, } @@ -115,6 +150,15 @@ We also generate additive structures on `αᵃᵒᵖ` using `to_additive` variable {α} +@[simp, norm_cast, to_additive] lemma op_nat_cast [has_nat_cast α] (n : ℕ) : op (n : α) = n := rfl +@[simp, norm_cast, to_additive] lemma op_int_cast [has_int_cast α] (n : ℤ) : op (n : α) = n := rfl + +@[simp, norm_cast, to_additive] +lemma unop_nat_cast [has_nat_cast α] (n : ℕ) : unop (n : αᵐᵒᵖ) = n := rfl + +@[simp, norm_cast, to_additive] +lemma unop_int_cast [has_int_cast α] (n : ℤ) : unop (n : αᵐᵒᵖ) = n := rfl + @[simp, to_additive] lemma unop_div [div_inv_monoid α] (x y : αᵐᵒᵖ) : unop (x / y) = (unop y)⁻¹ * unop x := rfl @@ -205,6 +249,19 @@ unop_injective.group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) instance [comm_group α] : comm_group αᵃᵒᵖ := unop_injective.comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) +-- NOTE: `add_monoid_with_one α → add_monoid_with_one αᵃᵒᵖ` does not hold + +instance [add_comm_monoid_with_one α] : add_comm_monoid_with_one αᵃᵒᵖ := +{ nat_cast_zero := show op ((0 : ℕ) : α) = 0, by rw [nat.cast_zero, op_zero], + nat_cast_succ := show ∀ n, op ((n + 1 : ℕ) : α) = op (n : ℕ) + 1, by simp [add_comm], + ..add_opposite.add_comm_monoid α, ..add_opposite.has_one, ..add_opposite.has_nat_cast _ } + +instance [add_comm_group_with_one α] : add_comm_group_with_one αᵃᵒᵖ := +{ int_cast_of_nat := λ n, congr_arg op $ int.cast_of_nat n, + int_cast_neg_succ_of_nat := λ _, congr_arg op $ int.cast_neg_succ_of_nat _, + ..add_opposite.add_comm_monoid_with_one _, ..add_opposite.add_comm_group α, + ..add_opposite.has_int_cast α } + variable {α} /-- The function `add_opposite.op` is a multiplicative equivalence. -/ @@ -224,7 +281,7 @@ open mul_opposite `mul_equiv.inv`. -/ @[to_additive "Negation on an additive group is an `add_equiv` to the opposite group. When `G` is commutative, there is `add_equiv.inv`.", simps { fully_applied := ff, simp_rhs := tt }] -def mul_equiv.inv' (G : Type*) [group G] : G ≃* Gᵐᵒᵖ := +def mul_equiv.inv' (G : Type*) [division_monoid G] : G ≃* Gᵐᵒᵖ := { map_mul' := λ x y, unop_injective $ mul_inv_rev x y, .. (equiv.inv G).trans op_equiv } @@ -290,6 +347,21 @@ lemma units.coe_op_equiv_symm {M} [monoid M] (u : (Mˣ)ᵐᵒᵖ) : (units.op_equiv.symm u : Mᵐᵒᵖ) = op (u.unop : M) := rfl +@[to_additive] +lemma is_unit.op {M} [monoid M] {m : M} (h : is_unit m) : is_unit (op m) := +let ⟨u, hu⟩ := h in hu ▸ ⟨units.op_equiv.symm (op u), rfl⟩ + +@[to_additive] +lemma is_unit.unop {M} [monoid M] {m : Mᵐᵒᵖ} (h : is_unit m) : is_unit (unop m) := +let ⟨u, hu⟩ := h in hu ▸ ⟨unop (units.op_equiv u), rfl⟩ + +@[simp, to_additive] +lemma is_unit_op {M} [monoid M] {m : M} : is_unit (op m) ↔ is_unit m := ⟨is_unit.unop, is_unit.op⟩ + +@[simp, to_additive] +lemma is_unit_unop {M} [monoid M] {m : Mᵐᵒᵖ} : is_unit (unop m) ↔ is_unit m := +⟨is_unit.op, is_unit.unop⟩ + /-- A semigroup homomorphism `M →ₙ* N` can equivalently be viewed as a semigroup homomorphism `Mᵐᵒᵖ →ₙ* Nᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/ @[to_additive "An additive semigroup homomorphism `add_hom M N` can equivalently be viewed as an diff --git a/src/algebra/group/order_synonym.lean b/src/algebra/group/order_synonym.lean new file mode 100644 index 0000000000000..03147174e634e --- /dev/null +++ b/src/algebra/group/order_synonym.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2021 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Yaël Dillies +-/ + +import algebra.group.defs +import order.synonym + +/-! +# Group structure on the order type synonyms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Transfer algebraic instances from `α` to `αᵒᵈ` and `lex α`. +-/ + +open order_dual + +variables {α β : Type*} + +/-! ### `order_dual` -/ + +@[to_additive] instance [h : has_one α] : has_one αᵒᵈ := h +@[to_additive] instance [h : has_mul α] : has_mul αᵒᵈ := h +@[to_additive] instance [h : has_inv α] : has_inv αᵒᵈ := h +@[to_additive] instance [h : has_div α] : has_div αᵒᵈ := h +@[to_additive] instance [h : has_smul α β] : has_smul α βᵒᵈ := h +@[to_additive] instance order_dual.has_smul' [h : has_smul α β] : has_smul αᵒᵈ β := h +@[to_additive order_dual.has_smul] +instance order_dual.has_pow [h : has_pow α β] : has_pow αᵒᵈ β := h +@[to_additive order_dual.has_smul'] +instance order_dual.has_pow' [h : has_pow α β] : has_pow α βᵒᵈ := h +@[to_additive] instance [h : semigroup α] : semigroup αᵒᵈ := h +@[to_additive] instance [h : comm_semigroup α] : comm_semigroup αᵒᵈ := h +@[to_additive] instance [h : left_cancel_semigroup α] : left_cancel_semigroup αᵒᵈ := h +@[to_additive] instance [h : right_cancel_semigroup α] : right_cancel_semigroup αᵒᵈ := h +@[to_additive] instance [h : mul_one_class α] : mul_one_class αᵒᵈ := h +@[to_additive] instance [h : monoid α] : monoid αᵒᵈ := h +@[to_additive] instance [h : comm_monoid α] : comm_monoid αᵒᵈ := h +@[to_additive] instance [h : left_cancel_monoid α] : left_cancel_monoid αᵒᵈ := h +@[to_additive] instance [h : right_cancel_monoid α] : right_cancel_monoid αᵒᵈ := h +@[to_additive] instance [h : cancel_monoid α] : cancel_monoid αᵒᵈ := h +@[to_additive] instance [h : cancel_comm_monoid α] : cancel_comm_monoid αᵒᵈ := h +@[to_additive] instance [h : has_involutive_inv α] : has_involutive_inv αᵒᵈ := h +@[to_additive] instance [h : div_inv_monoid α] : div_inv_monoid αᵒᵈ := h +@[to_additive order_dual.subtraction_monoid] +instance [h : division_monoid α] : division_monoid αᵒᵈ := h +@[to_additive order_dual.subtraction_comm_monoid] +instance [h : division_comm_monoid α] : division_comm_monoid αᵒᵈ := h +@[to_additive] instance [h : group α] : group αᵒᵈ := h +@[to_additive] instance [h : comm_group α] : comm_group αᵒᵈ := h + +@[simp, to_additive] lemma to_dual_one [has_one α] : to_dual (1 : α) = 1 := rfl +@[simp, to_additive] lemma of_dual_one [has_one α] : (of_dual 1 : α) = 1 := rfl +@[simp, to_additive] +lemma to_dual_mul [has_mul α] (a b : α) : to_dual (a * b) = to_dual a * to_dual b := rfl +@[simp, to_additive] +lemma of_dual_mul [has_mul α] (a b : αᵒᵈ) : of_dual (a * b) = of_dual a * of_dual b := rfl +@[simp, to_additive] lemma to_dual_inv [has_inv α] (a : α) : to_dual a⁻¹ = (to_dual a)⁻¹ := rfl +@[simp, to_additive] lemma of_dual_inv [has_inv α] (a : αᵒᵈ) : of_dual a⁻¹ = (of_dual a)⁻¹ := rfl +@[simp, to_additive] +lemma to_dual_div [has_div α] (a b : α) : to_dual (a / b) = to_dual a / to_dual b := rfl +@[simp, to_additive] +lemma of_dual_div [has_div α] (a b : αᵒᵈ) : of_dual (a / b) = of_dual a / of_dual b := rfl +@[simp, to_additive] +lemma to_dual_smul [has_smul α β] (a : α) (b : β) : to_dual (a • b) = a • to_dual b := rfl +@[simp, to_additive] +lemma of_dual_smul [has_smul α β] (a : α) (b : βᵒᵈ) : of_dual (a • b) = a • of_dual b := rfl +@[simp, to_additive] +lemma to_dual_smul' [has_smul α β] (a : α) (b : β) : to_dual a • b = a • b := rfl +@[simp, to_additive] +lemma of_dual_smul' [has_smul α β] (a : αᵒᵈ) (b : β) : of_dual a • b = a • b := rfl +@[simp, to_additive to_dual_smul, to_additive_reorder 1 4] +lemma to_dual_pow [has_pow α β] (a : α) (b : β) : to_dual (a ^ b) = to_dual a ^ b := rfl +@[simp, to_additive of_dual_smul, to_additive_reorder 1 4] +lemma of_dual_pow [has_pow α β] (a : αᵒᵈ) (b : β) : of_dual (a ^ b) = of_dual a ^ b := rfl +@[simp, to_additive to_dual_smul', to_additive_reorder 1 4] +lemma pow_to_dual [has_pow α β] (a : α) (b : β) : a ^ to_dual b = a ^ b := rfl +@[simp, to_additive of_dual_smul', to_additive_reorder 1 4] +lemma pow_of_dual [has_pow α β] (a : α) (b : βᵒᵈ) : a ^ of_dual b = a ^ b := rfl + +/-! ### Lexicographical order -/ + +@[to_additive] instance [h : has_one α] : has_one (lex α) := h +@[to_additive] instance [h : has_mul α] : has_mul (lex α) := h +@[to_additive] instance [h : has_inv α] : has_inv (lex α) := h +@[to_additive] instance [h : has_div α] : has_div (lex α) := h +@[to_additive] instance [h : has_smul α β] : has_smul α (lex β) := h +@[to_additive] instance lex.has_smul' [h : has_smul α β] : has_smul (lex α) β := h +@[to_additive lex.has_smul] instance lex.has_pow [h : has_pow α β] : has_pow (lex α) β := h +@[to_additive lex.has_smul'] instance lex.has_pow' [h : has_pow α β] : has_pow α (lex β) := h +@[to_additive] instance [h : semigroup α] : semigroup (lex α) := h +@[to_additive] instance [h : comm_semigroup α] : comm_semigroup (lex α) := h +@[to_additive] instance [h : left_cancel_semigroup α] : left_cancel_semigroup (lex α) := h +@[to_additive] instance [h : right_cancel_semigroup α] : right_cancel_semigroup (lex α) := h +@[to_additive] instance [h : mul_one_class α] : mul_one_class (lex α) := h +@[to_additive] instance [h : monoid α] : monoid (lex α) := h +@[to_additive] instance [h : comm_monoid α] : comm_monoid (lex α) := h +@[to_additive] instance [h : left_cancel_monoid α] : left_cancel_monoid (lex α) := h +@[to_additive] instance [h : right_cancel_monoid α] : right_cancel_monoid (lex α) := h +@[to_additive] instance [h : cancel_monoid α] : cancel_monoid (lex α) := h +@[to_additive] instance [h : cancel_comm_monoid α] : cancel_comm_monoid (lex α) := h +@[to_additive] instance [h : has_involutive_inv α] : has_involutive_inv (lex α) := h +@[to_additive] instance [h : div_inv_monoid α] : div_inv_monoid (lex α) := h +@[to_additive order_dual.subtraction_monoid] +instance [h : division_monoid α] : division_monoid (lex α) := h +@[to_additive order_dual.subtraction_comm_monoid] +instance [h : division_comm_monoid α] : division_comm_monoid (lex α) := h +@[to_additive] instance [h : group α] : group (lex α) := h +@[to_additive] instance [h : comm_group α] : comm_group (lex α) := h + +@[simp, to_additive] lemma to_lex_one [has_one α] : to_lex (1 : α) = 1 := rfl +@[simp, to_additive] lemma of_lex_one [has_one α] : (of_lex 1 : α) = 1 := rfl +@[simp, to_additive] +lemma to_lex_mul [has_mul α] (a b : α) : to_lex (a * b) = to_lex a * to_lex b := rfl +@[simp, to_additive] +lemma of_lex_mul [has_mul α] (a b : lex α) : of_lex (a * b) = of_lex a * of_lex b := rfl +@[simp, to_additive] lemma to_lex_inv [has_inv α] (a : α) : to_lex a⁻¹ = (to_lex a)⁻¹ := rfl +@[simp, to_additive] lemma of_lex_inv [has_inv α] (a : lex α) : of_lex a⁻¹ = (of_lex a)⁻¹ := rfl +@[simp, to_additive] +lemma to_lex_div [has_div α] (a b : α) : to_lex (a / b) = to_lex a / to_lex b := rfl +@[simp, to_additive] +lemma of_lex_div [has_div α] (a b : lex α) : of_lex (a / b) = of_lex a / of_lex b := rfl +@[simp, to_additive] +lemma to_lex_smul [has_smul α β] (a : α) (b : β) : to_lex (a • b) = a • to_lex b := rfl +@[simp, to_additive] +lemma of_lex_smul [has_smul α β] (a : α) (b : lex β) : of_lex (a • b) = a • of_lex b := rfl +@[simp, to_additive] +lemma to_lex_smul' [has_smul α β] (a : α) (b : β) : to_lex a • b = a • b := rfl +@[simp, to_additive] +lemma of_lex_smul' [has_smul α β] (a : lex α) (b : β) : of_lex a • b = a • b := rfl +@[simp, to_additive to_lex_smul, to_additive_reorder 1 4] +lemma to_lex_pow [has_pow α β] (a : α) (b : β) : to_lex (a ^ b) = to_lex a ^ b := rfl +@[simp, to_additive of_lex_smul, to_additive_reorder 1 4] +lemma of_lex_pow [has_pow α β] (a : lex α) (b : β) : of_lex (a ^ b) = of_lex a ^ b := rfl +@[simp, to_additive to_lex_smul, to_additive_reorder 1 4] +lemma pow_to_lex [has_pow α β] (a : α) (b : β) : a ^ to_lex b = a ^ b := rfl +@[simp, to_additive of_lex_smul, to_additive_reorder 1 4] +lemma pow_of_lex [has_pow α β] (a : α) (b : lex β) : a ^ of_lex b = a ^ b := rfl diff --git a/src/algebra/group/pi.lean b/src/algebra/group/pi.lean index 2ad220e07c476..5671481eaa151 100644 --- a/src/algebra/group/pi.lean +++ b/src/algebra/group/pi.lean @@ -3,22 +3,31 @@ Copyright (c) 2018 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon, Patrick Massot -/ +import logic.pairwise import algebra.hom.group_instances import data.pi.algebra import data.set.function -import data.set.pairwise import tactic.pi_instances /-! # Pi instances for groups and monoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for group, monoid, semigroup and related structures on Pi types. -/ universes u v w +variables {ι α : Type*} variable {I : Type u} -- The indexing type variable {f : I → Type v} -- The family of types already equipped with instances -variables (x y : Π i, f i) (i : I) +variables (x y : Π i, f i) (i j : I) + +@[to_additive] +lemma set.preimage_one {α β : Type*} [has_one β] (s : set β) [decidable ((1 : β) ∈ s)] : + (1 : α → β) ⁻¹' s = if (1 : β) ∈ s then set.univ else ∅ := +set.preimage_const 1 s namespace pi @@ -43,10 +52,6 @@ instance monoid [∀ i, monoid $ f i] : monoid (Π i : I, f i) := by refine_struct { one := (1 : Π i, f i), mul := (*), npow := λ n x i, (x i) ^ n }; tactic.pi_instance_derive_field --- the attributes are intentionally out of order. `smul_apply` proves `nsmul_apply`. -@[to_additive, simp] -lemma pow_apply [∀ i, monoid $ f i] (n : ℕ) : (x^n) i = (x i)^n := rfl - @[to_additive] instance comm_monoid [∀ i, comm_monoid $ f i] : comm_monoid (Π i : I, f i) := by refine_struct { one := (1 : Π i, f i), mul := (*), npow := monoid.npow }; @@ -145,6 +150,38 @@ end mul_hom section mul_hom +/-- A family of mul_hom `f a : γ →ₙ* β a` defines a mul_hom `pi.mul_hom f : γ →ₙ* Π a, β a` +given by `pi.mul_hom f x b = f b x`. -/ +@[to_additive "A family of add_hom `f a : γ → β a` defines a add_hom `pi.add_hom +f : γ → Π a, β a` given by `pi.add_hom f x b = f b x`.", simps] +def pi.mul_hom {γ : Type w} [Π i, has_mul (f i)] [has_mul γ] + (g : Π i, γ →ₙ* f i) : γ →ₙ* Π i, f i := +{ to_fun := λ x i, g i x, + map_mul' := λ x y, funext $ λ i, (g i).map_mul x y, } + +@[to_additive] +lemma pi.mul_hom_injective {γ : Type w} [nonempty I] + [Π i, has_mul (f i)] [has_mul γ] (g : Π i, γ →ₙ* f i) + (hg : ∀ i, function.injective (g i)) : function.injective (pi.mul_hom g) := +λ x y h, let ⟨i⟩ := ‹nonempty I› in hg i ((function.funext_iff.mp h : _) i) + +/-- A family of monoid homomorphisms `f a : γ →* β a` defines a monoid homomorphism +`pi.monoid_mul_hom f : γ →* Π a, β a` given by `pi.monoid_mul_hom f x b = f b x`. -/ +@[to_additive "A family of additive monoid homomorphisms `f a : γ →+ β a` defines a monoid +homomorphism `pi.add_monoid_hom f : γ →+ Π a, β a` given by `pi.add_monoid_hom f x b += f b x`.", simps] +def pi.monoid_hom {γ : Type w} [Π i, mul_one_class (f i)] [mul_one_class γ] + (g : Π i, γ →* f i) : γ →* Π i, f i := +{ to_fun := λ x i, g i x, + map_one' := funext $ λ i, (g i).map_one, + .. pi.mul_hom (λ i, (g i).to_mul_hom) } + +@[to_additive] +lemma pi.monoid_hom_injective {γ : Type w} [nonempty I] + [Π i, mul_one_class (f i)] [mul_one_class γ] (g : Π i, γ →* f i) + (hg : ∀ i, function.injective (g i)) : function.injective (pi.monoid_hom g) := +pi.mul_hom_injective (λ i, (g i).to_mul_hom) hg + variables (f) [Π i, has_mul (f i)] /-- Evaluation of functions into an indexed collection of semigroups at a point is a semigroup @@ -277,6 +314,16 @@ This is the `mul_hom` version of `pi.single`. -/ variables {f} +@[to_additive] +lemma pi.mul_single_sup [Π i, semilattice_sup (f i)] [Π i, has_one (f i)] (i : I) (x y : f i) : + pi.mul_single i (x ⊔ y) = pi.mul_single i x ⊔ pi.mul_single i y := +function.update_sup _ _ _ _ + +@[to_additive] +lemma pi.mul_single_inf [Π i, semilattice_inf (f i)] [Π i, has_one (f i)] (i : I) (x y : f i) : + pi.mul_single i (x ⊓ y) = pi.mul_single i x ⊓ pi.mul_single i y := +function.update_inf _ _ _ _ + @[to_additive] lemma pi.mul_single_mul [Π i, mul_one_class $ f i] (i : I) (x y : f i) : mul_single i (x * y) = mul_single i x * mul_single i y := @@ -296,6 +343,22 @@ lemma pi.single_mul [Π i, mul_zero_class $ f i] (i : I) (x y : f i) : single i (x * y) = single i x * single i y := (mul_hom.single f i).map_mul x y +lemma pi.single_mul_left_apply [Π i, mul_zero_class $ f i] (a : f i) : + pi.single i (a * x i) j = pi.single i a j * x j := +(pi.apply_single (λ i, (* x i)) (λ i, zero_mul _) _ _ _).symm + +lemma pi.single_mul_right_apply [Π i, mul_zero_class $ f i] (a : f i) : + pi.single i (x i * a) j = x j * pi.single i a j := +(pi.apply_single (λ i, ((*) (x i))) (λ i, mul_zero _) _ _ _).symm + +lemma pi.single_mul_left [Π i, mul_zero_class $ f i] (a : f i) : + pi.single i (a * x i) = pi.single i a * x := +funext $ λ j, pi.single_mul_left_apply _ _ _ _ + +lemma pi.single_mul_right [Π i, mul_zero_class $ f i] (a : f i) : + pi.single i (x i * a) = x * pi.single i a := +funext $ λ j, pi.single_mul_right_apply _ _ _ _ + /-- The injection into a pi group at different indices commutes. For injections of commuting elements at the same index, see `commute.map` -/ @@ -318,7 +381,7 @@ lemma pi.mul_single_apply_commute [Π i, mul_one_class $ f i] (x : Π i, f i) (i begin obtain rfl | hij := decidable.eq_or_ne i j, { refl }, - { exact pi.mul_single_commute _ _ hij _ _, }, + { exact pi.mul_single_commute hij _ _, }, end @[to_additive update_eq_sub_add_single] @@ -331,6 +394,39 @@ begin { simp [function.update_noteq h.symm, h] } end +@[to_additive pi.single_add_single_eq_single_add_single] +lemma pi.mul_single_mul_mul_single_eq_mul_single_mul_mul_single + {M : Type*} [comm_monoid M] {k l m n : I} {u v : M} (hu : u ≠ 1) (hv : v ≠ 1) : + mul_single k u * mul_single l v = mul_single m u * mul_single n v ↔ + (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u * v = 1 ∧ k = l ∧ m = n) := +begin + refine ⟨λ h, _, _⟩, + { have hk := congr_fun h k, + have hl := congr_fun h l, + have hm := (congr_fun h m).symm, + have hn := (congr_fun h n).symm, + simp only [mul_apply, mul_single_apply, if_pos rfl] at hk hl hm hn, + rcases eq_or_ne k m with rfl | hkm, + { refine or.inl ⟨rfl, not_ne_iff.mp (λ hln, (hv _).elim)⟩, + rcases eq_or_ne k l with rfl | hkl, + { rwa [if_neg hln.symm, if_neg hln.symm, one_mul, one_mul] at hn }, + { rwa [if_neg hkl.symm, if_neg hln, one_mul, one_mul] at hl } }, + { rcases eq_or_ne m n with rfl | hmn, + { rcases eq_or_ne k l with rfl | hkl, + { rw [if_neg hkm.symm, if_neg hkm.symm, one_mul, if_pos rfl] at hm, + exact or.inr (or.inr ⟨hm, rfl, rfl⟩) }, + { simpa only [if_neg hkm, if_neg hkl, mul_one] using hk } }, + { rw [if_neg hkm.symm, if_neg hmn, one_mul, mul_one] at hm, + obtain rfl := (ite_ne_right_iff.mp (ne_of_eq_of_ne hm.symm hu)).1, + rw [if_neg hkm, if_neg hkm, one_mul, mul_one] at hk, + obtain rfl := (ite_ne_right_iff.mp (ne_of_eq_of_ne hk.symm hu)).1, + exact or.inr (or.inl ⟨hk.trans (if_pos rfl), rfl, rfl⟩) } } }, + { rintros (⟨rfl, rfl⟩ | ⟨rfl, rfl, rfl⟩ | ⟨h, rfl, rfl⟩), + { refl }, + { apply mul_comm }, + { simp_rw [←pi.mul_single_mul, h, mul_single_one] } }, +end + end single namespace function @@ -358,6 +454,11 @@ lemma update_div [Π i, has_div (f i)] [decidable_eq I] update (f₁ / f₂) i (x₁ / x₂) = update f₁ i x₁ / update f₂ i x₂ := funext $ λ j, (apply_update₂ (λ i, (/)) f₁ f₂ i x₁ x₂ j).symm +variables [has_one α] [nonempty ι] {a : α} + +@[simp, to_additive] lemma const_eq_one : const ι a = 1 ↔ a = 1 := @const_inj _ _ _ _ 1 +@[to_additive] lemma const_ne_one : const ι a ≠ 1 ↔ a ≠ 1 := const_eq_one.not + end function section piecewise @@ -384,7 +485,7 @@ end piecewise section extend -variables {ι : Type u} {η : Type v} (R : Type w) (s : ι → η) +variables {η : Type v} (R : Type w) (s : ι → η) /-- `function.extend s f 1` as a bundled hom. -/ @[to_additive function.extend_by_zero.hom "`function.extend s f 0` as a bundled hom.", simps] @@ -394,3 +495,14 @@ noncomputable def function.extend_by_one.hom [mul_one_class R] : (ι → R) →* map_mul' := λ f g, by { simpa using function.extend_mul s f g 1 1 } } end extend + +namespace pi +variables [decidable_eq I] [Π i, preorder (f i)] [Π i, has_one (f i)] + +@[to_additive] lemma mul_single_mono : monotone (pi.mul_single i : f i → Π i, f i) := +function.update_mono + +@[to_additive] lemma mul_single_strict_mono : strict_mono (pi.mul_single i : f i → Π i, f i) := +function.update_strict_mono + +end pi diff --git a/src/algebra/group/prod.lean b/src/algebra/group/prod.lean index 09cc361848ef4..2546fc56e9435 100644 --- a/src/algebra/group/prod.lean +++ b/src/algebra/group/prod.lean @@ -4,10 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon, Patrick Massot, Yury Kudryashov -/ import algebra.group.opposite +import algebra.group_with_zero.units.basic +import algebra.hom.units /-! # Monoid, group etc structures on `M × N` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define one-binop (`monoid`, `group` etc) structures on `M × N`. We also prove trivial `simp` lemmas, and define the following operations on `monoid_hom`s: @@ -47,6 +52,16 @@ lemma swap_mul [has_mul M] [has_mul N] (p q : M × N) : (p * q).swap = p.swap * @[to_additive] lemma mul_def [has_mul M] [has_mul N] (p q : M × N) : p * q = (p.1 * q.1, p.2 * q.2) := rfl +@[to_additive] +lemma one_mk_mul_one_mk [monoid M] [has_mul N] (b₁ b₂ : N) : + ((1 : M), b₁) * (1, b₂) = (1, b₁ * b₂) := +by rw [mk_mul_mk, mul_one] + +@[to_additive] +lemma mk_one_mul_mk_one [has_mul M] [monoid N] (a₁ a₂ : M) : + (a₁, (1 : N)) * (a₂, 1) = (a₁ * a₂, 1) := +by rw [mk_mul_mk, mul_one] + @[to_additive] instance [has_one M] [has_one N] : has_one (M × N) := ⟨(1, 1)⟩ @@ -136,11 +151,11 @@ instance [div_inv_monoid G] [div_inv_monoid H] : div_inv_monoid (G × H) := zpow_neg' := λ z a, ext (div_inv_monoid.zpow_neg' _ _) (div_inv_monoid.zpow_neg' _ _), .. prod.monoid, .. prod.has_inv, .. prod.has_div } -@[to_additive subtraction_monoid] +@[to_additive] instance [division_monoid G] [division_monoid H] : division_monoid (G × H) := { mul_inv_rev := λ a b, ext (mul_inv_rev _ _) (mul_inv_rev _ _), - inv_eq_of_mul := λ a b h, ext (inv_eq_of_mul_eq_one $ congr_arg fst h) - (inv_eq_of_mul_eq_one $ congr_arg snd h), + inv_eq_of_mul := λ a b h, ext (inv_eq_of_mul_eq_one_right $ congr_arg fst h) + (inv_eq_of_mul_eq_one_right $ congr_arg snd h), .. prod.div_inv_monoid, .. prod.has_involutive_inv } @[to_additive subtraction_comm_monoid] @@ -448,6 +463,46 @@ def prod_comm : M × N ≃* N × M := @[simp, to_additive coe_prod_comm_symm] lemma coe_prod_comm_symm : ⇑((prod_comm : M × N ≃* N × M).symm) = prod.swap := rfl +variables {M' N' : Type*} [mul_one_class M'] [mul_one_class N'] + +section +variables (M N M' N') + +/-- Four-way commutativity of `prod`. The name matches `mul_mul_mul_comm`. -/ +@[to_additive prod_prod_prod_comm "Four-way commutativity of `prod`. +The name matches `mul_mul_mul_comm`", simps apply] +def prod_prod_prod_comm : (M × N) × (M' × N') ≃* (M × M') × (N × N') := +{ to_fun := λ mnmn, ((mnmn.1.1, mnmn.2.1), (mnmn.1.2, mnmn.2.2)), + inv_fun := λ mmnn, ((mmnn.1.1, mmnn.2.1), (mmnn.1.2, mmnn.2.2)), + map_mul' := λ mnmn mnmn', rfl, + ..equiv.prod_prod_prod_comm M N M' N', } + +@[simp, to_additive] lemma prod_prod_prod_comm_to_equiv : + (prod_prod_prod_comm M N M' N').to_equiv = equiv.prod_prod_prod_comm M N M' N' := rfl + +@[simp] lemma prod_prod_prod_comm_symm : + (prod_prod_prod_comm M N M' N').symm = prod_prod_prod_comm M M' N N' := rfl + +end + +/--Product of multiplicative isomorphisms; the maps come from `equiv.prod_congr`.-/ +@[to_additive prod_congr "Product of additive isomorphisms; the maps come from `equiv.prod_congr`."] +def prod_congr (f : M ≃* M') (g : N ≃* N') : M × N ≃* M' × N' := +{ map_mul' := λ x y, prod.ext (f.map_mul _ _) (g.map_mul _ _), + ..f.to_equiv.prod_congr g.to_equiv } + +/--Multiplying by the trivial monoid doesn't change the structure.-/ +@[to_additive unique_prod "Multiplying by the trivial monoid doesn't change the structure."] +def unique_prod [unique N] : N × M ≃* M := +{ map_mul' := λ x y, rfl, + ..equiv.unique_prod M N } + +/--Multiplying by the trivial monoid doesn't change the structure.-/ +@[to_additive prod_unique "Multiplying by the trivial monoid doesn't change the structure."] +def prod_unique [unique N] : M × N ≃* M := +{ map_mul' := λ x y, rfl, + ..equiv.prod_unique M N } + end section @@ -475,13 +530,17 @@ open mul_opposite /-- Canonical homomorphism of monoids from `αˣ` into `α × αᵐᵒᵖ`. Used mainly to define the natural topology of `αˣ`. -/ @[to_additive "Canonical homomorphism of additive monoids from `add_units α` into `α × αᵃᵒᵖ`. -Used mainly to define the natural topology of `add_units α`."] +Used mainly to define the natural topology of `add_units α`.", simps] def embed_product (α : Type*) [monoid α] : αˣ →* α × αᵐᵒᵖ := { to_fun := λ x, ⟨x, op ↑x⁻¹⟩, - map_one' := by simp only [one_inv, eq_self_iff_true, units.coe_one, op_one, prod.mk_eq_one, + map_one' := by simp only [inv_one, eq_self_iff_true, units.coe_one, op_one, prod.mk_eq_one, and_self], map_mul' := λ x y, by simp only [mul_inv_rev, op_mul, units.coe_mul, prod.mk_mul_mk] } +@[to_additive] +lemma embed_product_injective (α : Type*) [monoid α] : function.injective (embed_product α) := +λ a₁ a₂ h, units.ext $ (congr_arg prod.fst h : _) + end units /-! ### Multiplication and division as homomorphisms -/ @@ -509,10 +568,10 @@ def mul_monoid_with_zero_hom [comm_monoid_with_zero α] : α × α →*₀ α := /-- Division as a monoid homomorphism. -/ @[to_additive "Subtraction as an additive monoid homomorphism.", simps] -def div_monoid_hom [comm_group α] : α × α →* α := +def div_monoid_hom [division_comm_monoid α] : α × α →* α := { to_fun := λ a, a.1 / a.2, - map_one' := div_one' _, - map_mul' := λ a b, mul_div_comm' _ _ _ _ } + map_one' := div_one _, + map_mul' := λ a b, mul_div_mul_comm _ _ _ _ } /-- Division as a multiplicative homomorphism with zero. -/ @[simps] @@ -520,6 +579,6 @@ def div_monoid_with_zero_hom [comm_group_with_zero α] : α × α →*₀ α := { to_fun := λ a, a.1 / a.2, map_zero' := zero_div _, map_one' := div_one _, - map_mul' := λ a b, (div_mul_div_comm₀ _ _ _ _).symm } + map_mul' := λ a b, mul_div_mul_comm _ _ _ _ } end bundled_mul_div diff --git a/src/algebra/group/semiconj.lean b/src/algebra/group/semiconj.lean index 780c119ff9364..fc54fd649ee71 100644 --- a/src/algebra/group/semiconj.lean +++ b/src/algebra/group/semiconj.lean @@ -10,6 +10,9 @@ import algebra.group.units /-! # Semiconjugate elements of a semigroup +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions We say that `x` is semiconjugate to `y` by `a` (`semiconj_by a x y`), if `a * x = y * a`. @@ -27,6 +30,7 @@ operations (`pow_right`, field inverse etc) are in the files that define corresp -/ universes u v +variables {G : Type*} /-- `x` is semiconjugate to `y` by `a`, if `a * x = y * a`. -/ @[to_additive add_semiconj_by "`x` is additive semiconjugate to `y` by `a` if `a + x = y + a`"] @@ -136,9 +140,20 @@ end end monoid +section division_monoid +variables [division_monoid G] {a x y : G} + +@[simp, to_additive] lemma inv_inv_symm_iff : semiconj_by a⁻¹ x⁻¹ y⁻¹ ↔ semiconj_by a y x := +inv_involutive.injective.eq_iff.symm.trans $ by simp_rw [mul_inv_rev, inv_inv, eq_comm, semiconj_by] + +@[to_additive] lemma inv_inv_symm : semiconj_by a x y → semiconj_by a⁻¹ y⁻¹ x⁻¹ := +inv_inv_symm_iff.2 + +end division_monoid + section group -variables {G : Type u} [group G] {a x y : G} +variables [group G] {a x y : G} @[simp, to_additive] lemma inv_right_iff : semiconj_by a x⁻¹ y⁻¹ ↔ semiconj_by a x y := @units_inv_right_iff G _ a ⟨x, x⁻¹, mul_inv_self x, inv_mul_self x⟩ @@ -153,13 +168,6 @@ inv_right_iff.2 @[to_additive] lemma inv_symm_left : semiconj_by a x y → semiconj_by a⁻¹ y x := inv_symm_left_iff.2 -@[to_additive] lemma inv_inv_symm (h : semiconj_by a x y) : semiconj_by a⁻¹ y⁻¹ x⁻¹ := -h.inv_right.inv_symm_left - --- this is not a simp lemma because it can be deduced from other simp lemmas -@[to_additive] lemma inv_inv_symm_iff : semiconj_by a⁻¹ y⁻¹ x⁻¹ ↔ semiconj_by a x y := -inv_right_iff.trans inv_symm_left_iff - /-- `a` semiconjugates `x` to `a * x * a⁻¹`. -/ @[to_additive "`a` semiconjugates `x` to `a + x + -a`."] lemma conj_mk (a x : G) : semiconj_by a x (a * x * a⁻¹) := diff --git a/src/algebra/group/type_tags.lean b/src/algebra/group/type_tags.lean index dba94370a37c6..46f64cf757500 100644 --- a/src/algebra/group/type_tags.lean +++ b/src/algebra/group/type_tags.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import algebra.hom.group -import logic.equiv.basic +import logic.equiv.defs +import data.finite.defs /-! # Type tags that turn additive structures into multiplicative, and vice versa +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define two type tags: * `additive α`: turns any multiplicative structure on `α` into the corresponding @@ -16,6 +20,10 @@ We define two type tags: multiplicative structure on `multiplicative α`. We also define instances `additive.*` and `multiplicative.*` that actually transfer the structures. + +## See also + +This file is similar to `order.synonym`. -/ universes u v @@ -65,6 +73,12 @@ end multiplicative instance [inhabited α] : inhabited (additive α) := ⟨additive.of_mul default⟩ instance [inhabited α] : inhabited (multiplicative α) := ⟨multiplicative.of_add default⟩ +instance [finite α] : finite (additive α) := finite.of_equiv α (by refl) +instance [finite α] : finite (multiplicative α) := finite.of_equiv α (by refl) + +instance [infinite α] : infinite (additive α) := by tauto +instance [infinite α] : infinite (multiplicative α) := by tauto + instance [nontrivial α] : nontrivial (additive α) := additive.of_mul.injective.nontrivial @@ -109,21 +123,35 @@ instance [add_comm_semigroup α] : comm_semigroup (multiplicative α) := { mul_comm := @add_comm _ _, ..multiplicative.semigroup } +instance [has_mul α] [is_left_cancel_mul α] : is_left_cancel_add (additive α) := +{ add_left_cancel := @mul_left_cancel α _ _ } + +instance [has_add α] [is_left_cancel_add α] : is_left_cancel_mul (multiplicative α) := +{ mul_left_cancel := @add_left_cancel α _ _ } + +instance [has_mul α] [is_right_cancel_mul α] : is_right_cancel_add (additive α) := +{ add_right_cancel := @mul_right_cancel α _ _ } + +instance [has_add α] [is_right_cancel_add α] : is_right_cancel_mul (multiplicative α) := +{ mul_right_cancel := @add_right_cancel α _ _ } + +instance [has_mul α] [is_cancel_mul α] : is_cancel_add (additive α) := +{ ..additive.is_left_cancel_add, ..additive.is_right_cancel_add } + +instance [has_add α] [is_cancel_add α] : is_cancel_mul (multiplicative α) := +{ ..multiplicative.is_left_cancel_mul, ..multiplicative.is_right_cancel_mul } + instance [left_cancel_semigroup α] : add_left_cancel_semigroup (additive α) := -{ add_left_cancel := @mul_left_cancel _ _, - ..additive.add_semigroup } +{ ..additive.add_semigroup, ..additive.is_left_cancel_add } instance [add_left_cancel_semigroup α] : left_cancel_semigroup (multiplicative α) := -{ mul_left_cancel := @add_left_cancel _ _, - ..multiplicative.semigroup } +{ ..multiplicative.semigroup, ..multiplicative.is_left_cancel_mul } instance [right_cancel_semigroup α] : add_right_cancel_semigroup (additive α) := -{ add_right_cancel := @mul_right_cancel _ _, - ..additive.add_semigroup } +{ ..additive.add_semigroup, ..additive.is_right_cancel_add } instance [add_right_cancel_semigroup α] : right_cancel_semigroup (multiplicative α) := -{ mul_right_cancel := @add_right_cancel _ _, - ..multiplicative.semigroup } +{ ..multiplicative.semigroup, ..multiplicative.is_right_cancel_mul } instance [has_one α] : has_zero (additive α) := ⟨additive.of_mul 1⟩ @@ -253,12 +281,12 @@ instance [sub_neg_monoid α] : div_inv_monoid (multiplicative α) := instance [division_monoid α] : subtraction_monoid (additive α) := { neg_add_rev := @mul_inv_rev _ _, - neg_eq_of_add := @inv_eq_of_mul_eq_one _ _, + neg_eq_of_add := @inv_eq_of_mul_eq_one_right _ _, .. additive.sub_neg_monoid, .. additive.has_involutive_neg } instance [subtraction_monoid α] : division_monoid (multiplicative α) := { mul_inv_rev := @neg_add_rev _ _, - inv_eq_of_mul := @neg_eq_of_add_eq_zero _ _, + inv_eq_of_mul := @neg_eq_of_add_eq_zero_right _ _, .. multiplicative.div_inv_monoid, .. multiplicative.has_involutive_inv } instance [division_comm_monoid α] : subtraction_comm_monoid (additive α) := diff --git a/src/algebra/group/ulift.lean b/src/algebra/group/ulift.lean index 54011d67d7ba7..7635fe79241ee 100644 --- a/src/algebra/group/ulift.lean +++ b/src/algebra/group/ulift.lean @@ -3,11 +3,16 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import algebra.hom.equiv +import data.int.cast.defs +import algebra.hom.equiv.basic +import algebra.group_with_zero.inj_surj /-! # `ulift` instances for groups and monoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for group, monoid, semigroup and related structures on `ulift` types. (Recall `ulift α` is just a "copy" of a type `α` in a higher universe.) @@ -19,7 +24,7 @@ We also provide `ulift.mul_equiv : ulift R ≃* R` (and its additive analogue). -/ universes u v -variables {α : Type u} {x y : ulift.{v} α} +variables {α : Type u} {β : Type*} {x y : ulift.{v} α} namespace ulift @@ -35,6 +40,16 @@ namespace ulift @[to_additive] instance has_inv [has_inv α] : has_inv (ulift α) := ⟨λ f, ⟨f.down⁻¹⟩⟩ @[simp, to_additive] lemma inv_down [has_inv α] : x⁻¹.down = (x.down)⁻¹ := rfl +@[to_additive] +instance has_smul [has_smul α β] : has_smul α (ulift β) := ⟨λ n x, up (n • x.down)⟩ +@[simp, to_additive] +lemma smul_down [has_smul α β] (a : α) (b : ulift.{v} β) : (a • b).down = a • b.down := rfl + +@[to_additive has_smul, to_additive_reorder 1] +instance has_pow [has_pow α β] : has_pow (ulift α) β := ⟨λ x n, up (x.down ^ n)⟩ +@[simp, to_additive smul_down, to_additive_reorder 1] +lemma pow_down [has_pow α β] (a : ulift.{v} α) (b : β) : (a ^ b).down = a.down ^ b := rfl + /-- The multiplicative equivalence between `ulift α` and `α`. -/ @@ -58,14 +73,6 @@ equiv.ulift.injective.mul_one_class _ rfl $ λ x y, rfl instance mul_zero_one_class [mul_zero_one_class α] : mul_zero_one_class (ulift α) := equiv.ulift.injective.mul_zero_one_class _ rfl rfl $ λ x y, rfl -@[to_additive has_vadd] -instance has_scalar {β : Type*} [has_scalar α β] : has_scalar α (ulift β) := -⟨λ n x, up (n • x.down)⟩ - -@[to_additive has_scalar, to_additive_reorder 1] -instance has_pow {β : Type*} [has_pow α β] : has_pow (ulift α) β := -⟨λ x n, up (x.down ^ n)⟩ - @[to_additive] instance monoid [monoid α] : monoid (ulift α) := equiv.ulift.injective.monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) @@ -74,6 +81,23 @@ equiv.ulift.injective.monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) instance comm_monoid [comm_monoid α] : comm_monoid (ulift α) := equiv.ulift.injective.comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) +instance [has_nat_cast α] : has_nat_cast (ulift α) := ⟨λ n, up n⟩ +instance [has_int_cast α] : has_int_cast (ulift α) := ⟨λ n, up n⟩ + +@[simp, norm_cast] lemma up_nat_cast [has_nat_cast α] (n : ℕ) : up (n : α) = n := rfl +@[simp, norm_cast] lemma up_int_cast [has_int_cast α] (n : ℤ) : up (n : α) = n := rfl +@[simp, norm_cast] lemma down_nat_cast [has_nat_cast α] (n : ℕ) : down (n : ulift α) = n := rfl +@[simp, norm_cast] lemma down_int_cast [has_int_cast α] (n : ℤ) : down (n : ulift α) = n := rfl + +instance add_monoid_with_one [add_monoid_with_one α] : add_monoid_with_one (ulift α) := +{ nat_cast_zero := congr_arg ulift.up nat.cast_zero, + nat_cast_succ := λ n, congr_arg ulift.up (nat.cast_succ _), + .. ulift.has_one, .. ulift.add_monoid, ..ulift.has_nat_cast } + +instance add_comm_monoid_with_one [add_comm_monoid_with_one α] : + add_comm_monoid_with_one (ulift α) := +{ ..ulift.add_monoid_with_one, .. ulift.add_comm_monoid } + instance monoid_with_zero [monoid_with_zero α] : monoid_with_zero (ulift α) := equiv.ulift.injective.monoid_with_zero _ rfl rfl (λ _ _, rfl) (λ _ _, rfl) @@ -95,6 +119,15 @@ instance comm_group [comm_group α] : comm_group (ulift α) := equiv.ulift.injective.comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) +instance add_group_with_one [add_group_with_one α] : add_group_with_one (ulift α) := +{ int_cast := λ n, ⟨n⟩, + int_cast_of_nat := λ n, congr_arg ulift.up (int.cast_of_nat _), + int_cast_neg_succ_of_nat := λ n, congr_arg ulift.up (int.cast_neg_succ_of_nat _), + .. ulift.add_monoid_with_one, .. ulift.add_group } + +instance add_comm_group_with_one [add_comm_group_with_one α] : add_comm_group_with_one (ulift α) := +{ ..ulift.add_group_with_one, .. ulift.add_comm_group } + instance group_with_zero [group_with_zero α] : group_with_zero (ulift α) := equiv.ulift.injective.group_with_zero _ rfl rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) @@ -128,7 +161,7 @@ instance cancel_monoid [cancel_monoid α] : cancel_monoid (ulift α) := equiv.ulift.injective.cancel_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) -@[to_additive add_cancel_monoid] +@[to_additive add_cancel_comm_monoid] instance cancel_comm_monoid [cancel_comm_monoid α] : cancel_comm_monoid (ulift α) := equiv.ulift.injective.cancel_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl) diff --git a/src/algebra/group/unique_prods.lean b/src/algebra/group/unique_prods.lean new file mode 100644 index 0000000000000..3fc479cc41994 --- /dev/null +++ b/src/algebra/group/unique_prods.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import data.finset.preimage + +/-! +# Unique products and related notions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A group `G` has *unique products* if for any two non-empty finite subsets `A, B ⊂ G`, there is an +element `g ∈ A * B` that can be written uniquely as a product of an element of `A` and an element +of `B`. We call the formalization this property `unique_prods`. Since the condition requires no +property of the group operation, we define it for a Type simply satisfying `has_mul`. We also +introduce the analogous "additive" companion, `unique_sums` and link the two so that `to_additive` +converts `unique_prods` into `unique_sums`. + +Here you can see several examples of Types that have `unique_sums/prods` +(`apply_instance` uses `covariants.to_unique_prods` and `covariants.to_unique_sums`). +```lean +import data.real.basic + +example : unique_sums ℕ := by apply_instance +example : unique_sums ℕ+ := by apply_instance +example : unique_sums ℤ := by apply_instance +example : unique_sums ℚ := by apply_instance +example : unique_sums ℝ := by apply_instance +example : unique_prods ℕ+ := by apply_instance +``` +-/ + +/-- Let `G` be a Type with multiplication, let `A B : finset G` be finite subsets and +let `a0 b0 : G` be two elements. `unique_mul A B a0 b0` asserts `a0 * b0` can be written in at +most one way as a product of an element of `A` and an element of `B`. -/ +@[to_additive "Let `G` be a Type with addition, let `A B : finset G` be finite subsets and +let `a0 b0 : G` be two elements. `unique_add A B a0 b0` asserts `a0 + b0` can be written in at +most one way as a sum of an element from `A` and an element from `B`."] +def unique_mul {G} [has_mul G] (A B : finset G) (a0 b0 : G) : Prop := +∀ ⦃a b⦄, a ∈ A → b ∈ B → a * b = a0 * b0 → a = a0 ∧ b = b0 + +namespace unique_mul +variables {G H : Type*} [has_mul G] [has_mul H] {A B : finset G} {a0 b0 : G} + +lemma mt {G} [has_mul G] {A B : finset G} {a0 b0 : G} (h : unique_mul A B a0 b0) : + ∀ ⦃a b⦄, a ∈ A → b ∈ B → a ≠ a0 ∨ b ≠ b0 → a * b ≠ a0 * b0 := +λ _ _ ha hb k, by { contrapose! k, exact h ha hb k } + +@[to_additive] +lemma subsingleton (A B : finset G) (a0 b0 : G) (h : unique_mul A B a0 b0) : + subsingleton { ab : G × G // ab.1 ∈ A ∧ ab.2 ∈ B ∧ ab.1 * ab.2 = a0 * b0 } := +⟨λ ⟨⟨a, b⟩, ha, hb, ab⟩ ⟨⟨a', b'⟩, ha', hb', ab'⟩, subtype.ext $ prod.ext + ((h ha hb ab).1.trans (h ha' hb' ab').1.symm) $ (h ha hb ab).2.trans (h ha' hb' ab').2.symm⟩ + +@[to_additive] +lemma set_subsingleton (A B : finset G) (a0 b0 : G) (h : unique_mul A B a0 b0) : + set.subsingleton { ab : G × G | ab.1 ∈ A ∧ ab.2 ∈ B ∧ ab.1 * ab.2 = a0 * b0 } := +begin + rintros ⟨x1, y1⟩ (hx : x1 ∈ A ∧ y1 ∈ B ∧ x1 * y1 = a0 * b0) + ⟨x2, y2⟩ (hy : x2 ∈ A ∧ y2 ∈ B ∧ x2 * y2 = a0 * b0), + rcases h hx.1 hx.2.1 hx.2.2 with ⟨rfl, rfl⟩, + rcases h hy.1 hy.2.1 hy.2.2 with ⟨rfl, rfl⟩, + refl, +end + +@[to_additive] +lemma iff_exists_unique (aA : a0 ∈ A) (bB : b0 ∈ B) : + unique_mul A B a0 b0 ↔ ∃! ab ∈ A ×ˢ B, ab.1 * ab.2 = a0 * b0 := +⟨λ _, ⟨(a0, b0), ⟨finset.mem_product.mpr ⟨aA, bB⟩, rfl, by simp⟩, by simpa⟩, λ h, h.elim2 begin + rintro ⟨x1, x2⟩ _ _ J x y hx hy l, + rcases prod.mk.inj_iff.mp (J (a0,b0) (finset.mk_mem_product aA bB) rfl) with ⟨rfl, rfl⟩, + exact prod.mk.inj_iff.mp (J (x,y) (finset.mk_mem_product hx hy) l), +end⟩ + +@[to_additive] +lemma exists_iff_exists_exists_unique : (∃ a0 b0 : G, a0 ∈ A ∧ b0 ∈ B ∧ unique_mul A B a0 b0) ↔ + ∃ g : G, ∃! ab ∈ A ×ˢ B, ab.1 * ab.2 = g := +⟨λ ⟨a0, b0, hA, hB, h⟩, ⟨_, (iff_exists_unique hA hB).mp h⟩, λ ⟨g, h⟩, begin + have h' := h, + rcases h' with ⟨⟨a,b⟩, ⟨hab, rfl, -⟩, -⟩, + cases finset.mem_product.mp hab with ha hb, + exact ⟨a, b, ha, hb, (iff_exists_unique ha hb).mpr h⟩, + end⟩ + +/-- `unique_mul` is preserved by inverse images under injective, multiplicative maps. -/ +@[to_additive "`unique_add` is preserved by inverse images under injective, additive maps."] +lemma mul_hom_preimage (f : G →ₙ* H) (hf : function.injective f) (a0 b0 : G) {A B : finset H} + (u : unique_mul A B (f a0) (f b0)) : + unique_mul (A.preimage f (set.inj_on_of_injective hf _)) + (B.preimage f (set.inj_on_of_injective hf _)) a0 b0 := +begin + intros a b ha hb ab, + rw [← hf.eq_iff, ← hf.eq_iff], + rw [← hf.eq_iff, map_mul, map_mul] at ab, + exact u (finset.mem_preimage.mp ha) (finset.mem_preimage.mp hb) ab, +end + +/-- `unique_mul` is preserved under multiplicative maps that are injective. + +See `unique_mul.mul_hom_map_iff` for a version with swapped bundling. -/ +@[to_additive "`unique_add` is preserved under additive maps that are injective. + +See `unique_add.add_hom_map_iff` for a version with swapped bundling."] +lemma mul_hom_image_iff [decidable_eq H] (f : G →ₙ* H) (hf : function.injective f) : + unique_mul (A.image f) (B.image f) (f a0) (f b0) ↔ unique_mul A B a0 b0 := +begin + refine ⟨λ h, _, λ h, _⟩, + { intros a b ha hb ab, + rw [← hf.eq_iff, ← hf.eq_iff], + rw [← hf.eq_iff, map_mul, map_mul] at ab, + exact h (finset.mem_image.mpr ⟨_, ha, rfl⟩) (finset.mem_image.mpr ⟨_, hb, rfl⟩) ab}, + { intros a b aA bB ab, + obtain ⟨a, ha, rfl⟩ : ∃ a' ∈ A, f a' = a := finset.mem_image.mp aA, + obtain ⟨b, hb, rfl⟩ : ∃ b' ∈ B, f b' = b := finset.mem_image.mp bB, + rw [hf.eq_iff, hf.eq_iff], + rw [← map_mul, ← map_mul, hf.eq_iff] at ab, + exact h ha hb ab }, +end + +/-- `unique_mul` is preserved under embeddings that are multiplicative. + +See `unique_mul.mul_hom_image_iff` for a version with swapped bundling. -/ +@[to_additive "`unique_add` is preserved under embeddings that are additive. + +See `unique_add.add_hom_image_iff` for a version with swapped bundling."] +lemma mul_hom_map_iff (f : G ↪ H) (mul : ∀ x y, f (x * y) = f x * f y) : + unique_mul (A.map f) (B.map f) (f a0) (f b0) ↔ unique_mul A B a0 b0 := +begin + classical, + convert mul_hom_image_iff ⟨f, mul⟩ f.2; + { ext, + simp only [finset.mem_map, mul_hom.coe_mk, finset.mem_image] }, +end + +end unique_mul + +/-- Let `G` be a Type with addition. `unique_sums G` asserts that any two non-empty +finite subsets of `A` have the `unique_add` property, with respect to some element of their +sum `A + B`. -/ +class unique_sums (G) [has_add G] : Prop := +(unique_add_of_nonempty : ∀ {A B : finset G} (hA : A.nonempty) (hB : B.nonempty), + ∃ (a0 ∈ A) (b0 ∈ B), unique_add A B a0 b0) + +/-- Let `G` be a Type with multiplication. `unique_prods G` asserts that any two non-empty +finite subsets of `G` have the `unique_mul` property, with respect to some element of their +product `A * B`. -/ +class unique_prods (G) [has_mul G] : Prop := +(unique_mul_of_nonempty : ∀ {A B : finset G} (hA : A.nonempty) (hB : B.nonempty), + ∃ (a0 ∈ A) (b0 ∈ B), unique_mul A B a0 b0) + +attribute [to_additive] unique_prods + +namespace multiplicative + +instance {M} [has_add M] [unique_sums M] : unique_prods (multiplicative M) := +{ unique_mul_of_nonempty := λ A B hA hB, let A' : finset M := A in have hA': A'.nonempty := hA, by + { obtain ⟨a0, hA0, b0, hB0, J⟩ := unique_sums.unique_add_of_nonempty hA' hB, + exact ⟨of_add a0, hA0, of_add b0, hB0, λ a b aA bB H, J aA bB H⟩ } } + +end multiplicative + +namespace additive + +instance {M} [has_mul M] [unique_prods M] : unique_sums (additive M) := +{ unique_add_of_nonempty := λ A B hA hB, let A' : finset M := A in have hA': A'.nonempty := hA, by + { obtain ⟨a0, hA0, b0, hB0, J⟩ := unique_prods.unique_mul_of_nonempty hA' hB, + exact ⟨of_mul a0, hA0, of_mul b0, hB0, λ a b aA bB H, J aA bB H⟩ } } + +end additive + +@[to_additive] lemma eq_and_eq_of_le_of_le_of_mul_le {A} [has_mul A] [linear_order A] + [covariant_class A A (*) (≤)] [covariant_class A A (function.swap (*)) (<)] + [contravariant_class A A (*) (≤)] + {a b a0 b0 : A} (ha : a0 ≤ a) (hb : b0 ≤ b) (ab : a * b ≤ a0 * b0) : + a = a0 ∧ b = b0 := +begin + haveI := has_mul.to_covariant_class_right A, + have ha' : ¬a0 * b0 < a * b → ¬a0 < a := mt (λ h, mul_lt_mul_of_lt_of_le h hb), + have hb' : ¬a0 * b0 < a * b → ¬b0 < b := mt (λ h, mul_lt_mul_of_le_of_lt ha h), + push_neg at ha' hb', + exact ⟨ha.antisymm' (ha' ab), hb.antisymm' (hb' ab)⟩, +end + +/-- This instance asserts that if `A` has a multiplication, a linear order, and multiplication +is 'very monotone', then `A` also has `unique_prods`. -/ +@[priority 100, -- see Note [lower instance priority] +to_additive "This instance asserts that if `A` has an addition, a linear order, and addition +is 'very monotone', then `A` also has `unique_sums`."] +instance covariants.to_unique_prods {A} [has_mul A] [linear_order A] + [covariant_class A A (*) (≤)] [covariant_class A A (function.swap (*)) (<)] + [contravariant_class A A (*) (≤)] : unique_prods A := +{ unique_mul_of_nonempty := λ A B hA hB, ⟨_, A.min'_mem ‹_›, _, B.min'_mem ‹_›, λ a b ha hb ab, + eq_and_eq_of_le_of_le_of_mul_le (finset.min'_le _ _ ‹_›) (finset.min'_le _ _ ‹_›) ab.le⟩ } diff --git a/src/algebra/group/units.lean b/src/algebra/group/units.lean index f9b8e3afd2df2..a8d5ad8fdc841 100644 --- a/src/algebra/group/units.lean +++ b/src/algebra/group/units.lean @@ -1,14 +1,18 @@ /- Copyright (c) 2017 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kenny Lau, Mario Carneiro, Johannes Hölzl, Chris Hughes, Jens Wagemaker +Authors: Kenny Lau, Mario Carneiro, Johannes Hölzl, Chris Hughes, Jens Wagemaker, Jon Eugster -/ import algebra.group.basic -import logic.nontrivial +import logic.unique +import tactic.nontriviality /-! # Units (i.e., invertible elements) of a monoid +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An element of a `monoid` is a unit if it has a two-sided inverse. ## Main declarations @@ -25,6 +29,8 @@ resembling the notation $R^{\times}$ for the units of a ring, which is common in -/ +open function + universe u variable {α : Type u} @@ -114,19 +120,33 @@ lemma copy_eq (u : αˣ) (val hv inv hi) : u.copy val hv inv hi = u := ext hv -/-- Units of a monoid form a group. -/ -@[to_additive "Additive units of an additive monoid form an additive group."] instance : group αˣ := +@[to_additive] instance : mul_one_class αˣ := { mul := λ u₁ u₂, ⟨u₁.val * u₂.val, u₂.inv * u₁.inv, - by rw [mul_assoc, ← mul_assoc u₂.val, val_inv, one_mul, val_inv], - by rw [mul_assoc, ← mul_assoc u₁.inv, inv_val, one_mul, inv_val]⟩, + by rw [mul_assoc, ←mul_assoc u₂.val, val_inv, one_mul, val_inv], + by rw [mul_assoc, ←mul_assoc u₁.inv, inv_val, one_mul, inv_val]⟩, one := ⟨1, 1, one_mul 1, one_mul 1⟩, - mul_one := λ u, ext $ mul_one u, one_mul := λ u, ext $ one_mul u, + mul_one := λ u, ext $ mul_one u } + +/-- Units of a monoid form a group. -/ +@[to_additive "Additive units of an additive monoid form an additive group."] +instance : group αˣ := +{ mul := (*), + one := 1, mul_assoc := λ u₁ u₂ u₃, ext $ mul_assoc u₁ u₂ u₃, inv := has_inv.inv, - mul_left_inv := λ u, ext u.inv_val } + mul_left_inv := λ u, ext u.inv_val, + ..units.mul_one_class } + +@[to_additive] instance {α} [comm_monoid α] : comm_group αˣ := +{ mul_comm := λ u₁ u₂, ext $ mul_comm _ _, ..units.group } + +@[to_additive] instance : inhabited αˣ := ⟨1⟩ + +@[to_additive] instance [has_repr α] : has_repr αˣ := ⟨repr ∘ val⟩ + +variables (a b c : αˣ) {u : αˣ} -variables (a b : αˣ) {c : αˣ} @[simp, norm_cast, to_additive] lemma coe_mul : (↑(a * b) : α) = a * b := rfl @[simp, norm_cast, to_additive] lemma coe_one : ((1 : αˣ) : α) = 1 := rfl @@ -143,11 +163,8 @@ by rw [←units.coe_one, eq_iff] @[simp, to_additive] lemma inv_mul : (↑a⁻¹ * a : α) = 1 := inv_val _ @[simp, to_additive] lemma mul_inv : (a * ↑a⁻¹ : α) = 1 := val_inv _ -@[to_additive] lemma inv_mul_of_eq {u : αˣ} {a : α} (h : ↑u = a) : ↑u⁻¹ * a = 1 := -by { rw [←h, u.inv_mul], } - -@[to_additive] lemma mul_inv_of_eq {u : αˣ} {a : α} (h : ↑u = a) : a * ↑u⁻¹ = 1 := -by { rw [←h, u.mul_inv], } +@[to_additive] lemma inv_mul_of_eq {a : α} (h : ↑u = a) : ↑u⁻¹ * a = 1 := by rw [←h, u.inv_mul] +@[to_additive] lemma mul_inv_of_eq {a : α} (h : ↑u = a) : a * ↑u⁻¹ = 1 := by rw [←h, u.mul_inv] @[simp, to_additive] lemma mul_inv_cancel_left (a : αˣ) (b : α) : (a:α) * (↑a⁻¹ * b) = b := by rw [← mul_assoc, mul_inv, one_mul] @@ -161,13 +178,6 @@ by rw [mul_assoc, mul_inv, mul_one] @[simp, to_additive] lemma inv_mul_cancel_right (a : α) (b : αˣ) : a * ↑b⁻¹ * b = a := by rw [mul_assoc, inv_mul, mul_one] -@[to_additive] instance : inhabited αˣ := ⟨1⟩ - -@[to_additive] instance {α} [comm_monoid α] : comm_group αˣ := -{ mul_comm := λ u₁ u₂, ext $ mul_comm _ _, ..units.group } - -@[to_additive] instance [has_repr α] : has_repr αˣ := ⟨repr ∘ val⟩ - @[simp, to_additive] theorem mul_right_inj (a : αˣ) {b c : α} : (a:α) * b = a * c ↔ b = c := ⟨λ h, by simpa only [inv_mul_cancel_left] using congr_arg ((*) ↑(a⁻¹ : αˣ)) h, congr_arg _⟩ @@ -186,13 +196,38 @@ by rw [mul_assoc, inv_mul, mul_one] @[to_additive] theorem mul_inv_eq_iff_eq_mul {a c : α} : a * ↑b⁻¹ = c ↔ a = c * b := ⟨λ h, by rw [← h, inv_mul_cancel_right], λ h, by rw [h, mul_inv_cancel_right]⟩ -lemma inv_eq_of_mul_eq_one {u : αˣ} {a : α} (h : ↑u * a = 1) : ↑u⁻¹ = a := +@[to_additive] protected lemma inv_eq_of_mul_eq_one_left {a : α} (h : a * u = 1) : ↑u⁻¹ = a := +calc ↑u⁻¹ = 1 * ↑u⁻¹ : by rw one_mul + ... = a : by rw [←h, mul_inv_cancel_right] + +@[to_additive] protected lemma inv_eq_of_mul_eq_one_right {a : α} (h : ↑u * a = 1) : ↑u⁻¹ = a := calc ↑u⁻¹ = ↑u⁻¹ * 1 : by rw mul_one - ... = ↑u⁻¹ * ↑u * a : by rw [←h, ←mul_assoc] - ... = a : by rw [u.inv_mul, one_mul] + ... = a : by rw [←h, inv_mul_cancel_left] + +@[to_additive] protected lemma eq_inv_of_mul_eq_one_left {a : α} (h : ↑u * a = 1) : a = ↑u⁻¹ := +(units.inv_eq_of_mul_eq_one_right h).symm + +@[to_additive] protected lemma eq_inv_of_mul_eq_one_right {a : α} (h : a * u = 1) : a = ↑u⁻¹ := +(units.inv_eq_of_mul_eq_one_left h).symm -lemma inv_unique {u₁ u₂ : αˣ} (h : (↑u₁ : α) = ↑u₂) : (↑u₁⁻¹ : α) = ↑u₂⁻¹ := -inv_eq_of_mul_eq_one $ by rw [h, u₂.mul_inv] +@[simp, to_additive] lemma mul_inv_eq_one {a : α} : a * ↑u⁻¹ = 1 ↔ a = u := +⟨inv_inv u ▸ units.eq_inv_of_mul_eq_one_right, λ h, mul_inv_of_eq h.symm⟩ + +@[simp, to_additive] lemma inv_mul_eq_one {a : α} : ↑u⁻¹ * a = 1 ↔ ↑u = a := +⟨inv_inv u ▸ units.inv_eq_of_mul_eq_one_right, inv_mul_of_eq⟩ + +@[to_additive] lemma mul_eq_one_iff_eq_inv {a : α} : a * u = 1 ↔ a = ↑u⁻¹ := +by rw [←mul_inv_eq_one, inv_inv] + +@[to_additive] lemma mul_eq_one_iff_inv_eq {a : α} : ↑u * a = 1 ↔ ↑u⁻¹ = a := +by rw [←inv_mul_eq_one, inv_inv] + +@[to_additive] lemma inv_unique {u₁ u₂ : αˣ} (h : (↑u₁ : α) = ↑u₂) : (↑u₁⁻¹ : α) = ↑u₂⁻¹ := +units.inv_eq_of_mul_eq_one_right $ by rw [h, u₂.mul_inv] + +@[simp, to_additive] +lemma coe_inv {M : Type*} [division_monoid M] (u : units M) : ↑u⁻¹ = (u⁻¹ : M) := +eq.symm $ inv_eq_of_mul_eq_one_right u.mul_inv end units @@ -223,6 +258,10 @@ infix ` /ₚ `:70 := divp theorem divp_assoc (a b : α) (u : αˣ) : a * b /ₚ u = a * (b /ₚ u) := mul_assoc _ _ _ +/-- `field_simp` needs the reverse direction of `divp_assoc` to move all `/ₚ` to the right. -/ +@[field_simps] lemma divp_assoc' (x y : α) (u : αˣ) : x * (y /ₚ u) = (x * y) /ₚ u := +(divp_assoc _ _ _).symm + @[simp] theorem divp_inv (u : αˣ) : a /ₚ u⁻¹ = a * u := rfl @[simp] theorem divp_mul_cancel (a : α) (u : αˣ) : a /ₚ u * u = a := @@ -234,31 +273,71 @@ mul_assoc _ _ _ @[simp] theorem divp_left_inj (u : αˣ) {a b : α} : a /ₚ u = b /ₚ u ↔ a = b := units.mul_left_inj _ -theorem divp_divp_eq_divp_mul (x : α) (u₁ u₂ : αˣ) : (x /ₚ u₁) /ₚ u₂ = x /ₚ (u₂ * u₁) := +@[field_simps] theorem divp_divp_eq_divp_mul (x : α) (u₁ u₂ : αˣ) : + (x /ₚ u₁) /ₚ u₂ = x /ₚ (u₂ * u₁) := by simp only [divp, mul_inv_rev, units.coe_mul, mul_assoc] -theorem divp_eq_iff_mul_eq {x : α} {u : αˣ} {y : α} : x /ₚ u = y ↔ y * u = x := +@[field_simps] theorem divp_eq_iff_mul_eq {x : α} {u : αˣ} {y : α} : x /ₚ u = y ↔ y * u = x := u.mul_left_inj.symm.trans $ by rw [divp_mul_cancel]; exact ⟨eq.symm, eq.symm⟩ +@[field_simps] theorem eq_divp_iff_mul_eq {x : α} {u : αˣ} {y : α} : x = y /ₚ u ↔ x * u = y := +by rw [eq_comm, divp_eq_iff_mul_eq] + theorem divp_eq_one_iff_eq {a : α} {u : αˣ} : a /ₚ u = 1 ↔ a = u := (units.mul_left_inj u).symm.trans $ by rw [divp_mul_cancel, one_mul] @[simp] theorem one_divp (u : αˣ) : 1 /ₚ u = ↑u⁻¹ := one_mul _ +/-- Used for `field_simp` to deal with inverses of units. -/ +@[field_simps] lemma inv_eq_one_divp (u : αˣ) : ↑u⁻¹ = 1 /ₚ u := +by rw one_divp + +/-- +Used for `field_simp` to deal with inverses of units. This form of the lemma +is essential since `field_simp` likes to use `inv_eq_one_div` to rewrite +`↑u⁻¹ = ↑(1 / u)`. +-/ +@[field_simps] lemma inv_eq_one_divp' (u : αˣ) : + ((1 / u : αˣ) : α) = 1 /ₚ u := +by rw [one_div, one_divp] + +/-- +`field_simp` moves division inside `αˣ` to the right, and this lemma +lifts the calculation to `α`. +-/ +@[field_simps] lemma coe_div_eq_divp (u₁ u₂ : αˣ) : ↑(u₁ / u₂) = ↑u₁ /ₚ u₂ := +by rw [divp, division_def, units.coe_mul] + end monoid section comm_monoid variables [comm_monoid α] -theorem divp_eq_divp_iff {x y : α} {ux uy : αˣ} : +@[field_simps] theorem divp_mul_eq_mul_divp (x y : α) (u : αˣ) : x /ₚ u * y = x * y /ₚ u := +by simp_rw [divp, mul_assoc, mul_comm] + +-- Theoretically redundant as `field_simp` lemma. +@[field_simps] lemma divp_eq_divp_iff {x y : α} {ux uy : αˣ} : x /ₚ ux = y /ₚ uy ↔ x * uy = y * ux := -by rw [divp_eq_iff_mul_eq, mul_comm, ← divp_assoc, divp_eq_iff_mul_eq, mul_comm y ux] +by rw [divp_eq_iff_mul_eq, divp_mul_eq_mul_divp, divp_eq_iff_mul_eq] -theorem divp_mul_divp (x y : α) (ux uy : αˣ) : +-- Theoretically redundant as `field_simp` lemma. +@[field_simps] lemma divp_mul_divp (x y : α) (ux uy : αˣ) : (x /ₚ ux) * (y /ₚ uy) = (x * y) /ₚ (ux * uy) := -by rw [← divp_divp_eq_divp_mul, divp_assoc, mul_comm x, divp_assoc, mul_comm] +by rw [divp_mul_eq_mul_divp, divp_assoc', divp_divp_eq_divp_mul] + +variables [subsingleton αˣ] {a b : α} + +@[to_additive] lemma eq_one_of_mul_right (h : a * b = 1) : a = 1 := +congr_arg units.inv $ subsingleton.elim (units.mk _ _ (by rwa mul_comm) h) 1 + +@[to_additive] lemma eq_one_of_mul_left (h : a * b = 1) : b = 1 := +congr_arg units.inv $ subsingleton.elim (units.mk _ _ h $ by rwa mul_comm) 1 + +@[simp, to_additive] lemma mul_eq_one : a * b = 1 ↔ a = 1 ∧ b = 1 := +⟨λ h, ⟨eq_one_of_mul_right h, eq_one_of_mul_left h⟩, by { rintro ⟨rfl, rfl⟩, exact mul_one _ }⟩ end comm_monoid @@ -289,10 +368,8 @@ lemma is_unit_of_subsingleton [monoid M] [subsingleton M] (a : M) : is_unit a := attribute [nontriviality] is_add_unit_of_subsingleton -@[to_additive] instance [monoid M] : can_lift M Mˣ := -{ coe := coe, - cond := is_unit, - prf := λ _, id } +@[to_additive] instance [monoid M] : can_lift M Mˣ coe is_unit := +{ prf := λ _, id } @[to_additive] instance [monoid M] [subsingleton M] : unique Mˣ := { default := 1, @@ -360,47 +437,72 @@ is_unit_iff_exists_inv.2 ⟨y * z, by rwa ← mul_assoc⟩ (hu : is_unit (x * y)) : is_unit y := @is_unit_of_mul_is_unit_left _ _ y x $ by rwa mul_comm +namespace is_unit + @[simp, to_additive] -lemma is_unit.mul_iff [comm_monoid M] {x y : M} : is_unit (x * y) ↔ is_unit x ∧ is_unit y := +lemma mul_iff [comm_monoid M] {x y : M} : is_unit (x * y) ↔ is_unit x ∧ is_unit y := ⟨λ h, ⟨is_unit_of_mul_is_unit_left h, is_unit_of_mul_is_unit_right h⟩, λ h, is_unit.mul h.1 h.2⟩ -@[to_additive] theorem is_unit.mul_right_inj [monoid M] {a b c : M} (ha : is_unit a) : - a * b = a * c ↔ b = c := -by cases ha with a ha; rw [←ha, units.mul_right_inj] +section monoid -@[to_additive] theorem is_unit.mul_left_inj [monoid M] {a b c : M} (ha : is_unit a) : - b * a = c * a ↔ b = c := -by cases ha with a ha; rw [←ha, units.mul_left_inj] +variables [monoid M] {a b c : M} -/-- The element of the group of units, corresponding to an element of a monoid which is a unit. -/ +/-- The element of the group of units, corresponding to an element of a monoid which is a unit. When +`α` is a `division_monoid`, use `is_unit.unit'` instead. -/ @[to_additive "The element of the additive group of additive units, corresponding to an element of -an additive monoid which is an additive unit."] -noncomputable def is_unit.unit [monoid M] {a : M} (h : is_unit a) : Mˣ := +an additive monoid which is an additive unit. When `α` is a `subtraction_monoid`, use +`is_add_unit.add_unit'` instead."] +protected noncomputable def unit (h : is_unit a) : Mˣ := (classical.some h).copy a (classical.some_spec h).symm _ rfl @[simp, to_additive] -lemma is_unit.unit_of_coe_units [monoid M] {a : Mˣ} (h : is_unit (a : M)) : h.unit = a := +lemma unit_of_coe_units {a : Mˣ} (h : is_unit (a : M)) : h.unit = a := units.ext $ rfl -@[to_additive] -lemma is_unit.unit_spec [monoid M] {a : M} (h : is_unit a) : ↑h.unit = a := -rfl +@[simp, to_additive] lemma unit_spec (h : is_unit a) : ↑h.unit = a := rfl -@[to_additive] -lemma is_unit.coe_inv_mul [monoid M] {a : M} (h : is_unit a) : - ↑(h.unit)⁻¹ * a = 1 := -units.mul_inv _ +@[simp, to_additive] +lemma coe_inv_mul (h : is_unit a) : ↑(h.unit)⁻¹ * a = 1 := units.mul_inv _ -@[to_additive] -lemma is_unit.mul_coe_inv [monoid M] {a : M} (h : is_unit a) : - a * ↑(h.unit)⁻¹ = 1 := -begin - convert units.mul_inv _, - simp [h.unit_spec] -end - -end is_unit +@[simp, to_additive] lemma mul_coe_inv (h : is_unit a) : a * ↑(h.unit)⁻¹ = 1 := +by convert h.unit.mul_inv + +/-- `is_unit x` is decidable if we can decide if `x` comes from `Mˣ`. -/ +@[to_additive "`is_add_unit x` is decidable if we can decide if `x` comes from `add_units M"] +instance (x : M) [h : decidable (∃ u : Mˣ, ↑u = x)] : decidable (is_unit x) := h + +@[to_additive] lemma mul_left_inj (h : is_unit a) : b * a = c * a ↔ b = c := +let ⟨u, hu⟩ := h in hu ▸ u.mul_left_inj + +@[to_additive] lemma mul_right_inj (h : is_unit a) : a * b = a * c ↔ b = c := +let ⟨u, hu⟩ := h in hu ▸ u.mul_right_inj + +@[to_additive] protected lemma mul_left_cancel (h : is_unit a) : a * b = a * c → b = c := +h.mul_right_inj.1 + +@[to_additive] protected lemma mul_right_cancel (h : is_unit b) : a * b = c * b → a = c := +h.mul_left_inj.1 + +@[to_additive] protected lemma mul_right_injective (h : is_unit a) : injective ((*) a) := +λ _ _, h.mul_left_cancel + +@[to_additive] protected lemma mul_left_injective (h : is_unit b) : injective (* b) := +λ _ _, h.mul_right_cancel + +end monoid + +variables [division_monoid M] {a : M} + +@[simp, to_additive] protected lemma inv_mul_cancel : is_unit a → a⁻¹ * a = 1 := +by { rintro ⟨u, rfl⟩, rw [← units.coe_inv, units.inv_mul] } + +@[simp, to_additive] protected lemma mul_inv_cancel : is_unit a → a * a⁻¹ = 1 := +by { rintro ⟨u, rfl⟩, rw [← units.coe_inv, units.mul_inv] } + +end is_unit -- namespace + +end is_unit -- section section noncomputable_defs diff --git a/src/algebra/group/with_one.lean b/src/algebra/group/with_one.lean deleted file mode 100644 index 947969d1a122b..0000000000000 --- a/src/algebra/group/with_one.lean +++ /dev/null @@ -1,382 +0,0 @@ -/- -Copyright (c) 2018 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro, Johan Commelin --/ -import algebra.hom.equiv -import algebra.ring.basic -import logic.equiv.basic -import logic.equiv.option - -/-! -# Adjoining a zero/one to semigroups and related algebraic structures - -This file contains different results about adjoining an element to an algebraic structure which then -behaves like a zero or a one. An example is adjoining a one to a semigroup to obtain a monoid. That -this provides an example of an adjunction is proved in `algebra.category.Mon.adjunctions`. - -Another result says that adjoining to a group an element `zero` gives a `group_with_zero`. For more -information about these structures (which are not that standard in informal mathematics, see -`algebra.group_with_zero.basic`) --/ - -universes u v w -variables {α : Type u} {β : Type v} {γ : Type w} - -/-- Add an extra element `1` to a type -/ -@[to_additive "Add an extra element `0` to a type"] -def with_one (α) := option α - -namespace with_one - -instance [has_repr α] : has_repr (with_zero α) := -⟨λ o, match o with | none := "0" | (some a) := "↑" ++ repr a end⟩ - -@[to_additive] -instance [has_repr α] : has_repr (with_one α) := -⟨λ o, match o with | none := "1" | (some a) := "↑" ++ repr a end⟩ - -@[to_additive] -instance : monad with_one := option.monad - -@[to_additive] -instance : has_one (with_one α) := ⟨none⟩ - -@[to_additive] -instance [has_mul α] : has_mul (with_one α) := ⟨option.lift_or_get (*)⟩ - -@[to_additive] -instance [has_inv α] : has_inv (with_one α) := ⟨λ a, option.map has_inv.inv a⟩ - -@[to_additive] -instance : inhabited (with_one α) := ⟨1⟩ - -@[to_additive] -instance [nonempty α] : nontrivial (with_one α) := option.nontrivial - -@[to_additive] -instance : has_coe_t α (with_one α) := ⟨some⟩ - -@[to_additive] -lemma some_eq_coe {a : α} : (some a : with_one α) = ↑a := rfl - -@[simp, to_additive] -lemma coe_ne_one {a : α} : (a : with_one α) ≠ (1 : with_one α) := -option.some_ne_none a - -@[simp, to_additive] -lemma one_ne_coe {a : α} : (1 : with_one α) ≠ a := -coe_ne_one.symm - -@[to_additive] -lemma ne_one_iff_exists {x : with_one α} : x ≠ 1 ↔ ∃ (a : α), ↑a = x := -option.ne_none_iff_exists - -@[to_additive] -instance : can_lift (with_one α) α := -{ coe := coe, - cond := λ a, a ≠ 1, - prf := λ a, ne_one_iff_exists.1 } - -@[simp, norm_cast, to_additive] -lemma coe_inj {a b : α} : (a : with_one α) = b ↔ a = b := -option.some_inj - -@[elab_as_eliminator, to_additive] -protected lemma cases_on {P : with_one α → Prop} : - ∀ (x : with_one α), P 1 → (∀ a : α, P a) → P x := -option.cases_on - --- the `show` statements in the proofs are important, because otherwise the generated lemmas --- `with_one.mul_one_class._proof_{1,2}` have an ill-typed statement after `with_one` is made --- irreducible. -@[to_additive] -instance [has_mul α] : mul_one_class (with_one α) := -{ mul := (*), - one := (1), - one_mul := show ∀ x : with_one α, 1 * x = x, from (option.lift_or_get_is_left_id _).1, - mul_one := show ∀ x : with_one α, x * 1 = x, from (option.lift_or_get_is_right_id _).1 } - -@[to_additive] -instance [semigroup α] : monoid (with_one α) := -{ mul_assoc := (option.lift_or_get_assoc _).1, - ..with_one.mul_one_class } - -example [semigroup α] : - @monoid.to_mul_one_class _ (@with_one.monoid α _) = @with_one.mul_one_class α _ := rfl - -@[to_additive] -instance [comm_semigroup α] : comm_monoid (with_one α) := -{ mul_comm := (option.lift_or_get_comm _).1, - ..with_one.monoid } - -section --- workaround: we make `with_one`/`with_zero` irreducible for this definition, otherwise `simps` --- will unfold it in the statement of the lemma it generates. -local attribute [irreducible] with_one with_zero -/-- `coe` as a bundled morphism -/ -@[to_additive "`coe` as a bundled morphism", simps apply] -def coe_mul_hom [has_mul α] : α →ₙ* (with_one α) := -{ to_fun := coe, map_mul' := λ x y, rfl } - -end - -section lift - -variables [has_mul α] [mul_one_class β] - -/-- Lift a semigroup homomorphism `f` to a bundled monoid homorphism. -/ -@[to_additive "Lift an add_semigroup homomorphism `f` to a bundled add_monoid homorphism."] -def lift : (α →ₙ* β) ≃ (with_one α →* β) := -{ to_fun := λ f, - { to_fun := λ x, option.cases_on x 1 f, - map_one' := rfl, - map_mul' := λ x y, - with_one.cases_on x (by { rw one_mul, exact (one_mul _).symm }) $ λ x, - with_one.cases_on y (by { rw mul_one, exact (mul_one _).symm }) $ λ y, - f.map_mul x y }, - inv_fun := λ F, F.to_mul_hom.comp coe_mul_hom, - left_inv := λ f, mul_hom.ext $ λ x, rfl, - right_inv := λ F, monoid_hom.ext $ λ x, with_one.cases_on x F.map_one.symm $ λ x, rfl } - -variables (f : α →ₙ* β) - -@[simp, to_additive] -lemma lift_coe (x : α) : lift f x = f x := rfl - -@[simp, to_additive] -lemma lift_one : lift f 1 = 1 := rfl - -@[to_additive] -theorem lift_unique (f : with_one α →* β) : f = lift (f.to_mul_hom.comp coe_mul_hom) := -(lift.apply_symm_apply f).symm - -end lift - -attribute [irreducible] with_one - -section map - -variables [has_mul α] [has_mul β] [has_mul γ] - -/-- Given a multiplicative map from `α → β` returns a monoid homomorphism - from `with_one α` to `with_one β` -/ -@[to_additive "Given an additive map from `α → β` returns an add_monoid homomorphism - from `with_zero α` to `with_zero β`"] -def map (f : α →ₙ* β) : with_one α →* with_one β := -lift (coe_mul_hom.comp f) - -@[simp, to_additive] lemma map_coe (f : α →ₙ* β) (a : α) : map f (a : with_one α) = f a := -lift_coe _ _ - -@[simp, to_additive] -lemma map_id : map (mul_hom.id α) = monoid_hom.id (with_one α) := -by { ext, induction x using with_one.cases_on; refl } - -@[to_additive] -lemma map_map (f : α →ₙ* β) (g : β →ₙ* γ) (x) : - map g (map f x) = map (g.comp f) x := -by { induction x using with_one.cases_on; refl } - -@[simp, to_additive] -lemma map_comp (f : α →ₙ* β) (g : β →ₙ* γ) : - map (g.comp f) = (map g).comp (map f) := -monoid_hom.ext $ λ x, (map_map f g x).symm - -/-- A version of `equiv.option_congr` for `with_one`. -/ -@[to_additive "A version of `equiv.option_congr` for `with_zero`.", simps apply] -def _root_.mul_equiv.with_one_congr (e : α ≃* β) : with_one α ≃* with_one β := -{ to_fun := map e.to_mul_hom, - inv_fun := map e.symm.to_mul_hom, - left_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp }, - right_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp }, - .. map e.to_mul_hom } - -@[simp] -lemma _root_.mul_equiv.with_one_congr_refl : (mul_equiv.refl α).with_one_congr = mul_equiv.refl _ := -mul_equiv.to_monoid_hom_injective map_id - -@[simp] -lemma _root_.mul_equiv.with_one_congr_symm (e : α ≃* β) : - e.with_one_congr.symm = e.symm.with_one_congr := rfl - -@[simp] -lemma _root_.mul_equiv.with_one_congr_trans (e₁ : α ≃* β) (e₂ : β ≃* γ) : - e₁.with_one_congr.trans e₂.with_one_congr = (e₁.trans e₂).with_one_congr := -mul_equiv.to_monoid_hom_injective (map_comp _ _).symm - -end map - -@[simp, norm_cast, to_additive] -lemma coe_mul [has_mul α] (a b : α) : ((a * b : α) : with_one α) = a * b := rfl - -@[simp, norm_cast, to_additive] -lemma coe_inv [has_inv α] (a : α) : ((a⁻¹ : α) : with_one α) = a⁻¹ := rfl - -end with_one - -namespace with_zero - -instance [one : has_one α] : has_one (with_zero α) := -{ ..one } - -@[simp, norm_cast] lemma coe_one [has_one α] : ((1 : α) : with_zero α) = 1 := rfl - -instance [has_mul α] : mul_zero_class (with_zero α) := -{ mul := λ o₁ o₂, o₁.bind (λ a, option.map (λ b, a * b) o₂), - zero_mul := λ a, rfl, - mul_zero := λ a, by cases a; refl, - ..with_zero.has_zero } - -@[simp, norm_cast] lemma coe_mul {α : Type u} [has_mul α] - {a b : α} : ((a * b : α) : with_zero α) = a * b := rfl - -@[simp] lemma zero_mul {α : Type u} [has_mul α] - (a : with_zero α) : 0 * a = 0 := rfl - -@[simp] lemma mul_zero {α : Type u} [has_mul α] - (a : with_zero α) : a * 0 = 0 := by cases a; refl - -instance [semigroup α] : semigroup_with_zero (with_zero α) := -{ mul_assoc := λ a b c, match a, b, c with - | none, _, _ := rfl - | some a, none, _ := rfl - | some a, some b, none := rfl - | some a, some b, some c := congr_arg some (mul_assoc _ _ _) - end, - ..with_zero.mul_zero_class } - -instance [comm_semigroup α] : comm_semigroup (with_zero α) := -{ mul_comm := λ a b, match a, b with - | none, _ := (mul_zero _).symm - | some a, none := rfl - | some a, some b := congr_arg some (mul_comm _ _) - end, - ..with_zero.semigroup_with_zero } - -instance [mul_one_class α] : mul_zero_one_class (with_zero α) := -{ one_mul := λ a, match a with - | none := rfl - | some a := congr_arg some $ one_mul _ - end, - mul_one := λ a, match a with - | none := rfl - | some a := congr_arg some $ mul_one _ - end, - ..with_zero.mul_zero_class, - ..with_zero.has_one } - -instance [has_one α] [has_pow α ℕ] : has_pow (with_zero α) ℕ := -⟨λ x n, match x, n with - | none, 0 := 1 - | none, n + 1 := 0 - | some x, n := ↑(x ^ n) - end⟩ - -@[simp, norm_cast] lemma coe_pow [has_one α] [has_pow α ℕ] {a : α} (n : ℕ) : - ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl - -instance [monoid α] : monoid_with_zero (with_zero α) := -{ npow := λ n x, x ^ n, - npow_zero' := λ x, match x with - | none := rfl - | some x := congr_arg some $ pow_zero _ - end, - npow_succ' := λ n x, match x with - | none := rfl - | some x := congr_arg some $ pow_succ _ _ - end, - .. with_zero.mul_zero_one_class, - .. with_zero.semigroup_with_zero } - -instance [comm_monoid α] : comm_monoid_with_zero (with_zero α) := -{ ..with_zero.monoid_with_zero, ..with_zero.comm_semigroup } - -/-- Given an inverse operation on `α` there is an inverse operation - on `with_zero α` sending `0` to `0`-/ -instance [has_inv α] : has_inv (with_zero α) := ⟨λ a, option.map has_inv.inv a⟩ - -@[simp, norm_cast] lemma coe_inv [has_inv α] (a : α) : - ((a⁻¹ : α) : with_zero α) = a⁻¹ := rfl - -@[simp] lemma inv_zero [has_inv α] : - (0 : with_zero α)⁻¹ = 0 := rfl - -instance [has_div α] : has_div (with_zero α) := -⟨λ o₁ o₂, o₁.bind (λ a, option.map (λ b, a / b) o₂)⟩ - -@[norm_cast] lemma coe_div [has_div α] (a b : α) : ↑(a / b : α) = (a / b : with_zero α) := rfl - -instance [has_one α] [has_pow α ℤ] : has_pow (with_zero α) ℤ := -⟨λ x n, match x, n with - | none, int.of_nat 0 := 1 - | none, int.of_nat (nat.succ n) := 0 - | none, int.neg_succ_of_nat n := 0 - | some x, n := ↑(x ^ n) - end⟩ - -@[simp, norm_cast] lemma coe_zpow [div_inv_monoid α] {a : α} (n : ℤ) : - ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl - -instance [div_inv_monoid α] : div_inv_monoid (with_zero α) := -{ div_eq_mul_inv := λ a b, match a, b with - | none, _ := rfl - | some a, none := rfl - | some a, some b := congr_arg some (div_eq_mul_inv _ _) - end, - zpow := λ n x, x ^ n, - zpow_zero' := λ x, match x with - | none := rfl - | some x := congr_arg some $ zpow_zero _ - end, - zpow_succ' := λ n x, match x with - | none := rfl - | some x := congr_arg some $ div_inv_monoid.zpow_succ' _ _ - end, - zpow_neg' := λ n x, match x with - | none := rfl - | some x := congr_arg some $ div_inv_monoid.zpow_neg' _ _ - end, - .. with_zero.has_div, - .. with_zero.has_inv, - .. with_zero.monoid_with_zero, } - - -section group -variables [group α] - -@[simp] lemma inv_one : (1 : with_zero α)⁻¹ = 1 := -show ((1⁻¹ : α) : with_zero α) = 1, by simp - -/-- if `G` is a group then `with_zero G` is a group with zero. -/ -instance : group_with_zero (with_zero α) := -{ inv_zero := inv_zero, - mul_inv_cancel := λ a ha, by { lift a to α using ha, norm_cast, apply mul_right_inv }, - .. with_zero.monoid_with_zero, - .. with_zero.div_inv_monoid, - .. with_zero.nontrivial } - -end group - -instance [comm_group α] : comm_group_with_zero (with_zero α) := -{ .. with_zero.group_with_zero, .. with_zero.comm_monoid_with_zero } - -instance [semiring α] : semiring (with_zero α) := -{ left_distrib := λ a b c, begin - cases a with a, {refl}, - cases b with b; cases c with c; try {refl}, - exact congr_arg some (left_distrib _ _ _) - end, - right_distrib := λ a b c, begin - cases c with c, - { change (a + b) * 0 = a * 0 + b * 0, simp }, - cases a with a; cases b with b; try {refl}, - exact congr_arg some (right_distrib _ _ _) - end, - ..with_zero.add_comm_monoid, - ..with_zero.mul_zero_class, - ..with_zero.monoid_with_zero } - -attribute [irreducible] with_zero - -end with_zero diff --git a/src/algebra/group/with_one/basic.lean b/src/algebra/group/with_one/basic.lean new file mode 100644 index 0000000000000..303a93390afda --- /dev/null +++ b/src/algebra/group/with_one/basic.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2018 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Johan Commelin +-/ +import algebra.group.with_one.defs +import algebra.hom.equiv.basic + +/-! +# More operations on `with_one` and `with_zero` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines various bundled morphisms on `with_one` and `with_zero` +that were not available in `algebra/group/with_one/defs`. + +## Main definitions + +* `with_one.lift`, `with_zero.lift` +* `with_one.map`, `with_zero.map` +-/ + +universes u v w +variables {α : Type u} {β : Type v} {γ : Type w} + +namespace with_one + +section +-- workaround: we make `with_one`/`with_zero` irreducible for this definition, otherwise `simps` +-- will unfold it in the statement of the lemma it generates. +local attribute [irreducible] with_one with_zero +/-- `coe` as a bundled morphism -/ +@[to_additive "`coe` as a bundled morphism", simps apply] +def coe_mul_hom [has_mul α] : α →ₙ* (with_one α) := +{ to_fun := coe, map_mul' := λ x y, rfl } + +end + +section lift + +local attribute [semireducible] with_one with_zero + +variables [has_mul α] [mul_one_class β] + +/-- Lift a semigroup homomorphism `f` to a bundled monoid homorphism. -/ +@[to_additive "Lift an add_semigroup homomorphism `f` to a bundled add_monoid homorphism."] +def lift : (α →ₙ* β) ≃ (with_one α →* β) := +{ to_fun := λ f, + { to_fun := λ x, option.cases_on x 1 f, + map_one' := rfl, + map_mul' := λ x y, + with_one.cases_on x (by { rw one_mul, exact (one_mul _).symm }) $ λ x, + with_one.cases_on y (by { rw mul_one, exact (mul_one _).symm }) $ λ y, + f.map_mul x y }, + inv_fun := λ F, F.to_mul_hom.comp coe_mul_hom, + left_inv := λ f, mul_hom.ext $ λ x, rfl, + right_inv := λ F, monoid_hom.ext $ λ x, with_one.cases_on x F.map_one.symm $ λ x, rfl } + +variables (f : α →ₙ* β) + +@[simp, to_additive] +lemma lift_coe (x : α) : lift f x = f x := rfl + +@[simp, to_additive] +lemma lift_one : lift f 1 = 1 := rfl + +@[to_additive] +theorem lift_unique (f : with_one α →* β) : f = lift (f.to_mul_hom.comp coe_mul_hom) := +(lift.apply_symm_apply f).symm + +end lift + +section map + +variables [has_mul α] [has_mul β] [has_mul γ] + +/-- Given a multiplicative map from `α → β` returns a monoid homomorphism + from `with_one α` to `with_one β` -/ +@[to_additive "Given an additive map from `α → β` returns an add_monoid homomorphism + from `with_zero α` to `with_zero β`"] +def map (f : α →ₙ* β) : with_one α →* with_one β := +lift (coe_mul_hom.comp f) + +@[simp, to_additive] lemma map_coe (f : α →ₙ* β) (a : α) : map f (a : with_one α) = f a := +lift_coe _ _ + +@[simp, to_additive] +lemma map_id : map (mul_hom.id α) = monoid_hom.id (with_one α) := +by { ext, induction x using with_one.cases_on; refl } + +@[to_additive] +lemma map_map (f : α →ₙ* β) (g : β →ₙ* γ) (x) : + map g (map f x) = map (g.comp f) x := +by { induction x using with_one.cases_on; refl } + +@[simp, to_additive] +lemma map_comp (f : α →ₙ* β) (g : β →ₙ* γ) : + map (g.comp f) = (map g).comp (map f) := +monoid_hom.ext $ λ x, (map_map f g x).symm + +/-- A version of `equiv.option_congr` for `with_one`. -/ +@[to_additive "A version of `equiv.option_congr` for `with_zero`.", simps apply] +def _root_.mul_equiv.with_one_congr (e : α ≃* β) : with_one α ≃* with_one β := +{ to_fun := map e.to_mul_hom, + inv_fun := map e.symm.to_mul_hom, + left_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp }, + right_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp }, + .. map e.to_mul_hom } + +@[simp] +lemma _root_.mul_equiv.with_one_congr_refl : (mul_equiv.refl α).with_one_congr = mul_equiv.refl _ := +mul_equiv.to_monoid_hom_injective map_id + +@[simp] +lemma _root_.mul_equiv.with_one_congr_symm (e : α ≃* β) : + e.with_one_congr.symm = e.symm.with_one_congr := rfl + +@[simp] +lemma _root_.mul_equiv.with_one_congr_trans (e₁ : α ≃* β) (e₂ : β ≃* γ) : + e₁.with_one_congr.trans e₂.with_one_congr = (e₁.trans e₂).with_one_congr := +mul_equiv.to_monoid_hom_injective (map_comp _ _).symm + +end map + +end with_one diff --git a/src/algebra/group/with_one/defs.lean b/src/algebra/group/with_one/defs.lean new file mode 100644 index 0000000000000..18428357b909c --- /dev/null +++ b/src/algebra/group/with_one/defs.lean @@ -0,0 +1,333 @@ +/- +Copyright (c) 2018 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Johan Commelin +-/ +import order.with_bot +import algebra.ring.defs + +/-! +# Adjoining a zero/one to semigroups and related algebraic structures + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains different results about adjoining an element to an algebraic structure which then +behaves like a zero or a one. An example is adjoining a one to a semigroup to obtain a monoid. That +this provides an example of an adjunction is proved in `algebra.category.Mon.adjunctions`. + +Another result says that adjoining to a group an element `zero` gives a `group_with_zero`. For more +information about these structures (which are not that standard in informal mathematics, see +`algebra.group_with_zero.basic`) + +## Implementation notes + +At various points in this file, `id $` is used in at the start of a proof field in a structure. This +ensures that the generated `_proof_1` lemmas are stated in terms of the algebraic operations and +not `option.map`, as the latter does not typecheck once `with_zero`/`with_one` is irreducible. +-/ + +universes u v w +variables {α : Type u} {β : Type v} {γ : Type w} + +/-- Add an extra element `1` to a type -/ +@[to_additive "Add an extra element `0` to a type"] +def with_one (α) := option α + +namespace with_one + +instance [has_repr α] : has_repr (with_zero α) := +⟨λ o, match o with | none := "0" | (some a) := "↑" ++ repr a end⟩ + +@[to_additive] +instance [has_repr α] : has_repr (with_one α) := +⟨λ o, match o with | none := "1" | (some a) := "↑" ++ repr a end⟩ + +@[to_additive] +instance : monad with_one := option.monad + +@[to_additive] +instance : has_one (with_one α) := ⟨none⟩ + +@[to_additive] +instance [has_mul α] : has_mul (with_one α) := ⟨option.lift_or_get (*)⟩ + +@[to_additive] instance [has_inv α] : has_inv (with_one α) := ⟨λ a, option.map has_inv.inv a⟩ + +@[to_additive] instance [has_involutive_inv α] : has_involutive_inv (with_one α) := +{ inv_inv := id $ λ a, (option.map_map _ _ _).trans $ by simp_rw [inv_comp_inv, option.map_id, id], + ..with_one.has_inv } + +@[to_additive] instance [has_inv α] : inv_one_class (with_one α) := +{ inv_one := rfl, + ..with_one.has_one, + ..with_one.has_inv } + +@[to_additive] +instance : inhabited (with_one α) := ⟨1⟩ + +@[to_additive] +instance [nonempty α] : nontrivial (with_one α) := option.nontrivial + +@[to_additive] +instance : has_coe_t α (with_one α) := ⟨some⟩ + +/-- Recursor for `with_one` using the preferred forms `1` and `↑a`. -/ +@[elab_as_eliminator, + to_additive "Recursor for `with_zero` using the preferred forms `0` and `↑a`."] +def rec_one_coe {C : with_one α → Sort*} (h₁ : C 1) (h₂ : Π (a : α), C a) : + Π (n : with_one α), C n := +option.rec h₁ h₂ + +/-- Deconstruct a `x : with_one α` to the underlying value in `α`, given a proof that `x ≠ 1`. -/ +@[to_additive unzero + "Deconstruct a `x : with_zero α` to the underlying value in `α`, given a proof that `x ≠ 0`."] +def unone {x : with_one α} (hx : x ≠ 1) : α := with_bot.unbot x hx + +@[simp, to_additive unzero_coe] +lemma unone_coe {x : α} (hx : (x : with_one α) ≠ 1) : unone hx = x := rfl + +@[simp, to_additive coe_unzero] +lemma coe_unone {x : with_one α} (hx : x ≠ 1) : ↑(unone hx) = x := with_bot.coe_unbot x hx + +@[to_additive] +lemma some_eq_coe {a : α} : (some a : with_one α) = ↑a := rfl + +@[simp, to_additive] +lemma coe_ne_one {a : α} : (a : with_one α) ≠ (1 : with_one α) := +option.some_ne_none a + +@[simp, to_additive] +lemma one_ne_coe {a : α} : (1 : with_one α) ≠ a := +coe_ne_one.symm + +@[to_additive] +lemma ne_one_iff_exists {x : with_one α} : x ≠ 1 ↔ ∃ (a : α), ↑a = x := +option.ne_none_iff_exists + +@[to_additive] +instance can_lift : can_lift (with_one α) α coe (λ a, a ≠ 1) := +{ prf := λ a, ne_one_iff_exists.1 } + +@[simp, norm_cast, to_additive] +lemma coe_inj {a b : α} : (a : with_one α) = b ↔ a = b := +option.some_inj + +@[elab_as_eliminator, to_additive] +protected lemma cases_on {P : with_one α → Prop} : + ∀ (x : with_one α), P 1 → (∀ a : α, P a) → P x := +option.cases_on + +@[to_additive] +instance [has_mul α] : mul_one_class (with_one α) := +{ mul := (*), + one := (1), + one_mul := id $ (option.lift_or_get_is_left_id _).1, + mul_one := id $ (option.lift_or_get_is_right_id _).1 } + +@[to_additive] +instance [semigroup α] : monoid (with_one α) := +{ mul_assoc := (option.lift_or_get_assoc _).1, + ..with_one.mul_one_class } + +example [semigroup α] : + @monoid.to_mul_one_class _ (@with_one.monoid α _) = @with_one.mul_one_class α _ := rfl + +@[to_additive] +instance [comm_semigroup α] : comm_monoid (with_one α) := +{ mul_comm := (option.lift_or_get_comm _).1, + ..with_one.monoid } + +attribute [irreducible] with_one + +@[simp, norm_cast, to_additive] +lemma coe_mul [has_mul α] (a b : α) : ((a * b : α) : with_one α) = a * b := rfl + +@[simp, norm_cast, to_additive] +lemma coe_inv [has_inv α] (a : α) : ((a⁻¹ : α) : with_one α) = a⁻¹ := rfl + +end with_one + +namespace with_zero + +instance [one : has_one α] : has_one (with_zero α) := +{ ..one } + +@[simp, norm_cast] lemma coe_one [has_one α] : ((1 : α) : with_zero α) = 1 := rfl + +instance [has_mul α] : mul_zero_class (with_zero α) := +{ mul := option.map₂ (*), + zero_mul := id $ option.map₂_none_left (*), + mul_zero := id $ option.map₂_none_right (*), + ..with_zero.has_zero } + +@[simp, norm_cast] lemma coe_mul {α : Type u} [has_mul α] + {a b : α} : ((a * b : α) : with_zero α) = a * b := rfl + +instance [has_mul α] : no_zero_divisors (with_zero α) := +⟨λ a b, id $ option.map₂_eq_none_iff.1⟩ + +instance [semigroup α] : semigroup_with_zero (with_zero α) := +{ mul_assoc := id $ λ _ _ _, option.map₂_assoc mul_assoc, + ..with_zero.mul_zero_class } + +instance [comm_semigroup α] : comm_semigroup (with_zero α) := +{ mul_comm := id $ λ _ _, option.map₂_comm mul_comm, + ..with_zero.semigroup_with_zero } + +instance [mul_one_class α] : mul_zero_one_class (with_zero α) := +{ one_mul := id $ option.map₂_left_identity one_mul, + mul_one := id $ option.map₂_right_identity mul_one, + ..with_zero.mul_zero_class, + ..with_zero.has_one } + +instance [has_one α] [has_pow α ℕ] : has_pow (with_zero α) ℕ := +⟨λ x n, match x, n with + | none, 0 := 1 + | none, n + 1 := 0 + | some x, n := ↑(x ^ n) + end⟩ + +@[simp, norm_cast] lemma coe_pow [has_one α] [has_pow α ℕ] {a : α} (n : ℕ) : + ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl + +instance [monoid α] : monoid_with_zero (with_zero α) := +{ npow := λ n x, x ^ n, + npow_zero' := λ x, match x with + | none := rfl + | some x := congr_arg some $ pow_zero _ + end, + npow_succ' := λ n x, match x with + | none := rfl + | some x := congr_arg some $ pow_succ _ _ + end, + .. with_zero.mul_zero_one_class, + .. with_zero.semigroup_with_zero } + +instance [comm_monoid α] : comm_monoid_with_zero (with_zero α) := +{ ..with_zero.monoid_with_zero, ..with_zero.comm_semigroup } + +/-- Given an inverse operation on `α` there is an inverse operation + on `with_zero α` sending `0` to `0`-/ +instance [has_inv α] : has_inv (with_zero α) := ⟨λ a, option.map has_inv.inv a⟩ + +@[simp, norm_cast] lemma coe_inv [has_inv α] (a : α) : ((a⁻¹ : α) : with_zero α) = a⁻¹ := rfl + +@[simp] lemma inv_zero [has_inv α] : (0 : with_zero α)⁻¹ = 0 := rfl + +instance [has_involutive_inv α] : has_involutive_inv (with_zero α) := +{ inv_inv := id $ λ a, (option.map_map _ _ _).trans $ by simp_rw [inv_comp_inv, option.map_id, id], + ..with_zero.has_inv } + +instance [inv_one_class α] : inv_one_class (with_zero α) := +{ inv_one := show ((1⁻¹ : α) : with_zero α) = 1, by simp, + ..with_zero.has_one, + ..with_zero.has_inv } + +instance [has_div α] : has_div (with_zero α) := ⟨option.map₂ (/)⟩ + +@[norm_cast] lemma coe_div [has_div α] (a b : α) : ↑(a / b : α) = (a / b : with_zero α) := rfl + +instance [has_one α] [has_pow α ℤ] : has_pow (with_zero α) ℤ := +⟨λ x n, match x, n with + | none, int.of_nat 0 := 1 + | none, int.of_nat (nat.succ n) := 0 + | none, int.neg_succ_of_nat n := 0 + | some x, n := ↑(x ^ n) + end⟩ + +@[simp, norm_cast] lemma coe_zpow [div_inv_monoid α] {a : α} (n : ℤ) : + ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl + +instance [div_inv_monoid α] : div_inv_monoid (with_zero α) := +{ div_eq_mul_inv := λ a b, match a, b with + | none, _ := rfl + | some a, none := rfl + | some a, some b := congr_arg some (div_eq_mul_inv _ _) + end, + zpow := λ n x, x ^ n, + zpow_zero' := λ x, match x with + | none := rfl + | some x := congr_arg some $ zpow_zero _ + end, + zpow_succ' := λ n x, match x with + | none := rfl + | some x := congr_arg some $ div_inv_monoid.zpow_succ' _ _ + end, + zpow_neg' := λ n x, match x with + | none := rfl + | some x := congr_arg some $ div_inv_monoid.zpow_neg' _ _ + end, + .. with_zero.has_div, + .. with_zero.has_inv, + .. with_zero.monoid_with_zero, } + +instance [div_inv_one_monoid α] : div_inv_one_monoid (with_zero α) := +{ ..with_zero.div_inv_monoid, + ..with_zero.inv_one_class } + +instance [division_monoid α] : division_monoid (with_zero α) := +{ mul_inv_rev := λ a b, match a, b with + | none, none := rfl + | none, some b := rfl + | some a, none := rfl + | some a, some b := congr_arg some $ mul_inv_rev _ _ + end, + inv_eq_of_mul := λ a b, match a, b with + | none, none := λ _, rfl + | none, some b := by contradiction + | some a, none := by contradiction + | some a, some b := λ h, congr_arg some $ inv_eq_of_mul_eq_one_right $ option.some_injective _ h + end, + .. with_zero.div_inv_monoid, .. with_zero.has_involutive_inv } + +instance [division_comm_monoid α] : division_comm_monoid (with_zero α) := +{ .. with_zero.division_monoid, .. with_zero.comm_semigroup } + +section group +variables [group α] + +/-- if `G` is a group then `with_zero G` is a group with zero. -/ +instance : group_with_zero (with_zero α) := +{ inv_zero := inv_zero, + mul_inv_cancel := λ a ha, by { lift a to α using ha, norm_cast, apply mul_right_inv }, + .. with_zero.monoid_with_zero, + .. with_zero.div_inv_monoid, + .. with_zero.nontrivial } + +end group + +instance [comm_group α] : comm_group_with_zero (with_zero α) := +{ .. with_zero.group_with_zero, .. with_zero.comm_monoid_with_zero } + +instance [add_monoid_with_one α] : add_monoid_with_one (with_zero α) := +{ nat_cast := λ n, if n = 0 then 0 else (n.cast : α), + nat_cast_zero := rfl, + nat_cast_succ := λ n, begin + cases n, + show (((1 : ℕ) : α) : with_zero α) = 0 + 1, by rw [nat.cast_one, coe_one, zero_add], + show (((n + 2 : ℕ) : α) : with_zero α) = ((n + 1 : ℕ) : α) + 1, + by rw [nat.cast_succ, coe_add, coe_one], + end, + .. with_zero.add_monoid, ..with_zero.has_one } + +instance [semiring α] : semiring (with_zero α) := +{ left_distrib := λ a b c, begin + cases a with a, {refl}, + cases b with b; cases c with c; try {refl}, + exact congr_arg some (left_distrib _ _ _) + end, + right_distrib := λ a b c, begin + cases c with c, + { change (a + b) * 0 = a * 0 + b * 0, simp }, + cases a with a; cases b with b; try {refl}, + exact congr_arg some (right_distrib _ _ _) + end, + ..with_zero.add_monoid_with_one, + ..with_zero.add_comm_monoid, + ..with_zero.mul_zero_class, + ..with_zero.monoid_with_zero } + +attribute [irreducible] with_zero + +end with_zero diff --git a/src/algebra/group/with_one/units.lean b/src/algebra/group/with_one/units.lean new file mode 100644 index 0000000000000..9c28cc1249e65 --- /dev/null +++ b/src/algebra/group/with_one/units.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2018 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Johan Commelin +-/ +import algebra.group.with_one.basic +import algebra.group_with_zero.units.basic + +/-! +# Isomorphism between a group and the units of itself adjoined with `0` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Notes +This is here to keep `algebra.group_with_zero.units.basic` out of the import requirements of +`algebra.order.field.defs`. +-/ + +namespace with_zero + +/-- Any group is isomorphic to the units of itself adjoined with `0`. -/ +def units_with_zero_equiv {α : Type*} [group α] : (with_zero α)ˣ ≃* α := +{ to_fun := λ a, unzero a.ne_zero, + inv_fun := λ a, units.mk0 a coe_ne_zero, + left_inv := λ _, units.ext $ by simpa only [coe_unzero], + right_inv := λ _, rfl, + map_mul' := λ _ _, coe_inj.mp $ by simpa only [coe_unzero, coe_mul] } + +end with_zero diff --git a/src/algebra/group_power/basic.lean b/src/algebra/group_power/basic.lean index 090a1761bcd98..281fa0372ef7e 100644 --- a/src/algebra/group_power/basic.lean +++ b/src/algebra/group_power/basic.lean @@ -3,13 +3,16 @@ Copyright (c) 2015 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Robert Y. Lewis -/ -import data.nat.basic -import tactic.monotonicity.basic -import group_theory.group_action.defs +import algebra.divisibility.basic +import algebra.group.commute +import algebra.group.type_tags /-! # Power operations on monoids and groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The power operation on monoids and groups. We separate this from group, because it depends on `ℕ`, which in turn depends on other parts of algebra. @@ -22,7 +25,7 @@ The analogous results for groups with zero can be found in `algebra.group_with_z ## Notation - `a ^ n` is used as notation for `has_pow.pow a n`; in this file `n : ℕ` or `n : ℤ`. -- `n • a` is used as notation for `has_scalar.smul n a`; in this file `n : ℕ` or `n : ℤ`. +- `n • a` is used as notation for `has_smul.smul n a`; in this file `n : ℕ` or `n : ℤ`. ## Implementation details @@ -31,7 +34,7 @@ We adopt the convention that `0^0 = 1`. universes u v w x y z u₁ u₂ -variables {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z} +variables {α : Type*} {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z} {R : Type u₁} {S : Type u₂} /-! @@ -68,6 +71,10 @@ by rw [pow_succ, pow_one] alias pow_two ← sq +theorem pow_three' (a : M) : a^3 = a * a * a := by rw [pow_succ', pow_two] + +theorem pow_three (a : M) : a^3 = a * (a * a) := by rw [pow_succ, pow_two] + @[to_additive] theorem pow_mul_comm' (a : M) (n : ℕ) : a^n * a = a * a^n := commute.pow_self a n @@ -102,11 +109,21 @@ by rw [nat.mul_comm, pow_mul] @[to_additive nsmul_add_sub_nsmul] theorem pow_mul_pow_sub (a : M) {m n : ℕ} (h : m ≤ n) : a ^ m * a ^ (n - m) = a ^ n := -by rw [←pow_add, nat.add_comm, tsub_add_cancel_of_le h] +by rw [←pow_add, nat.add_comm, nat.sub_add_cancel h] @[to_additive sub_nsmul_nsmul_add] theorem pow_sub_mul_pow (a : M) {m n : ℕ} (h : m ≤ n) : a ^ (n - m) * a ^ m = a ^ n := -by rw [←pow_add, tsub_add_cancel_of_le h] +by rw [←pow_add, nat.sub_add_cancel h] + +/-- If `x ^ n = 1`, then `x ^ m` is the same as `x ^ (m % n)` -/ +@[to_additive nsmul_eq_mod_nsmul "If `n • x = 0`, then `m • x` is the same as `(m % n) • x`"] +lemma pow_eq_pow_mod {M : Type*} [monoid M] {x : M} (m : ℕ) {n : ℕ} (h : x ^ n = 1) : + x ^ m = x ^ (m % n) := +begin + have t := congr_arg (λ a, x ^ a) ((nat.add_comm _ _).trans (nat.mod_add_div _ _)).symm, + dsimp at t, + rw [t, pow_add, pow_mul, h, one_pow, one_mul], +end @[to_additive bit0_nsmul] theorem pow_bit0 (a : M) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _ @@ -132,6 +149,17 @@ by rw [pow_bit0, (commute.refl a).mul_pow] theorem pow_bit1' (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a := by rw [bit1, pow_succ', pow_bit0'] +@[to_additive] +lemma pow_mul_pow_eq_one {a b : M} (n : ℕ) (h : a * b = 1) : + a ^ n * b ^ n = 1 := +begin + induction n with n hn, + { simp }, + { calc a ^ n.succ * b ^ n.succ = a ^ n * a * (b * b ^ n) : by rw [pow_succ', pow_succ] + ... = a ^ n * (a * b) * b ^ n : by simp only [mul_assoc] + ... = 1 : by simp [h, hn] } +end + lemma dvd_pow {x y : M} (hxy : x ∣ y) : ∀ {n : ℕ} (hn : n ≠ 0), x ∣ y^n | 0 hn := (hn rfl).elim @@ -193,260 +221,87 @@ theorem zpow_neg_coe_of_pos (a : G) : ∀ {n : ℕ}, 0 < n → a ^ -(n:ℤ) = (a end div_inv_monoid -section group -variables [group G] [group H] [add_group A] [add_group B] - -open int - -section nat - -@[simp, to_additive] theorem inv_pow (a : G) (n : ℕ) : (a⁻¹)^n = (a^n)⁻¹ := -begin - induction n with n ih, - { rw [pow_zero, pow_zero, one_inv] }, - { rw [pow_succ', pow_succ, ih, mul_inv_rev] } -end - -@[to_additive] -- rename to sub_nsmul? -theorem pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ := -have h1 : m - n + n = m, from tsub_add_cancel_of_le h, -have h2 : a^(m - n) * a^n = a^m, by rw [←pow_add, h1], -eq_mul_inv_of_mul_eq h2 - -@[to_additive] -theorem pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m := -(commute.refl a).inv_left.pow_pow m n - -@[to_additive sub_nsmul_neg] -theorem inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n := -by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv] +section division_monoid +variables [division_monoid α] {a b : α} -end nat +@[simp, to_additive] lemma inv_pow (a : α) : ∀ n : ℕ, (a⁻¹) ^ n = (a ^ n)⁻¹ +| 0 := by rw [pow_zero, pow_zero, inv_one] +| (n + 1) := by rw [pow_succ', pow_succ, inv_pow, mul_inv_rev] -- the attributes are intentionally out of order. `smul_zero` proves `zsmul_zero`. -@[to_additive zsmul_zero, simp] -theorem one_zpow : ∀ (n : ℤ), (1 : G) ^ n = 1 +@[to_additive zsmul_zero, simp] lemma one_zpow : ∀ (n : ℤ), (1 : α) ^ n = 1 | (n : ℕ) := by rw [zpow_coe_nat, one_pow] -| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, one_inv] +| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, inv_one] -@[simp, to_additive neg_zsmul] -theorem zpow_neg (a : G) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹ +@[simp, to_additive neg_zsmul] lemma zpow_neg (a : α) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹ | (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _ | 0 := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp } | -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl } -@[to_additive neg_one_zsmul_add] lemma mul_zpow_neg_one (a b : G) : - (a*b)^(-(1:ℤ)) = b^(-(1:ℤ))*a^(-(1:ℤ)) := -by simp only [mul_inv_rev, zpow_one, zpow_neg] +@[to_additive neg_one_zsmul_add] +lemma mul_zpow_neg_one (a b : α) : (a * b) ^ (-1 : ℤ) = b ^ (-1 : ℤ) * a ^ (-1 : ℤ) := +by simp_rw [zpow_neg_one, mul_inv_rev] -@[to_additive zsmul_neg] -theorem inv_zpow (a : G) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹ +@[to_additive zsmul_neg] lemma inv_zpow (a : α) : ∀ n : ℤ, a⁻¹ ^ n = (a ^ n)⁻¹ | (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow] | -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow] +@[simp, to_additive zsmul_neg'] +lemma inv_zpow' (a : α) (n : ℤ) : a⁻¹ ^ n = a ^ (-n) := by rw [inv_zpow, zpow_neg] + +@[to_additive nsmul_zero_sub] +lemma one_div_pow (a : α) (n : ℕ) : (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_pow] + +@[to_additive zsmul_zero_sub] +lemma one_div_zpow (a : α) (n : ℤ) : (1 / a) ^ n = 1 / a ^ n := by simp_rw [one_div, inv_zpow] + @[to_additive add_commute.zsmul_add] -theorem commute.mul_zpow {a b : G} (h : commute a b) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n -| (n : ℕ) := by simp [zpow_coe_nat, h.mul_pow n] -| -[1+n] := by simp [h.mul_pow, (h.pow_pow n.succ n.succ).inv_inv.symm.eq] +protected lemma commute.mul_zpow (h : commute a b) : ∀ (i : ℤ), (a * b) ^ i = a ^ i * b ^ i +| (n : ℕ) := by simp [h.mul_pow n] +| -[1+n] := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev] -end group +end division_monoid + +section division_comm_monoid +variables [division_comm_monoid α] -section comm_group -variables [comm_group G] [add_comm_group A] +@[to_additive zsmul_add] lemma mul_zpow (a b : α) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n := +(commute.all a b).mul_zpow -@[to_additive zsmul_add] -theorem mul_zpow (a b : G) (n : ℤ) : (a * b)^n = a^n * b^n := (commute.all a b).mul_zpow n +@[simp, to_additive nsmul_sub] lemma div_pow (a b : α) (n : ℕ) : (a / b) ^ n = a ^ n / b ^ n := +by simp only [div_eq_mul_inv, mul_pow, inv_pow] -@[to_additive zsmul_sub] -theorem div_zpow (a b : G) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n := -by rw [div_eq_mul_inv, div_eq_mul_inv, mul_zpow, inv_zpow] +@[simp, to_additive zsmul_sub] lemma div_zpow (a b : α) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n := +by simp only [div_eq_mul_inv, mul_zpow, inv_zpow] -/-- The `n`th power map (`n` an integer) on a commutative group, considered as a group +/-- The `n`-th power map (for an integer `n`) on a commutative group, considered as a group homomorphism. -/ @[to_additive "Multiplication by an integer `n` on a commutative additive group, considered as an additive group homomorphism.", simps] -def zpow_group_hom (n : ℤ) : G →* G := +def zpow_group_hom (n : ℤ) : α →* α := { to_fun := (^ n), map_one' := one_zpow n, map_mul' := λ a b, mul_zpow a b n } -end comm_group - -lemma zero_pow [monoid_with_zero R] : ∀ {n : ℕ}, 0 < n → (0 : R) ^ n = 0 -| (n+1) _ := by rw [pow_succ, zero_mul] - -lemma zero_pow_eq [monoid_with_zero R] (n : ℕ) : (0 : R)^n = if n = 0 then 1 else 0 := -begin - split_ifs with h, - { rw [h, pow_zero], }, - { rw [zero_pow (nat.pos_of_ne_zero h)] }, -end +end division_comm_monoid -lemma pow_eq_zero_of_le [monoid_with_zero M] {x : M} {n m : ℕ} - (hn : n ≤ m) (hx : x^n = 0) : x^m = 0 := -by rw [← tsub_add_cancel_of_le hn, pow_add, hx, mul_zero] +section group +variables [group G] [group H] [add_group A] [add_group B] -namespace ring_hom +@[to_additive sub_nsmul] lemma pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ := +eq_mul_inv_of_mul_eq $ by rw [←pow_add, nat.sub_add_cancel h] -variables [semiring R] [semiring S] +@[to_additive] lemma pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m := +(commute.refl a).inv_left.pow_pow _ _ -protected lemma map_pow (f : R →+* S) (a) : - ∀ n : ℕ, f (a ^ n) = (f a) ^ n := -map_pow f a +@[to_additive sub_nsmul_neg] +lemma inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n := +by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv] -end ring_hom +end group lemma pow_dvd_pow [monoid R] (a : R) {m n : ℕ} (h : m ≤ n) : - a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, tsub_add_cancel_of_le h]⟩ - -theorem pow_dvd_pow_of_dvd [comm_monoid R] {a b : R} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n -| 0 := by rw [pow_zero, pow_zero] -| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) } - -theorem pow_eq_zero [monoid_with_zero R] [no_zero_divisors R] {x : R} {n : ℕ} (H : x^n = 0) : - x = 0 := -begin - induction n with n ih, - { rw pow_zero at H, - rw [← mul_one x, H, mul_zero] }, - { rw pow_succ at H, - exact or.cases_on (mul_eq_zero.1 H) id ih } -end - -@[simp] lemma pow_eq_zero_iff [monoid_with_zero R] [no_zero_divisors R] - {a : R} {n : ℕ} (hn : 0 < n) : - a ^ n = 0 ↔ a = 0 := -begin - refine ⟨pow_eq_zero, _⟩, - rintros rfl, - exact zero_pow hn, -end - -lemma pow_ne_zero_iff [monoid_with_zero R] [no_zero_divisors R] {a : R} {n : ℕ} (hn : 0 < n) : - a ^ n ≠ 0 ↔ a ≠ 0 := -(pow_eq_zero_iff hn).not - -@[field_simps] theorem pow_ne_zero [monoid_with_zero R] [no_zero_divisors R] - {a : R} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 := -mt pow_eq_zero h - -theorem sq_eq_zero_iff [monoid_with_zero R] [no_zero_divisors R] {a : R} : a ^ 2 = 0 ↔ a = 0 := -pow_eq_zero_iff two_pos - -lemma pow_dvd_pow_iff [cancel_comm_monoid_with_zero R] - {x : R} {n m : ℕ} (h0 : x ≠ 0) (h1 : ¬ is_unit x) : - x ^ n ∣ x ^ m ↔ n ≤ m := -begin - split, - { intro h, rw [← not_lt], intro hmn, apply h1, - have : x ^ m * x ∣ x ^ m * 1, - { rw [← pow_succ', mul_one], exact (pow_dvd_pow _ (nat.succ_le_of_lt hmn)).trans h }, - rwa [mul_dvd_mul_iff_left, ← is_unit_iff_dvd_one] at this, apply pow_ne_zero m h0 }, - { apply pow_dvd_pow } -end - -section semiring -variables [semiring R] - -lemma min_pow_dvd_add {n m : ℕ} {a b c : R} (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) : - c ^ (min n m) ∣ a + b := -begin - replace ha := (pow_dvd_pow c (min_le_left n m)).trans ha, - replace hb := (pow_dvd_pow c (min_le_right n m)).trans hb, - exact dvd_add ha hb -end - -end semiring - -section comm_semiring -variables [comm_semiring R] - -lemma add_sq (a b : R) : (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 := -by simp only [sq, add_mul_self_eq] - -lemma add_sq' (a b : R) : (a + b) ^ 2 = a ^ 2 + b ^ 2 + 2 * a * b := -by rw [add_sq, add_assoc, add_comm _ (b ^ 2), add_assoc] - -alias add_sq ← add_pow_two - -end comm_semiring - -section has_distrib_neg -variables [monoid R] [has_distrib_neg R] - -variables (R) -theorem neg_one_pow_eq_or : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1 -| 0 := or.inl (pow_zero _) -| (n+1) := (neg_one_pow_eq_or n).swap.imp - (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg]) - (λ h, by rw [pow_succ, h, mul_one]) -variables {R} - -theorem neg_pow (a : R) (n : ℕ) : (- a) ^ n = (-1) ^ n * a ^ n := -(neg_one_mul a) ▸ (commute.neg_one_left a).mul_pow n - -@[simp] theorem neg_pow_bit0 (a : R) (n : ℕ) : (- a) ^ (bit0 n) = a ^ (bit0 n) := -by rw [pow_bit0', neg_mul_neg, pow_bit0'] - -@[simp] theorem neg_pow_bit1 (a : R) (n : ℕ) : (- a) ^ (bit1 n) = - a ^ (bit1 n) := -by simp only [bit1, pow_succ, neg_pow_bit0, neg_mul_eq_neg_mul] - -@[simp] lemma neg_sq (a : R) : (-a) ^ 2 = a ^ 2 := by simp [sq] -@[simp] lemma neg_one_sq : (-1 : R) ^ 2 = 1 := by rw [neg_sq, one_pow] - -alias neg_sq ← neg_pow_two -alias neg_one_sq ← neg_one_pow_two - -end has_distrib_neg - -section ring -variable [ring R] - -@[simp] -lemma neg_one_pow_mul_eq_zero_iff {n : ℕ} {r : R} : (-1)^n * r = 0 ↔ r = 0 := -by rcases neg_one_pow_eq_or R n; simp [h] - -@[simp] -lemma mul_neg_one_pow_eq_zero_iff {n : ℕ} {r : R} : r * (-1)^n = 0 ↔ r = 0 := -by rcases neg_one_pow_eq_or R n; simp [h] - -end ring - -section comm_ring -variables [comm_ring R] - -lemma sq_sub_sq (a b : R) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := -by rw [sq, sq, mul_self_sub_mul_self] - -alias sq_sub_sq ← pow_two_sub_pow_two - -lemma eq_or_eq_neg_of_sq_eq_sq [no_zero_divisors R] (a b : R) (h : a ^ 2 = b ^ 2) : - a = b ∨ a = -b := -by rwa [← add_eq_zero_iff_eq_neg, ← sub_eq_zero, or_comm, ← mul_eq_zero, - ← sq_sub_sq a b, sub_eq_zero] - -lemma sub_sq (a b : R) : (a - b) ^ 2 = a ^ 2 - 2 * a * b + b ^ 2 := -by rw [sub_eq_add_neg, add_sq, neg_sq, mul_neg, ← sub_eq_add_neg] - -alias sub_sq ← sub_pow_two - -lemma sub_sq' (a b : R) : (a - b) ^ 2 = a ^ 2 + b ^ 2 - 2 * a * b := -by rw [sub_eq_add_neg, add_sq', neg_sq, mul_neg, ← sub_eq_add_neg] - -/- Copies of the above comm_ring lemmas for `units R`. -/ -namespace units - -lemma eq_or_eq_neg_of_sq_eq_sq [no_zero_divisors R] (a b : Rˣ) (h : a ^ 2 = b ^ 2) : - a = b ∨ a = -b := -begin - refine (eq_or_eq_neg_of_sq_eq_sq _ _ _).imp (λ h, units.ext h) (λ h, units.ext h), - replace h := congr_arg (coe : Rˣ → R) h, - rwa [units.coe_pow, units.coe_pow] at h, -end - -end units - -end comm_ring + a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, nat.sub_add_cancel h]⟩ lemma of_add_nsmul [add_monoid A] (x : A) (n : ℕ) : multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl diff --git a/src/algebra/group_power/default.lean b/src/algebra/group_power/default.lean deleted file mode 100644 index 0f989844882c4..0000000000000 --- a/src/algebra/group_power/default.lean +++ /dev/null @@ -1 +0,0 @@ -import algebra.group_power.lemmas diff --git a/src/algebra/group_power/identities.lean b/src/algebra/group_power/identities.lean index ad41dc3407a13..82982c73a74eb 100644 --- a/src/algebra/group_power/identities.lean +++ b/src/algebra/group_power/identities.lean @@ -4,9 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bryan Gin-ge Chen, Kevin Lacker -/ import tactic.ring + /-! # Identities +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains some "named" commutative ring identities. -/ diff --git a/src/algebra/group_power/lemmas.lean b/src/algebra/group_power/lemmas.lean index 56a4139af2701..c01093f2fd6bf 100644 --- a/src/algebra/group_power/lemmas.lean +++ b/src/algebra/group_power/lemmas.lean @@ -4,11 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Robert Y. Lewis -/ import algebra.invertible -import data.int.cast +import algebra.group_power.ring +import algebra.order.monoid.with_top +import data.nat.pow +import data.int.cast.lemmas /-! # Lemmas about power operations on monoids and groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas about `monoid.pow`, `group.pow`, `nsmul`, `zsmul` which require additional imports besides those available in `algebra.group_power.basic`. -/ @@ -24,16 +30,17 @@ variables {α : Type*} {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : ### (Additive) monoid -/ section monoid -variables [monoid M] [monoid N] [add_monoid A] [add_monoid B] -@[simp] theorem nsmul_one [has_one A] : ∀ n : ℕ, n • (1 : A) = n := +@[simp] theorem nsmul_one [add_monoid_with_one A] : ∀ n : ℕ, n • (1 : A) = n := begin refine eq_nat_cast' (⟨_, _, _⟩ : ℕ →+ A) _, - { simp [zero_nsmul] }, - { simp [add_nsmul] }, - { simp } + { show 0 • (1 : A) = 0, simp [zero_nsmul] }, + { show ∀ x y : ℕ, (x + y) • (1 : A) = x • 1 + y • 1, simp [add_nsmul] }, + { show 1 • (1 : A) = 1, simp } end +variables [monoid M] [monoid N] [add_monoid A] [add_monoid B] + instance invertible_pow (m : M) [invertible m] (n : ℕ) : invertible (m ^ n) := { inv_of := ⅟ m ^ n, inv_of_mul_self := by rw [← (commute_inv_of m).symm.mul_pow, inv_of_mul_self, one_pow], @@ -43,41 +50,39 @@ lemma inv_of_pow (m : M) [invertible m] (n : ℕ) [invertible (m ^ n)] : ⅟(m ^ n) = ⅟m ^ n := @invertible_unique M _ (m ^ n) (m ^ n) _ (invertible_pow m n) rfl -lemma is_unit.pow {m : M} (n : ℕ) : is_unit m → is_unit (m ^ n) := -λ ⟨u, hu⟩, ⟨u ^ n, by simp *⟩ +@[to_additive] lemma is_unit.pow {m : M} (n : ℕ) : is_unit m → is_unit (m ^ n) := +λ ⟨u, hu⟩, ⟨u ^ n, hu ▸ u.coe_pow _⟩ -@[simp] lemma is_unit_pow_succ_iff {m : M} {n : ℕ} : - is_unit (m ^ (n + 1)) ↔ is_unit m := -begin - refine ⟨_, λ h, h.pow _⟩, - rw [pow_succ, ((commute.refl _).pow_right _).is_unit_mul_iff], - exact and.left -end +/-- If a natural power of `x` is a unit, then `x` is a unit. -/ +@[to_additive "If a natural multiple of `x` is an additive unit, then `x` is an additive unit."] +def units.of_pow (u : Mˣ) (x : M) {n : ℕ} (hn : n ≠ 0) (hu : x ^ n = u) : Mˣ := +u.left_of_mul x (x ^ (n - 1)) + (by rwa [← pow_succ, nat.sub_add_cancel (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn)]) + (commute.self_pow _ _) -lemma is_unit_pos_pow_iff {m : M} : - ∀ {n : ℕ} (h : 0 < n), is_unit (m ^ n) ↔ is_unit m -| (n + 1) _ := is_unit_pow_succ_iff +@[simp, to_additive] lemma is_unit_pow_iff {a : M} {n : ℕ} (hn : n ≠ 0) : + is_unit (a ^ n) ↔ is_unit a := +⟨λ ⟨u, hu⟩, (u.of_pow a hn hu.symm).is_unit, λ h, h.pow n⟩ -/-- If `x ^ n.succ = 1` then `x` has an inverse, `x^n`. -/ -def invertible_of_pow_succ_eq_one (x : M) (n : ℕ) (hx : x ^ n.succ = 1) : - invertible x := -⟨x ^ n, (pow_succ' x n).symm.trans hx, (pow_succ x n).symm.trans hx⟩ +@[to_additive] lemma is_unit_pow_succ_iff {m : M} {n : ℕ} : is_unit (m ^ (n + 1)) ↔ is_unit m := +is_unit_pow_iff n.succ_ne_zero -/-- If `x ^ n = 1` then `x` has an inverse, `x^(n - 1)`. -/ -def invertible_of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : 0 < n) : - invertible x := -begin - apply invertible_of_pow_succ_eq_one x (n - 1), - convert hx, - exact tsub_add_cancel_of_le (nat.succ_le_of_lt hn), -end +/-- If `x ^ n = 1`, `n ≠ 0`, then `x` is a unit. -/ +@[to_additive "If `n • x = 0`, `n ≠ 0`, then `x` is an additive unit.", simps] +def units.of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : n ≠ 0) : Mˣ := units.of_pow 1 x hn hx + +@[simp, to_additive] lemma units.pow_of_pow_eq_one {x : M} {n : ℕ} (hx : x ^ n = 1) (hn : n ≠ 0) : + units.of_pow_eq_one x n hx hn ^ n = 1 := +units.ext $ by rwa [units.coe_pow, units.coe_of_pow_eq_one, units.coe_one] -lemma is_unit_of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : 0 < n) : +@[to_additive] lemma is_unit_of_pow_eq_one {x : M} {n : ℕ} (hx : x ^ n = 1) (hn : n ≠ 0) : is_unit x := -begin - haveI := invertible_of_pow_eq_one x n hx hn, - exact is_unit_of_invertible x -end +(units.of_pow_eq_one x n hx hn).is_unit + +/-- If `x ^ n = 1` then `x` has an inverse, `x^(n - 1)`. -/ +def invertible_of_pow_eq_one (x : M) (n : ℕ) (hx : x ^ n = 1) (hn : n ≠ 0) : + invertible x := +(units.of_pow_eq_one x n hx hn).invertible lemma smul_pow [mul_action M N] [is_scalar_tower M N N] [smul_comm_class M N N] (k : M) (x : N) (p : ℕ) : @@ -98,24 +103,52 @@ end end monoid -section sub_neg_monoid -variables [sub_neg_monoid A] +lemma zsmul_one [add_group_with_one A] (n : ℤ) : n • (1 : A) = n := by cases n; simp + +section division_monoid +variables [division_monoid α] -lemma zsmul_one [has_one A] (n : ℤ) : n • (1 : A) = n := by cases n; simp +-- Note that `mul_zsmul` and `zpow_mul` have the primes swapped since their argument order, +-- and therefore the more "natural" choice of lemma, is reversed. +@[to_additive mul_zsmul'] lemma zpow_mul (a : α) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n +| (m : ℕ) (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat, ← pow_mul, ← zpow_coe_nat], refl } +| (m : ℕ) -[1+ n] := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← pow_mul, coe_nat_mul_neg_succ, + zpow_neg, inv_inj, ← zpow_coe_nat], refl } +| -[1+ m] (n : ℕ) := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← inv_pow, ← pow_mul, + neg_succ_mul_coe_nat, zpow_neg, inv_pow, inv_inj, ← zpow_coe_nat], refl } +| -[1+ m] -[1+ n] := by { rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, neg_succ_mul_neg_succ, + inv_pow, inv_inv, ← pow_mul, ← zpow_coe_nat], refl } + +@[to_additive mul_zsmul] lemma zpow_mul' (a : α) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m := +by rw [mul_comm, zpow_mul] -end sub_neg_monoid +@[to_additive bit0_zsmul] lemma zpow_bit0 (a : α) : ∀ n : ℤ, a ^ bit0 n = a ^ n * a ^ n +| (n : ℕ) := by simp only [zpow_coe_nat, ←int.coe_nat_bit0, pow_bit0] +| -[1+n] := by { simp [←mul_inv_rev, ←pow_bit0], rw [neg_succ_of_nat_eq, bit0_neg, zpow_neg], + norm_cast } + +@[to_additive bit0_zsmul'] lemma zpow_bit0' (a : α) (n : ℤ) : a ^ bit0 n = (a * a) ^ n := +(zpow_bit0 a n).trans ((commute.refl a).mul_zpow n).symm + +@[simp] lemma zpow_bit0_neg [has_distrib_neg α] (x : α) (n : ℤ) : (-x) ^ (bit0 n) = x ^ bit0 n := +by rw [zpow_bit0', zpow_bit0', neg_mul_neg] + +end division_monoid section group variables [group G] @[to_additive add_one_zsmul] lemma zpow_add_one (a : G) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a -| (of_nat n) := by simp [← int.coe_nat_succ, pow_succ'] -| -[1+n] := by rw [int.neg_succ_of_nat_eq, zpow_neg, neg_add, neg_add_cancel_right, zpow_neg, - ← int.coe_nat_succ, zpow_coe_nat, zpow_coe_nat, pow_succ _ n, mul_inv_rev, - inv_mul_cancel_right] +| (n : ℕ) := by simp only [← int.coe_nat_succ, zpow_coe_nat, pow_succ'] +| -[1+ 0] := by erw [zpow_zero, zpow_neg_succ_of_nat, pow_one, mul_left_inv] +| -[1+ n+1] := begin + rw [zpow_neg_succ_of_nat, pow_succ, mul_inv_rev, inv_mul_cancel_right], + rw [int.neg_succ_of_nat_eq, neg_add, add_assoc, neg_add_self, add_zero], + exact zpow_neg_succ_of_nat _ _ +end -@[to_additive zsmul_sub_one] +@[to_additive sub_one_zsmul] lemma zpow_sub_one (a : G) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ := calc a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ : (mul_inv_cancel_right _ _).symm ... = a^n * a⁻¹ : by rw [← zpow_add_one, sub_add_cancel] @@ -145,28 +178,47 @@ by rw [sub_eq_add_neg, zpow_add, zpow_neg] theorem zpow_one_add (a : G) (i : ℤ) : a ^ (1 + i) = a * a ^ i := by rw [zpow_add, zpow_one] -@[to_additive] -theorem zpow_mul_comm (a : G) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i := -by rw [← zpow_add, ← zpow_add, add_comm] - --- note that `mul_zsmul` and `zpow_mul` have the primes swapped since their argument order --- and therefore the more "natural" choice of lemma is reversed. -@[to_additive mul_zsmul'] -theorem zpow_mul (a : G) (m n : ℤ) : a ^ (m * n) = (a ^ m) ^ n := -int.induction_on n (by simp) (λ n ihn, by simp [mul_add, zpow_add, ihn]) - (λ n ihn, by simp only [mul_sub, zpow_sub, ihn, mul_one, zpow_one]) - -@[to_additive mul_zsmul] -theorem zpow_mul' (a : G) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m := -by rw [mul_comm, zpow_mul] - -@[to_additive bit0_zsmul] -theorem zpow_bit0 (a : G) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n := zpow_add _ _ _ +@[to_additive] lemma zpow_mul_comm (a : G) (i j : ℤ) : a ^ i * a ^ j = a ^ j * a ^ i := +(commute.refl _).zpow_zpow _ _ @[to_additive bit1_zsmul] theorem zpow_bit1 (a : G) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a := by rw [bit1, zpow_add, zpow_bit0, zpow_one] +/-- To show a property of all powers of `g` it suffices to show it is closed under multiplication +by `g` and `g⁻¹` on the left. For subgroups generated by more than one element, see +`subgroup.closure_induction_left`. -/ +@[to_additive "To show a property of all multiples of `g` it suffices to show it is closed under +addition by `g` and `-g` on the left. For additive subgroups generated by more than one element, see +`add_subgroup.closure_induction_left`."] +lemma zpow_induction_left {g : G} {P : G → Prop} (h_one : P (1 : G)) + (h_mul : ∀ a, P a → P (g * a)) (h_inv : ∀ a, P a → P (g⁻¹ * a)) (n : ℤ) : P (g ^ n) := +begin + induction n using int.induction_on with n ih n ih, + { rwa zpow_zero }, + { rw [add_comm, zpow_add, zpow_one], + exact h_mul _ ih }, + { rw [sub_eq_add_neg, add_comm, zpow_add, zpow_neg_one], + exact h_inv _ ih } +end + +/-- To show a property of all powers of `g` it suffices to show it is closed under multiplication +by `g` and `g⁻¹` on the right. For subgroups generated by more than one element, see +`subgroup.closure_induction_right`. -/ +@[to_additive "To show a property of all multiples of `g` it suffices to show it is closed under +addition by `g` and `-g` on the right. For additive subgroups generated by more than one element, +see `add_subgroup.closure_induction_right`."] +lemma zpow_induction_right {g : G} {P : G → Prop} (h_one : P (1 : G)) + (h_mul : ∀ a, P a → P (a * g)) (h_inv : ∀ a, P a → P (a * g⁻¹)) (n : ℤ) : P (g ^ n) := +begin + induction n using int.induction_on with n ih n ih, + { rwa zpow_zero }, + { rw zpow_add_one, + exact h_mul _ ih }, + { rw zpow_sub_one, + exact h_inv _ ih } +end + end group /-! @@ -282,9 +334,9 @@ lemma abs_zsmul (n : ℤ) (a : α) : |n • a| = |n| • |a| := begin obtain n0 | n0 := le_total 0 n, { lift n to ℕ using n0, - simp only [abs_nsmul, coe_nat_abs, coe_nat_zsmul] }, + simp only [abs_nsmul, abs_coe_nat, coe_nat_zsmul] }, { lift (- n) to ℕ using neg_nonneg.2 n0 with m h, - rw [← abs_neg (n • a), ← neg_zsmul, ← abs_neg n, ← h, coe_nat_zsmul, coe_nat_abs, + rw [← abs_neg (n • a), ← neg_zsmul, ← abs_neg n, ← h, coe_nat_zsmul, abs_coe_nat, coe_nat_zsmul], exact abs_nsmul m _ }, end @@ -371,8 +423,13 @@ by { dsimp [bit1], rw [add_mul, bit0_mul, one_mul], } lemma mul_bit1 [non_assoc_ring R] {n r : R} : r * bit1 n = (2 : ℤ) • (r * n) + r := by { dsimp [bit1], rw [mul_add, mul_bit0, mul_one], } -@[simp] theorem zsmul_eq_mul [non_assoc_ring R] (a : R) : ∀ (n : ℤ), n • a = n * a -| (n : ℕ) := by { rw [coe_nat_zsmul, nsmul_eq_mul], refl } +/-- Note this holds in marginally more generality than `int.cast_mul` -/ +lemma int.cast_mul_eq_zsmul_cast [add_comm_group_with_one α] : ∀ m n, ((m * n : ℤ) : α) = m • n := +λ m, int.induction_on' m 0 (by simp) (λ k _ ih n, by simp [add_mul, add_zsmul, ih]) + (λ k _ ih n, by simp [sub_mul, sub_zsmul, ih, ←sub_eq_add_neg]) + +@[simp] theorem zsmul_eq_mul [ring R] (a : R) : ∀ (n : ℤ), n • a = n * a +| (n : ℕ) := by rw [coe_nat_zsmul, nsmul_eq_mul, int.cast_coe_nat] | -[1+ n] := by simp [nat.cast_succ, neg_add_rev, int.cast_neg_succ_of_nat, add_mul] theorem zsmul_eq_mul' [ring R] (a : R) (n : ℤ) : n • a = a * n := @@ -408,8 +465,8 @@ end lemma neg_one_pow_eq_pow_mod_two [ring R] {n : ℕ} : (-1 : R) ^ n = (-1) ^ (n % 2) := by rw [← nat.mod_add_div n 2, pow_add, pow_mul]; simp [sq] -section ordered_semiring -variables [ordered_semiring R] {a : R} +section strict_ordered_semiring +variables [strict_ordered_semiring R] {a : R} /-- Bernoulli's inequality. This version works for semirings but requires additional hypotheses `0 ≤ a * a` and `0 ≤ (1 + a) * (1 + a)`. -/ @@ -446,7 +503,7 @@ lemma pow_le_of_le_one (h₀ : 0 ≤ a) (h₁ : a ≤ 1) {n : ℕ} (hn : n ≠ 0 lemma sq_le (h₀ : 0 ≤ a) (h₁ : a ≤ 1) : a ^ 2 ≤ a := pow_le_of_le_one h₀ h₁ two_ne_zero -end ordered_semiring +end strict_ordered_semiring section linear_ordered_semiring @@ -457,7 +514,7 @@ lemma sign_cases_of_C_mul_pow_nonneg {C r : R} (h : ∀ n : ℕ, 0 ≤ C * r ^ n begin have : 0 ≤ C, by simpa only [pow_zero, mul_one] using h 0, refine this.eq_or_lt.elim (λ h, or.inl h.symm) (λ hC, or.inr ⟨hC, _⟩), - refine nonneg_of_mul_nonneg_left _ hC, + refine nonneg_of_mul_nonneg_right _ hC, simpa only [pow_one] using h 1 end @@ -504,40 +561,20 @@ by simpa only [add_sub_cancel'_right] using one_add_mul_le_pow this n end linear_ordered_ring -/-- Bernoulli's inequality reformulated to estimate `(n : K)`. -/ -theorem nat.cast_le_pow_sub_div_sub {K : Type*} [linear_ordered_field K] {a : K} (H : 1 < a) - (n : ℕ) : - (n : K) ≤ (a ^ n - 1) / (a - 1) := -(le_div_iff (sub_pos.2 H)).2 $ le_sub_left_of_add_le $ - one_add_mul_sub_le_pow ((neg_le_self $ @zero_le_one K _).trans H.le) _ - -/-- For any `a > 1` and a natural `n` we have `n ≤ a ^ n / (a - 1)`. See also -`nat.cast_le_pow_sub_div_sub` for a stronger inequality with `a ^ n - 1` in the numerator. -/ -theorem nat.cast_le_pow_div_sub {K : Type*} [linear_ordered_field K] {a : K} (H : 1 < a) (n : ℕ) : - (n : K) ≤ a ^ n / (a - 1) := -(n.cast_le_pow_sub_div_sub H).trans $ div_le_div_of_le (sub_nonneg.2 H.le) - (sub_le_self _ zero_le_one) - namespace int -alias int.units_sq ← int.units_pow_two - -lemma units_pow_eq_pow_mod_two (u : ℤˣ) (n : ℕ) : u ^ n = u ^ (n % 2) := -by conv {to_lhs, rw ← nat.mod_add_div n 2}; rw [pow_add, pow_mul, units_sq, one_pow, mul_one] +lemma nat_abs_sq (x : ℤ) : (x.nat_abs ^ 2 : ℤ) = x ^ 2 := by rw [sq, int.nat_abs_mul_self', sq] -@[simp] lemma nat_abs_sq (x : ℤ) : (x.nat_abs ^ 2 : ℤ) = x ^ 2 := -by rw [sq, int.nat_abs_mul_self', sq] - -alias int.nat_abs_sq ← int.nat_abs_pow_two +alias nat_abs_sq ← nat_abs_pow_two lemma abs_le_self_sq (a : ℤ) : (int.nat_abs a : ℤ) ≤ a ^ 2 := by { rw [← int.nat_abs_sq a, sq], norm_cast, apply nat.le_mul_self } -alias int.abs_le_self_sq ← int.abs_le_self_pow_two +alias abs_le_self_sq ← abs_le_self_pow_two lemma le_self_sq (b : ℤ) : b ≤ b ^ 2 := le_trans (le_nat_abs) (abs_le_self_sq _) -alias int.le_self_sq ← int.le_self_pow_two +alias le_self_sq ← le_self_pow_two lemma pow_right_injective {x : ℤ} (h : 1 < x.nat_abs) : function.injective ((^) x : ℕ → ℤ) := begin @@ -760,13 +797,12 @@ h.cast_nat_mul_left n commute (m * a : R) (n * b : R) := h.cast_nat_mul_cast_nat_mul m n -@[simp] theorem self_cast_nat_mul (n : ℕ) : commute a (n * a : R) := -(commute.refl a).cast_nat_mul_right n +variables (a) (m n : ℕ) -@[simp] theorem cast_nat_mul_self (n : ℕ) : commute ((n : R) * a) a := -(commute.refl a).cast_nat_mul_left n +@[simp] lemma self_cast_nat_mul : commute a (n * a : R) := (commute.refl a).cast_nat_mul_right n +@[simp] lemma cast_nat_mul_self : commute ((n : R) * a) a := (commute.refl a).cast_nat_mul_left n -@[simp] theorem self_cast_nat_mul_cast_nat_mul (m n : ℕ) : commute (m * a : R) (n * a : R) := +@[simp] theorem self_cast_nat_mul_cast_nat_mul : commute (m * a : R) (n * a : R) := (commute.refl a).cast_nat_mul_cast_nat_mul m n end @@ -794,11 +830,8 @@ h.cast_int_mul_cast_int_mul m n variables (a) (m n : ℤ) -@[simp] lemma cast_int_left : commute (m : R) a := -by { rw [← mul_one (m : R)], exact (one_left a).cast_int_mul_left m } - -@[simp] lemma cast_int_right : commute a m := -by { rw [← mul_one (m : R)], exact (one_right a).cast_int_mul_right m } +@[simp] lemma cast_int_left : commute (m : R) a := int.cast_commute _ _ +@[simp] lemma cast_int_right : commute a m := int.commute_cast _ _ @[simp] theorem self_cast_int_mul : commute a (n * a : R) := (commute.refl a).cast_int_mul_right n diff --git a/src/algebra/group_power/order.lean b/src/algebra/group_power/order.lean index aa2ab3534f216..d16d94f5abb1b 100644 --- a/src/algebra/group_power/order.lean +++ b/src/algebra/group_power/order.lean @@ -3,25 +3,37 @@ Copyright (c) 2015 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Robert Y. Lewis -/ -import algebra.order.ring -import algebra.group_power.basic +import algebra.order.ring.abs +import algebra.order.with_zero +import algebra.group_power.ring +import data.set.intervals.basic /-! # Lemmas about the interaction of power operations with order +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Note that some lemmas are in `algebra/group_power/lemmas.lean` as they import files which depend on this file. -/ -variables {A G M R : Type*} +open function + +variables {β A G M R : Type*} + +section monoid +variable [monoid M] section preorder +variable [preorder M] -variables [monoid M] [preorder M] [covariant_class M M (*) (≤)] +section left +variables [covariant_class M M (*) (≤)] {x : M} @[to_additive nsmul_le_nsmul_of_le_right, mono] -lemma pow_le_pow_of_le_left' [covariant_class M M (function.swap (*)) (≤)] - {a b : M} (hab : a ≤ b) : ∀ i : ℕ, a ^ i ≤ b ^ i +lemma pow_le_pow_of_le_left' [covariant_class M M (swap (*)) (≤)] {a b : M} (hab : a ≤ b) : + ∀ i : ℕ, a ^ i ≤ b ^ i | 0 := by simp | (k+1) := by { rw [pow_succ, pow_succ], exact mul_le_mul' hab (pow_le_pow_of_le_left' k) } @@ -54,7 +66,7 @@ begin induction l with l IH, { simpa using ha }, { rw pow_succ, - exact one_lt_mul' ha IH } + exact one_lt_mul'' ha IH } end @[to_additive nsmul_neg] @@ -75,11 +87,84 @@ lemma pow_strict_mono_left [covariant_class M M (*) (<)] {a : M} (ha : 1 < a) : strict_mono ((^) a : ℕ → M) := λ m n, pow_lt_pow' ha +@[to_additive left.pow_nonneg] +lemma left.one_le_pow_of_le (hx : 1 ≤ x) : ∀ {n : ℕ}, 1 ≤ x^n +| 0 := (pow_zero x).ge +| (n + 1) := by { rw pow_succ, exact left.one_le_mul hx left.one_le_pow_of_le } + +@[to_additive left.pow_nonpos] +lemma left.pow_le_one_of_le (hx : x ≤ 1) : ∀ {n : ℕ}, x^n ≤ 1 +| 0 := (pow_zero _).le +| (n + 1) := by { rw pow_succ, exact left.mul_le_one hx left.pow_le_one_of_le } + +end left + +section right +variables [covariant_class M M (swap (*)) (≤)] {x : M} + +@[to_additive right.pow_nonneg] +lemma right.one_le_pow_of_le (hx : 1 ≤ x) : ∀ {n : ℕ}, 1 ≤ x^n +| 0 := (pow_zero _).ge +| (n + 1) := by { rw pow_succ, exact right.one_le_mul hx right.one_le_pow_of_le } + +@[to_additive right.pow_nonpos] +lemma right.pow_le_one_of_le (hx : x ≤ 1) : ∀ {n : ℕ}, x^n ≤ 1 +| 0 := (pow_zero _).le +| (n + 1) := by { rw pow_succ, exact right.mul_le_one hx right.pow_le_one_of_le } + +end right + +section covariant_lt_swap +variables [preorder β] [covariant_class M M (*) (<)] [covariant_class M M (swap (*)) (<)] + {f : β → M} + +@[to_additive strict_mono.nsmul_left] +lemma strict_mono.pow_right' (hf : strict_mono f) : ∀ {n : ℕ}, n ≠ 0 → strict_mono (λ a, f a ^ n) +| 0 hn := (hn rfl).elim +| 1 hn := by simpa +| (nat.succ $ nat.succ n) hn := + by { simp_rw pow_succ _ (n + 1), exact hf.mul' (strict_mono.pow_right' n.succ_ne_zero) } + +/-- See also `pow_strict_mono_right` -/ +@[nolint to_additive_doc, to_additive nsmul_strict_mono_left] +lemma pow_strict_mono_right' {n : ℕ} (hn : n ≠ 0) : strict_mono (λ a : M, a ^ n) := +strict_mono_id.pow_right' hn + +end covariant_lt_swap + +section covariant_le_swap +variables [preorder β] [covariant_class M M (*) (≤)] [covariant_class M M (swap (*)) (≤)] + +@[to_additive monotone.nsmul_left] +lemma monotone.pow_right {f : β → M} (hf : monotone f) : ∀ n : ℕ, monotone (λ a, f a ^ n) +| 0 := by simpa using monotone_const +| (n + 1) := by { simp_rw pow_succ, exact hf.mul' (monotone.pow_right _) } + +@[to_additive nsmul_mono_left] +lemma pow_mono_right (n : ℕ) : monotone (λ a : M, a ^ n) := monotone_id.pow_right _ + +end covariant_le_swap + +@[to_additive left.pow_neg] +lemma left.pow_lt_one_of_lt [covariant_class M M (*) (<)] {n : ℕ} {x : M} (hn : 0 < n) (h : x < 1) : + x^n < 1 := +nat.le_induction ((pow_one _).trans_lt h) (λ n _ ih, by { rw pow_succ, exact mul_lt_one h ih }) _ + (nat.succ_le_iff.2 hn) + +@[to_additive right.pow_neg] +lemma right.pow_lt_one_of_lt [covariant_class M M (swap (*)) (<)] {n : ℕ} {x : M} + (hn : 0 < n) (h : x < 1) : + x^n < 1 := +nat.le_induction ((pow_one _).trans_lt h) + (λ n _ ih, by { rw pow_succ, exact right.mul_lt_one h ih }) _ (nat.succ_le_iff.2 hn) + end preorder section linear_order +variables [linear_order M] -variables [monoid M] [linear_order M] [covariant_class M M (*) (≤)] +section covariant_le +variables [covariant_class M M (*) (≤)] @[to_additive nsmul_nonneg_iff] lemma one_le_pow_iff {x : M} {n : ℕ} (hn : n ≠ 0) : 1 ≤ x ^ n ↔ 1 ≤ x := @@ -109,7 +194,59 @@ lemma pow_le_pow_iff' (ha : 1 < a) : a ^ m ≤ a ^ n ↔ m ≤ n := (pow_strict_ @[to_additive nsmul_lt_nsmul_iff] lemma pow_lt_pow_iff' (ha : 1 < a) : a ^ m < a ^ n ↔ m < n := (pow_strict_mono_left ha).lt_iff_lt +end covariant_le + +section covariant_le_swap +variables [covariant_class M M (*) (≤)] [covariant_class M M (swap (*)) (≤)] + +@[to_additive lt_of_nsmul_lt_nsmul] +lemma lt_of_pow_lt_pow' {a b : M} (n : ℕ) : a ^ n < b ^ n → a < b := (pow_mono_right _).reflect_lt + +@[to_additive] +lemma min_lt_max_of_mul_lt_mul {a b c d : M} (h : a * b < c * d) : min a b < max c d := +lt_of_pow_lt_pow' 2 $ by { simp_rw pow_two, exact (mul_le_mul' inf_le_left + inf_le_right).trans_lt (h.trans_le $ mul_le_mul' le_sup_left le_sup_right) } + +@[to_additive min_lt_of_add_lt_two_nsmul] +lemma min_lt_of_mul_lt_sq {a b c : M} (h : a * b < c ^ 2) : min a b < c := +by simpa using min_lt_max_of_mul_lt_mul (h.trans_eq $ pow_two _) + +@[to_additive lt_max_of_two_nsmul_lt_add] +lemma lt_max_of_sq_lt_mul {a b c : M} (h : a ^ 2 < b * c) : a < max b c := +by simpa using min_lt_max_of_mul_lt_mul ((pow_two _).symm.trans_lt h) + +end covariant_le_swap + +section covariant_lt_swap +variables [covariant_class M M (*) (<)] [covariant_class M M (swap (*)) (<)] + +@[to_additive le_of_nsmul_le_nsmul] +lemma le_of_pow_le_pow' {a b : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ b ^ n → a ≤ b := +(pow_strict_mono_right' hn).le_iff_le.1 + +@[to_additive min_le_of_add_le_two_nsmul] +lemma min_le_of_mul_le_sq {a b c : M} (h : a * b ≤ c ^ 2) : min a b ≤ c := +by simpa using min_le_max_of_mul_le_mul (h.trans_eq $ pow_two _) + +@[to_additive le_max_of_two_nsmul_le_add] +lemma le_max_of_sq_le_mul {a b c : M} (h : a ^ 2 ≤ b * c) : a ≤ max b c := +by simpa using min_le_max_of_mul_le_mul ((pow_two _).symm.trans_le h) + +end covariant_lt_swap + +@[to_additive left.nsmul_neg_iff] +lemma left.pow_lt_one_iff [covariant_class M M (*) (<)] {n : ℕ} {x : M} (hn : 0 < n) : + x^n < 1 ↔ x < 1 := +by { haveI := has_mul.to_covariant_class_left M, exact pow_lt_one_iff hn.ne' } + +@[to_additive right.nsmul_neg_iff] +lemma right.pow_lt_one_iff [covariant_class M M (swap (*)) (<)] {n : ℕ} {x : M} (hn : 0 < n) : + x^n < 1 ↔ x < 1 := +⟨λ H, not_le.mp $ λ k, H.not_le $ by { haveI := has_mul.to_covariant_class_right M, + exact right.one_le_pow_of_le k }, right.pow_lt_one_of_lt hn⟩ + end linear_order +end monoid section div_inv_monoid @@ -138,6 +275,10 @@ end canonically_ordered_comm_semiring section ordered_semiring variables [ordered_semiring R] {a x y : R} {n m : ℕ} +lemma zero_pow_le_one : ∀ n : ℕ, (0 : R) ^ n ≤ 1 +| 0 := (pow_zero _).le +| (n + 1) := by { rw [zero_pow n.succ_pos], exact zero_le_one } + theorem pow_add_pow_le (hx : 0 ≤ x) (hy : 0 ≤ y) (hn : n ≠ 0) : x ^ n + y ^ n ≤ (x + y) ^ n := begin rcases nat.exists_eq_succ_of_ne_zero hn with ⟨k, rfl⟩, @@ -155,22 +296,14 @@ begin by { rw [pow_succ _ n], exact mul_le_mul_of_nonneg_left (ih (nat.succ_ne_zero k)) h2 } end -theorem pow_lt_pow_of_lt_left (Hxy : x < y) (Hxpos : 0 ≤ x) (Hnpos : 0 < n) : - x ^ n < y ^ n := -begin - cases lt_or_eq_of_le Hxpos, - { rw ← tsub_add_cancel_of_le (nat.succ_le_of_lt Hnpos), - induction (n - 1), { simpa only [pow_one] }, - rw [pow_add, pow_add, nat.succ_eq_add_one, pow_one, pow_one], - apply mul_lt_mul ih (le_of_lt Hxy) h (le_of_lt (pow_pos (lt_trans h Hxy) _)) }, - { rw [←h, zero_pow Hnpos], apply pow_pos (by rwa ←h at Hxy : 0 < y),} -end - -lemma pow_lt_one (h₀ : 0 ≤ a) (h₁ : a < 1) {n : ℕ} (hn : n ≠ 0) : a ^ n < 1 := -(one_pow n).subst (pow_lt_pow_of_lt_left h₁ h₀ (nat.pos_of_ne_zero hn)) +lemma pow_le_one : ∀ (n : ℕ) (h₀ : 0 ≤ a) (h₁ : a ≤ 1), a ^ n ≤ 1 +| 0 h₀ h₁ := (pow_zero a).le +| (n + 1) h₀ h₁ := (pow_succ' a n).le.trans (mul_le_one (pow_le_one n h₀ h₁) h₀ h₁) -theorem strict_mono_on_pow (hn : 0 < n) : strict_mono_on (λ x : R, x ^ n) (set.Ici 0) := -λ x hx y hy h, pow_lt_pow_of_lt_left h hx hn +lemma pow_lt_one (h₀ : 0 ≤ a) (h₁ : a < 1) : ∀ {n : ℕ} (hn : n ≠ 0), a ^ n < 1 +| 0 h := (h rfl).elim +| (n + 1) h := + by { rw pow_succ, exact mul_lt_one_of_nonneg_of_lt_one_left h₀ h₁ (pow_le_one _ h₀ h₁.le) } theorem one_le_pow_of_one_le (H : 1 ≤ a) : ∀ (n : ℕ), 1 ≤ a ^ n | 0 := by rw [pow_zero] @@ -184,22 +317,45 @@ monotone_nat_of_le_succ $ λ n, theorem pow_le_pow (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m := pow_mono ha h -theorem le_self_pow (ha : 1 ≤ a) (h : 1 ≤ m) : a ≤ a ^ m := -eq.trans_le (pow_one a).symm (pow_le_pow ha h) +theorem le_self_pow (ha : 1 ≤ a) (h : m ≠ 0) : a ≤ a ^ m := +(pow_one a).symm.trans_le (pow_le_pow ha $ pos_iff_ne_zero.mpr h) -lemma strict_mono_pow (h : 1 < a) : strict_mono (λ n : ℕ, a ^ n) := +@[mono] lemma pow_le_pow_of_le_left {a b : R} (ha : 0 ≤ a) (hab : a ≤ b) : ∀ i : ℕ, a^i ≤ b^i +| 0 := by simp +| (k+1) := by { rw [pow_succ, pow_succ], + exact mul_le_mul hab (pow_le_pow_of_le_left _) (pow_nonneg ha _) (le_trans ha hab) } + +lemma one_lt_pow (ha : 1 < a) : ∀ {n : ℕ} (hn : n ≠ 0), 1 < a ^ n +| 0 h := (h rfl).elim +| (n + 1) h := + by { rw pow_succ, exact one_lt_mul_of_lt_of_le ha (one_le_pow_of_one_le ha.le _) } + +end ordered_semiring + +section strict_ordered_semiring +variables [strict_ordered_semiring R] {a x y : R} {n m : ℕ} + +lemma pow_lt_pow_of_lt_left (h : x < y) (hx : 0 ≤ x) : ∀ {n : ℕ}, 0 < n → x ^ n < y ^ n +| 0 hn := hn.false.elim +| (n + 1) _ := by simpa only [pow_succ'] using + mul_lt_mul_of_le_of_le' (pow_le_pow_of_le_left hx h.le _) h (pow_pos (hx.trans_lt h) _) hx + +lemma strict_mono_on_pow (hn : 0 < n) : strict_mono_on (λ x : R, x ^ n) (set.Ici 0) := +λ x hx y hy h, pow_lt_pow_of_lt_left h hx hn + +lemma pow_strict_mono_right (h : 1 < a) : strict_mono (λ n : ℕ, a ^ n) := have 0 < a := zero_le_one.trans_lt h, strict_mono_nat_of_lt_succ $ λ n, by simpa only [one_mul, pow_succ] using mul_lt_mul h (le_refl (a ^ n)) (pow_pos this _) this.le lemma pow_lt_pow (h : 1 < a) (h2 : n < m) : a ^ n < a ^ m := -strict_mono_pow h h2 +pow_strict_mono_right h h2 lemma pow_lt_pow_iff (h : 1 < a) : a ^ n < a ^ m ↔ n < m := -(strict_mono_pow h).lt_iff_lt +(pow_strict_mono_right h).lt_iff_lt lemma pow_le_pow_iff (h : 1 < a) : a ^ n ≤ a ^ m ↔ n ≤ m := -(strict_mono_pow h).le_iff_le +(pow_strict_mono_right h).le_iff_le lemma strict_anti_pow (h₀ : 0 < a) (h₁ : a < 1) : strict_anti (λ n : ℕ, a ^ n) := strict_anti_nat_of_succ_lt $ λ n, @@ -211,26 +367,16 @@ lemma pow_lt_pow_iff_of_lt_one (h₀ : 0 < a) (h₁ : a < 1) : a ^ m < a ^ n ↔ lemma pow_lt_pow_of_lt_one (h : 0 < a) (ha : a < 1) {i j : ℕ} (hij : i < j) : a ^ j < a ^ i := (pow_lt_pow_iff_of_lt_one h ha).2 hij -@[mono] lemma pow_le_pow_of_le_left {a b : R} (ha : 0 ≤ a) (hab : a ≤ b) : ∀ i : ℕ, a^i ≤ b^i -| 0 := by simp -| (k+1) := by { rw [pow_succ, pow_succ], - exact mul_le_mul hab (pow_le_pow_of_le_left _) (pow_nonneg ha _) (le_trans ha hab) } - -lemma one_lt_pow (ha : 1 < a) {n : ℕ} (hn : n ≠ 0) : 1 < a ^ n := -pow_zero a ▸ pow_lt_pow ha (pos_iff_ne_zero.2 hn) - -lemma pow_le_one : ∀ (n : ℕ) (h₀ : 0 ≤ a) (h₁ : a ≤ 1), a ^ n ≤ 1 -| 0 h₀ h₁ := (pow_zero a).le -| (n + 1) h₀ h₁ := (pow_succ' a n).le.trans (mul_le_one (pow_le_one n h₀ h₁) h₀ h₁) +lemma pow_lt_self_of_lt_one (h₀ : 0 < a) (h₁ : a < 1) (hn : 1 < n) : a ^ n < a := +calc a ^ n < a ^ 1 : pow_lt_pow_of_lt_one h₀ h₁ hn +... = a : pow_one _ lemma sq_pos_of_pos (ha : 0 < a) : 0 < a ^ 2 := by { rw sq, exact mul_pos ha ha } -end ordered_semiring +end strict_ordered_semiring -section ordered_ring -variables [ordered_ring R] {a : R} - -lemma sq_pos_of_neg (ha : a < 0) : 0 < a ^ 2 := by { rw sq, exact mul_pos_of_neg_of_neg ha ha } +section strict_ordered_ring +variables [strict_ordered_ring R] {a : R} lemma pow_bit0_pos_of_neg (ha : a < 0) (n : ℕ) : 0 < a ^ bit0 n := begin @@ -244,10 +390,12 @@ begin exact mul_neg_of_neg_of_pos ha (pow_bit0_pos_of_neg ha n), end -end ordered_ring +lemma sq_pos_of_neg (ha : a < 0) : 0 < a ^ 2 := pow_bit0_pos_of_neg ha _ + +end strict_ordered_ring section linear_ordered_semiring -variable [linear_ordered_semiring R] +variables [linear_ordered_semiring R] {a b : R} lemma pow_le_one_iff_of_nonneg {a : R} (ha : 0 ≤ a) {n : ℕ} (hn : n ≠ 0) : a ^ n ≤ 1 ↔ a ≤ 1 := begin @@ -283,7 +431,7 @@ one_lt_pow_iff_of_nonneg ha (nat.succ_ne_zero _) @[simp] theorem pow_left_inj {x y : R} {n : ℕ} (Hxpos : 0 ≤ x) (Hypos : 0 ≤ y) (Hnpos : 0 < n) : x ^ n = y ^ n ↔ x = y := -(@strict_mono_on_pow R _ _ Hnpos).inj_on.eq_iff Hxpos Hypos +(@strict_mono_on_pow R _ _ Hnpos).eq_iff_eq Hxpos Hypos lemma lt_of_pow_lt_pow {a b : R} (n : ℕ) (hb : 0 ≤ b) (h : a ^ n < b ^ n) : a < b := lt_of_not_ge $ λ hn, not_lt_of_ge (pow_le_pow_of_le_left hb hn _) h @@ -294,6 +442,9 @@ le_of_not_lt $ λ h1, not_le_of_lt (pow_lt_pow_of_lt_left h1 hb hn) h @[simp] lemma sq_eq_sq {a b : R} (ha : 0 ≤ a) (hb : 0 ≤ b) : a ^ 2 = b ^ 2 ↔ a = b := pow_left_inj ha hb dec_trivial +lemma lt_of_mul_self_lt_mul_self (hb : 0 ≤ b) : a * a < b * b → a < b := +by { simp_rw ←sq, exact lt_of_pow_lt_pow _ hb } + end linear_ordered_semiring section linear_ordered_ring @@ -306,6 +457,11 @@ lemma pow_abs (a : R) (n : ℕ) : |a| ^ n = |a ^ n| := lemma abs_neg_one_pow (n : ℕ) : |(-1 : R) ^ n| = 1 := by rw [←pow_abs, abs_neg, abs_one, one_pow] +lemma abs_pow_eq_one (a : R) {n : ℕ} (h : 0 < n) : + |a ^ n| = 1 ↔ |a| = 1 := +by { convert pow_left_inj (abs_nonneg a) zero_le_one h, + exacts [(pow_abs _ _).symm, (one_pow _).symm] } + theorem pow_bit0_nonneg (a : R) (n : ℕ) : 0 ≤ a ^ bit0 n := by { rw pow_bit0, exact mul_self_nonneg _ } @@ -341,63 +497,46 @@ by simpa only [sq] using abs_mul_abs_self x theorem abs_sq (x : R) : |x ^ 2| = x ^ 2 := by simpa only [sq] using abs_mul_self x -theorem sq_lt_sq (h : |x| < |y|) : x ^ 2 < y ^ 2 := -by simpa only [sq_abs] using pow_lt_pow_of_lt_left h (abs_nonneg x) (1:ℕ).succ_pos +theorem sq_lt_sq : x ^ 2 < y ^ 2 ↔ |x| < |y| := +by simpa only [sq_abs] + using (@strict_mono_on_pow R _ _ two_pos).lt_iff_lt (abs_nonneg x) (abs_nonneg y) theorem sq_lt_sq' (h1 : -y < x) (h2 : x < y) : x ^ 2 < y ^ 2 := -sq_lt_sq (lt_of_lt_of_le (abs_lt.2 ⟨h1, h2⟩) (le_abs_self _)) +sq_lt_sq.2 (lt_of_lt_of_le (abs_lt.2 ⟨h1, h2⟩) (le_abs_self _)) -theorem sq_le_sq (h : |x| ≤ |y|) : x ^ 2 ≤ y ^ 2 := -by simpa only [sq_abs] using pow_le_pow_of_le_left (abs_nonneg x) h 2 +theorem sq_le_sq : x ^ 2 ≤ y ^ 2 ↔ |x| ≤ |y| := +by simpa only [sq_abs] + using (@strict_mono_on_pow R _ _ two_pos).le_iff_le (abs_nonneg x) (abs_nonneg y) theorem sq_le_sq' (h1 : -y ≤ x) (h2 : x ≤ y) : x ^ 2 ≤ y ^ 2 := -sq_le_sq (le_trans (abs_le.mpr ⟨h1, h2⟩) (le_abs_self _)) - -theorem abs_lt_abs_of_sq_lt_sq (h : x^2 < y^2) : |x| < |y| := -lt_of_pow_lt_pow 2 (abs_nonneg y) $ by rwa [← sq_abs x, ← sq_abs y] at h +sq_le_sq.2 (le_trans (abs_le.mpr ⟨h1, h2⟩) (le_abs_self _)) theorem abs_lt_of_sq_lt_sq (h : x^2 < y^2) (hy : 0 ≤ y) : |x| < y := -begin - rw [← abs_of_nonneg hy], - exact abs_lt_abs_of_sq_lt_sq h, -end +by rwa [← abs_of_nonneg hy, ← sq_lt_sq] theorem abs_lt_of_sq_lt_sq' (h : x^2 < y^2) (hy : 0 ≤ y) : -y < x ∧ x < y := abs_lt.mp $ abs_lt_of_sq_lt_sq h hy -theorem abs_le_abs_of_sq_le_sq (h : x^2 ≤ y^2) : |x| ≤ |y| := -le_of_pow_le_pow 2 (abs_nonneg y) (1:ℕ).succ_pos $ by rwa [← sq_abs x, ← sq_abs y] at h - theorem abs_le_of_sq_le_sq (h : x^2 ≤ y^2) (hy : 0 ≤ y) : |x| ≤ y := -begin - rw [← abs_of_nonneg hy], - exact abs_le_abs_of_sq_le_sq h, -end +by rwa [← abs_of_nonneg hy, ← sq_le_sq] theorem abs_le_of_sq_le_sq' (h : x^2 ≤ y^2) (hy : 0 ≤ y) : -y ≤ x ∧ x ≤ y := abs_le.mp $ abs_le_of_sq_le_sq h hy lemma sq_eq_sq_iff_abs_eq_abs (x y : R) : x^2 = y^2 ↔ |x| = |y| := -⟨λ h, (abs_le_abs_of_sq_le_sq h.le).antisymm (abs_le_abs_of_sq_le_sq h.ge), - λ h, by rw [←sq_abs, h, sq_abs]⟩ - -@[simp] lemma sq_eq_one_iff (x : R) : x^2 = 1 ↔ x = 1 ∨ x = -1 := -by rw [←abs_eq_abs, ←sq_eq_sq_iff_abs_eq_abs, one_pow] - -lemma sq_ne_one_iff (x : R) : x^2 ≠ 1 ↔ x ≠ 1 ∧ x ≠ -1 := -(not_iff_not.2 (sq_eq_one_iff _)).trans not_or_distrib +by simp only [le_antisymm_iff, sq_le_sq] @[simp] lemma sq_le_one_iff_abs_le_one (x : R) : x^2 ≤ 1 ↔ |x| ≤ 1 := -have t : x^2 ≤ 1^2 ↔ |x| ≤ |1| := ⟨abs_le_abs_of_sq_le_sq, sq_le_sq⟩, by simpa using t +by simpa only [one_pow, abs_one] using @sq_le_sq _ _ x 1 @[simp] lemma sq_lt_one_iff_abs_lt_one (x : R) : x^2 < 1 ↔ |x| < 1 := -have t : x^2 < 1^2 ↔ |x| < |1| := ⟨abs_lt_abs_of_sq_lt_sq, sq_lt_sq⟩, by simpa using t +by simpa only [one_pow, abs_one] using @sq_lt_sq _ _ x 1 @[simp] lemma one_le_sq_iff_one_le_abs (x : R) : 1 ≤ x^2 ↔ 1 ≤ |x| := -have t : 1^2 ≤ x^2 ↔ |1| ≤ |x| := ⟨abs_le_abs_of_sq_le_sq, sq_le_sq⟩, by simpa using t +by simpa only [one_pow, abs_one] using @sq_le_sq _ _ 1 x @[simp] lemma one_lt_sq_iff_one_lt_abs (x : R) : 1 < x^2 ↔ 1 < |x| := -have t : 1^2 < x^2 ↔ |1| < |x| := ⟨abs_lt_abs_of_sq_lt_sq, sq_lt_sq⟩, by simpa using t +by simpa only [one_pow, abs_one] using @sq_lt_sq _ _ 1 x lemma pow_four_le_pow_two_of_pow_two_le {x y : R} (h : x^2 ≤ y) : x^4 ≤ y^2 := (pow_mul x 2 2).symm ▸ pow_le_pow_of_le_left (sq_nonneg x) h 2 @@ -414,3 +553,35 @@ sub_nonneg.mp ((sub_add_eq_add_sub _ _ _).subst ((sub_sq a b).subst (sq_nonneg _ alias two_mul_le_add_sq ← two_mul_le_add_pow_two end linear_ordered_comm_ring + +section linear_ordered_comm_monoid_with_zero +variables [linear_ordered_comm_monoid_with_zero M] [no_zero_divisors M] {a : M} {n : ℕ} + +lemma pow_pos_iff (hn : 0 < n) : 0 < a ^ n ↔ 0 < a := by simp_rw [zero_lt_iff, pow_ne_zero_iff hn] + +end linear_ordered_comm_monoid_with_zero + +section linear_ordered_comm_group_with_zero +variables [linear_ordered_comm_group_with_zero M] {a : M} {m n : ℕ} + +lemma pow_lt_pow_succ (ha : 1 < a) : a ^ n < a ^ n.succ := +by { rw [←one_mul (a ^ n), pow_succ], + exact mul_lt_right₀ _ ha (pow_ne_zero _ (zero_lt_one.trans ha).ne') } + +lemma pow_lt_pow₀ (ha : 1 < a) (hmn : m < n) : a ^ m < a ^ n := +by { induction hmn with n hmn ih, exacts [pow_lt_pow_succ ha, lt_trans ih (pow_lt_pow_succ ha)] } + +end linear_ordered_comm_group_with_zero + +namespace monoid_hom +variables [ring R] [monoid M] [linear_order M] [covariant_class M M (*) (≤)] (f : R →* M) + +lemma map_neg_one : f (-1) = 1 := +(pow_eq_one_iff (nat.succ_ne_zero 1)).1 $ by rw [←map_pow, neg_one_sq, map_one] + +@[simp] lemma map_neg (x : R) : f (-x) = f x := +by rw [←neg_one_mul, map_mul, map_neg_one, one_mul] + +lemma map_sub_swap (x y : R) : f (x - y) = f (y - x) := by rw [←map_neg, neg_sub] + +end monoid_hom diff --git a/src/algebra/group_power/ring.lean b/src/algebra/group_power/ring.lean new file mode 100644 index 0000000000000..80e3dd7a3d76d --- /dev/null +++ b/src/algebra/group_power/ring.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2015 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Robert Y. Lewis +-/ +import algebra.group_power.basic +import algebra.group_with_zero.commute +import algebra.hom.ring +import algebra.ring.commute +import algebra.group_with_zero.divisibility +import algebra.ring.divisibility +import data.nat.order.basic + +/-! +# Power operations on monoids with zero, semirings, and rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides additional lemmas about the natural power operator on rings and semirings. +Further lemmas about ordered semirings and rings can be found in `algebra.group_power.lemmas`. + +-/ + +variables {R S M : Type*} + +section monoid_with_zero +variables [monoid_with_zero M] + +lemma zero_pow : ∀ {n : ℕ}, 0 < n → (0 : M) ^ n = 0 +| (n+1) _ := by rw [pow_succ, zero_mul] + +@[simp] lemma zero_pow' : ∀ n : ℕ, n ≠ 0 → (0 : M) ^ n = 0 +| 0 h := absurd rfl h +| (k+1) h := by { rw [pow_succ], exact zero_mul _ } + +lemma zero_pow_eq (n : ℕ) : (0 : M)^n = if n = 0 then 1 else 0 := +begin + split_ifs with h, + { rw [h, pow_zero], }, + { rw [zero_pow (nat.pos_of_ne_zero h)] }, +end + +lemma pow_eq_zero_of_le {x : M} {n m : ℕ} + (hn : n ≤ m) (hx : x^n = 0) : x^m = 0 := +by rw [← tsub_add_cancel_of_le hn, pow_add, hx, mul_zero] + +theorem pow_eq_zero [no_zero_divisors M] {x : M} {n : ℕ} (H : x^n = 0) : + x = 0 := +begin + induction n with n ih, + { rw pow_zero at H, + rw [← mul_one x, H, mul_zero] }, + { rw pow_succ at H, + exact or.cases_on (mul_eq_zero.1 H) id ih } +end + +@[simp] lemma pow_eq_zero_iff [no_zero_divisors M] + {a : M} {n : ℕ} (hn : 0 < n) : + a ^ n = 0 ↔ a = 0 := +begin + refine ⟨pow_eq_zero, _⟩, + rintros rfl, + exact zero_pow hn, +end + +lemma pow_eq_zero_iff' [no_zero_divisors M] [nontrivial M] + {a : M} {n : ℕ} : + a ^ n = 0 ↔ a = 0 ∧ n ≠ 0 := +by cases (zero_le n).eq_or_gt; simp [*, ne_of_gt] + +lemma pow_ne_zero_iff [no_zero_divisors M] {a : M} {n : ℕ} (hn : 0 < n) : + a ^ n ≠ 0 ↔ a ≠ 0 := +(pow_eq_zero_iff hn).not + +lemma ne_zero_pow {a : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≠ 0 → a ≠ 0 := +by { contrapose!, rintro rfl, exact zero_pow' n hn } + +@[field_simps] theorem pow_ne_zero [no_zero_divisors M] + {a : M} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 := +mt pow_eq_zero h + +instance ne_zero.pow [no_zero_divisors M] {x : M} [ne_zero x] {n : ℕ} : + ne_zero (x ^ n) := ⟨pow_ne_zero n ne_zero.out⟩ + +theorem sq_eq_zero_iff [no_zero_divisors M] {a : M} : a ^ 2 = 0 ↔ a = 0 := +pow_eq_zero_iff two_pos + +@[simp] lemma zero_pow_eq_zero [nontrivial M] {n : ℕ} : (0 : M) ^ n = 0 ↔ 0 < n := +begin + split; intro h, + { rw [pos_iff_ne_zero], rintro rfl, simpa using h }, + { exact zero_pow' n h.ne.symm } +end + +lemma ring.inverse_pow (r : M) : ∀ (n : ℕ), ring.inverse r ^ n = ring.inverse (r ^ n) +| 0 := by rw [pow_zero, pow_zero, ring.inverse_one] +| (n + 1) := by rw [pow_succ, pow_succ', ring.mul_inverse_rev' ((commute.refl r).pow_left n), + ring.inverse_pow] + +end monoid_with_zero + +section comm_monoid_with_zero +variables [comm_monoid_with_zero M] {n : ℕ} (hn : 0 < n) +include M hn + +/-- We define `x ↦ x^n` (for positive `n : ℕ`) as a `monoid_with_zero_hom` -/ +def pow_monoid_with_zero_hom : M →*₀ M := +{ map_zero' := zero_pow hn, + ..pow_monoid_hom n } + +@[simp] +lemma coe_pow_monoid_with_zero_hom : (pow_monoid_with_zero_hom hn : M → M) = (^ n) := rfl + +@[simp] +lemma pow_monoid_with_zero_hom_apply (a : M) : pow_monoid_with_zero_hom hn a = a ^ n := rfl + +end comm_monoid_with_zero + +lemma pow_dvd_pow_iff [cancel_comm_monoid_with_zero R] + {x : R} {n m : ℕ} (h0 : x ≠ 0) (h1 : ¬ is_unit x) : + x ^ n ∣ x ^ m ↔ n ≤ m := +begin + split, + { intro h, rw [← not_lt], intro hmn, apply h1, + have : x ^ m * x ∣ x ^ m * 1, + { rw [← pow_succ', mul_one], exact (pow_dvd_pow _ (nat.succ_le_of_lt hmn)).trans h }, + rwa [mul_dvd_mul_iff_left, ← is_unit_iff_dvd_one] at this, apply pow_ne_zero m h0 }, + { apply pow_dvd_pow } +end + +section semiring +variables [semiring R] [semiring S] + +protected lemma ring_hom.map_pow (f : R →+* S) (a) : + ∀ n : ℕ, f (a ^ n) = (f a) ^ n := +map_pow f a + +lemma min_pow_dvd_add {n m : ℕ} {a b c : R} (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) : + c ^ (min n m) ∣ a + b := +begin + replace ha := (pow_dvd_pow c (min_le_left n m)).trans ha, + replace hb := (pow_dvd_pow c (min_le_right n m)).trans hb, + exact dvd_add ha hb +end + +end semiring + +section comm_semiring +variables [comm_semiring R] + +lemma add_sq (a b : R) : (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 := +by simp only [sq, add_mul_self_eq] + +lemma add_sq' (a b : R) : (a + b) ^ 2 = a ^ 2 + b ^ 2 + 2 * a * b := +by rw [add_sq, add_assoc, add_comm _ (b ^ 2), add_assoc] + +alias add_sq ← add_pow_two + +end comm_semiring + +section has_distrib_neg +variables [monoid R] [has_distrib_neg R] + +variables (R) +theorem neg_one_pow_eq_or : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1 +| 0 := or.inl (pow_zero _) +| (n+1) := (neg_one_pow_eq_or n).swap.imp + (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg]) + (λ h, by rw [pow_succ, h, mul_one]) +variables {R} + +theorem neg_pow (a : R) (n : ℕ) : (- a) ^ n = (-1) ^ n * a ^ n := +(neg_one_mul a) ▸ (commute.neg_one_left a).mul_pow n + +@[simp] theorem neg_pow_bit0 (a : R) (n : ℕ) : (- a) ^ (bit0 n) = a ^ (bit0 n) := +by rw [pow_bit0', neg_mul_neg, pow_bit0'] + +@[simp] theorem neg_pow_bit1 (a : R) (n : ℕ) : (- a) ^ (bit1 n) = - a ^ (bit1 n) := +by simp only [bit1, pow_succ, neg_pow_bit0, neg_mul_eq_neg_mul] + +@[simp] lemma neg_sq (a : R) : (-a) ^ 2 = a ^ 2 := by simp [sq] +@[simp] lemma neg_one_sq : (-1 : R) ^ 2 = 1 := by rw [neg_sq, one_pow] + +alias neg_sq ← neg_pow_two +alias neg_one_sq ← neg_one_pow_two + +end has_distrib_neg + +section ring +variables [ring R] {a b : R} + +protected lemma commute.sq_sub_sq (h : commute a b) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := +by rw [sq, sq, h.mul_self_sub_mul_self_eq] + +@[simp] +lemma neg_one_pow_mul_eq_zero_iff {n : ℕ} {r : R} : (-1)^n * r = 0 ↔ r = 0 := +by rcases neg_one_pow_eq_or R n; simp [h] + +@[simp] +lemma mul_neg_one_pow_eq_zero_iff {n : ℕ} {r : R} : r * (-1)^n = 0 ↔ r = 0 := +by rcases neg_one_pow_eq_or R n; simp [h] + +variables [no_zero_divisors R] + +protected lemma commute.sq_eq_sq_iff_eq_or_eq_neg (h : commute a b) : + a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b := +by rw [←sub_eq_zero, h.sq_sub_sq, mul_eq_zero, add_eq_zero_iff_eq_neg, sub_eq_zero, or_comm] + +@[simp] lemma sq_eq_one_iff : a^2 = 1 ↔ a = 1 ∨ a = -1 := +by rw [←(commute.one_right a).sq_eq_sq_iff_eq_or_eq_neg, one_pow] + +lemma sq_ne_one_iff : a^2 ≠ 1 ↔ a ≠ 1 ∧ a ≠ -1 := sq_eq_one_iff.not.trans not_or_distrib + +end ring + +section comm_ring +variables [comm_ring R] + +lemma sq_sub_sq (a b : R) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := (commute.all a b).sq_sub_sq + +alias sq_sub_sq ← pow_two_sub_pow_two + +lemma sub_sq (a b : R) : (a - b) ^ 2 = a ^ 2 - 2 * a * b + b ^ 2 := +by rw [sub_eq_add_neg, add_sq, neg_sq, mul_neg, ← sub_eq_add_neg] + +alias sub_sq ← sub_pow_two + +lemma sub_sq' (a b : R) : (a - b) ^ 2 = a ^ 2 + b ^ 2 - 2 * a * b := +by rw [sub_eq_add_neg, add_sq', neg_sq, mul_neg, ← sub_eq_add_neg] + +variables [no_zero_divisors R] {a b : R} + +lemma sq_eq_sq_iff_eq_or_eq_neg : a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b := +(commute.all a b).sq_eq_sq_iff_eq_or_eq_neg + +lemma eq_or_eq_neg_of_sq_eq_sq (a b : R) : a ^ 2 = b ^ 2 → a = b ∨ a = -b := +sq_eq_sq_iff_eq_or_eq_neg.1 + +/- Copies of the above comm_ring lemmas for `units R`. -/ +namespace units + +protected lemma sq_eq_sq_iff_eq_or_eq_neg {a b : Rˣ} : a ^ 2 = b ^ 2 ↔ a = b ∨ a = -b := +by simp_rw [ext_iff, coe_pow, sq_eq_sq_iff_eq_or_eq_neg, units.coe_neg] + +protected lemma eq_or_eq_neg_of_sq_eq_sq (a b : Rˣ) (h : a ^ 2 = b ^ 2) : a = b ∨ a = -b := +units.sq_eq_sq_iff_eq_or_eq_neg.1 h + +end units + +end comm_ring diff --git a/src/algebra/group_ring_action.lean b/src/algebra/group_ring_action.lean deleted file mode 100644 index 1afb09bcf5898..0000000000000 --- a/src/algebra/group_ring_action.lean +++ /dev/null @@ -1,132 +0,0 @@ -/- -Copyright (c) 2020 Kenny Lau. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kenny Lau --/ - -import algebra.ring.equiv -import group_theory.group_action.group -import ring_theory.subring.basic - -/-! -# Group action on rings - -This file defines the typeclass of monoid acting on semirings `mul_semiring_action M R`, -and the corresponding typeclass of invariant subrings. - -Note that `algebra` does not satisfy the axioms of `mul_semiring_action`. - -## Implementation notes - -There is no separate typeclass for group acting on rings, group acting on fields, etc. -They are all grouped under `mul_semiring_action`. - -## Tags - -group action, invariant subring - --/ - -universes u v -open_locale big_operators - -/-- Typeclass for multiplicative actions by monoids on semirings. - -This combines `distrib_mul_action` with `mul_distrib_mul_action`. -/ -class mul_semiring_action (M : Type u) (R : Type v) [monoid M] [semiring R] - extends distrib_mul_action M R := -(smul_one : ∀ (g : M), (g • 1 : R) = 1) -(smul_mul : ∀ (g : M) (x y : R), g • (x * y) = (g • x) * (g • y)) - -section semiring - -variables (M G : Type u) [monoid M] [group G] -variables (A R S F : Type v) [add_monoid A] [semiring R] [comm_semiring S] [division_ring F] - --- note we could not use `extends` since these typeclasses are made with `old_structure_cmd` -@[priority 100] -instance mul_semiring_action.to_mul_distrib_mul_action [h : mul_semiring_action M R] : - mul_distrib_mul_action M R := -{ ..h } - -/-- Each element of the monoid defines a semiring homomorphism. -/ -@[simps] -def mul_semiring_action.to_ring_hom [mul_semiring_action M R] (x : M) : R →+* R := -{ .. mul_distrib_mul_action.to_monoid_hom R x, - .. distrib_mul_action.to_add_monoid_hom R x } - -theorem to_ring_hom_injective [mul_semiring_action M R] [has_faithful_scalar M R] : - function.injective (mul_semiring_action.to_ring_hom M R) := -λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, ring_hom.ext_iff.1 h r - -/-- Each element of the group defines a semiring isomorphism. -/ -@[simps] -def mul_semiring_action.to_ring_equiv [mul_semiring_action G R] (x : G) : R ≃+* R := -{ .. distrib_mul_action.to_add_equiv R x, - .. mul_semiring_action.to_ring_hom G R x } - -section -variables {M G R} - -/-- A stronger version of `submonoid.distrib_mul_action`. -/ -instance submonoid.mul_semiring_action [mul_semiring_action M R] (H : submonoid M) : - mul_semiring_action H R := -{ smul := (•), - .. H.mul_distrib_mul_action, - .. H.distrib_mul_action } - -/-- A stronger version of `subgroup.distrib_mul_action`. -/ -instance subgroup.mul_semiring_action [mul_semiring_action G R] (H : subgroup G) : - mul_semiring_action H R := -H.to_submonoid.mul_semiring_action - -/-- A stronger version of `subsemiring.distrib_mul_action`. -/ -instance subsemiring.mul_semiring_action {R'} [semiring R'] [mul_semiring_action R' R] - (H : subsemiring R') : - mul_semiring_action H R := -H.to_submonoid.mul_semiring_action - -/-- A stronger version of `subring.distrib_mul_action`. -/ -instance subring.mul_semiring_action {R'} [ring R'] [mul_semiring_action R' R] - (H : subring R') : - mul_semiring_action H R := -H.to_subsemiring.mul_semiring_action - -end - -section simp_lemmas - -variables {M G A R F} - -attribute [simp] smul_one smul_mul' smul_zero smul_add - -/-- Note that `smul_inv'` refers to the group case, and `smul_inv` has an additional inverse -on `x`. -/ -@[simp] lemma smul_inv'' [mul_semiring_action M F] (x : M) (m : F) : x • m⁻¹ = (x • m)⁻¹ := -(mul_semiring_action.to_ring_hom M F x).map_inv _ - -end simp_lemmas - -end semiring - -section ring - -variables (M : Type u) [monoid M] {R : Type v} [ring R] [mul_semiring_action M R] -variables (S : subring R) -open mul_action - -/-- A typeclass for subrings invariant under a `mul_semiring_action`. -/ -class is_invariant_subring : Prop := -(smul_mem : ∀ (m : M) {x : R}, x ∈ S → m • x ∈ S) - -instance is_invariant_subring.to_mul_semiring_action [is_invariant_subring M S] : - mul_semiring_action M S := -{ smul := λ m x, ⟨m • x, is_invariant_subring.smul_mem m x.2⟩, - one_smul := λ s, subtype.eq $ one_smul M s, - mul_smul := λ m₁ m₂ s, subtype.eq $ mul_smul m₁ m₂ s, - smul_add := λ m s₁ s₂, subtype.eq $ smul_add m s₁ s₂, - smul_zero := λ m, subtype.eq $ smul_zero m, - smul_one := λ m, subtype.eq $ smul_one m, - smul_mul := λ m s₁ s₂, subtype.eq $ smul_mul' m s₁ s₂ } - -end ring diff --git a/src/algebra/group_ring_action/basic.lean b/src/algebra/group_ring_action/basic.lean new file mode 100644 index 0000000000000..c51cd994effd6 --- /dev/null +++ b/src/algebra/group_ring_action/basic.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2020 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau +-/ + +import algebra.ring.equiv +import algebra.field.defs +import group_theory.group_action.group + +/-! +# Group action on rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the typeclass of monoid acting on semirings `mul_semiring_action M R`, +and the corresponding typeclass of invariant subrings. + +Note that `algebra` does not satisfy the axioms of `mul_semiring_action`. + +## Implementation notes + +There is no separate typeclass for group acting on rings, group acting on fields, etc. +They are all grouped under `mul_semiring_action`. + +## Tags + +group action, invariant subring + +-/ + +universes u v + +/-- Typeclass for multiplicative actions by monoids on semirings. + +This combines `distrib_mul_action` with `mul_distrib_mul_action`. -/ +class mul_semiring_action (M : Type u) (R : Type v) [monoid M] [semiring R] + extends distrib_mul_action M R := +(smul_one : ∀ (g : M), (g • 1 : R) = 1) +(smul_mul : ∀ (g : M) (x y : R), g • (x * y) = (g • x) * (g • y)) + +section semiring + +variables (M N G : Type*) [monoid M] [monoid N] [group G] +variables (A R S F : Type v) [add_monoid A] [semiring R] [comm_semiring S] [division_ring F] + +-- note we could not use `extends` since these typeclasses are made with `old_structure_cmd` +@[priority 100] +instance mul_semiring_action.to_mul_distrib_mul_action [h : mul_semiring_action M R] : + mul_distrib_mul_action M R := +{ ..h } + +/-- Each element of the monoid defines a semiring homomorphism. -/ +@[simps] +def mul_semiring_action.to_ring_hom [mul_semiring_action M R] (x : M) : R →+* R := +{ .. mul_distrib_mul_action.to_monoid_hom R x, + .. distrib_mul_action.to_add_monoid_hom R x } + +theorem to_ring_hom_injective [mul_semiring_action M R] [has_faithful_smul M R] : + function.injective (mul_semiring_action.to_ring_hom M R) := +λ m₁ m₂ h, eq_of_smul_eq_smul $ λ r, ring_hom.ext_iff.1 h r + +/-- Each element of the group defines a semiring isomorphism. -/ +@[simps] +def mul_semiring_action.to_ring_equiv [mul_semiring_action G R] (x : G) : R ≃+* R := +{ .. distrib_mul_action.to_add_equiv R x, + .. mul_semiring_action.to_ring_hom G R x } + +section +variables {M N} + +/-- Compose a `mul_semiring_action` with a `monoid_hom`, with action `f r' • m`. +See note [reducible non-instances]. -/ +@[reducible] def mul_semiring_action.comp_hom (f : N →* M) [mul_semiring_action M R] : + mul_semiring_action N R := +{ smul := has_smul.comp.smul f, + ..distrib_mul_action.comp_hom R f, + ..mul_distrib_mul_action.comp_hom R f } + +end + +section simp_lemmas + +variables {M G A R F} + +attribute [simp] smul_one smul_mul' smul_zero smul_add + +/-- Note that `smul_inv'` refers to the group case, and `smul_inv` has an additional inverse +on `x`. -/ +@[simp] lemma smul_inv'' [mul_semiring_action M F] (x : M) (m : F) : x • m⁻¹ = (x • m)⁻¹ := +map_inv₀ (mul_semiring_action.to_ring_hom M F x) _ + +end simp_lemmas + +end semiring diff --git a/src/algebra/group_ring_action/invariant.lean b/src/algebra/group_ring_action/invariant.lean new file mode 100644 index 0000000000000..83a3c28b1e1e0 --- /dev/null +++ b/src/algebra/group_ring_action/invariant.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2021 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.hom.group_action +import ring_theory.subring.pointwise + +/-! # Subrings invariant under an action + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ +section ring + +variables (M R : Type*) [monoid M] [ring R] [mul_semiring_action M R] +variables (S : subring R) +open mul_action +variables {R} + +/-- A typeclass for subrings invariant under a `mul_semiring_action`. -/ +class is_invariant_subring : Prop := +(smul_mem : ∀ (m : M) {x : R}, x ∈ S → m • x ∈ S) + +instance is_invariant_subring.to_mul_semiring_action [is_invariant_subring M S] : + mul_semiring_action M S := +{ smul := λ m x, ⟨m • x, is_invariant_subring.smul_mem m x.2⟩, + one_smul := λ s, subtype.eq $ one_smul M s, + mul_smul := λ m₁ m₂ s, subtype.eq $ mul_smul m₁ m₂ s, + smul_add := λ m s₁ s₂, subtype.eq $ smul_add m s₁ s₂, + smul_zero := λ m, subtype.eq $ smul_zero m, + smul_one := λ m, subtype.eq $ smul_one m, + smul_mul := λ m s₁ s₂, subtype.eq $ smul_mul' m s₁ s₂ } + +end ring + +section +variables (M : Type*) [monoid M] +variables {R' : Type*} [ring R'] [mul_semiring_action M R'] +variables (U : subring R') [is_invariant_subring M U] + +/-- The canonical inclusion from an invariant subring. -/ +def is_invariant_subring.subtype_hom : U →+*[M] R' := +{ map_smul' := λ m s, rfl, ..U.subtype } + +@[simp] theorem is_invariant_subring.coe_subtype_hom : + (is_invariant_subring.subtype_hom M U : U → R') = coe := rfl + +@[simp] theorem is_invariant_subring.coe_subtype_hom' : + (is_invariant_subring.subtype_hom M U : U →+* R') = U.subtype := rfl + +end diff --git a/src/algebra/group_ring_action/subobjects.lean b/src/algebra/group_ring_action/subobjects.lean new file mode 100644 index 0000000000000..638436b5ccd3c --- /dev/null +++ b/src/algebra/group_ring_action/subobjects.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2021 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.group_ring_action.basic +import group_theory.subgroup.basic + +/-! +# Instances of `mul_semiring_action` for subobjects + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +These are defined in this file as `semiring`s are not available yet where `submonoid` and `subgroup` +are defined. + +Instances for `subsemiring` and `subring` are provided next to the other scalar actions instances +for those subobjects. + +-/ +variables {M G R : Type*} +variables [monoid M] [group G] [semiring R] + +/-- A stronger version of `submonoid.distrib_mul_action`. -/ +instance submonoid.mul_semiring_action [mul_semiring_action M R] (H : submonoid M) : + mul_semiring_action H R := +{ smul := (•), + .. H.mul_distrib_mul_action, + .. H.distrib_mul_action } + +/-- A stronger version of `subgroup.distrib_mul_action`. -/ +instance subgroup.mul_semiring_action [mul_semiring_action G R] (H : subgroup G) : + mul_semiring_action H R := +H.to_submonoid.mul_semiring_action diff --git a/src/algebra/group_with_zero/basic.lean b/src/algebra/group_with_zero/basic.lean index 649717c0769a9..ab120f32d347f 100644 --- a/src/algebra/group_with_zero/basic.lean +++ b/src/algebra/group_with_zero/basic.lean @@ -3,15 +3,16 @@ Copyright (c) 2020 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ -import algebra.group.inj_surj +import algebra.group.basic import algebra.group_with_zero.defs -import algebra.hom.units -import logic.nontrivial -import group_theory.group_action.units +import algebra.group.order_synonym /-! # Groups with an adjoined zero element +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file describes structures that are not usually studied on their own right in mathematics, namely a special sort of monoid: apart from a distinguished “zero element” they form a group, or in other words, they are groups with an adjoined zero element. @@ -35,11 +36,10 @@ and require `0⁻¹ = 0`. -/ -set_option old_structure_cmd true open_locale classical open function -variables {M₀ G₀ M₀' G₀' : Type*} +variables {α M₀ G₀ M₀' G₀' F F' : Type*} section @@ -47,33 +47,6 @@ section mul_zero_class variables [mul_zero_class M₀] {a b : M₀} - -/-- Pullback a `mul_zero_class` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀' → M₀) - (hf : injective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) : - mul_zero_class M₀' := -{ mul := (*), - zero := 0, - zero_mul := λ a, hf $ by simp only [mul, zero, zero_mul], - mul_zero := λ a, hf $ by simp only [mul, zero, mul_zero] } - -/-- Pushforward a `mul_zero_class` instance along an surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀ → M₀') - (hf : surjective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) : - mul_zero_class M₀' := -{ mul := (*), - zero := 0, - mul_zero := hf.forall.2 $ λ x, by simp only [← zero, ← mul, mul_zero], - zero_mul := hf.forall.2 $ λ x, by simp only [← zero, ← mul, zero_mul] } - -lemma mul_eq_zero_of_left (h : a = 0) (b : M₀) : a * b = 0 := h.symm ▸ zero_mul b - -lemma mul_eq_zero_of_right (a : M₀) (h : b = 0) : a * b = 0 := h.symm ▸ mul_zero a - lemma left_ne_zero_of_mul : a * b ≠ 0 → a ≠ 0 := mt (λ h, mul_eq_zero_of_left h b) lemma right_ne_zero_of_mul : a * b ≠ 0 → b ≠ 0 := mt (mul_eq_zero_of_right a) @@ -93,59 +66,25 @@ lemma mul_zero_eq_const : (* (0 : M₀)) = function.const _ 0 := funext mul_zero end mul_zero_class -/-- Pushforward a `no_zero_divisors` instance along an injective function. -/ -protected lemma function.injective.no_zero_divisors [has_mul M₀] [has_zero M₀] - [has_mul M₀'] [has_zero M₀'] [no_zero_divisors M₀'] - (f : M₀ → M₀') (hf : injective f) (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) : - no_zero_divisors M₀ := -{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y H, - have f x * f y = 0, by rw [← mul, H, zero], - (eq_zero_or_eq_zero_of_mul_eq_zero this).imp (λ H, hf $ by rwa zero) (λ H, hf $ by rwa zero) } - -lemma eq_zero_of_mul_self_eq_zero [has_mul M₀] [has_zero M₀] [no_zero_divisors M₀] - {a : M₀} (h : a * a = 0) : - a = 0 := -(eq_zero_or_eq_zero_of_mul_eq_zero h).elim id id - -section - -variables [mul_zero_class M₀] [no_zero_divisors M₀] {a b : M₀} - -/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them -equals zero. -/ -@[simp] theorem mul_eq_zero : a * b = 0 ↔ a = 0 ∨ b = 0 := -⟨eq_zero_or_eq_zero_of_mul_eq_zero, - λo, o.elim (λ h, mul_eq_zero_of_left h b) (mul_eq_zero_of_right a)⟩ +section has_mul -/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them -equals zero. -/ -@[simp] theorem zero_eq_mul : 0 = a * b ↔ a = 0 ∨ b = 0 := -by rw [eq_comm, mul_eq_zero] +variables [has_mul M₀] [has_zero M₀] [no_zero_divisors M₀] {a b : M₀} -/-- If `α` has no zero divisors, then the product of two elements is nonzero iff both of them -are nonzero. -/ -theorem mul_ne_zero_iff : a * b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 := -(not_congr mul_eq_zero).trans not_or_distrib +lemma eq_zero_of_mul_self_eq_zero (h : a * a = 0) : a = 0 := +(eq_zero_or_eq_zero_of_mul_eq_zero h).elim id id @[field_simps] theorem mul_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 := -mul_ne_zero_iff.2 ⟨ha, hb⟩ +mt eq_zero_or_eq_zero_of_mul_eq_zero $ not_or_distrib.mpr ⟨ha, hb⟩ -/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` equals zero iff so is -`b * a`. -/ -theorem mul_eq_zero_comm : a * b = 0 ↔ b * a = 0 := -mul_eq_zero.trans $ (or_comm _ _).trans mul_eq_zero.symm +end has_mul -/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` is nonzero iff so is -`b * a`. -/ -theorem mul_ne_zero_comm : a * b ≠ 0 ↔ b * a ≠ 0 := -not_congr mul_eq_zero_comm +namespace ne_zero -lemma mul_self_eq_zero : a * a = 0 ↔ a = 0 := by simp -lemma zero_eq_mul_self : 0 = a * a ↔ a = 0 := by simp -lemma mul_self_ne_zero : a * a ≠ 0 ↔ a ≠ 0 := not_congr mul_self_eq_zero -lemma zero_ne_mul_self : 0 ≠ a * a ↔ a ≠ 0 := not_congr zero_eq_mul_self +instance mul [has_zero M₀] [has_mul M₀] [no_zero_divisors M₀] {x y : M₀} + [ne_zero x] [ne_zero y] : ne_zero (x * y) := +⟨mul_ne_zero out out⟩ -end +end ne_zero end @@ -153,24 +92,6 @@ section variables [mul_zero_one_class M₀] -/-- Pullback a `mul_zero_one_class` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀'] - (f : M₀' → M₀) - (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) : - mul_zero_one_class M₀' := -{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul } - -/-- Pushforward a `mul_zero_one_class` instance along an surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀'] - (f : M₀ → M₀') - (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) : - mul_zero_one_class M₀' := -{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul } - /-- In a monoid with zero, if zero equals one, then zero is the only element. -/ lemma eq_zero_of_zero_eq_one (h : (0 : M₀) = 1) (a : M₀) : a = 0 := by rw [← mul_one a, ← h, mul_zero] @@ -201,234 +122,14 @@ section variables [mul_zero_one_class M₀] [nontrivial M₀] {a b : M₀} -/-- In a nontrivial monoid with zero, zero and one are different. -/ -@[simp] lemma zero_ne_one : 0 ≠ (1:M₀) := -begin - assume h, - rcases exists_pair_ne M₀ with ⟨x, y, hx⟩, - apply hx, - calc x = 1 * x : by rw [one_mul] - ... = 0 : by rw [← h, zero_mul] - ... = 1 * y : by rw [← h, zero_mul] - ... = y : by rw [one_mul] -end - -@[simp] lemma one_ne_zero : (1:M₀) ≠ 0 := -zero_ne_one.symm - -lemma ne_zero_of_eq_one {a : M₀} (h : a = 1) : a ≠ 0 := -calc a = 1 : h - ... ≠ 0 : one_ne_zero - lemma left_ne_zero_of_mul_eq_one (h : a * b = 1) : a ≠ 0 := left_ne_zero_of_mul $ ne_zero_of_eq_one h lemma right_ne_zero_of_mul_eq_one (h : a * b = 1) : b ≠ 0 := right_ne_zero_of_mul $ ne_zero_of_eq_one h -/-- Pullback a `nontrivial` instance along a function sending `0` to `0` and `1` to `1`. -/ -protected lemma pullback_nonzero [has_zero M₀'] [has_one M₀'] - (f : M₀' → M₀) (zero : f 0 = 0) (one : f 1 = 1) : nontrivial M₀' := -⟨⟨0, 1, mt (congr_arg f) $ by { rw [zero, one], exact zero_ne_one }⟩⟩ - end -section semigroup_with_zero - -/-- Pullback a `semigroup_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.semigroup_with_zero - [has_zero M₀'] [has_mul M₀'] [semigroup_with_zero M₀] (f : M₀' → M₀) (hf : injective f) - (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) : - semigroup_with_zero M₀' := -{ .. hf.mul_zero_class f zero mul, - .. ‹has_zero M₀'›, - .. hf.semigroup f mul } - -/-- Pushforward a `semigroup_with_zero` class along an surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.semigroup_with_zero - [semigroup_with_zero M₀] [has_zero M₀'] [has_mul M₀'] (f : M₀ → M₀') (hf : surjective f) - (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) : - semigroup_with_zero M₀' := -{ .. hf.mul_zero_class f zero mul, - .. ‹has_zero M₀'›, - .. hf.semigroup f mul } - -end semigroup_with_zero - -section monoid_with_zero - -/-- Pullback a `monoid_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] - [has_pow M₀' ℕ] [monoid_with_zero M₀] - (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - monoid_with_zero M₀' := -{ .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul } - -/-- Pushforward a `monoid_with_zero` class along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] - [has_pow M₀' ℕ] [monoid_with_zero M₀] - (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - monoid_with_zero M₀' := -{ .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul } - -/-- Pullback a `monoid_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] - [has_pow M₀' ℕ] [comm_monoid_with_zero M₀] - (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - comm_monoid_with_zero M₀' := -{ .. hf.comm_monoid f one mul npow, .. hf.mul_zero_class f zero mul } - -/-- Pushforward a `monoid_with_zero` class along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] - [has_pow M₀' ℕ] [comm_monoid_with_zero M₀] - (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - comm_monoid_with_zero M₀' := -{ .. hf.comm_monoid f one mul npow, .. hf.mul_zero_class f zero mul } - -variables [monoid_with_zero M₀] - -namespace units - -/-- An element of the unit group of a nonzero monoid with zero represented as an element - of the monoid is nonzero. -/ -@[simp] lemma ne_zero [nontrivial M₀] (u : M₀ˣ) : - (u : M₀) ≠ 0 := -left_ne_zero_of_mul_eq_one u.mul_inv - --- We can't use `mul_eq_zero` + `units.ne_zero` in the next two lemmas because we don't assume --- `nonzero M₀`. - -@[simp] lemma mul_left_eq_zero (u : M₀ˣ) {a : M₀} : a * u = 0 ↔ a = 0 := -⟨λ h, by simpa using mul_eq_zero_of_left h ↑u⁻¹, λ h, mul_eq_zero_of_left h u⟩ - -@[simp] lemma mul_right_eq_zero (u : M₀ˣ) {a : M₀} : ↑u * a = 0 ↔ a = 0 := -⟨λ h, by simpa using mul_eq_zero_of_right ↑u⁻¹ h, mul_eq_zero_of_right u⟩ - -end units - -namespace is_unit - -lemma ne_zero [nontrivial M₀] {a : M₀} (ha : is_unit a) : a ≠ 0 := let ⟨u, hu⟩ := -ha in hu ▸ u.ne_zero - -lemma mul_right_eq_zero {a b : M₀} (ha : is_unit a) : a * b = 0 ↔ b = 0 := -let ⟨u, hu⟩ := ha in hu ▸ u.mul_right_eq_zero - -lemma mul_left_eq_zero {a b : M₀} (hb : is_unit b) : a * b = 0 ↔ a = 0 := -let ⟨u, hu⟩ := hb in hu ▸ u.mul_left_eq_zero - -end is_unit - -@[simp] theorem is_unit_zero_iff : is_unit (0 : M₀) ↔ (0:M₀) = 1 := -⟨λ ⟨⟨_, a, (a0 : 0 * a = 1), _⟩, rfl⟩, by rwa zero_mul at a0, - λ h, @is_unit_of_subsingleton _ _ (subsingleton_of_zero_eq_one h) 0⟩ - -@[simp] theorem not_is_unit_zero [nontrivial M₀] : ¬ is_unit (0 : M₀) := -mt is_unit_zero_iff.1 zero_ne_one - -namespace ring -open_locale classical - -/-- Introduce a function `inverse` on a monoid with zero `M₀`, which sends `x` to `x⁻¹` if `x` is -invertible and to `0` otherwise. This definition is somewhat ad hoc, but one needs a fully (rather -than partially) defined inverse function for some purposes, including for calculus. - -Note that while this is in the `ring` namespace for brevity, it requires the weaker assumption -`monoid_with_zero M₀` instead of `ring M₀`. -/ -noncomputable def inverse : M₀ → M₀ := -λ x, if h : is_unit x then ((h.unit⁻¹ : M₀ˣ) : M₀) else 0 - -/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/ -@[simp] lemma inverse_unit (u : M₀ˣ) : inverse (u : M₀) = (u⁻¹ : M₀ˣ) := -begin - simp only [units.is_unit, inverse, dif_pos], - exact units.inv_unique rfl -end - -/-- By definition, if `x` is not invertible then `inverse x = 0`. -/ -@[simp] lemma inverse_non_unit (x : M₀) (h : ¬(is_unit x)) : inverse x = 0 := dif_neg h - -lemma mul_inverse_cancel (x : M₀) (h : is_unit x) : x * inverse x = 1 := -by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.mul_inv], } - -lemma inverse_mul_cancel (x : M₀) (h : is_unit x) : inverse x * x = 1 := -by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.inv_mul], } - -lemma mul_inverse_cancel_right (x y : M₀) (h : is_unit x) : y * x * inverse x = y := -by rw [mul_assoc, mul_inverse_cancel x h, mul_one] - -lemma inverse_mul_cancel_right (x y : M₀) (h : is_unit x) : y * inverse x * x = y := -by rw [mul_assoc, inverse_mul_cancel x h, mul_one] - -lemma mul_inverse_cancel_left (x y : M₀) (h : is_unit x) : x * (inverse x * y) = y := -by rw [← mul_assoc, mul_inverse_cancel x h, one_mul] - -lemma inverse_mul_cancel_left (x y : M₀) (h : is_unit x) : inverse x * (x * y) = y := -by rw [← mul_assoc, inverse_mul_cancel x h, one_mul] - -variables (M₀) - -@[simp] lemma inverse_one : inverse (1 : M₀) = 1 := -inverse_unit 1 - -@[simp] lemma inverse_zero : inverse (0 : M₀) = 0 := -by { nontriviality, exact inverse_non_unit _ not_is_unit_zero } - -variables {M₀} - -lemma mul_inverse_rev' {a b : M₀} (h : commute a b) : inverse (a * b) = inverse b * inverse a := -begin - by_cases hab : is_unit (a * b), - { obtain ⟨⟨a, rfl⟩, b, rfl⟩ := h.is_unit_mul_iff.mp hab, - rw [←units.coe_mul, inverse_unit, inverse_unit, inverse_unit, ←units.coe_mul, - mul_inv_rev], }, - obtain ha | hb := not_and_distrib.mp (mt h.is_unit_mul_iff.mpr hab), - { rw [inverse_non_unit _ hab, inverse_non_unit _ ha, mul_zero]}, - { rw [inverse_non_unit _ hab, inverse_non_unit _ hb, zero_mul]}, -end - -lemma mul_inverse_rev {M₀} [comm_monoid_with_zero M₀] (a b : M₀) : - ring.inverse (a * b) = inverse b * inverse a := -mul_inverse_rev' (commute.all _ _) - -end ring - -lemma is_unit.ring_inverse {a : M₀} : is_unit a → is_unit (ring.inverse a) -| ⟨u, hu⟩ := hu ▸ ⟨u⁻¹, (ring.inverse_unit u).symm⟩ - -@[simp] lemma is_unit_ring_inverse {a : M₀} : is_unit (ring.inverse a) ↔ is_unit a := -⟨λ h, begin - casesI subsingleton_or_nontrivial M₀, - { convert h }, - { contrapose h, - rw ring.inverse_non_unit _ h, - exact not_is_unit_zero, }, -end, is_unit.ring_inverse⟩ - -lemma commute.ring_inverse_ring_inverse {a b : M₀} (h : commute a b) : - commute (ring.inverse a) (ring.inverse b) := -(ring.mul_inverse_rev' h.symm).symm.trans $ (congr_arg _ h.symm.eq).trans $ ring.mul_inverse_rev' h - -variable (M₀) - -end monoid_with_zero - section cancel_monoid_with_zero variables [cancel_monoid_with_zero M₀] {a b c : M₀} @@ -438,9 +139,8 @@ instance cancel_monoid_with_zero.to_no_zero_divisors : no_zero_divisors M₀ := ⟨λ a b ab0, by { by_cases a = 0, { left, exact h }, right, apply cancel_monoid_with_zero.mul_left_cancel_of_ne_zero h, rw [ab0, mul_zero], }⟩ -lemma mul_left_inj' (hc : c ≠ 0) : a * c = b * c ↔ a = b := ⟨mul_right_cancel₀ hc, λ h, h ▸ rfl⟩ - -lemma mul_right_inj' (ha : a ≠ 0) : a * b = a * c ↔ b = c := ⟨mul_left_cancel₀ ha, λ h, h ▸ rfl⟩ +lemma mul_left_inj' (hc : c ≠ 0) : a * c = b * c ↔ a = b := (mul_left_injective₀ hc).eq_iff +lemma mul_right_inj' (ha : a ≠ 0) : a * b = a * c ↔ b = c := (mul_right_injective₀ ha).eq_iff @[simp] lemma mul_eq_mul_right_iff : a * c = b * c ↔ a = b ∨ c = 0 := by by_cases hc : c = 0; [simp [hc], simp [mul_left_inj', hc]] @@ -456,18 +156,14 @@ lemma mul_left_eq_self₀ : a * b = b ↔ a = 1 ∨ b = 0 := calc a * b = b ↔ a * b = 1 * b : by rw one_mul ... ↔ a = 1 ∨ b = 0 : mul_eq_mul_right_iff -/-- Pullback a `monoid_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.cancel_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] - [has_pow M₀' ℕ] (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - cancel_monoid_with_zero M₀' := -{ mul_left_cancel_of_ne_zero := λ x y z hx H, hf $ mul_left_cancel₀ ((hf.ne_iff' zero).2 hx) $ - by erw [← mul, ← mul, H]; refl, - mul_right_cancel_of_ne_zero := λ x y z hx H, hf $ mul_right_cancel₀ ((hf.ne_iff' zero).2 hx) $ - by erw [← mul, ← mul, H]; refl, - .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul } +@[simp] lemma mul_eq_left₀ (ha : a ≠ 0) : a * b = a ↔ b = 1 := +by rw [iff.comm, ←mul_right_inj' ha, mul_one] + +@[simp] lemma mul_eq_right₀ (hb : b ≠ 0) : a * b = b ↔ a = 1 := +by rw [iff.comm, ←mul_left_inj' hb, one_mul] + +@[simp] lemma left_eq_mul₀ (ha : a ≠ 0) : a = a * b ↔ b = 1 := by rw [eq_comm, mul_eq_left₀ ha] +@[simp] lemma right_eq_mul₀ (hb : b ≠ 0) : b = a * b ↔ a = 1 := by rw [eq_comm, mul_eq_right₀ hb] /-- An element of a `cancel_monoid_with_zero` fixed by right multiplication by an element other than one must be zero. -/ @@ -481,60 +177,10 @@ classical.by_contradiction $ λ ha, h₁ $ mul_right_cancel₀ ha $ h₂.symm end cancel_monoid_with_zero -section cancel_comm_monoid_with_zero - -variables [cancel_comm_monoid_with_zero M₀] {a b c : M₀} - -/-- Pullback a `cancel_comm_monoid_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.cancel_comm_monoid_with_zero - [has_zero M₀'] [has_mul M₀'] [has_one M₀'] [has_pow M₀' ℕ] - (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - cancel_comm_monoid_with_zero M₀' := -{ .. hf.comm_monoid_with_zero f zero one mul npow, - .. hf.cancel_monoid_with_zero f zero one mul npow } - -end cancel_comm_monoid_with_zero section group_with_zero variables [group_with_zero G₀] {a b c g h x : G₀} -/-- Pullback a `group_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀'] - [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] - (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) - (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) - (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : - group_with_zero G₀' := -{ inv_zero := hf $ by erw [inv, zero, inv_zero], - mul_inv_cancel := λ x hx, hf $ by erw [one, mul, inv, mul_inv_cancel ((hf.ne_iff' zero).2 hx)], - .. hf.monoid_with_zero f zero one mul npow, - .. hf.div_inv_monoid f one mul inv div npow zpow, - .. pullback_nonzero f zero one, } - -/-- Pushforward a `group_with_zero` class along an surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀'] - [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] - (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f) - (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) - (inv : ∀ x, f x⁻¹ = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n): - group_with_zero G₀' := -{ inv_zero := by erw [← zero, ← inv, inv_zero], - mul_inv_cancel := hf.forall.2 $ λ x hx, - by erw [← inv, ← mul, mul_inv_cancel (mt (congr_arg f) $ trans_rel_left ne hx zero.symm)]; - exact one, - exists_pair_ne := ⟨0, 1, h01⟩, - .. hf.monoid_with_zero f zero one mul npow, - .. hf.div_inv_monoid f one mul inv div npow zpow } - @[simp] lemma mul_inv_cancel_right₀ (h : b ≠ 0) (a : G₀) : (a * b) * b⁻¹ = a := calc (a * b) * b⁻¹ = a * (b * b⁻¹) : mul_assoc _ _ _ @@ -591,7 +237,24 @@ instance group_with_zero.to_division_monoid : division_monoid G₀ := inv_eq_of_mul := λ a b, inv_eq_of_mul, ..‹group_with_zero G₀› } -@[simp] lemma inv_one : 1⁻¹ = (1:G₀) := division_monoid.inv_one +@[priority 10] -- see Note [lower instance priority] +instance group_with_zero.to_cancel_monoid_with_zero : cancel_monoid_with_zero G₀ := +{ mul_left_cancel_of_ne_zero := λ x y z hx h, + by rw [← inv_mul_cancel_left₀ hx y, h, inv_mul_cancel_left₀ hx z], + mul_right_cancel_of_ne_zero := λ x y z hy h, + by rw [← mul_inv_cancel_right₀ hy x, h, mul_inv_cancel_right₀ hy z], + ..‹group_with_zero G₀› } + +end group_with_zero + +section group_with_zero +variables [group_with_zero G₀] {a b c : G₀} + +@[simp] lemma zero_div (a : G₀) : 0 / a = 0 := +by rw [div_eq_mul_inv, zero_mul] + +@[simp] lemma div_zero (a : G₀) : a / 0 = 0 := +by rw [div_eq_mul_inv, inv_zero, mul_zero] /-- Multiplying `a` by itself and then by its inverse results in `a` (whether or not `a` is zero). -/ @@ -620,270 +283,31 @@ begin { rw [inv_mul_cancel h, one_mul] } end -/-- Multiplying `a` by itself and then dividing by itself results in -`a` (whether or not `a` is zero). -/ +/-- Multiplying `a` by itself and then dividing by itself results in `a`, whether or not `a` is +zero. -/ @[simp] lemma mul_self_div_self (a : G₀) : a * a / a = a := by rw [div_eq_mul_inv, mul_self_mul_inv a] -/-- Dividing `a` by itself and then multiplying by itself results in -`a` (whether or not `a` is zero). -/ +/-- Dividing `a` by itself and then multiplying by itself results in `a`, whether or not `a` is +zero. -/ @[simp] lemma div_self_mul_self (a : G₀) : a / a * a = a := by rw [div_eq_mul_inv, mul_inv_mul_self a] -lemma eq_inv_of_mul_right_eq_one : a * b = 1 → b = a⁻¹ := division_monoid.eq_inv_of_mul_eq_one_right -lemma eq_inv_of_mul_left_eq_one : a * b = 1 → a = b⁻¹ := division_monoid.eq_inv_of_mul_eq_one_left - -lemma inv_eq_one₀ : g⁻¹ = 1 ↔ g = 1 := division_monoid.inv_eq_one - -lemma eq_mul_inv_iff_mul_eq₀ (hc : c ≠ 0) : a = b * c⁻¹ ↔ a * c = b := -by split; rintro rfl; [rw inv_mul_cancel_right₀ hc, rw mul_inv_cancel_right₀ hc] - -lemma eq_inv_mul_iff_mul_eq₀ (hb : b ≠ 0) : a = b⁻¹ * c ↔ b * a = c := -by split; rintro rfl; [rw mul_inv_cancel_left₀ hb, rw inv_mul_cancel_left₀ hb] - -lemma inv_mul_eq_iff_eq_mul₀ (ha : a ≠ 0) : a⁻¹ * b = c ↔ b = a * c := -by rw [eq_comm, eq_inv_mul_iff_mul_eq₀ ha, eq_comm] - -lemma mul_inv_eq_iff_eq_mul₀ (hb : b ≠ 0) : a * b⁻¹ = c ↔ a = c * b := -by rw [eq_comm, eq_mul_inv_iff_mul_eq₀ hb, eq_comm] - -lemma mul_inv_eq_one₀ (hb : b ≠ 0) : a * b⁻¹ = 1 ↔ a = b := -by rw [mul_inv_eq_iff_eq_mul₀ hb, one_mul] - -lemma inv_mul_eq_one₀ (ha : a ≠ 0) : a⁻¹ * b = 1 ↔ a = b := -by rw [inv_mul_eq_iff_eq_mul₀ ha, mul_one, eq_comm] - -lemma mul_eq_one_iff_eq_inv₀ (hb : b ≠ 0) : a * b = 1 ↔ a = b⁻¹ := -by { convert mul_inv_eq_one₀ (inv_ne_zero hb), rw [inv_inv] } - -lemma mul_eq_one_iff_inv_eq₀ (ha : a ≠ 0) : a * b = 1 ↔ a⁻¹ = b := -by { convert inv_mul_eq_one₀ (inv_ne_zero ha), rw [inv_inv] } - -end group_with_zero - -namespace units -variables [group_with_zero G₀] -variables {a b : G₀} - -/-- Embed a non-zero element of a `group_with_zero` into the unit group. - By combining this function with the operations on units, - or the `/ₚ` operation, it is possible to write a division - as a partial function with three arguments. -/ -def mk0 (a : G₀) (ha : a ≠ 0) : G₀ˣ := -⟨a, a⁻¹, mul_inv_cancel ha, inv_mul_cancel ha⟩ - -@[simp] lemma mk0_one (h := one_ne_zero) : - mk0 (1 : G₀) h = 1 := -by { ext, refl } - -@[simp] lemma coe_mk0 {a : G₀} (h : a ≠ 0) : (mk0 a h : G₀) = a := rfl - -@[simp] lemma mk0_coe (u : G₀ˣ) (h : (u : G₀) ≠ 0) : mk0 (u : G₀) h = u := -units.ext rfl - -@[simp, norm_cast] lemma coe_inv' (u : G₀ˣ) : ((u⁻¹ : G₀ˣ) : G₀) = u⁻¹ := -eq_inv_of_mul_left_eq_one u.inv_mul - -@[simp] lemma mul_inv' (u : G₀ˣ) : (u : G₀) * u⁻¹ = 1 := mul_inv_cancel u.ne_zero - -@[simp] lemma inv_mul' (u : G₀ˣ) : (u⁻¹ : G₀) * u = 1 := inv_mul_cancel u.ne_zero - -@[simp] lemma mk0_inj {a b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) : - units.mk0 a ha = units.mk0 b hb ↔ a = b := -⟨λ h, by injection h, λ h, units.ext h⟩ - -/-- In a group with zero, an existential over a unit can be rewritten in terms of `units.mk0`. -/ -lemma exists0 {p : G₀ˣ → Prop} : (∃ g : G₀ˣ, p g) ↔ ∃ (g : G₀) (hg : g ≠ 0), p (units.mk0 g hg) := -⟨λ ⟨g, pg⟩, ⟨g, g.ne_zero, (g.mk0_coe g.ne_zero).symm ▸ pg⟩, λ ⟨g, hg, pg⟩, ⟨units.mk0 g hg, pg⟩⟩ - -/-- An alternative version of `units.exists0`. This one is useful if Lean cannot -figure out `p` when using `units.exists0` from right to left. -/ -lemma exists0' {p : Π g : G₀, g ≠ 0 → Prop} : - (∃ (g : G₀) (hg : g ≠ 0), p g hg) ↔ ∃ g : G₀ˣ, p g g.ne_zero := -iff.trans (by simp_rw [coe_mk0]) exists0.symm - -@[simp] lemma exists_iff_ne_zero {x : G₀} : (∃ u : G₀ˣ, ↑u = x) ↔ x ≠ 0 := -by simp [exists0] - -lemma _root_.group_with_zero.eq_zero_or_unit (a : G₀) : - a = 0 ∨ ∃ u : G₀ˣ, a = u := -begin - by_cases h : a = 0, - { left, - exact h }, - { right, - simpa only [eq_comm] using units.exists_iff_ne_zero.mpr h } -end - -@[simp] lemma smul_mk0 {α : Type*} [has_scalar G₀ α] {g : G₀} (hg : g ≠ 0) (a : α) : - (mk0 g hg) • a = g • a := -rfl - -end units - -section group_with_zero -variables [group_with_zero G₀] - -lemma is_unit.mk0 (x : G₀) (hx : x ≠ 0) : is_unit x := (units.mk0 x hx).is_unit - -lemma is_unit_iff_ne_zero {x : G₀} : is_unit x ↔ x ≠ 0 := -units.exists_iff_ne_zero - -@[priority 10] -- see Note [lower instance priority] -instance group_with_zero.no_zero_divisors : no_zero_divisors G₀ := -{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h, - begin - contrapose! h, - exact ((units.mk0 a h.1) * (units.mk0 b h.2)).ne_zero - end, - .. (‹_› : group_with_zero G₀) } - -@[priority 10] -- see Note [lower instance priority] -instance group_with_zero.cancel_monoid_with_zero : cancel_monoid_with_zero G₀ := -{ mul_left_cancel_of_ne_zero := λ x y z hx h, - by rw [← inv_mul_cancel_left₀ hx y, h, inv_mul_cancel_left₀ hx z], - mul_right_cancel_of_ne_zero := λ x y z hy h, - by rw [← mul_inv_cancel_right₀ hy x, h, mul_inv_cancel_right₀ hy z], - .. (‹_› : group_with_zero G₀) } - --- Can't be put next to the other `mk0` lemmas becuase it depends on the --- `no_zero_divisors` instance, which depends on `mk0`. -@[simp] lemma units.mk0_mul (x y : G₀) (hxy) : - units.mk0 (x * y) hxy = - units.mk0 x (mul_ne_zero_iff.mp hxy).1 * units.mk0 y (mul_ne_zero_iff.mp hxy).2 := -by { ext, refl } - -lemma mul_inv_rev₀ (x y : G₀) : (x * y)⁻¹ = y⁻¹ * x⁻¹ := mul_inv_rev _ _ - -@[simp] lemma div_self {a : G₀} (h : a ≠ 0) : a / a = 1 := -by rw [div_eq_mul_inv, mul_inv_cancel h] - -lemma div_one (a : G₀) : a / 1 = a := division_monoid.div_one _ - -@[simp] lemma zero_div (a : G₀) : 0 / a = 0 := -by rw [div_eq_mul_inv, zero_mul] - -@[simp] lemma div_zero (a : G₀) : a / 0 = 0 := -by rw [div_eq_mul_inv, inv_zero, mul_zero] - -@[simp] lemma div_mul_cancel (a : G₀) {b : G₀} (h : b ≠ 0) : a / b * b = a := -by rw [div_eq_mul_inv, inv_mul_cancel_right₀ h a] - -lemma div_mul_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a / b * b = a := -classical.by_cases (λ hb : b = 0, by simp [*]) (div_mul_cancel a) - -@[simp] lemma mul_div_cancel (a : G₀) {b : G₀} (h : b ≠ 0) : a * b / b = a := -by rw [div_eq_mul_inv, mul_inv_cancel_right₀ h a] - -lemma mul_div_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a * b / b = a := -classical.by_cases (λ hb : b = 0, by simp [*]) (mul_div_cancel a) - local attribute [simp] div_eq_mul_inv mul_comm mul_assoc mul_left_comm @[simp] lemma div_self_mul_self' (a : G₀) : a / (a * a) = a⁻¹ := -calc a / (a * a) = a⁻¹⁻¹ * a⁻¹ * a⁻¹ : by simp [mul_inv_rev₀] +calc a / (a * a) = a⁻¹⁻¹ * a⁻¹ * a⁻¹ : by simp [mul_inv_rev] ... = a⁻¹ : inv_mul_mul_self _ -lemma mul_one_div_cancel {a : G₀} (h : a ≠ 0) : a * (1 / a) = 1 := -by simp [h] - -lemma one_div_mul_cancel {a : G₀} (h : a ≠ 0) : (1 / a) * a = 1 := -by simp [h] - -lemma one_div_one : 1 / 1 = (1:G₀) := division_monoid.one_div_one - lemma one_div_ne_zero {a : G₀} (h : a ≠ 0) : 1 / a ≠ 0 := by simpa only [one_div] using inv_ne_zero h -lemma eq_one_div_of_mul_eq_one {a b : G₀} : a * b = 1 → b = 1 / a := -division_monoid.eq_one_div_of_mul_eq_one_right - -lemma eq_one_div_of_mul_eq_one_left {a b : G₀} : b * a = 1 → b = 1 / a := -division_monoid.eq_one_div_of_mul_eq_one_left - -lemma one_div_div (a b : G₀) : 1 / (a / b) = b / a := division_monoid.one_div_div _ _ - -lemma one_div_one_div (a : G₀) : 1 / (1 / a) = a := division_monoid.one_div_one_div _ - -lemma eq_of_one_div_eq_one_div {a b : G₀} : 1 / a = 1 / b → a = b := -division_monoid.eq_of_one_div_eq_one_div - -variables {a b c : G₀} - @[simp] lemma inv_eq_zero {a : G₀} : a⁻¹ = 0 ↔ a = 0 := -by rw [inv_eq_iff_inv_eq, inv_zero, eq_comm] +by rw [inv_eq_iff_eq_inv, inv_zero] @[simp] lemma zero_eq_inv {a : G₀} : 0 = a⁻¹ ↔ 0 = a := eq_comm.trans $ inv_eq_zero.trans eq_comm -lemma one_div_mul_one_div_rev (a b : G₀) : (1 / a) * (1 / b) = 1 / (b * a) := -division_monoid.one_div_mul_one_div_rev _ _ - -theorem divp_eq_div (a : G₀) (u : G₀ˣ) : a /ₚ u = a / u := -by simpa only [div_eq_mul_inv] using congr_arg ((*) a) u.coe_inv' - -@[simp] theorem divp_mk0 (a : G₀) {b : G₀} (hb : b ≠ 0) : - a /ₚ units.mk0 b hb = a / b := -divp_eq_div _ _ - -lemma inv_div : (a / b)⁻¹ = b / a := division_monoid.inv_div _ _ - -lemma inv_div_left : a⁻¹ / b = (b * a)⁻¹ := division_monoid.inv_div_left _ _ - -lemma div_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 := -by { rw div_eq_mul_inv, exact mul_ne_zero ha (inv_ne_zero hb) } - -@[simp] lemma div_eq_zero_iff : a / b = 0 ↔ a = 0 ∨ b = 0:= -by simp [div_eq_mul_inv] - -lemma div_ne_zero_iff : a / b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 := -(not_congr div_eq_zero_iff).trans not_or_distrib - -lemma div_left_inj' (hc : c ≠ 0) : a / c = b / c ↔ a = b := -by rw [← divp_mk0 _ hc, ← divp_mk0 _ hc, divp_left_inj] - -lemma div_eq_iff_mul_eq (hb : b ≠ 0) : a / b = c ↔ c * b = a := -⟨λ h, by rw [← h, div_mul_cancel _ hb], - λ h, by rw [← h, mul_div_cancel _ hb]⟩ - -lemma eq_div_iff_mul_eq (hc : c ≠ 0) : a = b / c ↔ a * c = b := -by rw [eq_comm, div_eq_iff_mul_eq hc] - -lemma div_eq_of_eq_mul {x : G₀} (hx : x ≠ 0) {y z : G₀} (h : y = z * x) : y / x = z := -(div_eq_iff_mul_eq hx).2 h.symm - -lemma eq_div_of_mul_eq {x : G₀} (hx : x ≠ 0) {y z : G₀} (h : z * x = y) : z = y / x := -eq.symm $ div_eq_of_eq_mul hx h.symm - -lemma eq_of_div_eq_one : a / b = 1 → a = b := division_monoid.eq_of_div_eq_one - -lemma div_eq_one_iff_eq (hb : b ≠ 0) : a / b = 1 ↔ a = b := -⟨eq_of_div_eq_one, λ h, h.symm ▸ div_self hb⟩ - -lemma div_mul_left {a b : G₀} (hb : b ≠ 0) : b / (a * b) = 1 / a := -by simp only [div_eq_mul_inv, mul_inv_rev, mul_inv_cancel_left₀ hb, one_mul] - -lemma mul_div_mul_right (a b : G₀) {c : G₀} (hc : c ≠ 0) : - (a * c) / (b * c) = a / b := -by simp only [div_eq_mul_inv, mul_inv_rev, mul_assoc, mul_inv_cancel_left₀ hc] - -lemma mul_mul_div (a : G₀) {b : G₀} (hb : b ≠ 0) : a = a * b * (1 / b) := -by simp [hb] - -lemma ring.inverse_eq_inv (a : G₀) : ring.inverse a = a⁻¹ := -begin - obtain rfl | ha := eq_or_ne a 0, - { simp }, - { exact ring.inverse_unit (units.mk0 a ha) } -end - -@[simp] lemma ring.inverse_eq_inv' : (ring.inverse : G₀ → G₀) = has_inv.inv := -funext ring.inverse_eq_inv - -@[field_simps] lemma div_div_eq_mul_div (a b c : G₀) : - a / (b / c) = (a * c) / b := -division_monoid.div_div_eq_mul_div _ _ _ - /-- Dividing `a` by the result of dividing `a` by itself results in `a` (whether or not `a` is zero). -/ @[simp] lemma div_div_self (a : G₀) : a / (a / a) = a := @@ -900,286 +324,47 @@ classical.by_cases (assume ha, ha) (assume ha, ((one_div_ne_zero ha) h).elim) -lemma div_div_div_cancel_right (a : G₀) (hc : c ≠ 0) : (a / c) / (b / c) = a / b := -by rw [div_div_eq_mul_div, div_mul_cancel _ hc] - -lemma div_mul_div_cancel (a : G₀) (hc : c ≠ 0) : (a / c) * (c / b) = a / b := -by rw [← mul_div_assoc, div_mul_cancel _ hc] +lemma mul_left_surjective₀ {a : G₀} (h : a ≠ 0) : surjective (λ g, a * g) := +λ g, ⟨a⁻¹ * g, by simp [← mul_assoc, mul_inv_cancel h]⟩ -@[field_simps] lemma eq_div_iff (hb : b ≠ 0) : c = a / b ↔ c * b = a := -eq_div_iff_mul_eq hb - -@[field_simps] lemma div_eq_iff (hb : b ≠ 0) : a / b = c ↔ a = c * b := -(div_eq_iff_mul_eq hb).trans eq_comm +lemma mul_right_surjective₀ {a : G₀} (h : a ≠ 0) : surjective (λ g, g * a) := +λ g, ⟨g * a⁻¹, by simp [mul_assoc, inv_mul_cancel h]⟩ end group_with_zero -section comm_group_with_zero -- comm -variables [comm_group_with_zero G₀] {a b c : G₀} - -@[priority 10] -- see Note [lower instance priority] -instance comm_group_with_zero.cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero G₀ := -{ ..group_with_zero.cancel_monoid_with_zero, ..comm_group_with_zero.to_comm_monoid_with_zero G₀ } - -@[priority 100] -- See note [lower instance priority] -instance comm_group_with_zero.to_division_comm_monoid : division_comm_monoid G₀ := -{ ..‹comm_group_with_zero G₀›, ..group_with_zero.to_division_monoid } - -/-- Pullback a `comm_group_with_zero` class along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.comm_group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀'] - [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] - (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) - (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) - (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : - comm_group_with_zero G₀' := -{ .. hf.group_with_zero f zero one mul inv div npow zpow, .. hf.comm_semigroup f mul } - -/-- Pushforward a `comm_group_with_zero` class along a surjective function. -/ -protected def function.surjective.comm_group_with_zero [has_zero G₀'] [has_mul G₀'] - [has_one G₀'] [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] - (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f) - (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) - (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) - (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : - comm_group_with_zero G₀' := -{ .. hf.group_with_zero h01 f zero one mul inv div npow zpow, .. hf.comm_semigroup f mul } - -lemma mul_inv₀ : (a * b)⁻¹ = a⁻¹ * b⁻¹ := division_comm_monoid.mul_inv _ _ - -lemma one_div_mul_one_div (a b : G₀) : (1 / a) * (1 / b) = 1 / (a * b) := -division_comm_monoid.one_div_mul_one_div _ _ - -lemma div_mul_right {a : G₀} (b : G₀) (ha : a ≠ 0) : a / (a * b) = 1 / b := -by rw [mul_comm, div_mul_left ha] - -lemma mul_div_cancel_left_of_imp {a b : G₀} (h : a = 0 → b = 0) : a * b / a = b := -by rw [mul_comm, mul_div_cancel_of_imp h] - -lemma mul_div_cancel_left {a : G₀} (b : G₀) (ha : a ≠ 0) : a * b / a = b := -mul_div_cancel_left_of_imp $ λ h, (ha h).elim - -lemma mul_div_cancel_of_imp' {a b : G₀} (h : b = 0 → a = 0) : b * (a / b) = a := -by rw [mul_comm, div_mul_cancel_of_imp h] - -lemma mul_div_cancel' (a : G₀) {b : G₀} (hb : b ≠ 0) : b * (a / b) = a := -by rw [mul_comm, (div_mul_cancel _ hb)] - -local attribute [simp] mul_assoc mul_comm mul_left_comm - -lemma div_mul_div_comm₀ (a b c d : G₀) : - (a / b) * (c / d) = (a * c) / (b * d) := -division_comm_monoid.div_mul_div_comm _ _ _ _ - -lemma div_div_div_comm₀ (a b c d : G₀) : (a / b) / (c / d) = (a / c) / (b / d) := -division_comm_monoid.div_div_div_comm _ _ _ _ - -lemma mul_div_mul_left (a b : G₀) {c : G₀} (hc : c ≠ 0) : - (c * a) / (c * b) = a / b := -by rw [mul_comm c, mul_comm c, mul_div_mul_right _ _ hc] - -@[field_simps] lemma div_mul_eq_mul_div (a b c : G₀) : (b / c) * a = (b * a) / c := -division_comm_monoid.div_mul_eq_mul_div _ _ _ - -lemma div_mul_eq_mul_div_comm (a b c : G₀) : - (b / c) * a = b * (a / c) := -division_comm_monoid.mul_comm_div _ _ _ - -lemma mul_eq_mul_of_div_eq_div (a : G₀) {b : G₀} (c : G₀) {d : G₀} (hb : b ≠ 0) - (hd : d ≠ 0) (h : a / b = c / d) : a * d = c * b := -by rw [← mul_one (a*d), mul_assoc, mul_comm d, ← mul_assoc, ← div_self hb, - ← div_mul_eq_mul_div_comm, h, div_mul_eq_mul_div, div_mul_cancel _ hd] - -@[field_simps] lemma div_div_eq_div_mul (a b c : G₀) : - (a / b) / c = a / (b * c) := -division_comm_monoid.div_div _ _ _ - -lemma div_div_div_div_eq (a : G₀) {b c d : G₀} : - (a / b) / (c / d) = (a * d) / (b * c) := -division_comm_monoid.div_div_div_eq _ _ _ _ - -lemma div_mul_eq_div_mul_one_div (a b c : G₀) : - a / (b * c) = (a / b) * (1 / c) := -division_comm_monoid.div_mul_eq_div_mul_one_div _ _ _ - -lemma div_helper {a : G₀} (b : G₀) (h : a ≠ 0) : (1 / (a * b)) * a = 1 / b := -by rw [div_mul_eq_mul_div, one_mul, div_mul_right _ h] - -end comm_group_with_zero - section comm_group_with_zero variables [comm_group_with_zero G₀] {a b c d : G₀} -lemma div_eq_inv_mul : a / b = b⁻¹ * a := division_comm_monoid.div_eq_inv_mul _ _ - -lemma mul_div_right_comm (a b c : G₀) : (a * b) / c = (a / c) * b := -division_comm_monoid.mul_div_right_comm _ _ _ - -lemma mul_comm_div' (a b c : G₀) : a / b * c = a * (c / b) := -division_comm_monoid.mul_comm_div _ _ _ - -lemma div_mul_comm' (a b c : G₀) : (a / b) * c = (c / b) * a := -division_comm_monoid.div_mul_comm _ _ _ - -lemma mul_div_comm (a b c : G₀) : a * (b / c) = b * (a / c) := -division_comm_monoid.mul_div_left_comm _ _ _ - -lemma div_right_comm (a : G₀) : (a / b) / c = (a / c) / b := -division_comm_monoid.div_right_comm _ _ _ - -@[field_simps] lemma div_eq_div_iff (hb : b ≠ 0) (hd : d ≠ 0) : a / b = c / d ↔ a * d = c * b := -calc a / b = c / d ↔ a / b * (b * d) = c / d * (b * d) : -by rw [mul_left_inj' (mul_ne_zero hb hd)] - ... ↔ a * d = c * b : -by rw [← mul_assoc, div_mul_cancel _ hb, - ← mul_assoc, mul_right_comm, div_mul_cancel _ hd] - -lemma div_div_cancel' (ha : a ≠ 0) : a / (a / b) = b := -by rw [div_eq_mul_inv, inv_div, mul_div_cancel' _ ha] +lemma div_mul_eq_mul_div₀ (a b c : G₀) : (a / c) * b = a * b / c := +by simp_rw [div_eq_mul_inv, mul_assoc, mul_comm c⁻¹] end comm_group_with_zero -namespace semiconj_by - -@[simp] lemma zero_right [mul_zero_class G₀] (a : G₀) : semiconj_by a 0 0 := -by simp only [semiconj_by, mul_zero, zero_mul] - -@[simp] lemma zero_left [mul_zero_class G₀] (x y : G₀) : semiconj_by 0 x y := -by simp only [semiconj_by, mul_zero, zero_mul] - -variables [group_with_zero G₀] {a x y x' y' : G₀} - -@[simp] lemma inv_symm_left_iff₀ : semiconj_by a⁻¹ x y ↔ semiconj_by a y x := -classical.by_cases - (λ ha : a = 0, by simp only [ha, inv_zero, semiconj_by.zero_left]) - (λ ha, @units_inv_symm_left_iff _ _ (units.mk0 a ha) _ _) - -lemma inv_symm_left₀ (h : semiconj_by a x y) : semiconj_by a⁻¹ y x := -semiconj_by.inv_symm_left_iff₀.2 h - -lemma inv_right₀ (h : semiconj_by a x y) : semiconj_by a x⁻¹ y⁻¹ := -begin - by_cases ha : a = 0, - { simp only [ha, zero_left] }, - by_cases hx : x = 0, - { subst x, - simp only [semiconj_by, mul_zero, @eq_comm _ _ (y * a), mul_eq_zero] at h, - simp [h.resolve_right ha] }, - { have := mul_ne_zero ha hx, - rw [h.eq, mul_ne_zero_iff] at this, - exact @units_inv_right _ _ _ (units.mk0 x hx) (units.mk0 y this.1) h }, -end - -@[simp] lemma inv_right_iff₀ : semiconj_by a x⁻¹ y⁻¹ ↔ semiconj_by a x y := -⟨λ h, inv_inv x ▸ inv_inv y ▸ h.inv_right₀, inv_right₀⟩ - -lemma div_right (h : semiconj_by a x y) (h' : semiconj_by a x' y') : - semiconj_by a (x / x') (y / y') := -by { rw [div_eq_mul_inv, div_eq_mul_inv], exact h.mul_right h'.inv_right₀ } - -end semiconj_by - -namespace commute - -@[simp] theorem zero_right [mul_zero_class G₀] (a : G₀) :commute a 0 := semiconj_by.zero_right a -@[simp] theorem zero_left [mul_zero_class G₀] (a : G₀) : commute 0 a := semiconj_by.zero_left a a - -variables [group_with_zero G₀] {a b c : G₀} - -@[simp] theorem inv_left_iff₀ : commute a⁻¹ b ↔ commute a b := -semiconj_by.inv_symm_left_iff₀ - -theorem inv_left₀ (h : commute a b) : commute a⁻¹ b := inv_left_iff₀.2 h - -@[simp] theorem inv_right_iff₀ : commute a b⁻¹ ↔ commute a b := -semiconj_by.inv_right_iff₀ - -theorem inv_right₀ (h : commute a b) : commute a b⁻¹ := inv_right_iff₀.2 h - -theorem inv_inv₀ (h : commute a b) : commute a⁻¹ b⁻¹ := h.inv_left₀.inv_right₀ - -@[simp] theorem div_right (hab : commute a b) (hac : commute a c) : - commute a (b / c) := -hab.div_right hac - -@[simp] theorem div_left (hac : commute a c) (hbc : commute b c) : - commute (a / b) c := -by { rw div_eq_mul_inv, exact hac.mul_left hbc.inv_left₀ } - -end commute - -namespace monoid_with_zero_hom - -variables [group_with_zero G₀] [group_with_zero G₀'] [monoid_with_zero M₀] [nontrivial M₀] - -section monoid_with_zero - -variables (f : G₀ →*₀ M₀) {a : G₀} - -lemma map_ne_zero : f a ≠ 0 ↔ a ≠ 0 := -⟨λ hfa ha, hfa $ ha.symm ▸ f.map_zero, λ ha, ((is_unit.mk0 a ha).map f.to_monoid_hom).ne_zero⟩ - -@[simp] lemma map_eq_zero : f a = 0 ↔ a = 0 := -not_iff_not.1 f.map_ne_zero - -end monoid_with_zero - -section group_with_zero - -variables (f : G₀ →*₀ G₀') (a b : G₀) - -/-- A monoid homomorphism between groups with zeros sending `0` to `0` sends `a⁻¹` to `(f a)⁻¹`. -/ -@[simp] lemma map_inv : f a⁻¹ = (f a)⁻¹ := -begin - by_cases h : a = 0, by simp [h], - apply eq_inv_of_mul_left_eq_one, - rw [← f.map_mul, inv_mul_cancel h, f.map_one] -end - -@[simp] lemma map_div : f (a / b) = f a / f b := -by simpa only [div_eq_mul_inv] using ((f.map_mul _ _).trans $ _root_.congr_arg _ $ f.map_inv b) - -end group_with_zero -end monoid_with_zero_hom - -/-- Inversion on a commutative group with zero, considered as a monoid with zero homomorphism. -/ -def inv_monoid_with_zero_hom {G₀ : Type*} [comm_group_with_zero G₀] : G₀ →*₀ G₀ := -{ to_fun := has_inv.inv, - map_zero' := inv_zero, - map_one' := inv_one, - map_mul' := λ _ _, mul_inv₀ } - -@[simp] lemma monoid_hom.map_units_inv {M G₀ : Type*} [monoid M] [group_with_zero G₀] - (f : M →* G₀) (u : Mˣ) : f ↑u⁻¹ = (f u)⁻¹ := -by rw [← units.coe_map, ← units.coe_map, ← units.coe_inv', monoid_hom.map_inv] - -@[simp] lemma monoid_with_zero_hom.map_units_inv {M G₀ : Type*} [monoid_with_zero M] - [group_with_zero G₀] (f : M →*₀ G₀) (u : Mˣ) : f ↑u⁻¹ = (f u)⁻¹ := -f.to_monoid_hom.map_units_inv u - -section noncomputable_defs - -variables {M : Type*} [nontrivial M] - -/-- Constructs a `group_with_zero` structure on a `monoid_with_zero` - consisting only of units and 0. -/ -noncomputable def group_with_zero_of_is_unit_or_eq_zero [hM : monoid_with_zero M] - (h : ∀ (a : M), is_unit a ∨ a = 0) : group_with_zero M := -{ inv := λ a, if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹, - inv_zero := dif_pos rfl, - mul_inv_cancel := λ a h0, by - { change a * (if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹) = 1, - rw [dif_neg h0, units.mul_inv_eq_iff_eq_mul, one_mul, is_unit.unit_spec] }, - exists_pair_ne := nontrivial.exists_pair_ne, -.. hM } - -/-- Constructs a `comm_group_with_zero` structure on a `comm_monoid_with_zero` - consisting only of units and 0. -/ -noncomputable def comm_group_with_zero_of_is_unit_or_eq_zero [hM : comm_monoid_with_zero M] - (h : ∀ (a : M), is_unit a ∨ a = 0) : comm_group_with_zero M := -{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hM } - -end noncomputable_defs +/-! ### Order dual -/ + +open order_dual + +instance [h : mul_zero_class α] : mul_zero_class αᵒᵈ := h +instance [h : mul_zero_one_class α] : mul_zero_one_class αᵒᵈ := h +instance [has_mul α] [has_zero α] [h : no_zero_divisors α] : no_zero_divisors αᵒᵈ := h +instance [h : semigroup_with_zero α] : semigroup_with_zero αᵒᵈ := h +instance [h : monoid_with_zero α] : monoid_with_zero αᵒᵈ := h +instance [h : cancel_monoid_with_zero α] : cancel_monoid_with_zero αᵒᵈ := h +instance [h : comm_monoid_with_zero α] : comm_monoid_with_zero αᵒᵈ := h +instance [h : cancel_comm_monoid_with_zero α] : cancel_comm_monoid_with_zero αᵒᵈ := h +instance [h : group_with_zero α] : group_with_zero αᵒᵈ := h +instance [h : comm_group_with_zero α] : comm_group_with_zero αᵒᵈ := h + +/-! ### Lexicographic order -/ + +instance [h : mul_zero_class α] : mul_zero_class (lex α) := h +instance [h : mul_zero_one_class α] : mul_zero_one_class (lex α) := h +instance [has_mul α] [has_zero α] [h : no_zero_divisors α] : no_zero_divisors (lex α) := h +instance [h : semigroup_with_zero α] : semigroup_with_zero (lex α) := h +instance [h : monoid_with_zero α] : monoid_with_zero (lex α) := h +instance [h : cancel_monoid_with_zero α] : cancel_monoid_with_zero (lex α) := h +instance [h : comm_monoid_with_zero α] : comm_monoid_with_zero (lex α) := h +instance [h : cancel_comm_monoid_with_zero α] : cancel_comm_monoid_with_zero (lex α) := h +instance [h : group_with_zero α] : group_with_zero (lex α) := h +instance [h : comm_group_with_zero α] : comm_group_with_zero (lex α) := h diff --git a/src/algebra/group_with_zero/commute.lean b/src/algebra/group_with_zero/commute.lean new file mode 100644 index 0000000000000..d6fe3e0815dc6 --- /dev/null +++ b/src/algebra/group_with_zero/commute.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2020 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin +-/ +import algebra.group_with_zero.semiconj +import algebra.group.commute +import tactic.nontriviality + +/-! +# Lemmas about commuting elements in a `monoid_with_zero` or a `group_with_zero`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +variables {α M₀ G₀ M₀' G₀' F F' : Type*} + +variables [monoid_with_zero M₀] + +namespace ring +open_locale classical + +lemma mul_inverse_rev' {a b : M₀} (h : commute a b) : inverse (a * b) = inverse b * inverse a := +begin + by_cases hab : is_unit (a * b), + { obtain ⟨⟨a, rfl⟩, b, rfl⟩ := h.is_unit_mul_iff.mp hab, + rw [←units.coe_mul, inverse_unit, inverse_unit, inverse_unit, ←units.coe_mul, + mul_inv_rev], }, + obtain ha | hb := not_and_distrib.mp (mt h.is_unit_mul_iff.mpr hab), + { rw [inverse_non_unit _ hab, inverse_non_unit _ ha, mul_zero]}, + { rw [inverse_non_unit _ hab, inverse_non_unit _ hb, zero_mul]}, +end + +lemma mul_inverse_rev {M₀} [comm_monoid_with_zero M₀] (a b : M₀) : + ring.inverse (a * b) = inverse b * inverse a := +mul_inverse_rev' (commute.all _ _) + +end ring + +lemma commute.ring_inverse_ring_inverse {a b : M₀} (h : commute a b) : + commute (ring.inverse a) (ring.inverse b) := +(ring.mul_inverse_rev' h.symm).symm.trans $ (congr_arg _ h.symm.eq).trans $ ring.mul_inverse_rev' h + +namespace commute + +@[simp] theorem zero_right [mul_zero_class G₀] (a : G₀) : commute a 0 := semiconj_by.zero_right a +@[simp] theorem zero_left [mul_zero_class G₀] (a : G₀) : commute 0 a := semiconj_by.zero_left a a + +variables [group_with_zero G₀] {a b c : G₀} + +@[simp] theorem inv_left_iff₀ : commute a⁻¹ b ↔ commute a b := +semiconj_by.inv_symm_left_iff₀ + +theorem inv_left₀ (h : commute a b) : commute a⁻¹ b := inv_left_iff₀.2 h + +@[simp] theorem inv_right_iff₀ : commute a b⁻¹ ↔ commute a b := +semiconj_by.inv_right_iff₀ + +theorem inv_right₀ (h : commute a b) : commute a b⁻¹ := inv_right_iff₀.2 h + +@[simp] theorem div_right (hab : commute a b) (hac : commute a c) : + commute a (b / c) := +hab.div_right hac + +@[simp] theorem div_left (hac : commute a c) (hbc : commute b c) : + commute (a / b) c := +by { rw div_eq_mul_inv, exact hac.mul_left hbc.inv_left₀ } + +end commute diff --git a/src/algebra/group_with_zero/default.lean b/src/algebra/group_with_zero/default.lean deleted file mode 100644 index 03893e3bbd7b6..0000000000000 --- a/src/algebra/group_with_zero/default.lean +++ /dev/null @@ -1 +0,0 @@ -import algebra.group_with_zero.basic diff --git a/src/algebra/group_with_zero/defs.lean b/src/algebra/group_with_zero/defs.lean index a3dca7dee20dd..9cb5b86bc8969 100644 --- a/src/algebra/group_with_zero/defs.lean +++ b/src/algebra/group_with_zero/defs.lean @@ -5,10 +5,14 @@ Authors: Johan Commelin -/ import algebra.group.defs import logic.nontrivial +import algebra.ne_zero /-! # Typeclasses for groups with an adjoined zero element +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides just the typeclass definitions, and the projection lemmas that expose their members. @@ -26,8 +30,6 @@ universe u -- `group_with_zero.div'` cannot contain a universe metavariable. variables {G₀ : Type u} {M₀ M₀' G₀' : Type*} -section - /-- Typeclass for expressing that a type `M₀` with multiplication and a zero satisfies `0 * a = 0` and `a * 0 = 0` for all `a : M₀`. -/ @[protect_proj, ancestor has_mul has_zero] @@ -47,6 +49,64 @@ mul_zero_class.mul_zero a end mul_zero_class +/-- A mixin for left cancellative multiplication by nonzero elements. -/ +@[protect_proj] class is_left_cancel_mul_zero (M₀ : Type u) [has_mul M₀] [has_zero M₀] : Prop := +(mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c) + +section is_left_cancel_mul_zero + +variables [has_mul M₀] [has_zero M₀] [is_left_cancel_mul_zero M₀] {a b c : M₀} + +lemma mul_left_cancel₀ (ha : a ≠ 0) (h : a * b = a * c) : b = c := +is_left_cancel_mul_zero.mul_left_cancel_of_ne_zero ha h + +lemma mul_right_injective₀ (ha : a ≠ 0) : function.injective ((*) a) := +λ b c, mul_left_cancel₀ ha + +end is_left_cancel_mul_zero + +/-- A mixin for right cancellative multiplication by nonzero elements. -/ +@[protect_proj] class is_right_cancel_mul_zero (M₀ : Type u) [has_mul M₀] [has_zero M₀] : Prop := +(mul_right_cancel_of_ne_zero : ∀ {a b c : M₀}, b ≠ 0 → a * b = c * b → a = c) + +section is_right_cancel_mul_zero + +variables [has_mul M₀] [has_zero M₀] [is_right_cancel_mul_zero M₀] {a b c : M₀} + +lemma mul_right_cancel₀ (hb : b ≠ 0) (h : a * b = c * b) : a = c := +is_right_cancel_mul_zero.mul_right_cancel_of_ne_zero hb h + +lemma mul_left_injective₀ (hb : b ≠ 0) : function.injective (λ a, a * b) := +λ a c, mul_right_cancel₀ hb + +end is_right_cancel_mul_zero + +/-- A mixin for cancellative multiplication by nonzero elements. -/ +@[protect_proj] class is_cancel_mul_zero (M₀ : Type u) [has_mul M₀] [has_zero M₀] + extends is_left_cancel_mul_zero M₀, is_right_cancel_mul_zero M₀ : Prop + +section comm_semigroup_with_zero + +variables [comm_semigroup M₀] [has_zero M₀] + +lemma is_left_cancel_mul_zero.to_is_right_cancel_mul_zero [is_left_cancel_mul_zero M₀] : + is_right_cancel_mul_zero M₀ := +⟨λ a b c ha h, mul_left_cancel₀ ha $ (mul_comm _ _).trans $ (h.trans (mul_comm _ _))⟩ + +lemma is_right_cancel_mul_zero.to_is_left_cancel_mul_zero [is_right_cancel_mul_zero M₀] : + is_left_cancel_mul_zero M₀ := +⟨λ a b c ha h, mul_right_cancel₀ ha $ (mul_comm _ _).trans $ (h.trans (mul_comm _ _))⟩ + +lemma is_left_cancel_mul_zero.to_is_cancel_mul_zero [is_left_cancel_mul_zero M₀] : + is_cancel_mul_zero M₀ := +{ .. ‹is_left_cancel_mul_zero M₀›, .. is_left_cancel_mul_zero.to_is_right_cancel_mul_zero } + +lemma is_right_cancel_mul_zero.to_is_cancel_mul_zero [is_right_cancel_mul_zero M₀] : + is_cancel_mul_zero M₀ := +{ .. ‹is_right_cancel_mul_zero M₀›, .. is_right_cancel_mul_zero.to_is_left_cancel_mul_zero } + +end comm_semigroup_with_zero + /-- Predicate typeclass for expressing that `a * b = 0` implies `a = 0` or `b = 0` for all `a` and `b` of type `G₀`. -/ class no_zero_divisors (M₀ : Type*) [has_mul M₀] [has_zero M₀] : Prop := @@ -56,16 +116,19 @@ export no_zero_divisors (eq_zero_or_eq_zero_of_mul_eq_zero) /-- A type `S₀` is a "semigroup with zero” if it is a semigroup with zero element, and `0` is left and right absorbing. -/ -@[protect_proj] class semigroup_with_zero (S₀ : Type*) extends semigroup S₀, mul_zero_class S₀. +@[protect_proj, ancestor semigroup mul_zero_class] +class semigroup_with_zero (S₀ : Type*) extends semigroup S₀, mul_zero_class S₀. /- By defining this _after_ `semigroup_with_zero`, we ensure that searches for `mul_zero_class` find this class first. -/ /-- A typeclass for non-associative monoids with zero elements. -/ -@[protect_proj] class mul_zero_one_class (M₀ : Type*) extends mul_one_class M₀, mul_zero_class M₀. +@[protect_proj, ancestor mul_one_class mul_zero_class] +class mul_zero_one_class (M₀ : Type*) extends mul_one_class M₀, mul_zero_class M₀. /-- A type `M₀` is a “monoid with zero” if it is a monoid with zero element, and `0` is left and right absorbing. -/ -@[protect_proj] class monoid_with_zero (M₀ : Type*) extends monoid M₀, mul_zero_one_class M₀. +@[protect_proj, ancestor monoid mul_zero_one_class] +class monoid_with_zero (M₀ : Type*) extends monoid M₀, mul_zero_one_class M₀. @[priority 100] -- see Note [lower instance priority] instance monoid_with_zero.to_semigroup_with_zero (M₀ : Type*) [monoid_with_zero M₀] : @@ -74,38 +137,33 @@ instance monoid_with_zero.to_semigroup_with_zero (M₀ : Type*) [monoid_with_zer /-- A type `M` is a `cancel_monoid_with_zero` if it is a monoid with zero element, `0` is left and right absorbing, and left/right multiplication by a non-zero element is injective. -/ -@[protect_proj] class cancel_monoid_with_zero (M₀ : Type*) extends monoid_with_zero M₀ := +@[protect_proj, ancestor monoid_with_zero] +class cancel_monoid_with_zero (M₀ : Type*) extends monoid_with_zero M₀ := (mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c) (mul_right_cancel_of_ne_zero : ∀ {a b c : M₀}, b ≠ 0 → a * b = c * b → a = c) -section cancel_monoid_with_zero - -variables [cancel_monoid_with_zero M₀] {a b c : M₀} - -lemma mul_left_cancel₀ (ha : a ≠ 0) (h : a * b = a * c) : b = c := -cancel_monoid_with_zero.mul_left_cancel_of_ne_zero ha h - -lemma mul_right_cancel₀ (hb : b ≠ 0) (h : a * b = c * b) : a = c := -cancel_monoid_with_zero.mul_right_cancel_of_ne_zero hb h - -lemma mul_right_injective₀ (ha : a ≠ 0) : function.injective ((*) a) := -λ b c, mul_left_cancel₀ ha - -lemma mul_left_injective₀ (hb : b ≠ 0) : function.injective (λ a, a * b) := -λ a c, mul_right_cancel₀ hb - -end cancel_monoid_with_zero +/-- A `cancel_monoid_with_zero` satisfies `is_cancel_mul_zero`. -/ +@[priority 100] +instance cancel_monoid_with_zero.to_is_cancel_mul_zero [cancel_monoid_with_zero M₀] : + is_cancel_mul_zero M₀ := +{ .. ‹cancel_monoid_with_zero M₀› } /-- A type `M` is a commutative “monoid with zero” if it is a commutative monoid with zero element, and `0` is left and right absorbing. -/ -@[protect_proj] +@[protect_proj, ancestor comm_monoid monoid_with_zero] class comm_monoid_with_zero (M₀ : Type*) extends comm_monoid M₀, monoid_with_zero M₀. /-- A type `M` is a `cancel_comm_monoid_with_zero` if it is a commutative monoid with zero element, `0` is left and right absorbing, and left/right multiplication by a non-zero element is injective. -/ -@[protect_proj] class cancel_comm_monoid_with_zero (M₀ : Type*) extends - comm_monoid_with_zero M₀, cancel_monoid_with_zero M₀. +@[protect_proj, ancestor comm_monoid_with_zero cancel_monoid_with_zero] +class cancel_comm_monoid_with_zero (M₀ : Type*) extends comm_monoid_with_zero M₀ := +(mul_left_cancel_of_ne_zero : ∀ {a b c : M₀}, a ≠ 0 → a * b = a * c → b = c) + +@[priority 100] +instance cancel_comm_monoid_with_zero.to_cancel_monoid_with_zero + [h : cancel_comm_monoid_with_zero M₀] : cancel_monoid_with_zero M₀ := +{ .. h, .. @is_left_cancel_mul_zero.to_is_right_cancel_mul_zero M₀ _ _ { .. h } } /-- A type `G₀` is a “group with zero” if it is a monoid with zero element (distinct from `1`) such that every nonzero element is invertible. @@ -113,12 +171,14 @@ The type is required to come with an “inverse” function, and the inverse of Examples include division rings and the ordered monoids that are the target of valuations in general valuation theory.-/ +@[protect_proj, ancestor monoid_with_zero div_inv_monoid nontrivial] class group_with_zero (G₀ : Type u) extends monoid_with_zero G₀, div_inv_monoid G₀, nontrivial G₀ := (inv_zero : (0 : G₀)⁻¹ = 0) (mul_inv_cancel : ∀ a:G₀, a ≠ 0 → a * a⁻¹ = 1) section group_with_zero + variables [group_with_zero G₀] @[simp] lemma inv_zero : (0 : G₀)⁻¹ = 0 := @@ -133,6 +193,77 @@ end group_with_zero if it is a commutative monoid with zero element (distinct from `1`) such that every nonzero element is invertible. The type is required to come with an “inverse” function, and the inverse of `0` must be `0`. -/ +@[protect_proj, ancestor comm_monoid_with_zero group_with_zero] class comm_group_with_zero (G₀ : Type*) extends comm_monoid_with_zero G₀, group_with_zero G₀. -end +section ne_zero + +attribute [field_simps] two_ne_zero three_ne_zero four_ne_zero + +variables [mul_zero_one_class M₀] [nontrivial M₀] {a b : M₀} + +variable (M₀) + +/-- In a nontrivial monoid with zero, zero and one are different. -/ +instance ne_zero.one : ne_zero (1 : M₀) := +⟨begin + assume h, + rcases exists_pair_ne M₀ with ⟨x, y, hx⟩, + apply hx, + calc x = 1 * x : by rw [one_mul] + ... = 0 : by rw [h, zero_mul] + ... = 1 * y : by rw [h, zero_mul] + ... = y : by rw [one_mul] +end⟩ + +variable {M₀} + +/-- Pullback a `nontrivial` instance along a function sending `0` to `0` and `1` to `1`. -/ +lemma pullback_nonzero [has_zero M₀'] [has_one M₀'] + (f : M₀' → M₀) (zero : f 0 = 0) (one : f 1 = 1) : nontrivial M₀' := +⟨⟨0, 1, mt (congr_arg f) $ by { rw [zero, one], exact zero_ne_one }⟩⟩ + +end ne_zero + +section mul_zero_class + +variables [mul_zero_class M₀] + +lemma mul_eq_zero_of_left {a : M₀} (h : a = 0) (b : M₀) : a * b = 0 := h.symm ▸ zero_mul b + +lemma mul_eq_zero_of_right (a : M₀) {b : M₀} (h : b = 0) : a * b = 0 := h.symm ▸ mul_zero a + +variables [no_zero_divisors M₀] {a b : M₀} + +/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them +equals zero. -/ +@[simp] theorem mul_eq_zero : a * b = 0 ↔ a = 0 ∨ b = 0 := +⟨eq_zero_or_eq_zero_of_mul_eq_zero, + λo, o.elim (λ h, mul_eq_zero_of_left h b) (mul_eq_zero_of_right a)⟩ + +/-- If `α` has no zero divisors, then the product of two elements equals zero iff one of them +equals zero. -/ +@[simp] theorem zero_eq_mul : 0 = a * b ↔ a = 0 ∨ b = 0 := +by rw [eq_comm, mul_eq_zero] + +/-- If `α` has no zero divisors, then the product of two elements is nonzero iff both of them +are nonzero. -/ +theorem mul_ne_zero_iff : a * b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 := +mul_eq_zero.not.trans not_or_distrib + +/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` equals zero iff so is +`b * a`. -/ +theorem mul_eq_zero_comm : a * b = 0 ↔ b * a = 0 := +mul_eq_zero.trans $ (or_comm _ _).trans mul_eq_zero.symm + +/-- If `α` has no zero divisors, then for elements `a, b : α`, `a * b` is nonzero iff so is +`b * a`. -/ +theorem mul_ne_zero_comm : a * b ≠ 0 ↔ b * a ≠ 0 := +mul_eq_zero_comm.not + +lemma mul_self_eq_zero : a * a = 0 ↔ a = 0 := by simp +lemma zero_eq_mul_self : 0 = a * a ↔ a = 0 := by simp +lemma mul_self_ne_zero : a * a ≠ 0 ↔ a ≠ 0 := mul_self_eq_zero.not +lemma zero_ne_mul_self : 0 ≠ a * a ↔ a ≠ 0 := zero_eq_mul_self.not + +end mul_zero_class diff --git a/src/algebra/group_with_zero/divisibility.lean b/src/algebra/group_with_zero/divisibility.lean new file mode 100644 index 0000000000000..47ad0aff0b759 --- /dev/null +++ b/src/algebra/group_with_zero/divisibility.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov, +Neil Strickland, Aaron Anderson +-/ +import algebra.group_with_zero.basic +import algebra.divisibility.units + +/-! +# Divisibility in groups with zero. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Lemmas about divisibility in groups and monoids with zero. + +-/ + +variables {α : Type*} + + +section semigroup_with_zero + +variables [semigroup_with_zero α] {a : α} + +theorem eq_zero_of_zero_dvd (h : 0 ∣ a) : a = 0 := +dvd.elim h (λ c H', H'.trans (zero_mul c)) + +/-- Given an element `a` of a commutative semigroup with zero, there exists another element whose + product with zero equals `a` iff `a` equals zero. -/ +@[simp] lemma zero_dvd_iff : 0 ∣ a ↔ a = 0 := +⟨eq_zero_of_zero_dvd, λ h, by { rw h, use 0, simp }⟩ + +@[simp] theorem dvd_zero (a : α) : a ∣ 0 := dvd.intro 0 (by simp) + +end semigroup_with_zero + +/-- Given two elements `b`, `c` of a `cancel_monoid_with_zero` and a nonzero element `a`, + `a*b` divides `a*c` iff `b` divides `c`. -/ +theorem mul_dvd_mul_iff_left [cancel_monoid_with_zero α] {a b c : α} + (ha : a ≠ 0) : a * b ∣ a * c ↔ b ∣ c := +exists_congr $ λ d, by rw [mul_assoc, mul_right_inj' ha] + +/-- Given two elements `a`, `b` of a commutative `cancel_monoid_with_zero` and a nonzero + element `c`, `a*c` divides `b*c` iff `a` divides `b`. -/ +theorem mul_dvd_mul_iff_right [cancel_comm_monoid_with_zero α] {a b c : α} (hc : c ≠ 0) : + a * c ∣ b * c ↔ a ∣ b := +exists_congr $ λ d, by rw [mul_right_comm, mul_left_inj' hc] + +section comm_monoid_with_zero + +variable [comm_monoid_with_zero α] + +/-- `dvd_not_unit a b` expresses that `a` divides `b` "strictly", i.e. that `b` divided by `a` +is not a unit. -/ +def dvd_not_unit (a b : α) : Prop := a ≠ 0 ∧ ∃ x, ¬is_unit x ∧ b = a * x + +lemma dvd_not_unit_of_dvd_of_not_dvd {a b : α} (hd : a ∣ b) (hnd : ¬ b ∣ a) : + dvd_not_unit a b := +begin + split, + { rintro rfl, exact hnd (dvd_zero _) }, + { rcases hd with ⟨c, rfl⟩, + refine ⟨c, _, rfl⟩, + rintro ⟨u, rfl⟩, + simpa using hnd } +end + +end comm_monoid_with_zero + +lemma dvd_and_not_dvd_iff [cancel_comm_monoid_with_zero α] {x y : α} : + x ∣ y ∧ ¬y ∣ x ↔ dvd_not_unit x y := +⟨λ ⟨⟨d, hd⟩, hyx⟩, ⟨λ hx0, by simpa [hx0] using hyx, ⟨d, + mt is_unit_iff_dvd_one.1 (λ ⟨e, he⟩, hyx ⟨e, by rw [hd, mul_assoc, ← he, mul_one]⟩), hd⟩⟩, + λ ⟨hx0, d, hdu, hdx⟩, ⟨⟨d, hdx⟩, λ ⟨e, he⟩, hdu (is_unit_of_dvd_one _ + ⟨e, mul_left_cancel₀ hx0 $ by conv {to_lhs, rw [he, hdx]};simp [mul_assoc]⟩)⟩⟩ + +section monoid_with_zero + +variable [monoid_with_zero α] + +theorem ne_zero_of_dvd_ne_zero {p q : α} (h₁ : q ≠ 0) + (h₂ : p ∣ q) : p ≠ 0 := +begin + rcases h₂ with ⟨u, rfl⟩, + exact left_ne_zero_of_mul h₁, +end + +end monoid_with_zero + +section cancel_comm_monoid_with_zero +variables [cancel_comm_monoid_with_zero α] [subsingleton αˣ] {a b : α} + +lemma dvd_antisymm : a ∣ b → b ∣ a → a = b := +begin + rintro ⟨c, rfl⟩ ⟨d, hcd⟩, + rw [mul_assoc, eq_comm, mul_right_eq_self₀, mul_eq_one] at hcd, + obtain ⟨rfl, -⟩ | rfl := hcd; simp, +end + +attribute [protected] nat.dvd_antisymm --This lemma is in core, so we protect it here + +lemma dvd_antisymm' : a ∣ b → b ∣ a → b = a := flip dvd_antisymm + +alias dvd_antisymm ← has_dvd.dvd.antisymm +alias dvd_antisymm' ← has_dvd.dvd.antisymm' + +lemma eq_of_forall_dvd (h : ∀ c, a ∣ c ↔ b ∣ c) : a = b := +((h _).2 dvd_rfl).antisymm $ (h _).1 dvd_rfl + +lemma eq_of_forall_dvd' (h : ∀ c, c ∣ a ↔ c ∣ b) : a = b := +((h _).1 dvd_rfl).antisymm $ (h _).2 dvd_rfl + +end cancel_comm_monoid_with_zero diff --git a/src/algebra/group_with_zero/inj_surj.lean b/src/algebra/group_with_zero/inj_surj.lean new file mode 100644 index 0000000000000..97b02c66d45d7 --- /dev/null +++ b/src/algebra/group_with_zero/inj_surj.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2020 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin +-/ +import algebra.group.inj_surj +import algebra.group_with_zero.defs + +/-! +# Lifting groups with zero along injective/surjective maps + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open function + +variables {M₀ G₀ M₀' G₀' : Type*} + +section mul_zero_class + +variables [mul_zero_class M₀] {a b : M₀} + +/-- Pullback a `mul_zero_class` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀' → M₀) + (hf : injective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) : + mul_zero_class M₀' := +{ mul := (*), + zero := 0, + zero_mul := λ a, hf $ by simp only [mul, zero, zero_mul], + mul_zero := λ a, hf $ by simp only [mul, zero, mul_zero] } + +/-- Pushforward a `mul_zero_class` instance along an surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.mul_zero_class [has_mul M₀'] [has_zero M₀'] (f : M₀ → M₀') + (hf : surjective f) (zero : f 0 = 0) (mul : ∀ a b, f (a * b) = f a * f b) : + mul_zero_class M₀' := +{ mul := (*), + zero := 0, + mul_zero := hf.forall.2 $ λ x, by simp only [← zero, ← mul, mul_zero], + zero_mul := hf.forall.2 $ λ x, by simp only [← zero, ← mul, zero_mul] } + +end mul_zero_class + +section no_zero_divisors + +/-- Pushforward a `no_zero_divisors` instance along an injective function. -/ +protected lemma function.injective.no_zero_divisors [has_mul M₀] [has_zero M₀] + [has_mul M₀'] [has_zero M₀'] [no_zero_divisors M₀'] + (f : M₀ → M₀') (hf : injective f) (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) : + no_zero_divisors M₀ := +{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y H, + have f x * f y = 0, by rw [← mul, H, zero], + (eq_zero_or_eq_zero_of_mul_eq_zero this).imp (λ H, hf $ by rwa zero) (λ H, hf $ by rwa zero) } + +end no_zero_divisors + +section mul_zero_one_class + +variables [mul_zero_one_class M₀] + +/-- Pullback a `mul_zero_one_class` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀'] + (f : M₀' → M₀) + (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) : + mul_zero_one_class M₀' := +{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul } + +/-- Pushforward a `mul_zero_one_class` instance along an surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.mul_zero_one_class [has_mul M₀'] [has_zero M₀'] [has_one M₀'] + (f : M₀ → M₀') + (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ a b, f (a * b) = f a * f b) : + mul_zero_one_class M₀' := +{ ..hf.mul_zero_class f zero mul, ..hf.mul_one_class f one mul } + +end mul_zero_one_class + +section semigroup_with_zero + +/-- Pullback a `semigroup_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.semigroup_with_zero + [has_zero M₀'] [has_mul M₀'] [semigroup_with_zero M₀] (f : M₀' → M₀) (hf : injective f) + (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) : + semigroup_with_zero M₀' := +{ .. hf.mul_zero_class f zero mul, + .. ‹has_zero M₀'›, + .. hf.semigroup f mul } + +/-- Pushforward a `semigroup_with_zero` class along an surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.semigroup_with_zero + [semigroup_with_zero M₀] [has_zero M₀'] [has_mul M₀'] (f : M₀ → M₀') (hf : surjective f) + (zero : f 0 = 0) (mul : ∀ x y, f (x * y) = f x * f y) : + semigroup_with_zero M₀' := +{ .. hf.mul_zero_class f zero mul, + .. ‹has_zero M₀'›, + .. hf.semigroup f mul } + +end semigroup_with_zero + +section monoid_with_zero + +/-- Pullback a `monoid_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] + [has_pow M₀' ℕ] [monoid_with_zero M₀] + (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + monoid_with_zero M₀' := +{ .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul } + +/-- Pushforward a `monoid_with_zero` class along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] + [has_pow M₀' ℕ] [monoid_with_zero M₀] + (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + monoid_with_zero M₀' := +{ .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul } + +/-- Pullback a `monoid_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] + [has_pow M₀' ℕ] [comm_monoid_with_zero M₀] + (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + comm_monoid_with_zero M₀' := +{ .. hf.comm_monoid f one mul npow, .. hf.mul_zero_class f zero mul } + +/-- Pushforward a `monoid_with_zero` class along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.comm_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] + [has_pow M₀' ℕ] [comm_monoid_with_zero M₀] + (f : M₀ → M₀') (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + comm_monoid_with_zero M₀' := +{ .. hf.comm_monoid f one mul npow, .. hf.mul_zero_class f zero mul } + +end monoid_with_zero + +section cancel_monoid_with_zero + +variables [cancel_monoid_with_zero M₀] {a b c : M₀} + +/-- Pullback a `monoid_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.cancel_monoid_with_zero [has_zero M₀'] [has_mul M₀'] [has_one M₀'] + [has_pow M₀' ℕ] (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + cancel_monoid_with_zero M₀' := +{ mul_left_cancel_of_ne_zero := λ x y z hx H, hf $ mul_left_cancel₀ ((hf.ne_iff' zero).2 hx) $ + by erw [← mul, ← mul, H]; refl, + mul_right_cancel_of_ne_zero := λ x y z hx H, hf $ mul_right_cancel₀ ((hf.ne_iff' zero).2 hx) $ + by erw [← mul, ← mul, H]; refl, + .. hf.monoid f one mul npow, .. hf.mul_zero_class f zero mul } + +end cancel_monoid_with_zero + +section cancel_comm_monoid_with_zero + +variables [cancel_comm_monoid_with_zero M₀] {a b c : M₀} + +/-- Pullback a `cancel_comm_monoid_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.cancel_comm_monoid_with_zero + [has_zero M₀'] [has_mul M₀'] [has_one M₀'] [has_pow M₀' ℕ] + (f : M₀' → M₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + cancel_comm_monoid_with_zero M₀' := +{ .. hf.comm_monoid_with_zero f zero one mul npow, + .. hf.cancel_monoid_with_zero f zero one mul npow } + +end cancel_comm_monoid_with_zero + +section group_with_zero +variables [group_with_zero G₀] {a b c g h x : G₀} + +/-- Pullback a `group_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀'] + [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] + (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) + (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : + group_with_zero G₀' := +{ inv_zero := hf $ by erw [inv, zero, inv_zero], + mul_inv_cancel := λ x hx, hf $ by erw [one, mul, inv, mul_inv_cancel ((hf.ne_iff' zero).2 hx)], + .. hf.monoid_with_zero f zero one mul npow, + .. hf.div_inv_monoid f one mul inv div npow zpow, + .. pullback_nonzero f zero one, } + +/-- Pushforward a `group_with_zero` class along an surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀'] + [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] + (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f) + (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) + (inv : ∀ x, f x⁻¹ = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n): + group_with_zero G₀' := +{ inv_zero := by erw [← zero, ← inv, inv_zero], + mul_inv_cancel := hf.forall.2 $ λ x hx, + by erw [← inv, ← mul, mul_inv_cancel (mt (congr_arg f) $ trans_rel_left ne hx zero.symm)]; + exact one, + exists_pair_ne := ⟨0, 1, h01⟩, + .. hf.monoid_with_zero f zero one mul npow, + .. hf.div_inv_monoid f one mul inv div npow zpow } + +end group_with_zero + +section comm_group_with_zero +variables [comm_group_with_zero G₀] {a b c d : G₀} + +/-- Pullback a `comm_group_with_zero` class along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.comm_group_with_zero [has_zero G₀'] [has_mul G₀'] [has_one G₀'] + [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] + (f : G₀' → G₀) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) + (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : + comm_group_with_zero G₀' := +{ .. hf.group_with_zero f zero one mul inv div npow zpow, .. hf.comm_semigroup f mul } + +/-- Pushforward a `comm_group_with_zero` class along a surjective function. -/ +protected def function.surjective.comm_group_with_zero [has_zero G₀'] [has_mul G₀'] + [has_one G₀'] [has_inv G₀'] [has_div G₀'] [has_pow G₀' ℕ] [has_pow G₀' ℤ] + (h01 : (0:G₀') ≠ 1) (f : G₀ → G₀') (hf : surjective f) + (zero : f 0 = 0) (one : f 1 = 1) (mul : ∀ x y, f (x * y) = f x * f y) (inv : ∀ x, f x⁻¹ = (f x)⁻¹) + (div : ∀ x y, f (x / y) = f x / f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : + comm_group_with_zero G₀' := +{ .. hf.group_with_zero h01 f zero one mul inv div npow zpow, .. hf.comm_semigroup f mul } + +end comm_group_with_zero diff --git a/src/algebra/group_with_zero/power.lean b/src/algebra/group_with_zero/power.lean index fc8779c1291ca..04129dafa0dc6 100644 --- a/src/algebra/group_with_zero/power.lean +++ b/src/algebra/group_with_zero/power.lean @@ -4,50 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ import algebra.group_power.lemmas +import data.int.bitwise /-! # Powers of elements of groups with an adjoined zero element +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define integer power functions for groups with an adjoined zero element. This generalises the integer power function on a division ring. -/ -section zero -variables {M : Type*} [monoid_with_zero M] - -@[simp] lemma zero_pow' : ∀ n : ℕ, n ≠ 0 → (0 : M) ^ n = 0 -| 0 h := absurd rfl h -| (k+1) h := by { rw [pow_succ], exact zero_mul _ } - -lemma ne_zero_pow {a : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≠ 0 → a ≠ 0 := -by { contrapose!, rintro rfl, exact zero_pow' n hn } - -@[simp] lemma zero_pow_eq_zero [nontrivial M] {n : ℕ} : (0 : M) ^ n = 0 ↔ 0 < n := -begin - split; intro h, - { rw [pos_iff_ne_zero], rintro rfl, simpa using h }, - { exact zero_pow' n h.ne.symm } -end - -lemma ring.inverse_pow (r : M) : ∀ (n : ℕ), ring.inverse r ^ n = ring.inverse (r ^ n) -| 0 := by rw [pow_zero, pow_zero, ring.inverse_one] -| (n + 1) := by rw [pow_succ, pow_succ', ring.mul_inverse_rev' ((commute.refl r).pow_left n), - ring.inverse_pow] - -end zero - section group_with_zero variables {G₀ : Type*} [group_with_zero G₀] {a : G₀} {m n : ℕ} section nat_pow -@[simp, field_simps] theorem inv_pow₀ (a : G₀) (n : ℕ) : (a⁻¹) ^ n = (a ^ n)⁻¹ := -begin - induction n with n ih, - { rw [pow_zero, pow_zero], exact inv_one.symm }, - { rw [pow_succ', pow_succ, ih, mul_inv_rev₀] } -end - theorem pow_sub₀ (a : G₀) {m n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ := have h1 : m - n + n = m, from tsub_add_cancel_of_le h, have h2 : a ^ (m - n) * a ^ n = a ^ m, by rw [←pow_add, h1], @@ -64,10 +37,10 @@ theorem pow_inv_comm₀ (a : G₀) (m n : ℕ) : (a⁻¹) ^ m * a ^ n = a ^ n * (commute.refl a).inv_left₀.pow_pow m n lemma inv_pow_sub₀ (ha : a ≠ 0) (h : n ≤ m) : a⁻¹ ^ (m - n) = (a ^ m)⁻¹ * a ^ n := -by rw [pow_sub₀ _ (inv_ne_zero ha) h, inv_pow₀, inv_pow₀, inv_inv] +by rw [pow_sub₀ _ (inv_ne_zero ha) h, inv_pow, inv_pow, inv_inv] lemma inv_pow_sub_of_lt (a : G₀) (h : n < m) : a⁻¹ ^ (m - n) = (a ^ m)⁻¹ * a ^ n := -by rw [pow_sub_of_lt a⁻¹ h, inv_pow₀, inv_pow₀, inv_inv] +by rw [pow_sub_of_lt a⁻¹ h, inv_pow, inv_pow, inv_inv] end nat_pow @@ -79,10 +52,6 @@ variables {G₀ : Type*} [group_with_zero G₀] local attribute [ematch] le_of_lt -@[simp] theorem one_zpow₀ : ∀ (n : ℤ), (1 : G₀) ^ n = 1 -| (n : ℕ) := by rw [zpow_coe_nat, one_pow] -| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, inv_one] - lemma zero_zpow : ∀ z : ℤ, z ≠ 0 → (0 : G₀) ^ z = 0 | (n : ℕ) h := by { rw [zpow_coe_nat, zero_pow'], simpa using h } | -[1+n] h := by simp @@ -94,25 +63,11 @@ begin { rw [zero_zpow _ h] } end -@[simp] theorem zpow_neg₀ (a : G₀) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹ -| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _ -| 0 := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp } -| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl } - -lemma mul_zpow_neg_one₀ (a b : G₀) : (a * b) ^ (-1 : ℤ) = b ^ (-1 : ℤ) * a ^ (-1 : ℤ) := -by simp only [mul_inv_rev₀, zpow_one, zpow_neg₀] - -lemma zpow_neg_one₀ (x : G₀) : x ^ (-1 : ℤ) = x⁻¹ := -by { rw [← congr_arg has_inv.inv (pow_one x), zpow_neg₀, ← zpow_coe_nat], refl } - -theorem inv_zpow₀ (a : G₀) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹ -| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow₀] -| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow₀] - lemma zpow_add_one₀ {a : G₀} (ha : a ≠ 0) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a -| (n : ℕ) := by simp [← int.coe_nat_succ, pow_succ'] -| -[1+n] := by rw [int.neg_succ_of_nat_eq, zpow_neg₀, neg_add, neg_add_cancel_right, zpow_neg₀, - ← int.coe_nat_succ, zpow_coe_nat, zpow_coe_nat, pow_succ _ n, mul_inv_rev₀, mul_assoc, +| (n : ℕ) := by simp only [← int.coe_nat_succ, zpow_coe_nat, pow_succ'] +| -[1+0] := by erw [zpow_zero, zpow_neg_succ_of_nat, pow_one, inv_mul_cancel ha] +| -[1+(n+1)] := by rw [int.neg_succ_of_nat_eq, zpow_neg, neg_add, neg_add_cancel_right, zpow_neg, + ← int.coe_nat_succ, zpow_coe_nat, zpow_coe_nat, pow_succ _ (n + 1), mul_inv_rev, mul_assoc, inv_mul_cancel ha, mul_one] lemma zpow_sub_one₀ {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ := @@ -163,66 +118,29 @@ theorem commute.self_zpow₀ (a : G₀) (n : ℤ) : commute a (a^n) := (commute. theorem commute.zpow_zpow_self₀ (a : G₀) (m n : ℤ) : commute (a^m) (a^n) := (commute.refl a).zpow_zpow₀ m n -theorem zpow_bit0₀ (a : G₀) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n := -begin - apply zpow_add', right, - by_cases hn : n = 0, - { simp [hn] }, - { simp [← two_mul, hn, two_ne_zero] } -end - theorem zpow_bit1₀ (a : G₀) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a := begin - rw [← zpow_bit0₀, bit1, zpow_add', zpow_one], + rw [← zpow_bit0, bit1, zpow_add', zpow_one], right, left, apply bit1_ne_zero end -theorem zpow_mul₀ (a : G₀) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n -| (m : ℕ) (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat, ← pow_mul, ← zpow_coe_nat], refl } -| (m : ℕ) -[1+ n] := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← pow_mul, coe_nat_mul_neg_succ, - zpow_neg₀, inv_inj, ← zpow_coe_nat], refl } -| -[1+ m] (n : ℕ) := by { rw [zpow_coe_nat, zpow_neg_succ_of_nat, ← inv_pow₀, ← pow_mul, - neg_succ_mul_coe_nat, zpow_neg₀, inv_pow₀, inv_inj, ← zpow_coe_nat], refl } -| -[1+ m] -[1+ n] := by { rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, neg_succ_mul_neg_succ, - inv_pow₀, inv_inv, ← pow_mul, ← zpow_coe_nat], refl } - -theorem zpow_mul₀' (a : G₀) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m := -by rw [mul_comm, zpow_mul₀] - -@[simp, norm_cast] lemma units.coe_zpow₀ (u : G₀ˣ) : - ∀ (n : ℤ), ((u ^ n : G₀ˣ) : G₀) = u ^ n -| (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat], exact u.coe_pow n } -| -[1+k] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, units.coe_inv', u.coe_pow] - lemma zpow_ne_zero_of_ne_zero {a : G₀} (ha : a ≠ 0) : ∀ (z : ℤ), a ^ z ≠ 0 | (n : ℕ) := by { rw zpow_coe_nat, exact pow_ne_zero _ ha } | -[1+n] := by { rw zpow_neg_succ_of_nat, exact inv_ne_zero (pow_ne_zero _ ha) } lemma zpow_sub₀ {a : G₀} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 := -by rw [sub_eq_add_neg, zpow_add₀ ha, zpow_neg₀, div_eq_mul_inv] - -lemma commute.mul_zpow₀ {a b : G₀} (h : commute a b) : - ∀ (i : ℤ), (a * b) ^ i = (a ^ i) * (b ^ i) -| (n : ℕ) := by simp [h.mul_pow n] -| -[1+n] := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev₀] - -theorem zpow_bit0' (a : G₀) (n : ℤ) : a ^ bit0 n = (a * a) ^ n := -(zpow_bit0₀ a n).trans ((commute.refl a).mul_zpow₀ n).symm +by rw [sub_eq_add_neg, zpow_add₀ ha, zpow_neg, div_eq_mul_inv] theorem zpow_bit1' (a : G₀) (n : ℤ) : a ^ bit1 n = (a * a) ^ n * a := -by rw [zpow_bit1₀, (commute.refl a).mul_zpow₀] +by rw [zpow_bit1₀, (commute.refl a).mul_zpow] lemma zpow_eq_zero {x : G₀} {n : ℤ} (h : x ^ n = 0) : x = 0 := classical.by_contradiction $ λ hx, zpow_ne_zero_of_ne_zero hx n h -lemma zpow_eq_zero_iff {a : G₀} {n : ℤ} (hn : 0 < n) : +lemma zpow_eq_zero_iff {a : G₀} {n : ℤ} (hn : n ≠ 0) : a ^ n = 0 ↔ a = 0 := -begin - refine ⟨zpow_eq_zero, _⟩, - rintros rfl, - exact zero_zpow _ hn.ne' -end +⟨zpow_eq_zero, λ ha, ha.symm ▸ zero_zpow _ hn⟩ lemma zpow_ne_zero {x : G₀} (n : ℤ) : x ≠ 0 → x ^ n ≠ 0 := mt zpow_eq_zero @@ -230,38 +148,15 @@ mt zpow_eq_zero theorem zpow_neg_mul_zpow_self (n : ℤ) {x : G₀} (h : x ≠ 0) : x ^ (-n) * x ^ n = 1 := begin - rw [zpow_neg₀], + rw [zpow_neg], exact inv_mul_cancel (zpow_ne_zero n h) end -theorem one_div_pow {a : G₀} (n : ℕ) : - (1 / a) ^ n = 1 / a ^ n := -by simp only [one_div, inv_pow₀] - -theorem one_div_zpow {a : G₀} (n : ℤ) : - (1 / a) ^ n = 1 / a ^ n := -by simp only [one_div, inv_zpow₀] - -@[simp] lemma inv_zpow' {a : G₀} (n : ℤ) : - (a ⁻¹) ^ n = a ^ (-n) := -by { rw [inv_zpow₀, ← zpow_neg_one, ← zpow_mul₀], simp } - end zpow section variables {G₀ : Type*} [comm_group_with_zero G₀] -@[simp] theorem div_pow (a b : G₀) (n : ℕ) : - (a / b) ^ n = a ^ n / b ^ n := -by simp only [div_eq_mul_inv, mul_pow, inv_pow₀] - -lemma mul_zpow₀ (a b : G₀) (m : ℤ) : (a * b) ^ m = (a ^ m) * (b ^ m) := -(commute.all a b).mul_zpow₀ m - -@[simp] theorem div_zpow₀ (a : G₀) {b : G₀} (n : ℤ) : - (a / b) ^ n = a ^ n / b ^ n := -by simp only [div_eq_mul_inv, mul_zpow₀, inv_zpow₀] - lemma div_sq_cancel (a b : G₀) : a ^ 2 * b / a = a * b := begin by_cases ha : a = 0, @@ -269,38 +164,11 @@ begin rw [sq, mul_assoc, mul_div_cancel_left _ ha] end -/-- The `n`-th power map (`n` an integer) on a commutative group with zero, considered as a group -homomorphism. -/ -def zpow_group_hom₀ (n : ℤ) : G₀ →* G₀ := -{ to_fun := (^ n), - map_one' := one_zpow₀ n, - map_mul' := λ a b, mul_zpow₀ a b n } - end /-- If a monoid homomorphism `f` between two `group_with_zero`s maps `0` to `0`, then it maps `x^n`, `n : ℤ`, to `(f x)^n`. -/ -lemma monoid_with_zero_hom.map_zpow {G₀ G₀' : Type*} [group_with_zero G₀] [group_with_zero G₀'] - (f : G₀ →*₀ G₀') (x : G₀) : - ∀ n : ℤ, f (x ^ n) = f x ^ n -| (n : ℕ) := by { rw [zpow_coe_nat, zpow_coe_nat], exact f.to_monoid_hom.map_pow x n } -| -[1+n] := begin - rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat], - exact ((f.map_inv _).trans $ congr_arg _ $ f.to_monoid_hom.map_pow x _) - end - --- I haven't been able to find a better home for this: --- it belongs with other lemmas on `linear_ordered_field`, but --- we need to wait until `zpow` has been defined in this file. -section -variables {R : Type*} [linear_ordered_field R] {a : R} - -lemma pow_minus_two_nonneg : 0 ≤ a^(-2 : ℤ) := -begin - simp only [inv_nonneg, zpow_neg₀], - change 0 ≤ a ^ ((2 : ℕ) : ℤ), - rw zpow_coe_nat, - apply sq_nonneg, -end - -end +@[simp] lemma map_zpow₀ {F G₀ G₀' : Type*} [group_with_zero G₀] [group_with_zero G₀'] + [monoid_with_zero_hom_class F G₀ G₀'] (f : F) (x : G₀) (n : ℤ) : + f (x ^ n) = f x ^ n := +map_zpow' f (map_inv₀ f) x n diff --git a/src/algebra/group_with_zero/semiconj.lean b/src/algebra/group_with_zero/semiconj.lean new file mode 100644 index 0000000000000..224d3a3204145 --- /dev/null +++ b/src/algebra/group_with_zero/semiconj.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2020 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin +-/ +import algebra.group_with_zero.units.basic +import algebra.group.semiconj + +/-! +# Lemmas about semiconjugate elements in a `group_with_zero`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +variables {α M₀ G₀ M₀' G₀' F F' : Type*} + +namespace semiconj_by + +@[simp] lemma zero_right [mul_zero_class G₀] (a : G₀) : semiconj_by a 0 0 := +by simp only [semiconj_by, mul_zero, zero_mul] + +@[simp] lemma zero_left [mul_zero_class G₀] (x y : G₀) : semiconj_by 0 x y := +by simp only [semiconj_by, mul_zero, zero_mul] + +variables [group_with_zero G₀] {a x y x' y' : G₀} + +@[simp] lemma inv_symm_left_iff₀ : semiconj_by a⁻¹ x y ↔ semiconj_by a y x := +classical.by_cases + (λ ha : a = 0, by simp only [ha, inv_zero, semiconj_by.zero_left]) + (λ ha, @units_inv_symm_left_iff _ _ (units.mk0 a ha) _ _) + +lemma inv_symm_left₀ (h : semiconj_by a x y) : semiconj_by a⁻¹ y x := +semiconj_by.inv_symm_left_iff₀.2 h + +lemma inv_right₀ (h : semiconj_by a x y) : semiconj_by a x⁻¹ y⁻¹ := +begin + by_cases ha : a = 0, + { simp only [ha, zero_left] }, + by_cases hx : x = 0, + { subst x, + simp only [semiconj_by, mul_zero, @eq_comm _ _ (y * a), mul_eq_zero] at h, + simp [h.resolve_right ha] }, + { have := mul_ne_zero ha hx, + rw [h.eq, mul_ne_zero_iff] at this, + exact @units_inv_right _ _ _ (units.mk0 x hx) (units.mk0 y this.1) h }, +end + +@[simp] lemma inv_right_iff₀ : semiconj_by a x⁻¹ y⁻¹ ↔ semiconj_by a x y := +⟨λ h, inv_inv x ▸ inv_inv y ▸ h.inv_right₀, inv_right₀⟩ + +lemma div_right (h : semiconj_by a x y) (h' : semiconj_by a x' y') : + semiconj_by a (x / x') (y / y') := +by { rw [div_eq_mul_inv, div_eq_mul_inv], exact h.mul_right h'.inv_right₀ } + +end semiconj_by diff --git a/src/algebra/group_with_zero/units/basic.lean b/src/algebra/group_with_zero/units/basic.lean new file mode 100644 index 0000000000000..a306052d3e7c8 --- /dev/null +++ b/src/algebra/group_with_zero/units/basic.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2020 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin +-/ +import algebra.group_with_zero.basic +import algebra.group.units +import tactic.nontriviality +import tactic.assert_exists + +/-! +# Lemmas about units in a `monoid_with_zero` or a `group_with_zero`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We also define `ring.inverse`, a globally defined function on any ring +(in fact any `monoid_with_zero`), which inverts units and sends non-units to zero. +-/ + +variables {α M₀ G₀ M₀' G₀' F F' : Type*} + +variables [monoid_with_zero M₀] + +namespace units + +/-- An element of the unit group of a nonzero monoid with zero represented as an element + of the monoid is nonzero. -/ +@[simp] lemma ne_zero [nontrivial M₀] (u : M₀ˣ) : + (u : M₀) ≠ 0 := +left_ne_zero_of_mul_eq_one u.mul_inv + +-- We can't use `mul_eq_zero` + `units.ne_zero` in the next two lemmas because we don't assume +-- `nonzero M₀`. + +@[simp] lemma mul_left_eq_zero (u : M₀ˣ) {a : M₀} : a * u = 0 ↔ a = 0 := +⟨λ h, by simpa using mul_eq_zero_of_left h ↑u⁻¹, λ h, mul_eq_zero_of_left h u⟩ + +@[simp] lemma mul_right_eq_zero (u : M₀ˣ) {a : M₀} : ↑u * a = 0 ↔ a = 0 := +⟨λ h, by simpa using mul_eq_zero_of_right ↑u⁻¹ h, mul_eq_zero_of_right u⟩ + +end units + +namespace is_unit + +lemma ne_zero [nontrivial M₀] {a : M₀} (ha : is_unit a) : a ≠ 0 := let ⟨u, hu⟩ := +ha in hu ▸ u.ne_zero + +lemma mul_right_eq_zero {a b : M₀} (ha : is_unit a) : a * b = 0 ↔ b = 0 := +let ⟨u, hu⟩ := ha in hu ▸ u.mul_right_eq_zero + +lemma mul_left_eq_zero {a b : M₀} (hb : is_unit b) : a * b = 0 ↔ a = 0 := +let ⟨u, hu⟩ := hb in hu ▸ u.mul_left_eq_zero + +end is_unit + +@[simp] theorem is_unit_zero_iff : is_unit (0 : M₀) ↔ (0:M₀) = 1 := +⟨λ ⟨⟨_, a, (a0 : 0 * a = 1), _⟩, rfl⟩, by rwa zero_mul at a0, + λ h, @is_unit_of_subsingleton _ _ (subsingleton_of_zero_eq_one h) 0⟩ + +@[simp] theorem not_is_unit_zero [nontrivial M₀] : ¬ is_unit (0 : M₀) := +mt is_unit_zero_iff.1 zero_ne_one + +namespace ring +open_locale classical + +/-- Introduce a function `inverse` on a monoid with zero `M₀`, which sends `x` to `x⁻¹` if `x` is +invertible and to `0` otherwise. This definition is somewhat ad hoc, but one needs a fully (rather +than partially) defined inverse function for some purposes, including for calculus. + +Note that while this is in the `ring` namespace for brevity, it requires the weaker assumption +`monoid_with_zero M₀` instead of `ring M₀`. -/ +noncomputable def inverse : M₀ → M₀ := +λ x, if h : is_unit x then ((h.unit⁻¹ : M₀ˣ) : M₀) else 0 + +/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/ +@[simp] lemma inverse_unit (u : M₀ˣ) : inverse (u : M₀) = (u⁻¹ : M₀ˣ) := +begin + simp only [units.is_unit, inverse, dif_pos], + exact units.inv_unique rfl +end + +/-- By definition, if `x` is not invertible then `inverse x = 0`. -/ +@[simp] lemma inverse_non_unit (x : M₀) (h : ¬(is_unit x)) : inverse x = 0 := dif_neg h + +lemma mul_inverse_cancel (x : M₀) (h : is_unit x) : x * inverse x = 1 := +by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.mul_inv], } + +lemma inverse_mul_cancel (x : M₀) (h : is_unit x) : inverse x * x = 1 := +by { rcases h with ⟨u, rfl⟩, rw [inverse_unit, units.inv_mul], } + +lemma mul_inverse_cancel_right (x y : M₀) (h : is_unit x) : y * x * inverse x = y := +by rw [mul_assoc, mul_inverse_cancel x h, mul_one] + +lemma inverse_mul_cancel_right (x y : M₀) (h : is_unit x) : y * inverse x * x = y := +by rw [mul_assoc, inverse_mul_cancel x h, mul_one] + +lemma mul_inverse_cancel_left (x y : M₀) (h : is_unit x) : x * (inverse x * y) = y := +by rw [← mul_assoc, mul_inverse_cancel x h, one_mul] + +lemma inverse_mul_cancel_left (x y : M₀) (h : is_unit x) : inverse x * (x * y) = y := +by rw [← mul_assoc, inverse_mul_cancel x h, one_mul] + +lemma inverse_mul_eq_iff_eq_mul (x y z : M₀) (h : is_unit x) : + inverse x * y = z ↔ y = x * z := +⟨λ h1, by rw [← h1, mul_inverse_cancel_left _ _ h], λ h1, by rw [h1, inverse_mul_cancel_left _ _ h]⟩ + +lemma eq_mul_inverse_iff_mul_eq (x y z : M₀) (h : is_unit z) : + x = y * inverse z ↔ x * z = y := +⟨λ h1, by rw [h1, inverse_mul_cancel_right _ _ h], + λ h1, by rw [← h1, mul_inverse_cancel_right _ _ h]⟩ + +variables (M₀) + +@[simp] lemma inverse_one : inverse (1 : M₀) = 1 := +inverse_unit 1 + +@[simp] lemma inverse_zero : inverse (0 : M₀) = 0 := +by { nontriviality, exact inverse_non_unit _ not_is_unit_zero } + +variables {M₀} + +end ring + +lemma is_unit.ring_inverse {a : M₀} : is_unit a → is_unit (ring.inverse a) +| ⟨u, hu⟩ := hu ▸ ⟨u⁻¹, (ring.inverse_unit u).symm⟩ + +@[simp] lemma is_unit_ring_inverse {a : M₀} : is_unit (ring.inverse a) ↔ is_unit a := +⟨λ h, begin + casesI subsingleton_or_nontrivial M₀, + { convert h }, + { contrapose h, + rw ring.inverse_non_unit _ h, + exact not_is_unit_zero, }, +end, is_unit.ring_inverse⟩ + +namespace units +variables [group_with_zero G₀] +variables {a b : G₀} + +/-- Embed a non-zero element of a `group_with_zero` into the unit group. + By combining this function with the operations on units, + or the `/ₚ` operation, it is possible to write a division + as a partial function with three arguments. -/ +def mk0 (a : G₀) (ha : a ≠ 0) : G₀ˣ := +⟨a, a⁻¹, mul_inv_cancel ha, inv_mul_cancel ha⟩ + +@[simp] lemma mk0_one (h := one_ne_zero) : + mk0 (1 : G₀) h = 1 := +by { ext, refl } + +@[simp] lemma coe_mk0 {a : G₀} (h : a ≠ 0) : (mk0 a h : G₀) = a := rfl + +@[simp] lemma mk0_coe (u : G₀ˣ) (h : (u : G₀) ≠ 0) : mk0 (u : G₀) h = u := +units.ext rfl + +@[simp] lemma mul_inv' (u : G₀ˣ) : (u : G₀) * u⁻¹ = 1 := mul_inv_cancel u.ne_zero + +@[simp] lemma inv_mul' (u : G₀ˣ) : (u⁻¹ : G₀) * u = 1 := inv_mul_cancel u.ne_zero + +@[simp] lemma mk0_inj {a b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) : + units.mk0 a ha = units.mk0 b hb ↔ a = b := +⟨λ h, by injection h, λ h, units.ext h⟩ + +/-- In a group with zero, an existential over a unit can be rewritten in terms of `units.mk0`. -/ +lemma exists0 {p : G₀ˣ → Prop} : (∃ g : G₀ˣ, p g) ↔ ∃ (g : G₀) (hg : g ≠ 0), p (units.mk0 g hg) := +⟨λ ⟨g, pg⟩, ⟨g, g.ne_zero, (g.mk0_coe g.ne_zero).symm ▸ pg⟩, λ ⟨g, hg, pg⟩, ⟨units.mk0 g hg, pg⟩⟩ + +/-- An alternative version of `units.exists0`. This one is useful if Lean cannot +figure out `p` when using `units.exists0` from right to left. -/ +lemma exists0' {p : Π g : G₀, g ≠ 0 → Prop} : + (∃ (g : G₀) (hg : g ≠ 0), p g hg) ↔ ∃ g : G₀ˣ, p g g.ne_zero := +iff.trans (by simp_rw [coe_mk0]) exists0.symm + +@[simp] lemma exists_iff_ne_zero {x : G₀} : (∃ u : G₀ˣ, ↑u = x) ↔ x ≠ 0 := +by simp [exists0] + +lemma _root_.group_with_zero.eq_zero_or_unit (a : G₀) : + a = 0 ∨ ∃ u : G₀ˣ, a = u := +begin + by_cases h : a = 0, + { left, + exact h }, + { right, + simpa only [eq_comm] using units.exists_iff_ne_zero.mpr h } +end + +end units + +section group_with_zero +variables [group_with_zero G₀] {a b c : G₀} + +lemma is_unit.mk0 (x : G₀) (hx : x ≠ 0) : is_unit x := (units.mk0 x hx).is_unit + +lemma is_unit_iff_ne_zero : is_unit a ↔ a ≠ 0 := units.exists_iff_ne_zero + +alias is_unit_iff_ne_zero ↔ _ ne.is_unit + +attribute [protected] ne.is_unit + +@[priority 10] -- see Note [lower instance priority] +instance group_with_zero.no_zero_divisors : no_zero_divisors G₀ := +{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h, + begin + contrapose! h, + exact ((units.mk0 a h.1) * (units.mk0 b h.2)).ne_zero + end, + .. (‹_› : group_with_zero G₀) } + +-- Can't be put next to the other `mk0` lemmas because it depends on the +-- `no_zero_divisors` instance, which depends on `mk0`. +@[simp] lemma units.mk0_mul (x y : G₀) (hxy) : + units.mk0 (x * y) hxy = + units.mk0 x (mul_ne_zero_iff.mp hxy).1 * units.mk0 y (mul_ne_zero_iff.mp hxy).2 := +by { ext, refl } + +lemma div_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 := +by { rw div_eq_mul_inv, exact mul_ne_zero ha (inv_ne_zero hb) } + +@[simp] lemma div_eq_zero_iff : a / b = 0 ↔ a = 0 ∨ b = 0:= +by simp [div_eq_mul_inv] + +lemma div_ne_zero_iff : a / b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 := +div_eq_zero_iff.not.trans not_or_distrib + +lemma ring.inverse_eq_inv (a : G₀) : ring.inverse a = a⁻¹ := +begin + obtain rfl | ha := eq_or_ne a 0, + { simp }, + { exact ring.inverse_unit (units.mk0 a ha) } +end + +@[simp] lemma ring.inverse_eq_inv' : (ring.inverse : G₀ → G₀) = has_inv.inv := +funext ring.inverse_eq_inv + +end group_with_zero + +section comm_group_with_zero -- comm +variables [comm_group_with_zero G₀] {a b c d : G₀} + +@[priority 10] -- see Note [lower instance priority] +instance comm_group_with_zero.to_cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero G₀ := +{ ..group_with_zero.to_cancel_monoid_with_zero, ..comm_group_with_zero.to_comm_monoid_with_zero G₀ } + +@[priority 100] -- See note [lower instance priority] +instance comm_group_with_zero.to_division_comm_monoid : division_comm_monoid G₀ := +{ ..‹comm_group_with_zero G₀›, ..group_with_zero.to_division_monoid } + +end comm_group_with_zero + +section noncomputable_defs + +open_locale classical +variables {M : Type*} [nontrivial M] + +/-- Constructs a `group_with_zero` structure on a `monoid_with_zero` + consisting only of units and 0. -/ +noncomputable def group_with_zero_of_is_unit_or_eq_zero [hM : monoid_with_zero M] + (h : ∀ (a : M), is_unit a ∨ a = 0) : group_with_zero M := +{ inv := λ a, if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹, + inv_zero := dif_pos rfl, + mul_inv_cancel := λ a h0, by + { change a * (if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹) = 1, + rw [dif_neg h0, units.mul_inv_eq_iff_eq_mul, one_mul, is_unit.unit_spec] }, + exists_pair_ne := nontrivial.exists_pair_ne, +.. hM } + +/-- Constructs a `comm_group_with_zero` structure on a `comm_monoid_with_zero` + consisting only of units and 0. -/ +noncomputable def comm_group_with_zero_of_is_unit_or_eq_zero [hM : comm_monoid_with_zero M] + (h : ∀ (a : M), is_unit a ∨ a = 0) : comm_group_with_zero M := +{ .. (group_with_zero_of_is_unit_or_eq_zero h), .. hM } + +end noncomputable_defs + +-- Guard against import creep +assert_not_exists multiplicative diff --git a/src/algebra/group_with_zero/units/lemmas.lean b/src/algebra/group_with_zero/units/lemmas.lean new file mode 100644 index 0000000000000..2f0ecc5d24a70 --- /dev/null +++ b/src/algebra/group_with_zero/units/lemmas.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2020 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin +-/ +import algebra.group_with_zero.commute +import algebra.hom.units +import group_theory.group_action.units + +/-! +# Further lemmas about units in a `monoid_with_zero` or a `group_with_zero`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +variables {α M₀ G₀ M₀' G₀' F F' : Type*} + +variables [monoid_with_zero M₀] + +section group_with_zero +variables [group_with_zero G₀] {a b c : G₀} + +@[simp] lemma div_self (h : a ≠ 0) : a / a = 1 := h.is_unit.div_self + +lemma eq_mul_inv_iff_mul_eq₀ (hc : c ≠ 0) : a = b * c⁻¹ ↔ a * c = b := +hc.is_unit.eq_mul_inv_iff_mul_eq + +lemma eq_inv_mul_iff_mul_eq₀ (hb : b ≠ 0) : a = b⁻¹ * c ↔ b * a = c := +hb.is_unit.eq_inv_mul_iff_mul_eq + +lemma inv_mul_eq_iff_eq_mul₀ (ha : a ≠ 0) : a⁻¹ * b = c ↔ b = a * c := +ha.is_unit.inv_mul_eq_iff_eq_mul + +lemma mul_inv_eq_iff_eq_mul₀ (hb : b ≠ 0) : a * b⁻¹ = c ↔ a = c * b := +hb.is_unit.mul_inv_eq_iff_eq_mul + +lemma mul_inv_eq_one₀ (hb : b ≠ 0) : a * b⁻¹ = 1 ↔ a = b := hb.is_unit.mul_inv_eq_one +lemma inv_mul_eq_one₀ (ha : a ≠ 0) : a⁻¹ * b = 1 ↔ a = b := ha.is_unit.inv_mul_eq_one + +lemma mul_eq_one_iff_eq_inv₀ (hb : b ≠ 0) : a * b = 1 ↔ a = b⁻¹ := hb.is_unit.mul_eq_one_iff_eq_inv +lemma mul_eq_one_iff_inv_eq₀ (ha : a ≠ 0) : a * b = 1 ↔ a⁻¹ = b := ha.is_unit.mul_eq_one_iff_inv_eq + +@[simp] lemma div_mul_cancel (a : G₀) (h : b ≠ 0) : a / b * b = a := h.is_unit.div_mul_cancel _ +@[simp] lemma mul_div_cancel (a : G₀) (h : b ≠ 0) : a * b / b = a := h.is_unit.mul_div_cancel _ + +lemma mul_one_div_cancel (h : a ≠ 0) : a * (1 / a) = 1 := h.is_unit.mul_one_div_cancel +lemma one_div_mul_cancel (h : a ≠ 0) : (1 / a) * a = 1 := h.is_unit.one_div_mul_cancel + +lemma div_left_inj' (hc : c ≠ 0) : a / c = b / c ↔ a = b := hc.is_unit.div_left_inj + +@[field_simps] lemma div_eq_iff (hb : b ≠ 0) : a / b = c ↔ a = c * b := hb.is_unit.div_eq_iff +@[field_simps] lemma eq_div_iff (hb : b ≠ 0) : c = a / b ↔ c * b = a := hb.is_unit.eq_div_iff + +lemma div_eq_iff_mul_eq (hb : b ≠ 0) : a / b = c ↔ c * b = a := hb.is_unit.div_eq_iff.trans eq_comm +lemma eq_div_iff_mul_eq (hc : c ≠ 0) : a = b / c ↔ a * c = b := hc.is_unit.eq_div_iff + +lemma div_eq_of_eq_mul (hb : b ≠ 0) : a = c * b → a / b = c := hb.is_unit.div_eq_of_eq_mul +lemma eq_div_of_mul_eq (hc : c ≠ 0) : a * c = b → a = b / c := hc.is_unit.eq_div_of_mul_eq + +lemma div_eq_one_iff_eq (hb : b ≠ 0) : a / b = 1 ↔ a = b := hb.is_unit.div_eq_one_iff_eq + +lemma div_mul_left (hb : b ≠ 0) : b / (a * b) = 1 / a := hb.is_unit.div_mul_left + +lemma mul_div_mul_right (a b : G₀) (hc : c ≠ 0) : (a * c) / (b * c) = a / b := +hc.is_unit.mul_div_mul_right _ _ + +lemma mul_mul_div (a : G₀) (hb : b ≠ 0) : a = a * b * (1 / b) := (hb.is_unit.mul_mul_div _).symm + +lemma div_div_div_cancel_right (a : G₀) (hc : c ≠ 0) : (a / c) / (b / c) = a / b := +by rw [div_div_eq_mul_div, div_mul_cancel _ hc] + +lemma div_mul_div_cancel (a : G₀) (hc : c ≠ 0) : (a / c) * (c / b) = a / b := +by rw [← mul_div_assoc, div_mul_cancel _ hc] + +lemma div_mul_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a / b * b = a := +classical.by_cases (λ hb : b = 0, by simp [*]) (div_mul_cancel a) + +lemma mul_div_cancel_of_imp {a b : G₀} (h : b = 0 → a = 0) : a * b / b = a := +classical.by_cases (λ hb : b = 0, by simp [*]) (mul_div_cancel a) + +@[simp] theorem divp_mk0 (a : G₀) {b : G₀} (hb : b ≠ 0) : + a /ₚ units.mk0 b hb = a / b := +divp_eq_div _ _ + +end group_with_zero + +section comm_group_with_zero -- comm +variables [comm_group_with_zero G₀] {a b c d : G₀} + +lemma div_mul_right (b : G₀) (ha : a ≠ 0) : a / (a * b) = 1 / b := ha.is_unit.div_mul_right _ + +lemma mul_div_cancel_left_of_imp {a b : G₀} (h : a = 0 → b = 0) : a * b / a = b := +by rw [mul_comm, mul_div_cancel_of_imp h] + +lemma mul_div_cancel_left (b : G₀) (ha : a ≠ 0) : a * b / a = b := ha.is_unit.mul_div_cancel_left _ + +lemma mul_div_cancel_of_imp' {a b : G₀} (h : b = 0 → a = 0) : b * (a / b) = a := +by rw [mul_comm, div_mul_cancel_of_imp h] + +lemma mul_div_cancel' (a : G₀) (hb : b ≠ 0) : b * (a / b) = a := hb.is_unit.mul_div_cancel' _ + +lemma mul_div_mul_left (a b : G₀) (hc : c ≠ 0) : (c * a) / (c * b) = a / b := +hc.is_unit.mul_div_mul_left _ _ + +lemma mul_eq_mul_of_div_eq_div (a : G₀) {b : G₀} (c : G₀) {d : G₀} (hb : b ≠ 0) (hd : d ≠ 0) + (h : a / b = c / d) : a * d = c * b := +by rw [←mul_one a, ←div_self hb, ←mul_comm_div, h, div_mul_eq_mul_div, div_mul_cancel _ hd] + +@[field_simps] lemma div_eq_div_iff (hb : b ≠ 0) (hd : d ≠ 0) : a / b = c / d ↔ a * d = c * b := +hb.is_unit.div_eq_div_iff hd.is_unit + +lemma div_div_cancel' (ha : a ≠ 0) : a / (a / b) = b := ha.is_unit.div_div_cancel + +lemma div_div_cancel_left' (ha : a ≠ 0) : a / b / a = b⁻¹ := ha.is_unit.div_div_cancel_left + +lemma div_helper (b : G₀) (h : a ≠ 0) : 1 / (a * b) * a = 1 / b := +by rw [div_mul_eq_mul_div, one_mul, div_mul_right _ h] + +end comm_group_with_zero + + +section monoid_with_zero +variables [group_with_zero G₀] [nontrivial M₀] + [monoid_with_zero M₀'] [monoid_with_zero_hom_class F G₀ M₀] + [monoid_with_zero_hom_class F' G₀ M₀'] (f : F) {a : G₀} +include M₀ + +lemma map_ne_zero : f a ≠ 0 ↔ a ≠ 0 := +⟨λ hfa ha, hfa $ ha.symm ▸ map_zero f, λ ha, ((is_unit.mk0 a ha).map f).ne_zero⟩ + +@[simp] lemma map_eq_zero : f a = 0 ↔ a = 0 := not_iff_not.1 (map_ne_zero f) + +omit M₀ +include M₀' + +lemma eq_on_inv₀ (f g : F') (h : f a = g a) : f a⁻¹ = g a⁻¹ := +begin + rcases eq_or_ne a 0 with rfl|ha, + { rw [inv_zero, map_zero, map_zero] }, + { exact (is_unit.mk0 a ha).eq_on_inv f g h } +end + +end monoid_with_zero + +section group_with_zero + +variables [group_with_zero G₀] [group_with_zero G₀'] [monoid_with_zero_hom_class F G₀ G₀'] + (f : F) (a b : G₀) +include G₀' + +/-- A monoid homomorphism between groups with zeros sending `0` to `0` sends `a⁻¹` to `(f a)⁻¹`. -/ +@[simp] lemma map_inv₀ : f a⁻¹ = (f a)⁻¹ := +begin + by_cases h : a = 0, by simp [h], + apply eq_inv_of_mul_eq_one_left, + rw [← map_mul, inv_mul_cancel h, map_one] +end + +@[simp] lemma map_div₀ : f (a / b) = f a / f b := map_div' f (map_inv₀ f) a b + +end group_with_zero + +/-- We define the inverse as a `monoid_with_zero_hom` by extending the inverse map by zero +on non-units. -/ +noncomputable +def monoid_with_zero.inverse {M : Type*} [comm_monoid_with_zero M] : + M →*₀ M := +{ to_fun := ring.inverse, + map_zero' := ring.inverse_zero _, + map_one' := ring.inverse_one _, + map_mul' := λ x y, (ring.mul_inverse_rev x y).trans (mul_comm _ _) } + +@[simp] +lemma monoid_with_zero.coe_inverse {M : Type*} [comm_monoid_with_zero M] : + (monoid_with_zero.inverse : M → M) = ring.inverse := rfl + +@[simp] +lemma monoid_with_zero.inverse_apply {M : Type*} [comm_monoid_with_zero M] (a : M) : + monoid_with_zero.inverse a = ring.inverse a := rfl + +/-- Inversion on a commutative group with zero, considered as a monoid with zero homomorphism. -/ +def inv_monoid_with_zero_hom {G₀ : Type*} [comm_group_with_zero G₀] : G₀ →*₀ G₀ := +{ map_zero' := inv_zero, + ..inv_monoid_hom } + +namespace units +variables [group_with_zero G₀] +variables {a b : G₀} + +@[simp] lemma smul_mk0 {α : Type*} [has_smul G₀ α] {g : G₀} (hg : g ≠ 0) (a : α) : + (mk0 g hg) • a = g • a := +rfl + +end units diff --git a/src/algebra/hierarchy_design.lean b/src/algebra/hierarchy_design.lean index bf4e6b491e0d0..31c4205bebe12 100644 --- a/src/algebra/hierarchy_design.lean +++ b/src/algebra/hierarchy_design.lean @@ -8,6 +8,9 @@ import tactic.doc_commands /-! # Documentation of the algebraic hierarchy +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A library note giving advice on modifying the algebraic hierarchy. (It is not intended as a "tour".) diff --git a/src/algebra/hom/aut.lean b/src/algebra/hom/aut.lean index 5ab45565bf26f..d0e2bfe47879f 100644 --- a/src/algebra/hom/aut.lean +++ b/src/algebra/hom/aut.lean @@ -8,6 +8,9 @@ import group_theory.perm.basic /-! # Multiplicative and additive group automorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the automorphism group structure on `add_aut R := add_equiv R R` and `mul_aut R := mul_equiv R R`. @@ -83,7 +86,7 @@ instance apply_mul_distrib_mul_action {M} [monoid M] : mul_distrib_mul_action (m @[simp] protected lemma smul_def {M} [monoid M] (f : mul_aut M) (a : M) : f • a = f a := rfl /-- `mul_aut.apply_mul_action` is faithful. -/ -instance apply_has_faithful_scalar {M} [monoid M] : has_faithful_scalar (mul_aut M) M := +instance apply_has_faithful_smul {M} [monoid M] : has_faithful_smul (mul_aut M) M := ⟨λ _ _, mul_equiv.ext⟩ /-- Group conjugation, `mul_aut.conj g h = g * h * g⁻¹`, as a monoid homomorphism @@ -159,7 +162,7 @@ instance apply_distrib_mul_action {A} [add_monoid A] : distrib_mul_action (add_a @[simp] protected lemma smul_def {A} [add_monoid A] (f : add_aut A) (a : A) : f • a = f a := rfl /-- `add_aut.apply_distrib_mul_action` is faithful. -/ -instance apply_has_faithful_scalar {A} [add_monoid A] : has_faithful_scalar (add_aut A) A := +instance apply_has_faithful_smul {A} [add_monoid A] : has_faithful_smul (add_aut A) A := ⟨λ _ _, add_equiv.ext⟩ /-- Additive group conjugation, `add_aut.conj g h = g + h - g`, as an additive monoid diff --git a/src/algebra/hom/centroid.lean b/src/algebra/hom/centroid.lean new file mode 100644 index 0000000000000..42578ad72ff4a --- /dev/null +++ b/src/algebra/hom/centroid.lean @@ -0,0 +1,322 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Christopher Hoskin +-/ +import algebra.group_power.lemmas +import algebra.hom.group_instances + +/-! +# Centroid homomorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `A` be a (non unital, non associative) algebra. The centroid of `A` is the set of linear maps +`T` on `A` such that `T` commutes with left and right multiplication, that is to say, for all `a` +and `b` in `A`, +$$ +T(ab) = (Ta)b, T(ab) = a(Tb). +$$ +In mathlib we call elements of the centroid "centroid homomorphisms" (`centroid_hom`) in keeping +with `add_monoid_hom` etc. + +We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to +be satisfied by itself and all stricter types. + +## Types of morphisms + +* `centroid_hom`: Maps which preserve left and right multiplication. + +## Typeclasses + +* `centroid_hom_class` + +## References + +* [Jacobson, Structure of Rings][Jacobson1956] +* [McCrimmon, A taste of Jordan algebras][mccrimmon2004] + +## Tags + +centroid +-/ + +open function + +variables {F α : Type*} + +-- Making `centroid_hom` an old structure will allow the lemma `to_add_monoid_hom_eq_coe` +-- to be true by `rfl`. After upgrading to Lean 4, this should no longer be needed +-- because eta for structures should provide the same result. +set_option old_structure_cmd true + +/-- The type of centroid homomorphisms from `α` to `α`. -/ +structure centroid_hom (α : Type*) [non_unital_non_assoc_semiring α] extends α →+ α := +(map_mul_left' (a b : α) : to_fun (a * b) = a * to_fun b) +(map_mul_right' (a b : α) : to_fun (a * b) = to_fun a * b) + +attribute [nolint doc_blame] centroid_hom.to_add_monoid_hom + +/-- `centroid_hom_class F α` states that `F` is a type of centroid homomorphisms. + +You should extend this class when you extend `centroid_hom`. -/ +class centroid_hom_class (F : Type*) (α : out_param $ Type*) [non_unital_non_assoc_semiring α] + extends add_monoid_hom_class F α α := +(map_mul_left (f : F) (a b : α) : f (a * b) = a * f b) +(map_mul_right (f : F) (a b : α) : f (a * b) = f a * b) + +export centroid_hom_class (map_mul_left map_mul_right) + +instance [non_unital_non_assoc_semiring α] [centroid_hom_class F α] : + has_coe_t F (centroid_hom α) := +⟨λ f, { to_fun := f, map_mul_left' := map_mul_left f, map_mul_right' := map_mul_right f, + ..(f : α →+ α) }⟩ + +/-! ### Centroid homomorphisms -/ + +namespace centroid_hom + +section non_unital_non_assoc_semiring + +variables [non_unital_non_assoc_semiring α] + +instance : centroid_hom_class (centroid_hom α) α := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by { cases f, cases g, congr' }, + map_zero := λ f, f.map_zero', + map_add := λ f, f.map_add', + map_mul_left := λ f, f.map_mul_left', + map_mul_right := λ f, f.map_mul_right' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +instance : has_coe_to_fun (centroid_hom α) (λ _, α → α) := fun_like.has_coe_to_fun + +@[simp] lemma to_fun_eq_coe {f : centroid_hom α} : f.to_fun = (f : α → α) := rfl + +@[ext] lemma ext {f g : centroid_hom α} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h + +@[simp, norm_cast] lemma coe_to_add_monoid_hom (f : centroid_hom α) : ⇑(f : α →+ α) = f := rfl +@[simp] lemma to_add_monoid_hom_eq_coe (f : centroid_hom α) : f.to_add_monoid_hom = f := rfl + +lemma coe_to_add_monoid_hom_injective : injective (coe : centroid_hom α → α →+ α) := +λ f g h, ext $ λ a, by { have := fun_like.congr_fun h a, exact this } + +/-- Turn a centroid homomorphism into an additive monoid endomorphism. -/ +def to_End (f : centroid_hom α) : add_monoid.End α := (f : α →+ α) + +lemma to_End_injective : injective (centroid_hom.to_End : centroid_hom α → add_monoid.End α) := +coe_to_add_monoid_hom_injective + +/-- Copy of a `centroid_hom` with a new `to_fun` equal to the old one. Useful to fix +definitional equalities. -/ +protected def copy (f : centroid_hom α) (f' : α → α) (h : f' = f) : + centroid_hom α := +{ to_fun := f', + map_mul_left' := λ a b, by simp_rw [h, map_mul_left], + map_mul_right' := λ a b, by simp_rw [h, map_mul_right], + ..f.to_add_monoid_hom.copy f' $ by exact h } + +@[simp] lemma coe_copy (f : centroid_hom α) (f' : α → α) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl + +lemma copy_eq (f : centroid_hom α) (f' : α → α) (h : f' = f) : f.copy f' h = f := fun_like.ext' h + +variables (α) + +/-- `id` as a `centroid_hom`. -/ +protected def id : centroid_hom α := +{ map_mul_left' := λ _ _, rfl, + map_mul_right' := λ _ _, rfl, + .. add_monoid_hom.id α } + +instance : inhabited (centroid_hom α) := ⟨centroid_hom.id α⟩ + +@[simp, norm_cast] lemma coe_id : ⇑(centroid_hom.id α) = id := rfl + +@[simp, norm_cast] lemma coe_to_add_monoid_hom_id : + (centroid_hom.id α : α →+ α) = add_monoid_hom.id α := rfl + +variables {α} + +@[simp] lemma id_apply (a : α) : centroid_hom.id α a = a := rfl + +/-- Composition of `centroid_hom`s as a `centroid_hom`. -/ +def comp (g f : centroid_hom α) : centroid_hom α := +{ map_mul_left' := λ a b, (congr_arg g $ f.map_mul_left' _ _).trans $ g.map_mul_left' _ _, + map_mul_right' := λ a b, (congr_arg g $ f.map_mul_right' _ _).trans $ g.map_mul_right' _ _, + .. g.to_add_monoid_hom.comp f.to_add_monoid_hom } + +@[simp, norm_cast] lemma coe_comp (g f : centroid_hom α) : ⇑(g.comp f) = g ∘ f := rfl +@[simp] lemma comp_apply (g f : centroid_hom α) (a : α) : g.comp f a = g (f a) := rfl +@[simp, norm_cast] lemma coe_comp_add_monoid_hom (g f : centroid_hom α) : + (g.comp f : α →+ α) = (g : α →+ α).comp f := rfl +@[simp] lemma comp_assoc (h g f : centroid_hom α) : (h.comp g).comp f = h.comp (g.comp f) := rfl +@[simp] lemma comp_id (f : centroid_hom α) : f.comp (centroid_hom.id α) = f := ext $ λ a, rfl +@[simp] lemma id_comp (f : centroid_hom α) : (centroid_hom.id α).comp f = f := ext $ λ a, rfl + +lemma cancel_right {g₁ g₂ f : centroid_hom α} (hf : surjective f) : + g₁.comp f = g₂.comp f ↔ g₁ = g₂ := +⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩ + +lemma cancel_left {g f₁ f₂ : centroid_hom α} (hg : injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ := +⟨λ h, ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩ + +instance : has_zero (centroid_hom α) := +⟨{ map_mul_left' := λ a b, (mul_zero _).symm, + map_mul_right' := λ a b, (zero_mul _).symm, + ..(0 : α →+ α) }⟩ + +instance : has_one (centroid_hom α) := ⟨centroid_hom.id α⟩ + +instance : has_add (centroid_hom α) := +⟨λ f g, + { map_mul_left' := λ a b, by simp [map_mul_left, mul_add], + map_mul_right' := λ a b, by simp [map_mul_right, add_mul], + ..(f + g : α →+ α) } ⟩ + +instance : has_mul (centroid_hom α) := ⟨comp⟩ + +instance has_nsmul : has_smul ℕ (centroid_hom α) := +⟨λ n f, + { map_mul_left' := λ a b, + by { change n • f (a * b) = a * n • f b, rw [map_mul_left f, ←mul_smul_comm] }, + map_mul_right' := λ a b, + by { change n • f (a * b) = n • f a * b, rw [map_mul_right f, ←smul_mul_assoc] }, + .. (n • f : α →+ α) }⟩ + +instance has_npow_nat : has_pow (centroid_hom α) ℕ := +⟨λ f n, +{ map_mul_left' := λ a b, begin + induction n with n ih, + { simp }, + { rw pow_succ, + exact (congr_arg f.to_End ih).trans (f.map_mul_left' _ _) } + end, + map_mul_right' := λ a b, begin + induction n with n ih, + { simp }, + { rw pow_succ, + exact (congr_arg f.to_End ih).trans (f.map_mul_right' _ _) } + end, + ..(f.to_End ^ n : add_monoid.End α) }⟩ + +@[simp, norm_cast] lemma coe_zero : ⇑(0 : centroid_hom α) = 0 := rfl +@[simp, norm_cast] lemma coe_one : ⇑(1 : centroid_hom α) = id := rfl +@[simp, norm_cast] lemma coe_add (f g : centroid_hom α) : ⇑(f + g) = f + g := rfl +@[simp, norm_cast] lemma coe_mul (f g : centroid_hom α) : ⇑(f * g) = f ∘ g := rfl +-- Eligible for `dsimp` +@[simp, norm_cast, nolint simp_nf] lemma coe_nsmul (f : centroid_hom α) (n : ℕ) : + ⇑(n • f) = n • f := rfl + +@[simp] lemma zero_apply (a : α) : (0 : centroid_hom α) a = 0 := rfl +@[simp] lemma one_apply (a : α) : (1 : centroid_hom α) a = a := rfl +@[simp] lemma add_apply (f g : centroid_hom α) (a : α) : (f + g) a = f a + g a := rfl +@[simp] lemma mul_apply (f g : centroid_hom α) (a : α) : (f * g) a = f (g a) := rfl +-- Eligible for `dsimp` +@[simp, nolint simp_nf] +lemma nsmul_apply (f : centroid_hom α) (n : ℕ) (a : α) : (n • f) a = n • f a := rfl + +@[simp] lemma to_End_zero : (0 : centroid_hom α).to_End = 0 := rfl +@[simp] lemma to_End_add (x y : centroid_hom α) : (x + y).to_End = x.to_End + y.to_End := rfl +lemma to_End_nsmul (x : centroid_hom α) (n : ℕ) : (n • x).to_End = n • x.to_End := rfl + +-- cf.`add_monoid_hom.add_comm_monoid` +instance : add_comm_monoid (centroid_hom α) := +coe_to_add_monoid_hom_injective.add_comm_monoid _ to_End_zero to_End_add to_End_nsmul + +instance : has_nat_cast (centroid_hom α) := +{ nat_cast := λ n, n • 1 } + +@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ⇑(n : centroid_hom α) = n • id := rfl + +lemma nat_cast_apply (n : ℕ) (m : α): + (n : centroid_hom α) m = n • m := rfl + +@[simp] lemma to_End_one : (1 : centroid_hom α).to_End = 1 := rfl +@[simp] lemma to_End_mul (x y : centroid_hom α) : (x * y).to_End = x.to_End * y.to_End := rfl +@[simp] lemma to_End_pow (x : centroid_hom α) (n : ℕ) : (x ^ n).to_End = x.to_End ^ n := +by { ext, refl } +@[simp, norm_cast] lemma to_End_nat_cast (n : ℕ) : (n : centroid_hom α).to_End = ↑n := rfl + +-- cf `add_monoid.End.semiring` +instance : semiring (centroid_hom α) := +to_End_injective.semiring _ to_End_zero to_End_one to_End_add to_End_mul + to_End_nsmul to_End_pow to_End_nat_cast + +lemma comp_mul_comm (T S : centroid_hom α) (a b : α) : (T ∘ S) (a * b) = (S ∘ T) (a * b) := +by rw [comp_app, map_mul_right, map_mul_left, ←map_mul_right, ←map_mul_left] + +end non_unital_non_assoc_semiring + +section non_unital_non_assoc_ring +variables [non_unital_non_assoc_ring α] + +/-- Negation of `centroid_hom`s as a `centroid_hom`. -/ +instance : has_neg (centroid_hom α) := +⟨λ f, + { map_mul_left' := by simp [map_mul_left], + map_mul_right' := by simp [map_mul_right], + .. (-f : α →+ α) }⟩ +instance : has_sub (centroid_hom α) := +⟨λ f g, +{ map_mul_left' := λ a b, by simp [map_mul_left, mul_sub], + map_mul_right' := λ a b, by simp [map_mul_right, sub_mul], + .. (f - g : α →+ α) }⟩ + +instance has_zsmul : has_smul ℤ (centroid_hom α) := +⟨λ n f, + { map_mul_left' := λ a b, + by { change n • f (a * b) = a * n • f b, rw [map_mul_left f, ←mul_smul_comm] }, + map_mul_right' := λ a b, + by { change n • f (a * b) = n • f a * b, rw [map_mul_right f, ←smul_mul_assoc] }, + .. (n • f : α →+ α) }⟩ + +instance : has_int_cast (centroid_hom α) := +{ int_cast := λ z, z • 1 } + +@[simp, norm_cast] lemma coe_int_cast (z : ℤ) : ⇑(z : centroid_hom α) = z • id := rfl + +lemma int_cast_apply (z : ℤ) (m : α) : + (z : centroid_hom α) m = z • m := rfl + +@[simp] lemma to_End_neg (x : centroid_hom α) : (-x).to_End = -x.to_End := rfl +@[simp] lemma to_End_sub (x y : centroid_hom α) : (x - y).to_End = x.to_End - y.to_End := rfl +lemma to_End_zsmul (x : centroid_hom α) (n : ℤ) : (n • x).to_End = n • x.to_End := rfl + +instance : add_comm_group (centroid_hom α) := +to_End_injective.add_comm_group _ to_End_zero to_End_add to_End_neg to_End_sub + to_End_nsmul to_End_zsmul + + +@[simp, norm_cast] lemma coe_neg (f : centroid_hom α) : ⇑(-f) = -f := rfl +@[simp, norm_cast] lemma coe_sub (f g : centroid_hom α) : ⇑(f - g) = f - g := rfl + +@[simp] lemma neg_apply (f : centroid_hom α) (a : α) : (-f) a = - f a := rfl +@[simp] lemma sub_apply (f g : centroid_hom α) (a : α) : (f - g) a = f a - g a := rfl + +@[simp, norm_cast] lemma to_End_int_cast (z : ℤ) : (z : centroid_hom α).to_End = ↑z := rfl + +instance : ring (centroid_hom α) := to_End_injective.ring _ to_End_zero to_End_one + to_End_add to_End_mul to_End_neg to_End_sub to_End_nsmul to_End_zsmul + to_End_pow to_End_nat_cast to_End_int_cast + +end non_unital_non_assoc_ring + +section non_unital_ring +variables [non_unital_ring α] + +/-- A prime associative ring has commutative centroid. -/ +@[reducible] -- See note [reducible non instances] +def comm_ring (h : ∀ a b : α, (∀ r : α, a * r * b = 0) → a = 0 ∨ b = 0) : + comm_ring (centroid_hom α) := +{ mul_comm := λ f g, begin + ext, + refine sub_eq_zero.1 ((or_self _).1 $ h _ _ $ λ r, _), + rw [mul_assoc, sub_mul, sub_eq_zero, ← map_mul_right, ← map_mul_right, coe_mul, coe_mul, + comp_mul_comm], + end, + ..centroid_hom.ring } + +end non_unital_ring +end centroid_hom diff --git a/src/algebra/hom/commute.lean b/src/algebra/hom/commute.lean new file mode 100644 index 0000000000000..24e71649ed215 --- /dev/null +++ b/src/algebra/hom/commute.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2018 Patrick Massot. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes, + Johannes Hölzl, Yury Kudryashov +-/ +import algebra.hom.group +import algebra.group.commute + +/-! +# Multiplicative homomorphisms respect semiconjugation and commutation. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +section commute + +variables {F M N : Type*} [has_mul M] [has_mul N] {a x y : M} + +@[simp, to_additive] +protected lemma semiconj_by.map [mul_hom_class F M N] (h : semiconj_by a x y) (f : F) : + semiconj_by (f a) (f x) (f y) := +by simpa only [semiconj_by, map_mul] using congr_arg f h + +@[simp, to_additive] +protected lemma commute.map [mul_hom_class F M N] (h : commute x y) (f : F) : + commute (f x) (f y) := +h.map f + +end commute diff --git a/src/algebra/hom/embedding.lean b/src/algebra/hom/embedding.lean new file mode 100644 index 0000000000000..77d654ca61879 --- /dev/null +++ b/src/algebra/hom/embedding.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2021 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import algebra.group.defs +import logic.embedding.basic + +/-! +# The embedding of a cancellative semigroup into itself by multiplication by a fixed element. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {R : Type*} + +section left_or_right_cancel_semigroup + +/-- +The embedding of a left cancellative semigroup into itself +by left multiplication by a fixed element. + -/ +@[to_additive + "The embedding of a left cancellative additive semigroup into itself + by left translation by a fixed element.", simps] +def mul_left_embedding {G : Type*} [left_cancel_semigroup G] (g : G) : G ↪ G := +{ to_fun := λ h, g * h, inj' := mul_right_injective g } + +/-- +The embedding of a right cancellative semigroup into itself +by right multiplication by a fixed element. + -/ +@[to_additive + "The embedding of a right cancellative additive semigroup into itself + by right translation by a fixed element.", simps] +def mul_right_embedding {G : Type*} [right_cancel_semigroup G] (g : G) : G ↪ G := +{ to_fun := λ h, h * g, inj' := mul_left_injective g } + +@[to_additive] +lemma mul_left_embedding_eq_mul_right_embedding {G : Type*} [cancel_comm_monoid G] (g : G) : + mul_left_embedding g = mul_right_embedding g := +by { ext, exact mul_comm _ _ } + +end left_or_right_cancel_semigroup diff --git a/src/algebra/hom/equiv.lean b/src/algebra/hom/equiv.lean deleted file mode 100644 index 37b8d917598e1..0000000000000 --- a/src/algebra/hom/equiv.lean +++ /dev/null @@ -1,736 +0,0 @@ -/- -Copyright (c) 2018 Johannes Hölzl. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov --/ -import algebra.group.type_tags -import algebra.group_with_zero.basic -import data.pi.algebra - -/-! -# Multiplicative and additive equivs - -In this file we define two extensions of `equiv` called `add_equiv` and `mul_equiv`, which are -datatypes representing isomorphisms of `add_monoid`s/`add_group`s and `monoid`s/`group`s. - -## Notations - -* ``infix ` ≃* `:25 := mul_equiv`` -* ``infix ` ≃+ `:25 := add_equiv`` - -The extended equivs all have coercions to functions, and the coercions are the canonical -notation when treating the isomorphisms as maps. - -## Implementation notes - -The fields for `mul_equiv`, `add_equiv` now avoid the unbundled `is_mul_hom` and `is_add_hom`, as -these are deprecated. - -## Tags - -equiv, mul_equiv, add_equiv --/ - -variables {F α β A B M N P Q G H : Type*} - -/-- Makes a multiplicative inverse from a bijection which preserves multiplication. -/ -@[to_additive "Makes an additive inverse from a bijection which preserves addition."] -def mul_hom.inverse [has_mul M] [has_mul N] (f : M →ₙ* N) (g : N → M) - (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : N →ₙ* M := -{ to_fun := g, - map_mul' := λ x y, - calc g (x * y) = g (f (g x) * f (g y)) : by rw [h₂ x, h₂ y] - ... = g (f (g x * g y)) : by rw f.map_mul - ... = g x * g y : h₁ _, } - -/-- The inverse of a bijective `monoid_hom` is a `monoid_hom`. -/ -@[to_additive "The inverse of a bijective `add_monoid_hom` is an `add_monoid_hom`.", simps] -def monoid_hom.inverse {A B : Type*} [monoid A] [monoid B] (f : A →* B) (g : B → A) - (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : - B →* A := -{ to_fun := g, - map_one' := by rw [← f.map_one, h₁], - .. (f : A →ₙ* B).inverse g h₁ h₂, } - -set_option old_structure_cmd true - -/-- add_equiv α β is the type of an equiv α ≃ β which preserves addition. -/ -@[ancestor equiv add_hom] -structure add_equiv (A B : Type*) [has_add A] [has_add B] extends A ≃ B, add_hom A B - -/-- `add_equiv_class F A B` states that `F` is a type of addition-preserving morphisms. -You should extend this class when you extend `add_equiv`. -/ -class add_equiv_class (F A B : Type*) [has_add A] [has_add B] - extends equiv_like F A B := -(map_add : ∀ (f : F) a b, f (a + b) = f a + f b) - -/-- The `equiv` underlying an `add_equiv`. -/ -add_decl_doc add_equiv.to_equiv -/-- The `add_hom` underlying a `add_equiv`. -/ -add_decl_doc add_equiv.to_add_hom - -/-- `mul_equiv α β` is the type of an equiv `α ≃ β` which preserves multiplication. -/ -@[ancestor equiv mul_hom, to_additive] -structure mul_equiv (M N : Type*) [has_mul M] [has_mul N] extends M ≃ N, M →ₙ* N - -/-- The `equiv` underlying a `mul_equiv`. -/ -add_decl_doc mul_equiv.to_equiv -/-- The `mul_hom` underlying a `mul_equiv`. -/ -add_decl_doc mul_equiv.to_mul_hom - -/-- `mul_equiv_class F A B` states that `F` is a type of multiplication-preserving morphisms. -You should extend this class when you extend `mul_equiv`. -/ -@[to_additive] -class mul_equiv_class (F A B : Type*) [has_mul A] [has_mul B] - extends equiv_like F A B := -(map_mul : ∀ (f : F) a b, f (a * b) = f a * f b) - -infix ` ≃* `:25 := mul_equiv -infix ` ≃+ `:25 := add_equiv - -namespace mul_equiv_class -variables (F) - -@[priority 100, -- See note [lower instance priority] - to_additive] -instance [has_mul M] [has_mul N] [h : mul_equiv_class F M N] : mul_hom_class F M N := -{ coe := (coe : F → M → N), - coe_injective' := @fun_like.coe_injective F _ _ _, - .. h } - -@[priority 100, -- See note [lower instance priority] - to_additive] -instance [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] : - monoid_hom_class F M N := -{ coe := (coe : F → M → N), - map_one := λ e, - calc e 1 = e 1 * 1 : (mul_one _).symm - ... = e 1 * e (inv e (1 : N) : M) : congr_arg _ (right_inv e 1).symm - ... = e (inv e (1 : N)) : by rw [← map_mul, one_mul] - ... = 1 : right_inv e 1, - .. mul_equiv_class.mul_hom_class F } - -@[priority 100] -- See note [lower instance priority] -instance to_monoid_with_zero_hom_class {α β : Type*} [mul_zero_one_class α] - [mul_zero_one_class β] [mul_equiv_class F α β] : monoid_with_zero_hom_class F α β := -{ map_zero := λ e, calc e 0 = e 0 * e (equiv_like.inv e 0) : by rw [←map_mul, zero_mul] - ... = 0 : by { convert mul_zero _, exact equiv_like.right_inv e _ } - ..mul_equiv_class.monoid_hom_class _ } - -variables {F} - -@[simp, to_additive] -lemma map_eq_one_iff {M N} [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] - (h : F) {x : M} : h x = 1 ↔ x = 1 := -map_eq_one_iff h (equiv_like.injective h) - -@[to_additive] -lemma map_ne_one_iff {M N} [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] - (h : F) {x : M} : - h x ≠ 1 ↔ x ≠ 1 := -map_ne_one_iff h (equiv_like.injective h) - -end mul_equiv_class - -@[to_additive] instance [has_mul α] [has_mul β] [mul_equiv_class F α β] : has_coe_t F (α ≃* β) := -⟨λ f, { to_fun := f, inv_fun := equiv_like.inv f, left_inv := equiv_like.left_inv f, - right_inv := equiv_like.right_inv f, map_mul' := map_mul f }⟩ - -namespace mul_equiv - -@[to_additive] -instance [has_mul M] [has_mul N] : has_coe_to_fun (M ≃* N) (λ _, M → N) := ⟨mul_equiv.to_fun⟩ - -@[to_additive] -instance [has_mul M] [has_mul N] : mul_equiv_class (M ≃* N) M N := -{ coe := to_fun, inv := inv_fun, left_inv := left_inv, right_inv := right_inv, - coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' }, - map_mul := map_mul' } - -variables [has_mul M] [has_mul N] [has_mul P] [has_mul Q] - -@[simp, to_additive] -lemma to_equiv_eq_coe (f : M ≃* N) : f.to_equiv = f := rfl - -@[simp, to_additive] -lemma to_fun_eq_coe {f : M ≃* N} : f.to_fun = f := rfl - -@[simp, to_additive] -lemma coe_to_equiv {f : M ≃* N} : ⇑(f : M ≃ N) = f := rfl - -@[simp, to_additive] -lemma coe_to_mul_hom {f : M ≃* N} : ⇑f.to_mul_hom = f := rfl - -/-- A multiplicative isomorphism preserves multiplication. -/ -@[to_additive "An additive isomorphism preserves addition."] -protected lemma map_mul (f : M ≃* N) : ∀ x y, f (x * y) = f x * f y := map_mul f - -/-- Makes a multiplicative isomorphism from a bijection which preserves multiplication. -/ -@[to_additive "Makes an additive isomorphism from a bijection which preserves addition."] -def mk' (f : M ≃ N) (h : ∀ x y, f (x * y) = f x * f y) : M ≃* N := -⟨f.1, f.2, f.3, f.4, h⟩ - -@[to_additive] -protected lemma bijective (e : M ≃* N) : function.bijective e := equiv_like.bijective e - -@[to_additive] -protected lemma injective (e : M ≃* N) : function.injective e := equiv_like.injective e - -@[to_additive] -protected lemma surjective (e : M ≃* N) : function.surjective e := equiv_like.surjective e - -/-- The identity map is a multiplicative isomorphism. -/ -@[refl, to_additive "The identity map is an additive isomorphism."] -def refl (M : Type*) [has_mul M] : M ≃* M := -{ map_mul' := λ _ _, rfl, -..equiv.refl _} - -@[to_additive] -instance : inhabited (M ≃* M) := ⟨refl M⟩ - -/-- The inverse of an isomorphism is an isomorphism. -/ -@[symm, to_additive "The inverse of an isomorphism is an isomorphism."] -def symm (h : M ≃* N) : N ≃* M := -{ map_mul' := (h.to_mul_hom.inverse h.to_equiv.symm h.left_inv h.right_inv).map_mul, - .. h.to_equiv.symm} - -@[simp, to_additive] -lemma inv_fun_eq_symm {f : M ≃* N} : f.inv_fun = f.symm := rfl - -/-- See Note [custom simps projection] -/ --- we don't hyperlink the note in the additive version, since that breaks syntax highlighting --- in the whole file. -@[to_additive "See Note custom simps projection"] -def simps.symm_apply (e : M ≃* N) : N → M := e.symm - -initialize_simps_projections add_equiv (to_fun → apply, inv_fun → symm_apply) -initialize_simps_projections mul_equiv (to_fun → apply, inv_fun → symm_apply) - -@[simp, to_additive] -theorem to_equiv_symm (f : M ≃* N) : f.symm.to_equiv = f.to_equiv.symm := rfl - -@[simp, to_additive] -theorem coe_mk (f : M → N) (g h₁ h₂ h₃) : ⇑(mul_equiv.mk f g h₁ h₂ h₃) = f := rfl - -@[simp, to_additive] -lemma to_equiv_mk (f : M → N) (g : N → M) (h₁ h₂ h₃) : - (mk f g h₁ h₂ h₃).to_equiv = ⟨f, g, h₁, h₂⟩ := rfl - -@[simp, to_additive] -lemma symm_symm : ∀ (f : M ≃* N), f.symm.symm = f -| ⟨f, g, h₁, h₂, h₃⟩ := rfl - -@[to_additive] -lemma symm_bijective : function.bijective (symm : (M ≃* N) → (N ≃* M)) := -equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩ - -@[simp, to_additive] -theorem symm_mk (f : M → N) (g h₁ h₂ h₃) : - (mul_equiv.mk f g h₁ h₂ h₃).symm = - { to_fun := g, inv_fun := f, ..(mul_equiv.mk f g h₁ h₂ h₃).symm} := rfl - -@[simp, to_additive] -theorem refl_symm : (refl M).symm = refl M := rfl - -/-- Transitivity of multiplication-preserving isomorphisms -/ -@[trans, to_additive "Transitivity of addition-preserving isomorphisms"] -def trans (h1 : M ≃* N) (h2 : N ≃* P) : (M ≃* P) := -{ map_mul' := λ x y, show h2 (h1 (x * y)) = h2 (h1 x) * h2 (h1 y), - by rw [h1.map_mul, h2.map_mul], - ..h1.to_equiv.trans h2.to_equiv } - -/-- `e.symm` is a right inverse of `e`, written as `e (e.symm y) = y`. -/ -@[simp, to_additive "`e.symm` is a right inverse of `e`, written as `e (e.symm y) = y`."] -lemma apply_symm_apply (e : M ≃* N) (y : N) : e (e.symm y) = y := -e.to_equiv.apply_symm_apply y - -/-- `e.symm` is a left inverse of `e`, written as `e.symm (e y) = y`. -/ -@[simp, to_additive "`e.symm` is a left inverse of `e`, written as `e.symm (e y) = y`."] -lemma symm_apply_apply (e : M ≃* N) (x : M) : e.symm (e x) = x := -e.to_equiv.symm_apply_apply x - -@[simp, to_additive] -theorem symm_comp_self (e : M ≃* N) : e.symm ∘ e = id := funext e.symm_apply_apply - -@[simp, to_additive] -theorem self_comp_symm (e : M ≃* N) : e ∘ e.symm = id := funext e.apply_symm_apply - -@[simp, to_additive] -theorem coe_refl : ⇑(refl M) = id := rfl - -@[simp, to_additive] -theorem refl_apply (m : M) : refl M m = m := rfl - -@[simp, to_additive] -theorem coe_trans (e₁ : M ≃* N) (e₂ : N ≃* P) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl - -@[simp, to_additive] -theorem trans_apply (e₁ : M ≃* N) (e₂ : N ≃* P) (m : M) : e₁.trans e₂ m = e₂ (e₁ m) := rfl - -@[simp, to_additive] theorem symm_trans_apply (e₁ : M ≃* N) (e₂ : N ≃* P) (p : P) : - (e₁.trans e₂).symm p = e₁.symm (e₂.symm p) := rfl - -@[simp, to_additive] theorem apply_eq_iff_eq (e : M ≃* N) {x y : M} : e x = e y ↔ x = y := -e.injective.eq_iff - -@[to_additive] -lemma apply_eq_iff_symm_apply (e : M ≃* N) {x : M} {y : N} : e x = y ↔ x = e.symm y := -e.to_equiv.apply_eq_iff_eq_symm_apply - -@[to_additive] -lemma symm_apply_eq (e : M ≃* N) {x y} : e.symm x = y ↔ x = e y := -e.to_equiv.symm_apply_eq - -@[to_additive] -lemma eq_symm_apply (e : M ≃* N) {x y} : y = e.symm x ↔ e y = x := -e.to_equiv.eq_symm_apply - -@[to_additive] lemma eq_comp_symm {α : Type*} (e : M ≃* N) (f : N → α) (g : M → α) : - f = g ∘ e.symm ↔ f ∘ e = g := e.to_equiv.eq_comp_symm f g - -@[to_additive] lemma comp_symm_eq {α : Type*} (e : M ≃* N) (f : N → α) (g : M → α) : - g ∘ e.symm = f ↔ g = f ∘ e := e.to_equiv.comp_symm_eq f g - -@[to_additive] lemma eq_symm_comp {α : Type*} (e : M ≃* N) (f : α → M) (g : α → N) : - f = e.symm ∘ g ↔ e ∘ f = g := e.to_equiv.eq_symm_comp f g - -@[to_additive] lemma symm_comp_eq {α : Type*} (e : M ≃* N) (f : α → M) (g : α → N) : - e.symm ∘ g = f ↔ g = e ∘ f := e.to_equiv.symm_comp_eq f g - -/-- Two multiplicative isomorphisms agree if they are defined by the - same underlying function. -/ -@[ext, to_additive - "Two additive isomorphisms agree if they are defined by the same underlying function."] -lemma ext {f g : mul_equiv M N} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h - -@[to_additive] lemma ext_iff {f g : mul_equiv M N} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff - -@[simp, to_additive] lemma mk_coe (e : M ≃* N) (e' h₁ h₂ h₃) : - (⟨e, e', h₁, h₂, h₃⟩ : M ≃* N) = e := ext $ λ _, rfl - -@[simp, to_additive] lemma mk_coe' (e : M ≃* N) (f h₁ h₂ h₃) : - (mul_equiv.mk f ⇑e h₁ h₂ h₃ : N ≃* M) = e.symm := -symm_bijective.injective $ ext $ λ x, rfl - -@[to_additive] protected lemma congr_arg {f : mul_equiv M N} {x x' : M} : x = x' → f x = f x' := -fun_like.congr_arg f - -@[to_additive] protected lemma congr_fun {f g : mul_equiv M N} (h : f = g) (x : M) : f x = g x := -fun_like.congr_fun h x - -/-- The `mul_equiv` between two monoids with a unique element. -/ -@[to_additive "The `add_equiv` between two add_monoids with a unique element."] -def mul_equiv_of_unique_of_unique {M N} - [unique M] [unique N] [has_mul M] [has_mul N] : M ≃* N := -{ map_mul' := λ _ _, subsingleton.elim _ _, - ..equiv_of_unique_of_unique } - -/-- There is a unique monoid homomorphism between two monoids with a unique element. -/ -@[to_additive - "There is a unique additive monoid homomorphism between two additive monoids with -a unique element."] -instance {M N} [unique M] [unique N] [has_mul M] [has_mul N] : unique (M ≃* N) := -{ default := mul_equiv_of_unique_of_unique , - uniq := λ _, ext $ λ x, subsingleton.elim _ _} - -/-! -## Monoids --/ - -/-- A multiplicative isomorphism of monoids sends `1` to `1` (and is hence a monoid isomorphism). -/ -@[to_additive "An additive isomorphism of additive monoids sends `0` to `0` -(and is hence an additive monoid isomorphism)."] -protected lemma map_one {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) : h 1 = 1 := -map_one h - -@[to_additive] -protected lemma map_eq_one_iff {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) {x : M} : - h x = 1 ↔ x = 1 := -mul_equiv_class.map_eq_one_iff h - -@[to_additive] -lemma map_ne_one_iff {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) {x : M} : - h x ≠ 1 ↔ x ≠ 1 := -mul_equiv_class.map_ne_one_iff h - -/-- A bijective `semigroup` homomorphism is an isomorphism -/ -@[to_additive "A bijective `add_semigroup` homomorphism is an isomorphism"] -noncomputable def of_bijective {M N F} [has_mul M] [has_mul N] [mul_hom_class F M N] (f : F) - (hf : function.bijective f) : M ≃* N := -{ map_mul' := map_mul f, - ..equiv.of_bijective f hf } - -/-- -Extract the forward direction of a multiplicative equivalence -as a multiplication-preserving function. --/ -@[to_additive "Extract the forward direction of an additive equivalence -as an addition-preserving function."] -def to_monoid_hom {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) : (M →* N) := -{ map_one' := h.map_one, .. h } - -@[simp, to_additive] -lemma coe_to_monoid_hom {M N} [mul_one_class M] [mul_one_class N] (e : M ≃* N) : - ⇑e.to_monoid_hom = e := -rfl - -@[to_additive] lemma to_monoid_hom_injective {M N} [mul_one_class M] [mul_one_class N] : - function.injective (to_monoid_hom : (M ≃* N) → M →* N) := -λ f g h, mul_equiv.ext (monoid_hom.ext_iff.1 h) - - -/-- -A multiplicative analogue of `equiv.arrow_congr`, -where the equivalence between the targets is multiplicative. --/ -@[to_additive "An additive analogue of `equiv.arrow_congr`, -where the equivalence between the targets is additive.", simps apply] -def arrow_congr {M N P Q : Type*} [has_mul P] [has_mul Q] - (f : M ≃ N) (g : P ≃* Q) : (M → P) ≃* (N → Q) := -{ to_fun := λ h n, g (h (f.symm n)), - inv_fun := λ k m, g.symm (k (f m)), - left_inv := λ h, by { ext, simp, }, - right_inv := λ k, by { ext, simp, }, - map_mul' := λ h k, by { ext, simp, }, } - -/-- -A multiplicative analogue of `equiv.arrow_congr`, -for multiplicative maps from a monoid to a commutative monoid. --/ -@[to_additive "An additive analogue of `equiv.arrow_congr`, -for additive maps from an additive monoid to a commutative additive monoid.", simps apply] -def monoid_hom_congr {M N P Q} [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q] - (f : M ≃* N) (g : P ≃* Q) : (M →* P) ≃* (N →* Q) := -{ to_fun := λ h, - g.to_monoid_hom.comp (h.comp f.symm.to_monoid_hom), - inv_fun := λ k, - g.symm.to_monoid_hom.comp (k.comp f.to_monoid_hom), - left_inv := λ h, by { ext, simp, }, - right_inv := λ k, by { ext, simp, }, - map_mul' := λ h k, by { ext, simp, }, } - -/-- A family of multiplicative equivalences `Π j, (Ms j ≃* Ns j)` generates a -multiplicative equivalence between `Π j, Ms j` and `Π j, Ns j`. - -This is the `mul_equiv` version of `equiv.Pi_congr_right`, and the dependent version of -`mul_equiv.arrow_congr`. --/ -@[to_additive add_equiv.Pi_congr_right "A family of additive equivalences `Π j, (Ms j ≃+ Ns j)` -generates an additive equivalence between `Π j, Ms j` and `Π j, Ns j`. - -This is the `add_equiv` version of `equiv.Pi_congr_right`, and the dependent version of -`add_equiv.arrow_congr`.", simps apply] -def Pi_congr_right {η : Type*} - {Ms Ns : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)] - (es : ∀ j, Ms j ≃* Ns j) : (Π j, Ms j) ≃* (Π j, Ns j) := -{ to_fun := λ x j, es j (x j), - inv_fun := λ x j, (es j).symm (x j), - map_mul' := λ x y, funext $ λ j, (es j).map_mul (x j) (y j), - .. equiv.Pi_congr_right (λ j, (es j).to_equiv) } - -@[simp] -lemma Pi_congr_right_refl {η : Type*} {Ms : η → Type*} [Π j, has_mul (Ms j)] : - Pi_congr_right (λ j, mul_equiv.refl (Ms j)) = mul_equiv.refl _ := rfl - -@[simp] -lemma Pi_congr_right_symm {η : Type*} - {Ms Ns : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)] - (es : ∀ j, Ms j ≃* Ns j) : (Pi_congr_right es).symm = (Pi_congr_right $ λ i, (es i).symm) := rfl - -@[simp] -lemma Pi_congr_right_trans {η : Type*} - {Ms Ns Ps : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)] - [Π j, has_mul (Ps j)] - (es : ∀ j, Ms j ≃* Ns j) (fs : ∀ j, Ns j ≃* Ps j) : - (Pi_congr_right es).trans (Pi_congr_right fs) = (Pi_congr_right $ λ i, (es i).trans (fs i)) := rfl - -/-- A family indexed by a nonempty subsingleton type is equivalent to the element at the single -index. -/ -@[to_additive add_equiv.Pi_subsingleton "A family indexed by a nonempty subsingleton type is -equivalent to the element at the single index.", simps] -def Pi_subsingleton - {ι : Type*} (M : ι → Type*) [Π j, has_mul (M j)] [subsingleton ι] (i : ι) : - (Π j, M j) ≃* M i := -{ map_mul' := λ f1 f2, pi.mul_apply _ _ _, ..equiv.Pi_subsingleton M i } - -/-! -# Groups --/ - -/-- A multiplicative equivalence of groups preserves inversion. -/ -@[to_additive "An additive equivalence of additive groups preserves negation."] -protected lemma map_inv [group G] [group H] (h : G ≃* H) (x : G) : h x⁻¹ = (h x)⁻¹ := -map_inv h x - -/-- A multiplicative equivalence of groups preserves division. -/ -@[to_additive "An additive equivalence of additive groups preserves subtractions."] -protected lemma map_div [group G] [group H] (h : G ≃* H) (x y : G) : h (x / y) = h x / h y := -map_div h x y - -end mul_equiv - -/-- Given a pair of monoid homomorphisms `f`, `g` such that `g.comp f = id` and `f.comp g = id`, -returns an multiplicative equivalence with `to_fun = f` and `inv_fun = g`. This constructor is -useful if the underlying type(s) have specialized `ext` lemmas for monoid homomorphisms. -/ -@[to_additive /-"Given a pair of additive monoid homomorphisms `f`, `g` such that `g.comp f = id` -and `f.comp g = id`, returns an additive equivalence with `to_fun = f` and `inv_fun = g`. This -constructor is useful if the underlying type(s) have specialized `ext` lemmas for additive -monoid homomorphisms."-/, simps {fully_applied := ff}] -def monoid_hom.to_mul_equiv [mul_one_class M] [mul_one_class N] (f : M →* N) (g : N →* M) - (h₁ : g.comp f = monoid_hom.id _) (h₂ : f.comp g = monoid_hom.id _) : - M ≃* N := -{ to_fun := f, - inv_fun := g, - left_inv := monoid_hom.congr_fun h₁, - right_inv := monoid_hom.congr_fun h₂, - map_mul' := f.map_mul } - -/-- A group is isomorphic to its group of units. -/ -@[to_additive "An additive group is isomorphic to its group of additive units"] -def to_units [group G] : G ≃* Gˣ := -{ to_fun := λ x, ⟨x, x⁻¹, mul_inv_self _, inv_mul_self _⟩, - inv_fun := coe, - left_inv := λ x, rfl, - right_inv := λ u, units.ext rfl, - map_mul' := λ x y, units.ext rfl } - -@[simp, to_additive] lemma coe_to_units [group G] (g : G) : - (to_units g : G) = g := rfl - -@[to_additive] -protected lemma group.is_unit {G} [group G] (x : G) : is_unit x := (to_units x).is_unit - -namespace units - -@[simp, to_additive] lemma coe_inv [group G] (u : Gˣ) : - ↑u⁻¹ = (u⁻¹ : G) := -to_units.symm.map_inv u - -variables [monoid M] [monoid N] [monoid P] - -/-- A multiplicative equivalence of monoids defines a multiplicative equivalence -of their groups of units. -/ -def map_equiv (h : M ≃* N) : Mˣ ≃* Nˣ := -{ inv_fun := map h.symm.to_monoid_hom, - left_inv := λ u, ext $ h.left_inv u, - right_inv := λ u, ext $ h.right_inv u, - .. map h.to_monoid_hom } - -/-- Left multiplication by a unit of a monoid is a permutation of the underlying type. -/ -@[to_additive "Left addition of an additive unit is a permutation of the underlying type.", - simps apply {fully_applied := ff}] -def mul_left (u : Mˣ) : equiv.perm M := -{ to_fun := λx, u * x, - inv_fun := λx, ↑u⁻¹ * x, - left_inv := u.inv_mul_cancel_left, - right_inv := u.mul_inv_cancel_left } - -@[simp, to_additive] -lemma mul_left_symm (u : Mˣ) : u.mul_left.symm = u⁻¹.mul_left := -equiv.ext $ λ x, rfl - -@[to_additive] -lemma mul_left_bijective (a : Mˣ) : function.bijective ((*) a : M → M) := -(mul_left a).bijective - -/-- Right multiplication by a unit of a monoid is a permutation of the underlying type. -/ -@[to_additive "Right addition of an additive unit is a permutation of the underlying type.", - simps apply {fully_applied := ff}] -def mul_right (u : Mˣ) : equiv.perm M := -{ to_fun := λx, x * u, - inv_fun := λx, x * ↑u⁻¹, - left_inv := λ x, mul_inv_cancel_right x u, - right_inv := λ x, inv_mul_cancel_right x u } - -@[simp, to_additive] -lemma mul_right_symm (u : Mˣ) : u.mul_right.symm = u⁻¹.mul_right := -equiv.ext $ λ x, rfl - -@[to_additive] -lemma mul_right_bijective (a : Mˣ) : function.bijective ((* a) : M → M) := -(mul_right a).bijective - -end units - -namespace equiv - -section has_involutive_neg - -variables (G) [has_involutive_inv G] - -/-- Inversion on a `group` or `group_with_zero` is a permutation of the underlying type. -/ -@[to_additive "Negation on an `add_group` is a permutation of the underlying type.", - simps apply {fully_applied := ff}] -protected def inv : perm G := inv_involutive.to_perm _ - -variable {G} - -@[simp, to_additive] -lemma inv_symm : (equiv.inv G).symm = equiv.inv G := rfl - -end has_involutive_neg - -section group -variables [group G] - -/-- Left multiplication in a `group` is a permutation of the underlying type. -/ -@[to_additive "Left addition in an `add_group` is a permutation of the underlying type."] -protected def mul_left (a : G) : perm G := (to_units a).mul_left - -@[simp, to_additive] -lemma coe_mul_left (a : G) : ⇑(equiv.mul_left a) = (*) a := rfl - -/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/ -@[simp, nolint simp_nf, - to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."] -lemma mul_left_symm_apply (a : G) : ((equiv.mul_left a).symm : G → G) = (*) a⁻¹ := rfl - -@[simp, to_additive] -lemma mul_left_symm (a : G) : (equiv.mul_left a).symm = equiv.mul_left a⁻¹ := -ext $ λ x, rfl - -@[to_additive] -lemma _root_.group.mul_left_bijective (a : G) : function.bijective ((*) a) := -(equiv.mul_left a).bijective - -/-- Right multiplication in a `group` is a permutation of the underlying type. -/ -@[to_additive "Right addition in an `add_group` is a permutation of the underlying type."] -protected def mul_right (a : G) : perm G := (to_units a).mul_right - -@[simp, to_additive] -lemma coe_mul_right (a : G) : ⇑(equiv.mul_right a) = λ x, x * a := rfl - -@[simp, to_additive] -lemma mul_right_symm (a : G) : (equiv.mul_right a).symm = equiv.mul_right a⁻¹ := -ext $ λ x, rfl - -/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/ -@[simp, nolint simp_nf, - to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."] -lemma mul_right_symm_apply (a : G) : ((equiv.mul_right a).symm : G → G) = λ x, x * a⁻¹ := rfl - -@[to_additive] -lemma _root_.group.mul_right_bijective (a : G) : function.bijective (* a) := -(equiv.mul_right a).bijective - -/-- A version of `equiv.mul_left a b⁻¹` that is defeq to `a / b`. -/ -@[to_additive /-" A version of `equiv.add_left a (-b)` that is defeq to `a - b`. "-/, simps] -protected def div_left (a : G) : G ≃ G := -{ to_fun := λ b, a / b, - inv_fun := λ b, b⁻¹ * a, - left_inv := λ b, by simp [div_eq_mul_inv], - right_inv := λ b, by simp [div_eq_mul_inv] } - -@[to_additive] -lemma div_left_eq_inv_trans_mul_left (a : G) : - equiv.div_left a = (equiv.inv G).trans (equiv.mul_left a) := -ext $ λ _, div_eq_mul_inv _ _ - -/-- A version of `equiv.mul_right a⁻¹ b` that is defeq to `b / a`. -/ -@[to_additive /-" A version of `equiv.add_right (-a) b` that is defeq to `b - a`. "-/, simps] -protected def div_right (a : G) : G ≃ G := -{ to_fun := λ b, b / a, - inv_fun := λ b, b * a, - left_inv := λ b, by simp [div_eq_mul_inv], - right_inv := λ b, by simp [div_eq_mul_inv] } - -@[to_additive] -lemma div_right_eq_mul_right_inv (a : G) : equiv.div_right a = equiv.mul_right a⁻¹ := -ext $ λ _, div_eq_mul_inv _ _ - -end group - -section group_with_zero -variables [group_with_zero G] - -/-- Left multiplication by a nonzero element in a `group_with_zero` is a permutation of the -underlying type. -/ -@[simps {fully_applied := ff}] -protected def mul_left₀ (a : G) (ha : a ≠ 0) : perm G := -(units.mk0 a ha).mul_left - -lemma _root_.mul_left_bijective₀ (a : G) (ha : a ≠ 0) : - function.bijective ((*) a : G → G) := -(equiv.mul_left₀ a ha).bijective - -/-- Right multiplication by a nonzero element in a `group_with_zero` is a permutation of the -underlying type. -/ -@[simps {fully_applied := ff}] -protected def mul_right₀ (a : G) (ha : a ≠ 0) : perm G := -(units.mk0 a ha).mul_right - -lemma _root_.mul_right_bijective₀ (a : G) (ha : a ≠ 0) : - function.bijective ((* a) : G → G) := -(equiv.mul_right₀ a ha).bijective - -end group_with_zero - -end equiv - -/-- When the group is commutative, `equiv.inv` is a `mul_equiv`. There is a variant of this -`mul_equiv.inv' G : G ≃* Gᵐᵒᵖ` for the non-commutative case. -/ -@[to_additive "When the `add_group` is commutative, `equiv.neg` is an `add_equiv`."] -def mul_equiv.inv (G : Type*) [comm_group G] : G ≃* G := -{ to_fun := has_inv.inv, - inv_fun := has_inv.inv, - map_mul' := mul_inv, - ..equiv.inv G } - -/-- When the group with zero is commutative, `equiv.inv₀` is a `mul_equiv`. -/ -@[simps apply] def mul_equiv.inv₀ (G : Type*) [comm_group_with_zero G] : G ≃* G := -{ to_fun := has_inv.inv, - inv_fun := has_inv.inv, - map_mul' := λ x y, mul_inv₀, - ..equiv.inv G } - -@[simp] lemma mul_equiv.inv₀_symm (G : Type*) [comm_group_with_zero G] : - (mul_equiv.inv₀ G).symm = mul_equiv.inv₀ G := rfl - -section type_tags - -/-- Reinterpret `G ≃+ H` as `multiplicative G ≃* multiplicative H`. -/ -def add_equiv.to_multiplicative [add_zero_class G] [add_zero_class H] : - (G ≃+ H) ≃ (multiplicative G ≃* multiplicative H) := -{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative, - f.symm.to_add_monoid_hom.to_multiplicative, f.3, f.4, f.5⟩, - inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩, - left_inv := λ x, by { ext, refl, }, - right_inv := λ x, by { ext, refl, }, } - -/-- Reinterpret `G ≃* H` as `additive G ≃+ additive H`. -/ -def mul_equiv.to_additive [mul_one_class G] [mul_one_class H] : - (G ≃* H) ≃ (additive G ≃+ additive H) := -{ to_fun := λ f, ⟨f.to_monoid_hom.to_additive, f.symm.to_monoid_hom.to_additive, f.3, f.4, f.5⟩, - inv_fun := λ f, ⟨f.to_add_monoid_hom, f.symm.to_add_monoid_hom, f.3, f.4, f.5⟩, - left_inv := λ x, by { ext, refl, }, - right_inv := λ x, by { ext, refl, }, } - -/-- Reinterpret `additive G ≃+ H` as `G ≃* multiplicative H`. -/ -def add_equiv.to_multiplicative' [mul_one_class G] [add_zero_class H] : - (additive G ≃+ H) ≃ (G ≃* multiplicative H) := -{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative', - f.symm.to_add_monoid_hom.to_multiplicative'', f.3, f.4, f.5⟩, - inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩, - left_inv := λ x, by { ext, refl, }, - right_inv := λ x, by { ext, refl, }, } - -/-- Reinterpret `G ≃* multiplicative H` as `additive G ≃+ H` as. -/ -def mul_equiv.to_additive' [mul_one_class G] [add_zero_class H] : - (G ≃* multiplicative H) ≃ (additive G ≃+ H) := -add_equiv.to_multiplicative'.symm - -/-- Reinterpret `G ≃+ additive H` as `multiplicative G ≃* H`. -/ -def add_equiv.to_multiplicative'' [add_zero_class G] [mul_one_class H] : - (G ≃+ additive H) ≃ (multiplicative G ≃* H) := -{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative'', - f.symm.to_add_monoid_hom.to_multiplicative', f.3, f.4, f.5⟩, - inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩, - left_inv := λ x, by { ext, refl, }, - right_inv := λ x, by { ext, refl, }, } - -/-- Reinterpret `multiplicative G ≃* H` as `G ≃+ additive H` as. -/ -def mul_equiv.to_additive'' [add_zero_class G] [mul_one_class H] : - (multiplicative G ≃* H) ≃ (G ≃+ additive H) := -add_equiv.to_multiplicative''.symm - -end type_tags diff --git a/src/algebra/hom/equiv/basic.lean b/src/algebra/hom/equiv/basic.lean new file mode 100644 index 0000000000000..6a616f42e7923 --- /dev/null +++ b/src/algebra/hom/equiv/basic.lean @@ -0,0 +1,549 @@ +/- +Copyright (c) 2018 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov +-/ +import algebra.hom.group +import data.fun_like.equiv +import logic.equiv.basic +import data.pi.algebra + +/-! +# Multiplicative and additive equivs + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define two extensions of `equiv` called `add_equiv` and `mul_equiv`, which are +datatypes representing isomorphisms of `add_monoid`s/`add_group`s and `monoid`s/`group`s. + +## Notations + +* ``infix ` ≃* `:25 := mul_equiv`` +* ``infix ` ≃+ `:25 := add_equiv`` + +The extended equivs all have coercions to functions, and the coercions are the canonical +notation when treating the isomorphisms as maps. + +## Implementation notes + +The fields for `mul_equiv`, `add_equiv` now avoid the unbundled `is_mul_hom` and `is_add_hom`, as +these are deprecated. + +## Tags + +equiv, mul_equiv, add_equiv +-/ + +variables {F α β A B M N P Q G H : Type*} + +/-- Makes a multiplicative inverse from a bijection which preserves multiplication. -/ +@[to_additive "Makes an additive inverse from a bijection which preserves addition."] +def mul_hom.inverse [has_mul M] [has_mul N] (f : M →ₙ* N) (g : N → M) + (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : N →ₙ* M := +{ to_fun := g, + map_mul' := λ x y, + calc g (x * y) = g (f (g x) * f (g y)) : by rw [h₂ x, h₂ y] + ... = g (f (g x * g y)) : by rw f.map_mul + ... = g x * g y : h₁ _, } + +/-- The inverse of a bijective `monoid_hom` is a `monoid_hom`. -/ +@[to_additive "The inverse of a bijective `add_monoid_hom` is an `add_monoid_hom`.", simps] +def monoid_hom.inverse {A B : Type*} [monoid A] [monoid B] (f : A →* B) (g : B → A) + (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : + B →* A := +{ to_fun := g, + map_one' := by rw [← f.map_one, h₁], + .. (f : A →ₙ* B).inverse g h₁ h₂, } + +set_option old_structure_cmd true + +/-- add_equiv α β is the type of an equiv α ≃ β which preserves addition. -/ +@[ancestor equiv add_hom] +structure add_equiv (A B : Type*) [has_add A] [has_add B] extends A ≃ B, add_hom A B + +/-- `add_equiv_class F A B` states that `F` is a type of addition-preserving morphisms. +You should extend this class when you extend `add_equiv`. -/ +class add_equiv_class (F A B : Type*) [has_add A] [has_add B] + extends equiv_like F A B := +(map_add : ∀ (f : F) a b, f (a + b) = f a + f b) + +/-- The `equiv` underlying an `add_equiv`. -/ +add_decl_doc add_equiv.to_equiv +/-- The `add_hom` underlying a `add_equiv`. -/ +add_decl_doc add_equiv.to_add_hom + +/-- `mul_equiv α β` is the type of an equiv `α ≃ β` which preserves multiplication. -/ +@[ancestor equiv mul_hom, to_additive] +structure mul_equiv (M N : Type*) [has_mul M] [has_mul N] extends M ≃ N, M →ₙ* N + +/-- The `equiv` underlying a `mul_equiv`. -/ +add_decl_doc mul_equiv.to_equiv +/-- The `mul_hom` underlying a `mul_equiv`. -/ +add_decl_doc mul_equiv.to_mul_hom + +/-- `mul_equiv_class F A B` states that `F` is a type of multiplication-preserving morphisms. +You should extend this class when you extend `mul_equiv`. -/ +@[to_additive] +class mul_equiv_class (F A B : Type*) [has_mul A] [has_mul B] + extends equiv_like F A B := +(map_mul : ∀ (f : F) a b, f (a * b) = f a * f b) + +infix ` ≃* `:25 := mul_equiv +infix ` ≃+ `:25 := add_equiv + +namespace mul_equiv_class +variables (F) + +@[priority 100, -- See note [lower instance priority] + to_additive] +instance [has_mul M] [has_mul N] [h : mul_equiv_class F M N] : mul_hom_class F M N := +{ coe := (coe : F → M → N), + coe_injective' := @fun_like.coe_injective F _ _ _, + .. h } + +@[priority 100, -- See note [lower instance priority] + to_additive] +instance [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] : + monoid_hom_class F M N := +{ coe := (coe : F → M → N), + map_one := λ e, + calc e 1 = e 1 * 1 : (mul_one _).symm + ... = e 1 * e (inv e (1 : N) : M) : congr_arg _ (right_inv e 1).symm + ... = e (inv e (1 : N)) : by rw [← map_mul, one_mul] + ... = 1 : right_inv e 1, + .. mul_equiv_class.mul_hom_class F } + +@[priority 100] -- See note [lower instance priority] +instance to_monoid_with_zero_hom_class {α β : Type*} [mul_zero_one_class α] + [mul_zero_one_class β] [mul_equiv_class F α β] : monoid_with_zero_hom_class F α β := +{ map_zero := λ e, calc e 0 = e 0 * e (equiv_like.inv e 0) : by rw [←map_mul, zero_mul] + ... = 0 : by { convert mul_zero _, exact equiv_like.right_inv e _ } + ..mul_equiv_class.monoid_hom_class _ } + +variables {F} + +@[simp, to_additive] +lemma map_eq_one_iff {M N} [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] + (h : F) {x : M} : h x = 1 ↔ x = 1 := +map_eq_one_iff h (equiv_like.injective h) + +@[to_additive] +lemma map_ne_one_iff {M N} [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] + (h : F) {x : M} : + h x ≠ 1 ↔ x ≠ 1 := +map_ne_one_iff h (equiv_like.injective h) + +end mul_equiv_class + +@[to_additive] instance [has_mul α] [has_mul β] [mul_equiv_class F α β] : has_coe_t F (α ≃* β) := +⟨λ f, { to_fun := f, inv_fun := equiv_like.inv f, left_inv := equiv_like.left_inv f, + right_inv := equiv_like.right_inv f, map_mul' := map_mul f }⟩ + +namespace mul_equiv + +@[to_additive] +instance [has_mul M] [has_mul N] : has_coe_to_fun (M ≃* N) (λ _, M → N) := ⟨mul_equiv.to_fun⟩ + +@[to_additive] +instance [has_mul M] [has_mul N] : mul_equiv_class (M ≃* N) M N := +{ coe := to_fun, inv := inv_fun, left_inv := left_inv, right_inv := right_inv, + coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' }, + map_mul := map_mul' } + +variables [has_mul M] [has_mul N] [has_mul P] [has_mul Q] + +@[simp, to_additive] +lemma to_equiv_eq_coe (f : M ≃* N) : f.to_equiv = f := rfl + +@[simp, to_additive] +lemma to_fun_eq_coe {f : M ≃* N} : f.to_fun = f := rfl + +@[simp, to_additive] +lemma coe_to_equiv {f : M ≃* N} : ⇑(f : M ≃ N) = f := rfl + +@[simp, to_additive] +lemma coe_to_mul_hom {f : M ≃* N} : ⇑f.to_mul_hom = f := rfl + +/-- A multiplicative isomorphism preserves multiplication. -/ +@[to_additive "An additive isomorphism preserves addition."] +protected lemma map_mul (f : M ≃* N) : ∀ x y, f (x * y) = f x * f y := map_mul f + +/-- Makes a multiplicative isomorphism from a bijection which preserves multiplication. -/ +@[to_additive "Makes an additive isomorphism from a bijection which preserves addition."] +def mk' (f : M ≃ N) (h : ∀ x y, f (x * y) = f x * f y) : M ≃* N := +⟨f.1, f.2, f.3, f.4, h⟩ + +@[to_additive] +protected lemma bijective (e : M ≃* N) : function.bijective e := equiv_like.bijective e + +@[to_additive] +protected lemma injective (e : M ≃* N) : function.injective e := equiv_like.injective e + +@[to_additive] +protected lemma surjective (e : M ≃* N) : function.surjective e := equiv_like.surjective e + +/-- The identity map is a multiplicative isomorphism. -/ +@[refl, to_additive "The identity map is an additive isomorphism."] +def refl (M : Type*) [has_mul M] : M ≃* M := +{ map_mul' := λ _ _, rfl, +..equiv.refl _} + +@[to_additive] +instance : inhabited (M ≃* M) := ⟨refl M⟩ + +/-- The inverse of an isomorphism is an isomorphism. -/ +@[symm, to_additive "The inverse of an isomorphism is an isomorphism."] +def symm (h : M ≃* N) : N ≃* M := +{ map_mul' := (h.to_mul_hom.inverse h.to_equiv.symm h.left_inv h.right_inv).map_mul, + .. h.to_equiv.symm} + +@[simp, to_additive] +lemma inv_fun_eq_symm {f : M ≃* N} : f.inv_fun = f.symm := rfl + +/-- See Note [custom simps projection] -/ +-- we don't hyperlink the note in the additive version, since that breaks syntax highlighting +-- in the whole file. +@[to_additive "See Note custom simps projection"] +def simps.symm_apply (e : M ≃* N) : N → M := e.symm + +initialize_simps_projections add_equiv (to_fun → apply, inv_fun → symm_apply) +initialize_simps_projections mul_equiv (to_fun → apply, inv_fun → symm_apply) + +@[simp, to_additive] +theorem to_equiv_symm (f : M ≃* N) : f.symm.to_equiv = f.to_equiv.symm := rfl + +@[simp, to_additive] +theorem coe_mk (f : M → N) (g h₁ h₂ h₃) : ⇑(mul_equiv.mk f g h₁ h₂ h₃) = f := rfl + +@[simp, to_additive] +lemma to_equiv_mk (f : M → N) (g : N → M) (h₁ h₂ h₃) : + (mk f g h₁ h₂ h₃).to_equiv = ⟨f, g, h₁, h₂⟩ := rfl + +@[simp, to_additive] +lemma symm_symm : ∀ (f : M ≃* N), f.symm.symm = f +| ⟨f, g, h₁, h₂, h₃⟩ := rfl + +@[to_additive] +lemma symm_bijective : function.bijective (symm : (M ≃* N) → (N ≃* M)) := +equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩ + +@[simp, to_additive] +theorem symm_mk (f : M → N) (g h₁ h₂ h₃) : + (mul_equiv.mk f g h₁ h₂ h₃).symm = + { to_fun := g, inv_fun := f, ..(mul_equiv.mk f g h₁ h₂ h₃).symm} := rfl + +@[simp, to_additive] +theorem refl_symm : (refl M).symm = refl M := rfl + +/-- Transitivity of multiplication-preserving isomorphisms -/ +@[trans, to_additive "Transitivity of addition-preserving isomorphisms"] +def trans (h1 : M ≃* N) (h2 : N ≃* P) : (M ≃* P) := +{ map_mul' := λ x y, show h2 (h1 (x * y)) = h2 (h1 x) * h2 (h1 y), + by rw [h1.map_mul, h2.map_mul], + ..h1.to_equiv.trans h2.to_equiv } + +/-- `e.symm` is a right inverse of `e`, written as `e (e.symm y) = y`. -/ +@[simp, to_additive "`e.symm` is a right inverse of `e`, written as `e (e.symm y) = y`."] +lemma apply_symm_apply (e : M ≃* N) (y : N) : e (e.symm y) = y := +e.to_equiv.apply_symm_apply y + +/-- `e.symm` is a left inverse of `e`, written as `e.symm (e y) = y`. -/ +@[simp, to_additive "`e.symm` is a left inverse of `e`, written as `e.symm (e y) = y`."] +lemma symm_apply_apply (e : M ≃* N) (x : M) : e.symm (e x) = x := +e.to_equiv.symm_apply_apply x + +@[simp, to_additive] +theorem symm_comp_self (e : M ≃* N) : e.symm ∘ e = id := funext e.symm_apply_apply + +@[simp, to_additive] +theorem self_comp_symm (e : M ≃* N) : e ∘ e.symm = id := funext e.apply_symm_apply + +@[simp, to_additive] +theorem coe_refl : ⇑(refl M) = id := rfl + +@[simp, to_additive] +theorem refl_apply (m : M) : refl M m = m := rfl + +@[simp, to_additive] +theorem coe_trans (e₁ : M ≃* N) (e₂ : N ≃* P) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl + +@[simp, to_additive] +theorem trans_apply (e₁ : M ≃* N) (e₂ : N ≃* P) (m : M) : e₁.trans e₂ m = e₂ (e₁ m) := rfl + +@[simp, to_additive] theorem symm_trans_apply (e₁ : M ≃* N) (e₂ : N ≃* P) (p : P) : + (e₁.trans e₂).symm p = e₁.symm (e₂.symm p) := rfl + +@[simp, to_additive] theorem apply_eq_iff_eq (e : M ≃* N) {x y : M} : e x = e y ↔ x = y := +e.injective.eq_iff + +@[to_additive] +lemma apply_eq_iff_symm_apply (e : M ≃* N) {x : M} {y : N} : e x = y ↔ x = e.symm y := +e.to_equiv.apply_eq_iff_eq_symm_apply + +@[to_additive] +lemma symm_apply_eq (e : M ≃* N) {x y} : e.symm x = y ↔ x = e y := +e.to_equiv.symm_apply_eq + +@[to_additive] +lemma eq_symm_apply (e : M ≃* N) {x y} : y = e.symm x ↔ e y = x := +e.to_equiv.eq_symm_apply + +@[to_additive] lemma eq_comp_symm {α : Type*} (e : M ≃* N) (f : N → α) (g : M → α) : + f = g ∘ e.symm ↔ f ∘ e = g := e.to_equiv.eq_comp_symm f g + +@[to_additive] lemma comp_symm_eq {α : Type*} (e : M ≃* N) (f : N → α) (g : M → α) : + g ∘ e.symm = f ↔ g = f ∘ e := e.to_equiv.comp_symm_eq f g + +@[to_additive] lemma eq_symm_comp {α : Type*} (e : M ≃* N) (f : α → M) (g : α → N) : + f = e.symm ∘ g ↔ e ∘ f = g := e.to_equiv.eq_symm_comp f g + +@[to_additive] lemma symm_comp_eq {α : Type*} (e : M ≃* N) (f : α → M) (g : α → N) : + e.symm ∘ g = f ↔ g = e ∘ f := e.to_equiv.symm_comp_eq f g + +@[simp, to_additive] +theorem symm_trans_self (e : M ≃* N) : e.symm.trans e = refl N := +fun_like.ext _ _ e.apply_symm_apply + +@[simp, to_additive] +theorem self_trans_symm (e : M ≃* N) : e.trans e.symm = refl M := +fun_like.ext _ _ e.symm_apply_apply + +@[simp, to_additive] lemma coe_monoid_hom_refl {M} [mul_one_class M] : + (refl M : M →* M) = monoid_hom.id M := rfl + +@[simp, to_additive] lemma coe_monoid_hom_trans {M N P} + [mul_one_class M] [mul_one_class N] [mul_one_class P] (e₁ : M ≃* N) (e₂ : N ≃* P) : + (e₁.trans e₂ : M →* P) = (e₂ : N →* P).comp ↑e₁ := +rfl + +/-- Two multiplicative isomorphisms agree if they are defined by the + same underlying function. -/ +@[ext, to_additive + "Two additive isomorphisms agree if they are defined by the same underlying function."] +lemma ext {f g : mul_equiv M N} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h + +@[to_additive] lemma ext_iff {f g : mul_equiv M N} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff + +@[simp, to_additive] lemma mk_coe (e : M ≃* N) (e' h₁ h₂ h₃) : + (⟨e, e', h₁, h₂, h₃⟩ : M ≃* N) = e := ext $ λ _, rfl + +@[simp, to_additive] lemma mk_coe' (e : M ≃* N) (f h₁ h₂ h₃) : + (mul_equiv.mk f ⇑e h₁ h₂ h₃ : N ≃* M) = e.symm := +symm_bijective.injective $ ext $ λ x, rfl + +@[to_additive] protected lemma congr_arg {f : mul_equiv M N} {x x' : M} : x = x' → f x = f x' := +fun_like.congr_arg f + +@[to_additive] protected lemma congr_fun {f g : mul_equiv M N} (h : f = g) (x : M) : f x = g x := +fun_like.congr_fun h x + +/-- The `mul_equiv` between two monoids with a unique element. -/ +@[to_additive "The `add_equiv` between two add_monoids with a unique element."] +def mul_equiv_of_unique {M N} + [unique M] [unique N] [has_mul M] [has_mul N] : M ≃* N := +{ map_mul' := λ _ _, subsingleton.elim _ _, + ..equiv.equiv_of_unique M N } + +/-- There is a unique monoid homomorphism between two monoids with a unique element. -/ +@[to_additive + "There is a unique additive monoid homomorphism between two additive monoids with +a unique element."] +instance {M N} [unique M] [unique N] [has_mul M] [has_mul N] : unique (M ≃* N) := +{ default := mul_equiv_of_unique , + uniq := λ _, ext $ λ x, subsingleton.elim _ _} + +/-! +## Monoids +-/ + +/-- A multiplicative isomorphism of monoids sends `1` to `1` (and is hence a monoid isomorphism). -/ +@[to_additive "An additive isomorphism of additive monoids sends `0` to `0` +(and is hence an additive monoid isomorphism)."] +protected lemma map_one {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) : h 1 = 1 := +map_one h + +@[to_additive] +protected lemma map_eq_one_iff {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) {x : M} : + h x = 1 ↔ x = 1 := +mul_equiv_class.map_eq_one_iff h + +@[to_additive] +lemma map_ne_one_iff {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) {x : M} : + h x ≠ 1 ↔ x ≠ 1 := +mul_equiv_class.map_ne_one_iff h + +/-- A bijective `semigroup` homomorphism is an isomorphism -/ +@[to_additive "A bijective `add_semigroup` homomorphism is an isomorphism", simps apply] +noncomputable def of_bijective {M N F} [has_mul M] [has_mul N] [mul_hom_class F M N] (f : F) + (hf : function.bijective f) : M ≃* N := +{ map_mul' := map_mul f, + ..equiv.of_bijective f hf } + +@[simp] +lemma of_bijective_apply_symm_apply {M N} [mul_one_class M] [mul_one_class N] {n : N} (f : M →* N) + (hf : function.bijective f) : f ((equiv.of_bijective f hf).symm n) = n := +(mul_equiv.of_bijective f hf).apply_symm_apply n + +/-- +Extract the forward direction of a multiplicative equivalence +as a multiplication-preserving function. +-/ +@[to_additive "Extract the forward direction of an additive equivalence +as an addition-preserving function."] +def to_monoid_hom {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) : (M →* N) := +{ map_one' := h.map_one, .. h } + +@[simp, to_additive] +lemma coe_to_monoid_hom {M N} [mul_one_class M] [mul_one_class N] (e : M ≃* N) : + ⇑e.to_monoid_hom = e := +rfl + +@[to_additive] lemma to_monoid_hom_injective {M N} [mul_one_class M] [mul_one_class N] : + function.injective (to_monoid_hom : (M ≃* N) → M →* N) := +λ f g h, mul_equiv.ext (monoid_hom.ext_iff.1 h) + + +/-- +A multiplicative analogue of `equiv.arrow_congr`, +where the equivalence between the targets is multiplicative. +-/ +@[to_additive "An additive analogue of `equiv.arrow_congr`, +where the equivalence between the targets is additive.", simps apply] +def arrow_congr {M N P Q : Type*} [has_mul P] [has_mul Q] + (f : M ≃ N) (g : P ≃* Q) : (M → P) ≃* (N → Q) := +{ to_fun := λ h n, g (h (f.symm n)), + inv_fun := λ k m, g.symm (k (f m)), + left_inv := λ h, by { ext, simp, }, + right_inv := λ k, by { ext, simp, }, + map_mul' := λ h k, by { ext, simp, }, } + +/-- +A multiplicative analogue of `equiv.arrow_congr`, +for multiplicative maps from a monoid to a commutative monoid. +-/ +@[to_additive "An additive analogue of `equiv.arrow_congr`, +for additive maps from an additive monoid to a commutative additive monoid.", simps apply] +def monoid_hom_congr {M N P Q} [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q] + (f : M ≃* N) (g : P ≃* Q) : (M →* P) ≃* (N →* Q) := +{ to_fun := λ h, + g.to_monoid_hom.comp (h.comp f.symm.to_monoid_hom), + inv_fun := λ k, + g.symm.to_monoid_hom.comp (k.comp f.to_monoid_hom), + left_inv := λ h, by { ext, simp, }, + right_inv := λ k, by { ext, simp, }, + map_mul' := λ h k, by { ext, simp, }, } + +/-- A family of multiplicative equivalences `Π j, (Ms j ≃* Ns j)` generates a +multiplicative equivalence between `Π j, Ms j` and `Π j, Ns j`. + +This is the `mul_equiv` version of `equiv.Pi_congr_right`, and the dependent version of +`mul_equiv.arrow_congr`. +-/ +@[to_additive add_equiv.Pi_congr_right "A family of additive equivalences `Π j, (Ms j ≃+ Ns j)` +generates an additive equivalence between `Π j, Ms j` and `Π j, Ns j`. + +This is the `add_equiv` version of `equiv.Pi_congr_right`, and the dependent version of +`add_equiv.arrow_congr`.", simps apply] +def Pi_congr_right {η : Type*} + {Ms Ns : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)] + (es : ∀ j, Ms j ≃* Ns j) : (Π j, Ms j) ≃* (Π j, Ns j) := +{ to_fun := λ x j, es j (x j), + inv_fun := λ x j, (es j).symm (x j), + map_mul' := λ x y, funext $ λ j, (es j).map_mul (x j) (y j), + .. equiv.Pi_congr_right (λ j, (es j).to_equiv) } + +@[simp, to_additive] +lemma Pi_congr_right_refl {η : Type*} {Ms : η → Type*} [Π j, has_mul (Ms j)] : + Pi_congr_right (λ j, mul_equiv.refl (Ms j)) = mul_equiv.refl _ := rfl + +@[simp, to_additive] +lemma Pi_congr_right_symm {η : Type*} + {Ms Ns : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)] + (es : ∀ j, Ms j ≃* Ns j) : (Pi_congr_right es).symm = (Pi_congr_right $ λ i, (es i).symm) := rfl + +@[simp, to_additive] +lemma Pi_congr_right_trans {η : Type*} + {Ms Ns Ps : η → Type*} [Π j, has_mul (Ms j)] [Π j, has_mul (Ns j)] + [Π j, has_mul (Ps j)] + (es : ∀ j, Ms j ≃* Ns j) (fs : ∀ j, Ns j ≃* Ps j) : + (Pi_congr_right es).trans (Pi_congr_right fs) = (Pi_congr_right $ λ i, (es i).trans (fs i)) := rfl + +/-- A family indexed by a nonempty subsingleton type is equivalent to the element at the single +index. -/ +@[to_additive add_equiv.Pi_subsingleton "A family indexed by a nonempty subsingleton type is +equivalent to the element at the single index.", simps] +def Pi_subsingleton + {ι : Type*} (M : ι → Type*) [Π j, has_mul (M j)] [subsingleton ι] (i : ι) : + (Π j, M j) ≃* M i := +{ map_mul' := λ f1 f2, pi.mul_apply _ _ _, ..equiv.Pi_subsingleton M i } + +/-! +# Groups +-/ + +/-- A multiplicative equivalence of groups preserves inversion. -/ +@[to_additive "An additive equivalence of additive groups preserves negation."] +protected lemma map_inv [group G] [division_monoid H] (h : G ≃* H) (x : G) : h x⁻¹ = (h x)⁻¹ := +map_inv h x + +/-- A multiplicative equivalence of groups preserves division. -/ +@[to_additive "An additive equivalence of additive groups preserves subtractions."] +protected lemma map_div [group G] [division_monoid H] (h : G ≃* H) (x y : G) : + h (x / y) = h x / h y := +map_div h x y + +end mul_equiv + +/-- Given a pair of multiplicative homomorphisms `f`, `g` such that `g.comp f = id` and +`f.comp g = id`, returns an multiplicative equivalence with `to_fun = f` and `inv_fun = g`. This +constructor is useful if the underlying type(s) have specialized `ext` lemmas for multiplicative +homomorphisms. -/ +@[to_additive /-"Given a pair of additive homomorphisms `f`, `g` such that `g.comp f = id` and +`f.comp g = id`, returns an additive equivalence with `to_fun = f` and `inv_fun = g`. This +constructor is useful if the underlying type(s) have specialized `ext` lemmas for additive +homomorphisms."-/, simps {fully_applied := ff}] +def mul_hom.to_mul_equiv [has_mul M] [has_mul N] (f : M →ₙ* N) (g : N →ₙ* M) + (h₁ : g.comp f = mul_hom.id _) (h₂ : f.comp g = mul_hom.id _) : + M ≃* N := +{ to_fun := f, + inv_fun := g, + left_inv := mul_hom.congr_fun h₁, + right_inv := mul_hom.congr_fun h₂, + map_mul' := f.map_mul } + +/-- Given a pair of monoid homomorphisms `f`, `g` such that `g.comp f = id` and `f.comp g = id`, +returns an multiplicative equivalence with `to_fun = f` and `inv_fun = g`. This constructor is +useful if the underlying type(s) have specialized `ext` lemmas for monoid homomorphisms. -/ +@[to_additive /-"Given a pair of additive monoid homomorphisms `f`, `g` such that `g.comp f = id` +and `f.comp g = id`, returns an additive equivalence with `to_fun = f` and `inv_fun = g`. This +constructor is useful if the underlying type(s) have specialized `ext` lemmas for additive +monoid homomorphisms."-/, simps {fully_applied := ff}] +def monoid_hom.to_mul_equiv [mul_one_class M] [mul_one_class N] (f : M →* N) (g : N →* M) + (h₁ : g.comp f = monoid_hom.id _) (h₂ : f.comp g = monoid_hom.id _) : + M ≃* N := +{ to_fun := f, + inv_fun := g, + left_inv := monoid_hom.congr_fun h₁, + right_inv := monoid_hom.congr_fun h₂, + map_mul' := f.map_mul } + +namespace equiv + +section has_involutive_neg + +variables (G) [has_involutive_inv G] + +/-- Inversion on a `group` or `group_with_zero` is a permutation of the underlying type. -/ +@[to_additive "Negation on an `add_group` is a permutation of the underlying type.", + simps apply {fully_applied := ff}] +protected def inv : perm G := inv_involutive.to_perm _ + +variable {G} + +@[simp, to_additive] +lemma inv_symm : (equiv.inv G).symm = equiv.inv G := rfl + +end has_involutive_neg + +end equiv diff --git a/src/algebra/hom/equiv/type_tags.lean b/src/algebra/hom/equiv/type_tags.lean new file mode 100644 index 0000000000000..e08dd40f9a4fe --- /dev/null +++ b/src/algebra/hom/equiv/type_tags.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2018 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov +-/ +import algebra.hom.equiv.basic +import algebra.group.type_tags + +/-! +# Additive and multiplicative equivalences associated to `multiplicative` and `additive`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {G H : Type*} + +/-- Reinterpret `G ≃+ H` as `multiplicative G ≃* multiplicative H`. -/ +def add_equiv.to_multiplicative [add_zero_class G] [add_zero_class H] : + (G ≃+ H) ≃ (multiplicative G ≃* multiplicative H) := +{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative, + f.symm.to_add_monoid_hom.to_multiplicative, f.3, f.4, f.5⟩, + inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩, + left_inv := λ x, by { ext, refl, }, + right_inv := λ x, by { ext, refl, }, } + +/-- Reinterpret `G ≃* H` as `additive G ≃+ additive H`. -/ +def mul_equiv.to_additive [mul_one_class G] [mul_one_class H] : + (G ≃* H) ≃ (additive G ≃+ additive H) := +{ to_fun := λ f, ⟨f.to_monoid_hom.to_additive, f.symm.to_monoid_hom.to_additive, f.3, f.4, f.5⟩, + inv_fun := λ f, ⟨f.to_add_monoid_hom, f.symm.to_add_monoid_hom, f.3, f.4, f.5⟩, + left_inv := λ x, by { ext, refl, }, + right_inv := λ x, by { ext, refl, }, } + +/-- Reinterpret `additive G ≃+ H` as `G ≃* multiplicative H`. -/ +def add_equiv.to_multiplicative' [mul_one_class G] [add_zero_class H] : + (additive G ≃+ H) ≃ (G ≃* multiplicative H) := +{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative', + f.symm.to_add_monoid_hom.to_multiplicative'', f.3, f.4, f.5⟩, + inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩, + left_inv := λ x, by { ext, refl, }, + right_inv := λ x, by { ext, refl, }, } + +/-- Reinterpret `G ≃* multiplicative H` as `additive G ≃+ H` as. -/ +def mul_equiv.to_additive' [mul_one_class G] [add_zero_class H] : + (G ≃* multiplicative H) ≃ (additive G ≃+ H) := +add_equiv.to_multiplicative'.symm + +/-- Reinterpret `G ≃+ additive H` as `multiplicative G ≃* H`. -/ +def add_equiv.to_multiplicative'' [add_zero_class G] [mul_one_class H] : + (G ≃+ additive H) ≃ (multiplicative G ≃* H) := +{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative'', + f.symm.to_add_monoid_hom.to_multiplicative', f.3, f.4, f.5⟩, + inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩, + left_inv := λ x, by { ext, refl, }, + right_inv := λ x, by { ext, refl, }, } + +/-- Reinterpret `multiplicative G ≃* H` as `G ≃+ additive H` as. -/ +def mul_equiv.to_additive'' [add_zero_class G] [mul_one_class H] : + (multiplicative G ≃* H) ≃ (G ≃+ additive H) := +add_equiv.to_multiplicative''.symm + +section +variables (G) (H) + +/-- `additive (multiplicative G)` is just `G`. -/ +def add_equiv.additive_multiplicative [add_zero_class G] : additive (multiplicative G) ≃+ G := +mul_equiv.to_additive'' (mul_equiv.refl (multiplicative G)) + +/-- `multiplicative (additive H)` is just `H`. -/ +def mul_equiv.multiplicative_additive [mul_one_class H] : multiplicative (additive H) ≃* H := +add_equiv.to_multiplicative'' (add_equiv.refl (additive H)) + +end diff --git a/src/algebra/hom/equiv/units/basic.lean b/src/algebra/hom/equiv/units/basic.lean new file mode 100644 index 0000000000000..0b25b357a3777 --- /dev/null +++ b/src/algebra/hom/equiv/units/basic.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2018 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov +-/ +import algebra.hom.equiv.basic +import algebra.hom.units + +/-! +# Multiplicative and additive equivalence acting on units. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {F α β A B M N P Q G H : Type*} + +/-- A group is isomorphic to its group of units. -/ +@[to_additive "An additive group is isomorphic to its group of additive units"] +def to_units [group G] : G ≃* Gˣ := +{ to_fun := λ x, ⟨x, x⁻¹, mul_inv_self _, inv_mul_self _⟩, + inv_fun := coe, + left_inv := λ x, rfl, + right_inv := λ u, units.ext rfl, + map_mul' := λ x y, units.ext rfl } + +@[simp, to_additive] lemma coe_to_units [group G] (g : G) : + (to_units g : G) = g := rfl + +namespace units + +variables [monoid M] [monoid N] [monoid P] + +/-- A multiplicative equivalence of monoids defines a multiplicative equivalence +of their groups of units. -/ +def map_equiv (h : M ≃* N) : Mˣ ≃* Nˣ := +{ inv_fun := map h.symm.to_monoid_hom, + left_inv := λ u, ext $ h.left_inv u, + right_inv := λ u, ext $ h.right_inv u, + .. map h.to_monoid_hom } + +@[simp] +lemma map_equiv_symm (h : M ≃* N) : (map_equiv h).symm = map_equiv h.symm := +rfl + +@[simp] +lemma coe_map_equiv (h : M ≃* N) (x : Mˣ) : (map_equiv h x : N) = h x := +rfl + +/-- Left multiplication by a unit of a monoid is a permutation of the underlying type. -/ +@[to_additive "Left addition of an additive unit is a permutation of the underlying type.", + simps apply {fully_applied := ff}] +def mul_left (u : Mˣ) : equiv.perm M := +{ to_fun := λx, u * x, + inv_fun := λx, ↑u⁻¹ * x, + left_inv := u.inv_mul_cancel_left, + right_inv := u.mul_inv_cancel_left } + +@[simp, to_additive] +lemma mul_left_symm (u : Mˣ) : u.mul_left.symm = u⁻¹.mul_left := +equiv.ext $ λ x, rfl + +@[to_additive] +lemma mul_left_bijective (a : Mˣ) : function.bijective ((*) a : M → M) := +(mul_left a).bijective + +/-- Right multiplication by a unit of a monoid is a permutation of the underlying type. -/ +@[to_additive "Right addition of an additive unit is a permutation of the underlying type.", + simps apply {fully_applied := ff}] +def mul_right (u : Mˣ) : equiv.perm M := +{ to_fun := λx, x * u, + inv_fun := λx, x * ↑u⁻¹, + left_inv := λ x, mul_inv_cancel_right x u, + right_inv := λ x, inv_mul_cancel_right x u } + +@[simp, to_additive] +lemma mul_right_symm (u : Mˣ) : u.mul_right.symm = u⁻¹.mul_right := +equiv.ext $ λ x, rfl + +@[to_additive] +lemma mul_right_bijective (a : Mˣ) : function.bijective ((* a) : M → M) := +(mul_right a).bijective + +end units + +namespace equiv + +section group +variables [group G] + +/-- Left multiplication in a `group` is a permutation of the underlying type. -/ +@[to_additive "Left addition in an `add_group` is a permutation of the underlying type."] +protected def mul_left (a : G) : perm G := (to_units a).mul_left + +@[simp, to_additive] +lemma coe_mul_left (a : G) : ⇑(equiv.mul_left a) = (*) a := rfl + +/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/ +@[simp, nolint simp_nf, + to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."] +lemma mul_left_symm_apply (a : G) : ((equiv.mul_left a).symm : G → G) = (*) a⁻¹ := rfl + +@[simp, to_additive] +lemma mul_left_symm (a : G) : (equiv.mul_left a).symm = equiv.mul_left a⁻¹ := +ext $ λ x, rfl + +@[to_additive] +lemma _root_.group.mul_left_bijective (a : G) : function.bijective ((*) a) := +(equiv.mul_left a).bijective + +/-- Right multiplication in a `group` is a permutation of the underlying type. -/ +@[to_additive "Right addition in an `add_group` is a permutation of the underlying type."] +protected def mul_right (a : G) : perm G := (to_units a).mul_right + +@[simp, to_additive] +lemma coe_mul_right (a : G) : ⇑(equiv.mul_right a) = λ x, x * a := rfl + +@[simp, to_additive] +lemma mul_right_symm (a : G) : (equiv.mul_right a).symm = equiv.mul_right a⁻¹ := +ext $ λ x, rfl + +/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/ +@[simp, nolint simp_nf, + to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."] +lemma mul_right_symm_apply (a : G) : ((equiv.mul_right a).symm : G → G) = λ x, x * a⁻¹ := rfl + +@[to_additive] +lemma _root_.group.mul_right_bijective (a : G) : function.bijective (* a) := +(equiv.mul_right a).bijective + +/-- A version of `equiv.mul_left a b⁻¹` that is defeq to `a / b`. -/ +@[to_additive /-" A version of `equiv.add_left a (-b)` that is defeq to `a - b`. "-/, simps] +protected def div_left (a : G) : G ≃ G := +{ to_fun := λ b, a / b, + inv_fun := λ b, b⁻¹ * a, + left_inv := λ b, by simp [div_eq_mul_inv], + right_inv := λ b, by simp [div_eq_mul_inv] } + +@[to_additive] +lemma div_left_eq_inv_trans_mul_left (a : G) : + equiv.div_left a = (equiv.inv G).trans (equiv.mul_left a) := +ext $ λ _, div_eq_mul_inv _ _ + +/-- A version of `equiv.mul_right a⁻¹ b` that is defeq to `b / a`. -/ +@[to_additive /-" A version of `equiv.add_right (-a) b` that is defeq to `b - a`. "-/, simps] +protected def div_right (a : G) : G ≃ G := +{ to_fun := λ b, b / a, + inv_fun := λ b, b * a, + left_inv := λ b, by simp [div_eq_mul_inv], + right_inv := λ b, by simp [div_eq_mul_inv] } + +@[to_additive] +lemma div_right_eq_mul_right_inv (a : G) : equiv.div_right a = equiv.mul_right a⁻¹ := +ext $ λ _, div_eq_mul_inv _ _ + +end group + +end equiv + +/-- In a `division_comm_monoid`, `equiv.inv` is a `mul_equiv`. There is a variant of this +`mul_equiv.inv' G : G ≃* Gᵐᵒᵖ` for the non-commutative case. -/ +@[to_additive "When the `add_group` is commutative, `equiv.neg` is an `add_equiv`.", simps apply] +def mul_equiv.inv (G : Type*) [division_comm_monoid G] : G ≃* G := +{ to_fun := has_inv.inv, + inv_fun := has_inv.inv, + map_mul' := mul_inv, + ..equiv.inv G } + +@[simp] lemma mul_equiv.inv_symm (G : Type*) [division_comm_monoid G] : + (mul_equiv.inv G).symm = mul_equiv.inv G := rfl diff --git a/src/algebra/hom/equiv/units/group_with_zero.lean b/src/algebra/hom/equiv/units/group_with_zero.lean new file mode 100644 index 0000000000000..e0144e693d766 --- /dev/null +++ b/src/algebra/hom/equiv/units/group_with_zero.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2018 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov +-/ +import algebra.hom.equiv.units.basic +import algebra.group_with_zero.units.basic + +/-! +# Multiplication by a nonzero element in a `group_with_zero` is a permutation. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {G : Type*} + +namespace equiv + +section group_with_zero +variables [group_with_zero G] + +/-- Left multiplication by a nonzero element in a `group_with_zero` is a permutation of the +underlying type. -/ +@[simps {fully_applied := ff}] +protected def mul_left₀ (a : G) (ha : a ≠ 0) : perm G := +(units.mk0 a ha).mul_left + +lemma _root_.mul_left_bijective₀ (a : G) (ha : a ≠ 0) : + function.bijective ((*) a : G → G) := +(equiv.mul_left₀ a ha).bijective + +/-- Right multiplication by a nonzero element in a `group_with_zero` is a permutation of the +underlying type. -/ +@[simps {fully_applied := ff}] +protected def mul_right₀ (a : G) (ha : a ≠ 0) : perm G := +(units.mk0 a ha).mul_right + +lemma _root_.mul_right_bijective₀ (a : G) (ha : a ≠ 0) : + function.bijective ((* a) : G → G) := +(equiv.mul_right₀ a ha).bijective + +end group_with_zero + +end equiv diff --git a/src/algebra/hom/freiman.lean b/src/algebra/hom/freiman.lean index 8a68912793ea7..08a9903902c69 100644 --- a/src/algebra/hom/freiman.lean +++ b/src/algebra/hom/freiman.lean @@ -3,12 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import algebra.big_operators.multiset +import algebra.big_operators.multiset.basic import data.fun_like.basic /-! # Freiman homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define Freiman homomorphisms. A `n`-Freiman homomorphism on `A` is a function `f : α → β` such that `f (x₁) * ... * f (xₙ) = f (y₁) * ... * f (yₙ)` for all `x₁, ..., xₙ, y₁, ..., yₙ ∈ A` such that `x₁ * ... * xₙ = y₁ * ... * yₙ`. In particular, any @@ -66,13 +69,13 @@ structure freiman_hom (A : set α) (β : Type*) [comm_monoid α] [comm_monoid β (hs : s.card = n) (ht : t.card = n) (h : s.prod = t.prod) : (s.map to_fun).prod = (t.map to_fun).prod) -notation A ` →+[`:25 n:25 `] `:0 β:0 := add_freiman_hom A β n -notation A ` →*[`:25 n:25 `] `:0 β:0 := freiman_hom A β n +notation (name := add_freiman_hom) A ` →+[`:25 n:25 `] `:0 β:0 := add_freiman_hom A β n +notation (name := freiman_hom) A ` →*[`:25 n:25 `] `:0 β:0 := freiman_hom A β n /-- `add_freiman_hom_class F s β n` states that `F` is a type of `n`-ary sums-preserving morphisms. You should extend this class when you extend `add_freiman_hom`. -/ class add_freiman_hom_class (F : Type*) (A : out_param $ set α) (β : out_param $ Type*) - [add_comm_monoid α] [add_comm_monoid β] (n : ℕ) [fun_like F α (λ _, β)] := + [add_comm_monoid α] [add_comm_monoid β] (n : ℕ) [fun_like F α (λ _, β)] : Prop := (map_sum_eq_map_sum' (f : F) {s t : multiset α} (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A) (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A) (hs : s.card = n) (ht : t.card = n) (h : s.sum = t.sum) : (s.map f).sum = (t.map f).sum) @@ -83,7 +86,7 @@ You should extend this class when you extend `freiman_hom`. -/ "`add_freiman_hom_class F A β n` states that `F` is a type of `n`-ary sums-preserving morphisms. You should extend this class when you extend `add_freiman_hom`."] class freiman_hom_class (F : Type*) (A : out_param $ set α) (β : out_param $ Type*) [comm_monoid α] - [comm_monoid β] (n : ℕ) [fun_like F α (λ _, β)] := + [comm_monoid β] (n : ℕ) [fun_like F α (λ _, β)] : Prop := (map_prod_eq_map_prod' (f : F) {s t : multiset α} (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A) (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A) (hs : s.card = n) (ht : t.card = n) (h : s.prod = t.prod) : (s.map f).prod = (t.map f).prod) @@ -121,9 +124,10 @@ instance fun_like : fun_like (A →*[n] β) α (λ _, β) := instance freiman_hom_class : freiman_hom_class (A →*[n] β) A β n := { map_prod_eq_map_prod' := map_prod_eq_map_prod' } -/-- Helper instance for when there's too many metavariables to apply -`fun_like.has_coe_to_fun` directly. -/ -@[to_additive] +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +@[to_additive "Helper instance for when there's too many metavariables to apply +`fun_like.has_coe_to_fun` directly."] instance : has_coe_to_fun (A →*[n] β) (λ _, α → β) := ⟨to_fun⟩ initialize_simps_projections freiman_hom (to_fun → apply) @@ -195,7 +199,7 @@ ext $ λ x, rfl def const (A : set α) (n : ℕ) (b : β) : A →*[n] β := { to_fun := λ _, b, map_prod_eq_map_prod' := λ s t _ _ hs ht _, - by rw [multiset.map_const, multiset.map_const, prod_repeat, prod_repeat, hs, ht] } + by rw [multiset.map_const, multiset.map_const, prod_replicate, prod_replicate, hs, ht] } @[simp, to_additive] lemma const_apply (n : ℕ) (b : β) (x : α) : const A n b x = b := rfl @@ -232,7 +236,7 @@ Freiman homomorphism sending `x` to `-f x`."] instance : has_inv (A →*[n] G) := ⟨λ f, { to_fun := λ x, (f x)⁻¹, map_prod_eq_map_prod' := λ s t hsA htA hs ht h, - by rw [prod_map_inv', prod_map_inv', map_prod_eq_map_prod f hsA htA hs ht h] }⟩ + by rw [prod_map_inv, prod_map_inv, map_prod_eq_map_prod f hsA htA hs ht h] }⟩ @[simp, to_additive] lemma inv_apply (f : A →*[n] G) (x : α) : f⁻¹ x = (f x)⁻¹ := rfl @@ -340,7 +344,7 @@ begin rw [hs, ht] }, rw [←hs, card_pos_iff_exists_mem] at hm, obtain ⟨a, ha⟩ := hm, - suffices : ((s + repeat a (n - m)).map f).prod = ((t + repeat a (n - m)).map f).prod, + suffices : ((s + replicate (n - m) a).map f).prod = ((t + replicate (n - m) a).map f).prod, { simp_rw [multiset.map_add, prod_add] at this, exact mul_right_cancel this }, replace ha := hsA _ ha, @@ -348,12 +352,12 @@ begin rotate 2, assumption, -- Can't infer `A` and `n` from the context, so do it manually. { rw mem_add at hx, refine hx.elim (hsA _) (λ h, _), - rwa eq_of_mem_repeat h }, + rwa eq_of_mem_replicate h }, { rw mem_add at hx, refine hx.elim (htA _) (λ h, _), - rwa eq_of_mem_repeat h }, - { rw [card_add, hs, card_repeat, add_tsub_cancel_of_le h] }, - { rw [card_add, ht, card_repeat, add_tsub_cancel_of_le h] }, + rwa eq_of_mem_replicate h }, + { rw [card_add, hs, card_replicate, add_tsub_cancel_of_le h] }, + { rw [card_add, ht, card_replicate, add_tsub_cancel_of_le h] }, { rw [prod_add, prod_add, hst] } end @@ -368,7 +372,7 @@ def freiman_hom.to_freiman_hom (h : m ≤ n) (f : A →*[n] β) : A →*[m] β : /-- A `n`-Freiman homomorphism is also a `m`-Freiman homomorphism for any `m ≤ n`. -/ @[to_additive add_freiman_hom.add_freiman_hom_class_of_le "An additive `n`-Freiman homomorphism is also an additive `m`-Freiman homomorphism for any `m ≤ n`."] -def freiman_hom.freiman_hom_class_of_le [freiman_hom_class F A β n] (h : m ≤ n) : +lemma freiman_hom.freiman_hom_class_of_le [freiman_hom_class F A β n] (h : m ≤ n) : freiman_hom_class F A β m := { map_prod_eq_map_prod' := λ f s t hsA htA hs ht hst, map_prod_eq_map_prod_of_le f hsA htA hs ht hst h } diff --git a/src/algebra/hom/group.lean b/src/algebra/hom/group.lean index 8df94fc8fb90c..17cd97042d8a5 100644 --- a/src/algebra/hom/group.lean +++ b/src/algebra/hom/group.lean @@ -4,13 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes, Johannes Hölzl, Yury Kudryashov -/ -import algebra.group.commute +import algebra.ne_zero +import algebra.group.basic import algebra.group_with_zero.defs import data.fun_like.basic /-! # Monoid and group homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the bundled structures for monoid and group homomorphisms. Namely, we define `monoid_hom` (resp., `add_monoid_hom`) to be bundled homomorphisms between multiplicative (resp., additive) monoids or groups. @@ -58,7 +62,7 @@ monoid_hom, add_monoid_hom -/ -variables {M : Type*} {N : Type*} {P : Type*} -- monoids +variables {α β M N P : Type*} -- monoids variables {G : Type*} {H : Type*} -- groups variables {F : Type*} -- homs @@ -90,6 +94,17 @@ class zero_hom_class (F : Type*) (M N : out_param $ Type*) end zero +namespace ne_zero + +lemma of_map {R M} [has_zero R] [has_zero M] [zero_hom_class F R M] (f : F) {r : R} + [ne_zero (f r)] : ne_zero r := ⟨λ h, ne (f r) $ by convert zero_hom_class.map_zero f⟩ + +lemma of_injective {R M} [has_zero R] {r : R} [ne_zero r] [has_zero M] [zero_hom_class F R M] + {f : F} (hf : function.injective f) : ne_zero (f r) := +⟨by { rw ← zero_hom_class.map_zero f, exact hf.ne (ne r) }⟩ + +end ne_zero + section add @@ -202,6 +217,9 @@ ne_of_apply_ne f $ ne_of_ne_of_eq hx (map_one f).symm instance [one_hom_class F M N] : has_coe_t F (one_hom M N) := ⟨λ f, { to_fun := f, map_one' := map_one f }⟩ +@[simp, to_additive] lemma one_hom.coe_coe [one_hom_class F M N] (f : F) : + ((f : one_hom M N) : M → N) = f := rfl + end one section mul @@ -246,6 +264,9 @@ mul_hom_class.map_mul f x y instance [mul_hom_class F M N] : has_coe_t F (M →ₙ* N) := ⟨λ f, { to_fun := f, map_mul' := map_mul f }⟩ +@[simp, to_additive] lemma mul_hom.coe_coe [mul_hom_class F M N] (f : F) : + ((f : mul_hom M N) : M → N) = f := rfl + end mul section mul_one @@ -289,33 +310,36 @@ instance monoid_hom.monoid_hom_class : monoid_hom_class (M →* N) M N := instance [monoid_hom_class F M N] : has_coe_t F (M →* N) := ⟨λ f, { to_fun := f, map_one' := map_one f, map_mul' := map_mul f }⟩ +@[simp, to_additive] lemma monoid_hom.coe_coe [monoid_hom_class F M N] (f : F) : + ((f : M →* N) : M → N) = f := rfl + @[to_additive] lemma map_mul_eq_one [monoid_hom_class F M N] (f : F) {a b : M} (h : a * b = 1) : f a * f b = 1 := by rw [← map_mul, h, map_one] +@[to_additive] +lemma map_div' [div_inv_monoid G] [div_inv_monoid H] [monoid_hom_class F G H] (f : F) + (hf : ∀ a, f a⁻¹ = (f a)⁻¹) (a b : G) : f (a / b) = f a / f b := +by rw [div_eq_mul_inv, div_eq_mul_inv, map_mul, hf] + /-- Group homomorphisms preserve inverse. -/ @[simp, to_additive "Additive group homomorphisms preserve negation."] -theorem map_inv [group G] [group H] [monoid_hom_class F G H] - (f : F) (g : G) : f g⁻¹ = (f g)⁻¹ := -eq_inv_of_mul_eq_one $ map_mul_eq_one f $ inv_mul_self g +lemma map_inv [group G] [division_monoid H] [monoid_hom_class F G H] (f : F) (a : G) : + f a⁻¹ = (f a)⁻¹ := +eq_inv_of_mul_eq_one_left $ map_mul_eq_one f $ inv_mul_self _ /-- Group homomorphisms preserve division. -/ @[simp, to_additive "Additive group homomorphisms preserve subtraction."] -theorem map_mul_inv [group G] [group H] [monoid_hom_class F G H] - (f : F) (g h : G) : f (g * h⁻¹) = f g * (f h)⁻¹ := +lemma map_mul_inv [group G] [division_monoid H] [monoid_hom_class F G H] (f : F) (a b : G) : + f (a * b⁻¹) = f a * (f b)⁻¹ := by rw [map_mul, map_inv] /-- Group homomorphisms preserve division. -/ @[simp, to_additive "Additive group homomorphisms preserve subtraction."] -lemma map_div [group G] [group H] [monoid_hom_class F G H] - (f : F) (x y : G) : f (x / y) = f x / f y := -by rw [div_eq_mul_inv, div_eq_mul_inv, map_mul_inv] - -@[to_additive] -theorem map_div' [div_inv_monoid G] [div_inv_monoid H] [monoid_hom_class F G H] (f : F) - (hf : ∀ x, f (x⁻¹) = (f x)⁻¹) (a b : G) : f (a / b) = f a / f b := -by rw [div_eq_mul_inv, div_eq_mul_inv, map_mul, hf] +lemma map_div [group G] [division_monoid H] [monoid_hom_class F G H] (f : F) : + ∀ a b, f (a / b) = f a / f b := +map_div' _ $ map_inv f -- to_additive puts the arguments in the wrong order, so generate an auxiliary lemma, then -- swap its arguments. @@ -342,12 +366,13 @@ theorem map_zpow' [div_inv_monoid G] [div_inv_monoid H] [monoid_hom_class F G H] -- swap its arguments. /-- Group homomorphisms preserve integer power. -/ @[to_additive map_zsmul.aux, simp] -theorem map_zpow [group G] [group H] [monoid_hom_class F G H] (f : F) (g : G) (n : ℤ) : +theorem map_zpow [group G] [division_monoid H] [monoid_hom_class F G H] (f : F) (g : G) (n : ℤ) : f (g ^ n) = (f g) ^ n := map_zpow' f (map_inv f) g n /-- Additive group homomorphisms preserve integer scaling. -/ -theorem map_zsmul [add_group G] [add_group H] [add_monoid_hom_class F G H] (f : F) (n : ℤ) (g : G) : +theorem map_zsmul [add_group G] [subtraction_monoid H] [add_monoid_hom_class F G H] (f : F) + (n : ℤ) (g : G) : f (n • g) = n • f g := map_zsmul.aux f g n @@ -398,6 +423,9 @@ instance monoid_with_zero_hom.monoid_with_zero_hom_class : instance [monoid_with_zero_hom_class F M N] : has_coe_t F (M →*₀ N) := ⟨λ f, { to_fun := f, map_one' := map_one f, map_zero' := map_zero f, map_mul' := map_mul f }⟩ +@[simp] lemma monoid_with_zero_hom.coe_coe [monoid_with_zero_hom_class F M N] (f : F) : + ((f : M →*₀ N) : M → N) = f := rfl + end mul_zero_one -- completely uninteresting lemmas about coercion to function, that all homs need @@ -578,11 +606,11 @@ fun_like.coe_injective h lemma one_hom.ext_iff [has_one M] [has_one N] {f g : one_hom M N} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff /-- Deprecated: use `fun_like.ext_iff` instead. -/ -@[to_additive] +@[to_additive "Deprecated: use `fun_like.ext_iff` instead."] lemma mul_hom.ext_iff [has_mul M] [has_mul N] {f g : M →ₙ* N} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff /-- Deprecated: use `fun_like.ext_iff` instead. -/ -@[to_additive] +@[to_additive "Deprecated: use `fun_like.ext_iff` instead."] lemma monoid_hom.ext_iff [mul_one_class M] [mul_one_class N] {f g : M →* N} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff @@ -620,6 +648,14 @@ protected def one_hom.copy {hM : has_one M} {hN : has_one N} (f : one_hom M N) ( { to_fun := f', map_one' := h.symm ▸ f.map_one' } +@[simp, to_additive] lemma one_hom.coe_copy {hM : has_one M} {hN : has_one N} (f : one_hom M N) + (f' : M → N) (h : f' = f) : ⇑(f.copy f' h) = f' := +rfl + +@[to_additive] lemma one_hom.coe_copy_eq {hM : has_one M} {hN : has_one N} (f : one_hom M N) + (f' : M → N) (h : f' = f) : f.copy f' h = f := +fun_like.ext' h + /-- Copy of a `mul_hom` with a new `to_fun` equal to the old one. Useful to fix definitional equalities. -/ @[to_additive "Copy of an `add_hom` with a new `to_fun` equal to the old one. Useful to fix @@ -629,6 +665,14 @@ protected def mul_hom.copy {hM : has_mul M} {hN : has_mul N} (f : M →ₙ* N) ( { to_fun := f', map_mul' := h.symm ▸ f.map_mul' } +@[simp, to_additive] +lemma mul_hom.coe_copy {hM : has_mul M} {hN : has_mul N} (f : M →ₙ* N) (f' : M → N) + (h : f' = f) : ⇑(f.copy f' h) = f' := rfl + +@[to_additive] lemma mul_hom.coe_copy_eq {hM : has_mul M} {hN : has_mul N} (f : M →ₙ* N) + (f' : M → N) (h : f' = f) : f.copy f' h = f := +fun_like.ext' h + /-- Copy of a `monoid_hom` with a new `to_fun` equal to the old one. Useful to fix definitional equalities. -/ @[to_additive "Copy of an `add_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix @@ -637,12 +681,28 @@ protected def monoid_hom.copy {hM : mul_one_class M} {hN : mul_one_class N} (f : (f' : M → N) (h : f' = f) : M →* N := { ..f.to_one_hom.copy f' h, ..f.to_mul_hom.copy f' h } +@[simp, to_additive] lemma monoid_hom.coe_copy {hM : mul_one_class M} {hN : mul_one_class N} + (f : M →* N) (f' : M → N) (h : f' = f) : ⇑(f.copy f' h) = f' := +rfl + +@[to_additive] lemma monoid_hom.copy_eq {hM : mul_one_class M} {hN : mul_one_class N} + (f : M →* N) (f' : M → N) (h : f' = f) : f.copy f' h = f := +fun_like.ext' h + /-- Copy of a `monoid_hom` with a new `to_fun` equal to the old one. Useful to fix definitional equalities. -/ protected def monoid_with_zero_hom.copy {hM : mul_zero_one_class M} {hN : mul_zero_one_class N} (f : M →*₀ N) (f' : M → N) (h : f' = f) : M →* N := { ..f.to_zero_hom.copy f' h, ..f.to_monoid_hom.copy f' h } +@[simp] lemma monoid_with_zero_hom.coe_copy {hM : mul_zero_one_class M} {hN : mul_zero_one_class N} + (f : M →*₀ N) (f' : M → N) (h : f' = f) : ⇑(f.copy f' h) = f' := +rfl + +lemma monoid_with_zero_hom.copy_eq {hM : mul_zero_one_class M} {hN : mul_zero_one_class N} + (f : M →*₀ N) (f' : M → N) (h : f' = f) : f.copy f' h = f := +fun_like.ext' h + @[to_additive] protected lemma one_hom.map_one [has_one M] [has_one N] (f : one_hom M N) : f 1 = 1 := f.map_one' /-- If `f` is a monoid homomorphism then `f 1 = 1`. -/ @@ -671,8 +731,7 @@ protected lemma monoid_with_zero_hom.map_mul [mul_zero_one_class M] [mul_zero_on add_decl_doc add_monoid_hom.map_add namespace monoid_hom -variables {mM : mul_one_class M} {mN : mul_one_class N} {mP : mul_one_class P} -variables [group G] [comm_group H] [monoid_hom_class F M N] +variables {mM : mul_one_class M} {mN : mul_one_class N} [monoid_hom_class F M N] include mM mN @@ -695,14 +754,22 @@ let ⟨y, hy⟩ := hx in ⟨f y, map_mul_eq_one f hy⟩ end monoid_hom +section division_comm_monoid +variables [division_comm_monoid α] + /-- Inversion on a commutative group, considered as a monoid homomorphism. -/ -@[to_additive "Inversion on a commutative additive group, considered as an additive -monoid homomorphism."] -def comm_group.inv_monoid_hom {G : Type*} [comm_group G] : G →* G := +@[to_additive "Negation on a commutative additive group, considered as an additive monoid +homomorphism."] +def inv_monoid_hom : α →* α := { to_fun := has_inv.inv, - map_one' := one_inv, + map_one' := inv_one, map_mul' := mul_inv } +@[simp] lemma coe_inv_monoid_hom : (inv_monoid_hom : α → α) = has_inv.inv := rfl +@[simp] lemma inv_monoid_hom_apply (a : α) : inv_monoid_hom a = a⁻¹ := rfl + +end division_comm_monoid + /-- The identity map from a type with 1 to itself. -/ @[to_additive, simps] def one_hom.id (M : Type*) [has_one M] : one_hom M M := @@ -783,7 +850,8 @@ lemma monoid_with_zero_hom.comp_apply [mul_zero_one_class M] [mul_zero_one_class g.comp f x = g (f x) := rfl /-- Composition of monoid homomorphisms is associative. -/ -@[to_additive] lemma one_hom.comp_assoc {Q : Type*} [has_one M] [has_one N] [has_one P] [has_one Q] +@[to_additive "Composition of additive monoid homomorphisms is associative."] +lemma one_hom.comp_assoc {Q : Type*} [has_one M] [has_one N] [has_one P] [has_one Q] (f : one_hom M N) (g : one_hom N P) (h : one_hom P Q) : (h.comp g).comp f = h.comp (g.comp f) := rfl @[to_additive] lemma mul_hom.comp_assoc {Q : Type*} [has_mul M] [has_mul N] [has_mul P] [has_mul Q] @@ -911,7 +979,7 @@ instance : monoid (monoid.End M) := instance : inhabited (monoid.End M) := ⟨1⟩ -instance : has_coe_to_fun (monoid.End M) (λ _, M → M) := ⟨monoid_hom.to_fun⟩ +instance : monoid_hom_class (monoid.End M) M M := monoid_hom.monoid_hom_class end End @@ -938,7 +1006,7 @@ instance : monoid (add_monoid.End A) := instance : inhabited (add_monoid.End A) := ⟨1⟩ -instance : has_coe_to_fun (add_monoid.End A) (λ _, A → A) := ⟨add_monoid_hom.to_fun⟩ +instance : add_monoid_hom_class (add_monoid.End A) A A := add_monoid_hom.add_monoid_hom_class end End @@ -1053,34 +1121,26 @@ by { ext, simp only [map_one, coe_comp, function.comp_app, one_apply] } g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ := by { ext, simp only [mul_apply, function.comp_app, map_mul, coe_comp] } -/-- If two homomorphism from a group to a monoid are equal at `x`, then they are equal at `x⁻¹`. -/ -@[to_additive "If two homomorphism from an additive group to an additive monoid are equal at `x`, -then they are equal at `-x`." ] -lemma eq_on_inv {G} [group G] [monoid M] [monoid_hom_class F G M] {f g : F} {x : G} - (h : f x = g x) : f x⁻¹ = g x⁻¹ := -left_inv_eq_right_inv (map_mul_eq_one f $ inv_mul_self x) $ - h.symm ▸ map_mul_eq_one g $ mul_inv_self x - /-- Group homomorphisms preserve inverse. -/ -@[to_additive] -protected theorem map_inv {G H} [group G] [group H] (f : G →* H) (g : G) : f g⁻¹ = (f g)⁻¹ := -map_inv f g +@[to_additive "Additive group homomorphisms preserve negation."] +protected lemma map_inv [group α] [division_monoid β] (f : α →* β) (a : α) : f a⁻¹ = (f a)⁻¹ := +map_inv f _ /-- Group homomorphisms preserve integer power. -/ @[to_additive "Additive group homomorphisms preserve integer scaling."] -protected theorem map_zpow {G H} [group G] [group H] (f : G →* H) (g : G) (n : ℤ) : +protected theorem map_zpow [group α] [division_monoid β] (f : α →* β) (g : α) (n : ℤ) : f (g ^ n) = (f g) ^ n := map_zpow f g n /-- Group homomorphisms preserve division. -/ @[to_additive "Additive group homomorphisms preserve subtraction."] -protected theorem map_div {G H} [group G] [group H] (f : G →* H) (g h : G) : +protected theorem map_div [group α] [division_monoid β] (f : α →* β) (g h : α) : f (g / h) = f g / f h := map_div f g h /-- Group homomorphisms preserve division. -/ -@[to_additive] -protected theorem map_mul_inv {G H} [group G] [group H] (f : G →* H) (g h : G) : +@[to_additive "Additive group homomorphisms preserve subtraction."] +protected theorem map_mul_inv [group α] [division_monoid β] (f : α →* β) (g h : α) : f (g * h⁻¹) = (f g) * (f h)⁻¹ := map_mul_inv f g h @@ -1125,7 +1185,7 @@ def of_map_mul_inv {H : Type*} [group H] (f : G → H) (map_div : ∀ a b : G, f (a * b⁻¹) = f a * (f b)⁻¹) : G →* H := mk' f $ λ x y, -calc f (x * y) = f x * (f $ 1 * 1⁻¹ * y⁻¹)⁻¹ : by simp only [one_mul, one_inv, ← map_div, inv_inv] +calc f (x * y) = f x * (f $ 1 * 1⁻¹ * y⁻¹)⁻¹ : by simp only [one_mul, inv_one, ← map_div, inv_inv] ... = f x * f y : by { simp only [map_div], simp only [mul_right_inv, one_mul, inv_inv] } @[simp, to_additive] lemma coe_of_map_mul_inv {H : Type*} [group H] (f : G → H) @@ -1189,19 +1249,3 @@ instance {M N} {hM : mul_zero_one_class M} [comm_monoid_with_zero N] : has_mul ( { to_fun := λ a, f a * g a, map_zero' := by rw [map_zero, zero_mul], ..(f * g : M →* N) }⟩ - -section commute - -variables [has_mul M] [has_mul N] {a x y : M} - -@[simp, to_additive] -protected lemma semiconj_by.map [mul_hom_class F M N] (h : semiconj_by a x y) (f : F) : - semiconj_by (f a) (f x) (f y) := -by simpa only [semiconj_by, map_mul] using congr_arg f h - -@[simp, to_additive] -protected lemma commute.map [mul_hom_class F M N] (h : commute x y) (f : F) : - commute (f x) (f y) := -h.map f - -end commute diff --git a/src/algebra/hom/group_action.lean b/src/algebra/hom/group_action.lean index 55bc58e280721..8c086115d579e 100644 --- a/src/algebra/hom/group_action.lean +++ b/src/algebra/hom/group_action.lean @@ -3,12 +3,15 @@ Copyright (c) 2020 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ -import algebra.group_ring_action -import group_theory.group_action.defs +import algebra.group_ring_action.basic +import algebra.module.basic /-! # Equivariant homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `mul_action_hom M X Y`, the type of equivariant functions from `X` to `Y`, where `M` is a monoid @@ -18,18 +21,28 @@ import group_theory.group_action.defs * `mul_semiring_action_hom M R S`, the type of equivariant ring homomorphisms from `R` to `S`, where `M` is a monoid that acts on the rings `R` and `S`. +The above types have corresponding classes: +* `smul_hom_class F M X Y` states that `F` is a type of bundled `X → Y` homs + preserving scalar multiplication by `M` +* `distrib_mul_action_hom_class F M A B` states that `F` is a type of bundled `A → B` homs + preserving the additive monoid structure and scalar multiplication by `M` +* `mul_semiring_action_hom_class F M R S` states that `F` is a type of bundled `R → S` homs + preserving the ring structure and scalar multiplication by `M` + ## Notations * `X →[M] Y` is `mul_action_hom M X Y`. -* `A →+[M] B` is `distrib_mul_action_hom M X Y`. -* `R →+*[M] S` is `mul_semiring_action_hom M X Y`. +* `A →+[M] B` is `distrib_mul_action_hom M A B`. +* `R →+*[M] S` is `mul_semiring_action_hom M R S`. -/ +assert_not_exists submonoid + variables (M' : Type*) -variables (X : Type*) [has_scalar M' X] -variables (Y : Type*) [has_scalar M' Y] -variables (Z : Type*) [has_scalar M' Z] +variables (X : Type*) [has_smul M' X] +variables (Y : Type*) [has_smul M' Y] +variables (Z : Type*) [has_smul M' Z] variables (M : Type*) [monoid M] variables (A : Type*) [add_monoid A] [distrib_mul_action M A] variables (A' : Type*) [add_group A'] [distrib_mul_action M A'] @@ -41,34 +54,47 @@ variables (R' : Type*) [ring R'] [mul_semiring_action M R'] variables (S : Type*) [semiring S] [mul_semiring_action M S] variables (S' : Type*) [ring S'] [mul_semiring_action M S'] variables (T : Type*) [semiring T] [mul_semiring_action M T] -variables (G : Type*) [group G] (H : subgroup G) set_option old_structure_cmd true /-- Equivariant functions. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure mul_action_hom := (to_fun : X → Y) (map_smul' : ∀ (m : M') (x : X), to_fun (m • x) = m • to_fun x) -notation X ` →[`:25 M:25 `] `:0 Y:0 := mul_action_hom M X Y +notation (name := mul_action_hom) X ` →[`:25 M:25 `] `:0 Y:0 := mul_action_hom M X Y -namespace mul_action_hom +/-- `smul_hom_class F M X Y` states that `F` is a type of morphisms preserving +scalar multiplication by `M`. -instance : has_coe_to_fun (X →[M'] Y) (λ _, X → Y) := ⟨mul_action_hom.to_fun⟩ +You should extend this class when you extend `mul_action_hom`. -/ +class smul_hom_class (F : Type*) (M X Y : out_param $ Type*) [has_smul M X] [has_smul M Y] + extends fun_like F X (λ _, Y) := +(map_smul : ∀ (f : F) (c : M) (x : X), f (c • x) = c • f x) -variables {M M' X Y} +-- `M` becomes a metavariable but it's an `out_param` so it's not a problem. +attribute [nolint dangerous_instance] smul_hom_class.to_fun_like -@[simp] lemma map_smul (f : X →[M'] Y) (m : M') (x : X) : f (m • x) = m • f x := -f.map_smul' m x +export smul_hom_class (map_smul) +attribute [simp] map_smul -@[ext] theorem ext : ∀ {f g : X →[M'] Y}, (∀ x, f x = g x) → f = g -| ⟨f, _⟩ ⟨g, _⟩ H := by { congr' 1 with x, exact H x } +namespace mul_action_hom -theorem ext_iff {f g : X →[M'] Y} : f = g ↔ ∀ x, f x = g x := -⟨λ H x, by rw H, ext⟩ +instance : has_coe_to_fun (X →[M'] Y) (λ _, X → Y) := ⟨mul_action_hom.to_fun⟩ -protected lemma congr_fun {f g : X →[M'] Y} (h : f = g) (x : X) : f x = g x := h ▸ rfl +instance : smul_hom_class (X →[M'] Y) M' X Y := +{ coe := mul_action_hom.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_smul := mul_action_hom.map_smul' } + +variables {M M' X Y} + +protected lemma map_smul (f : X →[M'] Y) (m : M') (x : X) : f (m • x) = m • f x := map_smul _ _ _ +@[ext] theorem ext : ∀ {f g : X →[M'] Y}, (∀ x, f x = g x) → f = g := fun_like.ext +theorem ext_iff {f g : X →[M'] Y} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff +protected lemma congr_fun {f g : X →[M'] Y} (h : f = g) (x : X) : f x = g x := +fun_like.congr_fun h _ variables (M M') {X} @@ -119,6 +145,17 @@ add_decl_doc distrib_mul_action_hom.to_mul_action_hom notation A ` →+[`:25 M:25 `] `:0 B:0 := distrib_mul_action_hom M A B +/-- `distrib_mul_action_hom_class F M A B` states that `F` is a type of morphisms preserving +the additive monoid structure and scalar multiplication by `M`. + +You should extend this class when you extend `distrib_mul_action_hom`. -/ +class distrib_mul_action_hom_class (F : Type*) (M A B : out_param $ Type*) + [monoid M] [add_monoid A] [add_monoid B] [distrib_mul_action M A] [distrib_mul_action M B] + extends smul_hom_class F M A B, add_monoid_hom_class F A B + +-- `M` becomes a metavariable but it's an `out_param` so it's not a problem. +attribute [nolint dangerous_instance] distrib_mul_action_hom_class.to_add_monoid_hom_class + namespace distrib_mul_action_hom instance has_coe : has_coe (A →+[M] B) (A →+ B) := @@ -129,6 +166,13 @@ instance has_coe' : has_coe (A →+[M] B) (A →[M] B) := instance : has_coe_to_fun (A →+[M] B) (λ _, A → B) := ⟨to_fun⟩ +instance : distrib_mul_action_hom_class (A →+[M] B) M A B := +{ coe := distrib_mul_action_hom.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_smul := distrib_mul_action_hom.map_smul', + map_zero := distrib_mul_action_hom.map_zero', + map_add := distrib_mul_action_hom.map_add' } + variables {M A B} @[simp] lemma to_fun_eq_coe (f : A →+[M] B) : f.to_fun = ⇑f := rfl @@ -136,13 +180,10 @@ variables {M A B} @[norm_cast] lemma coe_fn_coe (f : A →+[M] B) : ((f : A →+ B) : A → B) = f := rfl @[norm_cast] lemma coe_fn_coe' (f : A →+[M] B) : ((f : A →[M] B) : A → B) = f := rfl -@[ext] theorem ext : ∀ {f g : A →+[M] B}, (∀ x, f x = g x) → f = g -| ⟨f, _, _, _⟩ ⟨g, _, _, _⟩ H := by { congr' 1 with x, exact H x } - -theorem ext_iff {f g : A →+[M] B} : f = g ↔ ∀ x, f x = g x := -⟨λ H x, by rw H, ext⟩ - -protected lemma congr_fun {f g : A →+[M] B} (h : f = g) (x : A) : f x = g x := h ▸ rfl +@[ext] theorem ext : ∀ {f g : A →+[M] B}, (∀ x, f x = g x) → f = g := fun_like.ext +theorem ext_iff {f g : A →+[M] B} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff +protected lemma congr_fun {f g : A →+[M] B} (h : f = g) (x : A) : f x = g x := +fun_like.congr_fun h _ lemma to_mul_action_hom_injective {f g : A →+[M] B} (h : (f : A →[M] B) = (g : A →[M] B)) : f = g := @@ -152,20 +193,11 @@ lemma to_add_monoid_hom_injective {f g : A →+[M] B} (h : (f : A →+ B) = (g : A →+ B)) : f = g := by { ext a, exact add_monoid_hom.congr_fun h a, } -@[simp] lemma map_zero (f : A →+[M] B) : f 0 = 0 := -f.map_zero' - -@[simp] lemma map_add (f : A →+[M] B) (x y : A) : f (x + y) = f x + f y := -f.map_add' x y - -@[simp] lemma map_neg (f : A' →+[M] B') (x : A') : f (-x) = -f x := -(f : A' →+ B').map_neg x - -@[simp] lemma map_sub (f : A' →+[M] B') (x y : A') : f (x - y) = f x - f y := -(f : A' →+ B').map_sub x y - -@[simp] lemma map_smul (f : A →+[M] B) (m : M) (x : A) : f (m • x) = m • f x := -f.map_smul' m x +protected lemma map_zero (f : A →+[M] B) : f 0 = 0 := map_zero _ +protected lemma map_add (f : A →+[M] B) (x y : A) : f (x + y) = f x + f y := map_add _ _ _ +protected lemma map_neg (f : A' →+[M] B') (x : A') : f (-x) = -f x := map_neg _ _ +protected lemma map_sub (f : A' →+[M] B') (x y : A') : f (x - y) = f x - f y := map_sub _ _ _ +protected lemma map_smul (f : A →+[M] B) (m : M) (x : A) : f (m • x) = m • f x := map_smul _ _ _ variables (M) {A} @@ -230,7 +262,7 @@ end semiring end distrib_mul_action_hom /-- Equivariant ring homomorphisms. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure mul_semiring_action_hom extends R →+[M] S, R →+* S. /-- Reinterpret an equivariant ring homomorphism as a ring homomorphism. -/ @@ -241,6 +273,17 @@ add_decl_doc mul_semiring_action_hom.to_distrib_mul_action_hom notation R ` →+*[`:25 M:25 `] `:0 S:0 := mul_semiring_action_hom M R S +/-- `mul_semiring_action_hom_class F M R S` states that `F` is a type of morphisms preserving +the ring structure and scalar multiplication by `M`. + +You should extend this class when you extend `mul_semiring_action_hom`. -/ +class mul_semiring_action_hom_class (F : Type*) (M R S : out_param $ Type*) + [monoid M] [semiring R] [semiring S] [distrib_mul_action M R] [distrib_mul_action M S] + extends distrib_mul_action_hom_class F M R S, ring_hom_class F R S + +-- `M` becomes a metavariable but it's an `out_param` so it's not a problem. +attribute [nolint dangerous_instance] mul_semiring_action_hom_class.to_ring_hom_class + namespace mul_semiring_action_hom instance has_coe : has_coe (R →+*[M] S) (R →+* S) := @@ -251,37 +294,30 @@ instance has_coe' : has_coe (R →+*[M] S) (R →+[M] S) := instance : has_coe_to_fun (R →+*[M] S) (λ _, R → S) := ⟨λ c, c.to_fun⟩ +instance : mul_semiring_action_hom_class (R →+*[M] S) M R S := +{ coe := mul_semiring_action_hom.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_smul := mul_semiring_action_hom.map_smul', + map_zero := mul_semiring_action_hom.map_zero', + map_add := mul_semiring_action_hom.map_add', + map_one := mul_semiring_action_hom.map_one', + map_mul := mul_semiring_action_hom.map_mul' } + variables {M R S} @[norm_cast] lemma coe_fn_coe (f : R →+*[M] S) : ((f : R →+* S) : R → S) = f := rfl @[norm_cast] lemma coe_fn_coe' (f : R →+*[M] S) : ((f : R →+[M] S) : R → S) = f := rfl -@[ext] theorem ext : ∀ {f g : R →+*[M] S}, (∀ x, f x = g x) → f = g -| ⟨f, _, _, _, _, _⟩ ⟨g, _, _, _, _, _⟩ H := by { congr' 1 with x, exact H x } - -theorem ext_iff {f g : R →+*[M] S} : f = g ↔ ∀ x, f x = g x := -⟨λ H x, by rw H, ext⟩ - -@[simp] lemma map_zero (f : R →+*[M] S) : f 0 = 0 := -f.map_zero' - -@[simp] lemma map_add (f : R →+*[M] S) (x y : R) : f (x + y) = f x + f y := -f.map_add' x y +@[ext] theorem ext : ∀ {f g : R →+*[M] S}, (∀ x, f x = g x) → f = g := fun_like.ext +theorem ext_iff {f g : R →+*[M] S} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff -@[simp] lemma map_neg (f : R' →+*[M] S') (x : R') : f (-x) = -f x := -(f : R' →+* S').map_neg x - -@[simp] lemma map_sub (f : R' →+*[M] S') (x y : R') : f (x - y) = f x - f y := -(f : R' →+* S').map_sub x y - -@[simp] lemma map_one (f : R →+*[M] S) : f 1 = 1 := -f.map_one' - -@[simp] lemma map_mul (f : R →+*[M] S) (x y : R) : f (x * y) = f x * f y := -f.map_mul' x y - -@[simp] lemma map_smul (f : R →+*[M] S) (m : M) (x : R) : f (m • x) = m • f x := -f.map_smul' m x +protected lemma map_zero (f : R →+*[M] S) : f 0 = 0 := map_zero _ +protected lemma map_add (f : R →+*[M] S) (x y : R) : f (x + y) = f x + f y := map_add _ _ _ +protected lemma map_neg (f : R' →+*[M] S') (x : R') : f (-x) = -f x := map_neg _ _ +protected lemma map_sub (f : R' →+*[M] S') (x y : R') : f (x - y) = f x - f y := map_sub _ _ _ +protected lemma map_one (f : R →+*[M] S) : f 1 = 1 := map_one _ +protected lemma map_mul (f : R →+*[M] S) (x y : R) : f (x * y) = f x * f y := map_mul _ _ _ +protected lemma map_smul (f : R →+*[M] S) (m : M) (x : R) : f (m • x) = m • f x := map_smul _ _ _ variables (M) {R} @@ -307,18 +343,3 @@ ext $ λ x, by rw [comp_apply, id_apply] ext $ λ x, by rw [comp_apply, id_apply] end mul_semiring_action_hom - -section -variables (M) {R'} (U : subring R') [is_invariant_subring M U] - -/-- The canonical inclusion from an invariant subring. -/ -def is_invariant_subring.subtype_hom : U →+*[M] R' := -{ map_smul' := λ m s, rfl, ..U.subtype } - -@[simp] theorem is_invariant_subring.coe_subtype_hom : - (is_invariant_subring.subtype_hom M U : U → R') = coe := rfl - -@[simp] theorem is_invariant_subring.coe_subtype_hom' : - (is_invariant_subring.subtype_hom M U : U →+* R') = U.subtype := rfl - -end diff --git a/src/algebra/hom/group_instances.lean b/src/algebra/hom/group_instances.lean index 9ba4e7a68da68..ba5ff959d7466 100644 --- a/src/algebra/hom/group_instances.lean +++ b/src/algebra/hom/group_instances.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes, Johannes Hölzl, Yury Kudryashov -/ - import algebra.group_power.basic +import algebra.ring.basic /-! # Instances on spaces of monoid and group morphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We endow the space of monoid morphisms `M →* N` with a `comm_monoid` structure when the target is commutative, through pointwise multiplication, and with a `comm_group` structure when the target is a commutative group. We also prove the same instances for additive situations. @@ -55,18 +58,38 @@ instance {M G} [mul_one_class M] [comm_group G] : comm_group (M →* G) := zpow_neg' := λ n f, by { ext x, simp }, ..monoid_hom.comm_monoid } +instance [add_comm_monoid M] : add_comm_monoid (add_monoid.End M) := +add_monoid_hom.add_comm_monoid + instance [add_comm_monoid M] : semiring (add_monoid.End M) := { zero_mul := λ x, add_monoid_hom.ext $ λ i, rfl, mul_zero := λ x, add_monoid_hom.ext $ λ i, add_monoid_hom.map_zero _, left_distrib := λ x y z, add_monoid_hom.ext $ λ i, add_monoid_hom.map_add _ _ _, right_distrib := λ x y z, add_monoid_hom.ext $ λ i, rfl, + nat_cast := λ n, n • 1, + nat_cast_zero := add_monoid.nsmul_zero' _, + nat_cast_succ := λ n, (add_monoid.nsmul_succ' n 1).trans (add_comm _ _), .. add_monoid.End.monoid M, .. add_monoid_hom.add_comm_monoid } +/-- See also `add_monoid.End.nat_cast_def`. -/ +@[simp] lemma add_monoid.End.nat_cast_apply [add_comm_monoid M] (n : ℕ) (m : M) : + (↑n : add_monoid.End M) m = n • m := rfl + +instance [add_comm_group M] : add_comm_group (add_monoid.End M) := +add_monoid_hom.add_comm_group + instance [add_comm_group M] : ring (add_monoid.End M) := -{ .. add_monoid.End.semiring, +{ int_cast := λ z, z • 1, + int_cast_of_nat := of_nat_zsmul _, + int_cast_neg_succ_of_nat := zsmul_neg_succ_of_nat _, + .. add_monoid.End.semiring, .. add_monoid_hom.add_comm_group } +/-- See also `add_monoid.End.int_cast_def`. -/ +@[simp] lemma add_monoid.End.int_cast_apply [add_comm_group M] (z : ℤ) (m : M) : + (↑z : add_monoid.End M) m = z • m := rfl + /-! ### Morphisms of morphisms @@ -202,7 +225,8 @@ variables {R S : Type*} [non_unital_non_assoc_semiring R] [non_unital_non_assoc_ This is a more-strongly bundled version of `add_monoid_hom.mul_left` and `add_monoid_hom.mul_right`. -A stronger version of this exists for algebras as `algebra.lmul`. +Stronger versions of this exists for algebras as `linear_map.mul`, `non_unital_alg_hom.mul` +and `algebra.lmul`. -/ def add_monoid_hom.mul : R →+ R →+ R := { to_fun := add_monoid_hom.mul_left, diff --git a/src/algebra/hom/iterate.lean b/src/algebra/hom/iterate.lean index 63b253f5a01b2..4bd68c2cdae3c 100644 --- a/src/algebra/hom/iterate.lean +++ b/src/algebra/hom/iterate.lean @@ -3,15 +3,15 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ - -import algebra.group_power.basic -import logic.function.iterate -import group_theory.perm.basic +import algebra.group_power.lemmas import group_theory.group_action.opposite /-! # Iterates of monoid and ring homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Iterate of a monoid/ring homomorphism is a monoid/ring homomorphism but it has a wrong type, so Lean can't apply lemmas like `monoid_hom.map_one` to `f^[n] 1`. Though it is possible to define a monoid structure on the endomorphisms, quite often we do not want to convert from @@ -142,9 +142,6 @@ f.to_add_monoid_hom.iterate_map_zsmul n m x end ring_hom -lemma equiv.perm.coe_pow {α : Type*} (f : equiv.perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) := -hom_coe_pow _ rfl (λ _ _, rfl) _ _ - --what should be the namespace for this section? section monoid @@ -165,8 +162,34 @@ smul_iterate (mul_opposite.op a) n lemma mul_right_iterate_apply_one : (* a)^[n] 1 = a ^ n := by simp [mul_right_iterate] +@[simp, to_additive] +lemma pow_iterate (n : ℕ) (j : ℕ) : ((λ (x : G), x^n)^[j]) = λ x, x^(n^j) := +begin + letI : mul_action ℕ G := + { smul := λ n g, g^n, + one_smul := pow_one, + mul_smul := λ m n g, pow_mul' g m n }, + exact smul_iterate n j, +end + end monoid +section group + +variables [group G] + +@[simp, to_additive] +lemma zpow_iterate (n : ℤ) (j : ℕ) : ((λ (x : G), x^n)^[j]) = λ x, x^(n^j) := +begin + letI : mul_action ℤ G := + { smul := λ n g, g^n, + one_smul := zpow_one, + mul_smul := λ m n g, zpow_mul' g m n }, + exact smul_iterate n j, +end + +end group + section semigroup variables [semigroup G] {a b c : G} diff --git a/src/algebra/hom/non_unital_alg.lean b/src/algebra/hom/non_unital_alg.lean index 1c82398d8a8a3..a5443eb570e6b 100644 --- a/src/algebra/hom/non_unital_alg.lean +++ b/src/algebra/hom/non_unital_alg.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Oliver Nash. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Oliver Nash -/ -import algebra.algebra.basic +import algebra.algebra.hom /-! # Morphisms of non-unital algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines morphisms between two types, each of which carries: * an addition, * an additive zero, @@ -60,6 +63,47 @@ notation A ` →ₙₐ[`:25 R `] ` B := non_unital_alg_hom R A B attribute [nolint doc_blame] non_unital_alg_hom.to_distrib_mul_action_hom attribute [nolint doc_blame] non_unital_alg_hom.to_mul_hom +/-- `non_unital_alg_hom_class F R A B` asserts `F` is a type of bundled algebra homomorphisms +from `A` to `B`. -/ +class non_unital_alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) + (B : out_param Type*) [monoid R] + [non_unital_non_assoc_semiring A] [non_unital_non_assoc_semiring B] + [distrib_mul_action R A] [distrib_mul_action R B] + extends distrib_mul_action_hom_class F R A B, mul_hom_class F A B + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] non_unital_alg_hom_class.to_mul_hom_class + +namespace non_unital_alg_hom_class + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +@[priority 100, nolint dangerous_instance] -- See note [lower instance priority] +instance non_unital_alg_hom_class.to_non_unital_ring_hom_class {F R A B : Type*} [monoid R] + [non_unital_non_assoc_semiring A] [distrib_mul_action R A] + [non_unital_non_assoc_semiring B] [distrib_mul_action R B] + [non_unital_alg_hom_class F R A B] : non_unital_ring_hom_class F A B := +{ coe := coe_fn, ..‹non_unital_alg_hom_class F R A B› } + +variables [semiring R] + [non_unital_non_assoc_semiring A] [module R A] + [non_unital_non_assoc_semiring B] [module R B] + +@[priority 100] -- see Note [lower instance priority] +instance {F : Type*} [non_unital_alg_hom_class F R A B] : linear_map_class F R A B := +{ map_smulₛₗ := distrib_mul_action_hom_class.map_smul, + ..‹non_unital_alg_hom_class F R A B› } + +instance {F R A B : Type*} [monoid R] + [non_unital_non_assoc_semiring A] [distrib_mul_action R A] + [non_unital_non_assoc_semiring B] [distrib_mul_action R B] + [non_unital_alg_hom_class F R A B] : has_coe_t F (A →ₙₐ[R] B) := +{ coe := λ f, + { to_fun := f, + map_smul' := map_smul f, + .. (f : A →ₙ+* B) } } + +end non_unital_alg_hom_class + namespace non_unital_alg_hom variables {R A B C} [monoid R] @@ -74,10 +118,21 @@ instance : has_coe_to_fun (A →ₙₐ[R] B) (λ _, A → B) := ⟨to_fun⟩ initialize_simps_projections non_unital_alg_hom (to_fun → apply) +@[simp, protected] lemma coe_coe {F : Type*} [non_unital_alg_hom_class F R A B] (f : F) : + ⇑(f : A →ₙₐ[R] B) = f := rfl + lemma coe_injective : @function.injective (A →ₙₐ[R] B) (A → B) coe_fn := by rintro ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩; congr +instance : non_unital_alg_hom_class (A →ₙₐ[R] B) R A B := +{ coe := to_fun, + coe_injective' := coe_injective, + map_smul := λ f, f.map_smul', + map_add := λ f, f.map_add', + map_zero := λ f, f.map_zero', + map_mul := λ f, f.map_mul' } + @[ext] lemma ext {f g : A →ₙₐ[R] B} (h : ∀ x, f x = g x) : f = g := coe_injective $ funext h @@ -131,20 +186,16 @@ by { ext, refl, } ((⟨f, h₁, h₂, h₃, h₄⟩ : A →ₙₐ[R] B) : A →ₙ* B) = ⟨f, h₄⟩ := by { ext, refl, } -@[simp] lemma map_smul (f : A →ₙₐ[R] B) (c : R) (x : A) : - f (c • x) = c • f x := -f.to_distrib_mul_action_hom.map_smul c x +@[simp] protected lemma map_smul (f : A →ₙₐ[R] B) (c : R) (x : A) : + f (c • x) = c • f x := map_smul _ _ _ -@[simp] lemma map_add (f : A →ₙₐ[R] B) (x y : A) : - f (x + y) = (f x) + (f y) := -f.to_distrib_mul_action_hom.map_add x y +@[simp] protected lemma map_add (f : A →ₙₐ[R] B) (x y : A) : + f (x + y) = (f x) + (f y) := map_add _ _ _ -@[simp] lemma map_mul (f : A →ₙₐ[R] B) (x y : A) : - f (x * y) = (f x) * (f y) := -f.to_mul_hom.map_mul x y +@[simp] protected lemma map_mul (f : A →ₙₐ[R] B) (x y : A) : + f (x * y) = (f x) * (f y) := map_mul _ _ _ -@[simp] lemma map_zero (f : A →ₙₐ[R] B) : f 0 = 0 := -f.to_distrib_mul_action_hom.map_zero +@[simp] protected lemma map_zero (f : A →ₙₐ[R] B) : f 0 = 0 := map_zero _ instance : has_zero (A →ₙₐ[R] B) := ⟨{ map_mul' := by simp, @@ -263,9 +314,14 @@ namespace alg_hom variables {R A B} [comm_semiring R] [semiring A] [semiring B] [algebra R A] [algebra R B] +@[priority 100] -- see Note [lower instance priority] +instance {F : Type*} [alg_hom_class F R A B] : non_unital_alg_hom_class F R A B := +{ map_smul := map_smul, + ..‹alg_hom_class F R A B› } + /-- A unital morphism of algebras is a `non_unital_alg_hom`. -/ def to_non_unital_alg_hom (f : A →ₐ[R] B) : A →ₙₐ[R] B := -{ map_smul' := f.map_smul, .. f, } +{ map_smul' := map_smul f, .. f, } instance non_unital_alg_hom.has_coe : has_coe (A →ₐ[R] B) (A →ₙₐ[R] B) := ⟨to_non_unital_alg_hom⟩ diff --git a/src/algebra/hom/ring.lean b/src/algebra/hom/ring.lean new file mode 100644 index 0000000000000..5d085245f67a2 --- /dev/null +++ b/src/algebra/hom/ring.lean @@ -0,0 +1,570 @@ +/- +Copyright (c) 2019 Amelia Livingston. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Amelia Livingston, Jireh Loreaux +-/ +import algebra.group_with_zero.inj_surj +import algebra.ring.basic +import algebra.divisibility.basic +import data.pi.algebra +import algebra.hom.units +import data.set.image + +/-! +# Homomorphisms of semirings and rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines bundled homomorphisms of (non-unital) semirings and rings. As with monoid and +groups, we use the same structure `ring_hom a β`, a.k.a. `α →+* β`, for both types of homomorphisms. + +The unbundled homomorphisms are defined in `deprecated.ring`. They are deprecated and the plan is to +slowly remove them from mathlib. + +## Main definitions + +* `non_unital_ring_hom`: Non-unital (semi)ring homomorphisms. Additive monoid homomorphism which + preserve multiplication. +* `ring_hom`: (Semi)ring homomorphisms. Monoid homomorphisms which are also additive monoid + homomorphism. + +## Notations + +* `→ₙ+*`: Non-unital (semi)ring homs +* `→+*`: (Semi)ring homs + +## Implementation notes + +* There's a coercion from bundled homs to fun, and the canonical notation is to + use the bundled hom as a function via this coercion. + +* There is no `semiring_hom` -- the idea is that `ring_hom` is used. + The constructor for a `ring_hom` between semirings needs a proof of `map_zero`, + `map_one` and `map_add` as well as `map_mul`; a separate constructor + `ring_hom.mk'` will construct ring homs between rings from monoid homs given + only a proof that addition is preserved. + +## Tags + +`ring_hom`, `semiring_hom` +-/ + +set_option old_structure_cmd true + +open function + +variables {F α β γ : Type*} + +/-- Bundled non-unital semiring homomorphisms `α →ₙ+* β`; use this for bundled non-unital ring +homomorphisms too. + +When possible, instead of parametrizing results over `(f : α →ₙ+* β)`, +you should parametrize over `(F : Type*) [non_unital_ring_hom_class F α β] (f : F)`. + +When you extend this structure, make sure to extend `non_unital_ring_hom_class`. -/ +structure non_unital_ring_hom (α β : Type*) [non_unital_non_assoc_semiring α] + [non_unital_non_assoc_semiring β] extends α →ₙ* β, α →+ β + +infixr ` →ₙ+* `:25 := non_unital_ring_hom + +/-- Reinterpret a non-unital ring homomorphism `f : α →ₙ+* β` as a semigroup +homomorphism `α →ₙ* β`. The `simp`-normal form is `(f : α →ₙ* β)`. -/ +add_decl_doc non_unital_ring_hom.to_mul_hom + +/-- Reinterpret a non-unital ring homomorphism `f : α →ₙ+* β` as an additive +monoid homomorphism `α →+ β`. The `simp`-normal form is `(f : α →+ β)`. -/ +add_decl_doc non_unital_ring_hom.to_add_monoid_hom + +section non_unital_ring_hom_class + +/-- `non_unital_ring_hom_class F α β` states that `F` is a type of non-unital (semi)ring +homomorphisms. You should extend this class when you extend `non_unital_ring_hom`. -/ +class non_unital_ring_hom_class (F : Type*) (α β : out_param Type*) + [non_unital_non_assoc_semiring α] [non_unital_non_assoc_semiring β] + extends mul_hom_class F α β, add_monoid_hom_class F α β + +variables [non_unital_non_assoc_semiring α] [non_unital_non_assoc_semiring β] + [non_unital_ring_hom_class F α β] + +instance : has_coe_t F (α →ₙ+* β) := +⟨λ f, { to_fun := f, map_zero' := map_zero f, map_mul' := map_mul f, map_add' := map_add f }⟩ + +end non_unital_ring_hom_class + +namespace non_unital_ring_hom + +section coe + +/-! +Throughout this section, some `semiring` arguments are specified with `{}` instead of `[]`. +See note [implicit instance arguments]. +-/ +variables {rα : non_unital_non_assoc_semiring α} {rβ : non_unital_non_assoc_semiring β} + +include rα rβ + +instance : non_unital_ring_hom_class (α →ₙ+* β) α β := +{ coe := non_unital_ring_hom.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_add := non_unital_ring_hom.map_add', + map_zero := non_unital_ring_hom.map_zero', + map_mul := non_unital_ring_hom.map_mul' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +instance : has_coe_to_fun (α →ₙ+* β) (λ _, α → β) := ⟨non_unital_ring_hom.to_fun⟩ + +@[simp] lemma to_fun_eq_coe (f : α →ₙ+* β) : f.to_fun = f := rfl + +@[simp] lemma coe_mk (f : α → β) (h₁ h₂ h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : α →ₙ+* β) = f := rfl + +@[simp] lemma coe_coe [non_unital_ring_hom_class F α β] (f : F) : ((f : α →ₙ+* β) : α → β) = f := +rfl + +@[simp] lemma coe_to_mul_hom (f : α →ₙ+* β) : ⇑f.to_mul_hom = f := rfl + +@[simp] lemma coe_mul_hom_mk (f : α → β) (h₁ h₂ h₃) : + ((⟨f, h₁, h₂, h₃⟩ : α →ₙ+* β) : α →ₙ* β) = ⟨f, h₁⟩ := rfl + +@[simp] lemma coe_to_add_monoid_hom (f : α →ₙ+* β) : ⇑f.to_add_monoid_hom = f := rfl + +@[simp] lemma coe_add_monoid_hom_mk (f : α → β) (h₁ h₂ h₃) : + ((⟨f, h₁, h₂, h₃⟩ : α →ₙ+* β) : α →+ β) = ⟨f, h₂, h₃⟩ := rfl + +/-- Copy of a `ring_hom` with a new `to_fun` equal to the old one. Useful to fix definitional +equalities. -/ +protected def copy (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : α →ₙ+* β := +{ ..f.to_mul_hom.copy f' h, ..f.to_add_monoid_hom.copy f' h } + +@[simp] lemma coe_copy (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl + +lemma copy_eq (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h + +end coe + +variables [rα : non_unital_non_assoc_semiring α] [rβ : non_unital_non_assoc_semiring β] + +section +include rα rβ + +variables (f : α →ₙ+* β) {x y : α} {rα rβ} + +@[ext] lemma ext ⦃f g : α →ₙ+* β⦄ : (∀ x, f x = g x) → f = g := fun_like.ext _ _ + +lemma ext_iff {f g : α →ₙ+* β} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff + +@[simp] lemma mk_coe (f : α →ₙ+* β) (h₁ h₂ h₃) : non_unital_ring_hom.mk f h₁ h₂ h₃ = f := +ext $ λ _, rfl + +lemma coe_add_monoid_hom_injective : injective (coe : (α →ₙ+* β) → (α →+ β)) := +λ f g h, ext $ add_monoid_hom.congr_fun h + +lemma coe_mul_hom_injective : injective (coe : (α →ₙ+* β) → (α →ₙ* β)) := +λ f g h, ext $ mul_hom.congr_fun h + +end + +/-- The identity non-unital ring homomorphism from a non-unital semiring to itself. -/ +protected def id (α : Type*) [non_unital_non_assoc_semiring α] : α →ₙ+* α := +by refine {to_fun := id, ..}; intros; refl + +include rα rβ + +instance : has_zero (α →ₙ+* β) := +⟨{ to_fun := 0, + map_mul' := λ x y, (mul_zero (0 : β)).symm, + map_zero' := rfl, + map_add' := λ x y, (add_zero (0 : β)).symm }⟩ + +instance : inhabited (α →ₙ+* β) := ⟨0⟩ + +@[simp] lemma coe_zero : ⇑(0 : α →ₙ+* β) = 0 := rfl +@[simp] lemma zero_apply (x : α) : (0 : α →ₙ+* β) x = 0 := rfl + +omit rβ + +@[simp] lemma id_apply (x : α) : non_unital_ring_hom.id α x = x := rfl +@[simp] lemma coe_add_monoid_hom_id : + (non_unital_ring_hom.id α : α →+ α) = add_monoid_hom.id α := rfl +@[simp] lemma coe_mul_hom_id : (non_unital_ring_hom.id α : α →ₙ* α) = mul_hom.id α := rfl + +variable {rγ : non_unital_non_assoc_semiring γ} +include rβ rγ + +/-- Composition of non-unital ring homomorphisms is a non-unital ring homomorphism. -/ +def comp (g : β →ₙ+* γ) (f : α →ₙ+* β) : α →ₙ+* γ := +{ ..g.to_mul_hom.comp f.to_mul_hom, ..g.to_add_monoid_hom.comp f.to_add_monoid_hom } + +/-- Composition of non-unital ring homomorphisms is associative. -/ +lemma comp_assoc {δ} {rδ : non_unital_non_assoc_semiring δ} (f : α →ₙ+* β) (g : β →ₙ+* γ) + (h : γ →ₙ+* δ) : (h.comp g).comp f = h.comp (g.comp f) := rfl + +@[simp] lemma coe_comp (g : β →ₙ+* γ) (f : α →ₙ+* β) : ⇑(g.comp f) = g ∘ f := rfl +@[simp] lemma comp_apply (g : β →ₙ+* γ) (f : α →ₙ+* β) (x : α) : g.comp f x = g (f x) := rfl + +@[simp] lemma coe_comp_add_monoid_hom (g : β →ₙ+* γ) (f : α →ₙ+* β) : + (g.comp f : α →+ γ) = (g : β →+ γ).comp f := rfl +@[simp] lemma coe_comp_mul_hom (g : β →ₙ+* γ) (f : α →ₙ+* β) : + (g.comp f : α →ₙ* γ) = (g : β →ₙ* γ).comp f := rfl + +@[simp] lemma comp_zero (g : β →ₙ+* γ) : g.comp (0 : α →ₙ+* β) = 0 := by { ext, simp } +@[simp] lemma zero_comp (f : α →ₙ+* β) : (0 : β →ₙ+* γ).comp f = 0 := by { ext, refl } + +omit rγ + +@[simp] lemma comp_id (f : α →ₙ+* β) : f.comp (non_unital_ring_hom.id α) = f := ext $ λ x, rfl +@[simp] lemma id_comp (f : α →ₙ+* β) : (non_unital_ring_hom.id β).comp f = f := ext $ λ x, rfl + +omit rβ + +instance : monoid_with_zero (α →ₙ+* α) := +{ one := non_unital_ring_hom.id α, + mul := comp, + mul_one := comp_id, + one_mul := id_comp, + mul_assoc := λ f g h, comp_assoc _ _ _, + zero := 0, + mul_zero := comp_zero, + zero_mul := zero_comp } + +lemma one_def : (1 : α →ₙ+* α) = non_unital_ring_hom.id α := rfl + +@[simp] lemma coe_one : ⇑(1 : α →ₙ+* α) = id := rfl + +lemma mul_def (f g : α →ₙ+* α) : f * g = f.comp g := rfl + +@[simp] lemma coe_mul (f g : α →ₙ+* α) : ⇑(f * g) = f ∘ g := rfl + +include rβ rγ + +lemma cancel_right {g₁ g₂ : β →ₙ+* γ} {f : α →ₙ+* β} (hf : surjective f) : + g₁.comp f = g₂.comp f ↔ g₁ = g₂ := +⟨λ h, ext $ hf.forall.2 (ext_iff.1 h), λ h, h ▸ rfl⟩ + +lemma cancel_left {g : β →ₙ+* γ} {f₁ f₂ : α →ₙ+* β} (hg : injective g) : + g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ := +⟨λ h, ext $ λ x, hg $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩ + +omit rα rβ rγ + +end non_unital_ring_hom + +/-- Bundled semiring homomorphisms; use this for bundled ring homomorphisms too. + +This extends from both `monoid_hom` and `monoid_with_zero_hom` in order to put the fields in a +sensible order, even though `monoid_with_zero_hom` already extends `monoid_hom`. -/ +structure ring_hom (α : Type*) (β : Type*) [non_assoc_semiring α] [non_assoc_semiring β] + extends α →* β, α →+ β, α →ₙ+* β, α →*₀ β + +infixr ` →+* `:25 := ring_hom + +/-- Reinterpret a ring homomorphism `f : α →+* β` as a monoid with zero homomorphism `α →*₀ β`. +The `simp`-normal form is `(f : α →*₀ β)`. -/ +add_decl_doc ring_hom.to_monoid_with_zero_hom + +/-- Reinterpret a ring homomorphism `f : α →+* β` as a monoid homomorphism `α →* β`. +The `simp`-normal form is `(f : α →* β)`. -/ +add_decl_doc ring_hom.to_monoid_hom + +/-- Reinterpret a ring homomorphism `f : α →+* β` as an additive monoid homomorphism `α →+ β`. +The `simp`-normal form is `(f : α →+ β)`. -/ +add_decl_doc ring_hom.to_add_monoid_hom + +/-- Reinterpret a ring homomorphism `f : α →+* β` as a non-unital ring homomorphism `α →ₙ+* β`. The +`simp`-normal form is `(f : α →ₙ+* β)`. -/ +add_decl_doc ring_hom.to_non_unital_ring_hom + +section ring_hom_class + +/-- `ring_hom_class F α β` states that `F` is a type of (semi)ring homomorphisms. +You should extend this class when you extend `ring_hom`. + +This extends from both `monoid_hom_class` and `monoid_with_zero_hom_class` in +order to put the fields in a sensible order, even though +`monoid_with_zero_hom_class` already extends `monoid_hom_class`. -/ +class ring_hom_class (F : Type*) (α β : out_param Type*) + [non_assoc_semiring α] [non_assoc_semiring β] + extends monoid_hom_class F α β, add_monoid_hom_class F α β, monoid_with_zero_hom_class F α β + +variables [non_assoc_semiring α] [non_assoc_semiring β] [ring_hom_class F α β] + +/-- Ring homomorphisms preserve `bit1`. -/ +@[simp] lemma map_bit1 (f : F) (a : α) : (f (bit1 a) : β) = bit1 (f a) := by simp [bit1] + +instance : has_coe_t F (α →+* β) := +⟨λ f, { to_fun := f, map_zero' := map_zero f, map_one' := map_one f, map_mul' := map_mul f, + map_add' := map_add f }⟩ + +@[priority 100] +instance ring_hom_class.to_non_unital_ring_hom_class : non_unital_ring_hom_class F α β := +{ .. ‹ring_hom_class F α β› } + +end ring_hom_class + +namespace ring_hom + +section coe + +/-! +Throughout this section, some `semiring` arguments are specified with `{}` instead of `[]`. +See note [implicit instance arguments]. +-/ +variables {rα : non_assoc_semiring α} {rβ : non_assoc_semiring β} + +include rα rβ + +instance : ring_hom_class (α →+* β) α β := +{ coe := ring_hom.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_add := ring_hom.map_add', + map_zero := ring_hom.map_zero', + map_mul := ring_hom.map_mul', + map_one := ring_hom.map_one' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. +-/ +instance : has_coe_to_fun (α →+* β) (λ _, α → β) := ⟨ring_hom.to_fun⟩ + +initialize_simps_projections ring_hom (to_fun → apply) + +@[simp] lemma to_fun_eq_coe (f : α →+* β) : f.to_fun = f := rfl + +@[simp] lemma coe_mk (f : α → β) (h₁ h₂ h₃ h₄) : ⇑(⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) = f := rfl + +@[simp] lemma coe_coe {F : Type*} [ring_hom_class F α β] (f : F) : ((f : α →+* β) : α → β) = f := +rfl + +instance has_coe_monoid_hom : has_coe (α →+* β) (α →* β) := ⟨ring_hom.to_monoid_hom⟩ + +@[simp, norm_cast] lemma coe_monoid_hom (f : α →+* β) : ⇑(f : α →* β) = f := rfl + +@[simp] lemma to_monoid_hom_eq_coe (f : α →+* β) : f.to_monoid_hom = f := rfl +@[simp] lemma to_monoid_with_zero_hom_eq_coe (f : α →+* β) : + (f.to_monoid_with_zero_hom : α → β) = f := rfl + +@[simp] lemma coe_monoid_hom_mk (f : α → β) (h₁ h₂ h₃ h₄) : + ((⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) : α →* β) = ⟨f, h₁, h₂⟩ := rfl + +@[simp, norm_cast] lemma coe_add_monoid_hom (f : α →+* β) : ⇑(f : α →+ β) = f := rfl + +@[simp] lemma to_add_monoid_hom_eq_coe (f : α →+* β) : f.to_add_monoid_hom = f := rfl + +@[simp] lemma coe_add_monoid_hom_mk (f : α → β) (h₁ h₂ h₃ h₄) : + ((⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) : α →+ β) = ⟨f, h₃, h₄⟩ := rfl + +/-- Copy of a `ring_hom` with a new `to_fun` equal to the old one. Useful to fix definitional +equalities. -/ +def copy (f : α →+* β) (f' : α → β) (h : f' = f) : α →+* β := +{ ..f.to_monoid_with_zero_hom.copy f' h, ..f.to_add_monoid_hom.copy f' h } + +@[simp] lemma coe_copy (f : α →+* β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl + +lemma copy_eq (f : α →+* β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h + +end coe + +variables [rα : non_assoc_semiring α] [rβ : non_assoc_semiring β] + +section +include rα rβ + +variables (f : α →+* β) {x y : α} {rα rβ} + +lemma congr_fun {f g : α →+* β} (h : f = g) (x : α) : f x = g x := fun_like.congr_fun h x +lemma congr_arg (f : α →+* β) {x y : α} (h : x = y) : f x = f y := fun_like.congr_arg f h + +lemma coe_inj ⦃f g : α →+* β⦄ (h : (f : α → β) = g) : f = g := fun_like.coe_injective h + +@[ext] lemma ext ⦃f g : α →+* β⦄ : (∀ x, f x = g x) → f = g := fun_like.ext _ _ + +lemma ext_iff {f g : α →+* β} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff + +@[simp] lemma mk_coe (f : α →+* β) (h₁ h₂ h₃ h₄) : ring_hom.mk f h₁ h₂ h₃ h₄ = f := ext $ λ _, rfl + +lemma coe_add_monoid_hom_injective : injective (coe : (α →+* β) → (α →+ β)) := +λ f g h, ext $ add_monoid_hom.congr_fun h + +lemma coe_monoid_hom_injective : injective (coe : (α →+* β) → (α →* β)) := +λ f g h, ext $ monoid_hom.congr_fun h + +/-- Ring homomorphisms map zero to zero. -/ +protected lemma map_zero (f : α →+* β) : f 0 = 0 := map_zero f + +/-- Ring homomorphisms map one to one. -/ +protected lemma map_one (f : α →+* β) : f 1 = 1 := map_one f + +/-- Ring homomorphisms preserve addition. -/ +protected lemma map_add (f : α →+* β) : ∀ a b, f (a + b) = f a + f b := map_add f + +/-- Ring homomorphisms preserve multiplication. -/ +protected lemma map_mul (f : α →+* β) : ∀ a b, f (a * b) = f a * f b := map_mul f + +/-- Ring homomorphisms preserve `bit0`. -/ +protected lemma map_bit0 (f : α →+* β) : ∀ a, f (bit0 a) = bit0 (f a) := map_bit0 f + +/-- Ring homomorphisms preserve `bit1`. -/ +protected lemma map_bit1 (f : α →+* β) : ∀ a, f (bit1 a) = bit1 (f a) := map_bit1 f + +@[simp] lemma map_ite_zero_one {F : Type*} [ring_hom_class F α β] (f : F) (p : Prop) [decidable p] : + f (ite p 0 1) = ite p 0 1 := +by { split_ifs; simp [h] } + +@[simp] lemma map_ite_one_zero {F : Type*} [ring_hom_class F α β] (f : F) (p : Prop) [decidable p] : + f (ite p 1 0) = ite p 1 0 := +by { split_ifs; simp [h] } + +/-- `f : α →+* β` has a trivial codomain iff `f 1 = 0`. -/ +lemma codomain_trivial_iff_map_one_eq_zero : (0 : β) = 1 ↔ f 1 = 0 := by rw [map_one, eq_comm] + +/-- `f : α →+* β` has a trivial codomain iff it has a trivial range. -/ +lemma codomain_trivial_iff_range_trivial : (0 : β) = 1 ↔ ∀ x, f x = 0 := +f.codomain_trivial_iff_map_one_eq_zero.trans + ⟨λ h x, by rw [←mul_one x, map_mul, h, mul_zero], λ h, h 1⟩ + +/-- `f : α →+* β` has a trivial codomain iff its range is `{0}`. -/ +lemma codomain_trivial_iff_range_eq_singleton_zero : (0 : β) = 1 ↔ set.range f = {0} := +f.codomain_trivial_iff_range_trivial.trans + ⟨ λ h, set.ext (λ y, ⟨λ ⟨x, hx⟩, by simp [←hx, h x], λ hy, ⟨0, by simpa using hy.symm⟩⟩), + λ h x, set.mem_singleton_iff.mp (h ▸ set.mem_range_self x)⟩ + +/-- `f : α →+* β` doesn't map `1` to `0` if `β` is nontrivial -/ +lemma map_one_ne_zero [nontrivial β] : f 1 ≠ 0 := +mt f.codomain_trivial_iff_map_one_eq_zero.mpr zero_ne_one + +/-- If there is a homomorphism `f : α →+* β` and `β` is nontrivial, then `α` is nontrivial. -/ +lemma domain_nontrivial [nontrivial β] : nontrivial α := +⟨⟨1, 0, mt (λ h, show f 1 = 0, by rw [h, map_zero]) f.map_one_ne_zero⟩⟩ + +lemma codomain_trivial (f : α →+* β) [h : subsingleton α] : subsingleton β := +(subsingleton_or_nontrivial β).resolve_right + (λ _, by exactI not_nontrivial_iff_subsingleton.mpr h f.domain_nontrivial) + +end + +/-- Ring homomorphisms preserve additive inverse. -/ +protected theorem map_neg [non_assoc_ring α] [non_assoc_ring β] (f : α →+* β) (x : α) : + f (-x) = -(f x) := +map_neg f x + +/-- Ring homomorphisms preserve subtraction. -/ +protected theorem map_sub [non_assoc_ring α] [non_assoc_ring β] (f : α →+* β) (x y : α) : + f (x - y) = (f x) - (f y) := map_sub f x y + +/-- Makes a ring homomorphism from a monoid homomorphism of rings which preserves addition. -/ +def mk' [non_assoc_semiring α] [non_assoc_ring β] (f : α →* β) + (map_add : ∀ a b, f (a + b) = f a + f b) : + α →+* β := +{ ..add_monoid_hom.mk' f map_add, ..f } + +section semiring +variables [semiring α] [semiring β] + +lemma is_unit_map (f : α →+* β) {a : α} : is_unit a → is_unit (f a) := is_unit.map f + +protected lemma map_dvd (f : α →+* β) {a b : α} : a ∣ b → f a ∣ f b := map_dvd f + +end semiring + +/-- The identity ring homomorphism from a semiring to itself. -/ +def id (α : Type*) [non_assoc_semiring α] : α →+* α := by refine {to_fun := id, ..}; intros; refl + +include rα + +instance : inhabited (α →+* α) := ⟨id α⟩ + +@[simp] lemma id_apply (x : α) : ring_hom.id α x = x := rfl +@[simp] lemma coe_add_monoid_hom_id : (id α : α →+ α) = add_monoid_hom.id α := rfl +@[simp] lemma coe_monoid_hom_id : (id α : α →* α) = monoid_hom.id α := rfl + +variable {rγ : non_assoc_semiring γ} +include rβ rγ + +/-- Composition of ring homomorphisms is a ring homomorphism. -/ +def comp (g : β →+* γ) (f : α →+* β) : α →+* γ := +{ to_fun := g ∘ f, + map_one' := by simp, + ..g.to_non_unital_ring_hom.comp f.to_non_unital_ring_hom } + +/-- Composition of semiring homomorphisms is associative. -/ +lemma comp_assoc {δ} {rδ: non_assoc_semiring δ} (f : α →+* β) (g : β →+* γ) (h : γ →+* δ) : + (h.comp g).comp f = h.comp (g.comp f) := rfl + +@[simp] lemma coe_comp (hnp : β →+* γ) (hmn : α →+* β) : (hnp.comp hmn : α → γ) = hnp ∘ hmn := rfl + +lemma comp_apply (hnp : β →+* γ) (hmn : α →+* β) (x : α) : (hnp.comp hmn : α → γ) x = + (hnp (hmn x)) := rfl + +omit rγ + +@[simp] lemma comp_id (f : α →+* β) : f.comp (id α) = f := ext $ λ x, rfl + +@[simp] lemma id_comp (f : α →+* β) : (id β).comp f = f := ext $ λ x, rfl + +omit rβ + +instance : monoid (α →+* α) := +{ one := id α, + mul := comp, + mul_one := comp_id, + one_mul := id_comp, + mul_assoc := λ f g h, comp_assoc _ _ _ } + +lemma one_def : (1 : α →+* α) = id α := rfl +lemma mul_def (f g : α →+* α) : f * g = f.comp g := rfl + +@[simp] lemma coe_one : ⇑(1 : α →+* α) = _root_.id := rfl +@[simp] lemma coe_mul (f g : α →+* α) : ⇑(f * g) = f ∘ g := rfl + +include rβ rγ + +lemma cancel_right {g₁ g₂ : β →+* γ} {f : α →+* β} (hf : surjective f) : + g₁.comp f = g₂.comp f ↔ g₁ = g₂ := +⟨λ h, ring_hom.ext $ hf.forall.2 (ext_iff.1 h), λ h, h ▸ rfl⟩ + +lemma cancel_left {g : β →+* γ} {f₁ f₂ : α →+* β} (hg : injective g) : + g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ := +⟨λ h, ring_hom.ext $ λ x, hg $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩ + +end ring_hom + +/-- Pullback `is_domain` instance along an injective function. -/ +protected theorem function.injective.is_domain [ring α] [is_domain α] [ring β] (f : β →+* α) + (hf : injective f) : is_domain β := +begin + haveI := pullback_nonzero f f.map_zero f.map_one, + haveI := is_right_cancel_mul_zero.to_no_zero_divisors α, + haveI := hf.no_zero_divisors f f.map_zero f.map_mul, + exact no_zero_divisors.to_is_domain β, +end + +namespace add_monoid_hom +variables [comm_ring α] [is_domain α] [comm_ring β] (f : β →+ α) + +/-- Make a ring homomorphism from an additive group homomorphism from a commutative ring to an +integral domain that commutes with self multiplication, assumes that two is nonzero and `1` is sent +to `1`. -/ +def mk_ring_hom_of_mul_self_of_two_ne_zero (h : ∀ x, f (x * x) = f x * f x) (h_two : (2 : α) ≠ 0) + (h_one : f 1 = 1) : β →+* α := +{ map_one' := h_one, + map_mul' := λ x y, begin + have hxy := h (x + y), + rw [mul_add, add_mul, add_mul, f.map_add, f.map_add, f.map_add, f.map_add, h x, h y, add_mul, + mul_add, mul_add, ← sub_eq_zero, add_comm, ← sub_sub, ← sub_sub, ← sub_sub, + mul_comm y x, mul_comm (f y) (f x)] at hxy, + simp only [add_assoc, add_sub_assoc, add_sub_cancel'_right] at hxy, + rw [sub_sub, ← two_mul, ← add_sub_assoc, ← two_mul, ← mul_sub, mul_eq_zero, sub_eq_zero, + or_iff_not_imp_left] at hxy, + exact hxy h_two, + end, + ..f } + +@[simp] lemma coe_fn_mk_ring_hom_of_mul_self_of_two_ne_zero (h h_two h_one) : + (f.mk_ring_hom_of_mul_self_of_two_ne_zero h h_two h_one : β → α) = f := rfl + +@[simp] lemma coe_add_monoid_hom_mk_ring_hom_of_mul_self_of_two_ne_zero (h h_two h_one) : + (f.mk_ring_hom_of_mul_self_of_two_ne_zero h h_two h_one : β →+ α) = f := +by { ext, refl } + +end add_monoid_hom diff --git a/src/algebra/hom/units.lean b/src/algebra/hom/units.lean index 47a65c30dcdf3..c6e5cc4987288 100644 --- a/src/algebra/hom/units.lean +++ b/src/algebra/hom/units.lean @@ -4,15 +4,57 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin, Chris Hughes, Kevin Buzzard -/ import algebra.hom.group - +import algebra.group.units /-! -# Lift monoid homomorphisms to group homomorphisms of their units subgroups. +# Monoid homomorphisms and units + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file allows to lift monoid homomorphisms to group homomorphisms of their units subgroups. It +also contains unrelated results about `units` that depend on `monoid_hom`. + +## Main declarations + +* `units.map`: Turn an homomorphism from `α` to `β` monoids into an homomorphism from `αˣ` to `βˣ`. +* `monoid_hom.to_hom_units`: Turn an homomorphism from a group `α` to `β` into an homomorphism from + `α` to `βˣ`. + +## TODO + +The results that don't mention homomorphisms should be proved (earlier?) in a different file and be +used to golf the basic `group` lemmas. -/ +open function + universes u v w +@[to_additive] lemma group.is_unit {G} [group G] (g : G) : is_unit g := +⟨⟨g, g⁻¹, mul_inv_self g, inv_mul_self g⟩, rfl⟩ + +section monoid_hom_class + +/-- If two homomorphisms from a division monoid to a monoid are equal at a unit `x`, then they are +equal at `x⁻¹`. -/ +@[to_additive "If two homomorphisms from a subtraction monoid to an additive monoid are equal at an +additive unit `x`, then they are equal at `-x`."] +lemma is_unit.eq_on_inv {F G N} [division_monoid G] [monoid N] [monoid_hom_class F G N] {x : G} + (hx : is_unit x) (f g : F) (h : f x = g x) : f x⁻¹ = g x⁻¹ := +left_inv_eq_right_inv (map_mul_eq_one f hx.inv_mul_cancel) $ + h.symm ▸ map_mul_eq_one g $ hx.mul_inv_cancel + +/-- If two homomorphism from a group to a monoid are equal at `x`, then they are equal at `x⁻¹`. -/ +@[to_additive "If two homomorphism from an additive group to an additive monoid are equal at `x`, +then they are equal at `-x`." ] +lemma eq_on_inv {F G M} [group G] [monoid M] [monoid_hom_class F G M] (f g : F) {x : G} + (h : f x = g x) : f x⁻¹ = g x⁻¹ := +(group.is_unit x).eq_on_inv f g h + +end monoid_hom_class + namespace units -variables {M : Type u} {N : Type v} {P : Type w} [monoid M] [monoid N] [monoid P] +variables {α : Type*} {M : Type u} {N : Type v} {P : Type w} [monoid M] [monoid N] [monoid P] /-- The group homomorphism on units induced by a `monoid_hom`. -/ @[to_additive "The `add_group` homomorphism on `add_unit`s induced by an `add_monoid_hom`."] @@ -48,9 +90,24 @@ variable {M} lemma coe_pow (u : Mˣ) (n : ℕ) : ((u ^ n : Mˣ) : M) = u ^ n := (units.coe_hom M).map_pow u n -@[simp, norm_cast, to_additive] -lemma coe_zpow {G} [group G] (u : Gˣ) (n : ℤ) : ((u ^ n : Gˣ) : G) = u ^ n := -(units.coe_hom G).map_zpow u n +section division_monoid +variables [division_monoid α] + +@[simp, norm_cast, to_additive] lemma coe_div : ∀ u₁ u₂ : αˣ, ↑(u₁ / u₂) = (u₁ / u₂ : α) := +(units.coe_hom α).map_div + +@[simp, norm_cast, to_additive] lemma coe_zpow : ∀ (u : αˣ) (n : ℤ), ((u ^ n : αˣ) : α) = u ^ n := +(units.coe_hom α).map_zpow + +@[field_simps] lemma _root_.divp_eq_div (a : α) (u : αˣ) : a /ₚ u = a / u := +by rw [div_eq_mul_inv, divp, u.coe_inv] + +@[simp, to_additive] +lemma _root_.map_units_inv {F : Type*} [monoid_hom_class F M α] (f : F) (u : units M) : + f ↑u⁻¹ = (f u)⁻¹ := +((f : M →* α).comp (units.coe_hom M)).map_inv u + +end division_monoid /-- If a map `g : M → Nˣ` agrees with a homomorphism `f : M →* N`, then this map is a monoid homomorphism too. -/ @@ -84,43 +141,188 @@ and `f.to_hom_units` is the corresponding monoid homomorphism from `G` to `Mˣ`. then its image lies in the `add_units` of `M`, and `f.to_hom_units` is the corresponding homomorphism from `G` to `add_units M`."] def to_hom_units {G M : Type*} [group G] [monoid M] (f : G →* M) : G →* Mˣ := -{ to_fun := λ g, - ⟨f g, f (g⁻¹), - by rw [← f.map_mul, mul_inv_self, f.map_one], - by rw [← f.map_mul, inv_mul_self, f.map_one]⟩, - map_one' := units.ext (f.map_one), - map_mul' := λ _ _, units.ext (f.map_mul _ _) } +units.lift_right f + (λ g, ⟨f g, f g⁻¹, map_mul_eq_one f (mul_inv_self _), map_mul_eq_one f (inv_mul_self _)⟩) + (λ g, rfl) -@[simp] lemma coe_to_hom_units {G M : Type*} [group G] [monoid M] (f : G →* M) (g : G): - (f.to_hom_units g : M) = f g := rfl +@[simp, to_additive] +lemma coe_to_hom_units {G M : Type*} [group G] [monoid M] (f : G →* M) (g : G) : + (f.to_hom_units g : M) = f g := +rfl end monoid_hom -section is_unit -variables {M : Type*} {N : Type*} +namespace is_unit +variables {F G α M N : Type*} + +section monoid +variables [monoid M] [monoid N] -@[to_additive] lemma is_unit.map {F : Type*} [monoid M] [monoid N] [monoid_hom_class F M N] - (f : F) {x : M} (h : is_unit x) : is_unit (f x) := +@[to_additive] lemma map [monoid_hom_class F M N] (f : F) {x : M} (h : is_unit x) : is_unit (f x) := by rcases h with ⟨y, rfl⟩; exact (units.map (f : M →* N) y).is_unit +@[to_additive] lemma of_left_inverse [monoid_hom_class F M N] [monoid_hom_class G N M] + {f : F} {x : M} (g : G) (hfg : function.left_inverse g f) (h : is_unit (f x)) : + is_unit x := +by simpa only [hfg x] using h.map g + +@[to_additive] lemma _root_.is_unit_map_of_left_inverse + [monoid_hom_class F M N] [monoid_hom_class G N M] + {f : F} {x : M} (g : G) (hfg : function.left_inverse g f) : + is_unit (f x) ↔ is_unit x := +⟨of_left_inverse g hfg, map _⟩ + /-- If a homomorphism `f : M →* N` sends each element to an `is_unit`, then it can be lifted to `f : M →* Nˣ`. See also `units.lift_right` for a computable version. -/ @[to_additive "If a homomorphism `f : M →+ N` sends each element to an `is_add_unit`, then it can be lifted to `f : M →+ add_units N`. See also `add_units.lift_right` for a computable version."] -noncomputable def is_unit.lift_right [monoid M] [monoid N] (f : M →* N) - (hf : ∀ x, is_unit (f x)) : M →* Nˣ := +noncomputable def lift_right (f : M →* N) (hf : ∀ x, is_unit (f x)) : M →* Nˣ := units.lift_right f (λ x, (hf x).unit) $ λ x, rfl -@[to_additive] lemma is_unit.coe_lift_right [monoid M] [monoid N] (f : M →* N) - (hf : ∀ x, is_unit (f x)) (x) : +@[to_additive] lemma coe_lift_right (f : M →* N) (hf : ∀ x, is_unit (f x)) (x) : (is_unit.lift_right f hf x : N) = f x := rfl -@[simp, to_additive] lemma is_unit.mul_lift_right_inv [monoid M] [monoid N] (f : M →* N) - (h : ∀ x, is_unit (f x)) (x) : f x * ↑(is_unit.lift_right f h x)⁻¹ = 1 := +@[simp, to_additive] lemma mul_lift_right_inv (f : M →* N) (h : ∀ x, is_unit (f x)) (x) : + f x * ↑(is_unit.lift_right f h x)⁻¹ = 1 := units.mul_lift_right_inv (λ y, rfl) x -@[simp, to_additive] lemma is_unit.lift_right_inv_mul [monoid M] [monoid N] (f : M →* N) - (h : ∀ x, is_unit (f x)) (x) : ↑(is_unit.lift_right f h x)⁻¹ * f x = 1 := +@[simp, to_additive] lemma lift_right_inv_mul (f : M →* N) (h : ∀ x, is_unit (f x)) (x) : + ↑(is_unit.lift_right f h x)⁻¹ * f x = 1 := units.lift_right_inv_mul (λ y, rfl) x +end monoid + +section division_monoid +variables [division_monoid α] {a b c : α} + +/-- The element of the group of units, corresponding to an element of a monoid which is a unit. As +opposed to `is_unit.unit`, the inverse is computable and comes from the inversion on `α`. This is +useful to transfer properties of inversion in `units α` to `α`. See also `to_units`. -/ +@[to_additive "The element of the additive group of additive units, corresponding to an element of +an additive monoid which is an additive unit. As opposed to `is_add_unit.add_unit`, the negation is +computable and comes from the negation on `α`. This is useful to transfer properties of negation in +`add_units α` to `α`. See also `to_add_units`.", simps] +def unit' (h : is_unit a) : αˣ := ⟨a, a⁻¹, h.mul_inv_cancel, h.inv_mul_cancel⟩ + +@[simp, to_additive] protected lemma mul_inv_cancel_left (h : is_unit a) : ∀ b, a * (a⁻¹ * b) = b := +h.unit'.mul_inv_cancel_left + +@[simp, to_additive] protected lemma inv_mul_cancel_left (h : is_unit a) : ∀ b, a⁻¹ * (a * b) = b := +h.unit'.inv_mul_cancel_left + +@[simp, to_additive] protected lemma mul_inv_cancel_right (h : is_unit b) (a : α) : + a * b * b⁻¹ = a := +h.unit'.mul_inv_cancel_right _ + +@[simp, to_additive] protected lemma inv_mul_cancel_right (h : is_unit b) (a : α) : + a * b⁻¹ * b = a := +h.unit'.inv_mul_cancel_right _ + +@[to_additive] protected lemma div_self (h : is_unit a) : a / a = 1 := +by rw [div_eq_mul_inv, h.mul_inv_cancel] + +@[to_additive] protected lemma eq_mul_inv_iff_mul_eq (h : is_unit c) : a = b * c⁻¹ ↔ a * c = b := +h.unit'.eq_mul_inv_iff_mul_eq + +@[to_additive] protected lemma eq_inv_mul_iff_mul_eq (h : is_unit b) : a = b⁻¹ * c ↔ b * a = c := +h.unit'.eq_inv_mul_iff_mul_eq + +@[to_additive] protected lemma inv_mul_eq_iff_eq_mul (h : is_unit a) : a⁻¹ * b = c ↔ b = a * c := +h.unit'.inv_mul_eq_iff_eq_mul + +@[to_additive] protected lemma mul_inv_eq_iff_eq_mul (h : is_unit b) : a * b⁻¹ = c ↔ a = c * b := +h.unit'.mul_inv_eq_iff_eq_mul + +@[to_additive] protected lemma mul_inv_eq_one (h : is_unit b) : a * b⁻¹ = 1 ↔ a = b := +@units.mul_inv_eq_one _ _ h.unit' _ + +@[to_additive] protected lemma inv_mul_eq_one (h : is_unit a) : a⁻¹ * b = 1 ↔ a = b := +@units.inv_mul_eq_one _ _ h.unit' _ + +@[to_additive] protected lemma mul_eq_one_iff_eq_inv (h : is_unit b) : a * b = 1 ↔ a = b⁻¹ := +@units.mul_eq_one_iff_eq_inv _ _ h.unit' _ + +@[to_additive] protected lemma mul_eq_one_iff_inv_eq (h : is_unit a) : a * b = 1 ↔ a⁻¹ = b := +@units.mul_eq_one_iff_inv_eq _ _ h.unit' _ + +@[simp, to_additive] protected lemma div_mul_cancel (h : is_unit b) (a : α) : a / b * b = a := +by rw [div_eq_mul_inv, h.inv_mul_cancel_right] + +@[simp, to_additive] protected lemma mul_div_cancel (h : is_unit b) (a : α) : a * b / b = a := +by rw [div_eq_mul_inv, h.mul_inv_cancel_right] + +@[to_additive] protected lemma mul_one_div_cancel (h : is_unit a) : a * (1 / a) = 1 := by simp [h] +@[to_additive] protected lemma one_div_mul_cancel (h : is_unit a) : (1 / a) * a = 1 := by simp [h] + +@[to_additive] lemma inv : is_unit a → is_unit a⁻¹ := +by { rintro ⟨u, rfl⟩, rw ←units.coe_inv, exact units.is_unit _ } + +@[to_additive] lemma div (ha : is_unit a) (hb : is_unit b) : is_unit (a / b) := +by { rw div_eq_mul_inv, exact ha.mul hb.inv } + +@[to_additive] protected lemma div_left_inj (h : is_unit c) : a / c = b / c ↔ a = b := +by { simp_rw div_eq_mul_inv, exact units.mul_left_inj h.inv.unit' } + +@[to_additive] protected lemma div_eq_iff (h : is_unit b) : a / b = c ↔ a = c * b := +by rw [div_eq_mul_inv, h.mul_inv_eq_iff_eq_mul] + +@[to_additive] protected lemma eq_div_iff (h : is_unit c) : a = b / c ↔ a * c = b := +by rw [div_eq_mul_inv, h.eq_mul_inv_iff_mul_eq] + +@[to_additive] protected lemma div_eq_of_eq_mul (h : is_unit b) : a = c * b → a / b = c := +h.div_eq_iff.2 + +@[to_additive] protected lemma eq_div_of_mul_eq (h : is_unit c) : a * c = b → a = b / c := +h.eq_div_iff.2 + +@[to_additive] protected lemma div_eq_one_iff_eq (h : is_unit b) : a / b = 1 ↔ a = b := +⟨eq_of_div_eq_one, λ hab, hab.symm ▸ h.div_self⟩ + +/-- The `group` version of this lemma is `div_mul_cancel'''` -/ +@[to_additive "The `add_group` version of this lemma is `sub_add_cancel''`"] +protected lemma div_mul_left (h : is_unit b) : b / (a * b) = 1 / a := +by rw [div_eq_mul_inv, mul_inv_rev, h.mul_inv_cancel_left, one_div] + +@[to_additive] protected lemma mul_div_mul_right (h : is_unit c) (a b : α) : + (a * c) / (b * c) = a / b := +by simp only [div_eq_mul_inv, mul_inv_rev, mul_assoc, h.mul_inv_cancel_left] + +@[to_additive] protected lemma mul_mul_div (a : α) (h : is_unit b) : a * b * (1 / b) = a := +by simp [h] + +end division_monoid + +section division_comm_monoid +variables [division_comm_monoid α] {a b c d : α} + +@[to_additive] protected lemma div_mul_right (h : is_unit a) (b : α) : a / (a * b) = 1 / b := +by rw [mul_comm, h.div_mul_left] + +@[to_additive] protected lemma mul_div_cancel_left (h : is_unit a) (b : α) : a * b / a = b := +by rw [mul_comm, h.mul_div_cancel] + +@[to_additive] protected lemma mul_div_cancel' (h : is_unit a) (b : α) : a * (b / a) = b := +by rw [mul_comm, h.div_mul_cancel] + +@[to_additive] protected lemma mul_div_mul_left (h : is_unit c) (a b : α) : + (c * a) / (c * b) = a / b := +by rw [mul_comm c, mul_comm c, h.mul_div_mul_right] + +@[to_additive] protected lemma mul_eq_mul_of_div_eq_div (hb : is_unit b) (hd : is_unit d) (a c : α) + (h : a / b = c / d) : a * d = c * b := +by rw [←mul_one a, ←hb.div_self, ←mul_comm_div, h, div_mul_eq_mul_div, hd.div_mul_cancel] + +@[to_additive] protected lemma div_eq_div_iff (hb : is_unit b) (hd : is_unit d) : + a / b = c / d ↔ a * d = c * b := +by rw [←(hb.mul hd).mul_left_inj, ←mul_assoc, hb.div_mul_cancel, ←mul_assoc, mul_right_comm, + hd.div_mul_cancel] + +@[to_additive] protected lemma div_div_cancel (h : is_unit a) : a / (a / b) = b := +by rw [div_div_eq_mul_div, h.mul_div_cancel_left] + +@[to_additive] protected lemma div_div_cancel_left (h : is_unit a) : + a / b / a = b⁻¹ := +by rw [div_eq_mul_inv, div_eq_mul_inv, mul_right_comm, h.mul_inv_cancel, one_mul] + +end division_comm_monoid end is_unit diff --git a/src/algebra/homology/Module.lean b/src/algebra/homology/Module.lean index 6f774f21b7f92..b2a096d7dfe9e 100644 --- a/src/algebra/homology/Module.lean +++ b/src/algebra/homology/Module.lean @@ -6,10 +6,14 @@ Authors: Scott Morrison import algebra.homology.homotopy import algebra.category.Module.abelian import algebra.category.Module.subobject +import category_theory.limits.concrete_category /-! # Complexes of modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide some additional API to work with homological complexes in `Module R`. -/ @@ -80,14 +84,19 @@ example (f g : C ⟶ D) (h : homotopy f g) (i : ι) : begin -- To check that two morphisms out of a homology group agree, it suffices to check on cycles: ext, - dsimp, - simp only [homology.π_map_apply], + simp only [homology_functor_map, homology.π_map_apply], -- To check that two elements are equal mod boundaries, it suffices to exhibit a boundary: ext1, swap, exact (to_prev i h.hom) x.1, -- Moreover, to check that two cycles are equal, it suffices to check their underlying elements: ext1, - simp [h.comm i, x.2]; abel, + simp only [map_add, image_to_kernel_arrow_apply, homological_complex.hom.sq_from_left, + Module.to_kernel_subobject_arrow, category_theory.limits.kernel_subobject_map_arrow_apply, + d_next_eq_d_from_from_next, function.comp_app, zero_add, Module.coe_comp, + linear_map.add_apply, map_zero, subtype.val_eq_coe, + category_theory.limits.image_subobject_arrow_comp_apply, linear_map.map_coe_ker, + prev_d_eq_to_prev_d_to, h.comm i, x.2], + abel end end Module diff --git a/src/algebra/homology/additive.lean b/src/algebra/homology/additive.lean index af7261722dc07..d7df969443b34 100644 --- a/src/algebra/homology/additive.lean +++ b/src/algebra/homology/additive.lean @@ -10,6 +10,9 @@ import category_theory.preadditive.additive_functor /-! # Homology is an additive functor +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `V` is preadditive, `homological_complex V c` is also preadditive, and `homology_functor` is additive. @@ -35,10 +38,10 @@ instance : has_zero (C ⟶ D) := ⟨{ f := λ i, 0 }⟩ instance : has_add (C ⟶ D) := ⟨λ f g, { f := λ i, f.f i + g.f i, }⟩ instance : has_neg (C ⟶ D) := ⟨λ f, { f := λ i, -(f.f i) }⟩ instance : has_sub (C ⟶ D) := ⟨λ f g, { f := λ i, f.f i - g.f i, }⟩ -instance has_nat_scalar : has_scalar ℕ (C ⟶ D) := ⟨λ n f, +instance has_nat_scalar : has_smul ℕ (C ⟶ D) := ⟨λ n f, { f := λ i, n • f.f i, comm' := λ i j h, by simp [preadditive.nsmul_comp, preadditive.comp_nsmul] }⟩ -instance has_int_scalar : has_scalar ℤ (C ⟶ D) := ⟨λ n f, +instance has_int_scalar : has_smul ℤ (C ⟶ D) := ⟨λ n f, { f := λ i, n • f.f i, comm' := λ i j h, by simp [preadditive.zsmul_comp, preadditive.comp_zsmul] }⟩ @@ -67,8 +70,6 @@ namespace homological_complex instance eval_additive (i : ι) : (eval V c i).additive := {} -variables [has_zero_object V] - instance cycles_additive [has_equalizers V] : (cycles_functor V c i).additive := {} variables [has_images V] [has_image_maps V] @@ -109,9 +110,31 @@ def functor.map_homological_complex (F : V ⥤ W) [F.additive] (c : complex_shap { f := λ i, F.map (f.f i), comm' := λ i j h, by { dsimp, rw [←F.map_comp, ←F.map_comp, f.comm], }, }, }. +variable (V) + +/-- The functor on homological complexes induced by the identity functor is +isomorphic to the identity functor. -/ +@[simps] +def functor.map_homological_complex_id_iso (c : complex_shape ι) : + (𝟭 V).map_homological_complex c ≅ 𝟭 _ := +nat_iso.of_components (λ K, hom.iso_of_components (λ i, iso.refl _) (by tidy)) (by tidy) + +variable {V} + instance functor.map_homogical_complex_additive (F : V ⥤ W) [F.additive] (c : complex_shape ι) : (F.map_homological_complex c).additive := {} +instance functor.map_homological_complex_reflects_iso + (F : V ⥤ W) [F.additive] [reflects_isomorphisms F] (c : complex_shape ι) : + reflects_isomorphisms (F.map_homological_complex c) := +⟨λ X Y f, begin + introI, + haveI : ∀ (n : ι), is_iso (F.map (f.f n)) := λ n, is_iso.of_iso + ((homological_complex.eval W c n).map_iso (as_iso ((F.map_homological_complex c).map f))), + haveI := λ n, is_iso_of_reflects_iso (f.f n) F, + exact homological_complex.hom.is_iso_of_components f, +end⟩ + /-- A natural transformation between functors induces a natural transformation between those functors applied to homological complexes. @@ -138,6 +161,32 @@ by tidy (nat_trans.map_homological_complex α c).app C ≫ (G.map_homological_complex c).map f := by tidy +/-- +A natural isomorphism between functors induces a natural isomorphism +between those functors applied to homological complexes. +-/ +@[simps] +def nat_iso.map_homological_complex {F G : V ⥤ W} [F.additive] [G.additive] + (α : F ≅ G) (c : complex_shape ι) : F.map_homological_complex c ≅ G.map_homological_complex c := +{ hom := α.hom.map_homological_complex c, + inv := α.inv.map_homological_complex c, + hom_inv_id' := by simpa only [← nat_trans.map_homological_complex_comp, α.hom_inv_id], + inv_hom_id' := by simpa only [← nat_trans.map_homological_complex_comp, α.inv_hom_id], } + +/-- +An equivalence of categories induces an equivalences between the respective categories +of homological complex. +-/ +@[simps] +def equivalence.map_homological_complex (e : V ≌ W) [e.functor.additive] (c : complex_shape ι): + homological_complex V c ≌ homological_complex W c := +{ functor := e.functor.map_homological_complex c, + inverse := e.inverse.map_homological_complex c, + unit_iso := (functor.map_homological_complex_id_iso V c).symm ≪≫ + nat_iso.map_homological_complex e.unit_iso c, + counit_iso := nat_iso.map_homological_complex e.counit_iso c ≪≫ + functor.map_homological_complex_id_iso W c, } + end category_theory namespace chain_complex @@ -163,6 +212,8 @@ variables [has_zero_object V] {W : Type*} [category W] [preadditive W] [has_zero namespace homological_complex +local attribute [simp] eq_to_hom_map + /-- Turning an object into a complex supported at `j` then applying a functor is the same as applying the functor then forming the complex. diff --git a/src/algebra/homology/augment.lean b/src/algebra/homology/augment.lean index 6904f0708305b..0eed5748bf070 100644 --- a/src/algebra/homology/augment.lean +++ b/src/algebra/homology/augment.lean @@ -4,10 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import algebra.homology.single -import tactic.linarith /-! # Augmentation and truncation of `ℕ`-indexed (co)chain complexes. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ noncomputable theory diff --git a/src/algebra/homology/complex_shape.lean b/src/algebra/homology/complex_shape.lean index 1a31f498d7581..94b6110670cc5 100644 --- a/src/algebra/homology/complex_shape.lean +++ b/src/algebra/homology/complex_shape.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin, Scott Morrison -/ import algebra.group.defs -import data.option.basic import logic.relation /-! # Shapes of homological complexes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define a structure `complex_shape ι` for describing the shapes of homological complexes indexed by a type `ι`. This is intended to capture chain complexes and cochain complexes, indexed by either `ℕ` or `ℤ`, @@ -23,8 +25,8 @@ we only allow nonzero differentials `d i j` from `i` to `j` if `c.rel i j`. Further, we require that `{ j // c.rel i j }` and `{ i // c.rel i j }` are subsingletons. This means that the shape consists of some union of lines, rays, intervals, and circles. -Convenience functions `c.next` and `c.prev` provide, as an `option`, these related elements -when they exist. +Convenience functions `c.next` and `c.prev` provide these related elements +when they exist, and return their input otherwise. This design aims to avoid certain problems arising from dependent type theory. In particular we never have to ensure morphisms `d i : X i ⟶ X (succ i)` compose as @@ -54,9 +56,9 @@ and we will only allow a non-zero differential from `i` to `j` when `rel i j`. There are axioms which imply `{ j // c.rel i j }` and `{ i // c.rel i j }` are subsingletons. This means that the shape consists of some union of lines, rays, intervals, and circles. -Below we define `c.next` and `c.prev` which provide, as an `option`, these related elements. +Below we define `c.next` and `c.prev` which provide these related elements. -/ -@[ext, nolint has_inhabited_instance] +@[ext, nolint has_nonempty_instance] structure complex_shape (ι : Type*) := (rel : ι → ι → Prop) (next_eq : ∀ {i j j'}, rel i j → rel i j' → j = j') @@ -131,22 +133,24 @@ begin end /-- -An option-valued arbitary choice of index `j` such that `rel i j`, if such exists. +An arbitary choice of index `j` such that `rel i j`, if such exists. +Returns `i` otherwise. -/ -def next (c : complex_shape ι) (i : ι) : option { j // c.rel i j } := -option.choice _ +def next (c : complex_shape ι) (i : ι) : ι := +if h : ∃ j, c.rel i j then h.some else i /-- -An option-valued arbitary choice of index `i` such that `rel i j`, if such exists. +An arbitary choice of index `i` such that `rel i j`, if such exists. +Returns `j` otherwise. -/ -def prev (c : complex_shape ι) (j : ι) : option { i // c.rel i j } := -option.choice _ +def prev (c : complex_shape ι) (j : ι) : ι := +if h : ∃ i, c.rel i j then h.some else j -lemma next_eq_some (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.next i = some ⟨j, h⟩ := -option.choice_eq _ +lemma next_eq' (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.next i = j := +by { apply c.next_eq _ h, dsimp only [next], rw dif_pos, exact Exists.some_spec ⟨j, h⟩, } -lemma prev_eq_some (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.prev j = some ⟨i, h⟩ := -option.choice_eq _ +lemma prev_eq' (c : complex_shape ι) {i j : ι} (h : c.rel i j) : c.prev j = i := +by { apply c.prev_eq _ h, dsimp only [prev], rw dif_pos, exact Exists.some_spec ⟨i, h⟩, } /-- The `complex_shape` allowing differentials from `X i` to `X (i+a)`. diff --git a/src/algebra/homology/differential_object.lean b/src/algebra/homology/differential_object.lean index 12a6920cb0ba9..03f8f3839d349 100644 --- a/src/algebra/homology/differential_object.lean +++ b/src/algebra/homology/differential_object.lean @@ -9,6 +9,9 @@ import category_theory.differential_object /-! # Homological complexes are differential graded objects. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We verify that a `homological_complex` indexed by an `add_comm_group` is essentially the same thing as a differential graded object. diff --git a/src/algebra/homology/exact.lean b/src/algebra/homology/exact.lean index cb4411a7c6047..a38897e0d7ada 100644 --- a/src/algebra/homology/exact.lean +++ b/src/algebra/homology/exact.lean @@ -8,6 +8,9 @@ import algebra.homology.image_to_kernel /-! # Exact sequences +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In a category with zero morphisms, images, and equalizers we say that `f : A ⟶ B` and `g : B ⟶ C` are exact if `f ≫ g = 0` and the natural map `image f ⟶ kernel g` is an epimorphism. @@ -198,13 +201,17 @@ begin apply_instance, end +/-- The dual of this lemma is only true when `V` is abelian, see `abelian.exact_epi_comp_iff`. -/ +lemma exact_comp_mono_iff [mono h] : exact f (g ≫ h) ↔ exact f g := +begin + refine ⟨λ hfg, ⟨zero_of_comp_mono h (by rw [category.assoc, hfg.1]), _⟩, λ h, exact_comp_mono h⟩, + rw ← (iso.eq_comp_inv _).1 (image_to_kernel_comp_mono _ _ h hfg.1), + haveI := hfg.2, apply_instance +end + @[simp] lemma exact_comp_iso [is_iso h] : exact f (g ≫ h) ↔ exact f g := -⟨λ w, begin - rw [←category.comp_id g, ←is_iso.hom_inv_id h, ←category.assoc], - exactI exact_comp_mono w, - end, - λ w, exact_comp_mono w⟩ +exact_comp_mono_iff lemma exact_kernel_subobject_arrow : exact (kernel_subobject f).arrow f := begin diff --git a/src/algebra/homology/flip.lean b/src/algebra/homology/flip.lean index 8963be0280c5d..310b4ac89443a 100644 --- a/src/algebra/homology/flip.lean +++ b/src/algebra/homology/flip.lean @@ -8,6 +8,9 @@ import algebra.homology.homological_complex /-! # Flip a complex of complexes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For now we don't have double complexes as a distinct thing, but we can model them as complexes of complexes. diff --git a/src/algebra/homology/functor.lean b/src/algebra/homology/functor.lean index 87f4bc213bacc..cee1f32ec5ddd 100644 --- a/src/algebra/homology/functor.lean +++ b/src/algebra/homology/functor.lean @@ -8,6 +8,9 @@ import algebra.homology.homological_complex /-! # Complexes in functor categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We can view a complex valued in a functor category `T ⥤ V` as a functor from `T` to complexes valued in `V`. diff --git a/src/algebra/homology/homological_complex.lean b/src/algebra/homology/homological_complex.lean index 7c4851e060cc3..7bbcf28f61770 100644 --- a/src/algebra/homology/homological_complex.lean +++ b/src/algebra/homology/homological_complex.lean @@ -10,6 +10,9 @@ import category_theory.graded_object /-! # Homological complexes. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A `homological_complex V c` with a "shape" controlled by `c : complex_shape ι` has chain groups `X i` (objects in `V`) indexed by `i : ι`, and a differential `d i j` whenever `c.rel i j`. @@ -27,7 +30,7 @@ and similarly `cochain_complex V α`, with `i = j + 1`. There is a category structure, where morphisms are chain maps. For `C : homological_complex V c`, we define `C.X_next i`, which is either `C.X j` for some -arbitrarily chosen `j` such that `c.r i j`, or the zero object if there is no such `j`. +arbitrarily chosen `j` such that `c.r i j`, or `C.X i` if there is no such `j`. Similarly we have `C.X_prev j`. Defined in terms of these we have `C.d_from i : C.X i ⟶ C.X_next i` and `C.d_to j : C.X_prev j ⟶ C.X j`, which are either defined as `C.d i j`, or zero, as needed. @@ -108,40 +111,40 @@ homological_complex V (complex_shape.up α) namespace chain_complex @[simp] lemma prev (α : Type*) [add_right_cancel_semigroup α] [has_one α] (i : α) : - (complex_shape.down α).prev i = some ⟨i+1, rfl⟩ := -option.choice_eq _ + (complex_shape.down α).prev i = i+1 := +(complex_shape.down α).prev_eq' rfl @[simp] lemma next (α : Type*) [add_group α] [has_one α] (i : α) : - (complex_shape.down α).next i = some ⟨i-1, sub_add_cancel i 1⟩ := -option.choice_eq _ + (complex_shape.down α).next i = i-1 := +(complex_shape.down α).next_eq' $ sub_add_cancel _ _ @[simp] lemma next_nat_zero : - (complex_shape.down ℕ).next 0 = none := -@option.choice_eq_none _ ⟨by rintro ⟨j, ⟨⟩⟩⟩ + (complex_shape.down ℕ).next 0 = 0 := +by { classical, refine dif_neg _, push_neg, intro, apply nat.no_confusion } @[simp] lemma next_nat_succ (i : ℕ) : - (complex_shape.down ℕ).next (i+1) = some ⟨i, rfl⟩ := -option.choice_eq _ + (complex_shape.down ℕ).next (i+1) = i := +(complex_shape.down ℕ).next_eq' rfl end chain_complex namespace cochain_complex @[simp] lemma prev (α : Type*) [add_group α] [has_one α] (i : α) : - (complex_shape.up α).prev i = some ⟨i-1, sub_add_cancel i 1⟩ := -option.choice_eq _ + (complex_shape.up α).prev i = i-1 := +(complex_shape.up α).prev_eq' $ sub_add_cancel _ _ @[simp] lemma next (α : Type*) [add_right_cancel_semigroup α] [has_one α] (i : α) : - (complex_shape.up α).next i = some ⟨i+1, rfl⟩ := -option.choice_eq _ + (complex_shape.up α).next i = i+1 := +(complex_shape.up α).next_eq' rfl @[simp] lemma prev_nat_zero : - (complex_shape.up ℕ).prev 0 = none := -@option.choice_eq_none _ ⟨by rintro ⟨j, ⟨⟩⟩⟩ + (complex_shape.up ℕ).prev 0 = 0 := +by { classical, refine dif_neg _, push_neg, intro, apply nat.no_confusion } @[simp] lemma prev_nat_succ (i : ℕ) : - (complex_shape.up ℕ).prev (i+1) = some ⟨i, rfl⟩ := -option.choice_eq _ + (complex_shape.up ℕ).prev (i+1) = i := +(complex_shape.up ℕ).prev_eq' rfl end cochain_complex @@ -290,135 +293,95 @@ end section -variables [has_zero_object V] -open_locale zero_object - -/-- Either `C.X i`, if there is some `i` with `c.rel i j`, or the zero object. -/ -def X_prev (j : ι) : V := -match c.prev j with -| none := 0 -| (some ⟨i,_⟩) := C.X i -end +/-- Either `C.X i`, if there is some `i` with `c.rel i j`, or `C.X j`. -/ +abbreviation X_prev (j : ι) : V := C.X (c.prev j) /-- If `c.rel i j`, then `C.X_prev j` is isomorphic to `C.X i`. -/ def X_prev_iso {i j : ι} (r : c.rel i j) : C.X_prev j ≅ C.X i := -eq_to_iso begin - dsimp [X_prev], - rw c.prev_eq_some r, - refl, -end +eq_to_iso $ by rw ← c.prev_eq' r -/-- If there is no `i` so `c.rel i j`, then `C.X_prev j` is isomorphic to `0`. -/ -def X_prev_iso_zero {j : ι} (h : c.prev j = none) : - C.X_prev j ≅ 0 := -eq_to_iso begin - dsimp [X_prev], - rw h, - refl, +/-- If there is no `i` so `c.rel i j`, then `C.X_prev j` is isomorphic to `C.X j`. -/ +def X_prev_iso_self {j : ι} (h : ¬c.rel (c.prev j) j) : + C.X_prev j ≅ C.X j := +eq_to_iso $ congr_arg C.X begin + dsimp [complex_shape.prev], + rw dif_neg, push_neg, intros i hi, + have : c.prev j = i := c.prev_eq' hi, + rw this at h, contradiction, end -/-- Either `C.X j`, if there is some `j` with `c.rel i j`, or the zero object. -/ -def X_next (i : ι) : V := -match c.next i with -| none := 0 -| (some ⟨j,_⟩) := C.X j -end +/-- Either `C.X j`, if there is some `j` with `c.rel i j`, or `C.X i`. -/ +abbreviation X_next (i : ι) : V := C.X (c.next i) /-- If `c.rel i j`, then `C.X_next i` is isomorphic to `C.X j`. -/ def X_next_iso {i j : ι} (r : c.rel i j) : C.X_next i ≅ C.X j := -eq_to_iso begin - dsimp [X_next], - rw c.next_eq_some r, - refl, -end +eq_to_iso $ by rw ← c.next_eq' r -/-- If there is no `j` so `c.rel i j`, then `C.X_next i` is isomorphic to `0`. -/ -def X_next_iso_zero {i : ι} (h : c.next i = none) : - C.X_next i ≅ 0 := -eq_to_iso begin - dsimp [X_next], - rw h, - refl, +/-- If there is no `j` so `c.rel i j`, then `C.X_next i` is isomorphic to `C.X i`. -/ +def X_next_iso_self {i : ι} (h : ¬c.rel i (c.next i)) : + C.X_next i ≅ C.X i := +eq_to_iso $ congr_arg C.X begin + dsimp [complex_shape.next], + rw dif_neg, rintro ⟨j, hj⟩, + have : c.next i = j := c.next_eq' hj, + rw this at h, contradiction, end /-- The differential mapping into `C.X j`, or zero if there isn't one. -/ -def d_to (j : ι) : C.X_prev j ⟶ C.X j := -match c.prev j with -| none := (0 : C.X_prev j ⟶ C.X j) -| (some ⟨i, w⟩) := (C.X_prev_iso w).hom ≫ C.d i j -end +abbreviation d_to (j : ι) : C.X_prev j ⟶ C.X j := C.d (c.prev j) j /-- The differential mapping out of `C.X i`, or zero if there isn't one. -/ -def d_from (i : ι) : C.X i ⟶ C.X_next i := -match c.next i with -| none := (0 : C.X i ⟶ C.X_next i) -| (some ⟨j, w⟩) := C.d i j ≫ (C.X_next_iso w).inv -end +abbreviation d_from (i : ι) : C.X i ⟶ C.X_next i := C.d i (c.next i) lemma d_to_eq {i j : ι} (r : c.rel i j) : C.d_to j = (C.X_prev_iso r).hom ≫ C.d i j := begin - dsimp [d_to, X_prev_iso], - rw c.prev_eq_some r, - refl, + obtain rfl := c.prev_eq' r, + exact (category.id_comp _).symm, end @[simp] -lemma d_to_eq_zero {j : ι} (h : c.prev j = none) : +lemma d_to_eq_zero {j : ι} (h : ¬c.rel (c.prev j) j) : C.d_to j = 0 := -begin - dsimp [d_to], - rw h, refl, -end +C.shape _ _ h lemma d_from_eq {i j : ι} (r : c.rel i j) : C.d_from i = C.d i j ≫ (C.X_next_iso r).inv := begin - dsimp [d_from, X_next_iso], - rw c.next_eq_some r, - refl, + obtain rfl := c.next_eq' r, + exact (category.comp_id _).symm, end @[simp] -lemma d_from_eq_zero {i : ι} (h : c.next i = none) : +lemma d_from_eq_zero {i : ι} (h : ¬c.rel i (c.next i)) : C.d_from i = 0 := -begin - dsimp [d_from], - rw h, refl, -end +C.shape _ _ h @[simp, reassoc] lemma X_prev_iso_comp_d_to {i j : ι} (r : c.rel i j) : (C.X_prev_iso r).inv ≫ C.d_to j = C.d i j := by simp [C.d_to_eq r] -@[simp, reassoc] lemma X_prev_iso_zero_comp_d_to {j : ι} (h : c.prev j = none) : - (C.X_prev_iso_zero h).inv ≫ C.d_to j = 0 := +@[simp, reassoc] lemma X_prev_iso_self_comp_d_to {j : ι} (h : ¬c.rel (c.prev j) j) : + (C.X_prev_iso_self h).inv ≫ C.d_to j = 0 := by simp [h] @[simp, reassoc] lemma d_from_comp_X_next_iso {i j : ι} (r : c.rel i j) : C.d_from i ≫ (C.X_next_iso r).hom = C.d i j := by simp [C.d_from_eq r] -@[simp, reassoc] lemma d_from_comp_X_next_iso_zero {i : ι} (h : c.next i = none) : - C.d_from i ≫ (C.X_next_iso_zero h).hom = 0 := +@[simp, reassoc] lemma d_from_comp_X_next_iso_self {i : ι} (h : ¬c.rel i (c.next i)) : + C.d_from i ≫ (C.X_next_iso_self h).hom = 0 := by simp [h] @[simp] lemma d_to_comp_d_from (j : ι) : C.d_to j ≫ C.d_from j = 0 := -begin - rcases h₁ : c.next j with _ | ⟨k,w₁⟩, - { rw [d_from_eq_zero _ h₁], simp }, - { rw [d_from_eq _ w₁], - rcases h₂ : c.prev j with _ | ⟨i,w₂⟩, - { rw [d_to_eq_zero _ h₂], simp }, - { rw [d_to_eq _ w₂], simp } } -end +C.d_comp_d _ _ _ lemma kernel_from_eq_kernel [has_kernels V] {i j : ι} (r : c.rel i j) : kernel_subobject (C.d_from i) = kernel_subobject (C.d i j) := @@ -468,58 +431,45 @@ def iso_of_components (f : Π i, C₁.X i ≅ C₂.X i) iso_app (iso_of_components f hf) i = f i := by { ext, simp, } -variables [has_zero_object V] -open_locale zero_object +lemma is_iso_of_components (f : C₁ ⟶ C₂) [∀ (n : ι), is_iso (f.f n)] : is_iso f := +begin + convert is_iso.of_iso (homological_complex.hom.iso_of_components (λ n, as_iso (f.f n)) + (by tidy)), + ext n, + refl, +end /-! Lemmas relating chain maps and `d_to`/`d_from`. -/ -/-- `f.prev j` is `f.f i` if there is some `r i j`, and zero otherwise. -/ -def prev (f : hom C₁ C₂) (j : ι) : C₁.X_prev j ⟶ C₂.X_prev j := -match c.prev j with -| none := 0 -| some ⟨i,w⟩ := (C₁.X_prev_iso w).hom ≫ f.f i ≫ (C₂.X_prev_iso w).inv -end +/-- `f.prev j` is `f.f i` if there is some `r i j`, and `f.f j` otherwise. -/ +abbreviation prev (f : hom C₁ C₂) (j : ι) : C₁.X_prev j ⟶ C₂.X_prev j := f.f _ lemma prev_eq (f : hom C₁ C₂) {i j : ι} (w : c.rel i j) : f.prev j = (C₁.X_prev_iso w).hom ≫ f.f i ≫ (C₂.X_prev_iso w).inv := begin - dsimp [prev], - rw c.prev_eq_some w, - refl, + obtain rfl := c.prev_eq' w, + simp only [X_prev_iso, eq_to_iso_refl, iso.refl_hom, iso.refl_inv, id_comp, comp_id], end -/-- `f.next i` is `f.f j` if there is some `r i j`, and zero otherwise. -/ -def next (f : hom C₁ C₂) (i : ι) : C₁.X_next i ⟶ C₂.X_next i := -match c.next i with -| none := 0 -| some ⟨j,w⟩ := (C₁.X_next_iso w).hom ≫ f.f j ≫ (C₂.X_next_iso w).inv -end +/-- `f.next i` is `f.f j` if there is some `r i j`, and `f.f j` otherwise. -/ +abbreviation next (f : hom C₁ C₂) (i : ι) : C₁.X_next i ⟶ C₂.X_next i := f.f _ lemma next_eq (f : hom C₁ C₂) {i j : ι} (w : c.rel i j) : f.next i = (C₁.X_next_iso w).hom ≫ f.f j ≫ (C₂.X_next_iso w).inv := begin - dsimp [next], - rw c.next_eq_some w, - refl, + obtain rfl := c.next_eq' w, + simp only [X_next_iso, eq_to_iso_refl, iso.refl_hom, iso.refl_inv, id_comp, comp_id], end @[simp, reassoc, elementwise] lemma comm_from (f : hom C₁ C₂) (i : ι) : f.f i ≫ C₂.d_from i = C₁.d_from i ≫ f.next i := -begin - rcases h : c.next i with _ | ⟨j,w⟩, - { simp [h] }, - { simp [d_from_eq _ w, next_eq _ w] } -end +f.comm _ _ @[simp, reassoc, elementwise] lemma comm_to (f : hom C₁ C₂) (j : ι) : f.prev j ≫ C₂.d_to j = C₁.d_to j ≫ f.f j := -begin - rcases h : c.prev j with _ | ⟨j,w⟩, - { simp [h] }, - { simp [d_to_eq _ w, prev_eq _ w] } -end +f.comm _ _ /-- A morphism of chain complexes @@ -531,30 +481,10 @@ arrow.hom_mk (f.comm_from i) @[simp] lemma sq_from_left (f : hom C₁ C₂) (i : ι) : (f.sq_from i).left = f.f i := rfl @[simp] lemma sq_from_right (f : hom C₁ C₂) (i : ι) : (f.sq_from i).right = f.next i := rfl -@[simp] lemma sq_from_id (C₁ : homological_complex V c) (i : ι) : sq_from (𝟙 C₁) i = 𝟙 _ := -begin - rcases h : c.next i with _ | ⟨j,w⟩, - { ext, - { refl }, - { dsimp, simp only [next, h], - symmetry, - apply zero_of_target_iso_zero, - exact X_next_iso_zero _ h } }, - { ext, refl, dsimp, simp [next, h] } -end +@[simp] lemma sq_from_id (C₁ : homological_complex V c) (i : ι) : sq_from (𝟙 C₁) i = 𝟙 _ := rfl @[simp] lemma sq_from_comp (f : C₁ ⟶ C₂) (g : C₂ ⟶ C₃) (i : ι) : - sq_from (f ≫ g) i = sq_from f i ≫ sq_from g i := -begin - rcases h : c.next i with _ | ⟨j,w⟩, - { ext, - { refl }, - { dsimp, simp only [next, h], - symmetry, - apply zero_of_target_iso_zero, - exact X_next_iso_zero _ h } }, - { ext, refl, dsimp, simp [next, h] } -end + sq_from (f ≫ g) i = sq_from f i ≫ sq_from g i := rfl /-- A morphism of chain complexes @@ -633,7 +563,7 @@ Auxiliary structure for setting up the recursion in `mk`. This is purely an implementation detail: for some reason just using the dependent 6-tuple directly results in `mk_aux` taking much longer (well over the `-T100000` limit) to elaborate. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure mk_struct := (X₀ X₁ X₂ : V) (d₀ : X₁ ⟶ X₀) @@ -826,7 +756,7 @@ Auxiliary structure for setting up the recursion in `mk`. This is purely an implementation detail: for some reason just using the dependent 6-tuple directly results in `mk_aux` taking much longer (well over the `-T100000` limit) to elaborate. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure mk_struct := (X₀ X₁ X₂ : V) (d₀ : X₀ ⟶ X₁) diff --git a/src/algebra/homology/homology.lean b/src/algebra/homology/homology.lean index 786a74f5d3a9c..348197a115a68 100644 --- a/src/algebra/homology/homology.lean +++ b/src/algebra/homology/homology.lean @@ -10,6 +10,9 @@ import category_theory.graded_object /-! # The homology of a complex +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given `C : homological_complex V c`, we have `C.cycles i` and `C.boundaries i`, both defined as subobjects of `C.X i`. @@ -33,8 +36,6 @@ noncomputable theory namespace homological_complex -variables [has_zero_object V] - section cycles variables [has_kernels V] @@ -55,7 +56,7 @@ def cycles_iso_kernel {i j : ι} (r : c.rel i j) : subobject.iso_of_eq _ _ (C.cycles_eq_kernel_subobject r) ≪≫ kernel_subobject_iso (C.d i j) -lemma cycles_eq_top {i} (h : c.next i = none) : C.cycles i = ⊤ := +lemma cycles_eq_top {i} (h : ¬c.rel i (c.next i)) : C.cycles i = ⊤ := begin rw eq_top_iff, apply le_kernel_subobject, @@ -84,7 +85,8 @@ def boundaries_iso_image [has_equalizers V] {i j : ι} (r : c.rel i j) : subobject.iso_of_eq _ _ (C.boundaries_eq_image_subobject r) ≪≫ image_subobject_iso (C.d i j) -lemma boundaries_eq_bot {j} (h : c.prev j = none) : C.boundaries j = ⊥ := +lemma boundaries_eq_bot [has_zero_object V] {j} (h : ¬c.rel (c.prev j) j) : + C.boundaries j = ⊥ := begin rw eq_bot_iff, refine image_subobject_le _ 0 _, @@ -120,15 +122,61 @@ The homology of a complex at index `i`. abbreviation homology (C : homological_complex V c) (i : ι) : V := homology (C.d_to i) (C.d_from i) (C.d_to_comp_d_from i) +/-- The `j`th homology of a homological complex (as kernel of 'the differential from `Cⱼ`' modulo +the image of 'the differential to `Cⱼ`') is isomorphic to the kernel of `d : Cⱼ → Cₖ` modulo +the image of `d : Cᵢ → Cⱼ` when `rel i j` and `rel j k`. -/ +def homology_iso (C : homological_complex V c) {i j k : ι} (hij : c.rel i j) (hjk : c.rel j k) : + C.homology j ≅ _root_.homology (C.d i j) (C.d j k) (C.d_comp_d i j k) := +homology.map_iso _ _ (arrow.iso_mk (C.X_prev_iso hij) (iso.refl _) $ by dsimp; + rw [C.d_to_eq hij, category.comp_id]) +(arrow.iso_mk (iso.refl _) (C.X_next_iso hjk) $ by dsimp; rw [C.d_from_comp_X_next_iso hjk, + category.id_comp]) rfl end end homological_complex +/-- The 0th homology of a chain complex is isomorphic to the cokernel of `d : C₁ ⟶ C₀`. -/ +def chain_complex.homology_zero_iso [has_kernels V] [has_images V] [has_cokernels V] + (C : chain_complex V ℕ) [epi (factor_thru_image (C.d 1 0))] : + C.homology 0 ≅ cokernel (C.d 1 0) := +(homology.map_iso _ _ (arrow.iso_mk (C.X_prev_iso rfl) (iso.refl _) $ +by rw C.d_to_eq rfl; exact (category.comp_id _).symm : arrow.mk (C.d_to 0) ≅ arrow.mk (C.d 1 0)) + (arrow.iso_mk (iso.refl _) (iso.refl _) $ +by simp [C.d_from_eq_zero (λ (h : _ = _), one_ne_zero $ by + rwa chain_complex.next_nat_zero at h)] : arrow.mk (C.d_from 0) ≅ arrow.mk 0) rfl).trans $ +homology_of_zero_right _ + +/-- The 0th cohomology of a cochain complex is isomorphic to the kernel of `d : C₀ → C₁`. -/ +def cochain_complex.homology_zero_iso [has_zero_object V] + [has_kernels V] [has_images V] [has_cokernels V] (C : cochain_complex V ℕ) : + C.homology 0 ≅ kernel (C.d 0 1) := +(homology.map_iso _ _ (arrow.iso_mk (C.X_prev_iso_self (by rw cochain_complex.prev_nat_zero; + exact one_ne_zero)) (iso.refl _) (by simp) : arrow.mk (C.d_to 0) ≅ arrow.mk 0) + (arrow.iso_mk (iso.refl _) (C.X_next_iso rfl) + (by simp) : arrow.mk (C.d_from 0) ≅ arrow.mk (C.d 0 1)) $ by simpa).trans $ +homology_of_zero_left _ + +/-- The `n + 1`th homology of a chain complex (as kernel of 'the differential from `Cₙ₊₁`' modulo +the image of 'the differential to `Cₙ₊₁`') is isomorphic to the kernel of `d : Cₙ₊₁ → Cₙ` modulo +the image of `d : Cₙ₊₂ → Cₙ₊₁`. -/ +def chain_complex.homology_succ_iso [has_kernels V] [has_images V] [has_cokernels V] + (C : chain_complex V ℕ) (n : ℕ) : + C.homology (n + 1) ≅ homology (C.d (n + 2) (n + 1)) (C.d (n + 1) n) (C.d_comp_d _ _ _) := +C.homology_iso rfl rfl + +/-- The `n + 1`th cohomology of a cochain complex (as kernel of 'the differential from `Cₙ₊₁`' +modulo the image of 'the differential to `Cₙ₊₁`') is isomorphic to the kernel of `d : Cₙ₊₁ → Cₙ₊₂` +modulo the image of `d : Cₙ → Cₙ₊₁`. -/ +def cochain_complex.homology_succ_iso [has_kernels V] [has_images V] [has_cokernels V] + (C : cochain_complex V ℕ) (n : ℕ) : + C.homology (n + 1) ≅ homology (C.d n (n + 1)) (C.d (n + 1) (n + 2)) (C.d_comp_d _ _ _) := +C.homology_iso rfl rfl + open homological_complex /-! Computing the cycles is functorial. -/ section -variables [has_zero_object V] [has_kernels V] +variables [has_kernels V] variables {C₁ C₂ C₃ : homological_complex V c} (f : C₁ ⟶ C₂) /-- @@ -161,7 +209,7 @@ end /-! Computing the boundaries is functorial. -/ section -variables [has_zero_object V] [has_images V] [has_image_maps V] +variables [has_images V] [has_image_maps V] variables {C₁ C₂ C₃ : homological_complex V c} (f : C₁ ⟶ C₂) /-- @@ -183,7 +231,7 @@ end section /-! The `boundaries_to_cycles` morphisms are natural. -/ -variables [has_zero_object V] [has_equalizers V] [has_images V] [has_image_maps V] +variables [has_equalizers V] [has_images V] [has_image_maps V] variables {C₁ C₂ : homological_complex V c} (f : C₁ ⟶ C₂) @[simp, reassoc] diff --git a/src/algebra/homology/homotopy.lean b/src/algebra/homology/homotopy.lean index 5d37a03874969..df7241c4395d3 100644 --- a/src/algebra/homology/homotopy.lean +++ b/src/algebra/homology/homotopy.lean @@ -9,6 +9,9 @@ import tactic.abel /-! # Chain homotopies +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define chain homotopies, and prove that homotopic chain maps induce the same map on homology. -/ @@ -30,164 +33,90 @@ section /-- The composition of `C.d i i' ≫ f i' i` if there is some `i'` coming after `i`, and `0` otherwise. -/ def d_next (i : ι) : (Π i j, C.X i ⟶ D.X j) →+ (C.X i ⟶ D.X i) := -add_monoid_hom.mk' (λ f, match c.next i with -| none := 0 -| some ⟨i',w⟩ := C.d i i' ≫ f i' i -end) -begin - intros f g, - rcases c.next i with _|⟨i',w⟩, - exact (zero_add _).symm, - exact preadditive.comp_add _ _ _ _ _ _, -end +add_monoid_hom.mk' (λ f, C.d i (c.next i) ≫ f (c.next i) i) $ +λ f g, preadditive.comp_add _ _ _ _ _ _ /-- `f i' i` if `i'` comes after `i`, and 0 if there's no such `i'`. Hopefully there won't be much need for this, except in `d_next_eq_d_from_from_next` to see that `d_next` factors through `C.d_from i`. -/ -def from_next [has_zero_object V] (i : ι) : (Π i j, C.X i ⟶ D.X j) →+ (C.X_next i ⟶ D.X i) := -add_monoid_hom.mk' (λ f, match c.next i with -| none := 0 -| some ⟨i',w⟩ := (C.X_next_iso w).hom ≫ f i' i -end) -begin - intros f g, - rcases c.next i with _|⟨i',w⟩, - exact (zero_add _).symm, - exact preadditive.comp_add _ _ _ _ _ _, -end +def from_next (i : ι) : (Π i j, C.X i ⟶ D.X j) →+ (C.X_next i ⟶ D.X i) := +add_monoid_hom.mk' (λ f, f (c.next i) i) $ λ f g, rfl @[simp] -lemma d_next_eq_d_from_from_next [has_zero_object V] (f : Π i j, C.X i ⟶ D.X j) (i : ι) : - d_next i f = C.d_from i ≫ from_next i f := -begin - dsimp [d_next, from_next], - rcases c.next i with ⟨⟩|⟨⟨i', w⟩⟩; - { dsimp [d_next, from_next], simp }, -end +lemma d_next_eq_d_from_from_next (f : Π i j, C.X i ⟶ D.X j) (i : ι) : + d_next i f = C.d_from i ≫ from_next i f := rfl lemma d_next_eq (f : Π i j, C.X i ⟶ D.X j) {i i' : ι} (w : c.rel i i') : d_next i f = C.d i i' ≫ f i' i := -begin - dsimp [d_next], - rw c.next_eq_some w, - refl, -end +by { obtain rfl := c.next_eq' w, refl } @[simp] lemma d_next_comp_left (f : C ⟶ D) (g : Π i j, D.X i ⟶ E.X j) (i : ι) : d_next i (λ i j, f.f i ≫ g i j) = f.f i ≫ d_next i g := -begin - dsimp [d_next], - rcases c.next i with _|⟨i',w⟩, - { exact comp_zero.symm, }, - { dsimp [d_next], - simp, }, -end +(f.comm_assoc _ _ _).symm @[simp] lemma d_next_comp_right (f : Π i j, C.X i ⟶ D.X j) (g : D ⟶ E) (i : ι) : d_next i (λ i j, f i j ≫ g.f j) = d_next i f ≫ g.f i := -begin - dsimp [d_next], - rcases c.next i with _|⟨i',w⟩, - { exact zero_comp.symm, }, - { dsimp [d_next], - simp, }, -end +(category.assoc _ _ _).symm /-- The composition of `f j j' ≫ D.d j' j` if there is some `j'` coming before `j`, and `0` otherwise. -/ def prev_d (j : ι) : (Π i j, C.X i ⟶ D.X j) →+ (C.X j ⟶ D.X j) := -add_monoid_hom.mk' (λ f, match c.prev j with -| none := 0 -| some ⟨j',w⟩ := f j j' ≫ D.d j' j -end) -begin - intros f g, - rcases c.prev j with _|⟨j',w⟩, - exact (zero_add _).symm, - exact preadditive.add_comp _ _ _ _ _ _, -end +add_monoid_hom.mk' (λ f, f j (c.prev j) ≫ D.d (c.prev j) j) $ +λ f g, preadditive.add_comp _ _ _ _ _ _ /-- `f j j'` if `j'` comes after `j`, and 0 if there's no such `j'`. Hopefully there won't be much need for this, except in `d_next_eq_d_from_from_next` to see that `d_next` factors through `C.d_from i`. -/ -def to_prev [has_zero_object V] (j : ι) : (Π i j, C.X i ⟶ D.X j) →+ (C.X j ⟶ D.X_prev j) := -add_monoid_hom.mk' (λ f, match c.prev j with -| none := 0 -| some ⟨j',w⟩ := f j j' ≫ (D.X_prev_iso w).inv -end) -begin - intros f g, - rcases c.prev j with _|⟨j',w⟩, - exact (zero_add _).symm, - exact preadditive.add_comp _ _ _ _ _ _, -end +def to_prev (j : ι) : (Π i j, C.X i ⟶ D.X j) →+ (C.X j ⟶ D.X_prev j) := +add_monoid_hom.mk' (λ f, f j (c.prev j)) $ λ f g, rfl @[simp] -lemma prev_d_eq_to_prev_d_to [has_zero_object V] (f : Π i j, C.X i ⟶ D.X j) (j : ι) : - prev_d j f = to_prev j f ≫ D.d_to j := -begin - dsimp [prev_d, to_prev], - rcases c.prev j with ⟨⟩|⟨⟨j', w⟩⟩; - { dsimp [prev_d, to_prev], simp }, -end +lemma prev_d_eq_to_prev_d_to (f : Π i j, C.X i ⟶ D.X j) (j : ι) : + prev_d j f = to_prev j f ≫ D.d_to j := rfl lemma prev_d_eq (f : Π i j, C.X i ⟶ D.X j) {j j' : ι} (w : c.rel j' j) : prev_d j f = f j j' ≫ D.d j' j := -begin - dsimp [prev_d], - rw c.prev_eq_some w, - refl, -end +by { obtain rfl := c.prev_eq' w, refl } @[simp] lemma prev_d_comp_left (f : C ⟶ D) (g : Π i j, D.X i ⟶ E.X j) (j : ι) : prev_d j (λ i j, f.f i ≫ g i j) = f.f j ≫ prev_d j g := -begin - dsimp [prev_d], - rcases c.prev j with _|⟨j',w⟩, - { exact comp_zero.symm, }, - { dsimp [prev_d, hom.prev], - simp, }, -end +category.assoc _ _ _ @[simp] lemma prev_d_comp_right (f : Π i j, C.X i ⟶ D.X j) (g : D ⟶ E) (j : ι) : prev_d j (λ i j, f i j ≫ g.f j) = prev_d j f ≫ g.f j := -begin - dsimp [prev_d], - rcases c.prev j with _|⟨j',w⟩, - { exact zero_comp.symm, }, - { dsimp [prev_d], - simp, }, -end +by { dsimp [prev_d], simp only [category.assoc, g.comm] } lemma d_next_nat (C D : chain_complex V ℕ) (i : ℕ) (f : Π i j, C.X i ⟶ D.X j) : d_next i f = C.d i (i-1) ≫ f (i-1) i := begin + dsimp [d_next], cases i, - { dsimp [d_next], - rcases (complex_shape.down ℕ).next 0 with _|⟨j,hj⟩; - dsimp [d_next], - { rw [C.shape, zero_comp], dsimp, dec_trivial }, - { dsimp at hj, exact (nat.succ_ne_zero _ hj).elim } }, - rw d_next_eq, dsimp, refl + { simp only [shape, chain_complex.next_nat_zero, complex_shape.down_rel, + nat.one_ne_zero, not_false_iff, zero_comp], }, + { dsimp only [nat.succ_eq_add_one], + have : (complex_shape.down ℕ).next (i + 1) = i + 1 - 1, + { rw chain_complex.next_nat_succ, refl }, + congr' 2, } end lemma prev_d_nat (C D : cochain_complex V ℕ) (i : ℕ) (f : Π i j, C.X i ⟶ D.X j) : prev_d i f = f i (i-1) ≫ D.d (i-1) i := begin + dsimp [prev_d], cases i, - { dsimp [prev_d], - rcases (complex_shape.up ℕ).prev 0 with _|⟨j,hj⟩; - dsimp [prev_d], - { rw [D.shape, comp_zero], dsimp, dec_trivial }, - { dsimp at hj, exact (nat.succ_ne_zero _ hj).elim } }, - rw prev_d_eq, dsimp, refl + { simp only [shape, cochain_complex.prev_nat_zero, complex_shape.up_rel, + nat.one_ne_zero, not_false_iff, comp_zero]}, + { dsimp only [nat.succ_eq_add_one], + have : (complex_shape.up ℕ).prev (i + 1) = i + 1 - 1, + { rw cochain_complex.prev_nat_succ, refl }, + congr' 2, }, end /-- A homotopy `h` between chain maps `f` and `g` consists of components `h i j : C.X i ⟶ D.X j` which are zero unless `c.rel j i`, satisfying the homotopy condition. -/ -@[ext, nolint has_inhabited_instance] +@[ext, nolint has_nonempty_instance] structure homotopy (f g : C ⟶ D) := (hom : Π i j, C.X i ⟶ D.X j) (zero' : ∀ i j, ¬ c.rel j i → hom i j = 0 . obviously) @@ -300,13 +229,9 @@ def null_homotopic_map (hom : Π i j, C.X i ⟶ D.X j) : C ⟶ D := comm' := λ i j hij, begin have eq1 : prev_d i hom ≫ D.d i j = 0, - { rcases h : c.prev i with _|⟨i',w⟩, - { dsimp [prev_d], rw h, erw zero_comp, }, - { rw [prev_d_eq hom w, category.assoc, D.d_comp_d' i' i j w hij, comp_zero], }, }, + { simp only [prev_d, add_monoid_hom.mk'_apply, category.assoc, d_comp_d, comp_zero], }, have eq2 : C.d i j ≫ d_next j hom = 0, - { rcases h : c.next j with _|⟨j',w⟩, - { dsimp [d_next], rw h, erw comp_zero, }, - { rw [d_next_eq hom w, ← category.assoc, C.d_comp_d' i j j' hij w, zero_comp], }, }, + { simp only [d_next, add_monoid_hom.mk'_apply, d_comp_d_assoc, zero_comp], }, rw [d_next_eq hom hij, prev_d_eq hom hij, preadditive.comp_add, preadditive.add_comp, eq1, eq2, add_zero, zero_add, category.assoc], end } @@ -322,8 +247,8 @@ lemma null_homotopic_map_comp (hom : Π i j, C.X i ⟶ D.X j) (g : D ⟶ E) : null_homotopic_map hom ≫ g = null_homotopic_map (λ i j, hom i j ≫ g.f j) := begin ext n, - dsimp [null_homotopic_map], - simp only [preadditive.add_comp, d_next_comp_right, prev_d_comp_right], + dsimp [null_homotopic_map, from_next, to_prev, add_monoid_hom.mk'_apply], + simp only [preadditive.add_comp, category.assoc, g.comm], end /-- Compatibility of `null_homotopic_map'` with the postcomposition by a morphism @@ -346,8 +271,8 @@ lemma comp_null_homotopic_map (f : C ⟶ D) (hom : Π i j, D.X i ⟶ E.X j) : f ≫ null_homotopic_map hom = null_homotopic_map (λ i j, f.f i ≫ hom i j) := begin ext n, - dsimp [null_homotopic_map], - simp only [preadditive.comp_add, d_next_comp_left, prev_d_comp_left], + dsimp [null_homotopic_map, from_next, to_prev, add_monoid_hom.mk'_apply], + simp only [preadditive.comp_add, category.assoc, f.comm_assoc], end /-- Compatibility of `null_homotopic_map'` with the precomposition by a morphism @@ -372,10 +297,7 @@ lemma map_null_homotopic_map {W : Type*} [category W] [preadditive W] begin ext i, dsimp [null_homotopic_map, d_next, prev_d], - rcases c.next i with _|⟨inext,wn⟩; - rcases c.prev i with _|⟨iprev,wp⟩; - dsimp [d_next, prev_d]; - simp only [G.map_comp, functor.map_zero, functor.map_add], + simp only [G.map_comp, functor.map_add], end /-- Compatibility of `null_homotopic_map'` with the application of additive functors -/ @@ -423,7 +345,7 @@ with `null_homotopic_map` or `null_homotopic_map'` -/ lemma null_homotopic_map_f {k₂ k₁ k₀ : ι} (r₂₁ : c.rel k₂ k₁) (r₁₀ : c.rel k₁ k₀) (hom : Π i j, C.X i ⟶ D.X j) : (null_homotopic_map hom).f k₁ = C.d k₁ k₀ ≫ hom k₀ k₁ + hom k₁ k₂ ≫ D.d k₂ k₁ := -by { dsimp [null_homotopic_map], rw [d_next_eq hom r₁₀, prev_d_eq hom r₂₁], } +by { dsimp only [null_homotopic_map], rw [d_next_eq hom r₁₀, prev_d_eq hom r₂₁], } @[simp] lemma null_homotopic_map'_f {k₂ k₁ k₀ : ι} (r₂₁ : c.rel k₂ k₁) (r₁₀ : c.rel k₁ k₀) @@ -443,10 +365,9 @@ lemma null_homotopic_map_f_of_not_rel_left {k₁ k₀ : ι} (r₁₀ : c.rel k (hom : Π i j, C.X i ⟶ D.X j) : (null_homotopic_map hom).f k₀ = hom k₀ k₁ ≫ D.d k₁ k₀ := begin - dsimp [null_homotopic_map], - rw prev_d_eq hom r₁₀, - rcases h : c.next k₀ with _|⟨l,w⟩, swap, exfalso, exact hk₀ l w, - dsimp [d_next], rw h, erw zero_add, + dsimp only [null_homotopic_map], + rw [prev_d_eq hom r₁₀, d_next, add_monoid_hom.mk'_apply, C.shape, zero_comp, zero_add], + exact hk₀ _ end @[simp] @@ -468,10 +389,9 @@ lemma null_homotopic_map_f_of_not_rel_right {k₁ k₀ : ι} (r₁₀ : c.rel k (hom : Π i j, C.X i ⟶ D.X j) : (null_homotopic_map hom).f k₁ = C.d k₁ k₀ ≫ hom k₀ k₁ := begin - dsimp [null_homotopic_map], - rw d_next_eq hom r₁₀, - rcases h : c.prev k₁ with _|⟨l,w⟩, swap, exfalso, exact hk₁ l w, - dsimp [prev_d], rw h, erw add_zero, + dsimp only [null_homotopic_map], + rw [d_next_eq hom r₁₀, prev_d, add_monoid_hom.mk'_apply, D.shape, comp_zero, add_zero], + exact hk₁ _, end @[simp] @@ -493,13 +413,8 @@ lemma null_homotopic_map_f_eq_zero {k₀ : ι} (hom : Π i j, C.X i ⟶ D.X j) : (null_homotopic_map hom).f k₀ = 0 := begin - dsimp [null_homotopic_map], - rcases h1 : c.next k₀ with _|⟨l,w⟩, swap, exfalso, exact hk₀ l w, - rcases h2 : c.prev k₀ with _|⟨l,w⟩, swap, exfalso, exact hk₀' l w, - dsimp [d_next, prev_d], - rw [h1, h2], - erw zero_add, - refl, + dsimp [null_homotopic_map, d_next, prev_d], + rw [C.shape, D.shape, zero_comp, comp_zero, add_zero]; apply_assumption, end @[simp] @@ -534,24 +449,24 @@ variables {P Q : chain_complex V ℕ} prev_d j f = f j (j+1) ≫ Q.d _ _ := begin dsimp [prev_d], - simp only [chain_complex.prev], - refl, + have : (complex_shape.down ℕ).prev j = j + 1 := chain_complex.prev ℕ j, + congr' 2, end @[simp] lemma d_next_succ_chain_complex (f : Π i j, P.X i ⟶ Q.X j) (i : ℕ) : d_next (i+1) f = P.d _ _ ≫ f i (i+1) := begin dsimp [d_next], - simp only [chain_complex.next_nat_succ], - refl, + have : (complex_shape.down ℕ).next (i + 1) = i := chain_complex.next_nat_succ _, + congr' 2, end @[simp] lemma d_next_zero_chain_complex (f : Π i j, P.X i ⟶ Q.X j) : d_next 0 f = 0 := begin dsimp [d_next], - simp only [chain_complex.next_nat_zero], - refl, + rw [P.shape, zero_comp], + rw chain_complex.next_nat_zero, dsimp, dec_trivial, end variables (e : P ⟶ Q) @@ -591,8 +506,6 @@ def mk_inductive_aux₁ : section -variable [has_zero_object V] - /-- An auxiliary construction for `mk_inductive`. -/ @@ -603,10 +516,10 @@ def mk_inductive_aux₂ : | (n+1) := let I := mk_inductive_aux₁ e zero comm_zero one comm_one succ n in ⟨(P.X_next_iso rfl).hom ≫ I.1, I.2.1 ≫ (Q.X_prev_iso rfl).inv, by simpa using I.2.2⟩ -lemma mk_inductive_aux₃ (i : ℕ) : - (mk_inductive_aux₂ e zero comm_zero one comm_one succ i).2.1 ≫ (Q.X_prev_iso rfl).hom - = (P.X_next_iso rfl).inv ≫ (mk_inductive_aux₂ e zero comm_zero one comm_one succ (i+1)).1 := -by rcases i with (_|_|i); { dsimp, simp, } +lemma mk_inductive_aux₃ (i j : ℕ) (h : i+1 = j) : + (mk_inductive_aux₂ e zero comm_zero one comm_one succ i).2.1 ≫ (Q.X_prev_iso h).hom + = (P.X_next_iso h).inv ≫ (mk_inductive_aux₂ e zero comm_zero one comm_one succ j).1 := +by subst j; rcases i with (_|_|i); { dsimp, simp, } /-- A constructor for a `homotopy e 0`, for `e` a chain map between `ℕ`-indexed chain complexes, @@ -627,20 +540,16 @@ def mk_inductive : homotopy e 0 := comm := λ i, begin dsimp, simp only [add_zero], convert (mk_inductive_aux₂ e zero comm_zero one comm_one succ i).2.2, - { rcases i with (_|_|_|i), - { dsimp, - simp only [d_next_zero_chain_complex, d_from_eq_zero, limits.comp_zero], }, - all_goals - { simp only [d_next_succ_chain_complex], - dsimp, - simp only [category.comp_id, category.assoc, iso.inv_hom_id, d_from_comp_X_next_iso_assoc, - dite_eq_ite, if_true, eq_self_iff_true]}, }, { cases i, - all_goals - { simp only [prev_d_chain_complex], - dsimp, - simp only [category.comp_id, category.assoc, iso.inv_hom_id, X_prev_iso_comp_d_to, - dite_eq_ite, if_true, eq_self_iff_true], }, }, + { dsimp [from_next], rw dif_neg, + simp only [chain_complex.next_nat_zero, nat.one_ne_zero, not_false_iff], }, + { dsimp [from_next], rw dif_pos, swap, { simp only [chain_complex.next_nat_succ] }, + have aux : (complex_shape.down ℕ).next i.succ = i := chain_complex.next_nat_succ i, + rw mk_inductive_aux₃ e zero comm_zero one comm_one succ + ((complex_shape.down ℕ).next i.succ) (i+1) (by rw aux), + dsimp [X_next_iso], erw category.id_comp, } }, + { dsimp [to_prev], rw dif_pos, swap, { simp only [chain_complex.prev] }, + dsimp [X_prev_iso], erw category.comp_id, }, end, } end @@ -660,24 +569,24 @@ variables {P Q : cochain_complex V ℕ} d_next j f = P.d _ _ ≫ f (j+1) j := begin dsimp [d_next], - simp only [cochain_complex.next], - refl, + have : (complex_shape.up ℕ).next j = j + 1 := cochain_complex.next ℕ j, + congr' 2, end @[simp] lemma prev_d_succ_cochain_complex (f : Π i j, P.X i ⟶ Q.X j) (i : ℕ) : prev_d (i+1) f = f (i+1) _ ≫ Q.d i (i+1) := begin dsimp [prev_d], - simp [cochain_complex.prev_nat_succ], - refl, + have : (complex_shape.up ℕ).prev (i+1) = i := cochain_complex.prev_nat_succ i, + congr' 2, end @[simp] lemma prev_d_zero_cochain_complex (f : Π i j, P.X i ⟶ Q.X j) : prev_d 0 f = 0 := begin dsimp [prev_d], - simp only [cochain_complex.prev_nat_zero], - refl, + rw [Q.shape, comp_zero], + rw [cochain_complex.prev_nat_zero], dsimp, dec_trivial, end variables (e : P ⟶ Q) @@ -717,8 +626,6 @@ def mk_coinductive_aux₁ : section -variable [has_zero_object V] - /-- An auxiliary construction for `mk_inductive`. -/ @@ -730,10 +637,10 @@ def mk_coinductive_aux₂ : | (n+1) := let I := mk_coinductive_aux₁ e zero comm_zero one comm_one succ n in ⟨I.1 ≫ (Q.X_prev_iso rfl).inv, (P.X_next_iso rfl).hom ≫ I.2.1, by simpa using I.2.2⟩ -lemma mk_coinductive_aux₃ (i : ℕ) : - (mk_coinductive_aux₂ e zero comm_zero one comm_one succ i).2.1 ≫ (Q.X_prev_iso rfl).inv - = (P.X_next_iso rfl).hom ≫ (mk_coinductive_aux₂ e zero comm_zero one comm_one succ (i+1)).1 := -by rcases i with (_|_|i); { dsimp, simp, } +lemma mk_coinductive_aux₃ (i j : ℕ) (h : i + 1 = j) : + (P.X_next_iso h).inv ≫ (mk_coinductive_aux₂ e zero comm_zero one comm_one succ i).2.1 + = (mk_coinductive_aux₂ e zero comm_zero one comm_one succ j).1 ≫ (Q.X_prev_iso h).hom := +by subst j; rcases i with (_|_|i); { dsimp, simp, } /-- A constructor for a `homotopy e 0`, for `e` a chain map between `ℕ`-indexed cochain complexes, @@ -755,26 +662,16 @@ def mk_coinductive : homotopy e 0 := dsimp, rw [add_zero, add_comm], convert (mk_coinductive_aux₂ e zero comm_zero one comm_one succ i).2.2 using 2, - { rcases i with (_|_|_|i), - { simp only [mk_coinductive_aux₂, prev_d_zero_cochain_complex, zero_comp] }, - all_goals - { simp only [prev_d_succ_cochain_complex], - dsimp, - simp only [eq_self_iff_true, iso.inv_hom_id_assoc, dite_eq_ite, - if_true, category.assoc, X_prev_iso_comp_d_to], }, }, { cases i, - { dsimp, - simp only [eq_self_iff_true, d_next_cochain_complex, dif_pos, - d_from_comp_X_next_iso_assoc, ←comm_zero], - rw mk_coinductive_aux₂, - dsimp, - convert comm_zero.symm, - simp only [iso.inv_hom_id_assoc], }, - { dsimp, - simp only [eq_self_iff_true, d_next_cochain_complex, dif_pos, d_from_comp_X_next_iso_assoc], - rw mk_coinductive_aux₂, - dsimp only, - simp only [iso.inv_hom_id_assoc], }, }, + { dsimp [to_prev], rw dif_neg, + simp only [cochain_complex.prev_nat_zero, nat.one_ne_zero, not_false_iff], }, + { dsimp [to_prev], rw dif_pos, swap, { simp only [cochain_complex.prev_nat_succ] }, + have aux : (complex_shape.up ℕ).prev i.succ = i := cochain_complex.prev_nat_succ i, + rw mk_coinductive_aux₃ e zero comm_zero one comm_one succ + ((complex_shape.up ℕ).prev i.succ) (i+1) (by rw aux), + dsimp [X_prev_iso], erw category.comp_id, } }, + { dsimp [from_next], rw dif_pos, swap, { simp only [cochain_complex.next] }, + dsimp [X_next_iso], erw category.id_comp, }, end } end @@ -827,9 +724,15 @@ instance : inhabited (homotopy_equiv C C) := ⟨refl C⟩ homotopy_inv_hom_id := by simpa using ((f.homotopy_inv_hom_id.comp_right_id g.hom).comp_left g.inv).trans g.homotopy_inv_hom_id, } +/-- An isomorphism of complexes induces a homotopy equivalence. -/ +def of_iso {ι : Type*} {V : Type u} [category.{v} V] [preadditive V] + {c : complex_shape ι} {C D : homological_complex V c} (f : C ≅ D) : + homotopy_equiv C D := +⟨f.hom, f.inv, homotopy.of_eq f.3, homotopy.of_eq f.4⟩ + end homotopy_equiv -variables [has_equalizers V] [has_cokernels V] [has_images V] [has_image_maps V] [has_zero_object V] +variables [has_equalizers V] [has_cokernels V] [has_images V] [has_image_maps V] /-- Homotopic maps induce the same map on homology. @@ -880,13 +783,10 @@ def functor.map_homotopy (F : V ⥤ W) [F.additive] {f g : C ⟶ D} (h : homotop { hom := λ i j, F.map (h.hom i j), zero' := λ i j w, by { rw [h.zero i j w, F.map_zero], }, comm := λ i, begin - have := h.comm i, dsimp [d_next, prev_d] at *, - rcases c.next i with _|⟨inext,wn⟩; - rcases c.prev i with _|⟨iprev,wp⟩; - dsimp [d_next, prev_d] at *; - { intro h, - simp [h] }, + rw h.comm i, + simp only [F.map_add, ← F.map_comp], + refl end, } /-- An additive functor preserves homotopy equivalences. -/ diff --git a/src/algebra/homology/homotopy_category.lean b/src/algebra/homology/homotopy_category.lean index 373657a40e757..08eed788b3823 100644 --- a/src/algebra/homology/homotopy_category.lean +++ b/src/algebra/homology/homotopy_category.lean @@ -9,6 +9,9 @@ import category_theory.quotient /-! # The homotopy category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `homotopy_category V c` gives the category of chain complexes of shape `c` in `V`, with chain maps identified when they are homotopic. -/ @@ -50,9 +53,9 @@ namespace homotopy_category def quotient : homological_complex V c ⥤ homotopy_category V c := category_theory.quotient.functor _ -local attribute [instance] has_zero_object.has_zero +open_locale zero_object --- TODO upgrade this is to `has_zero_object`, presumably for any `quotient`. +-- TODO upgrade this to `has_zero_object`, presumably for any `quotient`. instance [has_zero_object V] : inhabited (homotopy_category V c) := ⟨(quotient V c).obj 0⟩ variables {V c} @@ -113,7 +116,7 @@ def homotopy_equiv_of_iso homotopy_hom_inv_id := homotopy_of_eq _ _ (by { simp, refl, }), homotopy_inv_hom_id := homotopy_of_eq _ _ (by { simp, refl, }), } -variables (V c) [has_zero_object V] [has_equalizers V] [has_images V] [has_image_maps V] +variables (V c) [has_equalizers V] [has_images V] [has_image_maps V] [has_cokernels V] /-- The `i`-th homology, as a functor from the homotopy category. -/ diff --git a/src/algebra/homology/image_to_kernel.lean b/src/algebra/homology/image_to_kernel.lean index 3af24858d8049..5b100a5aec890 100644 --- a/src/algebra/homology/image_to_kernel.lean +++ b/src/algebra/homology/image_to_kernel.lean @@ -8,6 +8,9 @@ import category_theory.subobject.limits /-! # Image-to-kernel comparison maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Whenever `f : A ⟶ B` and `g : B ⟶ C` satisfy `w : f ≫ g = 0`, we have `image_le_kernel f g w : image_subobject f ≤ kernel_subobject g` (assuming the appropriate images and kernels exist). @@ -175,6 +178,20 @@ lemma homology.ext {D : V} {k k' : homology f g w ⟶ D} (p : homology.π f g w ≫ k = homology.π f g w ≫ k') : k = k' := by { ext, exact p, } +/-- The cokernel of the map `Im f ⟶ Ker 0` is isomorphic to the cokernel of `f.` -/ +def homology_of_zero_right [has_cokernel (image_to_kernel f (0 : B ⟶ C) comp_zero)] + [has_cokernel f] [has_cokernel (image.ι f)] [epi (factor_thru_image f)] : + homology f (0 : B ⟶ C) comp_zero ≅ cokernel f := +(cokernel.map_iso _ _ (image_subobject_iso _) ((kernel_subobject_iso 0).trans + kernel_zero_iso_source) (by simp)).trans (cokernel_image_ι _) + +/-- The kernel of the map `Im 0 ⟶ Ker f` is isomorphic to the kernel of `f.` -/ +def homology_of_zero_left [has_zero_object V] [has_kernels V] [has_image (0 : A ⟶ B)] + [has_cokernel (image_to_kernel (0 : A ⟶ B) g zero_comp)] : + homology (0 : A ⟶ B) g zero_comp ≅ kernel g := +((cokernel_iso_of_eq $ image_to_kernel_zero_left _).trans cokernel_zero_iso_target).trans + (kernel_subobject_iso _) + /-- `homology 0 0 _` is just the middle object. -/ @[simps] def homology_zero_zero [has_zero_object V] diff --git a/src/algebra/homology/local_cohomology.lean b/src/algebra/homology/local_cohomology.lean new file mode 100644 index 0000000000000..2812460b2b143 --- /dev/null +++ b/src/algebra/homology/local_cohomology.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2023 Emily Witt. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Emily Witt, Scott Morrison, Jake Levinson, Sam van Gool +-/ +import ring_theory.ideal.basic +import algebra.category.Module.colimits +import algebra.category.Module.projective +import category_theory.abelian.ext +import category_theory.limits.final +import ring_theory.noetherian + +/-! +# Local cohomology. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the `i`-th local cohomology module of an `R`-module `M` with support in an +ideal `I` of `R`, where `R` is a commutative ring, as the direct limit of Ext modules: + +Given a collection of ideals cofinal with the powers of `I`, consider the directed system of +quotients of `R` by these ideals, and take the direct limit of the system induced on the `i`-th +Ext into `M`. One can, of course, take the collection to simply be the integral powers of `I`. + +## References + +* [M. Hochster, *Local cohomology*][hochsterunpublished] + +* [R. Hartshorne, *Local cohomology: A seminar given by A. Grothendieck*][hartshorne61] +* [M. Brodmann and R. Sharp, *Local cohomology: An algebraic introduction with geometric + applications*][brodmannsharp13] +* [S. Iyengar, G. Leuschke, A. Leykin, Anton, C. Miller, E. Miller, A. Singh, U. Walther, + *Twenty-four hours of local cohomology*][iyengaretal13] + +## Tags + +local cohomology, local cohomology modules + +## Future work + +* Prove that this definition is equivalent to: + * the right-derived functor definition + * the characterization as the limit of Koszul homology + * the characterization as the cohomology of a Cech-like complex +* Establish long exact sequence(s) in local cohomology +-/ + +open opposite +open category_theory +open category_theory.limits + +noncomputable theory + +universes u v v' + +namespace local_cohomology + +/- We define local cohomology, implemented as a direct limit of `Ext(R/J, -)`. -/ +section +variables {R : Type u} [comm_ring R] {D : Type v} [small_category D] + +/-- The directed system of `R`-modules of the form `R/J`, where `J` is an ideal of `R`, +determined by the functor `I` -/ +def ring_mod_ideals (I : D ⥤ ideal R) : D ⥤ Module.{u} R := +{ obj := λ t, Module.of R $ R ⧸ (I.obj t), + map := λ s t w, submodule.mapq _ _ (linear_map.id) (I.map w).down.down } + +/- TODO: Once this file is ported, move this file to the right location. -/ +instance Module_enough_projectives' : enough_projectives (Module.{u} R) := + Module.Module_enough_projectives.{u} + +/-- The diagram we will take the colimit of to define local cohomology, corresponding to the +directed system determined by the functor `I` -/ +def diagram (I : D ⥤ ideal R) (i : ℕ) : Dᵒᵖ ⥤ Module.{u} R ⥤ Module.{u} R := +(ring_mod_ideals I).op ⋙ Ext R (Module.{u} R) i + +end + +section +-- We momentarily need to work with a type inequality, as later we will take colimits +-- along diagrams either in Type, or in the same universe as the ring, and we need to cover both. +variables {R : Type max u v} [comm_ring R] {D : Type v} [small_category D] + +/-- `local_cohomology.of_diagram I i` is the the functor sending a module `M` over a commutative +ring `R` to the direct limit of `Ext^i(R/J, M)`, where `J` ranges over a collection of ideals +of `R`, represented as a functor `I`. -/ +/- +In this definition we do not assume any special property of the diagram `I`, but the relevant case +will be where `I` is (cofinal with) the diagram of powers of a single given ideal. + +Below, we give two equivalent definitions of the usual local cohomology with support +in an ideal `J`, `local_cohomology` and `local_cohomology.of_self_le_radical`. + + -/ +def of_diagram (I : D ⥤ ideal R) (i : ℕ) : + Module.{max u v} R ⥤ Module.{max u v} R := +colimit (diagram.{(max u v) v} I i) + +end + +section +variables {R : Type max u v v'} [comm_ring R] {D : Type v} [small_category D] + +variables {E : Type v'} [small_category E] + (I' : E ⥤ D) (I : D ⥤ ideal R) + +/-- Local cohomology along a composition of diagrams. -/ +def diagram_comp (i : ℕ) : diagram (I' ⋙ I) i ≅ I'.op ⋙ (diagram I i) := iso.refl _ + +/-- Local cohomology agrees along precomposition with a cofinal diagram. -/ +def iso_of_final [functor.initial I'] (i : ℕ) : + of_diagram.{(max u v) v'} (I' ⋙ I) i ≅ of_diagram.{(max u v') v} I i := +(has_colimit.iso_of_nat_iso (diagram_comp _ _ _)) +≪≫ (functor.final.colimit_iso _ _) + +end + +section diagrams + +variables {R : Type u} [comm_ring R] + +/-- The functor sending a natural number `i` to the `i`-th power of the ideal `J` -/ +def ideal_powers_diagram (J : ideal R) : ℕᵒᵖ ⥤ ideal R := +{ obj := λ t, J^(unop t), + map := λ s t w, ⟨⟨ideal.pow_le_pow w.unop.down.down⟩⟩, } + +/-- The full subcategory of all ideals with radical containing `J` -/ +@[derive category] def self_le_radical (J : ideal R) : Type u := +full_subcategory (λ J' : ideal R, J ≤ J'.radical) + +instance self_le_radical.inhabited (J : ideal R) : inhabited (self_le_radical J) := +{ default := ⟨J, ideal.le_radical⟩ } + +/-- The diagram of all ideals with radical containing `J`, represented as a functor. +This is the "largest" diagram that computes local cohomology with support in `J`. -/ +def self_le_radical_diagram (J : ideal R) : (self_le_radical J) ⥤ ideal R := +full_subcategory_inclusion _ + +end diagrams + +end local_cohomology + +/-! We give two models for the local cohomology with support in an ideal `J`: first in terms of +the powers of `J` (`local_cohomology`), then in terms of *all* ideals with radical +containing `J` (`local_cohomology.of_self_le_radical`). -/ +section models_for_local_cohomology + +open local_cohomology + +variables {R : Type u} [comm_ring R] + +/-- `local_cohomology J i` is `i`-th the local cohomology module of a module `M` over +a commutative ring `R` with support in the ideal `J` of `R`, defined as the direct limit +of `Ext^i(R/J^t, M)` over all powers `t : ℕ`. -/ +def local_cohomology (J : ideal R) (i : ℕ) : Module.{u} R ⥤ Module.{u} R := +of_diagram (ideal_powers_diagram J) i + +/-- Local cohomology as the direct limit of `Ext^i(R/J', M)` over *all* ideals `J'` with radical +containing `J`. -/ +def local_cohomology.of_self_le_radical (J : ideal R) (i : ℕ) : Module.{u} R ⥤ Module.{u} R := +of_diagram.{u} (self_le_radical_diagram.{u} J) i + +end models_for_local_cohomology + +namespace local_cohomology + +/-! +Showing equivalence of different definitions of local cohomology. + * `local_cohomology.iso_self_le_radical` gives the isomorphism + `local_cohomology J i ≅ local_cohomology.of_self_le_radical J i` + * `local_cohomology.iso_of_same_radical` gives the isomorphism + `local_cohomology J i ≅ local_cohomology K i` when `J.radical = K.radical`. +-/ +section local_cohomology_equiv + +variables {R : Type u} [comm_ring R] + +/-- Lifting `ideal_powers_diagram J` from a diagram valued in `ideals R` to a diagram +valued in `self_le_radical J`. -/ +def ideal_powers_to_self_le_radical (J : ideal R) : ℕᵒᵖ ⥤ self_le_radical J := +full_subcategory.lift _ (ideal_powers_diagram J) +(λ k, begin + change _ ≤ (J^(unop k)).radical, + cases (unop k), + { simp only [ideal.radical_top, pow_zero, ideal.one_eq_top, le_top] }, + { simp only [J.radical_pow _ n.succ_pos, ideal.le_radical] }, +end) + +variables {I J K : ideal R} + +/-- +PORTING NOTE: This lemma should probably be moved to `ring_theory/finiteness.lean` +to be near `ideal.exists_radical_pow_le_of_fg`, which it generalizes. +-/ +lemma ideal.exists_pow_le_of_le_radical_of_fg (hIJ : I ≤ J.radical) (hJ : J.radical.fg) : + ∃ (k : ℕ), I^k ≤ J := +begin + obtain ⟨k, hk⟩ := J.exists_radical_pow_le_of_fg hJ, + use k, + calc I^k ≤ J.radical^k : ideal.pow_mono hIJ _ + ... ≤ J : hk, +end + +/-- The diagram of powers of `J` is initial in the diagram of all ideals with +radical containing `J`. This uses noetherianness. -/ +instance ideal_powers_initial [hR : is_noetherian R R] : + functor.initial (ideal_powers_to_self_le_radical J) := +{ out := λ J', begin + apply @zigzag_is_connected _ _ _, + { intros j1 j2, + apply relation.refl_trans_gen.single, + -- The inclusions `J^n1 ≤ J'` and `J^n2 ≤ J'` always form a triangle, based on + -- which exponent is larger. + cases le_total (unop j1.left) (unop j2.left) with h, + right, exact ⟨costructured_arrow.hom_mk (hom_of_le h).op (of_as_true trivial)⟩, + left, exact ⟨costructured_arrow.hom_mk (hom_of_le h).op (of_as_true trivial)⟩ }, + { obtain ⟨k, hk⟩ := ideal.exists_pow_le_of_le_radical_of_fg J'.2 + (is_noetherian_def.mp hR _), + exact ⟨costructured_arrow.mk (⟨⟨hk⟩⟩ : (ideal_powers_to_self_le_radical J).obj (op k) ⟶ J')⟩}, + end } + +/-- Local cohomology (defined in terms of powers of `J`) agrees with local +cohomology computed over all ideals with radical containing `J`. -/ +def iso_self_le_radical (J : ideal R) [is_noetherian R R] (i : ℕ) : + local_cohomology.of_self_le_radical J i ≅ local_cohomology J i := +(local_cohomology.iso_of_final.{u u 0} + (ideal_powers_to_self_le_radical J) (self_le_radical_diagram J) i).symm +≪≫ has_colimit.iso_of_nat_iso (iso.refl _) + +/-- Casting from the full subcategory of ideals with radical containing `J` to the full +subcategory of ideals with radical containing `K`. -/ +def self_le_radical.cast (hJK : J.radical = K.radical) : + self_le_radical J ⥤ self_le_radical K := +full_subcategory.map (λ L hL, begin + rw ← ideal.radical_le_radical_iff at ⊢ hL, + exact hJK.symm.trans_le hL, + end) + +-- TODO generalize this to the equivalence of full categories for any `iff`. +instance self_le_radical.cast_is_equivalence (hJK : J.radical = K.radical) : + is_equivalence (self_le_radical.cast hJK) := +{ inverse := self_le_radical.cast hJK.symm, + unit_iso := by tidy, + counit_iso := by tidy } + +/-- The natural isomorphism between local cohomology defined using the `of_self_le_radical` +diagram, assuming `J.radical = K.radical`. -/ +def self_le_radical.iso_of_same_radical (hJK : J.radical = K.radical) (i : ℕ) : + of_self_le_radical J i ≅ of_self_le_radical K i := +(iso_of_final.{u u u} (self_le_radical.cast hJK.symm) _ _).symm + +/-- Local cohomology agrees on ideals with the same radical. -/ +def iso_of_same_radical [is_noetherian R R] (hJK : J.radical = K.radical) (i : ℕ) : + local_cohomology J i ≅ local_cohomology K i := +(iso_self_le_radical J i).symm +≪≫ self_le_radical.iso_of_same_radical hJK i +≪≫ iso_self_le_radical K i + +end local_cohomology_equiv + +end local_cohomology diff --git a/src/algebra/homology/opposite.lean b/src/algebra/homology/opposite.lean new file mode 100644 index 0000000000000..7613e58ab6a0d --- /dev/null +++ b/src/algebra/homology/opposite.lean @@ -0,0 +1,265 @@ +/- +Copyright (c) 2022 Amelia Livingston. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin, Amelia Livingston +-/ + +import category_theory.abelian.opposite +import category_theory.abelian.homology +import algebra.homology.additive + +/-! +# Opposite categories of complexes + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +Given a preadditive category `V`, the opposite of its category of chain complexes is equivalent to +the category of cochain complexes of objects in `Vᵒᵖ`. We define this equivalence, and another +analagous equivalence (for a general category of homological complexes with a general +complex shape). + +We then show that when `V` is abelian, if `C` is a homological complex, then the homology of +`op(C)` is isomorphic to `op` of the homology of `C` (and the analagous result for `unop`). + +## Implementation notes +It is convenient to define both `op` and `op_symm`; this is because given a complex shape `c`, +`c.symm.symm` is not defeq to `c`. + +## Tags +opposite, chain complex, cochain complex, homology, cohomology, homological complex +-/ + + +noncomputable theory + +open opposite category_theory category_theory.limits + +section + +variables {V : Type*} [category V] [abelian V] + +lemma image_to_kernel_op {X Y Z : V} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) : + image_to_kernel g.op f.op (by rw [←op_comp, w, op_zero]) = ((image_subobject_iso _) + ≪≫ (image_op_op _).symm).hom ≫ (cokernel.desc f (factor_thru_image g) + (by rw [←cancel_mono (image.ι g), category.assoc, image.fac, w, zero_comp])).op + ≫ ((kernel_subobject_iso _) ≪≫ (kernel_op_op _)).inv := +begin + ext, + simpa only [iso.trans_hom, iso.symm_hom, iso.trans_inv, kernel_op_op_inv, category.assoc, + image_to_kernel_arrow, kernel_subobject_arrow', kernel.lift_ι, ←op_comp, cokernel.π_desc, + ←image_subobject_arrow, ←image_unop_op_inv_comp_op_factor_thru_image g.op], +end + +lemma image_to_kernel_unop {X Y Z : Vᵒᵖ} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) : + image_to_kernel g.unop f.unop (by rw [←unop_comp, w, unop_zero]) = ((image_subobject_iso _) + ≪≫ (image_unop_unop _).symm).hom ≫ (cokernel.desc f (factor_thru_image g) + (by rw [←cancel_mono (image.ι g), category.assoc, image.fac, w, zero_comp])).unop + ≫ ((kernel_subobject_iso _) ≪≫ (kernel_unop_unop _)).inv := +begin + ext, + dunfold image_unop_unop, + simp only [iso.trans_hom, iso.symm_hom, iso.trans_inv, kernel_unop_unop_inv, category.assoc, + image_to_kernel_arrow, kernel_subobject_arrow', kernel.lift_ι, cokernel.π_desc, + iso.unop_inv, ←unop_comp, factor_thru_image_comp_image_unop_op_inv, quiver.hom.unop_op, + image_subobject_arrow], +end + +/-- Given `f, g` with `f ≫ g = 0`, the homology of `g.op, f.op` is the opposite of the homology of +`f, g`. -/ +def homology_op {X Y Z : V} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) : + homology g.op f.op (by rw [←op_comp, w, op_zero]) ≅ opposite.op (homology f g w) := +cokernel_iso_of_eq (image_to_kernel_op _ _ w) ≪≫ (cokernel_epi_comp _ _) + ≪≫ cokernel_comp_is_iso _ _ ≪≫ cokernel_op_op _ ≪≫ ((homology_iso_kernel_desc _ _ _) + ≪≫ (kernel_iso_of_eq (by ext; simp only [image.fac, cokernel.π_desc, cokernel.π_desc_assoc])) + ≪≫ (kernel_comp_mono _ (image.ι g))).op + +/-- Given morphisms `f, g` in `Vᵒᵖ` with `f ≫ g = 0`, the homology of `g.unop, f.unop` is the +opposite of the homology of `f, g`. -/ +def homology_unop {X Y Z : Vᵒᵖ} (f : X ⟶ Y) (g : Y ⟶ Z) (w : f ≫ g = 0) : + homology g.unop f.unop (by rw [←unop_comp, w, unop_zero]) ≅ opposite.unop (homology f g w) := +cokernel_iso_of_eq (image_to_kernel_unop _ _ w) ≪≫ (cokernel_epi_comp _ _) + ≪≫ cokernel_comp_is_iso _ _ ≪≫ cokernel_unop_unop _ + ≪≫ ((homology_iso_kernel_desc _ _ _) + ≪≫ (kernel_iso_of_eq (by ext; simp only [image.fac, cokernel.π_desc, cokernel.π_desc_assoc])) + ≪≫ (kernel_comp_mono _ (image.ι g))).unop + +end + +namespace homological_complex + +variables {ι V : Type*} [category V] {c : complex_shape ι} + +section +variables [preadditive V] + +/-- Sends a complex `X` with objects in `V` to the corresponding complex with objects in `Vᵒᵖ`. -/ +@[simps] protected def op (X : homological_complex V c) : homological_complex Vᵒᵖ c.symm := +{ X := λ i, op (X.X i), + d := λ i j, (X.d j i).op, + shape' := λ i j hij, by { rw [X.shape j i hij, op_zero], }, + d_comp_d' := by { intros, rw [← op_comp, X.d_comp_d, op_zero], } } + +/-- Sends a complex `X` with objects in `V` to the corresponding complex with objects in `Vᵒᵖ`. -/ +@[simps] protected def op_symm (X : homological_complex V c.symm) : homological_complex Vᵒᵖ c := +{ X := λ i, op (X.X i), + d := λ i j, (X.d j i).op, + shape' := λ i j hij, by { rw [X.shape j i hij, op_zero], }, + d_comp_d' := by { intros, rw [← op_comp, X.d_comp_d, op_zero], } } + +/-- Sends a complex `X` with objects in `Vᵒᵖ` to the corresponding complex with objects in `V`. -/ +@[simps] protected def unop (X : homological_complex Vᵒᵖ c) : homological_complex V c.symm := +{ X := λ i, unop (X.X i), + d := λ i j, (X.d j i).unop, + shape' := λ i j hij, by { rw [X.shape j i hij, unop_zero], }, + d_comp_d' := by { intros, rw [← unop_comp, X.d_comp_d, unop_zero], } } + +/-- Sends a complex `X` with objects in `Vᵒᵖ` to the corresponding complex with objects in `V`. -/ +@[simps] protected def unop_symm (X : homological_complex Vᵒᵖ c.symm) : homological_complex V c := +{ X := λ i, unop (X.X i), + d := λ i j, (X.d j i).unop, + shape' := λ i j hij, by { rw [X.shape j i hij, unop_zero], }, + d_comp_d' := by { intros, rw [← unop_comp, X.d_comp_d, unop_zero], } } + +variables (V c) + +/-- Auxilliary definition for `op_equivalence`. -/ +@[simps] def op_functor : (homological_complex V c)ᵒᵖ ⥤ homological_complex Vᵒᵖ c.symm := +{ obj := λ X, (unop X).op, + map := λ X Y f, + { f := λ i, (f.unop.f i).op, + comm' := λ i j hij, by simp only [op_d, ← op_comp, f.unop.comm] }, } + +/-- Auxilliary definition for `op_equivalence`. -/ +@[simps] def op_inverse : homological_complex Vᵒᵖ c.symm ⥤ (homological_complex V c)ᵒᵖ := +{ obj := λ X, op X.unop_symm, + map := λ X Y f, quiver.hom.op + { f := λ i, (f.f i).unop, + comm' := λ i j hij, by simp only [unop_symm_d, ←unop_comp, f.comm], }} + +/-- Auxilliary definition for `op_equivalence`. -/ +def op_unit_iso : 𝟭 (homological_complex V c)ᵒᵖ ≅ op_functor V c ⋙ op_inverse V c := +nat_iso.of_components (λ X, (homological_complex.hom.iso_of_components (λ i, iso.refl _) + (λ i j hij, by simp only [iso.refl_hom, category.id_comp, unop_symm_d, op_d, quiver.hom.unop_op, + category.comp_id]) : (opposite.unop X).op.unop_symm ≅ unop X).op) + begin + intros X Y f, + refine quiver.hom.unop_inj _, + ext, + simp only [quiver.hom.unop_op, functor.id_map, iso.op_hom, functor.comp_map, + unop_comp, comp_f, hom.iso_of_components_hom_f], + erw [category.id_comp, category.comp_id (f.unop.f x)], + end + +/-- Auxilliary definition for `op_equivalence`. -/ +def op_counit_iso : op_inverse V c ⋙ op_functor V c ≅ 𝟭 (homological_complex Vᵒᵖ c.symm) := +nat_iso.of_components (λ X, homological_complex.hom.iso_of_components (λ i, iso.refl _) + (λ i j hij, by simpa only [iso.refl_hom, category.id_comp, category.comp_id])) + begin + intros X Y f, + ext, + simpa only [quiver.hom.unop_op, quiver.hom.op_unop, functor.comp_map, functor.id_map, + iso.refl_hom, category.id_comp, category.comp_id, comp_f, hom.iso_of_components_hom_f], + end + +/-- Given a category of complexes with objects in `V`, there is a natural equivalence between its +opposite category and a category of complexes with objects in `Vᵒᵖ`. -/ +@[simps] def op_equivalence : (homological_complex V c)ᵒᵖ ≌ homological_complex Vᵒᵖ c.symm := +{ functor := op_functor V c, + inverse := op_inverse V c, + unit_iso := op_unit_iso V c, + counit_iso := op_counit_iso V c, + functor_unit_iso_comp' := + begin + intro X, + ext, + simp only [op_unit_iso, op_counit_iso, nat_iso.of_components_hom_app, iso.op_hom, + comp_f, op_functor_map_f, quiver.hom.unop_op, hom.iso_of_components_hom_f], + exact category.comp_id _, + end } + +/-- Auxilliary definition for `unop_equivalence`. -/ +@[simps] def unop_functor : (homological_complex Vᵒᵖ c)ᵒᵖ ⥤ homological_complex V c.symm := +{ obj := λ X, (unop X).unop, + map := λ X Y f, + { f := λ i, (f.unop.f i).unop, + comm' := λ i j hij, by simp only [unop_d, ← unop_comp, f.unop.comm] }, } + +/-- Auxilliary definition for `unop_equivalence`. -/ +@[simps] def unop_inverse : homological_complex V c.symm ⥤ (homological_complex Vᵒᵖ c)ᵒᵖ := +{ obj := λ X, op X.op_symm, + map := λ X Y f, quiver.hom.op + { f := λ i, (f.f i).op, + comm' := λ i j hij, by simp only [op_symm_d, ←op_comp, f.comm], }} + +/-- Auxilliary definition for `unop_equivalence`. -/ +def unop_unit_iso : 𝟭 (homological_complex Vᵒᵖ c)ᵒᵖ ≅ unop_functor V c ⋙ unop_inverse V c := +nat_iso.of_components (λ X, (homological_complex.hom.iso_of_components (λ i, iso.refl _) + (λ i j hij, by simp only [iso.refl_hom, category.id_comp, unop_symm_d, op_d, quiver.hom.unop_op, + category.comp_id]) : (opposite.unop X).op.unop_symm ≅ unop X).op) + begin + intros X Y f, + refine quiver.hom.unop_inj _, + ext, + simp only [quiver.hom.unop_op, functor.id_map, iso.op_hom, functor.comp_map, + unop_comp, comp_f, hom.iso_of_components_hom_f], + erw [category.id_comp, category.comp_id (f.unop.f x)], + end + +/-- Auxilliary definition for `unop_equivalence`. -/ +def unop_counit_iso : unop_inverse V c ⋙ unop_functor V c ≅ 𝟭 (homological_complex V c.symm) := +nat_iso.of_components (λ X, homological_complex.hom.iso_of_components (λ i, iso.refl _) + (λ i j hij, by simpa only [iso.refl_hom, category.id_comp, category.comp_id])) + begin + intros X Y f, + ext, + simpa only [quiver.hom.unop_op, quiver.hom.op_unop, functor.comp_map, functor.id_map, + iso.refl_hom, category.id_comp, category.comp_id, comp_f, hom.iso_of_components_hom_f], + end + +/-- Given a category of complexes with objects in `Vᵒᵖ`, there is a natural equivalence between its +opposite category and a category of complexes with objects in `V`. -/ +@[simps] def unop_equivalence : (homological_complex Vᵒᵖ c)ᵒᵖ ≌ homological_complex V c.symm := +{ functor := unop_functor V c, + inverse := unop_inverse V c, + unit_iso := unop_unit_iso V c, + counit_iso := unop_counit_iso V c, + functor_unit_iso_comp' := + begin + intro X, + ext, + simp only [op_unit_iso, op_counit_iso, nat_iso.of_components_hom_app, iso.op_hom, + comp_f, op_functor_map_f, quiver.hom.unop_op, hom.iso_of_components_hom_f], + exact category.comp_id _, + end } + +variables {V c} +instance op_functor_additive : (@op_functor ι V _ c _).additive := {} + +instance unop_functor_additive : (@unop_functor ι V _ c _).additive := {} + +end + +variables [abelian V] (C : homological_complex V c) (i : ι) + +/-- Auxilliary tautological definition for `homology_op`. -/ +def homology_op_def : + C.op.homology i ≅ _root_.homology (C.d_from i).op (C.d_to i).op + (by rw [←op_comp, C.d_to_comp_d_from i, op_zero]) := iso.refl _ + +/-- Given a complex `C` of objects in `V`, the `i`th homology of its 'opposite' complex (with +objects in `Vᵒᵖ`) is the opposite of the `i`th homology of `C`. -/ +def homology_op : C.op.homology i ≅ opposite.op (C.homology i) := +homology_op_def _ _ ≪≫ homology_op _ _ _ + +/-- Auxilliary tautological definition for `homology_unop`. -/ +def homology_unop_def (C : homological_complex Vᵒᵖ c) : + C.unop.homology i ≅ _root_.homology (C.d_from i).unop (C.d_to i).unop + (by rw [←unop_comp, C.d_to_comp_d_from i, unop_zero]) := iso.refl _ + +/-- Given a complex `C` of objects in `Vᵒᵖ`, the `i`th homology of its 'opposite' complex (with +objects in `V`) is the opposite of the `i`th homology of `C`. -/ +def homology_unop (C : homological_complex Vᵒᵖ c) : + C.unop.homology i ≅ opposite.unop (C.homology i) := +homology_unop_def _ _ ≪≫ homology_unop _ _ _ + +end homological_complex diff --git a/src/algebra/homology/quasi_iso.lean b/src/algebra/homology/quasi_iso.lean index 20d99543f75fc..82fd875676257 100644 --- a/src/algebra/homology/quasi_iso.lean +++ b/src/algebra/homology/quasi_iso.lean @@ -1,13 +1,17 @@ /- Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Scott Morrison, Joël Riou -/ -import algebra.homology.homology +import algebra.homology.homotopy +import category_theory.abelian.homology /-! # Quasi-isomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A chain map is a quasi-isomorphism if it induces isomorphisms on homology. ## Future work @@ -53,3 +57,159 @@ lemma quasi_iso_of_comp_left (f : C ⟶ D) [quasi_iso f] (g : D ⟶ E) [quasi_is lemma quasi_iso_of_comp_right (f : C ⟶ D) (g : D ⟶ E) [quasi_iso g] [quasi_iso (f ≫ g)] : quasi_iso f := { is_iso := λ i, is_iso.of_is_iso_fac_right ((homology_functor V c i).map_comp f g).symm } + +namespace homotopy_equiv + +section +variables {W : Type*} [category W] [preadditive W] [has_cokernels W] [has_images W] + [has_equalizers W] [has_zero_object W] [has_image_maps W] + +/-- An homotopy equivalence is a quasi-isomorphism. -/ +lemma to_quasi_iso {C D : homological_complex W c} (e : homotopy_equiv C D) : + quasi_iso e.hom := +⟨λ i, begin + refine ⟨⟨(homology_functor W c i).map e.inv, _⟩⟩, + simp only [← functor.map_comp, ← (homology_functor W c i).map_id], + split; apply homology_map_eq_of_homotopy, + exacts [e.homotopy_hom_inv_id, e.homotopy_inv_hom_id], +end⟩ + +lemma to_quasi_iso_inv {C D : homological_complex W c} (e : homotopy_equiv C D) (i : ι) : + (@as_iso _ _ _ _ _ (e.to_quasi_iso.1 i)).inv = (homology_functor W c i).map e.inv := +begin + symmetry, + simp only [←iso.hom_comp_eq_id, as_iso_hom, ←functor.map_comp, ←(homology_functor W c i).map_id, + homology_map_eq_of_homotopy e.homotopy_hom_inv_id _], +end + +end +end homotopy_equiv +namespace homological_complex.hom +section to_single₀ +variables {W : Type*} [category W] [abelian W] + +section +variables {X : chain_complex W ℕ} {Y : W} (f : X ⟶ ((chain_complex.single₀ _).obj Y)) + [hf : quasi_iso f] + +/-- If a chain map `f : X ⟶ Y[0]` is a quasi-isomorphism, then the cokernel of the differential +`d : X₁ → X₀` is isomorphic to `Y.` -/ +noncomputable def to_single₀_cokernel_at_zero_iso : cokernel (X.d 1 0) ≅ Y := +(X.homology_zero_iso.symm.trans ((@as_iso _ _ _ _ _ (hf.1 0)).trans + ((chain_complex.homology_functor_0_single₀ W).app Y))) + +lemma to_single₀_cokernel_at_zero_iso_hom_eq [hf : quasi_iso f] : + f.to_single₀_cokernel_at_zero_iso.hom = cokernel.desc (X.d 1 0) (f.f 0) + (by rw ←f.2 1 0 rfl; exact comp_zero) := +begin + ext, + dunfold to_single₀_cokernel_at_zero_iso chain_complex.homology_zero_iso homology_of_zero_right + homology.map_iso chain_complex.homology_functor_0_single₀ cokernel.map, + dsimp, + simp only [cokernel.π_desc, category.assoc, homology.map_desc, cokernel.π_desc_assoc], + simp [homology.desc, iso.refl_inv (X.X 0)], +end + +lemma to_single₀_epi_at_zero [hf : quasi_iso f] : + epi (f.f 0) := +begin + constructor, + intros Z g h Hgh, + rw [←cokernel.π_desc (X.d 1 0) (f.f 0) (by rw ←f.2 1 0 rfl; exact comp_zero), + ←to_single₀_cokernel_at_zero_iso_hom_eq] at Hgh, + rw (@cancel_epi _ _ _ _ _ _ (epi_comp _ _) _ _).1 Hgh, +end + +lemma to_single₀_exact_d_f_at_zero [hf : quasi_iso f] : + exact (X.d 1 0) (f.f 0) := +begin + rw preadditive.exact_iff_homology_zero, + have h : X.d 1 0 ≫ f.f 0 = 0, + { simp only [← f.2 1 0 rfl, chain_complex.single₀_obj_X_d, comp_zero], }, + refine ⟨h, nonempty.intro (homology_iso_kernel_desc _ _ _ ≪≫ _)⟩, + { suffices : is_iso (cokernel.desc _ _ h), + { haveI := this, apply kernel.of_mono, }, + rw ←to_single₀_cokernel_at_zero_iso_hom_eq, + apply_instance } +end + +lemma to_single₀_exact_at_succ [hf : quasi_iso f] (n : ℕ) : + exact (X.d (n + 2) (n + 1)) (X.d (n + 1) n) := +(preadditive.exact_iff_homology_zero _ _).2 ⟨X.d_comp_d _ _ _, +⟨(chain_complex.homology_succ_iso _ _).symm.trans + ((@as_iso _ _ _ _ _ (hf.1 (n + 1))).trans homology_zero_zero)⟩⟩ + +end +section +variables {X : cochain_complex W ℕ} {Y : W} + (f : (cochain_complex.single₀ _).obj Y ⟶ X) + +/-- If a cochain map `f : Y[0] ⟶ X` is a quasi-isomorphism, then the kernel of the differential +`d : X₀ → X₁` is isomorphic to `Y.` -/ +noncomputable def from_single₀_kernel_at_zero_iso [hf : quasi_iso f] : kernel (X.d 0 1) ≅ Y := +(X.homology_zero_iso.symm.trans ((@as_iso _ _ _ _ _ (hf.1 0)).symm.trans + ((cochain_complex.homology_functor_0_single₀ W).app Y))) + +lemma from_single₀_kernel_at_zero_iso_inv_eq [hf : quasi_iso f] : + f.from_single₀_kernel_at_zero_iso.inv = kernel.lift (X.d 0 1) (f.f 0) + (by rw f.2 0 1 rfl; exact zero_comp) := +begin + ext, + dunfold from_single₀_kernel_at_zero_iso cochain_complex.homology_zero_iso homology_of_zero_left + homology.map_iso cochain_complex.homology_functor_0_single₀ kernel.map, + simp only [iso.trans_inv, iso.app_inv, iso.symm_inv, category.assoc, + equalizer_as_kernel, kernel.lift_ι], + dsimp, + simp only [category.assoc, homology.π_map, cokernel_zero_iso_target_hom, + cokernel_iso_of_eq_hom_comp_desc, kernel_subobject_arrow, homology.π_map_assoc, + is_iso.inv_comp_eq], + simp [homology.π, kernel_subobject_map_comp, iso.refl_hom (X.X 0), category.comp_id], +end + +lemma from_single₀_mono_at_zero [hf : quasi_iso f] : + mono (f.f 0) := +begin + constructor, + intros Z g h Hgh, + rw [←kernel.lift_ι (X.d 0 1) (f.f 0) (by rw f.2 0 1 rfl; exact zero_comp), + ←from_single₀_kernel_at_zero_iso_inv_eq] at Hgh, + rw (@cancel_mono _ _ _ _ _ _ (mono_comp _ _) _ _).1 Hgh, +end + +lemma from_single₀_exact_f_d_at_zero [hf : quasi_iso f] : + exact (f.f 0) (X.d 0 1) := +begin + rw preadditive.exact_iff_homology_zero, + have h : f.f 0 ≫ X.d 0 1 = 0, + { simp only [homological_complex.hom.comm, cochain_complex.single₀_obj_X_d, zero_comp] }, + refine ⟨h, nonempty.intro (homology_iso_cokernel_lift _ _ _ ≪≫ _)⟩, + { suffices : is_iso (kernel.lift (X.d 0 1) (f.f 0) h), + { haveI := this, apply cokernel.of_epi }, + rw ←from_single₀_kernel_at_zero_iso_inv_eq f, + apply_instance }, +end + +lemma from_single₀_exact_at_succ [hf : quasi_iso f] (n : ℕ) : + exact (X.d n (n + 1)) (X.d (n + 1) (n + 2)) := +(preadditive.exact_iff_homology_zero _ _).2 + ⟨X.d_comp_d _ _ _, ⟨(cochain_complex.homology_succ_iso _ _).symm.trans + ((@as_iso _ _ _ _ _ (hf.1 (n + 1))).symm.trans homology_zero_zero)⟩⟩ + +end +end to_single₀ +end homological_complex.hom + +variables {A : Type*} [category A] [abelian A] {B : Type*} [category B] [abelian B] + (F : A ⥤ B) [functor.additive F] [preserves_finite_limits F] [preserves_finite_colimits F] + [faithful F] + +lemma category_theory.functor.quasi_iso_of_map_quasi_iso + {C D : homological_complex A c} (f : C ⟶ D) + (hf : quasi_iso ((F.map_homological_complex _).map f)) : quasi_iso f := +⟨λ i, begin + haveI : is_iso (F.map ((homology_functor A c i).map f)), + { rw [← functor.comp_map, ← nat_iso.naturality_2 (F.homology_functor_iso i) f, + functor.comp_map], + apply_instance, }, + exact is_iso_of_reflects_iso _ F, +end⟩ diff --git a/src/algebra/homology/short_exact/abelian.lean b/src/algebra/homology/short_exact/abelian.lean new file mode 100644 index 0000000000000..639dea8217be2 --- /dev/null +++ b/src/algebra/homology/short_exact/abelian.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2021 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin, Andrew Yang, Pierre-Alexandre Bazin +-/ +import algebra.homology.short_exact.preadditive +import category_theory.abelian.diagram_lemmas.four + +/-! +# Short exact sequences in abelian categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In an abelian category, a left-split or right-split short exact sequence admits a splitting. +-/ + +noncomputable theory + +open category_theory category_theory.limits category_theory.preadditive + +variables {𝒜 : Type*} [category 𝒜] + +namespace category_theory + +variables {A B C A' B' C' : 𝒜} {f : A ⟶ B} {g : B ⟶ C} {f' : A' ⟶ B'} {g' : B' ⟶ C'} +variables [abelian 𝒜] +open_locale zero_object + +lemma is_iso_of_short_exact_of_is_iso_of_is_iso (h : short_exact f g) (h' : short_exact f' g') + (i₁ : A ⟶ A') (i₂ : B ⟶ B') (i₃ : C ⟶ C') + (comm₁ : i₁ ≫ f' = f ≫ i₂) (comm₂ : i₂ ≫ g' = g ≫ i₃) [is_iso i₁] [is_iso i₃] : + is_iso i₂ := +begin + obtain ⟨_⟩ := h, + obtain ⟨_⟩ := h', + resetI, + refine @abelian.is_iso_of_is_iso_of_is_iso_of_is_iso_of_is_iso 𝒜 _ _ 0 _ _ _ 0 _ _ _ + 0 f g 0 f' g' 0 i₁ i₂ i₃ _ comm₁ comm₂ 0 0 0 0 0 _ _ _ _ _ _ _ _ _ _ _; + try { simp }; + try { apply exact_zero_left_of_mono }; + try { assumption }; + rwa ← epi_iff_exact_zero_right, +end + +/-- To construct a splitting of `A -f⟶ B -g⟶ C` it suffices to supply +a *morphism* `i : B ⟶ A ⊞ C` such that `f ≫ i` is the canonical map `biprod.inl : A ⟶ A ⊞ C` and +`i ≫ q = g`, where `q` is the canonical map `biprod.snd : A ⊞ C ⟶ C`, +together with proofs that `f` is mono and `g` is epi. + +The morphism `i` is then automatically an isomorphism. -/ +def splitting.mk' (h : short_exact f g) (i : B ⟶ A ⊞ C) + (h1 : f ≫ i = biprod.inl) (h2 : i ≫ biprod.snd = g) : splitting f g := +{ iso := + begin + refine @as_iso _ _ _ _ i (id _), + refine is_iso_of_short_exact_of_is_iso_of_is_iso h _ _ _ _ + (h1.trans (category.id_comp _).symm).symm (h2.trans (category.comp_id _).symm), + split, + apply exact_inl_snd + end, + comp_iso_eq_inl := by { rwa as_iso_hom, }, + iso_comp_snd_eq := h2 } + +/-- To construct a splitting of `A -f⟶ B -g⟶ C` it suffices to supply +a *morphism* `i : A ⊞ C ⟶ B` such that `p ≫ i = f` where `p` is the canonical map +`biprod.inl : A ⟶ A ⊞ C`, and `i ≫ g` is the canonical map `biprod.snd : A ⊞ C ⟶ C`, +together with proofs that `f` is mono and `g` is epi. + +The morphism `i` is then automatically an isomorphism. -/ +def splitting.mk'' (h : short_exact f g) (i : A ⊞ C ⟶ B) + (h1 : biprod.inl ≫ i = f) (h2 : i ≫ g = biprod.snd) : splitting f g := +{ iso := + begin + refine (@as_iso _ _ _ _ i (id _)).symm, + refine is_iso_of_short_exact_of_is_iso_of_is_iso _ h _ _ _ + (h1.trans (category.id_comp _).symm).symm (h2.trans (category.comp_id _).symm), + split, + apply exact_inl_snd + end, + comp_iso_eq_inl := by rw [iso.symm_hom, as_iso_inv, is_iso.comp_inv_eq, h1], + iso_comp_snd_eq := by rw [iso.symm_hom, as_iso_inv, is_iso.inv_comp_eq, h2] } + +/-- A short exact sequence that is left split admits a splitting. -/ +def left_split.splitting {f : A ⟶ B} {g : B ⟶ C} (h : left_split f g) : splitting f g := +splitting.mk' h.short_exact (biprod.lift h.left_split.some g) +(by { ext, + { simpa only [biprod.inl_fst, biprod.lift_fst, category.assoc] using h.left_split.some_spec }, + { simp only [biprod.inl_snd, biprod.lift_snd, category.assoc, h.exact.w], } }) +(by { simp only [biprod.lift_snd], }) + +/-- A short exact sequence that is right split admits a splitting. -/ +def right_split.splitting {f : A ⟶ B} {g : B ⟶ C} (h : right_split f g) : splitting f g := +splitting.mk'' h.short_exact (biprod.desc f h.right_split.some) +(biprod.inl_desc _ _) +(by { ext, + { rw [biprod.inl_snd, ← category.assoc, biprod.inl_desc, h.exact.w] }, + { rw [biprod.inr_snd, ← category.assoc, biprod.inr_desc, h.right_split.some_spec] } }) + +end category_theory diff --git a/src/algebra/homology/short_exact/preadditive.lean b/src/algebra/homology/short_exact/preadditive.lean new file mode 100644 index 0000000000000..899a730744bd9 --- /dev/null +++ b/src/algebra/homology/short_exact/preadditive.lean @@ -0,0 +1,318 @@ +/- +Copyright (c) 2021 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin, Andrew Yang +-/ +import algebra.homology.exact +import category_theory.preadditive.additive_functor + +/-! +# Short exact sequences, and splittings. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +`short_exact f g` is the proposition that `0 ⟶ A -f⟶ B -g⟶ C ⟶ 0` is an exact sequence. + +We define when a short exact sequence is left-split, right-split, and split. + +## See also +In `algebra.homology.short_exact.abelian` we show that in an abelian category +a left-split short exact sequences admits a splitting. +-/ + +noncomputable theory + +open category_theory category_theory.limits category_theory.preadditive + +variables {𝒜 : Type*} [category 𝒜] + +namespace category_theory +variables {A B C A' B' C' : 𝒜} (f : A ⟶ B) (g : B ⟶ C) (f' : A' ⟶ B') (g' : B' ⟶ C') + +section has_zero_morphisms +variables [has_zero_morphisms 𝒜] [has_kernels 𝒜] [has_images 𝒜] + +/-- If `f : A ⟶ B` and `g : B ⟶ C` then `short_exact f g` is the proposition saying + the resulting diagram `0 ⟶ A ⟶ B ⟶ C ⟶ 0` is an exact sequence. -/ +structure short_exact : Prop := +[mono : mono f] +[epi : epi g] +(exact : exact f g) + +/-- An exact sequence `A -f⟶ B -g⟶ C` is *left split* +if there exists a morphism `φ : B ⟶ A` such that `f ≫ φ = 𝟙 A` and `g` is epi. + +Such a sequence is automatically short exact (i.e., `f` is mono). -/ +structure left_split : Prop := +(left_split : ∃ φ : B ⟶ A, f ≫ φ = 𝟙 A) +[epi : epi g] +(exact : exact f g) + +lemma left_split.short_exact {f : A ⟶ B} {g : B ⟶ C} (h : left_split f g) : short_exact f g := +{ mono := + begin + obtain ⟨φ, hφ⟩ := h.left_split, + haveI : mono (f ≫ φ) := by { rw hφ, apply_instance }, + exact mono_of_mono f φ, + end, + epi := h.epi, + exact := h.exact } + +/-- An exact sequence `A -f⟶ B -g⟶ C` is *right split* +if there exists a morphism `φ : C ⟶ B` such that `f ≫ φ = 𝟙 A` and `f` is mono. + +Such a sequence is automatically short exact (i.e., `g` is epi). -/ +structure right_split : Prop := +(right_split : ∃ χ : C ⟶ B, χ ≫ g = 𝟙 C) +[mono : mono f] +(exact : exact f g) + +lemma right_split.short_exact {f : A ⟶ B} {g : B ⟶ C} (h : right_split f g) : short_exact f g := +{ epi := + begin + obtain ⟨χ, hχ⟩ := h.right_split, + haveI : epi (χ ≫ g) := by { rw hχ, apply_instance }, + exact epi_of_epi χ g, + end, + mono := h.mono, + exact := h.exact } + +end has_zero_morphisms + +section preadditive +variables [preadditive 𝒜] + +/-- An exact sequence `A -f⟶ B -g⟶ C` is *split* if there exist +`φ : B ⟶ A` and `χ : C ⟶ B` such that: +* `f ≫ φ = 𝟙 A` +* `χ ≫ g = 𝟙 C` +* `f ≫ g = 0` +* `χ ≫ φ = 0` +* `φ ≫ f + g ≫ χ = 𝟙 B` + +Such a sequence is automatically short exact (i.e., `f` is mono and `g` is epi). -/ +structure split : Prop := +(split : ∃ (φ : B ⟶ A) (χ : C ⟶ B), + f ≫ φ = 𝟙 A ∧ χ ≫ g = 𝟙 C ∧ f ≫ g = 0 ∧ χ ≫ φ = 0 ∧ φ ≫ f + g ≫ χ = 𝟙 B) + +variables [has_kernels 𝒜] [has_images 𝒜] + +lemma exact_of_split {A B C : 𝒜} {f : A ⟶ B} {g : B ⟶ C} {χ : C ⟶ B} {φ : B ⟶ A} + (hfg : f ≫ g = 0) (H : φ ≫ f + g ≫ χ = 𝟙 B) : exact f g := +{ w := hfg, + epi := + begin + let ψ : (kernel_subobject g : 𝒜) ⟶ image_subobject f := + subobject.arrow _ ≫ φ ≫ factor_thru_image_subobject f, + suffices : ψ ≫ image_to_kernel f g hfg = 𝟙 _, + { convert epi_of_epi ψ _, rw this, apply_instance }, + rw ← cancel_mono (subobject.arrow _), swap, { apply_instance }, + simp only [image_to_kernel_arrow, image_subobject_arrow_comp, category.id_comp, category.assoc], + calc (kernel_subobject g).arrow ≫ φ ≫ f + = (kernel_subobject g).arrow ≫ 𝟙 B : _ + ... = (kernel_subobject g).arrow : category.comp_id _, + rw [← H, preadditive.comp_add], + simp only [add_zero, zero_comp, kernel_subobject_arrow_comp_assoc], + end } + +section + +variables {f g} + +lemma split.exact (h : split f g) : exact f g := +by { obtain ⟨φ, χ, -, -, h1, -, h2⟩ := h, exact exact_of_split h1 h2 } + +lemma split.left_split (h : split f g) : left_split f g := +{ left_split := by { obtain ⟨φ, χ, h1, -⟩ := h, exact ⟨φ, h1⟩, }, + epi := begin + obtain ⟨φ, χ, -, h2, -⟩ := h, + have : epi (χ ≫ g), { rw h2, apply_instance }, + exactI epi_of_epi χ g, + end, + exact := h.exact } + +lemma split.right_split (h : split f g) : right_split f g := +{ right_split := by { obtain ⟨φ, χ, -, h1, -⟩ := h, exact ⟨χ, h1⟩, }, + mono := begin + obtain ⟨φ, χ, h1, -⟩ := h, + have : mono (f ≫ φ), { rw h1, apply_instance }, + exactI mono_of_mono f φ, + end, + exact := h.exact } + +lemma split.short_exact (h : split f g) : short_exact f g := +h.left_split.short_exact + +end + +lemma split.map {𝒜 ℬ : Type*} [category 𝒜] [preadditive 𝒜] [category ℬ] [preadditive ℬ] + (F : 𝒜 ⥤ ℬ) [functor.additive F] {A B C : 𝒜} {f : A ⟶ B} {g : B ⟶ C} (h : split f g) : + split (F.map f) (F.map g) := +begin + obtain ⟨φ, χ, h1, h2, h3, h4, h5⟩ := h, + refine ⟨⟨F.map φ, F.map χ, _⟩⟩, + simp only [← F.map_comp, ← F.map_id, ← F.map_add, F.map_zero, *, eq_self_iff_true, and_true], +end + +/-- The sequence `A ⟶ A ⊞ B ⟶ B` is exact. -/ +lemma exact_inl_snd [has_binary_biproducts 𝒜] (A B : 𝒜) : + exact (biprod.inl : A ⟶ A ⊞ B) biprod.snd := +exact_of_split biprod.inl_snd biprod.total + +/-- The sequence `B ⟶ A ⊞ B ⟶ A` is exact. -/ +lemma exact_inr_fst [has_binary_biproducts 𝒜] (A B : 𝒜) : + exact (biprod.inr : B ⟶ A ⊞ B) biprod.fst := +exact_of_split biprod.inr_fst ((add_comm _ _).trans biprod.total) + +end preadditive + +/-- A *splitting* of a sequence `A -f⟶ B -g⟶ C` is an isomorphism +to the short exact sequence `0 ⟶ A ⟶ A ⊞ C ⟶ C ⟶ 0` such that +the vertical maps on the left and the right are the identity. -/ +@[nolint has_nonempty_instance] +structure splitting [has_zero_morphisms 𝒜] [has_binary_biproducts 𝒜] := +(iso : B ≅ A ⊞ C) +(comp_iso_eq_inl : f ≫ iso.hom = biprod.inl) +(iso_comp_snd_eq : iso.hom ≫ biprod.snd = g) + +variables {f g} + +namespace splitting + +section has_zero_morphisms +variables [has_zero_morphisms 𝒜] [has_binary_biproducts 𝒜] + +attribute [simp, reassoc] comp_iso_eq_inl iso_comp_snd_eq + +variables (h : splitting f g) + +@[simp, reassoc] lemma inl_comp_iso_eq : biprod.inl ≫ h.iso.inv = f := +by rw [iso.comp_inv_eq, h.comp_iso_eq_inl] + +@[simp, reassoc] lemma iso_comp_eq_snd : h.iso.inv ≫ g = biprod.snd := +by rw [iso.inv_comp_eq, h.iso_comp_snd_eq] + +/-- If `h` is a splitting of `A -f⟶ B -g⟶ C`, +then `h.section : C ⟶ B` is the morphism satisfying `h.section ≫ g = 𝟙 C`. -/ +def _root_.category_theory.splitting.section : C ⟶ B := biprod.inr ≫ h.iso.inv + +/-- If `h` is a splitting of `A -f⟶ B -g⟶ C`, +then `h.retraction : B ⟶ A` is the morphism satisfying `f ≫ h.retraction = 𝟙 A`. -/ +def retraction : B ⟶ A := h.iso.hom ≫ biprod.fst + +@[simp, reassoc] lemma section_π : h.section ≫ g = 𝟙 C := by { delta splitting.section, simp } + +@[simp, reassoc] lemma ι_retraction : f ≫ h.retraction = 𝟙 A := by { delta retraction, simp } + +@[simp, reassoc] lemma section_retraction : h.section ≫ h.retraction = 0 := +by { delta splitting.section retraction, simp } + +/-- The retraction in a splitting is a split mono. -/ +protected def split_mono : split_mono f := ⟨h.retraction, by simp⟩ + +/-- The section in a splitting is a split epi. -/ +protected def split_epi : split_epi g := ⟨h.section, by simp⟩ + +@[simp, reassoc] lemma inr_iso_inv : biprod.inr ≫ h.iso.inv = h.section := rfl + +@[simp, reassoc] lemma iso_hom_fst : h.iso.hom ≫ biprod.fst = h.retraction := rfl + +/-- A short exact sequence of the form `X -f⟶ Y -0⟶ Z` where `f` is an iso and `Z` is zero +has a splitting. -/ +def splitting_of_is_iso_zero {X Y Z : 𝒜} (f : X ⟶ Y) [is_iso f] (hZ : is_zero Z) : + splitting f (0 : Y ⟶ Z) := +⟨(as_iso f).symm ≪≫ iso_biprod_zero hZ, by simp [hZ.eq_of_tgt _ 0], by simp⟩ + +include h + +protected lemma mono : mono f := +begin + apply mono_of_mono _ h.retraction, + rw h.ι_retraction, + apply_instance +end + +protected lemma epi : epi g := +begin + apply_with (epi_of_epi h.section) { instances := ff }, + rw h.section_π, + apply_instance +end + +instance : mono h.section := +by { delta splitting.section, apply_instance } + +instance : epi h.retraction := +by { delta retraction, apply epi_comp } + +end has_zero_morphisms + +section preadditive +variables [preadditive 𝒜] [has_binary_biproducts 𝒜] +variables (h : splitting f g) + +lemma split_add : h.retraction ≫ f + g ≫ h.section = 𝟙 _ := +begin + delta splitting.section retraction, + rw [← cancel_mono h.iso.hom, ← cancel_epi h.iso.inv], + simp only [category.comp_id, category.id_comp, category.assoc, + iso.inv_hom_id_assoc, iso.inv_hom_id, limits.biprod.total, + preadditive.comp_add, preadditive.add_comp, + splitting.comp_iso_eq_inl, splitting.iso_comp_eq_snd_assoc] +end + +@[reassoc] +lemma retraction_ι_eq_id_sub : + h.retraction ≫ f = 𝟙 _ - g ≫ h.section := +eq_sub_iff_add_eq.mpr h.split_add + +@[reassoc] +lemma π_section_eq_id_sub : + g ≫ h.section = 𝟙 _ - h.retraction ≫ f := +eq_sub_iff_add_eq.mpr ((add_comm _ _).trans h.split_add) + +lemma splittings_comm (h h' : splitting f g) : + h'.section ≫ h.retraction = - h.section ≫ h'.retraction := +begin + haveI := h.mono, + rw ← cancel_mono f, + simp [retraction_ι_eq_id_sub], +end + +include h + +lemma split : split f g := +begin + let φ := h.iso.hom ≫ biprod.fst, + let χ := biprod.inr ≫ h.iso.inv, + refine ⟨⟨h.retraction, h.section, h.ι_retraction, h.section_π, _, + h.section_retraction, h.split_add⟩⟩, + rw [← h.inl_comp_iso_eq, category.assoc, h.iso_comp_eq_snd, biprod.inl_snd], +end + +@[reassoc] lemma comp_eq_zero : f ≫ g = 0 := +h.split.1.some_spec.some_spec.2.2.1 + +variables [has_kernels 𝒜] [has_images 𝒜] [has_zero_object 𝒜] [has_cokernels 𝒜] + +protected lemma exact : exact f g := +begin + rw exact_iff_exact_of_iso f g (biprod.inl : A ⟶ A ⊞ C) (biprod.snd : A ⊞ C ⟶ C) _ _ _, + { exact exact_inl_snd _ _ }, + { refine arrow.iso_mk (iso.refl _) h.iso _, + simp only [iso.refl_hom, arrow.mk_hom, category.id_comp, comp_iso_eq_inl], }, + { refine arrow.iso_mk h.iso (iso.refl _) _, + dsimp, simp, }, + { refl } +end + +protected +lemma short_exact : short_exact f g := +{ mono := h.mono, epi := h.epi, exact := h.exact } + +end preadditive + +end splitting + +end category_theory diff --git a/src/algebra/homology/single.lean b/src/algebra/homology/single.lean index 82ff2975d8030..ca25cc2f960e9 100644 --- a/src/algebra/homology/single.lean +++ b/src/algebra/homology/single.lean @@ -8,6 +8,9 @@ import algebra.homology.homology /-! # Chain complexes supported in a single degree +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `single V j c : V ⥤ homological_complex V c`, which constructs complexes in `V` of shape `c`, supported in degree `j`. @@ -179,6 +182,7 @@ Morphisms from a `ℕ`-indexed chain complex `C` to a single object chain complex with `X` concentrated in degree 0 are the same as morphisms `f : C.X 0 ⟶ X` such that `C.d 1 0 ≫ f = 0`. -/ +@[simps] def to_single₀_equiv (C : chain_complex V ℕ) (X : V) : (C ⟶ (single₀ V).obj X) ≃ { f : C.X 0 ⟶ X // C.d 1 0 ≫ f = 0 } := { to_fun := λ f, ⟨f.f 0, by { rw ←f.comm 1 0, simp, }⟩, @@ -201,6 +205,37 @@ def to_single₀_equiv (C : chain_complex V ℕ) (X : V) : end, right_inv := by tidy, } +@[ext] +lemma to_single₀_ext {C : chain_complex V ℕ} {X : V} + (f g : (C ⟶ (single₀ V).obj X)) (h : f.f 0 = g.f 0) : f = g := +(to_single₀_equiv C X).injective (by { ext, exact h, }) + +/-- +Morphisms from a single object chain complex with `X` concentrated in degree 0 +to a `ℕ`-indexed chain complex `C` are the same as morphisms `f : X → C.X`. +-/ +@[simps] +def from_single₀_equiv (C : chain_complex V ℕ) (X : V) : + ((single₀ V).obj X ⟶ C) ≃ (X ⟶ C.X 0) := +{ to_fun := λ f, f.f 0, + inv_fun := λ f, + { f := λ i, match i with + | 0 := f + | (n+1) := 0 + end, + comm' := λ i j h, begin + cases i; cases j; unfold_aux; + simp only [shape, complex_shape.down_rel, nat.one_ne_zero, not_false_iff, + comp_zero, zero_comp, nat.succ_ne_zero, single₀_obj_X_d], + end }, + left_inv := λ f, begin + ext i, + cases i, + { refl, }, + { ext, }, + end, + right_inv := λ g, rfl, } + variables (V) /-- `single₀` is the same as `single V _ 0`. -/ diff --git a/src/algebra/indicator_function.lean b/src/algebra/indicator_function.lean index 2762a65b1b36b..d412f3c3e71ef 100644 --- a/src/algebra/indicator_function.lean +++ b/src/algebra/indicator_function.lean @@ -8,6 +8,9 @@ import algebra.support /-! # Indicator function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + - `indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `0` otherwise. - `mul_indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `1` otherwise. @@ -96,7 +99,7 @@ mul_indicator_eq_one @[to_additive] lemma mul_indicator_apply_ne_one {a : α} : s.mul_indicator f a ≠ 1 ↔ a ∈ s ∩ mul_support f := -by simp only [ne.def, mul_indicator_apply_eq_one, not_imp, mem_inter_eq, mem_mul_support] +by simp only [ne.def, mul_indicator_apply_eq_one, not_imp, mem_inter_iff, mem_mul_support] @[simp, to_additive] lemma mul_support_mul_indicator : function.mul_support (s.mul_indicator f) = s ∩ function.mul_support f := @@ -183,6 +186,34 @@ end (mul_indicator s f)⁻¹' B = s.ite (f ⁻¹' B) (1 ⁻¹' B) := by letI := classical.dec_pred (∈ s); exact piecewise_preimage s f 1 B +@[to_additive] lemma mul_indicator_one_preimage (s : set M) : + t.mul_indicator 1 ⁻¹' s ∈ ({set.univ, ∅} : set (set α)) := +begin + classical, + rw [mul_indicator_one', preimage_one], + split_ifs; simp +end + +@[to_additive] lemma mul_indicator_const_preimage_eq_union (U : set α) (s : set M) (a : M) + [decidable (a ∈ s)] [decidable ((1 : M) ∈ s)] : + U.mul_indicator (λ x, a) ⁻¹' s = (if a ∈ s then U else ∅) ∪ (if (1 : M) ∈ s then Uᶜ else ∅) := +begin + rw [mul_indicator_preimage, preimage_one, preimage_const], + split_ifs; simp [← compl_eq_univ_diff] +end + +@[to_additive] lemma mul_indicator_const_preimage (U : set α) (s : set M) (a : M) : + U.mul_indicator (λ x, a) ⁻¹' s ∈ ({set.univ, U, Uᶜ, ∅} : set (set α)) := +begin + classical, + rw [mul_indicator_const_preimage_eq_union], + split_ifs; simp +end + +lemma indicator_one_preimage [has_zero M] (U : set α) (s : set M) : + U.indicator 1 ⁻¹' s ∈ ({set.univ, U, Uᶜ, ∅} : set (set α)) := +indicator_const_preimage _ _ 1 + @[to_additive] lemma mul_indicator_preimage_of_not_mem (s : set α) (f : α → M) {t : set M} (ht : (1:M) ∉ t) : (mul_indicator s f)⁻¹' t = f ⁻¹' t ∩ s := @@ -218,7 +249,7 @@ by rw [← mul_indicator_union_mul_inter_apply f s t, mul_indicator_of_not_mem h @[to_additive] lemma mul_indicator_union_of_disjoint (h : disjoint s t) (f : α → M) : mul_indicator (s ∪ t) f = λa, mul_indicator s f a * mul_indicator t f a := -funext $ λa, mul_indicator_union_of_not_mem_inter (λ ha, h ha) _ +funext $ λa, mul_indicator_union_of_not_mem_inter (λ ha, h.le_bot ha) _ @[to_additive] lemma mul_indicator_mul (s : set α) (f g : α → M) : mul_indicator s (λa, f a * g a) = λa, mul_indicator s f a * mul_indicator s g a := @@ -336,8 +367,8 @@ by rw [sub_eq_add_neg, indicator_compl'] @[to_additive indicator_diff'] lemma mul_indicator_diff (h : s ⊆ t) (f : α → G) : mul_indicator (t \ s) f = mul_indicator t f * (mul_indicator s f)⁻¹ := -eq_mul_inv_of_mul_eq $ by rw [pi.mul_def, ← mul_indicator_union_of_disjoint disjoint_diff.symm f, - diff_union_self, union_eq_self_of_subset_right h] +eq_mul_inv_of_mul_eq $ by { rw [pi.mul_def, ←mul_indicator_union_of_disjoint, diff_union_self, + union_eq_self_of_subset_right h], exact disjoint_sdiff_self_left } lemma indicator_diff {G : Type*} [add_group G] {s t : set α} (h : s ⊆ t) (f : α → G) : indicator (t \ s) f = indicator t f - indicator s f := @@ -413,12 +444,17 @@ begin rw [finset.prod_insert haI, finset.set_bUnion_insert, mul_indicator_union_of_not_mem_inter, ih _], { assume i hi j hj hij, exact hI i (finset.mem_insert_of_mem hi) j (finset.mem_insert_of_mem hj) hij }, - simp only [not_exists, exists_prop, mem_Union, mem_inter_eq, not_and], + simp only [not_exists, exists_prop, mem_Union, mem_inter_iff, not_and], assume hx a' ha', refine disjoint_left.1 (hI a (finset.mem_insert_self _ _) a' (finset.mem_insert_of_mem ha') _) hx, exact (ne_of_mem_of_not_mem ha' haI).symm end +@[to_additive] lemma mul_indicator_finset_bUnion_apply {ι} (I : finset ι) + (s : ι → set α) {f : α → M} (h : ∀ (i ∈ I) (j ∈ I), i ≠ j → disjoint (s i) (s j)) (x : α) : + mul_indicator (⋃ i ∈ I, s i) f x = ∏ i in I, mul_indicator (s i) f x := +by rw set.mul_indicator_finset_bUnion I s h + end comm_monoid section mul_zero_class @@ -452,12 +488,21 @@ lemma inter_indicator_one {s t : set α} : funext (λ _, by simpa only [← inter_indicator_mul, pi.mul_apply, pi.one_apply, one_mul]) lemma indicator_prod_one {s : set α} {t : set β} {x : α} {y : β} : - (s ×ˢ t : set _).indicator (1 : _ → M) (x, y) = s.indicator 1 x * t.indicator 1 y := -begin - letI := classical.dec_pred (∈ s), - letI := classical.dec_pred (∈ t), - simp [indicator_apply, ← ite_and], -end + (s ×ˢ t).indicator (1 : _ → M) (x, y) = s.indicator 1 x * t.indicator 1 y := +by { classical, simp [indicator_apply, ←ite_and] } + +variables (M) [nontrivial M] + +lemma indicator_eq_zero_iff_not_mem {U : set α} {x : α} : + indicator U 1 x = (0 : M) ↔ x ∉ U := +by { classical, simp [indicator_apply, imp_false] } + +lemma indicator_eq_one_iff_mem {U : set α} {x : α} : + indicator U 1 x = (1 : M) ↔ x ∈ U := +by { classical, simp [indicator_apply, imp_false] } + +lemma indicator_one_inj {U V : set α} (h : indicator U (1 : α → M) = indicator V 1) : U = V := +by { ext, simp_rw [← indicator_eq_one_iff_mem M, h] } end mul_zero_one_class diff --git a/src/algebra/invertible.lean b/src/algebra/invertible.lean index f1ab5c27eaf50..9e64de20e92cb 100644 --- a/src/algebra/invertible.lean +++ b/src/algebra/invertible.lean @@ -5,11 +5,15 @@ Authors: Anne Baanen -/ import algebra.group.units -import algebra.ring.basic +import algebra.group_with_zero.units.lemmas +import algebra.ring.defs /-! # Invertible elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a typeclass `invertible a` for elements `a` with a two-sided multiplicative inverse. @@ -105,11 +109,19 @@ by { apply inv_of_eq_right_inv, rw [h, mul_inv_of_self], } instance [monoid α] (a : α) : subsingleton (invertible a) := ⟨ λ ⟨b, hba, hab⟩ ⟨c, hca, hac⟩, by { congr, exact left_inv_eq_right_inv hba hac } ⟩ +/-- If `r` is invertible and `s = r` and `si = ⅟r`, then `s` is invertible with `⅟s = si`. -/ +def invertible.copy' [mul_one_class α] {r : α} (hr : invertible r) (s : α) (si : α) + (hs : s = r) (hsi : si = ⅟r) : + invertible s := +{ inv_of := si, + inv_of_mul_self := by rw [hs, hsi, inv_of_mul_self], + mul_inv_of_self := by rw [hs, hsi, mul_inv_of_self] } + /-- If `r` is invertible and `s = r`, then `s` is invertible. -/ -def invertible.copy [monoid α] {r : α} (hr : invertible r) (s : α) (hs : s = r) : invertible s := -{ inv_of := ⅟r, - inv_of_mul_self := by rw [hs, inv_of_mul_self], - mul_inv_of_self := by rw [hs, mul_inv_of_self] } +@[reducible] +def invertible.copy [mul_one_class α] {r : α} (hr : invertible r) (s : α) (hs : s = r) : + invertible s := +hr.copy' _ _ hs rfl /-- An `invertible` element is a unit. -/ @[simps] @@ -138,8 +150,7 @@ Prefer `casesI h.nonempty_invertible` over `letI := h.invertible` if you want to noncomputable def is_unit.invertible [monoid α] {a : α} (h : is_unit a) : invertible a := classical.choice h.nonempty_invertible -@[simp] -lemma nonempty_invertible_iff_is_unit [monoid α] (a : α) : +@[simp] lemma nonempty_invertible_iff_is_unit [monoid α] (a : α) : nonempty (invertible a) ↔ is_unit a := ⟨nonempty.rec $ @is_unit_of_invertible _ _ _, is_unit.nonempty_invertible⟩ @@ -171,14 +182,13 @@ inv_of_eq_right_inv (by simp) @[simp] lemma inv_of_two_add_inv_of_two [non_assoc_semiring α] [invertible (2 : α)] : (⅟2 : α) + (⅟2 : α) = 1 := -by simp only [←two_mul, mul_inv_of_self] +by rw [←two_mul, mul_inv_of_self] /-- `a` is the inverse of `⅟a`. -/ instance invertible_inv_of [has_one α] [has_mul α] {a : α} [invertible a] : invertible (⅟a) := ⟨ a, mul_inv_of_self a, inv_of_mul_self a ⟩ -@[simp] lemma inv_of_inv_of [monoid α] (a : α) [invertible a] [invertible (⅟a)] : - ⅟(⅟a) = a := +@[simp] lemma inv_of_inv_of [monoid α] (a : α) [invertible a] [invertible (⅟a)] : ⅟(⅟a) = a := inv_of_eq_right_inv (inv_of_mul_self _) @[simp] lemma inv_of_inj [monoid α] {a b : α} [invertible a] [invertible b] : @@ -189,11 +199,15 @@ inv_of_eq_right_inv (inv_of_mul_self _) def invertible_mul [monoid α] (a b : α) [invertible a] [invertible b] : invertible (a * b) := ⟨ ⅟b * ⅟a, by simp [←mul_assoc], by simp [←mul_assoc] ⟩ -@[simp] -lemma inv_of_mul [monoid α] (a b : α) [invertible a] [invertible b] [invertible (a * b)] : +@[simp] lemma inv_of_mul [monoid α] (a b : α) [invertible a] [invertible b] [invertible (a * b)] : ⅟(a * b) = ⅟b * ⅟a := inv_of_eq_right_inv (by simp [←mul_assoc]) +/-- A copy of `invertible_mul` for dot notation. -/ +@[reducible] def invertible.mul [monoid α] {a b : α} (ha : invertible a) (hb : invertible b) : + invertible (a * b) := +invertible_mul _ _ + theorem commute.inv_of_right [monoid α] {a b : α} [invertible b] (h : commute a b) : commute a (⅟b) := calc a * (⅟b) = (⅟b) * (b * a * (⅟b)) : by simp [mul_assoc] @@ -215,6 +229,46 @@ lemma nonzero_of_invertible [mul_zero_one_class α] (a : α) [nontrivial α] [in λ ha, zero_ne_one $ calc 0 = ⅟a * a : by simp [ha] ... = 1 : inv_of_mul_self a +@[priority 100] instance invertible.ne_zero [mul_zero_one_class α] [nontrivial α] (a : α) + [invertible a] : ne_zero a := ⟨nonzero_of_invertible a⟩ + +section monoid +variables [monoid α] + +/-- This is the `invertible` version of `units.is_unit_units_mul` -/ +@[reducible] def invertible_of_invertible_mul (a b : α) [invertible a] [invertible (a * b)] : + invertible b := +{ inv_of := ⅟(a * b) * a, + inv_of_mul_self := by rw [mul_assoc, inv_of_mul_self], + mul_inv_of_self := by rw [←(is_unit_of_invertible a).mul_right_inj, ←mul_assoc, ←mul_assoc, + mul_inv_of_self, mul_one, one_mul] } + +/-- This is the `invertible` version of `units.is_unit_mul_units` -/ +@[reducible] def invertible_of_mul_invertible (a b : α) [invertible (a * b)] [invertible b] : + invertible a := +{ inv_of := b * ⅟(a * b), + inv_of_mul_self := by rw [←(is_unit_of_invertible b).mul_left_inj, mul_assoc, mul_assoc, + inv_of_mul_self, mul_one, one_mul], + mul_inv_of_self := by rw [←mul_assoc, mul_inv_of_self] } + +/-- `invertible_of_invertible_mul` and `invertible_mul` as an equivalence. -/ +@[simps] def invertible.mul_left {a : α} (ha : invertible a) (b : α) : + invertible b ≃ invertible (a * b) := +{ to_fun := λ hb, by exactI invertible_mul a b, + inv_fun := λ hab, by exactI invertible_of_invertible_mul a _, + left_inv := λ hb, subsingleton.elim _ _, + right_inv := λ hab, subsingleton.elim _ _, } + +/-- `invertible_of_mul_invertible` and `invertible_mul` as an equivalence. -/ +@[simps] def invertible.mul_right (a : α) {b : α} (ha : invertible b) : + invertible a ≃ invertible (a * b) := +{ to_fun := λ hb, by exactI invertible_mul a b, + inv_fun := λ hab, by exactI invertible_of_mul_invertible _ b, + left_inv := λ hb, subsingleton.elim _ _, + right_inv := λ hab, subsingleton.elim _ _, } + +end monoid + section monoid_with_zero variable [monoid_with_zero α] @@ -271,3 +325,32 @@ def invertible.map {R : Type*} {S : Type*} {F : Type*} [mul_one_class R] [mul_on { inv_of := f (⅟r), inv_of_mul_self := by rw [←map_mul, inv_of_mul_self, map_one], mul_inv_of_self := by rw [←map_mul, mul_inv_of_self, map_one] } + +/-- Note that the `invertible (f r)` argument can be satisfied by using `letI := invertible.map f r` +before applying this lemma. -/ +lemma map_inv_of {R : Type*} {S : Type*} {F : Type*} [mul_one_class R] [monoid S] + [monoid_hom_class F R S] (f : F) (r : R) [invertible r] [invertible (f r)] : + f (⅟r) = ⅟(f r) := +by { letI := invertible.map f r, convert rfl } + +/-- If a function `f : R → S` has a left-inverse that is a monoid hom, + then `r : R` is invertible if `f r` is. + +The inverse is computed as `g (⅟(f r))` -/ +@[simps {attrs := []}] +def invertible.of_left_inverse {R : Type*} {S : Type*} {G : Type*} + [mul_one_class R] [mul_one_class S] [monoid_hom_class G S R] + (f : R → S) (g : G) (r : R) (h : function.left_inverse g f) [invertible (f r)] : + invertible r := +(invertible.map g (f r)).copy _ (h r).symm + +/-- Invertibility on either side of a monoid hom with a left-inverse is equivalent. -/ +@[simps] +def invertible_equiv_of_left_inverse {R : Type*} {S : Type*} {F G : Type*} + [monoid R] [monoid S] [monoid_hom_class F R S] [monoid_hom_class G S R] + (f : F) (g : G) (r : R) (h : function.left_inverse g f) : + invertible (f r) ≃ invertible r := +{ to_fun := λ _, by exactI invertible.of_left_inverse f _ _ h, + inv_fun := λ _, by exactI invertible.map f _, + left_inv := λ x, subsingleton.elim _ _, + right_inv := λ x, subsingleton.elim _ _ } diff --git a/src/algebra/is_prime_pow.lean b/src/algebra/is_prime_pow.lean index 73a651a3d1a76..790f67bedab9b 100644 --- a/src/algebra/is_prime_pow.lean +++ b/src/algebra/is_prime_pow.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ import algebra.associated -import data.nat.factorization import number_theory.divisors /-! # Prime powers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file deals with prime powers: numbers which are positive integer powers of a single prime. -/ @@ -40,12 +42,13 @@ begin simp, end -lemma not_is_prime_pow_one : ¬ is_prime_pow (1 : R) := -begin - simp only [is_prime_pow_def, not_exists, not_and', and_imp], - intros x n hn hx ht, - exact ht.not_unit (is_unit_of_pow_eq_one x n hx hn), -end +lemma is_prime_pow.not_unit {n : R} (h : is_prime_pow n) : ¬is_unit n := +let ⟨p, k, hp, hk, hn⟩ := h in hn ▸ (is_unit_pow_iff hk.ne').not.mpr hp.not_unit + +lemma is_unit.not_is_prime_pow {n : R} (h : is_unit n) : ¬is_prime_pow n := +λ h', h'.not_unit h + +lemma not_is_prime_pow_one : ¬ is_prime_pow (1 : R) := is_unit_one.not_is_prime_pow lemma prime.is_prime_pow {p : R} (hp : prime p) : is_prime_pow p := ⟨p, 1, hp, zero_lt_one, by simp⟩ @@ -60,28 +63,13 @@ theorem is_prime_pow.ne_zero [no_zero_divisors R] {n : R} (h : is_prime_pow n) : lemma is_prime_pow.ne_one {n : R} (h : is_prime_pow n) : n ≠ 1 := λ t, eq.rec not_is_prime_pow_one t.symm h -section unique_units - -lemma eq_of_prime_pow_eq {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R} - {k₁ k₂ : ℕ} (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₁) (h : p₁ ^ k₁ = p₂ ^ k₂) : - p₁ = p₂ := -by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime hp₁ hp₂ hk₁ } - -lemma eq_of_prime_pow_eq' {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R} - {k₁ k₂ : ℕ} (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₂) (h : p₁ ^ k₁ = p₂ ^ k₂) : - p₁ = p₂ := -by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime' hp₁ hp₂ hk₁ } - -end unique_units - section nat lemma is_prime_pow_nat_iff (n : ℕ) : is_prime_pow n ↔ ∃ (p k : ℕ), nat.prime p ∧ 0 < k ∧ p ^ k = n := by simp only [is_prime_pow_def, nat.prime_iff] -lemma nat.prime.is_prime_pow {p : ℕ} (hp : p.prime) : is_prime_pow p := -(nat.prime_iff.mp hp).is_prime_pow +lemma nat.prime.is_prime_pow {p : ℕ} (hp : p.prime) : is_prime_pow p := hp.prime.is_prime_pow lemma is_prime_pow_nat_iff_bounded (n : ℕ) : is_prime_pow n ↔ ∃ (p : ℕ), p ≤ n ∧ ∃ (k : ℕ), k ≤ n ∧ p.prime ∧ 0 < k ∧ p ^ k = n := @@ -96,30 +84,6 @@ end instance {n : ℕ} : decidable (is_prime_pow n) := decidable_of_iff' _ (is_prime_pow_nat_iff_bounded n) -lemma is_prime_pow.min_fac_pow_factorization_eq {n : ℕ} (hn : is_prime_pow n) : - n.min_fac ^ n.factorization n.min_fac = n := -begin - obtain ⟨p, k, hp, hk, rfl⟩ := hn, - rw ←nat.prime_iff at hp, - rw [hp.pow_min_fac hk.ne', hp.factorization_pow, finsupp.single_eq_same], -end - -lemma is_prime_pow_of_min_fac_pow_factorization_eq {n : ℕ} - (h : n.min_fac ^ n.factorization n.min_fac = n) (hn : n ≠ 1) : - is_prime_pow n := -begin - rcases eq_or_ne n 0 with rfl | hn', - { simpa using h }, - refine ⟨_, _, nat.prime_iff.1 (nat.min_fac_prime hn), _, h⟩, - rw [pos_iff_ne_zero, ←finsupp.mem_support_iff, nat.factor_iff_mem_factorization, - nat.mem_factors_iff_dvd hn' (nat.min_fac_prime hn)], - apply nat.min_fac_dvd -end - -lemma is_prime_pow_iff_min_fac_pow_factorization_eq {n : ℕ} (hn : n ≠ 1) : - is_prime_pow n ↔ n.min_fac ^ n.factorization n.min_fac = n := -⟨λ h, h.min_fac_pow_factorization_eq, λ h, is_prime_pow_of_min_fac_pow_factorization_eq h hn⟩ - lemma is_prime_pow.dvd {n m : ℕ} (hn : is_prime_pow n) (hm : m ∣ n) (hm₁ : m ≠ 1) : is_prime_pow m := begin @@ -132,90 +96,6 @@ begin simpa using hm₁, end -lemma is_prime_pow_iff_factorization_eq_single {n : ℕ} : - is_prime_pow n ↔ ∃ p k : ℕ, 0 < k ∧ n.factorization = finsupp.single p k := -begin - rw is_prime_pow_nat_iff, - refine exists₂_congr (λ p k, _), - split, - { rintros ⟨hp, hk, hn⟩, - exact ⟨hk, by rw [←hn, nat.prime.factorization_pow hp]⟩ }, - { rintros ⟨hk, hn⟩, - have hn0 : n ≠ 0, - { rintro rfl, - simpa only [finsupp.single_eq_zero, eq_comm, nat.factorization_zero, hk.ne'] using hn }, - rw nat.eq_pow_of_factorization_eq_single hn0 hn, - exact ⟨nat.prime_of_mem_factorization - (by simp [hn, hk.ne'] : p ∈ n.factorization.support), hk, rfl⟩ } -end - -lemma is_prime_pow_iff_card_support_factorization_eq_one {n : ℕ} : - is_prime_pow n ↔ n.factorization.support.card = 1 := -by simp_rw [is_prime_pow_iff_factorization_eq_single, finsupp.card_support_eq_one', exists_prop, - pos_iff_ne_zero] - -/-- An equivalent definition for prime powers: `n` is a prime power iff there is a unique prime -dividing it. -/ -lemma is_prime_pow_iff_unique_prime_dvd {n : ℕ} : - is_prime_pow n ↔ ∃! p : ℕ, p.prime ∧ p ∣ n := -begin - rw is_prime_pow_nat_iff, - split, - { rintro ⟨p, k, hp, hk, rfl⟩, - refine ⟨p, ⟨hp, dvd_pow_self _ hk.ne'⟩, _⟩, - rintro q ⟨hq, hq'⟩, - exact (nat.prime_dvd_prime_iff_eq hq hp).1 (hq.dvd_of_dvd_pow hq') }, - rintro ⟨p, ⟨hp, hn⟩, hq⟩, - -- Take care of the n = 0 case - rcases eq_or_ne n 0 with rfl | hn₀, - { obtain ⟨q, hq', hq''⟩ := nat.exists_infinite_primes (p + 1), - cases hq q ⟨hq'', by simp⟩, - simpa using hq' }, - -- So assume 0 < n - refine ⟨p, n.factorization p, hp, hp.factorization_pos_of_dvd hn₀ hn, _⟩, - simp only [and_imp] at hq, - apply nat.dvd_antisymm (nat.pow_factorization_dvd _ _), - -- We need to show n ∣ p ^ n.factorization p - apply nat.dvd_of_factors_subperm hn₀, - rw [hp.factors_pow, list.subperm_ext_iff], - intros q hq', - rw nat.mem_factors hn₀ at hq', - cases hq _ hq'.1 hq'.2, - simp, -end - -lemma is_prime_pow_pow_iff {n k : ℕ} (hk : k ≠ 0) : - is_prime_pow (n ^ k) ↔ is_prime_pow n := -begin - simp only [is_prime_pow_iff_unique_prime_dvd], - apply exists_unique_congr, - simp only [and.congr_right_iff], - intros p hp, - exact ⟨hp.dvd_of_dvd_pow, λ t, t.trans (dvd_pow_self _ hk)⟩, -end - -lemma nat.coprime.is_prime_pow_dvd_mul {n a b : ℕ} (hab : nat.coprime a b) (hn : is_prime_pow n) : - n ∣ a * b ↔ n ∣ a ∨ n ∣ b := -begin - rcases eq_or_ne a 0 with rfl | ha, - { simp only [nat.coprime_zero_left] at hab, - simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, - rcases eq_or_ne b 0 with rfl | hb, - { simp only [nat.coprime_zero_right] at hab, - simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, - refine ⟨_, λ h, or.elim h (λ i, i.trans (dvd_mul_right _ _)) (λ i, i.trans (dvd_mul_left _ _))⟩, - obtain ⟨p, k, hp, hk, rfl⟩ := (is_prime_pow_nat_iff _).1 hn, - simp only [hp.pow_dvd_iff_le_factorization (mul_ne_zero ha hb), - nat.factorization_mul ha hb, hp.pow_dvd_iff_le_factorization ha, - hp.pow_dvd_iff_le_factorization hb, pi.add_apply, finsupp.coe_add], - have : a.factorization p = 0 ∨ b.factorization p = 0, - { rw [←finsupp.not_mem_support_iff, ←finsupp.not_mem_support_iff, ←not_and_distrib, - ←finset.mem_inter], - exact λ t, nat.factorization_disjoint_of_coprime hab t }, - cases this; - simp [this, imp_or_distrib], -end - lemma nat.disjoint_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) : disjoint (a.divisors.filter is_prime_pow) (b.divisors.filter is_prime_pow) := begin @@ -224,21 +104,6 @@ begin exact hn.ne_one (nat.eq_one_of_dvd_coprimes hab han hbn), end -lemma nat.mul_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) : - (a * b).divisors.filter is_prime_pow = (a.divisors ∪ b.divisors).filter is_prime_pow := -begin - rcases eq_or_ne a 0 with rfl | ha, - { simp only [nat.coprime_zero_left] at hab, - simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, - rcases eq_or_ne b 0 with rfl | hb, - { simp only [nat.coprime_zero_right] at hab, - simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, - ext n, - simp only [ha, hb, finset.mem_union, finset.mem_filter, nat.mul_eq_zero, and_true, ne.def, - and.congr_left_iff, not_false_iff, nat.mem_divisors, or_self], - apply hab.is_prime_pow_dvd_mul, -end - lemma is_prime_pow.two_le : ∀ {n : ℕ}, is_prime_pow n → 2 ≤ n | 0 h := (not_is_prime_pow_zero h).elim | 1 h := (not_is_prime_pow_one h).elim diff --git a/src/algebra/jordan/basic.lean b/src/algebra/jordan/basic.lean new file mode 100644 index 0000000000000..2c239fa99c6de --- /dev/null +++ b/src/algebra/jordan/basic.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2021 Christopher Hoskin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Hoskin +-/ +import algebra.lie.of_associative + +/-! +# Jordan rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `A` be a non-unital, non-associative ring. Then `A` is said to be a (commutative, linear) Jordan +ring if the multiplication is commutative and satisfies a weak associativity law known as the +Jordan Identity: for all `a` and `b` in `A`, +``` +(a * b) * a^2 = a * (b * a^2) +``` +i.e. the operators of multiplication by `a` and `a^2` commute. + +A more general concept of a (non-commutative) Jordan ring can also be defined, as a +(non-commutative, non-associative) ring `A` where, for each `a` in `A`, the operators of left and +right multiplication by `a` and `a^2` commute. + +Every associative algebra can be equipped with a symmetrized multiplication (characterized by +`sym_alg.sym_mul_sym`) making it into a commutative Jordan algebra (`sym_alg.is_comm_jordan`). +Jordan algebras arising this way are said to be special. + +A real Jordan algebra `A` can be introduced by +```lean +variables {A : Type*} [non_unital_non_assoc_ring A] [module ℝ A] [smul_comm_class ℝ A A] + [is_scalar_tower ℝ A A] [is_comm_jordan A] +``` + +## Main results + +- `two_nsmul_lie_lmul_lmul_add_add_eq_zero` : Linearisation of the commutative Jordan axiom + +## Implementation notes + +We shall primarily be interested in linear Jordan algebras (i.e. over rings of characteristic not +two) leaving quadratic algebras to those better versed in that theory. + +The conventional way to linearise the Jordan axiom is to equate coefficients (more formally, assume +that the axiom holds in all field extensions). For simplicity we use brute force algebraic expansion +and substitution instead. + +## Motivation + +Every Jordan algebra `A` has a triple product defined, for `a` `b` and `c` in `A` by +$$ +{a\,b\,c} = (a * b) * c - (a * c) * b + a * (b * c). +$$ +Via this triple product Jordan algebras are related to a number of other mathematical structures: +Jordan triples, partial Jordan triples, Jordan pairs and quadratic Jordan algebras. In addition to +their considerable algebraic interest ([mccrimmon2004]) these structures have been shown to have +deep connections to mathematical physics, functional analysis and differential geometry. For more +information about these connections the interested reader is referred to [alfsenshultz2003], +[chu2012], [friedmanscarr2005], [iordanescu2003] and [upmeier1987]. + +There are also exceptional Jordan algebras which can be shown not to be the symmetrization of any +associative algebra. The 3x3 matrices of octonions is the canonical example. + +Non-commutative Jordan algebras have connections to the Vidav-Palmer theorem +[cabreragarciarodriguezpalacios2014]. + +## References + +* [Cabrera García and Rodríguez Palacios, Non-associative normed algebras. Volume 1] + [cabreragarciarodriguezpalacios2014] +* [Hanche-Olsen and Størmer, Jordan Operator Algebras][hancheolsenstormer1984] +* [McCrimmon, A taste of Jordan algebras][mccrimmon2004] + +-/ + +variables (A : Type*) + +/-- A (non-commutative) Jordan multiplication. -/ +class is_jordan [has_mul A] := +(lmul_comm_rmul : ∀ a b : A, (a * b) * a = a * (b * a)) +(lmul_lmul_comm_lmul : ∀ a b : A, (a * a) * (a * b) = a * ((a * a) * b)) +(lmul_lmul_comm_rmul : ∀ a b : A, (a * a) * (b * a) = ((a * a) * b) * a) +(lmul_comm_rmul_rmul : ∀ a b : A, (a * b) * (a * a) = a * (b * (a * a))) +(rmul_comm_rmul_rmul : ∀ a b : A, (b * a) * (a * a) = (b * (a * a)) * a) + +/-- A commutative Jordan multipication -/ +class is_comm_jordan [has_mul A] := +(mul_comm : ∀ a b : A, a * b = b * a) +(lmul_comm_rmul_rmul : ∀ a b : A, (a * b) * (a * a) = a * (b * (a * a))) + +/-- A (commutative) Jordan multiplication is also a Jordan multipication -/ +@[priority 100] -- see Note [lower instance priority] +instance is_comm_jordan.to_is_jordan [has_mul A] [is_comm_jordan A] : is_jordan A := +{ lmul_comm_rmul := λ a b, by rw [is_comm_jordan.mul_comm, is_comm_jordan.mul_comm a b], + lmul_lmul_comm_lmul := λ a b, by rw [is_comm_jordan.mul_comm (a * a) (a * b), + is_comm_jordan.lmul_comm_rmul_rmul, is_comm_jordan.mul_comm b (a * a)], + lmul_comm_rmul_rmul := is_comm_jordan.lmul_comm_rmul_rmul, + lmul_lmul_comm_rmul := λ a b, by rw [is_comm_jordan.mul_comm (a * a) (b * a), + is_comm_jordan.mul_comm b a, is_comm_jordan.lmul_comm_rmul_rmul, is_comm_jordan.mul_comm, + is_comm_jordan.mul_comm b (a * a)], + rmul_comm_rmul_rmul := λ a b, by rw [is_comm_jordan.mul_comm b a, + is_comm_jordan.lmul_comm_rmul_rmul, is_comm_jordan.mul_comm], } + +/-- Semigroup multiplication satisfies the (non-commutative) Jordan axioms-/ +@[priority 100] -- see Note [lower instance priority] +instance semigroup.is_jordan [semigroup A] : is_jordan A := +{ lmul_comm_rmul := λ a b, by rw mul_assoc, + lmul_lmul_comm_lmul := λ a b, by rw [mul_assoc, mul_assoc], + lmul_comm_rmul_rmul := λ a b, by rw [mul_assoc], + lmul_lmul_comm_rmul := λ a b, by rw [←mul_assoc], + rmul_comm_rmul_rmul := λ a b, by rw [← mul_assoc, ← mul_assoc], } + +@[priority 100] -- see Note [lower instance priority] +instance comm_semigroup.is_comm_jordan [comm_semigroup A] : is_comm_jordan A := +{ mul_comm := mul_comm, + lmul_comm_rmul_rmul := λ a b, mul_assoc _ _ _, } + +local notation `L` := add_monoid.End.mul_left +local notation `R` := add_monoid.End.mul_right + +/-! +The Jordan axioms can be expressed in terms of commuting multiplication operators. +-/ +section commute +variables {A} [non_unital_non_assoc_ring A] [is_jordan A] + +@[simp] lemma commute_lmul_rmul (a : A) : commute (L a) (R a) := +add_monoid_hom.ext $ λ b, (is_jordan.lmul_comm_rmul _ _).symm + +@[simp] lemma commute_lmul_lmul_sq (a : A) : commute (L a) (L (a * a)) := +add_monoid_hom.ext $ λ b, (is_jordan.lmul_lmul_comm_lmul _ _).symm + +@[simp] lemma commute_lmul_rmul_sq (a : A) : commute (L a) (R (a * a)) := +add_monoid_hom.ext $ λ b, (is_jordan.lmul_comm_rmul_rmul _ _).symm + +@[simp] lemma commute_lmul_sq_rmul (a : A) : commute (L (a * a)) (R a) := +add_monoid_hom.ext $ λ b, (is_jordan.lmul_lmul_comm_rmul _ _) + +@[simp] lemma commute_rmul_rmul_sq (a : A) : commute (R a) (R (a * a)) := +add_monoid_hom.ext $ λ b, (is_jordan.rmul_comm_rmul_rmul _ _).symm + +end commute + +variables {A} [non_unital_non_assoc_ring A] [is_comm_jordan A] + +/-! +The endomorphisms on an additive monoid `add_monoid.End` form a `ring`, and this may be equipped +with a Lie Bracket via `ring.has_bracket`. +-/ + +lemma two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add (a b : A) : + 2•(⁅L a, L (a * b)⁆ + ⁅L b, L (b * a)⁆) = ⁅L (a * a), L b⁆ + ⁅L (b * b), L a⁆ := +begin + suffices : 2 • ⁅L a, L (a * b)⁆ + 2 • ⁅L b, L (b * a)⁆ + ⁅L b, L (a * a)⁆ + ⁅L a, L (b * b)⁆ = 0, + { rwa [← sub_eq_zero, ← sub_sub, sub_eq_add_neg, sub_eq_add_neg, lie_skew, lie_skew, nsmul_add] }, + convert (commute_lmul_lmul_sq (a + b)).lie_eq, + simp only [add_mul, mul_add, map_add, lie_add, add_lie, is_comm_jordan.mul_comm b a, + (commute_lmul_lmul_sq a).lie_eq, (commute_lmul_lmul_sq b).lie_eq], + abel, +end + +lemma two_nsmul_lie_lmul_lmul_add_add_eq_zero (a b c : A) : + 2•(⁅L a, L (b * c)⁆ + ⁅L b, L (c * a)⁆ + ⁅L c, L (a * b)⁆) = 0 := +begin + symmetry, + calc 0 = ⁅L (a + b + c), L ((a + b + c) * (a + b + c))⁆ : + by rw (commute_lmul_lmul_sq (a + b + c)).lie_eq + ... = ⁅L a + L b + L c, + L (a * a) + L (a * b) + L (a * c) + (L (b * a) + L (b * b) + L (b * c)) + + (L (c * a) + L (c * b) + L (c * c))⁆ : + by rw [add_mul, add_mul, mul_add, mul_add, mul_add, mul_add, mul_add, mul_add, + map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add, map_add] + ... = ⁅L a + L b + L c, + L (a * a) + L (a * b) + L (c * a) + (L (a * b) + L (b * b) + L (b * c)) + + (L (c * a) + L (b * c) + L (c * c))⁆ : + by rw [is_comm_jordan.mul_comm b a, is_comm_jordan.mul_comm c a, is_comm_jordan.mul_comm c b] + ... = ⁅L a + L b + L c, L (a * a) + L (b * b) + L (c * c) + 2•L (a * b) + 2•L (c * a) + + 2•L (b * c) ⁆ : + by {rw [two_smul, two_smul, two_smul], + simp only [lie_add, add_lie, commute_lmul_lmul_sq, zero_add, add_zero], abel} + ... = ⁅L a, L (a * a)⁆ + ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + ⁅L a, 2•L (a * b)⁆ + + ⁅L a, 2•L(c * a)⁆ + ⁅L a, 2•L (b * c)⁆ + + (⁅L b, L (a * a)⁆ + ⁅L b, L (b * b)⁆ + ⁅L b, L (c * c)⁆ + ⁅L b, 2•L (a * b)⁆ + + ⁅L b, 2•L (c * a)⁆ + ⁅L b, 2•L (b * c)⁆) + + (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + ⁅L c, L (c * c)⁆ + ⁅L c, 2•L (a * b)⁆ + + ⁅L c, 2•L (c * a)⁆ + ⁅L c, 2•L (b * c)⁆) : + by rw [add_lie, add_lie, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, + lie_add, lie_add, lie_add, lie_add, lie_add, lie_add, lie_add] + ... = ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + ⁅L a, 2•L (a * b)⁆ + ⁅L a, 2•L (c * a)⁆ + + ⁅L a, 2•L (b * c)⁆ + + (⁅L b, L (a * a)⁆ + ⁅L b, L (c * c)⁆ + ⁅L b, 2•L (a * b)⁆ + ⁅L b, 2•L (c * a)⁆ + + ⁅L b, 2•L (b * c)⁆) + + (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + ⁅L c, 2•L (a * b)⁆ + ⁅L c, 2•L (c * a)⁆ + + ⁅L c, 2•L (b * c)⁆) : + by rw [(commute_lmul_lmul_sq a).lie_eq, (commute_lmul_lmul_sq b).lie_eq, + (commute_lmul_lmul_sq c).lie_eq, zero_add, add_zero, add_zero] + ... = ⁅L a, L (b * b)⁆ + ⁅L a, L (c * c)⁆ + 2•⁅L a, L (a * b)⁆ + 2•⁅L a, L (c * a)⁆ + + 2•⁅L a, L (b * c)⁆ + + (⁅L b, L (a * a)⁆ + ⁅L b, L (c * c)⁆ + 2•⁅L b, L (a * b)⁆ + 2•⁅L b, L (c * a)⁆ + + 2•⁅L b, L (b * c)⁆) + + (⁅L c, L (a * a)⁆ + ⁅L c, L (b * b)⁆ + 2•⁅L c, L (a * b)⁆ + 2•⁅L c, L (c * a)⁆ + + 2•⁅L c, L (b * c)⁆) : + by simp only [lie_nsmul] + ... = (⁅L a, L (b * b)⁆+ ⁅L b, L (a * a)⁆ + 2•(⁅L a, L (a * b)⁆ + ⁅L b, L (a * b)⁆)) + + (⁅L a, L (c * c)⁆ + ⁅L c, L (a * a)⁆ + 2•(⁅L a, L (c * a)⁆ + ⁅L c, L (c * a)⁆)) + + (⁅L b, L (c * c)⁆ + ⁅L c, L (b * b)⁆ + 2•(⁅L b, L (b * c)⁆ + ⁅L c, L (b * c)⁆)) + + (2•⁅L a, L (b * c)⁆ + 2•⁅L b, L (c * a)⁆ + 2•⁅L c, L (a * b)⁆) : by abel + ... = 2•⁅L a, L (b * c)⁆ + 2•⁅L b, L (c * a)⁆ + 2•⁅L c, L (a * b)⁆ : + by begin + rw add_left_eq_self, + nth_rewrite 1 is_comm_jordan.mul_comm a b, + nth_rewrite 0 is_comm_jordan.mul_comm c a, + nth_rewrite 1 is_comm_jordan.mul_comm b c, + rw [two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add, + two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add, + two_nsmul_lie_lmul_lmul_add_eq_lie_lmul_lmul_add, + ← lie_skew (L (a * a)), ← lie_skew (L (b * b)), ← lie_skew (L (c * c)), + ← lie_skew (L (a * a)), ← lie_skew (L (b * b)), ← lie_skew (L (c * c))], + abel, + end + ... = 2•(⁅L a, L (b * c)⁆ + ⁅L b, L (c * a)⁆ + ⁅L c, L (a * b)⁆) : by rw [nsmul_add, nsmul_add] +end diff --git a/src/algebra/lie/abelian.lean b/src/algebra/lie/abelian.lean index 12aa6a6f3afb6..3464b04c602e3 100644 --- a/src/algebra/lie/abelian.lean +++ b/src/algebra/lie/abelian.lean @@ -9,6 +9,9 @@ import algebra.lie.ideal_operations /-! # Trivial Lie modules and Abelian Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The action of a Lie algebra `L` on a module `M` is trivial if `⁅x, m⁆ = 0` for all `x ∈ L` and `m ∈ M`. In the special case that `M = L` with the adjoint action, triviality corresponds to the concept of an Abelian Lie algebra. @@ -274,9 +277,9 @@ lemma lie_submodule.lie_abelian_iff_lie_self_eq_bot : is_lie_abelian I ↔ ⁅I, begin simp only [_root_.eq_bot_iff, lie_ideal_oper_eq_span, lie_submodule.lie_span_le, lie_submodule.bot_coe, set.subset_singleton_iff, set.mem_set_of_eq, exists_imp_distrib], - refine ⟨λ h z x y hz, hz.symm.trans ((lie_subalgebra.coe_bracket _ _ _).symm.trans + refine ⟨λ h z x y hz, hz.symm.trans (((I : lie_subalgebra R L).coe_bracket x y).symm.trans ((coe_zero_iff_zero _ _).mpr (by apply h.trivial))), - λ h, ⟨λ x y, (coe_zero_iff_zero _ _).mp (h _ x y rfl)⟩⟩, + λ h, ⟨λ x y, ((I : lie_subalgebra R L).coe_zero_iff_zero _).mp (h _ x y rfl)⟩⟩, end end ideal_operations diff --git a/src/algebra/lie/base_change.lean b/src/algebra/lie/base_change.lean index 2403b345978e8..bf0b6beaa9c74 100644 --- a/src/algebra/lie/base_change.lean +++ b/src/algebra/lie/base_change.lean @@ -9,6 +9,9 @@ import algebra.lie.tensor_product /-! # Extension and restriction of scalars for Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Lie algebras have a well-behaved theory of extension and restriction of scalars. ## Main definitions @@ -40,7 +43,7 @@ support in the tensor product library, it is far easier to bootstrap like this, definition below. -/ private def bracket' : (A ⊗[R] L) →ₗ[R] (A ⊗[R] L) →ₗ[R] A ⊗[R] L := tensor_product.curry $ - (tensor_product.map (algebra.lmul' R) (lie_module.to_module_hom R L L : L ⊗[R] L →ₗ[R] L)) + (tensor_product.map (linear_map.mul' R _) (lie_module.to_module_hom R L L : L ⊗[R] L →ₗ[R] L)) ∘ₗ ↑(tensor_product.tensor_tensor_tensor_comm R A L A L) @[simp] private lemma bracket'_tmul (s t : A) (x y : L) : @@ -115,8 +118,8 @@ begin { simp only [lie_zero, smul_zero], }, { intros a₂ l₂, simp only [bracket_def, bracket', tensor_product.smul_tmul', mul_left_comm a₁ a a₂, - tensor_product.curry_apply, algebra.lmul'_apply, algebra.id.smul_eq_mul, function.comp_app, - linear_equiv.coe_coe, linear_map.coe_comp, tensor_product.map_tmul, + tensor_product.curry_apply, linear_map.mul'_apply, algebra.id.smul_eq_mul, + function.comp_app, linear_equiv.coe_coe, linear_map.coe_comp, tensor_product.map_tmul, tensor_product.tensor_tensor_tensor_comm_tmul], }, { intros z₁ z₂ h₁ h₂, simp only [h₁, h₂, smul_add, lie_add], }, }, diff --git a/src/algebra/lie/basic.lean b/src/algebra/lie/basic.lean index edff21112ee4b..3d3743e0ac425 100644 --- a/src/algebra/lie/basic.lean +++ b/src/algebra/lie/basic.lean @@ -11,6 +11,9 @@ import tactic.noncomm_ring /-! # Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines Lie rings and Lie algebras over a commutative ring together with their modules, morphisms and equivalences, as well as various lemmas to make these definitions usable. @@ -450,10 +453,10 @@ e.to_linear_equiv.surjective /-- A bijective morphism of Lie algebras yields an equivalence of Lie algebras. -/ @[simps] noncomputable def of_bijective (f : L₁ →ₗ⁅R⁆ L₂) - (h₁ : function.injective f) (h₂ : function.surjective f) : L₁ ≃ₗ⁅R⁆ L₂ := + (h : function.bijective f) : L₁ ≃ₗ⁅R⁆ L₂ := { to_fun := f, map_lie' := f.map_lie, - .. (linear_equiv.of_bijective (f : L₁ →ₗ[R] L₂) h₁ h₂), } + .. (linear_equiv.of_bijective (f : L₁ →ₗ[R] L₂) h), } end lie_equiv @@ -599,14 +602,14 @@ lemma sub_apply (f g : M →ₗ⁅R,L⁆ N) (m : M) : (f - g) m = f m - g m := r lemma neg_apply (f : M →ₗ⁅R,L⁆ N) (m : M) : (-f) m = -(f m) := rfl -instance has_nsmul : has_scalar ℕ (M →ₗ⁅R,L⁆ N) := +instance has_nsmul : has_smul ℕ (M →ₗ⁅R,L⁆ N) := { smul := λ n f, { map_lie' := λ x m, by simp, ..(n • (f : M →ₗ[R] N)) } } @[norm_cast, simp] lemma coe_nsmul (n : ℕ) (f : M →ₗ⁅R,L⁆ N) : ⇑(n • f) = n • f := rfl lemma nsmul_apply (n : ℕ) (f : M →ₗ⁅R,L⁆ N) (m : M) : (n • f) m = n • f m := rfl -instance has_zsmul : has_scalar ℤ (M →ₗ⁅R,L⁆ N) := +instance has_zsmul : has_smul ℤ (M →ₗ⁅R,L⁆ N) := { smul := λ z f, { map_lie' := λ x m, by simp, ..(z • (f : M →ₗ[R] N)) } } @[norm_cast, simp] lemma coe_zsmul (z : ℤ) (f : M →ₗ⁅R,L⁆ N) : ⇑(z • f) = z • f := rfl @@ -617,7 +620,7 @@ instance : add_comm_group (M →ₗ⁅R,L⁆ N) := coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, coe_nsmul _ _) (λ _ _, coe_zsmul _ _) -instance : has_scalar R (M →ₗ⁅R,L⁆ N) := +instance : has_smul R (M →ₗ⁅R,L⁆ N) := { smul := λ t f, { map_lie' := by simp, ..(t • (f : M →ₗ[R] N)) }, } @[norm_cast, simp] lemma coe_smul (t : R) (f : M →ₗ⁅R,L⁆ N) : ⇑(t • f) = t • f := rfl diff --git a/src/algebra/lie/cartan_matrix.lean b/src/algebra/lie/cartan_matrix.lean index fad2ebbe0ac54..1e175daa8002c 100644 --- a/src/algebra/lie/cartan_matrix.lean +++ b/src/algebra/lie/cartan_matrix.lean @@ -5,11 +5,14 @@ Authors: Oliver Nash -/ import algebra.lie.free import algebra.lie.quotient -import data.matrix.basic +import data.matrix.notation /-! # Lie algebras from Cartan matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Split semi-simple Lie algebras are uniquely determined by their Cartan matrix. Indeed, if `A` is an `l × l` Cartan matrix, the corresponding Lie algebra may be obtained as the Lie algebra on `3l` generators: $H_1, H_2, \ldots H_l, E_1, E_2, \ldots, E_l, F_1, F_2, \ldots, F_l$ @@ -182,12 +185,12 @@ The corresponding Dynkin diagram is: o --- o --- o --- o --- o ``` -/ -def E₆ : matrix (fin 6) (fin 6) ℤ := ![![ 2, 0, -1, 0, 0, 0], - ![ 0, 2, 0, -1, 0, 0], - ![-1, 0, 2, -1, 0, 0], - ![ 0, -1, -1, 2, -1, 0], - ![ 0, 0, 0, -1, 2, -1], - ![ 0, 0, 0, 0, -1, 2]] +def E₆ : matrix (fin 6) (fin 6) ℤ := !![ 2, 0, -1, 0, 0, 0; + 0, 2, 0, -1, 0, 0; + -1, 0, 2, -1, 0, 0; + 0, -1, -1, 2, -1, 0; + 0, 0, 0, -1, 2, -1; + 0, 0, 0, 0, -1, 2] /-- The Cartan matrix of type e₇. See [bourbaki1968] plate VI, page 281. @@ -198,13 +201,13 @@ The corresponding Dynkin diagram is: o --- o --- o --- o --- o --- o ``` -/ -def E₇ : matrix (fin 7) (fin 7) ℤ := ![![ 2, 0, -1, 0, 0, 0, 0], - ![ 0, 2, 0, -1, 0, 0, 0], - ![-1, 0, 2, -1, 0, 0, 0], - ![ 0, -1, -1, 2, -1, 0, 0], - ![ 0, 0, 0, -1, 2, -1, 0], - ![ 0, 0, 0, 0, -1, 2, -1], - ![ 0, 0, 0, 0, 0, -1, 2]] +def E₇ : matrix (fin 7) (fin 7) ℤ := !![ 2, 0, -1, 0, 0, 0, 0; + 0, 2, 0, -1, 0, 0, 0; + -1, 0, 2, -1, 0, 0, 0; + 0, -1, -1, 2, -1, 0, 0; + 0, 0, 0, -1, 2, -1, 0; + 0, 0, 0, 0, -1, 2, -1; + 0, 0, 0, 0, 0, -1, 2] /-- The Cartan matrix of type e₈. See [bourbaki1968] plate VII, page 285. @@ -215,14 +218,14 @@ The corresponding Dynkin diagram is: o --- o --- o --- o --- o --- o --- o ``` -/ -def E₈ : matrix (fin 8) (fin 8) ℤ := ![![ 2, 0, -1, 0, 0, 0, 0, 0], - ![ 0, 2, 0, -1, 0, 0, 0, 0], - ![-1, 0, 2, -1, 0, 0, 0, 0], - ![ 0, -1, -1, 2, -1, 0, 0, 0], - ![ 0, 0, 0, -1, 2, -1, 0, 0], - ![ 0, 0, 0, 0, -1, 2, -1, 0], - ![ 0, 0, 0, 0, 0, -1, 2, -1], - ![ 0, 0, 0, 0, 0, 0, -1, 2]] +def E₈ : matrix (fin 8) (fin 8) ℤ := !![ 2, 0, -1, 0, 0, 0, 0, 0; + 0, 2, 0, -1, 0, 0, 0, 0; + -1, 0, 2, -1, 0, 0, 0, 0; + 0, -1, -1, 2, -1, 0, 0, 0; + 0, 0, 0, -1, 2, -1, 0, 0; + 0, 0, 0, 0, -1, 2, -1, 0; + 0, 0, 0, 0, 0, -1, 2, -1; + 0, 0, 0, 0, 0, 0, -1, 2] /-- The Cartan matrix of type f₄. See [bourbaki1968] plate VIII, page 288. @@ -231,10 +234,10 @@ The corresponding Dynkin diagram is: o --- o =>= o --- o ``` -/ -def F₄ : matrix (fin 4) (fin 4) ℤ := ![![ 2, -1, 0, 0], - ![-1, 2, -2, 0], - ![ 0, -1, 2, -1], - ![ 0, 0, -1, 2]] +def F₄ : matrix (fin 4) (fin 4) ℤ := !![ 2, -1, 0, 0; + -1, 2, -2, 0; + 0, -1, 2, -1; + 0, 0, -1, 2] /-- The Cartan matrix of type g₂. See [bourbaki1968] plate IX, page 290. @@ -244,8 +247,8 @@ o ≡>≡ o ``` Actually we are using the transpose of Bourbaki's matrix. This is to make this matrix consistent with `cartan_matrix.F₄`, in the sense that all non-zero values below the diagonal are -1. -/ -def G₂ : matrix (fin 2) (fin 2) ℤ := ![![ 2, -3], - ![-1, 2]] +def G₂ : matrix (fin 2) (fin 2) ℤ := !![ 2, -3; + -1, 2] end cartan_matrix diff --git a/src/algebra/lie/cartan_subalgebra.lean b/src/algebra/lie/cartan_subalgebra.lean index 0c1204888eb1a..460f04376cb0b 100644 --- a/src/algebra/lie/cartan_subalgebra.lean +++ b/src/algebra/lie/cartan_subalgebra.lean @@ -4,18 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Oliver Nash -/ import algebra.lie.nilpotent +import algebra.lie.normalizer /-! # Cartan subalgebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Cartan subalgebras are one of the most important concepts in Lie theory. We define them here. The standard example is the set of diagonal matrices in the Lie algebra of matrices. ## Main definitions - * `lie_subalgebra.normalizer` - * `lie_subalgebra.le_normalizer_of_ideal` + * `lie_submodule.is_ucs_limit` * `lie_subalgebra.is_cartan_subalgebra` + * `lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit` ## Tags @@ -27,91 +31,73 @@ universes u v w w₁ w₂ variables {R : Type u} {L : Type v} variables [comm_ring R] [lie_ring L] [lie_algebra R L] (H : lie_subalgebra R L) -namespace lie_subalgebra - -/-- The normalizer of a Lie subalgebra `H` is the set of elements of the Lie algebra whose bracket -with any element of `H` lies in `H`. It is the Lie algebra equivalent of the group-theoretic -normalizer (see `subgroup.normalizer`) and is an idealizer in the sense of abstract algebra. -/ -def normalizer : lie_subalgebra R L := -{ carrier := { x : L | ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H }, - zero_mem' := λ y hy, by { rw zero_lie y, exact H.zero_mem, }, - add_mem' := λ z₁ z₂ h₁ h₂ y hy, by { rw add_lie, exact H.add_mem (h₁ y hy) (h₂ y hy), }, - smul_mem' := λ t y hy z hz, by { rw smul_lie, exact H.smul_mem t (hy z hz), }, - lie_mem' := λ z₁ z₂ h₁ h₂ y hy, by - { rw lie_lie, exact H.sub_mem (h₁ _ (h₂ y hy)) (h₂ _ (h₁ y hy)), }, } +/-- Given a Lie module `M` of a Lie algebra `L`, `lie_submodule.is_ucs_limit` is the proposition +that a Lie submodule `N ⊆ M` is the limiting value for the upper central series. -lemma mem_normalizer_iff (x : L) : x ∈ H.normalizer ↔ ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H := iff.rfl +This is a characteristic property of Cartan subalgebras with the roles of `L`, `M`, `N` played by +`H`, `L`, `H`, respectively. See `lie_subalgebra.is_cartan_subalgebra_iff_is_ucs_limit`. -/ +def lie_submodule.is_ucs_limit + {M : Type*} [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M] + (N : lie_submodule R L M) : Prop := +∃ k, ∀ l, k ≤ l → (⊥ : lie_submodule R L M).ucs l = N -lemma mem_normalizer_iff' (x : L) : x ∈ H.normalizer ↔ ∀ (y : L), (y ∈ H) → ⁅y, x⁆ ∈ H := -forall₂_congr $ λ y hy, by rw [← lie_skew, neg_mem_iff] - -lemma le_normalizer : H ≤ H.normalizer := -λ x hx, show ∀ (y : L), y ∈ H → ⁅x,y⁆ ∈ H, from λ y, H.lie_mem hx +namespace lie_subalgebra -variables {H} +/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/ +class is_cartan_subalgebra : Prop := +(nilpotent : lie_algebra.is_nilpotent R H) +(self_normalizing : H.normalizer = H) -lemma lie_mem_sup_of_mem_normalizer {x y z : L} (hx : x ∈ H.normalizer) - (hy : y ∈ (R ∙ x) ⊔ ↑H) (hz : z ∈ (R ∙ x) ⊔ ↑H) : ⁅y, z⁆ ∈ (R ∙ x) ⊔ ↑H := -begin - rw submodule.mem_sup at hy hz, - obtain ⟨u₁, hu₁, v, hv : v ∈ H, rfl⟩ := hy, - obtain ⟨u₂, hu₂, w, hw : w ∈ H, rfl⟩ := hz, - obtain ⟨t, rfl⟩ := submodule.mem_span_singleton.mp hu₁, - obtain ⟨s, rfl⟩ := submodule.mem_span_singleton.mp hu₂, - apply submodule.mem_sup_right, - simp only [lie_subalgebra.mem_coe_submodule, smul_lie, add_lie, zero_add, lie_add, smul_zero, - lie_smul, lie_self], - refine H.add_mem (H.smul_mem s _) (H.add_mem (H.smul_mem t _) (H.lie_mem hv hw)), - exacts [(H.mem_normalizer_iff' x).mp hx v hv, (H.mem_normalizer_iff x).mp hx w hw], -end +instance [H.is_cartan_subalgebra] : lie_algebra.is_nilpotent R H := is_cartan_subalgebra.nilpotent -/-- A Lie subalgebra is an ideal of its normalizer. -/ -lemma ideal_in_normalizer : ∀ {x y : L}, x ∈ H.normalizer → y ∈ H → ⁅x,y⁆ ∈ H := -λ x y h, h y +@[simp] lemma normalizer_eq_self_of_is_cartan_subalgebra + (H : lie_subalgebra R L) [H.is_cartan_subalgebra] : + H.to_lie_submodule.normalizer = H.to_lie_submodule := +by rw [← lie_submodule.coe_to_submodule_eq_iff, coe_normalizer_eq_normalizer, + is_cartan_subalgebra.self_normalizing, coe_to_lie_submodule] -/-- A Lie subalgebra `H` is an ideal of any Lie subalgebra `K` containing `H` and contained in the -normalizer of `H`. -/ -lemma exists_nested_lie_ideal_of_le_normalizer - {K : lie_subalgebra R L} (h₁ : H ≤ K) (h₂ : K ≤ H.normalizer) : - ∃ (I : lie_ideal R K), (I : lie_subalgebra R K) = of_le h₁ := +@[simp] lemma ucs_eq_self_of_is_cartan_subalgebra + (H : lie_subalgebra R L) [H.is_cartan_subalgebra] (k : ℕ) : + H.to_lie_submodule.ucs k = H.to_lie_submodule := begin - rw exists_nested_lie_ideal_coe_eq_iff, - exact λ x y hx hy, ideal_in_normalizer (h₂ hx) hy, + induction k with k ih, + { simp, }, + { simp [ih], }, end -/-- The normalizer of a Lie subalgebra `H` is the maximal Lie subalgebra in which `H` is a Lie -ideal. -/ -lemma le_normalizer_of_ideal {N : lie_subalgebra R L} - (h : ∀ (x y : L), x ∈ N → y ∈ H → ⁅x,y⁆ ∈ H) : N ≤ H.normalizer := -λ x hx y, h x y hx - -variables (H) - -lemma normalizer_eq_self_iff : - H.normalizer = H ↔ (lie_module.max_triv_submodule R H $ L ⧸ H.to_lie_submodule) = ⊥ := +lemma is_cartan_subalgebra_iff_is_ucs_limit : + H.is_cartan_subalgebra ↔ H.to_lie_submodule.is_ucs_limit := begin - rw lie_submodule.eq_bot_iff, - refine ⟨λ h, _, λ h, le_antisymm (λ x hx, _) H.le_normalizer⟩, - { rintros ⟨x⟩ hx, - suffices : x ∈ H, by simpa, - rw [← h, H.mem_normalizer_iff'], - intros y hy, - replace hx : ⁅_, lie_submodule.quotient.mk' _ x⁆ = 0 := hx ⟨y, hy⟩, - rwa [← lie_module_hom.map_lie, lie_submodule.quotient.mk_eq_zero] at hx, }, - { let y := lie_submodule.quotient.mk' H.to_lie_submodule x, - have hy : y ∈ lie_module.max_triv_submodule R H (L ⧸ H.to_lie_submodule), - { rintros ⟨z, hz⟩, - rw [← lie_module_hom.map_lie, lie_submodule.quotient.mk_eq_zero, coe_bracket_of_module, - submodule.coe_mk, mem_to_lie_submodule], - exact (H.mem_normalizer_iff' x).mp hx z hz, }, - simpa using h y hy, }, + split, + { introsI h, + have h₁ : _root_.lie_algebra.is_nilpotent R H := by apply_instance, + obtain ⟨k, hk⟩ := H.to_lie_submodule.is_nilpotent_iff_exists_self_le_ucs.mp h₁, + replace hk : H.to_lie_submodule = lie_submodule.ucs k ⊥ := + le_antisymm hk (lie_submodule.ucs_le_of_normalizer_eq_self + H.normalizer_eq_self_of_is_cartan_subalgebra k), + refine ⟨k, λ l hl, _⟩, + rw [← nat.sub_add_cancel hl, lie_submodule.ucs_add, ← hk, + lie_subalgebra.ucs_eq_self_of_is_cartan_subalgebra], }, + { rintros ⟨k, hk⟩, + exact + { nilpotent := + begin + dunfold lie_algebra.is_nilpotent, + erw H.to_lie_submodule.is_nilpotent_iff_exists_lcs_eq_bot, + use k, + rw [_root_.eq_bot_iff, lie_submodule.lcs_le_iff, hk k (le_refl k)], + exact le_refl _, + end, + self_normalizing := + begin + have hk' := hk (k + 1) k.le_succ, + rw [lie_submodule.ucs_succ, hk k (le_refl k)] at hk', + rw [← lie_subalgebra.coe_to_submodule_eq_iff, + ← lie_subalgebra.coe_normalizer_eq_normalizer, hk', + lie_subalgebra.coe_to_lie_submodule], + end } }, end -/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/ -class is_cartan_subalgebra : Prop := -(nilpotent : lie_algebra.is_nilpotent R H) -(self_normalizing : H.normalizer = H) - end lie_subalgebra @[simp] lemma lie_ideal.normalizer_eq_top {R : Type u} {L : Type v} diff --git a/src/algebra/lie/character.lean b/src/algebra/lie/character.lean index 170178ca0b8fe..1d85a4465fa2a 100644 --- a/src/algebra/lie/character.lean +++ b/src/algebra/lie/character.lean @@ -10,6 +10,9 @@ import linear_algebra.dual /-! # Characters of Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A character of a Lie algebra `L` over a commutative ring `R` is a morphism of Lie algebras `L → R`, where `R` is regarded as a Lie algebra over itself via the ring commutator. For an Abelian Lie algebra (e.g., a Cartan subalgebra of a semisimple Lie algebra) a character is just a linear form. diff --git a/src/algebra/lie/classical.lean b/src/algebra/lie/classical.lean index 0bc4ada4aecb4..b6b6e38cfb15d 100644 --- a/src/algebra/lie/classical.lean +++ b/src/algebra/lie/classical.lean @@ -9,10 +9,14 @@ import data.matrix.dmatrix import algebra.lie.abelian import linear_algebra.matrix.trace import algebra.lie.skew_adjoint +import linear_algebra.symplectic_group /-! # Classical Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file is the place to find definitions and basic properties of the classical Lie algebras: * Aₗ = sl(l+1) * Bₗ ≃ so(l+1, l) ≃ so(2l+1) @@ -119,13 +123,10 @@ end special_linear namespace symplectic -/-- The matrix defining the canonical skew-symmetric bilinear form. -/ -def J : matrix (l ⊕ l) (l ⊕ l) R := matrix.from_blocks 0 (-1) 1 0 - /-- The symplectic Lie algebra: skew-adjoint matrices with respect to the canonical skew-symmetric bilinear form. -/ def sp [fintype l] : lie_subalgebra R (matrix (l ⊕ l) (l ⊕ l) R) := - skew_adjoint_matrices_lie_subalgebra (J l R) + skew_adjoint_matrices_lie_subalgebra (matrix.J l R) end symplectic @@ -330,8 +331,8 @@ begin ext i j, rcases i with ⟨⟨i₁ | i₂⟩ | i₃⟩; rcases j with ⟨⟨j₁ | j₂⟩ | j₃⟩; - simp only [indefinite_diagonal, matrix.diagonal, equiv.sum_assoc_apply_inl_inl, - matrix.reindex_lie_equiv_apply, matrix.minor_apply, equiv.symm_symm, matrix.reindex_apply, + simp only [indefinite_diagonal, matrix.diagonal_apply, equiv.sum_assoc_apply_inl_inl, + matrix.reindex_lie_equiv_apply, matrix.submatrix_apply, equiv.symm_symm, matrix.reindex_apply, sum.elim_inl, if_true, eq_self_iff_true, matrix.one_apply_eq, matrix.from_blocks_apply₁₁, dmatrix.zero_apply, equiv.sum_assoc_apply_inl_inr, if_false, matrix.from_blocks_apply₁₂, matrix.from_blocks_apply₂₁, matrix.from_blocks_apply₂₂, equiv.sum_assoc_apply_inr, diff --git a/src/algebra/lie/direct_sum.lean b/src/algebra/lie/direct_sum.lean index 257b61b88aab9..fd1db3af14d08 100644 --- a/src/algebra/lie/direct_sum.lean +++ b/src/algebra/lie/direct_sum.lean @@ -11,7 +11,10 @@ import algebra.lie.basic /-! # Direct sums of Lie algebras and Lie modules -Direct sums of Lie algebras and Lie modules carry natural algbebra and module structures. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Direct sums of Lie algebras and Lie modules carry natural algebra and module structures. ## Tags @@ -194,14 +197,6 @@ section ideals variables {L : Type w} [lie_ring L] [lie_algebra R L] (I : ι → lie_ideal R L) -/-- Given a Lie algebra `L` and a family of ideals `I i ⊆ L`, informally this definition is the -statement that `L = ⨁ i, I i`. - -More formally, the inclusions give a natural map from the (external) direct sum to the enclosing Lie -algebra: `(⨁ i, I i) → L`, and this definition is the proposition that this map is bijective. -/ -def lie_algebra_is_internal [decidable_eq ι] : Prop := -function.bijective $ to_module R ι L $ λ i, ((I i).incl : I i →ₗ[R] L) - /-- The fact that this instance is necessary seems to be a bug in typeclass inference. See [this Zulip thread](https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/ Typeclass.20resolution.20under.20binders/near/245151099). -/ diff --git a/src/algebra/lie/engel.lean b/src/algebra/lie/engel.lean index b27b354fdaca8..9e22f226cc1fa 100644 --- a/src/algebra/lie/engel.lean +++ b/src/algebra/lie/engel.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Oliver Nash -/ import algebra.lie.nilpotent -import algebra.lie.cartan_subalgebra +import algebra.lie.normalizer /-! # Engel's theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains a proof of Engel's theorem providing necessary and sufficient conditions for Lie algebras and Lie modules to be nilpotent. @@ -259,14 +262,11 @@ begin exact nontrivial_max_triv_of_is_nilpotent R K (L' ⧸ K.to_lie_submodule), }, haveI _i5 : is_noetherian R L' := is_noetherian_of_surjective L _ (linear_map.range_range_restrict (to_endomorphism R L M)), - obtain ⟨K, hK₁, hK₂⟩ := - well_founded.well_founded_iff_has_max'.mp (lie_subalgebra.well_founded_of_noetherian R L') s hs, + obtain ⟨K, hK₁, hK₂⟩ := (lie_subalgebra.well_founded_of_noetherian R L').has_min s hs, have hK₃ : K = ⊤, { by_contra contra, obtain ⟨K', hK'₁, hK'₂⟩ := this K hK₁ contra, - specialize hK₂ K' hK'₁ (le_of_lt hK'₂), - replace hK'₂ := (ne_of_lt hK'₂).symm, - contradiction, }, + exact hK₂ K' hK'₁ hK'₂, }, exact hK₃ ▸ hK₁, end diff --git a/src/algebra/lie/free.lean b/src/algebra/lie/free.lean index 0bb0e5c04bd27..1823531a53c2a 100644 --- a/src/algebra/lie/free.lean +++ b/src/algebra/lie/free.lean @@ -11,6 +11,9 @@ import algebra.free_non_unital_non_assoc_algebra /-! # Free Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a commutative ring `R` and a type `X` we construct the free Lie algebra on `X` with coefficients in `R` together with its universal property. @@ -54,7 +57,7 @@ noncomputable theory variables (R : Type u) (X : Type v) [comm_ring R] -/-- We save characters by using Bourbaki's name `lib` (as in «libre») for +/- We save characters by using Bourbaki's name `lib` (as in «libre») for `free_non_unital_non_assoc_algebra` in this file. -/ local notation `lib` := free_non_unital_non_assoc_algebra local notation `lib.lift` := free_non_unital_non_assoc_algebra.lift @@ -105,7 +108,7 @@ def free_lie_algebra := quot (free_lie_algebra.rel R X) namespace free_lie_algebra instance {S : Type*} [monoid S] [distrib_mul_action S R] [is_scalar_tower S R R] : - has_scalar S (free_lie_algebra R X) := + has_smul S (free_lie_algebra R X) := { smul := λ t, quot.map ((•) t) (rel.smul_of_tower t) } instance {S : Type*} [monoid S] [distrib_mul_action S R] [distrib_mul_action Sᵐᵒᵖ R] @@ -165,10 +168,8 @@ def of : X → free_lie_algebra R X := λ x, quot.mk _ (lib.of R x) variables {L : Type w} [lie_ring L] [lie_algebra R L] -local attribute [instance] lie_ring.to_non_unital_non_assoc_semiring - /-- An auxiliary definition used to construct the equivalence `lift` below. -/ -def lift_aux (f : X → L) := lib.lift R f +def lift_aux (f : X → commutator_ring L) := lib.lift R f lemma lift_aux_map_smul (f : X → L) (t : R) (a : lib R X) : lift_aux R f (t • a) = t • lift_aux R f a := @@ -201,7 +202,7 @@ begin end /-- The quotient map as a `non_unital_alg_hom`. -/ -def mk : lib R X →ₙₐ[R] free_lie_algebra R X := +def mk : lib R X →ₙₐ[R] commutator_ring (free_lie_algebra R X) := { to_fun := quot.mk (rel R X), map_smul' := λ t a, rfl, map_zero' := rfl, diff --git a/src/algebra/lie/ideal_operations.lean b/src/algebra/lie/ideal_operations.lean index b9bc5442261d7..b1ab8c6d38e28 100644 --- a/src/algebra/lie/ideal_operations.lean +++ b/src/algebra/lie/ideal_operations.lean @@ -8,6 +8,9 @@ import algebra.lie.submodule /-! # Ideal operations for Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a Lie module `M` over a Lie algebra `L`, there is a natural action of the Lie ideals of `L` on the Lie submodules of `M`. In the special case that `M = L` with the adjoint action, this provides a pairing of Lie ideals which is especially important. For example, it can be used to @@ -86,6 +89,14 @@ begin exact ⟨⟨x, hx⟩, ⟨n, hn⟩, rfl⟩, }, end +lemma lie_le_iff : ⁅I, N⁆ ≤ N' ↔ ∀ (x ∈ I) (m ∈ N), ⁅x, m⁆ ∈ N' := +begin + rw [lie_ideal_oper_eq_span, lie_submodule.lie_span_le], + refine ⟨λ h x hx m hm, h ⟨⟨x, hx⟩, ⟨m, hm⟩, rfl⟩, _⟩, + rintros h _ ⟨⟨x, hx⟩, ⟨m, hm⟩, rfl⟩, + exact h x hx m hm, +end + lemma lie_coe_mem_lie (x : I) (m : N) : ⁅(x : L), (m : M)⁆ ∈ ⁅I, N⁆ := by { rw lie_ideal_oper_eq_span, apply subset_lie_span, use [x, m], } @@ -97,7 +108,7 @@ begin suffices : ∀ (I J : lie_ideal R L), ⁅I, J⁆ ≤ ⁅J, I⁆, { exact le_antisymm (this I J) (this J I), }, clear I J, intros I J, rw [lie_ideal_oper_eq_span, lie_span_le], rintros x ⟨y, z, h⟩, rw ← h, - rw [← lie_skew, ← lie_neg, ← submodule.coe_neg], + rw [← lie_skew, ← lie_neg, ← lie_submodule.coe_neg], apply lie_coe_mem_lie, end diff --git a/src/algebra/lie/matrix.lean b/src/algebra/lie/matrix.lean index c38085e480964..afd6b6dc5c42f 100644 --- a/src/algebra/lie/matrix.lean +++ b/src/algebra/lie/matrix.lean @@ -10,6 +10,9 @@ import linear_algebra.matrix.to_linear_equiv /-! # Lie algebras of matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An important class of Lie algebras are those arising from the associative algebra structure on square matrices over a commutative ring. This file provides some very basic definitions whose primary value stems from their utility when constructing the classical Lie algebras using matrices. @@ -73,7 +76,7 @@ types, `matrix.reindex`, is an equivalence of Lie algebras. -/ def matrix.reindex_lie_equiv : matrix n n R ≃ₗ⁅R⁆ matrix m m R := { to_fun := matrix.reindex e e, map_lie' := λ M N, by simp only [lie_ring.of_associative_ring_bracket, matrix.reindex_apply, - matrix.minor_mul_equiv, matrix.mul_eq_mul, matrix.minor_sub, pi.sub_apply], + matrix.submatrix_mul_equiv, matrix.mul_eq_mul, matrix.submatrix_sub, pi.sub_apply], ..(matrix.reindex_linear_equiv R R e e) } @[simp] lemma matrix.reindex_lie_equiv_apply (M : matrix n n R) : diff --git a/src/algebra/lie/nilpotent.lean b/src/algebra/lie/nilpotent.lean index 97ac35b977979..6d4b290ac1816 100644 --- a/src/algebra/lie/nilpotent.lean +++ b/src/algebra/lie/nilpotent.lean @@ -5,12 +5,16 @@ Authors: Oliver Nash -/ import algebra.lie.solvable import algebra.lie.quotient -import linear_algebra.eigenspace +import algebra.lie.normalizer +import linear_algebra.eigenspace.basic import ring_theory.nilpotent /-! # Nilpotent Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Like groups, Lie algebras admit a natural concept of nilpotency. More generally, any Lie module carries a natural concept of nilpotency. We define these here via the lower central series. @@ -45,7 +49,7 @@ expression of the fact that the terms of the Lie submodule's lower central serie submodules of the enclosing Lie module. See also `lie_module.lower_central_series_eq_lcs_comap` and -`lie_module.lower_central_series_map_eq_lcs` below. -/ +`lie_module.lower_central_series_map_eq_lcs` below, as well as `lie_submodule.ucs`. -/ def lcs : lie_submodule R L M → lie_submodule R L M := (λ N, ⁅(⊤ : lie_ideal R L), N⁆)^[k] @[simp] lemma lcs_zero (N : lie_submodule R L M) : N.lcs 0 = N := rfl @@ -171,6 +175,24 @@ steps). -/ class is_nilpotent : Prop := (nilpotent : ∃ k, lower_central_series R L M k = ⊥) +/-- See also `lie_module.is_nilpotent_iff_exists_ucs_eq_top`. -/ +lemma is_nilpotent_iff : + is_nilpotent R L M ↔ ∃ k, lower_central_series R L M k = ⊥ := +⟨λ h, h.nilpotent, λ h, ⟨h⟩⟩ + +variables {R L M} + +lemma _root_.lie_submodule.is_nilpotent_iff_exists_lcs_eq_bot (N : lie_submodule R L M) : + lie_module.is_nilpotent R L N ↔ ∃ k, N.lcs k = ⊥ := +begin + rw is_nilpotent_iff, + refine exists_congr (λ k, _), + rw [N.lower_central_series_eq_lcs_comap k, lie_submodule.comap_incl_eq_bot, + inf_eq_right.mpr (N.lcs_le_self k)], +end + +variables (R L M) + @[priority 100] instance trivial_is_nilpotent [is_trivial L M] : is_nilpotent R L M := ⟨by { use 1, change ⁅⊤, ⊤⁆ = ⊥, simp, }⟩ @@ -323,6 +345,81 @@ end end lie_module +namespace lie_submodule + +variables {N₁ N₂ : lie_submodule R L M} + +/-- The upper (aka ascending) central series. + +See also `lie_submodule.lcs`. -/ +def ucs (k : ℕ) : lie_submodule R L M → lie_submodule R L M := +normalizer^[k] + +@[simp] lemma ucs_zero : N.ucs 0 = N := rfl + +@[simp] lemma ucs_succ (k : ℕ) : + N.ucs (k + 1) = (N.ucs k).normalizer := +function.iterate_succ_apply' normalizer k N + +lemma ucs_add (k l : ℕ) : + N.ucs (k + l) = (N.ucs l).ucs k := +function.iterate_add_apply normalizer k l N + +@[mono] lemma ucs_mono (k : ℕ) (h : N₁ ≤ N₂) : + N₁.ucs k ≤ N₂.ucs k := +begin + induction k with k ih, { simpa, }, + simp only [ucs_succ], + mono, +end + +lemma ucs_eq_self_of_normalizer_eq_self (h : N₁.normalizer = N₁) (k : ℕ) : + N₁.ucs k = N₁ := +by { induction k with k ih, { simp, }, { rwa [ucs_succ, ih], }, } + +/-- If a Lie module `M` contains a self-normalizing Lie submodule `N`, then all terms of the upper +central series of `M` are contained in `N`. + +An important instance of this situation arises from a Cartan subalgebra `H ⊆ L` with the roles of +`L`, `M`, `N` played by `H`, `L`, `H`, respectively. -/ +lemma ucs_le_of_normalizer_eq_self (h : N₁.normalizer = N₁) (k : ℕ) : + (⊥ : lie_submodule R L M).ucs k ≤ N₁ := +by { rw ← ucs_eq_self_of_normalizer_eq_self h k, mono, simp, } + +lemma lcs_add_le_iff (l k : ℕ) : + N₁.lcs (l + k) ≤ N₂ ↔ N₁.lcs l ≤ N₂.ucs k := +begin + revert l, + induction k with k ih, { simp, }, + intros l, + rw [(by abel : l + (k + 1) = l + 1 + k), ih, ucs_succ, lcs_succ, top_lie_le_iff_le_normalizer], +end + +lemma lcs_le_iff (k : ℕ) : + N₁.lcs k ≤ N₂ ↔ N₁ ≤ N₂.ucs k := +by { convert lcs_add_le_iff 0 k, rw zero_add, } + +lemma gc_lcs_ucs (k : ℕ): + galois_connection (λ (N : lie_submodule R L M), N.lcs k) (λ (N : lie_submodule R L M), N.ucs k) := +λ N₁ N₂, lcs_le_iff k + +lemma ucs_eq_top_iff (k : ℕ) : N.ucs k = ⊤ ↔ lie_module.lower_central_series R L M k ≤ N := +by { rw [eq_top_iff, ← lcs_le_iff], refl, } + +lemma _root_.lie_module.is_nilpotent_iff_exists_ucs_eq_top : + lie_module.is_nilpotent R L M ↔ ∃ k, (⊥ : lie_submodule R L M).ucs k = ⊤ := +by { rw lie_module.is_nilpotent_iff, exact exists_congr (λ k, by simp [ucs_eq_top_iff]), } + +lemma ucs_comap_incl (k : ℕ) : + ((⊥ : lie_submodule R L M).ucs k).comap N.incl = (⊥ : lie_submodule R L N).ucs k := +by { induction k with k ih, { exact N.ker_incl, }, { simp [← ih], }, } + +lemma is_nilpotent_iff_exists_self_le_ucs : + lie_module.is_nilpotent R L N ↔ ∃ k, N ≤ (⊥ : lie_submodule R L M).ucs k := +by simp_rw [lie_module.is_nilpotent_iff_exists_ucs_eq_top, ← ucs_comap_incl, comap_incl_eq_top] + +end lie_submodule + section morphisms open lie_module function @@ -441,10 +538,10 @@ begin split, { rintros ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩, erw [← lie_submodule.mem_coe_submodule, ih, lie_submodule.mem_coe_submodule] at hz, - exact ⟨⟨lie_submodule.quotient.mk y, submodule.mem_top⟩, ⟨z, hz⟩, rfl⟩, }, + exact ⟨⟨lie_submodule.quotient.mk y, lie_submodule.mem_top _⟩, ⟨z, hz⟩, rfl⟩, }, { rintros ⟨⟨⟨y⟩, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩, erw [← lie_submodule.mem_coe_submodule, ← ih, lie_submodule.mem_coe_submodule] at hz, - exact ⟨⟨y, submodule.mem_top⟩, ⟨z, hz⟩, rfl⟩, }, }, + exact ⟨⟨y, lie_submodule.mem_top _⟩, ⟨z, hz⟩, rfl⟩, }, }, end /-- Note that the below inequality can be strict. For example the ideal of strictly-upper-triangular @@ -457,7 +554,7 @@ begin { simp only [lie_module.lower_central_series_succ, lie_submodule.lie_ideal_oper_eq_linear_span], apply submodule.span_mono, rintros x ⟨⟨y, -⟩, ⟨z, hz⟩, rfl : ⁅y, z⁆ = x⟩, - exact ⟨⟨y.val, submodule.mem_top⟩, ⟨z, ih hz⟩, rfl⟩, }, + exact ⟨⟨y.val, lie_submodule.mem_top _⟩, ⟨z, ih hz⟩, rfl⟩, }, end /-- A central extension of nilpotent Lie algebras is nilpotent. -/ @@ -577,7 +674,7 @@ begin { simp, }, { simp_rw [lower_central_series_succ, lcs_succ, lie_submodule.lie_ideal_oper_eq_linear_span', ← (I.lcs M k).mem_coe_submodule, ih, lie_submodule.mem_coe_submodule, - lie_submodule.mem_top, exists_true_left, lie_subalgebra.coe_bracket_of_module], + lie_submodule.mem_top, exists_true_left, (I : lie_subalgebra R L).coe_bracket_of_module], congr, ext m, split, @@ -597,9 +694,12 @@ lemma lie_algebra.ad_nilpotent_of_nilpotent {a : A} (h : is_nilpotent a) : is_nilpotent (lie_algebra.ad R A a) := begin rw lie_algebra.ad_eq_lmul_left_sub_lmul_right, - have hl : is_nilpotent (algebra.lmul_left R a), { rwa algebra.is_nilpotent_lmul_left_iff, }, - have hr : is_nilpotent (algebra.lmul_right R a), { rwa algebra.is_nilpotent_lmul_right_iff, }, - exact (algebra.commute_lmul_left_right R a a).is_nilpotent_sub hl hr, + have hl : is_nilpotent (linear_map.mul_left R a), + { rwa linear_map.is_nilpotent_mul_left_iff, }, + have hr : is_nilpotent (linear_map.mul_right R a), + { rwa linear_map.is_nilpotent_mul_right_iff, }, + have := @linear_map.commute_mul_left_right R A _ _ _ _ _ a a, + exact this.is_nilpotent_sub hl hr, end variables {R} diff --git a/src/algebra/lie/non_unital_non_assoc_algebra.lean b/src/algebra/lie/non_unital_non_assoc_algebra.lean index 8ccd3e24c3417..3d6397abd9938 100644 --- a/src/algebra/lie/non_unital_non_assoc_algebra.lean +++ b/src/algebra/lie/non_unital_non_assoc_algebra.lean @@ -9,6 +9,9 @@ import algebra.lie.basic /-! # Lie algebras as non-unital, non-associative algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The definition of Lie algebras uses the `has_bracket` typeclass for multiplication whereas we have a separate `has_mul` typeclass used for general algebras. @@ -23,7 +26,8 @@ algebra and we provide some basic definitions for doing so here. ## Main definitions - * `lie_ring.to_non_unital_non_assoc_semiring` + * `commutator_ring` turns a Lie ring into a `non_unital_non_assoc_semiring` by turning its + `has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`). * `lie_hom.to_non_unital_alg_hom` ## Tags @@ -35,9 +39,16 @@ universes u v w variables (R : Type u) (L : Type v) [comm_ring R] [lie_ring L] [lie_algebra R L] +/-- Type synonym for turning a `lie_ring` into a `non_unital_non_assoc_semiring`. + +A `lie_ring` can be regarded as a `non_unital_non_assoc_semiring` by turning its +`has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`). -/ +def commutator_ring (L : Type v) : Type v := L + /-- A `lie_ring` can be regarded as a `non_unital_non_assoc_semiring` by turning its `has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`). -/ -def lie_ring.to_non_unital_non_assoc_semiring : non_unital_non_assoc_semiring L := +instance : non_unital_non_assoc_semiring (commutator_ring L) := +show non_unital_non_assoc_semiring L, from { mul := has_bracket.bracket, left_distrib := lie_add, right_distrib := add_lie, @@ -45,17 +56,28 @@ def lie_ring.to_non_unital_non_assoc_semiring : non_unital_non_assoc_semiring L mul_zero := lie_zero, .. (infer_instance : add_comm_monoid L) } -local attribute [instance] lie_ring.to_non_unital_non_assoc_semiring - namespace lie_algebra +instance (L : Type v) [nonempty L] : nonempty (commutator_ring L) := +‹nonempty L› + +instance (L : Type v) [inhabited L] : inhabited (commutator_ring L) := +‹inhabited L› + +instance : lie_ring (commutator_ring L) := +show lie_ring L, by apply_instance + +instance : lie_algebra R (commutator_ring L) := +show lie_algebra R L, by apply_instance + /-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can reinterpret the `smul_lie` law as an `is_scalar_tower`. -/ -instance is_scalar_tower : is_scalar_tower R L L := ⟨smul_lie⟩ +instance is_scalar_tower : is_scalar_tower R (commutator_ring L) (commutator_ring L) := ⟨smul_lie⟩ /-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can reinterpret the `lie_smul` law as an `smul_comm_class`. -/ -instance smul_comm_class : smul_comm_class R L L := ⟨λ t x y, (lie_smul t x y).symm⟩ +instance smul_comm_class : smul_comm_class R (commutator_ring L) (commutator_ring L) := +⟨λ t x y, (lie_smul t x y).symm⟩ end lie_algebra @@ -66,14 +88,14 @@ variables {R L} {L₂ : Type w} [lie_ring L₂] [lie_algebra R L₂] /-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can regard a `lie_hom` as a `non_unital_alg_hom`. -/ @[simps] -def to_non_unital_alg_hom (f : L →ₗ⁅R⁆ L₂) : L →ₙₐ[R] L₂ := +def to_non_unital_alg_hom (f : L →ₗ⁅R⁆ L₂) : commutator_ring L →ₙₐ[R] commutator_ring L₂ := { to_fun := f, map_zero' := f.map_zero, map_mul' := f.map_lie, ..f } lemma to_non_unital_alg_hom_injective : - function.injective (to_non_unital_alg_hom : _ → (L →ₙₐ[R] L₂)) := + function.injective (to_non_unital_alg_hom : _ → (commutator_ring L →ₙₐ[R] commutator_ring L₂)) := λ f g h, ext $ non_unital_alg_hom.congr_fun h end lie_hom diff --git a/src/algebra/lie/normalizer.lean b/src/algebra/lie/normalizer.lean new file mode 100644 index 0000000000000..b8b889787bf49 --- /dev/null +++ b/src/algebra/lie/normalizer.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2022 Oliver Nash. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Oliver Nash +-/ +import algebra.lie.abelian +import algebra.lie.ideal_operations +import algebra.lie.quotient + +/-! +# The normalizer of a Lie submodules and subalgebras. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given a Lie module `M` over a Lie subalgebra `L`, the normalizer of a Lie submodule `N ⊆ M` is +the Lie submodule with underlying set `{ m | ∀ (x : L), ⁅x, m⁆ ∈ N }`. + +The lattice of Lie submodules thus has two natural operations, the normalizer: `N ↦ N.normalizer` +and the ideal operation: `N ↦ ⁅⊤, N⁆`; these are adjoint, i.e., they form a Galois connection. This +adjointness is the reason that we may define nilpotency in terms of either the upper or lower +central series. + +Given a Lie subalgebra `H ⊆ L`, we may regard `H` as a Lie submodule of `L` over `H`, and thus +consider the normalizer. This turns out to be a Lie subalgebra. + +## Main definitions + + * `lie_submodule.normalizer` + * `lie_subalgebra.normalizer` + * `lie_submodule.gc_top_lie_normalizer` + +## Tags + +lie algebra, normalizer +-/ + +variables {R L M M' : Type*} +variables [comm_ring R] [lie_ring L] [lie_algebra R L] +variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M] +variables [add_comm_group M'] [module R M'] [lie_ring_module L M'] [lie_module R L M'] + +namespace lie_submodule + +variables (N : lie_submodule R L M) {N₁ N₂ : lie_submodule R L M} + +/-- The normalizer of a Lie submodule. -/ +def normalizer : lie_submodule R L M := +{ carrier := { m | ∀ (x : L), ⁅x, m⁆ ∈ N }, + add_mem' := λ m₁ m₂ hm₁ hm₂ x, by { rw lie_add, exact N.add_mem' (hm₁ x) (hm₂ x), }, + zero_mem' := λ x, by simp, + smul_mem' := λ t m hm x, by { rw lie_smul, exact N.smul_mem' t (hm x), }, + lie_mem := λ x m hm y, by { rw leibniz_lie, exact N.add_mem' (hm ⁅y, x⁆) (N.lie_mem (hm y)), } } + +@[simp] lemma mem_normalizer (m : M) : + m ∈ N.normalizer ↔ ∀ (x : L), ⁅x, m⁆ ∈ N := +iff.rfl + +lemma le_normalizer : N ≤ N.normalizer := +begin + intros m hm, + rw mem_normalizer, + exact λ x, N.lie_mem hm, +end + +lemma normalizer_inf : + (N₁ ⊓ N₂).normalizer = N₁.normalizer ⊓ N₂.normalizer := +by { ext, simp [← forall_and_distrib], } + +@[mono] lemma monotone_normalizer : + monotone (normalizer : lie_submodule R L M → lie_submodule R L M) := +begin + intros N₁ N₂ h m hm, + rw mem_normalizer at hm ⊢, + exact λ x, h (hm x), +end + +@[simp] lemma comap_normalizer (f : M' →ₗ⁅R,L⁆ M) : + N.normalizer.comap f = (N.comap f).normalizer := +by { ext, simp, } + +lemma top_lie_le_iff_le_normalizer (N' : lie_submodule R L M) : + ⁅(⊤ : lie_ideal R L), N⁆ ≤ N' ↔ N ≤ N'.normalizer := +by { rw lie_le_iff, tauto, } + +lemma gc_top_lie_normalizer : + galois_connection (λ N : lie_submodule R L M, ⁅(⊤ : lie_ideal R L), N⁆) normalizer := +top_lie_le_iff_le_normalizer + +variables (R L M) + +lemma normalizer_bot_eq_max_triv_submodule : + (⊥ : lie_submodule R L M).normalizer = lie_module.max_triv_submodule R L M := +rfl + +end lie_submodule + +namespace lie_subalgebra + +variables (H : lie_subalgebra R L) + +/-- Regarding a Lie subalgebra `H ⊆ L` as a module over itself, its normalizer is in fact a Lie +subalgebra. -/ +def normalizer : lie_subalgebra R L := +{ lie_mem' := λ y z hy hz x, + begin + rw [coe_bracket_of_module, mem_to_lie_submodule, leibniz_lie, ← lie_skew y, ← sub_eq_add_neg], + exact H.sub_mem (hz ⟨_, hy x⟩) (hy ⟨_, hz x⟩), + end, + .. H.to_lie_submodule.normalizer } + +lemma mem_normalizer_iff' (x : L) : x ∈ H.normalizer ↔ ∀ (y : L), (y ∈ H) → ⁅y, x⁆ ∈ H := +by { rw subtype.forall', refl, } + +lemma mem_normalizer_iff (x : L) : x ∈ H.normalizer ↔ ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H := +begin + rw mem_normalizer_iff', + refine forall₂_congr (λ y hy, _), + rw [← lie_skew, neg_mem_iff], +end + +lemma le_normalizer : H ≤ H.normalizer := H.to_lie_submodule.le_normalizer + +lemma coe_normalizer_eq_normalizer : + (H.to_lie_submodule.normalizer : submodule R L) = H.normalizer := +rfl + +variables {H} + +lemma lie_mem_sup_of_mem_normalizer {x y z : L} (hx : x ∈ H.normalizer) + (hy : y ∈ (R ∙ x) ⊔ ↑H) (hz : z ∈ (R ∙ x) ⊔ ↑H) : ⁅y, z⁆ ∈ (R ∙ x) ⊔ ↑H := +begin + rw submodule.mem_sup at hy hz, + obtain ⟨u₁, hu₁, v, hv : v ∈ H, rfl⟩ := hy, + obtain ⟨u₂, hu₂, w, hw : w ∈ H, rfl⟩ := hz, + obtain ⟨t, rfl⟩ := submodule.mem_span_singleton.mp hu₁, + obtain ⟨s, rfl⟩ := submodule.mem_span_singleton.mp hu₂, + apply submodule.mem_sup_right, + simp only [lie_subalgebra.mem_coe_submodule, smul_lie, add_lie, zero_add, lie_add, smul_zero, + lie_smul, lie_self], + refine H.add_mem (H.smul_mem s _) (H.add_mem (H.smul_mem t _) (H.lie_mem hv hw)), + exacts [(H.mem_normalizer_iff' x).mp hx v hv, (H.mem_normalizer_iff x).mp hx w hw], +end + +/-- A Lie subalgebra is an ideal of its normalizer. -/ +lemma ideal_in_normalizer {x y : L} (hx : x ∈ H.normalizer) (hy : y ∈ H) : ⁅x,y⁆ ∈ H := +begin + rw [← lie_skew, neg_mem_iff], + exact hx ⟨y, hy⟩, +end + +/-- A Lie subalgebra `H` is an ideal of any Lie subalgebra `K` containing `H` and contained in the +normalizer of `H`. -/ +lemma exists_nested_lie_ideal_of_le_normalizer + {K : lie_subalgebra R L} (h₁ : H ≤ K) (h₂ : K ≤ H.normalizer) : + ∃ (I : lie_ideal R K), (I : lie_subalgebra R K) = of_le h₁ := +begin + rw exists_nested_lie_ideal_coe_eq_iff, + exact λ x y hx hy, ideal_in_normalizer (h₂ hx) hy, +end + +variables (H) + +lemma normalizer_eq_self_iff : + H.normalizer = H ↔ (lie_module.max_triv_submodule R H $ L ⧸ H.to_lie_submodule) = ⊥ := +begin + rw lie_submodule.eq_bot_iff, + refine ⟨λ h, _, λ h, le_antisymm (λ x hx, _) H.le_normalizer⟩, + { rintros ⟨x⟩ hx, + suffices : x ∈ H, by simpa, + rw [← h, H.mem_normalizer_iff'], + intros y hy, + replace hx : ⁅_, lie_submodule.quotient.mk' _ x⁆ = 0 := hx ⟨y, hy⟩, + rwa [← lie_module_hom.map_lie, lie_submodule.quotient.mk_eq_zero] at hx, }, + { let y := lie_submodule.quotient.mk' H.to_lie_submodule x, + have hy : y ∈ lie_module.max_triv_submodule R H (L ⧸ H.to_lie_submodule), + { rintros ⟨z, hz⟩, + rw [← lie_module_hom.map_lie, lie_submodule.quotient.mk_eq_zero, coe_bracket_of_module, + submodule.coe_mk, mem_to_lie_submodule], + exact (H.mem_normalizer_iff' x).mp hx z hz, }, + simpa using h y hy, }, +end + +end lie_subalgebra diff --git a/src/algebra/lie/of_associative.lean b/src/algebra/lie/of_associative.lean index 99e834dfe38d8..e63c1a71f10e1 100644 --- a/src/algebra/lie/of_associative.lean +++ b/src/algebra/lie/of_associative.lean @@ -11,6 +11,9 @@ import algebra.algebra.subalgebra.basic /-! # Lie algebras of associative algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the Lie algebra structure that arises on an associative algebra via the ring commutator. @@ -49,6 +52,10 @@ lemma lie_def (x y : A) : ⁅x, y⁆ = x*y - y*x := rfl end ring +lemma commute_iff_lie_eq {x y : A} : commute x y ↔ ⁅x, y⁆ = 0 := sub_eq_zero.symm + +lemma commute.lie_eq {x y : A} (h : commute x y) : ⁅x, y⁆ = 0 := sub_eq_zero_of_eq h + namespace lie_ring /-- An associative ring gives rise to a Lie ring by taking the bracket to be the ring commutator. -/ @@ -201,17 +208,36 @@ rfl variables {R L M} -lemma lie_submodule.coe_map_to_endomorphism_le {N : lie_submodule R L M} {x : L} : +namespace lie_submodule + +open lie_module + +variables {N : lie_submodule R L M} {x : L} + +lemma coe_map_to_endomorphism_le : (N : submodule R M).map (lie_module.to_endomorphism R L M x) ≤ N := begin rintros n ⟨m, hm, rfl⟩, exact N.lie_mem hm, end +variables (N x) + +lemma to_endomorphism_comp_subtype_mem (m : M) (hm : m ∈ (N : submodule R M)) : + (to_endomorphism R L M x).comp (N : submodule R M).subtype ⟨m, hm⟩ ∈ (N : submodule R M) := +by simpa using N.lie_mem hm + +@[simp] lemma to_endomorphism_restrict_eq_to_endomorphism + (h := N.to_endomorphism_comp_subtype_mem x) : + (to_endomorphism R L M x).restrict h = to_endomorphism R L N x := +by { ext, simp [linear_map.restrict_apply], } + +end lie_submodule + open lie_algebra lemma lie_algebra.ad_eq_lmul_left_sub_lmul_right (A : Type v) [ring A] [algebra R A] : - (ad R A : A → module.End R A) = algebra.lmul_left R - algebra.lmul_right R := + (ad R A : A → module.End R A) = linear_map.mul_left R - linear_map.mul_right R := by { ext a b, simp [lie_ring.of_associative_ring_bracket], } lemma lie_subalgebra.ad_comp_incl_eq (K : lie_subalgebra R L) (x : K) : diff --git a/src/algebra/lie/quotient.lean b/src/algebra/lie/quotient.lean index fd47a97283820..16cb98882faaf 100644 --- a/src/algebra/lie/quotient.lean +++ b/src/algebra/lie/quotient.lean @@ -10,6 +10,9 @@ import linear_algebra.isomorphisms /-! # Quotients of Lie algebras and Lie modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a Lie submodule of a Lie module, the quotient carries a natural Lie module structure. In the special case that the Lie module is the Lie algebra itself via the adjoint action, the submodule is a Lie ideal and the quotient carries a natural Lie algebra structure. @@ -45,12 +48,12 @@ namespace quotient variables {N I} instance add_comm_group : add_comm_group (M ⧸ N) := submodule.quotient.add_comm_group _ -instance module' {S : Type*} [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] : +instance module' {S : Type*} [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M] : module S (M ⧸ N) := submodule.quotient.module' _ instance module : module R (M ⧸ N) := submodule.quotient.module _ instance is_central_scalar {S : Type*} [semiring S] - [has_scalar S R] [module S M] [is_scalar_tower S R M] - [has_scalar Sᵐᵒᵖ R] [module Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M] + [has_smul S R] [module S M] [is_scalar_tower S R M] + [has_smul Sᵐᵒᵖ R] [module Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M] [is_central_scalar S M] : is_central_scalar S (M ⧸ N) := submodule.quotient.is_central_scalar _ instance inhabited : inhabited (M ⧸ N) := ⟨0⟩ @@ -59,42 +62,33 @@ instance inhabited : inhabited (M ⧸ N) := ⟨0⟩ lie_submodule of the lie_module `N`. -/ abbreviation mk : M → M ⧸ N := submodule.quotient.mk -lemma is_quotient_mk (m : M) : - quotient.mk' m = (mk m : M ⧸ N) := rfl +lemma is_quotient_mk (m : M) : quotient.mk' m = (mk m : M ⧸ N) := rfl /-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there is a natural linear map from `L` to the endomorphisms of `M` leaving `N` invariant. -/ def lie_submodule_invariant : L →ₗ[R] submodule.compatible_maps N.to_submodule N.to_submodule := - linear_map.cod_restrict _ (lie_module.to_endomorphism R L M) N.lie_mem +linear_map.cod_restrict _ (lie_module.to_endomorphism R L M) $ λ _ _, N.lie_mem variables (N) /-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there is a natural Lie algebra morphism from `L` to the linear endomorphism of the quotient `M/N`. -/ def action_as_endo_map : L →ₗ⁅R⁆ module.End R (M ⧸ N) := -{ map_lie' := λ x y, by { ext m, - change mk ⁅⁅x, y⁆, m⁆ = mk (⁅x, ⁅y, m⁆⁆ - ⁅y, ⁅x, m⁆⁆), - congr, apply lie_lie, }, +{ map_lie' := λ x y, submodule.linear_map_qext _ $ linear_map.ext $ λ m, + congr_arg mk $ lie_lie _ _ _, ..linear_map.comp (submodule.mapq_linear (N : submodule R M) ↑N) lie_submodule_invariant } /-- Given a Lie module `M` over a Lie algebra `L`, together with a Lie submodule `N ⊆ M`, there is a natural bracket action of `L` on the quotient `M/N`. -/ -def action_as_endo_map_bracket : has_bracket L (M ⧸ N) := ⟨λ x n, action_as_endo_map N x n⟩ +instance action_as_endo_map_bracket : has_bracket L (M ⧸ N) := ⟨λ x n, action_as_endo_map N x n⟩ instance lie_quotient_lie_ring_module : lie_ring_module L (M ⧸ N) := -{ bracket := λ x n, (action_as_endo_map N : L →ₗ[R] module.End R (M ⧸ N)) x n, - add_lie := λ x y n, by { simp only [linear_map.map_add, linear_map.add_apply], }, - lie_add := λ x m n, by { simp only [linear_map.map_add, linear_map.add_apply], }, - leibniz_lie := λ x y m, show action_as_endo_map _ _ _ = _, - { simp only [lie_hom.map_lie, lie_ring.of_associative_ring_bracket, sub_add_cancel, - lie_hom.coe_to_linear_map, linear_map.mul_apply, linear_map.sub_apply], } } +{ bracket := has_bracket.bracket, + ..lie_ring_module.comp_lie_hom _ (action_as_endo_map N) } /-- The quotient of a Lie module by a Lie submodule, is a Lie module. -/ instance lie_quotient_lie_module : lie_module R L (M ⧸ N) := -{ smul_lie := λ t x m, show (_ : L →ₗ[R] module.End R (M ⧸ N)) _ _ = _, - { simp only [linear_map.map_smul], refl, }, - lie_smul := λ x t m, show (_ : L →ₗ[R] module.End R (M ⧸ N)) _ _ = _, - { simp only [linear_map.map_smul], refl, }, } +lie_module.comp_lie_hom _ (action_as_endo_map N) instance lie_quotient_has_bracket : has_bracket (L ⧸ I) (L ⧸ I) := ⟨begin diff --git a/src/algebra/lie/semisimple.lean b/src/algebra/lie/semisimple.lean index 64f243e7af7c8..d76852391a9c7 100644 --- a/src/algebra/lie/semisimple.lean +++ b/src/algebra/lie/semisimple.lean @@ -8,6 +8,9 @@ import algebra.lie.solvable /-! # Semisimple Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The famous Cartan-Dynkin-Killing classification of semisimple Lie algebras renders them one of the most important classes of Lie algebras. In this file we define simple and semisimple Lie algebras and prove some basic related results. @@ -77,7 +80,7 @@ instance is_semisimple_of_is_simple [h : is_simple R L] : is_semisimple R L := begin rw is_semisimple_iff_no_abelian_ideals, intros I hI, - obtain ⟨⟨h₁⟩, h₂⟩ := id h, + obtain @⟨⟨h₁⟩, h₂⟩ := id h, by_contradiction contra, rw [h₁ I contra, lie_abelian_iff_equiv_lie_abelian lie_ideal.top_equiv] at hI, exact h₂ hI, diff --git a/src/algebra/lie/skew_adjoint.lean b/src/algebra/lie/skew_adjoint.lean index 4c3ea50651cbe..c9f78e816a6d0 100644 --- a/src/algebra/lie/skew_adjoint.lean +++ b/src/algebra/lie/skew_adjoint.lean @@ -9,6 +9,9 @@ import linear_algebra.matrix.bilinear_form /-! # Lie algebras of skew-adjoint endomorphisms of a bilinear form +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When a module carries a bilinear form, the Lie algebra of endomorphisms of the module contains a distinguished Lie subalgebra: the skew-adjoint endomorphisms. Such subalgebras are important because they provide a simple, explicit construction of the so-called classical Lie algebras. @@ -119,7 +122,7 @@ begin A ∈ skew_adjoint_matrices_submodule (Pᵀ ⬝ J ⬝ P), { simp only [lie_subalgebra.mem_coe, submodule.mem_map_equiv, lie_subalgebra.mem_map_submodule, coe_coe], exact this, }, - simp [matrix.is_skew_adjoint, J.is_adjoint_pair_equiv _ _ P (is_unit_of_invertible P)], + simp [matrix.is_skew_adjoint, J.is_adjoint_pair_equiv' _ _ P (is_unit_of_invertible P)], end lemma skew_adjoint_matrices_lie_subalgebra_equiv_apply diff --git a/src/algebra/lie/solvable.lean b/src/algebra/lie/solvable.lean index 88bb281acdadd..e463807199cc5 100644 --- a/src/algebra/lie/solvable.lean +++ b/src/algebra/lie/solvable.lean @@ -10,6 +10,9 @@ import order.hom.basic /-! # Solvable Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Like groups, Lie algebras admit a natural concept of solvability. We define this here via the derived series and prove some related results. We also define the radical of a Lie algebra and prove that it is solvable when the Lie algebra is Noetherian. @@ -78,7 +81,7 @@ end D k I ≤ D l J := begin revert l, induction k with k ih; intros l h₂, - { rw nat.le_zero_iff at h₂, rw [h₂, derived_series_of_ideal_zero], exact h₁, }, + { rw le_zero_iff at h₂, rw [h₂, derived_series_of_ideal_zero], exact h₁, }, { have h : l = k.succ ∨ l ≤ k, by rwa [le_iff_eq_or_lt, nat.lt_succ_iff] at h₂, cases h, { rw [h, derived_series_of_ideal_succ, derived_series_of_ideal_succ], @@ -187,7 +190,7 @@ class is_solvable : Prop := (solvable : ∃ k, derived_series R L k = ⊥) instance is_solvable_bot : is_solvable R ↥(⊥ : lie_ideal R L) := -⟨⟨0, @subsingleton.elim _ lie_ideal.subsingleton_of_bot _ ⊥⟩⟩ +⟨⟨0, subsingleton.elim _ ⊥⟩⟩ instance is_solvable_add {I J : lie_ideal R L} [hI : is_solvable R I] [hJ : is_solvable R J] : is_solvable R ↥(I + J) := @@ -333,8 +336,8 @@ lemma derived_length_zero (I : lie_ideal R L) [hI : is_solvable R I] : begin let s := {k | derived_series_of_ideal R L k I = ⊥}, change Inf s = 0 ↔ _, have hne : s ≠ ∅, - { rw set.ne_empty_iff_nonempty, - obtain ⟨k, hk⟩ := id hI, use k, + { obtain ⟨k, hk⟩ := id hI, + refine set.nonempty.ne_empty ⟨k, _⟩, rw [derived_series_def, lie_ideal.derived_series_eq_bot_iff] at hk, exact hk, }, simp [hne], end diff --git a/src/algebra/lie/subalgebra.lean b/src/algebra/lie/subalgebra.lean index 5dfce2b1c2894..7c39d3779ae92 100644 --- a/src/algebra/lie/subalgebra.lean +++ b/src/algebra/lie/subalgebra.lean @@ -9,6 +9,9 @@ import ring_theory.noetherian /-! # Lie subalgebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines Lie subalgebras of a Lie algebra and provides basic related definitions and results. @@ -57,7 +60,7 @@ instance : set_like (lie_subalgebra R L) L := coe_injective' := λ L' L'' h, by { rcases L' with ⟨⟨⟩⟩, rcases L'' with ⟨⟨⟩⟩, congr' } } instance : add_subgroup_class (lie_subalgebra R L) L := -{ add_mem := λ L', L'.add_mem', +{ add_mem := λ L' _ _, L'.add_mem', zero_mem := λ L', L'.zero_mem', neg_mem := λ L' x hx, show -x ∈ (L' : submodule R L), from neg_mem hx } @@ -74,19 +77,22 @@ section variables {R₁ : Type*} [semiring R₁] /-- A Lie subalgebra inherits module structures from `L`. -/ -instance [has_scalar R₁ R] [module R₁ L] [is_scalar_tower R₁ R L] +instance [has_smul R₁ R] [module R₁ L] [is_scalar_tower R₁ R L] (L' : lie_subalgebra R L) : module R₁ L' := L'.to_submodule.module' -instance [has_scalar R₁ R] [has_scalar R₁ᵐᵒᵖ R] [module R₁ L] [module R₁ᵐᵒᵖ L] +instance [has_smul R₁ R] [has_smul R₁ᵐᵒᵖ R] [module R₁ L] [module R₁ᵐᵒᵖ L] [is_scalar_tower R₁ R L] [is_scalar_tower R₁ᵐᵒᵖ R L] [is_central_scalar R₁ L] (L' : lie_subalgebra R L) : is_central_scalar R₁ L' := L'.to_submodule.is_central_scalar -instance [has_scalar R₁ R] [module R₁ L] [is_scalar_tower R₁ R L] +instance [has_smul R₁ R] [module R₁ L] [is_scalar_tower R₁ R L] (L' : lie_subalgebra R L) : is_scalar_tower R₁ R L' := L'.to_submodule.is_scalar_tower +instance (L' : lie_subalgebra R L) [is_noetherian R L] : is_noetherian R L' := +is_noetherian_submodule' ↑L' + end /-- A Lie subalgebra forms a new Lie algebra. -/ @@ -239,11 +245,11 @@ end /-- A Lie algebra is equivalent to its range under an injective Lie algebra morphism. -/ noncomputable def equiv_range_of_injective (h : function.injective f) : L ≃ₗ⁅R⁆ f.range := -lie_equiv.of_bijective f.range_restrict (λ x y hxy, +lie_equiv.of_bijective f.range_restrict ⟨λ x y hxy, begin simp only [subtype.mk_eq_mk, range_restrict_apply] at hxy, exact h hxy, -end) f.surjective_range_restrict +end, f.surjective_range_restrict⟩ @[simp] lemma equiv_range_of_injective_apply (h : function.injective f) (x : L) : f.equiv_range_of_injective h x = ⟨f x, mem_range_self f x⟩ := @@ -255,7 +261,7 @@ lemma submodule.exists_lie_subalgebra_coe_eq_iff (p : submodule R L) : (∃ (K : lie_subalgebra R L), ↑K = p) ↔ ∀ (x y : L), x ∈ p → y ∈ p → ⁅x, y⁆ ∈ p := begin split, - { rintros ⟨K, rfl⟩, exact K.lie_mem', }, + { rintros ⟨K, rfl⟩ _ _, exact K.lie_mem', }, { intros h, use { lie_mem' := h, ..p }, exact lie_subalgebra.coe_to_submodule_mk p _, }, end @@ -378,6 +384,13 @@ instance : add_comm_monoid (lie_subalgebra R L) := add_zero := λ _, sup_bot_eq, add_comm := λ _ _, sup_comm, } +instance : canonically_ordered_add_monoid (lie_subalgebra R L) := +{ add_le_add_left := λ a b, sup_le_sup_left, + exists_add_of_le := λ a b h, ⟨b, (sup_eq_right.2 h).symm⟩, + le_self_add := λ a b, le_sup_left, + ..lie_subalgebra.add_comm_monoid, + ..lie_subalgebra.complete_lattice } + @[simp] lemma add_eq_sup : K + K' = K ⊔ K' := rfl @[norm_cast, simp] lemma inf_coe_to_submodule : @@ -390,11 +403,10 @@ by rw [← mem_coe_submodule, ← mem_coe_submodule, ← mem_coe_submodule, inf_ lemma eq_bot_iff : K = ⊥ ↔ ∀ (x : L), x ∈ K → x = 0 := by { rw eq_bot_iff, exact iff.rfl, } --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_bot : subsingleton (lie_subalgebra R ↥(⊥ : lie_subalgebra R L)) := +instance subsingleton_of_bot : subsingleton (lie_subalgebra R ↥(⊥ : lie_subalgebra R L)) := begin apply subsingleton_of_bot_eq_top, - ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw submodule.mem_bot at hx, subst hx, + ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw lie_subalgebra.mem_bot at hx, subst hx, simp only [true_iff, eq_self_iff_true, submodule.mk_eq_zero, mem_bot], end diff --git a/src/algebra/lie/submodule.lean b/src/algebra/lie/submodule.lean index c4794edc3829d..cf38862aee369 100644 --- a/src/algebra/lie/submodule.lean +++ b/src/algebra/lie/submodule.lean @@ -9,6 +9,9 @@ import ring_theory.noetherian /-! # Lie submodules of a Lie algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define Lie submodules and Lie ideals, we construct the lattice structure on Lie submodules and we use it to define various important operations, notably the Lie span of a subset of a Lie module. @@ -54,7 +57,7 @@ instance : set_like (lie_submodule R L M) M := coe_injective' := λ N O h, by cases N; cases O; congr' } instance : add_subgroup_class (lie_submodule R L M) M := -{ add_mem := λ N, N.add_mem', +{ add_mem := λ N _ _, N.add_mem', zero_mem := λ N, N.zero_mem', neg_mem := λ N x hx, show -x ∈ N.to_submodule, from neg_mem hx } @@ -108,15 +111,15 @@ equalities. -/ protected def copy (s : set M) (hs : s = ↑N) : lie_submodule R L M := { carrier := s, zero_mem' := hs.symm ▸ N.zero_mem', - add_mem' := hs.symm ▸ N.add_mem', + add_mem' := λ _ _, hs.symm ▸ N.add_mem', smul_mem' := hs.symm ▸ N.smul_mem', - lie_mem := hs.symm ▸ N.lie_mem, } + lie_mem := λ _ _, hs.symm ▸ N.lie_mem, } @[simp] lemma coe_copy (S : lie_submodule R L M) (s : set M) (hs : s = ↑S) : (S.copy s hs : set M) = s := rfl lemma copy_eq (S : lie_submodule R L M) (s : set M) (hs : s = ↑S) : S.copy s hs = S := -coe_submodule_injective (set_like.coe_injective hs) +set_like.coe_injective hs instance : lie_ring_module L N := { bracket := λ (x : L) (m : N), ⟨⁅x, m.val⁆, N.lie_mem m.property⟩, @@ -124,13 +127,13 @@ instance : lie_ring_module L N := lie_add := by { intros x m n, apply set_coe.ext, apply lie_add, }, leibniz_lie := by { intros x y m, apply set_coe.ext, apply leibniz_lie, }, } -instance module' {S : Type*} [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] : +instance module' {S : Type*} [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M] : module S N := N.to_submodule.module' instance : module R N := N.to_submodule.module -instance {S : Type*} [semiring S] [has_scalar S R] [has_scalar Sᵐᵒᵖ R] [module S M] [module Sᵐᵒᵖ M] +instance {S : Type*} [semiring S] [has_smul S R] [has_smul Sᵐᵒᵖ R] [module S M] [module Sᵐᵒᵖ M] [is_scalar_tower S R M] [is_scalar_tower Sᵐᵒᵖ R M] [is_central_scalar S M] : is_central_scalar S N := N.to_submodule.is_central_scalar @@ -178,6 +181,28 @@ instance : has_coe (lie_ideal R L) (lie_subalgebra R L) := ⟨λ I, lie_ideal_su @[norm_cast] lemma lie_ideal.coe_to_lie_subalgebra_to_submodule (I : lie_ideal R L) : ((I : lie_subalgebra R L) : submodule R L) = I := rfl +/-- An ideal of `L` is a Lie subalgebra of `L`, so it is a Lie ring. -/ +instance lie_ideal.lie_ring (I : lie_ideal R L) : lie_ring I := lie_subalgebra.lie_ring R L ↑I + +/-- Transfer the `lie_algebra` instance from the coercion `lie_ideal → lie_subalgebra`. -/ +instance lie_ideal.lie_algebra (I : lie_ideal R L) : lie_algebra R I := +lie_subalgebra.lie_algebra R L ↑I + +/-- Transfer the `lie_module` instance from the coercion `lie_ideal → lie_subalgebra`. -/ +instance lie_ideal.lie_ring_module {R L : Type*} [comm_ring R] [lie_ring L] [lie_algebra R L] + (I : lie_ideal R L) [lie_ring_module L M] : lie_ring_module I M := +lie_subalgebra.lie_ring_module (I : lie_subalgebra R L) + +@[simp] +theorem lie_ideal.coe_bracket_of_module {R L : Type*} [comm_ring R] [lie_ring L] [lie_algebra R L] + (I : lie_ideal R L) [lie_ring_module L M] (x : I) (m : M) : + ⁅x,m⁆ = ⁅(↑x : L),m⁆ := +lie_subalgebra.coe_bracket_of_module (I : lie_subalgebra R L) x m + +/-- Transfer the `lie_module` instance from the coercion `lie_ideal → lie_subalgebra`. -/ +instance lie_ideal.lie_module (I : lie_ideal R L) : lie_module R I M := +lie_subalgebra.lie_module (I : lie_subalgebra R L) + end lie_ideal variables {R M} @@ -186,7 +211,7 @@ lemma submodule.exists_lie_submodule_coe_eq_iff (p : submodule R M) : (∃ (N : lie_submodule R L M), ↑N = p) ↔ ∀ (x : L) (m : M), m ∈ p → ⁅x, m⁆ ∈ p := begin split, - { rintros ⟨N, rfl⟩, exact N.lie_mem, }, + { rintros ⟨N, rfl⟩ _ _, exact N.lie_mem, }, { intros h, use { lie_mem := h, ..p }, exact lie_submodule.coe_to_submodule_mk p _, }, end @@ -351,11 +376,10 @@ by { rw [← mem_coe_submodule, sup_coe_to_submodule, submodule.mem_sup], exact lemma eq_bot_iff : N = ⊥ ↔ ∀ (m : M), m ∈ N → m = 0 := by { rw eq_bot_iff, exact iff.rfl, } --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_bot : subsingleton (lie_submodule R L ↥(⊥ : lie_submodule R L M)) := +instance subsingleton_of_bot : subsingleton (lie_submodule R L ↥(⊥ : lie_submodule R L M)) := begin apply subsingleton_of_bot_eq_top, - ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw submodule.mem_bot at hx, subst hx, + ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw lie_submodule.mem_bot at hx, subst hx, simp only [true_iff, eq_self_iff_true, submodule.mk_eq_zero, lie_submodule.mem_bot], end @@ -556,6 +580,15 @@ submodule.mem_map @[simp] lemma mem_comap {m : M} : m ∈ comap f N' ↔ f m ∈ N' := iff.rfl +lemma comap_incl_eq_top : N₂.comap N.incl = ⊤ ↔ N ≤ N₂ := +by simpa only [← lie_submodule.coe_to_submodule_eq_iff, lie_submodule.coe_submodule_comap, + lie_submodule.incl_coe, lie_submodule.top_coe_submodule, submodule.comap_subtype_eq_top] + +lemma comap_incl_eq_bot : N₂.comap N.incl = ⊥ ↔ N ⊓ N₂ = ⊥ := +by simpa only [_root_.eq_bot_iff, ← lie_submodule.coe_to_submodule_eq_iff, + lie_submodule.coe_submodule_comap, lie_submodule.incl_coe, lie_submodule.bot_coe_submodule, + ← submodule.disjoint_iff_comap_eq_bot, disjoint_iff] + end lie_submodule namespace lie_ideal @@ -635,11 +668,10 @@ different (though the latter does naturally inject into the former). In other words, in general, ideals of `I`, regarded as a Lie algebra in its own right, are not the same as ideals of `L` contained in `I`. -/ --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_bot : subsingleton (lie_ideal R ↥(⊥ : lie_ideal R L)) := +instance subsingleton_of_bot : subsingleton (lie_ideal R (⊥ : lie_ideal R L)) := begin apply subsingleton_of_bot_eq_top, - ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw submodule.mem_bot at hx, subst hx, + ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw lie_submodule.mem_bot at hx, subst hx, simp only [true_iff, eq_self_iff_true, submodule.mk_eq_zero, lie_submodule.mem_bot], end @@ -842,7 +874,8 @@ def incl : I →ₗ⁅R⁆ L := (I : lie_subalgebra R L).incl @[simp] lemma incl_coe : (I.incl : I →ₗ[R] L) = (I : submodule R L).subtype := rfl @[simp] lemma comap_incl_self : comap I.incl I = ⊤ := -by { rw ← lie_submodule.coe_to_submodule_eq_iff, exact submodule.comap_subtype_self _, } +by rw [← lie_submodule.coe_to_submodule_eq_iff, lie_submodule.top_coe_submodule, + lie_ideal.comap_coe_submodule, lie_ideal.incl_coe, submodule.comap_subtype_self] @[simp] lemma ker_incl : I.incl.ker = ⊥ := by rw [← lie_submodule.coe_to_submodule_eq_iff, I.incl.ker_coe_submodule, diff --git a/src/algebra/lie/tensor_product.lean b/src/algebra/lie/tensor_product.lean index 2880b7c9aba29..1512f182e6fbc 100644 --- a/src/algebra/lie/tensor_product.lean +++ b/src/algebra/lie/tensor_product.lean @@ -8,6 +8,9 @@ import algebra.lie.abelian /-! # Tensor products of Lie modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Tensor products of Lie modules carry natural Lie module structures. ## Tags @@ -87,7 +90,7 @@ def lift : (M →ₗ[R] N →ₗ[R] P) ≃ₗ⁅R,L⁆ (M ⊗[R] N →ₗ[R] P) @[simp] lemma lift_apply (f : M →ₗ[R] N →ₗ[R] P) (m : M) (n : N) : lift R L M N P f (m ⊗ₜ n) = f m n := -lift.equiv_apply R M N P f m n +rfl /-- A weaker form of the universal property for tensor product of modules of a Lie algebra. diff --git a/src/algebra/lie/universal_enveloping.lean b/src/algebra/lie/universal_enveloping.lean index c8bed4612a51d..b9a3dbd8834e0 100644 --- a/src/algebra/lie/universal_enveloping.lean +++ b/src/algebra/lie/universal_enveloping.lean @@ -10,6 +10,9 @@ import linear_algebra.tensor_algebra.basic /-! # Universal enveloping algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a commutative ring `R` and a Lie algebra `L` over `R`, we construct the universal enveloping algebra of `L`, together with its universal property. @@ -82,11 +85,20 @@ def lift : (L →ₗ⁅R⁆ A) ≃ (universal_enveloping_algebra R L →ₐ[R] A ring_quot.lift_alg_hom R ⟨tensor_algebra.lift R (f : L →ₗ[R] A), begin intros a b h, induction h with x y, - simp [lie_ring.of_associative_ring_bracket], + simp only [lie_ring.of_associative_ring_bracket, + map_add, tensor_algebra.lift_ι_apply, lie_hom.coe_to_linear_map, lie_hom.map_lie, + map_mul, sub_add_cancel], end⟩, inv_fun := λ F, (F : universal_enveloping_algebra R L →ₗ⁅R⁆ A).comp (ι R), - left_inv := λ f, by { ext, simp [ι, mk_alg_hom], }, - right_inv := λ F, by { ext, simp [ι, mk_alg_hom], } } + left_inv := λ f, by { ext, simp only [ι, mk_alg_hom, + tensor_algebra.lift_ι_apply, lie_hom.coe_to_linear_map, linear_map.to_fun_eq_coe, + linear_map.coe_comp, lie_hom.coe_comp, alg_hom.coe_to_lie_hom, lie_hom.coe_mk, + function.comp_app, alg_hom.to_linear_map_apply, ring_quot.lift_alg_hom_mk_alg_hom_apply], }, + right_inv := λ F, by { ext, simp only [ι, mk_alg_hom, + tensor_algebra.lift_ι_apply, lie_hom.coe_to_linear_map, linear_map.to_fun_eq_coe, + linear_map.coe_comp, lie_hom.coe_linear_map_comp, alg_hom.comp_to_linear_map, + function.comp_app, alg_hom.to_linear_map_apply, ring_quot.lift_alg_hom_mk_alg_hom_apply, + alg_hom.coe_to_lie_hom, lie_hom.coe_mk], } } @[simp] lemma lift_symm_apply (F : universal_enveloping_algebra R L →ₐ[R] A) : (lift R).symm F = (F : universal_enveloping_algebra R L →ₗ⁅R⁆ A).comp (ι R) := diff --git a/src/algebra/lie/weights.lean b/src/algebra/lie/weights.lean index f2f993b8f4388..32bc6b4540044 100644 --- a/src/algebra/lie/weights.lean +++ b/src/algebra/lie/weights.lean @@ -6,13 +6,17 @@ Authors: Oliver Nash import algebra.lie.nilpotent import algebra.lie.tensor_product import algebra.lie.character +import algebra.lie.engel import algebra.lie.cartan_subalgebra -import linear_algebra.eigenspace +import linear_algebra.eigenspace.basic import ring_theory.tensor_product /-! # Weights and roots of Lie modules and Lie algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Just as a key tool when studying the behaviour of a linear operator is to decompose the space on which it acts into a sum of (generalised) eigenspaces, a key tool when studying a representation `M` of Lie algebra `L` is to decompose `M` into a sum of simultaneous eigenspaces of `x` as `x` ranges @@ -34,6 +38,7 @@ Basic definitions and properties of the above ideas are provided in this file. * `lie_algebra.is_root` * `lie_algebra.root_space_weight_space_product` * `lie_algebra.root_space_product` + * `lie_algebra.zero_root_subalgebra_eq_iff_is_cartan` ## References @@ -71,7 +76,17 @@ lemma mem_pre_weight_space (χ : L → R) (m : M) : m ∈ pre_weight_space M χ ↔ ∀ x, ∃ (k : ℕ), ((to_endomorphism R L M x - (χ x) • 1)^k) m = 0 := by simp [pre_weight_space, -linear_map.pow_apply] -variables (L) +variables (R) + +lemma exists_pre_weight_space_zero_le_ker_of_is_noetherian [is_noetherian R M] (x : L) : + ∃ (k : ℕ), pre_weight_space M (0 : L → R) ≤ ((to_endomorphism R L M x)^k).ker := +begin + use (to_endomorphism R L M x).maximal_generalized_eigenspace_index 0, + simp only [← module.End.generalized_eigenspace_zero, pre_weight_space, pi.zero_apply, infi_le, + ← (to_endomorphism R L M x).maximal_generalized_eigenspace_eq], +end + +variables {R} (L) /-- See also `bourbaki1975b` Chapter VII §1.1, Proposition 2 (ii). -/ protected lemma weight_vector_multiplication (M₁ : Type w₁) (M₂ : Type w₂) (M₃ : Type w₃) @@ -118,8 +133,8 @@ begin linear_map.add_apply, lie_module_hom.map_sub, linear_map.sub_apply, linear_map.ltensor_tmul, algebra_tensor_module.curry_apply, curry_apply, linear_map.to_fun_eq_coe, linear_map.coe_restrict_scalars_eq_coe], abel, }, - suffices : ∃ k, ((f₁ + f₂)^k) (m₁ ⊗ₜ m₂) = 0, - { obtain ⟨k, hk⟩ := this, use k, + rsuffices ⟨k, hk⟩ : ∃ k, ((f₁ + f₂)^k) (m₁ ⊗ₜ m₂) = 0, + { use k, rw [← linear_map.comp_apply, linear_map.commute_pow_left_of_commute h_comm_square, linear_map.comp_apply, hk, linear_map.map_zero], }, @@ -230,6 +245,27 @@ lemma is_weight_zero_of_nilpotent is_weight (⊤ : lie_subalgebra R L) M 0 := by { rw [is_weight, lie_hom.coe_zero, zero_weight_space_eq_top_of_nilpotent], exact top_ne_bot, } +/-- A (nilpotent) Lie algebra acts nilpotently on the zero weight space of a Noetherian Lie +module. -/ +lemma is_nilpotent_to_endomorphism_weight_space_zero + [lie_algebra.is_nilpotent R L] [is_noetherian R M] (x : L) : + _root_.is_nilpotent $ to_endomorphism R L (weight_space M (0 : L → R)) x := +begin + obtain ⟨k, hk⟩ := exists_pre_weight_space_zero_le_ker_of_is_noetherian R M x, + use k, + ext ⟨m, hm⟩, + rw [linear_map.zero_apply, lie_submodule.coe_zero, submodule.coe_eq_zero, + ← lie_submodule.to_endomorphism_restrict_eq_to_endomorphism, linear_map.pow_restrict, + ← set_like.coe_eq_coe, linear_map.restrict_apply, submodule.coe_mk, submodule.coe_zero], + exact hk hm, +end + +/-- By Engel's theorem, when the Lie algebra is Noetherian, the zero weight space of a Noetherian +Lie module is nilpotent. -/ +instance [lie_algebra.is_nilpotent R L] [is_noetherian R L] [is_noetherian R M] : + is_nilpotent R L (weight_space M (0 : L → R)) := +is_nilpotent_iff_forall.mpr $ is_nilpotent_to_endomorphism_weight_space_zero M + end lie_module namespace lie_algebra @@ -412,14 +448,30 @@ begin lie_subalgebra.coe_bracket_of_module, submodule.coe_mk, hk], end -/-- In finite dimensions over a field (and possibly more generally) Engel's theorem shows that -the converse of this is also true, i.e., -`zero_root_subalgebra R L H = H ↔ lie_subalgebra.is_cartan_subalgebra H`. -/ -lemma zero_root_subalgebra_is_cartan_of_eq (h : zero_root_subalgebra R L H = H) : - lie_subalgebra.is_cartan_subalgebra H := +/-- If the zero root subalgebra of a nilpotent Lie subalgebra `H` is just `H` then `H` is a Cartan +subalgebra. + +When `L` is Noetherian, it follows from Engel's theorem that the converse holds. See +`lie_algebra.zero_root_subalgebra_eq_iff_is_cartan` -/ +lemma is_cartan_of_zero_root_subalgebra_eq (h : zero_root_subalgebra R L H = H) : + H.is_cartan_subalgebra := { nilpotent := infer_instance, self_normalizing := by { rw ← h, exact zero_root_subalgebra_normalizer_eq_self R L H, } } +@[simp] lemma zero_root_subalgebra_eq_of_is_cartan (H : lie_subalgebra R L) + [H.is_cartan_subalgebra] [is_noetherian R L] : + zero_root_subalgebra R L H = H := +begin + refine le_antisymm _ (le_zero_root_subalgebra R L H), + suffices : root_space H 0 ≤ H.to_lie_submodule, { exact λ x hx, this hx, }, + obtain ⟨k, hk⟩ := (root_space H 0).is_nilpotent_iff_exists_self_le_ucs.mp (by apply_instance), + exact hk.trans (lie_submodule.ucs_le_of_normalizer_eq_self (by simp) k), +end + +lemma zero_root_subalgebra_eq_iff_is_cartan [is_noetherian R L] : + zero_root_subalgebra R L H = H ↔ H.is_cartan_subalgebra := +⟨is_cartan_of_zero_root_subalgebra_eq R L H, by { introsI, simp, }⟩ + end lie_algebra namespace lie_module diff --git a/src/algebra/linear_recurrence.lean b/src/algebra/linear_recurrence.lean index be9b92321b59b..1e9b19c88f546 100644 --- a/src/algebra/linear_recurrence.lean +++ b/src/algebra/linear_recurrence.lean @@ -9,6 +9,9 @@ import linear_algebra.dimension /-! # Linear recurrence +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Informally, a "linear recurrence" is an assertion of the form `∀ n : ℕ, u (n + d) = a 0 * u n + a 1 * u (n+1) + ... + a (d-1) * u (n+d-1)`, where `u` is a sequence, `d` is the *order* of the recurrence and the `a i` @@ -167,15 +170,20 @@ def tuple_succ : (fin E.order → α) →ₗ[α] (fin E.order → α) := end comm_semiring -section field +section strong_rank_condition -variables {α : Type*} [field α] (E : linear_recurrence α) +-- note: `strong_rank_condition` is the same as `nontrivial` on `comm_ring`s, but that result, +-- `comm_ring_strong_rank_condition`, is in a much later file. +variables {α : Type*} [comm_ring α] [strong_rank_condition α] (E : linear_recurrence α) /-- The dimension of `E.sol_space` is `E.order`. -/ -lemma sol_space_dim : module.rank α E.sol_space = E.order := -@dim_fin_fun α _ E.order ▸ E.to_init.dim_eq +lemma sol_space_rank : module.rank α E.sol_space = E.order := +begin + letI := nontrivial_of_invariant_basis_number α, + exact @rank_fin_fun α _ _ E.order ▸ E.to_init.rank_eq +end -end field +end strong_rank_condition section comm_ring diff --git a/src/algebra/modeq.lean b/src/algebra/modeq.lean new file mode 100644 index 0000000000000..68291700694b0 --- /dev/null +++ b/src/algebra/modeq.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2023 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.int.modeq +import group_theory.quotient_group + +/-! +# Equality modulo an element + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines equality modulo an element in a commutative group. + +## Main definitions + +* `a ≡ b [PMOD p]`: `a` and `b` are congruent modulo a`p`. + +## See also + +`smodeq` is a generalisation to arbitrary submodules. + +## TODO + +Delete `int.modeq` in favour of `add_comm_group.modeq`. Generalise `smodeq` to `add_subgroup` and +redefine `add_comm_group.modeq` using it. Once this is done, we can rename `add_comm_group.modeq` +to `add_subgroup.modeq` and multiplicativise it. Longer term, we could generalise to submonoids and +also unify with `nat.modeq`. +-/ + +namespace add_comm_group +variables {α : Type*} + +section add_comm_group +variables [add_comm_group α] {p a a₁ a₂ b b₁ b₂ c : α} {n : ℕ} {z : ℤ} + +/-- `a ≡ b [PMOD p]` means that `b` is congruent to `a` modulo `p`. + +Equivalently (as shown in `algebra.order.to_interval_mod`), `b` does not lie in the open interval +`(a, a + p)` modulo `p`, or `to_Ico_mod hp a` disagrees with `to_Ioc_mod hp a` at `b`, or +`to_Ico_div hp a` disagrees with `to_Ioc_div hp a` at `b`. -/ +def modeq (p a b : α) : Prop := ∃ z : ℤ, b - a = z • p + +notation a ` ≡ `:50 b ` [PMOD `:50 p `]`:0 := modeq p a b + +@[refl, simp] lemma modeq_refl (a : α) : a ≡ a [PMOD p] := ⟨0, by simp⟩ + +lemma modeq_rfl : a ≡ a [PMOD p] := modeq_refl _ + +lemma modeq_comm : a ≡ b [PMOD p] ↔ b ≡ a [PMOD p] := +(equiv.neg _).exists_congr_left.trans $ by simp [modeq, ←neg_eq_iff_eq_neg] + +alias modeq_comm ↔ modeq.symm _ + +attribute [symm] modeq.symm + +@[trans] lemma modeq.trans : a ≡ b [PMOD p] → b ≡ c [PMOD p] → a ≡ c [PMOD p] := +λ ⟨m, hm⟩ ⟨n, hn⟩, ⟨m + n, by simp [add_smul, ←hm, ←hn]⟩ + +instance : is_refl _ (modeq p) := ⟨modeq_refl⟩ + +@[simp] lemma neg_modeq_neg : -a ≡ -b [PMOD p] ↔ a ≡ b [PMOD p] := +modeq_comm.trans $ by simp [modeq] + +alias neg_modeq_neg ↔ modeq.of_neg modeq.neg + +@[simp] lemma modeq_neg : a ≡ b [PMOD -p] ↔ a ≡ b [PMOD p] := +modeq_comm.trans $ by simp [modeq, ←neg_eq_iff_eq_neg] + +alias modeq_neg ↔ modeq.of_neg' modeq.neg' + +lemma modeq_sub (a b : α) : a ≡ b [PMOD b - a] := ⟨1, (one_smul _ _).symm⟩ + +@[simp] lemma modeq_zero : a ≡ b [PMOD 0] ↔ a = b := by simp [modeq, sub_eq_zero, eq_comm] + +@[simp] lemma self_modeq_zero : p ≡ 0 [PMOD p] := ⟨-1, by simp⟩ + +@[simp] lemma zsmul_modeq_zero (z : ℤ) : z • p ≡ 0 [PMOD p] := ⟨-z, by simp⟩ +lemma add_zsmul_modeq (z : ℤ) : a + z • p ≡ a [PMOD p] := ⟨-z, by simp⟩ +lemma zsmul_add_modeq (z : ℤ) : z • p + a ≡ a [PMOD p] := ⟨-z, by simp⟩ +lemma add_nsmul_modeq (n : ℕ) : a + n • p ≡ a [PMOD p] := ⟨-n, by simp⟩ +lemma nsmul_add_modeq (n : ℕ) : n • p + a ≡ a [PMOD p] := ⟨-n, by simp⟩ + +namespace modeq + +protected lemma add_zsmul (z : ℤ) : a ≡ b [PMOD p] → a + z • p ≡ b [PMOD p] := +(add_zsmul_modeq _).trans +protected lemma zsmul_add (z : ℤ) : a ≡ b [PMOD p] → z • p + a ≡ b [PMOD p] := +(zsmul_add_modeq _).trans +protected lemma add_nsmul (n : ℕ) : a ≡ b [PMOD p] → a + n • p ≡ b [PMOD p] := +(add_nsmul_modeq _).trans +protected lemma nsmul_add (n : ℕ) : a ≡ b [PMOD p] → n • p + a ≡ b [PMOD p] := +(nsmul_add_modeq _).trans + +protected lemma of_zsmul : a ≡ b [PMOD (z • p)] → a ≡ b [PMOD p] := +λ ⟨m, hm⟩, ⟨m * z, by rwa [mul_smul]⟩ + +protected lemma of_nsmul : a ≡ b [PMOD (n • p)] → a ≡ b [PMOD p] := +λ ⟨m, hm⟩, ⟨m * n, by rwa [mul_smul, coe_nat_zsmul]⟩ + +protected lemma zsmul : a ≡ b [PMOD p] → z • a ≡ z • b [PMOD (z • p)] := +Exists.imp $ λ m hm, by rw [←smul_sub, hm, smul_comm] + +protected lemma nsmul : a ≡ b [PMOD p] → n • a ≡ n • b [PMOD (n • p)] := +Exists.imp $ λ m hm, by rw [←smul_sub, hm, smul_comm] + +end modeq + +@[simp] lemma zsmul_modeq_zsmul [no_zero_smul_divisors ℤ α] (hn : z ≠ 0) : + z • a ≡ z • b [PMOD (z • p)] ↔ a ≡ b [PMOD p] := +exists_congr $ λ m, by rw [←smul_sub, smul_comm, smul_right_inj hn]; apply_instance + +@[simp] lemma nsmul_modeq_nsmul [no_zero_smul_divisors ℕ α] (hn : n ≠ 0) : + n • a ≡ n • b [PMOD (n • p)] ↔ a ≡ b [PMOD p] := +exists_congr $ λ m, by rw [←smul_sub, smul_comm, smul_right_inj hn]; apply_instance + +alias zsmul_modeq_zsmul ↔ modeq.zsmul_cancel _ +alias nsmul_modeq_nsmul ↔ modeq.nsmul_cancel _ + +namespace modeq + +@[simp] protected lemma add_iff_left : + a₁ ≡ b₁ [PMOD p] → (a₁ + a₂ ≡ b₁ + b₂ [PMOD p] ↔ a₂ ≡ b₂ [PMOD p]) := +λ ⟨m, hm⟩, (equiv.add_left m).symm.exists_congr_left.trans $ + by simpa [add_sub_add_comm, hm, add_smul] + +@[simp] protected lemma add_iff_right : + a₂ ≡ b₂ [PMOD p] → (a₁ + a₂ ≡ b₁ + b₂ [PMOD p] ↔ a₁ ≡ b₁ [PMOD p]) := +λ ⟨m, hm⟩, (equiv.add_right m).symm.exists_congr_left.trans $ + by simpa [add_sub_add_comm, hm, add_smul] + +@[simp] protected lemma sub_iff_left : + a₁ ≡ b₁ [PMOD p] → (a₁ - a₂ ≡ b₁ - b₂ [PMOD p] ↔ a₂ ≡ b₂ [PMOD p]) := +λ ⟨m, hm⟩, (equiv.sub_left m).symm.exists_congr_left.trans $ + by simpa [sub_sub_sub_comm, hm, sub_smul] + +@[simp] protected lemma sub_iff_right : + a₂ ≡ b₂ [PMOD p] → (a₁ - a₂ ≡ b₁ - b₂ [PMOD p] ↔ a₁ ≡ b₁ [PMOD p]) := +λ ⟨m, hm⟩, (equiv.sub_right m).symm.exists_congr_left.trans $ + by simpa [sub_sub_sub_comm, hm, sub_smul] + +alias modeq.add_iff_left ↔ add_left_cancel add +alias modeq.add_iff_right ↔ add_right_cancel _ +alias modeq.sub_iff_left ↔ sub_left_cancel sub +alias modeq.sub_iff_right ↔ sub_right_cancel _ + +attribute [protected] add_left_cancel add_right_cancel add sub_left_cancel sub_right_cancel sub + +protected lemma add_left (c : α) (h : a ≡ b [PMOD p]) : c + a ≡ c + b [PMOD p] := modeq_rfl.add h +protected lemma sub_left (c : α) (h : a ≡ b [PMOD p]) : c - a ≡ c - b [PMOD p] := modeq_rfl.sub h +protected lemma add_right (c : α) (h : a ≡ b [PMOD p]) : a + c ≡ b + c [PMOD p] := h.add modeq_rfl +protected lemma sub_right (c : α) (h : a ≡ b [PMOD p]) : a - c ≡ b - c [PMOD p] := h.sub modeq_rfl + +protected lemma add_left_cancel' (c : α) : c + a ≡ c + b [PMOD p] → a ≡ b [PMOD p] := +modeq_rfl.add_left_cancel + +protected lemma add_right_cancel' (c : α) : a + c ≡ b + c [PMOD p] → a ≡ b [PMOD p] := +modeq_rfl.add_right_cancel + +protected lemma sub_left_cancel' (c : α) : c - a ≡ c - b [PMOD p] → a ≡ b [PMOD p] := +modeq_rfl.sub_left_cancel + +protected lemma sub_right_cancel' (c : α) : a - c ≡ b - c [PMOD p] → a ≡ b [PMOD p] := +modeq_rfl.sub_right_cancel + +end modeq + +lemma modeq_sub_iff_add_modeq' : a ≡ b - c [PMOD p] ↔ c + a ≡ b [PMOD p] := by simp [modeq, sub_sub] +lemma modeq_sub_iff_add_modeq : a ≡ b - c [PMOD p] ↔ a + c ≡ b [PMOD p] := +modeq_sub_iff_add_modeq'.trans $ by rw add_comm +lemma sub_modeq_iff_modeq_add' : a - b ≡ c [PMOD p] ↔ a ≡ b + c [PMOD p] := +modeq_comm.trans $ modeq_sub_iff_add_modeq'.trans modeq_comm +lemma sub_modeq_iff_modeq_add : a - b ≡ c [PMOD p] ↔ a ≡ c + b [PMOD p] := +modeq_comm.trans $ modeq_sub_iff_add_modeq.trans modeq_comm + +@[simp] lemma sub_modeq_zero : a - b ≡ 0 [PMOD p] ↔ a ≡ b [PMOD p] := +by simp [sub_modeq_iff_modeq_add] + +@[simp] lemma add_modeq_left : a + b ≡ a [PMOD p] ↔ b ≡ 0 [PMOD p] := +by simp [←modeq_sub_iff_add_modeq'] + +@[simp] lemma add_modeq_right : a + b ≡ b [PMOD p] ↔ a ≡ 0 [PMOD p] := +by simp [←modeq_sub_iff_add_modeq] + +lemma modeq_iff_eq_add_zsmul : a ≡ b [PMOD p] ↔ ∃ z : ℤ, b = a + z • p := +by simp_rw [modeq, sub_eq_iff_eq_add'] + +lemma not_modeq_iff_ne_add_zsmul : ¬a ≡ b [PMOD p] ↔ ∀ z : ℤ, b ≠ a + z • p := +by rw [modeq_iff_eq_add_zsmul, not_exists] + +lemma modeq_iff_eq_mod_zmultiples : a ≡ b [PMOD p] ↔ (b : α ⧸ add_subgroup.zmultiples p) = a := +by simp_rw [modeq_iff_eq_add_zsmul, quotient_add_group.eq_iff_sub_mem, + add_subgroup.mem_zmultiples_iff, eq_sub_iff_add_eq', eq_comm] + +lemma not_modeq_iff_ne_mod_zmultiples : + ¬a ≡ b [PMOD p] ↔ (b : α ⧸ add_subgroup.zmultiples p) ≠ a := +modeq_iff_eq_mod_zmultiples.not + +end add_comm_group + +@[simp] lemma modeq_iff_int_modeq {a b z : ℤ} : a ≡ b [PMOD z] ↔ a ≡ b [ZMOD z] := +by simp [modeq, dvd_iff_exists_eq_mul_left, int.modeq_iff_dvd] + +section add_comm_group_with_one +variables [add_comm_group_with_one α] [char_zero α] + +@[simp, norm_cast] +lemma int_cast_modeq_int_cast {a b z : ℤ} : a ≡ b [PMOD (z : α)] ↔ a ≡ b [PMOD z] := +by simp_rw [modeq, ←int.cast_mul_eq_zsmul_cast]; norm_cast + +@[simp, norm_cast] +lemma nat_cast_modeq_nat_cast {a b n : ℕ} : a ≡ b [PMOD (n : α)] ↔ a ≡ b [MOD n] := +by simp_rw [←int.coe_nat_modeq_iff, ←modeq_iff_int_modeq, ←@int_cast_modeq_int_cast α, + int.cast_coe_nat] + +alias int_cast_modeq_int_cast ↔ modeq.of_int_cast modeq.int_cast +alias nat_cast_modeq_nat_cast ↔ _root_.nat.modeq.of_nat_cast modeq.nat_cast + +end add_comm_group_with_one +end add_comm_group diff --git a/src/algebra/module/algebra.lean b/src/algebra/module/algebra.lean index 129e92cffef04..b6659e7d6af38 100644 --- a/src/algebra/module/algebra.lean +++ b/src/algebra/module/algebra.lean @@ -8,6 +8,9 @@ import algebra.algebra.basic /-! # Additional facts about modules over algebras. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace linear_map diff --git a/src/algebra/module/basic.lean b/src/algebra/module/basic.lean index 4ced2e4b03436..243f4ca3953a4 100644 --- a/src/algebra/module/basic.lean +++ b/src/algebra/module/basic.lean @@ -3,15 +3,17 @@ Copyright (c) 2015 Nathaniel Thomas. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro -/ -import algebra.big_operators.basic + import algebra.smul_with_zero -import group_theory.group_action.big_operators import group_theory.group_action.group -import tactic.norm_num +import tactic.abel /-! # Modules over a ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define * `module R M` : an additive commutative monoid `M` is a `module` over a @@ -37,7 +39,6 @@ semimodule, module, vector space -/ open function -open_locale big_operators universes u v variables {α R k S M M₂ M₃ ι : Type*} @@ -71,6 +72,9 @@ instance add_comm_monoid.nat_module : module ℕ M := zero_smul := zero_nsmul, add_smul := λ r s x, add_nsmul x r s } +lemma add_monoid.End.nat_cast_def (n : ℕ) : + (↑n : add_monoid.End M) = distrib_mul_action.to_add_monoid_End ℕ M n := rfl + theorem add_smul : (r + s) • x = r • x + s • x := module.add_smul r s x lemma convex.combo_self {a b : R} (h : a + b = 1) (x : M) : a • x + b • x = x := @@ -89,7 +93,7 @@ convex.combo_self inv_of_two_add_inv_of_two _ /-- Pullback a `module` structure along an injective additive monoid homomorphism. See note [reducible non-instances]. -/ @[reducible] -protected def function.injective.module [add_comm_monoid M₂] [has_scalar R M₂] (f : M₂ →+ M) +protected def function.injective.module [add_comm_monoid M₂] [has_smul R M₂] (f : M₂ →+ M) (hf : injective f) (smul : ∀ (c : R) x, f (c • x) = c • f x) : module R M₂ := { smul := (•), @@ -98,7 +102,7 @@ protected def function.injective.module [add_comm_monoid M₂] [has_scalar R M .. hf.distrib_mul_action f smul } /-- Pushforward a `module` structure along a surjective additive monoid homomorphism. -/ -protected def function.surjective.module [add_comm_monoid M₂] [has_scalar R M₂] (f : M →+ M₂) +protected def function.surjective.module [add_comm_monoid M₂] [has_smul R M₂] (f : M →+ M₂) (hf : surjective f) (smul : ∀ (c : R) x, f (c • x) = c • f x) : module R M₂ := { smul := (•), @@ -113,7 +117,7 @@ See also `function.surjective.mul_action_left` and `function.surjective.distrib_ -/ @[reducible] def function.surjective.module_left {R S M : Type*} [semiring R] [add_comm_monoid M] - [module R M] [semiring S] [has_scalar S M] + [module R M] [semiring S] [has_smul S M] (f : R →+* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) : module S M := { smul := (•), @@ -128,7 +132,7 @@ variables {R} (M) See note [reducible non-instances]. -/ @[reducible] def module.comp_hom [semiring S] (f : S →+* R) : module S M := -{ smul := has_scalar.comp.smul f, +{ smul := has_smul.comp.smul f, add_smul := λ r s x, by simp [add_smul], .. mul_action_with_zero.comp_hom M f.to_monoid_with_zero_hom, .. distrib_mul_action.comp_hom M (f : S →* R) } @@ -157,15 +161,9 @@ variables {R M} lemma module.eq_zero_of_zero_eq_one (zero_eq_one : (0 : R) = 1) : x = 0 := by rw [←one_smul R x, ←zero_eq_one, zero_smul] -lemma list.sum_smul {l : list R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum := -((smul_add_hom R M).flip x).map_list_sum l - -lemma multiset.sum_smul {l : multiset R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum := -((smul_add_hom R M).flip x).map_multiset_sum l - -lemma finset.sum_smul {f : ι → R} {s : finset ι} {x : M} : - (∑ i in s, f i) • x = (∑ i in s, (f i) • x) := -((smul_add_hom R M).flip x).map_sum f s +@[simp] lemma smul_add_one_sub_smul {R : Type*} [ring R] [module R M] + {r : R} {m : M} : r • m + (1 - r) • m = m := +by rw [← add_smul, add_sub_cancel'_right, one_smul] end add_comm_monoid @@ -197,12 +195,15 @@ instance add_comm_group.int_module : module ℤ M := zero_smul := zero_zsmul, add_smul := λ r s x, add_zsmul x r s } +lemma add_monoid.End.int_cast_def (z : ℤ) : + (↑z : add_monoid.End M) = distrib_mul_action.to_add_monoid_End ℤ M z := rfl + /-- A structure containing most informations as in a module, except the fields `zero_smul` and `smul_zero`. As these fields can be deduced from the other ones when `M` is an `add_comm_group`, this provides a way to construct a module structure by checking less properties, in `module.of_core`. -/ -@[nolint has_inhabited_instance] -structure module.core extends has_scalar R M := +@[nolint has_nonempty_instance] +structure module.core extends has_smul R M := (smul_add : ∀(r : R) (x y : M), r • (x + y) = r • x + r • y) (add_smul : ∀(r s : R) (x : M), (r + s) • x = r • x + s • x) (mul_smul : ∀(r s : R) (x : M), (r * s) • x = r • s • x) @@ -213,11 +214,17 @@ variables {R M} /-- Define `module` without proving `zero_smul` and `smul_zero` by using an auxiliary structure `module.core`, when the underlying space is an `add_comm_group`. -/ def module.of_core (H : module.core R M) : module R M := -by letI := H.to_has_scalar; exact +by letI := H.to_has_smul; exact { zero_smul := λ x, (add_monoid_hom.mk' (λ r : R, r • x) (λ r s, H.add_smul r s x)).map_zero, smul_zero := λ r, (add_monoid_hom.mk' ((•) r) (H.smul_add r)).map_zero, ..H } +lemma convex.combo_eq_smul_sub_add [module R M] {x y : M} {a b : R} (h : a + b = 1) : + a • x + b • y = b • (y - x) + x := +calc + a • x + b • y = (b • y - b • x) + (a • x + b • x) : by abel + ... = b • (y - x) + x : by rw [smul_sub, convex.combo_self h] + end add_comm_group /-- A variant of `module.ext` that's convenient for term-mode. -/ @@ -234,7 +241,7 @@ section module variables [ring R] [add_comm_group M] [module R M] (r s : R) (x y : M) @[simp] theorem neg_smul : -r • x = - (r • x) := -eq_neg_of_add_eq_zero (by rw [← add_smul, add_left_neg, zero_smul]) +eq_neg_of_add_eq_zero_left $ by rw [← add_smul, add_left_neg, zero_smul] @[simp] lemma neg_smul_neg : -r • -x = r • x := by rw [neg_smul, smul_neg, neg_neg] @@ -256,14 +263,13 @@ as an instance because Lean has no way to guess `R`. -/ protected theorem module.subsingleton (R M : Type*) [semiring R] [subsingleton R] [add_comm_monoid M] [module R M] : subsingleton M := -⟨λ x y, by rw [← one_smul R x, ← one_smul R y, subsingleton.elim (1:R) 0, zero_smul, zero_smul]⟩ +mul_action_with_zero.subsingleton R M /-- A semiring is `nontrivial` provided that there exists a nontrivial module over this semiring. -/ protected theorem module.nontrivial (R M : Type*) [semiring R] [nontrivial M] [add_comm_monoid M] [module R M] : nontrivial R := -(subsingleton_or_nontrivial R).resolve_left $ λ hR, not_subsingleton M $ - by exactI module.subsingleton R M +mul_action_with_zero.nontrivial R M @[priority 910] -- see Note [lower instance priority] instance semiring.to_module [semiring R] : module R R := @@ -297,7 +303,7 @@ instance ring_hom.apply_distrib_mul_action [semiring R] : distrib_mul_action (R f • a = f a := rfl /-- `ring_hom.apply_distrib_mul_action` is faithful. -/ -instance ring_hom.apply_has_faithful_scalar [semiring R] : has_faithful_scalar (R →+* R) R := +instance ring_hom.apply_has_faithful_smul [semiring R] : has_faithful_smul (R →+* R) R := ⟨ring_hom.ext⟩ section add_comm_monoid @@ -320,7 +326,7 @@ end mathlib all `add_comm_monoid`s should normally have exactly one `ℕ`-module structure by design. -/ lemma nat_smul_eq_nsmul (h : module ℕ M) (n : ℕ) (x : M) : - @has_scalar.smul ℕ M h.to_has_scalar n x = n • x := + @has_smul.smul ℕ M h.to_has_smul n x = n • x := by rw [nsmul_eq_smul_cast ℕ n x, nat.cast_id] /-- All `ℕ`-module structures are equal. Not an instance since in mathlib all `add_comm_monoid` @@ -353,7 +359,7 @@ end /-- Convert back any exotic `ℤ`-smul to the canonical instance. This should not be needed since in mathlib all `add_comm_group`s should normally have exactly one `ℤ`-module structure by design. -/ lemma int_smul_eq_zsmul (h : module ℤ M) (n : ℤ) (x : M) : - @has_scalar.smul ℤ M h.to_has_scalar n x = n • x := + @has_smul.smul ℤ M h.to_has_smul n x = n • x := by rw [zsmul_eq_smul_cast ℤ n x, int.cast_id] /-- All `ℤ`-module structures are equal. Not an instance since in mathlib all `add_comm_group` @@ -375,27 +381,32 @@ lemma map_nat_cast_smul [add_comm_monoid M] [add_comm_monoid M₂] {F : Type*} f ((x : R) • a) = (x : S) • f a := by simp only [←nsmul_eq_smul_cast, map_nsmul] -lemma map_inv_int_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*} +lemma map_inv_nat_cast_smul [add_comm_monoid M] [add_comm_monoid M₂] {F : Type*} [add_monoid_hom_class F M M₂] (f : F) - (R S : Type*) [division_ring R] [division_ring S] [module R M] [module S M₂] - (n : ℤ) (x : M) : + (R S : Type*) [division_semiring R] [division_semiring S] [module R M] [module S M₂] + (n : ℕ) (x : M) : f ((n⁻¹ : R) • x) = (n⁻¹ : S) • f x := begin by_cases hR : (n : R) = 0; by_cases hS : (n : S) = 0, { simp [hR, hS] }, { suffices : ∀ y, f y = 0, by simp [this], clear x, intro x, - rw [← inv_smul_smul₀ hS (f x), ← map_int_cast_smul f R S], simp [hR] }, + rw [← inv_smul_smul₀ hS (f x), ← map_nat_cast_smul f R S], simp [hR] }, { suffices : ∀ y, f y = 0, by simp [this], clear x, intro x, - rw [← smul_inv_smul₀ hR x, map_int_cast_smul f R S, hS, zero_smul] }, - { rw [← inv_smul_smul₀ hS (f _), ← map_int_cast_smul f R S, smul_inv_smul₀ hR] } + rw [← smul_inv_smul₀ hR x, map_nat_cast_smul f R S, hS, zero_smul] }, + { rw [← inv_smul_smul₀ hS (f _), ← map_nat_cast_smul f R S, smul_inv_smul₀ hR] } end -lemma map_inv_nat_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*} +lemma map_inv_int_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*} [add_monoid_hom_class F M M₂] (f : F) (R S : Type*) [division_ring R] [division_ring S] [module R M] [module S M₂] - (n : ℕ) (x : M) : - f ((n⁻¹ : R) • x) = (n⁻¹ : S) • f x := -map_inv_int_cast_smul f R S n x + (z : ℤ) (x : M) : + f ((z⁻¹ : R) • x) = (z⁻¹ : S) • f x := +begin + obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg, + { rw [int.cast_coe_nat, int.cast_coe_nat, map_inv_nat_cast_smul _ R S] }, + { simp_rw [int.cast_neg, int.cast_coe_nat, inv_neg, neg_smul, map_neg, + map_inv_nat_cast_smul _ R S] }, +end lemma map_rat_cast_smul [add_comm_group M] [add_comm_group M₂] {F : Type*} [add_monoid_hom_class F M M₂] (f : F) @@ -410,13 +421,18 @@ lemma map_rat_smul [add_comm_group M] [add_comm_group M₂] [module ℚ M] [modu f (c • x) = c • f x := rat.cast_id c ▸ map_rat_cast_smul f ℚ ℚ c x -/-- There can be at most one `module ℚ E` structure on an additive commutative group. This is not -an instance because `simp` becomes very slow if we have many `subsingleton` instances, -see [gh-6025]. -/ -lemma subsingleton_rat_module (E : Type*) [add_comm_group E] : subsingleton (module ℚ E) := +/-- There can be at most one `module ℚ E` structure on an additive commutative group. -/ +instance subsingleton_rat_module (E : Type*) [add_comm_group E] : subsingleton (module ℚ E) := ⟨λ P Q, module.ext' P Q $ λ r x, @map_rat_smul _ _ _ _ P Q _ _ (add_monoid_hom.id E) r x⟩ +/-- If `E` is a vector space over two division semirings `R` and `S`, then scalar multiplications +agree on inverses of natural numbers in `R` and `S`. -/ +lemma inv_nat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_monoid E] [division_semiring R] + [division_semiring S] [module R E] [module S E] (n : ℕ) (x : E) : + (n⁻¹ : R) • x = (n⁻¹ : S) • x := +map_inv_nat_cast_smul (add_monoid_hom.id E) R S n x + /-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications agree on inverses of integer numbers in `R` and `S`. -/ lemma inv_int_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R] @@ -424,27 +440,20 @@ lemma inv_int_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [divisio (n⁻¹ : R) • x = (n⁻¹ : S) • x := map_inv_int_cast_smul (add_monoid_hom.id E) R S n x -/-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications -agree on inverses of natural numbers in `R` and `S`. -/ -lemma inv_nat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R] - [division_ring S] [module R E] [module S E] (n : ℕ) (x : E) : - (n⁻¹ : R) • x = (n⁻¹ : S) • x := -map_inv_nat_cast_smul (add_monoid_hom.id E) R S n x +/-- If `E` is a vector space over a division ring `R` and has a monoid action by `α`, then that +action commutes by scalar multiplication of inverses of natural numbers in `R`. -/ +lemma inv_nat_cast_smul_comm {α E : Type*} (R : Type*) [add_comm_monoid E] [division_semiring R] + [monoid α] [module R E] [distrib_mul_action α E] (n : ℕ) (s : α) (x : E) : + (n⁻¹ : R) • s • x = s • (n⁻¹ : R) • x := +(map_inv_nat_cast_smul (distrib_mul_action.to_add_monoid_hom E s) R R n x).symm -/-- If `E` is a vector space over a division rings `R` and has a monoid action by `α`, then that +/-- If `E` is a vector space over a division ring `R` and has a monoid action by `α`, then that action commutes by scalar multiplication of inverses of integers in `R` -/ lemma inv_int_cast_smul_comm {α E : Type*} (R : Type*) [add_comm_group E] [division_ring R] [monoid α] [module R E] [distrib_mul_action α E] (n : ℤ) (s : α) (x : E) : (n⁻¹ : R) • s • x = s • (n⁻¹ : R) • x := (map_inv_int_cast_smul (distrib_mul_action.to_add_monoid_hom E s) R R n x).symm -/-- If `E` is a vector space over a division rings `R` and has a monoid action by `α`, then that -action commutes by scalar multiplication of inverses of natural numbers in `R`. -/ -lemma inv_nat_cast_smul_comm {α E : Type*} (R : Type*) [add_comm_group E] [division_ring R] - [monoid α] [module R E] [distrib_mul_action α E] (n : ℕ) (s : α) (x : E) : - (n⁻¹ : R) • s • x = s • (n⁻¹ : R) • x := -(map_inv_nat_cast_smul (distrib_mul_action.to_add_monoid_hom E s) R R n x).symm - /-- If `E` is a vector space over two division rings `R` and `S`, then scalar multiplications agree on rational numbers in `R` and `S`. -/ lemma rat_cast_smul_eq {E : Type*} (R S : Type*) [add_comm_group E] [division_ring R] @@ -483,36 +492,41 @@ is the result `smul_eq_zero`: a scalar multiple is `0` iff either argument is `0 It is a generalization of the `no_zero_divisors` class to heterogeneous multiplication. -/ -class no_zero_smul_divisors (R M : Type*) [has_zero R] [has_zero M] [has_scalar R M] : Prop := +class no_zero_smul_divisors (R M : Type*) [has_zero R] [has_zero M] [has_smul R M] : Prop := (eq_zero_or_eq_zero_of_smul_eq_zero : ∀ {c : R} {x : M}, c • x = 0 → c = 0 ∨ x = 0) export no_zero_smul_divisors (eq_zero_or_eq_zero_of_smul_eq_zero) /-- Pullback a `no_zero_smul_divisors` instance along an injective function. -/ lemma function.injective.no_zero_smul_divisors {R M N : Type*} [has_zero R] [has_zero M] - [has_zero N] [has_scalar R M] [has_scalar R N] [no_zero_smul_divisors R N] (f : M → N) + [has_zero N] [has_smul R M] [has_smul R N] [no_zero_smul_divisors R N] (f : M → N) (hf : function.injective f) (h0 : f 0 = 0) (hs : ∀ (c : R) (x : M), f (c • x) = c • f x) : no_zero_smul_divisors R M := ⟨λ c m h, or.imp_right (@hf _ _) $ h0.symm ▸ eq_zero_or_eq_zero_of_smul_eq_zero (by rw [←hs, h, h0])⟩ -section module +@[priority 100] -- See note [lower instance priority] +instance no_zero_divisors.to_no_zero_smul_divisors [has_zero R] [has_mul R] [no_zero_divisors R] : + no_zero_smul_divisors R R := +⟨λ c x, eq_zero_or_eq_zero_of_mul_eq_zero⟩ -variables [semiring R] [add_comm_monoid M] [module R M] +lemma smul_ne_zero [has_zero R] [has_zero M] [has_smul R M] [no_zero_smul_divisors R M] {c : R} + {x : M} (hc : c ≠ 0) (hx : x ≠ 0) : c • x ≠ 0 := +λ h, (eq_zero_or_eq_zero_of_smul_eq_zero h).elim hc hx -instance no_zero_smul_divisors.of_no_zero_divisors [no_zero_divisors R] : - no_zero_smul_divisors R R := -⟨λ c x, no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero⟩ +section smul_with_zero +variables [has_zero R] [has_zero M] [smul_with_zero R M] [no_zero_smul_divisors R M] {c : R} {x : M} -@[simp] -theorem smul_eq_zero [no_zero_smul_divisors R M] {c : R} {x : M} : - c • x = 0 ↔ c = 0 ∨ x = 0 := +@[simp] lemma smul_eq_zero : c • x = 0 ↔ c = 0 ∨ x = 0 := ⟨eq_zero_or_eq_zero_of_smul_eq_zero, - λ h, h.elim (λ h, h.symm ▸ zero_smul R x) (λ h, h.symm ▸ smul_zero c)⟩ + λ h, h.elim (λ h, h.symm ▸ zero_smul R x) (λ h, h.symm ▸ smul_zero c)⟩ + +lemma smul_ne_zero_iff : c • x ≠ 0 ↔ c ≠ 0 ∧ x ≠ 0 := by rw [ne.def, smul_eq_zero, not_or_distrib] -theorem smul_ne_zero [no_zero_smul_divisors R M] {c : R} {x : M} : - c • x ≠ 0 ↔ c ≠ 0 ∧ x ≠ 0 := -by simp only [ne.def, smul_eq_zero, not_or_distrib] +end smul_with_zero + +section module +variables [semiring R] [add_comm_monoid M] [module R M] section nat @@ -523,7 +537,7 @@ lemma nat.no_zero_smul_divisors : no_zero_smul_divisors ℕ M := ⟨by { intros c x, rw [nsmul_eq_smul_cast R, smul_eq_zero], simp }⟩ @[simp] lemma two_nsmul_eq_zero {v : M} : 2 • v = 0 ↔ v = 0 := -by { haveI := nat.no_zero_smul_divisors R M, norm_num [smul_eq_zero] } +by { haveI := nat.no_zero_smul_divisors R M, simp [smul_eq_zero] } end nat @@ -531,9 +545,10 @@ variables (R M) /-- If `M` is an `R`-module with one and `M` has characteristic zero, then `R` has characteristic zero as well. Usually `M` is an `R`-algebra. -/ -lemma char_zero.of_module [has_one M] [char_zero M] : char_zero R := +lemma char_zero.of_module (M) [add_comm_monoid_with_one M] [char_zero M] [module R M] : + char_zero R := begin - refine ⟨λ m n h, @nat.cast_injective M _ _ _ _ _ _⟩, + refine ⟨λ m n h, @nat.cast_injective M _ _ _ _ _⟩, rw [← nsmul_one, ← nsmul_one, nsmul_eq_smul_cast R m (1 : M), nsmul_eq_smul_cast R n (1 : M), h] end @@ -598,15 +613,21 @@ end smul_injective end module -section division_ring +section group_with_zero -variables [division_ring R] [add_comm_group M] [module R M] +variables [group_with_zero R] [add_monoid M] [distrib_mul_action R M] +/-- This instance applies to `division_semiring`s, in particular `nnreal` and `nnrat`. -/ @[priority 100] -- see note [lower instance priority] -instance no_zero_smul_divisors.of_division_ring : no_zero_smul_divisors R M := +instance group_with_zero.to_no_zero_smul_divisors : no_zero_smul_divisors R M := ⟨λ c x h, or_iff_not_imp_left.2 $ λ hc, (smul_eq_zero_iff_eq' hc).1 h⟩ -end division_ring +end group_with_zero + +@[priority 100] -- see note [lower instance priority] +instance rat_module.no_zero_smul_divisors [add_comm_group M] [module ℚ M] : + no_zero_smul_divisors ℤ M := +⟨λ k x h, by simpa [zsmul_eq_smul_cast ℚ k x] using h⟩ end no_zero_smul_divisors @@ -618,5 +639,4 @@ by rw [nsmul_eq_mul, mul_one] m • (1 : R) = ↑m := by rw [zsmul_eq_mul, mul_one] -lemma finset.cast_card [comm_semiring R] (s : finset α) : (s.card : R) = ∑ a in s, 1 := -by rw [finset.sum_const, nat.smul_one_eq_coe] +assert_not_exists multiset diff --git a/src/algebra/module/big_operators.lean b/src/algebra/module/big_operators.lean new file mode 100644 index 0000000000000..3a64046bf8454 --- /dev/null +++ b/src/algebra/module/big_operators.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Yury Kudryashov, Yaël Dillies +-/ +import algebra.module.basic +import group_theory.group_action.big_operators + +/-! +# Finite sums over modules over a ring + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open_locale big_operators + +variables {α β R M ι : Type*} + +section add_comm_monoid +variables [semiring R] [add_comm_monoid M] [module R M] (r s : R) (x y : M) + +lemma list.sum_smul {l : list R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum := +((smul_add_hom R M).flip x).map_list_sum l + +lemma multiset.sum_smul {l : multiset R} {x : M} : l.sum • x = (l.map (λ r, r • x)).sum := +((smul_add_hom R M).flip x).map_multiset_sum l + +lemma multiset.sum_smul_sum {s : multiset R} {t : multiset M} : + s.sum • t.sum = ((s ×ˢ t).map $ λ p : R × M, p.fst • p.snd).sum := +begin + induction s using multiset.induction with a s ih, + { simp }, + { simp [add_smul, ih, ←multiset.smul_sum] } +end + +lemma finset.sum_smul {f : ι → R} {s : finset ι} {x : M} : + (∑ i in s, f i) • x = (∑ i in s, (f i) • x) := +((smul_add_hom R M).flip x).map_sum f s + +lemma finset.sum_smul_sum {f : α → R} {g : β → M} {s : finset α} {t : finset β} : + (∑ i in s, f i) • (∑ i in t, g i) = ∑ p in s ×ˢ t, f p.fst • g p.snd := +by { rw [finset.sum_product, finset.sum_smul, finset.sum_congr rfl], intros, rw finset.smul_sum } + +end add_comm_monoid + +lemma finset.cast_card [comm_semiring R] (s : finset α) : (s.card : R) = ∑ a in s, 1 := +by rw [finset.sum_const, nat.smul_one_eq_coe] diff --git a/src/algebra/module/bimodule.lean b/src/algebra/module/bimodule.lean new file mode 100644 index 0000000000000..259311e22dd0c --- /dev/null +++ b/src/algebra/module/bimodule.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2022 Oliver Nash. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Oliver Nash +-/ +import ring_theory.tensor_product + +/-! +# Bimodules + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +One frequently encounters situations in which several sets of scalars act on a single space, subject +to compatibility condition(s). A distinguished instance of this is the theory of bimodules: one has +two rings `R`, `S` acting on an additive group `M`, with `R` acting covariantly ("on the left") +and `S` acting contravariantly ("on the right"). The compatibility condition is just: +`(r • m) • s = r • (m • s)` for all `r : R`, `s : S`, `m : M`. + +This situation can be set up in Mathlib as: +```lean +variables (R S M : Type*) [ring R] [ring S] +variables [add_comm_group M] [module R M] [module Sᵐᵒᵖ M] [smul_comm_class R Sᵐᵒᵖ M] +``` +The key fact is: +```lean +example : module (R ⊗[ℕ] Sᵐᵒᵖ) M := tensor_product.algebra.module +``` +Note that the corresponding result holds for the canonically isomorphic ring `R ⊗[ℤ] Sᵐᵒᵖ` but it is +preferable to use the `R ⊗[ℕ] Sᵐᵒᵖ` instance since it works without additive inverses. + +Bimodules are thus just a special case of `module`s and most of their properties follow from the +theory of `module`s`. In particular a two-sided submodule of a bimodule is simply a term of type +`submodule (R ⊗[ℕ] Sᵐᵒᵖ) M`. + +This file is a place to collect results which are specific to bimodules. + +## Main definitions + + * `subbimodule.mk` + * `subbimodule.smul_mem` + * `subbimodule.smul_mem'` + * `subbimodule.to_submodule` + * `subbimodule.to_submodule'` + +## Implementation details + +For many definitions and lemmas it is preferable to set things up without opposites, i.e., as: +`[module S M] [smul_comm_class R S M]` rather than `[module Sᵐᵒᵖ M] [smul_comm_class R Sᵐᵒᵖ M]`. +The corresponding results for opposites then follow automatically and do not require taking +advantage of the fact that `(Sᵐᵒᵖ)ᵐᵒᵖ` is defeq to `S`. + +## TODO + +Develop the theory of two-sided ideals, which have type `submodule (R ⊗[ℕ] Rᵐᵒᵖ) R`. + +-/ + +open_locale tensor_product + +local attribute [instance] tensor_product.algebra.module + +namespace subbimodule + +section algebra + +variables {R A B M : Type*} +variables [comm_semiring R] [add_comm_monoid M] [module R M] +variables [semiring A] [semiring B] [module A M] [module B M] +variables [algebra R A] [algebra R B] +variables [is_scalar_tower R A M] [is_scalar_tower R B M] +variables [smul_comm_class A B M] + +/-- A constructor for a subbimodule which demands closure under the two sets of scalars +individually, rather than jointly via their tensor product. + +Note that `R` plays no role but it is convenient to make this generalisation to support the cases +`R = ℕ` and `R = ℤ` which both show up naturally. See also `base_change`. -/ +@[simps] def mk (p : add_submonoid M) + (hA : ∀ (a : A) {m : M}, m ∈ p → a • m ∈ p) + (hB : ∀ (b : B) {m : M}, m ∈ p → b • m ∈ p) : submodule (A ⊗[R] B) M := +{ carrier := p, + smul_mem' := λ ab m, tensor_product.induction_on ab + (λ hm, by simpa only [zero_smul] using p.zero_mem) + (λ a b hm, by simpa only [tensor_product.algebra.smul_def] using hA a (hB b hm)) + (λ z w hz hw hm, by simpa only [add_smul] using p.add_mem (hz hm) (hw hm)), + .. p } + +lemma smul_mem (p : submodule (A ⊗[R] B) M) (a : A) {m : M} (hm : m ∈ p) : a • m ∈ p := +begin + suffices : a • m = a ⊗ₜ[R] (1 : B) • m, { exact this.symm ▸ p.smul_mem _ hm, }, + simp [tensor_product.algebra.smul_def], +end + +lemma smul_mem' (p : submodule (A ⊗[R] B) M) (b : B) {m : M} (hm : m ∈ p) : b • m ∈ p := +begin + suffices : b • m = (1 : A) ⊗ₜ[R] b • m, { exact this.symm ▸ p.smul_mem _ hm, }, + simp [tensor_product.algebra.smul_def], +end + +/-- If `A` and `B` are also `algebra`s over yet another set of scalars `S` then we may "base change" +from `R` to `S`. -/ +@[simps] def base_change (S : Type*) [comm_semiring S] [module S M] [algebra S A] [algebra S B] + [is_scalar_tower S A M] [is_scalar_tower S B M] (p : submodule (A ⊗[R] B) M) : + submodule (A ⊗[S] B) M := +mk p.to_add_submonoid (smul_mem p) (smul_mem' p) + +/-- Forgetting the `B` action, a `submodule` over `A ⊗[R] B` is just a `submodule` over `A`. -/ +@[simps] def to_submodule (p : submodule (A ⊗[R] B) M) : submodule A M := +{ carrier := p, + smul_mem' := smul_mem p, + .. p } + +/-- Forgetting the `A` action, a `submodule` over `A ⊗[R] B` is just a `submodule` over `B`. -/ +@[simps] def to_submodule' (p : submodule (A ⊗[R] B) M) : submodule B M := +{ carrier := p, + smul_mem' := smul_mem' p, + .. p } + +end algebra + +section ring + +variables (R S M : Type*) [ring R] [ring S] +variables [add_comm_group M] [module R M] [module S M] [smul_comm_class R S M] + +/-- A `submodule` over `R ⊗[ℕ] S` is naturally also a `submodule` over the canonically-isomorphic +ring `R ⊗[ℤ] S`. -/ +@[simps] def to_subbimodule_int (p : submodule (R ⊗[ℕ] S) M) : submodule (R ⊗[ℤ] S) M := +base_change ℤ p + +/-- A `submodule` over `R ⊗[ℤ] S` is naturally also a `submodule` over the canonically-isomorphic +ring `R ⊗[ℕ] S`. -/ +@[simps] def to_subbimodule_nat (p : submodule (R ⊗[ℤ] S) M) : submodule (R ⊗[ℕ] S) M := +base_change ℕ p + +end ring + +end subbimodule diff --git a/src/algebra/module/dedekind_domain.lean b/src/algebra/module/dedekind_domain.lean new file mode 100644 index 0000000000000..d766ff9bc44da --- /dev/null +++ b/src/algebra/module/dedekind_domain.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Pierre-Alexandre Bazin +-/ +import algebra.module.torsion +import ring_theory.dedekind_domain.ideal + +/-! +# Modules over a Dedekind domain + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Over a Dedekind domain, a `I`-torsion module is the internal direct sum of its `p i ^ e i`-torsion +submodules, where `I = ∏ i, p i ^ e i` is its unique decomposition in prime ideals. +Therefore, as any finitely generated torsion module is `I`-torsion for some `I`, it is an internal +direct sum of its `p i ^ e i`-torsion submodules for some prime ideals `p i` and numbers `e i`. +-/ + +universes u v +open_locale big_operators + +variables {R : Type u} [comm_ring R] [is_domain R] {M : Type v} [add_comm_group M] [module R M] + +open_locale direct_sum + +namespace submodule +variables [is_dedekind_domain R] +open unique_factorization_monoid + +open_locale classical + +/--Over a Dedekind domain, a `I`-torsion module is the internal direct sum of its `p i ^ e i`- +torsion submodules, where `I = ∏ i, p i ^ e i` is its unique decomposition in prime ideals.-/ +lemma is_internal_prime_power_torsion_of_is_torsion_by_ideal {I : ideal R} (hI : I ≠ ⊥) + (hM : module.is_torsion_by_set R M I) : + direct_sum.is_internal (λ p : (factors I).to_finset, + torsion_by_set R M (p ^ (factors I).count p : ideal R)) := +begin + let P := factors I, + have prime_of_mem := λ p (hp : p ∈ P.to_finset), prime_of_factor p (multiset.mem_to_finset.mp hp), + apply @torsion_by_set_is_internal _ _ _ _ _ _ _ _ (λ p, p ^ P.count p) _, + { convert hM, + rw [← finset.inf_eq_infi, is_dedekind_domain.inf_prime_pow_eq_prod, + ← finset.prod_multiset_count, ← associated_iff_eq], + { exact factors_prod hI }, + { exact prime_of_mem }, { exact λ _ _ _ _ ij, ij } }, + { intros p hp q hq pq, dsimp, + rw irreducible_pow_sup, + { suffices : (normalized_factors _).count p = 0, + { rw [this, zero_min, pow_zero, ideal.one_eq_top] }, + { rw [multiset.count_eq_zero, normalized_factors_of_irreducible_pow + (prime_of_mem q hq).irreducible, multiset.mem_replicate], + exact λ H, pq $ H.2.trans $ normalize_eq q } }, + { rw ← ideal.zero_eq_bot, apply pow_ne_zero, exact (prime_of_mem q hq).ne_zero }, + { exact (prime_of_mem p hp).irreducible } } +end + +/--A finitely generated torsion module over a Dedekind domain is an internal direct sum of its +`p i ^ e i`-torsion submodules where `p i` are factors of `(⊤ : submodule R M).annihilator` and +`e i` are their multiplicities. -/ +theorem is_internal_prime_power_torsion [module.finite R M] (hM : module.is_torsion R M) : + direct_sum.is_internal (λ p : (factors (⊤ : submodule R M).annihilator).to_finset, + torsion_by_set R M (p ^ (factors (⊤ : submodule R M).annihilator).count p : ideal R)) := +begin + have hM' := module.is_torsion_by_set_annihilator_top R M, + have hI := submodule.annihilator_top_inter_non_zero_divisors hM, + refine is_internal_prime_power_torsion_of_is_torsion_by_ideal _ hM', + rw ←set.nonempty_iff_ne_empty at hI, rw submodule.ne_bot_iff, + obtain ⟨x, H, hx⟩ := hI, exact ⟨x, H, non_zero_divisors.ne_zero hx⟩ +end + +/--A finitely generated torsion module over a Dedekind domain is an internal direct sum of its +`p i ^ e i`-torsion submodules for some prime ideals `p i` and numbers `e i`.-/ +theorem exists_is_internal_prime_power_torsion [module.finite R M] (hM : module.is_torsion R M) : + ∃ (P : finset $ ideal R) [decidable_eq P] [∀ p ∈ P, prime p] (e : P → ℕ), + by exactI direct_sum.is_internal (λ p : P, torsion_by_set R M (p ^ e p : ideal R)) := +⟨_, _, λ p hp, prime_of_factor p (multiset.mem_to_finset.mp hp), _, + is_internal_prime_power_torsion hM⟩ + +end submodule diff --git a/src/algebra/module/default.lean b/src/algebra/module/default.lean deleted file mode 100644 index ddb93422d3c0b..0000000000000 --- a/src/algebra/module/default.lean +++ /dev/null @@ -1,12 +0,0 @@ -/- -Copyright (c) 2020 Chris Hughes. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes --/ -import algebra.module.basic -import algebra.module.submodule - -/-! -# Default file for module -This file imports `algebra.module.basic` and `algebra.module.submodule`. --/ diff --git a/src/algebra/module/equiv.lean b/src/algebra/module/equiv.lean index 2dadf157e6a6e..5cb99e06014d4 100644 --- a/src/algebra/module/equiv.lean +++ b/src/algebra/module/equiv.lean @@ -9,6 +9,9 @@ import algebra.module.linear_map /-! # (Semi)linear equivalences +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define * `linear_equiv σ M M₂`, `M ≃ₛₗ[σ] M₂`: an invertible semilinear map. Here, `σ` is a `ring_hom` @@ -34,7 +37,6 @@ linear equiv, linear equivalences, linear isomorphism, linear isomorphic -/ open function -open_locale big_operators universes u u' v w x y z variables {R : Type*} {R₁ : Type*} {R₂ : Type*} {R₃ : Type*} @@ -45,13 +47,12 @@ section set_option old_structure_cmd true /-- A linear equivalence is an invertible linear map. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure linear_equiv {R : Type*} {S : Type*} [semiring R] [semiring S] (σ : R →+* S) {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] (M : Type*) (M₂ : Type*) [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂] extends linear_map σ M M₂, M ≃+ M₂ -end attribute [nolint doc_blame] linear_equiv.to_linear_map attribute [nolint doc_blame] linear_equiv.to_add_equiv @@ -60,6 +61,49 @@ notation M ` ≃ₛₗ[`:50 σ `] ` M₂ := linear_equiv σ M M₂ notation M ` ≃ₗ[`:50 R `] ` M₂ := linear_equiv (ring_hom.id R) M M₂ notation M ` ≃ₗ⋆[`:50 R `] ` M₂ := linear_equiv (star_ring_end R) M M₂ +/-- `semilinear_equiv_class F σ M M₂` asserts `F` is a type of bundled `σ`-semilinear equivs +`M → M₂`. + +See also `linear_equiv_class F R M M₂` for the case where `σ` is the identity map on `R`. + +A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S` +is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and +`f (c • x) = (σ c) • f x`. -/ +class semilinear_equiv_class (F : Type*) {R S : out_param Type*} [semiring R] [semiring S] + (σ : out_param $ R →+* S) {σ' : out_param $ S →+* R} + [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] (M M₂ : out_param Type*) + [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂] + extends add_equiv_class F M M₂ := +(map_smulₛₗ : ∀ (f : F) (r : R) (x : M), f (r • x) = (σ r) • f x) + +-- `R, S, σ, σ'` become metavars, but it's OK since they are outparams. +attribute [nolint dangerous_instance] semilinear_equiv_class.to_add_equiv_class + +/-- `linear_equiv_class F R M M₂` asserts `F` is a type of bundled `R`-linear equivs `M → M₂`. +This is an abbreviation for `semilinear_equiv_class F (ring_hom.id R) M M₂`. +-/ +abbreviation linear_equiv_class (F : Type*) (R M M₂ : out_param Type*) + [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂] := +semilinear_equiv_class F (ring_hom.id R) M M₂ + +end + +namespace semilinear_equiv_class + +variables (F : Type*) [semiring R] [semiring S] +variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] +variables [module R M] [module S M₂] {σ : R →+* S} {σ' : S →+* R} + +-- `σ'` becomes a metavariable, but it's OK since it's an outparam +@[priority 100, nolint dangerous_instance] +instance [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] [s : semilinear_equiv_class F σ M M₂] : + semilinear_map_class F σ M M₂ := +{ coe := (coe : F → M → M₂), + coe_injective' := @fun_like.coe_injective F _ _ _, + ..s } + +end semilinear_equiv_class + namespace linear_equiv section add_comm_monoid @@ -101,11 +145,14 @@ lemma to_linear_map_injective : (e₁ : M →ₛₗ[σ] M₂) = e₂ ↔ e₁ = e₂ := to_linear_map_injective.eq_iff -instance : add_monoid_hom_class (M ≃ₛₗ[σ] M₂) M M₂ := +instance : semilinear_equiv_class (M ≃ₛₗ[σ] M₂) σ M M₂ := { coe := linear_equiv.to_fun, - coe_injective' := λ f g h, to_linear_map_injective (fun_like.coe_injective h), - map_add := linear_equiv.map_add', - map_zero := λ f, f.to_linear_map.map_zero } + inv := linear_equiv.inv_fun, + coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' }, + left_inv := linear_equiv.left_inv, + right_inv := linear_equiv.right_inv, + map_add := map_add', + map_smulₛₗ := map_smul' } lemma coe_injective : @injective (M ≃ₛₗ[σ] M₂) (M → M₂) coe_fn := @@ -161,7 +208,7 @@ include module_M module_S_M₂ re₁ re₂ def symm (e : M ≃ₛₗ[σ] M₂) : M₂ ≃ₛₗ[σ'] M := { to_fun := e.to_linear_map.inverse e.inv_fun e.left_inv e.right_inv, inv_fun := e.to_equiv.symm.inv_fun, - map_smul' := λ r x, by simp, + map_smul' := λ r x, by rw map_smulₛₗ, .. e.to_linear_map.inverse e.inv_fun e.left_inv e.right_inv, .. e.to_equiv.symm } omit module_M module_S_M₂ re₁ re₂ @@ -193,7 +240,8 @@ variables (e₁₂ : M₁ ≃ₛₗ[σ₁₂] M₂) (e₂₃ : M₂ ≃ₛₗ[σ include σ₃₁ /-- Linear equivalences are transitive. -/ --- Note: The linter thinks the `ring_hom_comp_triple` argument is doubled -- it is not. +-- Note: the `ring_hom_comp_triple σ₃₂ σ₂₁ σ₃₁` is unused, but is convenient to carry around +-- implicitly for lemmas like `linear_equiv.self_trans_symm`. @[trans, nolint unused_arguments] def trans : M₁ ≃ₛₗ[σ₁₃] M₃ := { .. e₂₃.to_linear_map.comp e₁₂.to_linear_map, @@ -219,6 +267,9 @@ rfl include σ₃₁ @[simp] theorem trans_apply (c : M₁) : (e₁₂.trans e₂₃ : M₁ ≃ₛₗ[σ₁₃] M₃) c = e₂₃ (e₁₂ c) := rfl + +theorem coe_trans : + (e₁₂.trans e₂₃ : M₁ →ₛₗ[σ₁₃] M₃) = (e₂₃ : M₂ →ₛₗ[σ₂₃] M₃).comp (e₁₂ : M₁ →ₛₗ[σ₁₂] M₂) := rfl omit σ₃₁ include σ' @@ -295,13 +346,15 @@ omit module_M₃ @[simp] lemma refl_symm [module R M] : (refl R M).symm = linear_equiv.refl R M := rfl -@[simp] lemma self_trans_symm [module R M] [module R M₂] (f : M ≃ₗ[R] M₂) : - f.trans f.symm = linear_equiv.refl R M := +include re₁₂ re₂₁ module_M₁ module_M₂ +@[simp] lemma self_trans_symm (f : M₁ ≃ₛₗ[σ₁₂] M₂) : + f.trans f.symm = linear_equiv.refl R₁ M₁ := by { ext x, simp } -@[simp] lemma symm_trans_self [module R M] [module R M₂] (f : M ≃ₗ[R] M₂) : - f.symm.trans f = linear_equiv.refl R M₂ := +@[simp] lemma symm_trans_self (f : M₁ ≃ₛₗ[σ₁₂] M₂) : + f.symm.trans f = linear_equiv.refl R₂ M₂ := by { ext x, simp } +omit re₁₂ re₂₁ module_M₁ module_M₂ @[simp, norm_cast] lemma refl_to_linear_map [module R M] : (linear_equiv.refl R M : M →ₗ[R] M) = linear_map.id := @@ -317,16 +370,14 @@ rfl protected theorem map_add (a b : M) : e (a + b) = e a + e b := map_add e a b protected theorem map_zero : e 0 = 0 := map_zero e -@[simp] theorem map_smulₛₗ (c : R) (x : M) : e (c • x) = (σ c) • e x := e.map_smul' c x +-- TODO: `simp` isn't picking up `map_smulₛₗ` for `linear_equiv`s without specifying `map_smulₛₗ f` +@[simp] protected theorem map_smulₛₗ (c : R) (x : M) : e (c • x) = (σ c) • e x := e.map_smul' c x include module_N₁ module_N₂ theorem map_smul (e : N₁ ≃ₗ[R₁] N₂) (c : R₁) (x : N₁) : - e (c • x) = c • e x := map_smulₛₗ _ _ _ + e (c • x) = c • e x := map_smulₛₗ e c x omit module_N₁ module_N₂ -@[simp] lemma map_sum {s : finset ι} (u : ι → M) : e (∑ i in s, u i) = ∑ i in s, e (u i) := -e.to_linear_map.map_sum - @[simp] theorem map_eq_zero_iff {x : M} : e x = 0 ↔ x = 0 := e.to_add_equiv.map_eq_zero_iff theorem map_ne_zero_iff {x : M} : e x ≠ 0 ↔ x ≠ 0 := @@ -366,30 +417,6 @@ e.to_equiv.image_eq_preimage s protected lemma image_symm_eq_preimage (s : set M₂) : e.symm '' s = e ⁻¹' s := e.to_equiv.symm.image_eq_preimage s -section pointwise -open_locale pointwise - -@[simp] lemma image_smul_setₛₗ (c : R) (s : set M) : - e '' (c • s) = (σ c) • e '' s := -linear_map.image_smul_setₛₗ e.to_linear_map c s - -@[simp] lemma preimage_smul_setₛₗ (c : S) (s : set M₂) : - e ⁻¹' (c • s) = σ' c • e ⁻¹' s := -by rw [← linear_equiv.image_symm_eq_preimage, ← linear_equiv.image_symm_eq_preimage, - image_smul_setₛₗ] - -include module_M₁ module_N₁ - -@[simp] lemma image_smul_set (e : M₁ ≃ₗ[R₁] N₁) (c : R₁) (s : set M₁) : - e '' (c • s) = c • e '' s := -linear_map.image_smul_set e.to_linear_map c s - -@[simp] lemma preimage_smul_set (e : M₁ ≃ₗ[R₁] N₁) (c : R₁) (s : set N₁) : - e ⁻¹' (c • s) = c • e ⁻¹' s := -e.preimage_smul_setₛₗ c s - -end pointwise - end /-- Interpret a `ring_equiv` `f` as an `f`-semilinear equiv. -/ @@ -480,7 +507,7 @@ instance apply_distrib_mul_action : distrib_mul_action (M ≃ₗ[R] M) M := f • a = f a := rfl /-- `linear_equiv.apply_distrib_mul_action` is faithful. -/ -instance apply_has_faithful_scalar : has_faithful_scalar (M ≃ₗ[R] M) M := +instance apply_has_faithful_smul : has_faithful_smul (M ≃ₗ[R] M) M := ⟨λ _ _, linear_equiv.ext⟩ instance apply_smul_comm_class : smul_comm_class R (M ≃ₗ[R] M) M := @@ -491,6 +518,23 @@ instance apply_smul_comm_class' : smul_comm_class (M ≃ₗ[R] M) R M := end automorphisms +section of_subsingleton + +variables (M M₂) [module R M] [module R M₂] [subsingleton M] [subsingleton M₂] + +/-- Any two modules that are subsingletons are isomorphic. -/ +@[simps] def of_subsingleton : M ≃ₗ[R] M₂ := +{ to_fun := λ _, 0, + inv_fun := λ _, 0, + left_inv := λ x, subsingleton.elim _ _, + right_inv := λ x, subsingleton.elim _ _, + .. (0 : M →ₗ[R] M₂)} + +@[simp] lemma of_subsingleton_self : of_subsingleton M M = refl R M := +by { ext, simp } + +end of_subsingleton + end add_comm_monoid end linear_equiv diff --git a/src/algebra/module/graded_module.lean b/src/algebra/module/graded_module.lean new file mode 100644 index 0000000000000..969e6d008f875 --- /dev/null +++ b/src/algebra/module/graded_module.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ + +import ring_theory.graded_algebra.basic +import algebra.graded_mul_action +import algebra.direct_sum.decomposition +import algebra.module.big_operators + +/-! +# Graded Module + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given an `R`-algebra `A` graded by `𝓐`, a graded `A`-module `M` is expressed as +`direct_sum.decomposition 𝓜` and `set_like.has_graded_smul 𝓐 𝓜`. +Then `⨁ i, 𝓜 i` is an `A`-module and is isomorphic to `M`. + +## Tags + +graded module +-/ + + +section + +open_locale direct_sum + +variables {ι : Type*} (A : ι → Type*) (M : ι → Type*) + +namespace direct_sum +open graded_monoid + +/-- A graded version of `distrib_mul_action`. -/ +class gdistrib_mul_action [add_monoid ι] [gmonoid A] [Π i, add_monoid (M i)] + extends gmul_action A M := +(smul_add {i j} (a : A i) (b c : M j) : smul a (b + c) = smul a b + smul a c) +(smul_zero {i j} (a : A i) : smul a (0 : M j) = 0) + +/-- A graded version of `module`. -/ +class gmodule [add_monoid ι] [Π i, add_monoid (A i)] [Π i, add_monoid (M i)] + [gmonoid A] extends gdistrib_mul_action A M := +(add_smul {i j} (a a' : A i) (b : M j) : smul (a + a') b = smul a b + smul a' b) +(zero_smul {i j} (b : M j) : smul (0 : A i) b = 0) + +/-- A graded version of `semiring.to_module`. -/ +instance gsemiring.to_gmodule [decidable_eq ι] [add_monoid ι] + [Π (i : ι), add_comm_monoid (A i)] [gsemiring A] : + gmodule A A := +{ smul_add := λ _ _, gsemiring.mul_add, + smul_zero := λ i j, gsemiring.mul_zero, + add_smul := λ i j, gsemiring.add_mul, + zero_smul := λ i j, gsemiring.zero_mul, + ..gmonoid.to_gmul_action A } + +variables [add_monoid ι] [Π (i : ι), add_comm_monoid (A i)] [Π i, add_comm_monoid (M i)] + +/-- The piecewise multiplication from the `has_mul` instance, as a bundled homomorphism. -/ +@[simps] def gsmul_hom [gmonoid A] [gmodule A M] {i j} : + A i →+ M j →+ M (i + j) := +{ to_fun := λ a, + { to_fun := λ b, ghas_smul.smul a b, + map_zero' := gdistrib_mul_action.smul_zero _, + map_add' := gdistrib_mul_action.smul_add _ }, + map_zero' := add_monoid_hom.ext $ λ a, gmodule.zero_smul a, + map_add' := λ a₁ a₂, add_monoid_hom.ext $ λ b, gmodule.add_smul _ _ _} + +namespace gmodule + +/-- For graded monoid `A` and a graded module `M` over `A`. `gmodule.smul_add_monoid_hom` is the +`⨁ᵢ Aᵢ`-scalar multiplication on `⨁ᵢ Mᵢ` induced by `gsmul_hom`. -/ +def smul_add_monoid_hom + [decidable_eq ι] [gmonoid A] [gmodule A M] : + (⨁ i, A i) →+ (⨁ i, M i) →+ (⨁ i, M i) := +to_add_monoid $ λ i, add_monoid_hom.flip $ + to_add_monoid $ λ j, add_monoid_hom.flip $ + (of M _).comp_hom.comp $ gsmul_hom A M + +section + +open graded_monoid direct_sum gmodule + +instance [decidable_eq ι] [gmonoid A] [gmodule A M] : + has_smul (⨁ i, A i) (⨁ i, M i) := +{ smul := λ x y, smul_add_monoid_hom A M x y } + +@[simp] lemma smul_def [decidable_eq ι] [gmonoid A] [gmodule A M] + (x : ⨁ i, A i) (y : ⨁ i, M i) : x • y = smul_add_monoid_hom _ _ x y := rfl + +@[simp] lemma smul_add_monoid_hom_apply_of_of [decidable_eq ι] [gmonoid A] [gmodule A M] + {i j} (x : A i) (y : M j) : + smul_add_monoid_hom A M (direct_sum.of A i x) (of M j y) = + of M (i + j) (ghas_smul.smul x y) := +by simp [smul_add_monoid_hom] + +@[simp] lemma of_smul_of [decidable_eq ι] [gmonoid A] [gmodule A M] + {i j} (x : A i) (y : M j) : + direct_sum.of A i x • of M j y = of M (i + j) (ghas_smul.smul x y) := +smul_add_monoid_hom_apply_of_of _ _ _ _ + +open add_monoid_hom + +-- Almost identical to the proof of `direct_sum.one_mul` +private lemma one_smul [decidable_eq ι] [gmonoid A] [gmodule A M] (x : ⨁ i, M i) : + (1 : ⨁ i, A i) • x = x := +suffices smul_add_monoid_hom A M 1 = add_monoid_hom.id (⨁ i, M i), + from add_monoid_hom.congr_fun this x, +begin + apply direct_sum.add_hom_ext, intros i xi, + unfold has_one.one, + rw smul_add_monoid_hom_apply_of_of, + exact direct_sum.of_eq_of_graded_monoid_eq (one_smul (graded_monoid A) $ graded_monoid.mk i xi), +end + +-- Almost identical to the proof of `direct_sum.mul_assoc` +private lemma mul_smul [decidable_eq ι] [gsemiring A] [gmodule A M] + (a b : ⨁ i, A i) (c : ⨁ i, M i) : (a * b) • c = a • (b • c) := +suffices (smul_add_monoid_hom A M).comp_hom.comp (direct_sum.mul_hom A) + -- `λ a b c, (a * b) • c` as a bundled hom + = (add_monoid_hom.comp_hom add_monoid_hom.flip_hom $ + (smul_add_monoid_hom A M).flip.comp_hom.comp $ smul_add_monoid_hom A M).flip, + -- `λ a b c, a • (b • c)` as a bundled hom + from add_monoid_hom.congr_fun (add_monoid_hom.congr_fun (add_monoid_hom.congr_fun this a) b) c, +begin + ext ai ax bi bx ci cx : 6, + dsimp only [coe_comp, function.comp_app, comp_hom_apply_apply, flip_apply, flip_hom_apply], + rw [smul_add_monoid_hom_apply_of_of, smul_add_monoid_hom_apply_of_of, + direct_sum.mul_hom_of_of, smul_add_monoid_hom_apply_of_of], + exact direct_sum.of_eq_of_graded_monoid_eq + (mul_smul (graded_monoid.mk ai ax) (graded_monoid.mk bi bx) (graded_monoid.mk ci cx)), +end + +/-- The `module` derived from `gmodule A M`. -/ +instance module [decidable_eq ι] [gsemiring A] [gmodule A M] : + module (⨁ i, A i) (⨁ i, M i) := +{ smul := (•), + one_smul := one_smul _ _, + mul_smul := mul_smul _ _, + smul_add := λ r, (smul_add_monoid_hom A M r).map_add, + smul_zero := λ r, (smul_add_monoid_hom A M r).map_zero, + add_smul := λ r s x, by simp only [smul_def, map_add, add_monoid_hom.add_apply], + zero_smul := λ x, by simp only [smul_def, map_zero, add_monoid_hom.zero_apply] } + +end + +end gmodule + +end direct_sum + +end + +open_locale direct_sum big_operators + +variables {ι R A M σ σ' : Type*} +variables [add_monoid ι] [comm_semiring R] [semiring A] [algebra R A] +variables (𝓐 : ι → σ') [set_like σ' A] +variables (𝓜 : ι → σ) + +namespace set_like + +include σ' A σ M + +instance gmul_action [add_monoid M] [distrib_mul_action A M] + [set_like σ M] [set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜] : + graded_monoid.gmul_action (λ i, 𝓐 i) (λ i, 𝓜 i) := +{ one_smul := λ ⟨i, m⟩, sigma.subtype_ext (zero_add _) (one_smul _ _), + mul_smul := λ ⟨i, a⟩ ⟨j, a'⟩ ⟨k, b⟩, sigma.subtype_ext (add_assoc _ _ _) (mul_smul _ _ _), + ..set_like.ghas_smul 𝓐 𝓜 } + +instance gdistrib_mul_action [add_monoid M] [distrib_mul_action A M] + [set_like σ M] [add_submonoid_class σ M] [set_like.graded_monoid 𝓐] + [set_like.has_graded_smul 𝓐 𝓜] : + direct_sum.gdistrib_mul_action (λ i, 𝓐 i) (λ i, 𝓜 i) := +{ smul_add := λ i j a b c, subtype.ext $ smul_add _ _ _, + smul_zero := λ i j a, subtype.ext $ smul_zero _, + ..set_like.gmul_action 𝓐 𝓜 } + +variables [add_comm_monoid M] [module A M] [set_like σ M] [add_submonoid_class σ' A] + [add_submonoid_class σ M] [set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜] + +/-- `[set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜]` is the internal version of graded + module, the internal version can be translated into the external version `gmodule`. -/ +instance gmodule : direct_sum.gmodule (λ i, 𝓐 i) (λ i, 𝓜 i) := +{ smul := λ i j x y, ⟨(x : A) • (y : M), set_like.has_graded_smul.smul_mem x.2 y.2⟩, + add_smul := λ i j a a' b, subtype.ext $ add_smul _ _ _, + zero_smul := λ i j b, subtype.ext $ zero_smul _ _, + ..set_like.gdistrib_mul_action 𝓐 𝓜} + +end set_like + +namespace graded_module + +include σ' A σ M + +variables [add_comm_monoid M] [module A M] [set_like σ M] [add_submonoid_class σ' A] + [add_submonoid_class σ M] [set_like.graded_monoid 𝓐] [set_like.has_graded_smul 𝓐 𝓜] + +/-- +The smul multiplication of `A` on `⨁ i, 𝓜 i` from `(⨁ i, 𝓐 i) →+ (⨁ i, 𝓜 i) →+ ⨁ i, 𝓜 i` +turns `⨁ i, 𝓜 i` into an `A`-module +-/ +def is_module [decidable_eq ι] [graded_ring 𝓐] : + module A (⨁ i, 𝓜 i) := +{ smul := λ a b, direct_sum.decompose 𝓐 a • b, + .. module.comp_hom _ (direct_sum.decompose_ring_equiv 𝓐 : A ≃+* ⨁ i, 𝓐 i).to_ring_hom } + +local attribute [instance] graded_module.is_module + +/-- +`⨁ i, 𝓜 i` and `M` are isomorphic as `A`-modules. +"The internal version" and "the external version" are isomorphism as `A`-modules. +-/ +def linear_equiv [decidable_eq ι] [graded_ring 𝓐] + [direct_sum.decomposition 𝓜] : + M ≃ₗ[A] ⨁ i, 𝓜 i := +{ to_fun := direct_sum.decompose_add_equiv 𝓜, + map_smul' := λ x y, begin + classical, + rw [← direct_sum.sum_support_decompose 𝓐 x, map_sum, finset.sum_smul, map_sum, + finset.sum_smul, finset.sum_congr rfl (λ i hi, _)], + rw [ring_hom.id_apply, ← direct_sum.sum_support_decompose 𝓜 y, map_sum, finset.smul_sum, + map_sum, finset.smul_sum, finset.sum_congr rfl (λ j hj, _)], + simp only [(•), direct_sum.decompose_add_equiv_apply, direct_sum.decompose_coe, + direct_sum.gmodule.smul_add_monoid_hom_apply_of_of], + convert direct_sum.decompose_coe 𝓜 _, + refl, + end, + .. direct_sum.decompose_add_equiv 𝓜 } + +end graded_module diff --git a/src/algebra/module/hom.lean b/src/algebra/module/hom.lean index 232b20064ec51..81b6c29f0738e 100644 --- a/src/algebra/module/hom.lean +++ b/src/algebra/module/hom.lean @@ -8,6 +8,9 @@ import algebra.module.pi /-! # Bundled hom instances for module and multiplicative actions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for module, mul_action and related structures on bundled `_hom` types. These are analogous to the instances in `algebra.module.pi`, but for bundled instead of unbundled @@ -38,7 +41,7 @@ lemma smul_apply (r : R) (f : A →+ B) (x : A) : (r • f) x = r • f x := rfl instance [smul_comm_class R S B] : smul_comm_class R S (A →+ B) := ⟨λ a b f, ext $ λ x, smul_comm _ _ _⟩ -instance [has_scalar R S] [is_scalar_tower R S B] : is_scalar_tower R S (A →+ B) := +instance [has_smul R S] [is_scalar_tower R S B] : is_scalar_tower R S (A →+ B) := ⟨λ a b f, ext $ λ x, smul_assoc _ _ _⟩ instance [distrib_mul_action Rᵐᵒᵖ B] [is_central_scalar R B] : is_central_scalar R (A →+ B) := diff --git a/src/algebra/module/injective.lean b/src/algebra/module/injective.lean new file mode 100644 index 0000000000000..cfbb97da496fc --- /dev/null +++ b/src/algebra/module/injective.lean @@ -0,0 +1,385 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ + +import category_theory.preadditive.injective +import algebra.category.Module.epi_mono +import ring_theory.ideal.basic +import linear_algebra.linear_pmap + +/-! +# Injective modules + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `module.injective`: an `R`-module `Q` is injective if and only if every injective `R`-linear + map descends to a linear map to `Q`, i.e. in the following diagram, if `f` is injective then there + is an `R`-linear map `h : Y ⟶ Q` such that `g = h ∘ f` + ``` + X --- f ---> Y + | + | g + v + Q + ``` +* `module.Baer`: an `R`-module `Q` satisfies Baer's criterion if any `R`-linear map from an + `ideal R` extends to an `R`-linear map `R ⟶ Q` + +## Main statements + +* `module.Baer.criterion`: an `R`-module is injective if it is Baer. + +-/ + + +noncomputable theory + +universes u v + +variables (R : Type u) [ring R] (Q : Type (max u v)) [add_comm_group Q] [module R Q] + +/--An `R`-module `Q` is injective if and only if every injective `R`-linear map descends to a linear +map to `Q`, i.e. in the following diagram, if `f` is injective then there is an `R`-linear map +`h : Y ⟶ Q` such that `g = h ∘ f` + ``` + X --- f ---> Y + | + | g + v + Q + ``` +-/ +class module.injective : Prop := +(out : ∀ (X Y : Type (max u v)) [add_comm_group X] [add_comm_group Y] [module R X] [module R Y] + (f : X →ₗ[R] Y) (hf : function.injective f) (g : X →ₗ[R] Q), + ∃ (h : Y →ₗ[R] Q), ∀ x, h (f x) = g x) + +lemma module.injective_object_of_injective_module [module.injective.{u v} R Q] : + category_theory.injective.{max u v} (⟨Q⟩ : Module.{max u v} R) := +{ factors := λ X Y g f mn, begin + rcases module.injective.out X Y f ((Module.mono_iff_injective f).mp mn) g with ⟨h, eq1⟩, + exact ⟨h, linear_map.ext eq1⟩, + end } + +lemma module.injective_module_of_injective_object + [category_theory.injective.{max u v} (⟨Q⟩ : Module.{max u v} R)] : + module.injective.{u v} R Q := +{ out := λ X Y ins1 ins2 ins3 ins4 f hf g, begin + resetI, + rcases @category_theory.injective.factors (Module R) _ ⟨Q⟩ _ ⟨X⟩ ⟨Y⟩ g f + ((Module.mono_iff_injective _).mpr hf) with ⟨h, rfl⟩, + exact ⟨h, λ x, rfl⟩ + end } + +lemma module.injective_iff_injective_object : + module.injective.{u v} R Q ↔ category_theory.injective.{max u v} (⟨Q⟩ : Module.{max u v} R) := +⟨λ h, @@module.injective_object_of_injective_module R _ Q _ _ h, + λ h, @@module.injective_module_of_injective_object R _ Q _ _ h⟩ + +/--An `R`-module `Q` satisfies Baer's criterion if any `R`-linear map from an `ideal R` extends to +an `R`-linear map `R ⟶ Q`-/ +def module.Baer : Prop := ∀ (I : ideal R) (g : I →ₗ[R] Q), ∃ (g' : R →ₗ[R] Q), + ∀ (x : R) (mem : x ∈ I), g' x = g ⟨x, mem⟩ + +namespace module.Baer + +variables {R Q} {M N : Type (max u v)} [add_comm_group M] [add_comm_group N] +variables [module R M] [module R N] (i : M →ₗ[R] N) (f : M →ₗ[R] Q) + +/-- If we view `M` as a submodule of `N` via the injective linear map `i : M ↪ N`, then a submodule +between `M` and `N` is a submodule `N'` of `N`. To prove Baer's criterion, we need to consider +pairs of `(N', f')` such that `M ≤ N' ≤ N` and `f'` extends `f`. -/ +structure extension_of extends linear_pmap R N Q := +(le : i.range ≤ domain) +(is_extension : ∀ (m : M), f m = to_linear_pmap ⟨i m, le ⟨m, rfl⟩⟩) +section ext + +variables {i f} + +@[ext] lemma extension_of.ext {a b : extension_of i f} + (domain_eq : a.domain = b.domain) + (to_fun_eq : ∀ ⦃x : a.domain⦄ ⦃y : b.domain⦄, + (x : N) = y → a.to_linear_pmap x = b.to_linear_pmap y) : a = b := +begin + rcases a with ⟨a, a_le, e1⟩, + rcases b with ⟨b, b_le, e2⟩, + congr, + exact linear_pmap.ext domain_eq to_fun_eq, +end + +lemma extension_of.ext_iff {a b : extension_of i f} : + a = b ↔ ∃ (domain_eq : a.domain = b.domain), + ∀ ⦃x : a.domain⦄ ⦃y : b.domain⦄, (x : N) = y → a.to_linear_pmap x = b.to_linear_pmap y := +⟨λ r, r ▸ ⟨rfl, λ x y h, congr_arg a.to_fun $ by exact_mod_cast h⟩, + λ ⟨h1, h2⟩, extension_of.ext h1 h2⟩ + +end ext + +instance : has_inf (extension_of i f) := +{ inf := λ X1 X2, + { le := λ x hx, (begin + rcases hx with ⟨x, rfl⟩, + refine ⟨X1.le (set.mem_range_self _), X2.le (set.mem_range_self _), _⟩, + rw [← X1.is_extension x, ← X2.is_extension x], + end : x ∈ X1.to_linear_pmap.eq_locus X2.to_linear_pmap), + is_extension := λ m, X1.is_extension _, + .. (X1.to_linear_pmap ⊓ X2.to_linear_pmap)} } + +instance : semilattice_inf (extension_of i f) := +function.injective.semilattice_inf extension_of.to_linear_pmap + (λ X Y h, extension_of.ext (by rw h) $ λ x y h', by { induction h, congr, exact_mod_cast h' }) $ + λ X Y, linear_pmap.ext rfl $ λ x y h, by { congr, exact_mod_cast h } + +variables {R i f} + +lemma chain_linear_pmap_of_chain_extension_of + {c : set (extension_of i f)} (hchain : is_chain (≤) c) : + (is_chain (≤) $ (λ x : extension_of i f, x.to_linear_pmap) '' c) := +begin + rintro _ ⟨a, a_mem, rfl⟩ _ ⟨b, b_mem, rfl⟩ neq, + exact hchain a_mem b_mem (ne_of_apply_ne _ neq), +end + +/-- The maximal element of every nonempty chain of `extension_of i f`. -/ +def extension_of.max {c : set (extension_of i f)} (hchain : is_chain (≤) c) + (hnonempty : c.nonempty) : + extension_of i f := +{ le := le_trans hnonempty.some.le $ (linear_pmap.le_Sup _ $ (set.mem_image _ _ _).mpr + ⟨hnonempty.some, hnonempty.some_spec, rfl⟩).1, + is_extension := λ m, begin + refine eq.trans (hnonempty.some.is_extension m) _, + symmetry, + generalize_proofs _ h0 h1, + exact linear_pmap.Sup_apply + (is_chain.directed_on $ chain_linear_pmap_of_chain_extension_of hchain) + ((set.mem_image _ _ _).mpr ⟨hnonempty.some, hnonempty.some_spec, rfl⟩) ⟨i m, h1⟩, + end, + ..linear_pmap.Sup _ (is_chain.directed_on $ chain_linear_pmap_of_chain_extension_of hchain) } + +lemma extension_of.le_max {c : set (extension_of i f)} (hchain : is_chain (≤) c) + (hnonempty : c.nonempty) (a : extension_of i f) (ha : a ∈ c) : + a ≤ extension_of.max hchain hnonempty := +linear_pmap.le_Sup (is_chain.directed_on $ chain_linear_pmap_of_chain_extension_of hchain) $ + (set.mem_image _ _ _).mpr ⟨a, ha, rfl⟩ + +variables (i f) [fact $ function.injective i] + +instance extension_of.inhabited : inhabited (extension_of i f) := +{ default := + { domain := i.range, + to_fun := + { to_fun := λ x, f x.2.some, + map_add' := λ x y, begin + have eq1 : _ + _ = (x + y).1 := congr_arg2 (+) x.2.some_spec y.2.some_spec, + rw [← map_add, ← (x + y).2.some_spec] at eq1, + rw [← fact.out (function.injective i) eq1, map_add], + end, + map_smul' := λ r x, begin + have eq1 : r • _ = (r • x).1 := congr_arg ((•) r) x.2.some_spec, + rw [← linear_map.map_smul, ← (r • x).2.some_spec] at eq1, + rw [ring_hom.id_apply, ← fact.out (function.injective i) eq1, linear_map.map_smul], + end }, + le := le_refl _, + is_extension := λ m, begin + simp only [linear_pmap.mk_apply, linear_map.coe_mk], + congr, + exact fact.out (function.injective i) (⟨i m, ⟨_, rfl⟩⟩ : i.range).2.some_spec.symm, + end } } + +/-- Since every nonempty chain has a maximal element, by Zorn's lemma, there is a maximal +`extension_of i f`. -/ +def extension_of_max : extension_of i f := +(@zorn_nonempty_partial_order (extension_of i f) _ ⟨inhabited.default⟩ + (λ c hchain hnonempty, + ⟨extension_of.max hchain hnonempty, extension_of.le_max hchain hnonempty⟩)).some + +lemma extension_of_max_is_max : + ∀ (a : extension_of i f), extension_of_max i f ≤ a → a = extension_of_max i f := +(@zorn_nonempty_partial_order (extension_of i f) _ ⟨inhabited.default⟩ + ((λ c hchain hnonempty, + ⟨extension_of.max hchain hnonempty, extension_of.le_max hchain hnonempty⟩))).some_spec + +variables {f} +private lemma extension_of_max_adjoin.aux1 + {y : N} + (x : (extension_of_max i f).domain ⊔ submodule.span R {y}) : + ∃ (a : (extension_of_max i f).domain) (b : R), x.1 = a.1 + b • y := +begin + have mem1 : x.1 ∈ (_ : set _) := x.2, + rw submodule.coe_sup at mem1, + rcases mem1 with ⟨a, b, a_mem, (b_mem : b ∈ (submodule.span R _ : submodule R N)), eq1⟩, + rw submodule.mem_span_singleton at b_mem, + rcases b_mem with ⟨z, eq2⟩, + exact ⟨⟨a, a_mem⟩, z, by rw [← eq1, ← eq2]⟩, +end + +/--If `x ∈ M ⊔ ⟨y⟩`, then `x = m + r • y`, `fst` pick an arbitrary such `m`.-/ +def extension_of_max_adjoin.fst + {y : N} (x : (extension_of_max i f).domain ⊔ submodule.span R {y}) : + (extension_of_max i f).domain := +(extension_of_max_adjoin.aux1 i x).some + +/--If `x ∈ M ⊔ ⟨y⟩`, then `x = m + r • y`, `snd` pick an arbitrary such `r`.-/ +def extension_of_max_adjoin.snd + {y : N} (x : (extension_of_max i f).domain ⊔ submodule.span R {y}) : R := +(extension_of_max_adjoin.aux1 i x).some_spec.some + +lemma extension_of_max_adjoin.eqn + {y : N} (x : (extension_of_max i f).domain ⊔ submodule.span R {y}) : + ↑x = ↑(extension_of_max_adjoin.fst i x) + (extension_of_max_adjoin.snd i x) • y := +(extension_of_max_adjoin.aux1 i x).some_spec.some_spec + +variables (f) +/--the ideal `I = {r | r • y ∈ N}`-/ +def extension_of_max_adjoin.ideal (y : N) : + ideal R := +(extension_of_max i f).domain.comap ((linear_map.id : R →ₗ[R] R).smul_right y) + +/--A linear map `I ⟶ Q` by `x ↦ f' (x • y)` where `f'` is the maximal extension-/ +def extension_of_max_adjoin.ideal_to (y : N) : + extension_of_max_adjoin.ideal i f y →ₗ[R] Q := +{ to_fun := λ z, (extension_of_max i f).to_linear_pmap ⟨(↑z : R) • y, z.prop⟩, + map_add' := λ z1 z2, by simp [← (extension_of_max i f).to_linear_pmap.map_add, add_smul], + map_smul' := λ z1 z2, by simp [← (extension_of_max i f).to_linear_pmap.map_smul, mul_smul]; refl } + +/-- Since we assumed `Q` being Baer, the linear map `x ↦ f' (x • y) : I ⟶ Q` extends to `R ⟶ Q`, +call this extended map `φ`-/ +def extension_of_max_adjoin.extend_ideal_to (h : module.Baer R Q) (y : N) : R →ₗ[R] Q := +(h (extension_of_max_adjoin.ideal i f y) (extension_of_max_adjoin.ideal_to i f y)).some + +lemma extension_of_max_adjoin.extend_ideal_to_is_extension (h : module.Baer R Q) (y : N) : + ∀ (x : R) (mem : x ∈ extension_of_max_adjoin.ideal i f y), + extension_of_max_adjoin.extend_ideal_to i f h y x = + extension_of_max_adjoin.ideal_to i f y ⟨x, mem⟩ := +(h (extension_of_max_adjoin.ideal i f y) (extension_of_max_adjoin.ideal_to i f y)).some_spec + +lemma extension_of_max_adjoin.extend_ideal_to_wd' (h : module.Baer R Q) {y : N} (r : R) + (eq1 : r • y = 0) : + extension_of_max_adjoin.extend_ideal_to i f h y r = 0 := +begin + rw extension_of_max_adjoin.extend_ideal_to_is_extension i f h y r + (by rw eq1; exact submodule.zero_mem _ : r • y ∈ _), + simp only [extension_of_max_adjoin.ideal_to, linear_map.coe_mk, eq1, subtype.coe_mk, + ← zero_mem_class.zero_def, (extension_of_max i f).to_linear_pmap.map_zero] +end + +lemma extension_of_max_adjoin.extend_ideal_to_wd (h : module.Baer R Q) {y : N} (r r' : R) + (eq1 : r • y = r' • y) : + extension_of_max_adjoin.extend_ideal_to i f h y r = + extension_of_max_adjoin.extend_ideal_to i f h y r' := +begin + rw [← sub_eq_zero, ← map_sub], + convert extension_of_max_adjoin.extend_ideal_to_wd' i f h (r - r') _, + rw [sub_smul, sub_eq_zero, eq1], +end + +lemma extension_of_max_adjoin.extend_ideal_to_eq (h : module.Baer R Q) {y : N} (r : R) + (hr : r • y ∈ (extension_of_max i f).domain) : + extension_of_max_adjoin.extend_ideal_to i f h y r = + (extension_of_max i f).to_linear_pmap ⟨r • y, hr⟩ := +by simp only [extension_of_max_adjoin.extend_ideal_to_is_extension i f h _ _ hr, + extension_of_max_adjoin.ideal_to, linear_map.coe_mk, subtype.coe_mk] + +/--We can finally define a linear map `M ⊔ ⟨y⟩ ⟶ Q` by `x + r • y ↦ f x + φ r` +-/ +def extension_of_max_adjoin.extension_to_fun (h : module.Baer R Q) + {y : N} : + (extension_of_max i f).domain ⊔ submodule.span R {y} → Q := +λ x, (extension_of_max i f).to_linear_pmap (extension_of_max_adjoin.fst i x) + + extension_of_max_adjoin.extend_ideal_to i f h y (extension_of_max_adjoin.snd i x) + +lemma extension_of_max_adjoin.extension_to_fun_wd (h : module.Baer R Q) + {y : N} (x : (extension_of_max i f).domain ⊔ submodule.span R {y}) + (a : (extension_of_max i f).domain) (r : R) + (eq1 : ↑x = ↑a + r • y) : + extension_of_max_adjoin.extension_to_fun i f h x = + (extension_of_max i f).to_linear_pmap a + + extension_of_max_adjoin.extend_ideal_to i f h y r := +begin + cases a with a ha, + rw subtype.coe_mk at eq1, + have eq2 : (extension_of_max_adjoin.fst i x - a : N) = (r - extension_of_max_adjoin.snd i x) • y, + { rwa [extension_of_max_adjoin.eqn, ← sub_eq_zero, ←sub_sub_sub_eq, + sub_eq_zero, ← sub_smul] at eq1 }, + have eq3 := extension_of_max_adjoin.extend_ideal_to_eq i f h (r - extension_of_max_adjoin.snd i x) + (by rw ← eq2; exact submodule.sub_mem _ (extension_of_max_adjoin.fst i x).2 ha), + simp only [map_sub, sub_smul, sub_eq_iff_eq_add] at eq3, + unfold extension_of_max_adjoin.extension_to_fun, + rw [eq3, ← add_assoc, ← (extension_of_max i f).to_linear_pmap.map_add, add_mem_class.mk_add_mk], + congr, + ext, + rw [subtype.coe_mk, add_sub, ← eq1], + exact eq_sub_of_add_eq (extension_of_max_adjoin.eqn _ _).symm +end + +/--The linear map `M ⊔ ⟨y⟩ ⟶ Q` by `x + r • y ↦ f x + φ r` is an extension of `f`-/ +def extension_of_max_adjoin (h : module.Baer R Q) (y : N) : + extension_of i f := +{ domain := (extension_of_max i f).domain ⊔ submodule.span R {y}, + le := le_trans (extension_of_max i f).le le_sup_left, + to_fun := + { to_fun := extension_of_max_adjoin.extension_to_fun i f h, + map_add' := λ a b, begin + have eq1 : ↑a + ↑b = + ↑((extension_of_max_adjoin.fst i a) + (extension_of_max_adjoin.fst i b)) + + (extension_of_max_adjoin.snd i a + extension_of_max_adjoin.snd i b) • y, + { rw [extension_of_max_adjoin.eqn, extension_of_max_adjoin.eqn, add_smul], + abel, }, + rw [extension_of_max_adjoin.extension_to_fun_wd i f h (a + b) _ _ eq1, + linear_pmap.map_add, map_add], + unfold extension_of_max_adjoin.extension_to_fun, + abel, + end, + map_smul' := λ r a, begin + rw [ring_hom.id_apply], + have eq1 : r • ↑a = ↑(r • extension_of_max_adjoin.fst i a) + + (r • extension_of_max_adjoin.snd i a) • y, + { rw [extension_of_max_adjoin.eqn, smul_add, smul_eq_mul, mul_smul], + refl, }, + rw [extension_of_max_adjoin.extension_to_fun_wd i f h (r • a) _ _ eq1, + linear_map.map_smul, linear_pmap.map_smul, ← smul_add], + congr', + end }, + is_extension := λ m, begin + simp only [linear_pmap.mk_apply, linear_map.coe_mk], + rw [(extension_of_max i f).is_extension, extension_of_max_adjoin.extension_to_fun_wd i f h + _ ⟨i m, _⟩ 0 _, map_zero, add_zero], + simp, + end } + +lemma extension_of_max_le (h : module.Baer R Q) {y : N} : + extension_of_max i f ≤ extension_of_max_adjoin i f h y := +⟨le_sup_left, λ x x' EQ, begin + symmetry, + change extension_of_max_adjoin.extension_to_fun i f h _ = _, + rw [extension_of_max_adjoin.extension_to_fun_wd i f h x' x 0 (by simp [EQ]), map_zero, add_zero], +end⟩ + +lemma extension_of_max_to_submodule_eq_top (h : module.Baer R Q) : + (extension_of_max i f).domain = ⊤ := +begin + refine submodule.eq_top_iff'.mpr (λ y, _), + rw [← extension_of_max_is_max i f _ (extension_of_max_le i f h), extension_of_max_adjoin, + submodule.mem_sup], + exact ⟨0, submodule.zero_mem _, y, submodule.mem_span_singleton_self _, zero_add _⟩ +end + +/--**Baer's criterion** for injective module : a Baer module is an injective module, i.e. if every +linear map from an ideal can be extended, then the module is injective.-/ +protected theorem injective (h : module.Baer R Q) : + module.injective R Q := +{ out := λ X Y ins1 ins2 ins3 ins4 i hi f, begin + haveI : fact (function.injective i) := ⟨hi⟩, + exact ⟨{ to_fun := λ y, (extension_of_max i f).to_linear_pmap + ⟨y, (extension_of_max_to_submodule_eq_top i f h).symm ▸ trivial⟩, + map_add' := λ x y, by { rw ← linear_pmap.map_add, congr, }, + map_smul' := λ r x, by { rw ← linear_pmap.map_smul, congr } }, + λ x, ((extension_of_max i f).is_extension x).symm⟩, + end } + +end module.Baer diff --git a/src/algebra/module/linear_map.lean b/src/algebra/module/linear_map.lean index abda3d037225b..17767837fbf4f 100644 --- a/src/algebra/module/linear_map.lean +++ b/src/algebra/module/linear_map.lean @@ -4,16 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne Baanen, Frédéric Dupuis, Heather Macbeth -/ -import algebra.hom.group import algebra.hom.group_action -import algebra.module.basic import algebra.module.pi -import algebra.ring.comp_typeclasses import algebra.star.basic +import data.set.pointwise.smul +import algebra.ring.comp_typeclasses /-! # (Semi)linear maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define * `linear_map σ M M₂`, `M →ₛₗ[σ] M₂` : a semilinear map between two `module`s. Here, @@ -53,8 +55,10 @@ To ensure that composition works smoothly for semilinear maps, we use the typecl linear map -/ +assert_not_exists submonoid +assert_not_exists finset + open function -open_locale big_operators universes u u' v w x y z variables {R : Type*} {R₁ : Type*} {R₂ : Type*} {R₃ : Type*} @@ -88,8 +92,6 @@ structure linear_map {R : Type*} {S : Type*} [semiring R] [semiring S] (σ : R extends add_hom M M₂ := (map_smul' : ∀ (r : R) (x : M), to_fun (r • x) = (σ r) • to_fun x) -end - /-- The `add_hom` underlying a `linear_map`. -/ add_decl_doc linear_map.to_add_hom @@ -97,6 +99,65 @@ notation M ` →ₛₗ[`:25 σ:25 `] `:0 M₂:0 := linear_map σ M M₂ notation M ` →ₗ[`:25 R:25 `] `:0 M₂:0 := linear_map (ring_hom.id R) M M₂ notation M ` →ₗ⋆[`:25 R:25 `] `:0 M₂:0 := linear_map (star_ring_end R) M M₂ +/-- `semilinear_map_class F σ M M₂` asserts `F` is a type of bundled `σ`-semilinear maps `M → M₂`. + +See also `linear_map_class F R M M₂` for the case where `σ` is the identity map on `R`. + +A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S` +is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and +`f (c • x) = (σ c) • f x`. -/ +class semilinear_map_class (F : Type*) {R S : out_param Type*} [semiring R] [semiring S] + (σ : out_param $ R →+* S) (M M₂ : out_param Type*) + [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module S M₂] + extends add_hom_class F M M₂ := +(map_smulₛₗ : ∀ (f : F) (r : R) (x : M), f (r • x) = (σ r) • f x) + +end + +-- `σ` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] semilinear_map_class.to_add_hom_class + +export semilinear_map_class (map_smulₛₗ) +attribute [simp] map_smulₛₗ + +/-- `linear_map_class F R M M₂` asserts `F` is a type of bundled `R`-linear maps `M → M₂`. + +This is an abbreviation for `semilinear_map_class F (ring_hom.id R) M M₂`. +-/ +abbreviation linear_map_class (F : Type*) (R M M₂ : out_param Type*) + [semiring R] [add_comm_monoid M] [add_comm_monoid M₂] [module R M] [module R M₂] := +semilinear_map_class F (ring_hom.id R) M M₂ + +namespace semilinear_map_class + +variables (F : Type*) +variables [semiring R] [semiring S] +variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃] +variables [add_comm_monoid N₁] [add_comm_monoid N₂] [add_comm_monoid N₃] +variables [module R M] [module R M₂] [module S M₃] +variables {σ : R →+* S} + +@[priority 100, nolint dangerous_instance] -- `σ` is an `out_param` so it's not dangerous +instance [semilinear_map_class F σ M M₃] : add_monoid_hom_class F M M₃ := +{ coe := λ f, (f : M → M₃), + map_zero := λ f, show f 0 = 0, by { rw [← zero_smul R (0 : M), map_smulₛₗ], simp }, + .. semilinear_map_class.to_add_hom_class F σ M M₃ } + +@[priority 100, nolint dangerous_instance] -- `R` is an `out_param` so it's not dangerous +instance [linear_map_class F R M M₂] : distrib_mul_action_hom_class F R M M₂ := +{ coe := λ f, (f : M → M₂), + map_smul := λ f c x, by rw [map_smulₛₗ, ring_hom.id_apply], + .. semilinear_map_class.add_monoid_hom_class F } + +variables {F} (f : F) [i : semilinear_map_class F σ M M₃] +include i + +lemma map_smul_inv {σ' : S →+* R} [ring_hom_inv_pair σ σ'] (c : S) (x : M) : + c • f x = f (σ' c • x) := +by simp + +end semilinear_map_class + namespace linear_map section add_comm_monoid @@ -109,20 +170,20 @@ variables [add_comm_monoid N₁] [add_comm_monoid N₂] [add_comm_monoid N₃] variables [module R M] [module R M₂] [module S M₃] variables {σ : R →+* S} -instance : add_monoid_hom_class (M →ₛₗ[σ] M₃) M M₃ := +instance : semilinear_map_class (M →ₛₗ[σ] M₃) σ M M₃ := { coe := linear_map.to_fun, coe_injective' := λ f g h, by cases f; cases g; congr', map_add := linear_map.map_add', - map_zero := λ f, show f.to_fun 0 = 0, by { rw [← zero_smul R (0 : M), f.map_smul'], simp } } - -/-- The `distrib_mul_action_hom` underlying a `linear_map`. -/ -def to_distrib_mul_action_hom (f : M →ₗ[R] M₂) : distrib_mul_action_hom R M M₂ := -{ map_zero' := show f 0 = 0, from map_zero f, ..f } + map_smulₛₗ := linear_map.map_smul' } /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` directly. -/ -instance : has_coe_to_fun (M →ₛₗ[σ] M₃) (λ _, M → M₃) := ⟨linear_map.to_fun⟩ +instance : has_coe_to_fun (M →ₛₗ[σ] M₃) (λ _, M → M₃) := ⟨λ f, f⟩ + +/-- The `distrib_mul_action_hom` underlying a `linear_map`. -/ +def to_distrib_mul_action_hom (f : M →ₗ[R] M₂) : distrib_mul_action_hom R M M₂ := +{ map_zero' := show f 0 = 0, from map_zero f, ..f } @[simp] lemma to_fun_eq_coe {f : M →ₛₗ[σ] M₃} : f.to_fun = (f : M → M₃) := rfl @@ -135,6 +196,14 @@ protected def copy (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) map_add' := h.symm ▸ f.map_add', map_smul' := h.symm ▸ f.map_smul' } +@[simp] lemma coe_copy (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : ⇑(f.copy f' h) = f' := rfl +lemma copy_eq (f : M →ₛₗ[σ] M₃) (f' : M → M₃) (h : f' = ⇑f) : f.copy f' h = f := fun_like.ext' h + +/-- See Note [custom simps projection]. -/ +protected def simps.apply {R S : Type*} [semiring R] [semiring S] (σ : R →+* S) + (M M₃ : Type*) [add_comm_monoid M] [add_comm_monoid M₃] [module R M] [module S M₃] + (f : M →ₛₗ[σ] M₃) : M → M₃ := f + initialize_simps_projections linear_map (to_fun → apply) @[simp] lemma coe_mk {σ : R →+* S} (f : M → M₃) (h₁ h₂) : @@ -181,17 +250,14 @@ fun_like.ext_iff variables (fₗ gₗ f g) protected lemma map_add (x y : M) : f (x + y) = f x + f y := map_add f x y - -@[simp] lemma map_smulₛₗ (c : R) (x : M) : f (c • x) = (σ c) • f x := f.map_smul' c x - -lemma map_smul (c : R) (x : M) : fₗ (c • x) = c • fₗ x := fₗ.map_smul' c x - -lemma map_smul_inv {σ' : S →+* R} [ring_hom_inv_pair σ σ'] (c : S) (x : M) : +protected lemma map_zero : f 0 = 0 := map_zero f +-- TODO: `simp` isn't picking up `map_smulₛₗ` for `linear_map`s without specifying `map_smulₛₗ f` +@[simp] protected lemma map_smulₛₗ (c : R) (x : M) : f (c • x) = (σ c) • f x := map_smulₛₗ f c x +protected lemma map_smul (c : R) (x : M) : fₗ (c • x) = c • fₗ x := map_smul fₗ c x +protected lemma map_smul_inv {σ' : S →+* R} [ring_hom_inv_pair σ σ'] (c : S) (x : M) : c • f x = f (σ' c • x) := by simp -protected lemma map_zero : f 0 = 0 := map_zero f - -- TODO: generalize to `zero_hom_class` @[simp] lemma map_eq_zero_iff (h : function.injective f) {x : M} : f x = 0 ↔ x = 0 := ⟨λ w, by { apply h, simp [w], }, λ w, by { subst w, simp, }⟩ @@ -199,61 +265,65 @@ protected lemma map_zero : f 0 = 0 := map_zero f section pointwise open_locale pointwise -@[simp] lemma image_smul_setₛₗ (c : R) (s : set M) : - f '' (c • s) = (σ c) • f '' s := +variables (M M₃ σ) {F : Type*} (h : F) + +@[simp] lemma _root_.image_smul_setₛₗ [semilinear_map_class F σ M M₃] (c : R) (s : set M) : + h '' (c • s) = (σ c) • h '' s := begin apply set.subset.antisymm, { rintros x ⟨y, ⟨z, zs, rfl⟩, rfl⟩, - exact ⟨f z, set.mem_image_of_mem _ zs, (f.map_smulₛₗ _ _).symm ⟩ }, + exact ⟨h z, set.mem_image_of_mem _ zs, (map_smulₛₗ _ _ _).symm ⟩ }, { rintros x ⟨y, ⟨z, hz, rfl⟩, rfl⟩, - exact (set.mem_image _ _ _).2 ⟨c • z, set.smul_mem_smul_set hz, f.map_smulₛₗ _ _⟩ } + exact (set.mem_image _ _ _).2 ⟨c • z, set.smul_mem_smul_set hz, map_smulₛₗ _ _ _⟩ } end -lemma image_smul_set (c : R) (s : set M) : - fₗ '' (c • s) = c • fₗ '' s := -by simp - -lemma preimage_smul_setₛₗ {c : R} (hc : is_unit c) (s : set M₃) : - f ⁻¹' (σ c • s) = c • f ⁻¹' s := +lemma _root_.preimage_smul_setₛₗ [semilinear_map_class F σ M M₃] {c : R} (hc : is_unit c) + (s : set M₃) : h ⁻¹' (σ c • s) = c • h ⁻¹' s := begin apply set.subset.antisymm, { rintros x ⟨y, ys, hy⟩, refine ⟨(hc.unit.inv : R) • x, _, _⟩, - { simp only [←hy, smul_smul, set.mem_preimage, units.inv_eq_coe_inv, map_smulₛₗ, ← σ.map_mul, - is_unit.coe_inv_mul, one_smul, ring_hom.map_one, ys] }, + { simp only [←hy, smul_smul, set.mem_preimage, units.inv_eq_coe_inv, map_smulₛₗ h, ← map_mul, + is_unit.coe_inv_mul, one_smul, map_one, ys] }, { simp only [smul_smul, is_unit.mul_coe_inv, one_smul, units.inv_eq_coe_inv] } }, { rintros x ⟨y, hy, rfl⟩, - refine ⟨f y, hy, by simp only [ring_hom.id_apply, linear_map.map_smulₛₗ]⟩ } + refine ⟨h y, hy, by simp only [ring_hom.id_apply, map_smulₛₗ h]⟩ } end -lemma preimage_smul_set {c : R} (hc : is_unit c) (s : set M₂) : - fₗ ⁻¹' (c • s) = c • fₗ ⁻¹' s := -fₗ.preimage_smul_setₛₗ hc s +variables (R M₂) + +lemma _root_.image_smul_set [linear_map_class F R M M₂] (c : R) (s : set M) : + h '' (c • s) = c • h '' s := +image_smul_setₛₗ _ _ _ h c s + +lemma _root_.preimage_smul_set [linear_map_class F R M M₂] {c : R} (hc : is_unit c) (s : set M₂) : + h ⁻¹' (c • s) = c • h ⁻¹' s := +preimage_smul_setₛₗ _ _ _ h hc s end pointwise variables (M M₂) /-- -A typeclass for `has_scalar` structures which can be moved through a `linear_map`. +A typeclass for `has_smul` structures which can be moved through a `linear_map`. This typeclass is generated automatically from a `is_scalar_tower` instance, but exists so that we can also add an instance for `add_comm_group.int_module`, allowing `z •` to be moved even if `R` does not support negation. -/ -class compatible_smul (R S : Type*) [semiring S] [has_scalar R M] - [module S M] [has_scalar R M₂] [module S M₂] := +class compatible_smul (R S : Type*) [semiring S] [has_smul R M] + [module S M] [has_smul R M₂] [module S M₂] := (map_smul : ∀ (fₗ : M →ₗ[S] M₂) (c : R) (x : M), fₗ (c • x) = c • fₗ x) variables {M M₂} @[priority 100] instance is_scalar_tower.compatible_smul - {R S : Type*} [semiring S] [has_scalar R S] - [has_scalar R M] [module S M] [is_scalar_tower R S M] - [has_scalar R M₂] [module S M₂] [is_scalar_tower R S M₂] : compatible_smul M M₂ R S := + {R S : Type*} [semiring S] [has_smul R S] + [has_smul R M] [module S M] [is_scalar_tower R S M] + [has_smul R M₂] [module S M₂] [is_scalar_tower R S M₂] : compatible_smul M M₂ R S := ⟨λ fₗ c x, by rw [← smul_one_smul S c x, ← smul_one_smul S c (fₗ x), map_smul]⟩ @[simp, priority 900] -lemma map_smul_of_tower {R S : Type*} [semiring S] [has_scalar R M] - [module S M] [has_scalar R M₂] [module S M₂] +lemma map_smul_of_tower {R S : Type*} [semiring S] [has_smul R M] + [module S M] [has_smul R M₂] [module S M₂] [compatible_smul M M₂ R S] (fₗ : M →ₗ[S] M₂) (c : R) (x : M) : fₗ (c • x) = c • fₗ x := compatible_smul.map_smul fₗ c x @@ -299,10 +369,6 @@ end restrict_scalars variable {R} -@[simp] lemma map_sum {ι} {t : finset ι} {g : ι → M} : - f (∑ i in t, g i) = (∑ i in t, f (g i)) := -f.to_add_monoid_hom.map_sum _ _ - theorem to_add_monoid_hom_injective : function.injective (to_add_monoid_hom : (M →ₛₗ[σ] M₃) → (M →+ M₃)) := λ f g h, ext $ add_monoid_hom.congr_fun h @@ -551,7 +617,7 @@ by { intros f g h, ext, exact linear_map.congr_fun h x } namespace linear_map -section has_scalar +section has_smul variables [semiring R] [semiring R₂] [semiring R₃] variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] @@ -561,7 +627,7 @@ variables [monoid S] [distrib_mul_action S M₂] [smul_comm_class R₂ S M₂] variables [monoid S₃] [distrib_mul_action S₃ M₃] [smul_comm_class R₃ S₃ M₃] variables [monoid T] [distrib_mul_action T M₂] [smul_comm_class R₂ T M₂] -instance : has_scalar S (M →ₛₗ[σ₁₂] M₂) := +instance : has_smul S (M →ₛₗ[σ₁₂] M₂) := ⟨λ a f, { to_fun := a • f, map_add' := λ x y, by simp only [pi.smul_apply, f.map_add, smul_add], map_smul' := λ c x, by simp [pi.smul_apply, smul_comm (σ₁₂ c)] }⟩ @@ -575,14 +641,14 @@ instance [smul_comm_class S T M₂] : smul_comm_class S T (M →ₛₗ[σ₁₂] -- example application of this instance: if S -> T -> R are homomorphisms of commutative rings and -- M and M₂ are R-modules then the S-module and T-module structures on Hom_R(M,M₂) are compatible. -instance [has_scalar S T] [is_scalar_tower S T M₂] : is_scalar_tower S T (M →ₛₗ[σ₁₂] M₂) := +instance [has_smul S T] [is_scalar_tower S T M₂] : is_scalar_tower S T (M →ₛₗ[σ₁₂] M₂) := { smul_assoc := λ _ _ _, ext $ λ _, smul_assoc _ _ _ } instance [distrib_mul_action Sᵐᵒᵖ M₂] [smul_comm_class R₂ Sᵐᵒᵖ M₂] [is_central_scalar S M₂] : is_central_scalar S (M →ₛₗ[σ₁₂] M₂) := { op_smul_eq_smul := λ a b, ext $ λ x, op_smul_eq_smul _ _ } -end has_scalar +end has_smul /-! ### Arithmetic on the codomain -/ section arithmetic @@ -613,7 +679,8 @@ instance : inhabited (M →ₛₗ[σ₁₂] M₂) := ⟨0⟩ /-- The sum of two linear maps is linear. -/ instance : has_add (M →ₛₗ[σ₁₂] M₂) := ⟨λ f g, { to_fun := f + g, - map_add' := by simp [add_comm, add_left_comm], map_smul' := by simp [smul_add] }⟩ + map_add' := by simp [add_comm, add_left_comm], + map_smul' := by simp [smul_add] }⟩ @[simp] lemma add_apply (f g : M →ₛₗ[σ₁₂] M₂) (x : M) : (f + g) x = f x + g x := rfl @@ -641,10 +708,10 @@ include σ₁₃ ext $ λ _, g.map_neg _ omit σ₁₃ -/-- The negation of a linear map is linear. -/ +/-- The subtraction of two linear maps is linear. -/ instance : has_sub (M →ₛₗ[σ₁₂] N₂) := ⟨λ f g, { to_fun := f - g, - map_add' := λ x y, by simp only [pi.sub_apply, map_add, add_sub_comm], + map_add' := λ x y, by simp only [pi.sub_apply, map_add, add_sub_add_comm], map_smul' := λ r x, by simp [pi.sub_apply, map_smul, smul_sub] }⟩ @[simp] lemma sub_apply (f g : M →ₛₗ[σ₁₂] N₂) (x : M) : (f - g) x = f x - g x := rfl @@ -672,7 +739,7 @@ variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] variables [module R M] [module R₂ M₂] [module R₃ M₃] variables {σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃} [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] -section has_scalar +section has_smul variables [monoid S] [distrib_mul_action S M₂] [smul_comm_class R₂ S M₂] variables [monoid S₃] [distrib_mul_action S₃ M₃] [smul_comm_class R₃ S₃ M₃] variables [monoid T] [distrib_mul_action T M₂] [smul_comm_class R₂ T M₂] @@ -694,7 +761,7 @@ theorem comp_smul [module R M₂] [module R M₃] [smul_comm_class R S M₂] [di (g : M₃ →ₗ[R] M₂) (a : S) (f : M →ₗ[R] M₃) : g.comp (a • f) = a • (g.comp f) := ext $ λ x, g.map_smul_of_tower _ _ -end has_scalar +end has_smul section module variables [semiring S] [module S M₂] [smul_comm_class R₂ S M₂] @@ -743,16 +810,30 @@ instance _root_.module.End.semiring : semiring (module.End R M) := one := (1 : M →ₗ[R] M), zero := 0, add := (+), - npow := @npow_rec _ ⟨(1 : M →ₗ[R] M)⟩ ⟨(*)⟩, mul_zero := comp_zero, zero_mul := zero_comp, left_distrib := λ f g h, comp_add _ _ _, right_distrib := λ f g h, add_comp _ _ _, + nat_cast := λ n, n • 1, + nat_cast_zero := add_monoid.nsmul_zero' _, + nat_cast_succ := λ n, (add_monoid.nsmul_succ' n 1).trans (add_comm _ _), + .. add_monoid_with_one.unary, .. _root_.module.End.monoid, .. linear_map.add_comm_monoid } +/-- See also `module.End.nat_cast_def`. -/ +@[simp] lemma _root_.module.End.nat_cast_apply (n : ℕ) (m : M) : + (↑n : module.End R M) m = n • m := rfl + instance _root_.module.End.ring : ring (module.End R N₁) := -{ ..module.End.semiring, ..linear_map.add_comm_group } +{ int_cast := λ z, z • 1, + int_cast_of_nat := of_nat_zsmul _, + int_cast_neg_succ_of_nat := zsmul_neg_succ_of_nat _, + ..module.End.semiring, ..linear_map.add_comm_group } + +/-- See also `module.End.int_cast_def`. -/ +@[simp] lemma _root_.module.End.int_cast_apply (z : ℤ) (m : N₁) : + (↑z : module.End R N₁) m = z • m := rfl section variables [monoid S] [distrib_mul_action S M] [smul_comm_class R S M] @@ -760,11 +841,11 @@ variables [monoid S] [distrib_mul_action S M] [smul_comm_class R S M] instance _root_.module.End.is_scalar_tower : is_scalar_tower S (module.End R M) (module.End R M) := ⟨smul_comp⟩ -instance _root_.module.End.smul_comm_class [has_scalar S R] [is_scalar_tower S R M] : +instance _root_.module.End.smul_comm_class [has_smul S R] [is_scalar_tower S R M] : smul_comm_class S (module.End R M) (module.End R M) := ⟨λ s _ _, (comp_smul _ s _).symm⟩ -instance _root_.module.End.smul_comm_class' [has_scalar S R] [is_scalar_tower S R M] : +instance _root_.module.End.smul_comm_class' [has_smul S R] [is_scalar_tower S R M] : smul_comm_class (module.End R M) S (module.End R M) := smul_comm_class.symm _ _ _ @@ -787,7 +868,7 @@ instance apply_module : module (module.End R M) M := @[simp] protected lemma smul_def (f : module.End R M) (a : M) : f • a = f a := rfl /-- `linear_map.apply_module` is faithful. -/ -instance apply_has_faithful_scalar : has_faithful_scalar (module.End R M) M := +instance apply_has_faithful_smul : has_faithful_smul (module.End R M) M := ⟨λ _ _, linear_map.ext⟩ instance apply_smul_comm_class : smul_comm_class R (module.End R M) M := @@ -816,7 +897,7 @@ variables [monoid S] [distrib_mul_action S M] [smul_comm_class S R M] This is a stronger version of `distrib_mul_action.to_add_monoid_hom`. -/ @[simps] def to_linear_map (s : S) : M →ₗ[R] M := -{ to_fun := has_scalar.smul s, +{ to_fun := has_smul.smul s, map_add' := smul_add s, map_smul' := λ a b, smul_comm _ _ _ } @@ -836,7 +917,7 @@ namespace module variables (R M) [semiring R] [add_comm_monoid M] [module R M] variables [semiring S] [module S M] [smul_comm_class S R M] -/-- Each element of the monoid defines a module endomorphism. +/-- Each element of the semiring defines a module endomorphism. This is a stronger version of `distrib_mul_action.to_module_End`. -/ @[simps] @@ -866,4 +947,10 @@ def module_End_self_op : R ≃+* module.End Rᵐᵒᵖ R := right_inv := λ f, linear_map.ext_ring_op $ mul_one _, ..module.to_module_End _ _ } +lemma End.nat_cast_def (n : ℕ) [add_comm_monoid N₁] [module R N₁] : + (↑n : module.End R N₁) = module.to_module_End R N₁ n := rfl + +lemma End.int_cast_def (z : ℤ) [add_comm_group N₁] [module R N₁] : + (↑z : module.End R N₁) = module.to_module_End R N₁ z := rfl + end module diff --git a/src/algebra/module/localized_module.lean b/src/algebra/module/localized_module.lean new file mode 100644 index 0000000000000..7df4bd5427c3b --- /dev/null +++ b/src/algebra/module/localized_module.lean @@ -0,0 +1,1007 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang, Jujian Zhang +-/ + +import group_theory.monoid_localization +import ring_theory.localization.basic +import algebra.algebra.restrict_scalars + +/-! +# Localized Module + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given a commutative ring `R`, a multiplicative subset `S ⊆ R` and an `R`-module `M`, we can localize +`M` by `S`. This gives us a `localization S`-module. + +## Main definitions + +* `localized_module.r` : the equivalence relation defining this localization, namely + `(m, s) ≈ (m', s')` if and only if if there is some `u : S` such that `u • s' • m = u • s • m'`. +* `localized_module M S` : the localized module by `S`. +* `localized_module.mk` : the canonical map sending `(m, s) : M × S ↦ m/s : localized_module M S` +* `localized_module.lift_on` : any well defined function `f : M × S → α` respecting `r` descents to + a function `localized_module M S → α` +* `localized_module.lift_on₂` : any well defined function `f : M × S → M × S → α` respecting `r` + descents to a function `localized_module M S → localized_module M S` +* `localized_module.mk_add_mk` : in the localized module + `mk m s + mk m' s' = mk (s' • m + s • m') (s * s')` +* `localized_module.mk_smul_mk` : in the localized module, for any `r : R`, `s t : S`, `m : M`, + we have `mk r s • mk m t = mk (r • m) (s * t)` where `mk r s : localization S` is localized ring + by `S`. +* `localized_module.is_module` : `localized_module M S` is a `localization S`-module. + +## Future work + + * Redefine `localization` for monoids and rings to coincide with `localized_module`. +-/ + + +namespace localized_module + +universes u v + +variables {R : Type u} [comm_semiring R] (S : submonoid R) +variables (M : Type v) [add_comm_monoid M] [module R M] + +/--The equivalence relation on `M × S` where `(m1, s1) ≈ (m2, s2)` if and only if +for some (u : S), u * (s2 • m1 - s1 • m2) = 0-/ +def r (a b : M × S) : Prop := +∃ (u : S), u • b.2 • a.1 = u • a.2 • b.1 + +lemma r.is_equiv : is_equiv _ (r S M) := +{ refl := λ ⟨m, s⟩, ⟨1, by rw [one_smul]⟩, + trans := λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨m3, s3⟩ ⟨u1, hu1⟩ ⟨u2, hu2⟩, begin + use u1 * u2 * s2, + -- Put everything in the same shape, sorting the terms using `simp` + have hu1' := congr_arg ((•) (u2 * s3)) hu1.symm, + have hu2' := congr_arg ((•) (u1 * s1)) hu2.symm, + simp only [← mul_smul, smul_assoc, mul_assoc, mul_comm, mul_left_comm] at ⊢ hu1' hu2', + rw [hu2', hu1'] + end, + symm := λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩, ⟨u, hu.symm⟩ } + +instance r.setoid : setoid (M × S) := +{ r := r S M, + iseqv := ⟨(r.is_equiv S M).refl, (r.is_equiv S M).symm, (r.is_equiv S M).trans⟩ } + +-- TODO: change `localization` to use `r'` instead of `r` so that the two types are also defeq, +-- `localization S = localized_module S R`. +example {R} [comm_semiring R] (S : submonoid R) : ⇑(localization.r' S) = localized_module.r S R := +rfl + +/-- +If `S` is a multiplicative subset of a ring `R` and `M` an `R`-module, then +we can localize `M` by `S`. +-/ +@[nolint has_nonempty_instance] +def _root_.localized_module : Type (max u v) := quotient (r.setoid S M) + +section +variables {M S} + +/--The canonical map sending `(m, s) ↦ m/s`-/ +def mk (m : M) (s : S) : localized_module S M := +quotient.mk ⟨m, s⟩ + +lemma mk_eq {m m' : M} {s s' : S} : mk m s = mk m' s' ↔ ∃ (u : S), u • s' • m = u • s • m' := +quotient.eq + +@[elab_as_eliminator] +lemma induction_on {β : localized_module S M → Prop} (h : ∀ (m : M) (s : S), β (mk m s)) : + ∀ (x : localized_module S M), β x := +by { rintro ⟨⟨m, s⟩⟩, exact h m s } + +@[elab_as_eliminator] +lemma induction_on₂ {β : localized_module S M → localized_module S M → Prop} + (h : ∀ (m m' : M) (s s' : S), β (mk m s) (mk m' s')) : ∀ x y, β x y := +by { rintro ⟨⟨m, s⟩⟩ ⟨⟨m', s'⟩⟩, exact h m m' s s' } + +/--If `f : M × S → α` respects the equivalence relation `localized_module.r`, then +`f` descents to a map `localized_module M S → α`. +-/ +def lift_on {α : Type*} (x : localized_module S M) (f : M × S → α) + (wd : ∀ (p p' : M × S) (h1 : p ≈ p'), f p = f p') : α := +quotient.lift_on x f wd + +lemma lift_on_mk {α : Type*} {f : M × S → α} + (wd : ∀ (p p' : M × S) (h1 : p ≈ p'), f p = f p') + (m : M) (s : S) : + lift_on (mk m s) f wd = f ⟨m, s⟩ := +by convert quotient.lift_on_mk f wd ⟨m, s⟩ + +/--If `f : M × S → M × S → α` respects the equivalence relation `localized_module.r`, then +`f` descents to a map `localized_module M S → localized_module M S → α`. +-/ +def lift_on₂ {α : Type*} (x y : localized_module S M) (f : (M × S) → (M × S) → α) + (wd : ∀ (p q p' q' : M × S) (h1 : p ≈ p') (h2 : q ≈ q'), f p q = f p' q') : α := +quotient.lift_on₂ x y f wd + +lemma lift_on₂_mk {α : Type*} (f : (M × S) → (M × S) → α) + (wd : ∀ (p q p' q' : M × S) (h1 : p ≈ p') (h2 : q ≈ q'), f p q = f p' q') + (m m' : M) (s s' : S) : + lift_on₂ (mk m s) (mk m' s') f wd = f ⟨m, s⟩ ⟨m', s'⟩ := +by convert quotient.lift_on₂_mk f wd _ _ + +instance : has_zero (localized_module S M) := ⟨mk 0 1⟩ +@[simp] lemma zero_mk (s : S) : mk (0 : M) s = 0 := +mk_eq.mpr ⟨1, by rw [one_smul, smul_zero, smul_zero, one_smul]⟩ + +instance : has_add (localized_module S M) := +{ add := λ p1 p2, lift_on₂ p1 p2 (λ x y, mk (y.2 • x.1 + x.2 • y.1) (x.2 * y.2)) $ + λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨m1', s1'⟩ ⟨m2', s2'⟩ ⟨u1, hu1⟩ ⟨u2, hu2⟩, mk_eq.mpr ⟨u1 * u2, begin + -- Put everything in the same shape, sorting the terms using `simp` + have hu1' := congr_arg ((•) (u2 * s2 * s2')) hu1, + have hu2' := congr_arg ((•) (u1 * s1 * s1')) hu2, + simp only [smul_add, ← mul_smul, smul_assoc, mul_assoc, mul_comm, mul_left_comm] + at ⊢ hu1' hu2', + rw [hu1', hu2'] + end⟩ } + +lemma mk_add_mk {m1 m2 : M} {s1 s2 : S} : + mk m1 s1 + mk m2 s2 = mk (s2 • m1 + s1 • m2) (s1 * s2) := +mk_eq.mpr $ ⟨1, by dsimp only; rw [one_smul]⟩ + +private lemma add_assoc' (x y z : localized_module S M) : + x + y + z = x + (y + z) := +begin + induction x using localized_module.induction_on with mx sx, + induction y using localized_module.induction_on with my sy, + induction z using localized_module.induction_on with mz sz, + simp only [mk_add_mk, smul_add], + refine mk_eq.mpr ⟨1, _⟩, + rw [one_smul, one_smul], + congr' 1, + { rw [mul_assoc] }, + { rw [eq_comm, mul_comm, add_assoc, mul_smul, mul_smul, ←mul_smul sx sz, mul_comm, mul_smul], }, +end + +private lemma add_comm' (x y : localized_module S M) : + x + y = y + x := +localized_module.induction_on₂ (λ m m' s s', by rw [mk_add_mk, mk_add_mk, add_comm, mul_comm]) x y + +private lemma zero_add' (x : localized_module S M) : 0 + x = x := +induction_on (λ m s, by rw [← zero_mk s, mk_add_mk, smul_zero, zero_add, mk_eq]; + exact ⟨1, by rw [one_smul, mul_smul, one_smul]⟩) x + +private lemma add_zero' (x : localized_module S M) : x + 0 = x := +induction_on (λ m s, by rw [← zero_mk s, mk_add_mk, smul_zero, add_zero, mk_eq]; + exact ⟨1, by rw [one_smul, mul_smul, one_smul]⟩) x + +instance has_nat_smul : has_smul ℕ (localized_module S M) := +{ smul := λ n, nsmul_rec n } + +private lemma nsmul_zero' (x : localized_module S M) : (0 : ℕ) • x = 0 := +localized_module.induction_on (λ _ _, rfl) x +private lemma nsmul_succ' (n : ℕ) (x : localized_module S M) : + n.succ • x = x + n • x := +localized_module.induction_on (λ _ _, rfl) x + +instance : add_comm_monoid (localized_module S M) := +{ add := (+), + add_assoc := add_assoc', + zero := 0, + zero_add := zero_add', + add_zero := add_zero', + nsmul := (•), + nsmul_zero' := nsmul_zero', + nsmul_succ' := nsmul_succ', + add_comm := add_comm' } + +instance {M : Type*} [add_comm_group M] [module R M] : + add_comm_group (localized_module S M) := +{ neg := λ p, lift_on p (λ x, localized_module.mk (-x.1) x.2) + (λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩, by { rw mk_eq, exact ⟨u, by simpa⟩ }), + add_left_neg := λ p, begin + obtain ⟨⟨m, s⟩, rfl : mk m s = p⟩ := quotient.exists_rep p, + change (mk m s).lift_on (λ x, mk (-x.1) x.2) + (λ ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩, by { rw mk_eq, exact ⟨u, by simpa⟩ }) + mk m s = 0, + rw [lift_on_mk, mk_add_mk], + simp + end, + ..(show add_comm_monoid (localized_module S M), by apply_instance) } + +lemma mk_neg {M : Type*} [add_comm_group M] [module R M] {m : M} {s : S} : + mk (-m) s = - mk m s := rfl + +instance {A : Type*} [semiring A] [algebra R A] {S : submonoid R} : + semiring (localized_module S A) := +{ mul := λ m₁ m₂, lift_on₂ m₁ m₂ (λ x₁ x₂, localized_module.mk (x₁.1 * x₂.1) (x₁.2 * x₂.2)) + (begin + rintros ⟨a₁, s₁⟩ ⟨a₂, s₂⟩ ⟨b₁, t₁⟩ ⟨b₂, t₂⟩ ⟨u₁, e₁⟩ ⟨u₂, e₂⟩, + rw mk_eq, + use u₁ * u₂, + dsimp only at ⊢ e₁ e₂, + rw eq_comm, + transitivity (u₁ • t₁ • a₁) • u₂ • t₂ • a₂, + rw [e₁, e₂], swap, rw eq_comm, + all_goals { rw [smul_smul, mul_mul_mul_comm, ← smul_eq_mul, ← smul_eq_mul A, + smul_smul_smul_comm, mul_smul, mul_smul] } + end), + left_distrib := begin + intros x₁ x₂ x₃, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := quotient.exists_rep x₃, + apply mk_eq.mpr _, + use 1, + simp only [one_mul, smul_add, mul_add, mul_smul_comm, smul_smul, ← mul_assoc, mul_right_comm] + end, + right_distrib := begin + intros x₁ x₂ x₃, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := quotient.exists_rep x₃, + apply mk_eq.mpr _, + use 1, + simp only [one_mul, smul_add, add_mul, smul_smul, ← mul_assoc, smul_mul_assoc, mul_right_comm], + end, + zero_mul := begin + intros x, + obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x, + exact mk_eq.mpr ⟨1, by simp only [zero_mul, smul_zero]⟩, + end, + mul_zero := begin + intros x, + obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x, + exact mk_eq.mpr ⟨1, by simp only [mul_zero, smul_zero]⟩, + end, + mul_assoc := begin + intros x₁ x₂ x₃, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := quotient.exists_rep x₃, + apply mk_eq.mpr _, + use 1, + simp only [one_mul, smul_smul, ← mul_assoc, mul_right_comm], + end, + one := mk 1 (1 : S), + one_mul := begin + intros x, + obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x, + exact mk_eq.mpr ⟨1, by simp only [one_mul, one_smul]⟩, + end, + mul_one := begin + intros x, + obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x, + exact mk_eq.mpr ⟨1, by simp only [mul_one, one_smul]⟩, + end, + ..(show add_comm_monoid (localized_module S A), by apply_instance) } + +instance {A : Type*} [comm_semiring A] [algebra R A] {S : submonoid R} : + comm_semiring (localized_module S A) := +{ mul_comm := begin + intros x₁ x₂, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + exact mk_eq.mpr ⟨1, by simp only [one_smul, mul_comm]⟩ + end, + ..(show semiring (localized_module S A), by apply_instance) } + +instance {A : Type*} [ring A] [algebra R A] {S : submonoid R} : + ring (localized_module S A) := +{ ..(show add_comm_group (localized_module S A), by apply_instance), + ..(show monoid (localized_module S A), by apply_instance), + ..(show distrib (localized_module S A), by apply_instance) } + +instance {A : Type*} [comm_ring A] [algebra R A] {S : submonoid R} : + comm_ring (localized_module S A) := +{ mul_comm := begin + intros x₁ x₂, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + exact mk_eq.mpr ⟨1, by simp only [one_smul, mul_comm]⟩ + end, + ..(show ring (localized_module S A), by apply_instance) } + +lemma mk_mul_mk {A : Type*} [semiring A] [algebra R A] {a₁ a₂ : A} {s₁ s₂ : S} : + mk a₁ s₁ * mk a₂ s₂ = mk (a₁ * a₂) (s₁ * s₂) := +rfl + +instance : has_smul (localization S) (localized_module S M) := +{ smul := λ f x, localization.lift_on f (λ r s, lift_on x (λ p, mk (r • p.1) (s * p.2)) + begin + rintros ⟨m1, t1⟩ ⟨m2, t2⟩ ⟨u, h⟩, + refine mk_eq.mpr ⟨u, _⟩, + have h' := congr_arg ((•) (s • r)) h, + simp only [← mul_smul, smul_assoc, mul_comm, mul_left_comm, submonoid.smul_def, + submonoid.coe_mul] at ⊢ h', + rw h', + end) begin + induction x using localized_module.induction_on with m t, + rintros r r' s s' h, + simp only [lift_on_mk, lift_on_mk, mk_eq], + obtain ⟨u, eq1⟩ := localization.r_iff_exists.mp h, + use u, + have eq1' := congr_arg (• (t • m)) eq1, + simp only [← mul_smul, smul_assoc, submonoid.smul_def, submonoid.coe_mul] at ⊢ eq1', + ring_nf at ⊢ eq1', + rw eq1' + end } + +lemma mk_smul_mk (r : R) (m : M) (s t : S) : + localization.mk r s • mk m t = mk (r • m) (s * t) := +begin + unfold has_smul.smul, + rw [localization.lift_on_mk, lift_on_mk], +end + +private lemma one_smul' (m : localized_module S M) : + (1 : localization S) • m = m := +begin + induction m using localized_module.induction_on with m s, + rw [← localization.mk_one, mk_smul_mk, one_smul, one_mul], +end + +private lemma mul_smul' (x y : localization S) (m : localized_module S M) : + (x * y) • m = x • y • m := +begin + induction x using localization.induction_on with data, + induction y using localization.induction_on with data', + rcases ⟨data, data'⟩ with ⟨⟨r, s⟩, ⟨r', s'⟩⟩, + + induction m using localized_module.induction_on with m t, + rw [localization.mk_mul, mk_smul_mk, mk_smul_mk, mk_smul_mk, mul_smul, mul_assoc], +end + +private lemma smul_add' (x : localization S) (y z : localized_module S M) : + x • (y + z) = x • y + x • z := +begin + induction x using localization.induction_on with data, + rcases data with ⟨r, u⟩, + induction y using localized_module.induction_on with m s, + induction z using localized_module.induction_on with n t, + rw [mk_smul_mk, mk_smul_mk, mk_add_mk, mk_smul_mk, mk_add_mk, mk_eq], + use 1, + simp only [one_smul, smul_add, ← mul_smul, submonoid.smul_def, submonoid.coe_mul], + ring_nf +end + +private lemma smul_zero' (x : localization S) : + x • (0 : localized_module S M) = 0 := +begin + induction x using localization.induction_on with data, + rcases data with ⟨r, s⟩, + rw [←zero_mk s, mk_smul_mk, smul_zero, zero_mk, zero_mk], +end + +private lemma add_smul' (x y : localization S) (z : localized_module S M) : + (x + y) • z = x • z + y • z := +begin + induction x using localization.induction_on with datax, + induction y using localization.induction_on with datay, + induction z using localized_module.induction_on with m t, + rcases ⟨datax, datay⟩ with ⟨⟨r, s⟩, ⟨r', s'⟩⟩, + rw [localization.add_mk, mk_smul_mk, mk_smul_mk, mk_smul_mk, mk_add_mk, mk_eq], + use 1, + simp only [one_smul, add_smul, smul_add, ← mul_smul, submonoid.smul_def, submonoid.coe_mul, + submonoid.coe_one], + rw add_comm, -- Commutativity of addition in the module is not applied by `ring`. + ring_nf, +end + +private lemma zero_smul' (x : localized_module S M) : + (0 : localization S) • x = 0 := +begin + induction x using localized_module.induction_on with m s, + rw [← localization.mk_zero s, mk_smul_mk, zero_smul, zero_mk], +end + +instance is_module : module (localization S) (localized_module S M) := +{ smul := (•), + one_smul := one_smul', + mul_smul := mul_smul', + smul_add := smul_add', + smul_zero := smul_zero', + add_smul := add_smul', + zero_smul := zero_smul' } + +@[simp] lemma mk_cancel_common_left (s' s : S) (m : M) : mk (s' • m) (s' * s) = mk m s := +mk_eq.mpr ⟨1, by { simp only [mul_smul, one_smul], rw smul_comm }⟩ + +@[simp] lemma mk_cancel (s : S) (m : M) : mk (s • m) s = mk m 1 := +mk_eq.mpr ⟨1, by simp⟩ + +@[simp] lemma mk_cancel_common_right (s s' : S) (m : M) : mk (s' • m) (s * s') = mk m s := +mk_eq.mpr ⟨1, by simp [mul_smul]⟩ + +instance is_module' : module R (localized_module S M) := +{ ..module.comp_hom (localized_module S M) $ (algebra_map R (localization S)) } + +lemma smul'_mk (r : R) (s : S) (m : M) : r • mk m s = mk (r • m) s := +by erw [mk_smul_mk r m 1 s, one_mul] + +instance {A : Type*} [semiring A] [algebra R A] : + algebra (localization S) (localized_module S A) := +algebra.of_module +begin + intros r x₁ x₂, + obtain ⟨y, s, rfl : is_localization.mk' _ y s = r⟩ := is_localization.mk'_surjective S r, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + rw [mk_mul_mk, ← localization.mk_eq_mk', mk_smul_mk, mk_smul_mk, mk_mul_mk, + mul_assoc, smul_mul_assoc], +end +begin + intros r x₁ x₂, + obtain ⟨y, s, rfl : is_localization.mk' _ y s = r⟩ := is_localization.mk'_surjective S r, + obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := quotient.exists_rep x₁, + obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := quotient.exists_rep x₂, + rw [mk_mul_mk, ← localization.mk_eq_mk', mk_smul_mk, mk_smul_mk, mk_mul_mk, + mul_left_comm, mul_smul_comm] +end + +lemma algebra_map_mk {A : Type*} [semiring A] [algebra R A] (a : R) (s : S) : + algebra_map _ _ (localization.mk a s) = mk (algebra_map R A a) s := +begin + rw [algebra.algebra_map_eq_smul_one], + change _ • mk _ _ = _, + rw [mk_smul_mk, algebra.algebra_map_eq_smul_one, mul_one] +end + +instance : is_scalar_tower R (localization S) (localized_module S M) := +restrict_scalars.is_scalar_tower R (localization S) (localized_module S M) + +instance algebra' {A : Type*} [semiring A] [algebra R A] : + algebra R (localized_module S A) := +{ commutes' := begin + intros r x, + obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x, + dsimp, + rw [← localization.mk_one_eq_algebra_map, algebra_map_mk, mk_mul_mk, mk_mul_mk, mul_comm, + algebra.commutes], + end, + smul_def' := begin + intros r x, + obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := quotient.exists_rep x, + dsimp, + rw [← localization.mk_one_eq_algebra_map, algebra_map_mk, mk_mul_mk, smul'_mk, + algebra.smul_def, one_mul], + end, + ..(algebra_map (localization S) (localized_module S A)).comp (algebra_map R $ localization S), + ..(show module R (localized_module S A), by apply_instance) } +section + +variables (S M) + +/-- The function `m ↦ m / 1` as an `R`-linear map. +-/ +@[simps] +def mk_linear_map : M →ₗ[R] localized_module S M := +{ to_fun := λ m, mk m 1, + map_add' := λ x y, by simp [mk_add_mk], + map_smul' := λ r x, (smul'_mk _ _ _).symm } + +end + +/-- +For any `s : S`, there is an `R`-linear map given by `a/b ↦ a/(b*s)`. +-/ +@[simps] +def div_by (s : S) : localized_module S M →ₗ[R] localized_module S M := +{ to_fun := λ p, p.lift_on (λ p, mk p.1 (s * p.2)) $ λ ⟨a, b⟩ ⟨a', b'⟩ ⟨c, eq1⟩, mk_eq.mpr ⟨c, + begin + rw [mul_smul, mul_smul, smul_comm c, eq1, smul_comm s]; + apply_instance, + end⟩, + map_add' := λ x y, x.induction_on₂ + (begin + intros m₁ m₂ t₁ t₂, + simp only [mk_add_mk, localized_module.lift_on_mk, mul_smul, ←smul_add, mul_assoc, + mk_cancel_common_left s], + rw show s * (t₁ * t₂) = t₁ * (s * t₂), by { ext, simp only [submonoid.coe_mul], ring }, + end) y, + map_smul' := λ r x, x.induction_on $ by { intros, simp [localized_module.lift_on_mk, smul'_mk] } } + +lemma div_by_mul_by (s : S) (p : localized_module S M) : + div_by s (algebra_map R (module.End R (localized_module S M)) s p) = p := +p.induction_on +begin + intros m t, + simp only [localized_module.lift_on_mk, module.algebra_map_End_apply, smul'_mk, div_by_apply], + erw mk_cancel_common_left s t, +end + +lemma mul_by_div_by (s : S) (p : localized_module S M) : + algebra_map R (module.End R (localized_module S M)) s (div_by s p) = p := +p.induction_on +begin + intros m t, + simp only [localized_module.lift_on_mk, div_by_apply, module.algebra_map_End_apply, smul'_mk], + erw mk_cancel_common_left s t, +end + +end + +end localized_module + +section is_localized_module + +universes u v + +variables {R : Type*} [comm_ring R] (S : submonoid R) +variables {M M' M'' : Type*} [add_comm_monoid M] [add_comm_monoid M'] [add_comm_monoid M''] +variables [module R M] [module R M'] [module R M''] (f : M →ₗ[R] M') (g : M →ₗ[R] M'') + +/-- +The characteristic predicate for localized module. +`is_localized_module S f` describes that `f : M ⟶ M'` is the localization map identifying `M'` as +`localized_module S M`. +-/ +class is_localized_module : Prop := +(map_units [] : ∀ (x : S), is_unit (algebra_map R (module.End R M') x)) +(surj [] : ∀ y : M', ∃ (x : M × S), x.2 • y = f x.1) +(eq_iff_exists [] : ∀ {x₁ x₂}, f x₁ = f x₂ ↔ ∃ c : S, c • x₂ = c • x₁) + +namespace localized_module + +/-- +If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then +there is a linear map `localized_module S M → M''`. +-/ +noncomputable def lift' (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) : + (localized_module S M) → M'' := +λ m, m.lift_on (λ p, (h $ p.2).unit⁻¹ $ g p.1) $ λ ⟨m, s⟩ ⟨m', s'⟩ ⟨c, eq1⟩, +begin + generalize_proofs h1 h2, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←h2.unit⁻¹.1.map_smul], symmetry, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff], dsimp, + have : c • s • g m' = c • s' • g m, + { erw [←g.map_smul, ←g.map_smul, ←g.map_smul, ←g.map_smul, eq1], refl, }, + have : function.injective (h c).unit.inv, + { rw function.injective_iff_has_left_inverse, refine ⟨(h c).unit, _⟩, + intros x, + change ((h c).unit.1 * (h c).unit.inv) x = x, + simp only [units.inv_eq_coe_inv, is_unit.mul_coe_inv, linear_map.one_apply], }, + apply_fun (h c).unit.inv, + erw [units.inv_eq_coe_inv, module.End_algebra_map_is_unit_inv_apply_eq_iff, + ←(h c).unit⁻¹.1.map_smul], symmetry, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, + ←g.map_smul, ←g.map_smul, ←g.map_smul, ←g.map_smul, eq1], refl, +end + +lemma lift'_mk (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) (m : M) (s : S) : + localized_module.lift' S g h (localized_module.mk m s) = + (h s).unit⁻¹.1 (g m) := rfl + +lemma lift'_add (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) (x y) : + localized_module.lift' S g h (x + y) = + localized_module.lift' S g h x + localized_module.lift' S g h y := +localized_module.induction_on₂ begin + intros a a' b b', + erw [localized_module.lift'_mk, localized_module.lift'_mk, localized_module.lift'_mk], + dsimp, generalize_proofs h1 h2 h3, + erw [map_add, module.End_algebra_map_is_unit_inv_apply_eq_iff, + smul_add, ←h2.unit⁻¹.1.map_smul, ←h3.unit⁻¹.1.map_smul], + congr' 1; symmetry, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, mul_smul, ←map_smul], refl, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, mul_comm, mul_smul, ←map_smul], refl, +end x y + +lemma lift'_smul (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) + (r : R) (m) : + r • localized_module.lift' S g h m = localized_module.lift' S g h (r • m) := +m.induction_on begin + intros a b, + rw [localized_module.lift'_mk, localized_module.smul'_mk, localized_module.lift'_mk], + generalize_proofs h1 h2, + erw [←h1.unit⁻¹.1.map_smul, ←g.map_smul], +end + +/-- +If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then +there is a linear map `localized_module S M → M''`. +-/ +noncomputable def lift (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) : + (localized_module S M) →ₗ[R] M'' := +{ to_fun := localized_module.lift' S g h, + map_add' := localized_module.lift'_add S g h, + map_smul' := λ r x, by rw [localized_module.lift'_smul, ring_hom.id_apply] } + +/-- +If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then +`lift g m s = s⁻¹ • g m`. +-/ +lemma lift_mk (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) + (m : M) (s : S) : + localized_module.lift S g h (localized_module.mk m s) = (h s).unit⁻¹.1 (g m) := rfl + +/-- +If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then +there is a linear map `lift g ∘ mk_linear_map = g`. +-/ +lemma lift_comp (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) : + (lift S g h).comp (mk_linear_map S M) = g := +begin + ext x, dsimp, rw localized_module.lift_mk, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, one_smul], +end + +/-- +If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible and +`l` is another linear map `localized_module S M ⟶ M''` such that `l ∘ mk_linear_map = g` then +`l = lift g` +-/ +lemma lift_unique (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) + (l : localized_module S M →ₗ[R] M'') + (hl : l.comp (localized_module.mk_linear_map S M) = g) : + localized_module.lift S g h = l := +begin + ext x, induction x using localized_module.induction_on with m s, + rw [localized_module.lift_mk], + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←hl, linear_map.coe_comp, function.comp_app, + localized_module.mk_linear_map_apply, ←l.map_smul, localized_module.smul'_mk], + congr' 1, rw localized_module.mk_eq, + refine ⟨1, _⟩, simp only [one_smul], refl, +end + +end localized_module + +instance localized_module_is_localized_module : + is_localized_module S (localized_module.mk_linear_map S M) := +{ map_units := λ s, ⟨⟨algebra_map R (module.End R (localized_module S M)) s, + localized_module.div_by s, + fun_like.ext _ _ $ localized_module.mul_by_div_by s, + fun_like.ext _ _ $ localized_module.div_by_mul_by s⟩, + fun_like.ext _ _ $ λ p, p.induction_on $ by { intros, refl }⟩, + surj := λ p, p.induction_on + begin + intros m t, + refine ⟨⟨m, t⟩, _⟩, + erw [localized_module.smul'_mk, localized_module.mk_linear_map_apply, submonoid.coe_subtype, + localized_module.mk_cancel t ], + end, + eq_iff_exists := λ m1 m2, + { mp := λ eq1, by simpa only [eq_comm, one_smul] using localized_module.mk_eq.mp eq1, + mpr := λ ⟨c, eq1⟩, + localized_module.mk_eq.mpr ⟨c, by simpa only [eq_comm, one_smul] using eq1⟩ } } + +namespace is_localized_module + +variable [is_localized_module S f] + +/-- +If `(M', f : M ⟶ M')` satisfies universal property of localized module, there is a canonical map +`localized_module S M ⟶ M'`. +-/ +noncomputable def from_localized_module' : localized_module S M → M' := +λ p, p.lift_on (λ x, (is_localized_module.map_units f x.2).unit⁻¹ (f x.1)) +begin + rintros ⟨a, b⟩ ⟨a', b'⟩ ⟨c, eq1⟩, + dsimp, + generalize_proofs h1 h2, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←h2.unit⁻¹.1.map_smul, + module.End_algebra_map_is_unit_inv_apply_eq_iff', ←linear_map.map_smul, ←linear_map.map_smul], + exact (is_localized_module.eq_iff_exists S f).mpr ⟨c, eq1⟩, +end + +@[simp] lemma from_localized_module'_mk (m : M) (s : S) : + from_localized_module' S f (localized_module.mk m s) = + (is_localized_module.map_units f s).unit⁻¹ (f m) := +rfl + +lemma from_localized_module'_add (x y : localized_module S M) : + from_localized_module' S f (x + y) = + from_localized_module' S f x + from_localized_module' S f y := +localized_module.induction_on₂ begin + intros a a' b b', + simp only [localized_module.mk_add_mk, from_localized_module'_mk], + generalize_proofs h1 h2 h3, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, smul_add, ←h2.unit⁻¹.1.map_smul, + ←h3.unit⁻¹.1.map_smul, map_add], + congr' 1, + all_goals { erw [module.End_algebra_map_is_unit_inv_apply_eq_iff'] }, + { dsimp, erw [mul_smul, f.map_smul], refl, }, + { dsimp, erw [mul_comm, f.map_smul, mul_smul], refl, }, +end x y + +lemma from_localized_module'_smul (r : R) (x : localized_module S M) : + r • from_localized_module' S f x = from_localized_module' S f (r • x) := +localized_module.induction_on begin + intros a b, + rw [from_localized_module'_mk, localized_module.smul'_mk, from_localized_module'_mk], + generalize_proofs h1, erw [f.map_smul, h1.unit⁻¹.1.map_smul], refl, +end x + +/-- +If `(M', f : M ⟶ M')` satisfies universal property of localized module, there is a canonical map +`localized_module S M ⟶ M'`. +-/ +noncomputable def from_localized_module : localized_module S M →ₗ[R] M' := +{ to_fun := from_localized_module' S f, + map_add' := from_localized_module'_add S f, + map_smul' := λ r x, by rw [from_localized_module'_smul, ring_hom.id_apply] } + +lemma from_localized_module_mk (m : M) (s : S) : + from_localized_module S f (localized_module.mk m s) = + (is_localized_module.map_units f s).unit⁻¹ (f m) := +rfl + +lemma from_localized_module.inj : function.injective $ from_localized_module S f := +λ x y eq1, +begin + induction x using localized_module.induction_on with a b, + induction y using localized_module.induction_on with a' b', + simp only [from_localized_module_mk] at eq1, + generalize_proofs h1 h2 at eq1, + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff, ←linear_map.map_smul, + module.End_algebra_map_is_unit_inv_apply_eq_iff'] at eq1, + erw [localized_module.mk_eq, ←is_localized_module.eq_iff_exists S f, f.map_smul, f.map_smul, eq1], + refl, +end + +lemma from_localized_module.surj : function.surjective $ from_localized_module S f := +λ x, let ⟨⟨m, s⟩, eq1⟩ := is_localized_module.surj S f x in ⟨localized_module.mk m s, +by { rw [from_localized_module_mk, module.End_algebra_map_is_unit_inv_apply_eq_iff, ←eq1], refl }⟩ + +lemma from_localized_module.bij : function.bijective $ from_localized_module S f := +⟨from_localized_module.inj _ _, from_localized_module.surj _ _⟩ + +/-- +If `(M', f : M ⟶ M')` satisfies universal property of localized module, then `M'` is isomorphic to +`localized_module S M` as an `R`-module. +-/ +@[simps] noncomputable def iso : localized_module S M ≃ₗ[R] M' := +{ ..from_localized_module S f, + ..equiv.of_bijective (from_localized_module S f) $ from_localized_module.bij _ _} + +lemma iso_apply_mk (m : M) (s : S) : + iso S f (localized_module.mk m s) = (is_localized_module.map_units f s).unit⁻¹ (f m) := +rfl + +lemma iso_symm_apply_aux (m : M') : + (iso S f).symm m = localized_module.mk (is_localized_module.surj S f m).some.1 + (is_localized_module.surj S f m).some.2 := +begin + generalize_proofs _ h2, + apply_fun (iso S f) using linear_equiv.injective _, + rw [linear_equiv.apply_symm_apply], + simp only [iso_apply, linear_map.to_fun_eq_coe, from_localized_module_mk], + erw [module.End_algebra_map_is_unit_inv_apply_eq_iff', h2.some_spec], +end + +lemma iso_symm_apply' (m : M') (a : M) (b : S) (eq1 : b • m = f a) : + (iso S f).symm m = localized_module.mk a b := +(iso_symm_apply_aux S f m).trans $ localized_module.mk_eq.mpr $ +begin + generalize_proofs h1, + erw [←is_localized_module.eq_iff_exists S f, f.map_smul, f.map_smul, ←h1.some_spec, ←mul_smul, + mul_comm, mul_smul, eq1], +end + +lemma iso_symm_comp : (iso S f).symm.to_linear_map.comp f = localized_module.mk_linear_map S M := +begin + ext m, rw [linear_map.comp_apply, localized_module.mk_linear_map_apply], + change (iso S f).symm _ = _, rw [iso_symm_apply'], exact one_smul _ _, +end + +/-- +If `M'` is a localized module and `g` is a linear map `M' → M''` such that all scalar multiplication +by `s : S` is invertible, then there is a linear map `M' → M''`. +-/ +noncomputable def lift (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) : + M' →ₗ[R] M'' := +(localized_module.lift S g h).comp (iso S f).symm.to_linear_map + +lemma lift_comp (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) : + (lift S f g h).comp f = g := +begin + dunfold is_localized_module.lift, + rw [linear_map.comp_assoc], + convert localized_module.lift_comp S g h, + exact iso_symm_comp _ _, +end + +lemma lift_unique (g : M →ₗ[R] M'') + (h : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) + (l : M' →ₗ[R] M'') (hl : l.comp f = g) : + lift S f g h = l := +begin + dunfold is_localized_module.lift, + rw [localized_module.lift_unique S g h (l.comp (iso S f).to_linear_map), linear_map.comp_assoc, + show (iso S f).to_linear_map.comp (iso S f).symm.to_linear_map = linear_map.id, from _, + linear_map.comp_id], + { rw [linear_equiv.comp_to_linear_map_symm_eq, linear_map.id_comp], }, + { rw [linear_map.comp_assoc, ←hl], congr' 1, ext x, + erw [from_localized_module_mk, module.End_algebra_map_is_unit_inv_apply_eq_iff, one_smul], }, +end + +/-- +Universal property from localized module: +If `(M', f : M ⟶ M')` is a localized module then it satisfies the following universal property: +For every `R`-module `M''` which every `s : S`-scalar multiplication is invertible and for every +`R`-linear map `g : M ⟶ M''`, there is a unique `R`-linear map `l : M' ⟶ M''` such that +`l ∘ f = g`. +``` +M -----f----> M' +| / +|g / +| / l +v / +M'' +``` +-/ +lemma is_universal : + ∀ (g : M →ₗ[R] M'') (map_unit : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)), + ∃! (l : M' →ₗ[R] M''), l.comp f = g := +λ g h, ⟨lift S f g h, lift_comp S f g h, λ l hl, (lift_unique S f g h l hl).symm⟩ + +lemma ring_hom_ext (map_unit : ∀ (x : S), is_unit ((algebra_map R (module.End R M'')) x)) + ⦃j k : M' →ₗ[R] M''⦄ (h : j.comp f = k.comp f) : j = k := +by { rw [←lift_unique S f (k.comp f) map_unit j h, lift_unique], refl } + +/-- +If `(M', f)` and `(M'', g)` both satisfy universal property of localized module, then `M', M''` +are isomorphic as `R`-module +-/ +noncomputable def linear_equiv [is_localized_module S g] : M' ≃ₗ[R] M'' := +(iso S f).symm.trans (iso S g) + +variable {S} + +lemma smul_injective (s : S) : function.injective (λ m : M', s • m) := +((module.End_is_unit_iff _).mp (is_localized_module.map_units f s)).injective + +lemma smul_inj (s : S) (m₁ m₂ : M') : s • m₁ = s • m₂ ↔ m₁ = m₂ := +(smul_injective f s).eq_iff + +/-- `mk' f m s` is the fraction `m/s` with respect to the localization map `f`. -/ +noncomputable +def mk' (m : M) (s : S) : M' := from_localized_module S f (localized_module.mk m s) + +lemma mk'_smul (r : R) (m : M) (s : S) : mk' f (r • m) s = r • mk' f m s := +by { delta mk', rw [← localized_module.smul'_mk, linear_map.map_smul] } + +lemma mk'_add_mk' (m₁ m₂ : M) (s₁ s₂ : S) : + mk' f m₁ s₁ + mk' f m₂ s₂ = mk' f (s₂ • m₁ + s₁ • m₂) (s₁ * s₂) := +by { delta mk', rw [← map_add, localized_module.mk_add_mk] } + +@[simp] lemma mk'_zero (s : S) : + mk' f 0 s = 0 := +by rw [← zero_smul R (0 : M), mk'_smul, zero_smul] + +variable (S) + +@[simp] lemma mk'_one (m : M) : + mk' f m (1 : S) = f m := +by { delta mk', rw [from_localized_module_mk, module.End_algebra_map_is_unit_inv_apply_eq_iff, + submonoid.coe_one, one_smul] } + +variable {S} + +@[simp] lemma mk'_cancel (m : M) (s : S) : + mk' f (s • m) s = f m := +by { delta mk', rw [localized_module.mk_cancel, ← mk'_one S f], refl } + +@[simp] lemma mk'_cancel' (m : M) (s : S) : + s • mk' f m s = f m := +by rw [submonoid.smul_def, ← mk'_smul, ← submonoid.smul_def, mk'_cancel] + +@[simp] lemma mk'_cancel_left (m : M) (s₁ s₂ : S) : + mk' f (s₁ • m) (s₁ * s₂) = mk' f m s₂ := +by { delta mk', rw localized_module.mk_cancel_common_left } + +@[simp] lemma mk'_cancel_right (m : M) (s₁ s₂ : S) : + mk' f (s₂ • m) (s₁ * s₂) = mk' f m s₁ := +by { delta mk', rw localized_module.mk_cancel_common_right } + +lemma mk'_add (m₁ m₂ : M) (s : S) : mk' f (m₁ + m₂) s = mk' f m₁ s + mk' f m₂ s := +by { rw [mk'_add_mk', ← smul_add, mk'_cancel_left] } + +lemma mk'_eq_mk'_iff (m₁ m₂ : M) (s₁ s₂ : S) : + mk' f m₁ s₁ = mk' f m₂ s₂ ↔ ∃ s : S, s • s₁ • m₂ = s • s₂ • m₁ := +begin + delta mk', + rw [(from_localized_module.inj S f).eq_iff, localized_module.mk_eq], + simp_rw eq_comm +end + +lemma mk'_neg {M M' : Type*} [add_comm_group M] [add_comm_group M'] [module R M] + [module R M'] (f : M →ₗ[R] M') [is_localized_module S f] (m : M) (s : S) : + mk' f (-m) s = - mk' f m s := +by { delta mk', rw [localized_module.mk_neg, map_neg] } + +lemma mk'_sub {M M' : Type*} [add_comm_group M] [add_comm_group M'] [module R M] + [module R M'] (f : M →ₗ[R] M') [is_localized_module S f] (m₁ m₂ : M) (s : S) : + mk' f (m₁ - m₂) s = mk' f m₁ s - mk' f m₂ s := +by rw [sub_eq_add_neg, sub_eq_add_neg, mk'_add, mk'_neg] + +lemma mk'_sub_mk' {M M' : Type*} [add_comm_group M] [add_comm_group M'] [module R M] + [module R M'] (f : M →ₗ[R] M') [is_localized_module S f] (m₁ m₂ : M) (s₁ s₂ : S) : + mk' f m₁ s₁ - mk' f m₂ s₂ = mk' f (s₂ • m₁ - s₁ • m₂) (s₁ * s₂) := +by rw [sub_eq_add_neg, ← mk'_neg, mk'_add_mk', smul_neg, ← sub_eq_add_neg] + +lemma mk'_mul_mk'_of_map_mul {M M' : Type*} [semiring M] [semiring M'] [module R M] + [algebra R M'] (f : M →ₗ[R] M') (hf : ∀ m₁ m₂, f (m₁ * m₂) = f m₁ * f m₂) + [is_localized_module S f] (m₁ m₂ : M) (s₁ s₂ : S) : + mk' f m₁ s₁ * mk' f m₂ s₂ = mk' f (m₁ * m₂) (s₁ * s₂) := +begin + symmetry, + apply (module.End_algebra_map_is_unit_inv_apply_eq_iff _ _ _).mpr, + simp_rw [submonoid.coe_mul, ← smul_eq_mul], + rw [smul_smul_smul_comm, ← mk'_smul, ← mk'_smul], + simp_rw [← submonoid.smul_def, mk'_cancel, smul_eq_mul, hf], +end + +lemma mk'_mul_mk' {M M' : Type*} [semiring M] [semiring M'] [algebra R M] + [algebra R M'] (f : M →ₐ[R] M') + [is_localized_module S f.to_linear_map] (m₁ m₂ : M) (s₁ s₂ : S) : + mk' f.to_linear_map m₁ s₁ * mk' f.to_linear_map m₂ s₂ = + mk' f.to_linear_map (m₁ * m₂) (s₁ * s₂) := +mk'_mul_mk'_of_map_mul f.to_linear_map f.map_mul m₁ m₂ s₁ s₂ + +variables {f} + +@[simp] lemma mk'_eq_iff {m : M} {s : S} {m' : M'} : + mk' f m s = m' ↔ f m = s • m' := +by rw [← smul_inj f s, submonoid.smul_def, ← mk'_smul, ← submonoid.smul_def, mk'_cancel] + +@[simp] lemma mk'_eq_zero {m : M} (s : S) : + mk' f m s = 0 ↔ f m = 0 := +by rw [mk'_eq_iff, smul_zero] + +variable (f) + +lemma mk'_eq_zero' {m : M} (s : S) : + mk' f m s = 0 ↔ ∃ s' : S, s' • m = 0 := +by simp_rw [← mk'_zero f (1 : S), mk'_eq_mk'_iff, smul_zero, one_smul, eq_comm] + +lemma mk_eq_mk' (s : S) (m : M) : + localized_module.mk m s = mk' (localized_module.mk_linear_map S M) m s := +by rw [eq_comm, mk'_eq_iff, submonoid.smul_def, localized_module.smul'_mk, + ← submonoid.smul_def, localized_module.mk_cancel, localized_module.mk_linear_map_apply] + +variable (S) + +lemma eq_zero_iff {m : M} : + f m = 0 ↔ ∃ s' : S, s' • m = 0 := +(mk'_eq_zero (1 : S)).symm.trans (mk'_eq_zero' f _) + +lemma mk'_surjective : function.surjective (function.uncurry $ mk' f : M × S → M') := +begin + intro x, + obtain ⟨⟨m, s⟩, e : s • x = f m⟩ := is_localized_module.surj S f x, + exact ⟨⟨m, s⟩, mk'_eq_iff.mpr e.symm⟩ +end + +section algebra + +lemma mk_of_algebra {R S S' : Type*} [comm_ring R] [comm_ring S] [comm_ring S'] + [algebra R S] [algebra R S'] (M : submonoid R) (f : S →ₐ[R] S') + (h₁ : ∀ x ∈ M, is_unit (algebra_map R S' x)) + (h₂ : ∀ y, ∃ (x : S × M), x.2 • y = f x.1) + (h₃ : ∀ x, f x = 0 → ∃ m : M, m • x = 0) : + is_localized_module M f.to_linear_map := +begin + replace h₃ := λ x, iff.intro (h₃ x) (λ ⟨⟨m, hm⟩, e⟩, (h₁ m hm).mul_left_cancel $ + by { rw ← algebra.smul_def, simpa [submonoid.smul_def] using f.congr_arg e }), + constructor, + { intro x, + rw module.End_is_unit_iff, + split, + { rintros a b (e : x • a = x • b), simp_rw [submonoid.smul_def, algebra.smul_def] at e, + exact (h₁ x x.2).mul_left_cancel e }, + { intro a, refine ⟨((h₁ x x.2).unit⁻¹ : _) * a, _⟩, change (x : R) • (_ * a) = _, + rw [algebra.smul_def, ← mul_assoc, is_unit.mul_coe_inv, one_mul] } }, + { exact h₂ }, + { intros, dsimp, rw [eq_comm, ← sub_eq_zero, ← map_sub, h₃], simp_rw [smul_sub, sub_eq_zero] }, +end + +end algebra + +end is_localized_module + +end is_localized_module diff --git a/src/algebra/module/opposites.lean b/src/algebra/module/opposites.lean index f6f6a9ad0fcc2..d66b4be1d6cbd 100644 --- a/src/algebra/module/opposites.lean +++ b/src/algebra/module/opposites.lean @@ -9,6 +9,9 @@ import group_theory.group_action.opposite /-! # Module operations on `Mᵐᵒᵖ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains definitions that build on top of the group action definitions in `group_theory.group_action.opposite`. -/ diff --git a/src/algebra/module/pi.lean b/src/algebra/module/pi.lean index bb91f6ee2bcd9..c91004eb8ebe1 100644 --- a/src/algebra/module/pi.lean +++ b/src/algebra/module/pi.lean @@ -11,6 +11,9 @@ import group_theory.group_action.pi /-! # Pi instances for modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for module and related structures on Pi Types -/ @@ -21,23 +24,23 @@ variables (x y : Π i, f i) (i : I) namespace pi -lemma _root_.is_smul_regular.pi {α : Type*} [Π i, has_scalar α $ f i] {k : α} +lemma _root_.is_smul_regular.pi {α : Type*} [Π i, has_smul α $ f i] {k : α} (hk : Π i, is_smul_regular (f i) k) : is_smul_regular (Π i, f i) k := λ _ _ h, funext $ λ i, hk i (congr_fun h i : _) instance smul_with_zero (α) [has_zero α] [Π i, has_zero (f i)] [Π i, smul_with_zero α (f i)] : smul_with_zero α (Π i, f i) := -{ smul_zero := λ _, funext $ λ _, smul_zero' (f _) _, +{ smul_zero := λ _, funext $ λ _, smul_zero _, zero_smul := λ _, funext $ λ _, zero_smul _ _, - ..pi.has_scalar } + ..pi.has_smul } instance smul_with_zero' {g : I → Type*} [Π i, has_zero (g i)] [Π i, has_zero (f i)] [Π i, smul_with_zero (g i) (f i)] : smul_with_zero (Π i, g i) (Π i, f i) := -{ smul_zero := λ _, funext $ λ _, smul_zero' (f _) _, +{ smul_zero := λ _, funext $ λ _, smul_zero _, zero_smul := λ _, funext $ λ _, zero_smul _ _, - ..pi.has_scalar' } + ..pi.has_smul' } instance mul_action_with_zero (α) [monoid_with_zero α] [Π i, has_zero (f i)] [Π i, mul_action_with_zero α (f i)] : @@ -60,6 +63,20 @@ instance module (α) {r : semiring α} {m : ∀ i, add_comm_monoid $ f i} zero_smul := λ f, funext $ λ i, zero_smul α _, ..pi.distrib_mul_action _ } +/- Extra instance to short-circuit type class resolution. +For unknown reasons, this is necessary for certain inference problems. E.g., for this to succeed: +```lean +example (β X : Type*) [normed_add_comm_group β] [normed_space ℝ β] : module ℝ (X → β) := +infer_instance +``` +See: https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Typeclass.20resolution.20under.20binders/near/281296989 +-/ +/-- A special case of `pi.module` for non-dependent types. Lean struggles to elaborate +definitions elsewhere in the library without this. -/ +instance _root_.function.module (α β : Type*) [semiring α] [add_comm_monoid β] [module α β] : + module α (I → β) := +pi.module _ _ _ + variables {I f} instance module' {g : I → Type*} {r : Π i, semiring (f i)} {m : Π i, add_comm_monoid (g i)} @@ -74,4 +91,11 @@ instance (α) {r : semiring α} {m : Π i, add_comm_monoid $ f i} ⟨λ c x h, or_iff_not_imp_left.mpr (λ hc, funext (λ i, (smul_eq_zero.mp (congr_fun h i)).resolve_left hc))⟩ +/-- A special case of `pi.no_zero_smul_divisors` for non-dependent types. Lean struggles to +synthesize this instance by itself elsewhere in the library. -/ +instance _root_.function.no_zero_smul_divisors {ι α β : Type*} {r : semiring α} + {m : add_comm_monoid β} [module α β] [no_zero_smul_divisors α β] : + no_zero_smul_divisors α (ι → β) := +pi.no_zero_smul_divisors _ + end pi diff --git a/src/algebra/module/pid.lean b/src/algebra/module/pid.lean new file mode 100644 index 0000000000000..adc0435a263cd --- /dev/null +++ b/src/algebra/module/pid.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Pierre-Alexandre Bazin +-/ +import algebra.module.dedekind_domain +import linear_algebra.free_module.pid +import algebra.module.projective +import algebra.category.Module.biproducts + +/-! +# Structure of finitely generated modules over a PID + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main statements + +* `module.equiv_direct_sum_of_is_torsion` : A finitely generated torsion module over a PID is + isomorphic to a direct sum of some `R ⧸ R ∙ (p i ^ e i)` where the `p i ^ e i` are prime powers. +* `module.equiv_free_prod_direct_sum` : A finitely generated module over a PID is isomorphic to the + product of a free module (its torsion free part) and a direct sum of the form above (its torsion + submodule). + +## Notation + +* `R` is a PID and `M` is a (finitely generated for main statements) `R`-module, with additional + torsion hypotheses in the intermediate lemmas. +* `N` is a `R`-module lying over a higher type universe than `R`. This assumption is needed on the + final statement for technical reasons. +* `p` is an irreducible element of `R` or a tuple of these. + +## Implementation details + +We first prove (`submodule.is_internal_prime_power_torsion_of_pid`) that a finitely generated +torsion module is the internal direct sum of its `p i ^ e i`-torsion submodules for some +(finitely many) prime powers `p i ^ e i`. This is proved in more generality for a Dedekind domain +at `submodule.is_internal_prime_power_torsion`. + +Then we treat the case of a `p ^ ∞`-torsion module (that is, a module where all elements are +cancelled by scalar multiplication by some power of `p`) and apply it to the `p i ^ e i`-torsion +submodules (that are `p i ^ ∞`-torsion) to get the result for torsion modules. + +Then we get the general result using that a torsion free module is free (which has been proved at +`module.free_of_finite_type_torsion_free'` at `linear_algebra/free_module/pid.lean`.) + +## Tags + +Finitely generated module, principal ideal domain, classification, structure theorem +-/ + +universes u v +open_locale big_operators classical + +variables {R : Type u} [comm_ring R] [is_domain R] [is_principal_ideal_ring R] +variables {M : Type v} [add_comm_group M] [module R M] +variables {N : Type (max u v)} [add_comm_group N] [module R N] + +open_locale direct_sum +open submodule + +open unique_factorization_monoid + +/--A finitely generated torsion module over a PID is an internal direct sum of its +`p i ^ e i`-torsion submodules for some primes `p i` and numbers `e i`.-/ +theorem submodule.is_internal_prime_power_torsion_of_pid + [module.finite R M] (hM : module.is_torsion R M) : + direct_sum.is_internal (λ p : (factors (⊤ : submodule R M).annihilator).to_finset, + torsion_by R M + (is_principal.generator (p : ideal R) + ^ (factors (⊤ : submodule R M).annihilator).count p)) := +begin + convert is_internal_prime_power_torsion hM, + ext p : 1, + rw [← torsion_by_span_singleton_eq, ideal.submodule_span_eq, ← ideal.span_singleton_pow, + ideal.span_singleton_generator], +end + +/--A finitely generated torsion module over a PID is an internal direct sum of its +`p i ^ e i`-torsion submodules for some primes `p i` and numbers `e i`.-/ +theorem submodule.exists_is_internal_prime_power_torsion_of_pid + [module.finite R M] (hM : module.is_torsion R M) : + ∃ (ι : Type u) [fintype ι] [decidable_eq ι] (p : ι → R) (h : ∀ i, irreducible $ p i) (e : ι → ℕ), + by exactI direct_sum.is_internal (λ i, torsion_by R M $ p i ^ e i) := +begin + refine ⟨_, _, _, _, _, _, submodule.is_internal_prime_power_torsion_of_pid hM⟩, + exact finset.fintype_coe_sort _, + { rintro ⟨p, hp⟩, + have hP := prime_of_factor p (multiset.mem_to_finset.mp hp), + haveI := ideal.is_prime_of_prime hP, + exact (is_principal.prime_generator_of_is_prime p hP.ne_zero).irreducible }, +end + +namespace module +section p_torsion +variables {p : R} (hp : irreducible p) (hM : module.is_torsion' M (submonoid.powers p)) +variables [dec : Π x : M, decidable (x = 0)] + +open ideal submodule.is_principal +include dec + +include hp hM +lemma _root_.ideal.torsion_of_eq_span_pow_p_order (x : M) : + torsion_of R M x = span {p ^ p_order hM x} := +begin + dunfold p_order, + rw [← (torsion_of R M x).span_singleton_generator, ideal.span_singleton_eq_span_singleton, + ← associates.mk_eq_mk_iff_associated, associates.mk_pow], + have prop : (λ n : ℕ, p ^ n • x = 0) = + λ n : ℕ, (associates.mk $ generator $ torsion_of R M x) ∣ associates.mk p ^ n, + { ext n, rw [← associates.mk_pow, associates.mk_dvd_mk, ← mem_iff_generator_dvd], refl }, + have := (is_torsion'_powers_iff p).mp hM x, rw prop at this, + classical, + convert associates.eq_pow_find_of_dvd_irreducible_pow ((associates.irreducible_mk p).mpr hp) + this.some_spec, +end + +lemma p_pow_smul_lift {x y : M} {k : ℕ} (hM' : module.is_torsion_by R M (p ^ p_order hM y)) + (h : p ^ k • x ∈ R ∙ y) : ∃ a : R, p ^ k • x = p ^ k • a • y := +begin + by_cases hk : k ≤ p_order hM y, + { let f := ((R ∙ p ^ (p_order hM y - k) * p ^ k).quot_equiv_of_eq _ _).trans + (quot_torsion_of_equiv_span_singleton R M y), + have : f.symm ⟨p ^ k • x, h⟩ ∈ + R ∙ ideal.quotient.mk (R ∙ p ^ (p_order hM y - k) * p ^ k) (p ^ k), + { rw [← quotient.torsion_by_eq_span_singleton, mem_torsion_by_iff, ← f.symm.map_smul], + convert f.symm.map_zero, ext, + rw [coe_smul_of_tower, coe_mk, coe_zero, smul_smul, ← pow_add, nat.sub_add_cancel hk, @hM' x], + { exact mem_non_zero_divisors_of_ne_zero (pow_ne_zero _ hp.ne_zero) } }, + rw submodule.mem_span_singleton at this, obtain ⟨a, ha⟩ := this, use a, + rw [f.eq_symm_apply, ← ideal.quotient.mk_eq_mk, ← quotient.mk_smul] at ha, + dsimp only [smul_eq_mul, f, linear_equiv.trans_apply, submodule.quot_equiv_of_eq_mk, + quot_torsion_of_equiv_span_singleton_apply_mk] at ha, + rw [smul_smul, mul_comm], exact congr_arg coe ha.symm, + { symmetry, convert ideal.torsion_of_eq_span_pow_p_order hp hM y, + rw [← pow_add, nat.sub_add_cancel hk] } }, + { use 0, rw [zero_smul, smul_zero, ← nat.sub_add_cancel (le_of_not_le hk), + pow_add, mul_smul, hM', smul_zero] } +end + +open submodule.quotient + +lemma exists_smul_eq_zero_and_mk_eq {z : M} (hz : module.is_torsion_by R M (p ^ p_order hM z)) + {k : ℕ} (f : (R ⧸ R ∙ p ^ k) →ₗ[R] M ⧸ R ∙ z) : + ∃ x : M, p ^ k • x = 0 ∧ submodule.quotient.mk x = f 1 := +begin + have f1 := mk_surjective (R ∙ z) (f 1), + have : p ^ k • f1.some ∈ R ∙ z, + { rw [← quotient.mk_eq_zero, mk_smul, f1.some_spec, ← f.map_smul], + convert f.map_zero, change _ • submodule.quotient.mk _ = _, + rw [← mk_smul, quotient.mk_eq_zero, algebra.id.smul_eq_mul, mul_one], + exact submodule.mem_span_singleton_self _ }, + obtain ⟨a, ha⟩ := p_pow_smul_lift hp hM hz this, + refine ⟨f1.some - a • z, by rw [smul_sub, sub_eq_zero, ha], _⟩, + rw [mk_sub, mk_smul, (quotient.mk_eq_zero _).mpr $ submodule.mem_span_singleton_self _, + smul_zero, sub_zero, f1.some_spec] +end + +open finset multiset +omit dec hM + +/--A finitely generated `p ^ ∞`-torsion module over a PID is isomorphic to a direct sum of some + `R ⧸ R ∙ (p ^ e i)` for some `e i`.-/ +theorem torsion_by_prime_power_decomposition (hN : module.is_torsion' N (submonoid.powers p)) + [h' : module.finite R N] : + ∃ (d : ℕ) (k : fin d → ℕ), nonempty $ N ≃ₗ[R] ⨁ (i : fin d), R ⧸ R ∙ (p ^ (k i : ℕ)) := +begin + obtain ⟨d, s, hs⟩ := @module.finite.exists_fin _ _ _ _ _ h', use d, clear h', + unfreezingI { induction d with d IH generalizing N }, + { use λ i, fin_zero_elim i, + rw [set.range_eq_empty, submodule.span_empty] at hs, + haveI : unique N := ⟨⟨0⟩, λ x, by { rw [← mem_bot _, hs], trivial }⟩, + exact ⟨0⟩ }, + { haveI : Π x : N, decidable (x = 0), classical, apply_instance, + obtain ⟨j, hj⟩ := exists_is_torsion_by hN d.succ d.succ_ne_zero s hs, + let s' : fin d → N ⧸ R ∙ s j := submodule.quotient.mk ∘ s ∘ j.succ_above, + obtain ⟨k, ⟨f⟩⟩ := IH _ s' _; clear IH, + { have : ∀ i : fin d, ∃ x : N, + p ^ k i • x = 0 ∧ f (submodule.quotient.mk x) = direct_sum.lof R _ _ i 1, + { intro i, + let fi := f.symm.to_linear_map.comp (direct_sum.lof _ _ _ i), + obtain ⟨x, h0, h1⟩ := exists_smul_eq_zero_and_mk_eq hp hN hj fi, refine ⟨x, h0, _⟩, rw h1, + simp only [linear_map.coe_comp, f.symm.coe_to_linear_map, f.apply_symm_apply] }, + refine ⟨_, ⟨((( + @lequiv_prod_of_right_split_exact _ _ _ _ _ _ _ _ _ _ _ _ + ((f.trans ulift.module_equiv.{u u v}.symm).to_linear_map.comp $ mkq _) + ((direct_sum.to_module _ _ _ $ λ i, (liftq_span_singleton.{u u} (p ^ k i) + (linear_map.to_span_singleton _ _ _) (this i).some_spec.left : R ⧸ _ →ₗ[R] _)).comp + ulift.module_equiv.to_linear_map) + (R ∙ s j).injective_subtype _ _).symm.trans $ + ((quot_torsion_of_equiv_span_singleton _ _ _).symm.trans $ + quot_equiv_of_eq _ _ $ ideal.torsion_of_eq_span_pow_p_order hp hN _).prod $ + ulift.module_equiv).trans $ + (@direct_sum.lequiv_prod_direct_sum R _ _ _ + (λ i, R ⧸ R ∙ p ^ @option.rec _ (λ _, ℕ) (p_order hN $ s j) k i) _ _).symm).trans $ + direct_sum.lequiv_congr_left R (fin_succ_equiv d).symm⟩⟩, + { rw [range_subtype, linear_equiv.to_linear_map_eq_coe, linear_equiv.ker_comp, ker_mkq] }, + { rw [linear_equiv.to_linear_map_eq_coe, ← f.comp_coe, linear_map.comp_assoc, + linear_map.comp_assoc, ← linear_equiv.to_linear_map_eq_coe, + linear_equiv.to_linear_map_symm_comp_eq, linear_map.comp_id, + ← linear_map.comp_assoc, ← linear_map.comp_assoc], + suffices : (f.to_linear_map.comp (R ∙ s j).mkq).comp _ = linear_map.id, + { rw [← f.to_linear_map_eq_coe, this, linear_map.id_comp] }, + ext i : 3, + simp only [linear_map.coe_comp, function.comp_app, mkq_apply], + rw [linear_equiv.coe_to_linear_map, linear_map.id_apply, direct_sum.to_module_lof, + liftq_span_singleton_apply, linear_map.to_span_singleton_one, + ideal.quotient.mk_eq_mk, map_one, (this i).some_spec.right] } }, + { exact (mk_surjective _).forall.mpr + (λ x, ⟨(@hN x).some, by rw [← quotient.mk_smul, (@hN x).some_spec, quotient.mk_zero]⟩) }, + { have hs' := congr_arg (submodule.map $ mkq $ R ∙ s j) hs, + rw [submodule.map_span, submodule.map_top, range_mkq] at hs', simp only [mkq_apply] at hs', + simp only [s'], rw [set.range_comp (_ ∘ s), fin.range_succ_above], + rw [← set.range_comp, ← set.insert_image_compl_eq_range _ j, function.comp_apply, + (quotient.mk_eq_zero _).mpr (submodule.mem_span_singleton_self _), span_insert_zero] at hs', + exact hs' } } +end +end p_torsion + +/--A finitely generated torsion module over a PID is isomorphic to a direct sum of some + `R ⧸ R ∙ (p i ^ e i)` where the `p i ^ e i` are prime powers.-/ +theorem equiv_direct_sum_of_is_torsion [h' : module.finite R N] (hN : module.is_torsion R N) : + ∃ (ι : Type u) [fintype ι] (p : ι → R) (h : ∀ i, irreducible $ p i) (e : ι → ℕ), + nonempty $ N ≃ₗ[R] ⨁ (i : ι), R ⧸ R ∙ (p i ^ e i) := +begin + obtain ⟨I, fI, _, p, hp, e, h⟩ := submodule.exists_is_internal_prime_power_torsion_of_pid hN, + haveI := fI, + have : ∀ i, ∃ (d : ℕ) (k : fin d → ℕ), + nonempty $ torsion_by R N (p i ^ e i) ≃ₗ[R] ⨁ j, R ⧸ R ∙ (p i ^ k j), + { haveI := is_noetherian_of_fg_of_noetherian' (module.finite_def.mp h'), + haveI := λ i, is_noetherian_submodule' (torsion_by R N $ p i ^ e i), + exact λ i, torsion_by_prime_power_decomposition (hp i) + ((is_torsion'_powers_iff $ p i).mpr $ λ x, ⟨e i, smul_torsion_by _ _⟩) }, + classical, + refine ⟨Σ i, fin (this i).some, infer_instance, + λ ⟨i, j⟩, p i, λ ⟨i, j⟩, hp i, λ ⟨i, j⟩, (this i).some_spec.some j, + ⟨(linear_equiv.of_bijective (direct_sum.coe_linear_map _) h).symm.trans $ + (dfinsupp.map_range.linear_equiv $ λ i, (this i).some_spec.some_spec.some).trans $ + (direct_sum.sigma_lcurry_equiv R).symm.trans + (dfinsupp.map_range.linear_equiv $ λ i, quot_equiv_of_eq _ _ _)⟩⟩, + cases i with i j, simp only +end + +/--**Structure theorem of finitely generated modules over a PID** : A finitely generated + module over a PID is isomorphic to the product of a free module and a direct sum of some + `R ⧸ R ∙ (p i ^ e i)` where the `p i ^ e i` are prime powers.-/ +theorem equiv_free_prod_direct_sum [h' : module.finite R N] : + ∃ (n : ℕ) (ι : Type u) [fintype ι] (p : ι → R) (h : ∀ i, irreducible $ p i) (e : ι → ℕ), + nonempty $ N ≃ₗ[R] (fin n →₀ R) × ⨁ (i : ι), R ⧸ R ∙ (p i ^ e i) := +begin + haveI := is_noetherian_of_fg_of_noetherian' (module.finite_def.mp h'), + haveI := is_noetherian_submodule' (torsion R N), + haveI := module.finite.of_surjective _ (torsion R N).mkq_surjective, + obtain ⟨I, fI, p, hp, e, ⟨h⟩⟩ := equiv_direct_sum_of_is_torsion (@torsion_is_torsion R N _ _ _), + obtain ⟨n, ⟨g⟩⟩ := @module.basis_of_finite_type_torsion_free' R _ _ _ (N ⧸ torsion R N) _ _ _ _, + haveI : module.projective R (N ⧸ torsion R N) := module.projective_of_basis ⟨g⟩, + obtain ⟨f, hf⟩ := module.projective_lifting_property _ linear_map.id (torsion R N).mkq_surjective, + refine ⟨n, I, fI, p, hp, e, + ⟨(lequiv_prod_of_right_split_exact (torsion R N).injective_subtype _ hf).symm.trans $ + (h.prod g).trans $ linear_equiv.prod_comm R _ _⟩⟩, + rw [range_subtype, ker_mkq] +end +end module diff --git a/src/algebra/module/pointwise_pi.lean b/src/algebra/module/pointwise_pi.lean index 50e1153def811..3a6335a55f771 100644 --- a/src/algebra/module/pointwise_pi.lean +++ b/src/algebra/module/pointwise_pi.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Alex J. Best. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Alex J. Best -/ -import data.set.pointwise +import data.set.pointwise.smul import group_theory.group_action.pi /-! # Pointwise actions on sets in Pi types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas about pointwise actions on sets in Pi types. ## Tags @@ -23,7 +26,7 @@ open set variables {K ι : Type*} {R : ι → Type*} @[to_additive] -lemma smul_pi_subset [∀ i, has_scalar K (R i)] (r : K) (s : set ι) (t : Π i, set (R i)) : +lemma smul_pi_subset [∀ i, has_smul K (R i)] (r : K) (s : set ι) (t : Π i, set (R i)) : r • pi s t ⊆ pi s (r • t) := begin rintros x ⟨y, h, rfl⟩ i hi, @@ -31,7 +34,7 @@ begin end @[to_additive] -lemma smul_univ_pi [∀ i, has_scalar K (R i)] (r : K) (t : Π i, set (R i)) : +lemma smul_univ_pi [∀ i, has_smul K (R i)] (r : K) (t : Π i, set (R i)) : r • pi (univ : set ι) t = pi (univ : set ι) (r • t) := subset.antisymm (smul_pi_subset _ _ _) $ λ x h, begin refine ⟨λ i, classical.some (h i $ set.mem_univ _), λ i hi, _, funext $ λ i, _⟩, diff --git a/src/algebra/module/prod.lean b/src/algebra/module/prod.lean index 640e0b4d73693..3f5d9ca458169 100644 --- a/src/algebra/module/prod.lean +++ b/src/algebra/module/prod.lean @@ -9,6 +9,9 @@ import group_theory.group_action.prod /-! # Prod instances for module and multiplicative actions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for binary product of modules -/ @@ -18,13 +21,13 @@ namespace prod instance smul_with_zero [has_zero R] [has_zero M] [has_zero N] [smul_with_zero R M] [smul_with_zero R N] : smul_with_zero R (M × N) := -{ smul_zero := λ r, prod.ext (smul_zero' _ _) (smul_zero' _ _), +{ smul_zero := λ r, prod.ext (smul_zero _) (smul_zero _), zero_smul := λ ⟨m, n⟩, prod.ext (zero_smul _ _) (zero_smul _ _), - ..prod.has_scalar } + ..prod.has_smul } instance mul_action_with_zero [monoid_with_zero R] [has_zero M] [has_zero N] [mul_action_with_zero R M] [mul_action_with_zero R N] : mul_action_with_zero R (M × N) := -{ smul_zero := λ r, prod.ext (smul_zero' _ _) (smul_zero' _ _), +{ smul_zero := λ r, prod.ext (smul_zero _) (smul_zero _), zero_smul := λ ⟨m, n⟩, prod.ext (zero_smul _ _) (zero_smul _ _), ..prod.mul_action } diff --git a/src/algebra/module/projective.lean b/src/algebra/module/projective.lean index ca4949996259c..c147cd4606636 100644 --- a/src/algebra/module/projective.lean +++ b/src/algebra/module/projective.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2021 Kevin Buzzard. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kevin Buzzard +Authors: Kevin Buzzard, Antoine Labelle -/ import algebra.module.basic @@ -12,6 +12,9 @@ import linear_algebra.free_module.basic # Projective modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains a definition of a projective module, the proof that our definition is equivalent to a lifting property, and the proof that all free modules are projective. @@ -62,26 +65,31 @@ projective module universes u v +open linear_map finsupp + /- The actual implementation we choose: `P` is projective if the natural surjection from the free `R`-module on `P` to `P` splits. -/ /-- An R-module is projective if it is a direct summand of a free module, or equivalently if maps from the module lift along surjections. There are several other equivalent definitions. -/ -class module.projective (R : Type u) [semiring R] (P : Type (max u v)) [add_comm_monoid P] +class module.projective (R : Type*) [semiring R] (P : Type*) [add_comm_monoid P] [module R P] : Prop := (out : ∃ s : P →ₗ[R] (P →₀ R), function.left_inverse (finsupp.total P P R id) s) namespace module -lemma projective_def {R : Type u} [semiring R] {P : Type (max u v)} [add_comm_monoid P] - [module R P] : projective R P ↔ +section semiring + +variables {R : Type*} [semiring R] {P : Type*} [add_comm_monoid P] [module R P] + {M : Type*} [add_comm_monoid M] [module R M] {N : Type*} [add_comm_monoid N] [module R N] + +lemma projective_def : projective R P ↔ (∃ s : P →ₗ[R] (P →₀ R), function.left_inverse (finsupp.total P P R id) s) := ⟨λ h, h.1, λ h, ⟨h⟩⟩ -section semiring - -variables {R : Type u} [semiring R] {P : Type (max u v)} [add_comm_monoid P] [module R P] - {M : Type (max u v)} [add_comm_group M] [module R M] {N : Type*} [add_comm_group N] [module R N] +theorem projective_def' : projective R P ↔ + (∃ s : P →ₗ[R] (P →₀ R), (finsupp.total P P R id) ∘ₗ s = id) := +by simp_rw [projective_def, fun_like.ext_iff, function.left_inverse, coe_comp, id_coe, id.def] /-- A projective R-module has the property that maps from it lift along surjections. -/ theorem projective_lifting_property [h : projective R P] (f : M →ₗ[R] N) (g : P →ₗ[R] N) @@ -106,9 +114,90 @@ begin simp [φ, finsupp.total_apply, function.surj_inv_eq hf], end +variables {Q : Type*} [add_comm_monoid Q] [module R Q] + +instance [hP : projective R P] [hQ : projective R Q] : projective R (P × Q) := +begin + rw module.projective_def', + cases hP.out with sP hsP, + cases hQ.out with sQ hsQ, + use coprod (lmap_domain R R (inl R P Q)) (lmap_domain R R (inr R P Q)) ∘ₗ sP.prod_map sQ, + ext; simp only [coe_inl, coe_inr, coe_comp, function.comp_app, prod_map_apply, map_zero, + coprod_apply, lmap_domain_apply, map_domain_zero, add_zero, zero_add, id_comp, + total_map_domain], + + { rw [←fst_apply _, apply_total R], exact hsP x, }, + { rw [←snd_apply _, apply_total R], exact finsupp.total_zero_apply _ (sP x), }, + { rw [←fst_apply _, apply_total R], exact finsupp.total_zero_apply _ (sQ x), }, + { rw [←snd_apply _, apply_total R], exact hsQ x, }, +end + +variables {ι : Type*} (A : ι → Type*) [Π (i : ι), add_comm_monoid (A i)] + [Π (i : ι), module R (A i)] + +instance [h : Π (i : ι), projective R (A i)] : projective R (Π₀ i, A i) := +begin + classical, + rw module.projective_def', + simp_rw projective_def at h, choose s hs using h, + + letI : Π (i : ι), add_comm_monoid (A i →₀ R) := λ i, by apply_instance, + letI : Π (i : ι), module R (A i →₀ R) := λ i, by apply_instance, + letI : add_comm_monoid (Π₀ (i : ι), A i →₀ R) := @dfinsupp.add_comm_monoid ι (λ i, A i →₀ R) _, + letI : module R (Π₀ (i : ι), A i →₀ R) := @dfinsupp.module ι R (λ i, A i →₀ R) _ _ _, + + let f := λ i, lmap_domain R R (dfinsupp.single i : A i → Π₀ i, A i), + use dfinsupp.coprod_map f ∘ₗ dfinsupp.map_range.linear_map s, + + ext i x j, + simp only [dfinsupp.coprod_map, direct_sum.lof, total_map_domain, + coe_comp, coe_lsum, id_coe, linear_equiv.coe_to_linear_map, finsupp_lequiv_dfinsupp_symm_apply, + function.comp_app, dfinsupp.lsingle_apply, dfinsupp.map_range.linear_map_apply, + dfinsupp.map_range_single, lmap_domain_apply, dfinsupp.to_finsupp_single, + finsupp.sum_single_index, id.def, function.comp.left_id, dfinsupp.single_apply], + rw [←dfinsupp.lapply_apply j, apply_total R], + + obtain rfl | hij := eq_or_ne i j, + + { convert (hs i) x, + { ext, simp }, + { simp } }, + { convert finsupp.total_zero_apply _ ((s i) x), + { ext, simp [hij] }, + { simp [hij] } } +end + +end semiring + +section ring + +variables {R : Type*} [ring R] {P : Type*} [add_comm_group P] [module R P] + +/-- Free modules are projective. -/ +theorem projective_of_basis {ι : Type*} (b : basis ι R P) : projective R P := +begin + -- need P →ₗ (P →₀ R) for definition of projective. + -- get it from `ι → (P →₀ R)` coming from `b`. + use b.constr ℕ (λ i, finsupp.single (b i) (1 : R)), + intro m, + simp only [b.constr_apply, mul_one, id.def, finsupp.smul_single', finsupp.total_single, + linear_map.map_finsupp_sum], + exact b.total_repr m, +end + +@[priority 100] +instance projective_of_free [module.free R P] : module.projective R P := +projective_of_basis $ module.free.choose_basis R P + +end ring + +--This is in a different section because special universe restrictions are required. +section of_lifting_property + /-- A module which satisfies the universal property is projective. Note that the universe variables in `huniv` are somewhat restricted. -/ theorem projective_of_lifting_property' + {R : Type u} [semiring R] {P : Type (max u v)} [add_comm_monoid P] [module R P] -- If for all surjections of `R`-modules `M →ₗ N`, all maps `P →ₗ N` lift to `P →ₗ M`, (huniv : ∀ {M : Type (max v u)} {N : Type (max u v)} [add_comm_monoid M] [add_comm_monoid N], by exactI @@ -131,15 +220,10 @@ begin simp }, end -end semiring - -section ring - -variables {R : Type u} [ring R] {P : Type (max u v)} [add_comm_group P] [module R P] - /-- A variant of `of_lifting_property'` when we're working over a `[ring R]`, which only requires quantifying over modules with an `add_comm_group` instance. -/ theorem projective_of_lifting_property + {R : Type u} [ring R] {P : Type (max u v)} [add_comm_group P] [module R P] -- If for all surjections of `R`-modules `M →ₗ N`, all maps `P →ₗ N` lift to `P →ₗ M`, (huniv : ∀ {M : Type (max v u)} {N : Type (max u v)} [add_comm_group M] [add_comm_group N], by exactI @@ -165,22 +249,6 @@ begin simp }, end -/-- Free modules are projective. -/ -theorem projective_of_basis {ι : Type*} (b : basis ι R P) : projective R P := -begin - -- need P →ₗ (P →₀ R) for definition of projective. - -- get it from `ι → (P →₀ R)` coming from `b`. - use b.constr ℕ (λ i, finsupp.single (b i) (1 : R)), - intro m, - simp only [b.constr_apply, mul_one, id.def, finsupp.smul_single', finsupp.total_single, - linear_map.map_finsupp_sum], - exact b.total_repr m, -end - -@[priority 100] -instance projective_of_free [module.free R P] : module.projective R P := -projective_of_basis $ module.free.choose_basis R P - -end ring +end of_lifting_property end module diff --git a/src/algebra/module/submodule.lean b/src/algebra/module/submodule.lean deleted file mode 100644 index cff1388b1ad80..0000000000000 --- a/src/algebra/module/submodule.lean +++ /dev/null @@ -1,425 +0,0 @@ -/- -Copyright (c) 2015 Nathaniel Thomas. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro --/ -import algebra.module.linear_map -import algebra.module.equiv -import group_theory.group_action.sub_mul_action -/-! - -# Submodules of a module - -In this file we define - -* `submodule R M` : a subset of a `module` `M` that contains zero and is closed with respect to - addition and scalar multiplication. - -* `subspace k M` : an abbreviation for `submodule` assuming that `k` is a `field`. - -## Tags - -submodule, subspace, linear map --/ - -open function -open_locale big_operators - -universes u'' u' u v w -variables {G : Type u''} {S : Type u'} {R : Type u} {M : Type v} {ι : Type w} - -set_option old_structure_cmd true - -/-- A submodule of a module is one which is closed under vector operations. - This is a sufficient condition for the subset of vectors in the submodule - to themselves form a module. -/ -structure submodule (R : Type u) (M : Type v) [semiring R] - [add_comm_monoid M] [module R M] extends add_submonoid M, sub_mul_action R M : Type v. - -/-- Reinterpret a `submodule` as an `add_submonoid`. -/ -add_decl_doc submodule.to_add_submonoid - -/-- Reinterpret a `submodule` as an `sub_mul_action`. -/ -add_decl_doc submodule.to_sub_mul_action - -namespace submodule - -variables [semiring R] [add_comm_monoid M] [module R M] - -instance : set_like (submodule R M) M := -{ coe := submodule.carrier, - coe_injective' := λ p q h, by cases p; cases q; congr' } - -instance : add_submonoid_class (submodule R M) M := -{ zero_mem := zero_mem', - add_mem := add_mem' } - -@[simp] theorem mem_to_add_submonoid (p : submodule R M) (x : M) : x ∈ p.to_add_submonoid ↔ x ∈ p := -iff.rfl - -variables {p q : submodule R M} - -@[simp] -lemma mem_mk {S : set M} {x : M} (h₁ h₂ h₃) : x ∈ (⟨S, h₁, h₂, h₃⟩ : submodule R M) ↔ x ∈ S := -iff.rfl - -@[simp] lemma coe_set_mk (S : set M) (h₁ h₂ h₃) : - ((⟨S, h₁, h₂, h₃⟩ : submodule R M) : set M) = S := rfl - -@[simp] -lemma mk_le_mk {S S' : set M} (h₁ h₂ h₃ h₁' h₂' h₃') : - (⟨S, h₁, h₂, h₃⟩ : submodule R M) ≤ (⟨S', h₁', h₂', h₃'⟩ : submodule R M) ↔ S ⊆ S' := iff.rfl - -@[ext] theorem ext (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := set_like.ext h - -/-- Copy of a submodule with a new `carrier` equal to the old one. Useful to fix definitional -equalities. -/ -protected def copy (p : submodule R M) (s : set M) (hs : s = ↑p) : submodule R M := -{ carrier := s, - zero_mem' := hs.symm ▸ p.zero_mem', - add_mem' := hs.symm ▸ p.add_mem', - smul_mem' := hs.symm ▸ p.smul_mem' } - -@[simp] lemma coe_copy (S : submodule R M) (s : set M) (hs : s = ↑S) : - (S.copy s hs : set M) = s := rfl - -lemma copy_eq (S : submodule R M) (s : set M) (hs : s = ↑S) : S.copy s hs = S := -set_like.coe_injective hs - -theorem to_add_submonoid_injective : - injective (to_add_submonoid : submodule R M → add_submonoid M) := -λ p q h, set_like.ext'_iff.2 (show _, from set_like.ext'_iff.1 h) - -@[simp] theorem to_add_submonoid_eq : p.to_add_submonoid = q.to_add_submonoid ↔ p = q := -to_add_submonoid_injective.eq_iff - -@[mono] lemma to_add_submonoid_strict_mono : - strict_mono (to_add_submonoid : submodule R M → add_submonoid M) := λ _ _, id - -lemma to_add_submonoid_le : p.to_add_submonoid ≤ q.to_add_submonoid ↔ p ≤ q := iff.rfl - -@[mono] -lemma to_add_submonoid_mono : monotone (to_add_submonoid : submodule R M → add_submonoid M) := -to_add_submonoid_strict_mono.monotone - -@[simp] theorem coe_to_add_submonoid (p : submodule R M) : - (p.to_add_submonoid : set M) = p := rfl - -theorem to_sub_mul_action_injective : - injective (to_sub_mul_action : submodule R M → sub_mul_action R M) := -λ p q h, set_like.ext'_iff.2 (show _, from set_like.ext'_iff.1 h) - -@[simp] theorem to_sub_mul_action_eq : p.to_sub_mul_action = q.to_sub_mul_action ↔ p = q := -to_sub_mul_action_injective.eq_iff - -@[mono] lemma to_sub_mul_action_strict_mono : - strict_mono (to_sub_mul_action : submodule R M → sub_mul_action R M) := λ _ _, id - -@[mono] -lemma to_sub_mul_action_mono : monotone (to_sub_mul_action : submodule R M → sub_mul_action R M) := -to_sub_mul_action_strict_mono.monotone - -@[simp] theorem coe_to_sub_mul_action (p : submodule R M) : - (p.to_sub_mul_action : set M) = p := rfl - -end submodule - -namespace submodule - -section add_comm_monoid - -variables [semiring R] [add_comm_monoid M] - --- We can infer the module structure implicitly from the bundled submodule, --- rather than via typeclass resolution. -variables {module_M : module R M} -variables {p q : submodule R M} -variables {r : R} {x y : M} - -variables (p) -@[simp] lemma mem_carrier : x ∈ p.carrier ↔ x ∈ (p : set M) := iff.rfl - -@[simp] protected lemma zero_mem : (0 : M) ∈ p := zero_mem _ -protected lemma add_mem (h₁ : x ∈ p) (h₂ : y ∈ p) : x + y ∈ p := add_mem h₁ h₂ - -lemma smul_mem (r : R) (h : x ∈ p) : r • x ∈ p := p.smul_mem' r h -lemma smul_of_tower_mem [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] - (r : S) (h : x ∈ p) : r • x ∈ p := -p.to_sub_mul_action.smul_of_tower_mem r h - -protected lemma sum_mem {t : finset ι} {f : ι → M} : (∀c∈t, f c ∈ p) → (∑ i in t, f i) ∈ p := -sum_mem - -lemma sum_smul_mem {t : finset ι} {f : ι → M} (r : ι → R) - (hyp : ∀ c ∈ t, f c ∈ p) : (∑ i in t, r i • f i) ∈ p := -sum_mem (λ i hi, smul_mem _ _ (hyp i hi)) - -@[simp] lemma smul_mem_iff' [group G] [mul_action G M] [has_scalar G R] [is_scalar_tower G R M] - (g : G) : g • x ∈ p ↔ x ∈ p := -p.to_sub_mul_action.smul_mem_iff' g - -instance : has_add p := ⟨λx y, ⟨x.1 + y.1, add_mem x.2 y.2⟩⟩ -instance : has_zero p := ⟨⟨0, zero_mem _⟩⟩ -instance : inhabited p := ⟨0⟩ -instance [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] : - has_scalar S p := ⟨λ c x, ⟨c • x.1, smul_of_tower_mem _ c x.2⟩⟩ - -instance [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] : is_scalar_tower S R p := -p.to_sub_mul_action.is_scalar_tower - -instance - [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] - [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M] - [is_central_scalar S M] : is_central_scalar S p := -p.to_sub_mul_action.is_central_scalar - -protected lemma nonempty : (p : set M).nonempty := ⟨0, p.zero_mem⟩ - -@[simp] lemma mk_eq_zero {x} (h : x ∈ p) : (⟨x, h⟩ : p) = 0 ↔ x = 0 := subtype.ext_iff_val - -variables {p} -@[simp, norm_cast] lemma coe_eq_zero {x : p} : (x : M) = 0 ↔ x = 0 := -(set_like.coe_eq_coe : (x : M) = (0 : p) ↔ x = 0) -@[simp, norm_cast] lemma coe_add (x y : p) : (↑(x + y) : M) = ↑x + ↑y := rfl -@[simp, norm_cast] lemma coe_zero : ((0 : p) : M) = 0 := rfl -@[norm_cast] lemma coe_smul (r : R) (x : p) : ((r • x : p) : M) = r • ↑x := rfl -@[simp, norm_cast] lemma coe_smul_of_tower [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] - (r : S) (x : p) : ((r • x : p) : M) = r • ↑x := rfl -@[simp, norm_cast] lemma coe_mk (x : M) (hx : x ∈ p) : ((⟨x, hx⟩ : p) : M) = x := rfl -@[simp] lemma coe_mem (x : p) : (x : M) ∈ p := x.2 - -variables (p) - -instance : add_comm_monoid p := -{ add := (+), zero := 0, .. p.to_add_submonoid.to_add_comm_monoid } - -instance module' [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] : module S p := -by refine {smul := (•), ..p.to_sub_mul_action.mul_action', ..}; - { intros, apply set_coe.ext, simp [smul_add, add_smul, mul_smul] } -instance : module R p := p.module' - -instance no_zero_smul_divisors [no_zero_smul_divisors R M] : no_zero_smul_divisors R p := -⟨λ c x h, - have c = 0 ∨ (x : M) = 0, - from eq_zero_or_eq_zero_of_smul_eq_zero (congr_arg coe h), - this.imp_right (@subtype.ext_iff _ _ x 0).mpr⟩ - -/-- Embedding of a submodule `p` to the ambient space `M`. -/ -protected def subtype : p →ₗ[R] M := -by refine {to_fun := coe, ..}; simp [coe_smul] - -theorem subtype_apply (x : p) : p.subtype x = x := rfl - -@[simp] lemma coe_subtype : ((submodule.subtype p) : p → M) = coe := rfl - -lemma injective_subtype : injective p.subtype := subtype.coe_injective - -/-- Note the `add_submonoid` version of this lemma is called `add_submonoid.coe_finset_sum`. -/ -@[simp] lemma coe_sum (x : ι → p) (s : finset ι) : ↑(∑ i in s, x i) = ∑ i in s, (x i : M) := -p.subtype.map_sum - -section restrict_scalars -variables (S) [semiring S] [module S M] [module R M] [has_scalar S R] [is_scalar_tower S R M] - -/-- -`V.restrict_scalars S` is the `S`-submodule of the `S`-module given by restriction of scalars, -corresponding to `V`, an `R`-submodule of the original `R`-module. --/ -def restrict_scalars (V : submodule R M) : submodule S M := -{ carrier := V, - zero_mem' := V.zero_mem, - smul_mem' := λ c m h, V.smul_of_tower_mem c h, - add_mem' := λ x y hx hy, V.add_mem hx hy } - -@[simp] -lemma coe_restrict_scalars (V : submodule R M) : (V.restrict_scalars S : set M) = V := -rfl - -@[simp] -lemma restrict_scalars_mem (V : submodule R M) (m : M) : m ∈ V.restrict_scalars S ↔ m ∈ V := -iff.refl _ - -@[simp] -lemma restrict_scalars_self (V : submodule R M) : V.restrict_scalars R = V := -set_like.coe_injective rfl - -variables (R S M) - -lemma restrict_scalars_injective : - function.injective (restrict_scalars S : submodule R M → submodule S M) := -λ V₁ V₂ h, ext $ set.ext_iff.1 (set_like.ext'_iff.1 h : _) - -@[simp] lemma restrict_scalars_inj {V₁ V₂ : submodule R M} : - restrict_scalars S V₁ = restrict_scalars S V₂ ↔ V₁ = V₂ := -(restrict_scalars_injective S _ _).eq_iff - -/-- Even though `p.restrict_scalars S` has type `submodule S M`, it is still an `R`-module. -/ -instance restrict_scalars.orig_module (p : submodule R M) : - module R (p.restrict_scalars S) := -(by apply_instance : module R p) - -instance (p : submodule R M) : is_scalar_tower S R (p.restrict_scalars S) := -{ smul_assoc := λ r s x, subtype.ext $ smul_assoc r s (x : M) } - -/-- `restrict_scalars S` is an embedding of the lattice of `R`-submodules into -the lattice of `S`-submodules. -/ -@[simps] -def restrict_scalars_embedding : submodule R M ↪o submodule S M := -{ to_fun := restrict_scalars S, - inj' := restrict_scalars_injective S R M, - map_rel_iff' := λ p q, by simp [set_like.le_def] } - -/-- Turning `p : submodule R M` into an `S`-submodule gives the same module structure -as turning it into a type and adding a module structure. -/ -@[simps {simp_rhs := tt}] -def restrict_scalars_equiv (p : submodule R M) : p.restrict_scalars S ≃ₗ[R] p := -{ to_fun := id, inv_fun := id, map_smul' := λ c x, rfl, .. add_equiv.refl p } - -end restrict_scalars - -end add_comm_monoid - -section add_comm_group - -variables [ring R] [add_comm_group M] -variables {module_M : module R M} -variables (p p' : submodule R M) -variables {r : R} {x y : M} - -instance [module R M] : add_subgroup_class (submodule R M) M := -{ neg_mem := λ p x, p.to_sub_mul_action.neg_mem, - .. submodule.add_submonoid_class } - -protected lemma neg_mem (hx : x ∈ p) : -x ∈ p := neg_mem hx - -/-- Reinterpret a submodule as an additive subgroup. -/ -def to_add_subgroup : add_subgroup M := -{ neg_mem' := λ _, p.neg_mem , .. p.to_add_submonoid } - -@[simp] lemma coe_to_add_subgroup : (p.to_add_subgroup : set M) = p := rfl - -@[simp] lemma mem_to_add_subgroup : x ∈ p.to_add_subgroup ↔ x ∈ p := iff.rfl - -include module_M - -theorem to_add_subgroup_injective : injective (to_add_subgroup : submodule R M → add_subgroup M) -| p q h := set_like.ext (set_like.ext_iff.1 h : _) - -@[simp] theorem to_add_subgroup_eq : p.to_add_subgroup = p'.to_add_subgroup ↔ p = p' := -to_add_subgroup_injective.eq_iff - -@[mono] lemma to_add_subgroup_strict_mono : - strict_mono (to_add_subgroup : submodule R M → add_subgroup M) := λ _ _, id - -lemma to_add_subgroup_le : p.to_add_subgroup ≤ p'.to_add_subgroup ↔ p ≤ p' := iff.rfl - -@[mono] lemma to_add_subgroup_mono : monotone (to_add_subgroup : submodule R M → add_subgroup M) := -to_add_subgroup_strict_mono.monotone - -omit module_M - -protected lemma sub_mem : x ∈ p → y ∈ p → x - y ∈ p := sub_mem -protected lemma neg_mem_iff : -x ∈ p ↔ x ∈ p := neg_mem_iff -protected lemma add_mem_iff_left : y ∈ p → (x + y ∈ p ↔ x ∈ p) := add_mem_cancel_right -protected lemma add_mem_iff_right : x ∈ p → (x + y ∈ p ↔ y ∈ p) := add_mem_cancel_left -protected lemma coe_neg (x : p) : ((-x : p) : M) = -x := add_subgroup_class.coe_neg _ -protected lemma coe_sub (x y : p) : (↑(x - y) : M) = ↑x - ↑y := add_subgroup_class.coe_sub _ _ - -lemma sub_mem_iff_left (hy : y ∈ p) : (x - y) ∈ p ↔ x ∈ p := -by rw [sub_eq_add_neg, p.add_mem_iff_left (p.neg_mem hy)] - -lemma sub_mem_iff_right (hx : x ∈ p) : (x - y) ∈ p ↔ y ∈ p := -by rw [sub_eq_add_neg, p.add_mem_iff_right hx, p.neg_mem_iff] - -instance : add_comm_group p := -{ add := (+), zero := 0, neg := has_neg.neg, ..p.to_add_subgroup.to_add_comm_group } - -end add_comm_group - -section is_domain - -variables [ring R] [is_domain R] -variables [add_comm_group M] [module R M] {b : ι → M} - -lemma not_mem_of_ortho {x : M} {N : submodule R M} - (ortho : ∀ (c : R) (y ∈ N), c • x + y = (0 : M) → c = 0) : - x ∉ N := -by { intro hx, simpa using ortho (-1) x hx } - -lemma ne_zero_of_ortho {x : M} {N : submodule R M} - (ortho : ∀ (c : R) (y ∈ N), c • x + y = (0 : M) → c = 0) : - x ≠ 0 := -mt (λ h, show x ∈ N, from h.symm ▸ N.zero_mem) (not_mem_of_ortho ortho) - -end is_domain - -section ordered_monoid - -variables [semiring R] - -/-- A submodule of an `ordered_add_comm_monoid` is an `ordered_add_comm_monoid`. -/ -instance to_ordered_add_comm_monoid - {M} [ordered_add_comm_monoid M] [module R M] (S : submodule R M) : - ordered_add_comm_monoid S := -subtype.coe_injective.ordered_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) - -/-- A submodule of a `linear_ordered_add_comm_monoid` is a `linear_ordered_add_comm_monoid`. -/ -instance to_linear_ordered_add_comm_monoid - {M} [linear_ordered_add_comm_monoid M] [module R M] (S : submodule R M) : - linear_ordered_add_comm_monoid S := -subtype.coe_injective.linear_ordered_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) - -/-- A submodule of an `ordered_cancel_add_comm_monoid` is an `ordered_cancel_add_comm_monoid`. -/ -instance to_ordered_cancel_add_comm_monoid - {M} [ordered_cancel_add_comm_monoid M] [module R M] (S : submodule R M) : - ordered_cancel_add_comm_monoid S := -subtype.coe_injective.ordered_cancel_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) - -/-- A submodule of a `linear_ordered_cancel_add_comm_monoid` is a -`linear_ordered_cancel_add_comm_monoid`. -/ -instance to_linear_ordered_cancel_add_comm_monoid - {M} [linear_ordered_cancel_add_comm_monoid M] [module R M] (S : submodule R M) : - linear_ordered_cancel_add_comm_monoid S := -subtype.coe_injective.linear_ordered_cancel_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) - -end ordered_monoid - -section ordered_group - -variables [ring R] - -/-- A submodule of an `ordered_add_comm_group` is an `ordered_add_comm_group`. -/ -instance to_ordered_add_comm_group - {M} [ordered_add_comm_group M] [module R M] (S : submodule R M) : - ordered_add_comm_group S := -subtype.coe_injective.ordered_add_comm_group coe - rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) - -/-- A submodule of a `linear_ordered_add_comm_group` is a -`linear_ordered_add_comm_group`. -/ -instance to_linear_ordered_add_comm_group - {M} [linear_ordered_add_comm_group M] [module R M] (S : submodule R M) : - linear_ordered_add_comm_group S := -subtype.coe_injective.linear_ordered_add_comm_group coe - rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) - -end ordered_group - -end submodule - -namespace submodule - -variables [division_ring S] [semiring R] [add_comm_monoid M] [module R M] -variables [has_scalar S R] [module S M] [is_scalar_tower S R M] - -variables (p : submodule R M) {s : S} {x y : M} - -theorem smul_mem_iff (s0 : s ≠ 0) : s • x ∈ p ↔ x ∈ p := -p.to_sub_mul_action.smul_mem_iff s0 - -end submodule - -/-- Subspace of a vector space. Defined to equal `submodule`. -/ -abbreviation subspace (R : Type u) (M : Type v) - [field R] [add_comm_group M] [module R M] := -submodule R M diff --git a/src/algebra/module/submodule/basic.lean b/src/algebra/module/submodule/basic.lean new file mode 100644 index 0000000000000..6b5d2175764bb --- /dev/null +++ b/src/algebra/module/submodule/basic.lean @@ -0,0 +1,491 @@ +/- +Copyright (c) 2015 Nathaniel Thomas. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro +-/ +import algebra.module.linear_map +import algebra.module.equiv +import group_theory.group_action.sub_mul_action +import group_theory.submonoid.membership + +/-! + +# Submodules of a module + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define + +* `submodule R M` : a subset of a `module` `M` that contains zero and is closed with respect to + addition and scalar multiplication. + +* `subspace k M` : an abbreviation for `submodule` assuming that `k` is a `field`. + +## Tags + +submodule, subspace, linear map +-/ + +open function +open_locale big_operators + +universes u'' u' u v w +variables {G : Type u''} {S : Type u'} {R : Type u} {M : Type v} {ι : Type w} + +set_option old_structure_cmd true + +/-- A submodule of a module is one which is closed under vector operations. + This is a sufficient condition for the subset of vectors in the submodule + to themselves form a module. -/ +structure submodule (R : Type u) (M : Type v) [semiring R] + [add_comm_monoid M] [module R M] extends add_submonoid M, sub_mul_action R M : Type v. + +/-- Reinterpret a `submodule` as an `add_submonoid`. -/ +add_decl_doc submodule.to_add_submonoid + +/-- Reinterpret a `submodule` as an `sub_mul_action`. -/ +add_decl_doc submodule.to_sub_mul_action + +namespace submodule + +variables [semiring R] [add_comm_monoid M] [module R M] + +instance : set_like (submodule R M) M := +{ coe := submodule.carrier, + coe_injective' := λ p q h, by cases p; cases q; congr' } + +instance : add_submonoid_class (submodule R M) M := +{ zero_mem := zero_mem', + add_mem := add_mem' } + +instance : smul_mem_class (submodule R M) R M := +{ smul_mem := smul_mem' } + +@[simp] theorem mem_to_add_submonoid (p : submodule R M) (x : M) : x ∈ p.to_add_submonoid ↔ x ∈ p := +iff.rfl + +variables {p q : submodule R M} + +@[simp] +lemma mem_mk {S : set M} {x : M} (h₁ h₂ h₃) : x ∈ (⟨S, h₁, h₂, h₃⟩ : submodule R M) ↔ x ∈ S := +iff.rfl + +@[simp] lemma coe_set_mk (S : set M) (h₁ h₂ h₃) : + ((⟨S, h₁, h₂, h₃⟩ : submodule R M) : set M) = S := rfl + +@[simp] +lemma mk_le_mk {S S' : set M} (h₁ h₂ h₃ h₁' h₂' h₃') : + (⟨S, h₁, h₂, h₃⟩ : submodule R M) ≤ (⟨S', h₁', h₂', h₃'⟩ : submodule R M) ↔ S ⊆ S' := iff.rfl + +@[ext] theorem ext (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := set_like.ext h + +/-- Copy of a submodule with a new `carrier` equal to the old one. Useful to fix definitional +equalities. -/ +protected def copy (p : submodule R M) (s : set M) (hs : s = ↑p) : submodule R M := +{ carrier := s, + zero_mem' := hs.symm ▸ p.zero_mem', + add_mem' := λ _ _, hs.symm ▸ p.add_mem', + smul_mem' := hs.symm ▸ p.smul_mem' } + +@[simp] lemma coe_copy (S : submodule R M) (s : set M) (hs : s = ↑S) : + (S.copy s hs : set M) = s := rfl + +lemma copy_eq (S : submodule R M) (s : set M) (hs : s = ↑S) : S.copy s hs = S := +set_like.coe_injective hs + +theorem to_add_submonoid_injective : + injective (to_add_submonoid : submodule R M → add_submonoid M) := +λ p q h, set_like.ext'_iff.2 (show _, from set_like.ext'_iff.1 h) + +@[simp] theorem to_add_submonoid_eq : p.to_add_submonoid = q.to_add_submonoid ↔ p = q := +to_add_submonoid_injective.eq_iff + +@[mono] lemma to_add_submonoid_strict_mono : + strict_mono (to_add_submonoid : submodule R M → add_submonoid M) := λ _ _, id + +lemma to_add_submonoid_le : p.to_add_submonoid ≤ q.to_add_submonoid ↔ p ≤ q := iff.rfl + +@[mono] +lemma to_add_submonoid_mono : monotone (to_add_submonoid : submodule R M → add_submonoid M) := +to_add_submonoid_strict_mono.monotone + +@[simp] theorem coe_to_add_submonoid (p : submodule R M) : + (p.to_add_submonoid : set M) = p := rfl + +theorem to_sub_mul_action_injective : + injective (to_sub_mul_action : submodule R M → sub_mul_action R M) := +λ p q h, set_like.ext'_iff.2 (show _, from set_like.ext'_iff.1 h) + +@[simp] theorem to_sub_mul_action_eq : p.to_sub_mul_action = q.to_sub_mul_action ↔ p = q := +to_sub_mul_action_injective.eq_iff + +@[mono] lemma to_sub_mul_action_strict_mono : + strict_mono (to_sub_mul_action : submodule R M → sub_mul_action R M) := λ _ _, id + +@[mono] +lemma to_sub_mul_action_mono : monotone (to_sub_mul_action : submodule R M → sub_mul_action R M) := +to_sub_mul_action_strict_mono.monotone + +@[simp] theorem coe_to_sub_mul_action (p : submodule R M) : + (p.to_sub_mul_action : set M) = p := rfl + +end submodule + +namespace smul_mem_class + +variables [semiring R] [add_comm_monoid M] [module R M] {A : Type*} [set_like A M] + [add_submonoid_class A M] [hA : smul_mem_class A R M] (S' : A) + +include hA +/-- A submodule of a `module` is a `module`. -/ +@[priority 75] -- Prefer subclasses of `module` over `smul_mem_class`. +instance to_module : module R S' := +subtype.coe_injective.module R (add_submonoid_class.subtype S') (set_like.coe_smul S') + +/-- The natural `R`-linear map from a submodule of an `R`-module `M` to `M`. -/ +protected def subtype : S' →ₗ[R] M := ⟨coe, λ _ _, rfl, λ _ _, rfl⟩ + +@[simp] protected theorem coe_subtype : (smul_mem_class.subtype S' : S' → M) = coe := rfl + +end smul_mem_class + +namespace submodule + +section add_comm_monoid + +variables [semiring R] [add_comm_monoid M] + +-- We can infer the module structure implicitly from the bundled submodule, +-- rather than via typeclass resolution. +variables {module_M : module R M} +variables {p q : submodule R M} +variables {r : R} {x y : M} + +variables (p) +@[simp] lemma mem_carrier : x ∈ p.carrier ↔ x ∈ (p : set M) := iff.rfl + +@[simp] protected lemma zero_mem : (0 : M) ∈ p := zero_mem _ +protected lemma add_mem (h₁ : x ∈ p) (h₂ : y ∈ p) : x + y ∈ p := add_mem h₁ h₂ + +lemma smul_mem (r : R) (h : x ∈ p) : r • x ∈ p := p.smul_mem' r h +lemma smul_of_tower_mem [has_smul S R] [has_smul S M] [is_scalar_tower S R M] + (r : S) (h : x ∈ p) : r • x ∈ p := +p.to_sub_mul_action.smul_of_tower_mem r h + +protected lemma sum_mem {t : finset ι} {f : ι → M} : (∀c∈t, f c ∈ p) → (∑ i in t, f i) ∈ p := +sum_mem + +lemma sum_smul_mem {t : finset ι} {f : ι → M} (r : ι → R) + (hyp : ∀ c ∈ t, f c ∈ p) : (∑ i in t, r i • f i) ∈ p := +sum_mem (λ i hi, smul_mem _ _ (hyp i hi)) + +@[simp] lemma smul_mem_iff' [group G] [mul_action G M] [has_smul G R] [is_scalar_tower G R M] + (g : G) : g • x ∈ p ↔ x ∈ p := +p.to_sub_mul_action.smul_mem_iff' g + +instance : has_add p := ⟨λx y, ⟨x.1 + y.1, add_mem x.2 y.2⟩⟩ +instance : has_zero p := ⟨⟨0, zero_mem _⟩⟩ +instance : inhabited p := ⟨0⟩ +instance [has_smul S R] [has_smul S M] [is_scalar_tower S R M] : + has_smul S p := ⟨λ c x, ⟨c • x.1, smul_of_tower_mem _ c x.2⟩⟩ + +instance [has_smul S R] [has_smul S M] [is_scalar_tower S R M] : is_scalar_tower S R p := +p.to_sub_mul_action.is_scalar_tower + +instance is_scalar_tower' {S' : Type*} + [has_smul S R] [has_smul S M] [has_smul S' R] [has_smul S' M] [has_smul S S'] + [is_scalar_tower S' R M] [is_scalar_tower S S' M] [is_scalar_tower S R M] : + is_scalar_tower S S' p := +p.to_sub_mul_action.is_scalar_tower' + +instance + [has_smul S R] [has_smul S M] [is_scalar_tower S R M] + [has_smul Sᵐᵒᵖ R] [has_smul Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M] + [is_central_scalar S M] : is_central_scalar S p := +p.to_sub_mul_action.is_central_scalar + +protected lemma nonempty : (p : set M).nonempty := ⟨0, p.zero_mem⟩ + +@[simp] lemma mk_eq_zero {x} (h : x ∈ p) : (⟨x, h⟩ : p) = 0 ↔ x = 0 := subtype.ext_iff_val + +variables {p} +@[simp, norm_cast] lemma coe_eq_zero {x : p} : (x : M) = 0 ↔ x = 0 := +(set_like.coe_eq_coe : (x : M) = (0 : p) ↔ x = 0) +@[simp, norm_cast] lemma coe_add (x y : p) : (↑(x + y) : M) = ↑x + ↑y := rfl +@[simp, norm_cast] lemma coe_zero : ((0 : p) : M) = 0 := rfl +@[norm_cast] lemma coe_smul (r : R) (x : p) : ((r • x : p) : M) = r • ↑x := rfl +@[simp, norm_cast] lemma coe_smul_of_tower [has_smul S R] [has_smul S M] [is_scalar_tower S R M] + (r : S) (x : p) : ((r • x : p) : M) = r • ↑x := rfl +@[simp, norm_cast] lemma coe_mk (x : M) (hx : x ∈ p) : ((⟨x, hx⟩ : p) : M) = x := rfl +@[simp] lemma coe_mem (x : p) : (x : M) ∈ p := x.2 + +variables (p) + +instance : add_comm_monoid p := +{ add := (+), zero := 0, .. p.to_add_submonoid.to_add_comm_monoid } + +instance module' [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M] : module S p := +by refine {smul := (•), ..p.to_sub_mul_action.mul_action', ..}; + { intros, apply set_coe.ext, simp [smul_add, add_smul, mul_smul] } +instance : module R p := p.module' + +instance no_zero_smul_divisors [no_zero_smul_divisors R M] : no_zero_smul_divisors R p := +⟨λ c x h, + have c = 0 ∨ (x : M) = 0, + from eq_zero_or_eq_zero_of_smul_eq_zero (congr_arg coe h), + this.imp_right (@subtype.ext_iff _ _ x 0).mpr⟩ + +/-- Embedding of a submodule `p` to the ambient space `M`. -/ +protected def subtype : p →ₗ[R] M := +by refine {to_fun := coe, ..}; simp [coe_smul] + +theorem subtype_apply (x : p) : p.subtype x = x := rfl + +@[simp] lemma coe_subtype : ((submodule.subtype p) : p → M) = coe := rfl + +lemma injective_subtype : injective p.subtype := subtype.coe_injective + +/-- Note the `add_submonoid` version of this lemma is called `add_submonoid.coe_finset_sum`. -/ +@[simp] lemma coe_sum (x : ι → p) (s : finset ι) : ↑(∑ i in s, x i) = ∑ i in s, (x i : M) := +map_sum p.subtype _ _ + +section add_action + +/-! ### Additive actions by `submodule`s + +These instances transfer the action by an element `m : M` of a `R`-module `M` written as `m +ᵥ a` +onto the action by an element `s : S` of a submodule `S : submodule R M` such that +`s +ᵥ a = (s : M) +ᵥ a`. + +These instances work particularly well in conjunction with `add_group.to_add_action`, enabling +`s +ᵥ m` as an alias for `↑s + m`. + +-/ + +variables {α β : Type*} + +instance [has_vadd M α] : has_vadd p α := p.to_add_submonoid.has_vadd + +instance vadd_comm_class [has_vadd M β] [has_vadd α β] [vadd_comm_class M α β] : + vadd_comm_class p α β := ⟨λ a, (vadd_comm (a : M) : _)⟩ + +instance [has_vadd M α] [has_faithful_vadd M α] : + has_faithful_vadd p α := ⟨λ x y h, subtype.ext $ eq_of_vadd_eq_vadd h⟩ + +/-- The action by a submodule is the action by the underlying module. -/ +instance [add_action M α] : add_action p α := add_action.comp_hom _ p.subtype.to_add_monoid_hom + +variable {p} + +lemma vadd_def [has_vadd M α] (g : p) (m : α) : g +ᵥ m = (g : M) +ᵥ m := rfl + +end add_action + +section restrict_scalars +variables (S) [semiring S] [module S M] [module R M] [has_smul S R] [is_scalar_tower S R M] + +/-- +`V.restrict_scalars S` is the `S`-submodule of the `S`-module given by restriction of scalars, +corresponding to `V`, an `R`-submodule of the original `R`-module. +-/ +def restrict_scalars (V : submodule R M) : submodule S M := +{ carrier := V, + zero_mem' := V.zero_mem, + smul_mem' := λ c m h, V.smul_of_tower_mem c h, + add_mem' := λ x y hx hy, V.add_mem hx hy } + +@[simp] +lemma coe_restrict_scalars (V : submodule R M) : (V.restrict_scalars S : set M) = V := +rfl + +@[simp] +lemma restrict_scalars_mem (V : submodule R M) (m : M) : m ∈ V.restrict_scalars S ↔ m ∈ V := +iff.refl _ + +@[simp] +lemma restrict_scalars_self (V : submodule R M) : V.restrict_scalars R = V := +set_like.coe_injective rfl + +variables (R S M) + +lemma restrict_scalars_injective : + function.injective (restrict_scalars S : submodule R M → submodule S M) := +λ V₁ V₂ h, ext $ set.ext_iff.1 (set_like.ext'_iff.1 h : _) + +@[simp] lemma restrict_scalars_inj {V₁ V₂ : submodule R M} : + restrict_scalars S V₁ = restrict_scalars S V₂ ↔ V₁ = V₂ := +(restrict_scalars_injective S _ _).eq_iff + +/-- Even though `p.restrict_scalars S` has type `submodule S M`, it is still an `R`-module. -/ +instance restrict_scalars.orig_module (p : submodule R M) : + module R (p.restrict_scalars S) := +(by apply_instance : module R p) + +instance (p : submodule R M) : is_scalar_tower S R (p.restrict_scalars S) := +{ smul_assoc := λ r s x, subtype.ext $ smul_assoc r s (x : M) } + +/-- `restrict_scalars S` is an embedding of the lattice of `R`-submodules into +the lattice of `S`-submodules. -/ +@[simps] +def restrict_scalars_embedding : submodule R M ↪o submodule S M := +{ to_fun := restrict_scalars S, + inj' := restrict_scalars_injective S R M, + map_rel_iff' := λ p q, by simp [set_like.le_def] } + +/-- Turning `p : submodule R M` into an `S`-submodule gives the same module structure +as turning it into a type and adding a module structure. -/ +@[simps {simp_rhs := tt}] +def restrict_scalars_equiv (p : submodule R M) : p.restrict_scalars S ≃ₗ[R] p := +{ to_fun := id, inv_fun := id, map_smul' := λ c x, rfl, .. add_equiv.refl p } + +end restrict_scalars + +end add_comm_monoid + +section add_comm_group + +variables [ring R] [add_comm_group M] +variables {module_M : module R M} +variables (p p' : submodule R M) +variables {r : R} {x y : M} + +instance [module R M] : add_subgroup_class (submodule R M) M := +{ neg_mem := λ p x, p.to_sub_mul_action.neg_mem, + .. submodule.add_submonoid_class } + +protected lemma neg_mem (hx : x ∈ p) : -x ∈ p := neg_mem hx + +/-- Reinterpret a submodule as an additive subgroup. -/ +def to_add_subgroup : add_subgroup M := +{ neg_mem' := λ _, p.neg_mem , .. p.to_add_submonoid } + +@[simp] lemma coe_to_add_subgroup : (p.to_add_subgroup : set M) = p := rfl + +@[simp] lemma mem_to_add_subgroup : x ∈ p.to_add_subgroup ↔ x ∈ p := iff.rfl + +include module_M + +theorem to_add_subgroup_injective : injective (to_add_subgroup : submodule R M → add_subgroup M) +| p q h := set_like.ext (set_like.ext_iff.1 h : _) + +@[simp] theorem to_add_subgroup_eq : p.to_add_subgroup = p'.to_add_subgroup ↔ p = p' := +to_add_subgroup_injective.eq_iff + +@[mono] lemma to_add_subgroup_strict_mono : + strict_mono (to_add_subgroup : submodule R M → add_subgroup M) := λ _ _, id + +lemma to_add_subgroup_le : p.to_add_subgroup ≤ p'.to_add_subgroup ↔ p ≤ p' := iff.rfl + +@[mono] lemma to_add_subgroup_mono : monotone (to_add_subgroup : submodule R M → add_subgroup M) := +to_add_subgroup_strict_mono.monotone + +omit module_M + +protected lemma sub_mem : x ∈ p → y ∈ p → x - y ∈ p := sub_mem +protected lemma neg_mem_iff : -x ∈ p ↔ x ∈ p := neg_mem_iff +protected lemma add_mem_iff_left : y ∈ p → (x + y ∈ p ↔ x ∈ p) := add_mem_cancel_right +protected lemma add_mem_iff_right : x ∈ p → (x + y ∈ p ↔ y ∈ p) := add_mem_cancel_left +protected lemma coe_neg (x : p) : ((-x : p) : M) = -x := add_subgroup_class.coe_neg _ +protected lemma coe_sub (x y : p) : (↑(x - y) : M) = ↑x - ↑y := add_subgroup_class.coe_sub _ _ + +lemma sub_mem_iff_left (hy : y ∈ p) : (x - y) ∈ p ↔ x ∈ p := +by rw [sub_eq_add_neg, p.add_mem_iff_left (p.neg_mem hy)] + +lemma sub_mem_iff_right (hx : x ∈ p) : (x - y) ∈ p ↔ y ∈ p := +by rw [sub_eq_add_neg, p.add_mem_iff_right hx, p.neg_mem_iff] + +instance : add_comm_group p := +{ add := (+), zero := 0, neg := has_neg.neg, ..p.to_add_subgroup.to_add_comm_group } + +end add_comm_group + +section is_domain + +variables [ring R] [is_domain R] +variables [add_comm_group M] [module R M] {b : ι → M} + +lemma not_mem_of_ortho {x : M} {N : submodule R M} + (ortho : ∀ (c : R) (y ∈ N), c • x + y = (0 : M) → c = 0) : + x ∉ N := +by { intro hx, simpa using ortho (-1) x hx } + +lemma ne_zero_of_ortho {x : M} {N : submodule R M} + (ortho : ∀ (c : R) (y ∈ N), c • x + y = (0 : M) → c = 0) : + x ≠ 0 := +mt (λ h, show x ∈ N, from h.symm ▸ N.zero_mem) (not_mem_of_ortho ortho) + +end is_domain + +section ordered_monoid + +variables [semiring R] + +/-- A submodule of an `ordered_add_comm_monoid` is an `ordered_add_comm_monoid`. -/ +instance to_ordered_add_comm_monoid + {M} [ordered_add_comm_monoid M] [module R M] (S : submodule R M) : + ordered_add_comm_monoid S := +subtype.coe_injective.ordered_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) + +/-- A submodule of a `linear_ordered_add_comm_monoid` is a `linear_ordered_add_comm_monoid`. -/ +instance to_linear_ordered_add_comm_monoid + {M} [linear_ordered_add_comm_monoid M] [module R M] (S : submodule R M) : + linear_ordered_add_comm_monoid S := +subtype.coe_injective.linear_ordered_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) + (λ _ _, rfl) + +/-- A submodule of an `ordered_cancel_add_comm_monoid` is an `ordered_cancel_add_comm_monoid`. -/ +instance to_ordered_cancel_add_comm_monoid + {M} [ordered_cancel_add_comm_monoid M] [module R M] (S : submodule R M) : + ordered_cancel_add_comm_monoid S := +subtype.coe_injective.ordered_cancel_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) + +/-- A submodule of a `linear_ordered_cancel_add_comm_monoid` is a +`linear_ordered_cancel_add_comm_monoid`. -/ +instance to_linear_ordered_cancel_add_comm_monoid + {M} [linear_ordered_cancel_add_comm_monoid M] [module R M] (S : submodule R M) : + linear_ordered_cancel_add_comm_monoid S := +subtype.coe_injective.linear_ordered_cancel_add_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) + (λ _ _, rfl) (λ _ _, rfl) + +end ordered_monoid + +section ordered_group + +variables [ring R] + +/-- A submodule of an `ordered_add_comm_group` is an `ordered_add_comm_group`. -/ +instance to_ordered_add_comm_group + {M} [ordered_add_comm_group M] [module R M] (S : submodule R M) : + ordered_add_comm_group S := +subtype.coe_injective.ordered_add_comm_group coe + rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) + +/-- A submodule of a `linear_ordered_add_comm_group` is a +`linear_ordered_add_comm_group`. -/ +instance to_linear_ordered_add_comm_group + {M} [linear_ordered_add_comm_group M] [module R M] (S : submodule R M) : + linear_ordered_add_comm_group S := +subtype.coe_injective.linear_ordered_add_comm_group coe + rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) + +end ordered_group + +end submodule + +namespace submodule + +variables [division_ring S] [semiring R] [add_comm_monoid M] [module R M] +variables [has_smul S R] [module S M] [is_scalar_tower S R M] + +variables (p : submodule R M) {s : S} {x y : M} + +theorem smul_mem_iff (s0 : s ≠ 0) : s • x ∈ p ↔ x ∈ p := +p.to_sub_mul_action.smul_mem_iff s0 + +end submodule + +/-- Subspace of a vector space. Defined to equal `submodule`. -/ +abbreviation subspace (R : Type u) (M : Type v) + [division_ring R] [add_comm_group M] [module R M] := +submodule R M diff --git a/src/algebra/module/submodule/bilinear.lean b/src/algebra/module/submodule/bilinear.lean new file mode 100644 index 0000000000000..d2c2755e21d57 --- /dev/null +++ b/src/algebra/module/submodule/bilinear.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2019 Kenny Lau. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kenny Lau, Eric Wieser +-/ +import linear_algebra.span +import linear_algebra.bilinear_map + +/-! +# Images of pairs of submodules under bilinear maps + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides `submodule.map₂`, which is later used to implement `submodule.has_mul`. + +## Main results + +* `submodule.map₂_eq_span_image2`: the image of two submodules under a bilinear map is the span of + their `set.image2`. + +## Notes + +This file is quite similar to the n-ary section of `data.set.basic` and to `order.filter.n_ary`. +Please keep them in sync. +-/ + +universes uι u v + +open set +open_locale big_operators +open_locale pointwise + +namespace submodule + +variables {ι : Sort uι} {R M N P : Type*} +variables [comm_semiring R] [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] +variables [module R M] [module R N] [module R P] + +/-- Map a pair of submodules under a bilinear map. + +This is the submodule version of `set.image2`. -/ +def map₂ (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) : submodule R P := +⨆ s : p, q.map $ f s + +theorem apply_mem_map₂ (f : M →ₗ[R] N →ₗ[R] P) {m : M} {n : N} + {p : submodule R M} {q : submodule R N} (hm : m ∈ p) (hn : n ∈ q) : f m n ∈ map₂ f p q := +(le_supr _ ⟨m, hm⟩ : _ ≤ map₂ f p q) ⟨n, hn, rfl⟩ + +theorem map₂_le {f : M →ₗ[R] N →ₗ[R] P} + {p : submodule R M} {q : submodule R N} {r : submodule R P} : + map₂ f p q ≤ r ↔ ∀ (m ∈ p) (n ∈ q), f m n ∈ r := +⟨λ H m hm n hn, H $ apply_mem_map₂ _ hm hn, + λ H, supr_le $ λ ⟨m, hm⟩, map_le_iff_le_comap.2 $ λ n hn, H m hm n hn⟩ + +variables R +theorem map₂_span_span (f : M →ₗ[R] N →ₗ[R] P) (s : set M) (t : set N) : + map₂ f (span R s) (span R t) = span R (set.image2 (λ m n, f m n) s t) := +begin + apply le_antisymm, + { rw map₂_le, intros a ha b hb, + apply span_induction ha, + work_on_goal 1 { intros, apply span_induction hb, + work_on_goal 1 { intros, exact subset_span ⟨_, _, ‹_›, ‹_›, rfl⟩ } }, + all_goals { + intros, + simp only [linear_map.map_zero, linear_map.zero_apply, zero_mem, + linear_map.map_add, linear_map.add_apply, linear_map.map_smul, linear_map.smul_apply] }, + all_goals { + solve_by_elim [add_mem _ _, zero_mem _, smul_mem _ _ _] + { max_depth := 4, discharger := tactic.interactive.apply_instance } } }, + { rw span_le, rintros _ ⟨a, b, ha, hb, rfl⟩, + exact apply_mem_map₂ _ (subset_span ha) (subset_span hb) } +end +variables {R} + +@[simp] theorem map₂_bot_right (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) : map₂ f p ⊥ = ⊥ := +eq_bot_iff.2 $ map₂_le.2 $ λ m hm n hn, + by { rw [submodule.mem_bot] at hn ⊢, rw [hn, linear_map.map_zero] } + +@[simp] theorem map₂_bot_left (f : M →ₗ[R] N →ₗ[R] P) (q : submodule R N) : map₂ f ⊥ q = ⊥ := +eq_bot_iff.2 $ map₂_le.2 $ λ m hm n hn, + by { rw [submodule.mem_bot] at hm ⊢, rw [hm, linear_map.map_zero₂] } + +@[mono] theorem map₂_le_map₂ {f : M →ₗ[R] N →ₗ[R] P} + {p₁ p₂ : submodule R M} {q₁ q₂ : submodule R N} (hp : p₁ ≤ p₂) (hq : q₁ ≤ q₂) : + map₂ f p₁ q₁ ≤ map₂ f p₂ q₂ := +map₂_le.2 $ λ m hm n hn, apply_mem_map₂ _ (hp hm) (hq hn) + +theorem map₂_le_map₂_left {f : M →ₗ[R] N →ₗ[R] P} + {p₁ p₂ : submodule R M} {q : submodule R N} (h : p₁ ≤ p₂) : map₂ f p₁ q ≤ map₂ f p₂ q := +map₂_le_map₂ h (le_refl q) + +theorem map₂_le_map₂_right {f : M →ₗ[R] N →ₗ[R] P} + {p : submodule R M} {q₁ q₂ : submodule R N} (h : q₁ ≤ q₂): map₂ f p q₁ ≤ map₂ f p q₂ := +map₂_le_map₂ (le_refl p) h + +theorem map₂_sup_right (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q₁ q₂ : submodule R N) : + map₂ f p (q₁ ⊔ q₂) = map₂ f p q₁ ⊔ map₂ f p q₂ := +le_antisymm (map₂_le.2 $ λ m hm np hnp, let ⟨n, hn, p, hp, hnp⟩ := mem_sup.1 hnp in + mem_sup.2 ⟨_, apply_mem_map₂ _ hm hn, _, apply_mem_map₂ _ hm hp, hnp ▸ (map_add _ _ _).symm⟩) +(sup_le (map₂_le_map₂_right le_sup_left) (map₂_le_map₂_right le_sup_right)) + +theorem map₂_sup_left (f : M →ₗ[R] N →ₗ[R] P) (p₁ p₂ : submodule R M) (q : submodule R N) : + map₂ f (p₁ ⊔ p₂) q = map₂ f p₁ q ⊔ map₂ f p₂ q := +le_antisymm (map₂_le.2 $ λ mn hmn p hp, let ⟨m, hm, n, hn, hmn⟩ := mem_sup.1 hmn in + mem_sup.2 ⟨_, apply_mem_map₂ _ hm hp, _, apply_mem_map₂ _ hn hp, + hmn ▸ (linear_map.map_add₂ _ _ _ _).symm⟩) +(sup_le (map₂_le_map₂_left le_sup_left) (map₂_le_map₂_left le_sup_right)) + +lemma image2_subset_map₂ (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) : + set.image2 (λ m n, f m n) (↑p : set M) (↑q : set N) ⊆ (↑(map₂ f p q) : set P) := +by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact apply_mem_map₂ _ hi hj } + +lemma map₂_eq_span_image2 (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) : + map₂ f p q = span R (set.image2 (λ m n, f m n) (p : set M) (q : set N)) := +by rw [← map₂_span_span, span_eq, span_eq] + +lemma map₂_flip (f : M →ₗ[R] N →ₗ[R] P) (p : submodule R M) (q : submodule R N) : + map₂ f.flip q p = map₂ f p q := +by { rw [map₂_eq_span_image2, map₂_eq_span_image2, set.image2_swap], refl } + +lemma map₂_supr_left (f : M →ₗ[R] N →ₗ[R] P) (s : ι → submodule R M) (t : submodule R N) : + map₂ f (⨆ i, s i) t = ⨆ i, map₂ f (s i) t := +begin + suffices : + map₂ f (⨆ i, span R (s i : set M)) (span R t) = (⨆ i, map₂ f (span R (s i)) (span R t)), + { simpa only [span_eq] using this }, + simp_rw [map₂_span_span, ← span_Union, map₂_span_span, set.image2_Union_left], +end + +lemma map₂_supr_right (f : M →ₗ[R] N →ₗ[R] P) (s : submodule R M) (t : ι → submodule R N) : + map₂ f s (⨆ i, t i) = ⨆ i, map₂ f s (t i) := +begin + suffices : + map₂ f (span R s) (⨆ i, span R (t i : set N)) = (⨆ i, map₂ f (span R s) (span R (t i))), + { simpa only [span_eq] using this }, + simp_rw [map₂_span_span, ← span_Union, map₂_span_span, set.image2_Union_right], +end + +theorem map₂_span_singleton_eq_map (f : M →ₗ[R] N →ₗ[R] P) (m : M) : + map₂ f (span R {m}) = map (f m) := +begin + funext, rw map₂_eq_span_image2, apply le_antisymm, + { rw [span_le, set.image2_subset_iff], + intros x hx y hy, + obtain ⟨a, rfl⟩ := mem_span_singleton.1 hx, + rw [f.map_smul], + exact smul_mem _ a (mem_map_of_mem hy) }, + { rintro _ ⟨n, hn, rfl⟩, + exact subset_span ⟨m, n, mem_span_singleton_self m, hn, rfl⟩ }, +end + +theorem map₂_span_singleton_eq_map_flip (f : M →ₗ[R] N →ₗ[R] P) (s : submodule R M) (n : N) : + map₂ f s (span R {n}) = map (f.flip n) s := +by rw [← map₂_span_singleton_eq_map, map₂_flip] + +end submodule diff --git a/src/algebra/module/submodule/lattice.lean b/src/algebra/module/submodule/lattice.lean new file mode 100644 index 0000000000000..669c4f0ee22f9 --- /dev/null +++ b/src/algebra/module/submodule/lattice.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2017 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov +-/ +import algebra.module.submodule.basic +import algebra.punit_instances + +/-! +# The lattice structure on `submodule`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the lattice structure on submodules, `submodule.complete_lattice`, with `⊥` +defined as `{0}` and `⊓` defined as intersection of the underlying carrier. +If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`. + +Many results about operations on this lattice structure are defined in `linear_algebra/basic.lean`, +most notably those which use `span`. + +## Implementation notes + +This structure should match the `add_submonoid.complete_lattice` structure, and we should try +to unify the APIs where possible. + +-/ + +variables {R S M : Type*} + +section add_comm_monoid +variables [semiring R] [semiring S] [add_comm_monoid M] [module R M] [module S M] +variables [has_smul S R] [is_scalar_tower S R M] +variables {p q : submodule R M} + +namespace submodule + +/-- The set `{0}` is the bottom element of the lattice of submodules. -/ +instance : has_bot (submodule R M) := +⟨{ carrier := {0}, smul_mem' := by simp { contextual := tt }, .. (⊥ : add_submonoid M)}⟩ + +instance inhabited' : inhabited (submodule R M) := ⟨⊥⟩ + +@[simp] lemma bot_coe : ((⊥ : submodule R M) : set M) = {0} := rfl +@[simp] lemma bot_to_add_submonoid : (⊥ : submodule R M).to_add_submonoid = ⊥ := rfl + +section +variables (R) +@[simp] lemma restrict_scalars_bot : restrict_scalars S (⊥ : submodule R M) = ⊥ := rfl + +@[simp] lemma mem_bot {x : M} : x ∈ (⊥ : submodule R M) ↔ x = 0 := set.mem_singleton_iff +end + +@[simp] lemma restrict_scalars_eq_bot_iff {p : submodule R M} : + restrict_scalars S p = ⊥ ↔ p = ⊥ := +by simp [set_like.ext_iff] + +instance unique_bot : unique (⊥ : submodule R M) := +⟨infer_instance, λ x, subtype.ext $ (mem_bot R).1 x.mem⟩ + +instance : order_bot (submodule R M) := +{ bot := ⊥, + bot_le := λ p x, by simp [zero_mem] {contextual := tt} } + +protected lemma eq_bot_iff (p : submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) := +⟨ λ h, h.symm ▸ λ x hx, (mem_bot R).mp hx, + λ h, eq_bot_iff.mpr (λ x hx, (mem_bot R).mpr (h x hx)) ⟩ + +@[ext] protected lemma bot_ext (x y : (⊥ : submodule R M)) : x = y := +begin + rcases x with ⟨x, xm⟩, rcases y with ⟨y, ym⟩, congr, + rw (submodule.eq_bot_iff _).mp rfl x xm, + rw (submodule.eq_bot_iff _).mp rfl y ym, +end + +protected lemma ne_bot_iff (p : submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) := +by { haveI := classical.prop_decidable, simp_rw [ne.def, p.eq_bot_iff, not_forall] } + +lemma nonzero_mem_of_bot_lt {p : submodule R M} (bot_lt : ⊥ < p) : ∃ a : p, a ≠ 0 := +let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp bot_lt.ne' in ⟨⟨b, hb₁⟩, hb₂ ∘ (congr_arg coe)⟩ + +lemma exists_mem_ne_zero_of_ne_bot {p : submodule R M} (h : p ≠ ⊥) : ∃ b : M, b ∈ p ∧ b ≠ 0 := +let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp h in ⟨b, hb₁, hb₂⟩ + +/-- The bottom submodule is linearly equivalent to punit as an `R`-module. -/ +@[simps] def bot_equiv_punit : (⊥ : submodule R M) ≃ₗ[R] punit := +{ to_fun := λ x, punit.star, + inv_fun := λ x, 0, + map_add' := by { intros, ext, }, + map_smul' := by { intros, ext, }, + left_inv := by { intro x, ext, }, + right_inv := by { intro x, ext, }, } + +lemma eq_bot_of_subsingleton (p : submodule R M) [subsingleton p] : p = ⊥ := +begin + rw eq_bot_iff, + intros v hv, + exact congr_arg coe (subsingleton.elim (⟨v, hv⟩ : p) 0) +end + +/-- The universal set is the top element of the lattice of submodules. -/ +instance : has_top (submodule R M) := +⟨{ carrier := set.univ, smul_mem' := λ _ _ _, trivial, .. (⊤ : add_submonoid M)}⟩ + +@[simp] lemma top_coe : ((⊤ : submodule R M) : set M) = set.univ := rfl + +@[simp] lemma top_to_add_submonoid : (⊤ : submodule R M).to_add_submonoid = ⊤ := rfl + +@[simp] lemma mem_top {x : M} : x ∈ (⊤ : submodule R M) := trivial + +section +variables (R) +@[simp] lemma restrict_scalars_top : restrict_scalars S (⊤ : submodule R M) = ⊤ := rfl +end + +@[simp] lemma restrict_scalars_eq_top_iff {p : submodule R M} : + restrict_scalars S p = ⊤ ↔ p = ⊤ := +by simp [set_like.ext_iff] + +instance : order_top (submodule R M) := +{ top := ⊤, + le_top := λ p x _, trivial } + +lemma eq_top_iff' {p : submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p := +eq_top_iff.trans ⟨λ h x, h trivial, λ h x _, h x⟩ + +/-- The top submodule is linearly equivalent to the module. + +This is the module version of `add_submonoid.top_equiv`. -/ +@[simps] def top_equiv : (⊤ : submodule R M) ≃ₗ[R] M := +{ to_fun := λ x, x, + inv_fun := λ x, ⟨x, by simp⟩, + map_add' := by { intros, refl, }, + map_smul' := by { intros, refl, }, + left_inv := by { intro x, ext, refl, }, + right_inv := by { intro x, refl, }, } + +instance : has_Inf (submodule R M) := +⟨λ S, +{ carrier := ⋂ s ∈ S, (s : set M), + zero_mem' := by simp [zero_mem], + add_mem' := by simp [add_mem] {contextual := tt}, + smul_mem' := by simp [smul_mem] {contextual := tt} }⟩ + +private lemma Inf_le' {S : set (submodule R M)} {p} : p ∈ S → Inf S ≤ p := +set.bInter_subset_of_mem + +private lemma le_Inf' {S : set (submodule R M)} {p} : (∀q ∈ S, p ≤ q) → p ≤ Inf S := +set.subset_Inter₂ + +instance : has_inf (submodule R M) := +⟨λ p q, +{ carrier := p ∩ q, + zero_mem' := by simp [zero_mem], + add_mem' := by simp [add_mem] {contextual := tt}, + smul_mem' := by simp [smul_mem] {contextual := tt} }⟩ + +instance : complete_lattice (submodule R M) := +{ sup := λ a b, Inf {x | a ≤ x ∧ b ≤ x}, + le_sup_left := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, ha, + le_sup_right := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, hb, + sup_le := λ a b c h₁ h₂, Inf_le' ⟨h₁, h₂⟩, + inf := (⊓), + le_inf := λ a b c, set.subset_inter, + inf_le_left := λ a b, set.inter_subset_left _ _, + inf_le_right := λ a b, set.inter_subset_right _ _, + Sup := λtt, Inf {t | ∀t'∈tt, t' ≤ t}, + le_Sup := λ s p hs, le_Inf' $ λ q hq, hq _ hs, + Sup_le := λ s p hs, Inf_le' hs, + Inf := Inf, + le_Inf := λ s a, le_Inf', + Inf_le := λ s a, Inf_le', + ..submodule.order_top, + ..submodule.order_bot, + ..set_like.partial_order } + +@[simp] theorem inf_coe : ↑(p ⊓ q) = (p ∩ q : set M) := rfl + +@[simp] theorem mem_inf {p q : submodule R M} {x : M} : + x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q := iff.rfl + +@[simp] theorem Inf_coe (P : set (submodule R M)) : (↑(Inf P) : set M) = ⋂ p ∈ P, ↑p := rfl + +@[simp] theorem finset_inf_coe {ι} (s : finset ι) (p : ι → submodule R M) : + (↑(s.inf p) : set M) = ⋂ i ∈ s, ↑(p i) := +begin + letI := classical.dec_eq ι, + refine s.induction_on _ (λ i s hi ih, _), + { simp }, + { rw [finset.inf_insert, inf_coe, ih], + simp }, +end + +@[simp] theorem infi_coe {ι} (p : ι → submodule R M) : + (↑⨅ i, p i : set M) = ⋂ i, ↑(p i) := +by rw [infi, Inf_coe]; ext a; simp; exact +⟨λ h i, h _ i rfl, λ h i x e, e ▸ h _⟩ + +@[simp] lemma mem_Inf {S : set (submodule R M)} {x : M} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := +set.mem_Inter₂ + +@[simp] theorem mem_infi {ι} (p : ι → submodule R M) {x} : + x ∈ (⨅ i, p i) ↔ ∀ i, x ∈ p i := +by rw [← set_like.mem_coe, infi_coe, set.mem_Inter]; refl + +@[simp] theorem mem_finset_inf {ι} {s : finset ι} {p : ι → submodule R M} {x : M} : + x ∈ s.inf p ↔ ∀ i ∈ s, x ∈ p i := +by simp only [← set_like.mem_coe, finset_inf_coe, set.mem_Inter] + +lemma mem_sup_left {S T : submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T := +show S ≤ S ⊔ T, from le_sup_left + +lemma mem_sup_right {S T : submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T := +show T ≤ S ⊔ T, from le_sup_right + +lemma add_mem_sup {S T : submodule R M} {s t : M} (hs : s ∈ S) (ht : t ∈ T) : s + t ∈ S ⊔ T := +add_mem (mem_sup_left hs) (mem_sup_right ht) + +lemma sub_mem_sup {R' M' : Type*} [ring R'] [add_comm_group M'] [module R' M'] + {S T : submodule R' M'} {s t : M'} (hs : s ∈ S) (ht : t ∈ T) : + s - t ∈ S ⊔ T := +begin + rw sub_eq_add_neg, + exact add_mem_sup hs (neg_mem ht), +end + +lemma mem_supr_of_mem {ι : Sort*} {b : M} {p : ι → submodule R M} (i : ι) (h : b ∈ p i) : + b ∈ (⨆i, p i) := +have p i ≤ (⨆i, p i) := le_supr p i, +@this b h + +open_locale big_operators + +lemma sum_mem_supr {ι : Type*} [fintype ι] {f : ι → M} {p : ι → submodule R M} + (h : ∀ i, f i ∈ p i) : + ∑ i, f i ∈ ⨆ i, p i := +sum_mem $ λ i hi, mem_supr_of_mem i (h i) + +lemma sum_mem_bsupr {ι : Type*} {s : finset ι} {f : ι → M} {p : ι → submodule R M} + (h : ∀ i ∈ s, f i ∈ p i) : + ∑ i in s, f i ∈ ⨆ i ∈ s, p i := +sum_mem $ λ i hi, mem_supr_of_mem i $ mem_supr_of_mem hi (h i hi) + +/-! Note that `submodule.mem_supr` is provided in `linear_algebra/basic.lean`. -/ + +lemma mem_Sup_of_mem {S : set (submodule R M)} {s : submodule R M} + (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S := +show s ≤ Sup S, from le_Sup hs + +theorem disjoint_def {p p' : submodule R M} : + disjoint p p' ↔ ∀ x ∈ p, x ∈ p' → x = (0:M) := +disjoint_iff_inf_le.trans $ show (∀ x, x ∈ p ∧ x ∈ p' → x ∈ ({0} : set M)) ↔ _, by simp + +theorem disjoint_def' {p p' : submodule R M} : + disjoint p p' ↔ ∀ (x ∈ p) (y ∈ p'), x = y → x = (0:M) := +disjoint_def.trans ⟨λ h x hx y hy hxy, h x hx $ hxy.symm ▸ hy, + λ h x hx hx', h _ hx x hx' rfl⟩ + +lemma eq_zero_of_coe_mem_of_disjoint (hpq : disjoint p q) {a : p} (ha : (a : M) ∈ q) : + a = 0 := +by exact_mod_cast disjoint_def.mp hpq a (coe_mem a) ha + +end submodule + +section nat_submodule + +/-- An additive submonoid is equivalent to a ℕ-submodule. -/ +def add_submonoid.to_nat_submodule : add_submonoid M ≃o submodule ℕ M := +{ to_fun := λ S, + { smul_mem' := λ r s hs, show r • s ∈ S, from nsmul_mem hs _, ..S }, + inv_fun := submodule.to_add_submonoid, + left_inv := λ ⟨S, _, _⟩, rfl, + right_inv := λ ⟨S, _, _, _⟩, rfl, + map_rel_iff' := λ a b, iff.rfl } + +@[simp] +lemma add_submonoid.to_nat_submodule_symm : + ⇑(add_submonoid.to_nat_submodule.symm : _ ≃o add_submonoid M) = submodule.to_add_submonoid := rfl + +@[simp] +lemma add_submonoid.coe_to_nat_submodule (S : add_submonoid M) : + (S.to_nat_submodule : set M) = S := rfl + +@[simp] +lemma add_submonoid.to_nat_submodule_to_add_submonoid (S : add_submonoid M) : + S.to_nat_submodule.to_add_submonoid = S := +add_submonoid.to_nat_submodule.symm_apply_apply S + +@[simp] +lemma submodule.to_add_submonoid_to_nat_submodule (S : submodule ℕ M) : + S.to_add_submonoid.to_nat_submodule = S := +add_submonoid.to_nat_submodule.apply_symm_apply S + +end nat_submodule + +end add_comm_monoid + +section int_submodule + +variables [add_comm_group M] + +/-- An additive subgroup is equivalent to a ℤ-submodule. -/ +def add_subgroup.to_int_submodule : add_subgroup M ≃o submodule ℤ M := +{ to_fun := λ S, + { smul_mem' := λ r s hs, S.zsmul_mem hs _, ..S}, + inv_fun := submodule.to_add_subgroup, + left_inv := λ ⟨S, _, _, _⟩, rfl, + right_inv := λ ⟨S, _, _, _⟩, rfl, + map_rel_iff' := λ a b, iff.rfl } + +@[simp] +lemma add_subgroup.to_int_submodule_symm : + ⇑(add_subgroup.to_int_submodule.symm : _ ≃o add_subgroup M) = submodule.to_add_subgroup := rfl + +@[simp] +lemma add_subgroup.coe_to_int_submodule (S : add_subgroup M) : + (S.to_int_submodule : set M) = S := rfl + +@[simp] +lemma add_subgroup.to_int_submodule_to_add_subgroup (S : add_subgroup M) : + S.to_int_submodule.to_add_subgroup = S := +add_subgroup.to_int_submodule.symm_apply_apply S + +@[simp] +lemma submodule.to_add_subgroup_to_int_submodule (S : submodule ℤ M) : + S.to_add_subgroup.to_int_submodule = S := +add_subgroup.to_int_submodule.apply_symm_apply S + +end int_submodule diff --git a/src/algebra/module/submodule/pointwise.lean b/src/algebra/module/submodule/pointwise.lean new file mode 100644 index 0000000000000..bc4be0638ac43 --- /dev/null +++ b/src/algebra/module/submodule/pointwise.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2021 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import group_theory.subgroup.pointwise +import linear_algebra.span + +/-! # Pointwise instances on `submodule`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides: + +* `submodule.has_pointwise_neg` + +and the actions + +* `submodule.pointwise_distrib_mul_action` +* `submodule.pointwise_mul_action_with_zero` + +which matches the action of `mul_action_set`. + +These actions are available in the `pointwise` locale. + +## Implementation notes + +Most of the lemmas in this file are direct copies of lemmas from +`group_theory/submonoid/pointwise.lean`. +-/ + +variables {α : Type*} {R : Type*} {M : Type*} + +open_locale pointwise + +namespace submodule + +section neg + +section semiring +variables [semiring R] [add_comm_group M] [module R M] + +/-- The submodule with every element negated. Note if `R` is a ring and not just a semiring, this +is a no-op, as shown by `submodule.neg_eq_self`. + +Recall that When `R` is the semiring corresponding to the nonnegative elements of `R'`, +`submodule R' M` is the type of cones of `M`. This instance reflects such cones about `0`. + +This is available as an instance in the `pointwise` locale. -/ +protected def has_pointwise_neg : has_neg (submodule R M) := +{ neg := λ p, + { carrier := -(p : set M), + smul_mem' := λ r m hm, set.mem_neg.2 $ smul_neg r m ▸ p.smul_mem r $ set.mem_neg.1 hm, + ..(- p.to_add_submonoid) } } + +localized "attribute [instance] submodule.has_pointwise_neg" in pointwise +open_locale pointwise + +@[simp] lemma coe_set_neg (S : submodule R M) : ↑(-S) = -(S : set M) := rfl + +@[simp] lemma neg_to_add_submonoid (S : submodule R M) : + (-S).to_add_submonoid = -S.to_add_submonoid := rfl + +@[simp] lemma mem_neg {g : M} {S : submodule R M} : g ∈ -S ↔ -g ∈ S := iff.rfl + +/-- `submodule.has_pointwise_neg` is involutive. + +This is available as an instance in the `pointwise` locale. -/ +protected def has_involutive_pointwise_neg : has_involutive_neg (submodule R M) := +{ neg := has_neg.neg, + neg_neg := λ S, set_like.coe_injective $ neg_neg _ } + +localized "attribute [instance] submodule.has_involutive_pointwise_neg" in pointwise + +@[simp] lemma neg_le_neg (S T : submodule R M) : -S ≤ -T ↔ S ≤ T := +set_like.coe_subset_coe.symm.trans set.neg_subset_neg + +lemma neg_le (S T : submodule R M) : -S ≤ T ↔ S ≤ -T := +set_like.coe_subset_coe.symm.trans set.neg_subset + +/-- `submodule.has_pointwise_neg` as an order isomorphism. -/ +def neg_order_iso : submodule R M ≃o submodule R M := +{ to_equiv := equiv.neg _, + map_rel_iff' := neg_le_neg } + +lemma closure_neg (s : set M) : span R (-s) = -(span R s) := +begin + apply le_antisymm, + { rw [span_le, coe_set_neg, ←set.neg_subset, neg_neg], + exact subset_span }, + { rw [neg_le, span_le, coe_set_neg, ←set.neg_subset], + exact subset_span } +end + +@[simp] +lemma neg_inf (S T : submodule R M) : -(S ⊓ T) = (-S) ⊓ (-T) := +set_like.coe_injective set.inter_neg + +@[simp] +lemma neg_sup (S T : submodule R M) : -(S ⊔ T) = (-S) ⊔ (-T) := +(neg_order_iso : submodule R M ≃o submodule R M).map_sup S T + +@[simp] +lemma neg_bot : -(⊥ : submodule R M) = ⊥ := +set_like.coe_injective $ (set.neg_singleton 0).trans $ congr_arg _ neg_zero + +@[simp] +lemma neg_top : -(⊤ : submodule R M) = ⊤ := +set_like.coe_injective $ set.neg_univ + +@[simp] +lemma neg_infi {ι : Sort*} (S : ι → submodule R M) : -(⨅ i, S i) = ⨅ i, -S i := +(neg_order_iso : submodule R M ≃o submodule R M).map_infi _ + +@[simp] +lemma neg_supr {ι : Sort*} (S : ι → submodule R M) : -(⨆ i, S i) = ⨆ i, -(S i) := +(neg_order_iso : submodule R M ≃o submodule R M).map_supr _ + +end semiring + +open_locale pointwise + +@[simp] lemma neg_eq_self [ring R] [add_comm_group M] [module R M] (p : submodule R M) : -p = p := +ext $ λ _, p.neg_mem_iff + +end neg + +variables [semiring R] [add_comm_monoid M] [module R M] + +instance pointwise_add_comm_monoid : add_comm_monoid (submodule R M) := +{ add := (⊔), + add_assoc := λ _ _ _, sup_assoc, + zero := ⊥, + zero_add := λ _, bot_sup_eq, + add_zero := λ _, sup_bot_eq, + add_comm := λ _ _, sup_comm } + +@[simp] lemma add_eq_sup (p q : submodule R M) : p + q = p ⊔ q := rfl +@[simp] lemma zero_eq_bot : (0 : submodule R M) = ⊥ := rfl + +instance : canonically_ordered_add_monoid (submodule R M) := +{ zero := 0, + bot := ⊥, + add := (+), + add_le_add_left := λ a b, sup_le_sup_left, + exists_add_of_le := λ a b h, ⟨b, (sup_eq_right.2 h).symm⟩, + le_self_add := λ a b, le_sup_left, + ..submodule.pointwise_add_comm_monoid, + ..submodule.complete_lattice } + +section +variables [monoid α] [distrib_mul_action α M] [smul_comm_class α R M] + +/-- The action on a submodule corresponding to applying the action to every element. + +This is available as an instance in the `pointwise` locale. -/ +protected def pointwise_distrib_mul_action : distrib_mul_action α (submodule R M) := +{ smul := λ a S, S.map (distrib_mul_action.to_linear_map R M a : M →ₗ[R] M), + one_smul := λ S, + (congr_arg (λ f : module.End R M, S.map f) (linear_map.ext $ by exact one_smul α)).trans + S.map_id, + mul_smul := λ a₁ a₂ S, + (congr_arg (λ f : module.End R M, S.map f) (linear_map.ext $ by exact mul_smul _ _)).trans + (S.map_comp _ _), + smul_zero := λ a, map_bot _, + smul_add := λ a S₁ S₂, map_sup _ _ _ } + +localized "attribute [instance] submodule.pointwise_distrib_mul_action" in pointwise +open_locale pointwise + +@[simp] lemma coe_pointwise_smul (a : α) (S : submodule R M) : ↑(a • S) = a • (S : set M) := rfl + +@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : submodule R M) : + (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl + +@[simp] lemma pointwise_smul_to_add_subgroup {R M : Type*} + [ring R] [add_comm_group M] [distrib_mul_action α M] [module R M] [smul_comm_class α R M] + (a : α) (S : submodule R M) : + (a • S).to_add_subgroup = a • S.to_add_subgroup := rfl + +lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submodule R M) : m ∈ S → a • m ∈ a • S := +(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M)) + +/-- See also `submodule.smul_bot`. -/ +@[simp] lemma smul_bot' (a : α) : a • (⊥ : submodule R M) = ⊥ := map_bot _ +/-- See also `submodule.smul_sup`. -/ +lemma smul_sup' (a : α) (S T : submodule R M) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _ +lemma smul_span (a : α) (s : set M) : a • span R s = span R (a • s) := map_span _ _ +lemma span_smul (a : α) (s : set M) : span R (a • s) = a • span R s := eq.symm (span_image _).symm + +instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ M] [smul_comm_class αᵐᵒᵖ R M] + [is_central_scalar α M] : + is_central_scalar α (submodule R M) := +⟨λ a S, congr_arg (λ f : module.End R M, S.map f) $ linear_map.ext $ by exact op_smul_eq_smul _⟩ + +@[simp] lemma smul_le_self_of_tower {α : Type*} + [semiring α] [module α R] [module α M] [smul_comm_class α R M] [is_scalar_tower α R M] + (a : α) (S : submodule R M) : a • S ≤ S := +begin + rintro y ⟨x, hx, rfl⟩, + exact smul_of_tower_mem _ a hx, +end + +end + +section +variables [semiring α] [module α M] [smul_comm_class α R M] +/-- The action on a submodule corresponding to applying the action to every element. + +This is available as an instance in the `pointwise` locale. + +This is a stronger version of `submodule.pointwise_distrib_mul_action`. Note that `add_smul` does +not hold so this cannot be stated as a `module`. -/ +protected def pointwise_mul_action_with_zero : mul_action_with_zero α (submodule R M) := +{ zero_smul := λ S, + (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact zero_smul α)).trans S.map_zero, + .. submodule.pointwise_distrib_mul_action } + +localized "attribute [instance] submodule.pointwise_mul_action_with_zero" in pointwise + +end + +end submodule diff --git a/src/algebra/module/submodule_lattice.lean b/src/algebra/module/submodule_lattice.lean deleted file mode 100644 index 2a424b500e5d0..0000000000000 --- a/src/algebra/module/submodule_lattice.lean +++ /dev/null @@ -1,318 +0,0 @@ -/- -Copyright (c) 2017 Johannes Hölzl. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov --/ -import algebra.module.submodule -import algebra.punit_instances - -/-! -# The lattice structure on `submodule`s - -This file defines the lattice structure on submodules, `submodule.complete_lattice`, with `⊥` -defined as `{0}` and `⊓` defined as intersection of the underlying carrier. -If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`. - -Many results about operations on this lattice structure are defined in `linear_algebra/basic.lean`, -most notably those which use `span`. - -## Implementation notes - -This structure should match the `add_submonoid.complete_lattice` structure, and we should try -to unify the APIs where possible. - --/ - -variables {R S M : Type*} - -section add_comm_monoid -variables [semiring R] [semiring S] [add_comm_monoid M] [module R M] [module S M] -variables [has_scalar S R] [is_scalar_tower S R M] -variables {p q : submodule R M} - -namespace submodule - -/-- The set `{0}` is the bottom element of the lattice of submodules. -/ -instance : has_bot (submodule R M) := -⟨{ carrier := {0}, smul_mem' := by simp { contextual := tt }, .. (⊥ : add_submonoid M)}⟩ - -instance inhabited' : inhabited (submodule R M) := ⟨⊥⟩ - -@[simp] lemma bot_coe : ((⊥ : submodule R M) : set M) = {0} := rfl -@[simp] lemma bot_to_add_submonoid : (⊥ : submodule R M).to_add_submonoid = ⊥ := rfl - -section -variables (R) -@[simp] lemma restrict_scalars_bot : restrict_scalars S (⊥ : submodule R M) = ⊥ := rfl - -@[simp] lemma mem_bot {x : M} : x ∈ (⊥ : submodule R M) ↔ x = 0 := set.mem_singleton_iff -end - -@[simp] lemma restrict_scalars_eq_bot_iff {p : submodule R M} : - restrict_scalars S p = ⊥ ↔ p = ⊥ := -by simp [set_like.ext_iff] - -instance unique_bot : unique (⊥ : submodule R M) := -⟨infer_instance, λ x, subtype.ext $ (mem_bot R).1 x.mem⟩ - -instance : order_bot (submodule R M) := -{ bot := ⊥, - bot_le := λ p x, by simp [zero_mem] {contextual := tt} } - -protected lemma eq_bot_iff (p : submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) := -⟨ λ h, h.symm ▸ λ x hx, (mem_bot R).mp hx, - λ h, eq_bot_iff.mpr (λ x hx, (mem_bot R).mpr (h x hx)) ⟩ - -@[ext] protected lemma bot_ext (x y : (⊥ : submodule R M)) : x = y := -begin - rcases x with ⟨x, xm⟩, rcases y with ⟨y, ym⟩, congr, - rw (submodule.eq_bot_iff _).mp rfl x xm, - rw (submodule.eq_bot_iff _).mp rfl y ym, -end - -protected lemma ne_bot_iff (p : submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) := -by { haveI := classical.prop_decidable, simp_rw [ne.def, p.eq_bot_iff, not_forall] } - -lemma nonzero_mem_of_bot_lt {p : submodule R M} (bot_lt : ⊥ < p) : ∃ a : p, a ≠ 0 := -let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp bot_lt.ne' in ⟨⟨b, hb₁⟩, hb₂ ∘ (congr_arg coe)⟩ - -lemma exists_mem_ne_zero_of_ne_bot {p : submodule R M} (h : p ≠ ⊥) : ∃ b : M, b ∈ p ∧ b ≠ 0 := -let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp h in ⟨b, hb₁, hb₂⟩ - -/-- The bottom submodule is linearly equivalent to punit as an `R`-module. -/ -@[simps] def bot_equiv_punit : (⊥ : submodule R M) ≃ₗ[R] punit := -{ to_fun := λ x, punit.star, - inv_fun := λ x, 0, - map_add' := by { intros, ext, }, - map_smul' := by { intros, ext, }, - left_inv := by { intro x, ext, }, - right_inv := by { intro x, ext, }, } - -lemma eq_bot_of_subsingleton (p : submodule R M) [subsingleton p] : p = ⊥ := -begin - rw eq_bot_iff, - intros v hv, - exact congr_arg coe (subsingleton.elim (⟨v, hv⟩ : p) 0) -end - -/-- The universal set is the top element of the lattice of submodules. -/ -instance : has_top (submodule R M) := -⟨{ carrier := set.univ, smul_mem' := λ _ _ _, trivial, .. (⊤ : add_submonoid M)}⟩ - -@[simp] lemma top_coe : ((⊤ : submodule R M) : set M) = set.univ := rfl - -@[simp] lemma top_to_add_submonoid : (⊤ : submodule R M).to_add_submonoid = ⊤ := rfl - -@[simp] lemma mem_top {x : M} : x ∈ (⊤ : submodule R M) := trivial - -section -variables (R) -@[simp] lemma restrict_scalars_top : restrict_scalars S (⊤ : submodule R M) = ⊤ := rfl -end - -@[simp] lemma restrict_scalars_eq_top_iff {p : submodule R M} : - restrict_scalars S p = ⊤ ↔ p = ⊤ := -by simp [set_like.ext_iff] - -instance : order_top (submodule R M) := -{ top := ⊤, - le_top := λ p x _, trivial } - -lemma eq_top_iff' {p : submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p := -eq_top_iff.trans ⟨λ h x, h trivial, λ h x _, h x⟩ - -/-- The top submodule is linearly equivalent to the module. - -This is the module version of `add_submonoid.top_equiv`. -/ -@[simps] def top_equiv : (⊤ : submodule R M) ≃ₗ[R] M := -{ to_fun := λ x, x, - inv_fun := λ x, ⟨x, by simp⟩, - map_add' := by { intros, refl, }, - map_smul' := by { intros, refl, }, - left_inv := by { intro x, ext, refl, }, - right_inv := by { intro x, refl, }, } - -instance : has_Inf (submodule R M) := -⟨λ S, -{ carrier := ⋂ s ∈ S, (s : set M), - zero_mem' := by simp [zero_mem], - add_mem' := by simp [add_mem] {contextual := tt}, - smul_mem' := by simp [smul_mem] {contextual := tt} }⟩ - -private lemma Inf_le' {S : set (submodule R M)} {p} : p ∈ S → Inf S ≤ p := -set.bInter_subset_of_mem - -private lemma le_Inf' {S : set (submodule R M)} {p} : (∀q ∈ S, p ≤ q) → p ≤ Inf S := -set.subset_Inter₂ - -instance : has_inf (submodule R M) := -⟨λ p q, -{ carrier := p ∩ q, - zero_mem' := by simp [zero_mem], - add_mem' := by simp [add_mem] {contextual := tt}, - smul_mem' := by simp [smul_mem] {contextual := tt} }⟩ - -instance : complete_lattice (submodule R M) := -{ sup := λ a b, Inf {x | a ≤ x ∧ b ≤ x}, - le_sup_left := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, ha, - le_sup_right := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, hb, - sup_le := λ a b c h₁ h₂, Inf_le' ⟨h₁, h₂⟩, - inf := (⊓), - le_inf := λ a b c, set.subset_inter, - inf_le_left := λ a b, set.inter_subset_left _ _, - inf_le_right := λ a b, set.inter_subset_right _ _, - Sup := λtt, Inf {t | ∀t'∈tt, t' ≤ t}, - le_Sup := λ s p hs, le_Inf' $ λ q hq, hq _ hs, - Sup_le := λ s p hs, Inf_le' hs, - Inf := Inf, - le_Inf := λ s a, le_Inf', - Inf_le := λ s a, Inf_le', - ..submodule.order_top, - ..submodule.order_bot, - ..set_like.partial_order } - -@[simp] theorem inf_coe : ↑(p ⊓ q) = (p ∩ q : set M) := rfl - -@[simp] theorem mem_inf {p q : submodule R M} {x : M} : - x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q := iff.rfl - -@[simp] theorem Inf_coe (P : set (submodule R M)) : (↑(Inf P) : set M) = ⋂ p ∈ P, ↑p := rfl - -@[simp] theorem finset_inf_coe {ι} (s : finset ι) (p : ι → submodule R M) : - (↑(s.inf p) : set M) = ⋂ i ∈ s, ↑(p i) := -begin - letI := classical.dec_eq ι, - refine s.induction_on _ (λ i s hi ih, _), - { simp }, - { rw [finset.inf_insert, inf_coe, ih], - simp }, -end - -@[simp] theorem infi_coe {ι} (p : ι → submodule R M) : - (↑⨅ i, p i : set M) = ⋂ i, ↑(p i) := -by rw [infi, Inf_coe]; ext a; simp; exact -⟨λ h i, h _ i rfl, λ h i x e, e ▸ h _⟩ - -@[simp] lemma mem_Inf {S : set (submodule R M)} {x : M} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := -set.mem_Inter₂ - -@[simp] theorem mem_infi {ι} (p : ι → submodule R M) {x} : - x ∈ (⨅ i, p i) ↔ ∀ i, x ∈ p i := -by rw [← set_like.mem_coe, infi_coe, set.mem_Inter]; refl - -@[simp] theorem mem_finset_inf {ι} {s : finset ι} {p : ι → submodule R M} {x : M} : - x ∈ s.inf p ↔ ∀ i ∈ s, x ∈ p i := -by simp only [← set_like.mem_coe, finset_inf_coe, set.mem_Inter] - -lemma mem_sup_left {S T : submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T := -show S ≤ S ⊔ T, from le_sup_left - -lemma mem_sup_right {S T : submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T := -show T ≤ S ⊔ T, from le_sup_right - -lemma add_mem_sup {S T : submodule R M} {s t : M} (hs : s ∈ S) (ht : t ∈ T) : s + t ∈ S ⊔ T := -add_mem (mem_sup_left hs) (mem_sup_right ht) - -lemma mem_supr_of_mem {ι : Sort*} {b : M} {p : ι → submodule R M} (i : ι) (h : b ∈ p i) : - b ∈ (⨆i, p i) := -have p i ≤ (⨆i, p i) := le_supr p i, -@this b h - -open_locale big_operators - -lemma sum_mem_supr {ι : Type*} [fintype ι] {f : ι → M} {p : ι → submodule R M} - (h : ∀ i, f i ∈ p i) : - ∑ i, f i ∈ ⨆ i, p i := -sum_mem $ λ i hi, mem_supr_of_mem i (h i) - -lemma sum_mem_bsupr {ι : Type*} {s : finset ι} {f : ι → M} {p : ι → submodule R M} - (h : ∀ i ∈ s, f i ∈ p i) : - ∑ i in s, f i ∈ ⨆ i ∈ s, p i := -sum_mem $ λ i hi, mem_supr_of_mem i $ mem_supr_of_mem hi (h i hi) - -/-! Note that `submodule.mem_supr` is provided in `linear_algebra/basic.lean`. -/ - -lemma mem_Sup_of_mem {S : set (submodule R M)} {s : submodule R M} - (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S := -show s ≤ Sup S, from le_Sup hs - -theorem disjoint_def {p p' : submodule R M} : - disjoint p p' ↔ ∀ x ∈ p, x ∈ p' → x = (0:M) := -show (∀ x, x ∈ p ∧ x ∈ p' → x ∈ ({0} : set M)) ↔ _, by simp - -theorem disjoint_def' {p p' : submodule R M} : - disjoint p p' ↔ ∀ (x ∈ p) (y ∈ p'), x = y → x = (0:M) := -disjoint_def.trans ⟨λ h x hx y hy hxy, h x hx $ hxy.symm ▸ hy, - λ h x hx hx', h _ hx x hx' rfl⟩ - -lemma eq_zero_of_coe_mem_of_disjoint (hpq : disjoint p q) {a : p} (ha : (a : M) ∈ q) : - a = 0 := -by exact_mod_cast disjoint_def.mp hpq a (coe_mem a) ha - -end submodule - -section nat_submodule - -/-- An additive submonoid is equivalent to a ℕ-submodule. -/ -def add_submonoid.to_nat_submodule : add_submonoid M ≃o submodule ℕ M := -{ to_fun := λ S, - { smul_mem' := λ r s hs, show r • s ∈ S, from nsmul_mem hs _, ..S }, - inv_fun := submodule.to_add_submonoid, - left_inv := λ ⟨S, _, _⟩, rfl, - right_inv := λ ⟨S, _, _, _⟩, rfl, - map_rel_iff' := λ a b, iff.rfl } - -@[simp] -lemma add_submonoid.to_nat_submodule_symm : - ⇑(add_submonoid.to_nat_submodule.symm : _ ≃o add_submonoid M) = submodule.to_add_submonoid := rfl - -@[simp] -lemma add_submonoid.coe_to_nat_submodule (S : add_submonoid M) : - (S.to_nat_submodule : set M) = S := rfl - -@[simp] -lemma add_submonoid.to_nat_submodule_to_add_submonoid (S : add_submonoid M) : - S.to_nat_submodule.to_add_submonoid = S := -add_submonoid.to_nat_submodule.symm_apply_apply S - -@[simp] -lemma submodule.to_add_submonoid_to_nat_submodule (S : submodule ℕ M) : - S.to_add_submonoid.to_nat_submodule = S := -add_submonoid.to_nat_submodule.apply_symm_apply S - -end nat_submodule - -end add_comm_monoid - -section int_submodule - -variables [add_comm_group M] - -/-- An additive subgroup is equivalent to a ℤ-submodule. -/ -def add_subgroup.to_int_submodule : add_subgroup M ≃o submodule ℤ M := -{ to_fun := λ S, - { smul_mem' := λ r s hs, S.zsmul_mem hs _, ..S}, - inv_fun := submodule.to_add_subgroup, - left_inv := λ ⟨S, _, _, _⟩, rfl, - right_inv := λ ⟨S, _, _, _⟩, rfl, - map_rel_iff' := λ a b, iff.rfl } - -@[simp] -lemma add_subgroup.to_int_submodule_symm : - ⇑(add_subgroup.to_int_submodule.symm : _ ≃o add_subgroup M) = submodule.to_add_subgroup := rfl - -@[simp] -lemma add_subgroup.coe_to_int_submodule (S : add_subgroup M) : - (S.to_int_submodule : set M) = S := rfl - -@[simp] -lemma add_subgroup.to_int_submodule_to_add_subgroup (S : add_subgroup M) : - S.to_int_submodule.to_add_subgroup = S := -add_subgroup.to_int_submodule.symm_apply_apply S - -@[simp] -lemma submodule.to_add_subgroup_to_int_submodule (S : submodule ℤ M) : - S.to_add_subgroup.to_int_submodule = S := -add_subgroup.to_int_submodule.apply_symm_apply S - -end int_submodule diff --git a/src/algebra/module/submodule_pointwise.lean b/src/algebra/module/submodule_pointwise.lean deleted file mode 100644 index a435d5e19af33..0000000000000 --- a/src/algebra/module/submodule_pointwise.lean +++ /dev/null @@ -1,203 +0,0 @@ -/- -Copyright (c) 2021 Eric Wieser. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Eric Wieser --/ -import group_theory.subgroup.pointwise -import linear_algebra.span - -/-! # Pointwise instances on `submodule`s - -This file provides: - -* `submodule.has_pointwise_neg` - -and the actions - -* `submodule.pointwise_distrib_mul_action` -* `submodule.pointwise_mul_action_with_zero` - -which matches the action of `mul_action_set`. - -These actions are available in the `pointwise` locale. - -## Implementation notes - -Most of the lemmas in this file are direct copies of lemmas from -`group_theory/submonoid/pointwise.lean`. --/ - -variables {α : Type*} {R : Type*} {M : Type*} - -open_locale pointwise - -namespace submodule - -section neg - -section semiring -variables [semiring R] [add_comm_group M] [module R M] - -/-- The submodule with every element negated. Note if `R` is a ring and not just a semiring, this -is a no-op, as shown by `submodule.neg_eq_self`. - -Recall that When `R` is the semiring corresponding to the nonnegative elements of `R'`, -`submodule R' M` is the type of cones of `M`. This instance reflects such cones about `0`. - -This is available as an instance in the `pointwise` locale. -/ -protected def has_pointwise_neg : has_neg (submodule R M) := -{ neg := λ p, - { carrier := -(p : set M), - smul_mem' := λ r m hm, set.mem_neg.2 $ smul_neg r m ▸ p.smul_mem r $ set.mem_neg.1 hm, - ..(- p.to_add_submonoid) } } - -localized "attribute [instance] submodule.has_pointwise_neg" in pointwise -open_locale pointwise - -@[simp] lemma coe_set_neg (S : submodule R M) : ↑(-S) = -(S : set M) := rfl - -@[simp] lemma neg_to_add_submonoid (S : submodule R M) : - (-S).to_add_submonoid = -S.to_add_submonoid := rfl - -@[simp] lemma mem_neg {g : M} {S : submodule R M} : g ∈ -S ↔ -g ∈ S := iff.rfl - -/-- `submodule.has_pointwise_neg` is involutive. - -This is available as an instance in the `pointwise` locale. -/ -protected def has_involutive_pointwise_neg : has_involutive_neg (submodule R M) := -{ neg := has_neg.neg, - neg_neg := λ S, set_like.coe_injective $ neg_neg _ } - -localized "attribute [instance] submodule.has_involutive_pointwise_neg" in pointwise - -@[simp] lemma neg_le_neg (S T : submodule R M) : -S ≤ -T ↔ S ≤ T := -set_like.coe_subset_coe.symm.trans set.neg_subset_neg - -lemma neg_le (S T : submodule R M) : -S ≤ T ↔ S ≤ -T := -set_like.coe_subset_coe.symm.trans set.neg_subset - -/-- `submodule.has_pointwise_neg` as an order isomorphism. -/ -def neg_order_iso : submodule R M ≃o submodule R M := -{ to_equiv := equiv.neg _, - map_rel_iff' := neg_le_neg } - -lemma closure_neg (s : set M) : span R (-s) = -(span R s) := -begin - apply le_antisymm, - { rw [span_le, coe_set_neg, ←set.neg_subset, neg_neg], - exact subset_span }, - { rw [neg_le, span_le, coe_set_neg, ←set.neg_subset], - exact subset_span } -end - -@[simp] -lemma neg_inf (S T : submodule R M) : -(S ⊓ T) = (-S) ⊓ (-T) := -set_like.coe_injective set.inter_neg - -@[simp] -lemma neg_sup (S T : submodule R M) : -(S ⊔ T) = (-S) ⊔ (-T) := -(neg_order_iso : submodule R M ≃o submodule R M).map_sup S T - -@[simp] -lemma neg_bot : -(⊥ : submodule R M) = ⊥ := -set_like.coe_injective $ (set.neg_singleton 0).trans $ congr_arg _ neg_zero - -@[simp] -lemma neg_top : -(⊤ : submodule R M) = ⊤ := -set_like.coe_injective $ set.neg_univ - -@[simp] -lemma neg_infi {ι : Sort*} (S : ι → submodule R M) : -(⨅ i, S i) = ⨅ i, -S i := -(neg_order_iso : submodule R M ≃o submodule R M).map_infi _ - -@[simp] -lemma neg_supr {ι : Sort*} (S : ι → submodule R M) : -(⨆ i, S i) = ⨆ i, -(S i) := -(neg_order_iso : submodule R M ≃o submodule R M).map_supr _ - -end semiring - -open_locale pointwise - -@[simp] lemma neg_eq_self [ring R] [add_comm_group M] [module R M] (p : submodule R M) : -p = p := -ext $ λ _, p.neg_mem_iff - -end neg - -variables [semiring R] [add_comm_monoid M] [module R M] - -instance pointwise_add_comm_monoid : add_comm_monoid (submodule R M) := -{ add := (⊔), - add_assoc := λ _ _ _, sup_assoc, - zero := ⊥, - zero_add := λ _, bot_sup_eq, - add_zero := λ _, sup_bot_eq, - add_comm := λ _ _, sup_comm } - -@[simp] lemma add_eq_sup (p q : submodule R M) : p + q = p ⊔ q := rfl -@[simp] lemma zero_eq_bot : (0 : submodule R M) = ⊥ := rfl - -section -variables [monoid α] [distrib_mul_action α M] [smul_comm_class α R M] - -/-- The action on a submodule corresponding to applying the action to every element. - -This is available as an instance in the `pointwise` locale. -/ -protected def pointwise_distrib_mul_action : distrib_mul_action α (submodule R M) := -{ smul := λ a S, S.map (distrib_mul_action.to_linear_map _ _ a), - one_smul := λ S, - (congr_arg (λ f, S.map f) (linear_map.ext $ by exact one_smul α)).trans S.map_id, - mul_smul := λ a₁ a₂ S, - (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact mul_smul _ _)).trans - (S.map_comp _ _), - smul_zero := λ a, map_bot _, - smul_add := λ a S₁ S₂, map_sup _ _ _ } - -localized "attribute [instance] submodule.pointwise_distrib_mul_action" in pointwise -open_locale pointwise - -@[simp] lemma coe_pointwise_smul (a : α) (S : submodule R M) : ↑(a • S) = a • (S : set M) := rfl - -@[simp] lemma pointwise_smul_to_add_submonoid (a : α) (S : submodule R M) : - (a • S).to_add_submonoid = a • S.to_add_submonoid := rfl - -@[simp] lemma pointwise_smul_to_add_subgroup {R M : Type*} - [ring R] [add_comm_group M] [distrib_mul_action α M] [module R M] [smul_comm_class α R M] - (a : α) (S : submodule R M) : - (a • S).to_add_subgroup = a • S.to_add_subgroup := rfl - -lemma smul_mem_pointwise_smul (m : M) (a : α) (S : submodule R M) : m ∈ S → a • m ∈ a • S := -(set.smul_mem_smul_set : _ → _ ∈ a • (S : set M)) - -instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ M] [smul_comm_class αᵐᵒᵖ R M] - [is_central_scalar α M] : - is_central_scalar α (submodule R M) := -⟨λ a S, congr_arg (λ f, S.map f) $ linear_map.ext $ by exact op_smul_eq_smul _⟩ - -@[simp] lemma smul_le_self_of_tower {α : Type*} - [semiring α] [module α R] [module α M] [smul_comm_class α R M] [is_scalar_tower α R M] - (a : α) (S : submodule R M) : a • S ≤ S := -begin - rintro y ⟨x, hx, rfl⟩, - exact smul_of_tower_mem _ a hx, -end - -end - -section -variables [semiring α] [module α M] [smul_comm_class α R M] -/-- The action on a submodule corresponding to applying the action to every element. - -This is available as an instance in the `pointwise` locale. - -This is a stronger version of `submodule.pointwise_distrib_mul_action`. Note that `add_smul` does -not hold so this cannot be stated as a `module`. -/ -protected def pointwise_mul_action_with_zero : mul_action_with_zero α (submodule R M) := -{ zero_smul := λ S, - (congr_arg (λ f : M →ₗ[R] M, S.map f) (linear_map.ext $ by exact zero_smul α)).trans S.map_zero, - .. submodule.pointwise_distrib_mul_action } - -localized "attribute [instance] submodule.pointwise_mul_action_with_zero" in pointwise - -end - -end submodule diff --git a/src/algebra/module/torsion.lean b/src/algebra/module/torsion.lean index aac753fdcdd60..fae52a8083c44 100644 --- a/src/algebra/module/torsion.lean +++ b/src/algebra/module/torsion.lean @@ -3,18 +3,19 @@ Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Pierre-Alexandre Bazin -/ -import algebra.module -import linear_algebra.quotient -import ring_theory.ideal.quotient -import ring_theory.non_zero_divisors import algebra.direct_sum.module -import group_theory.torsion +import algebra.module.big_operators import linear_algebra.isomorphisms import group_theory.torsion +import ring_theory.coprime.ideal +import ring_theory.finiteness /-! # Torsion submodules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `torsion_of R M x` : the torsion ideal of `x`, containing all `a` such that `a • x = 0`. @@ -39,8 +40,9 @@ import group_theory.torsion * `torsion_by_set_eq_torsion_by_span` : torsion by a set is torsion by the ideal generated by it. * `submodule.torsion_by_is_torsion_by` : the `a`-torsion submodule is a `a`-torsion module. Similar lemmas for `torsion'` and `torsion`. -* `submodule.torsion_is_internal` : a `∏ i, p i`-torsion module is the internal direct sum of its - `p i`-torsion submodules when the `p i` are pairwise coprime. +* `submodule.torsion_by_is_internal` : a `∏ i, p i`-torsion module is the internal direct sum of its + `p i`-torsion submodules when the `p i` are pairwise coprime. A more general version with coprime + ideals is `submodule.torsion_by_set_is_internal`. * `submodule.no_zero_smul_divisors_iff_torsion_bot` : a module over a domain has `no_zero_smul_divisors` (that is, there is no non-zero `a`, `x` such that `a • x = 0`) iff its torsion submodule is trivial. @@ -60,14 +62,64 @@ import group_theory.torsion Torsion, submodule, module, quotient -/ -section +namespace ideal + +section torsion_of + variables (R M : Type*) [semiring R] [add_comm_monoid M] [module R M] + /--The torsion ideal of `x`, containing all `a` such that `a • x = 0`.-/ @[simps] def torsion_of (x : M) : ideal R := (linear_map.to_span_singleton R M x).ker + +@[simp] lemma torsion_of_zero : torsion_of R M (0 : M) = ⊤ := by simp [torsion_of] + variables {R M} + @[simp] lemma mem_torsion_of_iff (x : M) (a : R) : a ∈ torsion_of R M x ↔ a • x = 0 := iff.rfl + +variables (R) + +@[simp] lemma torsion_of_eq_top_iff (m : M) : torsion_of R M m = ⊤ ↔ m = 0 := +begin + refine ⟨λ h, _, λ h, by simp [h]⟩, + rw [← one_smul R m, ← mem_torsion_of_iff m (1 : R), h], + exact submodule.mem_top, +end + +@[simp] lemma torsion_of_eq_bot_iff_of_no_zero_smul_divisors + [nontrivial R] [no_zero_smul_divisors R M] (m : M) : + torsion_of R M m = ⊥ ↔ m ≠ 0 := +begin + refine ⟨λ h contra, _, λ h, (submodule.eq_bot_iff _).mpr $ λ r hr, _⟩, + { rw [contra, torsion_of_zero] at h, + exact bot_ne_top.symm h, }, + { rw [mem_torsion_of_iff, smul_eq_zero] at hr, + tauto, }, end +/-- See also `complete_lattice.independent.linear_independent` which provides the same conclusion +but requires the stronger hypothesis `no_zero_smul_divisors R M`. -/ +lemma complete_lattice.independent.linear_independent' {ι R M : Type*} {v : ι → M} + [ring R] [add_comm_group M] [module R M] + (hv : complete_lattice.independent $ λ i, (R ∙ v i)) + (h_ne_zero : ∀ i, ideal.torsion_of R M (v i) = ⊥) : + linear_independent R v := +begin + refine linear_independent_iff_not_smul_mem_span.mpr (λ i r hi, _), + replace hv := complete_lattice.independent_def.mp hv i, + simp only [supr_subtype', ← submodule.span_range_eq_supr, disjoint_iff] at hv, + have : r • v i ∈ ⊥, + { rw [← hv, submodule.mem_inf], + refine ⟨submodule.mem_span_singleton.mpr ⟨r, rfl⟩, _⟩, + convert hi, + ext, + simp, }, + rw [← submodule.mem_bot R, ← h_ne_zero i], + simpa using this, +end + +end torsion_of + section variables (R M : Type*) [ring R] [add_comm_group M] [module R M] /--The span of `x` in `M` is isomorphic to `R` quotiented by the torsion ideal of `x`.-/ @@ -76,10 +128,12 @@ noncomputable def quot_torsion_of_equiv_span_singleton (x : M) : (linear_map.to_span_singleton R M x).quot_ker_equiv_range.trans $ linear_equiv.of_eq _ _ (linear_map.span_singleton_eq_range R M x).symm +variables {R M} @[simp] lemma quot_torsion_of_equiv_span_singleton_apply_mk (x : M) (a : R) : quot_torsion_of_equiv_span_singleton R M x (submodule.quotient.mk a) = a • ⟨x, submodule.mem_span_singleton_self x⟩ := rfl end +end ideal open_locale non_zero_divisors @@ -91,7 +145,7 @@ namespace submodule /-- The `a`-torsion submodule for `a` in `R`, containing all elements `x` of `M` such that `a • x = 0`. -/ -@[simps] def torsion_by (a : R) : submodule R M := (distrib_mul_action.to_linear_map _ _ a).ker +@[simps] def torsion_by (a : R) : submodule R M := (distrib_mul_action.to_linear_map R M a).ker /-- The submodule containing all elements `x` of `M` such that `a • x = 0` for all `a` in `s`. -/ @[simps] def torsion_by_set (s : set R) : submodule R M := Inf (torsion_by R M '' s) @@ -111,6 +165,7 @@ namespace submodule /-- The torsion submodule, containing all elements `x` of `M` such that `a • x = 0` for some non-zero-divisor `a` in `R`. -/ @[reducible] def torsion := torsion' R M R⁰ + end submodule namespace module @@ -122,7 +177,7 @@ namespace module @[reducible] def is_torsion_by_set (s : set R) := ∀ ⦃x : M⦄ ⦃a : s⦄, (a : R) • x = 0 /-- A `S`-torsion module is a module where every element is `a`-torsion for some `a` in `S`. -/ -@[reducible] def is_torsion' (S : Type*) [has_scalar S M] := ∀ ⦃x : M⦄, ∃ a : S, a • x = 0 +@[reducible] def is_torsion' (S : Type*) [has_smul S M] := ∀ ⦃x : M⦄, ∃ a : S, a • x = 0 /-- A torsion module is a module where every element is `a`-torsion for some non-zero-divisor `a`. -/ @@ -134,12 +189,11 @@ end defs variables {R M : Type*} -namespace submodule - -open module - +section variables [comm_semiring R] [add_comm_monoid M] [module R M] (s : set R) (a : R) +namespace submodule + @[simp] lemma smul_torsion_by (x : torsion_by R M a) : a • x = 0 := subtype.ext x.prop @[simp] lemma smul_coe_torsion_by (x : torsion_by R M a) : a • (x : M) = 0 := x.prop @[simp] lemma mem_torsion_by_iff (x : M) : x ∈ torsion_by R M a ↔ a • x = 0 := iff.rfl @@ -157,33 +211,6 @@ begin simp only [mem_torsion_by_set_iff, set_coe.forall, subtype.coe_mk, set.mem_singleton_iff, forall_eq, mem_torsion_by_iff] end -@[simp] lemma is_torsion_by_singleton_iff : is_torsion_by_set R M {a} ↔ is_torsion_by R M a := -begin - refine ⟨λ h x, @h _ ⟨_, set.mem_singleton _⟩, λ h x, _⟩, - rintro ⟨b, rfl : b = a⟩, exact @h _ -end - -lemma is_torsion_by_set_iff_torsion_by_set_eq_top : - is_torsion_by_set R M s ↔ torsion_by_set R M s = ⊤ := -⟨λ h, eq_top_iff.mpr (λ _ _, (mem_torsion_by_set_iff _ _).mpr $ @h _), - λ h x, by { rw [← mem_torsion_by_set_iff, h], trivial }⟩ - -/-- A `a`-torsion module is a module whose `a`-torsion submodule is the full space. -/ -lemma is_torsion_by_iff_torsion_by_eq_top : is_torsion_by R M a ↔ torsion_by R M a = ⊤ := -by rw [← torsion_by_singleton_eq, ← is_torsion_by_singleton_iff, - is_torsion_by_set_iff_torsion_by_set_eq_top] - -lemma torsion_by_set_is_torsion_by_set : is_torsion_by_set R (torsion_by_set R M s) s := -λ ⟨x, hx⟩ a, subtype.ext $ (mem_torsion_by_set_iff _ _).mp hx a - -/-- The `a`-torsion submodule is a `a`-torsion module. -/ -lemma torsion_by_is_torsion_by : is_torsion_by R (torsion_by R M a) a := λ _, smul_torsion_by _ _ - -@[simp] lemma torsion_by_torsion_by_eq_top : torsion_by R (torsion_by R M a) a = ⊤ := -(is_torsion_by_iff_torsion_by_eq_top a).mp $ torsion_by_is_torsion_by a -@[simp] lemma torsion_by_set_torsion_by_set_eq_top : - torsion_by_set R (torsion_by_set R M s) s = ⊤ := -(is_torsion_by_set_iff_torsion_by_set_eq_top s).mp $ torsion_by_set_is_torsion_by_set s lemma torsion_by_set_le_torsion_by_set_of_subset {s t : set R} (st : s ⊆ t) : torsion_by_set R M t ≤ torsion_by_set R M s := @@ -195,19 +222,13 @@ lemma torsion_by_set_eq_torsion_by_span : begin refine le_antisymm (λ x hx, _) (torsion_by_set_le_torsion_by_set_of_subset subset_span), rw mem_torsion_by_set_iff at hx ⊢, - suffices : ideal.span s ≤ torsion_of R M x, + suffices : ideal.span s ≤ ideal.torsion_of R M x, { rintro ⟨a, ha⟩, exact this ha }, rw ideal.span_le, exact λ a ha, hx ⟨a, ha⟩ end -lemma is_torsion_by_set_iff_is_torsion_by_span : - is_torsion_by_set R M s ↔ is_torsion_by_set R M (ideal.span s) := -by rw [is_torsion_by_set_iff_torsion_by_set_eq_top, is_torsion_by_set_iff_torsion_by_set_eq_top, - torsion_by_set_eq_torsion_by_span] lemma torsion_by_span_singleton_eq : torsion_by_set R M (R ∙ a) = torsion_by R M a := ((torsion_by_set_eq_torsion_by_span _).symm.trans $ torsion_by_singleton_eq _) -lemma is_torsion_by_span_singleton_iff : is_torsion_by_set R M (R ∙ a) ↔ is_torsion_by R M a := -((is_torsion_by_set_iff_is_torsion_by_span _).symm.trans $ is_torsion_by_singleton_iff _) lemma torsion_by_le_torsion_by_of_dvd (a b : R) (dvd : a ∣ b) : torsion_by R M a ≤ torsion_by R M b := @@ -223,77 +244,154 @@ eq_bot_iff.mpr (λ _ h, by { rw [mem_torsion_by_iff, one_smul] at h, exact h }) by { rw [eq_bot_iff, ← torsion_by_one, ← torsion_by_singleton_eq], exact torsion_by_set_le_torsion_by_set_of_subset (λ _ _, trivial) } +end submodule +open submodule +namespace module + +@[simp] lemma is_torsion_by_singleton_iff : is_torsion_by_set R M {a} ↔ is_torsion_by R M a := +begin + refine ⟨λ h x, @h _ ⟨_, set.mem_singleton _⟩, λ h x, _⟩, + rintro ⟨b, rfl : b = a⟩, exact @h _ +end + +lemma is_torsion_by_set_iff_torsion_by_set_eq_top : + is_torsion_by_set R M s ↔ submodule.torsion_by_set R M s = ⊤ := +⟨λ h, eq_top_iff.mpr (λ _ _, (mem_torsion_by_set_iff _ _).mpr $ @h _), + λ h x, by { rw [← mem_torsion_by_set_iff, h], trivial }⟩ + +/-- A `a`-torsion module is a module whose `a`-torsion submodule is the full space. -/ +lemma is_torsion_by_iff_torsion_by_eq_top : is_torsion_by R M a ↔ torsion_by R M a = ⊤ := +by rw [← torsion_by_singleton_eq, ← is_torsion_by_singleton_iff, + is_torsion_by_set_iff_torsion_by_set_eq_top] + +lemma is_torsion_by_set_iff_is_torsion_by_span : + is_torsion_by_set R M s ↔ is_torsion_by_set R M (ideal.span s) := +by rw [is_torsion_by_set_iff_torsion_by_set_eq_top, is_torsion_by_set_iff_torsion_by_set_eq_top, + torsion_by_set_eq_torsion_by_span] + +lemma is_torsion_by_span_singleton_iff : is_torsion_by_set R M (R ∙ a) ↔ is_torsion_by R M a := +((is_torsion_by_set_iff_is_torsion_by_span _).symm.trans $ is_torsion_by_singleton_iff _) + +end module +namespace submodule +open module + +lemma torsion_by_set_is_torsion_by_set : is_torsion_by_set R (torsion_by_set R M s) s := +λ ⟨x, hx⟩ a, subtype.ext $ (mem_torsion_by_set_iff _ _).mp hx a + +/-- The `a`-torsion submodule is a `a`-torsion module. -/ +lemma torsion_by_is_torsion_by : is_torsion_by R (torsion_by R M a) a := λ _, smul_torsion_by _ _ + +@[simp] lemma torsion_by_torsion_by_eq_top : torsion_by R (torsion_by R M a) a = ⊤ := +(is_torsion_by_iff_torsion_by_eq_top a).mp $ torsion_by_is_torsion_by a +@[simp] lemma torsion_by_set_torsion_by_set_eq_top : + torsion_by_set R (torsion_by_set R M s) s = ⊤ := +(is_torsion_by_set_iff_torsion_by_set_eq_top s).mp $ torsion_by_set_is_torsion_by_set s + +variables (R M) +lemma torsion_gc : @galois_connection (submodule R M) (ideal R)ᵒᵈ _ _ + annihilator (λ I, torsion_by_set R M $ I.of_dual) := +λ A I, ⟨λ h x hx, (mem_torsion_by_set_iff _ _).mpr $ λ ⟨a, ha⟩, mem_annihilator.mp (h ha) x hx, + λ h a ha, mem_annihilator.mpr $ λ x hx, (mem_torsion_by_set_iff _ _).mp (h hx) ⟨a, ha⟩⟩ + +variables {R M} section coprime open_locale big_operators -open dfinsupp -variables {ι : Type*} {p : ι → R} {S : finset ι} (hp : pairwise (is_coprime on λ s : S, p s)) +variables {ι : Type*} {p : ι → ideal R} {S : finset ι} +variables (hp : (S : set ι).pairwise $ λ i j, p i ⊔ p j = ⊤) include hp -lemma supr_torsion_by_eq_torsion_by_prod : - (⨆ i : S, torsion_by R M (p i)) = torsion_by R M (∏ i in S, p i) := +lemma supr_torsion_by_ideal_eq_torsion_by_infi : + (⨆ i ∈ S, torsion_by_set R M $ p i) = torsion_by_set R M ↑(⨅ i ∈ S, p i) := begin cases S.eq_empty_or_nonempty with h h, - { rw [h, finset.prod_empty, torsion_by_one], - convert supr_of_empty _, exact subtype.is_empty_false }, + { rw h, convert supr_emptyset, convert torsion_by_univ, convert top_coe, exact infi_emptyset }, apply le_antisymm, - { apply supr_le _, rintro ⟨i, is⟩, - exact torsion_by_le_torsion_by_of_dvd _ _ (finset.dvd_prod_of_mem p is) }, - { intros x hx, classical, rw mem_supr_iff_exists_dfinsupp', - cases (exists_sum_eq_one_iff_pairwise_coprime h).mpr hp with f hf, - use equiv_fun_on_fintype.inv_fun (λ i, ⟨(f i * ∏ j in S \ {i}, p j) • x, begin - obtain ⟨i, is⟩ := i, - change p i • (f i * ∏ j in S \ {i}, _) • _ = _, change _ • _ = _ at hx, - rw [smul_smul, mul_comm, mul_assoc, mul_smul, ← finset.prod_eq_prod_diff_singleton_mul is, - hx, smul_zero] - end⟩), - simp only [equiv.inv_fun_as_coe, sum_eq_sum_fintype, coe_eq_zero, eq_self_iff_true, - implies_true_iff, finset.univ_eq_attach, equiv_fun_on_fintype_apply], - change ∑ i : S, ((f i * ∏ j in S \ {i}, p j) • x) = x, - have : ∑ i : S, _ = _ := S.sum_finset_coe (λ i, f i * ∏ j in S \ {i}, p j), - rw [← finset.sum_smul, this, hf, one_smul] } + { apply supr_le _, intro i, apply supr_le _, intro is, + apply torsion_by_set_le_torsion_by_set_of_subset, + exact (infi_le (λ i, ⨅ (H : i ∈ S), p i) i).trans (infi_le _ is), }, + { intros x hx, + rw mem_supr_finset_iff_exists_sum, + obtain ⟨μ, hμ⟩ := (mem_supr_finset_iff_exists_sum _ _).mp + ((ideal.eq_top_iff_one _).mp $ (ideal.supr_infi_eq_top_iff_pairwise h _).mpr hp), + refine ⟨λ i, ⟨(μ i : R) • x, _⟩, _⟩, + { rw mem_torsion_by_set_iff at hx ⊢, + rintro ⟨a, ha⟩, rw smul_smul, + suffices : a * μ i ∈ ⨅ i ∈ S, p i, from hx ⟨_, this⟩, + rw mem_infi, intro j, rw mem_infi, intro hj, + by_cases ij : j = i, + { rw ij, exact ideal.mul_mem_right _ _ ha }, + { have := coe_mem (μ i), simp only [mem_infi] at this, + exact ideal.mul_mem_left _ _ (this j hj ij) } }, + { simp_rw coe_mk, rw [← finset.sum_smul, hμ, one_smul] } } end -lemma torsion_by_independent : complete_lattice.independent (λ i : S, torsion_by R M (p i)) := -λ i, begin - classical, - dsimp, rw [disjoint_iff, eq_bot_iff], intros x hx, - rw submodule.mem_inf at hx, obtain ⟨hxi, hxj⟩ := hx, - have hxi : p i • x = 0 := hxi, - rw mem_supr_iff_exists_dfinsupp' at hxj, cases hxj with f hf, - obtain ⟨b, c, h1⟩ := pairwise_coprime_iff_coprime_prod.mp hp i i.2, - rw [mem_bot, ← one_smul _ x, ← h1, add_smul], - convert (zero_add (0:M)), - { rw [mul_smul, hxi, smul_zero] }, - { rw [← hf, smul_sum, sum_eq_zero], - intro j, by_cases ji : j = i, - { convert smul_zero _, - rw ← mem_bot _, convert coe_mem (f j), - symmetry, rw supr_eq_bot, intro hj', - exfalso, exact hj' ji }, - { have hj' : ↑j ∈ S \ {i}, - { rw finset.mem_sdiff, refine ⟨j.2, λ hj', ji _⟩, ext, rw ← finset.mem_singleton, exact hj' }, - rw [finset.prod_eq_prod_diff_singleton_mul hj', ← mul_assoc, mul_smul], - have : (⨆ (H : ¬j = i), torsion_by R M (p j)) ≤ torsion_by R M (p j) := supr_const_le, - have : _ • _ = _ := this (coe_mem _), - rw [this, smul_zero] } } +lemma sup_indep_torsion_by_ideal : S.sup_indep (λ i, torsion_by_set R M $ p i) := +λ T hT i hi hiT, begin + rw [disjoint_iff, finset.sup_eq_supr, + supr_torsion_by_ideal_eq_torsion_by_infi $ λ i hi j hj ij, hp (hT hi) (hT hj) ij], + have := @galois_connection.u_inf _ _ (order_dual.to_dual _) (order_dual.to_dual _) _ _ _ _ + (torsion_gc R M), dsimp at this ⊢, + rw [← this, ideal.sup_infi_eq_top, top_coe, torsion_by_univ], + intros j hj, apply hp hi (hT hj), rintro rfl, exact hiT hj end + +omit hp +variables {q : ι → R} (hq : (S : set ι).pairwise $ is_coprime on q) +include hq + +lemma supr_torsion_by_eq_torsion_by_prod : + (⨆ i ∈ S, torsion_by R M $ q i) = torsion_by R M (∏ i in S, q i) := +begin + rw [← torsion_by_span_singleton_eq, ideal.submodule_span_eq, + ← ideal.finset_inf_span_singleton _ _ hq, finset.inf_eq_infi, + ← supr_torsion_by_ideal_eq_torsion_by_infi], + { congr, ext : 1, congr, ext : 1, exact (torsion_by_span_singleton_eq _).symm }, + { exact λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime _ _).mpr (hq hi hj ij), } +end + +lemma sup_indep_torsion_by : S.sup_indep (λ i, torsion_by R M $ q i) := +begin + convert sup_indep_torsion_by_ideal + (λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime (q i) _).mpr $ hq hi hj ij), + ext : 1, exact (torsion_by_span_singleton_eq _).symm, +end + end coprime end submodule +end section needs_group variables [comm_ring R] [add_comm_group M] [module R M] namespace submodule open_locale big_operators -variables {ι : Type*} {p : ι → R} {S : finset ι} (hp : pairwise (is_coprime on λ s : S, p s)) -include hp +variables {ι : Type*} [decidable_eq ι] {S : finset ι} -/--If the `p i` are pairwise coprime, a `∏ i, p i`-torsion module is the internal direct sum of +/--If the `p i` are pairwise coprime, a `⨅ i, p i`-torsion module is the internal direct sum of its `p i`-torsion submodules.-/ -lemma torsion_is_internal [decidable_eq ι] (hM : torsion_by R M (∏ i in S, p i) = ⊤) : - direct_sum.submodule_is_internal (λ i : S, torsion_by R M (p i)) := -direct_sum.submodule_is_internal_of_independent_of_supr_eq_top - (torsion_by_independent hp) (by { rw ← hM, exact supr_torsion_by_eq_torsion_by_prod hp}) +lemma torsion_by_set_is_internal {p : ι → ideal R} + (hp : (S : set ι).pairwise $ λ i j, p i ⊔ p j = ⊤) + (hM : module.is_torsion_by_set R M (⨅ i ∈ S, p i : ideal R)) : + direct_sum.is_internal (λ i : S, torsion_by_set R M $ p i) := +direct_sum.is_internal_submodule_of_independent_of_supr_eq_top + (complete_lattice.independent_iff_sup_indep.mpr $ sup_indep_torsion_by_ideal hp) + ((supr_subtype'' ↑S $ λ i, torsion_by_set R M $ p i).trans $ + (supr_torsion_by_ideal_eq_torsion_by_infi hp).trans $ + (module.is_torsion_by_set_iff_torsion_by_set_eq_top _).mp hM) + +/--If the `q i` are pairwise coprime, a `∏ i, q i`-torsion module is the internal direct sum of +its `q i`-torsion submodules.-/ +lemma torsion_by_is_internal {q : ι → R} (hq : (S : set ι).pairwise $ is_coprime on q) + (hM : module.is_torsion_by R M $ ∏ i in S, q i) : + direct_sum.is_internal (λ i : S, torsion_by R M $ q i) := +begin + rw [← module.is_torsion_by_span_singleton_iff, ideal.submodule_span_eq, + ← ideal.finset_inf_span_singleton _ _ hq, finset.inf_eq_infi] at hM, + convert torsion_by_set_is_internal + (λ i hi j hj ij, (ideal.sup_eq_top_iff_is_coprime (q i) _).mpr $ hq hi hj ij) hM, + ext : 1, exact (torsion_by_span_singleton_eq _).symm, +end end submodule @@ -302,22 +400,36 @@ variables {I : ideal R} (hM : is_torsion_by_set R M I) include hM /-- can't be an instance because hM can't be inferred -/ -def is_torsion_by_set.has_scalar : has_scalar (R ⧸ I) M := +def is_torsion_by_set.has_smul : has_smul (R ⧸ I) M := { smul := λ b x, quotient.lift_on' b (• x) $ λ b₁ b₂ h, begin show b₁ • x = b₂ • x, - have : (-b₁ + b₂) • x = 0 := @hM x ⟨_, h⟩, + have : (-b₁ + b₂) • x = 0 := @hM x ⟨_, quotient_add_group.left_rel_apply.mp h⟩, rw [add_smul, neg_smul, neg_add_eq_zero] at this, exact this end } @[simp] lemma is_torsion_by_set.mk_smul (b : R) (x : M) : - by haveI := hM.has_scalar; exact ideal.quotient.mk I b • x = b • x := rfl + by haveI := hM.has_smul; exact ideal.quotient.mk I b • x = b • x := rfl /-- A `(R ⧸ I)`-module is a `R`-module which `is_torsion_by_set R M I`. -/ def is_torsion_by_set.module : module (R ⧸ I) M := -@function.surjective.module_left _ _ _ _ _ _ _ hM.has_scalar +@function.surjective.module_left _ _ _ _ _ _ _ hM.has_smul _ ideal.quotient.mk_surjective (is_torsion_by_set.mk_smul hM) +instance is_torsion_by_set.is_scalar_tower {S : Type*} [has_smul S R] [has_smul S M] + [is_scalar_tower S R M] [is_scalar_tower S R R] : + @@is_scalar_tower S (R ⧸ I) M _ (is_torsion_by_set.module hM).to_has_smul _ := +{ smul_assoc := λ b d x, quotient.induction_on' d $ λ c, (smul_assoc b c x : _) } + +omit hM + +instance : module (R ⧸ I) (M ⧸ I • (⊤ : submodule R M)) := +is_torsion_by_set.module (λ x r, begin + induction x using quotient.induction_on, + refine (submodule.quotient.mk_eq_zero _).mpr (submodule.smul_mem_smul r.prop _), + trivial, +end) + end module namespace submodule @@ -328,23 +440,23 @@ module.is_torsion_by_set.module $ torsion_by_set_is_torsion_by_set I @[simp] lemma torsion_by_set.mk_smul (I : ideal R) (b : R) (x : torsion_by_set R M I) : ideal.quotient.mk I b • x = b • x := rfl -instance (I : ideal R) {S : Type*} [has_scalar S R] [has_scalar S M] +instance (I : ideal R) {S : Type*} [has_smul S R] [has_smul S M] [is_scalar_tower S R M] [is_scalar_tower S R R] : is_scalar_tower S (R ⧸ I) (torsion_by_set R M I) := -{ smul_assoc := λ b d x, quotient.induction_on' d $ λ c, (smul_assoc b c x : _) } +infer_instance /-- The `a`-torsion submodule as a `(R ⧸ R∙a)`-module. -/ instance (a : R) : module (R ⧸ R ∙ a) (torsion_by R M a) := module.is_torsion_by_set.module $ - (is_torsion_by_span_singleton_iff a).mpr $ torsion_by_is_torsion_by a + (module.is_torsion_by_span_singleton_iff a).mpr $ torsion_by_is_torsion_by a @[simp] lemma torsion_by.mk_smul (a b : R) (x : torsion_by R M a) : ideal.quotient.mk (R ∙ a) b • x = b • x := rfl -instance (a : R) {S : Type*} [has_scalar S R] [has_scalar S M] +instance (a : R) {S : Type*} [has_smul S R] [has_smul S M] [is_scalar_tower S R M] [is_scalar_tower S R R] : is_scalar_tower S (R ⧸ R ∙ a) (torsion_by R M a) := -{ smul_assoc := λ b d x, quotient.induction_on' d $ λ c, (smul_assoc b c x : _) } +infer_instance end submodule end needs_group @@ -359,7 +471,7 @@ variables (S : Type*) [comm_monoid S] [distrib_mul_action S M] [smul_comm_class @[simp] lemma mem_torsion'_iff (x : M) : x ∈ torsion' R M S ↔ ∃ a : S, a • x = 0 := iff.rfl @[simp] lemma mem_torsion_iff (x : M) : x ∈ torsion R M ↔ ∃ a : R⁰, a • x = 0 := iff.rfl -@[simps] instance : has_scalar S (torsion' R M S) := +@[simps] instance : has_smul S (torsion' R M S) := ⟨λ s x, ⟨s • x, by { obtain ⟨x, a, h⟩ := x, use a, dsimp, rw [smul_comm, h, smul_zero] }⟩⟩ instance : distrib_mul_action S (torsion' R M S) := subtype.coe_injective.distrib_mul_action ((torsion' R M S).subtype).to_add_monoid_hom (λ (c : S) x, rfl) @@ -381,16 +493,34 @@ torsion module. -/ /-- The torsion submodule is always a torsion module. -/ lemma torsion_is_torsion : module.is_torsion R (torsion R M) := torsion'_is_torsion' R⁰ - -lemma is_torsion'_powers_iff (p : R) : - is_torsion' M (submonoid.powers p) ↔ ∀ x : M, ∃ n : ℕ, p ^ n • x = 0 := -⟨λ h x, let ⟨⟨a, ⟨n, rfl⟩⟩, hx⟩ := @h x in ⟨n, hx⟩, -λ h x, let ⟨n, hn⟩ := h x in ⟨⟨_, ⟨n, rfl⟩⟩, hn⟩⟩ - end torsion' section torsion -variables [comm_semiring R] [add_comm_monoid M] [module R M] [no_zero_divisors R] [nontrivial R] +variables [comm_semiring R] [add_comm_monoid M] [module R M] +open_locale big_operators + +variables (R M) + +lemma _root_.module.is_torsion_by_set_annihilator_top : + module.is_torsion_by_set R M (⊤ : submodule R M).annihilator := +λ x ha, mem_annihilator.mp ha.prop x mem_top + +variables {R M} + +lemma _root_.submodule.annihilator_top_inter_non_zero_divisors [module.finite R M] + (hM : module.is_torsion R M) : + ((⊤ : submodule R M).annihilator : set R) ∩ R⁰ ≠ ∅:= +begin + obtain ⟨S, hS⟩ := ‹module.finite R M›.out, + refine set.nonempty.ne_empty ⟨_, _, (∏ x in S, (@hM x).some : R⁰).prop⟩, + rw [submonoid.coe_finset_prod, set_like.mem_coe, ←hS, mem_annihilator_span], + intro n, + letI := classical.dec_eq M, + rw [←finset.prod_erase_mul _ _ n.prop, mul_smul, ←submonoid.smul_def, (@hM n).some_spec, + smul_zero], +end + +variables [no_zero_divisors R] [nontrivial R] lemma coe_torsion_eq_annihilator_ne_bot : (torsion R M : set M) = { x : M | (R ∙ x).annihilator ≠ ⊥ } := @@ -438,6 +568,45 @@ instance no_zero_smul_divisors [is_domain R] : no_zero_smul_divisors R (M ⧸ to no_zero_smul_divisors_iff_torsion_eq_bot.mpr torsion_eq_bot end quotient_torsion + +section p_torsion +open module +section +variables [monoid R] [add_comm_monoid M] [distrib_mul_action R M] + +lemma is_torsion'_powers_iff (p : R) : + is_torsion' M (submonoid.powers p) ↔ ∀ x : M, ∃ n : ℕ, p ^ n • x = 0 := +⟨λ h x, let ⟨⟨a, ⟨n, rfl⟩⟩, hx⟩ := @h x in ⟨n, hx⟩, +λ h x, let ⟨n, hn⟩ := h x in ⟨⟨_, ⟨n, rfl⟩⟩, hn⟩⟩ + +/--In a `p ^ ∞`-torsion module (that is, a module where all elements are cancelled by scalar +multiplication by some power of `p`), the smallest `n` such that `p ^ n • x = 0`.-/ +def p_order {p : R} (hM : is_torsion' M $ submonoid.powers p) (x : M) + [Π n : ℕ, decidable (p ^ n • x = 0)] := +nat.find $ (is_torsion'_powers_iff p).mp hM x +@[simp] lemma pow_p_order_smul {p : R} (hM : is_torsion' M $ submonoid.powers p) (x : M) + [Π n : ℕ, decidable (p ^ n • x = 0)] : p ^ p_order hM x • x = 0 := +nat.find_spec $ (is_torsion'_powers_iff p).mp hM x + +end +variables [comm_semiring R] [add_comm_monoid M] [module R M] [Π x : M, decidable (x = 0)] + +lemma exists_is_torsion_by {p : R} (hM : is_torsion' M $ submonoid.powers p) + (d : ℕ) (hd : d ≠ 0) (s : fin d → M) (hs : span R (set.range s) = ⊤) : + ∃ j : fin d, module.is_torsion_by R M (p ^ p_order hM (s j)) := +begin + let oj := list.argmax (λ i, p_order hM $ s i) (list.fin_range d), + have hoj : oj.is_some := (option.ne_none_iff_is_some.mp $ + λ eq_none, hd $ list.fin_range_eq_nil.mp $ list.argmax_eq_none.mp eq_none), + use option.get hoj, + rw [is_torsion_by_iff_torsion_by_eq_top, eq_top_iff, ← hs, submodule.span_le, + set.range_subset_iff], intro i, change _ • _ = _, + have : p_order hM (s i) ≤ p_order hM (s $ option.get hoj) := + list.le_of_mem_argmax (list.mem_fin_range i) (option.get_mem hoj), + rw [← nat.sub_add_cancel this, pow_add, mul_smul, pow_p_order_smul, smul_zero] +end + +end p_torsion end submodule namespace ideal.quotient diff --git a/src/algebra/module/ulift.lean b/src/algebra/module/ulift.lean index c75da83edbf52..cb9655b89cc93 100644 --- a/src/algebra/module/ulift.lean +++ b/src/algebra/module/ulift.lean @@ -9,6 +9,9 @@ import algebra.module.equiv /-! # `ulift` instances for module and multiplicative actions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for module, mul_action and related structures on `ulift` types. (Recall `ulift α` is just a "copy" of a type `α` in a higher universe.) @@ -23,54 +26,69 @@ variable {R : Type u} variable {M : Type v} variable {N : Type w} -instance has_scalar_left [has_scalar R M] : - has_scalar (ulift R) M := +@[to_additive] +instance has_smul_left [has_smul R M] : + has_smul (ulift R) M := ⟨λ s x, s.down • x⟩ -@[simp] lemma smul_down [has_scalar R M] (s : ulift R) (x : M) : (s • x) = s.down • x := rfl - -@[simp] -lemma smul_down' [has_scalar R M] (s : R) (x : ulift M) : - (s • x).down = s • x.down := -rfl +@[simp, to_additive] +lemma smul_def [has_smul R M] (s : ulift R) (x : M) : s • x = s.down • x := rfl -instance is_scalar_tower [has_scalar R M] [has_scalar M N] [has_scalar R N] +instance is_scalar_tower [has_smul R M] [has_smul M N] [has_smul R N] [is_scalar_tower R M N] : is_scalar_tower (ulift R) M N := ⟨λ x y z, show (x.down • y) • z = x.down • y • z, from smul_assoc _ _ _⟩ -instance is_scalar_tower' [has_scalar R M] [has_scalar M N] [has_scalar R N] +instance is_scalar_tower' [has_smul R M] [has_smul M N] [has_smul R N] [is_scalar_tower R M N] : is_scalar_tower R (ulift M) N := ⟨λ x y z, show (x • y.down) • z = x • y.down • z, from smul_assoc _ _ _⟩ -instance is_scalar_tower'' [has_scalar R M] [has_scalar M N] [has_scalar R N] +instance is_scalar_tower'' [has_smul R M] [has_smul M N] [has_smul R N] [is_scalar_tower R M N] : is_scalar_tower R M (ulift N) := ⟨λ x y z, show up ((x • y) • z.down) = ⟨x • y • z.down⟩, by rw smul_assoc⟩ -instance [has_scalar R M] [has_scalar Rᵐᵒᵖ M] [is_central_scalar R M] : +instance [has_smul R M] [has_smul Rᵐᵒᵖ M] [is_central_scalar R M] : is_central_scalar R (ulift M) := ⟨λ r m, congr_arg up $ op_smul_eq_smul r m.down⟩ +@[to_additive] instance mul_action [monoid R] [mul_action R M] : mul_action (ulift R) M := { smul := (•), mul_smul := λ _ _, mul_smul _ _, one_smul := one_smul _ } +@[to_additive] instance mul_action' [monoid R] [mul_action R M] : mul_action R (ulift M) := { smul := (•), - mul_smul := λ r s f, by { cases f, ext, simp [mul_smul], }, - one_smul := λ f, by { ext, simp [one_smul], } } + mul_smul := λ r s ⟨f⟩, ext _ _ $ mul_smul _ _ _, + one_smul := λ ⟨f⟩, ext _ _ $ one_smul _ _ } + +instance smul_zero_class [has_zero M] [smul_zero_class R M] : + smul_zero_class (ulift R) M := +{ smul_zero := λ _, smul_zero _, + .. ulift.has_smul_left } + +instance smul_zero_class' [has_zero M] [smul_zero_class R M] : + smul_zero_class R (ulift M) := +{ smul_zero := λ c, by { ext, simp [smul_zero], } } + +instance distrib_smul [add_zero_class M] [distrib_smul R M] : + distrib_smul (ulift R) M := +{ smul_add := λ _, smul_add _ } + +instance distrib_smul' [add_zero_class M] [distrib_smul R M] : + distrib_smul R (ulift M) := +{ smul_add := λ c f g, by { ext, simp [smul_add], } } instance distrib_mul_action [monoid R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action (ulift R) M := -{ smul_zero := λ _, smul_zero _, - smul_add := λ _, smul_add _ } +{ ..ulift.mul_action, + ..ulift.distrib_smul } instance distrib_mul_action' [monoid R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action R (ulift M) := -{ smul_zero := λ c, by { ext, simp [smul_zero], }, - smul_add := λ c f g, by { ext, simp [smul_add], }, - ..ulift.mul_action' } +{ ..ulift.mul_action', + ..ulift.distrib_smul' } instance mul_distrib_mul_action [monoid R] [monoid M] [mul_distrib_mul_action R M] : mul_distrib_mul_action (ulift R) M := @@ -85,13 +103,13 @@ instance mul_distrib_mul_action' [monoid R] [monoid M] [mul_distrib_mul_action R instance smul_with_zero [has_zero R] [has_zero M] [smul_with_zero R M] : smul_with_zero (ulift R) M := -{ smul_zero := λ _, smul_zero' _ _, +{ smul_zero := λ _, smul_zero _, zero_smul := zero_smul _, - ..ulift.has_scalar_left } + ..ulift.has_smul_left } instance smul_with_zero' [has_zero R] [has_zero M] [smul_with_zero R M] : smul_with_zero R (ulift M) := -{ smul_zero := λ _, ulift.ext _ _ $ smul_zero' _ _, +{ smul_zero := λ _, ulift.ext _ _ $ smul_zero _, zero_smul := λ _, ulift.ext _ _ $ zero_smul _ _ } instance mul_action_with_zero [monoid_with_zero R] [has_zero M] [mul_action_with_zero R M] : @@ -113,6 +131,7 @@ instance module' [semiring R] [add_comm_monoid M] [module R M] : module R (ulift /-- The `R`-linear equivalence between `ulift M` and `M`. -/ +@[simps apply symm_apply] def module_equiv [semiring R] [add_comm_monoid M] [module R M] : ulift M ≃ₗ[R] M := { to_fun := ulift.down, inv_fun := ulift.up, diff --git a/src/algebra/module/zlattice.lean b/src/algebra/module/zlattice.lean new file mode 100644 index 0000000000000..cdea3c81502dc --- /dev/null +++ b/src/algebra/module/zlattice.lean @@ -0,0 +1,254 @@ +/- +Copyright (c) 2023 Xavier Roblot. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Xavier Roblot +-/ +import measure_theory.group.fundamental_domain + +/-! +# ℤ-lattices + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `E` be a finite dimensional vector space over a `normed_linear_ordered_field` `K` with a solid +norm and that is also a `floor_ring`, e.g. `ℚ` or `ℝ`. A (full) ℤ-lattice `L` of `E` is a discrete +subgroup of `E` such that `L` spans `E` over `K`. + +The ℤ-lattice `L` can be defined in two ways: +* For `b` a basis of `E`, then `submodule.span ℤ (set.range b)` is a ℤ-lattice of `E`. +* As an `add_subgroup E` with the additional properties: + `∀ r : ℝ, (L ∩ metric.closed_ball 0 r).finite`, that is `L` is discrete + `submodule.span ℝ (L : set E) = ⊤`, that is `L` spans `E` over `K`. + +## Main result +* `zspan.is_add_fundamental_domain`: for a ℤ-lattice `submodule.span ℤ (set.range b)`, proves that +the set defined by `zspan.fundamental_domain` is a fundamental domain. + +-/ + +open_locale big_operators + +noncomputable theory + +namespace zspan + +open measure_theory measurable_set submodule + +variables {E ι : Type*} + +section normed_lattice_field + +variables {K : Type*} [normed_linear_ordered_field K] +variables [normed_add_comm_group E] [normed_space K E] +variables (b : basis ι K E) + +/-- The fundamental domain of the ℤ-lattice spanned by `b`. See `zspan.is_add_fundamental_domain` +for the proof that it is the fundamental domain. -/ +def fundamental_domain : set E := { m | ∀ i, b.repr m i ∈ set.Ico (0 : K) 1 } + +@[simp] +lemma mem_fundamental_domain {m : E} : + m ∈ fundamental_domain b ↔ ∀ i, b.repr m i ∈ set.Ico (0 : K) 1 := iff.rfl + +variables [floor_ring K] + +section fintype + +variable [fintype ι] + +/-- The map that sends a vector of `E` to the element of the ℤ-lattice spanned by `b` obtained +by rounding down its coordinates on the basis `b`. -/ +def floor (m : E) : span ℤ (set.range b) := ∑ i, ⌊b.repr m i⌋ • b.restrict_scalars ℤ i + +/-- The map that sends a vector of `E` to the element of the ℤ-lattice spanned by `b` obtained +by rounding up its coordinates on the basis `b`. -/ +def ceil (m : E) : span ℤ (set.range b) := ∑ i, ⌈b.repr m i⌉ • b.restrict_scalars ℤ i + +@[simp] +lemma repr_floor_apply (m : E) (i : ι) : + b.repr (floor b m) i = ⌊b.repr m i⌋ := +by { classical ; simp only [floor, zsmul_eq_smul_cast K, b.repr.map_smul, finsupp.single_apply, + finset.sum_apply', basis.repr_self, finsupp.smul_single', mul_one, finset.sum_ite_eq', coe_sum, + finset.mem_univ, if_true, coe_smul_of_tower, basis.restrict_scalars_apply, linear_equiv.map_sum] } + +@[simp] +lemma repr_ceil_apply (m : E) (i : ι) : + b.repr (ceil b m) i = ⌈b.repr m i⌉ := +by { classical ; simp only [ceil, zsmul_eq_smul_cast K, b.repr.map_smul, finsupp.single_apply, + finset.sum_apply', basis.repr_self, finsupp.smul_single', mul_one, finset.sum_ite_eq', coe_sum, + finset.mem_univ, if_true, coe_smul_of_tower, basis.restrict_scalars_apply, linear_equiv.map_sum] } + +@[simp] +lemma floor_eq_self_of_mem (m : E) (h : m ∈ span ℤ (set.range b)) : (floor b m : E) = m := +begin + apply b.ext_elem, + simp_rw [repr_floor_apply b], + intro i, + obtain ⟨z, hz⟩ := (b.mem_span_iff_repr_mem ℤ _).mp h i, + rw [← hz], + exact congr_arg (coe : ℤ → K) (int.floor_int_cast z), +end + +@[simp] +lemma ceil_eq_self_of_mem (m : E) (h : m ∈ span ℤ (set.range b)) : (ceil b m : E) = m := +begin + apply b.ext_elem, + simp_rw [repr_ceil_apply b], + intro i, + obtain ⟨z, hz⟩ := (b.mem_span_iff_repr_mem ℤ _).mp h i, + rw [← hz], + exact congr_arg (coe : ℤ → K) (int.ceil_int_cast z), +end + +/-- The map that sends a vector `E` to the fundamental domain of the lattice, +see `zspan.fract_mem_fundamental_domain`. -/ +def fract (m : E) : E := m - floor b m + +lemma fract_apply (m : E) : fract b m = m - floor b m := rfl + +@[simp] +lemma repr_fract_apply (m : E) (i : ι): + b.repr (fract b m) i = int.fract (b.repr m i) := +by rw [fract, map_sub, finsupp.coe_sub, pi.sub_apply, repr_floor_apply, int.fract] + +@[simp] +lemma fract_fract (m : E) : fract b (fract b m) = fract b m := +basis.ext_elem b (λ _, by { classical ; simp only [repr_fract_apply, int.fract_fract] }) + +@[simp] +lemma fract_zspan_add (m : E) {v : E} (h : v ∈ span ℤ (set.range b)) : + fract b (v + m) = fract b m := +begin + classical, + refine (basis.ext_elem_iff b).mpr (λ i, _), + simp_rw [repr_fract_apply, int.fract_eq_fract], + use (b.restrict_scalars ℤ).repr ⟨v, h⟩ i, + rw [map_add, finsupp.coe_add, pi.add_apply, add_tsub_cancel_right, + ← (eq_int_cast (algebra_map ℤ K) _), basis.restrict_scalars_repr_apply, coe_mk], +end + +@[simp] +lemma fract_add_zspan (m : E) {v : E} (h : v ∈ span ℤ (set.range b)) : + fract b (m + v) = fract b m := by { rw [add_comm, fract_zspan_add b m h] } + +variable {b} + +lemma fract_eq_self {x : E} : + fract b x = x ↔ x ∈ fundamental_domain b := +by { classical ; simp only [basis.ext_elem_iff b, repr_fract_apply, int.fract_eq_self, + mem_fundamental_domain, set.mem_Ico] } + +variable (b) + +lemma fract_mem_fundamental_domain (x : E) : + fract b x ∈ fundamental_domain b := fract_eq_self.mp (fract_fract b _) + +lemma fract_eq_fract (m n : E) : + fract b m = fract b n ↔ -m + n ∈ span ℤ (set.range b) := +begin + classical, + rw [eq_comm, basis.ext_elem_iff b], + simp_rw [repr_fract_apply, int.fract_eq_fract, eq_comm, basis.mem_span_iff_repr_mem, + sub_eq_neg_add, map_add, linear_equiv.map_neg, finsupp.coe_add, finsupp.coe_neg, pi.add_apply, + pi.neg_apply, ← (eq_int_cast (algebra_map ℤ K) _), set.mem_range], +end + +lemma norm_fract_le [has_solid_norm K] (m : E) : + ‖fract b m‖ ≤ ∑ i, ‖b i‖ := +begin + classical, + calc + ‖fract b m‖ = ‖∑ i, b.repr (fract b m) i • b i‖ : by rw b.sum_repr + ... = ‖∑ i, int.fract (b.repr m i) • b i‖ : by simp_rw repr_fract_apply + ... ≤ ∑ i, ‖int.fract (b.repr m i) • b i‖ : norm_sum_le _ _ + ... ≤ ∑ i, ‖int.fract (b.repr m i)‖ * ‖b i‖ : by simp_rw norm_smul + ... ≤ ∑ i, ‖b i‖ : finset.sum_le_sum (λ i _, _), + suffices : ‖int.fract (((b.repr) m) i)‖ ≤ 1, + { convert mul_le_mul_of_nonneg_right this (norm_nonneg _ : 0 ≤ ‖b i ‖), + exact (one_mul _).symm, }, + rw (norm_one.symm : 1 = ‖(1 : K)‖), + apply norm_le_norm_of_abs_le_abs, + rw [abs_one, int.abs_fract], + exact le_of_lt (int.fract_lt_one _), +end + +section unique + +variable [unique ι] + +@[simp] lemma coe_floor_self (k : K) : (floor (basis.singleton ι K) k : K) = ⌊k⌋ := +basis.ext_elem _ (λ _, by rw [repr_floor_apply, basis.singleton_repr, basis.singleton_repr]) + +@[simp] lemma coe_fract_self (k : K) : (fract (basis.singleton ι K) k : K) = int.fract k := +basis.ext_elem _ (λ _, by rw [repr_fract_apply, basis.singleton_repr, basis.singleton_repr]) + +end unique + +end fintype + +lemma fundamental_domain_bounded [finite ι] [has_solid_norm K] : + metric.bounded (fundamental_domain b) := +begin + casesI nonempty_fintype ι, + use 2 * ∑ j, ‖b j‖, + intros x hx y hy, + refine le_trans (dist_le_norm_add_norm x y) _, + rw [← fract_eq_self.mpr hx, ← fract_eq_self.mpr hy], + refine (add_le_add (norm_fract_le b x) (norm_fract_le b y)).trans _, + rw ← two_mul, +end + +lemma vadd_mem_fundamental_domain [fintype ι] (y : span ℤ (set.range b)) (x : E) : + y +ᵥ x ∈ fundamental_domain b ↔ y = -floor b x := +by rw [subtype.ext_iff, ← add_right_inj x, add_subgroup_class.coe_neg, ← sub_eq_add_neg, + ← fract_apply, ← fract_zspan_add b _ (subtype.mem y), add_comm, ← vadd_eq_add, ← vadd_def, + eq_comm, ← fract_eq_self] + +lemma exist_unique_vadd_mem_fundamental_domain [finite ι] (x : E) : + ∃! v : span ℤ (set.range b), v +ᵥ x ∈ fundamental_domain b := +begin + casesI nonempty_fintype ι, + refine ⟨-floor b x, _, λ y h, _⟩, + { exact (vadd_mem_fundamental_domain b (-floor b x) x).mpr rfl, }, + { exact (vadd_mem_fundamental_domain b y x).mp h, }, +end + +end normed_lattice_field + +section real + +variables [normed_add_comm_group E] [normed_space ℝ E] +variables (b : basis ι ℝ E) + +@[measurability] +lemma fundamental_domain_measurable_set [measurable_space E] [opens_measurable_space E] + [finite ι] : + measurable_set (fundamental_domain b) := +begin + haveI : finite_dimensional ℝ E := finite_dimensional.of_fintype_basis b, + let f := (finsupp.linear_equiv_fun_on_finite ℝ ℝ ι).to_linear_map.comp b.repr.to_linear_map, + let D : set (ι → ℝ) := set.pi set.univ (λ i : ι, (set.Ico (0 : ℝ) 1)), + rw ( _ : fundamental_domain b = f⁻¹' D), + { refine measurable_set_preimage (linear_map.continuous_of_finite_dimensional f).measurable _, + exact pi set.univ.to_countable (λ (i : ι) (H : i ∈ set.univ), measurable_set_Ico), }, + { ext, + simp only [fundamental_domain, set.mem_set_of_eq, linear_map.coe_comp, + linear_equiv.coe_to_linear_map, set.mem_preimage, function.comp_app, set.mem_univ_pi, + finsupp.linear_equiv_fun_on_finite_apply], }, +end + +/-- For a ℤ-lattice `submodule.span ℤ (set.range b)`, proves that the set defined +by `zspan.fundamental_domain` is a fundamental domain. -/ +protected lemma is_add_fundamental_domain [finite ι] [measurable_space E] + [opens_measurable_space E] (μ : measure E) : + is_add_fundamental_domain (span ℤ (set.range b)).to_add_subgroup (fundamental_domain b) μ := +begin + casesI nonempty_fintype ι, + exact is_add_fundamental_domain.mk' (null_measurable_set (fundamental_domain_measurable_set b)) + (λ x, exist_unique_vadd_mem_fundamental_domain b x), +end + +end real + +end zspan diff --git a/src/algebra/monoid_algebra/basic.lean b/src/algebra/monoid_algebra/basic.lean index f66f0c170473e..b0df6344a58e8 100644 --- a/src/algebra/monoid_algebra/basic.lean +++ b/src/algebra/monoid_algebra/basic.lean @@ -3,13 +3,18 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Yury G. Kudryashov, Scott Morrison -/ +import algebra.algebra.equiv import algebra.big_operators.finsupp import algebra.hom.non_unital_alg +import algebra.module.big_operators import linear_algebra.finsupp /-! # Monoid algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When the domain of a `finsupp` has a multiplicative or additive structure, we can define a convolution product. To mathematicians this structure is known as the "monoid algebra", i.e. the finite formal linear combinations over a given semiring of elements of the monoid. @@ -43,7 +48,7 @@ Similarly, I attempted to just define -/ noncomputable theory -open_locale classical big_operators +open_locale big_operators open finset finsupp @@ -107,11 +112,13 @@ instance : non_unital_non_assoc_semiring (monoid_algebra k G) := { zero := 0, mul := (*), add := (+), - left_distrib := assume f g h, by simp only [mul_def, sum_add_index, mul_add, mul_zero, - single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add], - right_distrib := assume f g h, by simp only [mul_def, sum_add_index, add_mul, zero_mul, - single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero, - sum_add], + left_distrib := assume f g h, by haveI := classical.dec_eq G; + simp only [mul_def, sum_add_index, mul_add, mul_zero, + single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add], + right_distrib := assume f g h, by haveI := classical.dec_eq G; + simp only [mul_def, sum_add_index, add_mul, zero_mul, + single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero, + sum_add], zero_mul := assume f, by simp only [mul_def, sum_zero_index], mul_zero := assume f, by simp only [mul_def, sum_zero_index, sum_zero], .. finsupp.add_comm_monoid } @@ -174,12 +181,17 @@ instance : non_assoc_semiring (monoid_algebra k G) := mul := (*), zero := 0, add := (+), + nat_cast := λ n, single 1 n, + nat_cast_zero := by simp [nat.cast], + nat_cast_succ := λ _, by simp [nat.cast]; refl, one_mul := assume f, by simp only [mul_def, one_def, sum_single_index, zero_mul, single_zero, sum_zero, zero_add, one_mul, sum_single], mul_one := assume f, by simp only [mul_def, one_def, sum_single_index, mul_zero, single_zero, sum_zero, add_zero, mul_one, sum_single], ..monoid_algebra.non_unital_non_assoc_semiring } +lemma nat_cast_def (n : ℕ) : (n : monoid_algebra k G) = single 1 n := rfl + end mul_one_class /-! #### Semiring structure -/ @@ -241,11 +253,16 @@ instance [ring k] [semigroup G] : non_unital_ring (monoid_algebra k G) := .. monoid_algebra.non_unital_semiring } instance [ring k] [mul_one_class G] : non_assoc_ring (monoid_algebra k G) := -{ .. monoid_algebra.add_comm_group, +{ int_cast := λ z, single 1 (z : k), + int_cast_of_nat := λ n, by simpa, + int_cast_neg_succ_of_nat := λ n, by simpa, + .. monoid_algebra.add_comm_group, .. monoid_algebra.non_assoc_semiring } +lemma int_cast_def [ring k] [mul_one_class G] (z : ℤ) : (z : monoid_algebra k G) = single 1 z := rfl + instance [ring k] [monoid G] : ring (monoid_algebra k G) := -{ .. monoid_algebra.non_unital_non_assoc_ring, +{ .. monoid_algebra.non_assoc_ring, .. monoid_algebra.semiring } instance [comm_ring k] [comm_semigroup G] : non_unital_comm_ring (monoid_algebra k G) := @@ -258,9 +275,13 @@ instance [comm_ring k] [comm_monoid G] : comm_ring (monoid_algebra k G) := variables {S : Type*} -instance [monoid R] [semiring k] [distrib_mul_action R k] : - has_scalar R (monoid_algebra k G) := -finsupp.has_scalar +instance [semiring k] [smul_zero_class R k] : + smul_zero_class R (monoid_algebra k G) := +finsupp.smul_zero_class + +instance [semiring k] [distrib_smul R k] : + distrib_smul R (monoid_algebra k G) := +finsupp.distrib_smul _ _ instance [monoid R] [semiring k] [distrib_mul_action R k] : distrib_mul_action R (monoid_algebra k G) := @@ -270,13 +291,12 @@ instance [semiring R] [semiring k] [module R k] : module R (monoid_algebra k G) := finsupp.module G k -instance [monoid R] [semiring k] [distrib_mul_action R k] [has_faithful_scalar R k] [nonempty G] : - has_faithful_scalar R (monoid_algebra k G) := -finsupp.has_faithful_scalar +instance [monoid R] [semiring k] [distrib_mul_action R k] [has_faithful_smul R k] [nonempty G] : + has_faithful_smul R (monoid_algebra k G) := +finsupp.has_faithful_smul -instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k] - [has_scalar R S] [is_scalar_tower R S k] : - is_scalar_tower R S (monoid_algebra k G) := +instance [semiring k] [smul_zero_class R k] [smul_zero_class S k] [has_smul R S] + [is_scalar_tower R S k] : is_scalar_tower R S (monoid_algebra k G) := finsupp.is_scalar_tower G k instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k] @@ -302,7 +322,7 @@ section misc_theorems variables [semiring k] local attribute [reducible] monoid_algebra -lemma mul_apply [has_mul G] (f g : monoid_algebra k G) (x : G) : +lemma mul_apply [decidable_eq G] [has_mul G] (f g : monoid_algebra k G) (x : G) : (f * g) x = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, if a₁ * a₂ = x then b₁ * b₂ else 0) := begin rw [mul_def], @@ -312,11 +332,12 @@ end lemma mul_apply_antidiagonal [has_mul G] (f g : monoid_algebra k G) (x : G) (s : finset (G × G)) (hs : ∀ {p : G × G}, p ∈ s ↔ p.1 * p.2 = x) : (f * g) x = ∑ p in s, (f p.1 * g p.2) := +by classical; exact let F : G × G → k := λ p, if p.1 * p.2 = x then f p.1 * g p.2 else 0 in calc (f * g) x = (∑ a₁ in f.support, ∑ a₂ in g.support, F (a₁, a₂)) : mul_apply f g x -... = ∑ p in f.support.product g.support, F p : finset.sum_product.symm -... = ∑ p in (f.support.product g.support).filter (λ p : G × G, p.1 * p.2 = x), f p.1 * g p.2 : +... = ∑ p in f.support ×ˢ g.support, F p : finset.sum_product.symm +... = ∑ p in (f.support ×ˢ g.support).filter (λ p : G × G, p.1 * p.2 = x), f p.1 * g p.2 : (finset.sum_filter _ _).symm ... = ∑ p in s.filter (λ p : G × G, p.1 ∈ f.support ∧ p.2 ∈ g.support), f p.1 * g p.2 : sum_congr (by { ext, simp only [mem_filter, mem_product, hs, and_comm] }) (λ _ _, rfl) @@ -328,11 +349,6 @@ calc (f * g) x = (∑ a₁ in f.support, ∑ a₂ in g.support, F (a₁, a₂)) { rw [hp hps h1, mul_zero] } end -lemma support_mul [has_mul G] (a b : monoid_algebra k G) : - (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ * a₂}) := -subset.trans support_sum $ bUnion_mono $ assume a₁ _, - subset.trans support_sum $ bUnion_mono $ assume a₂ _, support_single_subset - @[simp] lemma single_mul_single [has_mul G] {a₁ a₂ : G} {b₁ b₂ : k} : (single a₁ b₁ : monoid_algebra k G) * single a₂ b₂ = single (a₁ * a₂) (b₁ * b₂) := (sum_single_index (by simp only [zero_mul, single_zero, sum_zero])).trans @@ -403,6 +419,7 @@ Note the order of the elements of the product are reversed compared to the argum lemma mul_single_apply_aux [has_mul G] (f : monoid_algebra k G) {r : k} {x y z : G} (H : ∀ a, a * x = z ↔ a = y) : (f * single x r) z = f y * r := +by classical; exact have A : ∀ a₁ b₁, (single x r).sum (λ a₂ b₂, ite (a₁ * a₂ = z) (b₁ * b₂) 0) = ite (a₁ * x = z) (b₁ * r) 0, from λ a₁ b₁, sum_single_index $ by simp, @@ -415,44 +432,49 @@ lemma mul_single_one_apply [mul_one_class G] (f : monoid_algebra k G) (r : k) (x (f * single 1 r) x = f x * r := f.mul_single_apply_aux $ λ a, by rw [mul_one] -lemma support_mul_single [right_cancel_semigroup G] - (f : monoid_algebra k G) (r : k) (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) : - (f * single x r).support = f.support.map (mul_right_embedding x) := +lemma mul_single_apply_of_not_exists_mul [has_mul G] (r : k) {g g' : G} (x : monoid_algebra k G) + (h : ¬∃ d, g' = d * g): + (x * finsupp.single g r : monoid_algebra k G) g' = 0 := begin - ext y, simp only [mem_support_iff, mem_map, exists_prop, mul_right_embedding_apply], - by_cases H : ∃ a, a * x = y, - { rcases H with ⟨a, rfl⟩, - rw [mul_single_apply_aux f (λ _, mul_left_inj x)], - simp [hr] }, - { push_neg at H, - simp [mul_apply, H] } + classical, + rw [mul_apply, finsupp.sum_comm, finsupp.sum_single_index], + swap, + { simp_rw [finsupp.sum, mul_zero, if_t_t, finset.sum_const_zero] }, + { apply finset.sum_eq_zero, + simp_rw ite_eq_right_iff, + rintros g'' hg'' rfl, + exfalso, + exact h ⟨_, rfl⟩ } end lemma single_mul_apply_aux [has_mul G] (f : monoid_algebra k G) {r : k} {x y z : G} (H : ∀ a, x * a = y ↔ a = z) : (single x r * f) y = r * f z := +by classical; exact ( have f.sum (λ a b, ite (x * a = y) (0 * b) 0) = 0, by simp, calc (single x r * f) y = sum f (λ a b, ite (x * a = y) (r * b) 0) : - (mul_apply _ _ _).trans $ sum_single_index this + (mul_apply _ _ _).trans $ sum_single_index (by exact this) ... = f.sum (λ a b, ite (a = z) (r * b) 0) : by simp only [H] ... = if z ∈ f.support then (r * f z) else 0 : f.support.sum_ite_eq' _ _ -... = _ : by split_ifs with h; simp at h; simp [h] +... = _ : by split_ifs with h; simp at h; simp [h]) lemma single_one_mul_apply [mul_one_class G] (f : monoid_algebra k G) (r : k) (x : G) : (single 1 r * f) x = r * f x := f.single_mul_apply_aux $ λ a, by rw [one_mul] -lemma support_single_mul [left_cancel_semigroup G] - (f : monoid_algebra k G) (r : k) (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) : - (single x r * f).support = f.support.map (mul_left_embedding x) := +lemma single_mul_apply_of_not_exists_mul [has_mul G] (r : k) {g g' : G} (x : monoid_algebra k G) + (h : ¬∃ d, g' = g * d): + (finsupp.single g r * x : monoid_algebra k G) g' = 0 := begin - ext y, simp only [mem_support_iff, mem_map, exists_prop, mul_left_embedding_apply], - by_cases H : ∃ a, x * a = y, - { rcases H with ⟨a, rfl⟩, - rw [single_mul_apply_aux f (λ _, mul_right_inj x)], - simp [hr] }, - { push_neg at H, - simp [mul_apply, H] } + classical, + rw [mul_apply, finsupp.sum_single_index], + swap, + { simp_rw [finsupp.sum, zero_mul, if_t_t, finset.sum_const_zero] }, + { apply finset.sum_eq_zero, + simp_rw ite_eq_right_iff, + rintros g'' hg'' rfl, + exfalso, + exact h ⟨_, rfl⟩ }, end lemma lift_nc_smul [mul_one_class G] {R : Type*} [semiring R] (f : k →+* R) (g : G →* R) (c : k) @@ -470,13 +492,14 @@ end misc_theorems /-! #### Non-unital, non-associative algebra structure -/ section non_unital_non_assoc_algebra -variables (k) [monoid R] [semiring k] [distrib_mul_action R k] [has_mul G] +variables (k) [semiring k] [distrib_smul R k] [has_mul G] instance is_scalar_tower_self [is_scalar_tower R k k] : is_scalar_tower R (monoid_algebra k G) (monoid_algebra k G) := ⟨λ t a b, begin ext m, + classical, simp only [mul_apply, finsupp.smul_sum, smul_ite, smul_mul_assoc, sum_smul_index', zero_mul, if_t_t, implies_true_iff, eq_self_iff_true, sum_zero, coe_smul, smul_eq_mul, pi.smul_apply, smul_zero], @@ -487,8 +510,8 @@ end⟩ also commute with the algebra multiplication. -/ instance smul_comm_class_self [smul_comm_class R k k] : smul_comm_class R (monoid_algebra k G) (monoid_algebra k G) := -⟨λ t a b, -begin +⟨λ t a b, begin + classical, ext m, simp only [mul_apply, finsupp.sum, finset.smul_sum, smul_ite, mul_smul_comm, sum_smul_index', implies_true_iff, eq_self_iff_true, coe_smul, ite_eq_right_iff, smul_eq_mul, pi.smul_apply, @@ -792,8 +815,8 @@ local attribute [reducible] monoid_algebra lemma prod_single [comm_semiring k] [comm_monoid G] {s : finset ι} {a : ι → G} {b : ι → k} : (∏ i in s, single (a i) (b i)) = single (∏ i in s, a i) (∏ i in s, b i) := -finset.induction_on s rfl $ λ a s has ih, by rw [prod_insert has, ih, - single_mul_single, prod_insert has, prod_insert has] +finset.cons_induction_on s rfl $ λ a s has ih, by rw [prod_cons has, ih, + single_mul_single, prod_cons has, prod_cons has] end @@ -826,17 +849,6 @@ calc (f * g) x = sum g (λ a b, (f * single a b) x) : end -section span - -variables [semiring k] [mul_one_class G] - -/-- An element of `monoid_algebra R M` is in the subalgebra generated by its support. -/ -lemma mem_span_support (f : monoid_algebra k G) : - f ∈ submodule.span k (of k G '' (f.support : set G)) := -by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported] - -end span - section opposite open finsupp mul_opposite @@ -878,13 +890,13 @@ def submodule_of_smul_mem (W : submodule k V) (h : ∀ (g : G) (v : V), v ∈ W submodule (monoid_algebra k G) V := { carrier := W, zero_mem' := W.zero_mem', - add_mem' := W.add_mem', + add_mem' := λ _ _, W.add_mem', smul_mem' := begin intros f v hv, rw [←finsupp.sum_single f, finsupp.sum, finset.sum_smul], simp_rw [←smul_of, smul_assoc], exact submodule.sum_smul_mem W _ (λ g _, h g v hv) - end } + end } end submodule @@ -947,11 +959,13 @@ instance : non_unital_non_assoc_semiring (add_monoid_algebra k G) := { zero := 0, mul := (*), add := (+), - left_distrib := assume f g h, by simp only [mul_def, sum_add_index, mul_add, mul_zero, - single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add], - right_distrib := assume f g h, by simp only [mul_def, sum_add_index, add_mul, mul_zero, zero_mul, - single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero, - sum_add], + left_distrib := assume f g h, by haveI := classical.dec_eq G; + simp only [mul_def, sum_add_index, mul_add, mul_zero, + single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_add], + right_distrib := assume f g h, by haveI := classical.dec_eq G; + simp only [mul_def, sum_add_index, add_mul, mul_zero, zero_mul, + single_zero, single_add, eq_self_iff_true, forall_true_iff, forall_3_true_iff, sum_zero, + sum_add], zero_mul := assume f, by simp only [mul_def, sum_zero_index], mul_zero := assume f, by simp only [mul_def, sum_zero_index, sum_zero], nsmul := λ n f, n • f, @@ -1012,20 +1026,25 @@ instance : non_assoc_semiring (add_monoid_algebra k G) := mul := (*), zero := 0, add := (+), + nat_cast := λ n, single 0 n, + nat_cast_zero := by simp [nat.cast], + nat_cast_succ := λ _, by simp [nat.cast]; refl, one_mul := assume f, by simp only [mul_def, one_def, sum_single_index, zero_mul, single_zero, sum_zero, zero_add, one_mul, sum_single], mul_one := assume f, by simp only [mul_def, one_def, sum_single_index, mul_zero, single_zero, sum_zero, add_zero, mul_one, sum_single], .. add_monoid_algebra.non_unital_non_assoc_semiring } +lemma nat_cast_def (n : ℕ) : (n : add_monoid_algebra k G) = single 0 n := rfl + end mul_one_class /-! #### Semiring structure -/ section semiring -instance {R : Type*} [monoid R] [semiring k] [distrib_mul_action R k] : - has_scalar R (add_monoid_algebra k G) := -finsupp.has_scalar +instance {R : Type*} [semiring k] [smul_zero_class R k] : + smul_zero_class R (add_monoid_algebra k G) := +finsupp.smul_zero_class variables [semiring k] [add_monoid G] @@ -1080,11 +1099,17 @@ instance [ring k] [add_semigroup G] : non_unital_ring (add_monoid_algebra k G) : .. add_monoid_algebra.non_unital_semiring } instance [ring k] [add_zero_class G] : non_assoc_ring (add_monoid_algebra k G) := -{ .. add_monoid_algebra.add_comm_group, +{ int_cast := λ z, single 0 (z : k), + int_cast_of_nat := λ n, by simpa, + int_cast_neg_succ_of_nat := λ n, by simpa, + .. add_monoid_algebra.add_comm_group, .. add_monoid_algebra.non_assoc_semiring } +lemma int_cast_def [ring k] [add_zero_class G] (z : ℤ) : + (z : add_monoid_algebra k G) = single 0 z := rfl + instance [ring k] [add_monoid G] : ring (add_monoid_algebra k G) := -{ .. add_monoid_algebra.non_unital_non_assoc_ring, +{ .. add_monoid_algebra.non_assoc_ring, .. add_monoid_algebra.semiring } instance [comm_ring k] [add_comm_semigroup G] : non_unital_comm_ring (add_monoid_algebra k G) := @@ -1097,28 +1122,31 @@ instance [comm_ring k] [add_comm_monoid G] : comm_ring (add_monoid_algebra k G) variables {S : Type*} +instance [semiring k] [distrib_smul R k] : distrib_smul R (add_monoid_algebra k G) := +finsupp.distrib_smul G k + instance [monoid R] [semiring k] [distrib_mul_action R k] : distrib_mul_action R (add_monoid_algebra k G) := finsupp.distrib_mul_action G k -instance [monoid R] [semiring k] [distrib_mul_action R k] [has_faithful_scalar R k] [nonempty G] : - has_faithful_scalar R (add_monoid_algebra k G) := -finsupp.has_faithful_scalar +instance [semiring k] [smul_zero_class R k] [has_faithful_smul R k] [nonempty G] : + has_faithful_smul R (add_monoid_algebra k G) := +finsupp.has_faithful_smul instance [semiring R] [semiring k] [module R k] : module R (add_monoid_algebra k G) := finsupp.module G k -instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k] - [has_scalar R S] [is_scalar_tower R S k] : +instance [semiring k] [smul_zero_class R k] [smul_zero_class S k] + [has_smul R S] [is_scalar_tower R S k] : is_scalar_tower R S (add_monoid_algebra k G) := finsupp.is_scalar_tower G k -instance [monoid R] [monoid S] [semiring k] [distrib_mul_action R k] [distrib_mul_action S k] +instance [semiring k] [smul_zero_class R k] [smul_zero_class S k] [smul_comm_class R S k] : smul_comm_class R S (add_monoid_algebra k G) := finsupp.smul_comm_class G k -instance [monoid R] [semiring k] [distrib_mul_action R k] [distrib_mul_action Rᵐᵒᵖ k] +instance [semiring k] [smul_zero_class R k] [smul_zero_class Rᵐᵒᵖ k] [is_central_scalar R k] : is_central_scalar R (add_monoid_algebra k G) := finsupp.is_central_scalar G k @@ -1127,24 +1155,20 @@ finsupp.is_central_scalar G k because we've never discussed actions of additive groups. -/ end derived_instances - +. section misc_theorems variables [semiring k] -lemma mul_apply [has_add G] (f g : add_monoid_algebra k G) (x : G) : +lemma mul_apply [decidable_eq G] [has_add G] (f g : add_monoid_algebra k G) (x : G) : (f * g) x = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, if a₁ + a₂ = x then b₁ * b₂ else 0) := -@monoid_algebra.mul_apply k (multiplicative G) _ _ _ _ _ +@monoid_algebra.mul_apply k (multiplicative G) _ _ _ _ _ _ lemma mul_apply_antidiagonal [has_add G] (f g : add_monoid_algebra k G) (x : G) (s : finset (G × G)) (hs : ∀ {p : G × G}, p ∈ s ↔ p.1 + p.2 = x) : (f * g) x = ∑ p in s, (f p.1 * g p.2) := @monoid_algebra.mul_apply_antidiagonal k (multiplicative G) _ _ _ _ _ s @hs -lemma support_mul [has_add G] (a b : add_monoid_algebra k G) : - (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ + a₂}) := -@monoid_algebra.support_mul k (multiplicative G) _ _ _ _ - lemma single_mul_single [has_add G] {a₁ a₂ : G} {b₁ b₂ : k} : (single a₁ b₁ * single a₂ b₂ : add_monoid_algebra k G) = single (a₁ + a₂) (b₁ * b₂) := @monoid_algebra.single_mul_single k (multiplicative G) _ _ _ _ _ _ @@ -1232,6 +1256,11 @@ lemma mul_single_zero_apply [add_zero_class G] (f : add_monoid_algebra k G) (r : (f * single 0 r) x = f x * r := f.mul_single_apply_aux r _ _ _ $ λ a, by rw [add_zero] +lemma mul_single_apply_of_not_exists_add [has_add G] (r : k) {g g' : G} (x : add_monoid_algebra k G) + (h : ¬∃ d, g' = d + g): + (x * finsupp.single g r : add_monoid_algebra k G) g' = 0 := +@monoid_algebra.mul_single_apply_of_not_exists_mul k (multiplicative G) _ _ _ _ _ _ h + lemma single_mul_apply_aux [has_add G] (f : add_monoid_algebra k G) (r : k) (x y z : G) (H : ∀ a, x + a = y ↔ a = z) : (single x r * f : add_monoid_algebra k G) y = r * f z := @@ -1241,6 +1270,11 @@ lemma single_zero_mul_apply [add_zero_class G] (f : add_monoid_algebra k G) (r : (single 0 r * f : add_monoid_algebra k G) x = r * f x := f.single_mul_apply_aux r _ _ _ $ λ a, by rw [zero_add] +lemma single_mul_apply_of_not_exists_add [has_add G] (r : k) {g g' : G} (x : add_monoid_algebra k G) + (h : ¬∃ d, g' = g + d): + (finsupp.single g r * x : add_monoid_algebra k G) g' = 0 := +@monoid_algebra.single_mul_apply_of_not_exists_mul k (multiplicative G) _ _ _ _ _ _ h + lemma mul_single_apply [add_group G] (f : add_monoid_algebra k G) (r : k) (x y : G) : (f * single x r) y = f (y - x) * r := (sub_eq_add_neg y x).symm ▸ @@ -1250,16 +1284,6 @@ lemma single_mul_apply [add_group G] (r : k) (x : G) (f : add_monoid_algebra k G (single x r * f : add_monoid_algebra k G) y = r * f (- x + y) := @monoid_algebra.single_mul_apply k (multiplicative G) _ _ _ _ _ _ -lemma support_mul_single [add_right_cancel_semigroup G] - (f : add_monoid_algebra k G) (r : k) (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) : - (f * single x r : add_monoid_algebra k G).support = f.support.map (add_right_embedding x) := -@monoid_algebra.support_mul_single k (multiplicative G) _ _ _ _ hr _ - -lemma support_single_mul [add_left_cancel_semigroup G] - (f : add_monoid_algebra k G) (r : k) (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) : - (single x r * f : add_monoid_algebra k G).support = f.support.map (add_left_embedding x) := -@monoid_algebra.support_single_mul k (multiplicative G) _ _ _ _ hr _ - lemma lift_nc_smul {R : Type*} [add_zero_class G] [semiring R] (f : k →+* R) (g : multiplicative G →* R) (c : k) (φ : monoid_algebra k G) : lift_nc (f : k →+ R) g (c • φ) = f c * lift_nc (f : k →+ R) g φ := @@ -1288,23 +1312,6 @@ def map_domain_ring_hom (k : Type*) [semiring k] {H F : Type*} [add_monoid G] [a end misc_theorems -section span - -variables [semiring k] - -/-- An element of `add_monoid_algebra R M` is in the submodule generated by its support. -/ -lemma mem_span_support [add_zero_class G] (f : add_monoid_algebra k G) : - f ∈ submodule.span k (of k G '' (f.support : set G)) := -by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported] - -/-- An element of `add_monoid_algebra R M` is in the subalgebra generated by its support, using -unbundled inclusion. -/ -lemma mem_span_support' (f : add_monoid_algebra k G) : - f ∈ submodule.span k (of' k G '' (f.support : set G)) := -by rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported] - -end span - end add_monoid_algebra /-! @@ -1347,22 +1354,22 @@ variables {k G} section non_unital_non_assoc_algebra -variables (k) [monoid R] [semiring k] [distrib_mul_action R k] [has_add G] +variables (k) [semiring k] [distrib_smul R k] [has_add G] instance is_scalar_tower_self [is_scalar_tower R k k] : is_scalar_tower R (add_monoid_algebra k G) (add_monoid_algebra k G) := -@monoid_algebra.is_scalar_tower_self k (multiplicative G) R _ _ _ _ _ +@monoid_algebra.is_scalar_tower_self k (multiplicative G) R _ _ _ _ /-- Note that if `k` is a `comm_semiring` then we have `smul_comm_class k k k` and so we can take `R = k` in the below. In other words, if the coefficients are commutative amongst themselves, they also commute with the algebra multiplication. -/ instance smul_comm_class_self [smul_comm_class R k k] : smul_comm_class R (add_monoid_algebra k G) (add_monoid_algebra k G) := -@monoid_algebra.smul_comm_class_self k (multiplicative G) R _ _ _ _ _ +@monoid_algebra.smul_comm_class_self k (multiplicative G) R _ _ _ _ instance smul_comm_class_symm_self [smul_comm_class k R k] : smul_comm_class (add_monoid_algebra k G) R (add_monoid_algebra k G) := -@monoid_algebra.smul_comm_class_symm_self k (multiplicative G) R _ _ _ _ _ +@monoid_algebra.smul_comm_class_symm_self k (multiplicative G) R _ _ _ _ variables {A : Type u₃} [non_unital_non_assoc_semiring A] @@ -1560,8 +1567,8 @@ variable {ι : Type ui} lemma prod_single [comm_semiring k] [add_comm_monoid G] {s : finset ι} {a : ι → G} {b : ι → k} : (∏ i in s, single (a i) (b i)) = single (∑ i in s, a i) (∏ i in s, b i) := -finset.induction_on s rfl $ λ a s has ih, by rw [prod_insert has, ih, - single_mul_single, sum_insert has, prod_insert has] +finset.cons_induction_on s rfl $ λ a s has ih, by rw [prod_cons has, ih, + single_mul_single, sum_cons has, prod_cons has] end diff --git a/src/algebra/monoid_algebra/degree.lean b/src/algebra/monoid_algebra/degree.lean new file mode 100644 index 0000000000000..2aae4a028c4e4 --- /dev/null +++ b/src/algebra/monoid_algebra/degree.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import algebra.monoid_algebra.support + +/-! +# Lemmas about the `sup` and `inf` of the support of `add_monoid_algebra` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## TODO +The current plan is to state and prove lemmas about `finset.sup (finsupp.support f) D` with a +"generic" degree/weight function `D` from the grading Type `A` to a somewhat ordered Type `B`. + +Next, the general lemmas get specialized for some yet-to-be-defined `degree`s. +-/ + +variables {R A T B ι : Type*} + +namespace add_monoid_algebra +open_locale classical big_operators + +/-! ### Results about the `finset.sup` and `finset.inf` of `finsupp.support` -/ + +section general_results_assuming_semilattice_sup +variables [semilattice_sup B] [order_bot B] [semilattice_inf T] [order_top T] + +section semiring +variables [semiring R] + +section explicit_degrees +/-! + +In this section, we use `degb` and `degt` to denote "degree functions" on `A` with values in +a type with *b*ot or *t*op respectively. +-/ +variables (degb : A → B) (degt : A → T) (f g : add_monoid_algebra R A) + +lemma sup_support_add_le : (f + g).support.sup degb ≤ (f.support.sup degb) ⊔ (g.support.sup degb) := +(finset.sup_mono finsupp.support_add).trans_eq finset.sup_union + +lemma le_inf_support_add : f.support.inf degt ⊓ g.support.inf degt ≤ (f + g).support.inf degt := +sup_support_add_le (λ a : A, order_dual.to_dual (degt a)) f g + +end explicit_degrees + +section add_only +variables [has_add A] [has_add B] [has_add T] + [covariant_class B B (+) (≤)] [covariant_class B B (function.swap (+)) (≤)] + [covariant_class T T (+) (≤)] [covariant_class T T (function.swap (+)) (≤)] + +lemma sup_support_mul_le {degb : A → B} (degbm : ∀ {a b}, degb (a + b) ≤ degb a + degb b) + (f g : add_monoid_algebra R A) : + (f * g).support.sup degb ≤ f.support.sup degb + g.support.sup degb := +begin + refine (finset.sup_mono $ support_mul _ _).trans _, + simp_rw [finset.sup_bUnion, finset.sup_singleton], + refine (finset.sup_le $ λ fd fds, finset.sup_le $ λ gd gds, degbm.trans $ add_le_add _ _); + exact finset.le_sup ‹_›, +end + +lemma le_inf_support_mul {degt : A → T} (degtm : ∀ {a b}, degt a + degt b ≤ degt (a + b)) + (f g : add_monoid_algebra R A) : + f.support.inf degt + g.support.inf degt ≤ (f * g).support.inf degt := +order_dual.of_dual_le_of_dual.mpr $ + sup_support_mul_le (λ a b, order_dual.of_dual_le_of_dual.mp degtm) f g + +end add_only + +section add_monoids +variables [add_monoid A] + [add_monoid B] [covariant_class B B (+) (≤)] [covariant_class B B (function.swap (+)) (≤)] + [add_monoid T] [covariant_class T T (+) (≤)] [covariant_class T T (function.swap (+)) (≤)] + {degb : A → B} {degt : A → T} + +lemma sup_support_list_prod_le (degb0 : degb 0 ≤ 0) + (degbm : ∀ a b, degb (a + b) ≤ degb a + degb b) : + ∀ l : list (add_monoid_algebra R A), + l.prod.support.sup degb ≤ (l.map (λ f : add_monoid_algebra R A, f.support.sup degb)).sum +| [] := begin + rw [list.map_nil, finset.sup_le_iff, list.prod_nil, list.sum_nil], + exact λ a ha, by rwa [finset.mem_singleton.mp (finsupp.support_single_subset ha)] + end +| (f::fs) := begin + rw [list.prod_cons, list.map_cons, list.sum_cons], + exact (sup_support_mul_le degbm _ _).trans (add_le_add_left (sup_support_list_prod_le _) _) + end + +lemma le_inf_support_list_prod (degt0 : 0 ≤ degt 0) (degtm : ∀ a b, degt a + degt b ≤ degt (a + b)) + (l : list (add_monoid_algebra R A)) : + (l.map (λ f : add_monoid_algebra R A, f.support.inf degt)).sum ≤ l.prod.support.inf degt := +order_dual.of_dual_le_of_dual.mpr $ sup_support_list_prod_le + (order_dual.of_dual_le_of_dual.mp degt0) (λ a b, order_dual.of_dual_le_of_dual.mp (degtm _ _)) l + +lemma sup_support_pow_le (degb0 : degb 0 ≤ 0) (degbm : ∀ a b, degb (a + b) ≤ degb a + degb b) + (n : ℕ) (f : add_monoid_algebra R A) : + (f ^ n).support.sup degb ≤ n • (f.support.sup degb) := +begin + rw [← list.prod_replicate, ←list.sum_replicate], + refine (sup_support_list_prod_le degb0 degbm _).trans_eq _, + rw list.map_replicate, +end + +lemma le_inf_support_pow (degt0 : 0 ≤ degt 0) (degtm : ∀ a b, degt a + degt b ≤ degt (a + b)) + (n : ℕ) (f : add_monoid_algebra R A) : + n • (f.support.inf degt) ≤ (f ^ n).support.inf degt := +order_dual.of_dual_le_of_dual.mpr $ sup_support_pow_le (order_dual.of_dual_le_of_dual.mp degt0) + (λ a b, order_dual.of_dual_le_of_dual.mp (degtm _ _)) n f + +end add_monoids + +end semiring + +section commutative_lemmas +variables [comm_semiring R] [add_comm_monoid A] + [add_comm_monoid B] [covariant_class B B (+) (≤)] [covariant_class B B (function.swap (+)) (≤)] + [add_comm_monoid T] [covariant_class T T (+) (≤)] [covariant_class T T (function.swap (+)) (≤)] + {degb : A → B} {degt : A → T} + +lemma sup_support_multiset_prod_le + (degb0 : degb 0 ≤ 0) (degbm : ∀ a b, degb (a + b) ≤ degb a + degb b) + (m : multiset (add_monoid_algebra R A)) : + m.prod.support.sup degb ≤ (m.map (λ f : add_monoid_algebra R A, f.support.sup degb)).sum := +begin + induction m using quot.induction_on, + rw [multiset.quot_mk_to_coe'', multiset.coe_map, multiset.coe_sum, multiset.coe_prod], + exact sup_support_list_prod_le degb0 degbm m, +end + +lemma le_inf_support_multiset_prod + (degt0 : 0 ≤ degt 0) (degtm : ∀ a b, degt a + degt b ≤ degt (a + b)) + (m : multiset (add_monoid_algebra R A)) : + (m.map (λ f : add_monoid_algebra R A, f.support.inf degt)).sum ≤ m.prod.support.inf degt := +order_dual.of_dual_le_of_dual.mpr $ + sup_support_multiset_prod_le (order_dual.of_dual_le_of_dual.mp degt0) + (λ a b, order_dual.of_dual_le_of_dual.mp (degtm _ _)) m + +lemma sup_support_finset_prod_le + (degb0 : degb 0 ≤ 0) (degbm : ∀ a b, degb (a + b) ≤ degb a + degb b) + (s : finset ι) (f : ι → add_monoid_algebra R A) : + (∏ i in s, f i).support.sup degb ≤ ∑ i in s, (f i).support.sup degb := +(sup_support_multiset_prod_le degb0 degbm _).trans_eq $ congr_arg _ $ multiset.map_map _ _ _ + +lemma le_inf_support_finset_prod + (degt0 : 0 ≤ degt 0) (degtm : ∀ a b, degt a + degt b ≤ degt (a + b)) + (s : finset ι) (f : ι → add_monoid_algebra R A) : + ∑ i in s, (f i).support.inf degt ≤ (∏ i in s, f i).support.inf degt := +le_of_eq_of_le (by rw [multiset.map_map]; refl) (le_inf_support_multiset_prod degt0 degtm _) + +end commutative_lemmas + +end general_results_assuming_semilattice_sup + +end add_monoid_algebra diff --git a/src/algebra/monoid_algebra/division.lean b/src/algebra/monoid_algebra/division.lean new file mode 100644 index 0000000000000..4478367e461e0 --- /dev/null +++ b/src/algebra/monoid_algebra/division.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.monoid_algebra.basic +import data.finsupp.order + +/-! +# Division of `add_monoid_algebra` by monomials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file is most important for when `G = ℕ` (polynomials) or `G = σ →₀ ℕ` (multivariate +polynomials). + +In order to apply in maximal generality (such as for `laurent_polynomial`s), this uses +`∃ d, g' = g + d` in many places instead of `g ≤ g'`. + +## Main definitions + +* `add_monoid_algebra.div_of x g`: divides `x` by the monomial `add_monoid_algebra.of k G g` +* `add_monoid_algebra.mod_of x g`: the remainder upon dividing `x` by the monomial + `add_monoid_algebra.of k G g`. + +## Main results + +* `add_monoid_algebra.div_of_add_mod_of`, `add_monoid_algebra.mod_of_add_div_of`: `div_of` and + `mod_of` are well-behaved as quotient and remainder operators. + +## Implementation notes + +`∃ d, g' = g + d` is used as opposed to some other permutation up to commutativity in order to match +the definition of `semigroup_has_dvd`. The results in this file could be duplicated for +`monoid_algebra` by using `g ∣ g'`, but this can't be done automatically, and in any case is not +likely to be very useful. + +-/ + + +variables {k G : Type*} [semiring k] + +namespace add_monoid_algebra + +section +variables [add_cancel_comm_monoid G] + +/-- Divide by `of' k G g`, discarding terms not divisible by this. -/ +noncomputable def div_of (x : add_monoid_algebra k G) (g : G) : add_monoid_algebra k G := +-- note: comapping by `+ g` has the effect of subtracting `g` from every element in the support, and +-- discarding the elements of the support from which `g` can't be subtracted. If `G` is an additive +-- group, such as `ℤ` when used for `laurent_polynomial`, then no discarding occurs. +@finsupp.comap_domain.add_monoid_hom _ _ _ _ ((+) g) + (add_right_injective g) x + +local infix ` /ᵒᶠ `:70 := div_of + +@[simp] lemma div_of_apply (g : G) (x : add_monoid_algebra k G) (g' : G) : + (x /ᵒᶠ g) g' = x (g + g') := rfl + +@[simp] lemma support_div_of (g : G) (x : add_monoid_algebra k G) : + (x /ᵒᶠ g).support = x.support.preimage ((+) g) + (function.injective.inj_on + (add_right_injective g) _) := rfl + +@[simp] lemma zero_div_of (g : G) : (0 : add_monoid_algebra k G) /ᵒᶠ g = 0 := +map_zero _ + +@[simp] lemma div_of_zero (x : add_monoid_algebra k G) : x /ᵒᶠ 0 = x := +by { ext, simp only [add_monoid_algebra.div_of_apply, zero_add] } + +lemma add_div_of (x y : add_monoid_algebra k G) (g : G) : (x + y) /ᵒᶠ g = x /ᵒᶠ g + y /ᵒᶠ g := +map_add _ _ _ + +lemma div_of_add (x : add_monoid_algebra k G) (a b : G) : + x /ᵒᶠ (a + b) = (x /ᵒᶠ a) /ᵒᶠ b := +by { ext, simp only [add_monoid_algebra.div_of_apply, add_assoc] } + +/-- A bundled version of `add_monoid_algebra.div_of`. -/ +@[simps] +noncomputable def div_of_hom : multiplicative G →* add_monoid.End (add_monoid_algebra k G) := +{ to_fun := λ g, + { to_fun := λ x, div_of x g.to_add, + map_zero' := zero_div_of _, + map_add' := λ x y, add_div_of x y g.to_add }, + map_one' := add_monoid_hom.ext div_of_zero, + map_mul' := λ g₁ g₂, add_monoid_hom.ext $ λ x, + (congr_arg _ (add_comm g₁.to_add g₂.to_add)).trans (div_of_add _ _ _) } + +lemma of'_mul_div_of (a : G) (x : add_monoid_algebra k G) : + (of' k G a * x) /ᵒᶠ a = x := +begin + ext b, + rw [add_monoid_algebra.div_of_apply, of'_apply, single_mul_apply_aux, one_mul], + intro c, + exact add_right_inj _, +end + +lemma mul_of'_div_of (x : add_monoid_algebra k G) (a : G) : + (x * of' k G a) /ᵒᶠ a = x := +begin + ext b, + rw [add_monoid_algebra.div_of_apply, of'_apply, mul_single_apply_aux, mul_one], + intro c, + rw add_comm, + exact add_right_inj _, +end + +lemma of'_div_of (a : G) : (of' k G a) /ᵒᶠ a = 1 := +by simpa only [one_mul] using mul_of'_div_of (1 : add_monoid_algebra k G) a + +/-- The remainder upon division by `of' k G g`. -/ +noncomputable def mod_of (x : add_monoid_algebra k G) (g : G) : add_monoid_algebra k G := +x.filter (λ g₁, ¬∃ g₂, g₁ = g + g₂) + +local infix ` %ᵒᶠ `:70 := mod_of + +@[simp] lemma mod_of_apply_of_not_exists_add (x : add_monoid_algebra k G) (g : G) (g' : G) + (h : ¬∃ d, g' = g + d) : + (x %ᵒᶠ g) g' = x g' := +finsupp.filter_apply_pos _ _ h + +@[simp] lemma mod_of_apply_of_exists_add (x : add_monoid_algebra k G) (g : G) (g' : G) + (h : ∃ d, g' = g + d) : + (x %ᵒᶠ g) g' = 0 := +finsupp.filter_apply_neg _ _ $ by rwa [not_not] + +@[simp] lemma mod_of_apply_add_self (x : add_monoid_algebra k G) (g : G) (d : G) : + (x %ᵒᶠ g) (d + g) = 0 := +mod_of_apply_of_exists_add _ _ _ ⟨_, add_comm _ _⟩ + +@[simp] lemma mod_of_apply_self_add (x : add_monoid_algebra k G) (g : G) (d : G) : + (x %ᵒᶠ g) (g + d) = 0 := +mod_of_apply_of_exists_add _ _ _ ⟨_, rfl⟩ + +lemma of'_mul_mod_of (g : G) (x : add_monoid_algebra k G) : + (of' k G g * x) %ᵒᶠ g = 0 := +begin + ext g', + rw finsupp.zero_apply, + obtain ⟨d, rfl⟩ | h := em (∃ d, g' = g + d), + { rw mod_of_apply_self_add }, + { rw [mod_of_apply_of_not_exists_add _ _ _ h, of'_apply, + single_mul_apply_of_not_exists_add _ _ h] }, +end + +lemma mul_of'_mod_of (x : add_monoid_algebra k G) (g : G) : + (x * of' k G g) %ᵒᶠ g = 0 := +begin + ext g', + rw finsupp.zero_apply, + obtain ⟨d, rfl⟩ | h := em (∃ d, g' = g + d), + { rw mod_of_apply_self_add }, + { rw [mod_of_apply_of_not_exists_add _ _ _ h, of'_apply, mul_single_apply_of_not_exists_add], + simpa only [add_comm] using h }, +end + +lemma of'_mod_of (g : G) : of' k G g %ᵒᶠ g = 0 := +by simpa only [one_mul] using mul_of'_mod_of (1 : add_monoid_algebra k G) g + +lemma div_of_add_mod_of (x : add_monoid_algebra k G) (g : G) : + of' k G g * (x /ᵒᶠ g) + x %ᵒᶠ g = x := +begin + ext g', + simp_rw [finsupp.add_apply], + obtain ⟨d, rfl⟩ | h := em (∃ d, g' = g + d), + swap, + { rw [mod_of_apply_of_not_exists_add _ _ _ h, of'_apply, single_mul_apply_of_not_exists_add _ _ h, + zero_add] }, + { rw [mod_of_apply_self_add, add_zero], + rw [of'_apply, single_mul_apply_aux _ _ _, one_mul, div_of_apply], + intro a, + exact add_right_inj _ } +end + +lemma mod_of_add_div_of (x : add_monoid_algebra k G) (g : G) : + x %ᵒᶠ g + of' k G g * (x /ᵒᶠ g) = x := +by rw [add_comm, div_of_add_mod_of] + +lemma of'_dvd_iff_mod_of_eq_zero {x : add_monoid_algebra k G} {g : G} : + of' k G g ∣ x ↔ x %ᵒᶠ g = 0 := +begin + split, + { rintro ⟨x, rfl⟩, + rw of'_mul_mod_of }, + { intro h, + rw [←div_of_add_mod_of x g, h, add_zero], + exact dvd_mul_right _ _ }, +end + +end + +end add_monoid_algebra diff --git a/src/algebra/monoid_algebra/grading.lean b/src/algebra/monoid_algebra/grading.lean index 4473ac2be768b..d0acc07e315b1 100644 --- a/src/algebra/monoid_algebra/grading.lean +++ b/src/algebra/monoid_algebra/grading.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Wieser -/ import linear_algebra.finsupp -import algebra.monoid_algebra.basic +import algebra.monoid_algebra.support import algebra.direct_sum.internal import ring_theory.graded_algebra.basic /-! # Internal grading of an `add_monoid_algebra` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we show that an `add_monoid_algebra` has an internal direct sum structure. ## Main results @@ -62,7 +65,7 @@ end lemma mem_grade_iff' (m : M) (a : add_monoid_algebra R M) : a ∈ grade R m ↔ - a ∈ ((finsupp.lsingle m).range : submodule R (add_monoid_algebra R M)) := + a ∈ ((finsupp.lsingle m : R →ₗ[R] (M →₀ R)).range : submodule R (add_monoid_algebra R M)) := begin rw [mem_grade_iff, finsupp.support_subset_singleton'], apply exists_congr, @@ -70,7 +73,7 @@ begin split; exact eq.symm end -lemma grade_eq_lsingle_range (m : M) : grade R m = (finsupp.lsingle m).range := +lemma grade_eq_lsingle_range (m : M) : grade R m = (finsupp.lsingle m : R →ₗ[R] (M →₀ R)).range := submodule.ext (mem_grade_iff' R m) lemma single_mem_grade_by {R} [comm_semiring R] (f : M → ι) (m : M) (r : R) : @@ -95,7 +98,7 @@ instance grade_by.graded_monoid [add_monoid M] [add_monoid ι] [comm_semiring R] { rw [H , finsupp.single_zero] at h, exfalso, exact h }, - { rw [finsupp.support_single_ne_zero H, finset.mem_singleton] at h, + { rw [finsupp.support_single_ne_zero _ H, finset.mem_singleton] at h, rw [h, add_monoid_hom.map_zero] } end, mul_mem := λ i j a b ha hb c hc, begin @@ -113,7 +116,7 @@ by apply grade_by.graded_monoid (add_monoid_hom.id _) variables {R} [add_monoid M] [decidable_eq ι] [add_monoid ι] [comm_semiring R] (f : M →+ ι) /-- Auxiliary definition; the canonical grade decomposition, used to provide -`graded_algebra.decompose`. -/ +`direct_sum.decompose`. -/ def decompose_aux : add_monoid_algebra R M →ₐ[R] ⨁ i : ι, grade_by R f i := add_monoid_algebra.lift R M _ { to_fun := λ m, direct_sum.of (λ i : ι, grade_by R f i) (f m.to_add) @@ -156,12 +159,12 @@ begin exact add_monoid_hom.map_zero _ }, { intros m b y hmy hb ih hmby, have : disjoint (finsupp.single m b).support y.support, - { simpa only [finsupp.support_single_ne_zero hb, finset.disjoint_singleton_left] }, + { simpa only [finsupp.support_single_ne_zero _ hb, finset.disjoint_singleton_left] }, rw [mem_grade_by_iff, finsupp.support_add_eq this, finset.coe_union, set.union_subset_iff] at hmby, cases hmby with h1 h2, have : f m = i, - { rwa [finsupp.support_single_ne_zero hb, finset.coe_singleton, + { rwa [finsupp.support_single_ne_zero _ hb, finset.coe_singleton, set.singleton_subset_iff] at h1 }, subst this, simp only [alg_hom.map_add, submodule.coe_mk, decompose_aux_single f m], @@ -177,17 +180,22 @@ graded_algebra.of_alg_hom _ (decompose_aux f) (begin ext : 2, - dsimp, - rw [decompose_aux_single, direct_sum.submodule_coe_alg_hom_of, subtype.coe_mk], + simp only [alg_hom.coe_to_monoid_hom, function.comp_app, alg_hom.coe_comp, + function.comp.left_id, alg_hom.coe_id, add_monoid_algebra.of_apply, monoid_hom.coe_comp], + rw [decompose_aux_single, direct_sum.coe_alg_hom_of, subtype.coe_mk], end) - (λ i x, by convert (decompose_aux_coe f x : _)) + (λ i x, by rw [decompose_aux_coe f x]) + +-- Lean can't find this later without us repeating it +instance grade_by.decomposition : direct_sum.decomposition (grade_by R f) := +by apply_instance @[simp] lemma decompose_aux_eq_decompose : ⇑(decompose_aux f : add_monoid_algebra R M →ₐ[R] ⨁ i : ι, grade_by R f i) = - (graded_algebra.decompose (grade_by R f)) := rfl + (direct_sum.decompose (grade_by R f)) := rfl @[simp] lemma grades_by.decompose_single (m : M) (r : R) : - graded_algebra.decompose (grade_by R f) (finsupp.single m r) = + direct_sum.decompose (grade_by R f) (finsupp.single m r : add_monoid_algebra R M) = direct_sum.of (λ i : ι, grade_by R f i) (f m) ⟨finsupp.single m r, single_mem_grade_by _ _ _⟩ := decompose_aux_single _ _ _ @@ -195,18 +203,22 @@ decompose_aux_single _ _ _ instance grade.graded_algebra : graded_algebra (grade R : ι → submodule _ _) := add_monoid_algebra.grade_by.graded_algebra (add_monoid_hom.id _) +-- Lean can't find this later without us repeating it +instance grade.decomposition : direct_sum.decomposition (grade R : ι → submodule _ _) := +by apply_instance + @[simp] lemma grade.decompose_single (i : ι) (r : R) : - graded_algebra.decompose (grade R : ι → submodule _ _) (finsupp.single i r) = + direct_sum.decompose (grade R : ι → submodule _ _) (finsupp.single i r : add_monoid_algebra _ _) = direct_sum.of (λ i : ι, grade R i) i ⟨finsupp.single i r, single_mem_grade _ _⟩ := decompose_aux_single _ _ _ /-- `add_monoid_algebra.gradesby` describe an internally graded algebra -/ -lemma grade_by.is_internal : direct_sum.submodule_is_internal (grade_by R f) := -graded_algebra.is_internal _ +lemma grade_by.is_internal : direct_sum.is_internal (grade_by R f) := +direct_sum.decomposition.is_internal _ /-- `add_monoid_algebra.grades` describe an internally graded algebra -/ -lemma grade.is_internal : direct_sum.submodule_is_internal (grade R : ι → submodule R _) := -graded_algebra.is_internal _ +lemma grade.is_internal : direct_sum.is_internal (grade R : ι → submodule R _) := +direct_sum.decomposition.is_internal _ end add_monoid_algebra diff --git a/src/algebra/monoid_algebra/ideal.lean b/src/algebra/monoid_algebra/ideal.lean new file mode 100644 index 0000000000000..c5b235ec0c0db --- /dev/null +++ b/src/algebra/monoid_algebra/ideal.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ + +import algebra.monoid_algebra.division +import ring_theory.ideal.basic + +/-! +# Lemmas about ideals of `monoid_algebra` and `add_monoid_algebra` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {k A G : Type*} + +/-- If `x` belongs to the ideal generated by generators in `s`, then every element of the support of +`x` factors through an element of `s`. + +We could spell `∃ d, m = d * m` as `mul_opposite.op m' ∣ mul_opposite.op m` but this would be worse. +-/ +lemma monoid_algebra.mem_ideal_span_of_image + [monoid G] [semiring k] {s : set G} {x : monoid_algebra k G} : + x ∈ ideal.span (monoid_algebra.of k G '' s) ↔ ∀ m ∈ x.support, ∃ m' ∈ s, ∃ d, m = d * m' := +begin + let RHS : ideal (monoid_algebra k G) := + { carrier := {p | ∀ (m : G), m ∈ p.support → ∃ m' ∈ s, ∃ d, m = d * m'}, + add_mem' := λ x y hx hy m hm, by classical; + exact (finset.mem_union.1 $ finsupp.support_add hm).elim (hx m) (hy m), + zero_mem' := λ m hm, by cases hm, + smul_mem' := λ x y hy m hm, begin + replace hm := finset.mem_bUnion.mp (finsupp.support_sum hm), + obtain ⟨xm, hxm, hm⟩ := hm, + replace hm := finset.mem_bUnion.mp (finsupp.support_sum hm), + obtain ⟨ym, hym, hm⟩ := hm, + replace hm := finset.mem_singleton.mp (finsupp.support_single_subset hm), + obtain rfl := hm, + refine (hy _ hym).imp (λ sm, Exists.imp $ λ hsm, _), + rintros ⟨d, rfl⟩, + exact ⟨xm * d, (mul_assoc _ _ _).symm⟩, + end }, + change _ ↔ x ∈ RHS, + split, + { revert x, + refine ideal.span_le.2 _, + rintro _ ⟨i, hi, rfl⟩ m hm, + refine ⟨_, hi, 1, _⟩, + obtain rfl := finset.mem_singleton.mp (finsupp.support_single_subset hm), + exact (one_mul _).symm }, + { intros hx, + rw ←finsupp.sum_single x, + apply ideal.sum_mem _ (λ i hi, _), + obtain ⟨d, hd, d2, rfl⟩ := hx _ hi, + convert ideal.mul_mem_left _ (id $ finsupp.single d2 $ (x (d2 * d)) : monoid_algebra k G) _, + swap 3, + refine ideal.subset_span ⟨_, hd, rfl⟩, + rw [id.def, monoid_algebra.of_apply, monoid_algebra.single_mul_single, mul_one] }, +end + +/-- If `x` belongs to the ideal generated by generators in `s`, then every element of the support of +`x` factors additively through an element of `s`. +-/ +lemma add_monoid_algebra.mem_ideal_span_of'_image + [add_monoid A] [semiring k] {s : set A} {x : add_monoid_algebra k A} : + x ∈ ideal.span (add_monoid_algebra.of' k A '' s) ↔ ∀ m ∈ x.support, ∃ m' ∈ s, ∃ d, m = d + m' := +@monoid_algebra.mem_ideal_span_of_image k (multiplicative A) _ _ _ _ diff --git a/src/algebra/monoid_algebra/no_zero_divisors.lean b/src/algebra/monoid_algebra/no_zero_divisors.lean new file mode 100644 index 0000000000000..58493153c3cc5 --- /dev/null +++ b/src/algebra/monoid_algebra/no_zero_divisors.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import algebra.monoid_algebra.support + +/-! +# Variations on non-zero divisors in `add_monoid_algebra`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file studies the interaction between typeclass assumptions on two Types `R` and `A` and +whether `add_monoid_algebra R A` has non-zero zero-divisors. For some background on related +questions, see [Kaplansky's Conjectures](https://en.wikipedia.org/wiki/Kaplansky%27s_conjectures), +especially the *zero divisor conjecture*. + +_Conjecture._ +Let `K` be a field, and `G` a torsion-free group. The group ring `K[G]` does not contain +nontrivial zero divisors, that is, it is a domain. + +We formalize in this file the well-known result that if `R` is a field and `A` is a left-ordered +group, then `R[A]` contains no non-zero zero-divisors. Some of these assumptions can be trivially +weakened: below we mention what assumptions are sufficient for the proofs in this file. + +## Main results + +* `no_zero_divisors.of_left_ordered` shows that if `R` is a semiring with no non-zero + zero-divisors, `A` is a linearly ordered, add right cancel semigroup with strictly monotone + left addition, then `add_monoid_algebra R A` has no non-zero zero-divisors. +* `no_zero_divisors.of_right_ordered` shows that if `R` is a semiring with no non-zero + zero-divisors, `A` is a linearly ordered, add left cancel semigroup with strictly monotone + right addition, then `add_monoid_algebra R A` has no non-zero zero-divisors. + +The conditions on `A` imposed in `no_zero_divisors.of_left_ordered` are sometimes referred to as +`left-ordered`. +The conditions on `A` imposed in `no_zero_divisors.of_right_ordered` are sometimes referred to as +`right-ordered`. + +These conditions are sufficient, but not necessary. As mentioned above, *Kaplansky's Conjecture* +asserts that `A` being torsion-free may be enough. +-/ + +namespace add_monoid_algebra +open finsupp + +variables {R A : Type*} [semiring R] + +/-- The coefficient of a monomial in a product `f * g` that can be reached in at most one way +as a product of monomials in the supports of `f` and `g` is a product. -/ +lemma mul_apply_add_eq_mul_of_forall_ne [has_add A] {f g : add_monoid_algebra R A} {a0 b0 : A} + (h : ∀ {a b : A}, a ∈ f.support → b ∈ g.support → (a ≠ a0 ∨ b ≠ b0) → a + b ≠ a0 + b0) : + (f * g) (a0 + b0) = f a0 * g b0 := +begin + classical, + rw mul_apply, + refine (finset.sum_eq_single a0 _ _).trans _, + { exact λ b H hb, finset.sum_eq_zero (λ x H1, if_neg (h H H1 (or.inl hb))) }, + { exact λ af0, by simp [not_mem_support_iff.mp af0] }, + { refine (finset.sum_eq_single b0 (λ b bg b0, _) _).trans (if_pos rfl), + { by_cases af : a0 ∈ f.support, + { exact if_neg (h af bg (or.inr b0)) }, + { simp only [not_mem_support_iff.mp af, zero_mul, if_t_t] } }, + { exact λ bf0, by simp [not_mem_support_iff.mp bf0] } }, +end + +section left_or_right_orderability + +lemma left.exists_add_of_mem_support_single_mul [add_left_cancel_semigroup A] + {g : add_monoid_algebra R A} (a x : A) + (hx : x ∈ (single a 1 * g : add_monoid_algebra R A).support) : + ∃ b ∈ g.support, a + b = x := +by rwa [support_single_mul _ _ (λ y, by rw one_mul : ∀ y : R, 1 * y = 0 ↔ _), finset.mem_map] at hx + +lemma right.exists_add_of_mem_support_single_mul [add_right_cancel_semigroup A] + {f : add_monoid_algebra R A} (b x : A) + (hx : x ∈ (f * single b 1 : add_monoid_algebra R A).support) : + ∃ a ∈ f.support, a + b = x := +by rwa [support_mul_single _ _ (λ y, by rw mul_one : ∀ y : R, y * 1 = 0 ↔ _), finset.mem_map] at hx + +/-- If `R` is a semiring with no non-trivial zero-divisors and `A` is a left-ordered add right +cancel semigroup, then `add_monoid_algebra R A` also contains no non-zero zero-divisors. -/ +lemma no_zero_divisors.of_left_ordered [no_zero_divisors R] + [add_right_cancel_semigroup A] [linear_order A] [covariant_class A A (+) (<)] : + no_zero_divisors (add_monoid_algebra R A) := +⟨λ f g fg, begin + contrapose! fg, + let gmin : A := g.support.min' (support_nonempty_iff.mpr fg.2), + refine support_nonempty_iff.mp _, + obtain ⟨a, ha, H⟩ := right.exists_add_of_mem_support_single_mul gmin + ((f * single gmin 1 : add_monoid_algebra R A).support.min' + (by rw support_mul_single; simp [support_nonempty_iff.mpr fg.1])) (finset.min'_mem _ _), + refine ⟨a + gmin, mem_support_iff.mpr _⟩, + rw mul_apply_add_eq_mul_of_forall_ne _, + { refine mul_ne_zero _ _, + exacts [mem_support_iff.mp ha, mem_support_iff.mp (finset.min'_mem _ _)] }, + { rw H, + rintro b c bf cg (hb | hc); refine ne_of_gt _, + { refine lt_of_lt_of_le (_ : _ < b + gmin ) _, + { apply finset.min'_lt_of_mem_erase_min', + rw ← H, + apply finset.mem_erase_of_ne_of_mem, + { simpa only [ne.def, add_left_inj] }, + { rw support_mul_single _ _ (λ y, by rw mul_one : ∀ y : R, y * 1 = 0 ↔ _), + simpa only [finset.mem_map, add_right_embedding_apply, add_left_inj, exists_prop, + exists_eq_right] } }, + { haveI : covariant_class A A (+) (≤) := has_add.to_covariant_class_left A, + exact add_le_add_left (finset.min'_le _ _ cg) _ } }, + { refine lt_of_le_of_lt (_ : _ ≤ b + gmin) _, + { apply finset.min'_le, + rw support_mul_single _ _ (λ y, by rw mul_one : ∀ y : R, y * 1 = 0 ↔ _), + simp only [bf, finset.mem_map, add_right_embedding_apply, add_left_inj, exists_prop, + exists_eq_right] }, + { refine add_lt_add_left _ _, + exact finset.min'_lt_of_mem_erase_min' _ _ (finset.mem_erase.mpr ⟨hc, cg⟩) } } } +end⟩ + +/-- If `R` is a semiring with no non-trivial zero-divisors and `A` is a right-ordered add left +cancel semigroup, then `add_monoid_algebra R A` also contains no non-zero zero-divisors. -/ +lemma no_zero_divisors.of_right_ordered [no_zero_divisors R] + [add_left_cancel_semigroup A] [linear_order A] [covariant_class A A (function.swap (+)) (<)] : + no_zero_divisors (add_monoid_algebra R A) := +⟨λ f g fg, begin + contrapose! fg, + let fmin : A := f.support.min' (support_nonempty_iff.mpr fg.1), + refine support_nonempty_iff.mp _, + obtain ⟨a, ha, H⟩ := left.exists_add_of_mem_support_single_mul fmin + ((single fmin 1 * g : add_monoid_algebra R A).support.min' + (by rw support_single_mul; simp [support_nonempty_iff.mpr fg.2])) (finset.min'_mem _ _), + refine ⟨fmin + a, mem_support_iff.mpr _⟩, + rw mul_apply_add_eq_mul_of_forall_ne _, + { refine mul_ne_zero _ _, + exacts [mem_support_iff.mp (finset.min'_mem _ _), mem_support_iff.mp ha] }, + { rw H, + rintro b c bf cg (hb | hc); refine ne_of_gt _, + { refine lt_of_le_of_lt (_ : _ ≤ fmin + c) _, + { apply finset.min'_le, + rw support_single_mul _ _ (λ y, by rw one_mul : ∀ y : R, 1 * y = 0 ↔ _), + simp only [cg, finset.mem_map, add_left_embedding_apply, add_right_inj, exists_prop, + exists_eq_right] }, + { refine add_lt_add_right _ _, + exact finset.min'_lt_of_mem_erase_min' _ _ (finset.mem_erase.mpr ⟨hb, bf⟩) } }, + { refine lt_of_lt_of_le (_ : _ < fmin + c) _, + { apply finset.min'_lt_of_mem_erase_min', + rw ← H, + apply finset.mem_erase_of_ne_of_mem, + { simpa only [ne.def, add_right_inj] }, + { rw support_single_mul _ _ (λ y, by rw one_mul : ∀ y : R, 1 * y = 0 ↔ _), + simpa only [finset.mem_map, add_left_embedding_apply, add_right_inj, exists_prop, + exists_eq_right]} }, + { haveI : covariant_class A A (function.swap (+)) (≤) := has_add.to_covariant_class_right A, + exact add_le_add_right (finset.min'_le _ _ bf) _ } } } +end⟩ + +end left_or_right_orderability + +end add_monoid_algebra diff --git a/src/algebra/monoid_algebra/support.lean b/src/algebra/monoid_algebra/support.lean new file mode 100644 index 0000000000000..9d94e76b6fb2a --- /dev/null +++ b/src/algebra/monoid_algebra/support.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import algebra.monoid_algebra.basic + +/-! +# Lemmas about the support of a finitely supported function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes u₁ u₂ u₃ +namespace monoid_algebra + +open finset finsupp +variables {k : Type u₁} {G : Type u₂} [semiring k] + +lemma support_single_mul_subset [decidable_eq G] [has_mul G] + (f : monoid_algebra k G) (r : k) (a : G) : + (single a r * f : monoid_algebra k G).support ⊆ finset.image ((*) a) f.support := +begin + intros x hx, + contrapose hx, + have : ∀ y, a * y = x → f y = 0, + { simpa only [not_and', mem_image, mem_support_iff, exists_prop, not_exists, not_not] using hx }, + simp only [mem_support_iff, mul_apply, sum_single_index, zero_mul, if_t_t, sum_zero, not_not], + exact finset.sum_eq_zero (by simp only [this, mem_support_iff, mul_zero, ne.def, + ite_eq_right_iff, eq_self_iff_true, implies_true_iff] {contextual := tt}), +end + +lemma support_mul_single_subset [decidable_eq G] [has_mul G] + (f : monoid_algebra k G) (r : k) (a : G) : + (f * single a r).support ⊆ finset.image (* a) f.support := +begin + intros x hx, + contrapose hx, + have : ∀ y, y * a = x → f y = 0, + { simpa only [not_and', mem_image, mem_support_iff, exists_prop, not_exists, not_not] using hx }, + simp only [mem_support_iff, mul_apply, sum_single_index, zero_mul, if_t_t, sum_zero, not_not], + exact finset.sum_eq_zero (by simp only [this, sum_single_index, ite_eq_right_iff, + eq_self_iff_true, implies_true_iff, zero_mul] {contextual := tt}), +end + +lemma support_single_mul_eq_image [decidable_eq G] [has_mul G] + (f : monoid_algebra k G) {r : k} (hr : ∀ y, r * y = 0 ↔ y = 0) {x : G} (lx : is_left_regular x) : + (single x r * f : monoid_algebra k G).support = finset.image ((*) x) f.support := +begin + refine subset_antisymm (support_single_mul_subset f _ _) (λ y hy, _), + obtain ⟨y, yf, rfl⟩ : ∃ (a : G), a ∈ f.support ∧ x * a = y, + { simpa only [finset.mem_image, exists_prop] using hy }, + simp only [mul_apply, mem_support_iff.mp yf, hr, mem_support_iff, sum_single_index, + finsupp.sum_ite_eq', ne.def, not_false_iff, if_true, zero_mul, if_t_t, sum_zero, lx.eq_iff] +end + +lemma support_mul_single_eq_image [decidable_eq G] [has_mul G] + (f : monoid_algebra k G) {r : k} (hr : ∀ y, y * r = 0 ↔ y = 0) {x : G} (rx : is_right_regular x) : + (f * single x r).support = finset.image (* x) f.support := +begin + refine subset_antisymm (support_mul_single_subset f _ _) (λ y hy, _), + obtain ⟨y, yf, rfl⟩ : ∃ (a : G), a ∈ f.support ∧ a * x = y, + { simpa only [finset.mem_image, exists_prop] using hy }, + simp only [mul_apply, mem_support_iff.mp yf, hr, mem_support_iff, sum_single_index, + finsupp.sum_ite_eq', ne.def, not_false_iff, if_true, mul_zero, if_t_t, sum_zero, rx.eq_iff] +end + +lemma support_mul [has_mul G] [decidable_eq G] (a b : monoid_algebra k G) : + (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ * a₂}) := +subset.trans support_sum $ bUnion_mono $ assume a₁ _, + subset.trans support_sum $ bUnion_mono $ assume a₂ _, support_single_subset + +lemma support_mul_single [right_cancel_semigroup G] + (f : monoid_algebra k G) (r : k) (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) : + (f * single x r).support = f.support.map (mul_right_embedding x) := +begin + classical, + ext, + simp only [support_mul_single_eq_image f hr (is_right_regular_of_right_cancel_semigroup x), + mem_image, mem_map, mul_right_embedding_apply], +end + +lemma support_single_mul [left_cancel_semigroup G] + (f : monoid_algebra k G) (r : k) (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) : + (single x r * f : monoid_algebra k G).support = f.support.map (mul_left_embedding x) := +begin + classical, + ext, + simp only [support_single_mul_eq_image f hr (is_left_regular_of_left_cancel_semigroup x), + mem_image, mem_map, mul_left_embedding_apply], +end + +section span + +variables [mul_one_class G] + +/-- An element of `monoid_algebra k G` is in the subalgebra generated by its support. -/ +lemma mem_span_support (f : monoid_algebra k G) : + f ∈ submodule.span k (of k G '' (f.support : set G)) := +by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported] + +end span + +end monoid_algebra + +namespace add_monoid_algebra + +open finset finsupp mul_opposite +variables {k : Type u₁} {G : Type u₂} [semiring k] + +lemma support_mul [decidable_eq G] [has_add G] (a b : add_monoid_algebra k G) : + (a * b).support ⊆ a.support.bUnion (λa₁, b.support.bUnion $ λa₂, {a₁ + a₂}) := +@monoid_algebra.support_mul k (multiplicative G) _ _ _ _ _ + +lemma support_mul_single [add_right_cancel_semigroup G] + (f : add_monoid_algebra k G) (r : k) (hr : ∀ y, y * r = 0 ↔ y = 0) (x : G) : + (f * single x r : add_monoid_algebra k G).support = f.support.map (add_right_embedding x) := +@monoid_algebra.support_mul_single k (multiplicative G) _ _ _ _ hr _ + +lemma support_single_mul [add_left_cancel_semigroup G] + (f : add_monoid_algebra k G) (r : k) (hr : ∀ y, r * y = 0 ↔ y = 0) (x : G) : + (single x r * f : add_monoid_algebra k G).support = f.support.map (add_left_embedding x) := +@monoid_algebra.support_single_mul k (multiplicative G) _ _ _ _ hr _ + +section span + +/-- An element of `add_monoid_algebra k G` is in the submodule generated by its support. -/ +lemma mem_span_support [add_zero_class G] (f : add_monoid_algebra k G) : + f ∈ submodule.span k (of k G '' (f.support : set G)) := +by rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported] + +/-- An element of `add_monoid_algebra k G` is in the subalgebra generated by its support, using +unbundled inclusion. -/ +lemma mem_span_support' (f : add_monoid_algebra k G) : + f ∈ submodule.span k (of' k G '' (f.support : set G)) := +by rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported] + +end span + +end add_monoid_algebra diff --git a/src/algebra/monoid_algebra/to_direct_sum.lean b/src/algebra/monoid_algebra/to_direct_sum.lean index 4f43e85416d37..4a42590b85905 100644 --- a/src/algebra/monoid_algebra/to_direct_sum.lean +++ b/src/algebra/monoid_algebra/to_direct_sum.lean @@ -10,6 +10,9 @@ import data.finsupp.to_dfinsupp /-! # Conversion between `add_monoid_algebra` and homogenous `direct_sum` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides conversions between `add_monoid_algebra` and `direct_sum`. The latter is essentially a dependent version of the former. diff --git a/src/algebra/ne_zero.lean b/src/algebra/ne_zero.lean index 932e7e6ede88f..f2bb34bca6feb 100644 --- a/src/algebra/ne_zero.lean +++ b/src/algebra/ne_zero.lean @@ -3,12 +3,14 @@ Copyright (c) 2021 Eric Rodriguez. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Rodriguez -/ -import algebra.algebra.basic -import algebra.char_p.basic +import logic.basic /-! # `ne_zero` typeclass +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We create a typeclass `ne_zero n` which carries around the fact that `(n : R) ≠ 0`. ## Main declarations @@ -22,8 +24,7 @@ class ne_zero {R} [has_zero R] (n : R) : Prop := (out : n ≠ 0) lemma ne_zero.ne {R} [has_zero R] (n : R) [h : ne_zero n] : n ≠ 0 := h.out -lemma ne_zero.ne' (n : ℕ) (R) [has_zero R] [has_one R] [has_add R] [h : ne_zero (n : R)] : - (n : R) ≠ 0 := h.out +lemma ne_zero.ne' {R} [has_zero R] (n : R) [h : ne_zero n] : 0 ≠ n := h.out.symm lemma ne_zero_iff {R : Type*} [has_zero R] {n : R} : ne_zero n ↔ n ≠ 0 := ⟨λ h, h.out, ne_zero.mk⟩ @@ -31,56 +32,44 @@ lemma ne_zero_iff {R : Type*} [has_zero R] {n : R} : ne_zero n ↔ n ≠ 0 := lemma not_ne_zero {R : Type*} [has_zero R] {n : R} : ¬ ne_zero n ↔ n = 0 := by simp [ne_zero_iff] -namespace ne_zero - -variables {R S M F : Type*} {r : R} {x y : M} {n p : ℕ} {a : ℕ+} +lemma eq_zero_or_ne_zero {α} [has_zero α] (a : α) : a = 0 ∨ ne_zero a := +(eq_or_ne a 0).imp_right ne_zero.mk -instance pnat : ne_zero (a : ℕ) := ⟨a.ne_zero⟩ -instance succ : ne_zero (n + 1) := ⟨n.succ_ne_zero⟩ +section +variables {α : Type*} [has_zero α] [has_one α] -lemma of_pos [preorder M] [has_zero M] (h : 0 < x) : ne_zero x := ⟨h.ne'⟩ -lemma of_gt [canonically_ordered_add_monoid M] (h : x < y) : ne_zero y := of_pos $ pos_of_gt h +@[simp] lemma zero_ne_one [ne_zero (1 : α)] : (0 : α) ≠ 1 := ne_zero.ne' (1 : α) +@[simp] lemma one_ne_zero [ne_zero (1 : α)] : (1 : α) ≠ 0 := ne_zero.ne (1 : α) +lemma two_ne_zero [has_add α] [ne_zero (2 : α)] : (2 : α) ≠ 0 := ne_zero.ne (2 : α) +lemma three_ne_zero [has_add α] [ne_zero (3 : α)] : (3 : α) ≠ 0 := ne_zero.ne (3 : α) +lemma four_ne_zero [has_add α] [ne_zero (4 : α)] : (4 : α) ≠ 0 := ne_zero.ne (4 : α) -instance char_zero [ne_zero n] [add_monoid M] [has_one M] [char_zero M] : ne_zero (n : M) := -⟨nat.cast_ne_zero.mpr $ ne_zero.ne n⟩ +lemma ne_zero_of_eq_one [ne_zero (1 : α)] {a : α} (h : a = 1) : a ≠ 0 := +calc a = 1 : h + ... ≠ 0 : one_ne_zero -@[priority 100] instance invertible [mul_zero_one_class M] [nontrivial M] [invertible x] : - ne_zero x := ⟨nonzero_of_invertible x⟩ +variable (α) -instance coe_trans {r : R} [has_zero M] [has_coe R S] [has_coe_t S M] [h : ne_zero (r : M)] : - ne_zero ((r : S) : M) := ⟨h.out⟩ - -lemma trans {r : R} [has_zero M] [has_coe R S] [has_coe_t S M] (h : ne_zero ((r : S) : M)) : - ne_zero (r : M) := ⟨h.out⟩ +lemma zero_ne_one' [ne_zero (1 : α)] : (0 : α) ≠ 1 := ne_zero.ne' (1 : α) +lemma one_ne_zero' [ne_zero (1 : α)] : (1 : α) ≠ 0 := ne_zero.ne (1 : α) +lemma two_ne_zero' [has_add α] [ne_zero (2 : α)] : (2 : α) ≠ 0 := ne_zero.ne (2 : α) +lemma three_ne_zero' [has_add α] [ne_zero (3 : α)] : (3 : α) ≠ 0 := ne_zero.ne (3 : α) +lemma four_ne_zero' [has_add α] [ne_zero (4 : α)] : (4 : α) ≠ 0 := ne_zero.ne (4 : α) -lemma of_map [has_zero R] [has_zero M] [zero_hom_class F R M] (f : F) [ne_zero (f r)] : - ne_zero r := ⟨λ h, ne (f r) $ by convert map_zero f⟩ +end -lemma of_injective {r : R} [has_zero R] [h : ne_zero r] [has_zero M] [zero_hom_class F R M] - {f : F} (hf : function.injective f) : ne_zero (f r) := -⟨by { rw ←map_zero f, exact hf.ne (ne r) }⟩ - -lemma nat_of_injective [non_assoc_semiring M] [non_assoc_semiring R] [h : ne_zero (n : R)] - [ring_hom_class F R M] {f : F} (hf : function.injective f) : ne_zero (n : M) := - ⟨λ h, (ne_zero.ne' n R) $ hf $ by simpa⟩ - -variables (R M) +namespace ne_zero -lemma of_not_dvd [add_monoid M] [has_one M] [char_p M p] (h : ¬ p ∣ n) : ne_zero (n : M) := -⟨(not_iff_not.mpr $ char_p.cast_eq_zero_iff M p n).mpr h⟩ +variables {R S M F : Type*} {r : R} {x y : M} {n p : ℕ} --{a : ℕ+} -lemma of_no_zero_smul_divisors (n : ℕ) [comm_ring R] [ne_zero (n : R)] [ring M] [nontrivial M] - [algebra R M] [no_zero_smul_divisors R M] : ne_zero (n : M) := -nat_of_injective $ no_zero_smul_divisors.algebra_map_injective R M +instance succ : ne_zero (n + 1) := ⟨n.succ_ne_zero⟩ -lemma of_ne_zero_coe [has_zero R] [has_one R] [has_add R] [h : ne_zero (n : R)] : ne_zero n := -⟨by {casesI h, rintro rfl, contradiction}⟩ +lemma of_pos [preorder M] [has_zero M] (h : 0 < x) : ne_zero x := ⟨ne_of_gt h⟩ -lemma not_char_dvd [add_monoid R] [has_one R] (p : ℕ) [char_p R p] (k : ℕ) [h : ne_zero (k : R)] : - ¬ p ∣ k := -by rwa [←not_iff_not.mpr $ char_p.cast_eq_zero_iff R p k, ←ne.def, ←ne_zero_iff] +instance coe_trans [has_zero M] [has_coe R S] [has_coe_t S M] [h : ne_zero (r : M)] : + ne_zero ((r : S) : M) := ⟨h.out⟩ -lemma pos_of_ne_zero_coe [has_zero R] [has_one R] [has_add R] [ne_zero (n : R)] : 0 < n := -(ne_zero.of_ne_zero_coe R).out.bot_lt +lemma trans [has_zero M] [has_coe R S] [has_coe_t S M] (h : ne_zero ((r : S) : M)) : + ne_zero (r : M) := ⟨h.out⟩ end ne_zero diff --git a/src/algebra/opposites.lean b/src/algebra/opposites.lean index f9e50bdb68f9d..b3b6f1ab73b4a 100644 --- a/src/algebra/opposites.lean +++ b/src/algebra/opposites.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ import algebra.group.defs -import logic.equiv.basic +import logic.equiv.defs import logic.nontrivial /-! # Multiplicative opposite and algebraic operations on it +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `mul_opposite α = αᵐᵒᵖ` to be the multiplicative opposite of `α`. It inherits all additive algebraic structures on `α` (in other files), and reverses the order of multipliers in multiplicative structures, i.e., `op (x * y) = op y * op x`, where `mul_opposite.op` is the @@ -118,7 +121,7 @@ instance [has_involutive_neg α] : has_involutive_neg αᵐᵒᵖ := { inv_inv := λ a, unop_injective $ inv_inv _, ..mul_opposite.has_inv α } -@[to_additive] instance (R : Type*) [has_scalar R α] : has_scalar R αᵐᵒᵖ := +@[to_additive] instance (R : Type*) [has_smul R α] : has_smul R αᵐᵒᵖ := { smul := λ c x, op (c • unop x) } section @@ -147,10 +150,10 @@ variable {α} @[simp] lemma op_sub [has_sub α] (x y : α) : op (x - y) = op x - op y := rfl @[simp] lemma unop_sub [has_sub α] (x y : αᵐᵒᵖ) : unop (x - y) = unop x - unop y := rfl -@[simp, to_additive] lemma op_smul {R : Type*} [has_scalar R α] (c : R) (a : α) : +@[simp, to_additive] lemma op_smul {R : Type*} [has_smul R α] (c : R) (a : α) : op (c • a) = c • op a := rfl -@[simp, to_additive] lemma unop_smul {R : Type*} [has_scalar R α] (c : R) (a : αᵐᵒᵖ) : +@[simp, to_additive] lemma unop_smul {R : Type*} [has_smul R α] (c : R) (a : αᵐᵒᵖ) : unop (c • a) = c • unop a := rfl end @@ -206,6 +209,6 @@ instance [has_involutive_inv α] : has_involutive_inv αᵃᵒᵖ := instance [has_div α] : has_div αᵃᵒᵖ := { div := λ a b, op (unop a / unop b) } @[simp] lemma op_div [has_div α] (a b : α) : op (a / b) = op a / op b := rfl -@[simp] lemma unop_div [has_div α] (a b : α) : unop (a / b) = unop a / unop b := rfl +@[simp] lemma unop_div [has_div α] (a b : αᵃᵒᵖ) : unop (a / b) = unop a / unop b := rfl end add_opposite diff --git a/src/algebra/order/absolute_value.lean b/src/algebra/order/absolute_value.lean index e17a13b6e4dd6..ab4188ad4df84 100644 --- a/src/algebra/order/absolute_value.lean +++ b/src/algebra/order/absolute_value.lean @@ -3,11 +3,17 @@ Copyright (c) 2021 Anne Baanen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Anne Baanen -/ -import algebra.order.field +import algebra.group_with_zero.units.lemmas +import algebra.order.field.defs +import algebra.order.hom.basic +import algebra.ring.regular /-! # Absolute values +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a bundled type of absolute values `absolute_value R S`. ## Main definitions @@ -31,13 +37,41 @@ namespace absolute_value attribute [nolint doc_blame] absolute_value.to_mul_hom -initialize_simps_projections absolute_value (to_mul_hom_to_fun → apply) - section ordered_semiring +section semiring + variables {R S : Type*} [semiring R] [ordered_semiring S] (abv : absolute_value R S) -instance : has_coe_to_fun (absolute_value R S) (λ f, R → S) := ⟨λ f, f.to_fun⟩ +instance zero_hom_class : zero_hom_class (absolute_value R S) R S := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' }, + map_zero := λ f, (f.eq_zero' _).2 rfl } + +instance mul_hom_class : mul_hom_class (absolute_value R S) R S := +{ map_mul := λ f, f.map_mul' + ..absolute_value.zero_hom_class } + +instance nonneg_hom_class : nonneg_hom_class (absolute_value R S) R S := +{ map_nonneg := λ f, f.nonneg', + ..absolute_value.zero_hom_class } + +instance subadditive_hom_class : subadditive_hom_class (absolute_value R S) R S := +{ map_add_le_add := λ f, f.add_le', + ..absolute_value.zero_hom_class } + +@[simp] lemma coe_mk (f : R →ₙ* S) {h₁ h₂ h₃} : ((absolute_value.mk f h₁ h₂ h₃) : R → S) = f := rfl + +@[ext] lemma ext ⦃f g : absolute_value R S⦄ : (∀ x, f x = g x) → f = g := fun_like.ext _ _ + +/-- See Note [custom simps projection]. -/ +def simps.apply (f : absolute_value R S) : R → S := f + +initialize_simps_projections absolute_value (to_mul_hom_to_fun → apply) + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +instance : has_coe_to_fun (absolute_value R S) (λ f, R → S) := fun_like.has_coe_to_fun @[simp] lemma coe_to_mul_hom : ⇑abv.to_mul_hom = abv := rfl @@ -46,6 +80,8 @@ protected theorem nonneg (x : R) : 0 ≤ abv x := abv.nonneg' x protected theorem add_le (x y : R) : abv (x + y) ≤ abv x + abv y := abv.add_le' x y @[simp] protected theorem map_mul (x y : R) : abv (x * y) = abv x * abv y := abv.map_mul' x y +protected theorem ne_zero_iff {x : R} : abv x ≠ 0 ↔ x ≠ 0 := abv.eq_zero.not + protected theorem pos {x : R} (hx : x ≠ 0) : 0 < abv x := lt_of_le_of_ne (abv.nonneg x) (ne.symm $ mt abv.eq_zero.mp hx) @@ -54,73 +90,78 @@ lt_of_le_of_ne (abv.nonneg x) (ne.symm $ mt abv.eq_zero.mp hx) protected theorem ne_zero {x : R} (hx : x ≠ 0) : abv x ≠ 0 := (abv.pos hx).ne' +theorem map_one_of_is_regular (h : is_left_regular (abv 1)) : abv 1 = 1 := +h $ by simp [←abv.map_mul] + @[simp] protected theorem map_zero : abv 0 = 0 := abv.eq_zero.2 rfl -end ordered_semiring +end semiring -section ordered_ring +section ring -variables {R S : Type*} [ring R] [ordered_ring S] (abv : absolute_value R S) +variables {R S : Type*} [ring R] [ordered_semiring S] (abv : absolute_value R S) protected lemma sub_le (a b c : R) : abv (a - c) ≤ abv (a - b) + abv (b - c) := by simpa [sub_eq_add_neg, add_assoc] using abv.add_le (a - b) (b - c) -protected lemma le_sub (a b : R) : abv a - abv b ≤ abv (a - b) := -sub_le_iff_le_add.2 $ by simpa using abv.add_le (a - b) b - @[simp] lemma map_sub_eq_zero_iff (a b : R) : abv (a - b) = 0 ↔ a = b := abv.eq_zero.trans sub_eq_zero -end ordered_ring +end ring -section linear_ordered_ring +end ordered_semiring -variables {R S : Type*} [semiring R] [linear_ordered_ring S] (abv : absolute_value R S) +section ordered_ring -/-- `absolute_value.abs` is `abs` as a bundled `absolute_value`. -/ -@[simps] -protected def abs : absolute_value S S := -{ to_fun := abs, - nonneg' := abs_nonneg, - eq_zero' := λ _, abs_eq_zero, - add_le' := abs_add, - map_mul' := abs_mul } +section semiring -instance : inhabited (absolute_value S S) := ⟨absolute_value.abs⟩ +section is_domain -variables [nontrivial R] +-- all of these are true for `no_zero_divisors S`; but it doesn't work smoothly with the +-- `is_domain`/`cancel_monoid_with_zero` API +variables {R S : Type*} [semiring R] [ordered_ring S] (abv : absolute_value R S) +variables [is_domain S] [nontrivial R] @[simp] protected theorem map_one : abv 1 = 1 := -(mul_right_inj' $ abv.ne_zero one_ne_zero).1 $ -by rw [← abv.map_mul, mul_one, mul_one] +abv.map_one_of_is_regular ((is_regular_of_ne_zero $ abv.ne_zero one_ne_zero).left) + +instance : monoid_with_zero_hom_class (absolute_value R S) R S := +{ map_zero := λ f, f.map_zero, + map_one := λ f, f.map_one, + ..absolute_value.mul_hom_class } /-- Absolute values from a nontrivial `R` to a linear ordered ring preserve `*`, `0` and `1`. -/ -def to_monoid_with_zero_hom : R →*₀ S := -{ to_fun := abv, - map_zero' := abv.map_zero, - map_one' := abv.map_one, - .. abv } +def to_monoid_with_zero_hom : R →*₀ S := abv @[simp] lemma coe_to_monoid_with_zero_hom : ⇑abv.to_monoid_with_zero_hom = abv := rfl /-- Absolute values from a nontrivial `R` to a linear ordered ring preserve `*` and `1`. -/ -def to_monoid_hom : monoid_hom R S := -{ to_fun := abv, - map_one' := abv.map_one, - .. abv } +def to_monoid_hom : R →* S := abv @[simp] lemma coe_to_monoid_hom : ⇑abv.to_monoid_hom = abv := rfl @[simp] protected lemma map_pow (a : R) (n : ℕ) : abv (a ^ n) = abv a ^ n := abv.to_monoid_hom.map_pow a n -end linear_ordered_ring +end is_domain -section linear_ordered_comm_ring +end semiring section ring -variables {R S : Type*} [ring R] [linear_ordered_comm_ring S] (abv : absolute_value R S) +variables {R S : Type*} [ring R] [ordered_ring S] (abv : absolute_value R S) + +protected lemma le_sub (a b : R) : abv a - abv b ≤ abv (a - b) := +sub_le_iff_le_add.2 $ by simpa using abv.add_le (a - b) b + +end ring + +end ordered_ring + +section ordered_comm_ring + +variables {R S : Type*} [ring R] [ordered_comm_ring S] (abv : absolute_value R S) +variables [no_zero_divisors S] @[simp] protected theorem map_neg (a : R) : abv (-a) = abv a := begin @@ -133,33 +174,42 @@ end protected theorem map_sub (a b : R) : abv (a - b) = abv (b - a) := by rw [← neg_sub, abv.map_neg] -lemma abs_abv_sub_le_abv_sub (a b : R) : - abs (abv a - abv b) ≤ abv (a - b) := -abs_sub_le_iff.2 ⟨abv.le_sub _ _, by rw abv.map_sub; apply abv.le_sub⟩ +end ordered_comm_ring -end ring +instance {R S : Type*} [ring R] [ordered_comm_ring S] [nontrivial R] [is_domain S] : + mul_ring_norm_class (absolute_value R S) R S := +{ map_neg_eq_map := λ f, f.map_neg, + eq_zero_of_map_eq_zero := λ f a, f.eq_zero.1, + ..absolute_value.subadditive_hom_class, ..absolute_value.monoid_with_zero_hom_class } -end linear_ordered_comm_ring +section linear_ordered_ring -section linear_ordered_field +variables {R S : Type*} [semiring R] [linear_ordered_ring S] (abv : absolute_value R S) -section field +/-- `absolute_value.abs` is `abs` as a bundled `absolute_value`. -/ +@[simps] +protected def abs : absolute_value S S := +{ to_fun := abs, + nonneg' := abs_nonneg, + eq_zero' := λ _, abs_eq_zero, + add_le' := abs_add, + map_mul' := abs_mul } -variables {R S : Type*} [division_ring R] [linear_ordered_field S] (abv : absolute_value R S) +instance : inhabited (absolute_value S S) := ⟨absolute_value.abs⟩ -@[simp] protected theorem map_inv (a : R) : abv a⁻¹ = (abv a)⁻¹ := -abv.to_monoid_with_zero_hom.map_inv a +end linear_ordered_ring -@[simp] protected theorem map_div (a b : R) : abv (a / b) = abv a / abv b := -abv.to_monoid_with_zero_hom.map_div a b +section linear_ordered_comm_ring -end field +variables {R S : Type*} [ring R] [linear_ordered_comm_ring S] (abv : absolute_value R S) -end linear_ordered_field +lemma abs_abv_sub_le_abv_sub (a b : R) : + abs (abv a - abv b) ≤ abv (a - b) := +abs_sub_le_iff.2 ⟨abv.le_sub _ _, by rw abv.map_sub; apply abv.le_sub⟩ -end absolute_value +end linear_ordered_comm_ring -section is_absolute_value +end absolute_value /-- A function `f` is an absolute value if it is nonnegative, zero only at 0, additive, and multiplicative. @@ -181,7 +231,7 @@ variables {S : Type*} [ordered_semiring S] variables {R : Type*} [semiring R] (abv : R → S) [is_absolute_value abv] /-- A bundled absolute value is an absolute value. -/ -instance absolute_value.is_absolute_value +instance _root_.absolute_value.is_absolute_value (abv : absolute_value R S) : is_absolute_value abv := { abv_nonneg := abv.nonneg, abv_eq_zero := λ _, abv.eq_zero, @@ -197,88 +247,118 @@ def to_absolute_value : absolute_value R S := nonneg' := abv_nonneg abv, map_mul' := abv_mul abv } -theorem abv_zero : abv 0 = 0 := (abv_eq_zero abv).2 rfl - -theorem abv_pos {a : R} : 0 < abv a ↔ a ≠ 0 := -by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [abv_eq_zero abv, abv_nonneg abv] +theorem abv_zero : abv 0 = 0 := (to_absolute_value abv).map_zero +theorem abv_pos {a : R} : 0 < abv a ↔ a ≠ 0 := (to_absolute_value abv).pos_iff end ordered_semiring section linear_ordered_ring variables {S : Type*} [linear_ordered_ring S] -variables {R : Type*} [semiring R] (abv : R → S) [is_absolute_value abv] -instance abs_is_absolute_value {S} [linear_ordered_ring S] : - is_absolute_value (abs : S → S) := -{ abv_nonneg := abs_nonneg, - abv_eq_zero := λ _, abs_eq_zero, - abv_add := abs_add, - abv_mul := abs_mul } +instance abs_is_absolute_value : is_absolute_value (abs : S → S) := + absolute_value.abs.is_absolute_value end linear_ordered_ring -section linear_ordered_comm_ring +section ordered_ring -variables {S : Type*} [linear_ordered_comm_ring S] +variables {S : Type*} [ordered_ring S] section semiring + variables {R : Type*} [semiring R] (abv : R → S) [is_absolute_value abv] -theorem abv_one [nontrivial R] : abv 1 = 1 := -(mul_right_inj' $ mt (abv_eq_zero abv).1 one_ne_zero).1 $ -by rw [← abv_mul abv, mul_one, mul_one] +variables [is_domain S] + +theorem abv_one [nontrivial R] : abv 1 = 1 := (to_absolute_value abv).map_one /-- `abv` as a `monoid_with_zero_hom`. -/ -def abv_hom [nontrivial R] : R →*₀ S := ⟨abv, abv_zero abv, abv_one abv, abv_mul abv⟩ +def abv_hom [nontrivial R] : R →*₀ S := (to_absolute_value abv).to_monoid_with_zero_hom lemma abv_pow [nontrivial R] (abv : R → S) [is_absolute_value abv] (a : R) (n : ℕ) : abv (a ^ n) = abv a ^ n := -(abv_hom abv).to_monoid_hom.map_pow a n +(to_absolute_value abv).map_pow a n end semiring -end linear_ordered_comm_ring +section ring -section linear_ordered_field -variables {S : Type*} [linear_ordered_field S] +variables {R : Type*} [ring R] (abv : R → S) [is_absolute_value abv] + +lemma abv_sub_le (a b c : R) : abv (a - c) ≤ abv (a - b) + abv (b - c) := +by simpa [sub_eq_add_neg, add_assoc] using abv_add abv (a - b) (b - c) + +lemma sub_abv_le_abv_sub (a b : R) : abv a - abv b ≤ abv (a - b) := +(to_absolute_value abv).le_sub a b + +end ring + +end ordered_ring + +section ordered_comm_ring + +variables {S : Type*} [ordered_comm_ring S] section ring + variables {R : Type*} [ring R] (abv : R → S) [is_absolute_value abv] +variables [no_zero_divisors S] + theorem abv_neg (a : R) : abv (-a) = abv a := -by rw [← mul_self_inj_of_nonneg (abv_nonneg abv _) (abv_nonneg abv _), -← abv_mul abv, ← abv_mul abv]; simp +(to_absolute_value abv).map_neg a theorem abv_sub (a b : R) : abv (a - b) = abv (b - a) := -by rw [← neg_sub, abv_neg abv] +(to_absolute_value abv).map_sub a b -lemma abv_sub_le (a b c : R) : abv (a - c) ≤ abv (a - b) + abv (b - c) := -by simpa [sub_eq_add_neg, add_assoc] using abv_add abv (a - b) (b - c) +end ring -lemma sub_abv_le_abv_sub (a b : R) : abv a - abv b ≤ abv (a - b) := -sub_le_iff_le_add.2 $ by simpa using abv_add abv (a - b) b +end ordered_comm_ring + +section linear_ordered_comm_ring + +variables {S : Type*} [linear_ordered_comm_ring S] + +section ring + +variables {R : Type*} [ring R] (abv : R → S) [is_absolute_value abv] lemma abs_abv_sub_le_abv_sub (a b : R) : abs (abv a - abv b) ≤ abv (a - b) := -abs_sub_le_iff.2 ⟨sub_abv_le_abv_sub abv _ _, - by rw abv_sub abv; apply sub_abv_le_abv_sub abv⟩ +(to_absolute_value abv).abs_abv_sub_le_abv_sub a b + end ring -section field -variables {R : Type*} [division_ring R] (abv : R → S) [is_absolute_value abv] +end linear_ordered_comm_ring + +section linear_ordered_field -theorem abv_inv (a : R) : abv a⁻¹ = (abv a)⁻¹ := -(abv_hom abv).map_inv a +variables {S : Type*} [linear_ordered_semifield S] -theorem abv_div (a b : R) : abv (a / b) = abv a / abv b := -(abv_hom abv).map_div a b +section semiring -end field +variables {R : Type*} [semiring R] [nontrivial R] (abv : R → S) [is_absolute_value abv] -end linear_ordered_field +lemma abv_one' : abv 1 = 1 := +(to_absolute_value abv).map_one_of_is_regular + $ (is_regular_of_ne_zero $ (to_absolute_value abv).ne_zero one_ne_zero).left -end is_absolute_value +/-- An absolute value as a monoid with zero homomorphism, assuming the target is a semifield. -/ +def abv_hom' : R →*₀ S := ⟨abv, abv_zero abv, abv_one' abv, abv_mul abv⟩ + +end semiring + +section division_semiring + +variables {R : Type*} [division_semiring R] (abv : R → S) [is_absolute_value abv] + +theorem abv_inv (a : R) : abv a⁻¹ = (abv a)⁻¹ := map_inv₀ (abv_hom' abv) a +theorem abv_div (a b : R) : abv (a / b) = abv a / abv b := map_div₀ (abv_hom' abv) a b + +end division_semiring + +end linear_ordered_field end is_absolute_value diff --git a/src/algebra/order/algebra.lean b/src/algebra/order/algebra.lean index cc23ac67fb579..e240d5ae97712 100644 --- a/src/algebra/order/algebra.lean +++ b/src/algebra/order/algebra.lean @@ -10,6 +10,9 @@ import algebra.order.smul /-! # Ordered algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An ordered algebra is an ordered semiring, which is an algebra over an ordered commutative semiring, for which scalar multiplication is "compatible" with the two orders. @@ -45,13 +48,3 @@ begin end end ordered_algebra - -section instances - -variables {R : Type*} [linear_ordered_comm_ring R] - -instance linear_ordered_comm_ring.to_ordered_smul : ordered_smul R R := -{ smul_lt_smul_of_pos := ordered_semiring.mul_lt_mul_of_pos_left, - lt_of_smul_lt_smul_of_pos := λ a b c w₁ w₂, (mul_lt_mul_left w₂).mp w₁ } - -end instances diff --git a/src/algebra/order/archimedean.lean b/src/algebra/order/archimedean.lean index 3a307b1cb2281..3fa825a3a4457 100644 --- a/src/algebra/order/archimedean.lean +++ b/src/algebra/order/archimedean.lean @@ -3,13 +3,15 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import algebra.field_power import data.int.least_greatest import data.rat.floor /-! # Archimedean groups and fields. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the archimedean property for ordered groups and proves several results connected to this notion. Being archimedean means that for all elements `x` and `y>0` there exists a natural number `n` such that `x ≤ n • y`. @@ -20,8 +22,6 @@ number `n` such that `x ≤ n • y`. property. * `archimedean.floor_ring` defines a floor function on an archimedean linearly ordered ring making it into a `floor_ring`. -* `round` defines a function rounding to the nearest integer for a linearly ordered field which is - also a floor ring. ## Main statements @@ -71,36 +71,46 @@ lemma exists_unique_zsmul_near_of_pos' {a : α} (ha : 0 < a) (g : α) : by simpa only [sub_nonneg, add_zsmul, one_zsmul, sub_lt_iff_lt_add'] using exists_unique_zsmul_near_of_pos ha g +lemma exists_unique_sub_zsmul_mem_Ico {a : α} (ha : 0 < a) (b c : α) : + ∃! m : ℤ, b - m • a ∈ set.Ico c (c + a) := +by simpa only [mem_Ico, le_sub_iff_add_le, zero_add, add_comm c, sub_lt_iff_lt_add', add_assoc] + using exists_unique_zsmul_near_of_pos' ha (b - c) + lemma exists_unique_add_zsmul_mem_Ico {a : α} (ha : 0 < a) (b c : α) : ∃! m : ℤ, b + m • a ∈ set.Ico c (c + a) := (equiv.neg ℤ).bijective.exists_unique_iff.2 $ - by simpa only [equiv.neg_apply, mem_Ico, neg_zsmul, ← sub_eq_add_neg, le_sub_iff_add_le, zero_add, - add_comm c, sub_lt_iff_lt_add', add_assoc] using exists_unique_zsmul_near_of_pos' ha (b - c) + by simpa only [equiv.neg_apply, neg_zsmul, ← sub_eq_add_neg] + using exists_unique_sub_zsmul_mem_Ico ha b c lemma exists_unique_add_zsmul_mem_Ioc {a : α} (ha : 0 < a) (b c : α) : ∃! m : ℤ, b + m • a ∈ set.Ioc c (c + a) := (equiv.add_right (1 : ℤ)).bijective.exists_unique_iff.2 $ - by simpa only [add_zsmul, sub_lt_iff_lt_add', le_sub_iff_add_le', ← add_assoc, and.comm, mem_Ioc, - equiv.coe_add_right, one_zsmul, add_le_add_iff_right] + by simpa only [add_one_zsmul, sub_lt_iff_lt_add', le_sub_iff_add_le', ← add_assoc, and.comm, + mem_Ioc, equiv.coe_add_right, add_le_add_iff_right] using exists_unique_zsmul_near_of_pos ha (c - b) +lemma exists_unique_sub_zsmul_mem_Ioc {a : α} (ha : 0 < a) (b c : α) : + ∃! m : ℤ, b - m • a ∈ set.Ioc c (c + a) := +(equiv.neg ℤ).bijective.exists_unique_iff.2 $ + by simpa only [equiv.neg_apply, neg_zsmul, sub_neg_eq_add] + using exists_unique_add_zsmul_mem_Ioc ha b c + end linear_ordered_add_comm_group -theorem exists_nat_gt [ordered_semiring α] [nontrivial α] [archimedean α] - (x : α) : ∃ n : ℕ, x < n := +theorem exists_nat_gt [strict_ordered_semiring α] [archimedean α] (x : α) : ∃ n : ℕ, x < n := let ⟨n, h⟩ := archimedean.arch x zero_lt_one in ⟨n+1, lt_of_le_of_lt (by rwa ← nsmul_one) (nat.cast_lt.2 (nat.lt_succ_self _))⟩ -theorem exists_nat_ge [ordered_semiring α] [archimedean α] (x : α) : +theorem exists_nat_ge [strict_ordered_semiring α] [archimedean α] (x : α) : ∃ n : ℕ, x ≤ n := begin nontriviality α, exact (exists_nat_gt x).imp (λ n, le_of_lt) end -lemma add_one_pow_unbounded_of_pos [ordered_semiring α] [nontrivial α] [archimedean α] - (x : α) {y : α} (hy : 0 < y) : +lemma add_one_pow_unbounded_of_pos [strict_ordered_semiring α] [archimedean α] (x : α) {y : α} + (hy : 0 < y) : ∃ n : ℕ, x < (y + 1) ^ n := have 0 ≤ 1 + y, from add_nonneg zero_le_one hy.le, let ⟨n, h⟩ := archimedean.arch x hy in @@ -111,28 +121,15 @@ let ⟨n, h⟩ := archimedean.arch x hy in (add_nonneg zero_le_two hy.le) _ ... = (y + 1) ^ n : by rw [add_comm]⟩ -section linear_ordered_ring -variables [linear_ordered_ring α] [archimedean α] +section strict_ordered_ring +variables [strict_ordered_ring α] [archimedean α] lemma pow_unbounded_of_one_lt (x : α) {y : α} (hy1 : 1 < y) : ∃ n : ℕ, x < y ^ n := sub_add_cancel y 1 ▸ add_one_pow_unbounded_of_pos _ (sub_pos.2 hy1) -/-- Every x greater than or equal to 1 is between two successive -natural-number powers of every y greater than one. -/ -lemma exists_nat_pow_near {x : α} {y : α} (hx : 1 ≤ x) (hy : 1 < y) : - ∃ n : ℕ, y ^ n ≤ x ∧ x < y ^ (n + 1) := -have h : ∃ n : ℕ, x < y ^ n, from pow_unbounded_of_one_lt _ hy, -by classical; exact let n := nat.find h in - have hn : x < y ^ n, from nat.find_spec h, - have hnp : 0 < n, from pos_iff_ne_zero.2 (λ hn0, - by rw [hn0, pow_zero] at hn; exact (not_le_of_gt hn hx)), - have hnsp : nat.pred n + 1 = n, from nat.succ_pred_eq_of_pos hnp, - have hltn : nat.pred n < n, from nat.pred_lt (ne_of_gt hnp), - ⟨nat.pred n, le_of_not_lt (nat.find_min h hltn), by rwa hnsp⟩ - theorem exists_int_gt (x : α) : ∃ n : ℤ, x < n := -let ⟨n, h⟩ := exists_nat_gt x in ⟨n, by rwa ← coe_coe⟩ +let ⟨n, h⟩ := exists_nat_gt x in ⟨n, by rwa int.cast_coe_nat⟩ theorem exists_int_lt (x : α) : ∃ n : ℤ, (n : α) < x := let ⟨n, h⟩ := exists_int_gt (-x) in ⟨-n, by rw int.cast_neg; exact neg_lt.1 h⟩ @@ -151,22 +148,37 @@ begin exact ⟨λ h, le_trans (int.cast_le.2 h) h₁, h₂ z⟩, end +end strict_ordered_ring + +section linear_ordered_ring +variables [linear_ordered_ring α] [archimedean α] + +/-- Every x greater than or equal to 1 is between two successive +natural-number powers of every y greater than one. -/ +lemma exists_nat_pow_near {x : α} {y : α} (hx : 1 ≤ x) (hy : 1 < y) : + ∃ n : ℕ, y ^ n ≤ x ∧ x < y ^ (n + 1) := +have h : ∃ n : ℕ, x < y ^ n, from pow_unbounded_of_one_lt _ hy, +by classical; exact let n := nat.find h in + have hn : x < y ^ n, from nat.find_spec h, + have hnp : 0 < n, from pos_iff_ne_zero.2 (λ hn0, + by rw [hn0, pow_zero] at hn; exact (not_le_of_gt hn hx)), + have hnsp : nat.pred n + 1 = n, from nat.succ_pred_eq_of_pos hnp, + have hltn : nat.pred n < n, from nat.pred_lt (ne_of_gt hnp), + ⟨nat.pred n, le_of_not_lt (nat.find_min h hltn), by rwa hnsp⟩ + end linear_ordered_ring section linear_ordered_field - -variables [linear_ordered_field α] +variables [linear_ordered_field α] [archimedean α] {x y ε : α} /-- Every positive `x` is between two successive integer powers of another `y` greater than one. This is the same as `exists_mem_Ioc_zpow`, but with ≤ and < the other way around. -/ -lemma exists_mem_Ico_zpow [archimedean α] - {x : α} {y : α} (hx : 0 < x) (hy : 1 < y) : - ∃ n : ℤ, x ∈ set.Ico (y ^ n) (y ^ (n + 1)) := +lemma exists_mem_Ico_zpow (hx : 0 < x) (hy : 1 < y) : ∃ n : ℤ, x ∈ Ico (y ^ n) (y ^ (n + 1)) := by classical; exact let ⟨N, hN⟩ := pow_unbounded_of_one_lt x⁻¹ hy in have he: ∃ m : ℤ, y ^ m ≤ x, from - ⟨-N, le_of_lt (by { rw [zpow_neg₀ y (↑N), zpow_coe_nat], + ⟨-N, le_of_lt (by { rw [zpow_neg y (↑N), zpow_coe_nat], exact (inv_lt hx (lt_trans (inv_pos.2 hx) hN)).1 hN })⟩, let ⟨M, hM⟩ := pow_unbounded_of_one_lt x hy in have hb: ∃ b : ℤ, ∀ m, y ^ m ≤ x → m ≤ b, from @@ -179,112 +191,39 @@ let ⟨n, hn₁, hn₂⟩ := int.exists_greatest_of_bdd hb he in /-- Every positive `x` is between two successive integer powers of another `y` greater than one. This is the same as `exists_mem_Ico_zpow`, but with ≤ and < the other way around. -/ -lemma exists_mem_Ioc_zpow [archimedean α] - {x : α} {y : α} (hx : 0 < x) (hy : 1 < y) : - ∃ n : ℤ, x ∈ set.Ioc (y ^ n) (y ^ (n + 1)) := +lemma exists_mem_Ioc_zpow (hx : 0 < x) (hy : 1 < y) : ∃ n : ℤ, x ∈ Ioc (y ^ n) (y ^ (n + 1)) := let ⟨m, hle, hlt⟩ := exists_mem_Ico_zpow (inv_pos.2 hx) hy in have hyp : 0 < y, from lt_trans zero_lt_one hy, ⟨-(m+1), -by rwa [zpow_neg₀, inv_lt (zpow_pos_of_pos hyp _) hx], -by rwa [neg_add, neg_add_cancel_right, zpow_neg₀, +by rwa [zpow_neg, inv_lt (zpow_pos_of_pos hyp _) hx], +by rwa [neg_add, neg_add_cancel_right, zpow_neg, le_inv hx (zpow_pos_of_pos hyp _)]⟩ /-- For any `y < 1` and any positive `x`, there exists `n : ℕ` with `y ^ n < x`. -/ -lemma exists_pow_lt_of_lt_one [archimedean α] {x y : α} (hx : 0 < x) (hy : y < 1) : - ∃ n : ℕ, y ^ n < x := +lemma exists_pow_lt_of_lt_one (hx : 0 < x) (hy : y < 1) : ∃ n : ℕ, y ^ n < x := begin by_cases y_pos : y ≤ 0, { use 1, simp only [pow_one], linarith, }, rw [not_le] at y_pos, rcases pow_unbounded_of_one_lt (x⁻¹) (one_lt_inv y_pos hy) with ⟨q, hq⟩, - exact ⟨q, by rwa [inv_pow₀, inv_lt_inv hx (pow_pos y_pos _)] at hq⟩ + exact ⟨q, by rwa [inv_pow, inv_lt_inv hx (pow_pos y_pos _)] at hq⟩ end /-- Given `x` and `y` between `0` and `1`, `x` is between two successive powers of `y`. This is the same as `exists_nat_pow_near`, but for elements between `0` and `1` -/ -lemma exists_nat_pow_near_of_lt_one [archimedean α] - {x : α} {y : α} (xpos : 0 < x) (hx : x ≤ 1) (ypos : 0 < y) (hy : y < 1) : +lemma exists_nat_pow_near_of_lt_one (xpos : 0 < x) (hx : x ≤ 1) (ypos : 0 < y) (hy : y < 1) : ∃ n : ℕ, y ^ (n + 1) < x ∧ x ≤ y ^ n := begin rcases exists_nat_pow_near (one_le_inv_iff.2 ⟨xpos, hx⟩) (one_lt_inv_iff.2 ⟨ypos, hy⟩) with ⟨n, hn, h'n⟩, refine ⟨n, _, _⟩, - { rwa [inv_pow₀, inv_lt_inv xpos (pow_pos ypos _)] at h'n }, - { rwa [inv_pow₀, inv_le_inv (pow_pos ypos _) xpos] at hn } + { rwa [inv_pow, inv_lt_inv xpos (pow_pos ypos _)] at h'n }, + { rwa [inv_pow, inv_le_inv (pow_pos ypos _) xpos] at hn } end -variables [floor_ring α] - -lemma sub_floor_div_mul_nonneg (x : α) {y : α} (hy : 0 < y) : - 0 ≤ x - ⌊x / y⌋ * y := -begin - conv in x {rw ← div_mul_cancel x (ne_of_lt hy).symm}, - rw ← sub_mul, - exact mul_nonneg (sub_nonneg.2 (floor_le _)) (le_of_lt hy) -end - -lemma sub_floor_div_mul_lt (x : α) {y : α} (hy : 0 < y) : - x - ⌊x / y⌋ * y < y := -sub_lt_iff_lt_add.2 begin - conv in y {rw ← one_mul y}, - conv in x {rw ← div_mul_cancel x (ne_of_lt hy).symm}, - rw ← add_mul, - exact (mul_lt_mul_right hy).2 (by rw add_comm; exact lt_floor_add_one _), -end - -end linear_ordered_field - -instance : archimedean ℕ := -⟨λ n m m0, ⟨n, by simpa only [mul_one, nat.nsmul_eq_mul] using nat.mul_le_mul_left n m0⟩⟩ - -instance : archimedean ℤ := -⟨λ n m m0, ⟨n.to_nat, le_trans (int.le_to_nat _) $ -by simpa only [nsmul_eq_mul, int.nat_cast_eq_coe_nat, zero_add, mul_one] - using mul_le_mul_of_nonneg_left (int.add_one_le_iff.2 m0) (int.coe_zero_le n.to_nat)⟩⟩ - -/-- A linear ordered archimedean ring is a floor ring. This is not an `instance` because in some -cases we have a computable `floor` function. -/ -noncomputable def archimedean.floor_ring (α) - [linear_ordered_ring α] [archimedean α] : floor_ring α := -floor_ring.of_floor α (λ a, classical.some (exists_floor a)) - (λ z a, (classical.some_spec (exists_floor a) z).symm) - -section linear_ordered_field -variables [linear_ordered_field α] - -theorem archimedean_iff_nat_lt : - archimedean α ↔ ∀ x : α, ∃ n : ℕ, x < n := -⟨@exists_nat_gt α _ _, λ H, ⟨λ x y y0, - (H (x / y)).imp $ λ n h, le_of_lt $ - by rwa [div_lt_iff y0, ← nsmul_eq_mul] at h⟩⟩ - -theorem archimedean_iff_nat_le : - archimedean α ↔ ∀ x : α, ∃ n : ℕ, x ≤ n := -archimedean_iff_nat_lt.trans -⟨λ H x, (H x).imp $ λ _, le_of_lt, - λ H x, let ⟨n, h⟩ := H x in ⟨n+1, - lt_of_le_of_lt h (nat.cast_lt.2 (lt_add_one _))⟩⟩ - -theorem exists_rat_gt [archimedean α] (x : α) : ∃ q : ℚ, x < q := +lemma exists_rat_gt (x : α) : ∃ q : ℚ, x < q := let ⟨n, h⟩ := exists_nat_gt x in ⟨n, by rwa rat.cast_coe_nat⟩ -theorem archimedean_iff_rat_lt : - archimedean α ↔ ∀ x : α, ∃ q : ℚ, x < q := -⟨@exists_rat_gt α _, - λ H, archimedean_iff_nat_lt.2 $ λ x, - let ⟨q, h⟩ := H x in - ⟨⌈q⌉₊, lt_of_lt_of_le h $ - by simpa only [rat.cast_coe_nat] using (@rat.cast_le α _ _ _).2 (nat.le_ceil _)⟩⟩ - -theorem archimedean_iff_rat_le : - archimedean α ↔ ∀ x : α, ∃ q : ℚ, x ≤ q := -archimedean_iff_rat_lt.trans -⟨λ H x, (H x).imp $ λ _, le_of_lt, - λ H x, let ⟨n, h⟩ := H x in ⟨n+1, - lt_of_le_of_lt h (rat.cast_lt.2 (lt_add_one _))⟩⟩ - -variables [archimedean α] {x y : α} - theorem exists_rat_lt (x : α) : ∃ q : ℚ, (q : α) < x := let ⟨n, h⟩ := exists_int_lt x in ⟨n, by rwa rat.cast_coe_int⟩ @@ -303,7 +242,7 @@ begin rwa [← lt_sub_iff_add_lt', ← sub_mul, ← div_lt_iff' (sub_pos.2 h), one_div], { rw [rat.coe_int_denom, nat.cast_one], exact one_ne_zero }, - { intro H, rw [rat.coe_nat_num, ← coe_coe, nat.cast_eq_zero] at H, subst H, cases n0 }, + { intro H, rw [rat.coe_nat_num, int.cast_coe_nat, nat.cast_eq_zero] at H, subst H, cases n0 }, { rw [rat.coe_nat_denom, nat.cast_one], exact one_ne_zero } end @@ -334,50 +273,79 @@ end theorem exists_pos_rat_lt {x : α} (x0 : 0 < x) : ∃ q : ℚ, 0 < q ∧ (q : α) < x := by simpa only [rat.cast_pos] using exists_rat_btwn x0 +lemma exists_rat_near (x : α) (ε0 : 0 < ε) : ∃ q : ℚ, |x - q| < ε := +let ⟨q, h₁, h₂⟩ := exists_rat_btwn $ ((sub_lt_self_iff x).2 ε0).trans ((lt_add_iff_pos_left x).2 ε0) + in ⟨q, abs_sub_lt_iff.2 ⟨sub_lt_comm.1 h₁, sub_lt_iff_lt_add.2 h₂⟩⟩ + end linear_ordered_field -section -variables [linear_ordered_field α] [floor_ring α] +section linear_ordered_field +variables [linear_ordered_field α] -/-- `round` rounds a number to the nearest integer. `round (1 / 2) = 1` -/ -def round (x : α) : ℤ := ⌊x + 1 / 2⌋ +lemma archimedean_iff_nat_lt : archimedean α ↔ ∀ x : α, ∃ n : ℕ, x < n := +⟨@exists_nat_gt α _, λ H, ⟨λ x y y0, + (H (x / y)).imp $ λ n h, le_of_lt $ + by rwa [div_lt_iff y0, ← nsmul_eq_mul] at h⟩⟩ -@[simp] lemma round_zero : round (0 : α) = 0 := floor_eq_iff.2 (by norm_num) -@[simp] lemma round_one : round (1 : α) = 1 := floor_eq_iff.2 (by norm_num) +lemma archimedean_iff_nat_le : archimedean α ↔ ∀ x : α, ∃ n : ℕ, x ≤ n := +archimedean_iff_nat_lt.trans +⟨λ H x, (H x).imp $ λ _, le_of_lt, + λ H x, let ⟨n, h⟩ := H x in ⟨n+1, + lt_of_le_of_lt h (nat.cast_lt.2 (lt_add_one _))⟩⟩ -lemma abs_sub_round (x : α) : |x - round x| ≤ 1 / 2 := +lemma archimedean_iff_int_lt : archimedean α ↔ ∀ x : α, ∃ n : ℤ, x < n := +⟨@exists_int_gt α _, begin - rw [round, abs_sub_le_iff], - have := floor_le (x + 1 / 2), - have := lt_floor_add_one (x + 1 / 2), - split; linarith -end - -@[simp, norm_cast] theorem rat.floor_cast (x : ℚ) : ⌊(x:α)⌋ = ⌊x⌋ := -floor_eq_iff.2 (by exact_mod_cast floor_eq_iff.1 (eq.refl ⌊x⌋)) - -@[simp, norm_cast] theorem rat.ceil_cast (x : ℚ) : ⌈(x:α)⌉ = ⌈x⌉ := -by rw [←neg_inj, ←floor_neg, ←floor_neg, ← rat.cast_neg, rat.floor_cast] + rw archimedean_iff_nat_lt, + intros h x, + obtain ⟨n, h⟩ := h x, + refine ⟨n.to_nat, h.trans_le _⟩, + exact_mod_cast int.le_to_nat _, +end⟩ + +lemma archimedean_iff_int_le : archimedean α ↔ ∀ x : α, ∃ n : ℤ, x ≤ n := +archimedean_iff_int_lt.trans +⟨λ H x, (H x).imp $ λ _, le_of_lt, + λ H x, let ⟨n, h⟩ := H x in ⟨n+1, + lt_of_le_of_lt h (int.cast_lt.2 (lt_add_one _))⟩⟩ -@[simp, norm_cast] theorem rat.round_cast (x : ℚ) : round (x:α) = round x := -have ((x + 1 / 2 : ℚ) : α) = x + 1 / 2, by simp, -by rw [round, round, ← this, rat.floor_cast] +lemma archimedean_iff_rat_lt : archimedean α ↔ ∀ x : α, ∃ q : ℚ, x < q := +⟨@exists_rat_gt α _, + λ H, archimedean_iff_nat_lt.2 $ λ x, + let ⟨q, h⟩ := H x in + ⟨⌈q⌉₊, lt_of_lt_of_le h $ + by simpa only [rat.cast_coe_nat] using (@rat.cast_le α _ _ _).2 (nat.le_ceil _)⟩⟩ -@[simp, norm_cast] theorem rat.cast_fract (x : ℚ) : (↑(fract x) : α) = fract x := -by { simp only [fract, rat.cast_sub], simp } +lemma archimedean_iff_rat_le : archimedean α ↔ ∀ x : α, ∃ q : ℚ, x ≤ q := +archimedean_iff_rat_lt.trans +⟨λ H x, (H x).imp $ λ _, le_of_lt, + λ H x, let ⟨n, h⟩ := H x in ⟨n+1, + lt_of_le_of_lt h (rat.cast_lt.2 (lt_add_one _))⟩⟩ -end +end linear_ordered_field -section -variables [linear_ordered_field α] [archimedean α] +instance : archimedean ℕ := +⟨λ n m m0, ⟨n, by simpa only [mul_one, nat.nsmul_eq_mul] using nat.mul_le_mul_left n m0⟩⟩ -theorem exists_rat_near (x : α) {ε : α} (ε0 : 0 < ε) : - ∃ q : ℚ, |x - q| < ε := -let ⟨q, h₁, h₂⟩ := exists_rat_btwn $ - lt_trans ((sub_lt_self_iff x).2 ε0) ((lt_add_iff_pos_left x).2 ε0) in -⟨q, abs_sub_lt_iff.2 ⟨sub_lt.1 h₁, sub_lt_iff_lt_add.2 h₂⟩⟩ +instance : archimedean ℤ := +⟨λ n m m0, ⟨n.to_nat, le_trans (int.le_to_nat _) $ +by simpa only [nsmul_eq_mul, zero_add, mul_one] + using mul_le_mul_of_nonneg_left (int.add_one_le_iff.2 m0) (int.coe_zero_le n.to_nat)⟩⟩ instance : archimedean ℚ := archimedean_iff_rat_le.2 $ λ q, ⟨q, by rw rat.cast_id⟩ +/-- A linear ordered archimedean ring is a floor ring. This is not an `instance` because in some +cases we have a computable `floor` function. -/ +noncomputable def archimedean.floor_ring (α) [linear_ordered_ring α] [archimedean α] : + floor_ring α := +floor_ring.of_floor α (λ a, classical.some (exists_floor a)) + (λ z a, (classical.some_spec (exists_floor a) z).symm) + +/-- A linear ordered field that is a floor ring is archimedean. -/ +@[priority 100] -- see Note [lower instance priority] +instance floor_ring.archimedean (α) [linear_ordered_field α] [floor_ring α] : archimedean α := +begin + rw archimedean_iff_int_le, + exact λ x, ⟨⌈x⌉, int.le_ceil x⟩ end diff --git a/src/algebra/order/chebyshev.lean b/src/algebra/order/chebyshev.lean new file mode 100644 index 0000000000000..619b8b6c0d5ed --- /dev/null +++ b/src/algebra/order/chebyshev.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2023 Mantas Bakšys, Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mantas Bakšys, Yaël Dillies +-/ +import algebra.big_operators.order +import algebra.order.rearrangement +import group_theory.perm.cycle.basic + +/-! +# Chebyshev's sum inequality + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the Chebyshev sum inequality. + +Chebyshev's inequality states `(∑ i in s, f i) * (∑ i in s, g i) ≤ s.card * ∑ i in s, f i * g i` +when `f g : ι → α` monovary, and the reverse inequality when `f` and `g` antivary. + + +## Main declarations + +* `monovary_on.sum_mul_sum_le_card_mul_sum`: Chebyshev's inequality. +* `antivary_on.card_mul_sum_le_sum_mul_sum`: Chebyshev's inequality, dual version. +* `sq_sum_le_card_mul_sum_sq`: Special case of Chebyshev's inequality when `f = g`. + +## Implementation notes + +In fact, we don't need much compatibility between the addition and multiplication of `α`, so we can +actually decouple them by replacing multiplication with scalar multiplication and making `f` and `g` +land in different types. +As a bonus, this makes the dual statement trivial. The multiplication versions are provided for +convenience. + +The case for `monotone`/`antitone` pairs of functions over a `linear_order` is not deduced in this +file because it is easily deducible from the `monovary` API. +-/ + +open equiv equiv.perm finset function order_dual +open_locale big_operators + +variables {ι α β : Type*} + +/-! ### Scalar multiplication versions -/ + +section smul +variables [linear_ordered_ring α] [linear_ordered_add_comm_group β] [module α β] + [ordered_smul α β] {s : finset ι} {σ : perm ι} {f : ι → α} {g : ι → β} + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both +monotone/antitone), the scalar product of their sum is less than the size of the set times their +scalar product. -/ +lemma monovary_on.sum_smul_sum_le_card_smul_sum (hfg : monovary_on f g s) : + (∑ i in s, f i) • ∑ i in s, g i ≤ s.card • ∑ i in s, f i • g i := +begin + classical, + obtain ⟨σ, hσ, hs⟩ := s.countable_to_set.exists_cycle_on, + rw [←card_range s.card, sum_smul_sum_eq_sum_perm hσ], + exact sum_le_card_nsmul _ _ _ (λ n _, hfg.sum_smul_comp_perm_le_sum_smul $ λ x hx, hs $ λ h, hx $ + is_fixed_pt.perm_pow h _), +end + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the +other is antitone), the scalar product of their sum is less than the size of the set times their +scalar product. -/ +lemma antivary_on.card_smul_sum_le_sum_smul_sum (hfg : antivary_on f g s) : + s.card • ∑ i in s, f i • g i ≤ (∑ i in s, f i) • ∑ i in s, g i := +by convert hfg.dual_right.sum_smul_sum_le_card_smul_sum + +variables [fintype ι] + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both +monotone/antitone), the scalar product of their sum is less than the size of the set times their +scalar product. -/ +lemma monovary.sum_smul_sum_le_card_smul_sum (hfg : monovary f g) : + (∑ i, f i) • ∑ i, g i ≤ fintype.card ι • ∑ i, f i • g i := +(hfg.monovary_on _).sum_smul_sum_le_card_smul_sum + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the +other is antitone), the scalar product of their sum is less than the size of the set times their +scalar product. -/ +lemma antivary.card_smul_sum_le_sum_smul_sum (hfg : antivary f g) : + fintype.card ι • ∑ i, f i • g i ≤ (∑ i, f i) • ∑ i, g i := +by convert (hfg.dual_right.monovary_on _).sum_smul_sum_le_card_smul_sum + +end smul + +/-! +### Multiplication versions + +Special cases of the above when scalar multiplication is actually multiplication. +-/ + +section mul +variables [linear_ordered_ring α] {s : finset ι} {σ : perm ι} {f g : ι → α} + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both +monotone/antitone), the product of their sum is less than the size of the set times their scalar +product. -/ +lemma monovary_on.sum_mul_sum_le_card_mul_sum (hfg : monovary_on f g s) : + (∑ i in s, f i) * (∑ i in s, g i) ≤ s.card * ∑ i in s, f i * g i := +by { rw ←nsmul_eq_mul, exact hfg.sum_smul_sum_le_card_smul_sum } + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the +other is antitone), the product of their sum is greater than the size of the set times their scalar +product. -/ +lemma antivary_on.card_mul_sum_le_sum_mul_sum (hfg : antivary_on f g s) : + (s.card : α) * ∑ i in s, f i * g i ≤ (∑ i in s, f i) * (∑ i in s, g i) := +by { rw ←nsmul_eq_mul, exact hfg.card_smul_sum_le_sum_smul_sum } + +/-- Special case of **Chebyshev's Sum Inequality** or the **Cauchy-Schwarz Inequality**: The square +of the sum is less than the size of the set times the sum of the squares. -/ +lemma sq_sum_le_card_mul_sum_sq : (∑ i in s, f i)^2 ≤ s.card * ∑ i in s, f i ^ 2 := +by { simp_rw sq, exact (monovary_on_self _ _).sum_mul_sum_le_card_mul_sum } + +variables [fintype ι] + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` monovary together (eg they are both +monotone/antitone), the product of their sum is less than the size of the set times their scalar +product. -/ +lemma monovary.sum_mul_sum_le_card_mul_sum (hfg : monovary f g) : + (∑ i, f i) * (∑ i, g i) ≤ fintype.card ι * ∑ i, f i * g i := +(hfg.monovary_on _).sum_mul_sum_le_card_mul_sum + +/-- **Chebyshev's Sum Inequality**: When `f` and `g` antivary together (eg one is monotone, the +other is antitone), the product of their sum is less than the size of the set times their scalar +product. -/ +lemma antivary.card_mul_sum_le_sum_mul_sum (hfg : antivary f g) : + (fintype.card ι : α) * ∑ i, f i * g i ≤ (∑ i, f i) * (∑ i, g i) := +(hfg.antivary_on _).card_mul_sum_le_sum_mul_sum + +end mul + +variables [linear_ordered_field α] {s : finset ι} {f : ι → α} + +lemma sum_div_card_sq_le_sum_sq_div_card : + ((∑ i in s, f i) / s.card) ^ 2 ≤ (∑ i in s, f i ^ 2) / s.card := +begin + obtain rfl | hs := s.eq_empty_or_nonempty, + { simp }, + rw [←card_pos, ←@nat.cast_pos α] at hs, + rw [div_pow, div_le_div_iff (sq_pos_of_ne_zero _ hs.ne') hs, sq (s.card : α), mul_left_comm, + ←mul_assoc], + exact mul_le_mul_of_nonneg_right (sq_sum_le_card_mul_sum_sq) hs.le, +end diff --git a/src/algebra/order/complete_field.lean b/src/algebra/order/complete_field.lean new file mode 100644 index 0000000000000..d4d207ca1a804 --- /dev/null +++ b/src/algebra/order/complete_field.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2022 Alex J. Best. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alex J. Best, Yaël Dillies +-/ +import algebra.order.hom.ring +import algebra.order.pointwise +import analysis.special_functions.pow.real + +/-! +# Conditionally complete linear ordered fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file shows that the reals are unique, or, more formally, given a type satisfying the common +axioms of the reals (field, conditionally complete, linearly ordered) that there is an isomorphism +preserving these properties to the reals. This is `rat.induced_order_ring_iso`. Moreover this +isomorphism is unique. + +We introduce definitions of conditionally complete linear ordered fields, and show all such are +archimedean. We also construct the natural map from a `linear_ordered_field` to such a field. + +## Main definitions + +* `conditionally_complete_linear_ordered_field`: A field satisfying the standard axiomatization of + the real numbers, being a Dedekind complete and linear ordered field. +* `linear_ordered_field.induced_map`: A (unique) map from any archimedean linear ordered field to a + conditionally complete linear ordered field. Various bundlings are available. + +## Main results + +* `unique.order_ring_hom` : Uniqueness of `order_ring_hom`s from an archimedean linear ordered field + to a conditionally complete linear ordered field. +* `unique.order_ring_iso` : Uniqueness of `order_ring_iso`s between two + conditionally complete linearly ordered fields. + +## References + +* https://mathoverflow.net/questions/362991/ + who-first-characterized-the-real-numbers-as-the-unique-complete-ordered-field + +## Tags + +reals, conditionally complete, ordered field, uniqueness +-/ + +variables {F α β γ : Type*} + +noncomputable theory + +open function rat real set +open_locale classical pointwise + +set_option old_structure_cmd true + +/-- A field which is both linearly ordered and conditionally complete with respect to the order. +This axiomatizes the reals. -/ +@[protect_proj, ancestor linear_ordered_field conditionally_complete_linear_order] +class conditionally_complete_linear_ordered_field (α : Type*) + extends linear_ordered_field α renaming max → sup min → inf, conditionally_complete_linear_order α + +/-- Any conditionally complete linearly ordered field is archimedean. -/ +@[priority 100] -- see Note [lower instance priority] +instance conditionally_complete_linear_ordered_field.to_archimedean + [conditionally_complete_linear_ordered_field α] : archimedean α := +archimedean_iff_nat_lt.2 begin + by_contra' h, + obtain ⟨x, h⟩ := h, + have := cSup_le (range_nonempty (coe : ℕ → α)) (forall_range_iff.2 $ λ n, le_sub_iff_add_le.2 $ + le_cSup ⟨x, forall_range_iff.2 h⟩ ⟨n + 1, nat.cast_succ n⟩), + linarith, +end + +/-- The reals are a conditionally complete linearly ordered field. -/ +instance : conditionally_complete_linear_ordered_field ℝ := +{ ..real.linear_ordered_field, ..real.conditionally_complete_linear_order } + +namespace linear_ordered_field + +/-! +### Rational cut map + +The idea is that a conditionally complete linear ordered field is fully characterized by its copy of +the rationals. Hence we define `rat.cut_map β : α → set β` which sends `a : α` to the "rationals in +`β`" that are less than `a`. +-/ + +section cut_map +variables [linear_ordered_field α] + +section division_ring +variables (β) [division_ring β] {a a₁ a₂ : α} {b : β} {q : ℚ} + +/-- The lower cut of rationals inside a linear ordered field that are less than a given element of +another linear ordered field. -/ +def cut_map (a : α) : set β := (coe : ℚ → β) '' {t | ↑t < a} + +lemma cut_map_mono (h : a₁ ≤ a₂) : cut_map β a₁ ⊆ cut_map β a₂ := image_subset _ $ λ _, h.trans_lt' + +variables {β} + +@[simp] lemma mem_cut_map_iff : b ∈ cut_map β a ↔ ∃ q : ℚ, (q : α) < a ∧ (q : β) = b := iff.rfl + +@[simp] lemma coe_mem_cut_map_iff [char_zero β] : (q : β) ∈ cut_map β a ↔ (q : α) < a := +rat.cast_injective.mem_set_image + +lemma cut_map_self (a : α) : cut_map α a = Iio a ∩ range (coe : ℚ → α) := +begin + ext, + split, + { rintro ⟨q, h, rfl⟩, + exact ⟨h, q, rfl⟩ }, + { rintro ⟨h, q, rfl⟩, + exact ⟨q, h, rfl⟩ } +end + +end division_ring + +variables (β) [linear_ordered_field β] {a a₁ a₂ : α} {b : β} {q : ℚ} + +lemma cut_map_coe (q : ℚ) : cut_map β (q : α) = coe '' {r : ℚ | (r : β) < q} := +by simp_rw [cut_map, rat.cast_lt] + +variables [archimedean α] + +lemma cut_map_nonempty (a : α) : (cut_map β a).nonempty := nonempty.image _ $ exists_rat_lt a + +lemma cut_map_bdd_above (a : α) : bdd_above (cut_map β a) := +begin + obtain ⟨q, hq⟩ := exists_rat_gt a, + exact ⟨q, ball_image_iff.2 $ λ r hr, by exact_mod_cast (hq.trans' hr).le⟩, +end + +lemma cut_map_add (a b : α) : cut_map β (a + b) = cut_map β a + cut_map β b := +begin + refine (image_subset_iff.2 $ λ q hq, _).antisymm _, + { rw [mem_set_of_eq, ←sub_lt_iff_lt_add] at hq, + obtain ⟨q₁, hq₁q, hq₁ab⟩ := exists_rat_btwn hq, + refine ⟨q₁, q - q₁, _, _, add_sub_cancel'_right _ _⟩; try {norm_cast}; rwa coe_mem_cut_map_iff, + exact_mod_cast sub_lt_comm.mp hq₁q }, + { rintro _ ⟨_, _, ⟨qa, ha, rfl⟩, ⟨qb, hb, rfl⟩, rfl⟩, + refine ⟨qa + qb, _, by norm_cast⟩, + rw [mem_set_of_eq, cast_add], + exact add_lt_add ha hb } +end + +end cut_map + +/-! +### Induced map + +`rat.cut_map` spits out a `set β`. To get something in `β`, we now take the supremum. +-/ + +section induced_map +variables (α β γ) [linear_ordered_field α] [conditionally_complete_linear_ordered_field β] + [conditionally_complete_linear_ordered_field γ] + +/-- The induced order preserving function from a linear ordered field to a conditionally complete +linear ordered field, defined by taking the Sup in the codomain of all the rationals less than the +input. -/ +def induced_map (x : α) : β := Sup $ cut_map β x + +variables [archimedean α] + +lemma induced_map_mono : monotone (induced_map α β) := +λ a b h, cSup_le_cSup (cut_map_bdd_above β _) (cut_map_nonempty β _) (cut_map_mono β h) + +lemma induced_map_rat (q : ℚ) : induced_map α β (q : α) = q := +begin + refine cSup_eq_of_forall_le_of_forall_lt_exists_gt (cut_map_nonempty β q) (λ x h, _) (λ w h, _), + { rw cut_map_coe at h, + obtain ⟨r, h, rfl⟩ := h, + exact le_of_lt h }, + { obtain ⟨q', hwq, hq⟩ := exists_rat_btwn h, + rw cut_map_coe, + exact ⟨q', ⟨_, hq, rfl⟩, hwq⟩ } +end + +@[simp] lemma induced_map_zero : induced_map α β 0 = 0 := by exact_mod_cast induced_map_rat α β 0 +@[simp] lemma induced_map_one : induced_map α β 1 = 1 := by exact_mod_cast induced_map_rat α β 1 + +variables {α β} {a : α} {b : β} {q : ℚ} + +lemma induced_map_nonneg (ha : 0 ≤ a) : 0 ≤ induced_map α β a := +(induced_map_zero α _).ge.trans $ induced_map_mono _ _ ha + +lemma coe_lt_induced_map_iff : (q : β) < induced_map α β a ↔ (q : α) < a := +begin + refine ⟨λ h, _, λ hq, _⟩, + { rw ←induced_map_rat α at h, + exact (induced_map_mono α β).reflect_lt h }, + { obtain ⟨q', hq, hqa⟩ := exists_rat_btwn hq, + apply lt_cSup_of_lt (cut_map_bdd_above β a) (coe_mem_cut_map_iff.mpr hqa), + exact_mod_cast hq } +end + +lemma lt_induced_map_iff : b < induced_map α β a ↔ ∃ q : ℚ, b < q ∧ (q : α) < a := +⟨λ h, (exists_rat_btwn h).imp $ λ q, and.imp_right coe_lt_induced_map_iff.1, + λ ⟨q, hbq, hqa⟩, hbq.trans $ by rwa coe_lt_induced_map_iff⟩ + +@[simp] lemma induced_map_self (b : β) : induced_map β β b = b := +eq_of_forall_rat_lt_iff_lt $ λ q, coe_lt_induced_map_iff + +variables (α β) + +@[simp] lemma induced_map_induced_map (a : α) : + induced_map β γ (induced_map α β a) = induced_map α γ a := +eq_of_forall_rat_lt_iff_lt $ λ q, + by rw [coe_lt_induced_map_iff, coe_lt_induced_map_iff, iff.comm, coe_lt_induced_map_iff] + +@[simp] lemma induced_map_inv_self (b : β) : induced_map γ β (induced_map β γ b) = b := +by rw [induced_map_induced_map, induced_map_self] + +lemma induced_map_add (x y : α) : induced_map α β (x + y) = induced_map α β x + induced_map α β y := +begin + rw [induced_map, cut_map_add], + exact cSup_add (cut_map_nonempty β x) (cut_map_bdd_above β x) (cut_map_nonempty β y) + (cut_map_bdd_above β y), +end + +variables {α β} + +/-- Preparatory lemma for `induced_ring_hom`. -/ +lemma le_induced_map_mul_self_of_mem_cut_map (ha : 0 < a) (b : β) (hb : b ∈ cut_map β (a * a)) : + b ≤ induced_map α β a * induced_map α β a := +begin + obtain ⟨q, hb, rfl⟩ := hb, + obtain ⟨q', hq', hqq', hqa⟩ := exists_rat_pow_btwn two_ne_zero hb (mul_self_pos.2 ha.ne'), + transitivity (q' : β)^2, + exact_mod_cast hqq'.le, + rw pow_two at ⊢ hqa, + exact mul_self_le_mul_self (by exact_mod_cast hq'.le) (le_cSup (cut_map_bdd_above β a) $ + coe_mem_cut_map_iff.2 $ lt_of_mul_self_lt_mul_self ha.le hqa), +end + +/-- Preparatory lemma for `induced_ring_hom`. -/ +lemma exists_mem_cut_map_mul_self_of_lt_induced_map_mul_self (ha : 0 < a) (b : β) + (hba : b < induced_map α β a * induced_map α β a) : + ∃ c ∈ cut_map β (a * a), b < c := +begin + obtain hb | hb := lt_or_le b 0, + { refine ⟨0, _, hb⟩, + rw [←rat.cast_zero, coe_mem_cut_map_iff, rat.cast_zero], + exact mul_self_pos.2 ha.ne' }, + obtain ⟨q, hq, hbq, hqa⟩ := exists_rat_pow_btwn two_ne_zero hba (hb.trans_lt hba), + rw ←cast_pow at hbq, + refine ⟨(q^2 : ℚ), coe_mem_cut_map_iff.2 _, hbq⟩, + rw pow_two at ⊢ hqa, + push_cast, + obtain ⟨q', hq', hqa'⟩ := lt_induced_map_iff.1 (lt_of_mul_self_lt_mul_self _ hqa), + exact mul_self_lt_mul_self (by exact_mod_cast hq.le) (hqa'.trans' $ by assumption_mod_cast), + exact induced_map_nonneg ha.le, +end + +variables (α β) + +/-- `induced_map` as an additive homomorphism. -/ +def induced_add_hom : α →+ β := ⟨induced_map α β, induced_map_zero α β, induced_map_add α β⟩ + +/-- `induced_map` as an `order_ring_hom`. -/ +@[simps] def induced_order_ring_hom : α →+*o β := +{ monotone' := induced_map_mono _ _, + ..(induced_add_hom α β).mk_ring_hom_of_mul_self_of_two_ne_zero -- reduce to the case of x = y + begin + -- reduce to the case of 0 < x + suffices : ∀ x, 0 < x → + induced_add_hom α β (x * x) = induced_add_hom α β x * induced_add_hom α β x, + { rintro x, + obtain h | rfl | h := lt_trichotomy x 0, + { convert this (-x) (neg_pos.2 h) using 1, + { rw [neg_mul, mul_neg, neg_neg] }, + { simp_rw [add_monoid_hom.map_neg, neg_mul, mul_neg, neg_neg] } }, + { simp only [mul_zero, add_monoid_hom.map_zero] }, + { exact this x h } }, + -- prove that the (Sup of rationals less than x) ^ 2 is the Sup of the set of rationals less + -- than (x ^ 2) by showing it is an upper bound and any smaller number is not an upper bound + refine λ x hx, cSup_eq_of_forall_le_of_forall_lt_exists_gt (cut_map_nonempty β _) _ _, + exact le_induced_map_mul_self_of_mem_cut_map hx, + exact exists_mem_cut_map_mul_self_of_lt_induced_map_mul_self hx, + end two_ne_zero (induced_map_one _ _) } + +/-- The isomorphism of ordered rings between two conditionally complete linearly ordered fields. -/ +def induced_order_ring_iso : β ≃+*o γ := +{ inv_fun := induced_map γ β, + left_inv := induced_map_inv_self _ _, + right_inv := induced_map_inv_self _ _, + map_le_map_iff' := λ x y, begin + refine ⟨λ h, _, λ h, induced_map_mono _ _ h⟩, + simpa [induced_order_ring_hom, add_monoid_hom.mk_ring_hom_of_mul_self_of_two_ne_zero, + induced_add_hom] using induced_map_mono γ β h, + end, + ..induced_order_ring_hom β γ } + +@[simp] lemma coe_induced_order_ring_iso : ⇑(induced_order_ring_iso β γ) = induced_map β γ := rfl + +@[simp] lemma induced_order_ring_iso_symm : + (induced_order_ring_iso β γ).symm = induced_order_ring_iso γ β := rfl + +@[simp] lemma induced_order_ring_iso_self : induced_order_ring_iso β β = order_ring_iso.refl β := +order_ring_iso.ext induced_map_self + +open order_ring_iso + +/-- There is a unique ordered ring homomorphism from an archimedean linear ordered field to a +conditionally complete linear ordered field. -/ +instance : unique (α →+*o β) := unique_of_subsingleton $ induced_order_ring_hom α β + +/-- There is a unique ordered ring isomorphism between two conditionally complete linear ordered +fields. -/ +instance : unique (β ≃+*o γ) := unique_of_subsingleton $ induced_order_ring_iso β γ + +end induced_map +end linear_ordered_field + +section real + +variables {R S : Type*} [ordered_ring R] [linear_ordered_ring S] + +lemma ring_hom_monotone (hR : ∀ r : R, 0 ≤ r → ∃ s : R, s^2 = r) (f : R →+* S) : monotone f := +(monotone_iff_map_nonneg f).2 $ λ r h, by { obtain ⟨s, rfl⟩ := hR r h, rw map_pow, apply sq_nonneg } + +/-- There exists no nontrivial ring homomorphism `ℝ →+* ℝ`. -/ +instance real.ring_hom.unique : unique (ℝ →+* ℝ) := +{ default := ring_hom.id ℝ, + uniq := λ f, congr_arg order_ring_hom.to_ring_hom + (subsingleton.elim ⟨f, ring_hom_monotone (λ r hr, ⟨real.sqrt r, sq_sqrt hr⟩) f⟩ default), } + +end real diff --git a/src/algebra/order/euclidean_absolute_value.lean b/src/algebra/order/euclidean_absolute_value.lean index ddfbe8b958802..cef698d857b78 100644 --- a/src/algebra/order/euclidean_absolute_value.lean +++ b/src/algebra/order/euclidean_absolute_value.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ import algebra.order.absolute_value -import algebra.euclidean_domain +import algebra.euclidean_domain.instances /-! # Euclidean absolute values +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a predicate `absolute_value.is_euclidean abv` stating the absolute value is compatible with the Euclidean domain structure on its domain. diff --git a/src/algebra/order/field.lean b/src/algebra/order/field.lean deleted file mode 100644 index c6df55bc62ed6..0000000000000 --- a/src/algebra/order/field.lean +++ /dev/null @@ -1,772 +0,0 @@ -/- -Copyright (c) 2014 Robert Lewis. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn --/ -import algebra.field.basic -import algebra.group_power.order -import algebra.order.ring -import order.bounds -import tactic.monotonicity.basic - -/-! -# Linear ordered fields - -A linear ordered field is a field equipped with a linear order such that -* addition respects the order: `a ≤ b → c + a ≤ c + b`; -* multiplication of positives is positive: `0 < a → 0 < b → 0 < a * b`; -* `0 < 1`. - -## Main Definitions - -* `linear_ordered_field`: the class of linear ordered fields. --/ - -set_option old_structure_cmd true - -variable {α : Type*} - -/-- A linear ordered field is a field with a linear order respecting the operations. -/ -@[protect_proj] class linear_ordered_field (α : Type*) extends linear_ordered_comm_ring α, field α - -section linear_ordered_field -variables [linear_ordered_field α] {a b c d e : α} - -section - -/-- `equiv.mul_left₀` as an order_iso. -/ -@[simps {simp_rhs := tt}] -def order_iso.mul_left₀ (a : α) (ha : 0 < a) : α ≃o α := -{ map_rel_iff' := λ _ _, mul_le_mul_left ha, ..equiv.mul_left₀ a ha.ne' } - -/-- `equiv.mul_right₀` as an order_iso. -/ -@[simps {simp_rhs := tt}] -def order_iso.mul_right₀ (a : α) (ha : 0 < a) : α ≃o α := -{ map_rel_iff' := λ _ _, mul_le_mul_right ha, ..equiv.mul_right₀ a ha.ne' } - -end - -/-! -### Lemmas about pos, nonneg, nonpos, neg --/ - -@[simp] lemma inv_pos : 0 < a⁻¹ ↔ 0 < a := -suffices ∀ a : α, 0 < a → 0 < a⁻¹, -from ⟨λ h, inv_inv a ▸ this _ h, this a⟩, -assume a ha, flip lt_of_mul_lt_mul_left ha.le $ by simp [ne_of_gt ha, zero_lt_one] - -@[simp] lemma inv_nonneg : 0 ≤ a⁻¹ ↔ 0 ≤ a := -by simp only [le_iff_eq_or_lt, inv_pos, zero_eq_inv] - -@[simp] lemma inv_lt_zero : a⁻¹ < 0 ↔ a < 0 := -by simp only [← not_le, inv_nonneg] - -@[simp] lemma inv_nonpos : a⁻¹ ≤ 0 ↔ a ≤ 0 := -by simp only [← not_lt, inv_pos] - -lemma one_div_pos : 0 < 1 / a ↔ 0 < a := -inv_eq_one_div a ▸ inv_pos - -lemma one_div_neg : 1 / a < 0 ↔ a < 0 := -inv_eq_one_div a ▸ inv_lt_zero - -lemma one_div_nonneg : 0 ≤ 1 / a ↔ 0 ≤ a := -inv_eq_one_div a ▸ inv_nonneg - -lemma one_div_nonpos : 1 / a ≤ 0 ↔ a ≤ 0 := -inv_eq_one_div a ▸ inv_nonpos - -lemma div_pos_iff : 0 < a / b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := -by simp [division_def, mul_pos_iff] - -lemma div_neg_iff : a / b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := -by simp [division_def, mul_neg_iff] - -lemma div_nonneg_iff : 0 ≤ a / b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := -by simp [division_def, mul_nonneg_iff] - -lemma div_nonpos_iff : a / b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b := -by simp [division_def, mul_nonpos_iff] - -lemma div_pos (ha : 0 < a) (hb : 0 < b) : 0 < a / b := -div_pos_iff.2 $ or.inl ⟨ha, hb⟩ - -lemma div_pos_of_neg_of_neg (ha : a < 0) (hb : b < 0) : 0 < a / b := -div_pos_iff.2 $ or.inr ⟨ha, hb⟩ - -lemma div_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a / b < 0 := -div_neg_iff.2 $ or.inr ⟨ha, hb⟩ - -lemma div_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a / b < 0 := -div_neg_iff.2 $ or.inl ⟨ha, hb⟩ - -lemma div_nonneg (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a / b := -div_nonneg_iff.2 $ or.inl ⟨ha, hb⟩ - -lemma div_nonneg_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a / b := -div_nonneg_iff.2 $ or.inr ⟨ha, hb⟩ - -lemma div_nonpos_of_nonpos_of_nonneg (ha : a ≤ 0) (hb : 0 ≤ b) : a / b ≤ 0 := -div_nonpos_iff.2 $ or.inr ⟨ha, hb⟩ - -lemma div_nonpos_of_nonneg_of_nonpos (ha : 0 ≤ a) (hb : b ≤ 0) : a / b ≤ 0 := -div_nonpos_iff.2 $ or.inl ⟨ha, hb⟩ - -/-! -### Relating one division with another term. --/ - -lemma le_div_iff (hc : 0 < c) : a ≤ b / c ↔ a * c ≤ b := -⟨λ h, div_mul_cancel b (ne_of_lt hc).symm ▸ mul_le_mul_of_nonneg_right h hc.le, - λ h, calc - a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc).symm - ... ≤ b * (1 / c) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hc).le - ... = b / c : (div_eq_mul_one_div b c).symm⟩ - -lemma le_div_iff' (hc : 0 < c) : a ≤ b / c ↔ c * a ≤ b := -by rw [mul_comm, le_div_iff hc] - -lemma div_le_iff (hb : 0 < b) : a / b ≤ c ↔ a ≤ c * b := -⟨λ h, calc - a = a / b * b : by rw (div_mul_cancel _ (ne_of_lt hb).symm) - ... ≤ c * b : mul_le_mul_of_nonneg_right h hb.le, - λ h, calc - a / b = a * (1 / b) : div_eq_mul_one_div a b - ... ≤ (c * b) * (1 / b) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hb).le - ... = (c * b) / b : (div_eq_mul_one_div (c * b) b).symm - ... = c : by refine (div_eq_iff (ne_of_gt hb)).mpr rfl⟩ - -lemma div_le_iff' (hb : 0 < b) : a / b ≤ c ↔ a ≤ b * c := -by rw [mul_comm, div_le_iff hb] - -lemma lt_div_iff (hc : 0 < c) : a < b / c ↔ a * c < b := -lt_iff_lt_of_le_iff_le $ div_le_iff hc - -lemma lt_div_iff' (hc : 0 < c) : a < b / c ↔ c * a < b := -by rw [mul_comm, lt_div_iff hc] - -lemma div_lt_iff (hc : 0 < c) : b / c < a ↔ b < a * c := -lt_iff_lt_of_le_iff_le (le_div_iff hc) - -lemma div_lt_iff' (hc : 0 < c) : b / c < a ↔ b < c * a := -by rw [mul_comm, div_lt_iff hc] - -lemma inv_mul_le_iff (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ b * c := -begin - rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div], - exact div_le_iff' h, -end - -lemma inv_mul_le_iff' (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ c * b := -by rw [inv_mul_le_iff h, mul_comm] - -lemma mul_inv_le_iff (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ b * c := -by rw [mul_comm, inv_mul_le_iff h] - -lemma mul_inv_le_iff' (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ c * b := -by rw [mul_comm, inv_mul_le_iff' h] - -lemma div_self_le_one (a : α) : a / a ≤ 1 := -if h : a = 0 then by simp [h] else by simp [h] - -lemma inv_mul_lt_iff (h : 0 < b) : b⁻¹ * a < c ↔ a < b * c := -begin - rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div], - exact div_lt_iff' h, -end - -lemma inv_mul_lt_iff' (h : 0 < b) : b⁻¹ * a < c ↔ a < c * b := -by rw [inv_mul_lt_iff h, mul_comm] - -lemma mul_inv_lt_iff (h : 0 < b) : a * b⁻¹ < c ↔ a < b * c := -by rw [mul_comm, inv_mul_lt_iff h] - -lemma mul_inv_lt_iff' (h : 0 < b) : a * b⁻¹ < c ↔ a < c * b := -by rw [mul_comm, inv_mul_lt_iff' h] - -lemma inv_pos_le_iff_one_le_mul (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ b * a := -by { rw [inv_eq_one_div], exact div_le_iff ha } - -lemma inv_pos_le_iff_one_le_mul' (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ a * b := -by { rw [inv_eq_one_div], exact div_le_iff' ha } - -lemma inv_pos_lt_iff_one_lt_mul (ha : 0 < a) : a⁻¹ < b ↔ 1 < b * a := -by { rw [inv_eq_one_div], exact div_lt_iff ha } - -lemma inv_pos_lt_iff_one_lt_mul' (ha : 0 < a) : a⁻¹ < b ↔ 1 < a * b := -by { rw [inv_eq_one_div], exact div_lt_iff' ha } - -lemma div_le_iff_of_neg (hc : c < 0) : b / c ≤ a ↔ a * c ≤ b := -⟨λ h, div_mul_cancel b (ne_of_lt hc) ▸ mul_le_mul_of_nonpos_right h hc.le, - λ h, calc - a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc) - ... ≥ b * (1 / c) : mul_le_mul_of_nonpos_right h (one_div_neg.2 hc).le - ... = b / c : (div_eq_mul_one_div b c).symm⟩ - -lemma div_le_iff_of_neg' (hc : c < 0) : b / c ≤ a ↔ c * a ≤ b := -by rw [mul_comm, div_le_iff_of_neg hc] - -lemma le_div_iff_of_neg (hc : c < 0) : a ≤ b / c ↔ b ≤ a * c := -by rw [← neg_neg c, mul_neg, div_neg, le_neg, - div_le_iff (neg_pos.2 hc), neg_mul] - -lemma le_div_iff_of_neg' (hc : c < 0) : a ≤ b / c ↔ b ≤ c * a := -by rw [mul_comm, le_div_iff_of_neg hc] - -lemma div_lt_iff_of_neg (hc : c < 0) : b / c < a ↔ a * c < b := -lt_iff_lt_of_le_iff_le $ le_div_iff_of_neg hc - -lemma div_lt_iff_of_neg' (hc : c < 0) : b / c < a ↔ c * a < b := -by rw [mul_comm, div_lt_iff_of_neg hc] - -lemma lt_div_iff_of_neg (hc : c < 0) : a < b / c ↔ b < a * c := -lt_iff_lt_of_le_iff_le $ div_le_iff_of_neg hc - -lemma lt_div_iff_of_neg' (hc : c < 0) : a < b / c ↔ b < c * a := -by rw [mul_comm, lt_div_iff_of_neg hc] - -/-- One direction of `div_le_iff` where `b` is allowed to be `0` (but `c` must be nonnegative) -/ -lemma div_le_of_nonneg_of_le_mul (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ c * b) : a / b ≤ c := -by { rcases eq_or_lt_of_le hb with rfl|hb', simp [hc], rwa [div_le_iff hb'] } - -lemma div_le_one_of_le (h : a ≤ b) (hb : 0 ≤ b) : a / b ≤ 1 := -div_le_of_nonneg_of_le_mul hb zero_le_one $ by rwa one_mul - -/-! -### Bi-implications of inequalities using inversions --/ - -lemma inv_le_inv_of_le (ha : 0 < a) (h : a ≤ b) : b⁻¹ ≤ a⁻¹ := -by rwa [← one_div a, le_div_iff' ha, ← div_eq_mul_inv, div_le_iff (ha.trans_le h), one_mul] - -/-- See `inv_le_inv_of_le` for the implication from right-to-left with one fewer assumption. -/ -lemma inv_le_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := -by rw [← one_div, div_le_iff ha, ← div_eq_inv_mul, le_div_iff hb, one_mul] - -/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ ≤ b ↔ b⁻¹ ≤ a`. -See also `inv_le_of_inv_le` for a one-sided implication with one fewer assumption. -/ -lemma inv_le (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a := -by rw [← inv_le_inv hb (inv_pos.2 ha), inv_inv] - -lemma inv_le_of_inv_le (ha : 0 < a) (h : a⁻¹ ≤ b) : b⁻¹ ≤ a := -(inv_le ha ((inv_pos.2 ha).trans_le h)).1 h - -lemma le_inv (ha : 0 < a) (hb : 0 < b) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ := -by rw [← inv_le_inv (inv_pos.2 hb) ha, inv_inv] - -lemma inv_lt_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a := -lt_iff_lt_of_le_iff_le (inv_le_inv hb ha) - -/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ < b ↔ b⁻¹ < a`. -See also `inv_lt_of_inv_lt` for a one-sided implication with one fewer assumption. -/ -lemma inv_lt (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b ↔ b⁻¹ < a := -lt_iff_lt_of_le_iff_le (le_inv hb ha) - -lemma inv_lt_of_inv_lt (ha : 0 < a) (h : a⁻¹ < b) : b⁻¹ < a := -(inv_lt ha ((inv_pos.2 ha).trans h)).1 h - -lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ := -lt_iff_lt_of_le_iff_le (inv_le hb ha) - -lemma inv_le_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := -by rw [← one_div, div_le_iff_of_neg ha, ← div_eq_inv_mul, div_le_iff_of_neg hb, one_mul] - -lemma inv_le_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a := -by rw [← inv_le_inv_of_neg hb (inv_lt_zero.2 ha), inv_inv] - -lemma le_inv_of_neg (ha : a < 0) (hb : b < 0) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ := -by rw [← inv_le_inv_of_neg (inv_lt_zero.2 hb) ha, inv_inv] - -lemma inv_lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b⁻¹ ↔ b < a := -lt_iff_lt_of_le_iff_le (inv_le_inv_of_neg hb ha) - -lemma inv_lt_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b ↔ b⁻¹ < a := -lt_iff_lt_of_le_iff_le (le_inv_of_neg hb ha) - -lemma lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a < b⁻¹ ↔ b < a⁻¹ := -lt_iff_lt_of_le_iff_le (inv_le_of_neg hb ha) - -lemma inv_lt_one (ha : 1 < a) : a⁻¹ < 1 := -by rwa [inv_lt ((@zero_lt_one α _ _).trans ha) zero_lt_one, inv_one] - -lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ := -by rwa [lt_inv (@zero_lt_one α _ _) h₁, inv_one] - -lemma inv_le_one (ha : 1 ≤ a) : a⁻¹ ≤ 1 := -by rwa [inv_le ((@zero_lt_one α _ _).trans_le ha) zero_lt_one, inv_one] - -lemma one_le_inv (h₁ : 0 < a) (h₂ : a ≤ 1) : 1 ≤ a⁻¹ := -by rwa [le_inv (@zero_lt_one α _ _) h₁, inv_one] - -lemma inv_lt_one_iff_of_pos (h₀ : 0 < a) : a⁻¹ < 1 ↔ 1 < a := -⟨λ h₁, inv_inv a ▸ one_lt_inv (inv_pos.2 h₀) h₁, inv_lt_one⟩ - -lemma inv_lt_one_iff : a⁻¹ < 1 ↔ a ≤ 0 ∨ 1 < a := -begin - cases le_or_lt a 0 with ha ha, - { simp [ha, (inv_nonpos.2 ha).trans_lt zero_lt_one] }, - { simp only [ha.not_le, false_or, inv_lt_one_iff_of_pos ha] } -end - -lemma one_lt_inv_iff : 1 < a⁻¹ ↔ 0 < a ∧ a < 1 := -⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans h), inv_inv a ▸ inv_lt_one h⟩, and_imp.2 one_lt_inv⟩ - -lemma inv_le_one_iff : a⁻¹ ≤ 1 ↔ a ≤ 0 ∨ 1 ≤ a := -begin - rcases em (a = 1) with (rfl|ha), - { simp [le_rfl] }, - { simp only [ne.le_iff_lt (ne.symm ha), ne.le_iff_lt (mt inv_eq_one₀.1 ha), inv_lt_one_iff] } -end - -lemma one_le_inv_iff : 1 ≤ a⁻¹ ↔ 0 < a ∧ a ≤ 1 := -⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans_le h), inv_inv a ▸ inv_le_one h⟩, and_imp.2 one_le_inv⟩ - -/-! -### Relating two divisions. --/ - -@[mono] lemma div_le_div_of_le (hc : 0 ≤ c) (h : a ≤ b) : a / c ≤ b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 hc) -end - --- Not a `mono` lemma b/c `div_le_div` is strictly more general -lemma div_le_div_of_le_left (ha : 0 ≤ a) (hc : 0 < c) (h : c ≤ b) : a / b ≤ a / c := -begin - rw [div_eq_mul_inv, div_eq_mul_inv], - exact mul_le_mul_of_nonneg_left ((inv_le_inv (hc.trans_le h) hc).mpr h) ha -end - -lemma div_le_div_of_le_of_nonneg (hab : a ≤ b) (hc : 0 ≤ c) : a / c ≤ b / c := -div_le_div_of_le hc hab - -lemma div_le_div_of_nonpos_of_le (hc : c ≤ 0) (h : b ≤ a) : a / c ≤ b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_le_mul_of_nonpos_right h (one_div_nonpos.2 hc) -end - -lemma div_lt_div_of_lt (hc : 0 < c) (h : a < b) : a / c < b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_lt_mul_of_pos_right h (one_div_pos.2 hc) -end - -lemma div_lt_div_of_neg_of_lt (hc : c < 0) (h : b < a) : a / c < b / c := -begin - rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], - exact mul_lt_mul_of_neg_right h (one_div_neg.2 hc) -end - -lemma div_le_div_right (hc : 0 < c) : a / c ≤ b / c ↔ a ≤ b := -⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_lt hc, div_le_div_of_le $ hc.le⟩ - -lemma div_le_div_right_of_neg (hc : c < 0) : a / c ≤ b / c ↔ b ≤ a := -⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_neg_of_lt hc, div_le_div_of_nonpos_of_le $ hc.le⟩ - -lemma div_lt_div_right (hc : 0 < c) : a / c < b / c ↔ a < b := -lt_iff_lt_of_le_iff_le $ div_le_div_right hc - -lemma div_lt_div_right_of_neg (hc : c < 0) : a / c < b / c ↔ b < a := -lt_iff_lt_of_le_iff_le $ div_le_div_right_of_neg hc - -lemma div_lt_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b < a / c ↔ c < b := -by simp only [div_eq_mul_inv, mul_lt_mul_left ha, inv_lt_inv hb hc] - -lemma div_le_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b ≤ a / c ↔ c ≤ b := -le_iff_le_iff_lt_iff_lt.2 (div_lt_div_left ha hc hb) - -lemma div_lt_div_iff (b0 : 0 < b) (d0 : 0 < d) : - a / b < c / d ↔ a * d < c * b := -by rw [lt_div_iff d0, div_mul_eq_mul_div, div_lt_iff b0] - -lemma div_le_div_iff (b0 : 0 < b) (d0 : 0 < d) : a / b ≤ c / d ↔ a * d ≤ c * b := -by rw [le_div_iff d0, div_mul_eq_mul_div, div_le_iff b0] - -@[mono] lemma div_le_div (hc : 0 ≤ c) (hac : a ≤ c) (hd : 0 < d) (hbd : d ≤ b) : a / b ≤ c / d := -by { rw div_le_div_iff (hd.trans_le hbd) hd, exact mul_le_mul hac hbd hd.le hc } - -lemma div_lt_div (hac : a < c) (hbd : d ≤ b) (c0 : 0 ≤ c) (d0 : 0 < d) : - a / b < c / d := -(div_lt_div_iff (d0.trans_le hbd) d0).2 (mul_lt_mul hac hbd d0 c0) - -lemma div_lt_div' (hac : a ≤ c) (hbd : d < b) (c0 : 0 < c) (d0 : 0 < d) : - a / b < c / d := -(div_lt_div_iff (d0.trans hbd) d0).2 (mul_lt_mul' hac hbd d0.le c0) - -lemma div_lt_div_of_lt_left (hc : 0 < c) (hb : 0 < b) (h : b < a) : c / a < c / b := -(div_lt_div_left hc (hb.trans h) hb).mpr h - -/-! -### Relating one division and involving `1` --/ - -lemma div_le_self (ha : 0 ≤ a) (hb : 1 ≤ b) : a / b ≤ a := -by simpa only [div_one] using div_le_div_of_le_left ha zero_lt_one hb - -lemma div_lt_self (ha : 0 < a) (hb : 1 < b) : a / b < a := -by simpa only [div_one] using div_lt_div_of_lt_left ha zero_lt_one hb - -lemma le_div_self (ha : 0 ≤ a) (hb₀ : 0 < b) (hb₁ : b ≤ 1) : a ≤ a / b := -by simpa only [div_one] using div_le_div_of_le_left ha hb₀ hb₁ - -lemma one_le_div (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a := -by rw [le_div_iff hb, one_mul] - -lemma div_le_one (hb : 0 < b) : a / b ≤ 1 ↔ a ≤ b := -by rw [div_le_iff hb, one_mul] - -lemma one_lt_div (hb : 0 < b) : 1 < a / b ↔ b < a := -by rw [lt_div_iff hb, one_mul] - -lemma div_lt_one (hb : 0 < b) : a / b < 1 ↔ a < b := -by rw [div_lt_iff hb, one_mul] - -lemma one_le_div_of_neg (hb : b < 0) : 1 ≤ a / b ↔ a ≤ b := -by rw [le_div_iff_of_neg hb, one_mul] - -lemma div_le_one_of_neg (hb : b < 0) : a / b ≤ 1 ↔ b ≤ a := -by rw [div_le_iff_of_neg hb, one_mul] - -lemma one_lt_div_of_neg (hb : b < 0) : 1 < a / b ↔ a < b := -by rw [lt_div_iff_of_neg hb, one_mul] - -lemma div_lt_one_of_neg (hb : b < 0) : a / b < 1 ↔ b < a := -by rw [div_lt_iff_of_neg hb, one_mul] - -lemma one_div_le (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ b ↔ 1 / b ≤ a := -by simpa using inv_le ha hb - -lemma one_div_lt (ha : 0 < a) (hb : 0 < b) : 1 / a < b ↔ 1 / b < a := -by simpa using inv_lt ha hb - -lemma le_one_div (ha : 0 < a) (hb : 0 < b) : a ≤ 1 / b ↔ b ≤ 1 / a := -by simpa using le_inv ha hb - -lemma lt_one_div (ha : 0 < a) (hb : 0 < b) : a < 1 / b ↔ b < 1 / a := -by simpa using lt_inv ha hb - -lemma one_div_le_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ b ↔ 1 / b ≤ a := -by simpa using inv_le_of_neg ha hb - -lemma one_div_lt_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < b ↔ 1 / b < a := -by simpa using inv_lt_of_neg ha hb - -lemma le_one_div_of_neg (ha : a < 0) (hb : b < 0) : a ≤ 1 / b ↔ b ≤ 1 / a := -by simpa using le_inv_of_neg ha hb - -lemma lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : a < 1 / b ↔ b < 1 / a := -by simpa using lt_inv_of_neg ha hb - -lemma one_lt_div_iff : 1 < a / b ↔ 0 < b ∧ b < a ∨ b < 0 ∧ a < b := -begin - rcases lt_trichotomy b 0 with (hb|rfl|hb), - { simp [hb, hb.not_lt, one_lt_div_of_neg] }, - { simp [lt_irrefl, zero_le_one] }, - { simp [hb, hb.not_lt, one_lt_div] } -end - -lemma one_le_div_iff : 1 ≤ a / b ↔ 0 < b ∧ b ≤ a ∨ b < 0 ∧ a ≤ b := -begin - rcases lt_trichotomy b 0 with (hb|rfl|hb), - { simp [hb, hb.not_lt, one_le_div_of_neg] }, - { simp [lt_irrefl, zero_lt_one.not_le, zero_lt_one] }, - { simp [hb, hb.not_lt, one_le_div] } -end - -lemma div_lt_one_iff : a / b < 1 ↔ 0 < b ∧ a < b ∨ b = 0 ∨ b < 0 ∧ b < a := -begin - rcases lt_trichotomy b 0 with (hb|rfl|hb), - { simp [hb, hb.not_lt, hb.ne, div_lt_one_of_neg] }, - { simp [zero_lt_one], }, - { simp [hb, hb.not_lt, div_lt_one, hb.ne.symm] } -end - -lemma div_le_one_iff : a / b ≤ 1 ↔ 0 < b ∧ a ≤ b ∨ b = 0 ∨ b < 0 ∧ b ≤ a := -begin - rcases lt_trichotomy b 0 with (hb|rfl|hb), - { simp [hb, hb.not_lt, hb.ne, div_le_one_of_neg] }, - { simp [zero_le_one], }, - { simp [hb, hb.not_lt, div_le_one, hb.ne.symm] } -end - -/-! -### Relating two divisions, involving `1` --/ -lemma one_div_le_one_div_of_le (ha : 0 < a) (h : a ≤ b) : 1 / b ≤ 1 / a := -by simpa using inv_le_inv_of_le ha h - -lemma one_div_lt_one_div_of_lt (ha : 0 < a) (h : a < b) : 1 / b < 1 / a := -by rwa [lt_div_iff' ha, ← div_eq_mul_one_div, div_lt_one (ha.trans h)] - -lemma one_div_le_one_div_of_neg_of_le (hb : b < 0) (h : a ≤ b) : 1 / b ≤ 1 / a := -by rwa [div_le_iff_of_neg' hb, ← div_eq_mul_one_div, div_le_one_of_neg (h.trans_lt hb)] - -lemma one_div_lt_one_div_of_neg_of_lt (hb : b < 0) (h : a < b) : 1 / b < 1 / a := -by rwa [div_lt_iff_of_neg' hb, ← div_eq_mul_one_div, div_lt_one_of_neg (h.trans hb)] - -lemma le_of_one_div_le_one_div (ha : 0 < a) (h : 1 / a ≤ 1 / b) : b ≤ a := -le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_lt ha) h - -lemma lt_of_one_div_lt_one_div (ha : 0 < a) (h : 1 / a < 1 / b) : b < a := -lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_le ha) h - -lemma le_of_neg_of_one_div_le_one_div (hb : b < 0) (h : 1 / a ≤ 1 / b) : b ≤ a := -le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_neg_of_lt hb) h - -lemma lt_of_neg_of_one_div_lt_one_div (hb : b < 0) (h : 1 / a < 1 / b) : b < a := -lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_neg_of_le hb) h - -/-- For the single implications with fewer assumptions, see `one_div_le_one_div_of_le` and - `le_of_one_div_le_one_div` -/ -lemma one_div_le_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ 1 / b ↔ b ≤ a := -div_le_div_left zero_lt_one ha hb - -/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and - `lt_of_one_div_lt_one_div` -/ -lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a := -div_lt_div_left zero_lt_one ha hb - -/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_neg_of_lt` and - `lt_of_one_div_lt_one_div` -/ -lemma one_div_le_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ 1 / b ↔ b ≤ a := -by simpa [one_div] using inv_le_inv_of_neg ha hb - -/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and - `lt_of_one_div_lt_one_div` -/ -lemma one_div_lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < 1 / b ↔ b < a := -lt_iff_lt_of_le_iff_le (one_div_le_one_div_of_neg hb ha) - -lemma one_lt_one_div (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a := -by rwa [lt_one_div (@zero_lt_one α _ _) h1, one_div_one] - -lemma one_le_one_div (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a := -by rwa [le_one_div (@zero_lt_one α _ _) h1, one_div_one] - -lemma one_div_lt_neg_one (h1 : a < 0) (h2 : -1 < a) : 1 / a < -1 := -suffices 1 / a < 1 / -1, by rwa one_div_neg_one_eq_neg_one at this, -one_div_lt_one_div_of_neg_of_lt h1 h2 - -lemma one_div_le_neg_one (h1 : a < 0) (h2 : -1 ≤ a) : 1 / a ≤ -1 := -suffices 1 / a ≤ 1 / -1, by rwa one_div_neg_one_eq_neg_one at this, -one_div_le_one_div_of_neg_of_le h1 h2 - -/-! -### Results about halving. - -The equalities also hold in fields of characteristic `0`. -/ -lemma add_halves (a : α) : a / 2 + a / 2 = a := -by rw [div_add_div_same, ← two_mul, mul_div_cancel_left a two_ne_zero] - -lemma sub_self_div_two (a : α) : a - a / 2 = a / 2 := -suffices a / 2 + a / 2 - a / 2 = a / 2, by rwa add_halves at this, -by rw [add_sub_cancel] - -lemma div_two_sub_self (a : α) : a / 2 - a = - (a / 2) := -suffices a / 2 - (a / 2 + a / 2) = - (a / 2), by rwa add_halves at this, -by rw [sub_add_eq_sub_sub, sub_self, zero_sub] - -lemma add_self_div_two (a : α) : (a + a) / 2 = a := -by rw [← mul_two, mul_div_cancel a two_ne_zero] - -lemma half_pos (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two - -lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one - -lemma div_two_lt_of_pos (h : 0 < a) : a / 2 < a := -by { rw [div_lt_iff (@zero_lt_two α _ _)], exact lt_mul_of_one_lt_right h one_lt_two } - -lemma half_lt_self : 0 < a → a / 2 < a := div_two_lt_of_pos - -lemma half_le_self (ha_nonneg : 0 ≤ a) : a / 2 ≤ a := -begin - by_cases h0 : a = 0, - { simp [h0], }, - { rw ← ne.def at h0, - exact (half_lt_self (lt_of_le_of_ne ha_nonneg h0.symm)).le, }, -end - -lemma one_half_lt_one : (1 / 2 : α) < 1 := half_lt_self zero_lt_one - -lemma add_sub_div_two_lt (h : a < b) : a + (b - a) / 2 < b := -begin - rwa [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg, - ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (@zero_lt_two α _ _)] -end - -lemma left_lt_add_div_two : a < (a + b) / 2 ↔ a < b := by simp [lt_div_iff, mul_two] - -lemma add_div_two_lt_right : (a + b) / 2 < b ↔ a < b := by simp [div_lt_iff, mul_two] - -/-- An inequality involving `2`. -/ -lemma sub_one_div_inv_le_two (a2 : 2 ≤ a) : - (1 - 1 / a)⁻¹ ≤ 2 := -begin - -- Take inverses on both sides to obtain `2⁻¹ ≤ 1 - 1 / a` - refine trans (inv_le_inv_of_le (inv_pos.mpr zero_lt_two) _) (inv_inv (2 : α)).le, - -- move `1 / a` to the left and `1 - 1 / 2 = 1 / 2` to the right to obtain `1 / a ≤ ⅟ 2` - refine trans ((le_sub_iff_add_le.mpr ((_ : _ + 2⁻¹ = _ ).le))) ((sub_le_sub_iff_left 1).mpr _), - { -- show 2⁻¹ + 2⁻¹ = 1 - exact trans (two_mul _).symm (mul_inv_cancel two_ne_zero) }, - { -- take inverses on both sides and use the assumption `2 ≤ a`. - exact (one_div a).le.trans (inv_le_inv_of_le zero_lt_two a2) } -end - -/-! -### Miscellaneous lemmas --/ - -/-- Pullback a `linear_ordered_field` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.linear_ordered_field {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_inv β] [has_div β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] [has_pow β ℤ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n): - linear_ordered_field β := -{ ..hf.linear_ordered_ring f zero one add mul neg sub nsmul zsmul npow, - ..hf.field f zero one add mul neg sub inv div nsmul zsmul npow zpow} - -lemma mul_sub_mul_div_mul_neg_iff (hc : c ≠ 0) (hd : d ≠ 0) : - (a * d - b * c) / (c * d) < 0 ↔ a / c < b / d := -by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_lt_zero] - -alias mul_sub_mul_div_mul_neg_iff ↔ div_lt_div_of_mul_sub_mul_div_neg mul_sub_mul_div_mul_neg - -lemma mul_sub_mul_div_mul_nonpos_iff (hc : c ≠ 0) (hd : d ≠ 0) : - (a * d - b * c) / (c * d) ≤ 0 ↔ a / c ≤ b / d := -by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_nonpos] - -alias mul_sub_mul_div_mul_nonpos_iff ↔ - div_le_div_of_mul_sub_mul_div_nonpos mul_sub_mul_div_mul_nonpos - -lemma mul_le_mul_of_mul_div_le (h : a * (b / c) ≤ d) (hc : 0 < c) : b * a ≤ d * c := -begin - rw [← mul_div_assoc] at h, - rwa [mul_comm b, ← div_le_iff hc], -end - -lemma div_mul_le_div_mul_of_div_le_div (h : a / b ≤ c / d) (he : 0 ≤ e) : - a / (b * e) ≤ c / (d * e) := -begin - rw [div_mul_eq_div_mul_one_div, div_mul_eq_div_mul_one_div], - exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 he) -end - -lemma exists_add_lt_and_pos_of_lt (h : b < a) : ∃ c : α, b + c < a ∧ 0 < c := -⟨(a - b) / 2, add_sub_div_two_lt h, div_pos (sub_pos_of_lt h) zero_lt_two⟩ - -lemma exists_pos_mul_lt {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b * c < a := -begin - have : 0 < a / max (b + 1) 1, from div_pos h (lt_max_iff.2 (or.inr zero_lt_one)), - refine ⟨a / max (b + 1) 1, this, _⟩, - rw [← lt_div_iff this, div_div_cancel' h.ne'], - exact lt_max_iff.2 (or.inl $ lt_add_one _) -end - -lemma le_of_forall_sub_le (h : ∀ ε > 0, b - ε ≤ a) : b ≤ a := -begin - contrapose! h, - simpa only [and_comm ((0 : α) < _), lt_sub_iff_add_lt, gt_iff_lt] - using exists_add_lt_and_pos_of_lt h, -end - -lemma monotone.div_const {β : Type*} [preorder β] {f : β → α} (hf : monotone f) - {c : α} (hc : 0 ≤ c) : monotone (λ x, (f x) / c) := -by simpa only [div_eq_mul_inv] using hf.mul_const (inv_nonneg.2 hc) - -lemma strict_mono.div_const {β : Type*} [preorder β] {f : β → α} (hf : strict_mono f) - {c : α} (hc : 0 < c) : - strict_mono (λ x, (f x) / c) := -by simpa only [div_eq_mul_inv] using hf.mul_const (inv_pos.2 hc) - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_field.to_densely_ordered : densely_ordered α := -{ dense := λ a₁ a₂ h, ⟨(a₁ + a₂) / 2, - calc a₁ = (a₁ + a₁) / 2 : (add_self_div_two a₁).symm - ... < (a₁ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_left h _), - calc (a₁ + a₂) / 2 < (a₂ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_right h _) - ... = a₂ : add_self_div_two a₂⟩ } - -lemma mul_self_inj_of_nonneg (a0 : 0 ≤ a) (b0 : 0 ≤ b) : a * a = b * b ↔ a = b := -mul_self_eq_mul_self_iff.trans $ or_iff_left_of_imp $ - λ h, by { subst a, have : b = 0 := le_antisymm (neg_nonneg.1 a0) b0, rw [this, neg_zero] } - -lemma min_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : min (a / c) (b / c) = (min a b) / c := -eq.symm $ monotone.map_min (λ x y, div_le_div_of_le hc) - -lemma max_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : max (a / c) (b / c) = (max a b) / c := -eq.symm $ monotone.map_max (λ x y, div_le_div_of_le hc) - -lemma min_div_div_right_of_nonpos {c : α} (hc : c ≤ 0) (a b : α) : - min (a / c) (b / c) = (max a b) / c := -eq.symm $ antitone.map_max $ λ x y, div_le_div_of_nonpos_of_le hc - -lemma max_div_div_right_of_nonpos {c : α} (hc : c ≤ 0) (a b : α) : - max (a / c) (b / c) = (min a b) / c := -eq.symm $ antitone.map_min $ λ x y, div_le_div_of_nonpos_of_le hc - -lemma abs_div (a b : α) : |a / b| = |a| / |b| := (abs_hom : α →*₀ α).map_div a b - -lemma abs_one_div (a : α) : |1 / a| = 1 / |a| := -by rw [abs_div, abs_one] - -lemma abs_inv (a : α) : |a⁻¹| = (|a|)⁻¹ := (abs_hom : α →*₀ α).map_inv a - --- TODO: add lemmas with `a⁻¹`. -lemma one_div_strict_anti_on : strict_anti_on (λ x : α, 1 / x) (set.Ioi 0) := -λ x x1 y y1 xy, (one_div_lt_one_div (set.mem_Ioi.mp y1) (set.mem_Ioi.mp x1)).mpr xy - -lemma one_div_pow_le_one_div_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) : - 1 / a ^ n ≤ 1 / a ^ m := -by refine (one_div_le_one_div _ _).mpr (pow_le_pow a1 mn); - exact pow_pos (zero_lt_one.trans_le a1) _ - -lemma one_div_pow_lt_one_div_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) : - 1 / a ^ n < 1 / a ^ m := -by refine (one_div_lt_one_div _ _).mpr (pow_lt_pow a1 mn); - exact pow_pos (trans zero_lt_one a1) _ - -lemma one_div_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, 1 / a ^ n) := -λ m n, one_div_pow_le_one_div_pow_of_le a1 - -lemma one_div_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, 1 / a ^ n) := -λ m n, one_div_pow_lt_one_div_pow_of_lt a1 - -/-! ### Results about `is_lub` and `is_glb` -/ - -lemma is_lub.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) : - is_lub ((λ b, a * b) '' s) (a * b) := -begin - rcases lt_or_eq_of_le ha with ha | rfl, - { exact (order_iso.mul_left₀ _ ha).is_lub_image'.2 hs, }, - { simp_rw zero_mul, - rw hs.nonempty.image_const, - exact is_lub_singleton }, -end - -lemma is_lub.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) : - is_lub ((λ b, b * a) '' s) (b * a) := -by simpa [mul_comm] using hs.mul_left ha - -lemma is_glb.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) : - is_glb ((λ b, a * b) '' s) (a * b) := -begin - rcases lt_or_eq_of_le ha with ha | rfl, - { exact (order_iso.mul_left₀ _ ha).is_glb_image'.2 hs, }, - { simp_rw zero_mul, - rw hs.nonempty.image_const, - exact is_glb_singleton }, -end - -lemma is_glb.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) : - is_glb ((λ b, b * a) '' s) (b * a) := -by simpa [mul_comm] using hs.mul_left ha - -end linear_ordered_field diff --git a/src/algebra/order/field/basic.lean b/src/algebra/order/field/basic.lean new file mode 100644 index 0000000000000..049eff237f9b8 --- /dev/null +++ b/src/algebra/order/field/basic.lean @@ -0,0 +1,813 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn +-/ +import order.bounds.order_iso +import algebra.field.basic +import algebra.order.field.defs +import algebra.group_power.order + +/-! +# Lemmas about linear ordered (semi)fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +open function order_dual + +variables {ι α β : Type*} + +section linear_ordered_semifield +variables [linear_ordered_semifield α] {a b c d e : α} {m n : ℤ} + +/-- `equiv.mul_left₀` as an order_iso. -/ +@[simps {simp_rhs := tt}] +def order_iso.mul_left₀ (a : α) (ha : 0 < a) : α ≃o α := +{ map_rel_iff' := λ _ _, mul_le_mul_left ha, ..equiv.mul_left₀ a ha.ne' } + +/-- `equiv.mul_right₀` as an order_iso. -/ +@[simps {simp_rhs := tt}] +def order_iso.mul_right₀ (a : α) (ha : 0 < a) : α ≃o α := +{ map_rel_iff' := λ _ _, mul_le_mul_right ha, ..equiv.mul_right₀ a ha.ne' } + +/-! +### Lemmas about pos, nonneg, nonpos, neg +-/ + +@[simp] lemma inv_pos : 0 < a⁻¹ ↔ 0 < a := +suffices ∀ a : α, 0 < a → 0 < a⁻¹, +from ⟨λ h, inv_inv a ▸ this _ h, this a⟩, +assume a ha, flip lt_of_mul_lt_mul_left ha.le $ by simp [ne_of_gt ha, zero_lt_one] + +alias inv_pos ↔ _ inv_pos_of_pos + +@[simp] lemma inv_nonneg : 0 ≤ a⁻¹ ↔ 0 ≤ a := +by simp only [le_iff_eq_or_lt, inv_pos, zero_eq_inv] + +alias inv_nonneg ↔ _ inv_nonneg_of_nonneg + +@[simp] lemma inv_lt_zero : a⁻¹ < 0 ↔ a < 0 := +by simp only [← not_le, inv_nonneg] + +@[simp] lemma inv_nonpos : a⁻¹ ≤ 0 ↔ a ≤ 0 := +by simp only [← not_lt, inv_pos] + +lemma one_div_pos : 0 < 1 / a ↔ 0 < a := +inv_eq_one_div a ▸ inv_pos + +lemma one_div_neg : 1 / a < 0 ↔ a < 0 := +inv_eq_one_div a ▸ inv_lt_zero + +lemma one_div_nonneg : 0 ≤ 1 / a ↔ 0 ≤ a := +inv_eq_one_div a ▸ inv_nonneg + +lemma one_div_nonpos : 1 / a ≤ 0 ↔ a ≤ 0 := +inv_eq_one_div a ▸ inv_nonpos + +lemma div_pos (ha : 0 < a) (hb : 0 < b) : 0 < a / b := +by { rw div_eq_mul_inv, exact mul_pos ha (inv_pos.2 hb) } + +lemma div_nonneg (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a / b := +by { rw div_eq_mul_inv, exact mul_nonneg ha (inv_nonneg.2 hb) } + +lemma div_nonpos_of_nonpos_of_nonneg (ha : a ≤ 0) (hb : 0 ≤ b) : a / b ≤ 0 := +by { rw div_eq_mul_inv, exact mul_nonpos_of_nonpos_of_nonneg ha (inv_nonneg.2 hb) } + +lemma div_nonpos_of_nonneg_of_nonpos (ha : 0 ≤ a) (hb : b ≤ 0) : a / b ≤ 0 := +by { rw div_eq_mul_inv, exact mul_nonpos_of_nonneg_of_nonpos ha (inv_nonpos.2 hb) } + +lemma zpow_nonneg (ha : 0 ≤ a) : ∀ n : ℤ, 0 ≤ a ^ n +| (n : ℕ) := by { rw zpow_coe_nat, exact pow_nonneg ha _ } +| -[1+n] := by { rw zpow_neg_succ_of_nat, exact inv_nonneg.2 (pow_nonneg ha _) } + +lemma zpow_pos_of_pos (ha : 0 < a) : ∀ n : ℤ, 0 < a ^ n +| (n : ℕ) := by { rw zpow_coe_nat, exact pow_pos ha _ } +| -[1+n] := by { rw zpow_neg_succ_of_nat, exact inv_pos.2 (pow_pos ha _) } + +/-! +### Relating one division with another term. +-/ + +lemma le_div_iff (hc : 0 < c) : a ≤ b / c ↔ a * c ≤ b := +⟨λ h, div_mul_cancel b (ne_of_lt hc).symm ▸ mul_le_mul_of_nonneg_right h hc.le, + λ h, calc + a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc).symm + ... ≤ b * (1 / c) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hc).le + ... = b / c : (div_eq_mul_one_div b c).symm⟩ + +lemma le_div_iff' (hc : 0 < c) : a ≤ b / c ↔ c * a ≤ b := +by rw [mul_comm, le_div_iff hc] + +lemma div_le_iff (hb : 0 < b) : a / b ≤ c ↔ a ≤ c * b := +⟨λ h, calc + a = a / b * b : by rw (div_mul_cancel _ (ne_of_lt hb).symm) + ... ≤ c * b : mul_le_mul_of_nonneg_right h hb.le, + λ h, calc + a / b = a * (1 / b) : div_eq_mul_one_div a b + ... ≤ (c * b) * (1 / b) : mul_le_mul_of_nonneg_right h (one_div_pos.2 hb).le + ... = (c * b) / b : (div_eq_mul_one_div (c * b) b).symm + ... = c : by refine (div_eq_iff (ne_of_gt hb)).mpr rfl⟩ + +lemma div_le_iff' (hb : 0 < b) : a / b ≤ c ↔ a ≤ b * c := +by rw [mul_comm, div_le_iff hb] + +lemma lt_div_iff (hc : 0 < c) : a < b / c ↔ a * c < b := +lt_iff_lt_of_le_iff_le $ div_le_iff hc + +lemma lt_div_iff' (hc : 0 < c) : a < b / c ↔ c * a < b := +by rw [mul_comm, lt_div_iff hc] + +lemma div_lt_iff (hc : 0 < c) : b / c < a ↔ b < a * c := +lt_iff_lt_of_le_iff_le (le_div_iff hc) + +lemma div_lt_iff' (hc : 0 < c) : b / c < a ↔ b < c * a := +by rw [mul_comm, div_lt_iff hc] + +lemma inv_mul_le_iff (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ b * c := +begin + rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div], + exact div_le_iff' h, +end + +lemma inv_mul_le_iff' (h : 0 < b) : b⁻¹ * a ≤ c ↔ a ≤ c * b := +by rw [inv_mul_le_iff h, mul_comm] + +lemma mul_inv_le_iff (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ b * c := +by rw [mul_comm, inv_mul_le_iff h] + +lemma mul_inv_le_iff' (h : 0 < b) : a * b⁻¹ ≤ c ↔ a ≤ c * b := +by rw [mul_comm, inv_mul_le_iff' h] + +lemma div_self_le_one (a : α) : a / a ≤ 1 := +if h : a = 0 then by simp [h] else by simp [h] + +lemma inv_mul_lt_iff (h : 0 < b) : b⁻¹ * a < c ↔ a < b * c := +begin + rw [inv_eq_one_div, mul_comm, ← div_eq_mul_one_div], + exact div_lt_iff' h, +end + +lemma inv_mul_lt_iff' (h : 0 < b) : b⁻¹ * a < c ↔ a < c * b := +by rw [inv_mul_lt_iff h, mul_comm] + +lemma mul_inv_lt_iff (h : 0 < b) : a * b⁻¹ < c ↔ a < b * c := +by rw [mul_comm, inv_mul_lt_iff h] + +lemma mul_inv_lt_iff' (h : 0 < b) : a * b⁻¹ < c ↔ a < c * b := +by rw [mul_comm, inv_mul_lt_iff' h] + +lemma inv_pos_le_iff_one_le_mul (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ b * a := +by { rw [inv_eq_one_div], exact div_le_iff ha } + +lemma inv_pos_le_iff_one_le_mul' (ha : 0 < a) : a⁻¹ ≤ b ↔ 1 ≤ a * b := +by { rw [inv_eq_one_div], exact div_le_iff' ha } + +lemma inv_pos_lt_iff_one_lt_mul (ha : 0 < a) : a⁻¹ < b ↔ 1 < b * a := +by { rw [inv_eq_one_div], exact div_lt_iff ha } + +lemma inv_pos_lt_iff_one_lt_mul' (ha : 0 < a) : a⁻¹ < b ↔ 1 < a * b := +by { rw [inv_eq_one_div], exact div_lt_iff' ha } + +/-- One direction of `div_le_iff` where `b` is allowed to be `0` (but `c` must be nonnegative) -/ +lemma div_le_of_nonneg_of_le_mul (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ c * b) : a / b ≤ c := +by { rcases eq_or_lt_of_le hb with rfl|hb', simp [hc], rwa [div_le_iff hb'] } + +/-- One direction of `div_le_iff` where `c` is allowed to be `0` (but `b` must be nonnegative) -/ +lemma mul_le_of_nonneg_of_le_div (hb : 0 ≤ b) (hc : 0 ≤ c) (h : a ≤ b / c) : a * c ≤ b := +begin + obtain rfl | hc := hc.eq_or_lt, + { simpa using hb }, + { rwa le_div_iff hc at h } +end + +lemma div_le_one_of_le (h : a ≤ b) (hb : 0 ≤ b) : a / b ≤ 1 := +div_le_of_nonneg_of_le_mul hb zero_le_one $ by rwa one_mul + +/-! +### Bi-implications of inequalities using inversions +-/ + +lemma inv_le_inv_of_le (ha : 0 < a) (h : a ≤ b) : b⁻¹ ≤ a⁻¹ := +by rwa [← one_div a, le_div_iff' ha, ← div_eq_mul_inv, div_le_iff (ha.trans_le h), one_mul] + +/-- See `inv_le_inv_of_le` for the implication from right-to-left with one fewer assumption. -/ +lemma inv_le_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := +by rw [← one_div, div_le_iff ha, ← div_eq_inv_mul, le_div_iff hb, one_mul] + +/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ ≤ b ↔ b⁻¹ ≤ a`. +See also `inv_le_of_inv_le` for a one-sided implication with one fewer assumption. -/ +lemma inv_le (ha : 0 < a) (hb : 0 < b) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a := +by rw [← inv_le_inv hb (inv_pos.2 ha), inv_inv] + +lemma inv_le_of_inv_le (ha : 0 < a) (h : a⁻¹ ≤ b) : b⁻¹ ≤ a := +(inv_le ha ((inv_pos.2 ha).trans_le h)).1 h + +lemma le_inv (ha : 0 < a) (hb : 0 < b) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ := +by rw [← inv_le_inv (inv_pos.2 hb) ha, inv_inv] + +/-- See `inv_lt_inv_of_lt` for the implication from right-to-left with one fewer assumption. -/ +lemma inv_lt_inv (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b⁻¹ ↔ b < a := +lt_iff_lt_of_le_iff_le (inv_le_inv hb ha) + +lemma inv_lt_inv_of_lt (hb : 0 < b) (h : b < a) : a⁻¹ < b⁻¹ := +(inv_lt_inv (hb.trans h) hb).2 h + +/-- In a linear ordered field, for positive `a` and `b` we have `a⁻¹ < b ↔ b⁻¹ < a`. +See also `inv_lt_of_inv_lt` for a one-sided implication with one fewer assumption. -/ +lemma inv_lt (ha : 0 < a) (hb : 0 < b) : a⁻¹ < b ↔ b⁻¹ < a := +lt_iff_lt_of_le_iff_le (le_inv hb ha) + +lemma inv_lt_of_inv_lt (ha : 0 < a) (h : a⁻¹ < b) : b⁻¹ < a := +(inv_lt ha ((inv_pos.2 ha).trans h)).1 h + +lemma lt_inv (ha : 0 < a) (hb : 0 < b) : a < b⁻¹ ↔ b < a⁻¹ := +lt_iff_lt_of_le_iff_le (inv_le hb ha) + +lemma inv_lt_one (ha : 1 < a) : a⁻¹ < 1 := +by rwa [inv_lt (zero_lt_one.trans ha) zero_lt_one, inv_one] + +lemma one_lt_inv (h₁ : 0 < a) (h₂ : a < 1) : 1 < a⁻¹ := +by rwa [lt_inv zero_lt_one h₁, inv_one] + +lemma inv_le_one (ha : 1 ≤ a) : a⁻¹ ≤ 1 := +by rwa [inv_le (zero_lt_one.trans_le ha) zero_lt_one, inv_one] + +lemma one_le_inv (h₁ : 0 < a) (h₂ : a ≤ 1) : 1 ≤ a⁻¹ := +by rwa [le_inv zero_lt_one h₁, inv_one] + +lemma inv_lt_one_iff_of_pos (h₀ : 0 < a) : a⁻¹ < 1 ↔ 1 < a := +⟨λ h₁, inv_inv a ▸ one_lt_inv (inv_pos.2 h₀) h₁, inv_lt_one⟩ + +lemma inv_lt_one_iff : a⁻¹ < 1 ↔ a ≤ 0 ∨ 1 < a := +begin + cases le_or_lt a 0 with ha ha, + { simp [ha, (inv_nonpos.2 ha).trans_lt zero_lt_one] }, + { simp only [ha.not_le, false_or, inv_lt_one_iff_of_pos ha] } +end + +lemma one_lt_inv_iff : 1 < a⁻¹ ↔ 0 < a ∧ a < 1 := +⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans h), inv_inv a ▸ inv_lt_one h⟩, and_imp.2 one_lt_inv⟩ + +lemma inv_le_one_iff : a⁻¹ ≤ 1 ↔ a ≤ 0 ∨ 1 ≤ a := +begin + rcases em (a = 1) with (rfl|ha), + { simp [le_rfl] }, + { simp only [ne.le_iff_lt (ne.symm ha), ne.le_iff_lt (mt inv_eq_one.1 ha), inv_lt_one_iff] } +end + +lemma one_le_inv_iff : 1 ≤ a⁻¹ ↔ 0 < a ∧ a ≤ 1 := +⟨λ h, ⟨inv_pos.1 (zero_lt_one.trans_le h), inv_inv a ▸ inv_le_one h⟩, and_imp.2 one_le_inv⟩ + +/-! +### Relating two divisions. +-/ + +@[mono] lemma div_le_div_of_le (hc : 0 ≤ c) (h : a ≤ b) : a / c ≤ b / c := +begin + rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], + exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 hc) +end + +-- Not a `mono` lemma b/c `div_le_div` is strictly more general +lemma div_le_div_of_le_left (ha : 0 ≤ a) (hc : 0 < c) (h : c ≤ b) : a / b ≤ a / c := +begin + rw [div_eq_mul_inv, div_eq_mul_inv], + exact mul_le_mul_of_nonneg_left ((inv_le_inv (hc.trans_le h) hc).mpr h) ha +end + +lemma div_le_div_of_le_of_nonneg (hab : a ≤ b) (hc : 0 ≤ c) : a / c ≤ b / c := +div_le_div_of_le hc hab + +lemma div_lt_div_of_lt (hc : 0 < c) (h : a < b) : a / c < b / c := +begin + rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], + exact mul_lt_mul_of_pos_right h (one_div_pos.2 hc) +end + +lemma div_le_div_right (hc : 0 < c) : a / c ≤ b / c ↔ a ≤ b := +⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_lt hc, div_le_div_of_le $ hc.le⟩ + +lemma div_lt_div_right (hc : 0 < c) : a / c < b / c ↔ a < b := +lt_iff_lt_of_le_iff_le $ div_le_div_right hc + +lemma div_lt_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b < a / c ↔ c < b := +by simp only [div_eq_mul_inv, mul_lt_mul_left ha, inv_lt_inv hb hc] + +lemma div_le_div_left (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) : a / b ≤ a / c ↔ c ≤ b := +le_iff_le_iff_lt_iff_lt.2 (div_lt_div_left ha hc hb) + +lemma div_lt_div_iff (b0 : 0 < b) (d0 : 0 < d) : + a / b < c / d ↔ a * d < c * b := +by rw [lt_div_iff d0, div_mul_eq_mul_div, div_lt_iff b0] + +lemma div_le_div_iff (b0 : 0 < b) (d0 : 0 < d) : a / b ≤ c / d ↔ a * d ≤ c * b := +by rw [le_div_iff d0, div_mul_eq_mul_div, div_le_iff b0] + +@[mono] lemma div_le_div (hc : 0 ≤ c) (hac : a ≤ c) (hd : 0 < d) (hbd : d ≤ b) : a / b ≤ c / d := +by { rw div_le_div_iff (hd.trans_le hbd) hd, exact mul_le_mul hac hbd hd.le hc } + +lemma div_lt_div (hac : a < c) (hbd : d ≤ b) (c0 : 0 ≤ c) (d0 : 0 < d) : + a / b < c / d := +(div_lt_div_iff (d0.trans_le hbd) d0).2 (mul_lt_mul hac hbd d0 c0) + +lemma div_lt_div' (hac : a ≤ c) (hbd : d < b) (c0 : 0 < c) (d0 : 0 < d) : + a / b < c / d := +(div_lt_div_iff (d0.trans hbd) d0).2 (mul_lt_mul' hac hbd d0.le c0) + +lemma div_lt_div_of_lt_left (hc : 0 < c) (hb : 0 < b) (h : b < a) : c / a < c / b := +(div_lt_div_left hc (hb.trans h) hb).mpr h + +/-! +### Relating one division and involving `1` +-/ + +lemma div_le_self (ha : 0 ≤ a) (hb : 1 ≤ b) : a / b ≤ a := +by simpa only [div_one] using div_le_div_of_le_left ha zero_lt_one hb + +lemma div_lt_self (ha : 0 < a) (hb : 1 < b) : a / b < a := +by simpa only [div_one] using div_lt_div_of_lt_left ha zero_lt_one hb + +lemma le_div_self (ha : 0 ≤ a) (hb₀ : 0 < b) (hb₁ : b ≤ 1) : a ≤ a / b := +by simpa only [div_one] using div_le_div_of_le_left ha hb₀ hb₁ + +lemma one_le_div (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a := +by rw [le_div_iff hb, one_mul] + +lemma div_le_one (hb : 0 < b) : a / b ≤ 1 ↔ a ≤ b := +by rw [div_le_iff hb, one_mul] + +lemma one_lt_div (hb : 0 < b) : 1 < a / b ↔ b < a := +by rw [lt_div_iff hb, one_mul] + +lemma div_lt_one (hb : 0 < b) : a / b < 1 ↔ a < b := +by rw [div_lt_iff hb, one_mul] + +lemma one_div_le (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ b ↔ 1 / b ≤ a := +by simpa using inv_le ha hb + +lemma one_div_lt (ha : 0 < a) (hb : 0 < b) : 1 / a < b ↔ 1 / b < a := +by simpa using inv_lt ha hb + +lemma le_one_div (ha : 0 < a) (hb : 0 < b) : a ≤ 1 / b ↔ b ≤ 1 / a := +by simpa using le_inv ha hb + +lemma lt_one_div (ha : 0 < a) (hb : 0 < b) : a < 1 / b ↔ b < 1 / a := +by simpa using lt_inv ha hb + +/-! +### Relating two divisions, involving `1` +-/ +lemma one_div_le_one_div_of_le (ha : 0 < a) (h : a ≤ b) : 1 / b ≤ 1 / a := +by simpa using inv_le_inv_of_le ha h + +lemma one_div_lt_one_div_of_lt (ha : 0 < a) (h : a < b) : 1 / b < 1 / a := +by rwa [lt_div_iff' ha, ← div_eq_mul_one_div, div_lt_one (ha.trans h)] + +lemma le_of_one_div_le_one_div (ha : 0 < a) (h : 1 / a ≤ 1 / b) : b ≤ a := +le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_lt ha) h + +lemma lt_of_one_div_lt_one_div (ha : 0 < a) (h : 1 / a < 1 / b) : b < a := +lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_le ha) h + +/-- For the single implications with fewer assumptions, see `one_div_le_one_div_of_le` and + `le_of_one_div_le_one_div` -/ +lemma one_div_le_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a ≤ 1 / b ↔ b ≤ a := +div_le_div_left zero_lt_one ha hb + +/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and + `lt_of_one_div_lt_one_div` -/ +lemma one_div_lt_one_div (ha : 0 < a) (hb : 0 < b) : 1 / a < 1 / b ↔ b < a := +div_lt_div_left zero_lt_one ha hb + +lemma one_lt_one_div (h1 : 0 < a) (h2 : a < 1) : 1 < 1 / a := +by rwa [lt_one_div zero_lt_one h1, one_div_one] + +lemma one_le_one_div (h1 : 0 < a) (h2 : a ≤ 1) : 1 ≤ 1 / a := +by rwa [le_one_div zero_lt_one h1, one_div_one] + +/-! +### Results about halving. + +The equalities also hold in semifields of characteristic `0`. +-/ + +/- TODO: Unify `add_halves` and `add_halves'` into a single lemma about +`division_semiring` + `char_zero` -/ +lemma add_halves (a : α) : a / 2 + a / 2 = a := +by rw [div_add_div_same, ← two_mul, mul_div_cancel_left a two_ne_zero] + +-- TODO: Generalize to `division_semiring` +lemma add_self_div_two (a : α) : (a + a) / 2 = a := +by rw [← mul_two, mul_div_cancel a two_ne_zero] + +lemma half_pos (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two + +lemma one_half_pos : (0:α) < 1 / 2 := half_pos zero_lt_one + +@[simp] lemma half_le_self_iff : a / 2 ≤ a ↔ 0 ≤ a := +by rw [div_le_iff (zero_lt_two' α), mul_two, le_add_iff_nonneg_left] + +@[simp] lemma half_lt_self_iff : a / 2 < a ↔ 0 < a := +by rw [div_lt_iff (zero_lt_two' α), mul_two, lt_add_iff_pos_left] + +alias half_le_self_iff ↔ _ half_le_self +alias half_lt_self_iff ↔ _ half_lt_self +alias half_lt_self ← div_two_lt_of_pos + +lemma one_half_lt_one : (1 / 2 : α) < 1 := half_lt_self zero_lt_one + +lemma two_inv_lt_one : (2⁻¹ : α) < 1 := (one_div _).symm.trans_lt one_half_lt_one + +lemma left_lt_add_div_two : a < (a + b) / 2 ↔ a < b := by simp [lt_div_iff, mul_two] + +lemma add_div_two_lt_right : (a + b) / 2 < b ↔ a < b := by simp [div_lt_iff, mul_two] + +/-! +### Miscellaneous lemmas +-/ + +lemma mul_le_mul_of_mul_div_le (h : a * (b / c) ≤ d) (hc : 0 < c) : b * a ≤ d * c := +begin + rw [← mul_div_assoc] at h, + rwa [mul_comm b, ← div_le_iff hc], +end + +lemma div_mul_le_div_mul_of_div_le_div (h : a / b ≤ c / d) (he : 0 ≤ e) : + a / (b * e) ≤ c / (d * e) := +begin + rw [div_mul_eq_div_mul_one_div, div_mul_eq_div_mul_one_div], + exact mul_le_mul_of_nonneg_right h (one_div_nonneg.2 he) +end + +lemma exists_pos_mul_lt {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b * c < a := +begin + have : 0 < a / max (b + 1) 1, from div_pos h (lt_max_iff.2 (or.inr zero_lt_one)), + refine ⟨a / max (b + 1) 1, this, _⟩, + rw [← lt_div_iff this, div_div_cancel' h.ne'], + exact lt_max_iff.2 (or.inl $ lt_add_one _) +end + +lemma exists_pos_lt_mul {a : α} (h : 0 < a) (b : α) : ∃ c : α, 0 < c ∧ b < c * a := +let ⟨c, hc₀, hc⟩ := exists_pos_mul_lt h b +in ⟨c⁻¹, inv_pos.2 hc₀, by rwa [← div_eq_inv_mul, lt_div_iff hc₀]⟩ + +lemma monotone.div_const {β : Type*} [preorder β] {f : β → α} (hf : monotone f) + {c : α} (hc : 0 ≤ c) : monotone (λ x, (f x) / c) := +begin + haveI := @linear_order.decidable_le α _, + simpa only [div_eq_mul_inv] using (monotone_mul_right_of_nonneg (inv_nonneg.2 hc)).comp hf +end + +lemma strict_mono.div_const {β : Type*} [preorder β] {f : β → α} (hf : strict_mono f) + {c : α} (hc : 0 < c) : + strict_mono (λ x, (f x) / c) := +by simpa only [div_eq_mul_inv] using hf.mul_const (inv_pos.2 hc) + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_semifield.to_densely_ordered : densely_ordered α := +{ dense := λ a₁ a₂ h, ⟨(a₁ + a₂) / 2, + calc a₁ = (a₁ + a₁) / 2 : (add_self_div_two a₁).symm + ... < (a₁ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_left h _), + calc (a₁ + a₂) / 2 < (a₂ + a₂) / 2 : div_lt_div_of_lt zero_lt_two (add_lt_add_right h _) + ... = a₂ : add_self_div_two a₂⟩ } + +lemma min_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : min (a / c) (b / c) = (min a b) / c := +eq.symm $ monotone.map_min (λ x y, div_le_div_of_le hc) + +lemma max_div_div_right {c : α} (hc : 0 ≤ c) (a b : α) : max (a / c) (b / c) = (max a b) / c := +eq.symm $ monotone.map_max (λ x y, div_le_div_of_le hc) + +lemma one_div_strict_anti_on : strict_anti_on (λ x : α, 1 / x) (set.Ioi 0) := +λ x x1 y y1 xy, (one_div_lt_one_div (set.mem_Ioi.mp y1) (set.mem_Ioi.mp x1)).mpr xy + +lemma one_div_pow_le_one_div_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) : + 1 / a ^ n ≤ 1 / a ^ m := +by refine (one_div_le_one_div _ _).mpr (pow_le_pow a1 mn); + exact pow_pos (zero_lt_one.trans_le a1) _ + +lemma one_div_pow_lt_one_div_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) : + 1 / a ^ n < 1 / a ^ m := +by refine (one_div_lt_one_div _ _).mpr (pow_lt_pow a1 mn); + exact pow_pos (trans zero_lt_one a1) _ + +lemma one_div_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, 1 / a ^ n) := +λ m n, one_div_pow_le_one_div_pow_of_le a1 + +lemma one_div_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, 1 / a ^ n) := +λ m n, one_div_pow_lt_one_div_pow_of_lt a1 + +lemma inv_strict_anti_on : strict_anti_on (λ x : α, x⁻¹) (set.Ioi 0) := +λ x hx y hy xy, (inv_lt_inv hy hx).2 xy + +lemma inv_pow_le_inv_pow_of_le (a1 : 1 ≤ a) {m n : ℕ} (mn : m ≤ n) : + (a ^ n)⁻¹ ≤ (a ^ m)⁻¹ := +by convert one_div_pow_le_one_div_pow_of_le a1 mn; simp + +lemma inv_pow_lt_inv_pow_of_lt (a1 : 1 < a) {m n : ℕ} (mn : m < n) : + (a ^ n)⁻¹ < (a ^ m)⁻¹ := +by convert one_div_pow_lt_one_div_pow_of_lt a1 mn; simp + +lemma inv_pow_anti (a1 : 1 ≤ a) : antitone (λ n : ℕ, (a ^ n)⁻¹) := +λ m n, inv_pow_le_inv_pow_of_le a1 + +lemma inv_pow_strict_anti (a1 : 1 < a) : strict_anti (λ n : ℕ, (a ^ n)⁻¹) := +λ m n, inv_pow_lt_inv_pow_of_lt a1 + +/-! ### Results about `is_lub` and `is_glb` -/ + +lemma is_glb.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) : + is_glb ((λ b, a * b) '' s) (a * b) := +begin + rcases lt_or_eq_of_le ha with ha | rfl, + { exact (order_iso.mul_left₀ _ ha).is_glb_image'.2 hs, }, + { simp_rw zero_mul, + rw hs.nonempty.image_const, + exact is_glb_singleton }, +end + +lemma is_glb.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_glb s b) : + is_glb ((λ b, b * a) '' s) (b * a) := +by simpa [mul_comm] using hs.mul_left ha + +end linear_ordered_semifield + +section +variables [linear_ordered_field α] {a b c d : α} {n : ℤ} + +/-! ### Lemmas about pos, nonneg, nonpos, neg -/ + +lemma div_pos_iff : 0 < a / b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := by simp [division_def, mul_pos_iff] +lemma div_neg_iff : a / b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := by simp [division_def, mul_neg_iff] + +lemma div_nonneg_iff : 0 ≤ a / b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := +by simp [division_def, mul_nonneg_iff] + +lemma div_nonpos_iff : a / b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b := +by simp [division_def, mul_nonpos_iff] + +lemma div_nonneg_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a / b := +div_nonneg_iff.2 $ or.inr ⟨ha, hb⟩ + +lemma div_pos_of_neg_of_neg (ha : a < 0) (hb : b < 0) : 0 < a / b := +div_pos_iff.2 $ or.inr ⟨ha, hb⟩ + +lemma div_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a / b < 0 := +div_neg_iff.2 $ or.inr ⟨ha, hb⟩ + +lemma div_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a / b < 0 := +div_neg_iff.2 $ or.inl ⟨ha, hb⟩ + + +/-! ### Relating one division with another term -/ + +lemma div_le_iff_of_neg (hc : c < 0) : b / c ≤ a ↔ a * c ≤ b := +⟨λ h, div_mul_cancel b (ne_of_lt hc) ▸ mul_le_mul_of_nonpos_right h hc.le, + λ h, calc + a = a * c * (1 / c) : mul_mul_div a (ne_of_lt hc) + ... ≥ b * (1 / c) : mul_le_mul_of_nonpos_right h (one_div_neg.2 hc).le + ... = b / c : (div_eq_mul_one_div b c).symm⟩ + +lemma div_le_iff_of_neg' (hc : c < 0) : b / c ≤ a ↔ c * a ≤ b := +by rw [mul_comm, div_le_iff_of_neg hc] + +lemma le_div_iff_of_neg (hc : c < 0) : a ≤ b / c ↔ b ≤ a * c := +by rw [← neg_neg c, mul_neg, div_neg, le_neg, + div_le_iff (neg_pos.2 hc), neg_mul] + +lemma le_div_iff_of_neg' (hc : c < 0) : a ≤ b / c ↔ b ≤ c * a := +by rw [mul_comm, le_div_iff_of_neg hc] + +lemma div_lt_iff_of_neg (hc : c < 0) : b / c < a ↔ a * c < b := +lt_iff_lt_of_le_iff_le $ le_div_iff_of_neg hc + +lemma div_lt_iff_of_neg' (hc : c < 0) : b / c < a ↔ c * a < b := +by rw [mul_comm, div_lt_iff_of_neg hc] + +lemma lt_div_iff_of_neg (hc : c < 0) : a < b / c ↔ b < a * c := +lt_iff_lt_of_le_iff_le $ div_le_iff_of_neg hc + +lemma lt_div_iff_of_neg' (hc : c < 0) : a < b / c ↔ b < c * a := +by rw [mul_comm, lt_div_iff_of_neg hc] + +lemma div_le_one_of_ge (h : b ≤ a) (hb : b ≤ 0) : a / b ≤ 1 := +by simpa only [neg_div_neg_eq] using div_le_one_of_le (neg_le_neg h) (neg_nonneg_of_nonpos hb) + +/-! ### Bi-implications of inequalities using inversions -/ + +lemma inv_le_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := +by rw [← one_div, div_le_iff_of_neg ha, ← div_eq_inv_mul, div_le_iff_of_neg hb, one_mul] + +lemma inv_le_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ ≤ b ↔ b⁻¹ ≤ a := +by rw [← inv_le_inv_of_neg hb (inv_lt_zero.2 ha), inv_inv] + +lemma le_inv_of_neg (ha : a < 0) (hb : b < 0) : a ≤ b⁻¹ ↔ b ≤ a⁻¹ := +by rw [← inv_le_inv_of_neg (inv_lt_zero.2 hb) ha, inv_inv] + +lemma inv_lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b⁻¹ ↔ b < a := +lt_iff_lt_of_le_iff_le (inv_le_inv_of_neg hb ha) + +lemma inv_lt_of_neg (ha : a < 0) (hb : b < 0) : a⁻¹ < b ↔ b⁻¹ < a := +lt_iff_lt_of_le_iff_le (le_inv_of_neg hb ha) + +lemma lt_inv_of_neg (ha : a < 0) (hb : b < 0) : a < b⁻¹ ↔ b < a⁻¹ := +lt_iff_lt_of_le_iff_le (inv_le_of_neg hb ha) + +/-! ### Relating two divisions -/ + +lemma div_le_div_of_nonpos_of_le (hc : c ≤ 0) (h : b ≤ a) : a / c ≤ b / c := +begin + rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], + exact mul_le_mul_of_nonpos_right h (one_div_nonpos.2 hc) +end + +lemma div_lt_div_of_neg_of_lt (hc : c < 0) (h : b < a) : a / c < b / c := +begin + rw [div_eq_mul_one_div a c, div_eq_mul_one_div b c], + exact mul_lt_mul_of_neg_right h (one_div_neg.2 hc) +end + +lemma div_le_div_right_of_neg (hc : c < 0) : a / c ≤ b / c ↔ b ≤ a := +⟨le_imp_le_of_lt_imp_lt $ div_lt_div_of_neg_of_lt hc, div_le_div_of_nonpos_of_le $ hc.le⟩ + +lemma div_lt_div_right_of_neg (hc : c < 0) : a / c < b / c ↔ b < a := +lt_iff_lt_of_le_iff_le $ div_le_div_right_of_neg hc + +/-! ### Relating one division and involving `1` -/ + +lemma one_le_div_of_neg (hb : b < 0) : 1 ≤ a / b ↔ a ≤ b := +by rw [le_div_iff_of_neg hb, one_mul] + +lemma div_le_one_of_neg (hb : b < 0) : a / b ≤ 1 ↔ b ≤ a := +by rw [div_le_iff_of_neg hb, one_mul] + +lemma one_lt_div_of_neg (hb : b < 0) : 1 < a / b ↔ a < b := +by rw [lt_div_iff_of_neg hb, one_mul] + +lemma div_lt_one_of_neg (hb : b < 0) : a / b < 1 ↔ b < a := +by rw [div_lt_iff_of_neg hb, one_mul] + +lemma one_div_le_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ b ↔ 1 / b ≤ a := +by simpa using inv_le_of_neg ha hb + +lemma one_div_lt_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < b ↔ 1 / b < a := +by simpa using inv_lt_of_neg ha hb + +lemma le_one_div_of_neg (ha : a < 0) (hb : b < 0) : a ≤ 1 / b ↔ b ≤ 1 / a := +by simpa using le_inv_of_neg ha hb + +lemma lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : a < 1 / b ↔ b < 1 / a := +by simpa using lt_inv_of_neg ha hb + +lemma one_lt_div_iff : 1 < a / b ↔ 0 < b ∧ b < a ∨ b < 0 ∧ a < b := +begin + rcases lt_trichotomy b 0 with (hb|rfl|hb), + { simp [hb, hb.not_lt, one_lt_div_of_neg] }, + { simp [lt_irrefl, zero_le_one] }, + { simp [hb, hb.not_lt, one_lt_div] } +end + +lemma one_le_div_iff : 1 ≤ a / b ↔ 0 < b ∧ b ≤ a ∨ b < 0 ∧ a ≤ b := +begin + rcases lt_trichotomy b 0 with (hb|rfl|hb), + { simp [hb, hb.not_lt, one_le_div_of_neg] }, + { simp [lt_irrefl, zero_lt_one.not_le, zero_lt_one] }, + { simp [hb, hb.not_lt, one_le_div] } +end + +lemma div_lt_one_iff : a / b < 1 ↔ 0 < b ∧ a < b ∨ b = 0 ∨ b < 0 ∧ b < a := +begin + rcases lt_trichotomy b 0 with (hb|rfl|hb), + { simp [hb, hb.not_lt, hb.ne, div_lt_one_of_neg] }, + { simp [zero_lt_one], }, + { simp [hb, hb.not_lt, div_lt_one, hb.ne.symm] } +end + +lemma div_le_one_iff : a / b ≤ 1 ↔ 0 < b ∧ a ≤ b ∨ b = 0 ∨ b < 0 ∧ b ≤ a := +begin + rcases lt_trichotomy b 0 with (hb|rfl|hb), + { simp [hb, hb.not_lt, hb.ne, div_le_one_of_neg] }, + { simp [zero_le_one], }, + { simp [hb, hb.not_lt, div_le_one, hb.ne.symm] } +end + +/-! ### Relating two divisions, involving `1` -/ + +lemma one_div_le_one_div_of_neg_of_le (hb : b < 0) (h : a ≤ b) : 1 / b ≤ 1 / a := +by rwa [div_le_iff_of_neg' hb, ← div_eq_mul_one_div, div_le_one_of_neg (h.trans_lt hb)] + +lemma one_div_lt_one_div_of_neg_of_lt (hb : b < 0) (h : a < b) : 1 / b < 1 / a := +by rwa [div_lt_iff_of_neg' hb, ← div_eq_mul_one_div, div_lt_one_of_neg (h.trans hb)] + +lemma le_of_neg_of_one_div_le_one_div (hb : b < 0) (h : 1 / a ≤ 1 / b) : b ≤ a := +le_imp_le_of_lt_imp_lt (one_div_lt_one_div_of_neg_of_lt hb) h + +lemma lt_of_neg_of_one_div_lt_one_div (hb : b < 0) (h : 1 / a < 1 / b) : b < a := +lt_imp_lt_of_le_imp_le (one_div_le_one_div_of_neg_of_le hb) h + +/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_neg_of_lt` and + `lt_of_one_div_lt_one_div` -/ +lemma one_div_le_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a ≤ 1 / b ↔ b ≤ a := +by simpa [one_div] using inv_le_inv_of_neg ha hb + +/-- For the single implications with fewer assumptions, see `one_div_lt_one_div_of_lt` and + `lt_of_one_div_lt_one_div` -/ +lemma one_div_lt_one_div_of_neg (ha : a < 0) (hb : b < 0) : 1 / a < 1 / b ↔ b < a := +lt_iff_lt_of_le_iff_le (one_div_le_one_div_of_neg hb ha) + +lemma one_div_lt_neg_one (h1 : a < 0) (h2 : -1 < a) : 1 / a < -1 := +suffices 1 / a < 1 / -1, by rwa one_div_neg_one_eq_neg_one at this, +one_div_lt_one_div_of_neg_of_lt h1 h2 + +lemma one_div_le_neg_one (h1 : a < 0) (h2 : -1 ≤ a) : 1 / a ≤ -1 := +suffices 1 / a ≤ 1 / -1, by rwa one_div_neg_one_eq_neg_one at this, +one_div_le_one_div_of_neg_of_le h1 h2 + +/-! ### Results about halving -/ + +lemma sub_self_div_two (a : α) : a - a / 2 = a / 2 := +suffices a / 2 + a / 2 - a / 2 = a / 2, by rwa add_halves at this, +by rw [add_sub_cancel] + +lemma div_two_sub_self (a : α) : a / 2 - a = - (a / 2) := +suffices a / 2 - (a / 2 + a / 2) = - (a / 2), by rwa add_halves at this, +by rw [sub_add_eq_sub_sub, sub_self, zero_sub] + +lemma add_sub_div_two_lt (h : a < b) : a + (b - a) / 2 < b := +begin + rwa [← div_sub_div_same, sub_eq_add_neg, add_comm (b/2), ← add_assoc, ← sub_eq_add_neg, + ← lt_sub_iff_add_lt, sub_self_div_two, sub_self_div_two, div_lt_div_right (zero_lt_two' α)] +end + +/-- An inequality involving `2`. -/ +lemma sub_one_div_inv_le_two (a2 : 2 ≤ a) : (1 - 1 / a)⁻¹ ≤ 2 := +begin + -- Take inverses on both sides to obtain `2⁻¹ ≤ 1 - 1 / a` + refine (inv_le_inv_of_le (inv_pos.2 $ zero_lt_two' α) _).trans_eq (inv_inv (2 : α)), + -- move `1 / a` to the left and `1 - 1 / 2 = 1 / 2` to the right to obtain `1 / a ≤ ⅟ 2` + refine (le_sub_iff_add_le.2 (_ : _ + 2⁻¹ = _ ).le).trans ((sub_le_sub_iff_left 1).2 _), + { -- show 2⁻¹ + 2⁻¹ = 1 + exact (two_mul _).symm.trans (mul_inv_cancel two_ne_zero) }, + { -- take inverses on both sides and use the assumption `2 ≤ a`. + exact (one_div a).le.trans (inv_le_inv_of_le zero_lt_two a2) } +end + +/-! ### Results about `is_lub` and `is_glb` -/ + +-- TODO: Generalize to `linear_ordered_semifield` +lemma is_lub.mul_left {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) : + is_lub ((λ b, a * b) '' s) (a * b) := +begin + rcases lt_or_eq_of_le ha with ha | rfl, + { exact (order_iso.mul_left₀ _ ha).is_lub_image'.2 hs, }, + { simp_rw zero_mul, + rw hs.nonempty.image_const, + exact is_lub_singleton }, +end + +-- TODO: Generalize to `linear_ordered_semifield` +lemma is_lub.mul_right {s : set α} (ha : 0 ≤ a) (hs : is_lub s b) : + is_lub ((λ b, b * a) '' s) (b * a) := +by simpa [mul_comm] using hs.mul_left ha + +/-! ### Miscellaneous lemmmas -/ + +lemma mul_sub_mul_div_mul_neg_iff (hc : c ≠ 0) (hd : d ≠ 0) : + (a * d - b * c) / (c * d) < 0 ↔ a / c < b / d := +by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_lt_zero] + +lemma mul_sub_mul_div_mul_nonpos_iff (hc : c ≠ 0) (hd : d ≠ 0) : + (a * d - b * c) / (c * d) ≤ 0 ↔ a / c ≤ b / d := +by rw [mul_comm b c, ← div_sub_div _ _ hc hd, sub_nonpos] + +alias mul_sub_mul_div_mul_neg_iff ↔ div_lt_div_of_mul_sub_mul_div_neg mul_sub_mul_div_mul_neg +alias mul_sub_mul_div_mul_nonpos_iff ↔ + div_le_div_of_mul_sub_mul_div_nonpos mul_sub_mul_div_mul_nonpos + +lemma exists_add_lt_and_pos_of_lt (h : b < a) : ∃ c, b + c < a ∧ 0 < c := +⟨(a - b) / 2, add_sub_div_two_lt h, div_pos (sub_pos_of_lt h) zero_lt_two⟩ + +lemma le_of_forall_sub_le (h : ∀ ε > 0, b - ε ≤ a) : b ≤ a := +begin + contrapose! h, + simpa only [and_comm ((0 : α) < _), lt_sub_iff_add_lt, gt_iff_lt] + using exists_add_lt_and_pos_of_lt h, +end + +lemma mul_self_inj_of_nonneg (a0 : 0 ≤ a) (b0 : 0 ≤ b) : a * a = b * b ↔ a = b := +mul_self_eq_mul_self_iff.trans $ or_iff_left_of_imp $ + λ h, by { subst a, have : b = 0 := le_antisymm (neg_nonneg.1 a0) b0, rw [this, neg_zero] } + +lemma min_div_div_right_of_nonpos (hc : c ≤ 0) (a b : α) : min (a / c) (b / c) = (max a b) / c := +eq.symm $ antitone.map_max $ λ x y, div_le_div_of_nonpos_of_le hc + +lemma max_div_div_right_of_nonpos (hc : c ≤ 0) (a b : α) : max (a / c) (b / c) = (min a b) / c := +eq.symm $ antitone.map_min $ λ x y, div_le_div_of_nonpos_of_le hc + +lemma abs_inv (a : α) : |a⁻¹| = (|a|)⁻¹ := map_inv₀ (abs_hom : α →*₀ α) a +lemma abs_div (a b : α) : |a / b| = |a| / |b| := map_div₀ (abs_hom : α →*₀ α) a b +lemma abs_one_div (a : α) : |1 / a| = 1 / |a| := by rw [abs_div, abs_one] + +end diff --git a/src/algebra/order/field/canonical/basic.lean b/src/algebra/order/field/canonical/basic.lean new file mode 100644 index 0000000000000..90e5f56e0bb7d --- /dev/null +++ b/src/algebra/order/field/canonical/basic.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn +-/ +import algebra.order.field.canonical.defs + +/-! +# Lemmas about canonically ordered semifields. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ +variables {α : Type*} + +section canonically_linear_ordered_semifield +variables [canonically_linear_ordered_semifield α] [has_sub α] [has_ordered_sub α] + +lemma tsub_div (a b c : α) : (a - b) / c = a / c - b / c := by simp_rw [div_eq_mul_inv, tsub_mul] + +end canonically_linear_ordered_semifield diff --git a/src/algebra/order/field/canonical/defs.lean b/src/algebra/order/field/canonical/defs.lean new file mode 100644 index 0000000000000..30e193fa74c16 --- /dev/null +++ b/src/algebra/order/field/canonical/defs.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn +-/ +import algebra.order.field.defs +import algebra.order.ring.canonical +import algebra.order.with_zero + +/-! +# Canonically ordered semifields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +set_option old_structure_cmd true + +variables {α : Type*} + +/-- A canonically linear ordered field is a linear ordered field in which `a ≤ b` iff there exists +`c` with `b = a + c`. -/ +@[protect_proj, ancestor canonically_ordered_comm_semiring linear_ordered_semifield] +class canonically_linear_ordered_semifield (α : Type*) + extends canonically_ordered_comm_semiring α, linear_ordered_semifield α + +@[priority 100] -- See note [lower instance priority] +instance canonically_linear_ordered_semifield.to_linear_ordered_comm_group_with_zero + [canonically_linear_ordered_semifield α] : linear_ordered_comm_group_with_zero α := +{ mul_le_mul_left := λ a b h c, mul_le_mul_of_nonneg_left h $ zero_le _, + ..‹canonically_linear_ordered_semifield α› } + +@[priority 100] -- See note [lower instance priority] +instance canonically_linear_ordered_semifield.to_canonically_linear_ordered_add_monoid + [canonically_linear_ordered_semifield α] : canonically_linear_ordered_add_monoid α := +{ ..‹canonically_linear_ordered_semifield α› } diff --git a/src/algebra/order/field/defs.lean b/src/algebra/order/field/defs.lean new file mode 100644 index 0000000000000..b65b95b79824c --- /dev/null +++ b/src/algebra/order/field/defs.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn +-/ +import algebra.field.defs +import algebra.order.ring.defs + +/-! +# Linear ordered (semi)fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A linear ordered (semi)field is a (semi)field equipped with a linear order such that +* addition respects the order: `a ≤ b → c + a ≤ c + b`; +* multiplication of positives is positive: `0 < a → 0 < b → 0 < a * b`; +* `0 < 1`. + +## Main Definitions + +* `linear_ordered_semifield`: Typeclass for linear order semifields. +* `linear_ordered_field`: Typeclass for linear ordered fields. + +## Implementation details + +For olean caching reasons, this file is separate to the main file, `algebra.order.field.basic`. +The lemmata are instead located there. + +-/ + +set_option old_structure_cmd true + +variables {α : Type*} + +/-- A linear ordered semifield is a field with a linear order respecting the operations. -/ +@[protect_proj, ancestor linear_ordered_comm_semiring semifield] +class linear_ordered_semifield (α : Type*) extends linear_ordered_comm_semiring α, semifield α + +/-- A linear ordered field is a field with a linear order respecting the operations. -/ +@[protect_proj, ancestor linear_ordered_comm_ring field] +class linear_ordered_field (α : Type*) extends linear_ordered_comm_ring α, field α + +@[priority 100] -- See note [lower instance priority] +instance linear_ordered_field.to_linear_ordered_semifield [linear_ordered_field α] : + linear_ordered_semifield α := +{ ..linear_ordered_ring.to_linear_ordered_semiring, ..‹linear_ordered_field α› } + +-- Guard against import creep. +assert_not_exists monoid_hom diff --git a/src/algebra/order/field/inj_surj.lean b/src/algebra/order/field/inj_surj.lean new file mode 100644 index 0000000000000..01a1d0f929096 --- /dev/null +++ b/src/algebra/order/field/inj_surj.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn +-/ +import algebra.order.field.defs +import algebra.field.basic +import algebra.order.ring.inj_surj + +/-! +# Pulling back linearly ordered fields along injective maps. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +open function order_dual + +variables {ι α β : Type*} + +namespace function + +/-- Pullback a `linear_ordered_semifield` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +def injective.linear_ordered_semifield [linear_ordered_semifield α] [has_zero β] [has_one β] + [has_add β] [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] [has_inv β] [has_div β] + [has_pow β ℤ] [has_sup β] [has_inf β] (f : β → α) (hf : injective f) (zero : f 0 = 0) + (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) + (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_semifield β := +{ ..hf.linear_ordered_semiring f zero one add mul nsmul npow nat_cast hsup hinf, + ..hf.semifield f zero one add mul inv div nsmul npow zpow nat_cast } + +/-- Pullback a `linear_ordered_field` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +def injective.linear_ordered_field [linear_ordered_field α] [has_zero β] [has_one β] [has_add β] + [has_mul β] [has_neg β] [has_sub β] [has_pow β ℕ] [has_smul ℕ β] [has_smul ℤ β] [has_smul ℚ β] + [has_nat_cast β] [has_int_cast β] [has_rat_cast β] [has_inv β] [has_div β] [has_pow β ℤ] + [has_sup β] [has_inf β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) (div : ∀ x y, f (x / y) = f x / f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (qsmul : ∀ x (n : ℚ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) (rat_cast : ∀ n : ℚ, f n = n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_field β := +{ .. hf.linear_ordered_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast hsup hinf, + .. hf.field f zero one add mul neg sub inv div nsmul zsmul qsmul npow zpow nat_cast int_cast + rat_cast } + +end function diff --git a/src/algebra/order/field/pi.lean b/src/algebra/order/field/pi.lean new file mode 100644 index 0000000000000..1b4b66e5a7e25 --- /dev/null +++ b/src/algebra/order/field/pi.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.order.field.basic +import data.fintype.lattice + +/-! +# Lemmas about (finite domain) functions into fields. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We split this from `algebra.order.field.basic` to avoid importing the finiteness hierarchy there. +-/ + +variables {α ι : Type*} [linear_ordered_semifield α] + +lemma pi.exists_forall_pos_add_lt [has_exists_add_of_le α] [finite ι] {x y : ι → α} + (h : ∀ i, x i < y i) : ∃ ε, 0 < ε ∧ ∀ i, x i + ε < y i := +begin + casesI nonempty_fintype ι, + casesI is_empty_or_nonempty ι, + { exact ⟨1, zero_lt_one, is_empty_elim⟩ }, + choose ε hε hxε using λ i, exists_pos_add_of_lt' (h i), + obtain rfl : x + ε = y := funext hxε, + have hε : 0 < finset.univ.inf' finset.univ_nonempty ε := (finset.lt_inf'_iff _).2 (λ i _, hε _), + exact ⟨_, half_pos hε, λ i, add_lt_add_left ((half_lt_self hε).trans_le $ finset.inf'_le _ $ + finset.mem_univ _) _⟩, +end diff --git a/src/algebra/order/field/power.lean b/src/algebra/order/field/power.lean new file mode 100644 index 0000000000000..d694900f7994e --- /dev/null +++ b/src/algebra/order/field/power.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2014 Robert Lewis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Robert Lewis, Leonardo de Moura, Mario Carneiro, Floris van Doorn +-/ +import algebra.parity +import algebra.char_zero.lemmas +import algebra.group_with_zero.power +import algebra.order.field.basic + +/-! +# Lemmas about powers in ordered fields. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} +open function + +section linear_ordered_semifield +variables [linear_ordered_semifield α] {a b c d e : α} {m n : ℤ} + +/-! ### Integer powers -/ + +lemma zpow_le_of_le (ha : 1 ≤ a) (h : m ≤ n) : a ^ m ≤ a ^ n := +begin + have ha₀ : 0 < a, from one_pos.trans_le ha, + lift n - m to ℕ using sub_nonneg.2 h with k hk, + calc a ^ m = a ^ m * 1 : (mul_one _).symm + ... ≤ a ^ m * a ^ k : mul_le_mul_of_nonneg_left (one_le_pow_of_one_le ha _) (zpow_nonneg ha₀.le _) + ... = a ^ n : by rw [← zpow_coe_nat, ← zpow_add₀ ha₀.ne', hk, add_sub_cancel'_right] +end + +lemma zpow_le_one_of_nonpos (ha : 1 ≤ a) (hn : n ≤ 0) : a ^ n ≤ 1 := +(zpow_le_of_le ha hn).trans_eq $ zpow_zero _ + +lemma one_le_zpow_of_nonneg (ha : 1 ≤ a) (hn : 0 ≤ n) : 1 ≤ a ^ n := +(zpow_zero _).symm.trans_le $ zpow_le_of_le ha hn + +protected lemma nat.zpow_pos_of_pos {a : ℕ} (h : 0 < a) (n : ℤ) : 0 < (a : α)^n := +by { apply zpow_pos_of_pos, exact_mod_cast h } + +lemma nat.zpow_ne_zero_of_pos {a : ℕ} (h : 0 < a) (n : ℤ) : (a : α)^n ≠ 0 := +(nat.zpow_pos_of_pos h n).ne' + +lemma one_lt_zpow (ha : 1 < a) : ∀ n : ℤ, 0 < n → 1 < a ^ n +| (n : ℕ) h := (zpow_coe_nat _ _).symm.subst (one_lt_pow ha $ int.coe_nat_ne_zero.mp h.ne') +| -[1+ n] h := ((int.neg_succ_not_pos _).mp h).elim + +lemma zpow_strict_mono (hx : 1 < a) : strict_mono ((^) a : ℤ → α) := +strict_mono_int_of_lt_succ $ λ n, +have xpos : 0 < a, from zero_lt_one.trans hx, +calc a ^ n < a ^ n * a : lt_mul_of_one_lt_right (zpow_pos_of_pos xpos _) hx +... = a ^ (n + 1) : (zpow_add_one₀ xpos.ne' _).symm + +lemma zpow_strict_anti (h₀ : 0 < a) (h₁ : a < 1) : strict_anti ((^) a : ℤ → α) := +strict_anti_int_of_succ_lt $ λ n, +calc a ^ (n + 1) = a ^ n * a : zpow_add_one₀ h₀.ne' _ +... < a ^ n * 1 : (mul_lt_mul_left $ zpow_pos_of_pos h₀ _).2 h₁ +... = a ^ n : mul_one _ + +@[simp] lemma zpow_lt_iff_lt (hx : 1 < a) : a ^ m < a ^ n ↔ m < n := (zpow_strict_mono hx).lt_iff_lt +@[simp] lemma zpow_le_iff_le (hx : 1 < a) : a ^ m ≤ a ^ n ↔ m ≤ n := (zpow_strict_mono hx).le_iff_le + +@[simp] lemma div_pow_le (ha : 0 ≤ a) (hb : 1 ≤ b) (k : ℕ) : a/b^k ≤ a := +div_le_self ha $ one_le_pow_of_one_le hb _ + +lemma zpow_injective (h₀ : 0 < a) (h₁ : a ≠ 1) : injective ((^) a : ℤ → α) := +begin + rcases h₁.lt_or_lt with H|H, + { exact (zpow_strict_anti h₀ H).injective }, + { exact (zpow_strict_mono H).injective } +end + +@[simp] lemma zpow_inj (h₀ : 0 < a) (h₁ : a ≠ 1) : a ^ m = a ^ n ↔ m = n := +(zpow_injective h₀ h₁).eq_iff + +lemma zpow_le_max_of_min_le {x : α} (hx : 1 ≤ x) {a b c : ℤ} (h : min a b ≤ c) : + x ^ -c ≤ max (x ^ -a) (x ^ -b) := +begin + have : antitone (λ n : ℤ, x ^ -n) := λ m n h, zpow_le_of_le hx (neg_le_neg h), + exact (this h).trans_eq this.map_min, +end + +lemma zpow_le_max_iff_min_le {x : α} (hx : 1 < x) {a b c : ℤ} : + x ^ -c ≤ max (x ^ -a) (x ^ -b) ↔ min a b ≤ c := +by simp_rw [le_max_iff, min_le_iff, zpow_le_iff_le hx, neg_le_neg_iff] + +end linear_ordered_semifield + +section linear_ordered_field +variables [linear_ordered_field α] {a b c d : α} {n : ℤ} + +/-! ### Lemmas about powers to numerals. -/ + +lemma zpow_bit0_nonneg (a : α) (n : ℤ) : 0 ≤ a ^ bit0 n := +(mul_self_nonneg _).trans_eq $ (zpow_bit0 _ _).symm + +lemma zpow_two_nonneg (a : α) : 0 ≤ a ^ (2 : ℤ) := zpow_bit0_nonneg _ _ +lemma zpow_neg_two_nonneg (a : α) : 0 ≤ a ^ (-2 : ℤ) := zpow_bit0_nonneg _ (-1) + +lemma zpow_bit0_pos (h : a ≠ 0) (n : ℤ) : 0 < a ^ bit0 n := +(zpow_bit0_nonneg a n).lt_of_ne (zpow_ne_zero _ h).symm + +lemma zpow_two_pos_of_ne_zero (h : a ≠ 0) : 0 < a ^ (2 : ℤ) := zpow_bit0_pos h _ + +@[simp] lemma zpow_bit0_pos_iff (hn : n ≠ 0) : 0 < a ^ bit0 n ↔ a ≠ 0 := +⟨by { rintro h rfl, refine (zero_zpow _ _).not_gt h, rwa bit0_ne_zero }, λ h, zpow_bit0_pos h _⟩ + +@[simp] lemma zpow_bit1_neg_iff : a ^ bit1 n < 0 ↔ a < 0 := +⟨λ h, not_le.1 $ λ h', not_le.2 h $ zpow_nonneg h' _, + λ h, by rw [bit1, zpow_add_one₀ h.ne]; exact mul_neg_of_pos_of_neg (zpow_bit0_pos h.ne _) h⟩ + +@[simp] lemma zpow_bit1_nonneg_iff : 0 ≤ a ^ bit1 n ↔ 0 ≤ a := +le_iff_le_iff_lt_iff_lt.2 zpow_bit1_neg_iff + +@[simp] lemma zpow_bit1_nonpos_iff : a ^ bit1 n ≤ 0 ↔ a ≤ 0 := +by rw [le_iff_lt_or_eq, le_iff_lt_or_eq, zpow_bit1_neg_iff, zpow_eq_zero_iff (int.bit1_ne_zero n)] + +@[simp] lemma zpow_bit1_pos_iff : 0 < a ^ bit1 n ↔ 0 < a := +lt_iff_lt_of_le_iff_le zpow_bit1_nonpos_iff + +protected lemma even.zpow_nonneg (hn : even n) (a : α) : 0 ≤ a ^ n := +by obtain ⟨k, rfl⟩ := hn; exact zpow_bit0_nonneg _ _ + +lemma even.zpow_pos_iff (hn : even n) (h : n ≠ 0) : 0 < a ^ n ↔ a ≠ 0 := +by obtain ⟨k, rfl⟩ := hn; exact zpow_bit0_pos_iff (by rintro rfl; simpa using h) + +lemma odd.zpow_neg_iff (hn : odd n) : a ^ n < 0 ↔ a < 0 := +by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_neg_iff + +protected lemma odd.zpow_nonneg_iff (hn : odd n) : 0 ≤ a ^ n ↔ 0 ≤ a := +by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_nonneg_iff + +lemma odd.zpow_nonpos_iff (hn : odd n) : a ^ n ≤ 0 ↔ a ≤ 0 := +by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_nonpos_iff + +lemma odd.zpow_pos_iff (hn : odd n) : 0 < a ^ n ↔ 0 < a := +by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_pos_iff + +alias even.zpow_pos_iff ↔ _ even.zpow_pos +alias odd.zpow_neg_iff ↔ _ odd.zpow_neg +alias odd.zpow_nonpos_iff ↔ _ odd.zpow_nonpos + +lemma even.zpow_abs {p : ℤ} (hp : even p) (a : α) : |a| ^ p = a ^ p := +by cases abs_choice a with h h; simp only [h, hp.neg_zpow _] + +@[simp] lemma zpow_bit0_abs (a : α) (p : ℤ) : |a| ^ bit0 p = a ^ bit0 p := (even_bit0 _).zpow_abs _ + +/-! ### Miscellaneous lemmmas -/ + +/-- Bernoulli's inequality reformulated to estimate `(n : α)`. -/ +lemma nat.cast_le_pow_sub_div_sub (H : 1 < a) (n : ℕ) : (n : α) ≤ (a ^ n - 1) / (a - 1) := +(le_div_iff (sub_pos.2 H)).2 $ le_sub_left_of_add_le $ + one_add_mul_sub_le_pow ((neg_le_self zero_le_one).trans H.le) _ + +/-- For any `a > 1` and a natural `n` we have `n ≤ a ^ n / (a - 1)`. See also +`nat.cast_le_pow_sub_div_sub` for a stronger inequality with `a ^ n - 1` in the numerator. -/ +theorem nat.cast_le_pow_div_sub (H : 1 < a) (n : ℕ) : (n : α) ≤ a ^ n / (a - 1) := +(n.cast_le_pow_sub_div_sub H).trans $ div_le_div_of_le (sub_nonneg.2 H.le) + (sub_le_self _ zero_le_one) + +end linear_ordered_field diff --git a/src/algebra/order/floor.lean b/src/algebra/order/floor.lean index c93af3024e19f..f72aa511ecbcf 100644 --- a/src/algebra/order/floor.lean +++ b/src/algebra/order/floor.lean @@ -3,12 +3,19 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Kevin Kappelmann -/ +import data.int.lemmas +import data.set.intervals.group +import data.set.lattice import tactic.abel import tactic.linarith +import tactic.positivity /-! # Floor and ceil +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary We define the natural- and integer-valued floor and ceil functions on linearly ordered rings. @@ -23,6 +30,7 @@ We define the natural- and integer-valued floor and ceil functions on linearly o * `int.floor a`: Greatest integer `z` such that `z ≤ a`. * `int.ceil a`: Least integer `z` such that `a ≤ z`. * `int.fract a`: Fractional part of `a`, defined as `a - floor a`. +* `round a`: Nearest integer to `a`. It rounds halves towards infinity. ## Notations @@ -36,8 +44,6 @@ for `nnnorm`. ## TODO -Some `nat.floor` and `nat.ceil` lemmas require `linear_ordered_ring α`. Is `has_ordered_sub` enough? - `linear_ordered_ring`/`linear_ordered_semiring` can be relaxed to `order_ring`/`order_semiring` in many lemmas. @@ -47,7 +53,7 @@ rounding, floor, ceil -/ open set -variables {α : Type*} +variables {F α β : Type*} /-! ### Floor semiring -/ @@ -96,18 +102,23 @@ lemma le_floor (h : (n : α) ≤ a) : n ≤ ⌊a⌋₊ := (le_floor_iff $ n.cast lemma floor_lt (ha : 0 ≤ a) : ⌊a⌋₊ < n ↔ a < n := lt_iff_lt_of_le_iff_le $ le_floor_iff ha +lemma floor_lt_one (ha : 0 ≤ a) : ⌊a⌋₊ < 1 ↔ a < 1 := +(floor_lt ha).trans $ by rw nat.cast_one + lemma lt_of_floor_lt (h : ⌊a⌋₊ < n) : a < n := lt_of_not_le $ λ h', (le_floor h').not_lt h +lemma lt_one_of_floor_lt_one (h : ⌊a⌋₊ < 1) : a < 1 := by exact_mod_cast lt_of_floor_lt h + lemma floor_le (ha : 0 ≤ a) : (⌊a⌋₊ : α) ≤ a := (le_floor_iff ha).1 le_rfl lemma lt_succ_floor (a : α) : a < ⌊a⌋₊.succ := lt_of_floor_lt $ nat.lt_succ_self _ -lemma lt_floor_add_one (a : α) : a < ⌊a⌋₊ + 1 := lt_succ_floor a +lemma lt_floor_add_one (a : α) : a < ⌊a⌋₊ + 1 := by simpa using lt_succ_floor a @[simp] lemma floor_coe (n : ℕ) : ⌊(n : α)⌋₊ = n := eq_of_forall_le_iff $ λ a, by { rw [le_floor_iff, nat.cast_le], exact n.cast_nonneg } -@[simp] lemma floor_zero : ⌊(0 : α)⌋₊ = 0 := floor_coe 0 +@[simp] lemma floor_zero : ⌊(0 : α)⌋₊ = 0 := by rw [← nat.cast_zero, floor_coe] @[simp] lemma floor_one : ⌊(1 : α)⌋₊ = 1 := by rw [←nat.cast_one, floor_coe] @@ -146,6 +157,9 @@ lemma lt_of_lt_floor (h : n < ⌊a⌋₊) : ↑n < a := lemma floor_le_of_le (h : a ≤ n) : ⌊a⌋₊ ≤ n := le_imp_le_iff_lt_imp_lt.2 lt_of_lt_floor h +lemma floor_le_one_of_le_one (h : a ≤ 1) : ⌊a⌋₊ ≤ 1 := +floor_le_of_le $ h.trans_eq $ nat.cast_one.symm + @[simp] lemma floor_eq_zero : ⌊a⌋₊ = 0 ↔ a < 1 := by { rw [←lt_one_iff, ←@cast_one α], exact floor_lt' nat.one_ne_zero } @@ -177,16 +191,33 @@ lemma gc_ceil_coe : galois_connection (ceil : α → ℕ) coe := floor_semiring. lemma lt_ceil : n < ⌈a⌉₊ ↔ (n : α) < a := lt_iff_lt_of_le_iff_le ceil_le +@[simp] lemma add_one_le_ceil_iff : n + 1 ≤ ⌈a⌉₊ ↔ (n : α) < a := +by rw [← nat.lt_ceil, nat.add_one_le_iff] + +@[simp] lemma one_le_ceil_iff : 1 ≤ ⌈a⌉₊ ↔ 0 < a := +by rw [← zero_add 1, nat.add_one_le_ceil_iff, nat.cast_zero] + +lemma ceil_le_floor_add_one (a : α) : ⌈a⌉₊ ≤ ⌊a⌋₊ + 1 := +by { rw [ceil_le, nat.cast_add, nat.cast_one], exact (lt_floor_add_one a).le } + lemma le_ceil (a : α) : a ≤ ⌈a⌉₊ := ceil_le.1 le_rfl +@[simp] lemma ceil_int_cast {α : Type*} [linear_ordered_ring α] + [floor_semiring α] (z : ℤ) : ⌈(z : α)⌉₊ = z.to_nat := +eq_of_forall_ge_iff $ λ a, by { simp, norm_cast } + +@[simp] lemma ceil_nat_cast (n : ℕ) : ⌈(n : α)⌉₊ = n := +eq_of_forall_ge_iff $ λ a, by rw [ceil_le, cast_le] + lemma ceil_mono : monotone (ceil : α → ℕ) := gc_ceil_coe.monotone_l -@[simp] lemma ceil_coe (n : ℕ) : ⌈(n : α)⌉₊ = n := -eq_of_forall_ge_iff $ λ a, ceil_le.trans nat.cast_le +@[simp] lemma ceil_zero : ⌈(0 : α)⌉₊ = 0 := by rw [← nat.cast_zero, ceil_nat_cast] -@[simp] lemma ceil_zero : ⌈(0 : α)⌉₊ = 0 := ceil_coe 0 +@[simp] lemma ceil_one : ⌈(1 : α)⌉₊ = 1 := by rw [←nat.cast_one, ceil_nat_cast] -@[simp] lemma ceil_eq_zero : ⌈a⌉₊ = 0 ↔ a ≤ 0 := le_zero_iff.symm.trans ceil_le +@[simp] lemma ceil_eq_zero : ⌈a⌉₊ = 0 ↔ a ≤ 0 := by rw [← le_zero_iff, ceil_le, nat.cast_zero] + +@[simp] lemma ceil_pos : 0 < ⌈a⌉₊ ↔ 0 < a := by rw [lt_ceil, cast_zero] lemma lt_of_ceil_lt (h : ⌈a⌉₊ < n) : a < n := (le_ceil a).trans_lt (nat.cast_lt.2 h) @@ -204,7 +235,7 @@ lemma floor_lt_ceil_of_lt_of_pos {a b : α} (h : a < b) (h' : 0 < b) : ⌊a⌋ begin rcases le_or_lt 0 a with ha|ha, { rw floor_lt ha, exact h.trans_le (le_ceil _) }, - { rwa [floor_of_nonpos ha.le, lt_ceil] } + { rwa [floor_of_nonpos ha.le, lt_ceil, nat.cast_zero] } end lemma ceil_eq_iff (hn : n ≠ 0) : ⌈a⌉₊ = n ↔ ↑(n - 1) < a ∧ a ≤ n := @@ -247,44 +278,44 @@ by { ext, simp [lt_ceil] } @[simp] lemma preimage_Iic {a : α} (ha : 0 ≤ a) : ((coe : ℕ → α) ⁻¹' (set.Iic a)) = set.Iic ⌊a⌋₊ := by { ext, simp [le_floor_iff, ha] } -end linear_ordered_semiring - -section linear_ordered_ring -variables [linear_ordered_ring α] [floor_semiring α] {a : α} {n : ℕ} - lemma floor_add_nat (ha : 0 ≤ a) (n : ℕ) : ⌊a + n⌋₊ = ⌊a⌋₊ + n := eq_of_forall_le_iff $ λ b, begin - rw [le_floor_iff (add_nonneg ha n.cast_nonneg), ←sub_le_iff_le_add], + rw [le_floor_iff (add_nonneg ha n.cast_nonneg)], obtain hb | hb := le_total n b, - { rw [←cast_sub hb, ←tsub_le_iff_right], - exact (le_floor_iff ha).symm }, - { exact iff_of_true ((sub_nonpos_of_le $ cast_le.2 hb).trans ha) (le_add_left hb) } + { obtain ⟨d, rfl⟩ := exists_add_of_le hb, + rw [nat.cast_add, add_comm n, add_comm (n : α), add_le_add_iff_right, add_le_add_iff_right, + le_floor_iff ha] }, + { obtain ⟨d, rfl⟩ := exists_add_of_le hb, + rw [nat.cast_add, add_left_comm _ b, add_left_comm _ (b : α)], + refine iff_of_true _ le_self_add, + exact (le_add_of_nonneg_right $ ha.trans $ le_add_of_nonneg_right d.cast_nonneg) } end lemma floor_add_one (ha : 0 ≤ a) : ⌊a + 1⌋₊ = ⌊a⌋₊ + 1 := by { convert floor_add_nat ha 1, exact cast_one.symm } -lemma floor_sub_nat (a : α) (n : ℕ) : ⌊a - n⌋₊ = ⌊a⌋₊ - n := +lemma floor_sub_nat [has_sub α] [has_ordered_sub α] [has_exists_add_of_le α] (a : α) (n : ℕ) : + ⌊a - n⌋₊ = ⌊a⌋₊ - n := begin obtain ha | ha := le_total a 0, - { rw [floor_of_nonpos ha, floor_of_nonpos (sub_nonpos_of_le (ha.trans n.cast_nonneg)), + { rw [floor_of_nonpos ha, floor_of_nonpos (tsub_nonpos_of_le (ha.trans n.cast_nonneg)), zero_tsub] }, cases le_total a n, { rw [floor_of_nonpos (tsub_nonpos_of_le h), eq_comm, tsub_eq_zero_iff_le], exact nat.cast_le.1 ((nat.floor_le ha).trans h) }, - { rw [eq_tsub_iff_add_eq_of_le (le_floor h), ←floor_add_nat (sub_nonneg_of_le h), - sub_add_cancel] } + { rw [eq_tsub_iff_add_eq_of_le (le_floor h), ←floor_add_nat _, + tsub_add_cancel_of_le h], + exact le_tsub_of_add_le_left ((add_zero _).trans_le h), } end -lemma sub_one_lt_floor (a : α) : a - 1 < ⌊a⌋₊ := sub_lt_iff_lt_add.2 $ lt_floor_add_one a - lemma ceil_add_nat (ha : 0 ≤ a) (n : ℕ) : ⌈a + n⌉₊ = ⌈a⌉₊ + n := eq_of_forall_ge_iff $ λ b, begin rw [←not_lt, ←not_lt, not_iff_not], rw [lt_ceil], obtain hb | hb := le_or_lt n b, - { rw [←tsub_lt_iff_right hb, ←sub_lt_iff_lt_add, ←cast_sub hb], - exact lt_ceil.symm }, + { obtain ⟨d, rfl⟩ := exists_add_of_le hb, + rw [nat.cast_add, add_comm n, add_comm (n : α), add_lt_add_iff_right, add_lt_add_iff_right, + lt_ceil] }, { exact iff_of_true (lt_add_of_nonneg_of_lt ha $ cast_lt.2 hb) (lt_add_left _ _ _ hb) } end @@ -294,10 +325,23 @@ by { convert ceil_add_nat ha 1, exact cast_one.symm } lemma ceil_lt_add_one (ha : 0 ≤ a) : (⌈a⌉₊ : α) < a + 1 := lt_ceil.1 $ (nat.lt_succ_self _).trans_le (ceil_add_one ha).ge +lemma ceil_add_le (a b : α) : ⌈a + b⌉₊ ≤ ⌈a⌉₊ + ⌈b⌉₊ := +begin + rw [ceil_le, nat.cast_add], + exact add_le_add (le_ceil _) (le_ceil _), +end + +end linear_ordered_semiring + +section linear_ordered_ring +variables [linear_ordered_ring α] [floor_semiring α] + +lemma sub_one_lt_floor (a : α) : a - 1 < ⌊a⌋₊ := sub_lt_iff_lt_add.2 $ lt_floor_add_one a + end linear_ordered_ring -section linear_ordered_field -variables [linear_ordered_field α] [floor_semiring α] +section linear_ordered_semifield +variables [linear_ordered_semifield α] [floor_semiring α] lemma floor_div_nat (a : α) (n : ℕ) : ⌊a / n⌋₊ = ⌊a⌋₊ / n := begin @@ -320,7 +364,7 @@ end lemma floor_div_eq_div (m n : ℕ) : ⌊(m : α) / n⌋₊ = m / n := by { convert floor_div_nat (m : α) n, rw m.floor_coe } -end linear_ordered_field +end linear_ordered_semifield end nat @@ -408,27 +452,35 @@ lemma floor_lt : ⌊a⌋ < z ↔ a < z := lt_iff_lt_of_le_iff_le le_floor lemma floor_le (a : α) : (⌊a⌋ : α) ≤ a := gc_coe_floor.l_u_le a -lemma floor_nonneg : 0 ≤ ⌊a⌋ ↔ 0 ≤ a := le_floor +lemma floor_nonneg : 0 ≤ ⌊a⌋ ↔ 0 ≤ a := by rw [le_floor, int.cast_zero] + +@[simp] lemma floor_le_sub_one_iff : ⌊a⌋ ≤ z - 1 ↔ a < z := by rw [← floor_lt, le_sub_one_iff] + +@[simp] lemma floor_le_neg_one_iff : ⌊a⌋ ≤ -1 ↔ a < 0 := +by rw [← zero_sub (1 : ℤ), floor_le_sub_one_iff, cast_zero] lemma floor_nonpos (ha : a ≤ 0) : ⌊a⌋ ≤ 0 := begin - rw ←@cast_le α, + rw [← @cast_le α, int.cast_zero], exact (floor_le a).trans ha, end lemma lt_succ_floor (a : α) : a < ⌊a⌋.succ := floor_lt.1 $ int.lt_succ_self _ -lemma lt_floor_add_one (a : α) : a < ⌊a⌋ + 1 := +@[simp] lemma lt_floor_add_one (a : α) : a < ⌊a⌋ + 1 := by simpa only [int.succ, int.cast_add, int.cast_one] using lt_succ_floor a -lemma sub_one_lt_floor (a : α) : a - 1 < ⌊a⌋ := sub_lt_iff_lt_add.2 (lt_floor_add_one a) +@[simp] lemma sub_one_lt_floor (a : α) : a - 1 < ⌊a⌋ := sub_lt_iff_lt_add.2 (lt_floor_add_one a) -@[simp] lemma floor_coe (z : ℤ) : ⌊(z : α)⌋ = z := +@[simp] lemma floor_int_cast (z : ℤ) : ⌊(z : α)⌋ = z := eq_of_forall_le_iff $ λ a, by rw [le_floor, int.cast_le] -@[simp] lemma floor_zero : ⌊(0 : α)⌋ = 0 := floor_coe 0 +@[simp] lemma floor_nat_cast (n : ℕ) : ⌊(n : α)⌋ = n := +eq_of_forall_le_iff $ λ a, by rw [le_floor, ← cast_coe_nat, cast_le] -@[simp] lemma floor_one : ⌊(1 : α)⌋ = 1 := by rw [← int.cast_one, floor_coe] +@[simp] lemma floor_zero : ⌊(0 : α)⌋ = 0 := by rw [← cast_zero, floor_int_cast] + +@[simp] lemma floor_one : ⌊(1 : α)⌋ = 1 := by rw [← cast_one, floor_int_cast] @[mono] lemma floor_mono : monotone (floor : α → ℤ) := gc_coe_floor.monotone_u @@ -442,17 +494,34 @@ eq_of_forall_le_iff $ λ a, by rw [le_floor, lemma floor_add_one (a : α) : ⌊a + 1⌋ = ⌊a⌋ + 1 := by { convert floor_add_int a 1, exact cast_one.symm } +lemma le_floor_add (a b : α) : ⌊a⌋ + ⌊b⌋ ≤ ⌊a + b⌋ := +begin + rw [le_floor, int.cast_add], + exact add_le_add (floor_le _) (floor_le _), +end + +lemma le_floor_add_floor (a b : α) : ⌊a + b⌋ - 1 ≤ ⌊a⌋ + ⌊b⌋ := +begin + rw [←sub_le_iff_le_add, le_floor, int.cast_sub, sub_le_comm, int.cast_sub, int.cast_one], + refine le_trans _ (sub_one_lt_floor _).le, + rw [sub_le_iff_le_add', ←add_sub_assoc, sub_le_sub_iff_right], + exact floor_le _, +end + @[simp] lemma floor_int_add (z : ℤ) (a : α) : ⌊↑z + a⌋ = z + ⌊a⌋ := by simpa only [add_comm] using floor_add_int a z -@[simp] lemma floor_add_nat (a : α) (n : ℕ) : ⌊a + n⌋ = ⌊a⌋ + n := floor_add_int a n +@[simp] lemma floor_add_nat (a : α) (n : ℕ) : ⌊a + n⌋ = ⌊a⌋ + n := +by rw [← int.cast_coe_nat, floor_add_int] -@[simp] lemma floor_nat_add (n : ℕ) (a : α) : ⌊↑n + a⌋ = n + ⌊a⌋ := floor_int_add n a +@[simp] lemma floor_nat_add (n : ℕ) (a : α) : ⌊↑n + a⌋ = n + ⌊a⌋ := +by rw [← int.cast_coe_nat, floor_int_add] @[simp] lemma floor_sub_int (a : α) (z : ℤ) : ⌊a - z⌋ = ⌊a⌋ - z := eq.trans (by rw [int.cast_neg, sub_eq_add_neg]) (floor_add_int _ _) -@[simp] lemma floor_sub_nat (a : α) (n : ℕ) : ⌊a - n⌋ = ⌊a⌋ - n := floor_sub_int a n +@[simp] lemma floor_sub_nat (a : α) (n : ℕ) : ⌊a - n⌋ = ⌊a⌋ - n := +by rw [← int.cast_coe_nat, floor_sub_int] lemma abs_sub_lt_one_of_floor_eq_floor {α : Type*} [linear_ordered_comm_ring α] [floor_ring α] {a b : α} (h : ⌊a⌋ = ⌊b⌋) : |a - b| < 1 := @@ -469,6 +538,8 @@ lemma floor_eq_iff : ⌊a⌋ = z ↔ ↑z ≤ a ∧ a < z + 1 := by rw [le_antisymm_iff, le_floor, ←int.lt_add_one_iff, floor_lt, int.cast_add, int.cast_one, and.comm] +@[simp] lemma floor_eq_zero_iff : ⌊a⌋ = 0 ↔ a ∈ Ico (0 : α) 1 := by simp [floor_eq_iff] + lemma floor_eq_on_Ico (n : ℤ) : ∀ a ∈ set.Ico (n : α) (n + 1), ⌊a⌋ = n := λ a ⟨h₀, h₁⟩, floor_eq_iff.mpr ⟨h₀, h₁⟩ @@ -489,29 +560,64 @@ ext $ λ x, floor_eq_iff @[simp] lemma fract_add_int (a : α) (m : ℤ) : fract (a + m) = fract a := by { rw fract, simp } +@[simp] lemma fract_add_nat (a : α) (m : ℕ) : fract (a + m) = fract a := +by { rw fract, simp } + @[simp] lemma fract_sub_int (a : α) (m : ℤ) : fract (a - m) = fract a := by { rw fract, simp } @[simp] lemma fract_int_add (m : ℤ) (a : α) : fract (↑m + a) = fract a := by rw [add_comm, fract_add_int] +@[simp] lemma fract_sub_nat (a : α) (n : ℕ) : fract (a - n) = fract a := +by { rw fract, simp } + +@[simp] lemma fract_int_nat (n : ℕ) (a : α) : fract (↑n + a) = fract a := +by rw [add_comm, fract_add_nat] + +lemma fract_add_le (a b : α) : fract (a + b) ≤ fract a + fract b := +begin + rw [fract, fract, fract, sub_add_sub_comm, sub_le_sub_iff_left, ←int.cast_add, int.cast_le], + exact le_floor_add _ _, +end + +lemma fract_add_fract_le (a b : α) : fract a + fract b ≤ fract (a + b) + 1 := +begin + rw [fract, fract, fract, sub_add_sub_comm, sub_add, sub_le_sub_iff_left], + exact_mod_cast le_floor_add_floor a b, +end + @[simp] lemma self_sub_fract (a : α) : a - fract a = ⌊a⌋ := sub_sub_cancel _ _ @[simp] lemma fract_sub_self (a : α) : fract a - a = -⌊a⌋ := sub_sub_cancel_left _ _ -lemma fract_nonneg (a : α) : 0 ≤ fract a := sub_nonneg.2 $ floor_le _ +@[simp] lemma fract_nonneg (a : α) : 0 ≤ fract a := sub_nonneg.2 $ floor_le _ + +/-- The fractional part of `a` is positive if and only if `a ≠ ⌊a⌋`. -/ +lemma fract_pos : 0 < fract a ↔ a ≠ ⌊a⌋ := +(fract_nonneg a).lt_iff_ne.trans $ ne_comm.trans sub_ne_zero -lemma fract_lt_one (a : α) : fract a < 1 := sub_lt.1 $ sub_one_lt_floor _ +lemma fract_lt_one (a : α) : fract a < 1 := sub_lt_comm.1 $ sub_one_lt_floor _ @[simp] lemma fract_zero : fract (0 : α) = 0 := by rw [fract, floor_zero, cast_zero, sub_self] -@[simp] lemma fract_coe (z : ℤ) : fract (z : α) = 0 := -by { unfold fract, rw floor_coe, exact sub_self _ } +@[simp] lemma fract_one : fract (1 : α) = 0 := +by simp [fract] -@[simp] lemma fract_floor (a : α) : fract (⌊a⌋ : α) = 0 := fract_coe _ +lemma abs_fract : |int.fract a| = int.fract a := abs_eq_self.mpr $ fract_nonneg a + +@[simp] lemma abs_one_sub_fract : |1 - fract a| = 1 - fract a := +abs_eq_self.mpr $ sub_nonneg.mpr (fract_lt_one a).le + +@[simp] lemma fract_int_cast (z : ℤ) : fract (z : α) = 0 := +by { unfold fract, rw floor_int_cast, exact sub_self _ } + +@[simp] lemma fract_nat_cast (n : ℕ) : fract (n : α) = 0 := by simp [fract] + +@[simp] lemma fract_floor (a : α) : fract (⌊a⌋ : α) = 0 := fract_int_cast _ @[simp] lemma floor_fract (a : α) : ⌊fract a⌋ = 0 := -floor_eq_iff.2 ⟨fract_nonneg _, by { rw [int.cast_zero, zero_add], exact fract_lt_one a }⟩ +by rw [floor_eq_iff, int.cast_zero, zero_add]; exact ⟨fract_nonneg _, fract_lt_one _⟩ lemma fract_eq_iff {a b : α} : fract a = b ↔ 0 ≤ b ∧ b < 1 ∧ ∃ z : ℤ, a - b = z := ⟨λ h, by { rw ←h, exact ⟨fract_nonneg _, fract_lt_one _, ⟨⌊a⌋, sub_sub_cancel _ _⟩⟩}, @@ -534,7 +640,7 @@ lemma fract_eq_fract {a b : α} : fract a = fract b ↔ ∃ z : ℤ, a - b = z : end⟩ @[simp] lemma fract_eq_self {a : α} : fract a = a ↔ 0 ≤ a ∧ a < 1 := -fract_eq_iff.trans $ and.assoc.symm.trans $ and_iff_left ⟨0, sub_self a⟩ +fract_eq_iff.trans $ and.assoc.symm.trans $ and_iff_left ⟨0, by simp⟩ @[simp] lemma fract_fract (a : α) : fract (fract a) = fract a := fract_eq_self.2 ⟨fract_nonneg _, fract_lt_one _⟩ @@ -542,6 +648,26 @@ fract_eq_self.2 ⟨fract_nonneg _, fract_lt_one _⟩ lemma fract_add (a b : α) : ∃ z : ℤ, fract (a + b) - fract a - fract b = z := ⟨⌊a⌋ + ⌊b⌋ - ⌊a + b⌋, by { unfold fract, simp [sub_eq_add_neg], abel }⟩ +lemma fract_neg {x : α} (hx : fract x ≠ 0) : + fract (-x) = 1 - fract x := +begin + rw fract_eq_iff, + split, + { rw [le_sub_iff_add_le, zero_add], + exact (fract_lt_one x).le, }, + refine ⟨sub_lt_self _ (lt_of_le_of_ne' (fract_nonneg x) hx), -⌊x⌋ - 1, _⟩, + simp only [sub_sub_eq_add_sub, cast_sub, cast_neg, cast_one, sub_left_inj], + conv in (-x) {rw ← floor_add_fract x}, + simp [-floor_add_fract], +end + +@[simp] +lemma fract_neg_eq_zero {x : α} : fract (-x) = 0 ↔ fract x = 0 := +begin + simp only [fract_eq_iff, le_refl, zero_lt_one, tsub_zero, true_and], + split; rintros ⟨z, hz⟩; use [-z]; simp [← hz], +end + lemma fract_mul_nat (a : α) (b : ℕ) : ∃ z : ℤ, fract a * b - fract (a * b) = z := begin induction b with c hc, @@ -557,7 +683,7 @@ end lemma preimage_fract (s : set α) : fract ⁻¹' s = ⋃ m : ℤ, (λ x, x - m) ⁻¹' (s ∩ Ico (0 : α) 1) := begin ext x, - simp only [mem_preimage, mem_Union, mem_inter_eq], + simp only [mem_preimage, mem_Union, mem_inter_iff], refine ⟨λ h, ⟨⌊x⌋, h, fract_nonneg x, fract_lt_one x⟩, _⟩, rintro ⟨m, hms, hm0, hm1⟩, obtain rfl : ⌊x⌋ = m, from floor_eq_iff.2 ⟨sub_nonneg.1 hm0, sub_lt_iff_lt_add'.1 hm1⟩, @@ -567,7 +693,7 @@ end lemma image_fract (s : set α) : fract '' s = ⋃ m : ℤ, (λ x, x - m) '' s ∩ Ico 0 1 := begin ext x, - simp only [mem_image, mem_inter_eq, mem_Union], split, + simp only [mem_image, mem_inter_iff, mem_Union], split, { rintro ⟨y, hy, rfl⟩, exact ⟨⌊y⌋, ⟨y, hy, rfl⟩, fract_nonneg y, fract_lt_one y⟩ }, { rintro ⟨m, ⟨y, hys, rfl⟩, h0, h1⟩, @@ -577,7 +703,7 @@ end section linear_ordered_field -variables {k : Type*} [linear_ordered_field k] [floor_ring k] +variables {k : Type*} [linear_ordered_field k] [floor_ring k] {b : k} lemma fract_div_mul_self_mem_Ico (a b : k) (ha : 0 < a) : fract (b/a) * a ∈ Ico 0 a := ⟨(zero_le_mul_right ha).2 (fract_nonneg (b/a)), (mul_lt_iff_lt_one_left ha).2 (fract_lt_one (b/a))⟩ @@ -586,6 +712,51 @@ lemma fract_div_mul_self_add_zsmul_eq (a b : k) (ha : a ≠ 0) : fract (b/a) * a + ⌊b/a⌋ • a = b := by rw [zsmul_eq_mul, ← add_mul, fract_add_floor, div_mul_cancel b ha] +lemma sub_floor_div_mul_nonneg (a : k) (hb : 0 < b) : 0 ≤ a - ⌊a / b⌋ * b := +sub_nonneg_of_le $ (le_div_iff hb).1 $ floor_le _ + +lemma sub_floor_div_mul_lt (a : k) (hb : 0 < b) : a - ⌊a / b⌋ * b < b := +sub_lt_iff_lt_add.2 $ by { rw [←one_add_mul, ←div_lt_iff hb, add_comm], exact lt_floor_add_one _ } + +lemma fract_div_nat_cast_eq_div_nat_cast_mod {m n : ℕ} : + fract ((m : k) / n) = ↑(m % n) / n := +begin + rcases n.eq_zero_or_pos with rfl | hn, { simp, }, + have hn' : 0 < (n : k), { norm_cast, assumption, }, + refine fract_eq_iff.mpr ⟨by positivity, _, m / n, _⟩, + { simpa only [div_lt_one hn', nat.cast_lt] using m.mod_lt hn, }, + { rw [sub_eq_iff_eq_add', ← mul_right_inj' hn'.ne.symm, mul_div_cancel' _ hn'.ne.symm, mul_add, + mul_div_cancel' _ hn'.ne.symm], + norm_cast, + rw [← nat.cast_add, nat.mod_add_div m n], }, +end + +-- TODO Generalise this to allow `n : ℤ` using `int.fmod` instead of `int.mod`. +lemma fract_div_int_cast_eq_div_int_cast_mod {m : ℤ} {n : ℕ} : + fract ((m : k) / n) = ↑(m % n) / n := +begin + rcases n.eq_zero_or_pos with rfl | hn, { simp, }, + replace hn : 0 < (n : k), { norm_cast, assumption, }, + have : ∀ {l : ℤ} (hl : 0 ≤ l), fract ((l : k) / n) = ↑(l % n) / n, + { intros, + obtain ⟨l₀, rfl | rfl⟩ := l.eq_coe_or_neg, + { rw [cast_coe_nat, ← coe_nat_mod, cast_coe_nat, fract_div_nat_cast_eq_div_nat_cast_mod], }, + { rw [right.nonneg_neg_iff, coe_nat_nonpos_iff] at hl, simp [hl, zero_mod], }, }, + obtain ⟨m₀, rfl | rfl⟩ := m.eq_coe_or_neg, { exact this (of_nat_nonneg m₀), }, + let q := ⌈↑m₀ / (n : k)⌉, + let m₁ := (q * ↑n) -(↑m₀ : ℤ), + have hm₁ : 0 ≤ m₁, { simpa [←@cast_le k, ←div_le_iff hn] using floor_ring.gc_ceil_coe.le_u_l _, }, + calc fract (↑-↑m₀ / ↑n) = fract (-(m₀ : k) / n) : by push_cast + ... = fract ((m₁ : k) / n) : _ + ... = ↑(m₁ % (n : ℤ)) / ↑n : this hm₁ + ... = ↑(-(↑m₀ : ℤ) % ↑n) / ↑n : _, + { rw [← fract_int_add q, ← mul_div_cancel (q : k) (ne_of_gt hn), ← add_div, ← sub_eq_add_neg], + push_cast, }, + { congr' 2, + change ((q * ↑n) -(↑m₀ : ℤ)) % ↑n = _, + rw [sub_eq_add_neg, add_comm (q * ↑n), add_mul_mod_self], }, +end + end linear_ordered_field /-! #### Ceil -/ @@ -602,34 +773,64 @@ eq_of_forall_ge_iff (λ z, by rw [neg_le, ceil_le, le_floor, int.cast_neg, neg_l lemma lt_ceil : z < ⌈a⌉ ↔ (z : α) < a := lt_iff_lt_of_le_iff_le ceil_le +@[simp] lemma add_one_le_ceil_iff : z + 1 ≤ ⌈a⌉ ↔ (z : α) < a := by rw [← lt_ceil, add_one_le_iff] + +@[simp] lemma one_le_ceil_iff : 1 ≤ ⌈a⌉ ↔ 0 < a := +by rw [← zero_add (1 : ℤ), add_one_le_ceil_iff, cast_zero] + lemma ceil_le_floor_add_one (a : α) : ⌈a⌉ ≤ ⌊a⌋ + 1 := by { rw [ceil_le, int.cast_add, int.cast_one], exact (lt_floor_add_one a).le } lemma le_ceil (a : α) : a ≤ ⌈a⌉ := gc_ceil_coe.le_u_l a -@[simp] lemma ceil_coe (z : ℤ) : ⌈(z : α)⌉ = z := +@[simp] lemma ceil_int_cast (z : ℤ) : ⌈(z : α)⌉ = z := eq_of_forall_ge_iff $ λ a, by rw [ceil_le, int.cast_le] +@[simp] lemma ceil_nat_cast (n : ℕ) : ⌈(n : α)⌉ = n := +eq_of_forall_ge_iff $ λ a, by rw [ceil_le, ← cast_coe_nat, cast_le] + lemma ceil_mono : monotone (ceil : α → ℤ) := gc_ceil_coe.monotone_l @[simp] lemma ceil_add_int (a : α) (z : ℤ) : ⌈a + z⌉ = ⌈a⌉ + z := by rw [←neg_inj, neg_add', ←floor_neg, ←floor_neg, neg_add', floor_sub_int] +@[simp] lemma ceil_add_nat (a : α) (n : ℕ) : ⌈a + n⌉ = ⌈a⌉ + n := +by rw [← int.cast_coe_nat, ceil_add_int] + @[simp] lemma ceil_add_one (a : α) : ⌈a + 1⌉ = ⌈a⌉ + 1 := by { convert ceil_add_int a (1 : ℤ), exact cast_one.symm } @[simp] lemma ceil_sub_int (a : α) (z : ℤ) : ⌈a - z⌉ = ⌈a⌉ - z := eq.trans (by rw [int.cast_neg, sub_eq_add_neg]) (ceil_add_int _ _) +@[simp] lemma ceil_sub_nat (a : α) (n : ℕ) : ⌈a - n⌉ = ⌈a⌉ - n := +by convert ceil_sub_int a n using 1; simp + @[simp] lemma ceil_sub_one (a : α) : ⌈a - 1⌉ = ⌈a⌉ - 1 := by rw [eq_sub_iff_add_eq, ← ceil_add_one, sub_add_cancel] lemma ceil_lt_add_one (a : α) : (⌈a⌉ : α) < a + 1 := by { rw [← lt_ceil, ← int.cast_one, ceil_add_int], apply lt_add_one } -lemma ceil_pos : 0 < ⌈a⌉ ↔ 0 < a := lt_ceil +lemma ceil_add_le (a b : α) : ⌈a + b⌉ ≤ ⌈a⌉ + ⌈b⌉ := +begin + rw [ceil_le, int.cast_add], + exact add_le_add (le_ceil _) (le_ceil _), +end + +lemma ceil_add_ceil_le (a b : α) : ⌈a⌉ + ⌈b⌉ ≤ ⌈a + b⌉ + 1 := +begin + rw [←le_sub_iff_add_le, ceil_le, int.cast_sub, int.cast_add, int.cast_one, le_sub_comm], + refine (ceil_lt_add_one _).le.trans _, + rw [le_sub_iff_add_le', ←add_assoc, add_le_add_iff_right], + exact le_ceil _, +end + +@[simp] lemma ceil_pos : 0 < ⌈a⌉ ↔ 0 < a := by rw [lt_ceil, cast_zero] -@[simp] lemma ceil_zero : ⌈(0 : α)⌉ = 0 := ceil_coe 0 +@[simp] lemma ceil_zero : ⌈(0 : α)⌉ = 0 := by rw [← cast_zero, ceil_int_cast] + +@[simp] lemma ceil_one : ⌈(1 : α)⌉ = 1 := by rw [← cast_one, ceil_int_cast] lemma ceil_nonneg (ha : 0 ≤ a) : 0 ≤ ⌈a⌉ := by exact_mod_cast ha.trans (le_ceil a) @@ -638,6 +839,8 @@ lemma ceil_eq_iff : ⌈a⌉ = z ↔ ↑z - 1 < a ∧ a ≤ z := by rw [←ceil_le, ←int.cast_one, ←int.cast_sub, ←lt_ceil, int.sub_one_lt_iff, le_antisymm_iff, and.comm] +@[simp] lemma ceil_eq_zero_iff : ⌈a⌉ = 0 ↔ a ∈ Ioc (-1 : α) 0 := by simp [ceil_eq_iff] + lemma ceil_eq_on_Ioc (z : ℤ) : ∀ a ∈ set.Ioc (z - 1 : α) z, ⌈a⌉ = z := λ a ⟨h₀, h₁⟩, ceil_eq_iff.mpr ⟨h₀, h₁⟩ @@ -652,6 +855,23 @@ cast_lt.1 $ (floor_le a).trans_lt $ h.trans_le $ le_ceil b @[simp] lemma preimage_ceil_singleton (m : ℤ) : (ceil : α → ℤ) ⁻¹' {m} = Ioc (m - 1) m := ext $ λ x, ceil_eq_iff +lemma fract_eq_zero_or_add_one_sub_ceil (a : α) : fract a = 0 ∨ fract a = a + 1 - (⌈a⌉ : α) := +begin + cases eq_or_ne (fract a) 0 with ha ha, { exact or.inl ha, }, right, + suffices : (⌈a⌉ : α) = ⌊a⌋ + 1, { rw [this, ← self_sub_fract], abel, }, + norm_cast, + rw ceil_eq_iff, + refine ⟨_, _root_.le_of_lt $ by simp⟩, + rw [cast_add, cast_one, add_tsub_cancel_right, ← self_sub_fract a, sub_lt_self_iff], + exact ha.symm.lt_of_le (fract_nonneg a), +end + +lemma ceil_eq_add_one_sub_fract (ha : fract a ≠ 0) : (⌈a⌉ : α) = a + 1 - fract a := +by { rw (or_iff_right ha).mp (fract_eq_zero_or_add_one_sub_ceil a), abel, } + +lemma ceil_sub_self_eq (ha : fract a ≠ 0) : (⌈a⌉ : α) - a = 1 - fract a := +by { rw (or_iff_right ha).mp (fract_eq_zero_or_add_one_sub_ceil a), abel, } + /-! #### Intervals -/ @[simp] lemma preimage_Ioo {a b : α} : ((coe : ℤ → α) ⁻¹' (set.Ioo a b)) = set.Ioo ⌊a⌋ ⌈b⌉ := @@ -680,6 +900,195 @@ by { ext, simp [le_floor] } end int +open int + +/-! ### Round -/ + +section round + +section linear_ordered_ring + +variables [linear_ordered_ring α] [floor_ring α] + +/-- `round` rounds a number to the nearest integer. `round (1 / 2) = 1` -/ +def round (x : α) : ℤ := if 2 * fract x < 1 then ⌊x⌋ else ⌈x⌉ + +@[simp] lemma round_zero : round (0 : α) = 0 := by simp [round] + +@[simp] lemma round_one : round (1 : α) = 1 := by simp [round] + +@[simp] lemma round_nat_cast (n : ℕ) : round (n : α) = n := by simp [round] + +@[simp] lemma round_int_cast (n : ℤ) : round (n : α) = n := by simp [round] + +@[simp] +lemma round_add_int (x : α) (y : ℤ) : round (x + y) = round x + y := +by rw [round, round, int.fract_add_int, int.floor_add_int, int.ceil_add_int, ← apply_ite2, if_t_t] + +@[simp] +lemma round_add_one (a : α) : round (a + 1) = round a + 1 := +by { convert round_add_int a 1, exact int.cast_one.symm } + +@[simp] +lemma round_sub_int (x : α) (y : ℤ) : round (x - y) = round x - y := +by { rw [sub_eq_add_neg], norm_cast, rw [round_add_int, sub_eq_add_neg] } + +@[simp] +lemma round_sub_one (a : α) : round (a - 1) = round a - 1 := +by { convert round_sub_int a 1, exact int.cast_one.symm } + +@[simp] +lemma round_add_nat (x : α) (y : ℕ) : round (x + y) = round x + y := +by rw [round, round, fract_add_nat, int.floor_add_nat, int.ceil_add_nat, ← apply_ite2, if_t_t] + +@[simp] +lemma round_sub_nat (x : α) (y : ℕ) : round (x - y) = round x - y := +by { rw [sub_eq_add_neg, ← int.cast_coe_nat], norm_cast, rw [round_add_int, sub_eq_add_neg] } + +@[simp] +lemma round_int_add (x : α) (y : ℤ) : round ((y : α) + x) = y + round x := +by { rw [add_comm, round_add_int, add_comm] } + +@[simp] +lemma round_nat_add (x : α) (y : ℕ) : round ((y : α) + x) = y + round x := +by { rw [add_comm, round_add_nat, add_comm] } + +lemma abs_sub_round_eq_min (x : α) : |x - round x| = min (fract x) (1 - fract x) := +begin + simp_rw [round, min_def_lt, two_mul, ← lt_tsub_iff_left], + cases lt_or_ge (fract x) (1 - fract x) with hx hx, + { rw [if_pos hx, if_pos hx, self_sub_floor, abs_fract], }, + { have : 0 < fract x, + { replace hx : 0 < fract x + fract x := lt_of_lt_of_le zero_lt_one (tsub_le_iff_left.mp hx), + simpa only [← two_mul, zero_lt_mul_left, zero_lt_two] using hx, }, + rw [if_neg (not_lt.mpr hx), if_neg (not_lt.mpr hx), abs_sub_comm, ceil_sub_self_eq this.ne.symm, + abs_one_sub_fract], }, +end + +lemma round_le (x : α) (z : ℤ) : |x - round x| ≤ |x - z| := +begin + rw [abs_sub_round_eq_min, min_le_iff], + rcases le_or_lt (z : α) x with hx | hx; [left, right], + { conv_rhs { rw [abs_eq_self.mpr (sub_nonneg.mpr hx), ← fract_add_floor x, add_sub_assoc], }, + simpa only [le_add_iff_nonneg_right, sub_nonneg, cast_le] using le_floor.mpr hx, }, + { rw abs_eq_neg_self.mpr (sub_neg.mpr hx).le, + conv_rhs { rw ← fract_add_floor x, }, + rw [add_sub_assoc, add_comm, neg_add, neg_sub, le_add_neg_iff_add_le, sub_add_cancel, + le_sub_comm], + norm_cast, + exact floor_le_sub_one_iff.mpr hx, }, +end + +end linear_ordered_ring + +section linear_ordered_field + +variables [linear_ordered_field α] [floor_ring α] + +lemma round_eq (x : α) : round x = ⌊x + 1 / 2⌋ := +begin + simp_rw [round, (by simp only [lt_div_iff', two_pos] : 2 * fract x < 1 ↔ fract x < 1 / 2)], + cases lt_or_ge (fract x) (1 / 2) with hx hx, + { conv_rhs { rw [← fract_add_floor x, add_assoc, add_left_comm, floor_int_add], }, + rw [if_pos hx, self_eq_add_right, floor_eq_iff, cast_zero, zero_add], + split; linarith [fract_nonneg x], }, + { have : ⌊fract x + 1 / 2⌋ = 1, { rw floor_eq_iff, split; norm_num; linarith [fract_lt_one x], }, + rw [if_neg (not_lt.mpr hx), ← fract_add_floor x, add_assoc, add_left_comm, floor_int_add, + ceil_add_int, add_comm _ ⌊x⌋, add_right_inj, ceil_eq_iff, this, cast_one, sub_self], + split; linarith [fract_lt_one x], }, +end + +@[simp] lemma round_two_inv : round (2⁻¹ : α) = 1 := +by simp only [round_eq, ← one_div, add_halves', floor_one] + +@[simp] lemma round_neg_two_inv : round (-2⁻¹ : α) = 0 := +by simp only [round_eq, ← one_div, add_left_neg, floor_zero] + +@[simp] lemma round_eq_zero_iff {x : α} : round x = 0 ↔ x ∈ Ico (-(1 / 2)) ((1 : α)/2) := +begin + rw [round_eq, floor_eq_zero_iff, add_mem_Ico_iff_left], + norm_num, +end + +lemma abs_sub_round (x : α) : |x - round x| ≤ 1 / 2 := +begin + rw [round_eq, abs_sub_le_iff], + have := floor_le (x + 1 / 2), + have := lt_floor_add_one (x + 1 / 2), + split; linarith +end + +lemma abs_sub_round_div_nat_cast_eq {m n : ℕ} : + |(m : α) / n - round ((m : α) / n)| = ↑(min (m % n) (n - m % n)) / n := +begin + rcases n.eq_zero_or_pos with rfl | hn, { simp, }, + have hn' : 0 < (n : α), { norm_cast, assumption, }, + rw [abs_sub_round_eq_min, nat.cast_min, ← min_div_div_right hn'.le, + fract_div_nat_cast_eq_div_nat_cast_mod, nat.cast_sub (m.mod_lt hn).le, sub_div, + div_self hn'.ne.symm], +end + +end linear_ordered_field + +end round + +namespace nat +variables [linear_ordered_semiring α] [linear_ordered_semiring β] [floor_semiring α] + [floor_semiring β] [ring_hom_class F α β] {a : α} {b : β} +include β + +lemma floor_congr (h : ∀ n : ℕ, (n : α) ≤ a ↔ (n : β) ≤ b) : ⌊a⌋₊ = ⌊b⌋₊ := +begin + have h₀ : 0 ≤ a ↔ 0 ≤ b := by simpa only [cast_zero] using h 0, + obtain ha | ha := lt_or_le a 0, + { rw [floor_of_nonpos ha.le, floor_of_nonpos (le_of_not_le $ h₀.not.mp ha.not_le)] }, + exact (le_floor $ (h _).1 $ floor_le ha).antisymm (le_floor $ (h _).2 $ floor_le $ h₀.1 ha), +end + +lemma ceil_congr (h : ∀ n : ℕ, a ≤ n ↔ b ≤ n) : ⌈a⌉₊ = ⌈b⌉₊ := +(ceil_le.2 $ (h _).2 $ le_ceil _).antisymm $ ceil_le.2 $ (h _).1 $ le_ceil _ + +lemma map_floor (f : F) (hf : strict_mono f) (a : α) : ⌊f a⌋₊ = ⌊a⌋₊ := +floor_congr $ λ n, by rw [←map_nat_cast f, hf.le_iff_le] + +lemma map_ceil (f : F) (hf : strict_mono f) (a : α) : ⌈f a⌉₊ = ⌈a⌉₊ := +ceil_congr $ λ n, by rw [←map_nat_cast f, hf.le_iff_le] + +end nat + +namespace int +variables [linear_ordered_ring α] [linear_ordered_ring β] [floor_ring α] [floor_ring β] + [ring_hom_class F α β] {a : α} {b : β} +include β + +lemma floor_congr (h : ∀ n : ℤ, (n : α) ≤ a ↔ (n : β) ≤ b) : ⌊a⌋ = ⌊b⌋ := +(le_floor.2 $ (h _).1 $ floor_le _).antisymm $ le_floor.2 $ (h _).2 $ floor_le _ + +lemma ceil_congr (h : ∀ n : ℤ, a ≤ n ↔ b ≤ n) : ⌈a⌉ = ⌈b⌉ := +(ceil_le.2 $ (h _).2 $ le_ceil _).antisymm $ ceil_le.2 $ (h _).1 $ le_ceil _ + +lemma map_floor (f : F) (hf : strict_mono f) (a : α) : ⌊f a⌋ = ⌊a⌋ := +floor_congr $ λ n, by rw [←map_int_cast f, hf.le_iff_le] + +lemma map_ceil (f : F) (hf : strict_mono f) (a : α) : ⌈f a⌉ = ⌈a⌉ := +ceil_congr $ λ n, by rw [←map_int_cast f, hf.le_iff_le] + +lemma map_fract (f : F) (hf : strict_mono f) (a : α) : fract (f a) = f (fract a) := +by simp_rw [fract, map_sub, map_int_cast, map_floor _ hf] + +end int + +namespace int +variables [linear_ordered_field α] [linear_ordered_field β] [floor_ring α] [floor_ring β] + [ring_hom_class F α β] {a : α} {b : β} +include β + +lemma map_round (f : F) (hf : strict_mono f) (a : α) : round (f a) = round a := +by simp_rw [round_eq, ←map_floor _ hf, map_add, one_div, map_inv₀, map_bit0, map_one] + +end int + +section floor_ring_to_semiring variables {α} [linear_ordered_ring α] [floor_ring α] /-! #### A floor ring as a floor semiring -/ @@ -689,8 +1098,9 @@ instance _root_.floor_ring.to_floor_semiring : floor_semiring α := { floor := λ a, ⌊a⌋.to_nat, ceil := λ a, ⌈a⌉.to_nat, floor_of_neg := λ a ha, int.to_nat_of_nonpos (int.floor_nonpos ha.le), - gc_floor := λ a n ha, by { rw [int.le_to_nat_iff (int.floor_nonneg.2 ha), int.le_floor], refl }, - gc_ceil := λ a n, by { rw [int.to_nat_le, int.ceil_le], refl } } + gc_floor := λ a n ha, + by rw [int.le_to_nat_iff (int.floor_nonneg.2 ha), int.le_floor, int.cast_coe_nat], + gc_ceil := λ a n, by rw [int.to_nat_le, int.ceil_le, int.cast_coe_nat] } lemma int.floor_to_nat (a : α) : ⌊a⌋.to_nat = ⌊a⌋₊ := rfl @@ -713,6 +1123,8 @@ by { rw [←int.ceil_to_nat, int.to_nat_of_nonneg (int.ceil_nonneg ha)] } lemma nat.cast_ceil_eq_cast_int_ceil (ha : 0 ≤ a) : (⌈a⌉₊ : α) = ⌈a⌉ := by rw [←nat.cast_ceil_eq_int_ceil ha, int.cast_coe_nat] +end floor_ring_to_semiring + /-- There exists at most one `floor_ring` structure on a given linear ordered ring. -/ lemma subsingleton_floor_ring {α} [linear_ordered_ring α] : subsingleton (floor_ring α) := @@ -722,3 +1134,46 @@ begin have : H₁.ceil = H₂.ceil := funext (λ a, H₁.gc_ceil_coe.l_unique H₂.gc_ceil_coe $ λ _, rfl), cases H₁, cases H₂, congr; assumption end + +namespace tactic +open positivity + +private lemma int_floor_nonneg [linear_ordered_ring α] [floor_ring α] {a : α} (ha : 0 ≤ a) : + 0 ≤ ⌊a⌋ := int.floor_nonneg.2 ha +private lemma int_floor_nonneg_of_pos [linear_ordered_ring α] [floor_ring α] {a : α} (ha : 0 < a) : + 0 ≤ ⌊a⌋ := int_floor_nonneg ha.le + +/-- Extension for the `positivity` tactic: `int.floor` is nonnegative if its input is. -/ +@[positivity] +meta def positivity_floor : expr → tactic strictness +| `(⌊%%a⌋) := do + strictness_a ← core a, + match strictness_a with + | positive p := nonnegative <$> mk_app ``int_floor_nonneg_of_pos [p] + | nonnegative p := nonnegative <$> mk_app ``int_floor_nonneg [p] + | _ := failed + end +| e := pp e >>= fail ∘ format.bracket "The expression `" "` is not of the form `⌊a⌋`" + +private lemma nat_ceil_pos [linear_ordered_semiring α] [floor_semiring α] {a : α} : + 0 < a → 0 < ⌈a⌉₊ := nat.ceil_pos.2 +private lemma int_ceil_pos [linear_ordered_ring α] [floor_ring α] {a : α} : 0 < a → 0 < ⌈a⌉ := +int.ceil_pos.2 + +/-- Extension for the `positivity` tactic: `ceil` and `int.ceil` are positive/nonnegative if +their input is. -/ +@[positivity] +meta def positivity_ceil : expr → tactic strictness +| `(⌈%%a⌉₊) := do + positive p ← core a, -- We already know `0 ≤ n` for all `n : ℕ` + positive <$> mk_app ``nat_ceil_pos [p] +| `(⌈%%a⌉) := do + strictness_a ← core a, + match strictness_a with + | positive p := positive <$> mk_app ``int_ceil_pos [p] + | nonnegative p := nonnegative <$> mk_app ``int.ceil_nonneg [p] + | _ := failed + end +| e := pp e >>= fail ∘ format.bracket "The expression `" "` is not of the form `⌈a⌉₊` nor `⌈a⌉`" + +end tactic diff --git a/src/algebra/order/group.lean b/src/algebra/order/group.lean deleted file mode 100644 index 5d6794d20e54b..0000000000000 --- a/src/algebra/order/group.lean +++ /dev/null @@ -1,1389 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl --/ -import algebra.abs -import algebra.order.sub -import order.order_dual - -/-! -# Ordered groups - -This file develops the basics of ordered groups. - -## Implementation details - -Unfortunately, the number of `'` appended to lemmas in this file -may differ between the multiplicative and the additive version of a lemma. -The reason is that we did not want to change existing names in the library. --/ - -set_option old_structure_cmd true -open function - -universe u -variable {α : Type u} - -@[to_additive] -instance group.covariant_class_le.to_contravariant_class_le - [group α] [has_le α] [covariant_class α α (*) (≤)] : contravariant_class α α (*) (≤) := -group.covconv - -@[to_additive] -instance group.swap.covariant_class_le.to_contravariant_class_le [group α] [has_le α] - [covariant_class α α (swap (*)) (≤)] : contravariant_class α α (swap (*)) (≤) := -{ elim := λ a b c bc, calc b = b * a * a⁻¹ : eq_mul_inv_of_mul_eq rfl - ... ≤ c * a * a⁻¹ : mul_le_mul_right' bc a⁻¹ - ... = c : mul_inv_eq_of_eq_mul rfl } - -@[to_additive] -instance group.covariant_class_lt.to_contravariant_class_lt - [group α] [has_lt α] [covariant_class α α (*) (<)] : contravariant_class α α (*) (<) := -{ elim := λ a b c bc, calc b = a⁻¹ * (a * b) : eq_inv_mul_of_mul_eq rfl - ... < a⁻¹ * (a * c) : mul_lt_mul_left' bc a⁻¹ - ... = c : inv_mul_cancel_left a c } - -@[to_additive] -instance group.swap.covariant_class_lt.to_contravariant_class_lt [group α] [has_lt α] - [covariant_class α α (swap (*)) (<)] : contravariant_class α α (swap (*)) (<) := -{ elim := λ a b c bc, calc b = b * a * a⁻¹ : eq_mul_inv_of_mul_eq rfl - ... < c * a * a⁻¹ : mul_lt_mul_right' bc a⁻¹ - ... = c : mul_inv_eq_of_eq_mul rfl } - -/-- An ordered additive commutative group is an additive commutative group -with a partial order in which addition is strictly monotone. -/ -@[protect_proj, ancestor add_comm_group partial_order] -class ordered_add_comm_group (α : Type u) extends add_comm_group α, partial_order α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) - -/-- An ordered commutative group is an commutative group -with a partial order in which multiplication is strictly monotone. -/ -@[protect_proj, ancestor comm_group partial_order] -class ordered_comm_group (α : Type u) extends comm_group α, partial_order α := -(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b) -attribute [to_additive] ordered_comm_group - -@[to_additive] -instance ordered_comm_group.to_covariant_class_left_le (α : Type u) [ordered_comm_group α] : - covariant_class α α (*) (≤) := -{ elim := λ a b c bc, ordered_comm_group.mul_le_mul_left b c bc a } - -/--The units of an ordered commutative monoid form an ordered commutative group. -/ -@[to_additive "The units of an ordered commutative additive monoid form an ordered commutative -additive group."] -instance units.ordered_comm_group [ordered_comm_monoid α] : ordered_comm_group αˣ := -{ mul_le_mul_left := λ a b h c, (mul_le_mul_left' (h : (a : α) ≤ b) _ : (c : α) * a ≤ c * b), - .. units.partial_order, - .. units.comm_group } - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance ordered_comm_group.to_ordered_cancel_comm_monoid (α : Type u) - [s : ordered_comm_group α] : - ordered_cancel_comm_monoid α := -{ mul_left_cancel := λ a b c, (mul_right_inj a).mp, - le_of_mul_le_mul_left := λ a b c, (mul_le_mul_iff_left a).mp, - ..s } - -@[priority 100, to_additive] -instance ordered_comm_group.has_exists_mul_of_le (α : Type u) - [ordered_comm_group α] : - has_exists_mul_of_le α := -⟨λ a b hab, ⟨b * a⁻¹, (mul_inv_cancel_comm_assoc a b).symm⟩⟩ - -@[to_additive] instance [h : has_inv α] : has_inv αᵒᵈ := h -@[to_additive] instance [h : has_div α] : has_div αᵒᵈ := h -@[to_additive] instance [h : has_involutive_inv α] : has_involutive_inv αᵒᵈ := h -@[to_additive] instance [h : div_inv_monoid α] : div_inv_monoid αᵒᵈ := h -@[to_additive] instance [h : group α] : group αᵒᵈ := h -@[to_additive] instance [h : comm_group α] : comm_group αᵒᵈ := h - -@[to_additive] instance [ordered_comm_group α] : ordered_comm_group αᵒᵈ := -{ .. order_dual.ordered_comm_monoid, .. order_dual.group } - -section group -variables [group α] - -section typeclasses_left_le -variables [has_le α] [covariant_class α α (*) (≤)] {a b c d : α} - -/-- Uses `left` co(ntra)variant. -/ -@[simp, to_additive left.neg_nonpos_iff] -lemma left.inv_le_one_iff : - a⁻¹ ≤ 1 ↔ 1 ≤ a := -by { rw [← mul_le_mul_iff_left a], simp } - -/-- Uses `left` co(ntra)variant. -/ -@[simp, to_additive left.nonneg_neg_iff] -lemma left.one_le_inv_iff : - 1 ≤ a⁻¹ ↔ a ≤ 1 := -by { rw [← mul_le_mul_iff_left a], simp } - -@[simp, to_additive] -lemma le_inv_mul_iff_mul_le : b ≤ a⁻¹ * c ↔ a * b ≤ c := -by { rw ← mul_le_mul_iff_left a, simp } - -@[simp, to_additive] -lemma inv_mul_le_iff_le_mul : b⁻¹ * a ≤ c ↔ a ≤ b * c := -by rw [← mul_le_mul_iff_left b, mul_inv_cancel_left] - -@[to_additive neg_le_iff_add_nonneg'] -lemma inv_le_iff_one_le_mul' : a⁻¹ ≤ b ↔ 1 ≤ a * b := -(mul_le_mul_iff_left a).symm.trans $ by rw mul_inv_self - -@[to_additive] -lemma le_inv_iff_mul_le_one_left : a ≤ b⁻¹ ↔ b * a ≤ 1 := -(mul_le_mul_iff_left b).symm.trans $ by rw mul_inv_self - -@[to_additive] -lemma le_inv_mul_iff_le : 1 ≤ b⁻¹ * a ↔ b ≤ a := -by rw [← mul_le_mul_iff_left b, mul_one, mul_inv_cancel_left] - -@[to_additive] -lemma inv_mul_le_one_iff : a⁻¹ * b ≤ 1 ↔ b ≤ a := -trans (inv_mul_le_iff_le_mul) $ by rw mul_one - -end typeclasses_left_le - -section typeclasses_left_lt -variables [has_lt α] [covariant_class α α (*) (<)] {a b c : α} - -/-- Uses `left` co(ntra)variant. -/ -@[simp, to_additive left.neg_pos_iff] -lemma left.one_lt_inv_iff : - 1 < a⁻¹ ↔ a < 1 := -by rw [← mul_lt_mul_iff_left a, mul_inv_self, mul_one] - -/-- Uses `left` co(ntra)variant. -/ -@[simp, to_additive left.neg_neg_iff] -lemma left.inv_lt_one_iff : - a⁻¹ < 1 ↔ 1 < a := -by rw [← mul_lt_mul_iff_left a, mul_inv_self, mul_one] - -@[simp, to_additive] -lemma lt_inv_mul_iff_mul_lt : b < a⁻¹ * c ↔ a * b < c := -by { rw [← mul_lt_mul_iff_left a], simp } - -@[simp, to_additive] -lemma inv_mul_lt_iff_lt_mul : b⁻¹ * a < c ↔ a < b * c := -by rw [← mul_lt_mul_iff_left b, mul_inv_cancel_left] - -@[to_additive] -lemma inv_lt_iff_one_lt_mul' : a⁻¹ < b ↔ 1 < a * b := -(mul_lt_mul_iff_left a).symm.trans $ by rw mul_inv_self - -@[to_additive] -lemma lt_inv_iff_mul_lt_one' : a < b⁻¹ ↔ b * a < 1 := -(mul_lt_mul_iff_left b).symm.trans $ by rw mul_inv_self - -@[to_additive] -lemma lt_inv_mul_iff_lt : 1 < b⁻¹ * a ↔ b < a := -by rw [← mul_lt_mul_iff_left b, mul_one, mul_inv_cancel_left] - -@[to_additive] -lemma inv_mul_lt_one_iff : a⁻¹ * b < 1 ↔ b < a := -trans (inv_mul_lt_iff_lt_mul) $ by rw mul_one - -end typeclasses_left_lt - -section typeclasses_right_le -variables [has_le α] [covariant_class α α (swap (*)) (≤)] {a b c : α} - -/-- Uses `right` co(ntra)variant. -/ -@[simp, to_additive right.neg_nonpos_iff] -lemma right.inv_le_one_iff : - a⁻¹ ≤ 1 ↔ 1 ≤ a := -by { rw [← mul_le_mul_iff_right a], simp } - -/-- Uses `right` co(ntra)variant. -/ -@[simp, to_additive right.nonneg_neg_iff] -lemma right.one_le_inv_iff : - 1 ≤ a⁻¹ ↔ a ≤ 1 := -by { rw [← mul_le_mul_iff_right a], simp } - -@[to_additive neg_le_iff_add_nonneg] -lemma inv_le_iff_one_le_mul : a⁻¹ ≤ b ↔ 1 ≤ b * a := -(mul_le_mul_iff_right a).symm.trans $ by rw inv_mul_self - -@[to_additive] -lemma le_inv_iff_mul_le_one_right : a ≤ b⁻¹ ↔ a * b ≤ 1 := -(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_self - -@[simp, to_additive] -lemma mul_inv_le_iff_le_mul : a * b⁻¹ ≤ c ↔ a ≤ c * b := -(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_cancel_right - -@[simp, to_additive] -lemma le_mul_inv_iff_mul_le : c ≤ a * b⁻¹ ↔ c * b ≤ a := -(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_cancel_right - -@[simp, to_additive] -lemma mul_inv_le_one_iff_le : a * b⁻¹ ≤ 1 ↔ a ≤ b := -mul_inv_le_iff_le_mul.trans $ by rw one_mul - -@[to_additive] -lemma le_mul_inv_iff_le : 1 ≤ a * b⁻¹ ↔ b ≤ a := -by rw [← mul_le_mul_iff_right b, one_mul, inv_mul_cancel_right] - -@[to_additive] -lemma mul_inv_le_one_iff : b * a⁻¹ ≤ 1 ↔ b ≤ a := -trans (mul_inv_le_iff_le_mul) $ by rw one_mul - -end typeclasses_right_le - -section typeclasses_right_lt -variables [has_lt α] [covariant_class α α (swap (*)) (<)] {a b c : α} - -/-- Uses `right` co(ntra)variant. -/ -@[simp, to_additive right.neg_neg_iff "Uses `right` co(ntra)variant."] -lemma right.inv_lt_one_iff : - a⁻¹ < 1 ↔ 1 < a := -by rw [← mul_lt_mul_iff_right a, inv_mul_self, one_mul] - -/-- Uses `right` co(ntra)variant. -/ -@[simp, to_additive right.neg_pos_iff "Uses `right` co(ntra)variant."] -lemma right.one_lt_inv_iff : - 1 < a⁻¹ ↔ a < 1 := -by rw [← mul_lt_mul_iff_right a, inv_mul_self, one_mul] - -@[to_additive] -lemma inv_lt_iff_one_lt_mul : a⁻¹ < b ↔ 1 < b * a := -(mul_lt_mul_iff_right a).symm.trans $ by rw inv_mul_self - -@[to_additive] -lemma lt_inv_iff_mul_lt_one : a < b⁻¹ ↔ a * b < 1 := -(mul_lt_mul_iff_right b).symm.trans $ by rw inv_mul_self - -@[simp, to_additive] -lemma mul_inv_lt_iff_lt_mul : a * b⁻¹ < c ↔ a < c * b := -by rw [← mul_lt_mul_iff_right b, inv_mul_cancel_right] - -@[simp, to_additive] -lemma lt_mul_inv_iff_mul_lt : c < a * b⁻¹ ↔ c * b < a := -(mul_lt_mul_iff_right b).symm.trans $ by rw inv_mul_cancel_right - -@[simp, to_additive] -lemma inv_mul_lt_one_iff_lt : a * b⁻¹ < 1 ↔ a < b := -by rw [← mul_lt_mul_iff_right b, inv_mul_cancel_right, one_mul] - -@[to_additive] -lemma lt_mul_inv_iff_lt : 1 < a * b⁻¹ ↔ b < a := -by rw [← mul_lt_mul_iff_right b, one_mul, inv_mul_cancel_right] - -@[to_additive] -lemma mul_inv_lt_one_iff : b * a⁻¹ < 1 ↔ b < a := -trans (mul_inv_lt_iff_lt_mul) $ by rw one_mul - -end typeclasses_right_lt - -section typeclasses_left_right_le -variables [has_le α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] - {a b c d : α} - -@[simp, to_additive] -lemma inv_le_inv_iff : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := -by { rw [← mul_le_mul_iff_left a, ← mul_le_mul_iff_right b], simp } - -alias neg_le_neg_iff ↔ le_of_neg_le_neg _ - -section - -variable (α) - -/-- `x ↦ x⁻¹` as an order-reversing equivalence. -/ -@[to_additive "`x ↦ -x` as an order-reversing equivalence.", simps] -def order_iso.inv : α ≃o αᵒᵈ := -{ to_equiv := (equiv.inv α).trans order_dual.to_dual, - map_rel_iff' := λ a b, @inv_le_inv_iff α _ _ _ _ _ _ } - -end - -@[to_additive neg_le] -lemma inv_le' : a⁻¹ ≤ b ↔ b⁻¹ ≤ a := -(order_iso.inv α).symm_apply_le - -alias inv_le' ↔ inv_le_of_inv_le' _ -attribute [to_additive neg_le_of_neg_le] inv_le_of_inv_le' - -@[to_additive le_neg] -lemma le_inv' : a ≤ b⁻¹ ↔ b ≤ a⁻¹ := -(order_iso.inv α).le_symm_apply - -@[to_additive] -lemma mul_inv_le_inv_mul_iff : a * b⁻¹ ≤ d⁻¹ * c ↔ d * a ≤ c * b := -by rw [← mul_le_mul_iff_left d, ← mul_le_mul_iff_right b, mul_inv_cancel_left, mul_assoc, - inv_mul_cancel_right] - -@[simp, to_additive] lemma div_le_self_iff (a : α) {b : α} : a / b ≤ a ↔ 1 ≤ b := -by simp [div_eq_mul_inv] - -@[simp, to_additive] lemma le_div_self_iff (a : α) {b : α} : a ≤ a / b ↔ b ≤ 1 := -by simp [div_eq_mul_inv] - -alias sub_le_self_iff ↔ _ sub_le_self - -end typeclasses_left_right_le - -section typeclasses_left_right_lt -variables [has_lt α] [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] - {a b c d : α} - -@[simp, to_additive] -lemma inv_lt_inv_iff : a⁻¹ < b⁻¹ ↔ b < a := -by { rw [← mul_lt_mul_iff_left a, ← mul_lt_mul_iff_right b], simp } - -@[to_additive neg_lt] -lemma inv_lt' : a⁻¹ < b ↔ b⁻¹ < a := -by rw [← inv_lt_inv_iff, inv_inv] - -@[to_additive lt_neg] -lemma lt_inv' : a < b⁻¹ ↔ b < a⁻¹ := -by rw [← inv_lt_inv_iff, inv_inv] - -alias lt_inv' ↔ lt_inv_of_lt_inv _ -attribute [to_additive] lt_inv_of_lt_inv - -alias inv_lt' ↔ inv_lt_of_inv_lt' _ -attribute [to_additive neg_lt_of_neg_lt] inv_lt_of_inv_lt' - -@[to_additive] -lemma mul_inv_lt_inv_mul_iff : a * b⁻¹ < d⁻¹ * c ↔ d * a < c * b := -by rw [← mul_lt_mul_iff_left d, ← mul_lt_mul_iff_right b, mul_inv_cancel_left, mul_assoc, - inv_mul_cancel_right] - -@[simp, to_additive] lemma div_lt_self_iff (a : α) {b : α} : a / b < a ↔ 1 < b := -by simp [div_eq_mul_inv] - -alias sub_lt_self_iff ↔ _ sub_lt_self - -end typeclasses_left_right_lt - -section pre_order -variable [preorder α] - -section left_le -variables [covariant_class α α (*) (≤)] {a : α} - -@[to_additive] -lemma left.inv_le_self (h : 1 ≤ a) : a⁻¹ ≤ a := -le_trans (left.inv_le_one_iff.mpr h) h - -alias left.neg_le_self ← neg_le_self - -@[to_additive] -lemma left.self_le_inv (h : a ≤ 1) : a ≤ a⁻¹ := -le_trans h (left.one_le_inv_iff.mpr h) - -end left_le - -section left_lt -variables [covariant_class α α (*) (<)] {a : α} - -@[to_additive] -lemma left.inv_lt_self (h : 1 < a) : a⁻¹ < a := -(left.inv_lt_one_iff.mpr h).trans h - -alias left.neg_lt_self ← neg_lt_self - -@[to_additive] -lemma left.self_lt_inv (h : a < 1) : a < a⁻¹ := -lt_trans h (left.one_lt_inv_iff.mpr h) - -end left_lt - -section right_le -variables [covariant_class α α (swap (*)) (≤)] {a : α} - -@[to_additive] -lemma right.inv_le_self (h : 1 ≤ a) : a⁻¹ ≤ a := -le_trans (right.inv_le_one_iff.mpr h) h - -@[to_additive] -lemma right.self_le_inv (h : a ≤ 1) : a ≤ a⁻¹ := -le_trans h (right.one_le_inv_iff.mpr h) - -end right_le - -section right_lt -variables [covariant_class α α (swap (*)) (<)] {a : α} - -@[to_additive] -lemma right.inv_lt_self (h : 1 < a) : a⁻¹ < a := -(right.inv_lt_one_iff.mpr h).trans h - -@[to_additive] -lemma right.self_lt_inv (h : a < 1) : a < a⁻¹ := -lt_trans h (right.one_lt_inv_iff.mpr h) - -end right_lt - -end pre_order - -end group - -section comm_group -variables [comm_group α] - -section has_le -variables [has_le α] [covariant_class α α (*) (≤)] {a b c d : α} - -@[to_additive] -lemma inv_mul_le_iff_le_mul' : c⁻¹ * a ≤ b ↔ a ≤ b * c := -by rw [inv_mul_le_iff_le_mul, mul_comm] - -@[simp, to_additive] -lemma mul_inv_le_iff_le_mul' : a * b⁻¹ ≤ c ↔ a ≤ b * c := -by rw [← inv_mul_le_iff_le_mul, mul_comm] - -@[to_additive add_neg_le_add_neg_iff] -lemma mul_inv_le_mul_inv_iff' : a * b⁻¹ ≤ c * d⁻¹ ↔ a * d ≤ c * b := -by rw [mul_comm c, mul_inv_le_inv_mul_iff, mul_comm] - -end has_le - -section has_lt -variables [has_lt α] [covariant_class α α (*) (<)] {a b c d : α} - -@[to_additive] -lemma inv_mul_lt_iff_lt_mul' : c⁻¹ * a < b ↔ a < b * c := -by rw [inv_mul_lt_iff_lt_mul, mul_comm] - -@[simp, to_additive] -lemma mul_inv_lt_iff_le_mul' : a * b⁻¹ < c ↔ a < b * c := -by rw [← inv_mul_lt_iff_lt_mul, mul_comm] - -@[to_additive add_neg_lt_add_neg_iff] -lemma mul_inv_lt_mul_inv_iff' : a * b⁻¹ < c * d⁻¹ ↔ a * d < c * b := -by rw [mul_comm c, mul_inv_lt_inv_mul_iff, mul_comm] - -end has_lt - -end comm_group - -alias le_inv' ↔ le_inv_of_le_inv _ -attribute [to_additive] le_inv_of_le_inv - -alias left.inv_le_one_iff ↔ one_le_of_inv_le_one _ -attribute [to_additive] one_le_of_inv_le_one - -alias left.one_le_inv_iff ↔ le_one_of_one_le_inv _ -attribute [to_additive nonpos_of_neg_nonneg] le_one_of_one_le_inv - -alias inv_lt_inv_iff ↔ lt_of_inv_lt_inv _ -attribute [to_additive] lt_of_inv_lt_inv - -alias left.inv_lt_one_iff ↔ one_lt_of_inv_lt_one _ -attribute [to_additive] one_lt_of_inv_lt_one - -alias left.inv_lt_one_iff ← inv_lt_one_iff_one_lt -attribute [to_additive] inv_lt_one_iff_one_lt - -alias left.inv_lt_one_iff ← inv_lt_one' -attribute [to_additive neg_lt_zero] inv_lt_one' - -alias left.one_lt_inv_iff ↔ inv_of_one_lt_inv _ -attribute [to_additive neg_of_neg_pos] inv_of_one_lt_inv - -alias left.one_lt_inv_iff ↔ _ one_lt_inv_of_inv -attribute [to_additive neg_pos_of_neg] one_lt_inv_of_inv - -alias le_inv_mul_iff_mul_le ↔ mul_le_of_le_inv_mul _ -attribute [to_additive] mul_le_of_le_inv_mul - -alias le_inv_mul_iff_mul_le ↔ _ le_inv_mul_of_mul_le -attribute [to_additive] le_inv_mul_of_mul_le - -alias inv_mul_le_iff_le_mul ↔ _ inv_mul_le_of_le_mul -attribute [to_additive] inv_mul_le_iff_le_mul - -alias lt_inv_mul_iff_mul_lt ↔ mul_lt_of_lt_inv_mul _ -attribute [to_additive] mul_lt_of_lt_inv_mul - -alias lt_inv_mul_iff_mul_lt ↔ _ lt_inv_mul_of_mul_lt -attribute [to_additive] lt_inv_mul_of_mul_lt - -alias inv_mul_lt_iff_lt_mul ↔ lt_mul_of_inv_mul_lt inv_mul_lt_of_lt_mul -attribute [to_additive] lt_mul_of_inv_mul_lt -attribute [to_additive] inv_mul_lt_of_lt_mul - -alias lt_mul_of_inv_mul_lt ← lt_mul_of_inv_mul_lt_left -attribute [to_additive] lt_mul_of_inv_mul_lt_left - -alias left.inv_le_one_iff ← inv_le_one' -attribute [to_additive neg_nonpos] inv_le_one' - -alias left.one_le_inv_iff ← one_le_inv' -attribute [to_additive neg_nonneg] one_le_inv' - -alias left.one_lt_inv_iff ← one_lt_inv' -attribute [to_additive neg_pos] one_lt_inv' - -alias mul_lt_mul_left' ← ordered_comm_group.mul_lt_mul_left' -attribute [to_additive ordered_add_comm_group.add_lt_add_left] ordered_comm_group.mul_lt_mul_left' - -alias le_of_mul_le_mul_left' ← ordered_comm_group.le_of_mul_le_mul_left -attribute [to_additive ordered_add_comm_group.le_of_add_le_add_left] - ordered_comm_group.le_of_mul_le_mul_left - -alias lt_of_mul_lt_mul_left' ← ordered_comm_group.lt_of_mul_lt_mul_left -attribute [to_additive ordered_add_comm_group.lt_of_add_lt_add_left] - ordered_comm_group.lt_of_mul_lt_mul_left - -/-- Pullback an `ordered_comm_group` under an injective map. -See note [reducible non-instances]. -/ -@[reducible, to_additive function.injective.ordered_add_comm_group -"Pullback an `ordered_add_comm_group` under an injective map."] -def function.injective.ordered_comm_group [ordered_comm_group α] {β : Type*} - [has_one β] [has_mul β] [has_inv β] [has_div β] [has_pow β ℕ] [has_pow β ℤ] - (f : β → α) (hf : function.injective f) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) - (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) - (div : ∀ x y, f (x / y) = f x / f y) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) - (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : - ordered_comm_group β := -{ ..partial_order.lift f hf, - ..hf.ordered_comm_monoid f one mul npow, - ..hf.comm_group f one mul inv div npow zpow } - -/- Most of the lemmas that are primed in this section appear in ordered_field. -/ -/- I (DT) did not try to minimise the assumptions. -/ -section group -variables [group α] [has_le α] - -section right -variables [covariant_class α α (swap (*)) (≤)] {a b c d : α} - -@[simp, to_additive] -lemma div_le_div_iff_right (c : α) : a / c ≤ b / c ↔ a ≤ b := -by simpa only [div_eq_mul_inv] using mul_le_mul_iff_right _ - -@[to_additive sub_le_sub_right] -lemma div_le_div_right' (h : a ≤ b) (c : α) : a / c ≤ b / c := -(div_le_div_iff_right c).2 h - -@[simp, to_additive sub_nonneg] -lemma one_le_div' : 1 ≤ a / b ↔ b ≤ a := -by rw [← mul_le_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] - -alias sub_nonneg ↔ le_of_sub_nonneg sub_nonneg_of_le - -@[simp, to_additive sub_nonpos] -lemma div_le_one' : a / b ≤ 1 ↔ a ≤ b := -by rw [← mul_le_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] - -alias sub_nonpos ↔ le_of_sub_nonpos sub_nonpos_of_le - -@[to_additive] -lemma le_div_iff_mul_le : a ≤ c / b ↔ a * b ≤ c := -by rw [← mul_le_mul_iff_right b, div_eq_mul_inv, inv_mul_cancel_right] - -alias le_sub_iff_add_le ↔ add_le_of_le_sub_right le_sub_right_of_add_le - -@[to_additive] -lemma div_le_iff_le_mul : a / c ≤ b ↔ a ≤ b * c := -by rw [← mul_le_mul_iff_right c, div_eq_mul_inv, inv_mul_cancel_right] - --- TODO: Should we get rid of `sub_le_iff_le_add` in favor of --- (a renamed version of) `tsub_le_iff_right`? -@[priority 100] -- see Note [lower instance priority] -instance add_group.to_has_ordered_sub {α : Type*} [add_group α] [has_le α] - [covariant_class α α (swap (+)) (≤)] : has_ordered_sub α := -⟨λ a b c, sub_le_iff_le_add⟩ -/-- `equiv.mul_right` as an `order_iso`. See also `order_embedding.mul_right`. -/ -@[to_additive "`equiv.add_right` as an `order_iso`. See also `order_embedding.add_right`.", - simps to_equiv apply {simp_rhs := tt}] -def order_iso.mul_right (a : α) : α ≃o α := -{ map_rel_iff' := λ _ _, mul_le_mul_iff_right a, to_equiv := equiv.mul_right a } - -@[simp, to_additive] lemma order_iso.mul_right_symm (a : α) : - (order_iso.mul_right a).symm = order_iso.mul_right a⁻¹ := -by { ext x, refl } - -end right - -section left -variables [covariant_class α α (*) (≤)] - -/-- `equiv.mul_left` as an `order_iso`. See also `order_embedding.mul_left`. -/ -@[to_additive "`equiv.add_left` as an `order_iso`. See also `order_embedding.add_left`.", - simps to_equiv apply {simp_rhs := tt}] -def order_iso.mul_left (a : α) : α ≃o α := -{ map_rel_iff' := λ _ _, mul_le_mul_iff_left a, to_equiv := equiv.mul_left a } - -@[simp, to_additive] lemma order_iso.mul_left_symm (a : α) : - (order_iso.mul_left a).symm = order_iso.mul_left a⁻¹ := -by { ext x, refl } - -variables [covariant_class α α (swap (*)) (≤)] {a b c : α} - -@[simp, to_additive] -lemma div_le_div_iff_left (a : α) : a / b ≤ a / c ↔ c ≤ b := -by rw [div_eq_mul_inv, div_eq_mul_inv, ← mul_le_mul_iff_left a⁻¹, inv_mul_cancel_left, - inv_mul_cancel_left, inv_le_inv_iff] - -@[to_additive sub_le_sub_left] -lemma div_le_div_left' (h : a ≤ b) (c : α) : c / b ≤ c / a := -(div_le_div_iff_left c).2 h - -end left - -end group - -section comm_group -variables [comm_group α] - -section has_le -variables [has_le α] [covariant_class α α (*) (≤)] {a b c d : α} - -@[to_additive sub_le_sub_iff] -lemma div_le_div_iff' : a / b ≤ c / d ↔ a * d ≤ c * b := -by simpa only [div_eq_mul_inv] using mul_inv_le_mul_inv_iff' - -@[to_additive] -lemma le_div_iff_mul_le' : b ≤ c / a ↔ a * b ≤ c := -by rw [le_div_iff_mul_le, mul_comm] - -alias le_sub_iff_add_le' ↔ add_le_of_le_sub_left le_sub_left_of_add_le - -@[to_additive] -lemma div_le_iff_le_mul' : a / b ≤ c ↔ a ≤ b * c := -by rw [div_le_iff_le_mul, mul_comm] - -alias sub_le_iff_le_add' ↔ le_add_of_sub_left_le sub_left_le_of_le_add - -@[simp, to_additive] -lemma inv_le_div_iff_le_mul : b⁻¹ ≤ a / c ↔ c ≤ a * b := -le_div_iff_mul_le.trans inv_mul_le_iff_le_mul' - -@[to_additive] -lemma inv_le_div_iff_le_mul' : a⁻¹ ≤ b / c ↔ c ≤ a * b := -by rw [inv_le_div_iff_le_mul, mul_comm] - -@[to_additive sub_le] -lemma div_le'' : a / b ≤ c ↔ a / c ≤ b := -div_le_iff_le_mul'.trans div_le_iff_le_mul.symm - -@[to_additive le_sub] -lemma le_div'' : a ≤ b / c ↔ c ≤ b / a := -le_div_iff_mul_le'.trans le_div_iff_mul_le.symm - -end has_le - -section preorder -variables [preorder α] [covariant_class α α (*) (≤)] {a b c d : α} - -@[to_additive sub_le_sub] -lemma div_le_div'' (hab : a ≤ b) (hcd : c ≤ d) : - a / d ≤ b / c := -begin - rw [div_eq_mul_inv, div_eq_mul_inv, mul_comm b, mul_inv_le_inv_mul_iff, mul_comm], - exact mul_le_mul' hab hcd -end - -end preorder - -end comm_group - -/- Most of the lemmas that are primed in this section appear in ordered_field. -/ -/- I (DT) did not try to minimise the assumptions. -/ -section group -variables [group α] [has_lt α] - -section right -variables [covariant_class α α (swap (*)) (<)] {a b c d : α} - -@[simp, to_additive] -lemma div_lt_div_iff_right (c : α) : a / c < b / c ↔ a < b := -by simpa only [div_eq_mul_inv] using mul_lt_mul_iff_right _ - -@[to_additive sub_lt_sub_right] -lemma div_lt_div_right' (h : a < b) (c : α) : a / c < b / c := -(div_lt_div_iff_right c).2 h - -@[simp, to_additive sub_pos] -lemma one_lt_div' : 1 < a / b ↔ b < a := -by rw [← mul_lt_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] - -alias sub_pos ↔ lt_of_sub_pos sub_pos_of_lt - -@[simp, to_additive sub_neg] -lemma div_lt_one' : a / b < 1 ↔ a < b := -by rw [← mul_lt_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] - -alias sub_neg ↔ lt_of_sub_neg sub_neg_of_lt - -alias sub_neg ← sub_lt_zero - -@[to_additive] -lemma lt_div_iff_mul_lt : a < c / b ↔ a * b < c := -by rw [← mul_lt_mul_iff_right b, div_eq_mul_inv, inv_mul_cancel_right] - -alias lt_sub_iff_add_lt ↔ add_lt_of_lt_sub_right lt_sub_right_of_add_lt - -@[to_additive] -lemma div_lt_iff_lt_mul : a / c < b ↔ a < b * c := -by rw [← mul_lt_mul_iff_right c, div_eq_mul_inv, inv_mul_cancel_right] - -alias sub_lt_iff_lt_add ↔ lt_add_of_sub_right_lt sub_right_lt_of_lt_add - -end right - -section left -variables [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] {a b c : α} - -@[simp, to_additive] -lemma div_lt_div_iff_left (a : α) : a / b < a / c ↔ c < b := -by rw [div_eq_mul_inv, div_eq_mul_inv, ← mul_lt_mul_iff_left a⁻¹, inv_mul_cancel_left, - inv_mul_cancel_left, inv_lt_inv_iff] - -@[simp, to_additive] -lemma inv_lt_div_iff_lt_mul : a⁻¹ < b / c ↔ c < a * b := -by rw [div_eq_mul_inv, lt_mul_inv_iff_mul_lt, inv_mul_lt_iff_lt_mul] - -@[to_additive sub_lt_sub_left] -lemma div_lt_div_left' (h : a < b) (c : α) : c / b < c / a := -(div_lt_div_iff_left c).2 h - -end left - -end group - -section comm_group -variables [comm_group α] - -section has_lt -variables [has_lt α] [covariant_class α α (*) (<)] {a b c d : α} - -@[to_additive sub_lt_sub_iff] -lemma div_lt_div_iff' : a / b < c / d ↔ a * d < c * b := -by simpa only [div_eq_mul_inv] using mul_inv_lt_mul_inv_iff' - -@[to_additive] -lemma lt_div_iff_mul_lt' : b < c / a ↔ a * b < c := -by rw [lt_div_iff_mul_lt, mul_comm] - -alias lt_sub_iff_add_lt' ↔ add_lt_of_lt_sub_left lt_sub_left_of_add_lt - -@[to_additive] -lemma div_lt_iff_lt_mul' : a / b < c ↔ a < b * c := -by rw [div_lt_iff_lt_mul, mul_comm] - -alias sub_lt_iff_lt_add' ↔ lt_add_of_sub_left_lt sub_left_lt_of_lt_add - -@[to_additive] -lemma inv_lt_div_iff_lt_mul' : b⁻¹ < a / c ↔ c < a * b := -lt_div_iff_mul_lt.trans inv_mul_lt_iff_lt_mul' - -@[to_additive sub_lt] -lemma div_lt'' : a / b < c ↔ a / c < b := -div_lt_iff_lt_mul'.trans div_lt_iff_lt_mul.symm - -@[to_additive lt_sub] -lemma lt_div'' : a < b / c ↔ c < b / a := -lt_div_iff_mul_lt'.trans lt_div_iff_mul_lt.symm - -end has_lt - -section preorder -variables [preorder α] [covariant_class α α (*) (<)] {a b c d : α} - -@[to_additive sub_lt_sub] -lemma div_lt_div'' (hab : a < b) (hcd : c < d) : - a / d < b / c := -begin - rw [div_eq_mul_inv, div_eq_mul_inv, mul_comm b, mul_inv_lt_inv_mul_iff, mul_comm], - exact mul_lt_mul_of_lt_of_lt hab hcd -end - -end preorder - -end comm_group - -section linear_order -variables [group α] [linear_order α] [covariant_class α α (*) (≤)] - -section variable_names -variables {a b c : α} - -@[to_additive] -lemma le_of_forall_one_lt_lt_mul (h : ∀ ε : α, 1 < ε → a < b * ε) : a ≤ b := -le_of_not_lt (λ h₁, lt_irrefl a (by simpa using (h _ (lt_inv_mul_iff_lt.mpr h₁)))) - -@[to_additive] -lemma le_iff_forall_one_lt_lt_mul : a ≤ b ↔ ∀ ε, 1 < ε → a < b * ε := -⟨λ h ε, lt_mul_of_le_of_one_lt h, le_of_forall_one_lt_lt_mul⟩ - -/- I (DT) introduced this lemma to prove (the additive version `sub_le_sub_flip` of) -`div_le_div_flip` below. Now I wonder what is the point of either of these lemmas... -/ -@[to_additive] -lemma div_le_inv_mul_iff [covariant_class α α (swap (*)) (≤)] : - a / b ≤ a⁻¹ * b ↔ a ≤ b := -begin - rw [div_eq_mul_inv, mul_inv_le_inv_mul_iff], - exact ⟨λ h, not_lt.mp (λ k, not_lt.mpr h (mul_lt_mul''' k k)), λ h, mul_le_mul' h h⟩, -end - -/- What is the point of this lemma? See comment about `div_le_inv_mul_iff` above. -/ -@[simp, to_additive] -lemma div_le_div_flip {α : Type*} [comm_group α] [linear_order α] [covariant_class α α (*) (≤)] - {a b : α}: - a / b ≤ b / a ↔ a ≤ b := -begin - rw [div_eq_mul_inv b, mul_comm], - exact div_le_inv_mul_iff, -end - -@[simp, to_additive] lemma max_one_div_max_inv_one_eq_self (a : α) : - max a 1 / max a⁻¹ 1 = a := -by { rcases le_total a 1 with h|h; simp [h] } - -alias max_zero_sub_max_neg_zero_eq_self ← max_zero_sub_eq_self - -end variable_names - -section densely_ordered -variables [densely_ordered α] {a b c : α} - -@[to_additive] -lemma le_of_forall_one_lt_le_mul (h : ∀ ε : α, 1 < ε → a ≤ b * ε) : a ≤ b := -le_of_forall_le_of_dense $ λ c hc, -calc a ≤ b * (b⁻¹ * c) : h _ (lt_inv_mul_iff_lt.mpr hc) - ... = c : mul_inv_cancel_left b c - -@[to_additive] -lemma le_of_forall_lt_one_mul_le (h : ∀ ε < 1, a * ε ≤ b) : a ≤ b := -@le_of_forall_one_lt_le_mul αᵒᵈ _ _ _ _ _ _ h - -@[to_additive] -lemma le_of_forall_one_lt_div_le (h : ∀ ε : α, 1 < ε → a / ε ≤ b) : a ≤ b := -le_of_forall_lt_one_mul_le $ λ ε ε1, - by simpa only [div_eq_mul_inv, inv_inv] using h ε⁻¹ (left.one_lt_inv_iff.2 ε1) - -@[to_additive] -lemma le_iff_forall_one_lt_le_mul : a ≤ b ↔ ∀ ε, 1 < ε → a ≤ b * ε := -⟨λ h ε ε_pos, le_mul_of_le_of_one_le h ε_pos.le, le_of_forall_one_lt_le_mul⟩ - -@[to_additive] -lemma le_iff_forall_lt_one_mul_le : a ≤ b ↔ ∀ ε < 1, a * ε ≤ b := -@le_iff_forall_one_lt_le_mul αᵒᵈ _ _ _ _ _ _ - -end densely_ordered - -end linear_order - -/-! -### Linearly ordered commutative groups --/ - -/-- A linearly ordered additive commutative group is an -additive commutative group with a linear order in which -addition is monotone. -/ -@[protect_proj, ancestor ordered_add_comm_group linear_order] -class linear_ordered_add_comm_group (α : Type u) extends ordered_add_comm_group α, linear_order α - -/-- A linearly ordered commutative monoid with an additively absorbing `⊤` element. - Instances should include number systems with an infinite element adjoined.` -/ -@[protect_proj, ancestor linear_ordered_add_comm_monoid_with_top sub_neg_monoid nontrivial] -class linear_ordered_add_comm_group_with_top (α : Type*) - extends linear_ordered_add_comm_monoid_with_top α, sub_neg_monoid α, nontrivial α := -(neg_top : - (⊤ : α) = ⊤) -(add_neg_cancel : ∀ a:α, a ≠ ⊤ → a + (- a) = 0) - -/-- A linearly ordered commutative group is a -commutative group with a linear order in which -multiplication is monotone. -/ -@[protect_proj, ancestor ordered_comm_group linear_order, to_additive] -class linear_ordered_comm_group (α : Type u) extends ordered_comm_group α, linear_order α - -@[to_additive] instance [linear_ordered_comm_group α] : - linear_ordered_comm_group αᵒᵈ := -{ .. order_dual.ordered_comm_group, .. order_dual.linear_order α } - -section linear_ordered_comm_group -variables [linear_ordered_comm_group α] {a b c : α} - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance linear_ordered_comm_group.to_linear_ordered_cancel_comm_monoid : - linear_ordered_cancel_comm_monoid α := -{ le_of_mul_le_mul_left := λ x y z, le_of_mul_le_mul_left', - mul_left_cancel := λ x y z, mul_left_cancel, - ..‹linear_ordered_comm_group α› } - -/-- Pullback a `linear_ordered_comm_group` under an injective map. -See note [reducible non-instances]. -/ -@[reducible, to_additive function.injective.linear_ordered_add_comm_group -"Pullback a `linear_ordered_add_comm_group` under an injective map."] -def function.injective.linear_ordered_comm_group {β : Type*} - [has_one β] [has_mul β] [has_inv β] [has_div β] [has_pow β ℕ] [has_pow β ℤ] - (f : β → α) (hf : function.injective f) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) - (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) - (div : ∀ x y, f (x / y) = f x / f y) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) - (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : - linear_ordered_comm_group β := -{ ..linear_order.lift f hf, - ..hf.ordered_comm_group f one mul inv div npow zpow } - -@[to_additive linear_ordered_add_comm_group.add_lt_add_left] -lemma linear_ordered_comm_group.mul_lt_mul_left' - (a b : α) (h : a < b) (c : α) : c * a < c * b := -mul_lt_mul_left' h c - -@[to_additive min_neg_neg] -lemma min_inv_inv' (a b : α) : min (a⁻¹) (b⁻¹) = (max a b)⁻¹ := -eq.symm $ @monotone.map_max α αᵒᵈ _ _ has_inv.inv a b $ λ a b, inv_le_inv_iff.mpr - -@[to_additive max_neg_neg] -lemma max_inv_inv' (a b : α) : max (a⁻¹) (b⁻¹) = (min a b)⁻¹ := -eq.symm $ @monotone.map_min α αᵒᵈ _ _ has_inv.inv a b $ λ a b, inv_le_inv_iff.mpr - -@[to_additive min_sub_sub_right] -lemma min_div_div_right' (a b c : α) : min (a / c) (b / c) = min a b / c := -by simpa only [div_eq_mul_inv] using min_mul_mul_right a b (c⁻¹) - -@[to_additive max_sub_sub_right] -lemma max_div_div_right' (a b c : α) : max (a / c) (b / c) = max a b / c := -by simpa only [div_eq_mul_inv] using max_mul_mul_right a b (c⁻¹) - -@[to_additive min_sub_sub_left] -lemma min_div_div_left' (a b c : α) : min (a / b) (a / c) = a / max b c := -by simp only [div_eq_mul_inv, min_mul_mul_left, min_inv_inv'] - -@[to_additive max_sub_sub_left] -lemma max_div_div_left' (a b c : α) : max (a / b) (a / c) = a / min b c := -by simp only [div_eq_mul_inv, max_mul_mul_left, max_inv_inv'] - -@[to_additive eq_zero_of_neg_eq] -lemma eq_one_of_inv_eq' (h : a⁻¹ = a) : a = 1 := -match lt_trichotomy a 1 with -| or.inl h₁ := - have 1 < a, from h ▸ one_lt_inv_of_inv h₁, - absurd h₁ this.asymm -| or.inr (or.inl h₁) := h₁ -| or.inr (or.inr h₁) := - have a < 1, from h ▸ inv_lt_one'.mpr h₁, - absurd h₁ this.asymm -end - -@[to_additive exists_zero_lt] -lemma exists_one_lt' [nontrivial α] : ∃ (a:α), 1 < a := -begin - obtain ⟨y, hy⟩ := decidable.exists_ne (1 : α), - cases hy.lt_or_lt, - { exact ⟨y⁻¹, one_lt_inv'.mpr h⟩ }, - { exact ⟨y, h⟩ } -end - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance linear_ordered_comm_group.to_no_max_order [nontrivial α] : - no_max_order α := -⟨ begin - obtain ⟨y, hy⟩ : ∃ (a:α), 1 < a := exists_one_lt', - exact λ a, ⟨a * y, lt_mul_of_one_lt_right' a hy⟩ - end ⟩ - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance linear_ordered_comm_group.to_no_min_order [nontrivial α] : no_min_order α := -⟨ begin - obtain ⟨y, hy⟩ : ∃ (a:α), 1 < a := exists_one_lt', - exact λ a, ⟨a / y, (div_lt_self_iff a).mpr hy⟩ - end ⟩ - -end linear_ordered_comm_group - -section covariant_add_le - -section has_neg - -/-- `abs a` is the absolute value of `a`. -/ -@[to_additive "`abs a` is the absolute value of `a`", - priority 100] -- see Note [lower instance priority] -instance has_inv.to_has_abs [has_inv α] [has_sup α] : has_abs α := ⟨λ a, a ⊔ a⁻¹⟩ - -@[to_additive] lemma abs_eq_sup_inv [has_inv α] [has_sup α] (a : α) : |a| = a ⊔ a⁻¹ := rfl - -variables [has_neg α] [linear_order α] {a b: α} - -lemma abs_eq_max_neg : abs a = max a (-a) := -rfl - -lemma abs_choice (x : α) : |x| = x ∨ |x| = -x := max_choice _ _ - -lemma abs_le' : |a| ≤ b ↔ a ≤ b ∧ -a ≤ b := max_le_iff - -lemma le_abs : a ≤ |b| ↔ a ≤ b ∨ a ≤ -b := le_max_iff - -lemma le_abs_self (a : α) : a ≤ |a| := le_max_left _ _ - -lemma neg_le_abs_self (a : α) : -a ≤ |a| := le_max_right _ _ - -lemma lt_abs : a < |b| ↔ a < b ∨ a < -b := lt_max_iff - -theorem abs_le_abs (h₀ : a ≤ b) (h₁ : -a ≤ b) : |a| ≤ |b| := -(abs_le'.2 ⟨h₀, h₁⟩).trans (le_abs_self b) - -lemma abs_by_cases (P : α → Prop) {a : α} (h1 : P a) (h2 : P (-a)) : P (|a|) := -sup_ind _ _ h1 h2 - -end has_neg - -section add_group -variables [add_group α] [linear_order α] - -@[simp] lemma abs_neg (a : α) : | -a| = |a| := -begin - rw [abs_eq_max_neg, max_comm, neg_neg, abs_eq_max_neg] -end - -lemma eq_or_eq_neg_of_abs_eq {a b : α} (h : |a| = b) : a = b ∨ a = -b := -by simpa only [← h, eq_comm, eq_neg_iff_eq_neg] using abs_choice a - -lemma abs_eq_abs {a b : α} : |a| = |b| ↔ a = b ∨ a = -b := -begin - refine ⟨λ h, _, λ h, _⟩, - { obtain rfl | rfl := eq_or_eq_neg_of_abs_eq h; - simpa only [neg_eq_iff_neg_eq, neg_inj, or.comm, @eq_comm _ (-b)] using abs_choice b }, - { cases h; simp only [h, abs_neg] }, -end - -lemma abs_sub_comm (a b : α) : |a - b| = |b - a| := -calc |a - b| = | - (b - a)| : congr_arg _ (neg_sub b a).symm - ... = |b - a| : abs_neg (b - a) - -variables [covariant_class α α (+) (≤)] {a b c : α} - -lemma abs_of_nonneg (h : 0 ≤ a) : |a| = a := -max_eq_left $ (neg_nonpos.2 h).trans h - -lemma abs_of_pos (h : 0 < a) : |a| = a := -abs_of_nonneg h.le - -lemma abs_of_nonpos (h : a ≤ 0) : |a| = -a := -max_eq_right $ h.trans (neg_nonneg.2 h) - -lemma abs_of_neg (h : a < 0) : |a| = -a := -abs_of_nonpos h.le - -@[simp] lemma abs_zero : |0| = (0:α) := -abs_of_nonneg le_rfl - -@[simp] lemma abs_pos : 0 < |a| ↔ a ≠ 0 := -begin - rcases lt_trichotomy a 0 with (ha|rfl|ha), - { simp [abs_of_neg ha, neg_pos, ha.ne, ha] }, - { simp }, - { simp [abs_of_pos ha, ha, ha.ne.symm] } -end - -lemma abs_pos_of_pos (h : 0 < a) : 0 < |a| := abs_pos.2 h.ne.symm - -lemma abs_pos_of_neg (h : a < 0) : 0 < |a| := abs_pos.2 h.ne - -lemma neg_abs_le_self (a : α) : -|a| ≤ a := -begin - cases le_total 0 a with h h, - { calc -|a| = - a : congr_arg (has_neg.neg) (abs_of_nonneg h) - ... ≤ 0 : neg_nonpos.mpr h - ... ≤ a : h }, - { calc -|a| = - - a : congr_arg (has_neg.neg) (abs_of_nonpos h) - ... ≤ a : (neg_neg a).le } -end - -lemma neg_abs_le_neg (a : α) : -|a| ≤ -a := -by simpa using neg_abs_le_self (-a) - -lemma abs_nonneg (a : α) : 0 ≤ |a| := -(le_total 0 a).elim (λ h, h.trans (le_abs_self a)) (λ h, (neg_nonneg.2 h).trans $ neg_le_abs_self a) - -@[simp] lemma abs_abs (a : α) : | |a| | = |a| := -abs_of_nonneg $ abs_nonneg a - -@[simp] lemma abs_eq_zero : |a| = 0 ↔ a = 0 := -decidable.not_iff_not.1 $ ne_comm.trans $ (abs_nonneg a).lt_iff_ne.symm.trans abs_pos - -@[simp] lemma abs_nonpos_iff {a : α} : |a| ≤ 0 ↔ a = 0 := -(abs_nonneg a).le_iff_eq.trans abs_eq_zero - -variable [covariant_class α α (swap (+)) (≤)] - -lemma abs_lt : |a| < b ↔ - b < a ∧ a < b := -max_lt_iff.trans $ and.comm.trans $ by rw [neg_lt] - -lemma neg_lt_of_abs_lt (h : |a| < b) : -b < a := (abs_lt.mp h).1 - -lemma lt_of_abs_lt (h : |a| < b) : a < b := (abs_lt.mp h).2 - -lemma max_sub_min_eq_abs' (a b : α) : max a b - min a b = |a - b| := -begin - cases le_total a b with ab ba, - { rw [max_eq_right ab, min_eq_left ab, abs_of_nonpos, neg_sub], rwa sub_nonpos }, - { rw [max_eq_left ba, min_eq_right ba, abs_of_nonneg], rwa sub_nonneg } -end - -lemma max_sub_min_eq_abs (a b : α) : max a b - min a b = |b - a| := -by { rw abs_sub_comm, exact max_sub_min_eq_abs' _ _ } - -end add_group - -end covariant_add_le - -section linear_ordered_add_comm_group - -variables [linear_ordered_add_comm_group α] {a b c d : α} - -lemma abs_le : |a| ≤ b ↔ - b ≤ a ∧ a ≤ b := by rw [abs_le', and.comm, neg_le] - -lemma le_abs' : a ≤ |b| ↔ b ≤ -a ∨ a ≤ b := by rw [le_abs, or.comm, le_neg] - -lemma neg_le_of_abs_le (h : |a| ≤ b) : -b ≤ a := (abs_le.mp h).1 - -lemma le_of_abs_le (h : |a| ≤ b) : a ≤ b := (abs_le.mp h).2 - -@[to_additive] lemma apply_abs_le_mul_of_one_le' {β : Type*} [mul_one_class β] [preorder β] - [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)] {f : α → β} {a : α} - (h₁ : 1 ≤ f a) (h₂ : 1 ≤ f (-a)) : - f (|a|) ≤ f a * f (-a) := -(le_total a 0).by_cases (λ ha, (abs_of_nonpos ha).symm ▸ le_mul_of_one_le_left' h₁) - (λ ha, (abs_of_nonneg ha).symm ▸ le_mul_of_one_le_right' h₂) - -@[to_additive] lemma apply_abs_le_mul_of_one_le {β : Type*} [mul_one_class β] [preorder β] - [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)] {f : α → β} - (h : ∀ x, 1 ≤ f x) (a : α) : - f (|a|) ≤ f a * f (-a) := -apply_abs_le_mul_of_one_le' (h _) (h _) - -/-- -The **triangle inequality** in `linear_ordered_add_comm_group`s. --/ -lemma abs_add (a b : α) : |a + b| ≤ |a| + |b| := -abs_le.2 ⟨(neg_add (|a|) (|b|)).symm ▸ - add_le_add (neg_le.2 $ neg_le_abs_self _) (neg_le.2 $ neg_le_abs_self _), - add_le_add (le_abs_self _) (le_abs_self _)⟩ - -lemma abs_add' (a b : α) : |a| ≤ |b| + |b + a| := -by simpa using abs_add (-b) (b + a) - -theorem abs_sub (a b : α) : - |a - b| ≤ |a| + |b| := -by { rw [sub_eq_add_neg, ←abs_neg b], exact abs_add a _ } - -lemma abs_sub_le_iff : |a - b| ≤ c ↔ a - b ≤ c ∧ b - a ≤ c := -by rw [abs_le, neg_le_sub_iff_le_add, sub_le_iff_le_add', and_comm, sub_le_iff_le_add'] - -lemma abs_sub_lt_iff : |a - b| < c ↔ a - b < c ∧ b - a < c := -by rw [abs_lt, neg_lt_sub_iff_lt_add', sub_lt_iff_lt_add', and_comm, sub_lt_iff_lt_add'] - -lemma sub_le_of_abs_sub_le_left (h : |a - b| ≤ c) : b - c ≤ a := -sub_le.1 $ (abs_sub_le_iff.1 h).2 - -lemma sub_le_of_abs_sub_le_right (h : |a - b| ≤ c) : a - c ≤ b := -sub_le_of_abs_sub_le_left (abs_sub_comm a b ▸ h) - -lemma sub_lt_of_abs_sub_lt_left (h : |a - b| < c) : b - c < a := -sub_lt.1 $ (abs_sub_lt_iff.1 h).2 - -lemma sub_lt_of_abs_sub_lt_right (h : |a - b| < c) : a - c < b := -sub_lt_of_abs_sub_lt_left (abs_sub_comm a b ▸ h) - -lemma abs_sub_abs_le_abs_sub (a b : α) : |a| - |b| ≤ |a - b| := -sub_le_iff_le_add.2 $ -calc |a| = |a - b + b| : by rw [sub_add_cancel] - ... ≤ |a - b| + |b| : abs_add _ _ - -lemma abs_abs_sub_abs_le_abs_sub (a b : α) : | |a| - |b| | ≤ |a - b| := -abs_sub_le_iff.2 ⟨abs_sub_abs_le_abs_sub _ _, by rw abs_sub_comm; apply abs_sub_abs_le_abs_sub⟩ - -lemma abs_eq (hb : 0 ≤ b) : |a| = b ↔ a = b ∨ a = -b := -begin - refine ⟨eq_or_eq_neg_of_abs_eq, _⟩, - rintro (rfl|rfl); simp only [abs_neg, abs_of_nonneg hb] -end - -lemma abs_le_max_abs_abs (hab : a ≤ b) (hbc : b ≤ c) : |b| ≤ max (|a|) (|c|) := -abs_le'.2 - ⟨by simp [hbc.trans (le_abs_self c)], - by simp [(neg_le_neg_iff.mpr hab).trans (neg_le_abs_self a)]⟩ - -lemma eq_of_abs_sub_eq_zero {a b : α} (h : |a - b| = 0) : a = b := -sub_eq_zero.1 $ abs_eq_zero.1 h - -lemma abs_sub_le (a b c : α) : |a - c| ≤ |a - b| + |b - c| := -calc - |a - c| = |a - b + (b - c)| : by rw [sub_add_sub_cancel] - ... ≤ |a - b| + |b - c| : abs_add _ _ - -lemma abs_add_three (a b c : α) : |a + b + c| ≤ |a| + |b| + |c| := -(abs_add _ _).trans (add_le_add_right (abs_add _ _) _) - -lemma dist_bdd_within_interval {a b lb ub : α} (hal : lb ≤ a) (hau : a ≤ ub) - (hbl : lb ≤ b) (hbu : b ≤ ub) : |a - b| ≤ ub - lb := -abs_sub_le_iff.2 ⟨sub_le_sub hau hbl, sub_le_sub hbu hal⟩ - -lemma eq_of_abs_sub_nonpos (h : |a - b| ≤ 0) : a = b := -eq_of_abs_sub_eq_zero (le_antisymm h (abs_nonneg (a - b))) - -lemma max_sub_max_le_max (a b c d : α) : max a b - max c d ≤ max (a - c) (b - d) := -begin - simp only [sub_le_iff_le_add, max_le_iff], split, - calc a = a - c + c : (sub_add_cancel a c).symm - ... ≤ max (a - c) (b - d) + max c d : add_le_add (le_max_left _ _) (le_max_left _ _), - calc b = b - d + d : (sub_add_cancel b d).symm - ... ≤ max (a - c) (b - d) + max c d : add_le_add (le_max_right _ _) (le_max_right _ _) -end - -lemma abs_max_sub_max_le_max (a b c d : α) : |max a b - max c d| ≤ max (|a - c|) (|b - d|) := -begin - refine abs_sub_le_iff.2 ⟨_, _⟩, - { exact (max_sub_max_le_max _ _ _ _).trans (max_le_max (le_abs_self _) (le_abs_self _)) }, - { rw [abs_sub_comm a c, abs_sub_comm b d], - exact (max_sub_max_le_max _ _ _ _).trans (max_le_max (le_abs_self _) (le_abs_self _)) } -end - -lemma abs_min_sub_min_le_max (a b c d : α) : |min a b - min c d| ≤ max (|a - c|) (|b - d|) := -by simpa only [max_neg_neg, neg_sub_neg, abs_sub_comm] - using abs_max_sub_max_le_max (-a) (-b) (-c) (-d) - -lemma abs_max_sub_max_le_abs (a b c : α) : |max a c - max b c| ≤ |a - b| := -by simpa only [sub_self, abs_zero, max_eq_left (abs_nonneg _)] - using abs_max_sub_max_le_max a c b c - -instance with_top.linear_ordered_add_comm_group_with_top : - linear_ordered_add_comm_group_with_top (with_top α) := -{ neg := option.map (λ a : α, -a), - neg_top := @option.map_none _ _ (λ a : α, -a), - add_neg_cancel := begin - rintro (a | a) ha, - { exact (ha rfl).elim }, - { exact with_top.coe_add.symm.trans (with_top.coe_eq_coe.2 (add_neg_self a)) } - end, - .. with_top.linear_ordered_add_comm_monoid_with_top, - .. option.nontrivial } - -@[simp, norm_cast] -lemma with_top.coe_neg (a : α) : ((-a : α) : with_top α) = -a := rfl - -end linear_ordered_add_comm_group - -namespace add_comm_group - -/-- A collection of elements in an `add_comm_group` designated as "non-negative". -This is useful for constructing an `ordered_add_commm_group` -by choosing a positive cone in an exisiting `add_comm_group`. -/ -@[nolint has_inhabited_instance] -structure positive_cone (α : Type*) [add_comm_group α] := -(nonneg : α → Prop) -(pos : α → Prop := λ a, nonneg a ∧ ¬ nonneg (-a)) -(pos_iff : ∀ a, pos a ↔ nonneg a ∧ ¬ nonneg (-a) . order_laws_tac) -(zero_nonneg : nonneg 0) -(add_nonneg : ∀ {a b}, nonneg a → nonneg b → nonneg (a + b)) -(nonneg_antisymm : ∀ {a}, nonneg a → nonneg (-a) → a = 0) - -/-- A positive cone in an `add_comm_group` induces a linear order if -for every `a`, either `a` or `-a` is non-negative. -/ -@[nolint has_inhabited_instance] -structure total_positive_cone (α : Type*) [add_comm_group α] extends positive_cone α := -(nonneg_decidable : decidable_pred nonneg) -(nonneg_total : ∀ a : α, nonneg a ∨ nonneg (-a)) - -/-- Forget that a `total_positive_cone` is total. -/ -add_decl_doc total_positive_cone.to_positive_cone - -end add_comm_group - -namespace ordered_add_comm_group - -open add_comm_group - -/-- Construct an `ordered_add_comm_group` by -designating a positive cone in an existing `add_comm_group`. -/ -def mk_of_positive_cone {α : Type*} [add_comm_group α] (C : positive_cone α) : - ordered_add_comm_group α := -{ le := λ a b, C.nonneg (b - a), - lt := λ a b, C.pos (b - a), - lt_iff_le_not_le := λ a b, by simp; rw [C.pos_iff]; simp, - le_refl := λ a, by simp [C.zero_nonneg], - le_trans := λ a b c nab nbc, by simp [-sub_eq_add_neg]; - rw ← sub_add_sub_cancel; exact C.add_nonneg nbc nab, - le_antisymm := λ a b nab nba, eq_of_sub_eq_zero $ - C.nonneg_antisymm nba (by rw neg_sub; exact nab), - add_le_add_left := λ a b nab c, by simpa [(≤), preorder.le] using nab, - ..‹add_comm_group α› } - -end ordered_add_comm_group - -namespace linear_ordered_add_comm_group - -open add_comm_group - -/-- Construct a `linear_ordered_add_comm_group` by -designating a positive cone in an existing `add_comm_group` -such that for every `a`, either `a` or `-a` is non-negative. -/ -def mk_of_positive_cone {α : Type*} [add_comm_group α] (C : total_positive_cone α) : - linear_ordered_add_comm_group α := -{ le_total := λ a b, by { convert C.nonneg_total (b - a), change C.nonneg _ = _, congr, simp, }, - decidable_le := λ a b, C.nonneg_decidable _, - ..ordered_add_comm_group.mk_of_positive_cone C.to_positive_cone } - -end linear_ordered_add_comm_group - -namespace prod - -variables {G H : Type*} - -@[to_additive] -instance [ordered_comm_group G] [ordered_comm_group H] : - ordered_comm_group (G × H) := -{ .. prod.comm_group, .. prod.partial_order G H, .. prod.ordered_cancel_comm_monoid } - -end prod - -section type_tags - -instance [ordered_add_comm_group α] : ordered_comm_group (multiplicative α) := -{ ..multiplicative.comm_group, - ..multiplicative.ordered_comm_monoid } - -instance [ordered_comm_group α] : ordered_add_comm_group (additive α) := -{ ..additive.add_comm_group, - ..additive.ordered_add_comm_monoid } - -instance [linear_ordered_add_comm_group α] : linear_ordered_comm_group (multiplicative α) := -{ ..multiplicative.linear_order, - ..multiplicative.ordered_comm_group } - -instance [linear_ordered_comm_group α] : linear_ordered_add_comm_group (additive α) := -{ ..additive.linear_order, - ..additive.ordered_add_comm_group } - -end type_tags - -section norm_num_lemmas -/- The following lemmas are stated so that the `norm_num` tactic can use them with the -expected signatures. -/ -variables [ordered_comm_group α] {a b : α} - -@[to_additive neg_le_neg] -lemma inv_le_inv' : a ≤ b → b⁻¹ ≤ a⁻¹ := -inv_le_inv_iff.mpr - -@[to_additive neg_lt_neg] -lemma inv_lt_inv' : a < b → b⁻¹ < a⁻¹ := -inv_lt_inv_iff.mpr - -/- The additive version is also a `linarith` lemma. -/ -@[to_additive] -theorem inv_lt_one_of_one_lt : 1 < a → a⁻¹ < 1 := -inv_lt_one_iff_one_lt.mpr - -/- The additive version is also a `linarith` lemma. -/ -@[to_additive] -lemma inv_le_one_of_one_le : 1 ≤ a → a⁻¹ ≤ 1 := -inv_le_one'.mpr - -@[to_additive neg_nonneg_of_nonpos] -lemma one_le_inv_of_le_one : a ≤ 1 → 1 ≤ a⁻¹ := -one_le_inv'.mpr - -end norm_num_lemmas diff --git a/src/algebra/order/group/abs.lean b/src/algebra/order/group/abs.lean new file mode 100644 index 0000000000000..890733166db8e --- /dev/null +++ b/src/algebra/order/group/abs.lean @@ -0,0 +1,284 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.abs +import algebra.order.group.order_iso +import order.min_max + +/-! +# Absolute values in ordered groups. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} +open function + +section covariant_add_le + +section has_neg + +/-- `abs a` is the absolute value of `a`. -/ +@[to_additive "`abs a` is the absolute value of `a`", + priority 100] -- see Note [lower instance priority] +instance has_inv.to_has_abs [has_inv α] [has_sup α] : has_abs α := ⟨λ a, a ⊔ a⁻¹⟩ + +@[to_additive] lemma abs_eq_sup_inv [has_inv α] [has_sup α] (a : α) : |a| = a ⊔ a⁻¹ := rfl + +variables [has_neg α] [linear_order α] {a b: α} + +lemma abs_eq_max_neg : abs a = max a (-a) := +rfl + +lemma abs_choice (x : α) : |x| = x ∨ |x| = -x := max_choice _ _ + +lemma abs_le' : |a| ≤ b ↔ a ≤ b ∧ -a ≤ b := max_le_iff + +lemma le_abs : a ≤ |b| ↔ a ≤ b ∨ a ≤ -b := le_max_iff + +lemma le_abs_self (a : α) : a ≤ |a| := le_max_left _ _ + +lemma neg_le_abs_self (a : α) : -a ≤ |a| := le_max_right _ _ + +lemma lt_abs : a < |b| ↔ a < b ∨ a < -b := lt_max_iff + +theorem abs_le_abs (h₀ : a ≤ b) (h₁ : -a ≤ b) : |a| ≤ |b| := +(abs_le'.2 ⟨h₀, h₁⟩).trans (le_abs_self b) + +lemma abs_by_cases (P : α → Prop) {a : α} (h1 : P a) (h2 : P (-a)) : P (|a|) := +sup_ind _ _ h1 h2 + +end has_neg + +section add_group +variables [add_group α] [linear_order α] + +@[simp] lemma abs_neg (a : α) : | -a| = |a| := +begin + rw [abs_eq_max_neg, max_comm, neg_neg, abs_eq_max_neg] +end + +lemma eq_or_eq_neg_of_abs_eq {a b : α} (h : |a| = b) : a = b ∨ a = -b := +by simpa only [← h, eq_comm, neg_eq_iff_eq_neg] using abs_choice a + +lemma abs_eq_abs {a b : α} : |a| = |b| ↔ a = b ∨ a = -b := +begin + refine ⟨λ h, _, λ h, _⟩, + { obtain rfl | rfl := eq_or_eq_neg_of_abs_eq h; + simpa only [neg_eq_iff_eq_neg, neg_inj, or.comm] using abs_choice b }, + { cases h; simp only [h, abs_neg] }, +end + +lemma abs_sub_comm (a b : α) : |a - b| = |b - a| := +calc |a - b| = | - (b - a)| : congr_arg _ (neg_sub b a).symm + ... = |b - a| : abs_neg (b - a) + +variables [covariant_class α α (+) (≤)] {a b c : α} + +lemma abs_of_nonneg (h : 0 ≤ a) : |a| = a := +max_eq_left $ (neg_nonpos.2 h).trans h + +lemma abs_of_pos (h : 0 < a) : |a| = a := +abs_of_nonneg h.le + +lemma abs_of_nonpos (h : a ≤ 0) : |a| = -a := +max_eq_right $ h.trans (neg_nonneg.2 h) + +lemma abs_of_neg (h : a < 0) : |a| = -a := +abs_of_nonpos h.le + +lemma abs_le_abs_of_nonneg (ha : 0 ≤ a) (hab : a ≤ b) : |a| ≤ |b| := +by rwa [abs_of_nonneg ha, abs_of_nonneg (ha.trans hab)] + +@[simp] lemma abs_zero : |0| = (0:α) := +abs_of_nonneg le_rfl + +@[simp] lemma abs_pos : 0 < |a| ↔ a ≠ 0 := +begin + rcases lt_trichotomy a 0 with (ha|rfl|ha), + { simp [abs_of_neg ha, neg_pos, ha.ne, ha] }, + { simp }, + { simp [abs_of_pos ha, ha, ha.ne.symm] } +end + +lemma abs_pos_of_pos (h : 0 < a) : 0 < |a| := abs_pos.2 h.ne.symm + +lemma abs_pos_of_neg (h : a < 0) : 0 < |a| := abs_pos.2 h.ne + +lemma neg_abs_le_self (a : α) : -|a| ≤ a := +begin + cases le_total 0 a with h h, + { calc -|a| = - a : congr_arg (has_neg.neg) (abs_of_nonneg h) + ... ≤ 0 : neg_nonpos.mpr h + ... ≤ a : h }, + { calc -|a| = - - a : congr_arg (has_neg.neg) (abs_of_nonpos h) + ... ≤ a : (neg_neg a).le } +end + +lemma add_abs_nonneg (a : α) : 0 ≤ a + |a| := +begin + rw ←add_right_neg a, + apply add_le_add_left, + exact (neg_le_abs_self a), +end + +lemma neg_abs_le_neg (a : α) : -|a| ≤ -a := +by simpa using neg_abs_le_self (-a) + +@[simp] lemma abs_nonneg (a : α) : 0 ≤ |a| := +(le_total 0 a).elim (λ h, h.trans (le_abs_self a)) (λ h, (neg_nonneg.2 h).trans $ neg_le_abs_self a) + +@[simp] lemma abs_abs (a : α) : | |a| | = |a| := +abs_of_nonneg $ abs_nonneg a + +@[simp] lemma abs_eq_zero : |a| = 0 ↔ a = 0 := +decidable.not_iff_not.1 $ ne_comm.trans $ (abs_nonneg a).lt_iff_ne.symm.trans abs_pos + +@[simp] lemma abs_nonpos_iff {a : α} : |a| ≤ 0 ↔ a = 0 := +(abs_nonneg a).le_iff_eq.trans abs_eq_zero + +variable [covariant_class α α (swap (+)) (≤)] + +lemma abs_le_abs_of_nonpos (ha : a ≤ 0) (hab : b ≤ a) : |a| ≤ |b| := +by { rw [abs_of_nonpos ha, abs_of_nonpos (hab.trans ha)], exact neg_le_neg_iff.mpr hab } + +lemma abs_lt : |a| < b ↔ - b < a ∧ a < b := +max_lt_iff.trans $ and.comm.trans $ by rw [neg_lt] + +lemma neg_lt_of_abs_lt (h : |a| < b) : -b < a := (abs_lt.mp h).1 + +lemma lt_of_abs_lt (h : |a| < b) : a < b := (abs_lt.mp h).2 + +lemma max_sub_min_eq_abs' (a b : α) : max a b - min a b = |a - b| := +begin + cases le_total a b with ab ba, + { rw [max_eq_right ab, min_eq_left ab, abs_of_nonpos, neg_sub], rwa sub_nonpos }, + { rw [max_eq_left ba, min_eq_right ba, abs_of_nonneg], rwa sub_nonneg } +end + +lemma max_sub_min_eq_abs (a b : α) : max a b - min a b = |b - a| := +by { rw abs_sub_comm, exact max_sub_min_eq_abs' _ _ } + +end add_group + +end covariant_add_le + +section linear_ordered_add_comm_group + +variables [linear_ordered_add_comm_group α] {a b c d : α} + +lemma abs_le : |a| ≤ b ↔ - b ≤ a ∧ a ≤ b := by rw [abs_le', and.comm, neg_le] + +lemma le_abs' : a ≤ |b| ↔ b ≤ -a ∨ a ≤ b := by rw [le_abs, or.comm, le_neg] + +lemma neg_le_of_abs_le (h : |a| ≤ b) : -b ≤ a := (abs_le.mp h).1 + +lemma le_of_abs_le (h : |a| ≤ b) : a ≤ b := (abs_le.mp h).2 + +@[to_additive] lemma apply_abs_le_mul_of_one_le' {β : Type*} [mul_one_class β] [preorder β] + [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)] {f : α → β} {a : α} + (h₁ : 1 ≤ f a) (h₂ : 1 ≤ f (-a)) : + f (|a|) ≤ f a * f (-a) := +(le_total a 0).by_cases (λ ha, (abs_of_nonpos ha).symm ▸ le_mul_of_one_le_left' h₁) + (λ ha, (abs_of_nonneg ha).symm ▸ le_mul_of_one_le_right' h₂) + +@[to_additive] lemma apply_abs_le_mul_of_one_le {β : Type*} [mul_one_class β] [preorder β] + [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)] {f : α → β} + (h : ∀ x, 1 ≤ f x) (a : α) : + f (|a|) ≤ f a * f (-a) := +apply_abs_le_mul_of_one_le' (h _) (h _) + +/-- +The **triangle inequality** in `linear_ordered_add_comm_group`s. +-/ +lemma abs_add (a b : α) : |a + b| ≤ |a| + |b| := +abs_le.2 ⟨(neg_add (|a|) (|b|)).symm ▸ + add_le_add (neg_le.2 $ neg_le_abs_self _) (neg_le.2 $ neg_le_abs_self _), + add_le_add (le_abs_self _) (le_abs_self _)⟩ + +lemma abs_add' (a b : α) : |a| ≤ |b| + |b + a| := +by simpa using abs_add (-b) (b + a) + +theorem abs_sub (a b : α) : + |a - b| ≤ |a| + |b| := +by { rw [sub_eq_add_neg, ←abs_neg b], exact abs_add a _ } + +lemma abs_sub_le_iff : |a - b| ≤ c ↔ a - b ≤ c ∧ b - a ≤ c := +by rw [abs_le, neg_le_sub_iff_le_add, sub_le_iff_le_add', and_comm, sub_le_iff_le_add'] + +lemma abs_sub_lt_iff : |a - b| < c ↔ a - b < c ∧ b - a < c := +by rw [abs_lt, neg_lt_sub_iff_lt_add', sub_lt_iff_lt_add', and_comm, sub_lt_iff_lt_add'] + +lemma sub_le_of_abs_sub_le_left (h : |a - b| ≤ c) : b - c ≤ a := +sub_le_comm.1 $ (abs_sub_le_iff.1 h).2 + +lemma sub_le_of_abs_sub_le_right (h : |a - b| ≤ c) : a - c ≤ b := +sub_le_of_abs_sub_le_left (abs_sub_comm a b ▸ h) + +lemma sub_lt_of_abs_sub_lt_left (h : |a - b| < c) : b - c < a := +sub_lt_comm.1 $ (abs_sub_lt_iff.1 h).2 + +lemma sub_lt_of_abs_sub_lt_right (h : |a - b| < c) : a - c < b := +sub_lt_of_abs_sub_lt_left (abs_sub_comm a b ▸ h) + +lemma abs_sub_abs_le_abs_sub (a b : α) : |a| - |b| ≤ |a - b| := +sub_le_iff_le_add.2 $ +calc |a| = |a - b + b| : by rw [sub_add_cancel] + ... ≤ |a - b| + |b| : abs_add _ _ + +lemma abs_abs_sub_abs_le_abs_sub (a b : α) : | |a| - |b| | ≤ |a - b| := +abs_sub_le_iff.2 ⟨abs_sub_abs_le_abs_sub _ _, by rw abs_sub_comm; apply abs_sub_abs_le_abs_sub⟩ + +lemma abs_eq (hb : 0 ≤ b) : |a| = b ↔ a = b ∨ a = -b := +begin + refine ⟨eq_or_eq_neg_of_abs_eq, _⟩, + rintro (rfl|rfl); simp only [abs_neg, abs_of_nonneg hb] +end + +lemma abs_le_max_abs_abs (hab : a ≤ b) (hbc : b ≤ c) : |b| ≤ max (|a|) (|c|) := +abs_le'.2 + ⟨by simp [hbc.trans (le_abs_self c)], + by simp [(neg_le_neg_iff.mpr hab).trans (neg_le_abs_self a)]⟩ + +lemma min_abs_abs_le_abs_max : min (|a|) (|b|) ≤ |max a b| := +(le_total a b).elim + (λ h, (min_le_right _ _).trans_eq $ congr_arg _ (max_eq_right h).symm) + (λ h, (min_le_left _ _).trans_eq $ congr_arg _ (max_eq_left h).symm) + +lemma min_abs_abs_le_abs_min : min (|a|) (|b|) ≤ |min a b| := +(le_total a b).elim + (λ h, (min_le_left _ _).trans_eq $ congr_arg _ (min_eq_left h).symm) + (λ h, (min_le_right _ _).trans_eq $ congr_arg _ (min_eq_right h).symm) + +lemma abs_max_le_max_abs_abs : |max a b| ≤ max (|a|) (|b|) := +(le_total a b).elim + (λ h, (congr_arg _ $ max_eq_right h).trans_le $ le_max_right _ _) + (λ h, (congr_arg _ $ max_eq_left h).trans_le $ le_max_left _ _) + +lemma abs_min_le_max_abs_abs : |min a b| ≤ max (|a|) (|b|) := +(le_total a b).elim + (λ h, (congr_arg _ $ min_eq_left h).trans_le $ le_max_left _ _) + (λ h, (congr_arg _ $ min_eq_right h).trans_le $ le_max_right _ _) + +lemma eq_of_abs_sub_eq_zero {a b : α} (h : |a - b| = 0) : a = b := +sub_eq_zero.1 $ abs_eq_zero.1 h + +lemma abs_sub_le (a b c : α) : |a - c| ≤ |a - b| + |b - c| := +calc + |a - c| = |a - b + (b - c)| : by rw [sub_add_sub_cancel] + ... ≤ |a - b| + |b - c| : abs_add _ _ + +lemma abs_add_three (a b c : α) : |a + b + c| ≤ |a| + |b| + |c| := +(abs_add _ _).trans (add_le_add_right (abs_add _ _) _) + +lemma dist_bdd_within_interval {a b lb ub : α} (hal : lb ≤ a) (hau : a ≤ ub) + (hbl : lb ≤ b) (hbu : b ≤ ub) : |a - b| ≤ ub - lb := +abs_sub_le_iff.2 ⟨sub_le_sub hau hbl, sub_le_sub hbu hal⟩ + +lemma eq_of_abs_sub_nonpos (h : |a - b| ≤ 0) : a = b := +eq_of_abs_sub_eq_zero (le_antisymm h (abs_nonneg (a - b))) + +end linear_ordered_add_comm_group diff --git a/src/algebra/order/group/bounds.lean b/src/algebra/order/group/bounds.lean new file mode 100644 index 0000000000000..13573ec0b6178 --- /dev/null +++ b/src/algebra/order/group/bounds.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2017 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Yury Kudryashov +-/ +import order.bounds.basic +import algebra.order.group.defs + +/-! +# Least upper bound and the greatest lower bound in linear ordered additive commutative groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +section linear_ordered_add_comm_group + +variables [linear_ordered_add_comm_group α] {s : set α} {a ε : α} + +lemma is_glb.exists_between_self_add (h : is_glb s a) (hε : 0 < ε) : + ∃ b ∈ s, a ≤ b ∧ b < a + ε := +h.exists_between $ lt_add_of_pos_right _ hε + +lemma is_glb.exists_between_self_add' (h : is_glb s a) (h₂ : a ∉ s) (hε : 0 < ε) : + ∃ b ∈ s, a < b ∧ b < a + ε := +h.exists_between' h₂ $ lt_add_of_pos_right _ hε + +lemma is_lub.exists_between_sub_self (h : is_lub s a) (hε : 0 < ε) : ∃ b ∈ s, a - ε < b ∧ b ≤ a := +h.exists_between $ sub_lt_self _ hε + +lemma is_lub.exists_between_sub_self' (h : is_lub s a) (h₂ : a ∉ s) (hε : 0 < ε) : + ∃ b ∈ s, a - ε < b ∧ b < a := +h.exists_between' h₂ $ sub_lt_self _ hε + +end linear_ordered_add_comm_group diff --git a/src/algebra/order/group/defs.lean b/src/algebra/order/group/defs.lean new file mode 100644 index 0000000000000..cd13a15851640 --- /dev/null +++ b/src/algebra/order/group/defs.lean @@ -0,0 +1,959 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import order.hom.basic +import algebra.order.sub.defs +import algebra.order.monoid.cancel.defs + +/-! +# Ordered groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file develops the basics of ordered groups. + +## Implementation details + +Unfortunately, the number of `'` appended to lemmas in this file +may differ between the multiplicative and the additive version of a lemma. +The reason is that we did not want to change existing names in the library. +-/ + +set_option old_structure_cmd true +open function + +universe u +variable {α : Type u} + +/-- An ordered additive commutative group is an additive commutative group +with a partial order in which addition is strictly monotone. -/ +@[protect_proj, ancestor add_comm_group partial_order] +class ordered_add_comm_group (α : Type u) extends add_comm_group α, partial_order α := +(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) + +/-- An ordered commutative group is an commutative group +with a partial order in which multiplication is strictly monotone. -/ +@[protect_proj, ancestor comm_group partial_order] +class ordered_comm_group (α : Type u) extends comm_group α, partial_order α := +(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b) +attribute [to_additive] ordered_comm_group + +@[to_additive] +instance ordered_comm_group.to_covariant_class_left_le (α : Type u) [ordered_comm_group α] : + covariant_class α α (*) (≤) := +{ elim := λ a b c bc, ordered_comm_group.mul_le_mul_left b c bc a } + +@[priority 100, to_additive] -- See note [lower instance priority] +instance ordered_comm_group.to_ordered_cancel_comm_monoid [ordered_comm_group α] : + ordered_cancel_comm_monoid α := +{ le_of_mul_le_mul_left := λ a b c, le_of_mul_le_mul_left', + ..‹ordered_comm_group α› } + +example (α : Type u) [ordered_add_comm_group α] : covariant_class α α (swap (+)) (<) := +add_right_cancel_semigroup.covariant_swap_add_lt_of_covariant_swap_add_le α + +-- Backporting note: this instance is not used, +-- and causes timeouts when interacting with etaExperiment. +/-- A choice-free shortcut instance. -/ +@[to_additive "A choice-free shortcut instance."] +theorem ordered_comm_group.to_contravariant_class_left_le (α : Type u) [ordered_comm_group α] : + contravariant_class α α (*) (≤) := +{ elim := λ a b c bc, by simpa using mul_le_mul_left' bc a⁻¹, } + +-- Backporting note: this instance is not used, +-- and causes timeouts when interacting with etaExperiment. +/-- A choice-free shortcut instance. -/ +@[to_additive "A choice-free shortcut instance."] +theorem ordered_comm_group.to_contravariant_class_right_le (α : Type u) [ordered_comm_group α] : + contravariant_class α α (swap (*)) (≤) := +{ elim := λ a b c bc, by simpa using mul_le_mul_right' bc a⁻¹, } + +section group +variables [group α] + +section typeclasses_left_le +variables [has_le α] [covariant_class α α (*) (≤)] {a b c d : α} + +/-- Uses `left` co(ntra)variant. -/ +@[simp, to_additive left.neg_nonpos_iff "Uses `left` co(ntra)variant."] +lemma left.inv_le_one_iff : + a⁻¹ ≤ 1 ↔ 1 ≤ a := +by { rw [← mul_le_mul_iff_left a], simp } + +/-- Uses `left` co(ntra)variant. -/ +@[simp, to_additive left.nonneg_neg_iff "Uses `left` co(ntra)variant."] +lemma left.one_le_inv_iff : + 1 ≤ a⁻¹ ↔ a ≤ 1 := +by { rw [← mul_le_mul_iff_left a], simp } + +@[simp, to_additive] +lemma le_inv_mul_iff_mul_le : b ≤ a⁻¹ * c ↔ a * b ≤ c := +by { rw ← mul_le_mul_iff_left a, simp } + +@[simp, to_additive] +lemma inv_mul_le_iff_le_mul : b⁻¹ * a ≤ c ↔ a ≤ b * c := +by rw [← mul_le_mul_iff_left b, mul_inv_cancel_left] + +@[to_additive neg_le_iff_add_nonneg'] +lemma inv_le_iff_one_le_mul' : a⁻¹ ≤ b ↔ 1 ≤ a * b := +(mul_le_mul_iff_left a).symm.trans $ by rw mul_inv_self + +@[to_additive] +lemma le_inv_iff_mul_le_one_left : a ≤ b⁻¹ ↔ b * a ≤ 1 := +(mul_le_mul_iff_left b).symm.trans $ by rw mul_inv_self + +@[to_additive] +lemma le_inv_mul_iff_le : 1 ≤ b⁻¹ * a ↔ b ≤ a := +by rw [← mul_le_mul_iff_left b, mul_one, mul_inv_cancel_left] + +@[to_additive] +lemma inv_mul_le_one_iff : a⁻¹ * b ≤ 1 ↔ b ≤ a := +trans (inv_mul_le_iff_le_mul) $ by rw mul_one + +end typeclasses_left_le + +section typeclasses_left_lt +variables [has_lt α] [covariant_class α α (*) (<)] {a b c : α} + +/-- Uses `left` co(ntra)variant. -/ +@[simp, to_additive left.neg_pos_iff "Uses `left` co(ntra)variant."] +lemma left.one_lt_inv_iff : + 1 < a⁻¹ ↔ a < 1 := +by rw [← mul_lt_mul_iff_left a, mul_inv_self, mul_one] + +/-- Uses `left` co(ntra)variant. -/ +@[simp, to_additive left.neg_neg_iff "Uses `left` co(ntra)variant."] +lemma left.inv_lt_one_iff : + a⁻¹ < 1 ↔ 1 < a := +by rw [← mul_lt_mul_iff_left a, mul_inv_self, mul_one] + +@[simp, to_additive] +lemma lt_inv_mul_iff_mul_lt : b < a⁻¹ * c ↔ a * b < c := +by { rw [← mul_lt_mul_iff_left a], simp } + +@[simp, to_additive] +lemma inv_mul_lt_iff_lt_mul : b⁻¹ * a < c ↔ a < b * c := +by rw [← mul_lt_mul_iff_left b, mul_inv_cancel_left] + +@[to_additive] +lemma inv_lt_iff_one_lt_mul' : a⁻¹ < b ↔ 1 < a * b := +(mul_lt_mul_iff_left a).symm.trans $ by rw mul_inv_self + +@[to_additive] +lemma lt_inv_iff_mul_lt_one' : a < b⁻¹ ↔ b * a < 1 := +(mul_lt_mul_iff_left b).symm.trans $ by rw mul_inv_self + +@[to_additive] +lemma lt_inv_mul_iff_lt : 1 < b⁻¹ * a ↔ b < a := +by rw [← mul_lt_mul_iff_left b, mul_one, mul_inv_cancel_left] + +@[to_additive] +lemma inv_mul_lt_one_iff : a⁻¹ * b < 1 ↔ b < a := +trans (inv_mul_lt_iff_lt_mul) $ by rw mul_one + +end typeclasses_left_lt + +section typeclasses_right_le +variables [has_le α] [covariant_class α α (swap (*)) (≤)] {a b c : α} + +/-- Uses `right` co(ntra)variant. -/ +@[simp, to_additive right.neg_nonpos_iff "Uses `right` co(ntra)variant."] +lemma right.inv_le_one_iff : + a⁻¹ ≤ 1 ↔ 1 ≤ a := +by { rw [← mul_le_mul_iff_right a], simp } + +/-- Uses `right` co(ntra)variant. -/ +@[simp, to_additive right.nonneg_neg_iff "Uses `right` co(ntra)variant."] +lemma right.one_le_inv_iff : + 1 ≤ a⁻¹ ↔ a ≤ 1 := +by { rw [← mul_le_mul_iff_right a], simp } + +@[to_additive neg_le_iff_add_nonneg] +lemma inv_le_iff_one_le_mul : a⁻¹ ≤ b ↔ 1 ≤ b * a := +(mul_le_mul_iff_right a).symm.trans $ by rw inv_mul_self + +@[to_additive] +lemma le_inv_iff_mul_le_one_right : a ≤ b⁻¹ ↔ a * b ≤ 1 := +(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_self + +@[simp, to_additive] +lemma mul_inv_le_iff_le_mul : a * b⁻¹ ≤ c ↔ a ≤ c * b := +(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_cancel_right + +@[simp, to_additive] +lemma le_mul_inv_iff_mul_le : c ≤ a * b⁻¹ ↔ c * b ≤ a := +(mul_le_mul_iff_right b).symm.trans $ by rw inv_mul_cancel_right + +@[simp, to_additive] +lemma mul_inv_le_one_iff_le : a * b⁻¹ ≤ 1 ↔ a ≤ b := +mul_inv_le_iff_le_mul.trans $ by rw one_mul + +@[to_additive] +lemma le_mul_inv_iff_le : 1 ≤ a * b⁻¹ ↔ b ≤ a := +by rw [← mul_le_mul_iff_right b, one_mul, inv_mul_cancel_right] + +@[to_additive] +lemma mul_inv_le_one_iff : b * a⁻¹ ≤ 1 ↔ b ≤ a := +trans (mul_inv_le_iff_le_mul) $ by rw one_mul + +end typeclasses_right_le + +section typeclasses_right_lt +variables [has_lt α] [covariant_class α α (swap (*)) (<)] {a b c : α} + +/-- Uses `right` co(ntra)variant. -/ +@[simp, to_additive right.neg_neg_iff "Uses `right` co(ntra)variant."] +lemma right.inv_lt_one_iff : + a⁻¹ < 1 ↔ 1 < a := +by rw [← mul_lt_mul_iff_right a, inv_mul_self, one_mul] + +/-- Uses `right` co(ntra)variant. -/ +@[simp, to_additive right.neg_pos_iff "Uses `right` co(ntra)variant."] +lemma right.one_lt_inv_iff : + 1 < a⁻¹ ↔ a < 1 := +by rw [← mul_lt_mul_iff_right a, inv_mul_self, one_mul] + +@[to_additive] +lemma inv_lt_iff_one_lt_mul : a⁻¹ < b ↔ 1 < b * a := +(mul_lt_mul_iff_right a).symm.trans $ by rw inv_mul_self + +@[to_additive] +lemma lt_inv_iff_mul_lt_one : a < b⁻¹ ↔ a * b < 1 := +(mul_lt_mul_iff_right b).symm.trans $ by rw inv_mul_self + +@[simp, to_additive] +lemma mul_inv_lt_iff_lt_mul : a * b⁻¹ < c ↔ a < c * b := +by rw [← mul_lt_mul_iff_right b, inv_mul_cancel_right] + +@[simp, to_additive] +lemma lt_mul_inv_iff_mul_lt : c < a * b⁻¹ ↔ c * b < a := +(mul_lt_mul_iff_right b).symm.trans $ by rw inv_mul_cancel_right + +@[simp, to_additive] +lemma inv_mul_lt_one_iff_lt : a * b⁻¹ < 1 ↔ a < b := +by rw [← mul_lt_mul_iff_right b, inv_mul_cancel_right, one_mul] + +@[to_additive] +lemma lt_mul_inv_iff_lt : 1 < a * b⁻¹ ↔ b < a := +by rw [← mul_lt_mul_iff_right b, one_mul, inv_mul_cancel_right] + +@[to_additive] +lemma mul_inv_lt_one_iff : b * a⁻¹ < 1 ↔ b < a := +trans (mul_inv_lt_iff_lt_mul) $ by rw one_mul + +end typeclasses_right_lt + +section typeclasses_left_right_le +variables [has_le α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + {a b c d : α} + +@[simp, to_additive] +lemma inv_le_inv_iff : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := +by { rw [← mul_le_mul_iff_left a, ← mul_le_mul_iff_right b], simp } + +alias neg_le_neg_iff ↔ le_of_neg_le_neg _ + +@[to_additive] +lemma mul_inv_le_inv_mul_iff : a * b⁻¹ ≤ d⁻¹ * c ↔ d * a ≤ c * b := +by rw [← mul_le_mul_iff_left d, ← mul_le_mul_iff_right b, mul_inv_cancel_left, mul_assoc, + inv_mul_cancel_right] + +@[simp, to_additive] lemma div_le_self_iff (a : α) {b : α} : a / b ≤ a ↔ 1 ≤ b := +by simp [div_eq_mul_inv] + +@[simp, to_additive] lemma le_div_self_iff (a : α) {b : α} : a ≤ a / b ↔ b ≤ 1 := +by simp [div_eq_mul_inv] + +alias sub_le_self_iff ↔ _ sub_le_self + +end typeclasses_left_right_le + +section typeclasses_left_right_lt +variables [has_lt α] [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] + {a b c d : α} + +@[simp, to_additive] +lemma inv_lt_inv_iff : a⁻¹ < b⁻¹ ↔ b < a := +by { rw [← mul_lt_mul_iff_left a, ← mul_lt_mul_iff_right b], simp } + +@[to_additive neg_lt] +lemma inv_lt' : a⁻¹ < b ↔ b⁻¹ < a := +by rw [← inv_lt_inv_iff, inv_inv] + +@[to_additive lt_neg] +lemma lt_inv' : a < b⁻¹ ↔ b < a⁻¹ := +by rw [← inv_lt_inv_iff, inv_inv] + +alias lt_inv' ↔ lt_inv_of_lt_inv _ +attribute [to_additive] lt_inv_of_lt_inv + +alias inv_lt' ↔ inv_lt_of_inv_lt' _ +attribute [to_additive neg_lt_of_neg_lt] inv_lt_of_inv_lt' + +@[to_additive] +lemma mul_inv_lt_inv_mul_iff : a * b⁻¹ < d⁻¹ * c ↔ d * a < c * b := +by rw [← mul_lt_mul_iff_left d, ← mul_lt_mul_iff_right b, mul_inv_cancel_left, mul_assoc, + inv_mul_cancel_right] + +@[simp, to_additive] lemma div_lt_self_iff (a : α) {b : α} : a / b < a ↔ 1 < b := +by simp [div_eq_mul_inv] + +alias sub_lt_self_iff ↔ _ sub_lt_self + +end typeclasses_left_right_lt + +section pre_order +variable [preorder α] + +section left_le +variables [covariant_class α α (*) (≤)] {a : α} + +@[to_additive] +lemma left.inv_le_self (h : 1 ≤ a) : a⁻¹ ≤ a := +le_trans (left.inv_le_one_iff.mpr h) h + +alias left.neg_le_self ← neg_le_self + +@[to_additive] +lemma left.self_le_inv (h : a ≤ 1) : a ≤ a⁻¹ := +le_trans h (left.one_le_inv_iff.mpr h) + +end left_le + +section left_lt +variables [covariant_class α α (*) (<)] {a : α} + +@[to_additive] +lemma left.inv_lt_self (h : 1 < a) : a⁻¹ < a := +(left.inv_lt_one_iff.mpr h).trans h + +alias left.neg_lt_self ← neg_lt_self + +@[to_additive] +lemma left.self_lt_inv (h : a < 1) : a < a⁻¹ := +lt_trans h (left.one_lt_inv_iff.mpr h) + +end left_lt + +section right_le +variables [covariant_class α α (swap (*)) (≤)] {a : α} + +@[to_additive] +lemma right.inv_le_self (h : 1 ≤ a) : a⁻¹ ≤ a := +le_trans (right.inv_le_one_iff.mpr h) h + +@[to_additive] +lemma right.self_le_inv (h : a ≤ 1) : a ≤ a⁻¹ := +le_trans h (right.one_le_inv_iff.mpr h) + +end right_le + +section right_lt +variables [covariant_class α α (swap (*)) (<)] {a : α} + +@[to_additive] +lemma right.inv_lt_self (h : 1 < a) : a⁻¹ < a := +(right.inv_lt_one_iff.mpr h).trans h + +@[to_additive] +lemma right.self_lt_inv (h : a < 1) : a < a⁻¹ := +lt_trans h (right.one_lt_inv_iff.mpr h) + +end right_lt + +end pre_order + +end group + +section comm_group +variables [comm_group α] + +section has_le +variables [has_le α] [covariant_class α α (*) (≤)] {a b c d : α} + +@[to_additive] +lemma inv_mul_le_iff_le_mul' : c⁻¹ * a ≤ b ↔ a ≤ b * c := +by rw [inv_mul_le_iff_le_mul, mul_comm] + +@[simp, to_additive] +lemma mul_inv_le_iff_le_mul' : a * b⁻¹ ≤ c ↔ a ≤ b * c := +by rw [← inv_mul_le_iff_le_mul, mul_comm] + +@[to_additive add_neg_le_add_neg_iff] +lemma mul_inv_le_mul_inv_iff' : a * b⁻¹ ≤ c * d⁻¹ ↔ a * d ≤ c * b := +by rw [mul_comm c, mul_inv_le_inv_mul_iff, mul_comm] + +end has_le + +section has_lt +variables [has_lt α] [covariant_class α α (*) (<)] {a b c d : α} + +@[to_additive] +lemma inv_mul_lt_iff_lt_mul' : c⁻¹ * a < b ↔ a < b * c := +by rw [inv_mul_lt_iff_lt_mul, mul_comm] + +@[simp, to_additive] +lemma mul_inv_lt_iff_le_mul' : a * b⁻¹ < c ↔ a < b * c := +by rw [← inv_mul_lt_iff_lt_mul, mul_comm] + +@[to_additive add_neg_lt_add_neg_iff] +lemma mul_inv_lt_mul_inv_iff' : a * b⁻¹ < c * d⁻¹ ↔ a * d < c * b := +by rw [mul_comm c, mul_inv_lt_inv_mul_iff, mul_comm] + +end has_lt + +end comm_group + +alias left.inv_le_one_iff ↔ one_le_of_inv_le_one _ +attribute [to_additive] one_le_of_inv_le_one + +alias left.one_le_inv_iff ↔ le_one_of_one_le_inv _ +attribute [to_additive nonpos_of_neg_nonneg] le_one_of_one_le_inv + +alias inv_lt_inv_iff ↔ lt_of_inv_lt_inv _ +attribute [to_additive] lt_of_inv_lt_inv + +alias left.inv_lt_one_iff ↔ one_lt_of_inv_lt_one _ +attribute [to_additive] one_lt_of_inv_lt_one + +alias left.inv_lt_one_iff ← inv_lt_one_iff_one_lt +attribute [to_additive] inv_lt_one_iff_one_lt + +alias left.inv_lt_one_iff ← inv_lt_one' +attribute [to_additive neg_lt_zero] inv_lt_one' + +alias left.one_lt_inv_iff ↔ inv_of_one_lt_inv _ +attribute [to_additive neg_of_neg_pos] inv_of_one_lt_inv + +alias left.one_lt_inv_iff ↔ _ one_lt_inv_of_inv +attribute [to_additive neg_pos_of_neg] one_lt_inv_of_inv + +alias le_inv_mul_iff_mul_le ↔ mul_le_of_le_inv_mul _ +attribute [to_additive] mul_le_of_le_inv_mul + +alias le_inv_mul_iff_mul_le ↔ _ le_inv_mul_of_mul_le +attribute [to_additive] le_inv_mul_of_mul_le + +alias inv_mul_le_iff_le_mul ↔ _ inv_mul_le_of_le_mul +attribute [to_additive] inv_mul_le_iff_le_mul + +alias lt_inv_mul_iff_mul_lt ↔ mul_lt_of_lt_inv_mul _ +attribute [to_additive] mul_lt_of_lt_inv_mul + +alias lt_inv_mul_iff_mul_lt ↔ _ lt_inv_mul_of_mul_lt +attribute [to_additive] lt_inv_mul_of_mul_lt + +alias inv_mul_lt_iff_lt_mul ↔ lt_mul_of_inv_mul_lt inv_mul_lt_of_lt_mul +attribute [to_additive] lt_mul_of_inv_mul_lt +attribute [to_additive] inv_mul_lt_of_lt_mul + +alias lt_mul_of_inv_mul_lt ← lt_mul_of_inv_mul_lt_left +attribute [to_additive] lt_mul_of_inv_mul_lt_left + +alias left.inv_le_one_iff ← inv_le_one' +attribute [to_additive neg_nonpos] inv_le_one' + +alias left.one_le_inv_iff ← one_le_inv' +attribute [to_additive neg_nonneg] one_le_inv' + +alias left.one_lt_inv_iff ← one_lt_inv' +attribute [to_additive neg_pos] one_lt_inv' + +alias mul_lt_mul_left' ← ordered_comm_group.mul_lt_mul_left' +attribute [to_additive ordered_add_comm_group.add_lt_add_left] ordered_comm_group.mul_lt_mul_left' + +alias le_of_mul_le_mul_left' ← ordered_comm_group.le_of_mul_le_mul_left +attribute [to_additive ordered_add_comm_group.le_of_add_le_add_left] + ordered_comm_group.le_of_mul_le_mul_left + +alias lt_of_mul_lt_mul_left' ← ordered_comm_group.lt_of_mul_lt_mul_left +attribute [to_additive ordered_add_comm_group.lt_of_add_lt_add_left] + ordered_comm_group.lt_of_mul_lt_mul_left + +/- Most of the lemmas that are primed in this section appear in ordered_field. -/ +/- I (DT) did not try to minimise the assumptions. -/ +section group +variables [group α] [has_le α] + +section right +variables [covariant_class α α (swap (*)) (≤)] {a b c d : α} + +@[simp, to_additive] +lemma div_le_div_iff_right (c : α) : a / c ≤ b / c ↔ a ≤ b := +by simpa only [div_eq_mul_inv] using mul_le_mul_iff_right _ + +@[to_additive sub_le_sub_right] +lemma div_le_div_right' (h : a ≤ b) (c : α) : a / c ≤ b / c := +(div_le_div_iff_right c).2 h + +@[simp, to_additive sub_nonneg] +lemma one_le_div' : 1 ≤ a / b ↔ b ≤ a := +by rw [← mul_le_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] + +alias sub_nonneg ↔ le_of_sub_nonneg sub_nonneg_of_le + +@[simp, to_additive sub_nonpos] +lemma div_le_one' : a / b ≤ 1 ↔ a ≤ b := +by rw [← mul_le_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] + +alias sub_nonpos ↔ le_of_sub_nonpos sub_nonpos_of_le + +@[to_additive] +lemma le_div_iff_mul_le : a ≤ c / b ↔ a * b ≤ c := +by rw [← mul_le_mul_iff_right b, div_eq_mul_inv, inv_mul_cancel_right] + +alias le_sub_iff_add_le ↔ add_le_of_le_sub_right le_sub_right_of_add_le + +@[to_additive] +lemma div_le_iff_le_mul : a / c ≤ b ↔ a ≤ b * c := +by rw [← mul_le_mul_iff_right c, div_eq_mul_inv, inv_mul_cancel_right] + +-- TODO: Should we get rid of `sub_le_iff_le_add` in favor of +-- (a renamed version of) `tsub_le_iff_right`? +@[priority 100] -- see Note [lower instance priority] +instance add_group.to_has_ordered_sub {α : Type*} [add_group α] [has_le α] + [covariant_class α α (swap (+)) (≤)] : has_ordered_sub α := +⟨λ a b c, sub_le_iff_le_add⟩ + +end right + +section left +variables [covariant_class α α (*) (≤)] + +variables [covariant_class α α (swap (*)) (≤)] {a b c : α} + +@[simp, to_additive] +lemma div_le_div_iff_left (a : α) : a / b ≤ a / c ↔ c ≤ b := +by rw [div_eq_mul_inv, div_eq_mul_inv, ← mul_le_mul_iff_left a⁻¹, inv_mul_cancel_left, + inv_mul_cancel_left, inv_le_inv_iff] + +@[to_additive sub_le_sub_left] +lemma div_le_div_left' (h : a ≤ b) (c : α) : c / b ≤ c / a := +(div_le_div_iff_left c).2 h + +end left + +end group + +section comm_group +variables [comm_group α] + +section has_le +variables [has_le α] [covariant_class α α (*) (≤)] {a b c d : α} + +@[to_additive sub_le_sub_iff] +lemma div_le_div_iff' : a / b ≤ c / d ↔ a * d ≤ c * b := +by simpa only [div_eq_mul_inv] using mul_inv_le_mul_inv_iff' + +@[to_additive] +lemma le_div_iff_mul_le' : b ≤ c / a ↔ a * b ≤ c := +by rw [le_div_iff_mul_le, mul_comm] + +alias le_sub_iff_add_le' ↔ add_le_of_le_sub_left le_sub_left_of_add_le + +@[to_additive] +lemma div_le_iff_le_mul' : a / b ≤ c ↔ a ≤ b * c := +by rw [div_le_iff_le_mul, mul_comm] + +alias sub_le_iff_le_add' ↔ le_add_of_sub_left_le sub_left_le_of_le_add + +@[simp, to_additive] +lemma inv_le_div_iff_le_mul : b⁻¹ ≤ a / c ↔ c ≤ a * b := +le_div_iff_mul_le.trans inv_mul_le_iff_le_mul' + +@[to_additive] +lemma inv_le_div_iff_le_mul' : a⁻¹ ≤ b / c ↔ c ≤ a * b := +by rw [inv_le_div_iff_le_mul, mul_comm] + +@[to_additive] +lemma div_le_comm : a / b ≤ c ↔ a / c ≤ b := div_le_iff_le_mul'.trans div_le_iff_le_mul.symm + +@[to_additive] +lemma le_div_comm : a ≤ b / c ↔ c ≤ b / a := le_div_iff_mul_le'.trans le_div_iff_mul_le.symm + +end has_le + +section preorder +variables [preorder α] [covariant_class α α (*) (≤)] {a b c d : α} + +@[to_additive sub_le_sub] +lemma div_le_div'' (hab : a ≤ b) (hcd : c ≤ d) : + a / d ≤ b / c := +begin + rw [div_eq_mul_inv, div_eq_mul_inv, mul_comm b, mul_inv_le_inv_mul_iff, mul_comm], + exact mul_le_mul' hab hcd +end + +end preorder + +end comm_group + +/- Most of the lemmas that are primed in this section appear in ordered_field. -/ +/- I (DT) did not try to minimise the assumptions. -/ +section group +variables [group α] [has_lt α] + +section right +variables [covariant_class α α (swap (*)) (<)] {a b c d : α} + +@[simp, to_additive] +lemma div_lt_div_iff_right (c : α) : a / c < b / c ↔ a < b := +by simpa only [div_eq_mul_inv] using mul_lt_mul_iff_right _ + +@[to_additive sub_lt_sub_right] +lemma div_lt_div_right' (h : a < b) (c : α) : a / c < b / c := +(div_lt_div_iff_right c).2 h + +@[simp, to_additive sub_pos] +lemma one_lt_div' : 1 < a / b ↔ b < a := +by rw [← mul_lt_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] + +alias sub_pos ↔ lt_of_sub_pos sub_pos_of_lt + +@[simp, to_additive sub_neg] +lemma div_lt_one' : a / b < 1 ↔ a < b := +by rw [← mul_lt_mul_iff_right b, one_mul, div_eq_mul_inv, inv_mul_cancel_right] + +alias sub_neg ↔ lt_of_sub_neg sub_neg_of_lt + +alias sub_neg ← sub_lt_zero + +@[to_additive] +lemma lt_div_iff_mul_lt : a < c / b ↔ a * b < c := +by rw [← mul_lt_mul_iff_right b, div_eq_mul_inv, inv_mul_cancel_right] + +alias lt_sub_iff_add_lt ↔ add_lt_of_lt_sub_right lt_sub_right_of_add_lt + +@[to_additive] +lemma div_lt_iff_lt_mul : a / c < b ↔ a < b * c := +by rw [← mul_lt_mul_iff_right c, div_eq_mul_inv, inv_mul_cancel_right] + +alias sub_lt_iff_lt_add ↔ lt_add_of_sub_right_lt sub_right_lt_of_lt_add + +end right + +section left +variables [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] {a b c : α} + +@[simp, to_additive] +lemma div_lt_div_iff_left (a : α) : a / b < a / c ↔ c < b := +by rw [div_eq_mul_inv, div_eq_mul_inv, ← mul_lt_mul_iff_left a⁻¹, inv_mul_cancel_left, + inv_mul_cancel_left, inv_lt_inv_iff] + +@[simp, to_additive] +lemma inv_lt_div_iff_lt_mul : a⁻¹ < b / c ↔ c < a * b := +by rw [div_eq_mul_inv, lt_mul_inv_iff_mul_lt, inv_mul_lt_iff_lt_mul] + +@[to_additive sub_lt_sub_left] +lemma div_lt_div_left' (h : a < b) (c : α) : c / b < c / a := +(div_lt_div_iff_left c).2 h + +end left + +end group + +section comm_group +variables [comm_group α] + +section has_lt +variables [has_lt α] [covariant_class α α (*) (<)] {a b c d : α} + +@[to_additive sub_lt_sub_iff] +lemma div_lt_div_iff' : a / b < c / d ↔ a * d < c * b := +by simpa only [div_eq_mul_inv] using mul_inv_lt_mul_inv_iff' + +@[to_additive] +lemma lt_div_iff_mul_lt' : b < c / a ↔ a * b < c := +by rw [lt_div_iff_mul_lt, mul_comm] + +alias lt_sub_iff_add_lt' ↔ add_lt_of_lt_sub_left lt_sub_left_of_add_lt + +@[to_additive] +lemma div_lt_iff_lt_mul' : a / b < c ↔ a < b * c := +by rw [div_lt_iff_lt_mul, mul_comm] + +alias sub_lt_iff_lt_add' ↔ lt_add_of_sub_left_lt sub_left_lt_of_lt_add + +@[to_additive] +lemma inv_lt_div_iff_lt_mul' : b⁻¹ < a / c ↔ c < a * b := +lt_div_iff_mul_lt.trans inv_mul_lt_iff_lt_mul' + +@[to_additive] +lemma div_lt_comm : a / b < c ↔ a / c < b := div_lt_iff_lt_mul'.trans div_lt_iff_lt_mul.symm + +@[to_additive] +lemma lt_div_comm : a < b / c ↔ c < b / a := lt_div_iff_mul_lt'.trans lt_div_iff_mul_lt.symm + +end has_lt + +section preorder +variables [preorder α] [covariant_class α α (*) (<)] {a b c d : α} + +@[to_additive sub_lt_sub] +lemma div_lt_div'' (hab : a < b) (hcd : c < d) : + a / d < b / c := +begin + rw [div_eq_mul_inv, div_eq_mul_inv, mul_comm b, mul_inv_lt_inv_mul_iff, mul_comm], + exact mul_lt_mul_of_lt_of_lt hab hcd +end + +end preorder + +end comm_group + +section linear_order +variables [group α] [linear_order α] + +@[simp, to_additive cmp_sub_zero] +lemma cmp_div_one' [covariant_class α α (swap (*)) (≤)] (a b : α) : cmp (a / b) 1 = cmp a b := +by rw [← cmp_mul_right' _ _ b, one_mul, div_mul_cancel'] + +variables [covariant_class α α (*) (≤)] + +section variable_names +variables {a b c : α} + +@[to_additive] +lemma le_of_forall_one_lt_lt_mul (h : ∀ ε : α, 1 < ε → a < b * ε) : a ≤ b := +le_of_not_lt (λ h₁, lt_irrefl a (by simpa using (h _ (lt_inv_mul_iff_lt.mpr h₁)))) + +@[to_additive] +lemma le_iff_forall_one_lt_lt_mul : a ≤ b ↔ ∀ ε, 1 < ε → a < b * ε := +⟨λ h ε, lt_mul_of_le_of_one_lt h, le_of_forall_one_lt_lt_mul⟩ + +/- I (DT) introduced this lemma to prove (the additive version `sub_le_sub_flip` of) +`div_le_div_flip` below. Now I wonder what is the point of either of these lemmas... -/ +@[to_additive] +lemma div_le_inv_mul_iff [covariant_class α α (swap (*)) (≤)] : + a / b ≤ a⁻¹ * b ↔ a ≤ b := +begin + rw [div_eq_mul_inv, mul_inv_le_inv_mul_iff], + exact ⟨λ h, not_lt.mp (λ k, not_lt.mpr h (mul_lt_mul_of_lt_of_lt k k)), λ h, mul_le_mul' h h⟩, +end + +/- What is the point of this lemma? See comment about `div_le_inv_mul_iff` above. -/ +@[simp, to_additive] +lemma div_le_div_flip {α : Type*} [comm_group α] [linear_order α] [covariant_class α α (*) (≤)] + {a b : α}: + a / b ≤ b / a ↔ a ≤ b := +begin + rw [div_eq_mul_inv b, mul_comm], + exact div_le_inv_mul_iff, +end + +end variable_names + +end linear_order + +/-! +### Linearly ordered commutative groups +-/ + +/-- A linearly ordered additive commutative group is an +additive commutative group with a linear order in which +addition is monotone. -/ +@[protect_proj, ancestor ordered_add_comm_group linear_order] +class linear_ordered_add_comm_group (α : Type u) extends ordered_add_comm_group α, linear_order α + +/-- A linearly ordered commutative monoid with an additively absorbing `⊤` element. + Instances should include number systems with an infinite element adjoined.` -/ +@[protect_proj, ancestor linear_ordered_add_comm_monoid_with_top sub_neg_monoid nontrivial] +class linear_ordered_add_comm_group_with_top (α : Type*) + extends linear_ordered_add_comm_monoid_with_top α, sub_neg_monoid α, nontrivial α := +(neg_top : - (⊤ : α) = ⊤) +(add_neg_cancel : ∀ a:α, a ≠ ⊤ → a + (- a) = 0) + +/-- A linearly ordered commutative group is a +commutative group with a linear order in which +multiplication is monotone. -/ +@[protect_proj, ancestor ordered_comm_group linear_order, to_additive] +class linear_ordered_comm_group (α : Type u) extends ordered_comm_group α, linear_order α + +section linear_ordered_comm_group +variables [linear_ordered_comm_group α] {a b c : α} + +@[to_additive linear_ordered_add_comm_group.add_lt_add_left] +lemma linear_ordered_comm_group.mul_lt_mul_left' + (a b : α) (h : a < b) (c : α) : c * a < c * b := +mul_lt_mul_left' h c + +@[to_additive eq_zero_of_neg_eq] +lemma eq_one_of_inv_eq' (h : a⁻¹ = a) : a = 1 := +match lt_trichotomy a 1 with +| or.inl h₁ := + have 1 < a, from h ▸ one_lt_inv_of_inv h₁, + absurd h₁ this.asymm +| or.inr (or.inl h₁) := h₁ +| or.inr (or.inr h₁) := + have a < 1, from h ▸ inv_lt_one'.mpr h₁, + absurd h₁ this.asymm +end + +@[to_additive exists_zero_lt] +lemma exists_one_lt' [nontrivial α] : ∃ (a:α), 1 < a := +begin + obtain ⟨y, hy⟩ := decidable.exists_ne (1 : α), + cases hy.lt_or_lt, + { exact ⟨y⁻¹, one_lt_inv'.mpr h⟩ }, + { exact ⟨y, h⟩ } +end + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance linear_ordered_comm_group.to_no_max_order [nontrivial α] : + no_max_order α := +⟨ begin + obtain ⟨y, hy⟩ : ∃ (a:α), 1 < a := exists_one_lt', + exact λ a, ⟨a * y, lt_mul_of_one_lt_right' a hy⟩ + end ⟩ + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance linear_ordered_comm_group.to_no_min_order [nontrivial α] : no_min_order α := +⟨ begin + obtain ⟨y, hy⟩ : ∃ (a:α), 1 < a := exists_one_lt', + exact λ a, ⟨a / y, (div_lt_self_iff a).mpr hy⟩ + end ⟩ + +@[priority 100, to_additive] -- See note [lower instance priority] +instance linear_ordered_comm_group.to_linear_ordered_cancel_comm_monoid : + linear_ordered_cancel_comm_monoid α := +{ ..‹linear_ordered_comm_group α›, ..ordered_comm_group.to_ordered_cancel_comm_monoid } + +end linear_ordered_comm_group + +namespace add_comm_group + +/-- A collection of elements in an `add_comm_group` designated as "non-negative". +This is useful for constructing an `ordered_add_commm_group` +by choosing a positive cone in an exisiting `add_comm_group`. -/ +@[nolint has_nonempty_instance] +structure positive_cone (α : Type*) [add_comm_group α] := +(nonneg : α → Prop) +(pos : α → Prop := λ a, nonneg a ∧ ¬ nonneg (-a)) +(pos_iff : ∀ a, pos a ↔ nonneg a ∧ ¬ nonneg (-a) . order_laws_tac) +(zero_nonneg : nonneg 0) +(add_nonneg : ∀ {a b}, nonneg a → nonneg b → nonneg (a + b)) +(nonneg_antisymm : ∀ {a}, nonneg a → nonneg (-a) → a = 0) + +/-- A positive cone in an `add_comm_group` induces a linear order if +for every `a`, either `a` or `-a` is non-negative. -/ +@[nolint has_nonempty_instance] +structure total_positive_cone (α : Type*) [add_comm_group α] extends positive_cone α := +(nonneg_decidable : decidable_pred nonneg) +(nonneg_total : ∀ a : α, nonneg a ∨ nonneg (-a)) + +/-- Forget that a `total_positive_cone` is total. -/ +add_decl_doc total_positive_cone.to_positive_cone + +end add_comm_group + +namespace ordered_add_comm_group + +open add_comm_group + +/-- Construct an `ordered_add_comm_group` by +designating a positive cone in an existing `add_comm_group`. -/ +def mk_of_positive_cone {α : Type*} [add_comm_group α] (C : positive_cone α) : + ordered_add_comm_group α := +{ le := λ a b, C.nonneg (b - a), + lt := λ a b, C.pos (b - a), + lt_iff_le_not_le := λ a b, by simp; rw [C.pos_iff]; simp, + le_refl := λ a, by simp [C.zero_nonneg], + le_trans := λ a b c nab nbc, by simp [-sub_eq_add_neg]; + rw ← sub_add_sub_cancel; exact C.add_nonneg nbc nab, + le_antisymm := λ a b nab nba, eq_of_sub_eq_zero $ + C.nonneg_antisymm nba (by rw neg_sub; exact nab), + add_le_add_left := λ a b nab c, by simpa [(≤), preorder.le] using nab, + ..‹add_comm_group α› } + +end ordered_add_comm_group + +namespace linear_ordered_add_comm_group + +open add_comm_group + +/-- Construct a `linear_ordered_add_comm_group` by +designating a positive cone in an existing `add_comm_group` +such that for every `a`, either `a` or `-a` is non-negative. -/ +def mk_of_positive_cone {α : Type*} [add_comm_group α] (C : total_positive_cone α) : + linear_ordered_add_comm_group α := +{ le_total := λ a b, by { convert C.nonneg_total (b - a), change C.nonneg _ = _, congr, simp, }, + decidable_le := λ a b, C.nonneg_decidable _, + ..ordered_add_comm_group.mk_of_positive_cone C.to_positive_cone } + +end linear_ordered_add_comm_group + +section norm_num_lemmas +/- The following lemmas are stated so that the `norm_num` tactic can use them with the +expected signatures. -/ +variables [ordered_comm_group α] {a b : α} + +@[to_additive neg_le_neg] +lemma inv_le_inv' : a ≤ b → b⁻¹ ≤ a⁻¹ := +inv_le_inv_iff.mpr + +@[to_additive neg_lt_neg] +lemma inv_lt_inv' : a < b → b⁻¹ < a⁻¹ := +inv_lt_inv_iff.mpr + +/- The additive version is also a `linarith` lemma. -/ +@[to_additive] +theorem inv_lt_one_of_one_lt : 1 < a → a⁻¹ < 1 := +inv_lt_one_iff_one_lt.mpr + +/- The additive version is also a `linarith` lemma. -/ +@[to_additive] +lemma inv_le_one_of_one_le : 1 ≤ a → a⁻¹ ≤ 1 := +inv_le_one'.mpr + +@[to_additive neg_nonneg_of_nonpos] +lemma one_le_inv_of_le_one : a ≤ 1 → 1 ≤ a⁻¹ := +one_le_inv'.mpr + +end norm_num_lemmas + +section + +variables {β : Type*} +[group α] [preorder α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] +[preorder β] {f : β → α} {s : set β} + +@[to_additive] lemma monotone.inv (hf : monotone f) : antitone (λ x, (f x)⁻¹) := +λ x y hxy, inv_le_inv_iff.2 (hf hxy) + +@[to_additive] lemma antitone.inv (hf : antitone f) : monotone (λ x, (f x)⁻¹) := +λ x y hxy, inv_le_inv_iff.2 (hf hxy) + +@[to_additive] lemma monotone_on.inv (hf : monotone_on f s) : + antitone_on (λ x, (f x)⁻¹) s := +λ x hx y hy hxy, inv_le_inv_iff.2 (hf hx hy hxy) + +@[to_additive] lemma antitone_on.inv (hf : antitone_on f s) : + monotone_on (λ x, (f x)⁻¹) s := +λ x hx y hy hxy, inv_le_inv_iff.2 (hf hx hy hxy) + +end + +section + +variables {β : Type*} +[group α] [preorder α] [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] +[preorder β] {f : β → α} {s : set β} + +@[to_additive] lemma strict_mono.inv (hf : strict_mono f) : strict_anti (λ x, (f x)⁻¹) := +λ x y hxy, inv_lt_inv_iff.2 (hf hxy) + +@[to_additive] lemma strict_anti.inv (hf : strict_anti f) : strict_mono (λ x, (f x)⁻¹) := +λ x y hxy, inv_lt_inv_iff.2 (hf hxy) + +@[to_additive] lemma strict_mono_on.inv (hf : strict_mono_on f s) : + strict_anti_on (λ x, (f x)⁻¹) s := +λ x hx y hy hxy, inv_lt_inv_iff.2 (hf hx hy hxy) + +@[to_additive] lemma strict_anti_on.inv (hf : strict_anti_on f s) : + strict_mono_on (λ x, (f x)⁻¹) s := +λ x hx y hy hxy, inv_lt_inv_iff.2 (hf hx hy hxy) + +end diff --git a/src/algebra/order/group/densely_ordered.lean b/src/algebra/order/group/densely_ordered.lean new file mode 100644 index 0000000000000..eb80253c69138 --- /dev/null +++ b/src/algebra/order/group/densely_ordered.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.monoid.canonical.defs +import algebra.order.group.defs +import algebra.order.monoid.order_dual + +/-! +# Lemmas about densely linearly ordered groups. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +section densely_ordered +variables [group α] [linear_order α] +variables [covariant_class α α (*) (≤)] +variables [densely_ordered α] {a b c : α} + +@[to_additive] +lemma le_of_forall_lt_one_mul_le (h : ∀ ε < 1, a * ε ≤ b) : a ≤ b := +@le_of_forall_one_lt_le_mul αᵒᵈ _ _ _ _ _ _ _ _ h + +@[to_additive] +lemma le_of_forall_one_lt_div_le (h : ∀ ε : α, 1 < ε → a / ε ≤ b) : a ≤ b := +le_of_forall_lt_one_mul_le $ λ ε ε1, + by simpa only [div_eq_mul_inv, inv_inv] using h ε⁻¹ (left.one_lt_inv_iff.2 ε1) + +@[to_additive] +lemma le_iff_forall_one_lt_le_mul : a ≤ b ↔ ∀ ε, 1 < ε → a ≤ b * ε := +⟨λ h ε ε_pos, le_mul_of_le_of_one_le h ε_pos.le, le_of_forall_one_lt_le_mul⟩ + +@[to_additive] +lemma le_iff_forall_lt_one_mul_le : a ≤ b ↔ ∀ ε < 1, a * ε ≤ b := +@le_iff_forall_one_lt_le_mul αᵒᵈ _ _ _ _ _ _ + +end densely_ordered diff --git a/src/algebra/order/group/inj_surj.lean b/src/algebra/order/group/inj_surj.lean new file mode 100644 index 0000000000000..e26c1fe0f031d --- /dev/null +++ b/src/algebra/order/group/inj_surj.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.defs +import algebra.order.monoid.basic +import algebra.order.group.instances + +/-! +# Pull back ordered groups along injective maps. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α β : Type*} + +/-- Pullback an `ordered_comm_group` under an injective map. +See note [reducible non-instances]. -/ +@[reducible, to_additive function.injective.ordered_add_comm_group +"Pullback an `ordered_add_comm_group` under an injective map."] +def function.injective.ordered_comm_group [ordered_comm_group α] {β : Type*} + [has_one β] [has_mul β] [has_inv β] [has_div β] [has_pow β ℕ] [has_pow β ℤ] + (f : β → α) (hf : function.injective f) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) + (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) + (div : ∀ x y, f (x / y) = f x / f y) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) : + ordered_comm_group β := +{ ..partial_order.lift f hf, + ..hf.ordered_comm_monoid f one mul npow, + ..hf.comm_group f one mul inv div npow zpow } + +/-- Pullback a `linear_ordered_comm_group` under an injective map. +See note [reducible non-instances]. -/ +@[reducible, to_additive function.injective.linear_ordered_add_comm_group +"Pullback a `linear_ordered_add_comm_group` under an injective map."] +def function.injective.linear_ordered_comm_group [linear_ordered_comm_group α] {β : Type*} + [has_one β] [has_mul β] [has_inv β] [has_div β] [has_pow β ℕ] [has_pow β ℤ] + [has_sup β] [has_inf β] (f : β → α) (hf : function.injective f) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) + (inv : ∀ x, f (x⁻¹) = (f x)⁻¹) + (div : ∀ x y, f (x / y) = f x / f y) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (zpow : ∀ x (n : ℤ), f (x ^ n) = f x ^ n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_comm_group β := +{ ..linear_order.lift f hf hsup hinf, + ..hf.ordered_comm_group f one mul inv div npow zpow } diff --git a/src/algebra/order/group/instances.lean b/src/algebra/order/group/instances.lean new file mode 100644 index 0000000000000..71f3c24131163 --- /dev/null +++ b/src/algebra/order/group/instances.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.defs +import algebra.order.monoid.order_dual + +/-! +# Additional instances for ordered commutative groups. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +variables {α : Type*} + +@[to_additive] instance [ordered_comm_group α] : ordered_comm_group αᵒᵈ := +{ .. order_dual.ordered_comm_monoid, .. order_dual.group } + +@[to_additive] instance [linear_ordered_comm_group α] : + linear_ordered_comm_group αᵒᵈ := +{ .. order_dual.ordered_comm_group, .. order_dual.linear_order α } diff --git a/src/algebra/order/group/min_max.lean b/src/algebra/order/group/min_max.lean new file mode 100644 index 0000000000000..b0bfc080a6f0a --- /dev/null +++ b/src/algebra/order/group/min_max.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.abs +import algebra.order.monoid.min_max + +/-! +# `min` and `max` in linearly ordered groups. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +section +variables {α : Type*} [group α] [linear_order α] [covariant_class α α (*) (≤)] + +@[simp, to_additive] lemma max_one_div_max_inv_one_eq_self (a : α) : + max a 1 / max a⁻¹ 1 = a := +by { rcases le_total a 1 with h|h; simp [h] } + +alias max_zero_sub_max_neg_zero_eq_self ← max_zero_sub_eq_self + +end + +section linear_ordered_comm_group +variables {α : Type*} [linear_ordered_comm_group α] {a b c : α} + +@[to_additive min_neg_neg] +lemma min_inv_inv' (a b : α) : min (a⁻¹) (b⁻¹) = (max a b)⁻¹ := +eq.symm $ @monotone.map_max α αᵒᵈ _ _ has_inv.inv a b $ λ a b, inv_le_inv_iff.mpr + +@[to_additive max_neg_neg] +lemma max_inv_inv' (a b : α) : max (a⁻¹) (b⁻¹) = (min a b)⁻¹ := +eq.symm $ @monotone.map_min α αᵒᵈ _ _ has_inv.inv a b $ λ a b, inv_le_inv_iff.mpr + +@[to_additive min_sub_sub_right] +lemma min_div_div_right' (a b c : α) : min (a / c) (b / c) = min a b / c := +by simpa only [div_eq_mul_inv] using min_mul_mul_right a b (c⁻¹) + +@[to_additive max_sub_sub_right] +lemma max_div_div_right' (a b c : α) : max (a / c) (b / c) = max a b / c := +by simpa only [div_eq_mul_inv] using max_mul_mul_right a b (c⁻¹) + +@[to_additive min_sub_sub_left] +lemma min_div_div_left' (a b c : α) : min (a / b) (a / c) = a / max b c := +by simp only [div_eq_mul_inv, min_mul_mul_left, min_inv_inv'] + +@[to_additive max_sub_sub_left] +lemma max_div_div_left' (a b c : α) : max (a / b) (a / c) = a / min b c := +by simp only [div_eq_mul_inv, max_mul_mul_left, max_inv_inv'] + +end linear_ordered_comm_group + +section linear_ordered_add_comm_group +variables {α : Type*} [linear_ordered_add_comm_group α] {a b c : α} + +lemma max_sub_max_le_max (a b c d : α) : max a b - max c d ≤ max (a - c) (b - d) := +begin + simp only [sub_le_iff_le_add, max_le_iff], split, + calc a = a - c + c : (sub_add_cancel a c).symm + ... ≤ max (a - c) (b - d) + max c d : add_le_add (le_max_left _ _) (le_max_left _ _), + calc b = b - d + d : (sub_add_cancel b d).symm + ... ≤ max (a - c) (b - d) + max c d : add_le_add (le_max_right _ _) (le_max_right _ _) +end + +lemma abs_max_sub_max_le_max (a b c d : α) : |max a b - max c d| ≤ max (|a - c|) (|b - d|) := +begin + refine abs_sub_le_iff.2 ⟨_, _⟩, + { exact (max_sub_max_le_max _ _ _ _).trans (max_le_max (le_abs_self _) (le_abs_self _)) }, + { rw [abs_sub_comm a c, abs_sub_comm b d], + exact (max_sub_max_le_max _ _ _ _).trans (max_le_max (le_abs_self _) (le_abs_self _)) } +end + +lemma abs_min_sub_min_le_max (a b c d : α) : |min a b - min c d| ≤ max (|a - c|) (|b - d|) := +by simpa only [max_neg_neg, neg_sub_neg, abs_sub_comm] + using abs_max_sub_max_le_max (-a) (-b) (-c) (-d) + +lemma abs_max_sub_max_le_abs (a b c : α) : |max a c - max b c| ≤ |a - b| := +by simpa only [sub_self, abs_zero, max_eq_left (abs_nonneg _)] + using abs_max_sub_max_le_max a c b c + +end linear_ordered_add_comm_group diff --git a/src/algebra/order/group/order_iso.lean b/src/algebra/order/group/order_iso.lean new file mode 100644 index 0000000000000..c82dca13aad5e --- /dev/null +++ b/src/algebra/order/group/order_iso.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.defs +import algebra.hom.equiv.units.basic + +/-! +# Inverse and multiplication as order isomorphisms in ordered groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +set_option old_structure_cmd true +open function + +universe u +variable {α : Type u} + + +section group +variables [group α] + +section typeclasses_left_right_le +variables [has_le α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + {a b c d : α} + +section + +variable (α) + +/-- `x ↦ x⁻¹` as an order-reversing equivalence. -/ +@[to_additive "`x ↦ -x` as an order-reversing equivalence.", simps] +def order_iso.inv : α ≃o αᵒᵈ := +{ to_equiv := (equiv.inv α).trans order_dual.to_dual, + map_rel_iff' := λ a b, @inv_le_inv_iff α _ _ _ _ _ _ } + +end + +@[to_additive neg_le] +lemma inv_le' : a⁻¹ ≤ b ↔ b⁻¹ ≤ a := +(order_iso.inv α).symm_apply_le + +alias inv_le' ↔ inv_le_of_inv_le' _ +attribute [to_additive neg_le_of_neg_le] inv_le_of_inv_le' + +@[to_additive le_neg] +lemma le_inv' : a ≤ b⁻¹ ↔ b ≤ a⁻¹ := +(order_iso.inv α).le_symm_apply + +/-- `x ↦ a / x` as an order-reversing equivalence. -/ +@[to_additive "`x ↦ a - x` as an order-reversing equivalence.", simps] +def order_iso.div_left (a : α) : α ≃o αᵒᵈ := +{ to_equiv := (equiv.div_left a).trans order_dual.to_dual, + map_rel_iff' := λ x y, @div_le_div_iff_left α _ _ _ _ _ _ _ } + +end typeclasses_left_right_le + +end group + +alias le_inv' ↔ le_inv_of_le_inv _ +attribute [to_additive] le_inv_of_le_inv + +section group +variables [group α] [has_le α] + +section right +variables [covariant_class α α (swap (*)) (≤)] {a b c d : α} + +/-- `equiv.mul_right` as an `order_iso`. See also `order_embedding.mul_right`. -/ +@[to_additive "`equiv.add_right` as an `order_iso`. See also `order_embedding.add_right`.", + simps to_equiv apply {simp_rhs := tt}] +def order_iso.mul_right (a : α) : α ≃o α := +{ map_rel_iff' := λ _ _, mul_le_mul_iff_right a, to_equiv := equiv.mul_right a } + +@[simp, to_additive] lemma order_iso.mul_right_symm (a : α) : + (order_iso.mul_right a).symm = order_iso.mul_right a⁻¹ := +by { ext x, refl } + +/-- `x ↦ x / a` as an order isomorphism. -/ +@[to_additive "`x ↦ x - a` as an order isomorphism.", simps] +def order_iso.div_right (a : α) : α ≃o α := +{ to_equiv := equiv.div_right a, + map_rel_iff' := λ x y, div_le_div_iff_right a } + +end right + +section left +variables [covariant_class α α (*) (≤)] + +/-- `equiv.mul_left` as an `order_iso`. See also `order_embedding.mul_left`. -/ +@[to_additive "`equiv.add_left` as an `order_iso`. See also `order_embedding.add_left`.", + simps to_equiv apply {simp_rhs := tt}] +def order_iso.mul_left (a : α) : α ≃o α := +{ map_rel_iff' := λ _ _, mul_le_mul_iff_left a, to_equiv := equiv.mul_left a } + +@[simp, to_additive] lemma order_iso.mul_left_symm (a : α) : + (order_iso.mul_left a).symm = order_iso.mul_left a⁻¹ := +by { ext x, refl } + +end left + +end group diff --git a/src/algebra/order/group/prod.lean b/src/algebra/order/group/prod.lean new file mode 100644 index 0000000000000..3ca4fe7d767ee --- /dev/null +++ b/src/algebra/order/group/prod.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.instances +import algebra.order.monoid.prod + +/-! +# Products of ordered commutative groups. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variable {α : Type*} + +namespace prod + +variables {G H : Type*} + +@[to_additive] +instance [ordered_comm_group G] [ordered_comm_group H] : + ordered_comm_group (G × H) := +{ .. prod.comm_group, .. prod.partial_order G H, .. prod.ordered_cancel_comm_monoid } + +end prod diff --git a/src/algebra/order/group/type_tags.lean b/src/algebra/order/group/type_tags.lean new file mode 100644 index 0000000000000..96fdf16b6f4df --- /dev/null +++ b/src/algebra/order/group/type_tags.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.instances +import algebra.order.monoid.type_tags + +/-! # Ordered group structures on `multiplicative α` and `additive α`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +variables {α : Type*} + +instance [ordered_add_comm_group α] : ordered_comm_group (multiplicative α) := +{ ..multiplicative.comm_group, + ..multiplicative.ordered_comm_monoid } + +instance [ordered_comm_group α] : ordered_add_comm_group (additive α) := +{ ..additive.add_comm_group, + ..additive.ordered_add_comm_monoid } + +instance [linear_ordered_add_comm_group α] : linear_ordered_comm_group (multiplicative α) := +{ ..multiplicative.linear_order, + ..multiplicative.ordered_comm_group } + +instance [linear_ordered_comm_group α] : linear_ordered_add_comm_group (additive α) := +{ ..additive.linear_order, + ..additive.ordered_add_comm_group } diff --git a/src/algebra/order/group/units.lean b/src/algebra/order/group/units.lean new file mode 100644 index 0000000000000..1a6ae734291e3 --- /dev/null +++ b/src/algebra/order/group/units.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.defs +import algebra.order.monoid.defs +import algebra.order.monoid.units + +/-! +# Adjoining a top element to a `linear_ordered_add_comm_group_with_top`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variable {α : Type*} + +/-- The units of an ordered commutative monoid form an ordered commutative group. -/ +@[to_additive "The units of an ordered commutative additive monoid form an ordered commutative +additive group."] +instance units.ordered_comm_group [ordered_comm_monoid α] : ordered_comm_group αˣ := +{ mul_le_mul_left := λ a b h c, (mul_le_mul_left' (h : (a : α) ≤ b) _ : (c : α) * a ≤ c * b), + .. units.partial_order, + .. units.comm_group } diff --git a/src/algebra/order/group/with_top.lean b/src/algebra/order/group/with_top.lean new file mode 100644 index 0000000000000..4a95ca79bbc15 --- /dev/null +++ b/src/algebra/order/group/with_top.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.group.instances +import algebra.order.monoid.with_top + +/-! +# Adjoining a top element to a `linear_ordered_add_comm_group_with_top`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variable {α : Type*} + +section linear_ordered_add_comm_group +variables [linear_ordered_add_comm_group α] {a b c d : α} + +instance with_top.linear_ordered_add_comm_group_with_top : + linear_ordered_add_comm_group_with_top (with_top α) := +{ neg := option.map (λ a : α, -a), + neg_top := @option.map_none _ _ (λ a : α, -a), + add_neg_cancel := begin + rintro (a | a) ha, + { exact (ha rfl).elim }, + { exact with_top.coe_add.symm.trans (with_top.coe_eq_coe.2 (add_neg_self a)) } + end, + .. with_top.linear_ordered_add_comm_monoid_with_top, + .. option.nontrivial } + +@[simp, norm_cast] +lemma with_top.coe_neg (a : α) : ((-a : α) : with_top α) = -a := rfl + +end linear_ordered_add_comm_group diff --git a/src/algebra/order/hom/basic.lean b/src/algebra/order/hom/basic.lean new file mode 100644 index 0000000000000..26cdd079ec5f5 --- /dev/null +++ b/src/algebra/order/hom/basic.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.group_power.order + +/-! +# Algebraic order homomorphism classes + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines hom classes for common properties at the intersection of order theory and algebra. + +## Typeclasses + +Basic typeclasses +* `nonneg_hom_class`: Homs are nonnegative: `∀ f a, 0 ≤ f a` +* `subadditive_hom_class`: Homs are subadditive: `∀ f a b, f (a + b) ≤ f a + f b` +* `submultiplicative_hom_class`: Homs are submultiplicative: `∀ f a b, f (a * b) ≤ f a * f b` +* `mul_le_add_hom_class`: `∀ f a b, f (a * b) ≤ f a + f b` +* `nonarchimedean_hom_class`: `∀ a b, f (a + b) ≤ max (f a) (f b)` + +Group norms +* `add_group_seminorm_class`: Homs are nonnegative, subadditive, even and preserve zero. +* `group_seminorm_class`: Homs are nonnegative, respect `f (a * b) ≤ f a + f b`, `f a⁻¹ = f a` and + preserve zero. +* `add_group_norm_class`: Homs are seminorms such that `f x = 0 → x = 0` for all `x`. +* `group_norm_class`: Homs are seminorms such that `f x = 0 → x = 1` for all `x`. + +Ring norms +* `ring_seminorm_class`: Homs are submultiplicative group norms. +* `ring_norm_class`: Homs are ring seminorms that are also additive group norms. +* `mul_ring_seminorm_class`: Homs are ring seminorms that are multiplicative. +* `mul_ring_norm_class`: Homs are ring norms that are multiplicative. + +## Notes + +Typeclasses for seminorms are defined here while types of seminorms are defined in +`analysis.normed.group.seminorm` and `analysis.normed.ring.seminorm` because absolute values are +multiplicative ring norms but outside of this use we only consider real-valued seminorms. + +## TODO + +Finitary versions of the current lemmas. +-/ + +/-- +Diamond inheritance cannot depend on `out_param`s in the following circumstances: + * there are three classes `top`, `middle`, `bottom` + * all of these classes have a parameter `(α : out_param _)` + * all of these classes have an instance parameter `[root α]` that depends on this `out_param` + * the `root` class has two child classes: `left` and `right`, these are siblings in the hierarchy + * the instance `bottom.to_middle` takes a `[left α]` parameter + * the instance `middle.to_top` takes a `[right α]` parameter + * there is a `leaf` class that inherits from both `left` and `right`. +In that case, given instances `bottom α` and `leaf α`, Lean cannot synthesize a `top α` instance, +even though the hypotheses of the instances `bottom.to_middle` and `middle.to_top` are satisfied. + +There are two workarounds: +* You could replace the bundled inheritance implemented by the instance `middle.to_top` with + unbundled inheritance implemented by adding a `[top α]` parameter to the `middle` class. This is + the preferred option since it is also more compatible with Lean 4, at the cost of being more work + to implement and more verbose to use. +* You could weaken the `bottom.to_middle` instance by making it depend on a subclass of + `middle.to_top`'s parameter, in this example replacing `[left α]` with `[leaf α]`. +-/ +library_note "out-param inheritance" + +set_option old_structure_cmd true + +open function + +variables {ι F α β γ δ : Type*} + +/-! ### Basics -/ + +/-- `nonneg_hom_class F α β` states that `F` is a type of nonnegative morphisms. -/ +class nonneg_hom_class (F : Type*) (α β : out_param $ Type*) [has_zero β] [has_le β] + extends fun_like F α (λ _, β) := +(map_nonneg (f : F) : ∀ a, 0 ≤ f a) + +/-- `subadditive_hom_class F α β` states that `F` is a type of subadditive morphisms. -/ +class subadditive_hom_class (F : Type*) (α β : out_param $ Type*) [has_add α] [has_add β] [has_le β] + extends fun_like F α (λ _, β) := +(map_add_le_add (f : F) : ∀ a b, f (a + b) ≤ f a + f b) + +/-- `submultiplicative_hom_class F α β` states that `F` is a type of submultiplicative morphisms. -/ +@[to_additive subadditive_hom_class] +class submultiplicative_hom_class (F : Type*) (α β : out_param $ Type*) [has_mul α] [has_mul β] + [has_le β] extends fun_like F α (λ _, β) := +(map_mul_le_mul (f : F) : ∀ a b, f (a * b) ≤ f a * f b) + +/-- `mul_le_add_hom_class F α β` states that `F` is a type of subadditive morphisms. -/ +@[to_additive subadditive_hom_class] +class mul_le_add_hom_class (F : Type*) (α β : out_param $ Type*) [has_mul α] [has_add β] [has_le β] + extends fun_like F α (λ _, β) := +(map_mul_le_add (f : F) : ∀ a b, f (a * b) ≤ f a + f b) + +/-- `nonarchimedean_hom_class F α β` states that `F` is a type of non-archimedean morphisms. -/ +class nonarchimedean_hom_class (F : Type*) (α β : out_param $ Type*) [has_add α] [linear_order β] + extends fun_like F α (λ _, β) := +(map_add_le_max (f : F) : ∀ a b, f (a + b) ≤ max (f a) (f b)) + +export nonneg_hom_class (map_nonneg) +export subadditive_hom_class (map_add_le_add) +export submultiplicative_hom_class (map_mul_le_mul) +export mul_le_add_hom_class (map_mul_le_add) +export nonarchimedean_hom_class (map_add_le_max) + +attribute [simp] map_nonneg + +@[to_additive] lemma le_map_mul_map_div [group α] [comm_semigroup β] [has_le β] + [submultiplicative_hom_class F α β] (f : F) (a b : α) : f a ≤ f b * f (a / b) := +by simpa only [mul_comm, div_mul_cancel'] using map_mul_le_mul f (a / b) b + +@[to_additive] lemma le_map_add_map_div [group α] [add_comm_semigroup β] [has_le β] + [mul_le_add_hom_class F α β] (f : F) (a b : α) : f a ≤ f b + f (a / b) := +by simpa only [add_comm, div_mul_cancel'] using map_mul_le_add f (a / b) b + +@[to_additive] +lemma le_map_div_mul_map_div [group α] [comm_semigroup β] [has_le β] + [submultiplicative_hom_class F α β] (f : F) (a b c: α) : f (a / c) ≤ f (a / b) * f (b / c) := +by simpa only [div_mul_div_cancel'] using map_mul_le_mul f (a / b) (b / c) + +@[to_additive] +lemma le_map_div_add_map_div [group α] [add_comm_semigroup β] [has_le β] + [mul_le_add_hom_class F α β] (f : F) (a b c: α) : f (a / c) ≤ f (a / b) + f (b / c) := +by simpa only [div_mul_div_cancel'] using map_mul_le_add f (a / b) (b / c) + +/-! ### Group (semi)norms -/ + +/-- `add_group_seminorm_class F α` states that `F` is a type of `β`-valued seminorms on the additive +group `α`. + +You should extend this class when you extend `add_group_seminorm`. -/ +class add_group_seminorm_class (F : Type*) (α β : out_param $ Type*) [add_group α] + [ordered_add_comm_monoid β] extends subadditive_hom_class F α β := +(map_zero (f : F) : f 0 = 0) +(map_neg_eq_map (f : F) (a : α) : f (-a) = f a) + +/-- `group_seminorm_class F α` states that `F` is a type of `β`-valued seminorms on the group `α`. + +You should extend this class when you extend `group_seminorm`. -/ +@[to_additive] +class group_seminorm_class (F : Type*) (α β : out_param $ Type*) [group α] + [ordered_add_comm_monoid β] extends mul_le_add_hom_class F α β := +(map_one_eq_zero (f : F) : f 1 = 0) +(map_inv_eq_map (f : F) (a : α) : f a⁻¹ = f a) + +/-- `add_group_norm_class F α` states that `F` is a type of `β`-valued norms on the additive group +`α`. + +You should extend this class when you extend `add_group_norm`. -/ +class add_group_norm_class (F : Type*) (α β : out_param $ Type*) [add_group α] + [ordered_add_comm_monoid β] extends add_group_seminorm_class F α β := +(eq_zero_of_map_eq_zero (f : F) {a : α} : f a = 0 → a = 0) + +/-- `group_norm_class F α` states that `F` is a type of `β`-valued norms on the group `α`. + +You should extend this class when you extend `group_norm`. -/ +@[to_additive] +class group_norm_class (F : Type*) (α β : out_param $ Type*) [group α] [ordered_add_comm_monoid β] + extends group_seminorm_class F α β := +(eq_one_of_map_eq_zero (f : F) {a : α} : f a = 0 → a = 1) + +export add_group_seminorm_class (map_neg_eq_map) +export group_seminorm_class (map_one_eq_zero map_inv_eq_map) +export add_group_norm_class (eq_zero_of_map_eq_zero) +export group_norm_class (eq_one_of_map_eq_zero) + +attribute [simp, to_additive map_zero] map_one_eq_zero +attribute [simp] map_neg_eq_map +attribute [simp, to_additive] map_inv_eq_map +attribute [to_additive] group_seminorm_class.to_mul_le_add_hom_class +attribute [to_additive] group_norm_class.to_group_seminorm_class + +@[priority 100] -- See note [lower instance priority] +instance add_group_seminorm_class.to_zero_hom_class [add_group α] [ordered_add_comm_monoid β] + [add_group_seminorm_class F α β] : + zero_hom_class F α β := +{ ..‹add_group_seminorm_class F α β› } + +section group_seminorm_class +variables [group α] [ordered_add_comm_monoid β] [group_seminorm_class F α β] (f : F) (x y : α) +include α β + +@[to_additive] lemma map_div_le_add : f (x / y) ≤ f x + f y := +by { rw [div_eq_mul_inv, ←map_inv_eq_map f y], exact map_mul_le_add _ _ _ } + +@[to_additive] lemma map_div_rev : f (x / y) = f (y / x) := by rw [←inv_div, map_inv_eq_map] + +@[to_additive] lemma le_map_add_map_div' : f x ≤ f y + f (y / x) := +by simpa only [add_comm, map_div_rev, div_mul_cancel'] using map_mul_le_add f (x / y) y + +end group_seminorm_class + +example [ordered_add_comm_group β] : ordered_add_comm_monoid β := infer_instance + +@[to_additive] lemma abs_sub_map_le_div [group α] [linear_ordered_add_comm_group β] + [group_seminorm_class F α β] (f : F) (x y : α) : |f x - f y| ≤ f (x / y) := +begin + rw [abs_sub_le_iff, sub_le_iff_le_add', sub_le_iff_le_add'], + exact ⟨le_map_add_map_div _ _ _, le_map_add_map_div' _ _ _⟩ +end + +@[to_additive, priority 100] -- See note [lower instance priority] +instance group_seminorm_class.to_nonneg_hom_class [group α] [linear_ordered_add_comm_monoid β] + [group_seminorm_class F α β] : + nonneg_hom_class F α β := +{ map_nonneg := λ f a, (nsmul_nonneg_iff two_ne_zero).1 $ + by { rw [two_nsmul, ←map_one_eq_zero f, ←div_self' a], exact map_div_le_add _ _ _ }, + ..‹group_seminorm_class F α β› } + +section group_norm_class +variables [group α] [ordered_add_comm_monoid β] [group_norm_class F α β] (f : F) {x : α} +include α β + +@[simp, to_additive] lemma map_eq_zero_iff_eq_one : f x = 0 ↔ x = 1 := +⟨eq_one_of_map_eq_zero _, by { rintro rfl, exact map_one_eq_zero _ }⟩ + +@[to_additive] lemma map_ne_zero_iff_ne_one : f x ≠ 0 ↔ x ≠ 1 := (map_eq_zero_iff_eq_one _).not + +end group_norm_class + +@[to_additive] lemma map_pos_of_ne_one [group α] [linear_ordered_add_comm_monoid β] + [group_norm_class F α β] (f : F) {x : α} (hx : x ≠ 1) : 0 < f x := +(map_nonneg _ _).lt_of_ne $ ((map_ne_zero_iff_ne_one _).2 hx).symm + +/-! ### Ring (semi)norms -/ + +/-- `ring_seminorm_class F α` states that `F` is a type of `β`-valued seminorms on the ring `α`. + +You should extend this class when you extend `ring_seminorm`. -/ +class ring_seminorm_class (F : Type*) (α β : out_param $ Type*) [non_unital_non_assoc_ring α] + [ordered_semiring β] extends add_group_seminorm_class F α β, submultiplicative_hom_class F α β + +/-- `ring_norm_class F α` states that `F` is a type of `β`-valued norms on the ring `α`. + +You should extend this class when you extend `ring_norm`. -/ +class ring_norm_class (F : Type*) (α β : out_param $ Type*) [non_unital_non_assoc_ring α] + [ordered_semiring β] extends ring_seminorm_class F α β, add_group_norm_class F α β + +/-- `mul_ring_seminorm_class F α` states that `F` is a type of `β`-valued multiplicative seminorms +on the ring `α`. + +You should extend this class when you extend `mul_ring_seminorm`. -/ +class mul_ring_seminorm_class (F : Type*) (α β : out_param $ Type*) [non_assoc_ring α] + [ordered_semiring β] extends add_group_seminorm_class F α β, monoid_with_zero_hom_class F α β + +/-- `mul_ring_norm_class F α` states that `F` is a type of `β`-valued multiplicative norms on the +ring `α`. + +You should extend this class when you extend `mul_ring_norm`. -/ +class mul_ring_norm_class (F : Type*) (α β : out_param $ Type*) [non_assoc_ring α] + [ordered_semiring β] extends mul_ring_seminorm_class F α β, add_group_norm_class F α β + +-- See note [out-param inheritance] +@[priority 100] -- See note [lower instance priority] +instance ring_seminorm_class.to_nonneg_hom_class [non_unital_non_assoc_ring α] + [linear_ordered_semiring β] [ring_seminorm_class F α β] : nonneg_hom_class F α β := +add_group_seminorm_class.to_nonneg_hom_class + +@[priority 100] -- See note [lower instance priority] +instance mul_ring_seminorm_class.to_ring_seminorm_class [non_assoc_ring α] [ordered_semiring β] + [mul_ring_seminorm_class F α β] : ring_seminorm_class F α β := +{ map_mul_le_mul := λ f a b, (map_mul _ _ _).le, + ..‹mul_ring_seminorm_class F α β› } + +@[priority 100] -- See note [lower instance priority] +instance mul_ring_norm_class.to_ring_norm_class [non_assoc_ring α] [ordered_semiring β] + [mul_ring_norm_class F α β] : ring_norm_class F α β := +{ ..‹mul_ring_norm_class F α β›, ..mul_ring_seminorm_class.to_ring_seminorm_class } diff --git a/src/algebra/order/hom/monoid.lean b/src/algebra/order/hom/monoid.lean index c4ad367c017c9..9d36f82d867ce 100644 --- a/src/algebra/order/hom/monoid.lean +++ b/src/algebra/order/hom/monoid.lean @@ -3,13 +3,18 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ +import data.pi.algebra import algebra.hom.group -import algebra.order.with_zero +import algebra.order.group.instances +import algebra.order.monoid.with_zero.defs import order.hom.basic /-! # Ordered monoid and group homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines morphisms between (additive) ordered monoids. ## Types of morphisms @@ -70,14 +75,20 @@ structure order_add_monoid_hom (α β : Type*) [preorder α] [preorder β] [add_ infixr ` →+o `:25 := order_add_monoid_hom +section +set_option old_structure_cmd true + /-- `order_add_monoid_hom_class F α β` states that `F` is a type of ordered monoid homomorphisms. You should also extend this typeclass when you extend `order_add_monoid_hom`. -/ +@[ancestor add_monoid_hom_class] class order_add_monoid_hom_class (F : Type*) (α β : out_param $ Type*) [preorder α] [preorder β] [add_zero_class α] [add_zero_class β] extends add_monoid_hom_class F α β := (monotone (f : F) : monotone f) +end + -- Instances and lemmas are defined below through `@[to_additive]`. end add_monoid @@ -101,19 +112,25 @@ structure order_monoid_hom (α β : Type*) [preorder α] [preorder β] [mul_one_ infixr ` →*o `:25 := order_monoid_hom +section +set_option old_structure_cmd true + /-- `order_monoid_hom_class F α β` states that `F` is a type of ordered monoid homomorphisms. You should also extend this typeclass when you extend `order_monoid_hom`. -/ -@[to_additive] +@[ancestor monoid_hom_class, to_additive] class order_monoid_hom_class (F : Type*) (α β : out_param $ Type*) [preorder α] [preorder β] [mul_one_class α] [mul_one_class β] extends monoid_hom_class F α β := (monotone (f : F) : monotone f) +end + @[priority 100, to_additive] -- See note [lower instance priority] instance order_monoid_hom_class.to_order_hom_class [order_monoid_hom_class F α β] : order_hom_class F α β := -{ map_rel := order_monoid_hom_class.monotone } +{ map_rel := order_monoid_hom_class.monotone, + .. ‹order_monoid_hom_class F α β› } @[to_additive] instance [order_monoid_hom_class F α β] : has_coe_t F (α →*o β) := @@ -141,6 +158,9 @@ structure order_monoid_with_zero_hom (α β : Type*) [preorder α] [preorder β] infixr ` →*₀o `:25 := order_monoid_with_zero_hom +section +set_option old_structure_cmd true + /-- `order_monoid_with_zero_hom_class F α β` states that `F` is a type of ordered monoid with zero homomorphisms. @@ -150,6 +170,8 @@ class order_monoid_with_zero_hom_class (F : Type*) (α β : out_param $ Type*) extends monoid_with_zero_hom_class F α β := (monotone (f : F) : monotone f) +end + @[priority 100] -- See note [lower instance priority] instance order_monoid_with_zero_hom_class.to_order_monoid_hom_class [order_monoid_with_zero_hom_class F α β] : order_monoid_hom_class F α β := @@ -161,6 +183,47 @@ instance [order_monoid_with_zero_hom_class F α β] : has_coe_t F (α →*₀o end monoid_with_zero +section ordered_add_comm_monoid +variables [ordered_add_comm_monoid α] [ordered_add_comm_monoid β] [order_add_monoid_hom_class F α β] + (f : F) {a : α} +include β + +lemma map_nonneg (ha : 0 ≤ a) : 0 ≤ f a := by { rw ←map_zero f, exact order_hom_class.mono _ ha } +lemma map_nonpos (ha : a ≤ 0) : f a ≤ 0 := by { rw ←map_zero f, exact order_hom_class.mono _ ha } + +end ordered_add_comm_monoid + +section ordered_add_comm_group + +variables [ordered_add_comm_group α] + [ordered_add_comm_monoid β] [add_monoid_hom_class F α β] (f : F) + +lemma monotone_iff_map_nonneg : monotone (f : α → β) ↔ ∀ a, 0 ≤ a → 0 ≤ f a := +⟨λ h a, by { rw ←map_zero f, apply h }, λ h a b hl, + by { rw [←sub_add_cancel b a, map_add f], exact le_add_of_nonneg_left (h _ $ sub_nonneg.2 hl) }⟩ + +lemma antitone_iff_map_nonpos : antitone (f : α → β) ↔ ∀ a, 0 ≤ a → f a ≤ 0 := +monotone_to_dual_comp_iff.symm.trans $ monotone_iff_map_nonneg _ +lemma monotone_iff_map_nonpos : monotone (f : α → β) ↔ ∀ a ≤ 0, f a ≤ 0 := +antitone_comp_of_dual_iff.symm.trans $ antitone_iff_map_nonpos _ +lemma antitone_iff_map_nonneg : antitone (f : α → β) ↔ ∀ a ≤ 0, 0 ≤ f a := +monotone_comp_of_dual_iff.symm.trans $ monotone_iff_map_nonneg _ + +variable [covariant_class β β (+) (<)] + +lemma strict_mono_iff_map_pos : strict_mono (f : α → β) ↔ ∀ a, 0 < a → 0 < f a := +⟨λ h a, by { rw ←map_zero f, apply h }, λ h a b hl, + by { rw [←sub_add_cancel b a, map_add f], exact lt_add_of_pos_left _ (h _ $ sub_pos.2 hl) }⟩ + +lemma strict_anti_iff_map_neg : strict_anti (f : α → β) ↔ ∀ a, 0 < a → f a < 0 := +strict_mono_to_dual_comp_iff.symm.trans $ strict_mono_iff_map_pos _ +lemma strict_mono_iff_map_neg : strict_mono (f : α → β) ↔ ∀ a < 0, f a < 0 := +strict_anti_comp_of_dual_iff.symm.trans $ strict_anti_iff_map_neg _ +lemma strict_anti_iff_map_pos : strict_anti (f : α → β) ↔ ∀ a < 0, 0 < f a := +strict_mono_comp_of_dual_iff.symm.trans $ strict_mono_iff_map_pos _ + +end ordered_add_comm_group + namespace order_monoid_hom section preorder variables [preorder α] [preorder β] [preorder γ] [preorder δ] [mul_one_class α] @@ -207,7 +270,15 @@ definitional equalities."] protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β := { to_fun := f', monotone' := h.symm.subst f.monotone', - ..f.to_monoid_hom.copy f' $ by exact h } + ..f.to_monoid_hom.copy f' h } + +@[simp, to_additive] lemma coe_copy (f : α →*o β) (f' : α → β) (h : f' = f) : + ⇑(f.copy f' h) = f' := +rfl + +@[to_additive] lemma copy_eq (f : α →*o β) (f' : α → β) (h : f' = f) : + f.copy f' h = f := +fun_like.ext' h variables (α) @@ -345,12 +416,14 @@ lemma to_order_monoid_hom_injective : injective (to_order_monoid_hom : _ → α lemma to_monoid_with_zero_hom_injective : injective (to_monoid_with_zero_hom : _ → α →*₀ β) := λ f g h, ext $ by convert fun_like.ext_iff.1 h -/-- Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix +/-- Copy of an `order_monoid_with_zero_hom` with a new `to_fun` equal to the old one. Useful to fix definitional equalities. -/ -protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β := +protected def copy (f : α →*₀o β) (f' : α → β) (h : f' = f) : α →*o β := { to_fun := f', - monotone' := h.symm.subst f.monotone', - ..f.to_monoid_hom.copy f' (by exact h) } + .. f.to_order_monoid_hom.copy f' h, .. f.to_monoid_with_zero_hom.copy f' h } + +@[simp] lemma coe_copy (f : α →*₀o β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl +lemma copy_eq (f : α →*₀o β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h variables (α) diff --git a/src/algebra/order/hom/ring.lean b/src/algebra/order/hom/ring.lean index 7fbd7a488e2c5..82cc90c37120b 100644 --- a/src/algebra/order/hom/ring.lean +++ b/src/algebra/order/hom/ring.lean @@ -5,12 +5,17 @@ Authors: Alex J. Best, Yaël Dillies -/ import algebra.order.archimedean import algebra.order.hom.monoid -import algebra.order.ring +import algebra.order.ring.defs import algebra.ring.equiv +import tactic.by_contra +import tactic.wlog /-! # Ordered ring homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Homomorphisms between ordered (semi)rings that respect the ordering. ## Main definitions @@ -158,6 +163,9 @@ equalities. -/ protected def copy (f : α →+*o β) (f' : α → β) (h : f' = f) : α →+*o β := { .. f.to_ring_hom.copy f' h, .. f.to_order_add_monoid_hom.copy f' h } +@[simp] lemma coe_copy (f : α →+*o β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl +lemma copy_eq (f : α →+*o β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h + variable (α) /-- The identity as an ordered ring homomorphism. -/ @@ -215,7 +223,7 @@ variables [has_mul α] [has_add α] [has_le α] [has_mul β] [has_add β] [has_l [has_add γ] [has_le γ] [has_mul δ] [has_add δ] [has_le δ] /-- Reinterpret an ordered ring isomorphism as an order isomorphism. -/ -def to_order_iso (f : α ≃+*o β) : α ≃o β := ⟨f.to_ring_equiv.to_equiv, f.map_le_map_iff'⟩ +def to_order_iso (f : α ≃+*o β) : α ≃o β := ⟨f.to_ring_equiv.to_equiv, λ _ _, f.map_le_map_iff'⟩ instance : order_ring_iso_class (α ≃+*o β) α β := { coe := λ f, f.to_fun, @@ -223,7 +231,7 @@ instance : order_ring_iso_class (α ≃+*o β) α β := coe_injective' := λ f g h₁ h₂, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' }, map_add := λ f, f.map_add', map_mul := λ f, f.map_mul', - map_le_map_iff := λ f, f.map_le_map_iff', + map_le_map_iff := λ f _ _, f.map_le_map_iff', left_inv := λ f, f.left_inv, right_inv := λ f, f.right_inv } @@ -315,15 +323,14 @@ conditionally complete. /-- There is at most one ordered ring homomorphism from a linear ordered field to an archimedean linear ordered field. -/ --- TODO[gh-6025]: make this an instance once safe to do so -lemma order_ring_hom.subsingleton [linear_ordered_field α] [linear_ordered_field β] +instance order_ring_hom.subsingleton [linear_ordered_field α] [linear_ordered_field β] [archimedean β] : subsingleton (α →+*o β) := ⟨λ f g, begin ext x, - by_contra' h, - wlog h : f x < g x using [f g, g f], - { exact ne.lt_or_lt h }, + by_contra' h' : f x ≠ g x, + wlog h : f x < g x, + { exact this g f x (ne.symm h') (h'.lt_or_lt.resolve_left h), }, obtain ⟨q, hf, hg⟩ := exists_rat_btwn h, rw ←map_rat_cast f at hf, rw ←map_rat_cast g at hg, @@ -331,22 +338,16 @@ lemma order_ring_hom.subsingleton [linear_ordered_field α] [linear_ordered_fiel (order_hom_class.mono f).reflect_lt hf).elim, end⟩ -local attribute [instance] order_ring_hom.subsingleton - /-- There is at most one ordered ring isomorphism between a linear ordered field and an archimedean linear ordered field. -/ --- TODO[gh-6025]: make this an instance once safe to do so -lemma order_ring_iso.subsingleton_right [linear_ordered_field α] [linear_ordered_field β] +instance order_ring_iso.subsingleton_right [linear_ordered_field α] [linear_ordered_field β] [archimedean β] : subsingleton (α ≃+*o β) := order_ring_iso.to_order_ring_hom_injective.subsingleton -local attribute [instance] order_ring_iso.subsingleton_right - /-- There is at most one ordered ring isomorphism between an archimedean linear ordered field and a linear ordered field. -/ --- TODO[gh-6025]: make this an instance once safe to do so -lemma order_ring_iso.subsingleton_left [linear_ordered_field α] [archimedean α] +instance order_ring_iso.subsingleton_left [linear_ordered_field α] [archimedean α] [linear_ordered_field β] : subsingleton (α ≃+*o β) := order_ring_iso.symm_bijective.injective.subsingleton diff --git a/src/algebra/order/interval.lean b/src/algebra/order/interval.lean new file mode 100644 index 0000000000000..5372b31fabdea --- /dev/null +++ b/src/algebra/order/interval.lean @@ -0,0 +1,420 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.big_operators.order +import algebra.group.prod +import data.option.n_ary +import data.set.pointwise.basic +import order.interval +import tactic.positivity + +/-! +# Interval arithmetic + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines arithmetic operations on intervals and prove their correctness. Note that this is +full precision operations. The essentials of float operations can be found +in `data.fp.basic`. We have not yet integrated these with the rest of the library. +-/ + +open function set +open_locale big_operators pointwise + +universe u +variables {ι α : Type*} + +/-! ### One/zero -/ + +section one +section preorder +variables [preorder α] [has_one α] + +@[to_additive] instance : has_one (nonempty_interval α) := ⟨nonempty_interval.pure 1⟩ +@[to_additive] instance : has_one (interval α) := ⟨interval.pure 1⟩ + +namespace nonempty_interval + +@[simp, to_additive to_prod_zero] lemma to_prod_one : (1 : nonempty_interval α).to_prod = 1 := rfl +@[to_additive] lemma fst_one : (1 : nonempty_interval α).fst = 1 := rfl +@[to_additive] lemma snd_one : (1 : nonempty_interval α).snd = 1 := rfl +@[simp, norm_cast, to_additive] +lemma coe_one_interval : ((1 : nonempty_interval α) : interval α) = 1 := rfl +@[simp, to_additive] lemma pure_one : pure (1 : α) = 1 := rfl + +end nonempty_interval + +namespace interval + +@[simp, to_additive] lemma pure_one : pure (1 : α) = 1 := rfl +@[simp, to_additive] lemma one_ne_bot : (1 : interval α) ≠ ⊥ := pure_ne_bot +@[simp, to_additive] lemma bot_ne_one : (⊥ : interval α) ≠ 1 := bot_ne_pure + +end interval +end preorder + +section partial_order +variables [partial_order α] [has_one α] + +namespace nonempty_interval + +@[simp, to_additive] lemma coe_one : ((1 : nonempty_interval α) : set α) = 1 := coe_pure _ +@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : nonempty_interval α) := ⟨le_rfl, le_rfl⟩ + +end nonempty_interval + +namespace interval + +@[simp, to_additive] lemma coe_one : ((1 : interval α) : set α) = 1 := Icc_self _ +@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : interval α) := ⟨le_rfl, le_rfl⟩ + +end interval +end partial_order +end one + +/-! +### Addition/multiplication + +Note that this multiplication does not apply to `ℚ` or `ℝ`. +-/ + +section mul +variables [preorder α] [has_mul α] [covariant_class α α (*) (≤)] + [covariant_class α α (swap (*)) (≤)] + +@[to_additive] instance : has_mul (nonempty_interval α) := +⟨λ s t, ⟨s.to_prod * t.to_prod, mul_le_mul' s.fst_le_snd t.fst_le_snd⟩⟩ + +@[to_additive] instance : has_mul (interval α) := ⟨option.map₂ (*)⟩ + +namespace nonempty_interval +variables (s t : nonempty_interval α) (a b : α) + +@[simp, to_additive to_prod_add] lemma to_prod_mul : (s * t).to_prod = s.to_prod * t.to_prod := rfl +@[to_additive] lemma fst_mul : (s * t).fst = s.fst * t.fst := rfl +@[to_additive] lemma snd_mul : (s * t).snd = s.snd * t.snd := rfl +@[simp, to_additive] lemma coe_mul_interval : (↑(s * t) : interval α) = s * t := rfl +@[simp, to_additive] lemma pure_mul_pure : pure a * pure b = pure (a * b) := rfl + +end nonempty_interval + +namespace interval +variables (s t : interval α) + +@[simp, to_additive] lemma bot_mul : ⊥ * t = ⊥ := rfl +@[simp, to_additive] lemma mul_bot : s * ⊥ = ⊥ := option.map₂_none_right _ _ + +end interval +end mul + +/-! ### Powers -/ + +-- TODO: if `to_additive` gets improved sufficiently, derive this from `has_pow` +instance nonempty_interval.has_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] + [covariant_class α α (swap (+)) (≤)] : has_smul ℕ (nonempty_interval α) := +⟨λ n s, ⟨(n • s.fst, n • s.snd), nsmul_le_nsmul_of_le_right s.fst_le_snd _⟩⟩ + +section pow +variables [monoid α] [preorder α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + +@[to_additive nonempty_interval.has_nsmul] +instance nonempty_interval.has_pow : has_pow (nonempty_interval α) ℕ := +⟨λ s n, ⟨s.to_prod ^ n, pow_le_pow_of_le_left' s.fst_le_snd _⟩⟩ + +namespace nonempty_interval +variables (s : nonempty_interval α) (a : α) (n : ℕ) + +@[simp, to_additive to_prod_nsmul] lemma to_prod_pow : (s ^ n).to_prod = s.to_prod ^ n := rfl +@[to_additive] lemma fst_pow : (s ^ n).fst = s.fst ^ n := rfl +@[to_additive] lemma snd_pow : (s ^ n).snd = s.snd ^ n := rfl +@[simp, to_additive] lemma pure_pow : pure a ^ n = pure (a ^ n) := rfl + +end nonempty_interval +end pow + +namespace nonempty_interval + +@[to_additive] +instance [ordered_comm_monoid α] : comm_monoid (nonempty_interval α) := +nonempty_interval.to_prod_injective.comm_monoid _ to_prod_one to_prod_mul to_prod_pow + +end nonempty_interval + +@[to_additive] +instance [ordered_comm_monoid α] : mul_one_class (interval α) := +{ mul := (*), + one := 1, + one_mul := λ s, (option.map₂_coe_left _ _ _).trans $ + by simp only [nonempty_interval.pure_one, one_mul, ←id_def, option.map_id, id], + mul_one := λ s, (option.map₂_coe_right _ _ _).trans $ + by simp only [nonempty_interval.pure_one, mul_one, ←id_def, option.map_id, id] } + +@[to_additive] +instance [ordered_comm_monoid α] : comm_monoid (interval α) := +{ mul_comm := λ _ _, option.map₂_comm mul_comm, + mul_assoc := λ _ _ _, option.map₂_assoc mul_assoc, + ..interval.mul_one_class } + +namespace nonempty_interval + +@[simp, to_additive] lemma coe_pow_interval [ordered_comm_monoid α] (s : nonempty_interval α) + (n : ℕ) : + (↑(s ^ n) : interval α) = s ^ n := +map_pow (⟨coe, coe_one_interval, coe_mul_interval⟩ : nonempty_interval α →* interval α) _ _ + +end nonempty_interval + +namespace interval +variables [ordered_comm_monoid α] (s : interval α) {n : ℕ} + +@[to_additive] lemma bot_pow : ∀ {n : ℕ} (hn : n ≠ 0), (⊥ : interval α) ^ n = ⊥ +| 0 h := (h rfl).elim +| (nat.succ n) _ := bot_mul (⊥ ^ n) + +end interval + +/-! +### Subtraction + +Subtraction is defined more generally than division so that it applies to `ℕ` (and `has_ordered_div` +is not a thing and probably should not become one). +-/ + +section sub +variables [preorder α] [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] + [covariant_class α α (+) (≤)] + +instance : has_sub (nonempty_interval α) := +⟨λ s t, ⟨(s.fst - t.snd, s.snd - t.fst), tsub_le_tsub s.fst_le_snd t.fst_le_snd⟩⟩ + +instance : has_sub (interval α) := ⟨option.map₂ has_sub.sub⟩ + +namespace nonempty_interval +variables (s t : nonempty_interval α) {a b : α} + +@[simp] lemma fst_sub : (s - t).fst = s.fst - t.snd := rfl +@[simp] lemma snd_sub : (s - t).snd = s.snd - t.fst := rfl +@[simp] lemma coe_sub_interval : (↑(s - t) : interval α) = s - t := rfl +lemma sub_mem_sub (ha : a ∈ s) (hb : b ∈ t) : a - b ∈ s - t := +⟨tsub_le_tsub ha.1 hb.2, tsub_le_tsub ha.2 hb.1⟩ +@[simp] lemma pure_sub_pure (a b : α) : pure a - pure b = pure (a - b) := rfl + +end nonempty_interval + +namespace interval +variables (s t : interval α) + +@[simp] lemma bot_sub : ⊥ - t = ⊥ := rfl +@[simp] lemma sub_bot : s - ⊥ = ⊥ := option.map₂_none_right _ _ + +end interval +end sub + +/-! +### Division in ordered groups + +Note that this division does not apply to `ℚ` or `ℝ`. +-/ + +section div +variables [preorder α] [comm_group α] [covariant_class α α (*) (≤)] + +@[to_additive] instance : has_div (nonempty_interval α) := +⟨λ s t, ⟨(s.fst / t.snd, s.snd / t.fst), div_le_div'' s.fst_le_snd t.fst_le_snd⟩⟩ + +@[to_additive] instance : has_div (interval α) := ⟨option.map₂ (/)⟩ + +namespace nonempty_interval +variables (s t : nonempty_interval α) (a b : α) + +@[simp, to_additive] lemma fst_div : (s / t).fst = s.fst / t.snd := rfl +@[simp, to_additive] lemma snd_div : (s / t).snd = s.snd / t.fst := rfl +@[simp, to_additive] lemma coe_div_interval : (↑(s / t) : interval α) = s / t := rfl +@[to_additive] lemma div_mem_div (ha : a ∈ s) (hb : b ∈ t) : a / b ∈ s / t := +⟨div_le_div'' ha.1 hb.2, div_le_div'' ha.2 hb.1⟩ +@[simp, to_additive] lemma pure_div_pure : pure a / pure b = pure (a / b) := rfl + +end nonempty_interval + +namespace interval +variables (s t : interval α) + +@[simp, to_additive] lemma bot_div : ⊥ / t = ⊥ := rfl +@[simp, to_additive] lemma div_bot : s / ⊥ = ⊥ := option.map₂_none_right _ _ + +end interval +end div + +/-! ### Negation/inversion -/ + +section inv +variables [ordered_comm_group α] + +@[to_additive] instance : has_inv (nonempty_interval α) := +⟨λ s, ⟨(s.snd⁻¹, s.fst⁻¹), inv_le_inv' s.fst_le_snd⟩⟩ + +@[to_additive] instance : has_inv (interval α) := ⟨option.map has_inv.inv⟩ + +namespace nonempty_interval +variables (s t : nonempty_interval α) (a : α) + +@[simp, to_additive] lemma fst_inv : s⁻¹.fst = s.snd⁻¹ := rfl +@[simp, to_additive] lemma snd_inv : s⁻¹.snd = s.fst⁻¹ := rfl +@[simp, to_additive] lemma coe_inv_interval : (↑(s⁻¹) : interval α) = s⁻¹ := rfl +@[to_additive] lemma inv_mem_inv (ha : a ∈ s) : a⁻¹ ∈ s⁻¹ := ⟨inv_le_inv' ha.2, inv_le_inv' ha.1⟩ +@[simp, to_additive] lemma inv_pure : (pure a)⁻¹ = pure a⁻¹ := rfl + +end nonempty_interval + +@[simp, to_additive] lemma interval.inv_bot : (⊥ : interval α)⁻¹ = ⊥ := rfl + +end inv + +namespace nonempty_interval +variables [ordered_comm_group α] {s t : nonempty_interval α} + +@[to_additive] protected lemma mul_eq_one_iff : + s * t = 1 ↔ ∃ a b, s = pure a ∧ t = pure b ∧ a * b = 1 := +begin + refine ⟨λ h, _, _⟩, + { rw [ext_iff, prod.ext_iff] at h, + have := (mul_le_mul_iff_of_ge s.fst_le_snd t.fst_le_snd).1 (h.2.trans h.1.symm).le, + refine ⟨s.fst, t.fst, _, _, h.1⟩; ext; try { refl }, + exacts [this.1.symm, this.2.symm] }, + { rintro ⟨b, c, rfl, rfl, h⟩, + rw [pure_mul_pure, h, pure_one] } +end + +instance {α : Type u} [ordered_add_comm_group α] : subtraction_comm_monoid (nonempty_interval α) := +{ neg := has_neg.neg, + sub := has_sub.sub, + sub_eq_add_neg := λ s t, by ext; exact sub_eq_add_neg _ _, + neg_neg := λ s, by ext; exact neg_neg _, + neg_add_rev := λ s t, by ext; exact neg_add_rev _ _, + neg_eq_of_add := λ s t h, begin + obtain ⟨a, b, rfl, rfl, hab⟩ := nonempty_interval.add_eq_zero_iff.1 h, + rw [neg_pure, neg_eq_of_add_eq_zero_right hab], + end, + ..nonempty_interval.add_comm_monoid } + +@[to_additive nonempty_interval.subtraction_comm_monoid] +instance : division_comm_monoid (nonempty_interval α) := +{ inv := has_inv.inv, + div := (/), + div_eq_mul_inv := λ s t, by ext; exact div_eq_mul_inv _ _, + inv_inv := λ s, by ext; exact inv_inv _, + mul_inv_rev := λ s t, by ext; exact mul_inv_rev _ _, + inv_eq_of_mul := λ s t h, begin + obtain ⟨a, b, rfl, rfl, hab⟩ := nonempty_interval.mul_eq_one_iff.1 h, + rw [inv_pure, inv_eq_of_mul_eq_one_right hab], + end, + ..nonempty_interval.comm_monoid } + +end nonempty_interval + +namespace interval +variables [ordered_comm_group α] {s t : interval α} + +@[to_additive] protected lemma mul_eq_one_iff : + s * t = 1 ↔ ∃ a b, s = pure a ∧ t = pure b ∧ a * b = 1 := +begin + cases s, + { simp [with_bot.none_eq_bot] }, + cases t, + { simp [with_bot.none_eq_bot] }, + { simp [with_bot.some_eq_coe, ←nonempty_interval.coe_mul_interval, + nonempty_interval.mul_eq_one_iff] } +end + +instance {α : Type u} [ordered_add_comm_group α] : subtraction_comm_monoid (interval α) := +{ neg := has_neg.neg, + sub := has_sub.sub, + sub_eq_add_neg := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (sub_eq_add_neg _ _), + neg_neg := by rintro (_ | s); refl <|> exact congr_arg some (neg_neg _), + neg_add_rev := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (neg_add_rev _ _), + neg_eq_of_add := by rintro (_ | s) (_ | t) h; + cases h <|> exact congr_arg some (neg_eq_of_add_eq_zero_right $ option.some_injective _ h), + ..interval.add_comm_monoid } + +@[to_additive interval.subtraction_comm_monoid] +instance : division_comm_monoid (interval α) := +{ inv := has_inv.inv, + div := (/), + div_eq_mul_inv := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (div_eq_mul_inv _ _), + inv_inv := by rintro (_ | s); refl <|> exact congr_arg some (inv_inv _), + mul_inv_rev := by rintro (_ | s) (_ | t); refl <|> exact congr_arg some (mul_inv_rev _ _), + inv_eq_of_mul := by rintro (_ | s) (_ | t) h; + cases h <|> exact congr_arg some (inv_eq_of_mul_eq_one_right $ option.some_injective _ h), + ..interval.comm_monoid } + +end interval + +section length +variables [ordered_add_comm_group α] + +namespace nonempty_interval +variables (s t : nonempty_interval α) (a : α) + +/-- The length of an interval is its first component minus its second component. This measures the +accuracy of the approximation by an interval. -/ +def length : α := s.snd - s.fst + +@[simp] lemma length_nonneg : 0 ≤ s.length := sub_nonneg_of_le s.fst_le_snd +@[simp] lemma length_pure : (pure a).length = 0 := sub_self _ +@[simp] lemma length_zero : (0 : nonempty_interval α).length = 0 := length_pure _ +@[simp] lemma length_neg : (-s).length = s.length := neg_sub_neg _ _ +@[simp] lemma length_add : (s + t).length = s.length + t.length := add_sub_add_comm _ _ _ _ +@[simp] lemma length_sub : (s - t).length = s.length + t.length := by simp [sub_eq_add_neg] + +@[simp] lemma length_sum (f : ι → nonempty_interval α) (s : finset ι) : + (∑ i in s, f i).length = ∑ i in s, (f i).length := +map_sum (⟨length, length_zero, length_add⟩ : nonempty_interval α →+ α) _ _ + +end nonempty_interval + +namespace interval +variables (s t : interval α) (a : α) + +/-- The length of an interval is its first component minus its second component. This measures the +accuracy of the approximation by an interval. -/ +def length : interval α → α +| ⊥ := 0 +| (s : nonempty_interval α) := s.length + +@[simp] lemma length_nonneg : ∀ s : interval α, 0 ≤ s.length +| ⊥ := le_rfl +| (s : nonempty_interval α) := s.length_nonneg +@[simp] lemma length_pure : (pure a).length = 0 := nonempty_interval.length_pure _ +@[simp] lemma length_zero : (0 : interval α).length = 0 := length_pure _ +@[simp] lemma length_neg : ∀ s : interval α, (-s).length = s.length +| ⊥ := rfl +| (s : nonempty_interval α) := s.length_neg +lemma length_add_le : ∀ s t : interval α, (s + t).length ≤ s.length + t.length +| ⊥ _ := by simp +| _ ⊥ := by simp +| (s : nonempty_interval α) (t : nonempty_interval α) := (s.length_add t).le +lemma length_sub_le : (s - t).length ≤ s.length + t.length := +by simpa [sub_eq_add_neg] using length_add_le s (-t) + +lemma length_sum_le (f : ι → interval α) (s : finset ι) : + (∑ i in s, f i).length ≤ ∑ i in s, (f i).length := +finset.le_sum_of_subadditive _ length_zero length_add_le _ _ + +end interval +end length + +namespace tactic +open positivity + +/-- Extension for the `positivity` tactic: The length of an interval is always nonnegative. -/ +@[positivity] +meta def positivity_interval_length : expr → tactic strictness +| `(nonempty_interval.length %%s) := nonnegative <$> mk_app `nonempty_interval.length_nonneg [s] +| `(interval.length %%s) := nonnegative <$> mk_app `interval.length_nonneg [s] +| e := pp e >>= fail ∘ format.bracket "The expression `" + "` isn't of the form `nonempty_interval.length s` or `interval.length s`" + +end tactic diff --git a/src/algebra/order/invertible.lean b/src/algebra/order/invertible.lean index afdc5e4dd870d..a6d6d8b08736c 100644 --- a/src/algebra/order/invertible.lean +++ b/src/algebra/order/invertible.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury G. Kudryashov -/ -import algebra.order.ring +import algebra.order.ring.defs import algebra.invertible /-! # Lemmas about `inv_of` in ordered (semi)rings. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ variables {α : Type*} [linear_ordered_semiring α] {a : α} @@ -15,7 +18,7 @@ variables {α : Type*} [linear_ordered_semiring α] {a : α} @[simp] lemma inv_of_pos [invertible a] : 0 < ⅟a ↔ 0 < a := begin have : 0 < a * ⅟a, by simp only [mul_inv_of_self, zero_lt_one], - exact ⟨λ h, pos_of_mul_pos_right this h.le, λ h, pos_of_mul_pos_left this h.le⟩ + exact ⟨λ h, pos_of_mul_pos_left this h.le, λ h, pos_of_mul_pos_right this h.le⟩ end @[simp] lemma inv_of_nonpos [invertible a] : ⅟a ≤ 0 ↔ a ≤ 0 := @@ -24,7 +27,7 @@ by simp only [← not_lt, inv_of_pos] @[simp] lemma inv_of_nonneg [invertible a] : 0 ≤ ⅟a ↔ 0 ≤ a := begin have : 0 < a * ⅟a, by simp only [mul_inv_of_self, zero_lt_one], - exact ⟨λ h, (pos_of_mul_pos_right this h).le, λ h, (pos_of_mul_pos_left this h).le⟩ + exact ⟨λ h, (pos_of_mul_pos_left this h).le, λ h, (pos_of_mul_pos_right this h).le⟩ end @[simp] lemma inv_of_lt_zero [invertible a] : ⅟a < 0 ↔ a < 0 := @@ -32,4 +35,4 @@ by simp only [← not_le, inv_of_nonneg] @[simp] lemma inv_of_le_one [invertible a] (h : 1 ≤ a) : ⅟a ≤ 1 := by haveI := @linear_order.decidable_le α _; exact -mul_inv_of_self a ▸ decidable.le_mul_of_one_le_left (inv_of_nonneg.2 $ zero_le_one.trans h) h +mul_inv_of_self a ▸ le_mul_of_one_le_left (inv_of_nonneg.2 $ zero_le_one.trans h) h diff --git a/src/algebra/order/kleene.lean b/src/algebra/order/kleene.lean new file mode 100644 index 0000000000000..ed2ef7a143c8e --- /dev/null +++ b/src/algebra/order/kleene.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2022 Siddhartha Prasad, Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Siddhartha Prasad, Yaël Dillies +-/ +import algebra.order.ring.canonical +import algebra.ring.pi +import algebra.ring.prod +import order.hom.complete_lattice + +/-! +# Kleene Algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines idempotent semirings and Kleene algebras, which are used extensively in the theory +of computation. + +An idempotent semiring is a semiring whose addition is idempotent. An idempotent semiring is +naturally a semilattice by setting `a ≤ b` if `a + b = b`. + +A Kleene algebra is an idempotent semiring equipped with an additional unary operator `∗`, the +Kleene star. + +## Main declarations + +* `idem_semiring`: Idempotent semiring +* `idem_comm_semiring`: Idempotent commutative semiring +* `kleene_algebra`: Kleene algebra + +## Notation + +`a∗` is notation for `kstar a` in locale `computability`. + +## References + +* [D. Kozen, *A completeness theorem for Kleene algebras and the algebra of regular events*] + [kozen1994] +* https://planetmath.org/idempotentsemiring +* https://encyclopediaofmath.org/wiki/Idempotent_semi-ring +* https://planetmath.org/kleene_algebra + +## TODO + +Instances for `add_opposite`, `mul_opposite`, `ulift`, `subsemiring`, `subring`, `subalgebra`. + +## Tags + +kleene algebra, idempotent semiring +-/ + +set_option old_structure_cmd true + +open function + +universe u +variables {α β ι : Type*} {π : ι → Type*} + +/-- An idempotent semiring is a semiring with the additional property that addition is idempotent. +-/ +@[protect_proj] +class idem_semiring (α : Type u) extends semiring α, semilattice_sup α := +(sup := (+)) +(add_eq_sup : ∀ a b : α, a + b = a ⊔ b . try_refl_tac) +(bot : α := 0) +(bot_le : ∀ a, bot ≤ a) + +/-- An idempotent commutative semiring is a commutative semiring with the additional property that +addition is idempotent. -/ +@[protect_proj] +class idem_comm_semiring (α : Type u) extends comm_semiring α, idem_semiring α + +/-- Notation typeclass for the Kleene star `∗`. -/ +@[protect_proj] +class has_kstar (α : Type*) := +(kstar : α → α) + +localized "postfix `∗`:1025 := has_kstar.kstar" in computability + +/-- A Kleene Algebra is an idempotent semiring with an additional unary operator `kstar` (for Kleene +star) that satisfies the following properties: +* `1 + a * a∗ ≤ a∗` +* `1 + a∗ * a ≤ a∗` +* If `a * c + b ≤ c`, then `a∗ * b ≤ c` +* If `c * a + b ≤ c`, then `b * a∗ ≤ c` +-/ +@[protect_proj] +class kleene_algebra (α : Type*) extends idem_semiring α, has_kstar α := +(one_le_kstar : ∀ a : α, 1 ≤ a∗) +(mul_kstar_le_kstar : ∀ a : α, a * a∗ ≤ a∗) +(kstar_mul_le_kstar : ∀ a : α, a∗ * a ≤ a∗) +(mul_kstar_le_self : ∀ a b : α, b * a ≤ b → b * a∗ ≤ b) +(kstar_mul_le_self : ∀ a b : α, a * b ≤ b → a∗ * b ≤ b) + +@[priority 100] -- See note [lower instance priority] +instance idem_semiring.to_order_bot [idem_semiring α] : order_bot α := { ..‹idem_semiring α› } + +/-- Construct an idempotent semiring from an idempotent addition. -/ +@[reducible] -- See note [reducible non-instances] +def idem_semiring.of_semiring [semiring α] (h : ∀ a : α, a + a = a) : idem_semiring α := +{ le := λ a b, a + b = b, + le_refl := h, + le_trans := λ a b c (hab : _ = _) (hbc : _ = _), by { change _ = _, rw [←hbc, ←add_assoc, hab] }, + le_antisymm := λ a b (hab : _ = _) (hba : _ = _), by rwa [←hba, add_comm], + sup := (+), + le_sup_left := λ a b, by { change _ = _, rw [←add_assoc, h] }, + le_sup_right := λ a b, by { change _ = _, rw [add_comm, add_assoc, h] }, + sup_le := λ a b c hab (hbc : _ = _), by { change _ = _, rwa [add_assoc, hbc] }, + bot := 0, + bot_le := zero_add, + ..‹semiring α› } + +section idem_semiring +variables [idem_semiring α] {a b c : α} + +@[simp] lemma add_eq_sup (a b : α) : a + b = a ⊔ b := idem_semiring.add_eq_sup _ _ +lemma add_idem (a : α) : a + a = a := by simp + +lemma nsmul_eq_self : ∀ {n : ℕ} (hn : n ≠ 0) (a : α), n • a = a +| 0 h := (h rfl).elim +| 1 h := one_nsmul +| (n + 2) h := λ a, by rw [succ_nsmul, nsmul_eq_self n.succ_ne_zero, add_idem] + +lemma add_eq_left_iff_le : a + b = a ↔ b ≤ a := by simp +lemma add_eq_right_iff_le : a + b = b ↔ a ≤ b := by simp + +alias add_eq_left_iff_le ↔ _ has_le.le.add_eq_left +alias add_eq_right_iff_le ↔ _ has_le.le.add_eq_right + +lemma add_le_iff : a + b ≤ c ↔ a ≤ c ∧ b ≤ c := by simp +lemma add_le (ha : a ≤ c) (hb : b ≤ c) : a + b ≤ c := add_le_iff.2 ⟨ha, hb⟩ + +@[priority 100] -- See note [lower instance priority] +instance idem_semiring.to_canonically_ordered_add_monoid : canonically_ordered_add_monoid α := +{ add_le_add_left := λ a b hbc c, by { simp_rw add_eq_sup, exact sup_le_sup_left hbc _ }, + exists_add_of_le := λ a b h, ⟨b, h.add_eq_right.symm⟩, + le_self_add := λ a b, add_eq_right_iff_le.1 $ by rw [←add_assoc, add_idem], + ..‹idem_semiring α› } + +@[priority 100] -- See note [lower instance priority] +instance idem_semiring.to_covariant_class_mul_le : covariant_class α α (*) (≤) := +⟨λ a b c hbc, add_eq_left_iff_le.1 $ by rw [←mul_add, hbc.add_eq_left]⟩ + +@[priority 100] -- See note [lower instance priority] +instance idem_semiring.to_covariant_class_swap_mul_le : covariant_class α α (swap (*)) (≤) := +⟨λ a b c hbc, add_eq_left_iff_le.1 $ by rw [←add_mul, hbc.add_eq_left]⟩ + +end idem_semiring + +section kleene_algebra +variables [kleene_algebra α] {a b c : α} + +@[simp] lemma one_le_kstar : 1 ≤ a∗ := kleene_algebra.one_le_kstar _ +lemma mul_kstar_le_kstar : a * a∗ ≤ a∗ := kleene_algebra.mul_kstar_le_kstar _ +lemma kstar_mul_le_kstar : a∗ * a ≤ a∗ := kleene_algebra.kstar_mul_le_kstar _ +lemma mul_kstar_le_self : b * a ≤ b → b * a∗ ≤ b := kleene_algebra.mul_kstar_le_self _ _ +lemma kstar_mul_le_self : a * b ≤ b → a∗ * b ≤ b := kleene_algebra.kstar_mul_le_self _ _ + +lemma mul_kstar_le (hb : b ≤ c) (ha : c * a ≤ c) : b * a∗ ≤ c := +(mul_le_mul_right' hb _).trans $ mul_kstar_le_self ha + +lemma kstar_mul_le (hb : b ≤ c) (ha : a * c ≤ c) : a∗ * b ≤ c := +(mul_le_mul_left' hb _).trans $ kstar_mul_le_self ha + +lemma kstar_le_of_mul_le_left (hb : 1 ≤ b) : b * a ≤ b → a∗ ≤ b := by simpa using mul_kstar_le hb +lemma kstar_le_of_mul_le_right (hb : 1 ≤ b) : a * b ≤ b → a∗ ≤ b := by simpa using kstar_mul_le hb + +@[simp] lemma le_kstar : a ≤ a∗ := le_trans (le_mul_of_one_le_left' one_le_kstar) kstar_mul_le_kstar + +@[mono] lemma kstar_mono : monotone (has_kstar.kstar : α → α) := +λ a b h, kstar_le_of_mul_le_left one_le_kstar $ kstar_mul_le (h.trans le_kstar) $ + mul_kstar_le_kstar + +@[simp] lemma kstar_eq_one : a∗ = 1 ↔ a ≤ 1 := +⟨le_kstar.trans_eq, λ h, one_le_kstar.antisymm' $ kstar_le_of_mul_le_left le_rfl $ by rwa one_mul⟩ + +@[simp] lemma kstar_zero : (0 : α)∗ = 1 := kstar_eq_one.2 zero_le_one +@[simp] lemma kstar_one : (1 : α)∗ = 1 := kstar_eq_one.2 le_rfl + +@[simp] lemma kstar_mul_kstar (a : α) : a∗ * a∗ = a∗ := +(mul_kstar_le le_rfl $ kstar_mul_le_kstar).antisymm $ le_mul_of_one_le_left' one_le_kstar + +@[simp] lemma kstar_eq_self : a∗ = a ↔ a * a = a ∧ 1 ≤ a := +⟨λ h, ⟨by rw [←h, kstar_mul_kstar], one_le_kstar.trans_eq h⟩, λ h, + (kstar_le_of_mul_le_left h.2 h.1.le).antisymm le_kstar⟩ + +@[simp] lemma kstar_idem (a : α) : a∗∗ = a∗ := kstar_eq_self.2 ⟨kstar_mul_kstar _, one_le_kstar⟩ + +@[simp] lemma pow_le_kstar : ∀ {n : ℕ}, a ^ n ≤ a∗ +| 0 := (pow_zero _).trans_le one_le_kstar +| (n + 1) := by {rw pow_succ, exact (mul_le_mul_left' pow_le_kstar _).trans mul_kstar_le_kstar } + +end kleene_algebra + +namespace prod + +instance [idem_semiring α] [idem_semiring β] : idem_semiring (α × β) := +{ add_eq_sup := λ a b, ext (add_eq_sup _ _) (add_eq_sup _ _), + ..prod.semiring, ..prod.semilattice_sup _ _, ..prod.order_bot _ _ } + +instance [idem_comm_semiring α] [idem_comm_semiring β] : idem_comm_semiring (α × β) := +{ ..prod.comm_semiring, ..prod.idem_semiring } + +variables [kleene_algebra α] [kleene_algebra β] + +instance : kleene_algebra (α × β) := +{ kstar := λ a, (a.1∗, a.2∗), + one_le_kstar := λ a, ⟨one_le_kstar, one_le_kstar⟩, + mul_kstar_le_kstar := λ a, ⟨mul_kstar_le_kstar, mul_kstar_le_kstar⟩, + kstar_mul_le_kstar := λ a, ⟨kstar_mul_le_kstar, kstar_mul_le_kstar⟩, + mul_kstar_le_self := λ a b, and.imp mul_kstar_le_self mul_kstar_le_self, + kstar_mul_le_self := λ a b, and.imp kstar_mul_le_self kstar_mul_le_self, + ..prod.idem_semiring } + +lemma kstar_def (a : α × β) : a∗ = (a.1∗, a.2∗) := rfl +@[simp] lemma fst_kstar (a : α × β) : a∗.1 = a.1∗ := rfl +@[simp] lemma snd_kstar (a : α × β) : a∗.2 = a.2∗ := rfl + +end prod + +namespace pi + +instance [Π i, idem_semiring (π i)] : idem_semiring (Π i, π i) := +{ add_eq_sup := λ a b, funext $ λ i, add_eq_sup _ _, + ..pi.semiring, ..pi.semilattice_sup, ..pi.order_bot } + +instance [Π i, idem_comm_semiring (π i)] : idem_comm_semiring (Π i, π i) := +{ ..pi.comm_semiring, ..pi.idem_semiring } + +variables [Π i, kleene_algebra (π i)] + +instance : kleene_algebra (Π i, π i) := +{ kstar := λ a i, (a i)∗, + one_le_kstar := λ a i, one_le_kstar, + mul_kstar_le_kstar := λ a i, mul_kstar_le_kstar, + kstar_mul_le_kstar := λ a i, kstar_mul_le_kstar, + mul_kstar_le_self := λ a b h i, mul_kstar_le_self $ h _, + kstar_mul_le_self := λ a b h i, kstar_mul_le_self $ h _, + ..pi.idem_semiring } + +lemma kstar_def (a : Π i, π i) : a∗ = λ i, (a i)∗ := rfl +@[simp] lemma kstar_apply (a : Π i, π i) (i : ι) : a∗ i = (a i)∗ := rfl + +end pi + +namespace function.injective + +/-- Pullback an `idem_semiring` instance along an injective function. -/ +@[reducible] -- See note [reducible non-instances] +protected def idem_semiring [idem_semiring α] [has_zero β] [has_one β] [has_add β] [has_mul β] + [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] [has_sup β] [has_bot β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (bot : f ⊥ = ⊥) : + idem_semiring β := +{ add_eq_sup := λ a b, hf $ by erw [sup, add, add_eq_sup], + bot := ⊥, + bot_le := λ a, bot.trans_le $ @bot_le _ _ _ $ f a, + ..hf.semiring f zero one add mul nsmul npow nat_cast, ..hf.semilattice_sup _ sup, ..‹has_bot β› } + +/-- Pullback an `idem_comm_semiring` instance along an injective function. -/ +@[reducible] -- See note [reducible non-instances] +protected def idem_comm_semiring [idem_comm_semiring α] [has_zero β] [has_one β] [has_add β] + [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] [has_sup β] [has_bot β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (bot : f ⊥ = ⊥) : + idem_comm_semiring β := +{ ..hf.comm_semiring f zero one add mul nsmul npow nat_cast, + ..hf.idem_semiring f zero one add mul nsmul npow nat_cast sup bot } + +/-- Pullback an `idem_comm_semiring` instance along an injective function. -/ +@[reducible] -- See note [reducible non-instances] +protected def kleene_algebra [kleene_algebra α] [has_zero β] [has_one β] [has_add β] + [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] [has_sup β] [has_bot β] [has_kstar β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (bot : f ⊥ = ⊥) + (kstar : ∀ a, f a∗ = (f a)∗) : + kleene_algebra β := +{ one_le_kstar := λ a, one.trans_le $ by { erw kstar, exact one_le_kstar }, + mul_kstar_le_kstar := λ a, by { change f _ ≤ _, erw [mul, kstar], exact mul_kstar_le_kstar }, + kstar_mul_le_kstar := λ a, by { change f _ ≤ _, erw [mul, kstar], exact kstar_mul_le_kstar }, + mul_kstar_le_self := λ a b (h : f _ ≤ _), + by { change f _ ≤ _, erw [mul, kstar], erw mul at h, exact mul_kstar_le_self h }, + kstar_mul_le_self := λ a b (h : f _ ≤ _), + by { change f _ ≤ _, erw [mul, kstar], erw mul at h, exact kstar_mul_le_self h }, + ..hf.idem_semiring f zero one add mul nsmul npow nat_cast sup bot, ..‹has_kstar β› } + +end function.injective diff --git a/src/algebra/order/lattice_group.lean b/src/algebra/order/lattice_group.lean index 7ba2adf41dc60..47482f0e26494 100644 --- a/src/algebra/order/lattice_group.lean +++ b/src/algebra/order/lattice_group.lean @@ -4,12 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Christopher Hoskin -/ import algebra.group_power.basic -- Needed for squares -import algebra.order.group +import algebra.order.group.abs import tactic.nth_rewrite +import order.closure + /-! # Lattice ordered groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Lattice ordered groups were introduced by [Birkhoff][birkhoff1942]. They form the algebraic underpinnings of vector lattices, Banach lattices, AL-space, AM-space etc. @@ -29,7 +34,7 @@ number of equations and inequalities. - `a⁺ = a ⊔ 0`: The *positive component* of an element `a` of a lattice ordered commutative group - `a⁻ = (-a) ⊔ 0`: The *negative component* of an element `a` of a lattice ordered commutative group -* `|a| = a⊔(-a)`: The *absolute value* of an element `a` of a lattice ordered commutative group +- `|a| = a⊔(-a)`: The *absolute value* of an element `a` of a lattice ordered commutative group ## Implementation notes @@ -59,58 +64,43 @@ lattice, ordered, group universe u --- A linearly ordered additive commutative group is a lattice ordered commutative group -@[priority 100, to_additive] -- see Note [lower instance priority] -instance linear_ordered_comm_group.to_covariant_class (α : Type u) - [linear_ordered_comm_group α] : covariant_class α α (*) (≤) := -{ elim := λ a b c bc, linear_ordered_comm_group.mul_le_mul_left _ _ bc a } - variables {α : Type u} [lattice α] [comm_group α] -- Special case of Bourbaki A.VI.9 (1) -- c + (a ⊔ b) = (c + a) ⊔ (c + b) @[to_additive] lemma mul_sup [covariant_class α α (*) (≤)] (a b c : α) : c * (a ⊔ b) = (c * a) ⊔ (c * b) := -begin - refine le_antisymm _ (by simp), - rw [← mul_le_mul_iff_left (c⁻¹), ← mul_assoc, inv_mul_self, one_mul], - exact sup_le (by simp) (by simp), -end +(order_iso.mul_left _).map_sup _ _ + +@[to_additive] +lemma sup_mul [covariant_class α α (*) (≤)] (a b c : α) : (a ⊔ b) * c = (a * c) ⊔ (b * c) := +(order_iso.mul_right _).map_sup _ _ @[to_additive] lemma mul_inf [covariant_class α α (*) (≤)] (a b c : α) : c * (a ⊓ b) = (c * a) ⊓ (c * b) := -begin - refine le_antisymm (by simp) _, - rw [← mul_le_mul_iff_left (c⁻¹), ← mul_assoc, inv_mul_self, one_mul], - exact le_inf (by simp) (by simp), -end +(order_iso.mul_left _).map_inf _ _ + +@[to_additive] +lemma inf_mul [covariant_class α α (*) (≤)] (a b c : α) : (a ⊓ b) * c = (a * c) ⊓ (b * c) := +(order_iso.mul_right _).map_inf _ _ -- Special case of Bourbaki A.VI.9 (2) -- -(a ⊔ b)=(-a) ⊓ (-b) @[to_additive] lemma inv_sup_eq_inv_inf_inv [covariant_class α α (*) (≤)] (a b : α) : (a ⊔ b)⁻¹ = a⁻¹ ⊓ b⁻¹ := -begin - apply le_antisymm, - { refine le_inf _ _, - { rw inv_le_inv_iff, exact le_sup_left, }, - { rw inv_le_inv_iff, exact le_sup_right, } }, - { rw [← inv_le_inv_iff, inv_inv], - refine sup_le _ _, - { rw ← inv_le_inv_iff, simp, }, - { rw ← inv_le_inv_iff, simp, } } -end +(order_iso.inv α).map_sup _ _ -- -(a ⊓ b) = -a ⊔ -b @[to_additive] lemma inv_inf_eq_sup_inv [covariant_class α α (*) (≤)] (a b : α) : (a ⊓ b)⁻¹ = a⁻¹ ⊔ b⁻¹ := -by rw [← inv_inv (a⁻¹ ⊔ b⁻¹), inv_sup_eq_inv_inf_inv a⁻¹ b⁻¹, inv_inv, inv_inv] +(order_iso.inv α).map_inf _ _ -- Bourbaki A.VI.10 Prop 7 -- a ⊓ b + (a ⊔ b) = a + b @[to_additive] lemma inf_mul_sup [covariant_class α α (*) (≤)] (a b : α) : (a ⊓ b) * (a ⊔ b) = a * b := calc (a ⊓ b) * (a ⊔ b) = (a ⊓ b) * ((a * b) * (b⁻¹ ⊔ a⁻¹)) : - by { rw mul_sup b⁻¹ a⁻¹ (a * b), simp, } + by rw [mul_sup b⁻¹ a⁻¹ (a * b), mul_inv_cancel_right, mul_inv_cancel_comm] ... = (a ⊓ b) * ((a * b) * (a ⊓ b)⁻¹) : by rw [inv_inf_eq_sup_inv, sup_comm] ... = a * b : by rw [mul_comm, inv_mul_cancel_right] @@ -148,12 +138,12 @@ lemma m_neg_part_def (a : α) : a⁻ = a⁻¹ ⊔ 1 := rfl lemma pos_one : (1 : α)⁺ = 1 := sup_idem @[simp, to_additive] -lemma neg_one : (1 : α)⁻ = 1 := by rw [m_neg_part_def, one_inv, sup_idem] +lemma neg_one : (1 : α)⁻ = 1 := by rw [m_neg_part_def, inv_one, sup_idem] -- a⁻ = -(a ⊓ 0) @[to_additive] lemma neg_eq_inv_inf_one [covariant_class α α (*) (≤)] (a : α) : a⁻ = (a ⊓ 1)⁻¹ := -by rw [m_neg_part_def, ← inv_inj, inv_sup_eq_inv_inf_inv, inv_inv, inv_inv, one_inv] +by rw [m_neg_part_def, ← inv_inj, inv_sup_eq_inv_inf_inv, inv_inv, inv_inv, inv_one] @[to_additive le_abs] lemma le_mabs (a : α) : a ≤ |a| := le_sup_left @@ -172,23 +162,18 @@ lemma one_le_neg (a : α) : 1 ≤ a⁻ := le_sup_right @[to_additive] -- pos_nonpos_iff lemma pos_le_one_iff {a : α} : a⁺ ≤ 1 ↔ a ≤ 1 := -by { rw [m_pos_part_def, sup_le_iff], simp, } +by rw [m_pos_part_def, sup_le_iff, and_iff_left le_rfl] @[to_additive] -- neg_nonpos_iff lemma neg_le_one_iff {a : α} : a⁻ ≤ 1 ↔ a⁻¹ ≤ 1 := -by { rw [m_neg_part_def, sup_le_iff], simp, } - -@[to_additive] -lemma pos_eq_one_iff {a : α} : a⁺ = 1 ↔ a ≤ 1 := -by { rw le_antisymm_iff, simp only [one_le_pos, and_true], exact pos_le_one_iff, } +by rw [m_neg_part_def, sup_le_iff, and_iff_left le_rfl] -@[to_additive] -lemma neg_eq_one_iff' {a : α} : a⁻ = 1 ↔ a⁻¹ ≤ 1 := -by { rw le_antisymm_iff, simp only [one_le_neg, and_true], rw neg_le_one_iff, } +@[to_additive] lemma pos_eq_one_iff {a : α} : a⁺ = 1 ↔ a ≤ 1 := sup_eq_right +@[to_additive] lemma neg_eq_one_iff' {a : α} : a⁻ = 1 ↔ a⁻¹ ≤ 1 := sup_eq_right @[to_additive] lemma neg_eq_one_iff [covariant_class α α has_mul.mul has_le.le] {a : α} : a⁻ = 1 ↔ 1 ≤ a := -by { rw le_antisymm_iff, simp only [one_le_neg, and_true], rw [neg_le_one_iff, inv_le_one'], } +by rw [le_antisymm_iff, neg_le_one_iff, inv_le_one', and_iff_left (one_le_neg _)] @[to_additive le_pos] lemma m_le_pos (a : α) : a ≤ a⁺ := le_sup_left @@ -204,18 +189,7 @@ lemma neg_eq_pos_inv (a : α) : a⁻ = (a⁻¹)⁺ := rfl -- a⁺ = (-a)⁻ @[to_additive] -lemma pos_eq_neg_inv (a : α) : a⁺ = (a⁻¹)⁻ := by simp [neg_eq_pos_inv] - --- We use this in Bourbaki A.VI.12 Prop 9 a) --- c + (a ⊓ b) = (c + a) ⊓ (c + b) -@[to_additive] -lemma mul_inf_eq_mul_inf_mul [covariant_class α α (*) (≤)] - (a b c : α) : c * (a ⊓ b) = (c * a) ⊓ (c * b) := -begin - refine le_antisymm (by simp) _, - rw [← mul_le_mul_iff_left c⁻¹, ← mul_assoc, inv_mul_self, one_mul, le_inf_iff], - simp, -end +lemma pos_eq_neg_inv (a : α) : a⁺ = (a⁻¹)⁻ := by rw [neg_eq_pos_inv, inv_inv] -- Bourbaki A.VI.12 Prop 9 a) -- a = a⁺ - a⁻ @@ -232,7 +206,7 @@ end -- a⁺ ⊓ a⁻ = 0 (`a⁺` and `a⁻` are co-prime, and, since they are positive, disjoint) @[to_additive] lemma pos_inf_neg_eq_one [covariant_class α α (*) (≤)] (a : α) : a⁺ ⊓ a⁻ = 1 := -by rw [←mul_right_inj (a⁻)⁻¹, mul_inf_eq_mul_inf_mul, mul_one, mul_left_inv, mul_comm, +by rw [←mul_right_inj (a⁻)⁻¹, mul_inf, mul_one, mul_left_inv, mul_comm, ← div_eq_mul_inv, pos_div_neg, neg_eq_inv_inf_one, inv_inv] -- Bourbaki A.VI.12 (with a and b swapped) @@ -249,11 +223,11 @@ calc a ⊔ b = (b * (a / b)) ⊔ (b * 1) : by rw [mul_one b, div_eq_mul_inv, mul lemma inf_eq_div_pos_div [covariant_class α α (*) (≤)] (a b : α) : a ⊓ b = a / (a / b)⁺ := calc a ⊓ b = (a * 1) ⊓ (a * (b / a)) : by { rw [mul_one a, div_eq_mul_inv, mul_comm b, mul_inv_cancel_left], } -... = a * (1 ⊓ (b / a)) : by rw ← mul_inf_eq_mul_inf_mul 1 (b / a) a +... = a * (1 ⊓ (b / a)) : by rw ← mul_inf 1 (b / a) a ... = a * ((b / a) ⊓ 1) : by rw inf_comm ... = a * ((a / b)⁻¹ ⊓ 1) : by { rw div_eq_mul_inv, nth_rewrite 0 ← inv_inv b, rw [← mul_inv, mul_comm b⁻¹, ← div_eq_mul_inv], } -... = a * ((a / b)⁻¹ ⊓ 1⁻¹) : by rw one_inv +... = a * ((a / b)⁻¹ ⊓ 1⁻¹) : by rw inv_one ... = a / ((a / b) ⊔ 1) : by rw [← inv_sup_eq_inv_inf_inv, ← div_eq_mul_inv] -- Bourbaki A.VI.12 Prop 9 c) @@ -295,35 +269,22 @@ end lemma one_le_abs [covariant_class α α (*) (≤)] (a : α) : 1 ≤ |a| := by { rw ← m_pos_abs, exact one_le_pos _, } --- The proof from Bourbaki A.VI.12 Prop 9 d) -- |a| = a⁺ - a⁻ @[to_additive] lemma pos_mul_neg [covariant_class α α (*) (≤)] (a : α) : |a| = a⁺ * a⁻ := begin - refine le_antisymm _ _, - { refine sup_le _ _, - { nth_rewrite 0 ← mul_one a, - exact mul_le_mul' (m_le_pos a) (one_le_neg a) }, - { nth_rewrite 0 ← one_mul (a⁻¹), - exact mul_le_mul' (one_le_pos a) (inv_le_neg a) } }, - { rw [← inf_mul_sup, pos_inf_neg_eq_one, one_mul, ← m_pos_abs a], - apply sup_le, - { exact ((m_le_iff_pos_le_neg_ge _ _).mp (le_mabs a)).left, }, - { rw neg_eq_pos_inv, - exact ((m_le_iff_pos_le_neg_ge _ _).mp (inv_le_abs a)).left, }, } + rw [m_pos_part_def, sup_mul, one_mul, m_neg_part_def, mul_sup, mul_one, mul_inv_self, sup_assoc, + ←@sup_assoc _ _ a, sup_eq_right.2 le_sup_right], + exact (sup_eq_left.2 $ one_le_abs a).symm, end -- a ⊔ b - (a ⊓ b) = |b - a| @[to_additive] lemma sup_div_inf_eq_abs_div [covariant_class α α (*) (≤)] (a b : α) : - (a ⊔ b) / (a ⊓ b) = |b / a| := -begin - rw [sup_eq_mul_pos_div, inf_comm, inf_eq_div_pos_div, div_eq_mul_inv], - nth_rewrite 1 div_eq_mul_inv, - rw [mul_inv_rev, inv_inv, mul_comm, ← mul_assoc, inv_mul_cancel_right, pos_eq_neg_inv (a / b)], - nth_rewrite 1 div_eq_mul_inv, - rw [mul_inv_rev, ← div_eq_mul_inv, inv_inv, ← pos_mul_neg], -end + (a ⊔ b) / (a ⊓ b) = |b / a| := by +rw [sup_eq_mul_pos_div, inf_comm, inf_eq_div_pos_div, div_eq_mul_inv, div_eq_mul_inv b ((b / a)⁺), + mul_inv_rev, inv_inv, mul_comm, ← mul_assoc, inv_mul_cancel_right, pos_eq_neg_inv (a / b), + div_eq_mul_inv a b, mul_inv_rev, ← div_eq_mul_inv, inv_inv, ← pos_mul_neg] -- 2•(a ⊔ b) = a + b + |b - a| @[to_additive two_sup_eq_add_add_abs_sub] @@ -376,12 +337,9 @@ begin ((b ⊔ c ⊔ (a ⊔ c)) / ((b ⊔ c) ⊓ (a ⊔ c))) * |(a ⊓ c) / (b ⊓ c)| : by rw sup_div_inf_eq_abs_div ... = (b ⊔ c ⊔ (a ⊔ c)) / ((b ⊔ c) ⊓ (a ⊔ c)) * (((b ⊓ c) ⊔ (a ⊓ c)) / ((b ⊓ c) ⊓ (a ⊓ c))) : by rw sup_div_inf_eq_abs_div (b ⊓ c) (a ⊓ c) - ... = (b ⊔ a ⊔ c) / ((b ⊓ a) ⊔ c) * (((b ⊔ a) ⊓ c) / (b ⊓ a ⊓ c)) : by - { rw [← sup_inf_right, ← inf_sup_right, sup_assoc], - nth_rewrite 1 sup_comm, - rw [sup_right_idem, sup_assoc, inf_assoc], - nth_rewrite 3 inf_comm, - rw [inf_right_idem, inf_assoc], } + ... = (b ⊔ a ⊔ c) / ((b ⊓ a) ⊔ c) * (((b ⊔ a) ⊓ c) / (b ⊓ a ⊓ c)) : + by rw [← sup_inf_right, ← inf_sup_right, sup_assoc, @sup_comm _ _ c (a⊔c), sup_right_idem, + sup_assoc, inf_assoc, @inf_comm _ _ c (a⊓c), inf_right_idem, inf_assoc] ... = (b ⊔ a ⊔ c) * ((b ⊔ a) ⊓ c) /(((b ⊓ a) ⊔ c) * (b ⊓ a ⊓ c)) : by rw div_mul_div_comm ... = (b ⊔ a) * c / ((b ⊓ a) * c) : by rw [mul_comm, inf_mul_sup, mul_comm (b ⊓ a ⊔ c), inf_mul_sup] @@ -395,6 +353,15 @@ end lemma pos_of_one_le (a : α) (h : 1 ≤ a) : a⁺ = a := by { rw m_pos_part_def, exact sup_of_le_left h, } +@[to_additive] -- pos_eq_self_of_pos_pos +lemma pos_eq_self_of_one_lt_pos {α} [linear_order α] [comm_group α] + {x : α} (hx : 1 < x⁺) : x⁺ = x := +begin + rw [m_pos_part_def, right_lt_sup, not_le] at hx, + rw [m_pos_part_def, sup_eq_left], + exact hx.le +end + -- 0 ≤ a implies a⁺ = a @[to_additive] -- pos_of_nonpos lemma pos_of_le_one (a : α) (h : a ≤ 1) : a⁺ = 1 := @@ -410,7 +377,7 @@ neg_eq_one_iff'.mpr h @[to_additive] -- neg_of_nonpos lemma neg_of_le_one [covariant_class α α (*) (≤)] (a : α) (h : a ≤ 1) : a⁻ = a⁻¹ := -by { refine neg_of_one_le_inv _ _, rw one_le_inv', exact h, } +sup_eq_left.2 $ one_le_inv'.2 h @[to_additive] -- neg_of_nonneg' lemma neg_of_one_le [covariant_class α α (*) (≤)] (a : α) (h : 1 ≤ a) : a⁻ = 1 := @@ -419,13 +386,7 @@ neg_eq_one_iff.mpr h -- 0 ≤ a implies |a| = a @[to_additive abs_of_nonneg] lemma mabs_of_one_le [covariant_class α α (*) (≤)] (a : α) (h : 1 ≤ a) : |a| = a := -begin - unfold has_abs.abs, - rw [sup_eq_mul_pos_div, div_eq_mul_inv, inv_inv, ← pow_two, inv_mul_eq_iff_eq_mul, - ← pow_two, pos_of_one_le], - rw pow_two, - apply one_le_mul h h, -end +sup_eq_left.2 $ left.inv_le_self h /-- The unary operation of taking the absolute value is idempotent. -/ @[simp, to_additive abs_abs "The unary operation of taking the absolute value is idempotent."] @@ -462,7 +423,7 @@ sup_le (mabs_sup_div_sup_le_mabs a b c) (mabs_inf_div_inf_le_mabs a b c) /-- The absolute value satisfies the triangle inequality. -/ -@[to_additive abs_add_le] +@[to_additive abs_add_le "The absolute value satisfies the triangle inequality."] lemma mabs_mul_le [covariant_class α α (*) (≤)] (a b : α) : |a * b| ≤ |a| * |b| := begin apply sup_le, @@ -476,26 +437,45 @@ end lemma abs_inv_comm (a b : α) : |a/b| = |b/a| := begin unfold has_abs.abs, - rw [inv_div' a b, ← inv_inv (a / b), inv_div', sup_comm], + rw [inv_div a b, ← inv_inv (a / b), inv_div, sup_comm], end -- | |a| - |b| | ≤ |a - b| @[to_additive] lemma abs_abs_div_abs_le [covariant_class α α (*) (≤)] (a b : α) : | |a| / |b| | ≤ |a / b| := begin - unfold has_abs.abs, - rw sup_le_iff, + rw [abs_eq_sup_inv, sup_le_iff], split, { apply div_le_iff_le_mul.2, convert mabs_mul_le (a/b) b, - { rw div_mul_cancel', }, - { rw div_mul_cancel', }, - { exact covariant_swap_mul_le_of_covariant_mul_le α, } }, - { rw [div_eq_mul_inv, mul_inv_rev, inv_inv, mul_inv_le_iff_le_mul, ← abs_eq_sup_inv (a / b), - abs_inv_comm], + rw div_mul_cancel', + exact covariant_swap_mul_le_of_covariant_mul_le α, }, + { rw [div_eq_mul_inv, mul_inv_rev, inv_inv, mul_inv_le_iff_le_mul, abs_inv_comm], convert mabs_mul_le (b/a) a, - { rw div_mul_cancel', }, - {rw div_mul_cancel', } }, + { rw div_mul_cancel', }, }, end end lattice_ordered_comm_group + +namespace lattice_ordered_add_comm_group + +variables {β : Type u} [lattice β] [add_comm_group β] + +section solid + +/-- A subset `s ⊆ β`, with `β` an `add_comm_group` with a `lattice` structure, is solid if for +all `x ∈ s` and all `y ∈ β` such that `|y| ≤ |x|`, then `y ∈ s`. -/ +def is_solid (s : set β) : Prop := ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, |y| ≤ |x| → y ∈ s + +/-- The solid closure of a subset `s` is the smallest superset of `s` that is solid. -/ +def solid_closure (s : set β) : set β := {y | ∃ x ∈ s, |y| ≤ |x|} + +lemma is_solid_solid_closure (s : set β) : is_solid (solid_closure s) := +λ x ⟨y, hy, hxy⟩ z hzx, ⟨y, hy, hzx.trans hxy⟩ + +lemma solid_closure_min (s t : set β) (h1 : s ⊆ t) (h2 : is_solid t) : solid_closure s ⊆ t := +λ _ ⟨_, hy, hxy⟩, h2 (h1 hy) hxy + +end solid + +end lattice_ordered_add_comm_group diff --git a/src/algebra/order/module.lean b/src/algebra/order/module.lean index 6c236a59482b4..be66690ff1695 100644 --- a/src/algebra/order/module.lean +++ b/src/algebra/order/module.lean @@ -3,15 +3,14 @@ Copyright (c) 2020 Frédéric Dupuis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Frédéric Dupuis, Yaël Dillies -/ -import algebra.module.pi -import algebra.module.prod -import algebra.order.pi import algebra.order.smul -import data.set.pointwise /-! # Ordered module +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we provide lemmas about `ordered_smul` that hold once a module structure is present. ## References @@ -27,14 +26,10 @@ open_locale pointwise variables {k M N : Type*} -namespace order_dual - instance [semiring k] [ordered_add_comm_monoid M] [module k M] : module k Mᵒᵈ := { add_smul := λ r s x, order_dual.rec (add_smul _ _) x, zero_smul := λ m, order_dual.rec (zero_smul _) m } -end order_dual - section semiring variables [ordered_semiring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M] {a b : M} {c : k} @@ -107,7 +102,7 @@ end lemma smul_nonpos_of_nonpos_of_nonneg (hc : c ≤ 0) (ha : 0 ≤ a) : c • a ≤ 0 := calc c • a ≤ c • 0 : smul_le_smul_of_nonpos ha hc - ... = 0 : smul_zero' M c + ... = 0 : smul_zero c lemma smul_nonneg_of_nonpos_of_nonpos (hc : c ≤ 0) (ha : a ≤ 0) : 0 ≤ c • a := @smul_nonpos_of_nonpos_of_nonneg k Mᵒᵈ _ _ _ _ _ _ hc ha @@ -116,12 +111,46 @@ alias smul_pos_iff_of_neg ↔ _ smul_pos_of_neg_of_neg alias smul_neg_iff_of_pos ↔ _ smul_neg_of_pos_of_neg alias smul_neg_iff_of_neg ↔ _ smul_neg_of_neg_of_pos -lemma antitone_smul_left (hc : c ≤ 0) : antitone (has_scalar.smul c : M → M) := +lemma antitone_smul_left (hc : c ≤ 0) : antitone (has_smul.smul c : M → M) := λ a b h, smul_le_smul_of_nonpos h hc -lemma strict_anti_smul_left (hc : c < 0) : strict_anti (has_scalar.smul c : M → M) := +lemma strict_anti_smul_left (hc : c < 0) : strict_anti (has_smul.smul c : M → M) := λ a b h, smul_lt_smul_of_neg h hc +/-- Binary **rearrangement inequality**. -/ +lemma smul_add_smul_le_smul_add_smul [contravariant_class M M (+) (≤)] {a b : k} {c d : M} + (hab : a ≤ b) (hcd : c ≤ d) : + a • d + b • c ≤ a • c + b • d := +begin + obtain ⟨b, rfl⟩ := exists_add_of_le hab, + obtain ⟨d, rfl⟩ := exists_add_of_le hcd, + rw [smul_add, add_right_comm, smul_add, ←add_assoc, add_smul _ _ d], + rw le_add_iff_nonneg_right at hab hcd, + exact add_le_add_left (le_add_of_nonneg_right $ smul_nonneg hab hcd) _, +end + +/-- Binary **rearrangement inequality**. -/ +lemma smul_add_smul_le_smul_add_smul' [contravariant_class M M (+) (≤)] {a b : k} {c d : M} + (hba : b ≤ a) (hdc : d ≤ c) : a • d + b • c ≤ a • c + b • d := +by { rw [add_comm (a • d), add_comm (a • c)], exact smul_add_smul_le_smul_add_smul hba hdc } + +/-- Binary strict **rearrangement inequality**. -/ +lemma smul_add_smul_lt_smul_add_smul [covariant_class M M (+) (<)] [contravariant_class M M (+) (<)] + {a b : k} {c d : M} (hab : a < b) (hcd : c < d) : a • d + b • c < a • c + b • d := +begin + obtain ⟨b, rfl⟩ := exists_add_of_le hab.le, + obtain ⟨d, rfl⟩ := exists_add_of_le hcd.le, + rw [smul_add, add_right_comm, smul_add, ←add_assoc, add_smul _ _ d], + rw lt_add_iff_pos_right at hab hcd, + exact add_lt_add_left (lt_add_of_pos_right _ $ smul_pos hab hcd) _, +end + +/-- Binary strict **rearrangement inequality**. -/ +lemma smul_add_smul_lt_smul_add_smul' [covariant_class M M (+) (<)] + [contravariant_class M M (+) (<)] {a b : k} {c d : M} (hba : b < a) (hdc : d < c) : + a • d + b • c < a • c + b • d := +by { rw [add_comm (a • d), add_comm (a • c)], exact smul_add_smul_lt_smul_add_smul hba hdc } + end ring section field @@ -134,17 +163,17 @@ begin exact smul_le_smul_iff_of_pos (neg_pos_of_neg hc), end -lemma smul_lt_iff_of_neg (hc : c < 0) : c • a < b ↔ c⁻¹ • b < a := -begin - rw [←neg_neg c, ←neg_neg a, neg_smul_neg, inv_neg, neg_smul _ b, neg_lt_neg_iff], - exact smul_lt_iff_of_pos (neg_pos_of_neg hc), -end +lemma inv_smul_le_iff_of_neg (h : c < 0) : c⁻¹ • a ≤ b ↔ c • b ≤ a := +by { rw [←smul_le_smul_iff_of_neg h, smul_inv_smul₀ h.ne], apply_instance } -lemma lt_smul_iff_of_neg (hc : c < 0) : a < c • b ↔ b < c⁻¹ • a := -begin - rw [←neg_neg c, ←neg_neg b, neg_smul_neg, inv_neg, neg_smul _ a, neg_lt_neg_iff], - exact lt_smul_iff_of_pos (neg_pos_of_neg hc), -end +lemma inv_smul_lt_iff_of_neg (h : c < 0) : c⁻¹ • a < b ↔ c • b < a := +by { rw [←smul_lt_smul_iff_of_neg h, smul_inv_smul₀ h.ne], apply_instance } + +lemma smul_inv_le_iff_of_neg (h : c < 0) : a ≤ c⁻¹ • b ↔ b ≤ c • a := +by { rw [←smul_le_smul_iff_of_neg h, smul_inv_smul₀ h.ne], apply_instance } + +lemma smul_inv_lt_iff_of_neg (h : c < 0) : a < c⁻¹ • b ↔ b < c • a := +by { rw [←smul_lt_smul_iff_of_neg h, smul_inv_smul₀ h.ne], apply_instance } variables (M) @@ -156,53 +185,10 @@ variables (M) right_inv := smul_inv_smul₀ hc.ne, map_rel_iff' := λ b₁ b₂, smul_le_smul_iff_of_neg hc } -variables {M} [ordered_add_comm_group N] [module k N] [ordered_smul k N] - --- TODO: solve `prod.has_lt` and `prod.has_le` misalignment issue -instance prod.ordered_smul : ordered_smul k (M × N) := -ordered_smul.mk' $ λ (v u : M × N) (c : k) h hc, - ⟨smul_le_smul_of_nonneg h.1.1 hc.le, smul_le_smul_of_nonneg h.1.2 hc.le⟩ - -instance pi.ordered_smul {ι : Type*} {M : ι → Type*} [Π i, ordered_add_comm_group (M i)] - [Π i, mul_action_with_zero k (M i)] [∀ i, ordered_smul k (M i)] : - ordered_smul k (Π i : ι, M i) := -begin - refine (ordered_smul.mk' $ λ v u c h hc i, _), - change c • v i ≤ c • u i, - exact smul_le_smul_of_nonneg (h.le i) hc.le, -end - --- Sometimes Lean fails to apply the dependent version to non-dependent functions, --- so we define another instance -instance pi.ordered_smul' {ι : Type*} {M : Type*} [ordered_add_comm_group M] - [mul_action_with_zero k M] [ordered_smul k M] : - ordered_smul k (ι → M) := -pi.ordered_smul - end field /-! ### Upper/lower bounds -/ -section ordered_semiring -variables [ordered_semiring k] [ordered_add_comm_monoid M] [smul_with_zero k M] [ordered_smul k M] - {s : set M} {c : k} - -lemma smul_lower_bounds_subset_lower_bounds_smul (hc : 0 ≤ c) : - c • lower_bounds s ⊆ lower_bounds (c • s) := -(monotone_smul_left hc).image_lower_bounds_subset_lower_bounds_image - -lemma smul_upper_bounds_subset_upper_bounds_smul (hc : 0 ≤ c) : - c • upper_bounds s ⊆ upper_bounds (c • s) := -(monotone_smul_left hc).image_upper_bounds_subset_upper_bounds_image - -lemma bdd_below.smul_of_nonneg (hs : bdd_below s) (hc : 0 ≤ c) : bdd_below (c • s) := -(monotone_smul_left hc).map_bdd_below hs - -lemma bdd_above.smul_of_nonneg (hs : bdd_above s) (hc : 0 ≤ c) : bdd_above (c • s) := -(monotone_smul_left hc).map_bdd_above hs - -end ordered_semiring - section ordered_ring variables [ordered_ring k] [ordered_add_comm_group M] [module k M] [ordered_smul k M] {s : set M} {c : k} @@ -223,28 +209,21 @@ lemma bdd_above.smul_of_nonpos (hc : c ≤ 0) (hs : bdd_above s) : bdd_below (c end ordered_ring -section linear_ordered_field -variables [linear_ordered_field k] [ordered_add_comm_group M] - -section mul_action_with_zero -variables [mul_action_with_zero k M] [ordered_smul k M] {s t : set M} {c : k} - -@[simp] lemma lower_bounds_smul_of_pos (hc : 0 < c) : lower_bounds (c • s) = c • lower_bounds s := -(order_iso.smul_left _ hc).lower_bounds_image +section linear_ordered_ring +variables [linear_ordered_ring k] [linear_ordered_add_comm_group M] [module k M] [ordered_smul k M] + {a : k} -@[simp] lemma upper_bounds_smul_of_pos (hc : 0 < c) : upper_bounds (c • s) = c • upper_bounds s := -(order_iso.smul_left _ hc).upper_bounds_image +lemma smul_max_of_nonpos (ha : a ≤ 0) (b₁ b₂ : M) : a • max b₁ b₂ = min (a • b₁) (a • b₂) := +(antitone_smul_left ha : antitone (_ : M → M)).map_max -@[simp] lemma bdd_below_smul_iff_of_pos (hc : 0 < c) : bdd_below (c • s) ↔ bdd_below s := -(order_iso.smul_left _ hc).bdd_below_image +lemma smul_min_of_nonpos (ha : a ≤ 0) (b₁ b₂ : M) : a • min b₁ b₂ = max (a • b₁) (a • b₂) := +(antitone_smul_left ha : antitone (_ : M → M)).map_min -@[simp] lemma bdd_above_smul_iff_of_pos (hc : 0 < c) : bdd_above (c • s) ↔ bdd_above s := -(order_iso.smul_left _ hc).bdd_above_image +end linear_ordered_ring -end mul_action_with_zero - -section module -variables [module k M] [ordered_smul k M] {s t : set M} {c : k} +section linear_ordered_field +variables [linear_ordered_field k] [ordered_add_comm_group M] [module k M] [ordered_smul k M] + {s : set M} {c : k} @[simp] lemma lower_bounds_smul_of_neg (hc : c < 0) : lower_bounds (c • s) = c • upper_bounds s := (order_iso.smul_left_dual M hc).upper_bounds_image @@ -258,5 +237,4 @@ variables [module k M] [ordered_smul k M] {s t : set M} {c : k} @[simp] lemma bdd_above_smul_iff_of_neg (hc : c < 0) : bdd_above (c • s) ↔ bdd_below s := (order_iso.smul_left_dual M hc).bdd_below_image -end module end linear_ordered_field diff --git a/src/algebra/order/monoid.lean b/src/algebra/order/monoid.lean deleted file mode 100644 index f03f7d9a1c43b..0000000000000 --- a/src/algebra/order/monoid.lean +++ /dev/null @@ -1,1271 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl --/ -import algebra.group.with_one -import algebra.group.prod -import algebra.hom.equiv -import algebra.order.monoid_lemmas -import order.min_max -import order.hom.basic - -/-! -# Ordered monoids - -This file develops the basics of ordered monoids. - -## Implementation details - -Unfortunately, the number of `'` appended to lemmas in this file -may differ between the multiplicative and the additive version of a lemma. -The reason is that we did not want to change existing names in the library. --/ - -set_option old_structure_cmd true -open function - -universe u -variable {α : Type u} - -/-- An ordered commutative monoid is a commutative monoid -with a partial order such that `a ≤ b → c * a ≤ c * b` (multiplication is monotone) --/ -@[protect_proj, ancestor comm_monoid partial_order] -class ordered_comm_monoid (α : Type*) extends comm_monoid α, partial_order α := -(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b) - -/-- An ordered (additive) commutative monoid is a commutative monoid - with a partial order such that `a ≤ b → c + a ≤ c + b` (addition is monotone) --/ -@[protect_proj, ancestor add_comm_monoid partial_order] -class ordered_add_comm_monoid (α : Type*) extends add_comm_monoid α, partial_order α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) - -attribute [to_additive] ordered_comm_monoid - -section ordered_instances - -@[to_additive] -instance ordered_comm_monoid.to_covariant_class_left (M : Type*) [ordered_comm_monoid M] : - covariant_class M M (*) (≤) := -{ elim := λ a b c bc, ordered_comm_monoid.mul_le_mul_left _ _ bc a } - -/- This instance can be proven with `by apply_instance`. However, `with_bot ℕ` does not -pick up a `covariant_class M M (function.swap (*)) (≤)` instance without it (see PR #7940). -/ -@[to_additive] -instance ordered_comm_monoid.to_covariant_class_right (M : Type*) [ordered_comm_monoid M] : - covariant_class M M (swap (*)) (≤) := -covariant_swap_mul_le_of_covariant_mul_le M - -/- This is not an instance, to avoid creating a loop in the type-class system: in a -`left_cancel_semigroup` with a `partial_order`, assuming `covariant_class M M (*) (≤)` -implies `covariant_class M M (*) (<)` . -/ -@[to_additive] lemma has_mul.to_covariant_class_left - (M : Type*) [has_mul M] [partial_order M] [covariant_class M M (*) (<)] : - covariant_class M M (*) (≤) := -{ elim := λ a b c bc, by - { rcases eq_or_lt_of_le bc with rfl | bc, - { exact rfl.le }, - { exact (mul_lt_mul_left' bc a).le } } } - -/- This is not an instance, to avoid creating a loop in the type-class system: in a -`right_cancel_semigroup` with a `partial_order`, assuming `covariant_class M M (swap (*)) (<)` -implies `covariant_class M M (swap (*)) (≤)` . -/ -@[to_additive] lemma has_mul.to_covariant_class_right - (M : Type*) [has_mul M] [partial_order M] [covariant_class M M (swap (*)) (<)] : - covariant_class M M (swap (*)) (≤) := -{ elim := λ a b c bc, by - { rcases eq_or_lt_of_le bc with rfl | bc, - { exact rfl.le }, - { exact (mul_lt_mul_right' bc a).le } } } - -end ordered_instances - -/-- An `ordered_comm_monoid` with one-sided 'division' in the sense that -if `a ≤ b`, there is some `c` for which `a * c = b`. This is a weaker version -of the condition on canonical orderings defined by `canonically_ordered_monoid`. -/ -class has_exists_mul_of_le (α : Type u) [ordered_comm_monoid α] : Prop := -(exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ (c : α), b = a * c) - -/-- An `ordered_add_comm_monoid` with one-sided 'subtraction' in the sense that -if `a ≤ b`, then there is some `c` for which `a + c = b`. This is a weaker version -of the condition on canonical orderings defined by `canonically_ordered_add_monoid`. -/ -class has_exists_add_of_le (α : Type u) [ordered_add_comm_monoid α] : Prop := -(exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ (c : α), b = a + c) - -attribute [to_additive] has_exists_mul_of_le - -export has_exists_mul_of_le (exists_mul_of_le) - -export has_exists_add_of_le (exists_add_of_le) - -/-- A linearly ordered additive commutative monoid. -/ -@[protect_proj, ancestor linear_order ordered_add_comm_monoid] -class linear_ordered_add_comm_monoid (α : Type*) - extends linear_order α, ordered_add_comm_monoid α. - -/-- A linearly ordered commutative monoid. -/ -@[protect_proj, ancestor linear_order ordered_comm_monoid, to_additive] -class linear_ordered_comm_monoid (α : Type*) - extends linear_order α, ordered_comm_monoid α. - -/-- A linearly ordered commutative monoid with a zero element. -/ -class linear_ordered_comm_monoid_with_zero (α : Type*) - extends linear_ordered_comm_monoid α, comm_monoid_with_zero α := -(zero_le_one : (0 : α) ≤ 1) - -/-- A linearly ordered commutative monoid with an additively absorbing `⊤` element. - Instances should include number systems with an infinite element adjoined.` -/ -@[protect_proj, ancestor linear_ordered_add_comm_monoid has_top] -class linear_ordered_add_comm_monoid_with_top (α : Type*) - extends linear_ordered_add_comm_monoid α, has_top α := -(le_top : ∀ x : α, x ≤ ⊤) -(top_add' : ∀ x : α, ⊤ + x = ⊤) - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_add_comm_monoid_with_top.to_order_top (α : Type u) - [h : linear_ordered_add_comm_monoid_with_top α] : order_top α := -{ ..h } - -section linear_ordered_add_comm_monoid_with_top -variables [linear_ordered_add_comm_monoid_with_top α] {a b : α} - -@[simp] -lemma top_add (a : α) : ⊤ + a = ⊤ := linear_ordered_add_comm_monoid_with_top.top_add' a - -@[simp] -lemma add_top (a : α) : a + ⊤ = ⊤ := -trans (add_comm _ _) (top_add _) - -end linear_ordered_add_comm_monoid_with_top - -/-- Pullback an `ordered_comm_monoid` under an injective map. -See note [reducible non-instances]. -/ -@[reducible, to_additive function.injective.ordered_add_comm_monoid -"Pullback an `ordered_add_comm_monoid` under an injective map."] -def function.injective.ordered_comm_monoid [ordered_comm_monoid α] {β : Type*} - [has_one β] [has_mul β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ordered_comm_monoid β := -{ mul_le_mul_left := λ a b ab c, show f (c * a) ≤ f (c * b), by - { rw [mul, mul], apply mul_le_mul_left', exact ab }, - ..partial_order.lift f hf, - ..hf.comm_monoid f one mul npow } - -/-- Pullback a `linear_ordered_comm_monoid` under an injective map. -See note [reducible non-instances]. -/ -@[reducible, to_additive function.injective.linear_ordered_add_comm_monoid -"Pullback an `ordered_add_comm_monoid` under an injective map."] -def function.injective.linear_ordered_comm_monoid [linear_ordered_comm_monoid α] {β : Type*} - [has_one β] [has_mul β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - linear_ordered_comm_monoid β := -{ .. hf.ordered_comm_monoid f one mul npow, - .. linear_order.lift f hf } - -lemma bit0_pos [ordered_add_comm_monoid α] {a : α} (h : 0 < a) : 0 < bit0 a := -add_pos h h - -namespace units - -@[to_additive] -instance [monoid α] [preorder α] : preorder αˣ := -preorder.lift (coe : αˣ → α) - -@[simp, norm_cast, to_additive] -theorem coe_le_coe [monoid α] [preorder α] {a b : αˣ} : - (a : α) ≤ b ↔ a ≤ b := iff.rfl - -@[simp, norm_cast, to_additive] -theorem coe_lt_coe [monoid α] [preorder α] {a b : αˣ} : - (a : α) < b ↔ a < b := iff.rfl - -@[to_additive] -instance [monoid α] [partial_order α] : partial_order αˣ := -partial_order.lift coe units.ext - -@[to_additive] -instance [monoid α] [linear_order α] : linear_order αˣ := -linear_order.lift coe units.ext - -@[simp, norm_cast, to_additive] -theorem max_coe [monoid α] [linear_order α] {a b : αˣ} : - (↑(max a b) : α) = max a b := -by by_cases b ≤ a; simp [max_def, h] - -@[simp, norm_cast, to_additive] -theorem min_coe [monoid α] [linear_order α] {a b : αˣ} : - (↑(min a b) : α) = min a b := -by by_cases a ≤ b; simp [min_def, h] - -end units - -namespace with_zero - -local attribute [semireducible] with_zero - -instance [preorder α] : preorder (with_zero α) := with_bot.preorder - -instance [partial_order α] : partial_order (with_zero α) := with_bot.partial_order - -instance [preorder α] : order_bot (with_zero α) := with_bot.order_bot - -lemma zero_le [partial_order α] (a : with_zero α) : 0 ≤ a := order_bot.bot_le a - -lemma zero_lt_coe [preorder α] (a : α) : (0 : with_zero α) < a := with_bot.bot_lt_coe a - -@[simp, norm_cast] lemma coe_lt_coe [preorder α] {a b : α} : (a : with_zero α) < b ↔ a < b := -with_bot.coe_lt_coe - -@[simp, norm_cast] lemma coe_le_coe [preorder α] {a b : α} : (a : with_zero α) ≤ b ↔ a ≤ b := -with_bot.coe_le_coe - -instance [lattice α] : lattice (with_zero α) := with_bot.lattice - -instance [linear_order α] : linear_order (with_zero α) := with_bot.linear_order - -lemma mul_le_mul_left {α : Type u} [has_mul α] [preorder α] - [covariant_class α α (*) (≤)] : - ∀ (a b : with_zero α), - a ≤ b → ∀ (c : with_zero α), c * a ≤ c * b := -begin - rintro (_ | a) (_ | b) h (_ | c); - try { exact λ f hf, option.no_confusion hf }, - { exact false.elim (not_lt_of_le h (with_zero.zero_lt_coe a))}, - { simp_rw [some_eq_coe] at h ⊢, - norm_cast at h ⊢, - exact covariant_class.elim _ h } -end - -lemma lt_of_mul_lt_mul_left {α : Type u} [has_mul α] [partial_order α] - [contravariant_class α α (*) (<)] : - ∀ (a b c : with_zero α), a * b < a * c → b < c := -begin - rintro (_ | a) (_ | b) (_ | c) h; - try { exact false.elim (lt_irrefl none h) }, - { exact with_zero.zero_lt_coe c }, - { exact false.elim (not_le_of_lt h (with_zero.zero_le _)) }, - { simp_rw [some_eq_coe] at h ⊢, - norm_cast at h ⊢, - apply lt_of_mul_lt_mul_left' h } -end - -@[simp] lemma le_max_iff [linear_order α] {a b c : α} : - (a : with_zero α) ≤ max b c ↔ a ≤ max b c := -by simp only [with_zero.coe_le_coe, le_max_iff] - -@[simp] lemma min_le_iff [linear_order α] {a b c : α} : - min (a : with_zero α) b ≤ c ↔ min a b ≤ c := -by simp only [with_zero.coe_le_coe, min_le_iff] - -instance [ordered_comm_monoid α] : ordered_comm_monoid (with_zero α) := -{ mul_le_mul_left := with_zero.mul_le_mul_left, - ..with_zero.comm_monoid_with_zero, - ..with_zero.partial_order } - -/- -Note 1 : the below is not an instance because it requires `zero_le`. It seems -like a rather pathological definition because α already has a zero. -Note 2 : there is no multiplicative analogue because it does not seem necessary. -Mathematicians might be more likely to use the order-dual version, where all -elements are ≤ 1 and then 1 is the top element. --/ - -/-- -If `0` is the least element in `α`, then `with_zero α` is an `ordered_add_comm_monoid`. -See note [reducible non-instances]. --/ -@[reducible] protected def ordered_add_comm_monoid [ordered_add_comm_monoid α] - (zero_le : ∀ a : α, 0 ≤ a) : ordered_add_comm_monoid (with_zero α) := -begin - suffices, refine - { add_le_add_left := this, - ..with_zero.partial_order, - ..with_zero.add_comm_monoid, .. }, - { intros a b h c ca h₂, - cases b with b, - { rw le_antisymm h bot_le at h₂, - exact ⟨_, h₂, le_rfl⟩ }, - cases a with a, - { change c + 0 = some ca at h₂, - simp at h₂, simp [h₂], - exact ⟨_, rfl, by simpa using add_le_add_left (zero_le b) _⟩ }, - { simp at h, - cases c with c; change some _ = _ at h₂; - simp [-add_comm] at h₂; subst ca; refine ⟨_, rfl, _⟩, - { exact h }, - { exact add_le_add_left h _ } } } -end - -end with_zero - -/-- A canonically ordered additive monoid is an ordered commutative additive monoid - in which the ordering coincides with the subtractibility relation, - which is to say, `a ≤ b` iff there exists `c` with `b = a + c`. - This is satisfied by the natural numbers, for example, but not - the integers or other nontrivial `ordered_add_comm_group`s. -/ -@[protect_proj, ancestor ordered_add_comm_monoid has_bot] -class canonically_ordered_add_monoid (α : Type*) extends ordered_add_comm_monoid α, has_bot α := -(bot_le : ∀ x : α, ⊥ ≤ x) -(le_iff_exists_add : ∀ a b : α, a ≤ b ↔ ∃ c, b = a + c) - -@[priority 100] -- see Note [lower instance priority] -instance canonically_ordered_add_monoid.to_order_bot (α : Type u) - [h : canonically_ordered_add_monoid α] : order_bot α := -{ ..h } - -/-- A canonically ordered monoid is an ordered commutative monoid - in which the ordering coincides with the divisibility relation, - which is to say, `a ≤ b` iff there exists `c` with `b = a * c`. - Examples seem rare; it seems more likely that the `order_dual` - of a naturally-occurring lattice satisfies this than the lattice - itself (for example, dual of the lattice of ideals of a PID or - Dedekind domain satisfy this; collections of all things ≤ 1 seem to - be more natural that collections of all things ≥ 1). --/ -@[protect_proj, ancestor ordered_comm_monoid has_bot, to_additive] -class canonically_ordered_monoid (α : Type*) extends ordered_comm_monoid α, has_bot α := -(bot_le : ∀ x : α, ⊥ ≤ x) -(le_iff_exists_mul : ∀ a b : α, a ≤ b ↔ ∃ c, b = a * c) - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance canonically_ordered_monoid.to_order_bot (α : Type u) - [h : canonically_ordered_monoid α] : order_bot α := -{ ..h } - -section canonically_ordered_monoid - -variables [canonically_ordered_monoid α] {a b c d : α} - -@[to_additive] -lemma le_iff_exists_mul : a ≤ b ↔ ∃c, b = a * c := -canonically_ordered_monoid.le_iff_exists_mul a b - -@[to_additive] -lemma self_le_mul_right (a b : α) : a ≤ a * b := -le_iff_exists_mul.mpr ⟨b, rfl⟩ - -@[to_additive] -lemma self_le_mul_left (a b : α) : a ≤ b * a := -by { rw [mul_comm], exact self_le_mul_right a b } - -@[simp, to_additive zero_le] lemma one_le (a : α) : 1 ≤ a := -le_iff_exists_mul.mpr ⟨a, (one_mul _).symm⟩ - -@[simp, to_additive] lemma bot_eq_one : (⊥ : α) = 1 := -le_antisymm bot_le (one_le ⊥) - -@[simp, to_additive] lemma mul_eq_one_iff : a * b = 1 ↔ a = 1 ∧ b = 1 := -mul_eq_one_iff' (one_le _) (one_le _) - -@[simp, to_additive] lemma le_one_iff_eq_one : a ≤ 1 ↔ a = 1 := -iff.intro - (assume h, le_antisymm h (one_le a)) - (assume h, h ▸ le_refl a) - -@[to_additive] lemma one_lt_iff_ne_one : 1 < a ↔ a ≠ 1 := -iff.intro ne_of_gt $ assume hne, lt_of_le_of_ne (one_le _) hne.symm - -@[to_additive] lemma eq_one_or_one_lt : a = 1 ∨ 1 < a := -(one_le a).eq_or_lt.imp_left eq.symm - -@[to_additive] lemma exists_pos_mul_of_lt (h : a < b) : ∃ c > 1, a * c = b := -begin - obtain ⟨c, hc⟩ := le_iff_exists_mul.1 h.le, - refine ⟨c, one_lt_iff_ne_one.2 _, hc.symm⟩, - rintro rfl, - simpa [hc, lt_irrefl] using h -end - -@[to_additive] lemma le_mul_left (h : a ≤ c) : a ≤ b * c := -calc a = 1 * a : by simp - ... ≤ b * c : mul_le_mul' (one_le _) h - -@[to_additive] lemma le_mul_self : a ≤ b * a := -le_mul_left (le_refl a) - -@[to_additive] lemma le_mul_right (h : a ≤ b) : a ≤ b * c := -calc a = a * 1 : by simp - ... ≤ b * c : mul_le_mul' h (one_le _) - -@[to_additive] lemma le_self_mul : a ≤ a * c := -le_mul_right (le_refl a) - -@[to_additive] -lemma lt_iff_exists_mul [covariant_class α α (*) (<)] : a < b ↔ ∃ c > 1, b = a * c := -begin - simp_rw [lt_iff_le_and_ne, and_comm, le_iff_exists_mul, ← exists_and_distrib_left, exists_prop], - apply exists_congr, intro c, - rw [and.congr_left_iff, gt_iff_lt], rintro rfl, - split, - { rw [one_lt_iff_ne_one], apply mt, rintro rfl, rw [mul_one] }, - { rw [← (self_le_mul_right a c).lt_iff_ne], apply lt_mul_of_one_lt_right' } -end - --- This instance looks absurd: a monoid already has a zero -/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/ -instance with_zero.canonically_ordered_add_monoid {α : Type u} [canonically_ordered_add_monoid α] : - canonically_ordered_add_monoid (with_zero α) := -{ le_iff_exists_add := λ a b, begin - apply with_zero.cases_on a, - { exact iff_of_true bot_le ⟨b, (zero_add b).symm⟩ }, - apply with_zero.cases_on b, - { intro b', - refine iff_of_false (mt (le_antisymm bot_le) (by simp)) (not_exists.mpr (λ c, _)), - apply with_zero.cases_on c; - simp [←with_zero.coe_add] }, - { simp only [le_iff_exists_add, with_zero.coe_le_coe], - intros, - split; rintro ⟨c, h⟩, - { exact ⟨c, congr_arg coe h⟩ }, - { induction c using with_zero.cases_on, - { refine ⟨0, _⟩, - simpa using h }, - { refine ⟨c, _⟩, - simpa [←with_zero.coe_add] using h } } } - end, - .. with_zero.order_bot, - .. with_zero.ordered_add_comm_monoid zero_le } - -@[priority 100, to_additive] -instance canonically_ordered_monoid.has_exists_mul_of_le (α : Type u) - [canonically_ordered_monoid α] : has_exists_mul_of_le α := -{ exists_mul_of_le := λ a b hab, le_iff_exists_mul.mp hab } - -end canonically_ordered_monoid - -lemma pos_of_gt {M : Type*} [canonically_ordered_add_monoid M] {n m : M} (h : n < m) : 0 < m := -lt_of_le_of_lt (zero_le _) h - -/-- A canonically linear-ordered additive monoid is a canonically ordered additive monoid - whose ordering is a linear order. -/ -@[protect_proj, ancestor canonically_ordered_add_monoid linear_order] -class canonically_linear_ordered_add_monoid (α : Type*) - extends canonically_ordered_add_monoid α, linear_order α - -/-- A canonically linear-ordered monoid is a canonically ordered monoid - whose ordering is a linear order. -/ -@[protect_proj, ancestor canonically_ordered_monoid linear_order, to_additive] -class canonically_linear_ordered_monoid (α : Type*) - extends canonically_ordered_monoid α, linear_order α - -section canonically_linear_ordered_monoid -variables [canonically_linear_ordered_monoid α] - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance canonically_linear_ordered_monoid.semilattice_sup : semilattice_sup α := -{ ..linear_order.to_lattice } - -instance with_zero.canonically_linear_ordered_add_monoid - (α : Type*) [canonically_linear_ordered_add_monoid α] : - canonically_linear_ordered_add_monoid (with_zero α) := -{ .. with_zero.canonically_ordered_add_monoid, - .. with_zero.linear_order } - -@[to_additive] -lemma min_mul_distrib (a b c : α) : min a (b * c) = min a (min a b * min a c) := -begin - cases le_total a b with hb hb, - { simp [hb, le_mul_right] }, - { cases le_total a c with hc hc, - { simp [hc, le_mul_left] }, - { simp [hb, hc] } } -end - -@[to_additive] -lemma min_mul_distrib' (a b c : α) : min (a * b) c = min (min a c * min b c) c := -by simpa [min_comm _ c] using min_mul_distrib c a b - -@[simp, to_additive] -lemma one_min (a : α) : min 1 a = 1 := -min_eq_left (one_le a) - -@[simp, to_additive] -lemma min_one (a : α) : min a 1 = 1 := -min_eq_right (one_le a) - -end canonically_linear_ordered_monoid - -/-- An ordered cancellative additive commutative monoid -is an additive commutative monoid with a partial order, -in which addition is cancellative and monotone. -/ -@[protect_proj, ancestor add_cancel_comm_monoid partial_order] -class ordered_cancel_add_comm_monoid (α : Type u) - extends add_cancel_comm_monoid α, partial_order α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) -(le_of_add_le_add_left : ∀ a b c : α, a + b ≤ a + c → b ≤ c) - -/-- An ordered cancellative commutative monoid -is a commutative monoid with a partial order, -in which multiplication is cancellative and monotone. -/ -@[protect_proj, ancestor cancel_comm_monoid partial_order, to_additive] -class ordered_cancel_comm_monoid (α : Type u) - extends cancel_comm_monoid α, partial_order α := -(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b) -(le_of_mul_le_mul_left : ∀ a b c : α, a * b ≤ a * c → b ≤ c) - -section ordered_cancel_comm_monoid -variables [ordered_cancel_comm_monoid α] {a b c d : α} - -@[to_additive] -lemma ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left : ∀ a b c : α, a * b < a * c → b < c := -λ a b c h, lt_of_le_not_le - (ordered_cancel_comm_monoid.le_of_mul_le_mul_left a b c h.le) $ - mt (λ h, ordered_cancel_comm_monoid.mul_le_mul_left _ _ h _) (not_le_of_gt h) - -@[to_additive] -instance ordered_cancel_comm_monoid.to_contravariant_class_left - (M : Type*) [ordered_cancel_comm_monoid M] : - contravariant_class M M (*) (<) := -{ elim := λ a b c, ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left _ _ _ } - -/- This instance can be proven with `by apply_instance`. However, by analogy with the -instance `ordered_cancel_comm_monoid.to_covariant_class_right` above, I imagine that without -this instance, some Type would not have a `contravariant_class M M (function.swap (*)) (<)` -instance. -/ -@[to_additive] -instance ordered_cancel_comm_monoid.to_contravariant_class_right - (M : Type*) [ordered_cancel_comm_monoid M] : - contravariant_class M M (swap (*)) (<) := -contravariant_swap_mul_lt_of_contravariant_mul_lt M - -@[priority 100, to_additive] -- see Note [lower instance priority] -instance ordered_cancel_comm_monoid.to_ordered_comm_monoid : ordered_comm_monoid α := -{ ..‹ordered_cancel_comm_monoid α› } - -/-- Pullback an `ordered_cancel_comm_monoid` under an injective map. -See note [reducible non-instances]. -/ -@[reducible, to_additive function.injective.ordered_cancel_add_comm_monoid -"Pullback an `ordered_cancel_add_comm_monoid` under an injective map."] -def function.injective.ordered_cancel_comm_monoid {β : Type*} - [has_one β] [has_mul β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ordered_cancel_comm_monoid β := -{ le_of_mul_le_mul_left := λ a b c (bc : f (a * b) ≤ f (a * c)), - (mul_le_mul_iff_left (f a)).mp (by rwa [← mul, ← mul]), - ..hf.left_cancel_semigroup f mul, - ..hf.ordered_comm_monoid f one mul npow } - -end ordered_cancel_comm_monoid - -/-! Some lemmas about types that have an ordering and a binary operation, with no - rules relating them. -/ -@[to_additive] -lemma fn_min_mul_fn_max {β} [linear_order α] [comm_semigroup β] (f : α → β) (n m : α) : - f (min n m) * f (max n m) = f n * f m := -by { cases le_total n m with h h; simp [h, mul_comm] } - -@[to_additive] -lemma min_mul_max [linear_order α] [comm_semigroup α] (n m : α) : - min n m * max n m = n * m := -fn_min_mul_fn_max id n m - -/-- A linearly ordered cancellative additive commutative monoid -is an additive commutative monoid with a decidable linear order -in which addition is cancellative and monotone. -/ -@[protect_proj, ancestor ordered_cancel_add_comm_monoid linear_ordered_add_comm_monoid] -class linear_ordered_cancel_add_comm_monoid (α : Type u) - extends ordered_cancel_add_comm_monoid α, linear_ordered_add_comm_monoid α - -/-- A linearly ordered cancellative commutative monoid -is a commutative monoid with a linear order -in which multiplication is cancellative and monotone. -/ -@[protect_proj, ancestor ordered_cancel_comm_monoid linear_ordered_comm_monoid, to_additive] -class linear_ordered_cancel_comm_monoid (α : Type u) - extends ordered_cancel_comm_monoid α, linear_ordered_comm_monoid α - -section covariant_class_mul_le -variables [linear_order α] - -section has_mul -variable [has_mul α] - -section left -variable [covariant_class α α (*) (≤)] - -@[to_additive] lemma min_mul_mul_left (a b c : α) : min (a * b) (a * c) = a * min b c := -(monotone_id.const_mul' a).map_min.symm - -@[to_additive] -lemma max_mul_mul_left (a b c : α) : max (a * b) (a * c) = a * max b c := -(monotone_id.const_mul' a).map_max.symm - -@[to_additive] -lemma lt_or_lt_of_mul_lt_mul [covariant_class α α (function.swap (*)) (≤)] - {a b m n : α} (h : m * n < a * b) : - m < a ∨ n < b := -by { contrapose! h, exact mul_le_mul' h.1 h.2 } - -@[to_additive] -lemma mul_lt_mul_iff_of_le_of_le - [covariant_class α α (function.swap (*)) (<)] - [covariant_class α α (*) (<)] - [covariant_class α α (function.swap (*)) (≤)] - {a b c d : α} (ac : a ≤ c) (bd : b ≤ d) : - a * b < c * d ↔ (a < c) ∨ (b < d) := -begin - refine ⟨lt_or_lt_of_mul_lt_mul, λ h, _⟩, - cases h with ha hb, - { exact mul_lt_mul_of_lt_of_le ha bd }, - { exact mul_lt_mul_of_le_of_lt ac hb } -end - -end left - -section right -variable [covariant_class α α (function.swap (*)) (≤)] - -@[to_additive] -lemma min_mul_mul_right (a b c : α) : min (a * c) (b * c) = min a b * c := -(monotone_id.mul_const' c).map_min.symm - -@[to_additive] -lemma max_mul_mul_right (a b c : α) : max (a * c) (b * c) = max a b * c := -(monotone_id.mul_const' c).map_max.symm - -end right - -end has_mul - -variable [mul_one_class α] - -@[to_additive] -lemma min_le_mul_of_one_le_right [covariant_class α α (*) (≤)] {a b : α} (hb : 1 ≤ b) : - min a b ≤ a * b := -min_le_iff.2 $ or.inl $ le_mul_of_one_le_right' hb - -@[to_additive] -lemma min_le_mul_of_one_le_left [covariant_class α α (function.swap (*)) (≤)] {a b : α} - (ha : 1 ≤ a) : min a b ≤ a * b := -min_le_iff.2 $ or.inr $ le_mul_of_one_le_left' ha - -@[to_additive] -lemma max_le_mul_of_one_le [covariant_class α α (*) (≤)] - [covariant_class α α (function.swap (*)) (≤)] {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : - max a b ≤ a * b := -max_le_iff.2 ⟨le_mul_of_one_le_right' hb, le_mul_of_one_le_left' ha⟩ - -end covariant_class_mul_le - -section linear_ordered_cancel_comm_monoid -variables [linear_ordered_cancel_comm_monoid α] - -/-- Pullback a `linear_ordered_cancel_comm_monoid` under an injective map. -See note [reducible non-instances]. -/ -@[reducible, to_additive function.injective.linear_ordered_cancel_add_comm_monoid -"Pullback a `linear_ordered_cancel_add_comm_monoid` under an injective map."] -def function.injective.linear_ordered_cancel_comm_monoid {β : Type*} - [has_one β] [has_mul β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - linear_ordered_cancel_comm_monoid β := -{ ..hf.linear_ordered_comm_monoid f one mul npow, - ..hf.ordered_cancel_comm_monoid f one mul npow } - -end linear_ordered_cancel_comm_monoid - -/-! ### Order dual -/ - -namespace order_dual - -@[to_additive] instance [h : has_mul α] : has_mul αᵒᵈ := h -@[to_additive] instance [h : has_one α] : has_one αᵒᵈ := h -@[to_additive] instance [h : semigroup α] : semigroup αᵒᵈ := h -@[to_additive] instance [h : comm_semigroup α] : comm_semigroup αᵒᵈ := h -@[to_additive] instance [h : mul_one_class α] : mul_one_class αᵒᵈ := h -@[to_additive] instance [h : monoid α] : monoid αᵒᵈ := h -@[to_additive] instance [h : comm_monoid α] : comm_monoid αᵒᵈ := h -@[to_additive] instance [h : left_cancel_monoid α] : left_cancel_monoid αᵒᵈ := h -@[to_additive] instance [h : right_cancel_monoid α] : right_cancel_monoid αᵒᵈ := h -@[to_additive] instance [h : cancel_monoid α] : cancel_monoid αᵒᵈ := h -@[to_additive] instance [h : cancel_comm_monoid α] : cancel_comm_monoid αᵒᵈ := h -instance [h : mul_zero_class α] : mul_zero_class αᵒᵈ := h -instance [h : mul_zero_one_class α] : mul_zero_one_class αᵒᵈ := h -instance [h : monoid_with_zero α] : monoid_with_zero αᵒᵈ := h -instance [h : comm_monoid_with_zero α] : comm_monoid_with_zero αᵒᵈ := h -instance [h : cancel_comm_monoid_with_zero α] : cancel_comm_monoid_with_zero αᵒᵈ := h - -@[to_additive] -instance contravariant_class_mul_le [has_le α] [has_mul α] [c : contravariant_class α α (*) (≤)] : - contravariant_class αᵒᵈ αᵒᵈ (*) (≤) := -⟨c.1.flip⟩ - -@[to_additive] -instance covariant_class_mul_le [has_le α] [has_mul α] [c : covariant_class α α (*) (≤)] : - covariant_class αᵒᵈ αᵒᵈ (*) (≤) := -⟨c.1.flip⟩ - -@[to_additive] instance contravariant_class_swap_mul_le [has_le α] [has_mul α] - [c : contravariant_class α α (swap (*)) (≤)] : - contravariant_class αᵒᵈ αᵒᵈ (swap (*)) (≤) := -⟨c.1.flip⟩ - -@[to_additive] -instance covariant_class_swap_mul_le [has_le α] [has_mul α] - [c : covariant_class α α (swap (*)) (≤)] : - covariant_class αᵒᵈ αᵒᵈ (swap (*)) (≤) := -⟨c.1.flip⟩ - -@[to_additive] -instance contravariant_class_mul_lt [has_lt α] [has_mul α] [c : contravariant_class α α (*) (<)] : - contravariant_class αᵒᵈ αᵒᵈ (*) (<) := -⟨c.1.flip⟩ - -@[to_additive] -instance covariant_class_mul_lt [has_lt α] [has_mul α] [c : covariant_class α α (*) (<)] : - covariant_class αᵒᵈ αᵒᵈ (*) (<) := -⟨c.1.flip⟩ - -@[to_additive] instance contravariant_class_swap_mul_lt [has_lt α] [has_mul α] - [c : contravariant_class α α (swap (*)) (<)] : - contravariant_class αᵒᵈ αᵒᵈ (swap (*)) (<) := -⟨c.1.flip⟩ - -@[to_additive] -instance covariant_class_swap_mul_lt [has_lt α] [has_mul α] - [c : covariant_class α α (swap (*)) (<)] : - covariant_class αᵒᵈ αᵒᵈ (swap (*)) (<) := -⟨c.1.flip⟩ - -@[to_additive] -instance [ordered_comm_monoid α] : ordered_comm_monoid αᵒᵈ := -{ mul_le_mul_left := λ a b h c, mul_le_mul_left' h c, - .. order_dual.partial_order α, - .. order_dual.comm_monoid } - -@[to_additive ordered_cancel_add_comm_monoid.to_contravariant_class] -instance ordered_cancel_comm_monoid.to_contravariant_class [ordered_cancel_comm_monoid α] : - contravariant_class αᵒᵈ αᵒᵈ has_mul.mul has_le.le := -{ elim := λ a b c bc, (ordered_cancel_comm_monoid.le_of_mul_le_mul_left a c b (dual_le.mp bc)) } - -@[to_additive] -instance [ordered_cancel_comm_monoid α] : ordered_cancel_comm_monoid αᵒᵈ := -{ le_of_mul_le_mul_left := λ a b c : α, le_of_mul_le_mul_left', - .. order_dual.ordered_comm_monoid, .. order_dual.cancel_comm_monoid } - -@[to_additive] -instance [linear_ordered_cancel_comm_monoid α] : - linear_ordered_cancel_comm_monoid αᵒᵈ := -{ .. order_dual.linear_order α, - .. order_dual.ordered_cancel_comm_monoid } - -@[to_additive] -instance [linear_ordered_comm_monoid α] : - linear_ordered_comm_monoid αᵒᵈ := -{ .. order_dual.linear_order α, - .. order_dual.ordered_comm_monoid } - -end order_dual - -namespace prod - -variables {M N : Type*} - -@[to_additive] -instance [ordered_cancel_comm_monoid M] [ordered_cancel_comm_monoid N] : - ordered_cancel_comm_monoid (M × N) := -{ mul_le_mul_left := λ a b h c, ⟨mul_le_mul_left' h.1 _, mul_le_mul_left' h.2 _⟩, - le_of_mul_le_mul_left := λ a b c h, ⟨le_of_mul_le_mul_left' h.1, le_of_mul_le_mul_left' h.2⟩, - .. prod.cancel_comm_monoid, .. prod.partial_order M N } - -end prod - -/-! ### `with_bot`/`with_top`-/ - -namespace with_top - -section has_one - -variables [has_one α] - -@[to_additive] instance : has_one (with_top α) := ⟨(1 : α)⟩ - -@[simp, norm_cast, to_additive] lemma coe_one : ((1 : α) : with_top α) = 1 := rfl - -@[simp, norm_cast, to_additive] lemma coe_eq_one {a : α} : (a : with_top α) = 1 ↔ a = 1 := -coe_eq_coe - -@[simp, to_additive] protected lemma map_one {β} (f : α → β) : - (1 : with_top α).map f = (f 1 : with_top β) := rfl - -@[simp, norm_cast, to_additive] theorem one_eq_coe {a : α} : 1 = (a : with_top α) ↔ a = 1 := -trans eq_comm coe_eq_one - -@[simp, to_additive] theorem top_ne_one : ⊤ ≠ (1 : with_top α) . -@[simp, to_additive] theorem one_ne_top : (1 : with_top α) ≠ ⊤ . - -end has_one - -section has_add -variables [has_add α] {a b c d : with_top α} {x y : α} - -instance : has_add (with_top α) := ⟨λ o₁ o₂, o₁.bind $ λ a, o₂.map $ (+) a⟩ - -@[norm_cast] lemma coe_add : ((x + y : α) : with_top α) = x + y := rfl -@[norm_cast] lemma coe_bit0 : ((bit0 x : α) : with_top α) = bit0 x := rfl -@[norm_cast] lemma coe_bit1 [has_one α] {a : α} : ((bit1 a : α) : with_top α) = bit1 a := rfl - -@[simp] lemma top_add (a : with_top α) : ⊤ + a = ⊤ := rfl -@[simp] lemma add_top (a : with_top α) : a + ⊤ = ⊤ := by cases a; refl - -@[simp] lemma add_eq_top : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := -by cases a; cases b; simp [none_eq_top, some_eq_coe, ←with_top.coe_add, ←with_zero.coe_add] - -lemma add_ne_top : a + b ≠ ⊤ ↔ a ≠ ⊤ ∧ b ≠ ⊤ := add_eq_top.not.trans not_or_distrib - -lemma add_lt_top [partial_order α] {a b : with_top α} : a + b < ⊤ ↔ a < ⊤ ∧ b < ⊤ := -by simp_rw [lt_top_iff_ne_top, add_ne_top] - -lemma add_eq_coe : ∀ {a b : with_top α} {c : α}, - a + b = c ↔ ∃ (a' b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = c -| none b c := by simp [none_eq_top] -| (some a) none c := by simp [none_eq_top] -| (some a) (some b) c := - by simp only [some_eq_coe, ← coe_add, coe_eq_coe, exists_and_distrib_left, exists_eq_left] - -@[simp] lemma add_coe_eq_top_iff {x : with_top α} {y : α} : x + y = ⊤ ↔ x = ⊤ := -by { induction x using with_top.rec_top_coe; simp [← coe_add, -with_zero.coe_add] } - -@[simp] lemma coe_add_eq_top_iff {y : with_top α} : ↑x + y = ⊤ ↔ y = ⊤ := -by { induction y using with_top.rec_top_coe; simp [← coe_add, -with_zero.coe_add] } - -variables [preorder α] - -instance covariant_class_add_le [covariant_class α α (+) (≤)] : - covariant_class (with_top α) (with_top α) (+) (≤) := -⟨λ a b c h, begin - cases a; cases c; try { exact le_top }, - cases b, - { exact (not_top_le_coe _ h).elim }, - { exact some_le_some.2 (add_le_add_left (some_le_some.1 h) _) } -end⟩ - -instance covariant_class_swap_add_le [covariant_class α α (swap (+)) (≤)] : - covariant_class (with_top α) (with_top α) (swap (+)) (≤) := -⟨λ a b c h, begin - cases a; cases c; try { exact le_top }, - cases b, - { exact (not_top_le_coe _ h).elim }, - { exact some_le_some.2 (add_le_add_right (some_le_some.1 h) _) } -end⟩ - -instance contravariant_class_add_lt [contravariant_class α α (+) (<)] : - contravariant_class (with_top α) (with_top α) (+) (<) := -⟨λ a b c h, begin - cases a; cases b; try { exact (not_top_lt h).elim }, - cases c, - { exact coe_lt_top _ }, - { exact some_lt_some.2 (lt_of_add_lt_add_left $ some_lt_some.1 h) } -end⟩ - -instance contravariant_class_swap_add_lt [contravariant_class α α (swap (+)) (<)] : - contravariant_class (with_top α) (with_top α) (swap (+)) (<) := -⟨λ a b c h, begin - cases a; cases b; try { exact (not_top_lt h).elim }, - cases c, - { exact coe_lt_top _ }, - { exact some_lt_some.2 (lt_of_add_lt_add_right $ some_lt_some.1 h) } -end⟩ - -protected lemma le_of_add_le_add_left [contravariant_class α α (+) (≤)] (ha : a ≠ ⊤) - (h : a + b ≤ a + c) : b ≤ c := -begin - lift a to α using ha, - cases c; try {exact le_top}, - cases b, exact (not_top_le_coe _ h).elim, - simp only [some_eq_coe, ← coe_add, coe_le_coe] at h, rw some_le_some, - exact le_of_add_le_add_left h -end - -protected lemma le_of_add_le_add_right [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) - (h : b + a ≤ c + a) : b ≤ c := -begin - lift a to α using ha, - cases c, - { exact le_top }, - cases b, - { exact (not_top_le_coe _ h).elim }, - { exact some_le_some.2 (le_of_add_le_add_right $ some_le_some.1 h) } -end - -protected lemma add_lt_add_left [covariant_class α α (+) (<)] (ha : a ≠ ⊤) (h : b < c) : - a + b < a + c := -begin - lift a to α using ha, - lift b to α using (h.trans_le le_top).ne, - cases c, - { exact coe_lt_top _ }, - { exact some_lt_some.2 (add_lt_add_left (some_lt_some.1 h) _) } -end - -protected lemma add_lt_add_right [covariant_class α α (swap (+)) (<)] (ha : a ≠ ⊤) (h : b < c) : - b + a < c + a := -begin - lift a to α using ha, - lift b to α using (h.trans_le le_top).ne, - cases c, - { exact coe_lt_top _ }, - { exact some_lt_some.2 (add_lt_add_right (some_lt_some.1 h) _) } -end - -protected lemma add_le_add_iff_left [covariant_class α α (+) (≤)] [contravariant_class α α (+) (≤)] - (ha : a ≠ ⊤) : a + b ≤ a + c ↔ b ≤ c := -⟨with_top.le_of_add_le_add_left ha, λ h, add_le_add_left h a⟩ - -protected lemma add_le_add_iff_right [covariant_class α α (swap (+)) (≤)] - [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) : b + a ≤ c + a ↔ b ≤ c := -⟨with_top.le_of_add_le_add_right ha, λ h, add_le_add_right h a⟩ - -protected lemma add_lt_add_iff_left [covariant_class α α (+) (<)] [contravariant_class α α (+) (<)] - (ha : a ≠ ⊤) : a + b < a + c ↔ b < c := -⟨lt_of_add_lt_add_left, with_top.add_lt_add_left ha⟩ - -protected lemma add_lt_add_iff_right [covariant_class α α (swap (+)) (<)] - [contravariant_class α α (swap (+)) (<)] (ha : a ≠ ⊤) : b + a < c + a ↔ b < c := -⟨lt_of_add_lt_add_right, with_top.add_lt_add_right ha⟩ - -protected lemma add_lt_add_of_le_of_lt [covariant_class α α (+) (<)] - [covariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) (hab : a ≤ b) (hcd : c < d) : a + c < b + d := -(with_top.add_lt_add_left ha hcd).trans_le $ add_le_add_right hab _ - -protected lemma add_lt_add_of_lt_of_le [covariant_class α α (+) (≤)] - [covariant_class α α (swap (+)) (<)] (hc : c ≠ ⊤) (hab : a < b) (hcd : c ≤ d) : a + c < b + d := -(with_top.add_lt_add_right hc hab).trans_le $ add_le_add_left hcd _ - -end has_add - -instance [add_semigroup α] : add_semigroup (with_top α) := -{ add_assoc := begin - repeat { refine with_top.rec_top_coe _ _; try { intro }}; - simp [←with_top.coe_add, add_assoc] - end, - ..with_top.has_add } - -instance [add_comm_semigroup α] : add_comm_semigroup (with_top α) := -{ add_comm := - begin - repeat { refine with_top.rec_top_coe _ _; try { intro }}; - simp [←with_top.coe_add, add_comm] - end, - ..with_top.add_semigroup } - -instance [add_zero_class α] : add_zero_class (with_top α) := -{ zero_add := - begin - refine with_top.rec_top_coe _ _, - { simp }, - { intro, - rw [←with_top.coe_zero, ←with_top.coe_add, zero_add] } - end, - add_zero := - begin - refine with_top.rec_top_coe _ _, - { simp }, - { intro, - rw [←with_top.coe_zero, ←with_top.coe_add, add_zero] } - end, - ..with_top.has_zero, - ..with_top.has_add } - -instance [add_monoid α] : add_monoid (with_top α) := -{ ..with_top.add_zero_class, - ..with_top.has_zero, - ..with_top.add_semigroup } - -instance [add_comm_monoid α] : add_comm_monoid (with_top α) := -{ ..with_top.add_monoid, ..with_top.add_comm_semigroup } - -instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_top α) := -{ add_le_add_left := - begin - rintros a b h (_|c), { simp [none_eq_top] }, - rcases b with (_|b), { simp [none_eq_top] }, - rcases le_coe_iff.1 h with ⟨a, rfl, h⟩, - simp only [some_eq_coe, ← coe_add, coe_le_coe] at h ⊢, - exact add_le_add_left h c - end, - ..with_top.partial_order, ..with_top.add_comm_monoid } - -instance [linear_ordered_add_comm_monoid α] : - linear_ordered_add_comm_monoid_with_top (with_top α) := -{ top_add' := with_top.top_add, - ..with_top.order_top, - ..with_top.linear_order, - ..with_top.ordered_add_comm_monoid, - ..option.nontrivial } - -instance [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_top α) := -{ le_iff_exists_add := assume a b, - match a, b with - | ⊤, ⊤ := by simp - | (a : α), ⊤ := by { simp only [true_iff, le_top], refine ⟨⊤, _⟩, refl } - | (a : α), (b : α) := begin - rw [with_top.coe_le_coe, le_iff_exists_add], - split, - { rintro ⟨c, rfl⟩, - refine ⟨c, _⟩, norm_cast }, - { intro h, - exact match b, h with _, ⟨some c, rfl⟩ := ⟨_, rfl⟩ end } - end - | ⊤, (b : α) := by simp - end, - .. with_top.order_bot, - .. with_top.ordered_add_comm_monoid } - -instance [canonically_linear_ordered_add_monoid α] : - canonically_linear_ordered_add_monoid (with_top α) := -{ ..with_top.canonically_ordered_add_monoid, ..with_top.linear_order } - -/-- Coercion from `α` to `with_top α` as an `add_monoid_hom`. -/ -def coe_add_hom [add_monoid α] : α →+ with_top α := -⟨coe, rfl, λ _ _, rfl⟩ - -@[simp] lemma coe_coe_add_hom [add_monoid α] : ⇑(coe_add_hom : α →+ with_top α) = coe := rfl - -@[simp] lemma zero_lt_top [ordered_add_comm_monoid α] : (0 : with_top α) < ⊤ := -coe_lt_top 0 - -@[simp, norm_cast] lemma zero_lt_coe [ordered_add_comm_monoid α] (a : α) : - (0 : with_top α) < a ↔ 0 < a := -coe_lt_coe - -end with_top - -namespace with_bot - -@[to_additive] instance [has_one α] : has_one (with_bot α) := with_top.has_one -instance [has_add α] : has_add (with_bot α) := with_top.has_add -instance [add_semigroup α] : add_semigroup (with_bot α) := with_top.add_semigroup -instance [add_comm_semigroup α] : add_comm_semigroup (with_bot α) := with_top.add_comm_semigroup -instance [add_zero_class α] : add_zero_class (with_bot α) := with_top.add_zero_class -instance [add_monoid α] : add_monoid (with_bot α) := with_top.add_monoid -instance [add_comm_monoid α] : add_comm_monoid (with_bot α) := with_top.add_comm_monoid - -instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_bot α) := -begin - suffices, refine - { add_le_add_left := this, - ..with_bot.partial_order, - ..with_bot.add_comm_monoid, ..}, - { intros a b h c ca h₂, - cases c with c, {cases h₂}, - cases a with a; cases h₂, - cases b with b, {cases le_antisymm h bot_le}, - simp at h, - exact ⟨_, rfl, add_le_add_left h _⟩, } -end - -instance [linear_ordered_add_comm_monoid α] : linear_ordered_add_comm_monoid (with_bot α) := -{ ..with_bot.linear_order, ..with_bot.ordered_add_comm_monoid } - --- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast` -@[to_additive] -lemma coe_one [has_one α] : ((1 : α) : with_bot α) = 1 := rfl - --- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast` -@[to_additive] -lemma coe_eq_one [has_one α] {a : α} : (a : with_bot α) = 1 ↔ a = 1 := -with_top.coe_eq_one - -@[to_additive] protected lemma map_one {β} [has_one α] (f : α → β) : - (1 : with_bot α).map f = (f 1 : with_bot β) := rfl - -section has_add -variables [has_add α] {a b c d : with_bot α} {x y : α} - --- `norm_cast` proves those lemmas, because `with_top`/`with_bot` are reducible -lemma coe_add (a b : α) : ((a + b : α) : with_bot α) = a + b := rfl -lemma coe_bit0 : ((bit0 x : α) : with_bot α) = bit0 x := rfl -lemma coe_bit1 [has_one α] {a : α} : ((bit1 a : α) : with_bot α) = bit1 a := rfl - -@[simp] lemma bot_add (a : with_bot α) : ⊥ + a = ⊥ := rfl -@[simp] lemma add_bot (a : with_bot α) : a + ⊥ = ⊥ := by cases a; refl - -@[simp] lemma add_eq_bot : a + b = ⊥ ↔ a = ⊥ ∨ b = ⊥ := with_top.add_eq_top -lemma add_ne_bot : a + b ≠ ⊥ ↔ a ≠ ⊥ ∧ b ≠ ⊥ := with_top.add_ne_top - -lemma bot_lt_add [partial_order α] {a b : with_bot α} : ⊥ < a + b ↔ ⊥ < a ∧ ⊥ < b := -@with_top.add_lt_top αᵒᵈ _ _ _ _ - -lemma add_eq_coe : a + b = x ↔ ∃ (a' b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = x := with_top.add_eq_coe - -@[simp] lemma add_coe_eq_bot_iff : a + y = ⊥ ↔ a = ⊥ := with_top.add_coe_eq_top_iff -@[simp] lemma coe_add_eq_bot_iff : ↑x + b = ⊥ ↔ b = ⊥ := with_top.coe_add_eq_top_iff - -variables [preorder α] - -instance covariant_class_add_le [covariant_class α α (+) (≤)] : - covariant_class (with_bot α) (with_bot α) (+) (≤) := -@order_dual.covariant_class_add_le (with_top αᵒᵈ) _ _ _ - -instance covariant_class_swap_add_le [covariant_class α α (swap (+)) (≤)] : - covariant_class (with_bot α) (with_bot α) (swap (+)) (≤) := -@order_dual.covariant_class_swap_add_le (with_top αᵒᵈ) _ _ _ - -instance contravariant_class_add_lt [contravariant_class α α (+) (<)] : - contravariant_class (with_bot α) (with_bot α) (+) (<) := -@order_dual.contravariant_class_add_lt (with_top αᵒᵈ) _ _ _ - -instance contravariant_class_swap_add_lt [contravariant_class α α (swap (+)) (<)] : - contravariant_class (with_bot α) (with_bot α) (swap (+)) (<) := -@order_dual.contravariant_class_swap_add_lt (with_top αᵒᵈ) _ _ _ - -protected lemma le_of_add_le_add_left [contravariant_class α α (+) (≤)] (ha : a ≠ ⊥) - (h : a + b ≤ a + c) : b ≤ c := -@with_top.le_of_add_le_add_left αᵒᵈ _ _ _ _ _ _ ha h - -protected lemma le_of_add_le_add_right [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊥) - (h : b + a ≤ c + a) : b ≤ c := -@with_top.le_of_add_le_add_right αᵒᵈ _ _ _ _ _ _ ha h - -protected lemma add_lt_add_left [covariant_class α α (+) (<)] (ha : a ≠ ⊥) (h : b < c) : - a + b < a + c := -@with_top.add_lt_add_left αᵒᵈ _ _ _ _ _ _ ha h - -protected lemma add_lt_add_right [covariant_class α α (swap (+)) (<)] (ha : a ≠ ⊥) (h : b < c) : - b + a < c + a := -@with_top.add_lt_add_right αᵒᵈ _ _ _ _ _ _ ha h - -protected lemma add_le_add_iff_left [covariant_class α α (+) (≤)] [contravariant_class α α (+) (≤)] - (ha : a ≠ ⊥) : a + b ≤ a + c ↔ b ≤ c := -⟨with_bot.le_of_add_le_add_left ha, λ h, add_le_add_left h a⟩ - -protected lemma add_le_add_iff_right [covariant_class α α (swap (+)) (≤)] - [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊥) : b + a ≤ c + a ↔ b ≤ c := -⟨with_bot.le_of_add_le_add_right ha, λ h, add_le_add_right h a⟩ - -protected lemma add_lt_add_iff_left [covariant_class α α (+) (<)] [contravariant_class α α (+) (<)] - (ha : a ≠ ⊥) : a + b < a + c ↔ b < c := -⟨lt_of_add_lt_add_left, with_bot.add_lt_add_left ha⟩ - -protected lemma add_lt_add_iff_right [covariant_class α α (swap (+)) (<)] - [contravariant_class α α (swap (+)) (<)] (ha : a ≠ ⊥) : b + a < c + a ↔ b < c := -⟨lt_of_add_lt_add_right, with_bot.add_lt_add_right ha⟩ - -protected lemma add_lt_add_of_le_of_lt [covariant_class α α (+) (<)] - [covariant_class α α (swap (+)) (≤)] (hb : b ≠ ⊥) (hab : a ≤ b) (hcd : c < d) : a + c < b + d := -@with_top.add_lt_add_of_le_of_lt αᵒᵈ _ _ _ _ _ _ _ _ hb hab hcd - -protected lemma add_lt_add_of_lt_of_le [covariant_class α α (+) (≤)] - [covariant_class α α (swap (+)) (<)] (hd : d ≠ ⊥) (hab : a < b) (hcd : c ≤ d) : a + c < b + d := -@with_top.add_lt_add_of_lt_of_le αᵒᵈ _ _ _ _ _ _ _ _ hd hab hcd - -end has_add -end with_bot - -/-! ### `additive`/`multiplicative` -/ - -section type_tags - -instance : Π [preorder α], preorder (multiplicative α) := id -instance : Π [preorder α], preorder (additive α) := id -instance : Π [partial_order α], partial_order (multiplicative α) := id -instance : Π [partial_order α], partial_order (additive α) := id -instance : Π [linear_order α], linear_order (multiplicative α) := id -instance : Π [linear_order α], linear_order (additive α) := id - -instance [ordered_add_comm_monoid α] : ordered_comm_monoid (multiplicative α) := -{ mul_le_mul_left := @ordered_add_comm_monoid.add_le_add_left α _, - ..multiplicative.partial_order, - ..multiplicative.comm_monoid } - -instance [ordered_comm_monoid α] : ordered_add_comm_monoid (additive α) := -{ add_le_add_left := @ordered_comm_monoid.mul_le_mul_left α _, - ..additive.partial_order, - ..additive.add_comm_monoid } - -instance [ordered_cancel_add_comm_monoid α] : ordered_cancel_comm_monoid (multiplicative α) := -{ le_of_mul_le_mul_left := @ordered_cancel_add_comm_monoid.le_of_add_le_add_left α _, - ..multiplicative.left_cancel_semigroup, - ..multiplicative.ordered_comm_monoid } - -instance [ordered_cancel_comm_monoid α] : ordered_cancel_add_comm_monoid (additive α) := -{ le_of_add_le_add_left := @ordered_cancel_comm_monoid.le_of_mul_le_mul_left α _, - ..additive.add_left_cancel_semigroup, - ..additive.ordered_add_comm_monoid } - -instance [linear_ordered_add_comm_monoid α] : linear_ordered_comm_monoid (multiplicative α) := -{ ..multiplicative.linear_order, - ..multiplicative.ordered_comm_monoid } - -instance [linear_ordered_comm_monoid α] : linear_ordered_add_comm_monoid (additive α) := -{ ..additive.linear_order, - ..additive.ordered_add_comm_monoid } - -namespace additive - -variables [preorder α] - -@[simp] lemma of_mul_le {a b : α} : of_mul a ≤ of_mul b ↔ a ≤ b := iff.rfl - -@[simp] lemma of_mul_lt {a b : α} : of_mul a < of_mul b ↔ a < b := iff.rfl - -@[simp] lemma to_mul_le {a b : additive α} : to_mul a ≤ to_mul b ↔ a ≤ b := iff.rfl - -@[simp] lemma to_mul_lt {a b : additive α} : to_mul a < to_mul b ↔ a < b := iff.rfl - -end additive - -namespace multiplicative - -variables [preorder α] - -@[simp] lemma of_add_le {a b : α} : of_add a ≤ of_add b ↔ a ≤ b := iff.rfl - -@[simp] lemma of_add_lt {a b : α} : of_add a < of_add b ↔ a < b := iff.rfl - -@[simp] lemma to_add_le {a b : multiplicative α} : to_add a ≤ to_add b ↔ a ≤ b := iff.rfl - -@[simp] lemma to_add_lt {a b : multiplicative α} : to_add a < to_add b ↔ a < b := iff.rfl - -end multiplicative - -end type_tags - -namespace with_zero - -local attribute [semireducible] with_zero -variables [has_add α] - -/-- Making an additive monoid multiplicative then adding a zero is the same as adding a bottom -element then making it multiplicative. -/ -def to_mul_bot : with_zero (multiplicative α) ≃* multiplicative (with_bot α) := -by exact mul_equiv.refl _ - -@[simp] lemma to_mul_bot_zero : - to_mul_bot (0 : with_zero (multiplicative α)) = multiplicative.of_add ⊥ := rfl -@[simp] lemma to_mul_bot_coe (x : multiplicative α) : - to_mul_bot ↑x = multiplicative.of_add (x.to_add : with_bot α) := rfl -@[simp] lemma to_mul_bot_symm_bot : - to_mul_bot.symm (multiplicative.of_add (⊥ : with_bot α)) = 0 := rfl -@[simp] lemma to_mul_bot_coe_of_add (x : α) : - to_mul_bot.symm (multiplicative.of_add (x : with_bot α)) = multiplicative.of_add x := rfl - -variables [preorder α] (a b : with_zero (multiplicative α)) - -lemma to_mul_bot_strict_mono : strict_mono (@to_mul_bot α _) := λ x y, id -@[simp] lemma to_mul_bot_le : to_mul_bot a ≤ to_mul_bot b ↔ a ≤ b := iff.rfl -@[simp] lemma to_mul_bot_lt : to_mul_bot a < to_mul_bot b ↔ a < b := iff.rfl - -end with_zero - -/-- The order embedding sending `b` to `a * b`, for some fixed `a`. -See also `order_iso.mul_left` when working in an ordered group. -/ -@[to_additive "The order embedding sending `b` to `a + b`, for some fixed `a`. - See also `order_iso.add_left` when working in an additive ordered group.", simps] -def order_embedding.mul_left - {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (*) (<)] (m : α) : α ↪o α := -order_embedding.of_strict_mono (λ n, m * n) (λ a b w, mul_lt_mul_left' w m) - -/-- The order embedding sending `b` to `b * a`, for some fixed `a`. -See also `order_iso.mul_right` when working in an ordered group. -/ -@[to_additive "The order embedding sending `b` to `b + a`, for some fixed `a`. - See also `order_iso.add_right` when working in an additive ordered group.", simps] -def order_embedding.mul_right - {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (swap (*)) (<)] (m : α) : - α ↪o α := -order_embedding.of_strict_mono (λ n, n * m) (λ a b w, mul_lt_mul_right' w m) diff --git a/src/algebra/order/monoid/basic.lean b/src/algebra/order/monoid/basic.lean new file mode 100644 index 0000000000000..f2a9adb01108a --- /dev/null +++ b/src/algebra/order/monoid/basic.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.monoid.defs +import algebra.group.inj_surj +import order.hom.basic + +/-! +# Ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file develops some additional material on ordered monoids. +-/ + +set_option old_structure_cmd true +open function + +universe u +variables {α : Type u} {β : Type*} + +/-- Pullback an `ordered_comm_monoid` under an injective map. +See note [reducible non-instances]. -/ +@[reducible, to_additive function.injective.ordered_add_comm_monoid +"Pullback an `ordered_add_comm_monoid` under an injective map."] +def function.injective.ordered_comm_monoid [ordered_comm_monoid α] {β : Type*} + [has_one β] [has_mul β] [has_pow β ℕ] + (f : β → α) (hf : function.injective f) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + ordered_comm_monoid β := +{ mul_le_mul_left := λ a b ab c, show f (c * a) ≤ f (c * b), by + { rw [mul, mul], apply mul_le_mul_left', exact ab }, + ..partial_order.lift f hf, + ..hf.comm_monoid f one mul npow } + +/-- Pullback a `linear_ordered_comm_monoid` under an injective map. +See note [reducible non-instances]. -/ +@[reducible, to_additive function.injective.linear_ordered_add_comm_monoid +"Pullback an `ordered_add_comm_monoid` under an injective map."] +def function.injective.linear_ordered_comm_monoid [linear_ordered_comm_monoid α] {β : Type*} + [has_one β] [has_mul β] [has_pow β ℕ] [has_sup β] [has_inf β] + (f : β → α) (hf : function.injective f) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_comm_monoid β := +{ .. hf.ordered_comm_monoid f one mul npow, + .. linear_order.lift f hf hsup hinf } + +-- TODO find a better home for the next two constructions. + +/-- The order embedding sending `b` to `a * b`, for some fixed `a`. +See also `order_iso.mul_left` when working in an ordered group. -/ +@[to_additive "The order embedding sending `b` to `a + b`, for some fixed `a`. + See also `order_iso.add_left` when working in an additive ordered group.", simps] +def order_embedding.mul_left + {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (*) (<)] (m : α) : α ↪o α := +order_embedding.of_strict_mono (λ n, m * n) (λ a b w, mul_lt_mul_left' w m) + +/-- The order embedding sending `b` to `b * a`, for some fixed `a`. +See also `order_iso.mul_right` when working in an ordered group. -/ +@[to_additive "The order embedding sending `b` to `b + a`, for some fixed `a`. + See also `order_iso.add_right` when working in an additive ordered group.", simps] +def order_embedding.mul_right + {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (swap (*)) (<)] (m : α) : + α ↪o α := +order_embedding.of_strict_mono (λ n, n * m) (λ a b w, mul_lt_mul_right' w m) diff --git a/src/algebra/order/monoid/cancel/basic.lean b/src/algebra/order/monoid/cancel/basic.lean new file mode 100644 index 0000000000000..27fc04ea1e836 --- /dev/null +++ b/src/algebra/order/monoid/cancel/basic.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.monoid.basic +import algebra.order.monoid.cancel.defs + +/-! +# Basic results on ordered cancellative monoids. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We pull back ordered cancellative monoids along injective maps. +-/ + +universe u +variables {α : Type u} + +open function + +section ordered_cancel_comm_monoid +variables [ordered_cancel_comm_monoid α] + +/-- Pullback an `ordered_cancel_comm_monoid` under an injective map. +See note [reducible non-instances]. -/ +@[reducible, to_additive function.injective.ordered_cancel_add_comm_monoid +"Pullback an `ordered_cancel_add_comm_monoid` under an injective map."] +def function.injective.ordered_cancel_comm_monoid {β : Type*} + [has_one β] [has_mul β] [has_pow β ℕ] + (f : β → α) (hf : function.injective f) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + ordered_cancel_comm_monoid β := +{ le_of_mul_le_mul_left := λ a b c (bc : f (a * b) ≤ f (a * c)), + (mul_le_mul_iff_left (f a)).mp (by rwa [← mul, ← mul]), + ..hf.ordered_comm_monoid f one mul npow } + +end ordered_cancel_comm_monoid + +section linear_ordered_cancel_comm_monoid +variables [linear_ordered_cancel_comm_monoid α] + +/-- Pullback a `linear_ordered_cancel_comm_monoid` under an injective map. +See note [reducible non-instances]. -/ +@[reducible, to_additive function.injective.linear_ordered_cancel_add_comm_monoid +"Pullback a `linear_ordered_cancel_add_comm_monoid` under an injective map."] +def function.injective.linear_ordered_cancel_comm_monoid {β : Type*} + [has_one β] [has_mul β] [has_pow β ℕ] [has_sup β] [has_inf β] + (f : β → α) (hf : function.injective f) (one : f 1 = 1) + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_cancel_comm_monoid β := +{ ..hf.linear_ordered_comm_monoid f one mul npow hsup hinf, + ..hf.ordered_cancel_comm_monoid f one mul npow } + +end linear_ordered_cancel_comm_monoid diff --git a/src/algebra/order/monoid/cancel/defs.lean b/src/algebra/order/monoid/cancel/defs.lean new file mode 100644 index 0000000000000..d6c15af4ced82 --- /dev/null +++ b/src/algebra/order/monoid/cancel/defs.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.monoid.defs + +/-! +# Ordered cancellative monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universe u +variables {α : Type u} + +open function + +set_option old_structure_cmd true + +/-- An ordered cancellative additive commutative monoid +is an additive commutative monoid with a partial order, +in which addition is cancellative and monotone. -/ +@[protect_proj, ancestor add_comm_monoid partial_order] +class ordered_cancel_add_comm_monoid (α : Type u) extends add_comm_monoid α, partial_order α := +(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) +(le_of_add_le_add_left : ∀ a b c : α, a + b ≤ a + c → b ≤ c) + +/-- An ordered cancellative commutative monoid +is a commutative monoid with a partial order, +in which multiplication is cancellative and monotone. -/ +@[protect_proj, ancestor comm_monoid partial_order, to_additive] +class ordered_cancel_comm_monoid (α : Type u) extends comm_monoid α, partial_order α := +(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b) +(le_of_mul_le_mul_left : ∀ a b c : α, a * b ≤ a * c → b ≤ c) + +section ordered_cancel_comm_monoid +variables [ordered_cancel_comm_monoid α] {a b c d : α} + +@[priority 200, to_additive] -- see Note [lower instance priority] +instance ordered_cancel_comm_monoid.to_contravariant_class_le_left : + contravariant_class α α (*) (≤) := +⟨ordered_cancel_comm_monoid.le_of_mul_le_mul_left⟩ + +@[to_additive] +lemma ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left : ∀ a b c : α, a * b < a * c → b < c := +λ a b c h, lt_of_le_not_le + (ordered_cancel_comm_monoid.le_of_mul_le_mul_left a b c h.le) $ + mt (λ h, ordered_cancel_comm_monoid.mul_le_mul_left _ _ h _) (not_le_of_gt h) + +@[to_additive] +instance ordered_cancel_comm_monoid.to_contravariant_class_left + (M : Type*) [ordered_cancel_comm_monoid M] : + contravariant_class M M (*) (<) := +{ elim := λ a b c, ordered_cancel_comm_monoid.lt_of_mul_lt_mul_left _ _ _ } + +/- This instance can be proven with `by apply_instance`. However, by analogy with the +instance `ordered_cancel_comm_monoid.to_covariant_class_right` above, I imagine that without +this instance, some Type would not have a `contravariant_class M M (function.swap (*)) (<)` +instance. -/ +@[to_additive] +instance ordered_cancel_comm_monoid.to_contravariant_class_right + (M : Type*) [ordered_cancel_comm_monoid M] : + contravariant_class M M (swap (*)) (<) := +contravariant_swap_mul_lt_of_contravariant_mul_lt M + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance ordered_cancel_comm_monoid.to_ordered_comm_monoid : ordered_comm_monoid α := +{ ..‹ordered_cancel_comm_monoid α› } + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance ordered_cancel_comm_monoid.to_cancel_comm_monoid : cancel_comm_monoid α := +{ mul_left_cancel := λ a b c h, + (le_of_mul_le_mul_left' h.le).antisymm $ le_of_mul_le_mul_left' h.ge, + ..‹ordered_cancel_comm_monoid α› } + +end ordered_cancel_comm_monoid + +/-- A linearly ordered cancellative additive commutative monoid +is an additive commutative monoid with a decidable linear order +in which addition is cancellative and monotone. -/ +@[protect_proj, ancestor ordered_cancel_add_comm_monoid linear_ordered_add_comm_monoid] +class linear_ordered_cancel_add_comm_monoid (α : Type u) + extends ordered_cancel_add_comm_monoid α, linear_ordered_add_comm_monoid α + +/-- A linearly ordered cancellative commutative monoid +is a commutative monoid with a linear order +in which multiplication is cancellative and monotone. -/ +@[protect_proj, ancestor ordered_cancel_comm_monoid linear_ordered_comm_monoid, to_additive] +class linear_ordered_cancel_comm_monoid (α : Type u) + extends ordered_cancel_comm_monoid α, linear_ordered_comm_monoid α diff --git a/src/algebra/order/monoid/canonical/defs.lean b/src/algebra/order/monoid/canonical/defs.lean new file mode 100644 index 0000000000000..ddce37a99ab51 --- /dev/null +++ b/src/algebra/order/monoid/canonical/defs.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import order.bounded_order +import order.min_max +import algebra.ne_zero +import algebra.order.monoid.defs + +/-! +# Canonically ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universe u +variables {α : Type u} + +set_option old_structure_cmd true + +/-- An `ordered_comm_monoid` with one-sided 'division' in the sense that +if `a ≤ b`, there is some `c` for which `a * c = b`. This is a weaker version +of the condition on canonical orderings defined by `canonically_ordered_monoid`. -/ +class has_exists_mul_of_le (α : Type u) [has_mul α] [has_le α] : Prop := +(exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ (c : α), b = a * c) + +/-- An `ordered_add_comm_monoid` with one-sided 'subtraction' in the sense that +if `a ≤ b`, then there is some `c` for which `a + c = b`. This is a weaker version +of the condition on canonical orderings defined by `canonically_ordered_add_monoid`. -/ +class has_exists_add_of_le (α : Type u) [has_add α] [has_le α] : Prop := +(exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ (c : α), b = a + c) + +attribute [to_additive] has_exists_mul_of_le + +export has_exists_mul_of_le (exists_mul_of_le) + +export has_exists_add_of_le (exists_add_of_le) + +@[priority 100, to_additive] -- See note [lower instance priority] +instance group.has_exists_mul_of_le (α : Type u) [group α] [has_le α] : has_exists_mul_of_le α := +⟨λ a b hab, ⟨a⁻¹ * b, (mul_inv_cancel_left _ _).symm⟩⟩ + +section mul_one_class +variables [mul_one_class α] [preorder α] [contravariant_class α α (*) (<)] [has_exists_mul_of_le α] + {a b : α} + +@[to_additive] lemma exists_one_lt_mul_of_lt' (h : a < b) : ∃ c, 1 < c ∧ a * c = b := +by { obtain ⟨c, rfl⟩ := exists_mul_of_le h.le, exact ⟨c, one_lt_of_lt_mul_right h, rfl⟩ } + +end mul_one_class + +section has_exists_mul_of_le +variables [linear_order α] [densely_ordered α] [monoid α] [has_exists_mul_of_le α] + [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] {a b : α} + +@[to_additive] +lemma le_of_forall_one_lt_le_mul (h : ∀ ε : α, 1 < ε → a ≤ b * ε) : a ≤ b := +le_of_forall_le_of_dense $ λ x hxb, by { obtain ⟨ε, rfl⟩ := exists_mul_of_le hxb.le, + exact h _ ((lt_mul_iff_one_lt_right' b).1 hxb) } + +@[to_additive] +lemma le_of_forall_one_lt_lt_mul' (h : ∀ ε : α, 1 < ε → a < b * ε) : a ≤ b := +le_of_forall_one_lt_le_mul $ λ ε hε, (h _ hε).le + +@[to_additive] +lemma le_iff_forall_one_lt_lt_mul' : a ≤ b ↔ ∀ ε, 1 < ε → a < b * ε := +⟨λ h ε, lt_mul_of_le_of_one_lt h, le_of_forall_one_lt_lt_mul'⟩ + +end has_exists_mul_of_le + +/-- A canonically ordered additive monoid is an ordered commutative additive monoid + in which the ordering coincides with the subtractibility relation, + which is to say, `a ≤ b` iff there exists `c` with `b = a + c`. + This is satisfied by the natural numbers, for example, but not + the integers or other nontrivial `ordered_add_comm_group`s. -/ +@[protect_proj, ancestor ordered_add_comm_monoid has_bot] +class canonically_ordered_add_monoid (α : Type*) extends ordered_add_comm_monoid α, has_bot α := +(bot_le : ∀ x : α, ⊥ ≤ x) +(exists_add_of_le : ∀ {a b : α}, a ≤ b → ∃ c, b = a + c) +(le_self_add : ∀ a b : α, a ≤ a + b) + +@[priority 100] -- see Note [lower instance priority] +instance canonically_ordered_add_monoid.to_order_bot (α : Type u) + [h : canonically_ordered_add_monoid α] : order_bot α := +{ ..h } + +/-- A canonically ordered monoid is an ordered commutative monoid + in which the ordering coincides with the divisibility relation, + which is to say, `a ≤ b` iff there exists `c` with `b = a * c`. + Examples seem rare; it seems more likely that the `order_dual` + of a naturally-occurring lattice satisfies this than the lattice + itself (for example, dual of the lattice of ideals of a PID or + Dedekind domain satisfy this; collections of all things ≤ 1 seem to + be more natural that collections of all things ≥ 1). +-/ +@[protect_proj, ancestor ordered_comm_monoid has_bot, to_additive] +class canonically_ordered_monoid (α : Type*) extends ordered_comm_monoid α, has_bot α := +(bot_le : ∀ x : α, ⊥ ≤ x) +(exists_mul_of_le : ∀ {a b : α}, a ≤ b → ∃ c, b = a * c) +(le_self_mul : ∀ a b : α, a ≤ a * b) + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance canonically_ordered_monoid.to_order_bot (α : Type u) + [h : canonically_ordered_monoid α] : order_bot α := +{ ..h } + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance canonically_ordered_monoid.has_exists_mul_of_le (α : Type u) + [h : canonically_ordered_monoid α] : has_exists_mul_of_le α := +{ ..h } + +section canonically_ordered_monoid + +variables [canonically_ordered_monoid α] {a b c d : α} + +@[to_additive] lemma le_self_mul : a ≤ a * c := canonically_ordered_monoid.le_self_mul _ _ +@[to_additive] lemma le_mul_self : a ≤ b * a := by { rw mul_comm, exact le_self_mul } + +@[to_additive] lemma self_le_mul_right (a b : α) : a ≤ a * b := le_self_mul +@[to_additive] lemma self_le_mul_left (a b : α) : a ≤ b * a := le_mul_self + +@[to_additive] lemma le_of_mul_le_left : a * b ≤ c → a ≤ c := le_self_mul.trans +@[to_additive] lemma le_of_mul_le_right : a * b ≤ c → b ≤ c := le_mul_self.trans +@[to_additive] lemma le_mul_of_le_left : a ≤ b → a ≤ b * c := le_self_mul.trans' +@[to_additive] lemma le_mul_of_le_right : a ≤ c → a ≤ b * c := le_mul_self.trans' + +@[to_additive] +lemma le_iff_exists_mul : a ≤ b ↔ ∃ c, b = a * c := +⟨exists_mul_of_le, by { rintro ⟨c, rfl⟩, exact le_self_mul }⟩ + +@[to_additive] +lemma le_iff_exists_mul' : a ≤ b ↔ ∃ c, b = c * a := +by simpa only [mul_comm _ a] using le_iff_exists_mul + +@[simp, to_additive zero_le] lemma one_le (a : α) : 1 ≤ a := +le_iff_exists_mul.mpr ⟨a, (one_mul _).symm⟩ + +@[to_additive] lemma bot_eq_one : (⊥ : α) = 1 := +le_antisymm bot_le (one_le ⊥) + +--TODO: This is a special case of `mul_eq_one`. We need the instance +-- `canonically_ordered_monoid α → unique αˣ` +@[simp, to_additive] lemma mul_eq_one_iff : a * b = 1 ↔ a = 1 ∧ b = 1 := +mul_eq_one_iff' (one_le _) (one_le _) + +@[simp, to_additive] lemma le_one_iff_eq_one : a ≤ 1 ↔ a = 1 := +(one_le a).le_iff_eq + +@[to_additive] lemma one_lt_iff_ne_one : 1 < a ↔ a ≠ 1 := +(one_le a).lt_iff_ne.trans ne_comm + +@[to_additive] lemma eq_one_or_one_lt : a = 1 ∨ 1 < a := +(one_le a).eq_or_lt.imp_left eq.symm + +@[simp, to_additive add_pos_iff] lemma one_lt_mul_iff : 1 < a * b ↔ 1 < a ∨ 1 < b := +by simp only [one_lt_iff_ne_one, ne.def, mul_eq_one_iff, not_and_distrib] + +@[to_additive] lemma exists_one_lt_mul_of_lt (h : a < b) : ∃ c (hc : 1 < c), a * c = b := +begin + obtain ⟨c, hc⟩ := le_iff_exists_mul.1 h.le, + refine ⟨c, one_lt_iff_ne_one.2 _, hc.symm⟩, + rintro rfl, + simpa [hc, lt_irrefl] using h +end + +@[to_additive] lemma le_mul_left (h : a ≤ c) : a ≤ b * c := +calc a = 1 * a : by simp + ... ≤ b * c : mul_le_mul' (one_le _) h + +@[to_additive] lemma le_mul_right (h : a ≤ b) : a ≤ b * c := +calc a = a * 1 : by simp + ... ≤ b * c : mul_le_mul' h (one_le _) + +@[to_additive] +lemma lt_iff_exists_mul [covariant_class α α (*) (<)] : a < b ↔ ∃ c > 1, b = a * c := +begin + simp_rw [lt_iff_le_and_ne, and_comm, le_iff_exists_mul, ← exists_and_distrib_left, exists_prop], + apply exists_congr, intro c, + rw [and.congr_left_iff, gt_iff_lt], rintro rfl, + split, + { rw [one_lt_iff_ne_one], apply mt, rintro rfl, rw [mul_one] }, + { rw [← (self_le_mul_right a c).lt_iff_ne], apply lt_mul_of_one_lt_right' } +end + +end canonically_ordered_monoid + +lemma pos_of_gt {M : Type*} [canonically_ordered_add_monoid M] {n m : M} (h : n < m) : 0 < m := +lt_of_le_of_lt (zero_le _) h + +namespace ne_zero + +lemma pos {M} (a : M) [canonically_ordered_add_monoid M] [ne_zero a] : 0 < a := +(zero_le a).lt_of_ne $ ne_zero.out.symm + +lemma of_gt {M} [canonically_ordered_add_monoid M] {x y : M} (h : x < y) : ne_zero y := +of_pos $ pos_of_gt h + +-- 1 < p is still an often-used `fact`, due to `nat.prime` implying it, and it implying `nontrivial` +-- on `zmod`'s ring structure. We cannot just set this to be any `x < y`, else that becomes a +-- metavariable and it will hugely slow down typeclass inference. +@[priority 10] +instance of_gt' {M} [canonically_ordered_add_monoid M] [has_one M] {y : M} + [fact (1 < y)] : ne_zero y := +of_gt $ fact.out $ 1 < y + +instance bit0 {M} [canonically_ordered_add_monoid M] {x : M} [ne_zero x] : ne_zero (bit0 x) := +of_pos $ bit0_pos $ ne_zero.pos x + +end ne_zero + +/-- A canonically linear-ordered additive monoid is a canonically ordered additive monoid + whose ordering is a linear order. -/ +@[protect_proj, ancestor canonically_ordered_add_monoid linear_order] +class canonically_linear_ordered_add_monoid (α : Type*) + extends canonically_ordered_add_monoid α, linear_order α + +/-- A canonically linear-ordered monoid is a canonically ordered monoid + whose ordering is a linear order. -/ +@[protect_proj, ancestor canonically_ordered_monoid linear_order, to_additive] +class canonically_linear_ordered_monoid (α : Type*) + extends canonically_ordered_monoid α, linear_order α + +section canonically_linear_ordered_monoid +variables [canonically_linear_ordered_monoid α] + +@[priority 100, to_additive] -- see Note [lower instance priority] +instance canonically_linear_ordered_monoid.semilattice_sup : semilattice_sup α := +{ ..linear_order.to_lattice } + +@[to_additive] +lemma min_mul_distrib (a b c : α) : min a (b * c) = min a (min a b * min a c) := +begin + cases le_total a b with hb hb, + { simp [hb, le_mul_right] }, + { cases le_total a c with hc hc, + { simp [hc, le_mul_left] }, + { simp [hb, hc] } } +end + +@[to_additive] +lemma min_mul_distrib' (a b c : α) : min (a * b) c = min (min a c * min b c) c := +by simpa [min_comm _ c] using min_mul_distrib c a b + +@[simp, to_additive] +lemma one_min (a : α) : min 1 a = 1 := +min_eq_left (one_le a) + +@[simp, to_additive] +lemma min_one (a : α) : min a 1 = 1 := +min_eq_right (one_le a) + +/-- In a linearly ordered monoid, we are happy for `bot_eq_one` to be a `@[simp]` lemma. -/ +@[simp, to_additive + "In a linearly ordered monoid, we are happy for `bot_eq_zero` to be a `@[simp]` lemma"] +lemma bot_eq_one' : (⊥ : α) = 1 := +bot_eq_one + +end canonically_linear_ordered_monoid diff --git a/src/algebra/order/monoid/defs.lean b/src/algebra/order/monoid/defs.lean new file mode 100644 index 0000000000000..d4052dac4ecbc --- /dev/null +++ b/src/algebra/order/monoid/defs.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.monoid.lemmas +import order.bounded_order + +/-! +# Ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides the definitions of ordered monoids. + +-/ + +set_option old_structure_cmd true +open function + +universe u +variables {α : Type u} {β : Type*} + +/-- An ordered commutative monoid is a commutative monoid +with a partial order such that `a ≤ b → c * a ≤ c * b` (multiplication is monotone) +-/ +@[protect_proj, ancestor comm_monoid partial_order] +class ordered_comm_monoid (α : Type*) extends comm_monoid α, partial_order α := +(mul_le_mul_left : ∀ a b : α, a ≤ b → ∀ c : α, c * a ≤ c * b) + +/-- An ordered (additive) commutative monoid is a commutative monoid + with a partial order such that `a ≤ b → c + a ≤ c + b` (addition is monotone) +-/ +@[protect_proj, ancestor add_comm_monoid partial_order] +class ordered_add_comm_monoid (α : Type*) extends add_comm_monoid α, partial_order α := +(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) + +attribute [to_additive] ordered_comm_monoid + +section ordered_instances + +@[to_additive] +instance ordered_comm_monoid.to_covariant_class_left (M : Type*) [ordered_comm_monoid M] : + covariant_class M M (*) (≤) := +{ elim := λ a b c bc, ordered_comm_monoid.mul_le_mul_left _ _ bc a } + +/- This instance can be proven with `by apply_instance`. However, `with_bot ℕ` does not +pick up a `covariant_class M M (function.swap (*)) (≤)` instance without it (see PR #7940). -/ +@[to_additive] +instance ordered_comm_monoid.to_covariant_class_right (M : Type*) [ordered_comm_monoid M] : + covariant_class M M (swap (*)) (≤) := +covariant_swap_mul_le_of_covariant_mul_le M + +/- This is not an instance, to avoid creating a loop in the type-class system: in a +`left_cancel_semigroup` with a `partial_order`, assuming `covariant_class M M (*) (≤)` implies +`covariant_class M M (*) (<)`, see `left_cancel_semigroup.covariant_mul_lt_of_covariant_mul_le`. -/ +@[to_additive] lemma has_mul.to_covariant_class_left + (M : Type*) [has_mul M] [partial_order M] [covariant_class M M (*) (<)] : + covariant_class M M (*) (≤) := +⟨covariant_le_of_covariant_lt _ _ _ covariant_class.elim⟩ + +/- This is not an instance, to avoid creating a loop in the type-class system: in a +`right_cancel_semigroup` with a `partial_order`, assuming `covariant_class M M (swap (*)) (<)` +implies `covariant_class M M (swap (*)) (≤)`, see +`right_cancel_semigroup.covariant_swap_mul_lt_of_covariant_swap_mul_le`. -/ +@[to_additive] lemma has_mul.to_covariant_class_right + (M : Type*) [has_mul M] [partial_order M] [covariant_class M M (swap (*)) (<)] : + covariant_class M M (swap (*)) (≤) := +⟨covariant_le_of_covariant_lt _ _ _ covariant_class.elim⟩ + +end ordered_instances + +lemma bit0_pos [ordered_add_comm_monoid α] {a : α} (h : 0 < a) : 0 < bit0 a := +add_pos' h h + +/-- A linearly ordered additive commutative monoid. -/ +@[protect_proj, ancestor linear_order ordered_add_comm_monoid] +class linear_ordered_add_comm_monoid (α : Type*) + extends linear_order α, ordered_add_comm_monoid α. + +/-- A linearly ordered commutative monoid. -/ +@[protect_proj, ancestor linear_order ordered_comm_monoid, to_additive] +class linear_ordered_comm_monoid (α : Type*) + extends linear_order α, ordered_comm_monoid α. + +/-- A linearly ordered commutative monoid with an additively absorbing `⊤` element. + Instances should include number systems with an infinite element adjoined.` -/ +@[protect_proj, ancestor linear_ordered_add_comm_monoid has_top] +class linear_ordered_add_comm_monoid_with_top (α : Type*) + extends linear_ordered_add_comm_monoid α, has_top α := +(le_top : ∀ x : α, x ≤ ⊤) +(top_add' : ∀ x : α, ⊤ + x = ⊤) + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_add_comm_monoid_with_top.to_order_top (α : Type u) + [h : linear_ordered_add_comm_monoid_with_top α] : order_top α := +{ ..h } + +section linear_ordered_add_comm_monoid_with_top +variables [linear_ordered_add_comm_monoid_with_top α] {a b : α} + +@[simp] +lemma top_add (a : α) : ⊤ + a = ⊤ := linear_ordered_add_comm_monoid_with_top.top_add' a + +@[simp] +lemma add_top (a : α) : a + ⊤ = ⊤ := +trans (add_comm _ _) (top_add _) + +end linear_ordered_add_comm_monoid_with_top diff --git a/src/algebra/order/monoid/lemmas.lean b/src/algebra/order/monoid/lemmas.lean new file mode 100644 index 0000000000000..bbc1e04cab5f1 --- /dev/null +++ b/src/algebra/order/monoid/lemmas.lean @@ -0,0 +1,1250 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl, Damiano Testa, +Yuyang Zhao +-/ +import algebra.covariant_and_contravariant +import order.min_max + +/-! +# Ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file develops the basics of ordered monoids. + +## Implementation details + +Unfortunately, the number of `'` appended to lemmas in this file +may differ between the multiplicative and the additive version of a lemma. +The reason is that we did not want to change existing names in the library. + +## Remark + +Almost no monoid is actually present in this file: most assumptions have been generalized to +`has_mul` or `mul_one_class`. + +-/ + +-- TODO: If possible, uniformize lemma names, taking special care of `'`, +-- after the `ordered`-refactor is done. + +open function + +variables {α β : Type*} + +section has_mul +variables [has_mul α] + +section has_le +variables [has_le α] + +/- The prime on this lemma is present only on the multiplicative version. The unprimed version +is taken by the analogous lemma for semiring, with an extra non-negativity assumption. -/ +@[to_additive add_le_add_left] +lemma mul_le_mul_left' [covariant_class α α (*) (≤)] + {b c : α} (bc : b ≤ c) (a : α) : + a * b ≤ a * c := +covariant_class.elim _ bc + +@[to_additive le_of_add_le_add_left] +lemma le_of_mul_le_mul_left' [contravariant_class α α (*) (≤)] + {a b c : α} (bc : a * b ≤ a * c) : + b ≤ c := +contravariant_class.elim _ bc + +/- The prime on this lemma is present only on the multiplicative version. The unprimed version +is taken by the analogous lemma for semiring, with an extra non-negativity assumption. -/ +@[to_additive add_le_add_right] +lemma mul_le_mul_right' [covariant_class α α (swap (*)) (≤)] + {b c : α} (bc : b ≤ c) (a : α) : + b * a ≤ c * a := +covariant_class.elim a bc + +@[to_additive le_of_add_le_add_right] +lemma le_of_mul_le_mul_right' [contravariant_class α α (swap (*)) (≤)] + {a b c : α} (bc : b * a ≤ c * a) : + b ≤ c := +contravariant_class.elim a bc + +@[simp, to_additive] +lemma mul_le_mul_iff_left [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] + (a : α) {b c : α} : + a * b ≤ a * c ↔ b ≤ c := +rel_iff_cov α α (*) (≤) a + +@[simp, to_additive] +lemma mul_le_mul_iff_right + [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)] + (a : α) {b c : α} : + b * a ≤ c * a ↔ b ≤ c := +rel_iff_cov α α (swap (*)) (≤) a + +end has_le + +section has_lt +variables [has_lt α] + +@[simp, to_additive] +lemma mul_lt_mul_iff_left [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] + (a : α) {b c : α} : + a * b < a * c ↔ b < c := +rel_iff_cov α α (*) (<) a + +@[simp, to_additive] +lemma mul_lt_mul_iff_right + [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)] + (a : α) {b c : α} : + b * a < c * a ↔ b < c := +rel_iff_cov α α (swap (*)) (<) a + +@[to_additive add_lt_add_left] +lemma mul_lt_mul_left' [covariant_class α α (*) (<)] + {b c : α} (bc : b < c) (a : α) : + a * b < a * c := +covariant_class.elim _ bc + +@[to_additive lt_of_add_lt_add_left] +lemma lt_of_mul_lt_mul_left' [contravariant_class α α (*) (<)] + {a b c : α} (bc : a * b < a * c) : + b < c := +contravariant_class.elim _ bc + +@[to_additive add_lt_add_right] +lemma mul_lt_mul_right' [covariant_class α α (swap (*)) (<)] + {b c : α} (bc : b < c) (a : α) : + b * a < c * a := +covariant_class.elim a bc + +@[to_additive lt_of_add_lt_add_right] +lemma lt_of_mul_lt_mul_right' [contravariant_class α α (swap (*)) (<)] + {a b c : α} (bc : b * a < c * a) : + b < c := +contravariant_class.elim a bc + +end has_lt + +section preorder +variables [preorder α] + +@[to_additive] +lemma mul_lt_mul_of_lt_of_lt [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] + {a b c d : α} (h₁ : a < b) (h₂ : c < d) : a * c < b * d := +calc a * c < a * d : mul_lt_mul_left' h₂ a + ... < b * d : mul_lt_mul_right' h₁ d + +alias add_lt_add_of_lt_of_lt ← add_lt_add + +@[to_additive] +lemma mul_lt_mul_of_le_of_lt [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h₁ : a ≤ b) (h₂ : c < d) : a * c < b * d := +(mul_le_mul_right' h₁ _).trans_lt (mul_lt_mul_left' h₂ b) + +@[to_additive] +lemma mul_lt_mul_of_lt_of_le [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (<)] + {a b c d : α} (h₁ : a < b) (h₂ : c ≤ d) : a * c < b * d := +(mul_le_mul_left' h₂ _).trans_lt (mul_lt_mul_right' h₁ d) + +/-- Only assumes left strict covariance. -/ +@[to_additive "Only assumes left strict covariance"] +lemma left.mul_lt_mul [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h₁ : a < b) (h₂ : c < d) : a * c < b * d := +mul_lt_mul_of_le_of_lt h₁.le h₂ + +/-- Only assumes right strict covariance. -/ +@[to_additive "Only assumes right strict covariance"] +lemma right.mul_lt_mul [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (<)] + {a b c d : α} (h₁ : a < b) (h₂ : c < d) : a * c < b * d := +mul_lt_mul_of_lt_of_le h₁ h₂.le + +@[to_additive add_le_add] +lemma mul_le_mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d := +(mul_le_mul_left' h₂ _).trans (mul_le_mul_right' h₁ d) + +@[to_additive] +lemma mul_le_mul_three [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + {a b c d e f : α} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : + a * b * c ≤ d * e * f := +mul_le_mul' (mul_le_mul' h₁ h₂) h₃ + +@[to_additive] +lemma mul_lt_of_mul_lt_left [covariant_class α α (*) (≤)] + {a b c d : α} (h : a * b < c) (hle : d ≤ b) : + a * d < c := +(mul_le_mul_left' hle a).trans_lt h + +@[to_additive] +lemma mul_le_of_mul_le_left [covariant_class α α (*) (≤)] + {a b c d : α} (h : a * b ≤ c) (hle : d ≤ b) : + a * d ≤ c := +@act_rel_of_rel_of_act_rel _ _ _ (≤) _ ⟨λ _ _ _, le_trans⟩ a _ _ _ hle h + +@[to_additive] +lemma mul_lt_of_mul_lt_right [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h : a * b < c) (hle : d ≤ a) : + d * b < c := +(mul_le_mul_right' hle b).trans_lt h + +@[to_additive] +lemma mul_le_of_mul_le_right [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h : a * b ≤ c) (hle : d ≤ a) : + d * b ≤ c := +(mul_le_mul_right' hle b).trans h + +@[to_additive] +lemma lt_mul_of_lt_mul_left [covariant_class α α (*) (≤)] + {a b c d : α} (h : a < b * c) (hle : c ≤ d) : + a < b * d := +h.trans_le (mul_le_mul_left' hle b) + +@[to_additive] +lemma le_mul_of_le_mul_left [covariant_class α α (*) (≤)] + {a b c d : α} (h : a ≤ b * c) (hle : c ≤ d) : + a ≤ b * d := +@rel_act_of_rel_of_rel_act _ _ _ (≤) _ ⟨λ _ _ _, le_trans⟩ b _ _ _ hle h + +@[to_additive] +lemma lt_mul_of_lt_mul_right [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h : a < b * c) (hle : b ≤ d) : + a < d * c := +h.trans_le (mul_le_mul_right' hle c) + +@[to_additive] +lemma le_mul_of_le_mul_right [covariant_class α α (swap (*)) (≤)] + {a b c d : α} (h : a ≤ b * c) (hle : b ≤ d) : + a ≤ d * c := +h.trans (mul_le_mul_right' hle c) + +end preorder + +section partial_order +variables [partial_order α] + +@[to_additive] +lemma mul_left_cancel'' [contravariant_class α α (*) (≤)] + {a b c : α} (h : a * b = a * c) : + b = c := +(le_of_mul_le_mul_left' h.le).antisymm (le_of_mul_le_mul_left' h.ge) + +@[to_additive] +lemma mul_right_cancel'' [contravariant_class α α (swap (*)) (≤)] + {a b c : α} (h : a * b = c * b) : + a = c := +le_antisymm (le_of_mul_le_mul_right' h.le) (le_of_mul_le_mul_right' h.ge) + +end partial_order + +section linear_order +variables [linear_order α] {a b c d : α} [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (<)] + +@[to_additive] lemma min_le_max_of_mul_le_mul (h : a * b ≤ c * d) : min a b ≤ max c d := +by { simp_rw [min_le_iff, le_max_iff], contrapose! h, exact mul_lt_mul_of_lt_of_lt h.1.1 h.2.2 } + +end linear_order + +section linear_order +variables [linear_order α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + {a b c d : α} + +@[to_additive max_add_add_le_max_add_max] lemma max_mul_mul_le_max_mul_max' : + max (a * b) (c * d) ≤ max a c * max b d := +max_le (mul_le_mul' (le_max_left _ _) $ le_max_left _ _) $ + mul_le_mul' (le_max_right _ _) $ le_max_right _ _ + +--TODO: Also missing `min_mul_min_le_min_mul_mul` +@[to_additive min_add_min_le_min_add_add] lemma min_mul_min_le_min_mul_mul' : + min a c * min b d ≤ min (a * b) (c * d) := +le_min (mul_le_mul' (min_le_left _ _) $ min_le_left _ _) $ + mul_le_mul' (min_le_right _ _) $ min_le_right _ _ + +end linear_order +end has_mul + +-- using one +section mul_one_class +variables [mul_one_class α] + +section has_le +variables [has_le α] + +@[to_additive le_add_of_nonneg_right] +lemma le_mul_of_one_le_right' [covariant_class α α (*) (≤)] + {a b : α} (h : 1 ≤ b) : + a ≤ a * b := +calc a = a * 1 : (mul_one a).symm + ... ≤ a * b : mul_le_mul_left' h a + +@[to_additive add_le_of_nonpos_right] +lemma mul_le_of_le_one_right' [covariant_class α α (*) (≤)] + {a b : α} (h : b ≤ 1) : + a * b ≤ a := +calc a * b ≤ a * 1 : mul_le_mul_left' h a + ... = a : mul_one a + +@[to_additive le_add_of_nonneg_left] +lemma le_mul_of_one_le_left' [covariant_class α α (swap (*)) (≤)] + {a b : α} (h : 1 ≤ b) : + a ≤ b * a := +calc a = 1 * a : (one_mul a).symm + ... ≤ b * a : mul_le_mul_right' h a + +@[to_additive add_le_of_nonpos_left] +lemma mul_le_of_le_one_left' [covariant_class α α (swap (*)) (≤)] + {a b : α} (h : b ≤ 1) : + b * a ≤ a := +calc b * a ≤ 1 * a : mul_le_mul_right' h a + ... = a : one_mul a + +@[to_additive] +lemma one_le_of_le_mul_right [contravariant_class α α (*) (≤)] {a b : α} (h : a ≤ a * b) : 1 ≤ b := +le_of_mul_le_mul_left' $ by simpa only [mul_one] + +@[to_additive] +lemma le_one_of_mul_le_right [contravariant_class α α (*) (≤)] {a b : α} (h : a * b ≤ a) : b ≤ 1 := +le_of_mul_le_mul_left' $ by simpa only [mul_one] + +@[to_additive] +lemma one_le_of_le_mul_left [contravariant_class α α (swap (*)) (≤)] {a b : α} (h : b ≤ a * b) : + 1 ≤ a := +le_of_mul_le_mul_right' $ by simpa only [one_mul] + +@[to_additive] +lemma le_one_of_mul_le_left [contravariant_class α α (swap (*)) (≤)] {a b : α} (h : a * b ≤ b) : + a ≤ 1 := +le_of_mul_le_mul_right' $ by simpa only [one_mul] + +@[simp, to_additive le_add_iff_nonneg_right] +lemma le_mul_iff_one_le_right' + [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] + (a : α) {b : α} : + a ≤ a * b ↔ 1 ≤ b := +iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a) + +@[simp, to_additive le_add_iff_nonneg_left] +lemma le_mul_iff_one_le_left' + [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)] + (a : α) {b : α} : + a ≤ b * a ↔ 1 ≤ b := +iff.trans (by rw one_mul) (mul_le_mul_iff_right a) + +@[simp, to_additive add_le_iff_nonpos_right] +lemma mul_le_iff_le_one_right' + [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] + (a : α) {b : α} : + a * b ≤ a ↔ b ≤ 1 := +iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a) + +@[simp, to_additive add_le_iff_nonpos_left] +lemma mul_le_iff_le_one_left' + [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)] + {a b : α} : + a * b ≤ b ↔ a ≤ 1 := +iff.trans (by rw one_mul) (mul_le_mul_iff_right b) + +end has_le + +section has_lt +variable [has_lt α] + +@[to_additive lt_add_of_pos_right] +lemma lt_mul_of_one_lt_right' [covariant_class α α (*) (<)] + (a : α) {b : α} (h : 1 < b) : + a < a * b := +calc a = a * 1 : (mul_one a).symm + ... < a * b : mul_lt_mul_left' h a + +@[to_additive add_lt_of_neg_right] +lemma mul_lt_of_lt_one_right' [covariant_class α α (*) (<)] + (a : α) {b : α} (h : b < 1) : + a * b < a := +calc a * b < a * 1 : mul_lt_mul_left' h a + ... = a : mul_one a + +@[to_additive lt_add_of_pos_left] +lemma lt_mul_of_one_lt_left' [covariant_class α α (swap (*)) (<)] + (a : α) {b : α} (h : 1 < b) : + a < b * a := +calc a = 1 * a : (one_mul a).symm + ... < b * a : mul_lt_mul_right' h a + +@[to_additive add_lt_of_neg_left] +lemma mul_lt_of_lt_one_left' [covariant_class α α (swap (*)) (<)] + (a : α) {b : α} (h : b < 1) : + b * a < a := +calc b * a < 1 * a : mul_lt_mul_right' h a + ... = a : one_mul a + +@[to_additive] +lemma one_lt_of_lt_mul_right [contravariant_class α α (*) (<)] {a b : α} (h : a < a * b) : 1 < b := +lt_of_mul_lt_mul_left' $ by simpa only [mul_one] + +@[to_additive] +lemma lt_one_of_mul_lt_right [contravariant_class α α (*) (<)] {a b : α} (h : a * b < a) : b < 1 := +lt_of_mul_lt_mul_left' $ by simpa only [mul_one] + +@[to_additive] +lemma one_lt_of_lt_mul_left [contravariant_class α α (swap (*)) (<)] {a b : α} (h : b < a * b) : + 1 < a := +lt_of_mul_lt_mul_right' $ by simpa only [one_mul] + +@[to_additive] +lemma lt_one_of_mul_lt_left [contravariant_class α α (swap (*)) (<)] {a b : α} (h : a * b < b) : + a < 1 := +lt_of_mul_lt_mul_right' $ by simpa only [one_mul] + +@[simp, to_additive lt_add_iff_pos_right] +lemma lt_mul_iff_one_lt_right' + [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] + (a : α) {b : α} : + a < a * b ↔ 1 < b := +iff.trans (by rw mul_one) (mul_lt_mul_iff_left a) + +@[simp, to_additive lt_add_iff_pos_left] +lemma lt_mul_iff_one_lt_left' + [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)] + (a : α) {b : α} : + a < b * a ↔ 1 < b := +iff.trans (by rw one_mul) (mul_lt_mul_iff_right a) + +@[simp, to_additive add_lt_iff_neg_left] +lemma mul_lt_iff_lt_one_left' + [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] + {a b : α} : + a * b < a ↔ b < 1 := +iff.trans (by rw mul_one) (mul_lt_mul_iff_left a) + +@[simp, to_additive add_lt_iff_neg_right] +lemma mul_lt_iff_lt_one_right' + [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)] + {a : α} (b : α) : + a * b < b ↔ a < 1 := +iff.trans (by rw one_mul) (mul_lt_mul_iff_right b) + +end has_lt + +section preorder +variable [preorder α] + +/-! Lemmas of the form `b ≤ c → a ≤ 1 → b * a ≤ c`, +which assume left covariance. -/ + +@[to_additive] +lemma mul_le_of_le_of_le_one [covariant_class α α (*) (≤)] + {a b c : α} (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c := +calc b * a ≤ b * 1 : mul_le_mul_left' ha b + ... = b : mul_one b + ... ≤ c : hbc + +@[to_additive] +lemma mul_lt_of_le_of_lt_one [covariant_class α α (*) (<)] + {a b c : α} (hbc : b ≤ c) (ha : a < 1) : b * a < c := +calc b * a < b * 1 : mul_lt_mul_left' ha b + ... = b : mul_one b + ... ≤ c : hbc + +@[to_additive] +lemma mul_lt_of_lt_of_le_one [covariant_class α α (*) (≤)] + {a b c : α} (hbc : b < c) (ha : a ≤ 1) : b * a < c := +calc b * a ≤ b * 1 : mul_le_mul_left' ha b + ... = b : mul_one b + ... < c : hbc + +@[to_additive] +lemma mul_lt_of_lt_of_lt_one [covariant_class α α (*) (<)] + {a b c : α} (hbc : b < c) (ha : a < 1) : b * a < c := +calc b * a < b * 1 : mul_lt_mul_left' ha b + ... = b : mul_one b + ... < c : hbc + +@[to_additive] +lemma mul_lt_of_lt_of_lt_one' [covariant_class α α (*) (≤)] + {a b c : α} (hbc : b < c) (ha : a < 1) : b * a < c := +mul_lt_of_lt_of_le_one hbc ha.le + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.mul_le_one`. -/ +@[to_additive "Assumes left covariance. +The lemma assuming right covariance is `right.add_nonpos`."] +lemma left.mul_le_one [covariant_class α α (*) (≤)] + {a b : α} (ha : a ≤ 1) (hb : b ≤ 1) : a * b ≤ 1 := +mul_le_of_le_of_le_one ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.mul_lt_one_of_le_of_lt`. -/ +@[to_additive left.add_neg_of_nonpos_of_neg "Assumes left covariance. +The lemma assuming right covariance is `right.add_neg_of_nonpos_of_neg`."] +lemma left.mul_lt_one_of_le_of_lt [covariant_class α α (*) (<)] + {a b : α} (ha : a ≤ 1) (hb : b < 1) : a * b < 1 := +mul_lt_of_le_of_lt_one ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.mul_lt_one_of_lt_of_le`. -/ +@[to_additive left.add_neg_of_neg_of_nonpos "Assumes left covariance. +The lemma assuming right covariance is `right.add_neg_of_neg_of_nonpos`."] +lemma left.mul_lt_one_of_lt_of_le [covariant_class α α (*) (≤)] + {a b : α} (ha : a < 1) (hb : b ≤ 1) : a * b < 1 := +mul_lt_of_lt_of_le_one ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.mul_lt_one`. -/ +@[to_additive "Assumes left covariance. +The lemma assuming right covariance is `right.add_neg`."] +lemma left.mul_lt_one [covariant_class α α (*) (<)] + {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 := +mul_lt_of_lt_of_lt_one ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.mul_lt_one'`. -/ +@[to_additive "Assumes left covariance. +The lemma assuming right covariance is `right.add_neg'`."] +lemma left.mul_lt_one' [covariant_class α α (*) (≤)] + {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 := +mul_lt_of_lt_of_lt_one' ha hb + +/-! Lemmas of the form `b ≤ c → 1 ≤ a → b ≤ c * a`, +which assume left covariance. -/ + +@[to_additive] +lemma le_mul_of_le_of_one_le [covariant_class α α (*) (≤)] + {a b c : α} (hbc : b ≤ c) (ha : 1 ≤ a) : b ≤ c * a := +calc b ≤ c : hbc + ... = c * 1 : (mul_one c).symm + ... ≤ c * a : mul_le_mul_left' ha c + +@[to_additive] +lemma lt_mul_of_le_of_one_lt [covariant_class α α (*) (<)] + {a b c : α} (hbc : b ≤ c) (ha : 1 < a) : b < c * a := +calc b ≤ c : hbc + ... = c * 1 : (mul_one c).symm + ... < c * a : mul_lt_mul_left' ha c + +@[to_additive] +lemma lt_mul_of_lt_of_one_le [covariant_class α α (*) (≤)] + {a b c : α} (hbc : b < c) (ha : 1 ≤ a) : b < c * a := +calc b < c : hbc + ... = c * 1 : (mul_one c).symm + ... ≤ c * a : mul_le_mul_left' ha c + +@[to_additive] +lemma lt_mul_of_lt_of_one_lt [covariant_class α α (*) (<)] + {a b c : α} (hbc : b < c) (ha : 1 < a) : b < c * a := +calc b < c : hbc + ... = c * 1 : (mul_one c).symm + ... < c * a : mul_lt_mul_left' ha c + +@[to_additive] +lemma lt_mul_of_lt_of_one_lt' [covariant_class α α (*) (≤)] + {a b c : α} (hbc : b < c) (ha : 1 < a) : b < c * a := +lt_mul_of_lt_of_one_le hbc ha.le + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.one_le_mul`. -/ +@[to_additive left.add_nonneg "Assumes left covariance. +The lemma assuming right covariance is `right.add_nonneg`."] +lemma left.one_le_mul [covariant_class α α (*) (≤)] + {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b := +le_mul_of_le_of_one_le ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.one_lt_mul_of_le_of_lt`. -/ +@[to_additive left.add_pos_of_nonneg_of_pos "Assumes left covariance. +The lemma assuming right covariance is `right.add_pos_of_nonneg_of_pos`."] +lemma left.one_lt_mul_of_le_of_lt [covariant_class α α (*) (<)] + {a b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b := +lt_mul_of_le_of_one_lt ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.one_lt_mul_of_lt_of_le`. -/ +@[to_additive left.add_pos_of_pos_of_nonneg "Assumes left covariance. +The lemma assuming right covariance is `right.add_pos_of_pos_of_nonneg`."] +lemma left.one_lt_mul_of_lt_of_le [covariant_class α α (*) (≤)] + {a b : α} (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b := +lt_mul_of_lt_of_one_le ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.one_lt_mul`. -/ +@[to_additive left.add_pos "Assumes left covariance. +The lemma assuming right covariance is `right.add_pos`."] +lemma left.one_lt_mul [covariant_class α α (*) (<)] + {a b : α} (ha : 1 < a) (hb : 1 < b) : 1 < a * b := +lt_mul_of_lt_of_one_lt ha hb + +/-- Assumes left covariance. +The lemma assuming right covariance is `right.one_lt_mul'`. -/ +@[to_additive left.add_pos' "Assumes left covariance. +The lemma assuming right covariance is `right.add_pos'`."] +lemma left.one_lt_mul' [covariant_class α α (*) (≤)] + {a b : α} (ha : 1 < a) (hb : 1 < b) : 1 < a * b := +lt_mul_of_lt_of_one_lt' ha hb + +/-! Lemmas of the form `a ≤ 1 → b ≤ c → a * b ≤ c`, +which assume right covariance. -/ + +@[to_additive] +lemma mul_le_of_le_one_of_le [covariant_class α α (swap (*)) (≤)] + {a b c : α} (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c := +calc a * b ≤ 1 * b : mul_le_mul_right' ha b + ... = b : one_mul b + ... ≤ c : hbc + +@[to_additive] +lemma mul_lt_of_lt_one_of_le [covariant_class α α (swap (*)) (<)] + {a b c : α} (ha : a < 1) (hbc : b ≤ c) : a * b < c := +calc a * b < 1 * b : mul_lt_mul_right' ha b + ... = b : one_mul b + ... ≤ c : hbc + +@[to_additive] +lemma mul_lt_of_le_one_of_lt [covariant_class α α (swap (*)) (≤)] + {a b c : α} (ha : a ≤ 1) (hb : b < c) : a * b < c := +calc a * b ≤ 1 * b : mul_le_mul_right' ha b + ... = b : one_mul b + ... < c : hb + +@[to_additive] +lemma mul_lt_of_lt_one_of_lt [covariant_class α α (swap (*)) (<)] + {a b c : α} (ha : a < 1) (hb : b < c) : a * b < c := +calc a * b < 1 * b : mul_lt_mul_right' ha b + ... = b : one_mul b + ... < c : hb + +@[to_additive] +lemma mul_lt_of_lt_one_of_lt' [covariant_class α α (swap (*)) (≤)] + {a b c : α} (ha : a < 1) (hbc : b < c) : a * b < c := +mul_lt_of_le_one_of_lt ha.le hbc + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.mul_le_one`. -/ +@[to_additive "Assumes right covariance. +The lemma assuming left covariance is `left.add_nonpos`."] +lemma right.mul_le_one [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : a ≤ 1) (hb : b ≤ 1) : a * b ≤ 1 := +mul_le_of_le_one_of_le ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.mul_lt_one_of_lt_of_le`. -/ +@[to_additive right.add_neg_of_neg_of_nonpos "Assumes right covariance. +The lemma assuming left covariance is `left.add_neg_of_neg_of_nonpos`."] +lemma right.mul_lt_one_of_lt_of_le [covariant_class α α (swap (*)) (<)] + {a b : α} (ha : a < 1) (hb : b ≤ 1) : a * b < 1 := +mul_lt_of_lt_one_of_le ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.mul_lt_one_of_le_of_lt`. -/ +@[to_additive right.add_neg_of_nonpos_of_neg "Assumes right covariance. +The lemma assuming left covariance is `left.add_neg_of_nonpos_of_neg`."] +lemma right.mul_lt_one_of_le_of_lt [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : a ≤ 1) (hb : b < 1) : a * b < 1 := +mul_lt_of_le_one_of_lt ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.mul_lt_one`. -/ +@[to_additive "Assumes right covariance. +The lemma assuming left covariance is `left.add_neg`."] +lemma right.mul_lt_one [covariant_class α α (swap (*)) (<)] + {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 := +mul_lt_of_lt_one_of_lt ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.mul_lt_one'`. -/ +@[to_additive "Assumes right covariance. +The lemma assuming left covariance is `left.add_neg'`."] +lemma right.mul_lt_one' [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 := +mul_lt_of_lt_one_of_lt' ha hb + +/-! Lemmas of the form `1 ≤ a → b ≤ c → b ≤ a * c`, +which assume right covariance. -/ + +@[to_additive] +lemma le_mul_of_one_le_of_le [covariant_class α α (swap (*)) (≤)] + {a b c : α} (ha : 1 ≤ a) (hbc : b ≤ c) : b ≤ a * c := +calc b ≤ c : hbc + ... = 1 * c : (one_mul c).symm + ... ≤ a * c : mul_le_mul_right' ha c + +@[to_additive] +lemma lt_mul_of_one_lt_of_le [covariant_class α α (swap (*)) (<)] + {a b c : α} (ha : 1 < a) (hbc : b ≤ c) : b < a * c := +calc b ≤ c : hbc + ... = 1 * c : (one_mul c).symm + ... < a * c : mul_lt_mul_right' ha c + +@[to_additive] +lemma lt_mul_of_one_le_of_lt [covariant_class α α (swap (*)) (≤)] + {a b c : α} (ha : 1 ≤ a) (hbc : b < c) : b < a * c := +calc b < c : hbc + ... = 1 * c : (one_mul c).symm + ... ≤ a * c : mul_le_mul_right' ha c + +@[to_additive] +lemma lt_mul_of_one_lt_of_lt [covariant_class α α (swap (*)) (<)] + {a b c : α} (ha : 1 < a) (hbc : b < c) : b < a * c := +calc b < c : hbc + ... = 1 * c : (one_mul c).symm + ... < a * c : mul_lt_mul_right' ha c + +@[to_additive] +lemma lt_mul_of_one_lt_of_lt' [covariant_class α α (swap (*)) (≤)] + {a b c : α} (ha : 1 < a) (hbc : b < c) : b < a * c := +lt_mul_of_one_le_of_lt ha.le hbc + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.one_le_mul`. -/ +@[to_additive right.add_nonneg "Assumes right covariance. +The lemma assuming left covariance is `left.add_nonneg`."] +lemma right.one_le_mul [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b := +le_mul_of_one_le_of_le ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.one_lt_mul_of_lt_of_le`. -/ +@[to_additive right.add_pos_of_pos_of_nonneg "Assumes right covariance. +The lemma assuming left covariance is `left.add_pos_of_pos_of_nonneg`."] +lemma right.one_lt_mul_of_lt_of_le [covariant_class α α (swap (*)) (<)] + {a b : α} (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b := +lt_mul_of_one_lt_of_le ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.one_lt_mul_of_le_of_lt`. -/ +@[to_additive right.add_pos_of_nonneg_of_pos "Assumes right covariance. +The lemma assuming left covariance is `left.add_pos_of_nonneg_of_pos`."] +lemma right.one_lt_mul_of_le_of_lt [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b := +lt_mul_of_one_le_of_lt ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.one_lt_mul`. -/ +@[to_additive right.add_pos "Assumes right covariance. +The lemma assuming left covariance is `left.add_pos`."] +lemma right.one_lt_mul [covariant_class α α (swap (*)) (<)] + {a b : α} (ha : 1 < a) (hb : 1 < b) : 1 < a * b := +lt_mul_of_one_lt_of_lt ha hb + +/-- Assumes right covariance. +The lemma assuming left covariance is `left.one_lt_mul'`. -/ +@[to_additive right.add_pos' "Assumes right covariance. +The lemma assuming left covariance is `left.add_pos'`."] +lemma right.one_lt_mul' [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : 1 < a) (hb : 1 < b) : 1 < a * b := +lt_mul_of_one_lt_of_lt' ha hb + +alias left.mul_le_one ← mul_le_one' +alias left.mul_lt_one_of_le_of_lt ← mul_lt_one_of_le_of_lt +alias left.mul_lt_one_of_lt_of_le ← mul_lt_one_of_lt_of_le +alias left.mul_lt_one ← mul_lt_one +alias left.mul_lt_one' ← mul_lt_one' +attribute [to_additive add_nonpos "**Alias** of `left.add_nonpos`."] +mul_le_one' +attribute [to_additive add_neg_of_nonpos_of_neg "**Alias** of `left.add_neg_of_nonpos_of_neg`."] +mul_lt_one_of_le_of_lt +attribute [to_additive add_neg_of_neg_of_nonpos "**Alias** of `left.add_neg_of_neg_of_nonpos`."] +mul_lt_one_of_lt_of_le +attribute [to_additive "**Alias** of `left.add_neg`."] +mul_lt_one +attribute [to_additive "**Alias** of `left.add_neg'`."] +mul_lt_one' + +alias left.one_le_mul ← one_le_mul +alias left.one_lt_mul_of_le_of_lt ← one_lt_mul_of_le_of_lt' +alias left.one_lt_mul_of_lt_of_le ← one_lt_mul_of_lt_of_le' +alias left.one_lt_mul ← one_lt_mul' +alias left.one_lt_mul' ← one_lt_mul'' +attribute [to_additive add_nonneg "**Alias** of `left.add_nonneg`."] +one_le_mul +attribute [to_additive add_pos_of_nonneg_of_pos "**Alias** of `left.add_pos_of_nonneg_of_pos`."] +one_lt_mul_of_le_of_lt' +attribute [to_additive add_pos_of_pos_of_nonneg "**Alias** of `left.add_pos_of_pos_of_nonneg`."] +one_lt_mul_of_lt_of_le' +attribute [to_additive add_pos "**Alias** of `left.add_pos`."] +one_lt_mul' +attribute [to_additive add_pos' "**Alias** of `left.add_pos'`."] +one_lt_mul'' + +@[to_additive] +lemma lt_of_mul_lt_of_one_le_left [covariant_class α α (*) (≤)] + {a b c : α} (h : a * b < c) (hle : 1 ≤ b) : a < c := +(le_mul_of_one_le_right' hle).trans_lt h + +@[to_additive] +lemma le_of_mul_le_of_one_le_left [covariant_class α α (*) (≤)] + {a b c : α} (h : a * b ≤ c) (hle : 1 ≤ b) : a ≤ c := +(le_mul_of_one_le_right' hle).trans h + +@[to_additive] +lemma lt_of_lt_mul_of_le_one_left [covariant_class α α (*) (≤)] + {a b c : α} (h : a < b * c) (hle : c ≤ 1) : a < b := +h.trans_le (mul_le_of_le_one_right' hle) + +@[to_additive] +lemma le_of_le_mul_of_le_one_left [covariant_class α α (*) (≤)] + {a b c : α} (h : a ≤ b * c) (hle : c ≤ 1) : a ≤ b := +h.trans (mul_le_of_le_one_right' hle) + +@[to_additive] +lemma lt_of_mul_lt_of_one_le_right [covariant_class α α (swap (*)) (≤)] + {a b c : α} (h : a * b < c) (hle : 1 ≤ a) : b < c := +(le_mul_of_one_le_left' hle).trans_lt h + +@[to_additive] +lemma le_of_mul_le_of_one_le_right [covariant_class α α (swap (*)) (≤)] + {a b c : α} (h : a * b ≤ c) (hle : 1 ≤ a) : b ≤ c := +(le_mul_of_one_le_left' hle).trans h + +@[to_additive] +lemma lt_of_lt_mul_of_le_one_right [covariant_class α α (swap (*)) (≤)] + {a b c : α} (h : a < b * c) (hle : b ≤ 1) : a < c := +h.trans_le (mul_le_of_le_one_left' hle) + +@[to_additive] +lemma le_of_le_mul_of_le_one_right [covariant_class α α (swap (*)) (≤)] + {a b c : α} (h : a ≤ b * c) (hle : b ≤ 1) : a ≤ c := +h.trans (mul_le_of_le_one_left' hle) + +end preorder + +section partial_order +variables [partial_order α] + +@[to_additive] +lemma mul_eq_one_iff' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 := +iff.intro + (assume hab : a * b = 1, + have a ≤ 1, from hab ▸ le_mul_of_le_of_one_le le_rfl hb, + have a = 1, from le_antisymm this ha, + have b ≤ 1, from hab ▸ le_mul_of_one_le_of_le ha le_rfl, + have b = 1, from le_antisymm this hb, + and.intro ‹a = 1› ‹b = 1›) + (assume ⟨ha', hb'⟩, by rw [ha', hb', mul_one]) + +@[to_additive] lemma mul_le_mul_iff_of_ge [covariant_class α α (*) (≤)] + [covariant_class α α (swap (*)) (≤)] [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (<)] {a₁ a₂ b₁ b₂ : α} (ha : a₁ ≤ a₂) (hb : b₁ ≤ b₂) : + a₂ * b₂ ≤ a₁ * b₁ ↔ a₁ = a₂ ∧ b₁ = b₂ := +begin + refine ⟨λ h, _, by { rintro ⟨rfl, rfl⟩, refl }⟩, + simp only [eq_iff_le_not_lt, ha, hb, true_and], + refine ⟨λ ha, h.not_lt _, λ hb, h.not_lt _⟩, + { exact mul_lt_mul_of_lt_of_le ha hb }, + { exact mul_lt_mul_of_le_of_lt ha hb } +end + +section left +variables [covariant_class α α (*) (≤)] {a b : α} + +@[to_additive eq_zero_of_add_nonneg_left] +lemma eq_one_of_one_le_mul_left (ha : a ≤ 1) (hb : b ≤ 1) (hab : 1 ≤ a * b) : a = 1 := +ha.eq_of_not_lt $ λ h, hab.not_lt $ mul_lt_one_of_lt_of_le h hb + +@[to_additive] +lemma eq_one_of_mul_le_one_left (ha : 1 ≤ a) (hb : 1 ≤ b) (hab : a * b ≤ 1) : a = 1 := +ha.eq_of_not_gt $ λ h, hab.not_lt $ one_lt_mul_of_lt_of_le' h hb + +end left + +section right +variables [covariant_class α α (swap (*)) (≤)] {a b : α} + +@[to_additive eq_zero_of_add_nonneg_right] +lemma eq_one_of_one_le_mul_right (ha : a ≤ 1) (hb : b ≤ 1) (hab : 1 ≤ a * b) : b = 1 := +hb.eq_of_not_lt $ λ h, hab.not_lt $ right.mul_lt_one_of_le_of_lt ha h + +@[to_additive] +lemma eq_one_of_mul_le_one_right (ha : 1 ≤ a) (hb : 1 ≤ b) (hab : a * b ≤ 1) : b = 1 := +hb.eq_of_not_gt $ λ h, hab.not_lt $ right.one_lt_mul_of_le_of_lt ha h + +end right +end partial_order + +section linear_order +variables [linear_order α] + +lemma exists_square_le [covariant_class α α (*) (<)] + (a : α) : ∃ (b : α), b * b ≤ a := +begin + by_cases h : a < 1, + { use a, + have : a*a < a*1, + exact mul_lt_mul_left' h a, + rw mul_one at this, + exact le_of_lt this }, + { use 1, + push_neg at h, + rwa mul_one } +end + +end linear_order + +end mul_one_class + +section semigroup +variables [semigroup α] + +section partial_order +variables [partial_order α] + +/- This is not instance, since we want to have an instance from `left_cancel_semigroup`s +to the appropriate `covariant_class`. -/ +/-- A semigroup with a partial order and satisfying `left_cancel_semigroup` +(i.e. `a * c < b * c → a < b`) is a `left_cancel semigroup`. -/ +@[to_additive +"An additive semigroup with a partial order and satisfying `left_cancel_add_semigroup` +(i.e. `c + a < c + b → a < b`) is a `left_cancel add_semigroup`."] +def contravariant.to_left_cancel_semigroup + [contravariant_class α α (*) (≤)] : + left_cancel_semigroup α := +{ mul_left_cancel := λ a b c, mul_left_cancel'' + ..‹semigroup α› } + +/- This is not instance, since we want to have an instance from `right_cancel_semigroup`s +to the appropriate `covariant_class`. -/ +/-- A semigroup with a partial order and satisfying `right_cancel_semigroup` +(i.e. `a * c < b * c → a < b`) is a `right_cancel semigroup`. -/ +@[to_additive +"An additive semigroup with a partial order and satisfying `right_cancel_add_semigroup` +(`a + c < b + c → a < b`) is a `right_cancel add_semigroup`."] +def contravariant.to_right_cancel_semigroup + [contravariant_class α α (swap (*)) (≤)] : + right_cancel_semigroup α := +{ mul_right_cancel := λ a b c, mul_right_cancel'' + ..‹semigroup α› } + +@[to_additive] lemma left.mul_eq_mul_iff_eq_and_eq + [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] + [contravariant_class α α (*) (≤)] [contravariant_class α α (swap (*)) (≤)] + {a b c d : α} (hac : a ≤ c) (hbd : b ≤ d) : a * b = c * d ↔ a = c ∧ b = d := +begin + refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩, + rcases hac.eq_or_lt with rfl | hac, + { exact ⟨rfl, mul_left_cancel'' h⟩ }, + rcases eq_or_lt_of_le hbd with rfl | hbd, + { exact ⟨mul_right_cancel'' h, rfl⟩ }, + exact ((left.mul_lt_mul hac hbd).ne h).elim, +end + +@[to_additive] lemma right.mul_eq_mul_iff_eq_and_eq + [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] + [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (≤)] + {a b c d : α} (hac : a ≤ c) (hbd : b ≤ d) : a * b = c * d ↔ a = c ∧ b = d := +begin + refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩, + rcases hac.eq_or_lt with rfl | hac, + { exact ⟨rfl, mul_left_cancel'' h⟩ }, + rcases eq_or_lt_of_le hbd with rfl | hbd, + { exact ⟨mul_right_cancel'' h, rfl⟩ }, + exact ((right.mul_lt_mul hac hbd).ne h).elim, +end + +alias left.mul_eq_mul_iff_eq_and_eq ← mul_eq_mul_iff_eq_and_eq +attribute [to_additive] mul_eq_mul_iff_eq_and_eq + +end partial_order + +end semigroup + +section mono +variables [has_mul α] [preorder α] [preorder β] {f g : β → α} {s : set β} + +@[to_additive const_add] +lemma monotone.const_mul' [covariant_class α α (*) (≤)] (hf : monotone f) (a : α) : + monotone (λ x, a * f x) := +λ x y h, mul_le_mul_left' (hf h) a + +@[to_additive const_add] +lemma monotone_on.const_mul' [covariant_class α α (*) (≤)] (hf : monotone_on f s) (a : α) : + monotone_on (λ x, a * f x) s := +λ x hx y hy h, mul_le_mul_left' (hf hx hy h) a + +@[to_additive const_add] +lemma antitone.const_mul' [covariant_class α α (*) (≤)] (hf : antitone f) (a : α) : + antitone (λ x, a * f x) := +λ x y h, mul_le_mul_left' (hf h) a + +@[to_additive const_add] +lemma antitone_on.const_mul' [covariant_class α α (*) (≤)] (hf : antitone_on f s) (a : α) : + antitone_on (λ x, a * f x) s := +λ x hx y hy h, mul_le_mul_left' (hf hx hy h) a + +@[to_additive add_const] +lemma monotone.mul_const' [covariant_class α α (swap (*)) (≤)] + (hf : monotone f) (a : α) : monotone (λ x, f x * a) := +λ x y h, mul_le_mul_right' (hf h) a + +@[to_additive add_const] +lemma monotone_on.mul_const' [covariant_class α α (swap (*)) (≤)] + (hf : monotone_on f s) (a : α) : monotone_on (λ x, f x * a) s := +λ x hx y hy h, mul_le_mul_right' (hf hx hy h) a + +@[to_additive add_const] +lemma antitone.mul_const' [covariant_class α α (swap (*)) (≤)] + (hf : antitone f) (a : α) : antitone (λ x, f x * a) := +λ x y h, mul_le_mul_right' (hf h) a + +@[to_additive add_const] +lemma antitone_on.mul_const' [covariant_class α α (swap (*)) (≤)] + (hf : antitone_on f s) (a : α) : antitone_on (λ x, f x * a) s := +λ x hx y hy h, mul_le_mul_right' (hf hx hy h) a + +/-- The product of two monotone functions is monotone. -/ +@[to_additive add "The sum of two monotone functions is monotone."] +lemma monotone.mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + (hf : monotone f) (hg : monotone g) : monotone (λ x, f x * g x) := +λ x y h, mul_le_mul' (hf h) (hg h) + +/-- The product of two monotone functions is monotone. -/ +@[to_additive add "The sum of two monotone functions is monotone."] +lemma monotone_on.mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (λ x, f x * g x) s := +λ x hx y hy h, mul_le_mul' (hf hx hy h) (hg hx hy h) + +/-- The product of two antitone functions is antitone. -/ +@[to_additive add "The sum of two antitone functions is antitone."] +lemma antitone.mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + (hf : antitone f) (hg : antitone g) : antitone (λ x, f x * g x) := +λ x y h, mul_le_mul' (hf h) (hg h) + +/-- The product of two antitone functions is antitone. -/ +@[to_additive add "The sum of two antitone functions is antitone."] +lemma antitone_on.mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] + (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (λ x, f x * g x) s := +λ x hx y hy h, mul_le_mul' (hf hx hy h) (hg hx hy h) + +section left +variables [covariant_class α α (*) (<)] + +@[to_additive const_add] lemma strict_mono.const_mul' (hf : strict_mono f) (c : α) : + strict_mono (λ x, c * f x) := +λ a b ab, mul_lt_mul_left' (hf ab) c + +@[to_additive const_add] lemma strict_mono_on.const_mul' (hf : strict_mono_on f s) (c : α) : + strict_mono_on (λ x, c * f x) s := +λ a ha b hb ab, mul_lt_mul_left' (hf ha hb ab) c + +@[to_additive const_add] lemma strict_anti.const_mul' (hf : strict_anti f) (c : α) : + strict_anti (λ x, c * f x) := +λ a b ab, mul_lt_mul_left' (hf ab) c + +@[to_additive const_add] lemma strict_anti_on.const_mul' (hf : strict_anti_on f s) (c : α) : + strict_anti_on (λ x, c * f x) s := +λ a ha b hb ab, mul_lt_mul_left' (hf ha hb ab) c + +end left + +section right +variables [covariant_class α α (swap (*)) (<)] + +@[to_additive add_const] lemma strict_mono.mul_const' (hf : strict_mono f) (c : α) : + strict_mono (λ x, f x * c) := +λ a b ab, mul_lt_mul_right' (hf ab) c + +@[to_additive add_const] lemma strict_mono_on.mul_const' (hf : strict_mono_on f s) (c : α) : + strict_mono_on (λ x, f x * c) s := +λ a ha b hb ab, mul_lt_mul_right' (hf ha hb ab) c + +@[to_additive add_const] lemma strict_anti.mul_const' (hf : strict_anti f) (c : α) : + strict_anti (λ x, f x * c) := +λ a b ab, mul_lt_mul_right' (hf ab) c + +@[to_additive add_const] lemma strict_anti_on.mul_const' (hf : strict_anti_on f s) (c : α) : + strict_anti_on (λ x, f x * c) s := +λ a ha b hb ab, mul_lt_mul_right' (hf ha hb ab) c + +end right + +/-- The product of two strictly monotone functions is strictly monotone. -/ +@[to_additive add "The sum of two strictly monotone functions is strictly monotone."] +lemma strict_mono.mul' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] + (hf : strict_mono f) (hg : strict_mono g) : + strict_mono (λ x, f x * g x) := +λ a b ab, mul_lt_mul_of_lt_of_lt (hf ab) (hg ab) + +/-- The product of two strictly monotone functions is strictly monotone. -/ +@[to_additive add "The sum of two strictly monotone functions is strictly monotone."] +lemma strict_mono_on.mul' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] + (hf : strict_mono_on f s) (hg : strict_mono_on g s) : + strict_mono_on (λ x, f x * g x) s := +λ a ha b hb ab, mul_lt_mul_of_lt_of_lt (hf ha hb ab) (hg ha hb ab) + +/-- The product of two strictly antitone functions is strictly antitone. -/ +@[to_additive add "The sum of two strictly antitone functions is strictly antitone."] +lemma strict_anti.mul' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] + (hf : strict_anti f) (hg : strict_anti g) : + strict_anti (λ x, f x * g x) := +λ a b ab, mul_lt_mul_of_lt_of_lt (hf ab) (hg ab) + +/-- The product of two strictly antitone functions is strictly antitone. -/ +@[to_additive add "The sum of two strictly antitone functions is strictly antitone."] +lemma strict_anti_on.mul' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] + (hf : strict_anti_on f s) (hg : strict_anti_on g s) : + strict_anti_on (λ x, f x * g x) s := +λ a ha b hb ab, mul_lt_mul_of_lt_of_lt (hf ha hb ab) (hg ha hb ab) + +/-- The product of a monotone function and a strictly monotone function is strictly monotone. -/ +@[to_additive add_strict_mono +"The sum of a monotone function and a strictly monotone function is strictly monotone."] +lemma monotone.mul_strict_mono' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] + {f g : β → α} (hf : monotone f) (hg : strict_mono g) : + strict_mono (λ x, f x * g x) := +λ x y h, mul_lt_mul_of_le_of_lt (hf h.le) (hg h) + +/-- The product of a monotone function and a strictly monotone function is strictly monotone. -/ +@[to_additive add_strict_mono +"The sum of a monotone function and a strictly monotone function is strictly monotone."] +lemma monotone_on.mul_strict_mono' [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (≤)] {f g : β → α} + (hf : monotone_on f s) (hg : strict_mono_on g s) : + strict_mono_on (λ x, f x * g x) s := +λ x hx y hy h, mul_lt_mul_of_le_of_lt (hf hx hy h.le) (hg hx hy h) + +/-- The product of a antitone function and a strictly antitone function is strictly antitone. -/ +@[to_additive add_strict_anti +"The sum of a antitone function and a strictly antitone function is strictly antitone."] +lemma antitone.mul_strict_anti' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] + {f g : β → α} (hf : antitone f) (hg : strict_anti g) : + strict_anti (λ x, f x * g x) := +λ x y h, mul_lt_mul_of_le_of_lt (hf h.le) (hg h) + +/-- The product of a antitone function and a strictly antitone function is strictly antitone. -/ +@[to_additive add_strict_anti +"The sum of a antitone function and a strictly antitone function is strictly antitone."] +lemma antitone_on.mul_strict_anti' [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (≤)] {f g : β → α} + (hf : antitone_on f s) (hg : strict_anti_on g s) : + strict_anti_on (λ x, f x * g x) s := +λ x hx y hy h, mul_lt_mul_of_le_of_lt (hf hx hy h.le) (hg hx hy h) + +variables [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (<)] + +/-- The product of a strictly monotone function and a monotone function is strictly monotone. -/ +@[to_additive add_monotone +"The sum of a strictly monotone function and a monotone function is strictly monotone."] +lemma strict_mono.mul_monotone' (hf : strict_mono f) (hg : monotone g) : + strict_mono (λ x, f x * g x) := +λ x y h, mul_lt_mul_of_lt_of_le (hf h) (hg h.le) + +/-- The product of a strictly monotone function and a monotone function is strictly monotone. -/ +@[to_additive add_monotone +"The sum of a strictly monotone function and a monotone function is strictly monotone."] +lemma strict_mono_on.mul_monotone' (hf : strict_mono_on f s) (hg : monotone_on g s) : + strict_mono_on (λ x, f x * g x) s := +λ x hx y hy h, mul_lt_mul_of_lt_of_le (hf hx hy h) (hg hx hy h.le) + +/-- The product of a strictly antitone function and a antitone function is strictly antitone. -/ +@[to_additive add_antitone +"The sum of a strictly antitone function and a antitone function is strictly antitone."] +lemma strict_anti.mul_antitone' (hf : strict_anti f) (hg : antitone g) : + strict_anti (λ x, f x * g x) := +λ x y h, mul_lt_mul_of_lt_of_le (hf h) (hg h.le) + +/-- The product of a strictly antitone function and a antitone function is strictly antitone. -/ +@[to_additive add_antitone +"The sum of a strictly antitone function and a antitone function is strictly antitone."] +lemma strict_anti_on.mul_antitone' (hf : strict_anti_on f s) (hg : antitone_on g s) : + strict_anti_on (λ x, f x * g x) s := +λ x hx y hy h, mul_lt_mul_of_lt_of_le (hf hx hy h) (hg hx hy h.le) + +@[simp, to_additive cmp_add_left] +lemma cmp_mul_left' {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (*) (<)] + (a b c : α) : cmp (a * b) (a * c) = cmp b c := +(strict_mono_id.const_mul' a).cmp_map_eq b c + +@[simp, to_additive cmp_add_right] +lemma cmp_mul_right' {α : Type*} [has_mul α] [linear_order α] [covariant_class α α (swap (*)) (<)] + (a b c : α) : cmp (a * c) (b * c) = cmp a b := +(strict_mono_id.mul_const' c).cmp_map_eq a b + +end mono + +/-- +An element `a : α` is `mul_le_cancellable` if `x ↦ a * x` is order-reflecting. +We will make a separate version of many lemmas that require `[contravariant_class α α (*) (≤)]` with +`mul_le_cancellable` assumptions instead. These lemmas can then be instantiated to specific types, +like `ennreal`, where we can replace the assumption `add_le_cancellable x` by `x ≠ ∞`. +-/ +@[to_additive /-" An element `a : α` is `add_le_cancellable` if `x ↦ a + x` is order-reflecting. +We will make a separate version of many lemmas that require `[contravariant_class α α (+) (≤)]` with +`mul_le_cancellable` assumptions instead. These lemmas can then be instantiated to specific types, +like `ennreal`, where we can replace the assumption `add_le_cancellable x` by `x ≠ ∞`. "-/ +] +def mul_le_cancellable [has_mul α] [has_le α] (a : α) : Prop := +∀ ⦃b c⦄, a * b ≤ a * c → b ≤ c + +@[to_additive] +lemma contravariant.mul_le_cancellable [has_mul α] [has_le α] [contravariant_class α α (*) (≤)] + {a : α} : mul_le_cancellable a := +λ b c, le_of_mul_le_mul_left' + +@[to_additive] lemma mul_le_cancellable_one [monoid α] [has_le α] : mul_le_cancellable (1 : α) := +λ a b, by simpa only [one_mul] using id + +namespace mul_le_cancellable + +@[to_additive] +protected lemma injective [has_mul α] [partial_order α] {a : α} (ha : mul_le_cancellable a) : + injective ((*) a) := +λ b c h, le_antisymm (ha h.le) (ha h.ge) + +@[to_additive] +protected lemma inj [has_mul α] [partial_order α] {a b c : α} (ha : mul_le_cancellable a) : + a * b = a * c ↔ b = c := +ha.injective.eq_iff + +@[to_additive] +protected lemma injective_left [comm_semigroup α] [partial_order α] {a : α} + (ha : mul_le_cancellable a) : injective (* a) := +λ b c h, ha.injective $ by rwa [mul_comm a, mul_comm a] + +@[to_additive] +protected lemma inj_left [comm_semigroup α] [partial_order α] {a b c : α} + (hc : mul_le_cancellable c) : a * c = b * c ↔ a = b := +hc.injective_left.eq_iff + +variable [has_le α] + +@[to_additive] +protected lemma mul_le_mul_iff_left [has_mul α] [covariant_class α α (*) (≤)] + {a b c : α} (ha : mul_le_cancellable a) : a * b ≤ a * c ↔ b ≤ c := +⟨λ h, ha h, λ h, mul_le_mul_left' h a⟩ + +@[to_additive] +protected lemma mul_le_mul_iff_right [comm_semigroup α] [covariant_class α α (*) (≤)] + {a b c : α} (ha : mul_le_cancellable a) : b * a ≤ c * a ↔ b ≤ c := +by rw [mul_comm b, mul_comm c, ha.mul_le_mul_iff_left] + +@[to_additive] +protected lemma le_mul_iff_one_le_right [mul_one_class α] [covariant_class α α (*) (≤)] + {a b : α} (ha : mul_le_cancellable a) : a ≤ a * b ↔ 1 ≤ b := +iff.trans (by rw [mul_one]) ha.mul_le_mul_iff_left + +@[to_additive] +protected lemma mul_le_iff_le_one_right [mul_one_class α] [covariant_class α α (*) (≤)] + {a b : α} (ha : mul_le_cancellable a) : a * b ≤ a ↔ b ≤ 1 := +iff.trans (by rw [mul_one]) ha.mul_le_mul_iff_left + +@[to_additive] +protected lemma le_mul_iff_one_le_left [comm_monoid α] [covariant_class α α (*) (≤)] + {a b : α} (ha : mul_le_cancellable a) : a ≤ b * a ↔ 1 ≤ b := +by rw [mul_comm, ha.le_mul_iff_one_le_right] + +@[to_additive] +protected lemma mul_le_iff_le_one_left [comm_monoid α] [covariant_class α α (*) (≤)] + {a b : α} (ha : mul_le_cancellable a) : b * a ≤ a ↔ b ≤ 1 := +by rw [mul_comm, ha.mul_le_iff_le_one_right] + +end mul_le_cancellable + +section bit +variables [has_add α] [preorder α] + +lemma bit0_mono [covariant_class α α (+) (≤)] [covariant_class α α (swap (+)) (≤)] : + monotone (bit0 : α → α) := λ a b h, add_le_add h h + +lemma bit0_strict_mono [covariant_class α α (+) (<)] [covariant_class α α (swap (+)) (<)] : + strict_mono (bit0 : α → α) := λ a b h, add_lt_add h h + +end bit diff --git a/src/algebra/order/monoid/min_max.lean b/src/algebra/order/monoid/min_max.lean new file mode 100644 index 0000000000000..eebcdd00179a0 --- /dev/null +++ b/src/algebra/order/monoid/min_max.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import order.min_max +import algebra.order.monoid.lemmas + +/-! +# Lemmas about `min` and `max` in an ordered monoid. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open function + +variables {α β : Type*} + +/-! Some lemmas about types that have an ordering and a binary operation, with no + rules relating them. -/ +@[to_additive] +lemma fn_min_mul_fn_max [linear_order α] [comm_semigroup β] (f : α → β) (n m : α) : + f (min n m) * f (max n m) = f n * f m := +by { cases le_total n m with h h; simp [h, mul_comm] } + +@[to_additive] +lemma min_mul_max [linear_order α] [comm_semigroup α] (n m : α) : + min n m * max n m = n * m := +fn_min_mul_fn_max id n m + +section covariant_class_mul_le +variables [linear_order α] + +section has_mul +variable [has_mul α] + +section left +variable [covariant_class α α (*) (≤)] + +@[to_additive] lemma min_mul_mul_left (a b c : α) : min (a * b) (a * c) = a * min b c := +(monotone_id.const_mul' a).map_min.symm + +@[to_additive] +lemma max_mul_mul_left (a b c : α) : max (a * b) (a * c) = a * max b c := +(monotone_id.const_mul' a).map_max.symm + +end left + +section right +variable [covariant_class α α (function.swap (*)) (≤)] + +@[to_additive] +lemma min_mul_mul_right (a b c : α) : min (a * c) (b * c) = min a b * c := +(monotone_id.mul_const' c).map_min.symm + +@[to_additive] +lemma max_mul_mul_right (a b c : α) : max (a * c) (b * c) = max a b * c := +(monotone_id.mul_const' c).map_max.symm + +end right + +@[to_additive] lemma lt_or_lt_of_mul_lt_mul [covariant_class α α (*) (≤)] + [covariant_class α α (swap (*)) (≤)] {a₁ a₂ b₁ b₂ : α} : + a₁ * b₁ < a₂ * b₂ → a₁ < a₂ ∨ b₁ < b₂ := +by { contrapose!, exact λ h, mul_le_mul' h.1 h.2 } + +@[to_additive] lemma le_or_lt_of_mul_le_mul [covariant_class α α (*) (≤)] + [covariant_class α α (swap (*)) (<)] {a₁ a₂ b₁ b₂ : α} : + a₁ * b₁ ≤ a₂ * b₂ → a₁ ≤ a₂ ∨ b₁ < b₂ := +by { contrapose!, exact λ h, mul_lt_mul_of_lt_of_le h.1 h.2 } + +@[to_additive] lemma lt_or_le_of_mul_le_mul [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (≤)] {a₁ a₂ b₁ b₂ : α} : + a₁ * b₁ ≤ a₂ * b₂ → a₁ < a₂ ∨ b₁ ≤ b₂ := +by { contrapose!, exact λ h, mul_lt_mul_of_le_of_lt h.1 h.2 } + +@[to_additive] lemma le_or_le_of_mul_le_mul [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (<)] {a₁ a₂ b₁ b₂ : α} : + a₁ * b₁ ≤ a₂ * b₂ → a₁ ≤ a₂ ∨ b₁ ≤ b₂ := +by { contrapose!, exact λ h, mul_lt_mul_of_lt_of_lt h.1 h.2 } + +@[to_additive] lemma mul_lt_mul_iff_of_le_of_le [covariant_class α α (*) (≤)] + [covariant_class α α (swap (*)) (≤)] [covariant_class α α (*) (<)] + [covariant_class α α (swap (*)) (<)] {a₁ a₂ b₁ b₂ : α} (ha : a₁ ≤ a₂) (hb : b₁ ≤ b₂) : + a₁ * b₁ < a₂ * b₂ ↔ a₁ < a₂ ∨ b₁ < b₂ := +begin + refine ⟨lt_or_lt_of_mul_lt_mul, _⟩, + rintro (ha | hb), + { exact mul_lt_mul_of_lt_of_le ha hb }, + { exact mul_lt_mul_of_le_of_lt ha hb } +end + +end has_mul + +variable [mul_one_class α] + +@[to_additive] +lemma min_le_mul_of_one_le_right [covariant_class α α (*) (≤)] {a b : α} (hb : 1 ≤ b) : + min a b ≤ a * b := +min_le_iff.2 $ or.inl $ le_mul_of_one_le_right' hb + +@[to_additive] +lemma min_le_mul_of_one_le_left [covariant_class α α (function.swap (*)) (≤)] {a b : α} + (ha : 1 ≤ a) : min a b ≤ a * b := +min_le_iff.2 $ or.inr $ le_mul_of_one_le_left' ha + +@[to_additive] +lemma max_le_mul_of_one_le [covariant_class α α (*) (≤)] + [covariant_class α α (function.swap (*)) (≤)] {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : + max a b ≤ a * b := +max_le_iff.2 ⟨le_mul_of_one_le_right' hb, le_mul_of_one_le_left' ha⟩ + +end covariant_class_mul_le diff --git a/src/algebra/order/monoid/nat_cast.lean b/src/algebra/order/monoid/nat_cast.lean new file mode 100644 index 0000000000000..9960b3c1b13e2 --- /dev/null +++ b/src/algebra/order/monoid/nat_cast.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl, Yuyang Zhao +-/ +import algebra.order.monoid.lemmas +import algebra.order.zero_le_one +import data.nat.cast.defs + +/-! +# Order of numerials in an `add_monoid_with_one`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variable {α : Type*} + +open function + +lemma lt_add_one [has_one α] [add_zero_class α] [partial_order α] [zero_le_one_class α] + [ne_zero (1 : α)] [covariant_class α α (+) (<)] (a : α) : a < a + 1 := +lt_add_of_pos_right _ zero_lt_one + +lemma lt_one_add [has_one α] [add_zero_class α] [partial_order α] [zero_le_one_class α] + [ne_zero (1 : α)] [covariant_class α α (swap (+)) (<)] (a : α) : a < 1 + a := +lt_add_of_pos_left _ zero_lt_one + +variable [add_monoid_with_one α] + +lemma zero_le_two [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] : + (0 : α) ≤ 2 := +add_nonneg zero_le_one zero_le_one + +lemma zero_le_three [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] : + (0 : α) ≤ 3 := +add_nonneg zero_le_two zero_le_one + +lemma zero_le_four [preorder α] [zero_le_one_class α] [covariant_class α α (+) (≤)] : + (0 : α) ≤ 4 := +add_nonneg zero_le_two zero_le_two + +lemma one_le_two [has_le α] [zero_le_one_class α] [covariant_class α α (+) (≤)] : + (1 : α) ≤ 2 := +calc 1 = 1 + 0 : (add_zero 1).symm + ... ≤ 1 + 1 : add_le_add_left zero_le_one _ + +lemma one_le_two' [has_le α] [zero_le_one_class α] [covariant_class α α (swap (+)) (≤)] : + (1 : α) ≤ 2 := +calc 1 = 0 + 1 : (zero_add 1).symm + ... ≤ 1 + 1 : add_le_add_right zero_le_one _ + +section +variables [partial_order α] [zero_le_one_class α] [ne_zero (1 : α)] + +section +variables [covariant_class α α (+) (≤)] + +/-- See `zero_lt_two'` for a version with the type explicit. -/ +@[simp] lemma zero_lt_two : (0 : α) < 2 := zero_lt_one.trans_le one_le_two +/-- See `zero_lt_three'` for a version with the type explicit. -/ +@[simp] lemma zero_lt_three : (0 : α) < 3 := lt_add_of_lt_of_nonneg zero_lt_two zero_le_one +/-- See `zero_lt_four'` for a version with the type explicit. -/ +@[simp] lemma zero_lt_four : (0 : α) < 4 := lt_add_of_lt_of_nonneg zero_lt_two zero_le_two + +variables (α) + +/-- See `zero_lt_two` for a version with the type implicit. -/ +lemma zero_lt_two' : (0 : α) < 2 := zero_lt_two +/-- See `zero_lt_three` for a version with the type implicit. -/ +lemma zero_lt_three' : (0 : α) < 3 := zero_lt_three +/-- See `zero_lt_four` for a version with the type implicit. -/ +lemma zero_lt_four' : (0 : α) < 4 := zero_lt_four + +instance zero_le_one_class.ne_zero.two : ne_zero (2 : α) := ⟨zero_lt_two.ne'⟩ +instance zero_le_one_class.ne_zero.three : ne_zero (3 : α) := ⟨zero_lt_three.ne'⟩ +instance zero_le_one_class.ne_zero.four : ne_zero (4 : α) := ⟨zero_lt_four.ne'⟩ + +end + +lemma one_lt_two [covariant_class α α (+) (<)] : (1 : α) < 2 := lt_add_one _ + +end + +alias zero_lt_two ← two_pos +alias zero_lt_three ← three_pos +alias zero_lt_four ← four_pos diff --git a/src/algebra/order/monoid/order_dual.lean b/src/algebra/order/monoid/order_dual.lean new file mode 100644 index 0000000000000..dd806089d4316 --- /dev/null +++ b/src/algebra/order/monoid/order_dual.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ + +import algebra.group.order_synonym +import algebra.order.monoid.cancel.defs + +/-! # Ordered monoid structures on the order dual. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +universes u +variables {α : Type u} + +open function + +namespace order_dual + +@[to_additive] +instance contravariant_class_mul_le [has_le α] [has_mul α] [c : contravariant_class α α (*) (≤)] : + contravariant_class αᵒᵈ αᵒᵈ (*) (≤) := +⟨c.1.flip⟩ + +@[to_additive] +instance covariant_class_mul_le [has_le α] [has_mul α] [c : covariant_class α α (*) (≤)] : + covariant_class αᵒᵈ αᵒᵈ (*) (≤) := +⟨c.1.flip⟩ + +@[to_additive] instance contravariant_class_swap_mul_le [has_le α] [has_mul α] + [c : contravariant_class α α (swap (*)) (≤)] : + contravariant_class αᵒᵈ αᵒᵈ (swap (*)) (≤) := +⟨c.1.flip⟩ + +@[to_additive] +instance covariant_class_swap_mul_le [has_le α] [has_mul α] + [c : covariant_class α α (swap (*)) (≤)] : + covariant_class αᵒᵈ αᵒᵈ (swap (*)) (≤) := +⟨c.1.flip⟩ + +@[to_additive] +instance contravariant_class_mul_lt [has_lt α] [has_mul α] [c : contravariant_class α α (*) (<)] : + contravariant_class αᵒᵈ αᵒᵈ (*) (<) := +⟨c.1.flip⟩ + +@[to_additive] +instance covariant_class_mul_lt [has_lt α] [has_mul α] [c : covariant_class α α (*) (<)] : + covariant_class αᵒᵈ αᵒᵈ (*) (<) := +⟨c.1.flip⟩ + +@[to_additive] instance contravariant_class_swap_mul_lt [has_lt α] [has_mul α] + [c : contravariant_class α α (swap (*)) (<)] : + contravariant_class αᵒᵈ αᵒᵈ (swap (*)) (<) := +⟨c.1.flip⟩ + +@[to_additive] +instance covariant_class_swap_mul_lt [has_lt α] [has_mul α] + [c : covariant_class α α (swap (*)) (<)] : + covariant_class αᵒᵈ αᵒᵈ (swap (*)) (<) := +⟨c.1.flip⟩ + +@[to_additive] +instance [ordered_comm_monoid α] : ordered_comm_monoid αᵒᵈ := +{ mul_le_mul_left := λ a b h c, mul_le_mul_left' h c, + .. order_dual.partial_order α, + .. order_dual.comm_monoid } + +@[to_additive ordered_cancel_add_comm_monoid.to_contravariant_class] +instance ordered_cancel_comm_monoid.to_contravariant_class [ordered_cancel_comm_monoid α] : + contravariant_class αᵒᵈ αᵒᵈ has_mul.mul has_le.le := +{ elim := λ a b c, ordered_cancel_comm_monoid.le_of_mul_le_mul_left a c b } + +@[to_additive] +instance [ordered_cancel_comm_monoid α] : ordered_cancel_comm_monoid αᵒᵈ := +{ le_of_mul_le_mul_left := λ a b c : α, le_of_mul_le_mul_left', + .. order_dual.ordered_comm_monoid, .. order_dual.cancel_comm_monoid } + +@[to_additive] +instance [linear_ordered_cancel_comm_monoid α] : + linear_ordered_cancel_comm_monoid αᵒᵈ := +{ .. order_dual.linear_order α, + .. order_dual.ordered_cancel_comm_monoid } + +@[to_additive] +instance [linear_ordered_comm_monoid α] : + linear_ordered_comm_monoid αᵒᵈ := +{ .. order_dual.linear_order α, + .. order_dual.ordered_comm_monoid } + +end order_dual diff --git a/src/algebra/order/monoid/prod.lean b/src/algebra/order/monoid/prod.lean new file mode 100644 index 0000000000000..b071d078d3dd2 --- /dev/null +++ b/src/algebra/order/monoid/prod.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.group.prod +import algebra.order.monoid.cancel.defs +import algebra.order.monoid.canonical.defs + +/-! # Products of ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +namespace prod + +variables {α β M N : Type*} + +@[to_additive] +instance [ordered_comm_monoid α] [ordered_comm_monoid β] : ordered_comm_monoid (α × β) := +{ mul_le_mul_left := λ a b h c, ⟨mul_le_mul_left' h.1 _, mul_le_mul_left' h.2 _⟩, + .. prod.comm_monoid, .. prod.partial_order _ _ } + +@[to_additive] +instance [ordered_cancel_comm_monoid M] [ordered_cancel_comm_monoid N] : + ordered_cancel_comm_monoid (M × N) := +{ le_of_mul_le_mul_left := λ a b c h, ⟨le_of_mul_le_mul_left' h.1, le_of_mul_le_mul_left' h.2⟩, + .. prod.ordered_comm_monoid } + +@[to_additive] instance [has_le α] [has_le β] [has_mul α] [has_mul β] [has_exists_mul_of_le α] + [has_exists_mul_of_le β] : has_exists_mul_of_le (α × β) := +⟨λ a b h, let ⟨c, hc⟩ := exists_mul_of_le h.1, ⟨d, hd⟩ := exists_mul_of_le h.2 in + ⟨(c, d), ext hc hd⟩⟩ + +@[to_additive] instance [canonically_ordered_monoid α] [canonically_ordered_monoid β] : + canonically_ordered_monoid (α × β) := +{ le_self_mul := λ a b, ⟨le_self_mul, le_self_mul⟩, + ..prod.ordered_comm_monoid, ..prod.order_bot _ _, ..prod.has_exists_mul_of_le } + +end prod diff --git a/src/algebra/order/monoid/to_mul_bot.lean b/src/algebra/order/monoid/to_mul_bot.lean new file mode 100644 index 0000000000000..2cfbed9a89e21 --- /dev/null +++ b/src/algebra/order/monoid/to_mul_bot.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.with_zero +import algebra.order.monoid.with_top +import algebra.order.monoid.type_tags + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Making an additive monoid multiplicative then adding a zero is the same as adding a bottom +element then making it multiplicative. +-/ + +universe u +variables {α : Type u} + +namespace with_zero + +local attribute [semireducible] with_zero +variables [has_add α] + +/-- Making an additive monoid multiplicative then adding a zero is the same as adding a bottom +element then making it multiplicative. -/ +def to_mul_bot : with_zero (multiplicative α) ≃* multiplicative (with_bot α) := +by exact mul_equiv.refl _ + +@[simp] lemma to_mul_bot_zero : + to_mul_bot (0 : with_zero (multiplicative α)) = multiplicative.of_add ⊥ := rfl +@[simp] lemma to_mul_bot_coe (x : multiplicative α) : + to_mul_bot ↑x = multiplicative.of_add (x.to_add : with_bot α) := rfl +@[simp] lemma to_mul_bot_symm_bot : + to_mul_bot.symm (multiplicative.of_add (⊥ : with_bot α)) = 0 := rfl +@[simp] lemma to_mul_bot_coe_of_add (x : α) : + to_mul_bot.symm (multiplicative.of_add (x : with_bot α)) = multiplicative.of_add x := rfl + +variables [preorder α] (a b : with_zero (multiplicative α)) + +lemma to_mul_bot_strict_mono : strict_mono (@to_mul_bot α _) := λ x y, id +@[simp] lemma to_mul_bot_le : to_mul_bot a ≤ to_mul_bot b ↔ a ≤ b := iff.rfl +@[simp] lemma to_mul_bot_lt : to_mul_bot a < to_mul_bot b ↔ a < b := iff.rfl + +end with_zero diff --git a/src/algebra/order/monoid/type_tags.lean b/src/algebra/order/monoid/type_tags.lean new file mode 100644 index 0000000000000..69ca44b7e7dc1 --- /dev/null +++ b/src/algebra/order/monoid/type_tags.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.group.type_tags +import algebra.order.monoid.cancel.defs +import algebra.order.monoid.canonical.defs + +/-! # Ordered monoid structures on `multiplicative α` and `additive α`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +universes u +variables {α : Type u} + +instance : Π [has_le α], has_le (multiplicative α) := id +instance : Π [has_le α], has_le (additive α) := id +instance : Π [has_lt α], has_lt (multiplicative α) := id +instance : Π [has_lt α], has_lt (additive α) := id +instance : Π [preorder α], preorder (multiplicative α) := id +instance : Π [preorder α], preorder (additive α) := id +instance : Π [partial_order α], partial_order (multiplicative α) := id +instance : Π [partial_order α], partial_order (additive α) := id +instance : Π [linear_order α], linear_order (multiplicative α) := id +instance : Π [linear_order α], linear_order (additive α) := id +instance [has_le α] : Π [order_bot α], order_bot (multiplicative α) := id +instance [has_le α] : Π [order_bot α], order_bot (additive α) := id +instance [has_le α] : Π [order_top α], order_top (multiplicative α) := id +instance [has_le α] : Π [order_top α], order_top (additive α) := id +instance [has_le α] : Π [bounded_order α], bounded_order (multiplicative α) := id +instance [has_le α] : Π [bounded_order α], bounded_order (additive α) := id + +instance [ordered_add_comm_monoid α] : ordered_comm_monoid (multiplicative α) := +{ mul_le_mul_left := @ordered_add_comm_monoid.add_le_add_left α _, + ..multiplicative.partial_order, + ..multiplicative.comm_monoid } + +instance [ordered_comm_monoid α] : ordered_add_comm_monoid (additive α) := +{ add_le_add_left := @ordered_comm_monoid.mul_le_mul_left α _, + ..additive.partial_order, + ..additive.add_comm_monoid } + +instance [ordered_cancel_add_comm_monoid α] : ordered_cancel_comm_monoid (multiplicative α) := +{ le_of_mul_le_mul_left := @ordered_cancel_add_comm_monoid.le_of_add_le_add_left α _, + ..multiplicative.ordered_comm_monoid } + +instance [ordered_cancel_comm_monoid α] : ordered_cancel_add_comm_monoid (additive α) := +{ le_of_add_le_add_left := @ordered_cancel_comm_monoid.le_of_mul_le_mul_left α _, + ..additive.ordered_add_comm_monoid } + +instance [linear_ordered_add_comm_monoid α] : linear_ordered_comm_monoid (multiplicative α) := +{ ..multiplicative.linear_order, + ..multiplicative.ordered_comm_monoid } + +instance [linear_ordered_comm_monoid α] : linear_ordered_add_comm_monoid (additive α) := +{ ..additive.linear_order, + ..additive.ordered_add_comm_monoid } + +instance [has_add α] [has_le α] [has_exists_add_of_le α] : + has_exists_mul_of_le (multiplicative α) := +⟨@exists_add_of_le α _ _ _⟩ + +instance [has_mul α] [has_le α] [has_exists_mul_of_le α] : has_exists_add_of_le (additive α) := +⟨@exists_mul_of_le α _ _ _⟩ + +instance [canonically_ordered_add_monoid α] : canonically_ordered_monoid (multiplicative α) := +{ le_self_mul := @le_self_add α _, + ..multiplicative.ordered_comm_monoid, ..multiplicative.order_bot, + ..multiplicative.has_exists_mul_of_le } + +instance [canonically_ordered_monoid α] : canonically_ordered_add_monoid (additive α) := +{ le_self_add := @le_self_mul α _, + ..additive.ordered_add_comm_monoid, ..additive.order_bot, ..additive.has_exists_add_of_le } + +instance [canonically_linear_ordered_add_monoid α] : + canonically_linear_ordered_monoid (multiplicative α) := +{ ..multiplicative.canonically_ordered_monoid, ..multiplicative.linear_order } + +instance [canonically_linear_ordered_monoid α] : + canonically_linear_ordered_add_monoid (additive α) := +{ ..additive.canonically_ordered_add_monoid, ..additive.linear_order } + +namespace additive + +variables [preorder α] + +@[simp] lemma of_mul_le {a b : α} : of_mul a ≤ of_mul b ↔ a ≤ b := iff.rfl + +@[simp] lemma of_mul_lt {a b : α} : of_mul a < of_mul b ↔ a < b := iff.rfl + +@[simp] lemma to_mul_le {a b : additive α} : to_mul a ≤ to_mul b ↔ a ≤ b := iff.rfl + +@[simp] lemma to_mul_lt {a b : additive α} : to_mul a < to_mul b ↔ a < b := iff.rfl + +end additive + +namespace multiplicative + +variables [preorder α] + +@[simp] lemma of_add_le {a b : α} : of_add a ≤ of_add b ↔ a ≤ b := iff.rfl + +@[simp] lemma of_add_lt {a b : α} : of_add a < of_add b ↔ a < b := iff.rfl + +@[simp] lemma to_add_le {a b : multiplicative α} : to_add a ≤ to_add b ↔ a ≤ b := iff.rfl + +@[simp] lemma to_add_lt {a b : multiplicative α} : to_add a < to_add b ↔ a < b := iff.rfl + +end multiplicative diff --git a/src/algebra/order/monoid/units.lean b/src/algebra/order/monoid/units.lean new file mode 100644 index 0000000000000..63ad4dd83958c --- /dev/null +++ b/src/algebra/order/monoid/units.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import order.hom.basic +import order.min_max +import algebra.group.units + +/-! +# Units in ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +namespace units + +@[to_additive] +instance [monoid α] [preorder α] : preorder αˣ := +preorder.lift (coe : αˣ → α) + +@[simp, norm_cast, to_additive] +theorem coe_le_coe [monoid α] [preorder α] {a b : αˣ} : + (a : α) ≤ b ↔ a ≤ b := iff.rfl + +@[simp, norm_cast, to_additive] +theorem coe_lt_coe [monoid α] [preorder α] {a b : αˣ} : + (a : α) < b ↔ a < b := iff.rfl + +@[to_additive] +instance [monoid α] [partial_order α] : partial_order αˣ := +partial_order.lift coe units.ext + +@[to_additive] +instance [monoid α] [linear_order α] : linear_order αˣ := +linear_order.lift' coe units.ext + +/-- `coe : αˣ → α` as an order embedding. -/ +@[to_additive "`coe : add_units α → α` as an order embedding.", simps { fully_applied := ff }] +def order_embedding_coe [monoid α] [linear_order α] : αˣ ↪o α := ⟨⟨coe, ext⟩, λ _ _, iff.rfl⟩ + +@[simp, norm_cast, to_additive] +theorem max_coe [monoid α] [linear_order α] {a b : αˣ} : + (↑(max a b) : α) = max a b := +monotone.map_max order_embedding_coe.monotone + +@[simp, norm_cast, to_additive] +theorem min_coe [monoid α] [linear_order α] {a b : αˣ} : + (↑(min a b) : α) = min a b := +monotone.map_min order_embedding_coe.monotone + +end units diff --git a/src/algebra/order/monoid/with_top.lean b/src/algebra/order/monoid/with_top.lean new file mode 100644 index 0000000000000..616d4148549cb --- /dev/null +++ b/src/algebra/order/monoid/with_top.lean @@ -0,0 +1,492 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.hom.group +import algebra.order.monoid.order_dual +import algebra.order.monoid.with_zero.basic +import data.nat.cast.defs + +/-! # Adjoining top/bottom elements to ordered monoids. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes u v +variables {α : Type u} {β : Type v} + +open function + +namespace with_top + +section has_one + +variables [has_one α] + +@[to_additive] instance : has_one (with_top α) := ⟨(1 : α)⟩ + +@[simp, norm_cast, to_additive] lemma coe_one : ((1 : α) : with_top α) = 1 := rfl + +@[simp, norm_cast, to_additive] lemma coe_eq_one {a : α} : (a : with_top α) = 1 ↔ a = 1 := +coe_eq_coe + +@[simp, to_additive] lemma untop_one : (1 : with_top α).untop coe_ne_top = 1 := rfl +@[simp, to_additive] lemma untop_one' (d : α) : (1 : with_top α).untop' d = 1 := rfl + +@[simp, norm_cast, to_additive coe_nonneg] +lemma one_le_coe [has_le α] {a : α} : 1 ≤ (a : with_top α) ↔ 1 ≤ a := coe_le_coe + +@[simp, norm_cast, to_additive coe_le_zero] +lemma coe_le_one [has_le α] {a : α} : (a : with_top α) ≤ 1 ↔ a ≤ 1 := coe_le_coe + +@[simp, norm_cast, to_additive coe_pos] +lemma one_lt_coe [has_lt α] {a : α} : 1 < (a : with_top α) ↔ 1 < a := coe_lt_coe + +@[simp, norm_cast, to_additive coe_lt_zero] +lemma coe_lt_one [has_lt α] {a : α} : (a : with_top α) < 1 ↔ a < 1 := coe_lt_coe + +@[simp, to_additive] protected lemma map_one {β} (f : α → β) : + (1 : with_top α).map f = (f 1 : with_top β) := rfl + +@[simp, norm_cast, to_additive] theorem one_eq_coe {a : α} : 1 = (a : with_top α) ↔ a = 1 := +trans eq_comm coe_eq_one + +@[simp, to_additive] theorem top_ne_one : ⊤ ≠ (1 : with_top α) . +@[simp, to_additive] theorem one_ne_top : (1 : with_top α) ≠ ⊤ . + +instance [has_zero α] [has_le α] [zero_le_one_class α] : zero_le_one_class (with_top α) := +⟨some_le_some.2 zero_le_one⟩ + +end has_one + +section has_add +variables [has_add α] {a b c d : with_top α} {x y : α} + +instance : has_add (with_top α) := ⟨option.map₂ (+)⟩ + +@[norm_cast] lemma coe_add : ((x + y : α) : with_top α) = x + y := rfl +@[norm_cast] lemma coe_bit0 : ((bit0 x : α) : with_top α) = bit0 x := rfl +@[norm_cast] lemma coe_bit1 [has_one α] {a : α} : ((bit1 a : α) : with_top α) = bit1 a := rfl + +@[simp] lemma top_add (a : with_top α) : ⊤ + a = ⊤ := rfl +@[simp] lemma add_top (a : with_top α) : a + ⊤ = ⊤ := by cases a; refl + +@[simp] lemma add_eq_top : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := +by cases a; cases b; simp [none_eq_top, some_eq_coe, ←with_top.coe_add] + +lemma add_ne_top : a + b ≠ ⊤ ↔ a ≠ ⊤ ∧ b ≠ ⊤ := add_eq_top.not.trans not_or_distrib + +lemma add_lt_top [has_lt α] {a b : with_top α} : a + b < ⊤ ↔ a < ⊤ ∧ b < ⊤ := +by simp_rw [with_top.lt_top_iff_ne_top, add_ne_top] + +lemma add_eq_coe : ∀ {a b : with_top α} {c : α}, + a + b = c ↔ ∃ (a' b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = c +| none b c := by simp [none_eq_top] +| (some a) none c := by simp [none_eq_top] +| (some a) (some b) c := + by simp only [some_eq_coe, ← coe_add, coe_eq_coe, exists_and_distrib_left, exists_eq_left] + +@[simp] lemma add_coe_eq_top_iff {x : with_top α} {y : α} : x + y = ⊤ ↔ x = ⊤ := +by { induction x using with_top.rec_top_coe; simp [← coe_add] } + +@[simp] lemma coe_add_eq_top_iff {y : with_top α} : ↑x + y = ⊤ ↔ y = ⊤ := +by { induction y using with_top.rec_top_coe; simp [← coe_add] } + +instance covariant_class_add_le [has_le α] [covariant_class α α (+) (≤)] : + covariant_class (with_top α) (with_top α) (+) (≤) := +⟨λ a b c h, begin + cases a; cases c; try { exact le_top }, + rcases le_coe_iff.1 h with ⟨b, rfl, h'⟩, + exact coe_le_coe.2 (add_le_add_left (coe_le_coe.1 h) _) +end⟩ + +instance covariant_class_swap_add_le [has_le α] [covariant_class α α (swap (+)) (≤)] : + covariant_class (with_top α) (with_top α) (swap (+)) (≤) := +⟨λ a b c h, begin + cases a; cases c; try { exact le_top }, + rcases le_coe_iff.1 h with ⟨b, rfl, h'⟩, + exact coe_le_coe.2 (add_le_add_right (coe_le_coe.1 h) _) +end⟩ + +instance contravariant_class_add_lt [has_lt α] [contravariant_class α α (+) (<)] : + contravariant_class (with_top α) (with_top α) (+) (<) := +⟨λ a b c h, begin + induction a using with_top.rec_top_coe, { exact (not_none_lt _ h).elim }, + induction b using with_top.rec_top_coe, { exact (not_none_lt _ h).elim }, + induction c using with_top.rec_top_coe, + { exact coe_lt_top _ }, + { exact coe_lt_coe.2 (lt_of_add_lt_add_left $ coe_lt_coe.1 h) } +end⟩ + +instance contravariant_class_swap_add_lt [has_lt α] [contravariant_class α α (swap (+)) (<)] : + contravariant_class (with_top α) (with_top α) (swap (+)) (<) := +⟨λ a b c h, begin + cases a; cases b; try { exact (not_none_lt _ h).elim }, + cases c, + { exact coe_lt_top _ }, + { exact coe_lt_coe.2 (lt_of_add_lt_add_right $ coe_lt_coe.1 h) } +end⟩ + +protected lemma le_of_add_le_add_left [has_le α] [contravariant_class α α (+) (≤)] (ha : a ≠ ⊤) + (h : a + b ≤ a + c) : b ≤ c := +begin + lift a to α using ha, + induction c using with_top.rec_top_coe, { exact le_top }, + induction b using with_top.rec_top_coe, { exact (not_top_le_coe _ h).elim }, + simp only [← coe_add, coe_le_coe] at h ⊢, + exact le_of_add_le_add_left h +end + +protected lemma le_of_add_le_add_right [has_le α] [contravariant_class α α (swap (+)) (≤)] + (ha : a ≠ ⊤) (h : b + a ≤ c + a) : b ≤ c := +begin + lift a to α using ha, + cases c, + { exact le_top }, + cases b, + { exact (not_top_le_coe _ h).elim }, + { exact coe_le_coe.2 (le_of_add_le_add_right $ coe_le_coe.1 h) } +end + +protected lemma add_lt_add_left [has_lt α] [covariant_class α α (+) (<)] (ha : a ≠ ⊤) (h : b < c) : + a + b < a + c := +begin + lift a to α using ha, + rcases lt_iff_exists_coe.1 h with ⟨b, rfl, h'⟩, + cases c, + { exact coe_lt_top _ }, + { exact coe_lt_coe.2 (add_lt_add_left (coe_lt_coe.1 h) _) } +end + +protected lemma add_lt_add_right [has_lt α] [covariant_class α α (swap (+)) (<)] + (ha : a ≠ ⊤) (h : b < c) : + b + a < c + a := +begin + lift a to α using ha, + rcases lt_iff_exists_coe.1 h with ⟨b, rfl, h'⟩, + cases c, + { exact coe_lt_top _ }, + { exact coe_lt_coe.2 (add_lt_add_right (coe_lt_coe.1 h) _) } +end + +protected lemma add_le_add_iff_left [has_le α] [covariant_class α α (+) (≤)] + [contravariant_class α α (+) (≤)] + (ha : a ≠ ⊤) : a + b ≤ a + c ↔ b ≤ c := +⟨with_top.le_of_add_le_add_left ha, λ h, add_le_add_left h a⟩ + +protected lemma add_le_add_iff_right [has_le α] [covariant_class α α (swap (+)) (≤)] + [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) : b + a ≤ c + a ↔ b ≤ c := +⟨with_top.le_of_add_le_add_right ha, λ h, add_le_add_right h a⟩ + +protected lemma add_lt_add_iff_left [has_lt α] [covariant_class α α (+) (<)] + [contravariant_class α α (+) (<)] (ha : a ≠ ⊤) : a + b < a + c ↔ b < c := +⟨lt_of_add_lt_add_left, with_top.add_lt_add_left ha⟩ + +protected lemma add_lt_add_iff_right [has_lt α] [covariant_class α α (swap (+)) (<)] + [contravariant_class α α (swap (+)) (<)] (ha : a ≠ ⊤) : b + a < c + a ↔ b < c := +⟨lt_of_add_lt_add_right, with_top.add_lt_add_right ha⟩ + +protected lemma add_lt_add_of_le_of_lt [preorder α] [covariant_class α α (+) (<)] + [covariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊤) (hab : a ≤ b) (hcd : c < d) : a + c < b + d := +(with_top.add_lt_add_left ha hcd).trans_le $ add_le_add_right hab _ + +protected lemma add_lt_add_of_lt_of_le [preorder α] [covariant_class α α (+) (≤)] + [covariant_class α α (swap (+)) (<)] (hc : c ≠ ⊤) (hab : a < b) (hcd : c ≤ d) : a + c < b + d := +(with_top.add_lt_add_right hc hab).trans_le $ add_le_add_left hcd _ + +/- There is no `with_top.map_mul_of_mul_hom`, since `with_top` does not have a multiplication. -/ +@[simp] protected lemma map_add {F} [has_add β] [add_hom_class F α β] (f : F) (a b : with_top α) : + (a + b).map f = a.map f + b.map f := +begin + induction a using with_top.rec_top_coe, + { exact (top_add _).symm }, + { induction b using with_top.rec_top_coe, + { exact (add_top _).symm }, + { rw [map_coe, map_coe, ← coe_add, ← coe_add, ← map_add], + refl } }, +end + +end has_add + +instance [add_semigroup α] : add_semigroup (with_top α) := +{ add_assoc := λ _ _ _, option.map₂_assoc add_assoc, + ..with_top.has_add } + +instance [add_comm_semigroup α] : add_comm_semigroup (with_top α) := +{ add_comm := λ _ _, option.map₂_comm add_comm, + ..with_top.add_semigroup } + +instance [add_zero_class α] : add_zero_class (with_top α) := +{ zero_add := option.map₂_left_identity zero_add, + add_zero := option.map₂_right_identity add_zero, + ..with_top.has_zero, + ..with_top.has_add } + +instance [add_monoid α] : add_monoid (with_top α) := +{ ..with_top.add_zero_class, + ..with_top.has_zero, + ..with_top.add_semigroup } + +instance [add_comm_monoid α] : add_comm_monoid (with_top α) := +{ ..with_top.add_monoid, ..with_top.add_comm_semigroup } + +instance [add_monoid_with_one α] : add_monoid_with_one (with_top α) := +{ nat_cast := λ n, ↑(n : α), + nat_cast_zero := by rw [nat.cast_zero, with_top.coe_zero], + nat_cast_succ := λ n, by rw [nat.cast_add_one, with_top.coe_add, with_top.coe_one], + .. with_top.has_one, .. with_top.add_monoid } + +instance [add_comm_monoid_with_one α] : add_comm_monoid_with_one (with_top α) := +{ .. with_top.add_monoid_with_one, .. with_top.add_comm_monoid } + +instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_top α) := +{ add_le_add_left := + begin + rintros a b h (_|c), { simp [none_eq_top] }, + rcases b with (_|b), { simp [none_eq_top] }, + rcases le_coe_iff.1 h with ⟨a, rfl, h⟩, + simp only [some_eq_coe, ← coe_add, coe_le_coe] at h ⊢, + exact add_le_add_left h c + end, + ..with_top.partial_order, ..with_top.add_comm_monoid } + +instance [linear_ordered_add_comm_monoid α] : + linear_ordered_add_comm_monoid_with_top (with_top α) := +{ top_add' := with_top.top_add, + ..with_top.order_top, + ..with_top.linear_order, + ..with_top.ordered_add_comm_monoid, + ..option.nontrivial } + +instance [has_le α] [has_add α] [has_exists_add_of_le α] : has_exists_add_of_le (with_top α) := +⟨λ a b, match a, b with + | ⊤, ⊤ := by simp + | (a : α), ⊤ := λ _, ⟨⊤, rfl⟩ + | (a : α), (b : α) := λ h, begin + obtain ⟨c, rfl⟩ := exists_add_of_le (with_top.coe_le_coe.1 h), + exact ⟨c, rfl⟩ + end + | ⊤, (b : α) := λ h, (not_top_le_coe _ h).elim +end⟩ + +instance [canonically_ordered_add_monoid α] : canonically_ordered_add_monoid (with_top α) := +{ le_self_add := λ a b, match a, b with + | ⊤, ⊤ := le_rfl + | (a : α), ⊤ := le_top + | (a : α), (b : α) := with_top.coe_le_coe.2 le_self_add + | ⊤, (b : α) := le_rfl + end, + ..with_top.order_bot, ..with_top.ordered_add_comm_monoid, ..with_top.has_exists_add_of_le } + +instance [canonically_linear_ordered_add_monoid α] : + canonically_linear_ordered_add_monoid (with_top α) := +{ ..with_top.canonically_ordered_add_monoid, ..with_top.linear_order } + +@[simp, norm_cast] lemma coe_nat [add_monoid_with_one α] (n : ℕ) : ((n : α) : with_top α) = n := rfl +@[simp] lemma nat_ne_top [add_monoid_with_one α] (n : ℕ) : (n : with_top α) ≠ ⊤ := coe_ne_top +@[simp] lemma top_ne_nat [add_monoid_with_one α] (n : ℕ) : (⊤ : with_top α) ≠ n := top_ne_coe + +/-- Coercion from `α` to `with_top α` as an `add_monoid_hom`. -/ +def coe_add_hom [add_monoid α] : α →+ with_top α := +⟨coe, rfl, λ _ _, rfl⟩ + +@[simp] lemma coe_coe_add_hom [add_monoid α] : ⇑(coe_add_hom : α →+ with_top α) = coe := rfl + +@[simp] lemma zero_lt_top [ordered_add_comm_monoid α] : (0 : with_top α) < ⊤ := +coe_lt_top 0 + +@[simp, norm_cast] lemma zero_lt_coe [ordered_add_comm_monoid α] (a : α) : + (0 : with_top α) < a ↔ 0 < a := +coe_lt_coe + +/-- A version of `with_top.map` for `one_hom`s. -/ +@[to_additive "A version of `with_top.map` for `zero_hom`s", simps { fully_applied := ff }] +protected def _root_.one_hom.with_top_map {M N : Type*} [has_one M] [has_one N] (f : one_hom M N) : + one_hom (with_top M) (with_top N) := +{ to_fun := with_top.map f, + map_one' := by rw [with_top.map_one, map_one, coe_one] } + +/-- A version of `with_top.map` for `add_hom`s. -/ +@[simps { fully_applied := ff }] protected def _root_.add_hom.with_top_map + {M N : Type*} [has_add M] [has_add N] (f : add_hom M N) : + add_hom (with_top M) (with_top N) := +{ to_fun := with_top.map f, + map_add' := with_top.map_add f } + +/-- A version of `with_top.map` for `add_monoid_hom`s. -/ +@[simps { fully_applied := ff }] protected def _root_.add_monoid_hom.with_top_map + {M N : Type*} [add_zero_class M] [add_zero_class N] (f : M →+ N) : + with_top M →+ with_top N := +{ to_fun := with_top.map f, + .. f.to_zero_hom.with_top_map, .. f.to_add_hom.with_top_map } + +end with_top + +namespace with_bot + +@[to_additive] instance [has_one α] : has_one (with_bot α) := with_top.has_one +instance [has_add α] : has_add (with_bot α) := with_top.has_add +instance [add_semigroup α] : add_semigroup (with_bot α) := with_top.add_semigroup +instance [add_comm_semigroup α] : add_comm_semigroup (with_bot α) := with_top.add_comm_semigroup +instance [add_zero_class α] : add_zero_class (with_bot α) := with_top.add_zero_class +instance [add_monoid α] : add_monoid (with_bot α) := with_top.add_monoid +instance [add_comm_monoid α] : add_comm_monoid (with_bot α) := with_top.add_comm_monoid +instance [add_monoid_with_one α] : add_monoid_with_one (with_bot α) := with_top.add_monoid_with_one + +instance [add_comm_monoid_with_one α] : add_comm_monoid_with_one (with_bot α) := +with_top.add_comm_monoid_with_one + +instance [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : + zero_le_one_class (with_bot α) := +⟨some_le_some.2 zero_le_one⟩ + +-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast` +@[to_additive] +lemma coe_one [has_one α] : ((1 : α) : with_bot α) = 1 := rfl + +-- `by norm_cast` proves this lemma, so I did not tag it with `norm_cast` +@[to_additive] +lemma coe_eq_one [has_one α] {a : α} : (a : with_bot α) = 1 ↔ a = 1 := +with_top.coe_eq_one + +@[simp, to_additive] lemma unbot_one [has_one α] : (1 : with_bot α).unbot coe_ne_bot = 1 := rfl +@[simp, to_additive] lemma unbot_one' [has_one α] (d : α) : (1 : with_bot α).unbot' d = 1 := rfl + +@[simp, norm_cast, to_additive coe_nonneg] +lemma one_le_coe [has_one α] [has_le α] {a : α} : 1 ≤ (a : with_bot α) ↔ 1 ≤ a := coe_le_coe + +@[simp, norm_cast, to_additive coe_le_zero] +lemma coe_le_one [has_one α] [has_le α] {a : α} : (a : with_bot α) ≤ 1 ↔ a ≤ 1 := coe_le_coe + +@[simp, norm_cast, to_additive coe_pos] +lemma one_lt_coe [has_one α] [has_lt α] {a : α} : 1 < (a : with_bot α) ↔ 1 < a := coe_lt_coe + +@[simp, norm_cast, to_additive coe_lt_zero] +lemma coe_lt_one [has_one α] [has_lt α] {a : α} : (a : with_bot α) < 1 ↔ a < 1 := coe_lt_coe + +@[simp, to_additive] protected lemma map_one {β} [has_one α] (f : α → β) : + (1 : with_bot α).map f = (f 1 : with_bot β) := rfl + +@[norm_cast] lemma coe_nat [add_monoid_with_one α] (n : ℕ) : ((n : α) : with_bot α) = n := rfl +@[simp] lemma nat_ne_bot [add_monoid_with_one α] (n : ℕ) : (n : with_bot α) ≠ ⊥ := coe_ne_bot +@[simp] lemma bot_ne_nat [add_monoid_with_one α] (n : ℕ) : (⊥ : with_bot α) ≠ n := bot_ne_coe + +section has_add +variables [has_add α] {a b c d : with_bot α} {x y : α} + +-- `norm_cast` proves those lemmas, because `with_top`/`with_bot` are reducible +lemma coe_add (a b : α) : ((a + b : α) : with_bot α) = a + b := rfl +lemma coe_bit0 : ((bit0 x : α) : with_bot α) = bit0 x := rfl +lemma coe_bit1 [has_one α] {a : α} : ((bit1 a : α) : with_bot α) = bit1 a := rfl + +@[simp] lemma bot_add (a : with_bot α) : ⊥ + a = ⊥ := rfl +@[simp] lemma add_bot (a : with_bot α) : a + ⊥ = ⊥ := by cases a; refl + +@[simp] lemma add_eq_bot : a + b = ⊥ ↔ a = ⊥ ∨ b = ⊥ := with_top.add_eq_top +lemma add_ne_bot : a + b ≠ ⊥ ↔ a ≠ ⊥ ∧ b ≠ ⊥ := with_top.add_ne_top + +lemma bot_lt_add [has_lt α] {a b : with_bot α} : ⊥ < a + b ↔ ⊥ < a ∧ ⊥ < b := +@with_top.add_lt_top αᵒᵈ _ _ _ _ + +lemma add_eq_coe : a + b = x ↔ ∃ (a' b' : α), ↑a' = a ∧ ↑b' = b ∧ a' + b' = x := with_top.add_eq_coe + +@[simp] lemma add_coe_eq_bot_iff : a + y = ⊥ ↔ a = ⊥ := with_top.add_coe_eq_top_iff +@[simp] lemma coe_add_eq_bot_iff : ↑x + b = ⊥ ↔ b = ⊥ := with_top.coe_add_eq_top_iff + +/- There is no `with_bot.map_mul_of_mul_hom`, since `with_bot` does not have a multiplication. -/ +@[simp] protected lemma map_add {F} [has_add β] [add_hom_class F α β] (f : F) (a b : with_bot α) : + (a + b).map f = a.map f + b.map f := +with_top.map_add f a b + +/-- A version of `with_bot.map` for `one_hom`s. -/ +@[to_additive "A version of `with_bot.map` for `zero_hom`s", simps { fully_applied := ff }] +protected def _root_.one_hom.with_bot_map {M N : Type*} [has_one M] [has_one N] (f : one_hom M N) : + one_hom (with_bot M) (with_bot N) := +{ to_fun := with_bot.map f, + map_one' := by rw [with_bot.map_one, map_one, coe_one] } + +/-- A version of `with_bot.map` for `add_hom`s. -/ +@[simps { fully_applied := ff }] protected def _root_.add_hom.with_bot_map + {M N : Type*} [has_add M] [has_add N] (f : add_hom M N) : + add_hom (with_bot M) (with_bot N) := +{ to_fun := with_bot.map f, + map_add' := with_bot.map_add f } + +/-- A version of `with_bot.map` for `add_monoid_hom`s. -/ +@[simps { fully_applied := ff }] protected def _root_.add_monoid_hom.with_bot_map + {M N : Type*} [add_zero_class M] [add_zero_class N] (f : M →+ N) : + with_bot M →+ with_bot N := +{ to_fun := with_bot.map f, + .. f.to_zero_hom.with_bot_map, .. f.to_add_hom.with_bot_map } + +variables [preorder α] + +instance covariant_class_add_le [covariant_class α α (+) (≤)] : + covariant_class (with_bot α) (with_bot α) (+) (≤) := +@order_dual.covariant_class_add_le (with_top αᵒᵈ) _ _ _ + +instance covariant_class_swap_add_le [covariant_class α α (swap (+)) (≤)] : + covariant_class (with_bot α) (with_bot α) (swap (+)) (≤) := +@order_dual.covariant_class_swap_add_le (with_top αᵒᵈ) _ _ _ + +instance contravariant_class_add_lt [contravariant_class α α (+) (<)] : + contravariant_class (with_bot α) (with_bot α) (+) (<) := +@order_dual.contravariant_class_add_lt (with_top αᵒᵈ) _ _ _ + +instance contravariant_class_swap_add_lt [contravariant_class α α (swap (+)) (<)] : + contravariant_class (with_bot α) (with_bot α) (swap (+)) (<) := +@order_dual.contravariant_class_swap_add_lt (with_top αᵒᵈ) _ _ _ + +protected lemma le_of_add_le_add_left [contravariant_class α α (+) (≤)] (ha : a ≠ ⊥) + (h : a + b ≤ a + c) : b ≤ c := +@with_top.le_of_add_le_add_left αᵒᵈ _ _ _ _ _ _ ha h + +protected lemma le_of_add_le_add_right [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊥) + (h : b + a ≤ c + a) : b ≤ c := +@with_top.le_of_add_le_add_right αᵒᵈ _ _ _ _ _ _ ha h + +protected lemma add_lt_add_left [covariant_class α α (+) (<)] (ha : a ≠ ⊥) (h : b < c) : + a + b < a + c := +@with_top.add_lt_add_left αᵒᵈ _ _ _ _ _ _ ha h + +protected lemma add_lt_add_right [covariant_class α α (swap (+)) (<)] (ha : a ≠ ⊥) (h : b < c) : + b + a < c + a := +@with_top.add_lt_add_right αᵒᵈ _ _ _ _ _ _ ha h + +protected lemma add_le_add_iff_left [covariant_class α α (+) (≤)] [contravariant_class α α (+) (≤)] + (ha : a ≠ ⊥) : a + b ≤ a + c ↔ b ≤ c := +⟨with_bot.le_of_add_le_add_left ha, λ h, add_le_add_left h a⟩ + +protected lemma add_le_add_iff_right [covariant_class α α (swap (+)) (≤)] + [contravariant_class α α (swap (+)) (≤)] (ha : a ≠ ⊥) : b + a ≤ c + a ↔ b ≤ c := +⟨with_bot.le_of_add_le_add_right ha, λ h, add_le_add_right h a⟩ + +protected lemma add_lt_add_iff_left [covariant_class α α (+) (<)] [contravariant_class α α (+) (<)] + (ha : a ≠ ⊥) : a + b < a + c ↔ b < c := +⟨lt_of_add_lt_add_left, with_bot.add_lt_add_left ha⟩ + +protected lemma add_lt_add_iff_right [covariant_class α α (swap (+)) (<)] + [contravariant_class α α (swap (+)) (<)] (ha : a ≠ ⊥) : b + a < c + a ↔ b < c := +⟨lt_of_add_lt_add_right, with_bot.add_lt_add_right ha⟩ + +protected lemma add_lt_add_of_le_of_lt [covariant_class α α (+) (<)] + [covariant_class α α (swap (+)) (≤)] (hb : b ≠ ⊥) (hab : a ≤ b) (hcd : c < d) : a + c < b + d := +@with_top.add_lt_add_of_le_of_lt αᵒᵈ _ _ _ _ _ _ _ _ hb hab hcd + +protected lemma add_lt_add_of_lt_of_le [covariant_class α α (+) (≤)] + [covariant_class α α (swap (+)) (<)] (hd : d ≠ ⊥) (hab : a < b) (hcd : c ≤ d) : a + c < b + d := +@with_top.add_lt_add_of_lt_of_le αᵒᵈ _ _ _ _ _ _ _ _ hd hab hcd + +end has_add + +instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (with_bot α) := +{ add_le_add_left := λ a b h c, add_le_add_left h c, + ..with_bot.partial_order, + ..with_bot.add_comm_monoid } + +instance [linear_ordered_add_comm_monoid α] : linear_ordered_add_comm_monoid (with_bot α) := +{ ..with_bot.linear_order, ..with_bot.ordered_add_comm_monoid } + +end with_bot diff --git a/src/algebra/order/monoid/with_zero/basic.lean b/src/algebra/order/monoid/with_zero/basic.lean new file mode 100644 index 0000000000000..730b921ca2722 --- /dev/null +++ b/src/algebra/order/monoid/with_zero/basic.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.order.monoid.with_zero.defs +import algebra.group_with_zero.basic + +/-! +# An instance orphaned from `algebra.order.monoid.with_zero.defs` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We put this here to minimise imports: if you can move it back into +`algebra.order.monoid.with_zero.defs` without increasing imports, please do. +-/ + +open function + +universe u +variables {α : Type u} + +namespace with_zero + +instance contravariant_class_mul_lt {α : Type u} [has_mul α] [partial_order α] + [contravariant_class α α (*) (<)] : + contravariant_class (with_zero α) (with_zero α) (*) (<) := +begin + refine ⟨λ a b c h, _⟩, + have := ((zero_le _).trans_lt h).ne', + lift a to α using left_ne_zero_of_mul this, + lift c to α using right_ne_zero_of_mul this, + induction b using with_zero.rec_zero_coe, + exacts [zero_lt_coe _, coe_lt_coe.mpr (lt_of_mul_lt_mul_left' $ coe_lt_coe.mp h)] +end + +end with_zero diff --git a/src/algebra/order/monoid/with_zero/defs.lean b/src/algebra/order/monoid/with_zero/defs.lean new file mode 100644 index 0000000000000..4a30575a06993 --- /dev/null +++ b/src/algebra/order/monoid/with_zero/defs.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import algebra.group.with_one.defs +import algebra.order.monoid.canonical.defs +import algebra.order.zero_le_one + +/-! +# Adjoining a zero element to an ordered monoid. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +set_option old_structure_cmd true + +universe u +variables {α : Type u} + +/-- A linearly ordered commutative monoid with a zero element. -/ +class linear_ordered_comm_monoid_with_zero (α : Type*) + extends linear_ordered_comm_monoid α, comm_monoid_with_zero α := +(zero_le_one : (0 : α) ≤ 1) + +@[priority 100] +instance linear_ordered_comm_monoid_with_zero.to_zero_le_one_class + [linear_ordered_comm_monoid_with_zero α] : zero_le_one_class α := +{ ..‹linear_ordered_comm_monoid_with_zero α› } + +@[priority 100] +instance canonically_ordered_add_monoid.to_zero_le_one_class [canonically_ordered_add_monoid α] + [has_one α] : zero_le_one_class α := +⟨zero_le 1⟩ + +namespace with_zero + +local attribute [semireducible] with_zero + +instance [preorder α] : preorder (with_zero α) := with_bot.preorder + +instance [partial_order α] : partial_order (with_zero α) := with_bot.partial_order + +instance [preorder α] : order_bot (with_zero α) := with_bot.order_bot + +lemma zero_le [preorder α] (a : with_zero α) : 0 ≤ a := bot_le + +lemma zero_lt_coe [preorder α] (a : α) : (0 : with_zero α) < a := with_bot.bot_lt_coe a + +lemma zero_eq_bot [preorder α] : (0 : with_zero α) = ⊥ := rfl + +@[simp, norm_cast] lemma coe_lt_coe [preorder α] {a b : α} : (a : with_zero α) < b ↔ a < b := +with_bot.coe_lt_coe + +@[simp, norm_cast] lemma coe_le_coe [preorder α] {a b : α} : (a : with_zero α) ≤ b ↔ a ≤ b := +with_bot.coe_le_coe + +instance [lattice α] : lattice (with_zero α) := with_bot.lattice + +instance [linear_order α] : linear_order (with_zero α) := with_bot.linear_order + +instance covariant_class_mul_le {α : Type u} [has_mul α] [preorder α] + [covariant_class α α (*) (≤)] : + covariant_class (with_zero α) (with_zero α) (*) (≤) := +begin + refine ⟨λ a b c hbc, _⟩, + induction a using with_zero.rec_zero_coe, { exact zero_le _ }, + induction b using with_zero.rec_zero_coe, { exact zero_le _ }, + rcases with_bot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩, + rw [← coe_mul, ← coe_mul, coe_le_coe], + exact mul_le_mul_left' hbc' a +end + +@[simp] lemma le_max_iff [linear_order α] {a b c : α} : + (a : with_zero α) ≤ max b c ↔ a ≤ max b c := +by simp only [with_zero.coe_le_coe, le_max_iff] + +@[simp] lemma min_le_iff [linear_order α] {a b c : α} : + min (a : with_zero α) b ≤ c ↔ min a b ≤ c := +by simp only [with_zero.coe_le_coe, min_le_iff] + +instance [ordered_comm_monoid α] : ordered_comm_monoid (with_zero α) := +{ mul_le_mul_left := λ _ _, mul_le_mul_left', + ..with_zero.comm_monoid_with_zero, + ..with_zero.partial_order } + +protected lemma covariant_class_add_le [add_zero_class α] [preorder α] + [covariant_class α α (+) (≤)] (h : ∀ a : α, 0 ≤ a) : + covariant_class (with_zero α) (with_zero α) (+) (≤) := +begin + refine ⟨λ a b c hbc, _⟩, + induction a using with_zero.rec_zero_coe, + { rwa [zero_add, zero_add] }, + induction b using with_zero.rec_zero_coe, + { rw [add_zero], + induction c using with_zero.rec_zero_coe, + { rw [add_zero], exact le_rfl }, + { rw [← coe_add, coe_le_coe], + exact le_add_of_nonneg_right (h _) } }, + { rcases with_bot.coe_le_iff.1 hbc with ⟨c, rfl, hbc'⟩, + rw [← coe_add, ← coe_add, coe_le_coe], + exact add_le_add_left hbc' a } +end + +/- +Note 1 : the below is not an instance because it requires `zero_le`. It seems +like a rather pathological definition because α already has a zero. +Note 2 : there is no multiplicative analogue because it does not seem necessary. +Mathematicians might be more likely to use the order-dual version, where all +elements are ≤ 1 and then 1 is the top element. +-/ + +/-- +If `0` is the least element in `α`, then `with_zero α` is an `ordered_add_comm_monoid`. +See note [reducible non-instances]. +-/ +@[reducible] protected def ordered_add_comm_monoid [ordered_add_comm_monoid α] + (zero_le : ∀ a : α, 0 ≤ a) : ordered_add_comm_monoid (with_zero α) := +{ add_le_add_left := @add_le_add_left _ _ _ (with_zero.covariant_class_add_le zero_le), + ..with_zero.partial_order, + ..with_zero.add_comm_monoid, .. } + +end with_zero + +section canonically_ordered_monoid + +instance with_zero.has_exists_add_of_le {α} [has_add α] [preorder α] [has_exists_add_of_le α] : + has_exists_add_of_le (with_zero α) := +⟨λ a b, begin + apply with_zero.cases_on a, + { exact λ _, ⟨b, (zero_add b).symm⟩ }, + apply with_zero.cases_on b, + { exact λ b' h, (with_bot.not_coe_le_bot _ h).elim }, + rintro a' b' h, + obtain ⟨c, rfl⟩ := exists_add_of_le (with_zero.coe_le_coe.1 h), + exact ⟨c, rfl⟩, +end⟩ + +-- This instance looks absurd: a monoid already has a zero +/-- Adding a new zero to a canonically ordered additive monoid produces another one. -/ +instance with_zero.canonically_ordered_add_monoid {α : Type u} [canonically_ordered_add_monoid α] : + canonically_ordered_add_monoid (with_zero α) := +{ le_self_add := λ a b, begin + apply with_zero.cases_on a, + { exact bot_le }, + apply with_zero.cases_on b, + { exact λ b', le_rfl }, + { exact λ a' b', with_zero.coe_le_coe.2 le_self_add } + end, + .. with_zero.order_bot, + .. with_zero.ordered_add_comm_monoid zero_le, ..with_zero.has_exists_add_of_le } + +end canonically_ordered_monoid + +section canonically_linear_ordered_monoid + +instance with_zero.canonically_linear_ordered_add_monoid + (α : Type*) [canonically_linear_ordered_add_monoid α] : + canonically_linear_ordered_add_monoid (with_zero α) := +{ .. with_zero.canonically_ordered_add_monoid, + .. with_zero.linear_order } + +end canonically_linear_ordered_monoid diff --git a/src/algebra/order/monoid_lemmas.lean b/src/algebra/order/monoid_lemmas.lean deleted file mode 100644 index 4808acd20a01f..0000000000000 --- a/src/algebra/order/monoid_lemmas.lean +++ /dev/null @@ -1,811 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl, Damiano Testa, -Yuyang Zhao --/ -import algebra.covariant_and_contravariant -import order.monotone - -/-! -# Ordered monoids - -This file develops the basics of ordered monoids. - -## Implementation details - -Unfortunately, the number of `'` appended to lemmas in this file -may differ between the multiplicative and the additive version of a lemma. -The reason is that we did not want to change existing names in the library. - -## Remark - -Almost no monoid is actually present in this file: most assumptions have been generalized to -`has_mul` or `mul_one_class`. - --/ - --- TODO: If possible, uniformize lemma names, taking special care of `'`, --- after the `ordered`-refactor is done. - -open function - -variables {α β : Type*} - -section has_mul -variables [has_mul α] - -section has_le -variables [has_le α] - -/- The prime on this lemma is present only on the multiplicative version. The unprimed version -is taken by the analogous lemma for semiring, with an extra non-negativity assumption. -/ -@[to_additive add_le_add_left] -lemma mul_le_mul_left' [covariant_class α α (*) (≤)] - {b c : α} (bc : b ≤ c) (a : α) : - a * b ≤ a * c := -covariant_class.elim _ bc - -@[to_additive le_of_add_le_add_left] -lemma le_of_mul_le_mul_left' [contravariant_class α α (*) (≤)] - {a b c : α} (bc : a * b ≤ a * c) : - b ≤ c := -contravariant_class.elim _ bc - -/- The prime on this lemma is present only on the multiplicative version. The unprimed version -is taken by the analogous lemma for semiring, with an extra non-negativity assumption. -/ -@[to_additive add_le_add_right] -lemma mul_le_mul_right' [covariant_class α α (swap (*)) (≤)] - {b c : α} (bc : b ≤ c) (a : α) : - b * a ≤ c * a := -covariant_class.elim a bc - -@[to_additive le_of_add_le_add_right] -lemma le_of_mul_le_mul_right' [contravariant_class α α (swap (*)) (≤)] - {a b c : α} (bc : b * a ≤ c * a) : - b ≤ c := -contravariant_class.elim a bc - -@[simp, to_additive] -lemma mul_le_mul_iff_left [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] - (a : α) {b c : α} : - a * b ≤ a * c ↔ b ≤ c := -rel_iff_cov α α (*) (≤) a - -@[simp, to_additive] -lemma mul_le_mul_iff_right - [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)] - (a : α) {b c : α} : - b * a ≤ c * a ↔ b ≤ c := -rel_iff_cov α α (swap (*)) (≤) a - -end has_le - -section has_lt -variables [has_lt α] - -@[simp, to_additive] -lemma mul_lt_mul_iff_left [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] - (a : α) {b c : α} : - a * b < a * c ↔ b < c := -rel_iff_cov α α (*) (<) a - -@[simp, to_additive] -lemma mul_lt_mul_iff_right - [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)] - (a : α) {b c : α} : - b * a < c * a ↔ b < c := -rel_iff_cov α α (swap (*)) (<) a - -@[to_additive add_lt_add_left] -lemma mul_lt_mul_left' [covariant_class α α (*) (<)] - {b c : α} (bc : b < c) (a : α) : - a * b < a * c := -covariant_class.elim _ bc - -@[to_additive lt_of_add_lt_add_left] -lemma lt_of_mul_lt_mul_left' [contravariant_class α α (*) (<)] - {a b c : α} (bc : a * b < a * c) : - b < c := -contravariant_class.elim _ bc - -@[to_additive add_lt_add_right] -lemma mul_lt_mul_right' [covariant_class α α (swap (*)) (<)] - {b c : α} (bc : b < c) (a : α) : - b * a < c * a := -covariant_class.elim a bc - -@[to_additive lt_of_add_lt_add_right] -lemma lt_of_mul_lt_mul_right' [contravariant_class α α (swap (*)) (<)] - {a b c : α} (bc : b * a < c * a) : - b < c := -contravariant_class.elim a bc - -end has_lt - -section preorder -variables [preorder α] - -@[to_additive] -lemma mul_lt_mul_of_lt_of_lt [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] - {a b c d : α} (h₁ : a < b) (h₂ : c < d) : a * c < b * d := -calc a * c < a * d : mul_lt_mul_left' h₂ a - ... < b * d : mul_lt_mul_right' h₁ d - -@[to_additive] -lemma mul_lt_mul_of_le_of_lt [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h₁ : a ≤ b) (h₂ : c < d) : a * c < b * d := -(mul_le_mul_right' h₁ _).trans_lt (mul_lt_mul_left' h₂ b) - -@[to_additive] -lemma mul_lt_mul_of_lt_of_le [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (<)] - {a b c d : α} (h₁ : a < b) (h₂ : c ≤ d) : a * c < b * d := -(mul_le_mul_left' h₂ _).trans_lt (mul_lt_mul_right' h₁ d) - -@[to_additive add_lt_add] -lemma mul_lt_mul''' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h₁ : a < b) (h₂ : c < d) : a * c < b * d := -mul_lt_mul_of_le_of_lt h₁.le h₂ - -@[to_additive add_le_add] -lemma mul_le_mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d := -(mul_le_mul_left' h₂ _).trans (mul_le_mul_right' h₁ d) - -@[to_additive] -lemma mul_le_mul_three [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] - {a b c d e f : α} (h₁ : a ≤ d) (h₂ : b ≤ e) (h₃ : c ≤ f) : - a * b * c ≤ d * e * f := -mul_le_mul' (mul_le_mul' h₁ h₂) h₃ - -@[to_additive] -lemma mul_lt_of_mul_lt_left [covariant_class α α (*) (≤)] - {a b c d : α} (h : a * b < c) (hle : d ≤ b) : - a * d < c := -(mul_le_mul_left' hle a).trans_lt h - -@[to_additive] -lemma mul_le_of_mul_le_left [covariant_class α α (*) (≤)] - {a b c d : α} (h : a * b ≤ c) (hle : d ≤ b) : - a * d ≤ c := -@act_rel_of_rel_of_act_rel _ _ _ (≤) _ ⟨λ _ _ _, le_trans⟩ a _ _ _ hle h - -@[to_additive] -lemma mul_lt_of_mul_lt_right [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h : a * b < c) (hle : d ≤ a) : - d * b < c := -(mul_le_mul_right' hle b).trans_lt h - -@[to_additive] -lemma mul_le_of_mul_le_right [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h : a * b ≤ c) (hle : d ≤ a) : - d * b ≤ c := -(mul_le_mul_right' hle b).trans h - -@[to_additive] -lemma lt_mul_of_lt_mul_left [covariant_class α α (*) (≤)] - {a b c d : α} (h : a < b * c) (hle : c ≤ d) : - a < b * d := -h.trans_le (mul_le_mul_left' hle b) - -@[to_additive] -lemma le_mul_of_le_mul_left [covariant_class α α (*) (≤)] - {a b c d : α} (h : a ≤ b * c) (hle : c ≤ d) : - a ≤ b * d := -@rel_act_of_rel_of_rel_act _ _ _ (≤) _ ⟨λ _ _ _, le_trans⟩ b _ _ _ hle h - -@[to_additive] -lemma lt_mul_of_lt_mul_right [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h : a < b * c) (hle : b ≤ d) : - a < d * c := -h.trans_le (mul_le_mul_right' hle c) - -@[to_additive] -lemma le_mul_of_le_mul_right [covariant_class α α (swap (*)) (≤)] - {a b c d : α} (h : a ≤ b * c) (hle : b ≤ d) : - a ≤ d * c := -h.trans (mul_le_mul_right' hle c) - -end preorder - -section partial_order -variables [partial_order α] - -@[to_additive] -lemma mul_left_cancel'' [contravariant_class α α (*) (≤)] - {a b c : α} (h : a * b = a * c) : - b = c := -(le_of_mul_le_mul_left' h.le).antisymm (le_of_mul_le_mul_left' h.ge) - -@[to_additive] -lemma mul_right_cancel'' [contravariant_class α α (swap (*)) (≤)] - {a b c : α} (h : a * b = c * b) : - a = c := -le_antisymm (le_of_mul_le_mul_right' h.le) (le_of_mul_le_mul_right' h.ge) - -end partial_order - -end has_mul - --- using one -section mul_one_class -variables [mul_one_class α] - -section has_le -variables [has_le α] - -@[to_additive le_add_of_nonneg_right] -lemma le_mul_of_one_le_right' [covariant_class α α (*) (≤)] {a b : α} (h : 1 ≤ b) : - a ≤ a * b := -calc a = a * 1 : (mul_one _).symm - ... ≤ a * b : mul_le_mul_left' h a - -@[to_additive add_le_of_nonpos_right] -lemma mul_le_of_le_one_right' [covariant_class α α (*) (≤)] {a b : α} (h : b ≤ 1) : - a * b ≤ a := -calc a * b ≤ a * 1 : mul_le_mul_left' h a - ... = a : mul_one a - -@[simp, to_additive le_add_iff_nonneg_right] -lemma le_mul_iff_one_le_right' - [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] - (a : α) {b : α} : - a ≤ a * b ↔ 1 ≤ b := -iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a) - -@[simp, to_additive le_add_iff_nonneg_left] -lemma le_mul_iff_one_le_left' - [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)] - (a : α) {b : α} : - a ≤ b * a ↔ 1 ≤ b := -iff.trans (by rw one_mul) (mul_le_mul_iff_right a) - -@[simp, to_additive add_le_iff_nonpos_right] -lemma mul_le_iff_le_one_right' - [covariant_class α α (*) (≤)] [contravariant_class α α (*) (≤)] - (a : α) {b : α} : - a * b ≤ a ↔ b ≤ 1 := -iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a) - -@[simp, to_additive add_le_iff_nonpos_left] -lemma mul_le_iff_le_one_left' - [covariant_class α α (swap (*)) (≤)] [contravariant_class α α (swap (*)) (≤)] - {a b : α} : - a * b ≤ b ↔ a ≤ 1 := -iff.trans (by rw one_mul) (mul_le_mul_iff_right b) - -end has_le - -section has_lt -variable [has_lt α] - -@[to_additive lt_add_of_pos_right] -lemma lt_mul_of_one_lt_right' - [covariant_class α α (*) (<)] - (a : α) {b : α} (h : 1 < b) : - a < a * b := -calc a = a * 1 : (mul_one _).symm - ... < a * b : mul_lt_mul_left' h a - -@[simp, to_additive lt_add_iff_pos_right] -lemma lt_mul_iff_one_lt_right' - [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] - (a : α) {b : α} : - a < a * b ↔ 1 < b := -iff.trans (by rw mul_one) (mul_lt_mul_iff_left a) - -@[simp, to_additive lt_add_iff_pos_left] -lemma lt_mul_iff_one_lt_left' - [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)] - (a : α) {b : α} : - a < b * a ↔ 1 < b := -iff.trans (by rw one_mul) (mul_lt_mul_iff_right a) - -@[simp, to_additive add_lt_iff_neg_left] -lemma mul_lt_iff_lt_one_left' - [covariant_class α α (*) (<)] [contravariant_class α α (*) (<)] - {a b : α} : - a * b < a ↔ b < 1 := -iff.trans (by rw mul_one) (mul_lt_mul_iff_left a) - -@[simp, to_additive add_lt_iff_neg_right] -lemma mul_lt_iff_lt_one_right' - [covariant_class α α (swap (*)) (<)] [contravariant_class α α (swap (*)) (<)] - {a : α} (b : α) : - a * b < b ↔ a < 1 := -iff.trans (by rw one_mul) (mul_lt_mul_iff_right b) - -end has_lt - -section preorder -variable [preorder α] - -/-! Lemmas in the form of `b ≤ c → a ≤ 1 → b * a ≤ c`, -which assume left covariance. -/ - -@[to_additive] -lemma mul_le_of_le_of_le_one [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b ≤ c) (ha : a ≤ 1) : b * a ≤ c := -calc b * a ≤ b * 1 : mul_le_mul_left' ha b - ... = b : mul_one b - ... ≤ c : hbc - -alias mul_le_of_le_of_le_one ← mul_le_one' -attribute [to_additive add_nonpos] mul_le_one' - -@[to_additive] -lemma mul_lt_of_le_of_lt_one [covariant_class α α (*) (<)] - {a b c : α} (hbc : b ≤ c) (ha : a < 1) : b * a < c := -calc b * a < b * 1 : mul_lt_mul_left' ha b - ... = b : mul_one b - ... ≤ c : hbc - -@[to_additive] -lemma mul_lt_of_lt_of_le_one [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b < c) (ha : a ≤ 1) : b * a < c := -calc b * a ≤ b * 1 : mul_le_mul_left' ha b - ... = b : mul_one b - ... < c : hbc - -@[to_additive] -lemma mul_lt_of_lt_of_lt_one [covariant_class α α (*) (<)] - {a b c : α} (hbc : b < c) (ha : a < 1) : b * a < c := -calc b * a < b * 1 : mul_lt_mul_left' ha b - ... = b : mul_one b - ... < c : hbc - -/-- Assumes left covariance. The lemma assuming right covariance is `right.mul_lt_one`. -/ -@[to_additive "Assumes left covariance. The lemma assuming right covariance is `right.add_neg`."] -lemma left.mul_lt_one [covariant_class α α (*) (<)] - {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 := -calc a * b < a * 1 : mul_lt_mul_left' hb a - ... = a : mul_one a - ... < 1 : ha - -/-! Lemmas in the form of `b ≤ c → 1 ≤ a → b ≤ c * a`, -which assume left covariance. -/ - -@[to_additive] -lemma le_mul_of_le_of_le_one [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b ≤ c) (ha : 1 ≤ a) : b ≤ c * a := -calc b ≤ c : hbc - ... = c * 1 : (mul_one c).symm - ... ≤ c * a : mul_le_mul_left' ha c - -@[to_additive] -lemma lt_mul_of_le_of_one_lt [covariant_class α α (*) (<)] - {a b c : α} (hbc : b ≤ c) (ha : 1 < a) : b < c * a := -calc b ≤ c : hbc - ... = c * 1 : (mul_one c).symm - ... < c * a : mul_lt_mul_left' ha c - -@[to_additive] -lemma lt_mul_of_lt_of_one_le [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b < c) (ha : 1 ≤ a) : b < c * a := -calc b < c : hbc - ... = c * 1 : (mul_one c).symm - ... ≤ c * a : mul_le_mul_left' ha c - -@[to_additive] -lemma lt_mul_of_lt_of_one_lt [covariant_class α α (*) (<)] - {a b c : α} (hbc : b < c) (ha : 1 < a) : b < c * a := -calc b < c : hbc - ... = c * 1 : (mul_one c).symm - ... < c * a : mul_lt_mul_left' ha c - -@[to_additive] -lemma lt_mul_of_lt_of_one_le' [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b < c) (ha : 1 ≤ a) : b < c * a := -hbc.trans_le $ le_mul_of_one_le_right' ha - -@[to_additive] -lemma lt_mul_of_lt_of_one_lt' [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b < c) (ha : 1 < a) : b < c * a := -lt_mul_of_lt_of_one_le' hbc ha.le - -@[to_additive] -lemma le_mul_of_le_of_one_le [covariant_class α α (*) (≤)] - {a b c : α} (hbc : b ≤ c) (ha : 1 ≤ a) : b ≤ c * a := -calc b ≤ c : hbc - ... = c * 1 : (mul_one c).symm - ... ≤ c * a : mul_le_mul_left' ha c - -@[to_additive add_nonneg] -lemma one_le_mul_right [covariant_class α α (*) (≤)] - {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b := -calc 1 ≤ a : ha - ... = a * 1 : (mul_one a).symm - ... ≤ a * b : mul_le_mul_left' hb a - -/- This lemma is present to mimick the name of an existing one. -/ -@[to_additive add_nonneg] -lemma one_le_mul [covariant_class α α (*) (≤)] - {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b := -le_mul_of_le_of_le_one ha hb - -@[to_additive add_pos_of_pos_of_nonneg] -lemma one_lt_mul_of_lt_of_le' [covariant_class α α (*) (≤)] - {a b : α} (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b := -lt_of_lt_of_le ha $ le_mul_of_one_le_right' hb - -@[to_additive add_pos] -lemma one_lt_mul' [covariant_class α α (*) (≤)] - {a b : α} (ha : 1 < a) (hb : 1 < b) : 1 < a * b := -one_lt_mul_of_lt_of_le' ha hb.le - -/-! Lemmas in the form of `a ≤ 1 → b ≤ c → a * b ≤ c`, -which assume right covariance. -/ - -@[to_additive] -lemma mul_le_of_le_one_of_le [covariant_class α α (swap (*)) (≤)] - {a b c : α} (ha : a ≤ 1) (hbc : b ≤ c) : a * b ≤ c := -calc a * b ≤ 1 * b : mul_le_mul_right' ha b - ... = b : one_mul b - ... ≤ c : hbc - -@[to_additive] -lemma mul_lt_of_lt_one_of_le [covariant_class α α (swap (*)) (<)] - {a b c : α} (ha : a < 1) (hbc : b ≤ c) : a * b < c := -calc a * b < 1 * b : mul_lt_mul_right' ha b - ... = b : one_mul b - ... ≤ c : hbc - -@[to_additive] -lemma mul_lt_of_le_one_of_lt [covariant_class α α (swap (*)) (≤)] - {a b c : α} (ha : a ≤ 1) (hb : b < c) : a * b < c := -calc a * b ≤ 1 * b : mul_le_mul_right' ha b - ... = b : one_mul b - ... < c : hb - -@[to_additive] -lemma mul_lt_of_lt_one_of_lt [covariant_class α α (swap (*)) (<)] - {a b c : α} (ha : a < 1) (hb : b < c) : a * b < c := -calc a * b < 1 * b : mul_lt_mul_right' ha b - ... = b : one_mul b - ... < c : hb - -@[to_additive add_le_of_nonpos_left] -lemma mul_le_of_le_one_left' [covariant_class α α (swap (*)) (≤)] - {a b : α} (h : b ≤ 1) : b * a ≤ a := -calc b * a ≤ 1 * a : mul_le_mul_right' h a - ... = a : one_mul a - -/-- Assumes right covariance. The lemma assuming left covariance is `left.mul_lt_one`. -/ -@[to_additive "Assumes right covariance. The lemma assuming left covariance is `left.add_neg`"] -lemma right.mul_lt_one [covariant_class α α (swap (*)) (<)] - {a b : α} (ha : a < 1) (hb : b < 1) : a * b < 1 := -calc a * b < 1 * b : mul_lt_mul_right' ha b - ... = b : one_mul b - ... < 1 : hb - -/-! Lemmas in the form of `1 ≤ a → b ≤ c → b ≤ a * c`, -which assume right covariance. -/ - -@[to_additive] -lemma le_mul_of_one_le_of_le [covariant_class α α (swap (*)) (≤)] - {a b c : α} (ha : 1 ≤ a) (hbc : b ≤ c) : b ≤ a * c := -calc b ≤ c : hbc - ... = 1 * c : (one_mul c).symm - ... ≤ a * c : mul_le_mul_right' ha c - -@[to_additive] -lemma lt_mul_of_one_lt_of_le [covariant_class α α (swap (*)) (<)] - {a b c : α} (ha : 1 < a) (hbc : b ≤ c) : b < a * c := -calc b ≤ c : hbc - ... = 1 * c : (one_mul c).symm - ... < a * c : mul_lt_mul_right' ha c - -@[to_additive] -lemma lt_mul_of_one_le_of_lt [covariant_class α α (swap (*)) (≤)] - {a b c : α} (ha : 1 ≤ a) (hbc : b < c) : b < a * c := -calc b < c : hbc - ... = 1 * c : (one_mul c).symm - ... ≤ a * c : mul_le_mul_right' ha c - -@[to_additive] -lemma lt_mul_of_one_lt_of_lt [covariant_class α α (swap (*)) (≤)] - {a b c : α} (ha : 1 < a) (hbc : b < c) : b < a * c := -lt_mul_of_one_le_of_lt ha.le hbc - -@[to_additive le_add_of_nonneg_left] -lemma le_mul_of_one_le_left' [covariant_class α α (swap (*)) (≤)] - {a b : α} (h : 1 ≤ b) : a ≤ b * a := -calc a = 1 * a : (one_mul a).symm - ... ≤ b * a : mul_le_mul_right' h a - -@[to_additive lt_add_of_pos_left] -lemma lt_mul_of_one_lt_left' [covariant_class α α (swap (*)) (<)] - (a : α) {b : α} (h : 1 < b) : a < b * a := -calc a = 1 * a : (one_mul _).symm - ... < b * a : mul_lt_mul_right' h a - -/-- Assumes right covariance. -/ -@[to_additive right.add_nonneg "Assumes right covariance."] -lemma right.one_le_mul [covariant_class α α (swap (*)) (≤)] - {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b := -calc 1 ≤ b : hb - ... = 1 * b : (one_mul b).symm - ... ≤ a * b : mul_le_mul_right' ha b - -@[to_additive add_pos_of_nonneg_of_pos] -lemma one_lt_mul_of_le_of_lt' [covariant_class α α (swap (*)) (≤)] - {a b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b := -lt_of_lt_of_le hb $ le_mul_of_one_le_left' ha - -/-- Assumes right covariance. -/ -@[to_additive right.add_pos "Assumes right covariance."] -lemma right.one_lt_mul [covariant_class α α (swap (*)) (<)] - {a b : α} (hb : 1 < b) (ha : 1 < a) : 1 < a * b := -calc 1 < b : hb - ... = 1 * b : (one_mul b).symm - ... < a * b : mul_lt_mul_right' ha b - -@[to_additive] -lemma lt_of_mul_lt_of_one_le_left [covariant_class α α (*) (≤)] - {a b c : α} (h : a * b < c) (hle : 1 ≤ b) : a < c := -(le_mul_of_one_le_right' hle).trans_lt h - -@[to_additive] -lemma le_of_mul_le_of_one_le_left [covariant_class α α (*) (≤)] - {a b c : α} (h : a * b ≤ c) (hle : 1 ≤ b) : a ≤ c := -(le_mul_of_one_le_right' hle).trans h - -@[to_additive] -lemma lt_of_lt_mul_of_le_one_left [covariant_class α α (*) (≤)] - {a b c : α} (h : a < b * c) (hle : c ≤ 1) : a < b := -h.trans_le (mul_le_of_le_one_right' hle) - -@[to_additive] -lemma le_of_le_mul_of_le_one_left [covariant_class α α (*) (≤)] - {a b c : α} (h : a ≤ b * c) (hle : c ≤ 1) : a ≤ b := -h.trans (mul_le_of_le_one_right' hle) - -@[to_additive] -lemma lt_of_mul_lt_of_one_le_right [covariant_class α α (swap (*)) (≤)] - {a b c : α} (h : a * b < c) (hle : 1 ≤ a) : b < c := -(le_mul_of_one_le_left' hle).trans_lt h - -@[to_additive] -lemma le_of_mul_le_of_one_le_right [covariant_class α α (swap (*)) (≤)] - {a b c : α} (h : a * b ≤ c) (hle : 1 ≤ a) : b ≤ c := -(le_mul_of_one_le_left' hle).trans h - -@[to_additive] -lemma lt_of_lt_mul_of_le_one_right [covariant_class α α (swap (*)) (≤)] - {a b c : α} (h : a < b * c) (hle : b ≤ 1) : a < c := -h.trans_le (mul_le_of_le_one_left' hle) - -@[to_additive] -lemma le_of_le_mul_of_le_one_right [covariant_class α α (swap (*)) (≤)] - {a b c : α} (h : a ≤ b * c) (hle : b ≤ 1) : a ≤ c := -h.trans (mul_le_of_le_one_left' hle) - -end preorder - -section partial_order -variables [partial_order α] - -@[to_additive] -lemma mul_eq_one_iff' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] - {a b : α} (ha : 1 ≤ a) (hb : 1 ≤ b) : a * b = 1 ↔ a = 1 ∧ b = 1 := -iff.intro - (assume hab : a * b = 1, - have a ≤ 1, from hab ▸ le_mul_of_le_of_one_le le_rfl hb, - have a = 1, from le_antisymm this ha, - have b ≤ 1, from hab ▸ le_mul_of_one_le_of_le ha le_rfl, - have b = 1, from le_antisymm this hb, - and.intro ‹a = 1› ‹b = 1›) - (assume ⟨ha', hb'⟩, by rw [ha', hb', mul_one]) - -end partial_order - -section linear_order -variables [linear_order α] - -lemma exists_square_le [covariant_class α α (*) (<)] - (a : α) : ∃ (b : α), b * b ≤ a := -begin - by_cases h : a < 1, - { use a, - have : a*a < a*1, - exact mul_lt_mul_left' h a, - rw mul_one at this, - exact le_of_lt this }, - { use 1, - push_neg at h, - rwa mul_one } -end - -end linear_order - -end mul_one_class - -section semigroup -variables [semigroup α] - -section partial_order -variables [partial_order α] - -/- This is not instance, since we want to have an instance from `left_cancel_semigroup`s -to the appropriate `covariant_class`. -/ -/-- A semigroup with a partial order and satisfying `left_cancel_semigroup` -(i.e. `a * c < b * c → a < b`) is a `left_cancel semigroup`. -/ -@[to_additive -"An additive semigroup with a partial order and satisfying `left_cancel_add_semigroup` -(i.e. `c + a < c + b → a < b`) is a `left_cancel add_semigroup`."] -def contravariant.to_left_cancel_semigroup - [contravariant_class α α (*) (≤)] : - left_cancel_semigroup α := -{ mul_left_cancel := λ a b c, mul_left_cancel'' - ..‹semigroup α› } - -/- This is not instance, since we want to have an instance from `right_cancel_semigroup`s -to the appropriate `covariant_class`. -/ -/-- A semigroup with a partial order and satisfying `right_cancel_semigroup` -(i.e. `a * c < b * c → a < b`) is a `right_cancel semigroup`. -/ -@[to_additive -"An additive semigroup with a partial order and satisfying `right_cancel_add_semigroup` -(`a + c < b + c → a < b`) is a `right_cancel add_semigroup`."] -def contravariant.to_right_cancel_semigroup - [contravariant_class α α (swap (*)) (≤)] : - right_cancel_semigroup α := -{ mul_right_cancel := λ a b c, mul_right_cancel'' - ..‹semigroup α› } - -@[to_additive] lemma mul_eq_mul_iff_eq_and_eq - [contravariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] - [covariant_class α α (*) (<)] [contravariant_class α α (swap (*)) (≤)] - {a b c d : α} (hac : a ≤ c) (hbd : b ≤ d) : a * b = c * d ↔ a = c ∧ b = d := -begin - refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩, - rcases hac.eq_or_lt with rfl | hac, - { exact ⟨rfl, mul_left_cancel'' h⟩ }, - rcases eq_or_lt_of_le hbd with rfl | hbd, - { exact ⟨mul_right_cancel'' h, rfl⟩ }, - exact ((mul_lt_mul''' hac hbd).ne h).elim, -end - -end partial_order - -end semigroup - -section mono -variables [has_mul α] [preorder α] [preorder β] {f g : β → α} - -@[to_additive monotone.const_add] -lemma monotone.const_mul' [covariant_class α α (*) (≤)] (hf : monotone f) (a : α) : - monotone (λ x, a * f x) := -λ x y h, mul_le_mul_left' (hf h) a - -@[to_additive monotone.add_const] -lemma monotone.mul_const' [covariant_class α α (swap (*)) (≤)] - (hf : monotone f) (a : α) : monotone (λ x, f x * a) := -λ x y h, mul_le_mul_right' (hf h) a - -/-- The product of two monotone functions is monotone. -/ -@[to_additive monotone.add "The sum of two monotone functions is monotone."] -lemma monotone.mul' [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] - (hf : monotone f) (hg : monotone g) : monotone (λ x, f x * g x) := -λ x y h, mul_le_mul' (hf h) (hg h) - -section left -variables [covariant_class α α (*) (<)] - -@[to_additive strict_mono.const_add] -lemma strict_mono.const_mul' (hf : strict_mono f) (c : α) : - strict_mono (λ x, c * f x) := -λ a b ab, mul_lt_mul_left' (hf ab) c - -end left - -section right -variables [covariant_class α α (swap (*)) (<)] - -@[to_additive strict_mono.add_const] -lemma strict_mono.mul_const' (hf : strict_mono f) (c : α) : - strict_mono (λ x, f x * c) := -λ a b ab, mul_lt_mul_right' (hf ab) c - -end right - -/-- The product of two strictly monotone functions is strictly monotone. -/ -@[to_additive strict_mono.add -"The sum of two strictly monotone functions is strictly monotone."] -lemma strict_mono.mul' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (<)] - (hf : strict_mono f) (hg : strict_mono g) : - strict_mono (λ x, f x * g x) := -λ a b ab, mul_lt_mul_of_lt_of_lt (hf ab) (hg ab) - -/-- The product of a monotone function and a strictly monotone function is strictly monotone. -/ -@[to_additive monotone.add_strict_mono -"The sum of a monotone function and a strictly monotone function is strictly monotone."] -lemma monotone.mul_strict_mono' [covariant_class α α (*) (<)] [covariant_class α α (swap (*)) (≤)] - {f g : β → α} (hf : monotone f) (hg : strict_mono g) : - strict_mono (λ x, f x * g x) := -λ x y h, mul_lt_mul_of_le_of_lt (hf h.le) (hg h) - -variables [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (<)] - -/-- The product of a strictly monotone function and a monotone function is strictly monotone. -/ -@[to_additive strict_mono.add_monotone -"The sum of a strictly monotone function and a monotone function is strictly monotone."] -lemma strict_mono.mul_monotone' (hf : strict_mono f) (hg : monotone g) : - strict_mono (λ x, f x * g x) := -λ x y h, mul_lt_mul_of_lt_of_le (hf h) (hg h.le) - -end mono - -/-- -An element `a : α` is `mul_le_cancellable` if `x ↦ a * x` is order-reflecting. -We will make a separate version of many lemmas that require `[contravariant_class α α (*) (≤)]` with -`mul_le_cancellable` assumptions instead. These lemmas can then be instantiated to specific types, -like `ennreal`, where we can replace the assumption `add_le_cancellable x` by `x ≠ ∞`. --/ -@[to_additive /-" An element `a : α` is `add_le_cancellable` if `x ↦ a + x` is order-reflecting. -We will make a separate version of many lemmas that require `[contravariant_class α α (+) (≤)]` with -`mul_le_cancellable` assumptions instead. These lemmas can then be instantiated to specific types, -like `ennreal`, where we can replace the assumption `add_le_cancellable x` by `x ≠ ∞`. "-/ -] -def mul_le_cancellable [has_mul α] [has_le α] (a : α) : Prop := -∀ ⦃b c⦄, a * b ≤ a * c → b ≤ c - -@[to_additive] -lemma contravariant.mul_le_cancellable [has_mul α] [has_le α] [contravariant_class α α (*) (≤)] - {a : α} : mul_le_cancellable a := -λ b c, le_of_mul_le_mul_left' - -namespace mul_le_cancellable - -@[to_additive] -protected lemma injective [has_mul α] [partial_order α] {a : α} (ha : mul_le_cancellable a) : - injective ((*) a) := -λ b c h, le_antisymm (ha h.le) (ha h.ge) - -@[to_additive] -protected lemma inj [has_mul α] [partial_order α] {a b c : α} (ha : mul_le_cancellable a) : - a * b = a * c ↔ b = c := -ha.injective.eq_iff - -@[to_additive] -protected lemma injective_left [comm_semigroup α] [partial_order α] {a : α} - (ha : mul_le_cancellable a) : injective (* a) := -λ b c h, ha.injective $ by rwa [mul_comm a, mul_comm a] - -@[to_additive] -protected lemma inj_left [comm_semigroup α] [partial_order α] {a b c : α} - (hc : mul_le_cancellable c) : a * c = b * c ↔ a = b := -hc.injective_left.eq_iff - -variable [has_le α] - -@[to_additive] -protected lemma mul_le_mul_iff_left [has_mul α] [covariant_class α α (*) (≤)] - {a b c : α} (ha : mul_le_cancellable a) : a * b ≤ a * c ↔ b ≤ c := -⟨λ h, ha h, λ h, mul_le_mul_left' h a⟩ - -@[to_additive] -protected lemma mul_le_mul_iff_right [comm_semigroup α] [covariant_class α α (*) (≤)] - {a b c : α} (ha : mul_le_cancellable a) : b * a ≤ c * a ↔ b ≤ c := -by rw [mul_comm b, mul_comm c, ha.mul_le_mul_iff_left] - -@[to_additive] -protected lemma le_mul_iff_one_le_right [mul_one_class α] [covariant_class α α (*) (≤)] - {a b : α} (ha : mul_le_cancellable a) : a ≤ a * b ↔ 1 ≤ b := -iff.trans (by rw [mul_one]) ha.mul_le_mul_iff_left - -@[to_additive] -protected lemma mul_le_iff_le_one_right [mul_one_class α] [covariant_class α α (*) (≤)] - {a b : α} (ha : mul_le_cancellable a) : a * b ≤ a ↔ b ≤ 1 := -iff.trans (by rw [mul_one]) ha.mul_le_mul_iff_left - -@[to_additive] -protected lemma le_mul_iff_one_le_left [comm_monoid α] [covariant_class α α (*) (≤)] - {a b : α} (ha : mul_le_cancellable a) : a ≤ b * a ↔ 1 ≤ b := -by rw [mul_comm, ha.le_mul_iff_one_le_right] - -@[to_additive] -protected lemma mul_le_iff_le_one_left [comm_monoid α] [covariant_class α α (*) (≤)] - {a b : α} (ha : mul_le_cancellable a) : b * a ≤ a ↔ b ≤ 1 := -by rw [mul_comm, ha.mul_le_iff_le_one_right] - -end mul_le_cancellable diff --git a/src/algebra/order/monoid_lemmas_zero_lt.lean b/src/algebra/order/monoid_lemmas_zero_lt.lean deleted file mode 100644 index b1a8f20e492d6..0000000000000 --- a/src/algebra/order/monoid_lemmas_zero_lt.lean +++ /dev/null @@ -1,841 +0,0 @@ -/- -Copyright (c) 2022 Damiano Testa. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Damiano Testa, Yuyang Zhao --/ -import algebra.covariant_and_contravariant -import algebra.group_with_zero.defs - -/-! -# Multiplication by ·positive· elements is monotonic - -Let `α` be a type with `<` and `0`. We use the type `{x : α // 0 < x}` of positive elements of `α` -to prove results about monotonicity of multiplication. We also introduce the local notation `α>0` -for the subtype `{x : α // 0 < x}`: - -* the notation `α>0` to stands for `{x : α // 0 < x}`. - -If the type `α` also has a multiplication, then we combine this with (`contravariant_`) -`covariant_class`es to assume that multiplication by positive elements is (strictly) monotone on a -`mul_zero_class`, `monoid_with_zero`,... -More specifically, we use extensively the following typeclasses: - -* monotone left -* * `covariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono α`, - expressing that multiplication by positive elements on the left is monotone; -* * `covariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_strict_mono α`, - expressing that multiplication by positive elements on the left is strictly monotone; -* monotone right -* * `covariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono α`, - expressing that multiplication by positive elements on the right is monotone; -* * `covariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_strict_mono α`, - expressing that multiplication by positive elements on the right is strictly monotone. -* reverse monotone left -* * `contravariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono_rev α`, - expressing that multiplication by positive elements on the left is reverse monotone; -* * `contravariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_reflect_lt α`, - expressing that multiplication by positive elements on the left is strictly reverse monotone; -* reverse reverse monotone right -* * `contravariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono_rev α`, - expressing that multiplication by positive elements on the right is reverse monotone; -* * `contravariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_reflect_lt α`, - expressing that multiplication by positive elements on the right is strictly reverse monotone. - -## Formalization comments - -We use `α>0 = {x : α // 0 < x}` with a strict inequality since in most cases what happens with `0` -is clear. This creates a few bumps in the first couple of proofs, where we have to split cases on -whether an element is `0` or not, but goes smoothly after that. A further advantage is that we -only introduce notation for the positive elements and we do not need also the non-negative ones. --/ - -/- I am changing the file `algebra/order/monoid_lemmas` incrementally, with the idea of -reproducing almost all of the proofs in `algebra/order/ring` with weaker assumptions. -/ - -universe u -variable {α : Type u} - -/- Notation for positive elements -https:// -leanprover.zulipchat.com/#narrow/stream/113488-general/topic/notation.20for.20positive.20elements --/ -local notation `α>0` := {x : α // 0 < x} - -namespace zero_lt - -section abbreviations_strict_mono -variables (X : Type u) [has_mul X] [has_zero X] [has_lt X] - -/-- `zero_lt.pos_mul_strict_mono α` is an abbreviation for -`covariant_class α>0 α (λ x y, x * y) (<)`, -expressing that multiplication by positive elements on the left is strictly monotone. -/ -abbreviation pos_mul_strict_mono : Prop := -covariant_class {x : X // 0 < x} X (λ x y, x * y) (<) - -/-- `zero_lt.mul_pos_strict_mono α` is an abbreviation for -`covariant_class α>0 α (λ x y, y * x) (<)`, -expressing that multiplication by positive elements on the right is strictly monotone. -/ -abbreviation mul_pos_strict_mono : Prop := -covariant_class {x : X // 0 < x} X (λ x y, y * x) (<) - -/-- `zero_lt.pos_mul_reflect_lt α` is an abbreviation for -`contravariant_class α>0 α (λ x y, x * y) (<)`, -expressing that multiplication by positive elements on the left is strictly reverse monotone. -/ -abbreviation pos_mul_reflect_lt : Prop := -contravariant_class {x : X // 0 < x} X (λ x y, x * y) (<) - -/-- `zero_lt.mul_pos_reflect_lt α` is an abbreviation for -`contravariant_class α>0 α (λ x y, y * x) (<)`, -expressing that multiplication by positive elements on the right is strictly reverse monotone. -/ -abbreviation mul_pos_reflect_lt : Prop := -contravariant_class {x : X // 0 < x} X (λ x y, y * x) (<) - -end abbreviations_strict_mono - -section abbreviations_mono -variables (X : Type*) [has_mul X] [has_zero X] [preorder X] - -/-- `zero_lt.pos_mul_mono α` is an abbreviation for -`covariant_class α>0 α (λ x y, x * y) (≤)`, -expressing that multiplication by positive elements on the left is monotone. -/ -abbreviation pos_mul_mono : Prop := -covariant_class {x : X // 0 < x} X (λ x y, x * y) (≤) - -/-- `zero_lt.mul_pos_mono α` is an abbreviation for -`covariant_class α>0 α (λ x y, y * x) (≤)`, -expressing that multiplication by positive elements on the right is monotone. -/ -abbreviation mul_pos_mono : Prop := -covariant_class {x : X // 0 < x} X (λ x y, y * x) (≤) - -/-- `zero_lt.pos_mul_mono_rev α` is an abbreviation for -`contravariant_class α>0 α (λ x y, x * y) (≤)`, -expressing that multiplication by positive elements on the left is reverse monotone. -/ -abbreviation pos_mul_mono_rev : Prop := -contravariant_class {x : X // 0 < x} X (λ x y, x * y) (≤) - -/-- `zero_lt.mul_pos_mono_rev α` is an abbreviation for -`contravariant_class α>0 α (λ x y, y * x) (≤)`, -expressing that multiplication by positive elements on the right is reverse monotone. -/ -abbreviation mul_pos_mono_rev : Prop := -contravariant_class {x : X // 0 < x} X (λ x y, y * x) (≤) - -end abbreviations_mono - -variables {a b c d : α} - -section has_mul_zero -variables [has_mul α] [has_zero α] - -section has_lt -variables [has_lt α] - -lemma mul_lt_mul_left' [pos_mul_strict_mono α] - (bc : b < c) (a0 : 0 < a) : - a * b < a * c := -@covariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc - -lemma mul_lt_mul_right' [mul_pos_strict_mono α] - (bc : b < c) (a0 : 0 < a) : - b * a < c * a := -@covariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc - --- proven with `a0 : 0 ≤ a` as `lt_of_mul_lt_mul_left''` -lemma lt_of_mul_lt_mul_left' [pos_mul_reflect_lt α] - (bc : a * b < a * c) (a0 : 0 < a) : - b < c := -@contravariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc - --- proven with `a0 : 0 ≤ a` as `lt_of_mul_lt_mul_right''` -lemma lt_of_mul_lt_mul_right' [mul_pos_reflect_lt α] - (bc : b * a < c * a) (a0 : 0 < a) : - b < c := -@contravariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc - -@[simp] -lemma mul_lt_mul_iff_left [pos_mul_strict_mono α] [pos_mul_reflect_lt α] - (a0 : 0 < a) : - a * b < a * c ↔ b < c := -@rel_iff_cov α>0 α (λ x y, x * y) (<) _ _ ⟨a, a0⟩ _ _ - -@[simp] -lemma mul_lt_mul_iff_right [mul_pos_strict_mono α] [mul_pos_reflect_lt α] - (a0 : 0 < a) : - b * a < c * a ↔ b < c := -@rel_iff_cov α>0 α (λ x y, y * x) (<) _ _ ⟨a, a0⟩ _ _ - -end has_lt - -section preorder -variables [preorder α] - -lemma mul_le_mul_left' [pos_mul_mono α] - (bc : b ≤ c) (a0 : 0 < a) : - a * b ≤ a * c := -@covariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc - -lemma mul_le_mul_right' [mul_pos_mono α] - (bc : b ≤ c) (a0 : 0 < a) : - b * a ≤ c * a := -@covariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc - -lemma le_of_mul_le_mul_left' [pos_mul_mono_rev α] - (bc : a * b ≤ a * c) (a0 : 0 < a) : - b ≤ c := -@contravariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc - -lemma le_of_mul_le_mul_right' [mul_pos_mono_rev α] - (bc : b * a ≤ c * a) (a0 : 0 < a) : - b ≤ c := -@contravariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc - -@[simp] -lemma mul_le_mul_iff_left [pos_mul_mono α] [pos_mul_mono_rev α] - (a0 : 0 < a) : - a * b ≤ a * c ↔ b ≤ c := -@rel_iff_cov α>0 α (λ x y, x * y) (≤) _ _ ⟨a, a0⟩ _ _ - -@[simp] -lemma mul_le_mul_iff_right [mul_pos_mono α] [mul_pos_mono_rev α] - (a0 : 0 < a) : - b * a ≤ c * a ↔ b ≤ c := -@rel_iff_cov α>0 α (λ x y, y * x) (≤) _ _ ⟨a, a0⟩ _ _ - -end preorder - -section partial_order -variables [partial_order α] - -@[priority 100] -- see Note [lower instance priority] -instance pos_mul_strict_mono.to_pos_mul_mono [pos_mul_strict_mono α] : pos_mul_mono α := -⟨λ x a b h, h.eq_or_lt.elim (λ h', h' ▸ le_rfl) (λ h', (mul_lt_mul_left' h' x.prop).le)⟩ - -@[priority 100] -- see Note [lower instance priority] -instance mul_pos_strict_mono.to_mul_pos_mono [mul_pos_strict_mono α] : mul_pos_mono α := -⟨λ x a b h, h.eq_or_lt.elim (λ h', h' ▸ le_rfl) (λ h', (mul_lt_mul_right' h' x.prop).le)⟩ - -@[priority 100] -- see Note [lower instance priority] -instance pos_mul_mono_rev.to_pos_mul_reflect_lt [pos_mul_mono_rev α] : pos_mul_reflect_lt α := -⟨λ x a b h, lt_of_le_of_ne (le_of_mul_le_mul_left' h.le x.prop) (λ h', by simpa [h'] using h)⟩ - -@[priority 100] -- see Note [lower instance priority] -instance mul_pos_mono_rev.to_mul_pos_reflect_lt [mul_pos_mono_rev α] : mul_pos_reflect_lt α := -⟨λ x a b h, lt_of_le_of_ne (le_of_mul_le_mul_right' h.le x.prop) (λ h', by simpa [h'] using h)⟩ - -end partial_order - -section linear_order -variables [linear_order α] - -@[priority 100] -- see Note [lower instance priority] -instance pos_mul_strict_mono.to_pos_mul_mono_rev [pos_mul_strict_mono α] : pos_mul_mono_rev α := -⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt (mul_lt_mul_left' h' x.prop)⟩ - -@[priority 100] -- see Note [lower instance priority] -instance mul_pos_strict_mono.to_mul_pos_mono_rev [mul_pos_strict_mono α] : mul_pos_mono_rev α := -⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt (mul_lt_mul_right' h' x.prop)⟩ - -end linear_order - -end has_mul_zero - -section mul_zero_class -variables [mul_zero_class α] - -section preorder -variables [preorder α] - -/-- Assumes left covariance. -/ -lemma left.mul_pos [pos_mul_strict_mono α] - (ha : 0 < a) (hb : 0 < b) : - 0 < a * b := -have h : a * 0 < a * b, from mul_lt_mul_left' hb ha, -by rwa [mul_zero] at h - -lemma mul_neg_of_pos_of_neg [pos_mul_strict_mono α] - (ha : 0 < a) (hb : b < 0) : - a * b < 0 := -have h : a * b < a * 0, from mul_lt_mul_left' hb ha, -by rwa [mul_zero] at h - -/-- Assumes right covariance. -/ -lemma right.mul_pos [mul_pos_strict_mono α] - (ha : 0 < a) (hb : 0 < b) : - 0 < a * b := -have h : 0 * b < a * b, from mul_lt_mul_right' ha hb, -by rwa [zero_mul] at h - -lemma mul_neg_of_neg_of_pos [mul_pos_strict_mono α] - (ha : a < 0) (hb : 0 < b) : - a * b < 0 := -have h : a * b < 0 * b, from mul_lt_mul_right' ha hb, -by rwa [zero_mul] at h - -end preorder - -section partial_order -variables [partial_order α] - -lemma mul_le_mul_left'' [pos_mul_mono α] - (bc : b ≤ c) (a0 : 0 ≤ a) : - a * b ≤ a * c := -a0.lt_or_eq.elim (mul_le_mul_left' bc) (λ h, by simp only [← h, zero_mul]) - -lemma mul_le_mul_right'' [mul_pos_mono α] - (bc : b ≤ c) (a0 : 0 ≤ a) : - b * a ≤ c * a := -a0.lt_or_eq.elim (mul_le_mul_right' bc) (λ h, by simp only [← h, mul_zero]) - -/-- Assumes left covariance. -/ -lemma left.mul_nonneg [pos_mul_mono α] - (ha : 0 ≤ a) (hb : 0 ≤ b) : - 0 ≤ a * b := -have h : a * 0 ≤ a * b, from mul_le_mul_left'' hb ha, -by rwa [mul_zero] at h - -lemma mul_nonpos_of_nonneg_of_nonpos [pos_mul_mono α] - (ha : 0 ≤ a) (hb : b ≤ 0) : - a * b ≤ 0 := -have h : a * b ≤ a * 0, from mul_le_mul_left'' hb ha, -by rwa [mul_zero] at h - -/-- Assumes right covariance. -/ -lemma right.mul_nonneg [mul_pos_mono α] - (ha : 0 ≤ a) (hb : 0 ≤ b) : - 0 ≤ a * b := -have h : 0 * b ≤ a * b, from mul_le_mul_right'' ha hb, -by rwa [zero_mul] at h - -lemma mul_nonpos_of_nonpos_of_nonneg [mul_pos_mono α] - (ha : a ≤ 0) (hb : 0 ≤ b) : - a * b ≤ 0 := -have h : a * b ≤ 0 * b, from mul_le_mul_right'' ha hb, -by rwa [zero_mul] at h - -lemma lt_of_mul_lt_mul_left'' [pos_mul_reflect_lt α] - (bc : a * b < a * c) (a0 : 0 ≤ a) : - b < c := -begin - by_cases a₀ : a = 0, - { exact (lt_irrefl (0 : α) (by simpa only [a₀, zero_mul] using bc)).elim }, - { exact lt_of_mul_lt_mul_left' bc ((ne.symm a₀).le_iff_lt.mp a0) } -end - -lemma pos_of_mul_pos_left [pos_mul_reflect_lt α] (h : 0 < a * b) (ha : 0 ≤ a) : - 0 < b := -lt_of_mul_lt_mul_left'' ((mul_zero a).symm ▸ h : a * 0 < a * b) ha - -lemma lt_of_mul_lt_mul_right'' [mul_pos_reflect_lt α] - (bc : b * a < c * a) (a0 : 0 ≤ a) : - b < c := -begin - by_cases a₀ : a = 0, - { exact (lt_irrefl (0 : α) (by simpa only [a₀, mul_zero] using bc)).elim }, - { exact lt_of_mul_lt_mul_right' bc ((ne.symm a₀).le_iff_lt.mp a0) } -end - -lemma pos_of_mul_pos_right [mul_pos_reflect_lt α] (h : 0 < a * b) (hb : 0 ≤ b) : - 0 < a := -lt_of_mul_lt_mul_right'' ((zero_mul b).symm ▸ h : 0 * b < a * b) hb - -lemma pos_iff_pos_of_mul_pos [pos_mul_reflect_lt α] [mul_pos_reflect_lt α] (hab : 0 < a * b) : - 0 < a ↔ 0 < b := -⟨pos_of_mul_pos_left hab ∘ le_of_lt, pos_of_mul_pos_right hab ∘ le_of_lt⟩ - -end partial_order - -section linear_order -variables [linear_order α] - -lemma pos_and_pos_or_neg_and_neg_of_mul_pos [pos_mul_mono α] [mul_pos_mono α] - (hab : 0 < a * b) : - (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) := -begin - rcases lt_trichotomy 0 a with ha | rfl | ha, - { refine or.inl ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩, - exact mul_nonpos_of_nonneg_of_nonpos ha.le hb }, - { rw [zero_mul] at hab, exact hab.false.elim }, - { refine or.inr ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩, - exact mul_nonpos_of_nonpos_of_nonneg ha.le hb } -end - -lemma neg_of_mul_pos_left [pos_mul_mono α] [mul_pos_mono α] - (h : 0 < a * b) (ha : a ≤ 0) : - b < 0 := -((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.1.not_le ha).2 - -lemma neg_of_mul_pos_right [pos_mul_mono α] [mul_pos_mono α] - (h : 0 < a * b) (ha : b ≤ 0) : - a < 0 := -((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.2.not_le ha).1 - -lemma neg_iff_neg_of_mul_pos [pos_mul_mono α] [mul_pos_mono α] - (hab : 0 < a * b) : - a < 0 ↔ b < 0 := -⟨neg_of_mul_pos_left hab ∘ le_of_lt, neg_of_mul_pos_right hab ∘ le_of_lt⟩ - -lemma left.neg_of_mul_neg_left [pos_mul_mono α] - (h : a * b < 0) (h1 : 0 ≤ a) : - b < 0 := -lt_of_not_ge (assume h2 : b ≥ 0, (left.mul_nonneg h1 h2).not_lt h) - -lemma right.neg_of_mul_neg_left [mul_pos_mono α] - (h : a * b < 0) (h1 : 0 ≤ a) : - b < 0 := -lt_of_not_ge (assume h2 : b ≥ 0, (right.mul_nonneg h1 h2).not_lt h) - -lemma left.neg_of_mul_neg_right [pos_mul_mono α] - (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 := -lt_of_not_ge (assume h2 : a ≥ 0, (left.mul_nonneg h2 h1).not_lt h) - -lemma right.neg_of_mul_neg_right [mul_pos_mono α] - (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 := -lt_of_not_ge (assume h2 : a ≥ 0, (right.mul_nonneg h2 h1).not_lt h) - -end linear_order - -end mul_zero_class - -section mul_one_class -variables [mul_one_class α] [has_zero α] - -section preorder -variables [preorder α] - --- Lemmas in the form of `a ≤ a * b ↔ 1 ≤ b` and `a * b ≤ a ↔ b ≤ 1`, --- which assume left covariance. - -@[simp] -lemma le_mul_iff_one_le_right - [pos_mul_mono α] [pos_mul_mono_rev α] - (a0 : 0 < a) : - a ≤ a * b ↔ 1 ≤ b := -iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a0) - -@[simp] -lemma lt_mul_iff_one_lt_right - [pos_mul_strict_mono α] [pos_mul_reflect_lt α] - (a0 : 0 < a) : - a < a * b ↔ 1 < b := -iff.trans (by rw [mul_one]) (mul_lt_mul_iff_left a0) - -@[simp] -lemma mul_le_iff_le_one_right - [pos_mul_mono α] [pos_mul_mono_rev α] - (a0 : 0 < a) : - a * b ≤ a ↔ b ≤ 1 := -iff.trans (by rw [mul_one]) (mul_le_mul_iff_left a0) - -@[simp] -lemma mul_lt_iff_lt_one_right - [pos_mul_strict_mono α] [pos_mul_reflect_lt α] - (a0 : 0 < a) : - a * b < a ↔ b < 1 := -iff.trans (by rw [mul_one]) (mul_lt_mul_iff_left a0) - --- Lemmas in the form of `a ≤ b * a ↔ 1 ≤ b` and `a * b ≤ b ↔ a ≤ 1`, --- which assume right covariance. - -@[simp] -lemma le_mul_iff_one_le_left - [mul_pos_mono α] [mul_pos_mono_rev α] - (a0 : 0 < a) : - a ≤ b * a ↔ 1 ≤ b := -iff.trans (by rw [one_mul]) (mul_le_mul_iff_right a0) - -@[simp] -lemma lt_mul_iff_one_lt_left - [mul_pos_strict_mono α] [mul_pos_reflect_lt α] - (a0 : 0 < a) : - a < b * a ↔ 1 < b := -iff.trans (by rw [one_mul]) (mul_lt_mul_iff_right a0) - -@[simp] -lemma mul_le_iff_le_one_left - [mul_pos_mono α] [mul_pos_mono_rev α] - (b0 : 0 < b) : - a * b ≤ b ↔ a ≤ 1 := -iff.trans (by rw [one_mul]) (mul_le_mul_iff_right b0) - -@[simp] -lemma mul_lt_iff_lt_one_left - [mul_pos_strict_mono α] [mul_pos_reflect_lt α] - (b0 : 0 < b) : - a * b < b ↔ a < 1 := -iff.trans (by rw [one_mul]) (mul_lt_mul_iff_right b0) - --- Lemmas in the form of `b ≤ c → a ≤ 1 → 0 < b → b * a ≤ c`, --- which assume left covariance. - --- proven with `b0 : 0 ≤ b` as `mul_le_of_le_of_le_one'` -lemma mul_le_of_le_of_le_one [pos_mul_mono α] - (bc : b ≤ c) (ha : a ≤ 1) (b0 : 0 < b) : b * a ≤ c := -calc b * a ≤ b * 1 : mul_le_mul_left' ha b0 - ... = b : mul_one b - ... ≤ c : bc - -lemma mul_lt_of_le_of_lt_one [pos_mul_strict_mono α] - (bc : b ≤ c) (ha : a < 1) (b0 : 0 < b) : b * a < c := -calc b * a < b * 1 : mul_lt_mul_left' ha b0 - ... = b : mul_one b - ... ≤ c : bc - -lemma mul_lt_of_lt_of_le_one [pos_mul_mono α] - (bc : b < c) (ha : a ≤ 1) (b0 : 0 < b) : b * a < c := -calc b * a ≤ b * 1 : mul_le_mul_left' ha b0 - ... = b : mul_one b - ... < c : bc - -lemma mul_lt_of_lt_of_lt_one [pos_mul_strict_mono α] - (bc : b < c) (ha : a < 1) (b0 : 0 < b) : b * a < c := -calc b * a < b * 1 : mul_lt_mul_left' ha b0 - ... = b : mul_one b - ... < c : bc - -/-- Assumes left covariance. -/ -lemma left.mul_le_one_of_le_of_le [pos_mul_mono α] - (ha : a ≤ 1) (hb : b ≤ 1) (a0 : 0 < a) : a * b ≤ 1 := -mul_le_of_le_of_le_one ha hb a0 - -/-- Assumes left covariance. -/ -lemma left.mul_lt_one_of_le_of_lt [pos_mul_strict_mono α] - (ha : a ≤ 1) (hb : b < 1) (a0 : 0 < a) : a * b < 1 := -mul_lt_of_le_of_lt_one ha hb a0 - -/-- Assumes left covariance. -/ -lemma left.mul_lt_one_of_lt_of_le [pos_mul_mono α] - (ha : a < 1) (hb : b ≤ 1) (a0 : 0 < a) : a * b < 1 := -mul_lt_of_lt_of_le_one ha hb a0 - -/-- Assumes left covariance. -/ -lemma left.mul_lt_one_of_lt_of_lt [pos_mul_strict_mono α] - (ha : a < 1) (hb : b < 1) (a0 : 0 < a) : a * b < 1 := -mul_lt_of_lt_of_lt_one ha hb a0 - --- Lemmas in the form of `b ≤ c → 1 ≤ a → 0 < c → b ≤ c * a`, --- which assume left covariance. - --- proven with `c0 : 0 ≤ c` as `le_mul_of_le_of_one_le'` -lemma le_mul_of_le_of_one_le [pos_mul_mono α] - (bc : b ≤ c) (ha : 1 ≤ a) (c0 : 0 < c) : b ≤ c * a := -calc b ≤ c : bc - ... = c * 1 : (mul_one c).symm - ... ≤ c * a : mul_le_mul_left' ha c0 - -lemma lt_mul_of_le_of_one_lt [pos_mul_strict_mono α] - (bc : b ≤ c) (ha : 1 < a) (c0 : 0 < c) : b < c * a := -calc b ≤ c : bc - ... = c * 1 : (mul_one c).symm - ... < c * a : mul_lt_mul_left' ha c0 - -lemma lt_mul_of_lt_of_one_le [pos_mul_mono α] - (bc : b < c) (ha : 1 ≤ a) (c0 : 0 < c) : b < c * a := -calc b < c : bc - ... = c * 1 : (mul_one c).symm - ... ≤ c * a : mul_le_mul_left' ha c0 - -lemma lt_mul_of_lt_of_one_lt [pos_mul_strict_mono α] - (bc : b < c) (ha : 1 < a) (c0 : 0 < c) : b < c * a := -calc b < c : bc - ... = c * 1 : (mul_one _).symm - ... < c * a : mul_lt_mul_left' ha c0 - -/-- Assumes left covariance. -/ -lemma left.one_le_mul_of_le_of_le [pos_mul_mono α] - (ha : 1 ≤ a) (hb : 1 ≤ b) (a0 : 0 < a) : 1 ≤ a * b := -le_mul_of_le_of_one_le ha hb a0 - -/-- Assumes left covariance. -/ -lemma left.one_lt_mul_of_le_of_lt [pos_mul_strict_mono α] - (ha : 1 ≤ a) (hb : 1 < b) (a0 : 0 < a) : 1 < a * b := -lt_mul_of_le_of_one_lt ha hb a0 - -/-- Assumes left covariance. -/ -lemma left.one_lt_mul_of_lt_of_le [pos_mul_mono α] - (ha : 1 < a) (hb : 1 ≤ b) (a0 : 0 < a) : 1 < a * b := -lt_mul_of_lt_of_one_le ha hb a0 - -/-- Assumes left covariance. -/ -lemma left.one_lt_mul_of_lt_of_lt [pos_mul_strict_mono α] - (ha : 1 < a) (hb : 1 < b) (a0 : 0 < a) : 1 < a * b := -lt_mul_of_lt_of_one_lt ha hb a0 - --- Lemmas in the form of `a ≤ 1 → b ≤ c → 0 < b → a * b ≤ c`, --- which assume right covariance. - --- proven with `b0 : 0 ≤ b` as `mul_le_of_le_one_of_le'` -lemma mul_le_of_le_one_of_le [mul_pos_mono α] - (ha : a ≤ 1) (bc : b ≤ c) (b0 : 0 < b) : a * b ≤ c := -calc a * b ≤ 1 * b : mul_le_mul_right' ha b0 - ... = b : one_mul b - ... ≤ c : bc - -lemma mul_lt_of_lt_one_of_le [mul_pos_strict_mono α] - (ha : a < 1) (bc : b ≤ c) (b0 : 0 < b) : a * b < c := -calc a * b < 1 * b : mul_lt_mul_right' ha b0 - ... = b : one_mul b - ... ≤ c : bc - -lemma mul_lt_of_le_one_of_lt [mul_pos_mono α] - (ha : a ≤ 1) (hb : b < c) (b0 : 0 < b) : a * b < c := -calc a * b ≤ 1 * b : mul_le_mul_right' ha b0 - ... = b : one_mul b - ... < c : hb - -lemma mul_lt_of_lt_one_of_lt [mul_pos_strict_mono α] - (ha : a < 1) (bc : b < c) (b0 : 0 < b) : a * b < c := -calc a * b < 1 * b : mul_lt_mul_right' ha b0 - ... = b : one_mul b - ... < c : bc - -/-- Assumes right covariance. -/ -lemma right.mul_le_one_of_le_of_le [mul_pos_mono α] - (ha : a ≤ 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b ≤ 1 := -mul_le_of_le_one_of_le ha hb b0 - -/-- Assumes right covariance. -/ -lemma right.mul_lt_one_of_lt_of_le [mul_pos_strict_mono α] - (ha : a < 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b < 1 := -mul_lt_of_lt_one_of_le ha hb b0 - -/-- Assumes right covariance. -/ -lemma right.mul_lt_one_of_le_of_lt [mul_pos_mono α] - (ha : a ≤ 1) (hb : b < 1) (b0 : 0 < b) : a * b < 1 := -mul_lt_of_le_one_of_lt ha hb b0 - -/-- Assumes right covariance. -/ -lemma right.mul_lt_one_of_lt_of_lt [mul_pos_strict_mono α] - (ha : a < 1) (hb : b < 1) (b0 : 0 < b) : a * b < 1 := -mul_lt_of_lt_one_of_lt ha hb b0 - --- Lemmas in the form of `1 ≤ a → b ≤ c → 0 < c → b ≤ a * c`, --- which assume right covariance. - --- proven with `c0 : 0 ≤ c` as `le_mul_of_one_le_of_le'` -lemma le_mul_of_one_le_of_le [mul_pos_mono α] - (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 < c) : b ≤ a * c := -calc b ≤ c : bc - ... = 1 * c : (one_mul c).symm - ... ≤ a * c : mul_le_mul_right' ha c0 - -lemma lt_mul_of_one_lt_of_le [mul_pos_strict_mono α] - (ha : 1 < a) (bc : b ≤ c) (c0 : 0 < c) : b < a * c := -calc b ≤ c : bc - ... = 1 * c : (one_mul c).symm - ... < a * c : mul_lt_mul_right' ha c0 - -lemma lt_mul_of_one_le_of_lt [mul_pos_mono α] - (ha : 1 ≤ a) (bc : b < c) (c0 : 0 < c) : b < a * c := -calc b < c : bc - ... = 1 * c : (one_mul c).symm - ... ≤ a * c : mul_le_mul_right' ha c0 - -lemma lt_mul_of_one_lt_of_lt [mul_pos_strict_mono α] - (ha : 1 < a) (bc : b < c) (c0 : 0 < c) : b < a * c := -calc b < c : bc - ... = 1 * c : (one_mul c).symm - ... < a * c : mul_lt_mul_right' ha c0 - -/-- Assumes right covariance. -/ -lemma right.one_le_mul_of_le_of_le [mul_pos_mono α] - (ha : 1 ≤ a) (hb : 1 ≤ b) (b0 : 0 < b) : 1 ≤ a * b := -le_mul_of_one_le_of_le ha hb b0 - -/-- Assumes right covariance. -/ -lemma right.one_lt_mul_of_lt_of_le [mul_pos_strict_mono α] - (ha : 1 < a) (hb : 1 ≤ b) (b0 : 0 < b) : 1 < a * b := -lt_mul_of_one_lt_of_le ha hb b0 - -/-- Assumes right covariance. -/ -lemma right.one_lt_mul_of_le_of_lt [mul_pos_mono α] - (ha : 1 ≤ a) (hb : 1 < b) (b0 : 0 < b) : 1 < a * b := -lt_mul_of_one_le_of_lt ha hb b0 - -/-- Assumes right covariance. -/ -lemma right.one_lt_mul_of_lt_of_lt [mul_pos_strict_mono α] - (ha : 1 < a) (hb : 1 < b) (b0 : 0 < b) : 1 < a * b := -lt_mul_of_one_lt_of_lt ha hb b0 - --- proven with `a0 : 0 ≤ a` as `mul_le_of_le_one_right'` -lemma mul_le_of_le_one_right [pos_mul_mono α] (h : b ≤ 1) (a0 : 0 < a) : - a * b ≤ a := -mul_le_of_le_of_le_one le_rfl h a0 - --- proven with `a0 : 0 ≤ a` as `le_mul_of_one_le_right'` -lemma le_mul_of_one_le_right [pos_mul_mono α] (h : 1 ≤ b) (a0 : 0 < a) : - a ≤ a * b := -le_mul_of_le_of_one_le le_rfl h a0 - --- proven with `b0 : 0 ≤ b` as `mul_le_of_le_one_left'` -lemma mul_le_of_le_one_left [mul_pos_mono α] (h : a ≤ 1) (b0 : 0 < b) : - a * b ≤ b := -mul_le_of_le_one_of_le h le_rfl b0 - --- proven with `b0 : 0 ≤ b` as `le_mul_of_one_le_left'` -lemma le_mul_of_one_le_left [mul_pos_mono α] (h : 1 ≤ a) (b0 : 0 < b) : - b ≤ a * b := -le_mul_of_one_le_of_le h le_rfl b0 - --- proven with `a0 : 0 ≤ a` as `le_of_mul_le_of_one_le_left'` -lemma le_of_mul_le_of_one_le_left [pos_mul_mono α] - (h : a * b ≤ c) (hle : 1 ≤ b) (a0 : 0 < a) : - a ≤ c := -(le_mul_of_one_le_right hle a0).trans h - -lemma lt_of_mul_lt_of_one_le_left [pos_mul_mono α] - (h : a * b < c) (hle : 1 ≤ b) (a0 : 0 < a) : - a < c := -(le_mul_of_one_le_right hle a0).trans_lt h - --- proven with `b0 : 0 ≤ b` as `le_of_le_mul_of_le_one_left'` -lemma le_of_le_mul_of_le_one_left [pos_mul_mono α] - (h : a ≤ b * c) (hle : c ≤ 1) (b0 : 0 < b) : - a ≤ b := -h.trans (mul_le_of_le_one_right hle b0) - -lemma lt_of_lt_mul_of_le_one_left [pos_mul_mono α] - (h : a < b * c) (hle : c ≤ 1) (b0 : 0 < b) : - a < b := -h.trans_le (mul_le_of_le_one_right hle b0) - --- proven with `b0 : 0 ≤ b` as `le_of_mul_le_of_one_le_right'` -lemma le_of_mul_le_of_one_le_right [mul_pos_mono α] - (h : a * b ≤ c) (hle : 1 ≤ a) (b0 : 0 < b) : - b ≤ c := -(le_mul_of_one_le_left hle b0).trans h - -lemma lt_of_mul_lt_of_one_le_right [mul_pos_mono α] - (h : a * b < c) (hle : 1 ≤ a) (b0 : 0 < b) : - b < c := -(le_mul_of_one_le_left hle b0).trans_lt h - --- proven with `c0 : 0 ≤ b` as `le_of_le_mul_of_le_one_right'` -lemma le_of_le_mul_of_le_one_right [mul_pos_mono α] - (h : a ≤ b * c) (hle : b ≤ 1) (c0 : 0 < c) : - a ≤ c := -h.trans (mul_le_of_le_one_left hle c0) - -lemma lt_of_lt_mul_of_le_one_right [mul_pos_mono α] - (h : a < b * c) (hle : b ≤ 1) (c0 : 0 < c) : - a < c := -h.trans_le (mul_le_of_le_one_left hle c0) - -end preorder - -section linear_order -variables [linear_order α] - --- proven with `a0 : 0 ≤ a` as `exists_square_le'` -lemma exists_square_le [pos_mul_strict_mono α] - (a0 : 0 < a) : ∃ (b : α), b * b ≤ a := -begin - by_cases h : a < 1, - { use a, - have : a*a < a*1, - exact mul_lt_mul_left' h a0, - rw mul_one at this, - exact le_of_lt this }, - { use 1, - push_neg at h, - rwa mul_one } -end - -end linear_order - -end mul_one_class - -section mul_zero_one_class -variables [mul_zero_one_class α] - -section partial_order -variables [partial_order α] - -lemma mul_le_of_le_of_le_one' [pos_mul_mono α] - (bc : b ≤ c) (ha : a ≤ 1) (b0 : 0 ≤ b) : b * a ≤ c := -b0.lt_or_eq.elim (mul_le_of_le_of_le_one bc ha) (λ h, by rw [← h, zero_mul]; exact b0.trans bc) - -/-- Assumes left covariance. -/ -lemma left.mul_le_one_of_le_of_le' [pos_mul_mono α] - (ha : a ≤ 1) (hb : b ≤ 1) (a0 : 0 ≤ a) : a * b ≤ 1 := -mul_le_of_le_of_le_one' ha hb a0 - -lemma le_mul_of_le_of_one_le' [pos_mul_mono α] - (bc : b ≤ c) (ha : 1 ≤ a) (c0 : 0 ≤ c) : b ≤ c * a := -c0.lt_or_eq.elim (le_mul_of_le_of_one_le bc ha) (λ h, by rw [← h, zero_mul] at *; exact bc) - -/-- Assumes left covariance. -/ -lemma left.one_le_mul_of_le_of_le' [pos_mul_mono α] - (ha : 1 ≤ a) (hb : 1 ≤ b) (a0 : 0 ≤ a) : 1 ≤ a * b := -le_mul_of_le_of_one_le' ha hb a0 - -lemma mul_le_of_le_one_of_le' [mul_pos_mono α] - (ha : a ≤ 1) (bc : b ≤ c) (b0 : 0 ≤ b) : a * b ≤ c := -b0.lt_or_eq.elim (mul_le_of_le_one_of_le ha bc) (λ h, by rw [← h, mul_zero] at *; exact bc) - -/-- Assumes right covariance. -/ -lemma right.mul_le_one_of_le_of_le' [mul_pos_mono α] - (ha : a ≤ 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b ≤ 1 := -mul_le_of_le_one_of_le ha hb b0 - -lemma le_mul_of_one_le_of_le' [mul_pos_mono α] - (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 ≤ c) : b ≤ a * c := -c0.lt_or_eq.elim (le_mul_of_one_le_of_le ha bc) (λ h, by rw [← h, mul_zero] at *; exact bc) - -/-- Assumes right covariance. -/ -lemma right.one_le_mul_of_le_of_le' [mul_pos_mono α] - (ha : 1 ≤ a) (hb : 1 ≤ b) (b0 : 0 ≤ b) : 1 ≤ a * b := -le_mul_of_one_le_of_le' ha hb b0 - -lemma mul_le_of_le_one_right' [pos_mul_mono α] (h : b ≤ 1) (a0 : 0 ≤ a) : - a * b ≤ a := -mul_le_of_le_of_le_one' le_rfl h a0 - -lemma le_mul_of_one_le_right' [pos_mul_mono α] (h : 1 ≤ b) (a0 : 0 ≤ a) : - a ≤ a * b := -le_mul_of_le_of_one_le' le_rfl h a0 - -lemma mul_le_of_le_one_left' [mul_pos_mono α] (h : a ≤ 1) (b0 : 0 ≤ b) : - a * b ≤ b := -mul_le_of_le_one_of_le' h le_rfl b0 - -lemma le_mul_of_one_le_left' [mul_pos_mono α] (h : 1 ≤ a) (b0 : 0 ≤ b) : - b ≤ a * b := -le_mul_of_one_le_of_le' h le_rfl b0 - -lemma le_of_mul_le_of_one_le_left' [pos_mul_mono α] - (h : a * b ≤ c) (hle : 1 ≤ b) (a0 : 0 ≤ a) : - a ≤ c := -a0.lt_or_eq.elim (le_of_mul_le_of_one_le_left h hle) - (λ ha, by simpa only [← ha, zero_mul] using h) - -lemma le_of_le_mul_of_le_one_left' [pos_mul_mono α] - (h : a ≤ b * c) (hle : c ≤ 1) (b0 : 0 ≤ b) : - a ≤ b := -b0.lt_or_eq.elim (le_of_le_mul_of_le_one_left h hle) - (λ hb, by simpa only [← hb, zero_mul] using h) - -lemma le_of_mul_le_of_one_le_right' [mul_pos_mono α] - (h : a * b ≤ c) (hle : 1 ≤ a) (b0 : 0 ≤ b) : - b ≤ c := -b0.lt_or_eq.elim (le_of_mul_le_of_one_le_right h hle) - (λ ha, by simpa only [← ha, mul_zero] using h) - -lemma le_of_le_mul_of_le_one_right' [mul_pos_mono α] - (h : a ≤ b * c) (hle : b ≤ 1) (c0 : 0 ≤ c) : - a ≤ c := -c0.lt_or_eq.elim (le_of_le_mul_of_le_one_right h hle) - (λ ha, by simpa only [← ha, mul_zero] using h) - -end partial_order - -section linear_order -variables [linear_order α] - -lemma exists_square_le' [pos_mul_strict_mono α] - (a0 : 0 ≤ a) : ∃ (b : α), b * b ≤ a := -a0.lt_or_eq.elim exists_square_le (λ h, by rw [← h]; exact ⟨0, by simp⟩) - -end linear_order - -end mul_zero_one_class - -end zero_lt diff --git a/src/algebra/order/nonneg.lean b/src/algebra/order/nonneg.lean deleted file mode 100644 index 0d8d5d15c6267..0000000000000 --- a/src/algebra/order/nonneg.lean +++ /dev/null @@ -1,328 +0,0 @@ -/- -Copyright (c) 2021 Floris van Doorn. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Floris van Doorn --/ -import algebra.order.archimedean -import algebra.order.floor -import algebra.order.sub -import algebra.order.with_zero -import order.lattice_intervals -import order.complete_lattice_intervals - -/-! -# The type of nonnegative elements - -This file defines instances and prove some properties about the nonnegative elements -`{x : α // 0 ≤ x}` of an arbitrary type `α`. - -Currently we only state instances and states some `simp`/`norm_cast` lemmas. - -When `α` is `ℝ`, this will give us some properties about `ℝ≥0`. - -## Main declarations - -* `{x : α // 0 ≤ x}` is a `canonically_linear_ordered_add_monoid` if `α` is a `linear_ordered_ring`. -* `{x : α // 0 ≤ x}` is a `linear_ordered_comm_group_with_zero` if `α` is a `linear_ordered_field`. - -## Implementation Notes - -Instead of `{x : α // 0 ≤ x}` we could also use `set.Ici (0 : α)`, which is definitionally equal. -However, using the explicit subtype has a big advantage: when writing and element explicitly -with a proof of nonnegativity as `⟨x, hx⟩`, the `hx` is expected to have type `0 ≤ x`. If we would -use `Ici 0`, then the type is expected to be `x ∈ Ici 0`. Although these types are definitionally -equal, this often confuses the elaborator. Similar problems arise when doing cases on an element. - -The disadvantage is that we have to duplicate some instances about `set.Ici` to this subtype. --/ - -open set - -variables {α : Type*} - -namespace nonneg - -/-- This instance uses data fields from `subtype.partial_order` to help type-class inference. -The `set.Ici` data fields are definitionally equal, but that requires unfolding semireducible -definitions, so type-class inference won't see this. -/ -instance order_bot [preorder α] {a : α} : order_bot {x : α // a ≤ x} := -{ ..set.Ici.order_bot } - -lemma bot_eq [preorder α] {a : α} : (⊥ : {x : α // a ≤ x}) = ⟨a, le_rfl⟩ := rfl - -instance no_max_order [partial_order α] [no_max_order α] {a : α} : no_max_order {x : α // a ≤ x} := -set.Ici.no_max_order - -instance semilattice_inf [semilattice_inf α] {a : α} : semilattice_inf {x : α // a ≤ x} := -set.Ici.semilattice_inf - -instance densely_ordered [preorder α] [densely_ordered α] {a : α} : - densely_ordered {x : α // a ≤ x} := -show densely_ordered (Ici a), from set.densely_ordered - -/-- If `Sup ∅ ≤ a` then `{x : α // a ≤ x}` is a `conditionally_complete_linear_order`. -/ -@[reducible] -protected noncomputable def conditionally_complete_linear_order - [conditionally_complete_linear_order α] {a : α} : - conditionally_complete_linear_order {x : α // a ≤ x} := -{ .. @ord_connected_subset_conditionally_complete_linear_order α (set.Ici a) _ ⟨⟨a, le_rfl⟩⟩ _ } - -/-- If `Sup ∅ ≤ a` then `{x : α // a ≤ x}` is a `conditionally_complete_linear_order_bot`. - -This instance uses data fields from `subtype.linear_order` to help type-class inference. -The `set.Ici` data fields are definitionally equal, but that requires unfolding semireducible -definitions, so type-class inference won't see this. -/ -@[reducible] -protected noncomputable def conditionally_complete_linear_order_bot - [conditionally_complete_linear_order α] {a : α} (h : Sup ∅ ≤ a) : - conditionally_complete_linear_order_bot {x : α // a ≤ x} := -{ cSup_empty := (function.funext_iff.1 - (@subset_Sup_def α (set.Ici a) _ ⟨⟨a, le_rfl⟩⟩) ∅).trans $ subtype.eq $ - by { rw bot_eq, cases h.lt_or_eq with h2 h2, { simp [h2.not_le] }, simp [h2] }, - ..nonneg.order_bot, - ..nonneg.conditionally_complete_linear_order } - -instance inhabited [preorder α] {a : α} : inhabited {x : α // a ≤ x} := -⟨⟨a, le_rfl⟩⟩ - -instance has_zero [has_zero α] [preorder α] : has_zero {x : α // 0 ≤ x} := -⟨⟨0, le_rfl⟩⟩ - -@[simp, norm_cast] -protected lemma coe_zero [has_zero α] [preorder α] : ((0 : {x : α // 0 ≤ x}) : α) = 0 := rfl - -@[simp] lemma mk_eq_zero [has_zero α] [preorder α] {x : α} (hx : 0 ≤ x) : - (⟨x, hx⟩ : {x : α // 0 ≤ x}) = 0 ↔ x = 0 := -subtype.ext_iff - -instance has_add [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] : - has_add {x : α // 0 ≤ x} := -⟨λ x y, ⟨x + y, add_nonneg x.2 y.2⟩⟩ - -@[simp] lemma mk_add_mk [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] {x y : α} - (hx : 0 ≤ x) (hy : 0 ≤ y) : (⟨x, hx⟩ : {x : α // 0 ≤ x}) + ⟨y, hy⟩ = ⟨x + y, add_nonneg hx hy⟩ := -rfl - -@[simp, norm_cast] -protected lemma coe_add [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] - (a b : {x : α // 0 ≤ x}) : ((a + b : {x : α // 0 ≤ x}) : α) = a + b := rfl - -instance has_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] : - has_scalar ℕ {x : α // 0 ≤ x} := -⟨λ n x, ⟨n • x, nsmul_nonneg x.prop n⟩⟩ - -@[simp] lemma nsmul_mk [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] (n : ℕ) - {x : α} (hx : 0 ≤ x) : (n • ⟨x, hx⟩ : {x : α // 0 ≤ x}) = ⟨n • x, nsmul_nonneg hx n⟩ := -rfl - -@[simp, norm_cast] -protected lemma coe_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] - (n : ℕ) (a : {x : α // 0 ≤ x}) : ((n • a : {x : α // 0 ≤ x}) : α) = n • a := rfl - -instance ordered_add_comm_monoid [ordered_add_comm_monoid α] : - ordered_add_comm_monoid {x : α // 0 ≤ x} := -subtype.coe_injective.ordered_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) - -instance linear_ordered_add_comm_monoid [linear_ordered_add_comm_monoid α] : - linear_ordered_add_comm_monoid {x : α // 0 ≤ x} := -subtype.coe_injective.linear_ordered_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) - -instance ordered_cancel_add_comm_monoid [ordered_cancel_add_comm_monoid α] : - ordered_cancel_add_comm_monoid {x : α // 0 ≤ x} := -subtype.coe_injective.ordered_cancel_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) - -instance linear_ordered_cancel_add_comm_monoid [linear_ordered_cancel_add_comm_monoid α] : - linear_ordered_cancel_add_comm_monoid {x : α // 0 ≤ x} := -subtype.coe_injective.linear_ordered_cancel_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) - -/-- Coercion `{x : α // 0 ≤ x} → α` as a `add_monoid_hom`. -/ -def coe_add_monoid_hom [ordered_add_comm_monoid α] : {x : α // 0 ≤ x} →+ α := -⟨coe, nonneg.coe_zero, nonneg.coe_add⟩ - -@[norm_cast] -lemma nsmul_coe [ordered_add_comm_monoid α] (n : ℕ) (r : {x : α // 0 ≤ x}) : - ↑(n • r) = n • (r : α) := -nonneg.coe_add_monoid_hom.map_nsmul _ _ - -instance archimedean [ordered_add_comm_monoid α] [archimedean α] : archimedean {x : α // 0 ≤ x} := -⟨ assume x y pos_y, - let ⟨n, hr⟩ := archimedean.arch (x : α) (pos_y : (0 : α) < y) in - ⟨n, show (x : α) ≤ (n • y : {x : α // 0 ≤ x}), by simp [*, -nsmul_eq_mul, nsmul_coe]⟩ ⟩ - -instance has_one [ordered_semiring α] : has_one {x : α // 0 ≤ x} := -{ one := ⟨1, zero_le_one⟩ } - -@[simp, norm_cast] -protected lemma coe_one [ordered_semiring α] : ((1 : {x : α // 0 ≤ x}) : α) = 1 := rfl - -@[simp] lemma mk_eq_one [ordered_semiring α] {x : α} (hx : 0 ≤ x) : - (⟨x, hx⟩ : {x : α // 0 ≤ x}) = 1 ↔ x = 1 := -subtype.ext_iff - -instance has_mul [ordered_semiring α] : has_mul {x : α // 0 ≤ x} := -{ mul := λ x y, ⟨x * y, mul_nonneg x.2 y.2⟩ } - -@[simp, norm_cast] -protected lemma coe_mul [ordered_semiring α] (a b : {x : α // 0 ≤ x}) : - ((a * b : {x : α // 0 ≤ x}) : α) = a * b := rfl - -@[simp] lemma mk_mul_mk [ordered_semiring α] {x y : α} (hx : 0 ≤ x) (hy : 0 ≤ y) : - (⟨x, hx⟩ : {x : α // 0 ≤ x}) * ⟨y, hy⟩ = ⟨x * y, mul_nonneg hx hy⟩ := -rfl - -instance has_pow [ordered_semiring α] : has_pow {x : α // 0 ≤ x} ℕ := -{ pow := λ x n, ⟨x ^ n, pow_nonneg x.2 n⟩ } - -@[simp, norm_cast] -protected lemma coe_pow [ordered_semiring α] (a : {x : α // 0 ≤ x}) (n : ℕ) : - ((a ^ n: {x : α // 0 ≤ x}) : α) = a ^ n := rfl - -@[simp] lemma mk_pow [ordered_semiring α] {x : α} (hx : 0 ≤ x) (n : ℕ) : - (⟨x, hx⟩ : {x : α // 0 ≤ x}) ^ n = ⟨x ^ n, pow_nonneg hx n⟩ := -rfl - -instance ordered_semiring [ordered_semiring α] : ordered_semiring {x : α // 0 ≤ x} := -subtype.coe_injective.ordered_semiring _ - rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) - -instance ordered_comm_semiring [ordered_comm_semiring α] : ordered_comm_semiring {x : α // 0 ≤ x} := -subtype.coe_injective.ordered_comm_semiring _ - rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) - --- These prevent noncomputable instances being found, as it does not require `linear_order` which --- is frequently non-computable. -instance monoid_with_zero [ordered_semiring α] : monoid_with_zero {x : α // 0 ≤ x} := -by apply_instance - -instance comm_monoid_with_zero [ordered_comm_semiring α] : comm_monoid_with_zero {x : α // 0 ≤ x} := -by apply_instance - -instance nontrivial [linear_ordered_semiring α] : nontrivial {x : α // 0 ≤ x} := -⟨ ⟨0, 1, λ h, zero_ne_one (congr_arg subtype.val h)⟩ ⟩ - -instance linear_ordered_semiring [linear_ordered_semiring α] : - linear_ordered_semiring {x : α // 0 ≤ x} := -subtype.coe_injective.linear_ordered_semiring _ - rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) - -instance linear_ordered_comm_monoid_with_zero [linear_ordered_comm_ring α] : - linear_ordered_comm_monoid_with_zero {x : α // 0 ≤ x} := -{ mul_le_mul_left := λ a b h c, mul_le_mul_of_nonneg_left h c.2, - ..nonneg.linear_ordered_semiring, - ..nonneg.ordered_comm_semiring } - -/-- Coercion `{x : α // 0 ≤ x} → α` as a `ring_hom`. -/ -def coe_ring_hom [ordered_semiring α] : {x : α // 0 ≤ x} →+* α := -⟨coe, nonneg.coe_one, nonneg.coe_mul, nonneg.coe_zero, nonneg.coe_add⟩ - -@[simp, norm_cast] -protected lemma coe_nat_cast [ordered_semiring α] (n : ℕ) : ((↑n : {x : α // 0 ≤ x}) : α) = n := -map_nat_cast (coe_ring_hom : {x : α // 0 ≤ x} →+* α) n - -instance has_inv [linear_ordered_field α] : has_inv {x : α // 0 ≤ x} := -{ inv := λ x, ⟨x⁻¹, inv_nonneg.mpr x.2⟩ } - -@[simp, norm_cast] -protected lemma coe_inv [linear_ordered_field α] (a : {x : α // 0 ≤ x}) : - ((a⁻¹ : {x : α // 0 ≤ x}) : α) = a⁻¹ := rfl - -@[simp] lemma inv_mk [linear_ordered_field α] {x : α} (hx : 0 ≤ x) : - (⟨x, hx⟩ : {x : α // 0 ≤ x})⁻¹ = ⟨x⁻¹, inv_nonneg.mpr hx⟩ := -rfl - -instance linear_ordered_comm_group_with_zero [linear_ordered_field α] : - linear_ordered_comm_group_with_zero {x : α // 0 ≤ x} := -{ inv_zero := by { ext, exact inv_zero }, - mul_inv_cancel := by { intros a ha, ext, refine mul_inv_cancel (mt (λ h, _) ha), ext, exact h }, - ..nonneg.nontrivial, - ..nonneg.has_inv, - ..nonneg.linear_ordered_comm_monoid_with_zero } - -instance has_div [linear_ordered_field α] : has_div {x : α // 0 ≤ x} := -{ div := λ x y, ⟨x / y, div_nonneg x.2 y.2⟩ } - -@[simp, norm_cast] -protected lemma coe_div [linear_ordered_field α] (a b : {x : α // 0 ≤ x}) : - ((a / b : {x : α // 0 ≤ x}) : α) = a / b := rfl - -@[simp] lemma mk_div_mk [linear_ordered_field α] {x y : α} (hx : 0 ≤ x) (hy : 0 ≤ y) : - (⟨x, hx⟩ : {x : α // 0 ≤ x}) / ⟨y, hy⟩ = ⟨x / y, div_nonneg hx hy⟩ := -rfl - -instance canonically_ordered_add_monoid [ordered_ring α] : - canonically_ordered_add_monoid {x : α // 0 ≤ x} := -{ le_iff_exists_add := λ ⟨a, ha⟩ ⟨b, hb⟩, - by simpa only [mk_add_mk, subtype.exists, subtype.mk_eq_mk] using le_iff_exists_nonneg_add a b, - ..nonneg.ordered_add_comm_monoid, - ..nonneg.order_bot } - -instance canonically_ordered_comm_semiring [ordered_comm_ring α] [no_zero_divisors α] : - canonically_ordered_comm_semiring {x : α // 0 ≤ x} := -{ eq_zero_or_eq_zero_of_mul_eq_zero := by { rintro ⟨a, ha⟩ ⟨b, hb⟩, simp }, - ..nonneg.canonically_ordered_add_monoid, - ..nonneg.ordered_comm_semiring } - -instance canonically_linear_ordered_add_monoid [linear_ordered_ring α] : - canonically_linear_ordered_add_monoid {x : α // 0 ≤ x} := -{ ..subtype.linear_order _, ..nonneg.canonically_ordered_add_monoid } - -instance floor_semiring [ordered_semiring α] [floor_semiring α] : floor_semiring {r : α // 0 ≤ r} := -{ floor := λ a, ⌊(a : α)⌋₊, - ceil := λ a, ⌈(a : α)⌉₊, - floor_of_neg := λ a ha, floor_semiring.floor_of_neg ha, - gc_floor := λ a n ha, begin - refine (floor_semiring.gc_floor (show 0 ≤ (a : α), from ha)).trans _, - rw [←subtype.coe_le_coe, nonneg.coe_nat_cast] - end, - gc_ceil := λ a n, begin - refine (floor_semiring.gc_ceil (a : α) n).trans _, - rw [←subtype.coe_le_coe, nonneg.coe_nat_cast] - end} - -@[norm_cast] lemma nat_floor_coe [ordered_semiring α] [floor_semiring α] (a : {r : α // 0 ≤ r}) : - ⌊(a : α)⌋₊ = ⌊a⌋₊ := rfl - -@[norm_cast] lemma nat_ceil_coe [ordered_semiring α] [floor_semiring α] (a : {r : α // 0 ≤ r}) : - ⌈(a : α)⌉₊ = ⌈a⌉₊ := rfl - -section linear_order - -variables [has_zero α] [linear_order α] - -/-- The function `a ↦ max a 0` of type `α → {x : α // 0 ≤ x}`. -/ -def to_nonneg (a : α) : {x : α // 0 ≤ x} := -⟨max a 0, le_max_right _ _⟩ - -@[simp] -lemma coe_to_nonneg {a : α} : (to_nonneg a : α) = max a 0 := rfl - -@[simp] -lemma to_nonneg_of_nonneg {a : α} (h : 0 ≤ a) : to_nonneg a = ⟨a, h⟩ := -by simp [to_nonneg, h] - -@[simp] -lemma to_nonneg_coe {a : {x : α // 0 ≤ x}} : to_nonneg (a : α) = a := -by { cases a with a ha, exact to_nonneg_of_nonneg ha } - -@[simp] -lemma to_nonneg_le {a : α} {b : {x : α // 0 ≤ x}} : to_nonneg a ≤ b ↔ a ≤ b := -by { cases b with b hb, simp [to_nonneg, hb] } - -@[simp] -lemma to_nonneg_lt {a : {x : α // 0 ≤ x}} {b : α} : a < to_nonneg b ↔ ↑a < b := -by { cases a with a ha, simp [to_nonneg, ha.not_lt] } - -instance has_sub [has_sub α] : has_sub {x : α // 0 ≤ x} := -⟨λ x y, to_nonneg (x - y)⟩ - -@[simp] lemma mk_sub_mk [has_sub α] {x y : α} - (hx : 0 ≤ x) (hy : 0 ≤ y) : (⟨x, hx⟩ : {x : α // 0 ≤ x}) - ⟨y, hy⟩ = to_nonneg (x - y) := -rfl - -end linear_order - -instance has_ordered_sub [linear_ordered_ring α] : has_ordered_sub {x : α // 0 ≤ x} := -⟨by { rintro ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, simp only [sub_le_iff_le_add, subtype.mk_le_mk, mk_sub_mk, - mk_add_mk, to_nonneg_le, subtype.coe_mk]}⟩ - -end nonneg diff --git a/src/algebra/order/nonneg/field.lean b/src/algebra/order/nonneg/field.lean new file mode 100644 index 0000000000000..4d58ba9ed7e50 --- /dev/null +++ b/src/algebra/order/nonneg/field.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import algebra.order.field.basic +import algebra.order.field.canonical.defs +import algebra.order.field.inj_surj +import algebra.order.nonneg.ring + +/-! +# Semifield structure on the type of nonnegative elements + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines instances and prove some properties about the nonnegative elements +`{x : α // 0 ≤ x}` of an arbitrary type `α`. + +This is used to derive algebraic structures on `ℝ≥0` and `ℚ≥0` automatically. + +## Main declarations + +* `{x : α // 0 ≤ x}` is a `canonically_linear_ordered_semifield` if `α` is a `linear_ordered_field`. +-/ + +open set + +variables {α : Type*} + +namespace nonneg + +section linear_ordered_semifield +variables [linear_ordered_semifield α] {x y : α} + +instance has_inv : has_inv {x : α // 0 ≤ x} := ⟨λ x, ⟨x⁻¹, inv_nonneg.2 x.2⟩⟩ + +@[simp, norm_cast] +protected lemma coe_inv (a : {x : α // 0 ≤ x}) : ((a⁻¹ : {x : α // 0 ≤ x}) : α) = a⁻¹ := rfl + +@[simp] lemma inv_mk (hx : 0 ≤ x) : (⟨x, hx⟩ : {x : α // 0 ≤ x})⁻¹ = ⟨x⁻¹, inv_nonneg.2 hx⟩ := rfl + +instance has_div : has_div {x : α // 0 ≤ x} := ⟨λ x y, ⟨x / y, div_nonneg x.2 y.2⟩⟩ + +@[simp, norm_cast] protected lemma coe_div (a b : {x : α // 0 ≤ x}) : + ((a / b : {x : α // 0 ≤ x}) : α) = a / b := rfl + +@[simp] lemma mk_div_mk (hx : 0 ≤ x) (hy : 0 ≤ y) : + (⟨x, hx⟩ : {x : α // 0 ≤ x}) / ⟨y, hy⟩ = ⟨x / y, div_nonneg hx hy⟩ := rfl + +instance has_zpow : has_pow {x : α // 0 ≤ x} ℤ := ⟨λ a n, ⟨a ^ n, zpow_nonneg a.2 _⟩⟩ + +@[simp, norm_cast] protected lemma coe_zpow (a : {x : α // 0 ≤ x}) (n : ℤ) : + ((a ^ n : {x : α // 0 ≤ x}) : α) = a ^ n := rfl + +@[simp] lemma mk_zpow (hx : 0 ≤ x) (n : ℤ) : + (⟨x, hx⟩ : {x : α // 0 ≤ x}) ^ n = ⟨x ^ n, zpow_nonneg hx n⟩ := rfl + +instance linear_ordered_semifield : linear_ordered_semifield {x : α // 0 ≤ x} := +subtype.coe_injective.linear_ordered_semifield _ nonneg.coe_zero nonneg.coe_one nonneg.coe_add + nonneg.coe_mul nonneg.coe_inv nonneg.coe_div (λ _ _, rfl) nonneg.coe_pow nonneg.coe_zpow + nonneg.coe_nat_cast (λ _ _, rfl) (λ _ _, rfl) + +end linear_ordered_semifield + +instance canonically_linear_ordered_semifield [linear_ordered_field α] : + canonically_linear_ordered_semifield {x : α // 0 ≤ x} := +{ ..nonneg.linear_ordered_semifield, ..nonneg.canonically_ordered_comm_semiring } + +instance linear_ordered_comm_group_with_zero [linear_ordered_field α] : + linear_ordered_comm_group_with_zero {x : α // 0 ≤ x} := +infer_instance + +end nonneg diff --git a/src/algebra/order/nonneg/floor.lean b/src/algebra/order/nonneg/floor.lean new file mode 100644 index 0000000000000..ad01bc8b5c5ff --- /dev/null +++ b/src/algebra/order/nonneg/floor.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import algebra.order.nonneg.ring +import algebra.order.archimedean + +/-! +# Nonnegative elements are archimedean + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines instances and prove some properties about the nonnegative elements +`{x : α // 0 ≤ x}` of an arbitrary type `α`. + +This is used to derive algebraic structures on `ℝ≥0` and `ℚ≥0` automatically. + +## Main declarations + +* `{x : α // 0 ≤ x}` is a `floor_semiring` if `α` is. +-/ + +namespace nonneg +variables {α : Type*} + +instance archimedean [ordered_add_comm_monoid α] [archimedean α] : archimedean {x : α // 0 ≤ x} := +⟨λ x y hy, + let ⟨n, hr⟩ := archimedean.arch (x : α) (hy : (0 : α) < y) in + ⟨n, show (x : α) ≤ (n • y : {x : α // 0 ≤ x}), by simp [*, -nsmul_eq_mul, nsmul_coe]⟩⟩ + +instance floor_semiring [ordered_semiring α] [floor_semiring α] : floor_semiring {r : α // 0 ≤ r} := +{ floor := λ a, ⌊(a : α)⌋₊, + ceil := λ a, ⌈(a : α)⌉₊, + floor_of_neg := λ a ha, floor_semiring.floor_of_neg ha, + gc_floor := λ a n ha, begin + refine (floor_semiring.gc_floor (show 0 ≤ (a : α), from ha)).trans _, + rw [←subtype.coe_le_coe, nonneg.coe_nat_cast] + end, + gc_ceil := λ a n, begin + refine (floor_semiring.gc_ceil (a : α) n).trans _, + rw [←subtype.coe_le_coe, nonneg.coe_nat_cast] + end} + +@[norm_cast] lemma nat_floor_coe [ordered_semiring α] [floor_semiring α] (a : {r : α // 0 ≤ r}) : + ⌊(a : α)⌋₊ = ⌊a⌋₊ := rfl + +@[norm_cast] lemma nat_ceil_coe [ordered_semiring α] [floor_semiring α] (a : {r : α // 0 ≤ r}) : + ⌈(a : α)⌉₊ = ⌈a⌉₊ := rfl + +end nonneg diff --git a/src/algebra/order/nonneg/ring.lean b/src/algebra/order/nonneg/ring.lean new file mode 100644 index 0000000000000..3cd3e4242239c --- /dev/null +++ b/src/algebra/order/nonneg/ring.lean @@ -0,0 +1,305 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import data.nat.cast.basic +import algebra.order.ring.defs +import algebra.order.ring.inj_surj +import algebra.group_power.order +import order.complete_lattice_intervals +import order.lattice_intervals + +/-! +# The type of nonnegative elements + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines instances and prove some properties about the nonnegative elements +`{x : α // 0 ≤ x}` of an arbitrary type `α`. + +Currently we only state instances and states some `simp`/`norm_cast` lemmas. + +When `α` is `ℝ`, this will give us some properties about `ℝ≥0`. + +## Main declarations + +* `{x : α // 0 ≤ x}` is a `canonically_linear_ordered_add_monoid` if `α` is a `linear_ordered_ring`. + +## Implementation Notes + +Instead of `{x : α // 0 ≤ x}` we could also use `set.Ici (0 : α)`, which is definitionally equal. +However, using the explicit subtype has a big advantage: when writing and element explicitly +with a proof of nonnegativity as `⟨x, hx⟩`, the `hx` is expected to have type `0 ≤ x`. If we would +use `Ici 0`, then the type is expected to be `x ∈ Ici 0`. Although these types are definitionally +equal, this often confuses the elaborator. Similar problems arise when doing cases on an element. + +The disadvantage is that we have to duplicate some instances about `set.Ici` to this subtype. +-/ + +open set + +variables {α : Type*} + +namespace nonneg + +/-- This instance uses data fields from `subtype.partial_order` to help type-class inference. +The `set.Ici` data fields are definitionally equal, but that requires unfolding semireducible +definitions, so type-class inference won't see this. -/ +instance order_bot [preorder α] {a : α} : order_bot {x : α // a ≤ x} := +{ ..set.Ici.order_bot } + +lemma bot_eq [preorder α] {a : α} : (⊥ : {x : α // a ≤ x}) = ⟨a, le_rfl⟩ := rfl + +instance no_max_order [partial_order α] [no_max_order α] {a : α} : no_max_order {x : α // a ≤ x} := +set.Ici.no_max_order + +instance semilattice_sup [semilattice_sup α] {a : α} : semilattice_sup {x : α // a ≤ x} := +set.Ici.semilattice_sup + +instance semilattice_inf [semilattice_inf α] {a : α} : semilattice_inf {x : α // a ≤ x} := +set.Ici.semilattice_inf + +instance distrib_lattice [distrib_lattice α] {a : α} : distrib_lattice {x : α // a ≤ x} := +set.Ici.distrib_lattice + +instance densely_ordered [preorder α] [densely_ordered α] {a : α} : + densely_ordered {x : α // a ≤ x} := +show densely_ordered (Ici a), from set.densely_ordered + +/-- If `Sup ∅ ≤ a` then `{x : α // a ≤ x}` is a `conditionally_complete_linear_order`. -/ +@[reducible] +protected noncomputable def conditionally_complete_linear_order + [conditionally_complete_linear_order α] {a : α} : + conditionally_complete_linear_order {x : α // a ≤ x} := +{ .. @ord_connected_subset_conditionally_complete_linear_order α (set.Ici a) _ ⟨⟨a, le_rfl⟩⟩ _ } + +/-- If `Sup ∅ ≤ a` then `{x : α // a ≤ x}` is a `conditionally_complete_linear_order_bot`. + +This instance uses data fields from `subtype.linear_order` to help type-class inference. +The `set.Ici` data fields are definitionally equal, but that requires unfolding semireducible +definitions, so type-class inference won't see this. -/ +@[reducible] +protected noncomputable def conditionally_complete_linear_order_bot + [conditionally_complete_linear_order α] {a : α} (h : Sup ∅ ≤ a) : + conditionally_complete_linear_order_bot {x : α // a ≤ x} := +{ cSup_empty := (function.funext_iff.1 + (@subset_Sup_def α (set.Ici a) _ ⟨⟨a, le_rfl⟩⟩) ∅).trans $ subtype.eq $ + by { rw bot_eq, cases h.lt_or_eq with h2 h2, { simp [h2.not_le] }, simp [h2] }, + ..nonneg.order_bot, + ..nonneg.conditionally_complete_linear_order } + +instance inhabited [preorder α] {a : α} : inhabited {x : α // a ≤ x} := +⟨⟨a, le_rfl⟩⟩ + +instance has_zero [has_zero α] [preorder α] : has_zero {x : α // 0 ≤ x} := +⟨⟨0, le_rfl⟩⟩ + +@[simp, norm_cast] +protected lemma coe_zero [has_zero α] [preorder α] : ((0 : {x : α // 0 ≤ x}) : α) = 0 := rfl + +@[simp] lemma mk_eq_zero [has_zero α] [preorder α] {x : α} (hx : 0 ≤ x) : + (⟨x, hx⟩ : {x : α // 0 ≤ x}) = 0 ↔ x = 0 := +subtype.ext_iff + +instance has_add [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] : + has_add {x : α // 0 ≤ x} := +⟨λ x y, ⟨x + y, add_nonneg x.2 y.2⟩⟩ + +@[simp] lemma mk_add_mk [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] {x y : α} + (hx : 0 ≤ x) (hy : 0 ≤ y) : (⟨x, hx⟩ : {x : α // 0 ≤ x}) + ⟨y, hy⟩ = ⟨x + y, add_nonneg hx hy⟩ := +rfl + +@[simp, norm_cast] +protected lemma coe_add [add_zero_class α] [preorder α] [covariant_class α α (+) (≤)] + (a b : {x : α // 0 ≤ x}) : ((a + b : {x : α // 0 ≤ x}) : α) = a + b := rfl + +instance has_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] : + has_smul ℕ {x : α // 0 ≤ x} := +⟨λ n x, ⟨n • x, nsmul_nonneg x.prop n⟩⟩ + +@[simp] lemma nsmul_mk [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] (n : ℕ) + {x : α} (hx : 0 ≤ x) : (n • ⟨x, hx⟩ : {x : α // 0 ≤ x}) = ⟨n • x, nsmul_nonneg hx n⟩ := +rfl + +@[simp, norm_cast] +protected lemma coe_nsmul [add_monoid α] [preorder α] [covariant_class α α (+) (≤)] + (n : ℕ) (a : {x : α // 0 ≤ x}) : ((n • a : {x : α // 0 ≤ x}) : α) = n • a := rfl + +instance ordered_add_comm_monoid [ordered_add_comm_monoid α] : + ordered_add_comm_monoid {x : α // 0 ≤ x} := +subtype.coe_injective.ordered_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) + +instance linear_ordered_add_comm_monoid [linear_ordered_add_comm_monoid α] : + linear_ordered_add_comm_monoid {x : α // 0 ≤ x} := +subtype.coe_injective.linear_ordered_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) + (λ _ _, rfl) + +instance ordered_cancel_add_comm_monoid [ordered_cancel_add_comm_monoid α] : + ordered_cancel_add_comm_monoid {x : α // 0 ≤ x} := +subtype.coe_injective.ordered_cancel_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) + +instance linear_ordered_cancel_add_comm_monoid [linear_ordered_cancel_add_comm_monoid α] : + linear_ordered_cancel_add_comm_monoid {x : α // 0 ≤ x} := +subtype.coe_injective.linear_ordered_cancel_add_comm_monoid _ rfl (λ x y, rfl) (λ _ _, rfl) + (λ _ _, rfl) (λ _ _, rfl) + +/-- Coercion `{x : α // 0 ≤ x} → α` as a `add_monoid_hom`. -/ +def coe_add_monoid_hom [ordered_add_comm_monoid α] : {x : α // 0 ≤ x} →+ α := +⟨coe, nonneg.coe_zero, nonneg.coe_add⟩ + +@[norm_cast] +lemma nsmul_coe [ordered_add_comm_monoid α] (n : ℕ) (r : {x : α // 0 ≤ x}) : + ↑(n • r) = n • (r : α) := +nonneg.coe_add_monoid_hom.map_nsmul _ _ + +instance has_one [ordered_semiring α] : has_one {x : α // 0 ≤ x} := +{ one := ⟨1, zero_le_one⟩ } + +@[simp, norm_cast] +protected lemma coe_one [ordered_semiring α] : ((1 : {x : α // 0 ≤ x}) : α) = 1 := rfl + +@[simp] lemma mk_eq_one [ordered_semiring α] {x : α} (hx : 0 ≤ x) : + (⟨x, hx⟩ : {x : α // 0 ≤ x}) = 1 ↔ x = 1 := +subtype.ext_iff + +instance has_mul [ordered_semiring α] : has_mul {x : α // 0 ≤ x} := +{ mul := λ x y, ⟨x * y, mul_nonneg x.2 y.2⟩ } + +@[simp, norm_cast] +protected lemma coe_mul [ordered_semiring α] (a b : {x : α // 0 ≤ x}) : + ((a * b : {x : α // 0 ≤ x}) : α) = a * b := rfl + +@[simp] lemma mk_mul_mk [ordered_semiring α] {x y : α} (hx : 0 ≤ x) (hy : 0 ≤ y) : + (⟨x, hx⟩ : {x : α // 0 ≤ x}) * ⟨y, hy⟩ = ⟨x * y, mul_nonneg hx hy⟩ := +rfl + +instance add_monoid_with_one [ordered_semiring α] : add_monoid_with_one {x : α // 0 ≤ x} := +{ nat_cast := λ n, ⟨n, nat.cast_nonneg n⟩, + nat_cast_zero := by simp [nat.cast], + nat_cast_succ := λ _, by simp [nat.cast]; refl, + .. nonneg.has_one, .. nonneg.ordered_add_comm_monoid } + +@[simp, norm_cast] +protected lemma coe_nat_cast [ordered_semiring α] (n : ℕ) : ((↑n : {x : α // 0 ≤ x}) : α) = n := rfl + +@[simp] lemma mk_nat_cast [ordered_semiring α] (n : ℕ) : + (⟨n, n.cast_nonneg⟩ : {x : α // 0 ≤ x}) = n := rfl + +instance has_pow [ordered_semiring α] : has_pow {x : α // 0 ≤ x} ℕ := +{ pow := λ x n, ⟨x ^ n, pow_nonneg x.2 n⟩ } + +@[simp, norm_cast] +protected lemma coe_pow [ordered_semiring α] (a : {x : α // 0 ≤ x}) (n : ℕ) : + (↑(a ^ n) : α) = a ^ n := rfl + +@[simp] lemma mk_pow [ordered_semiring α] {x : α} (hx : 0 ≤ x) (n : ℕ) : + (⟨x, hx⟩ : {x : α // 0 ≤ x}) ^ n = ⟨x ^ n, pow_nonneg hx n⟩ := rfl + +instance ordered_semiring [ordered_semiring α] : ordered_semiring {x : α // 0 ≤ x} := +subtype.coe_injective.ordered_semiring _ + rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) + +instance strict_ordered_semiring [strict_ordered_semiring α] : + strict_ordered_semiring {x : α // 0 ≤ x} := +subtype.coe_injective.strict_ordered_semiring _ + rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) + +instance ordered_comm_semiring [ordered_comm_semiring α] : ordered_comm_semiring {x : α // 0 ≤ x} := +subtype.coe_injective.ordered_comm_semiring _ + rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) + +instance strict_ordered_comm_semiring [strict_ordered_comm_semiring α] : + strict_ordered_comm_semiring {x : α // 0 ≤ x} := +subtype.coe_injective.strict_ordered_comm_semiring _ + rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) + +-- These prevent noncomputable instances being found, as it does not require `linear_order` which +-- is frequently non-computable. +instance monoid_with_zero [ordered_semiring α] : monoid_with_zero {x : α // 0 ≤ x} := +by apply_instance + +instance comm_monoid_with_zero [ordered_comm_semiring α] : comm_monoid_with_zero {x : α // 0 ≤ x} := +by apply_instance + +instance semiring [ordered_semiring α] : semiring {x : α // 0 ≤ x} := infer_instance +instance comm_semiring [ordered_comm_semiring α] : comm_semiring {x : α // 0 ≤ x} := infer_instance + +instance nontrivial [linear_ordered_semiring α] : nontrivial {x : α // 0 ≤ x} := +⟨ ⟨0, 1, λ h, zero_ne_one (congr_arg subtype.val h)⟩ ⟩ + +instance linear_ordered_semiring [linear_ordered_semiring α] : + linear_ordered_semiring {x : α // 0 ≤ x} := +subtype.coe_injective.linear_ordered_semiring _ + rfl rfl (λ x y, rfl) (λ x y, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)(λ _ _, rfl) (λ _ _, rfl) + +instance linear_ordered_comm_monoid_with_zero [linear_ordered_comm_ring α] : + linear_ordered_comm_monoid_with_zero {x : α // 0 ≤ x} := +{ mul_le_mul_left := λ a b h c, mul_le_mul_of_nonneg_left h c.2, + ..nonneg.linear_ordered_semiring, + ..nonneg.ordered_comm_semiring } + +/-- Coercion `{x : α // 0 ≤ x} → α` as a `ring_hom`. -/ +def coe_ring_hom [ordered_semiring α] : {x : α // 0 ≤ x} →+* α := +⟨coe, nonneg.coe_one, nonneg.coe_mul, nonneg.coe_zero, nonneg.coe_add⟩ + +instance canonically_ordered_add_monoid [ordered_ring α] : + canonically_ordered_add_monoid {x : α // 0 ≤ x} := +{ le_self_add := λ a b, le_add_of_nonneg_right b.2, + exists_add_of_le := λ a b h, + ⟨⟨b - a, sub_nonneg_of_le h⟩, subtype.ext (add_sub_cancel'_right _ _).symm⟩, + ..nonneg.ordered_add_comm_monoid, + ..nonneg.order_bot } + +instance canonically_ordered_comm_semiring [ordered_comm_ring α] [no_zero_divisors α] : + canonically_ordered_comm_semiring {x : α // 0 ≤ x} := +{ eq_zero_or_eq_zero_of_mul_eq_zero := by { rintro ⟨a, ha⟩ ⟨b, hb⟩, simp }, + ..nonneg.canonically_ordered_add_monoid, + ..nonneg.ordered_comm_semiring } + +instance canonically_linear_ordered_add_monoid [linear_ordered_ring α] : + canonically_linear_ordered_add_monoid {x : α // 0 ≤ x} := +{ ..subtype.linear_order _, ..nonneg.canonically_ordered_add_monoid } + +section linear_order + +variables [has_zero α] [linear_order α] + +/-- The function `a ↦ max a 0` of type `α → {x : α // 0 ≤ x}`. -/ +def to_nonneg (a : α) : {x : α // 0 ≤ x} := +⟨max a 0, le_max_right _ _⟩ + +@[simp] +lemma coe_to_nonneg {a : α} : (to_nonneg a : α) = max a 0 := rfl + +@[simp] +lemma to_nonneg_of_nonneg {a : α} (h : 0 ≤ a) : to_nonneg a = ⟨a, h⟩ := +by simp [to_nonneg, h] + +@[simp] +lemma to_nonneg_coe {a : {x : α // 0 ≤ x}} : to_nonneg (a : α) = a := +by { cases a with a ha, exact to_nonneg_of_nonneg ha } + +@[simp] +lemma to_nonneg_le {a : α} {b : {x : α // 0 ≤ x}} : to_nonneg a ≤ b ↔ a ≤ b := +by { cases b with b hb, simp [to_nonneg, hb] } + +@[simp] +lemma to_nonneg_lt {a : {x : α // 0 ≤ x}} {b : α} : a < to_nonneg b ↔ ↑a < b := +by { cases a with a ha, simp [to_nonneg, ha.not_lt] } + +instance has_sub [has_sub α] : has_sub {x : α // 0 ≤ x} := +⟨λ x y, to_nonneg (x - y)⟩ + +@[simp] lemma mk_sub_mk [has_sub α] {x y : α} + (hx : 0 ≤ x) (hy : 0 ≤ y) : (⟨x, hx⟩ : {x : α // 0 ≤ x}) - ⟨y, hy⟩ = to_nonneg (x - y) := +rfl + +end linear_order + +instance has_ordered_sub [linear_ordered_ring α] : has_ordered_sub {x : α // 0 ≤ x} := +⟨by { rintro ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, simp only [sub_le_iff_le_add, subtype.mk_le_mk, mk_sub_mk, + mk_add_mk, to_nonneg_le, subtype.coe_mk]}⟩ + +end nonneg diff --git a/src/algebra/order/pi.lean b/src/algebra/order/pi.lean index 58d1edb4f39fa..7c696ad7209e0 100644 --- a/src/algebra/order/pi.lean +++ b/src/algebra/order/pi.lean @@ -3,16 +3,21 @@ Copyright (c) 2018 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon, Patrick Massot -/ -import algebra.group.pi -import algebra.order.group -import tactic.pi_instances +import algebra.order.ring.defs +import algebra.ring.pi +import tactic.positivity + /-! # Pi instances for ordered groups and monoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for ordered group, monoid, and related structures on Pi types. -/ universes u v w +variables {ι α β : Type*} variable {I : Type u} -- The indexing type variable {f : I → Type v} -- The family of types already equipped with instances variables (x y : Π i, f i) (i : I) @@ -28,23 +33,18 @@ instance ordered_comm_monoid {ι : Type*} {Z : ι → Type*} [∀ i, ordered_com ..pi.partial_order, ..pi.comm_monoid, } +@[to_additive] instance {ι : Type*} {α : ι → Type*} [Π i, has_le (α i)] [Π i, has_mul (α i)] + [Π i, has_exists_mul_of_le (α i)] : + has_exists_mul_of_le (Π i, α i) := +⟨λ a b h, ⟨λ i, (exists_mul_of_le $ h i).some, funext $ λ i, (exists_mul_of_le $ h i).some_spec⟩⟩ + /-- The product of a family of canonically ordered monoids is a canonically ordered monoid. -/ @[to_additive "The product of a family of canonically ordered additive monoids is a canonically ordered additive monoid."] instance {ι : Type*} {Z : ι → Type*} [∀ i, canonically_ordered_monoid (Z i)] : canonically_ordered_monoid (Π i, Z i) := -{ le_iff_exists_mul := λ f g, begin - fsplit, - { intro w, - fsplit, - { exact λ i, (le_iff_exists_mul.mp (w i)).some, }, - { ext i, - exact (le_iff_exists_mul.mp (w i)).some_spec, }, }, - { rintro ⟨h, rfl⟩, - exact λ i, le_mul_right le_rfl, }, - end, - ..pi.order_bot, - ..pi.ordered_comm_monoid, } +{ le_self_mul := λ f g i, le_self_mul, + ..pi.order_bot, ..pi.ordered_comm_monoid, ..pi.has_exists_mul_of_le } @[to_additive] instance ordered_cancel_comm_monoid [∀ i, ordered_cancel_comm_monoid $ f i] : @@ -61,4 +61,68 @@ instance ordered_comm_group [∀ i, ordered_comm_group $ f i] : ..pi.comm_group, ..pi.ordered_comm_monoid, } +instance [Π i, ordered_semiring (f i)] : ordered_semiring (Π i, f i) := +{ add_le_add_left := λ a b hab c i, add_le_add_left (hab _) _, + zero_le_one := λ _, zero_le_one, + mul_le_mul_of_nonneg_left := λ a b c hab hc i, mul_le_mul_of_nonneg_left (hab _) $ hc _, + mul_le_mul_of_nonneg_right := λ a b c hab hc i, mul_le_mul_of_nonneg_right (hab _) $ hc _, + ..pi.semiring, ..pi.partial_order } + +instance [Π i, ordered_comm_semiring (f i)] : ordered_comm_semiring (Π i, f i) := +{ ..pi.comm_semiring, ..pi.ordered_semiring } + +instance [Π i, ordered_ring (f i)] : ordered_ring (Π i, f i) := +{ mul_nonneg := λ a b ha hb i, mul_nonneg (ha _) (hb _), + ..pi.ring, ..pi.ordered_semiring } + +instance [Π i, ordered_comm_ring (f i)] : ordered_comm_ring (Π i, f i) := +{ ..pi.comm_ring, ..pi.ordered_ring } + end pi + +namespace function +variables (β) [has_one α] [preorder α] {a : α} + +@[to_additive const_nonneg_of_nonneg] +lemma one_le_const_of_one_le (ha : 1 ≤ a) : 1 ≤ const β a := λ _, ha + +@[to_additive] lemma const_le_one_of_le_one (ha : a ≤ 1) : const β a ≤ 1 := λ _, ha + +variables {β} [nonempty β] + +@[simp, to_additive const_nonneg] +lemma one_le_const : 1 ≤ const β a ↔ 1 ≤ a := @const_le_const _ _ _ _ 1 _ +@[simp, to_additive const_pos] +lemma one_lt_const : 1 < const β a ↔ 1 < a := @const_lt_const _ _ _ _ 1 a +@[simp, to_additive] lemma const_le_one : const β a ≤ 1 ↔ a ≤ 1 := @const_le_const _ _ _ _ _ 1 +@[simp, to_additive] lemma const_lt_one : const β a < 1 ↔ a < 1 := @const_lt_const _ _ _ _ _ 1 + +end function + +namespace tactic +open function positivity +variables (ι) [has_zero α] {a : α} + +private lemma function_const_nonneg_of_pos [preorder α] (ha : 0 < a) : 0 ≤ const ι a := +const_nonneg_of_nonneg _ ha.le + +variables [nonempty ι] + +private lemma function_const_ne_zero : a ≠ 0 → const ι a ≠ 0 := const_ne_zero.2 +private lemma function_const_pos [preorder α] : 0 < a → 0 < const ι a := const_pos.2 + +/-- Extension for the `positivity` tactic: `function.const` is positive/nonnegative/nonzero if its +input is. -/ +@[positivity] +meta def positivity_const : expr → tactic strictness +| `(function.const %%ι %%a) := do + strict_a ← core a, + match strict_a with + | positive p := positive <$> to_expr ``(function_const_pos %%ι %%p) + <|> nonnegative <$> to_expr ``(function_const_nonneg_of_pos %%ι %%p) + | nonnegative p := nonnegative <$> to_expr ``(const_nonneg_of_nonneg %%ι %%p) + | nonzero p := nonzero <$> to_expr ``(function_const_ne_zero %%ι %%p) + end +| e := pp e >>= fail ∘ format.bracket "The expression `" "` is not of the form `function.const ι a`" + +end tactic diff --git a/src/algebra/order/pointwise.lean b/src/algebra/order/pointwise.lean index 1df57f38bd2be..f9e5f6392c716 100644 --- a/src/algebra/order/pointwise.lean +++ b/src/algebra/order/pointwise.lean @@ -1,20 +1,112 @@ /- Copyright (c) 2021 Alex J. Best. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Alex J. Best +Authors: Alex J. Best, Yaël Dillies -/ -import algebra.order.field -import algebra.algebra.basic +import algebra.bounds +import data.set.pointwise.smul /-! # Pointwise operations on ordered algebraic objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas about the effect of pointwise operations on sets with an order structure. +## TODO + +`Sup (s • t) = Sup s • Sup t` and `Inf (s • t) = Inf s • Inf t` hold as well but +`covariant_class` is currently not polymorphic enough to state it. -/ +open function set open_locale pointwise +variables {α : Type*} + +section conditionally_complete_lattice +variables [conditionally_complete_lattice α] + +section has_one +variables [has_one α] + +@[simp, to_additive] lemma cSup_one : Sup (1 : set α) = 1 := cSup_singleton _ +@[simp, to_additive] lemma cInf_one : Inf (1 : set α) = 1 := cInf_singleton _ + +end has_one + +section group +variables [group α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] {s t : set α} + +@[to_additive] lemma cSup_inv (hs₀ : s.nonempty) (hs₁ : bdd_below s) : Sup s⁻¹ = (Inf s)⁻¹ := +by { rw ←image_inv, exact ((order_iso.inv α).map_cInf' hs₀ hs₁).symm } + +@[to_additive] lemma cInf_inv (hs₀ : s.nonempty) (hs₁ : bdd_above s) : Inf s⁻¹ = (Sup s)⁻¹ := +by { rw ←image_inv, exact ((order_iso.inv α).map_cSup' hs₀ hs₁).symm } + +@[to_additive] lemma cSup_mul (hs₀ : s.nonempty) (hs₁ : bdd_above s) (ht₀ : t.nonempty) + (ht₁ : bdd_above t) : + Sup (s * t) = Sup s * Sup t := +cSup_image2_eq_cSup_cSup (λ _, (order_iso.mul_right _).to_galois_connection) + (λ _, (order_iso.mul_left _).to_galois_connection) hs₀ hs₁ ht₀ ht₁ + +@[to_additive] lemma cInf_mul (hs₀ : s.nonempty) (hs₁ : bdd_below s) (ht₀ : t.nonempty) + (ht₁ : bdd_below t) : + Inf (s * t) = Inf s * Inf t := +cInf_image2_eq_cInf_cInf (λ _, (order_iso.mul_right _).symm.to_galois_connection) + (λ _, (order_iso.mul_left _).symm.to_galois_connection) hs₀ hs₁ ht₀ ht₁ + +@[to_additive] lemma cSup_div (hs₀ : s.nonempty) (hs₁ : bdd_above s) (ht₀ : t.nonempty) + (ht₁ : bdd_below t) : + Sup (s / t) = Sup s / Inf t := +by rw [div_eq_mul_inv, cSup_mul hs₀ hs₁ ht₀.inv ht₁.inv, cSup_inv ht₀ ht₁, div_eq_mul_inv] + +@[to_additive] lemma cInf_div (hs₀ : s.nonempty) (hs₁ : bdd_below s) (ht₀ : t.nonempty) + (ht₁ : bdd_above t) : + Inf (s / t) = Inf s / Sup t := +by rw [div_eq_mul_inv, cInf_mul hs₀ hs₁ ht₀.inv ht₁.inv, cInf_inv ht₀ ht₁, div_eq_mul_inv] + +end group +end conditionally_complete_lattice + +section complete_lattice +variables [complete_lattice α] + +section has_one +variables [has_one α] + +@[simp, to_additive] lemma Sup_one : Sup (1 : set α) = 1 := Sup_singleton +@[simp, to_additive] lemma Inf_one : Inf (1 : set α) = 1 := Inf_singleton + +end has_one + +section group +variables [group α] [covariant_class α α (*) (≤)] [covariant_class α α (swap (*)) (≤)] (s t : set α) + +@[to_additive] lemma Sup_inv (s : set α) : Sup s⁻¹ = (Inf s)⁻¹ := +by { rw [←image_inv, Sup_image], exact ((order_iso.inv α).map_Inf _).symm } + +@[to_additive] lemma Inf_inv (s : set α) : Inf s⁻¹ = (Sup s)⁻¹ := +by { rw [←image_inv, Inf_image], exact ((order_iso.inv α).map_Sup _).symm } + +@[to_additive] lemma Sup_mul : Sup (s * t) = Sup s * Sup t := +Sup_image2_eq_Sup_Sup (λ _, (order_iso.mul_right _).to_galois_connection) $ + λ _, (order_iso.mul_left _).to_galois_connection + +@[to_additive] lemma Inf_mul : Inf (s * t) = Inf s * Inf t := +Inf_image2_eq_Inf_Inf (λ _, (order_iso.mul_right _).symm.to_galois_connection) $ + λ _, (order_iso.mul_left _).symm.to_galois_connection + +@[to_additive] lemma Sup_div : Sup (s / t) = Sup s / Inf t := +by simp_rw [div_eq_mul_inv, Sup_mul, Sup_inv] + +@[to_additive] lemma Inf_div : Inf (s / t) = Inf s / Sup t := +by simp_rw [div_eq_mul_inv, Inf_mul, Inf_inv] + +end group +end complete_lattice + namespace linear_ordered_field variables {K : Type*} [linear_ordered_field K] {a b r : K} (hr : 0 < r) @@ -25,7 +117,7 @@ include hr lemma smul_Ioo : r • Ioo a b = Ioo (r • a) (r • b) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Ioo], + simp only [mem_smul_set, smul_eq_mul, mem_Ioo], split, { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split, exact (mul_lt_mul_left hr).mpr a_h_left_left, @@ -39,7 +131,7 @@ end lemma smul_Icc : r • Icc a b = Icc (r • a) (r • b) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Icc], + simp only [mem_smul_set, smul_eq_mul, mem_Icc], split, { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split, exact (mul_le_mul_left hr).mpr a_h_left_left, @@ -53,7 +145,7 @@ end lemma smul_Ico : r • Ico a b = Ico (r • a) (r • b) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Ico], + simp only [mem_smul_set, smul_eq_mul, mem_Ico], split, { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split, exact (mul_le_mul_left hr).mpr a_h_left_left, @@ -67,7 +159,7 @@ end lemma smul_Ioc : r • Ioc a b = Ioc (r • a) (r • b) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Ioc], + simp only [mem_smul_set, smul_eq_mul, mem_Ioc], split, { rintro ⟨a, ⟨a_h_left_left, a_h_left_right⟩, rfl⟩, split, exact (mul_lt_mul_left hr).mpr a_h_left_left, @@ -81,7 +173,7 @@ end lemma smul_Ioi : r • Ioi a = Ioi (r • a) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Ioi], + simp only [mem_smul_set, smul_eq_mul, mem_Ioi], split, { rintro ⟨a_w, a_h_left, rfl⟩, exact (mul_lt_mul_left hr).mpr a_h_left, }, @@ -95,7 +187,7 @@ end lemma smul_Iio : r • Iio a = Iio (r • a) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Iio], + simp only [mem_smul_set, smul_eq_mul, mem_Iio], split, { rintro ⟨a_w, a_h_left, rfl⟩, exact (mul_lt_mul_left hr).mpr a_h_left, }, @@ -109,7 +201,7 @@ end lemma smul_Ici : r • Ici a = Ici (r • a) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Ioi], + simp only [mem_smul_set, smul_eq_mul, mem_Ioi], split, { rintro ⟨a_w, a_h_left, rfl⟩, exact (mul_le_mul_left hr).mpr a_h_left, }, @@ -123,7 +215,7 @@ end lemma smul_Iic : r • Iic a = Iic (r • a) := begin ext x, - simp only [mem_smul_set, algebra.id.smul_eq_mul, mem_Iio], + simp only [mem_smul_set, smul_eq_mul, mem_Iio], split, { rintro ⟨a_w, a_h_left, rfl⟩, exact (mul_le_mul_left hr).mpr a_h_left, }, diff --git a/src/algebra/order/positive/field.lean b/src/algebra/order/positive/field.lean new file mode 100644 index 0000000000000..c5a955471ca01 --- /dev/null +++ b/src/algebra/order/positive/field.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import algebra.order.field.basic +import algebra.order.positive.ring + +/-! +# Algebraic structures on the set of positive numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that the set of positive elements of a linear ordered field is a linear +ordered commutative group. +-/ + +variables {K : Type*} [linear_ordered_field K] + +namespace positive + +instance : has_inv {x : K // 0 < x} := ⟨λ x, ⟨x⁻¹, inv_pos.2 x.2⟩⟩ + +@[simp] lemma coe_inv (x : {x : K // 0 < x}) : ↑x⁻¹ = (x⁻¹ : K) := rfl + +instance : has_pow {x : K // 0 < x} ℤ := +⟨λ x n, ⟨x ^ n, zpow_pos_of_pos x.2 _⟩⟩ + +@[simp] lemma coe_zpow (x : {x : K // 0 < x}) (n : ℤ) : ↑(x ^ n) = (x ^ n : K) := rfl + +instance : linear_ordered_comm_group {x : K // 0 < x} := +{ mul_left_inv := λ a, subtype.ext $ inv_mul_cancel a.2.ne', + .. positive.subtype.has_inv, .. positive.subtype.linear_ordered_cancel_comm_monoid } + +end positive diff --git a/src/algebra/order/positive/ring.lean b/src/algebra/order/positive/ring.lean new file mode 100644 index 0000000000000..32bb2e3103b14 --- /dev/null +++ b/src/algebra/order/positive/ring.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import algebra.order.ring.defs +import algebra.ring.inj_surj + +/-! +# Algebraic structures on the set of positive numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define various instances (`add_semigroup`, `ordered_comm_monoid` etc) on the +type `{x : R // 0 < x}`. In each case we try to require the weakest possible typeclass +assumptions on `R` but possibly, there is a room for improvements. +-/ +open function + +namespace positive + +variables {M R K : Type*} + +section add_basic + +variables [add_monoid M] [preorder M] [covariant_class M M (+) (<)] + +instance : has_add {x : M // 0 < x} := ⟨λ x y, ⟨x + y, add_pos x.2 y.2⟩⟩ + +@[simp, norm_cast] lemma coe_add (x y : {x : M // 0 < x}) : ↑(x + y) = (x + y : M) := rfl + +instance : add_semigroup {x : M // 0 < x} := subtype.coe_injective.add_semigroup _ coe_add + +instance {M : Type*} [add_comm_monoid M] [preorder M] [covariant_class M M (+) (<)] : + add_comm_semigroup {x : M // 0 < x} := +subtype.coe_injective.add_comm_semigroup _ coe_add + +instance {M : Type*} [add_left_cancel_monoid M] [preorder M] [covariant_class M M (+) (<)] : + add_left_cancel_semigroup {x : M // 0 < x} := +subtype.coe_injective.add_left_cancel_semigroup _ coe_add + +instance {M : Type*} [add_right_cancel_monoid M] [preorder M] [covariant_class M M (+) (<)] : + add_right_cancel_semigroup {x : M // 0 < x} := +subtype.coe_injective.add_right_cancel_semigroup _ coe_add + +instance covariant_class_add_lt : covariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (<) := +⟨λ x y z hyz, subtype.coe_lt_coe.1 $ add_lt_add_left hyz _⟩ + +instance covariant_class_swap_add_lt [covariant_class M M (swap (+)) (<)] : + covariant_class {x : M // 0 < x} {x : M // 0 < x} (swap (+)) (<) := +⟨λ x y z hyz, subtype.coe_lt_coe.1 $ add_lt_add_right hyz _⟩ + +instance contravariant_class_add_lt [contravariant_class M M (+) (<)] : + contravariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (<) := +⟨λ x y z h, subtype.coe_lt_coe.1 $ lt_of_add_lt_add_left h⟩ + +instance contravariant_class_swap_add_lt [contravariant_class M M (swap (+)) (<)] : + contravariant_class {x : M // 0 < x} {x : M // 0 < x} (swap (+)) (<) := +⟨λ x y z h, subtype.coe_lt_coe.1 $ lt_of_add_lt_add_right h⟩ + +instance contravariant_class_add_le [contravariant_class M M (+) (≤)] : + contravariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (≤) := +⟨λ x y z h, subtype.coe_le_coe.1 $ le_of_add_le_add_left h⟩ + +instance contravariant_class_swap_add_le [contravariant_class M M (swap (+)) (≤)] : + contravariant_class {x : M // 0 < x} {x : M // 0 < x} (swap (+)) (≤) := +⟨λ x y z h, subtype.coe_le_coe.1 $ le_of_add_le_add_right h⟩ + +end add_basic + +instance covariant_class_add_le [add_monoid M] [partial_order M] [covariant_class M M (+) (<)] : + covariant_class {x : M // 0 < x} {x : M // 0 < x} (+) (≤) := +⟨λ x, strict_mono.monotone $ λ _ _ h, add_lt_add_left h _⟩ + +section mul + +variables [strict_ordered_semiring R] + +instance : has_mul {x : R // 0 < x} := ⟨λ x y, ⟨x * y, mul_pos x.2 y.2⟩⟩ + +@[simp] lemma coe_mul (x y : {x : R // 0 < x}) : ↑(x * y) = (x * y : R) := rfl + +instance : has_pow {x : R // 0 < x} ℕ := ⟨λ x n, ⟨x ^ n, pow_pos x.2 n⟩⟩ + +@[simp] lemma coe_pow (x : {x : R // 0 < x}) (n : ℕ) : ↑(x ^ n) = (x ^ n : R) := rfl + +instance : semigroup {x : R // 0 < x} := subtype.coe_injective.semigroup coe coe_mul + +instance : distrib {x : R // 0 < x} := subtype.coe_injective.distrib _ coe_add coe_mul + +instance [nontrivial R] : has_one {x : R // 0 < x} := ⟨⟨1, one_pos⟩⟩ + +@[simp] lemma coe_one [nontrivial R] : ((1 : {x : R // 0 < x}) : R) = 1 := rfl + +instance [nontrivial R] : monoid {x : R // 0 < x} := +subtype.coe_injective.monoid _ coe_one coe_mul coe_pow + +end mul + +section mul_comm + +instance [strict_ordered_comm_semiring R] [nontrivial R] : ordered_comm_monoid {x : R // 0 < x} := +{ mul_le_mul_left := λ x y hxy c, subtype.coe_le_coe.1 $ mul_le_mul_of_nonneg_left hxy c.2.le, + .. subtype.partial_order _, + .. subtype.coe_injective.comm_monoid (coe : {x : R // 0 < x} → R) coe_one coe_mul coe_pow } + +/-- If `R` is a nontrivial linear ordered commutative semiring, then `{x : R // 0 < x}` is a linear +ordered cancellative commutative monoid. -/ +instance [linear_ordered_comm_semiring R] : linear_ordered_cancel_comm_monoid {x : R // 0 < x} := +{ le_of_mul_le_mul_left := λ a b c h, subtype.coe_le_coe.1 $ (mul_le_mul_left a.2).1 h, + .. subtype.linear_order _, .. positive.subtype.ordered_comm_monoid } + +end mul_comm + +end positive diff --git a/src/algebra/order/rearrangement.lean b/src/algebra/order/rearrangement.lean index 0a76e17ad39d4..9cd2d6d035fda 100644 --- a/src/algebra/order/rearrangement.lean +++ b/src/algebra/order/rearrangement.lean @@ -3,20 +3,34 @@ Copyright (c) 2022 Mantas Bakšys. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mantas Bakšys -/ +import algebra.big_operators.basic import algebra.order.module +import data.prod.lex import group_theory.perm.support -import order.monovary +import order.monotone.monovary import tactic.abel /-! # Rearrangement inequality -This file proves the rearrangement inequality. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the rearrangement inequality and deduces the conditions for equality and strict +inequality. The rearrangement inequality tells you that for two functions `f g : ι → α`, the sum `∑ i, f i * g (σ i)` is maximized over all `σ : perm ι` when `g ∘ σ` monovaries with `f` and minimized when `g ∘ σ` antivaries with `f`. +The inequality also tells you that `∑ i, f i * g (σ i) = ∑ i, f i * g i` if and only if `g ∘ σ` +monovaries with `f` when `g` monovaries with `f`. The above equality also holds if and only if +`g ∘ σ` antivaries with `f` when `g` antivaries with `f`. + +From the above two statements, we deduce that the inequality is strict if and only if `g ∘ σ` does +not monovary with `f` when `g` monovaries with `f`. Analogously, the inequality is strict if and +only if `g ∘ σ` does not antivary with `f` when `g` antivaries with `f`. + ## Implementation notes In fact, we don't need much compatibility between the addition and multiplication of `α`, so we can @@ -29,7 +43,7 @@ The case for `monotone`/`antitone` pairs of functions over a `linear_order` is n file because it is easily deducible from the `monovary` API. -/ -open equiv equiv.perm finset order_dual +open equiv equiv.perm finset function order_dual open_locale big_operators variables {ι α β : Type*} @@ -41,7 +55,7 @@ variables [linear_ordered_ring α] [linear_ordered_add_comm_group β] [module α [ordered_smul α β] {s : finset ι} {σ : perm ι} {f : ι → α} {g : ι → β} /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when -`f` and `g` vary together. Stated by permuting the entries of `g`. -/ +`f` and `g` monovary together. Stated by permuting the entries of `g`. -/ lemma monovary_on.sum_smul_comp_perm_le_sum_smul (hfg : monovary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f i • g (σ i) ≤ ∑ i in s, f i • g i := @@ -65,42 +79,71 @@ begin simp_rw sum_insert has, refine le_trans _ (add_le_add_left hind _), obtain hσa | hσa := eq_or_ne a (σ a), - { rw [←hσa, swap_self, trans_refl] at hτ, - rw [←hσa, hτ] }, + { rw [hτ, ←hσa, swap_self, trans_refl] }, have h1s : σ⁻¹ a ∈ s, { rw [ne.def, ←inv_eq_iff_eq] at hσa, refine mem_of_mem_insert_of_ne (hσ $ λ h, hσa _) hσa, rwa [apply_inv_self, eq_comm] at h }, simp only [← s.sum_erase_add _ h1s, add_comm], rw [← add_assoc, ← add_assoc], - refine add_le_add _ (sum_congr rfl $ λ x hx, _).le, - { simp only [hτ, swap_apply_left, function.comp_app, equiv.coe_trans, apply_inv_self], - suffices : 0 ≤ (f a - f (σ⁻¹ a)) • (g a - g (σ a)), - { rw ← sub_nonneg, - convert this, - simp only [smul_sub, sub_smul], - abel }, - refine smul_nonneg (sub_nonneg_of_le _) (sub_nonneg_of_le _), - { specialize hamax (σ⁻¹ a) h1s, - rw prod.lex.le_iff at hamax, - cases hamax, - { exact hfg (mem_insert_of_mem h1s) (mem_insert_self _ _) hamax }, - { exact hamax.2 } }, - { specialize hamax (σ a) (mem_of_mem_insert_of_ne (hσ $ σ.injective.ne hσa.symm) hσa.symm), - rw prod.lex.le_iff at hamax, - cases hamax, - { exact hamax.le }, - { exact hamax.1.le } } }, - { congr' 2, - rw [eq_comm, hτ], - rw [mem_erase, ne.def, eq_inv_iff_eq] at hx, - refine swap_apply_of_ne_of_ne hx.1 (σ.injective.ne _), + simp only [hτ, swap_apply_left, function.comp_app, equiv.coe_trans, apply_inv_self], + refine add_le_add (smul_add_smul_le_smul_add_smul' _ _) (sum_congr rfl $ λ x hx, _).le, + { specialize hamax (σ⁻¹ a) h1s, + rw prod.lex.le_iff at hamax, + cases hamax, + { exact hfg (mem_insert_of_mem h1s) (mem_insert_self _ _) hamax }, + { exact hamax.2 } }, + { specialize hamax (σ a) (mem_of_mem_insert_of_ne (hσ $ σ.injective.ne hσa.symm) hσa.symm), + rw prod.lex.le_iff at hamax, + cases hamax, + { exact hamax.le }, + { exact hamax.1.le } }, + { rw [mem_erase, ne.def, eq_inv_iff_eq] at hx, + rw swap_apply_of_ne_of_ne hx.1 (σ.injective.ne _), rintro rfl, exact has hx.2 } end +/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary +together. Stated by permuting the entries of `g`. -/ +lemma monovary_on.sum_smul_comp_perm_eq_sum_smul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i • g (σ i) = ∑ i in s, f i • g i ↔ monovary_on f (g ∘ σ) s := +begin + classical, + refine ⟨not_imp_not.1 $ λ h, _, λ h, (hfg.sum_smul_comp_perm_le_sum_smul hσ).antisymm _⟩, + { rw monovary_on at h, + push_neg at h, + obtain ⟨x, hx, y, hy, hgxy, hfxy⟩ := h, + set τ : perm ι := (swap x y).trans σ, + have hτs : {x | τ x ≠ x} ⊆ s, + { refine (set_support_mul_subset σ $ swap x y).trans (set.union_subset hσ $ λ z hz, _), + obtain ⟨_, rfl | rfl⟩ := swap_apply_ne_self_iff.1 hz; assumption }, + refine ((hfg.sum_smul_comp_perm_le_sum_smul hτs).trans_lt' _).ne, + obtain rfl | hxy := eq_or_ne x y, + { cases lt_irrefl _ hfxy }, + simp only [←s.sum_erase_add _ hx, ←(s.erase x).sum_erase_add _ (mem_erase.2 ⟨hxy.symm, hy⟩), + add_assoc, equiv.coe_trans, function.comp_app, swap_apply_right, swap_apply_left], + refine add_lt_add_of_le_of_lt (finset.sum_congr rfl $ λ z hz, _).le + (smul_add_smul_lt_smul_add_smul hfxy hgxy), + simp_rw mem_erase at hz, + rw swap_apply_of_ne_of_ne hz.2.1 hz.1 }, + { convert h.sum_smul_comp_perm_le_sum_smul ((set_support_inv_eq _).subset.trans hσ) using 1, + simp_rw [function.comp_app, apply_inv_self] } +end + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/ +lemma monovary_on.sum_smul_comp_perm_lt_sum_smul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i • g (σ i) < ∑ i in s, f i • g i ↔ ¬ monovary_on f (g ∘ σ) s := +by simp [←hfg.sum_smul_comp_perm_eq_sum_smul_iff hσ, + lt_iff_le_and_ne, hfg.sum_smul_comp_perm_le_sum_smul hσ] + /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when -`f` and `g` vary together. Stated by permuting the entries of `f`. -/ +`f` and `g` monovary together. Stated by permuting the entries of `f`. -/ lemma monovary_on.sum_comp_perm_smul_le_sum_smul (hfg : monovary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f (σ i) • g i ≤ ∑ i in s, f i • g i := @@ -110,13 +153,58 @@ begin exact σ.sum_comp' s (λ i j, f i • g j) hσ, end +/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary +together. Stated by permuting the entries of `f`. -/ +lemma monovary_on.sum_comp_perm_smul_eq_sum_smul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f (σ i) • g i = ∑ i in s, f i • g i ↔ monovary_on (f ∘ σ) g s := +begin + have hσinv : {x | σ⁻¹ x ≠ x} ⊆ s := (set_support_inv_eq _).subset.trans hσ, + refine (iff.trans _ $ hfg.sum_smul_comp_perm_eq_sum_smul_iff hσinv).trans ⟨λ h, _, λ h, _⟩, + { simpa only [σ.sum_comp' s (λ i j, f i • g j) hσ] }, + { convert h.comp_right σ, + { rw [comp.assoc, inv_def, symm_comp_self, comp.right_id] }, + { rw [σ.eq_preimage_iff_image_eq, set.image_perm hσ] } }, + { convert h.comp_right σ.symm, + { rw [comp.assoc, self_comp_symm, comp.right_id] }, + { rw σ.symm.eq_preimage_iff_image_eq, + exact set.image_perm hσinv } } +end + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f ∘ σ` and `g` do not monovary together. Stated by permuting the entries of `f`. -/ +lemma monovary_on.sum_comp_perm_smul_lt_sum_smul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f (σ i) • g i < ∑ i in s, f i • g i ↔ ¬ monovary_on (f ∘ σ) g s := +by simp [←hfg.sum_comp_perm_smul_eq_sum_smul_iff hσ, + lt_iff_le_and_ne, hfg.sum_comp_perm_smul_le_sum_smul hσ] + /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when -`f` and `g` antivary together. Stated by permuting the entries of `g`.-/ +`f` and `g` antivary together. Stated by permuting the entries of `g`. -/ lemma antivary_on.sum_smul_le_sum_smul_comp_perm (hfg : antivary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f i • g i ≤ ∑ i in s, f i • g (σ i) := hfg.dual_right.sum_smul_comp_perm_le_sum_smul hσ +/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and +`g`, which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary +together. Stated by permuting the entries of `g`. -/ +lemma antivary_on.sum_smul_eq_sum_smul_comp_perm_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i • g (σ i) = ∑ i in s, f i • g i ↔ antivary_on f (g ∘ σ) s := +(hfg.dual_right.sum_smul_comp_perm_eq_sum_smul_iff hσ).trans monovary_on_to_dual_right + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/ +lemma antivary_on.sum_smul_lt_sum_smul_comp_perm_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i • g i < ∑ i in s, f i • g (σ i) ↔ ¬ antivary_on f (g ∘ σ) s := +by simp [←hfg.sum_smul_eq_sum_smul_comp_perm_iff hσ, lt_iff_le_and_ne, eq_comm, + hfg.sum_smul_le_sum_smul_comp_perm hσ] + /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when `f` and `g` antivary together. Stated by permuting the entries of `f`. -/ lemma antivary_on.sum_smul_le_sum_comp_perm_smul (hfg : antivary_on f g s) @@ -124,32 +212,105 @@ lemma antivary_on.sum_smul_le_sum_comp_perm_smul (hfg : antivary_on f g s) ∑ i in s, f i • g i ≤ ∑ i in s, f (σ i) • g i := hfg.dual_right.sum_comp_perm_smul_le_sum_smul hσ +/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and +`g`, which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary +together. Stated by permuting the entries of `f`. -/ +lemma antivary_on.sum_smul_eq_sum_comp_perm_smul_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f (σ i) • g i = ∑ i in s, f i • g i ↔ antivary_on (f ∘ σ) g s := +(hfg.dual_right.sum_comp_perm_smul_eq_sum_smul_iff hσ).trans monovary_on_to_dual_right + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/ +lemma antivary_on.sum_smul_lt_sum_comp_perm_smul_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i • g i < ∑ i in s, f (σ i) • g i ↔ ¬ antivary_on (f ∘ σ) g s := +by simp [←hfg.sum_smul_eq_sum_comp_perm_smul_iff hσ, eq_comm, lt_iff_le_and_ne, + hfg.sum_smul_le_sum_comp_perm_smul hσ] + variables [fintype ι] /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when -`f` and `g` vary together. Stated by permuting the entries of `g`. -/ +`f` and `g` monovary together. Stated by permuting the entries of `g`. -/ lemma monovary.sum_smul_comp_perm_le_sum_smul (hfg : monovary f g) : ∑ i, f i • g (σ i) ≤ ∑ i, f i • g i := (hfg.monovary_on _).sum_smul_comp_perm_le_sum_smul $ λ i _, mem_univ _ +/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary +together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_smul_comp_perm_eq_sum_smul_iff (hfg : monovary f g) : + ∑ i, f i • g (σ i) = ∑ i, f i • g i ↔ monovary f (g ∘ σ) := +by simp [(hfg.monovary_on _).sum_smul_comp_perm_eq_sum_smul_iff (λ i _, mem_univ _)] + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_smul_comp_perm_lt_sum_smul_iff (hfg : monovary f g) : + ∑ i, f i • g (σ i) < ∑ i, f i • g i ↔ ¬ monovary f (g ∘ σ) := +by simp [(hfg.monovary_on _).sum_smul_comp_perm_lt_sum_smul_iff (λ i _, mem_univ _)] + /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is maximized when -`f` and `g` vary together. Stated by permuting the entries of `f`. -/ +`f` and `g` monovary together. Stated by permuting the entries of `f`. -/ lemma monovary.sum_comp_perm_smul_le_sum_smul (hfg : monovary f g) : ∑ i, f (σ i) • g i ≤ ∑ i, f i • g i := (hfg.monovary_on _).sum_comp_perm_smul_le_sum_smul $ λ i _, mem_univ _ +/-- **Equality case of Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary +together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_comp_perm_smul_eq_sum_smul_iff (hfg : monovary f g) : + ∑ i, f (σ i) • g i = ∑ i, f i • g i ↔ monovary (f ∘ σ) g := +by simp [(hfg.monovary_on _).sum_comp_perm_smul_eq_sum_smul_iff (λ i _, mem_univ _)] + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_comp_perm_smul_lt_sum_smul_iff (hfg : monovary f g) : + ∑ i, f (σ i) • g i < ∑ i, f i • g i ↔ ¬ monovary (f ∘ σ) g := +by simp [(hfg.monovary_on _).sum_comp_perm_smul_lt_sum_smul_iff (λ i _, mem_univ _)] + /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when -`f` and `g` antivary together. Stated by permuting the entries of `g`.-/ +`f` and `g` antivary together. Stated by permuting the entries of `g`. -/ lemma antivary.sum_smul_le_sum_smul_comp_perm (hfg : antivary f g) : ∑ i, f i • g i ≤ ∑ i, f i • g (σ i) := (hfg.antivary_on _).sum_smul_le_sum_smul_comp_perm $ λ i _, mem_univ _ +/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and +`g`, which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary +together. Stated by permuting the entries of `g`. -/ +lemma antivary.sum_smul_eq_sum_smul_comp_perm_iff (hfg : antivary f g) : + ∑ i, f i • g (σ i) = ∑ i, f i • g i ↔ antivary f (g ∘ σ) := +by simp [(hfg.antivary_on _).sum_smul_eq_sum_smul_comp_perm_iff (λ i _, mem_univ _)] + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/ +lemma antivary.sum_smul_lt_sum_smul_comp_perm_iff (hfg : antivary f g) : + ∑ i, f i • g i < ∑ i, f i • g (σ i) ↔ ¬ antivary f (g ∘ σ) := +by simp [(hfg.antivary_on _).sum_smul_lt_sum_smul_comp_perm_iff (λ i _, mem_univ _)] + /-- **Rearrangement Inequality**: Pointwise scalar multiplication of `f` and `g` is minimized when `f` and `g` antivary together. Stated by permuting the entries of `f`. -/ lemma antivary.sum_smul_le_sum_comp_perm_smul (hfg : antivary f g) : ∑ i, f i • g i ≤ ∑ i, f (σ i) • g i := (hfg.antivary_on _).sum_smul_le_sum_comp_perm_smul $ λ i _, mem_univ _ +/-- **Equality case of the Rearrangement Inequality**: Pointwise scalar multiplication of `f` and +`g`, which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary +together. Stated by permuting the entries of `f`. -/ +lemma antivary.sum_smul_eq_sum_comp_perm_smul_iff (hfg : antivary f g) : + ∑ i, f (σ i) • g i = ∑ i, f i • g i ↔ antivary (f ∘ σ) g := +by simp [(hfg.antivary_on _).sum_smul_eq_sum_comp_perm_smul_iff (λ i _, mem_univ _)] + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/ +lemma antivary.sum_smul_lt_sum_comp_perm_smul_iff (hfg : antivary f g) : + ∑ i, f i • g i < ∑ i, f (σ i) • g i ↔ ¬ antivary (f ∘ σ) g := +by simp [(hfg.antivary_on _).sum_smul_lt_sum_comp_perm_smul_iff (λ i _, mem_univ _)] + end smul /-! @@ -162,53 +323,173 @@ section mul variables [linear_ordered_ring α] {s : finset ι} {σ : perm ι} {f g : ι → α} /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and -`g` vary together. Stated by permuting the entries of `g`. -/ +`g` monovary together. Stated by permuting the entries of `g`. -/ lemma monovary_on.sum_mul_comp_perm_le_sum_mul (hfg : monovary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f i * g (σ i) ≤ ∑ i in s, f i * g i := hfg.sum_smul_comp_perm_le_sum_smul hσ +/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary +together. Stated by permuting the entries of `g`. -/ +lemma monovary_on.sum_mul_comp_perm_eq_sum_mul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i * g (σ i) = ∑ i in s, f i * g i ↔ monovary_on f (g ∘ σ) s := +hfg.sum_smul_comp_perm_eq_sum_smul_iff hσ + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise scalar multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/ +lemma monovary_on.sum_mul_comp_perm_lt_sum_mul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i • g (σ i) < ∑ i in s, f i • g i ↔ ¬ monovary_on f (g ∘ σ) s := +hfg.sum_smul_comp_perm_lt_sum_smul_iff hσ + /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and -`g` vary together. Stated by permuting the entries of `f`. -/ +`g` monovary together. Stated by permuting the entries of `f`. -/ lemma monovary_on.sum_comp_perm_mul_le_sum_mul (hfg : monovary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f (σ i) * g i ≤ ∑ i in s, f i * g i := hfg.sum_comp_perm_smul_le_sum_smul hσ +/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary +together. Stated by permuting the entries of `f`. -/ +lemma monovary_on.sum_comp_perm_mul_eq_sum_mul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f (σ i) * g i = ∑ i in s, f i * g i ↔ monovary_on (f ∘ σ) g s := +hfg.sum_comp_perm_smul_eq_sum_smul_iff hσ + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f ∘ σ` and `g` do not monovary together. Stated by permuting the entries of `f`. -/ +lemma monovary_on.sum_comp_perm_mul_lt_sum_mul_iff (hfg : monovary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f (σ i) * g i < ∑ i in s, f i * g i ↔ ¬ monovary_on (f ∘ σ) g s := +hfg.sum_comp_perm_smul_lt_sum_smul_iff hσ + /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and -`g` antivary together. Stated by permuting the entries of `g`.-/ +`g` antivary together. Stated by permuting the entries of `g`. -/ lemma antivary_on.sum_mul_le_sum_mul_comp_perm (hfg : antivary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f i * g i ≤ ∑ i in s, f i * g (σ i) := hfg.sum_smul_le_sum_smul_comp_perm hσ +/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary +together. Stated by permuting the entries of `g`. -/ +lemma antivary_on.sum_mul_eq_sum_mul_comp_perm_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i * g (σ i) = ∑ i in s, f i * g i ↔ antivary_on f (g ∘ σ) s := +hfg.sum_smul_eq_sum_smul_comp_perm_iff hσ + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/ +lemma antivary_on.sum_mul_lt_sum_mul_comp_perm_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i * g i < ∑ i in s, f i * g (σ i) ↔ ¬ antivary_on f (g ∘ σ) s := +hfg.sum_smul_lt_sum_smul_comp_perm_iff hσ + /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and `g` antivary together. Stated by permuting the entries of `f`. -/ lemma antivary_on.sum_mul_le_sum_comp_perm_mul (hfg : antivary_on f g s) (hσ : {x | σ x ≠ x} ⊆ s) : ∑ i in s, f i * g i ≤ ∑ i in s, f (σ i) * g i := hfg.sum_smul_le_sum_comp_perm_smul hσ +/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary +together. Stated by permuting the entries of `f`. -/ +lemma antivary_on.sum_mul_eq_sum_comp_perm_mul_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f (σ i) * g i = ∑ i in s, f i * g i ↔ antivary_on (f ∘ σ) g s := +hfg.sum_smul_eq_sum_comp_perm_smul_iff hσ + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/ +lemma antivary_on.sum_mul_lt_sum_comp_perm_mul_iff (hfg : antivary_on f g s) + (hσ : {x | σ x ≠ x} ⊆ s) : + ∑ i in s, f i * g i < ∑ i in s, f (σ i) * g i ↔ ¬ antivary_on (f ∘ σ) g s := +hfg.sum_smul_lt_sum_comp_perm_smul_iff hσ + variables [fintype ι] /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and -`g` vary together. Stated by permuting the entries of `g`. -/ +`g` monovary together. Stated by permuting the entries of `g`. -/ lemma monovary.sum_mul_comp_perm_le_sum_mul (hfg : monovary f g) : ∑ i, f i * g (σ i) ≤ ∑ i, f i * g i := hfg.sum_smul_comp_perm_le_sum_smul +/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` monovary +together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_mul_comp_perm_eq_sum_mul_iff (hfg : monovary f g) : + ∑ i, f i * g (σ i) = ∑ i, f i * g i ↔ monovary f (g ∘ σ) := +hfg.sum_smul_comp_perm_eq_sum_smul_iff + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_mul_comp_perm_lt_sum_mul_iff (hfg : monovary f g) : + ∑ i, f i * g (σ i) < ∑ i, f i * g i ↔ ¬ monovary f (g ∘ σ) := +hfg.sum_smul_comp_perm_lt_sum_smul_iff + /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is maximized when `f` and -`g` vary together. Stated by permuting the entries of `f`. -/ +`g` monovary together. Stated by permuting the entries of `f`. -/ lemma monovary.sum_comp_perm_mul_le_sum_mul (hfg : monovary f g) : ∑ i, f (σ i) * g i ≤ ∑ i, f i * g i := hfg.sum_comp_perm_smul_le_sum_smul +/-- **Equality case of Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which monovary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` monovary +together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_comp_perm_mul_eq_sum_mul_iff (hfg : monovary f g) : + ∑ i, f (σ i) * g i = ∑ i, f i * g i ↔ monovary (f ∘ σ) g := +hfg.sum_comp_perm_smul_eq_sum_smul_iff + +/-- **Strict inequality case of Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which monovary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not monovary together. Stated by permuting the entries of `g`. -/ +lemma monovary.sum_comp_perm_mul_lt_sum_mul_iff (hfg : monovary f g) : + ∑ i, f (σ i) * g i < ∑ i, f i * g i ↔ ¬ monovary (f ∘ σ) g := +hfg.sum_comp_perm_smul_lt_sum_smul_iff + /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and -`g` antivary together. Stated by permuting the entries of `g`.-/ +`g` antivary together. Stated by permuting the entries of `g`. -/ lemma antivary.sum_mul_le_sum_mul_comp_perm (hfg : antivary f g) : ∑ i, f i * g i ≤ ∑ i, f i * g (σ i) := hfg.sum_smul_le_sum_smul_comp_perm +/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which antivary together, is unchanged by a permutation if and only if `f` and `g ∘ σ` antivary +together. Stated by permuting the entries of `g`. -/ +lemma antivary.sum_mul_eq_sum_mul_comp_perm_iff (hfg : antivary f g) : + ∑ i, f i * g (σ i) = ∑ i, f i * g i ↔ antivary f (g ∘ σ) := +hfg.sum_smul_eq_sum_smul_comp_perm_iff + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f` and `g ∘ σ` do not antivary together. Stated by permuting the entries of `g`. -/ +lemma antivary.sum_mul_lt_sum_mul_comp_perm_iff (hfg : antivary f g) : + ∑ i, f i • g i < ∑ i, f i • g (σ i) ↔ ¬ antivary f (g ∘ σ) := +hfg.sum_smul_lt_sum_smul_comp_perm_iff + /-- **Rearrangement Inequality**: Pointwise multiplication of `f` and `g` is minimized when `f` and `g` antivary together. Stated by permuting the entries of `f`. -/ lemma antivary.sum_mul_le_sum_comp_perm_mul (hfg : antivary f g) : ∑ i, f i * g i ≤ ∑ i, f (σ i) * g i := hfg.sum_smul_le_sum_comp_perm_smul +/-- **Equality case of the Rearrangement Inequality**: Pointwise multiplication of `f` and `g`, +which antivary together, is unchanged by a permutation if and only if `f ∘ σ` and `g` antivary +together. Stated by permuting the entries of `f`. -/ +lemma antivary.sum_mul_eq_sum_comp_perm_mul_iff (hfg : antivary f g) : + ∑ i, f (σ i) * g i = ∑ i, f i * g i ↔ antivary (f ∘ σ) g := +hfg.sum_smul_eq_sum_comp_perm_smul_iff + +/-- **Strict inequality case of the Rearrangement Inequality**: Pointwise multiplication of +`f` and `g`, which antivary together, is strictly decreased by a permutation if and only if +`f ∘ σ` and `g` do not antivary together. Stated by permuting the entries of `f`. -/ +lemma antivary.sum_mul_lt_sum_comp_perm_mul_iff (hfg : antivary f g) : + ∑ i, f i * g i < ∑ i, f (σ i) * g i ↔ ¬ antivary (f ∘ σ) g := +hfg.sum_smul_lt_sum_comp_perm_smul_iff + end mul diff --git a/src/algebra/order/ring.lean b/src/algebra/order/ring.lean deleted file mode 100644 index 5e964988d52e9..0000000000000 --- a/src/algebra/order/ring.lean +++ /dev/null @@ -1,1725 +0,0 @@ -/- -Copyright (c) 2016 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro --/ -import algebra.order.group -import algebra.order.sub -import data.set.intervals.basic - -/-! -# Ordered rings and semirings - -This file develops the basics of ordered (semi)rings. - -Each typeclass here comprises -* an algebraic class (`semiring`, `comm_semiring`, `ring`, `comm_ring`) -* an order class (`partial_order`, `linear_order`) -* assumptions on how both interact ((strict) monotonicity, canonicity) - -For short, -* "`+` respects `≤`" means "monotonicity of addition" -* "`*` respects `<`" means "strict monotonicity of multiplication by a positive number". - -## Typeclasses - -* `ordered_semiring`: Semiring with a partial order such that `+` respects `≤` and `*` respects `<`. -* `ordered_comm_semiring`: Commutative semiring with a partial order such that `+` respects `≤` and - `*` respects `<`. -* `ordered_ring`: Ring with a partial order such that `+` respects `≤` and `*` respects `<`. -* `ordered_comm_ring`: Commutative ring with a partial order such that `+` respects `≤` and - `*` respects `<`. -* `linear_ordered_semiring`: Semiring with a linear order such that `+` respects `≤` and - `*` respects `<`. -* `linear_ordered_ring`: Ring with a linear order such that `+` respects `≤` and `*` respects `<`. -* `linear_ordered_comm_ring`: Commutative ring with a linear order such that `+` respects `≤` and - `*` respects `<`. -* `canonically_ordered_comm_semiring`: Commutative semiring with a partial order such that `+` - respects `≤`, `*` respects `<`, and `a ≤ b ↔ ∃ c, b = a + c`. - -and some typeclasses to define ordered rings by specifying their nonegative elements: -* `nonneg_ring`: To define `ordered_ring`s. -* `linear_nonneg_ring`: To define `linear_ordered_ring`s. - -## Hierarchy - -The hardest part of proving order lemmas might be to figure out the correct generality and its -corresponding typeclass. Here's an attempt at demystifying it. For each typeclass, we list its -immediate predecessors and what conditions are added to each of them. - -* `ordered_semiring` - - `ordered_cancel_add_comm_monoid` & multiplication & `*` respects `<` - - `semiring` & partial order structure & `+` respects `≤` & `*` respects `<` -* `ordered_comm_semiring` - - `ordered_semiring` & commutativity of multiplication - - `comm_semiring` & partial order structure & `+` respects `≤` & `*` respects `<` -* `ordered_ring` - - `ordered_semiring` & additive inverses - - `ordered_add_comm_group` & multiplication & `*` respects `<` - - `ring` & partial order structure & `+` respects `≤` & `*` respects `<` -* `ordered_comm_ring` - - `ordered_ring` & commutativity of multiplication - - `ordered_comm_semiring` & additive inverses - - `comm_ring` & partial order structure & `+` respects `≤` & `*` respects `<` -* `linear_ordered_semiring` - - `ordered_semiring` & totality of the order & nontriviality - - `linear_ordered_add_comm_monoid` & multiplication & nontriviality & `*` respects `<` -* `linear_ordered_ring` - - `ordered_ring` & totality of the order & nontriviality - - `linear_ordered_semiring` & additive inverses - - `linear_ordered_add_comm_group` & multiplication & `*` respects `<` - - `domain` & linear order structure -* `linear_ordered_comm_ring` - - `ordered_comm_ring` & totality of the order & nontriviality - - `linear_ordered_ring` & commutativity of multiplication - - `is_domain` & linear order structure -* `canonically_ordered_comm_semiring` - - `canonically_ordered_add_monoid` & multiplication & `*` respects `<` & no zero divisors - - `comm_semiring` & `a ≤ b ↔ ∃ c, b = a + c` & no zero divisors - -## TODO - -We're still missing some typeclasses, like -* `linear_ordered_comm_semiring` -* `canonically_ordered_semiring` -They have yet to come up in practice. --/ - -set_option old_structure_cmd true - -universe u -variable {α : Type u} - -namespace order_dual - -/-! Note that `order_dual` does not satisfy any of the ordered ring typeclasses due to the -`zero_le_one` field. -/ - -instance [h : distrib α] : distrib αᵒᵈ := h -instance [has_mul α] [h : has_distrib_neg α] : has_distrib_neg αᵒᵈ := h -instance [h : non_unital_non_assoc_semiring α] : non_unital_non_assoc_semiring αᵒᵈ := h -instance [h : non_unital_semiring α] : non_unital_semiring αᵒᵈ := h -instance [h : non_assoc_semiring α] : non_assoc_semiring αᵒᵈ := h -instance [h : semiring α] : semiring αᵒᵈ := h -instance [h : non_unital_comm_semiring α] : non_unital_comm_semiring αᵒᵈ := h -instance [h : comm_semiring α] : comm_semiring αᵒᵈ := h -instance [h : non_unital_non_assoc_ring α] : non_unital_non_assoc_ring αᵒᵈ := h -instance [h : non_unital_ring α] : non_unital_ring αᵒᵈ := h -instance [h : non_assoc_ring α] : non_assoc_ring αᵒᵈ := h -instance [h : ring α] : ring αᵒᵈ := h -instance [h : non_unital_comm_ring α] : non_unital_comm_ring αᵒᵈ := h -instance [h : comm_ring α] : comm_ring αᵒᵈ := h - -end order_dual - -lemma add_one_le_two_mul [has_le α] [semiring α] [covariant_class α α (+) (≤)] - {a : α} (a1 : 1 ≤ a) : - a + 1 ≤ 2 * a := -calc a + 1 ≤ a + a : add_le_add_left a1 a - ... = 2 * a : (two_mul _).symm - -/-- An `ordered_semiring α` is a semiring `α` with a partial order such that -addition is monotone and multiplication by a positive number is strictly monotone. -/ -@[protect_proj] -class ordered_semiring (α : Type u) extends semiring α, ordered_cancel_add_comm_monoid α := -(zero_le_one : 0 ≤ (1 : α)) -(mul_lt_mul_of_pos_left : ∀ a b c : α, a < b → 0 < c → c * a < c * b) -(mul_lt_mul_of_pos_right : ∀ a b c : α, a < b → 0 < c → a * c < b * c) - -section ordered_semiring -variables [ordered_semiring α] {a b c d : α} - -@[simp] lemma zero_le_one : 0 ≤ (1:α) := -ordered_semiring.zero_le_one - -lemma zero_le_two : 0 ≤ (2:α) := -add_nonneg zero_le_one zero_le_one - -lemma one_le_two : 1 ≤ (2:α) := -calc (1:α) = 0 + 1 : (zero_add _).symm - ... ≤ 1 + 1 : add_le_add_right zero_le_one _ - -section nontrivial - -variables [nontrivial α] - -@[simp] lemma zero_lt_one : 0 < (1 : α) := -lt_of_le_of_ne zero_le_one zero_ne_one - -lemma zero_lt_two : 0 < (2:α) := add_pos zero_lt_one zero_lt_one - -@[field_simps] lemma two_ne_zero : (2:α) ≠ 0 := -zero_lt_two.ne' - -lemma one_lt_two : 1 < (2:α) := -calc (2:α) = 1+1 : one_add_one_eq_two - ... > 1+0 : add_lt_add_left zero_lt_one _ - ... = 1 : add_zero 1 - -lemma zero_lt_three : 0 < (3:α) := add_pos zero_lt_two zero_lt_one - -@[field_simps] lemma three_ne_zero : (3:α) ≠ 0 := -zero_lt_three.ne' - -lemma zero_lt_four : 0 < (4:α) := add_pos zero_lt_two zero_lt_two - -@[field_simps] lemma four_ne_zero : (4:α) ≠ 0 := -zero_lt_four.ne' - -alias zero_lt_one ← one_pos -alias zero_lt_two ← two_pos -alias zero_lt_three ← three_pos -alias zero_lt_four ← four_pos - -end nontrivial - -lemma mul_lt_mul_of_pos_left (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := -ordered_semiring.mul_lt_mul_of_pos_left a b c h₁ h₂ - -lemma mul_lt_mul_of_pos_right (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := -ordered_semiring.mul_lt_mul_of_pos_right a b c h₁ h₂ - -lemma mul_lt_of_lt_one_left (hb : 0 < b) (ha : a < 1) : a * b < b := -(mul_lt_mul_of_pos_right ha hb).trans_le (one_mul _).le - -lemma mul_lt_of_lt_one_right (ha : 0 < a) (hb : b < 1) : a * b < a := -(mul_lt_mul_of_pos_left hb ha).trans_le (mul_one _).le - --- See Note [decidable namespace] -protected lemma decidable.mul_le_mul_of_nonneg_left [@decidable_rel α (≤)] - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := -begin - by_cases ba : b ≤ a, { simp [ba.antisymm h₁] }, - by_cases c0 : c ≤ 0, { simp [c0.antisymm h₂] }, - exact (mul_lt_mul_of_pos_left (h₁.lt_of_not_le ba) (h₂.lt_of_not_le c0)).le, -end - -lemma mul_le_mul_of_nonneg_left : a ≤ b → 0 ≤ c → c * a ≤ c * b := -by classical; exact decidable.mul_le_mul_of_nonneg_left - --- See Note [decidable namespace] -protected lemma decidable.mul_le_mul_of_nonneg_right [@decidable_rel α (≤)] - (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := -begin - by_cases ba : b ≤ a, { simp [ba.antisymm h₁] }, - by_cases c0 : c ≤ 0, { simp [c0.antisymm h₂] }, - exact (mul_lt_mul_of_pos_right (h₁.lt_of_not_le ba) (h₂.lt_of_not_le c0)).le, -end - -lemma mul_le_mul_of_nonneg_right : a ≤ b → 0 ≤ c → a * c ≤ b * c := -by classical; exact decidable.mul_le_mul_of_nonneg_right - --- TODO: there are four variations, depending on which variables we assume to be nonneg --- See Note [decidable namespace] -protected lemma decidable.mul_le_mul [@decidable_rel α (≤)] - (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d := -calc - a * b ≤ c * b : decidable.mul_le_mul_of_nonneg_right hac nn_b - ... ≤ c * d : decidable.mul_le_mul_of_nonneg_left hbd nn_c - -lemma mul_le_mul : a ≤ c → b ≤ d → 0 ≤ b → 0 ≤ c → a * b ≤ c * d := -by classical; exact decidable.mul_le_mul - --- See Note [decidable namespace] -protected lemma decidable.mul_nonneg_le_one_le {α : Type*} [ordered_semiring α] - [@decidable_rel α (≤)] {a b c : α} - (h₁ : 0 ≤ c) (h₂ : a ≤ c) (h₃ : 0 ≤ b) (h₄ : b ≤ 1) : a * b ≤ c := -by simpa only [mul_one] using decidable.mul_le_mul h₂ h₄ h₃ h₁ - -lemma mul_nonneg_le_one_le {α : Type*} [ordered_semiring α] {a b c : α} : - 0 ≤ c → a ≤ c → 0 ≤ b → b ≤ 1 → a * b ≤ c := -by classical; exact decidable.mul_nonneg_le_one_le - --- See Note [decidable namespace] -protected lemma decidable.mul_nonneg [@decidable_rel α (≤)] - (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := -have h : 0 * b ≤ a * b, from decidable.mul_le_mul_of_nonneg_right ha hb, -by rwa [zero_mul] at h - -lemma mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b := by classical; exact decidable.mul_nonneg - -@[simp] theorem pow_nonneg (H : 0 ≤ a) : ∀ (n : ℕ), 0 ≤ a ^ n -| 0 := by { rw pow_zero, exact zero_le_one} -| (n+1) := by { rw pow_succ, exact mul_nonneg H (pow_nonneg _) } - --- See Note [decidable namespace] -protected lemma decidable.mul_nonpos_of_nonneg_of_nonpos [@decidable_rel α (≤)] - (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 := -have h : a * b ≤ a * 0, from decidable.mul_le_mul_of_nonneg_left hb ha, -by rwa mul_zero at h - -lemma mul_nonpos_of_nonneg_of_nonpos : 0 ≤ a → b ≤ 0 → a * b ≤ 0 := - by classical; exact decidable.mul_nonpos_of_nonneg_of_nonpos - --- See Note [decidable namespace] -protected lemma decidable.mul_nonpos_of_nonpos_of_nonneg [@decidable_rel α (≤)] - (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 := -have h : a * b ≤ 0 * b, from decidable.mul_le_mul_of_nonneg_right ha hb, -by rwa zero_mul at h - -lemma mul_nonpos_of_nonpos_of_nonneg : a ≤ 0 → 0 ≤ b → a * b ≤ 0 := -by classical; exact decidable.mul_nonpos_of_nonpos_of_nonneg - --- See Note [decidable namespace] -protected lemma decidable.mul_lt_mul [@decidable_rel α (≤)] - (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d := -calc - a * b < c * b : mul_lt_mul_of_pos_right hac pos_b - ... ≤ c * d : decidable.mul_le_mul_of_nonneg_left hbd nn_c - -lemma mul_lt_mul : a < c → b ≤ d → 0 < b → 0 ≤ c → a * b < c * d := -by classical; exact decidable.mul_lt_mul - --- See Note [decidable namespace] -protected lemma decidable.mul_lt_mul' [@decidable_rel α (≤)] - (h1 : a ≤ c) (h2 : b < d) (h3 : 0 ≤ b) (h4 : 0 < c) : a * b < c * d := -calc - a * b ≤ c * b : decidable.mul_le_mul_of_nonneg_right h1 h3 - ... < c * d : mul_lt_mul_of_pos_left h2 h4 - -lemma mul_lt_mul' : a ≤ c → b < d → 0 ≤ b → 0 < c → a * b < c * d := -by classical; exact decidable.mul_lt_mul' - -lemma mul_pos (ha : 0 < a) (hb : 0 < b) : 0 < a * b := -have h : 0 * b < a * b, from mul_lt_mul_of_pos_right ha hb, -by rwa zero_mul at h - -@[simp] theorem pow_pos (H : 0 < a) : ∀ (n : ℕ), 0 < a ^ n -| 0 := by { nontriviality, rw pow_zero, exact zero_lt_one } -| (n+1) := by { rw pow_succ, exact mul_pos H (pow_pos _) } - -lemma mul_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a * b < 0 := -have h : a * b < a * 0, from mul_lt_mul_of_pos_left hb ha, -by rwa mul_zero at h - -lemma mul_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a * b < 0 := -have h : a * b < 0 * b, from mul_lt_mul_of_pos_right ha hb, -by rwa zero_mul at h - --- See Note [decidable namespace] -protected lemma decidable.mul_self_lt_mul_self [@decidable_rel α (≤)] - (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := -decidable.mul_lt_mul' h2.le h2 h1 $ h1.trans_lt h2 - -lemma mul_self_lt_mul_self (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := -mul_lt_mul' h2.le h2 h1 $ h1.trans_lt h2 - --- See Note [decidable namespace] -protected lemma decidable.strict_mono_on_mul_self [@decidable_rel α (≤)] : - strict_mono_on (λ x : α, x * x) (set.Ici 0) := -λ x hx y hy hxy, decidable.mul_self_lt_mul_self hx hxy - -lemma strict_mono_on_mul_self : strict_mono_on (λ x : α, x * x) (set.Ici 0) := -λ x hx y hy hxy, mul_self_lt_mul_self hx hxy - --- See Note [decidable namespace] -protected lemma decidable.mul_self_le_mul_self [@decidable_rel α (≤)] - (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := -decidable.mul_le_mul h2 h2 h1 $ h1.trans h2 - -lemma mul_self_le_mul_self (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b := -mul_le_mul h2 h2 h1 $ h1.trans h2 - --- See Note [decidable namespace] -protected lemma decidable.mul_lt_mul'' [@decidable_rel α (≤)] - (h1 : a < c) (h2 : b < d) (h3 : 0 ≤ a) (h4 : 0 ≤ b) : a * b < c * d := -h4.lt_or_eq_dec.elim - (λ b0, decidable.mul_lt_mul h1 h2.le b0 $ h3.trans h1.le) - (λ b0, by rw [← b0, mul_zero]; exact - mul_pos (h3.trans_lt h1) (h4.trans_lt h2)) - -lemma mul_lt_mul'' : a < c → b < d → 0 ≤ a → 0 ≤ b → a * b < c * d := -by classical; exact decidable.mul_lt_mul'' - --- See Note [decidable namespace] -protected lemma decidable.le_mul_of_one_le_right [@decidable_rel α (≤)] - (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ b * a := -suffices b * 1 ≤ b * a, by rwa mul_one at this, -decidable.mul_le_mul_of_nonneg_left h hb - -lemma le_mul_of_one_le_right : 0 ≤ b → 1 ≤ a → b ≤ b * a := -by classical; exact decidable.le_mul_of_one_le_right - --- See Note [decidable namespace] -protected lemma decidable.le_mul_of_one_le_left [@decidable_rel α (≤)] - (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ a * b := -suffices 1 * b ≤ a * b, by rwa one_mul at this, -decidable.mul_le_mul_of_nonneg_right h hb - -lemma le_mul_of_one_le_left : 0 ≤ b → 1 ≤ a → b ≤ a * b := -by classical; exact decidable.le_mul_of_one_le_left - --- See Note [decidable namespace] -protected lemma decidable.lt_mul_of_one_lt_right [@decidable_rel α (≤)] - (hb : 0 < b) (h : 1 < a) : b < b * a := -suffices b * 1 < b * a, by rwa mul_one at this, -decidable.mul_lt_mul' le_rfl h zero_le_one hb - -lemma lt_mul_of_one_lt_right : 0 < b → 1 < a → b < b * a := -by classical; exact decidable.lt_mul_of_one_lt_right - --- See Note [decidable namespace] -protected lemma decidable.lt_mul_of_one_lt_left [@decidable_rel α (≤)] - (hb : 0 < b) (h : 1 < a) : b < a * b := -suffices 1 * b < a * b, by rwa one_mul at this, -decidable.mul_lt_mul h le_rfl hb (zero_le_one.trans h.le) - -lemma lt_mul_of_one_lt_left : 0 < b → 1 < a → b < a * b := -by classical; exact decidable.lt_mul_of_one_lt_left - -lemma lt_two_mul_self [nontrivial α] (ha : 0 < a) : a < 2 * a := -lt_mul_of_one_lt_left ha one_lt_two - --- See Note [decidable namespace] -protected lemma decidable.add_le_mul_two_add [@decidable_rel α (≤)] {a b : α} - (a2 : 2 ≤ a) (b0 : 0 ≤ b) : a + (2 + b) ≤ a * (2 + b) := -calc a + (2 + b) ≤ a + (a + a * b) : - add_le_add_left (add_le_add a2 (decidable.le_mul_of_one_le_left b0 (one_le_two.trans a2))) a - ... ≤ a * (2 + b) : by rw [mul_add, mul_two, add_assoc] - -lemma add_le_mul_two_add {a b : α} : 2 ≤ a → 0 ≤ b → a + (2 + b) ≤ a * (2 + b) := -by classical; exact decidable.add_le_mul_two_add - --- See Note [decidable namespace] -protected lemma decidable.one_le_mul_of_one_le_of_one_le [@decidable_rel α (≤)] - {a b : α} (a1 : 1 ≤ a) (b1 : 1 ≤ b) : (1 : α) ≤ a * b := -(mul_one (1 : α)).symm.le.trans (decidable.mul_le_mul a1 b1 zero_le_one (zero_le_one.trans a1)) - -lemma one_le_mul_of_one_le_of_one_le {a b : α} : 1 ≤ a → 1 ≤ b → (1 : α) ≤ a * b := -by classical; exact decidable.one_le_mul_of_one_le_of_one_le - -/-- Pullback an `ordered_semiring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.ordered_semiring {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_scalar ℕ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ordered_semiring β := -{ zero_le_one := show f 0 ≤ f 1, by simp only [zero, one, zero_le_one], - mul_lt_mul_of_pos_left := λ a b c ab c0, show f (c * a) < f (c * b), - begin - rw [mul, mul], - refine mul_lt_mul_of_pos_left ab _, - rwa ← zero, - end, - mul_lt_mul_of_pos_right := λ a b c ab c0, show f (a * c) < f (b * c), - begin - rw [mul, mul], - refine mul_lt_mul_of_pos_right ab _, - rwa ← zero, - end, - ..hf.ordered_cancel_add_comm_monoid f zero add nsmul, - ..hf.semiring f zero one add mul nsmul npow } - -section -variable [nontrivial α] - -lemma bit1_pos (h : 0 ≤ a) : 0 < bit1 a := -lt_add_of_le_of_pos (add_nonneg h h) zero_lt_one - -lemma lt_add_one (a : α) : a < a + 1 := -lt_add_of_le_of_pos le_rfl zero_lt_one - -lemma lt_one_add (a : α) : a < 1 + a := -by { rw [add_comm], apply lt_add_one } - -end - -lemma bit1_pos' (h : 0 < a) : 0 < bit1 a := -begin - nontriviality, - exact bit1_pos h.le, -end - --- See Note [decidable namespace] -protected lemma decidable.one_lt_mul [@decidable_rel α (≤)] - (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b := -begin - nontriviality, - exact (one_mul (1 : α)) ▸ decidable.mul_lt_mul' ha hb zero_le_one (zero_lt_one.trans_le ha) -end - -lemma one_lt_mul : 1 ≤ a → 1 < b → 1 < a * b := -by classical; exact decidable.one_lt_mul - --- See Note [decidable namespace] -protected lemma decidable.mul_le_one [@decidable_rel α (≤)] - (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 := -begin rw ← one_mul (1 : α), apply decidable.mul_le_mul; {assumption <|> apply zero_le_one} end - -lemma mul_le_one : a ≤ 1 → 0 ≤ b → b ≤ 1 → a * b ≤ 1 := -by classical; exact decidable.mul_le_one - --- See Note [decidable namespace] -protected lemma decidable.one_lt_mul_of_le_of_lt [@decidable_rel α (≤)] - (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b := -begin - nontriviality, - calc 1 = 1 * 1 : by rw one_mul - ... < a * b : decidable.mul_lt_mul' ha hb zero_le_one (zero_lt_one.trans_le ha) -end - -lemma one_lt_mul_of_le_of_lt : 1 ≤ a → 1 < b → 1 < a * b := -by classical; exact decidable.one_lt_mul_of_le_of_lt - --- See Note [decidable namespace] -protected lemma decidable.one_lt_mul_of_lt_of_le [@decidable_rel α (≤)] - (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b := -begin - nontriviality, - calc 1 = 1 * 1 : by rw one_mul - ... < a * b : decidable.mul_lt_mul ha hb zero_lt_one $ zero_le_one.trans ha.le -end - -lemma one_lt_mul_of_lt_of_le : 1 < a → 1 ≤ b → 1 < a * b := -by classical; exact decidable.one_lt_mul_of_lt_of_le - --- See Note [decidable namespace] -protected lemma decidable.mul_le_of_le_one_right [@decidable_rel α (≤)] - (ha : 0 ≤ a) (hb1 : b ≤ 1) : a * b ≤ a := -calc a * b ≤ a * 1 : decidable.mul_le_mul_of_nonneg_left hb1 ha -... = a : mul_one a - -lemma mul_le_of_le_one_right : 0 ≤ a → b ≤ 1 → a * b ≤ a := -by classical; exact decidable.mul_le_of_le_one_right - --- See Note [decidable namespace] -protected lemma decidable.mul_le_of_le_one_left [@decidable_rel α (≤)] - (hb : 0 ≤ b) (ha1 : a ≤ 1) : a * b ≤ b := -calc a * b ≤ 1 * b : decidable.mul_le_mul ha1 le_rfl hb zero_le_one -... = b : one_mul b - -lemma mul_le_of_le_one_left : 0 ≤ b → a ≤ 1 → a * b ≤ b := -by classical; exact decidable.mul_le_of_le_one_left - --- See Note [decidable namespace] -protected lemma decidable.mul_lt_one_of_nonneg_of_lt_one_left [@decidable_rel α (≤)] - (ha0 : 0 ≤ a) (ha : a < 1) (hb : b ≤ 1) : a * b < 1 := -calc a * b ≤ a : decidable.mul_le_of_le_one_right ha0 hb -... < 1 : ha - -lemma mul_lt_one_of_nonneg_of_lt_one_left : 0 ≤ a → a < 1 → b ≤ 1 → a * b < 1 := -by classical; exact decidable.mul_lt_one_of_nonneg_of_lt_one_left - --- See Note [decidable namespace] -protected lemma decidable.mul_lt_one_of_nonneg_of_lt_one_right [@decidable_rel α (≤)] - (ha : a ≤ 1) (hb0 : 0 ≤ b) (hb : b < 1) : a * b < 1 := -calc a * b ≤ b : decidable.mul_le_of_le_one_left hb0 ha -... < 1 : hb - -lemma mul_lt_one_of_nonneg_of_lt_one_right : a ≤ 1 → 0 ≤ b → b < 1 → a * b < 1 := -by classical; exact decidable.mul_lt_one_of_nonneg_of_lt_one_right - -end ordered_semiring - -section ordered_comm_semiring - -/-- An `ordered_comm_semiring α` is a commutative semiring `α` with a partial order such that -addition is monotone and multiplication by a positive number is strictly monotone. -/ -@[protect_proj] -class ordered_comm_semiring (α : Type u) extends ordered_semiring α, comm_semiring α - -/-- Pullback an `ordered_comm_semiring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.ordered_comm_semiring [ordered_comm_semiring α] {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_scalar ℕ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ordered_comm_semiring β := -{ ..hf.comm_semiring f zero one add mul nsmul npow, - ..hf.ordered_semiring f zero one add mul nsmul npow } - -end ordered_comm_semiring - -/-- -A `linear_ordered_semiring α` is a nontrivial semiring `α` with a linear order -such that addition is monotone and multiplication by a positive number is strictly monotone. --/ --- It's not entirely clear we should assume `nontrivial` at this point; --- it would be reasonable to explore changing this, --- but be warned that the instances involving `domain` may cause --- typeclass search loops. -@[protect_proj] -class linear_ordered_semiring (α : Type u) - extends ordered_semiring α, linear_ordered_add_comm_monoid α, nontrivial α - -section linear_ordered_semiring -variables [linear_ordered_semiring α] {a b c d : α} - --- `norm_num` expects the lemma stating `0 < 1` to have a single typeclass argument --- (see `norm_num.prove_pos_nat`). --- Rather than working out how to relax that assumption, --- we provide a synonym for `zero_lt_one` (which needs both `ordered_semiring α` and `nontrivial α`) --- with only a `linear_ordered_semiring` typeclass argument. -lemma zero_lt_one' : 0 < (1 : α) := zero_lt_one - -lemma lt_of_mul_lt_mul_left (h : c * a < c * b) (hc : 0 ≤ c) : a < b := -by haveI := @linear_order.decidable_le α _; exact lt_of_not_ge - (assume h1 : b ≤ a, - have h2 : c * b ≤ c * a, from decidable.mul_le_mul_of_nonneg_left h1 hc, - h2.not_lt h) - -lemma lt_of_mul_lt_mul_right (h : a * c < b * c) (hc : 0 ≤ c) : a < b := -by haveI := @linear_order.decidable_le α _; exact lt_of_not_ge - (assume h1 : b ≤ a, - have h2 : b * c ≤ a * c, from decidable.mul_le_mul_of_nonneg_right h1 hc, - h2.not_lt h) - -lemma le_of_mul_le_mul_left (h : c * a ≤ c * b) (hc : 0 < c) : a ≤ b := -le_of_not_gt - (assume h1 : b < a, - have h2 : c * b < c * a, from mul_lt_mul_of_pos_left h1 hc, - h2.not_le h) - -lemma le_of_mul_le_mul_right (h : a * c ≤ b * c) (hc : 0 < c) : a ≤ b := -le_of_not_gt - (assume h1 : b < a, - have h2 : b * c < a * c, from mul_lt_mul_of_pos_right h1 hc, - h2.not_le h) - -lemma pos_and_pos_or_neg_and_neg_of_mul_pos (hab : 0 < a * b) : - (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) := -begin - haveI := @linear_order.decidable_le α _, - rcases lt_trichotomy 0 a with (ha|rfl|ha), - { refine or.inl ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩, - exact decidable.mul_nonpos_of_nonneg_of_nonpos ha.le hb }, - { rw [zero_mul] at hab, exact hab.false.elim }, - { refine or.inr ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩, - exact decidable.mul_nonpos_of_nonpos_of_nonneg ha.le hb } -end - -lemma nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg (hab : 0 ≤ a * b) : - (0 ≤ a ∧ 0 ≤ b) ∨ (a ≤ 0 ∧ b ≤ 0) := -begin - haveI := @linear_order.decidable_le α _, - refine decidable.or_iff_not_and_not.2 _, - simp only [not_and, not_le], intros ab nab, apply not_lt_of_le hab _, - rcases lt_trichotomy 0 a with (ha|rfl|ha), - exacts [mul_neg_of_pos_of_neg ha (ab ha.le), ((ab le_rfl).asymm (nab le_rfl)).elim, - mul_neg_of_neg_of_pos ha (nab ha.le)] -end - -lemma pos_of_mul_pos_left (h : 0 < a * b) (ha : 0 ≤ a) : 0 < b := -((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_right $ λ h, h.1.not_le ha).2 - -lemma pos_of_mul_pos_right (h : 0 < a * b) (hb : 0 ≤ b) : 0 < a := -((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_right $ λ h, h.2.not_le hb).1 - -lemma pos_iff_pos_of_mul_pos (hab : 0 < a * b) : 0 < a ↔ 0 < b := -⟨pos_of_mul_pos_left hab ∘ le_of_lt, pos_of_mul_pos_right hab ∘ le_of_lt⟩ - -lemma neg_of_mul_pos_left (h : 0 < a * b) (ha : a ≤ 0) : b < 0 := -((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.1.not_le ha).2 - -lemma neg_of_mul_pos_right (h : 0 < a * b) (ha : b ≤ 0) : a < 0 := -((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.2.not_le ha).1 - -lemma neg_iff_neg_of_mul_pos (hab : 0 < a * b) : a < 0 ↔ b < 0 := -⟨neg_of_mul_pos_left hab ∘ le_of_lt, neg_of_mul_pos_right hab ∘ le_of_lt⟩ - -lemma nonneg_of_mul_nonneg_left (h : 0 ≤ a * b) (h1 : 0 < a) : 0 ≤ b := -le_of_not_gt (assume h2 : b < 0, (mul_neg_of_pos_of_neg h1 h2).not_le h) - -lemma nonneg_of_mul_nonneg_right (h : 0 ≤ a * b) (h1 : 0 < b) : 0 ≤ a := -le_of_not_gt (assume h2 : a < 0, (mul_neg_of_neg_of_pos h2 h1).not_le h) - -lemma neg_of_mul_neg_left (h : a * b < 0) (h1 : 0 ≤ a) : b < 0 := -by haveI := @linear_order.decidable_le α _; exact -lt_of_not_ge (assume h2 : b ≥ 0, (decidable.mul_nonneg h1 h2).not_lt h) - -lemma neg_of_mul_neg_right (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 := -by haveI := @linear_order.decidable_le α _; exact -lt_of_not_ge (assume h2 : a ≥ 0, (decidable.mul_nonneg h2 h1).not_lt h) - -lemma nonpos_of_mul_nonpos_left (h : a * b ≤ 0) (h1 : 0 < a) : b ≤ 0 := -le_of_not_gt (assume h2 : b > 0, (mul_pos h1 h2).not_le h) - -lemma nonpos_of_mul_nonpos_right (h : a * b ≤ 0) (h1 : 0 < b) : a ≤ 0 := -le_of_not_gt (assume h2 : a > 0, (mul_pos h2 h1).not_le h) - -@[simp] lemma mul_le_mul_left (h : 0 < c) : c * a ≤ c * b ↔ a ≤ b := -by haveI := @linear_order.decidable_le α _; exact -⟨λ h', le_of_mul_le_mul_left h' h, λ h', decidable.mul_le_mul_of_nonneg_left h' h.le⟩ - -@[simp] lemma mul_le_mul_right (h : 0 < c) : a * c ≤ b * c ↔ a ≤ b := -by haveI := @linear_order.decidable_le α _; exact -⟨λ h', le_of_mul_le_mul_right h' h, λ h', decidable.mul_le_mul_of_nonneg_right h' h.le⟩ - -@[simp] lemma mul_lt_mul_left (h : 0 < c) : c * a < c * b ↔ a < b := -by haveI := @linear_order.decidable_le α _; exact -⟨lt_imp_lt_of_le_imp_le $ λ h', decidable.mul_le_mul_of_nonneg_left h' h.le, - λ h', mul_lt_mul_of_pos_left h' h⟩ - -@[simp] lemma mul_lt_mul_right (h : 0 < c) : a * c < b * c ↔ a < b := -by haveI := @linear_order.decidable_le α _; exact -⟨lt_imp_lt_of_le_imp_le $ λ h', decidable.mul_le_mul_of_nonneg_right h' h.le, - λ h', mul_lt_mul_of_pos_right h' h⟩ - -@[simp] lemma zero_le_mul_left (h : 0 < c) : 0 ≤ c * b ↔ 0 ≤ b := -by { convert mul_le_mul_left h, simp } - -@[simp] lemma zero_le_mul_right (h : 0 < c) : 0 ≤ b * c ↔ 0 ≤ b := -by { convert mul_le_mul_right h, simp } - -@[simp] lemma zero_lt_mul_left (h : 0 < c) : 0 < c * b ↔ 0 < b := -by { convert mul_lt_mul_left h, simp } - -@[simp] lemma zero_lt_mul_right (h : 0 < c) : 0 < b * c ↔ 0 < b := -by { convert mul_lt_mul_right h, simp } - -lemma add_le_mul_of_left_le_right (a2 : 2 ≤ a) (ab : a ≤ b) : a + b ≤ a * b := -have 0 < b, from -calc 0 < 2 : zero_lt_two - ... ≤ a : a2 - ... ≤ b : ab, -calc a + b ≤ b + b : add_le_add_right ab b - ... = 2 * b : (two_mul b).symm - ... ≤ a * b : (mul_le_mul_right this).mpr a2 - -lemma add_le_mul_of_right_le_left (b2 : 2 ≤ b) (ba : b ≤ a) : a + b ≤ a * b := -have 0 < a, from -calc 0 < 2 : zero_lt_two - ... ≤ b : b2 - ... ≤ a : ba, -calc a + b ≤ a + a : add_le_add_left ba a - ... = a * 2 : (mul_two a).symm - ... ≤ a * b : (mul_le_mul_left this).mpr b2 - -lemma add_le_mul (a2 : 2 ≤ a) (b2 : 2 ≤ b) : a + b ≤ a * b := -if hab : a ≤ b then add_le_mul_of_left_le_right a2 hab - else add_le_mul_of_right_le_left b2 (le_of_not_le hab) - -lemma add_le_mul' (a2 : 2 ≤ a) (b2 : 2 ≤ b) : a + b ≤ b * a := -(le_of_eq (add_comm _ _)).trans (add_le_mul b2 a2) - -section - -@[simp] lemma bit0_le_bit0 : bit0 a ≤ bit0 b ↔ a ≤ b := -by rw [bit0, bit0, ← two_mul, ← two_mul, mul_le_mul_left (zero_lt_two : 0 < (2:α))] - -@[simp] lemma bit0_lt_bit0 : bit0 a < bit0 b ↔ a < b := -by rw [bit0, bit0, ← two_mul, ← two_mul, mul_lt_mul_left (zero_lt_two : 0 < (2:α))] - -@[simp] lemma bit1_le_bit1 : bit1 a ≤ bit1 b ↔ a ≤ b := -(add_le_add_iff_right 1).trans bit0_le_bit0 - -@[simp] lemma bit1_lt_bit1 : bit1 a < bit1 b ↔ a < b := -(add_lt_add_iff_right 1).trans bit0_lt_bit0 - -@[simp] lemma one_le_bit1 : (1 : α) ≤ bit1 a ↔ 0 ≤ a := -by rw [bit1, le_add_iff_nonneg_left, bit0, ← two_mul, zero_le_mul_left (zero_lt_two : 0 < (2:α))] - -@[simp] lemma one_lt_bit1 : (1 : α) < bit1 a ↔ 0 < a := -by rw [bit1, lt_add_iff_pos_left, bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2:α))] - -@[simp] lemma zero_le_bit0 : (0 : α) ≤ bit0 a ↔ 0 ≤ a := -by rw [bit0, ← two_mul, zero_le_mul_left (zero_lt_two : 0 < (2:α))] - -@[simp] lemma zero_lt_bit0 : (0 : α) < bit0 a ↔ 0 < a := -by rw [bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2:α))] - -end - -lemma le_mul_iff_one_le_left (hb : 0 < b) : b ≤ a * b ↔ 1 ≤ a := -suffices 1 * b ≤ a * b ↔ 1 ≤ a, by rwa one_mul at this, -mul_le_mul_right hb - -lemma lt_mul_iff_one_lt_left (hb : 0 < b) : b < a * b ↔ 1 < a := -suffices 1 * b < a * b ↔ 1 < a, by rwa one_mul at this, -mul_lt_mul_right hb - -lemma le_mul_iff_one_le_right (hb : 0 < b) : b ≤ b * a ↔ 1 ≤ a := -suffices b * 1 ≤ b * a ↔ 1 ≤ a, by rwa mul_one at this, -mul_le_mul_left hb - -lemma lt_mul_iff_one_lt_right (hb : 0 < b) : b < b * a ↔ 1 < a := -suffices b * 1 < b * a ↔ 1 < a, by rwa mul_one at this, -mul_lt_mul_left hb - -theorem mul_nonneg_iff_right_nonneg_of_pos (ha : 0 < a) : 0 ≤ a * b ↔ 0 ≤ b := -by haveI := @linear_order.decidable_le α _; exact -⟨λ h, nonneg_of_mul_nonneg_left h ha, λ h, decidable.mul_nonneg ha.le h⟩ - -theorem mul_nonneg_iff_left_nonneg_of_pos (hb : 0 < b) : 0 ≤ a * b ↔ 0 ≤ a := -by haveI := @linear_order.decidable_le α _; exact -⟨λ h, nonneg_of_mul_nonneg_right h hb, λ h, decidable.mul_nonneg h hb.le⟩ - -lemma mul_le_iff_le_one_left (hb : 0 < b) : a * b ≤ b ↔ a ≤ 1 := -⟨ λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_left hb).2 h.not_lt), - λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_left hb).1 h.not_lt) ⟩ - -lemma mul_lt_iff_lt_one_left (hb : 0 < b) : a * b < b ↔ a < 1 := -lt_iff_lt_of_le_iff_le $ le_mul_iff_one_le_left hb - -lemma mul_le_iff_le_one_right (hb : 0 < b) : b * a ≤ b ↔ a ≤ 1 := -⟨ λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_right hb).2 h.not_lt), - λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_right hb).1 h.not_lt) ⟩ - -lemma mul_lt_iff_lt_one_right (hb : 0 < b) : b * a < b ↔ a < 1 := -lt_iff_lt_of_le_iff_le $ le_mul_iff_one_le_right hb - --- TODO: `left` and `right` for these two lemmas are backwards compared to `neg_of_mul_pos` --- lemmas. -lemma nonpos_of_mul_nonneg_left (h : 0 ≤ a * b) (hb : b < 0) : a ≤ 0 := -le_of_not_gt (λ ha, absurd h (mul_neg_of_pos_of_neg ha hb).not_le) - -lemma nonpos_of_mul_nonneg_right (h : 0 ≤ a * b) (ha : a < 0) : b ≤ 0 := -le_of_not_gt (λ hb, absurd h (mul_neg_of_neg_of_pos ha hb).not_le) - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_semiring.to_no_max_order {α : Type*} [linear_ordered_semiring α] : - no_max_order α := -⟨assume a, ⟨a + 1, lt_add_of_pos_right _ zero_lt_one⟩⟩ - -/-- Pullback a `linear_ordered_semiring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.linear_ordered_semiring {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_scalar ℕ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - linear_ordered_semiring β := -{ .. linear_order.lift f hf, - .. pullback_nonzero f zero one, - .. hf.ordered_semiring f zero one add mul nsmul npow } - -@[simp] lemma units.inv_pos {u : αˣ} : (0 : α) < ↑u⁻¹ ↔ (0 : α) < u := -have ∀ {u : αˣ}, (0 : α) < u → (0 : α) < ↑u⁻¹ := λ u h, - (zero_lt_mul_left h).mp $ u.mul_inv.symm ▸ zero_lt_one, -⟨this, this⟩ - -@[simp] lemma units.inv_neg {u : αˣ} : ↑u⁻¹ < (0 : α) ↔ ↑u < (0 : α) := -have ∀ {u : αˣ}, ↑u < (0 : α) → ↑u⁻¹ < (0 : α) := λ u h, - neg_of_mul_pos_left (by exact (u.mul_inv.symm ▸ zero_lt_one)) h.le, -⟨this, this⟩ - -end linear_ordered_semiring - -section mono -variables {β : Type*} [linear_ordered_semiring α] [preorder β] {f g : β → α} {a : α} - -lemma monotone_mul_left_of_nonneg (ha : 0 ≤ a) : monotone (λ x, a*x) := -by haveI := @linear_order.decidable_le α _; exact -assume b c b_le_c, decidable.mul_le_mul_of_nonneg_left b_le_c ha - -lemma monotone_mul_right_of_nonneg (ha : 0 ≤ a) : monotone (λ x, x*a) := -by haveI := @linear_order.decidable_le α _; exact -assume b c b_le_c, decidable.mul_le_mul_of_nonneg_right b_le_c ha - -lemma monotone.mul_const (hf : monotone f) (ha : 0 ≤ a) : - monotone (λ x, (f x) * a) := -(monotone_mul_right_of_nonneg ha).comp hf - -lemma monotone.const_mul (hf : monotone f) (ha : 0 ≤ a) : - monotone (λ x, a * (f x)) := -(monotone_mul_left_of_nonneg ha).comp hf - -lemma monotone.mul (hf : monotone f) (hg : monotone g) (hf0 : ∀ x, 0 ≤ f x) (hg0 : ∀ x, 0 ≤ g x) : - monotone (λ x, f x * g x) := -by haveI := @linear_order.decidable_le α _; exact -λ x y h, decidable.mul_le_mul (hf h) (hg h) (hg0 x) (hf0 y) - -lemma strict_mono_mul_left_of_pos (ha : 0 < a) : strict_mono (λ x, a * x) := -assume b c b_lt_c, (mul_lt_mul_left ha).2 b_lt_c - -lemma strict_mono_mul_right_of_pos (ha : 0 < a) : strict_mono (λ x, x * a) := -assume b c b_lt_c, (mul_lt_mul_right ha).2 b_lt_c - -lemma strict_mono.mul_const (hf : strict_mono f) (ha : 0 < a) : - strict_mono (λ x, (f x) * a) := -(strict_mono_mul_right_of_pos ha).comp hf - -lemma strict_mono.const_mul (hf : strict_mono f) (ha : 0 < a) : - strict_mono (λ x, a * (f x)) := -(strict_mono_mul_left_of_pos ha).comp hf - -lemma strict_mono.mul_monotone (hf : strict_mono f) (hg : monotone g) (hf0 : ∀ x, 0 ≤ f x) - (hg0 : ∀ x, 0 < g x) : - strict_mono (λ x, f x * g x) := -by haveI := @linear_order.decidable_le α _; exact -λ x y h, decidable.mul_lt_mul (hf h) (hg h.le) (hg0 x) (hf0 y) - -lemma monotone.mul_strict_mono (hf : monotone f) (hg : strict_mono g) (hf0 : ∀ x, 0 < f x) - (hg0 : ∀ x, 0 ≤ g x) : - strict_mono (λ x, f x * g x) := -by haveI := @linear_order.decidable_le α _; exact -λ x y h, decidable.mul_lt_mul' (hf h.le) (hg h) (hg0 x) (hf0 y) - -lemma strict_mono.mul (hf : strict_mono f) (hg : strict_mono g) (hf0 : ∀ x, 0 ≤ f x) - (hg0 : ∀ x, 0 ≤ g x) : - strict_mono (λ x, f x * g x) := -by haveI := @linear_order.decidable_le α _; exact -λ x y h, decidable.mul_lt_mul'' (hf h) (hg h) (hf0 x) (hg0 x) - -end mono - -section linear_ordered_semiring -variables [linear_ordered_semiring α] {a b c : α} - -lemma mul_max_of_nonneg (b c : α) (ha : 0 ≤ a) : a * max b c = max (a * b) (a * c) := -(monotone_mul_left_of_nonneg ha).map_max - -lemma mul_min_of_nonneg (b c : α) (ha : 0 ≤ a) : a * min b c = min (a * b) (a * c) := -(monotone_mul_left_of_nonneg ha).map_min - -lemma max_mul_of_nonneg (a b : α) (hc : 0 ≤ c) : max a b * c = max (a * c) (b * c) := -(monotone_mul_right_of_nonneg hc).map_max - -lemma min_mul_of_nonneg (a b : α) (hc : 0 ≤ c) : min a b * c = min (a * c) (b * c) := -(monotone_mul_right_of_nonneg hc).map_min - -end linear_ordered_semiring - -/-- An `ordered_ring α` is a ring `α` with a partial order such that -addition is monotone and multiplication by a positive number is strictly monotone. -/ -@[protect_proj] -class ordered_ring (α : Type u) extends ring α, ordered_add_comm_group α := -(zero_le_one : 0 ≤ (1 : α)) -(mul_pos : ∀ a b : α, 0 < a → 0 < b → 0 < a * b) - -section ordered_ring -variables [ordered_ring α] {a b c : α} - --- See Note [decidable namespace] -protected lemma decidable.ordered_ring.mul_nonneg [@decidable_rel α (≤)] - {a b : α} (h₁ : 0 ≤ a) (h₂ : 0 ≤ b) : 0 ≤ a * b := -begin - by_cases ha : a ≤ 0, { simp [le_antisymm ha h₁] }, - by_cases hb : b ≤ 0, { simp [le_antisymm hb h₂] }, - exact (le_not_le_of_lt (ordered_ring.mul_pos a b (h₁.lt_of_not_le ha) (h₂.lt_of_not_le hb))).1, -end - -lemma ordered_ring.mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b := -by classical; exact decidable.ordered_ring.mul_nonneg - --- See Note [decidable namespace] -protected lemma decidable.ordered_ring.mul_le_mul_of_nonneg_left - [@decidable_rel α (≤)] (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := -begin - rw [← sub_nonneg, ← mul_sub], - exact decidable.ordered_ring.mul_nonneg h₂ (sub_nonneg.2 h₁), -end - -lemma ordered_ring.mul_le_mul_of_nonneg_left : a ≤ b → 0 ≤ c → c * a ≤ c * b := -by classical; exact decidable.ordered_ring.mul_le_mul_of_nonneg_left - --- See Note [decidable namespace] -protected lemma decidable.ordered_ring.mul_le_mul_of_nonneg_right - [@decidable_rel α (≤)] (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := -begin - rw [← sub_nonneg, ← sub_mul], - exact decidable.ordered_ring.mul_nonneg (sub_nonneg.2 h₁) h₂, -end - -lemma ordered_ring.mul_le_mul_of_nonneg_right : a ≤ b → 0 ≤ c → a * c ≤ b * c := -by classical; exact decidable.ordered_ring.mul_le_mul_of_nonneg_right - -lemma ordered_ring.mul_lt_mul_of_pos_left (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b := -begin - rw [← sub_pos, ← mul_sub], - exact ordered_ring.mul_pos _ _ h₂ (sub_pos.2 h₁), -end - -lemma ordered_ring.mul_lt_mul_of_pos_right (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c := -begin - rw [← sub_pos, ← sub_mul], - exact ordered_ring.mul_pos _ _ (sub_pos.2 h₁) h₂, -end - -@[priority 100] -- see Note [lower instance priority] -instance ordered_ring.to_ordered_semiring : ordered_semiring α := -{ mul_zero := mul_zero, - zero_mul := zero_mul, - add_left_cancel := @add_left_cancel α _, - le_of_add_le_add_left := @le_of_add_le_add_left α _ _ _, - mul_lt_mul_of_pos_left := @ordered_ring.mul_lt_mul_of_pos_left α _, - mul_lt_mul_of_pos_right := @ordered_ring.mul_lt_mul_of_pos_right α _, - ..‹ordered_ring α› } - --- See Note [decidable namespace] -protected lemma decidable.mul_le_mul_of_nonpos_left [@decidable_rel α (≤)] - {a b c : α} (h : b ≤ a) (hc : c ≤ 0) : c * a ≤ c * b := -have -c ≥ 0, from neg_nonneg_of_nonpos hc, -have -c * b ≤ -c * a, from decidable.mul_le_mul_of_nonneg_left h this, -have -(c * b) ≤ -(c * a), by rwa [neg_mul, neg_mul] at this, -le_of_neg_le_neg this - -lemma mul_le_mul_of_nonpos_left {a b c : α} : b ≤ a → c ≤ 0 → c * a ≤ c * b := -by classical; exact decidable.mul_le_mul_of_nonpos_left - --- See Note [decidable namespace] -protected lemma decidable.mul_le_mul_of_nonpos_right [@decidable_rel α (≤)] - {a b c : α} (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := -have -c ≥ 0, from neg_nonneg_of_nonpos hc, -have b * -c ≤ a * -c, from decidable.mul_le_mul_of_nonneg_right h this, -have -(b * c) ≤ -(a * c), by rwa [mul_neg, mul_neg] at this, -le_of_neg_le_neg this - -lemma mul_le_mul_of_nonpos_right {a b c : α} : b ≤ a → c ≤ 0 → a * c ≤ b * c := -by classical; exact decidable.mul_le_mul_of_nonpos_right - --- See Note [decidable namespace] -protected lemma decidable.mul_nonneg_of_nonpos_of_nonpos [@decidable_rel α (≤)] - {a b : α} (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := -have 0 * b ≤ a * b, from decidable.mul_le_mul_of_nonpos_right ha hb, -by rwa zero_mul at this - -lemma mul_nonneg_of_nonpos_of_nonpos {a b : α} : a ≤ 0 → b ≤ 0 → 0 ≤ a * b := -by classical; exact decidable.mul_nonneg_of_nonpos_of_nonpos - -lemma mul_lt_mul_of_neg_left {a b c : α} (h : b < a) (hc : c < 0) : c * a < c * b := -have -c > 0, from neg_pos_of_neg hc, -have -c * b < -c * a, from mul_lt_mul_of_pos_left h this, -have -(c * b) < -(c * a), by rwa [neg_mul, neg_mul] at this, -lt_of_neg_lt_neg this - -lemma mul_lt_mul_of_neg_right {a b c : α} (h : b < a) (hc : c < 0) : a * c < b * c := -have -c > 0, from neg_pos_of_neg hc, -have b * -c < a * -c, from mul_lt_mul_of_pos_right h this, -have -(b * c) < -(a * c), by rwa [mul_neg, mul_neg] at this, -lt_of_neg_lt_neg this - -lemma mul_pos_of_neg_of_neg {a b : α} (ha : a < 0) (hb : b < 0) : 0 < a * b := -have 0 * b < a * b, from mul_lt_mul_of_neg_right ha hb, -by rwa zero_mul at this - -/-- Pullback an `ordered_ring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.ordered_ring {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ordered_ring β := -{ mul_pos := λ a b a0 b0, show f 0 < f (a * b), by { rw [zero, mul], apply mul_pos; rwa ← zero }, - ..hf.ordered_semiring f zero one add mul nsmul npow, - ..hf.ring f zero one add mul neg sub nsmul zsmul npow } - -lemma le_iff_exists_nonneg_add (a b : α) : a ≤ b ↔ ∃ c ≥ 0, b = a + c := -⟨λ h, ⟨b - a, sub_nonneg.mpr h, by simp⟩, - λ ⟨c, hc, h⟩, by { rw [h, le_add_iff_nonneg_right], exact hc }⟩ - -end ordered_ring - -section ordered_comm_ring - -/-- An `ordered_comm_ring α` is a commutative ring `α` with a partial order such that -addition is monotone and multiplication by a positive number is strictly monotone. -/ -@[protect_proj] -class ordered_comm_ring (α : Type u) extends ordered_ring α, comm_ring α - -@[priority 100] -- See note [lower instance priority] -instance ordered_comm_ring.to_ordered_comm_semiring {α : Type u} [ordered_comm_ring α] : - ordered_comm_semiring α := -{ .. (by apply_instance : ordered_semiring α), - .. ‹ordered_comm_ring α› } - -/-- Pullback an `ordered_comm_ring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.ordered_comm_ring [ordered_comm_ring α] {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ordered_comm_ring β := -{ ..hf.ordered_ring f zero one add mul neg sub nsmul zsmul npow, - ..hf.comm_ring f zero one add mul neg sub nsmul zsmul npow } - -end ordered_comm_ring - -/-- A `linear_ordered_ring α` is a ring `α` with a linear order such that -addition is monotone and multiplication by a positive number is strictly monotone. -/ -@[protect_proj] class linear_ordered_ring (α : Type u) - extends ordered_ring α, linear_order α, nontrivial α - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_ring.to_linear_ordered_add_comm_group [s : linear_ordered_ring α] : - linear_ordered_add_comm_group α := -{ .. s } - -section linear_ordered_semiring -variables [linear_ordered_semiring α] {a b c : α} - -local attribute [instance] linear_ordered_semiring.decidable_le - -lemma le_of_mul_le_of_one_le {a b c : α} (h : a * c ≤ b) (hb : 0 ≤ b) (hc : 1 ≤ c) : a ≤ b := -have h' : a * c ≤ b * c, from calc - a * c ≤ b : h - ... = b * 1 : by rewrite mul_one - ... ≤ b * c : decidable.mul_le_mul_of_nonneg_left hc hb, -le_of_mul_le_mul_right h' (zero_lt_one.trans_le hc) - -lemma nonneg_le_nonneg_of_sq_le_sq {a b : α} (hb : 0 ≤ b) (h : a * a ≤ b * b) : a ≤ b := -le_of_not_gt (λhab, (decidable.mul_self_lt_mul_self hb hab).not_le h) - -lemma mul_self_le_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a ≤ b ↔ a * a ≤ b * b := -⟨decidable.mul_self_le_mul_self h1, nonneg_le_nonneg_of_sq_le_sq h2⟩ - -lemma mul_self_lt_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a < b ↔ a * a < b * b := -((@decidable.strict_mono_on_mul_self α _ _).lt_iff_lt h1 h2).symm - -lemma mul_self_inj {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a * a = b * b ↔ a = b := -(@decidable.strict_mono_on_mul_self α _ _).inj_on.eq_iff h1 h2 - -end linear_ordered_semiring - -section linear_ordered_ring -variables [linear_ordered_ring α] {a b c : α} - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_ring.to_linear_ordered_semiring : linear_ordered_semiring α := -{ mul_zero := mul_zero, - zero_mul := zero_mul, - add_left_cancel := @add_left_cancel α _, - le_of_add_le_add_left := @le_of_add_le_add_left α _ _ _, - mul_lt_mul_of_pos_left := @mul_lt_mul_of_pos_left α _, - mul_lt_mul_of_pos_right := @mul_lt_mul_of_pos_right α _, - le_total := linear_ordered_ring.le_total, - ..‹linear_ordered_ring α› } - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_ring.is_domain : is_domain α := -{ eq_zero_or_eq_zero_of_mul_eq_zero := - begin - intros a b hab, - refine decidable.or_iff_not_and_not.2 (λ h, _), revert hab, - cases lt_or_gt_of_ne h.1 with ha ha; cases lt_or_gt_of_ne h.2 with hb hb, - exacts [(mul_pos_of_neg_of_neg ha hb).ne.symm, (mul_neg_of_neg_of_pos ha hb).ne, - (mul_neg_of_pos_of_neg ha hb).ne, (mul_pos ha hb).ne.symm] - end, - .. ‹linear_ordered_ring α› } - -@[simp] lemma abs_one : |(1 : α)| = 1 := abs_of_pos zero_lt_one -@[simp] lemma abs_two : |(2 : α)| = 2 := abs_of_pos zero_lt_two - -lemma abs_mul (a b : α) : |a * b| = |a| * |b| := -begin - haveI := @linear_order.decidable_le α _, - rw [abs_eq (decidable.mul_nonneg (abs_nonneg a) (abs_nonneg b))], - cases le_total a 0 with ha ha; cases le_total b 0 with hb hb; - simp only [abs_of_nonpos, abs_of_nonneg, true_or, or_true, eq_self_iff_true, - neg_mul, mul_neg, neg_neg, *] -end - -/-- `abs` as a `monoid_with_zero_hom`. -/ -def abs_hom : α →*₀ α := ⟨abs, abs_zero, abs_one, abs_mul⟩ - -@[simp] lemma abs_mul_abs_self (a : α) : |a| * |a| = a * a := -abs_by_cases (λ x, x * x = a * a) rfl (neg_mul_neg a a) - -@[simp] lemma abs_mul_self (a : α) : |a * a| = a * a := -by rw [abs_mul, abs_mul_abs_self] - -lemma mul_pos_iff : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := -⟨pos_and_pos_or_neg_and_neg_of_mul_pos, - λ h, h.elim (and_imp.2 mul_pos) (and_imp.2 mul_pos_of_neg_of_neg)⟩ - -lemma mul_neg_iff : a * b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := -by rw [← neg_pos, neg_mul_eq_mul_neg, mul_pos_iff, neg_pos, neg_lt_zero] - -lemma mul_nonneg_iff : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := -by haveI := @linear_order.decidable_le α _; exact -⟨nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg, - λ h, h.elim (and_imp.2 decidable.mul_nonneg) (and_imp.2 decidable.mul_nonneg_of_nonpos_of_nonpos)⟩ - -/-- Out of three elements of a `linear_ordered_ring`, two must have the same sign. -/ -lemma mul_nonneg_of_three (a b c : α) : - 0 ≤ a * b ∨ 0 ≤ b * c ∨ 0 ≤ c * a := -by iterate 3 { rw mul_nonneg_iff }; - have := le_total 0 a; have := le_total 0 b; have := le_total 0 c; itauto - -lemma mul_nonpos_iff : a * b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b := -by rw [← neg_nonneg, neg_mul_eq_mul_neg, mul_nonneg_iff, neg_nonneg, neg_nonpos] - -lemma mul_self_nonneg (a : α) : 0 ≤ a * a := -abs_mul_self a ▸ abs_nonneg _ - -@[simp] lemma neg_le_self_iff : -a ≤ a ↔ 0 ≤ a := -by simp [neg_le_iff_add_nonneg, ← two_mul, mul_nonneg_iff, zero_le_one, (@zero_lt_two α _ _).not_le] - -@[simp] lemma neg_lt_self_iff : -a < a ↔ 0 < a := -by simp [neg_lt_iff_pos_add, ← two_mul, mul_pos_iff, zero_lt_one, (@zero_lt_two α _ _).not_lt] - -@[simp] lemma le_neg_self_iff : a ≤ -a ↔ a ≤ 0 := -calc a ≤ -a ↔ -(-a) ≤ -a : by rw neg_neg -... ↔ 0 ≤ -a : neg_le_self_iff -... ↔ a ≤ 0 : neg_nonneg - -@[simp] lemma lt_neg_self_iff : a < -a ↔ a < 0 := -calc a < -a ↔ -(-a) < -a : by rw neg_neg -... ↔ 0 < -a : neg_lt_self_iff -... ↔ a < 0 : neg_pos - -@[simp] lemma abs_eq_self : |a| = a ↔ 0 ≤ a := by simp [abs_eq_max_neg] - -@[simp] lemma abs_eq_neg_self : |a| = -a ↔ a ≤ 0 := by simp [abs_eq_max_neg] - -/-- For an element `a` of a linear ordered ring, either `abs a = a` and `0 ≤ a`, - or `abs a = -a` and `a < 0`. - Use cases on this lemma to automate linarith in inequalities -/ -lemma abs_cases (a : α) : (|a| = a ∧ 0 ≤ a) ∨ (|a| = -a ∧ a < 0) := -begin - by_cases 0 ≤ a, - { left, - exact ⟨abs_eq_self.mpr h, h⟩ }, - { right, - push_neg at h, - exact ⟨abs_eq_neg_self.mpr (le_of_lt h), h⟩ } -end - -lemma gt_of_mul_lt_mul_neg_left (h : c * a < c * b) (hc : c ≤ 0) : b < a := -have nhc : 0 ≤ -c, from neg_nonneg_of_nonpos hc, -have h2 : -(c * b) < -(c * a), from neg_lt_neg h, -have h3 : (-c) * b < (-c) * a, from calc - (-c) * b = - (c * b) : by rewrite neg_mul_eq_neg_mul - ... < -(c * a) : h2 - ... = (-c) * a : by rewrite neg_mul_eq_neg_mul, -lt_of_mul_lt_mul_left h3 nhc - -lemma neg_one_lt_zero : -1 < (0:α) := neg_lt_zero.2 zero_lt_one - -@[simp] lemma mul_le_mul_left_of_neg {a b c : α} (h : c < 0) : c * a ≤ c * b ↔ b ≤ a := -by haveI := @linear_order.decidable_le α _; exact -⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_left h' h, - λ h', decidable.mul_le_mul_of_nonpos_left h' h.le⟩ - -@[simp] lemma mul_le_mul_right_of_neg {a b c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a := -by haveI := @linear_order.decidable_le α _; exact -⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_right h' h, - λ h', decidable.mul_le_mul_of_nonpos_right h' h.le⟩ - -@[simp] lemma mul_lt_mul_left_of_neg {a b c : α} (h : c < 0) : c * a < c * b ↔ b < a := -lt_iff_lt_of_le_iff_le (mul_le_mul_left_of_neg h) - -@[simp] lemma mul_lt_mul_right_of_neg {a b c : α} (h : c < 0) : a * c < b * c ↔ b < a := -lt_iff_lt_of_le_iff_le (mul_le_mul_right_of_neg h) - -lemma sub_one_lt (a : α) : a - 1 < a := -sub_lt_iff_lt_add.2 (lt_add_one a) - -@[simp] lemma mul_self_pos {a : α} : 0 < a * a ↔ a ≠ 0 := -begin - split, - { rintro h rfl, rw mul_zero at h, exact h.false }, - { intro h, - cases h.lt_or_lt with h h, - exacts [mul_pos_of_neg_of_neg h h, mul_pos h h] } -end - -lemma mul_self_le_mul_self_of_le_of_neg_le {x y : α} (h₁ : x ≤ y) (h₂ : -x ≤ y) : x * x ≤ y * y := -begin - haveI := @linear_order.decidable_le α _, - rw [← abs_mul_abs_self x], - exact decidable.mul_self_le_mul_self (abs_nonneg x) (abs_le.2 ⟨neg_le.2 h₂, h₁⟩) -end - -lemma nonneg_of_mul_nonpos_left {a b : α} (h : a * b ≤ 0) (hb : b < 0) : 0 ≤ a := -le_of_not_gt (λ ha, absurd h (mul_pos_of_neg_of_neg ha hb).not_le) - -lemma nonneg_of_mul_nonpos_right {a b : α} (h : a * b ≤ 0) (ha : a < 0) : 0 ≤ b := -le_of_not_gt (λ hb, absurd h (mul_pos_of_neg_of_neg ha hb).not_le) - -lemma pos_of_mul_neg_left {a b : α} (h : a * b < 0) (hb : b ≤ 0) : 0 < a := -by haveI := @linear_order.decidable_le α _; exact -lt_of_not_ge (λ ha, absurd h (decidable.mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt) - -lemma pos_of_mul_neg_right {a b : α} (h : a * b < 0) (ha : a ≤ 0) : 0 < b := -by haveI := @linear_order.decidable_le α _; exact -lt_of_not_ge (λ hb, absurd h (decidable.mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt) - -lemma neg_iff_pos_of_mul_neg (hab : a * b < 0) : a < 0 ↔ 0 < b := -⟨pos_of_mul_neg_right hab ∘ le_of_lt, neg_of_mul_neg_right hab ∘ le_of_lt⟩ - -lemma pos_iff_neg_of_mul_neg (hab : a * b < 0) : 0 < a ↔ b < 0 := -⟨neg_of_mul_neg_left hab ∘ le_of_lt, pos_of_mul_neg_left hab ∘ le_of_lt⟩ - -/-- The sum of two squares is zero iff both elements are zero. -/ -lemma mul_self_add_mul_self_eq_zero {x y : α} : x * x + y * y = 0 ↔ x = 0 ∧ y = 0 := -by rw [add_eq_zero_iff', mul_self_eq_zero, mul_self_eq_zero]; apply mul_self_nonneg - -lemma eq_zero_of_mul_self_add_mul_self_eq_zero (h : a * a + b * b = 0) : a = 0 := -(mul_self_add_mul_self_eq_zero.mp h).left - -lemma abs_eq_iff_mul_self_eq : |a| = |b| ↔ a * a = b * b := -begin - rw [← abs_mul_abs_self, ← abs_mul_abs_self b], - exact (mul_self_inj (abs_nonneg a) (abs_nonneg b)).symm, -end - -lemma abs_lt_iff_mul_self_lt : |a| < |b| ↔ a * a < b * b := -begin - rw [← abs_mul_abs_self, ← abs_mul_abs_self b], - exact mul_self_lt_mul_self_iff (abs_nonneg a) (abs_nonneg b) -end - -lemma abs_le_iff_mul_self_le : |a| ≤ |b| ↔ a * a ≤ b * b := -begin - rw [← abs_mul_abs_self, ← abs_mul_abs_self b], - exact mul_self_le_mul_self_iff (abs_nonneg a) (abs_nonneg b) -end - -lemma abs_le_one_iff_mul_self_le_one : |a| ≤ 1 ↔ a * a ≤ 1 := -by simpa only [abs_one, one_mul] using @abs_le_iff_mul_self_le α _ a 1 - -/-- Pullback a `linear_ordered_ring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.linear_ordered_ring {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - linear_ordered_ring β := -{ .. linear_order.lift f hf, - .. pullback_nonzero f zero one, - .. hf.ordered_ring f zero one add mul neg sub nsmul zsmul npow } - -end linear_ordered_ring - -/-- A `linear_ordered_comm_ring α` is a commutative ring `α` with a linear order -such that addition is monotone and multiplication by a positive number is strictly monotone. -/ -@[protect_proj] -class linear_ordered_comm_ring (α : Type u) extends linear_ordered_ring α, comm_monoid α - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_comm_ring.to_ordered_comm_ring [d : linear_ordered_comm_ring α] : - ordered_comm_ring α := -{ ..d } - -@[priority 100] -- see Note [lower instance priority] -instance linear_ordered_comm_ring.to_linear_ordered_semiring [d : linear_ordered_comm_ring α] : - linear_ordered_semiring α := -{ .. d, ..linear_ordered_ring.to_linear_ordered_semiring } - -section linear_ordered_comm_ring - -variables [linear_ordered_comm_ring α] {a b c d : α} - -lemma max_mul_mul_le_max_mul_max (b c : α) (ha : 0 ≤ a) (hd: 0 ≤ d) : - max (a * b) (d * c) ≤ max a c * max d b := -by haveI := @linear_order.decidable_le α _; exact -have ba : b * a ≤ max d b * max c a, from - decidable.mul_le_mul (le_max_right d b) (le_max_right c a) ha (le_trans hd (le_max_left d b)), -have cd : c * d ≤ max a c * max b d, from - decidable.mul_le_mul (le_max_right a c) (le_max_right b d) hd (le_trans ha (le_max_left a c)), -max_le - (by simpa [mul_comm, max_comm] using ba) - (by simpa [mul_comm, max_comm] using cd) - -lemma abs_sub_sq (a b : α) : |a - b| * |a - b| = a * a + b * b - (1 + 1) * a * b := -begin - rw abs_mul_abs_self, - simp only [mul_add, add_comm, add_left_comm, mul_comm, sub_eq_add_neg, - mul_one, mul_neg, neg_add_rev, neg_neg], -end - -end linear_ordered_comm_ring -section -variables [ring α] [linear_order α] {a b : α} - -@[simp] lemma abs_dvd (a b : α) : |a| ∣ b ↔ a ∣ b := -by { cases abs_choice a with h h; simp only [h, neg_dvd] } - -lemma abs_dvd_self (a : α) : |a| ∣ a := -(abs_dvd a a).mpr (dvd_refl a) - -@[simp] lemma dvd_abs (a b : α) : a ∣ |b| ↔ a ∣ b := -by { cases abs_choice b with h h; simp only [h, dvd_neg] } - -lemma self_dvd_abs (a : α) : a ∣ |a| := -(dvd_abs a a).mpr (dvd_refl a) - -lemma abs_dvd_abs (a b : α) : |a| ∣ |b| ↔ a ∣ b := -(abs_dvd _ _).trans (dvd_abs _ _) - -end - -section linear_ordered_comm_ring - -variables [linear_ordered_comm_ring α] - -/-- Pullback a `linear_ordered_comm_ring` under an injective map. -See note [reducible non-instances]. -/ -@[reducible] -def function.injective.linear_ordered_comm_ring {β : Type*} - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - linear_ordered_comm_ring β := -{ .. linear_order.lift f hf, - .. pullback_nonzero f zero one, - .. hf.ordered_comm_ring f zero one add mul neg sub nsmul zsmul npow } - -end linear_ordered_comm_ring - -namespace ring - -/-- A positive cone in a ring consists of a positive cone in underlying `add_comm_group`, -which contains `1` and such that the positive elements are closed under multiplication. -/ -@[nolint has_inhabited_instance] -structure positive_cone (α : Type*) [ring α] extends add_comm_group.positive_cone α := -(one_nonneg : nonneg 1) -(mul_pos : ∀ (a b), pos a → pos b → pos (a * b)) - -/-- Forget that a positive cone in a ring respects the multiplicative structure. -/ -add_decl_doc positive_cone.to_positive_cone - -/-- A positive cone in a ring induces a linear order if `1` is a positive element. -/ -@[nolint has_inhabited_instance] -structure total_positive_cone (α : Type*) [ring α] - extends positive_cone α, add_comm_group.total_positive_cone α := -(one_pos : pos 1) - -/-- Forget that a `total_positive_cone` in a ring is total. -/ -add_decl_doc total_positive_cone.to_positive_cone - -/-- Forget that a `total_positive_cone` in a ring respects the multiplicative structure. -/ -add_decl_doc total_positive_cone.to_total_positive_cone - -end ring - -namespace ordered_ring - -open ring - -/-- Construct an `ordered_ring` by -designating a positive cone in an existing `ring`. -/ -def mk_of_positive_cone {α : Type*} [ring α] (C : positive_cone α) : - ordered_ring α := -{ zero_le_one := by { change C.nonneg (1 - 0), convert C.one_nonneg, simp, }, - mul_pos := λ x y xp yp, begin - change C.pos (x*y - 0), - convert C.mul_pos x y (by { convert xp, simp, }) (by { convert yp, simp, }), - simp, - end, - ..‹ring α›, - ..ordered_add_comm_group.mk_of_positive_cone C.to_positive_cone } - -end ordered_ring - -namespace linear_ordered_ring - -open ring - -/-- Construct a `linear_ordered_ring` by -designating a positive cone in an existing `ring`. -/ -def mk_of_positive_cone {α : Type*} [ring α] (C : total_positive_cone α) : - linear_ordered_ring α := -{ exists_pair_ne := ⟨0, 1, begin - intro h, - have one_pos := C.one_pos, - rw [←h, C.pos_iff] at one_pos, - simpa using one_pos, - end⟩, - ..ordered_ring.mk_of_positive_cone C.to_positive_cone, - ..linear_ordered_add_comm_group.mk_of_positive_cone C.to_total_positive_cone, } - -end linear_ordered_ring - -/-- A canonically ordered commutative semiring is an ordered, commutative semiring -in which `a ≤ b` iff there exists `c` with `b = a + c`. This is satisfied by the -natural numbers, for example, but not the integers or other ordered groups. -/ -@[protect_proj] -class canonically_ordered_comm_semiring (α : Type*) extends - canonically_ordered_add_monoid α, comm_semiring α := -(eq_zero_or_eq_zero_of_mul_eq_zero : ∀ a b : α, a * b = 0 → a = 0 ∨ b = 0) - -namespace canonically_ordered_comm_semiring -variables [canonically_ordered_comm_semiring α] {a b : α} - -@[priority 100] -- see Note [lower instance priority] -instance to_no_zero_divisors : no_zero_divisors α := -⟨canonically_ordered_comm_semiring.eq_zero_or_eq_zero_of_mul_eq_zero⟩ - -@[priority 100] -- see Note [lower instance priority] -instance to_covariant_mul_le : covariant_class α α (*) (≤) := -begin - refine ⟨λ a b c h, _⟩, - rcases le_iff_exists_add.1 h with ⟨c, rfl⟩, - rw mul_add, - apply self_le_add_right -end - -/-- A version of `zero_lt_one : 0 < 1` for a `canonically_ordered_comm_semiring`. -/ -lemma zero_lt_one [nontrivial α] : (0:α) < 1 := (zero_le 1).lt_of_ne zero_ne_one - -@[simp] lemma mul_pos : 0 < a * b ↔ (0 < a) ∧ (0 < b) := -by simp only [pos_iff_ne_zero, ne.def, mul_eq_zero, not_or_distrib] - - -end canonically_ordered_comm_semiring - -section sub - -variables [canonically_ordered_comm_semiring α] {a b c : α} -variables [has_sub α] [has_ordered_sub α] - -variables [is_total α (≤)] - -namespace add_le_cancellable -protected lemma mul_tsub (h : add_le_cancellable (a * c)) : - a * (b - c) = a * b - a * c := -begin - cases total_of (≤) b c with hbc hcb, - { rw [tsub_eq_zero_iff_le.2 hbc, mul_zero, tsub_eq_zero_iff_le.2 (mul_le_mul_left' hbc a)] }, - { apply h.eq_tsub_of_add_eq, rw [← mul_add, tsub_add_cancel_of_le hcb] } -end - -protected lemma tsub_mul (h : add_le_cancellable (b * c)) : (a - b) * c = a * c - b * c := -by { simp only [mul_comm _ c] at *, exact h.mul_tsub } - -end add_le_cancellable - -variables [contravariant_class α α (+) (≤)] - -lemma mul_tsub (a b c : α) : a * (b - c) = a * b - a * c := -contravariant.add_le_cancellable.mul_tsub - -lemma tsub_mul (a b c : α) : (a - b) * c = a * c - b * c := -contravariant.add_le_cancellable.tsub_mul - -end sub - -/-! ### Structures involving `*` and `0` on `with_top` and `with_bot` - -The main results of this section are `with_top.canonically_ordered_comm_semiring` and -`with_bot.comm_monoid_with_zero`. --/ - -namespace with_top - -instance [nonempty α] : nontrivial (with_top α) := -option.nontrivial - -variable [decidable_eq α] - -section has_mul - -variables [has_zero α] [has_mul α] - -instance : mul_zero_class (with_top α) := -{ zero := 0, - mul := λm n, if m = 0 ∨ n = 0 then 0 else m.bind (λa, n.bind $ λb, ↑(a * b)), - zero_mul := assume a, if_pos $ or.inl rfl, - mul_zero := assume a, if_pos $ or.inr rfl } - -lemma mul_def {a b : with_top α} : - a * b = if a = 0 ∨ b = 0 then 0 else a.bind (λa, b.bind $ λb, ↑(a * b)) := rfl - -@[simp] lemma mul_top {a : with_top α} (h : a ≠ 0) : a * ⊤ = ⊤ := -by cases a; simp [mul_def, h]; refl - -@[simp] lemma top_mul {a : with_top α} (h : a ≠ 0) : ⊤ * a = ⊤ := -by cases a; simp [mul_def, h]; refl - -@[simp] lemma top_mul_top : (⊤ * ⊤ : with_top α) = ⊤ := -top_mul top_ne_zero - -end has_mul - -section mul_zero_class - -variables [mul_zero_class α] - -@[norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_top α) = a * b := -decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha, -decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb, -by { simp [*, mul_def], refl } - -lemma mul_coe {b : α} (hb : b ≠ 0) : ∀{a : with_top α}, a * b = a.bind (λa:α, ↑(a * b)) -| none := show (if (⊤:with_top α) = 0 ∨ (b:with_top α) = 0 then 0 else ⊤ : with_top α) = ⊤, - by simp [hb] -| (some a) := show ↑a * ↑b = ↑(a * b), from coe_mul.symm - -@[simp] lemma mul_eq_top_iff {a b : with_top α} : a * b = ⊤ ↔ (a ≠ 0 ∧ b = ⊤) ∨ (a = ⊤ ∧ b ≠ 0) := -begin - cases a; cases b; simp only [none_eq_top, some_eq_coe], - { simp [← coe_mul] }, - { suffices : ⊤ * (b : with_top α) = ⊤ ↔ b ≠ 0, by simpa, - by_cases hb : b = 0; simp [hb] }, - { suffices : (a : with_top α) * ⊤ = ⊤ ↔ a ≠ 0, by simpa, - by_cases ha : a = 0; simp [ha] }, - { simp [← coe_mul] } -end - -lemma mul_lt_top [preorder α] {a b : with_top α} (ha : a ≠ ⊤) (hb : b ≠ ⊤) : a * b < ⊤ := -begin - lift a to α using ha, - lift b to α using hb, - simp only [← coe_mul, coe_lt_top] -end - -end mul_zero_class - -/-- `nontrivial α` is needed here as otherwise we have `1 * ⊤ = ⊤` but also `= 0 * ⊤ = 0`. -/ -instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_top α) := -{ mul := (*), - one := 1, - zero := 0, - one_mul := λ a, match a with - | none := show ((1:α) : with_top α) * ⊤ = ⊤, by simp [-with_top.coe_one] - | (some a) := show ((1:α) : with_top α) * a = a, by simp [coe_mul.symm, -with_top.coe_one] - end, - mul_one := λ a, match a with - | none := show ⊤ * ((1:α) : with_top α) = ⊤, by simp [-with_top.coe_one] - | (some a) := show ↑a * ((1:α) : with_top α) = a, by simp [coe_mul.symm, -with_top.coe_one] - end, - .. with_top.mul_zero_class } - -instance [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_top α) := -⟨λ a b, by cases a; cases b; dsimp [mul_def]; split_ifs; - simp [*, none_eq_top, some_eq_coe, mul_eq_zero] at *⟩ - -instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_top α) := -{ mul := (*), - zero := 0, - mul_assoc := λ a b c, begin - cases a, - { by_cases hb : b = 0; by_cases hc : c = 0; - simp [*, none_eq_top] }, - cases b, - { by_cases ha : a = 0; by_cases hc : c = 0; - simp [*, none_eq_top, some_eq_coe] }, - cases c, - { by_cases ha : a = 0; by_cases hb : b = 0; - simp [*, none_eq_top, some_eq_coe] }, - simp [some_eq_coe, coe_mul.symm, mul_assoc] - end, - .. with_top.mul_zero_class } - -instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_top α) := -{ .. with_top.mul_zero_one_class, .. with_top.semigroup_with_zero } - -instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : - comm_monoid_with_zero (with_top α) := -{ mul := (*), - zero := 0, - mul_comm := λ a b, begin - by_cases ha : a = 0, { simp [ha] }, - by_cases hb : b = 0, { simp [hb] }, - simp [ha, hb, mul_def, option.bind_comm a b, mul_comm] - end, - .. with_top.monoid_with_zero } - -variables [canonically_ordered_comm_semiring α] - -private lemma distrib' (a b c : with_top α) : (a + b) * c = a * c + b * c := -begin - cases c, - { show (a + b) * ⊤ = a * ⊤ + b * ⊤, - by_cases ha : a = 0; simp [ha] }, - { show (a + b) * c = a * c + b * c, - by_cases hc : c = 0, { simp [hc] }, - simp [mul_coe hc], cases a; cases b, - repeat { refl <|> exact congr_arg some (add_mul _ _ _) } } -end - -/-- This instance requires `canonically_ordered_comm_semiring` as it is the smallest class -that derives from both `non_assoc_non_unital_semiring` and `canonically_ordered_add_monoid`, both -of which are required for distributivity. -/ -instance [nontrivial α] : comm_semiring (with_top α) := -{ right_distrib := distrib', - left_distrib := assume a b c, by rw [mul_comm, distrib', mul_comm b, mul_comm c]; refl, - .. with_top.add_comm_monoid, .. with_top.comm_monoid_with_zero,} - -instance [nontrivial α] : canonically_ordered_comm_semiring (with_top α) := -{ .. with_top.comm_semiring, - .. with_top.canonically_ordered_add_monoid, - .. with_top.no_zero_divisors, } - -end with_top - -namespace with_bot - -instance [nonempty α] : nontrivial (with_bot α) := -option.nontrivial - -variable [decidable_eq α] - -section has_mul - -variables [has_zero α] [has_mul α] - -instance : mul_zero_class (with_bot α) := -with_top.mul_zero_class - -lemma mul_def {a b : with_bot α} : - a * b = if a = 0 ∨ b = 0 then 0 else a.bind (λa, b.bind $ λb, ↑(a * b)) := rfl - -@[simp] lemma mul_bot {a : with_bot α} (h : a ≠ 0) : a * ⊥ = ⊥ := -with_top.mul_top h - -@[simp] lemma bot_mul {a : with_bot α} (h : a ≠ 0) : ⊥ * a = ⊥ := -with_top.top_mul h - -@[simp] lemma bot_mul_bot : (⊥ * ⊥ : with_bot α) = ⊥ := -with_top.top_mul_top - -end has_mul - -section mul_zero_class - -variables [mul_zero_class α] - -@[norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_bot α) = a * b := -decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha, -decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb, -by { simp [*, mul_def], refl } - -lemma mul_coe {b : α} (hb : b ≠ 0) {a : with_bot α} : a * b = a.bind (λa:α, ↑(a * b)) := -with_top.mul_coe hb - -@[simp] lemma mul_eq_bot_iff {a b : with_bot α} : a * b = ⊥ ↔ (a ≠ 0 ∧ b = ⊥) ∨ (a = ⊥ ∧ b ≠ 0) := -with_top.mul_eq_top_iff - -lemma bot_lt_mul [preorder α] {a b : with_bot α} (ha : ⊥ < a) (hb : ⊥ < b) : ⊥ < a * b := -begin - lift a to α using ne_bot_of_gt ha, - lift b to α using ne_bot_of_gt hb, - simp only [← coe_mul, bot_lt_coe], -end - -end mul_zero_class - -/-- `nontrivial α` is needed here as otherwise we have `1 * ⊥ = ⊥` but also `= 0 * ⊥ = 0`. -/ -instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_bot α) := -with_top.mul_zero_one_class - -instance [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_bot α) := -with_top.no_zero_divisors - -instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_bot α) := -with_top.semigroup_with_zero - -instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_bot α) := -with_top.monoid_with_zero - -instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : - comm_monoid_with_zero (with_bot α) := -with_top.comm_monoid_with_zero - -instance [canonically_ordered_comm_semiring α] [nontrivial α] : comm_semiring (with_bot α) := -with_top.comm_semiring - -end with_bot diff --git a/src/algebra/order/ring/abs.lean b/src/algebra/order/ring/abs.lean new file mode 100644 index 0000000000000..4dcdeda4b64dd --- /dev/null +++ b/src/algebra/order/ring/abs.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro +-/ + +import algebra.order.ring.defs +import algebra.ring.divisibility +import algebra.order.group.abs + +/-! +# Absolute values in linear ordered rings. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +section linear_ordered_ring +variables [linear_ordered_ring α] {a b c : α} + +@[simp] lemma abs_one : |(1 : α)| = 1 := abs_of_pos zero_lt_one +@[simp] lemma abs_two : |(2 : α)| = 2 := abs_of_pos zero_lt_two + +lemma abs_mul (a b : α) : |a * b| = |a| * |b| := +begin + rw [abs_eq (mul_nonneg (abs_nonneg a) (abs_nonneg b))], + cases le_total a 0 with ha ha; cases le_total b 0 with hb hb; + simp only [abs_of_nonpos, abs_of_nonneg, true_or, or_true, eq_self_iff_true, + neg_mul, mul_neg, neg_neg, *] +end + +/-- `abs` as a `monoid_with_zero_hom`. -/ +def abs_hom : α →*₀ α := ⟨abs, abs_zero, abs_one, abs_mul⟩ + +@[simp] lemma abs_mul_abs_self (a : α) : |a| * |a| = a * a := +abs_by_cases (λ x, x * x = a * a) rfl (neg_mul_neg a a) + +@[simp] lemma abs_mul_self (a : α) : |a * a| = a * a := +by rw [abs_mul, abs_mul_abs_self] + +@[simp] lemma abs_eq_self : |a| = a ↔ 0 ≤ a := by simp [abs_eq_max_neg] + +@[simp] lemma abs_eq_neg_self : |a| = -a ↔ a ≤ 0 := by simp [abs_eq_max_neg] + +/-- For an element `a` of a linear ordered ring, either `abs a = a` and `0 ≤ a`, + or `abs a = -a` and `a < 0`. + Use cases on this lemma to automate linarith in inequalities -/ +lemma abs_cases (a : α) : (|a| = a ∧ 0 ≤ a) ∨ (|a| = -a ∧ a < 0) := +begin + by_cases 0 ≤ a, + { left, + exact ⟨abs_eq_self.mpr h, h⟩ }, + { right, + push_neg at h, + exact ⟨abs_eq_neg_self.mpr (le_of_lt h), h⟩ } +end + +@[simp] lemma max_zero_add_max_neg_zero_eq_abs_self (a : α) : + max a 0 + max (-a) 0 = |a| := +begin + symmetry, + rcases le_total 0 a with ha|ha; + simp [ha], +end + +lemma abs_eq_iff_mul_self_eq : |a| = |b| ↔ a * a = b * b := +begin + rw [← abs_mul_abs_self, ← abs_mul_abs_self b], + exact (mul_self_inj (abs_nonneg a) (abs_nonneg b)).symm, +end + +lemma abs_lt_iff_mul_self_lt : |a| < |b| ↔ a * a < b * b := +begin + rw [← abs_mul_abs_self, ← abs_mul_abs_self b], + exact mul_self_lt_mul_self_iff (abs_nonneg a) (abs_nonneg b) +end + +lemma abs_le_iff_mul_self_le : |a| ≤ |b| ↔ a * a ≤ b * b := +begin + rw [← abs_mul_abs_self, ← abs_mul_abs_self b], + exact mul_self_le_mul_self_iff (abs_nonneg a) (abs_nonneg b) +end + +lemma abs_le_one_iff_mul_self_le_one : |a| ≤ 1 ↔ a * a ≤ 1 := +by simpa only [abs_one, one_mul] using @abs_le_iff_mul_self_le α _ a 1 + +end linear_ordered_ring + +section linear_ordered_comm_ring + +variables [linear_ordered_comm_ring α] {a b c d : α} + +lemma abs_sub_sq (a b : α) : |a - b| * |a - b| = a * a + b * b - (1 + 1) * a * b := +begin + rw abs_mul_abs_self, + simp only [mul_add, add_comm, add_left_comm, mul_comm, sub_eq_add_neg, + mul_one, mul_neg, neg_add_rev, neg_neg], +end + +end linear_ordered_comm_ring + +section +variables [ring α] [linear_order α] {a b : α} + +@[simp] lemma abs_dvd (a b : α) : |a| ∣ b ↔ a ∣ b := +by { cases abs_choice a with h h; simp only [h, neg_dvd] } + +lemma abs_dvd_self (a : α) : |a| ∣ a := +(abs_dvd a a).mpr (dvd_refl a) + +@[simp] lemma dvd_abs (a b : α) : a ∣ |b| ↔ a ∣ b := +by { cases abs_choice b with h h; simp only [h, dvd_neg] } + +lemma self_dvd_abs (a : α) : a ∣ |a| := +(dvd_abs a a).mpr (dvd_refl a) + +lemma abs_dvd_abs (a b : α) : |a| ∣ |b| ↔ a ∣ b := +(abs_dvd _ _).trans (dvd_abs _ _) + +end diff --git a/src/algebra/order/ring/canonical.lean b/src/algebra/order/ring/canonical.lean new file mode 100644 index 0000000000000..c9a037c59efd2 --- /dev/null +++ b/src/algebra/order/ring/canonical.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro +-/ +import algebra.order.ring.defs +import algebra.order.sub.canonical +import group_theory.group_action.defs + +/-! +# Canoncially ordered rings and semirings. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +* `canonically_ordered_comm_semiring` + - `canonically_ordered_add_monoid` & multiplication & `*` respects `≤` & no zero divisors + - `comm_semiring` & `a ≤ b ↔ ∃ c, b = a + c` & no zero divisors + +## TODO + +We're still missing some typeclasses, like +* `canonically_ordered_semiring` +They have yet to come up in practice. +-/ + +open function + +set_option old_structure_cmd true + +universe u +variables {α : Type u} {β : Type*} + + +/-- A canonically ordered commutative semiring is an ordered, commutative semiring in which `a ≤ b` +iff there exists `c` with `b = a + c`. This is satisfied by the natural numbers, for example, but +not the integers or other ordered groups. -/ +@[protect_proj, ancestor canonically_ordered_add_monoid comm_semiring] +class canonically_ordered_comm_semiring (α : Type*) extends + canonically_ordered_add_monoid α, comm_semiring α := +(eq_zero_or_eq_zero_of_mul_eq_zero : ∀ {a b : α}, a * b = 0 → a = 0 ∨ b = 0) + +section strict_ordered_semiring +variables [strict_ordered_semiring α] {a b c d : α} + +section has_exists_add_of_le +variables [has_exists_add_of_le α] + +/-- Binary **rearrangement inequality**. -/ +lemma mul_add_mul_le_mul_add_mul (hab : a ≤ b) (hcd : c ≤ d) : a * d + b * c ≤ a * c + b * d := +begin + obtain ⟨b, rfl⟩ := exists_add_of_le hab, + obtain ⟨d, rfl⟩ := exists_add_of_le hcd, + rw [mul_add, add_right_comm, mul_add, ←add_assoc], + exact add_le_add_left (mul_le_mul_of_nonneg_right hab $ (le_add_iff_nonneg_right _).1 hcd) _, +end + +/-- Binary **rearrangement inequality**. -/ +lemma mul_add_mul_le_mul_add_mul' (hba : b ≤ a) (hdc : d ≤ c) : a • d + b • c ≤ a • c + b • d := +by { rw [add_comm (a • d), add_comm (a • c)], exact mul_add_mul_le_mul_add_mul hba hdc } + +/-- Binary strict **rearrangement inequality**. -/ +lemma mul_add_mul_lt_mul_add_mul (hab : a < b) (hcd : c < d) : a * d + b * c < a * c + b * d := +begin + obtain ⟨b, rfl⟩ := exists_add_of_le hab.le, + obtain ⟨d, rfl⟩ := exists_add_of_le hcd.le, + rw [mul_add, add_right_comm, mul_add, ←add_assoc], + exact add_lt_add_left (mul_lt_mul_of_pos_right hab $ (lt_add_iff_pos_right _).1 hcd) _, +end + +/-- Binary **rearrangement inequality**. -/ +lemma mul_add_mul_lt_mul_add_mul' (hba : b < a) (hdc : d < c) : a • d + b • c < a • c + b • d := +by { rw [add_comm (a • d), add_comm (a • c)], exact mul_add_mul_lt_mul_add_mul hba hdc } + +end has_exists_add_of_le + +end strict_ordered_semiring + +namespace canonically_ordered_comm_semiring +variables [canonically_ordered_comm_semiring α] {a b : α} + +@[priority 100] -- see Note [lower instance priority] +instance to_no_zero_divisors : no_zero_divisors α := +⟨λ a b h, canonically_ordered_comm_semiring.eq_zero_or_eq_zero_of_mul_eq_zero h⟩ + +@[priority 100] -- see Note [lower instance priority] +instance to_covariant_mul_le : covariant_class α α (*) (≤) := +begin + refine ⟨λ a b c h, _⟩, + rcases exists_add_of_le h with ⟨c, rfl⟩, + rw mul_add, + apply self_le_add_right +end + +@[priority 100] -- see Note [lower instance priority] +instance to_ordered_comm_monoid : ordered_comm_monoid α := +{ mul_le_mul_left := λ _ _, mul_le_mul_left', + .. ‹canonically_ordered_comm_semiring α› } + +@[priority 100] -- see Note [lower instance priority] +instance to_ordered_comm_semiring : ordered_comm_semiring α := +{ zero_le_one := zero_le _, + mul_le_mul_of_nonneg_left := λ a b c h _, mul_le_mul_left' h _, + mul_le_mul_of_nonneg_right := λ a b c h _, mul_le_mul_right' h _, + ..‹canonically_ordered_comm_semiring α› } + +@[simp] lemma mul_pos : 0 < a * b ↔ (0 < a) ∧ (0 < b) := +by simp only [pos_iff_ne_zero, ne.def, mul_eq_zero, not_or_distrib] + + +end canonically_ordered_comm_semiring + +section sub + +variables [canonically_ordered_comm_semiring α] {a b c : α} +variables [has_sub α] [has_ordered_sub α] + +variables [is_total α (≤)] + +namespace add_le_cancellable +protected lemma mul_tsub (h : add_le_cancellable (a * c)) : + a * (b - c) = a * b - a * c := +begin + cases total_of (≤) b c with hbc hcb, + { rw [tsub_eq_zero_iff_le.2 hbc, mul_zero, tsub_eq_zero_iff_le.2 (mul_le_mul_left' hbc a)] }, + { apply h.eq_tsub_of_add_eq, rw [← mul_add, tsub_add_cancel_of_le hcb] } +end + +protected lemma tsub_mul (h : add_le_cancellable (b * c)) : (a - b) * c = a * c - b * c := +by { simp only [mul_comm _ c] at *, exact h.mul_tsub } + +end add_le_cancellable + +variables [contravariant_class α α (+) (≤)] + +lemma mul_tsub (a b c : α) : a * (b - c) = a * b - a * c := +contravariant.add_le_cancellable.mul_tsub + +lemma tsub_mul (a b c : α) : (a - b) * c = a * c - b * c := +contravariant.add_le_cancellable.tsub_mul + +end sub diff --git a/src/algebra/order/ring/char_zero.lean b/src/algebra/order/ring/char_zero.lean new file mode 100644 index 0000000000000..abff0e877ff3d --- /dev/null +++ b/src/algebra/order/ring/char_zero.lean @@ -0,0 +1,21 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro +-/ +import algebra.char_zero.defs +import algebra.order.ring.defs + +/-! +# Strict ordered semiring have characteristic zero + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +@[priority 100] -- see Note [lower instance priority] +instance strict_ordered_semiring.to_char_zero [strict_ordered_semiring α] : char_zero α := +⟨strict_mono.injective $ strict_mono_nat_of_lt_succ $ λ n, + by { rw [nat.cast_succ], apply lt_add_one }⟩ diff --git a/src/algebra/order/ring/cone.lean b/src/algebra/order/ring/cone.lean new file mode 100644 index 0000000000000..ee0647139a646 --- /dev/null +++ b/src/algebra/order/ring/cone.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro +-/ +import algebra.order.ring.defs + +/-! +# Constructing an ordered ring from a ring with a specified positive cone. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +/-! ### Positive cones -/ + +set_option old_structure_cmd true + +variables {α : Type*} [ring α] [nontrivial α] + +namespace ring + +/-- A positive cone in a ring consists of a positive cone in underlying `add_comm_group`, +which contains `1` and such that the positive elements are closed under multiplication. -/ +@[nolint has_nonempty_instance] +structure positive_cone (α : Type*) [ring α] extends add_comm_group.positive_cone α := +(one_nonneg : nonneg 1) +(mul_pos : ∀ (a b), pos a → pos b → pos (a * b)) + +/-- Forget that a positive cone in a ring respects the multiplicative structure. -/ +add_decl_doc positive_cone.to_positive_cone + +/-- A total positive cone in a nontrivial ring induces a linear order. -/ +@[nolint has_nonempty_instance] +structure total_positive_cone (α : Type*) [ring α] + extends positive_cone α, add_comm_group.total_positive_cone α + +/-- Forget that a `total_positive_cone` in a ring is total. -/ +add_decl_doc total_positive_cone.to_positive_cone + +/-- Forget that a `total_positive_cone` in a ring respects the multiplicative structure. -/ +add_decl_doc total_positive_cone.to_total_positive_cone + +lemma positive_cone.one_pos (C : positive_cone α) : C.pos 1 := +(C.pos_iff _).2 ⟨C.one_nonneg, λ h, one_ne_zero $ C.nonneg_antisymm C.one_nonneg h⟩ + +end ring + +open ring + +/-- Construct a `strict_ordered_ring` by designating a positive cone in an existing `ring`. -/ +def strict_ordered_ring.mk_of_positive_cone (C : positive_cone α) : strict_ordered_ring α := +{ exists_pair_ne := ⟨0, 1, λ h, by simpa [←h, C.pos_iff] using C.one_pos⟩, + zero_le_one := by { change C.nonneg (1 - 0), convert C.one_nonneg, simp, }, + mul_pos := λ x y xp yp, begin + change C.pos (x*y - 0), + convert C.mul_pos x y (by { convert xp, simp, }) (by { convert yp, simp, }), + simp, + end, + ..‹ring α›, + ..ordered_add_comm_group.mk_of_positive_cone C.to_positive_cone } + +/-- Construct a `linear_ordered_ring` by +designating a positive cone in an existing `ring`. -/ +def linear_ordered_ring.mk_of_positive_cone (C : total_positive_cone α) : linear_ordered_ring α := +{ ..strict_ordered_ring.mk_of_positive_cone C.to_positive_cone, + ..linear_ordered_add_comm_group.mk_of_positive_cone C.to_total_positive_cone, } diff --git a/src/algebra/order/ring/defs.lean b/src/algebra/order/ring/defs.lean new file mode 100644 index 0000000000000..24067d42c45fc --- /dev/null +++ b/src/algebra/order/ring/defs.lean @@ -0,0 +1,982 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Yaël Dillies +-/ + +import algebra.order.group.defs +import algebra.order.monoid.cancel.defs +import algebra.order.monoid.canonical.defs +import algebra.order.monoid.nat_cast +import algebra.order.monoid.with_zero.defs +import algebra.order.ring.lemmas +import algebra.ring.defs +import order.min_max +import tactic.nontriviality +import data.pi.algebra +import algebra.group.units + +/-! +# Ordered rings and semirings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file develops the basics of ordered (semi)rings. + +Each typeclass here comprises +* an algebraic class (`semiring`, `comm_semiring`, `ring`, `comm_ring`) +* an order class (`partial_order`, `linear_order`) +* assumptions on how both interact ((strict) monotonicity, canonicity) + +For short, +* "`+` respects `≤`" means "monotonicity of addition" +* "`+` respects `<`" means "strict monotonicity of addition" +* "`*` respects `≤`" means "monotonicity of multiplication by a nonnegative number". +* "`*` respects `<`" means "strict monotonicity of multiplication by a positive number". + +## Typeclasses + +* `ordered_semiring`: Semiring with a partial order such that `+` and `*` respect `≤`. +* `strict_ordered_semiring`: Nontrivial semiring with a partial order such that `+` and `*` respects + `<`. +* `ordered_comm_semiring`: Commutative semiring with a partial order such that `+` and `*` respect + `≤`. +* `strict_ordered_comm_semiring`: Nontrivial commutative semiring with a partial order such that `+` + and `*` respect `<`. +* `ordered_ring`: Ring with a partial order such that `+` respects `≤` and `*` respects `<`. +* `ordered_comm_ring`: Commutative ring with a partial order such that `+` respects `≤` and + `*` respects `<`. +* `linear_ordered_semiring`: Nontrivial semiring with a linear order such that `+` respects `≤` and + `*` respects `<`. +* `linear_ordered_comm_semiring`: Nontrivial commutative semiring with a linear order such that `+` + respects `≤` and `*` respects `<`. +* `linear_ordered_ring`: Nontrivial ring with a linear order such that `+` respects `≤` and `*` + respects `<`. +* `linear_ordered_comm_ring`: Nontrivial commutative ring with a linear order such that `+` respects + `≤` and `*` respects `<`. +* `canonically_ordered_comm_semiring`: Commutative semiring with a partial order such that `+` + respects `≤`, `*` respects `<`, and `a ≤ b ↔ ∃ c, b = a + c`. + +## Hierarchy + +The hardest part of proving order lemmas might be to figure out the correct generality and its +corresponding typeclass. Here's an attempt at demystifying it. For each typeclass, we list its +immediate predecessors and what conditions are added to each of them. + +* `ordered_semiring` + - `ordered_add_comm_monoid` & multiplication & `*` respects `≤` + - `semiring` & partial order structure & `+` respects `≤` & `*` respects `≤` +* `strict_ordered_semiring` + - `ordered_cancel_add_comm_monoid` & multiplication & `*` respects `<` & nontriviality + - `ordered_semiring` & `+` respects `<` & `*` respects `<` & nontriviality +* `ordered_comm_semiring` + - `ordered_semiring` & commutativity of multiplication + - `comm_semiring` & partial order structure & `+` respects `≤` & `*` respects `<` +* `strict_ordered_comm_semiring` + - `strict_ordered_semiring` & commutativity of multiplication + - `ordered_comm_semiring` & `+` respects `<` & `*` respects `<` & nontriviality +* `ordered_ring` + - `ordered_semiring` & additive inverses + - `ordered_add_comm_group` & multiplication & `*` respects `<` + - `ring` & partial order structure & `+` respects `≤` & `*` respects `<` +* `strict_ordered_ring` + - `strict_ordered_semiring` & additive inverses + - `ordered_semiring` & `+` respects `<` & `*` respects `<` & nontriviality +* `ordered_comm_ring` + - `ordered_ring` & commutativity of multiplication + - `ordered_comm_semiring` & additive inverses + - `comm_ring` & partial order structure & `+` respects `≤` & `*` respects `<` +* `strict_ordered_comm_ring` + - `strict_ordered_comm_semiring` & additive inverses + - `strict_ordered_ring` & commutativity of multiplication + - `ordered_comm_ring` & `+` respects `<` & `*` respects `<` & nontriviality +* `linear_ordered_semiring` + - `strict_ordered_semiring` & totality of the order + - `linear_ordered_add_comm_monoid` & multiplication & nontriviality & `*` respects `<` +* `linear_ordered_comm_semiring` + - `strict_ordered_comm_semiring` & totality of the order + - `linear_ordered_semiring` & commutativity of multiplication +* `linear_ordered_ring` + - `strict_ordered_ring` & totality of the order + - `linear_ordered_semiring` & additive inverses + - `linear_ordered_add_comm_group` & multiplication & `*` respects `<` + - `domain` & linear order structure +* `linear_ordered_comm_ring` + - `strict_ordered_comm_ring` & totality of the order + - `linear_ordered_ring` & commutativity of multiplication + - `linear_ordered_comm_semiring` & additive inverses + - `is_domain` & linear order structure + +-/ + +open function + +set_option old_structure_cmd true + +universe u +variables {α : Type u} {β : Type*} + +/-! Note that `order_dual` does not satisfy any of the ordered ring typeclasses due to the +`zero_le_one` field. -/ + +lemma add_one_le_two_mul [has_le α] [semiring α] [covariant_class α α (+) (≤)] + {a : α} (a1 : 1 ≤ a) : + a + 1 ≤ 2 * a := +calc a + 1 ≤ a + a : add_le_add_left a1 a + ... = 2 * a : (two_mul _).symm + +/-- An `ordered_semiring` is a semiring with a partial order such that addition is monotone and +multiplication by a nonnegative number is monotone. -/ +@[protect_proj, ancestor semiring ordered_add_comm_monoid] +class ordered_semiring (α : Type u) extends semiring α, ordered_add_comm_monoid α := +(zero_le_one : (0 : α) ≤ 1) +(mul_le_mul_of_nonneg_left : ∀ a b c : α, a ≤ b → 0 ≤ c → c * a ≤ c * b) +(mul_le_mul_of_nonneg_right : ∀ a b c : α, a ≤ b → 0 ≤ c → a * c ≤ b * c) + +/-- An `ordered_comm_semiring` is a commutative semiring with a partial order such that addition is +monotone and multiplication by a nonnegative number is monotone. -/ +@[protect_proj, ancestor ordered_semiring comm_semiring] +class ordered_comm_semiring (α : Type u) extends ordered_semiring α, comm_semiring α + +/-- An `ordered_ring` is a ring with a partial order such that addition is monotone and +multiplication by a nonnegative number is monotone. -/ +@[protect_proj, ancestor ring ordered_add_comm_group] +class ordered_ring (α : Type u) extends ring α, ordered_add_comm_group α := +(zero_le_one : 0 ≤ (1 : α)) +(mul_nonneg : ∀ a b : α, 0 ≤ a → 0 ≤ b → 0 ≤ a * b) + +/-- An `ordered_comm_ring` is a commutative ring with a partial order such that addition is monotone +and multiplication by a nonnegative number is monotone. -/ +@[protect_proj, ancestor ordered_ring comm_ring] +class ordered_comm_ring (α : Type u) extends ordered_ring α, comm_ring α + +/-- A `strict_ordered_semiring` is a nontrivial semiring with a partial order such that addition is +strictly monotone and multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor semiring ordered_cancel_add_comm_monoid nontrivial] +class strict_ordered_semiring (α : Type u) + extends semiring α, ordered_cancel_add_comm_monoid α, nontrivial α := +(zero_le_one : (0 : α) ≤ 1) +(mul_lt_mul_of_pos_left : ∀ a b c : α, a < b → 0 < c → c * a < c * b) +(mul_lt_mul_of_pos_right : ∀ a b c : α, a < b → 0 < c → a * c < b * c) + +/-- A `strict_ordered_comm_semiring` is a commutative semiring with a partial order such that +addition is strictly monotone and multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor strict_ordered_semiring comm_semiring] +class strict_ordered_comm_semiring (α : Type u) extends strict_ordered_semiring α, comm_semiring α + +/-- A `strict_ordered_ring` is a ring with a partial order such that addition is strictly monotone +and multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor ring ordered_add_comm_group nontrivial] +class strict_ordered_ring (α : Type u) extends ring α, ordered_add_comm_group α, nontrivial α := +(zero_le_one : 0 ≤ (1 : α)) +(mul_pos : ∀ a b : α, 0 < a → 0 < b → 0 < a * b) + +/-- A `strict_ordered_comm_ring` is a commutative ring with a partial order such that addition is +strictly monotone and multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor strict_ordered_ring comm_ring] +class strict_ordered_comm_ring (α : Type*) extends strict_ordered_ring α, comm_ring α + +/-- A `linear_ordered_semiring` is a nontrivial semiring with a linear order such that +addition is monotone and multiplication by a positive number is strictly monotone. -/ +/- It's not entirely clear we should assume `nontrivial` at this point; it would be reasonable to +explore changing this, but be warned that the instances involving `domain` may cause typeclass +search loops. -/ +@[protect_proj, ancestor strict_ordered_semiring linear_ordered_add_comm_monoid nontrivial] +class linear_ordered_semiring (α : Type u) + extends strict_ordered_semiring α, linear_ordered_add_comm_monoid α + +/-- A `linear_ordered_comm_semiring` is a nontrivial commutative semiring with a linear order such +that addition is monotone and multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor ordered_comm_semiring linear_ordered_semiring] +class linear_ordered_comm_semiring (α : Type*) + extends strict_ordered_comm_semiring α, linear_ordered_semiring α + +/-- A `linear_ordered_ring` is a ring with a linear order such that addition is monotone and +multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor strict_ordered_ring linear_order] +class linear_ordered_ring (α : Type u) extends strict_ordered_ring α, linear_order α + +/-- A `linear_ordered_comm_ring` is a commutative ring with a linear order such that addition is +monotone and multiplication by a positive number is strictly monotone. -/ +@[protect_proj, ancestor linear_ordered_ring comm_monoid] +class linear_ordered_comm_ring (α : Type u) extends linear_ordered_ring α, comm_monoid α + + +section ordered_semiring +variables [ordered_semiring α] {a b c d : α} + +@[priority 100] -- see Note [lower instance priority] +instance ordered_semiring.zero_le_one_class : zero_le_one_class α := +{ ..‹ordered_semiring α› } + +@[priority 200] -- see Note [lower instance priority] +instance ordered_semiring.to_pos_mul_mono : pos_mul_mono α := +⟨λ x a b h, ordered_semiring.mul_le_mul_of_nonneg_left _ _ _ h x.2⟩ + +@[priority 200] -- see Note [lower instance priority] +instance ordered_semiring.to_mul_pos_mono : mul_pos_mono α := +⟨λ x a b h, ordered_semiring.mul_le_mul_of_nonneg_right _ _ _ h x.2⟩ + +lemma bit1_mono : monotone (bit1 : α → α) := λ a b h, add_le_add_right (bit0_mono h) _ + +@[simp] lemma pow_nonneg (H : 0 ≤ a) : ∀ (n : ℕ), 0 ≤ a ^ n +| 0 := by { rw pow_zero, exact zero_le_one} +| (n+1) := by { rw pow_succ, exact mul_nonneg H (pow_nonneg _) } + +lemma add_le_mul_two_add (a2 : 2 ≤ a) (b0 : 0 ≤ b) : a + (2 + b) ≤ a * (2 + b) := +calc a + (2 + b) ≤ a + (a + a * b) : + add_le_add_left (add_le_add a2 $ le_mul_of_one_le_left b0 $ one_le_two.trans a2) a + ... ≤ a * (2 + b) : by rw [mul_add, mul_two, add_assoc] + +lemma one_le_mul_of_one_le_of_one_le (ha : 1 ≤ a) (hb : 1 ≤ b) : (1 : α) ≤ a * b := +left.one_le_mul_of_le_of_le ha hb $ zero_le_one.trans ha + +section monotone +variables [preorder β] {f g : β → α} + +lemma monotone_mul_left_of_nonneg (ha : 0 ≤ a) : monotone (λ x, a * x) := +λ b c h, mul_le_mul_of_nonneg_left h ha + +lemma monotone_mul_right_of_nonneg (ha : 0 ≤ a) : monotone (λ x, x * a) := +λ b c h, mul_le_mul_of_nonneg_right h ha + +lemma monotone.mul_const (hf : monotone f) (ha : 0 ≤ a) : monotone (λ x, f x * a) := +(monotone_mul_right_of_nonneg ha).comp hf + +lemma monotone.const_mul (hf : monotone f) (ha : 0 ≤ a) : monotone (λ x, a * f x) := +(monotone_mul_left_of_nonneg ha).comp hf + +lemma antitone.mul_const (hf : antitone f) (ha : 0 ≤ a) : antitone (λ x, f x * a) := +(monotone_mul_right_of_nonneg ha).comp_antitone hf + +lemma antitone.const_mul (hf : antitone f) (ha : 0 ≤ a) : antitone (λ x, a * f x) := +(monotone_mul_left_of_nonneg ha).comp_antitone hf + +lemma monotone.mul (hf : monotone f) (hg : monotone g) (hf₀ : ∀ x, 0 ≤ f x) (hg₀ : ∀ x, 0 ≤ g x) : + monotone (f * g) := +λ b c h, mul_le_mul (hf h) (hg h) (hg₀ _) (hf₀ _) + +end monotone + +lemma bit1_pos [nontrivial α] (h : 0 ≤ a) : 0 < bit1 a := +zero_lt_one.trans_le $ bit1_zero.symm.trans_le $ bit1_mono h + +lemma bit1_pos' (h : 0 < a) : 0 < bit1 a := by { nontriviality, exact bit1_pos h.le } + +lemma mul_le_one (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 := +one_mul (1 : α) ▸ mul_le_mul ha hb hb' zero_le_one + +lemma one_lt_mul_of_le_of_lt (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b := +hb.trans_le $ le_mul_of_one_le_left (zero_le_one.trans hb.le) ha + +lemma one_lt_mul_of_lt_of_le (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b := +ha.trans_le $ le_mul_of_one_le_right (zero_le_one.trans ha.le) hb + +alias one_lt_mul_of_le_of_lt ← one_lt_mul + +lemma mul_lt_one_of_nonneg_of_lt_one_left (ha₀ : 0 ≤ a) (ha : a < 1) (hb : b ≤ 1) : a * b < 1 := +(mul_le_of_le_one_right ha₀ hb).trans_lt ha + +lemma mul_lt_one_of_nonneg_of_lt_one_right (ha : a ≤ 1) (hb₀ : 0 ≤ b) (hb : b < 1) : a * b < 1 := +(mul_le_of_le_one_left hb₀ ha).trans_lt hb + +end ordered_semiring + +section ordered_ring +variables [ordered_ring α] {a b c d : α} + +@[priority 100] -- see Note [lower instance priority] +instance ordered_ring.to_ordered_semiring : ordered_semiring α := +{ mul_le_mul_of_nonneg_left := λ a b c h hc, + by simpa only [mul_sub, sub_nonneg] using ordered_ring.mul_nonneg _ _ hc (sub_nonneg.2 h), + mul_le_mul_of_nonneg_right := λ a b c h hc, + by simpa only [sub_mul, sub_nonneg] using ordered_ring.mul_nonneg _ _ (sub_nonneg.2 h) hc, + ..‹ordered_ring α›, ..ring.to_semiring } + +lemma mul_le_mul_of_nonpos_left (h : b ≤ a) (hc : c ≤ 0) : c * a ≤ c * b := +by simpa only [neg_mul, neg_le_neg_iff] using mul_le_mul_of_nonneg_left h (neg_nonneg.2 hc) + +lemma mul_le_mul_of_nonpos_right (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := +by simpa only [mul_neg, neg_le_neg_iff] using mul_le_mul_of_nonneg_right h (neg_nonneg.2 hc) + +lemma mul_nonneg_of_nonpos_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := +by simpa only [zero_mul] using mul_le_mul_of_nonpos_right ha hb + +lemma mul_le_mul_of_nonneg_of_nonpos (hca : c ≤ a) (hbd : b ≤ d) (hc : 0 ≤ c) (hb : b ≤ 0) : + a * b ≤ c * d := +(mul_le_mul_of_nonpos_right hca hb).trans $ mul_le_mul_of_nonneg_left hbd hc + +lemma mul_le_mul_of_nonneg_of_nonpos' (hca : c ≤ a) (hbd : b ≤ d) (ha : 0 ≤ a) (hd : d ≤ 0) : + a * b ≤ c * d := +(mul_le_mul_of_nonneg_left hbd ha).trans $ mul_le_mul_of_nonpos_right hca hd + +lemma mul_le_mul_of_nonpos_of_nonneg (hac : a ≤ c) (hdb : d ≤ b) (hc : c ≤ 0) (hb : 0 ≤ b) : + a * b ≤ c * d := +(mul_le_mul_of_nonneg_right hac hb).trans $ mul_le_mul_of_nonpos_left hdb hc + +lemma mul_le_mul_of_nonpos_of_nonneg' (hca : c ≤ a) (hbd : b ≤ d) (ha : 0 ≤ a) (hd : d ≤ 0) : + a * b ≤ c * d := +(mul_le_mul_of_nonneg_left hbd ha).trans $ mul_le_mul_of_nonpos_right hca hd + +lemma mul_le_mul_of_nonpos_of_nonpos (hca : c ≤ a) (hdb : d ≤ b) (hc : c ≤ 0) (hb : b ≤ 0) : + a * b ≤ c * d := +(mul_le_mul_of_nonpos_right hca hb).trans $ mul_le_mul_of_nonpos_left hdb hc + +lemma mul_le_mul_of_nonpos_of_nonpos' (hca : c ≤ a) (hdb : d ≤ b) (ha : a ≤ 0) (hd : d ≤ 0) : + a * b ≤ c * d := +(mul_le_mul_of_nonpos_left hdb ha).trans $ mul_le_mul_of_nonpos_right hca hd + +/-- Variant of `mul_le_of_le_one_left` for `b` non-positive instead of non-negative. -/ +lemma le_mul_of_le_one_left (hb : b ≤ 0) (h : a ≤ 1) : b ≤ a * b := +by simpa only [one_mul] using mul_le_mul_of_nonpos_right h hb + +/-- Variant of `le_mul_of_one_le_left` for `b` non-positive instead of non-negative. -/ +lemma mul_le_of_one_le_left (hb : b ≤ 0) (h : 1 ≤ a) : a * b ≤ b := +by simpa only [one_mul] using mul_le_mul_of_nonpos_right h hb + +/-- Variant of `mul_le_of_le_one_right` for `a` non-positive instead of non-negative. -/ +lemma le_mul_of_le_one_right (ha : a ≤ 0) (h : b ≤ 1) : a ≤ a * b := +by simpa only [mul_one] using mul_le_mul_of_nonpos_left h ha + +/-- Variant of `le_mul_of_one_le_right` for `a` non-positive instead of non-negative. -/ +lemma mul_le_of_one_le_right (ha : a ≤ 0) (h : 1 ≤ b) : a * b ≤ a := +by simpa only [mul_one] using mul_le_mul_of_nonpos_left h ha + +section monotone +variables [preorder β] {f g : β → α} + +lemma antitone_mul_left {a : α} (ha : a ≤ 0) : antitone ((*) a) := +λ b c b_le_c, mul_le_mul_of_nonpos_left b_le_c ha + +lemma antitone_mul_right {a : α} (ha : a ≤ 0) : antitone (λ x, x * a) := +λ b c b_le_c, mul_le_mul_of_nonpos_right b_le_c ha + +lemma monotone.const_mul_of_nonpos (hf : monotone f) (ha : a ≤ 0) : antitone (λ x, a * f x) := +(antitone_mul_left ha).comp_monotone hf + +lemma monotone.mul_const_of_nonpos (hf : monotone f) (ha : a ≤ 0) : antitone (λ x, f x * a) := +(antitone_mul_right ha).comp_monotone hf + +lemma antitone.const_mul_of_nonpos (hf : antitone f) (ha : a ≤ 0) : monotone (λ x, a * f x) := +(antitone_mul_left ha).comp hf + +lemma antitone.mul_const_of_nonpos (hf : antitone f) (ha : a ≤ 0) : monotone (λ x, f x * a) := +(antitone_mul_right ha).comp hf + +lemma antitone.mul_monotone (hf : antitone f) (hg : monotone g) (hf₀ : ∀ x, f x ≤ 0) + (hg₀ : ∀ x, 0 ≤ g x) : + antitone (f * g) := +λ b c h, mul_le_mul_of_nonpos_of_nonneg (hf h) (hg h) (hf₀ _) (hg₀ _) + +lemma monotone.mul_antitone (hf : monotone f) (hg : antitone g) (hf₀ : ∀ x, 0 ≤ f x) + (hg₀ : ∀ x, g x ≤ 0) : + antitone (f * g) := +λ b c h, mul_le_mul_of_nonneg_of_nonpos (hf h) (hg h) (hf₀ _) (hg₀ _) + +lemma antitone.mul (hf : antitone f) (hg : antitone g) (hf₀ : ∀ x, f x ≤ 0) (hg₀ : ∀ x, g x ≤ 0) : + monotone (f * g) := +λ b c h, mul_le_mul_of_nonpos_of_nonpos (hf h) (hg h) (hf₀ _) (hg₀ _) + +end monotone + +lemma le_iff_exists_nonneg_add (a b : α) : a ≤ b ↔ ∃ c ≥ 0, b = a + c := +⟨λ h, ⟨b - a, sub_nonneg.mpr h, by simp⟩, + λ ⟨c, hc, h⟩, by { rw [h, le_add_iff_nonneg_right], exact hc }⟩ + +end ordered_ring + +section ordered_comm_ring +variables [ordered_comm_ring α] + +@[priority 100] -- See note [lower instance priority] +instance ordered_comm_ring.to_ordered_comm_semiring : ordered_comm_semiring α := +{ ..ordered_ring.to_ordered_semiring, ..‹ordered_comm_ring α› } + +end ordered_comm_ring + +section strict_ordered_semiring +variables [strict_ordered_semiring α] {a b c d : α} + +@[priority 200] -- see Note [lower instance priority] +instance strict_ordered_semiring.to_pos_mul_strict_mono : pos_mul_strict_mono α := +⟨λ x a b h, strict_ordered_semiring.mul_lt_mul_of_pos_left _ _ _ h x.prop⟩ + +@[priority 200] -- see Note [lower instance priority] +instance strict_ordered_semiring.to_mul_pos_strict_mono : mul_pos_strict_mono α := +⟨λ x a b h, strict_ordered_semiring.mul_lt_mul_of_pos_right _ _ _ h x.prop⟩ + +/-- A choice-free version of `strict_ordered_semiring.to_ordered_semiring` to avoid using choice in +basic `nat` lemmas. -/ +@[reducible] -- See note [reducible non-instances] +def strict_ordered_semiring.to_ordered_semiring' [@decidable_rel α (≤)] : ordered_semiring α := +{ mul_le_mul_of_nonneg_left := λ a b c hab hc, begin + obtain rfl | hab := decidable.eq_or_lt_of_le hab, + { refl }, + obtain rfl | hc := decidable.eq_or_lt_of_le hc, + { simp }, + { exact (mul_lt_mul_of_pos_left hab hc).le } + end, + mul_le_mul_of_nonneg_right := λ a b c hab hc, begin + obtain rfl | hab := decidable.eq_or_lt_of_le hab, + { refl }, + obtain rfl | hc := decidable.eq_or_lt_of_le hc, + { simp }, + { exact (mul_lt_mul_of_pos_right hab hc).le } + end, + ..‹strict_ordered_semiring α› } + +@[priority 100] -- see Note [lower instance priority] +instance strict_ordered_semiring.to_ordered_semiring : ordered_semiring α := +{ mul_le_mul_of_nonneg_left := λ _ _ _, begin + letI := @strict_ordered_semiring.to_ordered_semiring' α _ (classical.dec_rel _), + exact mul_le_mul_of_nonneg_left, + end, + mul_le_mul_of_nonneg_right := λ _ _ _, begin + letI := @strict_ordered_semiring.to_ordered_semiring' α _ (classical.dec_rel _), + exact mul_le_mul_of_nonneg_right, + end, + ..‹strict_ordered_semiring α› } + +lemma mul_lt_mul (hac : a < c) (hbd : b ≤ d) (hb : 0 < b) (hc : 0 ≤ c) : a * b < c * d := +(mul_lt_mul_of_pos_right hac hb).trans_le $ mul_le_mul_of_nonneg_left hbd hc + +lemma mul_lt_mul' (hac : a ≤ c) (hbd : b < d) (hb : 0 ≤ b) (hc : 0 < c) : a * b < c * d := +(mul_le_mul_of_nonneg_right hac hb).trans_lt $ mul_lt_mul_of_pos_left hbd hc + +@[simp] theorem pow_pos (H : 0 < a) : ∀ (n : ℕ), 0 < a ^ n +| 0 := by { nontriviality, rw pow_zero, exact zero_lt_one } +| (n+1) := by { rw pow_succ, exact mul_pos H (pow_pos _) } + +lemma mul_self_lt_mul_self (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b := +mul_lt_mul' h2.le h2 h1 $ h1.trans_lt h2 + +-- In the next lemma, we used to write `set.Ici 0` instead of `{x | 0 ≤ x}`. +-- As this lemma is not used outside this file, +-- and the import for `set.Ici` is not otherwise needed until later, +-- we choose not to use it here. +lemma strict_mono_on_mul_self : strict_mono_on (λ x : α, x * x) {x | 0 ≤ x} := +λ x hx y hy hxy, mul_self_lt_mul_self hx hxy + +-- See Note [decidable namespace] +protected lemma decidable.mul_lt_mul'' [@decidable_rel α (≤)] + (h1 : a < c) (h2 : b < d) (h3 : 0 ≤ a) (h4 : 0 ≤ b) : a * b < c * d := +h4.lt_or_eq_dec.elim + (λ b0, mul_lt_mul h1 h2.le b0 $ h3.trans h1.le) + (λ b0, by rw [← b0, mul_zero]; exact + mul_pos (h3.trans_lt h1) (h4.trans_lt h2)) + +lemma mul_lt_mul'' : a < c → b < d → 0 ≤ a → 0 ≤ b → a * b < c * d := +by classical; exact decidable.mul_lt_mul'' + +lemma lt_mul_left (hn : 0 < a) (hm : 1 < b) : a < b * a := +by { convert mul_lt_mul_of_pos_right hm hn, rw one_mul } + +lemma lt_mul_right (hn : 0 < a) (hm : 1 < b) : a < a * b := +by { convert mul_lt_mul_of_pos_left hm hn, rw mul_one } + +lemma lt_mul_self (hn : 1 < a) : a < a * a := +lt_mul_left (hn.trans_le' zero_le_one) hn + +section monotone +variables [preorder β] {f g : β → α} + +lemma strict_mono_mul_left_of_pos (ha : 0 < a) : strict_mono (λ x, a * x) := +assume b c b_lt_c, mul_lt_mul_of_pos_left b_lt_c ha + +lemma strict_mono_mul_right_of_pos (ha : 0 < a) : strict_mono (λ x, x * a) := +assume b c b_lt_c, mul_lt_mul_of_pos_right b_lt_c ha + +lemma strict_mono.mul_const (hf : strict_mono f) (ha : 0 < a) : + strict_mono (λ x, (f x) * a) := +(strict_mono_mul_right_of_pos ha).comp hf + +lemma strict_mono.const_mul (hf : strict_mono f) (ha : 0 < a) : + strict_mono (λ x, a * (f x)) := +(strict_mono_mul_left_of_pos ha).comp hf + +lemma strict_anti.mul_const (hf : strict_anti f) (ha : 0 < a) : strict_anti (λ x, f x * a) := +(strict_mono_mul_right_of_pos ha).comp_strict_anti hf + +lemma strict_anti.const_mul (hf : strict_anti f) (ha : 0 < a) : strict_anti (λ x, a * f x) := +(strict_mono_mul_left_of_pos ha).comp_strict_anti hf + +lemma strict_mono.mul_monotone (hf : strict_mono f) (hg : monotone g) (hf₀ : ∀ x, 0 ≤ f x) + (hg₀ : ∀ x, 0 < g x) : + strict_mono (f * g) := +λ b c h, mul_lt_mul (hf h) (hg h.le) (hg₀ _) (hf₀ _) + +lemma monotone.mul_strict_mono (hf : monotone f) (hg : strict_mono g) (hf₀ : ∀ x, 0 < f x) + (hg₀ : ∀ x, 0 ≤ g x) : + strict_mono (f * g) := +λ b c h, mul_lt_mul' (hf h.le) (hg h) (hg₀ _) (hf₀ _) + +lemma strict_mono.mul (hf : strict_mono f) (hg : strict_mono g) (hf₀ : ∀ x, 0 ≤ f x) + (hg₀ : ∀ x, 0 ≤ g x) : + strict_mono (f * g) := +λ b c h, mul_lt_mul'' (hf h) (hg h) (hf₀ _) (hg₀ _) + +end monotone + +lemma lt_two_mul_self (ha : 0 < a) : a < 2 * a := lt_mul_of_one_lt_left ha one_lt_two + +@[priority 100] -- see Note [lower instance priority] +instance strict_ordered_semiring.to_no_max_order : no_max_order α := +⟨λ a, ⟨a + 1, lt_add_of_pos_right _ one_pos⟩⟩ + +end strict_ordered_semiring + +section strict_ordered_comm_semiring +variables [strict_ordered_comm_semiring α] + +/-- A choice-free version of `strict_ordered_comm_semiring.to_ordered_comm_semiring` to avoid using +choice in basic `nat` lemmas. -/ +@[reducible] -- See note [reducible non-instances] +def strict_ordered_comm_semiring.to_ordered_comm_semiring' [@decidable_rel α (≤)] : + ordered_comm_semiring α := +{ ..‹strict_ordered_comm_semiring α›, ..strict_ordered_semiring.to_ordered_semiring' } + +@[priority 100] -- see Note [lower instance priority] +instance strict_ordered_comm_semiring.to_ordered_comm_semiring : ordered_comm_semiring α := +{ ..‹strict_ordered_comm_semiring α›, ..strict_ordered_semiring.to_ordered_semiring } + +end strict_ordered_comm_semiring + +section strict_ordered_ring +variables [strict_ordered_ring α] {a b c : α} + +@[priority 100] -- see Note [lower instance priority] +instance strict_ordered_ring.to_strict_ordered_semiring : strict_ordered_semiring α := +{ le_of_add_le_add_left := @le_of_add_le_add_left α _ _ _, + mul_lt_mul_of_pos_left := λ a b c h hc, + by simpa only [mul_sub, sub_pos] using strict_ordered_ring.mul_pos _ _ hc (sub_pos.2 h), + mul_lt_mul_of_pos_right := λ a b c h hc, + by simpa only [sub_mul, sub_pos] using strict_ordered_ring.mul_pos _ _ (sub_pos.2 h) hc, + ..‹strict_ordered_ring α›, ..ring.to_semiring } + +/-- A choice-free version of `strict_ordered_ring.to_ordered_ring` to avoid using choice in basic +`int` lemmas. -/ +@[reducible] -- See note [reducible non-instances] +def strict_ordered_ring.to_ordered_ring' [@decidable_rel α (≤)] : ordered_ring α := +{ mul_nonneg := λ a b ha hb, begin + obtain ha | ha := decidable.eq_or_lt_of_le ha, + { rw [←ha, zero_mul] }, + obtain hb | hb := decidable.eq_or_lt_of_le hb, + { rw [←hb, mul_zero] }, + { exact (strict_ordered_ring.mul_pos _ _ ha hb).le } + end, + ..‹strict_ordered_ring α›, ..ring.to_semiring } + +@[priority 100] -- see Note [lower instance priority] +instance strict_ordered_ring.to_ordered_ring : ordered_ring α := +{ mul_nonneg := λ a b, begin + letI := @strict_ordered_ring.to_ordered_ring' α _ (classical.dec_rel _), + exact mul_nonneg, + end, + ..‹strict_ordered_ring α› } + +lemma mul_lt_mul_of_neg_left (h : b < a) (hc : c < 0) : c * a < c * b := +by simpa only [neg_mul, neg_lt_neg_iff] using mul_lt_mul_of_pos_left h (neg_pos_of_neg hc) + +lemma mul_lt_mul_of_neg_right (h : b < a) (hc : c < 0) : a * c < b * c := +by simpa only [mul_neg, neg_lt_neg_iff] using mul_lt_mul_of_pos_right h (neg_pos_of_neg hc) + +lemma mul_pos_of_neg_of_neg {a b : α} (ha : a < 0) (hb : b < 0) : 0 < a * b := +by simpa only [zero_mul] using mul_lt_mul_of_neg_right ha hb + +/-- Variant of `mul_lt_of_lt_one_left` for `b` negative instead of positive. -/ +lemma lt_mul_of_lt_one_left (hb : b < 0) (h : a < 1) : b < a * b := +by simpa only [one_mul] using mul_lt_mul_of_neg_right h hb + +/-- Variant of `lt_mul_of_one_lt_left` for `b` negative instead of positive. -/ +lemma mul_lt_of_one_lt_left (hb : b < 0) (h : 1 < a) : a * b < b := +by simpa only [one_mul] using mul_lt_mul_of_neg_right h hb + +/-- Variant of `mul_lt_of_lt_one_right` for `a` negative instead of positive. -/ +lemma lt_mul_of_lt_one_right (ha : a < 0) (h : b < 1) : a < a * b := +by simpa only [mul_one] using mul_lt_mul_of_neg_left h ha + +/-- Variant of `lt_mul_of_lt_one_right` for `a` negative instead of positive. -/ +lemma mul_lt_of_one_lt_right (ha : a < 0) (h : 1 < b) : a * b < a := +by simpa only [mul_one] using mul_lt_mul_of_neg_left h ha + +section monotone +variables [preorder β] {f g : β → α} + +lemma strict_anti_mul_left {a : α} (ha : a < 0) : strict_anti ((*) a) := +λ b c b_lt_c, mul_lt_mul_of_neg_left b_lt_c ha + +lemma strict_anti_mul_right {a : α} (ha : a < 0) : strict_anti (λ x, x * a) := +λ b c b_lt_c, mul_lt_mul_of_neg_right b_lt_c ha + +lemma strict_mono.const_mul_of_neg (hf : strict_mono f) (ha : a < 0) : strict_anti (λ x, a * f x) := +(strict_anti_mul_left ha).comp_strict_mono hf + +lemma strict_mono.mul_const_of_neg (hf : strict_mono f) (ha : a < 0) : strict_anti (λ x, f x * a) := +(strict_anti_mul_right ha).comp_strict_mono hf + +lemma strict_anti.const_mul_of_neg (hf : strict_anti f) (ha : a < 0) : strict_mono (λ x, a * f x) := +(strict_anti_mul_left ha).comp hf + +lemma strict_anti.mul_const_of_neg (hf : strict_anti f) (ha : a < 0) : strict_mono (λ x, f x * a) := +(strict_anti_mul_right ha).comp hf + +end monotone +end strict_ordered_ring + +section strict_ordered_comm_ring +variables [strict_ordered_comm_ring α] + +/-- A choice-free version of `strict_ordered_comm_ring.to_ordered_comm_semiring'` to avoid using +choice in basic `int` lemmas. -/ +@[reducible] -- See note [reducible non-instances] +def strict_ordered_comm_ring.to_ordered_comm_ring' [@decidable_rel α (≤)] : ordered_comm_ring α := +{ ..‹strict_ordered_comm_ring α›, ..strict_ordered_ring.to_ordered_ring' } + +@[priority 100] -- See note [lower instance priority] +instance strict_ordered_comm_ring.to_strict_ordered_comm_semiring : + strict_ordered_comm_semiring α := +{ ..‹strict_ordered_comm_ring α›, ..strict_ordered_ring.to_strict_ordered_semiring } + +@[priority 100] -- See note [lower instance priority] +instance strict_ordered_comm_ring.to_ordered_comm_ring : ordered_comm_ring α := +{ ..‹strict_ordered_comm_ring α›, ..strict_ordered_ring.to_ordered_ring } + +end strict_ordered_comm_ring + +section linear_ordered_semiring +variables [linear_ordered_semiring α] {a b c d : α} + +@[priority 200] -- see Note [lower instance priority] +instance linear_ordered_semiring.to_pos_mul_reflect_lt : pos_mul_reflect_lt α := +⟨λ a b c, (monotone_mul_left_of_nonneg a.2).reflect_lt⟩ + +@[priority 200] -- see Note [lower instance priority] +instance linear_ordered_semiring.to_mul_pos_reflect_lt : mul_pos_reflect_lt α := +⟨λ a b c, (monotone_mul_right_of_nonneg a.2).reflect_lt⟩ + +local attribute [instance] linear_ordered_semiring.decidable_le linear_ordered_semiring.decidable_lt + +lemma nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg (hab : 0 ≤ a * b) : + (0 ≤ a ∧ 0 ≤ b) ∨ (a ≤ 0 ∧ b ≤ 0) := +begin + refine decidable.or_iff_not_and_not.2 _, + simp only [not_and, not_le], intros ab nab, apply not_lt_of_le hab _, + rcases lt_trichotomy 0 a with (ha|rfl|ha), + exacts [mul_neg_of_pos_of_neg ha (ab ha.le), ((ab le_rfl).asymm (nab le_rfl)).elim, + mul_neg_of_neg_of_pos ha (nab ha.le)] +end + +lemma nonneg_of_mul_nonneg_left (h : 0 ≤ a * b) (hb : 0 < b) : 0 ≤ a := +le_of_not_gt $ λ ha, (mul_neg_of_neg_of_pos ha hb).not_le h + +lemma nonneg_of_mul_nonneg_right (h : 0 ≤ a * b) (ha : 0 < a) : 0 ≤ b := +le_of_not_gt $ λ hb, (mul_neg_of_pos_of_neg ha hb).not_le h + +lemma neg_of_mul_neg_left (h : a * b < 0) (hb : 0 ≤ b) : a < 0 := +lt_of_not_ge $ λ ha, (mul_nonneg ha hb).not_lt h + +lemma neg_of_mul_neg_right (h : a * b < 0) (ha : 0 ≤ a) : b < 0 := +lt_of_not_ge $ λ hb, (mul_nonneg ha hb).not_lt h + +lemma nonpos_of_mul_nonpos_left (h : a * b ≤ 0) (hb : 0 < b) : a ≤ 0 := +le_of_not_gt (assume ha : a > 0, (mul_pos ha hb).not_le h) + +lemma nonpos_of_mul_nonpos_right (h : a * b ≤ 0) (ha : 0 < a) : b ≤ 0 := +le_of_not_gt (assume hb : b > 0, (mul_pos ha hb).not_le h) + +@[simp] lemma zero_le_mul_left (h : 0 < c) : 0 ≤ c * b ↔ 0 ≤ b := +by { convert mul_le_mul_left h, simp } + +@[simp] lemma zero_le_mul_right (h : 0 < c) : 0 ≤ b * c ↔ 0 ≤ b := +by { convert mul_le_mul_right h, simp } + +lemma add_le_mul_of_left_le_right (a2 : 2 ≤ a) (ab : a ≤ b) : a + b ≤ a * b := +have 0 < b, from +calc 0 < 2 : zero_lt_two + ... ≤ a : a2 + ... ≤ b : ab, +calc a + b ≤ b + b : add_le_add_right ab b + ... = 2 * b : (two_mul b).symm + ... ≤ a * b : (mul_le_mul_right this).mpr a2 + +lemma add_le_mul_of_right_le_left (b2 : 2 ≤ b) (ba : b ≤ a) : a + b ≤ a * b := +have 0 < a, from +calc 0 < 2 : zero_lt_two + ... ≤ b : b2 + ... ≤ a : ba, +calc a + b ≤ a + a : add_le_add_left ba a + ... = a * 2 : (mul_two a).symm + ... ≤ a * b : (mul_le_mul_left this).mpr b2 + +lemma add_le_mul (a2 : 2 ≤ a) (b2 : 2 ≤ b) : a + b ≤ a * b := +if hab : a ≤ b then add_le_mul_of_left_le_right a2 hab + else add_le_mul_of_right_le_left b2 (le_of_not_le hab) + +lemma add_le_mul' (a2 : 2 ≤ a) (b2 : 2 ≤ b) : a + b ≤ b * a := +(le_of_eq (add_comm _ _)).trans (add_le_mul b2 a2) + +section + +@[simp] lemma bit0_le_bit0 : bit0 a ≤ bit0 b ↔ a ≤ b := +by rw [bit0, bit0, ← two_mul, ← two_mul, mul_le_mul_left (zero_lt_two : 0 < (2:α))] + +@[simp] lemma bit0_lt_bit0 : bit0 a < bit0 b ↔ a < b := +by rw [bit0, bit0, ← two_mul, ← two_mul, mul_lt_mul_left (zero_lt_two : 0 < (2:α))] + +@[simp] lemma bit1_le_bit1 : bit1 a ≤ bit1 b ↔ a ≤ b := +(add_le_add_iff_right 1).trans bit0_le_bit0 + +@[simp] lemma bit1_lt_bit1 : bit1 a < bit1 b ↔ a < b := +(add_lt_add_iff_right 1).trans bit0_lt_bit0 + +@[simp] lemma one_le_bit1 : (1 : α) ≤ bit1 a ↔ 0 ≤ a := +by rw [bit1, le_add_iff_nonneg_left, bit0, ← two_mul, zero_le_mul_left (zero_lt_two : 0 < (2:α))] + +@[simp] lemma one_lt_bit1 : (1 : α) < bit1 a ↔ 0 < a := +by rw [bit1, lt_add_iff_pos_left, bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2:α))] + +@[simp] lemma zero_le_bit0 : (0 : α) ≤ bit0 a ↔ 0 ≤ a := +by rw [bit0, ← two_mul, zero_le_mul_left (zero_lt_two : 0 < (2:α))] + +@[simp] lemma zero_lt_bit0 : (0 : α) < bit0 a ↔ 0 < a := +by rw [bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2:α))] + +end + +theorem mul_nonneg_iff_right_nonneg_of_pos (ha : 0 < a) : 0 ≤ a * b ↔ 0 ≤ b := +⟨λ h, nonneg_of_mul_nonneg_right h ha, mul_nonneg ha.le⟩ + +theorem mul_nonneg_iff_left_nonneg_of_pos (hb : 0 < b) : 0 ≤ a * b ↔ 0 ≤ a := +⟨λ h, nonneg_of_mul_nonneg_left h hb, λ h, mul_nonneg h hb.le⟩ + +lemma nonpos_of_mul_nonneg_left (h : 0 ≤ a * b) (hb : b < 0) : a ≤ 0 := +le_of_not_gt (λ ha, absurd h (mul_neg_of_pos_of_neg ha hb).not_le) + +lemma nonpos_of_mul_nonneg_right (h : 0 ≤ a * b) (ha : a < 0) : b ≤ 0 := +le_of_not_gt (λ hb, absurd h (mul_neg_of_neg_of_pos ha hb).not_le) + +@[simp] lemma units.inv_pos {u : αˣ} : (0 : α) < ↑u⁻¹ ↔ (0 : α) < u := +have ∀ {u : αˣ}, (0 : α) < u → (0 : α) < ↑u⁻¹ := λ u h, + (zero_lt_mul_left h).mp $ u.mul_inv.symm ▸ zero_lt_one, +⟨this, this⟩ + +@[simp] lemma units.inv_neg {u : αˣ} : ↑u⁻¹ < (0 : α) ↔ ↑u < (0 : α) := +have ∀ {u : αˣ}, ↑u < (0 : α) → ↑u⁻¹ < (0 : α) := λ u h, + neg_of_mul_pos_right (by exact (u.mul_inv.symm ▸ zero_lt_one)) h.le, +⟨this, this⟩ + +lemma cmp_mul_pos_left (ha : 0 < a) (b c : α) : cmp (a * b) (a * c) = cmp b c := +(strict_mono_mul_left_of_pos ha).cmp_map_eq b c + +lemma cmp_mul_pos_right (ha : 0 < a) (b c : α) : cmp (b * a) (c * a) = cmp b c := +(strict_mono_mul_right_of_pos ha).cmp_map_eq b c + +lemma mul_max_of_nonneg (b c : α) (ha : 0 ≤ a) : a * max b c = max (a * b) (a * c) := +(monotone_mul_left_of_nonneg ha).map_max + +lemma mul_min_of_nonneg (b c : α) (ha : 0 ≤ a) : a * min b c = min (a * b) (a * c) := +(monotone_mul_left_of_nonneg ha).map_min + +lemma max_mul_of_nonneg (a b : α) (hc : 0 ≤ c) : max a b * c = max (a * c) (b * c) := +(monotone_mul_right_of_nonneg hc).map_max + +lemma min_mul_of_nonneg (a b : α) (hc : 0 ≤ c) : min a b * c = min (a * c) (b * c) := +(monotone_mul_right_of_nonneg hc).map_min + +lemma le_of_mul_le_of_one_le {a b c : α} (h : a * c ≤ b) (hb : 0 ≤ b) (hc : 1 ≤ c) : a ≤ b := +le_of_mul_le_mul_right (h.trans $ le_mul_of_one_le_right hb hc) $ zero_lt_one.trans_le hc + +lemma nonneg_le_nonneg_of_sq_le_sq {a b : α} (hb : 0 ≤ b) (h : a * a ≤ b * b) : a ≤ b := +le_of_not_gt $ λ hab, (mul_self_lt_mul_self hb hab).not_le h + +lemma mul_self_le_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a ≤ b ↔ a * a ≤ b * b := +⟨mul_self_le_mul_self h1, nonneg_le_nonneg_of_sq_le_sq h2⟩ + +lemma mul_self_lt_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a < b ↔ a * a < b * b := +((@strict_mono_on_mul_self α _).lt_iff_lt h1 h2).symm + +lemma mul_self_inj {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a * a = b * b ↔ a = b := +(@strict_mono_on_mul_self α _).eq_iff_eq h1 h2 + +end linear_ordered_semiring + +@[priority 100] -- See note [lower instance priority] +instance linear_ordered_comm_semiring.to_linear_ordered_cancel_add_comm_monoid + [linear_ordered_comm_semiring α] : linear_ordered_cancel_add_comm_monoid α := +{ ..‹linear_ordered_comm_semiring α› } + +section linear_ordered_ring +variables [linear_ordered_ring α] {a b c : α} + +local attribute [instance] linear_ordered_ring.decidable_le linear_ordered_ring.decidable_lt + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_ring.to_linear_ordered_semiring : linear_ordered_semiring α := +{ ..‹linear_ordered_ring α›, ..strict_ordered_ring.to_strict_ordered_semiring } + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_ring.to_linear_ordered_add_comm_group : linear_ordered_add_comm_group α := +{ ..‹linear_ordered_ring α› } + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_ring.no_zero_divisors : no_zero_divisors α := +{ eq_zero_or_eq_zero_of_mul_eq_zero := + begin + intros a b hab, + refine decidable.or_iff_not_and_not.2 (λ h, _), revert hab, + cases lt_or_gt_of_ne h.1 with ha ha; cases lt_or_gt_of_ne h.2 with hb hb, + exacts [(mul_pos_of_neg_of_neg ha hb).ne.symm, (mul_neg_of_neg_of_pos ha hb).ne, + (mul_neg_of_pos_of_neg ha hb).ne, (mul_pos ha hb).ne.symm] + end, + .. ‹linear_ordered_ring α› } + +@[priority 100] -- see Note [lower instance priority] +--We don't want to import `algebra.ring.basic`, so we cannot use `no_zero_divisors.to_is_domain`. +instance linear_ordered_ring.is_domain : is_domain α := +{ mul_left_cancel_of_ne_zero := λ a b c ha h, + begin + rw [← sub_eq_zero, ← mul_sub] at h, + exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha) + end, + mul_right_cancel_of_ne_zero := λ a b c hb h, + begin + rw [← sub_eq_zero, ← sub_mul] at h, + exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb) + end, + .. (infer_instance : nontrivial α) } + +lemma mul_pos_iff : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := +⟨pos_and_pos_or_neg_and_neg_of_mul_pos, + λ h, h.elim (and_imp.2 mul_pos) (and_imp.2 mul_pos_of_neg_of_neg)⟩ + +lemma mul_neg_iff : a * b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := +by rw [← neg_pos, neg_mul_eq_mul_neg, mul_pos_iff, neg_pos, neg_lt_zero] + +lemma mul_nonneg_iff : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := +⟨nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg, + λ h, h.elim (and_imp.2 mul_nonneg) (and_imp.2 mul_nonneg_of_nonpos_of_nonpos)⟩ + +/-- Out of three elements of a `linear_ordered_ring`, two must have the same sign. -/ +lemma mul_nonneg_of_three (a b c : α) : + 0 ≤ a * b ∨ 0 ≤ b * c ∨ 0 ≤ c * a := +by iterate 3 { rw mul_nonneg_iff }; + have := le_total 0 a; have := le_total 0 b; have := le_total 0 c; itauto + +lemma mul_nonpos_iff : a * b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b := +by rw [← neg_nonneg, neg_mul_eq_mul_neg, mul_nonneg_iff, neg_nonneg, neg_nonpos] + +lemma mul_self_nonneg (a : α) : 0 ≤ a * a := +(le_total 0 a).elim (λ h, mul_nonneg h h) (λ h, mul_nonneg_of_nonpos_of_nonpos h h) + +@[simp] lemma neg_le_self_iff : -a ≤ a ↔ 0 ≤ a := +by simp [neg_le_iff_add_nonneg, ← two_mul, mul_nonneg_iff, zero_le_one, (zero_lt_two' α).not_le] + +@[simp] lemma neg_lt_self_iff : -a < a ↔ 0 < a := +by simp [neg_lt_iff_pos_add, ← two_mul, mul_pos_iff, zero_lt_one, (zero_lt_two' α).not_lt] + +@[simp] lemma le_neg_self_iff : a ≤ -a ↔ a ≤ 0 := +calc a ≤ -a ↔ -(-a) ≤ -a : by rw neg_neg +... ↔ 0 ≤ -a : neg_le_self_iff +... ↔ a ≤ 0 : neg_nonneg + +@[simp] lemma lt_neg_self_iff : a < -a ↔ a < 0 := +calc a < -a ↔ -(-a) < -a : by rw neg_neg +... ↔ 0 < -a : neg_lt_self_iff +... ↔ a < 0 : neg_pos + +lemma neg_one_lt_zero : -1 < (0:α) := neg_lt_zero.2 zero_lt_one + +@[simp] lemma mul_le_mul_left_of_neg {a b c : α} (h : c < 0) : c * a ≤ c * b ↔ b ≤ a := +(strict_anti_mul_left h).le_iff_le + +@[simp] lemma mul_le_mul_right_of_neg {a b c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a := +(strict_anti_mul_right h).le_iff_le + +@[simp] lemma mul_lt_mul_left_of_neg {a b c : α} (h : c < 0) : c * a < c * b ↔ b < a := +(strict_anti_mul_left h).lt_iff_lt + +@[simp] lemma mul_lt_mul_right_of_neg {a b c : α} (h : c < 0) : a * c < b * c ↔ b < a := +(strict_anti_mul_right h).lt_iff_lt + +lemma lt_of_mul_lt_mul_of_nonpos_left (h : c * a < c * b) (hc : c ≤ 0) : b < a := +lt_of_mul_lt_mul_left (by rwa [neg_mul, neg_mul, neg_lt_neg_iff]) $ neg_nonneg.2 hc + +lemma lt_of_mul_lt_mul_of_nonpos_right (h : a * c < b * c) (hc : c ≤ 0) : b < a := +lt_of_mul_lt_mul_right (by rwa [mul_neg, mul_neg, neg_lt_neg_iff]) $ neg_nonneg.2 hc + +lemma cmp_mul_neg_left {a : α} (ha : a < 0) (b c : α) : cmp (a * b) (a * c) = cmp c b := +(strict_anti_mul_left ha).cmp_map_eq b c + +lemma cmp_mul_neg_right {a : α} (ha : a < 0) (b c : α) : cmp (b * a) (c * a) = cmp c b := +(strict_anti_mul_right ha).cmp_map_eq b c + +lemma sub_one_lt (a : α) : a - 1 < a := +sub_lt_iff_lt_add.2 (lt_add_one a) + +@[simp] lemma mul_self_pos {a : α} : 0 < a * a ↔ a ≠ 0 := +begin + split, + { rintro h rfl, rw mul_zero at h, exact h.false }, + { intro h, + cases h.lt_or_lt with h h, + exacts [mul_pos_of_neg_of_neg h h, mul_pos h h] } +end + +lemma mul_self_le_mul_self_of_le_of_neg_le {x y : α} (h₁ : x ≤ y) (h₂ : -x ≤ y) : x * x ≤ y * y := +(le_total 0 x).elim (λ h, mul_le_mul h₁ h₁ h (h.trans h₁)) + (λ h, le_of_eq_of_le (neg_mul_neg x x).symm + (mul_le_mul h₂ h₂ (neg_nonneg.mpr h) ((neg_nonneg.mpr h).trans h₂))) + +lemma nonneg_of_mul_nonpos_left {a b : α} (h : a * b ≤ 0) (hb : b < 0) : 0 ≤ a := +le_of_not_gt (λ ha, absurd h (mul_pos_of_neg_of_neg ha hb).not_le) + +lemma nonneg_of_mul_nonpos_right {a b : α} (h : a * b ≤ 0) (ha : a < 0) : 0 ≤ b := +le_of_not_gt (λ hb, absurd h (mul_pos_of_neg_of_neg ha hb).not_le) + +lemma pos_of_mul_neg_left {a b : α} (h : a * b < 0) (hb : b ≤ 0) : 0 < a := +lt_of_not_ge (λ ha, absurd h (mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt) + +lemma pos_of_mul_neg_right {a b : α} (h : a * b < 0) (ha : a ≤ 0) : 0 < b := +lt_of_not_ge (λ hb, absurd h (mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt) + +lemma neg_iff_pos_of_mul_neg (hab : a * b < 0) : a < 0 ↔ 0 < b := +⟨pos_of_mul_neg_right hab ∘ le_of_lt, neg_of_mul_neg_left hab ∘ le_of_lt⟩ + +lemma pos_iff_neg_of_mul_neg (hab : a * b < 0) : 0 < a ↔ b < 0 := +⟨neg_of_mul_neg_right hab ∘ le_of_lt, pos_of_mul_neg_left hab ∘ le_of_lt⟩ + +/-- The sum of two squares is zero iff both elements are zero. -/ +lemma mul_self_add_mul_self_eq_zero {x y : α} : x * x + y * y = 0 ↔ x = 0 ∧ y = 0 := +by rw [add_eq_zero_iff', mul_self_eq_zero, mul_self_eq_zero]; apply mul_self_nonneg + +lemma eq_zero_of_mul_self_add_mul_self_eq_zero (h : a * a + b * b = 0) : a = 0 := +(mul_self_add_mul_self_eq_zero.mp h).left + +end linear_ordered_ring + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_comm_ring.to_strict_ordered_comm_ring [d : linear_ordered_comm_ring α] : + strict_ordered_comm_ring α := +{ ..d } + +@[priority 100] -- see Note [lower instance priority] +instance linear_ordered_comm_ring.to_linear_ordered_comm_semiring [d : linear_ordered_comm_ring α] : + linear_ordered_comm_semiring α := +{ .. d, ..linear_ordered_ring.to_linear_ordered_semiring } + +section linear_ordered_comm_ring + +variables [linear_ordered_comm_ring α] {a b c d : α} + +lemma max_mul_mul_le_max_mul_max (b c : α) (ha : 0 ≤ a) (hd: 0 ≤ d) : + max (a * b) (d * c) ≤ max a c * max d b := +have ba : b * a ≤ max d b * max c a, from + mul_le_mul (le_max_right d b) (le_max_right c a) ha (le_trans hd (le_max_left d b)), +have cd : c * d ≤ max a c * max b d, from + mul_le_mul (le_max_right a c) (le_max_right b d) hd (le_trans ha (le_max_left a c)), +max_le + (by simpa [mul_comm, max_comm] using ba) + (by simpa [mul_comm, max_comm] using cd) + +end linear_ordered_comm_ring diff --git a/src/algebra/order/ring/inj_surj.lean b/src/algebra/order/ring/inj_surj.lean new file mode 100644 index 0000000000000..e69a498a330bd --- /dev/null +++ b/src/algebra/order/ring/inj_surj.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro +-/ +import algebra.order.ring.defs +import algebra.order.monoid.cancel.basic +import algebra.ring.inj_surj + +/-! +# Pulling back ordered rings along injective maps. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +open function + +universe u +variables {α : Type u} {β : Type*} + +namespace function.injective + +/-- Pullback an `ordered_semiring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def ordered_semiring [ordered_semiring α] [has_zero β] [has_one β] [has_add β] [has_mul β] + [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] (f : β → α) (hf : injective f) (zero : f 0 = 0) + (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + ordered_semiring β := +{ zero_le_one := show f 0 ≤ f 1, by simp only [zero, one, zero_le_one], + mul_le_mul_of_nonneg_left := λ a b c h hc, show f (c * a) ≤ f (c * b), + by { rw [mul, mul], refine mul_le_mul_of_nonneg_left h _, rwa ←zero }, + mul_le_mul_of_nonneg_right := λ a b c h hc, show f (a * c) ≤ f (b * c), + by { rw [mul, mul], refine mul_le_mul_of_nonneg_right h _, rwa ←zero }, + ..hf.ordered_add_comm_monoid f zero add nsmul, + ..hf.semiring f zero one add mul nsmul npow nat_cast } + +/-- Pullback an `ordered_comm_semiring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def ordered_comm_semiring [ordered_comm_semiring α] [has_zero β] [has_one β] [has_add β] + [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] (f : β → α) (hf : injective f) + (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (mul : ∀ x y, f (x * y) = f x * f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (nat_cast : ∀ n : ℕ, f n = n) : + ordered_comm_semiring β := +{ ..hf.comm_semiring f zero one add mul nsmul npow nat_cast, + ..hf.ordered_semiring f zero one add mul nsmul npow nat_cast } + +/-- Pullback an `ordered_ring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def ordered_ring [ordered_ring α] [has_zero β] [has_one β] [has_add β] [has_mul β] + [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] + [has_int_cast β] (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + ordered_ring β := +{ mul_nonneg := λ a b ha hb, show f 0 ≤ f (a * b), + by { rw [zero, mul], apply mul_nonneg; rwa ← zero }, + ..hf.ordered_semiring f zero one add mul nsmul npow nat_cast, + ..hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-- Pullback an `ordered_comm_ring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def ordered_comm_ring [ordered_comm_ring α] [has_zero β] [has_one β] [has_add β] + [has_mul β] [has_neg β] [has_sub β] [has_pow β ℕ] [has_smul ℕ β] [has_smul ℤ β] [has_nat_cast β] + [has_int_cast β] (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + ordered_comm_ring β := +{ ..hf.ordered_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast, + ..hf.comm_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-- Pullback a `strict_ordered_semiring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def strict_ordered_semiring [strict_ordered_semiring α] [has_zero β] [has_one β] + [has_add β] [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] (f : β → α) + (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (mul : ∀ x y, f (x * y) = f x * f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (nat_cast : ∀ n : ℕ, f n = n) : + strict_ordered_semiring β := +{ mul_lt_mul_of_pos_left := λ a b c h hc, show f (c * a) < f (c * b), + by simpa only [mul, zero] using mul_lt_mul_of_pos_left ‹f a < f b› (by rwa ←zero), + mul_lt_mul_of_pos_right := λ a b c h hc, show f (a * c) < f (b * c), + by simpa only [mul, zero] using mul_lt_mul_of_pos_right ‹f a < f b› (by rwa ←zero), + ..hf.ordered_cancel_add_comm_monoid f zero add nsmul, + ..hf.ordered_semiring f zero one add mul nsmul npow nat_cast, + ..pullback_nonzero f zero one } + +/-- Pullback a `strict_ordered_comm_semiring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def strict_ordered_comm_semiring [strict_ordered_comm_semiring α] [has_zero β] [has_one β] + [has_add β] [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] (f : β → α) + (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (mul : ∀ x y, f (x * y) = f x * f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) (nat_cast : ∀ n : ℕ, f n = n) : + strict_ordered_comm_semiring β := +{ ..hf.comm_semiring f zero one add mul nsmul npow nat_cast, + ..hf.strict_ordered_semiring f zero one add mul nsmul npow nat_cast } + +/-- Pullback a `strict_ordered_ring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def strict_ordered_ring [strict_ordered_ring α] [has_zero β] [has_one β] [has_add β] + [has_mul β] [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] + [has_int_cast β] (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + strict_ordered_ring β := +{ mul_pos := λ a b a0 b0, show f 0 < f (a * b), by { rw [zero, mul], apply mul_pos; rwa ← zero }, + ..hf.strict_ordered_semiring f zero one add mul nsmul npow nat_cast, + ..hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-- Pullback a `strict_ordered_comm_ring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def strict_ordered_comm_ring [strict_ordered_comm_ring α] [has_zero β] + [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_pow β ℕ] [has_smul ℕ β] + [has_smul ℤ β] [has_nat_cast β] [has_int_cast β] (f : β → α) (hf : injective f) (zero : f 0 = 0) + (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + strict_ordered_comm_ring β := +{ ..hf.strict_ordered_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast, + ..hf.comm_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-- Pullback a `linear_ordered_semiring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def linear_ordered_semiring [linear_ordered_semiring α] [has_zero β] [has_one β] + [has_add β] [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] [has_sup β] [has_inf β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) + (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_semiring β := +{ .. linear_order.lift f hf hsup hinf, + .. hf.strict_ordered_semiring f zero one add mul nsmul npow nat_cast } + +/-- Pullback a `linear_ordered_semiring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def linear_ordered_comm_semiring [linear_ordered_comm_semiring α] + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_pow β ℕ] [has_smul ℕ β] [has_nat_cast β] + [has_sup β] [has_inf β] (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) + (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_comm_semiring β := +{ ..hf.linear_ordered_semiring f zero one add mul nsmul npow nat_cast hsup hinf, + ..hf.strict_ordered_comm_semiring f zero one add mul nsmul npow nat_cast } + +/-- Pullback a `linear_ordered_ring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +def linear_ordered_ring [linear_ordered_ring α] [has_zero β] [has_one β] [has_add β] [has_mul β] + [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] + [has_int_cast β] [has_sup β] [has_inf β] (f : β → α) (hf : injective f) (zero : f 0 = 0) + (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_ring β := +{ .. linear_order.lift f hf hsup hinf, + .. hf.strict_ordered_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +/-- Pullback a `linear_ordered_comm_ring` under an injective map. -/ +@[reducible] -- See note [reducible non-instances] +protected def linear_ordered_comm_ring [linear_ordered_comm_ring α] [has_zero β] + [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_pow β ℕ] [has_smul ℕ β] + [has_smul ℤ β] [has_nat_cast β] [has_int_cast β] [has_sup β] [has_inf β] (f : β → α) + (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ x y, f (x + y) = f x + f y) + (mul : ∀ x y, f (x * y) = f x * f y) (neg : ∀ x, f (-x) = -f x) + (sub : ∀ x y, f (x - y) = f x - f y) (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : + linear_ordered_comm_ring β := +{ .. linear_order.lift f hf hsup hinf, + .. hf.strict_ordered_comm_ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast } + +end function.injective diff --git a/src/algebra/order/ring/lemmas.lean b/src/algebra/order/ring/lemmas.lean new file mode 100644 index 0000000000000..cff9f4f845790 --- /dev/null +++ b/src/algebra/order/ring/lemmas.lean @@ -0,0 +1,868 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa, Yuyang Zhao +-/ +import algebra.covariant_and_contravariant +import algebra.group_with_zero.defs + +/-! +# Multiplication by ·positive· elements is monotonic + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `α` be a type with `<` and `0`. We use the type `{x : α // 0 < x}` of positive elements of `α` +to prove results about monotonicity of multiplication. We also introduce the local notation `α>0` +for the subtype `{x : α // 0 < x}`: + +If the type `α` also has a multiplication, then we combine this with (`contravariant_`) +`covariant_class`es to assume that multiplication by positive elements is (strictly) monotone on a +`mul_zero_class`, `monoid_with_zero`,... +More specifically, we use extensively the following typeclasses: + +* monotone left +* * `covariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono α`, + expressing that multiplication by positive elements on the left is monotone; +* * `covariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_strict_mono α`, + expressing that multiplication by positive elements on the left is strictly monotone; +* monotone right +* * `covariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono α`, + expressing that multiplication by positive elements on the right is monotone; +* * `covariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_strict_mono α`, + expressing that multiplication by positive elements on the right is strictly monotone. +* reverse monotone left +* * `contravariant_class α>0 α (λ x y, x * y) (≤)`, abbreviated `pos_mul_mono_rev α`, + expressing that multiplication by positive elements on the left is reverse monotone; +* * `contravariant_class α>0 α (λ x y, x * y) (<)`, abbreviated `pos_mul_reflect_lt α`, + expressing that multiplication by positive elements on the left is strictly reverse monotone; +* reverse reverse monotone right +* * `contravariant_class α>0 α (λ x y, y * x) (≤)`, abbreviated `mul_pos_mono_rev α`, + expressing that multiplication by positive elements on the right is reverse monotone; +* * `contravariant_class α>0 α (λ x y, y * x) (<)`, abbreviated `mul_pos_reflect_lt α`, + expressing that multiplication by positive elements on the right is strictly reverse monotone. + +## Notation + +The following is local notation in this file: +* `α≥0`: `{x : α // 0 ≤ x}` +* `α>0`: `{x : α // 0 < x}` +-/ + +variable (α : Type*) + +/- Notations for nonnegative and positive elements +https:// +leanprover.zulipchat.com/#narrow/stream/113488-general/topic/notation.20for.20positive.20elements +-/ +local notation `α≥0` := {x : α // 0 ≤ x} +local notation `α>0` := {x : α // 0 < x} + +section abbreviations +variables [has_mul α] [has_zero α] [preorder α] + +/-- `pos_mul_mono α` is an abbreviation for `covariant_class α≥0 α (λ x y, x * y) (≤)`, +expressing that multiplication by nonnegative elements on the left is monotone. -/ +abbreviation pos_mul_mono : Prop := covariant_class α≥0 α (λ x y, x * y) (≤) + +/-- `mul_pos_mono α` is an abbreviation for `covariant_class α≥0 α (λ x y, y * x) (≤)`, +expressing that multiplication by nonnegative elements on the right is monotone. -/ +abbreviation mul_pos_mono : Prop := covariant_class α≥0 α (λ x y, y * x) (≤) + +/-- `pos_mul_strict_mono α` is an abbreviation for `covariant_class α>0 α (λ x y, x * y) (<)`, +expressing that multiplication by positive elements on the left is strictly monotone. -/ +abbreviation pos_mul_strict_mono : Prop := covariant_class α>0 α (λ x y, x * y) (<) + +/-- `mul_pos_strict_mono α` is an abbreviation for `covariant_class α>0 α (λ x y, y * x) (<)`, +expressing that multiplication by positive elements on the right is strictly monotone. -/ +abbreviation mul_pos_strict_mono : Prop := covariant_class α>0 α (λ x y, y * x) (<) + +/-- `pos_mul_reflect_lt α` is an abbreviation for `contravariant_class α≥0 α (λ x y, x * y) (<)`, +expressing that multiplication by nonnegative elements on the left is strictly reverse monotone. -/ +abbreviation pos_mul_reflect_lt : Prop := contravariant_class α≥0 α (λ x y, x * y) (<) + +/-- `mul_pos_reflect_lt α` is an abbreviation for `contravariant_class α≥0 α (λ x y, y * x) (<)`, +expressing that multiplication by nonnegative elements on the right is strictly reverse monotone. -/ +abbreviation mul_pos_reflect_lt : Prop := contravariant_class α≥0 α (λ x y, y * x) (<) + +/-- `pos_mul_mono_rev α` is an abbreviation for `contravariant_class α>0 α (λ x y, x * y) (≤)`, +expressing that multiplication by positive elements on the left is reverse monotone. -/ +abbreviation pos_mul_mono_rev : Prop := contravariant_class α>0 α (λ x y, x * y) (≤) + +/-- `mul_pos_mono_rev α` is an abbreviation for `contravariant_class α>0 α (λ x y, y * x) (≤)`, +expressing that multiplication by positive elements on the right is reverse monotone. -/ +abbreviation mul_pos_mono_rev : Prop := contravariant_class α>0 α (λ x y, y * x) (≤) + +end abbreviations + +variables {α} {a b c d : α} + +section has_mul_zero +variables [has_mul α] [has_zero α] + +section preorder +variables [preorder α] + +instance pos_mul_mono.to_covariant_class_pos_mul_le [pos_mul_mono α] : + covariant_class α>0 α (λ x y, x * y) (≤) := +⟨λ a b c bc, @covariant_class.elim α≥0 α (λ x y, x * y) (≤) _ ⟨_, a.2.le⟩ _ _ bc⟩ + +instance mul_pos_mono.to_covariant_class_pos_mul_le [mul_pos_mono α] : + covariant_class α>0 α (λ x y, y * x) (≤) := +⟨λ a b c bc, @covariant_class.elim α≥0 α (λ x y, y * x) (≤) _ ⟨_, a.2.le⟩ _ _ bc⟩ + +instance pos_mul_reflect_lt.to_contravariant_class_pos_mul_lt [pos_mul_reflect_lt α] : + contravariant_class α>0 α (λ x y, x * y) (<) := +⟨λ a b c bc, @contravariant_class.elim α≥0 α (λ x y, x * y) (<) _ ⟨_, a.2.le⟩ _ _ bc⟩ + +instance mul_pos_reflect_lt.to_contravariant_class_pos_mul_lt [mul_pos_reflect_lt α] : + contravariant_class α>0 α (λ x y, y * x) (<) := +⟨λ a b c bc, @contravariant_class.elim α≥0 α (λ x y, y * x) (<) _ ⟨_, a.2.le⟩ _ _ bc⟩ + +lemma mul_le_mul_of_nonneg_left [pos_mul_mono α] (h : b ≤ c) (a0 : 0 ≤ a) : a * b ≤ a * c := +@covariant_class.elim α≥0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ h + +lemma mul_le_mul_of_nonneg_right [mul_pos_mono α] (h : b ≤ c) (a0 : 0 ≤ a) : b * a ≤ c * a := +@covariant_class.elim α≥0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ h + +lemma mul_lt_mul_of_pos_left [pos_mul_strict_mono α] (bc : b < c) (a0 : 0 < a) : a * b < a * c := +@covariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ bc + +lemma mul_lt_mul_of_pos_right [mul_pos_strict_mono α] (bc : b < c) (a0 : 0 < a) : b * a < c * a := +@covariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ bc + +lemma lt_of_mul_lt_mul_left [pos_mul_reflect_lt α] (h : a * b < a * c) (a0 : 0 ≤ a) : b < c := +@contravariant_class.elim α≥0 α (λ x y, x * y) (<) _ ⟨a, a0⟩ _ _ h + +lemma lt_of_mul_lt_mul_right [mul_pos_reflect_lt α] (h : b * a < c * a) (a0 : 0 ≤ a) : b < c := +@contravariant_class.elim α≥0 α (λ x y, y * x) (<) _ ⟨a, a0⟩ _ _ h + +lemma le_of_mul_le_mul_left [pos_mul_mono_rev α] (bc : a * b ≤ a * c) (a0 : 0 < a) : b ≤ c := +@contravariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨a, a0⟩ _ _ bc + +lemma le_of_mul_le_mul_right [mul_pos_mono_rev α] (bc : b * a ≤ c * a) (a0 : 0 < a) : b ≤ c := +@contravariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨a, a0⟩ _ _ bc + +alias lt_of_mul_lt_mul_left ← lt_of_mul_lt_mul_of_nonneg_left +alias lt_of_mul_lt_mul_right ← lt_of_mul_lt_mul_of_nonneg_right +alias le_of_mul_le_mul_left ← le_of_mul_le_mul_of_pos_left +alias le_of_mul_le_mul_right ← le_of_mul_le_mul_of_pos_right + +@[simp] lemma mul_lt_mul_left [pos_mul_strict_mono α] [pos_mul_reflect_lt α] + (a0 : 0 < a) : + a * b < a * c ↔ b < c := +@rel_iff_cov α>0 α (λ x y, x * y) (<) _ _ ⟨a, a0⟩ _ _ + +@[simp] lemma mul_lt_mul_right [mul_pos_strict_mono α] [mul_pos_reflect_lt α] + (a0 : 0 < a) : + b * a < c * a ↔ b < c := +@rel_iff_cov α>0 α (λ x y, y * x) (<) _ _ ⟨a, a0⟩ _ _ + +@[simp] lemma mul_le_mul_left [pos_mul_mono α] [pos_mul_mono_rev α] + (a0 : 0 < a) : + a * b ≤ a * c ↔ b ≤ c := +@rel_iff_cov α>0 α (λ x y, x * y) (≤) _ _ ⟨a, a0⟩ _ _ + +@[simp] lemma mul_le_mul_right [mul_pos_mono α] [mul_pos_mono_rev α] + (a0 : 0 < a) : + b * a ≤ c * a ↔ b ≤ c := +@rel_iff_cov α>0 α (λ x y, y * x) (≤) _ _ ⟨a, a0⟩ _ _ + +lemma mul_lt_mul_of_pos_of_nonneg [pos_mul_strict_mono α] [mul_pos_mono α] + (h₁ : a ≤ b) (h₂ : c < d) (a0 : 0 < a) (d0 : 0 ≤ d) : a * c < b * d := +(mul_lt_mul_of_pos_left h₂ a0).trans_le (mul_le_mul_of_nonneg_right h₁ d0) + +lemma mul_lt_mul_of_le_of_le' [pos_mul_strict_mono α] [mul_pos_mono α] + (h₁ : a ≤ b) (h₂ : c < d) (b0 : 0 < b) (c0 : 0 ≤ c) : a * c < b * d := +(mul_le_mul_of_nonneg_right h₁ c0).trans_lt (mul_lt_mul_of_pos_left h₂ b0) + +lemma mul_lt_mul_of_nonneg_of_pos [pos_mul_mono α] [mul_pos_strict_mono α] + (h₁ : a < b) (h₂ : c ≤ d) (a0 : 0 ≤ a) (d0 : 0 < d) : a * c < b * d := +(mul_le_mul_of_nonneg_left h₂ a0).trans_lt (mul_lt_mul_of_pos_right h₁ d0) + +lemma mul_lt_mul_of_le_of_lt' [pos_mul_mono α] [mul_pos_strict_mono α] + (h₁ : a < b) (h₂ : c ≤ d) (b0 : 0 ≤ b) (c0 : 0 < c) : a * c < b * d := +(mul_lt_mul_of_pos_right h₁ c0).trans_le (mul_le_mul_of_nonneg_left h₂ b0) + +lemma mul_lt_mul_of_pos_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α] + (h₁ : a < b) (h₂ : c < d) (a0 : 0 < a) (d0 : 0 < d) : a * c < b * d := +(mul_lt_mul_of_pos_left h₂ a0).trans (mul_lt_mul_of_pos_right h₁ d0) + +lemma mul_lt_mul_of_lt_of_lt' [pos_mul_strict_mono α] [mul_pos_strict_mono α] + (h₁ : a < b) (h₂ : c < d) (b0 : 0 < b) (c0 : 0 < c) : a * c < b * d := +(mul_lt_mul_of_pos_right h₁ c0).trans (mul_lt_mul_of_pos_left h₂ b0) + +lemma mul_lt_of_mul_lt_of_nonneg_left [pos_mul_mono α] (h : a * b < c) (hdb : d ≤ b) (ha : 0 ≤ a) : + a * d < c := +(mul_le_mul_of_nonneg_left hdb ha).trans_lt h + +lemma lt_mul_of_lt_mul_of_nonneg_left [pos_mul_mono α] (h : a < b * c) (hcd : c ≤ d) (hb : 0 ≤ b) : + a < b * d := +h.trans_le $ mul_le_mul_of_nonneg_left hcd hb + +lemma mul_lt_of_mul_lt_of_nonneg_right [mul_pos_mono α] (h : a * b < c) (hda : d ≤ a) (hb : 0 ≤ b) : + d * b < c := +(mul_le_mul_of_nonneg_right hda hb).trans_lt h + +lemma lt_mul_of_lt_mul_of_nonneg_right [mul_pos_mono α] (h : a < b * c) (hbd : b ≤ d) (hc : 0 ≤ c) : + a < d * c := +h.trans_le $ mul_le_mul_of_nonneg_right hbd hc + +end preorder + +section linear_order +variables [linear_order α] + +@[priority 100] -- see Note [lower instance priority] +instance pos_mul_strict_mono.to_pos_mul_mono_rev [pos_mul_strict_mono α] : pos_mul_mono_rev α := +⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt $ mul_lt_mul_of_pos_left h' x.prop⟩ + +@[priority 100] -- see Note [lower instance priority] +instance mul_pos_strict_mono.to_mul_pos_mono_rev [mul_pos_strict_mono α] : mul_pos_mono_rev α := +⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt $ mul_lt_mul_of_pos_right h' x.prop⟩ + +lemma pos_mul_mono_rev.to_pos_mul_strict_mono [pos_mul_mono_rev α] : pos_mul_strict_mono α := +⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ le_of_mul_le_mul_of_pos_left h' x.prop⟩ + +lemma mul_pos_mono_rev.to_mul_pos_strict_mono [mul_pos_mono_rev α] : mul_pos_strict_mono α := +⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ le_of_mul_le_mul_of_pos_right h' x.prop⟩ + +lemma pos_mul_strict_mono_iff_pos_mul_mono_rev : pos_mul_strict_mono α ↔ pos_mul_mono_rev α := +⟨@pos_mul_strict_mono.to_pos_mul_mono_rev _ _ _ _, @pos_mul_mono_rev.to_pos_mul_strict_mono _ _ _ _⟩ + +lemma mul_pos_strict_mono_iff_mul_pos_mono_rev : mul_pos_strict_mono α ↔ mul_pos_mono_rev α := +⟨@mul_pos_strict_mono.to_mul_pos_mono_rev _ _ _ _, @mul_pos_mono_rev.to_mul_pos_strict_mono _ _ _ _⟩ + +lemma pos_mul_reflect_lt.to_pos_mul_mono [pos_mul_reflect_lt α] : pos_mul_mono α := +⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt $ lt_of_mul_lt_mul_left h' x.prop⟩ + +lemma mul_pos_reflect_lt.to_mul_pos_mono [mul_pos_reflect_lt α] : mul_pos_mono α := +⟨λ x a b h, le_of_not_lt $ λ h', h.not_lt $ lt_of_mul_lt_mul_right h' x.prop⟩ + +lemma pos_mul_mono.to_pos_mul_reflect_lt [pos_mul_mono α] : pos_mul_reflect_lt α := +⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ mul_le_mul_of_nonneg_left h' x.prop⟩ + +lemma mul_pos_mono.to_mul_pos_reflect_lt [mul_pos_mono α] : mul_pos_reflect_lt α := +⟨λ x a b h, lt_of_not_le $ λ h', h.not_le $ mul_le_mul_of_nonneg_right h' x.prop⟩ + +lemma pos_mul_mono_iff_pos_mul_reflect_lt : pos_mul_mono α ↔ pos_mul_reflect_lt α := +⟨@pos_mul_mono.to_pos_mul_reflect_lt _ _ _ _, @pos_mul_reflect_lt.to_pos_mul_mono _ _ _ _⟩ + +lemma mul_pos_mono_iff_mul_pos_reflect_lt : mul_pos_mono α ↔ mul_pos_reflect_lt α := +⟨@mul_pos_mono.to_mul_pos_reflect_lt _ _ _ _, @mul_pos_reflect_lt.to_mul_pos_mono _ _ _ _⟩ + +end linear_order + +end has_mul_zero + +section mul_zero_class +variables [mul_zero_class α] + +section preorder +variables [preorder α] + +/-- Assumes left covariance. -/ +lemma left.mul_pos [pos_mul_strict_mono α] (ha : 0 < a) (hb : 0 < b) : 0 < a * b := +by simpa only [mul_zero] using mul_lt_mul_of_pos_left hb ha + +alias left.mul_pos ← mul_pos + +lemma mul_neg_of_pos_of_neg [pos_mul_strict_mono α] (ha : 0 < a) (hb : b < 0) : a * b < 0 := +by simpa only [mul_zero] using mul_lt_mul_of_pos_left hb ha + +@[simp] lemma zero_lt_mul_left [pos_mul_strict_mono α] [pos_mul_reflect_lt α] (h : 0 < c) : + 0 < c * b ↔ 0 < b := +by { convert mul_lt_mul_left h, simp } + +/-- Assumes right covariance. -/ +lemma right.mul_pos [mul_pos_strict_mono α] (ha : 0 < a) (hb : 0 < b) : 0 < a * b := +by simpa only [zero_mul] using mul_lt_mul_of_pos_right ha hb + +lemma mul_neg_of_neg_of_pos [mul_pos_strict_mono α] (ha : a < 0) (hb : 0 < b) : a * b < 0 := +by simpa only [zero_mul] using mul_lt_mul_of_pos_right ha hb + +@[simp] lemma zero_lt_mul_right [mul_pos_strict_mono α] [mul_pos_reflect_lt α] (h : 0 < c) : + 0 < b * c ↔ 0 < b := +by { convert mul_lt_mul_right h, simp } + +/-- Assumes left covariance. -/ +lemma left.mul_nonneg [pos_mul_mono α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := +by simpa only [mul_zero] using mul_le_mul_of_nonneg_left hb ha + +alias left.mul_nonneg ← mul_nonneg + +lemma mul_nonpos_of_nonneg_of_nonpos [pos_mul_mono α] (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 := +by simpa only [mul_zero] using mul_le_mul_of_nonneg_left hb ha + +/-- Assumes right covariance. -/ +lemma right.mul_nonneg [mul_pos_mono α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b := +by simpa only [zero_mul] using mul_le_mul_of_nonneg_right ha hb + +lemma mul_nonpos_of_nonpos_of_nonneg [mul_pos_mono α] (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 := +by simpa only [zero_mul] using mul_le_mul_of_nonneg_right ha hb + +lemma pos_of_mul_pos_right [pos_mul_reflect_lt α] (h : 0 < a * b) (ha : 0 ≤ a) : 0 < b := +lt_of_mul_lt_mul_left ((mul_zero a).symm ▸ h : a * 0 < a * b) ha + +lemma pos_of_mul_pos_left [mul_pos_reflect_lt α] (h : 0 < a * b) (hb : 0 ≤ b) : 0 < a := +lt_of_mul_lt_mul_right ((zero_mul b).symm ▸ h : 0 * b < a * b) hb + +lemma pos_iff_pos_of_mul_pos [pos_mul_reflect_lt α] [mul_pos_reflect_lt α] (hab : 0 < a * b) : + 0 < a ↔ 0 < b := +⟨pos_of_mul_pos_right hab ∘ le_of_lt, pos_of_mul_pos_left hab ∘ le_of_lt⟩ + +lemma mul_le_mul_of_le_of_le [pos_mul_mono α] [mul_pos_mono α] + (h₁ : a ≤ b) (h₂ : c ≤ d) (a0 : 0 ≤ a) (d0 : 0 ≤ d) : a * c ≤ b * d := +(mul_le_mul_of_nonneg_left h₂ a0).trans $ mul_le_mul_of_nonneg_right h₁ d0 + +lemma mul_le_mul [pos_mul_mono α] [mul_pos_mono α] + (h₁ : a ≤ b) (h₂ : c ≤ d) (c0 : 0 ≤ c) (b0 : 0 ≤ b) : a * c ≤ b * d := +(mul_le_mul_of_nonneg_right h₁ c0).trans $ mul_le_mul_of_nonneg_left h₂ b0 + +lemma mul_self_le_mul_self [pos_mul_mono α] [mul_pos_mono α] (ha : 0 ≤ a) (hab : a ≤ b) : + a * a ≤ b * b := +mul_le_mul hab hab ha $ ha.trans hab + +lemma mul_le_of_mul_le_of_nonneg_left [pos_mul_mono α] (h : a * b ≤ c) (hle : d ≤ b) (a0 : 0 ≤ a) : + a * d ≤ c := +(mul_le_mul_of_nonneg_left hle a0).trans h + +lemma le_mul_of_le_mul_of_nonneg_left [pos_mul_mono α] (h : a ≤ b * c) (hle : c ≤ d) (b0 : 0 ≤ b) : + a ≤ b * d := +h.trans (mul_le_mul_of_nonneg_left hle b0) + +lemma mul_le_of_mul_le_of_nonneg_right [mul_pos_mono α] (h : a * b ≤ c) (hle : d ≤ a) (b0 : 0 ≤ b) : + d * b ≤ c := +(mul_le_mul_of_nonneg_right hle b0).trans h + +lemma le_mul_of_le_mul_of_nonneg_right [mul_pos_mono α] (h : a ≤ b * c) (hle : b ≤ d) (c0 : 0 ≤ c) : + a ≤ d * c := +h.trans (mul_le_mul_of_nonneg_right hle c0) + +end preorder + +section partial_order +variables [partial_order α] + +lemma pos_mul_mono_iff_covariant_pos : pos_mul_mono α ↔ covariant_class α>0 α (λ x y, x * y) (≤) := +⟨@pos_mul_mono.to_covariant_class_pos_mul_le _ _ _ _, λ h, ⟨λ a b c h, begin + obtain ha | ha := a.prop.eq_or_gt, + { simp only [ha, zero_mul] }, + { exactI @covariant_class.elim α>0 α (λ x y, x * y) (≤) _ ⟨_, ha⟩ _ _ h } + end⟩⟩ + +lemma mul_pos_mono_iff_covariant_pos : mul_pos_mono α ↔ covariant_class α>0 α (λ x y, y * x) (≤) := +⟨@mul_pos_mono.to_covariant_class_pos_mul_le _ _ _ _, λ h, ⟨λ a b c h, begin + obtain ha | ha := a.prop.eq_or_gt, + { simp only [ha, mul_zero] }, + { exactI @covariant_class.elim α>0 α (λ x y, y * x) (≤) _ ⟨_, ha⟩ _ _ h } + end⟩⟩ + +lemma pos_mul_reflect_lt_iff_contravariant_pos : + pos_mul_reflect_lt α ↔ contravariant_class α>0 α (λ x y, x * y) (<) := +⟨@pos_mul_reflect_lt.to_contravariant_class_pos_mul_lt _ _ _ _, λ h, ⟨λ a b c h, begin + obtain ha | ha := a.prop.eq_or_gt, + { simpa [ha] using h }, + { exactI (@contravariant_class.elim α>0 α (λ x y, x * y) (<) _ ⟨_, ha⟩ _ _ h) } + end⟩⟩ + +lemma mul_pos_reflect_lt_iff_contravariant_pos : + mul_pos_reflect_lt α ↔ contravariant_class α>0 α (λ x y, y * x) (<) := +⟨@mul_pos_reflect_lt.to_contravariant_class_pos_mul_lt _ _ _ _, λ h, ⟨λ a b c h, begin + obtain ha | ha := a.prop.eq_or_gt, + { simpa [ha] using h }, + { exactI (@contravariant_class.elim α>0 α (λ x y, y * x) (<) _ ⟨_, ha⟩ _ _ h) } + end⟩⟩ + +@[priority 100] -- see Note [lower instance priority] +instance pos_mul_strict_mono.to_pos_mul_mono [pos_mul_strict_mono α] : pos_mul_mono α := +pos_mul_mono_iff_covariant_pos.2 $ ⟨λ a, strict_mono.monotone $ @covariant_class.elim _ _ _ _ _ _⟩ + +@[priority 100] -- see Note [lower instance priority] +instance mul_pos_strict_mono.to_mul_pos_mono [mul_pos_strict_mono α] : mul_pos_mono α := +mul_pos_mono_iff_covariant_pos.2 $ ⟨λ a, strict_mono.monotone $ @covariant_class.elim _ _ _ _ _ _⟩ + +@[priority 100] -- see Note [lower instance priority] +instance pos_mul_mono_rev.to_pos_mul_reflect_lt [pos_mul_mono_rev α] : pos_mul_reflect_lt α := +pos_mul_reflect_lt_iff_contravariant_pos.2 + ⟨λ a b c h, (le_of_mul_le_mul_of_pos_left h.le a.2).lt_of_ne $ by { rintro rfl, simpa using h }⟩ + +@[priority 100] -- see Note [lower instance priority] +instance mul_pos_mono_rev.to_mul_pos_reflect_lt [mul_pos_mono_rev α] : mul_pos_reflect_lt α := +mul_pos_reflect_lt_iff_contravariant_pos.2 + ⟨λ a b c h, (le_of_mul_le_mul_of_pos_right h.le a.2).lt_of_ne $ by { rintro rfl, simpa using h }⟩ + +lemma mul_left_cancel_iff_of_pos [pos_mul_mono_rev α] (a0 : 0 < a) : a * b = a * c ↔ b = c := +⟨λ h, (le_of_mul_le_mul_of_pos_left h.le a0).antisymm $ le_of_mul_le_mul_of_pos_left h.ge a0, + congr_arg _⟩ + +lemma mul_right_cancel_iff_of_pos [mul_pos_mono_rev α] (b0 : 0 < b) : a * b = c * b ↔ a = c := +⟨λ h, (le_of_mul_le_mul_of_pos_right h.le b0).antisymm $ le_of_mul_le_mul_of_pos_right h.ge b0, + congr_arg _⟩ + +lemma mul_eq_mul_iff_eq_and_eq_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α] + [pos_mul_mono_rev α] [mul_pos_mono_rev α] + (hac : a ≤ b) (hbd : c ≤ d) (a0 : 0 < a) (d0 : 0 < d) : + a * c = b * d ↔ a = b ∧ c = d := +begin + refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩, + rcases hac.eq_or_lt with rfl | hac, + { exact ⟨rfl, (mul_left_cancel_iff_of_pos a0).mp h⟩ }, + rcases eq_or_lt_of_le hbd with rfl | hbd, + { exact ⟨(mul_right_cancel_iff_of_pos d0).mp h, rfl⟩ }, + exact ((mul_lt_mul_of_pos_of_pos hac hbd a0 d0).ne h).elim, +end + +lemma mul_eq_mul_iff_eq_and_eq_of_pos' [pos_mul_strict_mono α] [mul_pos_strict_mono α] + [pos_mul_mono_rev α] [mul_pos_mono_rev α] + (hac : a ≤ b) (hbd : c ≤ d) (b0 : 0 < b) (c0 : 0 < c) : + a * c = b * d ↔ a = b ∧ c = d := +begin + refine ⟨λ h, _, λ h, congr_arg2 (*) h.1 h.2⟩, + rcases hac.eq_or_lt with rfl | hac, + { exact ⟨rfl, (mul_left_cancel_iff_of_pos b0).mp h⟩ }, + rcases eq_or_lt_of_le hbd with rfl | hbd, + { exact ⟨(mul_right_cancel_iff_of_pos c0).mp h, rfl⟩ }, + exact ((mul_lt_mul_of_lt_of_lt' hac hbd b0 c0).ne h).elim, +end + +end partial_order + +section linear_order +variables [linear_order α] + +lemma pos_and_pos_or_neg_and_neg_of_mul_pos [pos_mul_mono α] [mul_pos_mono α] + (hab : 0 < a * b) : + (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) := +begin + rcases lt_trichotomy 0 a with ha | rfl | ha, + { refine or.inl ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩, + exact mul_nonpos_of_nonneg_of_nonpos ha.le hb }, + { rw [zero_mul] at hab, exact hab.false.elim }, + { refine or.inr ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩, + exact mul_nonpos_of_nonpos_of_nonneg ha.le hb } +end + +lemma neg_of_mul_pos_right [pos_mul_mono α] [mul_pos_mono α] + (h : 0 < a * b) (ha : a ≤ 0) : + b < 0 := +((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.1.not_le ha).2 + +lemma neg_of_mul_pos_left [pos_mul_mono α] [mul_pos_mono α] + (h : 0 < a * b) (ha : b ≤ 0) : + a < 0 := +((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.2.not_le ha).1 + +lemma neg_iff_neg_of_mul_pos [pos_mul_mono α] [mul_pos_mono α] + (hab : 0 < a * b) : + a < 0 ↔ b < 0 := +⟨neg_of_mul_pos_right hab ∘ le_of_lt, neg_of_mul_pos_left hab ∘ le_of_lt⟩ + +lemma left.neg_of_mul_neg_left [pos_mul_mono α] + (h : a * b < 0) (h1 : 0 ≤ a) : + b < 0 := +lt_of_not_ge (assume h2 : b ≥ 0, (left.mul_nonneg h1 h2).not_lt h) + +lemma right.neg_of_mul_neg_left [mul_pos_mono α] + (h : a * b < 0) (h1 : 0 ≤ a) : + b < 0 := +lt_of_not_ge (assume h2 : b ≥ 0, (right.mul_nonneg h1 h2).not_lt h) + +lemma left.neg_of_mul_neg_right [pos_mul_mono α] + (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 := +lt_of_not_ge (assume h2 : a ≥ 0, (left.mul_nonneg h2 h1).not_lt h) + +lemma right.neg_of_mul_neg_right [mul_pos_mono α] + (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 := +lt_of_not_ge (assume h2 : a ≥ 0, (right.mul_nonneg h2 h1).not_lt h) + +end linear_order + +end mul_zero_class + +section mul_one_class +variables [mul_one_class α] [has_zero α] + +section preorder +variables [preorder α] + +/-! Lemmas of the form `a ≤ a * b ↔ 1 ≤ b` and `a * b ≤ a ↔ b ≤ 1`, +which assume left covariance. -/ + +@[simp] +lemma le_mul_iff_one_le_right + [pos_mul_mono α] [pos_mul_mono_rev α] + (a0 : 0 < a) : + a ≤ a * b ↔ 1 ≤ b := +iff.trans (by rw [mul_one]) (mul_le_mul_left a0) + +@[simp] +lemma lt_mul_iff_one_lt_right + [pos_mul_strict_mono α] [pos_mul_reflect_lt α] + (a0 : 0 < a) : + a < a * b ↔ 1 < b := +iff.trans (by rw [mul_one]) (mul_lt_mul_left a0) + +@[simp] +lemma mul_le_iff_le_one_right + [pos_mul_mono α] [pos_mul_mono_rev α] + (a0 : 0 < a) : + a * b ≤ a ↔ b ≤ 1 := +iff.trans (by rw [mul_one]) (mul_le_mul_left a0) + +@[simp] +lemma mul_lt_iff_lt_one_right + [pos_mul_strict_mono α] [pos_mul_reflect_lt α] + (a0 : 0 < a) : + a * b < a ↔ b < 1 := +iff.trans (by rw [mul_one]) (mul_lt_mul_left a0) + +/-! Lemmas of the form `a ≤ b * a ↔ 1 ≤ b` and `a * b ≤ b ↔ a ≤ 1`, +which assume right covariance. -/ + +@[simp] +lemma le_mul_iff_one_le_left + [mul_pos_mono α] [mul_pos_mono_rev α] + (a0 : 0 < a) : + a ≤ b * a ↔ 1 ≤ b := +iff.trans (by rw [one_mul]) (mul_le_mul_right a0) + +@[simp] +lemma lt_mul_iff_one_lt_left + [mul_pos_strict_mono α] [mul_pos_reflect_lt α] + (a0 : 0 < a) : + a < b * a ↔ 1 < b := +iff.trans (by rw [one_mul]) (mul_lt_mul_right a0) + +@[simp] +lemma mul_le_iff_le_one_left + [mul_pos_mono α] [mul_pos_mono_rev α] + (b0 : 0 < b) : + a * b ≤ b ↔ a ≤ 1 := +iff.trans (by rw [one_mul]) (mul_le_mul_right b0) + +@[simp] +lemma mul_lt_iff_lt_one_left + [mul_pos_strict_mono α] [mul_pos_reflect_lt α] + (b0 : 0 < b) : + a * b < b ↔ a < 1 := +iff.trans (by rw [one_mul]) (mul_lt_mul_right b0) + +/-! Lemmas of the form `1 ≤ b → a ≤ a * b`. + +Variants with `< 0` and `≤ 0` instead of `0 <` and `0 ≤` appear in `algebra/order/ring/defs` (which +imports this file) as they need additional results which are not yet available here. -/ + +lemma mul_le_of_le_one_left [mul_pos_mono α] (hb : 0 ≤ b) (h : a ≤ 1) : a * b ≤ b := +by simpa only [one_mul] using mul_le_mul_of_nonneg_right h hb + +lemma le_mul_of_one_le_left [mul_pos_mono α] (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ a * b := +by simpa only [one_mul] using mul_le_mul_of_nonneg_right h hb + +lemma mul_le_of_le_one_right [pos_mul_mono α] (ha : 0 ≤ a) (h : b ≤ 1) : a * b ≤ a := +by simpa only [mul_one] using mul_le_mul_of_nonneg_left h ha + +lemma le_mul_of_one_le_right [pos_mul_mono α] (ha : 0 ≤ a) (h : 1 ≤ b) : a ≤ a * b := +by simpa only [mul_one] using mul_le_mul_of_nonneg_left h ha + +lemma mul_lt_of_lt_one_left [mul_pos_strict_mono α] (hb : 0 < b) (h : a < 1) : a * b < b := +by simpa only [one_mul] using mul_lt_mul_of_pos_right h hb + +lemma lt_mul_of_one_lt_left [mul_pos_strict_mono α] (hb : 0 < b) (h : 1 < a) : b < a * b := +by simpa only [one_mul] using mul_lt_mul_of_pos_right h hb + +lemma mul_lt_of_lt_one_right [pos_mul_strict_mono α] (ha : 0 < a) (h : b < 1) : a * b < a := +by simpa only [mul_one] using mul_lt_mul_of_pos_left h ha + +lemma lt_mul_of_one_lt_right [pos_mul_strict_mono α] (ha : 0 < a) (h : 1 < b) : a < a * b := +by simpa only [mul_one] using mul_lt_mul_of_pos_left h ha + +/-! Lemmas of the form `b ≤ c → a ≤ 1 → b * a ≤ c`. -/ +/- Yaël: What's the point of these lemmas? They just chain an existing lemma with an assumption in +all possible ways, thereby artificially inflating the API and making the truly relevant lemmas hard +to find -/ + +lemma mul_le_of_le_of_le_one_of_nonneg [pos_mul_mono α] (h : b ≤ c) (ha : a ≤ 1) (hb : 0 ≤ b) : + b * a ≤ c := +(mul_le_of_le_one_right hb ha).trans h + +lemma mul_lt_of_le_of_lt_one_of_pos [pos_mul_strict_mono α] (bc : b ≤ c) (ha : a < 1) (b0 : 0 < b) : + b * a < c := +(mul_lt_of_lt_one_right b0 ha).trans_le bc + +lemma mul_lt_of_lt_of_le_one_of_nonneg [pos_mul_mono α] (h : b < c) (ha : a ≤ 1) (hb : 0 ≤ b) : + b * a < c := +(mul_le_of_le_one_right hb ha).trans_lt h + +/-- Assumes left covariance. -/ +lemma left.mul_le_one_of_le_of_le [pos_mul_mono α] (ha : a ≤ 1) (hb : b ≤ 1) (a0 : 0 ≤ a) : + a * b ≤ 1 := +mul_le_of_le_of_le_one_of_nonneg ha hb a0 + +/-- Assumes left covariance. -/ +lemma left.mul_lt_of_le_of_lt_one_of_pos [pos_mul_strict_mono α] + (ha : a ≤ 1) (hb : b < 1) (a0 : 0 < a) : a * b < 1 := +mul_lt_of_le_of_lt_one_of_pos ha hb a0 + +/-- Assumes left covariance. -/ +lemma left.mul_lt_of_lt_of_le_one_of_nonneg [pos_mul_mono α] + (ha : a < 1) (hb : b ≤ 1) (a0 : 0 ≤ a) : a * b < 1 := +mul_lt_of_lt_of_le_one_of_nonneg ha hb a0 + +lemma mul_le_of_le_of_le_one' [pos_mul_mono α] [mul_pos_mono α] + (bc : b ≤ c) (ha : a ≤ 1) (a0 : 0 ≤ a) (c0 : 0 ≤ c) : b * a ≤ c := +(mul_le_mul_of_nonneg_right bc a0).trans $ mul_le_of_le_one_right c0 ha + +lemma mul_lt_of_lt_of_le_one' [pos_mul_mono α] [mul_pos_strict_mono α] + (bc : b < c) (ha : a ≤ 1) (a0 : 0 < a) (c0 : 0 ≤ c) : b * a < c := +(mul_lt_mul_of_pos_right bc a0).trans_le $ mul_le_of_le_one_right c0 ha + +lemma mul_lt_of_le_of_lt_one' [pos_mul_strict_mono α] [mul_pos_mono α] + (bc : b ≤ c) (ha : a < 1) (a0 : 0 ≤ a) (c0 : 0 < c) : b * a < c := +(mul_le_mul_of_nonneg_right bc a0).trans_lt $ mul_lt_of_lt_one_right c0 ha + +lemma mul_lt_of_lt_of_lt_one_of_pos [pos_mul_mono α] [mul_pos_strict_mono α] + (bc : b < c) (ha : a ≤ 1) (a0 : 0 < a) (c0 : 0 ≤ c) : b * a < c := +(mul_lt_mul_of_pos_right bc a0).trans_le $ mul_le_of_le_one_right c0 ha + +/-! Lemmas of the form `b ≤ c → 1 ≤ a → b ≤ c * a`. -/ + +lemma le_mul_of_le_of_one_le_of_nonneg [pos_mul_mono α] (h : b ≤ c) (ha : 1 ≤ a) (hc : 0 ≤ c) : + b ≤ c * a := +h.trans $ le_mul_of_one_le_right hc ha + +lemma lt_mul_of_le_of_one_lt_of_pos [pos_mul_strict_mono α] (bc : b ≤ c) (ha : 1 < a) (c0 : 0 < c) : + b < c * a := +bc.trans_lt $ lt_mul_of_one_lt_right c0 ha + +lemma lt_mul_of_lt_of_one_le_of_nonneg [pos_mul_mono α] (h : b < c) (ha : 1 ≤ a) (hc : 0 ≤ c) : + b < c * a := +h.trans_le $ le_mul_of_one_le_right hc ha + +/-- Assumes left covariance. -/ +lemma left.one_le_mul_of_le_of_le [pos_mul_mono α] (ha : 1 ≤ a) (hb : 1 ≤ b) (a0 : 0 ≤ a) : + 1 ≤ a * b := +le_mul_of_le_of_one_le_of_nonneg ha hb a0 + +/-- Assumes left covariance. -/ +lemma left.one_lt_mul_of_le_of_lt_of_pos [pos_mul_strict_mono α] + (ha : 1 ≤ a) (hb : 1 < b) (a0 : 0 < a) : 1 < a * b := +lt_mul_of_le_of_one_lt_of_pos ha hb a0 + +/-- Assumes left covariance. -/ +lemma left.lt_mul_of_lt_of_one_le_of_nonneg [pos_mul_mono α] + (ha : 1 < a) (hb : 1 ≤ b) (a0 : 0 ≤ a) : 1 < a * b := +lt_mul_of_lt_of_one_le_of_nonneg ha hb a0 + +lemma le_mul_of_le_of_one_le' [pos_mul_mono α] [mul_pos_mono α] + (bc : b ≤ c) (ha : 1 ≤ a) (a0 : 0 ≤ a) (b0 : 0 ≤ b) : b ≤ c * a := +(le_mul_of_one_le_right b0 ha).trans $ mul_le_mul_of_nonneg_right bc a0 + +lemma lt_mul_of_le_of_one_lt' [pos_mul_strict_mono α] [mul_pos_mono α] + (bc : b ≤ c) (ha : 1 < a) (a0 : 0 ≤ a) (b0 : 0 < b) : b < c * a := +(lt_mul_of_one_lt_right b0 ha).trans_le $ mul_le_mul_of_nonneg_right bc a0 + +lemma lt_mul_of_lt_of_one_le' [pos_mul_mono α] [mul_pos_strict_mono α] + (bc : b < c) (ha : 1 ≤ a) (a0 : 0 < a) (b0 : 0 ≤ b) : b < c * a := +(le_mul_of_one_le_right b0 ha).trans_lt $ mul_lt_mul_of_pos_right bc a0 + +lemma lt_mul_of_lt_of_one_lt_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α] + (bc : b < c) (ha : 1 < a) (a0 : 0 < a) (b0 : 0 < b) : b < c * a := +(lt_mul_of_one_lt_right b0 ha).trans $ mul_lt_mul_of_pos_right bc a0 + +/-! Lemmas of the form `a ≤ 1 → b ≤ c → a * b ≤ c`. -/ + +lemma mul_le_of_le_one_of_le_of_nonneg [mul_pos_mono α] (ha : a ≤ 1) (h : b ≤ c) (hb : 0 ≤ b) : + a * b ≤ c := +(mul_le_of_le_one_left hb ha).trans h + +lemma mul_lt_of_lt_one_of_le_of_pos [mul_pos_strict_mono α] (ha : a < 1) (h : b ≤ c) (hb : 0 < b) : + a * b < c := +(mul_lt_of_lt_one_left hb ha).trans_le h + +lemma mul_lt_of_le_one_of_lt_of_nonneg [mul_pos_mono α] (ha : a ≤ 1) (h : b < c) (hb : 0 ≤ b) : + a * b < c := +(mul_le_of_le_one_left hb ha).trans_lt h + +/-- Assumes right covariance. -/ +lemma right.mul_lt_one_of_lt_of_le_of_pos [mul_pos_strict_mono α] + (ha : a < 1) (hb : b ≤ 1) (b0 : 0 < b) : a * b < 1 := +mul_lt_of_lt_one_of_le_of_pos ha hb b0 + +/-- Assumes right covariance. -/ +lemma right.mul_lt_one_of_le_of_lt_of_nonneg [mul_pos_mono α] + (ha : a ≤ 1) (hb : b < 1) (b0 : 0 ≤ b) : a * b < 1 := +mul_lt_of_le_one_of_lt_of_nonneg ha hb b0 + +lemma mul_lt_of_lt_one_of_lt_of_pos [pos_mul_strict_mono α] [mul_pos_strict_mono α] + (ha : a < 1) (bc : b < c) (a0 : 0 < a) (c0 : 0 < c) : a * b < c := +(mul_lt_mul_of_pos_left bc a0).trans $ mul_lt_of_lt_one_left c0 ha + +/-- Assumes right covariance. -/ +lemma right.mul_le_one_of_le_of_le [mul_pos_mono α] + (ha : a ≤ 1) (hb : b ≤ 1) (b0 : 0 ≤ b) : a * b ≤ 1 := +mul_le_of_le_one_of_le_of_nonneg ha hb b0 + +lemma mul_le_of_le_one_of_le' [pos_mul_mono α] [mul_pos_mono α] + (ha : a ≤ 1) (bc : b ≤ c) (a0 : 0 ≤ a) (c0 : 0 ≤ c) : a * b ≤ c := +(mul_le_mul_of_nonneg_left bc a0).trans $ mul_le_of_le_one_left c0 ha + +lemma mul_lt_of_lt_one_of_le' [pos_mul_mono α] [mul_pos_strict_mono α] + (ha : a < 1) (bc : b ≤ c) (a0 : 0 ≤ a) (c0 : 0 < c) : a * b < c := +(mul_le_mul_of_nonneg_left bc a0).trans_lt $ mul_lt_of_lt_one_left c0 ha + +lemma mul_lt_of_le_one_of_lt' [pos_mul_strict_mono α] [mul_pos_mono α] + (ha : a ≤ 1) (bc : b < c) (a0 : 0 < a) (c0 : 0 ≤ c) : a * b < c := +(mul_lt_mul_of_pos_left bc a0).trans_le $ mul_le_of_le_one_left c0 ha + +/-! Lemmas of the form `1 ≤ a → b ≤ c → b ≤ a * c`. -/ + +lemma lt_mul_of_one_lt_of_le_of_pos [mul_pos_strict_mono α] (ha : 1 < a) (h : b ≤ c) (hc : 0 < c) : + b < a * c := +h.trans_lt $ lt_mul_of_one_lt_left hc ha + +lemma lt_mul_of_one_le_of_lt_of_nonneg [mul_pos_mono α] (ha : 1 ≤ a) (h : b < c) (hc : 0 ≤ c) : + b < a * c := +h.trans_le $ le_mul_of_one_le_left hc ha + +lemma lt_mul_of_one_lt_of_lt_of_pos [mul_pos_strict_mono α] (ha : 1 < a) (h : b < c) (hc : 0 < c) : + b < a * c := +h.trans $ lt_mul_of_one_lt_left hc ha + +/-- Assumes right covariance. -/ +lemma right.one_lt_mul_of_lt_of_le_of_pos [mul_pos_strict_mono α] + (ha : 1 < a) (hb : 1 ≤ b) (b0 : 0 < b) : 1 < a * b := +lt_mul_of_one_lt_of_le_of_pos ha hb b0 + +/-- Assumes right covariance. -/ +lemma right.one_lt_mul_of_le_of_lt_of_nonneg [mul_pos_mono α] + (ha : 1 ≤ a) (hb : 1 < b) (b0 : 0 ≤ b) : 1 < a * b := +lt_mul_of_one_le_of_lt_of_nonneg ha hb b0 + +/-- Assumes right covariance. -/ +lemma right.one_lt_mul_of_lt_of_lt [mul_pos_strict_mono α] + (ha : 1 < a) (hb : 1 < b) (b0 : 0 < b) : 1 < a * b := +lt_mul_of_one_lt_of_lt_of_pos ha hb b0 + +lemma lt_mul_of_one_lt_of_lt_of_nonneg [mul_pos_mono α] (ha : 1 ≤ a) (h : b < c) (hc : 0 ≤ c) : + b < a * c := +h.trans_le $ le_mul_of_one_le_left hc ha + +lemma lt_of_mul_lt_of_one_le_of_nonneg_left [pos_mul_mono α] (h : a * b < c) (hle : 1 ≤ b) + (ha : 0 ≤ a) : + a < c := +(le_mul_of_one_le_right ha hle).trans_lt h + +lemma lt_of_lt_mul_of_le_one_of_nonneg_left [pos_mul_mono α] (h : a < b * c) (hc : c ≤ 1) + (hb : 0 ≤ b) : + a < b := +h.trans_le $ mul_le_of_le_one_right hb hc + +lemma lt_of_lt_mul_of_le_one_of_nonneg_right [mul_pos_mono α] (h : a < b * c) (hb : b ≤ 1) + (hc : 0 ≤ c) : + a < c := +h.trans_le $ mul_le_of_le_one_left hc hb + +lemma le_mul_of_one_le_of_le_of_nonneg [mul_pos_mono α] (ha : 1 ≤ a) (bc : b ≤ c) (c0 : 0 ≤ c) : + b ≤ a * c := +bc.trans $ le_mul_of_one_le_left c0 ha + +/-- Assumes right covariance. -/ +lemma right.one_le_mul_of_le_of_le [mul_pos_mono α] (ha : 1 ≤ a) (hb : 1 ≤ b) (b0 : 0 ≤ b) : + 1 ≤ a * b := +le_mul_of_one_le_of_le_of_nonneg ha hb b0 + +lemma le_of_mul_le_of_one_le_of_nonneg_left [pos_mul_mono α] (h : a * b ≤ c) (hb : 1 ≤ b) + (ha : 0 ≤ a) : + a ≤ c := +(le_mul_of_one_le_right ha hb).trans h + +lemma le_of_le_mul_of_le_one_of_nonneg_left [pos_mul_mono α] (h : a ≤ b * c) (hc : c ≤ 1) + (hb : 0 ≤ b) : + a ≤ b := +h.trans $ mul_le_of_le_one_right hb hc + +lemma le_of_mul_le_of_one_le_nonneg_right [mul_pos_mono α] (h : a * b ≤ c) (ha : 1 ≤ a) + (hb : 0 ≤ b) : + b ≤ c := +(le_mul_of_one_le_left hb ha).trans h + +lemma le_of_le_mul_of_le_one_of_nonneg_right [mul_pos_mono α] (h : a ≤ b * c) (hb : b ≤ 1) + (hc : 0 ≤ c) : + a ≤ c := +h.trans $ mul_le_of_le_one_left hc hb + +end preorder + +section linear_order +variables [linear_order α] + +-- Yaël: What's the point of this lemma? If we have `0 * 0 = 0`, then we can just take `b = 0`. +-- proven with `a0 : 0 ≤ a` as `exists_square_le` +lemma exists_square_le' [pos_mul_strict_mono α] (a0 : 0 < a) : ∃ (b : α), b * b ≤ a := +begin + obtain ha | ha := lt_or_le a 1, + { exact ⟨a, (mul_lt_of_lt_one_right a0 ha).le⟩ }, + { exact ⟨1, by rwa mul_one⟩ } +end + +end linear_order +end mul_one_class + +section cancel_monoid_with_zero + +variables [cancel_monoid_with_zero α] + +section partial_order +variables [partial_order α] + +lemma pos_mul_mono.to_pos_mul_strict_mono [pos_mul_mono α] : pos_mul_strict_mono α := +⟨λ x a b h, (mul_le_mul_of_nonneg_left h.le x.2.le).lt_of_ne (h.ne ∘ mul_left_cancel₀ x.2.ne')⟩ + +lemma pos_mul_mono_iff_pos_mul_strict_mono : pos_mul_mono α ↔ pos_mul_strict_mono α := +⟨@pos_mul_mono.to_pos_mul_strict_mono α _ _, @pos_mul_strict_mono.to_pos_mul_mono α _ _⟩ + +lemma mul_pos_mono.to_mul_pos_strict_mono [mul_pos_mono α] : mul_pos_strict_mono α := +⟨λ x a b h, (mul_le_mul_of_nonneg_right h.le x.2.le).lt_of_ne (h.ne ∘ mul_right_cancel₀ x.2.ne')⟩ + +lemma mul_pos_mono_iff_mul_pos_strict_mono : mul_pos_mono α ↔ mul_pos_strict_mono α := +⟨@mul_pos_mono.to_mul_pos_strict_mono α _ _, @mul_pos_strict_mono.to_mul_pos_mono α _ _⟩ + +lemma pos_mul_reflect_lt.to_pos_mul_mono_rev [pos_mul_reflect_lt α] : pos_mul_mono_rev α := +⟨λ x a b h, h.eq_or_lt.elim (le_of_eq ∘ mul_left_cancel₀ x.2.ne.symm) + (λ h', (lt_of_mul_lt_mul_left h' x.2.le).le)⟩ + +lemma pos_mul_mono_rev_iff_pos_mul_reflect_lt : pos_mul_mono_rev α ↔ pos_mul_reflect_lt α := +⟨@pos_mul_mono_rev.to_pos_mul_reflect_lt α _ _, @pos_mul_reflect_lt.to_pos_mul_mono_rev α _ _⟩ + +lemma mul_pos_reflect_lt.to_mul_pos_mono_rev [mul_pos_reflect_lt α] : mul_pos_mono_rev α := +⟨λ x a b h, h.eq_or_lt.elim (le_of_eq ∘ mul_right_cancel₀ x.2.ne.symm) + (λ h', (lt_of_mul_lt_mul_right h' x.2.le).le)⟩ + +lemma mul_pos_mono_rev_iff_mul_pos_reflect_lt : mul_pos_mono_rev α ↔ mul_pos_reflect_lt α := +⟨@mul_pos_mono_rev.to_mul_pos_reflect_lt α _ _, @mul_pos_reflect_lt.to_mul_pos_mono_rev α _ _⟩ + +end partial_order + +end cancel_monoid_with_zero + +section comm_semigroup_has_zero +variables [comm_semigroup α] [has_zero α] [preorder α] + +lemma pos_mul_strict_mono_iff_mul_pos_strict_mono : + pos_mul_strict_mono α ↔ mul_pos_strict_mono α := +by simp ! only [mul_comm] + +lemma pos_mul_reflect_lt_iff_mul_pos_reflect_lt : + pos_mul_reflect_lt α ↔ mul_pos_reflect_lt α := +by simp ! only [mul_comm] + +lemma pos_mul_mono_iff_mul_pos_mono : + pos_mul_mono α ↔ mul_pos_mono α := +by simp ! only [mul_comm] + +lemma pos_mul_mono_rev_iff_mul_pos_mono_rev : + pos_mul_mono_rev α ↔ mul_pos_mono_rev α := +by simp ! only [mul_comm] + +end comm_semigroup_has_zero diff --git a/src/algebra/order/ring/with_top.lean b/src/algebra/order/ring/with_top.lean new file mode 100644 index 0000000000000..aa0716b3ef5dd --- /dev/null +++ b/src/algebra/order/ring/with_top.lean @@ -0,0 +1,373 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro +-/ +import algebra.hom.ring +import algebra.order.monoid.with_top +import algebra.order.ring.canonical + +/-! # Structures involving `*` and `0` on `with_top` and `with_bot` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The main results of this section are `with_top.canonically_ordered_comm_semiring` and +`with_bot.ordered_comm_semiring`. +-/ + +variables {α : Type*} + +namespace with_top + +variable [decidable_eq α] + +section has_mul + +variables [has_zero α] [has_mul α] + +instance : mul_zero_class (with_top α) := +{ zero := 0, + mul := λ m n, if m = 0 ∨ n = 0 then 0 else option.map₂ (*) m n, + zero_mul := assume a, if_pos $ or.inl rfl, + mul_zero := assume a, if_pos $ or.inr rfl } + +lemma mul_def {a b : with_top α} : a * b = if a = 0 ∨ b = 0 then 0 else option.map₂ (*) a b := rfl + +lemma mul_top' {a : with_top α} : a * ⊤ = if a = 0 then 0 else ⊤ := +by induction a using with_top.rec_top_coe; simp [mul_def]; refl + +@[simp] lemma mul_top {a : with_top α} (h : a ≠ 0) : a * ⊤ = ⊤ := by rw [mul_top', if_neg h] + +lemma top_mul' {a : with_top α} : ⊤ * a = if a = 0 then 0 else ⊤ := +by induction a using with_top.rec_top_coe; simp [mul_def]; refl + +@[simp] lemma top_mul {a : with_top α} (h : a ≠ 0) : ⊤ * a = ⊤ := by rw [top_mul', if_neg h] + +@[simp] lemma top_mul_top : (⊤ * ⊤ : with_top α) = ⊤ := +top_mul top_ne_zero + +theorem mul_eq_top_iff {a b : with_top α} : a * b = ⊤ ↔ a ≠ 0 ∧ b = ⊤ ∨ a = ⊤ ∧ b ≠ 0 := +begin + rw [mul_def, ite_eq_iff, ← none_eq_top, option.map₂_eq_none_iff], + have ha : a = 0 → a ≠ none := λ h, h.symm ▸ zero_ne_top, + have hb : b = 0 → b ≠ none := λ h, h.symm ▸ zero_ne_top, + tauto +end + +theorem mul_lt_top' [has_lt α] {a b : with_top α} (ha : a < ⊤) (hb : b < ⊤) : a * b < ⊤ := +begin + rw [with_top.lt_top_iff_ne_top] at *, + simp only [ne.def, mul_eq_top_iff, *, and_false, false_and, false_or, not_false_iff] +end + +theorem mul_lt_top [has_lt α] {a b : with_top α} (ha : a ≠ ⊤) (hb : b ≠ ⊤) : a * b < ⊤ := + mul_lt_top' (with_top.lt_top_iff_ne_top.2 ha) (with_top.lt_top_iff_ne_top.2 hb) + +instance [no_zero_divisors α] : no_zero_divisors (with_top α) := +begin + refine ⟨λ a b h₁, decidable.by_contradiction $ λ h₂, _⟩, + rw [mul_def, if_neg h₂] at h₁, + rcases option.mem_map₂_iff.1 h₁ with ⟨a, b, (rfl : _ = _), (rfl : _ = _), hab⟩, + exact h₂ ((eq_zero_or_eq_zero_of_mul_eq_zero hab).imp (congr_arg some) (congr_arg some)) +end + +end has_mul + +section mul_zero_class + +variables [mul_zero_class α] + +@[simp, norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_top α) = a * b := +decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha, +decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb, +by { simp [*, mul_def] } + +lemma mul_coe {b : α} (hb : b ≠ 0) : ∀{a : with_top α}, a * b = a.bind (λa:α, ↑(a * b)) +| none := show (if (⊤:with_top α) = 0 ∨ (b:with_top α) = 0 then 0 else ⊤ : with_top α) = ⊤, + by simp [hb] +| (some a) := show ↑a * ↑b = ↑(a * b), from coe_mul.symm + +@[simp] lemma untop'_zero_mul (a b : with_top α) : (a * b).untop' 0 = a.untop' 0 * b.untop' 0 := +begin + by_cases ha : a = 0, { rw [ha, zero_mul, ← coe_zero, untop'_coe, zero_mul] }, + by_cases hb : b = 0, { rw [hb, mul_zero, ← coe_zero, untop'_coe, mul_zero] }, + induction a using with_top.rec_top_coe, { rw [top_mul hb, untop'_top, zero_mul] }, + induction b using with_top.rec_top_coe, { rw [mul_top ha, untop'_top, mul_zero] }, + rw [← coe_mul, untop'_coe, untop'_coe, untop'_coe] +end + +end mul_zero_class + +/-- `nontrivial α` is needed here as otherwise we have `1 * ⊤ = ⊤` but also `0 * ⊤ = 0`. -/ +instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_top α) := +{ mul := (*), + one := 1, + zero := 0, + one_mul := λ a, match a with + | ⊤ := mul_top (mt coe_eq_coe.1 one_ne_zero) + | (a : α) := by rw [← coe_one, ← coe_mul, one_mul] + end, + mul_one := λ a, match a with + | ⊤ := top_mul (mt coe_eq_coe.1 one_ne_zero) + | (a : α) := by rw [← coe_one, ← coe_mul, mul_one] + end, + .. with_top.mul_zero_class } + +/-- A version of `with_top.map` for `monoid_with_zero_hom`s. -/ +@[simps { fully_applied := ff }] protected def _root_.monoid_with_zero_hom.with_top_map + {R S : Type*} [mul_zero_one_class R] [decidable_eq R] [nontrivial R] + [mul_zero_one_class S] [decidable_eq S] [nontrivial S] (f : R →*₀ S) (hf : function.injective f) : + with_top R →*₀ with_top S := +{ to_fun := with_top.map f, + map_mul' := λ x y, + begin + have : ∀ z, map f z = 0 ↔ z = 0, + from λ z, (option.map_injective hf).eq_iff' f.to_zero_hom.with_top_map.map_zero, + rcases decidable.eq_or_ne x 0 with rfl|hx, { simp }, + rcases decidable.eq_or_ne y 0 with rfl|hy, { simp }, + induction x using with_top.rec_top_coe, { simp [hy, this] }, + induction y using with_top.rec_top_coe, + { have : (f x : with_top S) ≠ 0, by simpa [hf.eq_iff' (map_zero f)] using hx, + simp [hx, this] }, + simp only [← coe_mul, map_coe, map_mul] + end, + .. f.to_zero_hom.with_top_map, .. f.to_monoid_hom.to_one_hom.with_top_map } + +instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_top α) := +{ mul := (*), + zero := 0, + mul_assoc := λ a b c, begin + rcases eq_or_ne a 0 with rfl|ha, { simp only [zero_mul] }, + rcases eq_or_ne b 0 with rfl|hb, { simp only [zero_mul, mul_zero] }, + rcases eq_or_ne c 0 with rfl|hc, { simp only [mul_zero] }, + induction a using with_top.rec_top_coe, { simp [hb, hc] }, + induction b using with_top.rec_top_coe, { simp [ha, hc] }, + induction c using with_top.rec_top_coe, { simp [ha, hb] }, + simp only [← coe_mul, mul_assoc] + end, + .. with_top.mul_zero_class } + +instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_top α) := +{ .. with_top.mul_zero_one_class, .. with_top.semigroup_with_zero } + +instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : + comm_monoid_with_zero (with_top α) := +{ mul := (*), + zero := 0, + mul_comm := λ a b, + by simp only [or_comm, mul_def, mul_comm, @option.map₂_comm _ _ _ _ a b _ mul_comm], + .. with_top.monoid_with_zero } + +variables [canonically_ordered_comm_semiring α] + +private lemma distrib' (a b c : with_top α) : (a + b) * c = a * c + b * c := +begin + induction c using with_top.rec_top_coe, + { by_cases ha : a = 0; simp [ha] }, + { by_cases hc : c = 0, { simp [hc] }, + simp only [mul_coe hc], cases a; cases b, + repeat { refl <|> exact congr_arg some (add_mul _ _ _) } } +end + +/-- This instance requires `canonically_ordered_comm_semiring` as it is the smallest class +that derives from both `non_assoc_non_unital_semiring` and `canonically_ordered_add_monoid`, both +of which are required for distributivity. -/ +instance [nontrivial α] : comm_semiring (with_top α) := +{ right_distrib := distrib', + left_distrib := λ a b c, by { rw [mul_comm, distrib', mul_comm b, mul_comm c], refl }, + .. with_top.add_comm_monoid_with_one, .. with_top.comm_monoid_with_zero } + +instance [nontrivial α] : canonically_ordered_comm_semiring (with_top α) := +{ .. with_top.comm_semiring, + .. with_top.canonically_ordered_add_monoid, + .. with_top.no_zero_divisors, } + +/-- A version of `with_top.map` for `ring_hom`s. -/ +@[simps { fully_applied := ff }] protected def _root_.ring_hom.with_top_map + {R S : Type*} [canonically_ordered_comm_semiring R] [decidable_eq R] [nontrivial R] + [canonically_ordered_comm_semiring S] [decidable_eq S] [nontrivial S] + (f : R →+* S) (hf : function.injective f) : + with_top R →+* with_top S := +{ to_fun := with_top.map f, + .. f.to_monoid_with_zero_hom.with_top_map hf, .. f.to_add_monoid_hom.with_top_map } + +end with_top + +namespace with_bot + +variable [decidable_eq α] + +section has_mul + +variables [has_zero α] [has_mul α] + +instance : mul_zero_class (with_bot α) := +with_top.mul_zero_class + +lemma mul_def {a b : with_bot α} : + a * b = if a = 0 ∨ b = 0 then 0 else option.map₂ (*) a b := rfl + +@[simp] lemma mul_bot {a : with_bot α} (h : a ≠ 0) : a * ⊥ = ⊥ := +with_top.mul_top h + +@[simp] lemma bot_mul {a : with_bot α} (h : a ≠ 0) : ⊥ * a = ⊥ := +with_top.top_mul h + +@[simp] lemma bot_mul_bot : (⊥ * ⊥ : with_bot α) = ⊥ := +with_top.top_mul_top + +theorem mul_eq_bot_iff {a b : with_bot α} : a * b = ⊥ ↔ a ≠ 0 ∧ b = ⊥ ∨ a = ⊥ ∧ b ≠ 0 := +with_top.mul_eq_top_iff + +theorem bot_lt_mul' [has_lt α] {a b : with_bot α} (ha : ⊥ < a) (hb : ⊥ < b) : ⊥ < a * b := +@with_top.mul_lt_top' αᵒᵈ _ _ _ _ _ _ ha hb + +theorem bot_lt_mul [has_lt α] {a b : with_bot α} (ha : a ≠ ⊥) (hb : b ≠ ⊥) : ⊥ < a * b := +@with_top.mul_lt_top αᵒᵈ _ _ _ _ _ _ ha hb + +end has_mul + +section mul_zero_class + +variables [mul_zero_class α] + +@[norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_bot α) = a * b := +with_top.coe_mul + +lemma mul_coe {b : α} (hb : b ≠ 0) {a : with_bot α} : a * b = a.bind (λa:α, ↑(a * b)) := +with_top.mul_coe hb + +end mul_zero_class + +/-- `nontrivial α` is needed here as otherwise we have `1 * ⊥ = ⊥` but also `= 0 * ⊥ = 0`. -/ +instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_bot α) := +with_top.mul_zero_one_class + +instance [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_bot α) := +with_top.no_zero_divisors + +instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_bot α) := +with_top.semigroup_with_zero + +instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_bot α) := +with_top.monoid_with_zero + +instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : + comm_monoid_with_zero (with_bot α) := +with_top.comm_monoid_with_zero + +instance [canonically_ordered_comm_semiring α] [nontrivial α] : comm_semiring (with_bot α) := +with_top.comm_semiring + +instance [mul_zero_class α] [preorder α] [pos_mul_mono α] : + pos_mul_mono (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk], + rcases eq_or_ne x 0 with rfl | x0', { simp, }, + lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, }, + induction a using with_bot.rec_bot_coe, { simp_rw [mul_bot x0', bot_le] }, + induction b using with_bot.rec_bot_coe, { exact absurd h (bot_lt_coe a).not_le }, + simp only [← coe_mul, coe_le_coe] at *, + norm_cast at x0, + exact mul_le_mul_of_nonneg_left h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [mul_pos_mono α] : + mul_pos_mono (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk], + rcases eq_or_ne x 0 with rfl | x0', { simp, }, + lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, }, + induction a using with_bot.rec_bot_coe, { simp_rw [bot_mul x0', bot_le] }, + induction b using with_bot.rec_bot_coe, { exact absurd h (bot_lt_coe a).not_le }, + simp only [← coe_mul, coe_le_coe] at *, + norm_cast at x0, + exact mul_le_mul_of_nonneg_right h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [pos_mul_strict_mono α] : + pos_mul_strict_mono (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk], + lift x to α using x0.ne_bot, + induction b using with_bot.rec_bot_coe, { exact absurd h not_lt_bot, }, + induction a using with_bot.rec_bot_coe, { simp_rw [mul_bot x0.ne.symm, ← coe_mul, bot_lt_coe], }, + simp only [← coe_mul, coe_lt_coe] at *, + norm_cast at x0, + exact mul_lt_mul_of_pos_left h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [mul_pos_strict_mono α] : + mul_pos_strict_mono (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk], + lift x to α using x0.ne_bot, + induction b using with_bot.rec_bot_coe, { exact absurd h not_lt_bot, }, + induction a using with_bot.rec_bot_coe, { simp_rw [bot_mul x0.ne.symm, ← coe_mul, bot_lt_coe], }, + simp only [← coe_mul, coe_lt_coe] at *, + norm_cast at x0, + exact mul_lt_mul_of_pos_right h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [pos_mul_reflect_lt α] : + pos_mul_reflect_lt (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h, + rcases eq_or_ne x 0 with rfl | x0', { simpa using h, }, + lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, }, + induction b using with_bot.rec_bot_coe, { rw [mul_bot x0'] at h, exact absurd h bot_le.not_lt, }, + induction a using with_bot.rec_bot_coe, { exact with_bot.bot_lt_coe _, }, + simp only [← coe_mul, coe_lt_coe] at *, + norm_cast at x0, + exact lt_of_mul_lt_mul_left h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [mul_pos_reflect_lt α] : + mul_pos_reflect_lt (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h, + rcases eq_or_ne x 0 with rfl | x0', { simpa using h, }, + lift x to α, { rintro ⟨rfl⟩, exact (with_bot.bot_lt_coe (0 : α)).not_le x0, }, + induction b using with_bot.rec_bot_coe, { rw [bot_mul x0'] at h, exact absurd h bot_le.not_lt, }, + induction a using with_bot.rec_bot_coe, { exact with_bot.bot_lt_coe _, }, + simp only [← coe_mul, coe_lt_coe] at *, + norm_cast at x0, + exact lt_of_mul_lt_mul_right h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [pos_mul_mono_rev α] : + pos_mul_mono_rev (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h, + lift x to α using x0.ne_bot, + induction a using with_bot.rec_bot_coe, { exact bot_le, }, + induction b using with_bot.rec_bot_coe, + { rw [mul_bot x0.ne.symm, ← coe_mul] at h, exact absurd h (bot_lt_coe (x * a)).not_le, }, + simp only [← coe_mul, coe_le_coe] at *, + norm_cast at x0, + exact le_of_mul_le_mul_left h x0, +end ⟩ + +instance [mul_zero_class α] [preorder α] [mul_pos_mono_rev α] : + mul_pos_mono_rev (with_bot α) := +⟨begin + rintros ⟨x, x0⟩ a b h, simp only [subtype.coe_mk] at h, + lift x to α using x0.ne_bot, + induction a using with_bot.rec_bot_coe, { exact bot_le, }, + induction b using with_bot.rec_bot_coe, + { rw [bot_mul x0.ne.symm, ← coe_mul] at h, exact absurd h (bot_lt_coe (a * x)).not_le, }, + simp only [← coe_mul, coe_le_coe] at *, + norm_cast at x0, + exact le_of_mul_le_mul_right h x0, +end ⟩ + +instance [canonically_ordered_comm_semiring α] [nontrivial α] : + ordered_comm_semiring (with_bot α) := +{ mul_le_mul_of_nonneg_left := λ _ _ _, mul_le_mul_of_nonneg_left, + mul_le_mul_of_nonneg_right := λ _ _ _, mul_le_mul_of_nonneg_right, + .. with_bot.zero_le_one_class, + .. with_bot.ordered_add_comm_monoid, + .. with_bot.comm_semiring, } + +end with_bot diff --git a/src/algebra/order/smul.lean b/src/algebra/order/smul.lean index f7f874104681f..734d7ca1d0213 100644 --- a/src/algebra/order/smul.lean +++ b/src/algebra/order/smul.lean @@ -3,13 +3,19 @@ Copyright (c) 2020 Frédéric Dupuis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Frédéric Dupuis -/ - -import group_theory.group_action.group -import algebra.smul_with_zero +import algebra.module.pi +import algebra.module.prod +import algebra.order.monoid.prod +import algebra.order.pi +import data.set.pointwise.smul +import tactic.positivity /-! # Ordered scalar product +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define * `ordered_smul R M` : an ordered additive commutative monoid `M` is an `ordered_smul` @@ -34,6 +40,7 @@ In this file we define ordered module, ordered scalar, ordered smul, ordered action, ordered vector space -/ +open_locale pointwise /-- The ordered scalar product property is when an ordered additive commutative monoid @@ -45,21 +52,19 @@ class ordered_smul (R M : Type*) (smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, a < b → 0 < c → c • a < c • b) (lt_of_smul_lt_smul_of_pos : ∀ {a b : M}, ∀ {c : R}, c • a < c • b → 0 < c → a < b) -namespace order_dual +variables {ι 𝕜 R M N : Type*} -variables {R M : Type*} - -instance [has_scalar R M] : has_scalar R Mᵒᵈ := ⟨λ k x, order_dual.rec (λ x', (k • x' : M)) x⟩ +namespace order_dual instance [has_zero R] [add_zero_class M] [h : smul_with_zero R M] : smul_with_zero R Mᵒᵈ := { zero_smul := λ m, order_dual.rec (zero_smul _) m, - smul_zero := λ r, order_dual.rec (smul_zero' _) r, - ..order_dual.has_scalar } + smul_zero := λ r, order_dual.rec smul_zero r, + ..order_dual.has_smul } instance [monoid R] [mul_action R M] : mul_action R Mᵒᵈ := { one_smul := λ m, order_dual.rec (one_smul _) m, mul_smul := λ r, order_dual.rec mul_smul r, - ..order_dual.has_scalar } + ..order_dual.has_smul } instance [monoid_with_zero R] [add_monoid M] [mul_action_with_zero R M] : mul_action_with_zero R Mᵒᵈ := @@ -68,7 +73,7 @@ instance [monoid_with_zero R] [add_monoid M] [mul_action_with_zero R M] : instance [monoid_with_zero R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action R Mᵒᵈ := { smul_add := λ k a, order_dual.rec (λ a' b, order_dual.rec (smul_add _ _) b) a, - smul_zero := λ r, order_dual.rec smul_zero r } + smul_zero := λ r, order_dual.rec (@smul_zero _ M _ _) r } instance [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M] : @@ -77,17 +82,11 @@ instance [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] lt_of_smul_lt_smul_of_pos := λ a b, @ordered_smul.lt_of_smul_lt_smul_of_pos R M _ _ _ _ b a } -@[simp] lemma to_dual_smul [has_scalar R M] {c : R} {a : M} : to_dual (c • a) = c • to_dual a := rfl -@[simp] lemma of_dual_smul [has_scalar R M] {c : R} {a : Mᵒᵈ} : of_dual (c • a) = c • of_dual a := -rfl - end order_dual section ordered_smul - -variables {R M : Type*} - [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M] - {a b : M} {c : R} +variables [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M] + {s : set M} {a b : M} {c : R} lemma smul_lt_smul_of_pos : a < b → 0 < c → c • a < c • b := ordered_smul.smul_lt_smul_of_pos @@ -101,7 +100,7 @@ begin end lemma smul_nonneg (hc : 0 ≤ c) (ha : 0 ≤ a) : 0 ≤ c • a := -calc (0 : M) = c • (0 : M) : (smul_zero' M c).symm +calc (0 : M) = c • (0 : M) : (smul_zero c).symm ... ≤ c • a : smul_le_smul_of_nonneg ha hc lemma smul_nonpos_of_nonneg_of_nonpos (hc : 0 ≤ c) (ha : a ≤ 0) : c • a ≤ 0 := @@ -119,87 +118,200 @@ lemma smul_lt_smul_iff_of_pos (hc : 0 < c) : c • a < c • b ↔ a < b := ⟨λ h, lt_of_smul_lt_smul_of_nonneg h hc.le, λ h, smul_lt_smul_of_pos h hc⟩ lemma smul_pos_iff_of_pos (hc : 0 < c) : 0 < c • a ↔ 0 < a := -calc 0 < c • a ↔ c • 0 < c • a : by rw smul_zero' +calc 0 < c • a ↔ c • 0 < c • a : by rw smul_zero ... ↔ 0 < a : smul_lt_smul_iff_of_pos hc alias smul_pos_iff_of_pos ↔ _ smul_pos -lemma monotone_smul_left (hc : 0 ≤ c) : monotone (has_scalar.smul c : M → M) := +lemma monotone_smul_left (hc : 0 ≤ c) : monotone (has_smul.smul c : M → M) := λ a b h, smul_le_smul_of_nonneg h hc -lemma strict_mono_smul_left (hc : 0 < c) : strict_mono (has_scalar.smul c : M → M) := +lemma strict_mono_smul_left (hc : 0 < c) : strict_mono (has_smul.smul c : M → M) := λ a b h, smul_lt_smul_of_pos h hc +lemma smul_lower_bounds_subset_lower_bounds_smul (hc : 0 ≤ c) : + c • lower_bounds s ⊆ lower_bounds (c • s) := +(monotone_smul_left hc).image_lower_bounds_subset_lower_bounds_image + +lemma smul_upper_bounds_subset_upper_bounds_smul (hc : 0 ≤ c) : + c • upper_bounds s ⊆ upper_bounds (c • s) := +(monotone_smul_left hc).image_upper_bounds_subset_upper_bounds_image + +lemma bdd_below.smul_of_nonneg (hs : bdd_below s) (hc : 0 ≤ c) : bdd_below (c • s) := +(monotone_smul_left hc).map_bdd_below hs + +lemma bdd_above.smul_of_nonneg (hs : bdd_above s) (hc : 0 ≤ c) : bdd_above (c • s) := +(monotone_smul_left hc).map_bdd_above hs + end ordered_smul -/-- If `R` is a linear ordered semifield, then it suffices to verify only the first axiom of -`ordered_smul`. Moreover, it suffices to verify that `a < b` and `0 < c` imply -`c • a ≤ c • b`. We have no semifields in `mathlib`, so we use the assumption `∀ c ≠ 0, is_unit c` -instead. -/ -lemma ordered_smul.mk'' {R M : Type*} [linear_ordered_semiring R] [ordered_add_comm_monoid M] - [mul_action_with_zero R M] (hR : ∀ {c : R}, c ≠ 0 → is_unit c) - (hlt : ∀ ⦃a b : M⦄ ⦃c : R⦄, a < b → 0 < c → c • a ≤ c • b) : - ordered_smul R M := +/-- To prove that a linear ordered monoid is an ordered module, it suffices to verify only the first +axiom of `ordered_smul`. -/ +lemma ordered_smul.mk'' [ordered_semiring 𝕜] [linear_ordered_add_comm_monoid M] [smul_with_zero 𝕜 M] + (h : ∀ ⦃c : 𝕜⦄, 0 < c → strict_mono (λ a : M, c • a)) : + ordered_smul 𝕜 M := +{ smul_lt_smul_of_pos := λ a b c hab hc, h hc hab, + lt_of_smul_lt_smul_of_pos := λ a b c hab hc, (h hc).lt_iff_lt.1 hab } + +instance nat.ordered_smul [linear_ordered_cancel_add_comm_monoid M] : ordered_smul ℕ M := +ordered_smul.mk'' $ λ n hn a b hab, begin + cases n, + { cases hn }, + induction n with n ih, + { simp only [one_nsmul, hab], }, + { simp only [succ_nsmul _ n.succ, add_lt_add hab (ih n.succ_pos)] } +end + +instance int.ordered_smul [linear_ordered_add_comm_group M] : ordered_smul ℤ M := +ordered_smul.mk'' $ λ n hn, begin + cases n, + { simp only [int.of_nat_eq_coe, int.coe_nat_pos, coe_nat_zsmul] at ⊢ hn, + exact strict_mono_smul_left hn }, + { cases (int.neg_succ_not_pos _).1 hn } +end + +section linear_ordered_semiring +variables [linear_ordered_semiring R] [linear_ordered_add_comm_monoid M] [smul_with_zero R M] + [ordered_smul R M] {a : R} + +-- TODO: `linear_ordered_field M → ordered_smul ℚ M` + +instance linear_ordered_semiring.to_ordered_smul : ordered_smul R R := +ordered_smul.mk'' $ λ c, strict_mono_mul_left_of_pos + +lemma smul_max (ha : 0 ≤ a) (b₁ b₂ : M) : a • max b₁ b₂ = max (a • b₁) (a • b₂) := +(monotone_smul_left ha : monotone (_ : M → M)).map_max + +lemma smul_min (ha : 0 ≤ a) (b₁ b₂ : M) : a • min b₁ b₂ = min (a • b₁) (a • b₂) := +(monotone_smul_left ha : monotone (_ : M → M)).map_min + +end linear_ordered_semiring + +section linear_ordered_semifield +variables [linear_ordered_semifield 𝕜] [ordered_add_comm_monoid M] [ordered_add_comm_monoid N] + [mul_action_with_zero 𝕜 M] [mul_action_with_zero 𝕜 N] + +/-- To prove that a vector space over a linear ordered field is ordered, it suffices to verify only +the first axiom of `ordered_smul`. -/ +lemma ordered_smul.mk' (h : ∀ ⦃a b : M⦄ ⦃c : 𝕜⦄, a < b → 0 < c → c • a ≤ c • b) : + ordered_smul 𝕜 M := begin - have hlt' : ∀ ⦃a b : M⦄ ⦃c : R⦄, a < b → 0 < c → c • a < c • b, - { refine λ a b c hab hc, (hlt hab hc).lt_of_ne _, - rw [ne.def, (hR hc.ne').smul_left_cancel], + have hlt' : ∀ ⦃a b : M⦄ ⦃c : 𝕜⦄, a < b → 0 < c → c • a < c • b, + { refine λ a b c hab hc, (h hab hc).lt_of_ne _, + rw [ne.def, hc.ne'.is_unit.smul_left_cancel], exact hab.ne }, refine { smul_lt_smul_of_pos := hlt', .. }, - intros a b c h hc, - rcases (hR hc.ne') with ⟨c, rfl⟩, + intros a b c hab hc, + obtain ⟨c, rfl⟩ := hc.ne'.is_unit, rw [← inv_smul_smul c a, ← inv_smul_smul c b], - refine hlt' h (pos_of_mul_pos_left _ hc.le), + refine hlt' hab (pos_of_mul_pos_right _ hc.le), simp only [c.mul_inv, zero_lt_one] end -/-- If `R` is a linear ordered field, then it suffices to verify only the first axiom of -`ordered_smul`. -/ -lemma ordered_smul.mk' {k M : Type*} [linear_ordered_field k] [ordered_add_comm_monoid M] - [mul_action_with_zero k M] (hlt : ∀ ⦃a b : M⦄ ⦃c : k⦄, a < b → 0 < c → c • a ≤ c • b) : - ordered_smul k M := -ordered_smul.mk'' (λ c hc, is_unit.mk0 _ hc) hlt +instance [ordered_smul 𝕜 M] [ordered_smul 𝕜 N] : ordered_smul 𝕜 (M × N) := +ordered_smul.mk' $ λ a b c h hc, + ⟨smul_le_smul_of_nonneg h.1.1 hc.le, smul_le_smul_of_nonneg h.1.2 hc.le⟩ + +instance pi.ordered_smul {M : ι → Type*} [Π i, ordered_add_comm_monoid (M i)] + [Π i, mul_action_with_zero 𝕜 (M i)] [∀ i, ordered_smul 𝕜 (M i)] : + ordered_smul 𝕜 (Π i, M i) := +ordered_smul.mk' $ λ v u c h hc i, smul_le_smul_of_nonneg (h.le i) hc.le -instance linear_ordered_semiring.to_ordered_smul {R : Type*} [linear_ordered_semiring R] : - ordered_smul R R := -{ smul_lt_smul_of_pos := ordered_semiring.mul_lt_mul_of_pos_left, - lt_of_smul_lt_smul_of_pos := λ _ _ _ h hc, lt_of_mul_lt_mul_left h hc.le } +/- Sometimes Lean fails to apply the dependent version to non-dependent functions, so we define +another instance. -/ +instance pi.ordered_smul' [ordered_smul 𝕜 M] : ordered_smul 𝕜 (ι → M) := pi.ordered_smul -section field +/- Sometimes Lean fails to unify the module with the scalars, so we define another instance. -/ +instance pi.ordered_smul'' : ordered_smul 𝕜 (ι → 𝕜) := @pi.ordered_smul' ι 𝕜 𝕜 _ _ _ _ -variables {k M : Type*} [linear_ordered_field k] - [ordered_add_comm_group M] [mul_action_with_zero k M] [ordered_smul k M] - {a b : M} {c : k} +variables [ordered_smul 𝕜 M] {s : set M} {a b : M} {c : 𝕜} lemma smul_le_smul_iff_of_pos (hc : 0 < c) : c • a ≤ c • b ↔ a ≤ b := ⟨λ h, inv_smul_smul₀ hc.ne' a ▸ inv_smul_smul₀ hc.ne' b ▸ smul_le_smul_of_nonneg h (inv_nonneg.2 hc.le), λ h, smul_le_smul_of_nonneg h hc.le⟩ -lemma smul_lt_iff_of_pos (hc : 0 < c) : c • a < b ↔ a < c⁻¹ • b := -calc c • a < b ↔ c • a < c • c⁻¹ • b : by rw [smul_inv_smul₀ hc.ne'] -... ↔ a < c⁻¹ • b : smul_lt_smul_iff_of_pos hc +lemma inv_smul_le_iff (h : 0 < c) : c⁻¹ • a ≤ b ↔ a ≤ c • b := +by { rw [←smul_le_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance } -lemma lt_smul_iff_of_pos (hc : 0 < c) : a < c • b ↔ c⁻¹ • a < b := -calc a < c • b ↔ c • c⁻¹ • a < c • b : by rw [smul_inv_smul₀ hc.ne'] -... ↔ c⁻¹ • a < b : smul_lt_smul_iff_of_pos hc +lemma inv_smul_lt_iff (h : 0 < c) : c⁻¹ • a < b ↔ a < c • b := +by { rw [←smul_lt_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance } -lemma smul_le_iff_of_pos (hc : 0 < c) : c • a ≤ b ↔ a ≤ c⁻¹ • b := -calc c • a ≤ b ↔ c • a ≤ c • c⁻¹ • b : by rw [smul_inv_smul₀ hc.ne'] -... ↔ a ≤ c⁻¹ • b : smul_le_smul_iff_of_pos hc +lemma le_inv_smul_iff (h : 0 < c) : a ≤ c⁻¹ • b ↔ c • a ≤ b := +by { rw [←smul_le_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance } -lemma le_smul_iff_of_pos (hc : 0 < c) : a ≤ c • b ↔ c⁻¹ • a ≤ b := -calc a ≤ c • b ↔ c • c⁻¹ • a ≤ c • b : by rw [smul_inv_smul₀ hc.ne'] -... ↔ c⁻¹ • a ≤ b : smul_le_smul_iff_of_pos hc +lemma lt_inv_smul_iff (h : 0 < c) : a < c⁻¹ • b ↔ c • a < b := +by { rw [←smul_lt_smul_iff_of_pos h, smul_inv_smul₀ h.ne'], apply_instance } variables (M) /-- Left scalar multiplication as an order isomorphism. -/ -@[simps] def order_iso.smul_left {c : k} (hc : 0 < c) : M ≃o M := +@[simps] def order_iso.smul_left (hc : 0 < c) : M ≃o M := { to_fun := λ b, c • b, inv_fun := λ b, c⁻¹ • b, left_inv := inv_smul_smul₀ hc.ne', right_inv := smul_inv_smul₀ hc.ne', map_rel_iff' := λ b₁ b₂, smul_le_smul_iff_of_pos hc } -end field +variables {M} + +@[simp] lemma lower_bounds_smul_of_pos (hc : 0 < c) : lower_bounds (c • s) = c • lower_bounds s := +(order_iso.smul_left _ hc).lower_bounds_image + +@[simp] lemma upper_bounds_smul_of_pos (hc : 0 < c) : upper_bounds (c • s) = c • upper_bounds s := +(order_iso.smul_left _ hc).upper_bounds_image + +@[simp] lemma bdd_below_smul_iff_of_pos (hc : 0 < c) : bdd_below (c • s) ↔ bdd_below s := +(order_iso.smul_left _ hc).bdd_below_image + +@[simp] lemma bdd_above_smul_iff_of_pos (hc : 0 < c) : bdd_above (c • s) ↔ bdd_above s := +(order_iso.smul_left _ hc).bdd_above_image + +end linear_ordered_semifield + +namespace tactic +section ordered_smul +variables [ordered_semiring R] [ordered_add_comm_monoid M] [smul_with_zero R M] [ordered_smul R M] + {a : R} {b : M} + +private lemma smul_nonneg_of_pos_of_nonneg (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a • b := +smul_nonneg ha.le hb + +private lemma smul_nonneg_of_nonneg_of_pos (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a • b := +smul_nonneg ha hb.le + +end ordered_smul + +section no_zero_smul_divisors +variables [has_zero R] [has_zero M] [has_smul R M] [no_zero_smul_divisors R M] {a : R} {b : M} + +private lemma smul_ne_zero_of_pos_of_ne_zero [preorder R] (ha : 0 < a) (hb : b ≠ 0) : a • b ≠ 0 := +smul_ne_zero ha.ne' hb + +private lemma smul_ne_zero_of_ne_zero_of_pos [preorder M] (ha : a ≠ 0) (hb : 0 < b) : a • b ≠ 0 := +smul_ne_zero ha hb.ne' + +end no_zero_smul_divisors + +open positivity + +/-- Extension for the `positivity` tactic: scalar multiplication is nonnegative/positive/nonzero if +both sides are. -/ +@[positivity] +meta def positivity_smul : expr → tactic strictness +| e@`(%%a • %%b) := do + strictness_a ← core a, + strictness_b ← core b, + match strictness_a, strictness_b with + | positive pa, positive pb := positive <$> mk_app ``smul_pos [pa, pb] + | positive pa, nonnegative pb := nonnegative <$> mk_app ``smul_nonneg_of_pos_of_nonneg [pa, pb] + | nonnegative pa, positive pb := nonnegative <$> mk_app ``smul_nonneg_of_nonneg_of_pos [pa, pb] + | nonnegative pa, nonnegative pb := nonnegative <$> mk_app ``smul_nonneg [pa, pb] + | positive pa, nonzero pb := nonzero <$> to_expr ``(smul_ne_zero_of_pos_of_ne_zero %%pa %%pb) + | nonzero pa, positive pb := nonzero <$> to_expr ``(smul_ne_zero_of_ne_zero_of_pos %%pa %%pb) + | nonzero pa, nonzero pb := nonzero <$> to_expr ``(smul_ne_zero %%pa %%pb) + | sa@_, sb@ _ := positivity_fail e a b sa sb + end +| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a • b`" + +end tactic diff --git a/src/algebra/order/sub.lean b/src/algebra/order/sub.lean deleted file mode 100644 index d6fd57b7a295d..0000000000000 --- a/src/algebra/order/sub.lean +++ /dev/null @@ -1,791 +0,0 @@ -/- -Copyright (c) 2021 Floris van Doorn. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Floris van Doorn --/ -import algebra.order.monoid -/-! -# Ordered Subtraction - -This file proves lemmas relating (truncated) subtraction with an order. We provide a class -`has_ordered_sub` stating that `a - b ≤ c ↔ a ≤ c + b`. - -The subtraction discussed here could both be normal subtraction in an additive group or truncated -subtraction on a canonically ordered monoid (`ℕ`, `multiset`, `enat`, `ennreal`, ...) - -## Implementation details - -`has_ordered_sub` is a mixin type-class, so that we can use the results in this file even in cases -where we don't have a `canonically_ordered_add_monoid` instance -(even though that is our main focus). Conversely, this means we can use -`canonically_ordered_add_monoid` without necessarily having to define a subtraction. - -The results in this file are ordered by the type-class assumption needed to prove it. -This means that similar results might not be close to each other. Furthermore, we don't prove -implications if a bi-implication can be proven under the same assumptions. - -Lemmas using this class are named using `tsub` instead of `sub` (short for "truncated subtraction"). -This is to avoid naming conflicts with similar lemmas about ordered groups. - -We provide a second version of most results that require `[contravariant_class α α (+) (≤)]`. In the -second version we replace this type-class assumption by explicit `add_le_cancellable` assumptions. - -TODO: maybe we should make a multiplicative version of this, so that we can replace some identical -lemmas about subtraction/division in `ordered_[add_]comm_group` with these. - -TODO: generalize `nat.le_of_le_of_sub_le_sub_right`, `nat.sub_le_sub_right_iff`, - `nat.mul_self_sub_mul_self_eq` --/ - -variables {α β : Type*} - -/-- `has_ordered_sub α` means that `α` has a subtraction characterized by `a - b ≤ c ↔ a ≤ c + b`. -In other words, `a - b` is the least `c` such that `a ≤ b + c`. - -This is satisfied both by the subtraction in additive ordered groups and by truncated subtraction -in canonically ordered monoids on many specific types. --/ -class has_ordered_sub (α : Type*) [has_le α] [has_add α] [has_sub α] := -(tsub_le_iff_right : ∀ a b c : α, a - b ≤ c ↔ a ≤ c + b) - -section has_add - -variables [preorder α] [has_add α] [has_sub α] [has_ordered_sub α] {a b c d : α} - -@[simp] lemma tsub_le_iff_right : a - b ≤ c ↔ a ≤ c + b := -has_ordered_sub.tsub_le_iff_right a b c - -/-- See `add_tsub_cancel_right` for the equality if `contravariant_class α α (+) (≤)`. -/ -lemma add_tsub_le_right : a + b - b ≤ a := -tsub_le_iff_right.mpr le_rfl - -lemma le_tsub_add : b ≤ (b - a) + a := -tsub_le_iff_right.mp le_rfl - -lemma add_hom.le_map_tsub [preorder β] [has_add β] [has_sub β] [has_ordered_sub β] - (f : add_hom α β) (hf : monotone f) (a b : α) : - f a - f b ≤ f (a - b) := -by { rw [tsub_le_iff_right, ← f.map_add], exact hf le_tsub_add } - -lemma le_mul_tsub {R : Type*} [distrib R] [preorder R] [has_sub R] [has_ordered_sub R] - [covariant_class R R (*) (≤)] {a b c : R} : - a * b - a * c ≤ a * (b - c) := -(add_hom.mul_left a).le_map_tsub (monotone_id.const_mul' a) _ _ - -lemma le_tsub_mul {R : Type*} [comm_semiring R] [preorder R] [has_sub R] [has_ordered_sub R] - [covariant_class R R (*) (≤)] {a b c : R} : - a * c - b * c ≤ (a - b) * c := -by simpa only [mul_comm _ c] using le_mul_tsub - -end has_add - -/-- An order isomorphism between types with ordered subtraction preserves subtraction provided that -it preserves addition. -/ -lemma order_iso.map_tsub {M N : Type*} [preorder M] [has_add M] [has_sub M] [has_ordered_sub M] - [partial_order N] [has_add N] [has_sub N] [has_ordered_sub N] (e : M ≃o N) - (h_add : ∀ a b, e (a + b) = e a + e b) (a b : M) : - e (a - b) = e a - e b := -begin - set e_add : M ≃+ N := { map_add' := h_add, .. e }, - refine le_antisymm _ (e_add.to_add_hom.le_map_tsub e.monotone a b), - suffices : e (e.symm (e a) - e.symm (e b)) ≤ e (e.symm (e a - e b)), by simpa, - exact e.monotone (e_add.symm.to_add_hom.le_map_tsub e.symm.monotone _ _) -end - -/-! ### Preorder -/ - -section ordered_add_comm_monoid - -section preorder -variables [preorder α] - -section add_comm_semigroup -variables [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] {a b c d : α} - -lemma tsub_le_iff_left : a - b ≤ c ↔ a ≤ b + c := -by rw [tsub_le_iff_right, add_comm] - -lemma le_add_tsub : a ≤ b + (a - b) := -tsub_le_iff_left.mp le_rfl - -/-- See `add_tsub_cancel_left` for the equality if `contravariant_class α α (+) (≤)`. -/ -lemma add_tsub_le_left : a + b - a ≤ b := -tsub_le_iff_left.mpr le_rfl - -lemma tsub_le_tsub_right (h : a ≤ b) (c : α) : a - c ≤ b - c := -tsub_le_iff_left.mpr $ h.trans le_add_tsub - -lemma tsub_le_iff_tsub_le : a - b ≤ c ↔ a - c ≤ b := -by rw [tsub_le_iff_left, tsub_le_iff_right] - -/-- See `tsub_tsub_cancel_of_le` for the equality. -/ -lemma tsub_tsub_le : b - (b - a) ≤ a := -tsub_le_iff_right.mpr le_add_tsub - -section cov -variable [covariant_class α α (+) (≤)] - -lemma tsub_le_tsub_left (h : a ≤ b) (c : α) : c - b ≤ c - a := -tsub_le_iff_left.mpr $ le_add_tsub.trans $ add_le_add_right h _ - -lemma tsub_le_tsub (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := -(tsub_le_tsub_right hab _).trans $ tsub_le_tsub_left hcd _ - -/-- See `add_tsub_assoc_of_le` for the equality. -/ -lemma add_tsub_le_assoc : a + b - c ≤ a + (b - c) := -by { rw [tsub_le_iff_left, add_left_comm], exact add_le_add_left le_add_tsub a } - -lemma add_le_add_add_tsub : a + b ≤ (a + c) + (b - c) := -by { rw [add_assoc], exact add_le_add_left le_add_tsub a } - -lemma le_tsub_add_add : a + b ≤ (a - c) + (b + c) := -by { rw [add_comm a, add_comm (a - c)], exact add_le_add_add_tsub } - -lemma tsub_le_tsub_add_tsub : a - c ≤ (a - b) + (b - c) := -begin - rw [tsub_le_iff_left, ← add_assoc, add_right_comm], - exact le_add_tsub.trans (add_le_add_right le_add_tsub _), -end - -lemma tsub_tsub_tsub_le_tsub : (c - a) - (c - b) ≤ b - a := -begin - rw [tsub_le_iff_left, tsub_le_iff_left, add_left_comm], - exact le_tsub_add.trans (add_le_add_left le_add_tsub _), -end - -lemma tsub_tsub_le_tsub_add {a b c : α} : a - (b - c) ≤ a - b + c := -tsub_le_iff_right.2 $ calc - a ≤ a - b + b : le_tsub_add - ... ≤ a - b + (c + (b - c)) : add_le_add_left le_add_tsub _ - ... = a - b + c + (b - c) : (add_assoc _ _ _).symm - -end cov - -/-! #### Lemmas that assume that an element is `add_le_cancellable` -/ - -namespace add_le_cancellable - -protected lemma le_add_tsub_swap (hb : add_le_cancellable b) : a ≤ b + a - b := hb le_add_tsub - -protected lemma le_add_tsub (hb : add_le_cancellable b) : a ≤ a + b - b := -by { rw add_comm, exact hb.le_add_tsub_swap } - -protected lemma le_tsub_of_add_le_left (ha : add_le_cancellable a) (h : a + b ≤ c) : b ≤ c - a := -ha $ h.trans le_add_tsub - -protected lemma le_tsub_of_add_le_right (hb : add_le_cancellable b) (h : a + b ≤ c) : a ≤ c - b := -hb.le_tsub_of_add_le_left $ by rwa add_comm - -end add_le_cancellable - -/-! ### Lemmas where addition is order-reflecting -/ - -section contra -variable [contravariant_class α α (+) (≤)] - -lemma le_add_tsub_swap : a ≤ b + a - b := contravariant.add_le_cancellable.le_add_tsub_swap - -lemma le_add_tsub' : a ≤ a + b - b := contravariant.add_le_cancellable.le_add_tsub - -lemma le_tsub_of_add_le_left (h : a + b ≤ c) : b ≤ c - a := -contravariant.add_le_cancellable.le_tsub_of_add_le_left h - -lemma le_tsub_of_add_le_right (h : a + b ≤ c) : a ≤ c - b := -contravariant.add_le_cancellable.le_tsub_of_add_le_right h - -end contra - -end add_comm_semigroup - -variables [add_comm_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} - -lemma tsub_nonpos : a - b ≤ 0 ↔ a ≤ b := by rw [tsub_le_iff_left, add_zero] - -alias tsub_nonpos ↔ _ tsub_nonpos_of_le - -lemma add_monoid_hom.le_map_tsub [preorder β] [add_comm_monoid β] [has_sub β] - [has_ordered_sub β] (f : α →+ β) (hf : monotone f) (a b : α) : - f a - f b ≤ f (a - b) := -f.to_add_hom.le_map_tsub hf a b - -end preorder - -/-! ### Partial order -/ - -variables [partial_order α] [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] {a b c d : α} - -lemma tsub_tsub (b a c : α) : b - a - c = b - (a + c) := -begin - apply le_antisymm, - { rw [tsub_le_iff_left, tsub_le_iff_left, ← add_assoc, ← tsub_le_iff_left] }, - { rw [tsub_le_iff_left, add_assoc, ← tsub_le_iff_left, ← tsub_le_iff_left] } -end - -section cov -variable [covariant_class α α (+) (≤)] - -lemma tsub_add_eq_tsub_tsub (a b c : α) : a - (b + c) = a - b - c := -begin - refine le_antisymm (tsub_le_iff_left.mpr _) - (tsub_le_iff_left.mpr $ tsub_le_iff_left.mpr _), - { rw [add_assoc], refine le_trans le_add_tsub (add_le_add_left le_add_tsub _) }, - { rw [← add_assoc], apply le_add_tsub } -end - -lemma tsub_add_eq_tsub_tsub_swap (a b c : α) : a - (b + c) = a - c - b := -by { rw [add_comm], apply tsub_add_eq_tsub_tsub } - -lemma tsub_right_comm : a - b - c = a - c - b := -by simp_rw [← tsub_add_eq_tsub_tsub, add_comm] - -end cov - -/-! ### Lemmas that assume that an element is `add_le_cancellable`. -/ - -namespace add_le_cancellable - -protected lemma tsub_eq_of_eq_add (hb : add_le_cancellable b) (h : a = c + b) : a - b = c := -le_antisymm (tsub_le_iff_right.mpr h.le) $ - by { rw h, exact hb.le_add_tsub } - -protected lemma eq_tsub_of_add_eq (hc : add_le_cancellable c) (h : a + c = b) : a = b - c := -(hc.tsub_eq_of_eq_add h.symm).symm - -protected theorem tsub_eq_of_eq_add_rev (hb : add_le_cancellable b) (h : a = b + c) : a - b = c := -hb.tsub_eq_of_eq_add $ by rw [add_comm, h] - -@[simp] -protected lemma add_tsub_cancel_right (hb : add_le_cancellable b) : a + b - b = a := -hb.tsub_eq_of_eq_add $ by rw [add_comm] - -@[simp] -protected lemma add_tsub_cancel_left (ha : add_le_cancellable a) : a + b - a = b := -ha.tsub_eq_of_eq_add $ add_comm a b - -protected lemma lt_add_of_tsub_lt_left (hb : add_le_cancellable b) (h : a - b < c) : a < b + c := -begin - rw [lt_iff_le_and_ne, ← tsub_le_iff_left], - refine ⟨h.le, _⟩, - rintro rfl, - simpa [hb] using h, -end - -protected lemma lt_add_of_tsub_lt_right (hc : add_le_cancellable c) (h : a - c < b) : a < b + c := -begin - rw [lt_iff_le_and_ne, ← tsub_le_iff_right], - refine ⟨h.le, _⟩, - rintro rfl, - simpa [hc] using h, -end - -end add_le_cancellable - -/-! #### Lemmas where addition is order-reflecting. -/ - -section contra -variable [contravariant_class α α (+) (≤)] - -lemma tsub_eq_of_eq_add (h : a = c + b) : a - b = c := -contravariant.add_le_cancellable.tsub_eq_of_eq_add h - -lemma eq_tsub_of_add_eq (h : a + c = b) : a = b - c := -contravariant.add_le_cancellable.eq_tsub_of_add_eq h - -lemma tsub_eq_of_eq_add_rev (h : a = b + c) : a - b = c := -contravariant.add_le_cancellable.tsub_eq_of_eq_add_rev h - -@[simp] -lemma add_tsub_cancel_right (a b : α) : a + b - b = a := -contravariant.add_le_cancellable.add_tsub_cancel_right - -@[simp] -lemma add_tsub_cancel_left (a b : α) : a + b - a = b := -contravariant.add_le_cancellable.add_tsub_cancel_left - -lemma lt_add_of_tsub_lt_left (h : a - b < c) : a < b + c := -contravariant.add_le_cancellable.lt_add_of_tsub_lt_left h - -lemma lt_add_of_tsub_lt_right (h : a - c < b) : a < b + c := -contravariant.add_le_cancellable.lt_add_of_tsub_lt_right h - -end contra - -section both -variables [covariant_class α α (+) (≤)] [contravariant_class α α (+) (≤)] - -lemma add_tsub_add_eq_tsub_right (a c b : α) : (a + c) - (b + c) = a - b := -begin - apply le_antisymm, - { rw [tsub_le_iff_left, add_right_comm], exact add_le_add_right le_add_tsub c }, - { rw [tsub_le_iff_left, add_comm b], - apply le_of_add_le_add_right, - rw [add_assoc], - exact le_tsub_add } -end - -lemma add_tsub_add_eq_tsub_left (a b c : α) : (a + b) - (a + c) = b - c := -by rw [add_comm a b, add_comm a c, add_tsub_add_eq_tsub_right] - -end both - -end ordered_add_comm_monoid - -/-! ### Lemmas in a linearly ordered monoid. -/ -section linear_order -variables {a b c d : α} [linear_order α] [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] - -/-- See `lt_of_tsub_lt_tsub_right_of_le` for a weaker statement in a partial order. -/ -lemma lt_of_tsub_lt_tsub_right (h : a - c < b - c) : a < b := -lt_imp_lt_of_le_imp_le (λ h, tsub_le_tsub_right h c) h - -/-- See `lt_tsub_iff_right_of_le` for a weaker statement in a partial order. -/ -lemma lt_tsub_iff_right : a < b - c ↔ a + c < b := -lt_iff_lt_of_le_iff_le tsub_le_iff_right - -/-- See `lt_tsub_iff_left_of_le` for a weaker statement in a partial order. -/ -lemma lt_tsub_iff_left : a < b - c ↔ c + a < b := -lt_iff_lt_of_le_iff_le tsub_le_iff_left - -lemma lt_tsub_comm : a < b - c ↔ c < b - a := -lt_tsub_iff_left.trans lt_tsub_iff_right.symm - - - -section cov -variable [covariant_class α α (+) (≤)] - -/-- See `lt_of_tsub_lt_tsub_left_of_le` for a weaker statement in a partial order. -/ -lemma lt_of_tsub_lt_tsub_left (h : a - b < a - c) : c < b := -lt_imp_lt_of_le_imp_le (λ h, tsub_le_tsub_left h a) h - -end cov - -end linear_order - -/-! ### Lemmas in a canonically ordered monoid. -/ - -section canonically_ordered_add_monoid -variables [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} - -@[simp] lemma add_tsub_cancel_of_le (h : a ≤ b) : a + (b - a) = b := -begin - refine le_antisymm _ le_add_tsub, - obtain ⟨c, rfl⟩ := le_iff_exists_add.1 h, - exact add_le_add_left add_tsub_le_left a, -end - -lemma tsub_add_cancel_of_le (h : a ≤ b) : b - a + a = b := -by { rw [add_comm], exact add_tsub_cancel_of_le h } - -lemma add_tsub_cancel_iff_le : a + (b - a) = b ↔ a ≤ b := -⟨λ h, le_iff_exists_add.mpr ⟨b - a, h.symm⟩, add_tsub_cancel_of_le⟩ - -lemma tsub_add_cancel_iff_le : b - a + a = b ↔ a ≤ b := -by { rw [add_comm], exact add_tsub_cancel_iff_le } - -lemma add_le_of_le_tsub_right_of_le (h : b ≤ c) (h2 : a ≤ c - b) : a + b ≤ c := -(add_le_add_right h2 b).trans_eq $ tsub_add_cancel_of_le h - -lemma add_le_of_le_tsub_left_of_le (h : a ≤ c) (h2 : b ≤ c - a) : a + b ≤ c := -(add_le_add_left h2 a).trans_eq $ add_tsub_cancel_of_le h - -lemma tsub_le_tsub_iff_right (h : c ≤ b) : a - c ≤ b - c ↔ a ≤ b := -by rw [tsub_le_iff_right, tsub_add_cancel_of_le h] - -lemma tsub_left_inj (h1 : c ≤ a) (h2 : c ≤ b) : a - c = b - c ↔ a = b := -by simp_rw [le_antisymm_iff, tsub_le_tsub_iff_right h1, tsub_le_tsub_iff_right h2] - -/-- See `lt_of_tsub_lt_tsub_right` for a stronger statement in a linear order. -/ -lemma lt_of_tsub_lt_tsub_right_of_le (h : c ≤ b) (h2 : a - c < b - c) : a < b := -by { refine ((tsub_le_tsub_iff_right h).mp h2.le).lt_of_ne _, rintro rfl, exact h2.false } - -@[simp] lemma tsub_eq_zero_iff_le : a - b = 0 ↔ a ≤ b := -by rw [← nonpos_iff_eq_zero, tsub_le_iff_left, add_zero] - -/-- One direction of `tsub_eq_zero_iff_le`, as a `@[simp]`-lemma. -/ -@[simp] lemma tsub_eq_zero_of_le (h : a ≤ b) : a - b = 0 := -tsub_eq_zero_iff_le.mpr h - -@[simp] lemma tsub_self (a : α) : a - a = 0 := -tsub_eq_zero_iff_le.mpr le_rfl - -@[simp] lemma tsub_le_self : a - b ≤ a := -tsub_le_iff_left.mpr $ le_add_left le_rfl - -@[simp] lemma tsub_zero (a : α) : a - 0 = a := -le_antisymm tsub_le_self $ le_add_tsub.trans_eq $ zero_add _ - -@[simp] lemma zero_tsub (a : α) : 0 - a = 0 := -tsub_eq_zero_iff_le.mpr $ zero_le a - -lemma tsub_self_add (a b : α) : a - (a + b) = 0 := -by { rw [tsub_eq_zero_iff_le], apply self_le_add_right } - -lemma tsub_inj_left (h₁ : a ≤ b) (h₂ : a ≤ c) (h₃ : b - a = c - a) : b = c := -by rw [← tsub_add_cancel_of_le h₁, ← tsub_add_cancel_of_le h₂, h₃] - -lemma tsub_pos_iff_not_le : 0 < a - b ↔ ¬ a ≤ b := -by rw [pos_iff_ne_zero, ne.def, tsub_eq_zero_iff_le] - -lemma tsub_pos_of_lt (h : a < b) : 0 < b - a := -tsub_pos_iff_not_le.mpr h.not_le - -lemma tsub_add_tsub_cancel (hab : b ≤ a) (hbc : c ≤ b) : (a - b) + (b - c) = a - c := -begin - convert tsub_add_cancel_of_le (tsub_le_tsub_right hab c) using 2, - rw [tsub_tsub, add_tsub_cancel_of_le hbc], -end - -lemma tsub_tsub_tsub_cancel_right (h : c ≤ b) : (a - c) - (b - c) = a - b := -by rw [tsub_tsub, add_tsub_cancel_of_le h] - -/-! ### Lemmas that assume that an element is `add_le_cancellable`. -/ - -namespace add_le_cancellable -protected lemma eq_tsub_iff_add_eq_of_le (hc : add_le_cancellable c) (h : c ≤ b) : - a = b - c ↔ a + c = b := -begin - split, - { rintro rfl, exact tsub_add_cancel_of_le h }, - { rintro rfl, exact (hc.add_tsub_cancel_right).symm } -end - -protected lemma tsub_eq_iff_eq_add_of_le (hb : add_le_cancellable b) (h : b ≤ a) : - a - b = c ↔ a = c + b := -by rw [eq_comm, hb.eq_tsub_iff_add_eq_of_le h, eq_comm] - -protected lemma add_tsub_assoc_of_le (hc : add_le_cancellable c) (h : c ≤ b) (a : α) : - a + b - c = a + (b - c) := -by conv_lhs { rw [← add_tsub_cancel_of_le h, add_comm c, ← add_assoc, - hc.add_tsub_cancel_right] } - -protected lemma tsub_add_eq_add_tsub (hb : add_le_cancellable b) (h : b ≤ a) : - a - b + c = a + c - b := -by rw [add_comm a, hb.add_tsub_assoc_of_le h, add_comm] - -protected lemma tsub_tsub_assoc (hbc : add_le_cancellable (b - c)) (h₁ : b ≤ a) (h₂ : c ≤ b) : - a - (b - c) = a - b + c := -by rw [hbc.tsub_eq_iff_eq_add_of_le (tsub_le_self.trans h₁), add_assoc, - add_tsub_cancel_of_le h₂, tsub_add_cancel_of_le h₁] - -protected lemma tsub_add_tsub_comm (hb : add_le_cancellable b) (hd : add_le_cancellable d) - (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) := -by rw [hb.tsub_add_eq_add_tsub hba, ←hd.add_tsub_assoc_of_le hdc, tsub_tsub, add_comm d] - -protected lemma le_tsub_iff_left (ha : add_le_cancellable a) (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c := -⟨add_le_of_le_tsub_left_of_le h, ha.le_tsub_of_add_le_left⟩ - -protected lemma le_tsub_iff_right (ha : add_le_cancellable a) (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c := -by { rw [add_comm], exact ha.le_tsub_iff_left h } - -protected lemma tsub_lt_iff_left (hb : add_le_cancellable b) (hba : b ≤ a) : - a - b < c ↔ a < b + c := -begin - refine ⟨hb.lt_add_of_tsub_lt_left, _⟩, - intro h, refine (tsub_le_iff_left.mpr h.le).lt_of_ne _, - rintro rfl, exact h.ne' (add_tsub_cancel_of_le hba) -end - -protected lemma tsub_lt_iff_right (hb : add_le_cancellable b) (hba : b ≤ a) : - a - b < c ↔ a < c + b := -by { rw [add_comm], exact hb.tsub_lt_iff_left hba } - -protected lemma lt_tsub_of_add_lt_right (hc : add_le_cancellable c) (h : a + c < b) : a < b - c := -begin - apply lt_of_le_of_ne, - { rw [← add_tsub_cancel_of_le h.le, add_right_comm, add_assoc], - rw [hc.add_tsub_assoc_of_le], refine le_self_add, refine le_add_self }, - { rintro rfl, apply h.not_le, exact le_tsub_add } -end - -protected lemma lt_tsub_of_add_lt_left (ha : add_le_cancellable a) (h : a + c < b) : c < b - a := -by { apply ha.lt_tsub_of_add_lt_right, rwa add_comm } - -protected lemma tsub_lt_iff_tsub_lt (hb : add_le_cancellable b) (hc : add_le_cancellable c) - (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b := -by rw [hb.tsub_lt_iff_left h₁, hc.tsub_lt_iff_right h₂] - -protected lemma le_tsub_iff_le_tsub (ha : add_le_cancellable a) (hc : add_le_cancellable c) - (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a := -by rw [ha.le_tsub_iff_left h₁, hc.le_tsub_iff_right h₂] - -protected lemma lt_tsub_iff_right_of_le (hc : add_le_cancellable c) (h : c ≤ b) : - a < b - c ↔ a + c < b := -begin - refine ⟨_, hc.lt_tsub_of_add_lt_right⟩, - intro h2, - refine (add_le_of_le_tsub_right_of_le h h2.le).lt_of_ne _, - rintro rfl, - apply h2.not_le, - rw [hc.add_tsub_cancel_right] -end - -protected lemma lt_tsub_iff_left_of_le (hc : add_le_cancellable c) (h : c ≤ b) : - a < b - c ↔ c + a < b := -by { rw [add_comm], exact hc.lt_tsub_iff_right_of_le h } - -protected lemma lt_of_tsub_lt_tsub_left_of_le [contravariant_class α α (+) (<)] - (hb : add_le_cancellable b) (hca : c ≤ a) (h : a - b < a - c) : c < b := -begin - conv_lhs at h { rw [← tsub_add_cancel_of_le hca] }, - exact lt_of_add_lt_add_left (hb.lt_add_of_tsub_lt_right h), -end - -protected lemma tsub_le_tsub_iff_left (ha : add_le_cancellable a) (hc : add_le_cancellable c) - (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b := -begin - refine ⟨_, λ h, tsub_le_tsub_left h a⟩, - rw [tsub_le_iff_left, ← hc.add_tsub_assoc_of_le h, - hc.le_tsub_iff_right (h.trans le_add_self), add_comm b], - apply ha, -end - -protected lemma tsub_right_inj (ha : add_le_cancellable a) (hb : add_le_cancellable b) - (hc : add_le_cancellable c) (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c := -by simp_rw [le_antisymm_iff, ha.tsub_le_tsub_iff_left hb hba, ha.tsub_le_tsub_iff_left hc hca, - and_comm] - -protected lemma tsub_lt_tsub_right_of_le (hc : add_le_cancellable c) (h : c ≤ a) (h2 : a < b) : - a - c < b - c := -by { apply hc.lt_tsub_of_add_lt_left, rwa [add_tsub_cancel_of_le h] } - -protected lemma tsub_inj_right (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) - (h₃ : a - b = a - c) : b = c := -by { rw ← hab.inj, rw [tsub_add_cancel_of_le h₁, h₃, tsub_add_cancel_of_le h₂] } - -protected lemma tsub_lt_tsub_iff_left_of_le_of_le [contravariant_class α α (+) (<)] - (hb : add_le_cancellable b) (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) : - a - b < a - c ↔ c < b := -begin - refine ⟨hb.lt_of_tsub_lt_tsub_left_of_le h₂, _⟩, - intro h, refine (tsub_le_tsub_left h.le _).lt_of_ne _, - rintro h2, exact h.ne' (hab.tsub_inj_right h₁ h₂ h2) -end - -@[simp] protected lemma add_tsub_tsub_cancel (hac : add_le_cancellable (a - c)) (h : c ≤ a) : - (a + b) - (a - c) = b + c := -(hac.tsub_eq_iff_eq_add_of_le $ tsub_le_self.trans le_self_add).mpr $ - by rw [add_assoc, add_tsub_cancel_of_le h, add_comm] - -protected lemma tsub_tsub_cancel_of_le (hba : add_le_cancellable (b - a)) (h : a ≤ b) : - b - (b - a) = a := -by rw [hba.tsub_eq_iff_eq_add_of_le tsub_le_self, add_tsub_cancel_of_le h] - -end add_le_cancellable - -section contra -/-! ### Lemmas where addition is order-reflecting. -/ -variable [contravariant_class α α (+) (≤)] - -lemma eq_tsub_iff_add_eq_of_le (h : c ≤ b) : a = b - c ↔ a + c = b := -contravariant.add_le_cancellable.eq_tsub_iff_add_eq_of_le h - -lemma tsub_eq_iff_eq_add_of_le (h : b ≤ a) : a - b = c ↔ a = c + b := -contravariant.add_le_cancellable.tsub_eq_iff_eq_add_of_le h - -/-- See `add_tsub_le_assoc` for an inequality. -/ -lemma add_tsub_assoc_of_le (h : c ≤ b) (a : α) : a + b - c = a + (b - c) := -contravariant.add_le_cancellable.add_tsub_assoc_of_le h a - -lemma tsub_add_eq_add_tsub (h : b ≤ a) : a - b + c = a + c - b := -contravariant.add_le_cancellable.tsub_add_eq_add_tsub h - -lemma tsub_tsub_assoc (h₁ : b ≤ a) (h₂ : c ≤ b) : a - (b - c) = a - b + c := -contravariant.add_le_cancellable.tsub_tsub_assoc h₁ h₂ - -lemma tsub_add_tsub_comm (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) := -contravariant.add_le_cancellable.tsub_add_tsub_comm contravariant.add_le_cancellable hba hdc - -lemma le_tsub_iff_left (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c := -contravariant.add_le_cancellable.le_tsub_iff_left h - -lemma le_tsub_iff_right (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c := -contravariant.add_le_cancellable.le_tsub_iff_right h - -lemma tsub_lt_iff_left (hbc : b ≤ a) : a - b < c ↔ a < b + c := -contravariant.add_le_cancellable.tsub_lt_iff_left hbc - -lemma tsub_lt_iff_right (hbc : b ≤ a) : a - b < c ↔ a < c + b := -contravariant.add_le_cancellable.tsub_lt_iff_right hbc - -/-- This lemma (and some of its corollaries also holds for `ennreal`, - but this proof doesn't work for it. - Maybe we should add this lemma as field to `has_ordered_sub`? -/ -lemma lt_tsub_of_add_lt_right (h : a + c < b) : a < b - c := -contravariant.add_le_cancellable.lt_tsub_of_add_lt_right h - -lemma lt_tsub_of_add_lt_left (h : a + c < b) : c < b - a := -contravariant.add_le_cancellable.lt_tsub_of_add_lt_left h - -lemma tsub_lt_iff_tsub_lt (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b := -contravariant.add_le_cancellable.tsub_lt_iff_tsub_lt contravariant.add_le_cancellable h₁ h₂ - -lemma le_tsub_iff_le_tsub (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a := -contravariant.add_le_cancellable.le_tsub_iff_le_tsub contravariant.add_le_cancellable h₁ h₂ - -/-- See `lt_tsub_iff_right` for a stronger statement in a linear order. -/ -lemma lt_tsub_iff_right_of_le (h : c ≤ b) : a < b - c ↔ a + c < b := -contravariant.add_le_cancellable.lt_tsub_iff_right_of_le h - -/-- See `lt_tsub_iff_left` for a stronger statement in a linear order. -/ -lemma lt_tsub_iff_left_of_le (h : c ≤ b) : a < b - c ↔ c + a < b := -contravariant.add_le_cancellable.lt_tsub_iff_left_of_le h - -/-- See `lt_of_tsub_lt_tsub_left` for a stronger statement in a linear order. -/ -lemma lt_of_tsub_lt_tsub_left_of_le [contravariant_class α α (+) (<)] - (hca : c ≤ a) (h : a - b < a - c) : c < b := -contravariant.add_le_cancellable.lt_of_tsub_lt_tsub_left_of_le hca h - -lemma tsub_le_tsub_iff_left (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b := -contravariant.add_le_cancellable.tsub_le_tsub_iff_left contravariant.add_le_cancellable h - -lemma tsub_right_inj (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c := -contravariant.add_le_cancellable.tsub_right_inj contravariant.add_le_cancellable - contravariant.add_le_cancellable hba hca - -lemma tsub_lt_tsub_right_of_le (h : c ≤ a) (h2 : a < b) : a - c < b - c := -contravariant.add_le_cancellable.tsub_lt_tsub_right_of_le h h2 - -lemma tsub_inj_right (h₁ : b ≤ a) (h₂ : c ≤ a) (h₃ : a - b = a - c) : b = c := -contravariant.add_le_cancellable.tsub_inj_right h₁ h₂ h₃ - -/-- See `tsub_lt_tsub_iff_left_of_le` for a stronger statement in a linear order. -/ -lemma tsub_lt_tsub_iff_left_of_le_of_le [contravariant_class α α (+) (<)] - (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < a - c ↔ c < b := -contravariant.add_le_cancellable.tsub_lt_tsub_iff_left_of_le_of_le - contravariant.add_le_cancellable h₁ h₂ - -@[simp] lemma add_tsub_tsub_cancel (h : c ≤ a) : (a + b) - (a - c) = b + c := -contravariant.add_le_cancellable.add_tsub_tsub_cancel h - -/-- See `tsub_tsub_le` for an inequality. -/ -lemma tsub_tsub_cancel_of_le (h : a ≤ b) : b - (b - a) = a := -contravariant.add_le_cancellable.tsub_tsub_cancel_of_le h - -end contra - -end canonically_ordered_add_monoid - -/-! ### Lemmas in a linearly canonically ordered monoid. -/ - -section canonically_linear_ordered_add_monoid -variables [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} - -@[simp] lemma tsub_pos_iff_lt : 0 < a - b ↔ b < a := -by rw [tsub_pos_iff_not_le, not_le] - -lemma tsub_eq_tsub_min (a b : α) : a - b = a - min a b := -begin - cases le_total a b with h h, - { rw [min_eq_left h, tsub_self, tsub_eq_zero_iff_le.mpr h] }, - { rw [min_eq_right h] }, -end - -namespace add_le_cancellable - -protected lemma lt_tsub_iff_right (hc : add_le_cancellable c) : a < b - c ↔ a + c < b := -⟨lt_imp_lt_of_le_imp_le tsub_le_iff_right.mpr, hc.lt_tsub_of_add_lt_right⟩ - -protected lemma lt_tsub_iff_left (hc : add_le_cancellable c) : a < b - c ↔ c + a < b := -⟨lt_imp_lt_of_le_imp_le tsub_le_iff_left.mpr, hc.lt_tsub_of_add_lt_left⟩ - -protected lemma tsub_lt_tsub_iff_right (hc : add_le_cancellable c) (h : c ≤ a) : - a - c < b - c ↔ a < b := -by rw [hc.lt_tsub_iff_left, add_tsub_cancel_of_le h] - -protected lemma tsub_lt_self (ha : add_le_cancellable a) (h₁ : 0 < a) (h₂ : 0 < b) : a - b < a := -begin - refine tsub_le_self.lt_of_ne (λ h, _), - rw [← h, tsub_pos_iff_lt] at h₁, - exact h₂.not_le (ha.add_le_iff_nonpos_left.1 $ add_le_of_le_tsub_left_of_le h₁.le h.ge), -end - -protected lemma tsub_lt_self_iff (ha : add_le_cancellable a) : a - b < a ↔ 0 < a ∧ 0 < b := -begin - refine ⟨λ h, ⟨(zero_le _).trans_lt h, (zero_le b).lt_of_ne _⟩, λ h, ha.tsub_lt_self h.1 h.2⟩, - rintro rfl, - rw [tsub_zero] at h, - exact h.false -end - -/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/ -protected lemma tsub_lt_tsub_iff_left_of_le (ha : add_le_cancellable a) (hb : add_le_cancellable b) - (h : b ≤ a) : a - b < a - c ↔ c < b := -lt_iff_lt_of_le_iff_le $ ha.tsub_le_tsub_iff_left hb h - -end add_le_cancellable - -section contra -variable [contravariant_class α α (+) (≤)] - -/-- This lemma also holds for `ennreal`, but we need a different proof for that. -/ -lemma tsub_lt_tsub_iff_right (h : c ≤ a) : a - c < b - c ↔ a < b := -contravariant.add_le_cancellable.tsub_lt_tsub_iff_right h - -lemma tsub_lt_self : 0 < a → 0 < b → a - b < a := contravariant.add_le_cancellable.tsub_lt_self - -lemma tsub_lt_self_iff : a - b < a ↔ 0 < a ∧ 0 < b := -contravariant.add_le_cancellable.tsub_lt_self_iff - -/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/ -lemma tsub_lt_tsub_iff_left_of_le (h : b ≤ a) : a - b < a - c ↔ c < b := -contravariant.add_le_cancellable.tsub_lt_tsub_iff_left_of_le contravariant.add_le_cancellable h - -end contra - -/-! ### Lemmas about `max` and `min`. -/ - -lemma tsub_add_eq_max : a - b + b = max a b := -begin - cases le_total a b with h h, - { rw [max_eq_right h, tsub_eq_zero_iff_le.mpr h, zero_add] }, - { rw [max_eq_left h, tsub_add_cancel_of_le h] } -end - -lemma add_tsub_eq_max : a + (b - a) = max a b := -by rw [add_comm, max_comm, tsub_add_eq_max] - -lemma tsub_min : a - min a b = a - b := -begin - cases le_total a b with h h, - { rw [min_eq_left h, tsub_self, tsub_eq_zero_iff_le.mpr h] }, - { rw [min_eq_right h] } -end - -lemma tsub_add_min : a - b + min a b = a := -by { rw [← tsub_min, tsub_add_cancel_of_le], apply min_le_left } - -end canonically_linear_ordered_add_monoid - -namespace with_top - -section -variables [has_sub α] [has_zero α] - -/-- If `α` has subtraction and `0`, we can extend the subtraction to `with_top α`. -/ -protected def sub : Π (a b : with_top α), with_top α -| _ ⊤ := 0 -| ⊤ (x : α) := ⊤ -| (x : α) (y : α) := (x - y : α) - -instance : has_sub (with_top α) := -⟨with_top.sub⟩ - -@[simp, norm_cast] lemma coe_sub {a b : α} : (↑(a - b) : with_top α) = ↑a - ↑b := rfl -@[simp] lemma top_sub_coe {a : α} : (⊤ : with_top α) - a = ⊤ := rfl -@[simp] lemma sub_top {a : with_top α} : a - ⊤ = 0 := by { cases a; refl } - -end - -variables [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] -instance : has_ordered_sub (with_top α) := -begin - constructor, - rintro x y z, - induction y using with_top.rec_top_coe, { simp }, - induction x using with_top.rec_top_coe, { simp }, - induction z using with_top.rec_top_coe, { simp }, - norm_cast, exact tsub_le_iff_right -end - -end with_top diff --git a/src/algebra/order/sub/basic.lean b/src/algebra/order/sub/basic.lean new file mode 100644 index 0000000000000..82627122e80e0 --- /dev/null +++ b/src/algebra/order/sub/basic.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import order.hom.basic +import algebra.hom.equiv.basic +import algebra.ring.basic +import algebra.order.sub.defs + +/-! +# Additional results about ordered Subtraction + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +variables {α β : Type*} + +section has_add + +variables [preorder α] [has_add α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +lemma add_hom.le_map_tsub [preorder β] [has_add β] [has_sub β] [has_ordered_sub β] + (f : add_hom α β) (hf : monotone f) (a b : α) : + f a - f b ≤ f (a - b) := +by { rw [tsub_le_iff_right, ← f.map_add], exact hf le_tsub_add } + +lemma le_mul_tsub {R : Type*} [distrib R] [preorder R] [has_sub R] [has_ordered_sub R] + [covariant_class R R (*) (≤)] {a b c : R} : + a * b - a * c ≤ a * (b - c) := +(add_hom.mul_left a).le_map_tsub (monotone_id.const_mul' a) _ _ + +lemma le_tsub_mul {R : Type*} [comm_semiring R] [preorder R] [has_sub R] [has_ordered_sub R] + [covariant_class R R (*) (≤)] {a b c : R} : + a * c - b * c ≤ (a - b) * c := +by simpa only [mul_comm _ c] using le_mul_tsub + +end has_add + +/-- An order isomorphism between types with ordered subtraction preserves subtraction provided that +it preserves addition. -/ +lemma order_iso.map_tsub {M N : Type*} [preorder M] [has_add M] [has_sub M] [has_ordered_sub M] + [partial_order N] [has_add N] [has_sub N] [has_ordered_sub N] (e : M ≃o N) + (h_add : ∀ a b, e (a + b) = e a + e b) (a b : M) : + e (a - b) = e a - e b := +begin + set e_add : M ≃+ N := { map_add' := h_add, .. e }, + refine le_antisymm _ (e_add.to_add_hom.le_map_tsub e.monotone a b), + suffices : e (e.symm (e a) - e.symm (e b)) ≤ e (e.symm (e a - e b)), by simpa, + exact e.monotone (e_add.symm.to_add_hom.le_map_tsub e.symm.monotone _ _) +end + +/-! ### Preorder -/ + +section preorder +variables [preorder α] + +variables [add_comm_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +lemma add_monoid_hom.le_map_tsub [preorder β] [add_comm_monoid β] [has_sub β] + [has_ordered_sub β] (f : α →+ β) (hf : monotone f) (a b : α) : + f a - f b ≤ f (a - b) := +f.to_add_hom.le_map_tsub hf a b + +end preorder diff --git a/src/algebra/order/sub/canonical.lean b/src/algebra/order/sub/canonical.lean new file mode 100644 index 0000000000000..0be3913982c1b --- /dev/null +++ b/src/algebra/order/sub/canonical.lean @@ -0,0 +1,413 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import algebra.order.monoid.canonical.defs +import algebra.order.sub.defs + +/-! +# Lemmas about subtraction in canonically ordered monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +section has_exists_add_of_le +variables [add_comm_semigroup α] [partial_order α] [has_exists_add_of_le α] + [covariant_class α α (+) (≤)] [has_sub α] [has_ordered_sub α] {a b c d : α} + +@[simp] lemma add_tsub_cancel_of_le (h : a ≤ b) : a + (b - a) = b := +begin + refine le_antisymm _ le_add_tsub, + obtain ⟨c, rfl⟩ := exists_add_of_le h, + exact add_le_add_left add_tsub_le_left a, +end + +lemma tsub_add_cancel_of_le (h : a ≤ b) : b - a + a = b := +by { rw [add_comm], exact add_tsub_cancel_of_le h } + +lemma add_le_of_le_tsub_right_of_le (h : b ≤ c) (h2 : a ≤ c - b) : a + b ≤ c := +(add_le_add_right h2 b).trans_eq $ tsub_add_cancel_of_le h + +lemma add_le_of_le_tsub_left_of_le (h : a ≤ c) (h2 : b ≤ c - a) : a + b ≤ c := +(add_le_add_left h2 a).trans_eq $ add_tsub_cancel_of_le h + +lemma tsub_le_tsub_iff_right (h : c ≤ b) : a - c ≤ b - c ↔ a ≤ b := +by rw [tsub_le_iff_right, tsub_add_cancel_of_le h] + +lemma tsub_left_inj (h1 : c ≤ a) (h2 : c ≤ b) : a - c = b - c ↔ a = b := +by simp_rw [le_antisymm_iff, tsub_le_tsub_iff_right h1, tsub_le_tsub_iff_right h2] + +lemma tsub_inj_left (h₁ : a ≤ b) (h₂ : a ≤ c) : b - a = c - a → b = c := (tsub_left_inj h₁ h₂).1 + +/-- See `lt_of_tsub_lt_tsub_right` for a stronger statement in a linear order. -/ +lemma lt_of_tsub_lt_tsub_right_of_le (h : c ≤ b) (h2 : a - c < b - c) : a < b := +by { refine ((tsub_le_tsub_iff_right h).mp h2.le).lt_of_ne _, rintro rfl, exact h2.false } + +lemma tsub_add_tsub_cancel (hab : b ≤ a) (hcb : c ≤ b) : (a - b) + (b - c) = a - c := +begin + convert tsub_add_cancel_of_le (tsub_le_tsub_right hab c) using 2, + rw [tsub_tsub, add_tsub_cancel_of_le hcb], +end + +lemma tsub_tsub_tsub_cancel_right (h : c ≤ b) : (a - c) - (b - c) = a - b := +by rw [tsub_tsub, add_tsub_cancel_of_le h] + +/-! #### Lemmas that assume that an element is `add_le_cancellable`. -/ + +namespace add_le_cancellable + +protected lemma eq_tsub_iff_add_eq_of_le (hc : add_le_cancellable c) (h : c ≤ b) : + a = b - c ↔ a + c = b := +⟨by { rintro rfl, exact tsub_add_cancel_of_le h }, hc.eq_tsub_of_add_eq⟩ + +protected lemma tsub_eq_iff_eq_add_of_le (hb : add_le_cancellable b) (h : b ≤ a) : + a - b = c ↔ a = c + b := +by rw [eq_comm, hb.eq_tsub_iff_add_eq_of_le h, eq_comm] + +protected lemma add_tsub_assoc_of_le (hc : add_le_cancellable c) (h : c ≤ b) (a : α) : + a + b - c = a + (b - c) := +by conv_lhs { rw [← add_tsub_cancel_of_le h, add_comm c, ← add_assoc, + hc.add_tsub_cancel_right] } + +protected lemma tsub_add_eq_add_tsub (hb : add_le_cancellable b) (h : b ≤ a) : + a - b + c = a + c - b := +by rw [add_comm a, hb.add_tsub_assoc_of_le h, add_comm] + +protected lemma tsub_tsub_assoc (hbc : add_le_cancellable (b - c)) (h₁ : b ≤ a) (h₂ : c ≤ b) : + a - (b - c) = a - b + c := +hbc.tsub_eq_of_eq_add $ by rw [add_assoc, add_tsub_cancel_of_le h₂, tsub_add_cancel_of_le h₁] + +protected lemma tsub_add_tsub_comm (hb : add_le_cancellable b) (hd : add_le_cancellable d) + (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) := +by rw [hb.tsub_add_eq_add_tsub hba, ←hd.add_tsub_assoc_of_le hdc, tsub_tsub, add_comm d] + +protected lemma le_tsub_iff_left (ha : add_le_cancellable a) (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c := +⟨add_le_of_le_tsub_left_of_le h, ha.le_tsub_of_add_le_left⟩ + +protected lemma le_tsub_iff_right (ha : add_le_cancellable a) (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c := +by { rw [add_comm], exact ha.le_tsub_iff_left h } + +protected lemma tsub_lt_iff_left (hb : add_le_cancellable b) (hba : b ≤ a) : + a - b < c ↔ a < b + c := +begin + refine ⟨hb.lt_add_of_tsub_lt_left, _⟩, + intro h, refine (tsub_le_iff_left.mpr h.le).lt_of_ne _, + rintro rfl, exact h.ne' (add_tsub_cancel_of_le hba) +end + +protected lemma tsub_lt_iff_right (hb : add_le_cancellable b) (hba : b ≤ a) : + a - b < c ↔ a < c + b := +by { rw [add_comm], exact hb.tsub_lt_iff_left hba } + +protected lemma tsub_lt_iff_tsub_lt (hb : add_le_cancellable b) (hc : add_le_cancellable c) + (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b := +by rw [hb.tsub_lt_iff_left h₁, hc.tsub_lt_iff_right h₂] + +protected lemma le_tsub_iff_le_tsub (ha : add_le_cancellable a) (hc : add_le_cancellable c) + (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a := +by rw [ha.le_tsub_iff_left h₁, hc.le_tsub_iff_right h₂] + +protected lemma lt_tsub_iff_right_of_le (hc : add_le_cancellable c) (h : c ≤ b) : + a < b - c ↔ a + c < b := +begin + refine ⟨λ h', (add_le_of_le_tsub_right_of_le h h'.le).lt_of_ne _, hc.lt_tsub_of_add_lt_right⟩, + rintro rfl, + exact h'.ne' hc.add_tsub_cancel_right, +end + +protected lemma lt_tsub_iff_left_of_le (hc : add_le_cancellable c) (h : c ≤ b) : + a < b - c ↔ c + a < b := +by { rw [add_comm], exact hc.lt_tsub_iff_right_of_le h } + +protected lemma tsub_inj_right (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) + (h₃ : a - b = a - c) : b = c := +by { rw ← hab.inj, rw [tsub_add_cancel_of_le h₁, h₃, tsub_add_cancel_of_le h₂] } + +protected lemma lt_of_tsub_lt_tsub_left_of_le [contravariant_class α α (+) (<)] + (hb : add_le_cancellable b) (hca : c ≤ a) (h : a - b < a - c) : c < b := +begin + conv_lhs at h { rw [← tsub_add_cancel_of_le hca] }, + exact lt_of_add_lt_add_left (hb.lt_add_of_tsub_lt_right h), +end + +protected lemma tsub_lt_tsub_left_of_le (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) + (h : c < b) : a - b < a - c := +(tsub_le_tsub_left h.le _).lt_of_ne $ λ h', h.ne' $ hab.tsub_inj_right h₁ (h.le.trans h₁) h' + +protected lemma tsub_lt_tsub_right_of_le (hc : add_le_cancellable c) (h : c ≤ a) (h2 : a < b) : + a - c < b - c := +by { apply hc.lt_tsub_of_add_lt_left, rwa [add_tsub_cancel_of_le h] } + +protected lemma tsub_lt_tsub_iff_left_of_le_of_le [contravariant_class α α (+) (<)] + (hb : add_le_cancellable b) (hab : add_le_cancellable (a - b)) (h₁ : b ≤ a) (h₂ : c ≤ a) : + a - b < a - c ↔ c < b := +⟨hb.lt_of_tsub_lt_tsub_left_of_le h₂, hab.tsub_lt_tsub_left_of_le h₁⟩ + +@[simp] protected lemma add_tsub_tsub_cancel (hac : add_le_cancellable (a - c)) (h : c ≤ a) : + (a + b) - (a - c) = b + c := +hac.tsub_eq_of_eq_add $ by rw [add_assoc, add_tsub_cancel_of_le h, add_comm] + +protected lemma tsub_tsub_cancel_of_le (hba : add_le_cancellable (b - a)) (h : a ≤ b) : + b - (b - a) = a := +hba.tsub_eq_of_eq_add (add_tsub_cancel_of_le h).symm + +protected lemma tsub_tsub_tsub_cancel_left (hab : add_le_cancellable (a - b)) (h : b ≤ a) : + a - c - (a - b) = b - c := +by rw [tsub_right_comm, hab.tsub_tsub_cancel_of_le h] + +end add_le_cancellable + +section contra +/-! ### Lemmas where addition is order-reflecting. -/ +variable [contravariant_class α α (+) (≤)] + +lemma eq_tsub_iff_add_eq_of_le (h : c ≤ b) : a = b - c ↔ a + c = b := +contravariant.add_le_cancellable.eq_tsub_iff_add_eq_of_le h + +lemma tsub_eq_iff_eq_add_of_le (h : b ≤ a) : a - b = c ↔ a = c + b := +contravariant.add_le_cancellable.tsub_eq_iff_eq_add_of_le h + +/-- See `add_tsub_le_assoc` for an inequality. -/ +lemma add_tsub_assoc_of_le (h : c ≤ b) (a : α) : a + b - c = a + (b - c) := +contravariant.add_le_cancellable.add_tsub_assoc_of_le h a + +lemma tsub_add_eq_add_tsub (h : b ≤ a) : a - b + c = a + c - b := +contravariant.add_le_cancellable.tsub_add_eq_add_tsub h + +lemma tsub_tsub_assoc (h₁ : b ≤ a) (h₂ : c ≤ b) : a - (b - c) = a - b + c := +contravariant.add_le_cancellable.tsub_tsub_assoc h₁ h₂ + +lemma tsub_add_tsub_comm (hba : b ≤ a) (hdc : d ≤ c) : a - b + (c - d) = a + c - (b + d) := +contravariant.add_le_cancellable.tsub_add_tsub_comm contravariant.add_le_cancellable hba hdc + +lemma le_tsub_iff_left (h : a ≤ c) : b ≤ c - a ↔ a + b ≤ c := +contravariant.add_le_cancellable.le_tsub_iff_left h + +lemma le_tsub_iff_right (h : a ≤ c) : b ≤ c - a ↔ b + a ≤ c := +contravariant.add_le_cancellable.le_tsub_iff_right h + +lemma tsub_lt_iff_left (hbc : b ≤ a) : a - b < c ↔ a < b + c := +contravariant.add_le_cancellable.tsub_lt_iff_left hbc + +lemma tsub_lt_iff_right (hbc : b ≤ a) : a - b < c ↔ a < c + b := +contravariant.add_le_cancellable.tsub_lt_iff_right hbc + +lemma tsub_lt_iff_tsub_lt (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < c ↔ a - c < b := +contravariant.add_le_cancellable.tsub_lt_iff_tsub_lt contravariant.add_le_cancellable h₁ h₂ + +lemma le_tsub_iff_le_tsub (h₁ : a ≤ b) (h₂ : c ≤ b) : a ≤ b - c ↔ c ≤ b - a := +contravariant.add_le_cancellable.le_tsub_iff_le_tsub contravariant.add_le_cancellable h₁ h₂ + +/-- See `lt_tsub_iff_right` for a stronger statement in a linear order. -/ +lemma lt_tsub_iff_right_of_le (h : c ≤ b) : a < b - c ↔ a + c < b := +contravariant.add_le_cancellable.lt_tsub_iff_right_of_le h + +/-- See `lt_tsub_iff_left` for a stronger statement in a linear order. -/ +lemma lt_tsub_iff_left_of_le (h : c ≤ b) : a < b - c ↔ c + a < b := +contravariant.add_le_cancellable.lt_tsub_iff_left_of_le h + +/-- See `lt_of_tsub_lt_tsub_left` for a stronger statement in a linear order. -/ +lemma lt_of_tsub_lt_tsub_left_of_le [contravariant_class α α (+) (<)] + (hca : c ≤ a) (h : a - b < a - c) : c < b := +contravariant.add_le_cancellable.lt_of_tsub_lt_tsub_left_of_le hca h + +lemma tsub_lt_tsub_left_of_le : b ≤ a → c < b → a - b < a - c := +contravariant.add_le_cancellable.tsub_lt_tsub_left_of_le + +lemma tsub_lt_tsub_right_of_le (h : c ≤ a) (h2 : a < b) : a - c < b - c := +contravariant.add_le_cancellable.tsub_lt_tsub_right_of_le h h2 + +lemma tsub_inj_right (h₁ : b ≤ a) (h₂ : c ≤ a) (h₃ : a - b = a - c) : b = c := +contravariant.add_le_cancellable.tsub_inj_right h₁ h₂ h₃ + +/-- See `tsub_lt_tsub_iff_left_of_le` for a stronger statement in a linear order. -/ +lemma tsub_lt_tsub_iff_left_of_le_of_le [contravariant_class α α (+) (<)] + (h₁ : b ≤ a) (h₂ : c ≤ a) : a - b < a - c ↔ c < b := +contravariant.add_le_cancellable.tsub_lt_tsub_iff_left_of_le_of_le + contravariant.add_le_cancellable h₁ h₂ + +@[simp] lemma add_tsub_tsub_cancel (h : c ≤ a) : (a + b) - (a - c) = b + c := +contravariant.add_le_cancellable.add_tsub_tsub_cancel h + +/-- See `tsub_tsub_le` for an inequality. -/ +lemma tsub_tsub_cancel_of_le (h : a ≤ b) : b - (b - a) = a := +contravariant.add_le_cancellable.tsub_tsub_cancel_of_le h + +lemma tsub_tsub_tsub_cancel_left (h : b ≤ a) : a - c - (a - b) = b - c := +contravariant.add_le_cancellable.tsub_tsub_tsub_cancel_left h + +end contra +end has_exists_add_of_le + +/-! ### Lemmas in a canonically ordered monoid. -/ + +section canonically_ordered_add_monoid +variables [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +lemma add_tsub_cancel_iff_le : a + (b - a) = b ↔ a ≤ b := +⟨λ h, le_iff_exists_add.mpr ⟨b - a, h.symm⟩, add_tsub_cancel_of_le⟩ + +lemma tsub_add_cancel_iff_le : b - a + a = b ↔ a ≤ b := +by { rw [add_comm], exact add_tsub_cancel_iff_le } + +@[simp] lemma tsub_eq_zero_iff_le : a - b = 0 ↔ a ≤ b := +by rw [← nonpos_iff_eq_zero, tsub_le_iff_left, add_zero] + +alias tsub_eq_zero_iff_le ↔ _ tsub_eq_zero_of_le + +attribute [simp] tsub_eq_zero_of_le + +@[simp] lemma tsub_self (a : α) : a - a = 0 := tsub_eq_zero_of_le le_rfl + +@[simp] lemma tsub_le_self : a - b ≤ a := tsub_le_iff_left.mpr $ le_add_left le_rfl + +@[simp] lemma zero_tsub (a : α) : 0 - a = 0 := tsub_eq_zero_of_le $ zero_le a + +lemma tsub_self_add (a b : α) : a - (a + b) = 0 := tsub_eq_zero_of_le $ self_le_add_right _ _ + +lemma tsub_pos_iff_not_le : 0 < a - b ↔ ¬ a ≤ b := +by rw [pos_iff_ne_zero, ne.def, tsub_eq_zero_iff_le] + +lemma tsub_pos_of_lt (h : a < b) : 0 < b - a := tsub_pos_iff_not_le.mpr h.not_le + +lemma tsub_lt_of_lt (h : a < b) : a - c < b := lt_of_le_of_lt tsub_le_self h + +namespace add_le_cancellable + +protected lemma tsub_le_tsub_iff_left (ha : add_le_cancellable a) (hc : add_le_cancellable c) + (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b := +begin + refine ⟨_, λ h, tsub_le_tsub_left h a⟩, + rw [tsub_le_iff_left, ← hc.add_tsub_assoc_of_le h, hc.le_tsub_iff_right (h.trans le_add_self), + add_comm b], + apply ha, +end + +protected lemma tsub_right_inj (ha : add_le_cancellable a) (hb : add_le_cancellable b) + (hc : add_le_cancellable c) (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c := +by simp_rw [le_antisymm_iff, ha.tsub_le_tsub_iff_left hb hba, ha.tsub_le_tsub_iff_left hc hca, + and_comm] + +end add_le_cancellable + +/-! #### Lemmas where addition is order-reflecting. -/ + +section contra +variable [contravariant_class α α (+) (≤)] + +lemma tsub_le_tsub_iff_left (h : c ≤ a) : a - b ≤ a - c ↔ c ≤ b := +contravariant.add_le_cancellable.tsub_le_tsub_iff_left contravariant.add_le_cancellable h + +lemma tsub_right_inj (hba : b ≤ a) (hca : c ≤ a) : a - b = a - c ↔ b = c := +contravariant.add_le_cancellable.tsub_right_inj contravariant.add_le_cancellable + contravariant.add_le_cancellable hba hca + +variables (α) + +/-- A `canonically_ordered_add_monoid` with ordered subtraction and order-reflecting addition is +cancellative. This is not an instance at it would form a typeclass loop. + +See note [reducible non-instances]. -/ +@[reducible] +def canonically_ordered_add_monoid.to_add_cancel_comm_monoid : add_cancel_comm_monoid α := +{ add_left_cancel := λ a b c h, by simpa only [add_tsub_cancel_left] using congr_arg (λ x, x - a) h, + ..(by apply_instance : add_comm_monoid α) } + +end contra + +end canonically_ordered_add_monoid + +/-! ### Lemmas in a linearly canonically ordered monoid. -/ + +section canonically_linear_ordered_add_monoid +variables [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +@[simp] lemma tsub_pos_iff_lt : 0 < a - b ↔ b < a := +by rw [tsub_pos_iff_not_le, not_le] + +lemma tsub_eq_tsub_min (a b : α) : a - b = a - min a b := +begin + cases le_total a b with h h, + { rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h] }, + { rw [min_eq_right h] }, +end + +namespace add_le_cancellable + +protected lemma lt_tsub_iff_right (hc : add_le_cancellable c) : a < b - c ↔ a + c < b := +⟨lt_imp_lt_of_le_imp_le tsub_le_iff_right.mpr, hc.lt_tsub_of_add_lt_right⟩ + +protected lemma lt_tsub_iff_left (hc : add_le_cancellable c) : a < b - c ↔ c + a < b := +⟨lt_imp_lt_of_le_imp_le tsub_le_iff_left.mpr, hc.lt_tsub_of_add_lt_left⟩ + +protected lemma tsub_lt_tsub_iff_right (hc : add_le_cancellable c) (h : c ≤ a) : + a - c < b - c ↔ a < b := +by rw [hc.lt_tsub_iff_left, add_tsub_cancel_of_le h] + +protected lemma tsub_lt_self (ha : add_le_cancellable a) (h₁ : 0 < a) (h₂ : 0 < b) : a - b < a := +begin + refine tsub_le_self.lt_of_ne (λ h, _), + rw [← h, tsub_pos_iff_lt] at h₁, + exact h₂.not_le (ha.add_le_iff_nonpos_left.1 $ add_le_of_le_tsub_left_of_le h₁.le h.ge), +end + +protected lemma tsub_lt_self_iff (ha : add_le_cancellable a) : a - b < a ↔ 0 < a ∧ 0 < b := +begin + refine ⟨λ h, ⟨(zero_le _).trans_lt h, (zero_le b).lt_of_ne _⟩, λ h, ha.tsub_lt_self h.1 h.2⟩, + rintro rfl, + rw [tsub_zero] at h, + exact h.false +end + +/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/ +protected lemma tsub_lt_tsub_iff_left_of_le (ha : add_le_cancellable a) (hb : add_le_cancellable b) + (h : b ≤ a) : a - b < a - c ↔ c < b := +lt_iff_lt_of_le_iff_le $ ha.tsub_le_tsub_iff_left hb h + +end add_le_cancellable + +section contra +variable [contravariant_class α α (+) (≤)] + +/-- This lemma also holds for `ennreal`, but we need a different proof for that. -/ +lemma tsub_lt_tsub_iff_right (h : c ≤ a) : a - c < b - c ↔ a < b := +contravariant.add_le_cancellable.tsub_lt_tsub_iff_right h + +lemma tsub_lt_self : 0 < a → 0 < b → a - b < a := contravariant.add_le_cancellable.tsub_lt_self + +lemma tsub_lt_self_iff : a - b < a ↔ 0 < a ∧ 0 < b := +contravariant.add_le_cancellable.tsub_lt_self_iff + +/-- See `lt_tsub_iff_left_of_le_of_le` for a weaker statement in a partial order. -/ +lemma tsub_lt_tsub_iff_left_of_le (h : b ≤ a) : a - b < a - c ↔ c < b := +contravariant.add_le_cancellable.tsub_lt_tsub_iff_left_of_le contravariant.add_le_cancellable h + +end contra + +/-! ### Lemmas about `max` and `min`. -/ + +lemma tsub_add_eq_max : a - b + b = max a b := +begin + cases le_total a b with h h, + { rw [max_eq_right h, tsub_eq_zero_of_le h, zero_add] }, + { rw [max_eq_left h, tsub_add_cancel_of_le h] } +end + +lemma add_tsub_eq_max : a + (b - a) = max a b := +by rw [add_comm, max_comm, tsub_add_eq_max] + +lemma tsub_min : a - min a b = a - b := +begin + cases le_total a b with h h, + { rw [min_eq_left h, tsub_self, tsub_eq_zero_of_le h] }, + { rw [min_eq_right h] } +end + +lemma tsub_add_min : a - b + min a b = a := +by { rw [← tsub_min, tsub_add_cancel_of_le], apply min_le_left } + +end canonically_linear_ordered_add_monoid diff --git a/src/algebra/order/sub/defs.lean b/src/algebra/order/sub/defs.lean new file mode 100644 index 0000000000000..e65e0290ed919 --- /dev/null +++ b/src/algebra/order/sub/defs.lean @@ -0,0 +1,367 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import algebra.covariant_and_contravariant +import algebra.group.basic +import algebra.order.monoid.lemmas +import order.lattice + +/-! +# Ordered Subtraction + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves lemmas relating (truncated) subtraction with an order. We provide a class +`has_ordered_sub` stating that `a - b ≤ c ↔ a ≤ c + b`. + +The subtraction discussed here could both be normal subtraction in an additive group or truncated +subtraction on a canonically ordered monoid (`ℕ`, `multiset`, `part_enat`, `ennreal`, ...) + +## Implementation details + +`has_ordered_sub` is a mixin type-class, so that we can use the results in this file even in cases +where we don't have a `canonically_ordered_add_monoid` instance +(even though that is our main focus). Conversely, this means we can use +`canonically_ordered_add_monoid` without necessarily having to define a subtraction. + +The results in this file are ordered by the type-class assumption needed to prove it. +This means that similar results might not be close to each other. Furthermore, we don't prove +implications if a bi-implication can be proven under the same assumptions. + +Lemmas using this class are named using `tsub` instead of `sub` (short for "truncated subtraction"). +This is to avoid naming conflicts with similar lemmas about ordered groups. + +We provide a second version of most results that require `[contravariant_class α α (+) (≤)]`. In the +second version we replace this type-class assumption by explicit `add_le_cancellable` assumptions. + +TODO: maybe we should make a multiplicative version of this, so that we can replace some identical +lemmas about subtraction/division in `ordered_[add_]comm_group` with these. + +TODO: generalize `nat.le_of_le_of_sub_le_sub_right`, `nat.sub_le_sub_right_iff`, + `nat.mul_self_sub_mul_self_eq` +-/ + +variables {α β : Type*} + +/-- `has_ordered_sub α` means that `α` has a subtraction characterized by `a - b ≤ c ↔ a ≤ c + b`. +In other words, `a - b` is the least `c` such that `a ≤ b + c`. + +This is satisfied both by the subtraction in additive ordered groups and by truncated subtraction +in canonically ordered monoids on many specific types. +-/ +class has_ordered_sub (α : Type*) [has_le α] [has_add α] [has_sub α] : Prop := +(tsub_le_iff_right : ∀ a b c : α, a - b ≤ c ↔ a ≤ c + b) + +section has_add + +variables [preorder α] [has_add α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +@[simp] lemma tsub_le_iff_right : a - b ≤ c ↔ a ≤ c + b := +has_ordered_sub.tsub_le_iff_right a b c + +/-- See `add_tsub_cancel_right` for the equality if `contravariant_class α α (+) (≤)`. -/ +lemma add_tsub_le_right : a + b - b ≤ a := +tsub_le_iff_right.mpr le_rfl + +lemma le_tsub_add : b ≤ (b - a) + a := +tsub_le_iff_right.mp le_rfl + +end has_add + +/-! ### Preorder -/ + +section ordered_add_comm_semigroup + +section preorder +variables [preorder α] + +section add_comm_semigroup +variables [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +lemma tsub_le_iff_left : a - b ≤ c ↔ a ≤ b + c := +by rw [tsub_le_iff_right, add_comm] + +lemma le_add_tsub : a ≤ b + (a - b) := +tsub_le_iff_left.mp le_rfl + +/-- See `add_tsub_cancel_left` for the equality if `contravariant_class α α (+) (≤)`. -/ +lemma add_tsub_le_left : a + b - a ≤ b := +tsub_le_iff_left.mpr le_rfl + +lemma tsub_le_tsub_right (h : a ≤ b) (c : α) : a - c ≤ b - c := +tsub_le_iff_left.mpr $ h.trans le_add_tsub + +lemma tsub_le_iff_tsub_le : a - b ≤ c ↔ a - c ≤ b := +by rw [tsub_le_iff_left, tsub_le_iff_right] + +/-- See `tsub_tsub_cancel_of_le` for the equality. -/ +lemma tsub_tsub_le : b - (b - a) ≤ a := +tsub_le_iff_right.mpr le_add_tsub + +section cov +variable [covariant_class α α (+) (≤)] + +lemma tsub_le_tsub_left (h : a ≤ b) (c : α) : c - b ≤ c - a := +tsub_le_iff_left.mpr $ le_add_tsub.trans $ add_le_add_right h _ + +lemma tsub_le_tsub (hab : a ≤ b) (hcd : c ≤ d) : a - d ≤ b - c := +(tsub_le_tsub_right hab _).trans $ tsub_le_tsub_left hcd _ + +lemma antitone_const_tsub : antitone (λ x, c - x) := +λ x y hxy, tsub_le_tsub rfl.le hxy + +/-- See `add_tsub_assoc_of_le` for the equality. -/ +lemma add_tsub_le_assoc : a + b - c ≤ a + (b - c) := +by { rw [tsub_le_iff_left, add_left_comm], exact add_le_add_left le_add_tsub a } + +/-- See `tsub_add_eq_add_tsub` for the equality. -/ +lemma add_tsub_le_tsub_add : a + b - c ≤ a - c + b := +by { rw [add_comm, add_comm _ b], exact add_tsub_le_assoc } + +lemma add_le_add_add_tsub : a + b ≤ (a + c) + (b - c) := +by { rw [add_assoc], exact add_le_add_left le_add_tsub a } + +lemma le_tsub_add_add : a + b ≤ (a - c) + (b + c) := +by { rw [add_comm a, add_comm (a - c)], exact add_le_add_add_tsub } + +lemma tsub_le_tsub_add_tsub : a - c ≤ (a - b) + (b - c) := +begin + rw [tsub_le_iff_left, ← add_assoc, add_right_comm], + exact le_add_tsub.trans (add_le_add_right le_add_tsub _), +end + +lemma tsub_tsub_tsub_le_tsub : (c - a) - (c - b) ≤ b - a := +begin + rw [tsub_le_iff_left, tsub_le_iff_left, add_left_comm], + exact le_tsub_add.trans (add_le_add_left le_add_tsub _), +end + +lemma tsub_tsub_le_tsub_add {a b c : α} : a - (b - c) ≤ a - b + c := +tsub_le_iff_right.2 $ calc + a ≤ a - b + b : le_tsub_add + ... ≤ a - b + (c + (b - c)) : add_le_add_left le_add_tsub _ + ... = a - b + c + (b - c) : (add_assoc _ _ _).symm + +/-- See `tsub_add_tsub_comm` for the equality. -/ +lemma add_tsub_add_le_tsub_add_tsub : a + b - (c + d) ≤ a - c + (b - d) := +begin + rw [add_comm c, tsub_le_iff_left, add_assoc, ←tsub_le_iff_left, ←tsub_le_iff_left], + refine (tsub_le_tsub_right add_tsub_le_assoc c).trans _, + rw [add_comm a, add_comm (a - c)], + exact add_tsub_le_assoc, +end + +/-- See `add_tsub_add_eq_tsub_left` for the equality. -/ +lemma add_tsub_add_le_tsub_left : a + b - (a + c) ≤ b - c := +by { rw [tsub_le_iff_left, add_assoc], exact add_le_add_left le_add_tsub _ } + +/-- See `add_tsub_add_eq_tsub_right` for the equality. -/ +lemma add_tsub_add_le_tsub_right : a + c - (b + c) ≤ a - b := +by { rw [tsub_le_iff_left, add_right_comm], exact add_le_add_right le_add_tsub c } + +end cov + +/-! #### Lemmas that assume that an element is `add_le_cancellable` -/ + +namespace add_le_cancellable + +protected lemma le_add_tsub_swap (hb : add_le_cancellable b) : a ≤ b + a - b := hb le_add_tsub + +protected lemma le_add_tsub (hb : add_le_cancellable b) : a ≤ a + b - b := +by { rw add_comm, exact hb.le_add_tsub_swap } + +protected lemma le_tsub_of_add_le_left (ha : add_le_cancellable a) (h : a + b ≤ c) : b ≤ c - a := +ha $ h.trans le_add_tsub + +protected lemma le_tsub_of_add_le_right (hb : add_le_cancellable b) (h : a + b ≤ c) : a ≤ c - b := +hb.le_tsub_of_add_le_left $ by rwa add_comm + +end add_le_cancellable + +/-! ### Lemmas where addition is order-reflecting -/ + +section contra +variable [contravariant_class α α (+) (≤)] + +lemma le_add_tsub_swap : a ≤ b + a - b := contravariant.add_le_cancellable.le_add_tsub_swap + +lemma le_add_tsub' : a ≤ a + b - b := contravariant.add_le_cancellable.le_add_tsub + +lemma le_tsub_of_add_le_left (h : a + b ≤ c) : b ≤ c - a := +contravariant.add_le_cancellable.le_tsub_of_add_le_left h + +lemma le_tsub_of_add_le_right (h : a + b ≤ c) : a ≤ c - b := +contravariant.add_le_cancellable.le_tsub_of_add_le_right h + +end contra + +end add_comm_semigroup + +variables [add_comm_monoid α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +lemma tsub_nonpos : a - b ≤ 0 ↔ a ≤ b := by rw [tsub_le_iff_left, add_zero] + +alias tsub_nonpos ↔ _ tsub_nonpos_of_le + +end preorder + +/-! ### Partial order -/ + +variables [partial_order α] [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] {a b c d : α} + +lemma tsub_tsub (b a c : α) : b - a - c = b - (a + c) := +begin + apply le_antisymm, + { rw [tsub_le_iff_left, tsub_le_iff_left, ← add_assoc, ← tsub_le_iff_left] }, + { rw [tsub_le_iff_left, add_assoc, ← tsub_le_iff_left, ← tsub_le_iff_left] } +end + +lemma tsub_add_eq_tsub_tsub (a b c : α) : a - (b + c) = a - b - c := (tsub_tsub _ _ _).symm + +lemma tsub_add_eq_tsub_tsub_swap (a b c : α) : a - (b + c) = a - c - b := +by { rw [add_comm], apply tsub_add_eq_tsub_tsub } + +lemma tsub_right_comm : a - b - c = a - c - b := +by simp_rw [← tsub_add_eq_tsub_tsub, add_comm] + +/-! ### Lemmas that assume that an element is `add_le_cancellable`. -/ + +namespace add_le_cancellable + +protected lemma tsub_eq_of_eq_add (hb : add_le_cancellable b) (h : a = c + b) : a - b = c := +le_antisymm (tsub_le_iff_right.mpr h.le) $ + by { rw h, exact hb.le_add_tsub } + +protected lemma eq_tsub_of_add_eq (hc : add_le_cancellable c) (h : a + c = b) : a = b - c := +(hc.tsub_eq_of_eq_add h.symm).symm + +protected theorem tsub_eq_of_eq_add_rev (hb : add_le_cancellable b) (h : a = b + c) : a - b = c := +hb.tsub_eq_of_eq_add $ by rw [add_comm, h] + +@[simp] +protected lemma add_tsub_cancel_right (hb : add_le_cancellable b) : a + b - b = a := +hb.tsub_eq_of_eq_add $ by rw [add_comm] + +@[simp] +protected lemma add_tsub_cancel_left (ha : add_le_cancellable a) : a + b - a = b := +ha.tsub_eq_of_eq_add $ add_comm a b + +protected lemma lt_add_of_tsub_lt_left (hb : add_le_cancellable b) (h : a - b < c) : a < b + c := +begin + rw [lt_iff_le_and_ne, ← tsub_le_iff_left], + refine ⟨h.le, _⟩, + rintro rfl, + simpa [hb] using h, +end + +protected lemma lt_add_of_tsub_lt_right (hc : add_le_cancellable c) (h : a - c < b) : a < b + c := +begin + rw [lt_iff_le_and_ne, ← tsub_le_iff_right], + refine ⟨h.le, _⟩, + rintro rfl, + simpa [hc] using h, +end + +protected lemma lt_tsub_of_add_lt_right (hc : add_le_cancellable c) (h : a + c < b) : a < b - c := +(hc.le_tsub_of_add_le_right h.le).lt_of_ne $ by { rintro rfl, exact h.not_le le_tsub_add } + +protected lemma lt_tsub_of_add_lt_left (ha : add_le_cancellable a) (h : a + c < b) : c < b - a := +ha.lt_tsub_of_add_lt_right $ by rwa add_comm + +end add_le_cancellable + +/-! #### Lemmas where addition is order-reflecting. -/ + +section contra +variable [contravariant_class α α (+) (≤)] + +lemma tsub_eq_of_eq_add (h : a = c + b) : a - b = c := +contravariant.add_le_cancellable.tsub_eq_of_eq_add h + +lemma eq_tsub_of_add_eq (h : a + c = b) : a = b - c := +contravariant.add_le_cancellable.eq_tsub_of_add_eq h + +lemma tsub_eq_of_eq_add_rev (h : a = b + c) : a - b = c := +contravariant.add_le_cancellable.tsub_eq_of_eq_add_rev h + +@[simp] +lemma add_tsub_cancel_right (a b : α) : a + b - b = a := +contravariant.add_le_cancellable.add_tsub_cancel_right + +@[simp] +lemma add_tsub_cancel_left (a b : α) : a + b - a = b := +contravariant.add_le_cancellable.add_tsub_cancel_left + +lemma lt_add_of_tsub_lt_left (h : a - b < c) : a < b + c := +contravariant.add_le_cancellable.lt_add_of_tsub_lt_left h + +lemma lt_add_of_tsub_lt_right (h : a - c < b) : a < b + c := +contravariant.add_le_cancellable.lt_add_of_tsub_lt_right h + +/-- This lemma (and some of its corollaries) also holds for `ennreal`, but this proof doesn't work +for it. Maybe we should add this lemma as field to `has_ordered_sub`? -/ +lemma lt_tsub_of_add_lt_left : a + c < b → c < b - a := +contravariant.add_le_cancellable.lt_tsub_of_add_lt_left + +lemma lt_tsub_of_add_lt_right : a + c < b → a < b - c := +contravariant.add_le_cancellable.lt_tsub_of_add_lt_right + +end contra + +section both +variables [covariant_class α α (+) (≤)] [contravariant_class α α (+) (≤)] + +lemma add_tsub_add_eq_tsub_right (a c b : α) : (a + c) - (b + c) = a - b := +begin + refine add_tsub_add_le_tsub_right.antisymm (tsub_le_iff_right.2 $ le_of_add_le_add_right _), swap, + rw add_assoc, + exact le_tsub_add, +end + +lemma add_tsub_add_eq_tsub_left (a b c : α) : (a + b) - (a + c) = b - c := +by rw [add_comm a b, add_comm a c, add_tsub_add_eq_tsub_right] + +end both + +end ordered_add_comm_semigroup + +/-! ### Lemmas in a linearly ordered monoid. -/ +section linear_order +variables {a b c d : α} [linear_order α] [add_comm_semigroup α] [has_sub α] [has_ordered_sub α] + +/-- See `lt_of_tsub_lt_tsub_right_of_le` for a weaker statement in a partial order. -/ +lemma lt_of_tsub_lt_tsub_right (h : a - c < b - c) : a < b := +lt_imp_lt_of_le_imp_le (λ h, tsub_le_tsub_right h c) h + +/-- See `lt_tsub_iff_right_of_le` for a weaker statement in a partial order. -/ +lemma lt_tsub_iff_right : a < b - c ↔ a + c < b := +lt_iff_lt_of_le_iff_le tsub_le_iff_right + +/-- See `lt_tsub_iff_left_of_le` for a weaker statement in a partial order. -/ +lemma lt_tsub_iff_left : a < b - c ↔ c + a < b := +lt_iff_lt_of_le_iff_le tsub_le_iff_left + +lemma lt_tsub_comm : a < b - c ↔ c < b - a := +lt_tsub_iff_left.trans lt_tsub_iff_right.symm + +section cov +variable [covariant_class α α (+) (≤)] + +/-- See `lt_of_tsub_lt_tsub_left_of_le` for a weaker statement in a partial order. -/ +lemma lt_of_tsub_lt_tsub_left (h : a - b < a - c) : c < b := +lt_imp_lt_of_le_imp_le (λ h, tsub_le_tsub_left h a) h + +end cov + +end linear_order + +section ordered_add_comm_monoid +variables [partial_order α] [add_comm_monoid α] [has_sub α] [has_ordered_sub α] + +@[simp] lemma tsub_zero (a : α) : a - 0 = a := +add_le_cancellable.tsub_eq_of_eq_add add_le_cancellable_zero (add_zero _).symm + +end ordered_add_comm_monoid diff --git a/src/algebra/order/sub/with_top.lean b/src/algebra/order/sub/with_top.lean new file mode 100644 index 0000000000000..879e38bbf9fcc --- /dev/null +++ b/src/algebra/order/sub/with_top.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import algebra.order.sub.defs +import algebra.order.monoid.with_top + +/-! +# Lemma about subtraction in ordered monoids with a top element adjoined. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α β : Type*} + +namespace with_top + +section +variables [has_sub α] [has_zero α] + +/-- If `α` has subtraction and `0`, we can extend the subtraction to `with_top α`. -/ +protected def sub : Π (a b : with_top α), with_top α +| _ ⊤ := 0 +| ⊤ (x : α) := ⊤ +| (x : α) (y : α) := (x - y : α) + +instance : has_sub (with_top α) := +⟨with_top.sub⟩ + +@[simp, norm_cast] lemma coe_sub {a b : α} : (↑(a - b) : with_top α) = ↑a - ↑b := rfl +@[simp] lemma top_sub_coe {a : α} : (⊤ : with_top α) - a = ⊤ := rfl +@[simp] lemma sub_top {a : with_top α} : a - ⊤ = 0 := by { cases a; refl } + +@[simp] theorem sub_eq_top_iff : ∀ {a b : with_top α}, a - b = ⊤ ↔ a = ⊤ ∧ b ≠ ⊤ +| _ ⊤ := by simp +| ⊤ (b : α) := by simp +| (a : α) (b : α) := by simp only [← coe_sub, coe_ne_top, false_and] + +lemma map_sub [has_sub β] [has_zero β] {f : α → β} (h : ∀ x y, f (x - y) = f x - f y) + (h₀ : f 0 = 0) : + ∀ x y : with_top α, (x - y).map f = x.map f - y.map f +| _ ⊤ := by simp only [h₀, sub_top, with_top.map_zero, coe_zero, map_top] +| ⊤ (x : α) := rfl +| (x : α) (y : α) := by simp only [← coe_sub, map_coe, h] + +end + +variables [canonically_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] +instance : has_ordered_sub (with_top α) := +begin + constructor, + rintro x y z, + induction y using with_top.rec_top_coe, { simp }, + induction x using with_top.rec_top_coe, { simp }, + induction z using with_top.rec_top_coe, { simp }, + norm_cast, exact tsub_le_iff_right +end + +end with_top diff --git a/src/algebra/order/to_interval_mod.lean b/src/algebra/order/to_interval_mod.lean new file mode 100644 index 0000000000000..30cba2c693fb9 --- /dev/null +++ b/src/algebra/order/to_interval_mod.lean @@ -0,0 +1,955 @@ +/- +Copyright (c) 2022 Joseph Myers. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Myers +-/ +import algebra.modeq +import algebra.module.basic +import algebra.order.archimedean +import algebra.periodic +import data.int.succ_pred +import group_theory.quotient_group +import order.circular + +/-! +# Reducing to an interval modulo its length + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines operations that reduce a number (in an `archimedean` +`linear_ordered_add_comm_group`) to a number in a given interval, modulo the length of that +interval. + +## Main definitions + +* `to_Ico_div hp a b` (where `hp : 0 < p`): The unique integer such that this multiple of `p`, + subtracted from `b`, is in `Ico a (a + p)`. +* `to_Ico_mod hp a b` (where `hp : 0 < p`): Reduce `b` to the interval `Ico a (a + p)`. +* `to_Ioc_div hp a b` (where `hp : 0 < p`): The unique integer such that this multiple of `p`, + subtracted from `b`, is in `Ioc a (a + p)`. +* `to_Ioc_mod hp a b` (where `hp : 0 < p`): Reduce `b` to the interval `Ioc a (a + p)`. +-/ + +noncomputable theory + +section linear_ordered_add_comm_group + +variables {α : Type*} [linear_ordered_add_comm_group α] [hα : archimedean α] {p : α} (hp : 0 < p) + {a b c : α} {n : ℤ} +include hα + +/-- +The unique integer such that this multiple of `p`, subtracted from `b`, is in `Ico a (a + p)`. -/ +def to_Ico_div (a b : α) : ℤ := (exists_unique_sub_zsmul_mem_Ico hp b a).some + +lemma sub_to_Ico_div_zsmul_mem_Ico (a b : α) : b - to_Ico_div hp a b • p ∈ set.Ico a (a + p) := +(exists_unique_sub_zsmul_mem_Ico hp b a).some_spec.1 + +lemma to_Ico_div_eq_of_sub_zsmul_mem_Ico (h : b - n • p ∈ set.Ico a (a + p)) : + to_Ico_div hp a b = n := +((exists_unique_sub_zsmul_mem_Ico hp b a).some_spec.2 _ h).symm + +/-- +The unique integer such that this multiple of `p`, subtracted from `b`, is in `Ioc a (a + p)`. -/ +def to_Ioc_div (a b : α) : ℤ := (exists_unique_sub_zsmul_mem_Ioc hp b a).some + +lemma sub_to_Ioc_div_zsmul_mem_Ioc (a b : α) : b - to_Ioc_div hp a b • p ∈ set.Ioc a (a + p) := +(exists_unique_sub_zsmul_mem_Ioc hp b a).some_spec.1 + +lemma to_Ioc_div_eq_of_sub_zsmul_mem_Ioc (h : b - n • p ∈ set.Ioc a (a + p)) : + to_Ioc_div hp a b = n := +((exists_unique_sub_zsmul_mem_Ioc hp b a).some_spec.2 _ h).symm + +/-- Reduce `b` to the interval `Ico a (a + p)`. -/ +def to_Ico_mod (a b : α) : α := b - to_Ico_div hp a b • p + +/-- Reduce `b` to the interval `Ioc a (a + p)`. -/ +def to_Ioc_mod (a b : α) : α := b - to_Ioc_div hp a b • p + +lemma to_Ico_mod_mem_Ico (a b : α) : to_Ico_mod hp a b ∈ set.Ico a (a + p) := +sub_to_Ico_div_zsmul_mem_Ico hp a b + +lemma to_Ico_mod_mem_Ico' (b : α) : to_Ico_mod hp 0 b ∈ set.Ico 0 p := +by { convert to_Ico_mod_mem_Ico hp 0 b, exact (zero_add p).symm, } + +lemma to_Ioc_mod_mem_Ioc (a b : α) : to_Ioc_mod hp a b ∈ set.Ioc a (a + p) := +sub_to_Ioc_div_zsmul_mem_Ioc hp a b + +lemma left_le_to_Ico_mod (a b : α) : a ≤ to_Ico_mod hp a b := +(set.mem_Ico.1 (to_Ico_mod_mem_Ico hp a b)).1 + +lemma left_lt_to_Ioc_mod (a b : α) : a < to_Ioc_mod hp a b := +(set.mem_Ioc.1 (to_Ioc_mod_mem_Ioc hp a b)).1 + +lemma to_Ico_mod_lt_right (a b : α) : to_Ico_mod hp a b < a + p := +(set.mem_Ico.1 (to_Ico_mod_mem_Ico hp a b)).2 + +lemma to_Ioc_mod_le_right (a b : α) : to_Ioc_mod hp a b ≤ a + p := +(set.mem_Ioc.1 (to_Ioc_mod_mem_Ioc hp a b)).2 + +@[simp] lemma self_sub_to_Ico_div_zsmul (a b : α) : b - to_Ico_div hp a b • p = to_Ico_mod hp a b := +rfl + +@[simp] lemma self_sub_to_Ioc_div_zsmul (a b : α) : b - to_Ioc_div hp a b • p = to_Ioc_mod hp a b := +rfl + +@[simp] lemma to_Ico_div_zsmul_sub_self (a b : α) : + to_Ico_div hp a b • p - b = -to_Ico_mod hp a b := +by rw [to_Ico_mod, neg_sub] + +@[simp] lemma to_Ioc_div_zsmul_sub_self (a b : α) : + to_Ioc_div hp a b • p - b = -to_Ioc_mod hp a b := +by rw [to_Ioc_mod, neg_sub] + +@[simp] lemma to_Ico_mod_sub_self (a b : α) : to_Ico_mod hp a b - b = -to_Ico_div hp a b • p := +by rw [to_Ico_mod, sub_sub_cancel_left, neg_smul] + +@[simp] lemma to_Ioc_mod_sub_self (a b : α) : to_Ioc_mod hp a b - b = -to_Ioc_div hp a b • p := +by rw [to_Ioc_mod, sub_sub_cancel_left, neg_smul] + +@[simp] lemma self_sub_to_Ico_mod (a b : α) : b - to_Ico_mod hp a b = to_Ico_div hp a b • p := +by rw [to_Ico_mod, sub_sub_cancel] + +@[simp] lemma self_sub_to_Ioc_mod (a b : α) : b - to_Ioc_mod hp a b = to_Ioc_div hp a b • p := +by rw [to_Ioc_mod, sub_sub_cancel] + +@[simp] lemma to_Ico_mod_add_to_Ico_div_zsmul (a b : α) : + to_Ico_mod hp a b + to_Ico_div hp a b • p = b := +by rw [to_Ico_mod, sub_add_cancel] + +@[simp] lemma to_Ioc_mod_add_to_Ioc_div_zsmul (a b : α) : + to_Ioc_mod hp a b + to_Ioc_div hp a b • p = b := +by rw [to_Ioc_mod, sub_add_cancel] + +@[simp] lemma to_Ico_div_zsmul_sub_to_Ico_mod (a b : α) : + to_Ico_div hp a b • p + to_Ico_mod hp a b = b := +by rw [add_comm, to_Ico_mod_add_to_Ico_div_zsmul] + +@[simp] lemma to_Ioc_div_zsmul_sub_to_Ioc_mod (a b : α) : + to_Ioc_div hp a b • p + to_Ioc_mod hp a b = b := +by rw [add_comm, to_Ioc_mod_add_to_Ioc_div_zsmul] + +lemma to_Ico_mod_eq_iff : to_Ico_mod hp a b = c ↔ c ∈ set.Ico a (a + p) ∧ ∃ z : ℤ, b = c + z • p := +begin + refine ⟨λ h, ⟨h ▸ to_Ico_mod_mem_Ico hp a b, to_Ico_div hp a b, + h ▸ (to_Ico_mod_add_to_Ico_div_zsmul _ _ _).symm⟩, _⟩, + simp_rw ←@sub_eq_iff_eq_add, + rintro ⟨hc, n, rfl⟩, + rw [←to_Ico_div_eq_of_sub_zsmul_mem_Ico hp hc, to_Ico_mod], +end + +lemma to_Ioc_mod_eq_iff : to_Ioc_mod hp a b = c ↔ c ∈ set.Ioc a (a + p) ∧ ∃ z : ℤ, b = c + z • p := +begin + refine ⟨λ h, ⟨h ▸ to_Ioc_mod_mem_Ioc hp a b, to_Ioc_div hp a b, + h ▸ (to_Ioc_mod_add_to_Ioc_div_zsmul hp _ _).symm⟩, _⟩, + simp_rw ←@sub_eq_iff_eq_add, + rintro ⟨hc, n, rfl⟩, + rw [←to_Ioc_div_eq_of_sub_zsmul_mem_Ioc hp hc, to_Ioc_mod], +end + +@[simp] lemma to_Ico_div_apply_left (a : α) : to_Ico_div hp a a = 0 := +to_Ico_div_eq_of_sub_zsmul_mem_Ico hp $ by simp [hp] + +@[simp] lemma to_Ioc_div_apply_left (a : α) : to_Ioc_div hp a a = -1 := +to_Ioc_div_eq_of_sub_zsmul_mem_Ioc hp $ by simp [hp] + +@[simp] lemma to_Ico_mod_apply_left (a : α) : to_Ico_mod hp a a = a := +by { rw [to_Ico_mod_eq_iff hp, set.left_mem_Ico], exact ⟨lt_add_of_pos_right _ hp, 0, by simp⟩ } + +@[simp] lemma to_Ioc_mod_apply_left (a : α) : to_Ioc_mod hp a a = a + p := +by { rw [to_Ioc_mod_eq_iff hp, set.right_mem_Ioc], exact ⟨lt_add_of_pos_right _ hp, -1, by simp⟩ } + +lemma to_Ico_div_apply_right (a : α) : to_Ico_div hp a (a + p) = 1 := +to_Ico_div_eq_of_sub_zsmul_mem_Ico hp $ by simp [hp] + +lemma to_Ioc_div_apply_right (a : α) : to_Ioc_div hp a (a + p) = 0 := +to_Ioc_div_eq_of_sub_zsmul_mem_Ioc hp $ by simp [hp] + +lemma to_Ico_mod_apply_right (a : α) : to_Ico_mod hp a (a + p) = a := +by { rw [to_Ico_mod_eq_iff hp, set.left_mem_Ico], exact ⟨lt_add_of_pos_right _ hp, 1, by simp⟩ } + +lemma to_Ioc_mod_apply_right (a : α) : to_Ioc_mod hp a (a + p) = a + p := +by { rw [to_Ioc_mod_eq_iff hp, set.right_mem_Ioc], exact ⟨lt_add_of_pos_right _ hp, 0, by simp⟩ } + +@[simp] lemma to_Ico_div_add_zsmul (a b : α) (m : ℤ) : + to_Ico_div hp a (b + m • p) = to_Ico_div hp a b + m := +to_Ico_div_eq_of_sub_zsmul_mem_Ico hp $ + by simpa only [add_smul, add_sub_add_right_eq_sub] using sub_to_Ico_div_zsmul_mem_Ico hp a b + +@[simp] lemma to_Ico_div_add_zsmul' (a b: α) (m : ℤ) : + to_Ico_div hp (a + m • p) b = to_Ico_div hp a b - m := +begin + refine to_Ico_div_eq_of_sub_zsmul_mem_Ico _ _, + rw [sub_smul, ←sub_add, add_right_comm], + simpa using sub_to_Ico_div_zsmul_mem_Ico hp a b, +end + +@[simp] lemma to_Ioc_div_add_zsmul (a b : α) (m : ℤ) : + to_Ioc_div hp a (b + m • p) = to_Ioc_div hp a b + m := +to_Ioc_div_eq_of_sub_zsmul_mem_Ioc hp $ + by simpa only [add_smul, add_sub_add_right_eq_sub] using sub_to_Ioc_div_zsmul_mem_Ioc hp a b + +@[simp] lemma to_Ioc_div_add_zsmul' (a b : α) (m : ℤ) : + to_Ioc_div hp (a + m • p) b = to_Ioc_div hp a b - m := +begin + refine to_Ioc_div_eq_of_sub_zsmul_mem_Ioc _ _, + rw [sub_smul, ←sub_add, add_right_comm], + simpa using sub_to_Ioc_div_zsmul_mem_Ioc hp a b, +end + +@[simp] lemma to_Ico_div_zsmul_add (a b : α) (m : ℤ) : + to_Ico_div hp a (m • p + b) = m + to_Ico_div hp a b := +by rw [add_comm, to_Ico_div_add_zsmul, add_comm] + +/-! Note we omit `to_Ico_div_zsmul_add'` as `-m + to_Ico_div hp a b` is not very convenient. -/ + +@[simp] lemma to_Ioc_div_zsmul_add (a b : α) (m : ℤ) : + to_Ioc_div hp a (m • p + b) = m + to_Ioc_div hp a b := +by rw [add_comm, to_Ioc_div_add_zsmul, add_comm] + +/-! Note we omit `to_Ioc_div_zsmul_add'` as `-m + to_Ioc_div hp a b` is not very convenient. -/ + +@[simp] lemma to_Ico_div_sub_zsmul (a b : α) (m : ℤ) : + to_Ico_div hp a (b - m • p) = to_Ico_div hp a b - m := +by rw [sub_eq_add_neg, ←neg_smul, to_Ico_div_add_zsmul, sub_eq_add_neg] + +@[simp] lemma to_Ico_div_sub_zsmul' (a b : α) (m : ℤ) : + to_Ico_div hp (a - m • p) b = to_Ico_div hp a b + m := +by rw [sub_eq_add_neg, ←neg_smul, to_Ico_div_add_zsmul', sub_neg_eq_add] + +@[simp] lemma to_Ioc_div_sub_zsmul (a b : α) (m : ℤ) : + to_Ioc_div hp a (b - m • p) = to_Ioc_div hp a b - m := +by rw [sub_eq_add_neg, ←neg_smul, to_Ioc_div_add_zsmul, sub_eq_add_neg] + +@[simp] lemma to_Ioc_div_sub_zsmul' (a b : α) (m : ℤ) : + to_Ioc_div hp (a - m • p) b = to_Ioc_div hp a b + m := +by rw [sub_eq_add_neg, ←neg_smul, to_Ioc_div_add_zsmul', sub_neg_eq_add] + +@[simp] lemma to_Ico_div_add_right (a b : α) : to_Ico_div hp a (b + p) = to_Ico_div hp a b + 1 := +by simpa only [one_zsmul] using to_Ico_div_add_zsmul hp a b 1 + +@[simp] lemma to_Ico_div_add_right' (a b : α) : to_Ico_div hp (a + p) b = to_Ico_div hp a b - 1 := +by simpa only [one_zsmul] using to_Ico_div_add_zsmul' hp a b 1 + +@[simp] lemma to_Ioc_div_add_right (a b : α) : to_Ioc_div hp a (b + p) = to_Ioc_div hp a b + 1 := +by simpa only [one_zsmul] using to_Ioc_div_add_zsmul hp a b 1 + +@[simp] lemma to_Ioc_div_add_right' (a b : α) : to_Ioc_div hp (a + p) b = to_Ioc_div hp a b - 1 := +by simpa only [one_zsmul] using to_Ioc_div_add_zsmul' hp a b 1 + +@[simp] lemma to_Ico_div_add_left (a b : α) : to_Ico_div hp a (p + b) = to_Ico_div hp a b + 1 := +by rw [add_comm, to_Ico_div_add_right] + +@[simp] lemma to_Ico_div_add_left' (a b : α) : to_Ico_div hp (p + a) b = to_Ico_div hp a b - 1 := +by rw [add_comm, to_Ico_div_add_right'] + +@[simp] lemma to_Ioc_div_add_left (a b : α) : to_Ioc_div hp a (p + b) = to_Ioc_div hp a b + 1 := +by rw [add_comm, to_Ioc_div_add_right] + +@[simp] lemma to_Ioc_div_add_left' (a b : α) : to_Ioc_div hp (p + a) b = to_Ioc_div hp a b - 1 := +by rw [add_comm, to_Ioc_div_add_right'] + +@[simp] lemma to_Ico_div_sub (a b : α) : to_Ico_div hp a (b - p) = to_Ico_div hp a b - 1 := +by simpa only [one_zsmul] using to_Ico_div_sub_zsmul hp a b 1 + +@[simp] lemma to_Ico_div_sub' (a b : α) : to_Ico_div hp (a - p) b = to_Ico_div hp a b + 1 := +by simpa only [one_zsmul] using to_Ico_div_sub_zsmul' hp a b 1 + +@[simp] lemma to_Ioc_div_sub (a b : α) : to_Ioc_div hp a (b - p) = to_Ioc_div hp a b - 1 := +by simpa only [one_zsmul] using to_Ioc_div_sub_zsmul hp a b 1 + +@[simp] lemma to_Ioc_div_sub' (a b : α) : to_Ioc_div hp (a - p) b = to_Ioc_div hp a b + 1 := +by simpa only [one_zsmul] using to_Ioc_div_sub_zsmul' hp a b 1 + +lemma to_Ico_div_sub_eq_to_Ico_div_add (a b c : α) : + to_Ico_div hp a (b - c) = to_Ico_div hp (a + c) b := +begin + apply to_Ico_div_eq_of_sub_zsmul_mem_Ico, + rw [←sub_right_comm, set.sub_mem_Ico_iff_left, add_right_comm], + exact sub_to_Ico_div_zsmul_mem_Ico hp (a + c) b, +end + +lemma to_Ioc_div_sub_eq_to_Ioc_div_add (a b c : α) : + to_Ioc_div hp a (b - c) = to_Ioc_div hp (a + c) b := +begin + apply to_Ioc_div_eq_of_sub_zsmul_mem_Ioc, + rw [←sub_right_comm, set.sub_mem_Ioc_iff_left, add_right_comm], + exact sub_to_Ioc_div_zsmul_mem_Ioc hp (a + c) b, +end + +lemma to_Ico_div_sub_eq_to_Ico_div_add' (a b c : α) : + to_Ico_div hp (a - c) b = to_Ico_div hp a (b + c) := +by rw [←sub_neg_eq_add, to_Ico_div_sub_eq_to_Ico_div_add, sub_eq_add_neg] + +lemma to_Ioc_div_sub_eq_to_Ioc_div_add' (a b c : α) : + to_Ioc_div hp (a - c) b = to_Ioc_div hp a (b + c) := +by rw [←sub_neg_eq_add, to_Ioc_div_sub_eq_to_Ioc_div_add, sub_eq_add_neg] + +lemma to_Ico_div_neg (a b : α) : to_Ico_div hp a (-b) = -(to_Ioc_div hp (-a) b + 1) := +begin + suffices : to_Ico_div hp a (-b) = -(to_Ioc_div hp (-(a + p)) b), + { rwa [neg_add, ←sub_eq_add_neg, to_Ioc_div_sub_eq_to_Ioc_div_add', + to_Ioc_div_add_right] at this }, + rw [← neg_eq_iff_eq_neg, eq_comm], + apply to_Ioc_div_eq_of_sub_zsmul_mem_Ioc, + obtain ⟨hc, ho⟩ := sub_to_Ico_div_zsmul_mem_Ico hp a (-b), + rw [←neg_lt_neg_iff, neg_sub' (-b), neg_neg, ←neg_smul] at ho, + rw [←neg_le_neg_iff, neg_sub' (-b), neg_neg, ←neg_smul] at hc, + refine ⟨ho, hc.trans_eq _⟩, + rw [neg_add, neg_add_cancel_right], +end + +lemma to_Ico_div_neg' (a b : α) : to_Ico_div hp (-a) b = -(to_Ioc_div hp a (-b) + 1) := +by simpa only [neg_neg] using to_Ico_div_neg hp (-a) (-b) + +lemma to_Ioc_div_neg (a b : α) : to_Ioc_div hp a (-b) = -(to_Ico_div hp (-a) b + 1) := +by rw [←neg_neg b, to_Ico_div_neg, neg_neg, neg_neg, neg_add', neg_neg, add_sub_cancel] + +lemma to_Ioc_div_neg' (a b : α) : to_Ioc_div hp (-a) b = -(to_Ico_div hp a (-b) + 1) := +by simpa only [neg_neg] using to_Ioc_div_neg hp (-a) (-b) + +@[simp] lemma to_Ico_mod_add_zsmul (a b : α) (m : ℤ) : + to_Ico_mod hp a (b + m • p) = to_Ico_mod hp a b := +by { rw [to_Ico_mod, to_Ico_div_add_zsmul, to_Ico_mod, add_smul], abel } + +@[simp] lemma to_Ico_mod_add_zsmul' (a b : α) (m : ℤ) : + to_Ico_mod hp (a + m • p) b = to_Ico_mod hp a b + m • p := +by simp only [to_Ico_mod, to_Ico_div_add_zsmul', sub_smul, sub_add] + +@[simp] lemma to_Ioc_mod_add_zsmul (a b : α) (m : ℤ) : + to_Ioc_mod hp a (b + m • p) = to_Ioc_mod hp a b := +by { rw [to_Ioc_mod, to_Ioc_div_add_zsmul, to_Ioc_mod, add_smul], abel } + +@[simp] lemma to_Ioc_mod_add_zsmul' (a b : α) (m : ℤ) : + to_Ioc_mod hp (a + m • p) b = to_Ioc_mod hp a b + m • p := +by simp only [to_Ioc_mod, to_Ioc_div_add_zsmul', sub_smul, sub_add] + +@[simp] lemma to_Ico_mod_zsmul_add (a b : α) (m : ℤ) : + to_Ico_mod hp a (m • p + b) = to_Ico_mod hp a b := +by rw [add_comm, to_Ico_mod_add_zsmul] + +@[simp] lemma to_Ico_mod_zsmul_add' (a b : α) (m : ℤ) : + to_Ico_mod hp (m • p + a) b = m • p + to_Ico_mod hp a b := +by rw [add_comm, to_Ico_mod_add_zsmul', add_comm] + +@[simp] lemma to_Ioc_mod_zsmul_add (a b : α) (m : ℤ) : + to_Ioc_mod hp a (m • p + b) = to_Ioc_mod hp a b := +by rw [add_comm, to_Ioc_mod_add_zsmul] + +@[simp] lemma to_Ioc_mod_zsmul_add' (a b : α) (m : ℤ) : + to_Ioc_mod hp (m • p + a) b = m • p + to_Ioc_mod hp a b := +by rw [add_comm, to_Ioc_mod_add_zsmul', add_comm] + +@[simp] lemma to_Ico_mod_sub_zsmul (a b : α) (m : ℤ) : + to_Ico_mod hp a (b - m • p) = to_Ico_mod hp a b := +by rw [sub_eq_add_neg, ←neg_smul, to_Ico_mod_add_zsmul] + +@[simp] lemma to_Ico_mod_sub_zsmul' (a b : α) (m : ℤ) : + to_Ico_mod hp (a - m • p) b = to_Ico_mod hp a b - m • p := +by simp_rw [sub_eq_add_neg, ←neg_smul, to_Ico_mod_add_zsmul'] + +@[simp] lemma to_Ioc_mod_sub_zsmul (a b : α) (m : ℤ) : + to_Ioc_mod hp a (b - m • p) = to_Ioc_mod hp a b := +by rw [sub_eq_add_neg, ←neg_smul, to_Ioc_mod_add_zsmul] + +@[simp] lemma to_Ioc_mod_sub_zsmul' (a b : α) (m : ℤ) : + to_Ioc_mod hp (a - m • p) b = to_Ioc_mod hp a b - m • p := +by simp_rw [sub_eq_add_neg, ←neg_smul, to_Ioc_mod_add_zsmul'] + +@[simp] lemma to_Ico_mod_add_right (a b : α) : to_Ico_mod hp a (b + p) = to_Ico_mod hp a b := +by simpa only [one_zsmul] using to_Ico_mod_add_zsmul hp a b 1 + +@[simp] lemma to_Ico_mod_add_right' (a b : α) : to_Ico_mod hp (a + p) b = to_Ico_mod hp a b + p := +by simpa only [one_zsmul] using to_Ico_mod_add_zsmul' hp a b 1 + +@[simp] lemma to_Ioc_mod_add_right (a b : α) : to_Ioc_mod hp a (b + p) = to_Ioc_mod hp a b := +by simpa only [one_zsmul] using to_Ioc_mod_add_zsmul hp a b 1 + +@[simp] lemma to_Ioc_mod_add_right' (a b : α) : to_Ioc_mod hp (a + p) b = to_Ioc_mod hp a b + p := +by simpa only [one_zsmul] using to_Ioc_mod_add_zsmul' hp a b 1 + +@[simp] lemma to_Ico_mod_add_left (a b : α) : to_Ico_mod hp a (p + b) = to_Ico_mod hp a b := +by rw [add_comm, to_Ico_mod_add_right] + +@[simp] lemma to_Ico_mod_add_left' (a b : α) : to_Ico_mod hp (p + a) b = p + to_Ico_mod hp a b := +by rw [add_comm, to_Ico_mod_add_right', add_comm] + +@[simp] lemma to_Ioc_mod_add_left (a b : α) : to_Ioc_mod hp a (p + b) = to_Ioc_mod hp a b := +by rw [add_comm, to_Ioc_mod_add_right] + +@[simp] lemma to_Ioc_mod_add_left' (a b : α) : to_Ioc_mod hp (p + a) b = p + to_Ioc_mod hp a b := +by rw [add_comm, to_Ioc_mod_add_right', add_comm] + +@[simp] lemma to_Ico_mod_sub (a b : α) : to_Ico_mod hp a (b - p) = to_Ico_mod hp a b := +by simpa only [one_zsmul] using to_Ico_mod_sub_zsmul hp a b 1 + +@[simp] lemma to_Ico_mod_sub' (a b : α) : to_Ico_mod hp (a - p) b = to_Ico_mod hp a b - p := +by simpa only [one_zsmul] using to_Ico_mod_sub_zsmul' hp a b 1 + +@[simp] lemma to_Ioc_mod_sub (a b : α) : to_Ioc_mod hp a (b - p) = to_Ioc_mod hp a b := +by simpa only [one_zsmul] using to_Ioc_mod_sub_zsmul hp a b 1 + +@[simp] lemma to_Ioc_mod_sub' (a b : α) : to_Ioc_mod hp (a - p) b = to_Ioc_mod hp a b - p := +by simpa only [one_zsmul] using to_Ioc_mod_sub_zsmul' hp a b 1 + +lemma to_Ico_mod_sub_eq_sub (a b c : α) : to_Ico_mod hp a (b - c) = to_Ico_mod hp (a + c) b - c := +by simp_rw [to_Ico_mod, to_Ico_div_sub_eq_to_Ico_div_add, sub_right_comm] + +lemma to_Ioc_mod_sub_eq_sub (a b c : α) : to_Ioc_mod hp a (b - c) = to_Ioc_mod hp (a + c) b - c := +by simp_rw [to_Ioc_mod, to_Ioc_div_sub_eq_to_Ioc_div_add, sub_right_comm] + +lemma to_Ico_mod_add_right_eq_add (a b c : α) : + to_Ico_mod hp a (b + c) = to_Ico_mod hp (a - c) b + c := +by simp_rw [to_Ico_mod, to_Ico_div_sub_eq_to_Ico_div_add', sub_add_eq_add_sub] + +lemma to_Ioc_mod_add_right_eq_add (a b c : α) : + to_Ioc_mod hp a (b + c) = to_Ioc_mod hp (a - c) b + c := +by simp_rw [to_Ioc_mod, to_Ioc_div_sub_eq_to_Ioc_div_add', sub_add_eq_add_sub] + +lemma to_Ico_mod_neg (a b : α) : to_Ico_mod hp a (-b) = p - to_Ioc_mod hp (-a) b := +by { simp_rw [to_Ico_mod, to_Ioc_mod, to_Ico_div_neg, neg_smul, add_smul], abel } + +lemma to_Ico_mod_neg' (a b : α) : to_Ico_mod hp (-a) b = p - to_Ioc_mod hp a (-b) := +by simpa only [neg_neg] using to_Ico_mod_neg hp (-a) (-b) + +lemma to_Ioc_mod_neg (a b : α) : to_Ioc_mod hp a (-b) = p - to_Ico_mod hp (-a) b := +by { simp_rw [to_Ioc_mod, to_Ico_mod, to_Ioc_div_neg, neg_smul, add_smul], abel } + +lemma to_Ioc_mod_neg' (a b : α) : to_Ioc_mod hp (-a) b = p - to_Ico_mod hp a (-b) := +by simpa only [neg_neg] using to_Ioc_mod_neg hp (-a) (-b) + +lemma to_Ico_mod_eq_to_Ico_mod : to_Ico_mod hp a b = to_Ico_mod hp a c ↔ ∃ n : ℤ, c - b = n • p := +begin + refine ⟨λ h, ⟨to_Ico_div hp a c - to_Ico_div hp a b, _⟩, λ h, _⟩, + { conv_lhs { rw [←to_Ico_mod_add_to_Ico_div_zsmul hp a b, + ←to_Ico_mod_add_to_Ico_div_zsmul hp a c] }, + rw [h, sub_smul], + abel }, + { rcases h with ⟨z, hz⟩, + rw sub_eq_iff_eq_add at hz, + rw [hz, to_Ico_mod_zsmul_add] } +end + +lemma to_Ioc_mod_eq_to_Ioc_mod : to_Ioc_mod hp a b = to_Ioc_mod hp a c ↔ ∃ n : ℤ, c - b = n • p := +begin + refine ⟨λ h, ⟨to_Ioc_div hp a c - to_Ioc_div hp a b, _⟩, λ h, _⟩, + { conv_lhs { rw [←to_Ioc_mod_add_to_Ioc_div_zsmul hp a b, + ←to_Ioc_mod_add_to_Ioc_div_zsmul hp a c] }, + rw [h, sub_smul], + abel }, + { rcases h with ⟨z, hz⟩, + rw sub_eq_iff_eq_add at hz, + rw [hz, to_Ioc_mod_zsmul_add] } +end + +/-! ### Links between the `Ico` and `Ioc` variants applied to the same element -/ + +section Ico_Ioc +variables {a b} + +namespace add_comm_group + +lemma modeq_iff_to_Ico_mod_eq_left : a ≡ b [PMOD p] ↔ to_Ico_mod hp a b = a := +modeq_iff_eq_add_zsmul.trans ⟨by { rintro ⟨n, rfl⟩, + rw [to_Ico_mod_add_zsmul, to_Ico_mod_apply_left] }, λ h, ⟨to_Ico_div hp a b, eq_add_of_sub_eq h⟩⟩ + +lemma modeq_iff_to_Ioc_mod_eq_right : a ≡ b [PMOD p] ↔ to_Ioc_mod hp a b = a + p := +begin + refine modeq_iff_eq_add_zsmul.trans ⟨_, λ h, ⟨to_Ioc_div hp a b + 1, _⟩⟩, + { rintro ⟨z, rfl⟩, + rw [to_Ioc_mod_add_zsmul, to_Ioc_mod_apply_left] }, + { rwa [add_one_zsmul, add_left_comm, ←sub_eq_iff_eq_add'] } +end + +alias modeq_iff_to_Ico_mod_eq_left ↔ modeq.to_Ico_mod_eq_left _ +alias modeq_iff_to_Ioc_mod_eq_right ↔ modeq.to_Ico_mod_eq_right _ + +variables (a b) + +lemma tfae_modeq : + tfae [ + a ≡ b [PMOD p], + ∀ z : ℤ, b - z • p ∉ set.Ioo a (a + p), + to_Ico_mod hp a b ≠ to_Ioc_mod hp a b, + to_Ico_mod hp a b + p = to_Ioc_mod hp a b] := +begin + rw modeq_iff_to_Ico_mod_eq_left hp, + tfae_have : 3 → 2, + { rw [←not_exists, not_imp_not], + exact λ ⟨i, hi⟩, + ((to_Ico_mod_eq_iff hp).2 ⟨set.Ioo_subset_Ico_self hi, i, (sub_add_cancel b _).symm⟩).trans + ((to_Ioc_mod_eq_iff hp).2 ⟨set.Ioo_subset_Ioc_self hi, i, (sub_add_cancel b _).symm⟩).symm }, + tfae_have : 4 → 3, + { intro h, rw [←h, ne, eq_comm, add_right_eq_self], exact hp.ne' }, + tfae_have : 1 → 4, + { intro h, + rw [h, eq_comm, to_Ioc_mod_eq_iff, set.right_mem_Ioc], + refine ⟨lt_add_of_pos_right a hp, to_Ico_div hp a b - 1, _⟩, + rw [sub_one_zsmul, add_add_add_comm, add_right_neg, add_zero], + conv_lhs { rw [← to_Ico_mod_add_to_Ico_div_zsmul hp a b, h] } }, + tfae_have : 2 → 1, + { rw [←not_exists, not_imp_comm], + have h' := to_Ico_mod_mem_Ico hp a b, + exact λ h, ⟨_, h'.1.lt_of_ne' h, h'.2⟩ }, + tfae_finish, +end + +variables {a b} + +lemma modeq_iff_not_forall_mem_Ioo_mod : + a ≡ b [PMOD p] ↔ ∀ z : ℤ, b - z • p ∉ set.Ioo a (a + p) := (tfae_modeq hp a b).out 0 1 +lemma modeq_iff_to_Ico_mod_ne_to_Ioc_mod : + a ≡ b [PMOD p] ↔ to_Ico_mod hp a b ≠ to_Ioc_mod hp a b := (tfae_modeq hp a b).out 0 2 +lemma modeq_iff_to_Ico_mod_add_period_eq_to_Ioc_mod : + a ≡ b [PMOD p] ↔ to_Ico_mod hp a b + p = to_Ioc_mod hp a b := (tfae_modeq hp a b).out 0 3 + +lemma not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod : + ¬a ≡ b [PMOD p] ↔ to_Ico_mod hp a b = to_Ioc_mod hp a b := +(modeq_iff_to_Ico_mod_ne_to_Ioc_mod _).not_left + +lemma not_modeq_iff_to_Ico_div_eq_to_Ioc_div : + ¬a ≡ b [PMOD p] ↔ to_Ico_div hp a b = to_Ioc_div hp a b := +by rw [not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod hp, + to_Ico_mod, to_Ioc_mod, sub_right_inj, (zsmul_strict_mono_left hp).injective.eq_iff] + +lemma modeq_iff_to_Ico_div_eq_to_Ioc_div_add_one : + a ≡ b [PMOD p] ↔ to_Ico_div hp a b = to_Ioc_div hp a b + 1 := +by rw [modeq_iff_to_Ico_mod_add_period_eq_to_Ioc_mod hp, to_Ico_mod, to_Ioc_mod, + ← eq_sub_iff_add_eq, sub_sub, sub_right_inj, ← add_one_zsmul, + (zsmul_strict_mono_left hp).injective.eq_iff] + +end add_comm_group + +open add_comm_group + +/-- If `a` and `b` fall within the same cycle WRT `c`, then they are congruent modulo `p`. -/ +@[simp] lemma to_Ico_mod_inj {c : α} : to_Ico_mod hp c a = to_Ico_mod hp c b ↔ a ≡ b [PMOD p] := +by simp_rw [to_Ico_mod_eq_to_Ico_mod, modeq_iff_eq_add_zsmul, sub_eq_iff_eq_add'] + +alias to_Ico_mod_inj ↔ _ add_comm_group.modeq.to_Ico_mod_eq_to_Ico_mod + +lemma Ico_eq_locus_Ioc_eq_Union_Ioo : + {b | to_Ico_mod hp a b = to_Ioc_mod hp a b} = ⋃ z : ℤ, set.Ioo (a + z • p) (a + p + z • p) := +begin + ext1, simp_rw [set.mem_set_of, set.mem_Union, ← set.sub_mem_Ioo_iff_left, + ←not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod, modeq_iff_not_forall_mem_Ioo_mod hp, not_forall, + not_not], +end + +lemma to_Ioc_div_wcovby_to_Ico_div (a b : α) : to_Ioc_div hp a b ⩿ to_Ico_div hp a b := +begin + suffices : to_Ioc_div hp a b = to_Ico_div hp a b ∨ to_Ioc_div hp a b + 1 = to_Ico_div hp a b, + { rwa [wcovby_iff_eq_or_covby, ←order.succ_eq_iff_covby] }, + rw [eq_comm, ←not_modeq_iff_to_Ico_div_eq_to_Ioc_div, + eq_comm, ←modeq_iff_to_Ico_div_eq_to_Ioc_div_add_one], + exact em' _, +end + +lemma to_Ico_mod_le_to_Ioc_mod (a b : α) : to_Ico_mod hp a b ≤ to_Ioc_mod hp a b := +begin + rw [to_Ico_mod, to_Ioc_mod, sub_le_sub_iff_left], + exact zsmul_mono_left hp.le (to_Ioc_div_wcovby_to_Ico_div _ _ _).le +end + +lemma to_Ioc_mod_le_to_Ico_mod_add (a b : α) : to_Ioc_mod hp a b ≤ to_Ico_mod hp a b + p := +begin + rw [to_Ico_mod, to_Ioc_mod, sub_add, sub_le_sub_iff_left, sub_le_iff_le_add, ←add_one_zsmul, + (zsmul_strict_mono_left hp).le_iff_le], + apply (to_Ioc_div_wcovby_to_Ico_div _ _ _).le_succ, +end + +end Ico_Ioc + +open add_comm_group + +lemma to_Ico_mod_eq_self : to_Ico_mod hp a b = b ↔ b ∈ set.Ico a (a + p) := +by { rw [to_Ico_mod_eq_iff, and_iff_left], exact ⟨0, by simp⟩ } + +lemma to_Ioc_mod_eq_self : to_Ioc_mod hp a b = b ↔ b ∈ set.Ioc a (a + p) := +by { rw [to_Ioc_mod_eq_iff, and_iff_left], exact ⟨0, by simp⟩ } + +@[simp] lemma to_Ico_mod_to_Ico_mod (a₁ a₂ b : α) : + to_Ico_mod hp a₁ (to_Ico_mod hp a₂ b) = to_Ico_mod hp a₁ b := +(to_Ico_mod_eq_to_Ico_mod _).2 ⟨to_Ico_div hp a₂ b, self_sub_to_Ico_mod hp a₂ b⟩ + +@[simp] lemma to_Ico_mod_to_Ioc_mod (a₁ a₂ b : α) : + to_Ico_mod hp a₁ (to_Ioc_mod hp a₂ b) = to_Ico_mod hp a₁ b := +(to_Ico_mod_eq_to_Ico_mod _).2 ⟨to_Ioc_div hp a₂ b, self_sub_to_Ioc_mod hp a₂ b⟩ + +@[simp] lemma to_Ioc_mod_to_Ioc_mod (a₁ a₂ b : α) : + to_Ioc_mod hp a₁ (to_Ioc_mod hp a₂ b) = to_Ioc_mod hp a₁ b := +(to_Ioc_mod_eq_to_Ioc_mod _).2 ⟨to_Ioc_div hp a₂ b, self_sub_to_Ioc_mod hp a₂ b⟩ + +@[simp] lemma to_Ioc_mod_to_Ico_mod (a₁ a₂ b : α) : + to_Ioc_mod hp a₁ (to_Ico_mod hp a₂ b) = to_Ioc_mod hp a₁ b := +(to_Ioc_mod_eq_to_Ioc_mod _).2 ⟨to_Ico_div hp a₂ b, self_sub_to_Ico_mod hp a₂ b⟩ + +lemma to_Ico_mod_periodic (a : α) : function.periodic (to_Ico_mod hp a) p := +to_Ico_mod_add_right hp a + +lemma to_Ioc_mod_periodic (a : α) : function.periodic (to_Ioc_mod hp a) p := +to_Ioc_mod_add_right hp a + +-- helper lemmas for when `a = 0` +section zero + +lemma to_Ico_mod_zero_sub_comm (a b : α) : to_Ico_mod hp 0 (a - b) = p - to_Ioc_mod hp 0 (b - a) := +by rw [←neg_sub, to_Ico_mod_neg, neg_zero] + +lemma to_Ioc_mod_zero_sub_comm (a b : α) : to_Ioc_mod hp 0 (a - b) = p - to_Ico_mod hp 0 (b - a) := +by rw [←neg_sub, to_Ioc_mod_neg, neg_zero] + +lemma to_Ico_div_eq_sub (a b : α) : to_Ico_div hp a b = to_Ico_div hp 0 (b - a) := +by rw [to_Ico_div_sub_eq_to_Ico_div_add, zero_add] + +lemma to_Ioc_div_eq_sub (a b : α) : to_Ioc_div hp a b = to_Ioc_div hp 0 (b - a) := +by rw [to_Ioc_div_sub_eq_to_Ioc_div_add, zero_add] + +lemma to_Ico_mod_eq_sub (a b : α) : to_Ico_mod hp a b = to_Ico_mod hp 0 (b - a) + a := +by rw [to_Ico_mod_sub_eq_sub, zero_add, sub_add_cancel] + +lemma to_Ioc_mod_eq_sub (a b : α) : to_Ioc_mod hp a b = to_Ioc_mod hp 0 (b - a) + a := +by rw [to_Ioc_mod_sub_eq_sub, zero_add, sub_add_cancel] + +lemma to_Ico_mod_add_to_Ioc_mod_zero (a b : α) : + to_Ico_mod hp 0 (a - b) + to_Ioc_mod hp 0 (b - a) = p := +by rw [to_Ico_mod_zero_sub_comm, sub_add_cancel] + +lemma to_Ioc_mod_add_to_Ico_mod_zero (a b : α) : + to_Ioc_mod hp 0 (a - b) + to_Ico_mod hp 0 (b - a) = p := +by rw [add_comm, to_Ico_mod_add_to_Ioc_mod_zero] + +end zero + +/-- `to_Ico_mod` as an equiv from the quotient. -/ +@[simps symm_apply] +def quotient_add_group.equiv_Ico_mod (a : α) : + (α ⧸ add_subgroup.zmultiples p) ≃ set.Ico a (a + p) := +{ to_fun := λ b, ⟨(to_Ico_mod_periodic hp a).lift b, + quotient_add_group.induction_on' b $ to_Ico_mod_mem_Ico hp a⟩, + inv_fun := coe, + right_inv := λ b, subtype.ext $ (to_Ico_mod_eq_self hp).mpr b.prop, + left_inv := λ b, begin + induction b using quotient_add_group.induction_on', + dsimp, + rw [quotient_add_group.eq_iff_sub_mem, to_Ico_mod_sub_self], + apply add_subgroup.zsmul_mem_zmultiples, + end } + +@[simp] +lemma quotient_add_group.equiv_Ico_mod_coe (a b : α) : + quotient_add_group.equiv_Ico_mod hp a ↑b = ⟨to_Ico_mod hp a b, to_Ico_mod_mem_Ico hp a _⟩ := +rfl + +@[simp] +lemma quotient_add_group.equiv_Ico_mod_zero (a : α) : + quotient_add_group.equiv_Ico_mod hp a 0 = ⟨to_Ico_mod hp a 0, to_Ico_mod_mem_Ico hp a _⟩ := +rfl + +/-- `to_Ioc_mod` as an equiv from the quotient. -/ +@[simps symm_apply] +def quotient_add_group.equiv_Ioc_mod (a : α) : + (α ⧸ add_subgroup.zmultiples p) ≃ set.Ioc a (a + p) := +{ to_fun := λ b, ⟨(to_Ioc_mod_periodic hp a).lift b, + quotient_add_group.induction_on' b $ to_Ioc_mod_mem_Ioc hp a⟩, + inv_fun := coe, + right_inv := λ b, subtype.ext $ (to_Ioc_mod_eq_self hp).mpr b.prop, + left_inv := λ b, begin + induction b using quotient_add_group.induction_on', + dsimp, + rw [quotient_add_group.eq_iff_sub_mem, to_Ioc_mod_sub_self], + apply add_subgroup.zsmul_mem_zmultiples, + end } + +@[simp] +lemma quotient_add_group.equiv_Ioc_mod_coe (a b : α) : + quotient_add_group.equiv_Ioc_mod hp a ↑b = ⟨to_Ioc_mod hp a b, to_Ioc_mod_mem_Ioc hp a _⟩ := +rfl + +@[simp] +lemma quotient_add_group.equiv_Ioc_mod_zero (a : α) : + quotient_add_group.equiv_Ioc_mod hp a 0 = ⟨to_Ioc_mod hp a 0, to_Ioc_mod_mem_Ioc hp a _⟩ := +rfl + +/-! +### The circular order structure on `α ⧸ add_subgroup.zmultiples p` +-/ + +section circular + +private lemma to_Ixx_mod_iff (x₁ x₂ x₃ : α) : + to_Ico_mod hp x₁ x₂ ≤ to_Ioc_mod hp x₁ x₃ ↔ + to_Ico_mod hp 0 (x₂ - x₁) + to_Ico_mod hp 0 (x₁ - x₃) ≤ p := +by rw [to_Ico_mod_eq_sub, to_Ioc_mod_eq_sub _ x₁, add_le_add_iff_right, ←neg_sub x₁ x₃, + to_Ioc_mod_neg, neg_zero, le_sub_iff_add_le] + +private lemma to_Ixx_mod_cyclic_left {x₁ x₂ x₃ : α} + (h : to_Ico_mod hp x₁ x₂ ≤ to_Ioc_mod hp x₁ x₃) : + to_Ico_mod hp x₂ x₃ ≤ to_Ioc_mod hp x₂ x₁ := +begin + let x₂' := to_Ico_mod hp x₁ x₂, + let x₃' := to_Ico_mod hp x₂' x₃, + have h : x₂' ≤ to_Ioc_mod hp x₁ x₃' := by simpa, + have h₂₁ : x₂' < x₁ + p := to_Ico_mod_lt_right _ _ _, + have h₃₂ : x₃' - p < x₂' := sub_lt_iff_lt_add.2 (to_Ico_mod_lt_right _ _ _), + + suffices hequiv : x₃' ≤ to_Ioc_mod hp x₂' x₁, + { obtain ⟨z, hd⟩ : ∃ (z : ℤ), x₂ = x₂' + z • p := ((to_Ico_mod_eq_iff hp).1 rfl).2, + simpa [hd] }, + + cases le_or_lt x₃' (x₁ + p) with h₃₁ h₁₃, + { suffices hIoc₂₁ : to_Ioc_mod hp x₂' x₁ = x₁ + p, + { exact hIoc₂₁.symm.trans_ge h₃₁ }, + apply (to_Ioc_mod_eq_iff hp).2, + exact ⟨⟨h₂₁, by simp [left_le_to_Ico_mod]⟩, -1, by simp⟩ }, + + have hIoc₁₃ : to_Ioc_mod hp x₁ x₃' = x₃' - p, + { apply (to_Ioc_mod_eq_iff hp).2, + exact ⟨⟨lt_sub_iff_add_lt.2 h₁₃, le_of_lt (h₃₂.trans h₂₁)⟩, 1, by simp⟩ }, + have not_h₃₂ := (h.trans hIoc₁₃.le).not_lt, + contradiction +end + +private lemma to_Ixx_mod_antisymm (h₁₂₃ : to_Ico_mod hp a b ≤ to_Ioc_mod hp a c) + (h₁₃₂ : to_Ico_mod hp a c ≤ to_Ioc_mod hp a b) : + b ≡ a [PMOD p] ∨ c ≡ b [PMOD p] ∨ a ≡ c [PMOD p] := +begin + by_contra' h, + rw modeq_comm at h, + rw ←(not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod hp).mp h.2.2 at h₁₂₃, + rw ←(not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod hp).mp h.1 at h₁₃₂, + exact h.2.1 ((to_Ico_mod_inj _).1 $ h₁₃₂.antisymm h₁₂₃), +end + +private lemma to_Ixx_mod_total' (a b c : α) : + to_Ico_mod hp b a ≤ to_Ioc_mod hp b c ∨ to_Ico_mod hp b c ≤ to_Ioc_mod hp b a := +begin + /- an essential ingredient is the lemma sabing {a-b} + {b-a} = period if a ≠ b (and = 0 if a = b). + Thus if a ≠ b and b ≠ c then ({a-b} + {b-c}) + ({c-b} + {b-a}) = 2 * period, so one of + `{a-b} + {b-c}` and `{c-b} + {b-a}` must be `≤ period` -/ + have := congr_arg2 (+) + (to_Ico_mod_add_to_Ioc_mod_zero hp a b) (to_Ico_mod_add_to_Ioc_mod_zero hp c b), + rw [add_add_add_comm, add_comm (to_Ioc_mod _ _ _), add_add_add_comm, ←two_nsmul] at this, + replace := min_le_of_add_le_two_nsmul this.le, + rw min_le_iff at this, + rw [to_Ixx_mod_iff, to_Ixx_mod_iff], + refine this.imp (le_trans $ add_le_add_left _ _) (le_trans $ add_le_add_left _ _), + { apply to_Ico_mod_le_to_Ioc_mod }, + { apply to_Ico_mod_le_to_Ioc_mod } +end + +private lemma to_Ixx_mod_total (a b c : α) : + to_Ico_mod hp a b ≤ to_Ioc_mod hp a c ∨ to_Ico_mod hp c b ≤ to_Ioc_mod hp c a := +(to_Ixx_mod_total' _ _ _ _).imp_right $ to_Ixx_mod_cyclic_left _ + +private lemma to_Ixx_mod_trans {x₁ x₂ x₃ x₄ : α} + (h₁₂₃ : to_Ico_mod hp x₁ x₂ ≤ to_Ioc_mod hp x₁ x₃ + ∧ ¬to_Ico_mod hp x₃ x₂ ≤ to_Ioc_mod hp x₃ x₁) + (h₂₃₄ : to_Ico_mod hp x₂ x₄ ≤ to_Ioc_mod hp x₂ x₃ + ∧ ¬to_Ico_mod hp x₃ x₄ ≤ to_Ioc_mod hp x₃ x₂) : + to_Ico_mod hp x₁ x₄ ≤ to_Ioc_mod hp x₁ x₃ + ∧ ¬to_Ico_mod hp x₃ x₄ ≤ to_Ioc_mod hp x₃ x₁ := +begin + split, + { suffices h : ¬x₃ ≡ x₂ [PMOD p], + { have h₁₂₃' := to_Ixx_mod_cyclic_left _ (to_Ixx_mod_cyclic_left _ h₁₂₃.1), + have h₂₃₄' := to_Ixx_mod_cyclic_left _ (to_Ixx_mod_cyclic_left _ h₂₃₄.1), + rw [(not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod hp).1 h] at h₂₃₄', + exact to_Ixx_mod_cyclic_left _ (h₁₂₃'.trans h₂₃₄') }, + by_contra, + rw [(modeq_iff_to_Ico_mod_eq_left hp).1 h] at h₁₂₃, + exact h₁₂₃.2 (left_lt_to_Ioc_mod _ _ _).le }, + { rw [not_le] at h₁₂₃ h₂₃₄ ⊢, + exact (h₁₂₃.2.trans_le (to_Ico_mod_le_to_Ioc_mod _ x₃ x₂)).trans h₂₃₄.2 }, +end + +namespace quotient_add_group +variables [hp' : fact (0 < p)] +include hp' + +instance : has_btw (α ⧸ add_subgroup.zmultiples p) := +{ btw := λ x₁ x₂ x₃, (equiv_Ico_mod hp'.out 0 (x₂ - x₁) : α) ≤ equiv_Ioc_mod hp'.out 0 (x₃ - x₁) } + +lemma btw_coe_iff' {x₁ x₂ x₃ : α} : + has_btw.btw (x₁ : α ⧸ add_subgroup.zmultiples p) x₂ x₃ ↔ + to_Ico_mod hp'.out 0 (x₂ - x₁) ≤ to_Ioc_mod hp'.out 0 (x₃ - x₁) := +iff.rfl + +-- maybe harder to use than the primed one? +lemma btw_coe_iff {x₁ x₂ x₃ : α} : + has_btw.btw (x₁ : α ⧸ add_subgroup.zmultiples p) x₂ x₃ ↔ + to_Ico_mod hp'.out x₁ x₂ ≤ to_Ioc_mod hp'.out x₁ x₃ := +by rw [btw_coe_iff', to_Ioc_mod_sub_eq_sub, to_Ico_mod_sub_eq_sub, zero_add, sub_le_sub_iff_right] + +instance circular_preorder : circular_preorder (α ⧸ add_subgroup.zmultiples p) := +{ btw_refl := λ x, show _ ≤ _, by simp [sub_self, hp'.out.le], + btw_cyclic_left := λ x₁ x₂ x₃ h, begin + induction x₁ using quotient_add_group.induction_on', + induction x₂ using quotient_add_group.induction_on', + induction x₃ using quotient_add_group.induction_on', + simp_rw [btw_coe_iff] at h ⊢, + apply to_Ixx_mod_cyclic_left _ h, + end, + sbtw := _, + sbtw_iff_btw_not_btw := λ _ _ _, iff.rfl, + sbtw_trans_left := λ x₁ x₂ x₃ x₄ (h₁₂₃ : _ ∧ _) (h₂₃₄ : _ ∧ _), show _ ∧ _, begin + induction x₁ using quotient_add_group.induction_on', + induction x₂ using quotient_add_group.induction_on', + induction x₃ using quotient_add_group.induction_on', + induction x₄ using quotient_add_group.induction_on', + simp_rw [btw_coe_iff] at h₁₂₃ h₂₃₄ ⊢, + apply to_Ixx_mod_trans _ h₁₂₃ h₂₃₄, + end } + +instance circular_order : circular_order (α ⧸ add_subgroup.zmultiples p) := +{ btw_antisymm := λ x₁ x₂ x₃ h₁₂₃ h₃₂₁, begin + induction x₁ using quotient_add_group.induction_on', + induction x₂ using quotient_add_group.induction_on', + induction x₃ using quotient_add_group.induction_on', + rw btw_cyclic at h₃₂₁, + simp_rw [btw_coe_iff] at h₁₂₃ h₃₂₁, + simp_rw ←modeq_iff_eq_mod_zmultiples, + exact to_Ixx_mod_antisymm _ h₁₂₃ h₃₂₁, + end, + btw_total := λ x₁ x₂ x₃, begin + induction x₁ using quotient_add_group.induction_on', + induction x₂ using quotient_add_group.induction_on', + induction x₃ using quotient_add_group.induction_on', + simp_rw [btw_coe_iff] at ⊢, + apply to_Ixx_mod_total, + end, + ..quotient_add_group.circular_preorder } + +end quotient_add_group + +end circular + +end linear_ordered_add_comm_group + +/-! +### Connections to `int.floor` and `int.fract` +-/ + +section linear_ordered_field + +variables {α : Type*} [linear_ordered_field α] [floor_ring α] {p : α} (hp : 0 < p) + +lemma to_Ico_div_eq_floor (a b : α) : to_Ico_div hp a b = ⌊(b - a) / p⌋ := +begin + refine to_Ico_div_eq_of_sub_zsmul_mem_Ico hp _, + rw [set.mem_Ico, zsmul_eq_mul, ←sub_nonneg, add_comm, sub_right_comm, ←sub_lt_iff_lt_add, + sub_right_comm _ _ a], + exact ⟨int.sub_floor_div_mul_nonneg _ hp, int.sub_floor_div_mul_lt _ hp⟩, +end + +lemma to_Ioc_div_eq_neg_floor (a b : α) : to_Ioc_div hp a b = -⌊(a + p - b) / p⌋ := +begin + refine to_Ioc_div_eq_of_sub_zsmul_mem_Ioc hp _, + rw [set.mem_Ioc, zsmul_eq_mul, int.cast_neg, neg_mul, sub_neg_eq_add, ←sub_nonneg, + sub_add_eq_sub_sub], + refine ⟨_, int.sub_floor_div_mul_nonneg _ hp⟩, + rw [←add_lt_add_iff_right p, add_assoc, add_comm b, ←sub_lt_iff_lt_add, add_comm (_ * _), + ←sub_lt_iff_lt_add], + exact int.sub_floor_div_mul_lt _ hp +end + +lemma to_Ico_div_zero_one (b : α) : to_Ico_div (zero_lt_one' α) 0 b = ⌊b⌋ := +by simp [to_Ico_div_eq_floor] + +lemma to_Ico_mod_eq_add_fract_mul (a b : α) : to_Ico_mod hp a b = a + int.fract ((b - a) / p) * p := +begin + rw [to_Ico_mod, to_Ico_div_eq_floor, int.fract], + field_simp [hp.ne.symm], + ring +end + +lemma to_Ico_mod_eq_fract_mul (b : α) : to_Ico_mod hp 0 b = int.fract (b / p) * p := +by simp [to_Ico_mod_eq_add_fract_mul] + +lemma to_Ioc_mod_eq_sub_fract_mul (a b : α) : + to_Ioc_mod hp a b = a + p - int.fract ((a + p - b) / p) * p := +begin + rw [to_Ioc_mod, to_Ioc_div_eq_neg_floor, int.fract], + field_simp [hp.ne.symm], + ring +end + +lemma to_Ico_mod_zero_one (b : α) : to_Ico_mod (zero_lt_one' α) 0 b = int.fract b := +by simp [to_Ico_mod_eq_add_fract_mul] + +end linear_ordered_field + +/-! ### Lemmas about unions of translates of intervals -/ +section union + +open set int + +section linear_ordered_add_comm_group + +variables {α : Type*} [linear_ordered_add_comm_group α] [archimedean α] {p : α} (hp : 0 < p) (a : α) +include hp + +lemma Union_Ioc_add_zsmul : (⋃ (n : ℤ), Ioc (a + n • p) (a + (n + 1) • p)) = univ := +begin + refine eq_univ_iff_forall.mpr (λ b, mem_Union.mpr _), + rcases sub_to_Ioc_div_zsmul_mem_Ioc hp a b with ⟨hl, hr⟩, + refine ⟨to_Ioc_div hp a b, ⟨lt_sub_iff_add_lt.mp hl, _⟩⟩, + rw [add_smul, one_smul, ←add_assoc], + convert sub_le_iff_le_add.mp hr using 1, abel, +end + +lemma Union_Ico_add_zsmul : (⋃ (n : ℤ), Ico (a + n • p) (a + (n + 1) • p)) = univ := +begin + refine eq_univ_iff_forall.mpr (λ b, mem_Union.mpr _), + rcases sub_to_Ico_div_zsmul_mem_Ico hp a b with ⟨hl, hr⟩, + refine ⟨to_Ico_div hp a b, ⟨le_sub_iff_add_le.mp hl, _⟩⟩, + rw [add_smul, one_smul, ←add_assoc], + convert sub_lt_iff_lt_add.mp hr using 1, abel, +end + +lemma Union_Icc_add_zsmul : (⋃ (n : ℤ), Icc (a + n • p) (a + (n + 1) • p)) = univ := +by simpa only [Union_Ioc_add_zsmul hp a, univ_subset_iff] using + Union_mono (λ n : ℤ, (Ioc_subset_Icc_self : Ioc (a + n • p) (a + (n + 1) • p) ⊆ Icc _ _)) + +lemma Union_Ioc_zsmul : (⋃ (n : ℤ), Ioc (n • p) ((n + 1) • p)) = univ := +by simpa only [zero_add] using Union_Ioc_add_zsmul hp 0 + +lemma Union_Ico_zsmul : (⋃ (n : ℤ), Ico (n • p) ((n + 1) • p)) = univ := +by simpa only [zero_add] using Union_Ico_add_zsmul hp 0 + +lemma Union_Icc_zsmul : (⋃ (n : ℤ), Icc (n • p) ((n + 1) • p)) = univ := +by simpa only [zero_add] using Union_Icc_add_zsmul hp 0 + +end linear_ordered_add_comm_group + +section linear_ordered_ring + +variables {α : Type*} [linear_ordered_ring α] [archimedean α] (a : α) + +lemma Union_Ioc_add_int_cast : (⋃ (n : ℤ), Ioc (a + n) (a + n + 1)) = set.univ := +by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc] + using Union_Ioc_add_zsmul zero_lt_one a + +lemma Union_Ico_add_int_cast : (⋃ (n : ℤ), Ico (a + n) (a + n + 1)) = set.univ := +by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc] + using Union_Ico_add_zsmul zero_lt_one a + +lemma Union_Icc_add_int_cast : (⋃ (n : ℤ), Icc (a + n) (a + n + 1)) = set.univ := +by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc] + using Union_Icc_add_zsmul zero_lt_one a + +variables (α) + +lemma Union_Ioc_int_cast : (⋃ (n : ℤ), Ioc (n : α) (n + 1)) = set.univ := +by simpa only [zero_add] using Union_Ioc_add_int_cast (0 : α) + +lemma Union_Ico_int_cast : (⋃ (n : ℤ), Ico (n : α) (n + 1)) = set.univ := +by simpa only [zero_add] using Union_Ico_add_int_cast (0 : α) + +lemma Union_Icc_int_cast : (⋃ (n : ℤ), Icc (n : α) (n + 1)) = set.univ := +by simpa only [zero_add] using Union_Icc_add_int_cast (0 : α) + +end linear_ordered_ring + +end union diff --git a/src/algebra/order/upper_lower.lean b/src/algebra/order/upper_lower.lean new file mode 100644 index 0000000000000..d52a2b05f96bc --- /dev/null +++ b/src/algebra/order/upper_lower.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.order.group.defs +import data.set.pointwise.smul +import order.upper_lower.basic + +/-! +# Algebraic operations on upper/lower sets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Upper/lower sets are preserved under pointwise algebraic operations in ordered groups. +-/ + +open function set +open_locale pointwise + +section ordered_comm_monoid +variables {α : Type*} [ordered_comm_monoid α] {s : set α} {x : α} + +@[to_additive] lemma is_upper_set.smul_subset (hs : is_upper_set s) (hx : 1 ≤ x) : x • s ⊆ s := +smul_set_subset_iff.2 $ λ y, hs $ le_mul_of_one_le_left' hx + +@[to_additive] lemma is_lower_set.smul_subset (hs : is_lower_set s) (hx : x ≤ 1) : x • s ⊆ s := +smul_set_subset_iff.2 $ λ y, hs $ mul_le_of_le_one_left' hx + +end ordered_comm_monoid + +section ordered_comm_group +variables {α : Type*} [ordered_comm_group α] {s t : set α} {a : α} + +@[to_additive] lemma is_upper_set.smul (hs : is_upper_set s) : is_upper_set (a • s) := +hs.image $ order_iso.mul_left _ + +@[to_additive] lemma is_lower_set.smul (hs : is_lower_set s) : is_lower_set (a • s) := +hs.image $ order_iso.mul_left _ + +@[to_additive] lemma set.ord_connected.smul (hs : s.ord_connected) : (a • s).ord_connected := +begin + rw [←hs.upper_closure_inter_lower_closure, smul_set_inter], + exact (upper_closure _).upper.smul.ord_connected.inter (lower_closure _).lower.smul.ord_connected, +end + +@[to_additive] lemma is_upper_set.mul_left (ht : is_upper_set t) : is_upper_set (s * t) := +by { rw [←smul_eq_mul, ←bUnion_smul_set], exact is_upper_set_Union₂ (λ x hx, ht.smul) } + +@[to_additive] lemma is_upper_set.mul_right (hs : is_upper_set s) : is_upper_set (s * t) := +by { rw mul_comm, exact hs.mul_left } + +@[to_additive] lemma is_lower_set.mul_left (ht : is_lower_set t) : is_lower_set (s * t) := +ht.to_dual.mul_left + +@[to_additive] lemma is_lower_set.mul_right (hs : is_lower_set s) : is_lower_set (s * t) := +hs.to_dual.mul_right + +@[to_additive] lemma is_upper_set.inv (hs : is_upper_set s) : is_lower_set s⁻¹ := +λ x y h, hs $ inv_le_inv' h + +@[to_additive] lemma is_lower_set.inv (hs : is_lower_set s) : is_upper_set s⁻¹ := +λ x y h, hs $ inv_le_inv' h + +@[to_additive] lemma is_upper_set.div_left (ht : is_upper_set t) : is_lower_set (s / t) := +by { rw div_eq_mul_inv, exact ht.inv.mul_left } + +@[to_additive] lemma is_upper_set.div_right (hs : is_upper_set s) : is_upper_set (s / t) := +by { rw div_eq_mul_inv, exact hs.mul_right } + +@[to_additive] lemma is_lower_set.div_left (ht : is_lower_set t) : is_upper_set (s / t) := +ht.to_dual.div_left + +@[to_additive] lemma is_lower_set.div_right (hs : is_lower_set s) : is_lower_set (s / t) := +hs.to_dual.div_right + +namespace upper_set + +@[to_additive] instance : has_one (upper_set α) := ⟨Ici 1⟩ +@[to_additive] instance : has_mul (upper_set α) := ⟨λ s t, ⟨image2 (*) s t, s.2.mul_right⟩⟩ +@[to_additive] instance : has_div (upper_set α) := ⟨λ s t, ⟨image2 (/) s t, s.2.div_right⟩⟩ +@[to_additive] instance : has_smul α (upper_set α) := ⟨λ a s, ⟨(•) a '' s, s.2.smul⟩⟩ + +@[simp, norm_cast, to_additive] lemma coe_one : ((1 : upper_set α) : set α) = set.Ici 1 := rfl +@[simp, norm_cast, to_additive] +lemma coe_smul (a : α) (s : upper_set α) : (↑(a • s) : set α) = a • s := rfl +@[simp, norm_cast, to_additive] +lemma coe_mul (s t : upper_set α) : (↑(s * t) : set α) = s * t := rfl +@[simp, norm_cast, to_additive] +lemma coe_div (s t : upper_set α) : (↑(s / t) : set α) = s / t := rfl + +@[simp, to_additive] lemma Ici_one : Ici (1 : α) = 1 := rfl + +@[to_additive] instance : mul_action α (upper_set α) := set_like.coe_injective.mul_action _ coe_smul + +@[to_additive] +instance : comm_semigroup (upper_set α) := +{ mul := (*), + ..(set_like.coe_injective.comm_semigroup _ coe_mul : comm_semigroup (upper_set α)) } + +@[to_additive] +private lemma one_mul (s : upper_set α) : 1 * s = s := +set_like.coe_injective $ (subset_mul_right _ left_mem_Ici).antisymm' $ + by { rw [←smul_eq_mul, ←bUnion_smul_set], exact Union₂_subset (λ _, s.upper.smul_subset) } + +@[to_additive] instance : comm_monoid (upper_set α) := +{ one := 1, + one_mul := one_mul, + mul_one := λ s, by { rw mul_comm, exact one_mul _ }, + ..upper_set.comm_semigroup } + +end upper_set + +namespace lower_set + +@[to_additive] instance : has_one (lower_set α) := ⟨Iic 1⟩ +@[to_additive] instance : has_mul (lower_set α) := ⟨λ s t, ⟨image2 (*) s t, s.2.mul_right⟩⟩ +@[to_additive] instance : has_div (lower_set α) := ⟨λ s t, ⟨image2 (/) s t, s.2.div_right⟩⟩ +@[to_additive] instance : has_smul α (lower_set α) := ⟨λ a s, ⟨(•) a '' s, s.2.smul⟩⟩ + +@[simp, norm_cast, to_additive] +lemma coe_smul (a : α) (s : lower_set α) : (↑(a • s) : set α) = a • s := rfl +@[simp, norm_cast, to_additive] +lemma coe_mul (s t : lower_set α) : (↑(s * t) : set α) = s * t := rfl +@[simp, norm_cast, to_additive] +lemma coe_div (s t : lower_set α) : (↑(s / t) : set α) = s / t := rfl + +@[simp, to_additive] lemma Iic_one : Iic (1 : α) = 1 := rfl + +@[to_additive] instance : mul_action α (lower_set α) := set_like.coe_injective.mul_action _ coe_smul + +@[to_additive] +instance : comm_semigroup (lower_set α) := +{ mul := (*), + ..(set_like.coe_injective.comm_semigroup _ coe_mul : comm_semigroup (lower_set α)) } + +@[to_additive] +private lemma one_mul (s : lower_set α) : 1 * s = s := +set_like.coe_injective $ (subset_mul_right _ right_mem_Iic).antisymm' $ + by { rw [←smul_eq_mul, ←bUnion_smul_set], exact Union₂_subset (λ _, s.lower.smul_subset) } + +@[to_additive] instance : comm_monoid (lower_set α) := +{ one := 1, + one_mul := one_mul, + mul_one := λ s, by { rw mul_comm, exact one_mul _ }, + ..lower_set.comm_semigroup } + +end lower_set + +variables (a s t) + +@[simp, to_additive] lemma upper_closure_one : upper_closure (1 : set α) = 1 := +upper_closure_singleton _ + +@[simp, to_additive] lemma lower_closure_one : lower_closure (1 : set α) = 1 := +lower_closure_singleton _ + +@[simp, to_additive] lemma upper_closure_smul : upper_closure (a • s) = a • upper_closure s := +upper_closure_image $ order_iso.mul_left a + +@[simp, to_additive] lemma lower_closure_smul : lower_closure (a • s) = a • lower_closure s := +lower_closure_image $ order_iso.mul_left a + +@[to_additive] lemma mul_upper_closure : s * upper_closure t = upper_closure (s * t) := +by simp_rw [←smul_eq_mul, ←bUnion_smul_set, upper_closure_Union, upper_closure_smul, + upper_set.coe_infi₂, upper_set.coe_smul] + +@[to_additive] lemma mul_lower_closure : s * lower_closure t = lower_closure (s * t) := +by simp_rw [←smul_eq_mul, ←bUnion_smul_set, lower_closure_Union, lower_closure_smul, + lower_set.coe_supr₂, lower_set.coe_smul] + +@[to_additive] lemma upper_closure_mul : ↑(upper_closure s) * t = upper_closure (s * t) := +by { simp_rw mul_comm _ t, exact mul_upper_closure _ _ } + +@[to_additive] lemma lower_closure_mul : ↑(lower_closure s) * t = lower_closure (s * t) := +by { simp_rw mul_comm _ t, exact mul_lower_closure _ _ } + +@[simp, to_additive] +lemma upper_closure_mul_distrib : upper_closure (s * t) = upper_closure s * upper_closure t := +set_like.coe_injective $ + by rw [upper_set.coe_mul, mul_upper_closure, upper_closure_mul, upper_set.upper_closure] + +@[simp, to_additive] +lemma lower_closure_mul_distrib : lower_closure (s * t) = lower_closure s * lower_closure t := +set_like.coe_injective $ + by rw [lower_set.coe_mul, mul_lower_closure, lower_closure_mul, lower_set.lower_closure] + +end ordered_comm_group diff --git a/src/algebra/order/with_zero.lean b/src/algebra/order/with_zero.lean index 33eba665df98d..41b268e6c30e2 100644 --- a/src/algebra/order/with_zero.lean +++ b/src/algebra/order/with_zero.lean @@ -3,13 +3,20 @@ Copyright (c) 2020 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau, Johan Commelin, Patrick Massot -/ - -import algebra.order.group -import tactic.abel +import algebra.hom.equiv.units.group_with_zero +import algebra.group_with_zero.inj_surj +import algebra.order.group.units +import algebra.order.monoid.basic +import algebra.order.monoid.with_zero.defs +import algebra.order.group.instances +import algebra.order.monoid.type_tags /-! # Linearly ordered commutative groups and monoids with a zero element adjoined +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file sets up a special class of linearly ordered commutative monoids that show up as the target of so-called “valuations” in algebraic number theory. @@ -27,6 +34,7 @@ in another file. However, the lemmas about it are stated here. set_option old_structure_cmd true /-- A linearly ordered commutative group with a zero element. -/ +@[protect_proj, ancestor linear_ordered_comm_monoid_with_zero comm_group_with_zero] class linear_ordered_comm_group_with_zero (α : Type*) extends linear_ordered_comm_monoid_with_zero α, comm_group_with_zero α @@ -50,98 +58,6 @@ instance [linear_ordered_add_comm_group_with_top α] : ..multiplicative.linear_ordered_comm_monoid_with_zero, ..multiplicative.nontrivial } -section monoid -variable [monoid α] - -section preorder -variable [preorder α] - -section left -variable [covariant_class α α (*) (≤)] - -lemma left.one_le_pow_of_le : ∀ {n : ℕ} {x : α}, 1 ≤ x → 1 ≤ x^n -| 0 x _ := (pow_zero x).symm.le -| (n + 1) x H := calc 1 ≤ x : H - ... = x * 1 : (mul_one x).symm - ... ≤ x * x ^ n : mul_le_mul_left' (left.one_le_pow_of_le H) x - ... = x ^ n.succ : (pow_succ x n).symm - -end left - -section right -variable [covariant_class α α (function.swap (*)) (≤)] - -lemma right.one_le_pow_of_le {x : α} (H : 1 ≤ x) : - ∀ {n : ℕ}, 1 ≤ x^n -| 0 := (pow_zero _).symm.le -| (n + 1) := calc 1 ≤ x : H - ... = 1 * x : (one_mul x).symm - ... ≤ x ^ n * x : mul_le_mul_right' right.one_le_pow_of_le x - ... = x ^ n.succ : (pow_succ' x n).symm - -lemma right.pow_le_one_of_le {x : α} (H : x ≤ 1) : - ∀ {n : ℕ}, x^n ≤ 1 -| 0 := (pow_zero _).le -| (n + 1) := calc x ^ n.succ = x ^ n * x : pow_succ' x n - ... ≤ 1 * x : mul_le_mul_right' right.pow_le_one_of_le x - ... = x : one_mul x - ... ≤ 1 : H - -end right - -lemma pow_le_pow_of_le [covariant_class α α (*) (≤)] [covariant_class α α (function.swap (*)) (≤)] - {x y : α} (H : x ≤ y) : - ∀ {n : ℕ} , x^n ≤ y^n -| 0 := (pow_zero _).le.trans (pow_zero _).symm.le -| (n + 1) := calc x ^ n.succ = x * x ^ n : pow_succ x n - ... ≤ y * x ^ n : mul_le_mul_right' H (x ^ n) - ... ≤ y * y ^ n : mul_le_mul_left' pow_le_pow_of_le y - ... = y ^ n.succ : (pow_succ y n).symm - -lemma left.pow_lt_one_of_lt [covariant_class α α (*) (<)] {n : ℕ} {x : α} (n0 : 0 < n) (H : x < 1) : - x^n < 1 := -begin - refine nat.le_induction ((pow_one _).le.trans_lt H) (λ n n1 hn, _) _ (nat.succ_le_iff.mpr n0), - calc x ^ (n + 1) = x * x ^ n : pow_succ x n - ... < x * 1 : mul_lt_mul_left' hn x - ... = x : mul_one x - ... < 1 : H -end - -lemma left.pow_lt_one_iff {α: Type*} [monoid α] [linear_order α] - [covariant_class α α (*) (<)] {n : ℕ} {x : α} (n0 : 0 < n) : - x^n < 1 ↔ x < 1 := -⟨λ H, not_le.mp (λ k, not_le.mpr H (by - { haveI := has_mul.to_covariant_class_left α, - exact left.one_le_pow_of_le k})), left.pow_lt_one_of_lt n0⟩ - -lemma right.pow_lt_one_of_lt [covariant_class α α (function.swap (*)) (<)] {n : ℕ} {x : α} - (n0 : 0 < n) (H : x < 1) : - x^n < 1 := -begin - refine nat.le_induction ((pow_one _).le.trans_lt H) (λ n n1 hn, _) _ (nat.succ_le_iff.mpr n0), - calc x ^ (n + 1) = x ^ n * x : pow_succ' x n - ... < 1 * x : mul_lt_mul_right' hn x - ... = x : one_mul x - ... < 1 : H -end - -lemma right.pow_lt_one_iff {α: Type*} [monoid α] [linear_order α] - [covariant_class α α (function.swap (*)) (<)] {n : ℕ} {x : α} (n0 : 0 < n) : - x^n < 1 ↔ x < 1 := -⟨λ H, not_le.mp (λ k, not_le.mpr H (by - { haveI := has_mul.to_covariant_class_right α, - exact right.one_le_pow_of_le k})), right.pow_lt_one_of_lt n0⟩ - -end preorder - -section left_right -variables [linear_order α] - [covariant_class α α (*) (≤)] [covariant_class α α (function.swap (*)) (≤)] - -end left_right - -end monoid instance [linear_ordered_comm_monoid α] : linear_ordered_comm_monoid_with_zero (with_zero α) := { mul_le_mul_left := λ x y, mul_le_mul_left', @@ -165,21 +81,19 @@ The following facts are true more generally in a (linearly) ordered commutative See note [reducible non-instances]. -/ @[reducible] def function.injective.linear_ordered_comm_monoid_with_zero {β : Type*} - [has_zero β] [has_one β] [has_mul β] [has_pow β ℕ] + [has_zero β] [has_one β] [has_mul β] [has_pow β ℕ] [has_sup β] [has_inf β] (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1) - (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : + (mul : ∀ x y, f (x * y) = f x * f y) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y)) (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) : linear_ordered_comm_monoid_with_zero β := { zero_le_one := show f 0 ≤ f 1, by simp only [zero, one, linear_ordered_comm_monoid_with_zero.zero_le_one], - ..linear_order.lift f hf, + ..linear_order.lift f hf hsup hinf, ..hf.ordered_comm_monoid f one mul npow, ..hf.comm_monoid_with_zero f zero one mul npow } -lemma zero_le_one' : (0 : α) ≤ 1 := -linear_ordered_comm_monoid_with_zero.zero_le_one - @[simp] lemma zero_le' : 0 ≤ a := -by simpa only [mul_zero, mul_one] using mul_le_mul_left' (@zero_le_one' α _) a +by simpa only [mul_zero, mul_one] using mul_le_mul_left' zero_le_one a @[simp] lemma not_lt_zero' : ¬a < 0 := not_lt_of_le zero_le' @@ -193,9 +107,6 @@ lemma zero_lt_iff : 0 < a ↔ a ≠ 0 := lemma ne_zero_of_lt (h : b < a) : a ≠ 0 := λ h1, not_lt_zero' $ show b < 0, from h1 ▸ h -lemma pow_pos_iff [no_zero_divisors α] {n : ℕ} (hn : 0 < n) : 0 < a ^ n ↔ 0 < a := -by simp_rw [zero_lt_iff, pow_ne_zero_iff hn] - instance : linear_ordered_add_comm_monoid_with_top (additive αᵒᵈ) := { top := (0 : α), top_add' := λ a, (zero_mul a : (0 : α) * a = 0), @@ -207,8 +118,13 @@ end linear_ordered_comm_monoid variables [linear_ordered_comm_group_with_zero α] -lemma zero_lt_one₀ : (0 : α) < 1 := -lt_of_le_of_ne zero_le_one' zero_ne_one +-- TODO: Do we really need the following two? + +/-- Alias of `mul_le_one'` for unification. -/ +lemma mul_le_one₀ (ha : a ≤ 1) (hb : b ≤ 1) : a * b ≤ 1 := mul_le_one' ha hb + +/-- Alias of `one_le_mul'` for unification. -/ +lemma one_le_mul₀ (ha : 1 ≤ a) (hb : 1 ≤ b) : 1 ≤ a * b := one_le_mul ha hb lemma le_of_le_mul_right (h : c ≠ 0) (hab : a * c ≤ b * c) : a ≤ b := by simpa only [mul_inv_cancel_right₀ h] using (mul_le_mul_right' hab c⁻¹) @@ -223,6 +139,10 @@ begin { exact le_of_le_mul_right h (by simpa [h] using hab), }, end +lemma inv_le_one₀ (ha : a ≠ 0) : a⁻¹ ≤ 1 ↔ 1 ≤ a := @inv_le_one' _ _ _ _ $ units.mk0 a ha + +lemma one_le_inv₀ (ha : a ≠ 0) : 1 ≤ a⁻¹ ↔ a ≤ 1 := @one_le_inv' _ _ _ _ $ units.mk0 a ha + lemma le_mul_inv_iff₀ (hc : c ≠ 0) : a ≤ b * c⁻¹ ↔ a * c ≤ b := ⟨λ h, inv_inv c ▸ mul_inv_le_of_le_mul h, le_mul_inv_of_mul_le hc⟩ @@ -259,13 +179,6 @@ by { rw mul_comm at *, exact mul_inv_lt_of_lt_mul₀ h } lemma mul_lt_right₀ (c : α) (h : a < b) (hc : c ≠ 0) : a * c < b * c := by { contrapose! h, exact le_of_le_mul_right hc h } -lemma pow_lt_pow_succ {x : α} {n : ℕ} (hx : 1 < x) : x ^ n < x ^ n.succ := -by { rw [← one_mul (x ^ n), pow_succ], -exact mul_lt_right₀ _ hx (pow_ne_zero _ $ ne_of_gt (lt_trans zero_lt_one₀ hx)) } - -lemma pow_lt_pow₀ {x : α} {m n : ℕ} (hx : 1 < x) (hmn : m < n) : x ^ m < x ^ n := -by { induction hmn with n hmn ih, exacts [pow_lt_pow_succ hx, lt_trans ih (pow_lt_pow_succ hx)] } - lemma inv_lt_inv₀ (ha : a ≠ 0) (hb : b ≠ 0) : a⁻¹ < b⁻¹ ↔ b < a := show (units.mk0 a ha)⁻¹ < (units.mk0 b hb)⁻¹ ↔ (units.mk0 b hb) < (units.mk0 a ha), from inv_lt_inv_iff @@ -285,42 +198,46 @@ end lemma mul_le_mul_right₀ (hc : c ≠ 0) : a * c ≤ b * c ↔ a ≤ b := ⟨le_of_le_mul_right hc, λ hab, mul_le_mul_right' hab _⟩ -lemma div_le_div_right₀ (hc : c ≠ 0) : a/c ≤ b/c ↔ a ≤ b := +lemma mul_le_mul_left₀ (ha : a ≠ 0) : a * b ≤ a * c ↔ b ≤ c := +by {simp only [mul_comm a], exact mul_le_mul_right₀ ha } + +lemma div_le_div_right₀ (hc : c ≠ 0) : a / c ≤ b / c ↔ a ≤ b := by rw [div_eq_mul_inv, div_eq_mul_inv, mul_le_mul_right₀ (inv_ne_zero hc)] -lemma le_div_iff₀ (hc : c ≠ 0) : a ≤ b/c ↔ a*c ≤ b := +lemma div_le_div_left₀ (ha : a ≠ 0) (hb : b ≠ 0) (hc : c ≠ 0) : a / b ≤ a / c ↔ c ≤ b := +by simp only [div_eq_mul_inv, mul_le_mul_left₀ ha, inv_le_inv₀ hb hc] + +lemma le_div_iff₀ (hc : c ≠ 0) : a ≤ b / c ↔ a*c ≤ b := by rw [div_eq_mul_inv, le_mul_inv_iff₀ hc] -lemma div_le_iff₀ (hc : c ≠ 0) : a/c ≤ b ↔ a ≤ b*c := +lemma div_le_iff₀ (hc : c ≠ 0) : a / c ≤ b ↔ a ≤ b*c := by rw [div_eq_mul_inv, mul_inv_le_iff₀ hc] -instance : linear_ordered_add_comm_group_with_top (additive αᵒᵈ) := -{ neg_top := inv_zero, - add_neg_cancel := λ a ha, mul_inv_cancel ha, - ..additive.sub_neg_monoid, - ..additive.linear_ordered_add_comm_monoid_with_top, - ..additive.nontrivial } +/-- `equiv.mul_left₀` as an order_iso on a `linear_ordered_comm_group_with_zero.`. -namespace monoid_hom +Note that `order_iso.mul_left₀` refers to the `linear_ordered_field` version. -/ +@[simps apply to_equiv {simp_rhs := tt}] +def order_iso.mul_left₀' {a : α} (ha : a ≠ 0) : α ≃o α := +{ map_rel_iff' := λ x y, mul_le_mul_left₀ ha, ..equiv.mul_left₀ a ha } -variables {R : Type*} [ring R] (f : R →* α) +lemma order_iso.mul_left₀'_symm {a : α} (ha : a ≠ 0) : + (order_iso.mul_left₀' ha).symm = order_iso.mul_left₀' (inv_ne_zero ha) := +by { ext, refl } -theorem map_neg_one : f (-1) = 1 := -(pow_eq_one_iff (nat.succ_ne_zero 1)).1 $ - calc f (-1) ^ 2 = f (-1) * f(-1) : sq _ - ... = f ((-1) * - 1) : (f.map_mul _ _).symm - ... = f ( - - 1) : congr_arg _ (neg_one_mul _) - ... = f 1 : congr_arg _ (neg_neg _) - ... = 1 : map_one f +/-- `equiv.mul_right₀` as an order_iso on a `linear_ordered_comm_group_with_zero.`. -@[simp] lemma map_neg (x : R) : f (-x) = f x := -calc f (-x) = f (-1 * x) : congr_arg _ (neg_one_mul _).symm - ... = f (-1) * f x : map_mul _ _ _ - ... = 1 * f x : _root_.congr_arg (λ g, g * (f x)) (map_neg_one f) - ... = f x : one_mul _ +Note that `order_iso.mul_right₀` refers to the `linear_ordered_field` version. -/ +@[simps apply to_equiv {simp_rhs := tt}] +def order_iso.mul_right₀' {a : α} (ha : a ≠ 0) : α ≃o α := +{ map_rel_iff' := λ _ _, mul_le_mul_right₀ ha, ..equiv.mul_right₀ a ha } -lemma map_sub_swap (x y : R) : f (x - y) = f (y - x) := -calc f (x - y) = f (-(y - x)) : congr_arg _ (neg_sub _ _).symm - ... = _ : map_neg _ _ +lemma order_iso.mul_right₀'_symm {a : α} (ha : a ≠ 0) : + (order_iso.mul_right₀' ha).symm = order_iso.mul_right₀' (inv_ne_zero ha) := +by { ext, refl } -end monoid_hom +instance : linear_ordered_add_comm_group_with_top (additive αᵒᵈ) := +{ neg_top := inv_zero, + add_neg_cancel := λ a ha, mul_inv_cancel ha, + ..additive.sub_neg_monoid, + ..additive.linear_ordered_add_comm_monoid_with_top, + ..additive.nontrivial } diff --git a/src/algebra/order/zero_le_one.lean b/src/algebra/order/zero_le_one.lean new file mode 100644 index 0000000000000..08714be379a77 --- /dev/null +++ b/src/algebra/order/zero_le_one.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl +-/ +import order.basic +import algebra.ne_zero + +/-! +# Typeclass expressing `0 ≤ 1`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +open function + +/-- Typeclass for expressing that the `0` of a type is less or equal to its `1`. -/ +class zero_le_one_class (α : Type*) [has_zero α] [has_one α] [has_le α] := +(zero_le_one : (0 : α) ≤ 1) + +/-- `zero_le_one` with the type argument implicit. -/ +@[simp] lemma zero_le_one [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 := +zero_le_one_class.zero_le_one + +/-- `zero_le_one` with the type argument explicit. -/ +lemma zero_le_one' (α) [has_zero α] [has_one α] [has_le α] [zero_le_one_class α] : (0 : α) ≤ 1 := +zero_le_one + +section +variables [has_zero α] [has_one α] [partial_order α] [zero_le_one_class α] [ne_zero (1 : α)] + +/-- See `zero_lt_one'` for a version with the type explicit. -/ +@[simp] lemma zero_lt_one : (0 : α) < 1 := zero_le_one.lt_of_ne (ne_zero.ne' 1) + +variables (α) + +/-- See `zero_lt_one` for a version with the type implicit. -/ +lemma zero_lt_one' : (0 : α) < 1 := zero_lt_one + +end + +alias zero_lt_one ← one_pos diff --git a/src/algebra/parity.lean b/src/algebra/parity.lean index 0e2077bf429fc..d51bf886d687d 100644 --- a/src/algebra/parity.lean +++ b/src/algebra/parity.lean @@ -3,15 +3,13 @@ Copyright (c) 2022 Damiano Testa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Damiano Testa -/ - -import algebra.ring.basic -import algebra.algebra.basic -import algebra.group_power.basic -import algebra.field_power -import algebra.opposites +import algebra.group_power.lemmas /-! # Squares, even and odd elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves some general facts about squares, even and odd elements of semirings. In the implementation, we define `is_square` and we let `even` be the notion transported by @@ -37,18 +35,36 @@ Odd elements are not unified with a multiplicative notion. open mul_opposite variables {F α β R : Type*} -/-- An element `a` of a type `α` with multiplication satisfies `square a` if `a = r * r`, +section has_mul +variables [has_mul α] + +/-- An element `a` of a type `α` with multiplication satisfies `is_square a` if `a = r * r`, for some `r : α`. -/ @[to_additive "An element `a` of a type `α` with addition satisfies `even a` if `a = r + r`, for some `r : α`."] -def is_square [has_mul α] (a : α) : Prop := ∃ r, a = r * r +def is_square (a : α) : Prop := ∃ r, a = r * r + +@[simp, to_additive] lemma is_square_mul_self (m : α) : is_square (m * m) := ⟨m, rfl⟩ + +@[to_additive] lemma is_square_op_iff (a : α) : is_square (op a) ↔ is_square a := +⟨λ ⟨c, hc⟩, ⟨unop c, by rw [← unop_mul, ← hc, unop_op]⟩, λ ⟨c, hc⟩, by simp [hc]⟩ + +end has_mul @[simp, to_additive] -lemma is_square_mul_self [has_mul α] (m : α) : is_square (m * m) := ⟨m, rfl⟩ +lemma is_square_one [mul_one_class α] : is_square (1 : α) := ⟨1, (mul_one _).symm⟩ + +@[to_additive] +lemma is_square.map [mul_one_class α] [mul_one_class β] [monoid_hom_class F α β] {m : α} (f : F) : + is_square m → is_square (f m) := +by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp⟩ } + +section monoid +variables [monoid α] {n : ℕ} {a : α} @[to_additive even_iff_exists_two_nsmul] -lemma is_square_iff_exists_sq [monoid α] (m : α) : is_square m ↔ ∃ c, m = c ^ 2 := +lemma is_square_iff_exists_sq (m : α) : is_square m ↔ ∃ c, m = c ^ 2 := by simp [is_square, pow_two] alias is_square_iff_exists_sq ↔ is_square.exists_sq is_square_of_exists_sq @@ -59,55 +75,39 @@ attribute [to_additive even.exists_two_nsmul "Alias of the forwards direction of attribute [to_additive even_of_exists_two_nsmul "Alias of the backwards direction of `even_iff_exists_two_nsmul`."] is_square_of_exists_sq -@[simp, to_additive] -lemma is_square_one [mul_one_class α] : is_square (1 : α) := ⟨1, (mul_one _).symm⟩ - -@[to_additive] -lemma is_square.map [mul_one_class α] [mul_one_class β] [monoid_hom_class F α β] {m : α} (f : F) : - is_square m → is_square (f m) := -by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp⟩ } - -/-- Create a decidability instance for `is_square` on `fintype`s. -/ -instance is_square_decidable [fintype α] [has_mul α] [decidable_eq α] : - decidable_pred (is_square : α → Prop) := -λ a, fintype.decidable_exists_fintype +@[to_additive even.nsmul] lemma is_square.pow (n : ℕ) : is_square a → is_square (a ^ n) := +by { rintro ⟨a, rfl⟩, exact ⟨a ^ n, (commute.refl _).mul_pow _⟩ } -section monoid -variables [monoid α] +@[simp, to_additive even.nsmul'] +lemma even.is_square_pow : even n → ∀ a : α, is_square (a ^ n) := +by { rintro ⟨n, rfl⟩ a, exact ⟨a ^ n, pow_add _ _ _⟩ } @[simp, to_additive even_two_nsmul] lemma is_square_sq (a : α) : is_square (a ^ 2) := ⟨a, pow_two _⟩ -variables [has_distrib_neg α] {n : ℕ} +variables [has_distrib_neg α] lemma even.neg_pow : even n → ∀ a : α, (-a) ^ n = a ^ n := by { rintro ⟨c, rfl⟩ a, simp_rw [←two_mul, pow_mul, neg_sq] } lemma even.neg_one_pow (h : even n) : (-1 : α) ^ n = 1 := by rw [h.neg_pow, one_pow] -/-- `0` is always a square (in a monoid with zero). -/ -lemma is_square_zero (M : Type*) [monoid_with_zero M] : is_square (0 : M) := -by { use 0, simp only [mul_zero] } - end monoid -@[to_additive] -lemma is_square.mul_is_square [comm_monoid α] {m n : α} (hm : is_square m) (hn : is_square n) : - is_square (m * n) := -begin - rcases hm with ⟨m, rfl⟩, - rcases hn with ⟨n, rfl⟩, - refine ⟨m * n, mul_mul_mul_comm m m n n⟩, -end +@[to_additive] lemma is_square.mul [comm_semigroup α] {a b : α} : + is_square a → is_square b → is_square (a * b) := +by { rintro ⟨a, rfl⟩ ⟨b, rfl⟩, exact ⟨a * b, mul_mul_mul_comm _ _ _ _⟩ } -section group -variable [group α] +variables (α) -@[to_additive] -lemma is_square_op_iff (a : α) : is_square (op a) ↔ is_square a := -⟨λ ⟨c, hc⟩, ⟨unop c, by rw [← unop_mul, ← hc, unop_op]⟩, λ ⟨c, hc⟩, by simp [hc]⟩ +@[simp] lemma is_square_zero [mul_zero_class α] : is_square (0 : α) := ⟨0, (mul_zero _).symm⟩ -@[simp, to_additive] lemma is_square_inv (a : α) : is_square a⁻¹ ↔ is_square a := +variables {α} + +section division_monoid +variables [division_monoid α] {a : α} + +@[simp, to_additive] lemma is_square_inv : is_square a⁻¹ ↔ is_square a := begin refine ⟨λ h, _, λ h, _⟩, { rw [← is_square_op_iff, ← inv_inv a], @@ -115,19 +115,36 @@ begin { exact ((is_square_op_iff a).mpr h).map (mul_equiv.inv' α).symm } end -end group +alias is_square_inv ↔ _ is_square.inv + +attribute [to_additive] is_square.inv + +@[to_additive even.zsmul] lemma is_square.zpow (n : ℤ) : is_square a → is_square (a ^ n) := +by { rintro ⟨a, rfl⟩, exact ⟨a ^ n, (commute.refl _).mul_zpow _⟩ } + +variables [has_distrib_neg α] {n : ℤ} -section comm_group -variable [comm_group α] +lemma even.neg_zpow : even n → ∀ a : α, (-a) ^ n = a ^ n := +by { rintro ⟨c, rfl⟩ a, exact zpow_bit0_neg _ _ } + +lemma even.neg_one_zpow (h : even n) : (-1 : α) ^ n = 1 := by rw [h.neg_zpow, one_zpow] + +end division_monoid + +lemma even_abs [subtraction_monoid α] [linear_order α] {a : α} : even (|a|) ↔ even a := +by cases abs_choice a; simp only [h, even_neg] @[to_additive] -lemma is_square.div_is_square {m n : α} (hm : is_square m) (hn : is_square n) : is_square (m / n) := -by { rw div_eq_mul_inv, exact hm.mul_is_square ((is_square_inv n).mpr hn) } +lemma is_square.div [division_comm_monoid α] {a b : α} (ha : is_square a) (hb : is_square b) : + is_square (a / b) := +by { rw div_eq_mul_inv, exact ha.mul hb.inv } -end comm_group +@[simp, to_additive even.zsmul'] +lemma even.is_square_zpow [group α] {n : ℤ} : even n → ∀ a : α, is_square (a ^ n) := +by { rintro ⟨n, rfl⟩ a, exact ⟨a ^ n, zpow_add _ _ _⟩ } --- `odd.tsub_odd` requires `canonically_linear_ordered_semiring`, which we don't have -lemma even.tsub_even [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] +-- `odd.tsub` requires `canonically_linear_ordered_semiring`, which we don't have +lemma even.tsub [canonically_linear_ordered_add_monoid α] [has_sub α] [has_ordered_sub α] [contravariant_class α α (+) (≤)] {m n : α} (hm : even m) (hn : even n) : even (m - n) := begin obtain ⟨a, rfl⟩ := hm, @@ -150,6 +167,14 @@ by simp [even_iff_exists_two_nsmul] lemma even_iff_two_dvd {a : α} : even a ↔ 2 ∣ a := by simp [even, has_dvd.dvd, two_mul] +alias even_iff_two_dvd ↔ even.two_dvd _ + +theorem even.trans_dvd (hm : even m) (hn : m ∣ n) : even n := +even_iff_two_dvd.2 $ hm.two_dvd.trans hn + +theorem has_dvd.dvd.even (hn : m ∣ n) (hm : even m) : even n := +hm.trans_dvd hn + @[simp] lemma range_two_mul (α : Type*) [semiring α] : set.range (λ x : α, 2 * x) = {a | even a} := by { ext x, simp [eq_comm, two_mul, even] } @@ -187,24 +212,18 @@ alias odd_iff_exists_bit1 ↔ odd.exists_bit1 _ set.range (λ x : α, 2 * x + 1) = {a | odd a} := by { ext x, simp [odd, eq_comm] } -lemma even.add_odd (hm : even m) (hn : odd n) : odd (m + n) := -begin - rcases hm with ⟨m, rfl⟩, - rcases hn with ⟨n, rfl⟩, - exact ⟨m + n, by rw [mul_add, ← two_mul, add_assoc]⟩ -end +lemma even.add_odd : even m → odd n → odd (m + n) := +by { rintro ⟨m, rfl⟩ ⟨n, rfl⟩, exact ⟨m + n, by rw [mul_add, ← two_mul, add_assoc]⟩ } lemma odd.add_even (hm : odd m) (hn : even n) : odd (m + n) := by { rw add_comm, exact hn.add_odd hm } -lemma odd.add_odd (hm : odd m) (hn : odd n) : even (m + n) := +lemma odd.add_odd : odd m → odd n → even (m + n) := begin - rcases hm with ⟨m, rfl⟩, - rcases hn with ⟨n, rfl⟩, + rintro ⟨m, rfl⟩ ⟨n, rfl⟩, refine ⟨n + m + 1, _⟩, - rw [← two_mul, ←add_assoc, add_comm _ (2 * n), ←add_assoc, ←mul_add, add_assoc, mul_add _ (n + m), - mul_one], - refl + rw [two_mul, two_mul], + ac_refl end @[simp] lemma odd_one : odd (1 : α) := @@ -212,16 +231,12 @@ end @[simp] lemma odd_two_mul_add_one (m : α) : odd (2 * m + 1) := ⟨m, rfl⟩ -lemma ring_hom.odd (f : α →+* β) (hm : odd m) : odd (f m) := -begin - rcases hm with ⟨m, rfl⟩, - exact ⟨f m, by simp [two_mul]⟩ -end +lemma odd.map [ring_hom_class F α β] (f : F) : odd m → odd (f m) := +by { rintro ⟨m, rfl⟩, exact ⟨f m, by simp [two_mul]⟩ } -@[simp] lemma odd.mul_odd (hm : odd m) (hn : odd n) : odd (m * n) := +@[simp] lemma odd.mul : odd m → odd n → odd (m * n) := begin - rcases hm with ⟨m, rfl⟩, - rcases hn with ⟨n, rfl⟩, + rintro ⟨m, rfl⟩ ⟨n, rfl⟩, refine ⟨2 * m * n + n + m, _⟩, rw [mul_add, add_mul, mul_one, ← add_assoc, one_mul, mul_assoc, ← mul_add, ← mul_add, ← mul_assoc, ← nat.cast_two, ← nat.cast_comm], @@ -229,7 +244,7 @@ end lemma odd.pow (hm : odd m) : ∀ {a : ℕ}, odd (m ^ a) | 0 := by { rw pow_zero, exact odd_one } -| (a + 1) := by { rw pow_succ, exact hm.mul_odd odd.pow } +| (a + 1) := by { rw pow_succ, exact hm.mul odd.pow } end with_odd end semiring @@ -243,17 +258,26 @@ lemma odd.neg_one_pow (h : odd n) : (-1 : α) ^ n = -1 := by rw [h.neg_pow, one_ end monoid -section ring -variables [ring α] {a b : α} {n : ℕ} +section canonically_ordered_comm_semiring -@[simp] lemma even_neg_two : even (- 2 : α) := by simp only [even_neg, even_two] +variables [canonically_ordered_comm_semiring α] -lemma even_abs [linear_order α] {a : α} : even (|a|) ↔ even a := +-- this holds more generally in a `canonically_ordered_add_monoid` if we refactor `odd` to use +-- either `2 • t` or `t + t` instead of `2 * t`. +lemma odd.pos [nontrivial α] {n : α} (hn : odd n) : 0 < n := begin - rcases abs_choice a with h | h; rw h, - exact even_neg a, + obtain ⟨k, rfl⟩ := hn, + rw [pos_iff_ne_zero, ne.def, add_eq_zero_iff, not_and'], + exact λ h, (one_ne_zero h).elim end +end canonically_ordered_comm_semiring + +section ring +variables [ring α] {a b : α} {n : ℕ} + +@[simp] lemma even_neg_two : even (- 2 : α) := by simp only [even_neg, even_two] + lemma odd.neg (hp : odd a) : odd (-a) := begin obtain ⟨k, hk⟩ := hp, @@ -262,22 +286,21 @@ begin neg_add_cancel_right, ←neg_add, hk], end -@[simp] lemma odd_neg (a : α) : odd (-a) ↔ odd a := -⟨λ h, neg_neg a ▸ h.neg, odd.neg⟩ +@[simp] lemma odd_neg : odd (-a) ↔ odd a := ⟨λ h, neg_neg a ▸ h.neg, odd.neg⟩ @[simp] lemma odd_neg_one : odd (- 1 : α) := by simp lemma odd.sub_even (ha : odd a) (hb : even b) : odd (a - b) := -by { rw sub_eq_add_neg, exact ha.add_even ((even_neg _).mpr hb) } +by { rw sub_eq_add_neg, exact ha.add_even hb.neg } lemma even.sub_odd (ha : even a) (hb : odd b) : odd (a - b) := -by { rw sub_eq_add_neg, exact ha.add_odd ((odd_neg _).mpr hb) } +by { rw sub_eq_add_neg, exact ha.add_odd hb.neg } lemma odd.sub_odd (ha : odd a) (hb : odd b) : even (a - b) := -by { rw sub_eq_add_neg, exact ha.add_odd ((odd_neg _).mpr hb) } +by { rw sub_eq_add_neg, exact ha.add_odd hb.neg } -lemma odd_abs [linear_order α] {a : α} : odd (abs a) ↔ odd a := -by { cases abs_choice a with h h; simp only [h, odd_neg] } +lemma odd_abs [linear_order α] : odd (abs a) ↔ odd a := +by cases abs_choice a with h h; simp only [h, odd_neg] end ring @@ -323,70 +346,3 @@ lemma odd.strict_mono_pow (hn : odd n) : strict_mono (λ a : R, a ^ n) := by cases hn with k hk; simpa only [hk, two_mul] using strict_mono_pow_bit1 _ end powers - -/-- The cardinality of `fin (bit0 k)` is even, `fact` version. -This `fact` is needed as an instance by `matrix.special_linear_group.has_neg`. -/ -lemma fintype.card_fin_even {k : ℕ} : fact (even (fintype.card (fin (bit0 k)))) := -⟨by { rw [fintype.card_fin], exact even_bit0 k }⟩ - -section field_power -variable {K : Type*} - -section division_ring -variables [division_ring K] {n : ℤ} - -lemma even.neg_zpow (h : even n) (a : K) : (-a) ^ n = a ^ n := -by { obtain ⟨k, rfl⟩ := h, exact zpow_bit0_neg _ _ } - -lemma odd.neg_zpow (h : odd n) (a : K) : (-a) ^ n = - a ^ n := -by { obtain ⟨k, rfl⟩ := h.exists_bit1, exact zpow_bit1_neg _ _ } - -lemma even.neg_one_zpow (h : even n) : (-1 : K) ^ n = 1 := by rw [h.neg_zpow, one_zpow₀] -lemma odd.neg_one_zpow (h : odd n) : (-1 : K) ^ n = -1 := by rw [h.neg_zpow, one_zpow₀] - -end division_ring - -variables [linear_ordered_field K] {n : ℤ} {a : K} - -protected lemma even.zpow_nonneg (hn : even n) (a : K) : 0 ≤ a ^ n := -begin - cases le_or_lt 0 a with h h, - { exact zpow_nonneg h _ }, - { exact (hn.neg_zpow a).subst (zpow_nonneg (neg_nonneg_of_nonpos h.le) _) } -end - -theorem even.zpow_pos (hn : even n) (ha : a ≠ 0) : 0 < a ^ n := -by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit0_pos ha k - -protected lemma odd.zpow_nonneg (hn : odd n) (ha : 0 ≤ a) : 0 ≤ a ^ n := -by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_nonneg_iff.mpr ha - -theorem odd.zpow_pos (hn : odd n) (ha : 0 < a) : 0 < a ^ n := -by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_pos_iff.mpr ha - -theorem odd.zpow_nonpos (hn : odd n) (ha : a ≤ 0) : a ^ n ≤ 0:= -by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_nonpos_iff.mpr ha - -theorem odd.zpow_neg (hn : odd n) (ha : a < 0) : a ^ n < 0:= -by cases hn with k hk; simpa only [hk, two_mul] using zpow_bit1_neg_iff.mpr ha - -lemma even.zpow_abs {p : ℤ} (hp : even p) (a : K) : |a| ^ p = a ^ p := -begin - cases abs_choice a with h h; - simp only [h, hp.neg_zpow _], -end - -@[simp] lemma zpow_bit0_abs (a : K) (p : ℤ) : |a| ^ bit0 p = a ^ bit0 p := -(even_bit0 _).zpow_abs _ - -lemma even.abs_zpow {p : ℤ} (hp : even p) (a : K) : |a ^ p| = a ^ p := -begin - rw [abs_eq_self], - exact hp.zpow_nonneg _ -end - -@[simp] lemma abs_zpow_bit0 (a : K) (p : ℤ) : - |a ^ bit0 p| = a ^ bit0 p := -(even_bit0 _).abs_zpow _ - -end field_power diff --git a/src/algebra/pempty_instances.lean b/src/algebra/pempty_instances.lean index 4e43b22d9cb6d..176f818cb4d65 100644 --- a/src/algebra/pempty_instances.lean +++ b/src/algebra/pempty_instances.lean @@ -5,11 +5,14 @@ Authors: Julian Kuelshammer -/ import algebra.group.defs -import algebra.group.to_additive +import tactic.to_additive /-! # Instances on pempty +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file collects facts about algebraic structures on the (universe-polymorphic) empty type, e.g. that it is a semigroup. -/ diff --git a/src/algebra/periodic.lean b/src/algebra/periodic.lean index 987bef4bdd16b..1ca286569804a 100644 --- a/src/algebra/periodic.lean +++ b/src/algebra/periodic.lean @@ -3,15 +3,21 @@ Copyright (c) 2021 Benjamin Davidson. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Benjamin Davidson -/ +import algebra.big_operators.basic import algebra.field.opposite import algebra.module.basic import algebra.order.archimedean import data.int.parity import group_theory.coset +import group_theory.subgroup.zpowers +import group_theory.submonoid.membership /-! # Periodicity +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define and then prove facts about periodic and antiperiodic functions. ## Main definitions @@ -41,13 +47,11 @@ namespace function @[simp] def periodic [has_add α] (f : α → β) (c : α) : Prop := ∀ x : α, f (x + c) = f x -lemma periodic.funext [has_add α] - (h : periodic f c) : +protected lemma periodic.funext [has_add α] (h : periodic f c) : (λ x, f (x + c)) = f := funext h -lemma periodic.comp [has_add α] - (h : periodic f c) (g : β → γ) : +protected lemma periodic.comp [has_add α] (h : periodic f c) (g : β → γ) : periodic (g ∘ f) c := by simp * at * @@ -57,35 +61,31 @@ lemma periodic.comp_add_hom [has_add α] [has_add γ] λ x, by simp only [hg c, h (g x), add_hom.map_add, comp_app] @[to_additive] -lemma periodic.mul [has_add α] [has_mul β] - (hf : periodic f c) (hg : periodic g c) : +protected lemma periodic.mul [has_add α] [has_mul β] (hf : periodic f c) (hg : periodic g c) : periodic (f * g) c := by simp * at * @[to_additive] -lemma periodic.div [has_add α] [has_div β] - (hf : periodic f c) (hg : periodic g c) : +protected lemma periodic.div [has_add α] [has_div β] (hf : periodic f c) (hg : periodic g c) : periodic (f / g) c := by simp * at * @[to_additive] -lemma _root_.list.periodic_prod [has_add α] [comm_monoid β] +lemma _root_.list.periodic_prod [has_add α] [monoid β] (l : list (α → β)) (hl : ∀ f ∈ l, periodic f c) : periodic l.prod c := begin induction l with g l ih hl, { simp, }, - { simp only [list.mem_cons_iff, forall_eq_or_imp] at hl, - obtain ⟨hg, hl⟩ := hl, - simp only [list.prod_cons], - exact hg.mul (ih hl), }, + { rw [list.forall_mem_cons] at hl, + simpa only [list.prod_cons] using hl.1.mul (ih hl.2) } end @[to_additive] lemma _root_.multiset.periodic_prod [has_add α] [comm_monoid β] (s : multiset (α → β)) (hs : ∀ f ∈ s, periodic f c) : periodic s.prod c := -s.prod_to_list ▸ s.to_list.periodic_prod $ λ f hf, hs f $ (multiset.mem_to_list f s).mp hf +s.prod_to_list ▸ s.to_list.periodic_prod $ λ f hf, hs f $ multiset.mem_to_list.mp hf @[to_additive] lemma _root_.finset.periodic_prod [has_add α] [comm_monoid β] @@ -94,16 +94,16 @@ lemma _root_.finset.periodic_prod [has_add α] [comm_monoid β] s.prod_to_list f ▸ (s.to_list.map f).periodic_prod (by simpa [-periodic]) @[to_additive] -lemma periodic.smul [has_add α] [has_scalar γ β] (h : periodic f c) (a : γ) : +protected lemma periodic.smul [has_add α] [has_smul γ β] (h : periodic f c) (a : γ) : periodic (a • f) c := by simp * at * -lemma periodic.const_smul [add_monoid α] [group γ] [distrib_mul_action γ α] +protected lemma periodic.const_smul [add_monoid α] [group γ] [distrib_mul_action γ α] (h : periodic f c) (a : γ) : periodic (λ x, f (a • x)) (a⁻¹ • c) := λ x, by simpa only [smul_add, smul_inv_smul] using h (a • x) -lemma periodic.const_smul₀ [add_comm_monoid α] [division_ring γ] [module γ α] +lemma periodic.const_smul₀ [add_comm_monoid α] [division_semiring γ] [module γ α] (h : periodic f c) (a : γ) : periodic (λ x, f (a • x)) (a⁻¹ • c) := begin @@ -112,8 +112,7 @@ begin simpa only [smul_add, smul_inv_smul₀ ha] using h (a • x), end -lemma periodic.const_mul [division_ring α] - (h : periodic f c) (a : α) : +protected lemma periodic.const_mul [division_semiring α] (h : periodic f c) (a : α) : periodic (λ x, f (a * x)) (a⁻¹ * c) := h.const_smul₀ a @@ -122,103 +121,101 @@ lemma periodic.const_inv_smul [add_monoid α] [group γ] [distrib_mul_action γ periodic (λ x, f (a⁻¹ • x)) (a • c) := by simpa only [inv_inv] using h.const_smul a⁻¹ -lemma periodic.const_inv_smul₀ [add_comm_monoid α] [division_ring γ] [module γ α] +lemma periodic.const_inv_smul₀ [add_comm_monoid α] [division_semiring γ] [module γ α] (h : periodic f c) (a : γ) : periodic (λ x, f (a⁻¹ • x)) (a • c) := by simpa only [inv_inv] using h.const_smul₀ a⁻¹ -lemma periodic.const_inv_mul [division_ring α] - (h : periodic f c) (a : α) : +lemma periodic.const_inv_mul [division_semiring α] (h : periodic f c) (a : α) : periodic (λ x, f (a⁻¹ * x)) (a * c) := h.const_inv_smul₀ a -lemma periodic.mul_const [division_ring α] - (h : periodic f c) (a : α) : +lemma periodic.mul_const [division_semiring α] (h : periodic f c) (a : α) : periodic (λ x, f (x * a)) (c * a⁻¹) := h.const_smul₀ $ mul_opposite.op a -lemma periodic.mul_const' [division_ring α] +lemma periodic.mul_const' [division_semiring α] (h : periodic f c) (a : α) : periodic (λ x, f (x * a)) (c / a) := by simpa only [div_eq_mul_inv] using h.mul_const a -lemma periodic.mul_const_inv [division_ring α] - (h : periodic f c) (a : α) : +lemma periodic.mul_const_inv [division_semiring α] (h : periodic f c) (a : α) : periodic (λ x, f (x * a⁻¹)) (c * a) := h.const_inv_smul₀ $ mul_opposite.op a -lemma periodic.div_const [division_ring α] - (h : periodic f c) (a : α) : +lemma periodic.div_const [division_semiring α] (h : periodic f c) (a : α) : periodic (λ x, f (x / a)) (c * a) := by simpa only [div_eq_mul_inv] using h.mul_const_inv a -lemma periodic.add_period [add_semigroup α] - (h1 : periodic f c₁) (h2 : periodic f c₂) : +lemma periodic.add_period [add_semigroup α] (h1 : periodic f c₁) (h2 : periodic f c₂) : periodic f (c₁ + c₂) := by simp [*, ← add_assoc] at * -lemma periodic.sub_eq [add_group α] - (h : periodic f c) (x : α) : +lemma periodic.sub_eq [add_group α] (h : periodic f c) (x : α) : f (x - c) = f x := by simpa only [sub_add_cancel] using (h (x - c)).symm -lemma periodic.sub_eq' [add_comm_group α] - (h : periodic f c) : +lemma periodic.sub_eq' [add_comm_group α] (h : periodic f c) : f (c - x) = f (-x) := by simpa only [sub_eq_neg_add] using h (-x) -lemma periodic.neg [add_group α] - (h : periodic f c) : +protected lemma periodic.neg [add_group α] (h : periodic f c) : periodic f (-c) := by simpa only [sub_eq_add_neg, periodic] using h.sub_eq -lemma periodic.sub_period [add_comm_group α] - (h1 : periodic f c₁) (h2 : periodic f c₂) : +lemma periodic.sub_period [add_group α] (h1 : periodic f c₁) (h2 : periodic f c₂) : periodic f (c₁ - c₂) := -let h := h2.neg in by simp [*, sub_eq_add_neg, add_comm c₁, ← add_assoc] at * +by simpa only [sub_eq_add_neg] using h1.add_period h2.neg + +lemma periodic.const_add [add_semigroup α] (h : periodic f c) (a : α) : + periodic (λ x, f (a + x)) c := +λ x, by simpa [add_assoc] using h (a + x) -lemma periodic.nsmul [add_monoid α] - (h : periodic f c) (n : ℕ) : +lemma periodic.add_const [add_comm_semigroup α] (h : periodic f c) (a : α) : + periodic (λ x, f (x + a)) c := +by simpa only [add_comm] using h.const_add a + +lemma periodic.const_sub [add_comm_group α] (h : periodic f c) (a : α) : + periodic (λ x, f (a - x)) c := +λ x, by simp only [← sub_sub, h.sub_eq] + +lemma periodic.sub_const [add_comm_group α] (h : periodic f c) (a : α) : + periodic (λ x, f (x - a)) c := +by simpa only [sub_eq_add_neg] using h.add_const (-a) + +lemma periodic.nsmul [add_monoid α] (h : periodic f c) (n : ℕ) : periodic f (n • c) := by induction n; simp [nat.succ_eq_add_one, add_nsmul, ← add_assoc, zero_nsmul, *] at * -lemma periodic.nat_mul [semiring α] - (h : periodic f c) (n : ℕ) : +lemma periodic.nat_mul [semiring α] (h : periodic f c) (n : ℕ) : periodic f (n * c) := by simpa only [nsmul_eq_mul] using h.nsmul n -lemma periodic.neg_nsmul [add_group α] - (h : periodic f c) (n : ℕ) : +lemma periodic.neg_nsmul [add_group α] (h : periodic f c) (n : ℕ) : periodic f (-(n • c)) := (h.nsmul n).neg -lemma periodic.neg_nat_mul [ring α] - (h : periodic f c) (n : ℕ) : +lemma periodic.neg_nat_mul [ring α] (h : periodic f c) (n : ℕ) : periodic f (-(n * c)) := (h.nat_mul n).neg -lemma periodic.sub_nsmul_eq [add_group α] - (h : periodic f c) (n : ℕ) : +lemma periodic.sub_nsmul_eq [add_group α] (h : periodic f c) (n : ℕ) : f (x - n • c) = f x := by simpa only [sub_eq_add_neg] using h.neg_nsmul n x -lemma periodic.sub_nat_mul_eq [ring α] - (h : periodic f c) (n : ℕ) : +lemma periodic.sub_nat_mul_eq [ring α] (h : periodic f c) (n : ℕ) : f (x - n * c) = f x := by simpa only [nsmul_eq_mul] using h.sub_nsmul_eq n -lemma periodic.nsmul_sub_eq [add_comm_group α] - (h : periodic f c) (n : ℕ) : +lemma periodic.nsmul_sub_eq [add_comm_group α] (h : periodic f c) (n : ℕ) : f (n • c - x) = f (-x) := -by simpa only [sub_eq_neg_add] using h.nsmul n (-x) +(h.nsmul n).sub_eq' -lemma periodic.nat_mul_sub_eq [ring α] - (h : periodic f c) (n : ℕ) : +lemma periodic.nat_mul_sub_eq [ring α] (h : periodic f c) (n : ℕ) : f (n * c - x) = f (-x) := by simpa only [sub_eq_neg_add] using h.nat_mul n (-x) -lemma periodic.zsmul [add_group α] - (h : periodic f c) (n : ℤ) : +protected lemma periodic.zsmul [add_group α] (h : periodic f c) (n : ℤ) : periodic f (n • c) := begin cases n, @@ -226,58 +223,47 @@ begin { simpa only [zsmul_neg_succ_of_nat] using (h.nsmul n.succ).neg }, end -lemma periodic.int_mul [ring α] - (h : periodic f c) (n : ℤ) : +protected lemma periodic.int_mul [ring α] (h : periodic f c) (n : ℤ) : periodic f (n * c) := by simpa only [zsmul_eq_mul] using h.zsmul n -lemma periodic.sub_zsmul_eq [add_group α] - (h : periodic f c) (n : ℤ) : +lemma periodic.sub_zsmul_eq [add_group α] (h : periodic f c) (n : ℤ) : f (x - n • c) = f x := (h.zsmul n).sub_eq x -lemma periodic.sub_int_mul_eq [ring α] - (h : periodic f c) (n : ℤ) : +lemma periodic.sub_int_mul_eq [ring α] (h : periodic f c) (n : ℤ) : f (x - n * c) = f x := (h.int_mul n).sub_eq x -lemma periodic.zsmul_sub_eq [add_comm_group α] - (h : periodic f c) (n : ℤ) : +lemma periodic.zsmul_sub_eq [add_comm_group α] (h : periodic f c) (n : ℤ) : f (n • c - x) = f (-x) := -by simpa only [sub_eq_neg_add] using h.zsmul n (-x) +(h.zsmul _).sub_eq' -lemma periodic.int_mul_sub_eq [ring α] - (h : periodic f c) (n : ℤ) : +lemma periodic.int_mul_sub_eq [ring α] (h : periodic f c) (n : ℤ) : f (n * c - x) = f (-x) := -by simpa only [sub_eq_neg_add] using h.int_mul n (-x) +(h.int_mul _).sub_eq' -lemma periodic.eq [add_zero_class α] - (h : periodic f c) : +protected lemma periodic.eq [add_zero_class α] (h : periodic f c) : f c = f 0 := by simpa only [zero_add] using h 0 -lemma periodic.neg_eq [add_group α] - (h : periodic f c) : +protected lemma periodic.neg_eq [add_group α] (h : periodic f c) : f (-c) = f 0 := h.neg.eq -lemma periodic.nsmul_eq [add_monoid α] - (h : periodic f c) (n : ℕ) : +protected lemma periodic.nsmul_eq [add_monoid α] (h : periodic f c) (n : ℕ) : f (n • c) = f 0 := (h.nsmul n).eq -lemma periodic.nat_mul_eq [semiring α] - (h : periodic f c) (n : ℕ) : +lemma periodic.nat_mul_eq [semiring α] (h : periodic f c) (n : ℕ) : f (n * c) = f 0 := (h.nat_mul n).eq -lemma periodic.zsmul_eq [add_group α] - (h : periodic f c) (n : ℤ) : +lemma periodic.zsmul_eq [add_group α] (h : periodic f c) (n : ℤ) : f (n • c) = f 0 := (h.zsmul n).eq -lemma periodic.int_mul_eq [ring α] - (h : periodic f c) (n : ℤ) : +lemma periodic.int_mul_eq [ring α] (h : periodic f c) (n : ℤ) : f (n * c) = f 0 := (h.int_mul n).eq @@ -329,7 +315,11 @@ by { rcases a with ⟨_, m, rfl⟩, simp [add_submonoid.vadd_def, add_comm _ x, /-- Lift a periodic function to a function from the quotient group. -/ def periodic.lift [add_group α] (h : periodic f c) (x : α ⧸ add_subgroup.zmultiples c) : β := quotient.lift_on' x f $ - λ a b ⟨k, hk⟩, (h.zsmul k _).symm.trans $ congr_arg f $ add_eq_of_eq_neg_add hk + λ a b h', (begin + rw quotient_add_group.left_rel_apply at h', + obtain ⟨k, hk⟩ := h', + exact (h.zsmul k _).symm.trans (congr_arg f (add_eq_of_eq_neg_add hk)), + end) @[simp] lemma periodic.lift_coe [add_group α] (h : periodic f c) (a : α) : h.lift (a : α ⧸ add_subgroup.zmultiples c) = f a := @@ -342,88 +332,90 @@ rfl @[simp] def antiperiodic [has_add α] [has_neg β] (f : α → β) (c : α) : Prop := ∀ x : α, f (x + c) = -f x -lemma antiperiodic.funext [has_add α] [has_neg β] - (h : antiperiodic f c) : +protected lemma antiperiodic.funext [has_add α] [has_neg β] (h : antiperiodic f c) : (λ x, f (x + c)) = -f := funext h -lemma antiperiodic.funext' [has_add α] [add_group β] - (h : antiperiodic f c) : +protected lemma antiperiodic.funext' [has_add α] [has_involutive_neg β] (h : antiperiodic f c) : (λ x, -f (x + c)) = f := -(eq_neg_iff_eq_neg.mp h.funext).symm +neg_eq_iff_eq_neg.mpr h.funext /-- If a function is `antiperiodic` with antiperiod `c`, then it is also `periodic` with period `2 * c`. -/ -lemma antiperiodic.periodic [semiring α] [add_group β] - (h : antiperiodic f c) : +protected lemma antiperiodic.periodic [semiring α] [has_involutive_neg β] (h : antiperiodic f c) : periodic f (2 * c) := by simp [two_mul, ← add_assoc, h _] -lemma antiperiodic.eq [add_zero_class α] [has_neg β] - (h : antiperiodic f c) : f c = -f 0 := +protected lemma antiperiodic.eq [add_zero_class α] [has_neg β] (h : antiperiodic f c) : + f c = -f 0 := by simpa only [zero_add] using h 0 -lemma antiperiodic.nat_even_mul_periodic [semiring α] [add_group β] +lemma antiperiodic.nat_even_mul_periodic [semiring α] [has_involutive_neg β] (h : antiperiodic f c) (n : ℕ) : periodic f (n * (2 * c)) := h.periodic.nat_mul n -lemma antiperiodic.nat_odd_mul_antiperiodic [semiring α] [add_group β] +lemma antiperiodic.nat_odd_mul_antiperiodic [semiring α] [has_involutive_neg β] (h : antiperiodic f c) (n : ℕ) : antiperiodic f (n * (2 * c) + c) := λ x, by rw [← add_assoc, h, h.periodic.nat_mul] -lemma antiperiodic.int_even_mul_periodic [ring α] [add_group β] +lemma antiperiodic.int_even_mul_periodic [ring α] [has_involutive_neg β] (h : antiperiodic f c) (n : ℤ) : periodic f (n * (2 * c)) := h.periodic.int_mul n -lemma antiperiodic.int_odd_mul_antiperiodic [ring α] [add_group β] +lemma antiperiodic.int_odd_mul_antiperiodic [ring α] [has_involutive_neg β] (h : antiperiodic f c) (n : ℤ) : antiperiodic f (n * (2 * c) + c) := λ x, by rw [← add_assoc, h, h.periodic.int_mul] -lemma antiperiodic.nat_mul_eq_of_eq_zero [comm_semiring α] [add_group β] - (h : antiperiodic f c) (hi : f 0 = 0) (n : ℕ) : - f (n * c) = 0 := -begin - rcases nat.even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩; - have hk : (k : α) * (2 * c) = 2 * k * c := by rw [mul_left_comm, ← mul_assoc], - { simpa [← two_mul, hk, hi] using (h.nat_even_mul_periodic k).eq }, - { simpa [add_mul, hk, hi] using (h.nat_odd_mul_antiperiodic k).eq }, -end - -lemma antiperiodic.int_mul_eq_of_eq_zero [comm_ring α] [add_group β] - (h : antiperiodic f c) (hi : f 0 = 0) (n : ℤ) : - f (n * c) = 0 := -begin - rcases int.even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩; - have hk : (k : α) * (2 * c) = 2 * k * c := by rw [mul_left_comm, ← mul_assoc], - { simpa [← two_mul, hk, hi] using (h.int_even_mul_periodic k).eq }, - { simpa [add_mul, hk, hi] using (h.int_odd_mul_antiperiodic k).eq }, -end - -lemma antiperiodic.sub_eq [add_group α] [add_group β] +lemma antiperiodic.sub_eq [add_group α] [has_involutive_neg β] (h : antiperiodic f c) (x : α) : f (x - c) = -f x := -by simp only [eq_neg_iff_eq_neg.mp (h (x - c)), sub_add_cancel] +by rw [← neg_eq_iff_eq_neg, ← h (x - c), sub_add_cancel] -lemma antiperiodic.sub_eq' [add_comm_group α] [add_group β] - (h : antiperiodic f c) : +lemma antiperiodic.sub_eq' [add_comm_group α] [has_neg β] (h : antiperiodic f c) : f (c - x) = -f (-x) := by simpa only [sub_eq_neg_add] using h (-x) -lemma antiperiodic.neg [add_group α] [add_group β] +protected lemma antiperiodic.neg [add_group α] [has_involutive_neg β] (h : antiperiodic f c) : antiperiodic f (-c) := by simpa only [sub_eq_add_neg, antiperiodic] using h.sub_eq -lemma antiperiodic.neg_eq [add_group α] [add_group β] +lemma antiperiodic.neg_eq [add_group α] [has_involutive_neg β] (h : antiperiodic f c) : f (-c) = -f 0 := by simpa only [zero_add] using h.neg 0 -lemma antiperiodic.smul [has_add α] [monoid γ] [add_group β] [distrib_mul_action γ β] +lemma antiperiodic.nat_mul_eq_of_eq_zero [ring α] [neg_zero_class β] + (h : antiperiodic f c) (hi : f 0 = 0) : ∀ n : ℕ, f (n * c) = 0 +| 0 := by rwa [nat.cast_zero, zero_mul] +| (n + 1) := by simp [add_mul, antiperiodic.nat_mul_eq_of_eq_zero n, h _] + +lemma antiperiodic.int_mul_eq_of_eq_zero [ring α] [subtraction_monoid β] + (h : antiperiodic f c) (hi : f 0 = 0) : ∀ n : ℤ, f (n * c) = 0 +| (n : ℕ) := by rwa [int.cast_coe_nat, h.nat_mul_eq_of_eq_zero] +| -[1+n] := by rw [int.cast_neg_succ_of_nat, neg_mul, ← mul_neg, h.neg.nat_mul_eq_of_eq_zero hi] + +lemma antiperiodic.const_add [add_semigroup α] [has_neg β] (h : antiperiodic f c) (a : α) : + antiperiodic (λ x, f (a + x)) c := +λ x, by simpa [add_assoc] using h (a + x) + +lemma antiperiodic.add_const [add_comm_semigroup α] [has_neg β] (h : antiperiodic f c) (a : α) : + antiperiodic (λ x, f (x + a)) c := +λ x, by simpa only [add_right_comm] using h (x + a) + +lemma antiperiodic.const_sub [add_comm_group α] [has_involutive_neg β] (h : antiperiodic f c) + (a : α) : antiperiodic (λ x, f (a - x)) c := +λ x, by simp only [← sub_sub, h.sub_eq] + +lemma antiperiodic.sub_const [add_comm_group α] [has_neg β] (h : antiperiodic f c) (a : α) : + antiperiodic (λ x, f (x - a)) c := +by simpa only [sub_eq_add_neg] using h.add_const (-a) + +protected lemma antiperiodic.smul [has_add α] [monoid γ] [add_group β] [distrib_mul_action γ β] (h : antiperiodic f c) (a : γ) : antiperiodic (a • f) c := by simp * at * @@ -433,12 +425,12 @@ lemma antiperiodic.const_smul [add_monoid α] [has_neg β] [group γ] [distrib_m antiperiodic (λ x, f (a • x)) (a⁻¹ • c) := λ x, by simpa only [smul_add, smul_inv_smul] using h (a • x) -lemma antiperiodic.const_smul₀ [add_comm_monoid α] [has_neg β] [division_ring γ] [module γ α] +lemma antiperiodic.const_smul₀ [add_comm_monoid α] [has_neg β] [division_semiring γ] [module γ α] (h : antiperiodic f c) {a : γ} (ha : a ≠ 0) : antiperiodic (λ x, f (a • x)) (a⁻¹ • c) := λ x, by simpa only [smul_add, smul_inv_smul₀ ha] using h (a • x) -lemma antiperiodic.const_mul [division_ring α] [has_neg β] +lemma antiperiodic.const_mul [division_semiring α] [has_neg β] (h : antiperiodic f c) {a : α} (ha : a ≠ 0) : antiperiodic (λ x, f (a * x)) (a⁻¹ * c) := h.const_smul₀ ha @@ -448,74 +440,79 @@ lemma antiperiodic.const_inv_smul [add_monoid α] [has_neg β] [group γ] [distr antiperiodic (λ x, f (a⁻¹ • x)) (a • c) := by simpa only [inv_inv] using h.const_smul a⁻¹ -lemma antiperiodic.const_inv_smul₀ [add_comm_monoid α] [has_neg β] [division_ring γ] [module γ α] +lemma antiperiodic.const_inv_smul₀ + [add_comm_monoid α] [has_neg β] [division_semiring γ] [module γ α] (h : antiperiodic f c) {a : γ} (ha : a ≠ 0) : antiperiodic (λ x, f (a⁻¹ • x)) (a • c) := by simpa only [inv_inv] using h.const_smul₀ (inv_ne_zero ha) -lemma antiperiodic.const_inv_mul [division_ring α] [has_neg β] +lemma antiperiodic.const_inv_mul [division_semiring α] [has_neg β] (h : antiperiodic f c) {a : α} (ha : a ≠ 0) : antiperiodic (λ x, f (a⁻¹ * x)) (a * c) := h.const_inv_smul₀ ha -lemma antiperiodic.mul_const [division_ring α] [has_neg β] +lemma antiperiodic.mul_const [division_semiring α] [has_neg β] (h : antiperiodic f c) {a : α} (ha : a ≠ 0) : antiperiodic (λ x, f (x * a)) (c * a⁻¹) := h.const_smul₀ $ (mul_opposite.op_ne_zero_iff a).mpr ha -lemma antiperiodic.mul_const' [division_ring α] [has_neg β] +lemma antiperiodic.mul_const' [division_semiring α] [has_neg β] (h : antiperiodic f c) {a : α} (ha : a ≠ 0) : antiperiodic (λ x, f (x * a)) (c / a) := by simpa only [div_eq_mul_inv] using h.mul_const ha -lemma antiperiodic.mul_const_inv [division_ring α] [has_neg β] +lemma antiperiodic.mul_const_inv [division_semiring α] [has_neg β] (h : antiperiodic f c) {a : α} (ha : a ≠ 0) : antiperiodic (λ x, f (x * a⁻¹)) (c * a) := h.const_inv_smul₀ $ (mul_opposite.op_ne_zero_iff a).mpr ha -lemma antiperiodic.div_inv [division_ring α] [has_neg β] +protected lemma antiperiodic.div_inv [division_semiring α] [has_neg β] (h : antiperiodic f c) {a : α} (ha : a ≠ 0) : antiperiodic (λ x, f (x / a)) (c * a) := by simpa only [div_eq_mul_inv] using h.mul_const_inv ha -lemma antiperiodic.add [add_group α] [add_group β] +protected lemma antiperiodic.add [add_group α] [has_involutive_neg β] (h1 : antiperiodic f c₁) (h2 : antiperiodic f c₂) : periodic f (c₁ + c₂) := by simp [*, ← add_assoc] at * -lemma antiperiodic.sub [add_comm_group α] [add_group β] +protected lemma antiperiodic.sub [add_group α] [has_involutive_neg β] (h1 : antiperiodic f c₁) (h2 : antiperiodic f c₂) : periodic f (c₁ - c₂) := -let h := h2.neg in by simp [*, sub_eq_add_neg, add_comm c₁, ← add_assoc] at * +by simpa only [sub_eq_add_neg] using h1.add h2.neg -lemma periodic.add_antiperiod [add_group α] [add_group β] +lemma periodic.add_antiperiod [add_group α] [has_neg β] (h1 : periodic f c₁) (h2 : antiperiodic f c₂) : antiperiodic f (c₁ + c₂) := by simp [*, ← add_assoc] at * -lemma periodic.sub_antiperiod [add_comm_group α] [add_group β] +lemma periodic.sub_antiperiod [add_group α] [has_involutive_neg β] (h1 : periodic f c₁) (h2 : antiperiodic f c₂) : antiperiodic f (c₁ - c₂) := -let h := h2.neg in by simp [*, sub_eq_add_neg, add_comm c₁, ← add_assoc] at * +by simpa only [sub_eq_add_neg] using h1.add_antiperiod h2.neg -lemma periodic.add_antiperiod_eq [add_group α] [add_group β] +lemma periodic.add_antiperiod_eq [add_group α] [has_neg β] (h1 : periodic f c₁) (h2 : antiperiodic f c₂) : f (c₁ + c₂) = -f 0 := (h1.add_antiperiod h2).eq -lemma periodic.sub_antiperiod_eq [add_comm_group α] [add_group β] +lemma periodic.sub_antiperiod_eq [add_group α] [has_involutive_neg β] (h1 : periodic f c₁) (h2 : antiperiodic f c₂) : f (c₁ - c₂) = -f 0 := (h1.sub_antiperiod h2).eq -lemma antiperiodic.mul [has_add α] [ring β] +protected lemma antiperiodic.mul [has_add α] [has_mul β] [has_distrib_neg β] (hf : antiperiodic f c) (hg : antiperiodic g c) : periodic (f * g) c := by simp * at * -lemma antiperiodic.div [has_add α] [division_ring β] +protected lemma antiperiodic.div [has_add α] [division_monoid β] [has_distrib_neg β] (hf : antiperiodic f c) (hg : antiperiodic g c) : periodic (f / g) c := by simp [*, neg_div_neg_eq] at * end function + +lemma int.fract_periodic (α) [linear_ordered_ring α] [floor_ring α] : + function.periodic int.fract (1 : α) := +by exact_mod_cast λ a, int.fract_add_int a 1 diff --git a/src/algebra/polynomial/big_operators.lean b/src/algebra/polynomial/big_operators.lean index 9f48a03f1f5af..27bbec5a49037 100644 --- a/src/algebra/polynomial/big_operators.lean +++ b/src/algebra/polynomial/big_operators.lean @@ -8,6 +8,9 @@ import data.polynomial.monic /-! # Lemmas for the interaction between polynomials and `∑` and `∏`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Recall that `∑` and `∏` are notation for `finset.sum` and `finset.prod` respectively. ## Main results @@ -61,7 +64,7 @@ begin suffices : (l.map nat_degree).maximum = ((l.map nat_degree).foldr max 0 : ℕ), { rw this, simpa [this] using nat_degree_list_sum_le l }, - rw list.maximum_eq_coe_foldr_max_of_ne_nil, + rw ← list.foldr_max_of_ne_nil, { congr }, contrapose! h, rw [list.map_eq_nil] at h, @@ -142,7 +145,7 @@ lemma leading_coeff_multiset_prod' (h : (t.map leading_coeff).prod ≠ 0) : t.prod.leading_coeff = (t.map leading_coeff).prod := begin induction t using multiset.induction_on with a t ih, { simp }, - simp only [map_cons, multiset.prod_cons] at h ⊢, + simp only [multiset.map_cons, multiset.prod_cons] at h ⊢, rw polynomial.leading_coeff_mul'; { rwa ih, apply right_ne_zero_of_mul h } end @@ -169,7 +172,7 @@ lemma nat_degree_multiset_prod' (h : (t.map (λ f, leading_coeff f)).prod ≠ 0) begin revert h, refine multiset.induction_on t _ (λ a t ih ht, _), { simp }, - rw [map_cons, multiset.prod_cons] at ht ⊢, + rw [multiset.map_cons, multiset.prod_cons] at ht ⊢, rw [multiset.sum_cons, polynomial.nat_degree_mul', ih], { apply right_ne_zero_of_mul ht }, { rwa polynomial.leading_coeff_multiset_prod', apply right_ne_zero_of_mul ht }, @@ -192,8 +195,8 @@ begin nontriviality R, apply nat_degree_multiset_prod', suffices : (t.map (λ f, leading_coeff f)).prod = 1, { rw this, simp }, - convert prod_repeat (1 : R) t.card, - { simp only [eq_repeat, multiset.card_map, eq_self_iff_true, true_and], + convert prod_replicate t.card (1 : R), + { simp only [eq_replicate, multiset.card_map, eq_self_iff_true, true_and], rintros i hi, obtain ⟨i, hi, rfl⟩ := multiset.mem_map.mp hi, apply h, assumption }, @@ -227,7 +230,7 @@ lemma coeff_zero_multiset_prod : t.prod.coeff 0 = (t.map (λ f, coeff f 0)).prod := begin refine multiset.induction_on t _ (λ a t ht, _), { simp }, - rw [multiset.prod_cons, map_cons, multiset.prod_cons, polynomial.mul_coeff_zero, ht] + rw [multiset.prod_cons, multiset.map_cons, multiset.prod_cons, polynomial.mul_coeff_zero, ht] end lemma coeff_zero_prod : diff --git a/src/algebra/polynomial/group_ring_action.lean b/src/algebra/polynomial/group_ring_action.lean index ee9c71ae70bfb..93b34e2dc6752 100644 --- a/src/algebra/polynomial/group_ring_action.lean +++ b/src/algebra/polynomial/group_ring_action.lean @@ -3,15 +3,19 @@ Copyright (c) 2020 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ -import algebra.group_ring_action +import algebra.group_ring_action.basic import algebra.hom.group_action import data.polynomial.algebra_map import data.polynomial.monic +import group_theory.group_action.quotient /-! # Group action on rings applied to polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains instances and definitions relating `mul_semiring_action` to `polynomial`. -/ diff --git a/src/algebra/punit_instances.lean b/src/algebra/punit_instances.lean index 4774141908b37..7b86493d96fd1 100644 --- a/src/algebra/punit_instances.lean +++ b/src/algebra/punit_instances.lean @@ -6,12 +6,16 @@ Authors: Kenny Lau import algebra.module.basic import algebra.gcd_monoid.basic -import algebra.group_ring_action +import algebra.group_ring_action.basic import group_theory.group_action.defs +import order.complete_boolean_algebra /-! # Instances on punit +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file collects facts about algebraic structures on the one-element type, e.g. that it is a commutative ring. -/ @@ -42,7 +46,8 @@ intros; exact subsingleton.elim _ _ instance : comm_ring punit := by refine -{ .. punit.comm_group, +{ nat_cast := λ _, punit.star, + .. punit.comm_group, .. punit.add_comm_group, .. }; intros; exact subsingleton.elim _ _ @@ -69,66 +74,35 @@ intros; exact subsingleton.elim _ _ @[simp] lemma lcm_eq : lcm x y = star := rfl @[simp] lemma norm_unit_eq : norm_unit x = 1 := rfl -instance : complete_boolean_algebra punit := -by refine -{ le := λ _ _, true, - le_antisymm := λ _ _ _ _, subsingleton.elim _ _, - lt := λ _ _, false, - lt_iff_le_not_le := λ _ _, iff_of_false not_false (λ H, H.2 trivial), - top := star, - bot := star, - sup := λ _ _, star, - inf := λ _ _, star, - Sup := λ _, star, - Inf := λ _, star, - compl := λ _, star, - sdiff := λ _ _, star, - .. }; -intros; trivial <|> simp only [eq_iff_true_of_subsingleton] - -@[simp] lemma top_eq : (⊤ : punit) = star := rfl -@[simp] lemma bot_eq : (⊥ : punit) = star := rfl -@[simp] lemma sup_eq : x ⊔ y = star := rfl -@[simp] lemma inf_eq : x ⊓ y = star := rfl -@[simp] lemma Sup_eq : Sup s = star := rfl -@[simp] lemma Inf_eq : Inf s = star := rfl -@[simp] lemma compl_eq : xᶜ = star := rfl -@[simp] lemma sdiff_eq : x \ y = star := rfl -@[simp] protected lemma le : x ≤ y := trivial -@[simp] lemma not_lt : ¬(x < y) := not_false - instance : canonically_ordered_add_monoid punit := by refine -{ le_iff_exists_add := λ _ _, iff_of_true _ ⟨star, subsingleton.elim _ _⟩, +{ exists_add_of_le := λ _ _ _, ⟨star, subsingleton.elim _ _⟩, .. punit.comm_ring, .. punit.complete_boolean_algebra, .. }; intros; trivial instance : linear_ordered_cancel_add_comm_monoid punit := -{ add_left_cancel := λ _ _ _ _, subsingleton.elim _ _, - le_of_add_le_add_left := λ _ _ _ _, trivial, - le_total := λ _ _, or.inl trivial, - decidable_le := λ _ _, decidable.true, - decidable_eq := punit.decidable_eq, - decidable_lt := λ _ _, decidable.false, - .. punit.canonically_ordered_add_monoid } - -instance : has_scalar R punit := -{ smul := λ _ _, star } +{ le_of_add_le_add_left := λ _ _ _ _, trivial, + .. punit.canonically_ordered_add_monoid, ..punit.linear_order } -@[simp] lemma smul_eq (r : R) : r • y = star := rfl +instance : linear_ordered_add_comm_monoid_with_top punit := +{ top_add' := λ _, rfl, + ..punit.complete_boolean_algebra, + ..punit.linear_ordered_cancel_add_comm_monoid } -instance : is_central_scalar R punit := ⟨λ _ _, rfl⟩ +@[to_additive] instance : has_smul R punit := ⟨λ _ _, star⟩ -instance : smul_comm_class R S punit := ⟨λ _ _ _, subsingleton.elim _ _⟩ +@[simp, to_additive] lemma smul_eq (r : R) : r • y = star := rfl -instance [has_scalar R S] : is_scalar_tower R S punit := ⟨λ _ _ _, subsingleton.elim _ _⟩ +@[to_additive] instance : is_central_scalar R punit := ⟨λ _ _, rfl⟩ +@[to_additive] instance : smul_comm_class R S punit := ⟨λ _ _ _, rfl⟩ +@[to_additive] instance [has_smul R S] : is_scalar_tower R S punit := ⟨λ _ _ _, rfl⟩ instance [has_zero R] : smul_with_zero R punit := -by refine { ..punit.has_scalar, .. }; +by refine { ..punit.has_smul, .. }; intros; exact subsingleton.elim _ _ instance [monoid R] : mul_action R punit := -by refine { ..punit.has_scalar, .. }; +by refine { ..punit.has_smul, .. }; intros; exact subsingleton.elim _ _ instance [monoid R] : distrib_mul_action R punit := diff --git a/src/algebra/quadratic_discriminant.lean b/src/algebra/quadratic_discriminant.lean index 18318b7084c37..8b13bcb92b846 100644 --- a/src/algebra/quadratic_discriminant.lean +++ b/src/algebra/quadratic_discriminant.lean @@ -12,6 +12,9 @@ import tactic.linear_combination /-! # Quadratic discriminants and roots of a quadratic +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the discriminant of a quadratic and gives the solution to a quadratic equation. ## Main definition @@ -25,6 +28,8 @@ This file defines the discriminant of a quadratic and gives the solution to a qu - `quadratic_ne_zero_of_discrim_ne_sq`: if the discriminant has no square root, then the corresponding quadratic has no root. - `discrim_le_zero`: if a quadratic is always non-negative, then its discriminant is non-positive. +- `discrim_le_zero_of_nonpos`, `discrim_lt_zero`, `discrim_lt_zero_of_neg`: versions of this + statement with other inequalities. ## Tags @@ -39,49 +44,50 @@ variables {R : Type*} /-- Discriminant of a quadratic -/ def discrim [ring R] (a b c : R) : R := b^2 - 4 * a * c -variables [comm_ring R] [is_domain R] {a b c : R} +@[simp] lemma discrim_neg [ring R] (a b c : R) : discrim (-a) (-b) (-c) = discrim a b c := +by simp [discrim] + +variables [comm_ring R] {a b c : R} + +lemma discrim_eq_sq_of_quadratic_eq_zero {x : R} (h : a * x * x + b * x + c = 0) : + discrim a b c = (2 * a * x + b) ^ 2 := +begin + rw [discrim], + linear_combination -4 * a * h +end /-- A quadratic has roots if and only if its discriminant equals some square. -/ -lemma quadratic_eq_zero_iff_discrim_eq_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0) (x : R) : +lemma quadratic_eq_zero_iff_discrim_eq_sq [ne_zero (2 : R)] [no_zero_divisors R] + (ha : a ≠ 0) {x : R} : a * x * x + b * x + c = 0 ↔ discrim a b c = (2 * a * x + b) ^ 2 := begin - dsimp [discrim] at *, - split, - { assume h, - linear_combination (h, -4 * a) }, - { assume h, - have ha : 2 * 2 * a ≠ 0 := mul_ne_zero (mul_ne_zero h2 h2) ha, - apply mul_left_cancel₀ ha, - linear_combination (h, -1) } + refine ⟨discrim_eq_sq_of_quadratic_eq_zero, λ h, _⟩, + rw [discrim] at h, + have ha : 2 * 2 * a ≠ 0 := mul_ne_zero (mul_ne_zero (ne_zero.ne _) (ne_zero.ne _)) ha, + apply mul_left_cancel₀ ha, + linear_combination -h end /-- A quadratic has no root if its discriminant has no square root. -/ -lemma quadratic_ne_zero_of_discrim_ne_sq (h2 : (2 : R) ≠ 0) (ha : a ≠ 0) - (h : ∀ s : R, discrim a b c ≠ s * s) (x : R) : +lemma quadratic_ne_zero_of_discrim_ne_sq (h : ∀ s : R, discrim a b c ≠ s^2) (x : R) : a * x * x + b * x + c ≠ 0 := -begin - assume h', - rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, sq] at h', - exact h _ h' -end +mt discrim_eq_sq_of_quadratic_eq_zero $ h _ end ring section field -variables {K : Type*} [field K] [invertible (2 : K)] {a b c x : K} +variables {K : Type*} [field K] [ne_zero (2 : K)] {a b c x : K} -/-- Roots of a quadratic -/ +/-- Roots of a quadratic equation. -/ lemma quadratic_eq_zero_iff (ha : a ≠ 0) {s : K} (h : discrim a b c = s * s) (x : K) : a * x * x + b * x + c = 0 ↔ x = (-b + s) / (2 * a) ∨ x = (-b - s) / (2 * a) := begin - have h2 : (2 : K) ≠ 0 := nonzero_of_invertible 2, - rw [quadratic_eq_zero_iff_discrim_eq_sq h2 ha, h, sq, mul_self_eq_mul_self_iff], - have ne : 2 * a ≠ 0 := mul_ne_zero h2 ha, + rw [quadratic_eq_zero_iff_discrim_eq_sq ha, h, sq, mul_self_eq_mul_self_iff], field_simp, apply or_congr, - { split; intro h'; linear_combination (h', -1) }, + { split; intro h'; linear_combination -h' }, { split; intro h'; linear_combination h' }, end @@ -108,7 +114,7 @@ end field section linear_ordered_field variables {K : Type*} [linear_ordered_field K] {a b c : K} -/-- If a polynomial of degree 2 is always nonnegative, then its discriminant is nonpositive -/ +/-- If a polynomial of degree 2 is always nonnegative, then its discriminant is nonpositive. -/ lemma discrim_le_zero (h : ∀ x : K, 0 ≤ a * x * x + b * x + c) : discrim a b c ≤ 0 := begin rw [discrim, sq], @@ -120,19 +126,20 @@ begin rcases (this.eventually (eventually_lt_at_bot 0)).exists with ⟨x, hx⟩, exact false.elim ((h x).not_lt $ by rwa ← add_mul) }, -- if a = 0 - { rcases em (b = 0) with (rfl|hb), + { rcases eq_or_ne b 0 with (rfl|hb), { simp }, { have := h ((-c - 1) / b), rw [mul_div_cancel' _ hb] at this, linarith } }, -- if a > 0 - { have := calc - 4 * a * (a * (-(b / a) * (1 / 2)) * (-(b / a) * (1 / 2)) + b * (-(b / a) * (1 / 2)) + c) - = (a * (b / a)) * (a * (b / a)) - 2 * (a * (b / a)) * b + 4 * a * c : by ring - ... = -(b * b - 4 * a * c) : by { simp only [mul_div_cancel' b (ne_of_gt ha)], ring }, - have ha' : 0 ≤ 4 * a, by linarith, - have h := (mul_nonneg ha' (h (-(b / a) * (1 / 2)))), - rw this at h, rwa ← neg_nonneg } + { have ha' : 0 ≤ 4 * a := mul_nonneg zero_le_four ha.le, + have := h (-b / (2 * a)), + convert neg_nonpos.2 (mul_nonneg ha' (h (-b / (2 * a)))), + field_simp [ha.ne'], + ring } end +lemma discrim_le_zero_of_nonpos (h : ∀ x : K, a * x * x + b * x + c ≤ 0) : discrim a b c ≤ 0 := +discrim_neg a b c ▸ discrim_le_zero (by simpa only [neg_mul, ← neg_add, neg_nonneg]) + /-- If a polynomial of degree 2 is always positive, then its discriminant is negative, at least when the coefficient of the quadratic term is nonzero. @@ -148,4 +155,8 @@ begin linarith end +lemma discrim_lt_zero_of_neg (ha : a ≠ 0) (h : ∀ x : K, a * x * x + b * x + c < 0) : + discrim a b c < 0 := +discrim_neg a b c ▸ discrim_lt_zero (neg_ne_zero.2 ha) (by simpa only [neg_mul, ← neg_add, neg_pos]) + end linear_ordered_field diff --git a/src/algebra/quandle.lean b/src/algebra/quandle.lean index 866d9c0752fe8..6e98bb487b0e9 100644 --- a/src/algebra/quandle.lean +++ b/src/algebra/quandle.lean @@ -3,13 +3,17 @@ Copyright (c) 2020 Kyle Miller. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ -import algebra.hom.equiv -import data.zmod.basic +import algebra.hom.equiv.basic +import algebra.hom.aut +import data.zmod.defs import tactic.group /-! # Racks and Quandles +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines racks and quandles, algebraic structures for sets that bijectively act on themselves with a self-distributivity property. If `R` is a rack and `act : R → (R ≃ R)` is the self-action, @@ -30,7 +34,7 @@ complements that is analogous to the fundamental group of the exterior, and he showed that the quandle associated to an oriented knot is invariant up to orientation-reversed mirror image. Racks were used by Fenn and Rourke for framed codimension-2 knots and -links.[FennRourke1992] +links in [FennRourke1992]. Unital shelves are discussed in [crans2017]. The name "rack" came from wordplay by Conway and Wraith for the "wrack and ruin" of forgetting everything but the conjugation operation for a @@ -39,6 +43,7 @@ group. ## Main definitions * `shelf` is a type with a self-distributive action +* `unital_shelf` is a shelf with a left and right unit * `rack` is a shelf whose action for each element is invertible * `quandle` is a rack whose action for an element fixes that element * `quandle.conj` defines a quandle of a group acting on itself by conjugation. @@ -50,6 +55,11 @@ group. * `rack.envel_group` is left adjoint to `quandle.conj` (`to_envel_group.map`). The universality statements are `to_envel_group.univ` and `to_envel_group.univ_uniq`. +## Implementation notes + +"Unital racks" are uninteresting (see `rack.assoc_iff_id`, `unital_shelf.assoc`), so we do not +define them. + ## Notation The following notation is localized in `quandles`: @@ -88,6 +98,14 @@ class shelf (α : Type u) := (act : α → α → α) (self_distrib : ∀ {x y z : α}, act x (act y z) = act (act x y) (act x z)) +/-- +A *unital shelf* is a shelf equipped with an element `1` such that, for all elements `x`, +we have both `x ◃ 1` and `1 ◃ x` equal `x`. +-/ +class unital_shelf (α : Type u) extends shelf α, has_one α := +(one_act : ∀ a : α, act 1 a = a) +(act_one : ∀ a : α, act a 1 = a) + /-- The type of homomorphisms between shelves. This is also the notion of rack and quandle homomorphisms. @@ -110,12 +128,44 @@ class rack (α : Type u) extends shelf α := (left_inv : ∀ x, function.left_inverse (inv_act x) (act x)) (right_inv : ∀ x, function.right_inverse (inv_act x) (act x)) -localized "infixr ` ◃ `:65 := shelf.act" in quandles -localized "infixr ` ◃⁻¹ `:65 := rack.inv_act" in quandles -localized "infixr ` →◃ `:25 := shelf_hom" in quandles +localized "infixr (name := shelf.act) ` ◃ `:65 := shelf.act" in quandles +localized "infixr (name := rack.inv_act) ` ◃⁻¹ `:65 := rack.inv_act" in quandles +localized "infixr (name := shelf_hom) ` →◃ `:25 := shelf_hom" in quandles open_locale quandles +namespace unital_shelf +open shelf + +variables {S : Type*} [unital_shelf S] + +/-- +A monoid is *graphic* if, for all `x` and `y`, the *graphic identity* +`(x * y) * x = x * y` holds. For a unital shelf, this graphic +identity holds. +-/ +lemma act_act_self_eq (x y : S) : (x ◃ y) ◃ x = x ◃ y := +begin + have h : (x ◃ y) ◃ x = (x ◃ y) ◃ (x ◃ 1) := by rw act_one, + rw [h, ←shelf.self_distrib, act_one], +end + +lemma act_idem (x : S) : (x ◃ x) = x := by rw [←act_one x, ←shelf.self_distrib, act_one, act_one] + +lemma act_self_act_eq (x y : S) : x ◃ (x ◃ y) = x ◃ y := +begin + have h : x ◃ (x ◃ y) = (x ◃ 1) ◃ (x ◃ y) := by rw act_one, + rw [h, ←shelf.self_distrib, one_act], +end + +/-- +The associativity of a unital shelf comes for free. +-/ +lemma assoc (x y z : S) : (x ◃ y) ◃ z = x ◃ y ◃ z := +by rw [self_distrib, self_distrib, act_act_self_eq, act_self_act_eq] + +end unital_shelf + namespace rack variables {R : Type*} [rack R] @@ -161,8 +211,7 @@ This is used in the natural rack homomorphism `to_conj` from `R` to lemma ad_conj {R : Type*} [rack R] (x y : R) : act (x ◃ y) = act x * act y * (act x)⁻¹ := begin - apply @mul_right_cancel _ _ _ (act x), ext z, - simp only [inv_mul_cancel_right], + rw [eq_mul_inv_iff_mul_eq], ext z, apply self_distrib.symm, end @@ -298,7 +347,7 @@ instance opposite_quandle : quandle Qᵐᵒᵖ := The conjugation quandle of a group. Each element of the group acts by the corresponding inner automorphism. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def conj (G : Type*) := G instance conj.quandle (G : Type*) [group G] : quandle (conj G) := @@ -338,7 +387,7 @@ The dihedral quandle. This is the conjugation quandle of the dihedral group rest Used for Fox n-colorings of knots. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def dihedral (n : ℕ) := zmod n /-- diff --git a/src/algebra/quaternion.lean b/src/algebra/quaternion.lean index 7d645994e9ea0..449dbc5ee7f43 100644 --- a/src/algebra/quaternion.lean +++ b/src/algebra/quaternion.lean @@ -3,13 +3,19 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import algebra.algebra.basic +import algebra.algebra.equiv +import linear_algebra.finrank +import linear_algebra.free_module.basic +import linear_algebra.free_module.finite.basic import set_theory.cardinal.ordinal import tactic.ring_exp /-! # Quaternions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define quaternions `ℍ[R]` over a commutative ring `R`, and define some algebraic structures on `ℍ[R]`. @@ -19,7 +25,7 @@ algebraic structures on `ℍ[R]`. [quaternion algebra](https://en.wikipedia.org/wiki/Quaternion_algebra) with coefficients `a`, `b` * `quaternion R`, `ℍ[R]` : the space of quaternions, a.k.a. `quaternion_algebra R (-1) (-1)`; * `quaternion.norm_sq` : square of the norm of a quaternion; -* `quaternion.conj` : conjugate of a quaternion; +* `quaternion.star_ring` : provides the conjugate of a quaternion as `has_star.star`; We also define the following algebraic structures on `ℍ[R]`: @@ -52,7 +58,8 @@ Implemented as a structure with four fields: `re`, `im_i`, `im_j`, and `im_k`. - structure quaternion_algebra (R : Type*) (a b : R) := mk {} :: (re : R) (im_i : R) (im_j : R) (im_k : R) -localized "notation `ℍ[` R`,` a`,` b `]` := quaternion_algebra R a b" in quaternion +localized "notation (name := quaternion_algebra) `ℍ[` R`,` a`,` b `]` := + quaternion_algebra R a b" in quaternion namespace quaternion_algebra @@ -64,17 +71,37 @@ def equiv_prod {R : Type*} (c₁ c₂ : R) : ℍ[R, c₁, c₂] ≃ R × R × R left_inv := λ ⟨a₁, a₂, a₃, a₄⟩, rfl, right_inv := λ ⟨a₁, a₂, a₃, a₄⟩, rfl } +/-- The equivalence between a quaternion algebra over `R` and `fin 4 → R`. -/ +@[simps symm_apply] +def equiv_tuple {R : Type*} (c₁ c₂ : R) : ℍ[R, c₁, c₂] ≃ (fin 4 → R) := +{ to_fun := λ a, ![a.1, a.2, a.3, a.4], + inv_fun := λ a, ⟨a 0, a 1, a 2, a 3⟩, + left_inv := λ ⟨a₁, a₂, a₃, a₄⟩, rfl, + right_inv := λ f, by ext ⟨_, _|_|_|_|_|⟨⟩⟩; refl } + +@[simp] lemma equiv_tuple_apply {R : Type*} (c₁ c₂ : R) (x : ℍ[R, c₁, c₂]) : + equiv_tuple c₁ c₂ x = ![x.re, x.im_i, x.im_j, x.im_k] := rfl + @[simp] lemma mk.eta {R : Type*} {c₁ c₂} : ∀ a : ℍ[R, c₁, c₂], mk a.1 a.2 a.3 a.4 = a | ⟨a₁, a₂, a₃, a₄⟩ := rfl -variables {R : Type*} [comm_ring R] {c₁ c₂ : R} (r x y z : R) (a b c : ℍ[R, c₁, c₂]) +variables {S T R : Type*} [comm_ring R] {c₁ c₂ : R} (r x y z : R) (a b c : ℍ[R, c₁, c₂]) + +/-- The imaginary part of a quaternion. -/ +def im (x : ℍ[R, c₁, c₂]) : ℍ[R, c₁, c₂] := ⟨0, x.im_i, x.im_j, x.im_k⟩ + +@[simp] lemma im_re : a.im.re = 0 := rfl +@[simp] lemma im_im_i : a.im.im_i = a.im_i := rfl +@[simp] lemma im_im_j : a.im.im_j = a.im_j := rfl +@[simp] lemma im_im_k : a.im.im_k = a.im_k := rfl +@[simp] lemma im_idem : a.im.im = a.im := rfl instance : has_coe_t R (ℍ[R, c₁, c₂]) := ⟨λ x, ⟨x, 0, 0, 0⟩⟩ -@[simp] lemma coe_re : (x : ℍ[R, c₁, c₂]).re = x := rfl -@[simp] lemma coe_im_i : (x : ℍ[R, c₁, c₂]).im_i = 0 := rfl -@[simp] lemma coe_im_j : (x : ℍ[R, c₁, c₂]).im_j = 0 := rfl -@[simp] lemma coe_im_k : (x : ℍ[R, c₁, c₂]).im_k = 0 := rfl +@[simp, norm_cast] lemma coe_re : (x : ℍ[R, c₁, c₂]).re = x := rfl +@[simp, norm_cast] lemma coe_im_i : (x : ℍ[R, c₁, c₂]).im_i = 0 := rfl +@[simp, norm_cast] lemma coe_im_j : (x : ℍ[R, c₁, c₂]).im_j = 0 := rfl +@[simp, norm_cast] lemma coe_im_k : (x : ℍ[R, c₁, c₂]).im_k = 0 := rfl lemma coe_injective : function.injective (coe : R → ℍ[R, c₁, c₂]) := λ x y h, congr_arg re h @@ -98,11 +125,17 @@ instance : inhabited ℍ[R, c₁, c₂] := ⟨0⟩ (mk a₁ a₂ a₃ a₄ : ℍ[R, c₁, c₂]) + mk b₁ b₂ b₃ b₄ = mk (a₁ + b₁) (a₂ + b₂) (a₃ + b₃) (a₄ + b₄) := rfl +@[norm_cast, simp] lemma coe_add : ((x + y : R) : ℍ[R, c₁, c₂]) = x + y := +by ext; simp + @[simps] instance : has_neg ℍ[R, c₁, c₂] := ⟨λ a, ⟨-a.1, -a.2, -a.3, -a.4⟩⟩ @[simp] lemma neg_mk (a₁ a₂ a₃ a₄ : R) : -(mk a₁ a₂ a₃ a₄ : ℍ[R, c₁, c₂]) = ⟨-a₁, -a₂, -a₃, -a₄⟩ := rfl +@[norm_cast, simp] lemma coe_neg : ((-x : R) : ℍ[R, c₁, c₂]) = -x := +by ext; simp + @[simps] instance : has_sub ℍ[R, c₁, c₂] := ⟨λ a b, ⟨a.1 - b.1, a.2 - b.2, a.3 - b.3, a.4 - b.4⟩⟩ @@ -110,6 +143,17 @@ rfl (mk a₁ a₂ a₃ a₄ : ℍ[R, c₁, c₂]) - mk b₁ b₂ b₃ b₄ = mk (a₁ - b₁) (a₂ - b₂) (a₃ - b₃) (a₄ - b₄) := rfl +@[simp, norm_cast] lemma coe_im : (x : ℍ[R, c₁, c₂]).im = 0 := rfl + +@[simp] lemma re_add_im : ↑a.re + a.im = a := +ext _ _ (add_zero _) (zero_add _) (zero_add _) (zero_add _) + +@[simp] lemma sub_self_im : a - a.im = a.re := +ext _ _ (sub_zero _) (sub_self _) (sub_self _) (sub_self _) + +@[simp] lemma sub_self_re : a - a.re = a.im := +ext _ _ (sub_self _) (sub_zero _) (sub_zero _) (sub_zero _) + /-- Multiplication is given by * `1 * x = x * 1 = x`; @@ -132,41 +176,102 @@ rfl a₁ * b₃ + c₁ * a₂ * b₄ + a₃ * b₁ - c₁ * a₄ * b₂, a₁ * b₄ + a₂ * b₃ - a₃ * b₂ + a₄ * b₁⟩ := rfl -instance : ring ℍ[R, c₁, c₂] := +section +variables [has_smul S R] [has_smul T R] (s : S) + +/- +The `ring R` argument is not used, but it's also much stronger than the other definitions in this +file need; for instance `quaternion_algebra.has_zero` only really needs `has_zero R`. For +simplicity we just keep things consistent. +-/ +@[nolint unused_arguments] +instance : has_smul S ℍ[R, c₁, c₂] := +{ smul := λ s a, ⟨s • a.1, s • a.2, s • a.3, s • a.4⟩ } + +instance [has_smul S T] [is_scalar_tower S T R] : is_scalar_tower S T ℍ[R, c₁, c₂] := +{ smul_assoc := λ s t x, by ext; exact smul_assoc _ _ _ } + +instance [smul_comm_class S T R] : smul_comm_class S T ℍ[R, c₁, c₂] := +{ smul_comm := λ s t x, by ext; exact smul_comm _ _ _ } + +@[simp] lemma smul_re : (s • a).re = s • a.re := rfl +@[simp] lemma smul_im_i : (s • a).im_i = s • a.im_i := rfl +@[simp] lemma smul_im_j : (s • a).im_j = s • a.im_j := rfl +@[simp] lemma smul_im_k : (s • a).im_k = s • a.im_k := rfl + +@[simp] lemma smul_mk (re im_i im_j im_k : R) : + s • (⟨re, im_i, im_j, im_k⟩ : ℍ[R, c₁, c₂]) = ⟨s • re, s • im_i, s • im_j, s • im_k⟩ := rfl + +end + +@[simp, norm_cast] lemma coe_smul [smul_zero_class S R] (s : S) (r : R) : + (↑(s • r) : ℍ[R, c₁, c₂]) = s • ↑r := +ext _ _ rfl (smul_zero s).symm (smul_zero s).symm (smul_zero s).symm + +instance : add_comm_group ℍ[R, c₁, c₂] := by refine_struct { add := (+), - zero := (0 : ℍ[R, c₁, c₂]), neg := has_neg.neg, sub := has_sub.sub, + zero := (0 : ℍ[R, c₁, c₂]), + nsmul := (•), + zsmul := (•), }; + intros; try { refl }; ext; simp; ring_exp + +instance : add_group_with_one ℍ[R, c₁, c₂] := +{ nat_cast := λ n, ((n : R) : ℍ[R, c₁, c₂]), + nat_cast_zero := by simp, + nat_cast_succ := by simp, + int_cast := λ n, ((n : R) : ℍ[R, c₁, c₂]), + int_cast_of_nat := λ _, congr_arg coe (int.cast_of_nat _), + int_cast_neg_succ_of_nat := λ n, + show ↑↑_ = -↑↑_, by rw [int.cast_neg, int.cast_coe_nat, coe_neg], + one := 1, + .. quaternion_algebra.add_comm_group } + +@[simp, norm_cast] lemma nat_cast_re (n : ℕ) : (n : ℍ[R, c₁, c₂]).re = n := rfl +@[simp, norm_cast] lemma nat_cast_im_i (n : ℕ) : (n : ℍ[R, c₁, c₂]).im_i = 0 := rfl +@[simp, norm_cast] lemma nat_cast_im_j (n : ℕ) : (n : ℍ[R, c₁, c₂]).im_j = 0 := rfl +@[simp, norm_cast] lemma nat_cast_im_k (n : ℕ) : (n : ℍ[R, c₁, c₂]).im_k = 0 := rfl +@[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℍ[R, c₁, c₂]).im = 0 := rfl +@[norm_cast] lemma coe_nat_cast (n : ℕ) : ↑(n : R) = (n : ℍ[R, c₁, c₂]) := rfl + +@[simp, norm_cast] lemma int_cast_re (z : ℤ) : (z : ℍ[R, c₁, c₂]).re = z := rfl +@[simp, norm_cast] lemma int_cast_im_i (z : ℤ) : (z : ℍ[R, c₁, c₂]).im_i = 0 := rfl +@[simp, norm_cast] lemma int_cast_im_j (z : ℤ) : (z : ℍ[R, c₁, c₂]).im_j = 0 := rfl +@[simp, norm_cast] lemma int_cast_im_k (z : ℤ) : (z : ℍ[R, c₁, c₂]).im_k = 0 := rfl +@[simp, norm_cast] lemma int_cast_im (z : ℤ) : (z : ℍ[R, c₁, c₂]).im = 0 := rfl +@[norm_cast] lemma coe_int_cast (z : ℤ) : ↑(z : R) = (z : ℍ[R, c₁, c₂]) := rfl + +instance : ring ℍ[R, c₁, c₂] := +by refine_struct + { add := (+), mul := (*), one := 1, - nsmul := @nsmul_rec _ ⟨(0 : ℍ[R, c₁, c₂])⟩ ⟨(+)⟩, - zsmul := @zsmul_rec _ ⟨(0 : ℍ[R, c₁, c₂])⟩ ⟨(+)⟩ ⟨has_neg.neg⟩, - npow := @npow_rec _ ⟨(1 : ℍ[R, c₁, c₂])⟩ ⟨(*)⟩ }; + npow := @npow_rec _ ⟨(1 : ℍ[R, c₁, c₂])⟩ ⟨(*)⟩, + .. quaternion_algebra.add_group_with_one, + .. quaternion_algebra.add_comm_group }; intros; try { refl }; ext; simp; ring_exp -instance : algebra R ℍ[R, c₁, c₂] := -{ smul := λ r a, ⟨r * a.1, r * a.2, r * a.3, r * a.4⟩, - to_fun := coe, - map_one' := rfl, - map_zero' := rfl, - map_mul' := λ x y, by ext; simp, - map_add' := λ x y, by ext; simp, - smul_def' := λ r x, by ext; simp, - commutes' := λ r x, by ext; simp [mul_comm] } - -@[simp] lemma smul_re : (r • a).re = r • a.re := rfl -@[simp] lemma smul_im_i : (r • a).im_i = r • a.im_i := rfl -@[simp] lemma smul_im_j : (r • a).im_j = r • a.im_j := rfl -@[simp] lemma smul_im_k : (r • a).im_k = r • a.im_k := rfl - -@[simp] lemma smul_mk (re im_i im_j im_k : R) : - r • (⟨re, im_i, im_j, im_k⟩ : ℍ[R, c₁, c₂]) = ⟨r • re, r • im_i, r • im_j, r • im_k⟩ := rfl +@[norm_cast, simp] lemma coe_mul : ((x * y : R) : ℍ[R, c₁, c₂]) = x * y := +by ext; simp + +-- TODO: add weaker `mul_action`, `distrib_mul_action`, and `module` instances (and repeat them +-- for `ℍ[R]`) +instance [comm_semiring S] [algebra S R] : algebra S ℍ[R, c₁, c₂] := +{ smul := (•), + to_fun := λ s, coe (algebra_map S R s), + map_one' := by simpa only [map_one], + map_zero' := by simpa only [map_zero], + map_mul' := λ x y, by rw [map_mul, coe_mul], + map_add' := λ x y, by rw [map_add, coe_add], + smul_def' := λ s x, by ext; simp [algebra.smul_def], + commutes' := λ s x, by ext; simp [algebra.commutes] } lemma algebra_map_eq (r : R) : algebra_map R ℍ[R,c₁,c₂] r = ⟨r, 0, 0, 0⟩ := rfl section -variables (R c₁ c₂) +variables (c₁ c₂) /-- `quaternion_algebra.re` as a `linear_map`-/ @[simps] def re_lm : ℍ[R, c₁, c₂] →ₗ[R] R := @@ -184,19 +289,44 @@ variables (R c₁ c₂) @[simps] def im_k_lm : ℍ[R, c₁, c₂] →ₗ[R] R := { to_fun := im_k, map_add' := λ x y, rfl, map_smul' := λ r x, rfl } -end +/-- `quaternion_algebra.equiv_tuple` as a linear equivalence. -/ +def linear_equiv_tuple : ℍ[R,c₁,c₂] ≃ₗ[R] (fin 4 → R) := +linear_equiv.symm -- proofs are not `rfl` in the forward direction + { to_fun := (equiv_tuple c₁ c₂).symm, + inv_fun := equiv_tuple c₁ c₂, + map_add' := λ v₁ v₂, rfl, + map_smul' := λ v₁ v₂, rfl, + .. (equiv_tuple c₁ c₂).symm } -@[norm_cast, simp] lemma coe_add : ((x + y : R) : ℍ[R, c₁, c₂]) = x + y := -(algebra_map R ℍ[R, c₁, c₂]).map_add x y +@[simp] lemma coe_linear_equiv_tuple : ⇑(linear_equiv_tuple c₁ c₂) = equiv_tuple c₁ c₂ := rfl +@[simp] lemma coe_linear_equiv_tuple_symm : + ⇑(linear_equiv_tuple c₁ c₂).symm = (equiv_tuple c₁ c₂).symm := rfl + +/-- `ℍ[R, c₁, c₂]` has a basis over `R` given by `1`, `i`, `j`, and `k`. -/ +noncomputable def basis_one_i_j_k : basis (fin 4) R ℍ[R, c₁, c₂] := +basis.of_equiv_fun $ linear_equiv_tuple c₁ c₂ + +@[simp] lemma coe_basis_one_i_j_k_repr (q : ℍ[R, c₁, c₂]) : + ⇑((basis_one_i_j_k c₁ c₂).repr q) = ![q.re, q.im_i, q.im_j, q.im_k] := rfl + +instance : module.finite R ℍ[R, c₁, c₂] := module.finite.of_basis (basis_one_i_j_k c₁ c₂) +instance : module.free R ℍ[R, c₁, c₂] := module.free.of_basis (basis_one_i_j_k c₁ c₂) + +lemma rank_eq_four [strong_rank_condition R] : module.rank R ℍ[R, c₁, c₂] = 4 := +by { rw [rank_eq_card_basis (basis_one_i_j_k c₁ c₂), fintype.card_fin], norm_num } + +lemma finrank_eq_four [strong_rank_condition R] : finite_dimensional.finrank R ℍ[R, c₁, c₂] = 4 := +have cardinal.to_nat 4 = 4, + by rw [←cardinal.to_nat_cast 4, nat.cast_bit0, nat.cast_bit0, nat.cast_one], +by rw [finite_dimensional.finrank, rank_eq_four, this] + +end @[norm_cast, simp] lemma coe_sub : ((x - y : R) : ℍ[R, c₁, c₂]) = x - y := (algebra_map R ℍ[R, c₁, c₂]).map_sub x y -@[norm_cast, simp] lemma coe_neg : ((-x : R) : ℍ[R, c₁, c₂]) = -x := -(algebra_map R ℍ[R, c₁, c₂]).map_neg x - -@[norm_cast, simp] lemma coe_mul : ((x * y : R) : ℍ[R, c₁, c₂]) = x * y := -(algebra_map R ℍ[R, c₁, c₂]).map_mul x y +@[norm_cast, simp] lemma coe_pow (n : ℕ) : (↑(x ^ n) : ℍ[R, c₁, c₂]) = ↑x ^ n := +(algebra_map R ℍ[R, c₁, c₂]).map_pow x n lemma coe_commutes : ↑r * a = a * r := algebra.commutes r a @@ -212,64 +342,47 @@ by rw [← coe_commutes, coe_mul_eq_smul] lemma smul_coe : x • (y : ℍ[R, c₁, c₂]) = ↑(x * y) := by rw [coe_mul, coe_mul_eq_smul] /-- Quaternion conjugate. -/ -def conj : ℍ[R, c₁, c₂] ≃ₗ[R] ℍ[R, c₁, c₂] := -linear_equiv.of_involutive -{ to_fun := λ a, ⟨a.1, -a.2, -a.3, -a.4⟩, - map_add' := λ a b, by ext; simp [neg_add], - map_smul' := λ r a, by ext; simp } $ -λ a, by simp - -@[simp] lemma re_conj : (conj a).re = a.re := rfl -@[simp] lemma im_i_conj : (conj a).im_i = - a.im_i := rfl -@[simp] lemma im_j_conj : (conj a).im_j = - a.im_j := rfl -@[simp] lemma im_k_conj : (conj a).im_k = - a.im_k := rfl - -@[simp] lemma conj_mk (a₁ a₂ a₃ a₄ : R) : - conj (mk a₁ a₂ a₃ a₄ : ℍ[R, c₁, c₂]) = ⟨a₁, -a₂, -a₃, -a₄⟩ := -rfl - -@[simp] lemma conj_conj : a.conj.conj = a := ext _ _ rfl (neg_neg _) (neg_neg _) (neg_neg _) +instance : has_star ℍ[R, c₁, c₂] := +{ star := λ a, ⟨a.1, -a.2, -a.3, -a.4⟩ } -lemma conj_add : (a + b).conj = a.conj + b.conj := conj.map_add a b +@[simp] lemma re_star : (star a).re = a.re := rfl +@[simp] lemma im_i_star : (star a).im_i = - a.im_i := rfl +@[simp] lemma im_j_star : (star a).im_j = - a.im_j := rfl +@[simp] lemma im_k_star : (star a).im_k = - a.im_k := rfl +@[simp] lemma im_star : (star a).im = - a.im := ext _ _ neg_zero.symm rfl rfl rfl -@[simp] lemma conj_mul : (a * b).conj = b.conj * a.conj := by ext; simp; ring_exp - -lemma conj_conj_mul : (a.conj * b).conj = b.conj * a := -by rw [conj_mul, conj_conj] +@[simp] lemma star_mk (a₁ a₂ a₃ a₄ : R) : + star (mk a₁ a₂ a₃ a₄ : ℍ[R, c₁, c₂]) = ⟨a₁, -a₂, -a₃, -a₄⟩ := +rfl -lemma conj_mul_conj : (a * b.conj).conj = b * a.conj := -by rw [conj_mul, conj_conj] +instance : star_ring ℍ[R, c₁, c₂] := +{ star_involutive := λ x, by simp [has_star.star], + star_add := λ a b, by ext; simp [neg_add], + star_mul := λ a b, by ext; simp; ring_exp } -lemma self_add_conj' : a + a.conj = ↑(2 * a.re) := by ext; simp [two_mul] +lemma self_add_star' : a + star a = ↑(2 * a.re) := by ext; simp [two_mul] -lemma self_add_conj : a + a.conj = 2 * a.re := -by simp only [self_add_conj', two_mul, coe_add] +lemma self_add_star : a + star a = 2 * a.re := +by simp only [self_add_star', two_mul, coe_add] -lemma conj_add_self' : a.conj + a = ↑(2 * a.re) := by rw [add_comm, self_add_conj'] +lemma star_add_self' : star a + a = ↑(2 * a.re) := by rw [add_comm, self_add_star'] -lemma conj_add_self : a.conj + a = 2 * a.re := by rw [add_comm, self_add_conj] +lemma star_add_self : star a + a = 2 * a.re := by rw [add_comm, self_add_star] -lemma conj_eq_two_re_sub : a.conj = ↑(2 * a.re) - a := eq_sub_iff_add_eq.2 a.conj_add_self' +lemma star_eq_two_re_sub : star a = ↑(2 * a.re) - a := eq_sub_iff_add_eq.2 a.star_add_self' -lemma commute_conj_self : commute a.conj a := -begin - rw [a.conj_eq_two_re_sub], +instance : is_star_normal a := ⟨begin + rw [a.star_eq_two_re_sub], exact (coe_commute (2 * a.re) a).sub_left (commute.refl a) -end - -lemma commute_self_conj : commute a a.conj := -a.commute_conj_self.symm - -lemma commute_conj_conj {a b : ℍ[R, c₁, c₂]} (h : commute a b) : commute a.conj b.conj := -calc a.conj * b.conj = (b * a).conj : (conj_mul b a).symm - ... = (a * b).conj : by rw h.eq - ... = b.conj * a.conj : conj_mul a b +end⟩ -@[simp] lemma conj_coe : conj (x : ℍ[R, c₁, c₂]) = x := by ext; simp +@[simp, norm_cast] lemma star_coe : star (x : ℍ[R, c₁, c₂]) = x := by ext; simp -lemma conj_smul : conj (r • a) = r • conj a := conj.map_smul r a +@[simp] lemma star_im : star a.im = - a.im := im_star _ -@[simp] lemma conj_one : conj (1 : ℍ[R, c₁, c₂]) = 1 := conj_coe 1 +@[simp] lemma star_smul [monoid S] [distrib_mul_action S R] (s : S) (a : ℍ[R, c₁, c₂]) : + star (s • a) = s • star a := +ext _ _ rfl (smul_neg _ _).symm (smul_neg _ _).symm (smul_neg _ _).symm lemma eq_re_of_eq_coe {a : ℍ[R, c₁, c₂]} {x : R} (h : a = x) : a = a.re := by rw [h, coe_re] @@ -278,44 +391,37 @@ lemma eq_re_iff_mem_range_coe {a : ℍ[R, c₁, c₂]} : a = a.re ↔ a ∈ set.range (coe : R → ℍ[R, c₁, c₂]) := ⟨λ h, ⟨a.re, h.symm⟩, λ ⟨x, h⟩, eq_re_of_eq_coe h.symm⟩ +section char_zero +variables [no_zero_divisors R] [char_zero R] + @[simp] -lemma conj_fixed {R : Type*} [comm_ring R] [no_zero_divisors R] [char_zero R] - {c₁ c₂ : R} {a : ℍ[R, c₁, c₂]} : - conj a = a ↔ a = a.re := +lemma star_eq_self {c₁ c₂ : R} {a : ℍ[R, c₁, c₂]} : + star a = a ↔ a = a.re := by simp [ext_iff, neg_eq_iff_add_eq_zero, add_self_eq_zero] --- Can't use `rw ← conj_fixed` in the proof without additional assumptions - -lemma conj_mul_eq_coe : conj a * a = (conj a * a).re := by ext; simp; ring_exp +lemma star_eq_neg {c₁ c₂ : R} {a : ℍ[R, c₁, c₂]} : + star a = -a ↔ a.re = 0 := +by simp [ext_iff, eq_neg_iff_add_eq_zero] -lemma mul_conj_eq_coe : a * conj a = (a * conj a).re := -by { rw a.commute_self_conj.eq, exact a.conj_mul_eq_coe } +end char_zero +-- Can't use `rw ← star_eq_self` in the proof without additional assumptions -lemma conj_zero : conj (0 : ℍ[R, c₁, c₂]) = 0 := conj.map_zero +lemma star_mul_eq_coe : star a * a = (star a * a).re := by ext; simp; ring_exp -lemma conj_neg : (-a).conj = -a.conj := (conj : ℍ[R, c₁, c₂] ≃ₗ[R] _).map_neg a - -lemma conj_sub : (a - b).conj = a.conj - b.conj := (conj : ℍ[R, c₁, c₂] ≃ₗ[R] _).map_sub a b - -instance : star_ring ℍ[R, c₁, c₂] := -{ star := conj, - star_involutive := conj_conj, - star_add := conj_add, - star_mul := conj_mul } - -@[simp] lemma star_def (a : ℍ[R, c₁, c₂]) : star a = conj a := rfl +lemma mul_star_eq_coe : a * star a = (a * star a).re := +by { rw ←star_comm_self', exact a.star_mul_eq_coe } open mul_opposite /-- Quaternion conjugate as an `alg_equiv` to the opposite ring. -/ -def conj_ae : ℍ[R, c₁, c₂] ≃ₐ[R] (ℍ[R, c₁, c₂]ᵐᵒᵖ) := -{ to_fun := op ∘ conj, - inv_fun := conj ∘ unop, +def star_ae : ℍ[R, c₁, c₂] ≃ₐ[R] (ℍ[R, c₁, c₂]ᵐᵒᵖ) := +{ to_fun := op ∘ star, + inv_fun := star ∘ unop, map_mul' := λ x y, by simp, commutes' := λ r, by simp, - .. conj.to_add_equiv.trans op_add_equiv } + .. star_add_equiv.trans op_add_equiv } -@[simp] lemma coe_conj_ae : ⇑(conj_ae : ℍ[R, c₁, c₂] ≃ₐ[R] _) = op ∘ conj := rfl +@[simp] lemma coe_star_ae : ⇑(star_ae : ℍ[R, c₁, c₂] ≃ₐ[R] _) = op ∘ star := rfl end quaternion_algebra @@ -323,22 +429,36 @@ end quaternion_algebra `re`, `im_i`, `im_j`, and `im_k`. -/ def quaternion (R : Type*) [has_one R] [has_neg R] := quaternion_algebra R (-1) (-1) -localized "notation `ℍ[` R `]` := quaternion R" in quaternion +localized "notation (name := quaternion) `ℍ[` R `]` := quaternion R" in quaternion -/-- The equivalence between the quaternions over R and R × R × R × R. -/ +/-- The equivalence between the quaternions over `R` and `R × R × R × R`. -/ +@[simps] def quaternion.equiv_prod (R : Type*) [has_one R] [has_neg R] : ℍ[R] ≃ R × R × R × R := quaternion_algebra.equiv_prod _ _ +/-- The equivalence between the quaternions over `R` and `fin 4 → R`. -/ +@[simps symm_apply] +def quaternion.equiv_tuple (R : Type*) [has_one R] [has_neg R] : ℍ[R] ≃ (fin 4 → R) := +quaternion_algebra.equiv_tuple _ _ + +@[simp] lemma quaternion.equiv_tuple_apply (R : Type*) [has_one R] [has_neg R] (x : ℍ[R]) : + quaternion.equiv_tuple R x = ![x.re, x.im_i, x.im_j, x.im_k] := rfl + namespace quaternion -variables {R : Type*} [comm_ring R] (r x y z : R) (a b c : ℍ[R]) +variables {S T R : Type*} [comm_ring R] (r x y z : R) (a b c : ℍ[R]) export quaternion_algebra (re im_i im_j im_k) instance : has_coe_t R ℍ[R] := quaternion_algebra.has_coe_t instance : ring ℍ[R] := quaternion_algebra.ring instance : inhabited ℍ[R] := quaternion_algebra.inhabited -instance : algebra R ℍ[R] := quaternion_algebra.algebra +instance [has_smul S R] : has_smul S ℍ[R] := quaternion_algebra.has_smul +instance [has_smul S T] [has_smul S R] [has_smul T R] [is_scalar_tower S T R] : + is_scalar_tower S T ℍ[R] := quaternion_algebra.is_scalar_tower +instance [has_smul S R] [has_smul T R] [smul_comm_class S T R] : + smul_comm_class S T ℍ[R] := quaternion_algebra.smul_comm_class +instance [comm_semiring S] [algebra S R] : algebra S ℍ[R] := quaternion_algebra.algebra instance : star_ring ℍ[R] := quaternion_algebra.star_ring @[ext] lemma ext : a.re = b.re → a.im_i = b.im_i → a.im_j = b.im_j → a.im_k = b.im_k → a = b := @@ -348,39 +468,58 @@ lemma ext_iff {a b : ℍ[R]} : a = b ↔ a.re = b.re ∧ a.im_i = b.im_i ∧ a.im_j = b.im_j ∧ a.im_k = b.im_k := quaternion_algebra.ext_iff a b +/-- The imaginary part of a quaternion. -/ +def im (x : ℍ[R]) : ℍ[R] := x.im + +@[simp] lemma im_re : a.im.re = 0 := rfl +@[simp] lemma im_im_i : a.im.im_i = a.im_i := rfl +@[simp] lemma im_im_j : a.im.im_j = a.im_j := rfl +@[simp] lemma im_im_k : a.im.im_k = a.im_k := rfl +@[simp] lemma im_idem : a.im.im = a.im := rfl + +@[simp] lemma re_add_im : ↑a.re + a.im = a := a.re_add_im +@[simp] lemma sub_self_im : a - a.im = a.re := a.sub_self_im +@[simp] lemma sub_self_re : a - a.re = a.im := a.sub_self_re + @[simp, norm_cast] lemma coe_re : (x : ℍ[R]).re = x := rfl @[simp, norm_cast] lemma coe_im_i : (x : ℍ[R]).im_i = 0 := rfl @[simp, norm_cast] lemma coe_im_j : (x : ℍ[R]).im_j = 0 := rfl @[simp, norm_cast] lemma coe_im_k : (x : ℍ[R]).im_k = 0 := rfl +@[simp, norm_cast] lemma coe_im : (x : ℍ[R]).im = 0 := rfl @[simp] lemma zero_re : (0 : ℍ[R]).re = 0 := rfl @[simp] lemma zero_im_i : (0 : ℍ[R]).im_i = 0 := rfl @[simp] lemma zero_im_j : (0 : ℍ[R]).im_j = 0 := rfl @[simp] lemma zero_im_k : (0 : ℍ[R]).im_k = 0 := rfl +@[simp] lemma zero_im : (0 : ℍ[R]).im = 0 := rfl @[simp, norm_cast] lemma coe_zero : ((0 : R) : ℍ[R]) = 0 := rfl @[simp] lemma one_re : (1 : ℍ[R]).re = 1 := rfl @[simp] lemma one_im_i : (1 : ℍ[R]).im_i = 0 := rfl @[simp] lemma one_im_j : (1 : ℍ[R]).im_j = 0 := rfl @[simp] lemma one_im_k : (1 : ℍ[R]).im_k = 0 := rfl +@[simp] lemma one_im : (1 : ℍ[R]).im = 0 := rfl @[simp, norm_cast] lemma coe_one : ((1 : R) : ℍ[R]) = 1 := rfl @[simp] lemma add_re : (a + b).re = a.re + b.re := rfl @[simp] lemma add_im_i : (a + b).im_i = a.im_i + b.im_i := rfl @[simp] lemma add_im_j : (a + b).im_j = a.im_j + b.im_j := rfl @[simp] lemma add_im_k : (a + b).im_k = a.im_k + b.im_k := rfl +@[simp] lemma add_im : (a + b).im = a.im + b.im := ext _ _ (add_zero _).symm rfl rfl rfl @[simp, norm_cast] lemma coe_add : ((x + y : R) : ℍ[R]) = x + y := quaternion_algebra.coe_add x y @[simp] lemma neg_re : (-a).re = -a.re := rfl @[simp] lemma neg_im_i : (-a).im_i = -a.im_i := rfl @[simp] lemma neg_im_j : (-a).im_j = -a.im_j := rfl @[simp] lemma neg_im_k : (-a).im_k = -a.im_k := rfl +@[simp] lemma neg_im : (-a).im = -a.im := ext _ _ neg_zero.symm rfl rfl rfl @[simp, norm_cast] lemma coe_neg : ((-x : R) : ℍ[R]) = -x := quaternion_algebra.coe_neg x @[simp] lemma sub_re : (a - b).re = a.re - b.re := rfl @[simp] lemma sub_im_i : (a - b).im_i = a.im_i - b.im_i := rfl @[simp] lemma sub_im_j : (a - b).im_j = a.im_j - b.im_j := rfl @[simp] lemma sub_im_k : (a - b).im_k = a.im_k - b.im_k := rfl +@[simp] lemma sub_im : (a - b).im = a.im - b.im := ext _ _ (sub_zero _).symm rfl rfl rfl @[simp, norm_cast] lemma coe_sub : ((x - y : R) : ℍ[R]) = x - y := quaternion_algebra.coe_sub x y @[simp] lemma mul_re : @@ -405,14 +544,37 @@ quaternion_algebra.ext_iff a b @[simp, norm_cast] lemma coe_mul : ((x * y : R) : ℍ[R]) = x * y := quaternion_algebra.coe_mul x y +@[norm_cast, simp] lemma coe_pow (n : ℕ) : (↑(x ^ n) : ℍ[R]) = ↑x ^ n := +quaternion_algebra.coe_pow x n + +@[simp, norm_cast] lemma nat_cast_re (n : ℕ) : (n : ℍ[R]).re = n := rfl +@[simp, norm_cast] lemma nat_cast_im_i (n : ℕ) : (n : ℍ[R]).im_i = 0 := rfl +@[simp, norm_cast] lemma nat_cast_im_j (n : ℕ) : (n : ℍ[R]).im_j = 0 := rfl +@[simp, norm_cast] lemma nat_cast_im_k (n : ℕ) : (n : ℍ[R]).im_k = 0 := rfl +@[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℍ[R]).im = 0 := rfl +@[norm_cast] lemma coe_nat_cast (n : ℕ) : ↑(n : R) = (n : ℍ[R]) := rfl + +@[simp, norm_cast] lemma int_cast_re (z : ℤ) : (z : ℍ[R]).re = z := rfl +@[simp, norm_cast] lemma int_cast_im_i (z : ℤ) : (z : ℍ[R]).im_i = 0 := rfl +@[simp, norm_cast] lemma int_cast_im_j (z : ℤ) : (z : ℍ[R]).im_j = 0 := rfl +@[simp, norm_cast] lemma int_cast_im_k (z : ℤ) : (z : ℍ[R]).im_k = 0 := rfl +@[simp, norm_cast] lemma int_cast_im (z : ℤ) : (z : ℍ[R]).im = 0 := rfl +@[norm_cast] lemma coe_int_cast (z : ℤ) : ↑(z : R) = (z : ℍ[R]) := rfl + lemma coe_injective : function.injective (coe : R → ℍ[R]) := quaternion_algebra.coe_injective @[simp] lemma coe_inj {x y : R} : (x : ℍ[R]) = y ↔ x = y := coe_injective.eq_iff -@[simp] lemma smul_re : (r • a).re = r • a.re := rfl -@[simp] lemma smul_im_i : (r • a).im_i = r • a.im_i := rfl -@[simp] lemma smul_im_j : (r • a).im_j = r • a.im_j := rfl -@[simp] lemma smul_im_k : (r • a).im_k = r • a.im_k := rfl +@[simp] lemma smul_re [has_smul S R] (s : S) : (s • a).re = s • a.re := rfl +@[simp] lemma smul_im_i [has_smul S R] (s : S) : (s • a).im_i = s • a.im_i := rfl +@[simp] lemma smul_im_j [has_smul S R] (s : S) : (s • a).im_j = s • a.im_j := rfl +@[simp] lemma smul_im_k [has_smul S R] (s : S) : (s • a).im_k = s • a.im_k := rfl +@[simp] lemma smul_im [smul_zero_class S R] (s : S) : (s • a).im = s • a.im := +ext _ _ (smul_zero _).symm rfl rfl rfl + +@[simp, norm_cast] lemma coe_smul [smul_zero_class S R] (s : S) (r : R) : + (↑(s • r) : ℍ[R]) = s • ↑r := +quaternion_algebra.coe_smul _ _ lemma coe_commutes : ↑r * a = a * r := quaternion_algebra.coe_commutes r a @@ -426,48 +588,36 @@ lemma mul_coe_eq_smul : a * r = r • a := quaternion_algebra.mul_coe_eq_smul r lemma smul_coe : x • (y : ℍ[R]) = ↑(x * y) := quaternion_algebra.smul_coe x y -/-- Quaternion conjugate. -/ -def conj : ℍ[R] ≃ₗ[R] ℍ[R] := quaternion_algebra.conj - -@[simp] lemma conj_re : a.conj.re = a.re := rfl -@[simp] lemma conj_im_i : a.conj.im_i = - a.im_i := rfl -@[simp] lemma conj_im_j : a.conj.im_j = - a.im_j := rfl -@[simp] lemma conj_im_k : a.conj.im_k = - a.im_k := rfl - -@[simp] lemma conj_conj : a.conj.conj = a := a.conj_conj - -@[simp] lemma conj_add : (a + b).conj = a.conj + b.conj := a.conj_add b +instance : module.finite R ℍ[R] := quaternion_algebra.module.finite _ _ +instance : module.free R ℍ[R] := quaternion_algebra.module.free _ _ -@[simp] lemma conj_mul : (a * b).conj = b.conj * a.conj := a.conj_mul b +lemma rank_eq_four [strong_rank_condition R] : module.rank R ℍ[R] = 4 := +quaternion_algebra.rank_eq_four _ _ -lemma conj_conj_mul : (a.conj * b).conj = b.conj * a := a.conj_conj_mul b +lemma finrank_eq_four [strong_rank_condition R] : finite_dimensional.finrank R ℍ[R] = 4 := +quaternion_algebra.finrank_eq_four _ _ -lemma conj_mul_conj : (a * b.conj).conj = b * a.conj := a.conj_mul_conj b +@[simp] lemma star_re : (star a).re = a.re := rfl +@[simp] lemma star_im_i : (star a).im_i = - a.im_i := rfl +@[simp] lemma star_im_j : (star a).im_j = - a.im_j := rfl +@[simp] lemma star_im_k : (star a).im_k = - a.im_k := rfl +@[simp] lemma star_im : (star a).im = - a.im := a.im_star -lemma self_add_conj' : a + a.conj = ↑(2 * a.re) := a.self_add_conj' +lemma self_add_star' : a + star a = ↑(2 * a.re) := a.self_add_star' -lemma self_add_conj : a + a.conj = 2 * a.re := a.self_add_conj +lemma self_add_star : a + star a = 2 * a.re := a.self_add_star -lemma conj_add_self' : a.conj + a = ↑(2 * a.re) := a.conj_add_self' +lemma star_add_self' : star a + a = ↑(2 * a.re) := a.star_add_self' -lemma conj_add_self : a.conj + a = 2 * a.re := a.conj_add_self +lemma star_add_self : star a + a = 2 * a.re := a.star_add_self -lemma conj_eq_two_re_sub : a.conj = ↑(2 * a.re) - a := a.conj_eq_two_re_sub +lemma star_eq_two_re_sub : star a = ↑(2 * a.re) - a := a.star_eq_two_re_sub -lemma commute_conj_self : commute a.conj a := a.commute_conj_self +@[simp, norm_cast] lemma star_coe : star (x : ℍ[R]) = x := quaternion_algebra.star_coe x +@[simp] lemma im_star : star a.im = - a.im := quaternion_algebra.im_star _ -lemma commute_self_conj : commute a a.conj := a.commute_self_conj - -lemma commute_conj_conj {a b : ℍ[R]} (h : commute a b) : commute a.conj b.conj := -quaternion_algebra.commute_conj_conj h - -alias commute_conj_conj ← commute.quaternion_conj - -@[simp] lemma conj_coe : conj (x : ℍ[R]) = x := quaternion_algebra.conj_coe x - -@[simp] lemma conj_smul : conj (r • a) = r • conj a := a.conj_smul r - -@[simp] lemma conj_one : conj (1 : ℍ[R]) = 1 := conj_coe 1 +@[simp] lemma star_smul [monoid S] [distrib_mul_action S R] (s : S) (a : ℍ[R]) : + star (s • a) = s • star a := quaternion_algebra.star_smul _ _ lemma eq_re_of_eq_coe {a : ℍ[R]} {x : R} (h : a = x) : a = a.re := quaternion_algebra.eq_re_of_eq_coe h @@ -475,54 +625,74 @@ quaternion_algebra.eq_re_of_eq_coe h lemma eq_re_iff_mem_range_coe {a : ℍ[R]} : a = a.re ↔ a ∈ set.range (coe : R → ℍ[R]) := quaternion_algebra.eq_re_iff_mem_range_coe -@[simp] lemma conj_fixed {R : Type*} [comm_ring R] [no_zero_divisors R] [char_zero R] {a : ℍ[R]} : - conj a = a ↔ a = a.re := -quaternion_algebra.conj_fixed +section char_zero +variables [no_zero_divisors R] [char_zero R] -lemma conj_mul_eq_coe : conj a * a = (conj a * a).re := a.conj_mul_eq_coe +@[simp] lemma star_eq_self {a : ℍ[R]} : star a = a ↔ a = a.re := quaternion_algebra.star_eq_self -lemma mul_conj_eq_coe : a * conj a = (a * conj a).re := a.mul_conj_eq_coe +@[simp] lemma star_eq_neg {a : ℍ[R]} : star a = -a ↔ a.re = 0 := quaternion_algebra.star_eq_neg -@[simp] lemma conj_zero : conj (0:ℍ[R]) = 0 := quaternion_algebra.conj_zero +end char_zero -@[simp] lemma conj_neg : (-a).conj = -a.conj := a.conj_neg +lemma star_mul_eq_coe : star a * a = (star a * a).re := a.star_mul_eq_coe -@[simp] lemma conj_sub : (a - b).conj = a.conj - b.conj := a.conj_sub b +lemma mul_star_eq_coe : a * star a = (a * star a).re := a.mul_star_eq_coe open mul_opposite /-- Quaternion conjugate as an `alg_equiv` to the opposite ring. -/ -def conj_ae : ℍ[R] ≃ₐ[R] (ℍ[R]ᵐᵒᵖ) := quaternion_algebra.conj_ae +def star_ae : ℍ[R] ≃ₐ[R] (ℍ[R]ᵐᵒᵖ) := quaternion_algebra.star_ae -@[simp] lemma coe_conj_ae : ⇑(conj_ae : ℍ[R] ≃ₐ[R] ℍ[R]ᵐᵒᵖ) = op ∘ conj := rfl +@[simp] lemma coe_star_ae : ⇑(star_ae : ℍ[R] ≃ₐ[R] ℍ[R]ᵐᵒᵖ) = op ∘ star := rfl /-- Square of the norm. -/ def norm_sq : ℍ[R] →*₀ R := -{ to_fun := λ a, (a * a.conj).re, - map_zero' := by rw [conj_zero, zero_mul, zero_re], - map_one' := by rw [conj_one, one_mul, one_re], - map_mul' := λ x y, coe_injective $ by conv_lhs { rw [← mul_conj_eq_coe, conj_mul, mul_assoc, - ← mul_assoc y, y.mul_conj_eq_coe, coe_commutes, ← mul_assoc, x.mul_conj_eq_coe, ← coe_mul] } } +{ to_fun := λ a, (a * star a).re, + map_zero' := by rw [star_zero, zero_mul, zero_re], + map_one' := by rw [star_one, one_mul, one_re], + map_mul' := λ x y, coe_injective $ by conv_lhs { rw [← mul_star_eq_coe, star_mul, mul_assoc, + ← mul_assoc y, y.mul_star_eq_coe, coe_commutes, ← mul_assoc, x.mul_star_eq_coe, ← coe_mul] } } -lemma norm_sq_def : norm_sq a = (a * a.conj).re := rfl +lemma norm_sq_def : norm_sq a = (a * star a).re := rfl lemma norm_sq_def' : norm_sq a = a.1^2 + a.2^2 + a.3^2 + a.4^2 := by simp only [norm_sq_def, sq, mul_neg, sub_neg_eq_add, - mul_re, conj_re, conj_im_i, conj_im_j, conj_im_k] + mul_re, star_re, star_im_i, star_im_j, star_im_k] lemma norm_sq_coe : norm_sq (x : ℍ[R]) = x^2 := -by rw [norm_sq_def, conj_coe, ← coe_mul, coe_re, sq] +by rw [norm_sq_def, star_coe, ← coe_mul, coe_re, sq] + +@[simp] lemma norm_sq_star : norm_sq (star a) = norm_sq a := by simp [norm_sq_def'] + +@[norm_cast] lemma norm_sq_nat_cast (n : ℕ) : norm_sq (n : ℍ[R]) = n^2 := +by rw [←coe_nat_cast, norm_sq_coe] + +@[norm_cast] lemma norm_sq_int_cast (z : ℤ) : norm_sq (z : ℍ[R]) = z^2 := +by rw [←coe_int_cast, norm_sq_coe] @[simp] lemma norm_sq_neg : norm_sq (-a) = norm_sq a := -by simp only [norm_sq_def, conj_neg, neg_mul_neg] +by simp only [norm_sq_def, star_neg, neg_mul_neg] + +lemma self_mul_star : a * star a = norm_sq a := by rw [mul_star_eq_coe, norm_sq_def] -lemma self_mul_conj : a * a.conj = norm_sq a := by rw [mul_conj_eq_coe, norm_sq_def] +lemma star_mul_self : star a * a = norm_sq a := by rw [star_comm_self', self_mul_star] -lemma conj_mul_self : a.conj * a = norm_sq a := by rw [← a.commute_self_conj.eq, self_mul_conj] +lemma im_sq : a.im^2 = -norm_sq a.im := +by simp_rw [sq, ←star_mul_self, im_star, neg_mul, neg_neg] lemma coe_norm_sq_add : - (norm_sq (a + b) : ℍ[R]) = norm_sq a + a * b.conj + b * a.conj + norm_sq b := -by simp [← self_mul_conj, mul_add, add_mul, add_assoc] + (norm_sq (a + b) : ℍ[R]) = norm_sq a + a * star b + b * star a + norm_sq b := +by simp [← self_mul_star, mul_add, add_mul, add_assoc] + +lemma norm_sq_smul (r : R) (q : ℍ[R]) : norm_sq (r • q) = r^2 * norm_sq q := +by simp_rw [norm_sq_def, star_smul, smul_mul_smul, smul_re, sq, smul_eq_mul] + +lemma norm_sq_add (a b : ℍ[R]) : norm_sq (a + b) = norm_sq a + norm_sq b + 2 * (a * star b).re := +calc norm_sq (a + b) = (norm_sq a + (a * star b).re) + ((b * star a).re + norm_sq b) + : by simp_rw [norm_sq_def, star_add, add_mul, mul_add, add_re] + ... = norm_sq a + norm_sq b + ((a * star b).re + (b * star a).re) : by abel + ... = norm_sq a + norm_sq b + 2 * (a * star b).re + : by rw [←add_re, ←star_mul_star a b, self_add_star', coe_re] end quaternion @@ -553,33 +723,79 @@ by simpa only [le_antisymm_iff, norm_sq_nonneg, and_true] using @norm_sq_eq_zero instance : nontrivial ℍ[R] := { exists_pair_ne := ⟨0, 1, mt (congr_arg re) zero_ne_one⟩, } -instance : is_domain ℍ[R] := +instance : no_zero_divisors ℍ[R] := { eq_zero_or_eq_zero_of_mul_eq_zero := λ a b hab, have norm_sq a * norm_sq b = 0, by rwa [← norm_sq.map_mul, norm_sq_eq_zero], (eq_zero_or_eq_zero_of_mul_eq_zero this).imp norm_sq_eq_zero.1 norm_sq_eq_zero.1, ..quaternion.nontrivial, } +instance : is_domain ℍ[R] := +no_zero_divisors.to_is_domain _ + +lemma sq_eq_norm_sq : a^2 = norm_sq a ↔ a = a.re := +begin + simp_rw [←star_eq_self], + obtain rfl | hq0 := eq_or_ne a 0, + { simp }, + { rw [←star_mul_self, sq, mul_left_inj' hq0, eq_comm] } +end + +lemma sq_eq_neg_norm_sq : a^2 = -norm_sq a ↔ a.re = 0 := +begin + simp_rw [←star_eq_neg], + obtain rfl | hq0 := eq_or_ne a 0, + { simp }, + rw [←star_mul_self, ←mul_neg, ←neg_sq, sq, mul_left_inj' (neg_ne_zero.mpr hq0), eq_comm], +end + end linear_ordered_comm_ring section field variables [linear_ordered_field R] (a b : ℍ[R]) -@[simps { attrs := [] }]instance : has_inv ℍ[R] := ⟨λ a, (norm_sq a)⁻¹ • a.conj⟩ +@[simps { attrs := [] }] instance : has_inv ℍ[R] := ⟨λ a, (norm_sq a)⁻¹ • star a⟩ -instance : division_ring ℍ[R] := +instance : group_with_zero ℍ[R] := { inv := has_inv.inv, - inv_zero := by rw [has_inv_inv, conj_zero, smul_zero], - mul_inv_cancel := λ a ha, by rw [has_inv_inv, algebra.mul_smul_comm, self_mul_conj, smul_coe, + inv_zero := by rw [has_inv_inv, star_zero, smul_zero], + mul_inv_cancel := λ a ha, by rw [has_inv_inv, algebra.mul_smul_comm, self_mul_star, smul_coe, inv_mul_cancel (norm_sq_ne_zero.2 ha), coe_one], .. quaternion.nontrivial, + .. (by apply_instance : monoid_with_zero ℍ[R]) } + +@[norm_cast, simp] lemma coe_inv (x : R) : ((x⁻¹ : R) : ℍ[R]) = x⁻¹ := +map_inv₀ (algebra_map R ℍ[R]) _ + +@[norm_cast, simp] lemma coe_div (x y : R) : ((x / y : R) : ℍ[R]) = x / y := +map_div₀ (algebra_map R ℍ[R]) x y + +@[norm_cast, simp] lemma coe_zpow (x : R) (z : ℤ) : ((x ^ z : R) : ℍ[R]) = x ^ z := +map_zpow₀ (algebra_map R ℍ[R]) x z + +instance : division_ring ℍ[R] := +{ rat_cast := λ q, ↑(q : R), + rat_cast_mk := λ n d hd h, by rw [rat.cast_mk', coe_mul, coe_int_cast, coe_inv, coe_nat_cast], + qsmul := (•), + qsmul_eq_mul' := λ q x, begin + rw coe_mul_eq_smul, + ext; exact division_ring.qsmul_eq_mul' _ _, + end, + .. quaternion.group_with_zero, .. quaternion.ring } -@[simp] lemma norm_sq_inv : norm_sq a⁻¹ = (norm_sq a)⁻¹ := -monoid_with_zero_hom.map_inv norm_sq _ +@[simp, norm_cast] lemma rat_cast_re (q : ℚ) : (q : ℍ[R]).re = q := rfl +@[simp, norm_cast] lemma rat_cast_im_i (q : ℚ) : (q : ℍ[R]).im_i = 0 := rfl +@[simp, norm_cast] lemma rat_cast_im_j (q : ℚ) : (q : ℍ[R]).im_j = 0 := rfl +@[simp, norm_cast] lemma rat_cast_im_k (q : ℚ) : (q : ℍ[R]).im_k = 0 := rfl +@[simp, norm_cast] lemma rat_cast_im (q : ℚ) : (q : ℍ[R]).im = 0 := rfl +@[norm_cast] lemma coe_rat_cast (q : ℚ) : ↑(q : R) = (q : ℍ[R]) := rfl -@[simp] lemma norm_sq_div : norm_sq (a / b) = norm_sq a / norm_sq b := -monoid_with_zero_hom.map_div norm_sq a b +@[simp] lemma norm_sq_inv : norm_sq a⁻¹ = (norm_sq a)⁻¹ := map_inv₀ norm_sq _ +@[simp] lemma norm_sq_div : norm_sq (a / b) = norm_sq a / norm_sq b := map_div₀ norm_sq a b +@[simp] lemma norm_sq_zpow (z : ℤ) : norm_sq (a ^ z) = norm_sq a ^ z := map_zpow₀ norm_sq a z +@[norm_cast] lemma norm_sq_rat_cast (q : ℚ) : norm_sq (q : ℍ[R]) = q^2 := +by rw [←coe_rat_cast, norm_sq_coe] end field @@ -594,7 +810,7 @@ section quaternion_algebra variables {R : Type*} (c₁ c₂ : R) private theorem pow_four [infinite R] : #R ^ 4 = #R := -power_nat_eq (omega_le_mk R) $ by simp +power_nat_eq (aleph_0_le_mk R) $ by simp /-- The cardinality of a quaternion algebra, as a type. -/ lemma mk_quaternion_algebra : #ℍ[R, c₁, c₂] = #R ^ 4 := diff --git a/src/algebra/quaternion_basis.lean b/src/algebra/quaternion_basis.lean index d65824650cc52..deeee0cd9c997 100644 --- a/src/algebra/quaternion_basis.lean +++ b/src/algebra/quaternion_basis.lean @@ -9,6 +9,9 @@ import tactic.ring /-! # Basis on a quaternion-like algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `quaternion_algebra.basis A c₁ c₂`: a basis for a subspace of an `R`-algebra `A` that has the diff --git a/src/algebra/quotient.lean b/src/algebra/quotient.lean index 82c1ccb8eae7d..73c3e1c6b819a 100644 --- a/src/algebra/quotient.lean +++ b/src/algebra/quotient.lean @@ -3,12 +3,14 @@ Copyright (c) 2021 Anne Baanen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ - -import data.set_like.basic +import tactic.basic /-! # Algebraic quotients +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines notation for algebraic quotients, e.g. quotient groups `G ⧸ H`, quotient modules `M ⧸ N` and ideal quotients `R ⧸ I`. @@ -21,7 +23,7 @@ The actual quotient structures are defined in the following files: The following notation is introduced: -* `G ⧸ H` stands for the quotient of the type `G` by some term `H` +* `G ⧸ H` stands for the quotient of the type `G` by some term `H` (for example, `H` can be a normal subgroup of `G`). To implement this notation for other quotients, you should provide a `has_quotient` instance. Note that since `G` can usually be inferred from `H`, `_ ⧸ H` can also be used, @@ -49,7 +51,7 @@ class has_quotient (A : out_param $ Type u) (B : Type v) := This differs from `has_quotient.quotient'` in that the `A` argument is explicit, which is necessary to make Lean show the notation in the goal state. -/ -@[reducible, nolint has_inhabited_instance] -- Will be provided by e.g. `ideal.quotient.inhabited` +@[reducible, nolint has_nonempty_instance] -- Will be provided by e.g. `ideal.quotient.inhabited` def has_quotient.quotient (A : out_param $ Type u) {B : Type v} [has_quotient A B] (b : B) : Type (max u v) := has_quotient.quotient' b diff --git a/src/algebra/regular/basic.lean b/src/algebra/regular/basic.lean index 86bd53f1901de..e71fcb96d2eba 100644 --- a/src/algebra/regular/basic.lean +++ b/src/algebra/regular/basic.lean @@ -3,13 +3,16 @@ Copyright (c) 2021 Damiano Testa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Damiano Testa -/ -import algebra.order.monoid_lemmas +import algebra.group.commute +import algebra.order.monoid.lemmas import algebra.group_with_zero.basic -import logic.embedding /-! # Regular elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce left-regular, right-regular and regular elements, along with their `to_additive` analogues add-left-regular, add-right-regular and add-regular elements. @@ -24,24 +27,24 @@ by adding one further `0`. The final goal is to develop part of the API to prove, eventually, results about non-zero-divisors. -/ -variables {R : Type*} {a b : R} +variables {R : Type*} section has_mul -variable [has_mul R] +variables [has_mul R] /-- A left-regular element is an element `c` such that multiplication on the left by `c` is injective. -/ @[to_additive "An add-left-regular element is an element `c` such that addition on the left by `c` is injective. -/ "] -def is_left_regular (c : R) := function.injective ((*) c) +def is_left_regular (c : R) := ((*) c).injective /-- A right-regular element is an element `c` such that multiplication on the right by `c` is injective. -/ @[to_additive "An add-right-regular element is an element `c` such that addition on the right by `c` is injective."] -def is_right_regular (c : R) := function.injective (* c) +def is_right_regular (c : R) := (* c).injective /-- An add-regular element is an element `c` such that addition by `c` both on the left and on the right is injective. -/ @@ -74,7 +77,7 @@ end has_mul section semigroup -variable [semigroup R] +variables [semigroup R] {a b : R} /-- In a semigroup, the product of left-regular elements is left-regular. -/ @[to_additive "In an additive semigroup, the sum of add-left-regular elements is add-left.regular."] @@ -114,7 +117,7 @@ lemma is_right_regular.of_mul (ab : is_right_regular (b * a)) : begin refine λ x y xy, ab (_ : x * (b * a) = y * (b * a)), rw [← mul_assoc, ← mul_assoc], - exact congr_fun (congr_arg has_mul.mul xy) a, + exact congr_fun (congr_arg (*) xy) a, end /-- An element is right-regular if and only if multiplying it on the right with a right-regular @@ -154,7 +157,7 @@ end semigroup section mul_zero_class -variables [mul_zero_class R] +variables [mul_zero_class R] {a b : R} /-- The element `0` is left-regular if and only if `R` is trivial. -/ lemma is_left_regular.subsingleton (h : is_left_regular (0 : R)) : subsingleton R := @@ -170,11 +173,7 @@ h.left.subsingleton /-- The element `0` is left-regular if and only if `R` is trivial. -/ lemma is_left_regular_zero_iff_subsingleton : is_left_regular (0 : R) ↔ subsingleton R := -begin - refine ⟨λ h, h.subsingleton, _⟩, - intros H a b h, - exact @subsingleton.elim _ H a b -end +⟨λ h, h.subsingleton, λ H a b h, @subsingleton.elim _ H a b⟩ /-- In a non-trivial `mul_zero_class`, the `0` element is not left-regular. -/ lemma not_is_left_regular_zero_iff : ¬ is_left_regular (0 : R) ↔ nontrivial R := @@ -186,11 +185,7 @@ end /-- The element `0` is right-regular if and only if `R` is trivial. -/ lemma is_right_regular_zero_iff_subsingleton : is_right_regular (0 : R) ↔ subsingleton R := -begin - refine ⟨λ h, h.subsingleton, _⟩, - intros H a b h, - exact @subsingleton.elim _ H a b -end +⟨λ h, h.subsingleton, λ H a b h, @subsingleton.elim _ H a b⟩ /-- In a non-trivial `mul_zero_class`, the `0` element is not right-regular. -/ lemma not_is_right_regular_zero_iff : ¬ is_right_regular (0 : R) ↔ nontrivial R := @@ -255,7 +250,7 @@ end mul_one_class section comm_semigroup -variable [comm_semigroup R] +variables [comm_semigroup R] {a b : R} /-- A product is regular if and only if the factors are. -/ @[to_additive "A sum is add-regular if and only if the summands are."] @@ -269,17 +264,17 @@ end comm_semigroup section monoid -variables [monoid R] +variables [monoid R] {a b : R} /-- An element admitting a left inverse is left-regular. -/ @[to_additive "An element admitting a left additive opposite is add-left-regular."] lemma is_left_regular_of_mul_eq_one (h : b * a = 1) : is_left_regular a := -@is_left_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.left }) +@is_left_regular.of_mul R _ _ _ (by { rw h, exact is_regular_one.left }) /-- An element admitting a right inverse is right-regular. -/ @[to_additive "An element admitting a right additive opposite is add-right-regular."] lemma is_right_regular_of_mul_eq_one (h : a * b = 1) : is_right_regular a := -@is_right_regular.of_mul R _ a _ (by { rw h, exact is_regular_one.right }) +is_right_regular.of_mul (by { rw h, exact is_regular_one.right }) /-- If `R` is a monoid, an element in `Rˣ` is regular. -/ @[to_additive "If `R` is an additive monoid, an element in `add_units R` is add-regular."] @@ -296,33 +291,6 @@ end end monoid -section left_or_right_cancel_semigroup - -/-- -The embedding of a left cancellative semigroup into itself -by left multiplication by a fixed element. - -/ -@[to_additive - "The embedding of a left cancellative additive semigroup into itself - by left translation by a fixed element.", simps] -def mul_left_embedding {G : Type*} [left_cancel_semigroup G] (g : G) : G ↪ G := -{ to_fun := λ h, g * h, inj' := mul_right_injective g } - -/-- -The embedding of a right cancellative semigroup into itself -by right multiplication by a fixed element. - -/ -@[to_additive - "The embedding of a right cancellative additive semigroup into itself - by right translation by a fixed element.", simps] -def mul_right_embedding {G : Type*} [right_cancel_semigroup G] (g : G) : G ↪ G := -{ to_fun := λ h, h * g, inj' := mul_left_injective g } - -@[to_additive] -lemma mul_left_embedding_eq_mul_right_embedding {G : Type*} [cancel_comm_monoid G] (g : G) : - mul_left_embedding g = mul_right_embedding g := -by { ext, exact mul_comm _ _ } - /-- Elements of a left cancel semigroup are left regular. -/ @[to_additive "Elements of an add left cancel semigroup are add-left-regular."] lemma is_left_regular_of_left_cancel_semigroup [left_cancel_semigroup R] (g : R) : @@ -335,8 +303,6 @@ lemma is_right_regular_of_right_cancel_semigroup [right_cancel_semigroup R] (g : is_right_regular g := mul_left_injective g -end left_or_right_cancel_semigroup - section cancel_monoid variables [cancel_monoid R] @@ -351,7 +317,7 @@ end cancel_monoid section cancel_monoid_with_zero -variables [cancel_monoid_with_zero R] +variables [cancel_monoid_with_zero R] {a : R} /-- Non-zero elements of an integral domain are regular. -/ lemma is_regular_of_ne_zero (a0 : a ≠ 0) : is_regular a := diff --git a/src/algebra/regular/pow.lean b/src/algebra/regular/pow.lean index 342cc2f4338e7..ee2d02d7819ad 100644 --- a/src/algebra/regular/pow.lean +++ b/src/algebra/regular/pow.lean @@ -3,13 +3,15 @@ Copyright (c) 2021 Damiano Testa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Damiano Testa -/ -import algebra.group_power.basic import algebra.hom.iterate import algebra.regular.basic /-! # Regular elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Implementation details Group powers and other definitions import a lot of the algebra hierarchy. diff --git a/src/algebra/regular/smul.lean b/src/algebra/regular/smul.lean index b45087acf3d3a..6ec31dc4b434b 100644 --- a/src/algebra/regular/smul.lean +++ b/src/algebra/regular/smul.lean @@ -9,6 +9,9 @@ import algebra.regular.basic /-! # Action of regular elements on a module +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce `M`-regular elements, in the context of an `R`-module `M`. The corresponding predicate is called `is_smul_regular`. @@ -29,7 +32,7 @@ variables {R S : Type*} (M : Type*) {a b : R} {s : S} /-- An `M`-regular element is an element `c` such that multiplication on the left by `c` is an injective map `M → M`. -/ -def is_smul_regular [has_scalar R M] (c : R) := function.injective ((•) c : M → M) +def is_smul_regular [has_smul R M] (c : R) := function.injective ((•) c : M → M) lemma is_left_regular.is_smul_regular [has_mul R] {c : R} (h : is_left_regular c) : is_smul_regular R c := h @@ -49,9 +52,9 @@ namespace is_smul_regular variables {M} -section has_scalar +section has_smul -variables [has_scalar R M] [has_scalar R S] [has_scalar S M] [is_scalar_tower R S M] +variables [has_smul R M] [has_smul R S] [has_smul S M] [is_scalar_tower R S M] /-- The product of `M`-regular elements is `M`-regular. -/ lemma smul (ra : is_smul_regular M a) (rs : is_smul_regular M s) : @@ -102,7 +105,7 @@ begin exact ⟨ha.mul hb, hb.mul ha⟩ } end -end has_scalar +end has_smul section monoid @@ -141,7 +144,7 @@ end monoid section monoid_smul -variables [monoid S] [has_scalar R M] [has_scalar R S] [mul_action S M] [is_scalar_tower R S M] +variables [monoid S] [has_smul R M] [has_smul R S] [mul_action S M] [is_scalar_tower R S M] /-- An element of `S` admitting a left inverse in `R` is `M`-regular. -/ lemma of_smul_eq_one (h : a • s = 1) : is_smul_regular M s := @@ -183,7 +186,7 @@ end monoid_with_zero section comm_semigroup -variables [comm_semigroup R] [has_scalar R M] [is_scalar_tower R R M] +variables [comm_semigroup R] [has_smul R M] [is_scalar_tower R R M] /-- A product is `M`-regular if and only if the factors are. -/ lemma mul_iff : is_smul_regular M (a * b) ↔ diff --git a/src/algebra/ring/add_aut.lean b/src/algebra/ring/add_aut.lean new file mode 100644 index 0000000000000..986c4711c60c6 --- /dev/null +++ b/src/algebra/ring/add_aut.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import group_theory.group_action.group +import algebra.module.basic + +/-! +# Multiplication on the left/right as additive automorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `add_aut.mul_left` and `add_aut.mul_right`. + +See also `add_monoid_hom.mul_left`, `add_monoid_hom.mul_right`, `add_monoid.End.mul_left`, and +`add_monoid.End.mul_right` for multiplication by `R` as an endomorphism instead of multiplication by +`Rˣ` as an automorphism. +-/ + +namespace add_aut +variables {R : Type*} [semiring R] + +/-- Left multiplication by a unit of a semiring as an additive automorphism. -/ +@[simps { simp_rhs := tt }] +def mul_left : Rˣ →* add_aut R := distrib_mul_action.to_add_aut _ _ + +/-- Right multiplication by a unit of a semiring as an additive automorphism. -/ +def mul_right (u : Rˣ) : add_aut R := +distrib_mul_action.to_add_aut Rᵐᵒᵖˣ R (units.op_equiv.symm $ mul_opposite.op u) + +@[simp] lemma mul_right_apply (u : Rˣ) (x : R) : mul_right u x = x * u := rfl +@[simp] lemma mul_right_symm_apply (u : Rˣ) (x : R) : (mul_right u).symm x = x * ↑u⁻¹ := rfl + +end add_aut + diff --git a/src/algebra/ring/aut.lean b/src/algebra/ring/aut.lean index 642a865bbe7c9..05731948231e1 100644 --- a/src/algebra/ring/aut.lean +++ b/src/algebra/ring/aut.lean @@ -3,12 +3,16 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov -/ +import algebra.group_ring_action.basic import algebra.hom.aut import algebra.ring.equiv /-! # Ring automorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the automorphism group structure on `ring_aut R := ring_equiv R R`. ## Implementation notes @@ -29,6 +33,9 @@ ring_aut @[reducible] def ring_aut (R : Type*) [has_mul R] [has_add R] := ring_equiv R R namespace ring_aut + +section mul_add + variables (R : Type*) [has_mul R] [has_add R] /-- @@ -60,4 +67,38 @@ by refine_struct { to_fun := ring_equiv.to_mul_equiv }; intros; refl def to_perm : ring_aut R →* equiv.perm R := by refine_struct { to_fun := ring_equiv.to_equiv }; intros; refl +end mul_add + +section semiring + +variables {G R : Type*} [group G] [semiring R] + +/-- The tautological action by the group of automorphism of a ring `R` on `R`.-/ +instance apply_mul_semiring_action : mul_semiring_action (ring_aut R) R := +{ smul := ($), + smul_zero := ring_equiv.map_zero, + smul_add := ring_equiv.map_add, + smul_one := ring_equiv.map_one, + smul_mul := ring_equiv.map_mul, + one_smul := λ _, rfl, + mul_smul := λ _ _ _, rfl } + +@[simp] +protected lemma smul_def (f : ring_aut R) (r : R) : f • r = f r := rfl + +instance apply_has_faithful_smul : has_faithful_smul (ring_aut R) R := ⟨λ _ _, ring_equiv.ext⟩ + +variables (G R) + +/-- Each element of the group defines a ring automorphism. + +This is a stronger version of `distrib_mul_action.to_add_aut` and +`mul_distrib_mul_action.to_mul_aut`. -/ +@[simps] def _root_.mul_semiring_action.to_ring_aut [mul_semiring_action G R] : G →* ring_aut R := +{ to_fun := mul_semiring_action.to_ring_equiv G R, + map_mul' := λ g h, ring_equiv.ext $ mul_smul g h, + map_one' := ring_equiv.ext $ one_smul _, } + +end semiring + end ring_aut diff --git a/src/algebra/ring/basic.lean b/src/algebra/ring/basic.lean index f70453c26c8cc..9b60f938c03a9 100644 --- a/src/algebra/ring/basic.lean +++ b/src/algebra/ring/basic.lean @@ -1,311 +1,31 @@ /- Copyright (c) 2014 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Amelia Livingston, Yury Kudryashov, -Neil Strickland +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland -/ -import algebra.divisibility -import algebra.regular.basic -import data.pi.algebra +import algebra.ring.defs +import algebra.hom.group +import algebra.opposites /-! -# Properties and homomorphisms of semirings and rings +# Semirings and rings -This file proves simple properties of semirings, rings and domains and their unit groups. It also -defines bundled homomorphisms of semirings and rings. As with monoid and groups, we use the same -structure `ring_hom a β`, a.k.a. `α →+* β`, for both homomorphism types. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -The unbundled homomorphisms are defined in `deprecated/ring`. They are deprecated and the plan is to -slowly remove them from mathlib. +This file gives lemmas about semirings, rings and domains. +This is analogous to `algebra.group.basic`, +the difference being that the former is about `+` and `*` separately, while +the present file is about their interaction. -## Main definitions +For the definitions of semirings and rings see `algebra.ring.defs`. -ring_hom, nonzero, domain, is_domain - -## Notations - -* `→+*` for bundled ring homs (also use for semiring homs) -* `→ₙ+*` for bundled non-unital ring homs (also use for non-unital semiring homs) - -## Implementation notes - -* There's a coercion from bundled homs to fun, and the canonical notation is to - use the bundled hom as a function via this coercion. - -* There is no `semiring_hom` -- the idea is that `ring_hom` is used. - The constructor for a `ring_hom` between semirings needs a proof of `map_zero`, - `map_one` and `map_add` as well as `map_mul`; a separate constructor - `ring_hom.mk'` will construct ring homs between rings from monoid homs given - only a proof that addition is preserved. - -* To avoid repeating lemmas for `units`, this introduces a `has_distrib_neg` typeclass - which both `R` and `units R` satisfy. - -## Tags - -`ring_hom`, `semiring_hom`, `semiring`, `comm_semiring`, `ring`, `comm_ring`, `domain`, -`is_domain`, `nonzero`, `units` -/ universes u v w x variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x} -set_option old_structure_cmd true open function -/-! -### `distrib` class --/ - -/-- A typeclass stating that multiplication is left and right distributive -over addition. -/ -@[protect_proj, ancestor has_mul has_add] -class distrib (R : Type*) extends has_mul R, has_add R := -(left_distrib : ∀ a b c : R, a * (b + c) = (a * b) + (a * c)) -(right_distrib : ∀ a b c : R, (a + b) * c = (a * c) + (b * c)) - -lemma left_distrib [distrib R] (a b c : R) : a * (b + c) = a * b + a * c := -distrib.left_distrib a b c - -alias left_distrib ← mul_add - -lemma right_distrib [distrib R] (a b c : R) : (a + b) * c = a * c + b * c := -distrib.right_distrib a b c - -alias right_distrib ← add_mul - -lemma distrib_three_right [distrib R] (a b c d : R) : (a + b + c) * d = a * d + b * d + c * d := -by simp [right_distrib] - -/-- Pullback a `distrib` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.distrib {S} [has_mul R] [has_add R] [distrib S] - (f : R → S) (hf : injective f) (add : ∀ x y, f (x + y) = f x + f y) - (mul : ∀ x y, f (x * y) = f x * f y) : - distrib R := -{ mul := (*), - add := (+), - left_distrib := λ x y z, hf $ by simp only [*, left_distrib], - right_distrib := λ x y z, hf $ by simp only [*, right_distrib] } - -/-- Pushforward a `distrib` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.distrib {S} [distrib R] [has_add S] [has_mul S] - (f : R → S) (hf : surjective f) (add : ∀ x y, f (x + y) = f x + f y) - (mul : ∀ x y, f (x * y) = f x * f y) : - distrib S := -{ mul := (*), - add := (+), - left_distrib := hf.forall₃.2 $ λ x y z, by simp only [← add, ← mul, left_distrib], - right_distrib := hf.forall₃.2 $ λ x y z, by simp only [← add, ← mul, right_distrib] } - -/-! -### Semirings --/ - -/-- A not-necessarily-unital, not-necessarily-associative semiring. -/ -@[protect_proj, ancestor add_comm_monoid distrib mul_zero_class] -class non_unital_non_assoc_semiring (α : Type u) extends - add_comm_monoid α, distrib α, mul_zero_class α - -/-- An associative but not-necessarily unital semiring. -/ -@[protect_proj, ancestor non_unital_non_assoc_semiring semigroup_with_zero] -class non_unital_semiring (α : Type u) extends - non_unital_non_assoc_semiring α, semigroup_with_zero α - -/-- A unital but not-necessarily-associative semiring. -/ -@[protect_proj, ancestor non_unital_non_assoc_semiring mul_zero_one_class] -class non_assoc_semiring (α : Type u) extends - non_unital_non_assoc_semiring α, mul_zero_one_class α - -/-- A semiring is a type with the following structures: additive commutative monoid -(`add_comm_monoid`), multiplicative monoid (`monoid`), distributive laws (`distrib`), and -multiplication by zero law (`mul_zero_class`). The actual definition extends `monoid_with_zero` -instead of `monoid` and `mul_zero_class`. -/ -@[protect_proj, ancestor non_unital_semiring non_assoc_semiring monoid_with_zero] -class semiring (α : Type u) extends non_unital_semiring α, non_assoc_semiring α, monoid_with_zero α - -section injective_surjective_maps - -variables [has_zero β] [has_add β] [has_mul β] [has_scalar ℕ β] - -/-- Pullback a `non_unital_non_assoc_semiring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_unital_non_assoc_semiring - {α : Type u} [non_unital_non_assoc_semiring α] - (f : β → α) (hf : injective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_unital_non_assoc_semiring β := -{ .. hf.mul_zero_class f zero mul, .. hf.add_comm_monoid f zero add nsmul, .. hf.distrib f add mul } - -/-- Pullback a `non_unital_semiring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_unital_semiring - {α : Type u} [non_unital_semiring α] - (f : β → α) (hf : injective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_unital_semiring β := -{ .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.semigroup_with_zero f zero mul } - -/-- Pullback a `non_assoc_semiring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_assoc_semiring - {α : Type u} [non_assoc_semiring α] [has_one β] - (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_assoc_semiring β := -{ .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.mul_one_class f one mul } - -/-- Pullback a `semiring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.semiring - {α : Type u} [semiring α] [has_one β] [has_pow β ℕ] - (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - semiring β := -{ .. hf.monoid_with_zero f zero one mul npow, .. hf.add_comm_monoid f zero add nsmul, - .. hf.distrib f add mul } - -/-- Pushforward a `non_unital_non_assoc_semiring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_unital_non_assoc_semiring - {α : Type u} [non_unital_non_assoc_semiring α] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_unital_non_assoc_semiring β := -{ .. hf.mul_zero_class f zero mul, .. hf.add_comm_monoid f zero add nsmul, .. hf.distrib f add mul } - -/-- Pushforward a `non_unital_semiring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_unital_semiring - {α : Type u} [non_unital_semiring α] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_unital_semiring β := -{ .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.semigroup_with_zero f zero mul } - -/-- Pushforward a `non_assoc_semiring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_assoc_semiring - {α : Type u} [non_assoc_semiring α] [has_one β] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_assoc_semiring β := -{ .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.mul_one_class f one mul } - -/-- Pushforward a `semiring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.semiring - {α : Type u} [semiring α] [has_one β] [has_pow β ℕ] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - semiring β := -{ .. hf.monoid_with_zero f zero one mul npow, .. hf.add_comm_monoid f zero add nsmul, - .. hf.distrib f add mul } - -end injective_surjective_maps - -section has_one_has_add - -variables [has_one α] [has_add α] - -lemma one_add_one_eq_two : 1 + 1 = (2 : α) := -by unfold bit0 - -end has_one_has_add - -section non_unital_semiring -variables [non_unital_semiring α] - -theorem dvd_add {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := -dvd.elim h₁ (λ d hd, dvd.elim h₂ (λ e he, dvd.intro (d + e) (by simp [left_distrib, hd, he]))) - -end non_unital_semiring - -section non_assoc_semiring -variables [non_assoc_semiring α] - -lemma add_one_mul (a b : α) : (a + 1) * b = a * b + b := -by rw [add_mul, one_mul] -lemma mul_add_one (a b : α) : a * (b + 1) = a * b + a := -by rw [mul_add, mul_one] -lemma one_add_mul (a b : α) : (1 + a) * b = b + a * b := -by rw [add_mul, one_mul] -lemma mul_one_add (a b : α) : a * (1 + b) = a + a * b := -by rw [mul_add, mul_one] - -theorem two_mul (n : α) : 2 * n = n + n := -eq.trans (right_distrib 1 1 n) (by simp) - -theorem bit0_eq_two_mul (n : α) : bit0 n = 2 * n := -(two_mul _).symm - -theorem mul_two (n : α) : n * 2 = n + n := -(left_distrib n 1 1).trans (by simp) - -end non_assoc_semiring - -section semiring -variables [semiring α] - -@[to_additive] lemma mul_ite {α} [has_mul α] (P : Prop) [decidable P] (a b c : α) : - a * (if P then b else c) = if P then a * b else a * c := -by split_ifs; refl - -@[to_additive] lemma ite_mul {α} [has_mul α] (P : Prop) [decidable P] (a b c : α) : - (if P then a else b) * c = if P then a * c else b * c := -by split_ifs; refl - --- We make `mul_ite` and `ite_mul` simp lemmas, --- but not `add_ite` or `ite_add`. --- The problem we're trying to avoid is dealing with --- summations of the form `∑ x in s, (f x + ite P 1 0)`, --- in which `add_ite` followed by `sum_ite` would needlessly slice up --- the `f x` terms according to whether `P` holds at `x`. --- There doesn't appear to be a corresponding difficulty so far with --- `mul_ite` and `ite_mul`. -attribute [simp] mul_ite ite_mul - -@[simp] lemma mul_boole {α} [mul_zero_one_class α] (P : Prop) [decidable P] (a : α) : - a * (if P then 1 else 0) = if P then a else 0 := -by simp - -@[simp] lemma boole_mul {α} [mul_zero_one_class α] (P : Prop) [decidable P] (a : α) : - (if P then 1 else 0) * a = if P then a else 0 := -by simp - -lemma ite_mul_zero_left {α : Type*} [mul_zero_class α] (P : Prop) [decidable P] (a b : α) : - ite P (a * b) 0 = ite P a 0 * b := -by { by_cases h : P; simp [h], } - -lemma ite_mul_zero_right {α : Type*} [mul_zero_class α] (P : Prop) [decidable P] (a b : α) : - ite P (a * b) 0 = a * ite P b 0 := -by { by_cases h : P; simp [h], } - -lemma ite_and_mul_zero {α : Type*} [mul_zero_class α] - (P Q : Prop) [decidable P] [decidable Q] (a b : α) : - ite (P ∧ Q) (a * b) 0 = ite P a 0 * ite Q b 0 := -by simp only [←ite_and, ite_mul, mul_ite, mul_zero, zero_mul, and_comm] - -end semiring - namespace add_hom /-- Left multiplication by an element of a type with distributive multiplication is an `add_hom`. -/ @@ -353,635 +73,20 @@ lemma mul_right_apply {R : Type*} [non_unital_non_assoc_semiring R] (a r : R) : end add_monoid_hom -/-- Bundled non-unital semiring homomorphisms `R →ₙ+* S`; use this for bundled non-unital ring -homomorphisms too. - -When possible, instead of parametrizing results over `(f : R →ₙ+* S)`, -you should parametrize over `(F : Type*) [non_unital_ring_hom_class F R S] (f : F)`. - -When you extend this structure, make sure to extend `non_unital_ring_hom_class`. -/ -structure non_unital_ring_hom (R : Type*) (S : Type*) [non_unital_non_assoc_semiring R] - [non_unital_non_assoc_semiring S] extends R →ₙ* S, R →+ S - -infixr ` →ₙ+* `:25 := non_unital_ring_hom - -/-- Reinterpret a non-unital ring homomorphism `f : R →ₙ+* S` as a semigroup -homomorphism `R →ₙ* S`. The `simp`-normal form is `(f : R →ₙ* S)`. -/ -add_decl_doc non_unital_ring_hom.to_mul_hom - -/-- Reinterpret a non-unital ring homomorphism `f : R →ₙ+* S` as an additive -monoid homomorphism `R →+ S`. The `simp`-normal form is `(f : R →+ S)`. -/ -add_decl_doc non_unital_ring_hom.to_add_monoid_hom - -section non_unital_ring_hom_class - -/-- `non_unital_ring_hom_class F R S` states that `F` is a type of non-unital (semi)ring -homomorphisms. You should extend this class when you extend `non_unital_ring_hom`. -/ -class non_unital_ring_hom_class (F : Type*) (R S : out_param Type*) - [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] - extends mul_hom_class F R S, add_monoid_hom_class F R S - -variables {F : Type*} [non_unital_non_assoc_semiring α] [non_unital_non_assoc_semiring β] - [non_unital_ring_hom_class F α β] - -instance : has_coe_t F (α →ₙ+* β) := -⟨λ f, { to_fun := f, map_zero' := map_zero f, map_mul' := map_mul f, map_add' := map_add f }⟩ - -end non_unital_ring_hom_class - -namespace non_unital_ring_hom - -section coe - -/-! -Throughout this section, some `semiring` arguments are specified with `{}` instead of `[]`. -See note [implicit instance arguments]. --/ -variables {rα : non_unital_non_assoc_semiring α} {rβ : non_unital_non_assoc_semiring β} - -include rα rβ - -instance : non_unital_ring_hom_class (α →ₙ+* β) α β := -{ coe := non_unital_ring_hom.to_fun, - coe_injective' := λ f g h, by cases f; cases g; congr', - map_add := non_unital_ring_hom.map_add', - map_zero := non_unital_ring_hom.map_zero', - map_mul := non_unital_ring_hom.map_mul' } - -/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` -directly. --/ -instance : has_coe_to_fun (α →ₙ+* β) (λ _, α → β) := ⟨non_unital_ring_hom.to_fun⟩ - -@[simp] lemma to_fun_eq_coe (f : α →ₙ+* β) : f.to_fun = f := rfl - -@[simp] lemma coe_mk (f : α → β) (h₁ h₂ h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : α →ₙ+* β) = f := rfl - -@[simp] lemma coe_coe {F : Type*} [non_unital_ring_hom_class F α β] (f : F) : - ((f : α →ₙ+* β) : α → β) = f := rfl - -@[simp] lemma coe_to_mul_hom (f : α →ₙ+* β) : ⇑f.to_mul_hom = f := rfl - -@[simp] lemma coe_mul_hom_mk (f : α → β) (h₁ h₂ h₃) : - ((⟨f, h₁, h₂, h₃⟩ : α →ₙ+* β) : α →ₙ* β) = ⟨f, h₁⟩ := -rfl - -@[simp] lemma coe_to_add_monoid_hom (f : α →ₙ+* β) : ⇑f.to_add_monoid_hom = f := rfl - -@[simp] lemma coe_add_monoid_hom_mk (f : α → β) (h₁ h₂ h₃) : - ((⟨f, h₁, h₂, h₃⟩ : α →ₙ+* β) : α →+ β) = ⟨f, h₂, h₃⟩ := -rfl - -/-- Copy of a `ring_hom` with a new `to_fun` equal to the old one. Useful to fix definitional -equalities. -/ -protected def copy (f : α →ₙ+* β) (f' : α → β) (h : f' = f) : α →ₙ+* β := -{ ..f.to_mul_hom.copy f' h, ..f.to_add_monoid_hom.copy f' h } - -end coe - -variables [rα : non_unital_non_assoc_semiring α] [rβ : non_unital_non_assoc_semiring β] - -section -include rα rβ - -variables (f : α →ₙ+* β) {x y : α} {rα rβ} - -@[ext] theorem ext ⦃f g : α →ₙ+* β⦄ (h : ∀ x, f x = g x) : f = g := -fun_like.ext _ _ h - -theorem ext_iff {f g : α →ₙ+* β} : f = g ↔ ∀ x, f x = g x := -fun_like.ext_iff - -@[simp] lemma mk_coe (f : α →ₙ+* β) (h₁ h₂ h₃) : non_unital_ring_hom.mk f h₁ h₂ h₃ = f := -ext $ λ _, rfl - -theorem coe_add_monoid_hom_injective : function.injective (coe : (α →ₙ+* β) → (α →+ β)) := -λ f g h, ext (λ x, add_monoid_hom.congr_fun h x) - -theorem coe_mul_hom_injective : function.injective (coe : (α →ₙ+* β) → (α →ₙ* β)) := -λ f g h, ext (λ x, mul_hom.congr_fun h x) - -end - -/-- The identity non-unital ring homomorphism from a non-unital semiring to itself. -/ -protected def id (α : Type*) [non_unital_non_assoc_semiring α] : α →ₙ+* α := -by refine {to_fun := id, ..}; intros; refl - -include rα rβ - -instance : has_zero (α →ₙ+* β) := -has_zero.mk - { to_fun := 0, - map_mul' := λ x y, (mul_zero (0 : β)).symm, - map_zero' := rfl, - map_add' := λ x y, (add_zero (0 : β)).symm } - -instance : inhabited (α →ₙ+* β) := ⟨0⟩ - -@[simp] lemma coe_zero : ⇑(0 : α →ₙ+* β) = 0 := rfl -@[simp] lemma zero_apply (x : α) : (0 : α →ₙ+* β) x = 0 := rfl - -omit rβ - -@[simp] lemma id_apply (x : α) : non_unital_ring_hom.id α x = x := rfl -@[simp] lemma coe_add_monoid_hom_id : - (non_unital_ring_hom.id α : α →+ α) = add_monoid_hom.id α := rfl -@[simp] lemma coe_mul_hom_id : (non_unital_ring_hom.id α : α →ₙ* α) = mul_hom.id α := rfl - -variable {rγ : non_unital_non_assoc_semiring γ} -include rβ rγ - -/-- Composition of non-unital ring homomorphisms is a non-unital ring homomorphism. -/ -def comp (g : β →ₙ+* γ) (f : α →ₙ+* β) : α →ₙ+* γ := -{ ..g.to_mul_hom.comp f.to_mul_hom, ..g.to_add_monoid_hom.comp f.to_add_monoid_hom } - -/-- Composition of non-unital ring homomorphisms is associative. -/ -lemma comp_assoc {δ} {rδ : non_unital_non_assoc_semiring δ} (f : α →ₙ+* β) (g : β →ₙ+* γ) - (h : γ →ₙ+* δ) : (h.comp g).comp f = h.comp (g.comp f) := rfl - -@[simp] lemma coe_comp (g : β →ₙ+* γ) (f : α →ₙ+* β) : ⇑(g.comp f) = g ∘ f := rfl -@[simp] lemma comp_apply (g : β →ₙ+* γ) (f : α →ₙ+* β) (x : α) : g.comp f x = g (f x) := rfl - -@[simp] lemma coe_comp_add_monoid_hom (g : β →ₙ+* γ) (f : α →ₙ+* β) : - (g.comp f : α →+ γ) = (g : β →+ γ).comp f := rfl -@[simp] lemma coe_comp_mul_hom (g : β →ₙ+* γ) (f : α →ₙ+* β) : - (g.comp f : α →ₙ* γ) = (g : β →ₙ* γ).comp f := rfl - -@[simp] lemma comp_zero (g : β →ₙ+* γ) : g.comp (0 : α →ₙ+* β) = 0 := by { ext, simp } -@[simp] lemma zero_comp (f : α →ₙ+* β) : (0 : β →ₙ+* γ).comp f = 0 := by { ext, refl } - -omit rγ - -@[simp] lemma comp_id (f : α →ₙ+* β) : f.comp (non_unital_ring_hom.id α) = f := ext $ λ x, rfl -@[simp] lemma id_comp (f : α →ₙ+* β) : (non_unital_ring_hom.id β).comp f = f := ext $ λ x, rfl - -omit rβ - -instance : monoid_with_zero (α →ₙ+* α) := -{ one := non_unital_ring_hom.id α, - mul := comp, - mul_one := comp_id, - one_mul := id_comp, - mul_assoc := λ f g h, comp_assoc _ _ _, - zero := 0, - mul_zero := comp_zero, - zero_mul := zero_comp } - -lemma one_def : (1 : α →ₙ+* α) = non_unital_ring_hom.id α := rfl - -@[simp] lemma coe_one : ⇑(1 : α →ₙ+* α) = id := rfl - -lemma mul_def (f g : α →ₙ+* α) : f * g = f.comp g := rfl - -@[simp] lemma coe_mul (f g : α →ₙ+* α) : ⇑(f * g) = f ∘ g := rfl - -include rβ rγ - -lemma cancel_right {g₁ g₂ : β →ₙ+* γ} {f : α →ₙ+* β} (hf : surjective f) : - g₁.comp f = g₂.comp f ↔ g₁ = g₂ := -⟨λ h, ext $ hf.forall.2 (ext_iff.1 h), λ h, h ▸ rfl⟩ - -lemma cancel_left {g : β →ₙ+* γ} {f₁ f₂ : α →ₙ+* β} (hg : injective g) : - g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ := -⟨λ h, ext $ λ x, hg $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩ - -omit rα rβ rγ - -end non_unital_ring_hom - -/-- Bundled semiring homomorphisms; use this for bundled ring homomorphisms too. - -This extends from both `monoid_hom` and `monoid_with_zero_hom` in order to put the fields in a -sensible order, even though `monoid_with_zero_hom` already extends `monoid_hom`. -/ -structure ring_hom (α : Type*) (β : Type*) [non_assoc_semiring α] [non_assoc_semiring β] - extends α →* β, α →+ β, α →*₀ β - -infixr ` →+* `:25 := ring_hom - -/-- Reinterpret a ring homomorphism `f : R →+* S` as a monoid with zero homomorphism `R →*₀ S`. -The `simp`-normal form is `(f : R →*₀ S)`. -/ -add_decl_doc ring_hom.to_monoid_with_zero_hom - -/-- Reinterpret a ring homomorphism `f : R →+* S` as a monoid homomorphism `R →* S`. -The `simp`-normal form is `(f : R →* S)`. -/ -add_decl_doc ring_hom.to_monoid_hom - -/-- Reinterpret a ring homomorphism `f : R →+* S` as an additive monoid homomorphism `R →+ S`. -The `simp`-normal form is `(f : R →+ S)`. -/ -add_decl_doc ring_hom.to_add_monoid_hom - -section ring_hom_class - -/-- `ring_hom_class F R S` states that `F` is a type of (semi)ring homomorphisms. -You should extend this class when you extend `ring_hom`. - -This extends from both `monoid_hom_class` and `monoid_with_zero_hom_class` in -order to put the fields in a sensible order, even though -`monoid_with_zero_hom_class` already extends `monoid_hom_class`. -/ -class ring_hom_class (F : Type*) (R S : out_param Type*) - [non_assoc_semiring R] [non_assoc_semiring S] - extends monoid_hom_class F R S, add_monoid_hom_class F R S, monoid_with_zero_hom_class F R S - -variables {F : Type*} [non_assoc_semiring α] [non_assoc_semiring β] [ring_hom_class F α β] - -/-- Ring homomorphisms preserve `bit1`. -/ -@[simp] lemma map_bit1 (f : F) (a : α) : (f (bit1 a) : β) = bit1 (f a) := -by simp [bit1] - -instance : has_coe_t F (α →+* β) := -⟨λ f, { to_fun := f, map_zero' := map_zero f, map_one' := map_one f, map_mul' := map_mul f, - map_add' := map_add f }⟩ - -@[priority 100] -instance ring_hom_class.to_non_unital_ring_hom_class : non_unital_ring_hom_class F α β := -{ .. ‹ring_hom_class F α β› } - -end ring_hom_class - -namespace ring_hom - -section coe - -/-! -Throughout this section, some `semiring` arguments are specified with `{}` instead of `[]`. -See note [implicit instance arguments]. --/ -variables {rα : non_assoc_semiring α} {rβ : non_assoc_semiring β} - -include rα rβ - -instance : ring_hom_class (α →+* β) α β := -{ coe := ring_hom.to_fun, - coe_injective' := λ f g h, by cases f; cases g; congr', - map_add := ring_hom.map_add', - map_zero := ring_hom.map_zero', - map_mul := ring_hom.map_mul', - map_one := ring_hom.map_one' } - -/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` -directly. --/ -instance : has_coe_to_fun (α →+* β) (λ _, α → β) := ⟨ring_hom.to_fun⟩ - -initialize_simps_projections ring_hom (to_fun → apply) - -@[simp] lemma to_fun_eq_coe (f : α →+* β) : f.to_fun = f := rfl - -@[simp] lemma coe_mk (f : α → β) (h₁ h₂ h₃ h₄) : ⇑(⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) = f := rfl - -@[simp] lemma coe_coe {F : Type*} [ring_hom_class F α β] (f : F) : ((f : α →+* β) : α → β) = f := -rfl - -instance has_coe_monoid_hom : has_coe (α →+* β) (α →* β) := ⟨ring_hom.to_monoid_hom⟩ - -@[simp, norm_cast] lemma coe_monoid_hom (f : α →+* β) : ⇑(f : α →* β) = f := rfl - -@[simp] lemma to_monoid_hom_eq_coe (f : α →+* β) : f.to_monoid_hom = f := rfl -@[simp] lemma to_monoid_with_zero_hom_eq_coe (f : α →+* β) : - (f.to_monoid_with_zero_hom : α → β) = f := rfl - -@[simp] lemma coe_monoid_hom_mk (f : α → β) (h₁ h₂ h₃ h₄) : - ((⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) : α →* β) = ⟨f, h₁, h₂⟩ := -rfl - -@[simp, norm_cast] lemma coe_add_monoid_hom (f : α →+* β) : ⇑(f : α →+ β) = f := rfl - -@[simp] lemma to_add_monoid_hom_eq_coe (f : α →+* β) : f.to_add_monoid_hom = f := rfl - -@[simp] lemma coe_add_monoid_hom_mk (f : α → β) (h₁ h₂ h₃ h₄) : - ((⟨f, h₁, h₂, h₃, h₄⟩ : α →+* β) : α →+ β) = ⟨f, h₃, h₄⟩ := -rfl - -/-- Copy of a `ring_hom` with a new `to_fun` equal to the old one. Useful to fix definitional -equalities. -/ -def copy (f : α →+* β) (f' : α → β) (h : f' = f) : α →+* β := -{ ..f.to_monoid_with_zero_hom.copy f' h, ..f.to_add_monoid_hom.copy f' h } - -end coe - -variables [rα : non_assoc_semiring α] [rβ : non_assoc_semiring β] - -section -include rα rβ - -variables (f : α →+* β) {x y : α} {rα rβ} - -theorem congr_fun {f g : α →+* β} (h : f = g) (x : α) : f x = g x := -fun_like.congr_fun h x - -theorem congr_arg (f : α →+* β) {x y : α} (h : x = y) : f x = f y := -fun_like.congr_arg f h - -theorem coe_inj ⦃f g : α →+* β⦄ (h : (f : α → β) = g) : f = g := -fun_like.coe_injective h - -@[ext] theorem ext ⦃f g : α →+* β⦄ (h : ∀ x, f x = g x) : f = g := -fun_like.ext _ _ h - -theorem ext_iff {f g : α →+* β} : f = g ↔ ∀ x, f x = g x := -fun_like.ext_iff - -@[simp] lemma mk_coe (f : α →+* β) (h₁ h₂ h₃ h₄) : ring_hom.mk f h₁ h₂ h₃ h₄ = f := -ext $ λ _, rfl - -theorem coe_add_monoid_hom_injective : function.injective (coe : (α →+* β) → (α →+ β)) := -λ f g h, ext (λ x, add_monoid_hom.congr_fun h x) - -theorem coe_monoid_hom_injective : function.injective (coe : (α →+* β) → (α →* β)) := -λ f g h, ext (λ x, monoid_hom.congr_fun h x) - -/-- Ring homomorphisms map zero to zero. -/ -protected lemma map_zero (f : α →+* β) : f 0 = 0 := map_zero f - -/-- Ring homomorphisms map one to one. -/ -protected lemma map_one (f : α →+* β) : f 1 = 1 := map_one f - -/-- Ring homomorphisms preserve addition. -/ -protected lemma map_add (f : α →+* β) (a b : α) : f (a + b) = f a + f b := map_add f a b - -/-- Ring homomorphisms preserve multiplication. -/ -protected lemma map_mul (f : α →+* β) (a b : α) : f (a * b) = f a * f b := map_mul f a b - -/-- Ring homomorphisms preserve `bit0`. -/ -protected lemma map_bit0 (f : α →+* β) (a : α) : f (bit0 a) = bit0 (f a) := map_add _ _ _ - -/-- Ring homomorphisms preserve `bit1`. -/ -protected lemma map_bit1 (f : α →+* β) (a : α) : f (bit1 a) = bit1 (f a) := -by simp [bit1] - -/-- `f : R →+* S` has a trivial codomain iff `f 1 = 0`. -/ -lemma codomain_trivial_iff_map_one_eq_zero : (0 : β) = 1 ↔ f 1 = 0 := -by rw [map_one, eq_comm] - -/-- `f : R →+* S` has a trivial codomain iff it has a trivial range. -/ -lemma codomain_trivial_iff_range_trivial : (0 : β) = 1 ↔ (∀ x, f x = 0) := -f.codomain_trivial_iff_map_one_eq_zero.trans - ⟨λ h x, by rw [←mul_one x, map_mul, h, mul_zero], λ h, h 1⟩ - -/-- `f : R →+* S` has a trivial codomain iff its range is `{0}`. -/ -lemma codomain_trivial_iff_range_eq_singleton_zero : (0 : β) = 1 ↔ set.range f = {0} := -f.codomain_trivial_iff_range_trivial.trans - ⟨ λ h, set.ext (λ y, ⟨λ ⟨x, hx⟩, by simp [←hx, h x], λ hy, ⟨0, by simpa using hy.symm⟩⟩), - λ h x, set.mem_singleton_iff.mp (h ▸ set.mem_range_self x)⟩ - -/-- `f : R →+* S` doesn't map `1` to `0` if `S` is nontrivial -/ -lemma map_one_ne_zero [nontrivial β] : f 1 ≠ 0 := -mt f.codomain_trivial_iff_map_one_eq_zero.mpr zero_ne_one - -/-- If there is a homomorphism `f : R →+* S` and `S` is nontrivial, then `R` is nontrivial. -/ -lemma domain_nontrivial [nontrivial β] : nontrivial α := -⟨⟨1, 0, mt (λ h, show f 1 = 0, by rw [h, map_zero]) f.map_one_ne_zero⟩⟩ - - -end - -lemma is_unit_map [semiring α] [semiring β] (f : α →+* β) {a : α} (h : is_unit a) : is_unit (f a) := -h.map f - -/-- The identity ring homomorphism from a semiring to itself. -/ -def id (α : Type*) [non_assoc_semiring α] : α →+* α := -by refine {to_fun := id, ..}; intros; refl - -include rα - -instance : inhabited (α →+* α) := ⟨id α⟩ - -@[simp] lemma id_apply (x : α) : ring_hom.id α x = x := rfl -@[simp] lemma coe_add_monoid_hom_id : (id α : α →+ α) = add_monoid_hom.id α := rfl -@[simp] lemma coe_monoid_hom_id : (id α : α →* α) = monoid_hom.id α := rfl - -variable {rγ : non_assoc_semiring γ} -include rβ rγ - -/-- Composition of ring homomorphisms is a ring homomorphism. -/ -def comp (hnp : β →+* γ) (hmn : α →+* β) : α →+* γ := -{ to_fun := hnp ∘ hmn, - map_zero' := by simp, - map_one' := by simp, - map_add' := λ x y, by simp, - map_mul' := λ x y, by simp} - -/-- Composition of semiring homomorphisms is associative. -/ -lemma comp_assoc {δ} {rδ: non_assoc_semiring δ} (f : α →+* β) (g : β →+* γ) (h : γ →+* δ) : - (h.comp g).comp f = h.comp (g.comp f) := rfl - -@[simp] lemma coe_comp (hnp : β →+* γ) (hmn : α →+* β) : (hnp.comp hmn : α → γ) = hnp ∘ hmn := rfl - -lemma comp_apply (hnp : β →+* γ) (hmn : α →+* β) (x : α) : (hnp.comp hmn : α → γ) x = - (hnp (hmn x)) := rfl - -omit rγ - -@[simp] lemma comp_id (f : α →+* β) : f.comp (id α) = f := ext $ λ x, rfl - -@[simp] lemma id_comp (f : α →+* β) : (id β).comp f = f := ext $ λ x, rfl - -omit rβ - -instance : monoid (α →+* α) := -{ one := id α, - mul := comp, - mul_one := comp_id, - one_mul := id_comp, - mul_assoc := λ f g h, comp_assoc _ _ _ } - -lemma one_def : (1 : α →+* α) = id α := rfl - -@[simp] lemma coe_one : ⇑(1 : α →+* α) = _root_.id := rfl - -lemma mul_def (f g : α →+* α) : f * g = f.comp g := rfl - -@[simp] lemma coe_mul (f g : α →+* α) : ⇑(f * g) = f ∘ g := rfl - -include rβ rγ - -lemma cancel_right {g₁ g₂ : β →+* γ} {f : α →+* β} (hf : surjective f) : - g₁.comp f = g₂.comp f ↔ g₁ = g₂ := -⟨λ h, ring_hom.ext $ hf.forall.2 (ext_iff.1 h), λ h, h ▸ rfl⟩ - -lemma cancel_left {g : β →+* γ} {f₁ f₂ : α →+* β} (hg : injective g) : - g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ := -⟨λ h, ring_hom.ext $ λ x, hg $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩ - -omit rα rβ rγ - -end ring_hom - -section semiring - -variables [semiring α] {a : α} - -@[simp] theorem two_dvd_bit0 : 2 ∣ bit0 a := ⟨a, bit0_eq_two_mul _⟩ - -lemma ring_hom.map_dvd [semiring β] (f : α →+* β) {a b : α} : a ∣ b → f a ∣ f b := map_dvd f - -end semiring - -/-- A non-unital commutative semiring is a `non_unital_semiring` with commutative multiplication. -In other words, it is a type with the following structures: additive commutative monoid -(`add_comm_monoid`), commutative semigroup (`comm_semigroup`), distributive laws (`distrib`), and -multiplication by zero law (`mul_zero_class`). -/ -@[protect_proj, ancestor non_unital_semiring comm_semigroup] -class non_unital_comm_semiring (α : Type u) extends non_unital_semiring α, comm_semigroup α - -section non_unital_comm_semiring -variables [non_unital_comm_semiring α] [non_unital_comm_semiring β] {a b c : α} - -/-- Pullback a `non_unital_semiring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_unital_comm_semiring [has_zero γ] [has_add γ] [has_mul γ] - [has_scalar ℕ γ] (f : γ → α) (hf : injective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_unital_comm_semiring γ := -{ .. hf.non_unital_semiring f zero add mul nsmul, .. hf.comm_semigroup f mul } - -/-- Pushforward a `non_unital_semiring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_unital_comm_semiring [has_zero γ] [has_add γ] [has_mul γ] - [has_scalar ℕ γ] (f : α → γ) (hf : surjective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : - non_unital_comm_semiring γ := -{ .. hf.non_unital_semiring f zero add mul nsmul, .. hf.comm_semigroup f mul } - -lemma has_dvd.dvd.linear_comb {d x y : α} (hdx : d ∣ x) (hdy : d ∣ y) (a b : α) : - d ∣ (a * x + b * y) := -dvd_add (hdx.mul_left a) (hdy.mul_left b) - -end non_unital_comm_semiring - -/-- A commutative semiring is a `semiring` with commutative multiplication. In other words, it is a -type with the following structures: additive commutative monoid (`add_comm_monoid`), multiplicative -commutative monoid (`comm_monoid`), distributive laws (`distrib`), and multiplication by zero law -(`mul_zero_class`). -/ -@[protect_proj, ancestor semiring comm_monoid] -class comm_semiring (α : Type u) extends semiring α, comm_monoid α - -@[priority 100] -- see Note [lower instance priority] -instance comm_semiring.to_non_unital_comm_semiring [comm_semiring α] : non_unital_comm_semiring α := -{ .. comm_semiring.to_comm_monoid α, .. comm_semiring.to_semiring α } - -@[priority 100] -- see Note [lower instance priority] -instance comm_semiring.to_comm_monoid_with_zero [comm_semiring α] : comm_monoid_with_zero α := -{ .. comm_semiring.to_comm_monoid α, .. comm_semiring.to_semiring α } - -section comm_semiring -variables [comm_semiring α] [comm_semiring β] {a b c : α} - -/-- Pullback a `semiring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.comm_semiring [has_zero γ] [has_one γ] [has_add γ] [has_mul γ] - [has_scalar ℕ γ] [has_pow γ ℕ] (f : γ → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - comm_semiring γ := -{ .. hf.semiring f zero one add mul nsmul npow, .. hf.comm_semigroup f mul } - -/-- Pushforward a `semiring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.comm_semiring [has_zero γ] [has_one γ] [has_add γ] [has_mul γ] - [has_scalar ℕ γ] [has_pow γ ℕ] (f : α → γ) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - comm_semiring γ := -{ .. hf.semiring f zero one add mul nsmul npow, .. hf.comm_semigroup f mul } - -lemma add_mul_self_eq (a b : α) : (a + b) * (a + b) = a*a + 2*a*b + b*b := -by simp only [two_mul, add_mul, mul_add, add_assoc, mul_comm b] - -end comm_semiring - section has_distrib_neg -/-- Typeclass for a negation operator that distributes across multiplication. - -This is useful for dealing with submonoids of a ring that contain `-1` without having to duplicate -lemmas. -/ -class has_distrib_neg (α : Type*) [has_mul α] extends has_involutive_neg α := -(neg_mul : ∀ x y : α, -x * y = -(x * y)) -(mul_neg : ∀ x y : α, x * -y = -(x * y)) - section has_mul variables [has_mul α] [has_distrib_neg α] -@[simp] lemma neg_mul (a b : α) : - a * b = - (a * b) := -has_distrib_neg.neg_mul _ _ - -@[simp] lemma mul_neg (a b : α) : a * - b = - (a * b) := -has_distrib_neg.mul_neg _ _ - -lemma neg_mul_neg (a b : α) : -a * -b = a * b := -by simp - -lemma neg_mul_eq_neg_mul (a b : α) : -(a * b) = -a * b := -(neg_mul _ _).symm - -lemma neg_mul_eq_mul_neg (a b : α) : -(a * b) = a * -b := -(mul_neg _ _).symm +open mul_opposite -lemma neg_mul_comm (a b : α) : -a * b = a * -b := -by simp +instance : has_distrib_neg αᵐᵒᵖ := +{ neg_mul := λ _ _, unop_injective $ mul_neg _ _, + mul_neg := λ _ _, unop_injective $ neg_mul _ _, + ..mul_opposite.has_involutive_neg _ } end has_mul -section mul_one_class -variables [mul_one_class α] [has_distrib_neg α] - -theorem neg_eq_neg_one_mul (a : α) : -a = -1 * a := -by simp - -/-- An element of a ring multiplied by the additive inverse of one is the element's additive - inverse. -/ -lemma mul_neg_one (a : α) : a * -1 = -a := by simp - -/-- The additive inverse of one multiplied by an element of a ring is the element's additive - inverse. -/ -lemma neg_one_mul (a : α) : -1 * a = -a := by simp - -end mul_one_class - -section mul_zero_class -variables [mul_zero_class α] [has_distrib_neg α] - -/-- Prefer `neg_zero` if `add_comm_group` is available. -/ -@[simp] lemma neg_zero' : (-0 : α) = 0 := -by rw [←zero_mul (0 : α), ←neg_mul, mul_zero, mul_zero] - -end mul_zero_class - -section semigroup - -variables [semigroup α] [has_distrib_neg α] {a b c : α} - -theorem dvd_neg_of_dvd (h : a ∣ b) : (a ∣ -b) := -let ⟨c, hc⟩ := h in ⟨-c, by simp [hc]⟩ - -theorem dvd_of_dvd_neg (h : a ∣ -b) : (a ∣ b) := -let t := dvd_neg_of_dvd h in by rwa neg_neg at t - -/-- An element a of a semigroup with a distributive negation divides the negation of an element b -iff a divides b. -/ -@[simp] lemma dvd_neg (a b : α) : (a ∣ -b) ↔ (a ∣ b) := -⟨dvd_of_dvd_neg, dvd_neg_of_dvd⟩ - -theorem neg_dvd_of_dvd (h : a ∣ b) : -a ∣ b := -let ⟨c, hc⟩ := h in ⟨-c, by simp [hc]⟩ - -theorem dvd_of_neg_dvd (h : -a ∣ b) : a ∣ b := -let t := neg_dvd_of_dvd h in by rwa neg_neg at t - -/-- The negation of an element a of a semigroup with a distributive negation divides -another element b iff a divides b. -/ -@[simp] lemma neg_dvd (a b : α) : (-a ∣ b) ↔ (a ∣ b) := -⟨dvd_of_neg_dvd, neg_dvd_of_dvd⟩ - -end semigroup - section group variables [group α] [has_distrib_neg α] @@ -992,386 +97,9 @@ end group end has_distrib_neg -/-! -### Rings --/ - -/-- A not-necessarily-unital, not-necessarily-associative ring. -/ -@[protect_proj, ancestor add_comm_group non_unital_non_assoc_semiring] -class non_unital_non_assoc_ring (α : Type u) extends - add_comm_group α, non_unital_non_assoc_semiring α - -section non_unital_non_assoc_ring -variables [non_unital_non_assoc_ring α] - - -/-- Pullback a `non_unital_non_assoc_ring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_unital_non_assoc_ring - [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_scalar ℕ β] [has_scalar ℤ β] - (f : β → α) (hf : injective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_unital_non_assoc_ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul zsmul, ..hf.mul_zero_class f zero mul, - .. hf.distrib f add mul } - -/-- Pushforward a `non_unital_non_assoc_ring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_unital_non_assoc_ring - [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_scalar ℕ β] [has_scalar ℤ β] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_unital_non_assoc_ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul zsmul, .. hf.mul_zero_class f zero mul, - .. hf.distrib f add mul } - -@[priority 100] -instance non_unital_non_assoc_ring.to_has_distrib_neg : has_distrib_neg α := -{ neg := has_neg.neg, - neg_neg := neg_neg, - neg_mul := λ a b, (neg_eq_of_add_eq_zero $ by rw [← right_distrib, add_right_neg, zero_mul]).symm, - mul_neg := λ a b, (neg_eq_of_add_eq_zero $ by rw [← left_distrib, add_right_neg, mul_zero]).symm } - -lemma mul_sub_left_distrib (a b c : α) : a * (b - c) = a * b - a * c := -by simpa only [sub_eq_add_neg, neg_mul_eq_mul_neg] using mul_add a b (-c) - -alias mul_sub_left_distrib ← mul_sub - -lemma mul_sub_right_distrib (a b c : α) : (a - b) * c = a * c - b * c := -by simpa only [sub_eq_add_neg, neg_mul_eq_neg_mul] using add_mul a (-b) c - -alias mul_sub_right_distrib ← sub_mul - -variables {a b c d e : α} - -/-- An iff statement following from right distributivity in rings and the definition - of subtraction. -/ -theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d := -calc - a * e + c = b * e + d ↔ a * e + c = d + b * e : by simp [add_comm] - ... ↔ a * e + c - b * e = d : iff.intro (λ h, begin rw h, simp end) (λ h, - begin rw ← h, simp end) - ... ↔ (a - b) * e + c = d : begin simp [sub_mul, sub_add_eq_add_sub] end - -/-- A simplification of one side of an equation exploiting right distributivity in rings - and the definition of subtraction. -/ -theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d := -assume h, -calc - (a - b) * e + c = (a * e + c) - b * e : begin simp [sub_mul, sub_add_eq_add_sub] end - ... = d : begin rw h, simp [@add_sub_cancel α] end - -end non_unital_non_assoc_ring - -/-- An associative but not-necessarily unital ring. -/ -@[protect_proj, ancestor non_unital_non_assoc_ring non_unital_semiring] -class non_unital_ring (α : Type*) extends - non_unital_non_assoc_ring α, non_unital_semiring α - -section non_unital_ring -variables [non_unital_ring α] - -/-- Pullback a `non_unital_ring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_unital_ring - [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_scalar ℕ β] [has_scalar ℤ β] - (f : β → α) (hf : injective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_unital_ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, ..hf.mul_zero_class f zero mul, - .. hf.distrib f add mul, .. hf.semigroup f mul } - -/-- Pushforward a `non_unital_ring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_unital_ring - [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_scalar ℕ β] [has_scalar ℤ β] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_unital_ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, .. hf.mul_zero_class f zero mul, - .. hf.distrib f add mul, .. hf.semigroup f mul } - -end non_unital_ring - -/-- A unital but not-necessarily-associative ring. -/ -@[protect_proj, ancestor non_unital_non_assoc_ring non_assoc_semiring] -class non_assoc_ring (α : Type*) extends - non_unital_non_assoc_ring α, non_assoc_semiring α - -section non_assoc_ring -variables [non_assoc_ring α] - -/-- Pullback a `non_assoc_ring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_assoc_ring - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] - (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_assoc_ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, - .. hf.mul_zero_class f zero mul, .. hf.distrib f add mul, - .. hf.mul_one_class f one mul } - -/-- Pushforward a `non_unital_ring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_assoc_ring - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_assoc_ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, .. hf.mul_zero_class f zero mul, - .. hf.distrib f add mul, .. hf.mul_one_class f one mul } - -lemma sub_one_mul (a b : α) : (a - 1) * b = a * b - b := -by rw [sub_mul, one_mul] -lemma mul_sub_one (a b : α) : a * (b - 1) = a * b - a := -by rw [mul_sub, mul_one] -lemma one_sub_mul (a b : α) : (1 - a) * b = b - a * b := -by rw [sub_mul, one_mul] -lemma mul_one_sub (a b : α) : a * (1 - b) = a - a * b := -by rw [mul_sub, mul_one] - -end non_assoc_ring - -/-- A ring is a type with the following structures: additive commutative group (`add_comm_group`), -multiplicative monoid (`monoid`), and distributive laws (`distrib`). Equivalently, a ring is a -`semiring` with a negation operation making it an additive group. -/ -@[protect_proj, ancestor add_comm_group monoid distrib] -class ring (α : Type u) extends add_comm_group α, monoid α, distrib α - -section ring -variables [ring α] {a b c d e : α} - -/- A (unital, associative) ring is a not-necessarily-unital ring -/ -@[priority 100] -- see Note [lower instance priority] -instance ring.to_non_unital_ring : - non_unital_ring α := -{ zero_mul := λ a, add_left_cancel $ show 0 * a + 0 * a = 0 * a + 0, - by rw [← add_mul, zero_add, add_zero], - mul_zero := λ a, add_left_cancel $ show a * 0 + a * 0 = a * 0 + 0, - by rw [← mul_add, add_zero, add_zero], - ..‹ring α› } - -/- A (unital, associative) ring is a not-necessarily-associative ring -/ -@[priority 100] -- see Note [lower instance priority] -instance ring.to_non_assoc_ring : - non_assoc_ring α := -{ zero_mul := λ a, add_left_cancel $ show 0 * a + 0 * a = 0 * a + 0, - by rw [← add_mul, zero_add, add_zero], - mul_zero := λ a, add_left_cancel $ show a * 0 + a * 0 = a * 0 + 0, - by rw [← mul_add, add_zero, add_zero], - ..‹ring α› } - -/- The instance from `ring` to `semiring` happens often in linear algebra, for which all the basic -definitions are given in terms of semirings, but many applications use rings or fields. We increase -a little bit its priority above 100 to try it quickly, but remaining below the default 1000 so that -more specific instances are tried first. -/ -@[priority 200] -instance ring.to_semiring : semiring α := -{ ..‹ring α›, .. ring.to_non_unital_ring } - -/-- Pullback a `ring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.ring - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul zsmul, - .. hf.monoid f one mul npow, .. hf.distrib f add mul } - -/-- Pushforward a `ring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.ring - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - ring β := -{ .. hf.add_comm_group f zero add neg sub nsmul zsmul, - .. hf.monoid f one mul npow, .. hf.distrib f add mul } - -end ring - -namespace units -variables [ring α] {a b : α} - -/-- Each element of the group of units of a ring has an additive inverse. -/ -instance : has_neg αˣ := ⟨λu, ⟨-↑u, -↑u⁻¹, by simp, by simp⟩ ⟩ - -/-- Representing an element of a ring's unit group as an element of the ring commutes with - mapping this element to its additive inverse. -/ -@[simp, norm_cast] protected theorem coe_neg (u : αˣ) : (↑-u : α) = -u := rfl - -@[simp, norm_cast] protected theorem coe_neg_one : ((-1 : αˣ) : α) = -1 := rfl - -instance : has_distrib_neg αˣ := -{ neg := has_neg.neg, - neg_neg := λ u, units.ext $ neg_neg _, - neg_mul := λ u₁ u₂, units.ext $ neg_mul _ _, - mul_neg := λ u₁ u₂, units.ext $ mul_neg _ _, } - -end units - -lemma is_unit.neg [ring α] {a : α} : is_unit a → is_unit (-a) -| ⟨x, hx⟩ := hx ▸ (-x).is_unit - -lemma is_unit.neg_iff [ring α] (a : α) : is_unit (-a) ↔ is_unit a := -⟨λ h, neg_neg a ▸ h.neg, is_unit.neg⟩ - -lemma is_unit.sub_iff [ring α] {x y : α} : - is_unit (x - y) ↔ is_unit (y - x) := -(is_unit.neg_iff _).symm.trans $ neg_sub x y ▸ iff.rfl - -namespace ring_hom - -/-- Ring homomorphisms preserve additive inverse. -/ -protected theorem map_neg {α β} [non_assoc_ring α] [non_assoc_ring β] (f : α →+* β) (x : α) : - f (-x) = -(f x) := -map_neg f x - -/-- Ring homomorphisms preserve subtraction. -/ -protected theorem map_sub {α β} [non_assoc_ring α] [non_assoc_ring β] (f : α →+* β) (x y : α) : - f (x - y) = (f x) - (f y) := map_sub f x y - -/-- Makes a ring homomorphism from a monoid homomorphism of rings which preserves addition. -/ -def mk' {γ} [non_assoc_semiring α] [non_assoc_ring γ] (f : α →* γ) - (map_add : ∀ a b : α, f (a + b) = f a + f b) : - α →+* γ := -{ to_fun := f, - .. add_monoid_hom.mk' f map_add, .. f } - -end ring_hom - -/-- A non-unital commutative ring is a `non_unital_ring` with commutative multiplication. -/ -@[protect_proj, ancestor non_unital_ring comm_semigroup] -class non_unital_comm_ring (α : Type u) extends non_unital_ring α, comm_semigroup α - -@[priority 100] -- see Note [lower instance priority] -instance non_unital_comm_ring.to_non_unital_comm_semiring [s : non_unital_comm_ring α] : - non_unital_comm_semiring α := -{ ..s } - -/-- A commutative ring is a `ring` with commutative multiplication. -/ -@[protect_proj, ancestor ring comm_semigroup] -class comm_ring (α : Type u) extends ring α, comm_monoid α - -@[priority 100] -- see Note [lower instance priority] -instance comm_ring.to_comm_semiring [s : comm_ring α] : comm_semiring α := -{ mul_zero := mul_zero, zero_mul := zero_mul, ..s } - -@[priority 100] -- see Note [lower instance priority] -instance comm_ring.to_non_unital_comm_ring [s : comm_ring α] : non_unital_comm_ring α := -{ mul_zero := mul_zero, zero_mul := zero_mul, ..s } - -section non_unital_ring -variables [non_unital_ring α] {a b c : α} - -theorem dvd_sub (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c := -by { rw sub_eq_add_neg, exact dvd_add h₁ (dvd_neg_of_dvd h₂) } - -theorem dvd_add_iff_left (h : a ∣ c) : a ∣ b ↔ a ∣ b + c := -⟨λh₂, dvd_add h₂ h, λH, by have t := dvd_sub H h; rwa add_sub_cancel at t⟩ - -theorem dvd_add_iff_right (h : a ∣ b) : a ∣ c ↔ a ∣ b + c := -by rw add_comm; exact dvd_add_iff_left h - -/-- If an element a divides another element c in a commutative ring, a divides the sum of another - element b with c iff a divides b. -/ -theorem dvd_add_left (h : a ∣ c) : a ∣ b + c ↔ a ∣ b := -(dvd_add_iff_left h).symm - -/-- If an element a divides another element b in a commutative ring, a divides the sum of b and - another element c iff a divides c. -/ -theorem dvd_add_right (h : a ∣ b) : a ∣ b + c ↔ a ∣ c := -(dvd_add_iff_right h).symm - -lemma dvd_iff_dvd_of_dvd_sub {a b c : α} (h : a ∣ (b - c)) : (a ∣ b ↔ a ∣ c) := -begin - split, - { intro h', - convert dvd_sub h' h, - exact eq.symm (sub_sub_self b c) }, - { intro h', - convert dvd_add h h', - exact eq_add_of_sub_eq rfl } -end - -end non_unital_ring - -section ring -variables [ring α] {a b c : α} - -theorem two_dvd_bit1 : 2 ∣ bit1 a ↔ (2 : α) ∣ 1 := (dvd_add_iff_right (@two_dvd_bit0 _ _ a)).symm - -/-- An element a divides the sum a + b if and only if a divides b.-/ -@[simp] lemma dvd_add_self_left {a b : α} : a ∣ a + b ↔ a ∣ b := -dvd_add_right (dvd_refl a) - -/-- An element a divides the sum b + a if and only if a divides b.-/ -@[simp] lemma dvd_add_self_right {a b : α} : a ∣ b + a ↔ a ∣ b := -dvd_add_left (dvd_refl a) - -end ring - section non_unital_comm_ring variables [non_unital_comm_ring α] {a b c : α} -/-- Pullback a `comm_ring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.non_unital_comm_ring - [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] - (f : β → α) (hf : injective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_unital_comm_ring β := -{ .. hf.non_unital_ring f zero add mul neg sub nsmul zsmul, .. hf.comm_semigroup f mul } - -/-- Pushforward a `non_unital_comm_ring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.non_unital_comm_ring - [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : - non_unital_comm_ring β := -{ .. hf.non_unital_ring f zero add mul neg sub nsmul zsmul, .. hf.comm_semigroup f mul } - local attribute [simp] add_assoc add_comm add_left_comm mul_comm /-- Vieta's formula for a quadratic equation, relating the coefficients of the polynomial with @@ -1381,310 +109,67 @@ local attribute [simp] add_assoc add_comm add_left_comm mul_comm lemma Vieta_formula_quadratic {b c x : α} (h : x * x - b * x + c = 0) : ∃ y : α, y * y - b * y + c = 0 ∧ x + y = b ∧ x * y = c := begin - have : c = -(x * x - b * x) := (neg_eq_of_add_eq_zero h).symm, - have : c = x * (b - x), by subst this; simp [mul_sub, mul_comm], + have : c = x * (b - x) := (eq_neg_of_add_eq_zero_right h).trans (by simp [mul_sub, mul_comm]), refine ⟨b - x, _, by simp, by rw this⟩, rw [this, sub_add, ← sub_mul, sub_self] end -lemma dvd_mul_sub_mul {k a b x y : α} (hab : k ∣ a - b) (hxy : k ∣ x - y) : - k ∣ a * x - b * y := -begin - convert dvd_add (hxy.mul_left a) (hab.mul_right y), - rw [mul_sub_left_distrib, mul_sub_right_distrib], - simp only [sub_eq_add_neg, add_assoc, neg_add_cancel_left], -end - end non_unital_comm_ring -section comm_ring -variables [comm_ring α] {a b c : α} - -/-- Pullback a `comm_ring` instance along an injective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.injective.comm_ring - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - comm_ring β := -{ .. hf.ring f zero one add mul neg sub nsmul zsmul npow, .. hf.comm_semigroup f mul } - -/-- Pushforward a `comm_ring` instance along a surjective function. -See note [reducible non-instances]. -/ -@[reducible] -protected def function.surjective.comm_ring - [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] - [has_scalar ℕ β] [has_scalar ℤ β] [has_pow β ℕ] - (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) - (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) - (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) - (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) - (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) : - comm_ring β := -{ .. hf.ring f zero one add mul neg sub nsmul zsmul npow, .. hf.comm_semigroup f mul } - -end comm_ring - lemma succ_ne_self [non_assoc_ring α] [nontrivial α] (a : α) : a + 1 ≠ a := λ h, one_ne_zero ((add_right_inj a).mp (by simp [h])) lemma pred_ne_self [non_assoc_ring α] [nontrivial α] (a : α) : a - 1 ≠ a := λ h, one_ne_zero (neg_injective ((add_right_inj a).mp (by simpa [sub_eq_add_neg] using h))) -/-- Left `mul` by a `k : α` over `[ring α]` is injective, if `k` is not a zero divisor. -The typeclass that restricts all terms of `α` to have this property is `no_zero_divisors`. -/ -lemma is_left_regular_of_non_zero_divisor [non_unital_non_assoc_ring α] (k : α) - (h : ∀ (x : α), k * x = 0 → x = 0) : is_left_regular k := +section no_zero_divisors + +variable (α) + +lemma is_left_cancel_mul_zero.to_no_zero_divisors [ring α] [is_left_cancel_mul_zero α] : + no_zero_divisors α := begin - refine λ x y (h' : k * x = k * y), sub_eq_zero.mp (h _ _), - rw [mul_sub, sub_eq_zero, h'] + refine ⟨λ x y h, _⟩, + by_cases hx : x = 0, + { left, exact hx }, + { right, + rw [← sub_zero (x * y), ← mul_zero x, ← mul_sub] at h, + convert (is_left_cancel_mul_zero.mul_left_cancel_of_ne_zero) hx h, + rw [sub_zero] } end -/-- Right `mul` by a `k : α` over `[ring α]` is injective, if `k` is not a zero divisor. -The typeclass that restricts all terms of `α` to have this property is `no_zero_divisors`. -/ -lemma is_right_regular_of_non_zero_divisor [non_unital_non_assoc_ring α] (k : α) - (h : ∀ (x : α), x * k = 0 → x = 0) : is_right_regular k := +lemma is_right_cancel_mul_zero.to_no_zero_divisors [ring α] [is_right_cancel_mul_zero α] : + no_zero_divisors α := begin - refine λ x y (h' : x * k = y * k), sub_eq_zero.mp (h _ _), - rw [sub_mul, sub_eq_zero, h'] + refine ⟨λ x y h, _⟩, + by_cases hy : y = 0, + { right, exact hy }, + { left, + rw [← sub_zero (x * y), ← zero_mul y, ← sub_mul] at h, + convert (is_right_cancel_mul_zero.mul_right_cancel_of_ne_zero) hy h, + rw [sub_zero] } end -lemma is_regular_of_ne_zero' [non_unital_non_assoc_ring α] [no_zero_divisors α] {k : α} - (hk : k ≠ 0) : is_regular k := -⟨is_left_regular_of_non_zero_divisor k - (λ x h, (no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left hk), - is_right_regular_of_non_zero_divisor k - (λ x h, (no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hk)⟩ - -lemma is_regular_iff_ne_zero' [nontrivial α] [non_unital_non_assoc_ring α] [no_zero_divisors α] - {k : α} : is_regular k ↔ k ≠ 0 := -⟨λ h, by { rintro rfl, exact not_not.mpr h.left not_is_left_regular_zero }, is_regular_of_ne_zero'⟩ - -/-- A ring with no zero divisors is a cancel_monoid_with_zero. - -Note this is not an instance as it forms a typeclass loop. -/ -@[reducible] -def no_zero_divisors.to_cancel_monoid_with_zero [ring α] [no_zero_divisors α] : - cancel_monoid_with_zero α := -{ mul_left_cancel_of_ne_zero := λ a b c ha, - @is_regular.left _ _ _ (is_regular_of_ne_zero' ha) _ _, - mul_right_cancel_of_ne_zero := λ a b c hb, - @is_regular.right _ _ _ (is_regular_of_ne_zero' hb) _ _, - .. (infer_instance : semiring α) } - -/-- A domain is a nontrivial ring with no zero divisors, i.e. satisfying - the condition `a * b = 0 ↔ a = 0 ∨ b = 0`. - - This is implemented as a mixin for `ring α`. - To obtain an integral domain use `[comm_ring α] [is_domain α]`. -/ -@[protect_proj] class is_domain (α : Type u) [ring α] - extends no_zero_divisors α, nontrivial α : Prop - -section is_domain -section ring - -variables [ring α] [is_domain α] - -@[priority 100] -- see Note [lower instance priority] -instance is_domain.to_cancel_monoid_with_zero : cancel_monoid_with_zero α := -no_zero_divisors.to_cancel_monoid_with_zero - -/-- Pullback an `is_domain` instance along an injective function. -/ -protected theorem function.injective.is_domain [ring β] (f : β →+* α) (hf : injective f) : - is_domain β := -{ .. pullback_nonzero f f.map_zero f.map_one, - .. hf.no_zero_divisors f f.map_zero f.map_mul } - -end ring - -section comm_ring - -variables [comm_ring α] [is_domain α] - -@[priority 100] -- see Note [lower instance priority] -instance is_domain.to_cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero α := -{ ..comm_semiring.to_comm_monoid_with_zero, ..is_domain.to_cancel_monoid_with_zero } - -/-- -Makes a ring homomorphism from an additive group homomorphism from a commutative ring to an integral -domain that commutes with self multiplication, assumes that two is nonzero and one is sent to one. --/ -def add_monoid_hom.mk_ring_hom_of_mul_self_of_two_ne_zero [comm_ring β] (f : β →+ α) - (h : ∀ x, f (x * x) = f x * f x) (h_two : (2 : α) ≠ 0) (h_one : f 1 = 1) : β →+* α := -{ map_one' := h_one, - map_mul' := begin - intros x y, - have hxy := h (x + y), - rw [mul_add, add_mul, add_mul, f.map_add, f.map_add, f.map_add, f.map_add, h x, h y, add_mul, - mul_add, mul_add, ← sub_eq_zero, add_comm, ← sub_sub, ← sub_sub, ← sub_sub, - mul_comm y x, mul_comm (f y) (f x)] at hxy, - simp only [add_assoc, add_sub_assoc, add_sub_cancel'_right] at hxy, - rw [sub_sub, ← two_mul, ← add_sub_assoc, ← two_mul, ← mul_sub, mul_eq_zero, sub_eq_zero, - or_iff_not_imp_left] at hxy, - exact hxy h_two, +@[priority 100] +instance no_zero_divisors.to_is_cancel_mul_zero [ring α] [no_zero_divisors α] : + is_cancel_mul_zero α := +{ mul_left_cancel_of_ne_zero := λ a b c ha h, + begin + rw [← sub_eq_zero, ← mul_sub] at h, + exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha) end, - ..f } - -@[simp] -lemma add_monoid_hom.coe_fn_mk_ring_hom_of_mul_self_of_two_ne_zero [comm_ring β] (f : β →+ α) - (h h_two h_one) : - (f.mk_ring_hom_of_mul_self_of_two_ne_zero h h_two h_one : β → α) = f := rfl - -@[simp] -lemma add_monoid_hom.coe_add_monoid_hom_mk_ring_hom_of_mul_self_of_two_ne_zero [comm_ring β] - (f : β →+ α) (h h_two h_one) : - (f.mk_ring_hom_of_mul_self_of_two_ne_zero h h_two h_one : β →+ α) = f := by {ext, simp} - -end comm_ring - -end is_domain + mul_right_cancel_of_ne_zero := λ a b c hb h, + begin + rw [← sub_eq_zero, ← sub_mul] at h, + exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb) + end } -namespace semiconj_by +lemma no_zero_divisors.to_is_domain [ring α] [h : nontrivial α] [no_zero_divisors α] : + is_domain α := +{ .. no_zero_divisors.to_is_cancel_mul_zero α, .. h } -@[simp] lemma add_right [distrib R] {a x y x' y' : R} - (h : semiconj_by a x y) (h' : semiconj_by a x' y') : - semiconj_by a (x + x') (y + y') := -by simp only [semiconj_by, left_distrib, right_distrib, h.eq, h'.eq] - -@[simp] lemma add_left [distrib R] {a b x y : R} - (ha : semiconj_by a x y) (hb : semiconj_by b x y) : - semiconj_by (a + b) x y := -by simp only [semiconj_by, left_distrib, right_distrib, ha.eq, hb.eq] - -section -variables [has_mul R] [has_distrib_neg R] {a x y : R} - -lemma neg_right (h : semiconj_by a x y) : semiconj_by a (-x) (-y) := -by simp only [semiconj_by, h.eq, neg_mul, mul_neg] - -@[simp] lemma neg_right_iff : semiconj_by a (-x) (-y) ↔ semiconj_by a x y := -⟨λ h, neg_neg x ▸ neg_neg y ▸ h.neg_right, semiconj_by.neg_right⟩ - -lemma neg_left (h : semiconj_by a x y) : semiconj_by (-a) x y := -by simp only [semiconj_by, h.eq, neg_mul, mul_neg] - -@[simp] lemma neg_left_iff : semiconj_by (-a) x y ↔ semiconj_by a x y := -⟨λ h, neg_neg a ▸ h.neg_left, semiconj_by.neg_left⟩ - -end - -section -variables [mul_one_class R] [has_distrib_neg R] {a x y : R} - -@[simp] lemma neg_one_right (a : R) : semiconj_by a (-1) (-1) := -(one_right a).neg_right - -@[simp] lemma neg_one_left (x : R) : semiconj_by (-1) x x := -(semiconj_by.one_left x).neg_left - -end - -section -variables [non_unital_non_assoc_ring R] {a b x y x' y' : R} - -@[simp] lemma sub_right (h : semiconj_by a x y) (h' : semiconj_by a x' y') : - semiconj_by a (x - x') (y - y') := -by simpa only [sub_eq_add_neg] using h.add_right h'.neg_right - -@[simp] lemma sub_left (ha : semiconj_by a x y) (hb : semiconj_by b x y) : - semiconj_by (a - b) x y := -by simpa only [sub_eq_add_neg] using ha.add_left hb.neg_left - -end - -end semiconj_by - -namespace commute - -@[simp] theorem add_right [distrib R] {a b c : R} : - commute a b → commute a c → commute a (b + c) := -semiconj_by.add_right - -@[simp] theorem add_left [distrib R] {a b c : R} : - commute a c → commute b c → commute (a + b) c := -semiconj_by.add_left - -lemma bit0_right [distrib R] {x y : R} (h : commute x y) : commute x (bit0 y) := -h.add_right h - -lemma bit0_left [distrib R] {x y : R} (h : commute x y) : commute (bit0 x) y := -h.add_left h - -lemma bit1_right [non_assoc_semiring R] {x y : R} (h : commute x y) : commute x (bit1 y) := -h.bit0_right.add_right (commute.one_right x) - -lemma bit1_left [non_assoc_semiring R] {x y : R} (h : commute x y) : commute (bit1 x) y := -h.bit0_left.add_left (commute.one_left y) - -/-- Representation of a difference of two squares of commuting elements as a product. -/ -lemma mul_self_sub_mul_self_eq [non_unital_non_assoc_ring R] {a b : R} (h : commute a b) : - a * a - b * b = (a + b) * (a - b) := -by rw [add_mul, mul_sub, mul_sub, h.eq, sub_add_sub_cancel] - -lemma mul_self_sub_mul_self_eq' [non_unital_non_assoc_ring R] {a b : R} (h : commute a b) : - a * a - b * b = (a - b) * (a + b) := -by rw [mul_add, sub_mul, sub_mul, h.eq, sub_add_sub_cancel] - -lemma mul_self_eq_mul_self_iff [non_unital_non_assoc_ring R] [no_zero_divisors R] {a b : R} - (h : commute a b) : a * a = b * b ↔ a = b ∨ a = -b := -by rw [← sub_eq_zero, h.mul_self_sub_mul_self_eq, mul_eq_zero, or_comm, sub_eq_zero, - add_eq_zero_iff_eq_neg] - -section -variables [has_mul R] [has_distrib_neg R] {a b : R} - -theorem neg_right : commute a b → commute a (- b) := semiconj_by.neg_right -@[simp] theorem neg_right_iff : commute a (-b) ↔ commute a b := semiconj_by.neg_right_iff - -theorem neg_left : commute a b → commute (- a) b := semiconj_by.neg_left -@[simp] theorem neg_left_iff : commute (-a) b ↔ commute a b := semiconj_by.neg_left_iff - -end - -section -variables [mul_one_class R] [has_distrib_neg R] {a : R} - -@[simp] theorem neg_one_right (a : R) : commute a (-1) := semiconj_by.neg_one_right a -@[simp] theorem neg_one_left (a : R): commute (-1) a := semiconj_by.neg_one_left a - -end - -section -variables [non_unital_non_assoc_ring R] {a b c : R} - -@[simp] theorem sub_right : commute a b → commute a c → commute a (b - c) := semiconj_by.sub_right -@[simp] theorem sub_left : commute a c → commute b c → commute (a - b) c := semiconj_by.sub_left - -end - -end commute - -/-- Representation of a difference of two squares in a commutative ring as a product. -/ -theorem mul_self_sub_mul_self [comm_ring R] (a b : R) : a * a - b * b = (a + b) * (a - b) := -(commute.all a b).mul_self_sub_mul_self_eq - -lemma mul_self_sub_one [non_assoc_ring R] (a : R) : a * a - 1 = (a + 1) * (a - 1) := -by rw [←(commute.one_right a).mul_self_sub_mul_self_eq, mul_one] - -lemma mul_self_eq_mul_self_iff [comm_ring R] [no_zero_divisors R] {a b : R} : - a * a = b * b ↔ a = b ∨ a = -b := -(commute.all a b).mul_self_eq_mul_self_iff - -lemma mul_self_eq_one_iff [non_assoc_ring R] [no_zero_divisors R] {a : R} : - a * a = 1 ↔ a = 1 ∨ a = -1 := -by rw [←(commute.one_right a).mul_self_eq_mul_self_iff, mul_one] +@[priority 100] +instance is_domain.to_no_zero_divisors [ring α] [is_domain α] : no_zero_divisors α := +is_right_cancel_mul_zero.to_no_zero_divisors α -/-- In the unit group of an integral domain, a unit is its own inverse iff the unit is one or - one's additive inverse. -/ -lemma units.inv_eq_self_iff [ring R] [no_zero_divisors R] (u : Rˣ) : u⁻¹ = u ↔ u = 1 ∨ u = -1 := -begin - rw inv_eq_iff_mul_eq_one, - simp only [units.ext_iff], - push_cast, - exact mul_self_eq_one_iff -end +end no_zero_divisors diff --git a/src/algebra/ring/boolean_ring.lean b/src/algebra/ring/boolean_ring.lean index 3851071263fab..2e892c98278e8 100644 --- a/src/algebra/ring/boolean_ring.lean +++ b/src/algebra/ring/boolean_ring.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bryan Gin-ge Chen, Yaël Dillies -/ import algebra.punit_instances -import order.hom.lattice import tactic.abel import tactic.ring +import order.hom.lattice /-! # Boolean rings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A Boolean ring is a ring where multiplication is idempotent. They are equivalent to Boolean algebras. @@ -63,7 +66,7 @@ calc -a = -a + 0 : by rw add_zero ... = -a + -a + a : by rw [←neg_add_self, add_assoc] ... = a : by rw [add_self, zero_add] -lemma add_eq_zero : a + b = 0 ↔ a = b := +lemma add_eq_zero' : a + b = 0 ↔ a = b := calc a + b = 0 ↔ a = -b : add_eq_zero_iff_eq_neg ... ↔ a = b : by rw neg_eq @@ -82,7 +85,7 @@ by rw [sub_eq_add_neg, add_right_inj, neg_eq] @[priority 100] -- Note [lower instance priority] instance boolean_ring.to_comm_ring : comm_ring α := -{ mul_comm := λ a b, by rw [←add_eq_zero, mul_add_mul], +{ mul_comm := λ a b, by rw [←add_eq_zero', mul_add_mul], .. (infer_instance : boolean_ring α) } end boolean_ring @@ -135,7 +138,10 @@ lemma inf_assoc (a b c : α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := by { dsimp onl lemma sup_inf_self (a b : α) : a ⊔ a ⊓ b = a := by { dsimp only [(⊔), (⊓)], assoc_rw [mul_self, add_self, add_zero] } lemma inf_sup_self (a b : α) : a ⊓ (a ⊔ b) = a := -by { dsimp only [(⊔), (⊓)], assoc_rw [mul_add, mul_add, mul_self, mul_self, add_self, add_zero] } +begin + dsimp only [(⊔), (⊓)], + rw [mul_add, mul_add, mul_self, ←mul_assoc, mul_self, add_assoc, add_self, add_zero] +end lemma le_sup_inf_aux (a b c : α) : (a + b + a * b) * (a + c + a * c) = a + b * c + a * (b * c) := calc (a + b + a * b) * (a + c + a * c) = @@ -161,7 +167,6 @@ The data is defined so that: * `a \ b` unfolds to `a * (1 + b)` -/ def to_boolean_algebra : boolean_algebra α := -boolean_algebra.of_core { le_sup_inf := le_sup_inf, top := 1, le_top := λ a, show a + 1 + a * 1 = 1, by assoc_rw [mul_one, add_comm, add_self, add_zero], @@ -357,7 +362,7 @@ from `α` to `β` considered as Boolean rings. -/ { to_fun := to_boolring ∘ f ∘ of_boolring, map_zero' := f.map_bot', map_one' := f.map_top', - map_add' := map_symm_diff f, + map_add' := map_symm_diff' f, map_mul' := f.map_inf' } @[simp] lemma bounded_lattice_hom.as_boolring_id : @@ -385,3 +390,25 @@ end algebra_to_ring { map_mul' := λ a b, rfl, map_add' := of_boolalg_symm_diff, ..of_boolring.trans of_boolalg } + +open bool + +instance : boolean_ring bool := +{ add := bxor, + add_assoc := bxor_assoc, + zero := ff, + zero_add := ff_bxor, + add_zero := bxor_ff, + neg := id, + sub := bxor, + sub_eq_add_neg := λ _ _, rfl, + add_left_neg := bxor_self, + add_comm := bxor_comm, + one := tt, + mul := band, + mul_assoc := band_assoc, + one_mul := tt_band, + mul_one := band_tt, + left_distrib := band_bxor_distrib_left, + right_distrib := band_bxor_distrib_right, + mul_self := band_self } diff --git a/src/algebra/ring/commute.lean b/src/algebra/ring/commute.lean new file mode 100644 index 0000000000000..9241b24a54e7e --- /dev/null +++ b/src/algebra/ring/commute.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.ring.semiconj +import algebra.ring.units +import algebra.group.commute + +/-! +# Semirings and rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file gives lemmas about semirings, rings and domains. +This is analogous to `algebra.group.basic`, +the difference being that the former is about `+` and `*` separately, while +the present file is about their interaction. + +For the definitions of semirings and rings see `algebra.ring.defs`. + +-/ +universes u v w x +variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x} + +open function + +namespace commute + +@[simp] theorem add_right [distrib R] {a b c : R} : + commute a b → commute a c → commute a (b + c) := +semiconj_by.add_right + +@[simp] theorem add_left [distrib R] {a b c : R} : + commute a c → commute b c → commute (a + b) c := +semiconj_by.add_left + +lemma bit0_right [distrib R] {x y : R} (h : commute x y) : commute x (bit0 y) := +h.add_right h + +lemma bit0_left [distrib R] {x y : R} (h : commute x y) : commute (bit0 x) y := +h.add_left h + +lemma bit1_right [non_assoc_semiring R] {x y : R} (h : commute x y) : commute x (bit1 y) := +h.bit0_right.add_right (commute.one_right x) + +lemma bit1_left [non_assoc_semiring R] {x y : R} (h : commute x y) : commute (bit1 x) y := +h.bit0_left.add_left (commute.one_left y) + +/-- Representation of a difference of two squares of commuting elements as a product. -/ +lemma mul_self_sub_mul_self_eq [non_unital_non_assoc_ring R] {a b : R} (h : commute a b) : + a * a - b * b = (a + b) * (a - b) := +by rw [add_mul, mul_sub, mul_sub, h.eq, sub_add_sub_cancel] + +lemma mul_self_sub_mul_self_eq' [non_unital_non_assoc_ring R] {a b : R} (h : commute a b) : + a * a - b * b = (a - b) * (a + b) := +by rw [mul_add, sub_mul, sub_mul, h.eq, sub_add_sub_cancel] + +lemma mul_self_eq_mul_self_iff [non_unital_non_assoc_ring R] [no_zero_divisors R] {a b : R} + (h : commute a b) : a * a = b * b ↔ a = b ∨ a = -b := +by rw [← sub_eq_zero, h.mul_self_sub_mul_self_eq, mul_eq_zero, or_comm, sub_eq_zero, + add_eq_zero_iff_eq_neg] + +section +variables [has_mul R] [has_distrib_neg R] {a b : R} + +theorem neg_right : commute a b → commute a (- b) := semiconj_by.neg_right +@[simp] theorem neg_right_iff : commute a (-b) ↔ commute a b := semiconj_by.neg_right_iff + +theorem neg_left : commute a b → commute (- a) b := semiconj_by.neg_left +@[simp] theorem neg_left_iff : commute (-a) b ↔ commute a b := semiconj_by.neg_left_iff + +end + +section +variables [mul_one_class R] [has_distrib_neg R] {a : R} + +@[simp] theorem neg_one_right (a : R) : commute a (-1) := semiconj_by.neg_one_right a +@[simp] theorem neg_one_left (a : R): commute (-1) a := semiconj_by.neg_one_left a + +end + +section +variables [non_unital_non_assoc_ring R] {a b c : R} + +@[simp] theorem sub_right : commute a b → commute a c → commute a (b - c) := semiconj_by.sub_right +@[simp] theorem sub_left : commute a c → commute b c → commute (a - b) c := semiconj_by.sub_left + +end + +end commute + +/-- Representation of a difference of two squares in a commutative ring as a product. -/ +theorem mul_self_sub_mul_self [comm_ring R] (a b : R) : a * a - b * b = (a + b) * (a - b) := +(commute.all a b).mul_self_sub_mul_self_eq + +lemma mul_self_sub_one [non_assoc_ring R] (a : R) : a * a - 1 = (a + 1) * (a - 1) := +by rw [←(commute.one_right a).mul_self_sub_mul_self_eq, mul_one] + +lemma mul_self_eq_mul_self_iff [comm_ring R] [no_zero_divisors R] {a b : R} : + a * a = b * b ↔ a = b ∨ a = -b := +(commute.all a b).mul_self_eq_mul_self_iff + +lemma mul_self_eq_one_iff [non_assoc_ring R] [no_zero_divisors R] {a : R} : + a * a = 1 ↔ a = 1 ∨ a = -1 := +by rw [←(commute.one_right a).mul_self_eq_mul_self_iff, mul_one] + +namespace units + +/-- In the unit group of an integral domain, a unit is its own inverse iff the unit is one or + one's additive inverse. -/ +lemma inv_eq_self_iff [ring R] [no_zero_divisors R] (u : Rˣ) : u⁻¹ = u ↔ u = 1 ∨ u = -1 := +begin + rw inv_eq_iff_mul_eq_one, + simp only [ext_iff], + push_cast, + exact mul_self_eq_one_iff +end + +end units diff --git a/src/algebra/ring/comp_typeclasses.lean b/src/algebra/ring/comp_typeclasses.lean index c1bc6720e018a..19f4fc328812e 100644 --- a/src/algebra/ring/comp_typeclasses.lean +++ b/src/algebra/ring/comp_typeclasses.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Frédéric Dupuis, Heather Macbeth -/ -import algebra.ring.basic import algebra.ring.equiv /-! # Propositional typeclasses on several ring homs +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains three typeclasses used in the definition of (semi)linear maps: * `ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃`, which expresses the fact that `σ₂₃.comp σ₁₂ = σ₁₃` * `ring_hom_inv_pair σ₁₂ σ₂₁`, which states that `σ₁₂` and `σ₂₁` are inverses of each other diff --git a/src/algebra/ring/default.lean b/src/algebra/ring/default.lean deleted file mode 100644 index 9e07db37e3ae3..0000000000000 --- a/src/algebra/ring/default.lean +++ /dev/null @@ -1,11 +0,0 @@ -/- -Copyright (c) 2020 Chris Hughes. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes --/ -import algebra.ring.basic - -/-! -# Default file for ring -This file imports `algebra.ring.basic` --/ diff --git a/src/algebra/ring/defs.lean b/src/algebra/ring/defs.lean new file mode 100644 index 0000000000000..fe52249fb3230 --- /dev/null +++ b/src/algebra/ring/defs.lean @@ -0,0 +1,423 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.group.basic +import algebra.group_with_zero.defs +import data.int.cast.defs + +/-! +# Semirings and rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines semirings, rings and domains. This is analogous to `algebra.group.defs` and +`algebra.group.basic`, the difference being that the former is about `+` and `*` separately, while +the present file is about their interaction. + +## Main definitions + +* `distrib`: Typeclass for distributivity of multiplication over addition. +* `has_distrib_neg`: Typeclass for commutativity of negation and multiplication. This is useful when + dealing with multiplicative submonoids which are closed under negation without being closed under + addition, for example `units`. +* `(non_unital_)(non_assoc_)(semi)ring`: Typeclasses for possibly non-unital or non-associative + rings and semirings. Some combinations are not defined yet because they haven't found use. + +## Tags + +`semiring`, `comm_semiring`, `ring`, `comm_ring`, `domain`, `is_domain`, `nonzero`, `units` +-/ +universes u v w x +variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x} + +set_option old_structure_cmd true +open function + +/-! +### `distrib` class +-/ + +/-- A typeclass stating that multiplication is left and right distributive +over addition. -/ +@[protect_proj, ancestor has_mul has_add] +class distrib (R : Type*) extends has_mul R, has_add R := +(left_distrib : ∀ a b c : R, a * (b + c) = a * b + a * c) +(right_distrib : ∀ a b c : R, (a + b) * c = a * c + b * c) + +/-- A typeclass stating that multiplication is left distributive over addition. -/ +@[protect_proj] +class left_distrib_class (R : Type*) [has_mul R] [has_add R] := +(left_distrib : ∀ a b c : R, a * (b + c) = a * b + a * c) + +/-- A typeclass stating that multiplication is right distributive over addition. -/ +@[protect_proj] +class right_distrib_class (R : Type*) [has_mul R] [has_add R] := +(right_distrib : ∀ a b c : R, (a + b) * c = a * c + b * c) + +@[priority 100] -- see Note [lower instance priority] +instance distrib.left_distrib_class (R : Type*) [distrib R] : left_distrib_class R := +⟨distrib.left_distrib⟩ + +@[priority 100] -- see Note [lower instance priority] +instance distrib.right_distrib_class (R : Type*) [distrib R] : right_distrib_class R := +⟨distrib.right_distrib⟩ + +lemma left_distrib [has_mul R] [has_add R] [left_distrib_class R] (a b c : R) : + a * (b + c) = a * b + a * c := +left_distrib_class.left_distrib a b c + +alias left_distrib ← mul_add + +lemma right_distrib [has_mul R] [has_add R] [right_distrib_class R] (a b c : R) : + (a + b) * c = a * c + b * c := +right_distrib_class.right_distrib a b c + +alias right_distrib ← add_mul + +lemma distrib_three_right [has_mul R] [has_add R] [right_distrib_class R] (a b c d : R) : + (a + b + c) * d = a * d + b * d + c * d := +by simp [right_distrib] + +/-! +### Semirings +-/ + +/-- A not-necessarily-unital, not-necessarily-associative semiring. -/ +@[protect_proj, ancestor add_comm_monoid distrib mul_zero_class] +class non_unital_non_assoc_semiring (α : Type u) extends + add_comm_monoid α, distrib α, mul_zero_class α + +/-- An associative but not-necessarily unital semiring. -/ +@[protect_proj, ancestor non_unital_non_assoc_semiring semigroup_with_zero] +class non_unital_semiring (α : Type u) extends + non_unital_non_assoc_semiring α, semigroup_with_zero α + +/-- A unital but not-necessarily-associative semiring. -/ +@[protect_proj, ancestor non_unital_non_assoc_semiring mul_zero_one_class] +class non_assoc_semiring (α : Type u) extends + non_unital_non_assoc_semiring α, mul_zero_one_class α, add_comm_monoid_with_one α + +/-- A semiring is a type with the following structures: additive commutative monoid +(`add_comm_monoid`), multiplicative monoid (`monoid`), distributive laws (`distrib`), and +multiplication by zero law (`mul_zero_class`). The actual definition extends `monoid_with_zero` +instead of `monoid` and `mul_zero_class`. -/ +@[protect_proj, ancestor non_unital_semiring non_assoc_semiring monoid_with_zero] +class semiring (α : Type u) extends non_unital_semiring α, non_assoc_semiring α, monoid_with_zero α + +section has_one_has_add + +variables [has_one α] [has_add α] + +lemma one_add_one_eq_two : 1 + 1 = (2 : α) := rfl + +end has_one_has_add + +section distrib_mul_one_class +variables [has_add α] [mul_one_class α] + +lemma add_one_mul [right_distrib_class α] (a b : α) : (a + 1) * b = a * b + b := +by rw [add_mul, one_mul] +lemma mul_add_one [left_distrib_class α] (a b : α) : a * (b + 1) = a * b + a := +by rw [mul_add, mul_one] +lemma one_add_mul [right_distrib_class α] (a b : α) : (1 + a) * b = b + a * b := +by rw [add_mul, one_mul] +lemma mul_one_add [left_distrib_class α] (a b : α) : a * (1 + b) = a + a * b := +by rw [mul_add, mul_one] + +theorem two_mul [right_distrib_class α] (n : α) : 2 * n = n + n := +eq.trans (right_distrib 1 1 n) (by simp) + +theorem bit0_eq_two_mul [right_distrib_class α] (n : α) : bit0 n = 2 * n := +(two_mul _).symm + +theorem mul_two [left_distrib_class α] (n : α) : n * 2 = n + n := +(left_distrib n 1 1).trans (by simp) + +end distrib_mul_one_class + +section semiring +variables [semiring α] + +@[to_additive] lemma mul_ite {α} [has_mul α] (P : Prop) [decidable P] (a b c : α) : + a * (if P then b else c) = if P then a * b else a * c := +by split_ifs; refl + +@[to_additive] lemma ite_mul {α} [has_mul α] (P : Prop) [decidable P] (a b c : α) : + (if P then a else b) * c = if P then a * c else b * c := +by split_ifs; refl + +-- We make `mul_ite` and `ite_mul` simp lemmas, +-- but not `add_ite` or `ite_add`. +-- The problem we're trying to avoid is dealing with +-- summations of the form `∑ x in s, (f x + ite P 1 0)`, +-- in which `add_ite` followed by `sum_ite` would needlessly slice up +-- the `f x` terms according to whether `P` holds at `x`. +-- There doesn't appear to be a corresponding difficulty so far with +-- `mul_ite` and `ite_mul`. +attribute [simp] mul_ite ite_mul + +@[simp] lemma mul_boole {α} [mul_zero_one_class α] (P : Prop) [decidable P] (a : α) : + a * (if P then 1 else 0) = if P then a else 0 := +by simp + +@[simp] lemma boole_mul {α} [mul_zero_one_class α] (P : Prop) [decidable P] (a : α) : + (if P then 1 else 0) * a = if P then a else 0 := +by simp + +lemma ite_mul_zero_left {α : Type*} [mul_zero_class α] (P : Prop) [decidable P] (a b : α) : + ite P (a * b) 0 = ite P a 0 * b := +by { by_cases h : P; simp [h], } + +lemma ite_mul_zero_right {α : Type*} [mul_zero_class α] (P : Prop) [decidable P] (a b : α) : + ite P (a * b) 0 = a * ite P b 0 := +by { by_cases h : P; simp [h], } + +lemma ite_and_mul_zero {α : Type*} [mul_zero_class α] + (P Q : Prop) [decidable P] [decidable Q] (a b : α) : + ite (P ∧ Q) (a * b) 0 = ite P a 0 * ite Q b 0 := +by simp only [←ite_and, ite_mul, mul_ite, mul_zero, zero_mul, and_comm] + +end semiring + +/-- A non-unital commutative semiring is a `non_unital_semiring` with commutative multiplication. +In other words, it is a type with the following structures: additive commutative monoid +(`add_comm_monoid`), commutative semigroup (`comm_semigroup`), distributive laws (`distrib`), and +multiplication by zero law (`mul_zero_class`). -/ +@[protect_proj, ancestor non_unital_semiring comm_semigroup] +class non_unital_comm_semiring (α : Type u) extends non_unital_semiring α, comm_semigroup α + +/-- A commutative semiring is a `semiring` with commutative multiplication. In other words, it is a +type with the following structures: additive commutative monoid (`add_comm_monoid`), multiplicative +commutative monoid (`comm_monoid`), distributive laws (`distrib`), and multiplication by zero law +(`mul_zero_class`). -/ +@[protect_proj, ancestor semiring comm_monoid] +class comm_semiring (α : Type u) extends semiring α, comm_monoid α + +@[priority 100] -- see Note [lower instance priority] +instance comm_semiring.to_non_unital_comm_semiring [comm_semiring α] : non_unital_comm_semiring α := +{ .. comm_semiring.to_comm_monoid α, .. comm_semiring.to_semiring α } + +@[priority 100] -- see Note [lower instance priority] +instance comm_semiring.to_comm_monoid_with_zero [comm_semiring α] : comm_monoid_with_zero α := +{ .. comm_semiring.to_comm_monoid α, .. comm_semiring.to_semiring α } + +section comm_semiring +variables [comm_semiring α] {a b c : α} + +lemma add_mul_self_eq (a b : α) : (a + b) * (a + b) = a*a + 2*a*b + b*b := +by simp only [two_mul, add_mul, mul_add, add_assoc, mul_comm b] + +end comm_semiring + +section has_distrib_neg + +/-- Typeclass for a negation operator that distributes across multiplication. + +This is useful for dealing with submonoids of a ring that contain `-1` without having to duplicate +lemmas. -/ +class has_distrib_neg (α : Type*) [has_mul α] extends has_involutive_neg α := +(neg_mul : ∀ x y : α, -x * y = -(x * y)) +(mul_neg : ∀ x y : α, x * -y = -(x * y)) + +section has_mul +variables [has_mul α] [has_distrib_neg α] + +@[simp] lemma neg_mul (a b : α) : - a * b = - (a * b) := +has_distrib_neg.neg_mul _ _ + +@[simp] lemma mul_neg (a b : α) : a * - b = - (a * b) := +has_distrib_neg.mul_neg _ _ + +lemma neg_mul_neg (a b : α) : -a * -b = a * b := +by simp + +lemma neg_mul_eq_neg_mul (a b : α) : -(a * b) = -a * b := +(neg_mul _ _).symm + +lemma neg_mul_eq_mul_neg (a b : α) : -(a * b) = a * -b := +(mul_neg _ _).symm + +lemma neg_mul_comm (a b : α) : -a * b = a * -b := +by simp + +end has_mul + +section mul_one_class +variables [mul_one_class α] [has_distrib_neg α] + +theorem neg_eq_neg_one_mul (a : α) : -a = -1 * a := +by simp + +/-- An element of a ring multiplied by the additive inverse of one is the element's additive + inverse. -/ +lemma mul_neg_one (a : α) : a * -1 = -a := by simp + +/-- The additive inverse of one multiplied by an element of a ring is the element's additive + inverse. -/ +lemma neg_one_mul (a : α) : -1 * a = -a := by simp + +end mul_one_class + +section mul_zero_class +variables [mul_zero_class α] [has_distrib_neg α] + +@[priority 100] +instance mul_zero_class.neg_zero_class : neg_zero_class α := +{ neg_zero := by rw [←zero_mul (0 : α), ←neg_mul, mul_zero, mul_zero], + ..mul_zero_class.to_has_zero α, + ..has_distrib_neg.to_has_involutive_neg α } + +end mul_zero_class + +end has_distrib_neg + +/-! +### Rings +-/ + +/-- A not-necessarily-unital, not-necessarily-associative ring. -/ +@[protect_proj, ancestor add_comm_group non_unital_non_assoc_semiring] +class non_unital_non_assoc_ring (α : Type u) extends + add_comm_group α, non_unital_non_assoc_semiring α + +-- We defer the instance `non_unital_non_assoc_ring.to_has_distrib_neg` to `algebra.ring.basic` +-- as it relies on the lemma `eq_neg_of_add_eq_zero_left`. + +/-- An associative but not-necessarily unital ring. -/ +@[protect_proj, ancestor non_unital_non_assoc_ring non_unital_semiring] +class non_unital_ring (α : Type*) extends + non_unital_non_assoc_ring α, non_unital_semiring α + +/-- A unital but not-necessarily-associative ring. -/ +@[protect_proj, ancestor non_unital_non_assoc_ring non_assoc_semiring add_comm_group_with_one] +class non_assoc_ring (α : Type*) extends + non_unital_non_assoc_ring α, non_assoc_semiring α, add_comm_group_with_one α + +/-- A ring is a type with the following structures: additive commutative group (`add_comm_group`), +multiplicative monoid (`monoid`), and distributive laws (`distrib`). Equivalently, a ring is a +`semiring` with a negation operation making it an additive group. -/ +@[protect_proj, ancestor add_comm_group monoid distrib] +class ring (α : Type u) extends add_comm_group_with_one α, monoid α, distrib α + +section non_unital_non_assoc_ring +variables [non_unital_non_assoc_ring α] + +@[priority 100] +instance non_unital_non_assoc_ring.to_has_distrib_neg : has_distrib_neg α := +{ neg := has_neg.neg, + neg_neg := neg_neg, + neg_mul := λ a b, eq_neg_of_add_eq_zero_left $ by rw [←right_distrib, add_left_neg, zero_mul], + mul_neg := λ a b, eq_neg_of_add_eq_zero_left $ by rw [←left_distrib, add_left_neg, mul_zero] } + +lemma mul_sub_left_distrib (a b c : α) : a * (b - c) = a * b - a * c := +by simpa only [sub_eq_add_neg, neg_mul_eq_mul_neg] using mul_add a b (-c) + +alias mul_sub_left_distrib ← mul_sub + +lemma mul_sub_right_distrib (a b c : α) : (a - b) * c = a * c - b * c := +by simpa only [sub_eq_add_neg, neg_mul_eq_neg_mul] using add_mul a (-b) c + +alias mul_sub_right_distrib ← sub_mul + +variables {a b c d e : α} + +/-- An iff statement following from right distributivity in rings and the definition + of subtraction. -/ +theorem mul_add_eq_mul_add_iff_sub_mul_add_eq : a * e + c = b * e + d ↔ (a - b) * e + c = d := +calc + a * e + c = b * e + d ↔ a * e + c = d + b * e : by simp [add_comm] + ... ↔ a * e + c - b * e = d : iff.intro (λ h, begin rw h, simp end) (λ h, + begin rw ← h, simp end) + ... ↔ (a - b) * e + c = d : begin simp [sub_mul, sub_add_eq_add_sub] end + +/-- A simplification of one side of an equation exploiting right distributivity in rings + and the definition of subtraction. -/ +theorem sub_mul_add_eq_of_mul_add_eq_mul_add : a * e + c = b * e + d → (a - b) * e + c = d := +assume h, +calc + (a - b) * e + c = (a * e + c) - b * e : begin simp [sub_mul, sub_add_eq_add_sub] end + ... = d : begin rw h, simp [@add_sub_cancel α] end + +end non_unital_non_assoc_ring + + +section non_assoc_ring +variables [non_assoc_ring α] + +lemma sub_one_mul (a b : α) : (a - 1) * b = a * b - b := +by rw [sub_mul, one_mul] +lemma mul_sub_one (a b : α) : a * (b - 1) = a * b - a := +by rw [mul_sub, mul_one] +lemma one_sub_mul (a b : α) : (1 - a) * b = b - a * b := +by rw [sub_mul, one_mul] +lemma mul_one_sub (a b : α) : a * (1 - b) = a - a * b := +by rw [mul_sub, mul_one] + +end non_assoc_ring + +section ring +variables [ring α] {a b c d e : α} + +/- A (unital, associative) ring is a not-necessarily-unital ring -/ +@[priority 100] -- see Note [lower instance priority] +instance ring.to_non_unital_ring : + non_unital_ring α := +{ zero_mul := λ a, add_left_cancel $ show 0 * a + 0 * a = 0 * a + 0, + by rw [← add_mul, zero_add, add_zero], + mul_zero := λ a, add_left_cancel $ show a * 0 + a * 0 = a * 0 + 0, + by rw [← mul_add, add_zero, add_zero], + ..‹ring α› } + +/- A (unital, associative) ring is a not-necessarily-associative ring -/ +@[priority 100] -- see Note [lower instance priority] +instance ring.to_non_assoc_ring : + non_assoc_ring α := +{ zero_mul := λ a, add_left_cancel $ show 0 * a + 0 * a = 0 * a + 0, + by rw [← add_mul, zero_add, add_zero], + mul_zero := λ a, add_left_cancel $ show a * 0 + a * 0 = a * 0 + 0, + by rw [← mul_add, add_zero, add_zero], + ..‹ring α› } + +/- The instance from `ring` to `semiring` happens often in linear algebra, for which all the basic +definitions are given in terms of semirings, but many applications use rings or fields. We increase +a little bit its priority above 100 to try it quickly, but remaining below the default 1000 so that +more specific instances are tried first. -/ +@[priority 200] +instance ring.to_semiring : semiring α := +{ ..‹ring α›, .. ring.to_non_unital_ring } + +end ring + +/-- A non-unital commutative ring is a `non_unital_ring` with commutative multiplication. -/ +@[protect_proj, ancestor non_unital_ring comm_semigroup] +class non_unital_comm_ring (α : Type u) extends non_unital_ring α, comm_semigroup α + +@[priority 100] -- see Note [lower instance priority] +instance non_unital_comm_ring.to_non_unital_comm_semiring [s : non_unital_comm_ring α] : + non_unital_comm_semiring α := +{ ..s } + +/-- A commutative ring is a `ring` with commutative multiplication. -/ +@[protect_proj, ancestor ring comm_semigroup] +class comm_ring (α : Type u) extends ring α, comm_monoid α + +@[priority 100] -- see Note [lower instance priority] +instance comm_ring.to_comm_semiring [s : comm_ring α] : comm_semiring α := +{ mul_zero := mul_zero, zero_mul := zero_mul, ..s } + +@[priority 100] -- see Note [lower instance priority] +instance comm_ring.to_non_unital_comm_ring [s : comm_ring α] : non_unital_comm_ring α := +{ mul_zero := mul_zero, zero_mul := zero_mul, ..s } + +/-- A domain is a nontrivial semiring such multiplication by a non zero element is cancellative, + on both sides. In other words, a nontrivial semiring `R` satisfying + `∀ {a b c : R}, a ≠ 0 → a * b = a * c → b = c` and + `∀ {a b c : R}, b ≠ 0 → a * b = c * b → a = c`. + + This is implemented as a mixin for `semiring α`. + To obtain an integral domain use `[comm_ring α] [is_domain α]`. -/ +@[protect_proj, ancestor is_cancel_mul_zero nontrivial] +class is_domain (α : Type u) [semiring α] extends is_cancel_mul_zero α, nontrivial α : Prop diff --git a/src/algebra/ring/divisibility.lean b/src/algebra/ring/divisibility.lean new file mode 100644 index 0000000000000..2a44107e6500f --- /dev/null +++ b/src/algebra/ring/divisibility.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.divisibility.basic +import algebra.hom.equiv.basic +import algebra.ring.defs + +/-! +# Lemmas about divisibility in rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α β : Type*} + +section distrib_semigroup +variables [has_add α] [semigroup α] + +theorem dvd_add [left_distrib_class α] {a b c : α} (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b + c := +dvd.elim h₁ (λ d hd, dvd.elim h₂ (λ e he, dvd.intro (d + e) (by simp [left_distrib, hd, he]))) + +alias dvd_add ← has_dvd.dvd.add + +end distrib_semigroup + +@[simp] theorem two_dvd_bit0 [semiring α] {a : α} : 2 ∣ bit0 a := ⟨a, bit0_eq_two_mul _⟩ + +section non_unital_comm_semiring +variables [non_unital_comm_semiring α] [non_unital_comm_semiring β] {a b c : α} + +lemma has_dvd.dvd.linear_comb {d x y : α} (hdx : d ∣ x) (hdy : d ∣ y) (a b : α) : + d ∣ (a * x + b * y) := +dvd_add (hdx.mul_left a) (hdy.mul_left b) + +end non_unital_comm_semiring + + +section semigroup + +variables [semigroup α] [has_distrib_neg α] {a b c : α} + +/-- An element `a` of a semigroup with a distributive negation divides the negation of an element +`b` iff `a` divides `b`. -/ +@[simp] lemma dvd_neg : a ∣ -b ↔ a ∣ b := (equiv.neg _).exists_congr_left.trans $ by simpa + +/-- The negation of an element `a` of a semigroup with a distributive negation divides another +element `b` iff `a` divides `b`. -/ +@[simp] lemma neg_dvd : -a ∣ b ↔ a ∣ b := (equiv.neg _).exists_congr_left.trans $ by simpa + +alias neg_dvd ↔ has_dvd.dvd.of_neg_left has_dvd.dvd.neg_left +alias dvd_neg ↔ has_dvd.dvd.of_neg_right has_dvd.dvd.neg_right + +end semigroup + +section non_unital_ring +variables [non_unital_ring α] {a b c : α} + +theorem dvd_sub (h₁ : a ∣ b) (h₂ : a ∣ c) : a ∣ b - c := +by simpa only [←sub_eq_add_neg] using h₁.add h₂.neg_right + +alias dvd_sub ← has_dvd.dvd.sub + +/-- If an element `a` divides another element `c` in a ring, `a` divides the sum of another element +`b` with `c` iff `a` divides `b`. -/ +theorem dvd_add_left (h : a ∣ c) : a ∣ b + c ↔ a ∣ b := +⟨λ H, by simpa only [add_sub_cancel] using dvd_sub H h, λ h₂, dvd_add h₂ h⟩ + +/-- If an element `a` divides another element `b` in a ring, `a` divides the sum of `b` and another +element `c` iff `a` divides `c`. -/ +theorem dvd_add_right (h : a ∣ b) : a ∣ b + c ↔ a ∣ c := by rw add_comm; exact dvd_add_left h + +/-- If an element `a` divides another element `c` in a ring, `a` divides the difference of another +element `b` with `c` iff `a` divides `b`. -/ +theorem dvd_sub_left (h : a ∣ c) : a ∣ b - c ↔ a ∣ b := +by simpa only [←sub_eq_add_neg] using dvd_add_left (dvd_neg.2 h) + +/-- If an element `a` divides another element `b` in a ring, `a` divides the difference of `b` and +another element `c` iff `a` divides `c`. -/ +theorem dvd_sub_right (h : a ∣ b) : a ∣ b - c ↔ a ∣ c := +by rw [sub_eq_add_neg, dvd_add_right h, dvd_neg] + +lemma dvd_iff_dvd_of_dvd_sub (h : a ∣ b - c) : a ∣ b ↔ a ∣ c := +by rw [←sub_add_cancel b c, dvd_add_right h] + +lemma dvd_sub_comm : a ∣ b - c ↔ a ∣ c - b := by rw [←dvd_neg, neg_sub] + +end non_unital_ring + +section ring +variables [ring α] {a b c : α} + +theorem two_dvd_bit1 : 2 ∣ bit1 a ↔ (2 : α) ∣ 1 := dvd_add_right two_dvd_bit0 + +/-- An element a divides the sum a + b if and only if a divides b.-/ +@[simp] lemma dvd_add_self_left {a b : α} : a ∣ a + b ↔ a ∣ b := +dvd_add_right (dvd_refl a) + +/-- An element a divides the sum b + a if and only if a divides b.-/ +@[simp] lemma dvd_add_self_right {a b : α} : a ∣ b + a ↔ a ∣ b := +dvd_add_left (dvd_refl a) + +/-- An element `a` divides the difference `a - b` if and only if `a` divides `b`. -/ +@[simp] lemma dvd_sub_self_left : a ∣ a - b ↔ a ∣ b := dvd_sub_right dvd_rfl + +/-- An element `a` divides the difference `b - a` if and only if `a` divides `b`. -/ +@[simp] lemma dvd_sub_self_right : a ∣ b - a ↔ a ∣ b := dvd_sub_left dvd_rfl + +end ring + +section non_unital_comm_ring +variables [non_unital_comm_ring α] {a b c : α} + +lemma dvd_mul_sub_mul {k a b x y : α} (hab : k ∣ a - b) (hxy : k ∣ x - y) : + k ∣ a * x - b * y := +begin + convert dvd_add (hxy.mul_left a) (hab.mul_right y), + rw [mul_sub_left_distrib, mul_sub_right_distrib], + simp only [sub_eq_add_neg, add_assoc, neg_add_cancel_left], +end + +end non_unital_comm_ring diff --git a/src/algebra/ring/equiv.lean b/src/algebra/ring/equiv.lean index c328a291092aa..d68db88abdc04 100644 --- a/src/algebra/ring/equiv.lean +++ b/src/algebra/ring/equiv.lean @@ -3,14 +3,17 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov -/ -import algebra.big_operators.basic -import algebra.field.basic -import algebra.hom.equiv -import algebra.ring.opposite +import algebra.group.opposite +import algebra.hom.ring +import logic.equiv.set +import tactic.assert_exists /-! # (Semi)ring equivs +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define extension of `equiv` called `ring_equiv`, which is a datatype representing an isomorphism of `semiring`s, `ring`s, `division_ring`s, or `field`s. We also introduce the corresponding group of automorphisms `ring_aut`. @@ -36,7 +39,6 @@ multiplication in `equiv.perm`, and multiplication in `category_theory.End`, not equiv, mul_equiv, add_equiv, ring_equiv, mul_aut, add_aut, ring_aut -/ -open_locale big_operators variables {F α β R S S' : Type*} @@ -154,14 +156,14 @@ protected lemma ext_iff {f g : R ≃+* S} : f = g ↔ ∀ x, f x = g x := fun_li @[simp, norm_cast] lemma coe_to_add_equiv (f : R ≃+* S) : ⇑(f : R ≃+ S) = f := rfl /-- The `ring_equiv` between two semirings with a unique element. -/ -def ring_equiv_of_unique_of_unique {M N} +def ring_equiv_of_unique {M N} [unique M] [unique N] [has_add M] [has_mul M] [has_add N] [has_mul N] : M ≃+* N := -{ ..add_equiv.add_equiv_of_unique_of_unique, - ..mul_equiv.mul_equiv_of_unique_of_unique} +{ ..add_equiv.add_equiv_of_unique, + ..mul_equiv.mul_equiv_of_unique} instance {M N} [unique M] [unique N] [has_add M] [has_mul M] [has_add N] [has_mul N] : unique (M ≃+* N) := -{ default := ring_equiv_of_unique_of_unique, +{ default := ring_equiv_of_unique, uniq := λ _, ext $ λ x, subsingleton.elim _ _ } variable (R) @@ -192,6 +194,9 @@ initialize_simps_projections ring_equiv (to_fun → apply, inv_fun → symm_appl @[simp] lemma symm_symm (e : R ≃+* S) : e.symm.symm = e := ext $ λ x, rfl +@[simp] +lemma coe_to_equiv_symm (e : R ≃+* S) : (e.symm : S ≃ R) = (e : R ≃ S).symm := rfl + lemma symm_bijective : function.bijective (ring_equiv.symm : (R ≃+* S) → (S ≃+* R)) := equiv.bijective ⟨ring_equiv.symm, ring_equiv.symm, symm_symm, symm_symm⟩ @@ -207,9 +212,19 @@ symm_bijective.injective $ ext $ λ x, rfl @[trans] protected def trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') : R ≃+* S' := { .. (e₁.to_mul_equiv.trans e₂.to_mul_equiv), .. (e₁.to_add_equiv.trans e₂.to_add_equiv) } -@[simp] lemma trans_apply (e₁ : R ≃+* S) (e₂ : S ≃+* S') (a : R) : +lemma trans_apply (e₁ : R ≃+* S) (e₂ : S ≃+* S') (a : R) : e₁.trans e₂ a = e₂ (e₁ a) := rfl +@[simp] lemma coe_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂ : R → S') = e₂ ∘ e₁ := rfl + +@[simp] +lemma symm_trans_apply (e₁ : R ≃+* S) (e₂ : S ≃+* S') (a : S') : + (e₁.trans e₂).symm a = e₁.symm (e₂.symm a) := rfl + +lemma symm_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂).symm = e₂.symm.trans (e₁.symm) := rfl + protected lemma bijective (e : R ≃+* S) : function.bijective e := equiv_like.bijective e protected lemma injective (e : R ≃+* S) : function.injective e := equiv_like.injective e protected lemma surjective (e : R ≃+* S) : function.surjective e := equiv_like.surjective e @@ -220,6 +235,11 @@ protected lemma surjective (e : R ≃+* S) : function.surjective e := equiv_like lemma image_eq_preimage (e : R ≃+* S) (s : set R) : e '' s = e.symm ⁻¹' s := e.to_equiv.image_eq_preimage s +@[simp] lemma coe_mul_equiv_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂ : R ≃* S') = (e₁ : R ≃* S).trans ↑e₂:= rfl +@[simp] lemma coe_add_equiv_trans (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂ : R ≃+ S') = (e₁ : R ≃+ S).trans ↑e₂:= rfl + end basic section opposite @@ -331,6 +351,29 @@ protected lemma map_eq_one_iff : f x = 1 ↔ x = 1 := mul_equiv_class.map_eq_one lemma map_ne_one_iff : f x ≠ 1 ↔ x ≠ 1 := mul_equiv_class.map_ne_one_iff f +lemma coe_monoid_hom_refl : (ring_equiv.refl R : R →* R) = monoid_hom.id R := rfl +@[simp] lemma coe_add_monoid_hom_refl : (ring_equiv.refl R : R →+ R) = add_monoid_hom.id R := rfl +/-! `ring_equiv.coe_mul_equiv_refl` and `ring_equiv.coe_add_equiv_refl` are proved above +in higher generality -/ +@[simp] lemma coe_ring_hom_refl : (ring_equiv.refl R : R →* R) = ring_hom.id R := rfl + +@[simp] lemma coe_monoid_hom_trans [non_assoc_semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂ : R →* S') = (e₂ : S →* S').comp ↑e₁ := rfl +@[simp] lemma coe_add_monoid_hom_trans [non_assoc_semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂ : R →+ S') = (e₂ : S →+ S').comp ↑e₁ := rfl +/-! `ring_equiv.coe_mul_equiv_trans` and `ring_equiv.coe_add_equiv_trans` are proved above +in higher generality -/ +@[simp] lemma coe_ring_hom_trans [non_assoc_semiring S'] (e₁ : R ≃+* S) (e₂ : S ≃+* S') : + (e₁.trans e₂ : R →+* S') = (e₂ : S →+* S').comp ↑e₁ := rfl + +@[simp] lemma comp_symm (e : R ≃+* S) : + (e : R →+* S).comp (e.symm : S →+* R) = ring_hom.id S := +ring_hom.ext e.apply_symm_apply + +@[simp] lemma symm_comp (e : R ≃+* S) : + (e.symm : S →+* R).comp (e : R →+* S) = ring_hom.id R := +ring_hom.ext e.symm_apply_apply + end semiring section non_unital_ring @@ -349,6 +392,9 @@ variables [non_assoc_ring R] [non_assoc_ring S] (f : R ≃+* S) (x y : R) @[simp] lemma map_neg_one : f (-1) = -1 := f.map_one ▸ f.map_neg 1 +lemma map_eq_neg_one_iff {x : R} : f x = -1 ↔ x = -1 := +by rw [← neg_eq_iff_eq_neg, ← neg_eq_iff_eq_neg, ← map_neg, ring_equiv.map_eq_one_iff] + end ring section non_unital_semiring_hom @@ -526,46 +572,6 @@ def of_hom_inv {R S F G : Type*} [non_assoc_semiring R] [non_assoc_semiring S] end semiring_hom -section big_operators - -protected lemma map_list_prod [semiring R] [semiring S] (f : R ≃+* S) (l : list R) : - f l.prod = (l.map f).prod := map_list_prod f l - -protected lemma map_list_sum [non_assoc_semiring R] [non_assoc_semiring S] (f : R ≃+* S) - (l : list R) : f l.sum = (l.map f).sum := map_list_sum f l - -/-- An isomorphism into the opposite ring acts on the product by acting on the reversed elements -/ -protected lemma unop_map_list_prod [semiring R] [semiring S] (f : R ≃+* Sᵐᵒᵖ) (l : list R) : - mul_opposite.unop (f l.prod) = (l.map (mul_opposite.unop ∘ f)).reverse.prod := -unop_map_list_prod f l - -protected lemma map_multiset_prod [comm_semiring R] [comm_semiring S] (f : R ≃+* S) - (s : multiset R) : f s.prod = (s.map f).prod := map_multiset_prod f s - -protected lemma map_multiset_sum [non_assoc_semiring R] [non_assoc_semiring S] - (f : R ≃+* S) (s : multiset R) : f s.sum = (s.map f).sum := map_multiset_sum f s - -protected lemma map_prod {α : Type*} [comm_semiring R] [comm_semiring S] (g : R ≃+* S) (f : α → R) - (s : finset α) : g (∏ x in s, f x) = ∏ x in s, g (f x) := -map_prod g f s - -protected lemma map_sum {α : Type*} [non_assoc_semiring R] [non_assoc_semiring S] - (g : R ≃+* S) (f : α → R) (s : finset α) : g (∑ x in s, f x) = ∑ x in s, g (f x) := -map_sum g f s - -end big_operators - -section division_ring - -variables {K K' : Type*} [division_ring K] [division_ring K'] - (g : K ≃+* K') (x y : K) - -lemma map_inv : g x⁻¹ = (g x)⁻¹ := g.to_ring_hom.map_inv x - -lemma map_div : g (x / y) = g x / g y := g.to_ring_hom.map_div x y - -end division_ring - section group_power variables [semiring R] [semiring S] @@ -601,13 +607,26 @@ variables [has_add R] [has_add S] [has_mul R] [has_mul S] @[simp] theorem self_trans_symm (e : R ≃+* S) : e.trans e.symm = ring_equiv.refl R := ext e.3 @[simp] theorem symm_trans_self (e : R ≃+* S) : e.symm.trans e = ring_equiv.refl S := ext e.4 +/-- If two rings are isomorphic, and the second doesn't have zero divisors, +then so does the first. -/ +protected lemma no_zero_divisors + {A : Type*} (B : Type*) [ring A] [ring B] [no_zero_divisors B] + (e : A ≃+* B) : no_zero_divisors A := +{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y hxy, + have e x * e y = 0, by rw [← e.map_mul, hxy, e.map_zero], + by simpa using eq_zero_or_eq_zero_of_mul_eq_zero this } + /-- If two rings are isomorphic, and the second is a domain, then so is the first. -/ protected lemma is_domain {A : Type*} (B : Type*) [ring A] [ring B] [is_domain B] (e : A ≃+* B) : is_domain A := -{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y hxy, - have e x * e y = 0, by rw [← e.map_mul, hxy, e.map_zero], - by simpa using eq_zero_or_eq_zero_of_mul_eq_zero this, - exists_pair_ne := ⟨e.symm 0, e.symm 1, e.symm.injective.ne zero_ne_one⟩ } +begin + haveI : nontrivial A := ⟨⟨e.symm 0, e.symm 1, e.symm.injective.ne zero_ne_one⟩⟩, + haveI := e.no_zero_divisors B, + exact no_zero_divisors.to_is_domain _ +end end ring_equiv + +-- Guard against import creep +assert_not_exists fintype diff --git a/src/algebra/ring/fin.lean b/src/algebra/ring/fin.lean new file mode 100644 index 0000000000000..0b9379c02c61c --- /dev/null +++ b/src/algebra/ring/fin.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2022 Anne Baanen. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anne Baanen +-/ +import logic.equiv.fin +import algebra.ring.equiv +import algebra.group.prod + +/-! +# Rings and `fin` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file collects some basic results involving rings and the `fin` type + +## Main results + + * `ring_equiv.fin_two`: The product over `fin 2` of some rings is the cartesian product + +-/ + +/-- The product over `fin 2` of some rings is just the cartesian product of these rings. -/ +@[simps] +def ring_equiv.pi_fin_two (R : fin 2 → Type*) [Π i, semiring (R i)] : + (Π (i : fin 2), R i) ≃+* R 0 × R 1 := +{ to_fun := pi_fin_two_equiv R, + map_add' := λ a b, rfl, + map_mul' := λ a b, rfl, + .. pi_fin_two_equiv R } diff --git a/src/algebra/ring/idempotents.lean b/src/algebra/ring/idempotents.lean index 14f652b90269e..1fd69ef91052f 100644 --- a/src/algebra/ring/idempotents.lean +++ b/src/algebra/ring/idempotents.lean @@ -3,13 +3,17 @@ Copyright (c) 2022 Christopher Hoskin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Christopher Hoskin -/ -import algebra.ring.basic +import order.basic import algebra.group_power.basic -import tactic.nth_rewrite.default +import algebra.ring.defs +import tactic.nth_rewrite /-! # Idempotents +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines idempotents for an arbitary multiplication and proves some basic results, including: @@ -27,7 +31,7 @@ projection, idempotent variables {M N S M₀ M₁ R G G₀ : Type*} variables [has_mul M] [monoid N] [semigroup S] [mul_zero_class M₀] [mul_one_class M₁] - [non_assoc_ring R] [group G] [group_with_zero G₀] + [non_assoc_ring R] [group G] [cancel_monoid_with_zero G₀] /-- An element `p` is said to be idempotent if `p * p = p` @@ -43,57 +47,34 @@ lemma eq {p : M} (h : is_idempotent_elem p) : p * p = p := h lemma mul_of_commute {p q : S} (h : commute p q) (h₁ : is_idempotent_elem p) (h₂ : is_idempotent_elem q) : is_idempotent_elem (p * q) := - by rw [is_idempotent_elem, mul_assoc, ← mul_assoc q, ←h.eq, mul_assoc p, h₂.eq, ← mul_assoc, - h₁.eq] +by rw [is_idempotent_elem, mul_assoc, ← mul_assoc q, ← h.eq, mul_assoc p, h₂.eq, ← mul_assoc, h₁.eq] lemma zero : is_idempotent_elem (0 : M₀) := mul_zero _ lemma one : is_idempotent_elem (1 : M₁) := mul_one _ lemma one_sub {p : R} (h : is_idempotent_elem p) : is_idempotent_elem (1 - p) := -begin - rw is_idempotent_elem at h, - rw [is_idempotent_elem, mul_sub_left_distrib, mul_one, sub_mul, one_mul, h, sub_self, sub_zero], -end +by rw [is_idempotent_elem, mul_sub, mul_one, sub_mul, one_mul, h.eq, sub_self, sub_zero] @[simp] lemma one_sub_iff {p : R} : is_idempotent_elem (1 - p) ↔ is_idempotent_elem p := ⟨ λ h, sub_sub_cancel 1 p ▸ h.one_sub, is_idempotent_elem.one_sub ⟩ lemma pow {p : N} (n : ℕ) (h : is_idempotent_elem p) : is_idempotent_elem (p ^ n) := -begin - induction n with n ih, - { rw pow_zero, apply one, }, - { unfold is_idempotent_elem, - rw [pow_succ, ← mul_assoc, ← pow_mul_comm', mul_assoc (p^n), h.eq, pow_mul_comm', mul_assoc, - ih.eq], } -end +nat.rec_on n ((pow_zero p).symm ▸ one) (λ n ih, show p ^ n.succ * p ^ n.succ = p ^ n.succ, + by { nth_rewrite 2 ←h.eq, rw [←sq, ←sq, ←pow_mul, ←pow_mul'] }) lemma pow_succ_eq {p : N} (n : ℕ) (h : is_idempotent_elem p) : p ^ (n + 1) = p := -begin - induction n with n ih, - { rw [nat.zero_add, pow_one], }, - { rw [pow_succ, ih, h.eq], } -end +nat.rec_on n ((nat.zero_add 1).symm ▸ pow_one p) (λ n ih, by rw [pow_succ, ih, h.eq]) @[simp] lemma iff_eq_one {p : G} : is_idempotent_elem p ↔ p = 1 := -begin - split, - { intro h, - rw ← mul_left_inv p, - nth_rewrite_rhs 1 ← h.eq, - rw [← mul_assoc, mul_left_inv, one_mul] }, - { intro h, rw h, apply one, } -end +iff.intro (λ h, mul_left_cancel ((mul_one p).symm ▸ h.eq : p * p = p * 1)) (λ h, h.symm ▸ one) @[simp] lemma iff_eq_zero_or_one {p : G₀} : is_idempotent_elem p ↔ p = 0 ∨ p = 1 := begin - refine ⟨λ h, or_iff_not_imp_left.mpr (λ hp, _), _⟩, - { rw ← mul_inv_cancel hp, - nth_rewrite_rhs 0 ← h.eq, - rw [mul_assoc, mul_inv_cancel hp, mul_one] }, - { rintro (h₁ | h₂), - { rw h₁, exact zero, }, - { rw h₂, exact one, } } + refine iff.intro + (λ h, or_iff_not_imp_left.mpr (λ hp, _)) + (λ h, h.elim (λ hp, hp.symm ▸ zero) (λ hp, hp.symm ▸ one)), + exact mul_left_cancel₀ hp (h.trans (mul_one p).symm) end /-! ### Instances on `subtype is_idempotent_elem` -/ diff --git a/src/algebra/ring/inj_surj.lean b/src/algebra/ring/inj_surj.lean new file mode 100644 index 0000000000000..9a67f6e8b1ee5 --- /dev/null +++ b/src/algebra/ring/inj_surj.lean @@ -0,0 +1,464 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.ring.defs +import algebra.opposites +import algebra.group_with_zero.inj_surj + +/-! +# Pulling back rings along injective maps, and pushing them forward along surjective maps. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ +universes u v w x +variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x} + +open function + +/-! +### `distrib` class +-/ + +/-- Pullback a `distrib` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.distrib {S} [has_mul R] [has_add R] [distrib S] + (f : R → S) (hf : injective f) (add : ∀ x y, f (x + y) = f x + f y) + (mul : ∀ x y, f (x * y) = f x * f y) : + distrib R := +{ mul := (*), + add := (+), + left_distrib := λ x y z, hf $ by simp only [*, left_distrib], + right_distrib := λ x y z, hf $ by simp only [*, right_distrib] } + +/-- Pushforward a `distrib` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.distrib {S} [distrib R] [has_add S] [has_mul S] + (f : R → S) (hf : surjective f) (add : ∀ x y, f (x + y) = f x + f y) + (mul : ∀ x y, f (x * y) = f x * f y) : + distrib S := +{ mul := (*), + add := (+), + left_distrib := hf.forall₃.2 $ λ x y z, by simp only [← add, ← mul, left_distrib], + right_distrib := hf.forall₃.2 $ λ x y z, by simp only [← add, ← mul, right_distrib] } + +section injective_surjective_maps + +/-! +### Semirings +-/ + +variables [has_zero β] [has_add β] [has_mul β] [has_smul ℕ β] + +/-- Pullback a `non_unital_non_assoc_semiring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_unital_non_assoc_semiring + {α : Type u} [non_unital_non_assoc_semiring α] + (f : β → α) (hf : injective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : + non_unital_non_assoc_semiring β := +{ .. hf.mul_zero_class f zero mul, .. hf.add_comm_monoid f zero add nsmul, .. hf.distrib f add mul } + +/-- Pullback a `non_unital_semiring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_unital_semiring + {α : Type u} [non_unital_semiring α] + (f : β → α) (hf : injective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : + non_unital_semiring β := +{ .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.semigroup_with_zero f zero mul } + +/-- Pullback a `non_assoc_semiring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_assoc_semiring + {α : Type u} [non_assoc_semiring α] + {β : Type v} [has_zero β] [has_one β] [has_mul β] [has_add β] + [has_smul ℕ β] [has_nat_cast β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) : + non_assoc_semiring β := +{ .. hf.add_monoid_with_one f zero one add nsmul nat_cast, + .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, + .. hf.mul_one_class f one mul } + +/-- Pullback a `semiring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.semiring + {α : Type u} [semiring α] + {β : Type v} [has_zero β] [has_one β] [has_add β] [has_mul β] [has_pow β ℕ] + [has_smul ℕ β] [has_nat_cast β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + semiring β := +{ .. hf.non_assoc_semiring f zero one add mul nsmul nat_cast, + .. hf.monoid_with_zero f zero one mul npow, + .. hf.distrib f add mul } + +/-- Pushforward a `non_unital_non_assoc_semiring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_unital_non_assoc_semiring + {α : Type u} [non_unital_non_assoc_semiring α] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : + non_unital_non_assoc_semiring β := +{ .. hf.mul_zero_class f zero mul, .. hf.add_comm_monoid f zero add nsmul, .. hf.distrib f add mul } + +/-- Pushforward a `non_unital_semiring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_unital_semiring + {α : Type u} [non_unital_semiring α] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : + non_unital_semiring β := +{ .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.semigroup_with_zero f zero mul } + +/-- Pushforward a `non_assoc_semiring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_assoc_semiring + {α : Type u} [non_assoc_semiring α] + {β : Type v} [has_zero β] [has_one β] [has_add β] [has_mul β] + [has_smul ℕ β] [has_nat_cast β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) : + non_assoc_semiring β := +{ .. hf.add_monoid_with_one f zero one add nsmul nat_cast, + .. hf.non_unital_non_assoc_semiring f zero add mul nsmul, .. hf.mul_one_class f one mul } + +/-- Pushforward a `semiring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.semiring + {α : Type u} [semiring α] + {β : Type v} [has_zero β] [has_one β] [has_add β] [has_mul β] [has_pow β ℕ] + [has_smul ℕ β] [has_nat_cast β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + semiring β := +{ .. hf.non_assoc_semiring f zero one add mul nsmul nat_cast, + .. hf.monoid_with_zero f zero one mul npow, .. hf.add_comm_monoid f zero add nsmul, + .. hf.distrib f add mul } + +end injective_surjective_maps + +section non_unital_comm_semiring +variables [non_unital_comm_semiring α] [non_unital_comm_semiring β] {a b c : α} + +/-- Pullback a `non_unital_semiring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_unital_comm_semiring [has_zero γ] [has_add γ] [has_mul γ] + [has_smul ℕ γ] (f : γ → α) (hf : injective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : + non_unital_comm_semiring γ := +{ .. hf.non_unital_semiring f zero add mul nsmul, .. hf.comm_semigroup f mul } + +/-- Pushforward a `non_unital_semiring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_unital_comm_semiring [has_zero γ] [has_add γ] [has_mul γ] + [has_smul ℕ γ] (f : α → γ) (hf : surjective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) : + non_unital_comm_semiring γ := +{ .. hf.non_unital_semiring f zero add mul nsmul, .. hf.comm_semigroup f mul } + +end non_unital_comm_semiring + +section comm_semiring +variables [comm_semiring α] [comm_semiring β] {a b c : α} + +/-- Pullback a `semiring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.comm_semiring + [has_zero γ] [has_one γ] [has_add γ] [has_mul γ] [has_smul ℕ γ] [has_nat_cast γ] + [has_pow γ ℕ] (f : γ → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + comm_semiring γ := +{ .. hf.semiring f zero one add mul nsmul npow nat_cast, .. hf.comm_semigroup f mul } + +/-- Pushforward a `semiring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.comm_semiring + [has_zero γ] [has_one γ] [has_add γ] [has_mul γ] [has_smul ℕ γ] [has_nat_cast γ] + [has_pow γ ℕ] (f : α → γ) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) : + comm_semiring γ := +{ .. hf.semiring f zero one add mul nsmul npow nat_cast, .. hf.comm_semigroup f mul } + +end comm_semiring + +section has_distrib_neg + +section has_mul +variables [has_mul α] [has_distrib_neg α] + +/-- A type endowed with `-` and `*` has distributive negation, if it admits an injective map that +preserves `-` and `*` to a type which has distributive negation. -/ +@[reducible] -- See note [reducible non-instances] +protected def function.injective.has_distrib_neg [has_neg β] [has_mul β] (f : β → α) + (hf : injective f) (neg : ∀ a, f (-a) = -f a) (mul : ∀ a b, f (a * b) = f a * f b) : + has_distrib_neg β := +{ neg_mul := λ x y, hf $ by erw [neg, mul, neg, neg_mul, mul], + mul_neg := λ x y, hf $ by erw [neg, mul, neg, mul_neg, mul], + ..hf.has_involutive_neg _ neg, ..‹has_mul β› } + +/-- A type endowed with `-` and `*` has distributive negation, if it admits a surjective map that +preserves `-` and `*` from a type which has distributive negation. -/ +@[reducible] -- See note [reducible non-instances] +protected def function.surjective.has_distrib_neg [has_neg β] [has_mul β] (f : α → β) + (hf : surjective f) (neg : ∀ a, f (-a) = -f a) (mul : ∀ a b, f (a * b) = f a * f b) : + has_distrib_neg β := +{ neg_mul := hf.forall₂.2 $ λ x y, by { erw [←neg, ← mul, neg_mul, neg, mul], refl }, + mul_neg := hf.forall₂.2 $ λ x y, by { erw [←neg, ← mul, mul_neg, neg, mul], refl }, + ..hf.has_involutive_neg _ neg, ..‹has_mul β› } + +namespace add_opposite + +instance : has_distrib_neg αᵃᵒᵖ := unop_injective.has_distrib_neg _ unop_neg unop_mul + +end add_opposite + +end has_mul + +end has_distrib_neg + +/-! +### Rings +-/ + +section non_unital_non_assoc_ring +variables [non_unital_non_assoc_ring α] + +/-- Pullback a `non_unital_non_assoc_ring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_unital_non_assoc_ring + [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : + non_unital_non_assoc_ring β := +{ .. hf.add_comm_group f zero add neg sub nsmul zsmul, ..hf.mul_zero_class f zero mul, + .. hf.distrib f add mul } + +/-- Pushforward a `non_unital_non_assoc_ring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_unital_non_assoc_ring + [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : + non_unital_non_assoc_ring β := +{ .. hf.add_comm_group f zero add neg sub nsmul zsmul, .. hf.mul_zero_class f zero mul, + .. hf.distrib f add mul } + +end non_unital_non_assoc_ring + +section non_unital_ring +variables [non_unital_ring α] + +/-- Pullback a `non_unital_ring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_unital_ring + [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : + non_unital_ring β := +{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, ..hf.mul_zero_class f zero mul, + .. hf.distrib f add mul, .. hf.semigroup f mul } + +/-- Pushforward a `non_unital_ring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_unital_ring + [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] [has_smul ℕ β] [has_smul ℤ β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : + non_unital_ring β := +{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, .. hf.mul_zero_class f zero mul, + .. hf.distrib f add mul, .. hf.semigroup f mul } + +end non_unital_ring + +section non_assoc_ring +variables [non_assoc_ring α] + +/-- Pullback a `non_assoc_ring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_assoc_ring + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] [has_nat_cast β] [has_int_cast β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + non_assoc_ring β := +{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, + .. hf.add_group_with_one f zero one add neg sub nsmul gsmul nat_cast int_cast, + .. hf.mul_zero_class f zero mul, .. hf.distrib f add mul, + .. hf.mul_one_class f one mul } + +/-- Pushforward a `non_unital_ring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_assoc_ring + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] [has_nat_cast β] [has_int_cast β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (gsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + non_assoc_ring β := +{ .. hf.add_comm_group f zero add neg sub nsmul gsmul, .. hf.mul_zero_class f zero mul, + .. hf.add_group_with_one f zero one add neg sub nsmul gsmul nat_cast int_cast, + .. hf.distrib f add mul, .. hf.mul_one_class f one mul } + +end non_assoc_ring + +section ring +variables [ring α] {a b c d e : α} + +/-- Pullback a `ring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.ring + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] [has_int_cast β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + ring β := +{ .. hf.add_group_with_one f zero one add neg sub nsmul zsmul nat_cast int_cast, + .. hf.add_comm_group f zero add neg sub nsmul zsmul, + .. hf.monoid f one mul npow, .. hf.distrib f add mul } + +/-- Pushforward a `ring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.ring + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] [has_int_cast β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + ring β := +{ .. hf.add_group_with_one f zero one add neg sub nsmul zsmul nat_cast int_cast, + .. hf.add_comm_group f zero add neg sub nsmul zsmul, + .. hf.monoid f one mul npow, .. hf.distrib f add mul } + +end ring + +section non_unital_comm_ring +variables [non_unital_comm_ring α] {a b c : α} + +/-- Pullback a `comm_ring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.non_unital_comm_ring + [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : + non_unital_comm_ring β := +{ .. hf.non_unital_ring f zero add mul neg sub nsmul zsmul, .. hf.comm_semigroup f mul } + +/-- Pushforward a `non_unital_comm_ring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.non_unital_comm_ring + [has_zero β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) : + non_unital_comm_ring β := +{ .. hf.non_unital_ring f zero add mul neg sub nsmul zsmul, .. hf.comm_semigroup f mul } + +end non_unital_comm_ring + +section comm_ring +variables [comm_ring α] {a b c : α} + +/-- Pullback a `comm_ring` instance along an injective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.injective.comm_ring + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] [has_int_cast β] + (f : β → α) (hf : injective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + comm_ring β := +{ .. hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast, + .. hf.comm_semigroup f mul } + +/-- Pushforward a `comm_ring` instance along a surjective function. +See note [reducible non-instances]. -/ +@[reducible] +protected def function.surjective.comm_ring + [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β] + [has_smul ℕ β] [has_smul ℤ β] [has_pow β ℕ] [has_nat_cast β] [has_int_cast β] + (f : α → β) (hf : surjective f) (zero : f 0 = 0) (one : f 1 = 1) + (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) + (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) + (nsmul : ∀ x (n : ℕ), f (n • x) = n • f x) (zsmul : ∀ x (n : ℤ), f (n • x) = n • f x) + (npow : ∀ x (n : ℕ), f (x ^ n) = f x ^ n) + (nat_cast : ∀ n : ℕ, f n = n) (int_cast : ∀ n : ℤ, f n = n) : + comm_ring β := +{ .. hf.ring f zero one add mul neg sub nsmul zsmul npow nat_cast int_cast, + .. hf.comm_semigroup f mul } + +end comm_ring diff --git a/src/algebra/ring/opposite.lean b/src/algebra/ring/opposite.lean index a833861e4dd15..79f69ea9d9d64 100644 --- a/src/algebra/ring/opposite.lean +++ b/src/algebra/ring/opposite.lean @@ -3,11 +3,15 @@ Copyright (c) 2018 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kenny Lau -/ -import algebra.ring.basic +import algebra.group_with_zero.basic import algebra.group.opposite +import algebra.hom.ring /-! # Ring structures on the multiplicative opposite + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v variables (α : Type u) @@ -41,7 +45,8 @@ instance [non_unital_semiring α] : non_unital_semiring αᵐᵒᵖ := { .. mul_opposite.semigroup_with_zero α, .. mul_opposite.non_unital_non_assoc_semiring α } instance [non_assoc_semiring α] : non_assoc_semiring αᵐᵒᵖ := -{ .. mul_opposite.mul_zero_one_class α, .. mul_opposite.non_unital_non_assoc_semiring α } +{ .. mul_opposite.add_monoid_with_one α, .. mul_opposite.mul_zero_one_class α, + .. mul_opposite.non_unital_non_assoc_semiring α } instance [semiring α] : semiring αᵐᵒᵖ := { .. mul_opposite.non_unital_semiring α, .. mul_opposite.non_assoc_semiring α, @@ -61,10 +66,11 @@ instance [non_unital_ring α] : non_unital_ring αᵐᵒᵖ := .. mul_opposite.distrib α} instance [non_assoc_ring α] : non_assoc_ring αᵐᵒᵖ := -{ .. mul_opposite.add_comm_group α, .. mul_opposite.mul_zero_one_class α, .. mul_opposite.distrib α} +{ .. mul_opposite.add_comm_group α, .. mul_opposite.mul_zero_one_class α, .. mul_opposite.distrib α, + .. mul_opposite.add_group_with_one α } instance [ring α] : ring αᵐᵒᵖ := -{ .. mul_opposite.add_comm_group α, .. mul_opposite.monoid α, .. mul_opposite.semiring α } +{ .. mul_opposite.monoid α, .. mul_opposite.non_assoc_ring α } instance [non_unital_comm_ring α] : non_unital_comm_ring αᵐᵒᵖ := { .. mul_opposite.non_unital_ring α, .. mul_opposite.non_unital_comm_semiring α } @@ -78,7 +84,7 @@ instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors α (λ hy, or.inr $ unop_injective $ hy) (λ hx, or.inl $ unop_injective $ hx), } instance [ring α] [is_domain α] : is_domain αᵐᵒᵖ := -{ .. mul_opposite.no_zero_divisors α, .. mul_opposite.ring α, .. mul_opposite.nontrivial α } +no_zero_divisors.to_is_domain _ instance [group_with_zero α] : group_with_zero αᵐᵒᵖ := { mul_inv_cancel := λ x hx, unop_injective $ inv_mul_cancel $ unop_injective.ne hx, @@ -91,8 +97,8 @@ end mul_opposite namespace add_opposite instance [distrib α] : distrib αᵃᵒᵖ := -{ left_distrib := λ x y z, unop_injective $ mul_add x _ _, - right_distrib := λ x y z, unop_injective $ add_mul _ _ z, +{ left_distrib := λ x y z, unop_injective $ @mul_add α _ _ _ x z y, + right_distrib := λ x y z, unop_injective $ @add_mul α _ _ _ y x z, .. add_opposite.has_add α, .. @add_opposite.has_mul α _} instance [mul_zero_class α] : mul_zero_class αᵃᵒᵖ := @@ -117,7 +123,8 @@ instance [non_unital_semiring α] : non_unital_semiring αᵃᵒᵖ := { .. add_opposite.semigroup_with_zero α, .. add_opposite.non_unital_non_assoc_semiring α } instance [non_assoc_semiring α] : non_assoc_semiring αᵃᵒᵖ := -{ .. add_opposite.mul_zero_one_class α, .. add_opposite.non_unital_non_assoc_semiring α } +{ ..add_opposite.mul_zero_one_class α, ..add_opposite.non_unital_non_assoc_semiring α, + ..add_opposite.add_comm_monoid_with_one _ } instance [semiring α] : semiring αᵃᵒᵖ := { .. add_opposite.non_unital_semiring α, .. add_opposite.non_assoc_semiring α, @@ -137,10 +144,11 @@ instance [non_unital_ring α] : non_unital_ring αᵃᵒᵖ := .. add_opposite.distrib α} instance [non_assoc_ring α] : non_assoc_ring αᵃᵒᵖ := -{ .. add_opposite.add_comm_group α, .. add_opposite.mul_zero_one_class α, .. add_opposite.distrib α} +{ .. add_opposite.add_comm_group_with_one α, .. add_opposite.mul_zero_one_class α, + .. add_opposite.distrib α} instance [ring α] : ring αᵃᵒᵖ := -{ .. add_opposite.add_comm_group α, .. add_opposite.monoid α, .. add_opposite.semiring α } +{ .. add_opposite.non_assoc_ring α, .. add_opposite.semiring α } instance [non_unital_comm_ring α] : non_unital_comm_ring αᵃᵒᵖ := { .. add_opposite.non_unital_ring α, .. add_opposite.non_unital_comm_semiring α } @@ -154,7 +162,7 @@ instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors α ((@eq_zero_or_eq_zero_of_mul_eq_zero α _ _ _ _ _) $ op_injective H) } instance [ring α] [is_domain α] : is_domain αᵃᵒᵖ := -{ .. add_opposite.no_zero_divisors α, .. add_opposite.ring α, .. add_opposite.nontrivial α } +no_zero_divisors.to_is_domain _ instance [group_with_zero α] : group_with_zero αᵃᵒᵖ := { mul_inv_cancel := λ x hx, unop_injective $ mul_inv_cancel $ unop_injective.ne hx, @@ -167,6 +175,41 @@ end add_opposite open mul_opposite +/-- A non-unital ring homomorphism `f : R →ₙ+* S` such that `f x` commutes with `f y` for all `x, y` +defines a non-unital ring homomorphism to `Sᵐᵒᵖ`. -/ +@[simps {fully_applied := ff}] +def non_unital_ring_hom.to_opposite {R S : Type*} [non_unital_non_assoc_semiring R] + [non_unital_non_assoc_semiring S] (f : R →ₙ+* S) (hf : ∀ x y, commute (f x) (f y)) : + R →ₙ+* Sᵐᵒᵖ := +{ to_fun := mul_opposite.op ∘ f, + .. ((op_add_equiv : S ≃+ Sᵐᵒᵖ).to_add_monoid_hom.comp ↑f : R →+ Sᵐᵒᵖ), + .. f.to_mul_hom.to_opposite hf } + +/-- A non-unital ring homomorphism `f : R →ₙ* S` such that `f x` commutes with `f y` for all `x, y` +defines a non-unital ring homomorphism from `Rᵐᵒᵖ`. -/ +@[simps {fully_applied := ff}] +def non_unital_ring_hom.from_opposite {R S : Type*} [non_unital_non_assoc_semiring R] + [non_unital_non_assoc_semiring S] (f : R →ₙ+* S) (hf : ∀ x y, commute (f x) (f y)) : + Rᵐᵒᵖ →ₙ+* S := +{ to_fun := f ∘ mul_opposite.unop, + .. (f.to_add_monoid_hom.comp (op_add_equiv : R ≃+ Rᵐᵒᵖ).symm.to_add_monoid_hom : Rᵐᵒᵖ →+ S), + .. f.to_mul_hom.from_opposite hf } + +/-- A non-unital ring hom `α →ₙ+* β` can equivalently be viewed as a non-unital ring hom +`αᵐᵒᵖ →+* βᵐᵒᵖ`. This is the action of the (fully faithful) `ᵐᵒᵖ`-functor on morphisms. -/ +@[simps] +def non_unital_ring_hom.op {α β} [non_unital_non_assoc_semiring α] + [non_unital_non_assoc_semiring β] : (α →ₙ+* β) ≃ (αᵐᵒᵖ →ₙ+* βᵐᵒᵖ) := +{ to_fun := λ f, { ..f.to_add_monoid_hom.mul_op, ..f.to_mul_hom.op }, + inv_fun := λ f, { ..f.to_add_monoid_hom.mul_unop, ..f.to_mul_hom.unop }, + left_inv := λ f, by { ext, refl }, + right_inv := λ f, by { ext, simp } } + +/-- The 'unopposite' of a non-unital ring hom `αᵐᵒᵖ →ₙ+* βᵐᵒᵖ`. Inverse to +`non_unital_ring_hom.op`. -/ +@[simp] def non_unital_ring_hom.unop {α β} [non_unital_non_assoc_semiring α] + [non_unital_non_assoc_semiring β] : (αᵐᵒᵖ →ₙ+* βᵐᵒᵖ) ≃ (α →ₙ+* β) := non_unital_ring_hom.op.symm + /-- A ring homomorphism `f : R →+* S` such that `f x` commutes with `f y` for all `x, y` defines a ring homomorphism to `Sᵐᵒᵖ`. -/ @[simps {fully_applied := ff}] diff --git a/src/algebra/ring/order_synonym.lean b/src/algebra/ring/order_synonym.lean new file mode 100644 index 0000000000000..a10d6672f5c80 --- /dev/null +++ b/src/algebra/ring/order_synonym.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2021 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Yaël Dillies +-/ +import algebra.ring.defs +import algebra.group.order_synonym + +/-! +# Ring structure on the order type synonyms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Transfer algebraic instances from `α` to `αᵒᵈ` and `lex α`. +-/ + +variables {α : Type*} + +/-! ### Order dual -/ + +instance [h : distrib α] : distrib αᵒᵈ := h +instance [has_mul α] [has_add α] [h : left_distrib_class α] : left_distrib_class αᵒᵈ := h +instance [has_mul α] [has_add α] [h : right_distrib_class α] : right_distrib_class αᵒᵈ := h +instance [h : non_unital_non_assoc_semiring α] : non_unital_non_assoc_semiring αᵒᵈ := h +instance [h : non_unital_semiring α] : non_unital_semiring αᵒᵈ := h +instance [h : non_assoc_semiring α] : non_assoc_semiring αᵒᵈ := h +instance [h : semiring α] : semiring αᵒᵈ := h +instance [h : non_unital_comm_semiring α] : non_unital_comm_semiring αᵒᵈ := h +instance [h : comm_semiring α] : comm_semiring αᵒᵈ := h +instance [has_mul α] [h : has_distrib_neg α] : has_distrib_neg αᵒᵈ := h +instance [h : non_unital_non_assoc_ring α] : non_unital_non_assoc_ring αᵒᵈ := h +instance [h : non_unital_ring α] : non_unital_ring αᵒᵈ := h +instance [h : non_assoc_ring α] : non_assoc_ring αᵒᵈ := h +instance [h : ring α] : ring αᵒᵈ := h +instance [h : non_unital_comm_ring α] : non_unital_comm_ring αᵒᵈ := h +instance [h : comm_ring α] : comm_ring αᵒᵈ := h +instance [ring α] [h : is_domain α] : is_domain αᵒᵈ := h + +/-! ### Lexicographical order -/ + +instance [h : distrib α] : distrib (lex α) := h +instance [has_mul α] [has_add α] [h : left_distrib_class α] : left_distrib_class (lex α) := h +instance [has_mul α] [has_add α] [h : right_distrib_class α] : right_distrib_class (lex α) := h +instance [h : non_unital_non_assoc_semiring α] : non_unital_non_assoc_semiring (lex α) := h +instance [h : non_unital_semiring α] : non_unital_semiring (lex α) := h +instance [h : non_assoc_semiring α] : non_assoc_semiring (lex α) := h +instance [h : semiring α] : semiring (lex α) := h +instance [h : non_unital_comm_semiring α] : non_unital_comm_semiring (lex α) := h +instance [h : comm_semiring α] : comm_semiring (lex α) := h +instance [has_mul α] [h : has_distrib_neg α] : has_distrib_neg (lex α) := h +instance [h : non_unital_non_assoc_ring α] : non_unital_non_assoc_ring (lex α) := h +instance [h : non_unital_ring α] : non_unital_ring (lex α) := h +instance [h : non_assoc_ring α] : non_assoc_ring (lex α) := h +instance [h : ring α] : ring (lex α) := h +instance [h : non_unital_comm_ring α] : non_unital_comm_ring (lex α) := h +instance [h : comm_ring α] : comm_ring (lex α) := h +instance [ring α] [h : is_domain α] : is_domain (lex α) := h diff --git a/src/algebra/ring/pi.lean b/src/algebra/ring/pi.lean index 7b0ff31115171..b56dbf7fafd41 100644 --- a/src/algebra/ring/pi.lean +++ b/src/algebra/ring/pi.lean @@ -5,11 +5,14 @@ Authors: Simon Hudon, Patrick Massot -/ import tactic.pi_instances import algebra.group.pi -import algebra.ring.basic +import algebra.hom.ring /-! # Pi instances for ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for ring, semiring and related structures on Pi Types -/ @@ -88,24 +91,67 @@ by refine_struct { zero := (0 : Π i, f i), one := 1, add := (+), mul := (*), npow := monoid.npow }; tactic.pi_instance_derive_field +/-- A family of non-unital ring homomorphisms `f a : γ →ₙ+* β a` defines a non-unital ring +homomorphism `pi.non_unital_ring_hom f : γ →+* Π a, β a` given by +`pi.non_unital_ring_hom f x b = f b x`. -/ +@[simps] +protected def non_unital_ring_hom {γ : Type w} [Π i, non_unital_non_assoc_semiring (f i)] + [non_unital_non_assoc_semiring γ] (g : Π i, γ →ₙ+* f i) : γ →ₙ+* Π i, f i := +{ to_fun := λ x b, g b x, + .. pi.mul_hom (λ i, (g i).to_mul_hom), + .. pi.add_monoid_hom (λ i, (g i).to_add_monoid_hom) } + +lemma non_unital_ring_hom_injective {γ : Type w} [nonempty I] + [Π i, non_unital_non_assoc_semiring (f i)] [non_unital_non_assoc_semiring γ] (g : Π i, γ →ₙ+* f i) + (hg : ∀ i, function.injective (g i)) : function.injective (pi.non_unital_ring_hom g) := +mul_hom_injective (λ i, (g i).to_mul_hom) hg + /-- A family of ring homomorphisms `f a : γ →+* β a` defines a ring homomorphism `pi.ring_hom f : γ →+* Π a, β a` given by `pi.ring_hom f x b = f b x`. -/ @[simps] protected def ring_hom {γ : Type w} [Π i, non_assoc_semiring (f i)] [non_assoc_semiring γ] (g : Π i, γ →+* f i) : γ →+* Π i, f i := { to_fun := λ x b, g b x, - map_add' := λ x y, funext $ λ z, (g z).map_add x y, - map_mul' := λ x y, funext $ λ z, (g z).map_mul x y, - map_one' := funext $ λ z, (g z).map_one, - map_zero' := funext $ λ z, (g z).map_zero } + .. pi.monoid_hom (λ i, (g i).to_monoid_hom), + .. pi.add_monoid_hom (λ i, (g i).to_add_monoid_hom) } lemma ring_hom_injective {γ : Type w} [nonempty I] [Π i, non_assoc_semiring (f i)] [non_assoc_semiring γ] (g : Π i, γ →+* f i) (hg : ∀ i, function.injective (g i)) : function.injective (pi.ring_hom g) := -λ x y h, let ⟨i⟩ := ‹nonempty I› in hg i ((function.funext_iff.mp h : _) i) +monoid_hom_injective (λ i, (g i).to_monoid_hom) hg end pi +section non_unital_ring_hom + +universes u v +variable {I : Type u} + +/-- Evaluation of functions into an indexed collection of non-unital rings at a point is a +non-unital ring homomorphism. This is `function.eval` as a `non_unital_ring_hom`. -/ +@[simps] +def pi.eval_non_unital_ring_hom (f : I → Type v) + [Π i, non_unital_non_assoc_semiring (f i)] (i : I) : (Π i, f i) →ₙ+* f i := +{ ..(pi.eval_mul_hom f i), + ..(pi.eval_add_monoid_hom f i) } + +/-- `function.const` as a `non_unital_ring_hom`. -/ +@[simps] +def pi.const_non_unital_ring_hom (α β : Type*) [non_unital_non_assoc_semiring β] : β →ₙ+* (α → β) := +{ to_fun := function.const _, + .. pi.non_unital_ring_hom (λ _, non_unital_ring_hom.id β) } + +/-- Non-unital ring homomorphism between the function spaces `I → α` and `I → β`, induced by a +non-unital ring homomorphism `f` between `α` and `β`. -/ +@[simps] protected def non_unital_ring_hom.comp_left {α β : Type*} [non_unital_non_assoc_semiring α] + [non_unital_non_assoc_semiring β] (f : α →ₙ+* β) (I : Type*) : + (I → α) →ₙ+* (I → β) := +{ to_fun := λ h, f ∘ h, + .. f.to_mul_hom.comp_left I, + .. f.to_add_monoid_hom.comp_left I } + +end non_unital_ring_hom + section ring_hom universes u v diff --git a/src/algebra/ring/prod.lean b/src/algebra/ring/prod.lean index e3b5c9b826518..5f5c2da349c5e 100644 --- a/src/algebra/ring/prod.lean +++ b/src/algebra/ring/prod.lean @@ -3,15 +3,20 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Chris Hughes, Mario Carneiro, Yury Kudryashov -/ +import data.int.cast.prod import algebra.group.prod -import algebra.ring.basic import algebra.ring.equiv +import algebra.order.monoid.prod /-! # Semiring, ring etc structures on `R × S` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define two-binop (`semiring`, `ring` etc) structures on `R × S`. We also prove -trivial `simp` lemmas, and define the following operations on `ring_hom`s: +trivial `simp` lemmas, and define the following operations on `ring_hom`s and similarly for +`non_unital_ring_hom`s: * `fst R S : R × S →+* R`, `snd R S : R × S →+* S`: projections `prod.fst` and `prod.snd` as `ring_hom`s; @@ -20,7 +25,7 @@ trivial `simp` lemmas, and define the following operations on `ring_hom`s: sends `(x, y)` to `(f x, g y)`. -/ -variables {R : Type*} {R' : Type*} {S : Type*} {S' : Type*} {T : Type*} {T' : Type*} +variables {α β R R' S S' T T' : Type*} namespace prod @@ -43,11 +48,11 @@ instance [non_unital_semiring R] [non_unital_semiring S] : /-- Product of two `non_assoc_semiring`s is a `non_assoc_semiring`. -/ instance [non_assoc_semiring R] [non_assoc_semiring S] : non_assoc_semiring (R × S) := -{ .. prod.non_unital_non_assoc_semiring, .. prod.mul_one_class } +{ .. prod.non_unital_non_assoc_semiring, .. prod.mul_one_class, .. prod.add_monoid_with_one } /-- Product of two semirings is a semiring. -/ instance [semiring R] [semiring S] : semiring (R × S) := -{ .. prod.add_comm_monoid, .. prod.monoid_with_zero, .. prod.distrib } +{ .. prod.add_comm_monoid, .. prod.monoid_with_zero, .. prod.distrib, .. prod.add_monoid_with_one } /-- Product of two `non_unital_comm_semiring`s is a `non_unital_comm_semiring`. -/ instance [non_unital_comm_semiring R] [non_unital_comm_semiring S] : @@ -68,11 +73,11 @@ instance [non_unital_ring R] [non_unital_ring S] : instance [non_assoc_ring R] [non_assoc_ring S] : non_assoc_ring (R × S) := -{ .. prod.add_comm_group, .. prod.non_assoc_semiring } +{ .. prod.add_comm_group, .. prod.non_assoc_semiring, .. prod.add_group_with_one } /-- Product of two rings is a ring. -/ instance [ring R] [ring S] : ring (R × S) := -{ .. prod.add_comm_group, .. prod.semiring } +{ .. prod.add_comm_group, .. prod.add_group_with_one, .. prod.semiring } /-- Product of two `non_unital_comm_ring`s is a `non_unital_comm_ring`. -/ instance [non_unital_comm_ring R] [non_unital_comm_ring S] : non_unital_comm_ring (R × S) := @@ -84,6 +89,68 @@ instance [comm_ring R] [comm_ring S] : comm_ring (R × S) := end prod +namespace non_unital_ring_hom + +variables (R S) [non_unital_non_assoc_semiring R] [non_unital_non_assoc_semiring S] + +/-- Given non-unital semirings `R`, `S`, the natural projection homomorphism from `R × S` to `R`.-/ +def fst : R × S →ₙ+* R := { to_fun := prod.fst, .. mul_hom.fst R S, .. add_monoid_hom.fst R S } + +/-- Given non-unital semirings `R`, `S`, the natural projection homomorphism from `R × S` to `S`.-/ +def snd : R × S →ₙ+* S := { to_fun := prod.snd, .. mul_hom.snd R S, .. add_monoid_hom.snd R S } + +variables {R S} + +@[simp] lemma coe_fst : ⇑(fst R S) = prod.fst := rfl +@[simp] lemma coe_snd : ⇑(snd R S) = prod.snd := rfl + +section prod + +variables [non_unital_non_assoc_semiring T] (f : R →ₙ+* S) (g : R →ₙ+* T) + +/-- Combine two non-unital ring homomorphisms `f : R →ₙ+* S`, `g : R →ₙ+* T` into +`f.prod g : R →ₙ+* S × T` given by `(f.prod g) x = (f x, g x)` -/ +protected def prod (f : R →ₙ+* S) (g : R →ₙ+* T) : R →ₙ+* S × T := +{ to_fun := λ x, (f x, g x), + .. mul_hom.prod (f : mul_hom R S) (g : mul_hom R T), + .. add_monoid_hom.prod (f : R →+ S) (g : R →+ T) } + +@[simp] lemma prod_apply (x) : f.prod g x = (f x, g x) := rfl + +@[simp] lemma fst_comp_prod : (fst S T).comp (f.prod g) = f := +ext $ λ x, rfl + +@[simp] lemma snd_comp_prod : (snd S T).comp (f.prod g) = g := +ext $ λ x, rfl + +lemma prod_unique (f : R →ₙ+* S × T) : + ((fst S T).comp f).prod ((snd S T).comp f) = f := +ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta] + +end prod + +section prod_map + +variables [non_unital_non_assoc_semiring R'] [non_unital_non_assoc_semiring S'] + [non_unital_non_assoc_semiring T] +variables (f : R →ₙ+* R') (g : S →ₙ+* S') + +/-- `prod.map` as a `non_unital_ring_hom`. -/ +def prod_map : R × S →ₙ+* R' × S' := (f.comp (fst R S)).prod (g.comp (snd R S)) + +lemma prod_map_def : prod_map f g = (f.comp (fst R S)).prod (g.comp (snd R S)) := rfl + +@[simp] +lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl + +lemma prod_comp_prod_map (f : T →ₙ+* R) (g : T →ₙ+* S) (f' : R →ₙ+* R') (g' : S →ₙ+* S') : + (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) := +rfl + +end prod_map + +end non_unital_ring_hom + namespace ring_hom variables (R S) [non_assoc_semiring R] [non_assoc_semiring S] @@ -145,7 +212,9 @@ end prod_map end ring_hom namespace ring_equiv -variables {R S} [non_assoc_semiring R] [non_assoc_semiring S] +variables {R S R' S'} +variables [non_assoc_semiring R] [non_assoc_semiring S] +variables [non_assoc_semiring R'] [non_assoc_semiring S'] /-- Swapping components as an equivalence of (semi)rings. -/ def prod_comm : R × S ≃+* S × R := @@ -162,6 +231,31 @@ ring_hom.ext $ λ _, rfl (ring_hom.snd S R).comp ↑(prod_comm : R × S ≃+* S × R) = ring_hom.fst R S := ring_hom.ext $ λ _, rfl +section +variables (R R' S S') + +/-- Four-way commutativity of `prod`. The name matches `mul_mul_mul_comm`. -/ +@[simps apply] +def prod_prod_prod_comm : (R × R') × (S × S') ≃+* (R × S) × (R' × S') := +{ to_fun := λ rrss, ((rrss.1.1, rrss.2.1), (rrss.1.2, rrss.2.2)), + inv_fun := λ rsrs, ((rsrs.1.1, rsrs.2.1), (rsrs.1.2, rsrs.2.2)), + .. add_equiv.prod_prod_prod_comm R R' S S', + .. mul_equiv.prod_prod_prod_comm R R' S S' } + +@[simp] lemma prod_prod_prod_comm_symm : + (prod_prod_prod_comm R R' S S').symm = prod_prod_prod_comm R S R' S' := rfl + +@[simp] lemma prod_prod_prod_comm_to_add_equiv : + (prod_prod_prod_comm R R' S S').to_add_equiv = add_equiv.prod_prod_prod_comm R R' S S' := rfl + +@[simp] lemma prod_prod_prod_comm_to_mul_equiv : + (prod_prod_prod_comm R R' S S').to_mul_equiv = mul_equiv.prod_prod_prod_comm R R' S S' := rfl + +@[simp] lemma prod_prod_prod_comm_to_equiv : + (prod_prod_prod_comm R R' S S').to_equiv = equiv.prod_prod_prod_comm R R' S S' := rfl + +end + variables (R S) [subsingleton S] /-- A ring `R` is isomorphic to `R × S` when `S` is the zero ring -/ @@ -188,10 +282,31 @@ end ring_equiv lemma false_of_nontrivial_of_product_domain (R S : Type*) [ring R] [ring S] [is_domain (R × S)] [nontrivial R] [nontrivial S] : false := begin - have := is_domain.eq_zero_or_eq_zero_of_mul_eq_zero + have := no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero (show ((0 : R), (1 : S)) * (1, 0) = 0, by simp), rw [prod.mk_eq_zero,prod.mk_eq_zero] at this, rcases this with (⟨_,h⟩|⟨h,_⟩), { exact zero_ne_one h.symm }, { exact zero_ne_one h.symm } end + +/-! ### Order -/ + +instance [ordered_semiring α] [ordered_semiring β] : ordered_semiring (α × β) := +{ add_le_add_left := λ _ _, add_le_add_left, + zero_le_one := ⟨zero_le_one, zero_le_one⟩, + mul_le_mul_of_nonneg_left := λ a b c hab hc, + ⟨mul_le_mul_of_nonneg_left hab.1 hc.1, mul_le_mul_of_nonneg_left hab.2 hc.2⟩, + mul_le_mul_of_nonneg_right := λ a b c hab hc, + ⟨mul_le_mul_of_nonneg_right hab.1 hc.1, mul_le_mul_of_nonneg_right hab.2 hc.2⟩, + ..prod.semiring, ..prod.partial_order _ _ } + +instance [ordered_comm_semiring α] [ordered_comm_semiring β] : ordered_comm_semiring (α × β) := +{ ..prod.comm_semiring, ..prod.ordered_semiring } + +instance [ordered_ring α] [ordered_ring β] : ordered_ring (α × β) := +{ mul_nonneg := λ a b ha hb, ⟨mul_nonneg ha.1 hb.1, mul_nonneg ha.2 hb.2⟩, + ..prod.ring, ..prod.ordered_semiring } + +instance [ordered_comm_ring α] [ordered_comm_ring β] : ordered_comm_ring (α × β) := +{ ..prod.comm_ring, ..prod.ordered_ring } diff --git a/src/algebra/ring/regular.lean b/src/algebra/ring/regular.lean new file mode 100644 index 0000000000000..e34a13b1a68e8 --- /dev/null +++ b/src/algebra/ring/regular.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.regular.basic +import algebra.ring.defs + +/-! +# Lemmas about regular elements in rings. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +/-- Left `mul` by a `k : α` over `[ring α]` is injective, if `k` is not a zero divisor. +The typeclass that restricts all terms of `α` to have this property is `no_zero_divisors`. -/ +lemma is_left_regular_of_non_zero_divisor [non_unital_non_assoc_ring α] (k : α) + (h : ∀ (x : α), k * x = 0 → x = 0) : is_left_regular k := +begin + refine λ x y (h' : k * x = k * y), sub_eq_zero.mp (h _ _), + rw [mul_sub, sub_eq_zero, h'] +end + +/-- Right `mul` by a `k : α` over `[ring α]` is injective, if `k` is not a zero divisor. +The typeclass that restricts all terms of `α` to have this property is `no_zero_divisors`. -/ +lemma is_right_regular_of_non_zero_divisor [non_unital_non_assoc_ring α] (k : α) + (h : ∀ (x : α), x * k = 0 → x = 0) : is_right_regular k := +begin + refine λ x y (h' : x * k = y * k), sub_eq_zero.mp (h _ _), + rw [sub_mul, sub_eq_zero, h'] +end + +lemma is_regular_of_ne_zero' [non_unital_non_assoc_ring α] [no_zero_divisors α] {k : α} + (hk : k ≠ 0) : is_regular k := +⟨is_left_regular_of_non_zero_divisor k + (λ x h, (no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left hk), + is_right_regular_of_non_zero_divisor k + (λ x h, (no_zero_divisors.eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hk)⟩ + +lemma is_regular_iff_ne_zero' [nontrivial α] [non_unital_non_assoc_ring α] [no_zero_divisors α] + {k : α} : is_regular k ↔ k ≠ 0 := +⟨λ h, by { rintro rfl, exact not_not.mpr h.left not_is_left_regular_zero }, is_regular_of_ne_zero'⟩ + +/-- A ring with no zero divisors is a `cancel_monoid_with_zero`. + +Note this is not an instance as it forms a typeclass loop. -/ +@[reducible] +def no_zero_divisors.to_cancel_monoid_with_zero [ring α] [no_zero_divisors α] : + cancel_monoid_with_zero α := +{ mul_left_cancel_of_ne_zero := λ a b c ha, + @is_regular.left _ _ _ (is_regular_of_ne_zero' ha) _ _, + mul_right_cancel_of_ne_zero := λ a b c hb, + @is_regular.right _ _ _ (is_regular_of_ne_zero' hb) _ _, + .. (by apply_instance : monoid_with_zero α) } + +/-- A commutative ring with no zero divisors is a `cancel_comm_monoid_with_zero`. + +Note this is not an instance as it forms a typeclass loop. -/ +@[reducible] +def no_zero_divisors.to_cancel_comm_monoid_with_zero [comm_ring α] [no_zero_divisors α] : + cancel_comm_monoid_with_zero α := +{ .. no_zero_divisors.to_cancel_monoid_with_zero, + .. (by apply_instance : comm_monoid_with_zero α) } + +section is_domain + +@[priority 100] -- see Note [lower instance priority] +instance is_domain.to_cancel_monoid_with_zero [semiring α] [is_domain α] : + cancel_monoid_with_zero α := +{ .. semiring.to_monoid_with_zero α, .. ‹is_domain α› } + +variables [comm_semiring α] [is_domain α] + +@[priority 100] -- see Note [lower instance priority] +instance is_domain.to_cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero α := +{ .. ‹comm_semiring α›, .. ‹is_domain α› } + +end is_domain diff --git a/src/algebra/ring/semiconj.lean b/src/algebra/ring/semiconj.lean new file mode 100644 index 0000000000000..ec16a58a95e72 --- /dev/null +++ b/src/algebra/ring/semiconj.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.group.semiconj +import algebra.ring.defs + +/-! +# Semirings and rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file gives lemmas about semirings, rings and domains. +This is analogous to `algebra.group.basic`, +the difference being that the former is about `+` and `*` separately, while +the present file is about their interaction. + +For the definitions of semirings and rings see `algebra.ring.defs`. + +-/ +universes u v w x +variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x} + +open function + +namespace semiconj_by + +@[simp] lemma add_right [distrib R] {a x y x' y' : R} + (h : semiconj_by a x y) (h' : semiconj_by a x' y') : + semiconj_by a (x + x') (y + y') := +by simp only [semiconj_by, left_distrib, right_distrib, h.eq, h'.eq] + +@[simp] lemma add_left [distrib R] {a b x y : R} + (ha : semiconj_by a x y) (hb : semiconj_by b x y) : + semiconj_by (a + b) x y := +by simp only [semiconj_by, left_distrib, right_distrib, ha.eq, hb.eq] + +section +variables [has_mul R] [has_distrib_neg R] {a x y : R} + +lemma neg_right (h : semiconj_by a x y) : semiconj_by a (-x) (-y) := +by simp only [semiconj_by, h.eq, neg_mul, mul_neg] + +@[simp] lemma neg_right_iff : semiconj_by a (-x) (-y) ↔ semiconj_by a x y := +⟨λ h, neg_neg x ▸ neg_neg y ▸ h.neg_right, semiconj_by.neg_right⟩ + +lemma neg_left (h : semiconj_by a x y) : semiconj_by (-a) x y := +by simp only [semiconj_by, h.eq, neg_mul, mul_neg] + +@[simp] lemma neg_left_iff : semiconj_by (-a) x y ↔ semiconj_by a x y := +⟨λ h, neg_neg a ▸ h.neg_left, semiconj_by.neg_left⟩ + +end + +section +variables [mul_one_class R] [has_distrib_neg R] {a x y : R} + +@[simp] lemma neg_one_right (a : R) : semiconj_by a (-1) (-1) := +(one_right a).neg_right + +@[simp] lemma neg_one_left (x : R) : semiconj_by (-1) x x := +(semiconj_by.one_left x).neg_left + +end + +section +variables [non_unital_non_assoc_ring R] {a b x y x' y' : R} + +@[simp] lemma sub_right (h : semiconj_by a x y) (h' : semiconj_by a x' y') : + semiconj_by a (x - x') (y - y') := +by simpa only [sub_eq_add_neg] using h.add_right h'.neg_right + +@[simp] lemma sub_left (ha : semiconj_by a x y) (hb : semiconj_by b x y) : + semiconj_by (a - b) x y := +by simpa only [sub_eq_add_neg] using ha.add_left hb.neg_left + +end + +end semiconj_by diff --git a/src/algebra/ring/ulift.lean b/src/algebra/ring/ulift.lean index d09849d02ccc1..ea974bbd8c39e 100644 --- a/src/algebra/ring/ulift.lean +++ b/src/algebra/ring/ulift.lean @@ -9,6 +9,9 @@ import algebra.ring.equiv /-! # `ulift` instances for ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines instances for ring, semiring and related structures on `ulift` types. (Recall `ulift α` is just a "copy" of a type `α` in a higher universe.) @@ -35,7 +38,7 @@ tactic.pi_instance_derive_field instance non_assoc_semiring [non_assoc_semiring α] : non_assoc_semiring (ulift α) := by refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), - nsmul := add_monoid.nsmul }; + nsmul := add_monoid.nsmul, .. ulift.add_monoid_with_one }; tactic.pi_instance_derive_field instance non_unital_semiring [non_unital_semiring α] : non_unital_semiring (ulift α) := @@ -45,7 +48,7 @@ tactic.pi_instance_derive_field instance semiring [semiring α] : semiring (ulift α) := by refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), - nsmul := add_monoid.nsmul, npow := monoid.npow }; + nsmul := add_monoid.nsmul, npow := monoid.npow, .. ulift.add_monoid_with_one }; tactic.pi_instance_derive_field /-- @@ -66,7 +69,7 @@ tactic.pi_instance_derive_field instance comm_semiring [comm_semiring α] : comm_semiring (ulift α) := by refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), - nsmul := add_monoid.nsmul, npow := monoid.npow }; + nsmul := add_monoid.nsmul, npow := monoid.npow, .. ulift.semiring }; tactic.pi_instance_derive_field instance non_unital_non_assoc_ring [non_unital_non_assoc_ring α] : @@ -84,13 +87,14 @@ tactic.pi_instance_derive_field instance non_assoc_ring [non_assoc_ring α] : non_assoc_ring (ulift α) := by refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), sub := has_sub.sub, - neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul }; + neg := has_neg.neg, nsmul := add_monoid.nsmul, zsmul := sub_neg_monoid.zsmul, + .. ulift.add_group_with_one }; tactic.pi_instance_derive_field instance ring [ring α] : ring (ulift α) := by refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), sub := has_sub.sub, neg := has_neg.neg, nsmul := add_monoid.nsmul, npow := monoid.npow, - zsmul := sub_neg_monoid.zsmul }; + zsmul := sub_neg_monoid.zsmul, .. ulift.semiring, .. ulift.add_group_with_one }; tactic.pi_instance_derive_field instance non_unital_comm_ring [non_unital_comm_ring α] : non_unital_comm_ring (ulift α) := @@ -99,19 +103,7 @@ by refine_struct { zero := (0 : ulift α), add := (+), mul := (*), sub := has_su tactic.pi_instance_derive_field instance comm_ring [comm_ring α] : comm_ring (ulift α) := -by refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), sub := has_sub.sub, - neg := has_neg.neg, nsmul := add_monoid.nsmul, npow := monoid.npow, - zsmul := sub_neg_monoid.zsmul }; +by refine_struct { .. ulift.ring }; tactic.pi_instance_derive_field -instance field [field α] : field (ulift α) := -begin refine_struct { zero := (0 : ulift α), one := 1, add := (+), mul := (*), sub := has_sub.sub, - neg := has_neg.neg, nsmul := add_monoid.nsmul, npow := monoid.npow, zsmul := sub_neg_monoid.zsmul, - inv := has_inv.inv, div := has_div.div, zpow := λ n a, ulift.up (a.down ^ n), - exists_pair_ne := ulift.nontrivial.1 }; tactic.pi_instance_derive_field, - -- `mul_inv_cancel` requires special attention: it leaves the goal `∀ {a}, a ≠ 0 → a * a⁻¹ = 1`. - cases a, - tauto -end - end ulift diff --git a/src/algebra/ring/units.lean b/src/algebra/ring/units.lean new file mode 100644 index 0000000000000..c80b6157c2000 --- /dev/null +++ b/src/algebra/ring/units.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland +-/ +import algebra.ring.inj_surj +import algebra.group.units + +/-! +# Units in semirings and rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ +universes u v w x +variables {α : Type u} {β : Type v} {γ : Type w} {R : Type x} + +open function + +namespace units + +section has_distrib_neg +variables [monoid α] [has_distrib_neg α] {a b : α} + +/-- Each element of the group of units of a ring has an additive inverse. -/ +instance : has_neg αˣ := ⟨λu, ⟨-↑u, -↑u⁻¹, by simp, by simp⟩ ⟩ + +/-- Representing an element of a ring's unit group as an element of the ring commutes with + mapping this element to its additive inverse. -/ +@[simp, norm_cast] protected theorem coe_neg (u : αˣ) : (↑-u : α) = -u := rfl + +@[simp, norm_cast] protected theorem coe_neg_one : ((-1 : αˣ) : α) = -1 := rfl + +instance : has_distrib_neg αˣ := units.ext.has_distrib_neg _ units.coe_neg units.coe_mul + +@[field_simps] lemma neg_divp (a : α) (u : αˣ) : -(a /ₚ u) = (-a) /ₚ u := +by simp only [divp, neg_mul] + +end has_distrib_neg + +section ring + +variables [ring α] {a b : α} + +@[field_simps] lemma divp_add_divp_same (a b : α) (u : αˣ) : + a /ₚ u + b /ₚ u = (a + b) /ₚ u := +by simp only [divp, add_mul] + +@[field_simps] lemma divp_sub_divp_same (a b : α) (u : αˣ) : + a /ₚ u - b /ₚ u = (a - b) /ₚ u := +by rw [sub_eq_add_neg, sub_eq_add_neg, neg_divp, divp_add_divp_same] + +@[field_simps] lemma add_divp (a b : α) (u : αˣ) : a + b /ₚ u = (a * u + b) /ₚ u := +by simp only [divp, add_mul, units.mul_inv_cancel_right] + +@[field_simps] lemma sub_divp (a b : α) (u : αˣ) : a - b /ₚ u = (a * u - b) /ₚ u := +by simp only [divp, sub_mul, units.mul_inv_cancel_right] + +@[field_simps] lemma divp_add (a b : α) (u : αˣ) : a /ₚ u + b = (a + b * u) /ₚ u := +by simp only [divp, add_mul, units.mul_inv_cancel_right] + +@[field_simps] lemma divp_sub (a b : α) (u : αˣ) : a /ₚ u - b = (a - b * u) /ₚ u := +begin + simp only [divp, sub_mul, sub_right_inj], + assoc_rw [units.mul_inv, mul_one], +end + +end ring + +end units + +lemma is_unit.neg [monoid α] [has_distrib_neg α] {a : α} : is_unit a → is_unit (-a) +| ⟨x, hx⟩ := hx ▸ (-x).is_unit + +@[simp] +lemma is_unit.neg_iff [monoid α] [has_distrib_neg α] (a : α) : is_unit (-a) ↔ is_unit a := +⟨λ h, neg_neg a ▸ h.neg, is_unit.neg⟩ + +lemma is_unit.sub_iff [ring α] {x y : α} : + is_unit (x - y) ↔ is_unit (y - x) := +(is_unit.neg_iff _).symm.trans $ neg_sub x y ▸ iff.rfl + +namespace units + +@[field_simps] lemma divp_add_divp [comm_ring α] (a b : α) (u₁ u₂ : αˣ) : +a /ₚ u₁ + b /ₚ u₂ = (a * u₂ + u₁ * b) /ₚ (u₁ * u₂) := +begin + simp only [divp, add_mul, mul_inv_rev, coe_mul], + rw [mul_comm (↑u₁ * b), mul_comm b], + assoc_rw [mul_inv, mul_inv, mul_one, mul_one], +end + +@[field_simps] lemma divp_sub_divp [comm_ring α] (a b : α) (u₁ u₂ : αˣ) : + (a /ₚ u₁) - (b /ₚ u₂) = ((a * u₂) - (u₁ * b)) /ₚ (u₁ * u₂) := +by simp_rw [sub_eq_add_neg, neg_divp, divp_add_divp, mul_neg] + +lemma add_eq_mul_one_add_div [semiring R] {a : Rˣ} {b : R} : ↑a + b = a * (1 + ↑a⁻¹ * b) := +by rwa [mul_add, mul_one, ← mul_assoc, units.mul_inv, one_mul] + +end units diff --git a/src/algebra/ring_quot.lean b/src/algebra/ring_quot.lean index 707b36502dd67..026ee392e01c4 100644 --- a/src/algebra/ring_quot.lean +++ b/src/algebra/ring_quot.lean @@ -3,12 +3,15 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import algebra.algebra.basic +import algebra.algebra.hom import ring_theory.ideal.quotient /-! # Quotients of non-commutative rings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Unfortunately, ideals have only been developed in the commutative case as `ideal`, and it's not immediately clear how one should formalise ideals in the non-commutative case. @@ -27,6 +30,19 @@ variables {R : Type u₁} [semiring R] variables {S : Type u₂} [comm_semiring S] variables {A : Type u₃} [semiring A] [algebra S A] +namespace ring_con + +instance (c : ring_con A) : algebra S c.quotient := +{ smul := (•), + to_ring_hom := c.mk'.comp (algebra_map S A), + commutes' := λ r, quotient.ind' $ by exact λ a, congr_arg quotient.mk' $ algebra.commutes _ _, + smul_def' := λ r, quotient.ind' $ by exact λ a, congr_arg quotient.mk' $ algebra.smul_def _ _ } + +@[simp, norm_cast] lemma coe_algebra_map (c : ring_con A) (s : S) : + (↑(algebra_map S A s) : c.quotient) = algebra_map S _ s := rfl + +end ring_con + namespace ring_quot /-- @@ -58,6 +74,67 @@ by simp only [sub_eq_add_neg, h.neg.add_right] theorem rel.smul {r : A → A → Prop} (k : S) ⦃a b : A⦄ (h : rel r a b) : rel r (k • a) (k • b) := by simp only [algebra.smul_def, rel.mul_right h] +/-- `eqv_gen (ring_quot.rel r)` is a ring congruence. -/ +def ring_con (r : R → R → Prop) : ring_con R := +{ r := eqv_gen (rel r), + iseqv := eqv_gen.is_equivalence _, + add' := λ a b c d hab hcd, begin + induction hab with a' b' hab e a' b' hab' _ c' d' e hcd' hde' ihcd' ihde' generalizing c d, + { refine (eqv_gen.rel _ _ hab.add_left).trans _ _ _ _, + induction hcd with c' d' hcd f c' d' hcd' habcd' c' d' f' hcd' hdf' hbcd' hbcf', + { exact (eqv_gen.rel _ _ hcd.add_right), }, + { exact (eqv_gen.refl _), }, + { exact (habcd'.symm _ _), }, + { exact hbcd'.trans _ _ _ hbcf', }, }, + { induction hcd with c' d' hcd f c' d' hcd' habcd' c' d' f' hcd' hdf' hbcd' hbcf', + { exact (eqv_gen.rel _ _ hcd.add_right), }, + { exact (eqv_gen.refl _), }, + { exact (eqv_gen.symm _ _ habcd'), }, + { exact hbcd'.trans _ _ _ hbcf' }, }, + { exact (hab_ih _ _ $ hcd.symm _ _).symm _ _, }, + { exact (ihcd' _ _ hcd).trans _ _ _ (ihde' _ _ $ eqv_gen.refl _), }, + end, + mul' := λ a b c d hab hcd, begin + induction hab with a' b' hab e a' b' hab' _ c' d' e hcd' hde' ihcd' ihde' generalizing c d, + { refine (eqv_gen.rel _ _ hab.mul_left).trans _ _ _ _, + induction hcd with c' d' hcd f c' d' hcd' habcd' c' d' f' hcd' hdf' hbcd' hbcf', + { exact (eqv_gen.rel _ _ hcd.mul_right), }, + { exact (eqv_gen.refl _), }, + { exact (habcd'.symm _ _), }, + { exact hbcd'.trans _ _ _ hbcf', }, }, + { induction hcd with c' d' hcd f c' d' hcd' habcd' c' d' f' hcd' hdf' hbcd' hbcf', + { exact (eqv_gen.rel _ _ hcd.mul_right), }, + { exact (eqv_gen.refl _), }, + { exact (eqv_gen.symm _ _ habcd'), }, + { exact hbcd'.trans _ _ _ hbcf' }, }, + { exact (hab_ih _ _ $ hcd.symm _ _).symm _ _, }, + { exact (ihcd' _ _ hcd).trans _ _ _ (ihde' _ _ $ eqv_gen.refl _), }, + end } + +lemma eqv_gen_rel_eq (r : R → R → Prop) : eqv_gen (rel r) = ring_con_gen.rel r := +begin + ext x₁ x₂, + split, + { intro h, + induction h with x₃ x₄ h₃₄, + { induction h₃₄ with _ dfg h₃₄ x₃ x₄ x₅ h₃₄', + { exact ring_con_gen.rel.of _ _ ‹_› }, + { exact h₃₄_ih.add (ring_con_gen.rel.refl _) }, + { exact h₃₄_ih.mul (ring_con_gen.rel.refl _) }, + { exact (ring_con_gen.rel.refl _).mul h₃₄_ih} }, + { exact ring_con_gen.rel.refl _ }, + { exact ring_con_gen.rel.symm ‹_› }, + { exact ring_con_gen.rel.trans ‹_› ‹_› } }, + { intro h, + induction h, + { exact eqv_gen.rel _ _ (rel.of ‹_›), }, + { exact (ring_quot.ring_con r).refl _, }, + { exact (ring_quot.ring_con r).symm ‹_›, }, + { exact (ring_quot.ring_con r).trans ‹_› ‹_›, }, + { exact (ring_quot.ring_con r).add ‹_› ‹_›, }, + { exact (ring_quot.ring_con r).mul ‹_› ‹_›, } } +end + end ring_quot /-- The quotient of a ring by an arbitrary relation. -/ @@ -68,6 +145,7 @@ namespace ring_quot variable (r : R → R → Prop) +@[irreducible] private def nat_cast (n : ℕ) : ring_quot r := ⟨quot.mk _ n⟩ @[irreducible] private def zero : ring_quot r := ⟨quot.mk _ 0⟩ @[irreducible] private def one : ring_quot r := ⟨quot.mk _ 1⟩ @[irreducible] private def add : ring_quot r → ring_quot r → ring_quot r @@ -79,6 +157,18 @@ variable (r : R → R → Prop) @[irreducible] private def sub {R : Type u₁} [ring R] (r : R → R → Prop) : ring_quot r → ring_quot r → ring_quot r | ⟨a⟩ ⟨b⟩ := ⟨quot.map₂ has_sub.sub rel.sub_right rel.sub_left a b⟩ +@[irreducible] private def npow (n : ℕ) : ring_quot r → ring_quot r +| ⟨a⟩ := ⟨quot.lift + (λ a, quot.mk (ring_quot.rel r) (a ^ n)) + (λ a b (h : rel r a b), begin + -- note we can't define a `rel.pow` as `rel` isn't reflexive so `rel r 1 1` isn't true + dsimp only, + induction n, + { rw [pow_zero, pow_zero] }, + { rw [pow_succ, pow_succ], + simpa only [mul] using congr_arg2 (λ x y, mul r ⟨x⟩ ⟨y⟩) (quot.sound h) n_ih } + end) + a⟩ @[irreducible] private def smul [algebra S R] (n : S) : ring_quot r → ring_quot r | ⟨a⟩ := ⟨quot.map (λ a, n • a) (rel.smul n) a⟩ @@ -86,9 +176,10 @@ instance : has_zero (ring_quot r) := ⟨zero r⟩ instance : has_one (ring_quot r) := ⟨one r⟩ instance : has_add (ring_quot r) := ⟨add r⟩ instance : has_mul (ring_quot r) := ⟨mul r⟩ +instance : has_pow (ring_quot r) ℕ := ⟨λ x n, npow r n x⟩ instance {R : Type u₁} [ring R] (r : R → R → Prop) : has_neg (ring_quot r) := ⟨neg r⟩ instance {R : Type u₁} [ring R] (r : R → R → Prop) : has_sub (ring_quot r) := ⟨sub r⟩ -instance [algebra S R] : has_scalar S (ring_quot r) := ⟨smul r⟩ +instance [algebra S R] : has_smul S (ring_quot r) := ⟨smul r⟩ lemma zero_quot : (⟨quot.mk _ 0⟩ : ring_quot r) = 0 := show _ = zero r, by rw zero lemma one_quot : (⟨quot.mk _ 1⟩ : ring_quot r) = 1 := show _ = one r, by rw one @@ -96,6 +187,8 @@ lemma add_quot {a b} : (⟨quot.mk _ a⟩ + ⟨quot.mk _ b⟩ : ring_quot r) = by { show add r _ _ = _, rw add, refl } lemma mul_quot {a b} : (⟨quot.mk _ a⟩ * ⟨quot.mk _ b⟩ : ring_quot r) = ⟨quot.mk _ (a * b)⟩ := by { show mul r _ _ = _, rw mul, refl } +lemma pow_quot {a} {n : ℕ}: (⟨quot.mk _ a⟩ ^ n : ring_quot r) = ⟨quot.mk _ (a ^ n)⟩ := +by { show npow r _ _ = _, rw npow } lemma neg_quot {R : Type u₁} [ring R] (r : R → R → Prop) {a} : (-⟨quot.mk _ a⟩ : ring_quot r) = ⟨quot.mk _ (-a)⟩ := by { show neg r _ = _, rw neg, refl } @@ -111,6 +204,9 @@ instance (r : R → R → Prop) : semiring (ring_quot r) := mul := (*), zero := 0, one := 1, + nat_cast := nat_cast r, + nat_cast_zero := by simp [nat.cast, nat_cast, ← zero_quot], + nat_cast_succ := by simp [nat.cast, nat_cast, ← one_quot, add_quot], add_assoc := by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟩⟩, simp [add_quot, add_assoc] }, zero_add := by { rintros ⟨⟨⟩⟩, simp [add_quot, ← zero_quot] }, add_zero := by { rintros ⟨⟨⟩⟩, simp [add_quot, ← zero_quot], }, @@ -122,6 +218,9 @@ instance (r : R → R → Prop) : semiring (ring_quot r) := mul_one := by { rintros ⟨⟨⟩⟩, simp [mul_quot, ← one_quot] }, left_distrib := by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟩⟩, simp [mul_quot, add_quot, left_distrib] }, right_distrib := by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟩⟩, simp [mul_quot, add_quot, right_distrib] }, + npow := λ n x, x ^ n, + npow_zero' := by { rintros ⟨⟨⟩⟩, simp [pow_quot, ← one_quot] }, + npow_succ' := by { rintros n ⟨⟨⟩⟩, simp [pow_quot, mul_quot, pow_succ] }, nsmul := (•), nsmul_zero' := by { rintros ⟨⟨⟩⟩, simp [smul_quot, ← zero_quot] }, nsmul_succ' := by { rintros n ⟨⟨⟩⟩, simp [smul_quot, add_quot, add_mul, add_comm] } } @@ -131,6 +230,10 @@ instance {R : Type u₁} [ring R] (r : R → R → Prop) : ring (ring_quot r) := add_left_neg := by { rintros ⟨⟨⟩⟩, simp [neg_quot, add_quot, ← zero_quot], }, sub := has_sub.sub, sub_eq_add_neg := by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩, simp [neg_quot, sub_quot, add_quot, sub_eq_add_neg] }, + zsmul := (•), + zsmul_zero' := by { rintros ⟨⟨⟩⟩, simp [smul_quot, ← zero_quot] }, + zsmul_succ' := by { rintros n ⟨⟨⟩⟩, simp [smul_quot, add_quot, add_mul, add_comm] }, + zsmul_neg' := by { rintros n ⟨⟨⟩⟩, simp [smul_quot, neg_quot, add_mul] }, .. (ring_quot.semiring r) } instance {R : Type u₁} [comm_semiring R] (r : R → R → Prop) : comm_semiring (ring_quot r) := @@ -156,7 +259,7 @@ instance [algebra S R] (r : R → R → Prop) : algebra S (ring_quot r) := /-- The quotient map from a ring to its quotient, as a homomorphism of rings. -/ -def mk_ring_hom (r : R → R → Prop) : R →+* ring_quot r := +@[irreducible] def mk_ring_hom (r : R → R → Prop) : R →+* ring_quot r := { to_fun := λ x, ⟨quot.mk _ x⟩, map_one' := by simp [← one_quot], map_mul' := by simp [mul_quot], @@ -185,7 +288,7 @@ variables {T : Type u₄} [semiring T] Any ring homomorphism `f : R →+* T` which respects a relation `r : R → R → Prop` factors uniquely through a morphism `ring_quot r →+* T`. -/ -def lift {r : R → R → Prop} : +@[irreducible] def lift {r : R → R → Prop} : {f : R →+* T // ∀ ⦃x y⦄, r x y → f x = f y} ≃ (ring_quot r →+* T) := { to_fun := λ f', let f := (f' : R →+* T) in { to_fun := λ x, quot.lift f @@ -202,13 +305,13 @@ def lift {r : R → R → Prop} : map_one' := by simp [← one_quot, f.map_one], map_mul' := by { rintros ⟨⟨x⟩⟩ ⟨⟨y⟩⟩, simp [mul_quot, f.map_mul x y] }, }, inv_fun := λ F, ⟨F.comp (mk_ring_hom r), λ x y h, by { dsimp, rw mk_ring_hom_rel h, }⟩, - left_inv := λ f, by { ext, simp, refl }, - right_inv := λ F, by { ext, simp, refl } } + left_inv := λ f, by { ext, simp [mk_ring_hom] }, + right_inv := λ F, by { ext, simp [mk_ring_hom] } } @[simp] lemma lift_mk_ring_hom_apply (f : R →+* T) {r : R → R → Prop} (w : ∀ ⦃x y⦄, r x y → f x = f y) (x) : lift ⟨f, w⟩ (mk_ring_hom r x) = f x := -rfl +by { simp_rw [lift, mk_ring_hom], refl } -- note this is essentially `lift.symm_apply_eq.mp h` lemma lift_unique (f : R →+* T) {r : R → R → Prop} (w : ∀ ⦃x y⦄, r x y → f x = f y) @@ -217,7 +320,12 @@ by { ext, simp [h], } lemma eq_lift_comp_mk_ring_hom {r : R → R → Prop} (f : ring_quot r →+* T) : f = lift ⟨f.comp (mk_ring_hom r), λ x y h, by { dsimp, rw mk_ring_hom_rel h, }⟩ := -(lift.apply_symm_apply f).symm +begin + conv_lhs { rw ← lift.apply_symm_apply f }, + rw lift, + refl, +end + section comm_ring /-! @@ -235,7 +343,11 @@ lift λ x y h, ideal.quotient.eq.2 $ submodule.mem_Inf.mpr (λ p w, w ⟨x, y, h, sub_add_cancel x y⟩)⟩ @[simp] lemma ring_quot_to_ideal_quotient_apply (r : B → B → Prop) (x : B) : - ring_quot_to_ideal_quotient r (mk_ring_hom r x) = ideal.quotient.mk _ x := rfl + ring_quot_to_ideal_quotient r (mk_ring_hom r x) = ideal.quotient.mk _ x := +begin + simp_rw [ring_quot_to_ideal_quotient, lift, mk_ring_hom], + refl +end /-- The universal ring homomorphism from `B ⧸ ideal.of_rel r` to `ring_quot r`. -/ def ideal_quotient_to_ring_quot (r : B → B → Prop) : @@ -261,7 +373,20 @@ The ring equivalence between `ring_quot r` and `(ideal.of_rel r).quotient` def ring_quot_equiv_ideal_quotient (r : B → B → Prop) : ring_quot r ≃+* B ⧸ ideal.of_rel r := ring_equiv.of_hom_inv (ring_quot_to_ideal_quotient r) (ideal_quotient_to_ring_quot r) - (by { ext, refl, }) (by { ext, refl, }) + (begin + ext, + simp_rw [ring_quot_to_ideal_quotient, lift, mk_ring_hom], + dsimp, + rw [mk_ring_hom], + refl + end) + (begin + ext, + simp_rw [ring_quot_to_ideal_quotient, lift, mk_ring_hom], + dsimp, + rw [mk_ring_hom], + refl + end) end comm_ring @@ -305,20 +430,20 @@ variables (S) /-- The quotient map from an `S`-algebra to its quotient, as a homomorphism of `S`-algebras. -/ -def mk_alg_hom (s : A → A → Prop) : A →ₐ[S] ring_quot s := -{ commutes' := λ r, rfl, +@[irreducible] def mk_alg_hom (s : A → A → Prop) : A →ₐ[S] ring_quot s := +{ commutes' := λ r, by { simp [mk_ring_hom], refl }, ..mk_ring_hom s } @[simp] lemma mk_alg_hom_coe (s : A → A → Prop) : (mk_alg_hom S s : A →+* ring_quot s) = mk_ring_hom s := -rfl +by { simp_rw [mk_alg_hom, mk_ring_hom], refl } lemma mk_alg_hom_rel {s : A → A → Prop} {x y : A} (w : s x y) : mk_alg_hom S s x = mk_alg_hom S s y := by simp [mk_alg_hom, mk_ring_hom, quot.sound (rel.of w)] lemma mk_alg_hom_surjective (s : A → A → Prop) : function.surjective (mk_alg_hom S s) := -by { dsimp [mk_alg_hom], rintro ⟨⟨a⟩⟩, use a, refl, } +by { dsimp [mk_alg_hom, mk_ring_hom], rintro ⟨⟨a⟩⟩, use a, refl, } variables {B : Type u₄} [semiring B] [algebra S B] @@ -335,8 +460,8 @@ end Any `S`-algebra homomorphism `f : A →ₐ[S] B` which respects a relation `s : A → A → Prop` factors uniquely through a morphism `ring_quot s →ₐ[S] B`. -/ -def lift_alg_hom {s : A → A → Prop} : - { f : A →ₐ[S] B // ∀ ⦃x y⦄, s x y → f x = f y} ≃ (ring_quot s →ₐ[S] B) := +@[irreducible] def lift_alg_hom {s : A → A → Prop} : + {f : A →ₐ[S] B // ∀ ⦃x y⦄, s x y → f x = f y} ≃ (ring_quot s →ₐ[S] B) := { to_fun := λ f', let f := (f' : A →ₐ[S] B) in { to_fun := λ x, quot.lift f begin @@ -353,14 +478,14 @@ def lift_alg_hom {s : A → A → Prop} : map_mul' := by { rintros ⟨⟨x⟩⟩ ⟨⟨y⟩⟩, simp [mul_quot, f.map_mul x y], }, commutes' := by { rintros x, simp [← one_quot, smul_quot, algebra.algebra_map_eq_smul_one] } }, inv_fun := λ F, ⟨F.comp (mk_alg_hom S s), λ _ _ h, by { dsimp, erw mk_alg_hom_rel S h }⟩, - left_inv := λ f, by { ext, simp, refl }, - right_inv := λ F, by { ext, simp, refl } } + left_inv := λ f, by { ext, simp [mk_alg_hom, mk_ring_hom] }, + right_inv := λ F, by { ext, simp [mk_alg_hom, mk_ring_hom] } } @[simp] lemma lift_alg_hom_mk_alg_hom_apply (f : A →ₐ[S] B) {s : A → A → Prop} (w : ∀ ⦃x y⦄, s x y → f x = f y) (x) : (lift_alg_hom S ⟨f, w⟩) ((mk_alg_hom S s) x) = f x := -rfl +by { simp_rw [lift_alg_hom, mk_alg_hom, mk_ring_hom], refl, } -- note this is essentially `(lift_alg_hom S).symm_apply_eq.mp h` lemma lift_alg_hom_unique (f : A →ₐ[S] B) {s : A → A → Prop} (w : ∀ ⦃x y⦄, s x y → f x = f y) @@ -369,10 +494,12 @@ by { ext, simp [h], } lemma eq_lift_alg_hom_comp_mk_alg_hom {s : A → A → Prop} (f : ring_quot s →ₐ[S] B) : f = lift_alg_hom S ⟨f.comp (mk_alg_hom S s), λ x y h, by { dsimp, erw mk_alg_hom_rel S h, }⟩ := -((lift_alg_hom S).apply_symm_apply f).symm +begin + conv_lhs { rw ← ((lift_alg_hom S).apply_symm_apply f) }, + rw lift_alg_hom, + refl, +end end algebra -attribute [irreducible] mk_ring_hom mk_alg_hom lift lift_alg_hom - end ring_quot diff --git a/src/algebra/smul_with_zero.lean b/src/algebra/smul_with_zero.lean index 1e6dac42ea547..d8cb21c62c171 100644 --- a/src/algebra/smul_with_zero.lean +++ b/src/algebra/smul_with_zero.lean @@ -11,6 +11,9 @@ import group_theory.group_action.prod /-! # Introduce `smul_with_zero` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In analogy with the usual monoid action on a Type `M`, we introduce an action of a `monoid_with_zero` on a Type with `0`. @@ -42,8 +45,7 @@ variables (R M) /-- `smul_with_zero` is a class consisting of a Type `R` with `0 ∈ R` and a scalar multiplication of `R` on a Type `M` with `0`, such that the equality `r • m = 0` holds if at least one among `r` or `m` equals `0`. -/ -class smul_with_zero [has_zero R] [has_zero M] extends has_scalar R M := -(smul_zero : ∀ r : R, r • (0 : M) = 0) +class smul_with_zero [has_zero R] [has_zero M] extends smul_zero_class R M := (zero_smul : ∀ m : M, (0 : R) • m = 0) instance mul_zero_class.to_smul_with_zero [mul_zero_class R] : smul_with_zero R R := @@ -61,11 +63,14 @@ variables (R) {M} [has_zero R] [has_zero M] [smul_with_zero R M] @[simp] lemma zero_smul (m : M) : (0 : R) • m = 0 := smul_with_zero.zero_smul m -variables {R} (M) -/-- Note that this lemma has different typeclass assumptions to `smul_zero`. -/ -@[simp] lemma smul_zero' (r : R) : r • (0 : M) = 0 := smul_with_zero.smul_zero r +variables {R} {a : R} {b : M} + +lemma smul_eq_zero_of_left (h : a = 0) (b : M) : a • b = 0 := h.symm ▸ zero_smul _ b +lemma smul_eq_zero_of_right (a : R) (h : b = 0) : a • b = 0 := h.symm ▸ smul_zero a +lemma left_ne_zero_of_smul : a • b ≠ 0 → a ≠ 0 := mt $ λ h, smul_eq_zero_of_left h b +lemma right_ne_zero_of_smul : a • b ≠ 0 → b ≠ 0 := mt $ smul_eq_zero_of_right a -variables {R M} [has_zero R'] [has_zero M'] [has_scalar R M'] +variables {R M} [has_zero R'] [has_zero M'] [has_smul R M'] /-- Pullback a `smul_with_zero` structure along an injective zero-preserving homomorphism. See note [reducible non-instances]. -/ @@ -85,7 +90,7 @@ protected def function.surjective.smul_with_zero smul_with_zero R M' := { smul := (•), zero_smul := λ m, by { rcases hf m with ⟨x, rfl⟩, simp [←smul] }, - smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero'] } + smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero] } variables (M) @@ -134,7 +139,16 @@ instance monoid_with_zero.to_opposite_mul_action_with_zero : mul_action_with_zer { ..mul_zero_class.to_opposite_smul_with_zero R, ..monoid.to_opposite_mul_action R } -variables {R M} [mul_action_with_zero R M] [has_zero M'] [has_scalar R M'] +protected lemma mul_action_with_zero.subsingleton + [mul_action_with_zero R M] [subsingleton R] : subsingleton M := +⟨λ x y, by rw [←one_smul R x, ←one_smul R y, subsingleton.elim (1 : R) 0, zero_smul, zero_smul]⟩ + +protected lemma mul_action_with_zero.nontrivial + [mul_action_with_zero R M] [nontrivial M] : nontrivial R := +(subsingleton_or_nontrivial R).resolve_left $ λ hR, not_subsingleton M $ + by exactI mul_action_with_zero.subsingleton R M + +variables {R M} [mul_action_with_zero R M] [has_zero M'] [has_smul R M'] /-- Pullback a `mul_action_with_zero` structure along an injective zero-preserving homomorphism. See note [reducible non-instances]. -/ @@ -172,8 +186,8 @@ begin obtain rfl | hc := eq_or_ne c 0, { simp only [inv_zero, zero_smul] }, obtain rfl | hx := eq_or_ne x 0, - { simp only [inv_zero, smul_zero'] }, - { refine (eq_inv_of_mul_left_eq_one _).symm, + { simp only [inv_zero, smul_zero] }, + { refine inv_eq_of_mul_eq_one_left _, rw [smul_mul_smul, inv_mul_cancel hc, inv_mul_cancel hx, one_smul] } end @@ -184,5 +198,5 @@ end group_with_zero def smul_monoid_with_zero_hom {α β : Type*} [monoid_with_zero α] [mul_zero_one_class β] [mul_action_with_zero α β] [is_scalar_tower α β β] [smul_comm_class α β β] : α × β →*₀ β := -{ map_zero' := smul_zero' _ _, +{ map_zero' := smul_zero _, .. smul_monoid_hom } diff --git a/src/algebra/squarefree.lean b/src/algebra/squarefree.lean index 21ef0efe6a34f..dd70a525e1e70 100644 --- a/src/algebra/squarefree.lean +++ b/src/algebra/squarefree.lean @@ -4,15 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Aaron Anderson -/ import ring_theory.unique_factorization_domain -import ring_theory.int.basic -import number_theory.divisors -import algebra.is_prime_pow /-! # Squarefree elements of monoids + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. An element of a monoid is squarefree when it is not divisible by any squares except the squares of units. +Results about squarefree natural numbers are proved in `data/nat/squarefree`. + ## Main Definitions - `squarefree r` indicates that `r` is only divisible by `x * x` if `x` is a unit. @@ -21,8 +23,7 @@ except the squares of units. `multiplicity y x ≤ 1` or `is_unit y`. - `unique_factorization_monoid.squarefree_iff_nodup_factors`: A nonzero element `x` of a unique factorization monoid is squarefree iff `factors x` has no duplicate factors. - - `nat.squarefree_iff_nodup_factors`: A positive natural number `x` is squarefree iff - the list `factors x` has no duplicate factors. + ## Tags squarefree, multiplicity @@ -79,11 +80,25 @@ lemma squarefree.of_mul_left [comm_monoid R] {m n : R} (hmn : squarefree (m * n) lemma squarefree.of_mul_right [comm_monoid R] {m n : R} (hmn : squarefree (m * n)) : squarefree n := (λ p hp, hmn p (dvd_mul_of_dvd_right hp m)) -lemma squarefree_of_dvd_of_squarefree [comm_monoid R] +lemma squarefree.squarefree_of_dvd [comm_monoid R] {x y : R} (hdvd : x ∣ y) (hsq : squarefree y) : squarefree x := λ a h, hsq _ (h.trans hdvd) +section squarefree_gcd_of_squarefree + +variables {α : Type*} [cancel_comm_monoid_with_zero α] [gcd_monoid α] + +lemma squarefree.gcd_right (a : α) {b : α} (hb : squarefree b) : + squarefree (gcd a b) := +hb.squarefree_of_dvd (gcd_dvd_right _ _) + +lemma squarefree.gcd_left {a : α} (b : α) (ha : squarefree a) : + squarefree (gcd a b) := +ha.squarefree_of_dvd (gcd_dvd_left _ _) + +end squarefree_gcd_of_squarefree + namespace multiplicity section comm_monoid @@ -94,10 +109,8 @@ lemma squarefree_iff_multiplicity_le_one (r : R) : squarefree r ↔ ∀ x : R, multiplicity x r ≤ 1 ∨ is_unit x := begin refine forall_congr (λ a, _), - rw [← sq, pow_dvd_iff_le_multiplicity, or_iff_not_imp_left, not_le, imp_congr], - swap, { refl }, - convert enat.add_one_le_iff_lt (enat.coe_ne_top 1), - norm_cast, + rw [← sq, pow_dvd_iff_le_multiplicity, or_iff_not_imp_left, not_le, imp_congr _ iff.rfl], + simpa using part_enat.add_one_le_iff_lt (part_enat.coe_ne_top 1) end end comm_monoid @@ -114,10 +127,10 @@ begin refine wf_dvd_monoid.induction_on_irreducible b (by contradiction) (λ u hu hu', _) (λ b p hb hp ih hpb, _), { rw [multiplicity.finite_iff_dom, multiplicity.is_unit_right ha.not_unit hu], - exact enat.dom_coe 0, }, + exact part_enat.dom_coe 0, }, { refine multiplicity.finite_mul ha - (multiplicity.finite_iff_dom.mpr (enat.dom_of_le_coe (show multiplicity a p ≤ ↑1, from _))) - (ih hb), + (multiplicity.finite_iff_dom.mpr + (part_enat.dom_of_le_coe (show multiplicity a p ≤ ↑1, from _))) (ih hb), norm_cast, exact (((multiplicity.squarefree_iff_multiplicity_le_one p).mp hp.squarefree a) .resolve_right ha.not_unit) } @@ -167,18 +180,53 @@ end end irreducible +section is_radical + +variables [cancel_comm_monoid_with_zero R] + +theorem is_radical.squarefree {x : R} (h0 : x ≠ 0) (h : is_radical x) : squarefree x := +begin + rintro z ⟨w, rfl⟩, + specialize h 2 (z * w) ⟨w, by simp_rw [pow_two, mul_left_comm, ← mul_assoc]⟩, + rwa [← one_mul (z * w), mul_assoc, mul_dvd_mul_iff_right, ← is_unit_iff_dvd_one] at h, + rw [mul_assoc, mul_ne_zero_iff] at h0, exact h0.2, +end + +variable [gcd_monoid R] + +theorem squarefree.is_radical {x : R} (hx : squarefree x) : is_radical x := +(is_radical_iff_pow_one_lt 2 one_lt_two).2 $ λ y hy, and.right $ (dvd_gcd_iff x x y).1 +begin + by_cases gcd x y = 0, { rw h, apply dvd_zero }, + replace hy := ((dvd_gcd_iff x x _).2 ⟨dvd_rfl, hy⟩).trans gcd_pow_right_dvd_pow_gcd, + obtain ⟨z, hz⟩ := gcd_dvd_left x y, + nth_rewrite 0 hz at hy ⊢, + rw [pow_two, mul_dvd_mul_iff_left h] at hy, + obtain ⟨w, hw⟩ := hy, + exact (hx z ⟨w, by rwa [mul_right_comm, ←hw]⟩).mul_right_dvd.2 dvd_rfl, +end + +theorem is_radical_iff_squarefree_or_zero {x : R} : is_radical x ↔ squarefree x ∨ x = 0 := +⟨λ hx, (em $ x = 0).elim or.inr (λ h, or.inl $ hx.squarefree h), + or.rec squarefree.is_radical $ by { rintro rfl, rw zero_is_radical_iff, apply_instance }⟩ + +theorem is_radical_iff_squarefree_of_ne_zero {x : R} (h : x ≠ 0) : is_radical x ↔ squarefree x := +⟨is_radical.squarefree h, squarefree.is_radical⟩ + +end is_radical + namespace unique_factorization_monoid -variables [cancel_comm_monoid_with_zero R] [nontrivial R] [unique_factorization_monoid R] -variables [normalization_monoid R] +variables [cancel_comm_monoid_with_zero R] [unique_factorization_monoid R] -lemma squarefree_iff_nodup_normalized_factors [decidable_eq R] {x : R} (x0 : x ≠ 0) : - squarefree x ↔ multiset.nodup (normalized_factors x) := +lemma squarefree_iff_nodup_normalized_factors [normalization_monoid R] [decidable_eq R] {x : R} + (x0 : x ≠ 0) : squarefree x ↔ multiset.nodup (normalized_factors x) := begin have drel : decidable_rel (has_dvd.dvd : R → R → Prop), { classical, apply_instance, }, haveI := drel, rw [multiplicity.squarefree_iff_multiplicity_le_one, multiset.nodup_iff_count_le_one], + haveI := nontrivial_of_ne x 0 x0, split; intros h a, { by_cases hmem : a ∈ normalized_factors x, { have ha := irreducible_of_normalized_factor _ hmem, @@ -202,522 +250,19 @@ lemma dvd_pow_iff_dvd_of_squarefree {x y : R} {n : ℕ} (hsq : squarefree x) (h0 x ∣ y ^ n ↔ x ∣ y := begin classical, - by_cases hx : x = 0, - { simp [hx, pow_eq_zero_iff (nat.pos_of_ne_zero h0)] }, - by_cases hy : y = 0, - { simp [hy, zero_pow (nat.pos_of_ne_zero h0)] }, - refine ⟨λ h, _, λ h, h.pow h0⟩, - rw [dvd_iff_normalized_factors_le_normalized_factors hx (pow_ne_zero n hy), - normalized_factors_pow, - ((squarefree_iff_nodup_normalized_factors hx).1 hsq).le_nsmul_iff_le h0] at h, - rwa dvd_iff_normalized_factors_le_normalized_factors hx hy, + haveI := unique_factorization_monoid.to_gcd_monoid R, + exact ⟨hsq.is_radical n y, λ h, h.pow h0⟩, end end unique_factorization_monoid -namespace nat - -lemma squarefree_iff_nodup_factors {n : ℕ} (h0 : n ≠ 0) : - squarefree n ↔ n.factors.nodup := -begin - rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors h0, nat.factors_eq], - simp, -end - -theorem squarefree_iff_prime_squarefree {n : ℕ} : squarefree n ↔ ∀ x, prime x → ¬ x * x ∣ n := -squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible ⟨_, prime_two⟩ - -lemma squarefree.factorization_le_one {n : ℕ} (p : ℕ) (hn : squarefree n) : - n.factorization p ≤ 1 := -begin - rcases eq_or_ne n 0 with rfl | hn', - { simp }, - rw [multiplicity.squarefree_iff_multiplicity_le_one] at hn, - by_cases hp : p.prime, - { have := hn p, - simp only [multiplicity_eq_factorization hp hn', nat.is_unit_iff, hp.ne_one, or_false] at this, - exact_mod_cast this }, - { rw factorization_eq_zero_of_non_prime _ hp, - exact zero_le_one } -end - -lemma squarefree_of_factorization_le_one {n : ℕ} (hn : n ≠ 0) (hn' : ∀ p, n.factorization p ≤ 1) : - squarefree n := -begin - rw [squarefree_iff_nodup_factors hn, list.nodup_iff_count_le_one], - intro a, - rw factors_count_eq, - apply hn', -end - -lemma squarefree_iff_factorization_le_one {n : ℕ} (hn : n ≠ 0) : - squarefree n ↔ ∀ p, n.factorization p ≤ 1 := -⟨λ p hn, squarefree.factorization_le_one hn p, squarefree_of_factorization_le_one hn⟩ - -lemma squarefree.ext_iff {n m : ℕ} (hn : squarefree n) (hm : squarefree m) : - n = m ↔ ∀ p, prime p → (p ∣ n ↔ p ∣ m) := -begin - refine ⟨by { rintro rfl, simp }, λ h, eq_of_factorization_eq hn.ne_zero hm.ne_zero (λ p, _)⟩, - by_cases hp : p.prime, - { have h₁ := h _ hp, - rw [←not_iff_not, hp.dvd_iff_one_le_factorization hn.ne_zero, not_le, lt_one_iff, - hp.dvd_iff_one_le_factorization hm.ne_zero, not_le, lt_one_iff] at h₁, - have h₂ := squarefree.factorization_le_one p hn, - have h₃ := squarefree.factorization_le_one p hm, - rw [nat.le_add_one_iff, le_zero_iff] at h₂ h₃, - cases h₂, - { rwa [h₂, eq_comm, ←h₁] }, - { rw [h₂, h₃.resolve_left], - rw [←h₁, h₂], - simp only [nat.one_ne_zero, not_false_iff] } }, - rw [factorization_eq_zero_of_non_prime _ hp, factorization_eq_zero_of_non_prime _ hp], -end - -lemma squarefree_pow_iff {n k : ℕ} (hn : n ≠ 1) (hk : k ≠ 0) : - squarefree (n ^ k) ↔ squarefree n ∧ k = 1 := -begin - refine ⟨λ h, _, by { rintro ⟨hn, rfl⟩, simpa }⟩, - rcases eq_or_ne n 0 with rfl | hn₀, - { simpa [zero_pow hk.bot_lt] using h }, - refine ⟨squarefree_of_dvd_of_squarefree (dvd_pow_self _ hk) h, by_contradiction $ λ h₁, _⟩, - have : 2 ≤ k := k.two_le_iff.mpr ⟨hk, h₁⟩, - apply hn (nat.is_unit_iff.1 (h _ _)), - rw ←sq, - exact pow_dvd_pow _ this -end - -lemma squarefree_and_prime_pow_iff_prime {n : ℕ} : - squarefree n ∧ is_prime_pow n ↔ prime n := -begin - refine iff.symm ⟨λ hn, ⟨hn.squarefree, hn.is_prime_pow⟩, _⟩, - rw is_prime_pow_nat_iff, - rintro ⟨h, p, k, hp, hk, rfl⟩, - rw squarefree_pow_iff hp.ne_one hk.ne' at h, - rwa [h.2, pow_one], -end - -/-- Assuming that `n` has no factors less than `k`, returns the smallest prime `p` such that - `p^2 ∣ n`. -/ -def min_sq_fac_aux : ℕ → ℕ → option ℕ -| n k := - if h : n < k * k then none else - have nat.sqrt n + 2 - (k + 2) < nat.sqrt n + 2 - k, - by { rw nat.add_sub_add_right, exact nat.min_fac_lemma n k h }, - if k ∣ n then - let n' := n / k in - have nat.sqrt n' + 2 - (k + 2) < nat.sqrt n + 2 - k, from - lt_of_le_of_lt (nat.sub_le_sub_right - (nat.add_le_add_right (nat.sqrt_le_sqrt $ nat.div_le_self _ _) _) _) this, - if k ∣ n' then some k else min_sq_fac_aux n' (k + 2) - else min_sq_fac_aux n (k + 2) -using_well_founded {rel_tac := - λ _ _, `[exact ⟨_, measure_wf (λ ⟨n, k⟩, nat.sqrt n + 2 - k)⟩]} - -/-- Returns the smallest prime factor `p` of `n` such that `p^2 ∣ n`, or `none` if there is no - such `p` (that is, `n` is squarefree). See also `squarefree_iff_min_sq_fac`. -/ -def min_sq_fac (n : ℕ) : option ℕ := -if 2 ∣ n then - let n' := n / 2 in - if 2 ∣ n' then some 2 else min_sq_fac_aux n' 3 -else min_sq_fac_aux n 3 - -/-- The correctness property of the return value of `min_sq_fac`. - * If `none`, then `n` is squarefree; - * If `some d`, then `d` is a minimal square factor of `n` -/ -def min_sq_fac_prop (n : ℕ) : option ℕ → Prop -| none := squarefree n -| (some d) := prime d ∧ d * d ∣ n ∧ ∀ p, prime p → p * p ∣ n → d ≤ p - -theorem min_sq_fac_prop_div (n) {k} (pk : prime k) (dk : k ∣ n) (dkk : ¬ k * k ∣ n) - {o} (H : min_sq_fac_prop (n / k) o) : min_sq_fac_prop n o := -begin - have : ∀ p, prime p → p*p ∣ n → k*(p*p) ∣ n := λ p pp dp, - have _ := (coprime_primes pk pp).2 (λ e, by { subst e, contradiction }), - (coprime_mul_iff_right.2 ⟨this, this⟩).mul_dvd_of_dvd_of_dvd dk dp, - cases o with d, - { rw [min_sq_fac_prop, squarefree_iff_prime_squarefree] at H ⊢, - exact λ p pp dp, H p pp ((dvd_div_iff dk).2 (this _ pp dp)) }, - { obtain ⟨H1, H2, H3⟩ := H, - simp only [dvd_div_iff dk] at H2 H3, - exact ⟨H1, dvd_trans (dvd_mul_left _ _) H2, λ p pp dp, H3 _ pp (this _ pp dp)⟩ } -end - -theorem min_sq_fac_aux_has_prop : ∀ {n : ℕ} k, 0 < n → ∀ i, k = 2*i+3 → - (∀ m, prime m → m ∣ n → k ≤ m) → min_sq_fac_prop n (min_sq_fac_aux n k) -| n k := λ n0 i e ih, begin - rw min_sq_fac_aux, - by_cases h : n < k*k; simp [h], - { refine squarefree_iff_prime_squarefree.2 (λ p pp d, _), - have := ih p pp (dvd_trans ⟨_, rfl⟩ d), - have := nat.mul_le_mul this this, - exact not_le_of_lt h (le_trans this (le_of_dvd n0 d)) }, - have k2 : 2 ≤ k, { subst e, exact dec_trivial }, - have k0 : 0 < k := lt_of_lt_of_le dec_trivial k2, - have IH : ∀ n', n' ∣ n → ¬ k ∣ n' → min_sq_fac_prop n' (n'.min_sq_fac_aux (k + 2)), - { intros n' nd' nk, - have hn' := le_of_dvd n0 nd', - refine - have nat.sqrt n' - k < nat.sqrt n + 2 - k, from - lt_of_le_of_lt (nat.sub_le_sub_right (nat.sqrt_le_sqrt hn') _) (nat.min_fac_lemma n k h), - @min_sq_fac_aux_has_prop n' (k+2) (pos_of_dvd_of_pos nd' n0) - (i+1) (by simp [e, left_distrib]) (λ m m2 d, _), - cases nat.eq_or_lt_of_le (ih m m2 (dvd_trans d nd')) with me ml, - { subst me, contradiction }, - apply (nat.eq_or_lt_of_le ml).resolve_left, intro me, - rw [← me, e] at d, change 2 * (i + 2) ∣ n' at d, - have := ih _ prime_two (dvd_trans (dvd_of_mul_right_dvd d) nd'), - rw e at this, exact absurd this dec_trivial }, - have pk : k ∣ n → prime k, - { refine λ dk, prime_def_min_fac.2 ⟨k2, le_antisymm (min_fac_le k0) _⟩, - exact ih _ (min_fac_prime (ne_of_gt k2)) (dvd_trans (min_fac_dvd _) dk) }, - split_ifs with dk dkk, - { exact ⟨pk dk, (nat.dvd_div_iff dk).1 dkk, λ p pp d, ih p pp (dvd_trans ⟨_, rfl⟩ d)⟩ }, - { specialize IH (n/k) (div_dvd_of_dvd dk) dkk, - exact min_sq_fac_prop_div _ (pk dk) dk (mt (nat.dvd_div_iff dk).2 dkk) IH }, - { exact IH n (dvd_refl _) dk } -end -using_well_founded {rel_tac := - λ _ _, `[exact ⟨_, measure_wf (λ ⟨n, k⟩, nat.sqrt n + 2 - k)⟩]} - -theorem min_sq_fac_has_prop (n : ℕ) : min_sq_fac_prop n (min_sq_fac n) := -begin - dunfold min_sq_fac, split_ifs with d2 d4, - { exact ⟨prime_two, (dvd_div_iff d2).1 d4, λ p pp _, pp.two_le⟩ }, - { cases nat.eq_zero_or_pos n with n0 n0, { subst n0, cases d4 dec_trivial }, - refine min_sq_fac_prop_div _ prime_two d2 (mt (dvd_div_iff d2).2 d4) _, - refine min_sq_fac_aux_has_prop 3 (nat.div_pos (le_of_dvd n0 d2) dec_trivial) 0 rfl _, - refine λ p pp dp, succ_le_of_lt (lt_of_le_of_ne pp.two_le _), - rintro rfl, contradiction }, - { cases nat.eq_zero_or_pos n with n0 n0, { subst n0, cases d2 dec_trivial }, - refine min_sq_fac_aux_has_prop _ n0 0 rfl _, - refine λ p pp dp, succ_le_of_lt (lt_of_le_of_ne pp.two_le _), - rintro rfl, contradiction }, -end - -theorem min_sq_fac_prime {n d : ℕ} (h : n.min_sq_fac = some d) : prime d := -by { have := min_sq_fac_has_prop n, rw h at this, exact this.1 } - -theorem min_sq_fac_dvd {n d : ℕ} (h : n.min_sq_fac = some d) : d * d ∣ n := -by { have := min_sq_fac_has_prop n, rw h at this, exact this.2.1 } +namespace int -theorem min_sq_fac_le_of_dvd {n d : ℕ} (h : n.min_sq_fac = some d) - {m} (m2 : 2 ≤ m) (md : m * m ∣ n) : d ≤ m := -begin - have := min_sq_fac_has_prop n, rw h at this, - have fd := min_fac_dvd m, - exact le_trans - (this.2.2 _ (min_fac_prime $ ne_of_gt m2) (dvd_trans (mul_dvd_mul fd fd) md)) - (min_fac_le $ lt_of_lt_of_le dec_trivial m2), -end - -lemma squarefree_iff_min_sq_fac {n : ℕ} : - squarefree n ↔ n.min_sq_fac = none := -begin - have := min_sq_fac_has_prop n, - split; intro H, - { cases n.min_sq_fac with d, {refl}, - cases squarefree_iff_prime_squarefree.1 H _ this.1 this.2.1 }, - { rwa H at this } -end - -instance : decidable_pred (squarefree : ℕ → Prop) := -λ n, decidable_of_iff' _ squarefree_iff_min_sq_fac - -theorem squarefree_two : squarefree 2 := by rw squarefree_iff_nodup_factors; norm_num - -open unique_factorization_monoid - -lemma divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) : - (n.divisors.filter squarefree).val = - (unique_factorization_monoid.normalized_factors n).to_finset.powerset.val.map - (λ x, x.val.prod) := -begin - rw (finset.nodup _).ext ((finset.nodup _).map_on _), - { intro a, - simp only [multiset.mem_filter, id.def, multiset.mem_map, finset.filter_val, ← finset.mem_def, - mem_divisors], - split, - { rintro ⟨⟨an, h0⟩, hsq⟩, - use (unique_factorization_monoid.normalized_factors a).to_finset, - simp only [id.def, finset.mem_powerset], - rcases an with ⟨b, rfl⟩, - rw mul_ne_zero_iff at h0, - rw unique_factorization_monoid.squarefree_iff_nodup_normalized_factors h0.1 at hsq, - rw [multiset.to_finset_subset, multiset.to_finset_val, hsq.dedup, ← associated_iff_eq, - normalized_factors_mul h0.1 h0.2], - exact ⟨multiset.subset_of_le (multiset.le_add_right _ _), normalized_factors_prod h0.1⟩ }, - { rintro ⟨s, hs, rfl⟩, - rw [finset.mem_powerset, ← finset.val_le_iff, multiset.to_finset_val] at hs, - have hs0 : s.val.prod ≠ 0, - { rw [ne.def, multiset.prod_eq_zero_iff], - simp only [exists_prop, id.def, exists_eq_right], - intro con, - apply not_irreducible_zero (irreducible_of_normalized_factor 0 - (multiset.mem_dedup.1 (multiset.mem_of_le hs con))) }, - rw (normalized_factors_prod h0).symm.dvd_iff_dvd_right, - refine ⟨⟨multiset.prod_dvd_prod_of_le (le_trans hs (multiset.dedup_le _)), h0⟩, _⟩, - have h := unique_factorization_monoid.factors_unique irreducible_of_normalized_factor - (λ x hx, irreducible_of_normalized_factor x (multiset.mem_of_le - (le_trans hs (multiset.dedup_le _)) hx)) (normalized_factors_prod hs0), - rw [associated_eq_eq, multiset.rel_eq] at h, - rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors hs0, h], - apply s.nodup } }, - { intros x hx y hy h, - rw [← finset.val_inj, ← multiset.rel_eq, ← associated_eq_eq], - rw [← finset.mem_def, finset.mem_powerset] at hx hy, - apply unique_factorization_monoid.factors_unique _ _ (associated_iff_eq.2 h), - { intros z hz, - apply irreducible_of_normalized_factor z, - rw ← multiset.mem_to_finset, - apply hx hz }, - { intros z hz, - apply irreducible_of_normalized_factor z, - rw ← multiset.mem_to_finset, - apply hy hz } } -end - -open_locale big_operators - -lemma sum_divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) - {α : Type*} [add_comm_monoid α] {f : ℕ → α} : - ∑ i in (n.divisors.filter squarefree), f i = - ∑ i in (unique_factorization_monoid.normalized_factors n).to_finset.powerset, f (i.val.prod) := -by rw [finset.sum_eq_multiset_sum, divisors_filter_squarefree h0, multiset.map_map, - finset.sum_eq_multiset_sum] - -lemma sq_mul_squarefree_of_pos {n : ℕ} (hn : 0 < n) : - ∃ a b : ℕ, 0 < a ∧ 0 < b ∧ b ^ 2 * a = n ∧ squarefree a := -begin - let S := {s ∈ finset.range (n + 1) | s ∣ n ∧ ∃ x, s = x ^ 2}, - have hSne : S.nonempty, - { use 1, - have h1 : 0 < n ∧ ∃ (x : ℕ), 1 = x ^ 2 := ⟨hn, ⟨1, (one_pow 2).symm⟩⟩, - simpa [S] }, - let s := finset.max' S hSne, - have hs : s ∈ S := finset.max'_mem S hSne, - simp only [finset.sep_def, S, finset.mem_filter, finset.mem_range] at hs, - obtain ⟨hsn1, ⟨a, hsa⟩, ⟨b, hsb⟩⟩ := hs, - rw hsa at hn, - obtain ⟨hlts, hlta⟩ := canonically_ordered_comm_semiring.mul_pos.mp hn, - rw hsb at hsa hn hlts, - refine ⟨a, b, hlta, (pow_pos_iff zero_lt_two).mp hlts, hsa.symm, _⟩, - rintro x ⟨y, hy⟩, - rw nat.is_unit_iff, - by_contra hx, - refine lt_le_antisymm _ (finset.le_max' S ((b * x) ^ 2) _), - { simp_rw [S, hsa, finset.sep_def, finset.mem_filter, finset.mem_range], - refine ⟨lt_succ_iff.mpr (le_of_dvd hn _), _, ⟨b * x, rfl⟩⟩; use y; rw hy; ring }, - { convert lt_mul_of_one_lt_right hlts - (one_lt_pow 2 x zero_lt_two (one_lt_iff_ne_zero_and_ne_one.mpr ⟨λ h, by simp * at *, hx⟩)), - rw mul_pow }, -end - -lemma sq_mul_squarefree_of_pos' {n : ℕ} (h : 0 < n) : - ∃ a b : ℕ, (b + 1) ^ 2 * (a + 1) = n ∧ squarefree (a + 1) := -begin - obtain ⟨a₁, b₁, ha₁, hb₁, hab₁, hab₂⟩ := sq_mul_squarefree_of_pos h, - refine ⟨a₁.pred, b₁.pred, _, _⟩; - simpa only [add_one, succ_pred_eq_of_pos, ha₁, hb₁], -end - -lemma sq_mul_squarefree (n : ℕ) : ∃ a b : ℕ, b ^ 2 * a = n ∧ squarefree a := -begin - cases n, - { exact ⟨1, 0, (by simp), squarefree_one⟩ }, - { obtain ⟨a, b, -, -, h₁, h₂⟩ := sq_mul_squarefree_of_pos (succ_pos n), - exact ⟨a, b, h₁, h₂⟩ }, -end - -/-- `squarefree` is multiplicative. Note that the → direction does not require `hmn` -and generalizes to arbitrary commutative monoids. See `squarefree.of_mul_left` and -`squarefree.of_mul_right` above for auxiliary lemmas. -/ -lemma squarefree_mul {m n : ℕ} (hmn : m.coprime n) : - squarefree (m * n) ↔ squarefree m ∧ squarefree n := -begin - simp only [squarefree_iff_prime_squarefree, ←sq, ←forall_and_distrib], - refine ball_congr (λ p hp, _), - simp only [hmn.is_prime_pow_dvd_mul (hp.is_prime_pow.pow two_ne_zero), not_or_distrib], -end +@[simp] lemma squarefree_nat_abs {n : ℤ} : squarefree n.nat_abs ↔ squarefree n := +by simp_rw [squarefree, nat_abs_surjective.forall, ←nat_abs_mul, nat_abs_dvd_iff_dvd, + is_unit_iff_nat_abs_eq, nat.is_unit_iff] -end nat - -/-! ### Square-free prover -/ - -open norm_num - -namespace tactic -namespace norm_num - -/-- A predicate representing partial progress in a proof of `squarefree`. -/ -def squarefree_helper (n k : ℕ) : Prop := -0 < k → (∀ m, nat.prime m → m ∣ bit1 n → bit1 k ≤ m) → squarefree (bit1 n) - -lemma squarefree_bit10 (n : ℕ) (h : squarefree_helper n 1) : - squarefree (bit0 (bit1 n)) := -begin - refine @nat.min_sq_fac_prop_div _ _ nat.prime_two two_dvd_bit0 _ none _, - { rw [bit0_eq_two_mul (bit1 n), mul_dvd_mul_iff_left (@two_ne_zero ℕ _ _)], - exact nat.not_two_dvd_bit1 _ }, - { rw [bit0_eq_two_mul, nat.mul_div_right _ (dec_trivial:0<2)], - refine h dec_trivial (λ p pp dp, nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)), - rintro rfl, exact nat.not_two_dvd_bit1 _ dp } -end - -lemma squarefree_bit1 (n : ℕ) (h : squarefree_helper n 1) : - squarefree (bit1 n) := -begin - refine h dec_trivial (λ p pp dp, nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)), - rintro rfl, exact nat.not_two_dvd_bit1 _ dp -end - -lemma squarefree_helper_0 {k} (k0 : 0 < k) - {p : ℕ} (pp : nat.prime p) (h : bit1 k ≤ p) : bit1 (k + 1) ≤ p ∨ bit1 k = p := -begin - rcases lt_or_eq_of_le h with (hp:_+1≤_) | hp, - { rw [bit1, bit0_eq_two_mul] at hp, change 2*(_+1) ≤ _ at hp, - rw [bit1, bit0_eq_two_mul], - refine or.inl (lt_of_le_of_ne hp _), unfreezingI { rintro rfl }, - exact nat.not_prime_mul dec_trivial (lt_add_of_pos_left _ k0) pp }, - { exact or.inr hp } -end - -lemma squarefree_helper_1 (n k k' : ℕ) (e : k + 1 = k') - (hk : nat.prime (bit1 k) → ¬ bit1 k ∣ bit1 n) - (H : squarefree_helper n k') : squarefree_helper n k := -λ k0 ih, begin - subst e, - refine H (nat.succ_pos _) (λ p pp dp, _), - refine (squarefree_helper_0 k0 pp (ih p pp dp)).resolve_right (λ hp, _), - subst hp, cases hk pp dp -end - -lemma squarefree_helper_2 (n k k' c : ℕ) (e : k + 1 = k') - (hc : bit1 n % bit1 k = c) (c0 : 0 < c) - (h : squarefree_helper n k') : squarefree_helper n k := -begin - refine squarefree_helper_1 _ _ _ e (λ _, _) h, - refine mt _ (ne_of_gt c0), intro e₁, - rwa [← hc, ← nat.dvd_iff_mod_eq_zero], -end - -lemma squarefree_helper_3 (n n' k k' c : ℕ) (e : k + 1 = k') - (hn' : bit1 n' * bit1 k = bit1 n) - (hc : bit1 n' % bit1 k = c) (c0 : 0 < c) - (H : squarefree_helper n' k') : squarefree_helper n k := -λ k0 ih, begin - subst e, - have k0' : 0 < bit1 k := bit1_pos (nat.zero_le _), - have dn' : bit1 n' ∣ bit1 n := ⟨_, hn'.symm⟩, - have dk : bit1 k ∣ bit1 n := ⟨_, ((mul_comm _ _).trans hn').symm⟩, - have : bit1 n / bit1 k = bit1 n', - { rw [← hn', nat.mul_div_cancel _ k0'] }, - have k2 : 2 ≤ bit1 k := nat.succ_le_succ (bit0_pos k0), - have pk : (bit1 k).prime, - { refine nat.prime_def_min_fac.2 ⟨k2, le_antisymm (nat.min_fac_le k0') _⟩, - exact ih _ (nat.min_fac_prime (ne_of_gt k2)) (dvd_trans (nat.min_fac_dvd _) dk) }, - have dkk' : ¬ bit1 k ∣ bit1 n', {rw [nat.dvd_iff_mod_eq_zero, hc], exact ne_of_gt c0}, - have dkk : ¬ bit1 k * bit1 k ∣ bit1 n, {rwa [← nat.dvd_div_iff dk, this]}, - refine @nat.min_sq_fac_prop_div _ _ pk dk dkk none _, - rw this, refine H (nat.succ_pos _) (λ p pp dp, _), - refine (squarefree_helper_0 k0 pp (ih p pp $ dvd_trans dp dn')).resolve_right (λ e, _), - subst e, contradiction -end - -lemma squarefree_helper_4 (n k k' : ℕ) (e : bit1 k * bit1 k = k') - (hd : bit1 n < k') : squarefree_helper n k := -begin - cases nat.eq_zero_or_pos n with h h, - { subst n, exact λ _ _, squarefree_one }, - subst e, - refine λ k0 ih, irreducible.squarefree (nat.prime_def_le_sqrt.2 ⟨bit1_lt_bit1.2 h, _⟩), - intros m m2 hm md, - obtain ⟨p, pp, hp⟩ := nat.exists_prime_and_dvd (ne_of_gt m2), - have := (ih p pp (dvd_trans hp md)).trans - (le_trans (nat.le_of_dvd (lt_of_lt_of_le dec_trivial m2) hp) hm), - rw nat.le_sqrt at this, - exact not_le_of_lt hd this -end - -lemma not_squarefree_mul (a aa b n : ℕ) (ha : a * a = aa) (hb : aa * b = n) - (h₁ : 1 < a) : ¬ squarefree n := -by { rw [← hb, ← ha], exact λ H, ne_of_gt h₁ (nat.is_unit_iff.1 $ H _ ⟨_, rfl⟩) } - -/-- Given `e` a natural numeral and `a : nat` with `a^2 ∣ n`, return `⊢ ¬ squarefree e`. -/ -meta def prove_non_squarefree (e : expr) (n a : ℕ) : tactic expr := do - let ea := reflect a, - let eaa := reflect (a*a), - c ← mk_instance_cache `(nat), - (c, p₁) ← prove_lt_nat c `(1) ea, - let b := n / (a*a), let eb := reflect b, - (c, eaa, pa) ← prove_mul_nat c ea ea, - (c, e', pb) ← prove_mul_nat c eaa eb, - guard (e' =ₐ e), - return $ `(@not_squarefree_mul).mk_app [ea, eaa, eb, e, pa, pb, p₁] - -/-- Given `en`,`en1 := bit1 en`, `n1` the value of `en1`, `ek`, - returns `⊢ squarefree_helper en ek`. -/ -meta def prove_squarefree_aux : ∀ (ic : instance_cache) (en en1 : expr) (n1 : ℕ) - (ek : expr) (k : ℕ), tactic expr -| ic en en1 n1 ek k := do - let k1 := bit1 k, - let ek1 := `(bit1:ℕ→ℕ).mk_app [ek], - if n1 < k1*k1 then do - (ic, ek', p₁) ← prove_mul_nat ic ek1 ek1, - (ic, p₂) ← prove_lt_nat ic en1 ek', - pure $ `(squarefree_helper_4).mk_app [en, ek, ek', p₁, p₂] - else do - let c := n1 % k1, - let k' := k+1, let ek' := reflect k', - (ic, p₁) ← prove_succ ic ek ek', - if c = 0 then do - let n1' := n1 / k1, - let n' := n1' / 2, let en' := reflect n', - let en1' := `(bit1:ℕ→ℕ).mk_app [en'], - (ic, _, pn') ← prove_mul_nat ic en1' ek1, - let c := n1' % k1, - guard (c ≠ 0), - (ic, ec, pc) ← prove_div_mod ic en1' ek1 tt, - (ic, p₀) ← prove_pos ic ec, - p₂ ← prove_squarefree_aux ic en' en1' n1' ek' k', - pure $ `(squarefree_helper_3).mk_app [en, en', ek, ek', ec, p₁, pn', pc, p₀, p₂] - else do - (ic, ec, pc) ← prove_div_mod ic en1 ek1 tt, - (ic, p₀) ← prove_pos ic ec, - p₂ ← prove_squarefree_aux ic en en1 n1 ek' k', - pure $ `(squarefree_helper_2).mk_app [en, ek, ek', ec, p₁, pc, p₀, p₂] - -/-- Given `n > 0` a squarefree natural numeral, returns `⊢ squarefree n`. -/ -meta def prove_squarefree (en : expr) (n : ℕ) : tactic expr := -match match_numeral en with -| match_numeral_result.one := pure `(@squarefree_one ℕ _) -| match_numeral_result.bit0 en1 := match match_numeral en1 with - | match_numeral_result.one := pure `(nat.squarefree_two) - | match_numeral_result.bit1 en := do - ic ← mk_instance_cache `(ℕ), - p ← prove_squarefree_aux ic en en1 (n / 2) `(1:ℕ) 1, - pure $ `(squarefree_bit10).mk_app [en, p] - | _ := failed - end -| match_numeral_result.bit1 en' := do - ic ← mk_instance_cache `(ℕ), - p ← prove_squarefree_aux ic en' en n `(1:ℕ) 1, - pure $ `(squarefree_bit1).mk_app [en', p] -| _ := failed -end +@[simp] lemma squarefree_coe_nat {n : ℕ} : squarefree (n : ℤ) ↔ squarefree n := +by rw [←squarefree_nat_abs, nat_abs_of_nat] -/-- Evaluates the `prime` and `min_fac` functions. -/ -@[norm_num] meta def eval_squarefree : expr → tactic (expr × expr) -| `(squarefree (%%e : ℕ)) := do - n ← e.to_nat, - match n with - | 0 := false_intro `(@not_squarefree_zero ℕ _ _) - | 1 := true_intro `(@squarefree_one ℕ _) - | _ := match n.min_sq_fac with - | some d := prove_non_squarefree e n d >>= false_intro - | none := prove_squarefree e n >>= true_intro - end - end -| _ := failed - -end norm_num -end tactic +end int diff --git a/src/algebra/star/basic.lean b/src/algebra/star/basic.lean index 0b2482caa8732..04fb6397d361f 100644 --- a/src/algebra/star/basic.lean +++ b/src/algebra/star/basic.lean @@ -3,17 +3,18 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import tactic.apply_fun -import algebra.field.opposite -import algebra.field_power import algebra.ring.aut -import group_theory.group_action.units -import group_theory.group_action.opposite import algebra.ring.comp_typeclasses +import data.rat.cast +import group_theory.group_action.opposite +import data.set_like.basic /-! # Star monoids, rings, and modules +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the basic algebraic notions of star monoids, star rings, and star modules. A star algebra is simply a star ring that is also a star module. @@ -21,25 +22,16 @@ These are implemented as "mixin" typeclasses, so to summon a star ring (for exam one needs to write `(R : Type) [ring R] [star_ring R]`. This avoids difficulties with diamond inheritance. -We also define the class `star_ordered_ring R`, which says that the order on `R` respects the -star operation, i.e. an element `r` is nonnegative iff there exists an `s` such that -`r = star s * s`. - For now we simply do not introduce notations, as different users are expected to feel strongly about the relative merits of `r^*`, `r†`, `rᘁ`, and so on. Our star rings are actually star semirings, but of course we can prove `star_neg : star (-r) = - star r` when the underlying semiring is a ring. - -## TODO - -* In a Banach star algebra without a well-defined square root, the natural ordering is given by the -positive cone which is the closure of the sums of elements `star r * r`. A weaker version of -`star_ordered_ring` could be defined for this case. Note that the current definition has the -advantage of not requiring a topology. -/ +assert_not_exists finset +assert_not_exists subgroup universes u v @@ -60,6 +52,22 @@ A star operation (e.g. complex conjugate). -/ add_decl_doc star +/-- `star_mem_class S G` states `S` is a type of subsets `s ⊆ G` closed under star. -/ +class star_mem_class (S R : Type*) [has_star R] [set_like S R] := +(star_mem : ∀ {s : S} {r : R}, r ∈ s → star r ∈ s) + +export star_mem_class (star_mem) + +namespace star_mem_class + +variables {S : Type u} [has_star R] [set_like S R] [hS : star_mem_class S R] (s : S) +include hS + +instance : has_star s := +{ star := λ r, ⟨star (r : R), star_mem r.prop⟩ } + +end star_mem_class + /-- Typeclass for a star operation with is involutive. @@ -75,6 +83,9 @@ star_involutive _ lemma star_injective [has_involutive_star R] : function.injective (star : R → R) := star_involutive.injective +@[simp] lemma star_inj [has_involutive_star R] {x y : R} : star x = star y ↔ x = y := +star_injective.eq_iff + /-- `star` as an equivalence when it is involutive. -/ protected def equiv.star [has_involutive_star R] : equiv.perm R := star_involutive.to_perm _ @@ -107,6 +118,29 @@ class star_semigroup (R : Type u) [semigroup R] extends has_involutive_star R := export star_semigroup (star_mul) attribute [simp] star_mul +section star_semigroup +variables [semigroup R] [star_semigroup R] + +lemma star_star_mul (x y : R) : star (star x * y) = star y * x := by rw [star_mul, star_star] + +lemma star_mul_star (x y : R) : star (x * star y) = y * star x := by rw [star_mul, star_star] + +@[simp] lemma semiconj_by_star_star_star {x y z : R} : + semiconj_by (star x) (star z) (star y) ↔ semiconj_by x y z := +by simp_rw [semiconj_by, ←star_mul, star_inj, eq_comm] + +alias semiconj_by_star_star_star ↔ _ semiconj_by.star_star_star + +@[simp] lemma commute_star_star {x y : R} : commute (star x) (star y) ↔ commute x y := +semiconj_by_star_star_star + +alias commute_star_star ↔ _ commute.star_star + +lemma commute_star_comm {x y : R} : commute (star x) y ↔ commute x (star y) := +by rw [←commute_star_star, star_star] + +end star_semigroup + /-- In a commutative ring, make `simp` prefer leaving the order unchanged. -/ @[simp] lemma star_mul' [comm_semigroup R] [star_semigroup R] (x y : R) : star (x * y) = star x * star y := @@ -148,17 +182,7 @@ op_injective $ /-- When multiplication is commutative, `star` preserves division. -/ @[simp] lemma star_div [comm_group R] [star_semigroup R] (x y : R) : star (x / y) = star x / star y := -(star_mul_aut : R ≃* R).to_monoid_hom.map_div _ _ - -section -open_locale big_operators - -@[simp] lemma star_prod [comm_monoid R] [star_semigroup R] {α : Type*} - (s : finset α) (f : α → R): - star (∏ x in s, f x) = ∏ x in s, star (f x) := -(star_mul_aut : R ≃* R).map_prod _ _ - -end +map_div (star_mul_aut : R ≃* R) _ _ /-- Any commutative monoid admits the trivial `*`-structure. @@ -174,7 +198,7 @@ def star_semigroup_of_comm {R : Type*} [comm_monoid R] : star_semigroup R := section local attribute [instance] star_semigroup_of_comm -/-- Note that since `star_semigroup_of_comm` is reducible, `simp` can already prove this. --/ +/-- Note that since `star_semigroup_of_comm` is reducible, `simp` can already prove this. -/ lemma star_id_of_comm {R : Type*} [comm_semiring R] {x : R} : star x = x := rfl end @@ -225,16 +249,6 @@ star_eq_zero.not star (n • x) = n • star x := (star_add_equiv : R ≃+ R).to_add_monoid_hom.map_zsmul _ _ -section -open_locale big_operators - -@[simp] lemma star_sum [add_comm_monoid R] [star_add_monoid R] {α : Type*} - (s : finset α) (f : α → R): - star (∑ x in s, f x) = ∑ x in s, star (f x) := -(star_add_equiv : R ≃+ R).map_sum _ _ - -end - /-- A `*`-ring `R` is a (semi)ring with an involutive `star` operation which is additive which makes `R` with its multiplicative structure into a `*`-semigroup @@ -260,9 +274,9 @@ def star_ring_equiv [non_unital_semiring R] [star_ring R] : R ≃+* Rᵐᵒᵖ : @[simp, norm_cast] lemma star_int_cast [ring R] [star_ring R] (z : ℤ) : star (z : R) = z := -(congr_arg unop ((star_ring_equiv : R ≃+* Rᵐᵒᵖ).to_ring_hom.map_int_cast z)).trans (unop_int_cast _) +(congr_arg unop $ map_int_cast (star_ring_equiv : R ≃+* Rᵐᵒᵖ) z).trans (unop_int_cast _) -@[simp, norm_cast] lemma star_rat_cast [division_ring R] [char_zero R] [star_ring R] (r : ℚ) : +@[simp, norm_cast] lemma star_rat_cast [division_ring R] [star_ring R] (r : ℚ) : star (r : R) = r := (congr_arg unop $ map_rat_cast (star_ring_equiv : R ≃+* Rᵐᵒᵖ) r).trans (unop_rat_cast _) @@ -284,7 +298,7 @@ case for `(↑star_ring_aut : R →* R)`. -/ def star_ring_end [comm_semiring R] [star_ring R] : R →+* R := @star_ring_aut R _ _ variables {R} -localized "notation `conj` := star_ring_end _" in complex_conjugate +localized "notation (name := star_ring_end) `conj` := star_ring_end hole!" in complex_conjugate /-- This is not a simp lemma, since we usually want simp to keep `star_ring_end` bundled. For example, for complex conjugation, we don't want simp to turn `conj x` @@ -295,22 +309,32 @@ lemma star_ring_end_apply [comm_semiring R] [star_ring R] {x : R} : @[simp] lemma star_ring_end_self_apply [comm_semiring R] [star_ring R] (x : R) : star_ring_end R (star_ring_end R x) = x := star_star x +instance ring_hom.has_involutive_star {S : Type*} [non_assoc_semiring S] [comm_semiring R] + [star_ring R] : has_involutive_star (S →+* R) := +{ to_has_star := { star := λ f, ring_hom.comp (star_ring_end R) f }, + star_involutive := + by { intro _, ext, simp only [ring_hom.coe_comp, function.comp_app, star_ring_end_self_apply] }} + +lemma ring_hom.star_def {S : Type*} [non_assoc_semiring S] [comm_semiring R] [star_ring R] + (f : S →+* R) : has_star.star f = ring_hom.comp (star_ring_end R) f := rfl + +lemma ring_hom.star_apply {S : Type*} [non_assoc_semiring S] [comm_semiring R] [star_ring R] + (f : S →+* R) (s : S) : star f s = star (f s) := rfl + -- A more convenient name for complex conjugation alias star_ring_end_self_apply ← complex.conj_conj alias star_ring_end_self_apply ← is_R_or_C.conj_conj -@[simp] lemma star_inv' [division_ring R] [star_ring R] (x : R) : star (x⁻¹) = (star x)⁻¹ := -op_injective $ - ((star_ring_equiv : R ≃+* Rᵐᵒᵖ).to_ring_hom.map_inv x).trans (op_inv (star x)).symm +@[simp] lemma star_inv' [division_semiring R] [star_ring R] (x : R) : star (x⁻¹) = (star x)⁻¹ := +op_injective $ (map_inv₀ (star_ring_equiv : R ≃+* Rᵐᵒᵖ) x).trans (op_inv (star x)).symm -@[simp] lemma star_zpow₀ [division_ring R] [star_ring R] (x : R) (z : ℤ) : +@[simp] lemma star_zpow₀ [division_semiring R] [star_ring R] (x : R) (z : ℤ) : star (x ^ z) = star x ^ z := -op_injective $ - ((star_ring_equiv : R ≃+* Rᵐᵒᵖ).to_ring_hom.map_zpow x z).trans (op_zpow (star x) z).symm +op_injective $ (map_zpow₀ (star_ring_equiv : R ≃+* Rᵐᵒᵖ) x z).trans (op_zpow (star x) z).symm /-- When multiplication is commutative, `star` preserves division. -/ -@[simp] lemma star_div' [field R] [star_ring R] (x y : R) : star (x / y) = star x / star y := -(star_ring_end R).map_div _ _ +@[simp] lemma star_div' [semifield R] [star_ring R] (x y : R) : star (x / y) = star x / star y := +map_div₀ (star_ring_end R) _ _ @[simp] lemma star_bit0 [add_monoid R] [star_add_monoid R] (r : R) : star (bit0 r) = bit0 (star r) := @@ -330,35 +354,6 @@ def star_ring_of_comm {R : Type*} [comm_semiring R] : star_ring R := star_add := λ x y, rfl, ..star_semigroup_of_comm } -/-- -An ordered `*`-ring is a ring which is both an `ordered_add_comm_group` and a `*`-ring, -and `0 ≤ r ↔ ∃ s, r = star s * s`. --/ -class star_ordered_ring (R : Type u) [non_unital_semiring R] [partial_order R] - extends star_ring R := -(add_le_add_left : ∀ a b : R, a ≤ b → ∀ c : R, c + a ≤ c + b) -(nonneg_iff : ∀ r : R, 0 ≤ r ↔ ∃ s, r = star s * s) - -namespace star_ordered_ring - -variables [ring R] [partial_order R] [star_ordered_ring R] - -@[priority 100] -- see note [lower instance priority] -instance : ordered_add_comm_group R := -{ ..show ring R, by apply_instance, - ..show partial_order R, by apply_instance, - ..show star_ordered_ring R, by apply_instance } - -end star_ordered_ring - -lemma star_mul_self_nonneg - [non_unital_semiring R] [partial_order R] [star_ordered_ring R] {r : R} : 0 ≤ star r * r := -(star_ordered_ring.nonneg_iff _).mpr ⟨r, rfl⟩ - -lemma star_mul_self_nonneg' - [non_unital_semiring R] [partial_order R] [star_ordered_ring R] {r : R} : 0 ≤ r * star r := -by { nth_rewrite_rhs 0 [←star_star r], exact star_mul_self_nonneg } - /-- A star module `A` over a star ring `R` is a module which is a star add monoid, and the two star structures are compatible in the sense @@ -366,12 +361,12 @@ and the two star structures are compatible in the sense Note that it is up to the user of this typeclass to enforce `[semiring R] [star_ring R] [add_comm_monoid A] [star_add_monoid A] [module R A]`, and that -the statement only requires `[has_star R] [has_star A] [has_scalar R A]`. +the statement only requires `[has_star R] [has_star A] [has_smul R A]`. If used as `[comm_ring R] [star_ring R] [semiring A] [star_ring A] [algebra R A]`, this represents a star algebra. -/ -class star_module (R : Type u) (A : Type v) [has_star R] [has_star A] [has_scalar R A] : Prop := +class star_module (R : Type u) (A : Type v) [has_star R] [has_star A] [has_smul R A] : Prop := (star_smul : ∀ (r : R) (a : A), star (r • a) = star r • star a) export star_module (star_smul) @@ -391,6 +386,18 @@ instance [comm_semiring R] [star_ring R] : end ring_hom_inv_pair +section +set_option old_structure_cmd true + +/-- `star_hom_class F R S` states that `F` is a type of `star`-preserving maps from `R` to `S`. -/ +class star_hom_class (F : Type*) (R S : out_param Type*) [has_star R] [has_star S] + extends fun_like F R (λ _, S) := +(map_star : ∀ (f : F) (r : R), f (star r) = star (f r)) + +export star_hom_class (map_star) + +end + /-! ### Instances -/ namespace units @@ -409,7 +416,7 @@ instance : star_semigroup Rˣ := @[simp] lemma coe_star (u : Rˣ) : ↑(star u) = (star ↑u : R) := rfl @[simp] lemma coe_star_inv (u : Rˣ) : ↑(star u)⁻¹ = (star ↑u⁻¹ : R) := rfl -instance {A : Type*} [has_star A] [has_scalar R A] [star_module R A] : star_module Rˣ A := +instance {A : Type*} [has_star A] [has_smul R A] [star_module R A] : star_module Rˣ A := ⟨λ u a, (star_smul ↑u a : _)⟩ end units diff --git a/src/algebra/star/big_operators.lean b/src/algebra/star/big_operators.lean new file mode 100644 index 0000000000000..fd310750c5eae --- /dev/null +++ b/src/algebra/star/big_operators.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2021 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.big_operators.basic +import algebra.star.basic + +/-! # Big-operators lemmas about `star` algebraic operations + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +These results are kept separate from `algebra.star.basic` to avoid it needing to import `finset`. +-/ + +variables {R : Type*} + +open_locale big_operators + +@[simp] lemma star_prod [comm_monoid R] [star_semigroup R] {α : Type*} + (s : finset α) (f : α → R): + star (∏ x in s, f x) = ∏ x in s, star (f x) := +map_prod (star_mul_aut : R ≃* R) _ _ + +@[simp] lemma star_sum [add_comm_monoid R] [star_add_monoid R] {α : Type*} + (s : finset α) (f : α → R): + star (∑ x in s, f x) = ∑ x in s, star (f x) := +(star_add_equiv : R ≃+ R).map_sum _ _ diff --git a/src/algebra/star/chsh.lean b/src/algebra/star/chsh.lean index dbe8db59554e5..61e87cd570dca 100644 --- a/src/algebra/star/chsh.lean +++ b/src/algebra/star/chsh.lean @@ -3,12 +3,15 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import algebra.star.basic -import analysis.special_functions.pow +import algebra.char_p.invertible +import data.real.sqrt /-! # The Clauser-Horne-Shimony-Holt inequality and Tsirelson's inequality. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We establish a version of the Clauser-Horne-Shimony-Holt (CHSH) inequality (which is a generalization of Bell's inequality). This is a foundational result which implies that @@ -79,7 +82,7 @@ the `Aᵢ` commute with the `Bⱼ`. The physical interpretation is that `A₀` and `A₁` are a pair of boolean observables which are spacelike separated from another pair `B₀` and `B₁` of boolean observables. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure is_CHSH_tuple {R} [monoid R] [star_semigroup R] (A₀ A₁ B₀ B₁ : R) := (A₀_inv : A₀^2 = 1) (A₁_inv : A₁^2 = 1) (B₀_inv : B₀^2 = 1) (B₁_inv : B₁^2 = 1) (A₀_sa : star A₀ = A₀) (A₁_sa : star A₁ = A₁) (B₀_sa : star B₀ = B₀) (B₁_sa : star B₁ = B₁) @@ -130,7 +133,7 @@ begin T.A₀_sa, T.A₁_sa, T.B₀_sa, T.B₁_sa, mul_comm B₀, mul_comm B₁], }, rw idem', conv_rhs { congr, skip, congr, rw ←sa, }, - convert smul_le_smul_of_nonneg (star_mul_self_nonneg : 0 ≤ star P * P) _, + convert smul_le_smul_of_nonneg (star_mul_self_nonneg P) _, { simp, }, { apply_instance, }, { norm_num, } }, @@ -161,8 +164,7 @@ begin simp only [← pow_mul]; norm_num, end -lemma sqrt_two_inv_mul_self : √2⁻¹ * √2⁻¹ = (2⁻¹ : ℝ) := -by { rw [←mul_inv₀], norm_num, } +lemma sqrt_two_inv_mul_self : √2⁻¹ * √2⁻¹ = (2⁻¹ : ℝ) := by { rw ←mul_inv, norm_num } end tsirelson_inequality open tsirelson_inequality @@ -219,11 +221,11 @@ begin have P2_nonneg : 0 ≤ P^2, { rw [sq], conv { congr, skip, congr, rw ←P_sa, }, - convert (star_mul_self_nonneg : 0 ≤ star P * P), }, + convert (star_mul_self_nonneg P), }, have Q2_nonneg : 0 ≤ Q^2, { rw [sq], conv { congr, skip, congr, rw ←Q_sa, }, - convert (star_mul_self_nonneg : 0 ≤ star Q * Q), }, + convert (star_mul_self_nonneg Q), }, convert smul_le_smul_of_nonneg (add_nonneg P2_nonneg Q2_nonneg) (le_of_lt (show 0 < √2⁻¹, by norm_num)), -- `norm_num` can't directly show `0 ≤ √2⁻¹` simp, }, diff --git a/src/algebra/star/free.lean b/src/algebra/star/free.lean index 9e8ef68b90740..fca485ba14203 100644 --- a/src/algebra/star/free.lean +++ b/src/algebra/star/free.lean @@ -9,6 +9,9 @@ import algebra.free_algebra /-! # A *-algebra structure on the free algebra. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Reversing words gives a *-structure on the free monoid or on the free algebra on a type. ## Implementation note @@ -42,9 +45,13 @@ instance : star_ring (free_algebra R X) := star_involutive := λ x, by { unfold has_star.star, simp only [function.comp_apply], - refine free_algebra.induction R X _ _ _ _ x; intros; simp [*] }, - star_mul := λ a b, by simp, - star_add := λ a b, by simp } + refine free_algebra.induction R X _ _ _ _ x, + { intros, simp only [alg_hom.commutes, mul_opposite.algebra_map_apply, mul_opposite.unop_op] }, + { intros, simp only [lift_ι_apply, mul_opposite.unop_op] }, + { intros, simp only [*, map_mul, mul_opposite.unop_mul] }, + { intros, simp only [*, map_add, mul_opposite.unop_add] } }, + star_mul := λ a b, by simp only [function.comp_app, map_mul, mul_opposite.unop_mul], + star_add := λ a b, by simp only [function.comp_app, map_add, mul_opposite.unop_add]} @[simp] lemma star_ι (x : X) : star (ι R x) = (ι R x) := diff --git a/src/algebra/star/module.lean b/src/algebra/star/module.lean index d6dab39e5d40d..3bc5edfa0e127 100644 --- a/src/algebra/star/module.lean +++ b/src/algebra/star/module.lean @@ -10,6 +10,9 @@ import linear_algebra.prod /-! # The star operation, bundled as a star-linear equiv +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `star_linear_equiv`, which is the star operation bundled as a star-linear map. It is defined on a star algebra `A` over the base ring `R`. @@ -30,22 +33,22 @@ This file also provides some lemmas that need `algebra.module.basic` imported to section smul_lemmas variables {R M : Type*} +@[simp] lemma star_nat_cast_smul [semiring R] [add_comm_monoid M] [module R M] [star_add_monoid M] + (n : ℕ) (x : M) : star ((n : R) • x) = (n : R) • star x := +map_nat_cast_smul (star_add_equiv : M ≃+ M) R R n x + @[simp] lemma star_int_cast_smul [ring R] [add_comm_group M] [module R M] [star_add_monoid M] (n : ℤ) (x : M) : star ((n : R) • x) = (n : R) • star x := map_int_cast_smul (star_add_equiv : M ≃+ M) R R n x -@[simp] lemma star_nat_cast_smul [semiring R] [add_comm_monoid M] [module R M] [star_add_monoid M] - (n : ℕ) (x : M) : star ((n : R) • x) = (n : R) • star x := -map_nat_cast_smul (star_add_equiv : M ≃+ M) R R n x +@[simp] lemma star_inv_nat_cast_smul [division_semiring R] [add_comm_monoid M] [module R M] + [star_add_monoid M] (n : ℕ) (x : M) : star ((n⁻¹ : R) • x) = (n⁻¹ : R) • star x := +map_inv_nat_cast_smul (star_add_equiv : M ≃+ M) R R n x @[simp] lemma star_inv_int_cast_smul [division_ring R] [add_comm_group M] [module R M] [star_add_monoid M] (n : ℤ) (x : M) : star ((n⁻¹ : R) • x) = (n⁻¹ : R) • star x := map_inv_int_cast_smul (star_add_equiv : M ≃+ M) R R n x -@[simp] lemma star_inv_nat_cast_smul [division_ring R] [add_comm_group M] [module R M] - [star_add_monoid M] (n : ℕ) (x : M) : star ((n⁻¹ : R) • x) = (n⁻¹ : R) • star x := -map_inv_nat_cast_smul (star_add_equiv : M ≃+ M) R R n x - @[simp] lemma star_rat_cast_smul [division_ring R] [add_comm_group M] [module R M] [star_add_monoid M] (n : ℚ) (x : M) : star ((n : R) • x) = (n : R) • star x := map_rat_cast_smul (star_add_equiv : M ≃+ M) _ _ _ x @@ -60,7 +63,8 @@ end smul_lemmas then `star` is a semilinear equivalence. -/ @[simps] def star_linear_equiv (R : Type*) {A : Type*} - [comm_ring R] [star_ring R] [semiring A] [star_ring A] [module R A] [star_module R A] : + [comm_semiring R] [star_ring R] [add_comm_monoid A] [star_add_monoid A] [module R A] + [star_module R A] : A ≃ₗ⋆[R] A := { to_fun := star, map_smul' := star_smul, @@ -72,7 +76,7 @@ variables (R : Type*) (A : Type*) /-- The self-adjoint elements of a star module, as a submodule. -/ def self_adjoint.submodule : submodule R A := -{ smul_mem' := self_adjoint.smul_mem, +{ smul_mem' := λ r x, (is_self_adjoint.all _).smul, ..self_adjoint A } /-- The skew-adjoint elements of a star module, as a submodule. -/ @@ -97,7 +101,7 @@ variables {A} [invertible (2 : R)] { to_fun := λ x, ⟨(⅟2 : R) • (x - star x), by simp only [skew_adjoint.mem_iff, star_smul, star_sub, star_star, star_trivial, ←smul_neg, neg_sub]⟩, - map_add' := λ x y, by { ext, simp only [sub_add, ←smul_add, sub_sub_assoc_swap, star_add, + map_add' := λ x y, by { ext, simp only [sub_add, ←smul_add, sub_sub_eq_add_sub, star_add, add_subgroup.coe_mk, add_subgroup.coe_add] }, map_smul' := λ r x, by { ext, simp [←mul_smul, ←smul_sub, show r * ⅟ 2 = ⅟ 2 * r, from commute.inv_of_right (commute.one_right r).bit0_right] } } @@ -117,3 +121,9 @@ linear_equiv.of_linear ((self_adjoint.submodule R A).subtype.coprod (skew_adjoint.submodule R A).subtype) (by ext; simp) (linear_map.ext $ star_module.self_adjoint_part_add_skew_adjoint_part R) + +@[simp] +lemma algebra_map_star_comm {R A : Type*} [comm_semiring R] [star_ring R] [semiring A] + [star_semigroup A] [algebra R A] [star_module R A] (r : R) : + algebra_map R A (star r) = star (algebra_map R A r) := +by simp only [algebra.algebra_map_eq_smul_one, star_smul, star_one] diff --git a/src/algebra/star/order.lean b/src/algebra/star/order.lean new file mode 100644 index 0000000000000..7cee569d67e6f --- /dev/null +++ b/src/algebra/star/order.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2023 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ + +import algebra.star.basic +import group_theory.submonoid.basic + +/-! # Star ordered rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define the class `star_ordered_ring R`, which says that the order on `R` respects the +star operation, i.e. an element `r` is nonnegative iff it is in the `add_submonoid` generated by +elements of the form `star s * s`. In many cases, including all C⋆-algebras, this can be reduced to +`0 ≤ r ↔ ∃ s, r = star s * s`. However, this generality is slightly more convenient (e.g., it +allows us to register a `star_ordered_ring` instance for `ℚ`), and more closely resembles the +literature (see the seminal paper [*The positive cone in Banach algebras*][kelleyVaught1953]) + +In order to accodomate `non_unital_semiring R`, we actually don't characterize nonnegativity, but +rather the entire `≤` relation with `star_ordered_ring.le_iff`. However, notice that when `R` is a +`non_unital_ring`, these are equivalent (see `star_ordered_ring.nonneg_iff` and +`star_ordered_ring.of_nonneg_iff`). + +## TODO + +* In a Banach star algebra without a well-defined square root, the natural ordering is given by the +positive cone which is the _closure_ of the sums of elements `star r * r`. A weaker version of +`star_ordered_ring` could be defined for this case (again, see +[*The positive cone in Banach algebras*][kelleyVaught1953]). Note that the current definition has +the advantage of not requiring a topology. +-/ + +universe u +variable {R : Type u} + +/-- +An ordered `*`-ring is a ring which is both an `ordered_add_comm_group` and a `*`-ring, +and the nonnegative elements constitute precisely the `add_submonoid` generated by +elements of the form `star s * s`. + +If you are working with a `non_unital_ring` and not a `non_unital_semiring`, it may be more +convenient do declare instances using `star_ordered_ring.of_nonneg_iff'`. -/ +class star_ordered_ring (R : Type u) [non_unital_semiring R] [partial_order R] + extends star_ring R := +(add_le_add_left : ∀ a b : R, a ≤ b → ∀ c : R, c + a ≤ c + b) +(le_iff : ∀ x y : R, + x ≤ y ↔ ∃ p, p ∈ add_submonoid.closure (set.range $ λ s, star s * s) ∧ y = x + p) + +namespace star_ordered_ring + +@[priority 100] -- see note [lower instance priority] +instance to_ordered_add_comm_monoid [non_unital_semiring R] [partial_order R] + [star_ordered_ring R] : ordered_add_comm_monoid R := +{ ..show non_unital_semiring R, by apply_instance, + ..show partial_order R, by apply_instance, + ..show star_ordered_ring R, by apply_instance } + +@[priority 100] -- see note [lower instance priority] +instance to_has_exists_add_of_le [non_unital_semiring R] [partial_order R] + [star_ordered_ring R] : has_exists_add_of_le R := +{ exists_add_of_le := λ a b h, match (le_iff _ _).mp h with ⟨p, _, hp⟩ := ⟨p, hp⟩ end } + +@[priority 100] -- see note [lower instance priority] +instance to_ordered_add_comm_group [non_unital_ring R] [partial_order R] [star_ordered_ring R] : + ordered_add_comm_group R := +{ ..show non_unital_ring R, by apply_instance, + ..show partial_order R, by apply_instance, + ..show star_ordered_ring R, by apply_instance } + +/-- To construct a `star_ordered_ring` instance it suffices to show that `x ≤ y` if and only if +`y = x + star s * s` for some `s : R`. + +This is provided for convenience because it holds in some common scenarios (e.g.,`ℝ≥0`, `C(X, ℝ≥0)`) +and obviates the hassle of `add_submonoid.closure_induction` when creating those instances. + +If you are working with a `non_unital_ring` and not a `non_unital_semiring`, see +`star_ordered_ring.of_nonneg_iff` for a more convenient version. -/ +@[reducible] -- set note [reducible non-instances] +def of_le_iff [non_unital_semiring R] [partial_order R] [star_ring R] + (h_add : ∀ {x y : R}, x ≤ y → ∀ z, z + x ≤ z + y) + (h_le_iff : ∀ x y : R, x ≤ y ↔ ∃ s, y = x + star s * s) : + star_ordered_ring R := +{ add_le_add_left := @h_add, + le_iff := λ x y, + begin + refine ⟨λ h, _, _⟩, + { obtain ⟨p, hp⟩ := (h_le_iff x y).mp h, + exact ⟨star p * p, add_submonoid.subset_closure ⟨p, rfl⟩, hp⟩ }, + { rintro ⟨p, hp, hpxy⟩, + revert x y hpxy, + refine add_submonoid.closure_induction hp _ (λ x y h, add_zero x ▸ h.ge) _, + { rintro _ ⟨s, rfl⟩ x y rfl, + nth_rewrite 0 [←add_zero x], + refine h_add _ x, + exact (h_le_iff _ _).mpr ⟨s, by rw [zero_add]⟩ }, + { rintro a b ha hb x y rfl, + nth_rewrite 0 [←add_zero x], + refine h_add ((ha 0 _ (zero_add a).symm).trans (hb a _ rfl)) x } } + end, + .. ‹star_ring R› } + +/-- When `R` is a non-unital ring, to construct a `star_ordered_ring` instance it suffices to +show that the nonnegative elements are precisely those elements in the `add_submonoid` generated +by `star s * s` for `s : R`. -/ +@[reducible] -- set note [reducible non-instances] +def of_nonneg_iff [non_unital_ring R] [partial_order R] [star_ring R] + (h_add : ∀ {x y : R}, x ≤ y → ∀ z, z + x ≤ z + y) + (h_nonneg_iff : ∀ x : R, 0 ≤ x ↔ x ∈ add_submonoid.closure (set.range $ λ s : R, star s * s)) : + star_ordered_ring R := +{ add_le_add_left := @h_add, + le_iff := λ x y, + begin + haveI : covariant_class R R (+) (≤) := ⟨λ _ _ _ h, h_add h _⟩, + simpa only [←sub_eq_iff_eq_add', sub_nonneg, exists_eq_right'] using h_nonneg_iff (y - x), + end, + .. ‹star_ring R› } + +/-- When `R` is a non-unital ring, to construct a `star_ordered_ring` instance it suffices to +show that the nonnegative elements are precisely those elements of the form `star s * s` +for `s : R`. + +This is provided for convenience because it holds in many common scenarios (e.g.,`ℝ`, `ℂ`, or +any C⋆-algebra), and obviates the hassle of `add_submonoid.closure_induction` when creating those +instances. -/ +@[reducible] -- set note [reducible non-instances] +def of_nonneg_iff' [non_unital_ring R] [partial_order R] [star_ring R] + (h_add : ∀ {x y : R}, x ≤ y → ∀ z, z + x ≤ z + y) + (h_nonneg_iff : ∀ x : R, 0 ≤ x ↔ ∃ s, x = star s * s) : + star_ordered_ring R := +of_le_iff @h_add +begin + haveI : covariant_class R R (+) (≤) := ⟨λ _ _ _ h, h_add h _⟩, + simpa [sub_eq_iff_eq_add', sub_nonneg] using λ x y, h_nonneg_iff (y - x), +end + +lemma nonneg_iff [non_unital_semiring R] [partial_order R] [star_ordered_ring R] + {x : R} : 0 ≤ x ↔ x ∈ add_submonoid.closure (set.range $ λ s : R, star s * s) := +by simp only [le_iff, zero_add, exists_eq_right'] + +end star_ordered_ring + +section non_unital_semiring + +variables [non_unital_semiring R] [partial_order R] [star_ordered_ring R] + +lemma star_mul_self_nonneg (r : R) : 0 ≤ star r * r := +star_ordered_ring.nonneg_iff.mpr $ add_submonoid.subset_closure ⟨r, rfl⟩ + +lemma star_mul_self_nonneg' (r : R) : 0 ≤ r * star r := +by { nth_rewrite_rhs 0 [←star_star r], exact star_mul_self_nonneg (star r) } + +lemma conjugate_nonneg {a : R} (ha : 0 ≤ a) (c : R) : 0 ≤ star c * a * c := +begin + rw star_ordered_ring.nonneg_iff at ha, + refine add_submonoid.closure_induction ha (λ x hx, _) (by rw [mul_zero, zero_mul]) + (λ x y hx hy, _), + { obtain ⟨x, rfl⟩ := hx, + convert star_mul_self_nonneg (x * c) using 1, + rw [star_mul, ←mul_assoc, mul_assoc _ _ c] }, + { calc 0 ≤ star c * x * c + 0 : by rw [add_zero]; exact hx + ... ≤ star c * x * c + star c * y * c : star_ordered_ring.add_le_add_left _ _ hy _ + ... ≤ _ : by rw [mul_add, add_mul] } +end + +lemma conjugate_nonneg' {a : R} (ha : 0 ≤ a) (c : R) : 0 ≤ c * a * star c := +by simpa only [star_star] using conjugate_nonneg ha (star c) + +lemma conjugate_le_conjugate {a b : R} (hab : a ≤ b) (c : R) : star c * a * c ≤ star c * b * c := +begin + rw [star_ordered_ring.le_iff] at hab ⊢, + obtain ⟨p, hp, rfl⟩ := hab, + simp_rw [←star_ordered_ring.nonneg_iff] at hp ⊢, + exact ⟨star c * p * c, conjugate_nonneg hp c, by simp only [add_mul, mul_add]⟩, +end + +lemma conjugate_le_conjugate' {a b : R} (hab : a ≤ b) (c : R) : c * a * star c ≤ c * b * star c := +by simpa only [star_star] using conjugate_le_conjugate hab (star c) + +end non_unital_semiring diff --git a/src/algebra/star/pi.lean b/src/algebra/star/pi.lean index e86ed581ead55..201b46706e46e 100644 --- a/src/algebra/star/pi.lean +++ b/src/algebra/star/pi.lean @@ -5,11 +5,13 @@ Authors: Eric Wieser -/ import algebra.star.basic import algebra.ring.pi -import algebra.module.pi /-! # `star` on pi types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We put a `has_star` structure on pi types that operates elementwise, such that it describes the complex conjugation of vectors. -/ @@ -27,6 +29,9 @@ instance [Π i, has_star (f i)] : has_star (Π i, f i) := lemma star_def [Π i, has_star (f i)] (x : Π i, f i) : star x = λ i, star (x i) := rfl +instance [Π i, has_star (f i)] [∀ i, has_trivial_star (f i)] : has_trivial_star (Π i, f i) := +{ star_trivial := λ _, funext $ λ _, star_trivial _ } + instance [Π i, has_involutive_star (f i)] : has_involutive_star (Π i, f i) := { star_involutive := λ _, funext $ λ _, star_star _ } @@ -40,8 +45,26 @@ instance [Π i, non_unital_semiring (f i)] [Π i, star_ring (f i)] : star_ring ( { ..pi.star_add_monoid, ..(pi.star_semigroup : star_semigroup (Π i, f i)) } instance {R : Type w} - [Π i, has_scalar R (f i)] [has_star R] [Π i, has_star (f i)] [Π i, star_module R (f i)] : + [Π i, has_smul R (f i)] [has_star R] [Π i, has_star (f i)] [Π i, star_module R (f i)] : star_module R (Π i, f i) := { star_smul := λ r x, funext $ λ i, star_smul r (x i) } +lemma single_star [Π i, add_monoid (f i)] [Π i, star_add_monoid (f i)] [decidable_eq I] + (i : I) (a : f i) : + pi.single i (star a) = star (pi.single i a) := +single_op (λ i, @star (f i) _) (λ i, star_zero _) i a + end pi + +namespace function + +lemma update_star [Π i, has_star (f i)] [decidable_eq I] + (h : Π (i : I), f i) (i : I) (a : f i) : + function.update (star h) i (star a) = star (function.update h i a) := +funext $ λ j, (apply_update (λ i, star) h i a j).symm + +lemma star_sum_elim {I J α : Type*} (x : I → α) (y : J → α) [has_star α] : + star (sum.elim x y) = sum.elim (star x) (star y) := +by { ext x, cases x; simp } + +end function diff --git a/src/algebra/star/pointwise.lean b/src/algebra/star/pointwise.lean index ad20032b19e13..4885c23b117cb 100644 --- a/src/algebra/star/pointwise.lean +++ b/src/algebra/star/pointwise.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jireh Loreaux -/ import algebra.star.basic -import data.set.pointwise +import data.set.finite +import data.set.pointwise.basic /-! # Pointwise star operation on sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the star operation pointwise on sets and provides the basic API. Besides basic facts about about how the star operation acts on sets (e.g., `(s ∩ t)⋆ = s⋆ ∩ t⋆`), if `s t : set α`, then under suitable assumption on `α`, it is shown @@ -91,7 +95,7 @@ equiv.star.surjective.preimage_subset_preimage_iff lemma star_subset [has_involutive_star α] {s t : set α} : s⋆ ⊆ t ↔ s ⊆ t⋆ := by { rw [← star_subset_star, star_star] } -lemma finite.star [has_involutive_star α] {s : set α} (hs : finite s) : finite s⋆ := +lemma finite.star [has_involutive_star α] {s : set α} (hs : s.finite) : s⋆.finite := hs.preimage $ star_injective.inj_on _ lemma star_singleton {β : Type*} [has_involutive_star β] (x : β) : ({x} : set β)⋆ = {x⋆} := @@ -113,7 +117,7 @@ instance [has_star α] [has_trivial_star α] : has_trivial_star (set α) := protected lemma star_inv [group α] [star_semigroup α] (s : set α) : (s⁻¹)⋆ = (s⋆)⁻¹ := by { ext, simp only [mem_star, mem_inv, star_inv] } -protected lemma star_inv' [division_ring α] [star_ring α] (s : set α) : (s⁻¹)⋆ = (s⋆)⁻¹ := +protected lemma star_inv' [division_semiring α] [star_ring α] (s : set α) : (s⁻¹)⋆ = (s⋆)⁻¹ := by { ext, simp only [mem_star, mem_inv, star_inv'] } end set diff --git a/src/algebra/star/prod.lean b/src/algebra/star/prod.lean index 888a46e9bb9c7..2bc74d1b4e8c8 100644 --- a/src/algebra/star/prod.lean +++ b/src/algebra/star/prod.lean @@ -10,6 +10,9 @@ import algebra.module.prod /-! # `star` on product types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We put a `has_star` structure on product types that operates elementwise. -/ @@ -26,6 +29,10 @@ instance [has_star R] [has_star S] : has_star (R × S) := lemma star_def [has_star R] [has_star S] (x : R × S) : star x = (star x.1, star x.2) := rfl +instance [has_star R] [has_star S] [has_trivial_star R] [has_trivial_star S] : + has_trivial_star (R × S) := +{ star_trivial := λ _, prod.ext (star_trivial _) (star_trivial _) } + instance [has_involutive_star R] [has_involutive_star S] : has_involutive_star (R × S) := { star_involutive := λ _, prod.ext (star_star _) (star_star _) } @@ -41,7 +48,7 @@ instance [non_unital_semiring R] [non_unital_semiring S] [star_ring R] [star_rin star_ring (R × S) := { ..prod.star_add_monoid, ..(prod.star_semigroup : star_semigroup (R × S)) } -instance {α : Type w} [has_scalar α R] [has_scalar α S] [has_star α] [has_star R] [has_star S] +instance {α : Type w} [has_smul α R] [has_smul α S] [has_star α] [has_star R] [has_star S] [star_module α R] [star_module α S] : star_module α (R × S) := { star_smul := λ r x, prod.ext (star_smul _ _) (star_smul _ _) } diff --git a/src/algebra/star/self_adjoint.lean b/src/algebra/star/self_adjoint.lean index 86fe15c3418e4..146c294221606 100644 --- a/src/algebra/star/self_adjoint.lean +++ b/src/algebra/star/self_adjoint.lean @@ -10,6 +10,9 @@ import group_theory.subgroup.basic /-! # Self-adjoint, skew-adjoint and normal elements of a star additive group +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `self_adjoint R` (resp. `skew_adjoint R`), where `R` is a star additive group, as the additive subgroup containing the elements that satisfy `star x = x` (resp. `star x = -x`). This includes, for instance, (skew-)Hermitian operators on Hilbert spaces. @@ -31,21 +34,195 @@ We also define `is_star_normal R`, a `Prop` that states that an element `x` sati ## TODO +* Define `is_skew_adjoint` to match `is_self_adjoint`. * Define `λ z x, z * x * star z` (i.e. conjugation by `z`) as a monoid action of `R` on `R` (similar to the existing `conj_act` for groups), and then state the fact that `self_adjoint R` is invariant under it. -/ -variables (R : Type*) {A : Type*} +variables {R A : Type*} + +/-- An element is self-adjoint if it is equal to its star. -/ +def is_self_adjoint [has_star R] (x : R) : Prop := star x = x + +/-- An element of a star monoid is normal if it commutes with its adjoint. -/ +class is_star_normal [has_mul R] [has_star R] (x : R) : Prop := +(star_comm_self : commute (star x) x) + +export is_star_normal (star_comm_self) + +lemma star_comm_self' [has_mul R] [has_star R] (x : R) [is_star_normal x] : + (star x) * x = x * star x := +is_star_normal.star_comm_self + +namespace is_self_adjoint + +-- named to match `commute.all` +/-- All elements are self-adjoint when `star` is trivial. -/ +lemma all [has_star R] [has_trivial_star R] (r : R) : is_self_adjoint r := star_trivial _ + +lemma star_eq [has_star R] {x : R} (hx : is_self_adjoint x) : star x = x := hx + +lemma _root_.is_self_adjoint_iff [has_star R] {x : R} : is_self_adjoint x ↔ star x = x := iff.rfl + +@[simp] +lemma star_iff [has_involutive_star R] {x : R} : is_self_adjoint (star x) ↔ is_self_adjoint x := +by simpa only [is_self_adjoint, star_star] using eq_comm + +@[simp] +lemma star_mul_self [semigroup R] [star_semigroup R] (x : R) : is_self_adjoint (star x * x) := +by simp only [is_self_adjoint, star_mul, star_star] + +@[simp] +lemma mul_star_self [semigroup R] [star_semigroup R] (x : R) : is_self_adjoint (x * star x) := +by simpa only [star_star] using star_mul_self (star x) + +/-- Functions in a `star_hom_class` preserve self-adjoint elements. -/ +lemma star_hom_apply {F R S : Type*} [has_star R] [has_star S] [star_hom_class F R S] + {x : R} (hx : is_self_adjoint x) (f : F) : is_self_adjoint (f x) := +show star (f x) = f x, from map_star f x ▸ congr_arg f hx + +section add_monoid +variables [add_monoid R] [star_add_monoid R] + +variables (R) + +lemma _root_.is_self_adjoint_zero : is_self_adjoint (0 : R) := star_zero R + +variables {R} + +lemma add {x y : R} (hx : is_self_adjoint x) (hy : is_self_adjoint y) : is_self_adjoint (x + y) := +by simp only [is_self_adjoint_iff, star_add, hx.star_eq, hy.star_eq] + +lemma bit0 {x : R} (hx : is_self_adjoint x) : is_self_adjoint (bit0 x) := +by simp only [is_self_adjoint_iff, star_bit0, hx.star_eq] + +end add_monoid + +section add_group +variables [add_group R] [star_add_monoid R] + +lemma neg {x : R} (hx : is_self_adjoint x) : is_self_adjoint (-x) := +by simp only [is_self_adjoint_iff, star_neg, hx.star_eq] + +lemma sub {x y : R} (hx : is_self_adjoint x) (hy : is_self_adjoint y) : is_self_adjoint (x - y) := +by simp only [is_self_adjoint_iff, star_sub, hx.star_eq, hy.star_eq] + +end add_group + +section add_comm_monoid +variables [add_comm_monoid R] [star_add_monoid R] + +lemma _root_.is_self_adjoint_add_star_self (x : R) : is_self_adjoint (x + star x) := +by simp only [is_self_adjoint_iff, add_comm, star_add, star_star] + +lemma _root_.is_self_adjoint_star_add_self (x : R) : is_self_adjoint (star x + x) := +by simp only [is_self_adjoint_iff, add_comm, star_add, star_star] + +end add_comm_monoid + +section semigroup +variables [semigroup R] [star_semigroup R] + +lemma conjugate {x : R} (hx : is_self_adjoint x) (z : R) : is_self_adjoint (z * x * star z) := +by simp only [is_self_adjoint_iff, star_mul, star_star, mul_assoc, hx.star_eq] + +lemma conjugate' {x : R} (hx : is_self_adjoint x) (z : R) : is_self_adjoint (star z * x * z) := +by simp only [is_self_adjoint_iff, star_mul, star_star, mul_assoc, hx.star_eq] + +lemma is_star_normal {x : R} (hx : is_self_adjoint x) : is_star_normal x := +⟨by simp only [hx.star_eq]⟩ + +end semigroup + +section monoid +variables [monoid R] [star_semigroup R] + +variables (R) + +lemma _root_.is_self_adjoint_one : is_self_adjoint (1 : R) := star_one R + +variables {R} + +lemma pow {x : R} (hx : is_self_adjoint x) (n : ℕ) : is_self_adjoint (x ^ n):= +by simp only [is_self_adjoint_iff, star_pow, hx.star_eq] + +end monoid + +section semiring +variables [semiring R] [star_ring R] + +lemma bit1 {x : R} (hx : is_self_adjoint x) : is_self_adjoint (bit1 x) := +by simp only [is_self_adjoint_iff, star_bit1, hx.star_eq] + +@[simp] lemma _root_.is_self_adjoint_nat_cast (n : ℕ) : is_self_adjoint (n : R) := +star_nat_cast _ + +end semiring + +section comm_semigroup +variables [comm_semigroup R] [star_semigroup R] + +lemma mul {x y : R} (hx : is_self_adjoint x) (hy : is_self_adjoint y) : is_self_adjoint (x * y) := +by simp only [is_self_adjoint_iff, star_mul', hx.star_eq, hy.star_eq] + +end comm_semigroup + +section ring +variables [ring R] [star_ring R] + +@[simp] lemma _root_.is_self_adjoint_int_cast (z : ℤ) : is_self_adjoint (z : R) := +star_int_cast _ + +end ring + +section division_semiring +variables [division_semiring R] [star_ring R] + +lemma inv {x : R} (hx : is_self_adjoint x) : is_self_adjoint x⁻¹ := +by simp only [is_self_adjoint_iff, star_inv', hx.star_eq] + +lemma zpow {x : R} (hx : is_self_adjoint x) (n : ℤ) : is_self_adjoint (x ^ n):= +by simp only [is_self_adjoint_iff, star_zpow₀, hx.star_eq] + +end division_semiring + +section division_ring +variables [division_ring R] [star_ring R] + +lemma _root_.is_self_adjoint_rat_cast (x : ℚ) : is_self_adjoint (x : R) := +star_rat_cast _ + +end division_ring + +section semifield +variables [semifield R] [star_ring R] + +lemma div {x y : R} (hx : is_self_adjoint x) (hy : is_self_adjoint y) : is_self_adjoint (x / y) := +by simp only [is_self_adjoint_iff, star_div', hx.star_eq, hy.star_eq] + +end semifield + +section has_smul +variables [has_star R] [add_monoid A] [star_add_monoid A] [has_smul R A] [star_module R A] + +lemma smul {r : R} (hr : is_self_adjoint r) {x : A} (hx : is_self_adjoint x) : + is_self_adjoint (r • x) := +by simp only [is_self_adjoint_iff, star_smul, hr.star_eq, hx.star_eq] + +end has_smul + +end is_self_adjoint + +variables (R) /-- The self-adjoint elements of a star additive group, as an additive subgroup. -/ def self_adjoint [add_group R] [star_add_monoid R] : add_subgroup R := -{ carrier := {x | star x = x}, +{ carrier := {x | is_self_adjoint x}, zero_mem' := star_zero R, - add_mem' := λ x y (hx : star x = x) (hy : star y = y), - show star (x + y) = x + y, by simp only [star_add x y, hx, hy], - neg_mem' := λ x (hx : star x = x), show star (-x) = -x, by simp only [hx, star_neg] } + add_mem' := λ _ _ hx, hx.add, + neg_mem' := λ _ hx, hx.neg } /-- The skew-adjoint elements of a star additive group, as an additive subgroup. -/ def skew_adjoint [add_comm_group R] [star_add_monoid R] : add_subgroup R := @@ -57,16 +234,6 @@ def skew_adjoint [add_comm_group R] [star_add_monoid R] : add_subgroup R := variables {R} -/-- An element of a star monoid is normal if it commutes with its adjoint. -/ -class is_star_normal [has_mul R] [has_star R] (x : R) : Prop := -(star_comm_self : commute (star x) x) - -export is_star_normal (star_comm_self) - -lemma star_comm_self' [has_mul R] [has_star R] (x : R) [is_star_normal x] : - (star x) * x = x * star x := -is_star_normal.star_comm_self - namespace self_adjoint section add_group @@ -79,56 +246,48 @@ by { rw [←add_subgroup.mem_carrier], exact iff.rfl } instance : inhabited (self_adjoint R) := ⟨0⟩ -lemma bit0_mem {x : R} (hx : x ∈ self_adjoint R) : bit0 x ∈ self_adjoint R := -by simp only [mem_iff, star_bit0, mem_iff.mp hx] - end add_group section ring variables [ring R] [star_ring R] -instance : has_one (self_adjoint R) := ⟨⟨1, by rw [mem_iff, star_one]⟩⟩ +instance : has_one (self_adjoint R) := ⟨⟨1, is_self_adjoint_one R⟩⟩ @[simp, norm_cast] lemma coe_one : ↑(1 : self_adjoint R) = (1 : R) := rfl instance [nontrivial R] : nontrivial (self_adjoint R) := ⟨⟨0, 1, subtype.ne_of_val_ne zero_ne_one⟩⟩ -lemma one_mem : (1 : R) ∈ self_adjoint R := by simp only [mem_iff, star_one] - -lemma bit1_mem {x : R} (hx : x ∈ self_adjoint R) : bit1 x ∈ self_adjoint R := -by simp only [mem_iff, star_bit1, mem_iff.mp hx] - -lemma conjugate {x : R} (hx : x ∈ self_adjoint R) (z : R) : z * x * star z ∈ self_adjoint R := -by simp only [mem_iff, star_mul, star_star, mem_iff.mp hx, mul_assoc] +instance : has_nat_cast (self_adjoint R) := +⟨λ n, ⟨n, is_self_adjoint_nat_cast _⟩⟩ -lemma conjugate' {x : R} (hx : x ∈ self_adjoint R) (z : R) : star z * x * z ∈ self_adjoint R := -by simp only [mem_iff, star_mul, star_star, mem_iff.mp hx, mul_assoc] - -lemma is_star_normal_of_mem {x : R} (hx : x ∈ self_adjoint R) : is_star_normal x := -⟨by { simp only [mem_iff] at hx, simp only [hx] }⟩ - -instance (x : self_adjoint R) : is_star_normal (x : R) := -is_star_normal_of_mem (set_like.coe_mem _) +instance : has_int_cast (self_adjoint R) := +⟨λ n, ⟨n, is_self_adjoint_int_cast _⟩ ⟩ instance : has_pow (self_adjoint R) ℕ := -⟨λ x n, ⟨(x : R) ^ n, by simp only [mem_iff, star_pow, star_coe_eq]⟩⟩ +⟨λ x n, ⟨(x : R) ^ n, x.prop.pow n⟩⟩ @[simp, norm_cast] lemma coe_pow (x : self_adjoint R) (n : ℕ) : ↑(x ^ n) = (x : R) ^ n := rfl end ring -section comm_ring -variables [comm_ring R] [star_ring R] +section non_unital_comm_ring +variables [non_unital_comm_ring R] [star_ring R] instance : has_mul (self_adjoint R) := -⟨λ x y, ⟨(x : R) * y, by simp only [mem_iff, star_mul', star_coe_eq]⟩⟩ +⟨λ x y, ⟨(x : R) * y, x.prop.mul y.prop⟩⟩ @[simp, norm_cast] lemma coe_mul (x y : self_adjoint R) : ↑(x * y) = (x : R) * y := rfl +end non_unital_comm_ring + +section comm_ring +variables [comm_ring R] [star_ring R] + instance : comm_ring (self_adjoint R) := function.injective.comm_ring _ subtype.coe_injective (self_adjoint R).coe_zero coe_one (self_adjoint R).coe_add coe_mul (self_adjoint R).coe_neg (self_adjoint R).coe_sub (self_adjoint R).coe_nsmul (self_adjoint R).coe_zsmul coe_pow + (λ _, rfl) (λ _, rfl) end comm_ring @@ -137,39 +296,47 @@ section field variables [field R] [star_ring R] instance : has_inv (self_adjoint R) := -{ inv := λ x, ⟨(x.val)⁻¹, by simp only [mem_iff, star_inv', star_coe_eq, subtype.val_eq_coe]⟩ } +{ inv := λ x, ⟨(x.val)⁻¹, x.prop.inv⟩ } @[simp, norm_cast] lemma coe_inv (x : self_adjoint R) : ↑(x⁻¹) = (x : R)⁻¹ := rfl instance : has_div (self_adjoint R) := -{ div := λ x y, ⟨x / y, by simp only [mem_iff, star_div', star_coe_eq, subtype.val_eq_coe]⟩ } +{ div := λ x y, ⟨x / y, x.prop.div y.prop⟩ } @[simp, norm_cast] lemma coe_div (x y : self_adjoint R) : ↑(x / y) = (x / y : R) := rfl instance : has_pow (self_adjoint R) ℤ := -{ pow := λ x z, ⟨x ^ z, by simp only [mem_iff, star_zpow₀, star_coe_eq, subtype.val_eq_coe]⟩ } +{ pow := λ x z, ⟨x ^ z, x.prop.zpow z⟩ } @[simp, norm_cast] lemma coe_zpow (x : self_adjoint R) (z : ℤ) : ↑(x ^ z) = (x : R) ^ z := rfl +instance : has_rat_cast (self_adjoint R) := +⟨λ n, ⟨n, is_self_adjoint_rat_cast n⟩⟩ + +@[simp, norm_cast] lemma coe_rat_cast (x : ℚ) : ↑(x : self_adjoint R) = (x : R) := +rfl + +instance has_qsmul : has_smul ℚ (self_adjoint R) := +⟨λ a x, ⟨a • x, by rw rat.smul_def; exact is_self_adjoint.mul (is_self_adjoint_rat_cast a) x.prop⟩⟩ + +@[simp, norm_cast] lemma coe_rat_smul (x : self_adjoint R) (a : ℚ) : ↑(a • x) = a • (x : R) := +rfl + instance : field (self_adjoint R) := function.injective.field _ subtype.coe_injective (self_adjoint R).coe_zero coe_one (self_adjoint R).coe_add coe_mul (self_adjoint R).coe_neg (self_adjoint R).coe_sub coe_inv coe_div (self_adjoint R).coe_nsmul (self_adjoint R).coe_zsmul - coe_pow coe_zpow + coe_rat_smul coe_pow coe_zpow (λ _, rfl) (λ _, rfl) coe_rat_cast end field -section has_scalar +section has_smul variables [has_star R] [has_trivial_star R] [add_group A] [star_add_monoid A] -lemma smul_mem [has_scalar R A] [star_module R A] (r : R) {x : A} - (h : x ∈ self_adjoint A) : r • x ∈ self_adjoint A := -by rw [mem_iff, star_smul, star_trivial, mem_iff.mp h] +instance [has_smul R A] [star_module R A] : has_smul R (self_adjoint A) := +⟨λ r x, ⟨r • x, (is_self_adjoint.all _).smul x.prop⟩⟩ -instance [has_scalar R A] [star_module R A] : has_scalar R (self_adjoint A) := -⟨λ r x, ⟨r • x, smul_mem r x.prop⟩⟩ - -@[simp, norm_cast] lemma coe_smul [has_scalar R A] [star_module R A] (r : R) (x : self_adjoint A) : +@[simp, norm_cast] lemma coe_smul [has_smul R A] [star_module R A] (r : R) (x : self_adjoint A) : ↑(r • x) = r • (x : A) := rfl instance [monoid R] [mul_action R A] [star_module R A] : mul_action R (self_adjoint A) := @@ -179,7 +346,7 @@ instance [monoid R] [distrib_mul_action R A] [star_module R A] : distrib_mul_action R (self_adjoint A) := function.injective.distrib_mul_action (self_adjoint A).subtype subtype.coe_injective coe_smul -end has_scalar +end has_smul section module variables [has_star R] [has_trivial_star R] [add_comm_group A] [star_add_monoid A] @@ -225,14 +392,14 @@ is_star_normal_of_mem (set_like.coe_mem _) end ring -section has_scalar +section has_smul variables [has_star R] [has_trivial_star R] [add_comm_group A] [star_add_monoid A] lemma smul_mem [monoid R] [distrib_mul_action R A] [star_module R A] (r : R) {x : A} (h : x ∈ skew_adjoint A) : r • x ∈ skew_adjoint A := by rw [mem_iff, star_smul, star_trivial, mem_iff.mp h, smul_neg r] -instance [monoid R] [distrib_mul_action R A] [star_module R A] : has_scalar R (skew_adjoint A) := +instance [monoid R] [distrib_mul_action R A] [star_module R A] : has_smul R (skew_adjoint A) := ⟨λ r x, ⟨r • x, smul_mem r x.prop⟩⟩ @[simp, norm_cast] lemma coe_smul [monoid R] [distrib_mul_action R A] [star_module R A] @@ -245,10 +412,26 @@ function.injective.distrib_mul_action (skew_adjoint A).subtype subtype.coe_injec instance [semiring R] [module R A] [star_module R A] : module R (skew_adjoint A) := function.injective.module R (skew_adjoint A).subtype subtype.coe_injective coe_smul -end has_scalar +end has_smul end skew_adjoint +/-- Scalar multiplication of a self-adjoint element by a skew-adjoint element produces a +skew-adjoint element. -/ +lemma is_self_adjoint.smul_mem_skew_adjoint [ring R] [add_comm_group A] [module R A] + [star_add_monoid R] [star_add_monoid A] [star_module R A] {r : R} + (hr : r ∈ skew_adjoint R) {a : A} (ha : is_self_adjoint a) : + r • a ∈ skew_adjoint A := +(star_smul _ _).trans $ (congr_arg2 _ hr ha).trans $ neg_smul _ _ + +/-- Scalar multiplication of a skew-adjoint element by a skew-adjoint element produces a +self-adjoint element. -/ +lemma is_self_adjoint_smul_of_mem_skew_adjoint [ring R] [add_comm_group A] [module R A] + [star_add_monoid R] [star_add_monoid A] [star_module R A] {r : R} + (hr : r ∈ skew_adjoint R) {a : A} (ha : a ∈ skew_adjoint A) : + is_self_adjoint (r • a) := +(star_smul _ _).trans $ (congr_arg2 _ hr ha).trans $ neg_smul_neg _ _ + instance is_star_normal_zero [semiring R] [star_ring R] : is_star_normal (0 : R) := ⟨by simp only [star_comm_self, star_zero]⟩ diff --git a/src/algebra/star/star_alg_hom.lean b/src/algebra/star/star_alg_hom.lean new file mode 100644 index 0000000000000..93139df49b541 --- /dev/null +++ b/src/algebra/star/star_alg_hom.lean @@ -0,0 +1,701 @@ +/- +Copyright (c) 2022 Jireh Loreaux. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jireh Loreaux +-/ + +import algebra.hom.non_unital_alg +import algebra.star.prod +import algebra.algebra.prod + +/-! +# Morphisms of star algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines morphisms between `R`-algebras (unital or non-unital) `A` and `B` where both +`A` and `B` are equipped with a `star` operation. These morphisms, namely `star_alg_hom` and +`non_unital_star_alg_hom` are direct extensions of their non-`star`red counterparts with a field +`map_star` which guarantees they preserve the star operation. We keep the type classes as generic +as possible, in keeping with the definition of `non_unital_alg_hom` in the non-unital case. In this +file, we only assume `has_star` unless we want to talk about the zero map as a +`non_unital_star_alg_hom`, in which case we need `star_add_monoid`. Note that the scalar ring `R` +is not required to have a star operation, nor do we need `star_ring` or `star_module` structures on +`A` and `B`. + +As with `non_unital_alg_hom`, in the non-unital case the multiplications are not assumed to be +associative or unital, or even to be compatible with the scalar actions. In a typical application, +the operations will satisfy compatibility conditions making them into algebras (albeit possibly +non-associative and/or non-unital) but such conditions are not required here for the definitions. + +The primary impetus for defining these types is that they constitute the morphisms in the categories +of unital C⋆-algebras (with `star_alg_hom`s) and of C⋆-algebras (with `non_unital_star_alg_hom`s). + +TODO: add `star_alg_equiv`. + +## Main definitions + + * `non_unital_alg_hom` + * `star_alg_hom` + +## Tags + +non-unital, algebra, morphism, star +-/ + +set_option old_structure_cmd true + +/-! ### Non-unital star algebra homomorphisms -/ + +/-- A *non-unital ⋆-algebra homomorphism* is a non-unital algebra homomorphism between +non-unital `R`-algebras `A` and `B` equipped with a `star` operation, and this homomorphism is +also `star`-preserving. -/ +structure non_unital_star_alg_hom (R A B : Type*) [monoid R] + [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [has_star A] + [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [has_star B] + extends A →ₙₐ[R] B := +(map_star' : ∀ a : A, to_fun (star a) = star (to_fun a)) + +infixr ` →⋆ₙₐ `:25 := non_unital_star_alg_hom _ +notation A ` →⋆ₙₐ[`:25 R `] ` B := non_unital_star_alg_hom R A B + +/-- Reinterpret a non-unital star algebra homomorphism as a non-unital algebra homomorphism +by forgetting the interaction with the star operation. -/ +add_decl_doc non_unital_star_alg_hom.to_non_unital_alg_hom + +/-- `non_unital_star_alg_hom_class F R A B` asserts `F` is a type of bundled non-unital ⋆-algebra +homomorphisms from `A` to `B`. -/ +class non_unital_star_alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) + (B : out_param Type*) [monoid R] [has_star A] [has_star B] + [non_unital_non_assoc_semiring A] [non_unital_non_assoc_semiring B] + [distrib_mul_action R A] [distrib_mul_action R B] + extends non_unital_alg_hom_class F R A B, star_hom_class F A B + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] non_unital_star_alg_hom_class.to_star_hom_class + +namespace non_unital_star_alg_hom_class + +variables {F R A B : Type*} [monoid R] +variables [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [has_star A] +variables [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [has_star B] + +instance [non_unital_star_alg_hom_class F R A B] : has_coe_t F (A →⋆ₙₐ[R] B) := +{ coe := λ f, + { to_fun := f, + map_star' := map_star f, + .. (f : A →ₙₐ[R] B) }} + +end non_unital_star_alg_hom_class + +namespace non_unital_star_alg_hom + +section basic + +variables {R A B C D : Type*} [monoid R] +variables [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [has_star A] +variables [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [has_star B] +variables [non_unital_non_assoc_semiring C] [distrib_mul_action R C] [has_star C] +variables [non_unital_non_assoc_semiring D] [distrib_mul_action R D] [has_star D] + +instance : non_unital_star_alg_hom_class (A →⋆ₙₐ[R] B) R A B := +{ coe := to_fun, + coe_injective' := by rintro ⟨f, _⟩ ⟨g, _⟩ ⟨h⟩; congr, + map_smul := λ f, f.map_smul', + map_add := λ f, f.map_add', + map_zero := λ f, f.map_zero', + map_mul := λ f, f.map_mul', + map_star := λ f, f.map_star' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +instance : has_coe_to_fun (A →⋆ₙₐ[R] B) (λ _, A → B) := fun_like.has_coe_to_fun + +initialize_simps_projections non_unital_star_alg_hom (to_fun → apply) + +@[simp, protected] lemma coe_coe {F : Type*} [non_unital_star_alg_hom_class F R A B] (f : F) : + ⇑(f : A →⋆ₙₐ[R] B) = f := rfl + +@[simp] lemma coe_to_non_unital_alg_hom {f : A →⋆ₙₐ[R] B} : + (f.to_non_unital_alg_hom : A → B) = f := rfl + +@[ext] lemma ext {f g : A →⋆ₙₐ[R] B} (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h + +/-- Copy of a `non_unital_star_alg_hom` with a new `to_fun` equal to the old one. Useful +to fix definitional equalities. -/ +protected def copy (f : A →⋆ₙₐ[R] B) (f' : A → B) (h : f' = f) : A →⋆ₙₐ[R] B := +{ to_fun := f', + map_smul' := h.symm ▸ map_smul f, + map_zero' := h.symm ▸ map_zero f, + map_add' := h.symm ▸ map_add f, + map_mul' := h.symm ▸ map_mul f, + map_star' := h.symm ▸ map_star f } + +@[simp] lemma coe_copy (f : A →⋆ₙₐ[R] B) (f' : A → B) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl +lemma copy_eq (f : A →⋆ₙₐ[R] B) (f' : A → B) (h : f' = f) : f.copy f' h = f := fun_like.ext' h + +@[simp] lemma coe_mk (f : A → B) (h₁ h₂ h₃ h₄ h₅) : + ((⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →⋆ₙₐ[R] B) : A → B) = f := +rfl + +@[simp] lemma mk_coe (f : A →⋆ₙₐ[R] B) (h₁ h₂ h₃ h₄ h₅) : + (⟨f, h₁, h₂, h₃, h₄, h₅⟩ : A →⋆ₙₐ[R] B) = f := +by { ext, refl, } + +section +variables (R A) +/-- The identity as a non-unital ⋆-algebra homomorphism. -/ +protected def id : A →⋆ₙₐ[R] A := +{ map_star' := λ x, rfl, .. (1 : A →ₙₐ[R] A) } + +@[simp] lemma coe_id : ⇑(non_unital_star_alg_hom.id R A) = id := rfl +end + +/-- The composition of non-unital ⋆-algebra homomorphisms, as a non-unital ⋆-algebra +homomorphism. -/ +def comp (f : B →⋆ₙₐ[R] C) (g : A →⋆ₙₐ[R] B) : A →⋆ₙₐ[R] C := +{ map_star' := by simp only [map_star, non_unital_alg_hom.to_fun_eq_coe, eq_self_iff_true, + non_unital_alg_hom.coe_comp, coe_to_non_unital_alg_hom, function.comp_app, forall_const], + .. f.to_non_unital_alg_hom.comp g.to_non_unital_alg_hom } + +@[simp] lemma coe_comp (f : B →⋆ₙₐ[R] C) (g : A →⋆ₙₐ[R] B) : ⇑(comp f g) = f ∘ g := rfl + +@[simp] lemma comp_apply (f : B →⋆ₙₐ[R] C) (g : A →⋆ₙₐ[R] B) (a : A) : comp f g a = f (g a) := rfl + +@[simp] lemma comp_assoc (f : C →⋆ₙₐ[R] D) (g : B →⋆ₙₐ[R] C) (h : A →⋆ₙₐ[R] B) : + (f.comp g).comp h = f.comp (g.comp h) := rfl + +@[simp] lemma id_comp (f : A →⋆ₙₐ[R] B) : (non_unital_star_alg_hom.id _ _).comp f = f := +ext $ λ _, rfl + +@[simp] lemma comp_id (f : A →⋆ₙₐ[R] B) : f.comp (non_unital_star_alg_hom.id _ _) = f := +ext $ λ _, rfl + +instance : monoid (A →⋆ₙₐ[R] A) := +{ mul := comp, + mul_assoc := comp_assoc, + one := non_unital_star_alg_hom.id R A, + one_mul := id_comp, + mul_one := comp_id, } + +@[simp] lemma coe_one : ((1 : A →⋆ₙₐ[R] A) : A → A) = id := rfl +lemma one_apply (a : A) : (1 : A →⋆ₙₐ[R] A) a = a := rfl + +end basic + +section zero +-- the `zero` requires extra type class assumptions because we need `star_zero` +variables {R A B C D : Type*} [monoid R] +variables [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [star_add_monoid A] +variables [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [star_add_monoid B] + +instance : has_zero (A →⋆ₙₐ[R] B) := +⟨{ map_star' := by simp, .. (0 : non_unital_alg_hom R A B) }⟩ + +instance : inhabited (A →⋆ₙₐ[R] B) := ⟨0⟩ + +instance : monoid_with_zero (A →⋆ₙₐ[R] A) := +{ zero_mul := λ f, ext $ λ x, rfl, + mul_zero := λ f, ext $ λ x, map_zero f, + .. non_unital_star_alg_hom.monoid, + .. non_unital_star_alg_hom.has_zero } + +@[simp] lemma coe_zero : ((0 : A →⋆ₙₐ[R] B) : A → B) = 0 := rfl +lemma zero_apply (a : A) : (0 : A →⋆ₙₐ[R] B) a = 0 := rfl + +end zero + +end non_unital_star_alg_hom + +/-! ### Unital star algebra homomorphisms -/ + +section unital + +/-- A *⋆-algebra homomorphism* is an algebra homomorphism between `R`-algebras `A` and `B` +equipped with a `star` operation, and this homomorphism is also `star`-preserving. -/ +structure star_alg_hom (R A B: Type*) [comm_semiring R] [semiring A] [algebra R A] [has_star A] + [semiring B] [algebra R B] [has_star B] extends alg_hom R A B := +(map_star' : ∀ x : A, to_fun (star x) = star (to_fun x)) + +infixr ` →⋆ₐ `:25 := star_alg_hom _ +notation A ` →⋆ₐ[`:25 R `] ` B := star_alg_hom R A B + +/-- Reinterpret a unital star algebra homomorphism as a unital algebra homomorphism +by forgetting the interaction with the star operation. -/ +add_decl_doc star_alg_hom.to_alg_hom + +/-- `star_alg_hom_class F R A B` states that `F` is a type of ⋆-algebra homomorphisms. + +You should also extend this typeclass when you extend `star_alg_hom`. -/ +class star_alg_hom_class (F : Type*) (R : out_param Type*) (A : out_param Type*) + (B : out_param Type*) [comm_semiring R] [semiring A] [algebra R A] [has_star A] + [semiring B] [algebra R B] [has_star B] extends alg_hom_class F R A B, star_hom_class F A B + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] star_alg_hom_class.to_star_hom_class + +namespace star_alg_hom_class + +variables (F R A B : Type*) [comm_semiring R] [semiring A] [algebra R A] [has_star A] +variables [semiring B] [algebra R B] [has_star B] [hF : star_alg_hom_class F R A B] +include hF + +@[priority 100] /- See note [lower instance priority] -/ +instance to_non_unital_star_alg_hom_class : non_unital_star_alg_hom_class F R A B := +{ map_smul := map_smul, + .. star_alg_hom_class.to_alg_hom_class F R A B, + .. star_alg_hom_class.to_star_hom_class F R A B, } + +instance : has_coe_t F (A →⋆ₐ[R] B) := +{ coe := λ f, + { to_fun := f, + map_star' := map_star f, + ..(f : A →ₐ[R] B) } } + +end star_alg_hom_class + +namespace star_alg_hom + +variables {F R A B C D : Type*} [comm_semiring R] + [semiring A] [algebra R A] [has_star A] + [semiring B] [algebra R B] [has_star B] + [semiring C] [algebra R C] [has_star C] + [semiring D] [algebra R D] [has_star D] + +instance : star_alg_hom_class (A →⋆ₐ[R] B) R A B := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, + begin + obtain ⟨_, _, _, _, _, _, _⟩ := f; + obtain ⟨_, _, _, _, _, _, _⟩ := g; + congr' + end, + map_mul := map_mul', + map_one := map_one', + map_add := map_add', + map_zero := map_zero', + commutes := commutes', + map_star := map_star' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +instance : has_coe_to_fun (A →⋆ₐ[R] B) (λ _, A → B) := fun_like.has_coe_to_fun + +@[simp, protected] lemma coe_coe {F : Type*} [star_alg_hom_class F R A B] (f : F) : + ⇑(f : A →⋆ₐ[R] B) = f := rfl + +initialize_simps_projections star_alg_hom (to_fun → apply) + +@[simp] lemma coe_to_alg_hom {f : A →⋆ₐ[R] B} : + (f.to_alg_hom : A → B) = f := rfl + +@[ext] lemma ext {f g : A →⋆ₐ[R] B} (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h + +/-- Copy of a `star_alg_hom` with a new `to_fun` equal to the old one. Useful +to fix definitional equalities. -/ +protected def copy (f : A →⋆ₐ[R] B) (f' : A → B) (h : f' = f) : A →⋆ₐ[R] B := +{ to_fun := f', + map_one' := h.symm ▸ map_one f , + map_mul' := h.symm ▸ map_mul f, + map_zero' := h.symm ▸ map_zero f, + map_add' := h.symm ▸ map_add f, + commutes' := h.symm ▸ alg_hom_class.commutes f, + map_star' := h.symm ▸ map_star f } + +@[simp] lemma coe_copy (f : A →⋆ₐ[R] B) (f' : A → B) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl +lemma copy_eq (f : A →⋆ₐ[R] B) (f' : A → B) (h : f' = f) : f.copy f' h = f := fun_like.ext' h + +@[simp] lemma coe_mk (f : A → B) (h₁ h₂ h₃ h₄ h₅ h₆) : + ((⟨f, h₁, h₂, h₃, h₄, h₅, h₆⟩ : A →⋆ₐ[R] B) : A → B) = f := +rfl + +@[simp] lemma mk_coe (f : A →⋆ₐ[R] B) (h₁ h₂ h₃ h₄ h₅ h₆) : + (⟨f, h₁, h₂, h₃, h₄, h₅, h₆⟩ : A →⋆ₐ[R] B) = f := +by { ext, refl, } + +section +variables (R A) +/-- The identity as a `star_alg_hom`. -/ +protected def id : A →⋆ₐ[R] A := { map_star' := λ x, rfl, .. alg_hom.id _ _ } +@[simp] lemma coe_id : ⇑(star_alg_hom.id R A) = id := rfl +end + +instance : inhabited (A →⋆ₐ[R] A) := ⟨star_alg_hom.id R A⟩ + +/-- The composition of ⋆-algebra homomorphisms, as a ⋆-algebra homomorphism. -/ +def comp (f : B →⋆ₐ[R] C) (g : A →⋆ₐ[R] B) : A →⋆ₐ[R] C := +{ map_star' := by simp only [map_star, alg_hom.to_fun_eq_coe, alg_hom.coe_comp, coe_to_alg_hom, + function.comp_app, eq_self_iff_true, forall_const], + .. f.to_alg_hom.comp g.to_alg_hom } + +@[simp] lemma coe_comp (f : B →⋆ₐ[R] C) (g : A →⋆ₐ[R] B) : ⇑(comp f g) = f ∘ g := rfl + +@[simp] lemma comp_apply (f : B →⋆ₐ[R] C) (g : A →⋆ₐ[R] B) (a : A) : comp f g a = f (g a) := rfl + +@[simp] lemma comp_assoc (f : C →⋆ₐ[R] D) (g : B →⋆ₐ[R] C) (h : A →⋆ₐ[R] B) : + (f.comp g).comp h = f.comp (g.comp h) := rfl + +@[simp] lemma id_comp (f : A →⋆ₐ[R] B) : (star_alg_hom.id _ _).comp f = f := ext $ λ _, rfl + +@[simp] lemma comp_id (f : A →⋆ₐ[R] B) : f.comp (star_alg_hom.id _ _) = f := ext $ λ _, rfl + +instance : monoid (A →⋆ₐ[R] A) := +{ mul := comp, + mul_assoc := comp_assoc, + one := star_alg_hom.id R A, + one_mul := id_comp, + mul_one := comp_id } + +/-- A unital morphism of ⋆-algebras is a `non_unital_star_alg_hom`. -/ +def to_non_unital_star_alg_hom (f : A →⋆ₐ[R] B) : A →⋆ₙₐ[R] B := +{ map_smul' := map_smul f, .. f, } + +@[simp] lemma coe_to_non_unital_star_alg_hom (f : A →⋆ₐ[R] B) : + (f.to_non_unital_star_alg_hom : A → B) = f := +rfl + +end star_alg_hom + +end unital + +/-! ### Operations on the product type + +Note that this is copied from [`algebra/hom/non_unital_alg`](non_unital_alg). -/ + +namespace non_unital_star_alg_hom + +section prod + +variables (R A B C : Type*) [monoid R] + [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [has_star A] + [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [has_star B] + [non_unital_non_assoc_semiring C] [distrib_mul_action R C] [has_star C] + +/-- The first projection of a product is a non-unital ⋆-algebra homomoprhism. -/ +@[simps] +def fst : A × B →⋆ₙₐ[R] A := +{ map_star' := λ x, rfl, .. non_unital_alg_hom.fst R A B } + +/-- The second projection of a product is a non-unital ⋆-algebra homomorphism. -/ +@[simps] +def snd : A × B →⋆ₙₐ[R] B := +{ map_star' := λ x, rfl, .. non_unital_alg_hom.snd R A B } + +variables {R A B C} + +/-- The `pi.prod` of two morphisms is a morphism. -/ +@[simps] def prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : (A →⋆ₙₐ[R] B × C) := +{ map_star' := λ x, by simp [map_star, prod.star_def], + .. f.to_non_unital_alg_hom.prod g.to_non_unital_alg_hom } + +lemma coe_prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : ⇑(f.prod g) = pi.prod f g := rfl + +@[simp] theorem fst_prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : + (fst R B C).comp (prod f g) = f := by ext; refl + +@[simp] theorem snd_prod (f : A →⋆ₙₐ[R] B) (g : A →⋆ₙₐ[R] C) : + (snd R B C).comp (prod f g) = g := by ext; refl + +@[simp] theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 := +fun_like.coe_injective pi.prod_fst_snd + +/-- Taking the product of two maps with the same domain is equivalent to taking the product of +their codomains. -/ +@[simps] def prod_equiv : ((A →⋆ₙₐ[R] B) × (A →⋆ₙₐ[R] C)) ≃ (A →⋆ₙₐ[R] B × C) := +{ to_fun := λ f, f.1.prod f.2, + inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f), + left_inv := λ f, by ext; refl, + right_inv := λ f, by ext; refl } + +end prod + +section inl_inr + +variables (R A B C : Type*) [monoid R] + [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [star_add_monoid A] + [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [star_add_monoid B] + [non_unital_non_assoc_semiring C] [distrib_mul_action R C] [star_add_monoid C] + +/-- The left injection into a product is a non-unital algebra homomorphism. -/ +def inl : A →⋆ₙₐ[R] A × B := prod 1 0 + +/-- The right injection into a product is a non-unital algebra homomorphism. -/ +def inr : B →⋆ₙₐ[R] A × B := prod 0 1 + +variables {R A B} + +@[simp] theorem coe_inl : (inl R A B : A → A × B) = λ x, (x, 0) := rfl +theorem inl_apply (x : A) : inl R A B x = (x, 0) := rfl + +@[simp] theorem coe_inr : (inr R A B : B → A × B) = prod.mk 0 := rfl +theorem inr_apply (x : B) : inr R A B x = (0, x) := rfl + +end inl_inr + +end non_unital_star_alg_hom + +namespace star_alg_hom + +variables (R A B C : Type*) [comm_semiring R] + [semiring A] [algebra R A] [has_star A] + [semiring B] [algebra R B] [has_star B] + [semiring C] [algebra R C] [has_star C] + +/-- The first projection of a product is a ⋆-algebra homomoprhism. -/ +@[simps] +def fst : A × B →⋆ₐ[R] A := +{ map_star' := λ x, rfl, .. alg_hom.fst R A B } + +/-- The second projection of a product is a ⋆-algebra homomorphism. -/ +@[simps] +def snd : A × B →⋆ₐ[R] B := +{ map_star' := λ x, rfl, .. alg_hom.snd R A B } + +variables {R A B C} + +/-- The `pi.prod` of two morphisms is a morphism. -/ +@[simps] def prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : (A →⋆ₐ[R] B × C) := +{ map_star' := λ x, by simp [prod.star_def, map_star], + .. f.to_alg_hom.prod g.to_alg_hom } + +lemma coe_prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : ⇑(f.prod g) = pi.prod f g := rfl + +@[simp] theorem fst_prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : + (fst R B C).comp (prod f g) = f := by ext; refl + +@[simp] theorem snd_prod (f : A →⋆ₐ[R] B) (g : A →⋆ₐ[R] C) : + (snd R B C).comp (prod f g) = g := by ext; refl + +@[simp] theorem prod_fst_snd : prod (fst R A B) (snd R A B) = 1 := +fun_like.coe_injective pi.prod_fst_snd + +/-- Taking the product of two maps with the same domain is equivalent to taking the product of +their codomains. -/ +@[simps] def prod_equiv : ((A →⋆ₐ[R] B) × (A →⋆ₐ[R] C)) ≃ (A →⋆ₐ[R] B × C) := +{ to_fun := λ f, f.1.prod f.2, + inv_fun := λ f, ((fst _ _ _).comp f, (snd _ _ _).comp f), + left_inv := λ f, by ext; refl, + right_inv := λ f, by ext; refl } + +end star_alg_hom + +/-! ### Star algebra equivalences -/ + +/-- A *⋆-algebra* equivalence is an equivalence preserving addition, multiplication, scalar +multiplication and the star operation, which allows for considering both unital and non-unital +equivalences with a single structure. Currently, `alg_equiv` requires unital algebras, which is +why this structure does not extend it. -/ +structure star_alg_equiv (R A B : Type*) [has_add A] [has_mul A] [has_smul R A] [has_star A] + [has_add B] [has_mul B] [has_smul R B] [has_star B] extends A ≃+* B := +(map_star' : ∀ a : A, to_fun (star a) = star (to_fun a)) +(map_smul' : ∀ (r : R) (a : A), to_fun (r • a) = r • to_fun a) + +infixr ` ≃⋆ₐ `:25 := star_alg_equiv _ +notation A ` ≃⋆ₐ[`:25 R `] ` B := star_alg_equiv R A B + +/-- Reinterpret a star algebra equivalence as a `ring_equiv` by forgetting the interaction with +the star operation and scalar multiplication. -/ +add_decl_doc star_alg_equiv.to_ring_equiv + +/-- `star_alg_equiv_class F R A B` asserts `F` is a type of bundled ⋆-algebra equivalences between +`A` and `B`. + +You should also extend this typeclass when you extend `star_alg_equiv`. -/ +class star_alg_equiv_class (F : Type*) (R : out_param Type*) (A : out_param Type*) + (B : out_param Type*) [has_add A] [has_mul A] [has_smul R A] [has_star A] [has_add B] [has_mul B] + [has_smul R B] [has_star B] extends ring_equiv_class F A B := +(map_star : ∀ (f : F) (a : A), f (star a) = star (f a)) +(map_smul : ∀ (f : F) (r : R) (a : A), f (r • a) = r • f a) + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] star_alg_equiv_class.to_ring_equiv_class + +namespace star_alg_equiv_class + +@[priority 50] -- See note [lower instance priority] +instance {F R A B : Type*} [has_add A] [has_mul A] [has_smul R A] [has_star A] [has_add B] + [has_mul B] [has_smul R B] [has_star B] [hF : star_alg_equiv_class F R A B] : + star_hom_class F A B := +{ coe := λ f, f, + coe_injective' := fun_like.coe_injective, + .. hF } + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] star_alg_equiv_class.star_hom_class + +@[priority 50] -- See note [lower instance priority] +instance {F R A B : Type*} [has_add A] [has_mul A] [has_star A] [has_smul R A] [has_add B] + [has_mul B] [has_smul R B] [has_star B] [hF : star_alg_equiv_class F R A B] : + smul_hom_class F R A B := +{ coe := λ f, f, + coe_injective' := fun_like.coe_injective, + .. hF } + +-- `R` becomes a metavariable but that's fine because it's an `out_param` +attribute [nolint dangerous_instance] star_alg_equiv_class.smul_hom_class + +@[priority 100] -- See note [lower instance priority] +instance {F R A B : Type*} [monoid R] [non_unital_non_assoc_semiring A] [distrib_mul_action R A] + [has_star A] [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [has_star B] + [hF : star_alg_equiv_class F R A B] : non_unital_star_alg_hom_class F R A B := +{ coe := λ f, f, + coe_injective' := fun_like.coe_injective, + map_zero := map_zero, + .. hF } + +@[priority 100] -- See note [lower instance priority] +instance (F R A B : Type*) [comm_semiring R] [semiring A] [algebra R A] [has_star A] + [semiring B] [algebra R B] [has_star B] [hF : star_alg_equiv_class F R A B] : + star_alg_hom_class F R A B := +{ coe := λ f, f, + coe_injective' := fun_like.coe_injective, + map_one := map_one, + map_zero := map_zero, + commutes := λ f r, by simp only [algebra.algebra_map_eq_smul_one, map_smul, map_one], + .. hF} + +end star_alg_equiv_class + +namespace star_alg_equiv + +section basic + +variables {F R A B C : Type*} + [has_add A] [has_mul A] [has_smul R A] [has_star A] + [has_add B] [has_mul B] [has_smul R B] [has_star B] + [has_add C] [has_mul C] [has_smul R C] [has_star C] + +instance : star_alg_equiv_class (A ≃⋆ₐ[R] B) R A B := +{ coe := to_fun, + inv := inv_fun, + left_inv := left_inv, + right_inv := right_inv, + coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' }, + map_mul := map_mul', + map_add := map_add', + map_star := map_star', + map_smul := map_smul' } + +/-- Helper instance for when there's too many metavariables to apply +`fun_like.has_coe_to_fun` directly. -/ +instance : has_coe_to_fun (A ≃⋆ₐ[R] B) (λ _, A → B) := ⟨star_alg_equiv.to_fun⟩ + +@[ext] +lemma ext {f g : A ≃⋆ₐ[R] B} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h + +lemma ext_iff {f g : A ≃⋆ₐ[R] B} : f = g ↔ ∀ a, f a = g a := fun_like.ext_iff + +/-- Star algebra equivalences are reflexive. -/ +@[refl] def refl : A ≃⋆ₐ[R] A := +{ map_smul' := λ r a, rfl, map_star' := λ a, rfl, ..ring_equiv.refl A } + +instance : inhabited (A ≃⋆ₐ[R] A) := ⟨refl⟩ + +@[simp] lemma coe_refl : ⇑(refl : A ≃⋆ₐ[R] A) = id := rfl + +/-- Star algebra equivalences are symmetric. -/ +@[symm] +def symm (e : A ≃⋆ₐ[R] B) : B ≃⋆ₐ[R] A := +{ map_star' := λ b, by simpa only [e.left_inv (star (e.inv_fun b)), e.right_inv b] + using congr_arg e.inv_fun (e.map_star' (e.inv_fun b)).symm, + map_smul' := λ r b, by simpa only [e.left_inv (r • e.inv_fun b), e.right_inv b] + using congr_arg e.inv_fun (e.map_smul' r (e.inv_fun b)).symm, + ..e.to_ring_equiv.symm, } + +/-- See Note [custom simps projection] -/ +def simps.symm_apply (e : A ≃⋆ₐ[R] B) : B → A := e.symm + +initialize_simps_projections star_alg_equiv (to_fun → apply, inv_fun → simps.symm_apply) + +@[simp] lemma inv_fun_eq_symm {e : A ≃⋆ₐ[R] B} : e.inv_fun = e.symm := rfl + +@[simp] lemma symm_symm (e : A ≃⋆ₐ[R] B) : e.symm.symm = e := +by { ext, refl, } + +lemma symm_bijective : function.bijective (symm : (A ≃⋆ₐ[R] B) → (B ≃⋆ₐ[R] A)) := +equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩ + +@[simp] lemma mk_coe' (e : A ≃⋆ₐ[R] B) (f h₁ h₂ h₃ h₄ h₅ h₆) : + (⟨f, e, h₁, h₂, h₃, h₄, h₅, h₆⟩ : B ≃⋆ₐ[R] A) = e.symm := +symm_bijective.injective $ ext $ λ x, rfl + +@[simp] lemma symm_mk (f f') (h₁ h₂ h₃ h₄ h₅ h₆) : + (⟨f, f', h₁, h₂, h₃, h₄, h₅, h₆⟩ : A ≃⋆ₐ[R] B).symm = + { to_fun := f', inv_fun := f, + ..(⟨f, f', h₁, h₂, h₃, h₄, h₅, h₆⟩ : A ≃⋆ₐ[R] B).symm } := rfl + +@[simp] lemma refl_symm : (star_alg_equiv.refl : A ≃⋆ₐ[R] A).symm = star_alg_equiv.refl := rfl + +-- should be a `simp` lemma, but causes a linter timeout +lemma to_ring_equiv_symm (f : A ≃⋆ₐ[R] B) : (f : A ≃+* B).symm = f.symm := rfl + +@[simp] lemma symm_to_ring_equiv (e : A ≃⋆ₐ[R] B) : (e.symm : B ≃+* A) = (e : A ≃+* B).symm := rfl + +/-- Star algebra equivalences are transitive. -/ +@[trans] +def trans (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) : A ≃⋆ₐ[R] C := +{ map_smul' := λ r a, show e₂.to_fun (e₁.to_fun (r • a)) = r • e₂.to_fun (e₁.to_fun a), + by rw [e₁.map_smul', e₂.map_smul'], + map_star' := λ a, show e₂.to_fun (e₁.to_fun (star a)) = star (e₂.to_fun (e₁.to_fun a)), + by rw [e₁.map_star', e₂.map_star'], + ..(e₁.to_ring_equiv.trans e₂.to_ring_equiv), } + +@[simp] lemma apply_symm_apply (e : A ≃⋆ₐ[R] B) : ∀ x, e (e.symm x) = x := + e.to_ring_equiv.apply_symm_apply + +@[simp] lemma symm_apply_apply (e : A ≃⋆ₐ[R] B) : ∀ x, e.symm (e x) = x := + e.to_ring_equiv.symm_apply_apply + +@[simp] lemma symm_trans_apply (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) (x : C) : + (e₁.trans e₂).symm x = e₁.symm (e₂.symm x) := rfl + +@[simp] lemma coe_trans (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) : + ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl + +@[simp] lemma trans_apply (e₁ : A ≃⋆ₐ[R] B) (e₂ : B ≃⋆ₐ[R] C) (x : A) : + (e₁.trans e₂) x = e₂ (e₁ x) := rfl + +theorem left_inverse_symm (e : A ≃⋆ₐ[R] B) : function.left_inverse e.symm e := e.left_inv + +theorem right_inverse_symm (e : A ≃⋆ₐ[R] B) : function.right_inverse e.symm e := e.right_inv + +end basic + +section bijective + +variables {F G R A B : Type*} [monoid R] +variables [non_unital_non_assoc_semiring A] [distrib_mul_action R A] [has_star A] +variables [non_unital_non_assoc_semiring B] [distrib_mul_action R B] [has_star B] +variables [hF : non_unital_star_alg_hom_class F R A B] [non_unital_star_alg_hom_class G R B A] +include hF + +/-- If a (unital or non-unital) star algebra morphism has an inverse, it is an isomorphism of +star algebras. -/ +@[simps] def of_star_alg_hom (f : F) (g : G) (h₁ : ∀ x, g (f x) = x) (h₂ : ∀ x, f (g x) = x) : + A ≃⋆ₐ[R] B := +{ to_fun := f, + inv_fun := g, + left_inv := h₁, + right_inv := h₂, + map_add' := map_add f, + map_mul' := map_mul f, + map_smul' := map_smul f, + map_star' := map_star f } + +/-- Promote a bijective star algebra homomorphism to a star algebra equivalence. -/ +noncomputable def of_bijective (f : F) (hf : function.bijective f) : A ≃⋆ₐ[R] B := +{ to_fun := f, + map_star' := map_star f, + map_smul' := map_smul f, + .. ring_equiv.of_bijective f (hf : function.bijective (f : A → B)), } + +@[simp] lemma coe_of_bijective {f : F} (hf : function.bijective f) : + (star_alg_equiv.of_bijective f hf : A → B) = f := rfl + +lemma of_bijective_apply {f : F} (hf : function.bijective f) (a : A) : + (star_alg_equiv.of_bijective f hf) a = f a := rfl + +end bijective + +end star_alg_equiv diff --git a/src/algebra/star/subalgebra.lean b/src/algebra/star/subalgebra.lean index 7bf003398f68e..7356d1122fe09 100644 --- a/src/algebra/star/subalgebra.lean +++ b/src/algebra/star/subalgebra.lean @@ -1,14 +1,20 @@ /- Copyright (c) 2022 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison +Authors: Scott Morrison, Jireh Loreaux -/ -import algebra.star.basic +import algebra.star.star_alg_hom import algebra.algebra.subalgebra.basic +import algebra.star.pointwise +import algebra.star.module +import ring_theory.adjoin.basic /-! # Star subalgebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A *-subalgebra is a subalgebra of a *-algebra which is closed under *. The centralizer of a *-closed set is a *-subalgebra. @@ -30,24 +36,208 @@ Forgetting that a *-subalgebra is closed under *. -/ add_decl_doc star_subalgebra.to_subalgebra -variables (R : Type u) (A : Type v) [comm_semiring R] [star_ring R] - [semiring A] [star_ring A] [algebra R A] [star_module R A] +variables {F R A B C : Type*} [comm_semiring R] [star_ring R] +variables [semiring A] [star_ring A] [algebra R A] [star_module R A] +variables [semiring B] [star_ring B] [algebra R B] [star_module R B] +variables [semiring C] [star_ring C] [algebra R C] [star_module R C] instance : set_like (star_subalgebra R A) A := ⟨star_subalgebra.carrier, λ p q h, by cases p; cases q; congr'⟩ -instance : has_top (star_subalgebra R A) := -⟨{ star_mem' := by tidy, ..(⊤ : subalgebra R A) }⟩ +instance : star_mem_class (star_subalgebra R A) A := +{ star_mem := λ s a, s.star_mem' } -instance : inhabited (star_subalgebra R A) := ⟨⊤⟩ +instance : subsemiring_class (star_subalgebra R A) A := +{ add_mem := add_mem', + mul_mem := mul_mem', + one_mem := one_mem', + zero_mem := zero_mem' } + +instance {R A} [comm_ring R] [star_ring R] [ring A] [star_ring A] [algebra R A] [star_module R A] : + subring_class (star_subalgebra R A) A := +{ neg_mem := λ s a ha, show -a ∈ s.to_subalgebra, from neg_mem ha } + +-- this uses the `has_star` instance `s` inherits from `star_mem_class (star_subalgebra R A) A` +instance (s : star_subalgebra R A) : star_ring s := +{ star := star, + star_involutive := λ r, subtype.ext (star_star r), + star_mul := λ r₁ r₂, subtype.ext (star_mul r₁ r₂), + star_add := λ r₁ r₂, subtype.ext (star_add r₁ r₂) } + +instance (s : star_subalgebra R A) : algebra R s := s.to_subalgebra.algebra' + +instance (s : star_subalgebra R A) : star_module R s := +{ star_smul := λ r a, subtype.ext (star_smul r a) } + +@[simp] +lemma mem_carrier {s : star_subalgebra R A} {x : A} : x ∈ s.carrier ↔ x ∈ s := iff.rfl + +@[ext] theorem ext {S T : star_subalgebra R A} (h : ∀ x : A, x ∈ S ↔ x ∈ T) : S = T := +set_like.ext h + +@[simp] lemma mem_to_subalgebra {S : star_subalgebra R A} {x} : x ∈ S.to_subalgebra ↔ x ∈ S := +iff.rfl + +@[simp] lemma coe_to_subalgebra (S : star_subalgebra R A) : (S.to_subalgebra : set A) = S := rfl + +theorem to_subalgebra_injective : + function.injective (to_subalgebra : star_subalgebra R A → subalgebra R A) := +λ S T h, ext $ λ x, by rw [← mem_to_subalgebra, ← mem_to_subalgebra, h] + +theorem to_subalgebra_inj {S U : star_subalgebra R A} : S.to_subalgebra = U.to_subalgebra ↔ S = U := +to_subalgebra_injective.eq_iff + +lemma to_subalgebra_le_iff {S₁ S₂ : star_subalgebra R A} : + S₁.to_subalgebra ≤ S₂.to_subalgebra ↔ S₁ ≤ S₂ := iff.rfl + +/-- Copy of a star subalgebra with a new `carrier` equal to the old one. Useful to fix definitional +equalities. -/ +protected def copy (S : star_subalgebra R A) (s : set A) (hs : s = ↑S) : star_subalgebra R A := +{ carrier := s, + add_mem' := λ _ _, hs.symm ▸ S.add_mem', + mul_mem' := λ _ _, hs.symm ▸ S.mul_mem', + algebra_map_mem' := hs.symm ▸ S.algebra_map_mem', + star_mem' := λ _, hs.symm ▸ S.star_mem' } + +@[simp] lemma coe_copy (S : star_subalgebra R A) (s : set A) (hs : s = ↑S) : + (S.copy s hs : set A) = s := rfl + +lemma copy_eq (S : star_subalgebra R A) (s : set A) (hs : s = ↑S) : S.copy s hs = S := +set_like.coe_injective hs + +variables (S : star_subalgebra R A) + +theorem algebra_map_mem (r : R) : algebra_map R A r ∈ S := +S.algebra_map_mem' r + +theorem srange_le : (algebra_map R A).srange ≤ S.to_subalgebra.to_subsemiring := +λ x ⟨r, hr⟩, hr ▸ S.algebra_map_mem r + +theorem range_subset : set.range (algebra_map R A) ⊆ S := +λ x ⟨r, hr⟩, hr ▸ S.algebra_map_mem r + +theorem range_le : set.range (algebra_map R A) ≤ S := +S.range_subset + +protected theorem smul_mem {x : A} (hx : x ∈ S) (r : R) : r • x ∈ S := +(algebra.smul_def r x).symm ▸ mul_mem (S.algebra_map_mem r) hx + +/-- Embedding of a subalgebra into the algebra. -/ +def subtype : S →⋆ₐ[R] A := +by refine_struct { to_fun := (coe : S → A) }; intros; refl + +@[simp] lemma coe_subtype : (S.subtype : S → A) = coe := rfl + +lemma subtype_apply (x : S) : S.subtype x = (x : A) := rfl + +@[simp] lemma to_subalgebra_subtype : S.to_subalgebra.val = S.subtype.to_alg_hom := +rfl + +/-- The inclusion map between `star_subalgebra`s given by `subtype.map id` as a `star_alg_hom`. -/ +@[simps] def inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) : S₁ →⋆ₐ[R] S₂ := +{ to_fun := subtype.map id h, + map_one' := rfl, + map_mul' := λ x y, rfl, + map_zero' := rfl, + map_add' := λ x y, rfl, + commutes' := λ z, rfl, + map_star' := λ x, rfl } + +lemma inclusion_injective {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) : + function.injective $ inclusion h := +set.inclusion_injective h + +@[simp] lemma subtype_comp_inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) : + S₂.subtype.comp (inclusion h) = S₁.subtype := +rfl + +section map + +/-- Transport a star subalgebra via a star algebra homomorphism. -/ +def map (f : A →⋆ₐ[R] B) (S : star_subalgebra R A) : star_subalgebra R B := +{ star_mem' := + begin + rintro _ ⟨a, ha, rfl⟩, + exact map_star f a ▸ set.mem_image_of_mem _ (S.star_mem' ha), + end, + .. S.to_subalgebra.map f.to_alg_hom } + +lemma map_mono {S₁ S₂ : star_subalgebra R A} {f : A →⋆ₐ[R] B} : + S₁ ≤ S₂ → S₁.map f ≤ S₂.map f := +set.image_subset f + +lemma map_injective {f : A →⋆ₐ[R] B} (hf : function.injective f) : + function.injective (map f) := +λ S₁ S₂ ih, ext $ set.ext_iff.1 $ set.image_injective.2 hf $ set.ext $ set_like.ext_iff.mp ih + +@[simp] lemma map_id (S : star_subalgebra R A) : S.map (star_alg_hom.id R A) = S := +set_like.coe_injective $ set.image_id _ + +lemma map_map (S : star_subalgebra R A) (g : B →⋆ₐ[R] C) (f : A →⋆ₐ[R] B) : + (S.map f).map g = S.map (g.comp f) := +set_like.coe_injective $ set.image_image _ _ _ + +lemma mem_map {S : star_subalgebra R A} {f : A →⋆ₐ[R] B} {y : B} : + y ∈ map f S ↔ ∃ x ∈ S, f x = y := +subsemiring.mem_map + +lemma map_to_subalgebra {S : star_subalgebra R A} {f : A →⋆ₐ[R] B} : + (S.map f).to_subalgebra = S.to_subalgebra.map f.to_alg_hom := +set_like.coe_injective rfl + +@[simp] lemma coe_map (S : star_subalgebra R A) (f : A →⋆ₐ[R] B) : + (S.map f : set B) = f '' S := +rfl + +/-- Preimage of a star subalgebra under an star algebra homomorphism. -/ +def comap (f : A →⋆ₐ[R] B) (S : star_subalgebra R B) : star_subalgebra R A := +{ star_mem' := λ a ha, show f (star a) ∈ S, from (map_star f a).symm ▸ star_mem ha, + .. S.to_subalgebra.comap f.to_alg_hom } + +theorem map_le_iff_le_comap {S : star_subalgebra R A} {f : A →⋆ₐ[R] B} {U : star_subalgebra R B} : + map f S ≤ U ↔ S ≤ comap f U := +set.image_subset_iff + +lemma gc_map_comap (f : A →⋆ₐ[R] B) : galois_connection (map f) (comap f) := +λ S U, map_le_iff_le_comap + +lemma comap_mono {S₁ S₂ : star_subalgebra R B} {f : A →⋆ₐ[R] B} : + S₁ ≤ S₂ → S₁.comap f ≤ S₂.comap f := +set.preimage_mono + +lemma comap_injective {f : A →⋆ₐ[R] B} (hf : function.surjective f) : + function.injective (comap f) := +λ S₁ S₂ h, ext $ λ b, let ⟨x, hx⟩ := hf b in let this := set_like.ext_iff.1 h x in hx ▸ this + +@[simp] lemma comap_id (S : star_subalgebra R A) : S.comap (star_alg_hom.id R A) = S := +set_like.coe_injective $ set.preimage_id + +lemma comap_comap (S : star_subalgebra R C) (g : B →⋆ₐ[R] C) (f : A →⋆ₐ[R] B) : + (S.comap g).comap f = S.comap (g.comp f) := +set_like.coe_injective $ set.preimage_preimage + +@[simp] lemma mem_comap (S : star_subalgebra R B) (f : A →⋆ₐ[R] B) (x : A) : + x ∈ S.comap f ↔ f x ∈ S := +iff.rfl + +@[simp, norm_cast] lemma coe_comap (S : star_subalgebra R B) (f : A →⋆ₐ[R] B) : + (S.comap f : set A) = f ⁻¹' (S : set B) := +rfl + +end map section centralizer -variables {A} +variables (R) {A} + +lemma _root_.set.star_mem_centralizer {a : A} {s : set A} + (h : ∀ (a : A), a ∈ s → star a ∈ s) (ha : a ∈ set.centralizer s) : + star a ∈ set.centralizer s := +λ y hy, by simpa using congr_arg star (ha _ (h _ hy)).symm /-- The centralizer, or commutant, of a *-closed set as star subalgebra. -/ def centralizer (s : set A) (w : ∀ (a : A), a ∈ s → star a ∈ s) : star_subalgebra R A := -{ star_mem' := λ x xm y hy, by simpa using congr_arg star (xm _ (w _ hy)).symm, +{ star_mem' := λ x, set.star_mem_centralizer w, ..subalgebra.centralizer R s, } @[simp] @@ -66,3 +256,375 @@ set.centralizer_subset h end centralizer end star_subalgebra + +/-! ### The star closure of a subalgebra -/ + +namespace subalgebra + +open_locale pointwise + +variables {F R A B : Type*} [comm_semiring R] [star_ring R] +variables [semiring A] [algebra R A] [star_ring A] [star_module R A] +variables [semiring B] [algebra R B] [star_ring B] [star_module R B] + +/-- The pointwise `star` of a subalgebra is a subalgebra. -/ +instance : has_involutive_star (subalgebra R A) := +{ star := λ S, + { carrier := star S.carrier, + mul_mem' := λ x y hx hy, + begin + simp only [set.mem_star, subalgebra.mem_carrier] at *, + exact (star_mul x y).symm ▸ mul_mem hy hx, + end, + one_mem' := set.mem_star.mp ((star_one A).symm ▸ one_mem S : star (1 : A) ∈ S), + add_mem' := λ x y hx hy, + begin + simp only [set.mem_star, subalgebra.mem_carrier] at *, + exact (star_add x y).symm ▸ add_mem hx hy, + end, + zero_mem' := set.mem_star.mp ((star_zero A).symm ▸ zero_mem S : star (0 : A) ∈ S), + algebra_map_mem' := λ r, by simpa only [set.mem_star, subalgebra.mem_carrier, + ←algebra_map_star_comm] using S.algebra_map_mem (star r) }, + star_involutive := λ S, subalgebra.ext $ λ x, ⟨λ hx, (star_star x ▸ hx), λ hx, + ((star_star x).symm ▸ hx : star (star x) ∈ S)⟩ } + +@[simp] lemma mem_star_iff (S : subalgebra R A) (x : A) : x ∈ star S ↔ star x ∈ S := iff.rfl +@[simp] lemma star_mem_star_iff (S : subalgebra R A) (x : A) : star x ∈ star S ↔ x ∈ S := +by simpa only [star_star] using mem_star_iff S (star x) +@[simp] lemma coe_star (S : subalgebra R A) : ((star S : subalgebra R A) : set A) = star S := rfl + +lemma star_mono : monotone (star : subalgebra R A → subalgebra R A) := λ _ _ h _ hx, h hx + +variables (R) + +/-- The star operation on `subalgebra` commutes with `algebra.adjoin`. -/ +lemma star_adjoin_comm (s : set A) : star (algebra.adjoin R s) = algebra.adjoin R (star s) := +have this : ∀ t : set A, algebra.adjoin R (star t) ≤ star (algebra.adjoin R t), + from λ t, algebra.adjoin_le (λ x hx, algebra.subset_adjoin hx), +le_antisymm (by simpa only [star_star] using subalgebra.star_mono (this (star s))) (this s) + +variables {R} + +/-- The `star_subalgebra` obtained from `S : subalgebra R A` by taking the smallest subalgebra +containing both `S` and `star S`. -/ +@[simps] def star_closure (S : subalgebra R A) : star_subalgebra R A := +{ star_mem' := λ a ha, + begin + simp only [subalgebra.mem_carrier, ←(@algebra.gi R A _ _ _).l_sup_u _ _] at *, + rw [←mem_star_iff _ a, star_adjoin_comm], + convert ha, + simp [set.union_comm], + end, + .. S ⊔ star S } + +lemma star_closure_le {S₁ : subalgebra R A} {S₂ : star_subalgebra R A} (h : S₁ ≤ S₂.to_subalgebra) : + S₁.star_closure ≤ S₂ := +star_subalgebra.to_subalgebra_le_iff.1 $ sup_le h $ + λ x hx, (star_star x ▸ star_mem (show star x ∈ S₂, from h $ (S₁.mem_star_iff _).1 hx) : x ∈ S₂) + +lemma star_closure_le_iff {S₁ : subalgebra R A} {S₂ : star_subalgebra R A} : + S₁.star_closure ≤ S₂ ↔ S₁ ≤ S₂.to_subalgebra := +⟨λ h, le_sup_left.trans h, star_closure_le⟩ + +end subalgebra + +/-! ### The star subalgebra generated by a set -/ + +namespace star_subalgebra + +variables {F R A B : Type*} [comm_semiring R] [star_ring R] +variables [semiring A] [algebra R A] [star_ring A] [star_module R A] +variables [semiring B] [algebra R B] [star_ring B] [star_module R B] + +variables (R) + +/-- The minimal star subalgebra that contains `s`. -/ +@[simps] def adjoin (s : set A) : star_subalgebra R A := +{ star_mem' := λ x hx, by rwa [subalgebra.mem_carrier, ←subalgebra.mem_star_iff, + subalgebra.star_adjoin_comm, set.union_star, star_star, set.union_comm], + .. (algebra.adjoin R (s ∪ star s)) } + +lemma adjoin_eq_star_closure_adjoin (s : set A) : adjoin R s = (algebra.adjoin R s).star_closure := +to_subalgebra_injective $ + show algebra.adjoin R (s ∪ star s) = algebra.adjoin R s ⊔ star (algebra.adjoin R s), + from (subalgebra.star_adjoin_comm R s).symm ▸ algebra.adjoin_union s (star s) + +lemma adjoin_to_subalgebra (s : set A) : + (adjoin R s).to_subalgebra = (algebra.adjoin R (s ∪ star s)) := rfl + +lemma subset_adjoin (s : set A) : s ⊆ adjoin R s := + (set.subset_union_left s (star s)).trans algebra.subset_adjoin + +lemma star_subset_adjoin (s : set A) : star s ⊆ adjoin R s := + (set.subset_union_right s (star s)).trans algebra.subset_adjoin + +lemma self_mem_adjoin_singleton (x : A) : x ∈ adjoin R ({x} : set A) := +algebra.subset_adjoin $ set.mem_union_left _ (set.mem_singleton x) + +lemma star_self_mem_adjoin_singleton (x : A) : star x ∈ adjoin R ({x} : set A) := +star_mem $ self_mem_adjoin_singleton R x + +variables {R} + +protected lemma gc : galois_connection (adjoin R : set A → star_subalgebra R A) coe := +begin + intros s S, + rw [←to_subalgebra_le_iff, adjoin_to_subalgebra, algebra.adjoin_le_iff, coe_to_subalgebra], + exact ⟨λ h, (set.subset_union_left s _).trans h, + λ h, set.union_subset h $ λ x hx, star_star x ▸ star_mem (show star x ∈ S, from h hx)⟩, +end + +/-- Galois insertion between `adjoin` and `coe`. -/ +protected def gi : galois_insertion (adjoin R : set A → star_subalgebra R A) coe := +{ choice := λ s hs, (adjoin R s).copy s $ le_antisymm (star_subalgebra.gc.le_u_l s) hs, + gc := star_subalgebra.gc, + le_l_u := λ S, (star_subalgebra.gc (S : set A) (adjoin R S)).1 $ le_rfl, + choice_eq := λ _ _, star_subalgebra.copy_eq _ _ _ } + +lemma adjoin_le {S : star_subalgebra R A} {s : set A} (hs : s ⊆ S) : adjoin R s ≤ S := +star_subalgebra.gc.l_le hs + +lemma adjoin_le_iff {S : star_subalgebra R A} {s : set A} : adjoin R s ≤ S ↔ s ⊆ S := +star_subalgebra.gc _ _ + +lemma _root_.subalgebra.star_closure_eq_adjoin (S : subalgebra R A) : + S.star_closure = adjoin R (S : set A) := +le_antisymm (subalgebra.star_closure_le_iff.2 $ subset_adjoin R (S : set A)) + (adjoin_le (le_sup_left : S ≤ S ⊔ star S)) + +/-- If some predicate holds for all `x ∈ (s : set A)` and this predicate is closed under the +`algebra_map`, addition, multiplication and star operations, then it holds for `a ∈ adjoin R s`. -/ +lemma adjoin_induction {s : set A} {p : A → Prop} {a : A} (h : a ∈ adjoin R s) + (Hs : ∀ (x : A), x ∈ s → p x) (Halg : ∀ (r : R), p (algebra_map R A r)) + (Hadd : ∀ (x y : A), p x → p y → p (x + y)) (Hmul : ∀ (x y : A), p x → p y → p (x * y)) + (Hstar : ∀ (x : A), p x → p (star x)) : p a := +algebra.adjoin_induction h (λ x hx, hx.elim (λ hx, Hs x hx) (λ hx, star_star x ▸ Hstar _ (Hs _ hx))) + Halg Hadd Hmul + +lemma adjoin_induction₂ {s : set A} {p : A → A → Prop} {a b : A} (ha : a ∈ adjoin R s) + (hb : b ∈ adjoin R s) (Hs : ∀ (x : A), x ∈ s → ∀ (y : A), y ∈ s → p x y) + (Halg : ∀ (r₁ r₂ : R), p (algebra_map R A r₁) (algebra_map R A r₂)) + (Halg_left : ∀ (r : R) (x : A), x ∈ s → p (algebra_map R A r) x) + (Halg_right : ∀ (r : R) (x : A), x ∈ s → p x (algebra_map R A r)) + (Hadd_left : ∀ (x₁ x₂ y : A), p x₁ y → p x₂ y → p (x₁ + x₂) y) + (Hadd_right : ∀ (x y₁ y₂ : A), p x y₁ → p x y₂ → p x (y₁ + y₂)) + (Hmul_left : ∀ (x₁ x₂ y : A), p x₁ y → p x₂ y → p (x₁ * x₂) y) + (Hmul_right : ∀ (x y₁ y₂ : A), p x y₁ → p x y₂ → p x (y₁ * y₂)) + (Hstar : ∀ (x y : A), p x y → p (star x) (star y)) + (Hstar_left : ∀ (x y : A), p x y → p (star x) y) + (Hstar_right : ∀ (x y : A), p x y → p x (star y)) : p a b := +begin + refine algebra.adjoin_induction₂ ha hb (λ x hx y hy, _) Halg (λ r x hx, _) (λ r x hx, _) + Hadd_left Hadd_right Hmul_left Hmul_right, + { cases hx; cases hy, + exacts [Hs x hx y hy, star_star y ▸ Hstar_right _ _ (Hs _ hx _ hy), + star_star x ▸ Hstar_left _ _ (Hs _ hx _ hy), + star_star x ▸ star_star y ▸ Hstar _ _ (Hs _ hx _ hy)] }, + { cases hx, exacts [Halg_left _ _ hx, star_star x ▸ Hstar_right _ _ (Halg_left r _ hx)] }, + { cases hx, exacts [Halg_right _ _ hx, star_star x ▸ Hstar_left _ _ (Halg_right r _ hx)] }, +end + +/-- The difference with `star_subalgebra.adjoin_induction` is that this acts on the subtype. -/ +lemma adjoin_induction' {s : set A} {p : adjoin R s → Prop} (a : adjoin R s) + (Hs : ∀ x (h : x ∈ s), p ⟨x, subset_adjoin R s h⟩) + (Halg : ∀ r, p (algebra_map R _ r)) (Hadd : ∀ x y, p x → p y → p (x + y)) + (Hmul : ∀ x y, p x → p y → p (x * y)) (Hstar : ∀ x, p x → p (star x)) : p a := +subtype.rec_on a $ λ b hb, +begin + refine exists.elim _ (λ (hb : b ∈ adjoin R s) (hc : p ⟨b, hb⟩), hc), + apply adjoin_induction hb, + exacts [λ x hx, ⟨subset_adjoin R s hx, Hs x hx⟩, + λ r, ⟨star_subalgebra.algebra_map_mem _ r, Halg r⟩, + (λ x y hx hy, exists.elim hx $ λ hx' hx, + exists.elim hy $ λ hy' hy, ⟨add_mem hx' hy', Hadd _ _ hx hy⟩), + (λ x y hx hy, exists.elim hx $ λ hx' hx, + exists.elim hy $ λ hy' hy, ⟨mul_mem hx' hy', Hmul _ _ hx hy⟩), + λ x hx, exists.elim hx (λ hx' hx, ⟨star_mem hx', Hstar _ hx⟩)] +end + +variables (R) + +/-- If all elements of `s : set A` commute pairwise and also commute pairwise with elements of +`star s`, then `star_subalgebra.adjoin R s` is commutative. See note [reducible non-instances]. -/ +@[reducible] +def adjoin_comm_semiring_of_comm {s : set A} + (hcomm : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * b = b * a) + (hcomm_star : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * star b = star b * a) : + comm_semiring (adjoin R s) := +{ mul_comm := + begin + rintro ⟨x, hx⟩ ⟨y, hy⟩, + ext, + simp only [set_like.coe_mk, mul_mem_class.mk_mul_mk], + rw [←mem_to_subalgebra, adjoin_to_subalgebra] at hx hy, + letI : comm_semiring (algebra.adjoin R (s ∪ star s)) := algebra.adjoin_comm_semiring_of_comm R + begin + intros a ha b hb, + cases ha; cases hb, + exacts [hcomm _ ha _ hb, star_star b ▸ hcomm_star _ ha _ hb, + star_star a ▸ (hcomm_star _ hb _ ha).symm, + by simpa only [star_mul, star_star] using congr_arg star (hcomm _ hb _ ha)], + end, + exact congr_arg coe (mul_comm (⟨x, hx⟩ : algebra.adjoin R (s ∪ star s)) ⟨y, hy⟩), + end, + ..(adjoin R s).to_subalgebra.to_semiring } + +/-- If all elements of `s : set A` commute pairwise and also commute pairwise with elements of +`star s`, then `star_subalgebra.adjoin R s` is commutative. See note [reducible non-instances]. -/ +@[reducible] +def adjoin_comm_ring_of_comm (R : Type u) {A : Type v} [comm_ring R] [star_ring R] + [ring A] [algebra R A] [star_ring A] [star_module R A] {s : set A} + (hcomm : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * b = b * a) + (hcomm_star : ∀ (a : A), a ∈ s → ∀ (b : A), b ∈ s → a * star b = star b * a) : + comm_ring (adjoin R s) := +{ ..star_subalgebra.adjoin_comm_semiring_of_comm R hcomm hcomm_star, + ..(adjoin R s).to_subalgebra.to_ring } + +/-- The star subalgebra `star_subalgebra.adjoin R {x}` generated by a single `x : A` is commutative +if `x` is normal. -/ +instance adjoin_comm_semiring_of_is_star_normal (x : A) [is_star_normal x] : + comm_semiring (adjoin R ({x} : set A)) := +adjoin_comm_semiring_of_comm R + (λ a ha b hb, by { rw [set.mem_singleton_iff] at ha hb, rw [ha, hb] }) + (λ a ha b hb, + by { rw [set.mem_singleton_iff] at ha hb, simpa only [ha, hb] using (star_comm_self' x).symm }) + +/-- The star subalgebra `star_subalgebra.adjoin R {x}` generated by a single `x : A` is commutative +if `x` is normal. -/ +instance adjoin_comm_ring_of_is_star_normal (R : Type u) {A : Type v} [comm_ring R] [star_ring R] + [ring A] [algebra R A] [star_ring A] [star_module R A] (x : A) [is_star_normal x] : + comm_ring (adjoin R ({x} : set A)) := +{ mul_comm := mul_comm, ..(adjoin R ({x} : set A)).to_subalgebra.to_ring } + +/-! ### Complete lattice structure -/ + +variables {F R A B} + +instance : complete_lattice (star_subalgebra R A) := +galois_insertion.lift_complete_lattice star_subalgebra.gi + +instance : inhabited (star_subalgebra R A) := ⟨⊤⟩ + +@[simp] +lemma coe_top : (↑(⊤ : star_subalgebra R A) : set A) = set.univ := rfl + +@[simp] lemma mem_top {x : A} : x ∈ (⊤ : star_subalgebra R A) := +set.mem_univ x + +@[simp] lemma top_to_subalgebra : (⊤ : star_subalgebra R A).to_subalgebra = ⊤ := rfl + +@[simp] lemma to_subalgebra_eq_top {S : star_subalgebra R A} : S.to_subalgebra = ⊤ ↔ S = ⊤ := +star_subalgebra.to_subalgebra_injective.eq_iff' top_to_subalgebra + +lemma mem_sup_left {S T : star_subalgebra R A} : ∀ {x : A}, x ∈ S → x ∈ S ⊔ T := +show S ≤ S ⊔ T, from le_sup_left + +lemma mem_sup_right {S T : star_subalgebra R A} : ∀ {x : A}, x ∈ T → x ∈ S ⊔ T := +show T ≤ S ⊔ T, from le_sup_right + +lemma mul_mem_sup {S T : star_subalgebra R A} {x y : A} (hx : x ∈ S) (hy : y ∈ T) : + x * y ∈ S ⊔ T := +mul_mem (mem_sup_left hx) (mem_sup_right hy) + +lemma map_sup (f : A →⋆ₐ[R] B) (S T : star_subalgebra R A) : map f (S ⊔ T) = map f S ⊔ map f T := +(star_subalgebra.gc_map_comap f).l_sup + +@[simp, norm_cast] +lemma coe_inf (S T : star_subalgebra R A) : (↑(S ⊓ T) : set A) = S ∩ T := rfl + +@[simp] +lemma mem_inf {S T : star_subalgebra R A} {x : A} : x ∈ S ⊓ T ↔ x ∈ S ∧ x ∈ T := iff.rfl + +@[simp] lemma inf_to_subalgebra (S T : star_subalgebra R A) : + (S ⊓ T).to_subalgebra = S.to_subalgebra ⊓ T.to_subalgebra := rfl + +@[simp, norm_cast] +lemma coe_Inf (S : set (star_subalgebra R A)) : (↑(Inf S) : set A) = ⋂ s ∈ S, ↑s := Inf_image + +lemma mem_Inf {S : set (star_subalgebra R A)} {x : A} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := +by simp only [← set_like.mem_coe, coe_Inf, set.mem_Inter₂] + +@[simp] lemma Inf_to_subalgebra (S : set (star_subalgebra R A)) : + (Inf S).to_subalgebra = Inf (star_subalgebra.to_subalgebra '' S) := +set_like.coe_injective $ by simp + +@[simp, norm_cast] +lemma coe_infi {ι : Sort*} {S : ι → star_subalgebra R A} : (↑(⨅ i, S i) : set A) = ⋂ i, S i := +by simp [infi] + +lemma mem_infi {ι : Sort*} {S : ι → star_subalgebra R A} {x : A} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i := +by simp only [infi, mem_Inf, set.forall_range_iff] + +@[simp] lemma infi_to_subalgebra {ι : Sort*} (S : ι → star_subalgebra R A) : + (⨅ i, S i).to_subalgebra = ⨅ i, (S i).to_subalgebra := +set_like.coe_injective $ by simp + +lemma bot_to_subalgebra : (⊥ : star_subalgebra R A).to_subalgebra = ⊥ := +by { change algebra.adjoin R (∅ ∪ star ∅) = algebra.adjoin R ∅, simp } + +theorem mem_bot {x : A} : x ∈ (⊥ : star_subalgebra R A) ↔ x ∈ set.range (algebra_map R A) := +by rw [←mem_to_subalgebra, bot_to_subalgebra, algebra.mem_bot] + +@[simp] theorem coe_bot : ((⊥ : star_subalgebra R A) : set A) = set.range (algebra_map R A) := +by simp [set.ext_iff, mem_bot] + +theorem eq_top_iff {S : star_subalgebra R A} : + S = ⊤ ↔ ∀ x : A, x ∈ S := +⟨λ h x, by rw h; exact mem_top, λ h, by ext x; exact ⟨λ _, mem_top, λ _, h x⟩⟩ + +end star_subalgebra + +namespace star_alg_hom +open star_subalgebra + +variables {F R A B : Type*} [comm_semiring R] [star_ring R] +variables [semiring A] [algebra R A] [star_ring A] [star_module R A] +variables [semiring B] [algebra R B] [star_ring B] +variables [hF : star_alg_hom_class F R A B] (f g : F) + +include hF + +/-- The equalizer of two star `R`-algebra homomorphisms. -/ +def equalizer : star_subalgebra R A := +{ carrier := {a | f a = g a}, + mul_mem' := λ a b (ha : f a = g a) (hb : f b = g b), + by rw [set.mem_set_of_eq, map_mul f, map_mul g, ha, hb], + add_mem' := λ a b (ha : f a = g a) (hb : f b = g b), + by rw [set.mem_set_of_eq, map_add f, map_add g, ha, hb], + algebra_map_mem' := λ r, by simp only [set.mem_set_of_eq, alg_hom_class.commutes], + star_mem' := λ a (ha : f a = g a), by rw [set.mem_set_of_eq, map_star f, map_star g, ha] } + +@[simp] lemma mem_equalizer (x : A) : x ∈ star_alg_hom.equalizer f g ↔ f x = g x := iff.rfl + +lemma adjoin_le_equalizer {s : set A} (h : s.eq_on f g) : adjoin R s ≤ star_alg_hom.equalizer f g := +adjoin_le h + +lemma ext_of_adjoin_eq_top {s : set A} + (h : adjoin R s = ⊤) ⦃f g : F⦄ (hs : s.eq_on f g) : f = g := +fun_like.ext f g $ λ x, star_alg_hom.adjoin_le_equalizer f g hs $ h.symm ▸ trivial + +omit hF + +lemma map_adjoin [star_module R B] (f : A →⋆ₐ[R] B) (s : set A) : + map f (adjoin R s) = adjoin R (f '' s) := +galois_connection.l_comm_of_u_comm set.image_preimage (gc_map_comap f) star_subalgebra.gc + star_subalgebra.gc (λ _, rfl) + +lemma ext_adjoin {s : set A} [star_alg_hom_class F R (adjoin R s) B] {f g : F} + (h : ∀ x : adjoin R s, (x : A) ∈ s → f x = g x) : f = g := +begin + refine fun_like.ext f g (λ a, adjoin_induction' a (λ x hx, _) (λ r, _) (λ x y hx hy, _) + (λ x y hx hy, _) (λ x hx, _)), + { exact h ⟨x, subset_adjoin R s hx⟩ hx }, + { simp only [alg_hom_class.commutes] }, + { rw [map_add, map_add, hx, hy] }, + { rw [map_mul, map_mul, hx, hy] }, + { rw [map_star, map_star, hx] }, +end + +lemma ext_adjoin_singleton {a : A} [star_alg_hom_class F R (adjoin R ({a} : set A)) B] {f g : F} + (h : f ⟨a, self_mem_adjoin_singleton R a⟩ = g ⟨a, self_mem_adjoin_singleton R a⟩) : f = g := +ext_adjoin $ λ x hx, (show x = ⟨a, self_mem_adjoin_singleton R a⟩, + from subtype.ext $ set.mem_singleton_iff.mp hx).symm ▸ h + +end star_alg_hom diff --git a/src/algebra/star/unitary.lean b/src/algebra/star/unitary.lean index 026a343eaafb3..e06dc567dd283 100644 --- a/src/algebra/star/unitary.lean +++ b/src/algebra/star/unitary.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Shing Tak Lam, Frédéric Dupuis -/ import algebra.star.basic -import group_theory.submonoid.membership +import group_theory.submonoid.operations /-! # Unitary elements of a star monoid +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `unitary R`, where `R` is a star monoid, as the submonoid made of the elements that satisfy `star U * U = 1` and `U * star U = 1`, and these form a group. This includes, for instance, unitary operators on Hilbert spaces. @@ -113,7 +116,7 @@ section group_with_zero variables [group_with_zero R] [star_semigroup R] @[norm_cast] lemma coe_inv (U : unitary R) : ↑(U⁻¹) = (U⁻¹ : R) := -eq_inv_of_mul_right_eq_one (coe_mul_star_self _) +eq_inv_of_mul_eq_one_right $ coe_mul_star_self _ @[norm_cast] lemma coe_div (U₁ U₂ : unitary R) : ↑(U₁ / U₂) = (U₁ / U₂ : R) := by simp only [div_eq_mul_inv, coe_inv, submonoid.coe_mul] @@ -136,10 +139,7 @@ instance : has_neg (unitary R) := @[norm_cast] lemma coe_neg (U : unitary R) : ↑(-U) = (-U : R) := rfl instance : has_distrib_neg (unitary R) := -{ neg := has_neg.neg, - neg_neg := λ U, subtype.ext $ neg_neg _, - neg_mul := λ U₁ U₂, subtype.ext $ neg_mul _ _, - mul_neg := λ U₁ U₂, subtype.ext $ mul_neg _ _ } +subtype.coe_injective.has_distrib_neg _ coe_neg (unitary R).coe_mul end ring diff --git a/src/algebra/support.lean b/src/algebra/support.lean index 9b9b9dc8198b0..2ecb97cc95cca 100644 --- a/src/algebra/support.lean +++ b/src/algebra/support.lean @@ -3,15 +3,20 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import order.conditionally_complete_lattice +import order.conditionally_complete_lattice.basic +import data.set.finite import algebra.big_operators.basic import algebra.group.prod import algebra.group.pi -import algebra.module.pi +import algebra.module.basic +import group_theory.group_action.pi /-! # Support of a function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `function.support f = {x | f x ≠ 0}` and prove its basic properties. We also define `function.mul_support f = {x | f x ≠ 1}`. -/ @@ -54,9 +59,14 @@ iff.rfl mul_support f ⊆ s ↔ ∀ x ∉ s, f x = 1 := forall_congr $ λ x, not_imp_comm +@[to_additive] lemma mul_support_eq_iff {f : α → M} {s : set α} : + mul_support f = s ↔ ((∀ x, x ∈ s → f x ≠ 1) ∧ (∀ x, x ∉ s → f x = 1)) := +by simp only [set.ext_iff, mem_mul_support, ne.def, imp_not_comm, ← forall_and_distrib, + ← iff_def, ← xor_iff_not_iff', ← xor_iff_iff_not] + @[to_additive] lemma mul_support_disjoint_iff {f : α → M} {s : set α} : disjoint (mul_support f) s ↔ eq_on f 1 s := -by simp_rw [disjoint_iff_subset_compl_right, mul_support_subset_iff', not_mem_compl_iff, eq_on, +by simp_rw [←subset_compl_iff_disjoint_right, mul_support_subset_iff', not_mem_compl_iff, eq_on, pi.one_apply] @[to_additive] lemma disjoint_mul_support_iff {f : α → M} {s : set α} : @@ -69,17 +79,13 @@ by { simp_rw [← subset_empty_iff, mul_support_subset_iff', funext_iff], simp } @[simp, to_additive] lemma mul_support_nonempty_iff {f : α → M} : (mul_support f).nonempty ↔ f ≠ 1 := -by rw [← ne_empty_iff_nonempty, ne.def, mul_support_eq_empty_iff] +by rw [nonempty_iff_ne_empty, ne.def, mul_support_eq_empty_iff] @[to_additive] lemma range_subset_insert_image_mul_support (f : α → M) : range f ⊆ insert 1 (f '' mul_support f) := -begin - intros y hy, - rcases eq_or_ne y 1 with rfl|h2y, - { exact mem_insert _ _ }, - { obtain ⟨x, rfl⟩ := hy, refine mem_insert_of_mem _ ⟨x, h2y, rfl⟩ } -end +by simpa only [range_subset_iff, mem_insert_iff, or_iff_not_imp_left] + using λ x (hx : x ∈ mul_support f), mem_image_of_mem f hx @[simp, to_additive] lemma mul_support_one' : mul_support (1 : α → M) = ∅ := mul_support_eq_empty_iff.2 rfl @@ -94,9 +100,7 @@ by { ext x, simp [hc] } @[to_additive] lemma mul_support_binop_subset (op : M → N → P) (op1 : op 1 1 = 1) (f : α → M) (g : α → N) : mul_support (λ x, op (f x) (g x)) ⊆ mul_support f ∪ mul_support g := -λ x hx, classical.by_cases - (λ hf : f x = 1, or.inr $ λ hg, hx $ by simp only [hf, hg, op1]) - or.inl +λ x hx, not_or_of_imp (λ hf hg, hx $ by simp only [hf, hg, op1]) @[to_additive] lemma mul_support_sup [semilattice_sup M] (f g : α → M) : mul_support (λ x, f x ⊔ g x) ⊆ mul_support f ∪ mul_support g := @@ -149,7 +153,7 @@ rfl @[to_additive support_prod_mk] lemma mul_support_prod_mk (f : α → M) (g : α → N) : mul_support (λ x, (f x, g x)) = mul_support f ∪ mul_support g := -set.ext $ λ x, by simp only [mul_support, not_and_distrib, mem_union_eq, mem_set_of_eq, +set.ext $ λ x, by simp only [mul_support, not_and_distrib, mem_union, mem_set_of_eq, prod.mk_eq_one, ne.def] @[to_additive support_prod_mk'] lemma mul_support_prod_mk' (f : α → M × N) : @@ -176,37 +180,65 @@ mul_support_binop_subset (*) (one_mul _) f g begin induction n with n hfn, { simpa only [pow_zero, mul_support_one] using empty_subset _ }, - { simpa only [pow_succ] - using subset_trans (mul_support_mul f _) (union_subset (subset.refl _) hfn) } + { simpa only [pow_succ] using (mul_support_mul f _).trans (union_subset subset.rfl hfn) } end -@[simp, to_additive] lemma mul_support_inv [group G] (f : α → G) : - mul_support (λ x, (f x)⁻¹) = mul_support f := -set.ext $ λ x, not_congr inv_eq_one +section division_monoid +variables [division_monoid G] (f g : α → G) -@[simp, to_additive] lemma mul_support_inv' [group G] (f : α → G) : - mul_support (f⁻¹) = mul_support f := -mul_support_inv f +@[simp, to_additive] +lemma mul_support_inv : mul_support (λ x, (f x)⁻¹) = mul_support f := ext $ λ _, inv_ne_one -@[simp] lemma mul_support_inv₀ [group_with_zero G₀] (f : α → G₀) : - mul_support (λ x, (f x)⁻¹) = mul_support f := -set.ext $ λ x, not_congr inv_eq_one₀ +@[simp, to_additive] lemma mul_support_inv' : mul_support f⁻¹ = mul_support f := mul_support_inv f -@[to_additive] lemma mul_support_mul_inv [group G] (f g : α → G) : +@[to_additive] lemma mul_support_mul_inv : mul_support (λ x, f x * (g x)⁻¹) ⊆ mul_support f ∪ mul_support g := mul_support_binop_subset (λ a b, a * b⁻¹) (by simp) f g -@[to_additive support_sub] lemma mul_support_group_div [group G] (f g : α → G) : +@[to_additive] lemma mul_support_div : mul_support (λ x, f x / g x) ⊆ mul_support f ∪ mul_support g := -mul_support_binop_subset (/) (by simp only [one_div, one_inv]) f g +mul_support_binop_subset (/) one_div_one f g -lemma mul_support_div [group_with_zero G₀] (f g : α → G₀) : - mul_support (λ x, f x / g x) ⊆ mul_support f ∪ mul_support g := -mul_support_binop_subset (/) (by simp only [div_one]) f g +end division_monoid + +section zero_one +variables (R) [has_zero R] [has_one R] [ne_zero (1 : R)] + +@[simp] lemma support_one : support (1 : α → R) = univ := support_const one_ne_zero +@[simp] lemma mul_support_zero : mul_support (0 : α → R) = univ := mul_support_const zero_ne_one + +end zero_one + +section add_monoid_with_one +variables [add_monoid_with_one R] [char_zero R] {n : ℕ} + +lemma support_nat_cast (hn : n ≠ 0) : support (n : α → R) = univ := +support_const $ nat.cast_ne_zero.2 hn + +lemma mul_support_nat_cast (hn : n ≠ 1) : mul_support (n : α → R) = univ := +mul_support_const $ nat.cast_ne_one.2 hn + +end add_monoid_with_one + +section add_group_with_one +variables [add_group_with_one R] [char_zero R] {n : ℤ} + +lemma support_int_cast (hn : n ≠ 0) : support (n : α → R) = univ := +support_const $ int.cast_ne_zero.2 hn + +lemma mul_support_int_cast (hn : n ≠ 1) : mul_support (n : α → R) = univ := +mul_support_const $ int.cast_ne_one.2 hn + +end add_group_with_one + +lemma support_smul [has_zero R] [has_zero M] [smul_with_zero R M] [no_zero_smul_divisors R M] + (f : α → R) (g : α → M) : + support (f • g) = support f ∩ support g := +ext $ λ x, smul_ne_zero_iff @[simp] lemma support_mul [mul_zero_class R] [no_zero_divisors R] (f g : α → R) : support (λ x, f x * g x) = support f ∩ support g := -set.ext $ λ x, by simp only [mem_support, mul_ne_zero_iff, mem_inter_eq, not_or_distrib] +support_smul f g @[simp] lemma support_mul_subset_left [mul_zero_class R] (f g : α → R) : support (λ x, f x * g x) ⊆ support f := @@ -221,16 +253,11 @@ lemma support_smul_subset_right [add_monoid A] [monoid B] [distrib_mul_action B support (b • f) ⊆ support f := λ x hbf hf, hbf $ by rw [pi.smul_apply, hf, smul_zero] -lemma support_smul_subset_left [semiring R] [add_comm_monoid M] [module R M] - (f : α → R) (g : α → M) : +lemma support_smul_subset_left [has_zero M] [has_zero β] [smul_with_zero M β] + (f : α → M) (g : α → β) : support (f • g) ⊆ support f := λ x hfg hf, hfg $ by rw [pi.smul_apply', hf, zero_smul] -lemma support_smul [semiring R] [add_comm_monoid M] [module R M] - [no_zero_smul_divisors R M] (f : α → R) (g : α → M) : - support (f • g) = support f ∩ support g := -ext $ λ x, smul_ne_zero - lemma support_const_smul_of_ne_zero [semiring R] [add_comm_monoid M] [module R M] [no_zero_smul_divisors R M] (c : R) (g : α → M) (hc : c ≠ 0) : support (c • g) = support g := @@ -301,35 +328,27 @@ by rw [mul_support_comp_eq_preimage f g, image_inter_preimage] end set namespace pi -variables {A : Type*} {B : Type*} [decidable_eq A] [has_zero B] {a : A} {b : B} +variables {A : Type*} {B : Type*} [decidable_eq A] [has_one B] {a : A} {b : B} -lemma support_single_zero : function.support (pi.single a (0 : B)) = ∅ := by simp +open function -@[simp] lemma support_single_of_ne (h : b ≠ 0) : - function.support (pi.single a b) = {a} := -begin - ext, - simp only [mem_singleton_iff, ne.def, function.mem_support], - split, - { contrapose!, - exact λ h', single_eq_of_ne h' b }, - { rintro rfl, - rw single_eq_same, - exact h } -end +@[to_additive] lemma mul_support_mul_single_subset : mul_support (mul_single a b) ⊆ {a} := +λ x hx, by_contra $ λ hx', hx $ mul_single_eq_of_ne hx' _ -lemma support_single [decidable_eq B] : - function.support (pi.single a b) = if b = 0 then ∅ else {a} := by { split_ifs with h; simp [h] } +@[to_additive] lemma mul_support_mul_single_one : mul_support (mul_single a (1 : B)) = ∅ := +by simp -lemma support_single_subset : function.support (pi.single a b) ⊆ {a} := -begin - classical, - rw support_single, - split_ifs; simp -end +@[simp, to_additive] lemma mul_support_mul_single_of_ne (h : b ≠ 1) : + mul_support (mul_single a b) = {a} := +mul_support_mul_single_subset.antisymm $ + λ x (hx : x = a), by rwa [mem_mul_support, hx, mul_single_eq_same] + +@[to_additive] lemma mul_support_mul_single [decidable_eq B] : + mul_support (mul_single a b) = if b = 1 then ∅ else {a} := by { split_ifs with h; simp [h] } -lemma support_single_disjoint {b' : B} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : A} : - disjoint (function.support (single i b)) (function.support (single j b')) ↔ i ≠ j := -by rw [support_single_of_ne hb, support_single_of_ne hb', disjoint_singleton] +@[to_additive] +lemma mul_support_mul_single_disjoint {b' : B} (hb : b ≠ 1) (hb' : b' ≠ 1) {i j : A} : + disjoint (mul_support (mul_single i b)) (mul_support (mul_single j b')) ↔ i ≠ j := +by rw [mul_support_mul_single_of_ne hb, mul_support_mul_single_of_ne hb', disjoint_singleton] end pi diff --git a/src/algebra/symmetrized.lean b/src/algebra/symmetrized.lean index 40c1a004829e5..f4e94a886498f 100644 --- a/src/algebra/symmetrized.lean +++ b/src/algebra/symmetrized.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Christopher Hoskin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Christopher Hoskin -/ +import algebra.jordan.basic import algebra.module.basic -import tactic.abel /-! # Symmetrized algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A commutative multiplication on a real or complex space can be constructed from any multiplication by "symmetrization" i.e $$ @@ -42,28 +45,25 @@ variables {α : Type*} /-- The element of `sym_alg α` that represents `a : α`. -/ @[pattern,pp_nodot] -def sym : α → αˢʸᵐ := id +def sym : α ≃ αˢʸᵐ := equiv.refl _ /-- The element of `α` represented by `x : αˢʸᵐ`. -/ @[pp_nodot] -def unsym : αˢʸᵐ → α := id +def unsym : αˢʸᵐ ≃ α := equiv.refl _ @[simp] lemma unsym_sym (a : α) : unsym (sym a) = a := rfl @[simp] lemma sym_unsym (a : α) : sym (unsym a) = a := rfl - @[simp] lemma sym_comp_unsym : (sym : α → αˢʸᵐ) ∘ unsym = id := rfl @[simp] lemma unsym_comp_sym : (unsym : αˢʸᵐ → α) ∘ sym = id := rfl +@[simp] lemma sym_symm : (@sym α).symm = unsym := rfl +@[simp] lemma unsym_symm : (@unsym α).symm = sym := rfl -/-- The canonical bijection between `α` and `αˢʸᵐ`. -/ -@[simps apply symm_apply { fully_applied := ff }] -def sym_equiv : α ≃ αˢʸᵐ := ⟨sym, unsym, unsym_sym, sym_unsym⟩ - -lemma sym_bijective : bijective (sym : α → αˢʸᵐ) := sym_equiv.bijective -lemma unsym_bijective : bijective (unsym : αˢʸᵐ → α) := sym_equiv.symm.bijective -lemma sym_injective : injective (sym : α → αˢʸᵐ) := sym_bijective.injective -lemma sym_surjective : surjective (sym : α → αˢʸᵐ) := sym_bijective.surjective -lemma unsym_injective : injective (unsym : αˢʸᵐ → α) := unsym_bijective.injective -lemma unsym_surjective : surjective (unsym : αˢʸᵐ → α) := unsym_bijective.surjective +lemma sym_bijective : bijective (sym : α → αˢʸᵐ) := sym.bijective +lemma unsym_bijective : bijective (unsym : αˢʸᵐ → α) := unsym.symm.bijective +lemma sym_injective : injective (sym : α → αˢʸᵐ) := sym.injective +lemma sym_surjective : surjective (sym : α → αˢʸᵐ) := sym.surjective +lemma unsym_injective : injective (unsym : αˢʸᵐ → α) := unsym.injective +lemma unsym_surjective : surjective (unsym : αˢʸᵐ → α) := unsym.surjective @[simp] lemma sym_inj {a b : α} : sym a = sym b ↔ a = b := sym_injective.eq_iff @[simp] lemma unsym_inj {a b : αˢʸᵐ} : unsym a = unsym b ↔ a = b := unsym_injective.eq_iff @@ -92,7 +92,7 @@ instance [has_add α] [has_mul α] [has_one α] [invertible (2 : α)] : has_mul @[to_additive] instance [has_inv α] : has_inv αˢʸᵐ := { inv := λ a, sym $ (unsym a)⁻¹ } -instance (R : Type*) [has_scalar R α] : has_scalar R αˢʸᵐ := +instance (R : Type*) [has_smul R α] : has_smul R αˢʸᵐ := { smul := λ r a, sym (r • unsym a) } @[simp, to_additive] lemma sym_one [has_one α] : sym (1 : α) = 1 := rfl @@ -120,8 +120,8 @@ rfl @[simp, to_additive] lemma sym_inv [has_inv α] (a : α) : sym (a⁻¹) = (sym a)⁻¹ := rfl @[simp, to_additive] lemma unsym_inv [has_inv α] (a : αˢʸᵐ) : unsym (a⁻¹) = (unsym a)⁻¹ := rfl -@[simp] lemma sym_smul {R : Type*} [has_scalar R α] (c : R) (a : α) : sym (c • a) = c • sym a := rfl -@[simp] lemma unsym_smul {R : Type*} [has_scalar R α] (c : R) (a : αˢʸᵐ) : +@[simp] lemma sym_smul {R : Type*} [has_smul R α] (c : R) (a : α) : sym (c • a) = c • sym a := rfl +@[simp] lemma unsym_smul {R : Type*} [has_smul R α] (c : R) (a : αˢʸᵐ) : unsym (c • a) = c • unsym a := rfl @[simp, to_additive] lemma unsym_eq_one_iff [has_one α] (a : αˢʸᵐ) : a.unsym = 1 ↔ a = 1 := @@ -210,4 +210,33 @@ lemma mul_comm [has_mul α] [add_comm_semigroup α] [has_one α] [invertible (2 a * b = b * a := by rw [mul_def, mul_def, add_comm] + +instance [ring α] [invertible (2 : α)] : is_comm_jordan αˢʸᵐ := +{ mul_comm := sym_alg.mul_comm, + lmul_comm_rmul_rmul := λ a b, begin + -- Rearrange LHS + have commute_half_left := λ a : α, (commute.one_left a).bit0_left.inv_of_left.eq, + rw [mul_def, mul_def a b, unsym_sym, ← mul_assoc, ← commute_half_left (unsym (a*a)), mul_assoc, + mul_assoc, ← mul_add, ← mul_assoc, add_mul, mul_add (unsym (a * a)), ← add_assoc, ← mul_assoc, + ← mul_assoc], + + -- Rearrange RHS + nth_rewrite_rhs 0 [mul_def], + nth_rewrite_rhs 0 [mul_def], + nth_rewrite_rhs 2 [mul_def], + + rw [unsym_sym, sym_inj, ← mul_assoc, ← commute_half_left (unsym a), mul_assoc (⅟2) (unsym a), + mul_assoc (⅟2) _ (unsym a), ← mul_add, ← mul_assoc], + + nth_rewrite_rhs 0 mul_add (unsym a), + rw [add_mul, ← add_assoc, ← mul_assoc, ← mul_assoc], + + rw unsym_mul_self, + rw [← mul_assoc, ← mul_assoc, ← mul_assoc, ← mul_assoc, ← sub_eq_zero, ← mul_sub], + + convert mul_zero (⅟(2:α) * ⅟(2:α)), + rw [add_sub_add_right_eq_sub, add_assoc, add_assoc, add_sub_add_left_eq_sub, add_comm, + add_sub_add_right_eq_sub, sub_eq_zero], + end } + end sym_alg diff --git a/src/algebra/triv_sq_zero_ext.lean b/src/algebra/triv_sq_zero_ext.lean index 29181f505e075..f2ffc13cfe006 100644 --- a/src/algebra/triv_sq_zero_ext.lean +++ b/src/algebra/triv_sq_zero_ext.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2020 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kenny Lau +Authors: Kenny Lau, Eric Wieser -/ import algebra.algebra.basic @@ -10,12 +10,30 @@ import linear_algebra.prod /-! # Trivial Square-Zero Extension -Given a module `M` over a ring `R`, the trivial square-zero extension of `M` over `R` is defined -to be the `R`-algebra `R ⊕ M` with multiplication given by -`(r₁ + m₁) * (r₂ + m₂) = r₁ r₂ + r₁ m₂ + r₂ m₁`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given a ring `R` together with an `(R, R)`-bimodule `M`, the trivial square-zero extension of `M` +over `R` is defined to be the `R`-algebra `R ⊕ M` with multiplication given by +`(r₁ + m₁) * (r₂ + m₂) = r₁ r₂ + r₁ m₂ + m₁ r₂`. It is a square-zero extension because `M^2 = 0`. +Note that expressing this requires bimodules; we write these in general for a +not-necessarily-commutative `R` as: +```lean +variables {R M : Type*} [semiring R] [add_comm_monoid M] +variables [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] +``` +If we instead work with a commutative `R'` acting symmetrically on `M`, we write +```lean +variables {R' M : Type*} [comm_semiring R'] [add_comm_monoid M] +variables [module R' M] [module R'ᵐᵒᵖ M] [is_central_scalar R' M] +``` +noting that in this context `is_central_scalar R' M` implies `smul_comm_class R' R'ᵐᵒᵖ M`. + +Many of the later results in this file are only stated for the commutative `R'` for simplicity. + ## Main definitions * `triv_sq_zero_ext.inl`, `triv_sq_zero_ext.inr`: the canonical inclusions into @@ -45,8 +63,12 @@ R × M local notation `tsze` := triv_sq_zero_ext +open_locale big_operators + namespace triv_sq_zero_ext +open mul_opposite (op) + section basic variables {R : Type u} {M : Type v} @@ -66,6 +88,9 @@ x.1 def snd (x : tsze R M) : M := x.2 +@[simp] lemma fst_mk (r : R) (m : M) : fst (r, m) = r := rfl +@[simp] lemma snd_mk (r : R) (m : M) : snd (r, m) = m := rfl + @[ext] lemma ext {x y : tsze R M} (h1 : x.fst = y.fst) (h2 : x.snd = y.snd) : x = y := prod.ext h1 h2 @@ -73,12 +98,16 @@ section variables (M) @[simp] lemma fst_inl [has_zero M] (r : R) : (inl r : tsze R M).fst = r := rfl @[simp] lemma snd_inl [has_zero M] (r : R) : (inl r : tsze R M).snd = 0 := rfl +@[simp] lemma fst_comp_inl [has_zero M] : fst ∘ (inl : R → tsze R M) = id := rfl +@[simp] lemma snd_comp_inl [has_zero M] : snd ∘ (inl : R → tsze R M) = 0 := rfl end section variables (R) @[simp] lemma fst_inr [has_zero R] (m : M) : (inr m : tsze R M).fst = 0 := rfl @[simp] lemma snd_inr [has_zero R] (m : M) : (inr m : tsze R M).snd = m := rfl +@[simp] lemma fst_comp_inr [has_zero R] : fst ∘ (inr : M → tsze R M) = 0 := rfl +@[simp] lemma snd_comp_inr [has_zero R] : snd ∘ (inr : M → tsze R M) = id := rfl end lemma inl_injective [has_zero M] : function.injective (inl : R → tsze R M) := @@ -106,6 +135,9 @@ prod.has_zero instance [has_add R] [has_add M] : has_add (tsze R M) := prod.has_add +instance [has_sub R] [has_sub M] : has_sub (tsze R M) := +prod.has_sub + instance [has_neg R] [has_neg M] : has_neg (tsze R M) := prod.has_neg @@ -130,18 +162,18 @@ prod.add_comm_monoid instance [add_comm_group R] [add_comm_group M] : add_comm_group (tsze R M) := prod.add_comm_group -instance [has_scalar S R] [has_scalar S M] : has_scalar S (tsze R M) := -prod.has_scalar +instance [has_smul S R] [has_smul S M] : has_smul S (tsze R M) := +prod.has_smul -instance [has_scalar T R] [has_scalar T M] [has_scalar S R] [has_scalar S M] [has_scalar T S] +instance [has_smul T R] [has_smul T M] [has_smul S R] [has_smul S M] [has_smul T S] [is_scalar_tower T S R] [is_scalar_tower T S M] : is_scalar_tower T S (tsze R M) := prod.is_scalar_tower -instance [has_scalar T R] [has_scalar T M] [has_scalar S R] [has_scalar S M] +instance [has_smul T R] [has_smul T M] [has_smul S R] [has_smul S M] [smul_comm_class T S R] [smul_comm_class T S M] : smul_comm_class T S (tsze R M) := prod.smul_comm_class -instance [has_scalar S R] [has_scalar S M] [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ M] +instance [has_smul S R] [has_smul S M] [has_smul Sᵐᵒᵖ R] [has_smul Sᵐᵒᵖ M] [is_central_scalar S R] [is_central_scalar S M] : is_central_scalar S (tsze R M) := prod.is_central_scalar @@ -167,11 +199,22 @@ prod.module @[simp] lemma fst_neg [has_neg R] [has_neg M] (x : tsze R M) : (-x).fst = -x.fst := rfl @[simp] lemma snd_neg [has_neg R] [has_neg M] (x : tsze R M) : (-x).snd = -x.snd := rfl -@[simp] lemma fst_smul [has_scalar S R] [has_scalar S M] (s : S) (x : tsze R M) : +@[simp] lemma fst_sub [has_sub R] [has_sub M] (x₁ x₂ : tsze R M) : + (x₁ - x₂).fst = x₁.fst - x₂.fst := rfl +@[simp] lemma snd_sub [has_sub R] [has_sub M] (x₁ x₂ : tsze R M) : + (x₁ - x₂).snd = x₁.snd - x₂.snd := rfl + +@[simp] lemma fst_smul [has_smul S R] [has_smul S M] (s : S) (x : tsze R M) : (s • x).fst = s • x.fst := rfl -@[simp] lemma snd_smul [has_scalar S R] [has_scalar S M] (s : S) (x : tsze R M) : +@[simp] lemma snd_smul [has_smul S R] [has_smul S M] (s : S) (x : tsze R M) : (s • x).snd = s • x.snd := rfl +lemma fst_sum {ι} [add_comm_monoid R] [add_comm_monoid M] (s : finset ι) (f : ι → tsze R M) : + (∑ i in s, f i).fst = ∑ i in s, (f i).fst := prod.fst_sum + +lemma snd_sum {ι} [add_comm_monoid R] [add_comm_monoid M] (s : finset ι) (f : ι → tsze R M) : + (∑ i in s, f i).snd = ∑ i in s, (f i).snd := prod.snd_sum + section variables (M) @@ -181,14 +224,22 @@ variables (M) (inl (r₁ + r₂) : tsze R M) = inl r₁ + inl r₂ := ext rfl (add_zero 0).symm -@[simp] lemma inl_neg [has_neg R] [add_group M] (r : R) : +@[simp] lemma inl_neg [has_neg R] [sub_neg_zero_monoid M] (r : R) : (inl (-r) : tsze R M) = -inl r := ext rfl neg_zero.symm -@[simp] lemma inl_smul [monoid S] [add_monoid M] [has_scalar S R] [distrib_mul_action S M] +@[simp] lemma inl_sub [has_sub R] [sub_neg_zero_monoid M] (r₁ r₂ : R) : + (inl (r₁ - r₂) : tsze R M) = inl r₁ - inl r₂ := +ext rfl (sub_zero _).symm + +@[simp] lemma inl_smul [monoid S] [add_monoid M] [has_smul S R] [distrib_mul_action S M] (s : S) (r : R) : (inl (s • r) : tsze R M) = s • inl r := ext rfl (smul_zero s).symm +lemma inl_sum {ι} [add_comm_monoid R] [add_comm_monoid M] (s : finset ι) (f : ι → R) : + (inl (∑ i in s, f i) : tsze R M) = ∑ i in s, inl (f i) := +(linear_map.inl ℕ _ _).map_sum + end section @@ -200,13 +251,21 @@ variables (R) (inr (m₁ + m₂) : tsze R M) = inr m₁ + inr m₂ := ext (add_zero 0).symm rfl -@[simp] lemma inr_neg [add_group R] [has_neg M] (m : M) : +@[simp] lemma inr_neg [sub_neg_zero_monoid R] [has_neg M] (m : M) : (inr (-m) : tsze R M) = -inr m := ext neg_zero.symm rfl -@[simp] lemma inr_smul [has_zero R] [has_zero S] [smul_with_zero S R] [has_scalar S M] +@[simp] lemma inr_sub [sub_neg_zero_monoid R] [has_sub M] (m₁ m₂ : M) : + (inr (m₁ - m₂) : tsze R M) = inr m₁ - inr m₂ := +ext (sub_zero _).symm rfl + +@[simp] lemma inr_smul [has_zero R] [has_zero S] [smul_with_zero S R] [has_smul S M] (r : S) (m : M) : (inr (r • m) : tsze R M) = r • inr m := -ext (smul_zero' _ _).symm rfl +ext (smul_zero _).symm rfl + +lemma inr_sum {ι} [add_comm_monoid R] [add_comm_monoid M] (s : finset ι) (f : ι → M) : + (inr (∑ i in s, f i) : tsze R M) = ∑ i in s, inr (f i) := +(linear_map.inr ℕ _ _).map_sum end @@ -252,27 +311,29 @@ variables {R : Type u} {M : Type v} instance [has_one R] [has_zero M] : has_one (tsze R M) := ⟨(1, 0)⟩ -instance [has_mul R] [has_add M] [has_scalar R M] : has_mul (tsze R M) := -⟨λ x y, (x.1 * y.1, x.1 • y.2 + y.1 • x.2)⟩ +instance [has_mul R] [has_add M] [has_smul R M] [has_smul Rᵐᵒᵖ M] : has_mul (tsze R M) := +⟨λ x y, (x.1 * y.1, x.1 • y.2 + op y.1 • x.2)⟩ @[simp] lemma fst_one [has_one R] [has_zero M] : (1 : tsze R M).fst = 1 := rfl @[simp] lemma snd_one [has_one R] [has_zero M] : (1 : tsze R M).snd = 0 := rfl -@[simp] lemma fst_mul [has_mul R] [has_add M] [has_scalar R M] (x₁ x₂ : tsze R M) : +@[simp] lemma fst_mul [has_mul R] [has_add M] [has_smul R M] [has_smul Rᵐᵒᵖ M] (x₁ x₂ : tsze R M) : (x₁ * x₂).fst = x₁.fst * x₂.fst := rfl -@[simp] lemma snd_mul [has_mul R] [has_add M] [has_scalar R M] (x₁ x₂ : tsze R M) : - (x₁ * x₂).snd = x₁.fst • x₂.snd + x₂.fst • x₁.snd := rfl +@[simp] lemma snd_mul [has_mul R] [has_add M] [has_smul R M] [has_smul Rᵐᵒᵖ M] (x₁ x₂ : tsze R M) : + (x₁ * x₂).snd = x₁.fst • x₂.snd + op x₂.fst • x₁.snd := rfl section variables (M) @[simp] lemma inl_one [has_one R] [has_zero M] : (inl 1 : tsze R M) = 1 := rfl -@[simp] lemma inl_mul [monoid R] [add_monoid M] [distrib_mul_action R M] (r₁ r₂ : R) : +@[simp] lemma inl_mul [monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] (r₁ r₂ : R) : (inl (r₁ * r₂) : tsze R M) = inl r₁ * inl r₂ := -ext rfl $ show (0 : M) = r₁ • 0 + r₂ • 0, by rw [smul_zero, zero_add, smul_zero] +ext rfl $ show (0 : M) = r₁ • 0 + op r₂ • 0, by rw [smul_zero, zero_add, smul_zero] -lemma inl_mul_inl [monoid R] [add_monoid M] [distrib_mul_action R M] (r₁ r₂ : R) : +lemma inl_mul_inl [monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] (r₁ r₂ : R) : (inl r₁ * inl r₂ : tsze R M) = inl (r₁ * r₂) := (inl_mul M r₁ r₂).symm @@ -281,65 +342,221 @@ end section variables (R) -@[simp] lemma inr_mul_inr [semiring R] [add_comm_monoid M] [module R M] (m₁ m₂ : M) : +@[simp] lemma inr_mul_inr [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M] + (m₁ m₂ : M) : (inr m₁ * inr m₂ : tsze R M) = 0 := -ext (mul_zero _) $ show (0 : R) • m₂ + (0 : R) • m₁ = 0, by rw [zero_smul, zero_add, zero_smul] +ext (mul_zero _) $ show (0 : R) • m₂ + (0 : Rᵐᵒᵖ) • m₁ = 0, by rw [zero_smul, zero_add, zero_smul] end -lemma inl_mul_inr [semiring R] [add_comm_monoid M] [module R M] (r : R) (m : M) : +lemma inl_mul_inr [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M] (r : R) (m : M) : (inl r * inr m : tsze R M) = inr (r • m) := -ext (mul_zero r) $ show r • m + (0 : R) • 0 = r • m, by rw [smul_zero, add_zero] +ext (mul_zero r) $ show r • m + (0 : Rᵐᵒᵖ) • 0 = r • m, by rw [smul_zero, add_zero] -lemma inr_mul_inl [semiring R] [add_comm_monoid M] [module R M] (r : R) (m : M) : - (inr m * inl r : tsze R M) = inr (r • m) := -ext (zero_mul r) $ show (0 : R) • 0 + r • m = r • m, by rw [smul_zero, zero_add] +lemma inr_mul_inl [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M] (r : R) (m : M) : + (inr m * inl r : tsze R M) = inr (op r • m) := +ext (zero_mul r) $ show (0 : R) • 0 + op r • m = op r • m, by rw [smul_zero, zero_add] -instance [monoid R] [add_monoid M] [distrib_mul_action R M] : mul_one_class (tsze R M) := -{ one_mul := λ x, ext (one_mul x.1) $ show (1 : R) • x.2 + x.1 • 0 = x.2, +instance [monoid R] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] : + mul_one_class (tsze R M) := +{ one_mul := λ x, ext (one_mul x.1) $ show (1 : R) • x.2 + op x.1 • 0 = x.2, by rw [one_smul, smul_zero, add_zero], - mul_one := λ x, ext (mul_one x.1) $ show (x.1 • 0 : M) + (1 : R) • x.2 = x.2, + mul_one := λ x, ext (mul_one x.1) $ show (x.1 • 0 : M) + (1 : Rᵐᵒᵖ) • x.2 = x.2, by rw [smul_zero, zero_add, one_smul], .. triv_sq_zero_ext.has_one, .. triv_sq_zero_ext.has_mul } -instance [semiring R] [add_comm_monoid M] [module R M] : non_assoc_semiring (tsze R M) := -{ zero_mul := λ x, ext (zero_mul x.1) $ show (0 : R) • x.2 + x.1 • 0 = 0, +instance [add_monoid_with_one R] [add_monoid M] : add_monoid_with_one (tsze R M) := +{ nat_cast := λ n, inl n, + nat_cast_zero := by simp [nat.cast], + nat_cast_succ := λ _, by ext; simp [nat.cast], + .. triv_sq_zero_ext.add_monoid, + .. triv_sq_zero_ext.has_one } + +@[simp] lemma fst_nat_cast [add_monoid_with_one R] [add_monoid M] (n : ℕ) : + (n : tsze R M).fst = n := rfl +@[simp] lemma snd_nat_cast [add_monoid_with_one R] [add_monoid M] (n : ℕ) : + (n : tsze R M).snd = 0 := rfl +@[simp] lemma inl_nat_cast [add_monoid_with_one R] [add_monoid M] (n : ℕ) : + (inl n : tsze R M) = n := rfl + +instance [add_group_with_one R] [add_group M] : add_group_with_one (tsze R M) := +{ int_cast := λ z, inl z, + int_cast_of_nat := λ n, ext (int.cast_coe_nat _) rfl, + int_cast_neg_succ_of_nat := λ n, ext (int.cast_neg_succ_of_nat _) neg_zero.symm, + .. triv_sq_zero_ext.add_group, + .. triv_sq_zero_ext.add_monoid_with_one } + +@[simp] lemma fst_int_cast [add_group_with_one R] [add_group M] (z : ℤ) : + (z : tsze R M).fst = z := rfl +@[simp] lemma snd_int_cast [add_group_with_one R] [add_group M] (z : ℤ) : + (z : tsze R M).snd = 0 := rfl +@[simp] lemma inl_int_cast [add_group_with_one R] [add_group M] (z : ℤ) : + (inl z : tsze R M) = z := rfl + +instance [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M] : + non_assoc_semiring (tsze R M) := +{ zero_mul := λ x, ext (zero_mul x.1) $ show (0 : R) • x.2 + op x.1 • 0 = 0, by rw [zero_smul, zero_add, smul_zero], - mul_zero := λ x, ext (mul_zero x.1) $ show (x.1 • 0 : M) + (0 : R) • x.2 = 0, + mul_zero := λ x, ext (mul_zero x.1) $ show (x.1 • 0 : M) + (0 : Rᵐᵒᵖ) • x.2 = 0, by rw [smul_zero, zero_add, zero_smul], left_distrib := λ x₁ x₂ x₃, ext (mul_add x₁.1 x₂.1 x₃.1) $ - show x₁.1 • (x₂.2 + x₃.2) + (x₂.1 + x₃.1) • x₁.2 = - x₁.1 • x₂.2 + x₂.1 • x₁.2 + (x₁.1 • x₃.2 + x₃.1 • x₁.2), + show x₁.1 • (x₂.2 + x₃.2) + (op x₂.1 + op x₃.1) • x₁.2 = + x₁.1 • x₂.2 + op x₂.1 • x₁.2 + (x₁.1 • x₃.2 + op x₃.1 • x₁.2), by simp_rw [smul_add, add_smul, add_add_add_comm], right_distrib := λ x₁ x₂ x₃, ext (add_mul x₁.1 x₂.1 x₃.1) $ - show (x₁.1 + x₂.1) • x₃.2 + x₃.1 • (x₁.2 + x₂.2) = - x₁.1 • x₃.2 + x₃.1 • x₁.2 + (x₂.1 • x₃.2 + x₃.1 • x₂.2), + show (x₁.1 + x₂.1) • x₃.2 + op x₃.1 • (x₁.2 + x₂.2) = + x₁.1 • x₃.2 + op x₃.1 • x₁.2 + (x₂.1 • x₃.2 + op x₃.1 • x₂.2), by simp_rw [add_smul, smul_add, add_add_add_comm], + .. triv_sq_zero_ext.add_monoid_with_one, .. triv_sq_zero_ext.mul_one_class, .. triv_sq_zero_ext.add_comm_monoid } -instance [comm_monoid R] [add_monoid M] [distrib_mul_action R M] : monoid (tsze R M) := +instance [ring R] [add_comm_group M] [module R M] [module Rᵐᵒᵖ M] : + non_assoc_ring (tsze R M) := +{ .. triv_sq_zero_ext.add_group_with_one, + .. triv_sq_zero_ext.non_assoc_semiring } + +/-- In the general non-commutative case, the power operator is + +$$\begin{align} +(r + m)^n &= r^n + r^{n-1}m + r^{n-2}mr + \cdots + rmr^{n-2} + mr^{n-1} \\ + & =r^n + \sum_{i = 0}^{n - 1} r^{(n - 1) - i} m r^{i} +\end{align}$$ + +In the commutative case this becomes the simpler $(r + m)^n = r^n + nr^{n-1}m$. +-/ +instance [monoid R] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] : + has_pow (tsze R M) ℕ := +⟨λ x n, ⟨x.fst^n, + ((list.range n).map (λ i, x.fst ^ (n.pred - i) • op (x.fst ^ i) • x.snd)).sum⟩⟩ + +@[simp] lemma fst_pow [monoid R] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] + (x : tsze R M) (n : ℕ) : + fst (x ^ n) = x.fst ^ n := rfl + +lemma snd_pow_eq_sum [monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] (x : tsze R M) (n : ℕ) : + snd (x ^ n) = ((list.range n).map (λ i, x.fst ^ (n.pred - i) • op (x.fst ^ i) • x.snd)).sum := rfl + +lemma snd_pow_of_smul_comm [monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] + (x : tsze R M) (n : ℕ) (h : op x.fst • x.snd = x.fst • x.snd) : + snd (x ^ n) = n • x.fst ^ n.pred • x.snd := +begin + have : ∀ n : ℕ, op (x.fst ^ n) • x.snd = x.fst ^ n • x.snd, + { intro n, + induction n with n ih, + { simp }, + { rw [pow_succ', mul_opposite.op_mul, mul_smul, mul_smul, ←h, + smul_comm (_ : R) (op x.fst) x.snd, ih] } }, + simp_rw [snd_pow_eq_sum, this, smul_smul, ←pow_add], + cases n, + { rw [nat.pred_zero, pow_zero, list.range_zero, zero_smul, list.map_nil, list.sum_nil] }, + simp_rw nat.pred_succ, + refine (list.sum_eq_card_nsmul _ (x.fst ^ n • x.snd) _).trans _, + { rintros m hm, + simp_rw [list.mem_map, list.mem_range] at hm, + obtain ⟨i, hi, rfl⟩ := hm, + rw tsub_add_cancel_of_le (nat.lt_succ_iff.mp hi) }, + { rw [list.length_map, list.length_range] } +end + +@[simp] lemma snd_pow [comm_monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] [is_central_scalar R M] + (x : tsze R M) (n : ℕ) : + snd (x ^ n) = n • x.fst ^ n.pred • x.snd := +snd_pow_of_smul_comm _ _ (op_smul_eq_smul _ _) + +@[simp] lemma inl_pow [monoid R] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] + (r : R) (n : ℕ) : + (inl r ^ n : tsze R M) = inl (r ^ n) := +ext rfl $ by simp [snd_pow_eq_sum] + +instance [monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] : + monoid (tsze R M) := { mul_assoc := λ x y z, ext (mul_assoc x.1 y.1 z.1) $ - show (x.1 * y.1) • z.2 + z.1 • (x.1 • y.2 + y.1 • x.2) = - x.1 • (y.1 • z.2 + z.1 • y.2) + (y.1 * z.1) • x.2, - by simp_rw [smul_add, ← mul_smul, add_assoc, mul_comm], + show (x.1 * y.1) • z.2 + op z.1 • (x.1 • y.2 + op y.1 • x.2) = + x.1 • (y.1 • z.2 + op z.1 • y.2) + (op z.1 * op y.1) • x.2, + by simp_rw [smul_add, ← mul_smul, add_assoc, smul_comm], + npow := λ n x, x ^ n, + npow_zero' := λ x, ext (pow_zero x.fst) (by simp [snd_pow_eq_sum]), + npow_succ' := λ n x, ext (pow_succ _ _) begin + simp_rw [snd_mul, snd_pow_eq_sum, nat.pred_succ], + cases n, + { simp [list.range_succ], }, + simp_rw [nat.pred_succ], + rw [list.range_succ, list.map_append, list.sum_append, list.map_singleton, list.sum_singleton, + nat.sub_self, pow_zero, one_smul, list.smul_sum, list.map_map, function.comp, fst_pow], + simp_rw [smul_smul, ←pow_succ, nat.succ_eq_add_one], + congr' 2, + refine list.map_congr (λ i hi, _), + rw [list.mem_range, nat.lt_succ_iff] at hi, + rw nat.sub_add_comm hi, + end, .. triv_sq_zero_ext.mul_one_class } -instance [comm_monoid R] [add_comm_monoid M] [distrib_mul_action R M] : comm_monoid (tsze R M) := +lemma fst_list_prod [monoid R] [add_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] + (l : list (tsze R M)) : + l.prod.fst = (l.map fst).prod := +map_list_prod (⟨fst, fst_one, fst_mul⟩ : tsze R M →* R) _ + +instance [semiring R] [add_comm_monoid M] + [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] : + semiring (tsze R M) := +{ .. triv_sq_zero_ext.monoid, + .. triv_sq_zero_ext.non_assoc_semiring } + +/-- The second element of a product $\prod_{i=0}^n (r_i + m_i)$ is a sum of terms of the form +$r_0\cdots r_{i-1}m_ir_{i+1}\cdots r_n$. -/ +lemma snd_list_prod [semiring R] [add_comm_monoid M] + [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] + (l : list (tsze R M)) : + l.prod.snd = + (l.enum.map (λ x : ℕ × tsze R M, + ((l.map fst).take x.1).prod • op ((l.map fst).drop x.1.succ).prod • x.snd.snd)).sum := +begin + induction l with x xs ih, + { simp }, + { rw [list.enum_cons, ←list.map_fst_add_enum_eq_enum_from], + simp_rw [list.map_cons, list.map_map, function.comp, prod.map_snd, prod.map_fst, id, + list.take_zero, list.take_cons, list.prod_nil, list.prod_cons, snd_mul, one_smul, + list.drop, mul_smul, list.sum_cons, fst_list_prod, ih, list.smul_sum, list.map_map], + exact add_comm _ _, } +end + +instance [ring R] [add_comm_group M] + [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] : + ring (tsze R M) := +{ .. triv_sq_zero_ext.semiring, + .. triv_sq_zero_ext.non_assoc_ring } + +instance [comm_monoid R] [add_comm_monoid M] + [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] [is_central_scalar R M] : + comm_monoid (tsze R M) := { mul_comm := λ x₁ x₂, ext (mul_comm x₁.1 x₂.1) $ - show x₁.1 • x₂.2 + x₂.1 • x₁.2 = x₂.1 • x₁.2 + x₁.1 • x₂.2, from add_comm _ _, + show x₁.1 • x₂.2 + op x₂.1 • x₁.2 = x₂.1 • x₁.2 + op x₁.1 • x₂.2, + by rw [op_smul_eq_smul, op_smul_eq_smul, add_comm] .. triv_sq_zero_ext.monoid } -instance [comm_semiring R] [add_comm_monoid M] [module R M] : comm_semiring (tsze R M) := +instance [comm_semiring R] [add_comm_monoid M] + [module R M] [module Rᵐᵒᵖ M] [is_central_scalar R M] : + comm_semiring (tsze R M) := { .. triv_sq_zero_ext.comm_monoid, .. triv_sq_zero_ext.non_assoc_semiring } +instance [comm_ring R] [add_comm_group M] + [module R M] [module Rᵐᵒᵖ M] [is_central_scalar R M] : comm_ring (tsze R M) := +{ .. triv_sq_zero_ext.non_assoc_ring, + .. triv_sq_zero_ext.comm_semiring } + variables (R M) /-- The canonical inclusion of rings `R → triv_sq_zero_ext R M`. -/ @[simps apply] -def inl_hom [semiring R] [add_comm_monoid M] [module R M] : R →+* tsze R M := +def inl_hom [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M] : R →+* tsze R M := { to_fun := inl, map_one' := inl_one M, map_mul' := inl_mul M, @@ -349,74 +566,86 @@ def inl_hom [semiring R] [add_comm_monoid M] [module R M] : R →+* tsze R M := end mul section algebra -variables (S : Type*) (R : Type u) (M : Type v) -variables [comm_semiring S] [comm_semiring R] [add_comm_monoid M] -variables [algebra S R] [module S M] [module R M] [is_scalar_tower S R M] - -instance algebra' : algebra S (tsze R M) := -{ commutes' := λ r x, mul_comm _ _, +variables (S : Type*) (R R' : Type u) (M : Type v) +variables [comm_semiring S] [semiring R] [comm_semiring R'] [add_comm_monoid M] +variables [algebra S R] [algebra S R'] [module S M] +variables [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] +variables [is_scalar_tower S R M] [is_scalar_tower S Rᵐᵒᵖ M] +variables [module R' M] [module R'ᵐᵒᵖ M] [is_central_scalar R' M] [is_scalar_tower S R' M] + +instance algebra' : algebra S (tsze R M) := +{ smul := (•), + commutes' := λ s x, ext (algebra.commutes _ _) $ + show algebra_map S R s • x.snd + op x.fst • 0 = x.fst • 0 + op (algebra_map S R s) • x.snd, + begin + rw [smul_zero, smul_zero, add_zero, zero_add], + rw [algebra.algebra_map_eq_smul_one, mul_opposite.op_smul, mul_opposite.op_one, + smul_assoc, one_smul, smul_assoc, one_smul], + end, smul_def' := λ r x, ext (algebra.smul_def _ _) $ - show r • x.2 = algebra_map S R r • x.2 + x.1 • 0, by rw [smul_zero, add_zero, algebra_map_smul], + show r • x.2 = algebra_map S R r • x.2 + op x.1 • 0, + by rw [smul_zero, add_zero, algebra_map_smul], .. (triv_sq_zero_ext.inl_hom R M).comp (algebra_map S R) } -- shortcut instance for the common case -instance : algebra R (tsze R M) := triv_sq_zero_ext.algebra' _ _ _ +instance : algebra R' (tsze R' M) := triv_sq_zero_ext.algebra' _ _ _ -lemma algebra_map_eq_inl : ⇑(algebra_map R (tsze R M)) = inl := rfl -lemma algebra_map_eq_inl_hom : algebra_map R (tsze R M) = inl_hom R M := rfl +lemma algebra_map_eq_inl : ⇑(algebra_map R' (tsze R' M)) = inl := rfl +lemma algebra_map_eq_inl_hom : algebra_map R' (tsze R' M) = inl_hom R' M := rfl lemma algebra_map_eq_inl' (s : S) : algebra_map S (tsze R M) s = inl (algebra_map S R s) := rfl /-- The canonical `R`-algebra projection `triv_sq_zero_ext R M → R`. -/ @[simps] -def fst_hom : tsze R M →ₐ[R] R := +def fst_hom : tsze R M →ₐ[S] R := { to_fun := fst, map_one' := fst_one, map_mul' := fst_mul, map_zero' := fst_zero, map_add' := fst_add, - commutes' := fst_inl M } + commutes' := λ r, fst_inl M _ } -variables {R S M} +variables {R R' S M} -lemma alg_hom_ext {A} [semiring A] [algebra R A] ⦃f g : tsze R M →ₐ[R] A⦄ +lemma alg_hom_ext {A} [semiring A] [algebra R' A] ⦃f g : tsze R' M →ₐ[R'] A⦄ (h : ∀ m, f (inr m) = g (inr m)) : f = g := alg_hom.to_linear_map_injective $ linear_map_ext (λ r, (f.commutes _).trans (g.commutes _).symm) h @[ext] -lemma alg_hom_ext' {A} [semiring A] [algebra R A] ⦃f g : tsze R M →ₐ[R] A⦄ - (h : f.to_linear_map.comp (inr_hom R M) = g.to_linear_map.comp (inr_hom R M)) : +lemma alg_hom_ext' {A} [semiring A] [algebra R' A] ⦃f g : tsze R' M →ₐ[R'] A⦄ + (h : f.to_linear_map.comp (inr_hom R' M) = g.to_linear_map.comp (inr_hom R' M)) : f = g := alg_hom_ext $ linear_map.congr_fun h -variables {A : Type*} [semiring A] [algebra R A] +variables {A : Type*} [semiring A] [algebra R' A] /-- There is an alg_hom from the trivial square zero extension to any `R`-algebra with a submodule whose products are all zero. See `triv_sq_zero_ext.lift` for this as an equiv. -/ -def lift_aux (f : M →ₗ[R] A) (hf : ∀ x y, f x * f y = 0) : tsze R M →ₐ[R] A := +def lift_aux (f : M →ₗ[R'] A) (hf : ∀ x y, f x * f y = 0) : tsze R' M →ₐ[R'] A := alg_hom.of_linear_map - ((algebra.linear_map _ _).comp (fst_hom R M).to_linear_map + f.comp (snd_hom R M)) - (show algebra_map R _ 1 + f (0 : M) = 1, by rw [map_zero, map_one, add_zero]) + ((algebra.linear_map _ _).comp (fst_hom R' R' M).to_linear_map + f.comp (snd_hom R' M)) + (show algebra_map R' _ 1 + f (0 : M) = 1, by rw [map_zero, map_one, add_zero]) (triv_sq_zero_ext.ind $ λ r₁ m₁, triv_sq_zero_ext.ind $ λ r₂ m₂, begin dsimp, - simp only [add_zero, zero_add, add_mul, mul_add, smul_mul_smul, hf, smul_zero], + simp only [add_zero, zero_add, add_mul, mul_add, smul_mul_smul, hf, smul_zero, + op_smul_eq_smul], rw [←ring_hom.map_mul, linear_map.map_add, ←algebra.commutes _ (f _), ←algebra.smul_def, ←algebra.smul_def, add_right_comm, add_assoc, linear_map.map_smul, linear_map.map_smul], end) -@[simp] lemma lift_aux_apply_inr (f : M →ₗ[R] A) (hf : ∀ x y, f x * f y = 0) (m : M) : +@[simp] lemma lift_aux_apply_inr (f : M →ₗ[R'] A) (hf : ∀ x y, f x * f y = 0) (m : M) : lift_aux f hf (inr m) = f m := -show algebra_map R A 0 + f m = f m, by rw [ring_hom.map_zero, zero_add] +show algebra_map R' A 0 + f m = f m, by rw [ring_hom.map_zero, zero_add] -@[simp] lemma lift_aux_comp_inr_hom (f : M →ₗ[R] A) (hf : ∀ x y, f x * f y = 0) : - (lift_aux f hf).to_linear_map.comp (inr_hom R M) = f := +@[simp] lemma lift_aux_comp_inr_hom (f : M →ₗ[R'] A) (hf : ∀ x y, f x * f y = 0) : + (lift_aux f hf).to_linear_map.comp (inr_hom R' M) = f := linear_map.ext $ lift_aux_apply_inr f hf /- When applied to `inr` itself, `lift_aux` is the identity. -/ @[simp] -lemma lift_aux_inr_hom : lift_aux (inr_hom R M) (inr_mul_inr R) = alg_hom.id R (tsze R M) := +lemma lift_aux_inr_hom : lift_aux (inr_hom R' M) (inr_mul_inr R') = alg_hom.id R' (tsze R' M) := alg_hom_ext' $ lift_aux_comp_inr_hom _ _ /-- A universal property of the trivial square-zero extension, providing a unique @@ -425,13 +654,16 @@ products. This isomorphism is named to match the very similar `complex.lift`. -/ @[simps] -def lift : {f : M →ₗ[R] A // ∀ x y, f x * f y = 0} ≃ (tsze R M →ₐ[R] A) := +def lift : {f : M →ₗ[R'] A // ∀ x y, f x * f y = 0} ≃ (tsze R' M →ₐ[R'] A) := { to_fun := λ f, lift_aux f f.prop, - inv_fun := λ F, ⟨F.to_linear_map.comp (inr_hom R M), λ x y, + inv_fun := λ F, ⟨F.to_linear_map.comp (inr_hom R' M), λ x y, (F.map_mul _ _).symm.trans $ (F.congr_arg $ inr_mul_inr _ _ _).trans F.map_zero⟩, left_inv := λ f, subtype.ext $ lift_aux_comp_inr_hom _ _, right_inv := λ F, alg_hom_ext' $ lift_aux_comp_inr_hom _ _, } +/-- This lemma is obviously simp-normal, but the linter times out while processing it.-/ +attribute [nolint simp_nf] lift_symm_apply_coe + end algebra end triv_sq_zero_ext diff --git a/src/algebra/tropical/basic.lean b/src/algebra/tropical/basic.lean index 119ee6a555244..463ad1f35fec0 100644 --- a/src/algebra/tropical/basic.lean +++ b/src/algebra/tropical/basic.lean @@ -4,12 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yakov Pechersky -/ import algebra.group_power.order +import algebra.order.monoid.with_top import algebra.smul_with_zero +import algebra.order.monoid.min_max /-! # Tropical algebraic structures +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines algebraic structures of the (min-)tropical numbers, up to the tropical semiring. Some basic lemmas about conversion from the base type `R` to `tropical R` are provided, as well as the expected implementations of tropical addition and tropical multiplication. @@ -275,6 +280,12 @@ instance [has_zero R] : has_one (tropical R) := ⟨trop 0⟩ @[simp] lemma trop_zero [has_zero R] : trop (0 : R) = 1 := rfl @[simp] lemma untrop_one [has_zero R] : untrop (1 : tropical R) = 0 := rfl +instance [linear_order R] [order_top R] [has_zero R] : add_monoid_with_one (tropical R) := +{ nat_cast := λ n, if n = 0 then 0 else 1, + nat_cast_zero := rfl, + nat_cast_succ := λ n, (untrop_inj_iff _ _).1 (by cases n; simp [nat.cast]), + .. tropical.has_one, .. tropical.add_comm_monoid } + instance [has_zero R] : nontrivial (tropical (with_top R)) := ⟨⟨0, 1, trop_injective.ne with_top.top_ne_coe⟩⟩ @@ -295,13 +306,13 @@ instance [add_comm_semigroup R] : comm_semigroup (tropical R) := { mul_comm := λ _ _, untrop_injective (add_comm _ _), ..tropical.semigroup } -instance {α : Type*} [has_scalar α R] : has_pow (tropical R) α := +instance {α : Type*} [has_smul α R] : has_pow (tropical R) α := { pow := λ x n, trop $ n • untrop x } -@[simp] lemma untrop_pow {α : Type*} [has_scalar α R] (x : tropical R) (n : α) : +@[simp] lemma untrop_pow {α : Type*} [has_smul α R] (x : tropical R) (n : α) : untrop (x ^ n) = n • untrop x := rfl -@[simp] lemma trop_smul {α : Type*} [has_scalar α R] (x : R) (n : α) : +@[simp] lemma trop_smul {α : Type*} [has_smul α R] (x : R) (n : α) : trop (n • x) = trop x ^ n := rfl instance [add_zero_class R] : mul_one_class (tropical R) := @@ -400,7 +411,7 @@ variable [linear_ordered_add_comm_monoid_with_top R] instance : comm_semiring (tropical R) := { zero_mul := λ _, untrop_injective (top_add _), mul_zero := λ _, untrop_injective (add_top _), - ..tropical.has_zero, + ..tropical.add_monoid_with_one, ..tropical.distrib, ..tropical.add_comm_monoid, ..tropical.comm_monoid } diff --git a/src/algebra/tropical/big_operators.lean b/src/algebra/tropical/big_operators.lean index 73430afedb01e..5322f25dfa18b 100644 --- a/src/algebra/tropical/big_operators.lean +++ b/src/algebra/tropical/big_operators.lean @@ -3,14 +3,18 @@ Copyright (c) 2021 Yakov Pechersky. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yakov Pechersky -/ -import algebra.tropical.lattice import algebra.big_operators.basic import data.list.min_max +import algebra.tropical.basic +import order.conditionally_complete_lattice.finset /-! # Tropicalization of finitary operations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides the "big-op" or notation-based finitary operations on tropicalized types. This allows easy conversion between sums to Infs and prods to sums. Results here are important for expressing that evaluation of tropical polynomials are the minimum over a finite piecewise diff --git a/src/algebra/tropical/lattice.lean b/src/algebra/tropical/lattice.lean index cf81c638bf806..544bba5582e4a 100644 --- a/src/algebra/tropical/lattice.lean +++ b/src/algebra/tropical/lattice.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yakov Pechersky -/ import algebra.tropical.basic -import order.conditionally_complete_lattice +import order.conditionally_complete_lattice.basic /-! # Order on tropical algebraic structure +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the orders induced on tropical algebraic structures by the underlying type. ## Main declarations diff --git a/src/algebraic_geometry/AffineScheme.lean b/src/algebraic_geometry/AffineScheme.lean index 5d5b52cc7c56c..827f2d0f8852b 100644 --- a/src/algebraic_geometry/AffineScheme.lean +++ b/src/algebraic_geometry/AffineScheme.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ import algebraic_geometry.Gamma_Spec_adjunction -import algebraic_geometry.open_immersion +import algebraic_geometry.open_immersion.Scheme import category_theory.limits.opposites +import ring_theory.localization.inv_submonoid /-! # Affine schemes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the category of `AffineScheme`s as the essential image of `Spec`. We also define predicates about affine schemes and affine open sets. @@ -40,7 +44,8 @@ namespace algebraic_geometry open Spec (structure_sheaf) /-- The category of affine schemes -/ -def AffineScheme := Scheme.Spec.ess_image +@[derive category, nolint has_nonempty_instance] +def AffineScheme := Scheme.Spec.ess_image_subcategory /-- A Scheme is affine if the canonical map `X ⟶ Spec Γ(X)` is an isomorphism. -/ class is_affine (X : Scheme) : Prop := @@ -53,18 +58,34 @@ def Scheme.iso_Spec (X : Scheme) [is_affine X] : X ≅ Scheme.Spec.obj (op $ Scheme.Γ.obj $ op X) := as_iso (Γ_Spec.adjunction.unit.app X) -lemma mem_AffineScheme (X : Scheme) : X ∈ AffineScheme ↔ is_affine X := +/-- Construct an affine scheme from a scheme and the information that it is affine. +Also see `AffineScheme.of` for a typclass version. -/ +@[simps] +def AffineScheme.mk (X : Scheme) (h : is_affine X) : AffineScheme := +⟨X, @@mem_ess_image_of_unit_is_iso _ _ _ _ h.1⟩ + +/-- Construct an affine scheme from a scheme. Also see `AffineScheme.mk` for a non-typeclass +version. -/ +def AffineScheme.of (X : Scheme) [h : is_affine X] : AffineScheme := +AffineScheme.mk X h + +/-- Type check a morphism of schemes as a morphism in `AffineScheme`. -/ +def AffineScheme.of_hom {X Y : Scheme} [is_affine X] [is_affine Y] (f : X ⟶ Y) : + AffineScheme.of X ⟶ AffineScheme.of Y := +f + +lemma mem_Spec_ess_image (X : Scheme) : X ∈ Scheme.Spec.ess_image ↔ is_affine X := ⟨λ h, ⟨functor.ess_image.unit_is_iso h⟩, λ h, @@mem_ess_image_of_unit_is_iso _ _ _ X h.1⟩ -instance is_affine_AffineScheme (X : AffineScheme.{u}) : is_affine (X : Scheme.{u}) := -(mem_AffineScheme _).mp X.prop +instance is_affine_AffineScheme (X : AffineScheme.{u}) : is_affine X.obj := +⟨functor.ess_image.unit_is_iso X.property⟩ instance Spec_is_affine (R : CommRingᵒᵖ) : is_affine (Scheme.Spec.obj R) := -(mem_AffineScheme _).mp (Scheme.Spec.obj_mem_ess_image R) +algebraic_geometry.is_affine_AffineScheme ⟨_, Scheme.Spec.obj_mem_ess_image R⟩ lemma is_affine_of_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] [h : is_affine Y] : is_affine X := -by { rw [← mem_AffineScheme] at h ⊢, exact functor.ess_image.of_iso (as_iso f).symm h } +by { rw [← mem_Spec_ess_image] at h ⊢, exact functor.ess_image.of_iso (as_iso f).symm h } namespace AffineScheme @@ -92,7 +113,6 @@ end instance : has_colimits AffineScheme.{u} := begin haveI := adjunction.has_limits_of_equivalence.{u} Γ.{u}, - haveI : has_colimits AffineScheme.{u} ᵒᵖᵒᵖ := has_colimits_op_of_has_limits, exactI adjunction.has_colimits_of_equivalence.{u} (op_op_equivalence AffineScheme.{u}).inverse end @@ -103,14 +123,32 @@ begin exactI adjunction.has_limits_of_equivalence (op_op_equivalence AffineScheme.{u}).inverse end +noncomputable +instance : preserves_limits Γ.{u}.right_op := +@@adjunction.is_equivalence_preserves_limits _ _ Γ.right_op + (is_equivalence.of_equivalence equiv_CommRing) + +noncomputable +instance : preserves_limits forget_to_Scheme := +begin + apply_with (@@preserves_limits_of_nat_iso _ _ + (iso_whisker_right equiv_CommRing.unit_iso forget_to_Scheme).symm) { instances := ff }, + change preserves_limits (equiv_CommRing.functor ⋙ Scheme.Spec), + apply_instance, +end + end AffineScheme /-- An open subset of a scheme is affine if the open subscheme is affine. -/ def is_affine_open {X : Scheme} (U : opens X.carrier) : Prop := is_affine (X.restrict U.open_embedding) +/-- The set of affine opens as a subset of `opens X.carrier`. -/ +def Scheme.affine_opens (X : Scheme) : set (opens X.carrier) := +{ U : opens X.carrier | is_affine_open U } + lemma range_is_affine_open_of_open_immersion {X Y : Scheme} [is_affine X] (f : X ⟶ Y) - [H : is_open_immersion f] : is_affine_open ⟨set.range f.1.base, H.base_open.open_range⟩ := + [H : is_open_immersion f] : is_affine_open f.opens_range := begin refine is_affine_of_iso (is_open_immersion.iso_of_range_eq f (Y.of_restrict _) _).inv, exact subtype.range_coe.symm, @@ -124,16 +162,20 @@ begin exact set.range_id.symm end +instance Scheme.affine_cover_is_affine (X : Scheme) (i : X.affine_cover.J) : + is_affine (X.affine_cover.obj i) := +algebraic_geometry.Spec_is_affine _ + instance Scheme.affine_basis_cover_is_affine (X : Scheme) (i : X.affine_basis_cover.J) : is_affine (X.affine_basis_cover.obj i) := algebraic_geometry.Spec_is_affine _ lemma is_basis_affine_open (X : Scheme) : - opens.is_basis { U : opens X.carrier | is_affine_open U } := + opens.is_basis X.affine_opens := begin rw opens.is_basis_iff_nbhd, rintros U x (hU : x ∈ (U : set X.carrier)), - obtain ⟨S, hS, hxS, hSU⟩ := X.affine_basis_cover_is_basis.exists_subset_of_mem_open hU U.prop, + obtain ⟨S, hS, hxS, hSU⟩ := X.affine_basis_cover_is_basis.exists_subset_of_mem_open hU U.is_open, refine ⟨⟨S, X.affine_basis_cover_is_basis.is_open hS⟩, _, hxS, hSU⟩, rcases hS with ⟨i, rfl⟩, exact range_is_affine_open_of_open_immersion _, @@ -180,6 +222,29 @@ begin exact set.image_univ end +lemma is_affine_open.image_is_open_immersion {X Y : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) + (f : X ⟶ Y) [H : is_open_immersion f] : is_affine_open (f.opens_functor.obj U) := +begin + haveI : is_affine _ := hU, + convert range_is_affine_open_of_open_immersion (X.of_restrict U.open_embedding ≫ f), + ext1, + exact set.image_eq_range _ _ +end + +lemma is_affine_open_iff_of_is_open_immersion {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f] + (U : opens X.carrier) : + is_affine_open (H.open_functor.obj U) ↔ is_affine_open U := +begin + refine ⟨λ hU, @@is_affine_of_iso _ _ hU, λ hU, hU.image_is_open_immersion f⟩, + refine (is_open_immersion.iso_of_range_eq (X.of_restrict _ ≫ f) (Y.of_restrict _) _).hom, + { rw [Scheme.comp_val_base, coe_comp, set.range_comp], + dsimp [opens.inclusion], + rw [subtype.range_coe, subtype.range_coe], + refl }, + { apply_instance } +end + instance Scheme.quasi_compact_of_affine (X : Scheme) [is_affine X] : compact_space X.carrier := ⟨(top_is_affine_open X).is_compact⟩ @@ -195,14 +260,14 @@ end lemma Scheme.Spec_map_presheaf_map_eq_to_hom {X : Scheme} {U V : opens X.carrier} (h : U = V) (W) : (Scheme.Spec.map (X.presheaf.map (eq_to_hom h).op).op).val.c.app W = - eq_to_hom (by { cases h, dsimp, induction W using opposite.rec, congr, ext1, simpa }) := + eq_to_hom (by { cases h, induction W using opposite.rec, dsimp, simp, }) := begin have : Scheme.Spec.map (X.presheaf.map (𝟙 (op U))).op = 𝟙 _, { rw [X.presheaf.map_id, op_id, Scheme.Spec.map_id] }, cases h, refine (Scheme.congr_app this _).trans _, erw category.id_comp, - simpa + simpa [eq_to_hom_map], end lemma is_affine_open.Spec_Γ_identity_hom_app_from_Spec {X : Scheme} {U : opens X.carrier} @@ -252,8 +317,8 @@ begin have : hU.from_Spec.val.base '' (hU.from_Spec.val.base ⁻¹' (X.basic_open f : set X.carrier)) = (X.basic_open f : set X.carrier), { rw [set.image_preimage_eq_inter_range, set.inter_eq_left_iff_subset, hU.from_Spec_range], - exact Scheme.basic_open_subset _ _ }, - rw [subtype.coe_mk, Scheme.comp_val_base, ← this, coe_comp, set.range_comp], + exact Scheme.basic_open_le _ _ }, + rw [Scheme.hom.opens_range_coe, Scheme.comp_val_base, ← this, coe_comp, set.range_comp], congr' 1, refine (congr_arg coe $ Scheme.preimage_basic_open hU.from_Spec f).trans _, refine eq.trans _ (prime_spectrum.localization_away_comap_range (localization.away f) f).symm, @@ -274,6 +339,19 @@ begin erw hU.Spec_Γ_identity_hom_app_from_Spec, end +lemma is_affine_open.map_restrict_basic_open {X : Scheme} (r : X.presheaf.obj (op ⊤)) + {U : opens X.carrier} (hU : is_affine_open U) : + is_affine_open ((opens.map (X.of_restrict (X.basic_open r).open_embedding).1.base).obj U) := +begin + apply (is_affine_open_iff_of_is_open_immersion + (X.of_restrict (X.basic_open r).open_embedding) _).mp, + delta PresheafedSpace.is_open_immersion.open_functor, + dsimp, + erw [opens.functor_obj_map_obj, opens.open_embedding_obj_top, inf_comm, + ← Scheme.basic_open_res _ _ (hom_of_le le_top).op], + exact hU.basic_open_is_affine _, +end + lemma Scheme.map_prime_spectrum_basic_open_of_affine (X : Scheme) [is_affine X] (f : Scheme.Γ.obj (op X)) : (opens.map X.iso_Spec.hom.1.base).obj (prime_spectrum.basic_open f) = X.basic_open f := @@ -303,10 +381,137 @@ begin split, { rintro ⟨_, ⟨x, rfl⟩, rfl⟩, refine ⟨_, ⟨_, ⟨x, rfl⟩, rfl⟩, _⟩, - exact congr_arg subtype.val (X.map_prime_spectrum_basic_open_of_affine x) }, + exact congr_arg opens.carrier (X.map_prime_spectrum_basic_open_of_affine x) }, { rintro ⟨_, ⟨_, ⟨x, rfl⟩, rfl⟩, rfl⟩, refine ⟨_, ⟨x, rfl⟩, _⟩, - exact congr_arg subtype.val (X.map_prime_spectrum_basic_open_of_affine x).symm } + exact congr_arg opens.carrier (X.map_prime_spectrum_basic_open_of_affine x).symm } +end + +lemma is_affine_open.exists_basic_open_le {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) {V : opens X.carrier} (x : V) (h : ↑x ∈ U) : + ∃ f : X.presheaf.obj (op U), X.basic_open f ≤ V ∧ ↑x ∈ X.basic_open f := +begin + haveI : is_affine _ := hU, + obtain ⟨_, ⟨_, ⟨r, rfl⟩, rfl⟩, h₁, h₂⟩ := (is_basis_basic_open (X.restrict U.open_embedding)) + .exists_subset_of_mem_open _ ((opens.map U.inclusion).obj V).is_open, + swap, exact ⟨x, h⟩, + have : U.open_embedding.is_open_map.functor.obj ((X.restrict U.open_embedding).basic_open r) + = X.basic_open (X.presheaf.map (eq_to_hom U.open_embedding_obj_top.symm).op r), + { refine (Scheme.image_basic_open (X.of_restrict U.open_embedding) r).trans _, + erw ← Scheme.basic_open_res_eq _ _ (eq_to_hom U.open_embedding_obj_top).op, + rw [← comp_apply, ← category_theory.functor.map_comp, ← op_comp, eq_to_hom_trans, + eq_to_hom_refl, op_id, category_theory.functor.map_id, Scheme.hom.inv_app], + erw PresheafedSpace.is_open_immersion.of_restrict_inv_app, + congr }, + use X.presheaf.map (eq_to_hom U.open_embedding_obj_top.symm).op r, + rw ← this, + exact ⟨set.image_subset_iff.mpr h₂, set.mem_image_of_mem _ h₁⟩, + exact x.prop, +end + +instance {X : Scheme} {U : opens X.carrier} (f : X.presheaf.obj (op U)) : + algebra (X.presheaf.obj (op U)) (X.presheaf.obj (op $ X.basic_open f)) := +(X.presheaf.map (hom_of_le $ RingedSpace.basic_open_le _ f : _ ⟶ U).op).to_algebra + +lemma is_affine_open.opens_map_from_Spec_basic_open {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) (f : X.presheaf.obj (op U)) : + (opens.map hU.from_Spec.val.base).obj (X.basic_open f) = + RingedSpace.basic_open _ (Spec_Γ_identity.inv.app (X.presheaf.obj $ op U) f) := +begin + erw LocallyRingedSpace.preimage_basic_open, + refine eq.trans _ (RingedSpace.basic_open_res_eq (Scheme.Spec.obj $ op $ X.presheaf.obj (op U)) + .to_LocallyRingedSpace.to_RingedSpace (eq_to_hom hU.from_Spec_base_preimage).op _), + congr, + rw ← comp_apply, + congr, + erw ← hU.Spec_Γ_identity_hom_app_from_Spec, + rw iso.inv_hom_id_app_assoc, +end + +/-- The canonical map `Γ(𝒪ₓ, D(f)) ⟶ Γ(Spec 𝒪ₓ(U), D(Spec_Γ_identity.inv f))` +This is an isomorphism, as witnessed by an `is_iso` instance. -/ +def basic_open_sections_to_affine {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) + (f : X.presheaf.obj (op U)) : X.presheaf.obj (op $ X.basic_open f) ⟶ + (Scheme.Spec.obj $ op $ X.presheaf.obj (op U)).presheaf.obj + (op $ Scheme.basic_open _ $ Spec_Γ_identity.inv.app (X.presheaf.obj (op U)) f) := +hU.from_Spec.1.c.app (op $ X.basic_open f) ≫ (Scheme.Spec.obj $ op $ X.presheaf.obj (op U)) + .presheaf.map (eq_to_hom $ (hU.opens_map_from_Spec_basic_open f).symm).op + +instance {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) + (f : X.presheaf.obj (op U)) : is_iso (basic_open_sections_to_affine hU f) := +begin + delta basic_open_sections_to_affine, + apply_with is_iso.comp_is_iso { instances := ff }, + { apply PresheafedSpace.is_open_immersion.is_iso_of_subset, + rw hU.from_Spec_range, + exact RingedSpace.basic_open_le _ _ }, + apply_instance +end + +lemma is_localization_basic_open {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) + (f : X.presheaf.obj (op U)) : + is_localization.away f (X.presheaf.obj (op $ X.basic_open f)) := +begin + apply (is_localization.is_localization_iff_of_ring_equiv (submonoid.powers f) + (as_iso $ basic_open_sections_to_affine hU f ≫ (Scheme.Spec.obj _).presheaf.map + (eq_to_hom (basic_open_eq_of_affine _).symm).op).CommRing_iso_to_ring_equiv).mpr, + convert structure_sheaf.is_localization.to_basic_open _ f, + change _ ≫ (basic_open_sections_to_affine hU f ≫ _) = _, + delta basic_open_sections_to_affine, + erw ring_hom.algebra_map_to_algebra, + simp only [Scheme.comp_val_c_app, category.assoc], + erw hU.from_Spec.val.c.naturality_assoc, + rw hU.from_Spec_app_eq, + dsimp, + simp only [category.assoc, ← functor.map_comp, ← op_comp], + apply structure_sheaf.to_open_res, +end + +instance {X : Scheme} [is_affine X] (r : X.presheaf.obj (op ⊤)) : + is_localization.away r (X.presheaf.obj (op $ X.basic_open r)) := +is_localization_basic_open (top_is_affine_open X) r + +lemma is_localization_of_eq_basic_open {X : Scheme} {U V : opens X.carrier} (i : V ⟶ U) + (hU : is_affine_open U) (r : X.presheaf.obj (op U)) (e : V = X.basic_open r) : + @@is_localization.away _ r (X.presheaf.obj (op V)) _ (X.presheaf.map i.op).to_algebra := +by { subst e, convert is_localization_basic_open hU r using 3 } + +instance Γ_restrict_algebra + {X : Scheme} {Y : Top} {f : Y ⟶ X.carrier} (hf : open_embedding f) : + algebra (Scheme.Γ.obj (op X)) (Scheme.Γ.obj (op $ X.restrict hf)) := +(Scheme.Γ.map (X.of_restrict hf).op).to_algebra + +instance Γ_restrict_is_localization (X : Scheme.{u}) [is_affine X] (r : Scheme.Γ.obj (op X)) : + is_localization.away r (Scheme.Γ.obj (op $ X.restrict (X.basic_open r).open_embedding)) := + is_localization_of_eq_basic_open _ (top_is_affine_open X) r (opens.open_embedding_obj_top _) + +lemma basic_open_basic_open_is_basic_open {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) (f : X.presheaf.obj (op U)) (g : X.presheaf.obj (op $ X.basic_open f)) : + ∃ f' : X.presheaf.obj (op U), X.basic_open f' = X.basic_open g := +begin + haveI := is_localization_basic_open hU f, + obtain ⟨x, ⟨_, n, rfl⟩, rfl⟩ := is_localization.surj' (submonoid.powers f) g, + use f * x, + rw [algebra.smul_def, Scheme.basic_open_mul, Scheme.basic_open_mul], + erw Scheme.basic_open_res, + refine (inf_eq_left.mpr _).symm, + convert inf_le_left using 1, + apply Scheme.basic_open_of_is_unit, + apply submonoid.left_inv_le_is_unit _ (is_localization.to_inv_submonoid (submonoid.powers f) + (X.presheaf.obj (op $ X.basic_open f)) _).prop +end + +lemma exists_basic_open_le_affine_inter {X : Scheme} {U V : opens X.carrier} + (hU : is_affine_open U) (hV : is_affine_open V) (x : X.carrier) (hx : x ∈ U ⊓ V) : + ∃ (f : X.presheaf.obj $ op U) (g : X.presheaf.obj $ op V), + X.basic_open f = X.basic_open g ∧ x ∈ X.basic_open f := +begin + obtain ⟨f, hf₁, hf₂⟩ := hU.exists_basic_open_le ⟨x, hx.2⟩ hx.1, + obtain ⟨g, hg₁, hg₂⟩ := hV.exists_basic_open_le ⟨x, hf₂⟩ hx.2, + obtain ⟨f', hf'⟩ := basic_open_basic_open_is_basic_open hU f + (X.presheaf.map (hom_of_le hf₁ : _ ⟶ V).op g), + replace hf' := (hf'.trans (RingedSpace.basic_open_res _ _ _)).trans (inf_eq_right.mpr hg₁), + exact ⟨f', g, hf', hf'.symm ▸ hg₂⟩ end /-- The prime ideal of `𝒪ₓ(U)` corresponding to a point `x : U`. -/ @@ -381,9 +586,10 @@ begin erw [← X.presheaf.map_comp, Spec_Γ_naturality_assoc], congr' 1, simp only [← category.assoc], - transitivity _ ≫ (structure_sheaf (X.presheaf.obj $ op U)).1.germ ⟨_, _⟩, + transitivity _ ≫ (structure_sheaf (X.presheaf.obj $ op U)).presheaf.germ ⟨_, _⟩, { refl }, - convert ((structure_sheaf (X.presheaf.obj $ op U)).1.germ_res (hom_of_le le_top) ⟨_, _⟩) using 2, + convert ((structure_sheaf (X.presheaf.obj $ op U)).presheaf.germ_res (hom_of_le le_top) ⟨_, _⟩) + using 2, rw category.assoc, erw nat_trans.naturality, rw [← LocallyRingedSpace.Γ_map_op, ← LocallyRingedSpace.Γ.map_comp_assoc, ← op_comp], @@ -398,4 +604,117 @@ begin refl end +/-- The basic open set of a section `f` on an an affine open as an `X.affine_opens`. -/ +@[simps] +def Scheme.affine_basic_open (X : Scheme) {U : X.affine_opens} + (f : X.presheaf.obj $ op U) : X.affine_opens := +⟨X.basic_open f, U.prop.basic_open_is_affine f⟩ + +@[simp] +lemma is_affine_open.basic_open_from_Spec_app {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) (f : X.presheaf.obj (op U)) : + @Scheme.basic_open (Scheme.Spec.obj $ op (X.presheaf.obj $ op U)) + ((opens.map hU.from_Spec.1.base).obj U) + (hU.from_Spec.1.c.app (op U) f) = prime_spectrum.basic_open f := +begin + rw [← Scheme.basic_open_res_eq _ _ (eq_to_hom hU.from_Spec_base_preimage.symm).op, + basic_open_eq_of_affine', is_affine_open.from_Spec_app_eq], + congr, + rw [← comp_apply, ← comp_apply, category.assoc, ← functor.map_comp_assoc, + eq_to_hom_op, eq_to_hom_op, eq_to_hom_trans, eq_to_hom_refl, category_theory.functor.map_id, + category.id_comp, ← iso.app_inv, iso.inv_hom_id], + refl +end + +lemma is_affine_open.from_Spec_map_basic_open {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) (f : X.presheaf.obj (op U)) : + (opens.map hU.from_Spec.val.base).obj (X.basic_open f) = prime_spectrum.basic_open f := +by simp + +lemma is_affine_open.basic_open_union_eq_self_iff {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) (s : set (X.presheaf.obj $ op U)) : + (⨆ (f : s), X.basic_open (f : X.presheaf.obj $ op U)) = U ↔ ideal.span s = ⊤ := +begin + transitivity (⋃ (i : s), (prime_spectrum.basic_open i.1).1) = set.univ, + transitivity hU.from_Spec.1.base ⁻¹' (⨆ (f : s), X.basic_open (f : X.presheaf.obj $ op U)).1 = + hU.from_Spec.1.base ⁻¹' U.1, + { refine ⟨λ h, by rw h, _⟩, + intro h, + apply_fun set.image hU.from_Spec.1.base at h, + rw [set.image_preimage_eq_inter_range, set.image_preimage_eq_inter_range, + hU.from_Spec_range] at h, + simp only [set.inter_self, opens.carrier_eq_coe, set.inter_eq_right_iff_subset] + at h, + ext1, + refine set.subset.antisymm _ h, + simp only [set.Union_subset_iff, set_coe.forall, opens.coe_supr], + intros x hx, + exact X.basic_open_le x }, + { simp only [opens.supr_def, subtype.coe_mk, set.preimage_Union, subtype.val_eq_coe], + congr' 3, + { ext1 x, + exact congr_arg opens.carrier (hU.from_Spec_map_basic_open _) }, + { exact congr_arg opens.carrier hU.from_Spec_base_preimage } }, + { simp only [opens.carrier_eq_coe, prime_spectrum.basic_open_eq_zero_locus_compl], + rw [← set.compl_Inter, set.compl_univ_iff, ← prime_spectrum.zero_locus_Union, + ← prime_spectrum.zero_locus_empty_iff_eq_top, prime_spectrum.zero_locus_span], + simp only [set.Union_singleton_eq_range, subtype.range_val_subtype, set.set_of_mem_eq] } +end + +lemma is_affine_open.self_le_basic_open_union_iff {X : Scheme} {U : opens X.carrier} + (hU : is_affine_open U) (s : set (X.presheaf.obj $ op U)) : + U ≤ (⨆ (f : s), X.basic_open (f : X.presheaf.obj $ op U)) ↔ ideal.span s = ⊤ := +begin + rw [← hU.basic_open_union_eq_self_iff, @comm _ eq], + refine ⟨λ h, le_antisymm h _, le_of_eq⟩, + simp only [supr_le_iff, set_coe.forall], + intros x hx, + exact X.basic_open_le x +end + +/-- +Let `P` be a predicate on the affine open sets of `X` satisfying +1. If `P` holds on `U`, then `P` holds on the basic open set of every section on `U`. +2. If `P` holds for a family of basic open sets covering `U`, then `P` holds for `U`. +3. There exists an affine open cover of `X` each satisfying `P`. + +Then `P` holds for every affine open of `X`. + +This is also known as the **Affine communication lemma** in [*The rising sea*][RisingSea]. -/ +@[elab_as_eliminator] +lemma of_affine_open_cover {X : Scheme} (V : X.affine_opens) (S : set X.affine_opens) + {P : X.affine_opens → Prop} + (hP₁ : ∀ (U : X.affine_opens) (f : X.presheaf.obj $ op U.1), P U → + P (X.affine_basic_open f)) + (hP₂ : ∀ (U : X.affine_opens) (s : finset (X.presheaf.obj $ op U)) + (hs : ideal.span (s : set (X.presheaf.obj $ op U)) = ⊤), + (∀ (f : s), P (X.affine_basic_open f.1)) → P U) + (hS : (⋃ (i : S), i : set X.carrier) = set.univ) + (hS' : ∀ (U : S), P U) : P V := +begin + classical, + have : ∀ (x : V), ∃ (f : X.presheaf.obj $ op V.1), + ↑x ∈ (X.basic_open f) ∧ P (X.affine_basic_open f), + { intro x, + have : ↑x ∈ (set.univ : set X.carrier) := trivial, + rw ← hS at this, + obtain ⟨W, hW⟩ := set.mem_Union.mp this, + obtain ⟨f, g, e, hf⟩ := exists_basic_open_le_affine_inter V.prop W.1.prop x ⟨x.prop, hW⟩, + refine ⟨f, hf, _⟩, + convert hP₁ _ g (hS' W) using 1, + ext1, + exact e }, + choose f hf₁ hf₂ using this, + suffices : ideal.span (set.range f) = ⊤, + { obtain ⟨t, ht₁, ht₂⟩ := (ideal.span_eq_top_iff_finite _).mp this, + apply hP₂ V t ht₂, + rintro ⟨i, hi⟩, + obtain ⟨x, rfl⟩ := ht₁ hi, + exact hf₂ x }, + rw ← V.prop.self_le_basic_open_union_iff, + intros x hx, + rw [supr_range', opens.mem_supr], + exact ⟨_, hf₁ ⟨x, hx⟩⟩ +end + end algebraic_geometry diff --git a/src/algebraic_geometry/EllipticCurve.lean b/src/algebraic_geometry/EllipticCurve.lean deleted file mode 100644 index b7eab79cba7a8..0000000000000 --- a/src/algebraic_geometry/EllipticCurve.lean +++ /dev/null @@ -1,87 +0,0 @@ -/- -Copyright (c) 2021 Kevin Buzzard. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Kevin Buzzard --/ - -import data.rat.basic -import tactic.norm_num - -/-! -# The category of elliptic curves (over a field or a PID) - -We give a working definition of elliptic curves which is mathematically accurate -in many cases, and also good for computation. - -## Mathematical background - -Let `S` be a scheme. The actual category of elliptic curves over `S` is a large category, -whose objects are schemes `E` equipped with a map `E → S`, a section `S → E`, and some -axioms (the map is smooth and proper and the fibres are geometrically connected group varieties -of dimension 1). In the special case where `S` is `Spec R` for some commutative ring `R` -whose Picard group is trivial (this includes all fields, all principal ideal domains, and many -other commutative rings) then it can be shown (using rather a lot of algebro-geometric machinery) -that every elliptic curve is, up to isomorphism, a projective plane cubic defined by -the equation `y^2+a₁xy+a₃y=x^3+a₂x^2+a₄x+a₆`, with `aᵢ : R`, and such that the discriminant -of the aᵢ is a unit in `R`. - -Some more details of the construction can be found on pages 66-69 of -[N. Katz and B. Mazur, *Arithmetic moduli of elliptic curves*][katz_mazur] or pages -53-56 of [P. Deligne, *Courbes elliptiques: formulaire d'après J. Tate*][deligne_formulaire]. - -## Warning - -The definition in this file makes sense for all commutative rings `R`, but it only gives -a type which can be beefed up to a category which is equivalent to the category of elliptic -curves over `Spec R` in the case that `R` has trivial Picard group or, slightly more generally, -when the 12-torsion of Pic(R) is trivial. The issue is that for a general ring R, there -might be elliptic curves over Spec(R) in the sense of algebraic geometry which are not -globally defined by a cubic equation valid over the entire base. - -## TODO - -Define the R-points (or even A-points if A is an R-algebra). Care will be needed -at infinity if R is not a field. Define the group law on the R-points. (hard) prove associativity. - --/ - -/-- The discriminant of the plane cubic `Y^2+a1*X*Y+a3*Y=X^3+a2*X^2+a4*X+a6`. If `R` is a field -then this polynomial vanishes iff the cubic curve cut out by this equation is singular. -/ -def EllipticCurve.disc_aux {R : Type*} [comm_ring R] (a1 a2 a3 a4 a6 : R) : R := --432*a6^2 + ((288*a2 + 72*a1^2)*a4 + (-216*a3^2 + (144*a1*a2 + 36*a1^3)*a3 + (-64*a2^3 - -48*a1^2*a2^2 - 12*a1^4*a2 - a1^6)))*a6 + (-64*a4^3 + (-96*a1*a3 + (16*a2^2 + 8*a1^2*a2 + a1^4))*a4^2 -+ ((72*a2 - 30*a1^2)*a3^2 + (16*a1*a2^2 + 8*a1^3*a2 + a1^5)*a3)*a4 + (-27*a3^4 + (36*a1*a2 + -a1^3)*a3^3 + (-16*a2^3 - 8*a1^2*a2^2 - a1^4*a2)*a3^2)) - --- If Pic(R)[12]=0 then this definition is mathematically correct -/-- The category of elliptic curves over `R` (note that this definition is only mathematically -correct for certain rings, for example if `R` is a field or a PID). -/ -structure EllipticCurve (R : Type*) [comm_ring R] := -(a1 a2 a3 a4 a6 : R) -(disc_unit : Rˣ) -(disc_unit_eq : (disc_unit : R) = EllipticCurve.disc_aux a1 a2 a3 a4 a6) - -namespace EllipticCurve - -instance : inhabited (EllipticCurve ℚ) := ⟨⟨0,0,1,-1,0, ⟨37, 37⁻¹, by norm_num, by norm_num⟩, - show (37 : ℚ) = _ + _, by norm_num⟩⟩ - -variables {R : Type*} [comm_ring R] (E : EllipticCurve R) - -/-- The discriminant of an elliptic curve. Sometimes only defined up to sign in the literature; - we choose the sign used by the LMFDB. See - [the LMFDB page on discriminants](https://www.lmfdb.org/knowledge/show/ec.discriminant) - for more discussion. -/ -def disc : R := disc_aux E.a1 E.a2 E.a3 E.a4 E.a6 - -lemma disc_is_unit : is_unit E.disc := -begin - convert units.is_unit E.disc_unit, - exact E.disc_unit_eq.symm -end - -/-- The j-invariant of an elliptic curve. -/ -def j := (-48*E.a4 + (-24*E.a1*E.a3 + (16*E.a2^2 + 8*E.a1^2*E.a2 + E.a1^4)))^3 * - (E.disc_unit⁻¹ : Rˣ) - -end EllipticCurve diff --git a/src/algebraic_geometry/Gamma_Spec_adjunction.lean b/src/algebraic_geometry/Gamma_Spec_adjunction.lean index 1678717709f5f..566db61904700 100644 --- a/src/algebraic_geometry/Gamma_Spec_adjunction.lean +++ b/src/algebraic_geometry/Gamma_Spec_adjunction.lean @@ -10,6 +10,9 @@ import category_theory.adjunction.reflective /-! # Adjunction between `Γ` and `Spec` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the adjunction `Γ_Spec.adjunction : Γ ⊣ Spec` by defining the unit (`to_Γ_Spec`, in multiple steps in this file) and counit (done in Spec.lean) and checking that they satisfy the left and right triangle identities. The constructions and proofs make use of @@ -90,7 +93,7 @@ abbreviation to_Γ_Spec_map_basic_open : opens X := /-- The preimage is the basic open in `X` defined by the same element `r`. -/ lemma to_Γ_Spec_map_basic_open_eq : X.to_Γ_Spec_map_basic_open r = X.to_RingedSpace.basic_open r := -subtype.eq (X.to_Γ_Spec_preim_basic_open_eq r) +opens.ext (X.to_Γ_Spec_preim_basic_open_eq r) /-- The map from the global sections `Γ(X)` to the sections on the (preimage of) a basic open. -/ abbreviation to_to_Γ_Spec_map_basic_open : @@ -183,15 +186,15 @@ begin end /-- The canonical morphism from `X` to the spectrum of its global sections. -/ -@[simps coe_base] +@[simps val_base] def to_Γ_Spec : X ⟶ Spec.LocallyRingedSpace_obj (Γ.obj (op X)) := { val := X.to_Γ_Spec_SheafedSpace, - property := + prop := begin intro x, let p : prime_spectrum (Γ.obj (op X)) := X.to_Γ_Spec_fun x, constructor, /- show stalk map is local hom ↓ -/ - let S := (structure_sheaf _).val.stalk p, + let S := (structure_sheaf _).presheaf.stalk p, rintros (t : S) ht, obtain ⟨⟨r, s⟩, he⟩ := is_localization.surj p.as_ideal.prime_compl t, dsimp at he, @@ -246,7 +249,7 @@ def identity_to_Γ_Spec : 𝟭 LocallyRingedSpace.{u} ⟶ Γ.right_op ⋙ Spec.t apply LocallyRingedSpace.comp_ring_hom_ext, { ext1 x, dsimp [Spec.Top_map, LocallyRingedSpace.to_Γ_Spec_fun], - rw [← subtype.val_eq_coe, ← local_ring.comap_closed_point (PresheafedSpace.stalk_map _ x), + rw [← local_ring.comap_closed_point (PresheafedSpace.stalk_map _ x), ← prime_spectrum.comap_comp_apply, ← prime_spectrum.comap_comp_apply], congr' 2, exact (PresheafedSpace.stalk_map_germ f.1 ⊤ ⟨x,trivial⟩).symm, @@ -272,7 +275,7 @@ begin apply LocallyRingedSpace.comp_ring_hom_ext, { ext (p : prime_spectrum R) x, erw ← is_localization.at_prime.to_map_mem_maximal_iff - ((structure_sheaf R).val.stalk p) p.as_ideal x, + ((structure_sheaf R).presheaf.stalk p) p.as_ideal x, refl }, { intro r, apply to_open_res }, end diff --git a/src/algebraic_geometry/Scheme.lean b/src/algebraic_geometry/Scheme.lean index f05f267c286d1..04f5850f5b0f0 100644 --- a/src/algebraic_geometry/Scheme.lean +++ b/src/algebraic_geometry/Scheme.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import algebraic_geometry.Spec +import algebra.category.Ring.constructions /-! # The category of schemes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A scheme is a locally ringed space such that every point is contained in some open set where there is an isomorphism of presheaves between the restriction to that open set, and the structure sheaf of `Spec R`, for some commutative ring `R`. @@ -39,11 +43,16 @@ structure Scheme extends to_LocallyRingedSpace : LocallyRingedSpace := namespace Scheme +/-- A morphism between schemes is a morphism between the underlying locally ringed spaces. -/ +@[nolint has_nonempty_instance] -- There isn't nessecarily a morphism between two schemes. +def hom (X Y : Scheme) : Type* := +X.to_LocallyRingedSpace ⟶ Y.to_LocallyRingedSpace + /-- Schemes are a full subcategory of locally ringed spaces. -/ instance : category Scheme := -induced_category.category Scheme.to_LocallyRingedSpace +{ hom := hom, ..(induced_category.category Scheme.to_LocallyRingedSpace) } /-- The structure sheaf of a Scheme. -/ protected abbreviation sheaf (X : Scheme) := X.to_SheafedSpace.sheaf @@ -61,16 +70,11 @@ def forget_to_LocallyRingedSpace : Scheme ⥤ LocallyRingedSpace := def forget_to_Top : Scheme ⥤ Top := Scheme.forget_to_LocallyRingedSpace ⋙ LocallyRingedSpace.forget_to_Top -instance {X Y : Scheme} : has_lift_t (X ⟶ Y) - (X.to_SheafedSpace ⟶ Y.to_SheafedSpace) := (@@coe_to_lift $ @@coe_base coe_subtype) - -lemma id_val_base (X : Scheme) : (subtype.val (𝟙 X)).base = 𝟙 _ := rfl - -@[simp] lemma id_coe_base (X : Scheme) : - (↑(𝟙 X) : X.to_SheafedSpace ⟶ X.to_SheafedSpace).base = 𝟙 _ := rfl +@[simp] +lemma id_val_base (X : Scheme) : (𝟙 X : _).1.base = 𝟙 _ := rfl @[simp] lemma id_app {X : Scheme} (U : (opens X.carrier)ᵒᵖ) : - (subtype.val (𝟙 X)).c.app U = X.presheaf.map + (𝟙 X : _).val.c.app U = X.presheaf.map (eq_to_hom (by { induction U using opposite.rec, cases U, refl })) := PresheafedSpace.id_c_app X.to_PresheafedSpace U @@ -80,7 +84,7 @@ lemma comp_val {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) : @[reassoc, simp] lemma comp_coe_base {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) : - (↑(f ≫ g) : X.to_SheafedSpace ⟶ Z.to_SheafedSpace).base = f.val.base ≫ g.val.base := rfl + (f ≫ g).val.base = f.val.base ≫ g.val.base := rfl @[reassoc, elementwise] lemma comp_val_base {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) : @@ -118,6 +122,13 @@ begin refl end +/-- Given a morphism of schemes `f : X ⟶ Y`, and open sets `U ⊆ Y`, `V ⊆ f ⁻¹' U`, +this is the induced map `Γ(Y, U) ⟶ Γ(X, V)`. -/ +abbreviation hom.app_le {X Y : Scheme} + (f : X ⟶ Y) {V : opens X.carrier} {U : opens Y.carrier} (e : V ≤ (opens.map f.1.base).obj U) : + Y.presheaf.obj (op U) ⟶ X.presheaf.obj (op V) := +f.1.c.app (op U) ≫ X.presheaf.map (hom_of_le e).op + /-- The spectrum of a commutative ring, as a scheme. -/ @@ -147,17 +158,26 @@ Spec.LocallyRingedSpace_map_comp f g /-- The spectrum, as a contravariant functor from commutative rings to schemes. -/ -@[simps] def Spec : CommRingᵒᵖ ⥤ Scheme := +-- TODO: make either `Spec_obj` or `Spec.obj` the simp-normal form. `LocallyRingedSpace_obj` is +-- the simp-normal form of `toLocallyRingedSpace.obj`, but adding `simps` here without `attrs := []` +-- for the same effect caused problems in mathlib4. +@[simps {attrs := []}] +def Spec : CommRingᵒᵖ ⥤ Scheme := { obj := λ R, Spec_obj (unop R), map := λ R S f, Spec_map f.unop, map_id' := λ R, by rw [unop_id, Spec_map_id], map_comp' := λ R S T f g, by rw [unop_comp, Spec_map_comp] } /-- -The empty scheme, as `Spec 0`. +The empty scheme. -/ -def empty : Scheme := -Spec_obj (CommRing.of punit) +@[simps] +def {u} empty : Scheme.{u} := +{ carrier := Top.of pempty, + presheaf := (category_theory.functor.const _).obj (CommRing.of punit), + is_sheaf := presheaf.is_sheaf_of_is_terminal _ CommRing.punit_is_terminal, + local_ring := λ x, pempty.elim x, + local_affine := λ x, pempty.elim x } instance : has_emptyc Scheme := ⟨empty⟩ @@ -199,7 +219,7 @@ RingedSpace.mem_basic_open _ f ⟨x, trivial⟩ @[simp] lemma basic_open_res (i : op U ⟶ op V) : - X.basic_open (X.presheaf.map i f) = V ∩ X.basic_open f := + X.basic_open (X.presheaf.map i f) = V ⊓ X.basic_open f := RingedSpace.basic_open_res _ i f -- This should fire before `basic_open_res`. @@ -208,9 +228,11 @@ lemma basic_open_res_eq (i : op U ⟶ op V) [is_iso i] : X.basic_open (X.presheaf.map i f) = X.basic_open f := RingedSpace.basic_open_res_eq _ i f -lemma basic_open_subset : X.basic_open f ⊆ U := -RingedSpace.basic_open_subset _ _ +@[sheaf_restrict] +lemma basic_open_le : X.basic_open f ≤ U := +RingedSpace.basic_open_le _ _ +@[simp] lemma preimage_basic_open {X Y : Scheme} (f : X ⟶ Y) {U : opens Y.carrier} (r : Y.presheaf.obj $ op U) : (opens.map f.1.base).obj (Y.basic_open r) = @@ -218,21 +240,13 @@ lemma preimage_basic_open {X Y : Scheme} (f : X ⟶ Y) {U : opens Y.carrier} LocallyRingedSpace.preimage_basic_open f r @[simp] -lemma preimage_basic_open' {X Y : Scheme} (f : X ⟶ Y) {U : opens Y.carrier} - (r : Y.presheaf.obj $ op U) : - (opens.map (↑f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace).base).obj (Y.basic_open r) = - @Scheme.basic_open X ((opens.map f.1.base).obj U) (f.1.c.app _ r) := -LocallyRingedSpace.preimage_basic_open f r - -@[simp] -lemma basic_open_zero (U : opens X.carrier) : X.basic_open (0 : X.presheaf.obj $ op U) = ∅ := +lemma basic_open_zero (U : opens X.carrier) : X.basic_open (0 : X.presheaf.obj $ op U) = ⊥ := LocallyRingedSpace.basic_open_zero _ U @[simp] lemma basic_open_mul : X.basic_open (f * g) = X.basic_open f ⊓ X.basic_open g := RingedSpace.basic_open_mul _ _ _ -@[simp] lemma basic_open_of_is_unit {f : X.presheaf.obj (op U)} (hf : is_unit f) : X.basic_open f = U := RingedSpace.basic_open_of_is_unit _ hf @@ -261,7 +275,7 @@ lemma basic_open_eq_of_affine' {R : CommRing} prime_spectrum.basic_open ((Spec_Γ_identity.app R).hom f) := begin convert basic_open_eq_of_affine ((Spec_Γ_identity.app R).hom f), - exact (coe_hom_inv_id _ _).symm + exact (iso.hom_inv_id_apply _ _).symm end end algebraic_geometry diff --git a/src/algebraic_geometry/Spec.lean b/src/algebraic_geometry/Spec.lean index 817af71b7c2a6..eff89cbd23173 100644 --- a/src/algebraic_geometry/Spec.lean +++ b/src/algebraic_geometry/Spec.lean @@ -5,14 +5,17 @@ Authors: Scott Morrison, Justus Springer -/ import algebraic_geometry.locally_ringed_space import algebraic_geometry.structure_sheaf -import logic.equiv.transfer_instance import ring_theory.localization.localization_localization import topology.sheaves.sheaf_condition.sites import topology.sheaves.functors +import algebra.module.localized_module /-! # $Spec$ as a functor to locally ringed spaces. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the functor $Spec$ from commutative rings to locally ringed spaces. ## Implementation notes @@ -95,7 +98,7 @@ begin dsimp, erw [PresheafedSpace.id_c_app, comap_id], swap, { rw [Spec.Top_map_id, topological_space.opens.map_id_obj_unop] }, - simpa, + simpa [eq_to_hom_map], end lemma Spec.SheafedSpace_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) : @@ -115,7 +118,7 @@ Spec, as a contravariant functor from commutative rings to sheafed spaces. /-- Spec, as a contravariant functor from commutative rings to presheafed spaces. -/ -def Spec.to_PresheafedSpace : CommRingᵒᵖ ⥤ PresheafedSpace CommRing := +def Spec.to_PresheafedSpace : CommRingᵒᵖ ⥤ PresheafedSpace.{u} CommRing.{u} := Spec.to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace @[simp] lemma Spec.to_PresheafedSpace_obj (R : CommRingᵒᵖ) : @@ -188,26 +191,28 @@ The induced map of a ring homomorphism on the prime spectra, as a morphism of lo -/ @[simps] def Spec.LocallyRingedSpace_map {R S : CommRing} (f : R ⟶ S) : Spec.LocallyRingedSpace_obj S ⟶ Spec.LocallyRingedSpace_obj R := -subtype.mk (Spec.SheafedSpace_map f) $ λ p, is_local_ring_hom.mk $ λ a ha, +LocallyRingedSpace.hom.mk (Spec.SheafedSpace_map f) $ λ p, is_local_ring_hom.mk $ λ a ha, begin -- Here, we are showing that the map on prime spectra induced by `f` is really a morphism of -- *locally* ringed spaces, i.e. that the induced map on the stalks is a local ring homomorphism. rw ← local_ring_hom_comp_stalk_iso_apply at ha, replace ha := (stalk_iso S p).hom.is_unit_map ha, - rw coe_inv_hom_id at ha, + rw iso.inv_hom_id_apply at ha, replace ha := is_local_ring_hom.map_nonunit _ ha, convert ring_hom.is_unit_map (stalk_iso R (prime_spectrum.comap f p)).inv ha, - rw coe_hom_inv_id, + rw iso.hom_inv_id_apply end @[simp] lemma Spec.LocallyRingedSpace_map_id (R : CommRing) : Spec.LocallyRingedSpace_map (𝟙 R) = 𝟙 (Spec.LocallyRingedSpace_obj R) := -subtype.ext $ by { rw [Spec.LocallyRingedSpace_map_coe, Spec.SheafedSpace_map_id], refl } +LocallyRingedSpace.hom.ext _ _ $ + by { rw [Spec.LocallyRingedSpace_map_val, Spec.SheafedSpace_map_id], refl } lemma Spec.LocallyRingedSpace_map_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T) : Spec.LocallyRingedSpace_map (f ≫ g) = Spec.LocallyRingedSpace_map g ≫ Spec.LocallyRingedSpace_map f := -subtype.ext $ by { rw [Spec.LocallyRingedSpace_map_coe, Spec.SheafedSpace_map_comp], refl } +LocallyRingedSpace.hom.ext _ _ $ + by { rw [Spec.LocallyRingedSpace_map_val, Spec.SheafedSpace_map_comp], refl } /-- Spec, as a contravariant functor from commutative rings to locally ringed spaces. @@ -222,7 +227,8 @@ section Spec_Γ open algebraic_geometry.LocallyRingedSpace /-- The counit morphism `R ⟶ Γ(Spec R)` given by `algebraic_geometry.structure_sheaf.to_open`. -/ -@[simps] def to_Spec_Γ (R : CommRing) : R ⟶ Γ.obj (op (Spec.to_LocallyRingedSpace.obj (op R))) := +@[simps {rhs_md := tactic.transparency.semireducible}] +def to_Spec_Γ (R : CommRing) : R ⟶ Γ.obj (op (Spec.to_LocallyRingedSpace.obj (op R))) := structure_sheaf.to_open R ⊤ instance is_iso_to_Spec_Γ (R : CommRing) : is_iso (to_Spec_Γ R) := @@ -255,5 +261,104 @@ begin apply_instance end +namespace structure_sheaf + +variables {R S : CommRing.{u}} (f : R ⟶ S) (p : prime_spectrum R) + +/-- +For an algebra `f : R →+* S`, this is the ring homomorphism `S →+* (f∗ 𝒪ₛ)ₚ` for a `p : Spec R`. +This is shown to be the localization at `p` in `is_localized_module_to_pushforward_stalk_alg_hom`. +-/ +def to_pushforward_stalk : + S ⟶ (Spec.Top_map f _* (structure_sheaf S).1).stalk p := +structure_sheaf.to_open S ⊤ ≫ + @Top.presheaf.germ _ _ _ _ (Spec.Top_map f _* (structure_sheaf S).1) ⊤ ⟨p, trivial⟩ + +@[reassoc] +lemma to_pushforward_stalk_comp : + f ≫ structure_sheaf.to_pushforward_stalk f p = + structure_sheaf.to_stalk R p ≫ + (Top.presheaf.stalk_functor _ _).map (Spec.SheafedSpace_map f).c := +begin + rw structure_sheaf.to_stalk, + erw category.assoc, + rw Top.presheaf.stalk_functor_map_germ, + exact Spec_Γ_naturality_assoc f _, +end + +instance : algebra R ((Spec.Top_map f _* (structure_sheaf S).1).stalk p) := +(f ≫ structure_sheaf.to_pushforward_stalk f p).to_algebra + +lemma algebra_map_pushforward_stalk : + algebra_map R ((Spec.Top_map f _* (structure_sheaf S).1).stalk p) = + f ≫ structure_sheaf.to_pushforward_stalk f p := rfl + +variables (R S) [algebra R S] + +/-- +This is the `alg_hom` version of `to_pushforward_stalk`, which is the map `S ⟶ (f∗ 𝒪ₛ)ₚ` for some +algebra `R ⟶ S` and some `p : Spec R`. +-/ +@[simps] +def to_pushforward_stalk_alg_hom : + S →ₐ[R] (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).stalk p := +{ commutes' := λ _, rfl, ..(structure_sheaf.to_pushforward_stalk (algebra_map R S) p) } + +lemma is_localized_module_to_pushforward_stalk_alg_hom_aux (y) : + ∃ (x : S × p.as_ideal.prime_compl), x.2 • y = to_pushforward_stalk_alg_hom R S p x.1 := +begin + obtain ⟨U, hp, s, e⟩ := Top.presheaf.germ_exist _ _ y, + obtain ⟨_, ⟨r, rfl⟩, hpr : p ∈ prime_spectrum.basic_open r, + hrU : prime_spectrum.basic_open r ≤ U⟩ := prime_spectrum.is_topological_basis_basic_opens + .exists_subset_of_mem_open (show p ∈ ↑U, from hp) U.2, + change prime_spectrum.basic_open r ≤ U at hrU, + replace e := ((Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1) + .germ_res_apply (hom_of_le hrU) ⟨p, hpr⟩ _).trans e, + set s' := (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op s + with h, + rw ← h at e, + clear_value s', clear_dependent U, + obtain ⟨⟨s, ⟨_, n, rfl⟩⟩, hsn⟩ := @is_localization.surj _ _ _ + _ _ _ (structure_sheaf.is_localization.to_basic_open S $ algebra_map R S r) s', + refine ⟨⟨s, ⟨r, hpr⟩ ^ n⟩, _⟩, + rw [submonoid.smul_def, algebra.smul_def, algebra_map_pushforward_stalk, to_pushforward_stalk, + comp_apply, comp_apply], + iterate 2 { erw ← (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).germ_res_apply + (hom_of_le le_top) ⟨p, hpr⟩ }, + rw [← e, ← map_mul, mul_comm], + dsimp only [subtype.coe_mk] at hsn, + rw ← map_pow (algebra_map R S) at hsn, + congr' 1 +end + +instance is_localized_module_to_pushforward_stalk_alg_hom : + is_localized_module p.as_ideal.prime_compl (to_pushforward_stalk_alg_hom R S p).to_linear_map := +begin + apply is_localized_module.mk_of_algebra, + { intros x hx, rw [algebra_map_pushforward_stalk, to_pushforward_stalk_comp, comp_apply], + exact (is_localization.map_units ((structure_sheaf R).presheaf.stalk p) ⟨x, hx⟩).map _ }, + { apply is_localized_module_to_pushforward_stalk_alg_hom_aux }, + { intros x hx, + rw [to_pushforward_stalk_alg_hom_apply, ring_hom.to_fun_eq_coe, + ← (to_pushforward_stalk (algebra_map R S) p).map_zero, to_pushforward_stalk, comp_apply, + comp_apply, map_zero] at hx, + obtain ⟨U, hpU, i₁, i₂, e⟩ := Top.presheaf.germ_eq _ _ _ _ _ _ hx, + obtain ⟨_, ⟨r, rfl⟩, hpr, hrU⟩ := prime_spectrum.is_topological_basis_basic_opens + .exists_subset_of_mem_open (show p ∈ U.1, from hpU) U.2, + change prime_spectrum.basic_open r ≤ U at hrU, + apply_fun (Spec.Top_map (algebra_map R S) _* (structure_sheaf S).1).map (hom_of_le hrU).op at e, + simp only [Top.presheaf.pushforward_obj_map, functor.op_map, map_zero, ← comp_apply, + to_open_res] at e, + have : to_open S (prime_spectrum.basic_open $ algebra_map R S r) x = 0, + { refine eq.trans _ e, refl }, + have := (@is_localization.mk'_one _ _ _ + _ _ _ (structure_sheaf.is_localization.to_basic_open S $ algebra_map R S r) x).trans this, + obtain ⟨⟨_, n, rfl⟩, e⟩ := (is_localization.mk'_eq_zero_iff _ _).mp this, + refine ⟨⟨r, hpr⟩ ^ n, _⟩, + rw [submonoid.smul_def, algebra.smul_def, submonoid.coe_pow, subtype.coe_mk, map_pow], + exact e }, +end + +end structure_sheaf end algebraic_geometry diff --git a/src/algebraic_geometry/elliptic_curve/point.lean b/src/algebraic_geometry/elliptic_curve/point.lean new file mode 100644 index 0000000000000..f8e6785033fa0 --- /dev/null +++ b/src/algebraic_geometry/elliptic_curve/point.lean @@ -0,0 +1,868 @@ +/- +Copyright (c) 2022 David Kurniadi Angdinata. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Kurniadi Angdinata +-/ + +import algebraic_geometry.elliptic_curve.weierstrass +import linear_algebra.free_module.norm +import ring_theory.class_group + +/-! +# Nonsingular rational points on Weierstrass curves + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the type of nonsingular rational points on a Weierstrass curve over a field and +proves that it forms an abelian group under a geometric secant-and-tangent process. + +## Mathematical background + +Let `W` be a Weierstrass curve over a field `F`. A rational point on `W` is simply a point +$[X:Y:Z]$ defined over `F` in the projective plane satisfying the homogeneous cubic equation +$Y^2Z + a_1XYZ + a_3YZ^2 = X^3 + a_2X^2Z + a_4XZ^2 + a_6Z^3$. Any such point either lies in the +affine chart $Z \ne 0$ and satisfies the Weierstrass equation obtained by replacing $X/Z$ with $X$ +and $Y/Z$ with $Y$, or is the unique point at infinity $0 := [0:1:0]$ when $Z = 0$. With this new +description, a nonsingular rational point on `W` is either $0$ or an affine point $(x, y)$ where +the partial derivatives $W_X(X, Y)$ and $W_Y(X, Y)$ do not vanish simultaneously. For a field +extension `K` of `F`, a `K`-rational point is simply a rational point on `W` base changed to `K`. + +The set of nonsingular rational points forms an abelian group under a secant-and-tangent process. + * The identity rational point is `0`. + * Given a nonsingular rational point `P`, its negation `-P` is defined to be the unique third + point of intersection between `W` and the line through `0` and `P`. + Explicitly, if `P` is $(x, y)$, then `-P` is $(x, -y - a_1x - a_3)$. + * Given two points `P` and `Q`, their addition `P + Q` is defined to be the negation of the unique + third point of intersection between `W` and the line `L` through `P` and `Q`. + Explicitly, let `P` be $(x_1, y_1)$ and let `Q` be $(x_2, y_2)$. + * If $x_1 = x_2$ and $y_1 = -y_2 - a_1x_2 - a_3$, then `L` is vertical and `P + Q` is `0`. + * If $x_1 = x_2$ and $y_1 \ne -y_2 - a_1x_2 - a_3$, then `L` is the tangent of `W` at `P = Q`, + and has slope $\ell := (3x_1^2 + 2a_2x_1 + a_4 - a_1y_1) / (2y_1 + a_1x_1 + a_3)$. + * Otherwise $x_1 \ne x_2$, then `L` is the secant of `W` through `P` and `Q`, and has slope + $\ell := (y_1 - y_2) / (x_1 - x_2)$. + In the latter two cases, the $X$-coordinate of `P + Q` is then the unique third solution of the + equation obtained by substituting the line $Y = \ell(X - x_1) + y_1$ into the Weierstrass + equation, and can be written down explicitly as $x := \ell^2 + a_1\ell - a_2 - x_1 - x_2$ by + inspecting the $X^2$ terms. The $Y$-coordinate of `P + Q`, after applying the final negation + that maps $Y$ to $-Y - a_1X - a_3$, is precisely $y := -(\ell(x - x_1) + y_1) - a_1x - a_3$. +The group law on this set is then uniquely determined by these constructions. + +## Main definitions + + * `weierstrass_curve.point`: the type of nonsingular rational points on a Weierstrass curve `W`. + * `weierstrass_curve.point.add`: the addition of two nonsingular rational points on `W`. + +## Main statements + + * `weierstrass_curve.point.add_comm_group`: the type of nonsingular rational points on `W` forms an + abelian group under addition. + +## Notations + + * `W⟮K⟯`: the group of nonsingular rational points on `W` base changed to `K`. + +## References + +[J Silverman, *The Arithmetic of Elliptic Curves*][silverman2009] + +## Tags + +elliptic curve, rational point, group law +-/ + +private meta def map_simp : tactic unit := +`[simp only [map_one, map_bit0, map_bit1, map_neg, map_add, map_sub, _root_.map_mul, map_pow, + map_div₀]] + +private meta def eval_simp : tactic unit := +`[simp only [eval_C, eval_X, eval_neg, eval_add, eval_sub, eval_mul, eval_pow]] + +private meta def C_simp : tactic unit := +`[simp only [C_1, C_bit0, C_bit1, C_neg, C_add, C_sub, C_mul, C_pow]] + +private meta def derivative_simp : tactic unit := +`[simp only [derivative_C, derivative_X, derivative_X_pow, derivative_neg, derivative_add, + derivative_sub, derivative_mul, derivative_sq]] + +universes u v w + +namespace weierstrass_curve + +open coordinate_ring ideal polynomial + +open_locale non_zero_divisors polynomial polynomial_polynomial + +section basic + +/-! ### Polynomials associated to nonsingular rational points on a Weierstrass curve -/ + +variables {R : Type u} [comm_ring R] (W : weierstrass_curve R) (A : Type v) [comm_ring A] + [algebra R A] (B : Type w) [comm_ring B] [algebra R B] [algebra A B] [is_scalar_tower R A B] + (x₁ x₂ y₁ y₂ L : R) + +/-- The polynomial $-Y - a_1X - a_3$ associated to negation. -/ +noncomputable def neg_polynomial : R[X][Y] := -Y - C (C W.a₁ * X + C W.a₃) + +/-- The $Y$-coordinate of the negation of an affine point in `W`. + +This depends on `W`, and has argument order: $x_1$, $y_1$. -/ +@[simp] def neg_Y : R := -y₁ - W.a₁ * x₁ - W.a₃ + +lemma neg_Y_neg_Y : W.neg_Y x₁ (W.neg_Y x₁ y₁) = y₁ := by { simp only [neg_Y], ring1 } + +lemma base_change_neg_Y : + (W.base_change A).neg_Y (algebra_map R A x₁) (algebra_map R A y₁) + = algebra_map R A (W.neg_Y x₁ y₁) := +by { simp only [neg_Y], map_simp, refl } + +lemma base_change_neg_Y_of_base_change (x₁ y₁ : A) : + (W.base_change B).neg_Y (algebra_map A B x₁) (algebra_map A B y₁) + = algebra_map A B ((W.base_change A).neg_Y x₁ y₁) := +by rw [← base_change_neg_Y, base_change_base_change] + +@[simp] lemma eval_neg_polynomial : (W.neg_polynomial.eval $ C y₁).eval x₁ = W.neg_Y x₁ y₁ := +by { rw [neg_Y, sub_sub, neg_polynomial], eval_simp } + +/-- The polynomial $L(X - x_1) + y_1$ associated to the line $Y = L(X - x_1) + y_1$, +with a slope of $L$ that passes through an affine point $(x_1, y_1)$. + +This does not depend on `W`, and has argument order: $x_1$, $y_1$, $L$. -/ +noncomputable def line_polynomial : R[X] := C L * (X - C x₁) + C y₁ + +lemma XY_ideal_eq₁ : XY_ideal W x₁ (C y₁) = XY_ideal W x₁ (line_polynomial x₁ y₁ L) := +begin + simp only [XY_ideal, X_class, Y_class, line_polynomial], + rw [← span_pair_add_mul_right $ adjoin_root.mk _ $ C $ C $ -L, ← _root_.map_mul, ← map_add], + apply congr_arg (_ ∘ _ ∘ _ ∘ _), + C_simp, + ring1 +end + +/-- The polynomial obtained by substituting the line $Y = L*(X - x_1) + y_1$, with a slope of $L$ +that passes through an affine point $(x_1, y_1)$, into the polynomial $W(X, Y)$ associated to `W`. +If such a line intersects `W` at another point $(x_2, y_2)$, then the roots of this polynomial are +precisely $x_1$, $x_2$, and the $X$-coordinate of the addition of $(x_1, y_1)$ and $(x_2, y_2)$. + +This depends on `W`, and has argument order: $x_1$, $y_1$, $L$. -/ +noncomputable def add_polynomial : R[X] := W.polynomial.eval $ line_polynomial x₁ y₁ L + +lemma C_add_polynomial : + C (W.add_polynomial x₁ y₁ L) + = (Y - C (line_polynomial x₁ y₁ L)) * (W.neg_polynomial - C (line_polynomial x₁ y₁ L)) + + W.polynomial := +by { rw [add_polynomial, line_polynomial, weierstrass_curve.polynomial, neg_polynomial], eval_simp, + C_simp, ring1 } + +lemma coordinate_ring.C_add_polynomial : + adjoin_root.mk W.polynomial (C (W.add_polynomial x₁ y₁ L)) + = adjoin_root.mk W.polynomial + ((Y - C (line_polynomial x₁ y₁ L)) * (W.neg_polynomial - C (line_polynomial x₁ y₁ L))) := +adjoin_root.mk_eq_mk.mpr ⟨1, by rw [C_add_polynomial, add_sub_cancel', mul_one]⟩ + +lemma add_polynomial_eq : W.add_polynomial x₁ y₁ L = -cubic.to_poly + ⟨1, -L ^ 2 - W.a₁ * L + W.a₂, + 2 * x₁ * L ^ 2 + (W.a₁ * x₁ - 2 * y₁ - W.a₃) * L + (-W.a₁ * y₁ + W.a₄), + -x₁ ^ 2 * L ^ 2 + (2 * x₁ * y₁ + W.a₃ * x₁) * L - (y₁ ^ 2 + W.a₃ * y₁ - W.a₆)⟩ := +by { rw [add_polynomial, line_polynomial, weierstrass_curve.polynomial, cubic.to_poly], eval_simp, + C_simp, ring1 } + +/-- The $X$-coordinate of the addition of two affine points $(x_1, y_1)$ and $(x_2, y_2)$ in `W`, +where the line through them is not vertical and has a slope of $L$. + +This depends on `W`, and has argument order: $x_1$, $x_2$, $L$. -/ +@[simp] def add_X : R := L ^ 2 + W.a₁ * L - W.a₂ - x₁ - x₂ + +lemma base_change_add_X : + (W.base_change A).add_X (algebra_map R A x₁) (algebra_map R A x₂) (algebra_map R A L) + = algebra_map R A (W.add_X x₁ x₂ L) := +by { simp only [add_X], map_simp, refl } + +lemma base_change_add_X_of_base_change (x₁ x₂ L : A) : + (W.base_change B).add_X (algebra_map A B x₁) (algebra_map A B x₂) (algebra_map A B L) + = algebra_map A B ((W.base_change A).add_X x₁ x₂ L) := +by rw [← base_change_add_X, base_change_base_change] + +/-- The $Y$-coordinate, before applying the final negation, of the addition of two affine points +$(x_1, y_1)$ and $(x_2, y_2)$, where the line through them is not vertical and has a slope of $L$. + +This depends on `W`, and has argument order: $x_1$, $x_2$, $y_1$, $L$. -/ +@[simp] def add_Y' : R := L * (W.add_X x₁ x₂ L - x₁) + y₁ + +lemma base_change_add_Y' : + (W.base_change A).add_Y' (algebra_map R A x₁) (algebra_map R A x₂) (algebra_map R A y₁) + (algebra_map R A L) = algebra_map R A (W.add_Y' x₁ x₂ y₁ L) := +by { simp only [add_Y', base_change_add_X], map_simp } + +lemma base_change_add_Y'_of_base_change (x₁ x₂ y₁ L : A) : + (W.base_change B).add_Y' (algebra_map A B x₁) (algebra_map A B x₂) (algebra_map A B y₁) + (algebra_map A B L) = algebra_map A B ((W.base_change A).add_Y' x₁ x₂ y₁ L) := +by rw [← base_change_add_Y', base_change_base_change] + +/-- The $Y$-coordinate of the addition of two affine points $(x_1, y_1)$ and $(x_2, y_2)$ in `W`, +where the line through them is not vertical and has a slope of $L$. + +This depends on `W`, and has argument order: $x_1$, $x_2$, $y_1$, $L$. -/ +@[simp] def add_Y : R := W.neg_Y (W.add_X x₁ x₂ L) (W.add_Y' x₁ x₂ y₁ L) + +lemma base_change_add_Y : + (W.base_change A).add_Y (algebra_map R A x₁) (algebra_map R A x₂) (algebra_map R A y₁) + (algebra_map R A L) = algebra_map R A (W.add_Y x₁ x₂ y₁ L) := +by simp only [add_Y, base_change_add_Y', base_change_add_X, base_change_neg_Y] + +lemma base_change_add_Y_of_base_change (x₁ x₂ y₁ L : A) : + (W.base_change B).add_Y (algebra_map A B x₁) (algebra_map A B x₂) (algebra_map A B y₁) + (algebra_map A B L) = algebra_map A B ((W.base_change A).add_Y x₁ x₂ y₁ L) := +by rw [← base_change_add_Y, base_change_base_change] + +lemma XY_ideal_add_eq : + XY_ideal W (W.add_X x₁ x₂ L) (C (W.add_Y x₁ x₂ y₁ L)) + = span {adjoin_root.mk W.polynomial $ W.neg_polynomial - C (line_polynomial x₁ y₁ L)} + ⊔ X_ideal W (W.add_X x₁ x₂ L) := +begin + simp only [XY_ideal, X_ideal, X_class, Y_class, add_Y, add_Y', neg_Y, neg_polynomial, + line_polynomial], + conv_rhs { rw [sub_sub, ← neg_add', map_neg, span_singleton_neg, sup_comm, ← span_insert] }, + rw [← span_pair_add_mul_right $ adjoin_root.mk _ $ C $ C $ W.a₁ + L, ← _root_.map_mul, ← map_add], + apply congr_arg (_ ∘ _ ∘ _ ∘ _), + C_simp, + ring1 +end + +lemma equation_add_iff : + W.equation (W.add_X x₁ x₂ L) (W.add_Y' x₁ x₂ y₁ L) + ↔ (W.add_polynomial x₁ y₁ L).eval (W.add_X x₁ x₂ L) = 0 := +by { rw [equation, add_Y', add_polynomial, line_polynomial, weierstrass_curve.polynomial], + eval_simp } + +lemma nonsingular_add_of_eval_derivative_ne_zero + (hx' : W.equation (W.add_X x₁ x₂ L) (W.add_Y' x₁ x₂ y₁ L)) + (hx : (derivative $ W.add_polynomial x₁ y₁ L).eval (W.add_X x₁ x₂ L) ≠ 0) : + W.nonsingular (W.add_X x₁ x₂ L) (W.add_Y' x₁ x₂ y₁ L) := +begin + rw [nonsingular, and_iff_right hx', add_Y', polynomial_X, polynomial_Y], + eval_simp, + contrapose! hx, + rw [add_polynomial, line_polynomial, weierstrass_curve.polynomial], + eval_simp, + derivative_simp, + simp only [zero_add, add_zero, sub_zero, zero_mul, mul_one], + eval_simp, + linear_combination hx.left + L * hx.right with { normalization_tactic := `[norm_num1, ring1] } +end + +/-! ### The type of nonsingular rational points on a Weierstrass curve -/ + +/-- A nonsingular rational point on a Weierstrass curve `W` over `R`. This is either the point at +infinity `weierstrass_curve.point.zero` or an affine point `weierstrass_curve.point.some` $(x, y)$ +satisfying the equation $y^2 + a_1xy + a_3y = x^3 + a_2x^2 + a_4x + a_6$ of `W`. For an algebraic +extension `S` of `R`, the type of nonsingular `S`-rational points on `W` is denoted `W⟮S⟯`. -/ +inductive point +| zero +| some {x y : R} (h : W.nonsingular x y) + +localized "notation W⟮S⟯ := (W.base_change S).point" in weierstrass_curve + +namespace point + +instance : inhabited W.point := ⟨zero⟩ + +instance : has_zero W.point := ⟨zero⟩ + +@[simp] lemma zero_def : (zero : W.point) = 0 := rfl + +end point + +variables {W x₁ y₁} + +lemma equation_neg_iff : W.equation x₁ (W.neg_Y x₁ y₁) ↔ W.equation x₁ y₁ := +by { rw [equation_iff, equation_iff, neg_Y], congr' 2, ring1 } + +lemma equation_neg_of (h : W.equation x₁ $ W.neg_Y x₁ y₁) : W.equation x₁ y₁ := +equation_neg_iff.mp h + +/-- The negation of an affine point in `W` lies in `W`. -/ +lemma equation_neg (h : W.equation x₁ y₁) : W.equation x₁ $ W.neg_Y x₁ y₁ := equation_neg_iff.mpr h + +lemma nonsingular_neg_iff : W.nonsingular x₁ (W.neg_Y x₁ y₁) ↔ W.nonsingular x₁ y₁ := +begin + rw [nonsingular_iff, equation_neg_iff, ← neg_Y, neg_Y_neg_Y, ← @ne_comm _ y₁, nonsingular_iff], + exact and_congr_right' ((iff_congr not_and_distrib.symm not_and_distrib.symm).mpr $ + not_iff_not_of_iff $ and_congr_left $ λ h, by rw [← h]) +end + +lemma nonsingular_neg_of (h : W.nonsingular x₁ $ W.neg_Y x₁ y₁) : W.nonsingular x₁ y₁ := +nonsingular_neg_iff.mp h + +/-- The negation of a nonsingular affine point in `W` is nonsingular. -/ +lemma nonsingular_neg (h : W.nonsingular x₁ y₁) : W.nonsingular x₁ $ W.neg_Y x₁ y₁ := +nonsingular_neg_iff.mpr h + +namespace point + +/-- The negation of a nonsingular rational point. + +Given a nonsingular rational point `P`, use `-P` instead of `neg P`. -/ +def neg : W.point → W.point +| 0 := 0 +| (some h) := some $ nonsingular_neg h + +instance : has_neg W.point := ⟨neg⟩ + +@[simp] lemma neg_def (P : W.point) : P.neg = -P := rfl + +@[simp] lemma neg_zero : (-0 : W.point) = 0 := rfl + +@[simp] lemma neg_some (h : W.nonsingular x₁ y₁) : -some h = some (nonsingular_neg h) := rfl + +instance : has_involutive_neg W.point := ⟨neg, by { rintro (_ | _), { refl }, { simp, ring1 } }⟩ + +end point + +end basic + +section addition + +/-! ### Slopes of lines through nonsingular rational points on a Weierstrass curve -/ + +open_locale classical + +variables {F : Type u} [field F] (W : weierstrass_curve F) (K : Type v) [field K] [algebra F K] + (x₁ x₂ y₁ y₂ : F) + +/-- The slope of the line through two affine points $(x_1, y_1)$ and $(x_2, y_2)$ in `W`. +If $x_1 \ne x_2$, then this line is the secant of `W` through $(x_1, y_1)$ and $(x_2, y_2)$, +and has slope $(y_1 - y_2) / (x_1 - x_2)$. Otherwise, if $y_1 \ne -y_1 - a_1x_1 - a_3$, +then this line is the tangent of `W` at $(x_1, y_1) = (x_2, y_2)$, and has slope +$(3x_1^2 + 2a_2x_1 + a_4 - a_1y_1) / (2y_1 + a_1x_1 + a_3)$. Otherwise, this line is vertical, +and has undefined slope, in which case this function returns the value 0. + +This depends on `W`, and has argument order: $x_1$, $x_2$, $y_1$, $y_2$. -/ +noncomputable def slope : F := +if hx : x₁ = x₂ then if hy : y₁ = W.neg_Y x₂ y₂ then 0 +else (3 * x₁ ^ 2 + 2 * W.a₂ * x₁ + W.a₄ - W.a₁ * y₁) / (y₁ - W.neg_Y x₁ y₁) +else (y₁ - y₂) / (x₁ - x₂) + +variables {W x₁ x₂ y₁ y₂} (h₁ : W.nonsingular x₁ y₁) (h₂ : W.nonsingular x₂ y₂) + (h₁' : W.equation x₁ y₁) (h₂' : W.equation x₂ y₂) + +@[simp] lemma slope_of_Y_eq (hx : x₁ = x₂) (hy : y₁ = W.neg_Y x₂ y₂) : + W.slope x₁ x₂ y₁ y₂ = 0 := +by rw [slope, dif_pos hx, dif_pos hy] + +@[simp] lemma slope_of_Y_ne (hx : x₁ = x₂) (hy : y₁ ≠ W.neg_Y x₂ y₂) : + W.slope x₁ x₂ y₁ y₂ = (3 * x₁ ^ 2 + 2 * W.a₂ * x₁ + W.a₄ - W.a₁ * y₁) / (y₁ - W.neg_Y x₁ y₁) := +by rw [slope, dif_pos hx, dif_neg hy] + +@[simp] lemma slope_of_X_ne (hx : x₁ ≠ x₂) : W.slope x₁ x₂ y₁ y₂ = (y₁ - y₂) / (x₁ - x₂) := +by rw [slope, dif_neg hx] + +lemma slope_of_Y_ne_eq_eval (hx : x₁ = x₂) (hy : y₁ ≠ W.neg_Y x₂ y₂) : + W.slope x₁ x₂ y₁ y₂ + = -(W.polynomial_X.eval $ C y₁).eval x₁ / (W.polynomial_Y.eval $ C y₁).eval x₁ := +by { rw [slope_of_Y_ne hx hy, eval_polynomial_X, neg_sub], congr' 1, rw [neg_Y, eval_polynomial_Y], + ring1 } + +lemma base_change_slope : + (W.base_change K).slope (algebra_map F K x₁) (algebra_map F K x₂) (algebra_map F K y₁) + (algebra_map F K y₂) = algebra_map F K (W.slope x₁ x₂ y₁ y₂) := +begin + by_cases hx : x₁ = x₂, + { by_cases hy : y₁ = W.neg_Y x₂ y₂, + { rw [slope_of_Y_eq hx hy, slope_of_Y_eq $ congr_arg _ hx, map_zero], + { rw [hy, base_change_neg_Y] } }, + { rw [slope_of_Y_ne hx hy, slope_of_Y_ne $ congr_arg _ hx], + { map_simp, + simpa only [base_change_neg_Y] }, + { rw [base_change_neg_Y], + contrapose! hy, + exact no_zero_smul_divisors.algebra_map_injective F K hy } } }, + { rw [slope_of_X_ne hx, slope_of_X_ne], + { map_simp }, + { contrapose! hx, + exact no_zero_smul_divisors.algebra_map_injective F K hx } } +end + +lemma base_change_slope_of_base_change {R : Type u} [comm_ring R] (W : weierstrass_curve R) + (F : Type v) [field F] [algebra R F] (K : Type w) [field K] [algebra R K] [algebra F K] + [is_scalar_tower R F K] (x₁ x₂ y₁ y₂ : F) : + (W.base_change K).slope (algebra_map F K x₁) (algebra_map F K x₂) (algebra_map F K y₁) + (algebra_map F K y₂) = algebra_map F K ((W.base_change F).slope x₁ x₂ y₁ y₂) := +by rw [← base_change_slope, base_change_base_change] + +include h₁' h₂' + +lemma Y_eq_of_X_eq (hx : x₁ = x₂) : y₁ = y₂ ∨ y₁ = W.neg_Y x₂ y₂ := +begin + rw [equation_iff] at h₁' h₂', + rw [← sub_eq_zero, ← @sub_eq_zero _ _ y₁, ← mul_eq_zero, neg_Y], + linear_combination h₁' - h₂' with { normalization_tactic := `[rw [hx], ring1] } +end + +lemma Y_eq_of_Y_ne (hx : x₁ = x₂) (hy : y₁ ≠ W.neg_Y x₂ y₂) : y₁ = y₂ := +or.resolve_right (Y_eq_of_X_eq h₁' h₂' hx) hy + +lemma XY_ideal_eq₂ (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + XY_ideal W x₂ (C y₂) = XY_ideal W x₂ (line_polynomial x₁ y₁ $ W.slope x₁ x₂ y₁ y₂) := +begin + have hy₂ : y₂ = (line_polynomial x₁ y₁ $ W.slope x₁ x₂ y₁ y₂).eval x₂ := + begin + by_cases hx : x₁ = x₂, + { rcases ⟨hx, Y_eq_of_Y_ne h₁' h₂' hx $ hxy hx⟩ with ⟨rfl, rfl⟩, + field_simp [line_polynomial, sub_ne_zero_of_ne (hxy rfl)] }, + { field_simp [line_polynomial, slope_of_X_ne hx, sub_ne_zero_of_ne hx], + ring1 } + end, + nth_rewrite_lhs 0 [hy₂], + simp only [XY_ideal, X_class, Y_class, line_polynomial], + rw [← span_pair_add_mul_right $ adjoin_root.mk W.polynomial $ C $ C $ -W.slope x₁ x₂ y₁ y₂, + ← _root_.map_mul, ← map_add], + apply congr_arg (_ ∘ _ ∘ _ ∘ _), + eval_simp, + C_simp, + ring1 +end + +lemma add_polynomial_slope (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + W.add_polynomial x₁ y₁ (W.slope x₁ x₂ y₁ y₂) + = -((X - C x₁) * (X - C x₂) * (X - C (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂))) := +begin + rw [add_polynomial_eq, neg_inj, cubic.prod_X_sub_C_eq, cubic.to_poly_injective], + by_cases hx : x₁ = x₂, + { rcases ⟨hx, Y_eq_of_Y_ne h₁' h₂' hx (hxy hx)⟩ with ⟨rfl, rfl⟩, + rw [equation_iff] at h₁' h₂', + rw [slope_of_Y_ne rfl $ hxy rfl], + rw [neg_Y, ← sub_ne_zero] at hxy, + ext, + { refl }, + { simp only [add_X], + ring1 }, + { field_simp [hxy rfl], + ring1 }, + { linear_combination -h₁' with { normalization_tactic := `[field_simp [hxy rfl], ring1] } } }, + { rw [equation_iff] at h₁' h₂', + rw [slope_of_X_ne hx], + rw [← sub_eq_zero] at hx, + ext, + { refl }, + { simp only [add_X], + ring1 }, + { apply mul_right_injective₀ hx, + linear_combination h₂' - h₁' with { normalization_tactic := `[field_simp [hx], ring1] } }, + { apply mul_right_injective₀ hx, + linear_combination x₂ * h₁' - x₁ * h₂' + with { normalization_tactic := `[field_simp [hx], ring1] } } } +end + +lemma coordinate_ring.C_add_polynomial_slope (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + adjoin_root.mk W.polynomial (C $ W.add_polynomial x₁ y₁ $ W.slope x₁ x₂ y₁ y₂) + = -(X_class W x₁ * X_class W x₂ * X_class W (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂)) := +by simpa only [add_polynomial_slope h₁' h₂' hxy, map_neg, neg_inj, _root_.map_mul] + +lemma derivative_add_polynomial_slope (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + derivative (W.add_polynomial x₁ y₁ $ W.slope x₁ x₂ y₁ y₂) + = -((X - C x₁) * (X - C x₂) + (X - C x₁) * (X - C (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂)) + + (X - C x₂) * (X - C (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂))) := +by { rw [add_polynomial_slope h₁' h₂' hxy], derivative_simp, ring1 } + +/-! ### The addition law on nonsingular rational points on a Weierstrass curve -/ + +/-- The addition of two affine points in `W` on a sloped line, +before applying the final negation that maps $Y$ to $-Y - a_1X - a_3$, lies in `W`. -/ +lemma equation_add' (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + W.equation (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂) (W.add_Y' x₁ x₂ y₁ $ W.slope x₁ x₂ y₁ y₂) := +by { rw [equation_add_iff, add_polynomial_slope h₁' h₂' hxy], eval_simp, + rw [neg_eq_zero, sub_self, mul_zero] } + +/-- The addition of two affine points in `W` on a sloped line lies in `W`. -/ +lemma equation_add (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + W.equation (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂) (W.add_Y x₁ x₂ y₁ $ W.slope x₁ x₂ y₁ y₂) := +equation_neg $ equation_add' h₁' h₂' hxy + +omit h₁' h₂' + +include h₁ h₂ + +/-- The addition of two nonsingular affine points in `W` on a sloped line, +before applying the final negation that maps $Y$ to $-Y - a_1X - a_3$, is nonsingular. -/ +lemma nonsingular_add' (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + W.nonsingular (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂) (W.add_Y' x₁ x₂ y₁ $ W.slope x₁ x₂ y₁ y₂) := +begin + by_cases hx₁ : W.add_X x₁ x₂ (W.slope x₁ x₂ y₁ y₂) = x₁, + { rwa [add_Y', hx₁, sub_self, mul_zero, zero_add] }, + { by_cases hx₂ : W.add_X x₁ x₂ (W.slope x₁ x₂ y₁ y₂) = x₂, + { by_cases hx : x₁ = x₂, + { subst hx, + contradiction }, + { rwa [add_Y', ← neg_sub, mul_neg, hx₂, slope_of_X_ne hx, + div_mul_cancel _ $ sub_ne_zero_of_ne hx, neg_sub, sub_add_cancel] } }, + { apply W.nonsingular_add_of_eval_derivative_ne_zero _ _ _ _ (equation_add' h₁.1 h₂.1 hxy), + rw [derivative_add_polynomial_slope h₁.left h₂.left hxy], + eval_simp, + simpa only [neg_ne_zero, sub_self, mul_zero, add_zero] + using mul_ne_zero (sub_ne_zero_of_ne hx₁) (sub_ne_zero_of_ne hx₂) } } +end + +/-- The addition of two nonsingular affine points in `W` on a sloped line is nonsingular. -/ +lemma nonsingular_add (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + W.nonsingular (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂) (W.add_Y x₁ x₂ y₁ $ W.slope x₁ x₂ y₁ y₂) := +nonsingular_neg $ nonsingular_add' h₁ h₂ hxy + +omit h₁ h₂ + +namespace point + +variables {h₁ h₂} + +/-- The addition of two nonsingular rational points. + +Given two nonsingular rational points `P` and `Q`, use `P + Q` instead of `add P Q`. -/ +noncomputable def add : W.point → W.point → W.point +| 0 P := P +| P 0 := P +| (@some _ _ _ x₁ y₁ h₁) (@some _ _ _ x₂ y₂ h₂) := +if hx : x₁ = x₂ then if hy : y₁ = W.neg_Y x₂ y₂ then 0 +else some $ nonsingular_add h₁ h₂ $ λ _, hy +else some $ nonsingular_add h₁ h₂ $ λ h, (hx h).elim + +noncomputable instance : has_add W.point := ⟨add⟩ + +@[simp] lemma add_def (P Q : W.point) : P.add Q = P + Q := rfl + +noncomputable instance : add_zero_class W.point := +⟨0, (+), by rintro (_ | _); refl, by rintro (_ | _); refl⟩ + +@[simp] lemma some_add_some_of_Y_eq (hx : x₁ = x₂) (hy : y₁ = W.neg_Y x₂ y₂) : + some h₁ + some h₂ = 0 := +by rw [← add_def, add, dif_pos hx, dif_pos hy] + +@[simp] lemma some_add_self_of_Y_eq (hy : y₁ = W.neg_Y x₁ y₁) : some h₁ + some h₁ = 0 := +some_add_some_of_Y_eq rfl hy + +@[simp] lemma some_add_some_of_Y_ne (hx : x₁ = x₂) (hy : y₁ ≠ W.neg_Y x₂ y₂) : + some h₁ + some h₂ = some (nonsingular_add h₁ h₂ $ λ _, hy) := +by rw [← add_def, add, dif_pos hx, dif_neg hy] + +lemma some_add_some_of_Y_ne' (hx : x₁ = x₂) (hy : y₁ ≠ W.neg_Y x₂ y₂) : + some h₁ + some h₂ = -some (nonsingular_add' h₁ h₂ $ λ _, hy) := +some_add_some_of_Y_ne hx hy + +@[simp] lemma some_add_self_of_Y_ne (hy : y₁ ≠ W.neg_Y x₁ y₁) : + some h₁ + some h₁ = some (nonsingular_add h₁ h₁ $ λ _, hy) := +some_add_some_of_Y_ne rfl hy + +lemma some_add_self_of_Y_ne' (hy : y₁ ≠ W.neg_Y x₁ y₁) : + some h₁ + some h₁ = -some (nonsingular_add' h₁ h₁ $ λ _, hy) := +some_add_some_of_Y_ne rfl hy + +@[simp] lemma some_add_some_of_X_ne (hx : x₁ ≠ x₂) : + some h₁ + some h₂ = some (nonsingular_add h₁ h₂ $ λ h, (hx h).elim) := +by rw [← add_def, add, dif_neg hx] + +lemma some_add_some_of_X_ne' (hx : x₁ ≠ x₂) : + some h₁ + some h₂ = -some (nonsingular_add' h₁ h₂ $ λ h, (hx h).elim) := +some_add_some_of_X_ne hx + +end point + +end addition + +section group + +/-! ### The axioms for nonsingular rational points on a Weierstrass curve -/ + +variables {F : Type u} [field F] {W : weierstrass_curve F} {x₁ x₂ y₁ y₂ : F} + (h₁ : W.nonsingular x₁ y₁) (h₂ : W.nonsingular x₂ y₂) + (h₁' : W.equation x₁ y₁) (h₂' : W.equation x₂ y₂) + +include h₁ + +lemma XY_ideal_neg_mul : XY_ideal W x₁ (C $ W.neg_Y x₁ y₁) * XY_ideal W x₁ (C y₁) = X_ideal W x₁ := +begin + have Y_rw : + (Y - C (C y₁)) * (Y - C (C (W.neg_Y x₁ y₁))) - C (X - C x₁) + * (C (X ^ 2 + C (x₁ + W.a₂) * X + C (x₁ ^ 2 + W.a₂ * x₁ + W.a₄)) - C (C W.a₁) * Y) + = W.polynomial * 1 := + by linear_combination congr_arg C (congr_arg C ((W.equation_iff _ _).mp h₁.left).symm) + with { normalization_tactic := `[rw [neg_Y, weierstrass_curve.polynomial], C_simp, ring1] }, + simp_rw [XY_ideal, X_class, Y_class, span_pair_mul_span_pair, mul_comm, ← _root_.map_mul, + adjoin_root.mk_eq_mk.mpr ⟨1, Y_rw⟩, _root_.map_mul, span_insert, + ← span_singleton_mul_span_singleton, ← mul_sup, ← span_insert], + convert mul_top _ using 2, + simp_rw [← @set.image_singleton _ _ $ adjoin_root.mk _, ← set.image_insert_eq, ← map_span], + convert map_top (adjoin_root.mk W.polynomial) using 1, + apply congr_arg, + simp_rw [eq_top_iff_one, mem_span_insert', mem_span_singleton'], + cases ((W.nonsingular_iff' _ _).mp h₁).right with hx hy, + { let W_X := W.a₁ * y₁ - (3 * x₁ ^ 2 + 2 * W.a₂ * x₁ + W.a₄), + refine ⟨C (C W_X⁻¹ * -(X + C (2 * x₁ + W.a₂))), C (C $ W_X⁻¹ * W.a₁), 0, C (C $ W_X⁻¹ * -1), _⟩, + rw [← mul_right_inj' $ C_ne_zero.mpr $ C_ne_zero.mpr hx], + simp only [mul_add, ← mul_assoc, ← C_mul, mul_inv_cancel hx], + C_simp, + ring1 }, + { let W_Y := 2 * y₁ + W.a₁ * x₁ + W.a₃, + refine ⟨0, C (C W_Y⁻¹), C (C $ W_Y⁻¹ * -1), 0, _⟩, + rw [neg_Y, ← mul_right_inj' $ C_ne_zero.mpr $ C_ne_zero.mpr hy], + simp only [mul_add, ← mul_assoc, ← C_mul, mul_inv_cancel hy], + C_simp, + ring1 } +end + +private lemma XY_ideal'_mul_inv : + (XY_ideal W x₁ (C y₁) : fractional_ideal W.coordinate_ring⁰ W.function_field) + * (XY_ideal W x₁ (C $ W.neg_Y x₁ y₁) * (X_ideal W x₁)⁻¹) = 1 := +by rw [← mul_assoc, ← fractional_ideal.coe_ideal_mul, mul_comm $ XY_ideal W _ _, + XY_ideal_neg_mul h₁, X_ideal, + fractional_ideal.coe_ideal_span_singleton_mul_inv W.function_field $ X_class_ne_zero W x₁] + +omit h₁ + +include h₁' h₂' + +lemma XY_ideal_mul_XY_ideal (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + X_ideal W (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂) * (XY_ideal W x₁ (C y₁) * XY_ideal W x₂ (C y₂)) + = Y_ideal W (line_polynomial x₁ y₁ $ W.slope x₁ x₂ y₁ y₂) + * XY_ideal W (W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂) + (C $ W.add_Y x₁ x₂ y₁ $ W.slope x₁ x₂ y₁ y₂) := +begin + have sup_rw : ∀ a b c d : ideal W.coordinate_ring, a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c := + λ _ _ c _, by rw [← sup_assoc, @sup_comm _ _ c, sup_sup_sup_comm, ← sup_assoc], + rw [XY_ideal_add_eq, X_ideal, mul_comm, W.XY_ideal_eq₁ x₁ y₁ $ W.slope x₁ x₂ y₁ y₂, XY_ideal, + XY_ideal_eq₂ h₁' h₂' hxy, XY_ideal, span_pair_mul_span_pair], + simp_rw [span_insert, sup_rw, sup_mul, span_singleton_mul_span_singleton], + rw [← neg_eq_iff_eq_neg.mpr $ coordinate_ring.C_add_polynomial_slope h₁' h₂' hxy, + span_singleton_neg, coordinate_ring.C_add_polynomial, _root_.map_mul, Y_class], + simp_rw [mul_comm $ X_class W x₁, mul_assoc, ← span_singleton_mul_span_singleton, ← mul_sup], + rw [span_singleton_mul_span_singleton, ← span_insert, + ← span_pair_add_mul_right $ -(X_class W $ W.add_X x₁ x₂ $ W.slope x₁ x₂ y₁ y₂), mul_neg, + ← sub_eq_add_neg, ← sub_mul, ← map_sub, sub_sub_sub_cancel_right, span_insert, + ← span_singleton_mul_span_singleton, ← sup_rw, ← sup_mul, ← sup_mul], + apply congr_arg (_ ∘ _), + convert top_mul _, + simp_rw [X_class, ← @set.image_singleton _ _ $ adjoin_root.mk _, ← map_span, ← ideal.map_sup, + eq_top_iff_one, mem_map_iff_of_surjective _ $ adjoin_root.mk_surjective + W.monic_polynomial, ← span_insert, mem_span_insert', mem_span_singleton'], + by_cases hx : x₁ = x₂, + { rcases ⟨hx, Y_eq_of_Y_ne h₁' h₂' hx (hxy hx)⟩ with ⟨rfl, rfl⟩, + let y := (y₁ - W.neg_Y x₁ y₁) ^ 2, + replace hxy := pow_ne_zero 2 (sub_ne_zero_of_ne $ hxy rfl), + refine + ⟨1 + C (C $ y⁻¹ * 4) * W.polynomial, + ⟨C $ C y⁻¹ * (C 4 * X ^ 2 + C (4 * x₁ + W.b₂) * X + C (4 * x₁ ^ 2 + W.b₂ * x₁ + 2 * W.b₄)), + 0, C (C y⁻¹) * (Y - W.neg_polynomial), _⟩, + by rw [map_add, map_one, _root_.map_mul, adjoin_root.mk_self, mul_zero, add_zero]⟩, + rw [weierstrass_curve.polynomial, neg_polynomial, + ← mul_right_inj' $ C_ne_zero.mpr $ C_ne_zero.mpr hxy], + simp only [mul_add, ← mul_assoc, ← C_mul, mul_inv_cancel hxy], + linear_combination -4 * congr_arg C (congr_arg C $ (W.equation_iff _ _).mp h₁') + with { normalization_tactic := `[rw [b₂, b₄, neg_Y], C_simp, ring1] } }, + { replace hx := sub_ne_zero_of_ne hx, + refine ⟨_, ⟨⟨C $ C (x₁ - x₂)⁻¹, C $ C $ (x₁ - x₂)⁻¹ * -1, 0, _⟩, map_one _⟩⟩, + rw [← mul_right_inj' $ C_ne_zero.mpr $ C_ne_zero.mpr hx], + simp only [← mul_assoc, mul_add, ← C_mul, mul_inv_cancel hx], + C_simp, + ring1 } +end + +omit h₁' h₂' + +/-- The non-zero fractional ideal $\langle X - x, Y - y \rangle$ of $F(W)$ for some $x, y \in F$. -/ +@[simp] noncomputable def XY_ideal' : (fractional_ideal W.coordinate_ring⁰ W.function_field)ˣ := +units.mk_of_mul_eq_one _ _ $ XY_ideal'_mul_inv h₁ + +lemma XY_ideal'_eq : + (XY_ideal' h₁ : fractional_ideal W.coordinate_ring⁰ W.function_field) = XY_ideal W x₁ (C y₁) := +rfl + +local attribute [irreducible] coordinate_ring.comm_ring + +lemma mk_XY_ideal'_mul_mk_XY_ideal'_of_Y_eq : + class_group.mk (XY_ideal' $ nonsingular_neg h₁) * class_group.mk (XY_ideal' h₁) = 1 := +begin + rw [← _root_.map_mul], + exact (class_group.mk_eq_one_of_coe_ideal $ + by exact (fractional_ideal.coe_ideal_mul _ _).symm.trans + (fractional_ideal.coe_ideal_inj.mpr $ XY_ideal_neg_mul h₁)).mpr + ⟨_, X_class_ne_zero W _, rfl⟩ +end + +lemma mk_XY_ideal'_mul_mk_XY_ideal' (hxy : x₁ = x₂ → y₁ ≠ W.neg_Y x₂ y₂) : + class_group.mk (XY_ideal' h₁) * class_group.mk (XY_ideal' h₂) + = class_group.mk (XY_ideal' $ nonsingular_add h₁ h₂ hxy) := +begin + rw [← _root_.map_mul], + exact (class_group.mk_eq_mk_of_coe_ideal (by exact (fractional_ideal.coe_ideal_mul _ _).symm) $ + XY_ideal'_eq _).mpr ⟨_, _, X_class_ne_zero W _, Y_class_ne_zero W _, + XY_ideal_mul_XY_ideal h₁.left h₂.left hxy⟩ +end + +namespace point + +/-- The set function mapping an affine point $(x, y)$ of `W` to the class of the non-zero fractional +ideal $\langle X - x, Y - y \rangle$ of $F(W)$ in the class group of $F[W]$. -/ +@[simp] noncomputable def to_class_fun : W.point → additive (class_group W.coordinate_ring) +| 0 := 0 +| (some h) := additive.of_mul $ class_group.mk $ XY_ideal' h + +/-- The group homomorphism mapping an affine point $(x, y)$ of `W` to the class of the non-zero +fractional ideal $\langle X - x, Y - y \rangle$ of $F(W)$ in the class group of $F[W]$. -/ +@[simps] noncomputable def to_class : W.point →+ additive (class_group W.coordinate_ring) := +{ to_fun := to_class_fun, + map_zero' := rfl, + map_add' := + begin + rintro (_ | @⟨x₁, y₁, h₁⟩) (_ | @⟨x₂, y₂, h₂⟩), + any_goals { simp only [zero_def, to_class_fun, _root_.zero_add, _root_.add_zero] }, + by_cases hx : x₁ = x₂, + { by_cases hy : y₁ = W.neg_Y x₂ y₂, + { substs hx hy, + simpa only [some_add_some_of_Y_eq rfl rfl] + using (mk_XY_ideal'_mul_mk_XY_ideal'_of_Y_eq h₂).symm }, + { simpa only [some_add_some_of_Y_ne hx hy] + using (mk_XY_ideal'_mul_mk_XY_ideal' h₁ h₂ $ λ _, hy).symm } }, + { simpa only [some_add_some_of_X_ne hx] + using (mk_XY_ideal'_mul_mk_XY_ideal' h₁ h₂ $ λ h, (hx h).elim).symm } + end } + +@[simp] lemma to_class_zero : to_class (0 : W.point) = 0 := rfl + +lemma to_class_some : to_class (some h₁) = class_group.mk (XY_ideal' h₁) := rfl + +@[simp] lemma add_eq_zero (P Q : W.point) : P + Q = 0 ↔ P = -Q := +begin + rcases ⟨P, Q⟩ with ⟨_ | @⟨x₁, y₁, _⟩, _ | @⟨x₂, y₂, _⟩⟩, + any_goals { refl }, + { rw [zero_def, zero_add, ← neg_eq_iff_eq_neg, neg_zero, eq_comm] }, + { simp only [neg_some], + split, + { intro h, + by_cases hx : x₁ = x₂, + { by_cases hy : y₁ = W.neg_Y x₂ y₂, + { exact ⟨hx, hy⟩ }, + { rw [some_add_some_of_Y_ne hx hy] at h, + contradiction } }, + { rw [some_add_some_of_X_ne hx] at h, + contradiction } }, + { exact λ ⟨hx, hy⟩, some_add_some_of_Y_eq hx hy } } +end + +@[simp] lemma add_left_neg (P : W.point) : -P + P = 0 := by rw [add_eq_zero] + +@[simp] lemma neg_add_eq_zero (P Q : W.point) : -P + Q = 0 ↔ P = Q := by rw [add_eq_zero, neg_inj] + +lemma to_class_eq_zero (P : W.point) : to_class P = 0 ↔ P = 0 := +⟨begin + intro hP, + rcases P with (_ | @⟨_, _, ⟨h, _⟩⟩), + { refl }, + { rcases (class_group.mk_eq_one_of_coe_ideal $ by refl).mp hP with ⟨p, h0, hp⟩, + apply (p.nat_degree_norm_ne_one _).elim, + rw [← finrank_quotient_span_eq_nat_degree_norm W^.coordinate_ring.basis h0, + ← (quotient_equiv_alg_of_eq F hp).to_linear_equiv.finrank_eq, + (quotient_XY_ideal_equiv W h).to_linear_equiv.finrank_eq, finite_dimensional.finrank_self] } +end, congr_arg to_class⟩ + +lemma to_class_injective : function.injective $ @to_class _ _ W := +begin + rintro (_ | h) _ hP, + all_goals { rw [← neg_add_eq_zero, ← to_class_eq_zero, map_add, ← hP] }, + { exact zero_add 0 }, + { exact mk_XY_ideal'_mul_mk_XY_ideal'_of_Y_eq h } +end + +lemma add_comm (P Q : W.point) : P + Q = Q + P := +to_class_injective $ by simp only [map_add, add_comm] + +lemma add_assoc (P Q R : W.point) : P + Q + R = P + (Q + R) := +to_class_injective $ by simp only [map_add, add_assoc] + +noncomputable instance : add_comm_group W.point := +{ zero := zero, + neg := neg, + add := add, + zero_add := zero_add, + add_zero := add_zero, + add_left_neg := add_left_neg, + add_comm := add_comm, + add_assoc := add_assoc } + +end point + +end group + +section base_change + +/-! ### Nonsingular rational points on a base changed Weierstrass curve -/ + +variables {R : Type u} [comm_ring R] (W : weierstrass_curve R) (F : Type v) [field F] [algebra R F] + (K : Type w) [field K] [algebra R K] [algebra F K] [is_scalar_tower R F K] + +namespace point + +open_locale weierstrass_curve + +/-- The function from `W⟮F⟯` to `W⟮K⟯` induced by a base change from `F` to `K`. -/ +def of_base_change_fun : W⟮F⟯ → W⟮K⟯ +| 0 := 0 +| (some h) := some $ (nonsingular_iff_base_change_of_base_change W F K _ _).mp h + +/-- The group homomorphism from `W⟮F⟯` to `W⟮K⟯` induced by a base change from `F` to `K`. -/ +@[simps] def of_base_change : W⟮F⟯ →+ W⟮K⟯ := +{ to_fun := of_base_change_fun W F K, + map_zero' := rfl, + map_add' := + begin + rintro (_ | @⟨x₁, y₁, _⟩) (_ | @⟨x₂, y₂, _⟩), + any_goals { refl }, + by_cases hx : x₁ = x₂, + { by_cases hy : y₁ = (W.base_change F).neg_Y x₂ y₂, + { simp only [some_add_some_of_Y_eq hx hy, of_base_change_fun], + rw [some_add_some_of_Y_eq $ congr_arg _ hx], + { rw [hy, base_change_neg_Y_of_base_change] } }, + { simp only [some_add_some_of_Y_ne hx hy, of_base_change_fun], + rw [some_add_some_of_Y_ne $ congr_arg _ hx], + { simp only [base_change_add_X_of_base_change, base_change_add_Y_of_base_change, + base_change_slope_of_base_change], + exact ⟨rfl, rfl⟩ }, + { rw [base_change_neg_Y_of_base_change], + contrapose! hy, + exact no_zero_smul_divisors.algebra_map_injective F K hy } } }, + { simp only [some_add_some_of_X_ne hx, of_base_change_fun], + rw [some_add_some_of_X_ne], + { simp only [base_change_add_X_of_base_change, base_change_add_Y_of_base_change, + base_change_slope_of_base_change], + exact ⟨rfl, rfl⟩ }, + { contrapose! hx, + exact no_zero_smul_divisors.algebra_map_injective F K hx } } + end } + +lemma of_base_change_injective : function.injective $ of_base_change W F K := +begin + rintro (_ | _) (_ | _) h, + { refl }, + any_goals { contradiction }, + simp only, + exact ⟨no_zero_smul_divisors.algebra_map_injective F K (some.inj h).left, + no_zero_smul_divisors.algebra_map_injective F K (some.inj h).right⟩ +end + +end point + +end base_change + +end weierstrass_curve + +namespace elliptic_curve + +/-! ### Rational points on an elliptic curve -/ + +namespace point + +variables {R : Type} [nontrivial R] [comm_ring R] (E : elliptic_curve R) + +/-- An affine point on an elliptic curve `E` over `R`. -/ +def mk {x y : R} (h : E.equation x y) : E.point := weierstrass_curve.point.some $ E.nonsingular h + +end point + +end elliptic_curve diff --git a/src/algebraic_geometry/elliptic_curve/weierstrass.lean b/src/algebraic_geometry/elliptic_curve/weierstrass.lean new file mode 100644 index 0000000000000..ea856a6ac27ac --- /dev/null +++ b/src/algebraic_geometry/elliptic_curve/weierstrass.lean @@ -0,0 +1,712 @@ +/- +Copyright (c) 2021 Kevin Buzzard. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin Buzzard, David Kurniadi Angdinata +-/ + +import algebra.cubic_discriminant +import ring_theory.norm +import tactic.linear_combination + +/-! +# Weierstrass equations of elliptic curves + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the structure of an elliptic curve as a nonsingular Weierstrass curve given by a +Weierstrass equation, which is mathematically accurate in many cases but also good for computation. + +## Mathematical background + +Let `S` be a scheme. The actual category of elliptic curves over `S` is a large category, whose +objects are schemes `E` equipped with a map `E → S`, a section `S → E`, and some axioms (the map +is smooth and proper and the fibres are geometrically-connected one-dimensional group varieties). In +the special case where `S` is the spectrum of some commutative ring `R` whose Picard group is zero +(this includes all fields, all PIDs, and many other commutative rings) it can be shown (using a lot +of algebro-geometric machinery) that every elliptic curve `E` is a projective plane cubic isomorphic +to a Weierstrass curve given by the equation $Y^2 + a_1XY + a_3Y = X^3 + a_2X^2 + a_4X + a_6$ for +some $a_i$ in `R`, and such that a certain quantity called the discriminant of `E` is a unit in `R`. +If `R` is a field, this quantity divides the discriminant of a cubic polynomial whose roots over a +splitting field of `R` are precisely the $X$-coordinates of the non-zero 2-torsion points of `E`. + +## Main definitions + + * `weierstrass_curve`: a Weierstrass curve over a commutative ring. + * `weierstrass_curve.Δ`: the discriminant of a Weierstrass curve. + * `weierstrass_curve.variable_change`: the Weierstrass curve induced by a change of variables. + * `weierstrass_curve.base_change`: the Weierstrass curve base changed over an algebra. + * `weierstrass_curve.two_torsion_polynomial`: the 2-torsion polynomial of a Weierstrass curve. + * `weierstrass_curve.polynomial`: the polynomial associated to a Weierstrass curve. + * `weierstrass_curve.equation`: the Weirstrass equation of a Weierstrass curve. + * `weierstrass_curve.nonsingular`: the nonsingular condition at a point on a Weierstrass curve. + * `weierstrass_curve.coordinate_ring`: the coordinate ring of a Weierstrass curve. + * `weierstrass_curve.function_field`: the function field of a Weierstrass curve. + * `weierstrass_curve.coordinate_ring.basis`: the power basis of the coordinate ring over `R[X]`. + * `elliptic_curve`: an elliptic curve over a commutative ring. + * `elliptic_curve.j`: the j-invariant of an elliptic curve. + +## Main statements + + * `weierstrass_curve.two_torsion_polynomial_disc`: the discriminant of a Weierstrass curve is a + constant factor of the cubic discriminant of its 2-torsion polynomial. + * `weierstrass_curve.nonsingular_of_Δ_ne_zero`: a Weierstrass curve is nonsingular at every point + if its discriminant is non-zero. + * `weierstrass_curve.coordinate_ring.is_domain`: the coordinate ring of a Weierstrass curve is + an integral domain. + * `weierstrass_curve.coordinate_ring.degree_norm_smul_basis`: the degree of the norm of an element + in the coordinate ring in terms of the power basis. + * `elliptic_curve.nonsingular`: an elliptic curve is nonsingular at every point. + * `elliptic_curve.variable_change_j`: the j-invariant of an elliptic curve is invariant under an + admissible linear change of variables. + +## Implementation notes + +The definition of elliptic curves in this file makes sense for all commutative rings `R`, but it +only gives a type which can be beefed up to a category which is equivalent to the category of +elliptic curves over the spectrum $\mathrm{Spec}(R)$ of `R` in the case that `R` has trivial Picard +group $\mathrm{Pic}(R)$ or, slightly more generally, when its 12-torsion is trivial. The issue is +that for a general ring `R`, there might be elliptic curves over $\mathrm{Spec}(R)$ in the sense of +algebraic geometry which are not globally defined by a cubic equation valid over the entire base. + +## References + + * [N Katz and B Mazur, *Arithmetic Moduli of Elliptic Curves*][katz_mazur] + * [P Deligne, *Courbes Elliptiques: Formulaire (d'après J. Tate)*][deligne_formulaire] + * [J Silverman, *The Arithmetic of Elliptic Curves*][silverman2009] + +## Tags + +elliptic curve, weierstrass equation, j invariant +-/ + +private meta def map_simp : tactic unit := +`[simp only [map_one, map_bit0, map_bit1, map_neg, map_add, map_sub, map_mul, map_pow]] + +private meta def eval_simp : tactic unit := +`[simp only [eval_C, eval_X, eval_add, eval_sub, eval_mul, eval_pow]] + +private meta def C_simp : tactic unit := `[simp only [C_0, C_1, C_neg, C_add, C_sub, C_mul, C_pow]] + +universes u v w + +variable {R : Type u} + +/-! ## Weierstrass curves -/ + +/-- A Weierstrass curve $Y^2 + a_1XY + a_3Y = X^3 + a_2X^2 + a_4X + a_6$ with parameters $a_i$. -/ +@[ext] structure weierstrass_curve (R : Type u) := (a₁ a₂ a₃ a₄ a₆ : R) + +instance [inhabited R] : inhabited $ weierstrass_curve R := +⟨⟨default, default, default, default, default⟩⟩ + +namespace weierstrass_curve + +variables [comm_ring R] (W : weierstrass_curve R) + +section quantity + +/-! ### Standard quantities -/ + +/-- The `b₂` coefficient of a Weierstrass curve. -/ +@[simp] def b₂ : R := W.a₁ ^ 2 + 4 * W.a₂ + +/-- The `b₄` coefficient of a Weierstrass curve. -/ +@[simp] def b₄ : R := 2 * W.a₄ + W.a₁ * W.a₃ + +/-- The `b₆` coefficient of a Weierstrass curve. -/ +@[simp] def b₆ : R := W.a₃ ^ 2 + 4 * W.a₆ + +/-- The `b₈` coefficient of a Weierstrass curve. -/ +@[simp] def b₈ : R := +W.a₁ ^ 2 * W.a₆ + 4 * W.a₂ * W.a₆ - W.a₁ * W.a₃ * W.a₄ + W.a₂ * W.a₃ ^ 2 - W.a₄ ^ 2 + +lemma b_relation : 4 * W.b₈ = W.b₂ * W.b₆ - W.b₄ ^ 2 := by { simp only [b₂, b₄, b₆, b₈], ring1 } + +/-- The `c₄` coefficient of a Weierstrass curve. -/ +@[simp] def c₄ : R := W.b₂ ^ 2 - 24 * W.b₄ + +/-- The `c₆` coefficient of a Weierstrass curve. -/ +@[simp] def c₆ : R := -W.b₂ ^ 3 + 36 * W.b₂ * W.b₄ - 216 * W.b₆ + +/-- The discriminant `Δ` of a Weierstrass curve. If `R` is a field, then this polynomial vanishes +if and only if the cubic curve cut out by this equation is singular. Sometimes only defined up to +sign in the literature; we choose the sign used by the LMFDB. For more discussion, see +[the LMFDB page on discriminants](https://www.lmfdb.org/knowledge/show/ec.discriminant). -/ +@[simp] def Δ : R := -W.b₂ ^ 2 * W.b₈ - 8 * W.b₄ ^ 3 - 27 * W.b₆ ^ 2 + 9 * W.b₂ * W.b₄ * W.b₆ + +lemma c_relation : 1728 * W.Δ = W.c₄ ^ 3 - W.c₆ ^ 2 := +by { simp only [b₂, b₄, b₆, b₈, c₄, c₆, Δ], ring1 } + +end quantity + +section variable_change + +/-! ### Variable changes -/ + +variables (u : Rˣ) (r s t : R) + +/-- The Weierstrass curve over `R` induced by an admissible linear change of variables +$(X, Y) \mapsto (u^2X + r, u^3Y + u^2sX + t)$ for some $u \in R^\times$ and some $r, s, t \in R$. -/ +@[simps] def variable_change : weierstrass_curve R := +{ a₁ := ↑u⁻¹ * (W.a₁ + 2 * s), + a₂ := ↑u⁻¹ ^ 2 * (W.a₂ - s * W.a₁ + 3 * r - s ^ 2), + a₃ := ↑u⁻¹ ^ 3 * (W.a₃ + r * W.a₁ + 2 * t), + a₄ := ↑u⁻¹ ^ 4 * (W.a₄ - s * W.a₃ + 2 * r * W.a₂ - (t + r * s) * W.a₁ + 3 * r ^ 2 - 2 * s * t), + a₆ := ↑u⁻¹ ^ 6 * (W.a₆ + r * W.a₄ + r ^ 2 * W.a₂ + r ^ 3 - t * W.a₃ - t ^ 2 - r * t * W.a₁) } + +@[simp] lemma variable_change_b₂ : (W.variable_change u r s t).b₂ = ↑u⁻¹ ^ 2 * (W.b₂ + 12 * r) := +by { simp only [b₂, variable_change_a₁, variable_change_a₂], ring1 } + +@[simp] lemma variable_change_b₄ : + (W.variable_change u r s t).b₄ = ↑u⁻¹ ^ 4 * (W.b₄ + r * W.b₂ + 6 * r ^ 2) := +by { simp only [b₂, b₄, variable_change_a₁, variable_change_a₃, variable_change_a₄], ring1 } + +@[simp] lemma variable_change_b₆ : + (W.variable_change u r s t).b₆ = ↑u⁻¹ ^ 6 * (W.b₆ + 2 * r * W.b₄ + r ^ 2 * W.b₂ + 4 * r ^ 3) := +by { simp only [b₂, b₄, b₆, variable_change_a₃, variable_change_a₆], ring1 } + +@[simp] lemma variable_change_b₈ : + (W.variable_change u r s t).b₈ + = ↑u⁻¹ ^ 8 * (W.b₈ + 3 * r * W.b₆ + 3 * r ^ 2 * W.b₄ + r ^ 3 * W.b₂ + 3 * r ^ 4) := +by { simp only [b₂, b₄, b₆, b₈, variable_change_a₁, variable_change_a₂, variable_change_a₃, + variable_change_a₄, variable_change_a₆], ring1 } + +@[simp] lemma variable_change_c₄ : (W.variable_change u r s t).c₄ = ↑u⁻¹ ^ 4 * W.c₄ := +by { simp only [c₄, variable_change_b₂, variable_change_b₄], ring1 } + +@[simp] lemma variable_change_c₆ : (W.variable_change u r s t).c₆ = ↑u⁻¹ ^ 6 * W.c₆ := +by { simp only [c₆, variable_change_b₂, variable_change_b₄, variable_change_b₆], ring1 } + +@[simp] lemma variable_change_Δ : (W.variable_change u r s t).Δ = ↑u⁻¹ ^ 12 * W.Δ := +by { dsimp, ring1 } + +end variable_change + +variables (A : Type v) [comm_ring A] [algebra R A] (B : Type w) [comm_ring B] [algebra R B] + [algebra A B] [is_scalar_tower R A B] + +section base_change + +/-! ### Base changes -/ + +/-- The Weierstrass curve over `R` base changed to `A`. -/ +@[simps] def base_change : weierstrass_curve A := +⟨algebra_map R A W.a₁, algebra_map R A W.a₂, algebra_map R A W.a₃, algebra_map R A W.a₄, +algebra_map R A W.a₆⟩ + +@[simp] lemma base_change_b₂ : (W.base_change A).b₂ = algebra_map R A W.b₂ := +by { simp only [b₂, base_change_a₁, base_change_a₂], map_simp } + +@[simp] lemma base_change_b₄ : (W.base_change A).b₄ = algebra_map R A W.b₄ := +by { simp only [b₄, base_change_a₁, base_change_a₃, base_change_a₄], map_simp } + +@[simp] lemma base_change_b₆ : (W.base_change A).b₆ = algebra_map R A W.b₆ := +by { simp only [b₆, base_change_a₃, base_change_a₆], map_simp } + +@[simp] lemma base_change_b₈ : (W.base_change A).b₈ = algebra_map R A W.b₈ := +by { simp only [b₈, base_change_a₁, base_change_a₂, base_change_a₃, base_change_a₄, base_change_a₆], + map_simp } + +@[simp] lemma base_change_c₄ : (W.base_change A).c₄ = algebra_map R A W.c₄ := +by { simp only [c₄, base_change_b₂, base_change_b₄], map_simp } + +@[simp] lemma base_change_c₆ : (W.base_change A).c₆ = algebra_map R A W.c₆ := +by { simp only [c₆, base_change_b₂, base_change_b₄, base_change_b₆], map_simp } + +@[simp, nolint simp_nf] lemma base_change_Δ : (W.base_change A).Δ = algebra_map R A W.Δ := +by { simp only [Δ, base_change_b₂, base_change_b₄, base_change_b₆, base_change_b₈], map_simp } + +lemma base_change_self : W.base_change R = W := by ext; refl + +lemma base_change_base_change : (W.base_change A).base_change B = W.base_change B := +by ext; exact (is_scalar_tower.algebra_map_apply R A B _).symm + +end base_change + +section torsion_polynomial + +/-! ### 2-torsion polynomials -/ + +/-- A cubic polynomial whose discriminant is a multiple of the Weierstrass curve discriminant. If +`W` is an elliptic curve over a field `R` of characteristic different from 2, then its roots over a +splitting field of `R` are precisely the $X$-coordinates of the non-zero 2-torsion points of `W`. -/ +def two_torsion_polynomial : cubic R := ⟨4, W.b₂, 2 * W.b₄, W.b₆⟩ + +lemma two_torsion_polynomial_disc : W.two_torsion_polynomial.disc = 16 * W.Δ := +by { dsimp [two_torsion_polynomial, cubic.disc], ring1 } + +lemma two_torsion_polynomial_disc_is_unit [invertible (2 : R)] : + is_unit W.two_torsion_polynomial.disc ↔ is_unit W.Δ := +begin + rw [two_torsion_polynomial_disc, is_unit.mul_iff, show (16 : R) = 2 ^ 4, by norm_num1], + exact and_iff_right (is_unit_of_invertible $ 2 ^ 4) +end + +lemma two_torsion_polynomial_disc_ne_zero [nontrivial R] [invertible (2 : R)] (hΔ : is_unit W.Δ) : + W.two_torsion_polynomial.disc ≠ 0 := +(W.two_torsion_polynomial_disc_is_unit.mpr hΔ).ne_zero + +end torsion_polynomial + +localized "notation (name := outer_variable) `Y` := polynomial.X" in polynomial_polynomial + +localized "notation (name := polynomial_polynomial) R`[X][Y]` := polynomial (polynomial R)" + in polynomial_polynomial + +section polynomial + +/-! ### Weierstrass equations -/ + +open polynomial + +open_locale polynomial polynomial_polynomial + +/-- The polynomial $W(X, Y) := Y^2 + a_1XY + a_3Y - (X^3 + a_2X^2 + a_4X + a_6)$ associated to a +Weierstrass curve `W` over `R`. For ease of polynomial manipulation, this is represented as a term +of type `R[X][X]`, where the inner variable represents $X$ and the outer variable represents $Y$. +For clarity, the alternative notations `Y` and `R[X][Y]` are provided in the `polynomial_polynomial` +locale to represent the outer variable and the bivariate polynomial ring `R[X][X]` respectively. -/ +protected noncomputable def polynomial : R[X][Y] := +Y ^ 2 + C (C W.a₁ * X + C W.a₃) * Y - C (X ^ 3 + C W.a₂ * X ^ 2 + C W.a₄ * X + C W.a₆) + +lemma polynomial_eq : W.polynomial = cubic.to_poly + ⟨0, 1, cubic.to_poly ⟨0, 0, W.a₁, W.a₃⟩, cubic.to_poly ⟨-1, -W.a₂, -W.a₄, -W.a₆⟩⟩ := +by { simp only [weierstrass_curve.polynomial, cubic.to_poly], C_simp, ring1 } + +lemma polynomial_ne_zero [nontrivial R] : W.polynomial ≠ 0 := +by { rw [polynomial_eq], exact cubic.ne_zero_of_b_ne_zero one_ne_zero } + +@[simp] lemma degree_polynomial [nontrivial R] : W.polynomial.degree = 2 := +by { rw [polynomial_eq], exact cubic.degree_of_b_ne_zero' one_ne_zero } + +@[simp] lemma nat_degree_polynomial [nontrivial R] : W.polynomial.nat_degree = 2 := +by { rw [polynomial_eq], exact cubic.nat_degree_of_b_ne_zero' one_ne_zero } + +lemma monic_polynomial : W.polynomial.monic := +by { nontriviality R, simpa only [polynomial_eq] using cubic.monic_of_b_eq_one' } + +lemma irreducible_polynomial [is_domain R] : irreducible W.polynomial := +begin + by_contra h, + rcases (W.monic_polynomial.not_irreducible_iff_exists_add_mul_eq_coeff W.nat_degree_polynomial).mp + h with ⟨f, g, h0, h1⟩, + simp only [polynomial_eq, cubic.coeff_eq_c, cubic.coeff_eq_d] at h0 h1, + apply_fun degree at h0 h1, + rw [cubic.degree_of_a_ne_zero' $ neg_ne_zero.mpr $ one_ne_zero' R, degree_mul] at h0, + apply (h1.symm.le.trans cubic.degree_of_b_eq_zero').not_lt, + rcases nat.with_bot.add_eq_three_iff.mp h0.symm with h | h | h | h, + any_goals { rw [degree_add_eq_left_of_degree_lt]; simp only [h]; dec_trivial }, + any_goals { rw [degree_add_eq_right_of_degree_lt]; simp only [h]; dec_trivial } +end + +@[simp] lemma eval_polynomial (x y : R) : + (W.polynomial.eval $ C y).eval x + = y ^ 2 + W.a₁ * x * y + W.a₃ * y - (x ^ 3 + W.a₂ * x ^ 2 + W.a₄ * x + W.a₆) := +by { simp only [weierstrass_curve.polynomial], eval_simp, rw [add_mul, ← add_assoc] } + +@[simp] lemma eval_polynomial_zero : (W.polynomial.eval 0).eval 0 = -W.a₆ := +by simp only [← C_0, eval_polynomial, zero_add, zero_sub, mul_zero, zero_pow (nat.zero_lt_succ _)] + +/-- The proposition that an affine point $(x, y)$ lies in `W`. In other words, $W(x, y) = 0$. -/ +def equation (x y : R) : Prop := (W.polynomial.eval $ C y).eval x = 0 + +lemma equation_iff' (x y : R) : + W.equation x y ↔ y ^ 2 + W.a₁ * x * y + W.a₃ * y - (x ^ 3 + W.a₂ * x ^ 2 + W.a₄ * x + W.a₆) = 0 := +by rw [equation, eval_polynomial] + +@[simp] lemma equation_iff (x y : R) : + W.equation x y ↔ y ^ 2 + W.a₁ * x * y + W.a₃ * y = x ^ 3 + W.a₂ * x ^ 2 + W.a₄ * x + W.a₆ := +by rw [equation_iff', sub_eq_zero] + +@[simp] lemma equation_zero : W.equation 0 0 ↔ W.a₆ = 0 := +by rw [equation, C_0, eval_polynomial_zero, neg_eq_zero] + +lemma equation_iff_variable_change (x y : R) : + W.equation x y ↔ (W.variable_change 1 x 0 y).equation 0 0 := +begin + rw [equation_iff', ← neg_eq_zero, equation_zero, variable_change_a₆, inv_one, units.coe_one], + congr' 2, + ring1 +end + +lemma equation_iff_base_change [nontrivial A] [no_zero_smul_divisors R A] (x y : R) : + W.equation x y ↔ (W.base_change A).equation (algebra_map R A x) (algebra_map R A y) := +begin + simp only [equation_iff], + refine ⟨λ h, _, λ h, _⟩, + { convert congr_arg (algebra_map R A) h; { map_simp, refl } }, + { apply no_zero_smul_divisors.algebra_map_injective R A, map_simp, exact h } +end + +lemma equation_iff_base_change_of_base_change [nontrivial B] [no_zero_smul_divisors A B] (x y : A) : + (W.base_change A).equation x y + ↔ (W.base_change B).equation (algebra_map A B x) (algebra_map A B y) := +by rw [equation_iff_base_change (W.base_change A) B, base_change_base_change] + +/-! ### Nonsingularity of Weierstrass curves -/ + +/-- The partial derivative $W_X(X, Y)$ of $W(X, Y)$ with respect to $X$. + +TODO: define this in terms of `polynomial.derivative`. -/ +noncomputable def polynomial_X : R[X][Y] := +C (C W.a₁) * Y - C (C 3 * X ^ 2 + C (2 * W.a₂) * X + C W.a₄) + +@[simp] lemma eval_polynomial_X (x y : R) : + (W.polynomial_X.eval $ C y).eval x = W.a₁ * y - (3 * x ^ 2 + 2 * W.a₂ * x + W.a₄) := +by { simp only [polynomial_X], eval_simp } + +@[simp] lemma eval_polynomial_X_zero : (W.polynomial_X.eval 0).eval 0 = -W.a₄ := +by simp only [← C_0, eval_polynomial_X, zero_add, zero_sub, mul_zero, zero_pow zero_lt_two] + +/-- The partial derivative $W_Y(X, Y)$ of $W(X, Y)$ with respect to $Y$. + +TODO: define this in terms of `polynomial.derivative`. -/ +noncomputable def polynomial_Y : R[X][Y] := C (C 2) * Y + C (C W.a₁ * X + C W.a₃) + +@[simp] lemma eval_polynomial_Y (x y : R) : + (W.polynomial_Y.eval $ C y).eval x = 2 * y + W.a₁ * x + W.a₃ := +by { simp only [polynomial_Y], eval_simp, rw [← add_assoc] } + +@[simp] lemma eval_polynomial_Y_zero : (W.polynomial_Y.eval 0).eval 0 = W.a₃ := +by simp only [← C_0, eval_polynomial_Y, zero_add, mul_zero] + +/-- The proposition that an affine point $(x, y)$ on `W` is nonsingular. +In other words, either $W_X(x, y) \ne 0$ or $W_Y(x, y) \ne 0$. -/ +def nonsingular (x y : R) : Prop := +W.equation x y ∧ ((W.polynomial_X.eval $ C y).eval x ≠ 0 ∨ (W.polynomial_Y.eval $ C y).eval x ≠ 0) + +lemma nonsingular_iff' (x y : R) : + W.nonsingular x y + ↔ W.equation x y + ∧ (W.a₁ * y - (3 * x ^ 2 + 2 * W.a₂ * x + W.a₄) ≠ 0 ∨ 2 * y + W.a₁ * x + W.a₃ ≠ 0) := +by rw [nonsingular, equation_iff', eval_polynomial_X, eval_polynomial_Y] + +@[simp] lemma nonsingular_iff (x y : R) : + W.nonsingular x y + ↔ W.equation x y ∧ (W.a₁ * y ≠ 3 * x ^ 2 + 2 * W.a₂ * x + W.a₄ ∨ y ≠ -y - W.a₁ * x - W.a₃) := +by { rw [nonsingular_iff', sub_ne_zero, ← @sub_ne_zero _ _ y], congr' 4; ring1 } + +@[simp] lemma nonsingular_zero : W.nonsingular 0 0 ↔ W.a₆ = 0 ∧ (W.a₃ ≠ 0 ∨ W.a₄ ≠ 0) := +by rw [nonsingular, equation_zero, C_0, eval_polynomial_X_zero, neg_ne_zero, eval_polynomial_Y_zero, + or_comm] + +lemma nonsingular_iff_variable_change (x y : R) : + W.nonsingular x y ↔ (W.variable_change 1 x 0 y).nonsingular 0 0 := +begin + rw [nonsingular_iff', equation_iff_variable_change, equation_zero, ← neg_ne_zero, or_comm, + nonsingular_zero, variable_change_a₃, variable_change_a₄, inv_one, units.coe_one], + congr' 4; ring1 +end + +lemma nonsingular_iff_base_change [nontrivial A] [no_zero_smul_divisors R A] (x y : R) : + W.nonsingular x y ↔ (W.base_change A).nonsingular (algebra_map R A x) (algebra_map R A y) := +begin + rw [nonsingular_iff, nonsingular_iff, and_congr $ W.equation_iff_base_change A x y], + refine ⟨or.imp (not_imp_not.mpr $ λ h, _) (not_imp_not.mpr $ λ h, _), + or.imp (not_imp_not.mpr $ λ h, _) (not_imp_not.mpr $ λ h, _)⟩, + any_goals { apply no_zero_smul_divisors.algebra_map_injective R A, map_simp, exact h }, + any_goals { convert congr_arg (algebra_map R A) h; { map_simp, refl } } +end + +lemma nonsingular_iff_base_change_of_base_change [nontrivial B] [no_zero_smul_divisors A B] + (x y : A) : (W.base_change A).nonsingular x y + ↔ (W.base_change B).nonsingular (algebra_map A B x) (algebra_map A B y) := +by rw [nonsingular_iff_base_change (W.base_change A) B, base_change_base_change] + +lemma nonsingular_zero_of_Δ_ne_zero (h : W.equation 0 0) (hΔ : W.Δ ≠ 0) : W.nonsingular 0 0 := +by { simp only [equation_zero, nonsingular_zero] at *, contrapose! hΔ, simp [h, hΔ] } + +/-- A Weierstrass curve is nonsingular at every point if its discriminant is non-zero. -/ +lemma nonsingular_of_Δ_ne_zero {x y : R} (h : W.equation x y) (hΔ : W.Δ ≠ 0) : W.nonsingular x y := +(W.nonsingular_iff_variable_change x y).mpr $ + nonsingular_zero_of_Δ_ne_zero _ ((W.equation_iff_variable_change x y).mp h) $ +by rwa [variable_change_Δ, inv_one, units.coe_one, one_pow, one_mul] + +/-! ### Ideals in the coordinate ring -/ + +/-- The coordinate ring $R[W] := R[X, Y] / \langle W(X, Y) \rangle$ of `W`. + +Note that `derive comm_ring` generates a reducible instance of `comm_ring` for `coordinate_ring`. +In certain circumstances this might be extremely slow, because all instances in its definition are +unified exponentially many times. In this case, one solution is to manually add the local attribute +`local attribute [irreducible] coordinate_ring.comm_ring` to block this type-level unification. + +TODO Lean 4: verify if the new def-eq cache (lean4#1102) fixed this issue. + +See Zulip thread: +https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/.E2.9C.94.20class_group.2Emk -/ +@[derive [inhabited, comm_ring]] def coordinate_ring : Type u := adjoin_root W.polynomial + +/-- The function field $R(W) := \mathrm{Frac}(R[W])$ of `W`. -/ +abbreviation function_field : Type u := fraction_ring W.coordinate_ring + +namespace coordinate_ring + +open ideal + +instance [is_domain R] [normalized_gcd_monoid R] : is_domain W.coordinate_ring := +(quotient.is_domain_iff_prime _).mpr $ +by simpa only [span_singleton_prime W.polynomial_ne_zero, ← gcd_monoid.irreducible_iff_prime] + using W.irreducible_polynomial + +instance is_domain_of_field {F : Type u} [field F] (W : weierstrass_curve F) : + is_domain W.coordinate_ring := +by { classical, apply_instance } + +variables (x : R) (y : R[X]) + +/-- The class of the element $X - x$ in $R[W]$ for some $x \in R$. -/ +@[simp] noncomputable def X_class : W.coordinate_ring := adjoin_root.mk W.polynomial $ C $ X - C x + +lemma X_class_ne_zero [nontrivial R] : X_class W x ≠ 0 := +adjoin_root.mk_ne_zero_of_nat_degree_lt W.monic_polynomial (C_ne_zero.mpr $ X_sub_C_ne_zero x) $ + by { rw [nat_degree_polynomial, nat_degree_C], norm_num1 } + +/-- The class of the element $Y - y(X)$ in $R[W]$ for some $y(X) \in R[X]$. -/ +@[simp] noncomputable def Y_class : W.coordinate_ring := adjoin_root.mk W.polynomial $ Y - C y + +lemma Y_class_ne_zero [nontrivial R] : Y_class W y ≠ 0 := +adjoin_root.mk_ne_zero_of_nat_degree_lt W.monic_polynomial (X_sub_C_ne_zero y) $ + by { rw [nat_degree_polynomial, nat_degree_X_sub_C], norm_num1 } + +/-- The ideal $\langle X - x \rangle$ of $R[W]$ for some $x \in R$. -/ +@[simp] noncomputable def X_ideal : ideal W.coordinate_ring := span {X_class W x} + +/-- The ideal $\langle Y - y(X) \rangle$ of $R[W]$ for some $y(X) \in R[X]$. -/ +@[simp] noncomputable def Y_ideal : ideal W.coordinate_ring := span {Y_class W y} + +/-- The ideal $\langle X - x, Y - y(X) \rangle$ of $R[W]$ for some $x \in R$ and $y(X) \in R[X]$. -/ +@[simp] noncomputable def XY_ideal (x : R) (y : R[X]) : ideal W.coordinate_ring := +span {X_class W x, Y_class W y} + +/-! ### The coordinate ring as an `R[X]`-algebra -/ + +noncomputable instance : algebra R[X] W.coordinate_ring := quotient.algebra R[X] + +noncomputable instance algebra' : algebra R W.coordinate_ring := quotient.algebra R + +instance : is_scalar_tower R R[X] W.coordinate_ring := quotient.is_scalar_tower R R[X] _ + +instance [subsingleton R] : subsingleton W.coordinate_ring := module.subsingleton R[X] _ + +/-- The $R$-algebra isomorphism from $R[W] / \langle X - x, Y - y(X) \rangle$ to $R$ obtained by +evaluation at $y(X)$ and at $x$ provided that $W(x, y(x)) = 0$. -/ +noncomputable def quotient_XY_ideal_equiv {x : R} {y : R[X]} + (h : (W.polynomial.eval y).eval x = 0) : (W.coordinate_ring ⧸ XY_ideal W x y) ≃ₐ[R] R := +(quotient_equiv_alg_of_eq R $ + by simpa only [XY_ideal, X_class, Y_class, ← set.image_pair, ← map_span]).trans $ + (double_quot.quot_quot_equiv_quot_of_leₐ R $ (span_singleton_le_iff_mem _).mpr $ + mem_span_C_X_sub_C_X_sub_C_iff_eval_eval_eq_zero.mpr h).trans $ + ((quotient_span_C_X_sub_C_alg_equiv (X - C x) y).restrict_scalars R).trans $ + quotient_span_X_sub_C_alg_equiv x + +/-- The basis $\{1, Y\}$ for the coordinate ring $R[W]$ over the polynomial ring $R[X]$. + +Given a Weierstrass curve `W`, write `W^.coordinate_ring.basis` for this basis. -/ +protected noncomputable def basis : basis (fin 2) R[X] W.coordinate_ring := +(subsingleton_or_nontrivial R).by_cases (λ _, by exactI default) $ λ _, by exactI + ((adjoin_root.power_basis' W.monic_polynomial).basis.reindex $ + fin_congr W.nat_degree_polynomial) + +lemma basis_apply (n : fin 2) : + W^.coordinate_ring.basis n = (adjoin_root.power_basis' W.monic_polynomial).gen ^ (n : ℕ) := +begin + classical, + nontriviality R, + simpa only [coordinate_ring.basis, or.by_cases, dif_neg (not_subsingleton R), + basis.reindex_apply, power_basis.basis_eq_pow] +end + +lemma basis_zero : W^.coordinate_ring.basis 0 = 1 := by simpa only [basis_apply] using pow_zero _ + +lemma basis_one : W^.coordinate_ring.basis 1 = adjoin_root.mk W.polynomial Y := +by simpa only [basis_apply] using pow_one _ + +@[simp] lemma coe_basis : + (W^.coordinate_ring.basis : fin 2 → W.coordinate_ring) = ![1, adjoin_root.mk W.polynomial Y] := +by { ext n, fin_cases n, exacts [basis_zero W, basis_one W] } + +variable {W} + +lemma smul (x : R[X]) (y : W.coordinate_ring) : x • y = adjoin_root.mk W.polynomial (C x) * y := +(algebra_map_smul W.coordinate_ring x y).symm + +lemma smul_basis_eq_zero {p q : R[X]} + (hpq : p • 1 + q • adjoin_root.mk W.polynomial Y = 0) : p = 0 ∧ q = 0 := +begin + have h := fintype.linear_independent_iff.mp (coordinate_ring.basis W).linear_independent ![p, q], + erw [fin.sum_univ_succ, basis_zero, fin.sum_univ_one, basis_one] at h, + exact ⟨h hpq 0, h hpq 1⟩ +end + +lemma exists_smul_basis_eq (x : W.coordinate_ring) : + ∃ p q : R[X], p • 1 + q • adjoin_root.mk W.polynomial Y = x := +begin + have h := (coordinate_ring.basis W).sum_equiv_fun x, + erw [fin.sum_univ_succ, fin.sum_univ_one, basis_zero, basis_one] at h, + exact ⟨_, _, h⟩ +end + +variable (W) + +lemma smul_basis_mul_C (p q : R[X]) : + (p • 1 + q • adjoin_root.mk W.polynomial Y) * adjoin_root.mk W.polynomial (C y) + = ((p * y) • 1 + (q * y) • adjoin_root.mk W.polynomial Y) := +by { simp only [smul, _root_.map_mul], ring1 } + +lemma smul_basis_mul_Y (p q : R[X]) : + (p • 1 + q • adjoin_root.mk W.polynomial Y) * adjoin_root.mk W.polynomial Y + = (q * (X ^ 3 + C W.a₂ * X ^ 2 + C W.a₄ * X + C W.a₆)) • 1 + + (p - q * (C W.a₁ * X + C W.a₃)) • adjoin_root.mk W.polynomial Y := +begin + have Y_sq : adjoin_root.mk W.polynomial Y ^ 2 = adjoin_root.mk W.polynomial + (C (X ^ 3 + C W.a₂ * X ^ 2 + C W.a₄ * X + C W.a₆) - C (C W.a₁ * X + C W.a₃) * Y) := + adjoin_root.mk_eq_mk.mpr ⟨1, by { simp only [weierstrass_curve.polynomial], ring1 }⟩, + simp only [smul, add_mul, mul_assoc, ← sq, Y_sq, map_sub, _root_.map_mul], + ring1 +end + +/-! ### Norms on the coordinate ring -/ + +lemma norm_smul_basis (p q : R[X]) : + algebra.norm R[X] (p • 1 + q • adjoin_root.mk W.polynomial Y) + = p ^ 2 - p * q * (C W.a₁ * X + C W.a₃) + - q ^ 2 * (X ^ 3 + C W.a₂ * X ^ 2 + C W.a₄ * X + C W.a₆) := +begin + simp_rw [algebra.norm_eq_matrix_det W^.coordinate_ring.basis, matrix.det_fin_two, + algebra.left_mul_matrix_eq_repr_mul, basis_zero, mul_one, basis_one, smul_basis_mul_Y, + map_add, finsupp.add_apply, map_smul, finsupp.smul_apply, ← basis_zero, ← basis_one, + basis.repr_self_apply, if_pos, if_neg one_ne_zero, if_neg zero_ne_one, smul_eq_mul], + ring1 +end + +lemma coe_norm_smul_basis (p q : R[X]) : + ↑(algebra.norm R[X] $ p • 1 + q • adjoin_root.mk W.polynomial Y) + = adjoin_root.mk W.polynomial + ((C p + C q * X) * (C p + C q * (-Y - C (C W.a₁ * X + C W.a₃)))) := +adjoin_root.mk_eq_mk.mpr + ⟨C q ^ 2, by { rw [norm_smul_basis, weierstrass_curve.polynomial], C_simp, ring1 }⟩ + +lemma degree_norm_smul_basis [is_domain R] (p q : R[X]) : + (algebra.norm R[X] $ p • 1 + q • adjoin_root.mk W.polynomial Y).degree + = max (2 • p.degree) (2 • q.degree + 3) := +begin + have hdp : (p ^ 2).degree = 2 • p.degree := degree_pow p 2, + have hdpq : (p * q * (C W.a₁ * X + C W.a₃)).degree ≤ p.degree + q.degree + 1, + { simpa only [degree_mul] using add_le_add_left degree_linear_le (p.degree + q.degree) }, + have hdq : (q ^ 2 * (X ^ 3 + C W.a₂ * X ^ 2 + C W.a₄ * X + C W.a₆)).degree = 2 • q.degree + 3, + { rw [degree_mul, degree_pow, ← one_mul $ X ^ 3, ← C_1, degree_cubic $ one_ne_zero' R] }, + rw [norm_smul_basis], + by_cases hp : p = 0, { simpa only [hp, hdq, neg_zero, zero_sub, zero_mul, zero_pow zero_lt_two, + degree_neg] using (max_bot_left _).symm }, + by_cases hq : q = 0, { simpa only [hq, hdp, sub_zero, zero_mul, mul_zero, zero_pow zero_lt_two] + using (max_bot_right _).symm }, + rw [← not_iff_not_of_iff degree_eq_bot] at hp hq, + cases p.degree with dp, { exact (hp rfl).elim }, + cases q.degree with dq, { exact (hq rfl).elim }, + cases le_or_lt dp (dq + 1) with hpq hpq, + { convert (degree_sub_eq_right_of_degree_lt $ (degree_sub_le _ _).trans_lt $ + max_lt_iff.mpr ⟨hdp.trans_lt _, hdpq.trans_lt _⟩).trans (max_eq_right_of_lt _).symm; rw [hdq]; + exact with_bot.coe_lt_coe.mpr (by linarith only [hpq]) }, + { rw [sub_sub], + convert (degree_sub_eq_left_of_degree_lt $ (degree_add_le _ _).trans_lt $ + max_lt_iff.mpr ⟨hdpq.trans_lt _, hdq.trans_lt _⟩).trans (max_eq_left_of_lt _).symm; rw [hdp]; + exact with_bot.coe_lt_coe.mpr (by linarith only [hpq]) } +end + +variable {W} + +lemma degree_norm_ne_one [is_domain R] (x : W.coordinate_ring) : (algebra.norm R[X] x).degree ≠ 1 := +begin + rcases exists_smul_basis_eq x with ⟨p, q, rfl⟩, + rw [degree_norm_smul_basis], + rcases p.degree with (_ | _ | _ | _); cases q.degree, + any_goals { rintro (_ | _) }, + exact (lt_max_of_lt_right dec_trivial).ne' +end + +lemma nat_degree_norm_ne_one [is_domain R] (x : W.coordinate_ring) : + (algebra.norm R[X] x).nat_degree ≠ 1 := +mt (degree_eq_iff_nat_degree_eq_of_pos zero_lt_one).mpr $ degree_norm_ne_one x + +end coordinate_ring + +end polynomial + +end weierstrass_curve + +/-! ## Elliptic curves -/ + +/-- An elliptic curve over a commutative ring. Note that this definition is only mathematically +accurate for certain rings whose Picard group has trivial 12-torsion, such as a field or a PID. -/ +@[ext] structure elliptic_curve (R : Type u) [comm_ring R] extends weierstrass_curve R := +(Δ' : Rˣ) (coe_Δ' : ↑Δ' = to_weierstrass_curve.Δ) + +instance : inhabited $ elliptic_curve ℚ := +⟨⟨⟨0, 0, 1, -1, 0⟩, ⟨37, 37⁻¹, by norm_num1, by norm_num1⟩, by { dsimp, ring1 }⟩⟩ + +namespace elliptic_curve + +variables [comm_ring R] (E : elliptic_curve R) + +/-- The j-invariant `j` of an elliptic curve, which is invariant under isomorphisms over `R`. -/ +@[simp] def j : R := ↑E.Δ'⁻¹ * E.c₄ ^ 3 + +lemma two_torsion_polynomial_disc_ne_zero [nontrivial R] [invertible (2 : R)] : + E.two_torsion_polynomial.disc ≠ 0 := +E.two_torsion_polynomial_disc_ne_zero $ E.coe_Δ' ▸ E.Δ'.is_unit + +lemma nonsingular [nontrivial R] {x y : R} (h : E.equation x y) : E.nonsingular x y := +E.nonsingular_of_Δ_ne_zero h $ E.coe_Δ' ▸ E.Δ'.ne_zero + +section variable_change + +/-! ### Variable changes -/ + +variables (u : Rˣ) (r s t : R) + +/-- The elliptic curve over `R` induced by an admissible linear change of variables +$(X, Y) \mapsto (u^2X + r, u^3Y + u^2sX + t)$ for some $u \in R^\times$ and some $r, s, t \in R$. +When `R` is a field, any two Weierstrass equations isomorphic to `E` are related by this. -/ +@[simps] def variable_change : elliptic_curve R := +⟨E.variable_change u r s t, u⁻¹ ^ 12 * E.Δ', +by rw [units.coe_mul, units.coe_pow, coe_Δ', E.variable_change_Δ]⟩ + +lemma coe_variable_change_Δ' : (↑(E.variable_change u r s t).Δ' : R) = ↑u⁻¹ ^ 12 * E.Δ' := +by rw [variable_change_Δ', units.coe_mul, units.coe_pow] + +lemma coe_inv_variable_change_Δ' : (↑(E.variable_change u r s t).Δ'⁻¹ : R) = u ^ 12 * ↑E.Δ'⁻¹ := +by rw [variable_change_Δ', mul_inv, inv_pow, inv_inv, units.coe_mul, units.coe_pow] + +@[simp] lemma variable_change_j : (E.variable_change u r s t).j = E.j := +begin + rw [j, coe_inv_variable_change_Δ'], + have hu : (u * ↑u⁻¹ : R) ^ 12 = 1 := by rw [u.mul_inv, one_pow], + linear_combination E.j * hu with { normalization_tactic := `[dsimp, ring1] } +end + +end variable_change + +section base_change + +/-! ### Base changes -/ + +variables (A : Type v) [comm_ring A] [algebra R A] + +/-- The elliptic curve over `R` base changed to `A`. -/ +@[simps] def base_change : elliptic_curve A := +⟨E.base_change A, units.map ↑(algebra_map R A) E.Δ', +by rw [units.coe_map, ring_hom.coe_monoid_hom, coe_Δ', E.base_change_Δ]⟩ + +lemma coe_base_change_Δ' : ↑(E.base_change A).Δ' = algebra_map R A E.Δ' := rfl + +lemma coe_inv_base_change_Δ' : ↑(E.base_change A).Δ'⁻¹ = algebra_map R A ↑E.Δ'⁻¹ := rfl + +@[simp] lemma base_change_j : (E.base_change A).j = algebra_map R A E.j := +by { simp only [j, coe_inv_base_change_Δ', base_change_to_weierstrass_curve, E.base_change_c₄], + map_simp } + +end base_change + +end elliptic_curve diff --git a/src/algebraic_geometry/function_field.lean b/src/algebraic_geometry/function_field.lean index b5bbdfe4aaff2..628ccd684a434 100644 --- a/src/algebraic_geometry/function_field.lean +++ b/src/algebraic_geometry/function_field.lean @@ -8,6 +8,9 @@ import algebraic_geometry.properties /-! # Function field of integral schemes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the function field of an irreducible scheme as the stalk of the generic point. This is a field when the scheme is integral. @@ -36,7 +39,7 @@ noncomputable abbreviation Scheme.germ_to_function_field [irreducible_space X.carrier] (U : opens X.carrier) [h : nonempty U] : X.presheaf.obj (op U) ⟶ X.function_field := X.presheaf.germ ⟨generic_point X.carrier, - ((generic_point_spec X.carrier).mem_open_set_iff U.prop).mpr (by simpa using h)⟩ + ((generic_point_spec X.carrier).mem_open_set_iff U.is_open).mpr (by simpa using h)⟩ noncomputable instance [irreducible_space X.carrier] (U : opens X.carrier) [nonempty U] : @@ -53,11 +56,11 @@ begin intro ha, replace ha := ne_of_apply_ne _ ha, have hs : generic_point X.carrier ∈ RingedSpace.basic_open _ s, - { rw [← opens.mem_coe, (generic_point_spec X.carrier).mem_open_set_iff, set.top_eq_univ, - set.univ_inter, ← set.ne_empty_iff_nonempty, ne.def, ← opens.coe_bot, - subtype.coe_injective.eq_iff, ← opens.empty_eq], + { rw [← set_like.mem_coe, (generic_point_spec X.carrier).mem_open_set_iff, set.top_eq_univ, + set.univ_inter, set.nonempty_iff_ne_empty, ne.def, ← opens.coe_bot, + ← set_like.ext'_iff], erw basic_open_eq_bot_iff, - exacts [ha, (RingedSpace.basic_open _ _).prop] }, + exacts [ha, (RingedSpace.basic_open _ _).is_open] }, have := (X.presheaf.germ ⟨_, hs⟩).is_unit_map (RingedSpace.is_unit_res_basic_open _ s), rwa Top.presheaf.germ_res_apply at this end @@ -115,10 +118,7 @@ end noncomputable instance (R : CommRing) [is_domain R] : algebra R (Scheme.Spec.obj $ op R).function_field := -begin - apply ring_hom.to_algebra, - exact structure_sheaf.to_stalk R _, -end +ring_hom.to_algebra $ by { change CommRing.of R ⟶ _, apply structure_sheaf.to_stalk } @[simp] lemma generic_point_eq_bot_of_affine (R : CommRing) [is_domain R] : generic_point (Scheme.Spec.obj $ op R).carrier = (⟨0, ideal.bot_prime⟩ : prime_spectrum R) := @@ -148,7 +148,7 @@ end lemma is_affine_open.prime_ideal_of_generic_point {X : Scheme} [is_integral X] {U : opens X.carrier} (hU : is_affine_open U) [h : nonempty U] : hU.prime_ideal_of ⟨generic_point X.carrier, - ((generic_point_spec X.carrier).mem_open_set_iff U.prop).mpr (by simpa using h)⟩ = + ((generic_point_spec X.carrier).mem_open_set_iff U.is_open).mpr (by simpa using h)⟩ = generic_point (Scheme.Spec.obj $ op $ X.presheaf.obj $ op U).carrier := begin haveI : is_affine _ := hU, diff --git a/src/algebraic_geometry/gluing.lean b/src/algebraic_geometry/gluing.lean index 490a5954802d5..15c3b25257934 100644 --- a/src/algebraic_geometry/gluing.lean +++ b/src/algebraic_geometry/gluing.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ import algebraic_geometry.presheafed_space.gluing +import algebraic_geometry.open_immersion.Scheme /-! # Gluing Schemes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a family of gluing data of schemes, we may glue them together. ## Main definitions @@ -76,7 +80,7 @@ such that We can then glue the schemes `U i` together by identifying `V i j` with `V j i`, such that the `U i`'s are open subschemes of the glued space. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure glue_data extends category_theory.glue_data Scheme := (f_open : ∀ i j, is_open_immersion (f i j)) @@ -106,7 +110,7 @@ begin refine ⟨_, _ ≫ D.to_LocallyRingedSpace_glue_data.to_glue_data.ι i, _⟩, swap, exact (D.U i).affine_cover.map y, split, - { dsimp, + { dsimp [-set.mem_range], rw [coe_comp, set.range_comp], refine set.mem_image_of_mem _ _, exact (D.U i).affine_cover.covers y }, @@ -351,7 +355,8 @@ instance from_glued_stalk_iso (x : 𝒰.glued_cover.glued.carrier) : is_iso (PresheafedSpace.stalk_map 𝒰.from_glued.val x) := begin obtain ⟨i, x, rfl⟩ := 𝒰.glued_cover.ι_jointly_surjective x, - have := PresheafedSpace.stalk_map.congr_hom _ _ (congr_arg subtype.val $ 𝒰.ι_from_glued i) x, + have := PresheafedSpace.stalk_map.congr_hom _ _ + (congr_arg LocallyRingedSpace.hom.val $ 𝒰.ι_from_glued i) x, erw PresheafedSpace.stalk_map.comp at this, rw ← is_iso.eq_comp_inv at this, rw this, diff --git a/src/algebraic_geometry/limits.lean b/src/algebraic_geometry/limits.lean new file mode 100644 index 0000000000000..22c9fbc92cf7f --- /dev/null +++ b/src/algebraic_geometry/limits.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.pullbacks +import algebraic_geometry.AffineScheme + +/-! +# (Co)Limits of Schemes + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct various limits and colimits in the category of schemes. + +* The existence of fibred products was shown in `algebraic_geometry/pullbacks.lean`. +* `Spec ℤ` is the terminal object. +* The preceding two results imply that `Scheme` has all finite limits. +* The empty scheme is the (strict) initial object. + +## Todo + +* Coproducts exists (and the forgetful functors preserve them). + +-/ + +universe u + +open category_theory category_theory.limits opposite topological_space + +namespace algebraic_geometry + +/-- `Spec ℤ` is the terminal object in the category of schemes. -/ +noncomputable +def Spec_Z_is_terminal : is_terminal (Scheme.Spec.obj (op $ CommRing.of ℤ)) := +@@is_terminal.is_terminal_obj _ _ Scheme.Spec _ infer_instance + (terminal_op_of_initial CommRing.Z_is_initial) + +instance : has_terminal Scheme := has_terminal_of_has_terminal_of_preserves_limit Scheme.Spec + +instance : is_affine (⊤_ Scheme.{u}) := +is_affine_of_iso (preserves_terminal.iso Scheme.Spec).inv + +instance : has_finite_limits Scheme := +has_finite_limits_of_has_terminal_and_pullbacks + +section initial + +/-- The map from the empty scheme. -/ +@[simps] +def Scheme.empty_to (X : Scheme.{u}) : ∅ ⟶ X := +⟨{ base := ⟨λ x, pempty.elim x, by continuity⟩, + c := { app := λ U, CommRing.punit_is_terminal.from _ } }, λ x, pempty.elim x⟩ + +@[ext] +lemma Scheme.empty_ext {X : Scheme.{u}} (f g : ∅ ⟶ X) : f = g := +by { ext a, exact pempty.elim a } + +lemma Scheme.eq_empty_to {X : Scheme.{u}} (f : ∅ ⟶ X) : f = Scheme.empty_to X := +Scheme.empty_ext f (Scheme.empty_to X) + +instance (X : Scheme.{u}) : unique (∅ ⟶ X) := +⟨⟨Scheme.empty_to _⟩, λ _, Scheme.empty_ext _ _⟩ + +/-- The empty scheme is the initial object in the category of schemes. -/ +def empty_is_initial : is_initial (∅ : Scheme.{u}) := +is_initial.of_unique _ + +@[simp] +lemma empty_is_initial_to : empty_is_initial.to = Scheme.empty_to := rfl + +instance : is_empty Scheme.empty.carrier := +show is_empty pempty, by apply_instance + +instance Spec_punit_is_empty : is_empty (Scheme.Spec.obj (op $ CommRing.of punit)).carrier := +⟨prime_spectrum.punit⟩ + +@[priority 100] +instance is_open_immersion_of_is_empty {X Y : Scheme} (f : X ⟶ Y) [is_empty X.carrier] : + is_open_immersion f := +begin + apply_with is_open_immersion.of_stalk_iso { instances := ff }, + { apply open_embedding_of_continuous_injective_open, + { continuity }, + { rintro (i : X.carrier), exact is_empty_elim i }, + { intros U hU, convert is_open_empty, ext, apply (iff_false _).mpr, + exact λ x, is_empty_elim (show X.carrier, from x.some) } }, + { rintro (i : X.carrier), exact is_empty_elim i } +end + +@[priority 100] +instance is_iso_of_is_empty {X Y : Scheme} (f : X ⟶ Y) [is_empty Y.carrier] : is_iso f := +begin + haveI : is_empty X.carrier := ⟨λ x, is_empty_elim (show Y.carrier, from f.1.base x)⟩, + haveI : epi f.1.base, + { rw Top.epi_iff_surjective, rintro (x : Y.carrier), exact is_empty_elim x }, + apply is_open_immersion.to_iso +end + +/-- A scheme is initial if its underlying space is empty . -/ +noncomputable +def is_initial_of_is_empty {X : Scheme} [is_empty X.carrier] : is_initial X := +empty_is_initial.of_iso (as_iso $ empty_is_initial.to _) + +/-- `Spec 0` is the initial object in the category of schemes. -/ +noncomputable +def Spec_punit_is_initial : is_initial (Scheme.Spec.obj (op $ CommRing.of punit)) := +empty_is_initial.of_iso (as_iso $ empty_is_initial.to _) + +@[priority 100] +instance is_affine_of_is_empty {X : Scheme} [is_empty X.carrier] : is_affine X := +is_affine_of_iso (inv (empty_is_initial.to X) ≫ + empty_is_initial.to (Scheme.Spec.obj (op $ CommRing.of punit))) + +instance : has_initial Scheme := +has_initial_of_unique Scheme.empty + +instance initial_is_empty : is_empty (⊥_ Scheme).carrier := +⟨λ x, ((initial.to Scheme.empty : _).1.base x).elim⟩ + +lemma bot_is_affine_open (X : Scheme) : is_affine_open (⊥ : opens X.carrier) := +begin + convert range_is_affine_open_of_open_immersion (initial.to X), + ext, + exact (false_iff _).mpr (λ x, is_empty_elim (show (⊥_ Scheme).carrier, from x.some)), +end + +instance : has_strict_initial_objects Scheme := +has_strict_initial_objects_of_initial_is_strict (λ A f, by apply_instance) + +end initial + +end algebraic_geometry diff --git a/src/algebraic_geometry/locally_ringed_space.lean b/src/algebraic_geometry/locally_ringed_space.lean index 10096613620f6..65c77096f56c8 100644 --- a/src/algebraic_geometry/locally_ringed_space.lean +++ b/src/algebraic_geometry/locally_ringed_space.lean @@ -6,11 +6,13 @@ Authors: Johan Commelin import algebraic_geometry.ringed_space import algebraic_geometry.stalks -import logic.equiv.transfer_instance /-! # The category of locally ringed spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define (bundled) locally ringed spaces (as `SheafedSpace CommRing` along with the fact that the stalks are local rings), and morphisms between these (morphisms in `SheafedSpace` with `is_local_ring_hom` on the stalk maps). @@ -31,7 +33,7 @@ such that all the stalks are local rings. A morphism of locally ringed spaces is a morphism of ringed spaces such that the morphisms induced on stalks are local ring homomorphisms. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure LocallyRingedSpace extends SheafedSpace CommRing := (local_ring : ∀ x, local_ring (presheaf.stalk x)) @@ -63,15 +65,13 @@ def 𝒪 : sheaf CommRing X.to_Top := X.to_SheafedSpace.sheaf /-- A morphism of locally ringed spaces is a morphism of ringed spaces such that the morphims induced on stalks are local ring homomorphisms. -/ -def hom (X Y : LocallyRingedSpace) : Type* := -{ f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace // - ∀ x, is_local_ring_hom (PresheafedSpace.stalk_map f x) } +@[ext] +structure hom (X Y : LocallyRingedSpace.{u}) : Type u := +(val : X.to_SheafedSpace ⟶ Y.to_SheafedSpace) +(prop : ∀ x, is_local_ring_hom (PresheafedSpace.stalk_map val x)) instance : quiver LocallyRingedSpace := ⟨hom⟩ -@[ext] lemma hom_ext {X Y : LocallyRingedSpace} (f g : hom X Y) (w : f.1 = g.1) : f = g := -subtype.eq w - /-- The stalk of a locally ringed space, just as a `CommRing`. -/ @@ -103,7 +103,6 @@ def id (X : LocallyRingedSpace) : hom X X := instance (X : LocallyRingedSpace) : inhabited (hom X X) := ⟨id X⟩ /-- Composition of morphisms of locally ringed spaces. -/ -@[simps] def comp {X Y Z : LocallyRingedSpace} (f : hom X Y) (g : hom Y Z) : hom X Z := ⟨f.val ≫ g.val, λ x, begin @@ -116,9 +115,9 @@ instance : category LocallyRingedSpace := { hom := hom, id := id, comp := λ X Y Z f g, comp f g, - comp_id' := by { intros, ext1, simp, }, - id_comp' := by { intros, ext1, simp, }, - assoc' := by { intros, ext1, simp, }, }. + comp_id' := by { intros, ext1, simp [comp], }, + id_comp' := by { intros, ext1, simp [comp], }, + assoc' := by { intros, ext1, simp [comp], }, }. /-- The forgetful functor from `LocallyRingedSpace` to `SheafedSpace CommRing`. -/ @[simps] def forget_to_SheafedSpace : LocallyRingedSpace ⥤ SheafedSpace CommRing := @@ -135,7 +134,7 @@ forget_to_SheafedSpace ⋙ SheafedSpace.forget _ @[simp] lemma comp_val {X Y Z : LocallyRingedSpace} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).val = f.val ≫ g.val := rfl -@[simp] lemma comp_val_c {X Y Z : LocallyRingedSpace} (f : X ⟶ Y) (g : Y ⟶ Z) : +@[simp] lemma comp_val_c {X Y Z : LocallyRingedSpace.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).val.c = g.val.c ≫ (presheaf.pushforward _ g.val.base).map f.val.c := rfl lemma comp_val_c_app {X Y Z : LocallyRingedSpace} (f : X ⟶ Y) (g : Y ⟶ Z) (U : (opens Z)ᵒᵖ) : @@ -151,7 +150,7 @@ See also `iso_of_SheafedSpace_iso`. @[simps] def hom_of_SheafedSpace_hom_of_is_iso {X Y : LocallyRingedSpace} (f : X.to_SheafedSpace ⟶ Y.to_SheafedSpace) [is_iso f] : X ⟶ Y := -subtype.mk f $ λ x, +hom.mk f $ λ x, -- Here we need to see that the stalk maps are really local ring homomorphisms. -- This can be solved by type class inference, because stalk maps of isomorphisms are isomorphisms -- and isomorphisms are local ring homomorphisms. @@ -171,14 +170,14 @@ def iso_of_SheafedSpace_iso {X Y : LocallyRingedSpace} (f : X.to_SheafedSpace ≅ Y.to_SheafedSpace) : X ≅ Y := { hom := hom_of_SheafedSpace_hom_of_is_iso f.hom, inv := hom_of_SheafedSpace_hom_of_is_iso f.inv, - hom_inv_id' := hom_ext _ _ f.hom_inv_id, - inv_hom_id' := hom_ext _ _ f.inv_hom_id } + hom_inv_id' := hom.ext _ _ f.hom_inv_id, + inv_hom_id' := hom.ext _ _ f.inv_hom_id } instance : reflects_isomorphisms forget_to_SheafedSpace := { reflects := λ X Y f i, { out := by exactI ⟨hom_of_SheafedSpace_hom_of_is_iso (category_theory.inv (forget_to_SheafedSpace.map f)), - hom_ext _ _ (is_iso.hom_inv_id _), hom_ext _ _ (is_iso.inv_hom_id _)⟩ } } + hom.ext _ _ (is_iso.hom_inv_id _), hom.ext _ _ (is_iso.inv_hom_id _)⟩ } } instance is_SheafedSpace_iso {X Y : LocallyRingedSpace} (f : X ⟶ Y) [is_iso f] : is_iso f.1 := @@ -250,14 +249,11 @@ end -- This actually holds for all ringed spaces with nontrivial stalks. @[simp] lemma basic_open_zero (X : LocallyRingedSpace) (U : opens X.carrier) : - X.to_RingedSpace.basic_open (0 : X.presheaf.obj $ op U) = ∅ := + X.to_RingedSpace.basic_open (0 : X.presheaf.obj $ op U) = ⊥ := begin - ext, - simp only [set.mem_empty_eq, topological_space.opens.empty_eq, topological_space.opens.mem_coe, - opens.coe_bot, iff_false, RingedSpace.basic_open, is_unit_zero_iff, set.mem_set_of_eq, - map_zero], - rintro ⟨⟨y, _⟩, h, e⟩, - exact @zero_ne_one (X.presheaf.stalk y) _ _ h, + simp only [RingedSpace.basic_open, is_unit_zero_iff, map_zero, + zero_ne_one' (X.presheaf.stalk _), set.set_of_false, set.image_empty], + refl end instance component_nontrivial (X : LocallyRingedSpace) (U : opens X.carrier) diff --git a/src/algebraic_geometry/locally_ringed_space/has_colimits.lean b/src/algebraic_geometry/locally_ringed_space/has_colimits.lean index fc14a688ec35a..a25dffcdd9fc3 100644 --- a/src/algebraic_geometry/locally_ringed_space/has_colimits.lean +++ b/src/algebraic_geometry/locally_ringed_space/has_colimits.lean @@ -5,13 +5,16 @@ Authors: Andrew Yang -/ import algebraic_geometry.locally_ringed_space import algebra.category.Ring.constructions -import algebraic_geometry.open_immersion +import algebraic_geometry.open_immersion.basic import category_theory.limits.constructions.limits_of_products_and_equalizers /-! # Colimits of LocallyRingedSpace -We construct the explict coproducts and coequalizers of `LocallyRingedSpace`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct the explicit coproducts and coequalizers of `LocallyRingedSpace`. It then follows that `LocallyRingedSpace` has all colimits, and `forget_to_SheafedSpace` preserves them. @@ -70,7 +73,9 @@ def coproduct : LocallyRingedSpace := noncomputable def coproduct_cofan : cocone F := { X := coproduct F, - ι := { app := λ j, ⟨colimit.ι (F ⋙ forget_to_SheafedSpace) j, infer_instance⟩ } } + ι := + { app := λ j, ⟨colimit.ι (F ⋙ forget_to_SheafedSpace) j, infer_instance⟩, + naturality' := λ j j' f, by { cases j, cases j', tidy, }, } } /-- The explicit coproduct cofan constructed in `coproduct_cofan` is indeed a colimit. -/ noncomputable @@ -88,11 +93,12 @@ def coproduct_cofan_is_colimit : is_colimit (coproduct_cofan F) := ((forget_to_SheafedSpace.map_cocone s).ι.app i) y) := (s.ι.app i).2 y, apply_instance end⟩, - fac' := λ s j, subtype.eq (colimit.ι_desc _ _), - uniq' := λ s f h, subtype.eq (is_colimit.uniq _ (forget_to_SheafedSpace.map_cocone s) f.1 - (λ j, congr_arg subtype.val (h j))) } + fac' := λ s j, LocallyRingedSpace.hom.ext _ _ (colimit.ι_desc _ _), + uniq' := λ s f h, LocallyRingedSpace.hom.ext _ _ + (is_colimit.uniq _ (forget_to_SheafedSpace.map_cocone s) f.1 + (λ j, congr_arg LocallyRingedSpace.hom.val (h j))) } -instance : has_coproducts LocallyRingedSpace.{u} := +instance : has_coproducts.{u} LocallyRingedSpace.{u} := λ ι, ⟨λ F, ⟨⟨⟨_, coproduct_cofan_is_colimit F⟩⟩⟩⟩ noncomputable @@ -104,7 +110,7 @@ end has_coproducts section has_coequalizer -variables {X Y : LocallyRingedSpace.{u}} (f g : X ⟶ Y) +variables {X Y : LocallyRingedSpace.{v}} (f g : X ⟶ Y) namespace has_coequalizer @@ -167,7 +173,7 @@ begin SheafedSpace.congr_app (coequalizer.condition f.1 g.1), comp_apply], erw X.to_RingedSpace.basic_open_res, apply inf_eq_right.mpr, - refine (RingedSpace.basic_open_subset _ _).trans _, + refine (RingedSpace.basic_open_le _ _).trans _, rw coequalizer.condition f.1 g.1, exact λ _ h, h } end @@ -196,12 +202,12 @@ begin have hV : (coequalizer.π f.1 g.1).base ⁻¹' ((coequalizer.π f.1 g.1).base '' V.1) = V.1 := image_basic_open_image_preimage f g U s, have hV' : V = ⟨(coequalizer.π f.1 g.1).base ⁻¹' - ((coequalizer.π f.1 g.1).base '' V.1), hV.symm ▸ V.2⟩ := subtype.eq hV.symm, - have V_open : is_open (((coequalizer.π f.val g.val).base) '' V.val) := + ((coequalizer.π f.1 g.1).base '' V.1), hV.symm ▸ V.2⟩ := set_like.ext' hV.symm, + have V_open : is_open (((coequalizer.π f.val g.val).base) '' V.1) := image_basic_open_image_open f g U s, have VleU : - (⟨((coequalizer.π f.val g.val).base) '' V.val, V_open⟩ : topological_space.opens _) ≤ U, - { exact set.image_subset_iff.mpr (Y.to_RingedSpace.basic_open_subset _) }, + (⟨((coequalizer.π f.val g.val).base) '' V.1, V_open⟩ : topological_space.opens _) ≤ U, + { exact set.image_subset_iff.mpr (Y.to_RingedSpace.basic_open_le _) }, have hxV : x ∈ V := ⟨⟨_, hU⟩, ha, rfl⟩, erw ← (coequalizer f.val g.val).presheaf.germ_res_apply (hom_of_le VleU) @@ -233,7 +239,7 @@ def coequalizer : LocallyRingedSpace := noncomputable def coequalizer_cofork : cofork f g := @cofork.of_π _ _ _ _ f g (coequalizer f g) ⟨coequalizer.π f.1 g.1, infer_instance⟩ - (subtype.eq (coequalizer.condition f.1 g.1)) + (LocallyRingedSpace.hom.ext _ _ (coequalizer.condition f.1 g.1)) lemma is_local_ring_hom_stalk_map_congr {X Y : RingedSpace} (f g : X ⟶ Y) (H : f = g) (x) (h : is_local_ring_hom (PresheafedSpace.stalk_map f x)) : @@ -257,10 +263,10 @@ begin apply is_local_ring_hom_stalk_map_congr _ _ (coequalizer.π_desc s.π.1 e).symm y, apply_instance }, split, - exact subtype.eq (coequalizer.π_desc _ _), + { exact LocallyRingedSpace.hom.ext _ _ (coequalizer.π_desc _ _) }, intros m h, replace h : (coequalizer_cofork f g).π.1 ≫ m.1 = s.π.1 := by { rw ← h, refl }, - apply subtype.eq, + apply LocallyRingedSpace.hom.ext, apply (colimit.is_colimit (parallel_pair f.1 g.1)).uniq (cofork.of_π s.π.1 e) m.1, rintro ⟨⟩, { rw [← (colimit.cocone (parallel_pair f.val g.val)).w walking_parallel_pair_hom.left, @@ -278,7 +284,7 @@ instance : has_coequalizers LocallyRingedSpace := has_coequalizers_of_has_colimi noncomputable instance preserves_coequalizer : - preserves_colimits_of_shape walking_parallel_pair.{v} forget_to_SheafedSpace.{v} := + preserves_colimits_of_shape walking_parallel_pair forget_to_SheafedSpace.{v} := ⟨λ F, begin apply preserves_colimit_of_iso_diagram _ (diagram_iso_parallel_pair F).symm, apply preserves_colimit_of_preserves_colimit_cocone (coequalizer_cofork_is_colimit _ _), @@ -289,7 +295,7 @@ end⟩ end has_coequalizer -instance : has_colimits LocallyRingedSpace := colimits_from_coequalizers_and_coproducts +instance : has_colimits LocallyRingedSpace := has_colimits_of_has_coequalizers_and_coproducts noncomputable instance : preserves_colimits LocallyRingedSpace.forget_to_SheafedSpace := diff --git a/src/algebraic_geometry/morphisms/basic.lean b/src/algebraic_geometry/morphisms/basic.lean new file mode 100644 index 0000000000000..5ff036cda8b73 --- /dev/null +++ b/src/algebraic_geometry/morphisms/basic.lean @@ -0,0 +1,604 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.AffineScheme +import algebraic_geometry.pullbacks +import category_theory.morphism_property + +/-! +# Properties of morphisms between Schemes + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide the basic framework for talking about properties of morphisms between Schemes. + +A `morphism_property Scheme` is a predicate on morphisms between schemes, and an +`affine_target_morphism_property` is a predicate on morphisms into affine schemes. Given a +`P : affine_target_morphism_property`, we may construct a `morphism_property` called +`target_affine_locally P` that holds for `f : X ⟶ Y` whenever `P` holds for the +restriction of `f` on every affine open subset of `Y`. + +## Main definitions + +- `algebraic_geometry.affine_target_morphism_property.is_local`: We say that `P.is_local` if `P` +satisfies the assumptions of the affine communication lemma +(`algebraic_geometry.of_affine_open_cover`). That is, +1. `P` respects isomorphisms. +2. If `P` holds for `f : X ⟶ Y`, then `P` holds for `f ∣_ Y.basic_open r` for any + global section `r`. +3. If `P` holds for `f ∣_ Y.basic_open r` for all `r` in a spanning set of the global sections, + then `P` holds for `f`. + +- `algebraic_geometry.property_is_local_at_target`: We say that `property_is_local_at_target P` for +`P : morphism_property Scheme` if +1. `P` respects isomorphisms. +2. If `P` holds for `f : X ⟶ Y`, then `P` holds for `f ∣_ U` for any `U`. +3. If `P` holds for `f ∣_ U` for an open cover `U` of `Y`, then `P` holds for `f`. + +## Main results + +- `algebraic_geometry.affine_target_morphism_property.is_local.affine_open_cover_tfae`: + If `P.is_local`, then `target_affine_locally P f` iff there exists an affine cover `{ Uᵢ }` of `Y` + such that `P` holds for `f ∣_ Uᵢ`. +- `algebraic_geometry.affine_target_morphism_property.is_local_of_open_cover_imply`: + If the existance of an affine cover `{ Uᵢ }` of `Y` such that `P` holds for `f ∣_ Uᵢ` implies + `target_affine_locally P f`, then `P.is_local`. +- `algebraic_geometry.affine_target_morphism_property.is_local.affine_target_iff`: + If `Y` is affine and `f : X ⟶ Y`, then `target_affine_locally P f ↔ P f` provided `P.is_local`. +- `algebraic_geometry.affine_target_morphism_property.is_local.target_affine_locally_is_local` : + If `P.is_local`, then `property_is_local_at_target (target_affine_locally P)`. +- `algebraic_geometry.property_is_local_at_target.open_cover_tfae`: + If `property_is_local_at_target P`, then `P f` iff there exists an open cover `{ Uᵢ }` of `Y` + such that `P` holds for `f ∣_ Uᵢ`. + +These results should not be used directly, and should be ported to each property that is local. + +-/ + +universe u + +open topological_space category_theory category_theory.limits opposite + +noncomputable theory + +namespace algebraic_geometry + +/-- An `affine_target_morphism_property` is a class of morphisms from an arbitrary scheme into an +affine scheme. -/ +def affine_target_morphism_property := ∀ ⦃X Y : Scheme⦄ (f : X ⟶ Y) [is_affine Y], Prop + +/-- `is_iso` as a `morphism_property`. -/ +protected def Scheme.is_iso : morphism_property Scheme := @is_iso Scheme _ + +/-- `is_iso` as an `affine_morphism_property`. -/ +protected def Scheme.affine_target_is_iso : affine_target_morphism_property := +λ X Y f H, is_iso f + +instance : inhabited affine_target_morphism_property := ⟨Scheme.affine_target_is_iso⟩ + +/-- A `affine_target_morphism_property` can be extended to a `morphism_property` such that it +*never* holds when the target is not affine -/ +def affine_target_morphism_property.to_property (P : affine_target_morphism_property) : + morphism_property Scheme := +λ X Y f, ∃ h, @@P f h + +lemma affine_target_morphism_property.to_property_apply (P : affine_target_morphism_property) + {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] : + P.to_property f ↔ P f := by { delta affine_target_morphism_property.to_property, simp [*] } + +lemma affine_cancel_left_is_iso {P : affine_target_morphism_property} + (hP : P.to_property.respects_iso) {X Y Z : Scheme} (f : X ⟶ Y) + (g : Y ⟶ Z) [is_iso f] [is_affine Z] : P (f ≫ g) ↔ P g := +by rw [← P.to_property_apply, ← P.to_property_apply, hP.cancel_left_is_iso] + +lemma affine_cancel_right_is_iso + {P : affine_target_morphism_property} (hP : P.to_property.respects_iso) {X Y Z : Scheme} + (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] [is_affine Z] [is_affine Y] : P (f ≫ g) ↔ P f := +by rw [← P.to_property_apply, ← P.to_property_apply, hP.cancel_right_is_iso] + +lemma affine_target_morphism_property.respects_iso_mk {P : affine_target_morphism_property} + (h₁ : ∀ {X Y Z} (e : X ≅ Y) (f : Y ⟶ Z) [is_affine Z], by exactI P f → P (e.hom ≫ f)) + (h₂ : ∀ {X Y Z} (e : Y ≅ Z) (f : X ⟶ Y) [h : is_affine Y], + by exactI P f → @@P (f ≫ e.hom) (is_affine_of_iso e.inv)) : P.to_property.respects_iso := +begin + split, + { rintros X Y Z e f ⟨a, h⟩, exactI ⟨a, h₁ e f h⟩ }, + { rintros X Y Z e f ⟨a, h⟩, exactI ⟨is_affine_of_iso e.inv, h₂ e f h⟩ }, +end + +/-- For a `P : affine_target_morphism_property`, `target_affine_locally P` holds for +`f : X ⟶ Y` whenever `P` holds for the restriction of `f` on every affine open subset of `Y`. -/ +def target_affine_locally (P : affine_target_morphism_property) : morphism_property Scheme := + λ {X Y : Scheme} (f : X ⟶ Y), ∀ (U : Y.affine_opens), @@P (f ∣_ U) U.prop + +lemma is_affine_open.map_is_iso {X Y : Scheme} {U : opens Y.carrier} (hU : is_affine_open U) + (f : X ⟶ Y) [is_iso f] : is_affine_open ((opens.map f.1.base).obj U) := +begin + haveI : is_affine _ := hU, + exact is_affine_of_iso (f ∣_ U), +end + +lemma target_affine_locally_respects_iso {P : affine_target_morphism_property} + (hP : P.to_property.respects_iso) : (target_affine_locally P).respects_iso := +begin + split, + { introv H U, + rw [morphism_restrict_comp, affine_cancel_left_is_iso hP], + exact H U }, + { introv H, + rintro ⟨U, hU : is_affine_open U⟩, dsimp, + haveI : is_affine _ := hU, + haveI : is_affine _ := hU.map_is_iso e.hom, + rw [morphism_restrict_comp, affine_cancel_right_is_iso hP], + exact H ⟨(opens.map e.hom.val.base).obj U, hU.map_is_iso e.hom⟩ } +end + +/-- +We say that `P : affine_target_morphism_property` is a local property if +1. `P` respects isomorphisms. +2. If `P` holds for `f : X ⟶ Y`, then `P` holds for `f ∣_ Y.basic_open r` for any + global section `r`. +3. If `P` holds for `f ∣_ Y.basic_open r` for all `r` in a spanning set of the global sections, + then `P` holds for `f`. +-/ +structure affine_target_morphism_property.is_local (P : affine_target_morphism_property) : Prop := +(respects_iso : P.to_property.respects_iso) +(to_basic_open : ∀ {X Y : Scheme} [is_affine Y] (f : X ⟶ Y) (r : Y.presheaf.obj $ op ⊤), + by exactI P f → + @@P (f ∣_ (Y.basic_open r)) ((top_is_affine_open Y).basic_open_is_affine _)) +(of_basic_open_cover : ∀ {X Y : Scheme} [is_affine Y] (f : X ⟶ Y) + (s : finset (Y.presheaf.obj $ op ⊤)) (hs : ideal.span (s : set (Y.presheaf.obj $ op ⊤)) = ⊤), + by exactI (∀ (r : s), @@P (f ∣_ (Y.basic_open r.1)) + ((top_is_affine_open Y).basic_open_is_affine _)) → P f) + +lemma target_affine_locally_of_open_cover {P : affine_target_morphism_property} + (hP : P.is_local) + {X Y : Scheme} (f : X ⟶ Y) (𝒰 : Y.open_cover) [∀ i, is_affine (𝒰.obj i)] + (h𝒰 : ∀ i, P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i)) : + target_affine_locally P f := +begin + classical, + let S := λ i, (⟨⟨set.range (𝒰.map i).1.base, (𝒰.is_open i).base_open.open_range⟩, + range_is_affine_open_of_open_immersion (𝒰.map i)⟩ : Y.affine_opens), + intro U, + apply of_affine_open_cover U (set.range S), + { intros U r h, + haveI : is_affine _ := U.2, + have := hP.2 (f ∣_ U.1), + replace this := this (Y.presheaf.map (eq_to_hom U.1.open_embedding_obj_top).op r) h, + rw ← P.to_property_apply at this ⊢, + exact (hP.1.arrow_mk_iso_iff (morphism_restrict_restrict_basic_open f _ r)).mp this }, + { intros U s hs H, + haveI : is_affine _ := U.2, + apply hP.3 (f ∣_ U.1) (s.image (Y.presheaf.map (eq_to_hom U.1.open_embedding_obj_top).op)), + { apply_fun ideal.comap (Y.presheaf.map (eq_to_hom U.1.open_embedding_obj_top.symm).op) at hs, + rw ideal.comap_top at hs, + rw ← hs, + simp only [eq_to_hom_op, eq_to_hom_map, finset.coe_image], + have : ∀ {R S : CommRing} (e : S = R) (s : set S), + (by exactI ideal.span (eq_to_hom e '' s) = ideal.comap (eq_to_hom e.symm) (ideal.span s)), + { intros, subst e, simpa }, + apply this }, + { rintro ⟨r, hr⟩, + obtain ⟨r, hr', rfl⟩ := finset.mem_image.mp hr, + simp_rw ← P.to_property_apply at ⊢ H, + exact + (hP.1.arrow_mk_iso_iff (morphism_restrict_restrict_basic_open f _ r)).mpr (H ⟨r, hr'⟩) } }, + { rw set.eq_univ_iff_forall, + simp only [set.mem_Union], + intro x, + exact ⟨⟨_, ⟨𝒰.f x, rfl⟩⟩, 𝒰.covers x⟩ }, + { rintro ⟨_, i, rfl⟩, + simp_rw ← P.to_property_apply at ⊢ h𝒰, + exact (hP.1.arrow_mk_iso_iff (morphism_restrict_opens_range f _)).mpr (h𝒰 i) }, +end + +lemma affine_target_morphism_property.is_local.affine_open_cover_tfae + {P : affine_target_morphism_property} + (hP : P.is_local) {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [target_affine_locally P f, + ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)], ∀ (i : 𝒰.J), + by exactI P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J), + by exactI P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g], + by exactI P (pullback.snd : pullback f g ⟶ U), + ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤) (hU' : ∀ i, is_affine_open (U i)), + ∀ i, @@P (f ∣_ (U i)) (hU' i)] := +begin + tfae_have : 1 → 4, + { intros H U g h₁ h₂, + resetI, + replace H := H ⟨⟨_, h₂.base_open.open_range⟩, + range_is_affine_open_of_open_immersion g⟩, + rw ← P.to_property_apply at H ⊢, + rwa ← hP.1.arrow_mk_iso_iff (morphism_restrict_opens_range f _) }, + tfae_have : 4 → 3, + { intros H 𝒰 h𝒰 i, + resetI, + apply H }, + tfae_have : 3 → 2, + { exact λ H, ⟨Y.affine_cover, infer_instance, H Y.affine_cover⟩ }, + tfae_have : 2 → 1, + { rintro ⟨𝒰, h𝒰, H⟩, exactI target_affine_locally_of_open_cover hP f 𝒰 H }, + tfae_have : 5 → 2, + { rintro ⟨ι, U, hU, hU', H⟩, + refine ⟨Y.open_cover_of_supr_eq_top U hU, hU', _⟩, + intro i, + specialize H i, + rw [← P.to_property_apply, ← hP.1.arrow_mk_iso_iff (morphism_restrict_opens_range f _)], + rw ← P.to_property_apply at H, + convert H, + all_goals { ext1, exact subtype.range_coe } }, + tfae_have : 1 → 5, + { intro H, + refine ⟨Y.carrier, λ x, (Y.affine_cover.map x).opens_range, _, + λ i, range_is_affine_open_of_open_immersion _, _⟩, + { rw eq_top_iff, intros x _, erw opens.mem_supr, exact⟨x, Y.affine_cover.covers x⟩ }, + { intro i, exact H ⟨_, range_is_affine_open_of_open_immersion _⟩ } }, + tfae_finish +end + +lemma affine_target_morphism_property.is_local_of_open_cover_imply + (P : affine_target_morphism_property) (hP : P.to_property.respects_iso) + (H : ∀ {X Y : Scheme.{u}} (f : X ⟶ Y), + (∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)], ∀ (i : 𝒰.J), + by exactI P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i)) → + (∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g], + by exactI P (pullback.snd : pullback f g ⟶ U))) : P.is_local := +begin + refine ⟨hP, _, _⟩, + { introv h, + resetI, + haveI : is_affine _ := (top_is_affine_open Y).basic_open_is_affine r, + delta morphism_restrict, + rw affine_cancel_left_is_iso hP, + refine @@H f ⟨Scheme.open_cover_of_is_iso (𝟙 Y), _, _⟩ (Y.of_restrict _) _inst _, + { intro i, dsimp, apply_instance }, + { intro i, dsimp, + rwa [← category.comp_id pullback.snd, ← pullback.condition, affine_cancel_left_is_iso hP] } }, + { introv hs hs', + resetI, + replace hs := ((top_is_affine_open Y).basic_open_union_eq_self_iff _).mpr hs, + have := H f ⟨Y.open_cover_of_supr_eq_top _ hs, _, _⟩ (𝟙 _), + rwa [← category.comp_id pullback.snd, ← pullback.condition, + affine_cancel_left_is_iso hP] at this, + { intro i, exact (top_is_affine_open Y).basic_open_is_affine _ }, + { rintro (i : s), + specialize hs' i, + haveI : is_affine _ := (top_is_affine_open Y).basic_open_is_affine i.1, + delta morphism_restrict at hs', + rwa affine_cancel_left_is_iso hP at hs' } } +end + +lemma affine_target_morphism_property.is_local.affine_open_cover_iff + {P : affine_target_morphism_property} (hP : P.is_local) + {X Y : Scheme.{u}} (f : X ⟶ Y) (𝒰 : Scheme.open_cover.{u} Y) [h𝒰 : ∀ i, is_affine (𝒰.obj i)] : + target_affine_locally P f ↔ ∀ i, @@P (pullback.snd : pullback f (𝒰.map i) ⟶ _) (h𝒰 i) := +⟨λ H, let h := ((hP.affine_open_cover_tfae f).out 0 2).mp H in h 𝒰, + λ H, let h := ((hP.affine_open_cover_tfae f).out 1 0).mp in h ⟨𝒰, infer_instance, H⟩⟩ + +lemma affine_target_morphism_property.is_local.affine_target_iff + {P : affine_target_morphism_property} (hP : P.is_local) + {X Y : Scheme.{u}} (f : X ⟶ Y) [is_affine Y] : + target_affine_locally P f ↔ P f := +begin + rw hP.affine_open_cover_iff f _, + swap, { exact Scheme.open_cover_of_is_iso (𝟙 Y) }, + swap, { intro _, dsimp, apply_instance }, + transitivity (P (pullback.snd : pullback f (𝟙 _) ⟶ _)), + { exact ⟨λ H, H punit.star, λ H _, H⟩ }, + rw [← category.comp_id pullback.snd, ← pullback.condition, affine_cancel_left_is_iso hP.1], +end + +/-- +We say that `P : morphism_property Scheme` is local at the target if +1. `P` respects isomorphisms. +2. If `P` holds for `f : X ⟶ Y`, then `P` holds for `f ∣_ U` for any `U`. +3. If `P` holds for `f ∣_ U` for an open cover `U` of `Y`, then `P` holds for `f`. +-/ +structure property_is_local_at_target (P : morphism_property Scheme) : Prop := +(respects_iso : P.respects_iso) +(restrict : ∀ {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier), P f → P (f ∣_ U)) +(of_open_cover : ∀ {X Y : Scheme.{u}} (f : X ⟶ Y) (𝒰 : Scheme.open_cover.{u} Y), + (∀ (i : 𝒰.J), P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i)) → P f) + +lemma affine_target_morphism_property.is_local.target_affine_locally_is_local + {P : affine_target_morphism_property} (hP : P.is_local) : + property_is_local_at_target (target_affine_locally P) := +begin + constructor, + { exact target_affine_locally_respects_iso hP.1 }, + { intros X Y f U H V, + rw [← P.to_property_apply, hP.1.arrow_mk_iso_iff (morphism_restrict_restrict f _ _)], + convert H ⟨_, is_affine_open.image_is_open_immersion V.2 (Y.of_restrict _)⟩, + rw ← P.to_property_apply, + refl }, + { rintros X Y f 𝒰 h𝒰, + rw (hP.affine_open_cover_tfae f).out 0 1, + refine ⟨𝒰.bind (λ _, Scheme.affine_cover _), _, _⟩, + { intro i, dsimp [Scheme.open_cover.bind], apply_instance }, + { intro i, + specialize h𝒰 i.1, + rw (hP.affine_open_cover_tfae (pullback.snd : pullback f (𝒰.map i.fst) ⟶ _)).out 0 2 + at h𝒰, + specialize h𝒰 (Scheme.affine_cover _) i.2, + let e : pullback f ((𝒰.obj i.fst).affine_cover.map i.snd ≫ 𝒰.map i.fst) ⟶ + pullback (pullback.snd : pullback f (𝒰.map i.fst) ⟶ _) + ((𝒰.obj i.fst).affine_cover.map i.snd), + { refine (pullback_symmetry _ _).hom ≫ _, + refine (pullback_right_pullback_fst_iso _ _ _).inv ≫ _, + refine (pullback_symmetry _ _).hom ≫ _, + refine pullback.map _ _ _ _ (pullback_symmetry _ _).hom (𝟙 _) (𝟙 _) _ _; + simp only [category.comp_id, category.id_comp, pullback_symmetry_hom_comp_snd] }, + rw ← affine_cancel_left_is_iso hP.1 e at h𝒰, + convert h𝒰, + simp } }, +end + +lemma property_is_local_at_target.open_cover_tfae + {P : morphism_property Scheme} + (hP : property_is_local_at_target P) + {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [P f, + ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J), + P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J), + P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (U : opens Y.carrier), P (f ∣_ U), + ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g], + P (pullback.snd : pullback f g ⟶ U), + ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤), (∀ i, P (f ∣_ (U i)))] := +begin + tfae_have : 2 → 1, + { rintro ⟨𝒰, H⟩, exact hP.3 f 𝒰 H }, + tfae_have : 1 → 4, + { intros H U, exact hP.2 f U H }, + tfae_have : 4 → 3, + { intros H 𝒰 i, + rw ← hP.1.arrow_mk_iso_iff (morphism_restrict_opens_range f _), + exact H (𝒰.map i).opens_range }, + tfae_have : 3 → 2, + { exact λ H, ⟨Y.affine_cover, H Y.affine_cover⟩ }, + tfae_have : 4 → 5, + { intros H U g hg, + resetI, + rw ← hP.1.arrow_mk_iso_iff (morphism_restrict_opens_range f _), + apply H }, + tfae_have : 5 → 4, + { intros H U, + erw hP.1.cancel_left_is_iso, + apply H }, + tfae_have : 4 → 6, + { intro H, exact ⟨punit, λ _, ⊤, csupr_const, λ _, H _⟩ }, + tfae_have : 6 → 2, + { rintro ⟨ι, U, hU, H⟩, + refine ⟨Y.open_cover_of_supr_eq_top U hU, _⟩, + intro i, + rw ← hP.1.arrow_mk_iso_iff (morphism_restrict_opens_range f _), + convert H i, + all_goals { ext1, exact subtype.range_coe } }, + tfae_finish +end + +lemma property_is_local_at_target.open_cover_iff + {P : morphism_property Scheme} (hP : property_is_local_at_target P) + {X Y : Scheme.{u}} (f : X ⟶ Y) (𝒰 : Scheme.open_cover.{u} Y) : + P f ↔ ∀ i, P (pullback.snd : pullback f (𝒰.map i) ⟶ _) := +⟨λ H, let h := ((hP.open_cover_tfae f).out 0 2).mp H in h 𝒰, + λ H, let h := ((hP.open_cover_tfae f).out 1 0).mp in h ⟨𝒰, H⟩⟩ + +namespace affine_target_morphism_property + +/-- A `P : affine_target_morphism_property` is stable under base change if `P` holds for `Y ⟶ S` +implies that `P` holds for `X ×ₛ Y ⟶ X` with `X` and `S` affine schemes. -/ +def stable_under_base_change + (P : affine_target_morphism_property) : Prop := +∀ ⦃X Y S : Scheme⦄ [is_affine S] [is_affine X] (f : X ⟶ S) (g : Y ⟶ S), + by exactI P g → P (pullback.fst : pullback f g ⟶ X) + +lemma is_local.target_affine_locally_pullback_fst_of_right_of_stable_under_base_change + {P : affine_target_morphism_property} (hP : P.is_local) (hP' : P.stable_under_base_change) + {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [is_affine S] (H : P g) : + target_affine_locally P (pullback.fst : pullback f g ⟶ X) := +begin + rw (hP.affine_open_cover_tfae (pullback.fst : pullback f g ⟶ X)).out 0 1, + use [X.affine_cover, infer_instance], + intro i, + let e := pullback_symmetry _ _ ≪≫ pullback_right_pullback_fst_iso f g (X.affine_cover.map i), + have : e.hom ≫ pullback.fst = pullback.snd := by simp, + rw [← this, affine_cancel_left_is_iso hP.1], + apply hP'; assumption, +end + +lemma is_local.stable_under_base_change + {P : affine_target_morphism_property} (hP : P.is_local) (hP' : P.stable_under_base_change) : + (target_affine_locally P).stable_under_base_change := +morphism_property.stable_under_base_change.mk (target_affine_locally_respects_iso hP.respects_iso) +begin + intros X Y S f g H, + rw (hP.target_affine_locally_is_local.open_cover_tfae (pullback.fst : pullback f g ⟶ X)).out 0 1, + use S.affine_cover.pullback_cover f, + intro i, + rw (hP.affine_open_cover_tfae g).out 0 3 at H, + let e : pullback (pullback.fst : pullback f g ⟶ _) ((S.affine_cover.pullback_cover f).map i) ≅ _, + { refine pullback_symmetry _ _ ≪≫ pullback_right_pullback_fst_iso f g _ ≪≫ _ ≪≫ + (pullback_right_pullback_fst_iso (S.affine_cover.map i) g + (pullback.snd : pullback f (S.affine_cover.map i) ⟶ _)).symm, + exact as_iso (pullback.map _ _ _ _ (𝟙 _) (𝟙 _) (𝟙 _) + (by simpa using pullback.condition) (by simp)) }, + have : e.hom ≫ pullback.fst = pullback.snd := by simp, + rw [← this, (target_affine_locally_respects_iso hP.1).cancel_left_is_iso], + apply hP.target_affine_locally_pullback_fst_of_right_of_stable_under_base_change hP', + rw [← pullback_symmetry_hom_comp_snd, affine_cancel_left_is_iso hP.1], + apply H +end + +end affine_target_morphism_property + +/-- +The `affine_target_morphism_property` associated to `(target_affine_locally P).diagonal`. +See `diagonal_target_affine_locally_eq_target_affine_locally`. +-/ +def affine_target_morphism_property.diagonal (P : affine_target_morphism_property) : + affine_target_morphism_property := +λ X Y f hf, ∀ {U₁ U₂ : Scheme} (f₁ : U₁ ⟶ X) (f₂ : U₂ ⟶ X) [is_affine U₁] [is_affine U₂] + [is_open_immersion f₁] [is_open_immersion f₂], + by exactI P (pullback.map_desc f₁ f₂ f) + +lemma affine_target_morphism_property.diagonal_respects_iso (P : affine_target_morphism_property) + (hP : P.to_property.respects_iso) : + P.diagonal.to_property.respects_iso := +begin + delta affine_target_morphism_property.diagonal, + apply affine_target_morphism_property.respects_iso_mk, + { introv H _ _, + resetI, + rw [pullback.map_desc_comp, affine_cancel_left_is_iso hP, affine_cancel_right_is_iso hP], + apply H }, + { introv H _ _, + resetI, + rw [pullback.map_desc_comp, affine_cancel_right_is_iso hP], + apply H } +end + +lemma diagonal_target_affine_locally_of_open_cover (P : affine_target_morphism_property) + (hP : P.is_local) + {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} Y) + [∀ i, is_affine (𝒰.obj i)] (𝒰' : Π i, Scheme.open_cover.{u} (pullback f (𝒰.map i))) + [∀ i j, is_affine ((𝒰' i).obj j)] + (h𝒰' : ∀ i j k, P (pullback.map_desc ((𝒰' i).map j) ((𝒰' i).map k) pullback.snd)) : + (target_affine_locally P).diagonal f := +begin + refine (hP.affine_open_cover_iff _ _).mpr _, + { exact ((Scheme.pullback.open_cover_of_base 𝒰 f f).bind (λ i, + Scheme.pullback.open_cover_of_left_right.{u u} (𝒰' i) (𝒰' i) pullback.snd pullback.snd)) }, + { intro i, + dsimp at *, + apply_instance }, + { rintro ⟨i, j, k⟩, + dsimp, + convert (affine_cancel_left_is_iso hP.1 + (pullback_diagonal_map_iso _ _ ((𝒰' i).map j) ((𝒰' i).map k)).inv pullback.snd).mp _, + swap 3, + { convert h𝒰' i j k, apply pullback.hom_ext; simp, }, + all_goals + { apply pullback.hom_ext; simp only [category.assoc, pullback.lift_fst, pullback.lift_snd, + pullback.lift_fst_assoc, pullback.lift_snd_assoc] } } +end + +lemma affine_target_morphism_property.diagonal_of_target_affine_locally + (P : affine_target_morphism_property) + (hP : P.is_local) {X Y U : Scheme.{u}} (f : X ⟶ Y) (g : U ⟶ Y) + [is_affine U] [is_open_immersion g] (H : (target_affine_locally P).diagonal f) : + P.diagonal (pullback.snd : pullback f g ⟶ _) := +begin + rintros U V f₁ f₂ _ _ _ _, + resetI, + replace H := ((hP.affine_open_cover_tfae (pullback.diagonal f)).out 0 3).mp H, + let g₁ := pullback.map (f₁ ≫ pullback.snd) + (f₂ ≫ pullback.snd) f f + (f₁ ≫ pullback.fst) + (f₂ ≫ pullback.fst) g + (by rw [category.assoc, category.assoc, pullback.condition]) + (by rw [category.assoc, category.assoc, pullback.condition]), + let g₂ : pullback f₁ f₂ ⟶ pullback f g := pullback.fst ≫ f₁, + specialize H g₁, + rw ← affine_cancel_left_is_iso hP.1 (pullback_diagonal_map_iso f _ f₁ f₂).hom, + convert H, + { apply pullback.hom_ext; simp only [category.assoc, pullback.lift_fst, pullback.lift_snd, + pullback.lift_fst_assoc, pullback.lift_snd_assoc, category.comp_id, + pullback_diagonal_map_iso_hom_fst, pullback_diagonal_map_iso_hom_snd], } +end + +lemma affine_target_morphism_property.is_local.diagonal_affine_open_cover_tfae + {P : affine_target_morphism_property} + (hP : P.is_local) {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [(target_affine_locally P).diagonal f, + ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)], by exactI + ∀ (i : 𝒰.J), P.diagonal (pullback.snd : pullback f (𝒰.map i) ⟶ _), + ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J), by exactI + P.diagonal (pullback.snd : pullback f (𝒰.map i) ⟶ _), + ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g], by exactI + P.diagonal (pullback.snd : pullback f g ⟶ _), + ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] + (𝒰' : Π i, Scheme.open_cover.{u} (pullback f (𝒰.map i))) [∀ i j, is_affine ((𝒰' i).obj j)], + by exactI ∀ i j k, P (pullback.map_desc ((𝒰' i).map j) ((𝒰' i).map k) pullback.snd)] := +begin + tfae_have : 1 → 4, + { introv H hU hg _ _, resetI, apply P.diagonal_of_target_affine_locally; assumption }, + tfae_have : 4 → 3, + { introv H h𝒰, resetI, apply H }, + tfae_have : 3 → 2, + { exact λ H, ⟨Y.affine_cover, infer_instance, H Y.affine_cover⟩ }, + tfae_have : 2 → 5, + { rintro ⟨𝒰, h𝒰, H⟩, + resetI, + refine ⟨𝒰, infer_instance, λ _, Scheme.affine_cover _, infer_instance, _⟩, + intros i j k, + apply H }, + tfae_have : 5 → 1, + { rintro ⟨𝒰, _, 𝒰', _, H⟩, + exactI diagonal_target_affine_locally_of_open_cover P hP f 𝒰 𝒰' H, }, + tfae_finish +end + +lemma affine_target_morphism_property.is_local.diagonal {P : affine_target_morphism_property} + (hP : P.is_local) : P.diagonal.is_local := +affine_target_morphism_property.is_local_of_open_cover_imply + P.diagonal + (P.diagonal_respects_iso hP.1) + (λ _ _ f, ((hP.diagonal_affine_open_cover_tfae f).out 1 3).mp) + +lemma diagonal_target_affine_locally_eq_target_affine_locally (P : affine_target_morphism_property) + (hP : P.is_local) : + (target_affine_locally P).diagonal = target_affine_locally P.diagonal := +begin + ext _ _ f, + exact ((hP.diagonal_affine_open_cover_tfae f).out 0 1).trans + ((hP.diagonal.affine_open_cover_tfae f).out 1 0), +end + +lemma universally_is_local_at_target (P : morphism_property Scheme) + (hP : ∀ {X Y : Scheme.{u}} (f : X ⟶ Y) (𝒰 : Scheme.open_cover.{u} Y), + (∀ (i : 𝒰.J), P (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i)) → P f) : + property_is_local_at_target P.universally := +begin + refine ⟨P.universally_respects_iso, λ X Y f U, P.universally_stable_under_base_change + (is_pullback_morphism_restrict f U).flip, _⟩, + intros X Y f 𝒰 h X' Y' i₁ i₂ f' H, + apply hP _ (𝒰.pullback_cover i₂), + intro i, + dsimp, + apply h i (pullback.lift (pullback.fst ≫ i₁) (pullback.snd ≫ pullback.snd) _) pullback.snd, + swap, + { rw [category.assoc, category.assoc, ← pullback.condition, ← pullback.condition_assoc, H.w] }, + refine (is_pullback.of_right _ (pullback.lift_snd _ _ _) (is_pullback.of_has_pullback _ _)).flip, + rw [pullback.lift_fst, ← pullback.condition], + exact (is_pullback.of_has_pullback _ _).paste_horiz H.flip +end + +lemma universally_is_local_at_target_of_morphism_restrict (P : morphism_property Scheme) + (hP₁ : P.respects_iso) + (hP₂ : ∀ {X Y : Scheme.{u}} (f : X ⟶ Y) {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤), + (∀ i, P (f ∣_ (U i))) → P f) : + property_is_local_at_target P.universally := +universally_is_local_at_target P +begin + intros X Y f 𝒰 h𝒰, + apply hP₂ f (λ (i : 𝒰.J), (𝒰.map i).opens_range) 𝒰.supr_opens_range, + simp_rw hP₁.arrow_mk_iso_iff (morphism_restrict_opens_range f _), + exact h𝒰 +end + +/-- `topologically P` holds for a morphism if the underlying topological map satisfies `P`. -/ +def morphism_property.topologically + (P : ∀ {α β : Type u} [topological_space α] [topological_space β] (f : α → β), Prop) : + morphism_property Scheme.{u} := +λ X Y f, P f.1.base + +end algebraic_geometry diff --git a/src/algebraic_geometry/morphisms/finite_type.lean b/src/algebraic_geometry/morphisms/finite_type.lean new file mode 100644 index 0000000000000..ce417476ad834 --- /dev/null +++ b/src/algebraic_geometry/morphisms/finite_type.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.morphisms.ring_hom_properties +import ring_theory.ring_hom.finite_type + +/-! +# Morphisms of finite type + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A morphism of schemes `f : X ⟶ Y` is locally of finite type if for each affine `U ⊆ Y` and +`V ⊆ f ⁻¹' U`, The induced map `Γ(Y, U) ⟶ Γ(X, V)` is of finite type. + +A morphism of schemes is of finite type if it is both locally of finite type and quasi-compact. + +We show that these properties are local, and are stable under compositions. + +-/ + +noncomputable theory + +open category_theory category_theory.limits opposite topological_space + +universes v u + +namespace algebraic_geometry + +variables {X Y : Scheme.{u}} (f : X ⟶ Y) + +/-- +A morphism of schemes `f : X ⟶ Y` is locally of finite type if for each affine `U ⊆ Y` and +`V ⊆ f ⁻¹' U`, The induced map `Γ(Y, U) ⟶ Γ(X, V)` is of finite type. +-/ +@[mk_iff] +class locally_of_finite_type (f : X ⟶ Y) : Prop := +(finite_type_of_affine_subset : + ∀ (U : Y.affine_opens) (V : X.affine_opens) (e : V.1 ≤ (opens.map f.1.base).obj U.1), + (f.app_le e).finite_type) + +lemma locally_of_finite_type_eq : + @locally_of_finite_type = affine_locally @ring_hom.finite_type := +begin + ext X Y f, + rw [locally_of_finite_type_iff, affine_locally_iff_affine_opens_le], + exact ring_hom.finite_type_respects_iso +end + +@[priority 900] +instance locally_of_finite_type_of_is_open_immersion {X Y : Scheme} (f : X ⟶ Y) + [is_open_immersion f] : locally_of_finite_type f := +locally_of_finite_type_eq.symm ▸ ring_hom.finite_type_is_local.affine_locally_of_is_open_immersion f + +lemma locally_of_finite_type_stable_under_composition : + morphism_property.stable_under_composition @locally_of_finite_type := +locally_of_finite_type_eq.symm ▸ +ring_hom.finite_type_is_local.affine_locally_stable_under_composition + +instance locally_of_finite_type_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) + [hf : locally_of_finite_type f] [hg : locally_of_finite_type g] : + locally_of_finite_type (f ≫ g) := +locally_of_finite_type_stable_under_composition f g hf hg + +lemma locally_of_finite_type_of_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) + [hf : locally_of_finite_type (f ≫ g)] : + locally_of_finite_type f := +begin + unfreezingI { revert hf }, + rw [locally_of_finite_type_eq], + apply ring_hom.finite_type_is_local.affine_locally_of_comp, + introv H, + exactI ring_hom.finite_type.of_comp_finite_type H, +end + +lemma locally_of_finite_type.affine_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] + (𝒰' : ∀ i, Scheme.open_cover.{u} ((𝒰.pullback_cover f).obj i)) + [∀ i j, is_affine ((𝒰' i).obj j)] : + locally_of_finite_type f ↔ + (∀ i j, (Scheme.Γ.map ((𝒰' i).map j ≫ pullback.snd).op).finite_type) := +locally_of_finite_type_eq.symm ▸ ring_hom.finite_type_is_local.affine_open_cover_iff f 𝒰 𝒰' + +lemma locally_of_finite_type.source_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} X) : + locally_of_finite_type f ↔ (∀ i, locally_of_finite_type (𝒰.map i ≫ f)) := +locally_of_finite_type_eq.symm ▸ ring_hom.finite_type_is_local.source_open_cover_iff f 𝒰 + +lemma locally_of_finite_type.open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} Y) : + locally_of_finite_type f ↔ + (∀ i, locally_of_finite_type (pullback.snd : pullback f (𝒰.map i) ⟶ _)) := +locally_of_finite_type_eq.symm ▸ + ring_hom.finite_type_is_local.is_local_affine_locally.open_cover_iff f 𝒰 + +lemma locally_of_finite_type_respects_iso : + morphism_property.respects_iso @locally_of_finite_type := +locally_of_finite_type_eq.symm ▸ target_affine_locally_respects_iso + (source_affine_locally_respects_iso ring_hom.finite_type_respects_iso) + +end algebraic_geometry diff --git a/src/algebraic_geometry/morphisms/open_immersion.lean b/src/algebraic_geometry/morphisms/open_immersion.lean new file mode 100644 index 0000000000000..4ae87dfbdce6e --- /dev/null +++ b/src/algebraic_geometry/morphisms/open_immersion.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import topology.local_at_target +import algebraic_geometry.morphisms.basic + +/-! + +# Open immersions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A morphism is an open immersions if the underlying map of spaces is an open embedding +`f : X ⟶ U ⊆ Y`, and the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`. + +Most of the theories are developed in `algebraic_geometry/open_immersion`, and we provide the +remaining theorems analogous to other lemmas in `algebraic_geometry/morphisms/*`. + +-/ + +noncomputable theory + +open category_theory category_theory.limits opposite topological_space + +universe u + +namespace algebraic_geometry + +variables {X Y Z : Scheme.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) + +lemma is_open_immersion_iff_stalk {f : X ⟶ Y} : + is_open_immersion f ↔ + open_embedding f.1.base ∧ ∀ x, is_iso (PresheafedSpace.stalk_map f.1 x) := +begin + split, + { intro h, exactI ⟨h.1, infer_instance⟩ }, + { rintro ⟨h₁, h₂⟩, exactI is_open_immersion.of_stalk_iso f h₁ } +end + +lemma is_open_immersion_stable_under_composition : + morphism_property.stable_under_composition @is_open_immersion := +begin + introsI X Y Z f g h₁ h₂, apply_instance +end + +lemma is_open_immersion_respects_iso : + morphism_property.respects_iso @is_open_immersion := +begin + apply is_open_immersion_stable_under_composition.respects_iso, + intros _ _ _, apply_instance +end + +lemma is_open_immersion_is_local_at_target : property_is_local_at_target @is_open_immersion := +begin + constructor, + { exact is_open_immersion_respects_iso }, + { introsI, apply_instance }, + { intros X Y f 𝒰 H, + rw is_open_immersion_iff_stalk, + split, + { apply (open_embedding_iff_open_embedding_of_supr_eq_top + 𝒰.supr_opens_range f.1.base.2).mpr, + intro i, + have := ((is_open_immersion_respects_iso.arrow_iso_iff + (morphism_restrict_opens_range f (𝒰.map i))).mpr (H i)).1, + rwa [arrow.mk_hom, morphism_restrict_val_base] at this }, + { intro x, + have := arrow.iso_w (morphism_restrict_stalk_map f ((𝒰.map $ 𝒰.f $ f.1 x).opens_range) + ⟨x, 𝒰.covers _⟩), + dsimp only [arrow.mk_hom] at this, + rw this, + haveI : is_open_immersion (f ∣_ (𝒰.map $ 𝒰.f $ f.1 x).opens_range) := + (is_open_immersion_respects_iso.arrow_iso_iff + (morphism_restrict_opens_range f (𝒰.map _))).mpr (H _), + apply_instance } } +end + +lemma is_open_immersion.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [is_open_immersion f, + ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J), + is_open_immersion (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J), + is_open_immersion (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (U : opens Y.carrier), is_open_immersion (f ∣_ U), + ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g], + is_open_immersion (pullback.snd : pullback f g ⟶ _), + ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤), + ∀ i, is_open_immersion (f ∣_ (U i))] := +is_open_immersion_is_local_at_target.open_cover_tfae f + +lemma is_open_immersion.open_cover_iff {X Y : Scheme.{u}} + (𝒰 : Scheme.open_cover.{u} Y) (f : X ⟶ Y) : + is_open_immersion f ↔ ∀ i, is_open_immersion (pullback.snd : pullback f (𝒰.map i) ⟶ _) := +is_open_immersion_is_local_at_target.open_cover_iff f 𝒰 + +lemma is_open_immersion_stable_under_base_change : + morphism_property.stable_under_base_change @is_open_immersion := +morphism_property.stable_under_base_change.mk is_open_immersion_respects_iso $ + by { introsI X Y Z f g H, apply_instance } + +end algebraic_geometry diff --git a/src/algebraic_geometry/morphisms/quasi_compact.lean b/src/algebraic_geometry/morphisms/quasi_compact.lean new file mode 100644 index 0000000000000..b0914f8516fd2 --- /dev/null +++ b/src/algebraic_geometry/morphisms/quasi_compact.lean @@ -0,0 +1,341 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.morphisms.basic +import topology.spectral.hom +import algebraic_geometry.limits + +/-! +# Quasi-compact morphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A morphism of schemes is quasi-compact if the preimages of quasi-compact open sets are +quasi-compact. + +It suffices to check that preimages of affine open sets are compact +(`quasi_compact_iff_forall_affine`). + +-/ + +noncomputable theory + +open category_theory category_theory.limits opposite topological_space + +universe u + +open_locale algebraic_geometry + +namespace algebraic_geometry + +variables {X Y : Scheme.{u}} (f : X ⟶ Y) + +/-- +A morphism is `quasi-compact` if the underlying map of topological spaces is, i.e. if the preimages +of quasi-compact open sets are quasi-compact. +-/ +@[mk_iff] +class quasi_compact (f : X ⟶ Y) : Prop := +(is_compact_preimage : ∀ U : set Y.carrier, is_open U → is_compact U → is_compact (f.1.base ⁻¹' U)) + +lemma quasi_compact_iff_spectral : quasi_compact f ↔ is_spectral_map f.1.base := +⟨λ ⟨h⟩, ⟨by continuity, h⟩, λ h, ⟨h.2⟩⟩ + +/-- The `affine_target_morphism_property` corresponding to `quasi_compact`, asserting that the +domain is a quasi-compact scheme. -/ +def quasi_compact.affine_property : affine_target_morphism_property := +λ X Y f hf, compact_space X.carrier + +@[priority 900] +instance quasi_compact_of_is_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] : quasi_compact f := +begin + constructor, + intros U hU hU', + convert hU'.image (inv f.1.base).continuous_to_fun using 1, + rw set.image_eq_preimage_of_inverse, + delta function.left_inverse, + exacts [is_iso.inv_hom_id_apply f.1.base, is_iso.hom_inv_id_apply f.1.base] +end + +instance quasi_compact_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) + [quasi_compact f] [quasi_compact g] : quasi_compact (f ≫ g) := +begin + constructor, + intros U hU hU', + rw [Scheme.comp_val_base, coe_comp, set.preimage_comp], + apply quasi_compact.is_compact_preimage, + { exact continuous.is_open_preimage (by continuity) _ hU }, + apply quasi_compact.is_compact_preimage; assumption +end + +lemma is_compact_open_iff_eq_finset_affine_union {X : Scheme} (U : set X.carrier) : + is_compact U ∧ is_open U ↔ + ∃ (s : set X.affine_opens), s.finite ∧ U = ⋃ (i : X.affine_opens) (h : i ∈ s), i := +begin + apply opens.is_basis.is_compact_open_iff_eq_finite_Union + (coe : X.affine_opens → opens X.carrier), + { rw subtype.range_coe, exact is_basis_affine_open X }, + { exact λ i, i.2.is_compact } +end + +lemma is_compact_open_iff_eq_basic_open_union {X : Scheme} [is_affine X] (U : set X.carrier) : + is_compact U ∧ is_open U ↔ + ∃ (s : set (X.presheaf.obj (op ⊤))), s.finite ∧ + U = ⋃ (i : X.presheaf.obj (op ⊤)) (h : i ∈ s), X.basic_open i := +(is_basis_basic_open X).is_compact_open_iff_eq_finite_Union _ + (λ i, ((top_is_affine_open _).basic_open_is_affine _).is_compact) _ + +lemma quasi_compact_iff_forall_affine : quasi_compact f ↔ + ∀ U : opens Y.carrier, is_affine_open U → is_compact (f.1.base ⁻¹' (U : set Y.carrier)) := +begin + rw quasi_compact_iff, + refine ⟨λ H U hU, H U U.is_open hU.is_compact, _⟩, + intros H U hU hU', + obtain ⟨S, hS, rfl⟩ := (is_compact_open_iff_eq_finset_affine_union U).mp ⟨hU', hU⟩, + simp only [set.preimage_Union, subtype.val_eq_coe], + exact hS.is_compact_bUnion (λ i _, H i i.prop) +end + +@[simp] lemma quasi_compact.affine_property_to_property {X Y : Scheme} (f : X ⟶ Y) : + (quasi_compact.affine_property : _).to_property f ↔ + is_affine Y ∧ compact_space X.carrier := +by { delta affine_target_morphism_property.to_property quasi_compact.affine_property, simp } + +lemma quasi_compact_iff_affine_property : + quasi_compact f ↔ target_affine_locally quasi_compact.affine_property f := +begin + rw quasi_compact_iff_forall_affine, + transitivity (∀ U : Y.affine_opens, is_compact (f.1.base ⁻¹' (U : set Y.carrier))), + { exact ⟨λ h U, h U U.prop, λ h U hU, h ⟨U, hU⟩⟩ }, + apply forall_congr, + exact λ _, is_compact_iff_compact_space, +end + +lemma quasi_compact_eq_affine_property : + @quasi_compact = target_affine_locally quasi_compact.affine_property := +by { ext, exact quasi_compact_iff_affine_property _ } + +lemma is_compact_basic_open (X : Scheme) {U : opens X.carrier} (hU : is_compact (U : set X.carrier)) + (f : X.presheaf.obj (op U)) : is_compact (X.basic_open f : set X.carrier) := +begin + classical, + refine ((is_compact_open_iff_eq_finset_affine_union _).mpr _).1, + obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_finset_affine_union _).mp ⟨hU, U.is_open⟩, + let g : s → X.affine_opens, + { intro V, + use V.1 ⊓ X.basic_open f, + have : V.1.1 ⟶ U, + { apply hom_of_le, change _ ⊆ (U : set X.carrier), rw e, + convert @set.subset_Union₂ _ _ _ (λ (U : X.affine_opens) (h : U ∈ s), ↑U) V V.prop using 1, + refl }, + erw ← X.to_LocallyRingedSpace.to_RingedSpace.basic_open_res this.op, + exact is_affine_open.basic_open_is_affine V.1.prop _ }, + haveI : finite s := hs.to_subtype, + refine ⟨set.range g, set.finite_range g, _⟩, + refine (set.inter_eq_right_iff_subset.mpr (set_like.coe_subset_coe.2 $ + RingedSpace.basic_open_le _ _)).symm.trans _, + rw [e, set.Union₂_inter], + apply le_antisymm; apply set.Union₂_subset, + { intros i hi, + refine set.subset.trans _ (set.subset_Union₂ _ (set.mem_range_self ⟨i, hi⟩)), + exact set.subset.rfl }, + { rintro ⟨i, hi⟩ ⟨⟨j, hj⟩, hj'⟩, + rw ← hj', + refine set.subset.trans _ (set.subset_Union₂ j hj), + exact set.subset.rfl } +end + +lemma quasi_compact.affine_property_is_local : + (quasi_compact.affine_property : _).is_local := +begin + split, + { apply affine_target_morphism_property.respects_iso_mk; rintros X Y Z _ _ _ H, + exacts [@@homeomorph.compact_space _ _ H (Top.homeo_of_iso (as_iso e.inv.1.base)), H] }, + { introv H, + delta quasi_compact.affine_property at H ⊢, + change compact_space ((opens.map f.val.base).obj (Y.basic_open r)), + rw Scheme.preimage_basic_open f r, + erw ← is_compact_iff_compact_space, + rw ← is_compact_univ_iff at H, + exact is_compact_basic_open X H _ }, + { rintros X Y H f S hS hS', + resetI, + rw ← is_affine_open.basic_open_union_eq_self_iff at hS, + delta quasi_compact.affine_property, + rw ← is_compact_univ_iff, + change is_compact ((opens.map f.val.base).obj ⊤).1, + rw ← hS, + dsimp [opens.map], + simp only [opens.coe_supr, set.preimage_Union, subtype.val_eq_coe], + exacts [is_compact_Union (λ i, is_compact_iff_compact_space.mpr (hS' i)), + top_is_affine_open _] } +end + +lemma quasi_compact.affine_open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [quasi_compact f, + ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)], + ∀ (i : 𝒰.J), compact_space (pullback f (𝒰.map i)).carrier, + ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J), + compact_space (pullback f (𝒰.map i)).carrier, + ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g], + compact_space (pullback f g).carrier, + ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤) (hU' : ∀ i, is_affine_open (U i)), + ∀ i, compact_space (f.1.base ⁻¹' (U i).1)] := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.affine_open_cover_tfae f + +lemma quasi_compact.is_local_at_target : + property_is_local_at_target @quasi_compact := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.target_affine_locally_is_local + +lemma quasi_compact.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [quasi_compact f, + ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J), + quasi_compact (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J), + quasi_compact (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (U : opens Y.carrier), quasi_compact (f ∣_ U), + ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g], + quasi_compact (pullback.snd : pullback f g ⟶ _), + ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤), ∀ i, quasi_compact (f ∣_ (U i))] := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.target_affine_locally_is_local.open_cover_tfae f + +lemma quasi_compact_over_affine_iff {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] : + quasi_compact f ↔ compact_space X.carrier := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.affine_target_iff f + +lemma compact_space_iff_quasi_compact (X : Scheme) : + compact_space X.carrier ↔ quasi_compact (terminal.from X) := +(quasi_compact_over_affine_iff _).symm + +lemma quasi_compact.affine_open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y) + [∀ i, is_affine (𝒰.obj i)] (f : X ⟶ Y) : + quasi_compact f ↔ ∀ i, compact_space (pullback f (𝒰.map i)).carrier := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.affine_open_cover_iff f 𝒰 + +lemma quasi_compact.open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y) (f : X ⟶ Y) : + quasi_compact f ↔ ∀ i, quasi_compact (pullback.snd : pullback f (𝒰.map i) ⟶ _) := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.target_affine_locally_is_local.open_cover_iff f 𝒰 + +lemma quasi_compact_respects_iso : morphism_property.respects_iso @quasi_compact := +quasi_compact_eq_affine_property.symm ▸ + target_affine_locally_respects_iso quasi_compact.affine_property_is_local.1 + +lemma quasi_compact_stable_under_composition : + morphism_property.stable_under_composition @quasi_compact := +λ _ _ _ _ _ _ _, by exactI infer_instance + +local attribute [-simp] PresheafedSpace.as_coe SheafedSpace.as_coe + +lemma quasi_compact.affine_property_stable_under_base_change : + quasi_compact.affine_property.stable_under_base_change := +begin + intros X Y S _ _ f g h, + rw quasi_compact.affine_property at h ⊢, + resetI, + let 𝒰 := Scheme.pullback.open_cover_of_right Y.affine_cover.finite_subcover f g, + haveI : finite 𝒰.J, + { dsimp [𝒰], apply_instance }, + haveI : ∀ i, compact_space (𝒰.obj i).carrier, + { intro i, dsimp, apply_instance }, + exact 𝒰.compact_space, +end + +lemma quasi_compact_stable_under_base_change : + morphism_property.stable_under_base_change @quasi_compact := +quasi_compact_eq_affine_property.symm ▸ + quasi_compact.affine_property_is_local.stable_under_base_change + quasi_compact.affine_property_stable_under_base_change + +variables {Z : Scheme.{u}} + +instance (f : X ⟶ Z) (g : Y ⟶ Z) [quasi_compact g] : + quasi_compact (pullback.fst : pullback f g ⟶ X) := +quasi_compact_stable_under_base_change.fst f g infer_instance + +instance (f : X ⟶ Z) (g : Y ⟶ Z) [quasi_compact f] : + quasi_compact (pullback.snd : pullback f g ⟶ Y) := +quasi_compact_stable_under_base_change.snd f g infer_instance + +@[elab_as_eliminator] +lemma compact_open_induction_on {P : opens X.carrier → Prop} (S : opens X.carrier) + (hS : is_compact S.1) + (h₁ : P ⊥) + (h₂ : ∀ (S : opens X.carrier) (hS : is_compact S.1) (U : X.affine_opens), P S → P (S ⊔ U)) : + P S := +begin + classical, + obtain ⟨s, hs, hs'⟩ := (is_compact_open_iff_eq_finset_affine_union S.1).mp ⟨hS, S.2⟩, + replace hs' : S = supr (λ i : s, (i : opens X.carrier)) := by { ext1, simpa using hs' }, + subst hs', + apply hs.induction_on, + { convert h₁, rw supr_eq_bot, rintro ⟨_, h⟩, exact h.elim }, + { intros x s h₃ hs h₄, + have : is_compact (⨆ i : s, (i : opens X.carrier)).1, + { refine ((is_compact_open_iff_eq_finset_affine_union _).mpr _).1, exact ⟨s, hs, by simp⟩ }, + convert h₂ _ this x h₄, + simp only [coe_coe], + rw [supr_subtype, sup_comm], + conv_rhs { rw supr_subtype }, + exact supr_insert } +end + +lemma exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_affine_open (X : Scheme) + {U : opens X.carrier} (hU : is_affine_open U) (x f : X.presheaf.obj (op U)) + (H : x |_ X.basic_open f = 0) : + ∃ n : ℕ, f ^ n * x = 0 := +begin + rw ← map_zero (X.presheaf.map (hom_of_le $ X.basic_open_le f : X.basic_open f ⟶ U).op) at H, + have := (is_localization_basic_open hU f).3, + obtain ⟨⟨_, n, rfl⟩, e⟩ := this.mp H, + exact ⟨n, by simpa [mul_comm x] using e⟩, +end + +/-- If `x : Γ(X, U)` is zero on `D(f)` for some `f : Γ(X, U)`, and `U` is quasi-compact, then +`f ^ n * x = 0` for some `n`. -/ +lemma exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_compact (X : Scheme) + {U : opens X.carrier} (hU : is_compact U.1) (x f : X.presheaf.obj (op U)) + (H : x |_ X.basic_open f = 0) : + ∃ n : ℕ, f ^ n * x = 0 := +begin + obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_finset_affine_union U.1).mp ⟨hU, U.2⟩, + replace e : U = supr (λ i : s, (i : opens X.carrier)), + { ext1, simpa using e }, + have h₁ : ∀ i : s, i.1.1 ≤ U, + { intro i, change (i : opens X.carrier) ≤ U, rw e, exact le_supr _ _ }, + have H' := λ (i : s), exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_affine_open X i.1.2 + (X.presheaf.map (hom_of_le (h₁ i)).op x) (X.presheaf.map (hom_of_le (h₁ i)).op f) _, + swap, + { delta Top.presheaf.restrict_open Top.presheaf.restrict at H ⊢, + convert congr_arg (X.presheaf.map (hom_of_le _).op) H, + { simp only [← comp_apply, ← functor.map_comp], congr }, + { rw map_zero }, + { rw X.basic_open_res, exact set.inter_subset_right _ _ } }, + choose n hn using H', + haveI := hs.to_subtype, + casesI nonempty_fintype s, + use finset.univ.sup n, + suffices : ∀ (i : s), X.presheaf.map (hom_of_le (h₁ i)).op (f ^ (finset.univ.sup n) * x) = 0, + { subst e, + apply X.sheaf.eq_of_locally_eq (λ (i : s), (i : opens X.carrier)), + intro i, + rw map_zero, + apply this }, + intro i, + replace hn := congr_arg + (λ x, X.presheaf.map (hom_of_le (h₁ i)).op (f ^ (finset.univ.sup n - n i)) * x) (hn i), + dsimp at hn, + simp only [← map_mul, ← map_pow] at hn, + rwa [mul_zero, ← mul_assoc, ← pow_add, tsub_add_cancel_of_le] at hn, + apply finset.le_sup (finset.mem_univ i) +end + +end algebraic_geometry diff --git a/src/algebraic_geometry/morphisms/quasi_separated.lean b/src/algebraic_geometry/morphisms/quasi_separated.lean new file mode 100644 index 0000000000000..33569b42b09e2 --- /dev/null +++ b/src/algebraic_geometry/morphisms/quasi_separated.lean @@ -0,0 +1,484 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.morphisms.quasi_compact +import topology.quasi_separated + +/-! +# Quasi-separated morphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A morphism of schemes `f : X ⟶ Y` is quasi-separated if the diagonal morphism `X ⟶ X ×[Y] X` is +quasi-compact. + +A scheme is quasi-separated if the intersections of any two affine open sets is quasi-compact. +(`algebraic_geometry.quasi_separated_space_iff_affine`) + +We show that a morphism is quasi-separated if the preimage of every affine open is quasi-separated. + +We also show that this property is local at the target, +and is stable under compositions and base-changes. + +## Main result +- `is_localization_basic_open_of_qcqs` (**Qcqs lemma**): + If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`. + +-/ + +noncomputable theory + +open category_theory category_theory.limits opposite topological_space + +universe u + +open_locale algebraic_geometry + +namespace algebraic_geometry + +variables {X Y : Scheme.{u}} (f : X ⟶ Y) + +/-- A morphism is `quasi_separated` if diagonal map is quasi-compact. -/ +@[mk_iff] +class quasi_separated (f : X ⟶ Y) : Prop := +(diagonal_quasi_compact : quasi_compact (pullback.diagonal f)) + +/-- The `affine_target_morphism_property` corresponding to `quasi_separated`, asserting that the +domain is a quasi-separated scheme. -/ +def quasi_separated.affine_property : affine_target_morphism_property := +(λ X Y f _, quasi_separated_space X.carrier) + +lemma quasi_separated_space_iff_affine (X : Scheme) : + quasi_separated_space X.carrier ↔ ∀ (U V : X.affine_opens), is_compact (U ∩ V : set X.carrier) := +begin + rw quasi_separated_space_iff, + split, + { intros H U V, exact H U V U.1.2 U.2.is_compact V.1.2 V.2.is_compact }, + { intros H, + suffices : ∀ (U : opens X.carrier) (hU : is_compact U.1) (V : opens X.carrier) + (hV : is_compact V.1), is_compact (U ⊓ V).1, + { intros U V hU hU' hV hV', exact this ⟨U, hU⟩ hU' ⟨V, hV⟩ hV' }, + intros U hU V hV, + apply compact_open_induction_on V hV, + { simp }, + { intros S hS V hV, + change is_compact (U.1 ∩ (S.1 ∪ V.1)), + rw set.inter_union_distrib_left, + apply hV.union, + clear hV, + apply compact_open_induction_on U hU, + { simp }, + { intros S hS W hW, + change is_compact ((S.1 ∪ W.1) ∩ V.1), + rw set.union_inter_distrib_right, + apply hW.union, + apply H } } } +end + +lemma quasi_compact_affine_property_iff_quasi_separated_space {X Y : Scheme} [is_affine Y] + (f : X ⟶ Y) : + quasi_compact.affine_property.diagonal f ↔ quasi_separated_space X.carrier := +begin + delta affine_target_morphism_property.diagonal, + rw quasi_separated_space_iff_affine, + split, + { intros H U V, + haveI : is_affine _ := U.2, + haveI : is_affine _ := V.2, + let g : pullback (X.of_restrict U.1.open_embedding) (X.of_restrict V.1.open_embedding) ⟶ X := + pullback.fst ≫ X.of_restrict _, + have : is_open_immersion g := infer_instance, + have e := homeomorph.of_embedding _ this.base_open.to_embedding, + rw is_open_immersion.range_pullback_to_base_of_left at e, + erw [subtype.range_coe, subtype.range_coe] at e, + rw is_compact_iff_compact_space, + exact @@homeomorph.compact_space _ _ (H _ _) e }, + { introv H h₁ h₂, + resetI, + let g : pullback f₁ f₂ ⟶ X := pullback.fst ≫ f₁, + have : is_open_immersion g := infer_instance, + have e := homeomorph.of_embedding _ this.base_open.to_embedding, + rw is_open_immersion.range_pullback_to_base_of_left at e, + simp_rw is_compact_iff_compact_space at H, + exact @@homeomorph.compact_space _ _ + (H ⟨⟨_, h₁.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩ + ⟨⟨_, h₂.base_open.open_range⟩, range_is_affine_open_of_open_immersion _⟩) e.symm }, +end + +lemma quasi_separated_eq_diagonal_is_quasi_compact : + @quasi_separated = morphism_property.diagonal @quasi_compact := +by { ext, exact quasi_separated_iff _ } + +lemma quasi_compact_affine_property_diagonal_eq : + quasi_compact.affine_property.diagonal = quasi_separated.affine_property := +by { ext, rw quasi_compact_affine_property_iff_quasi_separated_space, refl } + +lemma quasi_separated_eq_affine_property_diagonal : + @quasi_separated = + target_affine_locally quasi_compact.affine_property.diagonal := +begin + rw [quasi_separated_eq_diagonal_is_quasi_compact, quasi_compact_eq_affine_property], + exact diagonal_target_affine_locally_eq_target_affine_locally + _ quasi_compact.affine_property_is_local +end + +lemma quasi_separated_eq_affine_property : + @quasi_separated = + target_affine_locally quasi_separated.affine_property := +by rw [quasi_separated_eq_affine_property_diagonal, quasi_compact_affine_property_diagonal_eq] + +lemma quasi_separated.affine_property_is_local : + quasi_separated.affine_property.is_local := +quasi_compact_affine_property_diagonal_eq ▸ +quasi_compact.affine_property_is_local.diagonal + +@[priority 900] +instance quasi_separated_of_mono {X Y : Scheme} (f : X ⟶ Y) [mono f] : quasi_separated f := +⟨infer_instance⟩ + +lemma quasi_separated_stable_under_composition : + morphism_property.stable_under_composition @quasi_separated := +quasi_separated_eq_diagonal_is_quasi_compact.symm ▸ + quasi_compact_stable_under_composition.diagonal + quasi_compact_respects_iso + quasi_compact_stable_under_base_change + +lemma quasi_separated_stable_under_base_change : + morphism_property.stable_under_base_change @quasi_separated := +quasi_separated_eq_diagonal_is_quasi_compact.symm ▸ + quasi_compact_stable_under_base_change.diagonal + quasi_compact_respects_iso + +instance quasi_separated_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) + [quasi_separated f] [quasi_separated g] : quasi_separated (f ≫ g) := +quasi_separated_stable_under_composition f g infer_instance infer_instance + +lemma quasi_separated_respects_iso : morphism_property.respects_iso @quasi_separated := +quasi_separated_eq_diagonal_is_quasi_compact.symm ▸ + quasi_compact_respects_iso.diagonal + +lemma quasi_separated.affine_open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [quasi_separated f, + ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)], + ∀ (i : 𝒰.J), quasi_separated_space (pullback f (𝒰.map i)).carrier, + ∀ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J), + quasi_separated_space (pullback f (𝒰.map i)).carrier, + ∀ {U : Scheme} (g : U ⟶ Y) [is_affine U] [is_open_immersion g], + quasi_separated_space (pullback f g).carrier, + ∃ (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] + (𝒰' : Π (i : 𝒰.J), Scheme.open_cover.{u} (pullback f (𝒰.map i))) + [∀ i j, is_affine ((𝒰' i).obj j)], by exactI ∀ (i : 𝒰.J) (j k : (𝒰' i).J), + compact_space (pullback ((𝒰' i).map j) ((𝒰' i).map k)).carrier] := +begin + have := quasi_compact.affine_property_is_local.diagonal_affine_open_cover_tfae f, + simp_rw [← quasi_compact_eq_affine_property, + ← quasi_separated_eq_diagonal_is_quasi_compact, + quasi_compact_affine_property_diagonal_eq] at this, + exact this +end + +lemma quasi_separated.is_local_at_target : + property_is_local_at_target @quasi_separated := +quasi_separated_eq_affine_property_diagonal.symm ▸ + quasi_compact.affine_property_is_local.diagonal.target_affine_locally_is_local + +lemma quasi_separated.open_cover_tfae {X Y : Scheme.{u}} (f : X ⟶ Y) : + tfae [quasi_separated f, + ∃ (𝒰 : Scheme.open_cover.{u} Y), ∀ (i : 𝒰.J), + quasi_separated (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (𝒰 : Scheme.open_cover.{u} Y) (i : 𝒰.J), + quasi_separated (pullback.snd : (𝒰.pullback_cover f).obj i ⟶ 𝒰.obj i), + ∀ (U : opens Y.carrier), quasi_separated (f ∣_ U), + ∀ {U : Scheme} (g : U ⟶ Y) [is_open_immersion g], + quasi_separated (pullback.snd : pullback f g ⟶ _), + ∃ {ι : Type u} (U : ι → opens Y.carrier) (hU : supr U = ⊤), + ∀ i, quasi_separated (f ∣_ (U i))] := +quasi_separated.is_local_at_target.open_cover_tfae f + +lemma quasi_separated_over_affine_iff {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] : + quasi_separated f ↔ quasi_separated_space X.carrier := +by rw [quasi_separated_eq_affine_property, + quasi_separated.affine_property_is_local.affine_target_iff f, + quasi_separated.affine_property] + +lemma quasi_separated_space_iff_quasi_separated (X : Scheme) : + quasi_separated_space X.carrier ↔ quasi_separated (terminal.from X) := +(quasi_separated_over_affine_iff _).symm + +lemma quasi_separated.affine_open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y) + [∀ i, is_affine (𝒰.obj i)] (f : X ⟶ Y) : + quasi_separated f ↔ ∀ i, quasi_separated_space (pullback f (𝒰.map i)).carrier := +begin + rw [quasi_separated_eq_affine_property, + quasi_separated.affine_property_is_local.affine_open_cover_iff f 𝒰], + refl, +end + +lemma quasi_separated.open_cover_iff {X Y : Scheme.{u}} (𝒰 : Scheme.open_cover.{u} Y) + (f : X ⟶ Y) : + quasi_separated f ↔ ∀ i, quasi_separated (pullback.snd : pullback f (𝒰.map i) ⟶ _) := +quasi_separated.is_local_at_target.open_cover_iff f 𝒰 + +instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [quasi_separated g] : + quasi_separated (pullback.fst : pullback f g ⟶ X) := +quasi_separated_stable_under_base_change.fst f g infer_instance + +instance {X Y S : Scheme} (f : X ⟶ S) (g : Y ⟶ S) [quasi_separated f] : + quasi_separated (pullback.snd : pullback f g ⟶ Y) := +quasi_separated_stable_under_base_change.snd f g infer_instance + +instance {X Y Z: Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) [quasi_separated f] [quasi_separated g] : + quasi_separated (f ≫ g) := +quasi_separated_stable_under_composition f g infer_instance infer_instance + +lemma quasi_separated_space_of_quasi_separated {X Y : Scheme} (f : X ⟶ Y) + [hY : quasi_separated_space Y.carrier] [quasi_separated f] : quasi_separated_space X.carrier := +begin + rw quasi_separated_space_iff_quasi_separated at hY ⊢, + have : f ≫ terminal.from Y = terminal.from X := terminal_is_terminal.hom_ext _ _, + rw ← this, + resetI, apply_instance +end + +instance quasi_separated_space_of_is_affine (X : Scheme) [is_affine X] : + quasi_separated_space X.carrier := +begin + constructor, + intros U V hU hU' hV hV', + obtain ⟨s, hs, e⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hU', hU⟩, + obtain ⟨s', hs', e'⟩ := (is_compact_open_iff_eq_basic_open_union _).mp ⟨hV', hV⟩, + rw [e, e', set.Union₂_inter], + simp_rw [set.inter_Union₂], + apply hs.is_compact_bUnion, + { intros i hi, + apply hs'.is_compact_bUnion, + intros i' hi', + change is_compact (X.basic_open i ⊓ X.basic_open i').1, + rw ← Scheme.basic_open_mul, + exact ((top_is_affine_open _).basic_open_is_affine _).is_compact } +end + +lemma is_affine_open.is_quasi_separated {X : Scheme} {U : opens X.carrier} (hU : is_affine_open U) : + is_quasi_separated (U : set X.carrier) := +begin + rw is_quasi_separated_iff_quasi_separated_space, + exacts [@@algebraic_geometry.quasi_separated_space_of_is_affine _ hU, U.is_open], +end + +lemma quasi_separated_of_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) + [H : quasi_separated (f ≫ g)] : quasi_separated f := +begin + rw (quasi_separated.affine_open_cover_tfae f).out 0 1, + rw (quasi_separated.affine_open_cover_tfae (f ≫ g)).out 0 2 at H, + use (Z.affine_cover.pullback_cover g).bind (λ x, Scheme.affine_cover _), + split, { intro i, dsimp, apply_instance }, + rintro ⟨i, j⟩, dsimp at *, + specialize H _ i, + refine @@quasi_separated_space_of_quasi_separated _ H _, + { exact pullback.map _ _ _ _ (𝟙 _) _ _ (by simp) (category.comp_id _) ≫ + (pullback_right_pullback_fst_iso g (Z.affine_cover.map i) f).hom }, + { apply algebraic_geometry.quasi_separated_of_mono } +end + +lemma exists_eq_pow_mul_of_is_affine_open (X : Scheme) (U : opens X.carrier) (hU : is_affine_open U) + (f : X.presheaf.obj (op U)) (x : X.presheaf.obj (op $ X.basic_open f)) : + ∃ (n : ℕ) (y : X.presheaf.obj (op U)), + y |_ X.basic_open f = (f |_ X.basic_open f) ^ n * x := +begin + have := (is_localization_basic_open hU f).2, + obtain ⟨⟨y, _, n, rfl⟩, d⟩ := this x, + use [n, y], + delta Top.presheaf.restrict_open Top.presheaf.restrict, + simpa [mul_comm x] using d.symm, +end + +lemma exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux (X : Scheme) + (S : X.affine_opens) (U₁ U₂ : opens X.carrier) + {n₁ n₂ : ℕ} {y₁ : X.presheaf.obj (op U₁)} + {y₂ : X.presheaf.obj (op U₂)} {f : X.presheaf.obj (op $ U₁ ⊔ U₂)} + {x : X.presheaf.obj (op $ X.basic_open f)} + (h₁ : S.1 ≤ U₁) (h₂ : S.1 ≤ U₂) + (e₁ : X.presheaf.map (hom_of_le $ X.basic_open_le + (X.presheaf.map (hom_of_le le_sup_left).op f) : _ ⟶ U₁).op y₁ = + X.presheaf.map (hom_of_le (by { erw X.basic_open_res, exact inf_le_left })).op + (X.presheaf.map (hom_of_le le_sup_left).op f) ^ n₁ * + (X.presheaf.map (hom_of_le (by { erw X.basic_open_res, exact inf_le_right })).op) x) + (e₂ : X.presheaf.map (hom_of_le $ X.basic_open_le + (X.presheaf.map (hom_of_le le_sup_right).op f) : _ ⟶ U₂).op y₂ = + X.presheaf.map (hom_of_le (by { rw X.basic_open_res, exact inf_le_left })).op + (X.presheaf.map (hom_of_le le_sup_right).op f) ^ n₂ * + (X.presheaf.map (hom_of_le (by { rw X.basic_open_res, exact inf_le_right })).op) x) : + ∃ n : ℕ, X.presheaf.map (hom_of_le $ h₁).op + ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (n + n₂) * y₁) = + X.presheaf.map (hom_of_le $ h₂).op + ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (n + n₁) * y₂) := +begin + have := (is_localization_basic_open S.2 + (X.presheaf.map (hom_of_le $ le_trans h₁ le_sup_left).op f)), + obtain ⟨⟨_, n, rfl⟩, e⟩ := + (@is_localization.eq_iff_exists _ _ _ _ _ _ this (X.presheaf.map (hom_of_le $ h₁).op + ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ n₂ * y₁)) + (X.presheaf.map (hom_of_le $ h₂).op + ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ n₁ * y₂))).mp _, + swap, + { simp only [map_pow, ring_hom.algebra_map_to_algebra, map_mul, ← comp_apply, + ← functor.map_comp, ← op_comp, hom_of_le_comp], + have h₃ : X.basic_open ((X.presheaf.map (hom_of_le (h₁.trans le_sup_left)).op) f) ≤ S.val, + { simpa only [X.basic_open_res] using inf_le_left, }, + transitivity + X.presheaf.map (hom_of_le $ h₃.trans $ h₁.trans le_sup_left).op f ^ (n₂ + n₁) * + X.presheaf.map (hom_of_le $ (X.basic_open_res f _).trans_le inf_le_right).op x, + { rw [pow_add, mul_assoc], congr' 1, + convert congr_arg (X.presheaf.map (hom_of_le _).op) e₁, + { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr }, + { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr }, + { rw [X.basic_open_res, X.basic_open_res], rintros x ⟨H₁, H₂⟩, exact ⟨h₁ H₁, H₂⟩ } }, + { rw [add_comm, pow_add, mul_assoc], congr' 1, + convert congr_arg (X.presheaf.map (hom_of_le _).op) e₂.symm, + { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr }, + { simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp], congr }, + { simp only [X.basic_open_res], + rintros x ⟨H₁, H₂⟩, exact ⟨h₂ H₁, H₂⟩ } } }, + use n, + simp only [pow_add, map_pow, map_mul, ← comp_apply, ← mul_assoc, + ← functor.map_comp, subtype.coe_mk] at e ⊢, + exact e +end + +lemma exists_eq_pow_mul_of_is_compact_of_is_quasi_separated (X : Scheme) + (U : opens X.carrier) (hU : is_compact U.1) (hU' : is_quasi_separated U.1) + (f : X.presheaf.obj (op U)) (x : X.presheaf.obj (op $ X.basic_open f)) : + ∃ (n : ℕ) (y : X.presheaf.obj (op U)), y |_ X.basic_open f = (f |_ X.basic_open f) ^ n * x := +begin + delta Top.presheaf.restrict_open Top.presheaf.restrict, + revert hU' f x, + apply compact_open_induction_on U hU, + { intros hU' f x, + use [0, f], + refine @@subsingleton.elim (CommRing.subsingleton_of_is_terminal + (X.sheaf.is_terminal_of_eq_empty _)) _ _, + erw eq_bot_iff, + exact X.basic_open_le f }, + { -- Given `f : 𝒪(S ∪ U), x : 𝒪(X_f)`, we need to show that `f ^ n * x` is the restriction of + -- some `y : 𝒪(S ∪ U)` for some `n : ℕ`. + intros S hS U hU hSU f x, + -- We know that such `y₁, n₁` exists on `S` by the induction hypothesis. + obtain ⟨n₁, y₁, hy₁⟩ := hU (hSU.of_subset $ set.subset_union_left _ _) + (X.presheaf.map (hom_of_le le_sup_left).op f) (X.presheaf.map (hom_of_le _).op x), + swap, { rw X.basic_open_res, exact inf_le_right }, + -- We know that such `y₂, n₂` exists on `U` since `U` is affine. + obtain ⟨n₂, y₂, hy₂⟩ := exists_eq_pow_mul_of_is_affine_open X _ U.2 + (X.presheaf.map (hom_of_le le_sup_right).op f) (X.presheaf.map (hom_of_le _).op x), + delta Top.presheaf.restrict_open Top.presheaf.restrict at hy₂, + swap, { rw X.basic_open_res, exact inf_le_right }, + -- Since `S ∪ U` is quasi-separated, `S ∩ U` can be covered by finite affine opens. + obtain ⟨s, hs', hs⟩ := (is_compact_open_iff_eq_finset_affine_union _).mp + ⟨hSU _ _ (set.subset_union_left _ _) S.2 hS + (set.subset_union_right _ _) U.1.2 U.2.is_compact, (S ⊓ U.1).2⟩, + haveI := hs'.to_subtype, + casesI nonempty_fintype s, + replace hs : S ⊓ U.1 = supr (λ i : s, (i : opens X.carrier)) := by { ext1, simpa using hs }, + have hs₁ : ∀ i : s, i.1.1 ≤ S, + { intro i, change (i : opens X.carrier) ≤ S, + refine le_trans _ inf_le_left, use U.1, erw hs, exact le_supr _ _ }, + have hs₂ : ∀ i : s, i.1.1 ≤ U.1, + { intro i, change (i : opens X.carrier) ≤ U, + refine le_trans _ inf_le_right, use S, erw hs, exact le_supr _ _ }, + -- On each affine open in the intersection, we have `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂` + -- for some `n` since `f ^ n₂ * y₁ = f ^ (n₁ + n₂) * x = f ^ n₁ * y₂` on `X_f`. + have : ∀ i : s, ∃ n : ℕ, + X.presheaf.map (hom_of_le $ hs₁ i).op + ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (n + n₂) * y₁) = + X.presheaf.map (hom_of_le $ hs₂ i).op + ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (n + n₁) * y₂), + { intro i, + exact exists_eq_pow_mul_of_is_compact_of_quasi_separated_space_aux X i.1 S U (hs₁ i) (hs₂ i) + hy₁ hy₂ }, + choose n hn using this, + -- We can thus choose a big enough `n` such that `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂` + -- on `S ∩ U`. + have : X.presheaf.map (hom_of_le $ inf_le_left).op + ((X.presheaf.map (hom_of_le le_sup_left).op f) ^ (finset.univ.sup n + n₂) * y₁) = + X.presheaf.map (hom_of_le $ inf_le_right).op + ((X.presheaf.map (hom_of_le le_sup_right).op f) ^ (finset.univ.sup n + n₁) * y₂), + { fapply X.sheaf.eq_of_locally_eq' (λ i : s, i.1.1), + { refine λ i, hom_of_le _, erw hs, exact le_supr _ _ }, + { exact le_of_eq hs }, + { intro i, + replace hn := congr_arg (λ x, X.presheaf.map (hom_of_le + (le_trans (hs₁ i) le_sup_left)).op f ^ (finset.univ.sup n - n i) * x) (hn i), + dsimp only at hn, + delta Scheme.sheaf SheafedSpace.sheaf, + simp only [← map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, ← mul_assoc] + at hn ⊢, + erw [← map_mul, ← map_mul] at hn, + rw [← pow_add, ← pow_add, ← add_assoc, ← add_assoc, tsub_add_cancel_of_le] at hn, + convert hn, + exact finset.le_sup (finset.mem_univ _) } }, + use finset.univ.sup n + n₁ + n₂, + -- By the sheaf condition, since `f ^ (n + n₂) * y₁ = f ^ (n + n₁) * y₂`, it can be glued into + -- the desired section on `S ∪ U`. + use (X.sheaf.obj_sup_iso_prod_eq_locus S U.1).inv ⟨⟨_ * _, _ * _⟩, this⟩, + refine X.sheaf.eq_of_locally_eq₂ + (hom_of_le (_ : X.basic_open (X.presheaf.map (hom_of_le le_sup_left).op f) ≤ _)) + (hom_of_le (_ : X.basic_open (X.presheaf.map (hom_of_le le_sup_right).op f) ≤ _)) _ _ _ _ _, + { rw X.basic_open_res, exact inf_le_right }, + { rw X.basic_open_res, exact inf_le_right }, + { rw [X.basic_open_res, X.basic_open_res], + erw ← inf_sup_right, + refine le_inf_iff.mpr ⟨X.basic_open_le f, le_of_eq rfl⟩ }, + { convert congr_arg (X.presheaf.map (hom_of_le _).op) + (X.sheaf.obj_sup_iso_prod_eq_locus_inv_fst S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1, + { delta Scheme.sheaf SheafedSpace.sheaf, + simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _), + ← functor.map_comp, ← op_comp], + congr }, + { delta Scheme.sheaf SheafedSpace.sheaf, + simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc, + pow_add], erw hy₁, congr' 1, rw [← mul_assoc, ← mul_assoc], congr' 1, + rw [mul_comm, ← comp_apply, ← functor.map_comp], congr } }, + { convert congr_arg (X.presheaf.map (hom_of_le _).op) + (X.sheaf.obj_sup_iso_prod_eq_locus_inv_snd S U.1 ⟨⟨_ * _, _ * _⟩, this⟩) using 1, + { delta Scheme.sheaf SheafedSpace.sheaf, + simp only [← comp_apply (X.presheaf.map _) (X.presheaf.map _), + ← functor.map_comp, ← op_comp], + congr }, + { delta Scheme.sheaf SheafedSpace.sheaf, + simp only [map_pow, map_mul, ← comp_apply, ← functor.map_comp, ← op_comp, mul_assoc, + pow_add], erw hy₂, rw [← comp_apply, ← functor.map_comp], congr } } } +end + +/-- If `U` is qcqs, then `Γ(X, D(f)) ≃ Γ(X, U)_f` for every `f : Γ(X, U)`. +This is known as the **Qcqs lemma** in [R. Vakil, *The rising sea*][RisingSea]. -/ +lemma is_localization_basic_open_of_qcqs {X : Scheme} {U : opens X.carrier} + (hU : is_compact U.1) (hU' : is_quasi_separated U.1) + (f : X.presheaf.obj (op U)) : + is_localization.away f (X.presheaf.obj (op $ X.basic_open f)) := +begin + constructor, + { rintro ⟨_, n, rfl⟩, + simp only [map_pow, subtype.coe_mk, ring_hom.algebra_map_to_algebra], + exact is_unit.pow _ (RingedSpace.is_unit_res_basic_open _ f), }, + { intro z, + obtain ⟨n, y, e⟩ := exists_eq_pow_mul_of_is_compact_of_is_quasi_separated X U hU hU' f z, + refine ⟨⟨y, _, n, rfl⟩, _⟩, + simpa only [map_pow, subtype.coe_mk, ring_hom.algebra_map_to_algebra, mul_comm z] + using e.symm }, + { intros x y, + rw [← sub_eq_zero, ← map_sub, ring_hom.algebra_map_to_algebra], + simp_rw [← @sub_eq_zero _ _ (_ * x) (_ * y), ← mul_sub], + generalize : x - y = z, + split, + { intro H, + obtain ⟨n, e⟩ := exists_pow_mul_eq_zero_of_res_basic_open_eq_zero_of_is_compact X hU _ _ H, + refine ⟨⟨_, n, rfl⟩, _⟩, + simpa [mul_comm z] using e }, + { rintro ⟨⟨_, n, rfl⟩, e : f ^ n * z = 0⟩, + rw [← ((RingedSpace.is_unit_res_basic_open _ f).pow n).mul_right_inj, mul_zero, ← map_pow, + ← map_mul, e, map_zero] } } +end + +end algebraic_geometry diff --git a/src/algebraic_geometry/morphisms/ring_hom_properties.lean b/src/algebraic_geometry/morphisms/ring_hom_properties.lean new file mode 100644 index 0000000000000..d30f2f44c77ec --- /dev/null +++ b/src/algebraic_geometry/morphisms/ring_hom_properties.lean @@ -0,0 +1,557 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.morphisms.basic +import ring_theory.local_properties + +/-! + +# Properties of morphisms from properties of ring homs. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide the basic framework for talking about properties of morphisms that come from properties +of ring homs. For `P` a property of ring homs, we have two ways of defining a property of scheme +morphisms: + +Let `f : X ⟶ Y`, +- `target_affine_locally (affine_and P)`: the preimage of an affine open `U = Spec A` is affine + (`= Spec B`) and `A ⟶ B` satisfies `P`. (TODO) +- `affine_locally P`: For each pair of affine open `U = Spec A ⊆ X` and `V = Spec B ⊆ f ⁻¹' U`, + the ring hom `A ⟶ B` satisfies `P`. + +For these notions to be well defined, we require `P` be a sufficient local property. For the former, +`P` should be local on the source (`ring_hom.respects_iso P`, `ring_hom.localization_preserves P`, +`ring_hom.of_localization_span`), and `target_affine_locally (affine_and P)` will be local on +the target. (TODO) + +For the latter `P` should be local on the target (`ring_hom.property_is_local P`), and +`affine_locally P` will be local on both the source and the target. + +Further more, these properties are stable under compositions (resp. base change) if `P` is. (TODO) + +-/ + +universe u + +open category_theory opposite topological_space category_theory.limits algebraic_geometry + +variable (P : ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S), Prop) + +namespace ring_hom + +include P + +variable {P} + +lemma respects_iso.basic_open_iff (hP : respects_iso @P) {X Y : Scheme} + [is_affine X] [is_affine Y] (f : X ⟶ Y) (r : Y.presheaf.obj (opposite.op ⊤)) : + P (Scheme.Γ.map (f ∣_ Y.basic_open r).op) ↔ + P (@is_localization.away.map (Y.presheaf.obj (opposite.op ⊤)) _ + (Y.presheaf.obj (opposite.op $ Y.basic_open r)) _ _ + (X.presheaf.obj (opposite.op ⊤)) _ (X.presheaf.obj + (opposite.op $ X.basic_open (Scheme.Γ.map f.op r))) _ _ (Scheme.Γ.map f.op) r _ _) := +begin + rw [Γ_map_morphism_restrict, hP.cancel_left_is_iso, hP.cancel_right_is_iso, + ← (hP.cancel_right_is_iso (f.val.c.app (opposite.op (Y.basic_open r))) (X.presheaf.map + (eq_to_hom (Scheme.preimage_basic_open f r).symm).op)), ← eq_iff_iff], + congr, + delta is_localization.away.map, + refine is_localization.ring_hom_ext (submonoid.powers r) _, + convert (is_localization.map_comp _).symm using 1, + change Y.presheaf.map _ ≫ _ = _ ≫ X.presheaf.map _, + rw f.val.c.naturality_assoc, + erw ← X.presheaf.map_comp, + congr, +end + +lemma respects_iso.basic_open_iff_localization (hP : respects_iso @P) + {X Y : Scheme} [is_affine X] [is_affine Y] (f : X ⟶ Y) (r : Y.presheaf.obj (opposite.op ⊤)) : + P (Scheme.Γ.map (f ∣_ Y.basic_open r).op) ↔ + P (localization.away_map (Scheme.Γ.map f.op) r) := +(hP.basic_open_iff _ _).trans (hP.is_localization_away_iff _ _ _ _).symm + +lemma respects_iso.of_restrict_morphism_restrict_iff (hP : ring_hom.respects_iso @P) + {X Y : Scheme} [is_affine Y] (f : X ⟶ Y) (r : Y.presheaf.obj (opposite.op ⊤)) + (U : opens X.carrier) (hU : is_affine_open U) {V : opens _} + (e : V = (opens.map (X.of_restrict ((opens.map f.1.base).obj _).open_embedding).1.base).obj U) : + P (Scheme.Γ.map ((X.restrict ((opens.map f.1.base).obj _).open_embedding).of_restrict + V.open_embedding ≫ f ∣_ Y.basic_open r).op) ↔ + P (localization.away_map (Scheme.Γ.map (X.of_restrict U.open_embedding ≫ f).op) r) := +begin + subst e, + convert (hP.is_localization_away_iff _ _ _ _).symm, + rotate, + { apply_instance }, + { apply ring_hom.to_algebra, + refine X.presheaf.map + (@hom_of_le _ _ ((is_open_map.functor _).obj _) ((is_open_map.functor _).obj _) _).op, + rw [← set_like.coe_subset_coe], + dsimp, + simp only [set.image_univ, subtype.range_coe, set.image_subset_iff], + refl }, + { exact algebraic_geometry.Γ_restrict_is_localization Y r }, + { rw ← U.open_embedding_obj_top at hU, + dsimp [Scheme.Γ_obj_op, Scheme.Γ_map_op, Scheme.restrict], + apply algebraic_geometry.is_localization_of_eq_basic_open _ hU, + rw [opens.open_embedding_obj_top, opens.functor_obj_map_obj], + convert (X.basic_open_res (Scheme.Γ.map f.op r) (hom_of_le le_top).op).symm using 1, + rw [opens.open_embedding_obj_top, opens.open_embedding_obj_top, inf_comm, + Scheme.Γ_map_op, ← Scheme.preimage_basic_open] }, + { apply is_localization.ring_hom_ext (submonoid.powers r) _, + swap, { exact algebraic_geometry.Γ_restrict_is_localization Y r }, + rw [is_localization.away.map, is_localization.map_comp, ring_hom.algebra_map_to_algebra, + ring_hom.algebra_map_to_algebra, op_comp, functor.map_comp, op_comp, functor.map_comp], + refine (@category.assoc CommRing _ _ _ _ _ _ _ _).symm.trans _, + refine eq.trans _ (@category.assoc CommRing _ _ _ _ _ _ _ _), + dsimp only [Scheme.Γ_map, quiver.hom.unop_op], + rw [morphism_restrict_c_app, category.assoc, category.assoc, category.assoc], + erw [f.1.c.naturality_assoc, ← X.presheaf.map_comp, ← X.presheaf.map_comp, + ← X.presheaf.map_comp], + congr }, +end + +lemma stable_under_base_change.Γ_pullback_fst + (hP : stable_under_base_change @P) (hP' : respects_iso @P) {X Y S : Scheme} + [is_affine X] [is_affine Y] [is_affine S] + (f : X ⟶ S) (g : Y ⟶ S) (H : P (Scheme.Γ.map g.op)) : + P (Scheme.Γ.map (pullback.fst : pullback f g ⟶ _).op) := +begin + rw [← preserves_pullback.iso_inv_fst AffineScheme.forget_to_Scheme + (AffineScheme.of_hom f) (AffineScheme.of_hom g), op_comp, functor.map_comp, + hP'.cancel_right_is_iso, AffineScheme.forget_to_Scheme_map], + have := _root_.congr_arg quiver.hom.unop (preserves_pullback.iso_hom_fst AffineScheme.Γ.right_op + (AffineScheme.of_hom f) (AffineScheme.of_hom g)), + simp only [quiver.hom.unop_op, functor.right_op_map, unop_comp] at this, + delta AffineScheme.Γ at this, + simp only [quiver.hom.unop_op, functor.comp_map, AffineScheme.forget_to_Scheme_map, + functor.op_map] at this, + rw [← this, hP'.cancel_right_is_iso, + ← pushout_iso_unop_pullback_inl_hom (quiver.hom.unop _) (quiver.hom.unop _), + hP'.cancel_right_is_iso], + exact hP.pushout_inl _ hP' _ _ H +end + +end ring_hom + +namespace algebraic_geometry + +/-- For `P` a property of ring homomorphisms, `source_affine_locally P` holds for `f : X ⟶ Y` +whenever `P` holds for the restriction of `f` on every affine open subset of `X`. -/ +def source_affine_locally : affine_target_morphism_property := +λ X Y f hY, ∀ (U : X.affine_opens), P (Scheme.Γ.map (X.of_restrict U.1.open_embedding ≫ f).op) + +/-- For `P` a property of ring homomorphisms, `affine_locally P` holds for `f : X ⟶ Y` if for each +affine open `U = Spec A ⊆ Y` and `V = Spec B ⊆ f ⁻¹' U`, the ring hom `A ⟶ B` satisfies `P`. +Also see `affine_locally_iff_affine_opens_le`. -/ +abbreviation affine_locally : morphism_property Scheme := +target_affine_locally (source_affine_locally @P) + +variable {P} + +lemma source_affine_locally_respects_iso (h₁ : ring_hom.respects_iso @P) : + (source_affine_locally @P).to_property.respects_iso := +begin + apply affine_target_morphism_property.respects_iso_mk, + { introv H U, + rw [← h₁.cancel_right_is_iso _ (Scheme.Γ.map (Scheme.restrict_map_iso e.inv U.1).hom.op), + ← functor.map_comp, ← op_comp], + convert H ⟨_, U.prop.map_is_iso e.inv⟩ using 3, + rw [is_open_immersion.iso_of_range_eq_hom, is_open_immersion.lift_fac_assoc, + category.assoc, e.inv_hom_id_assoc], + refl }, + { introv H U, + rw [← category.assoc, op_comp, functor.map_comp, h₁.cancel_left_is_iso], + exact H U } +end + +lemma affine_locally_respects_iso (h : ring_hom.respects_iso @P) : + (affine_locally @P).respects_iso := +target_affine_locally_respects_iso (source_affine_locally_respects_iso h) + +lemma affine_locally_iff_affine_opens_le + (hP : ring_hom.respects_iso @P) {X Y : Scheme} (f : X ⟶ Y) : + affine_locally @P f ↔ + (∀ (U : Y.affine_opens) (V : X.affine_opens) (e : V.1 ≤ (opens.map f.1.base).obj U.1), + P (f.app_le e)) := +begin + apply forall_congr, + intro U, + delta source_affine_locally, + simp_rw [op_comp, Scheme.Γ.map_comp, Γ_map_morphism_restrict, category.assoc, Scheme.Γ_map_op, + hP.cancel_left_is_iso], + split, + { intros H V e, + let U' := (opens.map f.val.base).obj U.1, + have e' : U'.open_embedding.is_open_map.functor.obj ((opens.map U'.inclusion).obj V.1) = V.1, + { ext1, refine set.image_preimage_eq_inter_range.trans (set.inter_eq_left_iff_subset.mpr _), + convert e, exact subtype.range_coe }, + have := H ⟨(opens.map (X.of_restrict (U'.open_embedding)).1.base).obj V.1, _⟩, + erw ← X.presheaf.map_comp at this, + rw [← hP.cancel_right_is_iso _ (X.presheaf.map (eq_to_hom _)), category.assoc, + ← X.presheaf.map_comp], + convert this using 1, + { dsimp only [functor.op, unop_op], rw opens.open_embedding_obj_top, congr' 1, exact e'.symm }, + { apply_instance }, + { apply (is_affine_open_iff_of_is_open_immersion (X.of_restrict _) _).mp, + convert V.2, + apply_instance } }, + { intros H V, + specialize H ⟨_, V.2.image_is_open_immersion (X.of_restrict _)⟩ (subtype.coe_image_subset _ _), + erw ← X.presheaf.map_comp, + rw [← hP.cancel_right_is_iso _ (X.presheaf.map (eq_to_hom _)), category.assoc, + ← X.presheaf.map_comp], + convert H, + { dsimp only [functor.op, unop_op], rw opens.open_embedding_obj_top, refl }, + { apply_instance } } +end + +lemma Scheme_restrict_basic_open_of_localization_preserves + (h₁ : ring_hom.respects_iso @P) + (h₂ : ring_hom.localization_preserves @P) + {X Y : Scheme} [is_affine Y] (f : X ⟶ Y) (r : Y.presheaf.obj (op ⊤)) + (H : source_affine_locally @P f) + (U : (X.restrict ((opens.map f.1.base).obj $ Y.basic_open r).open_embedding).affine_opens) : + P (Scheme.Γ.map + ((X.restrict ((opens.map f.1.base).obj $ Y.basic_open r).open_embedding).of_restrict + U.1.open_embedding ≫ f ∣_ Y.basic_open r).op) := +begin + specialize H ⟨_, U.2.image_is_open_immersion (X.of_restrict _)⟩, + convert (h₁.of_restrict_morphism_restrict_iff _ _ _ _ _).mpr _ using 1, + swap 5, + { exact h₂.away r H }, + { apply_instance }, + { exact U.2.image_is_open_immersion _}, + { ext1, exact (set.preimage_image_eq _ subtype.coe_injective).symm } +end + +lemma source_affine_locally_is_local + (h₁ : ring_hom.respects_iso @P) + (h₂ : ring_hom.localization_preserves @P) + (h₃ : ring_hom.of_localization_span @P) : (source_affine_locally @P).is_local := +begin + constructor, + { exact source_affine_locally_respects_iso h₁ }, + { introv H U, + apply Scheme_restrict_basic_open_of_localization_preserves h₁ h₂; assumption }, + { introv hs hs' U, + resetI, + apply h₃ _ _ hs, + intro r, + have := hs' r ⟨(opens.map (X.of_restrict _).1.base).obj U.1, _⟩, + rwa h₁.of_restrict_morphism_restrict_iff at this, + { exact U.2 }, + { refl }, + { apply_instance }, + { suffices : ∀ (V = (opens.map f.val.base).obj (Y.basic_open r.val)), + is_affine_open ((opens.map (X.of_restrict V.open_embedding).1.base).obj U.1), + { exact this _ rfl, }, + intros V hV, + rw Scheme.preimage_basic_open at hV, + subst hV, + exact U.2.map_restrict_basic_open (Scheme.Γ.map f.op r.1) } } +end + +variables {P} (hP : ring_hom.property_is_local @P) + +lemma source_affine_locally_of_source_open_cover_aux + (h₁ : ring_hom.respects_iso @P) + (h₃ : ring_hom.of_localization_span_target @P) + {X Y : Scheme} (f : X ⟶ Y) (U : X.affine_opens) + (s : set (X.presheaf.obj (op U.1))) (hs : ideal.span s = ⊤) + (hs' : ∀ (r : s), P (Scheme.Γ.map (X.of_restrict (X.basic_open r.1).open_embedding ≫ f).op)) : + P (Scheme.Γ.map (X.of_restrict U.1.open_embedding ≫ f).op) := +begin + apply_fun ideal.map (X.presheaf.map (eq_to_hom U.1.open_embedding_obj_top).op) at hs, + rw [ideal.map_span, ideal.map_top] at hs, + apply h₃ _ _ hs, + rintro ⟨s, r, hr, hs⟩, + have := (@@localization.alg_equiv _ _ _ _ _ (@@algebraic_geometry.Γ_restrict_is_localization + _ U.2 s)).to_ring_equiv.to_CommRing_iso, + refine (h₁.cancel_right_is_iso _ (@@localization.alg_equiv _ _ _ _ _ + (@@algebraic_geometry.Γ_restrict_is_localization _ U.2 s)) + .to_ring_equiv.to_CommRing_iso.hom).mp _, + subst hs, + rw [CommRing.comp_eq_ring_hom_comp, ← ring_hom.comp_assoc], + erw [is_localization.map_comp, ring_hom.comp_id], + rw [ring_hom.algebra_map_to_algebra, op_comp, functor.map_comp, ← CommRing.comp_eq_ring_hom_comp, + Scheme.Γ_map_op, Scheme.Γ_map_op, Scheme.Γ_map_op, category.assoc], + erw ← X.presheaf.map_comp, + rw [← h₁.cancel_right_is_iso _ (X.presheaf.map (eq_to_hom _))], + convert hs' ⟨r, hr⟩ using 1, + { erw category.assoc, rw [← X.presheaf.map_comp, op_comp, Scheme.Γ.map_comp, + Scheme.Γ_map_op, Scheme.Γ_map_op], congr }, + { dsimp [functor.op], + conv_lhs { rw opens.open_embedding_obj_top }, + conv_rhs { rw opens.open_embedding_obj_top }, + erw Scheme.image_basic_open (X.of_restrict U.1.open_embedding), + erw PresheafedSpace.is_open_immersion.of_restrict_inv_app_apply, + rw Scheme.basic_open_res_eq }, + { apply_instance } +end + +lemma is_open_immersion_comp_of_source_affine_locally (h₁ : ring_hom.respects_iso @P) + {X Y Z : Scheme} [is_affine X] [is_affine Z] (f : X ⟶ Y) [is_open_immersion f] (g : Y ⟶ Z) + (h₂ : source_affine_locally @P g) : + P (Scheme.Γ.map (f ≫ g).op) := +begin + rw [← h₁.cancel_right_is_iso _ (Scheme.Γ.map (is_open_immersion.iso_of_range_eq + (Y.of_restrict _) f _).hom.op), ← functor.map_comp, ← op_comp], + convert h₂ ⟨_, range_is_affine_open_of_open_immersion f⟩ using 3, + { rw [is_open_immersion.iso_of_range_eq_hom, is_open_immersion.lift_fac_assoc] }, + { apply_instance }, + { exact subtype.range_coe }, + { apply_instance } +end + +end algebraic_geometry + +open algebraic_geometry + +namespace ring_hom.property_is_local + +variables {P} (hP : ring_hom.property_is_local @P) + +include hP + +lemma source_affine_locally_of_source_open_cover + {X Y : Scheme} (f : X ⟶ Y) [is_affine Y] + (𝒰 : X.open_cover) [∀ i, is_affine (𝒰.obj i)] (H : ∀ i, P (Scheme.Γ.map (𝒰.map i ≫ f).op)) : + source_affine_locally @P f := +begin + let S := λ i, (⟨⟨set.range (𝒰.map i).1.base, (𝒰.is_open i).base_open.open_range⟩, + range_is_affine_open_of_open_immersion (𝒰.map i)⟩ : X.affine_opens), + intros U, + apply of_affine_open_cover U, + swap 5, { exact set.range S }, + { intros U r H, + convert hP.stable_under_composition _ _ H _ using 1, + swap, + { refine X.presheaf.map + (@hom_of_le _ _ ((is_open_map.functor _).obj _) ((is_open_map.functor _).obj _) _).op, + rw [unop_op, unop_op, opens.open_embedding_obj_top, opens.open_embedding_obj_top], + exact X.basic_open_le _ }, + { rw [op_comp, op_comp, functor.map_comp, functor.map_comp], + refine (eq.trans _ (category.assoc _ _ _).symm : _), + congr' 1, + refine eq.trans _ (X.presheaf.map_comp _ _), + change X.presheaf.map _ = _, + congr }, + convert hP.holds_for_localization_away _ + (X.presheaf.map (eq_to_hom U.1.open_embedding_obj_top).op r), + { exact (ring_hom.algebra_map_to_algebra _).symm }, + { dsimp [Scheme.Γ], + have := U.2, + rw ← U.1.open_embedding_obj_top at this, + convert is_localization_basic_open this _ using 6; + rw opens.open_embedding_obj_top; exact (Scheme.basic_open_res_eq _ _ _).symm } }, + { introv hs hs', + exact source_affine_locally_of_source_open_cover_aux hP.respects_iso hP.2 _ _ _ hs hs' }, + { rw set.eq_univ_iff_forall, + intro x, + rw set.mem_Union, + exact ⟨⟨_, 𝒰.f x, rfl⟩, 𝒰.covers x⟩ }, + { rintro ⟨_, i, rfl⟩, + specialize H i, + rw ← hP.respects_iso.cancel_right_is_iso _ (Scheme.Γ.map (is_open_immersion.iso_of_range_eq + (𝒰.map i) (X.of_restrict (S i).1.open_embedding) subtype.range_coe.symm).inv.op) at H, + rwa [← Scheme.Γ.map_comp, ← op_comp, is_open_immersion.iso_of_range_eq_inv, + is_open_immersion.lift_fac_assoc] at H } +end + +lemma affine_open_cover_tfae {X Y : Scheme.{u}} + [is_affine Y] (f : X ⟶ Y) : + tfae [source_affine_locally @P f, + ∃ (𝒰 : Scheme.open_cover.{u} X) [∀ i, is_affine (𝒰.obj i)], + ∀ (i : 𝒰.J), P (Scheme.Γ.map (𝒰.map i ≫ f).op), + ∀ (𝒰 : Scheme.open_cover.{u} X) [∀ i, is_affine (𝒰.obj i)] (i : 𝒰.J), + P (Scheme.Γ.map (𝒰.map i ≫ f).op), + ∀ {U : Scheme} (g : U ⟶ X) [is_affine U] [is_open_immersion g], + P (Scheme.Γ.map (g ≫ f).op)] := +begin + tfae_have : 1 → 4, + { intros H U g _ hg, + resetI, + specialize H ⟨⟨_, hg.base_open.open_range⟩, + range_is_affine_open_of_open_immersion g⟩, + rw [← hP.respects_iso.cancel_right_is_iso _ (Scheme.Γ.map (is_open_immersion.iso_of_range_eq + g (X.of_restrict (opens.open_embedding ⟨_, hg.base_open.open_range⟩)) + subtype.range_coe.symm).hom.op), ← Scheme.Γ.map_comp, ← op_comp, + is_open_immersion.iso_of_range_eq_hom] at H, + erw is_open_immersion.lift_fac_assoc at H, + exact H }, + tfae_have : 4 → 3, + { intros H 𝒰 _ i, resetI, apply H }, + tfae_have : 3 → 2, + { intro H, refine ⟨X.affine_cover, infer_instance, H _⟩ }, + tfae_have : 2 → 1, + { rintro ⟨𝒰, _, h𝒰⟩, + exactI hP.source_affine_locally_of_source_open_cover f 𝒰 h𝒰 }, + tfae_finish +end + +lemma open_cover_tfae {X Y : Scheme.{u}} [is_affine Y] (f : X ⟶ Y) : + tfae [source_affine_locally @P f, + ∃ (𝒰 : Scheme.open_cover.{u} X), ∀ (i : 𝒰.J), source_affine_locally @P (𝒰.map i ≫ f), + ∀ (𝒰 : Scheme.open_cover.{u} X) (i : 𝒰.J), source_affine_locally @P (𝒰.map i ≫ f), + ∀ {U : Scheme} (g : U ⟶ X) [is_open_immersion g], source_affine_locally @P (g ≫ f)] := +begin + tfae_have : 1 → 4, + { intros H U g hg V, + resetI, + rw (hP.affine_open_cover_tfae f).out 0 3 at H, + haveI : is_affine _ := V.2, + rw ← category.assoc, + apply H }, + tfae_have : 4 → 3, + { intros H 𝒰 _ i, resetI, apply H }, + tfae_have : 3 → 2, + { intro H, refine ⟨X.affine_cover, H _⟩ }, + tfae_have : 2 → 1, + { rintro ⟨𝒰, h𝒰⟩, + rw (hP.affine_open_cover_tfae f).out 0 1, + refine ⟨𝒰.bind (λ _, Scheme.affine_cover _), _, _⟩, + { intro i, dsimp, apply_instance }, + { intro i, + specialize h𝒰 i.1, + rw (hP.affine_open_cover_tfae (𝒰.map i.fst ≫ f)).out 0 3 at h𝒰, + erw category.assoc, + apply @@h𝒰 _ (show _, from _), + dsimp, apply_instance } }, + tfae_finish +end + +lemma source_affine_locally_comp_of_is_open_immersion + {X Y Z : Scheme.{u}} [is_affine Z] (f : X ⟶ Y) (g : Y ⟶ Z) [is_open_immersion f] + (H : source_affine_locally @P g) : source_affine_locally @P (f ≫ g) := +by apply ((hP.open_cover_tfae g).out 0 3).mp H + +lemma source_affine_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + [is_affine Y] (𝒰 : Scheme.open_cover.{u} X) [∀ i, is_affine (𝒰.obj i)] : + source_affine_locally @P f ↔ (∀ i, P (Scheme.Γ.map (𝒰.map i ≫ f).op)) := +⟨λ H, let h := ((hP.affine_open_cover_tfae f).out 0 2).mp H in h 𝒰, + λ H, let h := ((hP.affine_open_cover_tfae f).out 1 0).mp in h ⟨𝒰, infer_instance, H⟩⟩ + +lemma is_local_source_affine_locally : + (source_affine_locally @P).is_local := +source_affine_locally_is_local hP.respects_iso hP.localization_preserves + (@ring_hom.property_is_local.of_localization_span _ hP) + +lemma is_local_affine_locally : + property_is_local_at_target (affine_locally @P) := +hP.is_local_source_affine_locally.target_affine_locally_is_local + +lemma affine_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} Y) [∀ i, is_affine (𝒰.obj i)] + (𝒰' : ∀ i, Scheme.open_cover.{u} ((𝒰.pullback_cover f).obj i)) [∀ i j, is_affine ((𝒰' i).obj j)] : + affine_locally @P f ↔ + (∀ i j, P (Scheme.Γ.map ((𝒰' i).map j ≫ pullback.snd).op)) := +(hP.is_local_source_affine_locally.affine_open_cover_iff f 𝒰).trans + (forall_congr (λ i, hP.source_affine_open_cover_iff _ (𝒰' i))) + +lemma source_open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} X) : + affine_locally @P f ↔ ∀ i, affine_locally @P (𝒰.map i ≫ f) := +begin + split, + { intros H i U, + rw morphism_restrict_comp, + delta morphism_restrict, + apply hP.source_affine_locally_comp_of_is_open_immersion, + apply H }, + { intros H U, + haveI : is_affine _ := U.2, + apply ((hP.open_cover_tfae (f ∣_ U.1)).out 1 0).mp, + use 𝒰.pullback_cover (X.of_restrict _), + intro i, + specialize H i U, + rw morphism_restrict_comp at H, + delta morphism_restrict at H, + have := source_affine_locally_respects_iso hP.respects_iso, + rw [category.assoc, affine_cancel_left_is_iso this, ← affine_cancel_left_is_iso + this (pullback_symmetry _ _).hom, pullback_symmetry_hom_comp_snd_assoc] at H, + exact H } +end + +lemma affine_locally_of_is_open_immersion (hP : ring_hom.property_is_local @P) {X Y : Scheme} + (f : X ⟶ Y) [hf : is_open_immersion f] : affine_locally @P f := +begin + intro U, + haveI H : is_affine _ := U.2, + rw ← category.comp_id (f ∣_ U), + apply hP.source_affine_locally_comp_of_is_open_immersion, + rw hP.source_affine_open_cover_iff _ (Scheme.open_cover_of_is_iso (𝟙 _)), + { intro i, erw [category.id_comp, op_id, Scheme.Γ.map_id], + convert hP.holds_for_localization_away _ (1 : Scheme.Γ.obj _), + { exact (ring_hom.algebra_map_to_algebra _).symm }, + { apply_instance }, + { refine is_localization.away_of_is_unit_of_bijective _ is_unit_one function.bijective_id } }, + { intro i, exact H } +end + +lemma affine_locally_of_comp + (H : ∀ {R S T : Type.{u}} [comm_ring R] [comm_ring S] [comm_ring T], by exactI + ∀ (f : R →+* S) (g : S →+* T), P (g.comp f) → P g) + {X Y Z : Scheme} {f : X ⟶ Y} {g : Y ⟶ Z} (h : affine_locally @P (f ≫ g)) : + affine_locally @P f := +begin + let 𝒰 : ∀ i, ((Z.affine_cover.pullback_cover (f ≫ g)).obj i).open_cover, + { intro i, + refine Scheme.open_cover.bind _ (λ i, Scheme.affine_cover _), + apply Scheme.open_cover.pushforward_iso _ + (pullback_right_pullback_fst_iso g (Z.affine_cover.map i) f).hom, + apply Scheme.pullback.open_cover_of_right, + exact (pullback g (Z.affine_cover.map i)).affine_cover }, + haveI h𝒰 : ∀ i j, is_affine ((𝒰 i).obj j), by { dsimp, apply_instance }, + let 𝒰' := (Z.affine_cover.pullback_cover g).bind (λ i, Scheme.affine_cover _), + haveI h𝒰' : ∀ i, is_affine (𝒰'.obj i), by { dsimp, apply_instance }, + rw hP.affine_open_cover_iff f 𝒰' (λ i, Scheme.affine_cover _), + rw hP.affine_open_cover_iff (f ≫ g) Z.affine_cover 𝒰 at h, + rintros ⟨i, j⟩ k, + dsimp at i j k, + specialize h i ⟨j, k⟩, + dsimp only [Scheme.open_cover.bind_map, Scheme.open_cover.pushforward_iso_obj, + Scheme.pullback.open_cover_of_right_obj, Scheme.open_cover.pushforward_iso_map, + Scheme.pullback.open_cover_of_right_map, Scheme.open_cover.bind_obj, + Scheme.open_cover.pullback_cover_obj, Scheme.open_cover.pullback_cover_map] at h ⊢, + rw [category.assoc, category.assoc, pullback_right_pullback_fst_iso_hom_snd, + pullback.lift_snd_assoc, category.assoc, ← category.assoc, op_comp, functor.map_comp] at h, + exact H _ _ h, +end + +lemma affine_locally_stable_under_composition : + (affine_locally @P).stable_under_composition := +begin + intros X Y S f g hf hg, + let 𝒰 : ∀ i, ((S.affine_cover.pullback_cover (f ≫ g)).obj i).open_cover, + { intro i, + refine Scheme.open_cover.bind _ (λ i, Scheme.affine_cover _), + apply Scheme.open_cover.pushforward_iso _ + (pullback_right_pullback_fst_iso g (S.affine_cover.map i) f).hom, + apply Scheme.pullback.open_cover_of_right, + exact (pullback g (S.affine_cover.map i)).affine_cover }, + rw hP.affine_open_cover_iff (f ≫ g) S.affine_cover _, + rotate, + { exact 𝒰 }, + { intros i j, dsimp at *, apply_instance }, + { rintros i ⟨j, k⟩, + dsimp at i j k, + dsimp only [Scheme.open_cover.bind_map, Scheme.open_cover.pushforward_iso_obj, + Scheme.pullback.open_cover_of_right_obj, Scheme.open_cover.pushforward_iso_map, + Scheme.pullback.open_cover_of_right_map, Scheme.open_cover.bind_obj], + rw [category.assoc, category.assoc, pullback_right_pullback_fst_iso_hom_snd, + pullback.lift_snd_assoc, category.assoc, ← category.assoc, op_comp, functor.map_comp], + apply hP.stable_under_composition, + { exact (hP.affine_open_cover_iff _ _ _).mp hg _ _ }, + { delta affine_locally at hf, + rw (hP.is_local_source_affine_locally.affine_open_cover_tfae f).out 0 3 at hf, + specialize hf ((pullback g (S.affine_cover.map i)).affine_cover.map j ≫ pullback.fst), + rw (hP.affine_open_cover_tfae (pullback.snd : pullback f ((pullback g (S.affine_cover.map i)) + .affine_cover.map j ≫ pullback.fst) ⟶ _)).out 0 3 at hf, + apply hf } } +end + +end ring_hom.property_is_local diff --git a/src/algebraic_geometry/morphisms/universally_closed.lean b/src/algebraic_geometry/morphisms/universally_closed.lean new file mode 100644 index 0000000000000..1d53bcffeb4ca --- /dev/null +++ b/src/algebraic_geometry/morphisms/universally_closed.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.morphisms.basic +import topology.local_at_target + +/-! +# Universally closed morphism + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A morphism of schemes `f : X ⟶ Y` is universally closed if `X ×[Y] Y' ⟶ Y'` is a closed map +for all base change `Y' ⟶ Y`. + +We show that being universally closed is local at the target, and is stable under compositions and +base changes. + +-/ + +noncomputable theory + +open category_theory category_theory.limits opposite topological_space + +universes v u + +namespace algebraic_geometry + +variables {X Y : Scheme.{u}} (f : X ⟶ Y) + +open category_theory.morphism_property +open algebraic_geometry.morphism_property (topologically) + +/-- +A morphism of schemes `f : X ⟶ Y` is universally closed if the base change `X ×[Y] Y' ⟶ Y'` +along any morphism `Y' ⟶ Y` is (topologically) a closed map. +-/ +@[mk_iff] +class universally_closed (f : X ⟶ Y) : Prop := +(out : universally (topologically @is_closed_map) f) + +lemma universally_closed_eq : + @universally_closed = universally (topologically @is_closed_map) := +begin + ext X Y f, rw universally_closed_iff +end + +lemma universally_closed_respects_iso : + respects_iso @universally_closed := +universally_closed_eq.symm ▸ universally_respects_iso (topologically @is_closed_map) + +lemma universally_closed_stable_under_base_change : + stable_under_base_change @universally_closed := +universally_closed_eq.symm ▸ universally_stable_under_base_change (topologically @is_closed_map) + +lemma universally_closed_stable_under_composition : + stable_under_composition @universally_closed := +begin + rw universally_closed_eq, + exact stable_under_composition.universally (λ X Y Z f g hf hg, is_closed_map.comp hg hf), +end + +instance universally_closed_type_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) + [hf : universally_closed f] [hg : universally_closed g] : + universally_closed (f ≫ g) := +universally_closed_stable_under_composition f g hf hg + +instance universally_closed_fst {X Y Z : Scheme} (f : X ⟶ Z) (g : Y ⟶ Z) + [hg : universally_closed g] : + universally_closed (pullback.fst : pullback f g ⟶ _) := +universally_closed_stable_under_base_change.fst f g hg + +instance universally_closed_snd {X Y Z : Scheme} (f : X ⟶ Z) (g : Y ⟶ Z) + [hf : universally_closed f] : + universally_closed (pullback.snd : pullback f g ⟶ _) := +universally_closed_stable_under_base_change.snd f g hf + +lemma morphism_restrict_base {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + ⇑(f ∣_ U).1.base = U.1.restrict_preimage f.1 := +funext (λ x, subtype.ext $ morphism_restrict_base_coe f U x) + +lemma universally_closed_is_local_at_target : + property_is_local_at_target @universally_closed := +begin + rw universally_closed_eq, + apply universally_is_local_at_target_of_morphism_restrict, + { exact stable_under_composition.respects_iso (λ X Y Z f g hf hg, is_closed_map.comp hg hf) + (λ X Y f, (Top.homeo_of_iso (Scheme.forget_to_Top.map_iso f)).is_closed_map) }, + { intros X Y f ι U hU H, + simp_rw [topologically, morphism_restrict_base] at H, + exact (is_closed_map_iff_is_closed_map_of_supr_eq_top hU).mpr H } +end + +lemma universally_closed.open_cover_iff {X Y : Scheme.{u}} (f : X ⟶ Y) + (𝒰 : Scheme.open_cover.{u} Y) : + universally_closed f ↔ + (∀ i, universally_closed (pullback.snd : pullback f (𝒰.map i) ⟶ _)) := +universally_closed_is_local_at_target.open_cover_iff f 𝒰 + +end algebraic_geometry diff --git a/src/algebraic_geometry/open_immersion.lean b/src/algebraic_geometry/open_immersion.lean deleted file mode 100644 index 3c82312777987..0000000000000 --- a/src/algebraic_geometry/open_immersion.lean +++ /dev/null @@ -1,1549 +0,0 @@ -/- -Copyright (c) 2021 Andrew Yang. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Andrew Yang --/ -import algebraic_geometry.presheafed_space.has_colimits -import category_theory.limits.shapes.binary_products -import category_theory.limits.preserves.shapes.pullbacks -import topology.sheaves.functors -import algebraic_geometry.Scheme -import category_theory.limits.shapes.strict_initial -import algebra.category.Ring.instances - -/-! -# Open immersions of structured spaces - -We say that a morphism of presheafed spaces `f : X ⟶ Y` is an open immersions if -the underlying map of spaces is an open embedding `f : X ⟶ U ⊆ Y`, -and the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`. - -Abbreviations are also provided for `SheafedSpace`, `LocallyRingedSpace` and `Scheme`. - -## Main definitions - -* `algebraic_geometry.PresheafedSpace.is_open_immersion`: the `Prop`-valued typeclass asserting - that a PresheafedSpace hom `f` is an open_immersion. -* `algebraic_geometry.is_open_immersion`: the `Prop`-valued typeclass asserting - that a Scheme morphism `f` is an open_immersion. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.iso_restrict`: The source of an - open immersion is isomorphic to the restriction of the target onto the image. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.lift`: Any morphism whose range is - contained in an open immersion factors though the open immersion. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_SheafedSpace`: If `f : X ⟶ Y` is an - open immersion of presheafed spaces, and `Y` is a sheafed space, then `X` is also a sheafed - space. The morphism as morphisms of sheafed spaces is given by `to_SheafedSpace_hom`. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_LocallyRingedSpace`: If `f : X ⟶ Y` is - an open immersion of presheafed spaces, and `Y` is a locally ringed space, then `X` is also a - locally ringed space. The morphism as morphisms of locally ringed spaces is given by - `to_LocallyRingedSpace_hom`. - -## Main results - -* `algebraic_geometry.PresheafedSpace.is_open_immersion.comp`: The composition of two open - immersions is an open immersion. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.of_iso`: An iso is an open immersion. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_iso`: - A surjective open immersion is an isomorphism. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.stalk_iso`: An open immersion induces - an isomorphism on stalks. -* `algebraic_geometry.PresheafedSpace.is_open_immersion.has_pullback_of_left`: If `f` is an open - immersion, then the pullback `(f, g)` exists (and the forgetful functor to `Top` preserves it). -* `algebraic_geometry.PresheafedSpace.is_open_immersion.pullback_snd_of_left`: Open immersions - are stable under pullbacks. -* `algebraic_geometry.SheafedSpace.is_open_immersion.of_stalk_iso` An (topological) open embedding - between two sheafed spaces is an open immersion if all the stalk maps are isomorphisms. - --/ - -open topological_space category_theory opposite -open category_theory.limits -namespace algebraic_geometry - -universes v u - -variables {C : Type u} [category.{v} C] - -/-- -An open immersion of PresheafedSpaces is an open embedding `f : X ⟶ U ⊆ Y` of the underlying -spaces, such that the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`. --/ -class PresheafedSpace.is_open_immersion {X Y : PresheafedSpace C} (f : X ⟶ Y) : Prop := -(base_open : open_embedding f.base) -(c_iso : ∀ U : opens X, is_iso (f.c.app (op (base_open.is_open_map.functor.obj U)))) - -/-- -A morphism of SheafedSpaces is an open immersion if it is an open immersion as a morphism -of PresheafedSpaces --/ -abbreviation SheafedSpace.is_open_immersion - [has_products C] {X Y : SheafedSpace C} (f : X ⟶ Y) : Prop := -PresheafedSpace.is_open_immersion f - -/-- -A morphism of LocallyRingedSpaces is an open immersion if it is an open immersion as a morphism -of SheafedSpaces --/ -abbreviation LocallyRingedSpace.is_open_immersion {X Y : LocallyRingedSpace} (f : X ⟶ Y) : Prop := -SheafedSpace.is_open_immersion f.1 - -/-- -A morphism of Schemes is an open immersion if it is an open immersion as a morphism -of LocallyRingedSpaces --/ -abbreviation is_open_immersion {X Y : Scheme} (f : X ⟶ Y) : Prop := -LocallyRingedSpace.is_open_immersion f - -namespace PresheafedSpace.is_open_immersion - -open PresheafedSpace - -local notation `is_open_immersion` := PresheafedSpace.is_open_immersion - -attribute [instance] is_open_immersion.c_iso - -section - -variables {X Y : PresheafedSpace C} {f : X ⟶ Y} (H : is_open_immersion f) - -/-- The functor `opens X ⥤ opens Y` associated with an open immersion `f : X ⟶ Y`. -/ -abbreviation open_functor := H.base_open.is_open_map.functor - -/- -We want to keep `eq_to_hom`s in the form of `F.map (eq_to_hom _)` so that the lemmas about -naturality can be applied. --/ -local attribute [-simp] eq_to_hom_map eq_to_iso_map - -/-- An open immersion `f : X ⟶ Y` induces an isomorphism `X ≅ Y|_{f(X)}`. -/ -@[simps] noncomputable -def iso_restrict : X ≅ Y.restrict H.base_open := -PresheafedSpace.iso_of_components (iso.refl _) -begin - symmetry, - fapply nat_iso.of_components, - intro U, - refine as_iso (f.c.app (op (H.open_functor.obj (unop U)))) ≪≫ X.presheaf.map_iso (eq_to_iso _), - { induction U using opposite.rec, - cases U, - dsimp only [is_open_map.functor, functor.op, opens.map], - congr' 2, - erw set.preimage_image_eq _ H.base_open.inj, - refl }, - { intros U V i, - simp only [category_theory.eq_to_iso.hom, Top.presheaf.pushforward_obj_map, category.assoc, - functor.op_map, iso.trans_hom, as_iso_hom, functor.map_iso_hom, ←X.presheaf.map_comp], - erw [f.c.naturality_assoc, ←X.presheaf.map_comp], - congr } -end - -@[simp] lemma iso_restrict_hom_of_restrict : H.iso_restrict.hom ≫ Y.of_restrict _ = f := -begin - ext, - { simp only [comp_c_app, iso_restrict_hom_c_app, nat_trans.comp_app, - eq_to_hom_refl, of_restrict_c_app, category.assoc, whisker_right_id'], - erw [category.comp_id, f.c.naturality_assoc, ←X.presheaf.map_comp], - transitivity f.c.app x ≫ X.presheaf.map (𝟙 _), - { congr }, - { erw [X.presheaf.map_id, category.comp_id] } }, - { simp } -end - -@[simp] lemma iso_restrict_inv_of_restrict : H.iso_restrict.inv ≫ f = Y.of_restrict _ := -by { rw iso.inv_comp_eq, simp } - -instance mono [H : is_open_immersion f] : mono f := -by { rw ← H.iso_restrict_hom_of_restrict, apply mono_comp } - -/-- The composition of two open immersions is an open immersion. -/ -instance comp {Z : PresheafedSpace C} (f : X ⟶ Y) [hf : is_open_immersion f] (g : Y ⟶ Z) - [hg : is_open_immersion g] : - is_open_immersion (f ≫ g) := -{ base_open := hg.base_open.comp hf.base_open, - c_iso := λ U, - begin - generalize_proofs h, - dsimp only [algebraic_geometry.PresheafedSpace.comp_c_app, unop_op, functor.op, comp_base, - Top.presheaf.pushforward_obj_obj, opens.map_comp_obj], - apply_with is_iso.comp_is_iso { instances := ff }, - swap, - { have : (opens.map g.base).obj (h.functor.obj U) = hf.open_functor.obj U, - { dsimp only [opens.map, is_open_map.functor, PresheafedSpace.comp_base], - congr' 1, - rw [coe_comp, ←set.image_image, set.preimage_image_eq _ hg.base_open.inj] }, - rw this, - apply_instance }, - { have : h.functor.obj U = hg.open_functor.obj (hf.open_functor.obj U), - { dsimp only [is_open_map.functor], - congr' 1, - rw [comp_base, coe_comp, ←set.image_image], - congr }, - rw this, - apply_instance } - end } - -/-- For an open immersion `f : X ⟶ Y` and an open set `U ⊆ X`, we have the map `X(U) ⟶ Y(U)`. -/ -noncomputable -def inv_app (U : opens X) : X.presheaf.obj (op U) ⟶ Y.presheaf.obj (op (H.open_functor.obj U)) := -X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) ≫ - inv (f.c.app (op (H.open_functor.obj U))) - -@[simp, reassoc] lemma inv_naturality {U V : (opens X)ᵒᵖ} (i : U ⟶ V) : - X.presheaf.map i ≫ H.inv_app (unop V) = H.inv_app (unop U) ≫ - Y.presheaf.map (H.open_functor.op.map i) := -begin - simp only [inv_app, ←category.assoc], - rw [is_iso.comp_inv_eq], - simp only [category.assoc, f.c.naturality, is_iso.inv_hom_id_assoc, ← X.presheaf.map_comp], - erw ← X.presheaf.map_comp, - congr -end - -instance (U : opens X) : is_iso (H.inv_app U) := by { delta inv_app, apply_instance } - -lemma inv_inv_app (U : opens X) : - inv (H.inv_app U) = f.c.app (op (H.open_functor.obj U)) ≫ - X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) := -begin - rw ← cancel_epi (H.inv_app U), - rw is_iso.hom_inv_id, - delta inv_app, - simp [← functor.map_comp] -end - -@[simp, reassoc] lemma inv_app_app (U : opens X) : - H.inv_app U ≫ f.c.app (op (H.open_functor.obj U)) = - X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) := -by rw [inv_app, category.assoc, is_iso.inv_hom_id, category.comp_id] - -@[simp, reassoc] lemma app_inv_app (U : opens Y) : - f.c.app (op U) ≫ H.inv_app ((opens.map f.base).obj U) = - Y.presheaf.map ((hom_of_le (by exact set.image_preimage_subset f.base U)).op : - op U ⟶ op (H.open_functor.obj ((opens.map f.base).obj U))) := -by { erw ← category.assoc, rw [is_iso.comp_inv_eq, f.c.naturality], congr } - -/-- A variant of `app_inv_app` that gives an `eq_to_hom` instead of `hom_of_le`. -/ -@[reassoc] lemma app_inv_app' (U : opens Y) (hU : (U : set Y) ⊆ set.range f.base) : - f.c.app (op U) ≫ H.inv_app ((opens.map f.base).obj U) = - Y.presheaf.map (eq_to_hom (by - { apply has_le.le.antisymm, - { exact set.image_preimage_subset f.base U.1 }, - { change U ⊆ _, - refine has_le.le.trans_eq _ (@set.image_preimage_eq_inter_range _ _ f.base U.1).symm, - exact set.subset_inter_iff.mpr ⟨λ _ h, h, hU⟩ } })).op := -by { erw ← category.assoc, rw [is_iso.comp_inv_eq, f.c.naturality], congr } - -/-- An isomorphism is an open immersion. -/ -instance of_iso {X Y : PresheafedSpace C} (H : X ≅ Y) : is_open_immersion H.hom := -{ base_open := (Top.homeo_of_iso ((forget C).map_iso H)).open_embedding, - c_iso := λ _, infer_instance } - -@[priority 100] -instance of_is_iso {X Y : PresheafedSpace C} (f : X ⟶ Y) [is_iso f] : is_open_immersion f := -algebraic_geometry.PresheafedSpace.is_open_immersion.of_iso (as_iso f) - -instance of_restrict {X : Top} (Y : PresheafedSpace C) {f : X ⟶ Y.carrier} - (hf : open_embedding f) : is_open_immersion (Y.of_restrict hf) := -{ base_open := hf, - c_iso := λ U, - begin - dsimp, - have : (opens.map f).obj (hf.is_open_map.functor.obj U) = U, - { cases U, - dsimp only [opens.map, is_open_map.functor], - congr' 1, - rw set.preimage_image_eq _ hf.inj, - refl }, - convert (show is_iso (Y.presheaf.map (𝟙 _)), from infer_instance), - { apply subsingleton.helim, - rw this }, - { rw Y.presheaf.map_id, - apply_instance } - end } - -/-- An open immersion is an iso if the underlying continuous map is epi. -/ -lemma to_iso (f : X ⟶ Y) [h : is_open_immersion f] [h' : epi f.base] : is_iso f := -begin - apply_with is_iso_of_components { instances := ff }, - { let : X ≃ₜ Y := (homeomorph.of_embedding _ h.base_open.to_embedding).trans - { to_fun := subtype.val, inv_fun := λ x, ⟨x, - by { rw set.range_iff_surjective.mpr ((Top.epi_iff_surjective _).mp h'), trivial }⟩, - left_inv := λ ⟨_,_⟩, rfl, right_inv := λ _, rfl }, - convert is_iso.of_iso (Top.iso_of_homeo this), - { ext, refl } }, - { apply_with nat_iso.is_iso_of_is_iso_app { instances := ff }, - intro U, - have : U = op (h.open_functor.obj ((opens.map f.base).obj (unop U))), - { induction U using opposite.rec, - cases U, - dsimp only [functor.op, opens.map], - congr, - exact (set.image_preimage_eq _ ((Top.epi_iff_surjective _).mp h')).symm }, - convert @@is_open_immersion.c_iso _ h ((opens.map f.base).obj (unop U)) } -end - -instance stalk_iso [has_colimits C] [H : is_open_immersion f] (x : X) : is_iso (stalk_map f x) := -begin - rw ← H.iso_restrict_hom_of_restrict, - rw PresheafedSpace.stalk_map.comp, - apply_instance -end - -end - -section pullback - -noncomputable theory - -variables {X Y Z : PresheafedSpace C} (f : X ⟶ Z) [hf : is_open_immersion f] (g : Y ⟶ Z) - -include hf - -/-- - (Implementation.) The projection map when constructing the pullback along an open immersion. --/ -def pullback_cone_of_left_fst : - Y.restrict (Top.snd_open_embedding_of_left_open_embedding hf.base_open g.base) ⟶ X := -{ base := pullback.fst, - c := - { app := λ U, hf.inv_app (unop U) ≫ - g.c.app (op (hf.base_open.is_open_map.functor.obj (unop U))) ≫ - Y.presheaf.map (eq_to_hom - (begin - simp only [is_open_map.functor, subtype.mk_eq_mk, unop_op, op_inj_iff, opens.map, - subtype.coe_mk, functor.op_obj, subtype.val_eq_coe], - apply has_le.le.antisymm, - { rintros _ ⟨_, h₁, h₂⟩, - use (Top.pullback_iso_prod_subtype _ _).inv ⟨⟨_, _⟩, h₂⟩, - simpa using h₁ }, - { rintros _ ⟨x, h₁, rfl⟩, - exact ⟨_, h₁, concrete_category.congr_hom pullback.condition x⟩ } - end)), - naturality' := - begin - intros U V i, - induction U using opposite.rec, - induction V using opposite.rec, - simp only [quiver.hom.unop_op, Top.presheaf.pushforward_obj_map, category.assoc, - nat_trans.naturality_assoc, functor.op_map, inv_naturality_assoc, ← Y.presheaf.map_comp], - erw ← Y.presheaf.map_comp, - congr - end } } - -lemma pullback_cone_of_left_condition : - pullback_cone_of_left_fst f g ≫ f = Y.of_restrict _ ≫ g := -begin - ext U, - { induction U using opposite.rec, - dsimp only [comp_c_app, nat_trans.comp_app, unop_op, - whisker_right_app, pullback_cone_of_left_fst], - simp only [quiver.hom.unop_op, Top.presheaf.pushforward_obj_map, app_inv_app_assoc, - eq_to_hom_app, eq_to_hom_unop, category.assoc, nat_trans.naturality_assoc, functor.op_map], - erw [← Y.presheaf.map_comp, ← Y.presheaf.map_comp], - congr }, - { simpa using pullback.condition } -end - -/-- -We construct the pullback along an open immersion via restricting along the pullback of the -maps of underlying spaces (which is also an open embedding). --/ -def pullback_cone_of_left : pullback_cone f g := -pullback_cone.mk (pullback_cone_of_left_fst f g) (Y.of_restrict _) - (pullback_cone_of_left_condition f g) - -variable (s : pullback_cone f g) - -/-- - (Implementation.) Any cone over `cospan f g` indeed factors through the constructed cone. --/ -def pullback_cone_of_left_lift : s.X ⟶ (pullback_cone_of_left f g).X := -{ base := pullback.lift s.fst.base s.snd.base - (congr_arg (λ x, PresheafedSpace.hom.base x) s.condition), - c := - { app := λ U, s.snd.c.app _ ≫ s.X.presheaf.map (eq_to_hom (begin - dsimp only [opens.map, is_open_map.functor, functor.op], - congr' 2, - let s' : pullback_cone f.base g.base := pullback_cone.mk s.fst.base s.snd.base _, - have : _ = s.snd.base := limit.lift_π s' walking_cospan.right, - conv_lhs { erw ← this, rw coe_comp, erw ← set.preimage_preimage }, - erw set.preimage_image_eq _ - (Top.snd_open_embedding_of_left_open_embedding hf.base_open g.base).inj, - simp, - end)), - naturality' := λ U V i, - begin - erw s.snd.c.naturality_assoc, - rw category.assoc, - erw [← s.X.presheaf.map_comp, ← s.X.presheaf.map_comp], - congr - end } } - --- this lemma is not a `simp` lemma, because it is an implementation detail -lemma pullback_cone_of_left_lift_fst : - pullback_cone_of_left_lift f g s ≫ (pullback_cone_of_left f g).fst = s.fst := -begin - ext x, - { induction x using opposite.rec, - change ((_ ≫ _) ≫ _ ≫ _) ≫ _ = _, - simp_rw [category.assoc], - erw ← s.X.presheaf.map_comp, - erw s.snd.c.naturality_assoc, - have := congr_app s.condition (op (hf.open_functor.obj x)), - dsimp only [comp_c_app, unop_op] at this, - rw ← is_iso.comp_inv_eq at this, - reassoc! this, - erw [← this, hf.inv_app_app_assoc, s.fst.c.naturality_assoc], - simpa }, - { change pullback.lift _ _ _ ≫ pullback.fst = _, - simp } -end - --- this lemma is not a `simp` lemma, because it is an implementation detail -lemma pullback_cone_of_left_lift_snd : - pullback_cone_of_left_lift f g s ≫ (pullback_cone_of_left f g).snd = s.snd := -begin - ext x, - { change (_ ≫ _ ≫ _) ≫ _ = _, - simp_rw category.assoc, - erw s.snd.c.naturality_assoc, - erw [← s.X.presheaf.map_comp, ← s.X.presheaf.map_comp], - transitivity s.snd.c.app x ≫ s.X.presheaf.map (𝟙 _), - { congr }, - { rw s.X.presheaf.map_id, erw category.comp_id } }, - { change pullback.lift _ _ _ ≫ pullback.snd = _, - simp } -end - -instance pullback_cone_snd_is_open_immersion : - is_open_immersion (pullback_cone_of_left f g).snd := -begin - erw category_theory.limits.pullback_cone.mk_snd, - apply_instance -end - -/-- The constructed pullback cone is indeed the pullback. -/ -def pullback_cone_of_left_is_limit : - is_limit (pullback_cone_of_left f g) := -begin - apply pullback_cone.is_limit_aux', - intro s, - use pullback_cone_of_left_lift f g s, - use pullback_cone_of_left_lift_fst f g s, - use pullback_cone_of_left_lift_snd f g s, - intros m h₁ h₂, - rw ← cancel_mono (pullback_cone_of_left f g).snd, - exact (h₂.trans (pullback_cone_of_left_lift_snd f g s).symm) -end - -instance has_pullback_of_left : - has_pullback f g := -⟨⟨⟨_, pullback_cone_of_left_is_limit f g⟩⟩⟩ - -instance has_pullback_of_right : - has_pullback g f := has_pullback_symmetry f g - -/-- Open immersions are stable under base-change. -/ -instance pullback_snd_of_left : - is_open_immersion (pullback.snd : pullback f g ⟶ _) := -begin - delta pullback.snd, - rw ← limit.iso_limit_cone_hom_π ⟨_, pullback_cone_of_left_is_limit f g⟩ walking_cospan.right, - apply_instance -end - -/-- Open immersions are stable under base-change. -/ -instance pullback_fst_of_right : - is_open_immersion (pullback.fst : pullback g f ⟶ _) := -begin - rw ← pullback_symmetry_hom_comp_snd, - apply_instance -end - -instance pullback_one_is_open_immersion [is_open_immersion g] : - is_open_immersion (limit.π (cospan f g) walking_cospan.one) := -begin - rw [←limit.w (cospan f g) walking_cospan.hom.inl, cospan_map_inl], - apply_instance -end - -instance forget_preserves_limits_of_left : preserves_limit (cospan f g) (forget C) := -preserves_limit_of_preserves_limit_cone (pullback_cone_of_left_is_limit f g) -begin - apply (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v} _) _).to_fun, - refine (is_limit.equiv_iso_limit _).to_fun (limit.is_limit (cospan f.base g.base)), - fapply cones.ext, - exact (iso.refl _), - change ∀ j, _ = 𝟙 _ ≫ _ ≫ _, - simp_rw category.id_comp, - rintros (_|_|_); symmetry, - { erw category.comp_id, - exact limit.w (cospan f.base g.base) walking_cospan.hom.inl }, - { exact category.comp_id _ }, - { exact category.comp_id _ }, -end - -instance forget_preserves_limits_of_right : preserves_limit (cospan g f) (forget C) := -preserves_pullback_symmetry (forget C) f g - -lemma pullback_snd_is_iso_of_range_subset (H : set.range g.base ⊆ set.range f.base) : - is_iso (pullback.snd : pullback f g ⟶ _) := -begin - haveI := Top.snd_iso_of_left_embedding_range_subset hf.base_open.to_embedding g.base H, - haveI : is_iso (pullback.snd : pullback f g ⟶ _).base, - { delta pullback.snd, - rw ← limit.iso_limit_cone_hom_π ⟨_, pullback_cone_of_left_is_limit f g⟩ walking_cospan.right, - change is_iso (_ ≫ pullback.snd), - apply_instance }, - apply to_iso -end - -/-- -The universal property of open immersions: -For an open immersion `f : X ⟶ Z`, given any morphism of schemes `g : Y ⟶ Z` whose topological -image is contained in the image of `f`, we can lift this morphism to a unique `Y ⟶ X` that -commutes with these maps. --/ -def lift (H : set.range g.base ⊆ set.range f.base) : Y ⟶ X := -begin - haveI := pullback_snd_is_iso_of_range_subset f g H, - exact inv (pullback.snd : pullback f g ⟶ _) ≫ pullback.fst, -end - -@[simp, reassoc] lemma lift_fac (H : set.range g.base ⊆ set.range f.base) : - lift f g H ≫ f = g := -by { erw category.assoc, rw is_iso.inv_comp_eq, exact pullback.condition } - -lemma lift_uniq (H : set.range g.base ⊆ set.range f.base) (l : Y ⟶ X) - (hl : l ≫ f = g) : l = lift f g H := -by rw [← cancel_mono f, hl, lift_fac] - -/-- Two open immersions with equal range is isomorphic. -/ -@[simps] def iso_of_range_eq [is_open_immersion g] (e : set.range f.base = set.range g.base) : - X ≅ Y := -{ hom := lift g f (le_of_eq e), - inv := lift f g (le_of_eq e.symm), - hom_inv_id' := by { rw ← cancel_mono f, simp }, - inv_hom_id' := by { rw ← cancel_mono g, simp } } - -end pullback - -open category_theory.limits.walking_cospan - -section to_SheafedSpace - -variables [has_products C] {X : PresheafedSpace C} (Y : SheafedSpace C) -variables (f : X ⟶ Y.to_PresheafedSpace) [H : is_open_immersion f] - -include H - -/-- If `X ⟶ Y` is an open immersion, and `Y` is a SheafedSpace, then so is `X`. -/ -def to_SheafedSpace : SheafedSpace C := -{ is_sheaf := - begin - apply Top.presheaf.is_sheaf_of_iso (sheaf_iso_of_iso H.iso_restrict.symm).symm, - apply Top.sheaf.pushforward_sheaf_of_sheaf, - exact (Y.restrict H.base_open).is_sheaf - end, - to_PresheafedSpace := X } - -@[simp] lemma to_SheafedSpace_to_PresheafedSpace : (to_SheafedSpace Y f).to_PresheafedSpace = X := -rfl - -/-- -If `X ⟶ Y` is an open immersion of PresheafedSpaces, and `Y` is a SheafedSpace, we can -upgrade it into a morphism of SheafedSpaces. --/ -def to_SheafedSpace_hom : to_SheafedSpace Y f ⟶ Y := f - -@[simp] lemma to_SheafedSpace_hom_base : (to_SheafedSpace_hom Y f).base = f.base := rfl - -@[simp] lemma to_SheafedSpace_hom_c : (to_SheafedSpace_hom Y f).c = f.c := rfl - -instance to_SheafedSpace_is_open_immersion : - SheafedSpace.is_open_immersion (to_SheafedSpace_hom Y f) := H - -omit H - -@[simp] lemma SheafedSpace_to_SheafedSpace {X Y : SheafedSpace C} (f : X ⟶ Y) - [is_open_immersion f] : to_SheafedSpace Y f = X := by unfreezingI { cases X, refl } - -end to_SheafedSpace - -section to_LocallyRingedSpace - -variables {X : PresheafedSpace CommRing.{u}} (Y : LocallyRingedSpace.{u}) -variables (f : X ⟶ Y.to_PresheafedSpace) [H : is_open_immersion f] - -include H - -/-- If `X ⟶ Y` is an open immersion, and `Y` is a LocallyRingedSpace, then so is `X`. -/ -def to_LocallyRingedSpace : LocallyRingedSpace := -{ to_SheafedSpace := to_SheafedSpace Y.to_SheafedSpace f, - local_ring := λ x, begin - haveI : local_ring (Y.to_SheafedSpace.to_PresheafedSpace.stalk (f.base x)) := Y.local_ring _, - exact (as_iso (stalk_map f x)).CommRing_iso_to_ring_equiv.local_ring - end } - -@[simp] lemma to_LocallyRingedSpace_to_SheafedSpace : - (to_LocallyRingedSpace Y f).to_SheafedSpace = (to_SheafedSpace Y.1 f) := rfl - -/-- -If `X ⟶ Y` is an open immersion of PresheafedSpaces, and `Y` is a LocallyRingedSpace, we can -upgrade it into a morphism of LocallyRingedSpace. --/ -def to_LocallyRingedSpace_hom : to_LocallyRingedSpace Y f ⟶ Y := ⟨f, λ x, infer_instance⟩ - -@[simp] lemma to_LocallyRingedSpace_hom_val : - (to_LocallyRingedSpace_hom Y f).val = f := rfl - -instance to_LocallyRingedSpace_is_open_immersion : - LocallyRingedSpace.is_open_immersion (to_LocallyRingedSpace_hom Y f) := H - -omit H - -@[simp] lemma LocallyRingedSpace_to_LocallyRingedSpace {X Y : LocallyRingedSpace} (f : X ⟶ Y) - [LocallyRingedSpace.is_open_immersion f] : - @to_LocallyRingedSpace X.to_PresheafedSpace Y (@@coe (@@coe_to_lift (@@coe_base coe_subtype)) f) - (show is_open_immersion f.val, by apply_instance) = X := -by unfreezingI { cases X, delta to_LocallyRingedSpace, simp } - -end to_LocallyRingedSpace - -end PresheafedSpace.is_open_immersion - -namespace SheafedSpace.is_open_immersion - -variables [has_products C] - -@[priority 100] -instance of_is_iso {X Y : SheafedSpace C} (f : X ⟶ Y) [is_iso f] : - SheafedSpace.is_open_immersion f := -@@PresheafedSpace.is_open_immersion.of_is_iso _ f -(SheafedSpace.forget_to_PresheafedSpace.map_is_iso _) - -instance comp {X Y Z : SheafedSpace C} (f : X ⟶ Y) (g : Y ⟶ Z) - [SheafedSpace.is_open_immersion f] [SheafedSpace.is_open_immersion g] : - SheafedSpace.is_open_immersion (f ≫ g) := PresheafedSpace.is_open_immersion.comp f g - -section pullback - -variables {X Y Z : SheafedSpace C} (f : X ⟶ Z) (g : Y ⟶ Z) -variable [H : SheafedSpace.is_open_immersion f] - -include H - -local notation `forget` := SheafedSpace.forget_to_PresheafedSpace -open category_theory.limits.walking_cospan - -instance : mono f := faithful_reflects_mono forget - (show @mono (PresheafedSpace C) _ _ _ f, by apply_instance) - -instance forget_map_is_open_immersion : - PresheafedSpace.is_open_immersion (forget .map f) := ⟨H.base_open, H.c_iso⟩ - -instance has_limit_cospan_forget_of_left : has_limit (cospan f g ⋙ forget) := -begin - apply has_limit_of_iso (diagram_iso_cospan.{v} _).symm, - change has_limit (cospan (forget .map f) (forget .map g)), - apply_instance -end - -instance has_limit_cospan_forget_of_left' : has_limit (cospan ((cospan f g ⋙ forget).map hom.inl) - ((cospan f g ⋙ forget).map hom.inr)) := -show has_limit (cospan (forget .map f) (forget .map g)), from infer_instance - -instance has_limit_cospan_forget_of_right : has_limit (cospan g f ⋙ forget) := -begin - apply has_limit_of_iso (diagram_iso_cospan.{v} _).symm, - change has_limit (cospan (forget .map g) (forget .map f)), - apply_instance -end - -instance has_limit_cospan_forget_of_right' : has_limit (cospan ((cospan g f ⋙ forget).map hom.inl) - ((cospan g f ⋙ forget).map hom.inr)) := -show has_limit (cospan (forget .map g) (forget .map f)), from infer_instance - - -instance forget_creates_pullback_of_left : creates_limit (cospan f g) forget := -creates_limit_of_fully_faithful_of_iso - (PresheafedSpace.is_open_immersion.to_SheafedSpace Y - (@pullback.snd (PresheafedSpace C) _ _ _ _ f g _)) - (eq_to_iso (show pullback _ _ = pullback _ _, by congr) - ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) - -instance forget_creates_pullback_of_right : creates_limit (cospan g f) forget := -creates_limit_of_fully_faithful_of_iso - (PresheafedSpace.is_open_immersion.to_SheafedSpace Y - (@pullback.fst (PresheafedSpace C) _ _ _ _ g f _)) - (eq_to_iso (show pullback _ _ = pullback _ _, by congr) - ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) - -instance SheafedSpace_forget_preserves_of_left : - preserves_limit (cospan f g) (SheafedSpace.forget C) := -@@limits.comp_preserves_limit _ _ _ _ forget (PresheafedSpace.forget C) _ -begin - apply_with (preserves_limit_of_iso_diagram _ (diagram_iso_cospan.{v} _).symm) { instances := tt }, - dsimp, - apply_instance -end - -instance SheafedSpace_forget_preserves_of_right : - preserves_limit (cospan g f) (SheafedSpace.forget C) := -preserves_pullback_symmetry _ _ _ - -instance SheafedSpace_has_pullback_of_left : has_pullback f g := - has_limit_of_created (cospan f g) forget - -instance SheafedSpace_has_pullback_of_right : has_pullback g f := - has_limit_of_created (cospan g f) forget - -/-- Open immersions are stable under base-change. -/ -instance SheafedSpace_pullback_snd_of_left : - SheafedSpace.is_open_immersion (pullback.snd : pullback f g ⟶ _) := -begin - delta pullback.snd, - have : _ = limit.π (cospan f g) right := preserves_limits_iso_hom_π - forget (cospan f g) right, - rw ← this, - have := has_limit.iso_of_nat_iso_hom_π - (diagram_iso_cospan.{v} (cospan f g ⋙ forget)) - right, - erw category.comp_id at this, - rw ← this, - dsimp, - apply_instance -end - -instance SheafedSpace_pullback_fst_of_right : - SheafedSpace.is_open_immersion (pullback.fst : pullback g f ⟶ _) := -begin - delta pullback.fst, - have : _ = limit.π (cospan g f) left := preserves_limits_iso_hom_π - forget (cospan g f) left, - rw ← this, - have := has_limit.iso_of_nat_iso_hom_π - (diagram_iso_cospan.{v} (cospan g f ⋙ forget)) left, - erw category.comp_id at this, - rw ← this, - dsimp, - apply_instance -end - -instance SheafedSpace_pullback_one_is_open_immersion [SheafedSpace.is_open_immersion g] : - SheafedSpace.is_open_immersion (limit.π (cospan f g) one : pullback f g ⟶ Z) := -begin - rw [←limit.w (cospan f g) hom.inl, cospan_map_inl], - apply_instance -end - -end pullback - -section of_stalk_iso -variables [has_limits C] [has_colimits C] [concrete_category.{v} C] -variables [reflects_isomorphisms (forget C)] [preserves_limits (forget C)] -variables [preserves_filtered_colimits (forget C)] - -/-- -Suppose `X Y : SheafedSpace C`, where `C` is a concrete category, -whose forgetful functor reflects isomorphisms, preserves limits and filtered colimits. -Then a morphism `X ⟶ Y` that is a topological open embedding -is an open immersion iff every stalk map is an iso. --/ -lemma of_stalk_iso {X Y : SheafedSpace C} (f : X ⟶ Y) - (hf : open_embedding f.base) [H : ∀ x : X, is_iso (PresheafedSpace.stalk_map f x)] : - SheafedSpace.is_open_immersion f := -{ base_open := hf, - c_iso := λ U, begin - apply_with (Top.presheaf.app_is_iso_of_stalk_functor_map_iso - (show Y.sheaf ⟶ (Top.sheaf.pushforward f.base).obj X.sheaf, from f.c)) { instances := ff }, - rintros ⟨_, y, hy, rfl⟩, - specialize H y, - delta PresheafedSpace.stalk_map at H, - haveI H' := Top.presheaf.stalk_pushforward.stalk_pushforward_iso_of_open_embedding - C hf X.presheaf y, - have := @@is_iso.comp_is_iso _ H (@@is_iso.inv_is_iso _ H'), - rw [category.assoc, is_iso.hom_inv_id, category.comp_id] at this, - exact this - end } - -end of_stalk_iso - -section prod - -variables [has_limits C] {ι : Type v} (F : discrete ι ⥤ SheafedSpace C) [has_colimit F] (i : ι) - -lemma sigma_ι_open_embedding : open_embedding (colimit.ι F i).base := -begin - rw ← (show _ = (colimit.ι F i).base, - from ι_preserves_colimits_iso_inv (SheafedSpace.forget C) F i), - have : _ = _ ≫ colimit.ι (discrete.functor (F ⋙ SheafedSpace.forget C).obj) i := - has_colimit.iso_of_nat_iso_ι_hom discrete.nat_iso_functor i, - rw ← iso.eq_comp_inv at this, - rw this, - have : colimit.ι _ _ ≫ _ = _ := Top.sigma_iso_sigma_hom_ι (F ⋙ SheafedSpace.forget C).obj i, - rw ← iso.eq_comp_inv at this, - rw this, - simp_rw [← category.assoc, Top.open_embedding_iff_comp_is_iso, - Top.open_embedding_iff_is_iso_comp], - exact open_embedding_sigma_mk -end - -lemma image_preimage_is_empty (j : ι) (h : i ≠ j) (U : opens (F.obj i)) : - (opens.map (colimit.ι (F ⋙ SheafedSpace.forget_to_PresheafedSpace) j).base).obj - ((opens.map (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv.base).obj - ((sigma_ι_open_embedding F i).is_open_map.functor.obj U)) = ∅ := -begin - ext, - apply iff_false_intro, - rintro ⟨y, hy, eq⟩, - replace eq := concrete_category.congr_arg - (preserves_colimit_iso (SheafedSpace.forget C) F ≪≫ - has_colimit.iso_of_nat_iso discrete.nat_iso_functor ≪≫ Top.sigma_iso_sigma _).hom eq, - simp_rw [category_theory.iso.trans_hom, ← Top.comp_app, ← PresheafedSpace.comp_base] at eq, - rw ι_preserves_colimits_iso_inv at eq, - change ((SheafedSpace.forget C).map (colimit.ι F i) ≫ _) y = - ((SheafedSpace.forget C).map (colimit.ι F j) ≫ _) x at eq, - rw [ι_preserves_colimits_iso_hom_assoc, ι_preserves_colimits_iso_hom_assoc, - has_colimit.iso_of_nat_iso_ι_hom_assoc, has_colimit.iso_of_nat_iso_ι_hom_assoc, - Top.sigma_iso_sigma_hom_ι, Top.sigma_iso_sigma_hom_ι] at eq, - exact h (congr_arg sigma.fst eq) -end - -instance sigma_ι_is_open_immersion [has_strict_terminal_objects C] : - SheafedSpace.is_open_immersion (colimit.ι F i) := -{ base_open := sigma_ι_open_embedding F i, - c_iso := λ U, begin - have e : colimit.ι F i = _ := - (ι_preserves_colimits_iso_inv SheafedSpace.forget_to_PresheafedSpace F i).symm, - have H : open_embedding (colimit.ι (F ⋙ SheafedSpace.forget_to_PresheafedSpace) i ≫ - (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv).base := - e ▸ sigma_ι_open_embedding F i, - suffices : is_iso ((colimit.ι (F ⋙ SheafedSpace.forget_to_PresheafedSpace) i ≫ - (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv).c.app - (op (H.is_open_map.functor.obj U))), - { convert this }, - rw [PresheafedSpace.comp_c_app, - ← PresheafedSpace.colimit_presheaf_obj_iso_componentwise_limit_hom_π], - suffices : is_iso (limit.π (PresheafedSpace.componentwise_diagram - (F ⋙ SheafedSpace.forget_to_PresheafedSpace) - ((opens.map (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv.base).obj - (unop $ op $ H.is_open_map.functor.obj U))) (op i)), - { resetI, apply_instance }, - apply limit_π_is_iso_of_is_strict_terminal, - intros j hj, - induction j using opposite.rec, - dsimp, - convert (F.obj j).sheaf.is_terminal_of_empty, - convert image_preimage_is_empty F i j (λ h, hj (congr_arg op h.symm)) U, - exact (congr_arg PresheafedSpace.hom.base e).symm - end } - -end prod - -end SheafedSpace.is_open_immersion - -namespace LocallyRingedSpace.is_open_immersion - -section pullback - -variables {X Y Z : LocallyRingedSpace.{u}} (f : X ⟶ Z) (g : Y ⟶ Z) -variable [H : LocallyRingedSpace.is_open_immersion f] - -@[priority 100] -instance of_is_iso [is_iso g] : - LocallyRingedSpace.is_open_immersion g := -@@PresheafedSpace.is_open_immersion.of_is_iso _ g.1 ⟨⟨(inv g).1, - by { erw ← LocallyRingedSpace.comp_val, rw is_iso.hom_inv_id, - erw ← LocallyRingedSpace.comp_val, rw is_iso.inv_hom_id, split; simpa }⟩⟩ - -include H - -instance comp (g : Z ⟶ Y) [LocallyRingedSpace.is_open_immersion g] : - LocallyRingedSpace.is_open_immersion (f ≫ g) := PresheafedSpace.is_open_immersion.comp f.1 g.1 - -instance mono : mono f := -faithful_reflects_mono (LocallyRingedSpace.forget_to_SheafedSpace) - (show mono f.1, by apply_instance) - -instance : SheafedSpace.is_open_immersion (LocallyRingedSpace.forget_to_SheafedSpace.map f) := H - -/-- An explicit pullback cone over `cospan f g` if `f` is an open immersion. -/ -def pullback_cone_of_left : pullback_cone f g := -begin - refine pullback_cone.mk _ - (Y.of_restrict (Top.snd_open_embedding_of_left_open_embedding H.base_open g.1.base)) _, - { use PresheafedSpace.is_open_immersion.pullback_cone_of_left_fst f.1 g.1, - intro x, - have := PresheafedSpace.stalk_map.congr_hom _ _ - (PresheafedSpace.is_open_immersion.pullback_cone_of_left_condition f.1 g.1) x, - rw [PresheafedSpace.stalk_map.comp, PresheafedSpace.stalk_map.comp] at this, - rw ← is_iso.eq_inv_comp at this, - rw this, - apply_instance }, - { exact subtype.eq (PresheafedSpace.is_open_immersion.pullback_cone_of_left_condition _ _) }, -end - -instance : LocallyRingedSpace.is_open_immersion (pullback_cone_of_left f g).snd := -show PresheafedSpace.is_open_immersion (Y.to_PresheafedSpace.of_restrict _), by apply_instance - -/-- The constructed `pullback_cone_of_left` is indeed limiting. -/ -def pullback_cone_of_left_is_limit : is_limit (pullback_cone_of_left f g) := -pullback_cone.is_limit_aux' _ $ λ s, -begin - use PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift f.1 g.1 - (pullback_cone.mk s.fst.1 s.snd.1 (congr_arg subtype.val s.condition)), - { intro x, - have := PresheafedSpace.stalk_map.congr_hom _ _ - (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_snd f.1 g.1 - (pullback_cone.mk s.fst.1 s.snd.1 (congr_arg subtype.val s.condition))) x, - change _ = _ ≫ PresheafedSpace.stalk_map s.snd.1 x at this, - rw [PresheafedSpace.stalk_map.comp, ← is_iso.eq_inv_comp] at this, - rw this, - apply_instance }, - split, - exact subtype.eq (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_fst f.1 g.1 _), - split, - exact subtype.eq (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_snd f.1 g.1 _), - intros m h₁ h₂, - rw ← cancel_mono (pullback_cone_of_left f g).snd, - exact (h₂.trans (subtype.eq - (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_snd f.1 g.1 - (pullback_cone.mk s.fst.1 s.snd.1 (congr_arg subtype.val s.condition))).symm)) -end - -instance has_pullback_of_left : - has_pullback f g := -⟨⟨⟨_, pullback_cone_of_left_is_limit f g⟩⟩⟩ - -instance has_pullback_of_right : - has_pullback g f := has_pullback_symmetry f g - -/-- Open immersions are stable under base-change. -/ -instance pullback_snd_of_left : - LocallyRingedSpace.is_open_immersion (pullback.snd : pullback f g ⟶ _) := -begin - delta pullback.snd, - rw ← limit.iso_limit_cone_hom_π ⟨_, pullback_cone_of_left_is_limit f g⟩ walking_cospan.right, - apply_instance -end - -/-- Open immersions are stable under base-change. -/ -instance pullback_fst_of_right : -LocallyRingedSpace.is_open_immersion (pullback.fst : pullback g f ⟶ _) := -begin - rw ← pullback_symmetry_hom_comp_snd, - apply_instance -end - -instance pullback_one_is_open_immersion [LocallyRingedSpace.is_open_immersion g] : - LocallyRingedSpace.is_open_immersion (limit.π (cospan f g) walking_cospan.one) := -begin - rw [←limit.w (cospan f g) walking_cospan.hom.inl, cospan_map_inl], - apply_instance -end - -instance forget_preserves_pullback_of_left : - preserves_limit (cospan f g) LocallyRingedSpace.forget_to_SheafedSpace := -preserves_limit_of_preserves_limit_cone (pullback_cone_of_left_is_limit f g) -begin - apply (is_limit_map_cone_pullback_cone_equiv _ _).symm.to_fun, - apply is_limit_of_is_limit_pullback_cone_map SheafedSpace.forget_to_PresheafedSpace, - exact PresheafedSpace.is_open_immersion.pullback_cone_of_left_is_limit f.1 g.1 -end - -instance forget_to_PresheafedSpace_preserves_pullback_of_left : - preserves_limit (cospan f g) - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) := -preserves_limit_of_preserves_limit_cone (pullback_cone_of_left_is_limit f g) -begin - apply (is_limit_map_cone_pullback_cone_equiv _ _).symm.to_fun, - exact PresheafedSpace.is_open_immersion.pullback_cone_of_left_is_limit f.1 g.1 -end - -instance forget_to_PresheafedSpace_preserves_open_immersion : - PresheafedSpace.is_open_immersion ((LocallyRingedSpace.forget_to_SheafedSpace ⋙ - SheafedSpace.forget_to_PresheafedSpace).map f) := H - -instance forget_to_Top_preserves_pullback_of_left : - preserves_limit (cospan f g) - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _) := -begin - change preserves_limit _ - ((LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) - ⋙ PresheafedSpace.forget _), - apply_with limits.comp_preserves_limit { instances := ff }, - apply_instance, - apply preserves_limit_of_iso_diagram _ (diagram_iso_cospan.{u} _).symm, - dsimp [SheafedSpace.forget_to_PresheafedSpace, -subtype.val_eq_coe], - apply_instance, -end - -instance forget_reflects_pullback_of_left : - reflects_limit (cospan f g) LocallyRingedSpace.forget_to_SheafedSpace := -reflects_limit_of_reflects_isomorphisms _ _ - -instance forget_preserves_pullback_of_right : - preserves_limit (cospan g f) LocallyRingedSpace.forget_to_SheafedSpace := -preserves_pullback_symmetry _ _ _ - -instance forget_to_PresheafedSpace_preserves_pullback_of_right : - preserves_limit (cospan g f) (LocallyRingedSpace.forget_to_SheafedSpace ⋙ - SheafedSpace.forget_to_PresheafedSpace) := -preserves_pullback_symmetry _ _ _ - -instance forget_reflects_pullback_of_right : - reflects_limit (cospan g f) LocallyRingedSpace.forget_to_SheafedSpace := -reflects_limit_of_reflects_isomorphisms _ _ - -instance forget_to_PresheafedSpace_reflects_pullback_of_left : - reflects_limit (cospan f g) - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) := -reflects_limit_of_reflects_isomorphisms _ _ - -instance forget_to_PresheafedSpace_reflects_pullback_of_right : - reflects_limit (cospan g f) - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) := -reflects_limit_of_reflects_isomorphisms _ _ - -lemma pullback_snd_is_iso_of_range_subset (H' : set.range g.1.base ⊆ set.range f.1.base) : - is_iso (pullback.snd : pullback f g ⟶ _) := -begin - apply_with (reflects_isomorphisms.reflects LocallyRingedSpace.forget_to_SheafedSpace) - { instances := ff }, - apply_with (reflects_isomorphisms.reflects SheafedSpace.forget_to_PresheafedSpace) - { instances := ff }, - erw ← preserves_pullback.iso_hom_snd - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) f g, - haveI := PresheafedSpace.is_open_immersion.pullback_snd_is_iso_of_range_subset _ _ H', - apply_instance, - apply_instance -end - -/-- -The universal property of open immersions: -For an open immersion `f : X ⟶ Z`, given any morphism of schemes `g : Y ⟶ Z` whose topological -image is contained in the image of `f`, we can lift this morphism to a unique `Y ⟶ X` that -commutes with these maps. --/ -def lift (H' : set.range g.1.base ⊆ set.range f.1.base) : Y ⟶ X := -begin - haveI := pullback_snd_is_iso_of_range_subset f g H', - exact inv (pullback.snd : pullback f g ⟶ _) ≫ pullback.fst, -end - -@[simp, reassoc] lemma lift_fac (H' : set.range g.1.base ⊆ set.range f.1.base) : - lift f g H' ≫ f = g := -by { erw category.assoc, rw is_iso.inv_comp_eq, exact pullback.condition } - -lemma lift_uniq (H' : set.range g.1.base ⊆ set.range f.1.base) (l : Y ⟶ X) - (hl : l ≫ f = g) : l = lift f g H' := -by rw [← cancel_mono f, hl, lift_fac] - -lemma lift_range (H' : set.range g.1.base ⊆ set.range f.1.base) : - set.range (lift f g H').1.base = f.1.base ⁻¹' (set.range g.1.base) := -begin - haveI := pullback_snd_is_iso_of_range_subset f g H', - dsimp only [lift], - have : _ = (pullback.fst : pullback f g ⟶ _).val.base := preserves_pullback.iso_hom_fst - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _) f g, - rw [LocallyRingedSpace.comp_val, SheafedSpace.comp_base, ← this, ← category.assoc, coe_comp], - rw [set.range_comp, set.range_iff_surjective.mpr, set.image_univ, Top.pullback_fst_range], - ext, - split, - { rintros ⟨y, eq⟩, exact ⟨y, eq.symm⟩ }, - { rintros ⟨y, eq⟩, exact ⟨y, eq.symm⟩ }, - { rw ← Top.epi_iff_surjective, - rw (show (inv (pullback.snd : pullback f g ⟶ _)).val.base = _, from - (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _).map_inv _), - apply_instance } -end - -end pullback - -/-- An open immersion is isomorphic to the induced open subscheme on its image. -/ -def iso_restrict {X Y : LocallyRingedSpace} {f : X ⟶ Y} - (H : LocallyRingedSpace.is_open_immersion f) : X ≅ Y.restrict H.base_open := -begin - apply LocallyRingedSpace.iso_of_SheafedSpace_iso, - refine SheafedSpace.forget_to_PresheafedSpace.preimage_iso _, - exact H.iso_restrict -end - -/-- To show that a locally ringed space is a scheme, it suffices to show that it has a jointly -surjective family of open immersions from affine schemes. -/ -protected def Scheme (X : LocallyRingedSpace) - (h : ∀ (x : X), ∃ (R : CommRing) (f : Spec.to_LocallyRingedSpace.obj (op R) ⟶ X), - (x ∈ set.range f.1.base : _) ∧ LocallyRingedSpace.is_open_immersion f) : Scheme := -{ to_LocallyRingedSpace := X, - local_affine := - begin - intro x, - obtain ⟨R, f, h₁, h₂⟩ := h x, - refine ⟨⟨⟨_, h₂.base_open.open_range⟩, h₁⟩, R, ⟨_⟩⟩, - apply LocallyRingedSpace.iso_of_SheafedSpace_iso, - refine SheafedSpace.forget_to_PresheafedSpace.preimage_iso _, - resetI, - apply PresheafedSpace.is_open_immersion.iso_of_range_eq (PresheafedSpace.of_restrict _ _) f.1, - { exact subtype.range_coe_subtype }, - { apply_instance } - end } - -end LocallyRingedSpace.is_open_immersion - -lemma is_open_immersion.open_range {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f] : - is_open (set.range f.1.base) := H.base_open.open_range - -section open_cover - -namespace Scheme - -/-- An open cover of `X` consists of a family of open immersions into `X`, -and for each `x : X` an open immersion (indexed by `f x`) that covers `x`. - -This is merely a coverage in the Zariski pretopology, and it would be optimal -if we could reuse the existing API about pretopologies, However, the definitions of sieves and -grothendieck topologies uses `Prop`s, so that the actual open sets and immersions are hard to -obtain. Also, since such a coverage in the pretopology usually contains a proper class of -immersions, it is quite hard to glue them, reason about finite covers, etc. --/ --- TODO: provide API to and from a presieve. -structure open_cover (X : Scheme.{u}) := -(J : Type v) -(obj : Π (j : J), Scheme) -(map : Π (j : J), obj j ⟶ X) -(f : X.carrier → J) -(covers : ∀ x, x ∈ set.range ((map (f x)).1.base)) -(is_open : ∀ x, is_open_immersion (map x) . tactic.apply_instance) - -attribute [instance] open_cover.is_open - -variables {X Y Z : Scheme.{u}} (𝒰 : open_cover X) (f : X ⟶ Z) (g : Y ⟶ Z) -variables [∀ x, has_pullback (𝒰.map x ≫ f) g] - -/-- The affine cover of a scheme. -/ -def affine_cover (X : Scheme) : open_cover X := -{ J := X.carrier, - obj := λ x, Spec.obj $ opposite.op (X.local_affine x).some_spec.some, - map := λ x, ((X.local_affine x).some_spec.some_spec.some.inv ≫ - X.to_LocallyRingedSpace.of_restrict _ : _), - f := λ x, x, - is_open := λ x, begin - apply_with PresheafedSpace.is_open_immersion.comp { instances := ff }, - apply_instance, - apply PresheafedSpace.is_open_immersion.of_restrict, - end, - covers := - begin - intro x, - erw coe_comp, - rw [set.range_comp, set.range_iff_surjective.mpr, set.image_univ], - erw subtype.range_coe_subtype, - exact (X.local_affine x).some.2, - rw ← Top.epi_iff_surjective, - change epi ((SheafedSpace.forget _).map (LocallyRingedSpace.forget_to_SheafedSpace.map _)), - apply_instance - end } - -instance : inhabited X.open_cover := ⟨X.affine_cover⟩ - -/-- Given an open cover `{ Uᵢ }` of `X`, and for each `Uᵢ` an open cover, we may combine these -open covers to form an open cover of `X`. -/ -@[simps J obj map] -def open_cover.bind (f : Π (x : 𝒰.J), open_cover (𝒰.obj x)) : open_cover X := -{ J := Σ (i : 𝒰.J), (f i).J, - obj := λ x, (f x.1).obj x.2, - map := λ x, (f x.1).map x.2 ≫ 𝒰.map x.1, - f := λ x, ⟨_, (f _).f (𝒰.covers x).some⟩, - covers := λ x, - begin - let y := (𝒰.covers x).some, - have hy : (𝒰.map (𝒰.f x)).val.base y = x := (𝒰.covers x).some_spec, - rcases (f (𝒰.f x)).covers y with ⟨z, hz⟩, - change x ∈ set.range (((f (𝒰.f x)).map ((f (𝒰.f x)).f y) ≫ 𝒰.map (𝒰.f x)).1.base), - use z, - erw comp_apply, - rw [hz, hy], - end } - -/-- An isomorphism `X ⟶ Y` is an open cover of `Y`. -/ -@[simps J obj map] -def open_cover_of_is_iso {X Y : Scheme.{u}} (f : X ⟶ Y) [is_iso f] : - open_cover Y := -{ J := punit.{v+1}, - obj := λ _, X, - map := λ _, f, - f := λ _, punit.star, - covers := λ x, by { rw set.range_iff_surjective.mpr, { trivial }, rw ← Top.epi_iff_surjective, - apply_instance } } - -/-- We construct an open cover from another, by providing the needed fields and showing that the -provided fields are isomorphic with the original open cover. -/ -@[simps J obj map] -def open_cover.copy {X : Scheme} (𝒰 : open_cover X) - (J : Type*) (obj : J → Scheme) (map : ∀ i, obj i ⟶ X) - (e₁ : J ≃ 𝒰.J) (e₂ : ∀ i, obj i ≅ 𝒰.obj (e₁ i)) - (e₂ : ∀ i, map i = (e₂ i).hom ≫ 𝒰.map (e₁ i)) : open_cover X := -{ J := J, - obj := obj, - map := map, - f := λ x, e₁.symm (𝒰.f x), - covers := λ x, begin - rw [e₂, Scheme.comp_val_base, coe_comp, set.range_comp, set.range_iff_surjective.mpr, - set.image_univ, e₁.right_inverse_symm], - { exact 𝒰.covers x }, - { rw ← Top.epi_iff_surjective, apply_instance } - end, - is_open := λ i, by { rw e₂, apply_instance } } - -/-- The pushforward of an open cover along an isomorphism. -/ -@[simps J obj map] -def open_cover.pushforward_iso {X Y : Scheme} (𝒰 : open_cover X) - (f : X ⟶ Y) [is_iso f] : - open_cover Y := -((open_cover_of_is_iso f).bind (λ _, 𝒰)).copy 𝒰.J _ _ - ((equiv.punit_prod _).symm.trans (equiv.sigma_equiv_prod punit 𝒰.J).symm) - (λ _, iso.refl _) - (λ _, (category.id_comp _).symm) - --- Related result : `open_cover.pullback_cover`, where we pullback an open cover on `X` along a --- morphism `W ⟶ X`. This is provided at the end of the file since it needs some more results --- about open immersion (which in turn needs the open cover API). - -local attribute [reducible] CommRing.of CommRing.of_hom - -instance val_base_is_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] : is_iso f.1.base := -Scheme.forget_to_Top.map_is_iso f - -instance basic_open_is_open_immersion {R : CommRing} (f : R) : -algebraic_geometry.is_open_immersion (Scheme.Spec.map (CommRing.of_hom - (algebra_map R (localization.away f))).op) := -begin - apply_with SheafedSpace.is_open_immersion.of_stalk_iso { instances := ff }, - any_goals { apply_instance }, - any_goals { apply_instance }, - exact (prime_spectrum.localization_away_open_embedding (localization.away f) f : _), - intro x, - exact Spec_map_localization_is_iso R (submonoid.powers f) x, -end - -/-- The basic open sets form an affine open cover of `Spec R`. -/ -def affine_basis_cover_of_affine (R : CommRing) : open_cover (Spec.obj (opposite.op R)) := -{ J := R, - obj := λ r, Spec.obj (opposite.op $ CommRing.of $ localization.away r), - map := λ r, Spec.map (quiver.hom.op (algebra_map R (localization.away r) : _)), - f := λ x, 1, - covers := λ r, - begin - rw set.range_iff_surjective.mpr ((Top.epi_iff_surjective _).mp _), - { exact trivial }, - { apply_instance } - end, - is_open := λ x, algebraic_geometry.Scheme.basic_open_is_open_immersion x } - -/-- We may bind the basic open sets of an open affine cover to form a affine cover that is also -a basis. -/ -def affine_basis_cover (X : Scheme) : open_cover X := -X.affine_cover.bind (λ x, affine_basis_cover_of_affine _) - -/-- The coordinate ring of a component in the `affine_basis_cover`. -/ -def affine_basis_cover_ring (X : Scheme) (i : X.affine_basis_cover.J) : CommRing := -CommRing.of $ @localization.away (X.local_affine i.1).some_spec.some _ i.2 - -lemma affine_basis_cover_obj (X : Scheme) (i : X.affine_basis_cover.J) : - X.affine_basis_cover.obj i = Spec.obj (op $ X.affine_basis_cover_ring i) := rfl - -lemma affine_basis_cover_map_range (X : Scheme) - (x : X.carrier) (r : (X.local_affine x).some_spec.some) : - set.range (X.affine_basis_cover.map ⟨x, r⟩).1.base = - (X.affine_cover.map x).1.base '' (prime_spectrum.basic_open r).1 := -begin - erw [coe_comp, set.range_comp], - congr, - exact (prime_spectrum.localization_away_comap_range (localization.away r) r : _) -end - -lemma affine_basis_cover_is_basis (X : Scheme) : - topological_space.is_topological_basis - { x : set X.carrier | ∃ a : X.affine_basis_cover.J, x = - set.range ((X.affine_basis_cover.map a).1.base) } := -begin - apply topological_space.is_topological_basis_of_open_of_nhds, - { rintros _ ⟨a, rfl⟩, - exact is_open_immersion.open_range (X.affine_basis_cover.map a) }, - { rintros a U haU hU, - rcases X.affine_cover.covers a with ⟨x, e⟩, - let U' := (X.affine_cover.map (X.affine_cover.f a)).1.base ⁻¹' U, - have hxU' : x ∈ U' := by { rw ← e at haU, exact haU }, - rcases prime_spectrum.is_basis_basic_opens.exists_subset_of_mem_open hxU' - ((X.affine_cover.map (X.affine_cover.f a)).1.base.continuous_to_fun.is_open_preimage _ hU) - with ⟨_,⟨_,⟨s,rfl⟩,rfl⟩,hxV,hVU⟩, - refine ⟨_,⟨⟨_,s⟩,rfl⟩,_,_⟩; erw affine_basis_cover_map_range, - { exact ⟨x,hxV,e⟩ }, - { rw set.image_subset_iff, exact hVU } } -end - -/-- -Every open cover of a quasi-compact scheme can be refined into a finite subcover. --/ -@[simps obj map] -def open_cover.finite_subcover {X : Scheme} (𝒰 : open_cover X) [H : compact_space X.carrier] : - open_cover X := -begin - have := @@compact_space.elim_nhds_subcover _ H - (λ (x : X.carrier), set.range ((𝒰.map (𝒰.f x)).1.base)) - (λ x, (is_open_immersion.open_range (𝒰.map (𝒰.f x))).mem_nhds (𝒰.covers x)), - let t := this.some, - have h : ∀ (x : X.carrier), ∃ (y : t), x ∈ set.range ((𝒰.map (𝒰.f y)).1.base), - { intro x, - have h' : x ∈ (⊤ : set X.carrier) := trivial, - rw [← classical.some_spec this, set.mem_Union] at h', - rcases h' with ⟨y,_,⟨hy,rfl⟩,hy'⟩, - exact ⟨⟨y,hy⟩,hy'⟩ }, - exact - { J := t, - obj := λ x, 𝒰.obj (𝒰.f x.1), - map := λ x, 𝒰.map (𝒰.f x.1), - f := λ x, (h x).some, - covers := λ x, (h x).some_spec } -end - -instance [H : compact_space X.carrier] : fintype 𝒰.finite_subcover.J := -by { delta open_cover.finite_subcover, apply_instance } - -end Scheme - -end open_cover - -namespace PresheafedSpace.is_open_immersion - -section to_Scheme - -variables {X : PresheafedSpace CommRing.{u}} (Y : Scheme.{u}) -variables (f : X ⟶ Y.to_PresheafedSpace) [H : PresheafedSpace.is_open_immersion f] - -include H - -/-- If `X ⟶ Y` is an open immersion, and `Y` is a scheme, then so is `X`. -/ -def to_Scheme : Scheme := -begin - apply LocallyRingedSpace.is_open_immersion.Scheme (to_LocallyRingedSpace _ f), - intro x, - obtain ⟨_,⟨i,rfl⟩,hx,hi⟩ := Y.affine_basis_cover_is_basis.exists_subset_of_mem_open - (set.mem_range_self x) H.base_open.open_range, - use Y.affine_basis_cover_ring i, - use LocallyRingedSpace.is_open_immersion.lift (to_LocallyRingedSpace_hom _ f) _ hi, - split, - { rw LocallyRingedSpace.is_open_immersion.lift_range, exact hx }, - { delta LocallyRingedSpace.is_open_immersion.lift, apply_instance } -end - -@[simp] lemma to_Scheme_to_LocallyRingedSpace : - (to_Scheme Y f).to_LocallyRingedSpace = (to_LocallyRingedSpace Y.1 f) := rfl - -/-- -If `X ⟶ Y` is an open immersion of PresheafedSpaces, and `Y` is a Scheme, we can -upgrade it into a morphism of Schemes. --/ -def to_Scheme_hom : to_Scheme Y f ⟶ Y := to_LocallyRingedSpace_hom _ f - -@[simp] lemma to_Scheme_hom_val : - (to_Scheme_hom Y f).val = f := rfl - -instance to_Scheme_hom_is_open_immersion : - is_open_immersion (to_Scheme_hom Y f) := H - -omit H - -lemma Scheme_eq_of_LocallyRingedSpace_eq {X Y : Scheme} - (H : X.to_LocallyRingedSpace = Y.to_LocallyRingedSpace) : X = Y := -by { cases X, cases Y, congr, exact H } - -lemma Scheme_to_Scheme {X Y : Scheme} (f : X ⟶ Y) [is_open_immersion f] : - to_Scheme Y f.1 = X := -begin - apply Scheme_eq_of_LocallyRingedSpace_eq, - exact LocallyRingedSpace_to_LocallyRingedSpace f -end - -end to_Scheme - -end PresheafedSpace.is_open_immersion - -/-- The restriction of a Scheme along an open embedding. -/ -@[simps] -def Scheme.restrict {U : Top} (X : Scheme) {f : U ⟶ Top.of X.carrier} (h : open_embedding f) : - Scheme := -{ to_PresheafedSpace := X.to_PresheafedSpace.restrict h, - ..(PresheafedSpace.is_open_immersion.to_Scheme X (X.to_PresheafedSpace.of_restrict h)) } - -/-- The canonical map from the restriction to the supspace. -/ -@[simps] -def Scheme.of_restrict {U : Top} (X : Scheme) {f : U ⟶ Top.of X.carrier} (h : open_embedding f) : - X.restrict h ⟶ X := -X.to_LocallyRingedSpace.of_restrict h - -instance is_open_immersion.of_restrict {U : Top} (X : Scheme) {f : U ⟶ Top.of X.carrier} - (h : open_embedding f) : is_open_immersion (X.of_restrict h) := -show PresheafedSpace.is_open_immersion (X.to_PresheafedSpace.of_restrict h), by apply_instance - -namespace is_open_immersion - -variables {X Y Z : Scheme.{u}} (f : X ⟶ Z) (g : Y ⟶ Z) -variable [H : is_open_immersion f] - -@[priority 100] -instance of_is_iso [is_iso g] : - is_open_immersion g := @@LocallyRingedSpace.is_open_immersion.of_is_iso _ -(show is_iso ((induced_functor _).map g), by apply_instance) - -/-- A open immersion induces an isomorphism from the domain onto the image -/ -def iso_restrict : X ≅ (Z.restrict H.base_open : _) := -⟨H.iso_restrict.hom, H.iso_restrict.inv, H.iso_restrict.hom_inv_id, H.iso_restrict.inv_hom_id⟩ - -include H - -local notation `forget` := Scheme.forget_to_LocallyRingedSpace - -instance mono : mono f := -faithful_reflects_mono (induced_functor _) - (show @mono LocallyRingedSpace _ _ _ f, by apply_instance) - -instance forget_map_is_open_immersion : LocallyRingedSpace.is_open_immersion (forget .map f) := -⟨H.base_open, H.c_iso⟩ - -instance has_limit_cospan_forget_of_left : - has_limit (cospan f g ⋙ Scheme.forget_to_LocallyRingedSpace) := -begin - apply has_limit_of_iso (diagram_iso_cospan.{u} _).symm, - change has_limit (cospan (forget .map f) (forget .map g)), - apply_instance -end - -open category_theory.limits.walking_cospan - -instance has_limit_cospan_forget_of_left' : - has_limit (cospan ((cospan f g ⋙ forget).map hom.inl) - ((cospan f g ⋙ forget).map hom.inr)) := -show has_limit (cospan (forget .map f) (forget .map g)), from infer_instance - -instance has_limit_cospan_forget_of_right : has_limit (cospan g f ⋙ forget) := -begin - apply has_limit_of_iso (diagram_iso_cospan.{u} _).symm, - change has_limit (cospan (forget .map g) (forget .map f)), - apply_instance -end - -instance has_limit_cospan_forget_of_right' : - has_limit (cospan ((cospan g f ⋙ forget).map hom.inl) - ((cospan g f ⋙ forget).map hom.inr)) := -show has_limit (cospan (forget .map g) (forget .map f)), from infer_instance - -instance forget_creates_pullback_of_left : creates_limit (cospan f g) forget := -creates_limit_of_fully_faithful_of_iso - (PresheafedSpace.is_open_immersion.to_Scheme Y - (@pullback.snd LocallyRingedSpace _ _ _ _ f g _).1) - (eq_to_iso (by simp) ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) - -instance forget_creates_pullback_of_right : creates_limit (cospan g f) forget := -creates_limit_of_fully_faithful_of_iso - (PresheafedSpace.is_open_immersion.to_Scheme Y - (@pullback.fst LocallyRingedSpace _ _ _ _ g f _).1) - (eq_to_iso (by simp) ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) - -instance forget_preserves_of_left : preserves_limit (cospan f g) forget := -category_theory.preserves_limit_of_creates_limit_and_has_limit _ _ - -instance forget_preserves_of_right : preserves_limit (cospan g f) forget := -preserves_pullback_symmetry _ _ _ - -instance has_pullback_of_left : has_pullback f g := -has_limit_of_created (cospan f g) forget - -instance has_pullback_of_right : has_pullback g f := -has_limit_of_created (cospan g f) forget - -instance pullback_snd_of_left : is_open_immersion (pullback.snd : pullback f g ⟶ _) := -begin - have := preserves_pullback.iso_hom_snd forget f g, - dsimp only [Scheme.forget_to_LocallyRingedSpace, induced_functor_map] at this, - rw ← this, - change LocallyRingedSpace.is_open_immersion _, - apply_instance -end - -instance pullback_fst_of_right : is_open_immersion (pullback.fst : pullback g f ⟶ _) := -begin - rw ← pullback_symmetry_hom_comp_snd, - apply_instance -end - -instance pullback_one [is_open_immersion g] : - is_open_immersion (limit.π (cospan f g) walking_cospan.one) := -begin - rw ← limit.w (cospan f g) walking_cospan.hom.inl, - change is_open_immersion (_ ≫ f), - apply_instance -end - -instance forget_to_Top_preserves_of_left : - preserves_limit (cospan f g) Scheme.forget_to_Top := -begin - apply_with limits.comp_preserves_limit { instances := ff }, - apply_instance, - apply preserves_limit_of_iso_diagram _ (diagram_iso_cospan.{u} _).symm, - dsimp [LocallyRingedSpace.forget_to_Top], - apply_instance -end - -instance forget_to_Top_preserves_of_right : - preserves_limit (cospan g f) Scheme.forget_to_Top := preserves_pullback_symmetry _ _ _ - -/-- -The universal property of open immersions: -For an open immersion `f : X ⟶ Z`, given any morphism of schemes `g : Y ⟶ Z` whose topological -image is contained in the image of `f`, we can lift this morphism to a unique `Y ⟶ X` that -commutes with these maps. --/ -def lift (H' : set.range g.1.base ⊆ set.range f.1.base) : Y ⟶ X := -LocallyRingedSpace.is_open_immersion.lift f g H' - -@[simp, reassoc] lemma lift_fac (H' : set.range g.1.base ⊆ set.range f.1.base) : - lift f g H' ≫ f = g := -LocallyRingedSpace.is_open_immersion.lift_fac f g H' - -lemma lift_uniq (H' : set.range g.1.base ⊆ set.range f.1.base) (l : Y ⟶ X) - (hl : l ≫ f = g) : l = lift f g H' := -LocallyRingedSpace.is_open_immersion.lift_uniq f g H' l hl - -/-- Two open immersions with equal range is isomorphic. -/ -@[simps] def iso_of_range_eq [is_open_immersion g] (e : set.range f.1.base = set.range g.1.base) : - X ≅ Y := -{ hom := lift g f (le_of_eq e), - inv := lift f g (le_of_eq e.symm), - hom_inv_id' := by { rw ← cancel_mono f, simp }, - inv_hom_id' := by { rw ← cancel_mono g, simp } } - -end is_open_immersion - -/-- Given an open cover on `X`, we may pull them back along a morphism `W ⟶ X` to obtain -an open cover of `W`. -/ -@[simps] -def Scheme.open_cover.pullback_cover {X : Scheme} (𝒰 : X.open_cover) {W : Scheme} (f : W ⟶ X) : - W.open_cover := -{ J := 𝒰.J, - obj := λ x, pullback f (𝒰.map x), - map := λ x, pullback.fst, - f := λ x, 𝒰.f (f.1.base x), - covers := λ x, begin - rw ← (show _ = (pullback.fst : pullback f (𝒰.map (𝒰.f (f.1.base x))) ⟶ _).1.base, - from preserves_pullback.iso_hom_fst Scheme.forget_to_Top f - (𝒰.map (𝒰.f (f.1.base x)))), - rw [coe_comp, set.range_comp, set.range_iff_surjective.mpr, set.image_univ, - Top.pullback_fst_range], - obtain ⟨y, h⟩ := 𝒰.covers (f.1.base x), - exact ⟨y, h.symm⟩, - { rw ← Top.epi_iff_surjective, apply_instance } - end } - -end algebraic_geometry diff --git a/src/algebraic_geometry/open_immersion/Scheme.lean b/src/algebraic_geometry/open_immersion/Scheme.lean new file mode 100644 index 0000000000000..4b930e16e1994 --- /dev/null +++ b/src/algebraic_geometry/open_immersion/Scheme.lean @@ -0,0 +1,1048 @@ +/- +Copyright (c) 2021 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import algebraic_geometry.open_immersion.basic +import algebraic_geometry.Scheme +import category_theory.limits.shapes.comm_sq + +/-! +# Open immersions of schemes + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +noncomputable theory + +open topological_space category_theory opposite +open category_theory.limits +namespace algebraic_geometry + +universes v v₁ v₂ u + +variables {C : Type u} [category.{v} C] + +/-- +A morphism of Schemes is an open immersion if it is an open immersion as a morphism +of LocallyRingedSpaces +-/ +abbreviation is_open_immersion {X Y : Scheme} (f : X ⟶ Y) : Prop := +LocallyRingedSpace.is_open_immersion f + +namespace LocallyRingedSpace.is_open_immersion + +/-- To show that a locally ringed space is a scheme, it suffices to show that it has a jointly +surjective family of open immersions from affine schemes. -/ +protected def Scheme (X : LocallyRingedSpace) + (h : ∀ (x : X), ∃ (R : CommRing) (f : Spec.to_LocallyRingedSpace.obj (op R) ⟶ X), + (x ∈ set.range f.1.base : _) ∧ LocallyRingedSpace.is_open_immersion f) : Scheme := +{ to_LocallyRingedSpace := X, + local_affine := + begin + intro x, + obtain ⟨R, f, h₁, h₂⟩ := h x, + refine ⟨⟨⟨_, h₂.base_open.open_range⟩, h₁⟩, R, ⟨_⟩⟩, + apply LocallyRingedSpace.iso_of_SheafedSpace_iso, + refine SheafedSpace.forget_to_PresheafedSpace.preimage_iso _, + resetI, + apply PresheafedSpace.is_open_immersion.iso_of_range_eq (PresheafedSpace.of_restrict _ _) f.1, + { exact subtype.range_coe_subtype }, + { apply_instance } + end } + +end LocallyRingedSpace.is_open_immersion + +lemma is_open_immersion.open_range {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f] : + is_open (set.range f.1.base) := H.base_open.open_range + +section open_cover + +namespace Scheme + +/-- An open cover of `X` consists of a family of open immersions into `X`, +and for each `x : X` an open immersion (indexed by `f x`) that covers `x`. + +This is merely a coverage in the Zariski pretopology, and it would be optimal +if we could reuse the existing API about pretopologies, However, the definitions of sieves and +grothendieck topologies uses `Prop`s, so that the actual open sets and immersions are hard to +obtain. Also, since such a coverage in the pretopology usually contains a proper class of +immersions, it is quite hard to glue them, reason about finite covers, etc. +-/ +-- TODO: provide API to and from a presieve. +structure open_cover (X : Scheme.{u}) := +(J : Type v) +(obj : Π (j : J), Scheme) +(map : Π (j : J), obj j ⟶ X) +(f : X.carrier → J) +(covers : ∀ x, x ∈ set.range ((map (f x)).1.base)) +(is_open : ∀ x, is_open_immersion (map x) . tactic.apply_instance) + +attribute [instance] open_cover.is_open + +variables {X Y Z : Scheme.{u}} (𝒰 : open_cover X) (f : X ⟶ Z) (g : Y ⟶ Z) +variables [∀ x, has_pullback (𝒰.map x ≫ f) g] + +/-- The affine cover of a scheme. -/ +def affine_cover (X : Scheme) : open_cover X := +{ J := X.carrier, + obj := λ x, Spec.obj $ opposite.op (X.local_affine x).some_spec.some, + map := λ x, ((X.local_affine x).some_spec.some_spec.some.inv ≫ + X.to_LocallyRingedSpace.of_restrict _ : _), + f := λ x, x, + is_open := λ x, begin + apply_with PresheafedSpace.is_open_immersion.comp { instances := ff }, + apply_instance, + apply PresheafedSpace.is_open_immersion.of_restrict, + end, + covers := + begin + intro x, + erw coe_comp, + rw [set.range_comp, set.range_iff_surjective.mpr, set.image_univ], + erw subtype.range_coe_subtype, + exact (X.local_affine x).some.2, + rw ← Top.epi_iff_surjective, + change epi ((SheafedSpace.forget _).map (LocallyRingedSpace.forget_to_SheafedSpace.map _)), + apply_instance + end } + +instance : inhabited X.open_cover := ⟨X.affine_cover⟩ + +/-- Given an open cover `{ Uᵢ }` of `X`, and for each `Uᵢ` an open cover, we may combine these +open covers to form an open cover of `X`. -/ +@[simps J obj map] +def open_cover.bind (f : Π (x : 𝒰.J), open_cover (𝒰.obj x)) : open_cover X := +{ J := Σ (i : 𝒰.J), (f i).J, + obj := λ x, (f x.1).obj x.2, + map := λ x, (f x.1).map x.2 ≫ 𝒰.map x.1, + f := λ x, ⟨_, (f _).f (𝒰.covers x).some⟩, + covers := λ x, + begin + let y := (𝒰.covers x).some, + have hy : (𝒰.map (𝒰.f x)).val.base y = x := (𝒰.covers x).some_spec, + rcases (f (𝒰.f x)).covers y with ⟨z, hz⟩, + change x ∈ set.range (((f (𝒰.f x)).map ((f (𝒰.f x)).f y) ≫ 𝒰.map (𝒰.f x)).1.base), + use z, + erw comp_apply, + rw [hz, hy], + end } + +/-- An isomorphism `X ⟶ Y` is an open cover of `Y`. -/ +@[simps J obj map] +def open_cover_of_is_iso {X Y : Scheme.{u}} (f : X ⟶ Y) [is_iso f] : + open_cover Y := +{ J := punit.{v+1}, + obj := λ _, X, + map := λ _, f, + f := λ _, punit.star, + covers := λ x, by { rw set.range_iff_surjective.mpr, { trivial }, rw ← Top.epi_iff_surjective, + apply_instance } } + +/-- We construct an open cover from another, by providing the needed fields and showing that the +provided fields are isomorphic with the original open cover. -/ +@[simps J obj map] +def open_cover.copy {X : Scheme} (𝒰 : open_cover X) + (J : Type*) (obj : J → Scheme) (map : ∀ i, obj i ⟶ X) + (e₁ : J ≃ 𝒰.J) (e₂ : ∀ i, obj i ≅ 𝒰.obj (e₁ i)) + (e₂ : ∀ i, map i = (e₂ i).hom ≫ 𝒰.map (e₁ i)) : open_cover X := +{ J := J, + obj := obj, + map := map, + f := λ x, e₁.symm (𝒰.f x), + covers := λ x, begin + rw [e₂, Scheme.comp_val_base, coe_comp, set.range_comp, set.range_iff_surjective.mpr, + set.image_univ, e₁.right_inverse_symm], + { exact 𝒰.covers x }, + { rw ← Top.epi_iff_surjective, apply_instance } + end, + is_open := λ i, by { rw e₂, apply_instance } } + +/-- The pushforward of an open cover along an isomorphism. -/ +@[simps J obj map] +def open_cover.pushforward_iso {X Y : Scheme} (𝒰 : open_cover X) + (f : X ⟶ Y) [is_iso f] : + open_cover Y := +((open_cover_of_is_iso f).bind (λ _, 𝒰)).copy 𝒰.J _ _ + ((equiv.punit_prod _).symm.trans (equiv.sigma_equiv_prod punit 𝒰.J).symm) + (λ _, iso.refl _) + (λ _, (category.id_comp _).symm) + +/-- Adding an open immersion into an open cover gives another open cover. -/ +@[simps] +def open_cover.add {X : Scheme} (𝒰 : X.open_cover) {Y : Scheme} (f : Y ⟶ X) + [is_open_immersion f] : X.open_cover := +{ J := option 𝒰.J, + obj := λ i, option.rec Y 𝒰.obj i, + map := λ i, option.rec f 𝒰.map i, + f := λ x, some (𝒰.f x), + covers := 𝒰.covers, + is_open := by rintro (_|_); dsimp; apply_instance } + +-- Related result : `open_cover.pullback_cover`, where we pullback an open cover on `X` along a +-- morphism `W ⟶ X`. This is provided at the end of the file since it needs some more results +-- about open immersion (which in turn needs the open cover API). + +local attribute [reducible] CommRing.of CommRing.of_hom + +instance val_base_is_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] : is_iso f.1.base := +Scheme.forget_to_Top.map_is_iso f + +instance basic_open_is_open_immersion {R : CommRing} (f : R) : +algebraic_geometry.is_open_immersion (Scheme.Spec.map (CommRing.of_hom + (algebra_map R (localization.away f))).op) := +begin + apply_with SheafedSpace.is_open_immersion.of_stalk_iso { instances := ff }, + any_goals { apply_instance }, + any_goals { apply_instance }, + exact (prime_spectrum.localization_away_open_embedding (localization.away f) f : _), + intro x, + exact Spec_map_localization_is_iso R (submonoid.powers f) x, +end + +/-- The basic open sets form an affine open cover of `Spec R`. -/ +def affine_basis_cover_of_affine (R : CommRing) : open_cover (Spec.obj (opposite.op R)) := +{ J := R, + obj := λ r, Spec.obj (opposite.op $ CommRing.of $ localization.away r), + map := λ r, Spec.map (quiver.hom.op (algebra_map R (localization.away r) : _)), + f := λ x, 1, + covers := λ r, + begin + rw set.range_iff_surjective.mpr ((Top.epi_iff_surjective _).mp _), + { exact trivial }, + { apply_instance } + end, + is_open := λ x, algebraic_geometry.Scheme.basic_open_is_open_immersion x } + +/-- We may bind the basic open sets of an open affine cover to form a affine cover that is also +a basis. -/ +def affine_basis_cover (X : Scheme) : open_cover X := +X.affine_cover.bind (λ x, affine_basis_cover_of_affine _) + +/-- The coordinate ring of a component in the `affine_basis_cover`. -/ +def affine_basis_cover_ring (X : Scheme) (i : X.affine_basis_cover.J) : CommRing := +CommRing.of $ @localization.away (X.local_affine i.1).some_spec.some _ i.2 + +lemma affine_basis_cover_obj (X : Scheme) (i : X.affine_basis_cover.J) : + X.affine_basis_cover.obj i = Spec.obj (op $ X.affine_basis_cover_ring i) := rfl + +lemma affine_basis_cover_map_range (X : Scheme) + (x : X.carrier) (r : (X.local_affine x).some_spec.some) : + set.range (X.affine_basis_cover.map ⟨x, r⟩).1.base = + (X.affine_cover.map x).1.base '' (prime_spectrum.basic_open r).1 := +begin + erw [coe_comp, set.range_comp], + congr, + exact (prime_spectrum.localization_away_comap_range (localization.away r) r : _) +end + +lemma affine_basis_cover_is_basis (X : Scheme) : + topological_space.is_topological_basis + { x : set X.carrier | ∃ a : X.affine_basis_cover.J, x = + set.range ((X.affine_basis_cover.map a).1.base) } := +begin + apply topological_space.is_topological_basis_of_open_of_nhds, + { rintros _ ⟨a, rfl⟩, + exact is_open_immersion.open_range (X.affine_basis_cover.map a) }, + { rintros a U haU hU, + rcases X.affine_cover.covers a with ⟨x, e⟩, + let U' := (X.affine_cover.map (X.affine_cover.f a)).1.base ⁻¹' U, + have hxU' : x ∈ U' := by { rw ← e at haU, exact haU }, + rcases prime_spectrum.is_basis_basic_opens.exists_subset_of_mem_open hxU' + ((X.affine_cover.map (X.affine_cover.f a)).1.base.continuous_to_fun.is_open_preimage _ hU) + with ⟨_,⟨_,⟨s,rfl⟩,rfl⟩,hxV,hVU⟩, + refine ⟨_,⟨⟨_,s⟩,rfl⟩,_,_⟩; erw affine_basis_cover_map_range, + { exact ⟨x,hxV,e⟩ }, + { rw set.image_subset_iff, exact hVU } } +end + +/-- +Every open cover of a quasi-compact scheme can be refined into a finite subcover. +-/ +@[simps obj map] +def open_cover.finite_subcover {X : Scheme} (𝒰 : open_cover X) [H : compact_space X.carrier] : + open_cover X := +begin + have := @@compact_space.elim_nhds_subcover _ H + (λ (x : X.carrier), set.range ((𝒰.map (𝒰.f x)).1.base)) + (λ x, (is_open_immersion.open_range (𝒰.map (𝒰.f x))).mem_nhds (𝒰.covers x)), + let t := this.some, + have h : ∀ (x : X.carrier), ∃ (y : t), x ∈ set.range ((𝒰.map (𝒰.f y)).1.base), + { intro x, + have h' : x ∈ (⊤ : set X.carrier) := trivial, + rw [← classical.some_spec this, set.mem_Union] at h', + rcases h' with ⟨y,_,⟨hy,rfl⟩,hy'⟩, + exact ⟨⟨y,hy⟩,hy'⟩ }, + exact + { J := t, + obj := λ x, 𝒰.obj (𝒰.f x.1), + map := λ x, 𝒰.map (𝒰.f x.1), + f := λ x, (h x).some, + covers := λ x, (h x).some_spec } +end + +instance [H : compact_space X.carrier] : fintype 𝒰.finite_subcover.J := +by { delta open_cover.finite_subcover, apply_instance } + +end Scheme + +end open_cover + +namespace PresheafedSpace.is_open_immersion + +section to_Scheme + +variables {X : PresheafedSpace.{u} CommRing.{u}} (Y : Scheme.{u}) +variables (f : X ⟶ Y.to_PresheafedSpace) [H : PresheafedSpace.is_open_immersion f] + +include H + +/-- If `X ⟶ Y` is an open immersion, and `Y` is a scheme, then so is `X`. -/ +def to_Scheme : Scheme := +begin + apply LocallyRingedSpace.is_open_immersion.Scheme (to_LocallyRingedSpace _ f), + intro x, + obtain ⟨_,⟨i,rfl⟩,hx,hi⟩ := Y.affine_basis_cover_is_basis.exists_subset_of_mem_open + (set.mem_range_self x) H.base_open.open_range, + use Y.affine_basis_cover_ring i, + use LocallyRingedSpace.is_open_immersion.lift (to_LocallyRingedSpace_hom _ f) _ hi, + split, + { rw LocallyRingedSpace.is_open_immersion.lift_range, exact hx }, + { delta LocallyRingedSpace.is_open_immersion.lift, apply_instance } +end + +@[simp] lemma to_Scheme_to_LocallyRingedSpace : + (to_Scheme Y f).to_LocallyRingedSpace = (to_LocallyRingedSpace Y.1 f) := rfl + +/-- +If `X ⟶ Y` is an open immersion of PresheafedSpaces, and `Y` is a Scheme, we can +upgrade it into a morphism of Schemes. +-/ +def to_Scheme_hom : to_Scheme Y f ⟶ Y := to_LocallyRingedSpace_hom _ f + +@[simp] lemma to_Scheme_hom_val : + (to_Scheme_hom Y f).val = f := rfl + +instance to_Scheme_hom_is_open_immersion : + is_open_immersion (to_Scheme_hom Y f) := H + +omit H + +lemma Scheme_eq_of_LocallyRingedSpace_eq {X Y : Scheme} + (H : X.to_LocallyRingedSpace = Y.to_LocallyRingedSpace) : X = Y := +by { cases X, cases Y, congr, exact H } + +lemma Scheme_to_Scheme {X Y : Scheme} (f : X ⟶ Y) [is_open_immersion f] : + to_Scheme Y f.1 = X := +begin + apply Scheme_eq_of_LocallyRingedSpace_eq, + exact LocallyRingedSpace_to_LocallyRingedSpace f +end + +end to_Scheme + +end PresheafedSpace.is_open_immersion + +/-- The restriction of a Scheme along an open embedding. -/ +@[simps] +def Scheme.restrict {U : Top} (X : Scheme) {f : U ⟶ Top.of X.carrier} (h : open_embedding f) : + Scheme := +{ to_PresheafedSpace := X.to_PresheafedSpace.restrict h, + ..(PresheafedSpace.is_open_immersion.to_Scheme X (X.to_PresheafedSpace.of_restrict h)) } + +/-- The canonical map from the restriction to the supspace. -/ +@[simps] +def Scheme.of_restrict {U : Top} (X : Scheme) {f : U ⟶ Top.of X.carrier} (h : open_embedding f) : + X.restrict h ⟶ X := +X.to_LocallyRingedSpace.of_restrict h + +instance is_open_immersion.of_restrict {U : Top} (X : Scheme) {f : U ⟶ Top.of X.carrier} + (h : open_embedding f) : is_open_immersion (X.of_restrict h) := +show PresheafedSpace.is_open_immersion (X.to_PresheafedSpace.of_restrict h), by apply_instance + +namespace is_open_immersion + +variables {X Y Z : Scheme.{u}} (f : X ⟶ Z) (g : Y ⟶ Z) +variable [H : is_open_immersion f] + +@[priority 100] +instance of_is_iso [is_iso g] : + is_open_immersion g := @@LocallyRingedSpace.is_open_immersion.of_is_iso _ +(show is_iso ((induced_functor _).map g), by apply_instance) + +lemma to_iso {X Y : Scheme} (f : X ⟶ Y) [h : is_open_immersion f] + [epi f.1.base] : is_iso f := +@@is_iso_of_reflects_iso _ _ f (Scheme.forget_to_LocallyRingedSpace ⋙ + LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) + (@@PresheafedSpace.is_open_immersion.to_iso _ f.1 h _) _ + +lemma of_stalk_iso {X Y : Scheme} (f : X ⟶ Y) (hf : open_embedding f.1.base) + [∀ x, is_iso (PresheafedSpace.stalk_map f.1 x)] : is_open_immersion f := +SheafedSpace.is_open_immersion.of_stalk_iso f.1 hf + +lemma iff_stalk_iso {X Y : Scheme} (f : X ⟶ Y) : + is_open_immersion f ↔ open_embedding f.1.base ∧ ∀ x, is_iso (PresheafedSpace.stalk_map f.1 x) := +⟨λ H, ⟨H.1, by exactI infer_instance⟩, λ ⟨h₁, h₂⟩, @@is_open_immersion.of_stalk_iso f h₁ h₂⟩ + +lemma _root_.algebraic_geometry.is_iso_iff_is_open_immersion {X Y : Scheme} (f : X ⟶ Y) : + is_iso f ↔ is_open_immersion f ∧ epi f.1.base := +⟨λ H, by exactI ⟨infer_instance, infer_instance⟩, λ ⟨h₁, h₂⟩, @@is_open_immersion.to_iso f h₁ h₂⟩ + +lemma _root_.algebraic_geometry.is_iso_iff_stalk_iso {X Y : Scheme} (f : X ⟶ Y) : + is_iso f ↔ is_iso f.1.base ∧ ∀ x, is_iso (PresheafedSpace.stalk_map f.1 x) := +begin + rw [is_iso_iff_is_open_immersion, is_open_immersion.iff_stalk_iso, and_comm, ← and_assoc], + refine and_congr ⟨_, _⟩ iff.rfl, + { rintro ⟨h₁, h₂⟩, + convert_to is_iso (Top.iso_of_homeo (homeomorph.homeomorph_of_continuous_open + (equiv.of_bijective _ ⟨h₂.inj, (Top.epi_iff_surjective _).mp h₁⟩) + h₂.continuous h₂.is_open_map)).hom, + { ext, refl }, + { apply_instance } }, + { intro H, exactI ⟨infer_instance, (Top.homeo_of_iso (as_iso f.1.base)).open_embedding⟩ } +end + +/-- A open immersion induces an isomorphism from the domain onto the image -/ +def iso_restrict : X ≅ (Z.restrict H.base_open : _) := +⟨H.iso_restrict.hom, H.iso_restrict.inv, H.iso_restrict.hom_inv_id, H.iso_restrict.inv_hom_id⟩ + +include H + +local notation `forget` := Scheme.forget_to_LocallyRingedSpace + +instance mono : mono f := +(induced_functor _).mono_of_mono_map (show @mono LocallyRingedSpace _ _ _ f, by apply_instance) + +instance forget_map_is_open_immersion : LocallyRingedSpace.is_open_immersion (forget .map f) := +⟨H.base_open, H.c_iso⟩ + +instance has_limit_cospan_forget_of_left : + has_limit (cospan f g ⋙ Scheme.forget_to_LocallyRingedSpace) := +begin + apply has_limit_of_iso (diagram_iso_cospan.{u} _).symm, + change has_limit (cospan (forget .map f) (forget .map g)), + apply_instance +end + +open category_theory.limits.walking_cospan + +instance has_limit_cospan_forget_of_left' : + has_limit (cospan ((cospan f g ⋙ forget).map hom.inl) + ((cospan f g ⋙ forget).map hom.inr)) := +show has_limit (cospan (forget .map f) (forget .map g)), from infer_instance + +instance has_limit_cospan_forget_of_right : has_limit (cospan g f ⋙ forget) := +begin + apply has_limit_of_iso (diagram_iso_cospan.{u} _).symm, + change has_limit (cospan (forget .map g) (forget .map f)), + apply_instance +end + +instance has_limit_cospan_forget_of_right' : + has_limit (cospan ((cospan g f ⋙ forget).map hom.inl) + ((cospan g f ⋙ forget).map hom.inr)) := +show has_limit (cospan (forget .map g) (forget .map f)), from infer_instance + +instance forget_creates_pullback_of_left : creates_limit (cospan f g) forget := +creates_limit_of_fully_faithful_of_iso + (PresheafedSpace.is_open_immersion.to_Scheme Y + (@pullback.snd LocallyRingedSpace _ _ _ _ f g _).1) + (eq_to_iso (by simp) ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) + +instance forget_creates_pullback_of_right : creates_limit (cospan g f) forget := +creates_limit_of_fully_faithful_of_iso + (PresheafedSpace.is_open_immersion.to_Scheme Y + (@pullback.fst LocallyRingedSpace _ _ _ _ g f _).1) + (eq_to_iso (by simp) ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) + +instance forget_preserves_of_left : preserves_limit (cospan f g) forget := +category_theory.preserves_limit_of_creates_limit_and_has_limit _ _ + +instance forget_preserves_of_right : preserves_limit (cospan g f) forget := +preserves_pullback_symmetry _ _ _ + +instance has_pullback_of_left : has_pullback f g := +has_limit_of_created (cospan f g) forget + +instance has_pullback_of_right : has_pullback g f := +has_limit_of_created (cospan g f) forget + +instance pullback_snd_of_left : is_open_immersion (pullback.snd : pullback f g ⟶ _) := +begin + have := preserves_pullback.iso_hom_snd forget f g, + dsimp only [Scheme.forget_to_LocallyRingedSpace, induced_functor_map] at this, + rw ← this, + change LocallyRingedSpace.is_open_immersion _, + apply_instance +end + +instance pullback_fst_of_right : is_open_immersion (pullback.fst : pullback g f ⟶ _) := +begin + rw ← pullback_symmetry_hom_comp_snd, + apply_instance +end + +instance pullback_to_base [is_open_immersion g] : + is_open_immersion (limit.π (cospan f g) walking_cospan.one) := +begin + rw ← limit.w (cospan f g) walking_cospan.hom.inl, + change is_open_immersion (_ ≫ f), + apply_instance +end + +instance forget_to_Top_preserves_of_left : + preserves_limit (cospan f g) Scheme.forget_to_Top := +begin + apply_with limits.comp_preserves_limit { instances := ff }, + apply_instance, + apply preserves_limit_of_iso_diagram _ (diagram_iso_cospan.{u} _).symm, + dsimp [LocallyRingedSpace.forget_to_Top], + apply_instance +end + +instance forget_to_Top_preserves_of_right : + preserves_limit (cospan g f) Scheme.forget_to_Top := preserves_pullback_symmetry _ _ _ + +lemma range_pullback_snd_of_left : + set.range (pullback.snd : pullback f g ⟶ Y).1.base = + (opens.map g.1.base).obj ⟨set.range f.1.base, H.base_open.open_range⟩ := +begin + rw [← (show _ = (pullback.snd : pullback f g ⟶ _).1.base, + from preserves_pullback.iso_hom_snd Scheme.forget_to_Top f g), coe_comp, set.range_comp, + set.range_iff_surjective.mpr, + ← @set.preimage_univ _ _ (pullback.fst : pullback f.1.base g.1.base ⟶ _), + Top.pullback_snd_image_fst_preimage, set.image_univ], + refl, + rw ← Top.epi_iff_surjective, + apply_instance +end + +lemma range_pullback_fst_of_right : + set.range (pullback.fst : pullback g f ⟶ Y).1.base = + (opens.map g.1.base).obj ⟨set.range f.1.base, H.base_open.open_range⟩ := +begin + rw [← (show _ = (pullback.fst : pullback g f ⟶ _).1.base, + from preserves_pullback.iso_hom_fst Scheme.forget_to_Top g f), coe_comp, set.range_comp, + set.range_iff_surjective.mpr, + ← @set.preimage_univ _ _ (pullback.snd : pullback g.1.base f.1.base ⟶ _), + Top.pullback_fst_image_snd_preimage, set.image_univ], + refl, + rw ← Top.epi_iff_surjective, + apply_instance +end + +lemma range_pullback_to_base_of_left : + set.range (pullback.fst ≫ f : pullback f g ⟶ Z).1.base = + set.range f.1.base ∩ set.range g.1.base := +begin + rw [pullback.condition, Scheme.comp_val_base, coe_comp, set.range_comp, + range_pullback_snd_of_left, opens.map_obj, opens.coe_mk, set.image_preimage_eq_inter_range, + set.inter_comm], +end + +lemma range_pullback_to_base_of_right : + set.range (pullback.fst ≫ g : pullback g f ⟶ Z).1.base = + set.range g.1.base ∩ set.range f.1.base := +begin + rw [Scheme.comp_val_base, coe_comp, set.range_comp, range_pullback_fst_of_right, opens.map_obj, + opens.coe_mk, set.image_preimage_eq_inter_range, set.inter_comm], +end + +/-- +The universal property of open immersions: +For an open immersion `f : X ⟶ Z`, given any morphism of schemes `g : Y ⟶ Z` whose topological +image is contained in the image of `f`, we can lift this morphism to a unique `Y ⟶ X` that +commutes with these maps. +-/ +def lift (H' : set.range g.1.base ⊆ set.range f.1.base) : Y ⟶ X := +LocallyRingedSpace.is_open_immersion.lift f g H' + +@[simp, reassoc] lemma lift_fac (H' : set.range g.1.base ⊆ set.range f.1.base) : + lift f g H' ≫ f = g := +LocallyRingedSpace.is_open_immersion.lift_fac f g H' + +lemma lift_uniq (H' : set.range g.1.base ⊆ set.range f.1.base) (l : Y ⟶ X) + (hl : l ≫ f = g) : l = lift f g H' := +LocallyRingedSpace.is_open_immersion.lift_uniq f g H' l hl + +/-- Two open immersions with equal range are isomorphic. -/ +@[simps] def iso_of_range_eq [is_open_immersion g] (e : set.range f.1.base = set.range g.1.base) : + X ≅ Y := +{ hom := lift g f (le_of_eq e), + inv := lift f g (le_of_eq e.symm), + hom_inv_id' := by { rw ← cancel_mono f, simp }, + inv_hom_id' := by { rw ← cancel_mono g, simp } } + +/-- The functor `opens X ⥤ opens Y` associated with an open immersion `f : X ⟶ Y`. -/ +abbreviation _root_.algebraic_geometry.Scheme.hom.opens_functor {X Y : Scheme} (f : X ⟶ Y) + [H : is_open_immersion f] : + opens X.carrier ⥤ opens Y.carrier := +H.open_functor + +/-- The isomorphism `Γ(X, U) ⟶ Γ(Y, f(U))` induced by an open immersion `f : X ⟶ Y`. -/ +def _root_.algebraic_geometry.Scheme.hom.inv_app {X Y : Scheme} (f : X ⟶ Y) + [H : is_open_immersion f] (U) : + X.presheaf.obj (op U) ⟶ Y.presheaf.obj (op (f.opens_functor.obj U)) := +H.inv_app U + +lemma app_eq_inv_app_app_of_comp_eq_aux {X Y U : Scheme} (f : Y ⟶ U) (g : U ⟶ X) + (fg : Y ⟶ X) (H : fg = f ≫ g) [h : is_open_immersion g] (V : opens U.carrier) : + (opens.map f.1.base).obj V = (opens.map fg.1.base).obj (g.opens_functor.obj V) := +begin + subst H, + rw [Scheme.comp_val_base, opens.map_comp_obj], + congr' 1, + ext1, + exact (set.preimage_image_eq _ h.base_open.inj).symm +end + +/-- The `fg` argument is to avoid nasty stuff about dependent types. -/ +lemma app_eq_inv_app_app_of_comp_eq {X Y U : Scheme} (f : Y ⟶ U) (g : U ⟶ X) + (fg : Y ⟶ X) (H : fg = f ≫ g) [h : is_open_immersion g] (V : opens U.carrier) : + f.1.c.app (op V) = g.inv_app _ ≫ fg.1.c.app _ ≫ Y.presheaf.map (eq_to_hom $ + is_open_immersion.app_eq_inv_app_app_of_comp_eq_aux f g fg H V).op := +begin + subst H, + rw [Scheme.comp_val_c_app, category.assoc, Scheme.hom.inv_app, + PresheafedSpace.is_open_immersion.inv_app_app_assoc, + f.val.c.naturality_assoc, Top.presheaf.pushforward_obj_map, ← functor.map_comp], + convert (category.comp_id _).symm, + convert Y.presheaf.map_id _, +end + +lemma lift_app {X Y U : Scheme} (f : U ⟶ Y) (g : X ⟶ Y) + [h : is_open_immersion f] (H) (V : opens U.carrier) : + (is_open_immersion.lift f g H).1.c.app (op V) = f.inv_app _ ≫ g.1.c.app _ ≫ + X.presheaf.map (eq_to_hom $ is_open_immersion.app_eq_inv_app_app_of_comp_eq_aux _ _ _ + (is_open_immersion.lift_fac f g H).symm V).op := +is_open_immersion.app_eq_inv_app_app_of_comp_eq _ _ _ _ _ + +end is_open_immersion + +namespace Scheme + +lemma image_basic_open {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f] + {U : opens X.carrier} (r : X.presheaf.obj (op U)) : + f.opens_functor.obj (X.basic_open r) = Y.basic_open (f.inv_app U r) := +begin + have e := Scheme.preimage_basic_open f (f.inv_app U r), + rw [Scheme.hom.inv_app, PresheafedSpace.is_open_immersion.inv_app_app_apply, + Scheme.basic_open_res, inf_eq_right.mpr _] at e, + rw ← e, + ext1, + refine set.image_preimage_eq_inter_range.trans _, + erw set.inter_eq_left_iff_subset, + refine set.subset.trans (Scheme.basic_open_le _ _) (set.image_subset_range _ _), + refine le_trans (Scheme.basic_open_le _ _) (le_of_eq _), + ext1, + exact (set.preimage_image_eq _ H.base_open.inj).symm +end + +/-- The image of an open immersion as an open set. -/ +@[simps] +def hom.opens_range {X Y : Scheme} (f : X ⟶ Y) [H : is_open_immersion f] : opens Y.carrier := +⟨_, H.base_open.open_range⟩ + +end Scheme + +section + +variable (X : Scheme) + +/-- The functor taking open subsets of `X` to open subschemes of `X`. -/ +@[simps obj_left obj_hom map_left] +def Scheme.restrict_functor : opens X.carrier ⥤ over X := +{ obj := λ U, over.mk (X.of_restrict U.open_embedding), + map := λ U V i, over.hom_mk (is_open_immersion.lift (X.of_restrict _) (X.of_restrict _) + (by { change set.range coe ⊆ set.range coe, simp_rw [subtype.range_coe], exact i.le })) + (is_open_immersion.lift_fac _ _ _), + map_id' := λ U, by begin + ext1, + dsimp only [over.hom_mk_left, over.id_left], + rw [← cancel_mono (X.of_restrict U.open_embedding), category.id_comp, + is_open_immersion.lift_fac], + end, + map_comp' := λ U V W i j, begin + ext1, + dsimp only [over.hom_mk_left, over.comp_left], + rw [← cancel_mono (X.of_restrict W.open_embedding), category.assoc], + iterate 3 { rw [is_open_immersion.lift_fac] } + end } + +@[reassoc] +lemma Scheme.restrict_functor_map_of_restrict {U V : opens X.carrier} (i : U ⟶ V) : + (X.restrict_functor.map i).1 ≫ X.of_restrict _ = X.of_restrict _ := +is_open_immersion.lift_fac _ _ _ + +lemma Scheme.restrict_functor_map_base {U V : opens X.carrier} (i : U ⟶ V) : + (X.restrict_functor.map i).1.1.base = (opens.to_Top _).map i := +begin + ext a, + exact (congr_arg (λ f : X.restrict U.open_embedding ⟶ X, by exact f.1.base a) + (X.restrict_functor_map_of_restrict i) : _), +end + +lemma Scheme.restrict_functor_map_app_aux {U V : opens X.carrier} (i : U ⟶ V) (W : opens V) : + U.open_embedding.is_open_map.functor.obj + ((opens.map (X.restrict_functor.map i).1.val.base).obj W) ≤ + V.open_embedding.is_open_map.functor.obj W := +begin + simp only [← set_like.coe_subset_coe, is_open_map.functor_obj_coe, set.image_subset_iff, + Scheme.restrict_functor_map_base, opens.map_coe, opens.inclusion_apply], + rintros _ h, + exact ⟨_, h, rfl⟩, +end + +lemma Scheme.restrict_functor_map_app {U V : opens X.carrier} (i : U ⟶ V) (W : opens V) : + (X.restrict_functor.map i).1.1.c.app (op W) = X.presheaf.map + (hom_of_le $ X.restrict_functor_map_app_aux i W).op := +begin + have e₁ := Scheme.congr_app (X.restrict_functor_map_of_restrict i) + (op $ V.open_embedding.is_open_map.functor.obj W), + rw Scheme.comp_val_c_app at e₁, + have e₂ := (X.restrict_functor.map i).1.val.c.naturality (eq_to_hom W.map_functor_eq).op, + rw ← is_iso.eq_inv_comp at e₂, + dsimp at e₁ e₂ ⊢, + rw [e₂, W.adjunction_counit_map_functor, ← is_iso.eq_inv_comp, is_iso.inv_comp_eq, + ← is_iso.eq_comp_inv] at e₁, + simp_rw [eq_to_hom_map (opens.map _), eq_to_hom_map (is_open_map.functor _), ← functor.map_inv, + ← functor.map_comp] at e₁, + rw e₁, + congr' 1, +end + +/-- The functor that restricts to open subschemes and then takes global section is +isomorphic to the structure sheaf. -/ +@[simps] +def Scheme.restrict_functor_Γ : + X.restrict_functor.op ⋙ (over.forget X).op ⋙ Scheme.Γ ≅ X.presheaf := +nat_iso.of_components + (λ U, X.presheaf.map_iso ((eq_to_iso (unop U).open_embedding_obj_top).symm.op : _)) +begin + intros U V i, + dsimp [-subtype.val_eq_coe, -Scheme.restrict_functor_map_left], + rw [X.restrict_functor_map_app, ← functor.map_comp, ← functor.map_comp], + congr' 1 +end + +end + +/-- The restriction of an isomorphism onto an open set. -/ +noncomputable +abbreviation Scheme.restrict_map_iso {X Y : Scheme} (f : X ⟶ Y) [is_iso f] (U : opens Y.carrier) : + X.restrict ((opens.map f.1.base).obj U).open_embedding ≅ Y.restrict U.open_embedding := +begin + refine is_open_immersion.iso_of_range_eq (X.of_restrict _ ≫ f) (Y.of_restrict _) _, + dsimp [opens.inclusion], + rw [coe_comp, set.range_comp], + dsimp, + rw [subtype.range_coe, subtype.range_coe], + refine @set.image_preimage_eq _ _ f.1.base U.1 _, + rw ← Top.epi_iff_surjective, + apply_instance +end + +/-- Given an open cover on `X`, we may pull them back along a morphism `W ⟶ X` to obtain +an open cover of `W`. -/ +@[simps] +def Scheme.open_cover.pullback_cover {X : Scheme} (𝒰 : X.open_cover) {W : Scheme} (f : W ⟶ X) : + W.open_cover := +{ J := 𝒰.J, + obj := λ x, pullback f (𝒰.map x), + map := λ x, pullback.fst, + f := λ x, 𝒰.f (f.1.base x), + covers := λ x, begin + rw ← (show _ = (pullback.fst : pullback f (𝒰.map (𝒰.f (f.1.base x))) ⟶ _).1.base, + from preserves_pullback.iso_hom_fst Scheme.forget_to_Top f + (𝒰.map (𝒰.f (f.1.base x)))), + rw [coe_comp, set.range_comp, set.range_iff_surjective.mpr, set.image_univ, + Top.pullback_fst_range], + obtain ⟨y, h⟩ := 𝒰.covers (f.1.base x), + exact ⟨y, h.symm⟩, + { rw ← Top.epi_iff_surjective, apply_instance } + end } + +lemma Scheme.open_cover.Union_range {X : Scheme} (𝒰 : X.open_cover) : + (⋃ i, set.range (𝒰.map i).1.base) = set.univ := +begin + rw set.eq_univ_iff_forall, + intros x, + rw set.mem_Union, + exact ⟨𝒰.f x, 𝒰.covers x⟩ +end + +lemma Scheme.open_cover.supr_opens_range {X : Scheme} (𝒰 : X.open_cover) : +(⨆ i, (𝒰.map i).opens_range) = ⊤ := +opens.ext $ by { rw opens.coe_supr, exact 𝒰.Union_range } + +lemma Scheme.open_cover.compact_space {X : Scheme} (𝒰 : X.open_cover) [finite 𝒰.J] + [H : ∀ i, compact_space (𝒰.obj i).carrier] : compact_space X.carrier := +begin + casesI nonempty_fintype 𝒰.J, + rw [← is_compact_univ_iff, ← 𝒰.Union_range], + apply is_compact_Union, + intro i, + rw is_compact_iff_compact_space, + exact @@homeomorph.compact_space _ _ (H i) + (Top.homeo_of_iso (as_iso (is_open_immersion.iso_of_range_eq (𝒰.map i) + (X.of_restrict (opens.open_embedding ⟨_, (𝒰.is_open i).base_open.open_range⟩)) + subtype.range_coe.symm).hom.1.base)) +end + +/-- Given open covers `{ Uᵢ }` and `{ Uⱼ }`, we may form the open cover `{ Uᵢ ∩ Uⱼ }`. -/ +def Scheme.open_cover.inter {X : Scheme.{u}} (𝒰₁ : Scheme.open_cover.{v₁} X) + (𝒰₂ : Scheme.open_cover.{v₂} X) : X.open_cover := +{ J := 𝒰₁.J × 𝒰₂.J, + obj := λ ij, pullback (𝒰₁.map ij.1) (𝒰₂.map ij.2), + map := λ ij, pullback.fst ≫ 𝒰₁.map ij.1, + f := λ x, ⟨𝒰₁.f x, 𝒰₂.f x⟩, + covers := λ x, by { rw is_open_immersion.range_pullback_to_base_of_left, + exact ⟨𝒰₁.covers x, 𝒰₂.covers x⟩ } } + +/-- If `U` is a family of open sets that covers `X`, then `X.restrict U` forms an `X.open_cover`. -/ +@[simps J obj map] +def Scheme.open_cover_of_supr_eq_top {s : Type*} (X : Scheme) (U : s → opens X.carrier) + (hU : (⨆ i, U i) = ⊤) : X.open_cover := +{ J := s, + obj := λ i, X.restrict (U i).open_embedding, + map := λ i, X.of_restrict (U i).open_embedding, + f := λ x, begin + have : x ∈ ⨆ i, U i := hU.symm ▸ (show x ∈ (⊤ : opens X.carrier), by triv), + exact (opens.mem_supr.mp this).some, + end, + covers := λ x, begin + erw subtype.range_coe, + have : x ∈ ⨆ i, U i := hU.symm ▸ (show x ∈ (⊤ : opens X.carrier), by triv), + exact (opens.mem_supr.mp this).some_spec, + end } + +section morphism_restrict + +/-- Given a morphism `f : X ⟶ Y` and an open set `U ⊆ Y`, we have `X ×[Y] U ≅ X |_{f ⁻¹ U}` -/ +def pullback_restrict_iso_restrict {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + pullback f (Y.of_restrict U.open_embedding) ≅ + X.restrict ((opens.map f.1.base).obj U).open_embedding := +begin + refine is_open_immersion.iso_of_range_eq pullback.fst (X.of_restrict _) _, + rw is_open_immersion.range_pullback_fst_of_right, + dsimp [opens.inclusion], + rw [subtype.range_coe, subtype.range_coe], + refl, +end + +@[simp, reassoc] +lemma pullback_restrict_iso_restrict_inv_fst {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + (pullback_restrict_iso_restrict f U).inv ≫ pullback.fst = X.of_restrict _ := +by { delta pullback_restrict_iso_restrict, simp } + +@[simp, reassoc] +lemma pullback_restrict_iso_restrict_hom_restrict {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + (pullback_restrict_iso_restrict f U).hom ≫ X.of_restrict _ = pullback.fst := +by { delta pullback_restrict_iso_restrict, simp } + +/-- The restriction of a morphism `X ⟶ Y` onto `X |_{f ⁻¹ U} ⟶ Y |_ U`. -/ +def morphism_restrict {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + X.restrict ((opens.map f.1.base).obj U).open_embedding ⟶ Y.restrict U.open_embedding := +(pullback_restrict_iso_restrict f U).inv ≫ pullback.snd + +infix ` ∣_ `: 80 := morphism_restrict + +@[simp, reassoc] +lemma pullback_restrict_iso_restrict_hom_morphism_restrict {X Y : Scheme} (f : X ⟶ Y) + (U : opens Y.carrier) : + (pullback_restrict_iso_restrict f U).hom ≫ f ∣_ U = pullback.snd := +iso.hom_inv_id_assoc _ _ + +@[simp, reassoc] +lemma morphism_restrict_ι {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + f ∣_ U ≫ Y.of_restrict U.open_embedding = X.of_restrict _ ≫ f := +by { delta morphism_restrict, + rw [category.assoc, pullback.condition.symm, pullback_restrict_iso_restrict_inv_fst_assoc] } + +lemma is_pullback_morphism_restrict {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + is_pullback (f ∣_ U) (X.of_restrict _) (Y.of_restrict _) f := +begin + delta morphism_restrict, + nth_rewrite 0 ← category.id_comp f, + refine (is_pullback.of_horiz_is_iso ⟨_⟩).paste_horiz + (is_pullback.of_has_pullback f (Y.of_restrict U.open_embedding)).flip, + rw [pullback_restrict_iso_restrict_inv_fst, category.comp_id], +end + +lemma morphism_restrict_comp {X Y Z : Scheme} (f : X ⟶ Y) (g : Y ⟶ Z) (U : opens Z.carrier) : + (f ≫ g) ∣_ U = (f ∣_ ((opens.map g.val.base).obj U) ≫ g ∣_ U : _) := +begin + delta morphism_restrict, + rw ← pullback_right_pullback_fst_iso_inv_snd_snd, + simp_rw ← category.assoc, + congr' 1, + rw ← cancel_mono pullback.fst, + simp_rw category.assoc, + rw [pullback_restrict_iso_restrict_inv_fst, pullback_right_pullback_fst_iso_inv_snd_fst, + ← pullback.condition, pullback_restrict_iso_restrict_inv_fst_assoc, + pullback_restrict_iso_restrict_inv_fst_assoc], + refl, + apply_instance +end + +instance {X Y : Scheme} (f : X ⟶ Y) [is_iso f] (U : opens Y.carrier) : is_iso (f ∣_ U) := +by { delta morphism_restrict, apply_instance } + +lemma morphism_restrict_base_coe {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) (x) : + @coe U Y.carrier _ ((f ∣_ U).1.base x) = f.1.base x.1 := +congr_arg (λ f, PresheafedSpace.hom.base (LocallyRingedSpace.hom.val f) x) (morphism_restrict_ι f U) + +lemma morphism_restrict_val_base {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + ⇑(f ∣_ U).1.base = U.1.restrict_preimage f.1.base := +funext (λ x, subtype.ext (morphism_restrict_base_coe f U x)) + +lemma image_morphism_restrict_preimage {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) + (V : opens U) : + ((opens.map f.val.base).obj U).open_embedding.is_open_map.functor.obj + ((opens.map (f ∣_ U).val.base).obj V) = + (opens.map f.val.base).obj (U.open_embedding.is_open_map.functor.obj V) := +begin + ext1, + ext x, + split, + { rintro ⟨⟨x, hx⟩, (hx' : (f ∣_ U).1.base _ ∈ _), rfl⟩, + refine ⟨⟨_, hx⟩, _, rfl⟩, + convert hx', + ext1, + exact (morphism_restrict_base_coe f U ⟨x, hx⟩).symm }, + { rintro ⟨⟨x, hx⟩, hx', (rfl : x = _)⟩, + refine ⟨⟨_, hx⟩, (_: ((f ∣_ U).1.base ⟨x, hx⟩) ∈ V.1), rfl⟩, + convert hx', + ext1, + exact morphism_restrict_base_coe f U ⟨x, hx⟩ } +end + +lemma morphism_restrict_c_app {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) (V : opens U) : + (f ∣_ U).1.c.app (op V) = f.1.c.app (op (U.open_embedding.is_open_map.functor.obj V)) ≫ + X.presheaf.map (eq_to_hom (image_morphism_restrict_preimage f U V)).op := +begin + have := Scheme.congr_app (morphism_restrict_ι f U) + (op (U.open_embedding.is_open_map.functor.obj V)), + rw [Scheme.comp_val_c_app, Scheme.comp_val_c_app_assoc] at this, + have e : (opens.map U.inclusion).obj (U.open_embedding.is_open_map.functor.obj V) = V, + { ext1, exact set.preimage_image_eq _ subtype.coe_injective }, + have : _ ≫ X.presheaf.map _ = _ := + (((f ∣_ U).1.c.naturality (eq_to_hom e).op).symm.trans _).trans this, + swap, { change Y.presheaf.map _ ≫ _ = Y.presheaf.map _ ≫ _, congr, }, + rw [← is_iso.eq_comp_inv, ← functor.map_inv, category.assoc] at this, + rw this, + congr' 1, + erw [← X.presheaf.map_comp, ← X.presheaf.map_comp], + congr' 1, +end + +lemma Γ_map_morphism_restrict {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) : + Scheme.Γ.map (f ∣_ U).op = Y.presheaf.map (eq_to_hom $ U.open_embedding_obj_top.symm).op ≫ + f.1.c.app (op U) ≫ + X.presheaf.map (eq_to_hom $ ((opens.map f.val.base).obj U).open_embedding_obj_top).op := +begin + rw [Scheme.Γ_map_op, morphism_restrict_c_app f U ⊤, f.val.c.naturality_assoc], + erw ← X.presheaf.map_comp, + congr, +end + +/-- Restricting a morphism onto the the image of an open immersion is isomorphic to the base change +along the immersion. -/ +def morphism_restrict_opens_range + {X Y U : Scheme} (f : X ⟶ Y) (g : U ⟶ Y) [hg : is_open_immersion g] : + arrow.mk (f ∣_ g.opens_range) ≅ arrow.mk (pullback.snd : pullback f g ⟶ _) := +begin + let V : opens Y.carrier := g.opens_range, + let e := is_open_immersion.iso_of_range_eq g (Y.of_restrict V.open_embedding) + (by exact subtype.range_coe.symm), + let t : pullback f g ⟶ pullback f (Y.of_restrict V.open_embedding) := + pullback.map _ _ _ _ (𝟙 _) e.hom (𝟙 _) (by rw [category.comp_id, category.id_comp]) + (by rw [category.comp_id, is_open_immersion.iso_of_range_eq_hom, is_open_immersion.lift_fac]), + symmetry, + refine arrow.iso_mk (as_iso t ≪≫ pullback_restrict_iso_restrict f V) e _, + rw [iso.trans_hom, as_iso_hom, ← iso.comp_inv_eq, ← cancel_mono g, arrow.mk_hom, arrow.mk_hom, + is_open_immersion.iso_of_range_eq_inv, category.assoc, category.assoc, category.assoc, + is_open_immersion.lift_fac, ← pullback.condition, morphism_restrict_ι, + pullback_restrict_iso_restrict_hom_restrict_assoc, pullback.lift_fst_assoc, category.comp_id], +end + +/-- The restrictions onto two equal open sets are isomorphic. This currently has bad defeqs when +unfolded, but it should not matter for now. Replace this definition if better defeqs are needed. -/ +def morphism_restrict_eq {X Y : Scheme} (f : X ⟶ Y) {U V : opens Y.carrier} (e : U = V) : + arrow.mk (f ∣_ U) ≅ arrow.mk (f ∣_ V) := eq_to_iso (by subst e) + +/-- Restricting a morphism twice is isomorpic to one restriction. -/ +def morphism_restrict_restrict {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) (V : opens U) : + arrow.mk (f ∣_ U ∣_ V) ≅ arrow.mk (f ∣_ (U.open_embedding.is_open_map.functor.obj V)) := +begin + have : (f ∣_ U ∣_ V) ≫ (iso.refl _).hom = + (as_iso $ (pullback_restrict_iso_restrict (f ∣_ U) V).inv ≫ (pullback_symmetry _ _).hom ≫ + pullback.map _ _ _ _ (𝟙 _) + ((pullback_restrict_iso_restrict f U).inv ≫ (pullback_symmetry _ _).hom) (𝟙 _) + ((category.comp_id _).trans (category.id_comp _).symm) (by simpa) ≫ + (pullback_right_pullback_fst_iso _ _ _).hom ≫ (pullback_symmetry _ _).hom).hom ≫ pullback.snd, + { simpa only [category.comp_id, pullback_right_pullback_fst_iso_hom_fst, iso.refl_hom, + category.assoc, pullback_symmetry_hom_comp_snd, as_iso_hom, pullback.lift_fst, + pullback_symmetry_hom_comp_fst] }, + refine arrow.iso_mk' _ _ _ _ this.symm ≪≫ (morphism_restrict_opens_range _ _).symm ≪≫ + morphism_restrict_eq _ _, + ext1, + dsimp, + rw [coe_comp, set.range_comp], + congr, + exact subtype.range_coe, +end + +/-- Restricting a morphism twice onto a basic open set is isomorphic to one restriction. -/ +def morphism_restrict_restrict_basic_open {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) + (r : Y.presheaf.obj (op U)) : + arrow.mk (f ∣_ U ∣_ (Y.restrict _).basic_open + (Y.presheaf.map (eq_to_hom U.open_embedding_obj_top).op r)) ≅ arrow.mk (f ∣_ Y.basic_open r) := +begin + refine morphism_restrict_restrict _ _ _ ≪≫ morphism_restrict_eq _ _, + have e := Scheme.preimage_basic_open (Y.of_restrict U.open_embedding) r, + erw [Scheme.of_restrict_val_c_app, opens.adjunction_counit_app_self, eq_to_hom_op] at e, + rw [← (Y.restrict U.open_embedding).basic_open_res_eq _ + (eq_to_hom U.inclusion_map_eq_top).op, ← comp_apply], + erw ← Y.presheaf.map_comp, + rw [eq_to_hom_op, eq_to_hom_op, eq_to_hom_map, eq_to_hom_trans], + erw ← e, + ext1, dsimp [opens.map, opens.inclusion], + rw [set.image_preimage_eq_inter_range, set.inter_eq_left_iff_subset, subtype.range_coe], + exact Y.basic_open_le r +end + +/-- +The stalk map of a restriction of a morphism is isomorphic to the stalk map of the original map. +-/ +def morphism_restrict_stalk_map {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) (x) : + arrow.mk (PresheafedSpace.stalk_map (f ∣_ U).1 x) ≅ + arrow.mk (PresheafedSpace.stalk_map f.1 x.1) := +begin + fapply arrow.iso_mk', + { refine Y.restrict_stalk_iso U.open_embedding ((f ∣_ U).1 x) ≪≫ Top.presheaf.stalk_congr _ _, + apply inseparable.of_eq, + exact morphism_restrict_base_coe f U x }, + { exact X.restrict_stalk_iso _ _ }, + { apply Top.presheaf.stalk_hom_ext, + intros V hxV, + simp only [Top.presheaf.stalk_congr_hom, category_theory.category.assoc, + category_theory.iso.trans_hom], + erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ_assoc, + erw PresheafedSpace.stalk_map_germ_assoc _ _ ⟨_, _⟩, + rw [Top.presheaf.germ_stalk_specializes'_assoc], + erw PresheafedSpace.stalk_map_germ _ _ ⟨_, _⟩, + erw PresheafedSpace.restrict_stalk_iso_hom_eq_germ, + rw [morphism_restrict_c_app, category.assoc, Top.presheaf.germ_res], + refl } +end + +instance {X Y : Scheme} (f : X ⟶ Y) (U : opens Y.carrier) [is_open_immersion f] : + is_open_immersion (f ∣_ U) := +by { delta morphism_restrict, apply_instance } + +end morphism_restrict + +end algebraic_geometry diff --git a/src/algebraic_geometry/open_immersion/basic.lean b/src/algebraic_geometry/open_immersion/basic.lean new file mode 100644 index 0000000000000..0592e7c1bed51 --- /dev/null +++ b/src/algebraic_geometry/open_immersion/basic.lean @@ -0,0 +1,1084 @@ +/- +Copyright (c) 2021 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import topology.category.Top.limits.pullbacks +import algebraic_geometry.locally_ringed_space + +/-! +# Open immersions of structured spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We say that a morphism of presheafed spaces `f : X ⟶ Y` is an open immersion if +the underlying map of spaces is an open embedding `f : X ⟶ U ⊆ Y`, +and the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`. + +Abbreviations are also provided for `SheafedSpace`, `LocallyRingedSpace` and `Scheme`. + +## Main definitions + +* `algebraic_geometry.PresheafedSpace.is_open_immersion`: the `Prop`-valued typeclass asserting + that a PresheafedSpace hom `f` is an open_immersion. +* `algebraic_geometry.is_open_immersion`: the `Prop`-valued typeclass asserting + that a Scheme morphism `f` is an open_immersion. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.iso_restrict`: The source of an + open immersion is isomorphic to the restriction of the target onto the image. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.lift`: Any morphism whose range is + contained in an open immersion factors though the open immersion. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_SheafedSpace`: If `f : X ⟶ Y` is an + open immersion of presheafed spaces, and `Y` is a sheafed space, then `X` is also a sheafed + space. The morphism as morphisms of sheafed spaces is given by `to_SheafedSpace_hom`. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_LocallyRingedSpace`: If `f : X ⟶ Y` is + an open immersion of presheafed spaces, and `Y` is a locally ringed space, then `X` is also a + locally ringed space. The morphism as morphisms of locally ringed spaces is given by + `to_LocallyRingedSpace_hom`. + +## Main results + +* `algebraic_geometry.PresheafedSpace.is_open_immersion.comp`: The composition of two open + immersions is an open immersion. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.of_iso`: An iso is an open immersion. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.to_iso`: + A surjective open immersion is an isomorphism. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.stalk_iso`: An open immersion induces + an isomorphism on stalks. +* `algebraic_geometry.PresheafedSpace.is_open_immersion.has_pullback_of_left`: If `f` is an open + immersion, then the pullback `(f, g)` exists (and the forgetful functor to `Top` preserves it). +* `algebraic_geometry.PresheafedSpace.is_open_immersion.pullback_snd_of_left`: Open immersions + are stable under pullbacks. +* `algebraic_geometry.SheafedSpace.is_open_immersion.of_stalk_iso` An (topological) open embedding + between two sheafed spaces is an open immersion if all the stalk maps are isomorphisms. + +-/ + +open topological_space category_theory opposite +open category_theory.limits +namespace algebraic_geometry + +universes v v₁ v₂ u + +variables {C : Type u} [category.{v} C] + +/-- +An open immersion of PresheafedSpaces is an open embedding `f : X ⟶ U ⊆ Y` of the underlying +spaces, such that the sheaf map `Y(V) ⟶ f _* X(V)` is an iso for each `V ⊆ U`. +-/ +class PresheafedSpace.is_open_immersion {X Y : PresheafedSpace.{v} C} (f : X ⟶ Y) : Prop := +(base_open : open_embedding f.base) +(c_iso : ∀ U : opens X, is_iso (f.c.app (op (base_open.is_open_map.functor.obj U)))) + +/-- +A morphism of SheafedSpaces is an open immersion if it is an open immersion as a morphism +of PresheafedSpaces +-/ +abbreviation SheafedSpace.is_open_immersion {X Y : SheafedSpace.{v} C} (f : X ⟶ Y) : Prop := +PresheafedSpace.is_open_immersion f + +/-- +A morphism of LocallyRingedSpaces is an open immersion if it is an open immersion as a morphism +of SheafedSpaces +-/ +abbreviation LocallyRingedSpace.is_open_immersion {X Y : LocallyRingedSpace} (f : X ⟶ Y) : Prop := +SheafedSpace.is_open_immersion f.1 + +namespace PresheafedSpace.is_open_immersion + +open PresheafedSpace + +local notation `is_open_immersion` := PresheafedSpace.is_open_immersion + +attribute [instance] is_open_immersion.c_iso + +section + +variables {X Y : PresheafedSpace.{v} C} {f : X ⟶ Y} (H : is_open_immersion f) + +/-- The functor `opens X ⥤ opens Y` associated with an open immersion `f : X ⟶ Y`. -/ +abbreviation open_functor := H.base_open.is_open_map.functor + +/-- An open immersion `f : X ⟶ Y` induces an isomorphism `X ≅ Y|_{f(X)}`. -/ +@[simps hom_c_app] noncomputable +def iso_restrict : X ≅ Y.restrict H.base_open := +PresheafedSpace.iso_of_components (iso.refl _) +begin + symmetry, + fapply nat_iso.of_components, + intro U, + refine as_iso (f.c.app (op (H.open_functor.obj (unop U)))) ≪≫ X.presheaf.map_iso (eq_to_iso _), + { induction U using opposite.rec, + cases U, + dsimp only [is_open_map.functor, functor.op, opens.map], + congr' 2, + erw set.preimage_image_eq _ H.base_open.inj, + refl }, + { intros U V i, + simp only [category_theory.eq_to_iso.hom, Top.presheaf.pushforward_obj_map, category.assoc, + functor.op_map, iso.trans_hom, as_iso_hom, functor.map_iso_hom, ←X.presheaf.map_comp], + erw [f.c.naturality_assoc, ←X.presheaf.map_comp], + congr } +end + +@[simp] lemma iso_restrict_hom_of_restrict : H.iso_restrict.hom ≫ Y.of_restrict _ = f := +begin + ext, + { simp only [comp_c_app, iso_restrict_hom_c_app, nat_trans.comp_app, + eq_to_hom_refl, of_restrict_c_app, category.assoc, whisker_right_id'], + erw [category.comp_id, f.c.naturality_assoc, ←X.presheaf.map_comp], + transitivity f.c.app x ≫ X.presheaf.map (𝟙 _), + { congr }, + { erw [X.presheaf.map_id, category.comp_id] } }, + { refl, } +end + +@[simp] lemma iso_restrict_inv_of_restrict : H.iso_restrict.inv ≫ f = Y.of_restrict _ := +by { rw [iso.inv_comp_eq, iso_restrict_hom_of_restrict] } + +instance mono [H : is_open_immersion f] : mono f := +by { rw ← H.iso_restrict_hom_of_restrict, apply mono_comp } + +/-- The composition of two open immersions is an open immersion. -/ +instance comp {Z : PresheafedSpace C} (f : X ⟶ Y) [hf : is_open_immersion f] (g : Y ⟶ Z) + [hg : is_open_immersion g] : + is_open_immersion (f ≫ g) := +{ base_open := hg.base_open.comp hf.base_open, + c_iso := λ U, + begin + generalize_proofs h, + dsimp only [algebraic_geometry.PresheafedSpace.comp_c_app, unop_op, functor.op, comp_base, + Top.presheaf.pushforward_obj_obj, opens.map_comp_obj], + apply_with is_iso.comp_is_iso { instances := ff }, + swap, + { have : (opens.map g.base).obj (h.functor.obj U) = hf.open_functor.obj U, + { ext1, + dsimp only [opens.map_coe, is_open_map.functor_obj_coe, comp_base], + rw [coe_comp, ← set.image_image, set.preimage_image_eq _ hg.base_open.inj] }, + rw this, + apply_instance }, + { have : h.functor.obj U = hg.open_functor.obj (hf.open_functor.obj U), + { ext1, + dsimp only [is_open_map.functor_obj_coe], + rw [comp_base, coe_comp, ←set.image_image] }, + rw this, + apply_instance } + end } + +/-- For an open immersion `f : X ⟶ Y` and an open set `U ⊆ X`, we have the map `X(U) ⟶ Y(U)`. -/ +noncomputable +def inv_app (U : opens X) : X.presheaf.obj (op U) ⟶ Y.presheaf.obj (op (H.open_functor.obj U)) := +X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) ≫ + inv (f.c.app (op (H.open_functor.obj U))) + +@[simp, reassoc] lemma inv_naturality {U V : (opens X)ᵒᵖ} (i : U ⟶ V) : + X.presheaf.map i ≫ H.inv_app (unop V) = H.inv_app (unop U) ≫ + Y.presheaf.map (H.open_functor.op.map i) := +begin + simp only [inv_app, ←category.assoc], + rw [is_iso.comp_inv_eq], + simp only [category.assoc, f.c.naturality, is_iso.inv_hom_id_assoc, ← X.presheaf.map_comp], + erw ← X.presheaf.map_comp, + congr +end + +instance (U : opens X) : is_iso (H.inv_app U) := by { delta inv_app, apply_instance } + +lemma inv_inv_app (U : opens X) : + inv (H.inv_app U) = f.c.app (op (H.open_functor.obj U)) ≫ + X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) := +begin + rw ← cancel_epi (H.inv_app U), + rw is_iso.hom_inv_id, + delta inv_app, + simp [← functor.map_comp] +end + +@[simp, reassoc, elementwise] lemma inv_app_app (U : opens X) : + H.inv_app U ≫ f.c.app (op (H.open_functor.obj U)) = + X.presheaf.map (eq_to_hom (by simp [opens.map, set.preimage_image_eq _ H.base_open.inj])) := +by rw [inv_app, category.assoc, is_iso.inv_hom_id, category.comp_id] + +@[simp, reassoc] lemma app_inv_app (U : opens Y) : + f.c.app (op U) ≫ H.inv_app ((opens.map f.base).obj U) = + Y.presheaf.map ((hom_of_le (by exact set.image_preimage_subset f.base U)).op : + op U ⟶ op (H.open_functor.obj ((opens.map f.base).obj U))) := +by { erw ← category.assoc, rw [is_iso.comp_inv_eq, f.c.naturality], congr } + +/-- A variant of `app_inv_app` that gives an `eq_to_hom` instead of `hom_of_le`. -/ +@[reassoc] lemma app_inv_app' (U : opens Y) (hU : (U : set Y) ⊆ set.range f.base) : + f.c.app (op U) ≫ H.inv_app ((opens.map f.base).obj U) = + Y.presheaf.map (eq_to_hom (by + { apply le_antisymm, + { exact set.image_preimage_subset f.base U.1 }, + { rw [← set_like.coe_subset_coe], + refine has_le.le.trans_eq _ (@set.image_preimage_eq_inter_range _ _ f.base U.1).symm, + exact set.subset_inter_iff.mpr ⟨λ _ h, h, hU⟩ } })).op := +by { erw ← category.assoc, rw [is_iso.comp_inv_eq, f.c.naturality], congr } + +/-- An isomorphism is an open immersion. -/ +instance of_iso {X Y : PresheafedSpace.{v} C} (H : X ≅ Y) : is_open_immersion H.hom := +{ base_open := (Top.homeo_of_iso ((forget C).map_iso H)).open_embedding, + c_iso := λ _, infer_instance } + +@[priority 100] +instance of_is_iso {X Y : PresheafedSpace.{v} C} (f : X ⟶ Y) [is_iso f] : is_open_immersion f := +algebraic_geometry.PresheafedSpace.is_open_immersion.of_iso (as_iso f) + +instance of_restrict {X : Top} (Y : PresheafedSpace C) {f : X ⟶ Y.carrier} + (hf : open_embedding f) : is_open_immersion (Y.of_restrict hf) := +{ base_open := hf, + c_iso := λ U, + begin + dsimp, + have : (opens.map f).obj (hf.is_open_map.functor.obj U) = U, + { ext1, + exact set.preimage_image_eq _ hf.inj }, + convert (show is_iso (Y.presheaf.map (𝟙 _)), from infer_instance), + { apply subsingleton.helim, + rw this }, + { rw Y.presheaf.map_id, + apply_instance } + end } + +@[elementwise, simp] +lemma of_restrict_inv_app {C : Type*} [category C] (X : PresheafedSpace C) {Y : Top} + {f : Y ⟶ Top.of X.carrier} + (h : open_embedding f) (U : opens (X.restrict h).carrier) : + (PresheafedSpace.is_open_immersion.of_restrict X h).inv_app U = 𝟙 _ := +begin + delta PresheafedSpace.is_open_immersion.inv_app, + rw [is_iso.comp_inv_eq, category.id_comp], + change X.presheaf.map _ = X.presheaf.map _, + congr +end + +/-- An open immersion is an iso if the underlying continuous map is epi. -/ +lemma to_iso (f : X ⟶ Y) [h : is_open_immersion f] [h' : epi f.base] : is_iso f := +begin + apply_with is_iso_of_components { instances := ff }, + { let : X ≃ₜ Y := (homeomorph.of_embedding _ h.base_open.to_embedding).trans + { to_fun := subtype.val, inv_fun := λ x, ⟨x, + by { rw set.range_iff_surjective.mpr ((Top.epi_iff_surjective _).mp h'), trivial }⟩, + left_inv := λ ⟨_,_⟩, rfl, right_inv := λ _, rfl }, + convert is_iso.of_iso (Top.iso_of_homeo this), + { ext, refl } }, + { apply_with nat_iso.is_iso_of_is_iso_app { instances := ff }, + intro U, + have : U = op (h.open_functor.obj ((opens.map f.base).obj (unop U))), + { induction U using opposite.rec, + cases U, + dsimp only [functor.op, opens.map], + congr, + exact (set.image_preimage_eq _ ((Top.epi_iff_surjective _).mp h')).symm }, + convert @@is_open_immersion.c_iso _ h ((opens.map f.base).obj (unop U)) } +end + +instance stalk_iso [has_colimits C] [H : is_open_immersion f] (x : X) : is_iso (stalk_map f x) := +begin + rw ← H.iso_restrict_hom_of_restrict, + rw PresheafedSpace.stalk_map.comp, + apply_instance +end + +end + +section pullback + +noncomputable theory + +variables {X Y Z : PresheafedSpace.{v} C} (f : X ⟶ Z) [hf : is_open_immersion f] (g : Y ⟶ Z) + +include hf + +/-- + (Implementation.) The projection map when constructing the pullback along an open immersion. +-/ +def pullback_cone_of_left_fst : + Y.restrict (Top.snd_open_embedding_of_left_open_embedding hf.base_open g.base) ⟶ X := +{ base := pullback.fst, + c := + { app := λ U, hf.inv_app (unop U) ≫ + g.c.app (op (hf.base_open.is_open_map.functor.obj (unop U))) ≫ + Y.presheaf.map (eq_to_hom + (begin + simp only [is_open_map.functor, subtype.mk_eq_mk, unop_op, op_inj_iff, opens.map, + subtype.coe_mk, functor.op_obj, subtype.val_eq_coe], + apply has_le.le.antisymm, + { rintros _ ⟨_, h₁, h₂⟩, + use (Top.pullback_iso_prod_subtype _ _).inv ⟨⟨_, _⟩, h₂⟩, + simpa using h₁ }, + { rintros _ ⟨x, h₁, rfl⟩, + exact ⟨_, h₁, concrete_category.congr_hom pullback.condition x⟩ } + end)), + naturality' := + begin + intros U V i, + induction U using opposite.rec, + induction V using opposite.rec, + simp only [quiver.hom.unop_op, Top.presheaf.pushforward_obj_map, category.assoc, + nat_trans.naturality_assoc, functor.op_map, inv_naturality_assoc, ← Y.presheaf.map_comp], + erw ← Y.presheaf.map_comp, + congr + end } } + +lemma pullback_cone_of_left_condition : + pullback_cone_of_left_fst f g ≫ f = Y.of_restrict _ ≫ g := +begin + ext U, + { induction U using opposite.rec, + dsimp only [comp_c_app, nat_trans.comp_app, unop_op, + whisker_right_app, pullback_cone_of_left_fst], + simp only [quiver.hom.unop_op, Top.presheaf.pushforward_obj_map, app_inv_app_assoc, + eq_to_hom_app, eq_to_hom_unop, category.assoc, nat_trans.naturality_assoc, functor.op_map], + erw [← Y.presheaf.map_comp, ← Y.presheaf.map_comp], + congr }, + { simpa using pullback.condition } +end + +/-- +We construct the pullback along an open immersion via restricting along the pullback of the +maps of underlying spaces (which is also an open embedding). +-/ +def pullback_cone_of_left : pullback_cone f g := +pullback_cone.mk (pullback_cone_of_left_fst f g) (Y.of_restrict _) + (pullback_cone_of_left_condition f g) + +variable (s : pullback_cone f g) + +/-- + (Implementation.) Any cone over `cospan f g` indeed factors through the constructed cone. +-/ +def pullback_cone_of_left_lift : s.X ⟶ (pullback_cone_of_left f g).X := +{ base := pullback.lift s.fst.base s.snd.base + (congr_arg (λ x, PresheafedSpace.hom.base x) s.condition), + c := + { app := λ U, s.snd.c.app _ ≫ s.X.presheaf.map (eq_to_hom (begin + dsimp only [opens.map, is_open_map.functor, functor.op], + congr' 2, + let s' : pullback_cone f.base g.base := pullback_cone.mk s.fst.base s.snd.base _, + have : _ = s.snd.base := limit.lift_π s' walking_cospan.right, + conv_lhs { erw ← this, rw coe_comp, erw ← set.preimage_preimage }, + erw set.preimage_image_eq _ + (Top.snd_open_embedding_of_left_open_embedding hf.base_open g.base).inj, + end)), + naturality' := λ U V i, + begin + erw s.snd.c.naturality_assoc, + rw category.assoc, + erw [← s.X.presheaf.map_comp, ← s.X.presheaf.map_comp], + congr + end } } + +-- this lemma is not a `simp` lemma, because it is an implementation detail +lemma pullback_cone_of_left_lift_fst : + pullback_cone_of_left_lift f g s ≫ (pullback_cone_of_left f g).fst = s.fst := +begin + ext x, + { induction x using opposite.rec, + change ((_ ≫ _) ≫ _ ≫ _) ≫ _ = _, + simp_rw [category.assoc], + erw ← s.X.presheaf.map_comp, + erw s.snd.c.naturality_assoc, + have := congr_app s.condition (op (hf.open_functor.obj x)), + dsimp only [comp_c_app, unop_op] at this, + rw ← is_iso.comp_inv_eq at this, + reassoc! this, + erw [← this, hf.inv_app_app_assoc, s.fst.c.naturality_assoc], + simpa [eq_to_hom_map], }, + { change pullback.lift _ _ _ ≫ pullback.fst = _, + simp } +end + +-- this lemma is not a `simp` lemma, because it is an implementation detail +lemma pullback_cone_of_left_lift_snd : + pullback_cone_of_left_lift f g s ≫ (pullback_cone_of_left f g).snd = s.snd := +begin + ext x, + { change (_ ≫ _ ≫ _) ≫ _ = _, + simp_rw category.assoc, + erw s.snd.c.naturality_assoc, + erw [← s.X.presheaf.map_comp, ← s.X.presheaf.map_comp], + transitivity s.snd.c.app x ≫ s.X.presheaf.map (𝟙 _), + { congr }, + { rw s.X.presheaf.map_id, erw category.comp_id } }, + { change pullback.lift _ _ _ ≫ pullback.snd = _, + simp } +end + +instance pullback_cone_snd_is_open_immersion : + is_open_immersion (pullback_cone_of_left f g).snd := +begin + erw category_theory.limits.pullback_cone.mk_snd, + apply_instance +end + +/-- The constructed pullback cone is indeed the pullback. -/ +def pullback_cone_of_left_is_limit : + is_limit (pullback_cone_of_left f g) := +begin + apply pullback_cone.is_limit_aux', + intro s, + use pullback_cone_of_left_lift f g s, + use pullback_cone_of_left_lift_fst f g s, + use pullback_cone_of_left_lift_snd f g s, + intros m h₁ h₂, + rw ← cancel_mono (pullback_cone_of_left f g).snd, + exact (h₂.trans (pullback_cone_of_left_lift_snd f g s).symm) +end + +instance has_pullback_of_left : + has_pullback f g := +⟨⟨⟨_, pullback_cone_of_left_is_limit f g⟩⟩⟩ + +instance has_pullback_of_right : + has_pullback g f := has_pullback_symmetry f g + +/-- Open immersions are stable under base-change. -/ +instance pullback_snd_of_left : + is_open_immersion (pullback.snd : pullback f g ⟶ _) := +begin + delta pullback.snd, + rw ← limit.iso_limit_cone_hom_π ⟨_, pullback_cone_of_left_is_limit f g⟩ walking_cospan.right, + apply_instance +end + +/-- Open immersions are stable under base-change. -/ +instance pullback_fst_of_right : + is_open_immersion (pullback.fst : pullback g f ⟶ _) := +begin + rw ← pullback_symmetry_hom_comp_snd, + apply_instance +end + +instance pullback_to_base_is_open_immersion [is_open_immersion g] : + is_open_immersion (limit.π (cospan f g) walking_cospan.one) := +begin + rw [←limit.w (cospan f g) walking_cospan.hom.inl, cospan_map_inl], + apply_instance +end + +instance forget_preserves_limits_of_left : preserves_limit (cospan f g) (forget C) := +preserves_limit_of_preserves_limit_cone (pullback_cone_of_left_is_limit f g) +begin + apply (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v} _) _).to_fun, + refine (is_limit.equiv_iso_limit _).to_fun (limit.is_limit (cospan f.base g.base)), + fapply cones.ext, + exact (iso.refl _), + change ∀ j, _ = 𝟙 _ ≫ _ ≫ _, + simp_rw category.id_comp, + rintros (_|_|_); symmetry, + { erw category.comp_id, + exact limit.w (cospan f.base g.base) walking_cospan.hom.inl }, + { exact category.comp_id _ }, + { exact category.comp_id _ }, +end + +instance forget_preserves_limits_of_right : preserves_limit (cospan g f) (forget C) := +preserves_pullback_symmetry (forget C) f g + +lemma pullback_snd_is_iso_of_range_subset (H : set.range g.base ⊆ set.range f.base) : + is_iso (pullback.snd : pullback f g ⟶ _) := +begin + haveI := Top.snd_iso_of_left_embedding_range_subset hf.base_open.to_embedding g.base H, + haveI : is_iso (pullback.snd : pullback f g ⟶ _).base, + { delta pullback.snd, + rw ← limit.iso_limit_cone_hom_π ⟨_, pullback_cone_of_left_is_limit f g⟩ walking_cospan.right, + change is_iso (_ ≫ pullback.snd), + apply_instance }, + apply to_iso +end + +/-- +The universal property of open immersions: +For an open immersion `f : X ⟶ Z`, given any morphism of schemes `g : Y ⟶ Z` whose topological +image is contained in the image of `f`, we can lift this morphism to a unique `Y ⟶ X` that +commutes with these maps. +-/ +def lift (H : set.range g.base ⊆ set.range f.base) : Y ⟶ X := +begin + haveI := pullback_snd_is_iso_of_range_subset f g H, + exact inv (pullback.snd : pullback f g ⟶ _) ≫ pullback.fst, +end + +@[simp, reassoc] lemma lift_fac (H : set.range g.base ⊆ set.range f.base) : + lift f g H ≫ f = g := +by { erw category.assoc, rw is_iso.inv_comp_eq, exact pullback.condition } + +lemma lift_uniq (H : set.range g.base ⊆ set.range f.base) (l : Y ⟶ X) + (hl : l ≫ f = g) : l = lift f g H := +by rw [← cancel_mono f, hl, lift_fac] + +/-- Two open immersions with equal range is isomorphic. -/ +@[simps] def iso_of_range_eq [is_open_immersion g] (e : set.range f.base = set.range g.base) : + X ≅ Y := +{ hom := lift g f (le_of_eq e), + inv := lift f g (le_of_eq e.symm), + hom_inv_id' := by { rw ← cancel_mono f, simp }, + inv_hom_id' := by { rw ← cancel_mono g, simp } } + +end pullback + +open category_theory.limits.walking_cospan + +section to_SheafedSpace + +variables {X : PresheafedSpace.{v} C} (Y : SheafedSpace C) +variables (f : X ⟶ Y.to_PresheafedSpace) [H : is_open_immersion f] + +include H + +/-- If `X ⟶ Y` is an open immersion, and `Y` is a SheafedSpace, then so is `X`. -/ +def to_SheafedSpace : SheafedSpace C := +{ is_sheaf := + begin + apply Top.presheaf.is_sheaf_of_iso (sheaf_iso_of_iso H.iso_restrict.symm).symm, + apply Top.sheaf.pushforward_sheaf_of_sheaf, + exact (Y.restrict H.base_open).is_sheaf + end, + to_PresheafedSpace := X } + +@[simp] lemma to_SheafedSpace_to_PresheafedSpace : (to_SheafedSpace Y f).to_PresheafedSpace = X := +rfl + +/-- +If `X ⟶ Y` is an open immersion of PresheafedSpaces, and `Y` is a SheafedSpace, we can +upgrade it into a morphism of SheafedSpaces. +-/ +def to_SheafedSpace_hom : to_SheafedSpace Y f ⟶ Y := f + +@[simp] lemma to_SheafedSpace_hom_base : (to_SheafedSpace_hom Y f).base = f.base := rfl + +@[simp] lemma to_SheafedSpace_hom_c : (to_SheafedSpace_hom Y f).c = f.c := rfl + +instance to_SheafedSpace_is_open_immersion : + SheafedSpace.is_open_immersion (to_SheafedSpace_hom Y f) := H + +omit H + +@[simp] lemma SheafedSpace_to_SheafedSpace {X Y : SheafedSpace.{v} C} (f : X ⟶ Y) + [is_open_immersion f] : to_SheafedSpace Y f = X := by unfreezingI { cases X, refl } + +end to_SheafedSpace + +section to_LocallyRingedSpace + +variables {X : PresheafedSpace.{u} CommRing.{u}} (Y : LocallyRingedSpace.{u}) +variables (f : X ⟶ Y.to_PresheafedSpace) [H : is_open_immersion f] + +include H + +/-- If `X ⟶ Y` is an open immersion, and `Y` is a LocallyRingedSpace, then so is `X`. -/ +def to_LocallyRingedSpace : LocallyRingedSpace := +{ to_SheafedSpace := to_SheafedSpace Y.to_SheafedSpace f, + local_ring := λ x, begin + haveI : local_ring (Y.to_SheafedSpace.to_PresheafedSpace.stalk (f.base x)) := Y.local_ring _, + exact (as_iso (stalk_map f x)).CommRing_iso_to_ring_equiv.local_ring + end } + +@[simp] lemma to_LocallyRingedSpace_to_SheafedSpace : + (to_LocallyRingedSpace Y f).to_SheafedSpace = (to_SheafedSpace Y.1 f) := rfl + +/-- +If `X ⟶ Y` is an open immersion of PresheafedSpaces, and `Y` is a LocallyRingedSpace, we can +upgrade it into a morphism of LocallyRingedSpace. +-/ +def to_LocallyRingedSpace_hom : to_LocallyRingedSpace Y f ⟶ Y := ⟨f, λ x, infer_instance⟩ + +@[simp] lemma to_LocallyRingedSpace_hom_val : + (to_LocallyRingedSpace_hom Y f).val = f := rfl + +instance to_LocallyRingedSpace_is_open_immersion : + LocallyRingedSpace.is_open_immersion (to_LocallyRingedSpace_hom Y f) := H + +omit H + +@[simp] lemma LocallyRingedSpace_to_LocallyRingedSpace {X Y : LocallyRingedSpace} (f : X ⟶ Y) + [LocallyRingedSpace.is_open_immersion f] : + to_LocallyRingedSpace Y f.1 = X := +by unfreezingI { cases X, delta to_LocallyRingedSpace, simp } + +end to_LocallyRingedSpace + +lemma is_iso_of_subset {X Y : PresheafedSpace.{v} C} (f : X ⟶ Y) + [H : PresheafedSpace.is_open_immersion f] (U : opens Y.carrier) + (hU : (U : set Y.carrier) ⊆ set.range f.base) : is_iso (f.c.app $ op U) := +begin + have : U = H.base_open.is_open_map.functor.obj ((opens.map f.base).obj U), + { ext1, + exact (set.inter_eq_left_iff_subset.mpr hU).symm.trans set.image_preimage_eq_inter_range.symm }, + convert PresheafedSpace.is_open_immersion.c_iso ((opens.map f.base).obj U), +end + +end PresheafedSpace.is_open_immersion + +namespace SheafedSpace.is_open_immersion + +@[priority 100] +instance of_is_iso {X Y : SheafedSpace.{v} C} (f : X ⟶ Y) [is_iso f] : + SheafedSpace.is_open_immersion f := +@@PresheafedSpace.is_open_immersion.of_is_iso _ f +(SheafedSpace.forget_to_PresheafedSpace.map_is_iso _) + +instance comp {X Y Z : SheafedSpace C} (f : X ⟶ Y) (g : Y ⟶ Z) + [SheafedSpace.is_open_immersion f] [SheafedSpace.is_open_immersion g] : + SheafedSpace.is_open_immersion (f ≫ g) := PresheafedSpace.is_open_immersion.comp f g + +section pullback + +variables {X Y Z : SheafedSpace C} (f : X ⟶ Z) (g : Y ⟶ Z) +variable [H : SheafedSpace.is_open_immersion f] + +include H + +local notation `forget` := SheafedSpace.forget_to_PresheafedSpace +open category_theory.limits.walking_cospan + +instance : mono f := +forget .mono_of_mono_map (show @mono (PresheafedSpace C) _ _ _ f, by apply_instance) + +instance forget_map_is_open_immersion : + PresheafedSpace.is_open_immersion (forget .map f) := ⟨H.base_open, H.c_iso⟩ + +instance has_limit_cospan_forget_of_left : has_limit (cospan f g ⋙ forget) := +begin + apply has_limit_of_iso (diagram_iso_cospan.{v} _).symm, + change has_limit (cospan (forget .map f) (forget .map g)), + apply_instance +end + +instance has_limit_cospan_forget_of_left' : has_limit (cospan ((cospan f g ⋙ forget).map hom.inl) + ((cospan f g ⋙ forget).map hom.inr)) := +show has_limit (cospan (forget .map f) (forget .map g)), from infer_instance + +instance has_limit_cospan_forget_of_right : has_limit (cospan g f ⋙ forget) := +begin + apply has_limit_of_iso (diagram_iso_cospan.{v} _).symm, + change has_limit (cospan (forget .map g) (forget .map f)), + apply_instance +end + +instance has_limit_cospan_forget_of_right' : has_limit (cospan ((cospan g f ⋙ forget).map hom.inl) + ((cospan g f ⋙ forget).map hom.inr)) := +show has_limit (cospan (forget .map g) (forget .map f)), from infer_instance + + +instance forget_creates_pullback_of_left : creates_limit (cospan f g) forget := +creates_limit_of_fully_faithful_of_iso + (PresheafedSpace.is_open_immersion.to_SheafedSpace Y + (@pullback.snd (PresheafedSpace C) _ _ _ _ f g _)) + (eq_to_iso (show pullback _ _ = pullback _ _, by congr) + ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) + +instance forget_creates_pullback_of_right : creates_limit (cospan g f) forget := +creates_limit_of_fully_faithful_of_iso + (PresheafedSpace.is_open_immersion.to_SheafedSpace Y + (@pullback.fst (PresheafedSpace C) _ _ _ _ g f _)) + (eq_to_iso (show pullback _ _ = pullback _ _, by congr) + ≪≫ has_limit.iso_of_nat_iso (diagram_iso_cospan _).symm) + +instance SheafedSpace_forget_preserves_of_left : + preserves_limit (cospan f g) (SheafedSpace.forget C) := +@@limits.comp_preserves_limit _ _ _ _ forget (PresheafedSpace.forget C) _ +begin + apply_with (preserves_limit_of_iso_diagram _ (diagram_iso_cospan.{v} _).symm) { instances := tt }, + dsimp, + apply_instance +end + +instance SheafedSpace_forget_preserves_of_right : + preserves_limit (cospan g f) (SheafedSpace.forget C) := +preserves_pullback_symmetry _ _ _ + +instance SheafedSpace_has_pullback_of_left : has_pullback f g := + has_limit_of_created (cospan f g) forget + +instance SheafedSpace_has_pullback_of_right : has_pullback g f := + has_limit_of_created (cospan g f) forget + +/-- Open immersions are stable under base-change. -/ +instance SheafedSpace_pullback_snd_of_left : + SheafedSpace.is_open_immersion (pullback.snd : pullback f g ⟶ _) := +begin + delta pullback.snd, + have : _ = limit.π (cospan f g) right := preserves_limits_iso_hom_π + forget (cospan f g) right, + rw ← this, + have := has_limit.iso_of_nat_iso_hom_π + (diagram_iso_cospan.{v} (cospan f g ⋙ forget)) + right, + erw category.comp_id at this, + rw ← this, + dsimp, + apply_instance +end + +instance SheafedSpace_pullback_fst_of_right : + SheafedSpace.is_open_immersion (pullback.fst : pullback g f ⟶ _) := +begin + delta pullback.fst, + have : _ = limit.π (cospan g f) left := preserves_limits_iso_hom_π + forget (cospan g f) left, + rw ← this, + have := has_limit.iso_of_nat_iso_hom_π + (diagram_iso_cospan.{v} (cospan g f ⋙ forget)) left, + erw category.comp_id at this, + rw ← this, + dsimp, + apply_instance +end + +instance SheafedSpace_pullback_to_base_is_open_immersion [SheafedSpace.is_open_immersion g] : + SheafedSpace.is_open_immersion (limit.π (cospan f g) one : pullback f g ⟶ Z) := +begin + rw [←limit.w (cospan f g) hom.inl, cospan_map_inl], + apply_instance +end + +end pullback + +section of_stalk_iso +variables [has_limits C] [has_colimits C] [concrete_category.{v} C] +variables [reflects_isomorphisms (forget C)] [preserves_limits (forget C)] +variables [preserves_filtered_colimits (forget C)] + +/-- +Suppose `X Y : SheafedSpace C`, where `C` is a concrete category, +whose forgetful functor reflects isomorphisms, preserves limits and filtered colimits. +Then a morphism `X ⟶ Y` that is a topological open embedding +is an open immersion iff every stalk map is an iso. +-/ +lemma of_stalk_iso {X Y : SheafedSpace C} (f : X ⟶ Y) + (hf : open_embedding f.base) [H : ∀ x : X, is_iso (PresheafedSpace.stalk_map f x)] : + SheafedSpace.is_open_immersion f := +{ base_open := hf, + c_iso := λ U, begin + apply_with (Top.presheaf.app_is_iso_of_stalk_functor_map_iso + (show Y.sheaf ⟶ (Top.sheaf.pushforward f.base).obj X.sheaf, from ⟨f.c⟩)) { instances := ff }, + rintros ⟨_, y, hy, rfl⟩, + specialize H y, + delta PresheafedSpace.stalk_map at H, + haveI H' := Top.presheaf.stalk_pushforward.stalk_pushforward_iso_of_open_embedding + C hf X.presheaf y, + have := @@is_iso.comp_is_iso _ H (@@is_iso.inv_is_iso _ H'), + rw [category.assoc, is_iso.hom_inv_id, category.comp_id] at this, + exact this + end } + +end of_stalk_iso + +section prod + +variables [has_limits C] {ι : Type v} (F : discrete ι ⥤ SheafedSpace C) [has_colimit F] + (i : discrete ι) + +lemma sigma_ι_open_embedding : open_embedding (colimit.ι F i).base := +begin + rw ← (show _ = (colimit.ι F i).base, + from ι_preserves_colimits_iso_inv (SheafedSpace.forget C) F i), + have : _ = _ ≫ colimit.ι (discrete.functor ((F ⋙ SheafedSpace.forget C).obj ∘ discrete.mk)) i := + has_colimit.iso_of_nat_iso_ι_hom discrete.nat_iso_functor i, + rw ← iso.eq_comp_inv at this, + rw this, + have : colimit.ι _ _ ≫ _ = _ := + Top.sigma_iso_sigma_hom_ι.{v v} ((F ⋙ SheafedSpace.forget C).obj ∘ discrete.mk) i.as, + rw ← iso.eq_comp_inv at this, + cases i, + rw this, + simp_rw [← category.assoc, Top.open_embedding_iff_comp_is_iso, + Top.open_embedding_iff_is_iso_comp], + dsimp, + exact open_embedding_sigma_mk +end + +lemma image_preimage_is_empty (j : discrete ι) (h : i ≠ j) (U : opens (F.obj i)) : + (opens.map (colimit.ι (F ⋙ SheafedSpace.forget_to_PresheafedSpace) j).base).obj + ((opens.map (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv.base).obj + ((sigma_ι_open_embedding F i).is_open_map.functor.obj U)) = ⊥ := +begin + ext, + apply iff_false_intro, + rintro ⟨y, hy, eq⟩, + replace eq := concrete_category.congr_arg + (preserves_colimit_iso (SheafedSpace.forget C) F ≪≫ + has_colimit.iso_of_nat_iso discrete.nat_iso_functor ≪≫ Top.sigma_iso_sigma.{v} _).hom eq, + simp_rw [category_theory.iso.trans_hom, ← Top.comp_app, ← PresheafedSpace.comp_base] at eq, + rw ι_preserves_colimits_iso_inv at eq, + change ((SheafedSpace.forget C).map (colimit.ι F i) ≫ _) y = + ((SheafedSpace.forget C).map (colimit.ι F j) ≫ _) x at eq, + cases i, cases j, + rw [ι_preserves_colimits_iso_hom_assoc, ι_preserves_colimits_iso_hom_assoc, + has_colimit.iso_of_nat_iso_ι_hom_assoc, has_colimit.iso_of_nat_iso_ι_hom_assoc, + Top.sigma_iso_sigma_hom_ι.{v}, Top.sigma_iso_sigma_hom_ι.{v}] at eq, + exact h (congr_arg discrete.mk (congr_arg sigma.fst eq)), +end + +instance sigma_ι_is_open_immersion [has_strict_terminal_objects C] : + SheafedSpace.is_open_immersion (colimit.ι F i) := +{ base_open := sigma_ι_open_embedding F i, + c_iso := λ U, begin + have e : colimit.ι F i = _ := + (ι_preserves_colimits_iso_inv SheafedSpace.forget_to_PresheafedSpace F i).symm, + have H : open_embedding (colimit.ι (F ⋙ SheafedSpace.forget_to_PresheafedSpace) i ≫ + (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv).base := + e ▸ sigma_ι_open_embedding F i, + suffices : is_iso ((colimit.ι (F ⋙ SheafedSpace.forget_to_PresheafedSpace) i ≫ + (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv).c.app + (op (H.is_open_map.functor.obj U))), + { convert this }, + rw [PresheafedSpace.comp_c_app, + ← PresheafedSpace.colimit_presheaf_obj_iso_componentwise_limit_hom_π], + rsufficesI : is_iso (limit.π (PresheafedSpace.componentwise_diagram + (F ⋙ SheafedSpace.forget_to_PresheafedSpace) + ((opens.map (preserves_colimit_iso SheafedSpace.forget_to_PresheafedSpace F).inv.base).obj + (unop $ op $ H.is_open_map.functor.obj U))) (op i)), + { apply_instance }, + apply limit_π_is_iso_of_is_strict_terminal, + intros j hj, + induction j using opposite.rec, + dsimp, + convert (F.obj j).sheaf.is_terminal_of_empty, + convert image_preimage_is_empty F i j (λ h, hj (congr_arg op h.symm)) U, + exact (congr_arg PresheafedSpace.hom.base e).symm + end } + +end prod + +end SheafedSpace.is_open_immersion + +namespace LocallyRingedSpace.is_open_immersion + +section pullback + +variables {X Y Z : LocallyRingedSpace.{u}} (f : X ⟶ Z) (g : Y ⟶ Z) +variable [H : LocallyRingedSpace.is_open_immersion f] + +@[priority 100] +instance of_is_iso [is_iso g] : + LocallyRingedSpace.is_open_immersion g := +@@PresheafedSpace.is_open_immersion.of_is_iso _ g.1 ⟨⟨(inv g).1, + by { erw ← LocallyRingedSpace.comp_val, rw is_iso.hom_inv_id, + erw ← LocallyRingedSpace.comp_val, rw is_iso.inv_hom_id, split; simpa }⟩⟩ + +include H + +instance comp (g : Z ⟶ Y) [LocallyRingedSpace.is_open_immersion g] : + LocallyRingedSpace.is_open_immersion (f ≫ g) := PresheafedSpace.is_open_immersion.comp f.1 g.1 + +instance mono : mono f := +LocallyRingedSpace.forget_to_SheafedSpace.mono_of_mono_map (show mono f.1, by apply_instance) + +instance : SheafedSpace.is_open_immersion (LocallyRingedSpace.forget_to_SheafedSpace.map f) := H + +/-- An explicit pullback cone over `cospan f g` if `f` is an open immersion. -/ +def pullback_cone_of_left : pullback_cone f g := +begin + refine pullback_cone.mk _ + (Y.of_restrict (Top.snd_open_embedding_of_left_open_embedding H.base_open g.1.base)) _, + { use PresheafedSpace.is_open_immersion.pullback_cone_of_left_fst f.1 g.1, + intro x, + have := PresheafedSpace.stalk_map.congr_hom _ _ + (PresheafedSpace.is_open_immersion.pullback_cone_of_left_condition f.1 g.1) x, + rw [PresheafedSpace.stalk_map.comp, PresheafedSpace.stalk_map.comp] at this, + rw ← is_iso.eq_inv_comp at this, + rw this, + apply_instance }, + { exact LocallyRingedSpace.hom.ext _ _ + (PresheafedSpace.is_open_immersion.pullback_cone_of_left_condition _ _) }, +end + +instance : LocallyRingedSpace.is_open_immersion (pullback_cone_of_left f g).snd := +show PresheafedSpace.is_open_immersion (Y.to_PresheafedSpace.of_restrict _), by apply_instance + +/-- The constructed `pullback_cone_of_left` is indeed limiting. -/ +def pullback_cone_of_left_is_limit : is_limit (pullback_cone_of_left f g) := +pullback_cone.is_limit_aux' _ $ λ s, +begin + use PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift f.1 g.1 + (pullback_cone.mk s.fst.1 s.snd.1 (congr_arg LocallyRingedSpace.hom.val s.condition)), + { intro x, + have := PresheafedSpace.stalk_map.congr_hom _ _ + (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_snd f.1 g.1 + (pullback_cone.mk s.fst.1 s.snd.1 (congr_arg LocallyRingedSpace.hom.val s.condition))) x, + change _ = _ ≫ PresheafedSpace.stalk_map s.snd.1 x at this, + rw [PresheafedSpace.stalk_map.comp, ← is_iso.eq_inv_comp] at this, + rw this, + apply_instance }, + split, + { exact LocallyRingedSpace.hom.ext _ _ + (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_fst f.1 g.1 _) }, + split, + { exact LocallyRingedSpace.hom.ext _ _ + (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_snd f.1 g.1 _) }, + intros m h₁ h₂, + rw ← cancel_mono (pullback_cone_of_left f g).snd, + exact (h₂.trans (LocallyRingedSpace.hom.ext _ _ + (PresheafedSpace.is_open_immersion.pullback_cone_of_left_lift_snd f.1 g.1 + (pullback_cone.mk s.fst.1 s.snd.1 (congr_arg LocallyRingedSpace.hom.val s.condition))).symm)) +end + +instance has_pullback_of_left : + has_pullback f g := +⟨⟨⟨_, pullback_cone_of_left_is_limit f g⟩⟩⟩ + +instance has_pullback_of_right : + has_pullback g f := has_pullback_symmetry f g + +/-- Open immersions are stable under base-change. -/ +instance pullback_snd_of_left : + LocallyRingedSpace.is_open_immersion (pullback.snd : pullback f g ⟶ _) := +begin + delta pullback.snd, + rw ← limit.iso_limit_cone_hom_π ⟨_, pullback_cone_of_left_is_limit f g⟩ walking_cospan.right, + apply_instance +end + +/-- Open immersions are stable under base-change. -/ +instance pullback_fst_of_right : +LocallyRingedSpace.is_open_immersion (pullback.fst : pullback g f ⟶ _) := +begin + rw ← pullback_symmetry_hom_comp_snd, + apply_instance +end + +instance pullback_to_base_is_open_immersion [LocallyRingedSpace.is_open_immersion g] : + LocallyRingedSpace.is_open_immersion (limit.π (cospan f g) walking_cospan.one) := +begin + rw [←limit.w (cospan f g) walking_cospan.hom.inl, cospan_map_inl], + apply_instance +end + +instance forget_preserves_pullback_of_left : + preserves_limit (cospan f g) LocallyRingedSpace.forget_to_SheafedSpace := +preserves_limit_of_preserves_limit_cone (pullback_cone_of_left_is_limit f g) +begin + apply (is_limit_map_cone_pullback_cone_equiv _ _).symm.to_fun, + apply is_limit_of_is_limit_pullback_cone_map SheafedSpace.forget_to_PresheafedSpace, + exact PresheafedSpace.is_open_immersion.pullback_cone_of_left_is_limit f.1 g.1 +end + +instance forget_to_PresheafedSpace_preserves_pullback_of_left : + preserves_limit (cospan f g) + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) := +preserves_limit_of_preserves_limit_cone (pullback_cone_of_left_is_limit f g) +begin + apply (is_limit_map_cone_pullback_cone_equiv _ _).symm.to_fun, + exact PresheafedSpace.is_open_immersion.pullback_cone_of_left_is_limit f.1 g.1 +end + +instance forget_to_PresheafedSpace_preserves_open_immersion : + PresheafedSpace.is_open_immersion ((LocallyRingedSpace.forget_to_SheafedSpace ⋙ + SheafedSpace.forget_to_PresheafedSpace).map f) := H + +instance forget_to_Top_preserves_pullback_of_left : + preserves_limit (cospan f g) + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _) := +begin + change preserves_limit _ + ((LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) + ⋙ PresheafedSpace.forget _), + apply_with limits.comp_preserves_limit { instances := ff }, + apply_instance, + apply preserves_limit_of_iso_diagram _ (diagram_iso_cospan.{u} _).symm, + dsimp [SheafedSpace.forget_to_PresheafedSpace], + apply_instance, +end + +instance forget_reflects_pullback_of_left : + reflects_limit (cospan f g) LocallyRingedSpace.forget_to_SheafedSpace := +reflects_limit_of_reflects_isomorphisms _ _ + +instance forget_preserves_pullback_of_right : + preserves_limit (cospan g f) LocallyRingedSpace.forget_to_SheafedSpace := +preserves_pullback_symmetry _ _ _ + +instance forget_to_PresheafedSpace_preserves_pullback_of_right : + preserves_limit (cospan g f) (LocallyRingedSpace.forget_to_SheafedSpace ⋙ + SheafedSpace.forget_to_PresheafedSpace) := +preserves_pullback_symmetry _ _ _ + +instance forget_reflects_pullback_of_right : + reflects_limit (cospan g f) LocallyRingedSpace.forget_to_SheafedSpace := +reflects_limit_of_reflects_isomorphisms _ _ + +instance forget_to_PresheafedSpace_reflects_pullback_of_left : + reflects_limit (cospan f g) + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) := +reflects_limit_of_reflects_isomorphisms _ _ + +instance forget_to_PresheafedSpace_reflects_pullback_of_right : + reflects_limit (cospan g f) + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) := +reflects_limit_of_reflects_isomorphisms _ _ + +lemma pullback_snd_is_iso_of_range_subset (H' : set.range g.1.base ⊆ set.range f.1.base) : + is_iso (pullback.snd : pullback f g ⟶ _) := +begin + apply_with (reflects_isomorphisms.reflects LocallyRingedSpace.forget_to_SheafedSpace) + { instances := ff }, + apply_with (reflects_isomorphisms.reflects SheafedSpace.forget_to_PresheafedSpace) + { instances := ff }, + erw ← preserves_pullback.iso_hom_snd + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget_to_PresheafedSpace) f g, + haveI := PresheafedSpace.is_open_immersion.pullback_snd_is_iso_of_range_subset _ _ H', + apply_instance, + apply_instance +end + +/-- +The universal property of open immersions: +For an open immersion `f : X ⟶ Z`, given any morphism of schemes `g : Y ⟶ Z` whose topological +image is contained in the image of `f`, we can lift this morphism to a unique `Y ⟶ X` that +commutes with these maps. +-/ +def lift (H' : set.range g.1.base ⊆ set.range f.1.base) : Y ⟶ X := +begin + haveI := pullback_snd_is_iso_of_range_subset f g H', + exact inv (pullback.snd : pullback f g ⟶ _) ≫ pullback.fst, +end + +@[simp, reassoc] lemma lift_fac (H' : set.range g.1.base ⊆ set.range f.1.base) : + lift f g H' ≫ f = g := +by { erw category.assoc, rw is_iso.inv_comp_eq, exact pullback.condition } + +lemma lift_uniq (H' : set.range g.1.base ⊆ set.range f.1.base) (l : Y ⟶ X) + (hl : l ≫ f = g) : l = lift f g H' := +by rw [← cancel_mono f, hl, lift_fac] + +lemma lift_range (H' : set.range g.1.base ⊆ set.range f.1.base) : + set.range (lift f g H').1.base = f.1.base ⁻¹' (set.range g.1.base) := +begin + haveI := pullback_snd_is_iso_of_range_subset f g H', + dsimp only [lift], + have : _ = (pullback.fst : pullback f g ⟶ _).val.base := preserves_pullback.iso_hom_fst + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _) f g, + rw [LocallyRingedSpace.comp_val, SheafedSpace.comp_base, ← this, ← category.assoc, coe_comp], + rw [set.range_comp, set.range_iff_surjective.mpr, set.image_univ, Top.pullback_fst_range], + ext, + split, + { rintros ⟨y, eq⟩, exact ⟨y, eq.symm⟩ }, + { rintros ⟨y, eq⟩, exact ⟨y, eq.symm⟩ }, + { rw ← Top.epi_iff_surjective, + rw (show (inv (pullback.snd : pullback f g ⟶ _)).val.base = _, from + (LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _).map_inv _), + apply_instance } +end + +end pullback + +/-- An open immersion is isomorphic to the induced open subscheme on its image. -/ +def iso_restrict {X Y : LocallyRingedSpace} {f : X ⟶ Y} + (H : LocallyRingedSpace.is_open_immersion f) : X ≅ Y.restrict H.base_open := +begin + apply LocallyRingedSpace.iso_of_SheafedSpace_iso, + refine SheafedSpace.forget_to_PresheafedSpace.preimage_iso _, + exact H.iso_restrict +end + +end LocallyRingedSpace.is_open_immersion + +section open_cover + +end open_cover + +end algebraic_geometry diff --git a/src/algebraic_geometry/presheafed_space.lean b/src/algebraic_geometry/presheafed_space.lean index 7262b6fb9c976..9c38f1afa9515 100644 --- a/src/algebraic_geometry/presheafed_space.lean +++ b/src/algebraic_geometry/presheafed_space.lean @@ -9,6 +9,9 @@ import category_theory.adjunction.fully_faithful /-! # Presheafed spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Introduces the category of topological spaces equipped with a presheaf (taking values in an arbitrary target category `C`.) @@ -16,7 +19,7 @@ We further describe how to apply functors and natural transformations to the val presheaves. -/ -universes v u +universes w v u open category_theory open Top @@ -26,13 +29,13 @@ open category_theory.category category_theory.functor variables (C : Type u) [category.{v} C] -local attribute [tidy] tactic.op_induction' +local attribute [tidy] tactic.op_induction' tactic.auto_cases_opens namespace algebraic_geometry /-- A `PresheafedSpace C` is a topological space equipped with a presheaf of `C`s. -/ structure PresheafedSpace := -(carrier : Top) +(carrier : Top.{w}) (presheaf : carrier.presheaf C) variables {C} @@ -41,10 +44,10 @@ namespace PresheafedSpace attribute [protected] presheaf -instance coe_carrier : has_coe (PresheafedSpace C) Top := +instance coe_carrier : has_coe (PresheafedSpace.{w v u} C) Top.{w} := { coe := λ X, X.carrier } -@[simp] lemma as_coe (X : PresheafedSpace C) : X.carrier = (X : Top.{v}) := rfl +@[simp] lemma as_coe (X : PresheafedSpace.{w v u} C) : X.carrier = (X : Top.{w}) := rfl @[simp] lemma mk_coe (carrier) (presheaf) : (({ carrier := carrier, presheaf := presheaf } : PresheafedSpace.{v} C) : Top.{v}) = carrier := rfl @@ -62,8 +65,8 @@ instance [inhabited C] : inhabited (PresheafedSpace C) := ⟨const (Top.of pempt /-- A morphism between presheafed spaces `X` and `Y` consists of a continuous map `f` between the underlying topological spaces, and a (notice contravariant!) map from the presheaf on `Y` to the pushforward of the presheaf on `X` via `f`. -/ -structure hom (X Y : PresheafedSpace C) := -(base : (X : Top.{v}) ⟶ (Y : Top.{v})) +structure hom (X Y : PresheafedSpace.{w v u} C) := +(base : (X : Top.{w}) ⟶ (Y : Top.{w})) (c : Y.presheaf ⟶ base _* X.presheaf) @[ext] lemma ext {X Y : PresheafedSpace C} (α β : hom X Y) @@ -85,8 +88,8 @@ by { cases α, cases β, congr, exacts [w,h] } . /-- The identity morphism of a `PresheafedSpace`. -/ -def id (X : PresheafedSpace C) : hom X X := -{ base := 𝟙 (X : Top.{v}), +def id (X : PresheafedSpace.{w v u} C) : hom X X := +{ base := 𝟙 (X : Top.{w}), c := eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm } instance hom_inhabited (X : PresheafedSpace C) : inhabited (hom X X) := ⟨id X⟩ @@ -109,7 +112,7 @@ local attribute [simp] id comp and we don't have a tactic caching mechanism. -/ /-- The category of PresheafedSpaces. Morphisms are pairs, a continuous map and a presheaf map from the presheaf on the target to the pushforward of the presheaf on the source. -/ -instance category_of_PresheafedSpaces : category (PresheafedSpace C) := +instance category_of_PresheafedSpaces : category (PresheafedSpace.{v v u} C) := { hom := hom, id := id, comp := λ X Y Z f g, comp f g, @@ -143,35 +146,36 @@ instance category_of_PresheafedSpaces : category (PresheafedSpace C) := end variables {C} +local attribute [simp] eq_to_hom_map -@[simp] lemma id_base (X : PresheafedSpace C) : +@[simp] lemma id_base (X : PresheafedSpace.{v v u} C) : ((𝟙 X) : X ⟶ X).base = 𝟙 (X : Top.{v}) := rfl -lemma id_c (X : PresheafedSpace C) : +lemma id_c (X : PresheafedSpace.{v v u} C) : ((𝟙 X) : X ⟶ X).c = eq_to_hom (presheaf.pushforward.id_eq X.presheaf).symm := rfl -@[simp] lemma id_c_app (X : PresheafedSpace C) (U) : +@[simp] lemma id_c_app (X : PresheafedSpace.{v v u} C) (U) : ((𝟙 X) : X ⟶ X).c.app U = X.presheaf.map (eq_to_hom (by { induction U using opposite.rec, cases U, refl })) := by { induction U using opposite.rec, cases U, simp only [id_c], dsimp, simp, } -@[simp] lemma comp_base {X Y Z : PresheafedSpace C} (f : X ⟶ Y) (g : Y ⟶ Z) : +@[simp] lemma comp_base {X Y Z : PresheafedSpace.{v v u} C} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).base = f.base ≫ g.base := rfl -instance (X Y : PresheafedSpace C) : has_coe_to_fun (X ⟶ Y) (λ _, X → Y) := +instance (X Y : PresheafedSpace.{v v u} C) : has_coe_to_fun (X ⟶ Y) (λ _, X → Y) := ⟨λ f, f.base⟩ -lemma coe_to_fun_eq {X Y : PresheafedSpace C} (f : X ⟶ Y) : (f : X → Y) = f.base := rfl +lemma coe_to_fun_eq {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) : (f : X → Y) = f.base := rfl -- The `reassoc` attribute was added despite the LHS not being a composition of two homs, -- for the reasons explained in the docstring. /-- Sometimes rewriting with `comp_c_app` doesn't work because of dependent type issues. In that case, `erw comp_c_app_assoc` might make progress. The lemma `comp_c_app_assoc` is also better suited for rewrites in the opposite direction. -/ -@[reassoc, simp] lemma comp_c_app {X Y Z : PresheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) : +@[reassoc, simp] lemma comp_c_app {X Y Z : PresheafedSpace.{v v u} C} (α : X ⟶ Y) (β : Y ⟶ Z) (U) : (α ≫ β).c.app U = (β.c).app U ≫ (α.c).app (op ((opens.map (β.base)).obj (unop U))) := rfl -lemma congr_app {X Y : PresheafedSpace C} {α β : X ⟶ Y} (h : α = β) (U) : +lemma congr_app {X Y : PresheafedSpace.{v v u} C} {α β : X ⟶ Y} (h : α = β) (U) : α.c.app U = β.c.app U ≫ X.presheaf.map (eq_to_hom (by subst h)) := by { subst h, dsimp, simp, } @@ -180,7 +184,7 @@ variables (C) /-- The forgetful functor from `PresheafedSpace` to `Top`. -/ @[simps] -def forget : PresheafedSpace C ⥤ Top := +def forget : PresheafedSpace.{v v u} C ⥤ Top := { obj := λ X, (X : Top.{v}), map := λ X Y f, f.base } @@ -188,7 +192,7 @@ end section iso -variables {X Y : PresheafedSpace C} +variables {X Y : PresheafedSpace.{v v u} C} /-- An isomorphism of PresheafedSpaces is a homeomorphism of the underlying space, and a @@ -261,7 +265,7 @@ section restrict The restriction of a presheafed space along an open embedding into the space. -/ @[simps] -def restrict {U : Top} (X : PresheafedSpace C) +def restrict {U : Top} (X : PresheafedSpace.{v v u} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : PresheafedSpace C := { carrier := U, presheaf := h.is_open_map.functor.op ⋙ X.presheaf } @@ -270,7 +274,7 @@ def restrict {U : Top} (X : PresheafedSpace C) The map from the restriction of a presheafed space. -/ @[simps] -def of_restrict {U : Top} (X : PresheafedSpace C) +def of_restrict {U : Top} (X : PresheafedSpace.{v v u} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : X.restrict h ⟶ X := { base := f, @@ -287,7 +291,7 @@ instance of_restrict_mono {U : Top} (X : PresheafedSpace C) (f : U ⟶ X.1) ext V, { induction V using opposite.rec, have hV : (opens.map (X.of_restrict hf).base).obj (hf.is_open_map.functor.obj V) = V, - { cases V, simp[opens.map, set.preimage_image_eq _ hf.inj] }, + { ext1, exact set.preimage_image_eq _ hf.inj }, haveI : is_iso (hf.is_open_map.adjunction.counit.app (unop (op (hf.is_open_map.functor.obj V)))) := (nat_iso.is_iso_app_of_is_iso (whisker_left @@ -358,13 +362,13 @@ end restrict The global sections, notated Gamma. -/ @[simps] -def Γ : (PresheafedSpace C)ᵒᵖ ⥤ C := +def Γ : (PresheafedSpace.{v v u} C)ᵒᵖ ⥤ C := { obj := λ X, (unop X).presheaf.obj (op ⊤), map := λ X Y f, f.unop.c.app (op ⊤) } lemma Γ_obj_op (X : PresheafedSpace C) : Γ.obj (op X) = X.presheaf.obj (op ⊤) := rfl -lemma Γ_map_op {X Y : PresheafedSpace C} (f : X ⟶ Y) : +lemma Γ_map_op {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) : Γ.map f.op = f.c.app (op ⊤) := rfl end PresheafedSpace @@ -385,7 +389,7 @@ namespace functor /-- We can apply a functor `F : C ⥤ D` to the values of the presheaf in any `PresheafedSpace C`, giving a functor `PresheafedSpace C ⥤ PresheafedSpace D` -/ -def map_presheaf (F : C ⥤ D) : PresheafedSpace C ⥤ PresheafedSpace D := +def map_presheaf (F : C ⥤ D) : PresheafedSpace.{v v u} C ⥤ PresheafedSpace.{v v u} D := { obj := λ X, { carrier := X.carrier, presheaf := X.presheaf ⋙ F }, map := λ X Y f, { base := f.base, c := whisker_right f.c F }, } @@ -393,9 +397,9 @@ def map_presheaf (F : C ⥤ D) : PresheafedSpace C ⥤ PresheafedSpace D := ((F.map_presheaf.obj X) : Top.{v}) = (X : Top.{v}) := rfl @[simp] lemma map_presheaf_obj_presheaf (F : C ⥤ D) (X : PresheafedSpace C) : (F.map_presheaf.obj X).presheaf = X.presheaf ⋙ F := rfl -@[simp] lemma map_presheaf_map_f (F : C ⥤ D) {X Y : PresheafedSpace C} (f : X ⟶ Y) : +@[simp] lemma map_presheaf_map_f (F : C ⥤ D) {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) : (F.map_presheaf.map f).base = f.base := rfl -@[simp] lemma map_presheaf_map_c (F : C ⥤ D) {X Y : PresheafedSpace C} (f : X ⟶ Y) : +@[simp] lemma map_presheaf_map_c (F : C ⥤ D) {X Y : PresheafedSpace.{v v u} C} (f : X ⟶ Y) : (F.map_presheaf.map f).c = whisker_right f.c F := rfl end functor diff --git a/src/algebraic_geometry/presheafed_space/gluing.lean b/src/algebraic_geometry/presheafed_space/gluing.lean index 428a7c1d98c25..c964bb9f338bf 100644 --- a/src/algebraic_geometry/presheafed_space/gluing.lean +++ b/src/algebraic_geometry/presheafed_space/gluing.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ import topology.gluing -import algebraic_geometry.open_immersion +import algebraic_geometry.open_immersion.basic import algebraic_geometry.locally_ringed_space.has_colimits /-! # Gluing Structured spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a family of gluing data of structured spaces (presheafed spaces, sheafed spaces, or locally ringed spaces), we may glue them together. @@ -87,8 +90,8 @@ such that We can then glue the spaces `U i` together by identifying `V i j` with `V j i`, such that the `U i`'s are open subspaces of the glued space. -/ -@[nolint has_inhabited_instance] -structure glue_data extends glue_data (PresheafedSpace C) := +@[nolint has_nonempty_instance] +structure glue_data extends glue_data (PresheafedSpace.{v} C) := (f_open : ∀ i j, is_open_immersion (f i j)) attribute [instance] glue_data.f_open @@ -98,11 +101,11 @@ namespace glue_data variables {C} (D : glue_data C) local notation `𝖣` := D.to_glue_data -local notation `π₁` i `,` j `,` k := @pullback.fst _ _ _ _ _ (D.f i j) (D.f i k) _ -local notation `π₂` i `,` j `,` k := @pullback.snd _ _ _ _ _ (D.f i j) (D.f i k) _ -local notation `π₁⁻¹` i `,` j `,` k := +local notation `π₁ `i`, `j`, `k := @pullback.fst _ _ _ _ _ (D.f i j) (D.f i k) _ +local notation `π₂ `i`, `j`, `k := @pullback.snd _ _ _ _ _ (D.f i j) (D.f i k) _ +local notation `π₁⁻¹ `i`, `j`, `k := (PresheafedSpace.is_open_immersion.pullback_fst_of_right (D.f i j) (D.f i k)).inv_app -local notation `π₂⁻¹` i `,` j `,` k := +local notation `π₂⁻¹ `i`, `j`, `k := (PresheafedSpace.is_open_immersion.pullback_snd_of_left (D.f i j) (D.f i k)).inv_app /-- The glue data of topological spaces associated to a family of glue data of PresheafedSpaces. -/ @@ -195,7 +198,7 @@ begin have e := (D.snd_inv_app_t_app' i j k U).some_spec, reassoc! e, rw ← e, - simp, + simp [eq_to_hom_map], end variable [has_limits C] @@ -205,8 +208,8 @@ lemma ι_image_preimage_eq (i j : D.J) (U : opens (D.U i).carrier) : (D.f_open j i).open_functor.obj ((opens.map (𝖣 .t j i).base).obj ((opens.map (𝖣 .f i j).base).obj U)) := begin - dsimp only [opens.map, is_open_map.functor], - congr' 1, + ext1, + dsimp only [opens.map_coe, is_open_map.functor_obj_coe], rw [← (show _ = (𝖣 .ι i).base, from 𝖣 .ι_glued_iso_inv (PresheafedSpace.forget _) i), ← (show _ = (𝖣 .ι j).base, from 𝖣 .ι_glued_iso_inv (PresheafedSpace.forget _) j), coe_comp, coe_comp, set.image_comp, set.preimage_comp, set.preimage_image_eq], @@ -284,8 +287,9 @@ begin rcases j with (⟨j, k⟩|j), { refine D.opens_image_preimage_map i j U ≫ (D.f j k).c.app _ ≫ (D.V (j, k)).presheaf.map (eq_to_hom _), - dsimp only [functor.op, opens.map, unop_op], - congr' 2, + rw [functor.op_obj], + congr' 1, ext1, + dsimp only [functor.op_obj, opens.map_coe, unop_op, is_open_map.functor_obj_coe], rw set.preimage_preimage, change (D.f j k ≫ 𝖣 .ι j).base ⁻¹' _ = _, congr' 3, @@ -467,7 +471,7 @@ end PresheafedSpace namespace SheafedSpace -variables (C) [has_products C] +variables (C) [has_products.{v} C] /-- A family of gluing data consists of @@ -488,8 +492,8 @@ such that We can then glue the spaces `U i` together by identifying `V i j` with `V j i`, such that the `U i`'s are open subspaces of the glued space. -/ -@[nolint has_inhabited_instance] -structure glue_data extends glue_data (SheafedSpace C) := +@[nolint has_nonempty_instance] +structure glue_data extends glue_data (SheafedSpace.{v} C) := (f_open : ∀ i j, SheafedSpace.is_open_immersion (f i j)) attribute [instance] glue_data.f_open @@ -560,7 +564,7 @@ such that We can then glue the spaces `U i` together by identifying `V i j` with `V j i`, such that the `U i`'s are open subspaces of the glued space. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure glue_data extends glue_data LocallyRingedSpace := (f_open : ∀ i j, LocallyRingedSpace.is_open_immersion (f i j)) diff --git a/src/algebraic_geometry/presheafed_space/has_colimits.lean b/src/algebraic_geometry/presheafed_space/has_colimits.lean index 3fde6da6ad269..c5bc2df14affb 100644 --- a/src/algebraic_geometry/presheafed_space/has_colimits.lean +++ b/src/algebraic_geometry/presheafed_space/has_colimits.lean @@ -4,13 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import algebraic_geometry.presheafed_space -import topology.category.Top.limits +import topology.category.Top.limits.basic import topology.sheaves.limits -import category_theory.limits.concrete_category /-! # `PresheafedSpace C` has colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `C` has limits, then the category `PresheafedSpace C` has colimits, and the forgetful functor to `Top` preserves these colimits. @@ -33,7 +35,7 @@ The limit of this diagram then constitutes the colimit presheaf. noncomputable theory -universes v u +universes v' u' v u open category_theory open Top @@ -44,7 +46,7 @@ open category_theory.category open category_theory.limits open category_theory.functor -variables {J : Type v} [small_category J] +variables {J : Type u'} [category.{v'} J] variables {C : Type u} [category.{v} C] @@ -52,8 +54,11 @@ namespace algebraic_geometry namespace PresheafedSpace +local attribute [simp] eq_to_hom_map +local attribute [tidy] tactic.auto_cases_opens + @[simp] -lemma map_id_c_app (F : J ⥤ PresheafedSpace C) (j) (U) : +lemma map_id_c_app (F : J ⥤ PresheafedSpace.{v} C) (j) (U) : (F.map (𝟙 j)).c.app (op U) = (pushforward.id (F.obj j).presheaf).inv.app (op U) ≫ (pushforward_eq (by { simp, refl }) (F.obj j).presheaf).hom.app (op U) := @@ -65,7 +70,7 @@ begin end @[simp] -lemma map_comp_c_app (F : J ⥤ PresheafedSpace C) {j₁ j₂ j₃} (f : j₁ ⟶ j₂) (g : j₂ ⟶ j₃) (U) : +lemma map_comp_c_app (F : J ⥤ PresheafedSpace.{v} C) {j₁ j₂ j₃} (f : j₁ ⟶ j₂) (g : j₂ ⟶ j₃) (U) : (F.map (f ≫ g)).c.app (op U) = (F.map g).c.app (op U) ≫ (pushforward_map (F.map g).base (F.map f).c).app (op U) ≫ @@ -78,13 +83,40 @@ begin dsimp, simp, dsimp, simp, -- See note [dsimp, simp] end +/-- +Given a diagram of `PresheafedSpace C`s, its colimit is computed by pushing the sheaves onto +the colimit of the underlying spaces, and taking componentwise limit. +This is the componentwise diagram for an open set `U` of the colimit of the underlying spaces. +-/ +@[simps] +def componentwise_diagram (F : J ⥤ PresheafedSpace.{v} C) + [has_colimit F] (U : opens (limits.colimit F).carrier) : Jᵒᵖ ⥤ C := +{ obj := λ j, (F.obj (unop j)).presheaf.obj (op ((opens.map (colimit.ι F (unop j)).base).obj U)), + map := λ j k f, (F.map f.unop).c.app _ ≫ (F.obj (unop k)).presheaf.map + (eq_to_hom (by { rw [← colimit.w F f.unop, comp_base], refl })), + map_comp' := λ i j k f g, + begin + cases U, + dsimp, + simp_rw [map_comp_c_app, category.assoc], + congr' 1, + rw [Top.presheaf.pushforward.comp_inv_app, Top.presheaf.pushforward_eq_hom_app, + category_theory.nat_trans.naturality_assoc, Top.presheaf.pushforward_map_app], + congr' 1, + rw [category.id_comp, ← (F.obj (unop k)).presheaf.map_comp], + erw ← (F.obj (unop k)).presheaf.map_comp, + congr + end } + +variable [has_colimits_of_shape J Top.{v}] + /-- Given a diagram of presheafed spaces, we can push all the presheaves forward to the colimit `X` of the underlying topological spaces, obtaining a diagram in `(presheaf C X)ᵒᵖ`. -/ @[simps] -def pushforward_diagram_to_colimit (F : J ⥤ PresheafedSpace C) : +def pushforward_diagram_to_colimit (F : J ⥤ PresheafedSpace.{v} C) : J ⥤ (presheaf C (colimit (F ⋙ PresheafedSpace.forget C)))ᵒᵖ := { obj := λ j, op ((colimit.ι (F ⋙ PresheafedSpace.forget C) j) _* (F.obj j).presheaf), map := λ j j' f, @@ -127,26 +159,26 @@ def pushforward_diagram_to_colimit (F : J ⥤ PresheafedSpace C) : { simp, refl, }, end, } -variables [has_limits C] +variables [∀ X : Top.{v}, has_limits_of_shape Jᵒᵖ (X.presheaf C)] /-- Auxiliary definition for `PresheafedSpace.has_colimits`. -/ -def colimit (F : J ⥤ PresheafedSpace C) : PresheafedSpace C := +def colimit (F : J ⥤ PresheafedSpace.{v} C) : PresheafedSpace C := { carrier := colimit (F ⋙ PresheafedSpace.forget C), presheaf := limit (pushforward_diagram_to_colimit F).left_op, } -@[simp] lemma colimit_carrier (F : J ⥤ PresheafedSpace C) : +@[simp] lemma colimit_carrier (F : J ⥤ PresheafedSpace.{v} C) : (colimit F).carrier = limits.colimit (F ⋙ PresheafedSpace.forget C) := rfl -@[simp] lemma colimit_presheaf (F : J ⥤ PresheafedSpace C) : +@[simp] lemma colimit_presheaf (F : J ⥤ PresheafedSpace.{v} C) : (colimit F).presheaf = limit (pushforward_diagram_to_colimit F).left_op := rfl /-- Auxiliary definition for `PresheafedSpace.has_colimits`. -/ @[simps] -def colimit_cocone (F : J ⥤ PresheafedSpace C) : cocone F := +def colimit_cocone (F : J ⥤ PresheafedSpace.{v} C) : cocone F := { X := colimit F, ι := { app := λ j, @@ -172,12 +204,14 @@ def colimit_cocone (F : J ⥤ PresheafedSpace C) : cocone F := simpa, } end, }, } +variables [has_limits_of_shape Jᵒᵖ C] + namespace colimit_cocone_is_colimit /-- Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`. -/ -def desc_c_app (F : J ⥤ PresheafedSpace C) (s : cocone F) (U : (opens ↥(s.X.carrier))ᵒᵖ) : +def desc_c_app (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) (U : (opens ↥(s.X.carrier))ᵒᵖ) : s.X.presheaf.obj U ⟶ (colimit.desc (F ⋙ PresheafedSpace.forget C) ((PresheafedSpace.forget C).map_cocone s) _* @@ -203,7 +237,7 @@ begin dsimp, simp, dsimp, simp, }, end -lemma desc_c_naturality (F : J ⥤ PresheafedSpace C) (s : cocone F) +lemma desc_c_naturality (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) {U V : (opens ↥(s.X.carrier))ᵒᵖ} (i : U ⟶ V) : s.X.presheaf.map i ≫ desc_c_app F s V = desc_c_app F s U ≫ (colimit.desc (F ⋙ forget C) @@ -227,13 +261,13 @@ end /-- Auxiliary definition for `PresheafedSpace.colimit_cocone_is_colimit`. -/ -def desc (F : J ⥤ PresheafedSpace C) (s : cocone F) : colimit F ⟶ s.X := +def desc (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) : colimit F ⟶ s.X := { base := colimit.desc (F ⋙ PresheafedSpace.forget C) ((PresheafedSpace.forget C).map_cocone s), c := { app := λ U, desc_c_app F s U, naturality' := λ U V i, desc_c_naturality F s i } } -lemma desc_fac (F : J ⥤ PresheafedSpace C) (s : cocone F) (j : J) : +lemma desc_fac (F : J ⥤ PresheafedSpace.{v} C) (s : cocone F) (j : J) : (colimit_cocone F).ι.app j ≫ desc F s = s.ι.app j := begin fapply PresheafedSpace.ext, @@ -250,7 +284,7 @@ open colimit_cocone_is_colimit /-- Auxiliary definition for `PresheafedSpace.has_colimits`. -/ -def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace C) : is_colimit (colimit_cocone F) := +def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace.{v} C) : is_colimit (colimit_cocone F) := { desc := λ s, desc F s, fac' := λ s, desc_fac F s, uniq' := λ s m w, @@ -276,10 +310,25 @@ def colimit_cocone_is_colimit (F : J ⥤ PresheafedSpace C) : is_colimit (colimi simp } end, } +instance : has_colimits_of_shape J (PresheafedSpace.{v} C) := +{ has_colimit := λ F, has_colimit.mk + { cocone := colimit_cocone F, + is_colimit := colimit_cocone_is_colimit F } } + +instance : preserves_colimits_of_shape J (PresheafedSpace.forget C) := +{ preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone + (colimit_cocone_is_colimit F) + begin + apply is_colimit.of_iso_colimit (colimit.is_colimit _), + fapply cocones.ext, + { refl, }, + { intro j, dsimp, simp, } + end } + /-- When `C` has limits, the category of presheaved spaces with values in `C` itself has colimits. -/ -instance : has_colimits (PresheafedSpace C) := +instance [has_limits C] : has_colimits (PresheafedSpace.{v} C) := { has_colimits_of_shape := λ J 𝒥, by exactI { has_colimit := λ F, has_colimit.mk { cocone := colimit_cocone F, @@ -289,7 +338,7 @@ instance : has_colimits (PresheafedSpace C) := The underlying topological space of a colimit of presheaved spaces is the colimit of the underlying topological spaces. -/ -instance forget_preserves_colimits : preserves_colimits (PresheafedSpace.forget C) := +instance forget_preserves_colimits [has_limits C] : preserves_colimits (PresheafedSpace.forget C) := { preserves_colimits_of_shape := λ J 𝒥, by exactI { preserves_colimit := λ F, preserves_colimit_of_preserves_colimit_cocone (colimit_cocone_is_colimit F) @@ -300,36 +349,11 @@ instance forget_preserves_colimits : preserves_colimits (PresheafedSpace.forget { intro j, dsimp, simp, } end } } -/-- -Given a diagram of `PresheafedSpace C`s, its colimit is computed by pushing the sheaves onto -the colimit of the underlying spaces, and taking componentwise limit. -This is the componentwise diagram for an open set `U` of the colimit of the underlying spaces. --/ -@[simps] -def componentwise_diagram (F : J ⥤ PresheafedSpace C) - (U : opens (limits.colimit F).carrier) : Jᵒᵖ ⥤ C := -{ obj := λ j, (F.obj (unop j)).presheaf.obj (op ((opens.map (colimit.ι F (unop j)).base).obj U)), - map := λ j k f, (F.map f.unop).c.app _ ≫ (F.obj (unop k)).presheaf.map - (eq_to_hom (by { rw [← colimit.w F f.unop, comp_base], refl })), - map_comp' := λ i j k f g, - begin - cases U, - dsimp, - simp_rw [map_comp_c_app, category.assoc], - congr' 1, - rw [Top.presheaf.pushforward.comp_inv_app, Top.presheaf.pushforward_eq_hom_app, - category_theory.nat_trans.naturality_assoc, Top.presheaf.pushforward_map_app], - congr' 1, - rw [category.id_comp, ← (F.obj (unop k)).presheaf.map_comp], - erw ← (F.obj (unop k)).presheaf.map_comp, - congr - end } - /-- The components of the colimit of a diagram of `PresheafedSpace C` is obtained via taking componentwise limits. -/ -def colimit_presheaf_obj_iso_componentwise_limit (F : J ⥤ PresheafedSpace C) +def colimit_presheaf_obj_iso_componentwise_limit (F : J ⥤ PresheafedSpace.{v} C) [has_colimit F] (U : opens (limits.colimit F).carrier) : (limits.colimit F).presheaf.obj (op U) ≅ limit (componentwise_diagram F U) := begin @@ -339,9 +363,8 @@ begin fapply nat_iso.of_components, { intro X, refine ((F.obj (unop X)).presheaf.map_iso (eq_to_iso _)), - dsimp only [functor.op, unop_op, opens.map], - congr' 2, - rw set.preimage_preimage, + simp only [functor.op_obj, unop_op, op_inj_iff, opens.map_coe, set_like.ext'_iff, + set.preimage_preimage], simp_rw ← comp_app, congr' 2, exact ι_preserves_colimits_iso_inv (forget C) F (unop X) }, @@ -356,7 +379,7 @@ begin end @[simp] -lemma colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app (F : J ⥤ PresheafedSpace C) +lemma colimit_presheaf_obj_iso_componentwise_limit_inv_ι_app (F : J ⥤ PresheafedSpace.{v} C) (U : opens (limits.colimit F).carrier) (j : J) : (colimit_presheaf_obj_iso_componentwise_limit F U).inv ≫ (colimit.ι F j).c.app (op U) = limit.π _ (op j) := @@ -377,7 +400,7 @@ begin end @[simp] -lemma colimit_presheaf_obj_iso_componentwise_limit_hom_π (F : J ⥤ PresheafedSpace C) +lemma colimit_presheaf_obj_iso_componentwise_limit_hom_π (F : J ⥤ PresheafedSpace.{v} C) (U : opens (limits.colimit F).carrier) (j : J) : (colimit_presheaf_obj_iso_componentwise_limit F U).hom ≫ limit.π _ (op j) = (colimit.ι F j).c.app (op U) := diff --git a/src/algebraic_geometry/prime_spectrum/basic.lean b/src/algebraic_geometry/prime_spectrum/basic.lean index d45eb115408ec..7daf83d95d9ca 100644 --- a/src/algebraic_geometry/prime_spectrum/basic.lean +++ b/src/algebraic_geometry/prime_spectrum/basic.lean @@ -5,16 +5,19 @@ Authors: Johan Commelin -/ import algebra.punit_instances import linear_algebra.finsupp -import ring_theory.nilpotent -import ring_theory.localization.away -import ring_theory.ideal.prod import ring_theory.ideal.over -import topology.sets.opens +import ring_theory.ideal.prod +import ring_theory.localization.away.basic +import ring_theory.nilpotent +import topology.sets.closeds import topology.sober /-! # Prime spectrum of a commutative ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The prime spectrum of a commutative ring is the type of all prime ideals. It is naturally endowed with a topology: the Zariski topology. @@ -37,11 +40,9 @@ whereas we denote subsets of prime spectra with `t`, `t'`, etc... ## Inspiration/contributors -The contents of this file draw inspiration from - +The contents of this file draw inspiration from which has contributions from Ramon Fernandez Mir, Kevin Buzzard, Kenny Lau, and Chris Hughes (on an earlier repository). - -/ noncomputable theory @@ -49,67 +50,74 @@ open_locale classical universes u v -variables (R : Type u) [comm_ring R] +variables (R : Type u) (S : Type v) [comm_ring R] [comm_ring S] -/-- The prime spectrum of a commutative ring `R` -is the type of all prime ideals of `R`. +/-- The prime spectrum of a commutative ring `R` is the type of all prime ideals of `R`. It is naturally endowed with a topology (the Zariski topology), and a sheaf of commutative rings (see `algebraic_geometry.structure_sheaf`). It is a fundamental building block in algebraic geometry. -/ -@[nolint has_inhabited_instance] -def prime_spectrum := {I : ideal R // I.is_prime} +@[ext] structure prime_spectrum := +(as_ideal : ideal R) +(is_prime : as_ideal.is_prime) -variable {R} +attribute [instance] prime_spectrum.is_prime namespace prime_spectrum -/-- A method to view a point in the prime spectrum of a commutative ring -as an ideal of that ring. -/ -abbreviation as_ideal (x : prime_spectrum R) : ideal R := x.val +variables {R S} -instance is_prime (x : prime_spectrum R) : - x.as_ideal.is_prime := x.2 +instance [nontrivial R] : nonempty $ prime_spectrum R := +let ⟨I, hI⟩ := ideal.exists_maximal R in ⟨⟨I, hI.is_prime⟩⟩ -/-- -The prime spectrum of the zero ring is empty. --/ +/-- The prime spectrum of the zero ring is empty. -/ lemma punit (x : prime_spectrum punit) : false := x.1.ne_top_iff_one.1 x.2.1 $ subsingleton.elim (0 : punit) 1 ▸ x.1.zero_mem -section -variables (R) (S : Type v) [comm_ring S] +variables (R S) + +/-- The map from the direct sum of prime spectra to the prime spectrum of a direct product. -/ +@[simp] def prime_spectrum_prod_of_sum : + prime_spectrum R ⊕ prime_spectrum S → prime_spectrum (R × S) +| (sum.inl ⟨I, hI⟩) := ⟨ideal.prod I ⊤, by exactI ideal.is_prime_ideal_prod_top⟩ +| (sum.inr ⟨J, hJ⟩) := ⟨ideal.prod ⊤ J, by exactI ideal.is_prime_ideal_prod_top'⟩ /-- The prime spectrum of `R × S` is in bijection with the disjoint unions of the prime spectrum of - `R` and the prime spectrum of `S`. -/ +`R` and the prime spectrum of `S`. -/ noncomputable def prime_spectrum_prod : prime_spectrum (R × S) ≃ prime_spectrum R ⊕ prime_spectrum S := -ideal.prime_ideals_equiv R S +equiv.symm $ equiv.of_bijective (prime_spectrum_prod_of_sum R S) +begin + split, + { rintro (⟨I, hI⟩|⟨J, hJ⟩) (⟨I', hI'⟩|⟨J', hJ'⟩) h; + simp only [ideal.prod.ext_iff, prime_spectrum_prod_of_sum] at h, + { simp only [h] }, + { exact false.elim (hI.ne_top h.left) }, + { exact false.elim (hJ.ne_top h.right) }, + { simp only [h] } }, + { rintro ⟨I, hI⟩, + rcases (ideal.ideal_prod_prime I).mp hI with (⟨p, ⟨hp, rfl⟩⟩|⟨p, ⟨hp, rfl⟩⟩), + { exact ⟨sum.inl ⟨p, hp⟩, rfl⟩ }, + { exact ⟨sum.inr ⟨p, hp⟩, rfl⟩ } } +end variables {R S} @[simp] lemma prime_spectrum_prod_symm_inl_as_ideal (x : prime_spectrum R) : - ((prime_spectrum_prod R S).symm (sum.inl x)).as_ideal = ideal.prod x.as_ideal ⊤ := + ((prime_spectrum_prod R S).symm $ sum.inl x).as_ideal = ideal.prod x.as_ideal ⊤ := by { cases x, refl } + @[simp] lemma prime_spectrum_prod_symm_inr_as_ideal (x : prime_spectrum S) : - ((prime_spectrum_prod R S).symm (sum.inr x)).as_ideal = ideal.prod ⊤ x.as_ideal := + ((prime_spectrum_prod R S).symm $ sum.inr x).as_ideal = ideal.prod ⊤ x.as_ideal := by { cases x, refl } -end - -@[ext] lemma ext {x y : prime_spectrum R} : - x = y ↔ x.as_ideal = y.as_ideal := -subtype.ext_iff_val +/-- The zero locus of a set `s` of elements of a commutative ring `R` is the set of all prime ideals +of the ring that contain the set `s`. -/-- The zero locus of a set `s` of elements of a commutative ring `R` -is the set of all prime ideals of the ring that contain the set `s`. - -An element `f` of `R` can be thought of as a dependent function -on the prime spectrum of `R`. -At a point `x` (a prime ideal) -the function (i.e., element) `f` takes values in the quotient ring `R` modulo the prime ideal `x`. -In this manner, `zero_locus s` is exactly the subset of `prime_spectrum R` -where all "functions" in `s` vanish simultaneously. +An element `f` of `R` can be thought of as a dependent function on the prime spectrum of `R`. +At a point `x` (a prime ideal) the function (i.e., element) `f` takes values in the quotient ring +`R` modulo the prime ideal `x`. In this manner, `zero_locus s` is exactly the subset of +`prime_spectrum R` where all "functions" in `s` vanish simultaneously. -/ def zero_locus (s : set R) : set (prime_spectrum R) := {x | s ⊆ x.as_ideal} @@ -121,15 +129,12 @@ def zero_locus (s : set R) : set (prime_spectrum R) := zero_locus (ideal.span s : set R) = zero_locus s := by { ext x, exact (submodule.gi R R).gc s x.as_ideal } -/-- The vanishing ideal of a set `t` of points -of the prime spectrum of a commutative ring `R` -is the intersection of all the prime ideals in the set `t`. +/-- The vanishing ideal of a set `t` of points of the prime spectrum of a commutative ring `R` is +the intersection of all the prime ideals in the set `t`. -An element `f` of `R` can be thought of as a dependent function -on the prime spectrum of `R`. -At a point `x` (a prime ideal) -the function (i.e., element) `f` takes values in the quotient ring `R` modulo the prime ideal `x`. -In this manner, `vanishing_ideal t` is exactly the ideal of `R` +An element `f` of `R` can be thought of as a dependent function on the prime spectrum of `R`. +At a point `x` (a prime ideal) the function (i.e., element) `f` takes values in the quotient ring +`R` modulo the prime ideal `x`. In this manner, `vanishing_ideal t` is exactly the ideal of `R` consisting of all "functions" that vanish on all of `t`. -/ def vanishing_ideal (t : set (prime_spectrum R)) : ideal R := @@ -258,9 +263,8 @@ begin split, { contrapose!, intro h, - apply set.ne_empty_iff_nonempty.mpr, rcases ideal.exists_le_maximal I h with ⟨M, hM, hIM⟩, - exact ⟨⟨M, hM.is_prime⟩, hIM⟩ }, + exact set.nonempty.ne_empty ⟨⟨M, hM.is_prime⟩, hIM⟩ }, { rintro rfl, apply zero_locus_empty_of_one_mem, trivial } end @@ -268,6 +272,10 @@ end zero_locus (set.univ : set R) = ∅ := zero_locus_empty_of_one_mem (set.mem_univ 1) +lemma vanishing_ideal_eq_top_iff {s : set (prime_spectrum R)} : vanishing_ideal s = ⊤ ↔ s = ∅ := +by rw [← top_le_iff, ← subset_zero_locus_iff_le_vanishing_ideal, + submodule.top_coe, zero_locus_univ, set.subset_empty_iff] + lemma zero_locus_sup (I J : ideal R) : zero_locus ((I ⊔ J : ideal R) : set R) = zero_locus I ∩ zero_locus J := (gc R).l_sup @@ -298,7 +306,7 @@ lemma vanishing_ideal_Union {ι : Sort*} (t : ι → set (prime_spectrum R)) : lemma zero_locus_inf (I J : ideal R) : zero_locus ((I ⊓ J : ideal R) : set R) = zero_locus I ∪ zero_locus J := -set.ext $ λ x, by simpa using x.2.inf_le +set.ext $ λ x, x.2.inf_le lemma union_zero_locus (s s' : set R) : zero_locus s ∪ zero_locus s' = zero_locus ((ideal.span s) ⊓ (ideal.span s') : ideal R) := @@ -306,7 +314,7 @@ by { rw zero_locus_inf, simp } lemma zero_locus_mul (I J : ideal R) : zero_locus ((I * J : ideal R) : set R) = zero_locus I ∪ zero_locus J := -set.ext $ λ x, by simpa using x.2.mul_le +set.ext $ λ x, x.2.mul_le lemma zero_locus_singleton_mul (f g : R) : zero_locus ({f * g} : set R) = zero_locus {f} ∪ zero_locus {g} := @@ -332,20 +340,18 @@ end lemma mem_compl_zero_locus_iff_not_mem {f : R} {I : prime_spectrum R} : I ∈ (zero_locus {f} : set (prime_spectrum R))ᶜ ↔ f ∉ I.as_ideal := -by rw [set.mem_compl_eq, mem_zero_locus, set.singleton_subset_iff]; refl +by rw [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]; refl -/-- The Zariski topology on the prime spectrum of a commutative ring -is defined via the closed sets of the topology: -they are exactly those sets that are the zero locus of a subset of the ring. -/ +/-- The Zariski topology on the prime spectrum of a commutative ring is defined via the closed sets +of the topology: they are exactly those sets that are the zero locus of a subset of the ring. -/ instance zariski_topology : topological_space (prime_spectrum R) := topological_space.of_closed (set.range prime_spectrum.zero_locus) (⟨set.univ, by simp⟩) begin intros Zs h, rw set.sInter_eq_Inter, - let f : Zs → set R := λ i, classical.some (h i.2), - have hf : ∀ i : Zs, ↑i = zero_locus (f i) := λ i, (classical.some_spec (h i.2)).symm, - simp only [hf], + choose f hf using λ i : Zs, h i.prop, + simp only [← hf], exact ⟨_, zero_locus_Union _⟩ end (by { rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩, exact ⟨_, (union_zero_locus s t).symm⟩ }) @@ -359,15 +365,14 @@ lemma is_closed_iff_zero_locus (Z : set (prime_spectrum R)) : by rw [← is_open_compl_iff, is_open_iff, compl_compl] lemma is_closed_iff_zero_locus_ideal (Z : set (prime_spectrum R)) : - is_closed Z ↔ ∃ (s : ideal R), Z = zero_locus s := + is_closed Z ↔ ∃ (I : ideal R), Z = zero_locus I := (is_closed_iff_zero_locus _).trans - ⟨λ x, ⟨_, x.some_spec.trans (zero_locus_span _).symm⟩, λ x, ⟨_, x.some_spec⟩⟩ + ⟨λ ⟨s, hs⟩, ⟨_, (zero_locus_span s).substr hs⟩, λ ⟨I, hI⟩, ⟨I, hI⟩⟩ lemma is_closed_iff_zero_locus_radical_ideal (Z : set (prime_spectrum R)) : - is_closed Z ↔ ∃ (s : ideal R), s.radical = s ∧ Z = zero_locus s := + is_closed Z ↔ ∃ (I : ideal R), I.is_radical ∧ Z = zero_locus I := (is_closed_iff_zero_locus_ideal _).trans - ⟨λ x, ⟨_, ideal.radical_idem _, x.some_spec.trans (zero_locus_radical _).symm⟩, - λ x, ⟨_, x.some_spec.2⟩⟩ + ⟨λ ⟨I, hI⟩, ⟨_, I.radical_is_radical, (zero_locus_radical I).substr hI⟩, λ ⟨I, _, hI⟩, ⟨I, hI⟩⟩ lemma is_closed_zero_locus (s : set R) : is_closed (zero_locus s) := @@ -385,7 +390,7 @@ begin (hs.2 ⟨J, hJ.is_prime⟩ (λ r hr, hIJ (le_of_lt hI $ hs.1 hr)))) }, { refine ⟨x.as_ideal.1, _⟩, rw [eq_comm, set.eq_singleton_iff_unique_mem], - refine ⟨λ _ h, h, λ y hy, prime_spectrum.ext.2 (h.eq_of_le y.2.ne_top hy).symm⟩ } + refine ⟨λ _ h, h, λ y hy, prime_spectrum.ext _ _ (h.eq_of_le y.2.ne_top hy).symm⟩ } end lemma zero_locus_vanishing_ideal_eq_closure (t : set (prime_spectrum R)) : @@ -405,6 +410,35 @@ lemma vanishing_ideal_closure (t : set (prime_spectrum R)) : vanishing_ideal (closure t) = vanishing_ideal t := zero_locus_vanishing_ideal_eq_closure t ▸ (gc R).u_l_u_eq_u t +lemma closure_singleton (x) : closure ({x} : set (prime_spectrum R)) = zero_locus x.as_ideal := +by rw [← zero_locus_vanishing_ideal_eq_closure, vanishing_ideal_singleton] + +lemma is_radical_vanishing_ideal (s : set (prime_spectrum R)) : + (vanishing_ideal s).is_radical := +by { rw [← vanishing_ideal_closure, ← zero_locus_vanishing_ideal_eq_closure, + vanishing_ideal_zero_locus_eq_radical], apply ideal.radical_is_radical } + +lemma vanishing_ideal_anti_mono_iff {s t : set (prime_spectrum R)} + (ht : is_closed t) : s ⊆ t ↔ vanishing_ideal t ≤ vanishing_ideal s := +⟨vanishing_ideal_anti_mono, λ h, +begin + rw [← ht.closure_subset_iff, ← ht.closure_eq], + convert ← zero_locus_anti_mono_ideal h; + apply zero_locus_vanishing_ideal_eq_closure, +end⟩ + +lemma vanishing_ideal_strict_anti_mono_iff {s t : set (prime_spectrum R)} + (hs : is_closed s) (ht : is_closed t) : + s ⊂ t ↔ vanishing_ideal t < vanishing_ideal s := +by rw [set.ssubset_def, vanishing_ideal_anti_mono_iff hs, + vanishing_ideal_anti_mono_iff ht, lt_iff_le_not_le] + +/-- The antitone order embedding of closed subsets of `Spec R` into ideals of `R`. -/ +def closeds_embedding (R : Type*) [comm_ring R] : + (topological_space.closeds $ prime_spectrum R)ᵒᵈ ↪o ideal R := +order_embedding.of_map_le_iff (λ s, vanishing_ideal s.of_dual) + (λ s t, (vanishing_ideal_anti_mono_iff s.2).symm) + lemma t1_space_iff_is_field [is_domain R] : t1_space (prime_spectrum R) ↔ is_field R := begin @@ -415,32 +449,31 @@ begin (is_closed_singleton_iff_is_maximal _).1 (t1_space.t1 ⟨⊥, hbot⟩)) (not_not.2 rfl)) }, { refine ⟨λ x, (is_closed_singleton_iff_is_maximal x).2 _⟩, by_cases hx : x.as_ideal = ⊥, - { exact hx.symm ▸ @ideal.bot_is_maximal R (@field.to_division_ring _ h.to_field) }, + { letI := h.to_field, exact hx.symm ▸ ideal.bot_is_maximal }, { exact absurd h (ring.not_is_field_iff_exists_prime.2 ⟨x.as_ideal, ⟨hx, x.2⟩⟩) } } end local notation `Z(` a `)` := zero_locus (a : set R) -lemma is_irreducible_zero_locus_iff_of_radical (I : ideal R) (hI : I.radical = I) : +lemma is_irreducible_zero_locus_iff_of_radical (I : ideal R) (hI : I.is_radical) : is_irreducible (zero_locus (I : set R)) ↔ I.is_prime := begin rw [ideal.is_prime_iff, is_irreducible], apply and_congr, - { rw [← set.ne_empty_iff_nonempty, ne.def, zero_locus_empty_iff_eq_top] }, + { rw [set.nonempty_iff_ne_empty, ne.def, zero_locus_empty_iff_eq_top] }, { transitivity ∀ (x y : ideal R), Z(I) ⊆ Z(x) ∪ Z(y) → Z(I) ⊆ Z(x) ∨ Z(I) ⊆ Z(y), { simp_rw [is_preirreducible_iff_closed_union_closed, is_closed_iff_zero_locus_ideal], split, { rintros h x y, exact h _ _ ⟨x, rfl⟩ ⟨y, rfl⟩ }, { rintros h _ _ ⟨x, rfl⟩ ⟨y, rfl⟩, exact h x y } }, { simp_rw [← zero_locus_inf, subset_zero_locus_iff_le_vanishing_ideal, - vanishing_ideal_zero_locus_eq_radical, hI], + vanishing_ideal_zero_locus_eq_radical, hI.radical], split, - { intros h x y h', - simp_rw [← set_like.mem_coe, ← set.singleton_subset_iff, ← ideal.span_le], - apply h, - rw [← hI, ← ideal.radical_le_radical_iff, ideal.radical_inf, ← ideal.radical_mul, - ideal.radical_le_radical_iff, hI, ideal.span_mul_span], - simpa [ideal.span_le] using h' }, + { simp_rw [← set_like.mem_coe, ← set.singleton_subset_iff, + ← ideal.span_le, ← ideal.span_singleton_mul_span_singleton], + refine λ h x y h', h _ _ _, + rw [← hI.radical_le_iff] at h' ⊢, + simpa only [ideal.radical_inf, ideal.radical_mul] using h' }, { simp_rw [or_iff_not_imp_left, set_like.not_le_iff_exists], rintros h s t h' ⟨x, hx, hx'⟩ y hy, exact h (h' ⟨ideal.mul_mem_right _ _ hx, ideal.mul_mem_left _ _ hy⟩) hx' } } } @@ -448,7 +481,12 @@ end lemma is_irreducible_zero_locus_iff (I : ideal R) : is_irreducible (zero_locus (I : set R)) ↔ I.radical.is_prime := -(zero_locus_radical I) ▸ is_irreducible_zero_locus_iff_of_radical _ I.radical_idem +zero_locus_radical I ▸ is_irreducible_zero_locus_iff_of_radical _ I.radical_is_radical + +lemma is_irreducible_iff_vanishing_ideal_is_prime {s : set (prime_spectrum R)} : + is_irreducible s ↔ (vanishing_ideal s).is_prime := +by rw [← is_irreducible_iff_closure, ← zero_locus_vanishing_ideal_eq_closure, + is_irreducible_zero_locus_iff_of_radical _ (is_radical_vanishing_ideal s)] instance [is_domain R] : irreducible_space (prime_spectrum R) := begin @@ -457,23 +495,11 @@ begin end instance : quasi_sober (prime_spectrum R) := -begin - constructor, - intros S h₁ h₂, - rw [← h₂.closure_eq, ← zero_locus_vanishing_ideal_eq_closure, - is_irreducible_zero_locus_iff] at h₁, - use ⟨_, h₁⟩, - obtain ⟨s, hs, rfl⟩ := (is_closed_iff_zero_locus_radical_ideal _).mp h₂, - rw is_generic_point_iff_forall_closed h₂, - intros Z hZ hxZ, - obtain ⟨t, rfl⟩ := (is_closed_iff_zero_locus_ideal _).mp hZ, - exact zero_locus_anti_mono (by simpa [hs] using hxZ), - simp [hs] -end +⟨λ S h₁ h₂, ⟨⟨_, is_irreducible_iff_vanishing_ideal_is_prime.1 h₁⟩, + by rw [is_generic_point, closure_singleton, zero_locus_vanishing_ideal_eq_closure, h₂.closure_eq]⟩⟩ section comap -variables {S : Type v} [comm_ring S] {S' : Type*} [comm_ring S'] - +variables {S' : Type*} [comm_ring S'] lemma preimage_comap_zero_locus_aux (f : R →+* S) (s : set R) : (λ y, ⟨ideal.comap f y.as_ideal, infer_instance⟩ : @@ -517,7 +543,7 @@ preimage_comap_zero_locus_aux f s lemma comap_injective_of_surjective (f : R →+* S) (hf : function.surjective f) : function.injective (comap f) := -λ x y h, prime_spectrum.ext.2 (ideal.comap_injective_of_surjective f hf +λ x y h, prime_spectrum.ext _ _ (ideal.comap_injective_of_surjective f hf (congr_arg prime_spectrum.as_ideal h : (comap f x).as_ideal = (comap f y).as_ideal)) lemma comap_singleton_is_closed_of_surjective (f : R →+* S) (hf : function.surjective f) @@ -575,7 +601,8 @@ lemma localization_comap_range [algebra R S] (M : submonoid R) begin ext x, split, - { rintro ⟨p, rfl⟩ x ⟨hx₁, hx₂⟩, + { simp_rw disjoint_iff_inf_le, + rintro ⟨p, rfl⟩ x ⟨hx₁, hx₂⟩, exact (p.2.1 : ¬ _) (p.as_ideal.eq_top_of_is_unit_mem hx₂ (is_localization.map_units S ⟨x, hx₁⟩)) }, { intro h, @@ -585,24 +612,81 @@ begin exact is_localization.comap_map_of_is_prime_disjoint M S _ x.2 h } end +section spec_of_surjective +/-! The comap of a surjective ring homomorphism is a closed embedding between the prime spectra. -/ + +open function ring_hom + +lemma comap_inducing_of_surjective (hf : surjective f) : inducing (comap f) := +{ induced := begin + simp_rw [topological_space_eq_iff, ←is_closed_compl_iff, is_closed_induced_iff, + is_closed_iff_zero_locus], + refine λ s, ⟨λ ⟨F, hF⟩, ⟨zero_locus (f ⁻¹' F), ⟨f ⁻¹' F, rfl⟩, + by rw [preimage_comap_zero_locus, surjective.image_preimage hf, hF]⟩, _⟩, + rintros ⟨-, ⟨F, rfl⟩, hF⟩, + exact ⟨f '' F, hF.symm.trans (preimage_comap_zero_locus f F)⟩, + end } + +lemma image_comap_zero_locus_eq_zero_locus_comap (hf : surjective f) (I : ideal S) : + comap f '' zero_locus I = zero_locus (I.comap f) := +begin + simp only [set.ext_iff, set.mem_image, mem_zero_locus, set_like.coe_subset_coe], + refine λ p, ⟨_, λ h_I_p, _⟩, + { rintro ⟨p, hp, rfl⟩ a ha, + exact hp ha }, + { have hp : ker f ≤ p.as_ideal := (ideal.comap_mono bot_le).trans h_I_p, + refine ⟨⟨p.as_ideal.map f, ideal.map_is_prime_of_surjective hf hp⟩, λ x hx, _, _⟩, + { obtain ⟨x', rfl⟩ := hf x, + exact ideal.mem_map_of_mem f (h_I_p hx) }, + { ext x, + change f x ∈ p.as_ideal.map f ↔ _, + rw ideal.mem_map_iff_of_surjective f hf, + refine ⟨_, λ hx, ⟨x, hx, rfl⟩⟩, + rintros ⟨x', hx', heq⟩, + rw ← sub_sub_cancel x' x, + refine p.as_ideal.sub_mem hx' (hp _), + rwa [mem_ker, map_sub, sub_eq_zero] } }, +end + +lemma range_comap_of_surjective (hf : surjective f) : + set.range (comap f) = zero_locus (ker f) := +begin + rw ← set.image_univ, + convert image_comap_zero_locus_eq_zero_locus_comap _ _ hf _, + rw zero_locus_bot, +end + +lemma is_closed_range_comap_of_surjective (hf : surjective f) : is_closed (set.range (comap f)) := +begin + rw range_comap_of_surjective _ f hf, + exact is_closed_zero_locus ↑(ker f), +end + +lemma closed_embedding_comap_of_surjective (hf : surjective f) : closed_embedding (comap f) := +{ induced := (comap_inducing_of_surjective S f hf).induced, + inj := comap_injective_of_surjective f hf, + closed_range := is_closed_range_comap_of_surjective S f hf } + +end spec_of_surjective + end comap section basic_open /-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/ def basic_open (r : R) : topological_space.opens (prime_spectrum R) := -{ val := { x | r ∉ x.as_ideal }, - property := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ } +{ carrier := { x | r ∉ x.as_ideal }, + is_open' := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ } @[simp] lemma mem_basic_open (f : R) (x : prime_spectrum R) : x ∈ basic_open f ↔ f ∉ x.as_ideal := iff.rfl lemma is_open_basic_open {a : R} : is_open ((basic_open a) : set (prime_spectrum R)) := -(basic_open a).property +(basic_open a).is_open @[simp] lemma basic_open_eq_zero_locus_compl (r : R) : (basic_open r : set (prime_spectrum R)) = (zero_locus {r})ᶜ := -set.ext $ λ x, by simpa only [set.mem_compl_eq, mem_zero_locus, set.singleton_subset_iff] +set.ext $ λ x, by simpa only [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff] @[simp] lemma basic_open_one : basic_open (1 : R) = ⊤ := topological_space.opens.ext $ by simp @@ -612,8 +696,8 @@ topological_space.opens.ext $ by simp lemma basic_open_le_basic_open_iff (f g : R) : basic_open f ≤ basic_open g ↔ f ∈ (ideal.span ({g} : set R)).radical := -by rw [topological_space.opens.le_def, basic_open_eq_zero_locus_compl, - basic_open_eq_zero_locus_compl, set.le_eq_subset, set.compl_subset_compl, +by rw [← set_like.coe_subset_coe, basic_open_eq_zero_locus_compl, + basic_open_eq_zero_locus_compl, set.compl_subset_compl, zero_locus_subset_zero_locus_singleton_iff] lemma basic_open_mul (f g : R) : basic_open (f * g) = basic_open f ⊓ basic_open g := @@ -635,7 +719,7 @@ begin { rintros _ ⟨r, rfl⟩, exact is_open_basic_open }, { rintros p U hp ⟨s, hs⟩, - rw [← compl_compl U, set.mem_compl_eq, ← hs, mem_zero_locus, set.not_subset] at hp, + rw [← compl_compl U, set.mem_compl_iff, ← hs, mem_zero_locus, set.not_subset] at hp, obtain ⟨f, hfs, hfp⟩ := hp, refine ⟨basic_open f, ⟨f, rfl⟩, hfp, _⟩, rw [← set.compl_subset_compl, ← hs, basic_open_eq_zero_locus_compl, compl_compl], @@ -665,7 +749,7 @@ begin rcases submodule.exists_finset_of_mem_supr I hn with ⟨s, hs⟩, use s, -- Using simp_rw here, because `hI` and `zero_locus_supr` need to be applied underneath binders - simp_rw [basic_open_eq_zero_locus_compl f, set.inter_comm, ← set.diff_eq, + simp_rw [basic_open_eq_zero_locus_compl f, set.inter_comm (zero_locus {f})ᶜ, ← set.diff_eq, set.diff_eq_empty, hI, ← zero_locus_supr], rw ← zero_locus_radical, -- this one can't be in `simp_rw` because it would loop apply zero_locus_anti_mono, @@ -677,11 +761,11 @@ end lemma basic_open_eq_bot_iff (f : R) : basic_open f = ⊥ ↔ is_nilpotent f := begin - rw [← subtype.coe_injective.eq_iff, basic_open_eq_zero_locus_compl], - simp only [set.eq_univ_iff_forall, topological_space.opens.empty_eq, set.singleton_subset_iff, + rw [← topological_space.opens.coe_inj, basic_open_eq_zero_locus_compl], + simp only [set.eq_univ_iff_forall, set.singleton_subset_iff, topological_space.opens.coe_bot, nilpotent_iff_mem_prime, set.compl_empty_iff, mem_zero_locus, set_like.mem_coe], - exact subtype.forall, + exact ⟨λ h I hI, h ⟨I, hI⟩, λ h ⟨I, hI⟩, h I hI⟩ end lemma localization_away_comap_range (S : Type v) [comm_ring S] [algebra R S] (r : R) @@ -690,7 +774,7 @@ begin rw localization_comap_range S (submonoid.powers r), ext, simp only [mem_zero_locus, basic_open_eq_zero_locus_compl, set_like.mem_coe, set.mem_set_of_eq, - set.singleton_subset_iff, set.mem_compl_eq], + set.singleton_subset_iff, set.mem_compl_iff, disjoint_iff_inf_le], split, { intros h₁ h₂, exact h₁ ⟨submonoid.mem_powers r, h₂⟩ }, @@ -707,27 +791,23 @@ end basic_open /-- The prime spectrum of a commutative ring is a compact topological space. -/ instance : compact_space (prime_spectrum R) := -{ compact_univ := by { convert is_compact_basic_open (1 : R), rw basic_open_one, refl } } +{ is_compact_univ := by { convert is_compact_basic_open (1 : R), rw basic_open_one, refl } } section order /-! ## The specialization order -We endow `prime_spectrum R` with a partial order, -where `x ≤ y` if and only if `y ∈ closure {x}`. +We endow `prime_spectrum R` with a partial order, where `x ≤ y` if and only if `y ∈ closure {x}`. -/ -instance : partial_order (prime_spectrum R) := -subtype.partial_order _ +instance : partial_order (prime_spectrum R) := partial_order.lift as_ideal ext -@[simp] lemma as_ideal_le_as_ideal (x y : prime_spectrum R) : - x.as_ideal ≤ y.as_ideal ↔ x ≤ y := -subtype.coe_le_coe +@[simp] lemma as_ideal_le_as_ideal (x y : prime_spectrum R) : x.as_ideal ≤ y.as_ideal ↔ x ≤ y := +iff.rfl -@[simp] lemma as_ideal_lt_as_ideal (x y : prime_spectrum R) : - x.as_ideal < y.as_ideal ↔ x < y := -subtype.coe_lt_coe +@[simp] lemma as_ideal_lt_as_ideal (x y : prime_spectrum R) : x.as_ideal < y.as_ideal ↔ x < y := +iff.rfl lemma le_iff_mem_closure (x y : prime_spectrum R) : x ≤ y ↔ y ∈ closure ({x} : set (prime_spectrum R)) := @@ -736,16 +816,27 @@ by rw [← as_ideal_le_as_ideal, ← zero_locus_vanishing_ideal_eq_closure, lemma le_iff_specializes (x y : prime_spectrum R) : x ≤ y ↔ x ⤳ y := -le_iff_mem_closure x y +(le_iff_mem_closure x y).trans specializes_iff_mem_closure.symm + +/-- `nhds` as an order embedding. -/ +@[simps { fully_applied := tt }] +def nhds_order_embedding : prime_spectrum R ↪o filter (prime_spectrum R) := +order_embedding.of_map_le_iff nhds $ λ a b, (le_iff_specializes a b).symm -instance : t0_space (prime_spectrum R) := -by { simp [t0_space_iff_or_not_mem_closure, ← le_iff_mem_closure, - ← not_and_distrib, ← le_antisymm_iff, eq_comm] } +instance : t0_space (prime_spectrum R) := ⟨nhds_order_embedding.injective⟩ + +instance [is_domain R] : order_bot (prime_spectrum R) := +{ bot := ⟨⊥, ideal.bot_prime⟩, + bot_le := λ I, @bot_le _ _ _ I.as_ideal } + +instance {R : Type*} [field R] : unique (prime_spectrum R) := +{ default := ⊥, + uniq := λ x, ext _ _ ((is_simple_order.eq_bot_or_eq_top _).resolve_right x.2.ne_top) } end order -/-- If `x` specializes to `y`, then there is a natural map from the localization of `y` to -the localization of `x`. -/ +/-- If `x` specializes to `y`, then there is a natural map from the localization of `y` to the +localization of `x`. -/ def localization_map_of_specializes {x y : prime_spectrum R} (h : x ⤳ y) : localization.at_prime y.as_ideal →+* localization.at_prime x.as_ideal := @is_localization.lift _ _ _ _ _ _ _ _ @@ -759,25 +850,41 @@ def localization_map_of_specializes {x y : prime_spectrum R} (h : x ⤳ y) : end prime_spectrum - namespace local_ring -variables (R) [local_ring R] +variables [local_ring R] -/-- -The closed point in the prime spectrum of a local ring. --/ -def closed_point : prime_spectrum R := -⟨maximal_ideal R, (maximal_ideal.is_maximal R).is_prime⟩ +/-- The closed point in the prime spectrum of a local ring. -/ +def closed_point : prime_spectrum R := ⟨maximal_ideal R, (maximal_ideal.is_maximal R).is_prime⟩ variable {R} lemma is_local_ring_hom_iff_comap_closed_point {S : Type v} [comm_ring S] [local_ring S] (f : R →+* S) : is_local_ring_hom f ↔ prime_spectrum.comap f (closed_point S) = closed_point R := -by { rw [(local_hom_tfae f).out 0 4, subtype.ext_iff], refl } +by { rw [(local_hom_tfae f).out 0 4, prime_spectrum.ext_iff], refl } @[simp] lemma comap_closed_point {S : Type v} [comm_ring S] [local_ring S] (f : R →+* S) [is_local_ring_hom f] : prime_spectrum.comap f (closed_point S) = closed_point R := (is_local_ring_hom_iff_comap_closed_point f).mp infer_instance +lemma specializes_closed_point (x : prime_spectrum R) : + x ⤳ closed_point R := +(prime_spectrum.le_iff_specializes _ _).mp (local_ring.le_maximal_ideal x.2.1) + +lemma closed_point_mem_iff (U : topological_space.opens $ prime_spectrum R) : + closed_point R ∈ U ↔ U = ⊤ := +begin + split, + { rw eq_top_iff, exact λ h x _, (specializes_closed_point x).mem_open U.2 h }, + { rintro rfl, trivial } +end + +@[simp] lemma _root_.prime_spectrum.comap_residue (x : prime_spectrum (residue_field R)) : + prime_spectrum.comap (residue R) x = closed_point R := +begin + rw subsingleton.elim x ⊥, + ext1, + exact ideal.mk_ker, +end + end local_ring diff --git a/src/algebraic_geometry/prime_spectrum/is_open_comap_C.lean b/src/algebraic_geometry/prime_spectrum/is_open_comap_C.lean index 94a5d44e69992..b8802891a5ab3 100644 --- a/src/algebraic_geometry/prime_spectrum/is_open_comap_C.lean +++ b/src/algebraic_geometry/prime_spectrum/is_open_comap_C.lean @@ -6,6 +6,9 @@ Authors: Damiano Testa import algebraic_geometry.prime_spectrum.basic import ring_theory.polynomial.basic /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The morphism `Spec R[x] --> Spec R` induced by the natural inclusion `R --> R[x]` is an open map. The main result is the first part of the statement of Lemma 00FB in the Stacks Project. @@ -31,28 +34,30 @@ def image_of_Df (f) : set (prime_spectrum R) := lemma is_open_image_of_Df : is_open (image_of_Df f) := begin - rw [image_of_Df, set_of_exists (λ i (x : prime_spectrum R), coeff f i ∉ x.val)], + rw [image_of_Df, set_of_exists (λ i (x : prime_spectrum R), coeff f i ∉ x.as_ideal)], exact is_open_Union (λ i, is_open_basic_open), end /-- If a point of `Spec R[x]` is not contained in the vanishing set of `f`, then its image in `Spec R` is contained in the open set where at least one of the coefficients of `f` is non-zero. -This lemma is a reformulation of `exists_coeff_not_mem_C_inverse`. -/ +This lemma is a reformulation of `exists_C_coeff_not_mem`. -/ lemma comap_C_mem_image_of_Df {I : prime_spectrum R[X]} (H : I ∈ (zero_locus {f} : set (prime_spectrum R[X]))ᶜ ) : prime_spectrum.comap (polynomial.C : R →+* R[X]) I ∈ image_of_Df f := -exists_coeff_not_mem_C_inverse (mem_compl_zero_locus_iff_not_mem.mp H) +exists_C_coeff_not_mem (mem_compl_zero_locus_iff_not_mem.mp H) /-- The open set `image_of_Df f` coincides with the image of `basic_open f` under the morphism `C⁺ : Spec R[x] → Spec R`. -/ lemma image_of_Df_eq_comap_C_compl_zero_locus : image_of_Df f = prime_spectrum.comap (C : R →+* R[X]) '' (zero_locus {f})ᶜ := begin - refine ext (λ x, ⟨λ hx, ⟨⟨map C x.val, (is_prime_map_C_of_is_prime x.property)⟩, ⟨_, _⟩⟩, _⟩), - { rw [mem_compl_eq, mem_zero_locus, singleton_subset_iff], + ext x, + refine ⟨λ hx, ⟨⟨map C x.as_ideal, (is_prime_map_C_of_is_prime x.is_prime)⟩, ⟨_, _⟩⟩, _⟩, + { rw [mem_compl_iff, mem_zero_locus, singleton_subset_iff], cases hx with i hi, exact λ a, hi (mem_map_C_iff.mp a i) }, - { refine subtype.ext (ext (λ x, ⟨λ h, _, λ h, subset_span (mem_image_of_mem C.1 h)⟩)), + { ext x, + refine ⟨λ h, _, λ h, subset_span (mem_image_of_mem C.1 h)⟩, rw ← @coeff_C_zero R x _, exact mem_map_C_iff.mp h 0 }, { rintro ⟨xli, complement, rfl⟩, diff --git a/src/algebraic_geometry/prime_spectrum/maximal.lean b/src/algebraic_geometry/prime_spectrum/maximal.lean new file mode 100644 index 0000000000000..4cbe42e75ea5c --- /dev/null +++ b/src/algebraic_geometry/prime_spectrum/maximal.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2022 David Kurniadi Angdinata. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Kurniadi Angdinata +-/ + +import algebraic_geometry.prime_spectrum.basic +import ring_theory.localization.as_subring + +/-! +# Maximal spectrum of a commutative ring + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The maximal spectrum of a commutative ring is the type of all maximal ideals. +It is naturally a subset of the prime spectrum endowed with the subspace topology. + +## Main definitions + +* `maximal_spectrum R`: The maximal spectrum of a commutative ring `R`, + i.e., the set of all maximal ideals of `R`. + +## Implementation notes + +The Zariski topology on the maximal spectrum is defined as the subspace topology induced by the +natural inclusion into the prime spectrum to avoid API duplication for zero loci. +-/ + +noncomputable theory +open_locale classical + +universes u v + +variables (R : Type u) [comm_ring R] + +/-- The maximal spectrum of a commutative ring `R` is the type of all maximal ideals of `R`. -/ +@[ext] structure maximal_spectrum := +(as_ideal : ideal R) +(is_maximal : as_ideal.is_maximal) + +attribute [instance] maximal_spectrum.is_maximal + +variable {R} + +namespace maximal_spectrum + +instance [nontrivial R] : nonempty $ maximal_spectrum R := +let ⟨I, hI⟩ := ideal.exists_maximal R in ⟨⟨I, hI⟩⟩ + +/-- The natural inclusion from the maximal spectrum to the prime spectrum. -/ +def to_prime_spectrum (x : maximal_spectrum R) : prime_spectrum R := +⟨x.as_ideal, x.is_maximal.is_prime⟩ + +lemma to_prime_spectrum_injective : (@to_prime_spectrum R _).injective := +λ ⟨_, _⟩ ⟨_, _⟩ h, by simpa only [mk.inj_eq] using (prime_spectrum.ext_iff _ _).mp h + +open prime_spectrum set + +lemma to_prime_spectrum_range : + set.range (@to_prime_spectrum R _) = {x | is_closed ({x} : set $ prime_spectrum R)} := +begin + simp only [is_closed_singleton_iff_is_maximal], + ext ⟨x, _⟩, + exact ⟨λ ⟨y, hy⟩, hy ▸ y.is_maximal, λ hx, ⟨⟨x, hx⟩, rfl⟩⟩ +end + +/-- The Zariski topology on the maximal spectrum of a commutative ring is defined as the subspace +topology induced by the natural inclusion into the prime spectrum. -/ +instance zariski_topology : topological_space $ maximal_spectrum R := +prime_spectrum.zariski_topology.induced to_prime_spectrum + +instance : t1_space $ maximal_spectrum R := +⟨λ x, is_closed_induced_iff.mpr + ⟨{to_prime_spectrum x}, (is_closed_singleton_iff_is_maximal _).mpr x.is_maximal, + by simpa only [← image_singleton] using preimage_image_eq {x} to_prime_spectrum_injective⟩⟩ + +lemma to_prime_spectrum_continuous : continuous $ @to_prime_spectrum R _ := continuous_induced_dom + +variables (R) [is_domain R] (K : Type v) [field K] [algebra R K] [is_fraction_ring R K] + +/-- An integral domain is equal to the intersection of its localizations at all its maximal ideals +viewed as subalgebras of its field of fractions. -/ +theorem infi_localization_eq_bot : + (⨅ v : maximal_spectrum R, + localization.subalgebra.of_field K _ v.as_ideal.prime_compl_le_non_zero_divisors) = ⊥ := +begin + ext x, + rw [algebra.mem_bot, algebra.mem_infi], + split, + { apply imp_of_not_imp_not, + intros hrange hlocal, + let denom : ideal R := (submodule.span R {1} : submodule R K).colon (submodule.span R {x}), + have hdenom : (1 : R) ∉ denom := + begin + intro hdenom, + rcases submodule.mem_span_singleton.mp + (submodule.mem_colon.mp hdenom x $ submodule.mem_span_singleton_self x) with ⟨y, hy⟩, + exact hrange ⟨y, by rw [← mul_one $ algebra_map R K y, ← algebra.smul_def, hy, one_smul]⟩ + end, + rcases denom.exists_le_maximal (λ h, (h ▸ hdenom) submodule.mem_top) with ⟨max, hmax, hle⟩, + rcases hlocal ⟨max, hmax⟩ with ⟨n, d, hd, rfl⟩, + apply hd (hle $ submodule.mem_colon.mpr $ λ _ hy, _), + rcases submodule.mem_span_singleton.mp hy with ⟨y, rfl⟩, + exact submodule.mem_span_singleton.mpr + ⟨y * n, by rw [algebra.smul_def, mul_one, map_mul, smul_comm, algebra.smul_def, + algebra.smul_def, mul_comm $ algebra_map R K d, inv_mul_cancel_right₀ $ + (map_ne_zero_iff _ $ no_zero_smul_divisors.algebra_map_injective R K).mpr $ + λ h, (h ▸ hd) max.zero_mem]⟩ }, + { rintro ⟨y, rfl⟩ ⟨v, hv⟩, + exact ⟨y, 1, v.ne_top_iff_one.mp hv.ne_top, by rw [map_one, inv_one, mul_one]⟩ } +end + +end maximal_spectrum + +namespace prime_spectrum + +variables (R) [is_domain R] (K : Type v) [field K] [algebra R K] [is_fraction_ring R K] + +/-- An integral domain is equal to the intersection of its localizations at all its prime ideals +viewed as subalgebras of its field of fractions. -/ +theorem infi_localization_eq_bot : + (⨅ v : prime_spectrum R, + localization.subalgebra.of_field K _ $ v.as_ideal.prime_compl_le_non_zero_divisors) = ⊥ := +begin + ext x, + rw [algebra.mem_infi], + split, + { rw [← maximal_spectrum.infi_localization_eq_bot, algebra.mem_infi], + exact λ hx ⟨v, hv⟩, hx ⟨v, hv.is_prime⟩ }, + { rw [algebra.mem_bot], + rintro ⟨y, rfl⟩ ⟨v, hv⟩, + exact ⟨y, 1, v.ne_top_iff_one.mp hv.ne_top, by rw [map_one, inv_one, mul_one]⟩ } +end + +end prime_spectrum diff --git a/src/algebraic_geometry/prime_spectrum/noetherian.lean b/src/algebraic_geometry/prime_spectrum/noetherian.lean index c9abaabee3c72..6606e553a5a53 100644 --- a/src/algebraic_geometry/prime_spectrum/noetherian.lean +++ b/src/algebraic_geometry/prime_spectrum/noetherian.lean @@ -1,10 +1,14 @@ /- Copyright (c) 2020 Filippo A. E. Nuccio. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Filippo A. E. Nuccio +Authors: Filippo A. E. Nuccio, Andrew Yang -/ import algebraic_geometry.prime_spectrum.basic +import topology.noetherian_space /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves additional properties of the prime spectrum a ring is Noetherian. -/ @@ -20,12 +24,12 @@ variables {A : Type u} [comm_ring A] [is_domain A] [is_noetherian_ring A] /--In a noetherian ring, every ideal contains a product of prime ideals ([samuel, § 3.3, Lemma 3])-/ lemma exists_prime_spectrum_prod_le (I : ideal R) : - ∃ (Z : multiset (prime_spectrum R)), multiset.prod (Z.map (coe : subtype _ → ideal R)) ≤ I := + ∃ (Z : multiset (prime_spectrum R)), multiset.prod (Z.map as_ideal) ≤ I := begin refine is_noetherian.induction (λ (M : ideal R) hgt, _) I, by_cases h_prM : M.is_prime, { use {⟨M, h_prM⟩}, - rw [multiset.map_singleton, multiset.prod_singleton, subtype.coe_mk], + rw [multiset.map_singleton, multiset.prod_singleton], exact le_rfl }, by_cases htop : M = ⊤, { rw htop, @@ -53,8 +57,8 @@ end product or prime ideals ([samuel, § 3.3, Lemma 3]) -/ lemma exists_prime_spectrum_prod_le_and_ne_bot_of_domain (h_fA : ¬ is_field A) {I : ideal A} (h_nzI: I ≠ ⊥) : - ∃ (Z : multiset (prime_spectrum A)), multiset.prod (Z.map (coe : subtype _ → ideal A)) ≤ I ∧ - multiset.prod (Z.map (coe : subtype _ → ideal A)) ≠ ⊥ := + ∃ (Z : multiset (prime_spectrum A)), multiset.prod (Z.map as_ideal) ≤ I ∧ + multiset.prod (Z.map as_ideal) ≠ ⊥ := begin revert h_nzI, refine is_noetherian.induction (λ (M : ideal A) hgt, _) I, @@ -66,10 +70,10 @@ begin obtain ⟨p_id, h_nzp, h_pp⟩ : ∃ (p : ideal A), p ≠ ⊥ ∧ p.is_prime, { apply ring.not_is_field_iff_exists_prime.mp h_fA }, use [({⟨p_id, h_pp⟩} : multiset (prime_spectrum A)), le_top], - rwa [multiset.map_singleton, multiset.prod_singleton, subtype.coe_mk] }, + rwa [multiset.map_singleton, multiset.prod_singleton] }, by_cases h_prM : M.is_prime, { use ({⟨M, h_prM⟩} : multiset (prime_spectrum A)), - rw [multiset.map_singleton, multiset.prod_singleton, subtype.coe_mk], + rw [multiset.map_singleton, multiset.prod_singleton], exact ⟨le_rfl, h_nzM⟩ }, obtain ⟨x, hx, y, hy, h_xy⟩ := (ideal.not_is_prime_iff.mp h_prM).resolve_left h_topM, have lt_add : ∀ z ∉ M, M < M + span A {z}, @@ -90,4 +94,14 @@ begin { rintro (hx | hy); contradiction }, end +open topological_space + +instance : noetherian_space (prime_spectrum R) := +begin + rw (noetherian_space_tfae $ prime_spectrum R).out 0 1, + have H := ‹is_noetherian_ring R›, + rw [is_noetherian_ring_iff, is_noetherian_iff_well_founded] at H, + exact (closeds_embedding R).dual.well_founded H +end + end prime_spectrum diff --git a/src/algebraic_geometry/projective_spectrum/scheme.lean b/src/algebraic_geometry/projective_spectrum/scheme.lean index 82bb7e9c258a6..4fc52b338df17 100644 --- a/src/algebraic_geometry/projective_spectrum/scheme.lean +++ b/src/algebraic_geometry/projective_spectrum/scheme.lean @@ -5,10 +5,14 @@ Authors: Jujian Zhang -/ import algebraic_geometry.projective_spectrum.structure_sheaf import algebraic_geometry.Spec +import ring_theory.graded_algebra.radical /-! # Proj as a scheme +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file is to prove that `Proj` is a scheme. ## Notation @@ -21,7 +25,7 @@ This file is to prove that `Proj` is a scheme. * `Spec` : `Spec` as a locally ringed space * `Spec.T` : the underlying topological space of `Spec` * `sbo g` : basic open set at `g` in `Spec` -* `A⁰_x` : the degree zero part of localized ring `Aₓ` +* `A⁰_x` : the degree zero part of localized ring `Aₓ` ## Implementation @@ -31,13 +35,27 @@ equipped with this structure sheaf is a scheme. We achieve this by using an affi open sets in `Proj`, more specifically: 1. We prove that `Proj` can be covered by basic open sets at homogeneous element of positive degree. -2. We prove that for any `f : A`, `Proj.T | (pbo f)` is homeomorphic to `Spec.T A⁰_f`: - - forward direction : +2. We prove that for any homogeneous element `f : A` of positive degree `m`, `Proj.T | (pbo f)` is + homeomorphic to `Spec.T A⁰_f`: + - forward direction `to_Spec`: for any `x : pbo f`, i.e. a relevant homogeneous prime ideal `x`, send it to - `x ∩ span {g / 1 | g ∈ A}` (see `Top_component.forward.carrier`). This ideal is prime, the proof - is in `Top_component.forward.to_fun`. The fact that this function is continuous is found in - `Top_component.forward` - - backward direction : TBC + `A⁰_f ∩ span {g / 1 | g ∈ x}` (see `Proj_iso_Spec_Top_component.to_Spec.carrier`). This ideal is + prime, the proof is in `Proj_iso_Spec_Top_component.to_Spec.to_fun`. The fact that this function + is continuous is found in `Proj_iso_Spec_Top_component.to_Spec` + - backward direction `from_Spec`: + for any `q : Spec A⁰_f`, we send it to `{a | ∀ i, aᵢᵐ/fⁱ ∈ q}`; we need this to be a + homogeneous prime ideal that is relevant. + * This is in fact an ideal, the proof can be found in + `Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal`; + * This ideal is also homogeneous, the proof can be found in + `Proj_iso_Spec_Top_component.from_Spec.carrier.as_ideal.homogeneous`; + * This ideal is relevant, the proof can be found in + `Proj_iso_Spec_Top_component.from_Spec.carrier.relevant`; + * This ideal is prime, the proof can be found in + `Proj_iso_Spec_Top_component.from_Spec.carrier.prime`. + Hence we have a well defined function `Spec.T A⁰_f → Proj.T | (pbo f)`, this function is called + `Proj_iso_Spec_Top_component.from_Spec.to_fun`. But to prove the continuity of this function, + we need to prove `from_Spec ∘ to_Spec` and `to_Spec ∘ from_Spec` are both identities (TBC). ## Main Definitions and Statements @@ -45,11 +63,10 @@ open sets in `Proj`, more specifically: element of degree `n` is the subring of elements of the form `a/f^m` where `a` has degree `mn`. For a homogeneous element `f` of degree `n` -* `Top_component.forward`: `forward f` is the +* `Proj_iso_Spec_Top_component.to_Spec`: `forward f` is the continuous map between `Proj.T| pbo f` and `Spec.T A⁰_f` -* `Top_component.forward.preimage_eq`: for any `a: A`, if `a/f^m` has degree zero, then the preimage - of `sbo a/f^m` under `forward f` is `pbo f ∩ pbo a`. - +* `Proj_iso_Spec_Top_component.to_Spec.preimage_eq`: for any `a: A`, if `a/f^m` has degree zero, + then the preimage of `sbo a/f^m` under `to_Spec f` is `pbo f ∩ pbo a`. * [Robin Hartshorne, *Algebraic Geometry*][Har77]: Chapter II.2 Proposition 2.5 -/ @@ -80,76 +97,389 @@ local notation `Proj| ` U := Proj .restrict (opens.open_embedding (U : opens Pro local notation `Proj.T| ` U := (Proj .restrict (opens.open_embedding (U : opens Proj.T))).to_SheafedSpace.to_PresheafedSpace.1 -- the underlying topological space of `Proj` restricted to some open set -local notation `pbo` x := projective_spectrum.basic_open 𝒜 x +local notation `pbo ` x := projective_spectrum.basic_open 𝒜 x -- basic open sets in `Proj` -local notation `sbo` f := prime_spectrum.basic_open f +local notation `sbo ` f := prime_spectrum.basic_open f -- basic open sets in `Spec` -local notation `Spec` ring := Spec.LocallyRingedSpace_obj (CommRing.of ring) +local notation `Spec ` ring := Spec.LocallyRingedSpace_obj (CommRing.of ring) -- `Spec` as a locally ringed space -local notation `Spec.T` ring := +local notation `Spec.T ` ring := (Spec.LocallyRingedSpace_obj (CommRing.of ring)).to_SheafedSpace.to_PresheafedSpace.1 -- the underlying topological space of `Spec` +local notation `A⁰_ ` f := homogeneous_localization.away 𝒜 f + +namespace Proj_iso_Spec_Top_component + +/- +This section is to construct the homeomorphism between `Proj` restricted at basic open set at +a homogeneous element `x` and `Spec A⁰ₓ` where `A⁰ₓ` is the degree zero part of the localized +ring `Aₓ`. +-/ + +namespace to_Spec + +open ideal + +-- This section is to construct the forward direction : +-- So for any `x` in `Proj| (pbo f)`, we need some point in `Spec A⁰_f`, i.e. a prime ideal, +-- and we need this correspondence to be continuous in their Zariski topology. + +variables {𝒜} {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : Proj| (pbo f)) + +/--For any `x` in `Proj| (pbo f)`, the corresponding ideal in `Spec A⁰_f`. This fact that this ideal +is prime is proven in `Top_component.forward.to_fun`-/ +def carrier : ideal (A⁰_ f) := +ideal.comap (algebra_map (A⁰_ f) (away f)) + (ideal.span $ algebra_map A (away f) '' x.val.as_homogeneous_ideal) + +lemma mem_carrier_iff (z : A⁰_ f) : + z ∈ carrier 𝒜 x ↔ + z.val ∈ ideal.span (algebra_map A (away f) '' x.1.as_homogeneous_ideal) := +iff.rfl + +lemma mem_carrier.clear_denominator' [decidable_eq (away f)] + {z : localization.away f} + (hz : z ∈ span ((algebra_map A (away f)) '' x.val.as_homogeneous_ideal)) : + ∃ (c : algebra_map A (away f) '' x.1.as_homogeneous_ideal →₀ away f) + (N : ℕ) (acd : Π y ∈ c.support.image c, A), + f ^ N • z = algebra_map A (away f) + (∑ i in c.support.attach, acd (c i) (finset.mem_image.mpr ⟨i, ⟨i.2, rfl⟩⟩) * i.1.2.some) := +begin + rw [←submodule_span_eq, finsupp.span_eq_range_total, linear_map.mem_range] at hz, + rcases hz with ⟨c, eq1⟩, + rw [finsupp.total_apply, finsupp.sum] at eq1, + obtain ⟨⟨_, N, rfl⟩, hN⟩ := is_localization.exist_integer_multiples_of_finset (submonoid.powers f) + (c.support.image c), + choose acd hacd using hN, + + refine ⟨c, N, acd, _⟩, + rw [← eq1, smul_sum, map_sum, ← sum_attach], + congr' 1, + ext i, + rw [_root_.map_mul, hacd, (classical.some_spec i.1.2).2, smul_eq_mul, smul_mul_assoc], + refl +end + +lemma mem_carrier.clear_denominator [decidable_eq (away f)] + {z : A⁰_ f} (hz : z ∈ carrier 𝒜 x) : + ∃ (c : algebra_map A (away f) '' x.1.as_homogeneous_ideal →₀ away f) + (N : ℕ) (acd : Π y ∈ c.support.image c, A), + f ^ N • z.val = algebra_map A (away f) + (∑ i in c.support.attach, acd (c i) (finset.mem_image.mpr ⟨i, ⟨i.2, rfl⟩⟩) * i.1.2.some) := +mem_carrier.clear_denominator' x $ (mem_carrier_iff 𝒜 x z).mpr hz + +lemma disjoint : + (disjoint (x.1.as_homogeneous_ideal.to_ideal : set A) (submonoid.powers f : set A)) := +begin + by_contra rid, + rw [set.not_disjoint_iff] at rid, + choose g hg using rid, + obtain ⟨hg1, ⟨k, rfl⟩⟩ := hg, + by_cases k_ineq : 0 < k, + { erw x.1.is_prime.pow_mem_iff_mem _ k_ineq at hg1, + exact x.2 hg1 }, + { erw [show k = 0, by linarith, pow_zero, ←ideal.eq_top_iff_one] at hg1, + apply x.1.is_prime.1, + exact hg1 }, +end + +lemma carrier_ne_top : + carrier 𝒜 x ≠ ⊤ := +begin + have eq_top := disjoint x, + classical, + contrapose! eq_top, + obtain ⟨c, N, acd, eq1⟩ := mem_carrier.clear_denominator _ x ((ideal.eq_top_iff_one _).mp eq_top), + rw [algebra.smul_def, homogeneous_localization.one_val, mul_one] at eq1, + change localization.mk (f ^ N) 1 = mk (∑ _, _) 1 at eq1, + simp only [mk_eq_mk', is_localization.eq] at eq1, + rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩, + erw [one_mul, one_mul] at eq1, + change f^_ * f^_ = f^_ * _ at eq1, + rw set.not_disjoint_iff_nonempty_inter, + refine ⟨f^M * f^N, eq1.symm ▸ mul_mem_left _ _ + (sum_mem _ (λ i hi, mul_mem_left _ _ _)), ⟨M + N, by rw pow_add⟩⟩, + generalize_proofs h₁ h₂, + exact (classical.some_spec h₂).1, +end + +variable (f) +/--The function between the basic open set `D(f)` in `Proj` to the corresponding basic open set in +`Spec A⁰_f`. This is bundled into a continuous map in `Top_component.forward`. +-/ +def to_fun (x : Proj.T| (pbo f)) : (Spec.T (A⁰_ f)) := +⟨carrier 𝒜 x, carrier_ne_top x, λ x1 x2 hx12, begin + classical, simp only [mem_carrier_iff] at hx12 ⊢, + let J := span (⇑(algebra_map A (away f)) '' x.val.as_homogeneous_ideal), + suffices h : ∀ (x y : localization.away f), x * y ∈ J → x ∈ J ∨ y ∈ J, + { rw [homogeneous_localization.mul_val] at hx12, exact h x1.val x2.val hx12, }, + clear' x1 x2 hx12, intros x1 x2 hx12, + induction x1 using localization.induction_on with data_x1, + induction x2 using localization.induction_on with data_x2, + rcases ⟨data_x1, data_x2⟩ with ⟨⟨a1, _, ⟨n1, rfl⟩⟩, ⟨a2, _, ⟨n2, rfl⟩⟩⟩, + rcases mem_carrier.clear_denominator' x hx12 with ⟨c, N, acd, eq1⟩, + simp only [algebra.smul_def] at eq1, + change localization.mk (f ^ N) 1 * (mk _ _ * mk _ _) = mk (∑ _, _) _ at eq1, + simp only [localization.mk_mul, one_mul] at eq1, + simp only [mk_eq_mk', is_localization.eq] at eq1, + rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩, + rw [submonoid.coe_one, one_mul] at eq1, + change f^_ * (_ * _) = f^_ * (f^_ * f^_ * _) at eq1, + rcases x.1.is_prime.mem_or_mem (show a1 * a2 * f ^ N * f ^ M ∈ _, from _) with h1|rid2, + rcases x.1.is_prime.mem_or_mem h1 with h1|rid1, + rcases x.1.is_prime.mem_or_mem h1 with h1|h2, + { left, simp only [show (mk a1 ⟨f ^ n1, _⟩ : away f) = mk a1 1 * mk 1 ⟨f^n1, ⟨n1, rfl⟩⟩, + by rw [localization.mk_mul, mul_one, one_mul]], + exact ideal.mul_mem_right _ _ (ideal.subset_span ⟨_, h1, rfl⟩), }, + { right, simp only [show (mk a2 ⟨f ^ n2, _⟩ : away f) = mk a2 1 * mk 1 ⟨f^n2, ⟨n2, rfl⟩⟩, + by rw [localization.mk_mul, mul_one, one_mul]], + exact ideal.mul_mem_right _ _ (ideal.subset_span ⟨_, h2, rfl⟩), }, + { exact false.elim (x.2 (x.1.is_prime.mem_of_pow_mem N rid1)), }, + { exact false.elim (x.2 (x.1.is_prime.mem_of_pow_mem M rid2)), }, + { rw [←mul_comm (f^M), ←mul_comm (f^N), eq1], + refine mul_mem_left _ _ (mul_mem_left _ _ (sum_mem _ (λ i hi, mul_mem_left _ _ _))), + generalize_proofs h₁ h₂, exact (classical.some_spec h₂).1 }, +end⟩ + +/- +The preimage of basic open set `D(a/f^n)` in `Spec A⁰_f` under the forward map from `Proj A` to +`Spec A⁰_f` is the basic open set `D(a) ∩ D(f)` in `Proj A`. This lemma is used to prove that the +forward map is continuous. +-/ +lemma preimage_eq (a b : A) (k : ℕ) (a_mem : a ∈ 𝒜 k) (b_mem1 : b ∈ 𝒜 k) + (b_mem2 : b ∈ submonoid.powers f) : to_fun 𝒜 f ⁻¹' + ((@prime_spectrum.basic_open (A⁰_ f) _ + (quotient.mk' ⟨k, ⟨a, a_mem⟩, ⟨b, b_mem1⟩, b_mem2⟩)) : + set (prime_spectrum (homogeneous_localization.away 𝒜 f))) + = {x | x.1 ∈ (pbo f) ⊓ (pbo a)} := +begin + classical, + ext1 y, split; intros hy, + { refine ⟨y.2, _⟩, + rw [set.mem_preimage, set_like.mem_coe, prime_spectrum.mem_basic_open] at hy, + rw projective_spectrum.mem_coe_basic_open, + intro a_mem_y, + apply hy, + rw [to_fun, mem_carrier_iff, homogeneous_localization.val_mk', subtype.coe_mk], + dsimp, rcases b_mem2 with ⟨k, hk⟩, + simp only [show (mk a ⟨b, ⟨k, hk⟩⟩ : away f) = mk 1 ⟨f^k, ⟨_, rfl⟩⟩ * mk a 1, + by { rw [mk_mul, one_mul, mul_one], congr, rw hk }], + exact ideal.mul_mem_left _ _ (ideal.subset_span ⟨_, a_mem_y, rfl⟩), }, + { change y.1 ∈ _ at hy, + rcases hy with ⟨hy1, hy2⟩, + rw projective_spectrum.mem_coe_basic_open at hy1 hy2, + rw [set.mem_preimage, to_fun, set_like.mem_coe, prime_spectrum.mem_basic_open], + intro rid, dsimp at rid, + rcases mem_carrier.clear_denominator 𝒜 _ rid with ⟨c, N, acd, eq1⟩, + rw [algebra.smul_def] at eq1, + change localization.mk (f^N) 1 * mk _ _ = mk (∑ _, _) _ at eq1, + rw [mk_mul, one_mul, mk_eq_mk', is_localization.eq] at eq1, + rcases eq1 with ⟨⟨_, ⟨M, rfl⟩⟩, eq1⟩, + rw [submonoid.coe_one, one_mul] at eq1, + simp only [subtype.coe_mk] at eq1, + + rcases y.1.is_prime.mem_or_mem (show a * f ^ N * f ^ M ∈ _, from _) with H1 | H3, + rcases y.1.is_prime.mem_or_mem H1 with H1 | H2, + { exact hy2 H1, }, + { exact y.2 (y.1.is_prime.mem_of_pow_mem N H2), }, + { exact y.2 (y.1.is_prime.mem_of_pow_mem M H3), }, + { rw [mul_comm _ (f^N), mul_comm _ (f^M), eq1], + refine mul_mem_left _ _ (mul_mem_left _ _ (sum_mem _ (λ i hi, mul_mem_left _ _ _))), + generalize_proofs h₁ h₂, exact (classical.some_spec h₂).1, }, }, +end + +end to_Spec section + variable {𝒜} -/-- -The degree zero part of the localized ring `Aₓ` is the subring of elements of the form `a/x^n` such -that `a` and `x^n` have the same degree. + +/--The continuous function between the basic open set `D(f)` in `Proj` to the corresponding basic +open set in `Spec A⁰_f`. +-/ +def to_Spec {f : A} : (Proj.T| (pbo f)) ⟶ (Spec.T (A⁰_ f)) := +{ to_fun := to_Spec.to_fun 𝒜 f, + continuous_to_fun := begin + apply is_topological_basis.continuous (prime_spectrum.is_topological_basis_basic_opens), + rintros _ ⟨⟨k, ⟨a, ha⟩, ⟨b, hb1⟩, ⟨k', hb2⟩⟩, rfl⟩, dsimp, + erw to_Spec.preimage_eq f a b k ha hb1 ⟨k', hb2⟩, + refine is_open_induced_iff.mpr ⟨(pbo f).1 ⊓ (pbo a).1, is_open.inter (pbo f).2 (pbo a).2, _⟩, + ext z, split; intros hz; simpa [set.mem_preimage], + end } + +end + +namespace from_Spec + +open graded_algebra set_like finset (hiding mk_zero) +open _root_.homogeneous_localization + +variables {𝒜} {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) + +private meta def mem_tac : tactic unit := +let b : tactic unit := + `[exact pow_mem_graded _ (submodule.coe_mem _) <|> exact nat_cast_mem_graded _ _ <|> + exact pow_mem_graded _ f_deg] in +b <|> `[by repeat { all_goals { apply graded_monoid.mul_mem } }; b] + +include f_deg +/--The function from `Spec A⁰_f` to `Proj|D(f)` is defined by `q ↦ {a | aᵢᵐ/fⁱ ∈ q}`, i.e. sending +`q` a prime ideal in `A⁰_f` to the homogeneous prime relevant ideal containing only and all the +elements `a : A` such that for every `i`, the degree 0 element formed by dividing the `m`-th power +of the `i`-th projection of `a` by the `i`-th power of the degree-`m` homogeneous element `f`, +lies in `q`. + +The set `{a | aᵢᵐ/fⁱ ∈ q}` +* is an ideal, as proved in `carrier.as_ideal`; +* is homogeneous, as proved in `carrier.as_homogeneous_ideal`; +* is prime, as proved in `carrier.as_ideal.prime`; +* is relevant, as proved in `carrier.relevant`. -/ -def degree_zero_part {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) : subring (away f) := -{ carrier := { y | ∃ (n : ℕ) (a : 𝒜 (m * n)), y = mk a.1 ⟨f^n, ⟨n, rfl⟩⟩ }, - mul_mem' := λ _ _ ⟨n, ⟨a, h⟩⟩ ⟨n', ⟨b, h'⟩⟩, h.symm ▸ h'.symm ▸ - ⟨n+n', ⟨⟨a.1 * b.1, (mul_add m n n').symm ▸ mul_mem a.2 b.2⟩, - by {rw mk_mul, congr' 1, simp only [pow_add], refl }⟩⟩, - one_mem' := ⟨0, ⟨1, (mul_zero m).symm ▸ one_mem⟩, - by { symmetry, convert ← mk_self 1, simp only [pow_zero], refl, }⟩, - add_mem' := λ _ _ ⟨n, ⟨a, h⟩⟩ ⟨n', ⟨b, h'⟩⟩, h.symm ▸ h'.symm ▸ - ⟨n+n', ⟨⟨f ^ n * b.1 + f ^ n' * a.1, (mul_add m n n').symm ▸ - add_mem (mul_mem (by { rw mul_comm, exact set_like.graded_monoid.pow_mem n f_deg }) b.2) - begin - rw add_comm, - refine mul_mem _ a.2, - rw mul_comm, - exact set_like.graded_monoid.pow_mem _ f_deg - end⟩, begin - rw add_mk, - congr' 1, - simp only [pow_add], - refl, - end⟩⟩, - zero_mem' := ⟨0, ⟨0, (mk_zero _).symm⟩⟩, - neg_mem' := λ x ⟨n, ⟨a, h⟩⟩, h.symm ▸ ⟨n, ⟨-a, neg_mk _ _⟩⟩ } - -local notation `A⁰_` f_deg := degree_zero_part f_deg - -instance (f : A) {m : ℕ} (f_deg : f ∈ 𝒜 m) : comm_ring (degree_zero_part f_deg) := -(degree_zero_part f_deg).to_comm_ring +def carrier (q : Spec.T (A⁰_ f)) : set A := +{a | ∀ i, (quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ m, by mem_tac⟩, + ⟨f^i, by rw mul_comm; mem_tac⟩, ⟨_, rfl⟩⟩ : A⁰_ f) ∈ q.1} + +lemma mem_carrier_iff (q : Spec.T (A⁰_ f)) (a : A) : + a ∈ carrier f_deg q ↔ + ∀ i, (quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ m, by mem_tac⟩, ⟨f^i, by rw mul_comm; mem_tac⟩, ⟨_, rfl⟩⟩ + : A⁰_ f) ∈ q.1 := +iff.rfl + +lemma mem_carrier_iff' (q : Spec.T (A⁰_ f)) (a : A) : + a ∈ carrier f_deg q ↔ + ∀ i, (localization.mk (proj 𝒜 i a ^ m) ⟨f^i, ⟨i, rfl⟩⟩ : localization.away f) ∈ + (algebra_map (homogeneous_localization.away 𝒜 f) (localization.away f)) '' q.1.1 := +(mem_carrier_iff f_deg q a).trans begin + split; intros h i; specialize h i, + { rw set.mem_image, refine ⟨_, h, rfl⟩, }, + { rw set.mem_image at h, rcases h with ⟨x, h, hx⟩, + convert h, rw [ext_iff_val, val_mk'], dsimp only [subtype.coe_mk], rw ←hx, refl, }, +end + +lemma carrier.add_mem (q : Spec.T (A⁰_ f)) {a b : A} (ha : a ∈ carrier f_deg q) + (hb : b ∈ carrier f_deg q) : + a + b ∈ carrier f_deg q := +begin + refine λ i, (q.2.mem_or_mem _).elim id id, + change (quotient.mk' ⟨_, _, _, _⟩ : A⁰_ f) ∈ q.1, dsimp only [subtype.coe_mk], + simp_rw [←pow_add, map_add, add_pow, mul_comm, ← nsmul_eq_mul], + let g : ℕ → A⁰_ f := λ j, (m + m).choose j • if h2 : m + m < j then 0 else if h1 : j ≤ m + then quotient.mk' ⟨m * i, ⟨proj 𝒜 i a^j * proj 𝒜 i b ^ (m - j), _⟩, + ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩ * + quotient.mk' ⟨m * i, ⟨proj 𝒜 i b ^ m, by mem_tac⟩, ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩ + else quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ m, by mem_tac⟩, + ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩ * quotient.mk' ⟨m * i, ⟨proj 𝒜 i a ^ (j - m) * + proj 𝒜 i b ^ (m + m - j), _⟩, ⟨_, by rw mul_comm; mem_tac⟩, ⟨i, rfl⟩⟩, + rotate, + { rw (_ : m*i = _), mem_tac, rw [← add_smul, nat.add_sub_of_le h1], refl }, + { rw (_ : m*i = _), mem_tac, rw ←add_smul, congr, zify [le_of_not_lt h2, le_of_not_le h1], abel }, + convert_to ∑ i in range (m + m + 1), g i ∈ q.1, swap, + { refine q.1.sum_mem (λ j hj, nsmul_mem _ _), split_ifs, + exacts [q.1.zero_mem, q.1.mul_mem_left _ (hb i), q.1.mul_mem_right _ (ha i)] }, + rw [ext_iff_val, val_mk'], + change _ = (algebra_map (homogeneous_localization.away 𝒜 f) (localization.away f)) _, + dsimp only [subtype.coe_mk], rw [map_sum, mk_sum], + apply finset.sum_congr rfl (λ j hj, _), + change _ = homogeneous_localization.val _, + rw [homogeneous_localization.smul_val], + split_ifs with h2 h1, + { exact ((finset.mem_range.1 hj).not_le h2).elim }, + all_goals { simp only [mul_val, zero_val, val_mk', subtype.coe_mk, mk_mul, ←smul_mk], congr' 2 }, + { rw [mul_assoc, ←pow_add, add_comm (m-j), nat.add_sub_assoc h1] }, { simp_rw [pow_add], refl }, + { rw [← mul_assoc, ←pow_add, nat.add_sub_of_le (le_of_not_le h1)] }, { simp_rw [pow_add], refl }, +end + +variables (hm : 0 < m) (q : Spec.T (A⁰_ f)) +include hm + +lemma carrier.zero_mem : (0 : A) ∈ carrier f_deg q := λ i, begin + convert submodule.zero_mem q.1 using 1, + rw [ext_iff_val, val_mk', zero_val], simp_rw [map_zero, zero_pow hm], + convert localization.mk_zero _ using 1, +end + +lemma carrier.smul_mem (c x : A) (hx : x ∈ carrier f_deg q) : c • x ∈ carrier f_deg q := +begin + revert c, + refine direct_sum.decomposition.induction_on 𝒜 _ _ _, + { rw zero_smul, exact carrier.zero_mem f_deg hm _ }, + { rintros n ⟨a, ha⟩ i, + simp_rw [subtype.coe_mk, proj_apply, smul_eq_mul, coe_decompose_mul_of_left_mem 𝒜 i ha], + split_ifs, + { convert_to (quotient.mk' ⟨_, ⟨a^m, pow_mem_graded m ha⟩, ⟨_, _⟩, ⟨n, rfl⟩⟩ * quotient.mk' + ⟨_, ⟨proj 𝒜 (i - n) x ^ m, by mem_tac⟩, ⟨_, _⟩, ⟨i - n, rfl⟩⟩ : A⁰_ f) ∈ q.1, + { erw [ext_iff_val, val_mk', mul_val, val_mk', val_mk', subtype.coe_mk], + simp_rw [mul_pow, subtype.coe_mk], rw [localization.mk_mul], + congr, erw [← pow_add, nat.add_sub_of_le h] }, + { exact ideal.mul_mem_left _ _ (hx _), rw [smul_eq_mul, mul_comm], mem_tac, } }, + { simp_rw [zero_pow hm], convert carrier.zero_mem f_deg hm q i, rw [map_zero, zero_pow hm] } }, + { simp_rw add_smul, exact λ _ _, carrier.add_mem f_deg q }, +end /-- -Every element in the degree zero part of `Aₓ` can be written as `a/x^n` for some `a` and `n : ℕ`, -`degree_zero_part.deg` picks this natural number `n` +For a prime ideal `q` in `A⁰_f`, the set `{a | aᵢᵐ/fⁱ ∈ q}` as an ideal. -/ -def degree_zero_part.deg {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) : ℕ := -x.2.some +def carrier.as_ideal : ideal A := +{ carrier := carrier f_deg q, + zero_mem' := carrier.zero_mem f_deg hm q, + add_mem' := λ a b, carrier.add_mem f_deg q, + smul_mem' := carrier.smul_mem f_deg hm q } + +lemma carrier.as_ideal.homogeneous : (carrier.as_ideal f_deg hm q).is_homogeneous 𝒜 := +λ i a ha j, (em (i = j)).elim + (λ h, h ▸ by simpa only [proj_apply, decompose_coe, of_eq_same] using ha _) + (λ h, begin + simp only [proj_apply, decompose_of_mem_ne 𝒜 (submodule.coe_mem (decompose 𝒜 a i)) h, + zero_pow hm], convert carrier.zero_mem f_deg hm q j, rw [map_zero, zero_pow hm], + end) /-- -Every element in the degree zero part of `Aₓ` can be written as `a/x^n` for some `a` and `n : ℕ`, -`degree_zero_part.deg` picks the numerator `a` +For a prime ideal `q` in `A⁰_f`, the set `{a | aᵢᵐ/fⁱ ∈ q}` as a homogeneous ideal. -/ -def degree_zero_part.num {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) : A := -x.2.some_spec.some.1 +def carrier.as_homogeneous_ideal : homogeneous_ideal 𝒜 := +⟨carrier.as_ideal f_deg hm q, carrier.as_ideal.homogeneous f_deg hm q⟩ -lemma degree_zero_part.num_mem {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) : - degree_zero_part.num f_deg x ∈ 𝒜 (m * degree_zero_part.deg f_deg x) := -x.2.some_spec.some.2 +lemma carrier.denom_not_mem : f ∉ carrier.as_ideal f_deg hm q := +λ rid, q.is_prime.ne_top $ (ideal.eq_top_iff_one _).mpr +begin + convert rid m, + simpa only [ext_iff_val, one_val, proj_apply, decompose_of_mem_same _ f_deg, val_mk'] using + (mk_self (⟨_, m, rfl⟩ : submonoid.powers f)).symm, +end -lemma degree_zero_part.eq {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x : A⁰_ f_deg) : - x.1 = mk (degree_zero_part.num f_deg x) ⟨f^(degree_zero_part.deg f_deg x), ⟨_, rfl⟩⟩ := -x.2.some_spec.some_spec +lemma carrier.relevant : + ¬homogeneous_ideal.irrelevant 𝒜 ≤ carrier.as_homogeneous_ideal f_deg hm q := +λ rid, carrier.denom_not_mem f_deg hm q $ rid $ direct_sum.decompose_of_mem_ne 𝒜 f_deg hm.ne' -lemma degree_zero_part.mul_val {f : A} {m : ℕ} (f_deg : f ∈ 𝒜 m) (x y : A⁰_ f_deg) : - (x * y).1 = x.1 * y.1 := rfl +lemma carrier.as_ideal.ne_top : (carrier.as_ideal f_deg hm q) ≠ ⊤ := +λ rid, carrier.denom_not_mem f_deg hm q (rid.symm ▸ submodule.mem_top) +lemma carrier.as_ideal.prime : (carrier.as_ideal f_deg hm q).is_prime := +(carrier.as_ideal.homogeneous f_deg hm q).is_prime_of_homogeneous_mem_or_mem + (carrier.as_ideal.ne_top f_deg hm q) $ λ x y ⟨nx, hnx⟩ ⟨ny, hny⟩ hxy, +show (∀ i, _ ∈ _) ∨ ∀ i, _ ∈ _, begin + rw [← and_forall_ne nx, and_iff_left, ← and_forall_ne ny, and_iff_left], + { apply q.2.mem_or_mem, convert hxy (nx + ny) using 1, + simp_rw [proj_apply, decompose_of_mem_same 𝒜 hnx, decompose_of_mem_same 𝒜 hny, + decompose_of_mem_same 𝒜 (mul_mem hnx hny), mul_pow, pow_add], + simpa only [ext_iff_val, val_mk', mul_val, mk_mul], }, + all_goals { intros n hn, convert q.1.zero_mem using 1, + rw [ext_iff_val, val_mk', zero_val], simp_rw [proj_apply, subtype.coe_mk], + convert mk_zero _, rw [decompose_of_mem_ne 𝒜 _ hn.symm, zero_pow hm], + { exact hnx <|> exact hny } }, end +variable (f_deg) +/-- +The function `Spec A⁰_f → Proj|D(f)` by sending `q` to `{a | aᵢᵐ/fⁱ ∈ q}`. +-/ +def to_fun : (Spec.T (A⁰_ f)) → (Proj.T| (pbo f)) := +λ q, ⟨⟨carrier.as_homogeneous_ideal f_deg hm q, carrier.as_ideal.prime f_deg hm q, + carrier.relevant f_deg hm q⟩, + (projective_spectrum.mem_basic_open _ f _).mp $ carrier.denom_not_mem f_deg hm q⟩ + +end from_Spec + +end Proj_iso_Spec_Top_component + end algebraic_geometry diff --git a/src/algebraic_geometry/projective_spectrum/structure_sheaf.lean b/src/algebraic_geometry/projective_spectrum/structure_sheaf.lean index a863673d33f9c..9003dcd0fa7d1 100644 --- a/src/algebraic_geometry/projective_spectrum/structure_sheaf.lean +++ b/src/algebraic_geometry/projective_spectrum/structure_sheaf.lean @@ -11,6 +11,9 @@ import algebraic_geometry.locally_ringed_space /-! # The structure sheaf on `projective_spectrum 𝒜`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In `src/algebraic_geometry/topology.lean`, we have given a topology on `projective_spectrum 𝒜`; in this file we will construct a sheaf on `projective_spectrum 𝒜`. @@ -56,7 +59,7 @@ variables {R A: Type*} variables [comm_ring R] [comm_ring A] [algebra R A] variables (𝒜 : ℕ → submodule R A) [graded_algebra 𝒜] -local notation `at ` x := homogeneous_localization 𝒜 x.as_homogeneous_ideal.to_ideal +local notation `at ` x := homogeneous_localization.at_prime 𝒜 x.as_homogeneous_ideal.to_ideal namespace projective_spectrum.structure_sheaf @@ -120,7 +123,7 @@ begin obtain ⟨nin2, hy2⟩ := (wb (opens.inf_le_right Va Vb y)), dsimp only at hy1 hy2, erw [hy1, hy2], - simpa only [val_mk', add_mk, ← subtype.val_eq_coe, add_comm], } + simpa only [val_mk', add_mk, ← subtype.val_eq_coe, add_comm, mul_comm sa sb], } end lemma neg_mem' (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ) @@ -143,8 +146,8 @@ begin rcases ha x with ⟨Va, ma, ia, ja, ⟨ra, ra_mem⟩, ⟨sa, sa_mem⟩, wa⟩, rcases hb x with ⟨Vb, mb, ib, jb, ⟨rb, rb_mem⟩, ⟨sb, sb_mem⟩, wb⟩, refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ja + jb, - ⟨ra * rb, set_like.graded_monoid.mul_mem ra_mem rb_mem⟩, - ⟨sa * sb, set_like.graded_monoid.mul_mem sa_mem sb_mem⟩, λ y, ⟨λ h, _, _⟩⟩, + ⟨ra * rb, set_like.mul_mem_graded ra_mem rb_mem⟩, + ⟨sa * sb, set_like.mul_mem_graded sa_mem sb_mem⟩, λ y, ⟨λ h, _, _⟩⟩, { cases (y : projective_spectrum.Top 𝒜).is_prime.mem_or_mem h with h h, { choose nin hy using wa ⟨y, (opens.inf_le_left Va Vb y).2⟩, exact nin h }, { choose nin hy using wb ⟨y, (opens.inf_le_right Va Vb y).2⟩, exact nin h }, }, @@ -212,7 +215,7 @@ def Proj.structure_sheaf : sheaf CommRing (projective_spectrum.Top 𝒜) := -- We check the sheaf condition under `forget CommRing`. (is_sheaf_iff_is_sheaf_comp _ _).mpr (is_sheaf_of_iso (structure_presheaf_comp_forget 𝒜).symm - (structure_sheaf_in_Type 𝒜).property)⟩ + (structure_sheaf_in_Type 𝒜).cond)⟩ end projective_spectrum @@ -247,33 +250,31 @@ def open_to_localization (U : opens (projective_spectrum.Top 𝒜)) (x : project to a homogeneous prime ideal `x` to the *homogeneous localization* at `x`, formed by gluing the `open_to_localization` maps. -/ def stalk_to_fiber_ring_hom (x : projective_spectrum.Top 𝒜) : - (Proj.structure_sheaf 𝒜).1.stalk x ⟶ CommRing.of (at x) := + (Proj.structure_sheaf 𝒜).presheaf.stalk x ⟶ CommRing.of (at x) := limits.colimit.desc (((open_nhds.inclusion x).op) ⋙ (Proj.structure_sheaf 𝒜).1) { X := _, ι := { app := λ U, open_to_localization 𝒜 ((open_nhds.inclusion _).obj (unop U)) x (unop U).2, } } @[simp] lemma germ_comp_stalk_to_fiber_ring_hom (U : opens (projective_spectrum.Top 𝒜)) (x : U) : - (Proj.structure_sheaf 𝒜).1.germ x ≫ stalk_to_fiber_ring_hom 𝒜 x = + (Proj.structure_sheaf 𝒜).presheaf.germ x ≫ stalk_to_fiber_ring_hom 𝒜 x = open_to_localization 𝒜 U x x.2 := limits.colimit.ι_desc _ _ @[simp] lemma stalk_to_fiber_ring_hom_germ' (U : opens (projective_spectrum.Top 𝒜)) (x : projective_spectrum.Top 𝒜) (hx : x ∈ U) (s : (Proj.structure_sheaf 𝒜).1.obj (op U)) : - stalk_to_fiber_ring_hom 𝒜 x ((Proj.structure_sheaf 𝒜).1.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) := + stalk_to_fiber_ring_hom 𝒜 x + ((Proj.structure_sheaf 𝒜).presheaf.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) := ring_hom.ext_iff.1 (germ_comp_stalk_to_fiber_ring_hom 𝒜 U ⟨x, hx⟩ : _) s @[simp] lemma stalk_to_fiber_ring_hom_germ (U : opens (projective_spectrum.Top 𝒜)) (x : U) (s : (Proj.structure_sheaf 𝒜).1.obj (op U)) : - stalk_to_fiber_ring_hom 𝒜 x ((Proj.structure_sheaf 𝒜).1.germ x s) = s.1 x := + stalk_to_fiber_ring_hom 𝒜 x ((Proj.structure_sheaf 𝒜).presheaf.germ x s) = s.1 x := by { cases x, exact stalk_to_fiber_ring_hom_germ' 𝒜 U _ _ _ } lemma homogeneous_localization.mem_basic_open (x : projective_spectrum.Top 𝒜) (f : at x) : x ∈ projective_spectrum.basic_open 𝒜 f.denom := -begin - rw projective_spectrum.mem_basic_open, - exact homogeneous_localization.denom_not_mem _, -end +by { rw projective_spectrum.mem_basic_open, exact f.denom_mem } variable (𝒜) @@ -283,28 +284,28 @@ basic open set `D(f.denom)`-/ def section_in_basic_open (x : projective_spectrum.Top 𝒜) : Π (f : at x), (Proj.structure_sheaf 𝒜).1.obj (op (projective_spectrum.basic_open 𝒜 f.denom)) := -λ f, ⟨λ y, quotient.mk' ⟨f.deg, ⟨f.num, f.num_mem⟩, ⟨f.denom, f.denom_mem⟩, y.2⟩, +λ f, ⟨λ y, quotient.mk' ⟨f.deg, ⟨f.num, f.num_mem_deg⟩, ⟨f.denom, f.denom_mem_deg⟩, y.2⟩, λ y, ⟨projective_spectrum.basic_open 𝒜 f.denom, y.2, - ⟨𝟙 _, ⟨f.deg, ⟨⟨f.num, f.num_mem⟩, ⟨f.denom, f.denom_mem⟩, + ⟨𝟙 _, ⟨f.deg, ⟨⟨f.num, f.num_mem_deg⟩, ⟨f.denom, f.denom_mem_deg⟩, λ z, ⟨z.2, rfl⟩⟩⟩⟩⟩⟩ -/--Given any point `x` and `f` in the homogeneous localizatoin at `x`, there is an element in the +/--Given any point `x` and `f` in the homogeneous localization at `x`, there is an element in the stalk at `x` obtained by `section_in_basic_open`. This is the inverse of `stalk_to_fiber_ring_hom`. -/ def homogeneous_localization_to_stalk (x : projective_spectrum.Top 𝒜) : - (at x) → (Proj.structure_sheaf 𝒜).1.stalk x := -λ f, (Proj.structure_sheaf 𝒜).1.germ + (at x) → (Proj.structure_sheaf 𝒜).presheaf.stalk x := +λ f, (Proj.structure_sheaf 𝒜).presheaf.germ (⟨x, homogeneous_localization.mem_basic_open _ x f⟩ : projective_spectrum.basic_open _ f.denom) (section_in_basic_open _ x f) /--Using `homogeneous_localization_to_stalk`, we construct a ring isomorphism between stalk at `x` and homogeneous localization at `x` for any point `x` in `Proj`.-/ def Proj.stalk_iso' (x : projective_spectrum.Top 𝒜) : - (Proj.structure_sheaf 𝒜).1.stalk x ≃+* CommRing.of (at x) := + (Proj.structure_sheaf 𝒜).presheaf.stalk x ≃+* CommRing.of (at x) := ring_equiv.of_bijective (stalk_to_fiber_ring_hom _ x) ⟨λ z1 z2 eq1, begin - obtain ⟨u1, memu1, s1, rfl⟩ := (Proj.structure_sheaf 𝒜).1.germ_exist x z1, - obtain ⟨u2, memu2, s2, rfl⟩ := (Proj.structure_sheaf 𝒜).1.germ_exist x z2, + obtain ⟨u1, memu1, s1, rfl⟩ := (Proj.structure_sheaf 𝒜).presheaf.germ_exist x z1, + obtain ⟨u2, memu2, s2, rfl⟩ := (Proj.structure_sheaf 𝒜).presheaf.germ_exist x z2, obtain ⟨v1, memv1, i1, ⟨j1, ⟨a1, a1_mem⟩, ⟨b1, b1_mem⟩, hs1⟩⟩ := s1.2 ⟨x, memu1⟩, obtain ⟨v2, memv2, i2, ⟨j2, ⟨a2, a2_mem⟩, ⟨b2, b2_mem⟩, hs2⟩⟩ := s2.2 ⟨x, memu2⟩, obtain ⟨b1_nin_x, eq2⟩ := hs1 ⟨x, memv1⟩, diff --git a/src/algebraic_geometry/projective_spectrum/topology.lean b/src/algebraic_geometry/projective_spectrum/topology.lean index 68e82cd8de7e5..d6d8f3f9408c0 100644 --- a/src/algebraic_geometry/projective_spectrum/topology.lean +++ b/src/algebraic_geometry/projective_spectrum/topology.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Jujian Zhang, Johan Commelin -/ -import topology.category.Top import ring_theory.graded_algebra.homogeneous_ideal +import topology.category.Top.basic +import topology.sets.opens /-! # Projective spectrum of a graded ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals that are prime and do not contain the irrelevant ideal. It is naturally endowed with a topology: the Zariski topology. @@ -31,8 +35,7 @@ It is naturally endowed with a topology: the Zariski topology. `projective_spectrum 𝒜` is the intersection of points in `t` (viewed as relevant homogeneous prime ideals). * `projective_spectrum.Top`: the topological space of `projective_spectrum 𝒜` endowed with the - Zariski topology - + Zariski topology. -/ noncomputable theory @@ -43,41 +46,24 @@ variables {R A: Type*} variables [comm_semiring R] [comm_ring A] [algebra R A] variables (𝒜 : ℕ → submodule R A) [graded_algebra 𝒜] -/-- -The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals that -are prime and do not contain the irrelevant ideal. --/ -@[nolint has_inhabited_instance] -def projective_spectrum := -{I : homogeneous_ideal 𝒜 // I.to_ideal.is_prime ∧ ¬(homogeneous_ideal.irrelevant 𝒜 ≤ I)} - -namespace projective_spectrum - - -variable {𝒜} -/-- A method to view a point in the projective spectrum of a graded ring -as a homogeneous ideal of that ring. -/ -abbreviation as_homogeneous_ideal (x : projective_spectrum 𝒜) : homogeneous_ideal 𝒜 := x.1 - -lemma as_homogeneous_ideal_def (x : projective_spectrum 𝒜) : - x.as_homogeneous_ideal = x.1 := rfl +/-- The projective spectrum of a graded commutative ring is the subtype of all homogenous ideals +that are prime and do not contain the irrelevant ideal. -/ +@[ext, nolint has_nonempty_instance] structure projective_spectrum := +(as_homogeneous_ideal : homogeneous_ideal 𝒜) +(is_prime : as_homogeneous_ideal.to_ideal.is_prime) +(not_irrelevant_le : ¬(homogeneous_ideal.irrelevant 𝒜 ≤ as_homogeneous_ideal)) -instance is_prime (x : projective_spectrum 𝒜) : - x.as_homogeneous_ideal.to_ideal.is_prime := x.2.1 +attribute [instance] projective_spectrum.is_prime -@[ext] lemma ext {x y : projective_spectrum 𝒜} : - x = y ↔ x.as_homogeneous_ideal = y.as_homogeneous_ideal := -subtype.ext_iff_val +namespace projective_spectrum -variable (𝒜) -/-- The zero locus of a set `s` of elements of a commutative ring `A` -is the set of all relevant homogeneous prime ideals of the ring that contain the set `s`. +/-- The zero locus of a set `s` of elements of a commutative ring `A` is the set of all relevant +homogeneous prime ideals of the ring that contain the set `s`. An element `f` of `A` can be thought of as a dependent function on the projective spectrum of `𝒜`. -At a point `x` (a homogeneous prime ideal) -the function (i.e., element) `f` takes values in the quotient ring `A` modulo the prime ideal `x`. -In this manner, `zero_locus s` is exactly the subset of `projective_spectrum 𝒜` -where all "functions" in `s` vanish simultaneously. -/ +At a point `x` (a homogeneous prime ideal) the function (i.e., element) `f` takes values in the +quotient ring `A` modulo the prime ideal `x`. In this manner, `zero_locus s` is exactly the subset +of `projective_spectrum 𝒜` where all "functions" in `s` vanish simultaneously. -/ def zero_locus (s : set A) : set (projective_spectrum 𝒜) := {x | s ⊆ x.as_homogeneous_ideal} @@ -89,15 +75,13 @@ def zero_locus (s : set A) : set (projective_spectrum 𝒜) := by { ext x, exact (submodule.gi _ _).gc s x.as_homogeneous_ideal.to_ideal } variable {𝒜} -/-- The vanishing ideal of a set `t` of points -of the prime spectrum of a commutative ring `R` -is the intersection of all the prime ideals in the set `t`. +/-- The vanishing ideal of a set `t` of points of the projective spectrum of a commutative ring `R` +is the intersection of all the relevant homogeneous prime ideals in the set `t`. An element `f` of `A` can be thought of as a dependent function on the projective spectrum of `𝒜`. -At a point `x` (a homogeneous prime ideal) -the function (i.e., element) `f` takes values in the quotient ring `A` modulo the prime ideal `x`. -In this manner, `vanishing_ideal t` is exactly the ideal of `A` -consisting of all "functions" that vanish on all of `t`. -/ +At a point `x` (a homogeneous prime ideal) the function (i.e., element) `f` takes values in the +quotient ring `A` modulo the prime ideal `x`. In this manner, `vanishing_ideal t` is exactly the +ideal of `A` consisting of all "functions" that vanish on all of `t`. -/ def vanishing_ideal (t : set (projective_spectrum 𝒜)) : homogeneous_ideal 𝒜 := ⨅ (x : projective_spectrum 𝒜) (h : x ∈ t), x.as_homogeneous_ideal @@ -252,7 +236,7 @@ by convert (gc_ideal 𝒜).u_infi; exact homogeneous_ideal.to_ideal_infi _ lemma zero_locus_inf (I J : ideal A) : zero_locus 𝒜 ((I ⊓ J : ideal A) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J := -set.ext $ λ x, by simpa using x.2.1.inf_le +set.ext $ λ x, x.is_prime.inf_le lemma union_zero_locus (s s' : set A) : zero_locus 𝒜 s ∪ zero_locus 𝒜 s' = zero_locus 𝒜 ((ideal.span s) ⊓ (ideal.span s'): ideal A) := @@ -260,19 +244,19 @@ by { rw zero_locus_inf, simp } lemma zero_locus_mul_ideal (I J : ideal A) : zero_locus 𝒜 ((I * J : ideal A) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J := -set.ext $ λ x, by simpa using x.2.1.mul_le +set.ext $ λ x, x.is_prime.mul_le lemma zero_locus_mul_homogeneous_ideal (I J : homogeneous_ideal 𝒜) : zero_locus 𝒜 ((I * J : homogeneous_ideal 𝒜) : set A) = zero_locus 𝒜 I ∪ zero_locus 𝒜 J := -set.ext $ λ x, by simpa using x.2.1.mul_le +set.ext $ λ x, x.is_prime.mul_le lemma zero_locus_singleton_mul (f g : A) : zero_locus 𝒜 ({f * g} : set A) = zero_locus 𝒜 {f} ∪ zero_locus 𝒜 {g} := -set.ext $ λ x, by simpa using x.2.1.mul_mem_iff_mem_or_mem +set.ext $ λ x, by simpa using x.is_prime.mul_mem_iff_mem_or_mem @[simp] lemma zero_locus_singleton_pow (f : A) (n : ℕ) (hn : 0 < n) : zero_locus 𝒜 ({f ^ n} : set A) = zero_locus 𝒜 {f} := -set.ext $ λ x, by simpa using x.2.1.pow_mem_iff_mem n hn +set.ext $ λ x, by simpa using x.is_prime.pow_mem_iff_mem n hn lemma sup_vanishing_ideal_le (t t' : set (projective_spectrum 𝒜)) : vanishing_ideal t ⊔ vanishing_ideal t' ≤ vanishing_ideal (t ∩ t') := @@ -287,11 +271,10 @@ end lemma mem_compl_zero_locus_iff_not_mem {f : A} {I : projective_spectrum 𝒜} : I ∈ (zero_locus 𝒜 {f} : set (projective_spectrum 𝒜))ᶜ ↔ f ∉ I.as_homogeneous_ideal := -by rw [set.mem_compl_eq, mem_zero_locus, set.singleton_subset_iff]; refl +by rw [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff]; refl -/-- The Zariski topology on the prime spectrum of a commutative ring -is defined via the closed sets of the topology: -they are exactly those sets that are the zero locus of a subset of the ring. -/ +/-- The Zariski topology on the prime spectrum of a commutative ring is defined via the closed sets +of the topology: they are exactly those sets that are the zero locus of a subset of the ring. -/ instance zariski_topology : topological_space (projective_spectrum 𝒜) := topological_space.of_closed (set.range (projective_spectrum.zero_locus 𝒜)) (⟨set.univ, by simp⟩) @@ -305,9 +288,7 @@ topological_space.of_closed (set.range (projective_spectrum.zero_locus 𝒜)) end (by { rintros _ ⟨s, rfl⟩ _ ⟨t, rfl⟩, exact ⟨_, (union_zero_locus 𝒜 s t).symm⟩ }) -/-- -The underlying topology of `Proj` is the projective spectrum of graded ring `A`. --/ +/-- The underlying topology of `Proj` is the projective spectrum of graded ring `A`. -/ def Top : Top := Top.of (projective_spectrum 𝒜) lemma is_open_iff (U : set (projective_spectrum 𝒜)) : @@ -349,8 +330,8 @@ section basic_open /-- `basic_open r` is the open subset containing all prime ideals not containing `r`. -/ def basic_open (r : A) : topological_space.opens (projective_spectrum 𝒜) := -{ val := { x | r ∉ x.as_homogeneous_ideal }, - property := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ } +{ carrier := { x | r ∉ x.as_homogeneous_ideal }, + is_open' := ⟨{r}, set.ext $ λ x, set.singleton_subset_iff.trans $ not_not.symm⟩ } @[simp] lemma mem_basic_open (f : A) (x : projective_spectrum 𝒜) : x ∈ basic_open 𝒜 f ↔ f ∉ x.as_homogeneous_ideal := iff.rfl @@ -360,11 +341,11 @@ lemma mem_coe_basic_open (f : A) (x : projective_spectrum 𝒜) : lemma is_open_basic_open {a : A} : is_open ((basic_open 𝒜 a) : set (projective_spectrum 𝒜)) := -(basic_open 𝒜 a).property +(basic_open 𝒜 a).is_open @[simp] lemma basic_open_eq_zero_locus_compl (r : A) : (basic_open 𝒜 r : set (projective_spectrum 𝒜)) = (zero_locus 𝒜 {r})ᶜ := -set.ext $ λ x, by simpa only [set.mem_compl_eq, mem_zero_locus, set.singleton_subset_iff] +set.ext $ λ x, by simpa only [set.mem_compl_iff, mem_zero_locus, set.singleton_subset_iff] @[simp] lemma basic_open_one : basic_open 𝒜 (1 : A) = ⊤ := topological_space.opens.ext $ by simp @@ -392,8 +373,8 @@ topological_space.opens.ext $ set.ext $ λ z, begin split; intros hz, { rcases show ∃ i, graded_algebra.proj 𝒜 i f ∉ z.as_homogeneous_ideal, begin contrapose! hz with H, - haveI : Π (i : ℕ) (x : 𝒜 i), decidable (x ≠ 0) := λ _, classical.dec_pred _, - rw ←graded_algebra.sum_support_decompose 𝒜 f, + classical, + rw ←direct_sum.sum_support_decompose 𝒜 f, apply ideal.sum_mem _ (λ i hi, H i) end with ⟨i, hi⟩, exact ⟨basic_open 𝒜 (graded_algebra.proj 𝒜 i f), ⟨i, rfl⟩, by rwa mem_basic_open⟩ }, @@ -408,7 +389,7 @@ begin { rintros _ ⟨r, rfl⟩, exact is_open_basic_open 𝒜 }, { rintros p U hp ⟨s, hs⟩, - rw [← compl_compl U, set.mem_compl_eq, ← hs, mem_zero_locus, set.not_subset] at hp, + rw [← compl_compl U, set.mem_compl_iff, ← hs, mem_zero_locus, set.not_subset] at hp, obtain ⟨f, hfs, hfp⟩ := hp, refine ⟨basic_open 𝒜 f, ⟨f, rfl⟩, hfp, _⟩, rw [← set.compl_subset_compl, ← hs, basic_open_eq_zero_locus_compl, compl_compl], @@ -427,15 +408,15 @@ where `x ≤ y` if and only if `y ∈ closure {x}`. -/ instance : partial_order (projective_spectrum 𝒜) := -subtype.partial_order _ +partial_order.lift as_homogeneous_ideal $ λ ⟨_, _, _⟩ ⟨_, _, _⟩, mk.inj_eq.mpr @[simp] lemma as_ideal_le_as_ideal (x y : projective_spectrum 𝒜) : x.as_homogeneous_ideal ≤ y.as_homogeneous_ideal ↔ x ≤ y := -subtype.coe_le_coe +iff.rfl @[simp] lemma as_ideal_lt_as_ideal (x y : projective_spectrum 𝒜) : x.as_homogeneous_ideal < y.as_homogeneous_ideal ↔ x < y := -subtype.coe_lt_coe +iff.rfl lemma le_iff_mem_closure (x y : projective_spectrum 𝒜) : x ≤ y ↔ y ∈ closure ({x} : set (projective_spectrum 𝒜)) := diff --git a/src/algebraic_geometry/properties.lean b/src/algebraic_geometry/properties.lean index 533a7c50b2d20..7dbae1c65bc70 100644 --- a/src/algebraic_geometry/properties.lean +++ b/src/algebraic_geometry/properties.lean @@ -6,14 +6,15 @@ Authors: Andrew Yang import algebraic_geometry.AffineScheme import ring_theory.nilpotent import topology.sheaves.sheaf_condition.sites -import category_theory.limits.constructions.binary_products import algebra.category.Ring.constructions -import ring_theory.integral_domain import ring_theory.local_properties /-! # Basic properties of schemes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide some basic properties of schemes ## Main definition @@ -31,16 +32,11 @@ variable (X : Scheme) instance : t0_space X.carrier := begin - rw t0_space_iff_distinguishable, - intros x y h h', + refine t0_space.of_open_cover (λ x, _), obtain ⟨U, R, ⟨e⟩⟩ := X.local_affine x, - have hy := (h' _ U.1.2).mp U.2, - erw ← subtype_indistinguishable_iff (⟨x, U.2⟩ : U.1.1) (⟨y, hy⟩ : U.1.1) at h', let e' : U.1 ≃ₜ prime_spectrum R := homeo_of_iso ((LocallyRingedSpace.forget_to_SheafedSpace ⋙ SheafedSpace.forget _).map_iso e), - have := t0_space_of_injective_of_continuous e'.injective e'.continuous, - rw t0_space_iff_distinguishable at this, - exact this ⟨x, U.2⟩ ⟨y, hy⟩ (by simpa using h) h' + exact ⟨U.1.1, U.2, U.1.2, e'.embedding.t0_space⟩ end instance : quasi_sober X.carrier := @@ -149,7 +145,8 @@ begin intros X U, apply h₁, intro x, - obtain ⟨_,⟨j,rfl⟩,hx,i⟩ := X.affine_basis_cover_is_basis.exists_subset_of_mem_open x.prop U.2, + obtain ⟨_, ⟨j, rfl⟩, hx, i⟩ := X.affine_basis_cover_is_basis.exists_subset_of_mem_open + (set_like.mem_coe.2 x.prop) U.is_open, let U' : opens _ := ⟨_, (X.affine_basis_cover.is_open j).base_open.open_range⟩, let i' : U' ⟶ U := hom_of_le i, @@ -158,7 +155,7 @@ begin apply h₂', apply h₃ end -. + lemma reduce_to_affine_nbhd (P : ∀ (X : Scheme) (x : X.carrier), Prop) (h₁ : ∀ (R : CommRing) (x : prime_spectrum R), P (Scheme.Spec.obj $ op R) x) (h₂ : ∀ {X Y} (f : X ⟶ Y) [is_open_immersion f] (x : X.carrier), P X x → P Y (f.1.base x)) : @@ -171,8 +168,8 @@ begin apply h₁, end -lemma eq_zero_of_basic_open_empty {X : Scheme} [hX : is_reduced X] {U : opens X.carrier} - (s : X.presheaf.obj (op U)) (hs : X.basic_open s = ∅) : +lemma eq_zero_of_basic_open_eq_bot {X : Scheme} [hX : is_reduced X] {U : opens X.carrier} + (s : X.presheaf.obj (op U)) (hs : X.basic_open s = ⊥) : s = 0 := begin apply Top.presheaf.section_ext X.sheaf U, @@ -183,17 +180,17 @@ begin obtain ⟨V, hx, i, H⟩ := hx x, unfreezingI { specialize H (X.presheaf.map i.op s) }, erw Scheme.basic_open_res at H, - rw [hs, ← subtype.coe_injective.eq_iff, opens.empty_eq, opens.inter_eq, inf_bot_eq] at H, - specialize H rfl ⟨x, hx⟩, + rw [hs] at H, + specialize H inf_bot_eq ⟨x, hx⟩, erw Top.presheaf.germ_res_apply at H, exact H }, { rintros X Y f hf, - have e : (f.val.base) ⁻¹' set.range ⇑(f.val.base) = ⊤, - { rw [← set.image_univ, set.preimage_image_eq _ hf.base_open.inj, set.top_eq_univ] }, + have e : (f.val.base) ⁻¹' set.range ⇑(f.val.base) = set.univ, + { rw [← set.image_univ, set.preimage_image_eq _ hf.base_open.inj] }, refine ⟨_, _, e, rfl, _⟩, rintros H hX s hs ⟨_, x, rfl⟩, unfreezingI { haveI := is_reduced_of_open_immersion f }, - specialize H (f.1.c.app _ s) _ ⟨x, by { change x ∈ (f.val.base) ⁻¹' _, rw e, trivial }⟩, + specialize H (f.1.c.app _ s) _ ⟨x, by { rw [opens.mem_mk, e], trivial }⟩, { rw [← Scheme.preimage_basic_open, hs], ext1, simp [opens.map] }, { erw ← PresheafedSpace.stalk_map_germ_apply f.1 ⟨_,_⟩ ⟨x,_⟩ at H, apply_fun (inv $ PresheafedSpace.stalk_map f.val x) at H, @@ -204,7 +201,7 @@ begin replace hs := (hs.map (Spec_Γ_identity.app R).inv), -- what the hell?! replace hs := @is_nilpotent.eq_zero _ _ _ _ (show _, from _) hs, - rw coe_hom_inv_id at hs, + rw iso.hom_inv_id_apply at hs, rw [hs, map_zero], exact @@is_reduced.component_reduced hX ⊤ } end @@ -214,7 +211,7 @@ lemma basic_open_eq_bot_iff {X : Scheme} [is_reduced X] {U : opens X.carrier} (s : X.presheaf.obj $ op U) : X.basic_open s = ⊥ ↔ s = 0 := begin - refine ⟨eq_zero_of_basic_open_empty s, _⟩, + refine ⟨eq_zero_of_basic_open_eq_bot s, _⟩, rintro rfl, simp, end @@ -236,8 +233,8 @@ instance is_reduced_of_is_integral [is_integral X] : is_reduced X := begin constructor, intro U, - cases U.1.eq_empty_or_nonempty, - { have : U = ∅ := subtype.eq h, + cases U.1.eq_empty_or_nonempty with h h, + { have : U = ⊥ := set_like.ext' h, haveI := CommRing.subsingleton_of_is_terminal (X.sheaf.is_terminal_of_eq_empty this), change _root_.is_reduced (X.sheaf.val.obj (op U)), apply_instance }, @@ -274,20 +271,23 @@ end lemma is_integral_of_is_irreducible_is_reduced [is_reduced X] [H : irreducible_space X.carrier] : is_integral X := begin - split, refine λ U hU, ⟨λ a b e, _, - (@@LocallyRingedSpace.component_nontrivial X.to_LocallyRingedSpace U hU).1⟩, - simp_rw [← basic_open_eq_bot_iff, ← opens.not_nonempty_iff_eq_bot], - by_contra' h, - obtain ⟨_, ⟨x, hx₁, rfl⟩, ⟨x, hx₂, e'⟩⟩ := @@nonempty_preirreducible_inter _ H.1 - (X.basic_open a).2 (X.basic_open b).2 - h.1 h.2, - replace e' := subtype.eq e', - subst e', - replace e := congr_arg (X.presheaf.germ x) e, - rw [ring_hom.map_mul, ring_hom.map_zero] at e, - refine @zero_ne_one (X.presheaf.stalk x.1) _ _ (is_unit_zero_iff.1 _), - convert hx₁.mul hx₂, - exact e.symm + split, intros U hU, + haveI := (@@LocallyRingedSpace.component_nontrivial X.to_LocallyRingedSpace U hU).1, + haveI : no_zero_divisors + (X.to_LocallyRingedSpace.to_SheafedSpace.to_PresheafedSpace.presheaf.obj (op U)), + { refine ⟨λ a b e, _⟩, + simp_rw [← basic_open_eq_bot_iff, ← opens.not_nonempty_iff_eq_bot], + by_contra' h, + obtain ⟨_, ⟨x, hx₁, rfl⟩, ⟨x, hx₂, e'⟩⟩ := @@nonempty_preirreducible_inter _ H.1 + (X.basic_open a).2 (X.basic_open b).2 h.1 h.2, + replace e' := subtype.eq e', + subst e', + replace e := congr_arg (X.presheaf.germ x) e, + rw [ring_hom.map_mul, ring_hom.map_zero] at e, + refine zero_ne_one' (X.presheaf.stalk x.1) (is_unit_zero_iff.1 _), + convert hx₁.mul hx₂, + exact e.symm }, + exact no_zero_divisors.to_is_domain _ end lemma is_integral_iff_is_irreducible_and_is_reduced : @@ -311,14 +311,15 @@ begin Y.presheaf.obj _ ≅ _).symm.CommRing_iso_to_ring_equiv.is_domain _ end -instance {R : CommRing} [H : is_domain R] : is_integral (Scheme.Spec.obj $ op R) := +instance {R : CommRing} [H : is_domain R] : irreducible_space (Scheme.Spec.obj $ op R).carrier := begin - apply_with is_integral_of_is_irreducible_is_reduced { instances := ff }, - { apply_instance }, - { dsimp [Spec.Top_obj], - apply_instance }, + convert prime_spectrum.irreducible_space, + assumption end +instance {R : CommRing} [is_domain R] : is_integral (Scheme.Spec.obj $ op R) := +is_integral_of_is_irreducible_is_reduced _ + lemma affine_is_integral_iff (R : CommRing) : is_integral (Scheme.Spec.obj $ op R) ↔ is_domain R := ⟨λ h, by exactI ring_equiv.is_domain ((Scheme.Spec.obj $ op R).presheaf.obj _) @@ -343,7 +344,7 @@ begin revert hx, contrapose!, simp_rw [← opens.not_nonempty_iff_eq_bot, not_not], - apply nonempty_preirreducible_inter U.prop (RingedSpace.basic_open _ _).prop, + apply nonempty_preirreducible_inter U.is_open (RingedSpace.basic_open _ _).is_open, simpa using H end diff --git a/src/algebraic_geometry/pullbacks.lean b/src/algebraic_geometry/pullbacks.lean index 8b2e24f67d4d1..5173a80bbca4d 100644 --- a/src/algebraic_geometry/pullbacks.lean +++ b/src/algebraic_geometry/pullbacks.lean @@ -5,11 +5,15 @@ Authors: Andrew Yang -/ import algebraic_geometry.gluing import category_theory.limits.opposites -import algebraic_geometry.Gamma_Spec_adjunction +import algebraic_geometry.AffineScheme +import category_theory.limits.shapes.diagonal /-! # Fibred products of schemes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we construct the fibred product of schemes via gluing. We roughly follow [har77] Theorem 3.3. @@ -245,7 +249,8 @@ def gluing : Scheme.glue_data.{u} := t_fac := λ i j k, begin apply pullback.hom_ext, apply pullback.hom_ext, - all_goals { simp } + all_goals { simp only [t'_snd_fst_fst, t'_snd_fst_snd, t'_snd_snd, + t_fst_fst, t_fst_snd, t_snd, category.assoc] } end, cocycle := λ i j k, cocycle 𝒰 f g i j k } @@ -514,8 +519,6 @@ end lemma has_pullback_of_cover : has_pullback f g := ⟨⟨⟨_, glued_is_limit 𝒰 f g⟩⟩⟩ -instance : has_limits CommRingᵒᵖ := has_limits_op_of_has_colimits - instance affine_has_pullback {A B C : CommRing} (f : Spec.obj (opposite.op A) ⟶ Spec.obj (opposite.op C)) (g : Spec.obj (opposite.op B) ⟶ Spec.obj (opposite.op C)) : has_pullback f g := @@ -560,6 +563,13 @@ has_pullback_of_cover (Z.affine_cover.pullback_cover f) f g instance : has_pullbacks Scheme := has_pullbacks_of_has_limit_cospan _ +instance {X Y Z : Scheme} (f : X ⟶ Z) (g : Y ⟶ Z) [is_affine X] [is_affine Y] [is_affine Z] : + is_affine (pullback f g) := +is_affine_of_iso (pullback.map f g (Spec.map (Γ.map f.op).op) (Spec.map (Γ.map g.op).op) + (Γ_Spec.adjunction.unit.app X) (Γ_Spec.adjunction.unit.app Y) (Γ_Spec.adjunction.unit.app Z) + (Γ_Spec.adjunction.unit.naturality f) (Γ_Spec.adjunction.unit.naturality g) ≫ + (preserves_pullback.iso Spec _ _).inv) + /-- Given an open cover `{ Xᵢ }` of `X`, then `X ×[Z] Y` is covered by `Xᵢ ×[Z] Y`. -/ @[simps J obj map] def open_cover_of_left (𝒰 : open_cover X) (f : X ⟶ Z) (g : Y ⟶ Z) : open_cover (pullback f g) := @@ -594,6 +604,23 @@ begin apply pullback.hom_ext; simp, end +/-- Given an open cover `{ Xᵢ }` of `X` and an open cover `{ Yⱼ }` of `Y`, then +`X ×[Z] Y` is covered by `Xᵢ ×[Z] Yⱼ`. -/ +@[simps J obj map] +def open_cover_of_left_right (𝒰X : X.open_cover) (𝒰Y : Y.open_cover) + (f : X ⟶ Z) (g : Y ⟶ Z) : (pullback f g).open_cover := +begin + fapply ((open_cover_of_left 𝒰X f g).bind (λ x, open_cover_of_right 𝒰Y (𝒰X.map x ≫ f) g)).copy + (𝒰X.J × 𝒰Y.J) + (λ ij, pullback (𝒰X.map ij.1 ≫ f) (𝒰Y.map ij.2 ≫ g)) + (λ ij, pullback.map _ _ _ _ (𝒰X.map ij.1) (𝒰Y.map ij.2) (𝟙 _) + (category.comp_id _) (category.comp_id _)) + (equiv.sigma_equiv_prod _ _).symm + (λ _, iso.refl _), + rintro ⟨i, j⟩, + apply pullback.hom_ext; simpa, +end + /-- (Implementation). Use `open_cover_of_base` instead. -/ def open_cover_of_base' (𝒰 : open_cover Z) (f : X ⟶ Z) (g : Y ⟶ Z) : open_cover (pullback f g) := begin @@ -641,3 +668,16 @@ end end pullback end algebraic_geometry.Scheme + +namespace algebraic_geometry + +instance {X Y S X' Y' S' : Scheme} (f : X ⟶ S) (g : Y ⟶ S) (f' : X' ⟶ S') + (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f') + (e₂ : g ≫ i₃ = i₂ ≫ g') [is_open_immersion i₁] [is_open_immersion i₂] [mono i₃] : + is_open_immersion (pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂) := +begin + rw pullback_map_eq_pullback_fst_fst_iso_inv, + apply_instance +end + +end algebraic_geometry diff --git a/src/algebraic_geometry/ringed_space.lean b/src/algebraic_geometry/ringed_space.lean index 97ef0e5241d69..ff9354559ca56 100644 --- a/src/algebraic_geometry/ringed_space.lean +++ b/src/algebraic_geometry/ringed_space.lean @@ -12,6 +12,9 @@ import algebra.category.Ring.limits /-! # Ringed spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the category of ringed spaces, as an alias for `SheafedSpace CommRing`. The facts collected in this file are typically stated for locally ringed spaces, but never actually @@ -68,7 +71,7 @@ begin choose V iVU m h_unit using λ x : U, X.is_unit_res_of_is_unit_germ U f x (h x), have hcover : U ≤ supr V, { intros x hxU, - rw [opens.mem_coe, opens.mem_supr], + rw [opens.mem_supr], exact ⟨⟨x, hxU⟩, m ⟨x, hxU⟩⟩ }, -- Let `g x` denote the inverse of `f` in `U x`. choose g hg using λ x : U, is_unit.exists_right_inv (h_unit x), @@ -97,8 +100,8 @@ The basic open of a section `f` is the set of all points `x`, such that the germ `x` is a unit. -/ def basic_open {U : opens X} (f : X.presheaf.obj (op U)) : opens X := -{ val := coe '' { x : U | is_unit (X.presheaf.germ x f) }, - property := begin +{ carrier := coe '' { x : U | is_unit (X.presheaf.germ x f) }, + is_open' := begin rw is_open_iff_forall_mem_open, rintros _ ⟨x, hx, rfl⟩, obtain ⟨V, i, hxV, hf⟩ := X.is_unit_res_of_is_unit_germ U f x hx, @@ -127,12 +130,12 @@ lemma mem_top_basic_open (f : X.presheaf.obj (op ⊤)) (x : X) : x ∈ X.basic_open f ↔ is_unit (X.presheaf.germ ⟨x, show x ∈ (⊤ : opens X), by trivial⟩ f) := mem_basic_open X f ⟨x, _⟩ -lemma basic_open_subset {U : opens X} (f : X.presheaf.obj (op U)) : X.basic_open f ⊆ U := +lemma basic_open_le {U : opens X} (f : X.presheaf.obj (op U)) : X.basic_open f ≤ U := by { rintros _ ⟨x, hx, rfl⟩, exact x.2 } /-- The restriction of a section `f` to the basic open of `f` is a unit. -/ lemma is_unit_res_basic_open {U : opens X} (f : X.presheaf.obj (op U)) : - is_unit (X.presheaf.map (@hom_of_le (opens X) _ _ _ (X.basic_open_subset f)).op f) := + is_unit (X.presheaf.map (@hom_of_le (opens X) _ _ _ (X.basic_open_le f)).op f) := begin apply is_unit_of_is_unit_germ, rintro ⟨_, ⟨x, hx, rfl⟩⟩, @@ -142,7 +145,7 @@ begin end @[simp] lemma basic_open_res {U V : (opens X)ᵒᵖ} (i : U ⟶ V) (f : X.presheaf.obj U) : - @basic_open X (unop V) (X.presheaf.map i f) = (unop V) ∩ @basic_open X (unop U) f := + @basic_open X (unop V) (X.presheaf.map i f) = (unop V) ⊓ @basic_open X (unop U) f := begin induction U using opposite.rec, induction V using opposite.rec, @@ -174,7 +177,7 @@ end begin ext1, dsimp [RingedSpace.basic_open], - rw set.image_inter subtype.coe_injective, + rw ←set.image_inter subtype.coe_injective, congr, ext, simp_rw map_mul, @@ -185,7 +188,7 @@ lemma basic_open_of_is_unit {U : opens X} {f : X.presheaf.obj (op U)} (hf : is_u X.basic_open f = U := begin apply le_antisymm, - { exact X.basic_open_subset f }, + { exact X.basic_open_le f }, intros x hx, erw X.mem_basic_open f (⟨x, hx⟩ : U), exact ring_hom.is_unit_map _ hf diff --git a/src/algebraic_geometry/sheafed_space.lean b/src/algebraic_geometry/sheafed_space.lean index c7e77102ec00a..93836059c50d0 100644 --- a/src/algebraic_geometry/sheafed_space.lean +++ b/src/algebraic_geometry/sheafed_space.lean @@ -9,6 +9,9 @@ import topology.sheaves.functors /-! # Sheafed spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Introduces the category of topological spaces equipped with a sheaf (taking values in an arbitrary target category `C`.) @@ -25,14 +28,14 @@ open opposite open category_theory.limits open category_theory.category category_theory.functor -variables (C : Type u) [category.{v} C] [limits.has_products C] +variables (C : Type u) [category.{v} C] local attribute [tidy] tactic.op_induction' namespace algebraic_geometry /-- A `SheafedSpace C` is a topological space equipped with a sheaf of `C`s. -/ -structure SheafedSpace extends PresheafedSpace C := +structure SheafedSpace extends PresheafedSpace.{v} C := (is_sheaf : presheaf.is_sheaf) variables {C} @@ -45,7 +48,7 @@ instance coe_carrier : has_coe (SheafedSpace C) Top := /-- Extract the `sheaf C (X : Top)` from a `SheafedSpace C`. -/ def sheaf (X : SheafedSpace C) : sheaf C (X : Top.{v}) := ⟨X.presheaf, X.is_sheaf⟩ -@[simp] lemma as_coe (X : SheafedSpace C) : X.carrier = (X : Top.{v}) := rfl +@[simp] lemma as_coe (X : SheafedSpace.{v} C) : X.carrier = (X : Top.{v}) := rfl @[simp] lemma mk_coe (carrier) (presheaf) (h) : (({ carrier := carrier, presheaf := presheaf, is_sheaf := h } : SheafedSpace.{v} C) : Top.{v}) = carrier := @@ -53,23 +56,23 @@ rfl instance (X : SheafedSpace.{v} C) : topological_space X := X.carrier.str -/-- The trivial `punit` valued sheaf on any topological space. -/ -def punit (X : Top) : SheafedSpace (discrete punit) := -{ is_sheaf := presheaf.is_sheaf_punit _, - ..@PresheafedSpace.const (discrete punit) _ X punit.star } +/-- The trivial `unit` valued sheaf on any topological space. -/ +def unit (X : Top) : SheafedSpace (discrete unit) := +{ is_sheaf := presheaf.is_sheaf_unit _, + ..@PresheafedSpace.const (discrete unit) _ X ⟨⟨⟩⟩ } -instance : inhabited (SheafedSpace (discrete _root_.punit)) := ⟨punit (Top.of pempty)⟩ +instance : inhabited (SheafedSpace (discrete _root_.unit)) := ⟨unit (Top.of pempty)⟩ instance : category (SheafedSpace C) := -show category (induced_category (PresheafedSpace C) SheafedSpace.to_PresheafedSpace), +show category (induced_category (PresheafedSpace.{v} C) SheafedSpace.to_PresheafedSpace), by apply_instance /-- Forgetting the sheaf condition is a functor from `SheafedSpace C` to `PresheafedSpace C`. -/ @[derive [full, faithful]] -def forget_to_PresheafedSpace : (SheafedSpace C) ⥤ (PresheafedSpace C) := +def forget_to_PresheafedSpace : (SheafedSpace.{v} C) ⥤ (PresheafedSpace.{v} C) := induced_functor _ -instance is_PresheafedSpace_iso {X Y : SheafedSpace C} (f : X ⟶ Y) [is_iso f] : +instance is_PresheafedSpace_iso {X Y : SheafedSpace.{v} C} (f : X ⟶ Y) [is_iso f] : @is_iso (PresheafedSpace C) _ _ _ f := SheafedSpace.forget_to_PresheafedSpace.map_is_iso f @@ -119,9 +122,7 @@ The restriction of a sheafed space along an open embedding into the space. -/ def restrict {U : Top} (X : SheafedSpace C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) : SheafedSpace C := -{ is_sheaf := λ ι 𝒰, ⟨is_limit.of_iso_limit - ((is_limit.postcompose_inv_equiv _ _).inv_fun (X.is_sheaf _).some) - (sheaf_condition_equalizer_products.fork.iso_of_open_embedding h 𝒰).symm⟩, +{ is_sheaf := is_sheaf_of_open_embedding h X.is_sheaf, ..X.to_PresheafedSpace.restrict h } /-- diff --git a/src/algebraic_geometry/stalks.lean b/src/algebraic_geometry/stalks.lean index 63dad4e5f3b40..4f5b48591d9ea 100644 --- a/src/algebraic_geometry/stalks.lean +++ b/src/algebraic_geometry/stalks.lean @@ -10,6 +10,9 @@ import topology.sheaves.stalks /-! # Stalks for presheaved spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file lifts constructions of stalks and pushforwards of stalks to work with the category of presheafed spaces. Additionally, we prove that restriction of presheafed spaces does not change the stalks. @@ -27,7 +30,7 @@ open opposite variables {C : Type u} [category.{v} C] [has_colimits C] -local attribute [tidy] tactic.op_induction' +local attribute [tidy] tactic.op_induction' tactic.auto_cases_opens open Top.presheaf @@ -41,11 +44,11 @@ abbreviation stalk (X : PresheafedSpace C) (x : X) : C := X.presheaf.stalk x /-- A morphism of presheafed spaces induces a morphism of stalks. -/ -def stalk_map {X Y : PresheafedSpace C} (α : X ⟶ Y) (x : X) : Y.stalk (α.base x) ⟶ X.stalk x := +def stalk_map {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (x : X) : Y.stalk (α.base x) ⟶ X.stalk x := (stalk_functor C (α.base x)).map (α.c) ≫ X.presheaf.stalk_pushforward C α.base x @[simp, elementwise, reassoc] -lemma stalk_map_germ {X Y : PresheafedSpace C} (α : X ⟶ Y) (U : opens Y.carrier) +lemma stalk_map_germ {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (U : opens Y.carrier) (x : (opens.map α.base).obj U) : Y.presheaf.germ ⟨α.base x, x.2⟩ ≫ stalk_map α ↑x = α.c.app (op U) ≫ X.presheaf.germ x := by rw [stalk_map, stalk_functor_map_germ_assoc, stalk_pushforward_germ] @@ -56,7 +59,7 @@ section restrict For an open embedding `f : U ⟶ X` and a point `x : U`, we get an isomorphism between the stalk of `X` at `f x` and the stalk of the restriction of `X` along `f` at t `x`. -/ -def restrict_stalk_iso {U : Top} (X : PresheafedSpace C) +def restrict_stalk_iso {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (x : U) : (X.restrict h).stalk x ≅ X.stalk (f x) := begin @@ -69,7 +72,7 @@ begin end @[simp, elementwise, reassoc] -lemma restrict_stalk_iso_hom_eq_germ {U : Top} (X : PresheafedSpace C) {f : U ⟶ (X : Top.{v})} +lemma restrict_stalk_iso_hom_eq_germ {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (V : opens U) (x : U) (hx : x ∈ V) : (X.restrict h).presheaf.germ ⟨x, hx⟩ ≫ (restrict_stalk_iso X h x).hom = X.presheaf.germ ⟨f x, show f x ∈ h.is_open_map.functor.obj V, from ⟨x, hx, rfl⟩⟩ := @@ -77,13 +80,13 @@ colimit.ι_pre ((open_nhds.inclusion (f x)).op ⋙ X.presheaf) (h.is_open_map.functor_nhds x).op (op ⟨V, hx⟩) @[simp, elementwise, reassoc] -lemma restrict_stalk_iso_inv_eq_germ {U : Top} (X : PresheafedSpace C) {f : U ⟶ (X : Top.{v})} +lemma restrict_stalk_iso_inv_eq_germ {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (V : opens U) (x : U) (hx : x ∈ V) : X.presheaf.germ ⟨f x, show f x ∈ h.is_open_map.functor.obj V, from ⟨x, hx, rfl⟩⟩ ≫ (restrict_stalk_iso X h x).inv = (X.restrict h).presheaf.germ ⟨x, hx⟩ := by rw [← restrict_stalk_iso_hom_eq_germ, category.assoc, iso.hom_inv_id, category.comp_id] -lemma restrict_stalk_iso_inv_eq_of_restrict {U : Top} (X : PresheafedSpace C) +lemma restrict_stalk_iso_inv_eq_of_restrict {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (x : U) : (X.restrict_stalk_iso h x).inv = stalk_map (X.of_restrict h) x := begin @@ -99,7 +102,7 @@ begin exact (colimit.w ((open_nhds.inclusion (f x)).op ⋙ X.presheaf) i.op).symm, end -instance of_restrict_stalk_map_is_iso {U : Top} (X : PresheafedSpace C) +instance of_restrict_stalk_map_is_iso {U : Top} (X : PresheafedSpace.{v} C) {f : U ⟶ (X : Top.{v})} (h : open_embedding f) (x : U) : is_iso (stalk_map (X.of_restrict h) x) := by { rw ← restrict_stalk_iso_inv_eq_of_restrict, apply_instance } @@ -108,7 +111,7 @@ end restrict namespace stalk_map -@[simp] lemma id (X : PresheafedSpace C) (x : X) : stalk_map (𝟙 X) x = 𝟙 (X.stalk x) := +@[simp] lemma id (X : PresheafedSpace.{v} C) (x : X) : stalk_map (𝟙 X) x = 𝟙 (X.stalk x) := begin dsimp [stalk_map], simp only [stalk_pushforward.id], @@ -118,7 +121,7 @@ begin end -- TODO understand why this proof is still gross (i.e. requires using `erw`) -@[simp] lemma comp {X Y Z : PresheafedSpace C} (α : X ⟶ Y) (β : Y ⟶ Z) (x : X) : +@[simp] lemma comp {X Y Z : PresheafedSpace.{v} C} (α : X ⟶ Y) (β : Y ⟶ Z) (x : X) : stalk_map (α ≫ β) x = (stalk_map β (α.base x) : Z.stalk (β.base (α.base x)) ⟶ Y.stalk (α.base x)) ≫ (stalk_map α x : Y.stalk (α.base x) ⟶ X.stalk x) := @@ -144,22 +147,22 @@ Unfortunately, this equality is not well-formed, as their types are not _definit To get a proper congruence lemma, we therefore have to introduce these `eq_to_hom` arrows on either side of the equality. -/ -lemma congr {X Y : PresheafedSpace C} (α β : X ⟶ Y) (h₁ : α = β) (x x': X) (h₂ : x = x') : +lemma congr {X Y : PresheafedSpace.{v} C} (α β : X ⟶ Y) (h₁ : α = β) (x x': X) (h₂ : x = x') : stalk_map α x ≫ eq_to_hom (show X.stalk x = X.stalk x', by rw h₂) = eq_to_hom (show Y.stalk (α.base x) = Y.stalk (β.base x'), by rw [h₁, h₂]) ≫ stalk_map β x' := stalk_hom_ext _ $ λ U hx, by { subst h₁, subst h₂, simp } -lemma congr_hom {X Y : PresheafedSpace C} (α β : X ⟶ Y) (h : α = β) (x : X) : +lemma congr_hom {X Y : PresheafedSpace.{v} C} (α β : X ⟶ Y) (h : α = β) (x : X) : stalk_map α x = eq_to_hom (show Y.stalk (α.base x) = Y.stalk (β.base x), by rw h) ≫ stalk_map β x := by rw [← stalk_map.congr α β h x x rfl, eq_to_hom_refl, category.comp_id] -lemma congr_point {X Y : PresheafedSpace C} (α : X ⟶ Y) (x x' : X) (h : x = x') : +lemma congr_point {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) (x x' : X) (h : x = x') : stalk_map α x ≫ eq_to_hom (show X.stalk x = X.stalk x', by rw h) = eq_to_hom (show Y.stalk (α.base x) = Y.stalk (α.base x'), by rw h) ≫ stalk_map α x' := by rw stalk_map.congr α α rfl x x' h -instance is_iso {X Y : PresheafedSpace C} (α : X ⟶ Y) [is_iso α] (x : X) : +instance is_iso {X Y : PresheafedSpace.{v} C} (α : X ⟶ Y) [is_iso α] (x : X) : is_iso (stalk_map α x) := { out := begin let β : Y ⟶ X := category_theory.inv α, @@ -184,13 +187,13 @@ end } /-- An isomorphism between presheafed spaces induces an isomorphism of stalks. -/ -def stalk_iso {X Y : PresheafedSpace C} (α : X ≅ Y) (x : X) : +def stalk_iso {X Y : PresheafedSpace.{v} C} (α : X ≅ Y) (x : X) : Y.stalk (α.hom.base x) ≅ X.stalk x := as_iso (stalk_map α.hom x) @[simp, reassoc, elementwise] -lemma stalk_specializes_stalk_map {X Y : PresheafedSpace C} (f : X ⟶ Y) {x y : X} (h : x ⤳ y) : - Y.presheaf.stalk_specializes (f.base.map_specialization h) ≫ stalk_map f x = +lemma stalk_specializes_stalk_map {X Y : PresheafedSpace.{v} C} (f : X ⟶ Y) {x y : X} (h : x ⤳ y) : + Y.presheaf.stalk_specializes (f.base.map_specializes h) ≫ stalk_map f x = stalk_map f y ≫ X.presheaf.stalk_specializes h := by { delta PresheafedSpace.stalk_map, simp [stalk_map] } diff --git a/src/algebraic_geometry/structure_sheaf.lean b/src/algebraic_geometry/structure_sheaf.lean index efbf261969500..1f2848001ed88 100644 --- a/src/algebraic_geometry/structure_sheaf.lean +++ b/src/algebraic_geometry/structure_sheaf.lean @@ -13,6 +13,9 @@ import ring_theory.subring.basic /-! # The structure sheaf on `prime_spectrum R`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the structure sheaf on `Top.of (prime_spectrum R)`, for a commutative ring `R` and prove basic properties about it. We define this as a subsheaf of the sheaf of dependent functions into the localizations, cut out by the condition that the function must be locally equal to a ratio of @@ -262,7 +265,7 @@ def Spec.structure_sheaf : sheaf CommRing (prime_spectrum.Top R) := -- We check the sheaf condition under `forget CommRing`. (is_sheaf_iff_is_sheaf_comp _ _).mpr (is_sheaf_of_iso (structure_presheaf_comp_forget R).symm - (structure_sheaf_in_Type R).property)⟩ + (structure_sheaf_in_Type R).cond)⟩ open Spec (structure_sheaf) @@ -358,7 +361,8 @@ by convert is_localization.mk'_mul _ f₁ f₂ ⟨g₁, hu₁ x x.2⟩ ⟨g₂, lemma const_ext {f₁ f₂ g₁ g₂ : R} {U hu₁ hu₂} (h : f₁ * g₂ = f₂ * g₁) : const R f₁ g₁ U hu₁ = const R f₂ g₂ U hu₂ := -subtype.eq $ funext $ λ x, is_localization.mk'_eq_of_eq h.symm +subtype.eq $ funext $ λ x, is_localization.mk'_eq_of_eq + (by rw [mul_comm, subtype.coe_mk, ←h, mul_comm, subtype.coe_mk]) lemma const_congr {f₁ f₂ g₁ g₂ : R} {U hu} (hf : f₁ = f₂) (hg : g₁ = g₂) : const R f₁ g₁ U hu = const R f₂ g₂ U (hg ▸ hu) := @@ -402,20 +406,20 @@ subtype.eq $ funext $ λ x, eq.symm $ is_localization.mk'_one _ f /-- The canonical ring homomorphism interpreting an element of `R` as an element of the stalk of `structure_sheaf R` at `x`. -/ -def to_stalk (x : prime_spectrum.Top R) : CommRing.of R ⟶ (structure_sheaf R).1.stalk x := -(to_open R ⊤ ≫ (structure_sheaf R).1.germ ⟨x, ⟨⟩⟩ : _) +def to_stalk (x : prime_spectrum.Top R) : CommRing.of R ⟶ (structure_sheaf R).presheaf.stalk x := +(to_open R ⊤ ≫ (structure_sheaf R).presheaf.germ ⟨x, ⟨⟩⟩ : _) @[simp] lemma to_open_germ (U : opens (prime_spectrum.Top R)) (x : U) : - to_open R U ≫ (structure_sheaf R).1.germ x = + to_open R U ≫ (structure_sheaf R).presheaf.germ x = to_stalk R x := by { rw [← to_open_res R ⊤ U (hom_of_le le_top : U ⟶ ⊤), category.assoc, presheaf.germ_res], refl } @[simp] lemma germ_to_open (U : opens (prime_spectrum.Top R)) (x : U) (f : R) : - (structure_sheaf R).1.germ x (to_open R U f) = to_stalk R x f := + (structure_sheaf R).presheaf.germ x (to_open R U f) = to_stalk R x f := by { rw ← to_open_germ, refl } lemma germ_to_top (x : prime_spectrum.Top R) (f : R) : - (structure_sheaf R).1.germ (⟨x, trivial⟩ : (⊤ : opens (prime_spectrum.Top R))) + (structure_sheaf R).presheaf.germ (⟨x, trivial⟩ : (⊤ : opens (prime_spectrum.Top R))) (to_open R ⊤ f) = to_stalk R x f := rfl @@ -432,7 +436,7 @@ by { erw ← germ_to_open R (basic_open (f : R)) ⟨x, f.2⟩ (f : R), /-- The canonical ring homomorphism from the localization of `R` at `p` to the stalk of the structure sheaf at the point `p`. -/ def localization_to_stalk (x : prime_spectrum.Top R) : - CommRing.of (localization.at_prime x.as_ideal) ⟶ (structure_sheaf R).1.stalk x := + CommRing.of (localization.at_prime x.as_ideal) ⟶ (structure_sheaf R).presheaf.stalk x := show localization.at_prime x.as_ideal →+* _, from is_localization.lift (is_unit_to_stalk R x) @@ -443,7 +447,7 @@ is_localization.lift_eq _ f @[simp] lemma localization_to_stalk_mk' (x : prime_spectrum.Top R) (f : R) (s : (as_ideal x).prime_compl) : localization_to_stalk R x (is_localization.mk' _ f s : localization _) = - (structure_sheaf R).1.germ (⟨x, s.2⟩ : basic_open (s : R)) + (structure_sheaf R).presheaf.germ (⟨x, s.2⟩ : basic_open (s : R)) (const R f s (basic_open s) (λ _, id)) := (is_localization.lift_mk'_spec _ _ _ _).2 $ by erw [← germ_to_open R (basic_open s) ⟨x, s.2⟩, ← germ_to_open R (basic_open s) ⟨x, s.2⟩, @@ -478,25 +482,25 @@ rfl a prime ideal `p` to the localization of `R` at `p`, formed by gluing the `open_to_localization` maps. -/ def stalk_to_fiber_ring_hom (x : prime_spectrum.Top R) : - (structure_sheaf R).1.stalk x ⟶ CommRing.of (localization.at_prime x.as_ideal) := + (structure_sheaf R).presheaf.stalk x ⟶ CommRing.of (localization.at_prime x.as_ideal) := limits.colimit.desc (((open_nhds.inclusion x).op) ⋙ (structure_sheaf R).1) { X := _, ι := { app := λ U, open_to_localization R ((open_nhds.inclusion _).obj (unop U)) x (unop U).2, } } @[simp] lemma germ_comp_stalk_to_fiber_ring_hom (U : opens (prime_spectrum.Top R)) (x : U) : - (structure_sheaf R).1.germ x ≫ stalk_to_fiber_ring_hom R x = + (structure_sheaf R).presheaf.germ x ≫ stalk_to_fiber_ring_hom R x = open_to_localization R U x x.2 := limits.colimit.ι_desc _ _ @[simp] lemma stalk_to_fiber_ring_hom_germ' (U : opens (prime_spectrum.Top R)) (x : prime_spectrum.Top R) (hx : x ∈ U) (s : (structure_sheaf R).1.obj (op U)) : - stalk_to_fiber_ring_hom R x ((structure_sheaf R).1.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) := + stalk_to_fiber_ring_hom R x ((structure_sheaf R).presheaf.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) := ring_hom.ext_iff.1 (germ_comp_stalk_to_fiber_ring_hom R U ⟨x, hx⟩ : _) s @[simp] lemma stalk_to_fiber_ring_hom_germ (U : opens (prime_spectrum.Top R)) (x : U) (s : (structure_sheaf R).1.obj (op U)) : - stalk_to_fiber_ring_hom R x ((structure_sheaf R).1.germ x s) = s.1 x := + stalk_to_fiber_ring_hom R x ((structure_sheaf R).presheaf.germ x s) = s.1 x := by { cases x, exact stalk_to_fiber_ring_hom_germ' R U _ _ _ } @[simp] lemma to_stalk_comp_stalk_to_fiber_ring_hom (x : prime_spectrum.Top R) : @@ -510,15 +514,15 @@ ring_hom.ext_iff.1 (to_stalk_comp_stalk_to_fiber_ring_hom R x) _ /-- The ring isomorphism between the stalk of the structure sheaf of `R` at a point `p` corresponding to a prime ideal in `R` and the localization of `R` at `p`. -/ @[simps] def stalk_iso (x : prime_spectrum.Top R) : - (structure_sheaf R).1.stalk x ≅ CommRing.of (localization.at_prime x.as_ideal) := + (structure_sheaf R).presheaf.stalk x ≅ CommRing.of (localization.at_prime x.as_ideal) := { hom := stalk_to_fiber_ring_hom R x, inv := localization_to_stalk R x, - hom_inv_id' := (structure_sheaf R).1.stalk_hom_ext $ λ U hxU, + hom_inv_id' := (structure_sheaf R).presheaf.stalk_hom_ext $ λ U hxU, begin ext s, simp only [comp_apply], rw [id_apply, stalk_to_fiber_ring_hom_germ'], obtain ⟨V, hxV, iVU, f, g, hg, hs⟩ := exists_const _ _ s x hxU, erw [← res_apply R U V iVU s ⟨x, hxV⟩, ← hs, const_apply, localization_to_stalk_mk'], - refine (structure_sheaf R).1.germ_ext V hxV (hom_of_le hg) iVU _, + refine (structure_sheaf R).presheaf.germ_ext V hxV (hom_of_le hg) iVU _, erw [← hs, res_const'] end, inv_hom_id' := @is_localization.ring_hom_ext R _ x.as_ideal.prime_compl @@ -575,17 +579,17 @@ begin rw is_localization.eq, -- We know that the fractions `a/b` and `c/d` are equal as sections of the structure sheaf on -- `basic_open f`. We need to show that they agree as elements in the localization of `R` at `f`. - -- This amounts showing that `a * d * r = c * b * r`, for some power `r = f ^ n` of `f`. + -- This amounts showing that `r * (d * a) = r * (b * c)`, for some power `r = f ^ n` of `f`. -- We define `I` as the ideal of *all* elements `r` satisfying the above equation. let I : ideal R := - { carrier := {r : R | a * d * r = c * b * r}, - zero_mem' := by simp only [set.mem_set_of_eq, mul_zero], - add_mem' := λ r₁ r₂ hr₁ hr₂, by { dsimp at hr₁ hr₂ ⊢, simp only [mul_add, hr₁, hr₂] }, - smul_mem' := λ r₁ r₂ hr₂, by { dsimp at hr₂ ⊢, simp only [mul_comm r₁ r₂, ← mul_assoc, hr₂] }}, + { carrier := {r : R | r * (d * a) = r * (b * c)}, + zero_mem' := by simp only [set.mem_set_of_eq, zero_mul], + add_mem' := λ r₁ r₂ hr₁ hr₂, by { dsimp at hr₁ hr₂ ⊢, simp only [add_mul, hr₁, hr₂] }, + smul_mem' := λ r₁ r₂ hr₂, by { dsimp at hr₂ ⊢, simp only [mul_assoc, hr₂] }}, -- Our claim now reduces to showing that `f` is contained in the radical of `I` suffices : f ∈ I.radical, { cases this with n hn, - exact ⟨⟨f ^ n, n, rfl⟩, hn⟩ }, + exact ⟨⟨f ^ n, n, rfl⟩, hn⟩, }, rw [← vanishing_ideal_zero_locus_eq_radical, mem_vanishing_ideal], intros p hfp, contrapose hfp, @@ -607,9 +611,9 @@ lemma locally_const_basic_open (U : opens (prime_spectrum.Top R)) begin -- First, any section `s` can be represented as a fraction `f/g` on some open neighborhood of `x` -- and we may pass to a `basic_open h`, since these form a basis - obtain ⟨V, (hxV : x.1 ∈ V.1), iVU, f, g, (hVDg : V ⊆ basic_open g), s_eq⟩ := + obtain ⟨V, (hxV : x.1 ∈ V.1), iVU, f, g, (hVDg : V ≤ basic_open g), s_eq⟩ := exists_const R U s x.1 x.2, - obtain ⟨_, ⟨h, rfl⟩, hxDh, (hDhV : basic_open h ⊆ V)⟩ := + obtain ⟨_, ⟨h, rfl⟩, hxDh, (hDhV : basic_open h ≤ V)⟩ := is_topological_basis_basic_opens.exists_subset_of_mem_open hxV V.2, -- The problem is of course, that `g` and `h` don't need to coincide. -- But, since `basic_open h ≤ basic_open g`, some power of `h` must be a multiple of `g` @@ -643,11 +647,11 @@ A local representation of a section `s` as fractions `a i / h i` on finitely man -/ lemma normalize_finite_fraction_representation (U : opens (prime_spectrum.Top R)) (s : (structure_sheaf R).1.obj (op U)) {ι : Type*} (t : finset ι) (a h : ι → R) - (iDh : Π i : ι, basic_open (h i) ⟶ U) (h_cover : U.1 ⊆ ⋃ i ∈ t, (basic_open (h i)).1) + (iDh : Π i : ι, basic_open (h i) ⟶ U) (h_cover : U ≤ ⨆ i ∈ t, basic_open (h i)) (hs : ∀ i : ι, const R (a i) (h i) (basic_open (h i)) (λ y hy, hy) = (structure_sheaf R).1.map (iDh i).op s) : ∃ (a' h' : ι → R) (iDh' : Π i : ι, (basic_open (h' i)) ⟶ U), - (U.1 ⊆ ⋃ i ∈ t, (basic_open (h' i)).1) ∧ + (U ≤ ⨆ i ∈ t, basic_open (h' i)) ∧ (∀ i j ∈ t, a' i * h' j = h' i * a' j) ∧ (∀ i ∈ t, (structure_sheaf R).1.map (iDh' i).op s = const R (a' i) (h' i) (basic_open (h' i)) (λ y hy, hy)) := @@ -688,7 +692,7 @@ begin have n_spec := λ (p : ι × ι), (exists_power p.fst p.snd).some_spec, -- We need one power `(h i * h j) ^ N` that works for *all* pairs `(i,j)` -- Since there are only finitely many indices involved, we can pick the supremum. - let N := (t.product t).sup n, + let N := (t ×ˢ t).sup n, have basic_opens_eq : ∀ i : ι, basic_open ((h i) ^ (N+1)) = basic_open (h i) := λ i, basic_open_pow _ _ (by linarith), -- Expanding the fraction `a i / h i` by the power `(h i) ^ N` gives the desired normalization @@ -734,19 +738,21 @@ begin choose a' h' iDh' hxDh' s_eq' using locally_const_basic_open R (basic_open f) s, -- Since basic opens are compact, we can pass to a finite subcover obtain ⟨t, ht_cover'⟩ := (is_compact_basic_open f).elim_finite_subcover - (λ (i : ι), (basic_open (h' i)).1) (λ i, is_open_basic_open) (λ x hx, _), + (λ (i : ι), basic_open (h' i)) (λ i, is_open_basic_open) (λ x hx, _), swap, { -- Here, we need to show that our basic opens actually form a cover of `basic_open f` rw set.mem_Union, exact ⟨⟨x,hx⟩, hxDh' ⟨x, hx⟩⟩ }, + simp only [← opens.coe_supr, set_like.coe_subset_coe] at ht_cover', -- We use the normalization lemma from above to obtain the relation `a i * h j = h i * a j` obtain ⟨a, h, iDh, ht_cover, ah_ha, s_eq⟩ := normalize_finite_fraction_representation R (basic_open f) s t a' h' iDh' ht_cover' s_eq', clear s_eq' iDh' hxDh' ht_cover' a' h', + simp only [← set_like.coe_subset_coe, opens.coe_supr] at ht_cover, -- Next we show that some power of `f` is a linear combination of the `h i` obtain ⟨n, hn⟩ : f ∈ (ideal.span (h '' ↑t)).radical, { rw [← vanishing_ideal_zero_locus_eq_radical, zero_locus_span], - simp_rw [subtype.val_eq_coe, basic_open_eq_zero_locus_compl] at ht_cover, + simp only [basic_open_eq_zero_locus_compl] at ht_cover, rw set.compl_subset_comm at ht_cover, -- Why doesn't `simp_rw` do this? simp_rw [set.compl_Union, compl_compl, ← zero_locus_Union, ← finset.set_bUnion_coe, ← set.image_eq_Union ] at ht_cover, @@ -813,15 +819,15 @@ def basic_open_iso (f : R) : (structure_sheaf R).1.obj (op (basic_open f)) ≅ CommRing.of (localization.away f) := (as_iso (show CommRing.of _ ⟶ _, from to_basic_open R f)).symm -instance stalk_algebra (p : prime_spectrum R) : algebra R ((structure_sheaf R).val.stalk p) := +instance stalk_algebra (p : prime_spectrum R) : algebra R ((structure_sheaf R).presheaf.stalk p) := (to_stalk R p).to_algebra @[simp] lemma stalk_algebra_map (p : prime_spectrum R) (r : R) : - algebra_map R ((structure_sheaf R).val.stalk p) r = to_stalk R p r := rfl + algebra_map R ((structure_sheaf R).presheaf.stalk p) r = to_stalk R p r := rfl /-- Stalk of the structure sheaf at a prime p as localization of R -/ instance is_localization.to_stalk (p : prime_spectrum R) : - is_localization.at_prime ((structure_sheaf R).val.stalk p) p.as_ideal := + is_localization.at_prime ((structure_sheaf R).presheaf.stalk p) p.as_ideal := begin convert (is_localization.is_localization_iff_of_ring_equiv _ (stalk_iso R p).symm .CommRing_iso_to_ring_equiv).mp localization.is_localization, @@ -876,7 +882,8 @@ begin end /-- The ring isomorphism between the ring `R` and the global sections `Γ(X, 𝒪ₓ)`. -/ -@[simps] def global_sections_iso : CommRing.of R ≅ (structure_sheaf R).1.obj (op ⊤) := +@[simps {rhs_md := tactic.transparency.semireducible}] +def global_sections_iso : CommRing.of R ≅ (structure_sheaf R).1.obj (op ⊤) := as_iso (to_open R ⊤) @[simp] lemma global_sections_iso_hom (R : CommRing) : @@ -885,13 +892,13 @@ as_iso (to_open R ⊤) @[simp, reassoc, elementwise] lemma to_stalk_stalk_specializes {R : Type*} [comm_ring R] {x y : prime_spectrum R} (h : x ⤳ y) : - to_stalk R y ≫ (structure_sheaf R).val.stalk_specializes h = to_stalk R x := -by { dsimp [ to_stalk], simpa } + to_stalk R y ≫ (structure_sheaf R).presheaf.stalk_specializes h = to_stalk R x := +by { dsimp[to_stalk], simpa [-to_open_germ], } @[simp, reassoc, elementwise] lemma localization_to_stalk_stalk_specializes {R : Type*} [comm_ring R] {x y : prime_spectrum R} (h : x ⤳ y) : - structure_sheaf.localization_to_stalk R y ≫ (structure_sheaf R).val.stalk_specializes h = + structure_sheaf.localization_to_stalk R y ≫ (structure_sheaf R).presheaf.stalk_specializes h = CommRing.of_hom (prime_spectrum.localization_map_of_specializes h) ≫ structure_sheaf.localization_to_stalk R x := begin @@ -907,7 +914,7 @@ end @[simp, reassoc, elementwise] lemma stalk_specializes_stalk_to_fiber {R : Type*} [comm_ring R] {x y : prime_spectrum R} (h : x ⤳ y) : - (structure_sheaf R).val.stalk_specializes h ≫ structure_sheaf.stalk_to_fiber_ring_hom R x = + (structure_sheaf R).presheaf.stalk_specializes h ≫ structure_sheaf.stalk_to_fiber_ring_hom R x = structure_sheaf.stalk_to_fiber_ring_hom R y ≫ prime_spectrum.localization_map_of_specializes h := begin diff --git a/src/algebraic_topology/Moore_complex.lean b/src/algebraic_topology/Moore_complex.lean index 911de401dca0c..5c835034f90df 100644 --- a/src/algebraic_topology/Moore_complex.lean +++ b/src/algebraic_topology/Moore_complex.lean @@ -10,6 +10,9 @@ import category_theory.abelian.basic /-! ## Moore complex +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We construct the normalized Moore complex, as a functor `simplicial_object C ⥤ chain_complex C ℕ`, for any abelian category `C`. @@ -91,12 +94,12 @@ begin -- after the first simp the proofs are almost identical cases n; dsimp, { simp only [subobject.factor_thru_arrow_assoc], - slice_lhs 2 3 { erw ←X.δ_comp_δ (fin.zero_le 0), }, + slice_lhs 2 3 { erw ←X.δ_comp_δ (fin.zero_le (0 : fin (0 + 2))), }, rw ←factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ (0 : fin 2) (by simp)), slice_lhs 2 3 { rw [kernel_subobject_arrow_comp], }, simp, }, { simp [factor_thru_right], - slice_lhs 2 3 { erw ←X.δ_comp_δ (fin.zero_le 0), }, + slice_lhs 2 3 { erw ←X.δ_comp_δ (fin.zero_le (0 : fin (n.succ + 2))) }, rw ←factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ (0 : fin (n+3)) (by simp)), slice_lhs 2 3 { rw [kernel_subobject_arrow_comp], }, simp, }, @@ -131,8 +134,8 @@ chain_complex.of_hom _ _ _ _ _ _ end) (λ n, begin cases n; dsimp, - { ext, simp, erw f.naturality, refl, }, - { ext, simp, erw f.naturality, refl, }, + { ext, simp, }, + { ext, simp, }, end) end normalized_Moore_complex @@ -157,4 +160,11 @@ def normalized_Moore_complex : simplicial_object C ⥤ chain_complex C ℕ := map_id' := λ X, by { ext n, cases n; { dsimp, simp, }, }, map_comp' := λ X Y Z f g, by { ext n, cases n; simp, }, } +variable {C} + +@[simp] +lemma normalized_Moore_complex_obj_d (X : simplicial_object C) (n : ℕ) : + ((normalized_Moore_complex C).obj X).d (n+1) n = normalized_Moore_complex.obj_d X n := +by apply chain_complex.of_d + end algebraic_topology diff --git a/src/algebraic_topology/alternating_face_map_complex.lean b/src/algebraic_topology/alternating_face_map_complex.lean index 2e2c7649b4e6e..9556037c8df4a 100644 --- a/src/algebraic_topology/alternating_face_map_complex.lean +++ b/src/algebraic_topology/alternating_face_map_complex.lean @@ -7,17 +7,26 @@ Authors: Joël Riou, Adam Topaz, Johan Commelin import algebra.homology.additive import algebraic_topology.Moore_complex import algebra.big_operators.fin +import category_theory.preadditive.opposite +import category_theory.idempotents.functor_categories +import tactic.equiv_rw /-! # The alternating face map complex of a simplicial object in a preadditive category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We construct the alternating face map complex, as a functor `alternating_face_map_complex : simplicial_object C ⥤ chain_complex C ℕ` for any preadditive category `C`. For any simplicial object `X` in `C`, this is the homological complex `... → X_2 → X_1 → X_0` where the differentials are alternating sums of faces. +The dual version `alternating_coface_map_complex : cosimplicial_object C ⥤ cochain_complex C ℕ` +is also constructed. + We also construct the natural transformation `inclusion_of_Moore_complex : normalized_Moore_complex A ⟶ alternating_face_map_complex A` when `A` is an abelian category. @@ -29,7 +38,7 @@ when `A` is an abelian category. -/ open category_theory category_theory.limits category_theory.subobject -open category_theory.preadditive category_theory.category +open category_theory.preadditive category_theory.category category_theory.idempotents open opposite open_locale big_operators @@ -121,10 +130,19 @@ end /-- The alternating face map complex, on objects -/ def obj : chain_complex C ℕ := chain_complex.of (λ n, X _[n]) (obj_d X) (d_squared X) +@[simp] +lemma obj_X (X : simplicial_object C) (n : ℕ) : + (alternating_face_map_complex.obj X).X n = X _[n] := rfl + +@[simp] +lemma obj_d_eq (X : simplicial_object C) (n : ℕ) : + (alternating_face_map_complex.obj X).d (n+1) n = + ∑ (i : fin (n+2)), (-1 : ℤ)^(i : ℕ) • X.δ i := +by apply chain_complex.of_d + variables {X} {Y} /-- The alternating face map complex, on morphisms -/ -@[simp] def map (f : X ⟶ Y) : obj X ⟶ obj Y := chain_complex.of_hom _ _ _ _ _ _ (λ n, f.app (op [n])) @@ -134,22 +152,38 @@ chain_complex.of_hom _ _ _ _ _ _ rw [comp_sum, sum_comp], apply finset.sum_congr rfl (λ x h, _), rw [comp_zsmul, zsmul_comp], - apply congr_arg, - erw f.naturality, - refl, + congr' 1, + symmetry, + apply f.naturality, end) +@[simp] +lemma map_f (f : X ⟶ Y) (n : ℕ) : (map f).f n = f.app (op [n]) := rfl + end alternating_face_map_complex variables (C : Type*) [category C] [preadditive C] /-- The alternating face map complex, as a functor -/ -@[simps] def alternating_face_map_complex : simplicial_object C ⥤ chain_complex C ℕ := { obj := alternating_face_map_complex.obj, map := λ X Y f, alternating_face_map_complex.map f } -variables {C} +variable {C} + +@[simp] +lemma alternating_face_map_complex_obj_X (X : simplicial_object C) (n : ℕ) : + ((alternating_face_map_complex C).obj X).X n = X _[n] := rfl + +@[simp] +lemma alternating_face_map_complex_obj_d (X : simplicial_object C) (n : ℕ) : + ((alternating_face_map_complex C).obj X).d (n+1) n = + alternating_face_map_complex.obj_d X n := +by apply chain_complex.of_d + +@[simp] +lemma alternating_face_map_complex_map_f {X Y : simplicial_object C} (f : X ⟶ Y) (n : ℕ) : + ((alternating_face_map_complex C).map f).f n = f.app (op [n]) := rfl lemma map_alternating_face_map_complex {D : Type*} [category D] [preadditive D] (F : C ⥤ D) [F.additive] : @@ -159,21 +193,51 @@ begin apply category_theory.functor.ext, { intros X Y f, ext n, - simp only [functor.comp_map, alternating_face_map_complex.map, - alternating_face_map_complex_map, functor.map_homological_complex_map_f, - chain_complex.of_hom_f, simplicial_object.whiskering_obj_map_app, - homological_complex.comp_f, homological_complex.eq_to_hom_f, - eq_to_hom_refl, comp_id, id_comp], }, + simp only [functor.comp_map, homological_complex.comp_f, + alternating_face_map_complex_map_f, functor.map_homological_complex_map_f, + homological_complex.eq_to_hom_f, eq_to_hom_refl, comp_id, id_comp, + simplicial_object.whiskering_obj_map_app], }, { intro X, - erw chain_complex.map_chain_complex_of, - congr, - ext n, - simp only [alternating_face_map_complex.obj_d, functor.map_sum], - congr, - ext, - apply functor.map_zsmul, }, + apply homological_complex.ext, + { rintros i j (rfl : j + 1 = i), + dsimp only [functor.comp_obj], + simpa only [functor.map_homological_complex_obj_d, alternating_face_map_complex_obj_d, + eq_to_hom_refl, id_comp, comp_id, alternating_face_map_complex.obj_d, + functor.map_sum, functor.map_zsmul], }, + { ext n, + refl, }, }, end +lemma karoubi_alternating_face_map_complex_d (P : karoubi (simplicial_object C)) (n : ℕ) : + (((alternating_face_map_complex.obj (karoubi_functor_category_embedding.obj P)).d (n+1) n).f) = + P.p.app (op [n+1]) ≫ ((alternating_face_map_complex.obj P.X).d (n+1) n) := +begin + dsimp, + simpa only [alternating_face_map_complex.obj_d_eq, karoubi.sum_hom, + preadditive.comp_sum, karoubi.zsmul_hom, preadditive.comp_zsmul], +end + +namespace alternating_face_map_complex + +/-- The natural transformation which gives the augmentation of the alternating face map +complex attached to an augmented simplicial object. -/ +@[simps] +def ε [limits.has_zero_object C] : + simplicial_object.augmented.drop ⋙ algebraic_topology.alternating_face_map_complex C ⟶ + simplicial_object.augmented.point ⋙ chain_complex.single₀ C := +{ app := λ X, begin + equiv_rw chain_complex.to_single₀_equiv _ _, + refine ⟨X.hom.app (op [0]), _⟩, + dsimp, + simp only [alternating_face_map_complex_obj_d, obj_d, fin.sum_univ_two, + fin.coe_zero, pow_zero, one_zsmul, fin.coe_one, pow_one, neg_smul, add_comp, + simplicial_object.δ_naturality, neg_comp], + apply add_right_neg, + end, + naturality' := λ X Y f, by { ext, exact congr_app f.w _, }, } + +end alternating_face_map_complex + /-! ## Construction of the natural inclusion of the normalized Moore complex -/ @@ -205,7 +269,7 @@ chain_complex.of_hom _ _ _ _ _ _ rw normalized_Moore_complex.obj_X, rw ← factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ _ j (by simp only [finset.mem_univ])), - slice_lhs 2 3 { erw kernel_subobject_arrow_comp (X.δ j.succ), }, + slice_lhs 2 3 { rw kernel_subobject_arrow_comp (X.δ j.succ), }, simp only [comp_zero], }, rw [fintype.sum_eq_zero _ null], simp only [add_zero], @@ -231,4 +295,53 @@ def inclusion_of_Moore_complex : (normalized_Moore_complex A) ⟶ (alternating_face_map_complex A) := { app := inclusion_of_Moore_complex_map, } +namespace alternating_coface_map_complex + +variables (X Y : cosimplicial_object C) + +/-- The differential on the alternating coface map complex is the alternate +sum of the coface maps -/ +@[simp] +def obj_d (n : ℕ) : X.obj [n] ⟶ X.obj [n+1] := +∑ (i : fin (n+2)), (-1 : ℤ)^(i : ℕ) • X.δ i + +lemma d_eq_unop_d (n : ℕ) : + obj_d X n = (alternating_face_map_complex.obj_d + ((cosimplicial_simplicial_equiv C).functor.obj (op X)) n).unop := +by simpa only [obj_d, alternating_face_map_complex.obj_d, unop_sum, unop_zsmul] + +lemma d_squared (n : ℕ) : obj_d X n ≫ obj_d X (n+1) = 0 := +by simp only [d_eq_unop_d, ← unop_comp, alternating_face_map_complex.d_squared, unop_zero] + +/-- The alternating coface map complex, on objects -/ +def obj : cochain_complex C ℕ := cochain_complex.of (λ n, X.obj [n]) (obj_d X) (d_squared X) + +variables {X} {Y} + +/-- The alternating face map complex, on morphisms -/ +@[simp] +def map (f : X ⟶ Y) : obj X ⟶ obj Y := +cochain_complex.of_hom _ _ _ _ _ _ + (λ n, f.app [n]) + (λ n, + begin + dsimp, + rw [comp_sum, sum_comp], + apply finset.sum_congr rfl (λ x h, _), + rw [comp_zsmul, zsmul_comp], + congr' 1, + symmetry, + apply f.naturality, + end) + +end alternating_coface_map_complex + +variable (C) + +/-- The alternating coface map complex, as a functor -/ +@[simps] +def alternating_coface_map_complex : cosimplicial_object C ⥤ cochain_complex C ℕ := +{ obj := alternating_coface_map_complex.obj, + map := λ X Y f, alternating_coface_map_complex.map f } + end algebraic_topology diff --git a/src/algebraic_topology/cech_nerve.lean b/src/algebraic_topology/cech_nerve.lean index 9c21341cfe6cb..e6024e9ae55ca 100644 --- a/src/algebraic_topology/cech_nerve.lean +++ b/src/algebraic_topology/cech_nerve.lean @@ -6,12 +6,16 @@ Authors: Adam Topaz import algebraic_topology.simplicial_object import category_theory.limits.shapes.wide_pullbacks +import category_theory.limits.shapes.finite_products import category_theory.arrow /-! # The Čech Nerve +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides a definition of the Čech nerve associated to an arrow, provided the base category has the correct wide pullbacks. @@ -22,6 +26,10 @@ Several variants are provided, given `f : arrow C`: 3. `simplicial_object.cech_nerve` and `simplicial_object.augmented_cech_nerve` are functorial versions of 1 resp. 2. +We end the file with a description of the Čech nerve of an arrow `X ⟶ ⊤_ C` to a terminal +object, when `C` has finite products. We call this `cech_nerve_terminal_from`. When `C` is +`G`-Set this gives us `EG` (the universal cover of the classifying space of `G`) as a simplicial +`G`-set, which is useful for group cohomology. -/ open category_theory @@ -29,30 +37,30 @@ open category_theory.limits noncomputable theory -universes v u +universes v u w variables {C : Type u} [category.{v} C] namespace category_theory.arrow variables (f : arrow C) -variables [∀ n : ℕ, has_wide_pullback f.right (λ i : ulift (fin (n+1)), f.left) (λ i, f.hom)] +variables [∀ n : ℕ, has_wide_pullback.{0} f.right (λ i : fin (n+1), f.left) (λ i, f.hom)] /-- The Čech nerve associated to an arrow. -/ @[simps] def cech_nerve : simplicial_object C := -{ obj := λ n, wide_pullback f.right - (λ i : ulift (fin (n.unop.len + 1)), f.left) (λ i, f.hom), +{ obj := λ n, wide_pullback.{0} f.right + (λ i : fin (n.unop.len + 1), f.left) (λ i, f.hom), map := λ m n g, wide_pullback.lift (wide_pullback.base _) - (λ i, wide_pullback.π (λ i, f.hom) $ ulift.up $ g.unop.to_order_hom i.down) $ λ j, by simp, + (λ i, wide_pullback.π (λ i, f.hom) $ g.unop.to_order_hom i) $ λ j, by simp, map_id' := λ x, by { ext ⟨⟩, { simpa }, { simp } }, map_comp' := λ x y z f g, by { ext ⟨⟩, { simpa }, { simp } } } /-- The morphism between Čech nerves associated to a morphism of arrows. -/ @[simps] def map_cech_nerve {f g : arrow C} - [∀ n : ℕ, has_wide_pullback f.right (λ i : ulift (fin (n+1)), f.left) (λ i, f.hom)] - [∀ n : ℕ, has_wide_pullback g.right (λ i : ulift (fin (n+1)), g.left) (λ i, g.hom)] + [∀ n : ℕ, has_wide_pullback f.right (λ i : fin (n+1), f.left) (λ i, f.hom)] + [∀ n : ℕ, has_wide_pullback g.right (λ i : fin (n+1), g.left) (λ i, g.hom)] (F : f ⟶ g) : f.cech_nerve ⟶ g.cech_nerve := { app := λ n, wide_pullback.lift (wide_pullback.base _ ≫ F.right) (λ i, wide_pullback.π _ i ≫ F.left) $ λ j, by simp, @@ -70,8 +78,8 @@ def augmented_cech_nerve : simplicial_object.augmented C := /-- The morphism between augmented Čech nerve associated to a morphism of arrows. -/ @[simps] def map_augmented_cech_nerve {f g : arrow C} - [∀ n : ℕ, has_wide_pullback f.right (λ i : ulift (fin (n+1)), f.left) (λ i, f.hom)] - [∀ n : ℕ, has_wide_pullback g.right (λ i : ulift (fin (n+1)), g.left) (λ i, g.hom)] + [∀ n : ℕ, has_wide_pullback f.right (λ i : fin (n+1), f.left) (λ i, f.hom)] + [∀ n : ℕ, has_wide_pullback g.right (λ i : fin (n+1), g.left) (λ i, g.hom)] (F : f ⟶ g) : f.augmented_cech_nerve ⟶ g.augmented_cech_nerve := { left := map_cech_nerve F, right := F.right, @@ -83,7 +91,7 @@ namespace category_theory namespace simplicial_object variables [∀ (n : ℕ) (f : arrow C), - has_wide_pullback f.right (λ i : ulift (fin (n+1)), f.left) (λ i, f.hom)] + has_wide_pullback f.right (λ i : fin (n+1), f.left) (λ i, f.hom)] /-- The Čech nerve construction, as a functor from `arrow C`. -/ @[simps] @@ -105,7 +113,7 @@ def augmented_cech_nerve : arrow C ⥤ simplicial_object.augmented C := @[simps] def equivalence_right_to_left (X : simplicial_object.augmented C) (F : arrow C) (G : X ⟶ F.augmented_cech_nerve) : augmented.to_arrow.obj X ⟶ F := -{ left := G.left.app _ ≫ wide_pullback.π (λ i, F.hom) ⟨0⟩, +{ left := G.left.app _ ≫ wide_pullback.π (λ i, F.hom) 0, right := G.right, w' := begin have := G.w, @@ -119,10 +127,10 @@ def equivalence_left_to_right (X : simplicial_object.augmented C) (F : arrow C) (G : augmented.to_arrow.obj X ⟶ F) : X ⟶ F.augmented_cech_nerve := { left := { app := λ x, limits.wide_pullback.lift (X.hom.app _ ≫ G.right) - (λ i, X.left.map (simplex_category.const x.unop i.down).op ≫ G.left) + (λ i, X.left.map (simplex_category.const x.unop i).op ≫ G.left) (λ i, by { dsimp, erw [category.assoc, arrow.w, augmented.to_arrow_obj_hom, nat_trans.naturality_assoc, - functor.const.obj_map, category.id_comp] } ), + functor.const_obj_map, category.id_comp] } ), naturality' := begin intros x y f, ext, @@ -131,7 +139,7 @@ def equivalence_left_to_right (X : simplicial_object.augmented C) (F : arrow C) rw [← category.assoc, ← X.left.map_comp], refl }, { dsimp, - simp only [functor.const.obj_map, nat_trans.naturality_assoc, + simp only [functor.const_obj_map, nat_trans.naturality_assoc, wide_pullback.lift_base, category.assoc], erw category.id_comp } end }, @@ -192,15 +200,15 @@ end category_theory namespace category_theory.arrow variables (f : arrow C) -variables [∀ n : ℕ, has_wide_pushout f.left (λ i : ulift (fin (n+1)), f.right) (λ i, f.hom)] +variables [∀ n : ℕ, has_wide_pushout f.left (λ i : fin (n+1), f.right) (λ i, f.hom)] /-- The Čech conerve associated to an arrow. -/ @[simps] def cech_conerve : cosimplicial_object C := { obj := λ n, wide_pushout f.left - (λ i : ulift (fin (n.len + 1)), f.right) (λ i, f.hom), + (λ i : fin (n.len + 1), f.right) (λ i, f.hom), map := λ m n g, wide_pushout.desc (wide_pushout.head _) - (λ i, wide_pushout.ι (λ i, f.hom) $ ulift.up $ g.to_order_hom i.down) $ + (λ i, wide_pushout.ι (λ i, f.hom) $ g.to_order_hom i) $ λ i, by { rw [wide_pushout.arrow_ι (λ i, f.hom)] }, map_id' := λ x, by { ext ⟨⟩, { simpa }, { simp } }, map_comp' := λ x y z f g, by { ext ⟨⟩, { simpa }, { simp } } } @@ -208,8 +216,8 @@ def cech_conerve : cosimplicial_object C := /-- The morphism between Čech conerves associated to a morphism of arrows. -/ @[simps] def map_cech_conerve {f g : arrow C} - [∀ n : ℕ, has_wide_pushout f.left (λ i : ulift (fin (n+1)), f.right) (λ i, f.hom)] - [∀ n : ℕ, has_wide_pushout g.left (λ i : ulift (fin (n+1)), g.right) (λ i, g.hom)] + [∀ n : ℕ, has_wide_pushout f.left (λ i : fin (n+1), f.right) (λ i, f.hom)] + [∀ n : ℕ, has_wide_pushout g.left (λ i : fin (n+1), g.right) (λ i, g.hom)] (F : f ⟶ g) : f.cech_conerve ⟶ g.cech_conerve := { app := λ n, wide_pushout.desc (F.left ≫ wide_pushout.head _) (λ i, F.right ≫ wide_pushout.ι _ i) $ @@ -228,8 +236,8 @@ def augmented_cech_conerve : cosimplicial_object.augmented C := /-- The morphism between augmented Čech conerves associated to a morphism of arrows. -/ @[simps] def map_augmented_cech_conerve {f g : arrow C} - [∀ n : ℕ, has_wide_pushout f.left (λ i : ulift (fin (n+1)), f.right) (λ i, f.hom)] - [∀ n : ℕ, has_wide_pushout g.left (λ i : ulift (fin (n+1)), g.right) (λ i, g.hom)] + [∀ n : ℕ, has_wide_pushout f.left (λ i : fin (n+1), f.right) (λ i, f.hom)] + [∀ n : ℕ, has_wide_pushout g.left (λ i : fin (n+1), g.right) (λ i, g.hom)] (F : f ⟶ g) : f.augmented_cech_conerve ⟶ g.augmented_cech_conerve := { left := F.left, right := map_cech_conerve F, @@ -241,7 +249,7 @@ namespace category_theory namespace cosimplicial_object variables [∀ (n : ℕ) (f : arrow C), - has_wide_pushout f.left (λ i : ulift (fin (n+1)), f.right) (λ i, f.hom)] + has_wide_pushout f.left (λ i : fin (n+1), f.right) (λ i, f.hom)] /-- The Čech conerve construction, as a functor from `arrow C`. -/ @[simps] @@ -265,7 +273,7 @@ def equivalence_left_to_right (F : arrow C) (X : cosimplicial_object.augmented C (G : F.augmented_cech_conerve ⟶ X) : F ⟶ augmented.to_arrow.obj X := { left := G.left, right := - (wide_pushout.ι (λ i, F.hom) (_root_.ulift.up 0) ≫ G.right.app (simplex_category.mk 0) : _), + (wide_pushout.ι (λ i, F.hom) 0 ≫ G.right.app (simplex_category.mk 0) : _), w' := begin have := G.w, apply_fun (λ e, e.app (simplex_category.mk 0)) at this, @@ -279,9 +287,9 @@ def equivalence_right_to_left (F : arrow C) (X : cosimplicial_object.augmented C (G : F ⟶ augmented.to_arrow.obj X) : F.augmented_cech_conerve ⟶ X := { left := G.left, right := { app := λ x, limits.wide_pushout.desc (G.left ≫ X.hom.app _) - (λ i, G.right ≫ X.right.map (simplex_category.const x i.down)) + (λ i, G.right ≫ X.right.map (simplex_category.const x i)) begin - rintros ⟨j⟩, + rintros j, rw ← arrow.w_assoc G, have t := X.hom.naturality (x.const j), dsimp at t ⊢, @@ -296,7 +304,7 @@ def equivalence_right_to_left (F : arrow C) (X : cosimplicial_object.augmented C rw [category.assoc, ←X.right.map_comp], refl }, { dsimp, - simp only [functor.const.obj_map, ←nat_trans.naturality, + simp only [functor.const_obj_map, ←nat_trans.naturality, wide_pushout.head_desc_assoc, wide_pushout.head_desc, category.assoc], erw category.id_comp } end }, @@ -348,4 +356,84 @@ adjunction.mk_of_hom_equiv end cosimplicial_object +/-- Given an object `X : C`, the natural simplicial object sending `[n]` to `Xⁿ⁺¹`. -/ +def cech_nerve_terminal_from {C : Type u} [category.{v} C] [has_finite_products C] (X : C) : + simplicial_object C := +{ obj := λ n, ∏ (λ i : fin (n.unop.len + 1), X), + map := λ m n f, limits.pi.lift (λ i, limits.pi.π _ (f.unop.to_order_hom i)), + map_id' := λ f, limit.hom_ext $ λ j, by discrete_cases; + simpa only [limit.lift_π, category.id_comp], + map_comp' := λ m n o f g, limit.hom_ext $ λ j, by discrete_cases; + simpa only [category.assoc, limit.lift_π, fan.mk_π_app] } + +namespace cech_nerve_terminal_from + +variables [has_terminal C] (ι : Type w) + +/-- The diagram `option ι ⥤ C` sending `none` to the terminal object and `some j` to `X`. -/ +def wide_cospan (X : C) : wide_pullback_shape ι ⥤ C := +wide_pullback_shape.wide_cospan (terminal C) (λ i : ι, X) (λ i, terminal.from X) + +instance unique_to_wide_cospan_none (X Y : C) : unique (Y ⟶ (wide_cospan ι X).obj none) := +by unfold wide_cospan; dsimp; apply_instance + +variables [has_finite_products C] + +/-- The product `Xᶥ` is the vertex of a limit cone on `wide_cospan ι X`. -/ +def wide_cospan.limit_cone [fintype ι] (X : C) : limit_cone (wide_cospan ι X) := +{ cone := + { X := ∏ (λ i : ι, X), + π := + { app := λ X, option.cases_on X (terminal.from _) (λ i, limit.π _ ⟨i⟩), + naturality' := λ i j f, + begin + cases f, + { cases i, + all_goals { dsimp, simp }}, + { dsimp, + simp only [terminal.comp_from], + exact subsingleton.elim _ _ } + end } }, + is_limit := + { lift := λ s, limits.pi.lift (λ j, s.π.app (some j)), + fac' := λ s j, option.cases_on j (subsingleton.elim _ _) (λ j, limit.lift_π _ _), + uniq' := λ s f h, + begin + ext j, + dunfold limits.pi.lift, + rw limit.lift_π, + dsimp, + rw ←h (some j.as), + congr, + ext, + refl, + end } } + +instance has_wide_pullback [finite ι] (X : C) : + has_wide_pullback (arrow.mk (terminal.from X)).right + (λ i : ι, (arrow.mk (terminal.from X)).left) (λ i, (arrow.mk (terminal.from X)).hom) := +begin + casesI nonempty_fintype ι, + exact ⟨⟨wide_cospan.limit_cone ι X⟩⟩, +end + +/-- Given an object `X : C`, the Čech nerve of the hom to the terminal object `X ⟶ ⊤_ C` is +naturally isomorphic to a simplicial object sending `[n]` to `Xⁿ⁺¹` (when `C` is `G-Set`, this is +`EG`, the universal cover of the classifying space of `G`. -/ +def iso (X : C) : + (arrow.mk (terminal.from X)).cech_nerve ≅ cech_nerve_terminal_from X := +iso.symm (nat_iso.of_components (λ m, ((limit.is_limit _).cone_point_unique_up_to_iso + (wide_cospan.limit_cone (fin (m.unop.len + 1)) X).2).symm) $ λ m n f, wide_pullback.hom_ext _ _ _ +(begin + intro j, + simp only [category.assoc], + dunfold cech_nerve_terminal_from wide_pullback.π pi.lift, + erw [wide_pullback.lift_π, limit.cone_point_unique_up_to_iso_inv_comp + (wide_cospan.limit_cone _ _).2, (limit.is_limit _).cone_point_unique_up_to_iso_inv_comp + (wide_cospan.limit_cone _ _).2, limit.lift_π], + refl, +end) +(@subsingleton.elim _ (@unique.subsingleton _ (limits.unique_to_terminal _)) _ _)) + +end cech_nerve_terminal_from end category_theory diff --git a/src/algebraic_topology/dold_kan/compatibility.lean b/src/algebraic_topology/dold_kan/compatibility.lean new file mode 100644 index 0000000000000..516e38ecaf374 --- /dev/null +++ b/src/algebraic_topology/dold_kan/compatibility.lean @@ -0,0 +1,301 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.equivalence + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Tools for compatibilities between Dold-Kan equivalences + +The purpose of this file is to introduce tools which will enable the +construction of the Dold-Kan equivalence `simplicial_object C ≌ chain_complex C ℕ` +for a pseudoabelian category `C` from the equivalence +`karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ)` and the two +equivalences `simplicial_object C ≅ karoubi (simplicial_object C)` and +`chain_complex C ℕ ≅ karoubi (chain_complex C ℕ)`. + +It is certainly possible to get an equivalence `simplicial_object C ≌ chain_complex C ℕ` +using a compositions of the three equivalences above, but then neither the functor +nor the inverse would have good definitional properties. For example, it would be better +if the inverse functor of the equivalence was exactly the functor +`Γ₀ : simplicial_object C ⥤ chain_complex C ℕ` which was constructed in `functor_gamma.lean`. + +In this file, given four categories `A`, `A'`, `B`, `B'`, equivalences `eA : A ≅ A'`, +`eB : B ≅ B'`, `e' : A' ≅ B'`, functors `F : A ⥤ B'`, `G : B ⥤ A` equipped with certain +compatibilities, we construct successive equivalences: +- `equivalence₀` from `A` to `B'`, which is the composition of `eA` and `e'`. +- `equivalence₁` from `A` to `B'`, with the same inverse functor as `equivalence₀`, +but whose functor is `F`. +- `equivalence₂` from `A` to `B`, which is the composition of `equivalence₁` and the +inverse of `eB`: +- `equivalence` from `A` to `B`, which has the same functor `F ⋙ eB.inverse` as `equivalence₂`, +but whose inverse functor is `G`. + +When extra assumptions are given, we shall also provide simplification lemmas for the +unit and counit isomorphisms of `equivalence`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory category_theory.category + +namespace algebraic_topology + +namespace dold_kan + +namespace compatibility + +variables {A A' B B' : Type*} [category A] [category A'] [category B] [category B'] + (eA : A ≌ A') (eB : B ≌ B') (e' : A' ≌ B') + {F : A ⥤ B'} (hF : eA.functor ⋙ e'.functor ≅ F) + {G : B ⥤ A} (hG : eB.functor ⋙ e'.inverse ≅ G ⋙ eA.functor) + +/-- A basic equivalence `A ≅ B'` obtained by composing `eA : A ≅ A'` and `e' : A' ≅ B'`. -/ +@[simps functor inverse unit_iso_hom_app] +def equivalence₀ : A ≌ B' := eA.trans e' + +include hF +variables {eA} {e'} + +/-- An intermediate equivalence `A ≅ B'` whose functor is `F` and whose inverse is +`e'.inverse ⋙ eA.inverse`. -/ +@[simps functor] +def equivalence₁ : A ≌ B' := +begin + letI : is_equivalence F := + is_equivalence.of_iso hF (is_equivalence.of_equivalence (equivalence₀ eA e')), + exact F.as_equivalence, +end + +lemma equivalence₁_inverse : (equivalence₁ hF).inverse = e'.inverse ⋙ eA.inverse := rfl + +/-- The counit isomorphism of the equivalence `equivalence₁` between `A` and `B'`. -/ +@[simps] +def equivalence₁_counit_iso : + (e'.inverse ⋙ eA.inverse) ⋙ F ≅ 𝟭 B' := +calc (e'.inverse ⋙ eA.inverse) ⋙ F + ≅ (e'.inverse ⋙ eA.inverse) ⋙ (eA.functor ⋙ e'.functor) : iso_whisker_left _ hF.symm +... ≅ e'.inverse ⋙ (eA.inverse ⋙ eA.functor) ⋙ e'.functor : iso.refl _ +... ≅ e'.inverse ⋙ 𝟭 _ ⋙ e'.functor : iso_whisker_left _ (iso_whisker_right eA.counit_iso _) +... ≅ e'.inverse ⋙ e'.functor : iso.refl _ +... ≅ 𝟭 B' : e'.counit_iso + +lemma equivalence₁_counit_iso_eq : (equivalence₁ hF).counit_iso = equivalence₁_counit_iso hF := +begin + ext Y, + dsimp [equivalence₀, equivalence₁, is_equivalence.inverse, is_equivalence.of_equivalence], + simp only [equivalence₁_counit_iso_hom_app, category_theory.functor.map_id, comp_id], +end + +/-- The unit isomorphism of the equivalence `equivalence₁` between `A` and `B'`. -/ +@[simps] +def equivalence₁_unit_iso : + 𝟭 A ≅ F ⋙ (e'.inverse ⋙ eA.inverse) := +calc 𝟭 A ≅ eA.functor ⋙ eA.inverse : eA.unit_iso +... ≅ eA.functor ⋙ 𝟭 A' ⋙ eA.inverse : iso.refl _ +... ≅ eA.functor ⋙ (e'.functor ⋙ e'.inverse) ⋙ eA.inverse : + iso_whisker_left _ (iso_whisker_right e'.unit_iso _) +... ≅ (eA.functor ⋙ e'.functor) ⋙ (e'.inverse ⋙ eA.inverse) : iso.refl _ +... ≅ F ⋙ (e'.inverse ⋙ eA.inverse) : iso_whisker_right hF _ + +lemma equivalence₁_unit_iso_eq : (equivalence₁ hF).unit_iso = equivalence₁_unit_iso hF := +begin + ext X, + dsimp [equivalence₀, equivalence₁, nat_iso.hcomp, + is_equivalence.of_equivalence], + simp only [id_comp, assoc, equivalence₁_unit_iso_hom_app], +end + +include eB + +/-- An intermediate equivalence `A ≅ B` obtained as the composition of `equivalence₁` and +the inverse of `eB : B ≌ B'`. -/ +@[simps functor] +def equivalence₂ : A ≌ B := (equivalence₁ hF).trans eB.symm + +lemma equivalence₂_inverse : (equivalence₂ eB hF).inverse = + eB.functor ⋙ e'.inverse ⋙ eA.inverse := rfl + +/-- The counit isomorphism of the equivalence `equivalence₂` between `A` and `B`. -/ +@[simps] +def equivalence₂_counit_iso : + (eB.functor ⋙ e'.inverse ⋙ eA.inverse) ⋙ (F ⋙ eB.inverse) ≅ 𝟭 B := +calc (eB.functor ⋙ e'.inverse ⋙ eA.inverse) ⋙ (F ⋙ eB.inverse) + ≅ eB.functor ⋙ (e'.inverse ⋙ eA.inverse ⋙ F) ⋙ eB.inverse : iso.refl _ +... ≅ eB.functor ⋙ 𝟭 _ ⋙ eB.inverse : + iso_whisker_left _ (iso_whisker_right (equivalence₁_counit_iso hF) _) +... ≅ eB.functor ⋙ eB.inverse : iso.refl _ +... ≅ 𝟭 B : eB.unit_iso.symm + +lemma equivalence₂_counit_iso_eq : + (equivalence₂ eB hF).counit_iso = equivalence₂_counit_iso eB hF := +begin + ext Y', + dsimp [equivalence₂, iso.refl], + simp only [equivalence₁_counit_iso_eq, equivalence₂_counit_iso_hom_app, + equivalence₁_counit_iso_hom_app, functor.map_comp, assoc], +end + +/-- The unit isomorphism of the equivalence `equivalence₂` between `A` and `B`. -/ +@[simps] +def equivalence₂_unit_iso : + 𝟭 A ≅ (F ⋙ eB.inverse) ⋙ (eB.functor ⋙ e'.inverse ⋙ eA.inverse) := +calc 𝟭 A ≅ F ⋙ e'.inverse ⋙ eA.inverse : equivalence₁_unit_iso hF +... ≅ F ⋙ 𝟭 B' ⋙ (e'.inverse ⋙ eA.inverse) : iso.refl _ +... ≅ F ⋙ (eB.inverse ⋙ eB.functor) ⋙ e'.inverse ⋙ eA.inverse : + iso_whisker_left _ (iso_whisker_right eB.counit_iso.symm _) +... ≅ (F ⋙ eB.inverse) ⋙ (eB.functor ⋙ e'.inverse ⋙ eA.inverse) : iso.refl _ + +lemma equivalence₂_unit_iso_eq : + (equivalence₂ eB hF).unit_iso = equivalence₂_unit_iso eB hF := +begin + ext X, + dsimp [equivalence₂], + simpa only [equivalence₂_unit_iso_hom_app, equivalence₁_unit_iso_eq, + equivalence₁_unit_iso_hom_app, assoc, nat_iso.cancel_nat_iso_hom_left], +end + +variable {eB} +include hG + +/-- The equivalence `A ≅ B` whose functor is `F ⋙ eB.inverse` and +whose inverse is `G : B ≅ A`. -/ +@[simps inverse] +def equivalence : A ≌ B := +begin + letI : is_equivalence G := begin + refine is_equivalence.of_iso _ (is_equivalence.of_equivalence (equivalence₂ eB hF).symm), + calc eB.functor ⋙ e'.inverse ⋙ eA.inverse + ≅ (eB.functor ⋙ e'.inverse) ⋙ eA.inverse : iso.refl _ + ... ≅ (G ⋙ eA.functor) ⋙ eA.inverse : iso_whisker_right hG _ + ... ≅ G ⋙ 𝟭 A : iso_whisker_left _ eA.unit_iso.symm + ... ≅ G : functor.right_unitor G, + end, + exact G.as_equivalence.symm, +end + +lemma equivalence_functor : (equivalence hF hG).functor = F ⋙ eB.inverse := rfl + +omit hG hF + +/-- The isomorphism `eB.functor ⋙ e'.inverse ⋙ e'.functor ≅ eB.functor` deduced +from the counit isomorphism of `e'`. -/ +@[simps hom_app] +def τ₀ : eB.functor ⋙ e'.inverse ⋙ e'.functor ≅ eB.functor := +calc eB.functor ⋙ e'.inverse ⋙ e'.functor + ≅ eB.functor ⋙ 𝟭 _ : iso_whisker_left _ e'.counit_iso +... ≅ eB.functor : functor.right_unitor _ + +include hF hG + +/-- The isomorphism `eB.functor ⋙ e'.inverse ⋙ e'.functor ≅ eB.functor` deduced +from the isomorphisms `hF : eA.functor ⋙ e'.functor ≅ F`, +`hG : eB.functor ⋙ e'.inverse ≅ G ⋙ eA.functor` and the datum of +an isomorphism `η : G ⋙ F ≅ eB.functor`. -/ +@[simps hom_app] +def τ₁ (η : G ⋙ F ≅ eB.functor) : + eB.functor ⋙ e'.inverse ⋙ e'.functor ≅ eB.functor := +calc eB.functor ⋙ e'.inverse ⋙ e'.functor + ≅ (eB.functor ⋙ e'.inverse) ⋙ e'.functor : iso.refl _ +... ≅ (G ⋙ eA.functor) ⋙ e'.functor : iso_whisker_right hG _ +... ≅ G ⋙ (eA.functor ⋙ e'.functor) : by refl +... ≅ G ⋙ F : iso_whisker_left _ hF +... ≅ eB.functor : η + +variables (η : G ⋙ F ≅ eB.functor) (hη : τ₀ = τ₁ hF hG η) + +omit hF hG +include η + +/-- The counit isomorphism of `equivalence`. -/ +@[simps] +def equivalence_counit_iso : G ⋙ (F ⋙ eB.inverse) ≅ 𝟭 B := +calc G ⋙ (F ⋙ eB.inverse) ≅ (G ⋙ F) ⋙ eB.inverse : iso.refl _ +... ≅ eB.functor ⋙ eB.inverse : iso_whisker_right η _ +... ≅ 𝟭 B : eB.unit_iso.symm + +variables {η hF hG} +include hη + +lemma equivalence_counit_iso_eq : + (equivalence hF hG).counit_iso = equivalence_counit_iso η := +begin + ext1, apply nat_trans.ext, ext Y, + dsimp [equivalence, equivalence_counit_iso, is_equivalence.of_equivalence], + simp only [equivalence₂_counit_iso_eq eB hF], + erw [nat_trans.id_app, nat_trans.id_app], + dsimp [equivalence₂, equivalence₁], + simp only [assoc, comp_id, F.map_id, id_comp, + equivalence₂_counit_iso_hom_app, ← eB.inverse.map_comp_assoc, + ← τ₀_hom_app, hη, τ₁_hom_app], + erw hF.inv.naturality_assoc, + congr' 2, + dsimp, + simp only [assoc, ← e'.functor.map_comp_assoc, eA.functor.map_comp, + equivalence.fun_inv_map, iso.inv_hom_id_app_assoc, hG.inv_hom_id_app], + dsimp, + rw [comp_id, eA.functor_unit_iso_comp, e'.functor.map_id, id_comp, hF.inv_hom_id_app_assoc], +end + +omit hη η eB +include hF + +variable (hF) + +/-- The isomorphism `eA.functor ≅ F ⋙ e'.inverse` deduced from the +unit isomorphism of `e'` and the isomorphism `hF : eA.functor ⋙ e'.functor ≅ F`. -/ +@[simps] +def υ : eA.functor ≅ F ⋙ e'.inverse := +calc eA.functor ≅ eA.functor ⋙ 𝟭 A' : (functor.left_unitor _).symm +... ≅ eA.functor ⋙ (e'.functor ⋙ e'.inverse) : iso_whisker_left _ e'.unit_iso +... ≅ (eA.functor ⋙ e'.functor) ⋙ e'.inverse : iso.refl _ +... ≅ F ⋙ e'.inverse : iso_whisker_right hF _ + +variables (ε : eA.functor ≅ F ⋙ e'.inverse) (hε : υ hF = ε) + +include ε hG +omit hF + +variable (hG) + +/-- The unit isomorphism of `equivalence`. -/ +@[simps] +def equivalence_unit_iso : 𝟭 A ≅ (F ⋙ eB.inverse) ⋙ G := +calc 𝟭 A ≅ eA.functor ⋙ eA.inverse : eA.unit_iso +... ≅ (F ⋙ e'.inverse) ⋙ eA.inverse : iso_whisker_right ε _ +... ≅ F ⋙ 𝟭 B' ⋙ e'.inverse ⋙ eA.inverse : iso.refl _ +... ≅ F ⋙ (eB.inverse ⋙ eB.functor) ⋙ (e'.inverse ⋙ eA.inverse) : + iso_whisker_left _ (iso_whisker_right eB.counit_iso.symm _) +... ≅ (F ⋙ eB.inverse) ⋙ (eB.functor ⋙ e'.inverse) ⋙ eA.inverse : iso.refl _ +... ≅ (F ⋙ eB.inverse) ⋙ (G ⋙ eA.functor) ⋙ eA.inverse : + iso_whisker_left _ (iso_whisker_right hG _) +... ≅ (F ⋙ eB.inverse ⋙ G) ⋙ (eA.functor ⋙ eA.inverse) : iso.refl _ +... ≅ (F ⋙ eB.inverse ⋙ G) ⋙ 𝟭 A : iso_whisker_left _ eA.unit_iso.symm +... ≅ (F ⋙ eB.inverse) ⋙ G : iso.refl _ + +include hε +variables {ε hF hG} + +lemma equivalence_unit_iso_eq : + (equivalence hF hG).unit_iso = equivalence_unit_iso hG ε := +begin + ext1, apply nat_trans.ext, ext X, + dsimp [equivalence, iso.refl, nat_iso.hcomp, is_equivalence.inverse, + is_equivalence.of_equivalence], + erw [nat_trans.id_app, id_comp, G.map_id, comp_id, comp_id], + simp only [equivalence₂_unit_iso_eq eB hF, equivalence₂_unit_iso_hom_app], + dsimp [equivalence₂, equivalence₁], + simp only [assoc, equivalence_unit_iso_hom_app, nat_iso.cancel_nat_iso_hom_left, + ← eA.inverse.map_comp_assoc, ← hε, υ_hom_app], +end + +end compatibility + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/decomposition.lean b/src/algebraic_topology/dold_kan/decomposition.lean new file mode 100644 index 0000000000000..f1cbbb85fd8b7 --- /dev/null +++ b/src/algebraic_topology/dold_kan/decomposition.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.p_infty + +/-! + +# Decomposition of the Q endomorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we obtain a lemma `decomposition_Q` which expresses +explicitly the projection `(Q q).f (n+1) : X _[n+1] ⟶ X _[n+1]` +(`X : simplicial_object C` with `C` a preadditive category) as +a sum of terms which are postcompositions with degeneracies. + +(TODO @joelriou: when `C` is abelian, define the degenerate +subcomplex of the alternating face map complex of `X` and show +that it is a complement to the normalized Moore complex.) + +Then, we introduce an ad hoc structure `morph_components X n Z` which +can be used in order to define morphisms `X _[n+1] ⟶ Z` using the +decomposition provided by `decomposition_Q`. This shall play a critical +role in the proof that the functor +`N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ))` +reflects isomorphisms. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory category_theory.category category_theory.preadditive opposite +open_locale big_operators simplicial + +noncomputable theory + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] {X X' : simplicial_object C} + +/-- In each positive degree, this lemma decomposes the idempotent endomorphism +`Q q` as a sum of morphisms which are postcompositions with suitable degeneracies. +As `Q q` is the complement projection to `P q`, this implies that in the case of +simplicial abelian groups, any $(n+1)$-simplex $x$ can be decomposed as +$x = x' + \sum (i=0}^{q-1} σ_{n-i}(y_i)$ where $x'$ is in the image of `P q` and +the $y_i$ are in degree $n$. -/ +lemma decomposition_Q (n q : ℕ) : + ((Q q).f (n+1) : X _[n+1] ⟶ X _[n+1]) = + ∑ (i : fin (n+1)) in finset.filter (λ i : fin(n+1), (i:ℕ) THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For any `X : simplicial_object C` where `C` is an abelian category, +the projector `P_infty : K[X] ⟶ K[X]` is supposed to be the projection +on the normalized subcomplex, parallel to the degenerate subcomplex, i.e. +the subcomplex generated by the images of all `X.σ i`. + +In this file, we obtain `degeneracy_comp_P_infty` which states that +if `X : simplicial_object C` with `C` a preadditive category, +`θ : [n] ⟶ Δ'` is a non injective map in `simplex_category`, then +`X.map θ.op ≫ P_infty.f n = 0`. It follows from the more precise +statement vanishing statement `σ_comp_P_eq_zero` for the `P q`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory category_theory.category category_theory.limits + category_theory.preadditive opposite +open_locale simplicial dold_kan + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] + +lemma higher_faces_vanish.comp_σ {Y : C} {X : simplicial_object C} {n b q : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish q φ) (hnbq : n + 1 = b + q) : + higher_faces_vanish q (φ ≫ X.σ ⟨b, + by simpa only [hnbq, nat.lt_succ_iff, le_add_iff_nonneg_right] using zero_le q⟩) := +λ j hj, begin + rw [assoc, simplicial_object.δ_comp_σ_of_gt', fin.pred_succ, + v.comp_δ_eq_zero_assoc _ _ hj, zero_comp], + { intro hj', + simpa only [hj', hnbq, fin.coe_zero, zero_add, add_comm b, add_assoc, false_and, + add_le_iff_nonpos_right, le_zero_iff, add_eq_zero_iff, nat.one_ne_zero] using hj, }, + { simp only [fin.lt_iff_coe_lt_coe, nat.lt_iff_add_one_le, + fin.succ_mk, fin.coe_mk, fin.coe_succ, add_le_add_iff_right], + linarith, }, +end + +lemma σ_comp_P_eq_zero (X : simplicial_object C) + {n q : ℕ} (i : fin (n + 1)) (hi : n + 1 ≤ i + q) : (X.σ i) ≫ (P q).f (n + 1) = 0 := +begin + induction q with q hq generalizing i hi, + { exfalso, + have h := fin.is_lt i, + linarith, }, + { by_cases n+1 ≤ (i : ℕ) + q, + { unfold P, + simp only [homological_complex.comp_f, ← assoc], + rw [hq i h, zero_comp], }, + { have hi' : n = (i : ℕ) + q, + { cases le_iff_exists_add.mp hi with j hj, + rw [← nat.lt_succ_iff, nat.succ_eq_add_one, add_assoc, hj, not_lt, + add_le_iff_nonpos_right, nonpos_iff_eq_zero] at h, + rw [← add_left_inj 1, add_assoc, hj, self_eq_add_right, h], }, + cases n, + { fin_cases i, + rw [show q = 0, by linarith], + unfold P, + simp only [id_comp, homological_complex.add_f_apply, comp_add, homological_complex.id_f, + Hσ, homotopy.null_homotopic_map'_f (c_mk 2 1 rfl) (c_mk 1 0 rfl), + alternating_face_map_complex.obj_d_eq], + erw [hσ'_eq' (zero_add 0).symm, hσ'_eq' (add_zero 1).symm, comp_id, + fin.sum_univ_two, fin.sum_univ_succ, fin.sum_univ_two], + simp only [pow_zero, pow_one, pow_two, fin.coe_zero, fin.coe_one, fin.coe_two, + one_zsmul, neg_zsmul, fin.mk_zero, fin.mk_one, fin.coe_succ, pow_add, one_mul, + neg_mul, neg_neg, fin.succ_zero_eq_one, fin.succ_one_eq_two, comp_neg, neg_comp, + add_comp, comp_add], + erw [simplicial_object.δ_comp_σ_self, simplicial_object.δ_comp_σ_self_assoc, + simplicial_object.δ_comp_σ_succ, comp_id, simplicial_object.δ_comp_σ_of_le X + (show (0 : fin(2)) ≤ fin.cast_succ 0, by rw fin.cast_succ_zero), + simplicial_object.δ_comp_σ_self_assoc, simplicial_object.δ_comp_σ_succ_assoc], + abel, }, + { rw [← id_comp (X.σ i), ← (P_add_Q_f q n.succ : _ = 𝟙 (X.obj _)), add_comp, add_comp], + have v : higher_faces_vanish q ((P q).f n.succ ≫ X.σ i) := + (higher_faces_vanish.of_P q n).comp_σ hi', + unfold P, + erw [← assoc, v.comp_P_eq_self, homological_complex.add_f_apply, + preadditive.comp_add, comp_id, v.comp_Hσ_eq hi', assoc, + simplicial_object.δ_comp_σ_succ'_assoc, fin.eta, + decomposition_Q n q, sum_comp, sum_comp, finset.sum_eq_zero, add_zero, + add_neg_eq_zero], swap, + { ext, simp only [fin.coe_mk, fin.coe_succ], }, + { intros j hj, + simp only [true_and, finset.mem_univ, finset.mem_filter] at hj, + simp only [nat.succ_eq_add_one] at hi', + obtain ⟨k, hk⟩ := nat.le.dest (nat.lt_succ_iff.mp (fin.is_lt j)), + rw add_comm at hk, + have hi'' : i = fin.cast_succ ⟨i, by linarith⟩ := + by { ext, simp only [fin.cast_succ_mk, fin.eta], }, + have eq := hq j.rev.succ begin + simp only [← hk, fin.rev_eq j hk.symm, nat.succ_eq_add_one, fin.succ_mk, fin.coe_mk], + linarith, + end, + rw [homological_complex.comp_f, assoc, assoc, assoc, hi'', + simplicial_object.σ_comp_σ_assoc, reassoc_of eq, zero_comp, comp_zero, + comp_zero, comp_zero], + simp only [fin.rev_eq j hk.symm, fin.le_iff_coe_le_coe, fin.coe_mk], + linarith, }, }, }, } +end + +@[simp, reassoc] +lemma σ_comp_P_infty (X : simplicial_object C) {n : ℕ} (i : fin (n+1)) : + (X.σ i) ≫ P_infty.f (n+1) = 0 := +begin + rw [P_infty_f, σ_comp_P_eq_zero X i], + simp only [le_add_iff_nonneg_left, zero_le], +end + +@[reassoc] +lemma degeneracy_comp_P_infty (X : simplicial_object C) + (n : ℕ) {Δ' : simplex_category} (θ : [n] ⟶ Δ') (hθ : ¬mono θ) : + X.map θ.op ≫ P_infty.f n = 0 := +begin + rw simplex_category.mono_iff_injective at hθ, + cases n, + { exfalso, + apply hθ, + intros x y h, + fin_cases x, + fin_cases y, }, + { obtain ⟨i, α, h⟩ := simplex_category.eq_σ_comp_of_not_injective θ hθ, + rw [h, op_comp, X.map_comp, assoc, (show X.map (simplex_category.σ i).op = X.σ i, by refl), + σ_comp_P_infty, comp_zero], }, +end + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/equivalence.lean b/src/algebraic_topology/dold_kan/equivalence.lean new file mode 100644 index 0000000000000..dc025a7938b2b --- /dev/null +++ b/src/algebraic_topology/dold_kan/equivalence.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.equivalence_pseudoabelian +import algebraic_topology.dold_kan.normalized + +/-! + +# The Dold-Kan correspondence + +The Dold-Kan correspondence states that for any abelian category `A`, there is +an equivalence between the category of simplicial objects in `A` and the +category of chain complexes in `A` (with degrees indexed by `ℕ` and the +homological convention that the degree is decreased by the differentials). + +In this file, we finish the construction of this equivalence by providing +`category_theory.abelian.dold_kan.equivalence` which is of type +`simplicial_object A ≌ chain_complex A ℕ` for any abelian category `A`. +The functor `simplicial_object A ⥤ chain_complex A ℕ` of this equivalence is +definitionally equal to `normalized_Moore_complex A`. + +## Overall strategy of the proof of the correspondence + +Before starting the implementation of the proof in Lean, the author noticed +that the Dold-Kan equivalence not only applies to abelian categories, but +should also hold generally for any pseudoabelian category `C` +(i.e. a category with instances `[preadditive C]` +`[has_finite_coproducts C]` and `[is_idempotent_complete C]`): this is +`category_theory.idempotents.dold_kan.equivalence`. + +When the alternating face map complex `K[X]` of a simplicial object `X` in an +abelian is studied, it is shown that it decomposes as a direct sum of the +normalized subcomplex and of the degenerate subcomplex. The crucial observation +is that in this decomposition, the projection on the normalized subcomplex can +be defined in each degree using simplicial operators. Then, the definition +of this projection `P_infty : K[X] ⟶ K[X]` can be carried out for any +`X : simplicial_object C` when `C` is a preadditive category. + +The construction of the endomorphism `P_infty` is done in the files +`homotopies.lean`, `faces.lean`, `projections.lean` and `p_infty.lean`. +Eventually, as we would also like to show that the inclusion of the normalized +Moore complex is a homotopy equivalence (cf. file `homotopy_equivalence.lean`), +this projection `P_infty` needs to be homotopic to the identity. In our +construction, we get this for free because `P_infty` is obtained by altering +the identity endomorphism by null homotopic maps. More details about this +aspect of the proof are in the file `homotopies.lean`. + +When the alternating face map complex `K[X]` is equipped with the idempotent +endomorphism `P_infty`, it becomes an object in `karoubi (chain_complex C ℕ)` +which is the idempotent completion of the category `chain_complex C ℕ`. In `functor_n.lean`, +we obtain this functor `N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)`, +which is formally extended as +`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)`. (Here, some functors +have an index which is the number of occurrences of `karoubi` at the source or the +target.) + +In `functor_gamma.lean`, assuming that the category `C` is additive, +we define the functor in the other direction +`Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)` as the formal +extension of a functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C` which is +defined similarly as in *Simplicial Homotopy Theory* by Goerss-Jardine. +In `degeneracies.lean`, we show that `P_infty` vanishes on the image of degeneracy +operators, which is one of the key properties that makes it possible to contruct +the isomorphism `N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ))`. + +The rest of the proof follows the strategy in the [original paper by Dold][dold1958]. We show +that the functor `N₂` reflects isomorphisms in `n_reflects_iso.lean`: this relies on a +decomposition of the identity of `X _[n]` using `P_infty.f n` and degeneracies obtained in +`decomposition.lean`. Then, in `n_comp_gamma.lean`, we construct a natural transformation +`Γ₂N₂.trans : N₂ ⋙ Γ₂ ⟶ 𝟭 (karoubi (simplicial_object C))`. It is shown that it is an +isomorphism using the fact that `N₂` reflects isomorphisms, and because we can show +that the composition `N₂ ⟶ N₂ ⋙ Γ₂ ⋙ N₂ ⟶ N₂` is the identity (see `identity_N₂`). The fact +that `N₂` is defined as a formal direct factor makes the proof easier because we only +have to compare endomorphisms of an alternating face map complex `K[X]` and we do not +have to worry with inclusions of kernel subobjects. + +In `equivalence_additive.lean`, we obtain +the equivalence `equivalence : karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ)`. +It is in the namespace `category_theory.preadditive.dold_kan`. The functors in this +equivalence are named `N` and `Γ`: by definition, they are `N₂` and `Γ₂`. + +In `equivalence_pseudoabelian.lean`, assuming `C` is idempotent complete, +we obtain `equivalence : simplicial_object C ≌ chain_complex C ℕ` +in the namespace `category_theory.idempotents.dold_kan`. This could be roughly +obtained by composing the previous equivalence with the equivalences +`simplicial_object C ≌ karoubi (simplicial_object C)` and +`karoubi (chain_complex C ℕ) ≌ chain_complex C ℕ`. Instead, we polish this construction +in `compatibility.lean` by ensuring good definitional properties of the equivalence (e.g. +the inverse functor is definitionallly equal to +`Γ₀' : chain_complex C ℕ ⥤ simplicial_object C`) and +showing compatibilities for the unit and counit isomorphisms. + +In this file `equivalence.lean`, assuming the category `A` is abelian, we obtain +`equivalence : simplicial_object A ≌ chain_complex A ℕ` in the namespace +`category_theory.abelian.dold_kan`. This is obtained by replacing the functor +`category_theory.idempotents.dold_kan.N` of the equivalence in the pseudoabelian case +with the isomorphic functor `normalized_Moore_complex A` thanks to the isomorphism +obtained in `normalized.lean`. + +TODO: Show functoriality properties of the three equivalences above. More precisely, +for example in the case of abelian categories `A` and `B`, if `F : A ⥤ B` is an +additive functor, we can show that the functors `N` for `A` and `B` are compatible +with the functors `simplicial_object A ⥤ simplicial_object B` and +`chain_complex A ℕ ⥤ chain_complex B ℕ` induced by `F`. (Note that this does not +require that `F` is an exact functor!) + +TODO: Introduce the degenerate subcomplex `D[X]` which is generated by +degenerate simplices, show that the projector `P_infty` corresponds to +a decomposition `K[X] ≅ N[X] ⊞ D[X]`. + +TODO: dualise all of this as `cosimplicial_object A ⥤ cochain_complex A ℕ`. (It is unclear +what is the best way to do this. The exact design may be decided when it is needed.) + +## References +* [Albrecht Dold, Homology of Symmetric Products and Other Functors of Complexes][dold1958] +* [Paul G. Goerss, John F. Jardine, Simplicial Homotopy Theory][goerss-jardine-2009] + +-/ + +noncomputable theory + +open category_theory +open category_theory.category +open category_theory.idempotents + +variables {A : Type*} [category A] [abelian A] + +namespace category_theory + +namespace abelian + +namespace dold_kan + +open algebraic_topology.dold_kan + +/-- The functor `N` for the equivalence is `normalized_Moore_complex A` -/ +def N : simplicial_object A ⥤ chain_complex A ℕ := algebraic_topology.normalized_Moore_complex A + +/-- The functor `Γ` for the equivalence is the same as in the pseudoabelian case. -/ +def Γ : chain_complex A ℕ ⥤ simplicial_object A := idempotents.dold_kan.Γ + +/-- The comparison isomorphism between `normalized_Moore_complex A` and +the functor `idempotents.dold_kan.N` from the pseudoabelian case -/ +@[simps] +def comparison_N : (N : simplicial_object A ⥤ _) ≅ idempotents.dold_kan.N := +calc N ≅ N ⋙ 𝟭 _ : functor.left_unitor N +... ≅ N ⋙ ((to_karoubi_equivalence _).functor ⋙ (to_karoubi_equivalence _).inverse) : + iso_whisker_left _ (to_karoubi_equivalence _).unit_iso +... ≅ (N ⋙ (to_karoubi_equivalence _).functor) ⋙ (to_karoubi_equivalence _).inverse : + iso.refl _ +... ≅ N₁ ⋙ (to_karoubi_equivalence _).inverse : iso_whisker_right + (N₁_iso_normalized_Moore_complex_comp_to_karoubi A).symm _ +... ≅ idempotents.dold_kan.N : by refl + +/-- The Dold-Kan equivalence for abelian categories -/ +@[simps functor] +def equivalence : simplicial_object A ≌ chain_complex A ℕ := +begin + let F : simplicial_object A ⥤ _ := idempotents.dold_kan.N, + let hF : is_equivalence F := is_equivalence.of_equivalence idempotents.dold_kan.equivalence, + letI : is_equivalence (N : simplicial_object A ⥤ _ ) := + is_equivalence.of_iso comparison_N.symm hF, + exact N.as_equivalence, +end + +lemma equivalence_inverse : (equivalence : simplicial_object A ≌ _).inverse = Γ := rfl + +end dold_kan + +end abelian + +end category_theory diff --git a/src/algebraic_topology/dold_kan/equivalence_additive.lean b/src/algebraic_topology/dold_kan/equivalence_additive.lean new file mode 100644 index 0000000000000..742196ac2a72b --- /dev/null +++ b/src/algebraic_topology/dold_kan/equivalence_additive.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.n_comp_gamma + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The Dold-Kan equivalence for additive categories. + +This file defines `preadditive.dold_kan.equivalence` which is the equivalence +of categories `karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ)`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits + category_theory.idempotents algebraic_topology.dold_kan + +variables {C : Type*} [category C] [preadditive C] + +namespace category_theory + +namespace preadditive + +namespace dold_kan + +/-- The functor `karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)` of +the Dold-Kan equivalence for additive categories. -/ +@[simps] +def N : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ) := N₂ + +variable [has_finite_coproducts C] + +/-- The inverse functor `karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)` of +the Dold-Kan equivalence for additive categories. -/ +@[simps] +def Γ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C) := Γ₂ + +/-- The Dold-Kan equivalence `karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ)` +for additive categories. -/ +@[simps] +def equivalence : karoubi (simplicial_object C) ≌ karoubi (chain_complex C ℕ) := +{ functor := N, + inverse := Γ, + unit_iso := Γ₂N₂, + counit_iso := N₂Γ₂, + functor_unit_iso_comp' := λ P, begin + let α := N.map_iso (Γ₂N₂.app P), + let β := N₂Γ₂.app (N.obj P), + symmetry, + change 𝟙 _ = α.hom ≫ β.hom, + rw [← iso.inv_comp_eq, comp_id, ← comp_id β.hom, ← iso.inv_comp_eq], + exact algebraic_topology.dold_kan.identity_N₂_objectwise P, + end } + +end dold_kan + +end preadditive + +end category_theory diff --git a/src/algebraic_topology/dold_kan/equivalence_pseudoabelian.lean b/src/algebraic_topology/dold_kan/equivalence_pseudoabelian.lean new file mode 100644 index 0000000000000..4d6fff16434a8 --- /dev/null +++ b/src/algebraic_topology/dold_kan/equivalence_pseudoabelian.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.equivalence_additive +import algebraic_topology.dold_kan.compatibility +import category_theory.idempotents.simplicial_object + +/-! + +# The Dold-Kan correspondence for pseudoabelian categories + +In this file, for any idempotent complete additive category `C`, +the Dold-Kan equivalence +`idempotents.dold_kan.equivalence C : simplicial_object C ≌ chain_complex C ℕ` +is obtained. It is deduced from the equivalence +`preadditive.dold_kan.equivalence` between the respective idempotent +completions of these categories using the fact that when `C` is idempotent complete, +then both `simplicial_object C` and `chain_complex C ℕ` are idempotent complete. + +The construction of `idempotents.dold_kan.equivalence` uses the tools +introduced in the file `compatibility.lean`. Doing so, the functor +`idempotents.dold_kan.N` of the equivalence is +the composition of `N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)` +(defined in `functor_n.lean`) and the inverse of the equivalence +`chain_complex C ℕ ≌ karoubi (chain_complex C ℕ)`. The functor +`idempotents.dold_kan.Γ` of the equivalence is by definition the functor +`Γ₀` introduced in `functor_gamma.lean`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits category_theory.idempotents + +variables {C : Type*} [category C] [preadditive C] [is_idempotent_complete C] + [has_finite_coproducts C] + +namespace category_theory + +namespace idempotents + +namespace dold_kan + +open algebraic_topology.dold_kan + +/-- The functor `N` for the equivalence is obtained by composing +`N' : simplicial_object C ⥤ karoubi (chain_complex C ℕ)` and the inverse +of the equivalence `chain_complex C ℕ ≌ karoubi (chain_complex C ℕ)`. -/ +@[simps, nolint unused_arguments] +def N : simplicial_object C ⥤ chain_complex C ℕ := +N₁ ⋙ (to_karoubi_equivalence _).inverse + +/-- The functor `Γ` for the equivalence is `Γ'`. -/ +@[simps, nolint unused_arguments] +def Γ : chain_complex C ℕ ⥤ simplicial_object C := Γ₀ + +lemma hN₁ : (to_karoubi_equivalence (simplicial_object C)).functor ⋙ + preadditive.dold_kan.equivalence.functor = N₁ := +functor.congr_obj (functor_extension₁_comp_whiskering_left_to_karoubi _ _) N₁ + +lemma hΓ₀ : (to_karoubi_equivalence (chain_complex C ℕ)).functor ⋙ + preadditive.dold_kan.equivalence.inverse = Γ ⋙ (to_karoubi_equivalence _).functor := +functor.congr_obj (functor_extension₂_comp_whiskering_left_to_karoubi _ _) Γ₀ + +/-- The Dold-Kan equivalence for pseudoabelian categories given +by the functors `N` and `Γ`. It is obtained by applying the results in +`compatibility.lean` to the equivalence `preadditive.dold_kan.equivalence`. -/ +def equivalence : simplicial_object C ≌ chain_complex C ℕ := +compatibility.equivalence (eq_to_iso hN₁) (eq_to_iso hΓ₀) + +lemma equivalence_functor : (equivalence : simplicial_object C ≌ _).functor = N := rfl +lemma equivalence_inverse : (equivalence : simplicial_object C ≌ _).inverse = Γ := rfl + +/-- The natural isomorphism `NΓ' satisfies the compatibility that is needed +for the construction of our counit isomorphism `η` -/ +lemma hη : compatibility.τ₀ = + compatibility.τ₁ (eq_to_iso hN₁) (eq_to_iso hΓ₀) + (N₁Γ₀ : Γ ⋙ N₁ ≅ (to_karoubi_equivalence (chain_complex C ℕ)).functor) := +begin + ext K : 3, + simpa only [compatibility.τ₀_hom_app, compatibility.τ₁_hom_app, eq_to_iso.hom, + preadditive.dold_kan.equivalence_counit_iso, N₂Γ₂_to_karoubi_iso_hom, eq_to_hom_map, + eq_to_hom_trans_assoc, eq_to_hom_app] using N₂Γ₂_compatible_with_N₁Γ₀ K, +end + +/-- The counit isomorphism induced by `N₁Γ₀` -/ +@[simps] +def η : Γ ⋙ N ≅ 𝟭 (chain_complex C ℕ) := compatibility.equivalence_counit_iso + (N₁Γ₀ : (Γ : chain_complex C ℕ ⥤ _ ) ⋙ N₁ ≅ (to_karoubi_equivalence _).functor) + +lemma equivalence_counit_iso : + dold_kan.equivalence.counit_iso = (η : Γ ⋙ N ≅ 𝟭 (chain_complex C ℕ)) := +compatibility.equivalence_counit_iso_eq hη + +lemma hε : compatibility.υ (eq_to_iso hN₁) = + (Γ₂N₁ : (to_karoubi_equivalence _).functor ≅ (N₁ : simplicial_object C ⥤ _) ⋙ + preadditive.dold_kan.equivalence.inverse) := +begin + ext X : 4, + erw [nat_trans.comp_app, compatibility_Γ₂N₁_Γ₂N₂_nat_trans], + simp only [compatibility.υ_hom_app, compatibility_Γ₂N₁_Γ₂N₂, + preadditive.dold_kan.equivalence_unit_iso, Γ₂N₂, iso.symm_hom, as_iso_inv, assoc], + erw [← nat_trans.comp_app_assoc, is_iso.hom_inv_id], + dsimp, + simpa only [id_comp, eq_to_hom_app, eq_to_hom_map, eq_to_hom_trans], +end + +/-- The unit isomorphism induced by `Γ₂N₁`. -/ +def ε : 𝟭 (simplicial_object C) ≅ N ⋙ Γ := +compatibility.equivalence_unit_iso (eq_to_iso hΓ₀) Γ₂N₁ + +lemma equivalence_unit_iso : dold_kan.equivalence.unit_iso = + (ε : 𝟭 (simplicial_object C) ≅ N ⋙ Γ) := +compatibility.equivalence_unit_iso_eq hε + +end dold_kan + +end idempotents + +end category_theory diff --git a/src/algebraic_topology/dold_kan/faces.lean b/src/algebraic_topology/dold_kan/faces.lean new file mode 100644 index 0000000000000..d9e7af0e63960 --- /dev/null +++ b/src/algebraic_topology/dold_kan/faces.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.homotopies +import tactic.ring_exp + +/-! + +# Study of face maps for the Dold-Kan correspondence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +TODO (@joelriou) continue adding the various files referenced below + +In this file, we obtain the technical lemmas that are used in the file +`projections.lean` in order to get basic properties of the endomorphisms +`P q : K[X] ⟶ K[X]` with respect to face maps (see `homotopies.lean` for the +role of these endomorphisms in the overall strategy of proof). + +The main lemma in this file is `higher_faces_vanish.induction`. It is based +on two technical lemmas `higher_faces_vanish.comp_Hσ_eq` and +`higher_faces_vanish.comp_Hσ_eq_zero`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open nat +open category_theory +open category_theory.limits +open category_theory.category +open category_theory.preadditive +open category_theory.simplicial_object +open_locale simplicial dold_kan + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] +variables {X : simplicial_object C} + +/-- A morphism `φ : Y ⟶ X _[n+1]` satisfies `higher_faces_vanish q φ` +when the compositions `φ ≫ X.δ j` are `0` for `j ≥ max 1 (n+2-q)`. When `q ≤ n+1`, +it basically means that the composition `φ ≫ X.δ j` are `0` for the `q` highest +possible values of a nonzero `j`. Otherwise, when `q ≥ n+2`, all the compositions +`φ ≫ X.δ j` for nonzero `j` vanish. See also the lemma `comp_P_eq_self_iff` in +`projections.lean` which states that `higher_faces_vanish q φ` is equivalent to +the identity `φ ≫ (P q).f (n+1) = φ`. -/ +def higher_faces_vanish {Y : C} {n : ℕ} (q : ℕ) (φ : Y ⟶ X _[n+1]) : Prop := +∀ (j : fin (n+1)), (n+1 ≤ (j : ℕ) + q) → φ ≫ X.δ j.succ = 0 + +namespace higher_faces_vanish + +@[reassoc] +lemma comp_δ_eq_zero {Y : C} {n : ℕ} {q : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish q φ) (j : fin (n+2)) (hj₁ : j ≠ 0) (hj₂ : n+2 ≤ (j : ℕ) + q) : + φ ≫ X.δ j = 0 := +begin + obtain ⟨i, hi⟩ := fin.eq_succ_of_ne_zero hj₁, + subst hi, + apply v i, + rw [← @nat.add_le_add_iff_right 1, add_assoc], + simpa only [fin.coe_succ, add_assoc, add_comm 1] using hj₂, +end + +lemma of_succ {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish (q+1) φ) : higher_faces_vanish q φ := +λ j hj, v j (by simpa only [← add_assoc] using le_add_right hj) + +lemma of_comp {Y Z : C} {q n : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish q φ) (f : Z ⟶ Y) : + higher_faces_vanish q (f ≫ φ) := λ j hj, +by rw [assoc, v j hj, comp_zero] + +lemma comp_Hσ_eq {Y : C} {n a q : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish q φ) (hnaq : n=a+q) : φ ≫ (Hσ q).f (n+1) = + - φ ≫ X.δ ⟨a+1, nat.succ_lt_succ (nat.lt_succ_iff.mpr (nat.le.intro hnaq.symm))⟩ ≫ + X.σ ⟨a, nat.lt_succ_iff.mpr (nat.le.intro hnaq.symm)⟩ := +begin + have hnaq_shift : Π d : ℕ, n+d=(a+d)+q, + { intro d, rw [add_assoc, add_comm d, ← add_assoc, hnaq], }, + rw [Hσ, homotopy.null_homotopic_map'_f (c_mk (n+2) (n+1) rfl) (c_mk (n+1) n rfl), + hσ'_eq hnaq (c_mk (n+1) n rfl), hσ'_eq (hnaq_shift 1) (c_mk (n+2) (n+1) rfl)], + simp only [alternating_face_map_complex.obj_d_eq, eq_to_hom_refl, + comp_id, comp_sum, sum_comp, comp_add], + simp only [comp_zsmul, zsmul_comp, ← assoc, ← mul_zsmul], + /- cleaning up the first sum -/ + rw [← fin.sum_congr' _ (hnaq_shift 2).symm, fin.sum_trunc], swap, + { rintro ⟨k, hk⟩, + suffices : φ ≫ X.δ (⟨a+2+k, by linarith⟩ : fin (n+2)) = 0, + { simp only [this, fin.nat_add_mk, fin.cast_mk, zero_comp, smul_zero], }, + convert v ⟨a+k+1, by linarith⟩ (by { rw fin.coe_mk, linarith, }), + rw [nat.succ_eq_add_one], + linarith, }, + /- cleaning up the second sum -/ + rw [← fin.sum_congr' _ (hnaq_shift 3).symm, @fin.sum_trunc _ _ (a+3)], swap, + { rintros ⟨k, hk⟩, + rw [assoc, X.δ_comp_σ_of_gt', v.comp_δ_eq_zero_assoc, zero_comp, zsmul_zero], + { intro h, + rw [fin.pred_eq_iff_eq_succ, fin.ext_iff] at h, + dsimp at h, + linarith, }, + { dsimp, + simp only [fin.coe_pred, fin.coe_mk, succ_add_sub_one], + linarith, }, + { dsimp, + linarith, }, }, + /- leaving out three specific terms -/ + conv_lhs { congr, skip, rw [fin.sum_univ_cast_succ, fin.sum_univ_cast_succ], }, + rw fin.sum_univ_cast_succ, + simp only [fin.last, fin.cast_le_mk, fin.coe_cast, fin.cast_mk, + fin.coe_cast_le, fin.coe_mk, fin.cast_succ_mk, fin.coe_cast_succ], + /- the purpose of the following `simplif` is to create three subgoals in order + to finish the proof -/ + have simplif : ∀ (a b c d e f : Y ⟶ X _[n+1]), b=f → d+e=0 → c+a=0 → a+b+(c+d+e) = f, + { intros a b c d e f h1 h2 h3, + rw [add_assoc c d e, h2, add_zero, add_comm a b, add_assoc, + add_comm a c, h3, add_zero, h1], }, + apply simplif, + { /- b=f -/ + rw [← pow_add, odd.neg_one_pow, neg_smul, one_zsmul], + use a, + linarith, }, + { /- d+e = 0 -/ + rw [assoc, assoc, X.δ_comp_σ_self' (fin.cast_succ_mk _ _ _).symm, + X.δ_comp_σ_succ' (fin.succ_mk _ _ _).symm], + simp only [comp_id, pow_add _ (a+1) 1, pow_one, mul_neg, mul_one, neg_smul, + add_right_neg], }, + { /- c+a = 0 -/ + rw ← finset.sum_add_distrib, + apply finset.sum_eq_zero, + rintros ⟨i, hi⟩ h₀, + have hia : (⟨i, by linarith⟩ : fin (n+2)) ≤ fin.cast_succ (⟨a, by linarith⟩ : fin (n+1)) := + by simpa only [fin.le_iff_coe_le_coe, fin.coe_mk, fin.cast_succ_mk, ← lt_succ_iff] using hi, + simp only [fin.coe_mk, fin.cast_le_mk, fin.cast_succ_mk, fin.succ_mk, assoc, fin.cast_mk, + ← δ_comp_σ_of_le X hia, add_eq_zero_iff_eq_neg, ← neg_zsmul], + congr, + ring_exp, }, +end + +lemma comp_Hσ_eq_zero {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish q φ) (hqn : n THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + + +In this file, we construct the functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C` +which shall be the inverse functor of the Dold-Kan equivalence in the case of abelian categories, +and more generally pseudoabelian categories. + +By definition, when `K` is a chain_complex, `Γ₀.obj K` is a simplicial object which +sends `Δ : simplex_categoryᵒᵖ` to a certain coproduct indexed by the set +`splitting.index_set Δ` whose elements consists of epimorphisms `e : Δ.unop ⟶ Δ'.unop` +(with `Δ' : simplex_categoryᵒᵖ`); the summand attached to such an `e` is `K.X Δ'.unop.len`. +By construction, `Γ₀.obj K` is a split simplicial object whose splitting is `Γ₀.splitting K`. + +We also construct `Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C)` +which shall be an equivalence for any additive category `C`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits + simplex_category simplicial_object opposite category_theory.idempotents +open_locale simplicial dold_kan + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] (K K' : chain_complex C ℕ) (f : K ⟶ K') + {Δ'' Δ' Δ : simplex_category} (i' : Δ'' ⟶ Δ') [mono i'] (i : Δ' ⟶ Δ) [mono i] + +/-- `is_δ₀ i` is a simple condition used to check whether a monomorphism `i` in +`simplex_category` identifies to the coface map `δ 0`. -/ +@[nolint unused_arguments] +def is_δ₀ {Δ Δ' : simplex_category} (i : Δ' ⟶ Δ) [mono i] : Prop := +(Δ.len = Δ'.len+1) ∧ (i.to_order_hom 0 ≠ 0) + +namespace is_δ₀ + +lemma iff {j : ℕ} {i : fin (j+2)} : is_δ₀ (simplex_category.δ i) ↔ i = 0 := +begin + split, + { rintro ⟨h₁, h₂⟩, + by_contradiction, + exact h₂ (fin.succ_above_ne_zero_zero h), }, + { rintro rfl, + exact ⟨rfl, fin.succ_ne_zero _⟩, }, +end + +lemma eq_δ₀ {n : ℕ} {i : [n] ⟶ [n+1]} [mono i] (hi : is_δ₀ i) : + i = simplex_category.δ 0 := +begin + unfreezingI { obtain ⟨j, rfl⟩ := simplex_category.eq_δ_of_mono i, }, + rw iff at hi, + rw hi, +end + +end is_δ₀ + +namespace Γ₀ + +namespace obj + +/-- In the definition of `(Γ₀.obj K).obj Δ` as a direct sum indexed by `A : splitting.index_set Δ`, +the summand `summand K Δ A` is `K.X A.1.len`. -/ +def summand (Δ : simplex_categoryᵒᵖ) (A : splitting.index_set Δ) : C := K.X A.1.unop.len + +/-- The functor `Γ₀` sends a chain complex `K` to the simplicial object which +sends `Δ` to the direct sum of the objects `summand K Δ A` for all `A : splitting.index_set Δ` -/ +def obj₂ (K : chain_complex C ℕ) (Δ : simplex_categoryᵒᵖ) [has_finite_coproducts C] : C := +∐ (λ (A : splitting.index_set Δ), summand K Δ A) + +namespace termwise + +/-- A monomorphism `i : Δ' ⟶ Δ` induces a morphism `K.X Δ.len ⟶ K.X Δ'.len` which +is the identity if `Δ = Δ'`, the differential on the complex `K` if `i = δ 0`, and +zero otherwise. -/ +def map_mono (K : chain_complex C ℕ) {Δ' Δ : simplex_category} (i : Δ' ⟶ Δ) [mono i] : + K.X Δ.len ⟶ K.X Δ'.len := +begin + by_cases Δ = Δ', + { exact eq_to_hom (by congr'), }, + { by_cases is_δ₀ i, + { exact K.d Δ.len Δ'.len, }, + { exact 0, }, }, +end + +variable (Δ) + +lemma map_mono_id : map_mono K (𝟙 Δ) = 𝟙 _ := +by { unfold map_mono, simp only [eq_self_iff_true, eq_to_hom_refl, dite_eq_ite, if_true], } + +variable {Δ} + +lemma map_mono_δ₀' (hi : is_δ₀ i) : map_mono K i = K.d Δ.len Δ'.len := +begin + unfold map_mono, + classical, + rw [dif_neg, dif_pos hi], + unfreezingI { rintro rfl, }, + simpa only [self_eq_add_right, nat.one_ne_zero] using hi.1, +end + +@[simp] +lemma map_mono_δ₀ {n : ℕ} : map_mono K (δ (0 : fin (n+2))) = K.d (n+1) n := +map_mono_δ₀' K _ (by rw is_δ₀.iff) + +lemma map_mono_eq_zero (h₁ : Δ ≠ Δ') (h₂ : ¬is_δ₀ i) : map_mono K i = 0 := +by { unfold map_mono, rw ne.def at h₁, split_ifs, refl, } + +variables {K K'} + +@[simp, reassoc] +lemma map_mono_naturality : map_mono K i ≫ f.f Δ'.len = f.f Δ.len ≫ map_mono K' i := +begin + unfold map_mono, + split_ifs, + { unfreezingI { subst h, }, + simp only [id_comp, eq_to_hom_refl, comp_id], }, + { rw homological_complex.hom.comm, }, + { rw [zero_comp, comp_zero], } +end + +variable (K) + +@[simp, reassoc] +lemma map_mono_comp : map_mono K i ≫ map_mono K i' = map_mono K (i' ≫ i) := +begin + /- case where i : Δ' ⟶ Δ is the identity -/ + by_cases h₁ : Δ = Δ', + { unfreezingI { subst h₁, }, + simp only [simplex_category.eq_id_of_mono i, + comp_id, id_comp, map_mono_id K, eq_to_hom_refl], }, + /- case where i' : Δ'' ⟶ Δ' is the identity -/ + by_cases h₂ : Δ' = Δ'', + { unfreezingI { subst h₂, }, + simp only [simplex_category.eq_id_of_mono i', + comp_id, id_comp, map_mono_id K, eq_to_hom_refl], }, + /- then the RHS is always zero -/ + obtain ⟨k, hk⟩ := nat.exists_eq_add_of_lt (len_lt_of_mono i h₁), + obtain ⟨k', hk'⟩ := nat.exists_eq_add_of_lt (len_lt_of_mono i' h₂), + have eq : Δ.len = Δ''.len + (k+k'+2) := by linarith, + rw map_mono_eq_zero K (i' ≫ i) _ _, rotate, + { by_contradiction, + simpa only [self_eq_add_right, h] using eq, }, + { by_contradiction, + simp only [h.1, add_right_inj] at eq, + linarith, }, + /- in all cases, the LHS is also zero, either by definition, or because d ≫ d = 0 -/ + by_cases h₃ : is_δ₀ i, + { by_cases h₄ : is_δ₀ i', + { rw [map_mono_δ₀' K i h₃, map_mono_δ₀' K i' h₄, + homological_complex.d_comp_d], }, + { simp only [map_mono_eq_zero K i' h₂ h₄, comp_zero], }, }, + { simp only [map_mono_eq_zero K i h₁ h₃, zero_comp], }, +end + +end termwise + +variable [has_finite_coproducts C] + +/-- The simplicial morphism on the simplicial object `Γ₀.obj K` induced by +a morphism `Δ' → Δ` in `simplex_category` is defined on each summand +associated to an `A : Γ_index_set Δ` in terms of the epi-mono factorisation +of `θ ≫ A.e`. -/ +def map (K : chain_complex C ℕ) {Δ' Δ : simplex_categoryᵒᵖ} (θ : Δ ⟶ Δ') : + obj₂ K Δ ⟶ obj₂ K Δ' := +sigma.desc (λ A, termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ + (sigma.ι (summand K Δ') (A.pull θ))) + +@[reassoc] +lemma map_on_summand₀ {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) {θ : Δ ⟶ Δ'} + {Δ'' : simplex_category} {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [epi e] [mono i] + (fac : e ≫ i = θ.unop ≫ A.e) : + (sigma.ι (summand K Δ) A) ≫ map K θ = + termwise.map_mono K i ≫ sigma.ι (summand K Δ') (splitting.index_set.mk e) := +begin + simp only [map, colimit.ι_desc, cofan.mk_ι_app], + have h := simplex_category.image_eq fac, + unfreezingI { subst h, }, + congr, + { exact simplex_category.image_ι_eq fac, }, + { dsimp only [simplicial_object.splitting.index_set.pull], + congr, + exact simplex_category.factor_thru_image_eq fac, }, +end + +@[reassoc] +lemma map_on_summand₀' {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') : + (sigma.ι (summand K Δ) A) ≫ map K θ = + termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ sigma.ι (summand K _) (A.pull θ) := +map_on_summand₀ K A (A.fac_pull θ) + +end obj + +variable [has_finite_coproducts C] + +/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on objects. -/ +@[simps] +def obj (K : chain_complex C ℕ) : simplicial_object C := +{ obj := λ Δ, obj.obj₂ K Δ, + map := λ Δ Δ' θ, obj.map K θ, + map_id' := λ Δ, begin + ext A, + cases A, + have fac : A.e ≫ 𝟙 A.1.unop = (𝟙 Δ).unop ≫ A.e := by rw [unop_id, comp_id, id_comp], + erw [obj.map_on_summand₀ K A fac, obj.termwise.map_mono_id, id_comp, comp_id], + unfreezingI { rcases A with ⟨Δ', ⟨e, he⟩⟩, }, + refl, + end, + map_comp' := λ Δ'' Δ' Δ θ' θ, begin + ext A, + cases A, + have fac : θ.unop ≫ θ'.unop ≫ A.e = (θ' ≫ θ).unop ≫ A.e := by rw [unop_comp, assoc], + rw [← image.fac (θ'.unop ≫ A.e), ← assoc, + ← image.fac (θ.unop ≫ factor_thru_image (θ'.unop ≫ A.e)), assoc] at fac, + simpa only [obj.map_on_summand₀'_assoc K A θ', obj.map_on_summand₀' K _ θ, + obj.termwise.map_mono_comp_assoc, obj.map_on_summand₀ K A fac], + end } + +lemma splitting_map_eq_id (Δ : simplex_categoryᵒᵖ) : + (simplicial_object.splitting.map (Γ₀.obj K) + (λ (n : ℕ), sigma.ι (Γ₀.obj.summand K (op [n])) (splitting.index_set.id (op [n]))) Δ) + = 𝟙 _ := +begin + ext A, + discrete_cases, + induction Δ using opposite.rec, + induction Δ with n, + dsimp, + simp only [colimit.ι_desc, cofan.mk_ι_app, comp_id, Γ₀.obj_map], + rw [Γ₀.obj.map_on_summand₀ K + (simplicial_object.splitting.index_set.id A.1) (show A.e ≫ 𝟙 _ = A.e.op.unop ≫ 𝟙 _, by refl), + Γ₀.obj.termwise.map_mono_id, A.ext'], + apply id_comp, +end + +/-- By construction, the simplicial `Γ₀.obj K` is equipped with a splitting. -/ +def splitting (K : chain_complex C ℕ) : simplicial_object.splitting (Γ₀.obj K) := +{ N := λ n, K.X n, + ι := λ n, sigma.ι (Γ₀.obj.summand K (op [n])) (splitting.index_set.id (op [n])), + map_is_iso' := λ Δ, begin + rw Γ₀.splitting_map_eq_id, + apply is_iso.id, + end, } + +@[simp] +lemma splitting_iso_hom_eq_id (Δ : simplex_categoryᵒᵖ) : ((splitting K).iso Δ).hom = 𝟙 _ := +splitting_map_eq_id K Δ + +@[reassoc] +lemma obj.map_on_summand {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') + {Δ'' : simplex_category} + {e : Δ'.unop ⟶ Δ''} {i : Δ'' ⟶ A.1.unop} [epi e] [mono i] + (fac : e ≫ i = θ.unop ≫ A.e) : (Γ₀.splitting K).ι_summand A ≫ (Γ₀.obj K).map θ = + Γ₀.obj.termwise.map_mono K i ≫ (Γ₀.splitting K).ι_summand (splitting.index_set.mk e) := +begin + dsimp only [simplicial_object.splitting.ι_summand, + simplicial_object.splitting.ι_coprod], + simp only [assoc, Γ₀.splitting_iso_hom_eq_id, id_comp, comp_id], + exact Γ₀.obj.map_on_summand₀ K A fac, +end + +@[reassoc] +lemma obj.map_on_summand' {Δ Δ' : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) (θ : Δ ⟶ Δ') : + (splitting K).ι_summand A ≫ (obj K).map θ = + obj.termwise.map_mono K (image.ι (θ.unop ≫ A.e)) ≫ (splitting K).ι_summand (A.pull θ) := +by { apply obj.map_on_summand, apply image.fac, } + +@[reassoc] +lemma obj.map_mono_on_summand_id {Δ Δ' : simplex_category} (i : Δ' ⟶ Δ) [mono i] : + (splitting K).ι_summand (splitting.index_set.id (op Δ)) ≫ (obj K).map i.op = + obj.termwise.map_mono K i ≫ (splitting K).ι_summand (splitting.index_set.id (op Δ')) := +obj.map_on_summand K (splitting.index_set.id (op Δ)) i.op (rfl : 𝟙 _ ≫ i = i ≫ 𝟙 _) + +@[reassoc] +lemma obj.map_epi_on_summand_id {Δ Δ' : simplex_category } (e : Δ' ⟶ Δ) [epi e] : + (Γ₀.splitting K).ι_summand (splitting.index_set.id (op Δ)) ≫ (Γ₀.obj K).map e.op = + (Γ₀.splitting K).ι_summand (splitting.index_set.mk e) := +by simpa only [Γ₀.obj.map_on_summand K (splitting.index_set.id (op Δ)) e.op + (rfl : e ≫ 𝟙 Δ = e ≫ 𝟙 Δ), Γ₀.obj.termwise.map_mono_id] using id_comp _ + +/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, on morphisms. -/ +@[simps] +def map {K K' : chain_complex C ℕ} (f : K ⟶ K') : obj K ⟶ obj K' := +{ app := λ Δ, (Γ₀.splitting K).desc Δ (λ A, f.f A.1.unop.len ≫ (Γ₀.splitting K').ι_summand A), + naturality' := λ Δ' Δ θ, begin + apply (Γ₀.splitting K).hom_ext', + intro A, + simp only [(splitting K).ι_desc_assoc, obj.map_on_summand'_assoc K _ θ, + (splitting K).ι_desc, assoc, obj.map_on_summand' K' _ θ], + apply obj.termwise.map_mono_naturality_assoc, + end, } + +end Γ₀ + +variable [has_finite_coproducts C] + +/-- The functor `Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C` +that induces `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which +shall be the inverse functor of the Dold-Kan equivalence for +abelian or pseudo-abelian categories. -/ +@[simps] +def Γ₀' : chain_complex C ℕ ⥤ simplicial_object.split C := +{ obj := λ K, simplicial_object.split.mk' (Γ₀.splitting K), + map := λ K K' f, + { F := Γ₀.map f, + f := f.f, + comm' := λ n, by { dsimp, simpa only [← splitting.ι_summand_id, + (Γ₀.splitting K).ι_desc], }, }, } + +/-- The functor `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C`, which is +the inverse functor of the Dold-Kan equivalence when `C` is an abelian +category, or more generally a pseudoabelian category. -/ +@[simps] +def Γ₀ : chain_complex C ℕ ⥤ simplicial_object C := Γ₀' ⋙ split.forget _ + + +/-- The extension of `Γ₀ : chain_complex C ℕ ⥤ simplicial_object C` +on the idempotent completions. It shall be an equivalence of categories +for any additive category `C`. -/ +@[simps] +def Γ₂ : karoubi (chain_complex C ℕ) ⥤ karoubi (simplicial_object C) := +(category_theory.idempotents.functor_extension₂ _ _).obj Γ₀ + +lemma higher_faces_vanish.on_Γ₀_summand_id (K : chain_complex C ℕ) (n : ℕ) : + higher_faces_vanish (n+1) ((Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n+1]))) := +begin + intros j hj, + have eq := Γ₀.obj.map_mono_on_summand_id K (simplex_category.δ j.succ), + rw [Γ₀.obj.termwise.map_mono_eq_zero K, zero_comp] at eq, rotate, + { intro h, + exact (nat.succ_ne_self n) (congr_arg simplex_category.len h), }, + { exact λ h, fin.succ_ne_zero j (by simpa only [is_δ₀.iff] using h), }, + exact eq, +end + +@[simp, reassoc] +lemma P_infty_on_Γ₀_splitting_summand_eq_self + (K : chain_complex C ℕ) {n : ℕ} : + (Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n])) ≫ (P_infty : K[Γ₀.obj K] ⟶ _).f n = + (Γ₀.splitting K).ι_summand (splitting.index_set.id (op [n])) := +begin + rw P_infty_f, + cases n, + { simpa only [P_f_0_eq] using comp_id _, }, + { exact (higher_faces_vanish.on_Γ₀_summand_id K n).comp_P_eq_self, }, +end + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/functor_n.lean b/src/algebraic_topology/dold_kan/functor_n.lean new file mode 100644 index 0000000000000..74f4d58a98df4 --- /dev/null +++ b/src/algebraic_topology/dold_kan/functor_n.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.p_infty + +/-! + +# Construction of functors N for the Dold-Kan correspondence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +TODO (@joelriou) continue adding the various files referenced below + +In this file, we construct functors `N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)` +and `N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)` +for any preadditive category `C`. (The indices of these functors are the number of occurrences +of `karoubi` at the source or the target.) + +In the case `C` is additive, the functor `N₂` shall be the functor of the equivalence +`category_theory.preadditive.dold_kan.equivalence` defined in `equivalence_additive.lean`. + +In the case the category `C` is pseudoabelian, the composition of `N₁` with the inverse of the +equivalence `chain_complex C ℕ ⥤ karoubi (chain_complex C ℕ)` will be the functor +`category_theory.idempotents.dold_kan.N` of the equivalence of categories +`category_theory.idempotents.dold_kan.equivalence : simplicial_object C ≌ chain_complex C ℕ` +defined in `equivalence_pseudoabelian.lean`. + +When the category `C` is abelian, a relation between `N₁` and the +normalized Moore complex functor shall be obtained in `normalized.lean`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory +open category_theory.category +open category_theory.idempotents + +noncomputable theory + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] + +/-- The functor `simplicial_object C ⥤ karoubi (chain_complex C ℕ)` which maps +`X` to the formal direct factor of `K[X]` defined by `P_infty`. -/ +@[simps] +def N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ) := +{ obj := λ X, + { X := alternating_face_map_complex.obj X, + p := P_infty, + idem := P_infty_idem, }, + map := λ X Y f, + { f := P_infty ≫ alternating_face_map_complex.map f, + comm := by { ext, simp }, }, + map_id' := λ X, by { ext, dsimp, simp }, + map_comp' := λ X Y Z f g, by { ext, simp } } + +/-- The extension of `N₁` to the Karoubi envelope of `simplicial_object C`. -/ +@[simps] +def N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ) := +(functor_extension₁ _ _).obj N₁ + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/gamma_comp_n.lean b/src/algebraic_topology/dold_kan/gamma_comp_n.lean new file mode 100644 index 0000000000000..86e9a3e0230c0 --- /dev/null +++ b/src/algebraic_topology/dold_kan/gamma_comp_n.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.functor_gamma +import category_theory.idempotents.homological_complex + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The counit isomorphism of the Dold-Kan equivalence + +The purpose of this file is to construct natural isomorphisms +`N₁Γ₀ : Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ)` +and `N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ))`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits category_theory.idempotents + opposite simplicial_object +open_locale simplicial + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] [has_finite_coproducts C] + +/-- The isomorphism `(Γ₀.splitting K).nondeg_complex ≅ K` for all `K : chain_complex C ℕ`. -/ +@[simps] +def Γ₀_nondeg_complex_iso (K : chain_complex C ℕ) : (Γ₀.splitting K).nondeg_complex ≅ K := +homological_complex.hom.iso_of_components (λ n, iso.refl _) +begin + rintros _ n (rfl : n+1=_), + dsimp, + simp only [id_comp, comp_id, alternating_face_map_complex.obj_d_eq, + preadditive.sum_comp, preadditive.comp_sum], + rw fintype.sum_eq_single (0 : fin (n+2)), + { simp only [fin.coe_zero, pow_zero, one_zsmul], + erw [Γ₀.obj.map_mono_on_summand_id_assoc, Γ₀.obj.termwise.map_mono_δ₀, + splitting.ι_π_summand_eq_id, comp_id], }, + { intros i hi, + dsimp, + simp only [preadditive.zsmul_comp, preadditive.comp_zsmul, assoc], + erw [Γ₀.obj.map_mono_on_summand_id_assoc, Γ₀.obj.termwise.map_mono_eq_zero, + zero_comp, zsmul_zero], + { intro h, + replace h := congr_arg simplex_category.len h, + change n+1 = n at h, + linarith, }, + { simpa only [is_δ₀.iff] using hi, }, }, +end + +/-- The natural isomorphism `(Γ₀.splitting K).nondeg_complex ≅ K` for `K : chain_complex C ℕ`. -/ +def Γ₀'_comp_nondeg_complex_functor : + Γ₀' ⋙ split.nondeg_complex_functor ≅ 𝟭 (chain_complex C ℕ) := +nat_iso.of_components Γ₀_nondeg_complex_iso + (λ X Y f, by { ext n, dsimp, simp only [comp_id, id_comp], }) + +/-- The natural isomorphism `Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ)`. -/ +def N₁Γ₀ : Γ₀ ⋙ N₁ ≅ to_karoubi (chain_complex C ℕ) := +calc Γ₀ ⋙ N₁ ≅ Γ₀' ⋙ split.forget C ⋙ N₁ : functor.associator _ _ _ +... ≅ Γ₀' ⋙ split.nondeg_complex_functor ⋙ to_karoubi _ : + iso_whisker_left Γ₀' split.to_karoubi_nondeg_complex_functor_iso_N₁.symm +... ≅ (Γ₀' ⋙ split.nondeg_complex_functor) ⋙ to_karoubi _ : (functor.associator _ _ _).symm +... ≅ 𝟭 _ ⋙ to_karoubi (chain_complex C ℕ) : iso_whisker_right Γ₀'_comp_nondeg_complex_functor _ +... ≅ to_karoubi (chain_complex C ℕ) : functor.left_unitor _ + +lemma N₁Γ₀_app (K : chain_complex C ℕ) : + N₁Γ₀.app K = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.symm + ≪≫ (to_karoubi _).map_iso (Γ₀_nondeg_complex_iso K) := +begin + ext1, + dsimp [N₁Γ₀], + erw [id_comp, comp_id, comp_id], + refl, +end + +lemma N₁Γ₀_hom_app (K : chain_complex C ℕ) : + N₁Γ₀.hom.app K = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.inv + ≫ (to_karoubi _).map (Γ₀_nondeg_complex_iso K).hom := +by { change (N₁Γ₀.app K).hom = _, simpa only [N₁Γ₀_app], } + +lemma N₁Γ₀_inv_app (K : chain_complex C ℕ) : + N₁Γ₀.inv.app K = (to_karoubi _).map (Γ₀_nondeg_complex_iso K).inv ≫ + (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.hom := +by { change (N₁Γ₀.app K).inv = _, simpa only [N₁Γ₀_app], } + +@[simp] +lemma N₁Γ₀_hom_app_f_f (K : chain_complex C ℕ) (n : ℕ) : + (N₁Γ₀.hom.app K).f.f n = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.inv.f.f n := +by { rw N₁Γ₀_hom_app, apply comp_id, } + +@[simp] +lemma N₁Γ₀_inv_app_f_f (K : chain_complex C ℕ) (n : ℕ) : + (N₁Γ₀.inv.app K).f.f n = (Γ₀.splitting K).to_karoubi_nondeg_complex_iso_N₁.hom.f.f n := +by { rw N₁Γ₀_inv_app, apply id_comp, } + +lemma N₂Γ₂_to_karoubi : to_karoubi (chain_complex C ℕ) ⋙ Γ₂ ⋙ N₂ = Γ₀ ⋙ N₁ := +begin + have h := functor.congr_obj (functor_extension₂_comp_whiskering_left_to_karoubi + (chain_complex C ℕ) (simplicial_object C)) Γ₀, + have h' := functor.congr_obj (functor_extension₁_comp_whiskering_left_to_karoubi + (simplicial_object C) (chain_complex C ℕ)) N₁, + dsimp [N₂, Γ₂, functor_extension₁] at h h' ⊢, + rw [← functor.assoc, h, functor.assoc, h'], +end + +/-- Compatibility isomorphism between `to_karoubi _ ⋙ Γ₂ ⋙ N₂` and `Γ₀ ⋙ N₁` which +are functors `chain_complex C ℕ ⥤ karoubi (chain_complex C ℕ)`. -/ +@[simps] +def N₂Γ₂_to_karoubi_iso : to_karoubi (chain_complex C ℕ) ⋙ Γ₂ ⋙ N₂ ≅ Γ₀ ⋙ N₁ := +eq_to_iso (N₂Γ₂_to_karoubi) + +/-- The counit isomorphism of the Dold-Kan equivalence for additive categories. -/ +def N₂Γ₂ : Γ₂ ⋙ N₂ ≅ 𝟭 (karoubi (chain_complex C ℕ)) := +((whiskering_left _ _ _).obj (to_karoubi (chain_complex C ℕ))).preimage_iso + (N₂Γ₂_to_karoubi_iso ≪≫ N₁Γ₀) + +lemma N₂Γ₂_compatible_with_N₁Γ₀ (K : chain_complex C ℕ) : + N₂Γ₂.hom.app ((to_karoubi _).obj K) = N₂Γ₂_to_karoubi_iso.hom.app K ≫ N₁Γ₀.hom.app K := +congr_app (((whiskering_left _ _ (karoubi (chain_complex C ℕ ))).obj + (to_karoubi (chain_complex C ℕ))).image_preimage + (N₂Γ₂_to_karoubi_iso.hom ≫ N₁Γ₀.hom : _ ⟶ to_karoubi _ ⋙ 𝟭 _)) K + +@[simp] +lemma N₂Γ₂_inv_app_f_f (X : karoubi (chain_complex C ℕ)) (n : ℕ) : + (N₂Γ₂.inv.app X).f.f n = + X.p.f n ≫ (Γ₀.splitting X.X).ι_summand (splitting.index_set.id (op [n])) := +begin + dsimp only [N₂Γ₂, functor.preimage_iso, iso.trans], + simp only [whiskering_left_obj_preimage_app, N₂Γ₂_to_karoubi_iso_inv, functor.id_map, + nat_trans.comp_app, eq_to_hom_app, functor.comp_map, assoc, karoubi.comp_f, + karoubi.eq_to_hom_f, eq_to_hom_refl, comp_id, karoubi.comp_p_assoc, N₂_map_f_f, + homological_complex.comp_f, N₁Γ₀_inv_app_f_f, P_infty_on_Γ₀_splitting_summand_eq_self_assoc, + splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f, Γ₂_map_f_app, karoubi.decomp_id_p_f], + dsimp [to_karoubi], + rw [splitting.ι_desc], + dsimp [splitting.index_set.id], + rw karoubi.homological_complex.p_idem_assoc, +end + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/homotopies.lean b/src/algebraic_topology/dold_kan/homotopies.lean index 631f3cb9fe164..13533ae3f6936 100644 --- a/src/algebraic_topology/dold_kan/homotopies.lean +++ b/src/algebraic_topology/dold_kan/homotopies.lean @@ -11,7 +11,10 @@ import algebraic_topology.dold_kan.notations # Construction of homotopies for the Dold-Kan correspondence -TODO (@joelriou) continue adding the various files references below +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +TODO (@joelriou) continue adding the various files referenced below (The general strategy of proof of the Dold-Kan correspondence is explained in `equivalence.lean`.) @@ -121,6 +124,11 @@ begin congr', } end +lemma hσ'_eq' {q n a : ℕ} (ha : n=a+q) : + (hσ' q n (n+1) rfl : X _[n] ⟶ X _[n+1]) = + (-1 : ℤ)^a • X.σ ⟨a, nat.lt_succ_iff.mpr (nat.le.intro (eq.symm ha))⟩ := +by rw [hσ'_eq ha rfl, eq_to_hom_refl, comp_id] + /-- The null homotopic map $(hσ q) ∘ d + d ∘ (hσ q)$ -/ def Hσ (q : ℕ) : K[X] ⟶ K[X] := null_homotopic_map' (hσ' q) @@ -134,14 +142,14 @@ begin unfold Hσ, rw null_homotopic_map'_f_of_not_rel_left (c_mk 1 0 rfl) cs_down_0_not_rel_left, cases q, - { erw hσ'_eq (show 0=0+0, by refl) (c_mk 1 0 rfl), + { rw hσ'_eq (show 0=0+0, by refl) (c_mk 1 0 rfl), simp only [pow_zero, fin.mk_zero, one_zsmul, eq_to_hom_refl, category.comp_id], erw chain_complex.of_d, simp only [alternating_face_map_complex.obj_d, fin.sum_univ_two, fin.coe_zero, pow_zero, one_zsmul, fin.coe_one, pow_one, comp_add, neg_smul, one_zsmul, comp_neg, add_neg_eq_zero], erw [δ_comp_σ_self, δ_comp_σ_succ], }, - { erw [hσ'_eq_zero (nat.succ_pos q) (c_mk 1 0 rfl), zero_comp], }, + { rw [hσ'_eq_zero (nat.succ_pos q) (c_mk 1 0 rfl), zero_comp], }, end /-- The maps `hσ' q n m hnm` are natural on the simplicial object -/ @@ -169,8 +177,7 @@ def nat_trans_Hσ (q : ℕ) : rw [null_homotopic_map'_comp, comp_null_homotopic_map'], congr, ext n m hnm, - simp only [alternating_face_map_complex_map, alternating_face_map_complex.map, - chain_complex.of_hom_f, hσ'_naturality], + simp only [alternating_face_map_complex_map_f, hσ'_naturality], end, } /-- The maps `hσ' q n m hnm` are compatible with the application of additive functors. -/ diff --git a/src/algebraic_topology/dold_kan/homotopy_equivalence.lean b/src/algebraic_topology/dold_kan/homotopy_equivalence.lean new file mode 100644 index 0000000000000..8db3a58d5be9b --- /dev/null +++ b/src/algebraic_topology/dold_kan/homotopy_equivalence.lean @@ -0,0 +1,96 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.normalized + +/-! + +# The normalized Moore complex and the alternating face map complex are homotopy equivalent + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, when the category `A` is abelian, we obtain the homotopy equivalence +`homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex` between the +normalized Moore complex and the alternating face map complex of a simplicial object in `A`. + +-/ + +open category_theory category_theory.category category_theory.limits + category_theory.preadditive +open_locale simplicial dold_kan + +noncomputable theory + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] (X : simplicial_object C) + +/-- Inductive construction of homotopies from `P q` to `𝟙 _` -/ +noncomputable def homotopy_P_to_id : Π (q : ℕ), + homotopy (P q : K[X] ⟶ _) (𝟙 _) +| 0 := homotopy.refl _ +| (q+1) := begin + refine homotopy.trans (homotopy.of_eq _) + (homotopy.trans + (homotopy.add (homotopy_P_to_id q) (homotopy.comp_left (homotopy_Hσ_to_zero q) (P q))) + (homotopy.of_eq _)), + { unfold P, simp only [comp_add, comp_id], }, + { simp only [add_zero, comp_zero], }, + end + +/-- The complement projection `Q q` to `P q` is homotopic to zero. -/ +def homotopy_Q_to_zero (q : ℕ) : homotopy (Q q : K[X] ⟶ _) 0 := +homotopy.equiv_sub_zero.to_fun (homotopy_P_to_id X q).symm + +lemma homotopy_P_to_id_eventually_constant {q n : ℕ} (hqn : n THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The unit isomorphism of the Dold-Kan equivalence + +In order to construct the unit isomorphism of the Dold-Kan equivalence, +we first construct natural transformations +`Γ₂N₁.nat_trans : N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)` and +`Γ₂N₂.nat_trans : N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)`. +It is then shown that `Γ₂N₂.nat_trans` is an isomorphism by using +that it becomes an isomorphism after the application of the functor +`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)` +which reflects isomorphisms. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits + category_theory.idempotents simplex_category opposite simplicial_object +open_locale simplicial dold_kan + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] + +lemma P_infty_comp_map_mono_eq_zero (X : simplicial_object C) {n : ℕ} + {Δ' : simplex_category} (i : Δ' ⟶ [n]) [hi : mono i] (h₁ : Δ'.len ≠ n) (h₂ : ¬is_δ₀ i) : + P_infty.f n ≫ X.map i.op = 0 := +begin + unfreezingI { induction Δ' using simplex_category.rec with m, }, + obtain ⟨k, hk⟩ := nat.exists_eq_add_of_lt (len_lt_of_mono i + (λ h, by { rw ← h at h₁, exact h₁ rfl, })), + simp only [len_mk] at hk, + cases k, + { change n = m + 1 at hk, + unfreezingI { subst hk, obtain ⟨j, rfl⟩ := eq_δ_of_mono i, }, + rw is_δ₀.iff at h₂, + have h₃ : 1 ≤ (j : ℕ), + { by_contra, + exact h₂ (by simpa only [fin.ext_iff, not_le, nat.lt_one_iff] using h), }, + exact (higher_faces_vanish.of_P (m+1) m).comp_δ_eq_zero j h₂ (by linarith), }, + { simp only [nat.succ_eq_add_one, ← add_assoc] at hk, + clear h₂ hi, + subst hk, + obtain ⟨j₁, i, rfl⟩ := eq_comp_δ_of_not_surjective i (λ h, begin + have h' := len_le_of_epi (simplex_category.epi_iff_surjective.2 h), + dsimp at h', + linarith, + end), + obtain ⟨j₂, i, rfl⟩ := eq_comp_δ_of_not_surjective i (λ h, begin + have h' := len_le_of_epi (simplex_category.epi_iff_surjective.2 h), + dsimp at h', + linarith, + end), + by_cases hj₁ : j₁ = 0, + { unfreezingI { subst hj₁, }, + rw [assoc, ← simplex_category.δ_comp_δ'' (fin.zero_le _)], + simp only [op_comp, X.map_comp, assoc, P_infty_f], + erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ j₂.succ_ne_zero, zero_comp], + rw fin.coe_succ, + linarith, }, + { simp only [op_comp, X.map_comp, assoc, P_infty_f], + erw [(higher_faces_vanish.of_P _ _).comp_δ_eq_zero_assoc _ hj₁, zero_comp], + by_contra, + exact hj₁ (by { simp only [fin.ext_iff, fin.coe_zero], linarith, }), }, }, +end + +@[reassoc] +lemma Γ₀_obj_termwise_map_mono_comp_P_infty (X : simplicial_object C) {Δ Δ' : simplex_category} + (i : Δ ⟶ Δ') [mono i] : + Γ₀.obj.termwise.map_mono (alternating_face_map_complex.obj X) i ≫ P_infty.f (Δ.len) = + P_infty.f (Δ'.len) ≫ X.map i.op := +begin + unfreezingI + { induction Δ using simplex_category.rec with n, + induction Δ' using simplex_category.rec with n', }, + dsimp, + /- We start with the case `i` is an identity -/ + by_cases n = n', + { unfreezingI { subst h, }, + simp only [simplex_category.eq_id_of_mono i, Γ₀.obj.termwise.map_mono_id, op_id, X.map_id], + dsimp, + simp only [id_comp, comp_id], }, + by_cases hi : is_δ₀ i, + /- The case `i = δ 0` -/ + { have h' : n' = n + 1 := hi.left, + unfreezingI { subst h', }, + simp only [Γ₀.obj.termwise.map_mono_δ₀' _ i hi], + dsimp, + rw [← P_infty.comm' _ n rfl, alternating_face_map_complex.obj_d_eq], + simp only [eq_self_iff_true, id_comp, if_true, preadditive.comp_sum], + rw finset.sum_eq_single (0 : fin (n+2)), rotate, + { intros b hb hb', + rw preadditive.comp_zsmul, + erw [P_infty_comp_map_mono_eq_zero X (simplex_category.δ b) h + (by { rw is_δ₀.iff, exact hb', }), zsmul_zero], }, + { simp only [finset.mem_univ, not_true, is_empty.forall_iff], }, + { simpa only [hi.eq_δ₀, fin.coe_zero, pow_zero, one_zsmul], }, }, + /- The case `i ≠ δ 0` -/ + { rw [Γ₀.obj.termwise.map_mono_eq_zero _ i _ hi, zero_comp], swap, + { by_contradiction h', + exact h (congr_arg simplex_category.len h'.symm), }, + rw P_infty_comp_map_mono_eq_zero, + { exact h, }, + { by_contradiction h', + exact hi h', }, }, +end + +variable [has_finite_coproducts C] + +namespace Γ₂N₁ + +/-- The natural transformation `N₁ ⋙ Γ₂ ⟶ to_karoubi (simplicial_object C)`. -/ +@[simps] +def nat_trans : (N₁ : simplicial_object C ⥤ _) ⋙ Γ₂ ⟶ to_karoubi _ := +{ app := λ X, + { f := + { app := λ Δ, (Γ₀.splitting K[X]).desc Δ (λ A, P_infty.f A.1.unop.len ≫ X.map (A.e.op)), + naturality' := λ Δ Δ' θ, begin + apply (Γ₀.splitting K[X]).hom_ext', + intro A, + change _ ≫ (Γ₀.obj K[X]).map θ ≫ _ = _, + simp only [splitting.ι_desc_assoc, assoc, + Γ₀.obj.map_on_summand'_assoc, splitting.ι_desc], + erw Γ₀_obj_termwise_map_mono_comp_P_infty_assoc X (image.ι (θ.unop ≫ A.e)), + dsimp only [to_karoubi], + simp only [← X.map_comp], + congr' 2, + simp only [eq_to_hom_refl, id_comp, comp_id, ← op_comp], + exact quiver.hom.unop_inj (A.fac_pull θ), + end, }, + comm := begin + apply (Γ₀.splitting K[X]).hom_ext, + intro n, + dsimp [N₁], + simp only [← splitting.ι_summand_id, splitting.ι_desc, + comp_id, splitting.ι_desc_assoc, assoc, P_infty_f_idem_assoc], + end, }, + naturality' := λ X Y f, begin + ext1, + apply (Γ₀.splitting K[X]).hom_ext, + intro n, + dsimp [N₁, to_karoubi], + simpa only [←splitting.ι_summand_id, splitting.ι_desc, splitting.ι_desc_assoc, + assoc, P_infty_f_idem_assoc, karoubi.comp_f, nat_trans.comp_app, Γ₂_map_f_app, + homological_complex.comp_f, alternating_face_map_complex.map_f, + P_infty_f_naturality_assoc, nat_trans.naturality], + end, } + +end Γ₂N₁ + +/-- The compatibility isomorphism relating `N₂ ⋙ Γ₂` and `N₁ ⋙ Γ₂`. -/ +@[simps] +def compatibility_Γ₂N₁_Γ₂N₂ : to_karoubi (simplicial_object C) ⋙ N₂ ⋙ Γ₂ ≅ N₁ ⋙ Γ₂ := +eq_to_iso (functor.congr_obj (functor_extension₁_comp_whiskering_left_to_karoubi _ _) (N₁ ⋙ Γ₂)) + +namespace Γ₂N₂ + +/-- The natural transformation `N₂ ⋙ Γ₂ ⟶ 𝟭 (simplicial_object C)`. -/ +def nat_trans : (N₂ : karoubi (simplicial_object C) ⥤ _) ⋙ Γ₂ ⟶ 𝟭 _ := +((whiskering_left _ _ _).obj _).preimage (compatibility_Γ₂N₁_Γ₂N₂.hom ≫ Γ₂N₁.nat_trans) + +lemma nat_trans_app_f_app (P : karoubi (simplicial_object C)) : + Γ₂N₂.nat_trans.app P = (N₂ ⋙ Γ₂).map P.decomp_id_i ≫ + (compatibility_Γ₂N₁_Γ₂N₂.hom ≫ Γ₂N₁.nat_trans).app P.X ≫ P.decomp_id_p := +whiskering_left_obj_preimage_app ((compatibility_Γ₂N₁_Γ₂N₂.hom ≫ Γ₂N₁.nat_trans)) P + +end Γ₂N₂ + +lemma compatibility_Γ₂N₁_Γ₂N₂_nat_trans (X : simplicial_object C) : + Γ₂N₁.nat_trans.app X = (compatibility_Γ₂N₁_Γ₂N₂.app X).inv ≫ + Γ₂N₂.nat_trans.app ((to_karoubi _).obj X) := +begin + rw [← cancel_epi (compatibility_Γ₂N₁_Γ₂N₂.app X).hom, iso.hom_inv_id_assoc], + exact congr_app (((whiskering_left _ _ _).obj _).image_preimage + (compatibility_Γ₂N₁_Γ₂N₂.hom ≫ Γ₂N₁.nat_trans : _ ⟶ to_karoubi _ ⋙ 𝟭 _ )).symm X, +end + +lemma identity_N₂_objectwise (P : karoubi (simplicial_object C)) : + N₂Γ₂.inv.app (N₂.obj P) ≫ N₂.map (Γ₂N₂.nat_trans.app P) = 𝟙 (N₂.obj P) := +begin + ext n, + have eq₁ : (N₂Γ₂.inv.app (N₂.obj P)).f.f n = P_infty.f n ≫ P.p.app (op [n]) ≫ + (Γ₀.splitting (N₂.obj P).X).ι_summand (splitting.index_set.id (op [n])), + { simp only [N₂Γ₂_inv_app_f_f, N₂_obj_p_f, assoc], }, + have eq₂ : (Γ₀.splitting (N₂.obj P).X).ι_summand (splitting.index_set.id (op [n])) ≫ + (N₂.map (Γ₂N₂.nat_trans.app P)).f.f n = P_infty.f n ≫ P.p.app (op [n]), + { dsimp [N₂], + simp only [Γ₂N₂.nat_trans_app_f_app, P_infty_on_Γ₀_splitting_summand_eq_self_assoc, + functor.comp_map, compatibility_Γ₂N₁_Γ₂N₂_hom, nat_trans.comp_app, + eq_to_hom_app, assoc, karoubi.comp_f, karoubi.eq_to_hom_f, eq_to_hom_refl, comp_id, + karoubi.decomp_id_p_f, karoubi.comp_p_assoc, Γ₂_map_f_app, + N₂_map_f_f, karoubi.decomp_id_i_f, Γ₂N₁.nat_trans_app_f_app], + erw [splitting.ι_desc_assoc, assoc, assoc, splitting.ι_desc_assoc], + dsimp [splitting.index_set.id, splitting.index_set.e], + simp only [assoc, nat_trans.naturality, P_infty_f_naturality_assoc, + app_idem_assoc, P_infty_f_idem_assoc], + erw [P.X.map_id, comp_id], }, + simp only [karoubi.comp_f, homological_complex.comp_f, karoubi.id_eq, N₂_obj_p_f, assoc, + eq₁, eq₂, P_infty_f_naturality_assoc, app_idem, P_infty_f_idem_assoc], +end + +lemma identity_N₂ : + ((𝟙 (N₂ : karoubi (simplicial_object C) ⥤ _ ) ◫ N₂Γ₂.inv) ≫ + (Γ₂N₂.nat_trans ◫ 𝟙 N₂) : N₂ ⟶ N₂) = 𝟙 N₂ := +by { ext P : 2, dsimp, rw [Γ₂.map_id, N₂.map_id, comp_id, id_comp, identity_N₂_objectwise P], } + +instance : is_iso (Γ₂N₂.nat_trans : (N₂ : karoubi (simplicial_object C) ⥤ _ ) ⋙ _ ⟶ _) := +begin + haveI : ∀ (P : karoubi (simplicial_object C)), is_iso (Γ₂N₂.nat_trans.app P), + { intro P, + haveI : is_iso (N₂.map (Γ₂N₂.nat_trans.app P)), + { have h := identity_N₂_objectwise P, + erw hom_comp_eq_id at h, + rw h, + apply_instance, }, + exact is_iso_of_reflects_iso _ N₂, }, + apply nat_iso.is_iso_of_is_iso_app, +end + +instance : is_iso (Γ₂N₁.nat_trans : (N₁ : simplicial_object C ⥤ _ ) ⋙ _ ⟶ _) := +begin + haveI : ∀ (X : simplicial_object C), is_iso (Γ₂N₁.nat_trans.app X), + { intro X, + rw compatibility_Γ₂N₁_Γ₂N₂_nat_trans, + apply_instance, }, + apply nat_iso.is_iso_of_is_iso_app, +end + +/-- The unit isomorphism of the Dold-Kan equivalence. -/ +@[simp] +def Γ₂N₂ : 𝟭 _ ≅ (N₂ : karoubi (simplicial_object C) ⥤ _) ⋙ Γ₂ := +(as_iso Γ₂N₂.nat_trans).symm + +/-- The natural isomorphism `to_karoubi (simplicial_object C) ≅ N₁ ⋙ Γ₂`. -/ +@[simps] +def Γ₂N₁ : to_karoubi _ ≅ (N₁ : simplicial_object C ⥤ _) ⋙ Γ₂ := +(as_iso Γ₂N₁.nat_trans).symm + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/n_reflects_iso.lean b/src/algebraic_topology/dold_kan/n_reflects_iso.lean new file mode 100644 index 0000000000000..10541d6b39f98 --- /dev/null +++ b/src/algebraic_topology/dold_kan/n_reflects_iso.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.functor_n +import algebraic_topology.dold_kan.decomposition +import category_theory.idempotents.homological_complex +import category_theory.idempotents.karoubi_karoubi + +/-! + +# N₁ and N₂ reflects isomorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, it is shown that the functors +`N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)` and +`N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ))` +reflect isomorphisms for any preadditive category `C`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory +open category_theory.category +open category_theory.idempotents +open opposite +open_locale simplicial + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] + +open morph_components + +instance : reflects_isomorphisms (N₁ : simplicial_object C ⥤ karoubi (chain_complex C ℕ)) := +⟨λ X Y f, begin + introI, + /- restating the result in a way that allows induction on the degree n -/ + suffices : ∀ (n : ℕ), is_iso (f.app (op [n])), + { haveI : ∀ (Δ : simplex_categoryᵒᵖ), is_iso (f.app Δ) := λ Δ, this Δ.unop.len, + apply nat_iso.is_iso_of_is_iso_app, }, + /- restating the assumption in a more practical form -/ + have h₁ := homological_complex.congr_hom (karoubi.hom_ext.mp (is_iso.hom_inv_id (N₁.map f))), + have h₂ := homological_complex.congr_hom (karoubi.hom_ext.mp (is_iso.inv_hom_id (N₁.map f))), + have h₃ := λ n, karoubi.homological_complex.p_comm_f_assoc (inv (N₁.map f)) (n) (f.app (op [n])), + simp only [N₁_map_f, karoubi.comp_f, homological_complex.comp_f, + alternating_face_map_complex.map_f, N₁_obj_p, karoubi.id_eq, assoc] at h₁ h₂ h₃, + /- we have to construct an inverse to f in degree n, by induction on n -/ + intro n, + induction n with n hn, + /- degree 0 -/ + { use (inv (N₁.map f)).f.f 0, + have h₁₀ := h₁ 0, + have h₂₀ := h₂ 0, + dsimp at h₁₀ h₂₀, + simp only [id_comp, comp_id] at h₁₀ h₂₀, + tauto, }, + /- induction step -/ + { haveI := hn, + use φ + { a := P_infty.f (n+1) ≫ (inv (N₁.map f)).f.f (n+1), + b := λ i, inv (f.app (op [n])) ≫ X.σ i, }, + simp only [morph_components.id, ← id_φ, ← pre_comp_φ, pre_comp, ← post_comp_φ, + post_comp, P_infty_f_naturality_assoc, is_iso.hom_inv_id_assoc, assoc, + is_iso.inv_hom_id_assoc, simplicial_object.σ_naturality, h₁, h₂, h₃], + tauto, }, +end⟩ + +lemma compatibility_N₂_N₁_karoubi : + N₂ ⋙ (karoubi_chain_complex_equivalence C ℕ).functor = + karoubi_functor_category_embedding simplex_categoryᵒᵖ C ⋙ N₁ ⋙ + (karoubi_chain_complex_equivalence (karoubi C) ℕ).functor ⋙ + functor.map_homological_complex (karoubi_karoubi.equivalence C).inverse _ := +begin + refine category_theory.functor.ext (λ P, _) (λ P Q f, _), + { refine homological_complex.ext _ _, + { ext n, + { dsimp, + simp only [karoubi_P_infty_f, comp_id, P_infty_f_naturality, id_comp], }, + { refl, }, }, + { rintros _ n (rfl : n+1 = _), + ext, + have h := (alternating_face_map_complex.map P.p).comm (n+1) n, + dsimp [N₂, karoubi_chain_complex_equivalence, karoubi_karoubi.inverse, + karoubi_homological_complex_equivalence.functor.obj] at ⊢ h, + simp only [karoubi.comp_f, assoc, karoubi.eq_to_hom_f, eq_to_hom_refl, id_comp, comp_id, + karoubi_alternating_face_map_complex_d, karoubi_P_infty_f, + ← homological_complex.hom.comm_assoc, ← h, app_idem_assoc], }, }, + { ext n, + dsimp [karoubi_karoubi.inverse, karoubi_functor_category_embedding, + karoubi_functor_category_embedding.map], + simp only [karoubi.comp_f, karoubi_P_infty_f, homological_complex.eq_to_hom_f, + karoubi.eq_to_hom_f, assoc, comp_id, P_infty_f_naturality, app_p_comp, + karoubi_chain_complex_equivalence_functor_obj_X_p, N₂_obj_p_f, eq_to_hom_refl, + P_infty_f_naturality_assoc, app_comp_p, P_infty_f_idem_assoc], }, +end + +/-- We deduce that `N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ))` +reflects isomorphisms from the fact that +`N₁ : simplicial_object (karoubi C) ⥤ karoubi (chain_complex (karoubi C) ℕ)` does. -/ +instance : reflects_isomorphisms + (N₂ : karoubi (simplicial_object C) ⥤ karoubi (chain_complex C ℕ)) := ⟨λ X Y f, +begin + introI, + -- The following functor `F` reflects isomorphism because it is + -- a composition of four functors which reflects isomorphisms. + -- Then, it suffices to show that `F.map f` is an isomorphism. + let F := karoubi_functor_category_embedding simplex_categoryᵒᵖ C ⋙ N₁ ⋙ + (karoubi_chain_complex_equivalence (karoubi C) ℕ).functor ⋙ + functor.map_homological_complex (karoubi_karoubi.equivalence C).inverse + (complex_shape.down ℕ), + haveI : is_iso (F.map f), + { dsimp only [F], + rw [← compatibility_N₂_N₁_karoubi, functor.comp_map], + apply functor.map_is_iso, }, + exact is_iso_of_reflects_iso f F, +end⟩ + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/normalized.lean b/src/algebraic_topology/dold_kan/normalized.lean new file mode 100644 index 0000000000000..d01fa53ec4cd0 --- /dev/null +++ b/src/algebraic_topology/dold_kan/normalized.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.functor_n + +/-! + +# Comparison with the normalized Moore complex functor + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +TODO (@joelriou) continue adding the various files referenced below + +In this file, we show that when the category `A` is abelian, +there is an isomorphism `N₁_iso_normalized_Moore_complex_comp_to_karoubi` between +the functor `N₁ : simplicial_object A ⥤ karoubi (chain_complex A ℕ)` +defined in `functor_n.lean` and the composition of +`normalized_Moore_complex A` with the inclusion +`chain_complex A ℕ ⥤ karoubi (chain_complex A ℕ)`. + +This isomorphism shall be used in `equivalence.lean` in order to obtain +the Dold-Kan equivalence +`category_theory.abelian.dold_kan.equivalence : simplicial_object A ≌ chain_complex A ℕ` +with a functor (definitionally) equal to `normalized_Moore_complex A`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory category_theory.category category_theory.limits + category_theory.subobject category_theory.idempotents +open_locale dold_kan + +noncomputable theory + +namespace algebraic_topology + +namespace dold_kan + +universe v + +variables {A : Type*} [category A] [abelian A] {X : simplicial_object A} + +lemma higher_faces_vanish.inclusion_of_Moore_complex_map (n : ℕ) : + higher_faces_vanish (n+1) ((inclusion_of_Moore_complex_map X).f (n+1)) := λ j hj, +begin + dsimp [inclusion_of_Moore_complex_map], + rw [← factor_thru_arrow _ _ (finset_inf_arrow_factors finset.univ + _ j (by simp only [finset.mem_univ])), assoc, kernel_subobject_arrow_comp, comp_zero], +end + +lemma factors_normalized_Moore_complex_P_infty (n : ℕ) : + subobject.factors (normalized_Moore_complex.obj_X X n) (P_infty.f n) := +begin + cases n, + { apply top_factors, }, + { rw [P_infty_f, normalized_Moore_complex.obj_X, finset_inf_factors], + intros i hi, + apply kernel_subobject_factors, + exact (higher_faces_vanish.of_P (n+1) n) i (le_add_self), } +end + +/-- P_infty factors through the normalized Moore complex -/ +@[simps] +def P_infty_to_normalized_Moore_complex (X : simplicial_object A) : K[X] ⟶ N[X] := +chain_complex.of_hom _ _ _ _ _ _ + (λ n, factor_thru _ _ (factors_normalized_Moore_complex_P_infty n)) + (λ n, begin + rw [← cancel_mono (normalized_Moore_complex.obj_X X n).arrow, assoc, assoc, + factor_thru_arrow, ← inclusion_of_Moore_complex_map_f, + ← normalized_Moore_complex_obj_d, ← (inclusion_of_Moore_complex_map X).comm' (n+1) n rfl, + inclusion_of_Moore_complex_map_f, factor_thru_arrow_assoc, + ← alternating_face_map_complex_obj_d], + exact P_infty.comm' (n+1) n rfl, + end) + +@[simp, reassoc] +lemma P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map + (X : simplicial_object A) : + P_infty_to_normalized_Moore_complex X ≫ inclusion_of_Moore_complex_map X = P_infty := by tidy + +@[simp, reassoc] +lemma P_infty_to_normalized_Moore_complex_naturality {X Y : simplicial_object A} (f : X ⟶ Y) : + alternating_face_map_complex.map f ≫ P_infty_to_normalized_Moore_complex Y = + P_infty_to_normalized_Moore_complex X ≫ normalized_Moore_complex.map f := by tidy + +@[simp, reassoc] +lemma P_infty_comp_P_infty_to_normalized_Moore_complex (X : simplicial_object A) : + P_infty ≫ P_infty_to_normalized_Moore_complex X = P_infty_to_normalized_Moore_complex X := +by tidy + +@[simp, reassoc] +lemma inclusion_of_Moore_complex_map_comp_P_infty (X : simplicial_object A) : + inclusion_of_Moore_complex_map X ≫ P_infty = inclusion_of_Moore_complex_map X := +begin + ext n, + cases n, + { dsimp, simp only [comp_id], }, + { exact (higher_faces_vanish.inclusion_of_Moore_complex_map n).comp_P_eq_self, }, +end + +instance : mono (inclusion_of_Moore_complex_map X) := +⟨λ Y f₁ f₂ hf, by { ext n, exact homological_complex.congr_hom hf n, }⟩ + +/-- `inclusion_of_Moore_complex_map X` is a split mono. -/ +def split_mono_inclusion_of_Moore_complex_map (X : simplicial_object A) : + split_mono (inclusion_of_Moore_complex_map X) := +{ retraction := P_infty_to_normalized_Moore_complex X, + id' := by simp only [← cancel_mono (inclusion_of_Moore_complex_map X), assoc, id_comp, + P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map, + inclusion_of_Moore_complex_map_comp_P_infty], } + +variable (A) + +/-- When the category `A` is abelian, +the functor `N₁ : simplicial_object A ⥤ karoubi (chain_complex A ℕ)` defined +using `P_infty` identifies to the composition of the normalized Moore complex functor +and the inclusion in the Karoubi envelope. -/ +def N₁_iso_normalized_Moore_complex_comp_to_karoubi : + N₁ ≅ (normalized_Moore_complex A ⋙ to_karoubi _) := +{ hom := + { app := λ X, + { f := P_infty_to_normalized_Moore_complex X, + comm := by erw [comp_id, P_infty_comp_P_infty_to_normalized_Moore_complex] }, + naturality' := λ X Y f, by simp only [functor.comp_map, normalized_Moore_complex_map, + P_infty_to_normalized_Moore_complex_naturality, karoubi.hom_ext, karoubi.comp_f, N₁_map_f, + P_infty_comp_P_infty_to_normalized_Moore_complex_assoc, to_karoubi_map_f, assoc] }, + inv := + { app := λ X, + { f := inclusion_of_Moore_complex_map X, + comm := by erw [inclusion_of_Moore_complex_map_comp_P_infty, id_comp] }, + naturality' := λ X Y f, by { ext, simp only [functor.comp_map, normalized_Moore_complex_map, + karoubi.comp_f, to_karoubi_map_f, homological_complex.comp_f, normalized_Moore_complex.map_f, + inclusion_of_Moore_complex_map_f, factor_thru_arrow, N₁_map_f, + inclusion_of_Moore_complex_map_comp_P_infty_assoc, alternating_face_map_complex.map_f] } }, + hom_inv_id' := begin + ext X : 3, + simp only [P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map, + nat_trans.comp_app, karoubi.comp_f, N₁_obj_p, nat_trans.id_app, karoubi.id_eq], + end, + inv_hom_id' := begin + ext X : 3, + simp only [← cancel_mono (inclusion_of_Moore_complex_map X), + nat_trans.comp_app, karoubi.comp_f, assoc, nat_trans.id_app, karoubi.id_eq, + P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map, + inclusion_of_Moore_complex_map_comp_P_infty], + dsimp only [functor.comp_obj, to_karoubi], + rw id_comp, + end } + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/notations.lean b/src/algebraic_topology/dold_kan/notations.lean index e7194e9cf2bd8..3276ab335e94a 100644 --- a/src/algebraic_topology/dold_kan/notations.lean +++ b/src/algebraic_topology/dold_kan/notations.lean @@ -10,11 +10,18 @@ import algebraic_topology.alternating_face_map_complex # Notations for the Dold-Kan equivalence +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the notation `K[X] : chain_complex C ℕ` for the alternating face map complex of `(X : simplicial_object C)` where `C` is a preadditive category, as well as `N[X]` for the normalized subcomplex in the case `C` is an abelian category. +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + -/ -localized "notation `K[`X`]` := algebraic_topology.alternating_face_map_complex.obj X" in dold_kan -localized "notation `N[`X`]` := algebraic_topology.normalized_Moore_complex.obj X" in dold_kan +localized "notation (name := alternating_face_map_complex) `K[`X`]` := + algebraic_topology.alternating_face_map_complex.obj X" in dold_kan +localized "notation (name := normalized_Moore_complex) `N[`X`]` := + algebraic_topology.normalized_Moore_complex.obj X" in dold_kan diff --git a/src/algebraic_topology/dold_kan/p_infty.lean b/src/algebraic_topology/dold_kan/p_infty.lean new file mode 100644 index 0000000000000..7b1c539dca8bf --- /dev/null +++ b/src/algebraic_topology/dold_kan/p_infty.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.projections +import category_theory.idempotents.functor_categories +import category_theory.idempotents.functor_extension + +/-! + +# Construction of the projection `P_infty` for the Dold-Kan correspondence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +TODO (@joelriou) continue adding the various files referenced below + +In this file, we construct the projection `P_infty : K[X] ⟶ K[X]` by passing +to the limit the projections `P q` defined in `projections.lean`. This +projection is a critical tool in this formalisation of the Dold-Kan correspondence, +because in the case of abelian categories, `P_infty` corresponds to the +projection on the normalized Moore subcomplex, with kernel the degenerate subcomplex. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory +open category_theory.category +open category_theory.preadditive +open category_theory.simplicial_object +open category_theory.idempotents +open opposite +open_locale simplicial dold_kan + +noncomputable theory + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] {X : simplicial_object C} + +lemma P_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) : + ((P (q+1)).f n : X _[n] ⟶ _ ) = (P q).f n := +begin + cases n, + { simp only [P_f_0_eq], }, + { unfold P, + simp only [add_right_eq_self, comp_add, homological_complex.comp_f, + homological_complex.add_f_apply, comp_id], + exact (higher_faces_vanish.of_P q n).comp_Hσ_eq_zero + (nat.succ_le_iff.mp hqn), }, +end + +lemma Q_is_eventually_constant {q n : ℕ} (hqn : n ≤ q) : + ((Q (q+1)).f n : X _[n] ⟶ _ ) = (Q q).f n := +by simp only [Q, homological_complex.sub_f_apply, P_is_eventually_constant hqn] + +/-- The endomorphism `P_infty : K[X] ⟶ K[X]` obtained from the `P q` by passing to the limit. -/ +def P_infty : K[X] ⟶ K[X] := chain_complex.of_hom _ _ _ _ _ _ + (λ n, ((P n).f n : X _[n] ⟶ _ )) + (λ n, by simpa only [← P_is_eventually_constant (show n ≤ n, by refl), + alternating_face_map_complex.obj_d_eq] using (P (n+1)).comm (n+1) n) + +/-- The endomorphism `Q_infty : K[X] ⟶ K[X]` obtained from the `Q q` by passing to the limit. -/ +def Q_infty : K[X] ⟶ K[X] := 𝟙 _ - P_infty + +@[simp] +lemma P_infty_f_0 : (P_infty.f 0 : X _[0] ⟶ X _[0]) = 𝟙 _ := rfl + +lemma P_infty_f (n : ℕ) : (P_infty.f n : X _[n] ⟶ X _[n] ) = (P n).f n := rfl + +@[simp] +lemma Q_infty_f_0 : (Q_infty.f 0 : X _[0] ⟶ X _[0]) = 0 := +by { dsimp [Q_infty], simp only [sub_self], } + +lemma Q_infty_f (n : ℕ) : (Q_infty.f n : X _[n] ⟶ X _[n] ) = (Q n).f n := rfl + +@[simp, reassoc] +lemma P_infty_f_naturality (n : ℕ) {X Y : simplicial_object C} (f : X ⟶ Y) : + f.app (op [n]) ≫ P_infty.f n = P_infty.f n ≫ f.app (op [n]) := +P_f_naturality n n f + +@[simp, reassoc] +lemma Q_infty_f_naturality (n : ℕ) {X Y : simplicial_object C} (f : X ⟶ Y) : + f.app (op [n]) ≫ Q_infty.f n = Q_infty.f n ≫ f.app (op [n]) := +Q_f_naturality n n f + +@[simp, reassoc] +lemma P_infty_f_idem (n : ℕ) : + (P_infty.f n : X _[n] ⟶ _) ≫ (P_infty.f n) = P_infty.f n := +by simp only [P_infty_f, P_f_idem] + +@[simp, reassoc] +lemma P_infty_idem : (P_infty : K[X] ⟶ _) ≫ P_infty = P_infty := +by { ext n, exact P_infty_f_idem n, } + +@[simp, reassoc] +lemma Q_infty_f_idem (n : ℕ) : + (Q_infty.f n : X _[n] ⟶ _) ≫ (Q_infty.f n) = Q_infty.f n := +Q_f_idem _ _ + +@[simp, reassoc] +lemma Q_infty_idem : (Q_infty : K[X] ⟶ _) ≫ Q_infty = Q_infty := +by { ext n, exact Q_infty_f_idem n, } + +@[simp, reassoc] +lemma P_infty_f_comp_Q_infty_f (n : ℕ) : + (P_infty.f n : X _[n] ⟶ _) ≫ Q_infty.f n = 0 := +begin + dsimp only [Q_infty], + simp only [homological_complex.sub_f_apply, homological_complex.id_f, comp_sub, comp_id, + P_infty_f_idem, sub_self], +end + +@[simp, reassoc] +lemma P_infty_comp_Q_infty : + (P_infty : K[X] ⟶ _) ≫ Q_infty = 0 := +by { ext n, apply P_infty_f_comp_Q_infty_f, } + +@[simp, reassoc] +lemma Q_infty_f_comp_P_infty_f (n : ℕ) : + (Q_infty.f n : X _[n] ⟶ _) ≫ P_infty.f n = 0 := +begin + dsimp only [Q_infty], + simp only [homological_complex.sub_f_apply, homological_complex.id_f, sub_comp, id_comp, + P_infty_f_idem, sub_self], +end + +@[simp, reassoc] +lemma Q_infty_comp_P_infty : + (Q_infty : K[X] ⟶ _) ≫ P_infty = 0 := +by { ext n, apply Q_infty_f_comp_P_infty_f, } + +@[simp] +lemma P_infty_add_Q_infty : + (P_infty : K[X] ⟶ _) + Q_infty = 𝟙 _ := +by { dsimp only [Q_infty], simp only [add_sub_cancel'_right], } + +lemma P_infty_f_add_Q_infty_f (n : ℕ) : + (P_infty.f n : X _[n] ⟶ _ ) + Q_infty.f n = 𝟙 _ := +homological_complex.congr_hom (P_infty_add_Q_infty) n + +variable (C) + +/-- `P_infty` induces a natural transformation, i.e. an endomorphism of +the functor `alternating_face_map_complex C`. -/ +@[simps] +def nat_trans_P_infty : + alternating_face_map_complex C ⟶ alternating_face_map_complex C := +{ app := λ _, P_infty, + naturality' := λ X Y f, by { ext n, exact P_infty_f_naturality n f, }, } + +/-- The natural transformation in each degree that is induced by `nat_trans_P_infty`. -/ +@[simps] +def nat_trans_P_infty_f (n : ℕ) := +nat_trans_P_infty C ◫ 𝟙 (homological_complex.eval _ _ n) + +variable {C} + +@[simp] +lemma map_P_infty_f {D : Type*} [category D] [preadditive D] + (G : C ⥤ D) [G.additive] (X : simplicial_object C) (n : ℕ) : + (P_infty : K[((whiskering C D).obj G).obj X] ⟶ _).f n = + G.map ((P_infty : alternating_face_map_complex.obj X ⟶ _).f n) := +by simp only [P_infty_f, map_P] + +/-- Given an object `Y : karoubi (simplicial_object C)`, this lemma +computes `P_infty` for the associated object in `simplicial_object (karoubi C)` +in terms of `P_infty` for `Y.X : simplicial_object C` and `Y.p`. -/ +lemma karoubi_P_infty_f {Y : karoubi (simplicial_object C)} (n : ℕ) : + ((P_infty : K[(karoubi_functor_category_embedding _ _).obj Y] ⟶ _).f n).f = + Y.p.app (op [n]) ≫ (P_infty : K[Y.X] ⟶ _).f n := +begin + -- We introduce P_infty endomorphisms P₁, P₂, P₃, P₄ on various objects Y₁, Y₂, Y₃, Y₄. + let Y₁ := (karoubi_functor_category_embedding _ _).obj Y, + let Y₂ := Y.X, + let Y₃ := (((whiskering _ _).obj (to_karoubi C)).obj Y.X), + let Y₄ := (karoubi_functor_category_embedding _ _).obj ((to_karoubi _).obj Y.X), + let P₁ : K[Y₁] ⟶ _ := P_infty, + let P₂ : K[Y₂] ⟶ _ := P_infty, + let P₃ : K[Y₃] ⟶ _ := P_infty, + let P₄ : K[Y₄] ⟶ _ := P_infty, + -- The statement of lemma relates P₁ and P₂. + change (P₁.f n).f = Y.p.app (op [n]) ≫ P₂.f n, + -- The proof proceeds by obtaining relations h₃₂, h₄₃, h₁₄. + have h₃₂ : (P₃.f n).f = P₂.f n := karoubi.hom_ext.mp (map_P_infty_f (to_karoubi C) Y₂ n), + have h₄₃ : P₄.f n = P₃.f n, + { have h := functor.congr_obj (to_karoubi_comp_karoubi_functor_category_embedding _ _) Y₂, + simp only [← nat_trans_P_infty_f_app], + congr', }, + let τ₁ := 𝟙 (karoubi_functor_category_embedding (simplex_categoryᵒᵖ) C), + let τ₂ := nat_trans_P_infty_f (karoubi C) n, + let τ := τ₁ ◫ τ₂, + have h₁₄ := idempotents.nat_trans_eq τ Y, + dsimp [τ, τ₁, τ₂, nat_trans_P_infty_f] at h₁₄, + rw [id_comp, id_comp, comp_id, comp_id] at h₁₄, + /- We use the three equalities h₃₂, h₄₃, h₁₄. -/ + rw [← h₃₂, ← h₄₃, h₁₄], + simp only [karoubi_functor_category_embedding.map_app_f, karoubi.decomp_id_p_f, + karoubi.decomp_id_i_f, karoubi.comp_f], + let π : Y₄ ⟶ Y₄ := (to_karoubi _ ⋙ karoubi_functor_category_embedding _ _).map Y.p, + have eq := karoubi.hom_ext.mp (P_infty_f_naturality n π), + simp only [karoubi.comp_f] at eq, + dsimp [π] at eq, + rw [← eq, reassoc_of (app_idem Y (op [n]))], +end + +end dold_kan + +end algebraic_topology diff --git a/src/algebraic_topology/dold_kan/projections.lean b/src/algebraic_topology/dold_kan/projections.lean new file mode 100644 index 0000000000000..4b9ea21fdc872 --- /dev/null +++ b/src/algebraic_topology/dold_kan/projections.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.dold_kan.faces +import category_theory.idempotents.basic + +/-! + +# Construction of projections for the Dold-Kan correspondence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +TODO (@joelriou) continue adding the various files referenced below + +In this file, we construct endomorphisms `P q : K[X] ⟶ K[X]` for all +`q : ℕ`. We study how they behave with respect to face maps with the lemmas +`higher_faces_vanish.of_P`, `higher_faces_vanish.comp_P_eq_self` and +`comp_P_eq_self_iff`. + +Then, we show that they are projections (see `P_f_idem` +and `P_idem`). They are natural transformations (see `nat_trans_P` +and `P_f_naturality`) and are compatible with the application +of additive functors (see `map_P`). + +By passing to the limit, these endomorphisms `P q` shall be used in `p_infty.lean` +in order to define `P_infty : K[X] ⟶ K[X]`, see `equivalence.lean` for the general +strategy of proof of the Dold-Kan equivalence. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +open category_theory category_theory.category category_theory.limits + category_theory.preadditive category_theory.simplicial_object opposite + category_theory.idempotents +open_locale simplicial dold_kan + +noncomputable theory + +namespace algebraic_topology + +namespace dold_kan + +variables {C : Type*} [category C] [preadditive C] {X : simplicial_object C} + +/-- This is the inductive definition of the projections `P q : K[X] ⟶ K[X]`, +with `P 0 := 𝟙 _` and `P (q+1) := P q ≫ (𝟙 _ + Hσ q)`. -/ +noncomputable def P : ℕ → (K[X] ⟶ K[X]) +| 0 := 𝟙 _ +| (q+1) := P q ≫ (𝟙 _ + Hσ q) + +/-- All the `P q` coincide with `𝟙 _` in degree 0. -/ +@[simp] +lemma P_f_0_eq (q : ℕ) : ((P q).f 0 : X _[0] ⟶ X _[0]) = 𝟙 _ := +begin + induction q with q hq, + { refl, }, + { unfold P, + simp only [homological_complex.add_f_apply, homological_complex.comp_f, + homological_complex.id_f, id_comp, hq, Hσ_eq_zero, add_zero], }, +end + +/-- `Q q` is the complement projection associated to `P q` -/ +def Q (q : ℕ) : K[X] ⟶ K[X] := 𝟙 _ - P q + +lemma P_add_Q (q : ℕ) : P q + Q q = 𝟙 K[X] := by { rw Q, abel, } + +lemma P_add_Q_f (q n : ℕ) : (P q).f n + (Q q).f n = 𝟙 (X _[n]) := +homological_complex.congr_hom (P_add_Q q) n + +@[simp] +lemma Q_eq_zero : (Q 0 : K[X] ⟶ _) = 0 := sub_self _ + +lemma Q_eq (q : ℕ) : (Q (q+1) : K[X] ⟶ _) = Q q - P q ≫ Hσ q := +by { unfold Q P, simp only [comp_add, comp_id], abel, } + +/-- All the `Q q` coincide with `0` in degree 0. -/ +@[simp] +lemma Q_f_0_eq (q : ℕ) : ((Q q).f 0 : X _[0] ⟶ X _[0]) = 0 := +by simp only [homological_complex.sub_f_apply, homological_complex.id_f, Q, P_f_0_eq, sub_self] + +namespace higher_faces_vanish + +/-- This lemma expresses the vanishing of +`(P q).f (n+1) ≫ X.δ k : X _[n+1] ⟶ X _[n]` when `k≠0` and `k≥n-q+2` -/ +lemma of_P : Π (q n : ℕ), higher_faces_vanish q (((P q).f (n+1) : X _[n+1] ⟶ X _[n+1])) +| 0 := λ n j hj₁, by { exfalso, have hj₂ := fin.is_lt j, linarith, } +| (q+1) := λ n, by { unfold P, exact (of_P q n).induction, } + +@[reassoc] +lemma comp_P_eq_self {Y : C} {n q : ℕ} {φ : Y ⟶ X _[n+1]} + (v : higher_faces_vanish q φ) : φ ≫ (P q).f (n+1) = φ := +begin + induction q with q hq, + { unfold P, + apply comp_id, }, + { unfold P, + simp only [comp_add, homological_complex.comp_f, homological_complex.add_f_apply, + comp_id, ← assoc, hq v.of_succ, add_right_eq_self], + by_cases hqn : n THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define a functor `nondeg_complex : simplicial_object.split C ⥤ chain_complex C ℕ` +when `C` is a preadditive category with finite coproducts, and get an isomorphism +`to_karoubi_nondeg_complex_iso_N₁ : nondeg_complex ⋙ to_karoubi _ ≅ forget C ⋙ dold_kan.N₁`. + +(See `equivalence.lean` for the general strategy of proof of the Dold-Kan equivalence.) + +-/ + +noncomputable theory + +open category_theory category_theory.limits category_theory.category + category_theory.preadditive category_theory.idempotents opposite + algebraic_topology algebraic_topology.dold_kan + +open_locale big_operators simplicial dold_kan + +namespace simplicial_object + +namespace splitting + +variables {C : Type*} [category C] [has_finite_coproducts C] + {X : simplicial_object C} (s : splitting X) + +/-- The projection on a summand of the coproduct decomposition given +by a splitting of a simplicial object. -/ +def π_summand [has_zero_morphisms C] {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) : + X.obj Δ ⟶ s.N A.1.unop.len := +begin + refine (s.iso Δ).inv ≫ sigma.desc (λ B, _), + by_cases B = A, + { exact eq_to_hom (by { subst h, refl, }), }, + { exact 0, }, +end + +@[simp, reassoc] +lemma ι_π_summand_eq_id [has_zero_morphisms C] {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) : + s.ι_summand A ≫ s.π_summand A = 𝟙 _ := +begin + dsimp [ι_summand, π_summand], + simp only [summand, assoc, is_iso.hom_inv_id_assoc], + erw [colimit.ι_desc, cofan.mk_ι_app], + dsimp, + simp only [eq_self_iff_true, if_true], +end + +@[simp, reassoc] +lemma ι_π_summand_eq_zero [has_zero_morphisms C] {Δ : simplex_categoryᵒᵖ} (A B : index_set Δ) + (h : B ≠ A) : s.ι_summand A ≫ s.π_summand B = 0 := +begin + dsimp [ι_summand, π_summand], + simp only [summand, assoc, is_iso.hom_inv_id_assoc], + erw [colimit.ι_desc, cofan.mk_ι_app], + apply dif_neg, + exact h.symm, +end + +variable [preadditive C] + +lemma decomposition_id (Δ : simplex_categoryᵒᵖ) : + 𝟙 (X.obj Δ) = ∑ (A : index_set Δ), s.π_summand A ≫ s.ι_summand A := +begin + apply s.hom_ext', + intro A, + rw [comp_id, comp_sum, finset.sum_eq_single A, ι_π_summand_eq_id_assoc], + { intros B h₁ h₂, + rw [s.ι_π_summand_eq_zero_assoc _ _ h₂, zero_comp], }, + { simp only [finset.mem_univ, not_true, is_empty.forall_iff], }, +end + +@[simp, reassoc] +lemma σ_comp_π_summand_id_eq_zero {n : ℕ} (i : fin (n+1)) : + X.σ i ≫ s.π_summand (index_set.id (op [n+1])) = 0 := +begin + apply s.hom_ext', + intro A, + dsimp only [simplicial_object.σ], + rw [comp_zero, s.ι_summand_epi_naturality_assoc A (simplex_category.σ i).op, + ι_π_summand_eq_zero], + symmetry, + change ¬ (A.epi_comp (simplex_category.σ i).op).eq_id, + rw index_set.eq_id_iff_len_eq, + have h := simplex_category.len_le_of_epi (infer_instance : epi A.e), + dsimp at ⊢ h, + linarith, +end + +/-- If a simplicial object `X` in an additive category is split, +then `P_infty` vanishes on all the summands of `X _[n]` which do +not correspond to the identity of `[n]`. -/ +lemma ι_summand_comp_P_infty_eq_zero {X : simplicial_object C} + (s : simplicial_object.splitting X) + {n : ℕ} (A : simplicial_object.splitting.index_set (op [n])) + (hA : ¬ A.eq_id) : + s.ι_summand A ≫ P_infty.f n = 0 := +begin + rw simplicial_object.splitting.index_set.eq_id_iff_mono at hA, + rw [simplicial_object.splitting.ι_summand_eq, assoc, + degeneracy_comp_P_infty X n A.e hA, comp_zero], +end + +lemma comp_P_infty_eq_zero_iff {Z : C} {n : ℕ} (f : Z ⟶ X _[n]) : + f ≫ P_infty.f n = 0 ↔ f ≫ s.π_summand (index_set.id (op [n])) = 0 := +begin + split, + { intro h, + cases n, + { dsimp at h, + rw [comp_id] at h, + rw [h, zero_comp], }, + { have h' := f ≫= P_infty_f_add_Q_infty_f (n+1), + dsimp at h', + rw [comp_id, comp_add, h, zero_add] at h', + rw [← h', assoc, Q_infty_f, decomposition_Q, preadditive.sum_comp, + preadditive.comp_sum, finset.sum_eq_zero], + intros i hi, + simp only [assoc, σ_comp_π_summand_id_eq_zero, comp_zero], }, }, + { intro h, + rw [← comp_id f, assoc, s.decomposition_id, preadditive.sum_comp, + preadditive.comp_sum, fintype.sum_eq_zero], + intro A, + by_cases hA : A.eq_id, + { dsimp at hA, + subst hA, + rw [assoc, reassoc_of h, zero_comp], }, + { simp only [assoc, s.ι_summand_comp_P_infty_eq_zero A hA, comp_zero], }, }, +end + +@[simp, reassoc] +lemma P_infty_comp_π_summand_id (n : ℕ) : + P_infty.f n ≫ s.π_summand (index_set.id (op [n])) = s.π_summand (index_set.id (op [n])) := +begin + conv_rhs { rw ← id_comp (s.π_summand _), }, + symmetry, + rw [← sub_eq_zero, ← sub_comp, ← comp_P_infty_eq_zero_iff, sub_comp, id_comp, + P_infty_f_idem, sub_self], +end + +@[simp, reassoc] +lemma π_summand_comp_ι_summand_comp_P_infty_eq_P_infty (n : ℕ) : + s.π_summand (index_set.id (op [n])) ≫ s.ι_summand (index_set.id (op [n])) ≫ P_infty.f n = + P_infty.f n := +begin + conv_rhs { rw ← id_comp (P_infty.f n), }, + erw [s.decomposition_id, preadditive.sum_comp], + rw [fintype.sum_eq_single (index_set.id (op [n])), assoc], + rintros A (hA : ¬A.eq_id), + rw [assoc, s.ι_summand_comp_P_infty_eq_zero A hA, comp_zero], +end + +/-- The differentials `s.d i j : s.N i ⟶ s.N j` on nondegenerate simplices of a split +simplicial object are induced by the differentials on the alternating face map complex. -/ +@[simp] +def d (i j : ℕ) : s.N i ⟶ s.N j := +s.ι_summand (index_set.id (op [i])) ≫ K[X].d i j ≫ s.π_summand (index_set.id (op [j])) + +lemma ι_summand_comp_d_comp_π_summand_eq_zero (j k : ℕ) (A : index_set (op [j])) (hA : ¬A.eq_id) : + s.ι_summand A ≫ K[X].d j k ≫ s.π_summand (index_set.id (op [k])) = 0 := +begin + rw A.eq_id_iff_mono at hA, + rw [← assoc, ← s.comp_P_infty_eq_zero_iff, assoc, ← P_infty.comm j k, s.ι_summand_eq, assoc, + degeneracy_comp_P_infty_assoc X j A.e hA, zero_comp, comp_zero], +end + +/-- If `s` is a splitting of a simplicial object `X` in a preadditive category, +`s.nondeg_complex` is a chain complex which is given in degree `n` by +the nondegenerate `n`-simplices of `X`. -/ +@[simps] +def nondeg_complex : chain_complex C ℕ := +{ X := s.N, + d := s.d, + shape' := λ i j hij, by simp only [d, K[X].shape i j hij, zero_comp, comp_zero], + d_comp_d' := λ i j k hij hjk, begin + simp only [d, assoc], + have eq : K[X].d i j ≫ 𝟙 (X.obj (op [j])) ≫ K[X].d j k ≫ + s.π_summand (index_set.id (op [k])) = 0 := + by erw [id_comp, homological_complex.d_comp_d_assoc, zero_comp], + rw s.decomposition_id at eq, + classical, + rw [fintype.sum_eq_add_sum_compl (index_set.id (op [j])), add_comp, comp_add, assoc, + preadditive.sum_comp, preadditive.comp_sum, finset.sum_eq_zero, add_zero] at eq, swap, + { intros A hA, + simp only [finset.mem_compl, finset.mem_singleton] at hA, + simp only [assoc, ι_summand_comp_d_comp_π_summand_eq_zero _ _ _ _ hA, comp_zero], }, + rw [eq, comp_zero], + end } + +/-- The chain complex `s.nondeg_complex` attached to a splitting of a simplicial object `X` +becomes isomorphic to the normalized Moore complex `N₁.obj X` defined as a formal direct +factor in the category `karoubi (chain_complex C ℕ)`. -/ +@[simps] +def to_karoubi_nondeg_complex_iso_N₁ : (to_karoubi _).obj s.nondeg_complex ≅ N₁.obj X := +{ hom := + { f := + { f := λ n, s.ι_summand (index_set.id (op [n])) ≫ P_infty.f n, + comm' := λ i j hij, begin + dsimp, + rw [assoc, assoc, assoc, π_summand_comp_ι_summand_comp_P_infty_eq_P_infty, + homological_complex.hom.comm], + end, }, + comm := by { ext n, dsimp, rw [id_comp, assoc, P_infty_f_idem], }, }, + inv := + { f := + { f := λ n, s.π_summand (index_set.id (op [n])), + comm' := λ i j hij, begin + dsimp, + slice_rhs 1 1 { rw ← id_comp (K[X].d i j), }, + erw s.decomposition_id, + rw [sum_comp, sum_comp, finset.sum_eq_single (index_set.id (op [i])), assoc, assoc], + { intros A h hA, + simp only [assoc, s.ι_summand_comp_d_comp_π_summand_eq_zero _ _ _ hA, comp_zero], }, + { simp only [finset.mem_univ, not_true, is_empty.forall_iff], }, + end, }, + comm := by { ext n, dsimp, simp only [comp_id, P_infty_comp_π_summand_id], }, }, + hom_inv_id' := begin + ext n, + simpa only [assoc, P_infty_comp_π_summand_id, karoubi.comp_f, + homological_complex.comp_f, ι_π_summand_eq_id], + end, + inv_hom_id' := begin + ext n, + simp only [π_summand_comp_ι_summand_comp_P_infty_eq_P_infty, karoubi.comp_f, + homological_complex.comp_f, N₁_obj_p, karoubi.id_eq], + end, } + +end splitting + +namespace split + +variables {C : Type*} [category C] [preadditive C] [has_finite_coproducts C] + +/-- The functor which sends a split simplicial object in a preadditive category to +the chain complex which consists of nondegenerate simplices. -/ +@[simps] +def nondeg_complex_functor : split C ⥤ chain_complex C ℕ := +{ obj := λ S, S.s.nondeg_complex, + map := λ S₁ S₂ Φ, + { f := Φ.f, + comm' := λ i j hij, begin + dsimp, + erw [← ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [i])), + ((alternating_face_map_complex C).map Φ.F).comm_assoc i j], + simp only [assoc], + congr' 2, + apply S₁.s.hom_ext', + intro A, + dsimp [alternating_face_map_complex], + erw ι_summand_naturality_symm_assoc Φ A, + by_cases A.eq_id, + { dsimp at h, + subst h, + simpa only [splitting.ι_π_summand_eq_id, comp_id, splitting.ι_π_summand_eq_id_assoc], }, + { have h' : splitting.index_set.id (op [j]) ≠ A := by { symmetry, exact h, }, + rw [S₁.s.ι_π_summand_eq_zero_assoc _ _ h', S₂.s.ι_π_summand_eq_zero _ _ h', + zero_comp, comp_zero], }, + end }, } + +/-- The natural isomorphism (in `karoubi (chain_complex C ℕ)`) between the chain complex +of nondegenerate simplices of a split simplicial object and the normalized Moore complex +defined as a formal direct factor of the alternating face map complex. -/ +@[simps] +def to_karoubi_nondeg_complex_functor_iso_N₁ : + nondeg_complex_functor ⋙ to_karoubi (chain_complex C ℕ) ≅ forget C ⋙ dold_kan.N₁ := +nat_iso.of_components (λ S, S.s.to_karoubi_nondeg_complex_iso_N₁) + (λ S₁ S₂ Φ, begin + ext n, + dsimp, + simp only [karoubi.comp_f, to_karoubi_map_f, homological_complex.comp_f, + nondeg_complex_functor_map_f, splitting.to_karoubi_nondeg_complex_iso_N₁_hom_f_f, + N₁_map_f, alternating_face_map_complex.map_f, assoc, P_infty_f_idem_assoc], + erw ← split.ι_summand_naturality_symm_assoc Φ (splitting.index_set.id (op [n])), + rw P_infty_f_naturality, + end) + +end split + +end simplicial_object diff --git a/src/algebraic_topology/extra_degeneracy.lean b/src/algebraic_topology/extra_degeneracy.lean new file mode 100644 index 0000000000000..fe97e110dc131 --- /dev/null +++ b/src/algebraic_topology/extra_degeneracy.lean @@ -0,0 +1,400 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.alternating_face_map_complex +import algebraic_topology.simplicial_set +import algebraic_topology.cech_nerve +import algebra.homology.homotopy +import tactic.fin_cases + +/-! + +# Augmented simplicial objects with an extra degeneracy + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In simplicial homotopy theory, in order to prove that the connected components +of a simplicial set `X` are contractible, it suffices to construct an extra +degeneracy as it is defined in *Simplicial Homotopy Theory* by Goerss-Jardine p. 190. +It consists of a series of maps `π₀ X → X _[0]` and `X _[n] → X _[n+1]` which +behave formally like an extra degeneracy `σ (-1)`. It can be thought as a datum +associated to the augmented simplicial set `X → π₀ X`. + +In this file, we adapt this definition to the case of augmented +simplicial objects in any category. + +## Main definitions + +- the structure `extra_degeneracy X` for any `X : simplicial_object.augmented C` +- `extra_degeneracy.map`: extra degeneracies are preserved by the application of any +functor `C ⥤ D` +- `sSet.augmented.standard_simplex.extra_degeneracy`: the standard `n`-simplex has +an extra degeneracy +- `arrow.augmented_cech_nerve.extra_degeneracy`: the Čech nerve of a split +epimorphism has an extra degeneracy +- `extra_degeneracy.homotopy_equiv`: in the case the category `C` is preadditive, +if we have an extra degeneracy on `X : simplicial_object.augmented C`, then +the augmentation on the alternating face map complex of `X` is a homotopy +equivalence. + +## References +* [Paul G. Goerss, John F. Jardine, *Simplical Homotopy Theory*][goerss-jardine-2009] + +-/ + +open category_theory category_theory.category +open category_theory.simplicial_object.augmented +open opposite +open_locale simplicial + +namespace simplicial_object + +namespace augmented + +variables {C : Type*} [category C] + +/-- The datum of an extra degeneracy is a technical condition on +augmented simplicial objects. The morphisms `s'` and `s n` of the +structure formally behave like extra degeneracies `σ (-1)`. -/ +@[ext] +structure extra_degeneracy (X : simplicial_object.augmented C) := +(s' : point.obj X ⟶ (drop.obj X) _[0]) +(s : Π (n : ℕ), (drop.obj X) _[n] ⟶ (drop.obj X) _[n+1]) +(s'_comp_ε' : s' ≫ X.hom.app (op [0]) = 𝟙 _) +(s₀_comp_δ₁' : s 0 ≫ (drop.obj X).δ 1 = X.hom.app (op [0]) ≫ s') +(s_comp_δ₀' : Π (n : ℕ), s n ≫ (drop.obj X).δ 0 = 𝟙 _) +(s_comp_δ' : Π (n : ℕ) (i : fin (n+2)), s (n+1) ≫ (drop.obj X).δ i.succ = + (drop.obj X).δ i ≫ s n) +(s_comp_σ' : Π (n : ℕ) (i : fin (n+1)), s n ≫ (drop.obj X).σ i.succ = + (drop.obj X).σ i ≫ s (n+1)) + +namespace extra_degeneracy + +restate_axiom s'_comp_ε' +restate_axiom s₀_comp_δ₁' +restate_axiom s_comp_δ₀' +restate_axiom s_comp_δ' +restate_axiom s_comp_σ' +attribute [reassoc] s'_comp_ε s₀_comp_δ₁ s_comp_δ₀ s_comp_δ s_comp_σ +attribute [simp] s'_comp_ε s_comp_δ₀ + +/-- If `ed` is an extra degeneracy for `X : simplicial_object.augmented C` and +`F : C ⥤ D` is a functor, then `ed.map F` is an extra degeneracy for the +augmented simplical object in `D` obtained by applying `F` to `X`. -/ +def map {D : Type*} [category D] + {X : simplicial_object.augmented C} (ed : extra_degeneracy X) (F : C ⥤ D) : + extra_degeneracy (((whiskering _ _).obj F).obj X) := +{ s' := F.map ed.s', + s := λ n, F.map (ed.s n), + s'_comp_ε' := by { dsimp, erw [comp_id, ← F.map_comp, ed.s'_comp_ε, F.map_id], }, + s₀_comp_δ₁' := by { dsimp, erw [comp_id, ← F.map_comp, ← F.map_comp, ed.s₀_comp_δ₁], }, + s_comp_δ₀' := λ n, by { dsimp, erw [← F.map_comp, ed.s_comp_δ₀, F.map_id], }, + s_comp_δ' := λ n i, by { dsimp, erw [← F.map_comp, ← F.map_comp, ed.s_comp_δ], refl, }, + s_comp_σ' := λ n i, by { dsimp, erw [← F.map_comp, ← F.map_comp, ed.s_comp_σ], refl, }, } + +/-- If `X` and `Y` are isomorphic augmented simplicial objects, then an extra +degeneracy for `X` gives also an extra degeneracy for `Y` -/ +def of_iso {X Y : simplicial_object.augmented C} (e : X ≅ Y) (ed : extra_degeneracy X) : + extra_degeneracy Y := +{ s' := (point.map_iso e).inv ≫ ed.s' ≫ (drop.map_iso e).hom.app (op [0]), + s := λ n, (drop.map_iso e).inv.app (op [n]) ≫ ed.s n ≫ (drop.map_iso e).hom.app (op [n+1]), + s'_comp_ε' := by simpa only [functor.map_iso, assoc, w₀, ed.s'_comp_ε_assoc] + using (point.map_iso e).inv_hom_id, + s₀_comp_δ₁' := begin + have h := w₀ e.inv, + dsimp at h ⊢, + simp only [assoc, ← simplicial_object.δ_naturality, ed.s₀_comp_δ₁_assoc, reassoc_of h], + end, + s_comp_δ₀' := λ n, begin + have h := ed.s_comp_δ₀', + dsimp at ⊢ h, + simpa only [assoc, ← simplicial_object.δ_naturality, reassoc_of h] + using congr_app (drop.map_iso e).inv_hom_id (op [n]), + end, + s_comp_δ' := λ n i, begin + have h := ed.s_comp_δ' n i, + dsimp at ⊢ h, + simp only [assoc, ← simplicial_object.δ_naturality, reassoc_of h, + ← simplicial_object.δ_naturality_assoc], + end, + s_comp_σ' := λ n i, begin + have h := ed.s_comp_σ' n i, + dsimp at ⊢ h, + simp only [assoc, ← simplicial_object.σ_naturality, reassoc_of h, + ← simplicial_object.σ_naturality_assoc], + end,} + +end extra_degeneracy + +end augmented + +end simplicial_object + +namespace sSet + +namespace augmented + +namespace standard_simplex + +/-- When `[has_zero X]`, the shift of a map `f : fin n → X` +is a map `fin (n+1) → X` which sends `0` to `0` and `i.succ` to `f i`. -/ +def shift_fun {n : ℕ} {X : Type*} [has_zero X] (f : fin n → X) (i : fin (n+1)) : X := +dite (i = 0) (λ h, 0) (λ h, f (i.pred h)) + +@[simp] +lemma shift_fun_0 {n : ℕ} {X : Type*} [has_zero X] (f : fin n → X) : shift_fun f 0 = 0 := rfl + +@[simp] +lemma shift_fun_succ {n : ℕ} {X : Type*} [has_zero X] (f : fin n → X) + (i : fin n) : shift_fun f i.succ = f i := +begin + dsimp [shift_fun], + split_ifs, + { exfalso, + simpa only [fin.ext_iff, fin.coe_succ] using h, }, + { simp only [fin.pred_succ], }, +end + +/-- The shift of a morphism `f : [n] → Δ` in `simplex_category` corresponds to +the monotone map which sends `0` to `0` and `i.succ` to `f.to_order_hom i`. -/ +@[simp] +def shift {n : ℕ} {Δ : simplex_category} (f : [n] ⟶ Δ) : [n+1] ⟶ Δ := simplex_category.hom.mk +{ to_fun := shift_fun f.to_order_hom, + monotone' := λ i₁ i₂ hi, begin + by_cases h₁ : i₁ = 0, + { subst h₁, + simp only [shift_fun_0, fin.zero_le], }, + { have h₂ : i₂ ≠ 0 := by { intro h₂, subst h₂, exact h₁ (le_antisymm hi (fin.zero_le _)), }, + cases fin.eq_succ_of_ne_zero h₁ with j₁ hj₁, + cases fin.eq_succ_of_ne_zero h₂ with j₂ hj₂, + substs hj₁ hj₂, + simpa only [shift_fun_succ] using f.to_order_hom.monotone (fin.succ_le_succ_iff.mp hi), }, + end, } + +/-- The obvious extra degeneracy on the standard simplex. -/ +@[protected] +def extra_degeneracy (Δ : simplex_category) : + simplicial_object.augmented.extra_degeneracy (standard_simplex.obj Δ) := +{ s' := λ x, simplex_category.hom.mk (order_hom.const _ 0), + s := λ n f, shift f, + s'_comp_ε' := by { ext1 j, fin_cases j, }, + s₀_comp_δ₁' := by { ext x j, fin_cases j, refl, }, + s_comp_δ₀' := λ n, begin + ext φ i : 4, + dsimp [simplicial_object.δ, simplex_category.δ, sSet.standard_simplex], + simp only [shift_fun_succ], + end, + s_comp_δ' := λ n i, begin + ext φ j : 4, + dsimp [simplicial_object.δ, simplex_category.δ, sSet.standard_simplex], + by_cases j = 0, + { subst h, + simp only [fin.succ_succ_above_zero, shift_fun_0], }, + { cases fin.eq_succ_of_ne_zero h with k hk, + subst hk, + simp only [fin.succ_succ_above_succ, shift_fun_succ], }, + end, + s_comp_σ' := λ n i, begin + ext φ j : 4, + dsimp [simplicial_object.σ, simplex_category.σ, sSet.standard_simplex], + by_cases j = 0, + { subst h, + simpa only [shift_fun_0] using shift_fun_0 φ.to_order_hom, }, + { cases fin.eq_succ_of_ne_zero h with k hk, + subst hk, + simp only [fin.succ_pred_above_succ, shift_fun_succ], }, + end, } + +instance nonempty_extra_degeneracy_standard_simplex (Δ : simplex_category) : + nonempty (simplicial_object.augmented.extra_degeneracy (standard_simplex.obj Δ)) := +⟨standard_simplex.extra_degeneracy Δ⟩ + +end standard_simplex + +end augmented + +end sSet + +namespace category_theory + +open limits + +namespace arrow + +namespace augmented_cech_nerve + +variables {C : Type*} [category C] (f : arrow C) + [∀ n : ℕ, has_wide_pullback f.right (λ i : fin (n+1), f.left) (λ i, f.hom)] + (S : split_epi f.hom) + +include S + +/-- The extra degeneracy map on the Čech nerve of a split epi. It is +given on the `0`-projection by the given section of the split epi, +and by shifting the indices on the other projections. -/ +noncomputable def extra_degeneracy.s (n : ℕ) : + f.cech_nerve.obj (op [n]) ⟶ f.cech_nerve.obj (op [n + 1]) := +wide_pullback.lift (wide_pullback.base _) + (λ i, dite (i = 0) (λ h, wide_pullback.base _ ≫ S.section_) + (λ h, wide_pullback.π _ (i.pred h))) + (λ i, begin + split_ifs, + { subst h, + simp only [assoc, split_epi.id, comp_id], }, + { simp only [wide_pullback.π_arrow], }, + end) + +@[simp] +lemma extra_degeneracy.s_comp_π_0 (n : ℕ) : + extra_degeneracy.s f S n ≫ wide_pullback.π _ 0 = wide_pullback.base _ ≫ S.section_ := +by { dsimp [extra_degeneracy.s], simpa only [wide_pullback.lift_π], } + +@[simp] +lemma extra_degeneracy.s_comp_π_succ (n : ℕ) (i : fin (n+1)) : + extra_degeneracy.s f S n ≫ wide_pullback.π _ i.succ = wide_pullback.π _ i := +begin + dsimp [extra_degeneracy.s], + simp only [wide_pullback.lift_π], + split_ifs, + { exfalso, + simpa only [fin.ext_iff, fin.coe_succ, fin.coe_zero, nat.succ_ne_zero] using h, }, + { congr, + apply fin.pred_succ, }, +end + +@[simp] +lemma extra_degeneracy.s_comp_base (n : ℕ) : + extra_degeneracy.s f S n ≫ wide_pullback.base _ = wide_pullback.base _ := +by apply wide_pullback.lift_base + +/-- The augmented Čech nerve associated to a split epimorphism has an extra degeneracy. -/ +noncomputable def extra_degeneracy : + simplicial_object.augmented.extra_degeneracy f.augmented_cech_nerve := +{ s' := S.section_ ≫ wide_pullback.lift f.hom (λ i, 𝟙 _) (λ i, by rw id_comp), + s := λ n, extra_degeneracy.s f S n, + s'_comp_ε' := + by simp only [augmented_cech_nerve_hom_app, assoc, wide_pullback.lift_base, split_epi.id], + s₀_comp_δ₁' := begin + dsimp [cech_nerve, simplicial_object.δ, simplex_category.δ], + ext j, + { fin_cases j, + simpa only [assoc, wide_pullback.lift_π, comp_id] using extra_degeneracy.s_comp_π_0 f S 0, }, + { simpa only [assoc, wide_pullback.lift_base, split_epi.id, comp_id] + using extra_degeneracy.s_comp_base f S 0, }, + end, + s_comp_δ₀' := λ n, begin + dsimp [cech_nerve, simplicial_object.δ, simplex_category.δ], + ext j, + { simpa only [assoc, wide_pullback.lift_π, id_comp] + using extra_degeneracy.s_comp_π_succ f S n j, }, + { simpa only [assoc, wide_pullback.lift_base, id_comp] + using extra_degeneracy.s_comp_base f S n, }, + end, + s_comp_δ' := λ n i, begin + dsimp [cech_nerve, simplicial_object.δ, simplex_category.δ], + ext j, + { simp only [assoc, wide_pullback.lift_π], + by_cases j = 0, + { subst h, + erw [fin.succ_succ_above_zero, extra_degeneracy.s_comp_π_0, extra_degeneracy.s_comp_π_0], + dsimp, + simp only [wide_pullback.lift_base_assoc], }, + { cases fin.eq_succ_of_ne_zero h with k hk, + subst hk, + erw [fin.succ_succ_above_succ, extra_degeneracy.s_comp_π_succ, + extra_degeneracy.s_comp_π_succ], + dsimp, + simp only [wide_pullback.lift_π], }, }, + { simp only [assoc, wide_pullback.lift_base], + erw [extra_degeneracy.s_comp_base, extra_degeneracy.s_comp_base], + dsimp, + simp only [wide_pullback.lift_base], }, + end, + s_comp_σ' := λ n i, begin + dsimp [cech_nerve, simplicial_object.σ, simplex_category.σ], + ext j, + { simp only [assoc, wide_pullback.lift_π], + by_cases j = 0, + { subst h, + erw [extra_degeneracy.s_comp_π_0, extra_degeneracy.s_comp_π_0], + dsimp, + simp only [wide_pullback.lift_base_assoc], }, + { cases fin.eq_succ_of_ne_zero h with k hk, + subst hk, + erw [fin.succ_pred_above_succ, extra_degeneracy.s_comp_π_succ, + extra_degeneracy.s_comp_π_succ], + dsimp, + simp only [wide_pullback.lift_π], }, }, + { simp only [assoc, wide_pullback.lift_base], + erw [extra_degeneracy.s_comp_base, extra_degeneracy.s_comp_base], + dsimp, + simp only [wide_pullback.lift_base], }, + end, } + +end augmented_cech_nerve + +end arrow + +end category_theory + +namespace simplicial_object + +namespace augmented + +namespace extra_degeneracy + +open algebraic_topology category_theory category_theory.limits + +/-- If `C` is a preadditive category and `X` is an augmented simplicial object +in `C` that has an extra degeneracy, then the augmentation on the alternating +face map complex of `X` is an homotopy equivalence. -/ +noncomputable +def homotopy_equiv {C : Type*} [category C] + [preadditive C] [has_zero_object C] {X : simplicial_object.augmented C} + (ed : extra_degeneracy X) : + homotopy_equiv (algebraic_topology.alternating_face_map_complex.obj (drop.obj X)) + ((chain_complex.single₀ C).obj (point.obj X)) := +{ hom := alternating_face_map_complex.ε.app X, + inv := (chain_complex.from_single₀_equiv _ _).inv_fun ed.s', + homotopy_inv_hom_id := homotopy.of_eq (by { ext, exact ed.s'_comp_ε, }), + homotopy_hom_inv_id := + { hom := λ i j, begin + by_cases i+1 = j, + { exact (-ed.s i) ≫ eq_to_hom (by congr'), }, + { exact 0, }, + end, + zero' := λ i j hij, begin + split_ifs, + { exfalso, exact hij h, }, + { simp only [eq_self_iff_true], }, + end, + comm := λ i, begin + cases i, + { rw [homotopy.prev_d_chain_complex, homotopy.d_next_zero_chain_complex, zero_add], + dsimp [chain_complex.from_single₀_equiv, chain_complex.to_single₀_equiv], + simp only [zero_add, eq_self_iff_true, preadditive.neg_comp, comp_id, if_true, + alternating_face_map_complex.obj_d_eq, fin.sum_univ_two, fin.coe_zero, pow_zero, + one_zsmul, fin.coe_one, pow_one, neg_smul, preadditive.comp_add, ← s₀_comp_δ₁, + s_comp_δ₀, preadditive.comp_neg, neg_add_rev, neg_neg, neg_add_cancel_right, + neg_add_cancel_comm], }, + { rw [homotopy.prev_d_chain_complex, homotopy.d_next_succ_chain_complex], + dsimp [chain_complex.to_single₀_equiv, chain_complex.from_single₀_equiv], + simp only [zero_comp, alternating_face_map_complex.obj_d_eq, eq_self_iff_true, + preadditive.neg_comp, comp_id, if_true, preadditive.comp_neg, + @fin.sum_univ_succ _ _ (i+2), preadditive.comp_add, fin.coe_zero, pow_zero, one_zsmul, + s_comp_δ₀, fin.coe_succ, pow_add, pow_one, mul_neg, neg_zsmul, + preadditive.comp_sum, preadditive.sum_comp, neg_neg, mul_one, + preadditive.comp_zsmul, preadditive.zsmul_comp, s_comp_δ, zsmul_neg], + rw [add_comm (-𝟙 _), add_assoc, add_assoc, add_left_neg, add_zero, + finset.sum_neg_distrib, add_left_neg], }, + end, }, } + +end extra_degeneracy + +end augmented + +end simplicial_object diff --git a/src/algebraic_topology/fundamental_groupoid/basic.lean b/src/algebraic_topology/fundamental_groupoid/basic.lean index 731c11d43d18b..90509950dcf73 100644 --- a/src/algebraic_topology/fundamental_groupoid/basic.lean +++ b/src/algebraic_topology/fundamental_groupoid/basic.lean @@ -11,6 +11,9 @@ import topology.homotopy.path /-! # Fundamental groupoid of a space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a topological space `X`, we can define the fundamental groupoid of `X` to be the category with objects being points of `X`, and morphisms `x ⟶ y` being paths from `x` to `y`, quotiented by homotopy equivalence. With this, the fundamental group of `X` based at `x` is just the automorphism @@ -95,7 +98,7 @@ def refl_trans_symm (p : path x₀ x₁) : homotopy (path.refl x₀) (p.trans p. { rw [path.symm, path.extend, set.Icc_extend_of_mem], { congr' 1, ext, - norm_num [sub_sub_assoc_swap] }, + norm_num [sub_sub_eq_add_sub] }, { rw unit_interval.two_mul_sub_one_mem_iff, exact ⟨(not_le.1 h).le, unit_interval.le_one x⟩ } } end, @@ -323,12 +326,12 @@ def fundamental_groupoid_functor : Top ⥤ category_theory.Groupoid := refl, end } -localized "notation `π` := fundamental_groupoid.fundamental_groupoid_functor" - in fundamental_groupoid -localized "notation `πₓ` := fundamental_groupoid.fundamental_groupoid_functor.obj" - in fundamental_groupoid -localized "notation `πₘ` := fundamental_groupoid.fundamental_groupoid_functor.map" - in fundamental_groupoid +localized "notation (name := fundamental_groupoid_functor) + `π` := fundamental_groupoid.fundamental_groupoid_functor" in fundamental_groupoid +localized "notation (name := fundamental_groupoid_functor.obj) + `πₓ` := fundamental_groupoid.fundamental_groupoid_functor.obj" in fundamental_groupoid +localized "notation (name := fundamental_groupoid_functor.map) + `πₘ` := fundamental_groupoid.fundamental_groupoid_functor.map" in fundamental_groupoid lemma map_eq {X Y : Top} {x₀ x₁ : X} (f : C(X, Y)) (p : path.homotopic.quotient x₀ x₁) : (πₘ f).map p = p.map_fn f := rfl diff --git a/src/algebraic_topology/fundamental_groupoid/fundamental_group.lean b/src/algebraic_topology/fundamental_groupoid/fundamental_group.lean index 2dfb249fa7de8..1d8ccaa70cb48 100644 --- a/src/algebraic_topology/fundamental_groupoid/fundamental_group.lean +++ b/src/algebraic_topology/fundamental_groupoid/fundamental_group.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Mark Lavrentyev. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mark Lavrentyev -/ -import category_theory.category.Groupoid import category_theory.groupoid import topology.category.Top.basic import topology.path_connected @@ -13,6 +12,9 @@ import algebraic_topology.fundamental_groupoid.basic /-! # Fundamental group of a space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a topological space `X` and a basepoint `x`, the fundamental group is the automorphism group of `x` i.e. the group with elements being loops based at `x` (quotiented by homotopy equivalence). -/ diff --git a/src/algebraic_topology/fundamental_groupoid/induced_maps.lean b/src/algebraic_topology/fundamental_groupoid/induced_maps.lean index a1c1a2b4c194c..1536082abcf65 100644 --- a/src/algebraic_topology/fundamental_groupoid/induced_maps.lean +++ b/src/algebraic_topology/fundamental_groupoid/induced_maps.lean @@ -10,6 +10,9 @@ import algebraic_topology.fundamental_groupoid.product /-! # Homotopic maps induce naturally isomorphic functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions - `fundamental_groupoid_functor.homotopic_maps_nat_iso H` The natural isomorphism diff --git a/src/algebraic_topology/fundamental_groupoid/product.lean b/src/algebraic_topology/fundamental_groupoid/product.lean index f97d5f0f64d54..7d8a7c033710a 100644 --- a/src/algebraic_topology/fundamental_groupoid/product.lean +++ b/src/algebraic_topology/fundamental_groupoid/product.lean @@ -6,12 +6,14 @@ Authors: Praneeth Kolichala import category_theory.groupoid import algebraic_topology.fundamental_groupoid.basic -import topology.category.Top.limits +import topology.category.Top.limits.products import topology.homotopy.product -import category_theory.limits.preserves.shapes.products /-! # Fundamental groupoid preserves products + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. In this file, we give the following definitions/theorems: - `fundamental_groupoid_functor.pi_iso` An isomorphism between Π i, (π Xᵢ) and π (Πi, Xᵢ), whose @@ -97,7 +99,7 @@ def cone_discrete_comp : limits.cone (discrete.functor X ⋙ π) ≌ limits.cones.postcompose_equivalence (discrete.comp_nat_iso_discrete X π) lemma cone_discrete_comp_obj_map_cone : - (cone_discrete_comp X).functor.obj ((π).map_cone (Top.pi_fan X)) + (cone_discrete_comp X).functor.obj ((π).map_cone (Top.pi_fan.{u} X)) = limits.fan.mk (πₓ (Top.of (Π i, X i))) (proj X) := rfl /-- This is `pi_iso.inv` as a cone morphism (in fact, isomorphism) -/ @@ -113,11 +115,11 @@ end /-- The fundamental groupoid functor preserves products -/ def preserves_product : limits.preserves_limit (discrete.functor X) π := begin - apply limits.preserves_limit_of_preserves_limit_cone (Top.pi_fan_is_limit X), + apply limits.preserves_limit_of_preserves_limit_cone (Top.pi_fan_is_limit.{u} X), apply (limits.is_limit.of_cone_equiv (cone_discrete_comp X)).to_fun, simp only [cone_discrete_comp_obj_map_cone], apply limits.is_limit.of_iso_limit _ (as_iso (pi_Top_to_pi_cone X)).symm, - exact (Groupoid.pi_limit_cone _).is_limit, + exact Groupoid.pi_limit_fan_is_limit _, end end preserves diff --git a/src/algebraic_topology/fundamental_groupoid/punit.lean b/src/algebraic_topology/fundamental_groupoid/punit.lean index ccb1a4c3d1da9..83bf875697b51 100644 --- a/src/algebraic_topology/fundamental_groupoid/punit.lean +++ b/src/algebraic_topology/fundamental_groupoid/punit.lean @@ -3,12 +3,15 @@ Copyright (c) 2022 Praneeth Kolichala. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Praneeth Kolichala -/ -import algebraic_topology.fundamental_groupoid.induced_maps import category_theory.punit +import algebraic_topology.fundamental_groupoid.basic /-! # Fundamental groupoid of punit +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The fundamental groupoid of punit is naturally isomorphic to `category_theory.discrete punit` -/ diff --git a/src/algebraic_topology/fundamental_groupoid/simply_connected.lean b/src/algebraic_topology/fundamental_groupoid/simply_connected.lean new file mode 100644 index 0000000000000..05e4e9f523fa4 --- /dev/null +++ b/src/algebraic_topology/fundamental_groupoid/simply_connected.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2022 Praneeth Kolichala. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Praneeth Kolichala +-/ +import algebraic_topology.fundamental_groupoid.induced_maps +import topology.homotopy.contractible +import category_theory.punit +import algebraic_topology.fundamental_groupoid.punit + +/-! +# Simply connected spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +This file defines simply connected spaces. +A topological space is simply connected if its fundamental groupoid is equivalent to `unit`. + +## Main theorems + - `simply_connected_iff_unique_homotopic` - A space is simply connected if and only if it is + nonempty and there is a unique path up to homotopy between any two points + + - `simply_connected_space.of_contractible` - A contractible space is simply connected +-/ +noncomputable theory + +open category_theory +open continuous_map +open_locale continuous_map + +/-- A simply connected space is one whose fundamental groupoid is equivalent to `discrete unit` -/ +class simply_connected_space (X : Type*) [topological_space X] : Prop := +(equiv_unit [] : nonempty (fundamental_groupoid X ≌ discrete unit)) + +lemma simply_connected_def (X : Type*) [topological_space X] : + simply_connected_space X ↔ nonempty (fundamental_groupoid X ≌ discrete unit) := +⟨λ h, @simply_connected_space.equiv_unit X _ h, λ h, ⟨h⟩⟩ + +lemma simply_connected_iff_unique_homotopic (X : Type*) [topological_space X] : + simply_connected_space X ↔ (nonempty X) ∧ + ∀ (x y : X), nonempty (unique (path.homotopic.quotient x y)) := +by { rw [simply_connected_def, equiv_punit_iff_unique], refl, } + +namespace simply_connected_space +variables {X : Type*} [topological_space X] [simply_connected_space X] + +instance (x y : X) : subsingleton (path.homotopic.quotient x y) := +@unique.subsingleton _ (nonempty.some (by { rw simply_connected_iff_unique_homotopic at *, tauto })) + +local attribute [instance] path.homotopic.setoid + +@[priority 100] +instance : path_connected_space X := +let unique_homotopic := (simply_connected_iff_unique_homotopic X).mp infer_instance in +{ nonempty := unique_homotopic.1, joined := λ x y, ⟨(unique_homotopic.2 x y).some.default.out⟩, } + +/-- In a simply connected space, any two paths are homotopic -/ +lemma paths_homotopic {x y : X} (p₁ p₂ : path x y) : path.homotopic p₁ p₂ := +by simpa using @subsingleton.elim (path.homotopic.quotient x y) _ ⟦p₁⟧ ⟦p₂⟧ + +@[priority 100] +instance of_contractible (Y : Type*) [topological_space Y] [contractible_space Y] : + simply_connected_space Y := +{ equiv_unit := + let H : Top.of Y ≃ₕ Top.of unit := (contractible_space.hequiv_unit Y).some in + ⟨(fundamental_groupoid_functor.equiv_of_homotopy_equiv H).trans + fundamental_groupoid.punit_equiv_discrete_punit⟩, } + +end simply_connected_space + +local attribute [instance] path.homotopic.setoid + +/-- A space is simply connected iff it is path connected, and there is at most one path + up to homotopy between any two points. -/ +lemma simply_connected_iff_paths_homotopic {Y : Type*} [topological_space Y] : + simply_connected_space Y ↔ (path_connected_space Y) ∧ + (∀ x y : Y, subsingleton (path.homotopic.quotient x y)) := +⟨by { introI, split; apply_instance, }, +λ h, begin + casesI h, rw simply_connected_iff_unique_homotopic, + exact ⟨infer_instance, λ x y, ⟨unique_of_subsingleton ⟦path_connected_space.some_path x y⟧⟩⟩, +end⟩ + +/-- Another version of `simply_connected_iff_paths_homotopic` -/ +lemma simply_connected_iff_paths_homotopic' {Y : Type*} [topological_space Y] : + simply_connected_space Y ↔ (path_connected_space Y) ∧ + (∀ {x y : Y} (p₁ p₂ : path x y), path.homotopic p₁ p₂) := +begin + convert simply_connected_iff_paths_homotopic, + simp [path.homotopic.quotient, setoid.eq_top_iff], refl, +end diff --git a/src/algebraic_topology/nerve.lean b/src/algebraic_topology/nerve.lean new file mode 100644 index 0000000000000..09c8373d1a4ba --- /dev/null +++ b/src/algebraic_topology/nerve.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.simplicial_set + +/-! + +# The nerve of a category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides the definition of the nerve of a category `C`, +which is a simplicial set `nerve C` (see [goerss-jardine-2009], Example I.1.4). + +## References +* [Paul G. Goerss, John F. Jardine, *Simplical Homotopy Theory*][goerss-jardine-2009] + +-/ + +open category_theory.category + +universes v u + +namespace category_theory + +/-- The nerve of a category -/ +@[simps] +def nerve (C : Type u) [category.{v} C] : sSet.{max u v} := +{ obj := λ Δ, (simplex_category.to_Cat.obj Δ.unop) ⥤ C, + map := λ Δ₁ Δ₂ f x, simplex_category.to_Cat.map f.unop ⋙ x, + map_id' := λ Δ, begin + rw [unop_id, functor.map_id], + ext x, + apply functor.id_comp, + end, } + +instance {C : Type*} [category C] {Δ : simplex_categoryᵒᵖ} : category ((nerve C).obj Δ) := +(infer_instance : category ((simplex_category.to_Cat.obj Δ.unop) ⥤ C)) + +/-- The nerve of a category, as a functor `Cat ⥤ sSet` -/ +@[simps] +def nerve_functor : Cat ⥤ sSet := +{ obj := λ C, nerve C, + map := λ C C' F, + { app := λ Δ x, x ⋙ F, }, + map_id' := λ C, begin + ext Δ x, + apply functor.comp_id, + end, } + +end category_theory diff --git a/src/algebraic_topology/simplex_category.lean b/src/algebraic_topology/simplex_category.lean index 0445dbca20df5..a75189e9c9056 100644 --- a/src/algebraic_topology/simplex_category.lean +++ b/src/algebraic_topology/simplex_category.lean @@ -4,14 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin, Scott Morrison, Adam Topaz -/ -import category_theory.skeletal import tactic.linarith +import category_theory.skeletal import data.fintype.sort import order.category.NonemptyFinLinOrd import category_theory.functor.reflects_isomorphisms /-! # The simplex category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We construct a skeletal model of the simplex category, with objects `ℕ` and the morphism `n ⟶ m` being the monotone maps from `fin (n+1)` to `fin (m+1)`. @@ -33,7 +36,7 @@ We provide the following functions to work with these objects: universe v -open category_theory +open category_theory category_theory.limits /-- The simplex category: * objects are natural numbers `n : ℕ` @@ -51,7 +54,7 @@ local attribute [semireducible] simplex_category /-- Interpet a natural number as an object of the simplex category. -/ def mk (n : ℕ) : simplex_category := n -localized "notation `[`n`]` := simplex_category.mk n" in simplicial +localized "notation (name := simplex_category.mk) `[`n`]` := simplex_category.mk n" in simplicial -- TODO: Make `len` irreducible. /-- The length of an object of `simplex_category`. -/ @@ -61,8 +64,12 @@ def len (n : simplex_category) : ℕ := n @[simp] lemma len_mk (n : ℕ) : [n].len = n := rfl @[simp] lemma mk_len (n : simplex_category) : [n.len] = n := rfl +/-- A recursor for `simplex_category`. Use it as `induction Δ using simplex_category.rec`. -/ +protected def rec {F : Π (Δ : simplex_category), Sort*} (h : ∀ (n : ℕ), F [n]) : + Π X, F X := λ n, h n.len + /-- Morphisms in the simplex_category. -/ -@[irreducible, nolint has_inhabited_instance] +@[irreducible, nolint has_nonempty_instance] protected def hom (a b : simplex_category) := fin (a.len + 1) →o fin (b.len + 1) namespace hom @@ -168,11 +175,36 @@ begin split_ifs; { simp at *; linarith }, end +lemma δ_comp_δ' {n} {i : fin (n+2)} {j : fin (n+3)} (H : i.cast_succ < j) : + δ i ≫ δ j = δ (j.pred (λ hj, by simpa only [hj, fin.not_lt_zero] using H)) ≫ δ i.cast_succ := +begin + rw ← δ_comp_δ, + { rw fin.succ_pred, }, + { simpa only [fin.le_iff_coe_le_coe, ← nat.lt_succ_iff, nat.succ_eq_add_one, ← fin.coe_succ, + j.succ_pred, fin.lt_iff_coe_lt_coe] using H, }, +end + +lemma δ_comp_δ'' {n} {i : fin (n+3)} {j : fin (n+2)} (H : i ≤ j.cast_succ) : + δ (i.cast_lt (nat.lt_of_le_of_lt (fin.le_iff_coe_le_coe.mp H) j.is_lt)) ≫ δ j.succ = + δ j ≫ δ i := +begin + rw δ_comp_δ, + { refl, }, + { exact H, }, +end + /-- The special case of the first simplicial identity -/ +@[reassoc] lemma δ_comp_δ_self {n} {i : fin (n+2)} : δ i ≫ δ i.cast_succ = δ i ≫ δ i.succ := (δ_comp_δ (le_refl i)).symm +@[reassoc] +lemma δ_comp_δ_self' {n} {i : fin (n+2)} {j : fin (n+3)} (H : j = i.cast_succ) : + δ i ≫ δ j = δ i ≫ δ i.succ := +by { subst H, rw δ_comp_δ_self, } + /-- The second simplicial identity -/ +@[reassoc] lemma δ_comp_σ_of_le {n} {i : fin (n+2)} {j : fin (n+1)} (H : i ≤ j.cast_succ) : δ i.cast_succ ≫ σ j.succ = σ j ≫ δ i := begin @@ -189,8 +221,8 @@ begin rcases i with ⟨i, _⟩, rcases j with ⟨j, _⟩, rcases k with ⟨k, _⟩, - simp only [subtype.mk_le_mk, fin.cast_succ_mk] at H, - dsimp, simp only [if_congr, subtype.mk_lt_mk, dif_ctx_congr], + simp only [fin.mk_le_mk, fin.cast_succ_mk] at H, + dsimp, split_ifs, -- Most of the goals can now be handled by `linarith`, -- but we have to deal with two of them by hand. @@ -203,6 +235,7 @@ begin end /-- The first part of the third simplicial identity -/ +@[reassoc] lemma δ_comp_σ_self {n} {i : fin (n+1)} : δ i.cast_succ ≫ σ i = 𝟙 [n] := begin @@ -212,11 +245,17 @@ begin { dsimp [δ, σ, fin.succ_above, fin.pred_above], simpa [fin.pred_above] with push_cast }, rcases i with ⟨i, _⟩, rcases j with ⟨j, _⟩, - dsimp, simp only [if_congr, subtype.mk_lt_mk], + dsimp, split_ifs; { simp at *; linarith, }, end +@[reassoc] +lemma δ_comp_σ_self' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.cast_succ) : + δ j ≫ σ i = 𝟙 [n] := +by { subst H, rw δ_comp_σ_self, } + /-- The second part of the third simplicial identity -/ +@[reassoc] lemma δ_comp_σ_succ {n} {i : fin (n+1)} : δ i.succ ≫ σ i = 𝟙 [n] := begin @@ -228,7 +267,13 @@ begin split_ifs; { simp at *; linarith, }, end +@[reassoc] +lemma δ_comp_σ_succ' {n} (j : fin (n+2)) (i : fin (n+1)) (H : j = i.succ) : + δ j ≫ σ i = 𝟙 [n] := +by { subst H, rw δ_comp_σ_succ, } + /-- The fourth simplicial identity -/ +@[reassoc] lemma δ_comp_σ_of_gt {n} {i : fin (n+2)} {j : fin (n+1)} (H : j.cast_succ < i) : δ i.succ ≫ σ j.cast_succ = σ j ≫ δ i := begin @@ -237,7 +282,7 @@ begin rcases i with ⟨i, _⟩, rcases j with ⟨j, _⟩, rcases k with ⟨k, _⟩, - simp only [subtype.mk_lt_mk, fin.cast_succ_mk] at H, + simp only [fin.mk_lt_mk, fin.cast_succ_mk] at H, suffices : ite (_ < ite (k < i + 1) _ _) _ _ = ite _ (ite (j < k) (k - 1) k) (ite (j < k) (k - 1) k + 1), { simpa [apply_dite fin.cast_succ, fin.pred_above] with push_cast, }, @@ -245,20 +290,20 @@ begin -- Most of the goals can now be handled by `linarith`, -- but we have to deal with three of them by hand. swap 2, - { simp only [subtype.mk_lt_mk] at h_1, + { simp only [fin.mk_lt_mk] at h_1, simp only [not_lt] at h_2, simp only [self_eq_add_right, one_ne_zero], exact lt_irrefl (k - 1) (lt_of_lt_of_le (nat.pred_lt (ne_of_lt (lt_of_le_of_lt (zero_le _) h_1)).symm) (le_trans (nat.le_of_lt_succ h) h_2)) }, swap 4, - { simp only [subtype.mk_lt_mk] at h_1, + { simp only [fin.mk_lt_mk] at h_1, simp only [not_lt] at h, simp only [nat.add_succ_sub_one, add_zero], exfalso, exact lt_irrefl _ (lt_of_le_of_lt (nat.le_pred_of_lt (nat.lt_of_succ_le h)) h_3), }, swap 4, - { simp only [subtype.mk_lt_mk] at h_1, + { simp only [fin.mk_lt_mk] at h_1, simp only [not_lt] at h_3, simp only [nat.add_succ_sub_one, add_zero], exact (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) h_2)).symm, }, @@ -266,9 +311,23 @@ begin all_goals { simp at h_1 h_2 ⊢; linarith, }, end +@[reassoc] +lemma δ_comp_σ_of_gt' {n} {i : fin (n+3)} {j : fin (n+2)} (H : j.succ < i) : + δ i ≫ σ j = σ (j.cast_lt ((add_lt_add_iff_right 1).mp (lt_of_lt_of_le + (by simpa only [fin.val_eq_coe, ← fin.coe_succ] + using fin.lt_iff_coe_lt_coe.mp H) i.is_le))) ≫ + δ (i.pred (λ hi, by simpa only [fin.not_lt_zero, hi] using H)) := +begin + rw ← δ_comp_σ_of_gt, + { simpa only [fin.succ_pred], }, + { rw [fin.cast_succ_cast_lt, ← fin.succ_lt_succ_iff, fin.succ_pred], + exact H, }, +end + local attribute [simp] fin.pred_mk /-- The fifth simplicial identity -/ +@[reassoc] lemma σ_comp_σ {n} {i j : fin (n+1)} (H : i ≤ j) : σ i.cast_succ ≫ σ j = σ j.succ ≫ σ i := begin @@ -277,7 +336,7 @@ begin rcases i with ⟨i, _⟩, rcases j with ⟨j, _⟩, rcases k with ⟨k, _⟩, - simp only [subtype.mk_le_mk] at H, + simp only [fin.mk_le_mk] at H, -- At this point `simp with push_cast` makes good progress, but neither `simp?` nor `squeeze_simp` -- return usable sets of lemmas. -- To avoid using a non-terminal simp, we make a `suffices` statement indicating the shape @@ -318,6 +377,10 @@ def skeletal_functor : simplex_category ⥤ NonemptyFinLinOrd.{v} := map_id' := λ a, by { ext, simp, }, map_comp' := λ a b c f g, by { ext, simp, }, } +lemma skeletal_functor.coe_map + {Δ₁ Δ₂ : simplex_category} (f : Δ₁ ⟶ Δ₂) : + coe_fn (skeletal_functor.{v}.map f) = ulift.up ∘ f.to_order_hom ∘ ulift.down := rfl + lemma skeletal : skeletal simplex_category := λ X Y ⟨I⟩, begin @@ -382,7 +445,7 @@ def is_skeleton_of : is_skeleton_of NonemptyFinLinOrd simplex_category skeletal_ /-- The truncated simplex category. -/ @[derive small_category] -def truncated (n : ℕ) := {a : simplex_category // a.len ≤ n} +def truncated (n : ℕ) := full_subcategory (λ a : simplex_category, a.len ≤ n) namespace truncated @@ -415,14 +478,11 @@ section epi_mono theorem mono_iff_injective {n m : simplex_category} {f : n ⟶ m} : mono f ↔ function.injective f.to_order_hom := begin - split, - { introsI m x y h, - have H : const n x ≫ f = const n y ≫ f, - { dsimp, rw h }, - change (n.const x).to_order_hom 0 = (n.const y).to_order_hom 0, - rw cancel_mono f at H, - rw H }, - { exact concrete_category.mono_of_injective f } + rw ← functor.mono_map_iff_mono skeletal_equivalence.functor.{0}, + dsimp only [skeletal_equivalence, functor.as_equivalence_functor], + rw [NonemptyFinLinOrd.mono_iff_injective, skeletal_functor.coe_map, + function.injective.of_comp_iff ulift.up_injective, + function.injective.of_comp_iff' _ ulift.down_bijective], end /-- A morphism in `simplex_category` is an epimorphism if and only if it is a surjective function @@ -430,39 +490,11 @@ end lemma epi_iff_surjective {n m : simplex_category} {f: n ⟶ m} : epi f ↔ function.surjective f.to_order_hom := begin - split, - { introsI hyp_f_epi x, - by_contra' h_ab, - -- The proof is by contradiction: assume f is not surjective, - -- then introduce two non-equal auxiliary functions equalizing f, and get a contradiction. - -- First we define the two auxiliary functions. - set chi_1 : m ⟶ [1] := hom.mk ⟨λ u, if u ≤ x then 0 else 1, begin - intros a b h, - dsimp only [], - split_ifs with h1 h2 h3, - any_goals { exact le_rfl }, - { exact bot_le }, - { exact false.elim (h1 (le_trans h h3)) } - end ⟩, - set chi_2 : m ⟶ [1] := hom.mk ⟨λ u, if u < x then 0 else 1, begin - intros a b h, - dsimp only [], - split_ifs with h1 h2 h3, - any_goals { exact le_rfl }, - { exact bot_le }, - { exact false.elim (h1 (lt_of_le_of_lt h h3)) } - end ⟩, - -- The two auxiliary functions equalize f - have f_comp_chi_i : f ≫ chi_1 = f ≫ chi_2, - { dsimp, - ext, - simp [le_iff_lt_or_eq, h_ab x_1] }, - -- We now just have to show the two auxiliary functions are not equal. - rw category_theory.cancel_epi f at f_comp_chi_i, rename f_comp_chi_i eq_chi_i, - apply_fun (λ e, e.to_order_hom x) at eq_chi_i, - suffices : (0 : fin 2) = 1, by exact bot_ne_top this, - simpa using eq_chi_i }, - { exact concrete_category.epi_of_surjective f } + rw ← functor.epi_map_iff_epi skeletal_equivalence.functor.{0}, + dsimp only [skeletal_equivalence, functor.as_equivalence_functor], + rw [NonemptyFinLinOrd.epi_iff_surjective, skeletal_functor.coe_map, + function.surjective.of_comp_iff' ulift.up_bijective, + function.surjective.of_comp_iff _ ulift.down_surjective], end /-- A monomorphism in `simplex_category` must increase lengths-/ @@ -567,7 +599,7 @@ begin refl, end -lemma eq_id_of_is_iso {x : simplex_category} {f : x ⟶ x} (hf : is_iso f) : f = 𝟙 _ := +lemma eq_id_of_is_iso {x : simplex_category} (f : x ⟶ x) [hf : is_iso f] : f = 𝟙 _ := congr_arg (λ (φ : _ ≅ _), φ.hom) (iso_eq_iso_refl (as_iso f)) lemma eq_σ_comp_of_not_injective' {n : ℕ} {Δ' : simplex_category} (θ : mk (n+1) ⟶ Δ') @@ -651,7 +683,7 @@ begin order_hom.comp_coe, hom.comp, small_category_comp], by_cases h' : θ.to_order_hom x ≤ i, { simp only [σ, mk_hom, hom.to_order_hom_mk, order_hom.coe_fun_mk], - erw fin.pred_above_below (fin.cast_pred i) (θ.to_order_hom x) + rw fin.pred_above_below (fin.cast_pred i) (θ.to_order_hom x) (by simpa [fin.cast_succ_cast_pred h] using h'), erw fin.succ_above_below i, swap, { simp only [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ], @@ -686,18 +718,22 @@ end lemma eq_id_of_mono {x : simplex_category} (i : x ⟶ x) [mono i] : i = 𝟙 _ := begin - apply eq_id_of_is_iso, + suffices : is_iso i, + { haveI := this, apply eq_id_of_is_iso, }, apply is_iso_of_bijective, - erw [fintype.bijective_iff_injective_and_card i.to_order_hom, ← mono_iff_injective, + dsimp, + rw [fintype.bijective_iff_injective_and_card i.to_order_hom, ← mono_iff_injective, eq_self_iff_true, and_true], apply_instance, end lemma eq_id_of_epi {x : simplex_category} (i : x ⟶ x) [epi i] : i = 𝟙 _ := begin - apply eq_id_of_is_iso, + suffices : is_iso i, + { haveI := this, apply eq_id_of_is_iso, }, apply is_iso_of_bijective, - erw [fintype.bijective_iff_surjective_and_card i.to_order_hom, ← epi_iff_surjective, + dsimp, + rw [fintype.bijective_iff_surjective_and_card i.to_order_hom, ← epi_iff_surjective, eq_self_iff_true, and_true], apply_instance, end @@ -711,7 +747,7 @@ begin use i, haveI : epi (σ i ≫ θ') := by { rw ← h, apply_instance, }, haveI := category_theory.epi_of_epi (σ i) θ', - erw [h, eq_id_of_epi θ', category.comp_id], + rw [h, eq_id_of_epi θ', category.comp_id], end lemma eq_δ_of_mono {n : ℕ} (θ : mk n ⟶ mk (n+1)) [mono θ] : ∃ (i : fin (n+2)), θ = δ i := @@ -723,9 +759,62 @@ begin use i, haveI : mono (θ' ≫ δ i) := by { rw ← h, apply_instance, }, haveI := category_theory.mono_of_mono θ' (δ i), - erw [h, eq_id_of_mono θ', category.id_comp], + rw [h, eq_id_of_mono θ', category.id_comp], end +lemma len_lt_of_mono {Δ' Δ : simplex_category} (i : Δ' ⟶ Δ) [hi : mono i] + (hi' : Δ ≠ Δ') : Δ'.len < Δ.len := +begin + cases lt_or_eq_of_le (len_le_of_mono hi), + { exact h, }, + { exfalso, + exact hi' (by { ext, exact h.symm,}), }, +end + +noncomputable instance : split_epi_category simplex_category := +skeletal_equivalence.{0}.inverse.split_epi_category_imp_of_is_equivalence + +instance : has_strong_epi_mono_factorisations simplex_category := +functor.has_strong_epi_mono_factorisations_imp_of_is_equivalence + simplex_category.skeletal_equivalence.{0}.inverse + +instance : has_strong_epi_images simplex_category := + limits.has_strong_epi_images_of_has_strong_epi_mono_factorisations + +instance (Δ Δ' : simplex_category) (θ : Δ ⟶ Δ') : epi (factor_thru_image θ) := strong_epi.epi + +lemma image_eq {Δ Δ' Δ'' : simplex_category } {φ : Δ ⟶ Δ''} + {e : Δ ⟶ Δ'} [epi e] {i : Δ' ⟶ Δ''} [mono i] (fac : e ≫ i = φ) : + image φ = Δ' := +begin + haveI := strong_epi_of_epi e, + let e := image.iso_strong_epi_mono e i fac, + ext, + exact le_antisymm (len_le_of_epi (infer_instance : epi e.hom)) + (len_le_of_mono (infer_instance : mono e.hom)), +end + +lemma image_ι_eq {Δ Δ'' : simplex_category } {φ : Δ ⟶ Δ''} + {e : Δ ⟶ image φ} [epi e] {i : image φ ⟶ Δ''} [mono i] (fac : e ≫ i = φ) : + image.ι φ = i := +begin + haveI := strong_epi_of_epi e, + rw [← image.iso_strong_epi_mono_hom_comp_ι e i fac, + simplex_category.eq_id_of_is_iso (image.iso_strong_epi_mono e i fac).hom, category.id_comp], +end + +lemma factor_thru_image_eq {Δ Δ'' : simplex_category } {φ : Δ ⟶ Δ''} + {e : Δ ⟶ image φ} [epi e] {i : image φ ⟶ Δ''} [mono i] (fac : e ≫ i = φ) : + factor_thru_image φ = e := +by rw [← cancel_mono i, fac, ← image_ι_eq fac, image.fac] + end epi_mono +/-- This functor `simplex_category ⥤ Cat` sends `[n]` (for `n : ℕ`) +to the category attached to the ordered set `{0, 1, ..., n}` -/ +@[simps obj map] +def to_Cat : simplex_category ⥤ Cat.{0} := +simplex_category.skeletal_functor ⋙ forget₂ NonemptyFinLinOrd LinOrd ⋙ + forget₂ LinOrd Lat ⋙ forget₂ Lat PartOrd ⋙ forget₂ PartOrd Preord ⋙ Preord_to_Cat + end simplex_category diff --git a/src/algebraic_topology/simplicial_object.lean b/src/algebraic_topology/simplicial_object.lean index 43ee554f737ce..0467fe961b36d 100644 --- a/src/algebraic_topology/simplicial_object.lean +++ b/src/algebraic_topology/simplicial_object.lean @@ -11,6 +11,9 @@ import category_theory.opposites /-! # Simplicial objects in a category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A simplicial object in a category `C` is a `C`-valued presheaf on `simplex_category`. (Similarly a cosimplicial object is functor `simplex_category ⥤ C`.) @@ -31,14 +34,13 @@ variables (C : Type u) [category.{v} C] /-- The category of simplicial objects valued in a category `C`. This is the category of contravariant functors from `simplex_category` to `C`. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def simplicial_object := simplex_categoryᵒᵖ ⥤ C namespace simplicial_object -localized - "notation X `_[`:1000 n `]` := - (X : category_theory.simplicial_object _).obj (opposite.op (simplex_category.mk n))" +localized "notation (name := simplicial_object.at) X ` _[`:1000 n `]` := + (X : category_theory.simplicial_object hole!).obj (opposite.op (simplex_category.mk n))" in simplicial instance {J : Type v} [small_category J] [has_limits_of_shape J C] : @@ -71,20 +73,41 @@ by { ext, simp [eq_to_iso], } /-- The generic case of the first simplicial identity -/ +@[reassoc] lemma δ_comp_δ {n} {i j : fin (n+2)} (H : i ≤ j) : X.δ j.succ ≫ X.δ i = X.δ i.cast_succ ≫ X.δ j := by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ H] } +@[reassoc] +lemma δ_comp_δ' {n} {i : fin (n+2)} {j : fin (n+3)} (H : i.cast_succ < j) : + X.δ j ≫ X.δ i = X.δ i.cast_succ ≫ + X.δ (j.pred (λ hj, by simpa only [hj, fin.not_lt_zero] using H)) := +by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ' H] } + +@[reassoc] +lemma δ_comp_δ'' {n} {i : fin (n+3)} {j : fin (n+2)} (H : i ≤ j.cast_succ) : + X.δ j.succ ≫ X.δ (i.cast_lt (nat.lt_of_le_of_lt (fin.le_iff_coe_le_coe.mp H) j.is_lt)) = + X.δ i ≫ X.δ j := +by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ'' H] } + /-- The special case of the first simplicial identity -/ +@[reassoc] lemma δ_comp_δ_self {n} {i : fin (n+2)} : X.δ i.cast_succ ≫ X.δ i = X.δ i.succ ≫ X.δ i := by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ_self] } +@[reassoc] +lemma δ_comp_δ_self' {n} {j : fin (n+3)} {i : fin (n+2)} (H : j = i.cast_succ) : + X.δ j ≫ X.δ i = X.δ i.succ ≫ X.δ i := +by { subst H, rw δ_comp_δ_self, } + /-- The second simplicial identity -/ +@[reassoc] lemma δ_comp_σ_of_le {n} {i : fin (n+2)} {j : fin (n+1)} (H : i ≤ j.cast_succ) : X.σ j.succ ≫ X.δ i.cast_succ = X.δ i ≫ X.σ j := by { dsimp [δ, σ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_le H] } /-- The first part of the third simplicial identity -/ +@[reassoc] lemma δ_comp_σ_self {n} {i : fin (n+1)} : X.σ i ≫ X.δ i.cast_succ = 𝟙 _ := begin @@ -92,7 +115,12 @@ begin simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_self, op_id, X.map_id], end +@[reassoc] +lemma δ_comp_σ_self' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.cast_succ): + X.σ i ≫ X.δ j = 𝟙 _ := by { subst H, rw δ_comp_σ_self, } + /-- The second part of the third simplicial identity -/ +@[reassoc] lemma δ_comp_σ_succ {n} {i : fin (n+1)} : X.σ i ≫ X.δ i.succ = 𝟙 _ := begin @@ -100,16 +128,40 @@ begin simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_succ, op_id, X.map_id], end +@[reassoc] +lemma δ_comp_σ_succ' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.succ) : + X.σ i ≫ X.δ j = 𝟙 _ := by { subst H, rw δ_comp_σ_succ, } + /-- The fourth simplicial identity -/ +@[reassoc] lemma δ_comp_σ_of_gt {n} {i : fin (n+2)} {j : fin (n+1)} (H : j.cast_succ < i) : X.σ j.cast_succ ≫ X.δ i.succ = X.δ i ≫ X.σ j := by { dsimp [δ, σ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_gt H] } +@[reassoc] +lemma δ_comp_σ_of_gt' {n} {i : fin (n+3)} {j : fin (n+2)} (H : j.succ < i) : + X.σ j ≫ X.δ i = X.δ (i.pred (λ hi, by simpa only [fin.not_lt_zero, hi] using H)) ≫ + X.σ (j.cast_lt ((add_lt_add_iff_right 1).mp (lt_of_lt_of_le + (by simpa only [fin.val_eq_coe, ← fin.coe_succ] + using fin.lt_iff_coe_lt_coe.mp H) i.is_le))) := +by { dsimp [δ, σ], simpa only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_gt' H], } + /-- The fifth simplicial identity -/ +@[reassoc] lemma σ_comp_σ {n} {i j : fin (n+1)} (H : i ≤ j) : X.σ j ≫ X.σ i.cast_succ = X.σ i ≫ X.σ j.succ := by { dsimp [δ, σ], simp only [←X.map_comp, ←op_comp, simplex_category.σ_comp_σ H] } +open_locale simplicial + +@[simp, reassoc] +lemma δ_naturality {X' X : simplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+2)) : + X.δ i ≫ f.app (op [n]) = f.app (op [n+1]) ≫ X'.δ i := f.naturality _ + +@[simp, reassoc] +lemma σ_naturality {X' X : simplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+1)) : + X.σ i ≫ f.app (op [n+1]) = f.app (op [n]) ≫ X'.σ i := f.naturality _ + variable (C) /-- Functor composition induces a functor on simplicial objects. -/ @@ -119,7 +171,7 @@ def whiskering (D : Type*) [category D] : whiskering_right _ _ _ /-- Truncated simplicial objects. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def truncated (n : ℕ) := (simplex_category.truncated n)ᵒᵖ ⥤ C variable {C} @@ -163,7 +215,7 @@ variable (C) abbreviation const : C ⥤ simplicial_object C := category_theory.functor.const _ /-- The category of augmented simplicial objects, defined as a comma category. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def augmented := comma (𝟭 (simplicial_object C)) (const C) variable {C} @@ -195,6 +247,14 @@ def to_arrow : augmented C ⥤ arrow C := refl, end } } +/-- The compatibility of a morphism with the augmentation, on 0-simplices -/ +@[reassoc] +lemma w₀ {X Y : augmented C} (f : X ⟶ Y) : + (augmented.drop.map f).app (op (simplex_category.mk 0)) ≫ + Y.hom.app (op (simplex_category.mk 0)) = + X.hom.app (op (simplex_category.mk 0)) ≫ augmented.point.map f := +by convert congr_app f.w (op (simplex_category.mk 0)) + variable (C) /-- Functor composition induces a functor on augmented simplicial objects. -/ @@ -211,8 +271,8 @@ def whiskering_obj (D : Type*) [category D] (F : C ⥤ D) : w' := begin ext, dsimp, - erw [category.comp_id, category.comp_id, ← F.map_comp, - ← F.map_comp, ← nat_trans.comp_app, η.w], + rw [category.comp_id, category.comp_id, ← F.map_comp, ← F.map_comp, ← nat_trans.comp_app], + erw η.w, refl, end } } @@ -228,16 +288,14 @@ def whiskering (D : Type u') [category.{v'} D] : w' := begin ext n, dsimp, - erw [category.comp_id, category.comp_id, η.naturality], + rw [category.comp_id, category.comp_id, η.naturality], end }, }, } variable {C} end augmented -open_locale simplicial - -/-- Aaugment a simplicial object with an object. -/ +/-- Augment a simplicial object with an object. -/ @[simps] def augment (X : simplicial_object C) (X₀ : C) (f : X _[0] ⟶ X₀) (w : ∀ (i : simplex_category) (g₁ g₂ : [0] ⟶ i), @@ -256,20 +314,18 @@ def augment (X : simplicial_object C) (X₀ : C) (f : X _[0] ⟶ X₀) @[simp] lemma augment_hom_zero (X : simplicial_object C) (X₀ : C) (f : X _[0] ⟶ X₀) (w) : (X.augment X₀ f w).hom.app (op [0]) = f := -by { dsimp, erw [simplex_category.hom_zero_zero ([0].const 0), X.map_id, category.id_comp] } +by { dsimp, rw [simplex_category.hom_zero_zero ([0].const 0), op_id, X.map_id, category.id_comp] } end simplicial_object /-- Cosimplicial objects. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def cosimplicial_object := simplex_category ⥤ C namespace cosimplicial_object -localized - "notation X `_[`:1000 n `]` := - (X : category_theory.cosimplicial_object _).obj (simplex_category.mk n)" - in simplicial +localized "notation (name := cosimplicial_object.at) X ` _[`:1000 n `]` := + (X : category_theory.cosimplicial_object hole!).obj (simplex_category.mk n)" in simplicial instance {J : Type v} [small_category J] [has_limits_of_shape J C] : has_limits_of_shape J (cosimplicial_object C) := by {dsimp [cosimplicial_object], apply_instance} @@ -299,22 +355,42 @@ X.map_iso (eq_to_iso (by rw h)) @[simp] lemma eq_to_iso_refl {n : ℕ} (h : n = n) : X.eq_to_iso h = iso.refl _ := by { ext, simp [eq_to_iso], } - /-- The generic case of the first cosimplicial identity -/ +@[reassoc] lemma δ_comp_δ {n} {i j : fin (n+2)} (H : i ≤ j) : X.δ i ≫ X.δ j.succ = X.δ j ≫ X.δ i.cast_succ := by { dsimp [δ], simp only [←X.map_comp, simplex_category.δ_comp_δ H], } +@[reassoc] +lemma δ_comp_δ' {n} {i : fin (n+2)} {j : fin (n+3)} (H : i.cast_succ < j) : + X.δ i ≫ X.δ j = X.δ (j.pred (λ hj, by simpa only [hj, fin.not_lt_zero] using H)) ≫ + X.δ i.cast_succ := +by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ' H] } + +@[reassoc] +lemma δ_comp_δ'' {n} {i : fin (n+3)} {j : fin (n+2)} (H : i ≤ j.cast_succ) : + X.δ (i.cast_lt (nat.lt_of_le_of_lt (fin.le_iff_coe_le_coe.mp H) j.is_lt)) ≫ X.δ j.succ = + X.δ j ≫ X.δ i := +by { dsimp [δ], simp only [←X.map_comp, ←op_comp, simplex_category.δ_comp_δ'' H] } + /-- The special case of the first cosimplicial identity -/ +@[reassoc] lemma δ_comp_δ_self {n} {i : fin (n+2)} : X.δ i ≫ X.δ i.cast_succ = X.δ i ≫ X.δ i.succ := by { dsimp [δ], simp only [←X.map_comp, simplex_category.δ_comp_δ_self] } +@[reassoc] +lemma δ_comp_δ_self' {n} {i : fin (n+2)} {j : fin (n+3)} (H : j = i.cast_succ) : + X.δ i ≫ X.δ j = X.δ i ≫ X.δ i.succ := +by { subst H, rw δ_comp_δ_self, } + /-- The second cosimplicial identity -/ +@[reassoc] lemma δ_comp_σ_of_le {n} {i : fin (n+2)} {j : fin (n+1)} (H : i ≤ j.cast_succ) : X.δ i.cast_succ ≫ X.σ j.succ = X.σ j ≫ X.δ i := by { dsimp [δ, σ], simp only [←X.map_comp, simplex_category.δ_comp_σ_of_le H] } /-- The first part of the third cosimplicial identity -/ +@[reassoc] lemma δ_comp_σ_self {n} {i : fin (n+1)} : X.δ i.cast_succ ≫ X.σ i = 𝟙 _ := begin @@ -322,7 +398,13 @@ begin simp only [←X.map_comp, simplex_category.δ_comp_σ_self, X.map_id], end +@[reassoc] +lemma δ_comp_σ_self' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.cast_succ) : + X.δ j ≫ X.σ i = 𝟙 _ := +by { subst H, rw δ_comp_σ_self, } + /-- The second part of the third cosimplicial identity -/ +@[reassoc] lemma δ_comp_σ_succ {n} {i : fin (n+1)} : X.δ i.succ ≫ X.σ i = 𝟙 _ := begin @@ -330,16 +412,41 @@ begin simp only [←X.map_comp, simplex_category.δ_comp_σ_succ, X.map_id], end +@[reassoc] +lemma δ_comp_σ_succ' {n} {j : fin (n+2)} {i : fin (n+1)} (H : j = i.succ) : + X.δ j ≫ X.σ i = 𝟙 _ := +by { subst H, rw δ_comp_σ_succ, } + /-- The fourth cosimplicial identity -/ +@[reassoc] lemma δ_comp_σ_of_gt {n} {i : fin (n+2)} {j : fin (n+1)} (H : j.cast_succ < i) : X.δ i.succ ≫ X.σ j.cast_succ = X.σ j ≫ X.δ i := by { dsimp [δ, σ], simp only [←X.map_comp, simplex_category.δ_comp_σ_of_gt H] } +@[reassoc] +lemma δ_comp_σ_of_gt' {n} {i : fin (n+3)} {j : fin (n+2)} (H : j.succ < i) : + X.δ i ≫ X.σ j = X.σ (j.cast_lt ((add_lt_add_iff_right 1).mp (lt_of_lt_of_le + (by simpa only [fin.val_eq_coe, ← fin.coe_succ] + using fin.lt_iff_coe_lt_coe.mp H) i.is_le))) ≫ + X.δ (i.pred (λ hi, by simpa only [fin.not_lt_zero, hi] using H)) := +by { dsimp [δ, σ], simpa only [←X.map_comp, ←op_comp, simplex_category.δ_comp_σ_of_gt' H], } + /-- The fifth cosimplicial identity -/ +@[reassoc] lemma σ_comp_σ {n} {i j : fin (n+1)} (H : i ≤ j) : X.σ i.cast_succ ≫ X.σ j = X.σ j.succ ≫ X.σ i := by { dsimp [δ, σ], simp only [←X.map_comp, simplex_category.σ_comp_σ H] } +@[simp, reassoc] +lemma δ_naturality {X' X : cosimplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+2)) : + X.δ i ≫ f.app (simplex_category.mk (n+1)) = + f.app (simplex_category.mk n) ≫ X'.δ i := f.naturality _ + +@[simp, reassoc] +lemma σ_naturality {X' X : cosimplicial_object C} (f : X ⟶ X') {n : ℕ} (i : fin (n+1)) : + X.σ i ≫ f.app (simplex_category.mk n) = + f.app (simplex_category.mk (n+1)) ≫ X'.σ i := f.naturality _ + variable (C) /-- Functor composition induces a functor on cosimplicial objects. -/ @@ -349,7 +456,7 @@ def whiskering (D : Type*) [category D] : whiskering_right _ _ _ /-- Truncated cosimplicial objects. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def truncated (n : ℕ) := simplex_category.truncated n ⥤ C variable {C} @@ -394,7 +501,7 @@ variable (C) abbreviation const : C ⥤ cosimplicial_object C := category_theory.functor.const _ /-- Augmented cosimplicial objects. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def augmented := comma (const C) (𝟭 (cosimplicial_object C)) variable {C} @@ -442,8 +549,8 @@ def whiskering_obj (D : Type*) [category D] (F : C ⥤ D) : w' := begin ext, dsimp, - erw [category.id_comp, category.id_comp, ← F.map_comp, - ← F.map_comp, ← nat_trans.comp_app, ← η.w], + rw [category.id_comp, category.id_comp, ← F.map_comp, ← F.map_comp, ← nat_trans.comp_app], + erw ← η.w, refl, end } } @@ -459,7 +566,7 @@ def whiskering (D : Type u') [category.{v'} D] : w' := begin ext n, dsimp, - erw [category.id_comp, category.id_comp, η.naturality], + rw [category.id_comp, category.id_comp, η.naturality], end }, }, } variable {C} @@ -495,6 +602,11 @@ end cosimplicial_object def simplicial_cosimplicial_equiv : (simplicial_object C)ᵒᵖ ≌ (cosimplicial_object Cᵒᵖ) := functor.left_op_right_op_equiv _ _ +/-- The anti-equivalence between cosimplicial objects and simplicial objects. -/ +@[simps] +def cosimplicial_simplicial_equiv : (cosimplicial_object C)ᵒᵖ ≌ (simplicial_object Cᵒᵖ) := +functor.op_unop_equiv _ _ + variable {C} /-- Construct an augmented cosimplicial object in the opposite @@ -565,21 +677,14 @@ def cosimplicial_to_simplicial_augmented : /-- The contravariant categorical equivalence between augmented simplicial objects and augmented cosimplicial objects in the opposite category. -/ -@[simps] +@[simps functor inverse] def simplicial_cosimplicial_augmented_equiv : (simplicial_object.augmented C)ᵒᵖ ≌ cosimplicial_object.augmented Cᵒᵖ := -{ functor := simplicial_to_cosimplicial_augmented _, - inverse := cosimplicial_to_simplicial_augmented _, - unit_iso := nat_iso.of_components - (λ X, X.unop.right_op_left_op_iso.op) begin - intros X Y f, - dsimp, - rw (show f = f.unop.op, by simp), - simp_rw ← op_comp, - congr' 1, - tidy, - end, - counit_iso := nat_iso.of_components - (λ X, X.left_op_right_op_iso) (by tidy) } +equivalence.mk + (simplicial_to_cosimplicial_augmented _) + (cosimplicial_to_simplicial_augmented _) + (nat_iso.of_components (λ X, X.unop.right_op_left_op_iso.op) $ λ X Y f, + by { dsimp, rw ←f.op_unop, simp_rw ← op_comp, congr' 1, tidy }) + (nat_iso.of_components (λ X, X.left_op_right_op_iso) $ by tidy) end category_theory diff --git a/src/algebraic_topology/simplicial_set.lean b/src/algebraic_topology/simplicial_set.lean index 5d5aca42921e6..1b42fcba597d4 100644 --- a/src/algebraic_topology/simplicial_set.lean +++ b/src/algebraic_topology/simplicial_set.lean @@ -8,7 +8,7 @@ import algebraic_topology.topological_simplex import category_theory.limits.presheaf import category_theory.limits.types import category_theory.yoneda -import topology.category.Top.limits +import topology.category.Top.limits.basic /-! A simplicial set is just a simplicial object in `Type`, @@ -24,6 +24,9 @@ and their boundaries `∂Δ[n]` and horns `Λ[n, i]`. ## Future work +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + There isn't yet a complete API for simplices, boundaries, and horns. As an example, we should have a function that constructs from a non-surjective order preserving function `fin n → fin n` @@ -32,7 +35,7 @@ a morphism `Δ[n] ⟶ ∂Δ[n]`. universes v u -open category_theory +open category_theory category_theory.limits open_locale simplicial @@ -48,7 +51,8 @@ namespace sSet is the Yoneda embedding of `n`. -/ def standard_simplex : simplex_category ⥤ sSet := yoneda -localized "notation `Δ[`n`]` := sSet.standard_simplex.obj (simplex_category.mk n)" in simplicial +localized "notation (name := standard_simplex) `Δ[`n`]` := + sSet.standard_simplex.obj (simplex_category.mk n)" in simplicial instance : inhabited sSet := ⟨Δ[0]⟩ @@ -68,7 +72,7 @@ def boundary (n : ℕ) : sSet := map := λ m₁ m₂ f α, ⟨f.unop ≫ (α : Δ[n].obj m₁), by { intro h, apply α.property, exact function.surjective.of_comp h }⟩ } -localized "notation `∂Δ[`n`]` := sSet.boundary n" in simplicial +localized "notation (name := sSet.boundary) `∂Δ[`n`]` := sSet.boundary n" in simplicial /-- The inclusion of the boundary of the `n`-th standard simplex into that standard simplex. -/ def boundary_inclusion (n : ℕ) : @@ -91,7 +95,7 @@ def horn (n : ℕ) (i : fin (n+1)) : sSet := exact set.range_comp_subset_range _ _ hj, end⟩ } -localized "notation `Λ[`n`, `i`]` := sSet.horn (n : ℕ) i" in simplicial +localized "notation (name := sSet.horn) `Λ[`n`, `i`]` := sSet.horn (n : ℕ) i" in simplicial /-- The inclusion of the `i`-th horn of the `n`-th standard simplex into that standard simplex. -/ def horn_inclusion (n : ℕ) (i : fin (n+1)) : @@ -119,10 +123,30 @@ def sk (n : ℕ) : sSet ⥤ sSet.truncated n := simplicial_object.sk n instance {n} : inhabited (sSet.truncated n) := ⟨(sk n).obj $ Δ[0]⟩ +/-- The category of augmented simplicial sets, as a particular case of +augmented simplicial objects. -/ +abbreviation augmented := simplicial_object.augmented (Type u) + +namespace augmented + +/-- The functor which sends `[n]` to the simplicial set `Δ[n]` equipped by +the obvious augmentation towards the terminal object of the category of sets. -/ +@[simps] +noncomputable def standard_simplex : simplex_category ⥤ sSet.augmented := +{ obj := λ Δ, + { left := sSet.standard_simplex.obj Δ, + right := terminal _, + hom := { app := λ Δ', terminal.from _, }, }, + map := λ Δ₁ Δ₂ θ, + { left := sSet.standard_simplex.map θ, + right := terminal.from _, }, } + +end augmented + end sSet /-- The functor associating the singular simplicial set to a topological space. -/ -noncomputable def Top.to_sSet : Top ⥤ sSet := +def Top.to_sSet : Top ⥤ sSet := colimit_adj.restricted_yoneda simplex_category.to_Top /-- The geometric realization functor. -/ diff --git a/src/algebraic_topology/split_simplicial_object.lean b/src/algebraic_topology/split_simplicial_object.lean new file mode 100644 index 0000000000000..18a1a01d2a18c --- /dev/null +++ b/src/algebraic_topology/split_simplicial_object.lean @@ -0,0 +1,434 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebraic_topology.simplicial_object +import category_theory.limits.shapes.finite_products + +/-! + +# Split simplicial objects + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we introduce the notion of split simplicial object. +If `C` is a category that has finite coproducts, a splitting +`s : splitting X` of a simplical object `X` in `C` consists +of the datum of a sequence of objects `s.N : ℕ → C` (which +we shall refer to as "nondegenerate simplices") and a +sequence of morphisms `s.ι n : s.N n → X _[n]` that have +the property that a certain canonical map identifies `X _[n]` +with the coproduct of objects `s.N i` indexed by all possible +epimorphisms `[n] ⟶ [i]` in `simplex_category`. (We do not +assume that the morphisms `s.ι n` are monomorphisms: in the +most common categories, this would be a consequence of the +axioms.) + +Simplicial objects equipped with a splitting form a category +`simplicial_object.split C`. + +## References +* [Stacks: Splitting simplicial objects] https://stacks.math.columbia.edu/tag/017O + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits + opposite simplex_category +open_locale simplicial + +universe u + +variables {C : Type*} [category C] + +namespace simplicial_object + +namespace splitting + +/-- The index set which appears in the definition of split simplicial objects. -/ +def index_set (Δ : simplex_categoryᵒᵖ) := +Σ (Δ' : simplex_categoryᵒᵖ), { α : Δ.unop ⟶ Δ'.unop // epi α } + +namespace index_set + +/-- The element in `splitting.index_set Δ` attached to an epimorphism `f : Δ ⟶ Δ'`. -/ +@[simps] +def mk {Δ Δ' : simplex_category} (f : Δ ⟶ Δ') [epi f] : index_set (op Δ) := +⟨op Δ', f, infer_instance⟩ + +variables {Δ' Δ : simplex_categoryᵒᵖ} (A : index_set Δ) (θ : Δ ⟶ Δ') + +/-- The epimorphism in `simplex_category` associated to `A : splitting.index_set Δ` -/ +def e := A.2.1 + +instance : epi A.e := A.2.2 + +lemma ext' : A = ⟨A.1, ⟨A.e, A.2.2⟩⟩ := by tidy + +lemma ext (A₁ A₂ : index_set Δ) (h₁ : A₁.1 = A₂.1) + (h₂ : A₁.e ≫ eq_to_hom (by rw h₁) = A₂.e) : A₁ = A₂ := +begin + rcases A₁ with ⟨Δ₁, ⟨α₁, hα₁⟩⟩, + rcases A₂ with ⟨Δ₂, ⟨α₂, hα₂⟩⟩, + simp only at h₁, + subst h₁, + simp only [eq_to_hom_refl, comp_id, index_set.e] at h₂, + simp only [h₂], +end + +instance : fintype (index_set Δ) := +fintype.of_injective + ((λ A, ⟨⟨A.1.unop.len, nat.lt_succ_iff.mpr + (len_le_of_epi (infer_instance : epi A.e))⟩, A.e.to_order_hom⟩) : + index_set Δ → (sigma (λ (k : fin (Δ.unop.len+1)), (fin (Δ.unop.len+1) → fin (k+1))))) +begin + rintros ⟨Δ₁, α₁⟩ ⟨Δ₂, α₂⟩ h₁, + induction Δ₁ using opposite.rec, + induction Δ₂ using opposite.rec, + simp only at h₁, + have h₂ : Δ₁ = Δ₂ := by { ext1, simpa only [fin.mk_eq_mk] using h₁.1, }, + subst h₂, + refine ext _ _ rfl _, + ext : 2, + exact eq_of_heq h₁.2, +end + +variable (Δ) + +/-- The distinguished element in `splitting.index_set Δ` which corresponds to the +identity of `Δ`. -/ +def id : index_set Δ := ⟨Δ, ⟨𝟙 _, by apply_instance,⟩⟩ + +instance : inhabited (index_set Δ) := ⟨id Δ⟩ + +variable {Δ} + +/-- The condition that an element `splitting.index_set Δ` is the distinguished +element `splitting.index_set.id Δ`. -/ +@[simp] +def eq_id : Prop := A = id _ + +lemma eq_id_iff_eq : A.eq_id ↔ A.1 = Δ := +begin + split, + { intro h, + dsimp at h, + rw h, + refl, }, + { intro h, + rcases A with ⟨Δ', ⟨f, hf⟩⟩, + simp only at h, + subst h, + refine ext _ _ rfl _, + { haveI := hf, + simp only [eq_to_hom_refl, comp_id], + exact eq_id_of_epi f, }, }, +end + +lemma eq_id_iff_len_eq : A.eq_id ↔ A.1.unop.len = Δ.unop.len := +begin + rw eq_id_iff_eq, + split, + { intro h, + rw h, }, + { intro h, + rw ← unop_inj_iff, + ext, + exact h, }, +end + +lemma eq_id_iff_len_le : A.eq_id ↔ Δ.unop.len ≤ A.1.unop.len := +begin + rw eq_id_iff_len_eq, + split, + { intro h, + rw h, }, + { exact le_antisymm (len_le_of_epi (infer_instance : epi A.e)), }, +end + +lemma eq_id_iff_mono : A.eq_id ↔ mono A.e := +begin + split, + { intro h, + dsimp at h, + subst h, + dsimp only [id, e], + apply_instance, }, + { intro h, + rw eq_id_iff_len_le, + exact len_le_of_mono h, } +end + +/-- Given `A : index_set Δ₁`, if `p.unop : unop Δ₂ ⟶ unop Δ₁` is an epi, this +is the obvious element in `A : index_set Δ₂` associated to the composition +of epimorphisms `p.unop ≫ A.e`. -/ +@[simps] +def epi_comp {Δ₁ Δ₂ : simplex_categoryᵒᵖ} (A : index_set Δ₁) (p : Δ₁ ⟶ Δ₂) [epi p.unop] : + index_set Δ₂ := ⟨A.1, ⟨p.unop ≫ A.e, epi_comp _ _⟩⟩ + +/-- +When `A : index_set Δ` and `θ : Δ → Δ'` is a morphism in `simplex_categoryᵒᵖ`, +an element in `index_set Δ'` can be defined by using the epi-mono factorisation +of `θ.unop ≫ A.e`. -/ +def pull : index_set Δ' := mk (factor_thru_image (θ.unop ≫ A.e)) + +@[reassoc] +lemma fac_pull : (A.pull θ).e ≫ image.ι (θ.unop ≫ A.e) = θ.unop ≫ A.e := image.fac _ + +end index_set + +variables (N : ℕ → C) (Δ : simplex_categoryᵒᵖ) + (X : simplicial_object C) (φ : Π n, N n ⟶ X _[n]) + +/-- Given a sequences of objects `N : ℕ → C` in a category `C`, this is +a family of objects indexed by the elements `A : splitting.index_set Δ`. +The `Δ`-simplices of a split simplicial objects shall identify to the +coproduct of objects in such a family. -/ +@[simp, nolint unused_arguments] +def summand (A : index_set Δ) : C := N A.1.unop.len + +variable [has_finite_coproducts C] + +/-- The coproduct of the family `summand N Δ` -/ +@[simp] +def coprod := ∐ summand N Δ + +variable {Δ} + +/-- The inclusion of a summand in the coproduct. -/ +@[simp] +def ι_coprod (A : index_set Δ) : N A.1.unop.len ⟶ coprod N Δ := sigma.ι _ A + +variables {N} + +/-- The canonical morphism `coprod N Δ ⟶ X.obj Δ` attached to a sequence +of objects `N` and a sequence of morphisms `N n ⟶ X _[n]`. -/ +@[simp] +def map (Δ : simplex_categoryᵒᵖ) : coprod N Δ ⟶ X.obj Δ := +sigma.desc (λ A, φ A.1.unop.len ≫ X.map A.e.op) + +end splitting + +variable [has_finite_coproducts C] + +/-- A splitting of a simplicial object `X` consists of the datum of a sequence +of objects `N`, a sequence of morphisms `ι : N n ⟶ X _[n]` such that +for all `Δ : simplex_categoryhᵒᵖ`, the canonical map `splitting.map X ι Δ` +is an isomorphism. -/ +@[nolint has_nonempty_instance] +structure splitting (X : simplicial_object C) := +(N : ℕ → C) +(ι : Π n, N n ⟶ X _[n]) +(map_is_iso' : ∀ (Δ : simplex_categoryᵒᵖ), is_iso (splitting.map X ι Δ)) + +namespace splitting + +variables {X Y : simplicial_object C} (s : splitting X) + +instance map_is_iso (Δ : simplex_categoryᵒᵖ) : is_iso (splitting.map X s.ι Δ) := +s.map_is_iso' Δ + +/-- The isomorphism on simplices given by the axiom `splitting.map_is_iso'` -/ +@[simps] +def iso (Δ : simplex_categoryᵒᵖ) : coprod s.N Δ ≅ X.obj Δ := +as_iso (splitting.map X s.ι Δ) + +/-- Via the isomorphism `s.iso Δ`, this is the inclusion of a summand +in the direct sum decomposition given by the splitting `s : splitting X`. -/ +def ι_summand {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) : + s.N A.1.unop.len ⟶ X.obj Δ := +splitting.ι_coprod s.N A ≫ (s.iso Δ).hom + +@[reassoc] +lemma ι_summand_eq {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) : + s.ι_summand A = s.ι A.1.unop.len ≫ X.map A.e.op := +begin + dsimp only [ι_summand, iso.hom], + erw [colimit.ι_desc, cofan.mk_ι_app], +end + +lemma ι_summand_id (n : ℕ) : s.ι_summand (index_set.id (op [n])) = s.ι n := +by { erw [ι_summand_eq, X.map_id, comp_id], refl, } + +/-- As it is stated in `splitting.hom_ext`, a morphism `f : X ⟶ Y` from a split +simplicial object to any simplicial object is determined by its restrictions +`s.φ f n : s.N n ⟶ Y _[n]` to the distinguished summands in each degree `n`. -/ +@[simp] +def φ (f : X ⟶ Y) (n : ℕ) : s.N n ⟶ Y _[n] := s.ι n ≫ f.app (op [n]) + +@[simp, reassoc] +lemma ι_summand_comp_app (f : X ⟶ Y) {Δ : simplex_categoryᵒᵖ} (A : index_set Δ) : + s.ι_summand A ≫ f.app Δ = s.φ f A.1.unop.len ≫ Y.map A.e.op := +by simp only [ι_summand_eq_assoc, φ, nat_trans.naturality, assoc] + +lemma hom_ext' {Z : C} {Δ : simplex_categoryᵒᵖ} (f g : X.obj Δ ⟶ Z) + (h : ∀ (A : index_set Δ), s.ι_summand A ≫ f = s.ι_summand A ≫ g) : + f = g := +begin + rw ← cancel_epi (s.iso Δ).hom, + ext A, + discrete_cases, + simpa only [ι_summand_eq, iso_hom, colimit.ι_desc_assoc, cofan.mk_ι_app, assoc] using h A, +end + +lemma hom_ext (f g : X ⟶ Y) (h : ∀ n : ℕ, s.φ f n = s.φ g n) : f = g := +begin + ext Δ, + apply s.hom_ext', + intro A, + induction Δ using opposite.rec, + induction Δ using simplex_category.rec with n, + dsimp, + simp only [s.ι_summand_comp_app, h], +end + +/-- The map `X.obj Δ ⟶ Z` obtained by providing a family of morphisms on all the +terms of decomposition given by a splitting `s : splitting X` -/ +def desc {Z : C} (Δ : simplex_categoryᵒᵖ) + (F : Π (A : index_set Δ), s.N A.1.unop.len ⟶ Z) : X.obj Δ ⟶ Z := +(s.iso Δ).inv ≫ sigma.desc F + +@[simp, reassoc] +lemma ι_desc {Z : C} (Δ : simplex_categoryᵒᵖ) + (F : Π (A : index_set Δ), s.N A.1.unop.len ⟶ Z) (A : index_set Δ) : + s.ι_summand A ≫ s.desc Δ F = F A := +begin + dsimp only [ι_summand, desc], + simp only [assoc, iso.hom_inv_id_assoc, ι_coprod], + erw [colimit.ι_desc, cofan.mk_ι_app], +end + +/-- A simplicial object that is isomorphic to a split simplicial object is split. -/ +@[simps] +def of_iso (e : X ≅ Y) : splitting Y := +{ N := s.N, + ι := λ n, s.ι n ≫ e.hom.app (op [n]), + map_is_iso' := λ Δ, begin + convert (infer_instance : is_iso ((s.iso Δ).hom ≫ e.hom.app Δ)), + tidy, + end, } + +@[reassoc] +lemma ι_summand_epi_naturality {Δ₁ Δ₂ : simplex_categoryᵒᵖ} (A : index_set Δ₁) + (p : Δ₁ ⟶ Δ₂) [epi p.unop] : + s.ι_summand A ≫ X.map p = s.ι_summand (A.epi_comp p) := +begin + dsimp [ι_summand], + erw [colimit.ι_desc, colimit.ι_desc, cofan.mk_ι_app, cofan.mk_ι_app], + dsimp only [index_set.epi_comp, index_set.e], + rw [op_comp, X.map_comp, assoc, quiver.hom.op_unop], +end + +end splitting + +variable (C) + +/-- The category `simplicial_object.split C` is the category of simplicial objects +in `C` equipped with a splitting, and morphisms are morphisms of simplicial objects +which are compatible with the splittings. -/ +@[ext, nolint has_nonempty_instance] +structure split := (X : simplicial_object C) (s : splitting X) + +namespace split + +variable {C} + +/-- The object in `simplicial_object.split C` attached to a splitting `s : splitting X` +of a simplicial object `X`. -/ +@[simps] +def mk' {X : simplicial_object C} (s : splitting X) : split C := ⟨X, s⟩ + +/-- Morphisms in `simplicial_object.split C` are morphisms of simplicial objects that +are compatible with the splittings. -/ +@[nolint has_nonempty_instance] +structure hom (S₁ S₂ : split C) := +(F : S₁.X ⟶ S₂.X) +(f : Π (n : ℕ), S₁.s.N n ⟶ S₂.s.N n) +(comm' : ∀ (n : ℕ), S₁.s.ι n ≫ F.app (op [n]) = f n ≫ S₂.s.ι n) + +@[ext] +lemma hom.ext {S₁ S₂ : split C} (Φ₁ Φ₂ : hom S₁ S₂) (h : ∀ (n : ℕ), Φ₁.f n = Φ₂.f n) : + Φ₁ = Φ₂ := +begin + rcases Φ₁ with ⟨F₁, f₁, c₁⟩, + rcases Φ₂ with ⟨F₂, f₂, c₂⟩, + have h' : f₁ = f₂ := by { ext, apply h, }, + subst h', + simp only [eq_self_iff_true, and_true], + apply S₁.s.hom_ext, + intro n, + dsimp, + rw [c₁, c₂], +end + +restate_axiom hom.comm' +attribute [simp, reassoc] hom.comm + +end split + +instance : category (split C) := +{ hom := split.hom, + id := λ S, { F := 𝟙 _, f := λ n, 𝟙 _, comm' := by tidy, }, + comp := λ S₁ S₂ S₃ Φ₁₂ Φ₂₃, + { F := Φ₁₂.F ≫ Φ₂₃.F, f := λ n, Φ₁₂.f n ≫ Φ₂₃.f n, comm' := by tidy, }, } + +variable {C} + +namespace split + +lemma congr_F {S₁ S₂ : split C} {Φ₁ Φ₂ : S₁ ⟶ S₂} (h : Φ₁ = Φ₂) : Φ₁.F = Φ₂.F := by rw h +lemma congr_f {S₁ S₂ : split C} {Φ₁ Φ₂ : S₁ ⟶ S₂} (h : Φ₁ = Φ₂) (n : ℕ) : + Φ₁.f n = Φ₂.f n := by rw h + +@[simp] +lemma id_F (S : split C) : (𝟙 S : S ⟶ S).F = 𝟙 (S.X) := rfl + +@[simp] +lemma id_f (S : split C) (n : ℕ) : (𝟙 S : S ⟶ S).f n = 𝟙 (S.s.N n) := rfl + +@[simp] +lemma comp_F {S₁ S₂ S₃ : split C} (Φ₁₂ : S₁ ⟶ S₂) (Φ₂₃ : S₂ ⟶ S₃) : + (Φ₁₂ ≫ Φ₂₃).F = Φ₁₂.F ≫ Φ₂₃.F := rfl + +@[simp] +lemma comp_f {S₁ S₂ S₃ : split C} (Φ₁₂ : S₁ ⟶ S₂) (Φ₂₃ : S₂ ⟶ S₃) (n : ℕ) : + (Φ₁₂ ≫ Φ₂₃).f n = Φ₁₂.f n ≫ Φ₂₃.f n := rfl + +@[simp, reassoc] +lemma ι_summand_naturality_symm {S₁ S₂ : split C} (Φ : S₁ ⟶ S₂) + {Δ : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) : + S₁.s.ι_summand A ≫ Φ.F.app Δ = Φ.f A.1.unop.len ≫ S₂.s.ι_summand A := +by rw [S₁.s.ι_summand_eq, S₂.s.ι_summand_eq, assoc, Φ.F.naturality, ← Φ.comm_assoc] + +variable (C) + +/-- The functor `simplicial_object.split C ⥤ simplicial_object C` which forgets +the splitting. -/ +@[simps] +def forget : split C ⥤ simplicial_object C := +{ obj := λ S, S.X, + map := λ S₁ S₂ Φ, Φ.F, } + +/-- The functor `simplicial_object.split C ⥤ C` which sends a simplicial object equipped +with a splitting to its nondegenerate `n`-simplices. -/ +@[simps] +def eval_N (n : ℕ) : split C ⥤ C := +{ obj := λ S, S.s.N n, + map := λ S₁ S₂ Φ, Φ.f n, } + +/-- The inclusion of each summand in the coproduct decomposition of simplices +in split simplicial objects is a natural transformation of functors +`simplicial_object.split C ⥤ C` -/ +@[simps] +def nat_trans_ι_summand {Δ : simplex_categoryᵒᵖ} (A : splitting.index_set Δ) : + eval_N C A.1.unop.len ⟶ forget C ⋙ (evaluation simplex_categoryᵒᵖ C).obj Δ := +{ app := λ S, S.s.ι_summand A, + naturality' := λ S₁ S₂ Φ, (ι_summand_naturality_symm Φ A).symm, } + +end split + +end simplicial_object diff --git a/src/algebraic_topology/topological_simplex.lean b/src/algebraic_topology/topological_simplex.lean index abf904e11b970..552095a9fa087 100644 --- a/src/algebraic_topology/topological_simplex.lean +++ b/src/algebraic_topology/topological_simplex.lean @@ -10,6 +10,9 @@ import topology.instances.nnreal /-! # Topological simplices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the natural functor from `simplex_category` to `Top` sending `[n]` to the topological `n`-simplex. This is used to define `Top.to_sSet` in `algebraic_topology.simpliciaL_set`. @@ -40,15 +43,16 @@ lemma to_Top_obj.ext {x : simplex_category} (f g : x.to_Top_obj) : def to_Top_map {x y : simplex_category} (f : x ⟶ y) : x.to_Top_obj → y.to_Top_obj := λ g, ⟨λ i, ∑ j in (finset.univ.filter (λ k, f k = i)), g j, begin - dsimp [to_Top_obj], - simp only [finset.filter_congr_decidable, finset.sum_congr], + simp only [finset.filter_congr_decidable, finset.sum_congr, to_Top_obj, set.mem_set_of], rw ← finset.sum_bUnion, convert g.2, { rw finset.eq_univ_iff_forall, intros i, rw finset.mem_bUnion, exact ⟨f i, by simp, by simp⟩ }, - { intros i hi j hj h e he, + { intros i hi j hj h, + rw [function.on_fun, disjoint_iff_inf_le], + intros e he, apply h, simp only [true_and, finset.inf_eq_inter, finset.mem_univ, finset.mem_filter, finset.mem_inter] at he, @@ -62,8 +66,8 @@ lemma coe_to_Top_map {x y : simplex_category} (f : x ⟶ y) (g : x.to_Top_obj) ( @[continuity] lemma continuous_to_Top_map {x y : simplex_category} (f : x ⟶ y) : continuous (to_Top_map f) := -continuous_subtype_mk _ $ continuous_pi $ λ i, continuous_finset_sum _ $ - λ j hj, continuous.comp (continuous_apply _) continuous_subtype_val +continuous.subtype_mk (continuous_pi $ λ i, continuous_finset_sum _ $ + λ j hj, (continuous_apply _).comp continuous_subtype_val) _ /-- The functor associating the topological `n`-simplex to `[n] : simplex_category`. -/ @[simps] @@ -84,7 +88,9 @@ def to_Top : simplex_category ⥤ Top := apply finset.sum_congr, { exact finset.ext (λ j, ⟨λ hj, by simpa using hj, λ hj, by simpa using hj⟩) }, { tauto }, - { intros j hj k hk h e he, + { intros j hj k hk h, + rw [function.on_fun, disjoint_iff_inf_le], + intros e he, apply h, simp only [true_and, finset.inf_eq_inter, finset.mem_univ, finset.mem_filter, finset.mem_inter] at he, diff --git a/src/analysis/ODE/gronwall.lean b/src/analysis/ODE/gronwall.lean index 06a3849e4cc4b..3c9bd852517ed 100644 --- a/src/analysis/ODE/gronwall.lean +++ b/src/analysis/ODE/gronwall.lean @@ -8,9 +8,12 @@ import analysis.special_functions.exp_deriv /-! # Grönwall's inequality +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The main technical result of this file is the Grönwall-like inequality -`norm_le_gronwall_bound_of_norm_deriv_right_le`. It states that if `f : ℝ → E` satisfies `∥f a∥ ≤ δ` -and `∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then for all `x ∈ [a, b]` we have `∥f x∥ ≤ δ * exp (K * +`norm_le_gronwall_bound_of_norm_deriv_right_le`. It states that if `f : ℝ → E` satisfies `‖f a‖ ≤ δ` +and `∀ x ∈ [a, b), ‖f' x‖ ≤ K * ‖f x‖ + ε`, then for all `x ∈ [a, b]` we have `‖f x‖ ≤ δ * exp (K * x) + (ε / K) * (exp (K * x) - 1)`. Then we use this inequality to prove some estimates on the possible rate of growth of the distance @@ -22,16 +25,16 @@ Sec. 4.5][HubbardWest-ode], where `norm_le_gronwall_bound_of_norm_deriv_right_le ## TODO -- Once we have FTC, prove an inequality for a function satisfying `∥f' x∥ ≤ K x * ∥f x∥ + ε`, +- Once we have FTC, prove an inequality for a function satisfying `‖f' x‖ ≤ K x * ‖f x‖ + ε`, or more generally `liminf_{y→x+0} (f y - f x)/(y - x) ≤ K x * f x + ε` with any sign of `K x` and `f x`. -/ -variables {E : Type*} [normed_group E] [normed_space ℝ E] - {F : Type*} [normed_group F] [normed_space ℝ F] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] + {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] open metric set asymptotics filter real -open_locale classical topological_space nnreal +open_locale classical topology nnreal /-! ### Technical lemmas about `gronwall_bound` -/ @@ -101,7 +104,7 @@ the inequalities `f a ≤ δ` and `∀ x ∈ [a, b), liminf_{z→x+0} (f z - f x)/(z - x) ≤ K * (f x) + ε`, then `f x` is bounded by `gronwall_bound δ K ε (x - a)` on `[a, b]`. -See also `norm_le_gronwall_bound_of_norm_deriv_right_le` for a version bounding `∥f x∥`, +See also `norm_le_gronwall_bound_of_norm_deriv_right_le` for a version bounding `‖f x‖`, `f : ℝ → E`. -/ theorem le_gronwall_bound_of_liminf_deriv_right_le {f f' : ℝ → ℝ} {δ K ε : ℝ} {a b : ℝ} (hf : continuous_on f (Icc a b)) @@ -128,13 +131,13 @@ begin end /-- A Grönwall-like inequality: if `f : ℝ → E` is continuous on `[a, b]`, has right derivative -`f' x` at every point `x ∈ [a, b)`, and satisfies the inequalities `∥f a∥ ≤ δ`, -`∀ x ∈ [a, b), ∥f' x∥ ≤ K * ∥f x∥ + ε`, then `∥f x∥` is bounded by `gronwall_bound δ K ε (x - a)` +`f' x` at every point `x ∈ [a, b)`, and satisfies the inequalities `‖f a‖ ≤ δ`, +`∀ x ∈ [a, b), ‖f' x‖ ≤ K * ‖f x‖ + ε`, then `‖f x‖` is bounded by `gronwall_bound δ K ε (x - a)` on `[a, b]`. -/ theorem norm_le_gronwall_bound_of_norm_deriv_right_le {f f' : ℝ → E} {δ K ε : ℝ} {a b : ℝ} (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x) - (ha : ∥f a∥ ≤ δ) (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ K * ∥f x∥ + ε) : - ∀ x ∈ Icc a b, ∥f x∥ ≤ gronwall_bound δ K ε (x - a) := + (ha : ‖f a‖ ≤ δ) (bound : ∀ x ∈ Ico a b, ‖f' x‖ ≤ K * ‖f x‖ + ε) : + ∀ x ∈ Icc a b, ‖f x‖ ≤ gronwall_bound δ K ε (x - a) := le_gronwall_bound_of_liminf_deriv_right_le (continuous_norm.comp_continuous_on hf) (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le hr) ha bound diff --git a/src/analysis/ODE/picard_lindelof.lean b/src/analysis/ODE/picard_lindelof.lean index 9e8f2a77c6e97..2b247eaacb36b 100644 --- a/src/analysis/ODE/picard_lindelof.lean +++ b/src/analysis/ODE/picard_lindelof.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2021 Yury G. Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yury G. Kudryashov +Authors: Yury G. Kudryashov, Winston Yin -/ import analysis.special_functions.integrals import topology.metric_space.contracting @@ -9,15 +9,23 @@ import topology.metric_space.contracting /-! # Picard-Lindelöf (Cauchy-Lipschitz) Theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that an ordinary differential equation $\dot x=v(t, x)$ such that $v$ is Lipschitz continuous in $x$ and continuous in $t$ has a local solution, see -`exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous`. +`exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof`. + +As a corollary, we prove that a time-independent locally continuously differentiable ODE has a +local solution. ## Implementation notes In order to split the proof into small lemmas, we introduce a structure `picard_lindelof` that holds all assumptions of the main theorem. This structure and lemmas in the `picard_lindelof` namespace -should be treated as private implementation details. +should be treated as private implementation details. This is not to be confused with the `Prop`- +valued structure `is_picard_lindelof`, which holds the long hypotheses of the Picard-Lindelöf +theorem for actual use as part of the public API. We only prove existence of a solution in this file. For uniqueness see `ODE_solution_unique` and related theorems in `analysis.ODE.gronwall`. @@ -29,25 +37,41 @@ differential equation open filter function set metric topological_space interval_integral measure_theory open measure_theory.measure_space (volume) -open_locale filter topological_space nnreal ennreal nat interval +open_locale filter topology nnreal ennreal nat interval noncomputable theory -variables {E : Type*} [normed_group E] [normed_space ℝ E] - -/-- This structure holds arguments of the Picard-Lipschitz (Cauchy-Lipschitz) theorem. Unless you -want to use one of the auxiliary lemmas, use -`exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous` instead of using this structure. -/ -structure picard_lindelof (E : Type*) [normed_group E] [normed_space ℝ E] := +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] + +/-- `Prop` structure holding the hypotheses of the Picard-Lindelöf theorem. + +The similarly named `picard_lindelof` structure is part of the internal API for convenience, so as +not to constantly invoke choice, but is not intended for public use. -/ +structure is_picard_lindelof + {E : Type*} [normed_add_comm_group E] (v : ℝ → E → E) (t_min t₀ t_max : ℝ) (x₀ : E) + (L : ℝ≥0) (R C : ℝ) : Prop := +(ht₀ : t₀ ∈ Icc t_min t_max) +(hR : 0 ≤ R) +(lipschitz : ∀ t ∈ Icc t_min t_max, lipschitz_on_with L (v t) (closed_ball x₀ R)) +(cont : ∀ x ∈ closed_ball x₀ R, continuous_on (λ (t : ℝ), v t x) (Icc t_min t_max)) +(norm_le : ∀ (t ∈ Icc t_min t_max) (x ∈ closed_ball x₀ R), ‖v t x‖ ≤ C) +(C_mul_le_R : (C : ℝ) * linear_order.max (t_max - t₀) (t₀ - t_min) ≤ R) + +/-- This structure holds arguments of the Picard-Lipschitz (Cauchy-Lipschitz) theorem. It is part of +the internal API for convenience, so as not to constantly invoke choice. Unless you want to use one +of the auxiliary lemmas, use `exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous` instead +of using this structure. + +The similarly named `is_picard_lindelof` is a bundled `Prop` holding the long hypotheses of the +Picard-Lindelöf theorem as named arguments. It is used as part of the public API. +-/ +structure picard_lindelof (E : Type*) [normed_add_comm_group E] [normed_space ℝ E] := (to_fun : ℝ → E → E) (t_min t_max : ℝ) (t₀ : Icc t_min t_max) (x₀ : E) (C R L : ℝ≥0) -(lipschitz' : ∀ t ∈ Icc t_min t_max, lipschitz_on_with L (to_fun t) (closed_ball x₀ R)) -(cont : ∀ x ∈ closed_ball x₀ R, continuous_on (λ t, to_fun t x) (Icc t_min t_max)) -(norm_le' : ∀ (t ∈ Icc t_min t_max) (x ∈ closed_ball x₀ R), ∥to_fun t x∥ ≤ C) -(C_mul_le_R : (C : ℝ) * max (t_max - t₀) (t₀ - t_min) ≤ R) +(is_pl : is_picard_lindelof to_fun t_min t₀ t_max x₀ L R C) namespace picard_lindelof @@ -56,9 +80,13 @@ variables (v : picard_lindelof E) instance : has_coe_to_fun (picard_lindelof E) (λ _, ℝ → E → E) := ⟨to_fun⟩ instance : inhabited (picard_lindelof E) := -⟨⟨0, 0, 0, ⟨0, le_rfl, le_rfl⟩, 0, 0, 0, 0, λ t ht, (lipschitz_with.const 0).lipschitz_on_with _, - λ _ _, by simpa only [pi.zero_apply] using continuous_on_const, λ t ht x hx, norm_zero.le, - (zero_mul _).le⟩⟩ +⟨⟨0, 0, 0, ⟨0, le_rfl, le_rfl⟩, 0, 0, 0, 0, + { ht₀ := by { rw [subtype.coe_mk, Icc_self], exact mem_singleton _ }, + hR := by refl, + lipschitz := λ t ht, (lipschitz_with.const 0).lipschitz_on_with _, + cont := λ _ _, by simpa only [pi.zero_apply] using continuous_on_const, + norm_le := λ t ht x hx, norm_zero.le, + C_mul_le_R := (zero_mul _).le }⟩⟩ lemma t_min_le_t_max : v.t_min ≤ v.t_max := v.t₀.2.1.trans v.t₀.2.2 @@ -66,17 +94,17 @@ protected lemma nonempty_Icc : (Icc v.t_min v.t_max).nonempty := nonempty_Icc.2 protected lemma lipschitz_on_with {t} (ht : t ∈ Icc v.t_min v.t_max) : lipschitz_on_with v.L (v t) (closed_ball v.x₀ v.R) := -v.lipschitz' t ht +v.is_pl.lipschitz t ht protected lemma continuous_on : continuous_on (uncurry v) (Icc v.t_min v.t_max ×ˢ closed_ball v.x₀ v.R) := have continuous_on (uncurry (flip v)) (closed_ball v.x₀ v.R ×ˢ Icc v.t_min v.t_max), - from continuous_on_prod_of_continuous_on_lipschitz_on _ v.L v.cont v.lipschitz', -this.comp continuous_swap.continuous_on preimage_swap_prod.symm.subset + from continuous_on_prod_of_continuous_on_lipschitz_on _ v.L v.is_pl.cont v.is_pl.lipschitz, +this.comp continuous_swap.continuous_on (preimage_swap_prod _ _).symm.subset lemma norm_le {t : ℝ} (ht : t ∈ Icc v.t_min v.t_max) {x : E} (hx : x ∈ closed_ball v.x₀ v.R) : - ∥v t x∥ ≤ v.C := -v.norm_le' _ ht _ hx + ‖v t x‖ ≤ v.C := +v.is_pl.norm_le _ ht _ hx /-- The maximum of distances from `t₀` to the endpoints of `[t_min, t_max]`. -/ def t_dist : ℝ := max (v.t_max - v.t₀) (v.t₀ - v.t_min) @@ -150,7 +178,7 @@ protected lemma mem_closed_ball (t : Icc v.t_min v.t_max) : f t ∈ closed_ball calc dist (f t) v.x₀ = dist (f t) (f.to_fun v.t₀) : by rw f.map_t₀' ... ≤ v.C * dist t v.t₀ : f.lipschitz.dist_le_mul _ _ ... ≤ v.C * v.t_dist : mul_le_mul_of_nonneg_left (v.dist_t₀_le _) v.C.2 - ... ≤ v.R : v.C_mul_le_R + ... ≤ v.R : v.is_pl.C_mul_le_R /-- Given a curve $γ \colon [t_{\min}, t_{\max}] → E$, `v_comp` is the function $F(t)=v(π t, γ(π t))$, where `π` is the projection $ℝ → [t_{\min}, t_{\max}]$. The integral of this @@ -167,7 +195,7 @@ begin exact ⟨(v.proj x).2, f.mem_closed_ball _⟩ end -lemma norm_v_comp_le (t : ℝ) : ∥f.v_comp t∥ ≤ v.C := +lemma norm_v_comp_le (t : ℝ) : ‖f.v_comp t‖ ≤ v.C := v.norm_le (v.proj t).2 $ f.mem_closed_ball _ lemma dist_apply_le_dist (f₁ f₂ : fun_space v) (t : Icc v.t_min v.t_max) : @@ -237,21 +265,21 @@ begin simp only [dist_eq_norm, next_apply, add_sub_add_left_eq_sub, ← interval_integral.integral_sub (interval_integrable_v_comp _ _ _) (interval_integrable_v_comp _ _ _), norm_integral_eq_norm_integral_Ioc] at *, - calc ∥∫ τ in Ι (v.t₀ : ℝ) t, f₁.v_comp τ - f₂.v_comp τ∥ + calc ‖∫ τ in Ι (v.t₀ : ℝ) t, f₁.v_comp τ - f₂.v_comp τ‖ ≤ ∫ τ in Ι (v.t₀ : ℝ) t, v.L * ((v.L * |τ - v.t₀|) ^ n / n! * d) : begin - refine norm_integral_le_of_norm_le (continuous.integrable_on_interval_oc _) _, + refine norm_integral_le_of_norm_le (continuous.integrable_on_uIoc _) _, { continuity }, { refine (ae_restrict_mem measurable_set_Ioc).mono (λ τ hτ, _), refine (v.lipschitz_on_with (v.proj τ).2).norm_sub_le_of_le (f₁.mem_closed_ball _) (f₂.mem_closed_ball _) ((h _).trans_eq _), rw v.proj_of_mem, - exact (interval_subset_Icc v.t₀.2 t.2 $ Ioc_subset_Icc_self hτ) } + exact (uIcc_subset_Icc v.t₀.2 t.2 $ Ioc_subset_Icc_self hτ) } end ... = (v.L * |t - v.t₀|) ^ (n + 1) / (n + 1)! * d : _, simp_rw [mul_pow, div_eq_mul_inv, mul_assoc, measure_theory.integral_mul_left, - measure_theory.integral_mul_right, integral_pow_abs_sub_interval_oc, div_eq_mul_inv, - pow_succ (v.L : ℝ), nat.factorial_succ, nat.cast_mul, nat.cast_succ, mul_inv₀, mul_assoc] + measure_theory.integral_mul_right, integral_pow_abs_sub_uIoc, div_eq_mul_inv, + pow_succ (v.L : ℝ), nat.factorial_succ, nat.cast_mul, nat.cast_succ, mul_inv, mul_assoc] end lemma dist_iterate_next_apply_le (f₁ f₂ : fun_space v) (n : ℕ) (t : Icc v.t_min v.t_max) : @@ -295,7 +323,8 @@ let ⟨N, K, hK⟩ := exists_contracting_iterate v in ⟨_, hK.is_fixed_pt_fixed end -/-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. -/ +/-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. Use +`exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof` instead for the public API. -/ lemma exists_solution : ∃ f : ℝ → E, f v.t₀ = v.x₀ ∧ ∀ t ∈ Icc v.t_min v.t_max, has_deriv_within_at f (v t (f t)) (Icc v.t_min v.t_max) t := @@ -310,21 +339,97 @@ end end picard_lindelof +lemma is_picard_lindelof.norm_le₀ {E : Type*} [normed_add_comm_group E] + {v : ℝ → E → E} {t_min t₀ t_max : ℝ} {x₀ : E} {C R : ℝ} {L : ℝ≥0} + (hpl : is_picard_lindelof v t_min t₀ t_max x₀ L R C) : ‖v t₀ x₀‖ ≤ C := +hpl.norm_le t₀ hpl.ht₀ x₀ $ mem_closed_ball_self hpl.hR + /-- Picard-Lindelöf (Cauchy-Lipschitz) theorem. -/ -lemma exists_forall_deriv_within_Icc_eq_of_lipschitz_of_continuous - [complete_space E] - {v : ℝ → E → E} {t_min t₀ t_max : ℝ} (ht₀ : t₀ ∈ Icc t_min t_max) - (x₀ : E) {C R : ℝ} (hR : 0 ≤ R) {L : ℝ≥0} - (Hlip : ∀ t ∈ Icc t_min t_max, lipschitz_on_with L (v t) (closed_ball x₀ R)) - (Hcont : ∀ x ∈ closed_ball x₀ R, continuous_on (λ t, v t x) (Icc t_min t_max)) - (Hnorm : ∀ (t ∈ Icc t_min t_max) (x ∈ closed_ball x₀ R), ∥v t x∥ ≤ C) - (Hmul_le : C * max (t_max - t₀) (t₀ - t_min) ≤ R) : +theorem exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof + [complete_space E] {v : ℝ → E → E} {t_min t₀ t_max : ℝ} (x₀ : E) {C R : ℝ} {L : ℝ≥0} + (hpl : is_picard_lindelof v t_min t₀ t_max x₀ L R C) : ∃ f : ℝ → E, f t₀ = x₀ ∧ ∀ t ∈ Icc t_min t_max, has_deriv_within_at f (v t (f t)) (Icc t_min t_max) t := begin - lift C to ℝ≥0 using ((norm_nonneg _).trans $ Hnorm t₀ ht₀ x₀ (mem_closed_ball_self hR)), - lift R to ℝ≥0 using hR, - lift t₀ to Icc t_min t_max using ht₀, + lift C to ℝ≥0 using (norm_nonneg _).trans hpl.norm_le₀, + lift t₀ to Icc t_min t_max using hpl.ht₀, exact picard_lindelof.exists_solution - ⟨v, t_min, t_max, t₀, x₀, C, R, L, Hlip, Hcont, Hnorm, Hmul_le⟩ + ⟨v, t_min, t_max, t₀, x₀, C, ⟨R, hpl.hR⟩, L, { ht₀ := t₀.property, ..hpl }⟩ end + +variables [proper_space E] {v : E → E} (t₀ : ℝ) (x₀ : E) + +/-- A time-independent, locally continuously differentiable ODE satisfies the hypotheses of the + Picard-Lindelöf theorem. -/ +lemma exists_is_picard_lindelof_const_of_cont_diff_on_nhds + {s : set E} (hv : cont_diff_on ℝ 1 v s) (hs : s ∈ 𝓝 x₀) : + ∃ (ε > (0 : ℝ)) L R C, is_picard_lindelof (λ t, v) (t₀ - ε) t₀ (t₀ + ε) x₀ L R C := +begin + -- extract Lipschitz constant + obtain ⟨L, s', hs', hlip⟩ := cont_diff_at.exists_lipschitz_on_with + ((hv.cont_diff_within_at (mem_of_mem_nhds hs)).cont_diff_at hs), + -- radius of closed ball in which v is bounded + obtain ⟨r, hr : 0 < r, hball⟩ := metric.mem_nhds_iff.mp (inter_sets (𝓝 x₀) hs hs'), + have hr' := (half_pos hr).le, + obtain ⟨C, hC⟩ := (is_compact_closed_ball x₀ (r / 2)).bdd_above_image -- uses proper_space E + (hv.continuous_on.norm.mono (subset_inter_iff.mp + ((closed_ball_subset_ball (half_lt_self hr)).trans hball)).left), + have hC' : 0 ≤ C, + { apply (norm_nonneg (v x₀)).trans, + apply hC, + exact ⟨x₀, ⟨mem_closed_ball_self hr', rfl⟩⟩ }, + set ε := if C = 0 then 1 else (r / 2 / C) with hε, + have hε0 : 0 < ε, + { rw hε, + split_ifs, + { exact zero_lt_one }, + { exact div_pos (half_pos hr) (lt_of_le_of_ne hC' (ne.symm h)) } }, + refine ⟨ε, hε0, L, r / 2, C, _⟩, + exact { ht₀ := by {rw ←real.closed_ball_eq_Icc, exact mem_closed_ball_self hε0.le}, + hR := (half_pos hr).le, + lipschitz := λ t ht, hlip.mono (subset_inter_iff.mp + (subset_trans (closed_ball_subset_ball (half_lt_self hr)) hball)).2, + cont := λ x hx, continuous_on_const, + norm_le := λ t ht x hx, hC ⟨x, hx, rfl⟩, + C_mul_le_R := begin + rw [add_sub_cancel', sub_sub_cancel, max_self, mul_ite, mul_one], + split_ifs, + { rwa ← h at hr' }, + { exact (mul_div_cancel' (r / 2) h).le } + end } +end + +/-- A time-independent, locally continuously differentiable ODE admits a solution in some open +interval. -/ +theorem exists_forall_deriv_at_Ioo_eq_of_cont_diff_on_nhds + {s : set E} (hv : cont_diff_on ℝ 1 v s) (hs : s ∈ 𝓝 x₀) : + ∃ (ε > (0 : ℝ)) (f : ℝ → E), f t₀ = x₀ ∧ + ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), f t ∈ s ∧ has_deriv_at f (v (f t)) t := +begin + obtain ⟨ε, hε, L, R, C, hpl⟩ := exists_is_picard_lindelof_const_of_cont_diff_on_nhds t₀ x₀ hv hs, + obtain ⟨f, hf1, hf2⟩ := exists_forall_deriv_within_Icc_eq_of_is_picard_lindelof x₀ hpl, + have hf2' : ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), has_deriv_at f (v (f t)) t := + λ t ht, (hf2 t (Ioo_subset_Icc_self ht)).has_deriv_at (Icc_mem_nhds ht.1 ht.2), + have h : (f ⁻¹' s) ∈ 𝓝 t₀, + { have := (hf2' t₀ (mem_Ioo.mpr ⟨sub_lt_self _ hε, lt_add_of_pos_right _ hε⟩)), + apply continuous_at.preimage_mem_nhds this.continuous_at, + rw hf1, + exact hs }, + rw metric.mem_nhds_iff at h, + obtain ⟨r, hr1, hr2⟩ := h, + refine ⟨min r ε, lt_min hr1 hε, f, hf1, λ t ht, + ⟨_, hf2' t (mem_of_mem_of_subset ht (Ioo_subset_Ioo + (sub_le_sub_left (min_le_right _ _) _) (add_le_add_left (min_le_right _ _) _)))⟩⟩, + rw ←set.mem_preimage, + apply set.mem_of_mem_of_subset _ hr2, + apply set.mem_of_mem_of_subset ht, + rw ←real.ball_eq_Ioo, + exact (metric.ball_subset_ball (min_le_left _ _)) +end + +/-- A time-independent, continuously differentiable ODE admits a solution in some open interval. -/ +theorem exists_forall_deriv_at_Ioo_eq_of_cont_diff + (hv : cont_diff ℝ 1 v) : ∃ (ε > (0 : ℝ)) (f : ℝ → E), f t₀ = x₀ ∧ + ∀ t ∈ Ioo (t₀ - ε) (t₀ + ε), has_deriv_at f (v (f t)) t := +let ⟨ε, hε, f, hf1, hf2⟩ := exists_forall_deriv_at_Ioo_eq_of_cont_diff_on_nhds t₀ x₀ hv.cont_diff_on + (is_open.mem_nhds is_open_univ (mem_univ _)) in ⟨ε, hε, f, hf1, λ t ht, (hf2 t ht).2⟩ diff --git a/src/analysis/analytic/basic.lean b/src/analysis/analytic/basic.lean index 02deec2c320b5..ce82b42524bcd 100644 --- a/src/analysis/analytic/basic.lean +++ b/src/analysis/analytic/basic.lean @@ -6,10 +6,14 @@ Authors: Sébastien Gouëzel, Yury Kudryashov import analysis.calculus.formal_multilinear_series import analysis.specific_limits.normed import logic.equiv.fin +import topology.algebra.infinite_sum.module /-! # Analytic functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A function is analytic in one dimension around `0` if it can be written as a converging power series `Σ pₙ zⁿ`. This definition can be extended to any dimension (even in infinite dimension) by requiring that `pₙ` is a continuous `n`-multilinear map. In general, `pₙ` is not unique (in two @@ -27,13 +31,13 @@ space is analytic, as well as the inverse on invertible operators. Let `p` be a formal multilinear series from `E` to `F`, i.e., `p n` is a multilinear map on `E^n` for `n : ℕ`. -* `p.radius`: the largest `r : ℝ≥0∞` such that `∥p n∥ * r^n` grows subexponentially. -* `p.le_radius_of_bound`, `p.le_radius_of_bound_nnreal`, `p.le_radius_of_is_O`: if `∥p n∥ * r ^ n` +* `p.radius`: the largest `r : ℝ≥0∞` such that `‖p n‖ * r^n` grows subexponentially. +* `p.le_radius_of_bound`, `p.le_radius_of_bound_nnreal`, `p.le_radius_of_is_O`: if `‖p n‖ * r ^ n` is bounded above, then `r ≤ p.radius`; * `p.is_o_of_lt_radius`, `p.norm_mul_pow_le_mul_pow_of_lt_radius`, `p.is_o_one_of_lt_radius`, `p.norm_mul_pow_le_of_lt_radius`, `p.nnnorm_mul_pow_le_of_lt_radius`: if `r < p.radius`, then - `∥p n∥ * r ^ n` tends to zero exponentially; -* `p.lt_radius_of_is_O`: if `r ≠ 0` and `∥p n∥ * r ^ n = O(a ^ n)` for some `-1 < a < 1`, then + `‖p n‖ * r ^ n` tends to zero exponentially; +* `p.lt_radius_of_is_O`: if `r ≠ 0` and `‖p n‖ * r ^ n = O(a ^ n)` for some `-1 < a < 1`, then `r < p.radius`; * `p.partial_sum n x`: the sum `∑_{i = 0}^{n-1} pᵢ xⁱ`. * `p.sum x`: the sum `∑'_{i = 0}^{∞} pᵢ xⁱ`. @@ -71,7 +75,7 @@ noncomputable theory variables {𝕜 E F G : Type*} -open_locale topological_space classical big_operators nnreal filter ennreal +open_locale topology classical big_operators nnreal filter ennreal open set filter asymptotics namespace formal_multilinear_series @@ -82,7 +86,7 @@ variables [topological_add_group E] [topological_add_group F] variables [has_continuous_const_smul 𝕜 E] [has_continuous_const_smul 𝕜 F] /-- Given a formal multilinear series `p` and a vector `x`, then `p.sum x` is the sum `Σ pₙ xⁿ`. A -priori, it only behaves well when `∥x∥ < p.radius`. -/ +priori, it only behaves well when `‖x‖ < p.radius`. -/ protected def sum (p : formal_multilinear_series 𝕜 E F) (x : E) : F := ∑' n : ℕ , p n (λ i, x) /-- Given a formal multilinear series `p` and a vector `x`, then `p.partial_sum n x` is the sum @@ -100,47 +104,47 @@ end formal_multilinear_series /-! ### The radius of a formal multilinear series -/ -variables [nondiscrete_normed_field 𝕜] -[normed_group E] [normed_space 𝕜 E] -[normed_group F] [normed_space 𝕜 F] -[normed_group G] [normed_space 𝕜 G] +variables [nontrivially_normed_field 𝕜] +[normed_add_comm_group E] [normed_space 𝕜 E] +[normed_add_comm_group F] [normed_space 𝕜 F] +[normed_add_comm_group G] [normed_space 𝕜 G] namespace formal_multilinear_series variables (p : formal_multilinear_series 𝕜 E F) {r : ℝ≥0} -/-- The radius of a formal multilinear series is the largest `r` such that the sum `Σ ∥pₙ∥ ∥y∥ⁿ` -converges for all `∥y∥ < r`. This implies that `Σ pₙ yⁿ` converges for all `∥y∥ < r`, but these +/-- The radius of a formal multilinear series is the largest `r` such that the sum `Σ ‖pₙ‖ ‖y‖ⁿ` +converges for all `‖y‖ < r`. This implies that `Σ pₙ yⁿ` converges for all `‖y‖ < r`, but these definitions are *not* equivalent in general. -/ def radius (p : formal_multilinear_series 𝕜 E F) : ℝ≥0∞ := -⨆ (r : ℝ≥0) (C : ℝ) (hr : ∀ n, ∥p n∥ * r ^ n ≤ C), (r : ℝ≥0∞) +⨆ (r : ℝ≥0) (C : ℝ) (hr : ∀ n, ‖p n‖ * r ^ n ≤ C), (r : ℝ≥0∞) -/-- If `∥pₙ∥ rⁿ` is bounded in `n`, then the radius of `p` is at least `r`. -/ -lemma le_radius_of_bound (C : ℝ) {r : ℝ≥0} (h : ∀ (n : ℕ), ∥p n∥ * r^n ≤ C) : +/-- If `‖pₙ‖ rⁿ` is bounded in `n`, then the radius of `p` is at least `r`. -/ +lemma le_radius_of_bound (C : ℝ) {r : ℝ≥0} (h : ∀ (n : ℕ), ‖p n‖ * r^n ≤ C) : (r : ℝ≥0∞) ≤ p.radius := le_supr_of_le r $ le_supr_of_le C $ (le_supr (λ _, (r : ℝ≥0∞)) h) -/-- If `∥pₙ∥ rⁿ` is bounded in `n`, then the radius of `p` is at least `r`. -/ -lemma le_radius_of_bound_nnreal (C : ℝ≥0) {r : ℝ≥0} (h : ∀ (n : ℕ), ∥p n∥₊ * r^n ≤ C) : +/-- If `‖pₙ‖ rⁿ` is bounded in `n`, then the radius of `p` is at least `r`. -/ +lemma le_radius_of_bound_nnreal (C : ℝ≥0) {r : ℝ≥0} (h : ∀ (n : ℕ), ‖p n‖₊ * r^n ≤ C) : (r : ℝ≥0∞) ≤ p.radius := p.le_radius_of_bound C $ λ n, by exact_mod_cast (h n) -/-- If `∥pₙ∥ rⁿ = O(1)`, as `n → ∞`, then the radius of `p` is at least `r`. -/ -lemma le_radius_of_is_O (h : is_O (λ n, ∥p n∥ * r^n) (λ n, (1 : ℝ)) at_top) : ↑r ≤ p.radius := +/-- If `‖pₙ‖ rⁿ = O(1)`, as `n → ∞`, then the radius of `p` is at least `r`. -/ +lemma le_radius_of_is_O (h : (λ n, ‖p n‖ * r^n) =O[at_top] (λ n, (1 : ℝ))) : ↑r ≤ p.radius := exists.elim (is_O_one_nat_at_top_iff.1 h) $ λ C hC, p.le_radius_of_bound C $ λ n, (le_abs_self _).trans (hC n) -lemma le_radius_of_eventually_le (C) (h : ∀ᶠ n in at_top, ∥p n∥ * r ^ n ≤ C) : ↑r ≤ p.radius := +lemma le_radius_of_eventually_le (C) (h : ∀ᶠ n in at_top, ‖p n‖ * r ^ n ≤ C) : ↑r ≤ p.radius := p.le_radius_of_is_O $ is_O.of_bound C $ h.mono $ λ n hn, by simpa -lemma le_radius_of_summable_nnnorm (h : summable (λ n, ∥p n∥₊ * r ^ n)) : ↑r ≤ p.radius := -p.le_radius_of_bound_nnreal (∑' n, ∥p n∥₊ * r ^ n) $ λ n, le_tsum' h _ +lemma le_radius_of_summable_nnnorm (h : summable (λ n, ‖p n‖₊ * r ^ n)) : ↑r ≤ p.radius := +p.le_radius_of_bound_nnreal (∑' n, ‖p n‖₊ * r ^ n) $ λ n, le_tsum' h _ -lemma le_radius_of_summable (h : summable (λ n, ∥p n∥ * r ^ n)) : ↑r ≤ p.radius := +lemma le_radius_of_summable (h : summable (λ n, ‖p n‖ * r ^ n)) : ↑r ≤ p.radius := p.le_radius_of_summable_nnnorm $ by { simp only [← coe_nnnorm] at h, exact_mod_cast h } lemma radius_eq_top_of_forall_nnreal_is_O - (h : ∀ r : ℝ≥0, is_O (λ n, ∥p n∥ * r^n) (λ n, (1 : ℝ)) at_top) : p.radius = ∞ := + (h : ∀ r : ℝ≥0, (λ n, ‖p n‖ * r^n) =O[at_top] (λ n, (1 : ℝ))) : p.radius = ∞ := ennreal.eq_top_of_forall_nnreal_le $ λ r, p.le_radius_of_is_O (h r) lemma radius_eq_top_of_eventually_eq_zero (h : ∀ᶠ n in at_top, p n = 0) : p.radius = ∞ := @@ -151,45 +155,50 @@ lemma radius_eq_top_of_forall_image_add_eq_zero (n : ℕ) (hn : ∀ m, p (m + n) p.radius_eq_top_of_eventually_eq_zero $ mem_at_top_sets.2 ⟨n, λ k hk, tsub_add_cancel_of_le hk ▸ hn _⟩ -/-- For `r` strictly smaller than the radius of `p`, then `∥pₙ∥ rⁿ` tends to zero exponentially: -for some `0 < a < 1`, `∥p n∥ rⁿ = o(aⁿ)`. -/ +@[simp] lemma const_formal_multilinear_series_radius {v : F} : + (const_formal_multilinear_series 𝕜 E v).radius = ⊤ := +(const_formal_multilinear_series 𝕜 E v).radius_eq_top_of_forall_image_add_eq_zero 1 + (by simp [const_formal_multilinear_series]) + +/-- For `r` strictly smaller than the radius of `p`, then `‖pₙ‖ rⁿ` tends to zero exponentially: +for some `0 < a < 1`, `‖p n‖ rⁿ = o(aⁿ)`. -/ lemma is_o_of_lt_radius (h : ↑r < p.radius) : - ∃ a ∈ Ioo (0 : ℝ) 1, is_o (λ n, ∥p n∥ * r ^ n) (pow a) at_top := + ∃ a ∈ Ioo (0 : ℝ) 1, (λ n, ‖p n‖ * r ^ n) =o[at_top] (pow a) := begin - rw (tfae_exists_lt_is_o_pow (λ n, ∥p n∥ * r ^ n) 1).out 1 4, + rw (tfae_exists_lt_is_o_pow (λ n, ‖p n‖ * r ^ n) 1).out 1 4, simp only [radius, lt_supr_iff] at h, rcases h with ⟨t, C, hC, rt⟩, rw [ennreal.coe_lt_coe, ← nnreal.coe_lt_coe] at rt, have : 0 < (t : ℝ), from r.coe_nonneg.trans_lt rt, rw [← div_lt_one this] at rt, refine ⟨_, rt, C, or.inr zero_lt_one, λ n, _⟩, - calc |∥p n∥ * r ^ n| = (∥p n∥ * t ^ n) * (r / t) ^ n : + calc |‖p n‖ * r ^ n| = (‖p n‖ * t ^ n) * (r / t) ^ n : by field_simp [mul_right_comm, abs_mul, this.ne'] ... ≤ C * (r / t) ^ n : mul_le_mul_of_nonneg_right (hC n) (pow_nonneg (div_nonneg r.2 t.2) _) end -/-- For `r` strictly smaller than the radius of `p`, then `∥pₙ∥ rⁿ = o(1)`. -/ +/-- For `r` strictly smaller than the radius of `p`, then `‖pₙ‖ rⁿ = o(1)`. -/ lemma is_o_one_of_lt_radius (h : ↑r < p.radius) : - is_o (λ n, ∥p n∥ * r ^ n) (λ _, 1 : ℕ → ℝ) at_top := + (λ n, ‖p n‖ * r ^ n) =o[at_top] (λ _, 1 : ℕ → ℝ) := let ⟨a, ha, hp⟩ := p.is_o_of_lt_radius h in hp.trans $ (is_o_pow_pow_of_lt_left ha.1.le ha.2).congr (λ n, rfl) one_pow -/-- For `r` strictly smaller than the radius of `p`, then `∥pₙ∥ rⁿ` tends to zero exponentially: -for some `0 < a < 1` and `C > 0`, `∥p n∥ * r ^ n ≤ C * a ^ n`. -/ +/-- For `r` strictly smaller than the radius of `p`, then `‖pₙ‖ rⁿ` tends to zero exponentially: +for some `0 < a < 1` and `C > 0`, `‖p n‖ * r ^ n ≤ C * a ^ n`. -/ lemma norm_mul_pow_le_mul_pow_of_lt_radius (h : ↑r < p.radius) : - ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), ∀ n, ∥p n∥ * r^n ≤ C * a^n := + ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), ∀ n, ‖p n‖ * r^n ≤ C * a^n := begin - rcases ((tfae_exists_lt_is_o_pow (λ n, ∥p n∥ * r ^ n) 1).out 1 5).mp (p.is_o_of_lt_radius h) + rcases ((tfae_exists_lt_is_o_pow (λ n, ‖p n‖ * r ^ n) 1).out 1 5).mp (p.is_o_of_lt_radius h) with ⟨a, ha, C, hC, H⟩, exact ⟨a, ha, C, hC, λ n, (le_abs_self _).trans (H n)⟩ end -/-- If `r ≠ 0` and `∥pₙ∥ rⁿ = O(aⁿ)` for some `-1 < a < 1`, then `r < p.radius`. -/ +/-- If `r ≠ 0` and `‖pₙ‖ rⁿ = O(aⁿ)` for some `-1 < a < 1`, then `r < p.radius`. -/ lemma lt_radius_of_is_O (h₀ : r ≠ 0) {a : ℝ} (ha : a ∈ Ioo (-1 : ℝ) 1) - (hp : is_O (λ n, ∥p n∥ * r ^ n) (pow a) at_top) : + (hp : (λ n, ‖p n‖ * r ^ n) =O[at_top] (pow a)) : ↑r < p.radius := begin - rcases ((tfae_exists_lt_is_o_pow (λ n, ∥p n∥ * r ^ n) 1).out 2 5).mp ⟨a, ha, hp⟩ + rcases ((tfae_exists_lt_is_o_pow (λ n, ‖p n‖ * r ^ n) 1).out 2 5).mp ⟨a, ha, hp⟩ with ⟨a, ha, C, hC, hp⟩, rw [← pos_iff_ne_zero, ← nnreal.coe_pos] at h₀, lift a to ℝ≥0 using ha.1.le, @@ -202,39 +211,39 @@ begin exact (le_abs_self _).trans (hp n) end -/-- For `r` strictly smaller than the radius of `p`, then `∥pₙ∥ rⁿ` is bounded. -/ +/-- For `r` strictly smaller than the radius of `p`, then `‖pₙ‖ rⁿ` is bounded. -/ lemma norm_mul_pow_le_of_lt_radius (p : formal_multilinear_series 𝕜 E F) {r : ℝ≥0} - (h : (r : ℝ≥0∞) < p.radius) : ∃ C > 0, ∀ n, ∥p n∥ * r^n ≤ C := + (h : (r : ℝ≥0∞) < p.radius) : ∃ C > 0, ∀ n, ‖p n‖ * r^n ≤ C := let ⟨a, ha, C, hC, h⟩ := p.norm_mul_pow_le_mul_pow_of_lt_radius h in ⟨C, hC, λ n, (h n).trans $ mul_le_of_le_one_right hC.lt.le (pow_le_one _ ha.1.le ha.2.le)⟩ -/-- For `r` strictly smaller than the radius of `p`, then `∥pₙ∥ rⁿ` is bounded. -/ +/-- For `r` strictly smaller than the radius of `p`, then `‖pₙ‖ rⁿ` is bounded. -/ lemma norm_le_div_pow_of_pos_of_lt_radius (p : formal_multilinear_series 𝕜 E F) {r : ℝ≥0} - (h0 : 0 < r) (h : (r : ℝ≥0∞) < p.radius) : ∃ C > 0, ∀ n, ∥p n∥ ≤ C / r ^ n := + (h0 : 0 < r) (h : (r : ℝ≥0∞) < p.radius) : ∃ C > 0, ∀ n, ‖p n‖ ≤ C / r ^ n := let ⟨C, hC, hp⟩ := p.norm_mul_pow_le_of_lt_radius h in ⟨C, hC, λ n, iff.mpr (le_div_iff (pow_pos h0 _)) (hp n)⟩ -/-- For `r` strictly smaller than the radius of `p`, then `∥pₙ∥ rⁿ` is bounded. -/ +/-- For `r` strictly smaller than the radius of `p`, then `‖pₙ‖ rⁿ` is bounded. -/ lemma nnnorm_mul_pow_le_of_lt_radius (p : formal_multilinear_series 𝕜 E F) {r : ℝ≥0} - (h : (r : ℝ≥0∞) < p.radius) : ∃ C > 0, ∀ n, ∥p n∥₊ * r^n ≤ C := + (h : (r : ℝ≥0∞) < p.radius) : ∃ C > 0, ∀ n, ‖p n‖₊ * r^n ≤ C := let ⟨C, hC, hp⟩ := p.norm_mul_pow_le_of_lt_radius h in ⟨⟨C, hC.lt.le⟩, hC, by exact_mod_cast hp⟩ lemma le_radius_of_tendsto (p : formal_multilinear_series 𝕜 E F) {l : ℝ} - (h : tendsto (λ n, ∥p n∥ * r^n) at_top (𝓝 l)) : ↑r ≤ p.radius := -p.le_radius_of_is_O (is_O_one_of_tendsto _ h) + (h : tendsto (λ n, ‖p n‖ * r^n) at_top (𝓝 l)) : ↑r ≤ p.radius := +p.le_radius_of_is_O (h.is_O_one _) lemma le_radius_of_summable_norm (p : formal_multilinear_series 𝕜 E F) - (hs : summable (λ n, ∥p n∥ * r^n)) : ↑r ≤ p.radius := + (hs : summable (λ n, ‖p n‖ * r^n)) : ↑r ≤ p.radius := p.le_radius_of_tendsto hs.tendsto_at_top_zero lemma not_summable_norm_of_radius_lt_nnnorm (p : formal_multilinear_series 𝕜 E F) {x : E} - (h : p.radius < ∥x∥₊) : ¬ summable (λ n, ∥p n∥ * ∥x∥^n) := + (h : p.radius < ‖x‖₊) : ¬ summable (λ n, ‖p n‖ * ‖x‖^n) := λ hs, not_le_of_lt h (p.le_radius_of_summable_norm hs) lemma summable_norm_mul_pow (p : formal_multilinear_series 𝕜 E F) {r : ℝ≥0} (h : ↑r < p.radius) : - summable (λ n : ℕ, ∥p n∥ * r ^ n) := + summable (λ n : ℕ, ‖p n‖ * r ^ n) := begin obtain ⟨a, ha : a ∈ Ioo (0 : ℝ) 1, C, hC : 0 < C, hp⟩ := p.norm_mul_pow_le_mul_pow_of_lt_radius h, exact summable_of_nonneg_of_le (λ n, mul_nonneg (norm_nonneg _) (pow_nonneg r.coe_nonneg _)) hp @@ -243,7 +252,7 @@ end lemma summable_norm_apply (p : formal_multilinear_series 𝕜 E F) {x : E} (hx : x ∈ emetric.ball (0 : E) p.radius) : - summable (λ n : ℕ, ∥p n (λ _, x)∥) := + summable (λ n : ℕ, ‖p n (λ _, x)‖) := begin rw mem_emetric_ball_zero_iff at hx, refine summable_of_nonneg_of_le (λ _, norm_nonneg _) (λ n, ((p n).le_op_norm _).trans_eq _) @@ -253,7 +262,7 @@ end lemma summable_nnnorm_mul_pow (p : formal_multilinear_series 𝕜 E F) {r : ℝ≥0} (h : ↑r < p.radius) : - summable (λ n : ℕ, ∥p n∥₊ * r ^ n) := + summable (λ n : ℕ, ‖p n‖₊ * r ^ n) := by { rw ← nnreal.summable_coe, push_cast, exact p.summable_norm_mul_pow h } protected lemma summable [complete_space F] @@ -262,11 +271,11 @@ protected lemma summable [complete_space F] summable_of_summable_norm (p.summable_norm_apply hx) lemma radius_eq_top_of_summable_norm (p : formal_multilinear_series 𝕜 E F) - (hs : ∀ r : ℝ≥0, summable (λ n, ∥p n∥ * r^n)) : p.radius = ∞ := + (hs : ∀ r : ℝ≥0, summable (λ n, ‖p n‖ * r^n)) : p.radius = ∞ := ennreal.eq_top_of_forall_nnreal_le (λ r, p.le_radius_of_summable_norm (hs r)) lemma radius_eq_top_iff_summable_norm (p : formal_multilinear_series 𝕜 E F) : - p.radius = ∞ ↔ ∀ r : ℝ≥0, summable (λ n, ∥p n∥ * r^n) := + p.radius = ∞ ↔ ∀ r : ℝ≥0, summable (λ n, ‖p n‖ * r^n) := begin split, { intros h r, @@ -280,16 +289,16 @@ begin { exact p.radius_eq_top_of_summable_norm } end -/-- If the radius of `p` is positive, then `∥pₙ∥` grows at most geometrically. -/ +/-- If the radius of `p` is positive, then `‖pₙ‖` grows at most geometrically. -/ lemma le_mul_pow_of_radius_pos (p : formal_multilinear_series 𝕜 E F) (h : 0 < p.radius) : - ∃ C r (hC : 0 < C) (hr : 0 < r), ∀ n, ∥p n∥ ≤ C * r ^ n := + ∃ C r (hC : 0 < C) (hr : 0 < r), ∀ n, ‖p n‖ ≤ C * r ^ n := begin rcases ennreal.lt_iff_exists_nnreal_btwn.1 h with ⟨r, r0, rlt⟩, have rpos : 0 < (r : ℝ), by simp [ennreal.coe_pos.1 r0], rcases norm_le_div_pow_of_pos_of_lt_radius p rpos rlt with ⟨C, Cpos, hCp⟩, refine ⟨C, r ⁻¹, Cpos, by simp [rpos], λ n, _⟩, convert hCp n, - exact inv_pow₀ _ _, + exact inv_pow _ _, end /-- The radius of the sum of two formal series is at least the minimum of their two radii. -/ @@ -319,7 +328,7 @@ begin refine ennreal.le_of_forall_nnreal_lt (λ r hr, _), apply le_radius_of_is_O, apply (is_O.trans_is_o _ (p.is_o_one_of_lt_radius hr)).is_O, - refine is_O.mul (@is_O_with.is_O _ _ _ _ _ (∥f∥) _ _ _ _) (is_O_refl _ _), + refine is_O.mul (@is_O_with.is_O _ _ _ _ _ (‖f‖) _ _ _ _) (is_O_refl _ _), apply is_O_with.of_bound (eventually_of_forall (λ n, _)), simpa only [norm_norm] using f.norm_comp_continuous_multilinear_map_le (p n) end @@ -332,7 +341,7 @@ section variables {f g : E → F} {p pf pg : formal_multilinear_series 𝕜 E F} {x : E} {r r' : ℝ≥0∞} /-- Given a function `f : E → F` and a formal multilinear series `p`, we say that `f` has `p` as -a power series on the ball of radius `r > 0` around `x` if `f (x + y) = ∑' pₙ yⁿ` for all `∥y∥ < r`. +a power series on the ball of radius `r > 0` around `x` if `f (x + y) = ∑' pₙ yⁿ` for all `‖y‖ < r`. -/ structure has_fpower_series_on_ball (f : E → F) (p : formal_multilinear_series 𝕜 E F) (x : E) (r : ℝ≥0∞) : Prop := @@ -407,12 +416,64 @@ lemma has_fpower_series_on_ball.mono has_fpower_series_on_ball f p x r' := ⟨le_trans hr hf.1, r'_pos, λ y hy, hf.has_sum (emetric.ball_subset_ball hr hy)⟩ +lemma has_fpower_series_at.congr (hf : has_fpower_series_at f p x) (hg : f =ᶠ[𝓝 x] g) : + has_fpower_series_at g p x := +begin + rcases hf with ⟨r₁, h₁⟩, + rcases emetric.mem_nhds_iff.mp hg with ⟨r₂, h₂pos, h₂⟩, + exact ⟨min r₁ r₂, (h₁.mono (lt_min h₁.r_pos h₂pos) inf_le_left).congr + (λ y hy, h₂ (emetric.ball_subset_ball inf_le_right hy))⟩ +end + protected lemma has_fpower_series_at.eventually (hf : has_fpower_series_at f p x) : ∀ᶠ r : ℝ≥0∞ in 𝓝[>] 0, has_fpower_series_on_ball f p x r := let ⟨r, hr⟩ := hf in mem_of_superset (Ioo_mem_nhds_within_Ioi (left_mem_Ico.2 hr.r_pos)) $ λ r' hr', hr.mono hr'.1 hr'.2.le +lemma has_fpower_series_on_ball.eventually_has_sum (hf : has_fpower_series_on_ball f p x r) : + ∀ᶠ y in 𝓝 0, has_sum (λn:ℕ, p n (λ(i : fin n), y)) (f (x + y)) := +by filter_upwards [emetric.ball_mem_nhds (0 : E) hf.r_pos] using λ _, hf.has_sum + +lemma has_fpower_series_at.eventually_has_sum (hf : has_fpower_series_at f p x) : + ∀ᶠ y in 𝓝 0, has_sum (λn:ℕ, p n (λ(i : fin n), y)) (f (x + y)) := +let ⟨r, hr⟩ := hf in hr.eventually_has_sum + +lemma has_fpower_series_on_ball.eventually_has_sum_sub (hf : has_fpower_series_on_ball f p x r) : + ∀ᶠ y in 𝓝 x, has_sum (λn:ℕ, p n (λ(i : fin n), y - x)) (f y) := +by filter_upwards [emetric.ball_mem_nhds x hf.r_pos] with y using hf.has_sum_sub + +lemma has_fpower_series_at.eventually_has_sum_sub (hf : has_fpower_series_at f p x) : + ∀ᶠ y in 𝓝 x, has_sum (λn:ℕ, p n (λ(i : fin n), y - x)) (f y) := +let ⟨r, hr⟩ := hf in hr.eventually_has_sum_sub + +lemma has_fpower_series_on_ball.eventually_eq_zero + (hf : has_fpower_series_on_ball f (0 : formal_multilinear_series 𝕜 E F) x r) : + ∀ᶠ z in 𝓝 x, f z = 0 := +by filter_upwards [hf.eventually_has_sum_sub] with z hz using hz.unique has_sum_zero + +lemma has_fpower_series_at.eventually_eq_zero + (hf : has_fpower_series_at f (0 : formal_multilinear_series 𝕜 E F) x) : + ∀ᶠ z in 𝓝 x, f z = 0 := +let ⟨r, hr⟩ := hf in hr.eventually_eq_zero + +lemma has_fpower_series_on_ball_const {c : F} {e : E} : + has_fpower_series_on_ball (λ _, c) (const_formal_multilinear_series 𝕜 E c) e ⊤ := +begin + refine ⟨by simp, with_top.zero_lt_top, λ y hy, has_sum_single 0 (λ n hn, _)⟩, + simp [const_formal_multilinear_series_apply hn] +end + +lemma has_fpower_series_at_const {c : F} {e : E} : + has_fpower_series_at (λ _, c) (const_formal_multilinear_series 𝕜 E c) e := +⟨⊤, has_fpower_series_on_ball_const⟩ + +lemma analytic_at_const {v : F} : analytic_at 𝕜 (λ _, v) x := +⟨const_formal_multilinear_series 𝕜 E v, has_fpower_series_at_const⟩ + +lemma analytic_on_const {v : F} {s : set E} : analytic_on 𝕜 (λ _, v) s := +λ z _, analytic_at_const + lemma has_fpower_series_on_ball.add (hf : has_fpower_series_on_ball f pf x r) (hg : has_fpower_series_on_ball g pg x r) : has_fpower_series_on_ball (f + g) (pf + pg) x r := @@ -459,6 +520,18 @@ lemma analytic_at.sub (hf : analytic_at 𝕜 f x) (hg : analytic_at 𝕜 g x) : analytic_at 𝕜 (f - g) x := by simpa only [sub_eq_add_neg] using hf.add hg.neg +lemma analytic_on.mono {s t : set E} (hf : analytic_on 𝕜 f t) (hst : s ⊆ t) : + analytic_on 𝕜 f s := +λ z hz, hf z (hst hz) + +lemma analytic_on.add {s : set E} (hf : analytic_on 𝕜 f s) (hg : analytic_on 𝕜 g s) : + analytic_on 𝕜 (f + g) s := +λ z hz, (hf z hz).add (hg z hz) + +lemma analytic_on.sub {s : set E} (hf : analytic_on 𝕜 f s) (hg : analytic_on 𝕜 g s) : + analytic_on 𝕜 (f - g) s := +λ z hz, (hf z hz).sub (hg z hz) + lemma has_fpower_series_on_ball.coeff_zero (hf : has_fpower_series_on_ball f pf x r) (v : fin 0 → E) : pf 0 v = f x := begin @@ -501,36 +574,36 @@ end /-- If a function admits a power series expansion, then it is exponentially close to the partial sums of this power series on strict subdisks of the disk of convergence. -This version provides an upper estimate that decreases both in `∥y∥` and `n`. See also +This version provides an upper estimate that decreases both in `‖y‖` and `n`. See also `has_fpower_series_on_ball.uniform_geometric_approx` for a weaker version. -/ lemma has_fpower_series_on_ball.uniform_geometric_approx' {r' : ℝ≥0} (hf : has_fpower_series_on_ball f p x r) (h : (r' : ℝ≥0∞) < r) : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), (∀ y ∈ metric.ball (0 : E) r', ∀ n, - ∥f (x + y) - p.partial_sum n y∥ ≤ C * (a * (∥y∥ / r')) ^ n) := + ‖f (x + y) - p.partial_sum n y‖ ≤ C * (a * (‖y‖ / r')) ^ n) := begin - obtain ⟨a, ha, C, hC, hp⟩ : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), ∀ n, ∥p n∥ * r' ^n ≤ C * a^n := + obtain ⟨a, ha, C, hC, hp⟩ : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), ∀ n, ‖p n‖ * r' ^n ≤ C * a^n := p.norm_mul_pow_le_mul_pow_of_lt_radius (h.trans_le hf.r_le), refine ⟨a, ha, C / (1 - a), div_pos hC (sub_pos.2 ha.2), λ y hy n, _⟩, - have yr' : ∥y∥ < r', by { rw ball_zero_eq at hy, exact hy }, + have yr' : ‖y‖ < r', by { rw ball_zero_eq at hy, exact hy }, have hr'0 : 0 < (r' : ℝ), from (norm_nonneg _).trans_lt yr', have : y ∈ emetric.ball (0 : E) r, { refine mem_emetric_ball_zero_iff.2 (lt_trans _ h), exact_mod_cast yr' }, rw [norm_sub_rev, ← mul_div_right_comm], - have ya : a * (∥y∥ / ↑r') ≤ a, + have ya : a * (‖y‖ / ↑r') ≤ a, from mul_le_of_le_one_right ha.1.le (div_le_one_of_le yr'.le r'.coe_nonneg), - suffices : ∥p.partial_sum n y - f (x + y)∥ ≤ C * (a * (∥y∥ / r')) ^ n / (1 - a * (∥y∥ / r')), + suffices : ‖p.partial_sum n y - f (x + y)‖ ≤ C * (a * (‖y‖ / r')) ^ n / (1 - a * (‖y‖ / r')), { refine this.trans _, apply_rules [div_le_div_of_le_left, sub_pos.2, div_nonneg, mul_nonneg, pow_nonneg, hC.lt.le, ha.1.le, norm_nonneg, nnreal.coe_nonneg, ha.2, (sub_le_sub_iff_left _).2]; apply_instance }, apply norm_sub_le_of_geometric_bound_of_has_sum (ya.trans_lt ha.2) _ (hf.has_sum this), assume n, - calc ∥(p n) (λ (i : fin n), y)∥ ≤ ∥p n∥ * (∏ i : fin n, ∥y∥) : + calc ‖(p n) (λ (i : fin n), y)‖ ≤ ‖p n‖ * (∏ i : fin n, ‖y‖) : continuous_multilinear_map.le_op_norm _ _ - ... = (∥p n∥ * r' ^ n) * (∥y∥ / r') ^ n : by field_simp [hr'0.ne', mul_right_comm] - ... ≤ (C * a ^ n) * (∥y∥ / r') ^ n : + ... = (‖p n‖ * r' ^ n) * (‖y‖ / r') ^ n : by field_simp [hr'0.ne', mul_right_comm] + ... ≤ (C * a ^ n) * (‖y‖ / r') ^ n : mul_le_mul_of_nonneg_right (hp n) (pow_nonneg (div_nonneg (norm_nonneg _) r'.coe_nonneg) _) - ... ≤ C * (a * (∥y∥ / r')) ^ n : by rw [mul_pow, mul_assoc] + ... ≤ C * (a * (‖y‖ / r')) ^ n : by rw [mul_pow, mul_assoc] end /-- If a function admits a power series expansion, then it is exponentially close to the partial @@ -538,13 +611,13 @@ sums of this power series on strict subdisks of the disk of convergence. -/ lemma has_fpower_series_on_ball.uniform_geometric_approx {r' : ℝ≥0} (hf : has_fpower_series_on_ball f p x r) (h : (r' : ℝ≥0∞) < r) : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), (∀ y ∈ metric.ball (0 : E) r', ∀ n, - ∥f (x + y) - p.partial_sum n y∥ ≤ C * a ^ n) := + ‖f (x + y) - p.partial_sum n y‖ ≤ C * a ^ n) := begin obtain ⟨a, ha, C, hC, hp⟩ : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), - (∀ y ∈ metric.ball (0 : E) r', ∀ n, ∥f (x + y) - p.partial_sum n y∥ ≤ C * (a * (∥y∥ / r')) ^ n), + (∀ y ∈ metric.ball (0 : E) r', ∀ n, ‖f (x + y) - p.partial_sum n y‖ ≤ C * (a * (‖y‖ / r')) ^ n), from hf.uniform_geometric_approx' h, refine ⟨a, ha, C, hC, λ y hy n, (hp y hy n).trans _⟩, - have yr' : ∥y∥ < r', by rwa ball_zero_eq at hy, + have yr' : ‖y‖ < r', by rwa ball_zero_eq at hy, refine mul_le_mul_of_nonneg_left (pow_le_pow_of_le_left _ _ _) hC.lt.le, exacts [mul_nonneg ha.1.le (div_nonneg (norm_nonneg y) r'.coe_nonneg), mul_le_of_le_one_right ha.1.le (div_le_one_of_le yr'.le r'.coe_nonneg)] @@ -552,12 +625,12 @@ end /-- Taylor formula for an analytic function, `is_O` version. -/ lemma has_fpower_series_at.is_O_sub_partial_sum_pow (hf : has_fpower_series_at f p x) (n : ℕ) : - is_O (λ y : E, f (x + y) - p.partial_sum n y) (λ y, ∥y∥ ^ n) (𝓝 0) := + (λ y : E, f (x + y) - p.partial_sum n y) =O[𝓝 0] (λ y, ‖y‖ ^ n) := begin rcases hf with ⟨r, hf⟩, rcases ennreal.lt_iff_exists_nnreal_btwn.1 hf.r_pos with ⟨r', r'0, h⟩, obtain ⟨a, ha, C, hC, hp⟩ : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), - (∀ y ∈ metric.ball (0 : E) r', ∀ n, ∥f (x + y) - p.partial_sum n y∥ ≤ C * (a * (∥y∥ / r')) ^ n), + (∀ y ∈ metric.ball (0 : E) r', ∀ n, ‖f (x + y) - p.partial_sum n y‖ ≤ C * (a * (‖y‖ / r')) ^ n), from hf.uniform_geometric_approx' h, refine is_O_iff.2 ⟨C * (a / r') ^ n, _⟩, replace r'0 : 0 < (r' : ℝ), by exact_mod_cast r'0, @@ -567,24 +640,24 @@ end /-- If `f` has formal power series `∑ n, pₙ` on a ball of radius `r`, then for `y, z` in any smaller ball, the norm of the difference `f y - f z - p 1 (λ _, y - z)` is bounded above by -`C * (max ∥y - x∥ ∥z - x∥) * ∥y - z∥`. This lemma formulates this property using `is_O` and +`C * (max ‖y - x‖ ‖z - x‖) * ‖y - z‖`. This lemma formulates this property using `is_O` and `filter.principal` on `E × E`. -/ lemma has_fpower_series_on_ball.is_O_image_sub_image_sub_deriv_principal (hf : has_fpower_series_on_ball f p x r) (hr : r' < r) : - is_O (λ y : E × E, f y.1 - f y.2 - (p 1 (λ _, y.1 - y.2))) - (λ y, ∥y - (x, x)∥ * ∥y.1 - y.2∥) (𝓟 $ emetric.ball (x, x) r') := + (λ y : E × E, f y.1 - f y.2 - (p 1 (λ _, y.1 - y.2))) =O[𝓟 (emetric.ball (x, x) r')] + (λ y, ‖y - (x, x)‖ * ‖y.1 - y.2‖) := begin lift r' to ℝ≥0 using ne_top_of_lt hr, rcases (zero_le r').eq_or_lt with rfl|hr'0, { simp only [is_O_bot, emetric.ball_zero, principal_empty, ennreal.coe_zero] }, obtain ⟨a, ha, C, hC : 0 < C, hp⟩ : - ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), ∀ (n : ℕ), ∥p n∥ * ↑r' ^ n ≤ C * a ^ n, + ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), ∀ (n : ℕ), ‖p n‖ * ↑r' ^ n ≤ C * a ^ n, from p.norm_mul_pow_le_mul_pow_of_lt_radius (hr.trans_le hf.r_le), simp only [← le_div_iff (pow_pos (nnreal.coe_pos.2 hr'0) _)] at hp, set L : E × E → ℝ := λ y, - (C * (a / r') ^ 2) * (∥y - (x, x)∥ * ∥y.1 - y.2∥) * (a / (1 - a) ^ 2 + 2 / (1 - a)), + (C * (a / r') ^ 2) * (‖y - (x, x)‖ * ‖y.1 - y.2‖) * (a / (1 - a) ^ 2 + 2 / (1 - a)), have hL : ∀ y ∈ emetric.ball (x, x) r', - ∥f y.1 - f y.2 - (p 1 (λ _, y.1 - y.2))∥ ≤ L y, + ‖f y.1 - f y.2 - (p 1 (λ _, y.1 - y.2))‖ ≤ L y, { intros y hy', have hy : y ∈ emetric.ball x r ×ˢ emetric.ball x r, { rw [emetric.ball_prod_same], exact emetric.ball_subset_ball hr.le hy' }, @@ -597,15 +670,15 @@ begin subsingleton.pi_single_eq, sub_sub_sub_cancel_right] }, rw [emetric.mem_ball, edist_eq_coe_nnnorm_sub, ennreal.coe_lt_coe] at hy', set B : ℕ → ℝ := λ n, - (C * (a / r') ^ 2) * (∥y - (x, x)∥ * ∥y.1 - y.2∥) * ((n + 2) * a ^ n), - have hAB : ∀ n, ∥A (n + 2)∥ ≤ B n := λ n, - calc ∥A (n + 2)∥ ≤ ∥p (n + 2)∥ * ↑(n + 2) * ∥y - (x, x)∥ ^ (n + 1) * ∥y.1 - y.2∥ : + (C * (a / r') ^ 2) * (‖y - (x, x)‖ * ‖y.1 - y.2‖) * ((n + 2) * a ^ n), + have hAB : ∀ n, ‖A (n + 2)‖ ≤ B n := λ n, + calc ‖A (n + 2)‖ ≤ ‖p (n + 2)‖ * ↑(n + 2) * ‖y - (x, x)‖ ^ (n + 1) * ‖y.1 - y.2‖ : by simpa only [fintype.card_fin, pi_norm_const (_ : E), prod.norm_def, pi.sub_def, prod.fst_sub, prod.snd_sub, sub_sub_sub_cancel_right] using (p $ n + 2).norm_image_sub_le (λ _, y.1 - x) (λ _, y.2 - x) - ... = ∥p (n + 2)∥ * ∥y - (x, x)∥ ^ n * (↑(n + 2) * ∥y - (x, x)∥ * ∥y.1 - y.2∥) : - by { rw [pow_succ ∥y - (x, x)∥], ring } - ... ≤ (C * a ^ (n + 2) / r' ^ (n + 2)) * r' ^ n * (↑(n + 2) * ∥y - (x, x)∥ * ∥y.1 - y.2∥) : + ... = ‖p (n + 2)‖ * ‖y - (x, x)‖ ^ n * (↑(n + 2) * ‖y - (x, x)‖ * ‖y.1 - y.2‖) : + by { rw [pow_succ ‖y - (x, x)‖], ring } + ... ≤ (C * a ^ (n + 2) / r' ^ (n + 2)) * r' ^ n * (↑(n + 2) * ‖y - (x, x)‖ * ‖y.1 - y.2‖) : by apply_rules [mul_le_mul_of_nonneg_right, mul_le_mul, hp, pow_le_pow_of_le_left, hy'.le, norm_nonneg, pow_nonneg, div_nonneg, mul_nonneg, nat.cast_nonneg, hC.le, r'.coe_nonneg, ha.1.le] @@ -614,11 +687,11 @@ begin have hBL : has_sum B (L y), { apply has_sum.mul_left, simp only [add_mul], - have : ∥a∥ < 1, by simp only [real.norm_eq_abs, abs_of_pos ha.1, ha.2], + have : ‖a‖ < 1, by simp only [real.norm_eq_abs, abs_of_pos ha.1, ha.2], convert (has_sum_coe_mul_geometric_of_norm_lt_1 this).add ((has_sum_geometric_of_norm_lt_1 this).mul_left 2) }, exact hA.norm_le_of_bounded hBL hAB }, - suffices : is_O L (λ y, ∥y - (x, x)∥ * ∥y.1 - y.2∥) (𝓟 (emetric.ball (x, x) r')), + suffices : L =O[𝓟 (emetric.ball (x, x) r')] (λ y, ‖y - (x, x)‖ * ‖y.1 - y.2‖), { refine (is_O.of_bound 1 (eventually_principal.2 $ λ y hy, _)).trans this, rw one_mul, exact (hL y hy).trans (le_abs_self _) }, @@ -628,21 +701,21 @@ end /-- If `f` has formal power series `∑ n, pₙ` on a ball of radius `r`, then for `y, z` in any smaller ball, the norm of the difference `f y - f z - p 1 (λ _, y - z)` is bounded above by -`C * (max ∥y - x∥ ∥z - x∥) * ∥y - z∥`. -/ +`C * (max ‖y - x‖ ‖z - x‖) * ‖y - z‖`. -/ lemma has_fpower_series_on_ball.image_sub_sub_deriv_le (hf : has_fpower_series_on_ball f p x r) (hr : r' < r) : ∃ C, ∀ (y z ∈ emetric.ball x r'), - ∥f y - f z - (p 1 (λ _, y - z))∥ ≤ C * (max ∥y - x∥ ∥z - x∥) * ∥y - z∥ := + ‖f y - f z - (p 1 (λ _, y - z))‖ ≤ C * (max ‖y - x‖ ‖z - x‖) * ‖y - z‖ := by simpa only [is_O_principal, mul_assoc, norm_mul, norm_norm, prod.forall, emetric.mem_ball, prod.edist_eq, max_lt_iff, and_imp, @forall_swap (_ < _) E] using hf.is_O_image_sub_image_sub_deriv_principal hr /-- If `f` has formal power series `∑ n, pₙ` at `x`, then -`f y - f z - p 1 (λ _, y - z) = O(∥(y, z) - (x, x)∥ * ∥y - z∥)` as `(y, z) → (x, x)`. +`f y - f z - p 1 (λ _, y - z) = O(‖(y, z) - (x, x)‖ * ‖y - z‖)` as `(y, z) → (x, x)`. In particular, `f` is strictly differentiable at `x`. -/ lemma has_fpower_series_at.is_O_image_sub_norm_mul_norm_sub (hf : has_fpower_series_at f p x) : - is_O (λ y : E × E, f y.1 - f y.2 - (p 1 (λ _, y.1 - y.2))) - (λ y, ∥y - (x, x)∥ * ∥y.1 - y.2∥) (𝓝 (x, x)) := + (λ y : E × E, f y.1 - f y.2 - (p 1 (λ _, y.1 - y.2))) =O[𝓝 (x, x)] + (λ y, ‖y - (x, x)‖ * ‖y.1 - y.2‖) := begin rcases hf with ⟨r, hf⟩, rcases ennreal.lt_iff_exists_nnreal_btwn.1 hf.r_pos with ⟨r', r'0, h⟩, @@ -659,7 +732,7 @@ lemma has_fpower_series_on_ball.tendsto_uniformly_on {r' : ℝ≥0} (λ y, f (x + y)) at_top (metric.ball (0 : E) r') := begin obtain ⟨a, ha, C, hC, hp⟩ : ∃ (a ∈ Ioo (0 : ℝ) 1) (C > 0), - (∀ y ∈ metric.ball (0 : E) r', ∀ n, ∥f (x + y) - p.partial_sum n y∥ ≤ C * a ^ n), + (∀ y ∈ metric.ball (0 : E) r', ∀ n, ‖f (x + y) - p.partial_sum n y‖ ≤ C * a ^ n), from hf.uniform_geometric_approx h, refine metric.tendsto_uniformly_on_iff.2 (λ ε εpos, _), have L : tendsto (λ n, (C : ℝ) * a^n) at_top (𝓝 ((C : ℝ) * 0)) := @@ -769,7 +842,7 @@ section uniqueness open continuous_multilinear_map lemma asymptotics.is_O.continuous_multilinear_map_apply_eq_zero {n : ℕ} {p : E [×n]→L[𝕜] F} - (h : is_O (λ y, p (λ i, y)) (λ y, ∥y∥ ^ (n + 1)) (𝓝 0)) (y : E) : + (h : (λ y, p (λ i, y)) =O[𝓝 0] (λ y, ‖y‖ ^ (n + 1))) (y : E) : p (λ i, y) = 0 := begin obtain ⟨c, c_pos, hc⟩ := h.exists_pos, @@ -786,25 +859,25 @@ begin have h₀ := mul_pos c_pos (pow_pos hy (n.succ + 1)), obtain ⟨k, k_pos, k_norm⟩ := normed_field.exists_norm_lt 𝕜 (lt_min (mul_pos δ_pos (inv_pos.mpr hy)) (mul_pos ε_pos (inv_pos.mpr h₀))), - have h₁ : ∥k • y∥ < δ, + have h₁ : ‖k • y‖ < δ, { rw norm_smul, exact inv_mul_cancel_right₀ hy.ne.symm δ ▸ mul_lt_mul_of_pos_right (lt_of_lt_of_le k_norm (min_le_left _ _)) hy }, have h₂ := calc - ∥p (λ i, k • y)∥ ≤ c * ∥k • y∥ ^ (n.succ + 1) + ‖p (λ i, k • y)‖ ≤ c * ‖k • y‖ ^ (n.succ + 1) : by simpa only [norm_pow, norm_norm] using ht (k • y) (δε (mem_ball_zero_iff.mpr h₁)) - ... = ∥k∥ ^ n.succ * (∥k∥ * (c * ∥y∥ ^ (n.succ + 1))) + ... = ‖k‖ ^ n.succ * (‖k‖ * (c * ‖y‖ ^ (n.succ + 1))) : by { simp only [norm_smul, mul_pow], rw pow_succ, ring }, - have h₃ : ∥k∥ * (c * ∥y∥ ^ (n.succ + 1)) < ε, from inv_mul_cancel_right₀ h₀.ne.symm ε ▸ + have h₃ : ‖k‖ * (c * ‖y‖ ^ (n.succ + 1)) < ε, from inv_mul_cancel_right₀ h₀.ne.symm ε ▸ mul_lt_mul_of_pos_right (lt_of_lt_of_le k_norm (min_le_right _ _)) h₀, - calc ∥p (λ i, y)∥ = ∥(k⁻¹) ^ n.succ∥ * ∥p (λ i, k • y)∥ + calc ‖p (λ i, y)‖ = ‖(k⁻¹) ^ n.succ‖ * ‖p (λ i, k • y)‖ : by simpa only [inv_smul_smul₀ (norm_pos_iff.mp k_pos), norm_smul, finset.prod_const, finset.card_fin] using congr_arg norm (p.map_smul_univ (λ (i : fin n.succ), k⁻¹) (λ (i : fin n.succ), k • y)) - ... ≤ ∥(k⁻¹) ^ n.succ∥ * (∥k∥ ^ n.succ * (∥k∥ * (c * ∥y∥ ^ (n.succ + 1)))) + ... ≤ ‖(k⁻¹) ^ n.succ‖ * (‖k‖ ^ n.succ * (‖k‖ * (c * ‖y‖ ^ (n.succ + 1)))) : mul_le_mul_of_nonneg_left h₂ (norm_nonneg _) - ... = ∥(k⁻¹ * k) ^ n.succ∥ * (∥k∥ * (c * ∥y∥ ^ (n.succ + 1))) + ... = ‖(k⁻¹ * k) ^ n.succ‖ * (‖k‖ * (c * ‖y‖ ^ (n.succ + 1))) : by { rw ←mul_assoc, simp [norm_mul, mul_pow] } ... ≤ 0 + ε : by { rw inv_mul_cancel (norm_pos_iff.mp k_pos), simpa using h₃.le }, }, @@ -840,6 +913,17 @@ theorem has_fpower_series_at.eq_formal_multilinear_series p₁ = p₂ := sub_eq_zero.mp (has_fpower_series_at.eq_zero (by simpa only [sub_self] using h₁.sub h₂)) +lemma has_fpower_series_at.eq_formal_multilinear_series_of_eventually + {p q : formal_multilinear_series 𝕜 𝕜 E} {f g : 𝕜 → E} {x : 𝕜} (hp : has_fpower_series_at f p x) + (hq : has_fpower_series_at g q x) (heq : ∀ᶠ z in 𝓝 x, f z = g z) : + p = q := +(hp.congr heq).eq_formal_multilinear_series hq + +/-- A one-dimensional formal multilinear series representing a locally zero function is zero. -/ +lemma has_fpower_series_at.eq_zero_of_eventually {p : formal_multilinear_series 𝕜 𝕜 E} {f : 𝕜 → E} + {x : 𝕜} (hp : has_fpower_series_at f p x) (hf : f =ᶠ[𝓝 x] 0) : p = 0 := +(hp.congr hf).eq_zero + /-- If a function `f : 𝕜 → E` has two power series representations at `x`, then the given radii in which convergence is guaranteed may be interchanged. This can be useful when the formal multilinear series in one representation has a particularly nice form, but the other has a larger radius. -/ @@ -860,7 +944,7 @@ theorem has_fpower_series_on_ball.r_eq_top_of_exists {f : 𝕜 → E} {r : ℝ { r_le := ennreal.le_of_forall_pos_nnreal_lt $ λ r hr hr', let ⟨p', hp'⟩ := h' r hr in (h.exchange_radius hp').r_le, r_pos := ennreal.coe_lt_top, - has_sum := λ y hy, let ⟨r', hr'⟩ := exists_gt ∥y∥₊, ⟨p', hp'⟩ := h' r' hr'.ne_bot.bot_lt + has_sum := λ y hy, let ⟨r', hr'⟩ := exists_gt ‖y‖₊, ⟨p', hp'⟩ := h' r' hr'.ne_bot.bot_lt in (h.exchange_radius hp').has_sum $ mem_emetric_ball_zero_iff.mpr (ennreal.coe_lt_coe.2 hr') } end uniqueness @@ -914,17 +998,17 @@ continuous_multilinear_map.curry_fin_finset_apply_const _ _ _ _ _ @[simp] lemma norm_change_origin_series_term (k l : ℕ) (s : finset (fin (k + l))) (hs : s.card = l) : - ∥p.change_origin_series_term k l s hs∥ = ∥p (k + l)∥ := + ‖p.change_origin_series_term k l s hs‖ = ‖p (k + l)‖ := by simp only [change_origin_series_term, linear_isometry_equiv.norm_map] @[simp] lemma nnnorm_change_origin_series_term (k l : ℕ) (s : finset (fin (k + l))) (hs : s.card = l) : - ∥p.change_origin_series_term k l s hs∥₊ = ∥p (k + l)∥₊ := + ‖p.change_origin_series_term k l s hs‖₊ = ‖p (k + l)‖₊ := by simp only [change_origin_series_term, linear_isometry_equiv.nnnorm_map] lemma nnnorm_change_origin_series_term_apply_le (k l : ℕ) (s : finset (fin (k + l))) (hs : s.card = l) (x y : E) : - ∥p.change_origin_series_term k l s hs (λ _, x) (λ _, y)∥₊ ≤ ∥p (k + l)∥₊ * ∥x∥₊ ^ l * ∥y∥₊ ^ k := + ‖p.change_origin_series_term k l s hs (λ _, x) (λ _, y)‖₊ ≤ ‖p (k + l)‖₊ * ‖x‖₊ ^ l * ‖y‖₊ ^ k := begin rw [← p.nnnorm_change_origin_series_term k l s hs, ← fin.prod_const, ← fin.prod_const], apply continuous_multilinear_map.le_of_op_nnnorm_le, @@ -941,13 +1025,13 @@ def change_origin_series (k : ℕ) : formal_multilinear_series 𝕜 E (E [×k] λ l, ∑ s : {s : finset (fin (k + l)) // finset.card s = l}, p.change_origin_series_term k l s s.2 lemma nnnorm_change_origin_series_le_tsum (k l : ℕ) : - ∥p.change_origin_series k l∥₊ ≤ - ∑' (x : {s : finset (fin (k + l)) // s.card = l}), ∥p (k + l)∥₊ := + ‖p.change_origin_series k l‖₊ ≤ + ∑' (x : {s : finset (fin (k + l)) // s.card = l}), ‖p (k + l)‖₊ := (nnnorm_sum_le _ _).trans_eq $ by simp only [tsum_fintype, nnnorm_change_origin_series_term] lemma nnnorm_change_origin_series_apply_le_tsum (k l : ℕ) (x : E) : - ∥p.change_origin_series k l (λ _, x)∥₊ ≤ - ∑' s : {s : finset (fin (k + l)) // s.card = l}, ∥p (k + l)∥₊ * ∥x∥₊ ^ l := + ‖p.change_origin_series k l (λ _, x)‖₊ ≤ + ∑' s : {s : finset (fin (k + l)) // s.card = l}, ‖p (k + l)‖₊ * ‖x‖₊ ^ l := begin rw [nnreal.tsum_mul_right, ← fin.prod_const], exact (p.change_origin_series k l).le_of_op_nnnorm_le _ @@ -997,17 +1081,17 @@ with non-definitional equalities. -/ lemma change_origin_series_summable_aux₁ {r r' : ℝ≥0} (hr : (r + r' : ℝ≥0∞) < p.radius) : summable (λ s : Σ k l : ℕ, {s : finset (fin (k + l)) // s.card = l}, - ∥p (s.1 + s.2.1)∥₊ * r ^ s.2.1 * r' ^ s.1) := + ‖p (s.1 + s.2.1)‖₊ * r ^ s.2.1 * r' ^ s.1) := begin rw ← change_origin_index_equiv.symm.summable_iff, dsimp only [(∘), change_origin_index_equiv_symm_apply_fst, change_origin_index_equiv_symm_apply_snd_fst], have : ∀ n : ℕ, has_sum - (λ s : finset (fin n), ∥p (n - s.card + s.card)∥₊ * r ^ s.card * r' ^ (n - s.card)) - (∥p n∥₊ * (r + r') ^ n), + (λ s : finset (fin n), ‖p (n - s.card + s.card)‖₊ * r ^ s.card * r' ^ (n - s.card)) + (‖p n‖₊ * (r + r') ^ n), { intro n, -- TODO: why `simp only [tsub_add_cancel_of_le (card_finset_fin_le _)]` fails? - convert_to has_sum (λ s : finset (fin n), ∥p n∥₊ * (r ^ s.card * r' ^ (n - s.card))) _, + convert_to has_sum (λ s : finset (fin n), ‖p n‖₊ * (r ^ s.card * r' ^ (n - s.card))) _, { ext1 s, rw [tsub_add_cancel_of_le (card_finset_fin_le _), mul_assoc] }, rw ← fin.sum_pow_mul_eq_add_pow, exact (has_sum_fintype _).mul_left _ }, @@ -1017,7 +1101,7 @@ begin end lemma change_origin_series_summable_aux₂ (hr : (r : ℝ≥0∞) < p.radius) (k : ℕ) : - summable (λ s : Σ l : ℕ, {s : finset (fin (k + l)) // s.card = l}, ∥p (k + s.1)∥₊ * r ^ s.1) := + summable (λ s : Σ l : ℕ, {s : finset (fin (k + l)) // s.card = l}, ‖p (k + s.1)‖₊ * r ^ s.1) := begin rcases ennreal.lt_iff_exists_add_pos_lt.1 hr with ⟨r', h0, hr'⟩, simpa only [mul_inv_cancel_right₀ (pow_pos h0 _).ne'] @@ -1026,7 +1110,7 @@ begin end lemma change_origin_series_summable_aux₃ {r : ℝ≥0} (hr : ↑r < p.radius) (k : ℕ) : - summable (λ l : ℕ, ∥p.change_origin_series k l∥₊ * r ^ l) := + summable (λ l : ℕ, ‖p.change_origin_series k l‖₊ * r ^ l) := begin refine nnreal.summable_of_le (λ n, _) (nnreal.summable_sigma.1 $ p.change_origin_series_summable_aux₂ hr k).2, @@ -1039,9 +1123,9 @@ lemma le_change_origin_series_radius (k : ℕ) : ennreal.le_of_forall_nnreal_lt $ λ r hr, le_radius_of_summable_nnnorm _ (p.change_origin_series_summable_aux₃ hr k) -lemma nnnorm_change_origin_le (k : ℕ) (h : (∥x∥₊ : ℝ≥0∞) < p.radius) : - ∥p.change_origin x k∥₊ ≤ - ∑' s : Σ l : ℕ, {s : finset (fin (k + l)) // s.card = l}, ∥p (k + s.1)∥₊ * ∥x∥₊ ^ s.1 := +lemma nnnorm_change_origin_le (k : ℕ) (h : (‖x‖₊ : ℝ≥0∞) < p.radius) : + ‖p.change_origin x k‖₊ ≤ + ∑' s : Σ l : ℕ, {s : finset (fin (k + l)) // s.card = l}, ‖p (k + s.1)‖₊ * ‖x‖₊ ^ s.1 := begin refine tsum_of_nnnorm_bounded _ (λ l, p.nnnorm_change_origin_series_apply_le_tsum k l x), have := p.change_origin_series_summable_aux₂ h k, @@ -1049,17 +1133,17 @@ begin exact ((nnreal.summable_sigma.1 this).1 l).has_sum end -/-- The radius of convergence of `p.change_origin x` is at least `p.radius - ∥x∥`. In other words, +/-- The radius of convergence of `p.change_origin x` is at least `p.radius - ‖x‖`. In other words, `p.change_origin x` is well defined on the largest ball contained in the original ball of convergence.-/ -lemma change_origin_radius : p.radius - ∥x∥₊ ≤ (p.change_origin x).radius := +lemma change_origin_radius : p.radius - ‖x‖₊ ≤ (p.change_origin x).radius := begin refine ennreal.le_of_forall_pos_nnreal_lt (λ r h0 hr, _), rw [lt_tsub_iff_right, add_comm] at hr, - have hr' : (∥x∥₊ : ℝ≥0∞) < p.radius, from (le_add_right le_rfl).trans_lt hr, + have hr' : (‖x‖₊ : ℝ≥0∞) < p.radius, from (le_add_right le_rfl).trans_lt hr, apply le_radius_of_summable_nnnorm, - have : ∀ k : ℕ, ∥p.change_origin x k∥₊ * r ^ k ≤ - (∑' s : Σ l : ℕ, {s : finset (fin (k + l)) // s.card = l}, ∥p (k + s.1)∥₊ * ∥x∥₊ ^ s.1) * r ^ k, + have : ∀ k : ℕ, ‖p.change_origin x k‖₊ * r ^ k ≤ + (∑' s : Σ l : ℕ, {s : finset (fin (k + l)) // s.card = l}, ‖p (k + s.1)‖₊ * ‖x‖₊ ^ s.1) * r ^ k, from λ k, mul_le_mul_right' (p.nnnorm_change_origin_le k hr') (r ^ k), refine nnreal.summable_of_le this _, simpa only [← nnreal.tsum_mul_right] @@ -1078,7 +1162,7 @@ have _ := p.le_change_origin_series_radius k, ((p.change_origin_series k).has_fpower_series_on_ball (hr.trans_le this)).mono hr this /-- Summing the series `p.change_origin x` at a point `y` gives back `p (x + y)`-/ -theorem change_origin_eval (h : (∥x∥₊ + ∥y∥₊ : ℝ≥0∞) < p.radius) : +theorem change_origin_eval (h : (‖x‖₊ + ‖y‖₊ : ℝ≥0∞) < p.radius) : (p.change_origin x).sum y = (p.sum (x + y)) := begin have radius_pos : 0 < p.radius := lt_of_le_of_lt (zero_le _) h, @@ -1135,8 +1219,8 @@ variables [complete_space F] {f : E → F} {p : formal_multilinear_series 𝕜 E power series on any subball of this ball (even with a different center), given by `p.change_origin`. -/ theorem has_fpower_series_on_ball.change_origin - (hf : has_fpower_series_on_ball f p x r) (h : (∥y∥₊ : ℝ≥0∞) < r) : - has_fpower_series_on_ball f (p.change_origin y) (x + y) (r - ∥y∥₊) := + (hf : has_fpower_series_on_ball f p x r) (h : (‖y‖₊ : ℝ≥0∞) < r) : + has_fpower_series_on_ball f (p.change_origin y) (x + y) (r - ‖y‖₊) := { r_le := begin apply le_trans _ p.change_origin_radius, exact tsub_le_tsub hf.r_le le_rfl @@ -1158,7 +1242,7 @@ lemma has_fpower_series_on_ball.analytic_at_of_mem (hf : has_fpower_series_on_ball f p x r) (h : y ∈ emetric.ball x r) : analytic_at 𝕜 f y := begin - have : (∥y - x∥₊ : ℝ≥0∞) < r, by simpa [edist_eq_coe_nnnorm_sub] using h, + have : (‖y - x‖₊ : ℝ≥0∞) < r, by simpa [edist_eq_coe_nnnorm_sub] using h, have := hf.change_origin this, rw [add_sub_cancel'_right] at this, exact this.analytic_at @@ -1180,3 +1264,46 @@ begin end end + +section + +open formal_multilinear_series + +variables {p : formal_multilinear_series 𝕜 𝕜 E} {f : 𝕜 → E} {z₀ : 𝕜} + +/-- A function `f : 𝕜 → E` has `p` as power series expansion at a point `z₀` iff it is the sum of +`p` in a neighborhood of `z₀`. This makes some proofs easier by hiding the fact that +`has_fpower_series_at` depends on `p.radius`. -/ +lemma has_fpower_series_at_iff : has_fpower_series_at f p z₀ ↔ + ∀ᶠ z in 𝓝 0, has_sum (λ n, z ^ n • p.coeff n) (f (z₀ + z)) := +begin + refine ⟨λ ⟨r, r_le, r_pos, h⟩, eventually_of_mem (emetric.ball_mem_nhds 0 r_pos) + (λ _, by simpa using h), _⟩, + simp only [metric.eventually_nhds_iff], + rintro ⟨r, r_pos, h⟩, + refine ⟨p.radius ⊓ r.to_nnreal, by simp, _, _⟩, + { simp only [r_pos.lt, lt_inf_iff, ennreal.coe_pos, real.to_nnreal_pos, and_true], + obtain ⟨z, z_pos, le_z⟩ := normed_field.exists_norm_lt 𝕜 r_pos.lt, + have : (‖z‖₊ : ennreal) ≤ p.radius, + by { simp only [dist_zero_right] at h, + apply formal_multilinear_series.le_radius_of_tendsto, + convert tendsto_norm.comp (h le_z).summable.tendsto_at_top_zero, + funext; simp [norm_smul, mul_comm] }, + refine lt_of_lt_of_le _ this, + simp only [ennreal.coe_pos], + exact zero_lt_iff.mpr (nnnorm_ne_zero_iff.mpr (norm_pos_iff.mp z_pos)) }, + { simp only [emetric.mem_ball, lt_inf_iff, edist_lt_coe, apply_eq_pow_smul_coeff, and_imp, + dist_zero_right] at h ⊢, + refine λ y hyp hyr, h _, + simpa [nndist_eq_nnnorm, real.lt_to_nnreal_iff_coe_lt] using hyr } +end + +lemma has_fpower_series_at_iff' : has_fpower_series_at f p z₀ ↔ + ∀ᶠ z in 𝓝 z₀, has_sum (λ n, (z - z₀) ^ n • p.coeff n) (f z) := +begin + rw [← map_add_left_nhds_zero, eventually_map, has_fpower_series_at_iff], + congrm ∀ᶠ z in (𝓝 0 : filter 𝕜), has_sum (λ n, _) (f (z₀ + z)), + rw add_sub_cancel' +end + +end diff --git a/src/analysis/analytic/composition.lean b/src/analysis/analytic/composition.lean index e7d04555e7627..83396029efcdc 100644 --- a/src/analysis/analytic/composition.lean +++ b/src/analysis/analytic/composition.lean @@ -9,7 +9,10 @@ import combinatorics.composition /-! # Composition of analytic functions -in this file we prove that the composition of analytic functions is analytic. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that the composition of analytic functions is analytic. The argument is the following. Assume `g z = ∑' qₙ (z, ..., z)` and `f y = ∑' pₖ (y, ..., y)`. Then @@ -67,7 +70,7 @@ noncomputable theory variables {𝕜 : Type*} {E F G H : Type*} open filter list -open_locale topological_space big_operators classical nnreal ennreal +open_locale topology big_operators classical nnreal ennreal section topological variables [comm_ring 𝕜] [add_comm_group E] [add_comm_group F] [add_comm_group G] @@ -181,10 +184,12 @@ def comp_along_composition {n : ℕ} (f : continuous_multilinear_map 𝕜 (λ (i : fin c.length), F) G) : continuous_multilinear_map 𝕜 (λ i : fin n, E) G := { to_fun := λ v, f (p.apply_composition c v), - map_add' := λ v i x y, by simp only [apply_composition_update, - continuous_multilinear_map.map_add], - map_smul' := λ v i c x, by simp only [apply_composition_update, - continuous_multilinear_map.map_smul], + map_add' := λ _ v i x y, by + { cases subsingleton.elim ‹_› (fin.decidable_eq _), + simp only [apply_composition_update, continuous_multilinear_map.map_add] }, + map_smul' := λ _ v i c x, by + { cases subsingleton.elim ‹_› (fin.decidable_eq _), + simp only [apply_composition_update, continuous_multilinear_map.map_smul] }, cont := f.cont.comp $ continuous_pi $ λ i, (coe_continuous _).comp $ continuous_pi $ λ j, continuous_apply _, } @@ -217,7 +222,7 @@ def comp_along_composition {n : ℕ} /-- Formal composition of two formal multilinear series. The `n`-th coefficient in the composition is defined to be the sum of `q.comp_along_composition p c` over all compositions of `n`. In other words, this term (as a multilinear function applied to `v_0, ..., v_{n-1}`) is -`∑'_{k} ∑'_{i₁ + ... + iₖ = n} pₖ (q_{i_1} (...), ..., q_{i_k} (...))`, where one puts all variables +`∑'_{k} ∑'_{i₁ + ... + iₖ = n} qₖ (p_{i_1} (...), ..., p_{i_k} (...))`, where one puts all variables `v_0, ..., v_{n-1}` in increasing order in the dots. In general, the composition `q ∘ p` only makes sense when the constant coefficient of `p` vanishes. @@ -268,6 +273,7 @@ begin exact p.congr rfl (λ j hj1 hj2, by congr) end +/-- Only `0`-th coefficient of `q.comp p` depends on `q 0`. -/ lemma remove_zero_comp_of_pos (q : formal_multilinear_series 𝕜 F G) (p : formal_multilinear_series 𝕜 E F) {n : ℕ} (hn : 0 < n) : q.remove_zero.comp p n = q.comp p n := @@ -288,11 +294,11 @@ end formal_multilinear_series end topological -variables [nondiscrete_normed_field 𝕜] - [normed_group E] [normed_space 𝕜 E] - [normed_group F] [normed_space 𝕜 F] - [normed_group G] [normed_space 𝕜 G] - [normed_group H] [normed_space 𝕜 H] +variables [nontrivially_normed_field 𝕜] + [normed_add_comm_group E] [normed_space 𝕜 E] + [normed_add_comm_group F] [normed_space 𝕜 F] + [normed_add_comm_group G] [normed_space 𝕜 G] + [normed_add_comm_group H] [normed_space 𝕜 H] namespace formal_multilinear_series @@ -301,21 +307,21 @@ the norms of the relevant bits of `f` and `p`. -/ lemma comp_along_composition_bound {n : ℕ} (p : formal_multilinear_series 𝕜 E F) (c : composition n) (f : continuous_multilinear_map 𝕜 (λ (i : fin c.length), F) G) (v : fin n → E) : - ∥f.comp_along_composition p c v∥ ≤ - ∥f∥ * (∏ i, ∥p (c.blocks_fun i)∥) * (∏ i : fin n, ∥v i∥) := -calc ∥f.comp_along_composition p c v∥ = ∥f (p.apply_composition c v)∥ : rfl -... ≤ ∥f∥ * ∏ i, ∥p.apply_composition c v i∥ : continuous_multilinear_map.le_op_norm _ _ -... ≤ ∥f∥ * ∏ i, ∥p (c.blocks_fun i)∥ * - ∏ j : fin (c.blocks_fun i), ∥(v ∘ (c.embedding i)) j∥ : + ‖f.comp_along_composition p c v‖ ≤ + ‖f‖ * (∏ i, ‖p (c.blocks_fun i)‖) * (∏ i : fin n, ‖v i‖) := +calc ‖f.comp_along_composition p c v‖ = ‖f (p.apply_composition c v)‖ : rfl +... ≤ ‖f‖ * ∏ i, ‖p.apply_composition c v i‖ : continuous_multilinear_map.le_op_norm _ _ +... ≤ ‖f‖ * ∏ i, ‖p (c.blocks_fun i)‖ * + ∏ j : fin (c.blocks_fun i), ‖(v ∘ (c.embedding i)) j‖ : begin apply mul_le_mul_of_nonneg_left _ (norm_nonneg _), refine finset.prod_le_prod (λ i hi, norm_nonneg _) (λ i hi, _), apply continuous_multilinear_map.le_op_norm, end -... = ∥f∥ * (∏ i, ∥p (c.blocks_fun i)∥) * - ∏ i (j : fin (c.blocks_fun i)), ∥(v ∘ (c.embedding i)) j∥ : +... = ‖f‖ * (∏ i, ‖p (c.blocks_fun i)‖) * + ∏ i (j : fin (c.blocks_fun i)), ‖(v ∘ (c.embedding i)) j‖ : by rw [finset.prod_mul_distrib, mul_assoc] -... = ∥f∥ * (∏ i, ∥p (c.blocks_fun i)∥) * (∏ i : fin n, ∥v i∥) : +... = ‖f‖ * (∏ i, ‖p (c.blocks_fun i)‖) * (∏ i : fin n, ‖v i‖) : by { rw [← c.blocks_fin_equiv.prod_comp, ← finset.univ_sigma_univ, finset.prod_sigma], congr } @@ -324,7 +330,7 @@ the norms of the relevant bits of `q` and `p`. -/ lemma comp_along_composition_norm {n : ℕ} (q : formal_multilinear_series 𝕜 F G) (p : formal_multilinear_series 𝕜 E F) (c : composition n) : - ∥q.comp_along_composition p c∥ ≤ ∥q c.length∥ * ∏ i, ∥p (c.blocks_fun i)∥ := + ‖q.comp_along_composition p c‖ ≤ ‖q c.length‖ * ∏ i, ‖p (c.blocks_fun i)‖ := continuous_multilinear_map.op_norm_le_bound _ (mul_nonneg (norm_nonneg _) (finset.prod_nonneg (λ i hi, norm_nonneg _))) (comp_along_composition_bound _ _ _) @@ -332,7 +338,7 @@ continuous_multilinear_map.op_norm_le_bound _ lemma comp_along_composition_nnnorm {n : ℕ} (q : formal_multilinear_series 𝕜 F G) (p : formal_multilinear_series 𝕜 E F) (c : composition n) : - ∥q.comp_along_composition p c∥₊ ≤ ∥q c.length∥₊ * ∏ i, ∥p (c.blocks_fun i)∥₊ := + ‖q.comp_along_composition p c‖₊ ≤ ‖q c.length‖₊ * ∏ i, ‖p (c.blocks_fun i)‖₊ := by { rw ← nnreal.coe_le_coe, push_cast, exact q.comp_along_composition_norm p c } /-! @@ -438,41 +444,41 @@ theorem comp_summable_nnreal (q : formal_multilinear_series 𝕜 F G) (p : formal_multilinear_series 𝕜 E F) (hq : 0 < q.radius) (hp : 0 < p.radius) : ∃ r > (0 : ℝ≥0), - summable (λ i : Σ n, composition n, ∥q.comp_along_composition p i.2∥₊ * r ^ i.1) := + summable (λ i : Σ n, composition n, ‖q.comp_along_composition p i.2‖₊ * r ^ i.1) := begin - /- This follows from the fact that the growth rate of `∥qₙ∥` and `∥pₙ∥` is at most geometric, - giving a geometric bound on each `∥q.comp_along_composition p op∥`, together with the + /- This follows from the fact that the growth rate of `‖qₙ‖` and `‖pₙ‖` is at most geometric, + giving a geometric bound on each `‖q.comp_along_composition p op‖`, together with the fact that there are `2^(n-1)` compositions of `n`, giving at most a geometric loss. -/ - rcases ennreal.lt_iff_exists_nnreal_btwn.1 (lt_min ennreal.zero_lt_one hq) with ⟨rq, rq_pos, hrq⟩, - rcases ennreal.lt_iff_exists_nnreal_btwn.1 (lt_min ennreal.zero_lt_one hp) with ⟨rp, rp_pos, hrp⟩, + rcases ennreal.lt_iff_exists_nnreal_btwn.1 (lt_min zero_lt_one hq) with ⟨rq, rq_pos, hrq⟩, + rcases ennreal.lt_iff_exists_nnreal_btwn.1 (lt_min zero_lt_one hp) with ⟨rp, rp_pos, hrp⟩, simp only [lt_min_iff, ennreal.coe_lt_one_iff, ennreal.coe_pos] at hrp hrq rp_pos rq_pos, - obtain ⟨Cq, hCq0, hCq⟩ : ∃ Cq > 0, ∀ n, ∥q n∥₊ * rq^n ≤ Cq := + obtain ⟨Cq, hCq0, hCq⟩ : ∃ Cq > 0, ∀ n, ‖q n‖₊ * rq^n ≤ Cq := q.nnnorm_mul_pow_le_of_lt_radius hrq.2, - obtain ⟨Cp, hCp1, hCp⟩ : ∃ Cp ≥ 1, ∀ n, ∥p n∥₊ * rp^n ≤ Cp, + obtain ⟨Cp, hCp1, hCp⟩ : ∃ Cp ≥ 1, ∀ n, ‖p n‖₊ * rp^n ≤ Cp, { rcases p.nnnorm_mul_pow_le_of_lt_radius hrp.2 with ⟨Cp, -, hCp⟩, exact ⟨max Cp 1, le_max_right _ _, λ n, (hCp n).trans (le_max_left _ _)⟩ }, let r0 : ℝ≥0 := (4 * Cp)⁻¹, - have r0_pos : 0 < r0 := nnreal.inv_pos.2 (mul_pos zero_lt_four (zero_lt_one.trans_le hCp1)), + have r0_pos : 0 < r0 := inv_pos.2 (mul_pos zero_lt_four (zero_lt_one.trans_le hCp1)), set r : ℝ≥0 := rp * rq * r0, have r_pos : 0 < r := mul_pos (mul_pos rp_pos rq_pos) r0_pos, have I : ∀ (i : Σ (n : ℕ), composition n), - ∥q.comp_along_composition p i.2∥₊ * r ^ i.1 ≤ Cq / 4 ^ i.1, + ‖q.comp_along_composition p i.2‖₊ * r ^ i.1 ≤ Cq / 4 ^ i.1, { rintros ⟨n, c⟩, have A, - calc ∥q c.length∥₊ * rq ^ n ≤ ∥q c.length∥₊* rq ^ c.length : + calc ‖q c.length‖₊ * rq ^ n ≤ ‖q c.length‖₊* rq ^ c.length : mul_le_mul' le_rfl (pow_le_pow_of_le_one rq.2 hrq.1.le c.length_le) ... ≤ Cq : hCq _, have B, - calc ((∏ i, ∥p (c.blocks_fun i)∥₊) * rp ^ n) - = ∏ i, ∥p (c.blocks_fun i)∥₊ * rp ^ c.blocks_fun i : + calc ((∏ i, ‖p (c.blocks_fun i)‖₊) * rp ^ n) + = ∏ i, ‖p (c.blocks_fun i)‖₊ * rp ^ c.blocks_fun i : by simp only [finset.prod_mul_distrib, finset.prod_pow_eq_pow_sum, c.sum_blocks_fun] ... ≤ ∏ i : fin c.length, Cp : finset.prod_le_prod' (λ i _, hCp _) ... = Cp ^ c.length : by simp ... ≤ Cp ^ n : pow_le_pow hCp1 c.length_le, - calc ∥q.comp_along_composition p c∥₊ * r ^ n - ≤ (∥q c.length∥₊ * ∏ i, ∥p (c.blocks_fun i)∥₊) * r ^ n : + calc ‖q.comp_along_composition p c‖₊ * r ^ n + ≤ (‖q c.length‖₊ * ∏ i, ‖p (c.blocks_fun i)‖₊) * r ^ n : mul_le_mul' (q.comp_along_composition_nnnorm p c) le_rfl - ... = (∥q c.length∥₊ * rq ^ n) * ((∏ i, ∥p (c.blocks_fun i)∥₊) * rp ^ n) * r0 ^ n : + ... = (‖q c.length‖₊ * rq ^ n) * ((∏ i, ‖p (c.blocks_fun i)‖₊) * rp ^ n) * r0 ^ n : by { simp only [r, mul_pow], ring } ... ≤ Cq * Cp ^ n * r0 ^ n : mul_le_mul' (mul_le_mul' A B) le_rfl ... = Cq / 4 ^ n : @@ -502,18 +508,18 @@ end summability over all compositions. -/ theorem le_comp_radius_of_summable (q : formal_multilinear_series 𝕜 F G) (p : formal_multilinear_series 𝕜 E F) (r : ℝ≥0) - (hr : summable (λ i : (Σ n, composition n), ∥q.comp_along_composition p i.2∥₊ * r ^ i.1)) : + (hr : summable (λ i : (Σ n, composition n), ‖q.comp_along_composition p i.2‖₊ * r ^ i.1)) : (r : ℝ≥0∞) ≤ (q.comp p).radius := begin refine le_radius_of_bound_nnreal _ - (∑' i : (Σ n, composition n), ∥comp_along_composition q p i.snd∥₊ * r ^ i.fst) (λ n, _), - calc ∥formal_multilinear_series.comp q p n∥₊ * r ^ n ≤ - ∑' (c : composition n), ∥comp_along_composition q p c∥₊ * r ^ n : + (∑' i : (Σ n, composition n), ‖comp_along_composition q p i.snd‖₊ * r ^ i.fst) (λ n, _), + calc ‖formal_multilinear_series.comp q p n‖₊ * r ^ n ≤ + ∑' (c : composition n), ‖comp_along_composition q p c‖₊ * r ^ n : begin rw [tsum_fintype, ← finset.sum_mul], exact mul_le_mul' (nnnorm_sum_le _ _) le_rfl end - ... ≤ ∑' (i : Σ (n : ℕ), composition n), ∥comp_along_composition q p i.snd∥₊ * r ^ i.fst : + ... ≤ ∑' (i : Σ (n : ℕ), composition n), ‖comp_along_composition q p i.snd‖₊ * r ^ i.fst : nnreal.tsum_comp_le_tsum_of_inj hr sigma_mk_injective end @@ -732,7 +738,7 @@ begin refine ⟨min rf' r, _⟩, refine ⟨le_trans (min_le_right rf' r) (formal_multilinear_series.le_comp_radius_of_summable q p r hr), min_pos, λ y hy, _⟩, - /- Let `y` satisfy `∥y∥ < min (r, rf', δ)`. We want to show that `g (f (x + y))` is the sum of + /- Let `y` satisfy `‖y‖ < min (r, rf', δ)`. We want to show that `g (f (x + y))` is the sum of `q.comp p` applied to `y`. -/ -- First, check that `y` is small enough so that estimates for `f` and `g` apply. have y_mem : y ∈ emetric.ball (0 : E) rf := @@ -792,10 +798,10 @@ begin { apply cauchy_seq_finset_of_norm_bounded _ (nnreal.summable_coe.2 hr) _, simp only [coe_nnnorm, nnreal.coe_mul, nnreal.coe_pow], rintros ⟨n, c⟩, - calc ∥(comp_along_composition q p c) (λ (j : fin n), y)∥ - ≤ ∥comp_along_composition q p c∥ * ∏ j : fin n, ∥y∥ : + calc ‖(comp_along_composition q p c) (λ (j : fin n), y)‖ + ≤ ‖comp_along_composition q p c‖ * ∏ j : fin n, ‖y‖ : by apply continuous_multilinear_map.le_op_norm - ... ≤ ∥comp_along_composition q p c∥ * (r : ℝ) ^ n : + ... ≤ ‖comp_along_composition q p c‖ * (r : ℝ) ^ n : begin apply mul_le_mul_of_nonneg_left _ (norm_nonneg _), rw [finset.prod_const, finset.card_fin], diff --git a/src/analysis/analytic/inverse.lean b/src/analysis/analytic/inverse.lean index 06ecf81952709..d2c1a11a873ea 100644 --- a/src/analysis/analytic/inverse.lean +++ b/src/analysis/analytic/inverse.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ import analysis.analytic.composition - +import tactic.congrm /-! # Inverse of analytic functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We construct the left and right inverse of a formal multilinear series with invertible linear term, we prove that they coincide and study their properties (notably convergence). @@ -26,14 +29,14 @@ we prove that they coincide and study their properties (notably convergence). -/ -open_locale big_operators classical topological_space +open_locale big_operators classical topology open finset filter namespace formal_multilinear_series -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -{E : Type*} [normed_group E] [normed_space 𝕜 E] -{F : Type*} [normed_group F] [normed_space 𝕜 F] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] /-! ### The left inverse of a formal multilinear series -/ @@ -126,7 +129,7 @@ begin ext k, simp [h] }, simp [formal_multilinear_series.comp, show n + 2 ≠ 1, by dec_trivial, A, finset.sum_union B, - apply_composition_ones, C, D], + apply_composition_ones, C, D, -set.to_finset_set_of], end /-! ### The right inverse of a formal multilinear series -/ @@ -165,14 +168,12 @@ lemma right_inv_remove_zero (p : formal_multilinear_series 𝕜 E F) (i : E ≃L begin ext1 n, induction n using nat.strong_rec' with n IH, - cases n, { simp }, - cases n, { simp }, + rcases n with _|_|n, + { simp only [right_inv_coeff_zero] }, + { simp only [right_inv_coeff_one] }, simp only [right_inv, neg_inj], - unfold_coes, - congr' 1, - rw remove_zero_comp_of_pos _ _ (show 0 < n+2, by dec_trivial), - congr' 1, - ext k, + rw remove_zero_comp_of_pos _ _ (add_pos_of_nonneg_of_pos (n.zero_le) zero_lt_two), + congr' 2 with k, by_cases hk : k < n+2; simp [hk, IH] end @@ -198,7 +199,7 @@ begin = p 1 (λ (i : fin 1), q n v), { apply p.congr (composition.single_length hn) (λ j hj1 hj2, _), simp [apply_composition_single] }, - simp [formal_multilinear_series.comp, A, finset.sum_union B, C], + simp [formal_multilinear_series.comp, A, finset.sum_union B, C, -set.to_finset_set_of], end lemma comp_right_inv_aux2 @@ -231,7 +232,7 @@ begin continuous_linear_equiv.coe_apply, continuous_multilinear_curry_fin1_symm_apply] }, have N : 0 < n+2, by dec_trivial, simp [comp_right_inv_aux1 N, h, right_inv, lt_irrefl n, show n + 2 ≠ 1, by dec_trivial, - ← sub_eq_add_neg, sub_eq_zero, comp_right_inv_aux2], + ← sub_eq_add_neg, sub_eq_zero, comp_right_inv_aux2, -set.to_finset_set_of], end lemma right_inv_coeff (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) (n : ℕ) (hn : 2 ≤ n) : @@ -246,7 +247,7 @@ begin ext v, have N : 0 < n + 2, by dec_trivial, have : (p 1) (λ (i : fin 1), 0) = 0 := continuous_multilinear_map.map_zero _, - simp [comp_right_inv_aux1 N, lt_irrefl n, this, comp_right_inv_aux2] + simp [comp_right_inv_aux1 N, lt_irrefl n, this, comp_right_inv_aux2, -set.to_finset_set_of], end /-! ### Coincidence of the left and the right inverse -/ @@ -291,7 +292,7 @@ $$ Here, `q_{n-1}` can only appear in the term with `k = 2`, and it only appears twice, so there is hope this formula can lead to an at most geometric behavior. -Let `Qₙ = ∥qₙ∥`. Bounding `∥pₖ∥` with `C r^k` gives an inequality +Let `Qₙ = ‖qₙ‖`. Bounding `‖pₖ‖` with `C r^k` gives an inequality $$ Q_n ≤ C' \sum_{k=2}^n r^k \sum_{i_1 + \dotsc + i_k = n} Q_{i_1} \dotsm Q_{i_k}. $$ @@ -395,7 +396,7 @@ begin (λ (k : ℕ), (fintype.pi_finset (λ (i : fin k), Ico 1 n) : finset (fin k → ℕ))) (λ n e, ∏ (j : fin n), r * (a ^ e j * p (e j)))], apply sum_congr rfl (λ j hj, _), - simp only [← @multilinear_map.mk_pi_algebra_apply ℝ (fin j) _ _ ℝ], + simp only [← @multilinear_map.mk_pi_algebra_apply ℝ (fin j) _ ℝ], simp only [← multilinear_map.map_sum_finset (multilinear_map.mk_pi_algebra ℝ (fin j) ℝ) (λ k (m : ℕ), r * (a ^ m * p m))], simp only [multilinear_map.mk_pi_algebra_apply], @@ -409,27 +410,27 @@ in the specific setup we are interesting in, by reducing to the general bound in `radius_right_inv_pos_of_radius_pos_aux1`. -/ lemma radius_right_inv_pos_of_radius_pos_aux2 {n : ℕ} (hn : 2 ≤ n + 1) (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) - {r a C : ℝ} (hr : 0 ≤ r) (ha : 0 ≤ a) (hC : 0 ≤ C) (hp : ∀ n, ∥p n∥ ≤ C * r ^ n) : - (∑ k in Ico 1 (n + 1), a ^ k * ∥p.right_inv i k∥) ≤ - ∥(i.symm : F →L[𝕜] E)∥ * a + ∥(i.symm : F →L[𝕜] E)∥ * C * ∑ k in Ico 2 (n + 1), - (r * ((∑ j in Ico 1 n, a ^ j * ∥p.right_inv i j∥))) ^ k := -let I := ∥(i.symm : F →L[𝕜] E)∥ in calc -∑ k in Ico 1 (n + 1), a ^ k * ∥p.right_inv i k∥ - = a * I + ∑ k in Ico 2 (n + 1), a ^ k * ∥p.right_inv i k∥ : + {r a C : ℝ} (hr : 0 ≤ r) (ha : 0 ≤ a) (hC : 0 ≤ C) (hp : ∀ n, ‖p n‖ ≤ C * r ^ n) : + (∑ k in Ico 1 (n + 1), a ^ k * ‖p.right_inv i k‖) ≤ + ‖(i.symm : F →L[𝕜] E)‖ * a + ‖(i.symm : F →L[𝕜] E)‖ * C * ∑ k in Ico 2 (n + 1), + (r * ((∑ j in Ico 1 n, a ^ j * ‖p.right_inv i j‖))) ^ k := +let I := ‖(i.symm : F →L[𝕜] E)‖ in calc +∑ k in Ico 1 (n + 1), a ^ k * ‖p.right_inv i k‖ + = a * I + ∑ k in Ico 2 (n + 1), a ^ k * ‖p.right_inv i k‖ : by simp only [linear_isometry_equiv.norm_map, pow_one, right_inv_coeff_one, nat.Ico_succ_singleton, sum_singleton, ← sum_Ico_consecutive _ one_le_two hn] ... = a * I + ∑ k in Ico 2 (n + 1), a ^ k * - ∥(i.symm : F →L[𝕜] E).comp_continuous_multilinear_map + ‖(i.symm : F →L[𝕜] E).comp_continuous_multilinear_map (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)), - p.comp_along_composition (p.right_inv i) c)∥ : + p.comp_along_composition (p.right_inv i) c)‖ : begin congr' 1, apply sum_congr rfl (λ j hj, _), rw [right_inv_coeff _ _ _ (mem_Ico.1 hj).1, norm_neg], end -... ≤ a * ∥(i.symm : F →L[𝕜] E)∥ + ∑ k in Ico 2 (n + 1), a ^ k * (I * +... ≤ a * ‖(i.symm : F →L[𝕜] E)‖ + ∑ k in Ico 2 (n + 1), a ^ k * (I * (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)), - C * r ^ c.length * ∏ j, ∥p.right_inv i (c.blocks_fun j)∥)) : + C * r ^ c.length * ∏ j, ‖p.right_inv i (c.blocks_fun j)‖)) : begin apply_rules [add_le_add, le_refl, sum_le_sum (λ j hj, _), mul_le_mul_of_nonneg_left, pow_nonneg, ha], @@ -443,17 +444,17 @@ begin end ... = I * a + I * C * ∑ k in Ico 2 (n + 1), a ^ k * (∑ c in ({c | 1 < composition.length c}.to_finset : finset (composition k)), - r ^ c.length * ∏ j, ∥p.right_inv i (c.blocks_fun j)∥) : + r ^ c.length * ∏ j, ‖p.right_inv i (c.blocks_fun j)‖) : begin - simp_rw [mul_assoc C, ← mul_sum, ← mul_assoc, mul_comm _ (∥↑i.symm∥), mul_assoc, ← mul_sum, + simp_rw [mul_assoc C, ← mul_sum, ← mul_assoc, mul_comm _ (‖↑i.symm‖), mul_assoc, ← mul_sum, ← mul_assoc, mul_comm _ C, mul_assoc, ← mul_sum], ring, end -... ≤ I * a + I * C * ∑ k in Ico 2 (n+1), (r * ((∑ j in Ico 1 n, a ^ j * ∥p.right_inv i j∥))) ^ k : +... ≤ I * a + I * C * ∑ k in Ico 2 (n+1), (r * ((∑ j in Ico 1 n, a ^ j * ‖p.right_inv i j‖))) ^ k : begin apply_rules [add_le_add, le_refl, mul_le_mul_of_nonneg_left, norm_nonneg, hC, mul_nonneg], simp_rw [mul_pow], - apply radius_right_inv_pos_of_radius_pos_aux1 n (λ k, ∥p.right_inv i k∥) + apply radius_right_inv_pos_of_radius_pos_aux1 n (λ k, ‖p.right_inv i k‖) (λ k, norm_nonneg _) hr ha, end @@ -462,9 +463,9 @@ also has a positive radius of convergence. -/ theorem radius_right_inv_pos_of_radius_pos (p : formal_multilinear_series 𝕜 E F) (i : E ≃L[𝕜] F) (hp : 0 < p.radius) : 0 < (p.right_inv i).radius := begin - obtain ⟨C, r, Cpos, rpos, ple⟩ : ∃ C r (hC : 0 < C) (hr : 0 < r), ∀ (n : ℕ), ∥p n∥ ≤ C * r ^ n := + obtain ⟨C, r, Cpos, rpos, ple⟩ : ∃ C r (hC : 0 < C) (hr : 0 < r), ∀ (n : ℕ), ‖p n‖ ≤ C * r ^ n := le_mul_pow_of_radius_pos p hp, - let I := ∥(i.symm : F →L[𝕜] E)∥, + let I := ‖(i.symm : F →L[𝕜] E)‖, -- choose `a` small enough to make sure that `∑_{k ≤ n} aᵏ Qₖ` will be controllable by -- induction obtain ⟨a, apos, ha1, ha2⟩ : ∃ a (apos : 0 < a), @@ -483,7 +484,7 @@ begin exact ⟨a, ha.1, ha.2.1.le, ha.2.2.le⟩ }, -- check by induction that the partial sums are suitably bounded, using the choice of `a` and the -- inductive control from Lemma `radius_right_inv_pos_of_radius_pos_aux2`. - let S := λ n, ∑ k in Ico 1 n, a ^ k * ∥p.right_inv i k∥, + let S := λ n, ∑ k in Ico 1 n, a ^ k * ‖p.right_inv i k‖, have IRec : ∀ n, 1 ≤ n → S n ≤ (I + 1) * a, { apply nat.le_induction, { simp only [S], @@ -521,14 +522,14 @@ begin by { apply lt_of_lt_of_le _ H, exact_mod_cast apos }, apply le_radius_of_bound _ ((I + 1) * a) (λ n, _), by_cases hn : n = 0, - { have : ∥p.right_inv i n∥ = ∥p.right_inv i 0∥, by congr; try { rw hn }, + { have : ‖p.right_inv i n‖ = ‖p.right_inv i 0‖, by congr; try { rw hn }, simp only [this, norm_zero, zero_mul, right_inv_coeff_zero], apply_rules [mul_nonneg, add_nonneg, norm_nonneg, zero_le_one, apos.le] }, { have one_le_n : 1 ≤ n := bot_lt_iff_ne_bot.2 hn, - calc ∥p.right_inv i n∥ * ↑a' ^ n = a ^ n * ∥p.right_inv i n∥ : mul_comm _ _ - ... ≤ ∑ k in Ico 1 (n + 1), a ^ k * ∥p.right_inv i k∥ : + calc ‖p.right_inv i n‖ * ↑a' ^ n = a ^ n * ‖p.right_inv i n‖ : mul_comm _ _ + ... ≤ ∑ k in Ico 1 (n + 1), a ^ k * ‖p.right_inv i k‖ : begin - have : ∀ k ∈ Ico 1 (n + 1), 0 ≤ a ^ k * ∥p.right_inv i k∥ := + have : ∀ k ∈ Ico 1 (n + 1), 0 ≤ a ^ k * ‖p.right_inv i k‖ := λ k hk, mul_nonneg (pow_nonneg apos.le _) (norm_nonneg _), exact single_le_sum this (by simp [one_le_n]), end diff --git a/src/analysis/analytic/isolated_zeros.lean b/src/analysis/analytic/isolated_zeros.lean new file mode 100644 index 0000000000000..7759f8579ca8b --- /dev/null +++ b/src/analysis/analytic/isolated_zeros.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2022 Vincent Beffara. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Vincent Beffara +-/ +import analysis.analytic.basic +import analysis.calculus.dslope +import analysis.calculus.fderiv_analytic +import analysis.calculus.formal_multilinear_series +import analysis.analytic.uniqueness + +/-! +# Principle of isolated zeros + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the fact that the zeros of a non-constant analytic function of one variable are +isolated. It also introduces a little bit of API in the `has_fpower_series_at` namespace that is +useful in this setup. + +## Main results + +* `analytic_at.eventually_eq_zero_or_eventually_ne_zero` is the main statement that if a function is + analytic at `z₀`, then either it is identically zero in a neighborhood of `z₀`, or it does not + vanish in a punctured neighborhood of `z₀`. +* `analytic_on.eq_on_of_preconnected_of_frequently_eq` is the identity theorem for analytic + functions: if a function `f` is analytic on a connected set `U` and is zero on a set with an + accumulation point in `U` then `f` is identically `0` on `U`. +-/ + +open_locale classical + +open filter function nat formal_multilinear_series emetric set +open_locale topology big_operators + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {s : E} + {p q : formal_multilinear_series 𝕜 𝕜 E} {f g : 𝕜 → E} + {n : ℕ} {z z₀ : 𝕜} {y : fin n → 𝕜} + +namespace has_sum + +variables {a : ℕ → E} + +lemma has_sum_at_zero (a : ℕ → E) : has_sum (λ n, (0:𝕜) ^ n • a n) (a 0) := +by convert has_sum_single 0 (λ b h, _); simp [nat.pos_of_ne_zero h] <|> simp + +lemma exists_has_sum_smul_of_apply_eq_zero (hs : has_sum (λ m, z ^ m • a m) s) + (ha : ∀ k < n, a k = 0) : + ∃ t : E, z ^ n • t = s ∧ has_sum (λ m, z ^ m • a (m + n)) t := +begin + obtain rfl | hn := n.eq_zero_or_pos, + { simpa }, + by_cases h : z = 0, + { have : s = 0 := hs.unique (by simpa [ha 0 hn, h] using has_sum_at_zero a), + exact ⟨a n, by simp [h, hn, this], by simpa [h] using has_sum_at_zero (λ m, a (m + n))⟩ }, + { refine ⟨(z ^ n)⁻¹ • s, by field_simp [smul_smul], _⟩, + have h1 : ∑ i in finset.range n, z ^ i • a i = 0, + from finset.sum_eq_zero (λ k hk, by simp [ha k (finset.mem_range.mp hk)]), + have h2 : has_sum (λ m, z ^ (m + n) • a (m + n)) s, + by simpa [h1] using (has_sum_nat_add_iff' n).mpr hs, + convert h2.const_smul (z⁻¹ ^ n), + { field_simp [pow_add, smul_smul] }, + { simp only [inv_pow] } } +end + +end has_sum + +namespace has_fpower_series_at + +lemma has_fpower_series_dslope_fslope (hp : has_fpower_series_at f p z₀) : + has_fpower_series_at (dslope f z₀) p.fslope z₀ := +begin + have hpd : deriv f z₀ = p.coeff 1 := hp.deriv, + have hp0 : p.coeff 0 = f z₀ := hp.coeff_zero 1, + simp only [has_fpower_series_at_iff, apply_eq_pow_smul_coeff, coeff_fslope] at hp ⊢, + refine hp.mono (λ x hx, _), + by_cases h : x = 0, + { convert has_sum_single 0 _; intros; simp [*] }, + { have hxx : ∀ (n : ℕ), x⁻¹ * x ^ (n + 1) = x ^ n := λ n, by field_simp [h, pow_succ'], + suffices : has_sum (λ n, x⁻¹ • x ^ (n + 1) • p.coeff (n + 1)) (x⁻¹ • (f (z₀ + x) - f z₀)), + { simpa [dslope, slope, h, smul_smul, hxx] using this }, + { simpa [hp0] using ((has_sum_nat_add_iff' 1).mpr hx).const_smul x⁻¹ } } +end + +lemma has_fpower_series_iterate_dslope_fslope (n : ℕ) (hp : has_fpower_series_at f p z₀) : + has_fpower_series_at ((swap dslope z₀)^[n] f) (fslope^[n] p) z₀ := +begin + induction n with n ih generalizing f p, + { exact hp }, + { simpa using ih (has_fpower_series_dslope_fslope hp) } +end + +lemma iterate_dslope_fslope_ne_zero (hp : has_fpower_series_at f p z₀) (h : p ≠ 0) : + (swap dslope z₀)^[p.order] f z₀ ≠ 0 := +begin + rw [← coeff_zero (has_fpower_series_iterate_dslope_fslope p.order hp) 1], + simpa [coeff_eq_zero] using apply_order_ne_zero h +end + +lemma eq_pow_order_mul_iterate_dslope (hp : has_fpower_series_at f p z₀) : + ∀ᶠ z in 𝓝 z₀, f z = (z - z₀) ^ p.order • ((swap dslope z₀)^[p.order] f z) := +begin + have hq := has_fpower_series_at_iff'.mp (has_fpower_series_iterate_dslope_fslope p.order hp), + filter_upwards [hq, has_fpower_series_at_iff'.mp hp] with x hx1 hx2, + have : ∀ k < p.order, p.coeff k = 0, + from λ k hk, by simpa [coeff_eq_zero] using apply_eq_zero_of_lt_order hk, + obtain ⟨s, hs1, hs2⟩ := has_sum.exists_has_sum_smul_of_apply_eq_zero hx2 this, + convert hs1.symm, + simp only [coeff_iterate_fslope] at hx1, + exact hx1.unique hs2 +end + +lemma locally_ne_zero (hp : has_fpower_series_at f p z₀) (h : p ≠ 0) : + ∀ᶠ z in 𝓝[≠] z₀, f z ≠ 0 := +begin + rw [eventually_nhds_within_iff], + have h2 := (has_fpower_series_iterate_dslope_fslope p.order hp).continuous_at, + have h3 := h2.eventually_ne (iterate_dslope_fslope_ne_zero hp h), + filter_upwards [eq_pow_order_mul_iterate_dslope hp, h3] with z e1 e2 e3, + simpa [e1, e2, e3] using pow_ne_zero p.order (sub_ne_zero.mpr e3), +end + +lemma locally_zero_iff (hp : has_fpower_series_at f p z₀) : + (∀ᶠ z in 𝓝 z₀, f z = 0) ↔ p = 0 := +⟨λ hf, hp.eq_zero_of_eventually hf, λ h, eventually_eq_zero (by rwa h at hp)⟩ + +end has_fpower_series_at + +namespace analytic_at + +/-- The *principle of isolated zeros* for an analytic function, local version: if a function is +analytic at `z₀`, then either it is identically zero in a neighborhood of `z₀`, or it does not +vanish in a punctured neighborhood of `z₀`. -/ +theorem eventually_eq_zero_or_eventually_ne_zero (hf : analytic_at 𝕜 f z₀) : + (∀ᶠ z in 𝓝 z₀, f z = 0) ∨ (∀ᶠ z in 𝓝[≠] z₀, f z ≠ 0) := +begin + rcases hf with ⟨p, hp⟩, + by_cases h : p = 0, + { exact or.inl (has_fpower_series_at.eventually_eq_zero (by rwa h at hp)) }, + { exact or.inr (hp.locally_ne_zero h) } +end + +lemma eventually_eq_or_eventually_ne (hf : analytic_at 𝕜 f z₀) (hg : analytic_at 𝕜 g z₀) : + (∀ᶠ z in 𝓝 z₀, f z = g z) ∨ (∀ᶠ z in 𝓝[≠] z₀, f z ≠ g z) := +by simpa [sub_eq_zero] using (hf.sub hg).eventually_eq_zero_or_eventually_ne_zero + +lemma frequently_zero_iff_eventually_zero {f : 𝕜 → E} {w : 𝕜} (hf : analytic_at 𝕜 f w) : + (∃ᶠ z in 𝓝[≠] w, f z = 0) ↔ (∀ᶠ z in 𝓝 w, f z = 0) := +⟨hf.eventually_eq_zero_or_eventually_ne_zero.resolve_right, + λ h, (h.filter_mono nhds_within_le_nhds).frequently⟩ + +lemma frequently_eq_iff_eventually_eq (hf : analytic_at 𝕜 f z₀) (hg : analytic_at 𝕜 g z₀) : + (∃ᶠ z in 𝓝[≠] z₀, f z = g z) ↔ (∀ᶠ z in 𝓝 z₀, f z = g z) := +by simpa [sub_eq_zero] using frequently_zero_iff_eventually_zero (hf.sub hg) + +end analytic_at + +namespace analytic_on + +variables {U : set 𝕜} + +/-- The *principle of isolated zeros* for an analytic function, global version: if a function is +analytic on a connected set `U` and vanishes in arbitrary neighborhoods of a point `z₀ ∈ U`, then +it is identically zero in `U`. +For higher-dimensional versions requiring that the function vanishes in a neighborhood of `z₀`, +see `eq_on_zero_of_preconnected_of_eventually_eq_zero`. -/ +theorem eq_on_zero_of_preconnected_of_frequently_eq_zero + (hf : analytic_on 𝕜 f U) (hU : is_preconnected U) + (h₀ : z₀ ∈ U) (hfw : ∃ᶠ z in 𝓝[≠] z₀, f z = 0) : + eq_on f 0 U := +hf.eq_on_zero_of_preconnected_of_eventually_eq_zero hU h₀ + ((hf z₀ h₀).frequently_zero_iff_eventually_zero.1 hfw) + +theorem eq_on_zero_of_preconnected_of_mem_closure (hf : analytic_on 𝕜 f U) (hU : is_preconnected U) + (h₀ : z₀ ∈ U) (hfz₀ : z₀ ∈ closure ({z | f z = 0} \ {z₀})) : + eq_on f 0 U := +hf.eq_on_zero_of_preconnected_of_frequently_eq_zero hU h₀ + (mem_closure_ne_iff_frequently_within.mp hfz₀) + +/-- The *identity principle* for analytic functions, global version: if two functions are +analytic on a connected set `U` and coincide at points which accumulate to a point `z₀ ∈ U`, then +they coincide globally in `U`. +For higher-dimensional versions requiring that the functions coincide in a neighborhood of `z₀`, +see `eq_on_of_preconnected_of_eventually_eq`. -/ +theorem eq_on_of_preconnected_of_frequently_eq (hf : analytic_on 𝕜 f U) (hg : analytic_on 𝕜 g U) + (hU : is_preconnected U) (h₀ : z₀ ∈ U) (hfg : ∃ᶠ z in 𝓝[≠] z₀, f z = g z) : + eq_on f g U := +begin + have hfg' : ∃ᶠ z in 𝓝[≠] z₀, (f - g) z = 0 := hfg.mono (λ z h, by rw [pi.sub_apply, h, sub_self]), + simpa [sub_eq_zero] using + λ z hz, (hf.sub hg).eq_on_zero_of_preconnected_of_frequently_eq_zero hU h₀ hfg' hz +end + +theorem eq_on_of_preconnected_of_mem_closure (hf : analytic_on 𝕜 f U) (hg : analytic_on 𝕜 g U) + (hU : is_preconnected U) (h₀ : z₀ ∈ U) (hfg : z₀ ∈ closure ({z | f z = g z} \ {z₀})) : + eq_on f g U := +hf.eq_on_of_preconnected_of_frequently_eq hg hU h₀ (mem_closure_ne_iff_frequently_within.mp hfg) + +/-- The *identity principle* for analytic functions, global version: if two functions on a normed +field `𝕜` are analytic everywhere and coincide at points which accumulate to a point `z₀`, then +they coincide globally. +For higher-dimensional versions requiring that the functions coincide in a neighborhood of `z₀`, +see `eq_of_eventually_eq`. -/ +theorem eq_of_frequently_eq [connected_space 𝕜] + (hf : analytic_on 𝕜 f univ) (hg : analytic_on 𝕜 g univ) + (hfg : ∃ᶠ z in 𝓝[≠] z₀, f z = g z) : f = g := +funext (λ x, eq_on_of_preconnected_of_frequently_eq hf hg is_preconnected_univ + (mem_univ z₀) hfg (mem_univ x)) + +end analytic_on diff --git a/src/analysis/analytic/linear.lean b/src/analysis/analytic/linear.lean index 7ce5a69a2d8f0..978b53cba4ba2 100644 --- a/src/analysis/analytic/linear.lean +++ b/src/analysis/analytic/linear.lean @@ -8,16 +8,19 @@ import analysis.analytic.basic /-! # Linear functions are analytic +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that a `continuous_linear_map` defines an analytic function with the formal power series `f x = f a + f (x - a)`. -/ -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -{E : Type*} [normed_group E] [normed_space 𝕜 E] -{F : Type*} [normed_group F] [normed_space 𝕜 F] -{G : Type*} [normed_group G] [normed_space 𝕜 G] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +{G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] -open_locale topological_space classical big_operators nnreal ennreal +open_locale topology classical big_operators nnreal ennreal open set filter asymptotics noncomputable theory diff --git a/src/analysis/analytic/radius_liminf.lean b/src/analysis/analytic/radius_liminf.lean index ecb1d750d27da..bbaad072c93de 100644 --- a/src/analysis/analytic/radius_liminf.lean +++ b/src/analysis/analytic/radius_liminf.lean @@ -4,20 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ import analysis.analytic.basic -import analysis.special_functions.pow +import analysis.special_functions.pow.nnreal /-! # Representation of `formal_multilinear_series.radius` as a `liminf` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that the radius of convergence of a `formal_multilinear_series` is equal to -$\liminf_{n\to\infty} \frac{1}{\sqrt[n]{∥p n∥}}$. This lemma can't go to `basic.lean` because this +$\liminf_{n\to\infty} \frac{1}{\sqrt[n]{‖p n‖}}$. This lemma can't go to `basic.lean` because this would create a circular dependency once we redefine `exp` using `formal_multilinear_series`. -/ -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -{E : Type*} [normed_group E] [normed_space 𝕜 E] -{F : Type*} [normed_group F] [normed_space 𝕜 F] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] -open_locale topological_space classical big_operators nnreal ennreal +open_locale topology classical big_operators nnreal ennreal open filter asymptotics namespace formal_multilinear_series @@ -25,12 +28,12 @@ namespace formal_multilinear_series variables (p : formal_multilinear_series 𝕜 E F) /-- The radius of a formal multilinear series is equal to -$\liminf_{n\to\infty} \frac{1}{\sqrt[n]{∥p n∥}}$. The actual statement uses `ℝ≥0` and some +$\liminf_{n\to\infty} \frac{1}{\sqrt[n]{‖p n‖}}$. The actual statement uses `ℝ≥0` and some coercions. -/ -lemma radius_eq_liminf : p.radius = liminf at_top (λ n, 1/((∥p n∥₊) ^ (1 / (n : ℝ)) : ℝ≥0)) := +lemma radius_eq_liminf : p.radius = liminf (λ n, 1/((‖p n‖₊) ^ (1 / (n : ℝ)) : ℝ≥0)) at_top := begin have : ∀ (r : ℝ≥0) {n : ℕ}, 0 < n → - ((r : ℝ≥0∞) ≤ 1 / ↑(∥p n∥₊ ^ (1 / (n : ℝ))) ↔ ∥p n∥₊ * r ^ n ≤ 1), + ((r : ℝ≥0∞) ≤ 1 / ↑(‖p n‖₊ ^ (1 / (n : ℝ))) ↔ ‖p n‖₊ * r ^ n ≤ 1), { intros r n hn, have : 0 < (n : ℝ) := nat.cast_pos.2 hn, conv_lhs {rw [one_div, ennreal.le_inv_iff_mul_le, ← ennreal.coe_mul, @@ -38,7 +41,7 @@ begin nnreal.rpow_mul, ← nnreal.mul_rpow, ← nnreal.one_rpow (n⁻¹), nnreal.rpow_le_rpow_iff (inv_pos.2 this), mul_comm, nnreal.rpow_nat_cast] } }, apply le_antisymm; refine ennreal.le_of_forall_nnreal_lt (λ r hr, _), - { rcases ((tfae_exists_lt_is_o_pow (λ n, ∥p n∥ * r ^ n) 1).out 1 7).1 (p.is_o_of_lt_radius hr) + { rcases ((tfae_exists_lt_is_o_pow (λ n, ‖p n‖ * r ^ n) 1).out 1 7).1 (p.is_o_of_lt_radius hr) with ⟨a, ha, H⟩, refine le_Liminf_of_le (by apply_auto_param) (eventually_map.2 $ _), refine H.mp ((eventually_gt_at_top 0).mono $ λ n hn₀ hn, (this _ hn₀).2 diff --git a/src/analysis/analytic/uniqueness.lean b/src/analysis/analytic/uniqueness.lean new file mode 100644 index 0000000000000..8668e4da3b970 --- /dev/null +++ b/src/analysis/analytic/uniqueness.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.analytic.linear +import analysis.analytic.composition +import analysis.normed_space.completion + +/-! +# Uniqueness principle for analytic functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that two analytic functions which coincide around a point coincide on whole connected sets, +in `analytic_on.eq_on_of_preconnected_of_eventually_eq`. +-/ + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] + +open set +open_locale topology ennreal + +namespace analytic_on + +/-- If an analytic function vanishes around a point, then it is uniformly zero along +a connected set. Superseded by `eq_on_zero_of_preconnected_of_locally_zero` which does not assume +completeness of the target space. -/ +theorem eq_on_zero_of_preconnected_of_eventually_eq_zero_aux [complete_space F] + {f : E → F} {U : set E} (hf : analytic_on 𝕜 f U) (hU : is_preconnected U) {z₀ : E} + (h₀ : z₀ ∈ U) (hfz₀ : f =ᶠ[𝓝 z₀] 0) : eq_on f 0 U := +begin + /- Let `u` be the set of points around which `f` vanishes. It is clearly open. We have to show + that its limit points in `U` still belong to it, from which the inclusion `U ⊆ u` will follow + by connectedness. -/ + let u := {x | f =ᶠ[𝓝 x] 0}, + suffices main : closure u ∩ U ⊆ u, + { have Uu : U ⊆ u, from + hU.subset_of_closure_inter_subset is_open_set_of_eventually_nhds ⟨z₀, h₀, hfz₀⟩ main, + assume z hz, + simpa using mem_of_mem_nhds (Uu hz) }, + /- Take a limit point `x`, then a ball `B (x, r)` on which it has a power series expansion, and + then `y ∈ B (x, r/2) ∩ u`. Then `f` has a power series expansion on `B (y, r/2)` as it is + contained in `B (x, r)`. All the coefficients in this series expansion vanish, as `f` is zero on a + neighborhood of `y`. Therefore, `f` is zero on `B (y, r/2)`. As this ball contains `x`, it follows + that `f` vanishes on a neighborhood of `x`, proving the claim. -/ + rintros x ⟨xu, xU⟩, + rcases hf x xU with ⟨p, r, hp⟩, + obtain ⟨y, yu, hxy⟩ : ∃ y ∈ u, edist x y < r / 2, + from emetric.mem_closure_iff.1 xu (r / 2) (ennreal.half_pos hp.r_pos.ne'), + let q := p.change_origin (y - x), + have has_series : has_fpower_series_on_ball f q y (r / 2), + { have A : (‖y - x‖₊ : ℝ≥0∞) < r / 2, by rwa [edist_comm, edist_eq_coe_nnnorm_sub] at hxy, + have := hp.change_origin (A.trans_le ennreal.half_le_self), + simp only [add_sub_cancel'_right] at this, + apply this.mono (ennreal.half_pos hp.r_pos.ne'), + apply ennreal.le_sub_of_add_le_left ennreal.coe_ne_top, + apply (add_le_add (A.le) (le_refl (r / 2))).trans (le_of_eq _), + exact ennreal.add_halves _ }, + have M : emetric.ball y (r / 2) ∈ 𝓝 x, from emetric.is_open_ball.mem_nhds hxy, + filter_upwards [M] with z hz, + have A : has_sum (λ (n : ℕ), q n (λ (i : fin n), z - y)) (f z) := has_series.has_sum_sub hz, + have B : has_sum (λ (n : ℕ), q n (λ (i : fin n), z - y)) (0), + { have : has_fpower_series_at 0 q y, from has_series.has_fpower_series_at.congr yu, + convert has_sum_zero, + ext n, + exact this.apply_eq_zero n _ }, + exact has_sum.unique A B +end + +/-- The *identity principle* for analytic functions: If an analytic function vanishes in a whole +neighborhood of a point `z₀`, then it is uniformly zero along a connected set. For a one-dimensional +version assuming only that the function vanishes at some points arbitrarily close to `z₀`, see +`eq_on_zero_of_preconnected_of_frequently_eq_zero`. -/ +theorem eq_on_zero_of_preconnected_of_eventually_eq_zero + {f : E → F} {U : set E} (hf : analytic_on 𝕜 f U) (hU : is_preconnected U) {z₀ : E} + (h₀ : z₀ ∈ U) (hfz₀ : f =ᶠ[𝓝 z₀] 0) : + eq_on f 0 U := +begin + let F' := uniform_space.completion F, + set e : F →L[𝕜] F' := uniform_space.completion.to_complL, + have : analytic_on 𝕜 (e ∘ f) U := λ x hx, (e.analytic_at _).comp (hf x hx), + have A : eq_on (e ∘ f) 0 U, + { apply eq_on_zero_of_preconnected_of_eventually_eq_zero_aux this hU h₀, + filter_upwards [hfz₀] with x hx, + simp only [hx, function.comp_app, pi.zero_apply, map_zero] }, + assume z hz, + have : e (f z) = e 0, by simpa only using A hz, + exact uniform_space.completion.coe_injective F this, +end + +/-- The *identity principle* for analytic functions: If two analytic functions coincide in a whole +neighborhood of a point `z₀`, then they coincide globally along a connected set. +For a one-dimensional version assuming only that the functions coincide at some points +arbitrarily close to `z₀`, see `eq_on_of_preconnected_of_frequently_eq`. -/ +theorem eq_on_of_preconnected_of_eventually_eq + {f g : E → F} {U : set E} (hf : analytic_on 𝕜 f U) (hg : analytic_on 𝕜 g U) + (hU : is_preconnected U) {z₀ : E} (h₀ : z₀ ∈ U) (hfg : f =ᶠ[𝓝 z₀] g) : + eq_on f g U := +begin + have hfg' : (f - g) =ᶠ[𝓝 z₀] 0 := hfg.mono (λ z h, by simp [h]), + simpa [sub_eq_zero] using + λ z hz, (hf.sub hg).eq_on_zero_of_preconnected_of_eventually_eq_zero hU h₀ hfg' hz, +end + +/-- The *identity principle* for analytic functions: If two analytic functions on a normed space +coincide in a neighborhood of a point `z₀`, then they coincide everywhere. +For a one-dimensional version assuming only that the functions coincide at some points +arbitrarily close to `z₀`, see `eq_of_frequently_eq`. -/ +theorem eq_of_eventually_eq {f g : E → F} [preconnected_space E] + (hf : analytic_on 𝕜 f univ) (hg : analytic_on 𝕜 g univ) {z₀ : E} (hfg : f =ᶠ[𝓝 z₀] g) : + f = g := +funext (λ x, eq_on_of_preconnected_of_eventually_eq hf hg is_preconnected_univ + (mem_univ z₀) hfg (mem_univ x)) + +end analytic_on diff --git a/src/analysis/asymptotics/asymptotic_equivalent.lean b/src/analysis/asymptotics/asymptotic_equivalent.lean index 9be85a2eaae66..3eb177685acb9 100644 --- a/src/analysis/asymptotics/asymptotic_equivalent.lean +++ b/src/analysis/asymptotics/asymptotic_equivalent.lean @@ -4,17 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Anatole Dedecker -/ import analysis.asymptotics.asymptotics -import analysis.normed_space.ordered +import analysis.normed.order.basic /-! # Asymptotic equivalence +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define the relation `is_equivalent l u v`, which means that `u-v` is little o of `v` along the filter `l`. Unlike `is_[oO]` relations, this one requires `u` and `v` to have the same codomain `β`. While the -definition only requires `β` to be a `normed_group`, most interesting properties require it to be a -`normed_field`. +definition only requires `β` to be a `normed_add_comm_group`, most interesting properties require it +to be a `normed_field`. ## Notations @@ -23,7 +26,7 @@ We introduce the notation `u ~[l] v := is_equivalent l u v`, which you can use b ## Main results -If `β` is a `normed_group` : +If `β` is a `normed_add_comm_group` : - `_ ~[l] _` is an equivalence relation - Equivalent statements for `u ~[l] const _ c` : @@ -57,26 +60,27 @@ This is to enable `calc` support, as `calc` requires that the last two explicit namespace asymptotics open filter function -open_locale topological_space +open_locale topology -section normed_group +section normed_add_comm_group -variables {α β : Type*} [normed_group β] +variables {α β : Type*} [normed_add_comm_group β] /-- Two functions `u` and `v` are said to be asymptotically equivalent along a filter `l` when `u x - v x = o(v x)` as x converges along `l`. -/ -def is_equivalent (l : filter α) (u v : α → β) := is_o (u - v) v l +def is_equivalent (l : filter α) (u v : α → β) := (u - v) =o[l] v -localized "notation u ` ~[`:50 l:50 `] `:0 v:50 := asymptotics.is_equivalent l u v" in asymptotics +localized "notation (name := asymptotics.is_equivalent) + u ` ~[`:50 l:50 `] `:0 v:50 := asymptotics.is_equivalent l u v" in asymptotics variables {u v w : α → β} {l : filter α} -lemma is_equivalent.is_o (h : u ~[l] v) : is_o (u - v) v l := h +lemma is_equivalent.is_o (h : u ~[l] v) : (u - v) =o[l] v := h -lemma is_equivalent.is_O (h : u ~[l] v) : is_O u v l := +lemma is_equivalent.is_O (h : u ~[l] v) : u =O[l] v := (is_O.congr_of_sub h.is_O.symm).mp (is_O_refl _ _) -lemma is_equivalent.is_O_symm (h : u ~[l] v) : is_O v u l := +lemma is_equivalent.is_O_symm (h : u ~[l] v) : v =O[l] u := begin convert h.is_o.right_is_O_add, ext, @@ -98,7 +102,7 @@ end lemma is_equivalent.congr_left {u v w : α → β} {l : filter α} (huv : u ~[l] v) (huw : u =ᶠ[l] w) : w ~[l] v := -is_o.congr' (huw.sub (eventually_eq.refl _ _)) (eventually_eq.refl _ _) huv +huv.congr' (huw.sub (eventually_eq.refl _ _)) (eventually_eq.refl _ _) lemma is_equivalent.congr_right {u v w : α → β} {l : filter α} (huv : u ~[l] v) (hvw : v =ᶠ[l] w) : u ~[l] w := @@ -110,7 +114,7 @@ begin exact is_o_zero_right_iff end -lemma is_equivalent_zero_iff_is_O_zero : u ~[l] 0 ↔ is_O u (0 : α → β) l := +lemma is_equivalent_zero_iff_is_O_zero : u ~[l] 0 ↔ u =O[l] (0 : α → β) := begin refine ⟨is_equivalent.is_O, λ h, _⟩, rw [is_equivalent_zero_iff_eventually_zero, eventually_eq_iff_exists_mem], @@ -146,15 +150,16 @@ end lemma is_equivalent.tendsto_nhds_iff {c : β} (huv : u ~[l] v) : tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c) := ⟨huv.tendsto_nhds, huv.symm.tendsto_nhds⟩ -lemma is_equivalent.add_is_o (huv : u ~[l] v) (hwv : is_o w v l) : (w + u) ~[l] v := -begin - rw is_equivalent at *, - convert hwv.add huv, - ext, - simp [add_sub], -end +lemma is_equivalent.add_is_o (huv : u ~[l] v) (hwv : w =o[l] v) : (u + w) ~[l] v := +by simpa only [is_equivalent, add_sub_right_comm] using huv.add hwv + +lemma is_equivalent.sub_is_o (huv : u ~[l] v) (hwv : w =o[l] v) : (u - w) ~[l] v := +by simpa only [sub_eq_add_neg] using huv.add_is_o hwv.neg_left + +lemma is_o.add_is_equivalent (hu : u =o[l] w) (hv : v ~[l] w) : (u + v) ~[l] w := +add_comm v u ▸ hv.add_is_o hu -lemma is_o.is_equivalent (huv : is_o (u - v) v l) : u ~[l] v := huv +lemma is_o.is_equivalent (huv : (u - v) =o[l] v) : u ~[l] v := huv lemma is_equivalent.neg (huv : u ~[l] v) : (λ x, - u x) ~[l] (λ x, - v x) := begin @@ -164,7 +169,7 @@ begin simp, end -end normed_group +end normed_add_comm_group open_locale asymptotics @@ -219,7 +224,7 @@ end normed_field section smul -lemma is_equivalent.smul {α E 𝕜 : Type*} [normed_field 𝕜] [normed_group E] +lemma is_equivalent.smul {α E 𝕜 : Type*} [normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] {a b : α → 𝕜} {u v : α → E} {l : filter α} (hab : a ~[l] b) (huv : u ~[l] v) : (λ x, a x • u x) ~[l] (λ x, b x • v x) := begin @@ -241,18 +246,18 @@ begin refine hφ.mp (huv.mp $ hCuv.mono $ λ x hCuvx huvx hφx, _), have key := - calc ∥φ x - 1∥ * ∥u x∥ - ≤ (c/2) / C * ∥u x∥ : mul_le_mul_of_nonneg_right hφx.le (norm_nonneg $ u x) - ... ≤ (c/2) / C * (C*∥v x∥) : mul_le_mul_of_nonneg_left hCuvx (div_pos (by linarith) hC).le - ... = c/2 * ∥v x∥ : by {field_simp [hC.ne.symm], ring}, - - calc ∥((λ (x : α), φ x • u x) - v) x∥ - = ∥(φ x - 1) • u x + (u x - v x)∥ : by simp [sub_smul, sub_add] - ... ≤ ∥(φ x - 1) • u x∥ + ∥u x - v x∥ : norm_add_le _ _ - ... = ∥φ x - 1∥ * ∥u x∥ + ∥u x - v x∥ : by rw norm_smul - ... ≤ c / 2 * ∥v x∥ + ∥u x - v x∥ : add_le_add_right key _ - ... ≤ c / 2 * ∥v x∥ + c / 2 * ∥v x∥ : add_le_add_left huvx _ - ... = c * ∥v x∥ : by ring, + calc ‖φ x - 1‖ * ‖u x‖ + ≤ (c/2) / C * ‖u x‖ : mul_le_mul_of_nonneg_right hφx.le (norm_nonneg $ u x) + ... ≤ (c/2) / C * (C*‖v x‖) : mul_le_mul_of_nonneg_left hCuvx (div_pos (by linarith) hC).le + ... = c/2 * ‖v x‖ : by {field_simp [hC.ne.symm], ring}, + + calc ‖((λ (x : α), φ x • u x) - v) x‖ + = ‖(φ x - 1) • u x + (u x - v x)‖ : by simp [sub_smul, sub_add] + ... ≤ ‖(φ x - 1) • u x‖ + ‖u x - v x‖ : norm_add_le _ _ + ... = ‖φ x - 1‖ * ‖u x‖ + ‖u x - v x‖ : by rw norm_smul + ... ≤ c / 2 * ‖v x‖ + ‖u x - v x‖ : add_le_add_right key _ + ... ≤ c / 2 * ‖v x‖ + c / 2 * ‖v x‖ : add_le_add_left huvx _ + ... = c * ‖v x‖ : by ring, end end smul @@ -272,7 +277,7 @@ begin refine ⟨λ x, (φ x)⁻¹, tendsto.inv₀ hφ (by norm_num) , _⟩, convert h.inv, ext, - simp [mul_inv₀] + simp [mul_inv] end lemma is_equivalent.div (htu : t ~[l] u) (hvw : v ~[l] w) : @@ -312,7 +317,7 @@ end asymptotics open filter asymptotics open_locale asymptotics -variables {α β : Type*} [normed_group β] +variables {α β : Type*} [normed_add_comm_group β] lemma filter.eventually_eq.is_equivalent {u v : α → β} {l : filter α} (h : u =ᶠ[l] v) : u ~[l] v := -is_o.congr' h.sub_eq.symm (eventually_eq.refl _ _) (is_o_zero v l) +is_equivalent.congr_right (is_o_refl_left _ _) h diff --git a/src/analysis/asymptotics/asymptotics.lean b/src/analysis/asymptotics/asymptotics.lean index edf371472bb88..77c2586c1dc1d 100644 --- a/src/analysis/asymptotics/asymptotics.lean +++ b/src/analysis/asymptotics/asymptotics.lean @@ -3,6 +3,7 @@ Copyright (c) 2019 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Yury Kudryashov -/ +import analysis.normed.group.infinite_sum import analysis.normed_space.basic import topology.algebra.order.liminf_limsup import topology.local_homeomorph @@ -10,11 +11,14 @@ import topology.local_homeomorph /-! # Asymptotics +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce these relations: -* `is_O_with c f g l` : "f is big O of g along l with constant c"; -* `is_O f g l` : "f is big O of g along l"; -* `is_o f g l` : "f is little o of g along l". +* `is_O_with c l f g` : "f is big O of g along l with constant c"; +* `f =O[l] g` : "f is big O of g along l"; +* `f =o[l] g` : "f is little o of g along l". Here `l` is any filter on the domain of `f` and `g`, which are assumed to be the same. The codomains of `f` and `g` do not need to be the same; all that is needed that there is a norm associated with @@ -27,7 +31,7 @@ instead. Often the ranges of `f` and `g` will be the real numbers, in which case the norm is the absolute value. In general, we have - `is_O f g l ↔ is_O (λ x, ∥f x∥) (λ x, ∥g x∥) l`, + `f =O[l] g ↔ (λ x, ‖f x‖) =O[l] (λ x, ‖g x‖)`, and similarly for `is_o`. But our setup allows us to use the notions e.g. with functions to the integers, rationals, complex numbers, or any normed vector space without mentioning the @@ -36,7 +40,7 @@ norm explicitly. If `f` and `g` are functions to a normed field like the reals or complex numbers and `g` is always nonzero, we have - `is_o f g l ↔ tendsto (λ x, f x / (g x)) l (𝓝 0)`. + `f =o[l] g ↔ tendsto (λ x, f x / (g x)) l (𝓝 0)`. In fact, the right-to-left direction holds without the hypothesis on `g`, and in the other direction it suffices to assume that `f` is zero wherever `g` is. (This generalization is useful in defining @@ -44,7 +48,7 @@ the Fréchet derivative.) -/ open filter set -open_locale topological_space big_operators classical filter nnreal +open_locale topology big_operators classical filter nnreal namespace asymptotics @@ -54,11 +58,11 @@ variables {α : Type*} {β : Type*} {E : Type*} {F : Type*} {G : Type*} {R : Type*} {R' : Type*} {𝕜 : Type*} {𝕜' : Type*} variables [has_norm E] [has_norm F] [has_norm G] -variables [semi_normed_group E'] [semi_normed_group F'] [semi_normed_group G'] -variables [normed_group E''] [normed_group F''] [normed_group G''] -variables [semi_normed_ring R] [semi_normed_ring R'] +variables [seminormed_add_comm_group E'] [seminormed_add_comm_group F'] + [seminormed_add_comm_group G'] [normed_add_comm_group E''] [normed_add_comm_group F''] + [normed_add_comm_group G''] [semi_normed_ring R] [semi_normed_ring R'] variables [normed_field 𝕜] [normed_field 𝕜'] -variables {c c' : ℝ} {f : α → E} {g : α → F} {k : α → G} +variables {c c' c₁ c₂ : ℝ} {f : α → E} {g : α → F} {k : α → G} variables {f' : α → E'} {g' : α → F'} {k' : α → G'} variables {f'' : α → E''} {g'' : α → F''} {k'' : α → G''} variables {l l' : filter α} @@ -67,135 +71,166 @@ section defs /-! ### Definitions -/ -/-- This version of the Landau notation `is_O_with C f g l` where `f` and `g` are two functions on -a type `α` and `l` is a filter on `α`, means that eventually for `l`, `∥f∥` is bounded by `C * ∥g∥`. -In other words, `∥f∥ / ∥g∥` is eventually bounded by `C`, modulo division by zero issues that are +/-- This version of the Landau notation `is_O_with C l f g` where `f` and `g` are two functions on +a type `α` and `l` is a filter on `α`, means that eventually for `l`, `‖f‖` is bounded by `C * ‖g‖`. +In other words, `‖f‖ / ‖g‖` is eventually bounded by `C`, modulo division by zero issues that are avoided by this definition. Probably you want to use `is_O` instead of this relation. -/ @[irreducible] -def is_O_with (c : ℝ) (f : α → E) (g : α → F) (l : filter α) : Prop := -∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥ +def is_O_with (c : ℝ) (l : filter α) (f : α → E) (g : α → F) : Prop := +∀ᶠ x in l, ‖ f x ‖ ≤ c * ‖ g x ‖ -/-- Definition of `is_O_with`. We record it in a lemma as we will set `is_O_with` to be irreducible -at the end of this file. -/ -lemma is_O_with_iff {c : ℝ} {f : α → E} {g : α → F} {l : filter α} : - is_O_with c f g l ↔ ∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥ := by rw is_O_with +/-- Definition of `is_O_with`. We record it in a lemma as `is_O_with` is irreducible. -/ +lemma is_O_with_iff : is_O_with c l f g ↔ ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖ := by rw is_O_with -alias is_O_with_iff ↔ asymptotics.is_O_with.bound asymptotics.is_O_with.of_bound +alias is_O_with_iff ↔ is_O_with.bound is_O_with.of_bound -/-- The Landau notation `is_O f g l` where `f` and `g` are two functions on a type `α` and `l` is -a filter on `α`, means that eventually for `l`, `∥f∥` is bounded by a constant multiple of `∥g∥`. -In other words, `∥f∥ / ∥g∥` is eventually bounded, modulo division by zero issues that are avoided +/-- The Landau notation `f =O[l] g` where `f` and `g` are two functions on a type `α` and `l` is +a filter on `α`, means that eventually for `l`, `‖f‖` is bounded by a constant multiple of `‖g‖`. +In other words, `‖f‖ / ‖g‖` is eventually bounded, modulo division by zero issues that are avoided by this definition. -/ @[irreducible] -def is_O (f : α → E) (g : α → F) (l : filter α) : Prop := ∃ c : ℝ, is_O_with c f g l +def is_O (l : filter α) (f : α → E) (g : α → F) : Prop := ∃ c : ℝ, is_O_with c l f g -/-- Definition of `is_O` in terms of `is_O_with`. We record it in a lemma as we will set -`is_O` to be irreducible at the end of this file. -/ -lemma is_O_iff_is_O_with {f : α → E} {g : α → F} {l : filter α} : - is_O f g l ↔ ∃ c : ℝ, is_O_with c f g l := by rw is_O +notation f ` =O[`:100 l `] ` g:100 := is_O l f g + +/-- Definition of `is_O` in terms of `is_O_with`. We record it in a lemma as `is_O` is +irreducible. -/ +lemma is_O_iff_is_O_with : f =O[l] g ↔ ∃ c : ℝ, is_O_with c l f g := by rw is_O /-- Definition of `is_O` in terms of filters. We record it in a lemma as we will set `is_O` to be irreducible at the end of this file. -/ -lemma is_O_iff {f : α → E} {g : α → F} {l : filter α} : - is_O f g l ↔ ∃ c : ℝ, ∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥ := by simp [is_O, is_O_with] +lemma is_O_iff : f =O[l] g ↔ ∃ c : ℝ, ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖ := +by simp only [is_O, is_O_with] -lemma is_O.of_bound (c : ℝ) {f : α → E} {g : α → F} {l : filter α} - (h : ∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥) : is_O f g l := is_O_iff.2 ⟨c, h⟩ +lemma is_O.of_bound (c : ℝ) (h : ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖) : f =O[l] g := +is_O_iff.2 ⟨c, h⟩ -lemma is_O.bound {f : α → E} {g : α → F} {l : filter α} : - is_O f g l → ∃ c : ℝ, ∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥ := is_O_iff.1 +lemma is_O.of_bound' (h : ∀ᶠ x in l, ‖f x‖ ≤ ‖g x‖) : f =O[l] g := +is_O.of_bound 1 $ by { simp_rw one_mul, exact h } -/-- The Landau notation `is_o f g l` where `f` and `g` are two functions on a type `α` and `l` is -a filter on `α`, means that eventually for `l`, `∥f∥` is bounded by an arbitrarily small constant -multiple of `∥g∥`. In other words, `∥f∥ / ∥g∥` tends to `0` along `l`, modulo division by zero +lemma is_O.bound : f =O[l] g → ∃ c : ℝ, ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖ := is_O_iff.1 + +/-- The Landau notation `f =o[l] g` where `f` and `g` are two functions on a type `α` and `l` is +a filter on `α`, means that eventually for `l`, `‖f‖` is bounded by an arbitrarily small constant +multiple of `‖g‖`. In other words, `‖f‖ / ‖g‖` tends to `0` along `l`, modulo division by zero issues that are avoided by this definition. -/ @[irreducible] -def is_o (f : α → E) (g : α → F) (l : filter α) : Prop := ∀ ⦃c : ℝ⦄, 0 < c → is_O_with c f g l +def is_o (l : filter α) (f : α → E) (g : α → F) : Prop := ∀ ⦃c : ℝ⦄, 0 < c → is_O_with c l f g + +notation f ` =o[`:100 l `] ` g:100 := is_o l f g /-- Definition of `is_o` in terms of `is_O_with`. We record it in a lemma as we will set `is_o` to be irreducible at the end of this file. -/ -lemma is_o_iff_forall_is_O_with {f : α → E} {g : α → F} {l : filter α} : - is_o f g l ↔ ∀ ⦃c : ℝ⦄, 0 < c → is_O_with c f g l := by rw is_o +lemma is_o_iff_forall_is_O_with : f =o[l] g ↔ ∀ ⦃c : ℝ⦄, 0 < c → is_O_with c l f g := by rw is_o -alias is_o_iff_forall_is_O_with ↔ asymptotics.is_o.forall_is_O_with asymptotics.is_o.of_is_O_with +alias is_o_iff_forall_is_O_with ↔ is_o.forall_is_O_with is_o.of_is_O_with /-- Definition of `is_o` in terms of filters. We record it in a lemma as we will set `is_o` to be irreducible at the end of this file. -/ -lemma is_o_iff {f : α → E} {g : α → F} {l : filter α} : - is_o f g l ↔ ∀ ⦃c : ℝ⦄, 0 < c → ∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥ := +lemma is_o_iff : f =o[l] g ↔ ∀ ⦃c : ℝ⦄, 0 < c → ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖ := by simp only [is_o, is_O_with] -alias is_o_iff ↔ asymptotics.is_o.bound asymptotics.is_o.of_bound +alias is_o_iff ↔ is_o.bound is_o.of_bound -lemma is_o.def {f : α → E} {g : α → F} {l : filter α} (h : is_o f g l) {c : ℝ} (hc : 0 < c) : - ∀ᶠ x in l, ∥ f x ∥ ≤ c * ∥ g x ∥ := +lemma is_o.def (h : f =o[l] g) (hc : 0 < c) : ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖ := is_o_iff.1 h hc -lemma is_o.def' {f : α → E} {g : α → F} {l : filter α} (h : is_o f g l) {c : ℝ} (hc : 0 < c) : - is_O_with c f g l := +lemma is_o.def' (h : f =o[l] g) (hc : 0 < c) : is_O_with c l f g := is_O_with_iff.2 $ is_o_iff.1 h hc end defs /-! ### Conversions -/ -theorem is_O_with.is_O (h : is_O_with c f g l) : is_O f g l := by rw is_O; exact ⟨c, h⟩ +theorem is_O_with.is_O (h : is_O_with c l f g) : f =O[l] g := by rw is_O; exact ⟨c, h⟩ -theorem is_o.is_O_with (hgf : is_o f g l) : is_O_with 1 f g l := hgf.def' zero_lt_one +theorem is_o.is_O_with (hgf : f =o[l] g) : is_O_with 1 l f g := hgf.def' zero_lt_one -theorem is_o.is_O (hgf : is_o f g l) : is_O f g l := hgf.is_O_with.is_O +theorem is_o.is_O (hgf : f =o[l] g) : f =O[l] g := hgf.is_O_with.is_O -lemma is_O.is_O_with {f : α → E} {g : α → F} {l : filter α} : - is_O f g l → ∃ c : ℝ, is_O_with c f g l := is_O_iff_is_O_with.1 +lemma is_O.is_O_with : f =O[l] g → ∃ c : ℝ, is_O_with c l f g := is_O_iff_is_O_with.1 -theorem is_O_with.weaken (h : is_O_with c f g' l) (hc : c ≤ c') : is_O_with c' f g' l := +theorem is_O_with.weaken (h : is_O_with c l f g') (hc : c ≤ c') : is_O_with c' l f g' := is_O_with.of_bound $ mem_of_superset h.bound $ λ x hx, -calc ∥f x∥ ≤ c * ∥g' x∥ : hx +calc ‖f x‖ ≤ c * ‖g' x‖ : hx ... ≤ _ : mul_le_mul_of_nonneg_right hc (norm_nonneg _) -theorem is_O_with.exists_pos (h : is_O_with c f g' l) : - ∃ c' (H : 0 < c'), is_O_with c' f g' l := +theorem is_O_with.exists_pos (h : is_O_with c l f g') : + ∃ c' (H : 0 < c'), is_O_with c' l f g' := ⟨max c 1, lt_of_lt_of_le zero_lt_one (le_max_right c 1), h.weaken $ le_max_left c 1⟩ -theorem is_O.exists_pos (h : is_O f g' l) : ∃ c (H : 0 < c), is_O_with c f g' l := +theorem is_O.exists_pos (h : f =O[l] g') : ∃ c (H : 0 < c), is_O_with c l f g' := let ⟨c, hc⟩ := h.is_O_with in hc.exists_pos -theorem is_O_with.exists_nonneg (h : is_O_with c f g' l) : - ∃ c' (H : 0 ≤ c'), is_O_with c' f g' l := +theorem is_O_with.exists_nonneg (h : is_O_with c l f g') : + ∃ c' (H : 0 ≤ c'), is_O_with c' l f g' := let ⟨c, cpos, hc⟩ := h.exists_pos in ⟨c, le_of_lt cpos, hc⟩ -theorem is_O.exists_nonneg (h : is_O f g' l) : - ∃ c (H : 0 ≤ c), is_O_with c f g' l := +theorem is_O.exists_nonneg (h : f =O[l] g') : + ∃ c (H : 0 ≤ c), is_O_with c l f g' := let ⟨c, hc⟩ := h.is_O_with in hc.exists_nonneg /-- `f = O(g)` if and only if `is_O_with c f g` for all sufficiently large `c`. -/ -lemma is_O_iff_eventually_is_O_with : is_O f g' l ↔ ∀ᶠ c in at_top, is_O_with c f g' l := +lemma is_O_iff_eventually_is_O_with : f =O[l] g' ↔ ∀ᶠ c in at_top, is_O_with c l f g' := is_O_iff_is_O_with.trans ⟨λ ⟨c, hc⟩, mem_at_top_sets.2 ⟨c, λ c' hc', hc.weaken hc'⟩, λ h, h.exists⟩ -/-- `f = O(g)` if and only if `∀ᶠ x in l, ∥f x∥ ≤ c * ∥g x∥` for all sufficiently large `c`. -/ -lemma is_O_iff_eventually : is_O f g' l ↔ ∀ᶠ c in at_top, ∀ᶠ x in l, ∥f x∥ ≤ c * ∥g' x∥ := +/-- `f = O(g)` if and only if `∀ᶠ x in l, ‖f x‖ ≤ c * ‖g x‖` for all sufficiently large `c`. -/ +lemma is_O_iff_eventually : f =O[l] g' ↔ ∀ᶠ c in at_top, ∀ᶠ x in l, ‖f x‖ ≤ c * ‖g' x‖ := is_O_iff_eventually_is_O_with.trans $ by simp only [is_O_with] -lemma is_O.exists_mem_basis {ι} {p : ι → Prop} {s : ι → set α} (h : is_O f g' l) +lemma is_O.exists_mem_basis {ι} {p : ι → Prop} {s : ι → set α} (h : f =O[l] g') (hb : l.has_basis p s) : - ∃ (c : ℝ) (hc : 0 < c) (i : ι) (hi : p i), ∀ x ∈ s i, ∥f x∥ ≤ c * ∥g' x∥ := + ∃ (c : ℝ) (hc : 0 < c) (i : ι) (hi : p i), ∀ x ∈ s i, ‖f x‖ ≤ c * ‖g' x‖ := flip Exists₂.imp h.exists_pos $ λ c hc h, by simpa only [is_O_with_iff, hb.eventually_iff, exists_prop] using h +lemma is_O_with_inv (hc : 0 < c) : is_O_with c⁻¹ l f g ↔ ∀ᶠ x in l, c * ‖f x‖ ≤ ‖g x‖ := +by simp only [is_O_with, ← div_eq_inv_mul, le_div_iff' hc] + +-- We prove this lemma with strange assumptions to get two lemmas below automatically +lemma is_o_iff_nat_mul_le_aux (h₀ : (∀ x, 0 ≤ ‖f x‖) ∨ ∀ x, 0 ≤ ‖g x‖) : + f =o[l] g ↔ ∀ n : ℕ, ∀ᶠ x in l, ↑n * ‖f x‖ ≤ ‖g x‖ := +begin + split, + { rintro H (_|n), + { refine (H.def one_pos).mono (λ x h₀', _), + rw [nat.cast_zero, zero_mul], + refine h₀.elim (λ hf, (hf x).trans _) (λ hg, hg x), + rwa one_mul at h₀' }, + { have : (0 : ℝ) < n.succ, from nat.cast_pos.2 n.succ_pos, + exact (is_O_with_inv this).1 (H.def' $ inv_pos.2 this) } }, + { refine λ H, is_o_iff.2 (λ ε ε0, _), + rcases exists_nat_gt ε⁻¹ with ⟨n, hn⟩, + have hn₀ : (0 : ℝ) < n, from (inv_pos.2 ε0).trans hn, + refine ((is_O_with_inv hn₀).2 (H n)).bound.mono (λ x hfg, _), + refine hfg.trans (mul_le_mul_of_nonneg_right (inv_le_of_inv_le ε0 hn.le) _), + refine h₀.elim (λ hf, nonneg_of_mul_nonneg_right ((hf x).trans hfg) _) (λ h, h x), + exact inv_pos.2 hn₀ } +end + +lemma is_o_iff_nat_mul_le : f =o[l] g' ↔ ∀ n : ℕ, ∀ᶠ x in l, ↑n * ‖f x‖ ≤ ‖g' x‖ := +is_o_iff_nat_mul_le_aux (or.inr $ λ x, norm_nonneg _) + +lemma is_o_iff_nat_mul_le' : f' =o[l] g ↔ ∀ n : ℕ, ∀ᶠ x in l, ↑n * ‖f' x‖ ≤ ‖g x‖ := +is_o_iff_nat_mul_le_aux (or.inl $ λ x, norm_nonneg _) + /-! ### Subsingleton -/ -@[nontriviality] lemma is_o_of_subsingleton [subsingleton E'] : is_o f' g' l := +@[nontriviality] lemma is_o_of_subsingleton [subsingleton E'] : f' =o[l] g' := is_o.of_bound $ λ c hc, by simp [subsingleton.elim (f' _) 0, mul_nonneg hc.le] -@[nontriviality] lemma is_O_of_subsingleton [subsingleton E'] : is_O f' g' l := +@[nontriviality] lemma is_O_of_subsingleton [subsingleton E'] : f' =O[l] g' := is_o_of_subsingleton.is_O +section congr + +variables {f₁ f₂ : α → E} {g₁ g₂ : α → F} + /-! ### Congruence -/ -theorem is_O_with_congr {c₁ c₂} {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hc : c₁ = c₂) (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : - is_O_with c₁ f₁ g₁ l ↔ is_O_with c₂ f₂ g₂ l := +theorem is_O_with_congr (hc : c₁ = c₂) (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : + is_O_with c₁ l f₁ g₁ ↔ is_O_with c₂ l f₂ g₂ := begin unfold is_O_with, subst c₂, @@ -204,451 +239,535 @@ begin rw [e₁, e₂], end -theorem is_O_with.congr' {c₁ c₂} {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hc : c₁ = c₂) (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : - is_O_with c₁ f₁ g₁ l → is_O_with c₂ f₂ g₂ l := -(is_O_with_congr hc hf hg).mp +theorem is_O_with.congr' (h : is_O_with c₁ l f₁ g₁) (hc : c₁ = c₂) (hf : f₁ =ᶠ[l] f₂) + (hg : g₁ =ᶠ[l] g₂) : is_O_with c₂ l f₂ g₂ := +(is_O_with_congr hc hf hg).mp h -theorem is_O_with.congr {c₁ c₂} {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hc : c₁ = c₂) (hf : ∀ x, f₁ x = f₂ x) (hg : ∀ x, g₁ x = g₂ x) : - is_O_with c₁ f₁ g₁ l → is_O_with c₂ f₂ g₂ l := -λ h, h.congr' hc (univ_mem' hf) (univ_mem' hg) +theorem is_O_with.congr (h : is_O_with c₁ l f₁ g₁) (hc : c₁ = c₂) (hf : ∀ x, f₁ x = f₂ x) + (hg : ∀ x, g₁ x = g₂ x) : is_O_with c₂ l f₂ g₂ := +h.congr' hc (univ_mem' hf) (univ_mem' hg) -theorem is_O_with.congr_left {f₁ f₂ : α → E} {l : filter α} (hf : ∀ x, f₁ x = f₂ x) : - is_O_with c f₁ g l → is_O_with c f₂ g l := -is_O_with.congr rfl hf (λ _, rfl) +theorem is_O_with.congr_left (h : is_O_with c l f₁ g) (hf : ∀ x, f₁ x = f₂ x) : + is_O_with c l f₂ g := +h.congr rfl hf (λ _, rfl) -theorem is_O_with.congr_right {g₁ g₂ : α → F} {l : filter α} (hg : ∀ x, g₁ x = g₂ x) : - is_O_with c f g₁ l → is_O_with c f g₂ l := -is_O_with.congr rfl (λ _, rfl) hg +theorem is_O_with.congr_right (h : is_O_with c l f g₁) (hg : ∀ x, g₁ x = g₂ x) : + is_O_with c l f g₂ := +h.congr rfl (λ _, rfl) hg -theorem is_O_with.congr_const {c₁ c₂} {l : filter α} (hc : c₁ = c₂) : - is_O_with c₁ f g l → is_O_with c₂ f g l := -is_O_with.congr hc (λ _, rfl) (λ _, rfl) +theorem is_O_with.congr_const (h : is_O_with c₁ l f g) (hc : c₁ = c₂) : is_O_with c₂ l f g := +h.congr hc (λ _, rfl) (λ _, rfl) -theorem is_O_congr {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : - is_O f₁ g₁ l ↔ is_O f₂ g₂ l := +theorem is_O_congr (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : f₁ =O[l] g₁ ↔ f₂ =O[l] g₂ := by { unfold is_O, exact exists_congr (λ c, is_O_with_congr rfl hf hg) } -theorem is_O.congr' {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : - is_O f₁ g₁ l → is_O f₂ g₂ l := -(is_O_congr hf hg).mp +theorem is_O.congr' (h : f₁ =O[l] g₁) (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : f₂ =O[l] g₂ := +(is_O_congr hf hg).mp h + +theorem is_O.congr (h : f₁ =O[l] g₁) (hf : ∀ x, f₁ x = f₂ x) (hg : ∀ x, g₁ x = g₂ x) : + f₂ =O[l] g₂ := +h.congr' (univ_mem' hf) (univ_mem' hg) + +theorem is_O.congr_left (h : f₁ =O[l] g) (hf : ∀ x, f₁ x = f₂ x) : f₂ =O[l] g := +h.congr hf (λ _, rfl) + +theorem is_O.congr_right (h : f =O[l] g₁) (hg : ∀ x, g₁ x = g₂ x) : f =O[l] g₂ := +h.congr (λ _, rfl) hg + +theorem is_o_congr (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : f₁ =o[l] g₁ ↔ f₂ =o[l] g₂ := +by { unfold is_o, exact forall₂_congr (λ c hc, is_O_with_congr (eq.refl c) hf hg) } -theorem is_O.congr {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hf : ∀ x, f₁ x = f₂ x) (hg : ∀ x, g₁ x = g₂ x) : - is_O f₁ g₁ l → is_O f₂ g₂ l := -λ h, h.congr' (univ_mem' hf) (univ_mem' hg) +theorem is_o.congr' (h : f₁ =o[l] g₁) (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : f₂ =o[l] g₂ := +(is_o_congr hf hg).mp h -theorem is_O.congr_left {f₁ f₂ : α → E} {l : filter α} (hf : ∀ x, f₁ x = f₂ x) : - is_O f₁ g l → is_O f₂ g l := -is_O.congr hf (λ _, rfl) +theorem is_o.congr (h : f₁ =o[l] g₁) (hf : ∀ x, f₁ x = f₂ x) (hg : ∀ x, g₁ x = g₂ x) : + f₂ =o[l] g₂ := +h.congr' (univ_mem' hf) (univ_mem' hg) -theorem is_O.congr_right {g₁ g₂ : α → E} {l : filter α} (hg : ∀ x, g₁ x = g₂ x) : - is_O f g₁ l → is_O f g₂ l := -is_O.congr (λ _, rfl) hg +theorem is_o.congr_left (h : f₁ =o[l] g) (hf : ∀ x, f₁ x = f₂ x) : f₂ =o[l] g := +h.congr hf (λ _, rfl) -theorem is_o_congr {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : - is_o f₁ g₁ l ↔ is_o f₂ g₂ l := -by { unfold is_o, exact ball_congr (λ c hc, is_O_with_congr (eq.refl c) hf hg) } +theorem is_o.congr_right (h : f =o[l] g₁) (hg : ∀ x, g₁ x = g₂ x) : f =o[l] g₂ := +h.congr (λ _, rfl) hg -theorem is_o.congr' {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hf : f₁ =ᶠ[l] f₂) (hg : g₁ =ᶠ[l] g₂) : - is_o f₁ g₁ l → is_o f₂ g₂ l := -(is_o_congr hf hg).mp +@[trans] theorem _root_.filter.eventually_eq.trans_is_O {f₁ f₂ : α → E} {g : α → F} + (hf : f₁ =ᶠ[l] f₂) (h : f₂ =O[l] g) : f₁ =O[l] g := +h.congr' hf.symm eventually_eq.rfl -theorem is_o.congr {f₁ f₂ : α → E} {g₁ g₂ : α → F} {l : filter α} - (hf : ∀ x, f₁ x = f₂ x) (hg : ∀ x, g₁ x = g₂ x) : - is_o f₁ g₁ l → is_o f₂ g₂ l := -λ h, h.congr' (univ_mem' hf) (univ_mem' hg) +@[trans] theorem _root_.filter.eventually_eq.trans_is_o {f₁ f₂ : α → E} {g : α → F} + (hf : f₁ =ᶠ[l] f₂) (h : f₂ =o[l] g) : f₁ =o[l] g := +h.congr' hf.symm eventually_eq.rfl -theorem is_o.congr_left {f₁ f₂ : α → E} {l : filter α} (hf : ∀ x, f₁ x = f₂ x) : - is_o f₁ g l → is_o f₂ g l := -is_o.congr hf (λ _, rfl) +@[trans] theorem is_O.trans_eventually_eq {f : α → E} {g₁ g₂ : α → F} + (h : f =O[l] g₁) (hg : g₁ =ᶠ[l] g₂) : f =O[l] g₂ := +h.congr' eventually_eq.rfl hg -theorem is_o.congr_right {g₁ g₂ : α → E} {l : filter α} (hg : ∀ x, g₁ x = g₂ x) : - is_o f g₁ l → is_o f g₂ l := -is_o.congr (λ _, rfl) hg +@[trans] theorem is_o.trans_eventually_eq {f : α → E} {g₁ g₂ : α → F} + (h : f =o[l] g₁) (hg : g₁ =ᶠ[l] g₂) : f =o[l] g₂ := +h.congr' eventually_eq.rfl hg + +end congr /-! ### Filter operations and transitivity -/ -theorem is_O_with.comp_tendsto (hcfg : is_O_with c f g l) +theorem is_O_with.comp_tendsto (hcfg : is_O_with c l f g) {k : β → α} {l' : filter β} (hk : tendsto k l' l): - is_O_with c (f ∘ k) (g ∘ k) l' := + is_O_with c l' (f ∘ k) (g ∘ k) := is_O_with.of_bound $ hk hcfg.bound -theorem is_O.comp_tendsto (hfg : is_O f g l) {k : β → α} {l' : filter β} (hk : tendsto k l' l) : - is_O (f ∘ k) (g ∘ k) l' := +theorem is_O.comp_tendsto (hfg : f =O[l] g) {k : β → α} {l' : filter β} (hk : tendsto k l' l) : + (f ∘ k) =O[l'] (g ∘ k) := is_O_iff_is_O_with.2 $ hfg.is_O_with.imp (λ c h, h.comp_tendsto hk) -theorem is_o.comp_tendsto (hfg : is_o f g l) {k : β → α} {l' : filter β} (hk : tendsto k l' l) : - is_o (f ∘ k) (g ∘ k) l' := +theorem is_o.comp_tendsto (hfg : f =o[l] g) {k : β → α} {l' : filter β} (hk : tendsto k l' l) : + (f ∘ k) =o[l'] (g ∘ k) := is_o.of_is_O_with $ λ c cpos, (hfg.forall_is_O_with cpos).comp_tendsto hk @[simp] theorem is_O_with_map {k : β → α} {l : filter β} : - is_O_with c f g (map k l) ↔ is_O_with c (f ∘ k) (g ∘ k) l := -by { unfold is_O_with, exact mem_map } + is_O_with c (map k l) f g ↔ is_O_with c l (f ∘ k) (g ∘ k) := +by { unfold is_O_with, exact eventually_map } -@[simp] theorem is_O_map {k : β → α} {l : filter β} : - is_O f g (map k l) ↔ is_O (f ∘ k) (g ∘ k) l := +@[simp] theorem is_O_map {k : β → α} {l : filter β} : f =O[map k l] g ↔ (f ∘ k) =O[l] (g ∘ k) := by simp only [is_O, is_O_with_map] -@[simp] theorem is_o_map {k : β → α} {l : filter β} : - is_o f g (map k l) ↔ is_o (f ∘ k) (g ∘ k) l := +@[simp] theorem is_o_map {k : β → α} {l : filter β} : f =o[map k l] g ↔ (f ∘ k) =o[l] (g ∘ k) := by simp only [is_o, is_O_with_map] -theorem is_O_with.mono (h : is_O_with c f g l') (hl : l ≤ l') : is_O_with c f g l := +theorem is_O_with.mono (h : is_O_with c l' f g) (hl : l ≤ l') : is_O_with c l f g := is_O_with.of_bound $ hl h.bound -theorem is_O.mono (h : is_O f g l') (hl : l ≤ l') : is_O f g l := +theorem is_O.mono (h : f =O[l'] g) (hl : l ≤ l') : f =O[l] g := is_O_iff_is_O_with.2 $ h.is_O_with.imp (λ c h, h.mono hl) -theorem is_o.mono (h : is_o f g l') (hl : l ≤ l') : is_o f g l := +theorem is_o.mono (h : f =o[l'] g) (hl : l ≤ l') : f =o[l] g := is_o.of_is_O_with $ λ c cpos, (h.forall_is_O_with cpos).mono hl -theorem is_O_with.trans (hfg : is_O_with c f g l) (hgk : is_O_with c' g k l) (hc : 0 ≤ c) : - is_O_with (c * c') f k l := +theorem is_O_with.trans (hfg : is_O_with c l f g) (hgk : is_O_with c' l g k) (hc : 0 ≤ c) : + is_O_with (c * c') l f k := begin unfold is_O_with at *, filter_upwards [hfg, hgk] with x hx hx', - calc ∥f x∥ ≤ c * ∥g x∥ : hx - ... ≤ c * (c' * ∥k x∥) : mul_le_mul_of_nonneg_left hx' hc - ... = c * c' * ∥k x∥ : (mul_assoc _ _ _).symm + calc ‖f x‖ ≤ c * ‖g x‖ : hx + ... ≤ c * (c' * ‖k x‖) : mul_le_mul_of_nonneg_left hx' hc + ... = c * c' * ‖k x‖ : (mul_assoc _ _ _).symm end -theorem is_O.trans (hfg : is_O f g' l) (hgk : is_O g' k l) : is_O f k l := +@[trans] theorem is_O.trans {f : α → E} {g : α → F'} {k : α → G} (hfg : f =O[l] g) + (hgk : g =O[l] k) : f =O[l] k := let ⟨c, cnonneg, hc⟩ := hfg.exists_nonneg, ⟨c', hc'⟩ := hgk.is_O_with in (hc.trans hc' cnonneg).is_O -theorem is_o.trans_is_O_with (hfg : is_o f g l) (hgk : is_O_with c g k l) (hc : 0 < c) : - is_o f k l := +theorem is_o.trans_is_O_with (hfg : f =o[l] g) (hgk : is_O_with c l g k) (hc : 0 < c) : + f =o[l] k := begin unfold is_o at *, intros c' c'pos, have : 0 < c' / c, from div_pos c'pos hc, - exact ((hfg this).trans hgk (le_of_lt this)).congr_const (div_mul_cancel _ (ne_of_gt hc)) + exact ((hfg this).trans hgk this.le).congr_const (div_mul_cancel _ hc.ne') end -theorem is_o.trans_is_O (hfg : is_o f g l) (hgk : is_O g k' l) : is_o f k' l := +@[trans] theorem is_o.trans_is_O {f : α → E} {g : α → F} {k : α → G'} (hfg : f =o[l] g) + (hgk : g =O[l] k) : + f =o[l] k := let ⟨c, cpos, hc⟩ := hgk.exists_pos in hfg.trans_is_O_with hc cpos -theorem is_O_with.trans_is_o (hfg : is_O_with c f g l) (hgk : is_o g k l) (hc : 0 < c) : - is_o f k l := +theorem is_O_with.trans_is_o (hfg : is_O_with c l f g) (hgk : g =o[l] k) (hc : 0 < c) : + f =o[l] k := begin unfold is_o at *, intros c' c'pos, have : 0 < c' / c, from div_pos c'pos hc, - exact (hfg.trans (hgk this) (le_of_lt hc)).congr_const (mul_div_cancel' _ (ne_of_gt hc)) + exact (hfg.trans (hgk this) hc.le).congr_const (mul_div_cancel' _ hc.ne') end -theorem is_O.trans_is_o (hfg : is_O f g' l) (hgk : is_o g' k l) : is_o f k l := +@[trans] theorem is_O.trans_is_o {f : α → E} {g : α → F'} {k : α → G} (hfg : f =O[l] g) + (hgk : g =o[l] k) : + f =o[l] k := let ⟨c, cpos, hc⟩ := hfg.exists_pos in hc.trans_is_o hgk cpos -theorem is_o.trans (hfg : is_o f g l) (hgk : is_o g k' l) : is_o f k' l := -hfg.trans_is_O hgk.is_O +@[trans] theorem is_o.trans {f : α → E} {g : α → F} {k : α → G} (hfg : f =o[l] g) + (hgk : g =o[l] k) : f =o[l] k := +hfg.trans_is_O_with hgk.is_O_with one_pos + +lemma _root_.filter.eventually.trans_is_O {f : α → E} {g : α → F'} {k : α → G} + (hfg : ∀ᶠ x in l, ‖f x‖ ≤ ‖g x‖) (hgk : g =O[l] k) : f =O[l] k := +(is_O.of_bound' hfg).trans hgk -theorem is_o.trans' (hfg : is_o f g' l) (hgk : is_o g' k l) : is_o f k l := -hfg.is_O.trans_is_o hgk +lemma _root_.filter.eventually.is_O {f : α → E} {g : α → ℝ} {l : filter α} + (hfg : ∀ᶠ x in l, ‖f x‖ ≤ g x) : f =O[l] g := +is_O.of_bound' $ hfg.mono $ λ x hx, hx.trans $ real.le_norm_self _ section variable (l) -theorem is_O_with_of_le' (hfg : ∀ x, ∥f x∥ ≤ c * ∥g x∥) : is_O_with c f g l := +theorem is_O_with_of_le' (hfg : ∀ x, ‖f x‖ ≤ c * ‖g x‖) : is_O_with c l f g := is_O_with.of_bound $ univ_mem' hfg -theorem is_O_with_of_le (hfg : ∀ x, ∥f x∥ ≤ ∥g x∥) : is_O_with 1 f g l := +theorem is_O_with_of_le (hfg : ∀ x, ‖f x‖ ≤ ‖g x‖) : is_O_with 1 l f g := is_O_with_of_le' l $ λ x, by { rw one_mul, exact hfg x } -theorem is_O_of_le' (hfg : ∀ x, ∥f x∥ ≤ c * ∥g x∥) : is_O f g l := +theorem is_O_of_le' (hfg : ∀ x, ‖f x‖ ≤ c * ‖g x‖) : f =O[l] g := (is_O_with_of_le' l hfg).is_O -theorem is_O_of_le (hfg : ∀ x, ∥f x∥ ≤ ∥g x∥) : is_O f g l := +theorem is_O_of_le (hfg : ∀ x, ‖f x‖ ≤ ‖g x‖) : f =O[l] g := (is_O_with_of_le l hfg).is_O end -theorem is_O_with_refl (f : α → E) (l : filter α) : is_O_with 1 f f l := +theorem is_O_with_refl (f : α → E) (l : filter α) : is_O_with 1 l f f := is_O_with_of_le l $ λ _, le_rfl -theorem is_O_refl (f : α → E) (l : filter α) : is_O f f l := (is_O_with_refl f l).is_O +theorem is_O_refl (f : α → E) (l : filter α) : f =O[l] f := (is_O_with_refl f l).is_O -theorem is_O_with.trans_le (hfg : is_O_with c f g l) (hgk : ∀ x, ∥g x∥ ≤ ∥k x∥) (hc : 0 ≤ c) : - is_O_with c f k l := +theorem is_O_with.trans_le (hfg : is_O_with c l f g) (hgk : ∀ x, ‖g x‖ ≤ ‖k x‖) (hc : 0 ≤ c) : + is_O_with c l f k := (hfg.trans (is_O_with_of_le l hgk) hc).congr_const $ mul_one c -theorem is_O.trans_le (hfg : is_O f g' l) (hgk : ∀ x, ∥g' x∥ ≤ ∥k x∥) : - is_O f k l := +theorem is_O.trans_le (hfg : f =O[l] g') (hgk : ∀ x, ‖g' x‖ ≤ ‖k x‖) : f =O[l] k := hfg.trans (is_O_of_le l hgk) -theorem is_o.trans_le (hfg : is_o f g l) (hgk : ∀ x, ∥g x∥ ≤ ∥k x∥) : - is_o f k l := +theorem is_o.trans_le (hfg : f =o[l] g) (hgk : ∀ x, ‖g x‖ ≤ ‖k x‖) : f =o[l] k := hfg.trans_is_O_with (is_O_with_of_le _ hgk) zero_lt_one +theorem is_o_irrefl' (h : ∃ᶠ x in l, ‖f' x‖ ≠ 0) : ¬f' =o[l] f' := +begin + intro ho, + rcases ((ho.bound one_half_pos).and_frequently h).exists with ⟨x, hle, hne⟩, + rw [one_div, ← div_eq_inv_mul] at hle, + exact (half_lt_self (lt_of_le_of_ne (norm_nonneg _) hne.symm)).not_le hle +end + +theorem is_o_irrefl (h : ∃ᶠ x in l, f'' x ≠ 0) : ¬f'' =o[l] f'' := +is_o_irrefl' $ h.mono $ λ x, norm_ne_zero_iff.mpr + +theorem is_O.not_is_o (h : f'' =O[l] g') (hf : ∃ᶠ x in l, f'' x ≠ 0) : ¬g' =o[l] f'' := +λ h', is_o_irrefl hf (h.trans_is_o h') + +theorem is_o.not_is_O (h : f'' =o[l] g') (hf : ∃ᶠ x in l, f'' x ≠ 0) : ¬g' =O[l] f'' := +λ h', is_o_irrefl hf (h.trans_is_O h') + section bot variables (c f g) -@[simp] theorem is_O_with_bot : is_O_with c f g ⊥ := is_O_with.of_bound $ trivial +@[simp] theorem is_O_with_bot : is_O_with c ⊥ f g := is_O_with.of_bound $ trivial -@[simp] theorem is_O_bot : is_O f g ⊥ := (is_O_with_bot 1 f g).is_O +@[simp] theorem is_O_bot : f =O[⊥] g := (is_O_with_bot 1 f g).is_O -@[simp] theorem is_o_bot : is_o f g ⊥ := is_o.of_is_O_with $ λ c _, is_O_with_bot c f g +@[simp] theorem is_o_bot : f =o[⊥] g := is_o.of_is_O_with $ λ c _, is_O_with_bot c f g end bot -@[simp] theorem is_O_with_pure {x} : is_O_with c f g (pure x) ↔ ∥f x∥ ≤ c * ∥g x∥ := is_O_with_iff +@[simp] theorem is_O_with_pure {x} : is_O_with c (pure x) f g ↔ ‖f x‖ ≤ c * ‖g x‖ := is_O_with_iff -theorem is_O_with.join (h : is_O_with c f g l) (h' : is_O_with c f g l') : - is_O_with c f g (l ⊔ l') := +theorem is_O_with.sup (h : is_O_with c l f g) (h' : is_O_with c l' f g) : + is_O_with c (l ⊔ l') f g := is_O_with.of_bound $ mem_sup.2 ⟨h.bound, h'.bound⟩ -theorem is_O_with.join' (h : is_O_with c f g' l) (h' : is_O_with c' f g' l') : - is_O_with (max c c') f g' (l ⊔ l') := +theorem is_O_with.sup' (h : is_O_with c l f g') (h' : is_O_with c' l' f g') : + is_O_with (max c c') (l ⊔ l') f g' := is_O_with.of_bound $ mem_sup.2 ⟨(h.weaken $ le_max_left c c').bound, (h'.weaken $ le_max_right c c').bound⟩ -theorem is_O.join (h : is_O f g' l) (h' : is_O f g' l') : is_O f g' (l ⊔ l') := -let ⟨c, hc⟩ := h.is_O_with, ⟨c', hc'⟩ := h'.is_O_with in (hc.join' hc').is_O +theorem is_O.sup (h : f =O[l] g') (h' : f =O[l'] g') : f =O[l ⊔ l'] g' := +let ⟨c, hc⟩ := h.is_O_with, ⟨c', hc'⟩ := h'.is_O_with in (hc.sup' hc').is_O + +theorem is_o.sup (h : f =o[l] g) (h' : f =o[l'] g) : f =o[l ⊔ l'] g := +is_o.of_is_O_with $ λ c cpos, (h.forall_is_O_with cpos).sup (h'.forall_is_O_with cpos) + +@[simp] lemma is_O_sup : f =O[l ⊔ l'] g' ↔ f =O[l] g' ∧ f =O[l'] g' := +⟨λ h, ⟨h.mono le_sup_left, h.mono le_sup_right⟩, λ h, h.1.sup h.2⟩ + +@[simp] lemma is_o_sup : f =o[l ⊔ l'] g ↔ f =o[l] g ∧ f =o[l'] g := +⟨λ h, ⟨h.mono le_sup_left, h.mono le_sup_right⟩, λ h, h.1.sup h.2⟩ + +lemma is_O_with_insert [topological_space α] {x : α} {s : set α} {C : ℝ} {g : α → E} {g' : α → F} + (h : ‖g x‖ ≤ C * ‖g' x‖) : + is_O_with C (𝓝[insert x s] x) g g' ↔ is_O_with C (𝓝[s] x) g g' := +by simp_rw [is_O_with, nhds_within_insert, eventually_sup, eventually_pure, h, true_and] + +lemma is_O_with.insert [topological_space α] {x : α} {s : set α} {C : ℝ} {g : α → E} {g' : α → F} + (h1 : is_O_with C (𝓝[s] x) g g') (h2 : ‖g x‖ ≤ C * ‖g' x‖) : + is_O_with C (𝓝[insert x s] x) g g' := +(is_O_with_insert h2).mpr h1 + +lemma is_o_insert [topological_space α] {x : α} {s : set α} {g : α → E'} {g' : α → F'} + (h : g x = 0) : g =o[𝓝[insert x s] x] g' ↔ g =o[𝓝[s] x] g' := +begin + simp_rw [is_o], + refine forall_congr (λ c, forall_congr (λ hc, _)), + rw [is_O_with_insert], + rw [h, norm_zero], + exact mul_nonneg hc.le (norm_nonneg _) +end + +lemma is_o.insert [topological_space α] {x : α} {s : set α} {g : α → E'} {g' : α → F'} + (h1 : g =o[𝓝[s] x] g') (h2 : g x = 0) : g =o[𝓝[insert x s] x] g' := +(is_o_insert h2).mpr h1 + +/-! ### Simplification : norm, abs -/ -theorem is_o.join (h : is_o f g l) (h' : is_o f g l') : - is_o f g (l ⊔ l') := -is_o.of_is_O_with $ -λ c cpos, (h.forall_is_O_with cpos).join (h'.forall_is_O_with cpos) +section norm_abs -/-! ### Simplification : norm -/ +variables {u v : α → ℝ} -@[simp] theorem is_O_with_norm_right : is_O_with c f (λ x, ∥g' x∥) l ↔ is_O_with c f g' l := +@[simp] theorem is_O_with_norm_right : is_O_with c l f (λ x, ‖g' x‖) ↔ is_O_with c l f g' := by simp only [is_O_with, norm_norm] -alias is_O_with_norm_right ↔ asymptotics.is_O_with.of_norm_right asymptotics.is_O_with.norm_right +@[simp] theorem is_O_with_abs_right : is_O_with c l f (λ x, |u x|) ↔ is_O_with c l f u := +@is_O_with_norm_right _ _ _ _ _ _ f u l -@[simp] theorem is_O_norm_right : is_O f (λ x, ∥g' x∥) l ↔ is_O f g' l := +alias is_O_with_norm_right ↔ is_O_with.of_norm_right is_O_with.norm_right +alias is_O_with_abs_right ↔ is_O_with.of_abs_right is_O_with.abs_right + +@[simp] theorem is_O_norm_right : f =O[l] (λ x, ‖g' x‖) ↔ f =O[l] g' := by { unfold is_O, exact exists_congr (λ _, is_O_with_norm_right) } -alias is_O_norm_right ↔ asymptotics.is_O.of_norm_right asymptotics.is_O.norm_right +@[simp] theorem is_O_abs_right : f =O[l] (λ x, |u x|) ↔ f =O[l] u := +@is_O_norm_right _ _ ℝ _ _ _ _ _ + +alias is_O_norm_right ↔ is_O.of_norm_right is_O.norm_right +alias is_O_abs_right ↔ is_O.of_abs_right is_O.abs_right -@[simp] theorem is_o_norm_right : is_o f (λ x, ∥g' x∥) l ↔ is_o f g' l := +@[simp] theorem is_o_norm_right : f =o[l] (λ x, ‖g' x‖) ↔ f =o[l] g' := by { unfold is_o, exact forall₂_congr (λ _ _, is_O_with_norm_right) } -alias is_o_norm_right ↔ asymptotics.is_o.of_norm_right asymptotics.is_o.norm_right +@[simp] theorem is_o_abs_right : f =o[l] (λ x, |u x|) ↔ f =o[l] u := +@is_o_norm_right _ _ ℝ _ _ _ _ _ + +alias is_o_norm_right ↔ is_o.of_norm_right is_o.norm_right +alias is_o_abs_right ↔ is_o.of_abs_right is_o.abs_right -@[simp] theorem is_O_with_norm_left : is_O_with c (λ x, ∥f' x∥) g l ↔ is_O_with c f' g l := +@[simp] theorem is_O_with_norm_left : is_O_with c l (λ x, ‖f' x‖) g ↔ is_O_with c l f' g := by simp only [is_O_with, norm_norm] -alias is_O_with_norm_left ↔ asymptotics.is_O_with.of_norm_left asymptotics.is_O_with.norm_left +@[simp] theorem is_O_with_abs_left : is_O_with c l (λ x, |u x|) g ↔ is_O_with c l u g := +@is_O_with_norm_left _ _ _ _ _ _ g u l -@[simp] theorem is_O_norm_left : is_O (λ x, ∥f' x∥) g l ↔ is_O f' g l := +alias is_O_with_norm_left ↔ is_O_with.of_norm_left is_O_with.norm_left +alias is_O_with_abs_left ↔ is_O_with.of_abs_left is_O_with.abs_left + +@[simp] theorem is_O_norm_left : (λ x, ‖f' x‖) =O[l] g ↔ f' =O[l] g := by { unfold is_O, exact exists_congr (λ _, is_O_with_norm_left) } -alias is_O_norm_left ↔ asymptotics.is_O.of_norm_left asymptotics.is_O.norm_left +@[simp] theorem is_O_abs_left : (λ x, |u x|) =O[l] g ↔ u =O[l] g := +@is_O_norm_left _ _ _ _ _ g u l + +alias is_O_norm_left ↔ is_O.of_norm_left is_O.norm_left +alias is_O_abs_left ↔ is_O.of_abs_left is_O.abs_left -@[simp] theorem is_o_norm_left : is_o (λ x, ∥f' x∥) g l ↔ is_o f' g l := +@[simp] theorem is_o_norm_left : (λ x, ‖f' x‖) =o[l] g ↔ f' =o[l] g := by { unfold is_o, exact forall₂_congr (λ _ _, is_O_with_norm_left) } -alias is_o_norm_left ↔ asymptotics.is_o.of_norm_left asymptotics.is_o.norm_left +@[simp] theorem is_o_abs_left : (λ x, |u x|) =o[l] g ↔ u =o[l] g := +@is_o_norm_left _ _ _ _ _ g u l + +alias is_o_norm_left ↔ is_o.of_norm_left is_o.norm_left +alias is_o_abs_left ↔ is_o.of_abs_left is_o.abs_left -theorem is_O_with_norm_norm : - is_O_with c (λ x, ∥f' x∥) (λ x, ∥g' x∥) l ↔ is_O_with c f' g' l := +theorem is_O_with_norm_norm : is_O_with c l (λ x, ‖f' x‖) (λ x, ‖g' x‖) ↔ is_O_with c l f' g' := is_O_with_norm_left.trans is_O_with_norm_right -alias is_O_with_norm_norm ↔ asymptotics.is_O_with.of_norm_norm asymptotics.is_O_with.norm_norm +theorem is_O_with_abs_abs : is_O_with c l (λ x, |u x|) (λ x, |v x|) ↔ is_O_with c l u v := +is_O_with_abs_left.trans is_O_with_abs_right -theorem is_O_norm_norm : - is_O (λ x, ∥f' x∥) (λ x, ∥g' x∥) l ↔ is_O f' g' l := +alias is_O_with_norm_norm ↔ is_O_with.of_norm_norm is_O_with.norm_norm +alias is_O_with_abs_abs ↔ is_O_with.of_abs_abs is_O_with.abs_abs + +theorem is_O_norm_norm : (λ x, ‖f' x‖) =O[l] (λ x, ‖g' x‖) ↔ f' =O[l] g' := is_O_norm_left.trans is_O_norm_right -alias is_O_norm_norm ↔ asymptotics.is_O.of_norm_norm asymptotics.is_O.norm_norm +theorem is_O_abs_abs : (λ x, |u x|) =O[l] (λ x, |v x|) ↔ u =O[l] v := +is_O_abs_left.trans is_O_abs_right + +alias is_O_norm_norm ↔ is_O.of_norm_norm is_O.norm_norm +alias is_O_abs_abs ↔ is_O.of_abs_abs is_O.abs_abs -theorem is_o_norm_norm : - is_o (λ x, ∥f' x∥) (λ x, ∥g' x∥) l ↔ is_o f' g' l := +theorem is_o_norm_norm : (λ x, ‖f' x‖) =o[l] (λ x, ‖g' x‖) ↔ f' =o[l] g' := is_o_norm_left.trans is_o_norm_right -alias is_o_norm_norm ↔ asymptotics.is_o.of_norm_norm asymptotics.is_o.norm_norm +theorem is_o_abs_abs : (λ x, |u x|) =o[l] (λ x, |v x|) ↔ u =o[l] v := +is_o_abs_left.trans is_o_abs_right + +alias is_o_norm_norm ↔ is_o.of_norm_norm is_o.norm_norm +alias is_o_abs_abs ↔ is_o.of_abs_abs is_o.abs_abs + +end norm_abs /-! ### Simplification: negate -/ -@[simp] theorem is_O_with_neg_right : is_O_with c f (λ x, -(g' x)) l ↔ is_O_with c f g' l := +@[simp] theorem is_O_with_neg_right : is_O_with c l f (λ x, -(g' x)) ↔ is_O_with c l f g' := by simp only [is_O_with, norm_neg] -alias is_O_with_neg_right ↔ asymptotics.is_O_with.of_neg_right asymptotics.is_O_with.neg_right +alias is_O_with_neg_right ↔ is_O_with.of_neg_right is_O_with.neg_right -@[simp] theorem is_O_neg_right : is_O f (λ x, -(g' x)) l ↔ is_O f g' l := +@[simp] theorem is_O_neg_right : f =O[l] (λ x, -(g' x)) ↔ f =O[l] g' := by { unfold is_O, exact exists_congr (λ _, is_O_with_neg_right) } -alias is_O_neg_right ↔ asymptotics.is_O.of_neg_right asymptotics.is_O.neg_right +alias is_O_neg_right ↔ is_O.of_neg_right is_O.neg_right -@[simp] theorem is_o_neg_right : is_o f (λ x, -(g' x)) l ↔ is_o f g' l := +@[simp] theorem is_o_neg_right : f =o[l] (λ x, -(g' x)) ↔ f =o[l] g' := by { unfold is_o, exact forall₂_congr (λ _ _, is_O_with_neg_right) } -alias is_o_neg_right ↔ asymptotics.is_o.of_neg_right asymptotics.is_o.neg_right +alias is_o_neg_right ↔ is_o.of_neg_right is_o.neg_right -@[simp] theorem is_O_with_neg_left : is_O_with c (λ x, -(f' x)) g l ↔ is_O_with c f' g l := +@[simp] theorem is_O_with_neg_left : is_O_with c l (λ x, -(f' x)) g ↔ is_O_with c l f' g := by simp only [is_O_with, norm_neg] -alias is_O_with_neg_left ↔ asymptotics.is_O_with.of_neg_left asymptotics.is_O_with.neg_left +alias is_O_with_neg_left ↔ is_O_with.of_neg_left is_O_with.neg_left -@[simp] theorem is_O_neg_left : is_O (λ x, -(f' x)) g l ↔ is_O f' g l := +@[simp] theorem is_O_neg_left : (λ x, -(f' x)) =O[l] g ↔ f' =O[l] g := by { unfold is_O, exact exists_congr (λ _, is_O_with_neg_left) } -alias is_O_neg_left ↔ asymptotics.is_O.of_neg_left asymptotics.is_O.neg_left +alias is_O_neg_left ↔ is_O.of_neg_left is_O.neg_left -@[simp] theorem is_o_neg_left : is_o (λ x, -(f' x)) g l ↔ is_o f' g l := +@[simp] theorem is_o_neg_left : (λ x, -(f' x)) =o[l] g ↔ f' =o[l] g := by { unfold is_o, exact forall₂_congr (λ _ _, is_O_with_neg_left) } -alias is_o_neg_left ↔ asymptotics.is_o.of_neg_right asymptotics.is_o.neg_left +alias is_o_neg_left ↔ is_o.of_neg_right is_o.neg_left /-! ### Product of functions (right) -/ -lemma is_O_with_fst_prod : is_O_with 1 f' (λ x, (f' x, g' x)) l := +lemma is_O_with_fst_prod : is_O_with 1 l f' (λ x, (f' x, g' x)) := is_O_with_of_le l $ λ x, le_max_left _ _ -lemma is_O_with_snd_prod : is_O_with 1 g' (λ x, (f' x, g' x)) l := +lemma is_O_with_snd_prod : is_O_with 1 l g' (λ x, (f' x, g' x)) := is_O_with_of_le l $ λ x, le_max_right _ _ -lemma is_O_fst_prod : is_O f' (λ x, (f' x, g' x)) l := is_O_with_fst_prod.is_O +lemma is_O_fst_prod : f' =O[l] (λ x, (f' x, g' x)) := is_O_with_fst_prod.is_O -lemma is_O_snd_prod : is_O g' (λ x, (f' x, g' x)) l := is_O_with_snd_prod.is_O +lemma is_O_snd_prod : g' =O[l] (λ x, (f' x, g' x)) := is_O_with_snd_prod.is_O -lemma is_O_fst_prod' {f' : α → E' × F'} : is_O (λ x, (f' x).1) f' l := +lemma is_O_fst_prod' {f' : α → E' × F'} : (λ x, (f' x).1) =O[l] f' := by simpa [is_O, is_O_with] using is_O_fst_prod -lemma is_O_snd_prod' {f' : α → E' × F'} : is_O (λ x, (f' x).2) f' l := +lemma is_O_snd_prod' {f' : α → E' × F'} : (λ x, (f' x).2) =O[l] f' := by simpa [is_O, is_O_with] using is_O_snd_prod section variables (f' k') -lemma is_O_with.prod_rightl (h : is_O_with c f g' l) (hc : 0 ≤ c) : - is_O_with c f (λ x, (g' x, k' x)) l := +lemma is_O_with.prod_rightl (h : is_O_with c l f g') (hc : 0 ≤ c) : + is_O_with c l f (λ x, (g' x, k' x)) := (h.trans is_O_with_fst_prod hc).congr_const (mul_one c) -lemma is_O.prod_rightl (h : is_O f g' l) : is_O f (λx, (g' x, k' x)) l := +lemma is_O.prod_rightl (h : f =O[l] g') : f =O[l] (λ x, (g' x, k' x)) := let ⟨c, cnonneg, hc⟩ := h.exists_nonneg in (hc.prod_rightl k' cnonneg).is_O -lemma is_o.prod_rightl (h : is_o f g' l) : is_o f (λ x, (g' x, k' x)) l := -is_o.of_is_O_with $ -λ c cpos, (h.forall_is_O_with cpos).prod_rightl k' (le_of_lt cpos) +lemma is_o.prod_rightl (h : f =o[l] g') : f =o[l] (λ x, (g' x, k' x)) := +is_o.of_is_O_with $ λ c cpos, (h.forall_is_O_with cpos).prod_rightl k' cpos.le -lemma is_O_with.prod_rightr (h : is_O_with c f g' l) (hc : 0 ≤ c) : - is_O_with c f (λ x, (f' x, g' x)) l := +lemma is_O_with.prod_rightr (h : is_O_with c l f g') (hc : 0 ≤ c) : + is_O_with c l f (λ x, (f' x, g' x)) := (h.trans is_O_with_snd_prod hc).congr_const (mul_one c) -lemma is_O.prod_rightr (h : is_O f g' l) : is_O f (λx, (f' x, g' x)) l := +lemma is_O.prod_rightr (h : f =O[l] g') : f =O[l] (λ x, (f' x, g' x)) := let ⟨c, cnonneg, hc⟩ := h.exists_nonneg in (hc.prod_rightr f' cnonneg).is_O -lemma is_o.prod_rightr (h : is_o f g' l) : is_o f (λx, (f' x, g' x)) l := -is_o.of_is_O_with $ -λ c cpos, (h.forall_is_O_with cpos).prod_rightr f' (le_of_lt cpos) +lemma is_o.prod_rightr (h : f =o[l] g') : f =o[l] (λx, (f' x, g' x)) := +is_o.of_is_O_with $ λ c cpos, (h.forall_is_O_with cpos).prod_rightr f' cpos.le end -lemma is_O_with.prod_left_same (hf : is_O_with c f' k' l) (hg : is_O_with c g' k' l) : - is_O_with c (λ x, (f' x, g' x)) k' l := +lemma is_O_with.prod_left_same (hf : is_O_with c l f' k') (hg : is_O_with c l g' k') : + is_O_with c l (λ x, (f' x, g' x)) k' := by rw is_O_with_iff at *; filter_upwards [hf, hg] with x using max_le -lemma is_O_with.prod_left (hf : is_O_with c f' k' l) (hg : is_O_with c' g' k' l) : - is_O_with (max c c') (λ x, (f' x, g' x)) k' l := +lemma is_O_with.prod_left (hf : is_O_with c l f' k') (hg : is_O_with c' l g' k') : + is_O_with (max c c') l (λ x, (f' x, g' x)) k' := (hf.weaken $ le_max_left c c').prod_left_same (hg.weaken $ le_max_right c c') -lemma is_O_with.prod_left_fst (h : is_O_with c (λ x, (f' x, g' x)) k' l) : - is_O_with c f' k' l := +lemma is_O_with.prod_left_fst (h : is_O_with c l (λ x, (f' x, g' x)) k') : + is_O_with c l f' k' := (is_O_with_fst_prod.trans h zero_le_one).congr_const $ one_mul c -lemma is_O_with.prod_left_snd (h : is_O_with c (λ x, (f' x, g' x)) k' l) : - is_O_with c g' k' l := +lemma is_O_with.prod_left_snd (h : is_O_with c l (λ x, (f' x, g' x)) k') : + is_O_with c l g' k' := (is_O_with_snd_prod.trans h zero_le_one).congr_const $ one_mul c lemma is_O_with_prod_left : - is_O_with c (λ x, (f' x, g' x)) k' l ↔ is_O_with c f' k' l ∧ is_O_with c g' k' l := + is_O_with c l (λ x, (f' x, g' x)) k' ↔ is_O_with c l f' k' ∧ is_O_with c l g' k' := ⟨λ h, ⟨h.prod_left_fst, h.prod_left_snd⟩, λ h, h.1.prod_left_same h.2⟩ -lemma is_O.prod_left (hf : is_O f' k' l) (hg : is_O g' k' l) : is_O (λ x, (f' x, g' x)) k' l := +lemma is_O.prod_left (hf : f' =O[l] k') (hg : g' =O[l] k') : (λ x, (f' x, g' x)) =O[l] k' := let ⟨c, hf⟩ := hf.is_O_with, ⟨c', hg⟩ := hg.is_O_with in (hf.prod_left hg).is_O -lemma is_O.prod_left_fst (h : is_O (λ x, (f' x, g' x)) k' l) : is_O f' k' l := -is_O_fst_prod.trans h - -lemma is_O.prod_left_snd (h : is_O (λ x, (f' x, g' x)) k' l) : is_O g' k' l := -is_O_snd_prod.trans h +lemma is_O.prod_left_fst : (λ x, (f' x, g' x)) =O[l] k' → f' =O[l] k' := is_O.trans is_O_fst_prod +lemma is_O.prod_left_snd : (λ x, (f' x, g' x)) =O[l] k' → g' =O[l] k' := is_O.trans is_O_snd_prod -@[simp] lemma is_O_prod_left : - is_O (λ x, (f' x, g' x)) k' l ↔ is_O f' k' l ∧ is_O g' k' l := +@[simp] lemma is_O_prod_left : (λ x, (f' x, g' x)) =O[l] k' ↔ f' =O[l] k' ∧ g' =O[l] k' := ⟨λ h, ⟨h.prod_left_fst, h.prod_left_snd⟩, λ h, h.1.prod_left h.2⟩ -lemma is_o.prod_left (hf : is_o f' k' l) (hg : is_o g' k' l) : is_o (λ x, (f' x, g' x)) k' l := -is_o.of_is_O_with $ -λ c hc, (hf.forall_is_O_with hc).prod_left_same (hg.forall_is_O_with hc) +lemma is_o.prod_left (hf : f' =o[l] k') (hg : g' =o[l] k') : (λ x, (f' x, g' x)) =o[l] k' := +is_o.of_is_O_with $ λ c hc, (hf.forall_is_O_with hc).prod_left_same (hg.forall_is_O_with hc) -lemma is_o.prod_left_fst (h : is_o (λ x, (f' x, g' x)) k' l) : is_o f' k' l := -is_O_fst_prod.trans_is_o h +lemma is_o.prod_left_fst : (λ x, (f' x, g' x)) =o[l] k' → f' =o[l] k' := +is_O.trans_is_o is_O_fst_prod -lemma is_o.prod_left_snd (h : is_o (λ x, (f' x, g' x)) k' l) : is_o g' k' l := -is_O_snd_prod.trans_is_o h +lemma is_o.prod_left_snd : (λ x, (f' x, g' x)) =o[l] k' → g' =o[l] k' := +is_O.trans_is_o is_O_snd_prod -@[simp] lemma is_o_prod_left : - is_o (λ x, (f' x, g' x)) k' l ↔ is_o f' k' l ∧ is_o g' k' l := +@[simp] lemma is_o_prod_left : (λ x, (f' x, g' x)) =o[l] k' ↔ f' =o[l] k' ∧ g' =o[l] k' := ⟨λ h, ⟨h.prod_left_fst, h.prod_left_snd⟩, λ h, h.1.prod_left h.2⟩ -lemma is_O_with.eq_zero_imp (h : is_O_with c f'' g'' l) : ∀ᶠ x in l, g'' x = 0 → f'' x = 0 := +lemma is_O_with.eq_zero_imp (h : is_O_with c l f'' g'') : ∀ᶠ x in l, g'' x = 0 → f'' x = 0 := eventually.mono h.bound $ λ x hx hg, norm_le_zero_iff.1 $ by simpa [hg] using hx -lemma is_O.eq_zero_imp (h : is_O f'' g'' l) : ∀ᶠ x in l, g'' x = 0 → f'' x = 0 := +lemma is_O.eq_zero_imp (h : f'' =O[l] g'') : ∀ᶠ x in l, g'' x = 0 → f'' x = 0 := let ⟨C, hC⟩ := h.is_O_with in hC.eq_zero_imp /-! ### Addition and subtraction -/ section add_sub -variables {c₁ c₂ : ℝ} {f₁ f₂ : α → E'} +variables {f₁ f₂ : α → E'} {g₁ g₂ : α → F'} -theorem is_O_with.add (h₁ : is_O_with c₁ f₁ g l) (h₂ : is_O_with c₂ f₂ g l) : - is_O_with (c₁ + c₂) (λ x, f₁ x + f₂ x) g l := +theorem is_O_with.add (h₁ : is_O_with c₁ l f₁ g) (h₂ : is_O_with c₂ l f₂ g) : + is_O_with (c₁ + c₂) l (λ x, f₁ x + f₂ x) g := by rw is_O_with at *; filter_upwards [h₁, h₂] with x hx₁ hx₂ using -calc ∥f₁ x + f₂ x∥ ≤ c₁ * ∥g x∥ + c₂ * ∥g x∥ : norm_add_le_of_le hx₁ hx₂ - ... = (c₁ + c₂) * ∥g x∥ : (add_mul _ _ _).symm +calc ‖f₁ x + f₂ x‖ ≤ c₁ * ‖g x‖ + c₂ * ‖g x‖ : norm_add_le_of_le hx₁ hx₂ + ... = (c₁ + c₂) * ‖g x‖ : (add_mul _ _ _).symm -theorem is_O.add (h₁ : is_O f₁ g l) (h₂ : is_O f₂ g l) : is_O (λ x, f₁ x + f₂ x) g l := +theorem is_O.add (h₁ : f₁ =O[l] g) (h₂ : f₂ =O[l] g) : (λ x, f₁ x + f₂ x) =O[l] g := let ⟨c₁, hc₁⟩ := h₁.is_O_with, ⟨c₂, hc₂⟩ := h₂.is_O_with in (hc₁.add hc₂).is_O -theorem is_o.add (h₁ : is_o f₁ g l) (h₂ : is_o f₂ g l) : is_o (λ x, f₁ x + f₂ x) g l := +theorem is_o.add (h₁ : f₁ =o[l] g) (h₂ : f₂ =o[l] g) : (λ x, f₁ x + f₂ x) =o[l] g := is_o.of_is_O_with $ λ c cpos, ((h₁.forall_is_O_with $ half_pos cpos).add (h₂.forall_is_O_with $ half_pos cpos)).congr_const (add_halves c) -theorem is_o.add_add {g₁ g₂ : α → F'} (h₁ : is_o f₁ g₁ l) (h₂ : is_o f₂ g₂ l) : - is_o (λ x, f₁ x + f₂ x) (λ x, ∥g₁ x∥ + ∥g₂ x∥) l := +theorem is_o.add_add (h₁ : f₁ =o[l] g₁) (h₂ : f₂ =o[l] g₂) : + (λ x, f₁ x + f₂ x) =o[l] (λ x, ‖g₁ x‖ + ‖g₂ x‖) := by refine (h₁.trans_le $ λ x, _).add (h₂.trans_le _); - simp [real.norm_eq_abs, abs_of_nonneg, add_nonneg] + simp [abs_of_nonneg, add_nonneg] -theorem is_O.add_is_o (h₁ : is_O f₁ g l) (h₂ : is_o f₂ g l) : is_O (λ x, f₁ x + f₂ x) g l := +theorem is_O.add_is_o (h₁ : f₁ =O[l] g) (h₂ : f₂ =o[l] g) : (λ x, f₁ x + f₂ x) =O[l] g := h₁.add h₂.is_O -theorem is_o.add_is_O (h₁ : is_o f₁ g l) (h₂ : is_O f₂ g l) : is_O (λ x, f₁ x + f₂ x) g l := +theorem is_o.add_is_O (h₁ : f₁ =o[l] g) (h₂ : f₂ =O[l] g) : (λ x, f₁ x + f₂ x) =O[l] g := h₁.is_O.add h₂ -theorem is_O_with.add_is_o (h₁ : is_O_with c₁ f₁ g l) (h₂ : is_o f₂ g l) (hc : c₁ < c₂) : - is_O_with c₂ (λx, f₁ x + f₂ x) g l := +theorem is_O_with.add_is_o (h₁ : is_O_with c₁ l f₁ g) (h₂ : f₂ =o[l] g) (hc : c₁ < c₂) : + is_O_with c₂ l (λx, f₁ x + f₂ x) g := (h₁.add (h₂.forall_is_O_with (sub_pos.2 hc))).congr_const (add_sub_cancel'_right _ _) -theorem is_o.add_is_O_with (h₁ : is_o f₁ g l) (h₂ : is_O_with c₁ f₂ g l) (hc : c₁ < c₂) : - is_O_with c₂ (λx, f₁ x + f₂ x) g l := +theorem is_o.add_is_O_with (h₁ : f₁ =o[l] g) (h₂ : is_O_with c₁ l f₂ g) (hc : c₁ < c₂) : + is_O_with c₂ l (λx, f₁ x + f₂ x) g := (h₂.add_is_o h₁ hc).congr_left $ λ _, add_comm _ _ -theorem is_O_with.sub (h₁ : is_O_with c₁ f₁ g l) (h₂ : is_O_with c₂ f₂ g l) : - is_O_with (c₁ + c₂) (λ x, f₁ x - f₂ x) g l := +theorem is_O_with.sub (h₁ : is_O_with c₁ l f₁ g) (h₂ : is_O_with c₂ l f₂ g) : + is_O_with (c₁ + c₂) l (λ x, f₁ x - f₂ x) g := by simpa only [sub_eq_add_neg] using h₁.add h₂.neg_left -theorem is_O_with.sub_is_o (h₁ : is_O_with c₁ f₁ g l) (h₂ : is_o f₂ g l) (hc : c₁ < c₂) : - is_O_with c₂ (λ x, f₁ x - f₂ x) g l := +theorem is_O_with.sub_is_o (h₁ : is_O_with c₁ l f₁ g) (h₂ : f₂ =o[l] g) (hc : c₁ < c₂) : + is_O_with c₂ l (λ x, f₁ x - f₂ x) g := by simpa only [sub_eq_add_neg] using h₁.add_is_o h₂.neg_left hc -theorem is_O.sub (h₁ : is_O f₁ g l) (h₂ : is_O f₂ g l) : is_O (λ x, f₁ x - f₂ x) g l := +theorem is_O.sub (h₁ : f₁ =O[l] g) (h₂ : f₂ =O[l] g) : (λ x, f₁ x - f₂ x) =O[l] g := by simpa only [sub_eq_add_neg] using h₁.add h₂.neg_left -theorem is_o.sub (h₁ : is_o f₁ g l) (h₂ : is_o f₂ g l) : is_o (λ x, f₁ x - f₂ x) g l := +theorem is_o.sub (h₁ : f₁ =o[l] g) (h₂ : f₂ =o[l] g) : (λ x, f₁ x - f₂ x) =o[l] g := by simpa only [sub_eq_add_neg] using h₁.add h₂.neg_left end add_sub @@ -659,46 +778,44 @@ section is_oO_as_rel variables {f₁ f₂ f₃ : α → E'} -theorem is_O_with.symm (h : is_O_with c (λ x, f₁ x - f₂ x) g l) : - is_O_with c (λ x, f₂ x - f₁ x) g l := +theorem is_O_with.symm (h : is_O_with c l (λ x, f₁ x - f₂ x) g) : + is_O_with c l (λ x, f₂ x - f₁ x) g := h.neg_left.congr_left $ λ x, neg_sub _ _ theorem is_O_with_comm : - is_O_with c (λ x, f₁ x - f₂ x) g l ↔ is_O_with c (λ x, f₂ x - f₁ x) g l := + is_O_with c l (λ x, f₁ x - f₂ x) g ↔ is_O_with c l (λ x, f₂ x - f₁ x) g := ⟨is_O_with.symm, is_O_with.symm⟩ -theorem is_O.symm (h : is_O (λ x, f₁ x - f₂ x) g l) : is_O (λ x, f₂ x - f₁ x) g l := +theorem is_O.symm (h : (λ x, f₁ x - f₂ x) =O[l] g) : (λ x, f₂ x - f₁ x) =O[l] g := h.neg_left.congr_left $ λ x, neg_sub _ _ -theorem is_O_comm : is_O (λ x, f₁ x - f₂ x) g l ↔ is_O (λ x, f₂ x - f₁ x) g l := +theorem is_O_comm : (λ x, f₁ x - f₂ x) =O[l] g ↔ (λ x, f₂ x - f₁ x) =O[l] g := ⟨is_O.symm, is_O.symm⟩ -theorem is_o.symm (h : is_o (λ x, f₁ x - f₂ x) g l) : is_o (λ x, f₂ x - f₁ x) g l := +theorem is_o.symm (h : (λ x, f₁ x - f₂ x) =o[l] g) : (λ x, f₂ x - f₁ x) =o[l] g := by simpa only [neg_sub] using h.neg_left -theorem is_o_comm : is_o (λ x, f₁ x - f₂ x) g l ↔ is_o (λ x, f₂ x - f₁ x) g l := +theorem is_o_comm : (λ x, f₁ x - f₂ x) =o[l] g ↔ (λ x, f₂ x - f₁ x) =o[l] g := ⟨is_o.symm, is_o.symm⟩ -theorem is_O_with.triangle (h₁ : is_O_with c (λ x, f₁ x - f₂ x) g l) - (h₂ : is_O_with c' (λ x, f₂ x - f₃ x) g l) : - is_O_with (c + c') (λ x, f₁ x - f₃ x) g l := +theorem is_O_with.triangle (h₁ : is_O_with c l (λ x, f₁ x - f₂ x) g) + (h₂ : is_O_with c' l (λ x, f₂ x - f₃ x) g) : + is_O_with (c + c') l (λ x, f₁ x - f₃ x) g := (h₁.add h₂).congr_left $ λ x, sub_add_sub_cancel _ _ _ -theorem is_O.triangle (h₁ : is_O (λ x, f₁ x - f₂ x) g l) (h₂ : is_O (λ x, f₂ x - f₃ x) g l) : - is_O (λ x, f₁ x - f₃ x) g l := +theorem is_O.triangle (h₁ : (λ x, f₁ x - f₂ x) =O[l] g) (h₂ : (λ x, f₂ x - f₃ x) =O[l] g) : + (λ x, f₁ x - f₃ x) =O[l] g := (h₁.add h₂).congr_left $ λ x, sub_add_sub_cancel _ _ _ -theorem is_o.triangle (h₁ : is_o (λ x, f₁ x - f₂ x) g l) (h₂ : is_o (λ x, f₂ x - f₃ x) g l) : - is_o (λ x, f₁ x - f₃ x) g l := +theorem is_o.triangle (h₁ : (λ x, f₁ x - f₂ x) =o[l] g) (h₂ : (λ x, f₂ x - f₃ x) =o[l] g) : + (λ x, f₁ x - f₃ x) =o[l] g := (h₁.add h₂).congr_left $ λ x, sub_add_sub_cancel _ _ _ -theorem is_O.congr_of_sub (h : is_O (λ x, f₁ x - f₂ x) g l) : - is_O f₁ g l ↔ is_O f₂ g l := +theorem is_O.congr_of_sub (h : (λ x, f₁ x - f₂ x) =O[l] g) : f₁ =O[l] g ↔ f₂ =O[l] g := ⟨λ h', (h'.sub h).congr_left (λ x, sub_sub_cancel _ _), λ h', (h.add h').congr_left (λ x, sub_add_cancel _ _)⟩ -theorem is_o.congr_of_sub (h : is_o (λ x, f₁ x - f₂ x) g l) : - is_o f₁ g l ↔ is_o f₂ g l := +theorem is_o.congr_of_sub (h : (λ x, f₁ x - f₂ x) =o[l] g) : f₁ =o[l] g ↔ f₂ =o[l] g := ⟨λ h', (h'.sub h).congr_left (λ x, sub_sub_cancel _ _), λ h', (h.add h').congr_left (λ x, sub_add_cancel _ _)⟩ @@ -710,42 +827,42 @@ section zero_const variables (g g' l) -theorem is_o_zero : is_o (λ x, (0 : E')) g' l := +theorem is_o_zero : (λ x, (0 : E')) =o[l] g' := is_o.of_bound $ λ c hc, univ_mem' $ λ x, by simpa using mul_nonneg hc.le (norm_nonneg $ g' x) -theorem is_O_with_zero (hc : 0 ≤ c) : is_O_with c (λ x, (0 : E')) g' l := +theorem is_O_with_zero (hc : 0 ≤ c) : is_O_with c l (λ x, (0 : E')) g' := is_O_with.of_bound $ univ_mem' $ λ x, by simpa using mul_nonneg hc (norm_nonneg $ g' x) -theorem is_O_with_zero' : is_O_with 0 (λ x, (0 : E')) g l := +theorem is_O_with_zero' : is_O_with 0 l (λ x, (0 : E')) g := is_O_with.of_bound $ univ_mem' $ λ x, by simp -theorem is_O_zero : is_O (λ x, (0 : E')) g l := +theorem is_O_zero : (λ x, (0 : E')) =O[l] g := is_O_iff_is_O_with.2 ⟨0, is_O_with_zero' _ _⟩ -theorem is_O_refl_left : is_O (λ x, f' x - f' x) g' l := +theorem is_O_refl_left : (λ x, f' x - f' x) =O[l] g' := (is_O_zero g' l).congr_left $ λ x, (sub_self _).symm -theorem is_o_refl_left : is_o (λ x, f' x - f' x) g' l := +theorem is_o_refl_left : (λ x, f' x - f' x) =o[l] g' := (is_o_zero g' l).congr_left $ λ x, (sub_self _).symm variables {g g' l} @[simp] theorem is_O_with_zero_right_iff : - is_O_with c f'' (λ x, (0 : F'')) l ↔ ∀ᶠ x in l, f'' x = 0 := -by simp only [is_O_with, exists_prop, true_and, norm_zero, mul_zero, norm_le_zero_iff] + is_O_with c l f'' (λ x, (0 : F')) ↔ f'' =ᶠ[l] 0 := +by simp only [is_O_with, exists_prop, true_and, norm_zero, mul_zero, norm_le_zero_iff, + eventually_eq, pi.zero_apply] -@[simp] theorem is_O_zero_right_iff : is_O f'' (λ x, (0 : F'')) l ↔ ∀ᶠ x in l, f'' x = 0 := +@[simp] theorem is_O_zero_right_iff : f'' =O[l] (λ x, (0 : F')) ↔ f'' =ᶠ[l] 0 := ⟨λ h, let ⟨c, hc⟩ := h.is_O_with in is_O_with_zero_right_iff.1 hc, λ h, (is_O_with_zero_right_iff.2 h : is_O_with 1 _ _ _).is_O⟩ @[simp] theorem is_o_zero_right_iff : - is_o f'' (λ x, (0 : F'')) l ↔ ∀ᶠ x in l, f'' x = 0 := -⟨λ h, is_O_zero_right_iff.1 h.is_O, - λ h, is_o.of_is_O_with $ λ c hc, is_O_with_zero_right_iff.2 h⟩ + f'' =o[l] (λ x, (0 : F')) ↔ f'' =ᶠ[l] 0 := +⟨λ h, is_O_zero_right_iff.1 h.is_O, λ h, is_o.of_is_O_with $ λ c hc, is_O_with_zero_right_iff.2 h⟩ theorem is_O_with_const_const (c : E) {c' : F''} (hc' : c' ≠ 0) (l : filter α) : - is_O_with (∥c∥ / ∥c'∥) (λ x : α, c) (λ x, c') l := + is_O_with (‖c‖ / ‖c'‖) l (λ x : α, c) (λ x, c') := begin unfold is_O_with, apply univ_mem', @@ -755,235 +872,269 @@ begin end theorem is_O_const_const (c : E) {c' : F''} (hc' : c' ≠ 0) (l : filter α) : - is_O (λ x : α, c) (λ x, c') l := + (λ x : α, c) =O[l] (λ x, c') := (is_O_with_const_const c hc' l).is_O @[simp] theorem is_O_const_const_iff {c : E''} {c' : F''} (l : filter α) [l.ne_bot] : - is_O (λ x : α, c) (λ x, c') l ↔ (c' = 0 → c = 0) := + (λ x : α, c) =O[l] (λ x, c') ↔ (c' = 0 → c = 0) := begin rcases eq_or_ne c' 0 with rfl|hc', - { simp }, + { simp [eventually_eq] }, { simp [hc', is_O_const_const _ hc'] } end -@[simp] lemma is_O_pure {x} : is_O f'' g'' (pure x) ↔ (g'' x = 0 → f'' x = 0) := -calc is_O f'' g'' (pure x) ↔ is_O (λ y : α, f'' x) (λ _, g'' x) (pure x) : is_O_congr rfl rfl - ... ↔ g'' x = 0 → f'' x = 0 : is_O_const_const_iff _ +@[simp] lemma is_O_pure {x} : f'' =O[pure x] g'' ↔ (g'' x = 0 → f'' x = 0) := +calc f'' =O[pure x] g'' ↔ (λ y : α, f'' x) =O[pure x] (λ _, g'' x) : is_O_congr rfl rfl + ... ↔ g'' x = 0 → f'' x = 0 : is_O_const_const_iff _ end zero_const -@[simp] lemma is_O_with_top : is_O_with c f g ⊤ ↔ ∀ x, ∥f x∥ ≤ c * ∥g x∥ := by rw is_O_with; refl +@[simp] lemma is_O_with_top : is_O_with c ⊤ f g ↔ ∀ x, ‖f x‖ ≤ c * ‖g x‖ := by rw is_O_with; refl -@[simp] lemma is_O_top : is_O f g ⊤ ↔ ∃ C, ∀ x, ∥f x∥ ≤ C * ∥g x∥ := by rw is_O_iff; refl +@[simp] lemma is_O_top : f =O[⊤] g ↔ ∃ C, ∀ x, ‖f x‖ ≤ C * ‖g x‖ := by rw is_O_iff; refl -@[simp] lemma is_o_top : is_o f'' g'' ⊤ ↔ ∀ x, f'' x = 0 := +@[simp] lemma is_o_top : f'' =o[⊤] g'' ↔ ∀ x, f'' x = 0 := begin refine ⟨_, λ h, (is_o_zero g'' ⊤).congr (λ x, (h x).symm) (λ x, rfl)⟩, simp only [is_o_iff, eventually_top], refine λ h x, norm_le_zero_iff.1 _, - have : tendsto (λ c : ℝ, c * ∥g'' x∥) (𝓝[>] 0) (𝓝 0) := + have : tendsto (λ c : ℝ, c * ‖g'' x‖) (𝓝[>] 0) (𝓝 0) := ((continuous_id.mul continuous_const).tendsto' _ _ (zero_mul _)).mono_left inf_le_left, exact le_of_tendsto_of_tendsto tendsto_const_nhds this (eventually_nhds_within_iff.2 $ eventually_of_forall $ λ c hc, h hc x) end @[simp] lemma is_O_with_principal {s : set α} : - is_O_with c f g (𝓟 s) ↔ ∀ x ∈ s, ∥f x∥ ≤ c * ∥g x∥ := + is_O_with c (𝓟 s) f g ↔ ∀ x ∈ s, ‖f x‖ ≤ c * ‖g x‖ := by rw is_O_with; refl -lemma is_O_principal {s : set α} : - is_O f g (𝓟 s) ↔ ∃ c, ∀ x ∈ s, ∥f x∥ ≤ c * ∥g x∥ := +lemma is_O_principal {s : set α} : f =O[𝓟 s] g ↔ ∃ c, ∀ x ∈ s, ‖f x‖ ≤ c * ‖g x‖ := by rw is_O_iff; refl -theorem is_O_with_const_one (c : E) (l : filter α) : is_O_with ∥c∥ (λ x : α, c) (λ x, (1 : 𝕜)) l := -begin - refine (is_O_with_const_const c _ l).congr_const _, - { rw [norm_one, div_one] }, - { exact one_ne_zero } -end +section -theorem is_O_const_one (c : E) (l : filter α) : is_O (λ x : α, c) (λ x, (1 : 𝕜)) l := -(is_O_with_const_one c l).is_O +variables (F) [has_one F] [norm_one_class F] -section +theorem is_O_with_const_one (c : E) (l : filter α) : is_O_with ‖c‖ l (λ x : α, c) (λ x, (1 : F)) := +by simp [is_O_with_iff] -variable (𝕜) +theorem is_O_const_one (c : E) (l : filter α) : (λ x : α, c) =O[l] (λ x, (1 : F)) := +(is_O_with_const_one F c l).is_O theorem is_o_const_iff_is_o_one {c : F''} (hc : c ≠ 0) : - is_o f (λ x, c) l ↔ is_o f (λ x, (1:𝕜)) l := -⟨λ h, h.trans_is_O $ is_O_const_one c l, λ h, h.trans_is_O $ is_O_const_const _ hc _⟩ + f =o[l] (λ x, c) ↔ f =o[l] (λ x, (1 : F)) := +⟨λ h, h.trans_is_O_with (is_O_with_const_one _ _ _) (norm_pos_iff.2 hc), + λ h, h.trans_is_O $ is_O_const_const _ hc _⟩ + +@[simp] theorem is_o_one_iff : f' =o[l] (λ x, 1 : α → F) ↔ tendsto f' l (𝓝 0) := +by simp only [is_o_iff, norm_one, mul_one, metric.nhds_basis_closed_ball.tendsto_right_iff, + metric.mem_closed_ball, dist_zero_right] + +@[simp] theorem is_O_one_iff : f =O[l] (λ x, 1 : α → F) ↔ is_bounded_under (≤) l (λ x, ‖f x‖) := +by { simp only [is_O_iff, norm_one, mul_one], refl } + +alias is_O_one_iff ↔ _ _root_.filter.is_bounded_under.is_O_one + +@[simp] theorem is_o_one_left_iff : (λ x, 1 : α → F) =o[l] f ↔ tendsto (λ x, ‖f x‖) l at_top := +calc (λ x, 1 : α → F) =o[l] f ↔ ∀ n : ℕ, ∀ᶠ x in l, ↑n * ‖(1 : F)‖ ≤ ‖f x‖ : + is_o_iff_nat_mul_le_aux $ or.inl $ λ x, by simp only [norm_one, zero_le_one] +... ↔ ∀ n : ℕ, true → ∀ᶠ x in l, ‖f x‖ ∈ Ici (n : ℝ) : + by simp only [norm_one, mul_one, true_implies_iff, mem_Ici] +... ↔ tendsto (λ x, ‖f x‖) l at_top : at_top_countable_basis_of_archimedean.1.tendsto_right_iff.symm + +theorem _root_.filter.tendsto.is_O_one {c : E'} (h : tendsto f' l (𝓝 c)) : + f' =O[l] (λ x, 1 : α → F) := +h.norm.is_bounded_under_le.is_O_one F + +theorem is_O.trans_tendsto_nhds (hfg : f =O[l] g') {y : F'} (hg : tendsto g' l (𝓝 y)) : + f =O[l] (λ x, 1 : α → F) := +hfg.trans $ hg.is_O_one F end theorem is_o_const_iff {c : F''} (hc : c ≠ 0) : - is_o f'' (λ x, c) l ↔ tendsto f'' l (𝓝 0) := -(is_o_const_iff_is_o_one ℝ hc).trans -begin - clear hc c, - simp only [is_o, is_O_with, norm_one, mul_one, metric.nhds_basis_closed_ball.tendsto_right_iff, - metric.mem_closed_ball, dist_zero_right] -end + f'' =o[l] (λ x, c) ↔ tendsto f'' l (𝓝 0) := +(is_o_const_iff_is_o_one ℝ hc).trans (is_o_one_iff _) lemma is_o_id_const {c : F''} (hc : c ≠ 0) : - is_o (λ (x : E''), x) (λ x, c) (𝓝 0) := + (λ (x : E''), x) =o[𝓝 0] (λ x, c) := (is_o_const_iff hc).mpr (continuous_id.tendsto 0) theorem _root_.filter.is_bounded_under.is_O_const (h : is_bounded_under (≤) l (norm ∘ f)) - {c : F''} (hc : c ≠ 0) : is_O f (λ x, c) l := -begin - rcases h with ⟨C, hC⟩, - refine (is_O.of_bound 1 _).trans (is_O_const_const C hc l), - refine (eventually_map.1 hC).mono (λ x h, _), - calc ∥f x∥ ≤ C : h - ... ≤ abs C : le_abs_self C - ... = 1 * ∥C∥ : (one_mul _).symm -end + {c : F''} (hc : c ≠ 0) : f =O[l] (λ x, c) := +(h.is_O_one ℝ).trans (is_O_const_const _ hc _) theorem is_O_const_of_tendsto {y : E''} (h : tendsto f'' l (𝓝 y)) {c : F''} (hc : c ≠ 0) : - is_O f'' (λ x, c) l := + f'' =O[l] (λ x, c) := h.norm.is_bounded_under_le.is_O_const hc -section +lemma is_O.is_bounded_under_le {c : F} (h : f =O[l] (λ x, c)) : + is_bounded_under (≤) l (norm ∘ f) := +let ⟨c', hc'⟩ := h.bound in ⟨c' * ‖c‖, eventually_map.2 hc'⟩ -variable (𝕜) +theorem is_O_const_of_ne {c : F''} (hc : c ≠ 0) : + f =O[l] (λ x, c) ↔ is_bounded_under (≤) l (norm ∘ f) := +⟨λ h, h.is_bounded_under_le, λ h, h.is_O_const hc⟩ -theorem is_o_one_iff : is_o f'' (λ x, (1 : 𝕜)) l ↔ tendsto f'' l (𝓝 0) := -is_o_const_iff one_ne_zero +theorem is_O_const_iff {c : F''} : + f'' =O[l] (λ x, c) ↔ (c = 0 → f'' =ᶠ[l] 0) ∧ is_bounded_under (≤) l (λ x, ‖f'' x‖) := +begin + refine ⟨λ h, ⟨λ hc, is_O_zero_right_iff.1 (by rwa ← hc), h.is_bounded_under_le⟩, _⟩, + rintro ⟨hcf, hf⟩, + rcases eq_or_ne c 0 with hc|hc, + exacts [(hcf hc).trans_is_O (is_O_zero _ _), hf.is_O_const hc] +end -theorem is_O_one_of_tendsto {y : E''} (h : tendsto f'' l (𝓝 y)) : - is_O f'' (λ x, (1:𝕜)) l := -is_O_const_of_tendsto h one_ne_zero +theorem is_O_iff_is_bounded_under_le_div (h : ∀ᶠ x in l, g'' x ≠ 0) : + f =O[l] g'' ↔ is_bounded_under (≤) l (λ x, ‖f x‖ / ‖g'' x‖) := +begin + simp only [is_O_iff, is_bounded_under, is_bounded, eventually_map], + exact exists_congr (λ c, eventually_congr $ h.mono $ + λ x hx, (div_le_iff $ norm_pos_iff.2 hx).symm) +end -theorem is_O.trans_tendsto_nhds (hfg : is_O f g'' l) {y : F''} (hg : tendsto g'' l (𝓝 y)) : - is_O f (λ x, (1:𝕜)) l := -hfg.trans $ is_O_one_of_tendsto 𝕜 hg +/-- `(λ x, c) =O[l] f` if and only if `f` is bounded away from zero. -/ +lemma is_O_const_left_iff_pos_le_norm {c : E''} (hc : c ≠ 0) : + (λ x, c) =O[l] f' ↔ ∃ b, 0 < b ∧ ∀ᶠ x in l, b ≤ ‖f' x‖ := +begin + split, + { intro h, + rcases h.exists_pos with ⟨C, hC₀, hC⟩, + refine ⟨‖c‖ / C, div_pos (norm_pos_iff.2 hc) hC₀, _⟩, + exact hC.bound.mono (λ x, (div_le_iff' hC₀).2) }, + { rintro ⟨b, hb₀, hb⟩, + refine is_O.of_bound (‖c‖ / b) (hb.mono $ λ x hx, _), + rw [div_mul_eq_mul_div, mul_div_assoc], + exact le_mul_of_one_le_right (norm_nonneg _) ((one_le_div hb₀).2 hx) } +end + +section + +variable (𝕜) end -theorem is_O.trans_tendsto (hfg : is_O f'' g'' l) (hg : tendsto g'' l (𝓝 0)) : +theorem is_O.trans_tendsto (hfg : f'' =O[l] g'') (hg : tendsto g'' l (𝓝 0)) : tendsto f'' l (𝓝 0) := (is_o_one_iff ℝ).1 $ hfg.trans_is_o $ (is_o_one_iff ℝ).2 hg -theorem is_o.trans_tendsto (hfg : is_o f'' g'' l) (hg : tendsto g'' l (𝓝 0)) : +theorem is_o.trans_tendsto (hfg : f'' =o[l] g'') (hg : tendsto g'' l (𝓝 0)) : tendsto f'' l (𝓝 0) := hfg.is_O.trans_tendsto hg /-! ### Multiplication by a constant -/ theorem is_O_with_const_mul_self (c : R) (f : α → R) (l : filter α) : - is_O_with ∥c∥ (λ x, c * f x) f l := + is_O_with ‖c‖ l (λ x, c * f x) f := is_O_with_of_le' _ $ λ x, norm_mul_le _ _ -theorem is_O_const_mul_self (c : R) (f : α → R) (l : filter α) : - is_O (λ x, c * f x) f l := +theorem is_O_const_mul_self (c : R) (f : α → R) (l : filter α) : (λ x, c * f x) =O[l] f := (is_O_with_const_mul_self c f l).is_O -theorem is_O_with.const_mul_left {f : α → R} (h : is_O_with c f g l) (c' : R) : - is_O_with (∥c'∥ * c) (λ x, c' * f x) g l := +theorem is_O_with.const_mul_left {f : α → R} (h : is_O_with c l f g) (c' : R) : + is_O_with (‖c'‖ * c) l (λ x, c' * f x) g := (is_O_with_const_mul_self c' f l).trans h (norm_nonneg c') -theorem is_O.const_mul_left {f : α → R} (h : is_O f g l) (c' : R) : - is_O (λ x, c' * f x) g l := +theorem is_O.const_mul_left {f : α → R} (h : f =O[l] g) (c' : R) : + (λ x, c' * f x) =O[l] g := let ⟨c, hc⟩ := h.is_O_with in (hc.const_mul_left c').is_O theorem is_O_with_self_const_mul' (u : Rˣ) (f : α → R) (l : filter α) : - is_O_with ∥(↑u⁻¹:R)∥ f (λ x, ↑u * f x) l := + is_O_with ‖(↑u⁻¹:R)‖ l f (λ x, ↑u * f x) := (is_O_with_const_mul_self ↑u⁻¹ _ l).congr_left $ λ x, u.inv_mul_cancel_left (f x) theorem is_O_with_self_const_mul (c : 𝕜) (hc : c ≠ 0) (f : α → 𝕜) (l : filter α) : - is_O_with ∥c∥⁻¹ f (λ x, c * f x) l := + is_O_with ‖c‖⁻¹ l f (λ x, c * f x) := (is_O_with_self_const_mul' (units.mk0 c hc) f l).congr_const $ norm_inv c theorem is_O_self_const_mul' {c : R} (hc : is_unit c) (f : α → R) (l : filter α) : - is_O f (λ x, c * f x) l := + f =O[l] (λ x, c * f x) := let ⟨u, hu⟩ := hc in hu ▸ (is_O_with_self_const_mul' u f l).is_O theorem is_O_self_const_mul (c : 𝕜) (hc : c ≠ 0) (f : α → 𝕜) (l : filter α) : - is_O f (λ x, c * f x) l := + f =O[l] (λ x, c * f x) := is_O_self_const_mul' (is_unit.mk0 c hc) f l theorem is_O_const_mul_left_iff' {f : α → R} {c : R} (hc : is_unit c) : - is_O (λ x, c * f x) g l ↔ is_O f g l := + (λ x, c * f x) =O[l] g ↔ f =O[l] g := ⟨(is_O_self_const_mul' hc f l).trans, λ h, h.const_mul_left c⟩ theorem is_O_const_mul_left_iff {f : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) : - is_O (λ x, c * f x) g l ↔ is_O f g l := + (λ x, c * f x) =O[l] g ↔ f =O[l] g := is_O_const_mul_left_iff' $ is_unit.mk0 c hc -theorem is_o.const_mul_left {f : α → R} (h : is_o f g l) (c : R) : - is_o (λ x, c * f x) g l := +theorem is_o.const_mul_left {f : α → R} (h : f =o[l] g) (c : R) : (λ x, c * f x) =o[l] g := (is_O_const_mul_self c f l).trans_is_o h theorem is_o_const_mul_left_iff' {f : α → R} {c : R} (hc : is_unit c) : - is_o (λ x, c * f x) g l ↔ is_o f g l := + (λ x, c * f x) =o[l] g ↔ f =o[l] g := ⟨(is_O_self_const_mul' hc f l).trans_is_o, λ h, h.const_mul_left c⟩ theorem is_o_const_mul_left_iff {f : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) : - is_o (λ x, c * f x) g l ↔ is_o f g l := + (λ x, c * f x) =o[l] g ↔ f =o[l] g := is_o_const_mul_left_iff' $ is_unit.mk0 c hc theorem is_O_with.of_const_mul_right {g : α → R} {c : R} (hc' : 0 ≤ c') - (h : is_O_with c' f (λ x, c * g x) l) : - is_O_with (c' * ∥c∥) f g l := + (h : is_O_with c' l f (λ x, c * g x)) : + is_O_with (c' * ‖c‖) l f g := h.trans (is_O_with_const_mul_self c g l) hc' -theorem is_O.of_const_mul_right {g : α → R} {c : R} - (h : is_O f (λ x, c * g x) l) : - is_O f g l := +theorem is_O.of_const_mul_right {g : α → R} {c : R} (h : f =O[l] (λ x, c * g x)) : + f =O[l] g := let ⟨c, cnonneg, hc⟩ := h.exists_nonneg in (hc.of_const_mul_right cnonneg).is_O theorem is_O_with.const_mul_right' {g : α → R} {u : Rˣ} {c' : ℝ} (hc' : 0 ≤ c') - (h : is_O_with c' f g l) : - is_O_with (c' * ∥(↑u⁻¹:R)∥) f (λ x, ↑u * g x) l := + (h : is_O_with c' l f g) : + is_O_with (c' * ‖(↑u⁻¹:R)‖) l f (λ x, ↑u * g x) := h.trans (is_O_with_self_const_mul' _ _ _) hc' theorem is_O_with.const_mul_right {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) - {c' : ℝ} (hc' : 0 ≤ c') (h : is_O_with c' f g l) : - is_O_with (c' * ∥c∥⁻¹) f (λ x, c * g x) l := + {c' : ℝ} (hc' : 0 ≤ c') (h : is_O_with c' l f g) : + is_O_with (c' * ‖c‖⁻¹) l f (λ x, c * g x) := h.trans (is_O_with_self_const_mul c hc g l) hc' -theorem is_O.const_mul_right' {g : α → R} {c : R} (hc : is_unit c) (h : is_O f g l) : - is_O f (λ x, c * g x) l := +theorem is_O.const_mul_right' {g : α → R} {c : R} (hc : is_unit c) (h : f =O[l] g) : + f =O[l] (λ x, c * g x) := h.trans (is_O_self_const_mul' hc g l) -theorem is_O.const_mul_right {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) (h : is_O f g l) : - is_O f (λ x, c * g x) l := +theorem is_O.const_mul_right {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) (h : f =O[l] g) : + f =O[l] (λ x, c * g x) := h.const_mul_right' $ is_unit.mk0 c hc theorem is_O_const_mul_right_iff' {g : α → R} {c : R} (hc : is_unit c) : - is_O f (λ x, c * g x) l ↔ is_O f g l := + f =O[l] (λ x, c * g x) ↔ f =O[l] g := ⟨λ h, h.of_const_mul_right, λ h, h.const_mul_right' hc⟩ theorem is_O_const_mul_right_iff {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) : - is_O f (λ x, c * g x) l ↔ is_O f g l := + f =O[l] (λ x, c * g x) ↔ f =O[l] g := is_O_const_mul_right_iff' $ is_unit.mk0 c hc -theorem is_o.of_const_mul_right {g : α → R} {c : R} (h : is_o f (λ x, c * g x) l) : - is_o f g l := +theorem is_o.of_const_mul_right {g : α → R} {c : R} (h : f =o[l] (λ x, c * g x)) : + f =o[l] g := h.trans_is_O (is_O_const_mul_self c g l) -theorem is_o.const_mul_right' {g : α → R} {c : R} (hc : is_unit c) (h : is_o f g l) : - is_o f (λ x, c * g x) l := +theorem is_o.const_mul_right' {g : α → R} {c : R} (hc : is_unit c) (h : f =o[l] g) : + f =o[l] (λ x, c * g x) := h.trans_is_O (is_O_self_const_mul' hc g l) -theorem is_o.const_mul_right {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) (h : is_o f g l) : - is_o f (λ x, c * g x) l := +theorem is_o.const_mul_right {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) (h : f =o[l] g) : + f =o[l] (λ x, c * g x) := h.const_mul_right' $ is_unit.mk0 c hc theorem is_o_const_mul_right_iff' {g : α → R} {c : R} (hc : is_unit c) : - is_o f (λ x, c * g x) l ↔ is_o f g l := + f =o[l] (λ x, c * g x) ↔ f =o[l] g := ⟨λ h, h.of_const_mul_right, λ h, h.const_mul_right' hc⟩ theorem is_o_const_mul_right_iff {g : α → 𝕜} {c : 𝕜} (hc : c ≠ 0) : - is_o f (λ x, c * g x) l ↔ is_o f g l := + f =o[l] (λ x, c * g x) ↔ f =o[l] g := is_o_const_mul_right_iff' $ is_unit.mk0 c hc /-! ### Multiplication -/ theorem is_O_with.mul {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} {c₁ c₂ : ℝ} - (h₁ : is_O_with c₁ f₁ g₁ l) (h₂ : is_O_with c₂ f₂ g₂ l) : - is_O_with (c₁ * c₂) (λ x, f₁ x * f₂ x) (λ x, g₁ x * g₂ x) l := + (h₁ : is_O_with c₁ l f₁ g₁) (h₂ : is_O_with c₂ l f₂ g₂) : + is_O_with (c₁ * c₂) l (λ x, f₁ x * f₂ x) (λ x, g₁ x * g₂ x) := begin unfold is_O_with at *, filter_upwards [h₁, h₂] with _ hx₁ hx₂, @@ -992,14 +1143,13 @@ begin rw [norm_mul, mul_mul_mul_comm] end -theorem is_O.mul {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} - (h₁ : is_O f₁ g₁ l) (h₂ : is_O f₂ g₂ l) : - is_O (λ x, f₁ x * f₂ x) (λ x, g₁ x * g₂ x) l := +theorem is_O.mul {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} (h₁ : f₁ =O[l] g₁) (h₂ : f₂ =O[l] g₂) : + (λ x, f₁ x * f₂ x) =O[l] (λ x, g₁ x * g₂ x) := let ⟨c, hc⟩ := h₁.is_O_with, ⟨c', hc'⟩ := h₂.is_O_with in (hc.mul hc').is_O theorem is_O.mul_is_o {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} - (h₁ : is_O f₁ g₁ l) (h₂ : is_o f₂ g₂ l) : - is_o (λ x, f₁ x * f₂ x) (λ x, g₁ x * g₂ x) l := + (h₁ : f₁ =O[l] g₁) (h₂ : f₂ =o[l] g₂) : + (λ x, f₁ x * f₂ x) =o[l] (λ x, g₁ x * g₂ x) := begin unfold is_o at *, intros c cpos, @@ -1007,9 +1157,8 @@ begin exact (hc'.mul (h₂ (div_pos cpos c'pos))).congr_const (mul_div_cancel' _ (ne_of_gt c'pos)) end -theorem is_o.mul_is_O {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} - (h₁ : is_o f₁ g₁ l) (h₂ : is_O f₂ g₂ l) : - is_o (λ x, f₁ x * f₂ x) (λ x, g₁ x * g₂ x) l := +theorem is_o.mul_is_O {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} (h₁ : f₁ =o[l] g₁) (h₂ : f₂ =O[l] g₂) : + (λ x, f₁ x * f₂ x) =o[l] (λ x, g₁ x * g₂ x) := begin unfold is_o at *, intros c cpos, @@ -1017,52 +1166,75 @@ begin exact ((h₁ (div_pos cpos c'pos)).mul hc').congr_const (div_mul_cancel _ (ne_of_gt c'pos)) end -theorem is_o.mul {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} (h₁ : is_o f₁ g₁ l) (h₂ : is_o f₂ g₂ l) : - is_o (λ x, f₁ x * f₂ x) (λ x, g₁ x * g₂ x) l := +theorem is_o.mul {f₁ f₂ : α → R} {g₁ g₂ : α → 𝕜} (h₁ : f₁ =o[l] g₁) (h₂ : f₂ =o[l] g₂) : + (λ x, f₁ x * f₂ x) =o[l] (λ x, g₁ x * g₂ x) := h₁.mul_is_O h₂.is_O -theorem is_O_with.pow' {f : α → R} {g : α → 𝕜} (h : is_O_with c f g l) : - ∀ n : ℕ, is_O_with (nat.cases_on n ∥(1 : R)∥ (λ n, c ^ (n + 1))) (λ x, f x ^ n) (λ x, g x ^ n) l -| 0 := by simpa using is_O_with_const_const (1 : R) (@one_ne_zero 𝕜 _ _) l +theorem is_O_with.pow' {f : α → R} {g : α → 𝕜} (h : is_O_with c l f g) : + ∀ n : ℕ, is_O_with (nat.cases_on n ‖(1 : R)‖ (λ n, c ^ (n + 1))) l (λ x, f x ^ n) (λ x, g x ^ n) +| 0 := by simpa using is_O_with_const_const (1 : R) (one_ne_zero' 𝕜) l | 1 := by simpa | (n + 2) := by simpa [pow_succ] using h.mul (is_O_with.pow' (n + 1)) -theorem is_O_with.pow [norm_one_class R] {f : α → R} {g : α → 𝕜} (h : is_O_with c f g l) : - ∀ n : ℕ, is_O_with (c ^ n) (λ x, f x ^ n) (λ x, g x ^ n) l +theorem is_O_with.pow [norm_one_class R] {f : α → R} {g : α → 𝕜} (h : is_O_with c l f g) : + ∀ n : ℕ, is_O_with (c ^ n) l (λ x, f x ^ n) (λ x, g x ^ n) | 0 := by simpa using h.pow' 0 | (n + 1) := h.pow' (n + 1) -theorem is_O.pow {f : α → R} {g : α → 𝕜} (h : is_O f g l) (n : ℕ) : - is_O (λ x, f x ^ n) (λ x, g x ^ n) l := +theorem is_O_with.of_pow {n : ℕ} {f : α → 𝕜} {g : α → R} (h : is_O_with c l (f ^ n) (g ^ n)) + (hn : n ≠ 0) (hc : c ≤ c' ^ n) (hc' : 0 ≤ c') : is_O_with c' l f g := +is_O_with.of_bound $ (h.weaken hc).bound.mono $ λ x hx, + le_of_pow_le_pow n (mul_nonneg hc' $ norm_nonneg _) hn.bot_lt $ + calc ‖f x‖ ^ n = ‖(f x) ^ n‖ : (norm_pow _ _).symm + ... ≤ c' ^ n * ‖(g x) ^ n‖ : hx + ... ≤ c' ^ n * ‖g x‖ ^ n : + mul_le_mul_of_nonneg_left (norm_pow_le' _ hn.bot_lt) (pow_nonneg hc' _) + ... = (c' * ‖g x‖) ^ n : (mul_pow _ _ _).symm + +theorem is_O.pow {f : α → R} {g : α → 𝕜} (h : f =O[l] g) (n : ℕ) : + (λ x, f x ^ n) =O[l] (λ x, g x ^ n) := let ⟨C, hC⟩ := h.is_O_with in is_O_iff_is_O_with.2 ⟨_, hC.pow' n⟩ -theorem is_o.pow {f : α → R} {g : α → 𝕜} (h : is_o f g l) {n : ℕ} (hn : 0 < n) : - is_o (λ x, f x ^ n) (λ x, g x ^ n) l := +theorem is_O.of_pow {f : α → 𝕜} {g : α → R} {n : ℕ} (hn : n ≠ 0) (h : (f ^ n) =O[l] (g ^ n)) : + f =O[l] g := +begin + rcases h.exists_pos with ⟨C, hC₀, hC⟩, + obtain ⟨c, hc₀, hc⟩ : ∃ c : ℝ, 0 ≤ c ∧ C ≤ c ^ n, + from ((eventually_ge_at_top _).and $ (tendsto_pow_at_top hn).eventually_ge_at_top C).exists, + exact (hC.of_pow hn hc hc₀).is_O +end + +theorem is_o.pow {f : α → R} {g : α → 𝕜} (h : f =o[l] g) {n : ℕ} (hn : 0 < n) : + (λ x, f x ^ n) =o[l] (λ x, g x ^ n) := begin cases n, exact hn.false.elim, clear hn, induction n with n ihn, { simpa only [pow_one] }, convert h.mul ihn; simp [pow_succ] end +theorem is_o.of_pow {f : α → 𝕜} {g : α → R} {n : ℕ} (h : (f ^ n) =o[l] (g ^ n)) (hn : n ≠ 0) : + f =o[l] g := +is_o.of_is_O_with $ λ c hc, (h.def' $ pow_pos hc _).of_pow hn le_rfl hc.le + /-! ### Inverse -/ -theorem is_O_with.inv_rev {f : α → 𝕜} {g : α → 𝕜'} (h : is_O_with c f g l) - (h₀ : ∀ᶠ x in l, f x ≠ 0) : is_O_with c (λ x, (g x)⁻¹) (λ x, (f x)⁻¹) l := +theorem is_O_with.inv_rev {f : α → 𝕜} {g : α → 𝕜'} (h : is_O_with c l f g) + (h₀ : ∀ᶠ x in l, f x = 0 → g x = 0) : is_O_with c l (λ x, (g x)⁻¹) (λ x, (f x)⁻¹) := begin refine is_O_with.of_bound (h.bound.mp (h₀.mono $ λ x h₀ hle, _)), - cases le_or_lt c 0 with hc hc, - { refine (h₀ $ norm_le_zero_iff.1 _).elim, - exact hle.trans (mul_nonpos_of_nonpos_of_nonneg hc $ norm_nonneg _) }, - { replace hle := inv_le_inv_of_le (norm_pos_iff.2 h₀) hle, - simpa only [norm_inv, mul_inv₀, ← div_eq_inv_mul, div_le_iff hc] using hle } + cases eq_or_ne (f x) 0 with hx hx, + { simp only [hx, h₀ hx, inv_zero, norm_zero, mul_zero] }, + { have hc : 0 < c, from pos_of_mul_pos_left ((norm_pos_iff.2 hx).trans_le hle) (norm_nonneg _), + replace hle := inv_le_inv_of_le (norm_pos_iff.2 hx) hle, + simpa only [norm_inv, mul_inv, ← div_eq_inv_mul, div_le_iff hc] using hle } end -theorem is_O.inv_rev {f : α → 𝕜} {g : α → 𝕜'} (h : is_O f g l) - (h₀ : ∀ᶠ x in l, f x ≠ 0) : is_O (λ x, (g x)⁻¹) (λ x, (f x)⁻¹) l := +theorem is_O.inv_rev {f : α → 𝕜} {g : α → 𝕜'} (h : f =O[l] g) + (h₀ : ∀ᶠ x in l, f x = 0 → g x = 0) : (λ x, (g x)⁻¹) =O[l] (λ x, (f x)⁻¹) := let ⟨c, hc⟩ := h.is_O_with in (hc.inv_rev h₀).is_O -theorem is_o.inv_rev {f : α → 𝕜} {g : α → 𝕜'} (h : is_o f g l) - (h₀ : ∀ᶠ x in l, f x ≠ 0) : is_o (λ x, (g x)⁻¹) (λ x, (f x)⁻¹) l := +theorem is_o.inv_rev {f : α → 𝕜} {g : α → 𝕜'} (h : f =o[l] g) + (h₀ : ∀ᶠ x in l, f x = 0 → g x = 0) : (λ x, (g x)⁻¹) =o[l] (λ x, (f x)⁻¹) := is_o.of_is_O_with $ λ c hc, (h.def' hc).inv_rev h₀ /-! ### Scalar multiplication -/ @@ -1070,46 +1242,45 @@ is_o.of_is_O_with $ λ c hc, (h.def' hc).inv_rev h₀ section smul_const variables [normed_space 𝕜 E'] -theorem is_O_with.const_smul_left (h : is_O_with c f' g l) (c' : 𝕜) : - is_O_with (∥c'∥ * c) (λ x, c' • f' x) g l := -by refine ((h.norm_left.const_mul_left (∥c'∥)).congr _ _ (λ _, rfl)).of_norm_left; - intros; simp only [norm_norm, norm_smul] +theorem is_O_with.const_smul_left (h : is_O_with c l f' g) (c' : 𝕜) : + is_O_with (‖c'‖ * c) l (λ x, c' • f' x) g := +is_O_with.of_norm_left $ + by simpa only [← norm_smul, norm_norm] using h.norm_left.const_mul_left (‖c'‖) + +lemma is_O.const_smul_left (h : f' =O[l] g) (c : 𝕜) : (c • f') =O[l] g := +let ⟨b, hb⟩ := h.is_O_with in (hb.const_smul_left _).is_O -theorem is_O_const_smul_left_iff {c : 𝕜} (hc : c ≠ 0) : - is_O (λ x, c • f' x) g l ↔ is_O f' g l := +lemma is_o.const_smul_left (h : f' =o[l] g) (c : 𝕜) : (c • f') =o[l] g := +is_o.of_norm_left $ by simpa only [← norm_smul] using h.norm_left.const_mul_left (‖c‖) + +theorem is_O_const_smul_left {c : 𝕜} (hc : c ≠ 0) : + (λ x, c • f' x) =O[l] g ↔ f' =O[l] g := begin - have cne0 : ∥c∥ ≠ 0, from mt norm_eq_zero.mp hc, + have cne0 : ‖c‖ ≠ 0, from mt norm_eq_zero.mp hc, rw [←is_O_norm_left], simp only [norm_smul], rw [is_O_const_mul_left_iff cne0, is_O_norm_left], end -theorem is_o_const_smul_left (h : is_o f' g l) (c : 𝕜) : - is_o (λ x, c • f' x) g l := +theorem is_o_const_smul_left {c : 𝕜} (hc : c ≠ 0) : + (λ x, c • f' x) =o[l] g ↔ f' =o[l] g := begin - refine ((h.norm_left.const_mul_left (∥c∥)).congr_left _).of_norm_left, - exact λ x, (norm_smul _ _).symm -end - -theorem is_o_const_smul_left_iff {c : 𝕜} (hc : c ≠ 0) : - is_o (λ x, c • f' x) g l ↔ is_o f' g l := -begin - have cne0 : ∥c∥ ≠ 0, from mt norm_eq_zero.mp hc, + have cne0 : ‖c‖ ≠ 0, from mt norm_eq_zero.mp hc, rw [←is_o_norm_left], simp only [norm_smul], rw [is_o_const_mul_left_iff cne0, is_o_norm_left] end theorem is_O_const_smul_right {c : 𝕜} (hc : c ≠ 0) : - is_O f (λ x, c • f' x) l ↔ is_O f f' l := + f =O[l] (λ x, c • f' x) ↔ f =O[l] f' := begin - have cne0 : ∥c∥ ≠ 0, from mt norm_eq_zero.mp hc, + have cne0 : ‖c‖ ≠ 0, from mt norm_eq_zero.mp hc, rw [←is_O_norm_right], simp only [norm_smul], rw [is_O_const_mul_right_iff cne0, is_O_norm_right] end theorem is_o_const_smul_right {c : 𝕜} (hc : c ≠ 0) : - is_o f (λ x, c • f' x) l ↔ is_o f f' l := + f =o[l] (λ x, c • f' x) ↔ f =o[l] f' := begin - have cne0 : ∥c∥ ≠ 0, from mt norm_eq_zero.mp hc, + have cne0 : ‖c‖ ≠ 0, from mt norm_eq_zero.mp hc, rw [←is_o_norm_right], simp only [norm_smul], rw [is_o_const_mul_right_iff cne0, is_o_norm_right] end @@ -1118,30 +1289,30 @@ end smul_const section smul -variables [normed_space 𝕜 E'] [normed_space 𝕜 F'] +variables [normed_space 𝕜 E'] [normed_space 𝕜' F'] {k₁ : α → 𝕜} {k₂ : α → 𝕜'} -theorem is_O_with.smul {k₁ k₂ : α → 𝕜} (h₁ : is_O_with c k₁ k₂ l) (h₂ : is_O_with c' f' g' l) : - is_O_with (c * c') (λ x, k₁ x • f' x) (λ x, k₂ x • g' x) l := +theorem is_O_with.smul (h₁ : is_O_with c l k₁ k₂) (h₂ : is_O_with c' l f' g') : + is_O_with (c * c') l (λ x, k₁ x • f' x) (λ x, k₂ x • g' x) := by refine ((h₁.norm_norm.mul h₂.norm_norm).congr rfl _ _).of_norm_norm; by intros; simp only [norm_smul] -theorem is_O.smul {k₁ k₂ : α → 𝕜} (h₁ : is_O k₁ k₂ l) (h₂ : is_O f' g' l) : - is_O (λ x, k₁ x • f' x) (λ x, k₂ x • g' x) l := +theorem is_O.smul (h₁ : k₁ =O[l] k₂) (h₂ : f' =O[l] g') : + (λ x, k₁ x • f' x) =O[l] (λ x, k₂ x • g' x) := by refine ((h₁.norm_norm.mul h₂.norm_norm).congr _ _).of_norm_norm; by intros; simp only [norm_smul] -theorem is_O.smul_is_o {k₁ k₂ : α → 𝕜} (h₁ : is_O k₁ k₂ l) (h₂ : is_o f' g' l) : - is_o (λ x, k₁ x • f' x) (λ x, k₂ x • g' x) l := +theorem is_O.smul_is_o (h₁ : k₁ =O[l] k₂) (h₂ : f' =o[l] g') : + (λ x, k₁ x • f' x) =o[l] (λ x, k₂ x • g' x) := by refine ((h₁.norm_norm.mul_is_o h₂.norm_norm).congr _ _).of_norm_norm; by intros; simp only [norm_smul] -theorem is_o.smul_is_O {k₁ k₂ : α → 𝕜} (h₁ : is_o k₁ k₂ l) (h₂ : is_O f' g' l) : - is_o (λ x, k₁ x • f' x) (λ x, k₂ x • g' x) l := +theorem is_o.smul_is_O (h₁ : k₁ =o[l] k₂) (h₂ : f' =O[l] g') : + (λ x, k₁ x • f' x) =o[l] (λ x, k₂ x • g' x) := by refine ((h₁.norm_norm.mul_is_O h₂.norm_norm).congr _ _).of_norm_norm; by intros; simp only [norm_smul] -theorem is_o.smul {k₁ k₂ : α → 𝕜} (h₁ : is_o k₁ k₂ l) (h₂ : is_o f' g' l) : - is_o (λ x, k₁ x • f' x) (λ x, k₂ x • g' x) l := +theorem is_o.smul (h₁ : k₁ =o[l] k₂) (h₂ : f' =o[l] g') : + (λ x, k₁ x • f' x) =o[l] (λ x, k₂ x • g' x) := by refine ((h₁.norm_norm.mul h₂.norm_norm).congr _ _).of_norm_norm; by intros; simp only [norm_smul] @@ -1153,8 +1324,8 @@ section sum variables {ι : Type*} {A : ι → α → E'} {C : ι → ℝ} {s : finset ι} -theorem is_O_with.sum (h : ∀ i ∈ s, is_O_with (C i) (A i) g l) : - is_O_with (∑ i in s, C i) (λ x, ∑ i in s, A i x) g l := +theorem is_O_with.sum (h : ∀ i ∈ s, is_O_with (C i) l (A i) g) : + is_O_with (∑ i in s, C i) l (λ x, ∑ i in s, A i x) g := begin induction s using finset.induction_on with i s is IH, { simp only [is_O_with_zero', finset.sum_empty, forall_true_iff] }, @@ -1162,17 +1333,16 @@ begin exact (h _ (finset.mem_insert_self i s)).add (IH (λ j hj, h _ (finset.mem_insert_of_mem hj))) } end -theorem is_O.sum (h : ∀ i ∈ s, is_O (A i) g l) : - is_O (λ x, ∑ i in s, A i x) g l := +theorem is_O.sum (h : ∀ i ∈ s, A i =O[l] g) : + (λ x, ∑ i in s, A i x) =O[l] g := begin - induction s using finset.induction_on with i s is IH, - { simp only [is_O_zero, finset.sum_empty, forall_true_iff] }, - { simp only [is, finset.sum_insert, not_false_iff], - exact (h _ (finset.mem_insert_self i s)).add (IH (λ j hj, h _ (finset.mem_insert_of_mem hj))) } + unfold is_O at *, + choose! C hC using h, + exact ⟨_, is_O_with.sum hC⟩, end -theorem is_o.sum (h : ∀ i ∈ s, is_o (A i) g' l) : - is_o (λ x, ∑ i in s, A i x) g' l := +theorem is_o.sum (h : ∀ i ∈ s, (A i) =o[l] g') : + (λ x, ∑ i in s, A i x) =o[l] g' := begin induction s using finset.induction_on with i s is IH, { simp only [is_o_zero, finset.sum_empty, forall_true_iff] }, @@ -1184,51 +1354,41 @@ end sum /-! ### Relation between `f = o(g)` and `f / g → 0` -/ -theorem is_o.tendsto_div_nhds_zero {f g : α → 𝕜} {l : filter α} (h : is_o f g l) : +theorem is_o.tendsto_div_nhds_zero {f g : α → 𝕜} (h : f =o[l] g) : tendsto (λ x, f x / (g x)) l (𝓝 0) := -have eq₁ : is_o (λ x, f x / g x) (λ x, g x / g x) l, - by simpa only [div_eq_mul_inv] using h.mul_is_O (is_O_refl _ _), -have eq₂ : is_O (λ x, g x / g x) (λ x, (1 : 𝕜)) l, - from is_O_of_le _ (λ x, by simp [div_self_le_one]), -(is_o_one_iff 𝕜).mp (eq₁.trans_is_O eq₂) +(is_o_one_iff 𝕜).mp $ +calc (λ x, f x / g x) =o[l] (λ x, g x / g x) : + by simpa only [div_eq_mul_inv] using h.mul_is_O (is_O_refl _ _) +... =O[l] (λ x, (1 : 𝕜)) : + is_O_of_le _ (λ x, by simp [div_self_le_one]) theorem is_o.tendsto_inv_smul_nhds_zero [normed_space 𝕜 E'] {f : α → E'} {g : α → 𝕜} {l : filter α} - (h : is_o f g l) : tendsto (λ x, (g x)⁻¹ • f x) l (𝓝 0) := + (h : f =o[l] g) : tendsto (λ x, (g x)⁻¹ • f x) l (𝓝 0) := by simpa only [div_eq_inv_mul, ← norm_inv, ← norm_smul, ← tendsto_zero_iff_norm_tendsto_zero] using h.norm_norm.tendsto_div_nhds_zero -theorem is_o_iff_tendsto' {f g : α → 𝕜} {l : filter α} - (hgf : ∀ᶠ x in l, g x = 0 → f x = 0) : - is_o f g l ↔ tendsto (λ x, f x / (g x)) l (𝓝 0) := -iff.intro is_o.tendsto_div_nhds_zero $ λ h, +theorem is_o_iff_tendsto' {f g : α → 𝕜} (hgf : ∀ᶠ x in l, g x = 0 → f x = 0) : + f =o[l] g ↔ tendsto (λ x, f x / (g x)) l (𝓝 0) := +⟨is_o.tendsto_div_nhds_zero, λ h, (((is_o_one_iff _).mpr h).mul_is_O (is_O_refl g l)).congr' - (hgf.mono $ λ x, div_mul_cancel_of_imp) (eventually_of_forall $ λ x, one_mul _) + (hgf.mono $ λ x, div_mul_cancel_of_imp) (eventually_of_forall $ λ x, one_mul _)⟩ -theorem is_o_iff_tendsto {f g : α → 𝕜} {l : filter α} - (hgf : ∀ x, g x = 0 → f x = 0) : - is_o f g l ↔ tendsto (λ x, f x / (g x)) l (𝓝 0) := +theorem is_o_iff_tendsto {f g : α → 𝕜} (hgf : ∀ x, g x = 0 → f x = 0) : + f =o[l] g ↔ tendsto (λ x, f x / (g x)) l (𝓝 0) := is_o_iff_tendsto' (eventually_of_forall hgf) -alias is_o_iff_tendsto' ↔ _ asymptotics.is_o_of_tendsto' -alias is_o_iff_tendsto ↔ _ asymptotics.is_o_of_tendsto +alias is_o_iff_tendsto' ↔ _ is_o_of_tendsto' +alias is_o_iff_tendsto ↔ _ is_o_of_tendsto lemma is_o_const_left_of_ne {c : E''} (hc : c ≠ 0) : - is_o (λ x, c) g l ↔ tendsto (norm ∘ g) l at_top := + (λ x, c) =o[l] g ↔ tendsto (λ x, ‖g x‖) l at_top := begin - split; intro h, - { refine (at_top_basis' 1).tendsto_right_iff.2 (λ C hC, _), - replace hC : 0 < C := zero_lt_one.trans_le hC, - replace h : is_o (λ _, 1 : α → ℝ) g l := (is_O_const_const _ hc _).trans_is_o h, - refine (h.def $ inv_pos.2 hC).mono (λ x hx, _), - rwa [norm_one, ← div_eq_inv_mul, one_le_div hC] at hx }, - { suffices : is_o (λ _, 1 : α → ℝ) g l, - from (is_O_const_const c (@one_ne_zero ℝ _ _) _).trans_is_o this, - refine is_o_iff.2 (λ ε ε0, (tendsto_at_top.1 h ε⁻¹).mono (λ x hx, _)), - rwa [norm_one, ← inv_inv ε, ← div_eq_inv_mul, one_le_div (inv_pos.2 ε0)] } + simp only [← is_o_one_left_iff ℝ], + exact ⟨(is_O_const_const (1 : ℝ) hc l).trans_is_o, (is_O_const_one ℝ c l).trans_is_o⟩ end @[simp] lemma is_o_const_left {c : E''} : - is_o (λ x, c) g'' l ↔ c = 0 ∨ tendsto (norm ∘ g'') l at_top := + (λ x, c) =o[l] g'' ↔ c = 0 ∨ tendsto (norm ∘ g'') l at_top := begin rcases eq_or_ne c 0 with rfl | hc, { simp only [is_o_zero, eq_self_iff_true, true_or] }, @@ -1236,22 +1396,22 @@ begin end @[simp] theorem is_o_const_const_iff [ne_bot l] {d : E''} {c : F''} : - is_o (λ x, d) (λ x, c) l ↔ d = 0 := -have ¬tendsto (function.const α ∥c∥) l at_top, + (λ x, d) =o[l] (λ x, c) ↔ d = 0 := +have ¬tendsto (function.const α ‖c‖) l at_top, from not_tendsto_at_top_of_tendsto_nhds tendsto_const_nhds, by simp [function.const, this] -@[simp] lemma is_o_pure {x} : is_o f'' g'' (pure x) ↔ f'' x = 0 := -calc is_o f'' g'' (pure x) ↔ is_o (λ y : α, f'' x) (λ _, g'' x) (pure x) : is_o_congr rfl rfl - ... ↔ f'' x = 0 : is_o_const_const_iff +@[simp] lemma is_o_pure {x} : f'' =o[pure x] g'' ↔ f'' x = 0 := +calc f'' =o[pure x] g'' ↔ (λ y : α, f'' x) =o[pure x] (λ _, g'' x) : is_o_congr rfl rfl + ... ↔ f'' x = 0 : is_o_const_const_iff -lemma is_o_const_id_comap_norm_at_top (c : F'') : is_o (λ x : E'', c) id (comap norm at_top) := +lemma is_o_const_id_comap_norm_at_top (c : F'') : (λ x : E'', c) =o[comap norm at_top] id := is_o_const_left.2 $ or.inr tendsto_comap -lemma is_o_const_id_at_top (c : E'') : is_o (λ x : ℝ, c) id at_top := +lemma is_o_const_id_at_top (c : E'') : (λ x : ℝ, c) =o[at_top] id := is_o_const_left.2 $ or.inr tendsto_abs_at_top_at_top -lemma is_o_const_id_at_bot (c : E'') : is_o (λ x : ℝ, c) id at_bot := +lemma is_o_const_id_at_bot (c : E'') : (λ x : ℝ, c) =o[at_bot] id := is_o_const_left.2 $ or.inr tendsto_abs_at_bot_at_top /-! @@ -1265,16 +1425,16 @@ section eventually_mul_div_cancel variables {u v : α → 𝕜} -lemma is_O_with.eventually_mul_div_cancel (h : is_O_with c u v l) : +lemma is_O_with.eventually_mul_div_cancel (h : is_O_with c l u v) : (u / v) * v =ᶠ[l] u := eventually.mono h.bound (λ y hy, div_mul_cancel_of_imp $ λ hv, by simpa [hv] using hy) /-- If `u = O(v)` along `l`, then `(u / v) * v = u` eventually at `l`. -/ -lemma is_O.eventually_mul_div_cancel (h : is_O u v l) : (u / v) * v =ᶠ[l] u := +lemma is_O.eventually_mul_div_cancel (h : u =O[l] v) : (u / v) * v =ᶠ[l] u := let ⟨c, hc⟩ := h.is_O_with in hc.eventually_mul_div_cancel /-- If `u = o(v)` along `l`, then `(u / v) * v = u` eventually at `l`. -/ -lemma is_o.eventually_mul_div_cancel (h : is_o u v l) : (u / v) * v =ᶠ[l] u := +lemma is_o.eventually_mul_div_cancel (h : u =o[l] v) : (u / v) * v =ᶠ[l] u := (h.forall_is_O_with zero_lt_one).eventually_mul_div_cancel end eventually_mul_div_cancel @@ -1285,20 +1445,20 @@ section exists_mul_eq variables {u v : α → 𝕜} -/-- If `∥φ∥` is eventually bounded by `c`, and `u =ᶠ[l] φ * v`, then we have `is_O_with c u v l`. +/-- If `‖φ‖` is eventually bounded by `c`, and `u =ᶠ[l] φ * v`, then we have `is_O_with c u v l`. This does not require any assumptions on `c`, which is why we keep this version along with `is_O_with_iff_exists_eq_mul`. -/ -lemma is_O_with_of_eq_mul (φ : α → 𝕜) (hφ : ∀ᶠ x in l, ∥φ x∥ ≤ c) (h : u =ᶠ[l] φ * v) : - is_O_with c u v l := +lemma is_O_with_of_eq_mul (φ : α → 𝕜) (hφ : ∀ᶠ x in l, ‖φ x‖ ≤ c) (h : u =ᶠ[l] φ * v) : + is_O_with c l u v := begin unfold is_O_with, - refine h.symm.rw (λ x a, ∥a∥ ≤ c * ∥v x∥) (hφ.mono $ λ x hx, _), + refine h.symm.rw (λ x a, ‖a‖ ≤ c * ‖v x‖) (hφ.mono $ λ x hx, _), simp only [norm_mul, pi.mul_apply], exact mul_le_mul_of_nonneg_right hx (norm_nonneg _) end lemma is_O_with_iff_exists_eq_mul (hc : 0 ≤ c) : - is_O_with c u v l ↔ ∃ (φ : α → 𝕜) (hφ : ∀ᶠ x in l, ∥φ x∥ ≤ c), u =ᶠ[l] φ * v := + is_O_with c l u v ↔ ∃ (φ : α → 𝕜) (hφ : ∀ᶠ x in l, ‖φ x‖ ≤ c), u =ᶠ[l] φ * v := begin split, { intro h, @@ -1309,12 +1469,12 @@ begin exact is_O_with_of_eq_mul φ hφ h } end -lemma is_O_with.exists_eq_mul (h : is_O_with c u v l) (hc : 0 ≤ c) : - ∃ (φ : α → 𝕜) (hφ : ∀ᶠ x in l, ∥φ x∥ ≤ c), u =ᶠ[l] φ * v := +lemma is_O_with.exists_eq_mul (h : is_O_with c l u v) (hc : 0 ≤ c) : + ∃ (φ : α → 𝕜) (hφ : ∀ᶠ x in l, ‖φ x‖ ≤ c), u =ᶠ[l] φ * v := (is_O_with_iff_exists_eq_mul hc).mp h lemma is_O_iff_exists_eq_mul : - is_O u v l ↔ ∃ (φ : α → 𝕜) (hφ : l.is_bounded_under (≤) (norm ∘ φ)), u =ᶠ[l] φ * v := + u =O[l] v ↔ ∃ (φ : α → 𝕜) (hφ : l.is_bounded_under (≤) (norm ∘ φ)), u =ᶠ[l] φ * v := begin split, { rintros h, @@ -1325,92 +1485,107 @@ begin exact is_O_iff_is_O_with.2 ⟨c, is_O_with_of_eq_mul φ hφ huvφ⟩ } end -alias is_O_iff_exists_eq_mul ↔ asymptotics.is_O.exists_eq_mul _ +alias is_O_iff_exists_eq_mul ↔ is_O.exists_eq_mul _ lemma is_o_iff_exists_eq_mul : - is_o u v l ↔ ∃ (φ : α → 𝕜) (hφ : tendsto φ l (𝓝 0)), u =ᶠ[l] φ * v := + u =o[l] v ↔ ∃ (φ : α → 𝕜) (hφ : tendsto φ l (𝓝 0)), u =ᶠ[l] φ * v := begin split, { exact λ h, ⟨λ x, u x / v x, h.tendsto_div_nhds_zero, h.eventually_mul_div_cancel.symm⟩ }, { unfold is_o, rintros ⟨φ, hφ, huvφ⟩ c hpos, - rw normed_group.tendsto_nhds_zero at hφ, + rw normed_add_comm_group.tendsto_nhds_zero at hφ, exact is_O_with_of_eq_mul _ ((hφ c hpos).mono $ λ x, le_of_lt) huvφ } end -alias is_o_iff_exists_eq_mul ↔ asymptotics.is_o.exists_eq_mul _ +alias is_o_iff_exists_eq_mul ↔ is_o.exists_eq_mul _ end exists_mul_eq /-! ### Miscellanous lemmas -/ theorem div_is_bounded_under_of_is_O {α : Type*} {l : filter α} - {f g : α → 𝕜} (h : is_O f g l) : - is_bounded_under (≤) l (λ x, ∥f x / g x∥) := + {f g : α → 𝕜} (h : f =O[l] g) : + is_bounded_under (≤) l (λ x, ‖f x / g x‖) := begin - obtain ⟨c, hc⟩ := is_O_iff.mp h, - refine ⟨max c 0, eventually_map.2 (filter.mem_of_superset hc (λ x hx, _))⟩, - simp only [mem_set_of_eq, norm_div] at ⊢ hx, - by_cases hgx : g x = 0, - { rw [hgx, norm_zero, div_zero, le_max_iff], - exact or.inr le_rfl }, - { exact le_max_iff.2 (or.inl ((div_le_iff (norm_pos_iff.2 hgx)).2 hx)) } + obtain ⟨c, h₀, hc⟩ := h.exists_nonneg, + refine ⟨c, eventually_map.2 (hc.bound.mono (λ x hx, _))⟩, + rw [norm_div], + exact div_le_of_nonneg_of_le_mul (norm_nonneg _) h₀ hx, end theorem is_O_iff_div_is_bounded_under {α : Type*} {l : filter α} {f g : α → 𝕜} (hgf : ∀ᶠ x in l, g x = 0 → f x = 0) : - is_O f g l ↔ is_bounded_under (≤) l (λ x, ∥f x / g x∥) := + f =O[l] g ↔ is_bounded_under (≤) l (λ x, ‖f x / g x‖) := begin refine ⟨div_is_bounded_under_of_is_O, λ h, _⟩, obtain ⟨c, hc⟩ := h, - rw filter.eventually_iff at hgf hc, - simp only [mem_set_of_eq, mem_map, norm_div] at hc, - refine is_O_iff.2 ⟨c, filter.eventually_of_mem (inter_mem hgf hc) (λ x hx, _)⟩, + simp only [eventually_map, norm_div] at hc, + refine is_O.of_bound c (hc.mp $ hgf.mono (λ x hx₁ hx₂, _)), by_cases hgx : g x = 0, - { simp [hx.1 hgx, hgx] }, - { refine (div_le_iff (norm_pos_iff.2 hgx)).mp hx.2 }, + { simp [hx₁ hgx, hgx] }, + { exact (div_le_iff (norm_pos_iff.2 hgx)).mp hx₂ }, end theorem is_O_of_div_tendsto_nhds {α : Type*} {l : filter α} {f g : α → 𝕜} (hgf : ∀ᶠ x in l, g x = 0 → f x = 0) (c : 𝕜) (H : filter.tendsto (f / g) l (𝓝 c)) : - is_O f g l := + f =O[l] g := (is_O_iff_div_is_bounded_under hgf).2 $ H.norm.is_bounded_under_le -lemma is_o.tendsto_zero_of_tendsto {α E 𝕜 : Type*} [normed_group E] [normed_field 𝕜] {u : α → E} - {v : α → 𝕜} {l : filter α} {y : 𝕜} (huv : is_o u v l) (hv : tendsto v l (𝓝 y)) : +lemma is_o.tendsto_zero_of_tendsto {α E 𝕜 : Type*} [normed_add_comm_group E] [normed_field 𝕜] + {u : α → E} {v : α → 𝕜} {l : filter α} {y : 𝕜} (huv : u =o[l] v) (hv : tendsto v l (𝓝 y)) : tendsto u l (𝓝 0) := begin - suffices h : is_o u (λ x, (1 : 𝕜)) l, + suffices h : u =o[l] (λ x, (1 : 𝕜)), { rwa is_o_one_iff at h }, - exact huv.trans_is_O (is_O_one_of_tendsto 𝕜 hv), + exact huv.trans_is_O (hv.is_O_one 𝕜), end theorem is_o_pow_pow {m n : ℕ} (h : m < n) : - is_o (λ(x : 𝕜), x^n) (λx, x^m) (𝓝 0) := + (λ x : 𝕜, x ^ n) =o[𝓝 0] (λ x, x ^ m) := begin - let p := n - m, - have nmp : n = m + p := (add_tsub_cancel_of_le (le_of_lt h)).symm, - have : (λ(x : 𝕜), x^m) = (λx, x^m * 1), by simp only [mul_one], - simp only [this, pow_add, nmp], - refine is_O.mul_is_o (is_O_refl _ _) ((is_o_one_iff _).2 _), - convert (continuous_pow p).tendsto (0 : 𝕜), - exact (zero_pow (tsub_pos_of_lt h)).symm + rcases lt_iff_exists_add.1 h with ⟨p, hp0 : 0 < p, rfl⟩, + suffices : (λ x : 𝕜, x ^ m * x ^ p) =o[𝓝 0] (λ x, x ^ m * 1 ^ p), + by simpa only [pow_add, one_pow, mul_one], + exact is_O.mul_is_o (is_O_refl _ _) (is_o.pow ((is_o_one_iff _).2 tendsto_id) hp0) end theorem is_o_norm_pow_norm_pow {m n : ℕ} (h : m < n) : - is_o (λ(x : E'), ∥x∥^n) (λx, ∥x∥^m) (𝓝 (0 : E')) := + (λ x : E', ‖x‖^n) =o[𝓝 0] (λ x, ‖x‖^m) := (is_o_pow_pow h).comp_tendsto tendsto_norm_zero theorem is_o_pow_id {n : ℕ} (h : 1 < n) : - is_o (λ(x : 𝕜), x^n) (λx, x) (𝓝 0) := + (λ x : 𝕜, x^n) =o[𝓝 0] (λ x, x) := by { convert is_o_pow_pow h, simp only [pow_one] } theorem is_o_norm_pow_id {n : ℕ} (h : 1 < n) : - is_o (λ(x : E'), ∥x∥^n) (λx, x) (𝓝 0) := + (λ x : E', ‖x‖^n) =o[𝓝 0] (λ x, x) := by simpa only [pow_one, is_o_norm_right] using @is_o_norm_pow_norm_pow E' _ _ _ h -theorem is_O_with.right_le_sub_of_lt_1 {f₁ f₂ : α → E'} (h : is_O_with c f₁ f₂ l) (hc : c < 1) : - is_O_with (1 / (1 - c)) f₂ (λx, f₂ x - f₁ x) l := +lemma is_O.eq_zero_of_norm_pow_within {f : E'' → F''} {s : set E''} {x₀ : E''} {n : ℕ} + (h : f =O[𝓝[s] x₀] λ x, ‖x - x₀‖ ^ n) (hx₀ : x₀ ∈ s) (hn : 0 < n) : f x₀ = 0 := +mem_of_mem_nhds_within hx₀ h.eq_zero_imp $ by simp_rw [sub_self, norm_zero, zero_pow hn] + +lemma is_O.eq_zero_of_norm_pow {f : E'' → F''} {x₀ : E''} {n : ℕ} + (h : f =O[𝓝 x₀] λ x, ‖x - x₀‖ ^ n) (hn : 0 < n) : f x₀ = 0 := +by { rw [← nhds_within_univ] at h, exact h.eq_zero_of_norm_pow_within (mem_univ _) hn } + +lemma is_o_pow_sub_pow_sub (x₀ : E') {n m : ℕ} (h : n < m) : + (λ x, ‖x - x₀‖ ^ m) =o[𝓝 x₀] λ x, ‖x - x₀‖^n := +begin + have : tendsto (λ x, ‖x - x₀‖) (𝓝 x₀) (𝓝 0), + { apply tendsto_norm_zero.comp, + rw ← sub_self x₀, + exact tendsto_id.sub tendsto_const_nhds }, + exact (is_o_pow_pow h).comp_tendsto this +end + +lemma is_o_pow_sub_sub (x₀ : E') {m : ℕ} (h : 1 < m) : + (λ x, ‖x - x₀‖^m) =o[𝓝 x₀] λ x, x - x₀ := +by simpa only [is_o_norm_right, pow_one] using is_o_pow_sub_pow_sub x₀ h + +theorem is_O_with.right_le_sub_of_lt_1 {f₁ f₂ : α → E'} (h : is_O_with c l f₁ f₂) (hc : c < 1) : + is_O_with (1 / (1 - c)) l f₂ (λx, f₂ x - f₁ x) := is_O_with.of_bound $ mem_of_superset h.bound $ λ x hx, begin simp only [mem_set_of_eq] at hx ⊢, @@ -1419,69 +1594,69 @@ begin { exact sub_pos.2 hc } end -theorem is_O_with.right_le_add_of_lt_1 {f₁ f₂ : α → E'} (h : is_O_with c f₁ f₂ l) (hc : c < 1) : - is_O_with (1 / (1 - c)) f₂ (λx, f₁ x + f₂ x) l := +theorem is_O_with.right_le_add_of_lt_1 {f₁ f₂ : α → E'} (h : is_O_with c l f₁ f₂) (hc : c < 1) : + is_O_with (1 / (1 - c)) l f₂ (λx, f₁ x + f₂ x) := (h.neg_right.right_le_sub_of_lt_1 hc).neg_right.of_neg_left.congr rfl (λ x, rfl) (λ x, by rw [neg_sub, sub_neg_eq_add]) -theorem is_o.right_is_O_sub {f₁ f₂ : α → E'} (h : is_o f₁ f₂ l) : - is_O f₂ (λx, f₂ x - f₁ x) l := +theorem is_o.right_is_O_sub {f₁ f₂ : α → E'} (h : f₁ =o[l] f₂) : + f₂ =O[l] (λx, f₂ x - f₁ x) := ((h.def' one_half_pos).right_le_sub_of_lt_1 one_half_lt_one).is_O -theorem is_o.right_is_O_add {f₁ f₂ : α → E'} (h : is_o f₁ f₂ l) : - is_O f₂ (λx, f₁ x + f₂ x) l := +theorem is_o.right_is_O_add {f₁ f₂ : α → E'} (h : f₁ =o[l] f₂) : + f₂ =O[l] (λx, f₁ x + f₂ x) := ((h.def' one_half_pos).right_le_add_of_lt_1 one_half_lt_one).is_O /-- If `f x = O(g x)` along `cofinite`, then there exists a positive constant `C` such that -`∥f x∥ ≤ C * ∥g x∥` whenever `g x ≠ 0`. -/ -theorem bound_of_is_O_cofinite (h : is_O f g'' cofinite) : - ∃ C > 0, ∀ ⦃x⦄, g'' x ≠ 0 → ∥f x∥ ≤ C * ∥g'' x∥ := +`‖f x‖ ≤ C * ‖g x‖` whenever `g x ≠ 0`. -/ +theorem bound_of_is_O_cofinite (h : f =O[cofinite] g'') : + ∃ C > 0, ∀ ⦃x⦄, g'' x ≠ 0 → ‖f x‖ ≤ C * ‖g'' x‖ := begin rcases h.exists_pos with ⟨C, C₀, hC⟩, rw [is_O_with, eventually_cofinite] at hC, - rcases (hC.to_finset.image (λ x, ∥f x∥ / ∥g'' x∥)).exists_le with ⟨C', hC'⟩, - have : ∀ x, C * ∥g'' x∥ < ∥f x∥ → ∥f x∥ / ∥g'' x∥ ≤ C', by simpa using hC', + rcases (hC.to_finset.image (λ x, ‖f x‖ / ‖g'' x‖)).exists_le with ⟨C', hC'⟩, + have : ∀ x, C * ‖g'' x‖ < ‖f x‖ → ‖f x‖ / ‖g'' x‖ ≤ C', by simpa using hC', refine ⟨max C C', lt_max_iff.2 (or.inl C₀), λ x h₀, _⟩, rw [max_mul_of_nonneg _ _ (norm_nonneg _), le_max_iff, or_iff_not_imp_left, not_le], exact λ hx, (div_le_iff (norm_pos_iff.2 h₀)).1 (this _ hx) end theorem is_O_cofinite_iff (h : ∀ x, g'' x = 0 → f'' x = 0) : - is_O f'' g'' cofinite ↔ ∃ C, ∀ x, ∥f'' x∥ ≤ C * ∥g'' x∥ := + f'' =O[cofinite] g'' ↔ ∃ C, ∀ x, ‖f'' x‖ ≤ C * ‖g'' x‖ := ⟨λ h', let ⟨C, C₀, hC⟩ := bound_of_is_O_cofinite h' in ⟨C, λ x, if hx : g'' x = 0 then by simp [h _ hx, hx] else hC hx⟩, λ h, (is_O_top.2 h).mono le_top⟩ -theorem bound_of_is_O_nat_at_top {f : ℕ → E} {g'' : ℕ → E''} (h : is_O f g'' at_top) : - ∃ C > 0, ∀ ⦃x⦄, g'' x ≠ 0 → ∥f x∥ ≤ C * ∥g'' x∥ := +theorem bound_of_is_O_nat_at_top {f : ℕ → E} {g'' : ℕ → E''} (h : f =O[at_top] g'') : + ∃ C > 0, ∀ ⦃x⦄, g'' x ≠ 0 → ‖f x‖ ≤ C * ‖g'' x‖ := bound_of_is_O_cofinite $ by rwa nat.cofinite_eq_at_top theorem is_O_nat_at_top_iff {f : ℕ → E''} {g : ℕ → F''} (h : ∀ x, g x = 0 → f x = 0) : - is_O f g at_top ↔ ∃ C, ∀ x, ∥f x∥ ≤ C * ∥g x∥ := + f =O[at_top] g ↔ ∃ C, ∀ x, ‖f x‖ ≤ C * ‖g x‖ := by rw [← nat.cofinite_eq_at_top, is_O_cofinite_iff h] theorem is_O_one_nat_at_top_iff {f : ℕ → E''} : - is_O f (λ n, 1 : ℕ → ℝ) at_top ↔ ∃ C, ∀ n, ∥f n∥ ≤ C := + f =O[at_top] (λ n, 1 : ℕ → ℝ) ↔ ∃ C, ∀ n, ‖f n‖ ≤ C := iff.trans (is_O_nat_at_top_iff (λ n h, (one_ne_zero h).elim)) $ by simp only [norm_one, mul_one] -theorem is_O_with_pi {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_group (E' i)] +theorem is_O_with_pi {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_add_comm_group (E' i)] {f : α → Π i, E' i} {C : ℝ} (hC : 0 ≤ C) : - is_O_with C f g' l ↔ ∀ i, is_O_with C (λ x, f x i) g' l := -have ∀ x, 0 ≤ C * ∥g' x∥, from λ x, mul_nonneg hC (norm_nonneg _), -by simp only [is_O_with_iff, pi_norm_le_iff (this _), eventually_all] + is_O_with C l f g' ↔ ∀ i, is_O_with C l (λ x, f x i) g' := +have ∀ x, 0 ≤ C * ‖g' x‖, from λ x, mul_nonneg hC (norm_nonneg _), +by simp only [is_O_with_iff, pi_norm_le_iff_of_nonneg (this _), eventually_all] -@[simp] theorem is_O_pi {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_group (E' i)] +@[simp] theorem is_O_pi {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_add_comm_group (E' i)] {f : α → Π i, E' i} : - is_O f g' l ↔ ∀ i, is_O (λ x, f x i) g' l := + f =O[l] g' ↔ ∀ i, (λ x, f x i) =O[l] g' := begin simp only [is_O_iff_eventually_is_O_with, ← eventually_all], exact eventually_congr (eventually_at_top.2 ⟨0, λ c, is_O_with_pi⟩) end -@[simp] theorem is_o_pi {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_group (E' i)] +@[simp] theorem is_o_pi {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_add_comm_group (E' i)] {f : α → Π i, E' i} : - is_o f g' l ↔ ∀ i, is_o (λ x, f x i) g' l := + f =o[l] g' ↔ ∀ i, (λ x, f x i) =o[l] g' := begin simp only [is_o, is_O_with_pi, le_of_lt] { contextual := tt }, exact ⟨λ h i c hc, h hc i, λ h c hc i, h i hc⟩ @@ -1491,13 +1666,13 @@ end asymptotics open asymptotics -lemma summable_of_is_O {ι E} [normed_group E] [complete_space E] {f : ι → E} {g : ι → ℝ} - (hg : summable g) (h : is_O f g cofinite) : summable f := +lemma summable_of_is_O {ι E} [normed_add_comm_group E] [complete_space E] {f : ι → E} {g : ι → ℝ} + (hg : summable g) (h : f =O[cofinite] g) : summable f := let ⟨C, hC⟩ := h.is_O_with in -summable_of_norm_bounded_eventually (λ x, C * ∥g x∥) (hg.abs.mul_left _) hC.bound +summable_of_norm_bounded_eventually (λ x, C * ‖g x‖) (hg.abs.mul_left _) hC.bound -lemma summable_of_is_O_nat {E} [normed_group E] [complete_space E] {f : ℕ → E} {g : ℕ → ℝ} - (hg : summable g) (h : is_O f g at_top) : summable f := +lemma summable_of_is_O_nat {E} [normed_add_comm_group E] [complete_space E] {f : ℕ → E} {g : ℕ → ℝ} + (hg : summable g) (h : f =O[at_top] g) : summable f := summable_of_is_O hg $ nat.cofinite_eq_at_top.symm ▸ h namespace local_homeomorph @@ -1509,7 +1684,7 @@ variables {E : Type*} [has_norm E] {F : Type*} [has_norm F] /-- Transfer `is_O_with` over a `local_homeomorph`. -/ lemma is_O_with_congr (e : local_homeomorph α β) {b : β} (hb : b ∈ e.target) {f : β → E} {g : β → F} {C : ℝ} : - is_O_with C f g (𝓝 b) ↔ is_O_with C (f ∘ e) (g ∘ e) (𝓝 (e.symm b)) := + is_O_with C (𝓝 b) f g ↔ is_O_with C (𝓝 (e.symm b)) (f ∘ e) (g ∘ e) := ⟨λ h, h.comp_tendsto $ by { convert e.continuous_at (e.map_target hb), exact (e.right_inv hb).symm }, λ h, (h.comp_tendsto (e.continuous_at_symm hb)).congr' rfl @@ -1518,12 +1693,12 @@ lemma is_O_with_congr (e : local_homeomorph α β) {b : β} (hb : b ∈ e.target /-- Transfer `is_O` over a `local_homeomorph`. -/ lemma is_O_congr (e : local_homeomorph α β) {b : β} (hb : b ∈ e.target) {f : β → E} {g : β → F} : - is_O f g (𝓝 b) ↔ is_O (f ∘ e) (g ∘ e) (𝓝 (e.symm b)) := + f =O[𝓝 b] g ↔ (f ∘ e) =O[𝓝 (e.symm b)] (g ∘ e) := by { unfold is_O, exact exists_congr (λ C, e.is_O_with_congr hb) } /-- Transfer `is_o` over a `local_homeomorph`. -/ lemma is_o_congr (e : local_homeomorph α β) {b : β} (hb : b ∈ e.target) {f : β → E} {g : β → F} : - is_o f g (𝓝 b) ↔ is_o (f ∘ e) (g ∘ e) (𝓝 (e.symm b)) := + f =o[𝓝 b] g ↔ (f ∘ e) =o[𝓝 (e.symm b)] (g ∘ e) := by { unfold is_o, exact forall₂_congr (λ c hc, e.is_O_with_congr hb) } end local_homeomorph @@ -1538,17 +1713,17 @@ open asymptotics /-- Transfer `is_O_with` over a `homeomorph`. -/ lemma is_O_with_congr (e : α ≃ₜ β) {b : β} {f : β → E} {g : β → F} {C : ℝ} : - is_O_with C f g (𝓝 b) ↔ is_O_with C (f ∘ e) (g ∘ e) (𝓝 (e.symm b)) := + is_O_with C (𝓝 b) f g ↔ is_O_with C (𝓝 (e.symm b)) (f ∘ e) (g ∘ e) := e.to_local_homeomorph.is_O_with_congr trivial /-- Transfer `is_O` over a `homeomorph`. -/ lemma is_O_congr (e : α ≃ₜ β) {b : β} {f : β → E} {g : β → F} : - is_O f g (𝓝 b) ↔ is_O (f ∘ e) (g ∘ e) (𝓝 (e.symm b)) := + f =O[𝓝 b] g ↔ (f ∘ e) =O[𝓝 (e.symm b)] (g ∘ e) := by { unfold is_O, exact exists_congr (λ C, e.is_O_with_congr) } /-- Transfer `is_o` over a `homeomorph`. -/ lemma is_o_congr (e : α ≃ₜ β) {b : β} {f : β → E} {g : β → F} : - is_o f g (𝓝 b) ↔ is_o (f ∘ e) (g ∘ e) (𝓝 (e.symm b)) := + f =o[𝓝 b] g ↔ (f ∘ e) =o[𝓝 (e.symm b)] (g ∘ e) := by { unfold is_o, exact forall₂_congr (λ c hc, e.is_O_with_congr) } end homeomorph diff --git a/src/analysis/asymptotics/specific_asymptotics.lean b/src/analysis/asymptotics/specific_asymptotics.lean index 3e1d8c52e0e4c..b98632ff3194e 100644 --- a/src/analysis/asymptotics/specific_asymptotics.lean +++ b/src/analysis/asymptotics/specific_asymptotics.lean @@ -3,18 +3,21 @@ Copyright (c) 2021 Anatole Dedecker. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Anatole Dedecker -/ -import analysis.normed_space.ordered +import analysis.normed.order.basic import analysis.asymptotics.asymptotics /-! # A collection of specific asymptotic results +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains specific lemmas about asymptotics which don't have their place in the general theory developped in `analysis.asymptotics.asymptotics`. -/ open filter asymptotics -open_locale topological_space +open_locale topology section normed_field @@ -22,9 +25,9 @@ section normed_field `x → a`, `x ≠ a`. -/ lemma filter.is_bounded_under.is_o_sub_self_inv {𝕜 E : Type*} [normed_field 𝕜] [has_norm E] {a : 𝕜} {f : 𝕜 → E} (h : is_bounded_under (≤) (𝓝[≠] a) (norm ∘ f)) : - is_o f (λ x, (x - a)⁻¹) (𝓝[≠] a) := + f =o[𝓝[≠] a] (λ x, (x - a)⁻¹) := begin - refine (h.is_O_const (@one_ne_zero ℝ _ _)).trans_is_o (is_o_const_left.2 $ or.inr _), + refine (h.is_O_const (one_ne_zero' ℝ)).trans_is_o (is_o_const_left.2 $ or.inr _), simp only [(∘), norm_inv], exact (tendsto_norm_sub_self_punctured_nhds a).inv_tendsto_zero end @@ -46,7 +49,7 @@ lemma pow_div_pow_eventually_eq_at_bot {p q : ℕ} : (λ x : 𝕜, x^p / x^q) =ᶠ[at_bot] (λ x, x^((p : ℤ) -q)) := begin apply ((eventually_lt_at_bot (0 : 𝕜)).mono (λ x hx, _)), - simp [zpow_sub₀ hx.ne'.symm], + simp [zpow_sub₀ hx.ne], end lemma tendsto_zpow_at_top_at_top {n : ℤ} @@ -54,7 +57,7 @@ lemma tendsto_zpow_at_top_at_top {n : ℤ} begin lift n to ℕ using hn.le, simp only [zpow_coe_nat], - exact tendsto_pow_at_top (nat.succ_le_iff.mpr $int.coe_nat_pos.mp hn) + exact tendsto_pow_at_top (nat.cast_pos.mp hn).ne' end lemma tendsto_pow_div_pow_at_top_at_top {p q : ℕ} @@ -81,14 +84,14 @@ variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜] lemma asymptotics.is_o_pow_pow_at_top_of_lt [order_topology 𝕜] {p q : ℕ} (hpq : p < q) : - is_o (λ x : 𝕜, x^p) (λ x, x^q) at_top := + (λ x : 𝕜, x^p) =o[at_top] (λ x, x^q) := begin refine (is_o_iff_tendsto' _).mpr (tendsto_pow_div_pow_at_top_zero hpq), exact (eventually_gt_at_top 0).mono (λ x hx hxq, (pow_ne_zero q hx.ne' hxq).elim), end lemma asymptotics.is_O.trans_tendsto_norm_at_top {α : Type*} {u v : α → 𝕜} {l : filter α} - (huv : is_O u v l) (hu : tendsto (λ x, ∥u x∥) l at_top) : tendsto (λ x, ∥v x∥) l at_top := + (huv : u =O[l] v) (hu : tendsto (λ x, ‖u x‖) l at_top) : tendsto (λ x, ‖v x‖) l at_top := begin rcases huv.exists_pos with ⟨c, hc, hcuv⟩, rw is_O_with at hcuv, @@ -104,29 +107,29 @@ section real open_locale big_operators open finset -lemma asymptotics.is_o.sum_range {α : Type*} [normed_group α] - {f : ℕ → α} {g : ℕ → ℝ} (h : is_o f g at_top) +lemma asymptotics.is_o.sum_range {α : Type*} [normed_add_comm_group α] + {f : ℕ → α} {g : ℕ → ℝ} (h : f =o[at_top] g) (hg : 0 ≤ g) (h'g : tendsto (λ n, ∑ i in range n, g i) at_top at_top) : - is_o (λ n, ∑ i in range n, f i) (λ n, ∑ i in range n, g i) at_top := + (λ n, ∑ i in range n, f i) =o[at_top] (λ n, ∑ i in range n, g i) := begin - have A : ∀ i, ∥g i∥ = g i := λ i, real.norm_of_nonneg (hg i), - have B : ∀ n, ∥∑ i in range n, g i∥ = ∑ i in range n, g i, + have A : ∀ i, ‖g i‖ = g i := λ i, real.norm_of_nonneg (hg i), + have B : ∀ n, ‖∑ i in range n, g i‖ = ∑ i in range n, g i, from λ n, by rwa [real.norm_eq_abs, abs_sum_of_nonneg'], apply is_o_iff.2 (λ ε εpos, _), - obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (b : ℕ), N ≤ b → ∥f b∥ ≤ ε / 2 * g b, + obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (b : ℕ), N ≤ b → ‖f b‖ ≤ ε / 2 * g b, by simpa only [A, eventually_at_top] using is_o_iff.mp h (half_pos εpos), - have : is_o (λ (n : ℕ), ∑ i in range N, f i) (λ (n : ℕ), ∑ i in range n, g i) at_top, + have : (λ (n : ℕ), ∑ i in range N, f i) =o[at_top] (λ (n : ℕ), ∑ i in range n, g i), { apply is_o_const_left.2, exact or.inr (h'g.congr (λ n, (B n).symm)) }, filter_upwards [is_o_iff.1 this (half_pos εpos), Ici_mem_at_top N] with n hn Nn, - calc ∥∑ i in range n, f i∥ - = ∥∑ i in range N, f i + ∑ i in Ico N n, f i∥ : + calc ‖∑ i in range n, f i‖ + = ‖∑ i in range N, f i + ∑ i in Ico N n, f i‖ : by rw sum_range_add_sum_Ico _ Nn - ... ≤ ∥∑ i in range N, f i∥ + ∥∑ i in Ico N n, f i∥ : + ... ≤ ‖∑ i in range N, f i‖ + ‖∑ i in Ico N n, f i‖ : norm_add_le _ _ - ... ≤ ∥∑ i in range N, f i∥ + ∑ i in Ico N n, (ε / 2) * g i : + ... ≤ ‖∑ i in range N, f i‖ + ∑ i in Ico N n, (ε / 2) * g i : add_le_add le_rfl (norm_sum_le_of_le _ (λ i hi, hN _ (mem_Ico.1 hi).1)) - ... ≤ ∥∑ i in range N, f i∥ + ∑ i in range n, (ε / 2) * g i : + ... ≤ ‖∑ i in range N, f i‖ + ∑ i in range n, (ε / 2) * g i : begin refine add_le_add le_rfl _, apply sum_le_sum_of_subset_of_nonneg, @@ -135,17 +138,17 @@ begin { assume i hi hident, exact mul_nonneg (half_pos εpos).le (hg i) } end - ... ≤ (ε / 2) * ∥∑ i in range n, g i∥ + (ε / 2) * (∑ i in range n, g i) : + ... ≤ (ε / 2) * ‖∑ i in range n, g i‖ + (ε / 2) * (∑ i in range n, g i) : begin rw ← mul_sum, exact add_le_add hn (mul_le_mul_of_nonneg_left le_rfl (half_pos εpos).le), end - ... = ε * ∥(∑ i in range n, g i)∥ : by { simp [B], ring } + ... = ε * ‖(∑ i in range n, g i)‖ : by { simp [B], ring } end -lemma asymptotics.is_o_sum_range_of_tendsto_zero {α : Type*} [normed_group α] +lemma asymptotics.is_o_sum_range_of_tendsto_zero {α : Type*} [normed_add_comm_group α] {f : ℕ → α} (h : tendsto f at_top (𝓝 0)) : - is_o (λ n, ∑ i in range n, f i) (λ n, (n : ℝ)) at_top := + (λ n, ∑ i in range n, f i) =o[at_top] (λ n, (n : ℝ)) := begin have := ((is_o_one_iff ℝ).2 h).sum_range (λ i, zero_le_one), simp only [sum_const, card_range, nat.smul_one_eq_coe] at this, @@ -153,7 +156,7 @@ begin end /-- The Cesaro average of a converging sequence converges to the same limit. -/ -lemma filter.tendsto.cesaro_smul {E : Type*} [normed_group E] [normed_space ℝ E] +lemma filter.tendsto.cesaro_smul {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {u : ℕ → E} {l : E} (h : tendsto u at_top (𝓝 l)) : tendsto (λ (n : ℕ), (n ⁻¹ : ℝ) • (∑ i in range n, u i)) at_top (𝓝 l) := begin @@ -170,8 +173,7 @@ begin end /-- The Cesaro average of a converging sequence converges to the same limit. -/ -lemma filter.tendsto.cesaro - {u : ℕ → ℝ} {l : ℝ} (h : tendsto u at_top (𝓝 l)) : +lemma filter.tendsto.cesaro {u : ℕ → ℝ} {l : ℝ} (h : tendsto u at_top (𝓝 l)) : tendsto (λ (n : ℕ), (n ⁻¹ : ℝ) * (∑ i in range n, u i)) at_top (𝓝 l) := h.cesaro_smul diff --git a/src/analysis/asymptotics/superpolynomial_decay.lean b/src/analysis/asymptotics/superpolynomial_decay.lean index ea8d3972a6930..3f003aa64537c 100644 --- a/src/analysis/asymptotics/superpolynomial_decay.lean +++ b/src/analysis/asymptotics/superpolynomial_decay.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Devon Tuma -/ import analysis.asymptotics.asymptotics -import analysis.normed_space.ordered +import analysis.normed.order.basic import data.polynomial.eval import topology.algebra.order.liminf_limsup /-! # Super-Polynomial Function Decay +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a predicate `asymptotics.superpolynomial_decay f` for a function satisfying one of following equivalent definitions (The definition is in terms of the first condition): @@ -26,7 +29,7 @@ These further equivalences are not proven in mathlib but would be good future pr The definition of superpolynomial decay for `f : α → β` is relative to a parameter `k : α → β`. Super-polynomial decay then means `f x` decays faster than `(k x) ^ c` for all integers `c`. -Equivalently `f x` decays faster than `p.eval (k x)` for all polynomials `p : polynomial β`. +Equivalently `f x` decays faster than `p.eval (k x)` for all polynomials `p : β[X]`. The definition is also relative to a filter `l : filter α` where the decay rate is compared. When the map `k` is given by `n ↦ ↑n : ℕ → ℝ` this defines negligible functions: @@ -46,7 +49,7 @@ https://ncatlab.org/nlab/show/rapidly+decreasing+function namespace asymptotics -open_locale topological_space +open_locale topology polynomial open filter /-- `f` has superpolynomial decay in parameter `k` along filter `l` if @@ -112,13 +115,13 @@ lemma superpolynomial_decay.mul_param_pow (hf : superpolynomial_decay l k f) (hf.param_pow_mul n).congr (λ _, mul_comm _ _) lemma superpolynomial_decay.polynomial_mul [has_continuous_add β] [has_continuous_mul β] - (hf : superpolynomial_decay l k f) (p : polynomial β) : + (hf : superpolynomial_decay l k f) (p : β[X]) : superpolynomial_decay l k (λ x, (p.eval $ k x) * f x) := polynomial.induction_on' p (λ p q hp hq, by simpa [add_mul] using hp.add hq) (λ n c, by simpa [mul_assoc] using (hf.param_pow_mul n).const_mul c) lemma superpolynomial_decay.mul_polynomial [has_continuous_add β] [has_continuous_mul β] - (hf : superpolynomial_decay l k f) (p : polynomial β) : + (hf : superpolynomial_decay l k f) (p : β[X]) : superpolynomial_decay l k (λ x, f x * (p.eval $ k x)) := (hf.polynomial_mul p).congr (λ _, mul_comm _ _) @@ -205,8 +208,8 @@ begin ((tendsto_zero_iff_abs_tendsto_zero _).1 hk.inv_tendsto_at_top), refine tendsto_of_tendsto_of_tendsto_of_le_of_le' h1 h2 (eventually_of_forall (λ x, abs_nonneg _)) ((eventually_map.1 hm).mp _), - refine ((eventually_ne_of_tendsto_at_top hk 0).mono $ λ x hk0 hx, _), - refine le_trans (le_of_eq _) (mul_le_mul_of_nonneg_left hx $ abs_nonneg (k x)⁻¹), + refine ((hk.eventually_ne_at_top 0).mono $ λ x hk0 hx, _), + refine eq.trans_le _ (mul_le_mul_of_nonneg_left hx $ abs_nonneg (k x)⁻¹), rw [← abs_mul, ← mul_assoc, pow_succ, ← mul_assoc, inv_mul_cancel hk0, one_mul], end @@ -229,7 +232,7 @@ lemma superpolynomial_decay.param_zpow_mul (hk : tendsto k l at_top) (hf : superpolynomial_decay l k f) (z : ℤ) : superpolynomial_decay l k (λ a, k a ^ z * f a) := begin rw superpolynomial_decay_iff_zpow_tendsto_zero _ hk at hf ⊢, - refine λ z', (hf $ z' + z).congr' ((eventually_ne_of_tendsto_at_top hk 0).mono (λ x hx, _)), + refine λ z', (hf $ z' + z).congr' ((hk.eventually_ne_at_top 0).mono (λ x hx, _)), simp [zpow_add₀ hx, mul_assoc, pi.mul_apply], end @@ -249,7 +252,7 @@ variable (f) lemma superpolynomial_decay_param_mul_iff (hk : tendsto k l at_top) : superpolynomial_decay l k (k * f) ↔ superpolynomial_decay l k f := -⟨λ h, (h.inv_param_mul hk).congr' ((eventually_ne_of_tendsto_at_top hk 0).mono +⟨λ h, (h.inv_param_mul hk).congr' ((hk.eventually_ne_at_top 0).mono (λ x hx, by simp [← mul_assoc, inv_mul_cancel hx])), λ h, h.param_mul⟩ lemma superpolynomial_decay_mul_param_iff (hk : tendsto k l at_top) : @@ -280,12 +283,12 @@ variable [normed_linear_ordered_field β] variables (l k f) lemma superpolynomial_decay_iff_norm_tendsto_zero : - superpolynomial_decay l k f ↔ ∀ (n : ℕ), tendsto (λ (a : α), ∥(k a) ^ n * f a∥) l (𝓝 0) := + superpolynomial_decay l k f ↔ ∀ (n : ℕ), tendsto (λ (a : α), ‖(k a) ^ n * f a‖) l (𝓝 0) := ⟨λ h z, tendsto_zero_iff_norm_tendsto_zero.1 (h z), λ h z, tendsto_zero_iff_norm_tendsto_zero.2 (h z)⟩ lemma superpolynomial_decay_iff_superpolynomial_decay_norm : - superpolynomial_decay l k f ↔ superpolynomial_decay l (λ a, ∥k a∥) (λ a, ∥f a∥) := + superpolynomial_decay l k f ↔ superpolynomial_decay l (λ a, ‖k a‖) (λ a, ‖f a‖) := (superpolynomial_decay_iff_norm_tendsto_zero l k f).trans (by simp [superpolynomial_decay]) variables {l k} @@ -293,38 +296,36 @@ variables {l k} variable [order_topology β] lemma superpolynomial_decay_iff_is_O (hk : tendsto k l at_top) : - superpolynomial_decay l k f ↔ ∀ (z : ℤ), is_O f (λ (a : α), (k a) ^ z) l := + superpolynomial_decay l k f ↔ ∀ (z : ℤ), f =O[l] (λ (a : α), (k a) ^ z) := begin refine (superpolynomial_decay_iff_zpow_tendsto_zero f hk).trans _, - have hk0 : ∀ᶠ x in l, k x ≠ 0 := eventually_ne_of_tendsto_at_top hk 0, + have hk0 : ∀ᶠ x in l, k x ≠ 0 := hk.eventually_ne_at_top 0, refine ⟨λ h z, _, λ h z, _⟩, { refine is_O_of_div_tendsto_nhds (hk0.mono (λ x hx hxz, absurd (zpow_eq_zero hxz) hx)) 0 _, have : (λ (a : α), k a ^ z)⁻¹ = (λ (a : α), k a ^ (- z)) := funext (λ x, by simp), rw [div_eq_mul_inv, mul_comm f, this], exact h (-z) }, - { suffices : is_O (λ (a : α), k a ^ z * f a) (λ (a : α), (k a)⁻¹) l, - from is_O.trans_tendsto this hk.inv_tendsto_at_top, + { suffices : (λ (a : α), k a ^ z * f a) =O[l] (λ (a : α), (k a)⁻¹), + from is_O.trans_tendsto this hk.inv_tendsto_at_top, refine ((is_O_refl (λ a, (k a) ^ z) l).mul (h (- (z + 1)))).trans (is_O.of_bound 1 $ hk0.mono (λ a ha0, _)), - simp only [one_mul, neg_add z 1, zpow_add₀ ha0, ← mul_assoc, zpow_neg₀, + simp only [one_mul, neg_add z 1, zpow_add₀ ha0, ← mul_assoc, zpow_neg, mul_inv_cancel (zpow_ne_zero z ha0), zpow_one] } end lemma superpolynomial_decay_iff_is_o (hk : tendsto k l at_top) : - superpolynomial_decay l k f ↔ ∀ (z : ℤ), is_o f (λ (a : α), (k a) ^ z) l := + superpolynomial_decay l k f ↔ ∀ (z : ℤ), f =o[l] (λ (a : α), (k a) ^ z) := begin refine ⟨λ h z, _, λ h, (superpolynomial_decay_iff_is_O f hk).2 (λ z, (h z).is_O)⟩, - have hk0 : ∀ᶠ x in l, k x ≠ 0 := eventually_ne_of_tendsto_at_top hk 0, - have : is_o (λ (x : α), (1 : β)) k l := is_o_of_tendsto' + have hk0 : ∀ᶠ x in l, k x ≠ 0 := hk.eventually_ne_at_top 0, + have : (λ (x : α), (1 : β)) =o[l] k := is_o_of_tendsto' (hk0.mono (λ x hkx hkx', absurd hkx' hkx)) (by simpa using hk.inv_tendsto_at_top), - have : is_o f (λ (x : α), k x * k x ^ (z - 1)) l, - by simpa using this.mul_is_O (((superpolynomial_decay_iff_is_O f hk).1 h) $ z - 1), + have : f =o[l] (λ (x : α), k x * k x ^ (z - 1)), + by simpa using this.mul_is_O (((superpolynomial_decay_iff_is_O f hk).1 h) $ z - 1), refine this.trans_is_O (is_O.of_bound 1 (hk0.mono $ λ x hkx, le_of_eq _)), rw [one_mul, zpow_sub_one₀ hkx, mul_comm (k x), mul_assoc, inv_mul_cancel hkx, mul_one], end -variable {f} - end normed_linear_ordered_field end asymptotics diff --git a/src/analysis/asymptotics/theta.lean b/src/analysis/asymptotics/theta.lean new file mode 100644 index 0000000000000..98375933808fc --- /dev/null +++ b/src/analysis/asymptotics/theta.lean @@ -0,0 +1,197 @@ +/- +Copyright (c) 2022 Yury G. Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury G. Kudryashov +-/ +import analysis.asymptotics.asymptotics + +/-! +# Asymptotic equivalence up to a constant + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `asymptotics.is_Theta l f g` (notation: `f =Θ[l] g`) as +`f =O[l] g ∧ g =O[l] f`, then prove basic properties of this equivalence relation. +-/ + +open filter +open_locale topology + +namespace asymptotics + +variables {α : Type*} {β : Type*} {E : Type*} {F : Type*} {G : Type*} + {E' : Type*} {F' : Type*} {G' : Type*} + {E'' : Type*} {F'' : Type*} {G'' : Type*} + {R : Type*} {R' : Type*} {𝕜 : Type*} {𝕜' : Type*} + +variables [has_norm E] [has_norm F] [has_norm G] +variables [seminormed_add_comm_group E'] [seminormed_add_comm_group F'] + [seminormed_add_comm_group G'] [normed_add_comm_group E''] [normed_add_comm_group F''] + [normed_add_comm_group G''] [semi_normed_ring R] [semi_normed_ring R'] +variables [normed_field 𝕜] [normed_field 𝕜'] +variables {c c' c₁ c₂ : ℝ} {f : α → E} {g : α → F} {k : α → G} +variables {f' : α → E'} {g' : α → F'} {k' : α → G'} +variables {f'' : α → E''} {g'' : α → F''} +variables {l l' : filter α} + +/-- We say that `f` is `Θ(g)` along a filter `l` (notation: `f =Θ[l] g`) if `f =O[l] g` and +`g =O[l] f`. -/ +def is_Theta (l : filter α) (f : α → E) (g : α → F) : Prop := is_O l f g ∧ is_O l g f + +notation f ` =Θ[`:100 l `] ` g:100 := is_Theta l f g + +lemma is_O.antisymm (h₁ : f =O[l] g) (h₂ : g =O[l] f) : f =Θ[l] g := ⟨h₁, h₂⟩ + +@[refl] lemma is_Theta_refl (f : α → E) (l : filter α) : f =Θ[l] f := ⟨is_O_refl _ _, is_O_refl _ _⟩ +lemma is_Theta_rfl : f =Θ[l] f := is_Theta_refl _ _ +@[symm] lemma is_Theta.symm (h : f =Θ[l] g) : g =Θ[l] f := h.symm + +lemma is_Theta_comm : f =Θ[l] g ↔ g =Θ[l] f := ⟨λ h, h.symm, λ h, h.symm⟩ + +@[trans] lemma is_Theta.trans {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g) + (h₂ : g =Θ[l] k) : f =Θ[l] k := +⟨h₁.1.trans h₂.1, h₂.2.trans h₁.2⟩ + +@[trans] lemma is_O.trans_is_Theta {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =O[l] g) + (h₂ : g =Θ[l] k) : f =O[l] k := +h₁.trans h₂.1 + +@[trans] lemma is_Theta.trans_is_O {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g) + (h₂ : g =O[l] k) : f =O[l] k := +h₁.1.trans h₂ + +@[trans] lemma is_o.trans_is_Theta {f : α → E} {g : α → F} {k : α → G'} (h₁ : f =o[l] g) + (h₂ : g =Θ[l] k) : f =o[l] k := +h₁.trans_is_O h₂.1 + +@[trans] lemma is_Theta.trans_is_o {f : α → E} {g : α → F'} {k : α → G} (h₁ : f =Θ[l] g) + (h₂ : g =o[l] k) : f =o[l] k := +h₁.1.trans_is_o h₂ + +@[trans] lemma is_Theta.trans_eventually_eq {f : α → E} {g₁ g₂ : α → F} (h : f =Θ[l] g₁) + (hg : g₁ =ᶠ[l] g₂) : f =Θ[l] g₂ := +⟨h.1.trans_eventually_eq hg, hg.symm.trans_is_O h.2⟩ + +@[trans] lemma _root_.filter.eventually_eq.trans_is_Theta {f₁ f₂ : α → E} {g : α → F} + (hf : f₁ =ᶠ[l] f₂) (h : f₂ =Θ[l] g) : f₁ =Θ[l] g := +⟨hf.trans_is_O h.1, h.2.trans_eventually_eq hf.symm⟩ + +@[simp] lemma is_Theta_norm_left : (λ x, ‖f' x‖) =Θ[l] g ↔ f' =Θ[l] g := by simp [is_Theta] +@[simp] lemma is_Theta_norm_right : f =Θ[l] (λ x, ‖g' x‖) ↔ f =Θ[l] g' := by simp [is_Theta] + +alias is_Theta_norm_left ↔ is_Theta.of_norm_left is_Theta.norm_left +alias is_Theta_norm_right ↔ is_Theta.of_norm_right is_Theta.norm_right + +lemma is_Theta_of_norm_eventually_eq (h : (λ x, ‖f x‖) =ᶠ[l] (λ x, ‖g x‖)) : f =Θ[l] g := +⟨is_O.of_bound 1 $ by simpa only [one_mul] using h.le, + is_O.of_bound 1 $ by simpa only [one_mul] using h.symm.le⟩ + +lemma is_Theta_of_norm_eventually_eq' {g : α → ℝ} (h : (λ x, ‖f' x‖) =ᶠ[l] g) : f' =Θ[l] g := +is_Theta_of_norm_eventually_eq $ h.mono $ λ x hx, by simp only [← hx, norm_norm] + +lemma is_Theta.is_o_congr_left (h : f' =Θ[l] g') : f' =o[l] k ↔ g' =o[l] k := +⟨h.symm.trans_is_o, h.trans_is_o⟩ + +lemma is_Theta.is_o_congr_right (h : g' =Θ[l] k') : f =o[l] g' ↔ f =o[l] k' := +⟨λ H, H.trans_is_Theta h, λ H, H.trans_is_Theta h.symm⟩ + +lemma is_Theta.is_O_congr_left (h : f' =Θ[l] g') : f' =O[l] k ↔ g' =O[l] k := +⟨h.symm.trans_is_O, h.trans_is_O⟩ + +lemma is_Theta.is_O_congr_right (h : g' =Θ[l] k') : f =O[l] g' ↔ f =O[l] k' := +⟨λ H, H.trans_is_Theta h, λ H, H.trans_is_Theta h.symm⟩ + +lemma is_Theta.mono (h : f =Θ[l] g) (hl : l' ≤ l) : f =Θ[l'] g := ⟨h.1.mono hl, h.2.mono hl⟩ + +lemma is_Theta.sup (h : f' =Θ[l] g') (h' : f' =Θ[l'] g') : f' =Θ[l ⊔ l'] g' := +⟨h.1.sup h'.1, h.2.sup h'.2⟩ + +@[simp] lemma is_Theta_sup : f' =Θ[l ⊔ l'] g' ↔ f' =Θ[l] g' ∧ f' =Θ[l'] g' := +⟨λ h, ⟨h.mono le_sup_left, h.mono le_sup_right⟩, λ h, h.1.sup h.2⟩ + +lemma is_Theta.eq_zero_iff (h : f'' =Θ[l] g'') : ∀ᶠ x in l, f'' x = 0 ↔ g'' x = 0 := +h.1.eq_zero_imp.mp $ h.2.eq_zero_imp.mono $ λ x, iff.intro + +lemma is_Theta.tendsto_zero_iff (h : f'' =Θ[l] g'') : tendsto f'' l (𝓝 0) ↔ tendsto g'' l (𝓝 0) := +by simp only [← is_o_one_iff ℝ, h.is_o_congr_left] + +lemma is_Theta.tendsto_norm_at_top_iff (h : f' =Θ[l] g') : + tendsto (norm ∘ f') l at_top ↔ tendsto (norm ∘ g') l at_top := +by simp only [← is_o_const_left_of_ne (one_ne_zero' ℝ), h.is_o_congr_right] + +lemma is_Theta.is_bounded_under_le_iff (h : f' =Θ[l] g') : + is_bounded_under (≤) l (norm ∘ f') ↔ is_bounded_under (≤) l (norm ∘ g') := +by simp only [← is_O_const_of_ne (one_ne_zero' ℝ), h.is_O_congr_left] + +lemma is_Theta.smul [normed_space 𝕜 E'] [normed_space 𝕜' F'] {f₁ : α → 𝕜} {f₂ : α → 𝕜'} + {g₁ : α → E'} {g₂ : α → F'} (hf : f₁ =Θ[l] f₂) (hg : g₁ =Θ[l] g₂) : + (λ x, f₁ x • g₁ x) =Θ[l] (λ x, f₂ x • g₂ x) := +⟨hf.1.smul hg.1, hf.2.smul hg.2⟩ + +lemma is_Theta.mul {f₁ f₂ : α → 𝕜} {g₁ g₂ : α → 𝕜'} (h₁ : f₁ =Θ[l] g₁) (h₂ : f₂ =Θ[l] g₂) : + (λ x, f₁ x * f₂ x) =Θ[l] (λ x, g₁ x * g₂ x) := +h₁.smul h₂ + +lemma is_Theta.inv {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) : (λ x, (f x)⁻¹) =Θ[l] (λ x, (g x)⁻¹) := +⟨h.2.inv_rev h.1.eq_zero_imp, h.1.inv_rev h.2.eq_zero_imp⟩ + +@[simp] lemma is_Theta_inv {f : α → 𝕜} {g : α → 𝕜'} : + (λ x, (f x)⁻¹) =Θ[l] (λ x, (g x)⁻¹) ↔ f =Θ[l] g := +⟨λ h, by simpa only [inv_inv] using h.inv, is_Theta.inv⟩ + +lemma is_Theta.div {f₁ f₂ : α → 𝕜} {g₁ g₂ : α → 𝕜'} (h₁ : f₁ =Θ[l] g₁) (h₂ : f₂ =Θ[l] g₂) : + (λ x, f₁ x / f₂ x) =Θ[l] (λ x, g₁ x / g₂ x) := +by simpa only [div_eq_mul_inv] using h₁.mul h₂.inv + +lemma is_Theta.pow {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) (n : ℕ) : + (λ x, (f x) ^ n) =Θ[l] (λ x, (g x) ^ n) := +⟨h.1.pow n, h.2.pow n⟩ + +lemma is_Theta.zpow {f : α → 𝕜} {g : α → 𝕜'} (h : f =Θ[l] g) (n : ℤ) : + (λ x, (f x) ^ n) =Θ[l] (λ x, (g x) ^ n) := +begin + cases n, + { simpa only [zpow_of_nat] using h.pow _ }, + { simpa only [zpow_neg_succ_of_nat] using (h.pow _).inv } +end + +lemma is_Theta_const_const {c₁ : E''} {c₂ : F''} (h₁ : c₁ ≠ 0) (h₂ : c₂ ≠ 0) : + (λ x : α, c₁) =Θ[l] (λ x, c₂) := +⟨is_O_const_const _ h₂ _, is_O_const_const _ h₁ _⟩ + +@[simp] lemma is_Theta_const_const_iff [ne_bot l] {c₁ : E''} {c₂ : F''} : + (λ x : α, c₁) =Θ[l] (λ x, c₂) ↔ (c₁ = 0 ↔ c₂ = 0) := +by simpa only [is_Theta, is_O_const_const_iff, ← iff_def] using iff.comm + +@[simp] lemma is_Theta_zero_left : (λ x, (0 : E')) =Θ[l] g'' ↔ g'' =ᶠ[l] 0 := +by simp only [is_Theta, is_O_zero, is_O_zero_right_iff, true_and] + +@[simp] lemma is_Theta_zero_right : f'' =Θ[l] (λ x, (0 : F')) ↔ f'' =ᶠ[l] 0 := +is_Theta_comm.trans is_Theta_zero_left + +lemma is_Theta_const_smul_left [normed_space 𝕜 E'] {c : 𝕜} (hc : c ≠ 0) : + (λ x, c • f' x) =Θ[l] g ↔ f' =Θ[l] g := +and_congr (is_O_const_smul_left hc) (is_O_const_smul_right hc) + +alias is_Theta_const_smul_left ↔ is_Theta.of_const_smul_left is_Theta.const_smul_left + +lemma is_Theta_const_smul_right [normed_space 𝕜 F'] {c : 𝕜} (hc : c ≠ 0) : + f =Θ[l] (λ x, c • g' x) ↔ f =Θ[l] g' := +and_congr (is_O_const_smul_right hc) (is_O_const_smul_left hc) + +alias is_Theta_const_smul_right ↔ is_Theta.of_const_smul_right is_Theta.const_smul_right + +lemma is_Theta_const_mul_left {c : 𝕜} {f : α → 𝕜} (hc : c ≠ 0) : + (λ x, c * f x) =Θ[l] g ↔ f =Θ[l] g := +by simpa only [← smul_eq_mul] using is_Theta_const_smul_left hc + +alias is_Theta_const_mul_left ↔ is_Theta.of_const_mul_left is_Theta.const_mul_left + +lemma is_Theta_const_mul_right {c : 𝕜} {g : α → 𝕜} (hc : c ≠ 0) : + f =Θ[l] (λ x, c * g x) ↔ f =Θ[l] g := +by simpa only [← smul_eq_mul] using is_Theta_const_smul_right hc + +alias is_Theta_const_mul_right ↔ is_Theta.of_const_mul_right is_Theta.const_mul_right + +end asymptotics diff --git a/src/analysis/bounded_variation.lean b/src/analysis/bounded_variation.lean new file mode 100644 index 0000000000000..252ed7aa1747e --- /dev/null +++ b/src/analysis/bounded_variation.lean @@ -0,0 +1,1059 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.calculus.deriv.add +import analysis.calculus.fderiv.equiv +import analysis.calculus.fderiv.prod +import analysis.calculus.monotone +import data.set.function +import algebra.group.basic +import tactic.wlog + +/-! +# Functions of bounded variation + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We study functions of bounded variation. In particular, we show that a bounded variation function +is a difference of monotone functions, and differentiable almost everywhere. This implies that +Lipschitz functions from the real line into finite-dimensional vector space are also differentiable +almost everywhere. + +## Main definitions and results + +* `evariation_on f s` is the total variation of the function `f` on the set `s`, in `ℝ≥0∞`. +* `has_bounded_variation_on f s` registers that the variation of `f` on `s` is finite. +* `has_locally_bounded_variation f s` registers that `f` has finite variation on any compact + subinterval of `s`. +* `variation_on_from_to f s a b` is the signed variation of `f` on `s ∩ Icc a b`, converted to `ℝ`. + +* `evariation_on.Icc_add_Icc` states that the variation of `f` on `[a, c]` is the sum of its + variations on `[a, b]` and `[b, c]`. +* `has_locally_bounded_variation_on.exists_monotone_on_sub_monotone_on` proves that a function + with locally bounded variation is the difference of two monotone functions. +* `lipschitz_with.has_locally_bounded_variation_on` shows that a Lipschitz function has locally + bounded variation. +* `has_locally_bounded_variation_on.ae_differentiable_within_at` shows that a bounded variation + function into a finite dimensional real vector space is differentiable almost everywhere. +* `lipschitz_on_with.ae_differentiable_within_at` is the same result for Lipschitz functions. + +We also give several variations around these results. + +## Implementation + +We define the variation as an extended nonnegative real, to allow for infinite variation. This makes +it possible to use the complete linear order structure of `ℝ≥0∞`. The proofs would be much +more tedious with an `ℝ`-valued or `ℝ≥0`-valued variation, since one would always need to check +that the sets one uses are nonempty and bounded above as these are only conditionally complete. +-/ +open_locale big_operators nnreal ennreal topology uniform_convergence +open set measure_theory filter + +variables {α β : Type*} [linear_order α] [linear_order β] +{E F : Type*} [pseudo_emetric_space E] [pseudo_emetric_space F] +{V : Type*} [normed_add_comm_group V] [normed_space ℝ V] [finite_dimensional ℝ V] + +/-- The (extended real valued) variation of a function `f` on a set `s` inside a linear order is +the supremum of the sum of `edist (f (u (i+1))) (f (u i))` over all finite increasing +sequences `u` in `s`. -/ +noncomputable def evariation_on (f : α → E) (s : set α) : ℝ≥0∞ := +⨆ (p : ℕ × {u : ℕ → α // monotone u ∧ ∀ i, u i ∈ s}), + ∑ i in finset.range p.1, edist (f ((p.2 : ℕ → α) (i+1))) (f ((p.2 : ℕ → α) i)) + +/-- A function has bounded variation on a set `s` if its total variation there is finite. -/ +def has_bounded_variation_on (f : α → E) (s : set α) := +evariation_on f s ≠ ∞ + +/-- A function has locally bounded variation on a set `s` if, given any interval `[a, b]` with +endpoints in `s`, then the function has finite variation on `s ∩ [a, b]`. -/ +def has_locally_bounded_variation_on (f : α → E) (s : set α) := +∀ a b, a ∈ s → b ∈ s → has_bounded_variation_on f (s ∩ Icc a b) + +/-! ## Basic computations of variation -/ + +namespace evariation_on + +lemma nonempty_monotone_mem {s : set α} (hs : s.nonempty) : + nonempty {u // monotone u ∧ ∀ (i : ℕ), u i ∈ s} := +begin + obtain ⟨x, hx⟩ := hs, + exact ⟨⟨λ i, x, λ i j hij, le_rfl, λ i, hx⟩⟩, +end + +lemma eq_of_edist_zero_on {f f' : α → E} {s : set α} (h : ∀ ⦃x⦄, x ∈ s → edist (f x) (f' x) = 0) : + evariation_on f s = evariation_on f' s := +begin + dsimp only [evariation_on], + congr' 1 with p : 1, + congr' 1 with i : 1, + rw [edist_congr_right (h $ p.snd.prop.2 (i+1)), edist_congr_left (h $ p.snd.prop.2 i)], +end + +lemma eq_of_eq_on {f f' : α → E} {s : set α} (h : eq_on f f' s) : + evariation_on f s = evariation_on f' s := +eq_of_edist_zero_on (λ x xs, by rw [h xs, edist_self]) + +lemma sum_le + (f : α → E) {s : set α} (n : ℕ) {u : ℕ → α} (hu : monotone u) (us : ∀ i, u i ∈ s) : + ∑ i in finset.range n, edist (f (u (i+1))) (f (u i)) ≤ evariation_on f s := +le_supr_of_le ⟨n, u, hu, us⟩ le_rfl + +lemma sum_le_of_monotone_on_Iic + (f : α → E) {s : set α} {n : ℕ} {u : ℕ → α} (hu : monotone_on u (Iic n)) + (us : ∀ i ≤ n, u i ∈ s) : + ∑ i in finset.range n, edist (f (u (i+1))) (f (u i)) ≤ evariation_on f s := +begin + let v := λ i, if i ≤ n then u i else u n, + have vs : ∀ i, v i ∈ s, + { assume i, + simp only [v], + split_ifs, + { exact us i h }, + { exact us n le_rfl } }, + have hv : monotone v, + { apply monotone_nat_of_le_succ (λ i, _), + simp only [v], + rcases lt_trichotomy i n with hi|rfl|hi, + { have : i + 1 ≤ n, by linarith, + simp only [hi.le, this, if_true], + exact hu hi.le this (nat.le_succ i) }, + { simp only [le_refl, if_true, add_le_iff_nonpos_right, le_zero_iff, nat.one_ne_zero, + if_false] }, + { have A : ¬(i ≤ n), by linarith, + have B : ¬(i + 1 ≤ n), by linarith, + simp [A, B] } }, + convert sum_le f n hv vs using 1, + apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_range] at hi, + have : i + 1 ≤ n, by linarith, + simp only [v], + simp [this, hi.le], +end + +lemma sum_le_of_monotone_on_Icc + (f : α → E) {s : set α} {m n : ℕ} {u : ℕ → α} (hu : monotone_on u (Icc m n)) + (us : ∀ i ∈ Icc m n, u i ∈ s) : + ∑ i in finset.Ico m n, edist (f (u (i+1))) (f (u i)) ≤ evariation_on f s := +begin + rcases le_or_lt n m with hnm|hmn, + { simp only [finset.Ico_eq_empty_of_le hnm, finset.sum_empty, zero_le'] }, + let v := λ i, u (m + i), + have hv : monotone_on v (Iic (n - m)), + { assume a ha b hb hab, + simp only [le_tsub_iff_left hmn.le, mem_Iic] at ha hb, + exact hu ⟨le_add_right le_rfl, ha⟩ ⟨le_add_right le_rfl, hb⟩ (add_le_add le_rfl hab) }, + have vs : ∀ i ∈ Iic (n - m), v i ∈ s, + { assume i hi, + simp only [le_tsub_iff_left hmn.le, mem_Iic] at hi, + exact us _ ⟨le_add_right le_rfl, hi⟩ }, + calc ∑ i in finset.Ico m n, edist (f (u (i + 1))) (f (u i)) + = ∑ i in finset.range (n - m), edist (f (u (m + i + 1))) (f (u (m + i))) : + begin + rw [finset.range_eq_Ico], + convert (finset.sum_Ico_add (λ i, edist (f (u (i + 1))) (f (u i))) 0 (n - m) m).symm, + { rw [zero_add] }, + { rw tsub_add_cancel_of_le hmn.le } + end + ... = ∑ i in finset.range (n - m), edist (f (v (i + 1))) (f (v i)) : + begin + apply finset.sum_congr rfl (λ i hi, _), + simp only [v, add_assoc], + end + ... ≤ evariation_on f s : sum_le_of_monotone_on_Iic f hv vs, +end + +lemma mono (f : α → E) {s t : set α} (hst : t ⊆ s) : + evariation_on f t ≤ evariation_on f s := +begin + apply supr_le _, + rintros ⟨n, ⟨u, hu, ut⟩⟩, + exact sum_le f n hu (λ i, hst (ut i)), +end + +lemma _root_.has_bounded_variation_on.mono {f : α → E} {s : set α} + (h : has_bounded_variation_on f s) {t : set α} (ht : t ⊆ s) : + has_bounded_variation_on f t := +(lt_of_le_of_lt (evariation_on.mono f ht) (lt_top_iff_ne_top.2 h)).ne + +lemma _root_.has_bounded_variation_on.has_locally_bounded_variation_on {f : α → E} {s : set α} + (h : has_bounded_variation_on f s) : has_locally_bounded_variation_on f s := +λ x y hx hy, h.mono (inter_subset_left _ _) + +lemma edist_le (f : α → E) {s : set α} {x y : α} (hx : x ∈ s) (hy : y ∈ s) : + edist (f x) (f y) ≤ evariation_on f s := +begin + wlog hxy : x ≤ y, + { rw edist_comm, + exact this f hy hx (le_of_not_le hxy) }, + let u : ℕ → α := λ n, if n = 0 then x else y, + have hu : monotone u, + { assume m n hmn, + dsimp only [u], + split_ifs, + exacts [le_rfl, hxy, by linarith [pos_iff_ne_zero.2 h], le_rfl] }, + have us : ∀ i, u i ∈ s, + { assume i, + dsimp only [u], + split_ifs, + exacts [hx, hy] }, + convert sum_le f 1 hu us, + simp [u, edist_comm], +end + +lemma eq_zero_iff (f : α → E) {s : set α} : + evariation_on f s = 0 ↔ ∀ (x y ∈ s), edist (f x) (f y) = 0 := +begin + split, + { rintro h x xs y ys, + rw [←le_zero_iff, ←h], + exact edist_le f xs ys, }, + { rintro h, + dsimp only [evariation_on], + rw ennreal.supr_eq_zero, + rintro ⟨n, u, um, us⟩, + exact finset.sum_eq_zero (λ i hi, h _ (us i.succ) _ (us i)), }, +end + +lemma constant_on {f : α → E} {s : set α} (hf : (f '' s).subsingleton) : evariation_on f s = 0 := +begin + rw eq_zero_iff, + rintro x xs y ys, + rw [hf ⟨x, xs, rfl⟩ ⟨y, ys, rfl⟩, edist_self], +end + +@[simp] protected lemma subsingleton (f : α → E) {s : set α} (hs : s.subsingleton) : + evariation_on f s = 0 := constant_on (hs.image f) + +lemma lower_continuous_aux {ι : Type*} {F : ι → α → E} {p : filter ι} + {f : α → E} {s : set α} (Ffs : ∀ x ∈ s, tendsto (λ i, F i x) p (𝓝 (f x))) + {v : ℝ≥0∞} (hv : v < evariation_on f s) : ∀ᶠ (n : ι) in p, v < evariation_on (F n) s := +begin + obtain ⟨⟨n, ⟨u, um, us⟩⟩, hlt⟩ : + ∃ (p : ℕ × {u : ℕ → α // monotone u ∧ ∀ i, u i ∈ s}), + v < ∑ i in finset.range p.1, edist (f ((p.2 : ℕ → α) (i+1))) (f ((p.2 : ℕ → α) i)) := + lt_supr_iff.mp hv, + have : tendsto (λ j, ∑ (i : ℕ) in finset.range n, edist (F j (u (i + 1))) (F j (u i))) + p (𝓝 (∑ (i : ℕ) in finset.range n, edist (f (u (i + 1))) (f (u i)))), + { apply tendsto_finset_sum, + exact λ i hi, tendsto.edist (Ffs (u i.succ) (us i.succ)) (Ffs (u i) (us i)) }, + exact (eventually_gt_of_tendsto_gt hlt this).mono + (λ i h, lt_of_lt_of_le h (sum_le (F i) n um us)), +end + +/-- +The map `λ f, evariation_on f s` is lower semicontinuous for pointwise convergence *on `s`*. +Pointwise convergence on `s` is encoded here as uniform convergence on the family consisting of the +singletons of elements of `s`. +-/ +@[protected] +lemma lower_semicontinuous (s : set α) : + lower_semicontinuous (λ f : α →ᵤ[s.image singleton] E, evariation_on f s) := +begin + intro f, + apply @lower_continuous_aux _ _ _ _ (uniform_on_fun α E (s.image singleton)) id (𝓝 f) f s _, + simpa only [uniform_on_fun.tendsto_iff_tendsto_uniformly_on, mem_image, forall_exists_index, + and_imp, forall_apply_eq_imp_iff₂, + tendsto_uniformly_on_singleton_iff_tendsto] using @tendsto_id _ (𝓝 f), +end + +/-- +The map `λ f, evariation_on f s` is lower semicontinuous for uniform convergence on `s`. +-/ +lemma lower_semicontinuous_uniform_on (s : set α) : + lower_semicontinuous (λ f : α →ᵤ[{s}] E, evariation_on f s) := +begin + intro f, + apply @lower_continuous_aux _ _ _ _ (uniform_on_fun α E {s}) id (𝓝 f) f s _, + have := @tendsto_id _ (𝓝 f), + rw uniform_on_fun.tendsto_iff_tendsto_uniformly_on at this, + simp_rw ←tendsto_uniformly_on_singleton_iff_tendsto, + exact λ x xs, ((this s rfl).mono (singleton_subset_iff.mpr xs)), +end + +lemma _root_.has_bounded_variation_on.dist_le {E : Type*} [pseudo_metric_space E] + {f : α → E} {s : set α} (h : has_bounded_variation_on f s) {x y : α} (hx : x ∈ s) (hy : y ∈ s) : + dist (f x) (f y) ≤ (evariation_on f s).to_real := +begin + rw [← ennreal.of_real_le_of_real_iff ennreal.to_real_nonneg, ennreal.of_real_to_real h, + ← edist_dist], + exact edist_le f hx hy +end + +lemma _root_.has_bounded_variation_on.sub_le + {f : α → ℝ} {s : set α} (h : has_bounded_variation_on f s) {x y : α} (hx : x ∈ s) (hy : y ∈ s) : + f x - f y ≤ (evariation_on f s).to_real := +begin + apply (le_abs_self _).trans, + rw ← real.dist_eq, + exact h.dist_le hx hy +end + +/-- Consider a monotone function `u` parameterizing some points of a set `s`. Given `x ∈ s`, then +one can find another monotone function `v` parameterizing the same points as `u`, with `x` added. +In particular, the variation of a function along `u` is bounded by its variation along `v`. -/ +lemma add_point (f : α → E) {s : set α} {x : α} (hx : x ∈ s) + (u : ℕ → α) (hu : monotone u) (us : ∀ i, u i ∈ s) (n : ℕ) : + ∃ (v : ℕ → α) (m : ℕ), monotone v ∧ (∀ i, v i ∈ s) ∧ x ∈ v '' (Iio m) ∧ + ∑ i in finset.range n, edist (f (u (i+1))) (f (u i)) ≤ + ∑ j in finset.range m, edist (f (v (j+1))) (f (v j)) := +begin + rcases le_or_lt (u n) x with h|h, + { let v := λ i, if i ≤ n then u i else x, + have vs : ∀ i, v i ∈ s, + { assume i, + simp only [v], + split_ifs, + { exact us i }, + { exact hx } }, + have hv : monotone v, + { apply monotone_nat_of_le_succ (λ i, _), + simp only [v], + rcases lt_trichotomy i n with hi|rfl|hi, + { have : i + 1 ≤ n := nat.succ_le_of_lt hi, + simp only [hi.le, this, if_true], + exact hu (nat.le_succ i) }, + { simp only [le_refl, if_true, add_le_iff_nonpos_right, le_zero_iff, nat.one_ne_zero, + if_false, h], }, + { have A : ¬(i ≤ n) := hi.not_le, + have B : ¬(i + 1 ≤ n) := λ h, A (i.le_succ.trans h), + simp only [A, B, if_false]} }, + refine ⟨v, n+2, hv, vs, (mem_image _ _ _).2 ⟨n+1, _, _⟩, _⟩, + { rw mem_Iio, exact nat.lt_succ_self (n+1) }, + { have : ¬(n + 1 ≤ n) := nat.not_succ_le_self n, + simp only [this, ite_eq_right_iff, is_empty.forall_iff] }, + { calc + ∑ i in finset.range n, edist (f (u (i+1))) (f (u i)) + = ∑ i in finset.range n, edist (f (v (i+1))) (f (v i)) : + begin + apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_range] at hi, + have : i + 1 ≤ n := nat.succ_le_of_lt hi, + dsimp only [v], + simp only [hi.le, this, if_true], + end + ... ≤ ∑ j in finset.range (n + 2), edist (f (v (j+1))) (f (v j)) : + finset.sum_le_sum_of_subset (finset.range_mono (nat.le_add_right n 2)) } }, + have exists_N : ∃ N, N ≤ n ∧ x < u N, from ⟨n, le_rfl, h⟩, + let N := nat.find exists_N, + have hN : N ≤ n ∧ x < u N := nat.find_spec exists_N, + let w : ℕ → α := λ i, if i < N then u i else if i = N then x else u (i - 1), + have ws : ∀ i, w i ∈ s, + { dsimp only [w], + assume i, + split_ifs, + exacts [us _, hx, us _] }, + have hw : monotone w, + { apply monotone_nat_of_le_succ (λ i, _), + dsimp only [w], + rcases lt_trichotomy (i + 1) N with hi|hi|hi, + { have : i < N := nat.lt_of_le_of_lt (nat.le_succ i) hi, + simp only [hi, this, if_true], + exact hu (nat.le_succ _) }, + { have A : i < N := hi ▸ (i.lt_succ_self), + have B : ¬(i + 1 < N) := by { rw ←hi, exact λ h, h.ne rfl, }, + rw [if_pos A, if_neg B, if_pos hi], + have T := nat.find_min exists_N A, + push_neg at T, + exact T (A.le.trans hN.1) }, + { have A : ¬(i < N) := (nat.lt_succ_iff.mp hi).not_lt, + have B : ¬(i + 1 < N) := hi.not_lt, + have C : ¬(i + 1 = N) := hi.ne.symm, + have D : i + 1 - 1 = i := nat.pred_succ i, + rw [if_neg A, if_neg B, if_neg C, D], + split_ifs, + { exact hN.2.le.trans (hu (le_of_not_lt A)) }, + { exact hu (nat.pred_le _) } } }, + refine ⟨w, n+1, hw, ws, (mem_image _ _ _).2 ⟨N, hN.1.trans_lt (nat.lt_succ_self n), _⟩, _⟩, + { dsimp only [w], rw [if_neg (lt_irrefl N), if_pos rfl] }, + rcases eq_or_lt_of_le (zero_le N) with Npos|Npos, + { calc ∑ i in finset.range n, edist (f (u (i + 1))) (f (u i)) + = ∑ i in finset.range n, edist (f (w (1 + i + 1))) (f (w (1 + i))) : + begin + apply finset.sum_congr rfl (λ i hi, _), + dsimp only [w], + simp only [← Npos, nat.not_lt_zero, nat.add_succ_sub_one, add_zero, if_false, + add_eq_zero_iff, nat.one_ne_zero, false_and, nat.succ_add_sub_one, zero_add], + rw add_comm 1 i, + end + ... = ∑ i in finset.Ico 1 (n + 1), edist (f (w (i + 1))) (f (w i)) : + begin + rw finset.range_eq_Ico, + exact finset.sum_Ico_add (λ i, edist (f (w (i + 1))) (f (w i))) 0 n 1, + end + ... ≤ ∑ j in finset.range (n + 1), edist (f (w (j + 1))) (f (w j)) : + begin + apply finset.sum_le_sum_of_subset _, + rw finset.range_eq_Ico, + exact finset.Ico_subset_Ico zero_le_one le_rfl, + end }, + { calc ∑ i in finset.range n, edist (f (u (i + 1))) (f (u i)) + = ∑ i in finset.Ico 0 (N-1), edist (f (u (i + 1))) (f (u i)) + + ∑ i in finset.Ico (N-1) N, edist (f (u (i + 1))) (f (u i)) + + ∑ i in finset.Ico N n, edist (f (u (i + 1))) (f (u i)) : + begin + rw [finset.sum_Ico_consecutive, finset.sum_Ico_consecutive, finset.range_eq_Ico], + { exact zero_le _ }, + { exact hN.1 }, + { exact zero_le _}, + { exact nat.pred_le _ } + end + ... = ∑ i in finset.Ico 0 (N-1), edist (f (w (i + 1))) (f (w i)) + + edist (f (u N)) (f (u (N - 1))) + + ∑ i in finset.Ico N n, edist (f (w (1 + i + 1))) (f (w (1 + i))) : + begin + congr' 1, congr' 1, + { apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_Ico, zero_le', true_and] at hi, + dsimp only [w], + have A : i + 1 < N, from nat.lt_pred_iff.1 hi, + have B : i < N := nat.lt_of_succ_lt A, + rw [if_pos A, if_pos B] }, + { have A : N - 1 + 1 = N, from nat.succ_pred_eq_of_pos Npos, + have : finset.Ico (N - 1) N = {N - 1}, by rw [← nat.Ico_succ_singleton, A], + simp only [this, A, finset.sum_singleton] }, + { apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_Ico] at hi, + dsimp only [w], + have A : ¬(1 + i + 1 < N) := λ h, by + { rw [add_assoc, add_comm] at h, + exact (hi.left).not_lt ((i.lt_succ_self).trans ((i.succ.lt_succ_self).trans h)), }, + have B : ¬(1 + i + 1 = N) := λ h, by + { rw [←h, add_assoc, add_comm] at hi, + exact nat.not_succ_le_self i (i.succ.le_succ.trans hi.left), }, + have C : ¬(1 + i < N) := λ h, by + { rw [add_comm] at h, exact (hi.left).not_lt (i.lt_succ_self.trans h), }, + have D : ¬(1 + i = N) := λ h, by + { rw [←h, add_comm, nat.succ_le_iff] at hi, exact hi.left.ne rfl, }, + rw [if_neg A, if_neg B, if_neg C, if_neg D], + congr' 3; + { rw [add_comm, nat.sub_one], apply nat.pred_succ, } } + end + ... = ∑ i in finset.Ico 0 (N-1), edist (f (w (i + 1))) (f (w i)) + + edist (f (w (N + 1))) (f (w (N - 1))) + + ∑ i in finset.Ico (N + 1) (n + 1), edist (f (w (i + 1))) (f (w (i))) : + begin + congr' 1, congr' 1, + { dsimp only [w], + have A : ¬(N + 1 < N) := nat.not_succ_lt_self, + have B : N - 1 < N := nat.pred_lt Npos.ne', + simp only [A, not_and, not_lt, nat.succ_ne_self, nat.add_succ_sub_one, add_zero, if_false, + B, if_true] }, + { exact finset.sum_Ico_add (λ i, edist (f (w (i + 1))) (f (w i))) N n 1 } + end + ... ≤ ∑ i in finset.Ico 0 (N - 1), edist (f (w (i + 1))) (f (w i)) + + ∑ i in finset.Ico (N - 1) (N + 1), edist (f (w (i + 1))) (f (w i)) + + ∑ i in finset.Ico (N + 1) (n + 1), edist (f (w (i + 1))) (f (w i)) : + begin + refine add_le_add (add_le_add le_rfl _) le_rfl, + have A : N - 1 + 1 = N := nat.succ_pred_eq_of_pos Npos, + have B : N - 1 + 1 < N + 1 := A.symm ▸ N.lt_succ_self, + have C : N - 1 < N + 1 := lt_of_le_of_lt (N.pred_le) (N.lt_succ_self), + rw [finset.sum_eq_sum_Ico_succ_bot C, finset.sum_eq_sum_Ico_succ_bot B, A, finset.Ico_self, + finset.sum_empty, add_zero, add_comm (edist _ _)], + exact edist_triangle _ _ _, + end + ... = ∑ j in finset.range (n + 1), edist (f (w (j + 1))) (f (w j)) : + begin + rw [finset.sum_Ico_consecutive, finset.sum_Ico_consecutive, finset.range_eq_Ico], + { exact zero_le _ }, + { exact nat.succ_le_succ hN.left }, + { exact zero_le _ }, + { exact N.pred_le.trans (N.le_succ) } + end } +end + +/-- The variation of a function on the union of two sets `s` and `t`, with `s` to the left of `t`, +bounds the sum of the variations along `s` and `t`. -/ +lemma add_le_union (f : α → E) {s t : set α} (h : ∀ x ∈ s, ∀ y ∈ t, x ≤ y) : + evariation_on f s + evariation_on f t ≤ evariation_on f (s ∪ t) := +begin + by_cases hs : s = ∅, + { simp [hs] }, + haveI : nonempty {u // monotone u ∧ ∀ (i : ℕ), u i ∈ s}, + from nonempty_monotone_mem (nonempty_iff_ne_empty.2 hs), + by_cases ht : t = ∅, + { simp [ht] }, + haveI : nonempty {u // monotone u ∧ ∀ (i : ℕ), u i ∈ t}, + from nonempty_monotone_mem (nonempty_iff_ne_empty.2 ht), + refine ennreal.supr_add_supr_le _, + /- We start from two sequences `u` and `v` along `s` and `t` respectively, and we build a new + sequence `w` along `s ∪ t` by juxtaposing them. Its variation is larger than the sum of the + variations. -/ + rintros ⟨n, ⟨u, hu, us⟩⟩ ⟨m, ⟨v, hv, vt⟩⟩, + let w := λ i, if i ≤ n then u i else v (i - (n+1)), + have wst : ∀ i, w i ∈ s ∪ t, + { assume i, + by_cases hi : i ≤ n, + { simp [w, hi, us] }, + { simp [w, hi, vt] } }, + have hw : monotone w, + { assume i j hij, + dsimp only [w], + split_ifs, + { exact hu hij }, + { apply h _ (us _) _ (vt _) }, + { exfalso, exact h_1 (hij.trans h_2), }, + { apply hv (tsub_le_tsub hij le_rfl) } }, + calc ∑ i in finset.range n, edist (f (u (i + 1))) (f (u i)) + + ∑ (i : ℕ) in finset.range m, edist (f (v (i + 1))) (f (v i)) + = ∑ i in finset.range n, edist (f (w (i + 1))) (f (w i)) + + ∑ (i : ℕ) in finset.range m, edist (f (w ((n+1) + i + 1))) (f (w ((n+1) + i))) : + begin + dsimp only [w], + congr' 1, + { apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_range] at hi, + have : i + 1 ≤ n := nat.succ_le_of_lt hi, + simp [hi.le, this] }, + { apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_range] at hi, + have B : ¬(n + 1 + i ≤ n), by linarith, + have A : ¬(n + 1 + i + 1 ≤ n) := λ h, B ((n+1+i).le_succ.trans h), + have C : n + 1 + i - n = i + 1, + { rw tsub_eq_iff_eq_add_of_le, + { abel }, + { exact n.le_succ.trans (n.succ.le_add_right i), } }, + simp only [A, B, C, nat.succ_sub_succ_eq_sub, if_false, add_tsub_cancel_left] } + end + ... = ∑ i in finset.range n, edist (f (w (i + 1))) (f (w i)) + + ∑ (i : ℕ) in finset.Ico (n+1) ((n+1)+m), edist (f (w (i + 1))) (f (w i)) : + begin + congr' 1, + rw finset.range_eq_Ico, + convert finset.sum_Ico_add (λ (i : ℕ), edist (f (w (i + 1))) (f (w i))) 0 m (n+1) using 3; + abel, + end + ... ≤ ∑ i in finset.range ((n+1) + m), edist (f (w (i + 1))) (f (w i)) : + begin + rw ← finset.sum_union, + { apply finset.sum_le_sum_of_subset _, + rintros i hi, + simp only [finset.mem_union, finset.mem_range, finset.mem_Ico] at hi ⊢, + cases hi, + { exact lt_of_lt_of_le hi (n.le_succ.trans (n.succ.le_add_right m)) }, + { exact hi.2 } }, + { apply finset.disjoint_left.2 (λ i hi h'i, _), + simp only [finset.mem_Ico, finset.mem_range] at hi h'i, + exact hi.not_lt (nat.lt_of_succ_le h'i.left) } + end + ... ≤ evariation_on f (s ∪ t) : sum_le f _ hw wst +end + +/-- If a set `s` is to the left of a set `t`, and both contain the boundary point `x`, then +the variation of `f` along `s ∪ t` is the sum of the variations. -/ +lemma union (f : α → E) {s t : set α} {x : α} (hs : is_greatest s x) (ht : is_least t x) : + evariation_on f (s ∪ t) = evariation_on f s + evariation_on f t := +begin + classical, + apply le_antisymm _ (evariation_on.add_le_union f (λ a ha b hb, le_trans (hs.2 ha) (ht.2 hb))), + apply supr_le _, + rintros ⟨n, ⟨u, hu, ust⟩⟩, + obtain ⟨v, m, hv, vst, xv, huv⟩ : ∃ (v : ℕ → α) (m : ℕ), monotone v ∧ (∀ i, v i ∈ s ∪ t) ∧ + x ∈ v '' (Iio m) ∧ ∑ i in finset.range n, edist (f (u (i+1))) (f (u i)) ≤ + ∑ j in finset.range m, edist (f (v (j+1))) (f (v j)), + from evariation_on.add_point f (mem_union_left t hs.1) u hu ust n, + obtain ⟨N, hN, Nx⟩ : ∃ N, N < m ∧ v N = x, from xv, + calc ∑ j in finset.range n, edist (f (u (j + 1))) (f (u j)) + ≤ ∑ j in finset.range m, edist (f (v (j + 1))) (f (v j)) : huv + ... = ∑ j in finset.Ico 0 N , edist (f (v (j + 1))) (f (v j)) + + ∑ j in finset.Ico N m , edist (f (v (j + 1))) (f (v j)) : + by rw [finset.range_eq_Ico, finset.sum_Ico_consecutive _ (zero_le _) hN.le] + ... ≤ evariation_on f s + evariation_on f t : + begin + refine add_le_add _ _, + { apply sum_le_of_monotone_on_Icc _ (hv.monotone_on _) (λ i hi, _), + rcases vst i with h|h, { exact h }, + have : v i = x, + { apply le_antisymm, + { rw ← Nx, exact hv hi.2 }, + { exact ht.2 h } }, + rw this, + exact hs.1 }, + { apply sum_le_of_monotone_on_Icc _ (hv.monotone_on _) (λ i hi, _), + rcases vst i with h|h, swap, { exact h }, + have : v i = x, + { apply le_antisymm, + { exact hs.2 h }, + { rw ← Nx, exact hv hi.1 } }, + rw this, + exact ht.1 } + end +end + +lemma Icc_add_Icc (f : α → E) {s : set α} {a b c : α} + (hab : a ≤ b) (hbc : b ≤ c) (hb : b ∈ s) : + evariation_on f (s ∩ Icc a b) + evariation_on f (s ∩ Icc b c) = evariation_on f (s ∩ Icc a c) := +begin + have A : is_greatest (s ∩ Icc a b) b := + ⟨⟨hb, hab, le_rfl⟩, (inter_subset_right _ _).trans (Icc_subset_Iic_self)⟩, + have B : is_least (s ∩ Icc b c) b := + ⟨⟨hb, le_rfl, hbc⟩, (inter_subset_right _ _).trans (Icc_subset_Ici_self)⟩, + rw [← evariation_on.union f A B, ← inter_union_distrib_left, Icc_union_Icc_eq_Icc hab hbc], +end + +lemma comp_le_of_monotone_on (f : α → E) {s : set α} {t : set β} (φ : β → α) + (hφ : monotone_on φ t) (φst : maps_to φ t s) : + evariation_on (f ∘ φ) t ≤ evariation_on f s := +supr_le $ λ ⟨n, u, hu, ut⟩, le_supr_of_le + ⟨n, φ ∘ u, λ x y xy, hφ (ut x) (ut y) (hu xy), λ i, φst (ut i)⟩ le_rfl + +lemma comp_le_of_antitone_on (f : α → E) {s : set α} {t : set β} (φ : β → α) + (hφ : antitone_on φ t) (φst : maps_to φ t s) : + evariation_on (f ∘ φ) t ≤ evariation_on f s := +begin + refine supr_le _, + rintro ⟨n, u, hu, ut⟩, + rw ←finset.sum_range_reflect, + refine (finset.sum_congr rfl $ λ x hx, _).trans_le (le_supr_of_le ⟨n, λ i, φ (u $ n-i), + λ x y xy, hφ (ut _) (ut _) (hu $ n.sub_le_sub_left xy), λ i, φst (ut _)⟩ le_rfl), + dsimp only [subtype.coe_mk], + rw [edist_comm, nat.sub_sub, add_comm, nat.sub_succ, nat.add_one, nat.succ_pred_eq_of_pos], + simpa only [tsub_pos_iff_lt, finset.mem_range] using hx, +end + +lemma comp_eq_of_monotone_on (f : α → E) {t : set β} (φ : β → α) (hφ : monotone_on φ t) : + evariation_on (f ∘ φ) t = evariation_on f (φ '' t) := +begin + apply le_antisymm (comp_le_of_monotone_on f φ hφ (maps_to_image φ t)), + casesI is_empty_or_nonempty β, + { convert zero_le _, + exact evariation_on.subsingleton f + ((subsingleton_of_subsingleton.image _).anti (surj_on_image φ t)) }, + let ψ := φ.inv_fun_on t, + have ψφs : eq_on (φ ∘ ψ) id (φ '' t) := (surj_on_image φ t).right_inv_on_inv_fun_on, + have ψts : maps_to ψ (φ '' t) t := (surj_on_image φ t).maps_to_inv_fun_on, + have hψ : monotone_on ψ (φ '' t) := + function.monotone_on_of_right_inv_on_of_maps_to hφ ψφs ψts, + change evariation_on (f ∘ id) (φ '' t) ≤ evariation_on (f ∘ φ) t, + rw ←eq_of_eq_on (ψφs.comp_left : eq_on (f ∘ (φ ∘ ψ)) (f ∘ id) (φ '' t)), + exact comp_le_of_monotone_on _ ψ hψ ψts, +end + +-- porting note: move to file `data.set.intervals.basic` once the port is over, +-- and use it in theorem `polynomial_functions_closure_eq_top` +-- in the file `topology/continuous_function/weierstrass.lean` +lemma _root_.set.subsingleton_Icc_of_ge {α : Type*} [partial_order α] {a b : α} (h : b ≤ a) : + set.subsingleton (Icc a b) := +begin + rintros c ⟨ac,cb⟩ d ⟨ad,db⟩, + cases le_antisymm (cb.trans h) ac, + cases le_antisymm (db.trans h) ad, + refl, +end + +lemma comp_inter_Icc_eq_of_monotone_on (f : α → E) {t : set β} (φ : β → α) + (hφ : monotone_on φ t) {x y : β} (hx : x ∈ t) (hy : y ∈ t) : + evariation_on (f ∘ φ) (t ∩ Icc x y) = evariation_on f ((φ '' t) ∩ Icc (φ x) (φ y)) := +begin + rcases le_total x y with h|h, + { convert comp_eq_of_monotone_on f φ (hφ.mono (set.inter_subset_left t (Icc x y))), + apply le_antisymm, + { rintro _ ⟨⟨u, us, rfl⟩, vφx, vφy⟩, + rcases le_total x u with xu|ux, + { rcases le_total u y with uy|yu, + { exact ⟨u, ⟨us, ⟨xu, uy⟩⟩, rfl⟩, }, + { rw le_antisymm vφy (hφ hy us yu), + exact ⟨y, ⟨hy, ⟨h, le_rfl⟩⟩, rfl⟩, }, }, + { rw ←le_antisymm vφx (hφ us hx ux), + exact ⟨x, ⟨hx, ⟨le_rfl, h⟩⟩, rfl⟩, }, }, + { rintro _ ⟨u, ⟨⟨hu, xu, uy⟩, rfl⟩⟩, + refine ⟨⟨u, hu, rfl⟩, ⟨hφ hx hu xu, hφ hu hy uy⟩⟩, }, }, + { rw [evariation_on.subsingleton, evariation_on.subsingleton], + exacts [(set.subsingleton_Icc_of_ge (hφ hy hx h)).anti (set.inter_subset_right _ _), + (set.subsingleton_Icc_of_ge h).anti (set.inter_subset_right _ _)], }, +end + +lemma comp_eq_of_antitone_on (f : α → E) {t : set β} (φ : β → α) (hφ : antitone_on φ t) : + evariation_on (f ∘ φ) t = evariation_on f (φ '' t) := +begin + apply le_antisymm (comp_le_of_antitone_on f φ hφ (maps_to_image φ t)), + casesI is_empty_or_nonempty β, + { convert zero_le _, + exact evariation_on.subsingleton f + ((subsingleton_of_subsingleton.image _).anti (surj_on_image φ t)) }, + let ψ := φ.inv_fun_on t, + have ψφs : eq_on (φ ∘ ψ) id (φ '' t) := (surj_on_image φ t).right_inv_on_inv_fun_on, + have ψts := (surj_on_image φ t).maps_to_inv_fun_on, + have hψ : antitone_on ψ (φ '' t) := + function.antitone_on_of_right_inv_on_of_maps_to hφ ψφs ψts, + change evariation_on (f ∘ id) (φ '' t) ≤ evariation_on (f ∘ φ) t, + rw ←eq_of_eq_on (ψφs.comp_left : eq_on (f ∘ (φ ∘ ψ)) (f ∘ id) (φ '' t)), + exact comp_le_of_antitone_on _ ψ hψ ψts, +end + +open order_dual + +lemma comp_of_dual (f : α → E) (s : set α) : + evariation_on (f ∘ of_dual) (of_dual ⁻¹' s) = evariation_on f s := +begin + convert comp_eq_of_antitone_on f of_dual (λ _ _ _ _, id), + simp only [equiv.image_preimage], +end + +end evariation_on + +/-! ## Monotone functions and bounded variation -/ + +lemma monotone_on.evariation_on_le {f : α → ℝ} {s : set α} (hf : monotone_on f s) {a b : α} + (as : a ∈ s) (bs : b ∈ s) : + evariation_on f (s ∩ Icc a b) ≤ ennreal.of_real (f b - f a) := +begin + apply supr_le _, + rintros ⟨n, ⟨u, hu, us⟩⟩, + calc + ∑ i in finset.range n, edist (f (u (i+1))) (f (u i)) + = ∑ i in finset.range n, ennreal.of_real (f (u (i + 1)) - f (u i)) : + begin + apply finset.sum_congr rfl (λ i hi, _), + simp only [finset.mem_range] at hi, + rw [edist_dist, real.dist_eq, abs_of_nonneg], + exact sub_nonneg_of_le (hf (us i).1 (us (i+1)).1 (hu (nat.le_succ _))), + end + ... = ennreal.of_real (∑ i in finset.range n, (f (u (i + 1)) - f (u i))) : + begin + rw [ennreal.of_real_sum_of_nonneg], + assume i hi, + exact sub_nonneg_of_le (hf (us i).1 (us (i+1)).1 (hu (nat.le_succ _))) + end + ... = ennreal.of_real (f (u n) - f (u 0)) : by rw finset.sum_range_sub (λ i, f (u i)) + ... ≤ ennreal.of_real (f b - f a) : + begin + apply ennreal.of_real_le_of_real, + exact sub_le_sub (hf (us n).1 bs (us n).2.2) (hf as (us 0).1 (us 0).2.1), + end +end + +lemma monotone_on.has_locally_bounded_variation_on {f : α → ℝ} {s : set α} (hf : monotone_on f s) : + has_locally_bounded_variation_on f s := +λ a b as bs, ((hf.evariation_on_le as bs).trans_lt ennreal.of_real_lt_top).ne + +/-- +The **signed** variation of `f` on the interval `Icc a b` intersected with the set `s`, +squashed to a real (therefore only really meaningful if the variation is finite) +-/ +noncomputable def variation_on_from_to (f : α → E) (s : set α) (a b : α) : ℝ := +if a ≤ b then (evariation_on f (s ∩ Icc a b)).to_real else + - (evariation_on f (s ∩ Icc b a)).to_real + +namespace variation_on_from_to + +variables (f : α → E) (s : set α) + +@[protected] +lemma self (a : α) : variation_on_from_to f s a a = 0 := +begin + dsimp only [variation_on_from_to], + rw [if_pos le_rfl, Icc_self, evariation_on.subsingleton, ennreal.zero_to_real], + exact λ x hx y hy, hx.2.trans hy.2.symm, +end + +@[protected] +lemma nonneg_of_le {a b : α} (h : a ≤ b) : 0 ≤ variation_on_from_to f s a b := +by simp only [variation_on_from_to, if_pos h, ennreal.to_real_nonneg] + +@[protected] +lemma eq_neg_swap (a b : α) : + variation_on_from_to f s a b = - variation_on_from_to f s b a := +begin + rcases lt_trichotomy a b with ab|rfl|ba, + { simp only [variation_on_from_to, if_pos ab.le, if_neg ab.not_le, neg_neg], }, + { simp only [self, neg_zero], }, + { simp only [variation_on_from_to, if_pos ba.le, if_neg ba.not_le, neg_neg], }, +end + +@[protected] +lemma nonpos_of_ge {a b : α} (h : b ≤ a) : variation_on_from_to f s a b ≤ 0 := +begin + rw eq_neg_swap, + exact neg_nonpos_of_nonneg (nonneg_of_le f s h), +end + +@[protected] +lemma eq_of_le {a b : α} (h : a ≤ b) : + variation_on_from_to f s a b = (evariation_on f (s ∩ Icc a b)).to_real := if_pos h + +@[protected] +lemma eq_of_ge {a b : α} (h : b ≤ a) : + variation_on_from_to f s a b = - (evariation_on f (s ∩ Icc b a)).to_real := +by rw [eq_neg_swap, neg_inj, eq_of_le f s h] + +@[protected] +lemma add {f : α → E} {s : set α} (hf : has_locally_bounded_variation_on f s) + {a b c : α} (ha : a ∈ s) (hb : b ∈ s) (hc : c ∈ s) : + variation_on_from_to f s a b + variation_on_from_to f s b c = variation_on_from_to f s a c := +begin + symmetry, + refine additive_of_is_total (≤) (variation_on_from_to f s) (∈s) _ _ ha hb hc, + { rintro x y xs ys, + simp only [eq_neg_swap f s y x, subtype.coe_mk, add_right_neg, forall_true_left], }, + { rintro x y z xy yz xs ys zs, + rw [eq_of_le f s xy, eq_of_le f s yz, eq_of_le f s (xy.trans yz), + ←ennreal.to_real_add (hf x y xs ys) (hf y z ys zs), + evariation_on.Icc_add_Icc f xy yz ys], }, +end + +@[protected] +lemma edist_zero_of_eq_zero + {f : α → E} {s : set α} (hf : has_locally_bounded_variation_on f s) + {a b : α} (ha : a ∈ s) (hb : b ∈ s) (h : variation_on_from_to f s a b = 0) : + edist (f a) (f b) = 0 := +begin + wlog h' : a ≤ b, + { rw edist_comm, + apply this hf hb ha _ (le_of_not_le h'), + rw [eq_neg_swap, h, neg_zero] }, + { apply le_antisymm _ (zero_le _), + rw [←ennreal.of_real_zero, ←h, eq_of_le f s h', ennreal.of_real_to_real (hf a b ha hb)], + apply evariation_on.edist_le, + exacts [⟨ha, ⟨le_rfl, h'⟩⟩, ⟨hb, ⟨h', le_rfl⟩⟩] }, +end + +@[protected] +lemma eq_left_iff + {f : α → E} {s : set α} (hf : has_locally_bounded_variation_on f s) + {a b c : α} (ha : a ∈ s) (hb : b ∈ s) (hc : c ∈ s) : + variation_on_from_to f s a b = variation_on_from_to f s a c ↔ variation_on_from_to f s b c = 0 := +by simp only [←add hf ha hb hc, self_eq_add_right] + +@[protected] +lemma eq_zero_iff_of_le + {f : α → E} {s : set α} (hf : has_locally_bounded_variation_on f s) + {a b : α} (ha : a ∈ s) (hb : b ∈ s) (ab : a ≤ b) : + variation_on_from_to f s a b = 0 ↔ + ∀ ⦃x⦄ (hx : x ∈ s ∩ Icc a b) ⦃y⦄ (hy : y ∈ s ∩ Icc a b), edist (f x) (f y) = 0 := +by rw [eq_of_le _ _ ab, ennreal.to_real_eq_zero_iff, + or_iff_left (hf a b ha hb), evariation_on.eq_zero_iff] + +@[protected] +lemma eq_zero_iff_of_ge + {f : α → E} {s : set α} (hf : has_locally_bounded_variation_on f s) + {a b : α} (ha : a ∈ s) (hb : b ∈ s) (ba : b ≤ a) : + variation_on_from_to f s a b = 0 ↔ + ∀ ⦃x⦄ (hx : x ∈ s ∩ Icc b a) ⦃y⦄ (hy : y ∈ s ∩ Icc b a), edist (f x) (f y) = 0 := +by rw [eq_of_ge _ _ ba, neg_eq_zero, ennreal.to_real_eq_zero_iff, + or_iff_left (hf b a hb ha), evariation_on.eq_zero_iff] + +@[protected] +lemma eq_zero_iff + {f : α → E} {s : set α} (hf : has_locally_bounded_variation_on f s) + {a b : α} (ha : a ∈ s) (hb : b ∈ s) : + variation_on_from_to f s a b = 0 ↔ + ∀ ⦃x⦄ (hx : x ∈ s ∩ uIcc a b) ⦃y⦄ (hy : y ∈ s ∩ uIcc a b), edist (f x) (f y) = 0 := +begin + rcases le_total a b with ab|ba, + { rw uIcc_of_le ab, + exact eq_zero_iff_of_le hf ha hb ab, }, + { rw uIcc_of_ge ba, + exact eq_zero_iff_of_ge hf ha hb ba, }, +end + +variables {f} {s} + +@[protected] +lemma monotone_on (hf : has_locally_bounded_variation_on f s) + {a : α} (as : a ∈ s) : monotone_on (variation_on_from_to f s a) s := +begin + rintro b bs c cs bc, + rw ←add hf as bs cs, + exact le_add_of_nonneg_right (nonneg_of_le f s bc), +end + +@[protected] +lemma antitone_on (hf : has_locally_bounded_variation_on f s) + {b : α} (bs : b ∈ s) : antitone_on (λ a, variation_on_from_to f s a b) s := +begin + rintro a as c cs ac, + dsimp only, + rw ←add hf as cs bs, + exact le_add_of_nonneg_left (nonneg_of_le f s ac), +end + +@[protected] +lemma sub_self_monotone_on {f : α → ℝ} {s : set α} + (hf : has_locally_bounded_variation_on f s) {a : α} (as : a ∈ s) : + monotone_on (variation_on_from_to f s a - f) s := +begin + rintro b bs c cs bc, + rw [pi.sub_apply, pi.sub_apply, le_sub_iff_add_le, add_comm_sub, ← le_sub_iff_add_le'], + calc f c - f b + ≤ |f c - f b| : le_abs_self _ + ... = dist (f b) (f c) : by rw [dist_comm, real.dist_eq] + ... ≤ variation_on_from_to f s b c : by + { rw [eq_of_le f s bc, dist_edist], + apply ennreal.to_real_mono (hf b c bs cs), + apply evariation_on.edist_le f, + exacts [⟨bs, le_rfl, bc⟩, ⟨cs, bc, le_rfl⟩] } + ... = variation_on_from_to f s a c - variation_on_from_to f s a b : + by rw [←add hf as bs cs, add_sub_cancel'] +end + +@[protected] +lemma comp_eq_of_monotone_on (f : α → E) {t : set β} (φ : β → α) (hφ : monotone_on φ t) + {x y : β} (hx : x ∈ t) (hy : y ∈ t) : + variation_on_from_to (f ∘ φ) t x y = variation_on_from_to f (φ '' t) (φ x) (φ y) := +begin + rcases le_total x y with h|h, + { rw [eq_of_le _ _ h, eq_of_le _ _ (hφ hx hy h), + evariation_on.comp_inter_Icc_eq_of_monotone_on f φ hφ hx hy], }, + { rw [eq_of_ge _ _ h, eq_of_ge _ _ (hφ hy hx h), + evariation_on.comp_inter_Icc_eq_of_monotone_on f φ hφ hy hx], }, +end + +end variation_on_from_to + +/-- If a real valued function has bounded variation on a set, then it is a difference of monotone +functions there. -/ +lemma has_locally_bounded_variation_on.exists_monotone_on_sub_monotone_on {f : α → ℝ} {s : set α} + (h : has_locally_bounded_variation_on f s) : + ∃ (p q : α → ℝ), monotone_on p s ∧ monotone_on q s ∧ f = p - q := +begin + rcases eq_empty_or_nonempty s with rfl|⟨c, cs⟩, + { exact ⟨f, 0, subsingleton_empty.monotone_on _, subsingleton_empty.monotone_on _, + (sub_zero f).symm⟩ }, + { exact ⟨_, _, variation_on_from_to.monotone_on h cs, + variation_on_from_to.sub_self_monotone_on h cs, (sub_sub_cancel _ _).symm⟩ }, +end + +/-! ## Lipschitz functions and bounded variation -/ + +lemma lipschitz_on_with.comp_evariation_on_le {f : E → F} {C : ℝ≥0} {t : set E} + (h : lipschitz_on_with C f t) {g : α → E} {s : set α} (hg : maps_to g s t) : + evariation_on (f ∘ g) s ≤ C * evariation_on g s := +begin + apply supr_le _, + rintros ⟨n, ⟨u, hu, us⟩⟩, + calc + ∑ i in finset.range n, edist (f (g (u (i+1)))) (f (g (u i))) + ≤ ∑ i in finset.range n, C * edist (g (u (i+1))) (g (u i)) : + finset.sum_le_sum (λ i hi, h (hg (us _)) (hg (us _))) + ... = C * ∑ i in finset.range n, edist (g (u (i+1))) (g (u i)) : by rw finset.mul_sum + ... ≤ C * evariation_on g s : mul_le_mul_left' (evariation_on.sum_le _ _ hu us) _ +end + +lemma lipschitz_on_with.comp_has_bounded_variation_on {f : E → F} {C : ℝ≥0} {t : set E} + (hf : lipschitz_on_with C f t) {g : α → E} {s : set α} (hg : maps_to g s t) + (h : has_bounded_variation_on g s) : + has_bounded_variation_on (f ∘ g) s := +ne_top_of_le_ne_top (ennreal.mul_ne_top ennreal.coe_ne_top h) (hf.comp_evariation_on_le hg) + +lemma lipschitz_on_with.comp_has_locally_bounded_variation_on {f : E → F} {C : ℝ≥0} {t : set E} + (hf : lipschitz_on_with C f t) {g : α → E} {s : set α} (hg : maps_to g s t) + (h : has_locally_bounded_variation_on g s) : + has_locally_bounded_variation_on (f ∘ g) s := +λ x y xs ys, hf.comp_has_bounded_variation_on (hg.mono_left (inter_subset_left _ _)) (h x y xs ys) + +lemma lipschitz_with.comp_has_bounded_variation_on {f : E → F} {C : ℝ≥0} + (hf : lipschitz_with C f) {g : α → E} {s : set α} (h : has_bounded_variation_on g s) : + has_bounded_variation_on (f ∘ g) s := +(hf.lipschitz_on_with univ).comp_has_bounded_variation_on (maps_to_univ _ _) h + +lemma lipschitz_with.comp_has_locally_bounded_variation_on {f : E → F} {C : ℝ≥0} + (hf : lipschitz_with C f) {g : α → E} {s : set α} (h : has_locally_bounded_variation_on g s) : + has_locally_bounded_variation_on (f ∘ g) s := +(hf.lipschitz_on_with univ).comp_has_locally_bounded_variation_on (maps_to_univ _ _) h + +lemma lipschitz_on_with.has_locally_bounded_variation_on {f : ℝ → E} {C : ℝ≥0} {s : set ℝ} + (hf : lipschitz_on_with C f s) : has_locally_bounded_variation_on f s := +hf.comp_has_locally_bounded_variation_on (maps_to_id _) + (@monotone_on_id ℝ _ s).has_locally_bounded_variation_on + +lemma lipschitz_with.has_locally_bounded_variation_on {f : ℝ → E} {C : ℝ≥0} + (hf : lipschitz_with C f) (s : set ℝ) : has_locally_bounded_variation_on f s := +(hf.lipschitz_on_with s).has_locally_bounded_variation_on + + +/-! ## Almost everywhere differentiability of functions with locally bounded variation -/ + +namespace has_locally_bounded_variation_on + +/-- A bounded variation function into `ℝ` is differentiable almost everywhere. Superseded by +`ae_differentiable_within_at_of_mem`. -/ +theorem ae_differentiable_within_at_of_mem_real + {f : ℝ → ℝ} {s : set ℝ} (h : has_locally_bounded_variation_on f s) : + ∀ᵐ x, x ∈ s → differentiable_within_at ℝ f s x := +begin + obtain ⟨p, q, hp, hq, fpq⟩ : ∃ p q, monotone_on p s ∧ monotone_on q s ∧ f = p - q, + from h.exists_monotone_on_sub_monotone_on, + filter_upwards [hp.ae_differentiable_within_at_of_mem, hq.ae_differentiable_within_at_of_mem] + with x hxp hxq xs, + have fpq : ∀ x, f x = p x - q x, by simp [fpq], + refine ((hxp xs).sub (hxq xs)).congr (λ y hy, fpq y) (fpq x), +end + +/-- A bounded variation function into a finite dimensional product vector space is differentiable +almost everywhere. Superseded by `ae_differentiable_within_at_of_mem`. -/ +theorem ae_differentiable_within_at_of_mem_pi {ι : Type*} [fintype ι] + {f : ℝ → (ι → ℝ)} {s : set ℝ} (h : has_locally_bounded_variation_on f s) : + ∀ᵐ x, x ∈ s → differentiable_within_at ℝ f s x := +begin + have A : ∀ (i : ι), lipschitz_with 1 (λ (x : ι → ℝ), x i) := λ i, lipschitz_with.eval i, + have : ∀ (i : ι), ∀ᵐ x, x ∈ s → differentiable_within_at ℝ (λ (x : ℝ), f x i) s x, + { assume i, + apply ae_differentiable_within_at_of_mem_real, + exact lipschitz_with.comp_has_locally_bounded_variation_on (A i) h }, + filter_upwards [ae_all_iff.2 this] with x hx xs, + exact differentiable_within_at_pi.2 (λ i, hx i xs), +end + +/-- A real function into a finite dimensional real vector space with bounded variation on a set +is differentiable almost everywhere in this set. -/ +theorem ae_differentiable_within_at_of_mem + {f : ℝ → V} {s : set ℝ} (h : has_locally_bounded_variation_on f s) : + ∀ᵐ x, x ∈ s → differentiable_within_at ℝ f s x := +begin + let A := (basis.of_vector_space ℝ V).equiv_fun.to_continuous_linear_equiv, + suffices H : ∀ᵐ x, x ∈ s → differentiable_within_at ℝ (A ∘ f) s x, + { filter_upwards [H] with x hx xs, + have : f = (A.symm ∘ A) ∘ f, + by simp only [continuous_linear_equiv.symm_comp_self, function.comp.left_id], + rw this, + exact A.symm.differentiable_at.comp_differentiable_within_at x (hx xs) }, + apply ae_differentiable_within_at_of_mem_pi, + exact A.lipschitz.comp_has_locally_bounded_variation_on h, +end + +/-- A real function into a finite dimensional real vector space with bounded variation on a set +is differentiable almost everywhere in this set. -/ +theorem ae_differentiable_within_at + {f : ℝ → V} {s : set ℝ} (h : has_locally_bounded_variation_on f s) (hs : measurable_set s) : + ∀ᵐ x ∂(volume.restrict s), differentiable_within_at ℝ f s x := +begin + rw ae_restrict_iff' hs, + exact h.ae_differentiable_within_at_of_mem +end + +/-- A real function into a finite dimensional real vector space with bounded variation +is differentiable almost everywhere. -/ +theorem ae_differentiable_at {f : ℝ → V} (h : has_locally_bounded_variation_on f univ) : + ∀ᵐ x, differentiable_at ℝ f x := +begin + filter_upwards [h.ae_differentiable_within_at_of_mem] with x hx, + rw differentiable_within_at_univ at hx, + exact hx (mem_univ _), +end + +end has_locally_bounded_variation_on + +/-- A real function into a finite dimensional real vector space which is Lipschitz on a set +is differentiable almost everywhere in this set . -/ +lemma lipschitz_on_with.ae_differentiable_within_at_of_mem + {C : ℝ≥0} {f : ℝ → V} {s : set ℝ} (h : lipschitz_on_with C f s) : + ∀ᵐ x, x ∈ s → differentiable_within_at ℝ f s x := +h.has_locally_bounded_variation_on.ae_differentiable_within_at_of_mem + +/-- A real function into a finite dimensional real vector space which is Lipschitz on a set +is differentiable almost everywhere in this set. -/ +lemma lipschitz_on_with.ae_differentiable_within_at + {C : ℝ≥0} {f : ℝ → V} {s : set ℝ} (h : lipschitz_on_with C f s) (hs : measurable_set s) : + ∀ᵐ x ∂(volume.restrict s), differentiable_within_at ℝ f s x := +h.has_locally_bounded_variation_on.ae_differentiable_within_at hs + +/-- A real Lipschitz function into a finite dimensional real vector space is differentiable +almost everywhere. -/ +lemma lipschitz_with.ae_differentiable_at + {C : ℝ≥0} {f : ℝ → V} (h : lipschitz_with C f) : + ∀ᵐ x, differentiable_at ℝ f x := +(h.has_locally_bounded_variation_on univ).ae_differentiable_at diff --git a/src/analysis/box_integral/basic.lean b/src/analysis/box_integral/basic.lean index 0449ea5728472..a02b18afc77bd 100644 --- a/src/analysis/box_integral/basic.lean +++ b/src/analysis/box_integral/basic.lean @@ -5,11 +5,14 @@ Authors: Yury Kudryashov -/ import analysis.box_integral.partition.filter import analysis.box_integral.partition.measure -import topology.uniform_space.compact_separated +import topology.uniform_space.compact /-! # Integrals of Riemann, Henstock-Kurzweil, and McShane +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define the integral of a function over a box in `ℝⁿ. The same definition works for Riemann, Henstock-Kurzweil, and McShane integrals. @@ -48,7 +51,7 @@ non-Riemann filter (e.g., Henstock-Kurzweil and McShane). integral -/ -open_locale big_operators classical topological_space nnreal filter uniformity box_integral +open_locale big_operators classical topology nnreal filter uniformity box_integral open set finset function filter metric box_integral.integration_params noncomputable theory @@ -57,8 +60,8 @@ namespace box_integral universes u v w -variables {ι : Type u} {E : Type v} {F : Type w} [normed_group E] [normed_space ℝ E] - [normed_group F] [normed_space ℝ F] {I J : box ι} {π : tagged_prepartition I} +variables {ι : Type u} {E : Type v} {F : Type w} [normed_add_comm_group E] [normed_space ℝ E] + [normed_add_comm_group F] [normed_space ℝ F] {I J : box ι} {π : tagged_prepartition I} open tagged_prepartition @@ -207,7 +210,7 @@ begin (l.has_basis_to_filter_Union_top _).prod_self.tendsto_iff uniformity_basis_dist_le], refine forall₂_congr (λ ε ε0, exists_congr $ λ r, _), simp only [exists_prop, prod.forall, set.mem_Union, exists_imp_distrib, - prod_mk_mem_set_prod_eq, and_imp, mem_inter_eq, mem_set_of_eq], + prod_mk_mem_set_prod_eq, and_imp, mem_inter_iff, mem_set_of_eq], exact and_congr iff.rfl ⟨λ H c₁ c₂ π₁ π₂ h₁ hU₁ h₂ hU₂, H π₁ π₂ c₁ h₁ hU₁ c₂ h₂ hU₂, λ H π₁ π₂ c₁ h₁ hU₁ c₂ h₂ hU₂, H c₁ c₂ π₁ π₂ h₁ hU₁ h₂ hU₂⟩ end @@ -334,12 +337,12 @@ begin { rw [integral, dif_neg hgi] } end -/-- If `∥f x∥ ≤ g x` on `[l, u]` and `g` is integrable, then the norm of the integral of `f` is less +/-- If `‖f x‖ ≤ g x` on `[l, u]` and `g` is integrable, then the norm of the integral of `f` is less than or equal to the integral of `g`. -/ -lemma norm_integral_le_of_norm_le {g : ℝⁿ → ℝ} (hle : ∀ x ∈ I.Icc, ∥f x∥ ≤ g x) +lemma norm_integral_le_of_norm_le {g : ℝⁿ → ℝ} (hle : ∀ x ∈ I.Icc, ‖f x‖ ≤ g x) (μ : measure ℝⁿ) [is_locally_finite_measure μ] (hg : integrable I l g μ.to_box_additive.to_smul) : - ∥(integral I l f μ.to_box_additive.to_smul : E)∥ ≤ + ‖(integral I l f μ.to_box_additive.to_smul : E)‖ ≤ integral I l g μ.to_box_additive.to_smul := begin by_cases hfi : integrable.{u v v} I l f μ.to_box_additive.to_smul, @@ -352,9 +355,9 @@ begin exact integral_nonneg (λ x hx, (norm_nonneg _).trans (hle x hx)) μ } end -lemma norm_integral_le_of_le_const {c : ℝ} (hc : ∀ x ∈ I.Icc, ∥f x∥ ≤ c) +lemma norm_integral_le_of_le_const {c : ℝ} (hc : ∀ x ∈ I.Icc, ‖f x‖ ≤ c) (μ : measure ℝⁿ) [is_locally_finite_measure μ] : - ∥(integral I l f μ.to_box_additive.to_smul : E)∥ ≤ (μ I).to_real * c := + ‖(integral I l f μ.to_box_additive.to_smul : E)‖ ≤ (μ I).to_real * c := by simpa only [integral_const] using norm_integral_le_of_norm_le hc μ (integrable_const c) @@ -593,7 +596,7 @@ lemma tendsto_integral_sum_sum_integral (h : integrable I l f vol) (π₀ : prep begin refine ((l.has_basis_to_filter_Union I π₀).tendsto_iff nhds_basis_closed_ball).2 (λ ε ε0, _), refine ⟨h.convergence_r ε, h.convergence_r_cond ε, _⟩, - simp only [mem_inter_eq, set.mem_Union, mem_set_of_eq], + simp only [mem_inter_iff, set.mem_Union, mem_set_of_eq], rintro π ⟨c, hc, hU⟩, exact h.dist_integral_sum_sum_integral_le_of_mem_base_set_of_Union_eq ε0 hc hU end @@ -652,8 +655,8 @@ begin simp only [dist_eq_norm, integral_sum_sub_partitions _ _ h₁p h₂p, box_additive_map.to_smul_apply, ← smul_sub], have : ∀ J ∈ π₁.to_prepartition ⊓ π₂.to_prepartition, - ∥μ.to_box_additive J • (f ((π₁.inf_prepartition π₂.to_prepartition).tag J) - - f ((π₂.inf_prepartition π₁.to_prepartition).tag J))∥ ≤ μ.to_box_additive J * ε', + ‖μ.to_box_additive J • (f ((π₁.inf_prepartition π₂.to_prepartition).tag J) - + f ((π₂.inf_prepartition π₁.to_prepartition).tag J))‖ ≤ μ.to_box_additive J * ε', { intros J hJ, have : 0 ≤ μ.to_box_additive J, from ennreal.to_real_nonneg, rw [norm_smul, real.norm_eq_abs, abs_of_nonneg this, ← dist_eq_norm], @@ -707,7 +710,7 @@ begin rcases exists_pos_mul_lt ε0' (B I) with ⟨ε', ε'0, hεI⟩, set δ : ℝ≥0 → ℝⁿ → Ioi (0 : ℝ) := λ c x, if x ∈ s then δ₁ c x (εs x) else (δ₂ c) x ε', refine ⟨δ, λ c, l.r_cond_of_bRiemann_eq_ff hl, _⟩, - simp only [set.mem_Union, mem_inter_eq, mem_set_of_eq], + simp only [set.mem_Union, mem_inter_iff, mem_set_of_eq], rintro π ⟨c, hπδ, hπp⟩, /- Now we split the sum into two parts based on whether `π.tag J` belongs to `s` or not. -/ rw [← g.sum_partition_boxes le_rfl hπp, mem_closed_ball, integral_sum, diff --git a/src/analysis/box_integral/box/basic.lean b/src/analysis/box_integral/box/basic.lean index c1158afc42622..71807a3aa84a4 100644 --- a/src/analysis/box_integral/box/basic.lean +++ b/src/analysis/box_integral/box/basic.lean @@ -10,6 +10,9 @@ import topology.metric_space.basic /-! # Rectangular boxes in `ℝⁿ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define rectangular boxes in `ℝⁿ`. As usual, we represent `ℝⁿ` as the type of functions `ι → ℝ` (usually `ι = fin n` for some `n`). When we need to interpret a box `[l, u]` as a set, we use the product `{x | ∀ i, l i < x i ∧ x i ≤ u i}` of half-open intervals `(l i, u i]`. We @@ -52,7 +55,7 @@ rectangular box open set function metric filter noncomputable theory -open_locale nnreal classical topological_space +open_locale nnreal classical topology namespace box_integral @@ -276,7 +279,7 @@ instance : lattice (with_bot (box ι)) := @[simp, norm_cast] lemma disjoint_with_bot_coe {I J : with_bot (box ι)} : disjoint (I : set (ι → ℝ)) J ↔ disjoint I J := -by { simp only [disjoint, ← with_bot_coe_subset_iff, coe_inf], refl } +by { simp only [disjoint_iff_inf_le, ← with_bot_coe_subset_iff, coe_inf], refl } lemma disjoint_coe : disjoint (I : with_bot (box ι)) J ↔ disjoint (I : set (ι → ℝ)) J := disjoint_with_bot_coe.symm @@ -335,7 +338,7 @@ lemma Ioo_subset_coe (I : box ι) : I.Ioo ⊆ I := λ x hx i, Ioo_subset_Ioc_sel protected lemma Ioo_subset_Icc (I : box ι) : I.Ioo ⊆ I.Icc := I.Ioo_subset_coe.trans coe_subset_Icc -lemma Union_Ioo_of_tendsto [fintype ι] {I : box ι} {J : ℕ → box ι} (hJ : monotone J) +lemma Union_Ioo_of_tendsto [finite ι] {I : box ι} {J : ℕ → box ι} (hJ : monotone J) (hl : tendsto (lower ∘ J) at_top (𝓝 I.lower)) (hu : tendsto (upper ∘ J) at_top (𝓝 I.upper)) : (⋃ n, (J n).Ioo) = I.Ioo := have hl' : ∀ i, antitone (λ n, (J n).lower i), @@ -374,14 +377,14 @@ lemma distortion_eq_of_sub_eq_div {I J : box ι} {r : ℝ} (h : ∀ i, I.upper i - I.lower i = (J.upper i - J.lower i) / r) : distortion I = distortion J := begin - simp only [distortion, nndist_pi_def, real.nndist_eq', h, real.nnabs.map_div], + simp only [distortion, nndist_pi_def, real.nndist_eq', h, map_div₀], congr' 1 with i, have : 0 < r, { by_contra hr, have := div_nonpos_of_nonneg_of_nonpos (sub_nonneg.2 $ J.lower_le_upper i) (not_lt.1 hr), rw ← h at this, exact this.not_lt (sub_pos.2 $ I.lower_lt_upper i) }, - simp only [nnreal.finset_sup_div, div_div_div_cancel_right _ (real.nnabs.map_ne_zero.2 this.ne')] + simp_rw [nnreal.finset_sup_div, div_div_div_cancel_right _ ((map_ne_zero real.nnabs).2 this.ne')], end lemma nndist_le_distortion_mul (I : box ι) (i : ι) : diff --git a/src/analysis/box_integral/box/subbox_induction.lean b/src/analysis/box_integral/box/subbox_induction.lean index 34ee99e76c269..c3aa323169157 100644 --- a/src/analysis/box_integral/box/subbox_induction.lean +++ b/src/analysis/box_integral/box/subbox_induction.lean @@ -9,6 +9,9 @@ import analysis.specific_limits.basic /-! # Induction on subboxes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove the following induction principle for `box_integral.box`, see `box_integral.box.subbox_induction_on`. Let `p` be a predicate on `box_integral.box ι`, let `I` be a box. Suppose that the following two properties hold true. @@ -27,7 +30,7 @@ rectangular box, induction -/ open set finset function filter metric -open_locale classical topological_space filter ennreal +open_locale classical topology filter ennreal noncomputable theory namespace box_integral @@ -64,6 +67,7 @@ lemma split_center_box_le (I : box ι) (s : set ι) : I.split_center_box s ≤ I lemma disjoint_split_center_box (I : box ι) {s t : set ι} (h : s ≠ t) : disjoint (I.split_center_box s : set (ι → ℝ)) (I.split_center_box t) := begin + rw disjoint_iff_inf_le, rintro y ⟨hs, ht⟩, apply h, ext i, rw [mem_coe, mem_split_center_box] at hs ht, @@ -127,7 +131,7 @@ begin from λ m, nat.rec_on m hpI (λ m, by simpa only [J_succ] using hs (J m) (hJle m)), have hJsub : ∀ m i, (J m).upper i - (J m).lower i = (I.upper i - I.lower i) / 2 ^ m, { intros m i, induction m with m ihm, { simp [J] }, - simp only [pow_succ', J_succ, upper_sub_lower_split_center_box, ihm, div_div_eq_div_mul] }, + simp only [pow_succ', J_succ, upper_sub_lower_split_center_box, ihm, div_div] }, have h0 : J 0 = I, from rfl, -- Now we clear unneeded assumptions clear_value J, clear hpI hs J_succ s, @@ -146,7 +150,7 @@ begin { suffices : tendsto (λ m, (J m).upper - (J m).lower) at_top (𝓝 0), by simpa using hJlz.add this, refine tendsto_pi_nhds.2 (λ i, _), simpa [hJsub] using tendsto_const_nhds.div_at_top - (tendsto_pow_at_top_at_top_of_one_lt (@one_lt_two ℝ _ _)) }, + (tendsto_pow_at_top_at_top_of_one_lt one_lt_two) }, replace hJlz : tendsto (λ m, (J m).lower) at_top (𝓝[Icc I.lower I.upper] z), from tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ hJlz (eventually_of_forall hJl_mem), diff --git a/src/analysis/box_integral/divergence_theorem.lean b/src/analysis/box_integral/divergence_theorem.lean index 49874fe1621ad..4744a0364b2b8 100644 --- a/src/analysis/box_integral/divergence_theorem.lean +++ b/src/analysis/box_integral/divergence_theorem.lean @@ -5,11 +5,17 @@ Authors: Yury Kudryashov -/ import analysis.box_integral.basic import analysis.box_integral.partition.additive -import analysis.calculus.fderiv +import analysis.calculus.fderiv.add +import analysis.calculus.fderiv.mul +import analysis.calculus.fderiv.equiv +import analysis.calculus.fderiv.restrict_scalars /-! # Divergence integral for Henstock-Kurzweil integral +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove the Divergence Theorem for a Henstock-Kurzweil style integral. The theorem says the following. Let `f : ℝⁿ → Eⁿ` be a function differentiable on a closed rectangular box `I` with derivative `f' x : ℝⁿ →L[ℝ] Eⁿ` at `x ∈ I`. Then the divergence `λ x, ∑ k, f' x eₖ k`, @@ -18,8 +24,8 @@ equal to the sum of integrals of `f` over the faces of `I` taken with appropriat To make the proof work, we had to ban tagged partitions with “long and thin” boxes. More precisely, we use the following generalization of one-dimensional Henstock-Kurzweil integral to functions -defined on a box in `ℝⁿ` (it corresponds to the value `⊥` of `box_integral.integration_params` in -the definition of `box_integral.has_integral`). +defined on a box in `ℝⁿ` (it corresponds to the value `box_integral.integration_params.GP = ⊥` of +`box_integral.integration_params` in the definition of `box_integral.has_integral`). We say that `f : ℝⁿ → E` has integral `y : E` over a box `I ⊆ ℝⁿ` if for an arbitrarily small positive `ε` and an arbitrarily large `c`, there exists a function `r : ℝⁿ → (0, ∞)` such that for @@ -38,12 +44,13 @@ Henstock-Kurzweil integral. Henstock-Kurzweil integral, integral, Stokes theorem, divergence theorem -/ -open_locale classical big_operators nnreal ennreal topological_space box_integral +open_locale classical big_operators nnreal ennreal topology box_integral open continuous_linear_map (lsmul) filter set finset metric + box_integral.integration_params (GP GP_le) noncomputable theory universes u -variables {E : Type u} [normed_group E] [normed_space ℝ E] {n : ℕ} +variables {E : Type u} [normed_add_comm_group E] [normed_space ℝ E] {n : ℕ} namespace box_integral @@ -59,10 +66,10 @@ open measure_theory lemma norm_volume_sub_integral_face_upper_sub_lower_smul_le {f : ℝⁿ⁺¹ → E} {f' : ℝⁿ⁺¹ →L[ℝ] E} (hfc : continuous_on f I.Icc) {x : ℝⁿ⁺¹} (hxI : x ∈ I.Icc) {a : E} {ε : ℝ} (h0 : 0 < ε) - (hε : ∀ y ∈ I.Icc, ∥f y - a - f' (y - x)∥ ≤ ε * ∥y - x∥) {c : ℝ≥0} (hc : I.distortion ≤ c) : - ∥(∏ j, (I.upper j - I.lower j)) • f' (pi.single i 1) - + (hε : ∀ y ∈ I.Icc, ‖f y - a - f' (y - x)‖ ≤ ε * ‖y - x‖) {c : ℝ≥0} (hc : I.distortion ≤ c) : + ‖(∏ j, (I.upper j - I.lower j)) • f' (pi.single i 1) - (integral (I.face i) ⊥ (f ∘ i.insert_nth (I.upper i)) box_additive_map.volume - - integral (I.face i) ⊥ (f ∘ i.insert_nth (I.lower i)) box_additive_map.volume)∥ ≤ + integral (I.face i) ⊥ (f ∘ i.insert_nth (I.lower i)) box_additive_map.volume)‖ ≤ 2 * ε * c * ∏ j, (I.upper j - I.lower j) := begin /- **Plan of the proof**. The difference of the integrals of the affine function @@ -81,32 +88,32 @@ begin of the faces `x i = I.lower i` and `x i = I.upper i` is `(2 * ε * diam I.Icc)`-close to the value of `f'` on `pi.single i (I.upper i - I.lower i) = lᵢ • eᵢ`, where `lᵢ = I.upper i - I.lower i` is the length of `i`-th edge of `I` and `eᵢ = pi.single i 1` is the `i`-th unit vector. -/ - have : ∀ y ∈ (I.face i).Icc, ∥f' (pi.single i (I.upper i - I.lower i)) - - (f (i.insert_nth (I.upper i) y) - f (i.insert_nth (I.lower i) y))∥ ≤ 2 * ε * diam I.Icc, + have : ∀ y ∈ (I.face i).Icc, ‖f' (pi.single i (I.upper i - I.lower i)) - + (f (i.insert_nth (I.upper i) y) - f (i.insert_nth (I.lower i) y))‖ ≤ 2 * ε * diam I.Icc, { intros y hy, set g := λ y, f y - a - f' (y - x) with hg, - change ∀ y ∈ I.Icc, ∥g y∥ ≤ ε * ∥y - x∥ at hε, + change ∀ y ∈ I.Icc, ‖g y‖ ≤ ε * ‖y - x‖ at hε, clear_value g, obtain rfl : f = λ y, a + f' (y - x) + g y, by simp [hg], - convert_to ∥g (i.insert_nth (I.lower i) y) - g (i.insert_nth (I.upper i) y)∥ ≤ _, + convert_to ‖g (i.insert_nth (I.lower i) y) - g (i.insert_nth (I.upper i) y)‖ ≤ _, { congr' 1, have := fin.insert_nth_sub_same i (I.upper i) (I.lower i) y, simp only [← this, f'.map_sub], abel }, { have : ∀ z ∈ Icc (I.lower i) (I.upper i), i.insert_nth z y ∈ I.Icc, from λ z hz, I.maps_to_insert_nth_face_Icc hz hy, - replace hε : ∀ y ∈ I.Icc, ∥g y∥ ≤ ε * diam I.Icc, + replace hε : ∀ y ∈ I.Icc, ‖g y‖ ≤ ε * diam I.Icc, { intros y hy, refine (hε y hy).trans (mul_le_mul_of_nonneg_left _ h0.le), rw ← dist_eq_norm, exact dist_le_diam_of_mem I.is_compact_Icc.bounded hy hxI }, rw [two_mul, add_mul], exact norm_sub_le_of_le (hε _ (this _ Hl)) (hε _ (this _ Hu)) } }, - calc ∥(∏ j, (I.upper j - I.lower j)) • f' (pi.single i 1) - + calc ‖(∏ j, (I.upper j - I.lower j)) • f' (pi.single i 1) - (integral (I.face i) ⊥ (f ∘ i.insert_nth (I.upper i)) box_additive_map.volume - - integral (I.face i) ⊥ (f ∘ i.insert_nth (I.lower i)) box_additive_map.volume)∥ - = ∥integral.{0 u u} (I.face i) ⊥ + integral (I.face i) ⊥ (f ∘ i.insert_nth (I.lower i)) box_additive_map.volume)‖ + = ‖integral.{0 u u} (I.face i) ⊥ (λ (x : fin n → ℝ), f' (pi.single i (I.upper i - I.lower i)) - (f (i.insert_nth (I.upper i) x) - f (i.insert_nth (I.lower i) x))) - box_additive_map.volume∥ : + box_additive_map.volume‖ : begin rw [← integral_sub (Hi _ Hu) (Hi _ Hl), ← box.volume_face_mul i, mul_smul, ← box.volume_apply, ← box_additive_map.to_smul_apply, ← integral_const, ← box_additive_map.volume, @@ -139,12 +146,12 @@ we allow `f` to be non-differentiable (but still continuous) at a countable set TODO: If `n > 0`, then the condition at `x ∈ s` can be replaced by a much weaker estimate but this requires either better integrability theorems, or usage of a filter depending on the countable set `s` (we need to ensure that none of the faces of a partition contain a point from `s`). -/ -lemma has_integral_bot_pderiv (f : ℝⁿ⁺¹ → E) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] E) (s : set ℝⁿ⁺¹) - (hs : countable s) (Hs : ∀ x ∈ s, continuous_within_at f I.Icc x) +lemma has_integral_GP_pderiv (f : ℝⁿ⁺¹ → E) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] E) (s : set ℝⁿ⁺¹) + (hs : s.countable) (Hs : ∀ x ∈ s, continuous_within_at f I.Icc x) (Hd : ∀ x ∈ I.Icc \ s, has_fderiv_within_at f (f' x) I.Icc x) (i : fin (n + 1)) : - has_integral.{0 u u} I ⊥ (λ x, f' x (pi.single i 1)) box_additive_map.volume - (integral.{0 u u} (I.face i) ⊥ (λ x, f (i.insert_nth (I.upper i) x)) box_additive_map.volume - - integral.{0 u u} (I.face i) ⊥ (λ x, f (i.insert_nth (I.lower i) x)) + has_integral.{0 u u} I GP (λ x, f' x (pi.single i 1)) box_additive_map.volume + (integral.{0 u u} (I.face i) GP (λ x, f (i.insert_nth (I.upper i) x)) box_additive_map.volume - + integral.{0 u u} (I.face i) GP (λ x, f (i.insert_nth (I.lower i) x)) box_additive_map.volume) := begin /- Note that `f` is continuous on `I.Icc`, hence it is integrable on the faces of all boxes @@ -155,13 +162,14 @@ begin by_cases hxs : x ∈ s, exacts [Hs x hxs, (Hd x ⟨hx, hxs⟩).continuous_within_at] }, set fI : ℝ → box (fin n) → E := λ y J, - integral.{0 u u} J ⊥ (λ x, f (i.insert_nth y x)) box_additive_map.volume, + integral.{0 u u} J GP (λ x, f (i.insert_nth y x)) box_additive_map.volume, set fb : Icc (I.lower i) (I.upper i) → fin n →ᵇᵃ[↑(I.face i)] E := - λ x, (integrable_of_continuous_on ⊥ (box.continuous_on_face_Icc Hc x.2) volume).to_box_additive, + λ x, (integrable_of_continuous_on GP (box.continuous_on_face_Icc Hc x.2) + volume).to_box_additive, set F : fin (n + 1) →ᵇᵃ[I] E := box_additive_map.upper_sub_lower I i fI fb (λ x hx J, rfl), /- Thus our statement follows from some local estimates. -/ - change has_integral I ⊥ (λ x, f' x (pi.single i 1)) _ (F I), - refine has_integral_of_le_Henstock_of_forall_is_o bot_le _ _ _ s hs _ _, + change has_integral I GP (λ x, f' x (pi.single i 1)) _ (F I), + refine has_integral_of_le_Henstock_of_forall_is_o GP_le _ _ _ s hs _ _, { /- We use the volume as an upper estimate. -/ exact (volume : measure ℝⁿ⁺¹).to_box_additive.restrict _ le_top }, { exact λ J, ennreal.to_real_nonneg }, @@ -171,8 +179,8 @@ begin because each of the integrals is close to `volume (J.face i) • f x`. TODO: there should be a shorter and more readable way to formalize this simple proof. -/ have : ∀ᶠ δ in 𝓝[>] (0 : ℝ), δ ∈ Ioc (0 : ℝ) (1 / 2) ∧ - (∀ y₁ y₂ ∈ closed_ball x δ ∩ I.Icc, ∥f y₁ - f y₂∥ ≤ ε / 2) ∧ - ((2 * δ) ^ (n + 1) * ∥f' x (pi.single i 1)∥ ≤ ε / 2), + (∀ y₁ y₂ ∈ closed_ball x δ ∩ I.Icc, ‖f y₁ - f y₂‖ ≤ ε / 2) ∧ + ((2 * δ) ^ (n + 1) * ‖f' x (pi.single i 1)‖ ≤ ε / 2), { refine eventually.and _ (eventually.and _ _), { exact Ioc_mem_nhds_within_Ioi ⟨le_rfl, one_half_pos⟩ }, { rcases ((nhds_within_has_basis nhds_basis_closed_ball _).tendsto_iff @@ -184,7 +192,7 @@ begin calc dist (f y₁) (f y₂) ≤ dist (f y₁) (f x) + dist (f y₂) (f x) : dist_triangle_right _ _ _ ... ≤ ε / 2 / 2 + ε / 2 / 2 : add_le_add (hδ₁ _ $ this hy₁) (hδ₁ _ $ this hy₂) ... = ε / 2 : add_halves _ }, - { have : continuous_within_at (λ δ, (2 * δ) ^ (n + 1) * ∥f' x (pi.single i 1)∥) + { have : continuous_within_at (λ δ, (2 * δ) ^ (n + 1) * ‖f' x (pi.single i 1)‖) (Ioi (0 : ℝ)) 0 := ((continuous_within_at_id.const_mul _).pow _).mul_const _, refine this.eventually (ge_mem_nhds _), simpa using half_pos ε0 } }, @@ -193,7 +201,7 @@ begin have Hl : J.lower i ∈ Icc (J.lower i) (J.upper i) := set.left_mem_Icc.2 (J.lower_le_upper i), have Hu : J.upper i ∈ Icc (J.lower i) (J.upper i) := set.right_mem_Icc.2 (J.lower_le_upper i), have Hi : ∀ x ∈ Icc (J.lower i) (J.upper i), - integrable.{0 u u} (J.face i) ⊥ (λ y, f (i.insert_nth x y)) box_additive_map.volume, + integrable.{0 u u} (J.face i) GP (λ y, f (i.insert_nth x y)) box_additive_map.volume, from λ x hx, integrable_of_continuous_on _ (box.continuous_on_face_Icc (Hc.mono $ box.le_iff_Icc.1 hJI) hx) volume, have hJδ' : J.Icc ⊆ closed_ball x δ ∩ I.Icc, @@ -250,20 +258,20 @@ the sum of integrals of `f` over the faces of `I` taken with appropriate signs. More precisely, we use a non-standard generalization of the Henstock-Kurzweil integral and we allow `f` to be non-differentiable (but still continuous) at a countable set of points. -/ -lemma has_integral_bot_divergence_of_forall_has_deriv_within_at - (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : countable s) +lemma has_integral_GP_divergence_of_forall_has_deriv_within_at + (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : s.countable) (Hs : ∀ x ∈ s, continuous_within_at f I.Icc x) (Hd : ∀ x ∈ I.Icc \ s, has_fderiv_within_at f (f' x) I.Icc x) : - has_integral.{0 u u} I ⊥ (λ x, ∑ i, f' x (pi.single i 1) i) + has_integral.{0 u u} I GP (λ x, ∑ i, f' x (pi.single i 1) i) box_additive_map.volume - (∑ i, (integral.{0 u u} (I.face i) ⊥ (λ x, f (i.insert_nth (I.upper i) x) i) + (∑ i, (integral.{0 u u} (I.face i) GP (λ x, f (i.insert_nth (I.upper i) x) i) box_additive_map.volume - - integral.{0 u u} (I.face i) ⊥ (λ x, f (i.insert_nth (I.lower i) x) i) + integral.{0 u u} (I.face i) GP (λ x, f (i.insert_nth (I.lower i) x) i) box_additive_map.volume)) := begin refine has_integral_sum (λ i hi, _), clear hi, simp only [has_fderiv_within_at_pi', continuous_within_at_pi] at Hd Hs, - convert has_integral_bot_pderiv I _ _ s hs (λ x hx, Hs x hx i) (λ x hx, Hd x hx i) i + convert has_integral_GP_pderiv I _ _ s hs (λ x hx, Hs x hx i) (λ x hx, Hd x hx i) i end end box_integral diff --git a/src/analysis/box_integral/integrability.lean b/src/analysis/box_integral/integrability.lean index df7802c704605..6a1630f6cd8a3 100644 --- a/src/analysis/box_integral/integrability.lean +++ b/src/analysis/box_integral/integrability.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ import analysis.box_integral.basic +import measure_theory.integral.set_integral import measure_theory.measure.regular /-! # McShane integrability vs Bochner integrability +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that any Bochner integrable function is McShane integrable (hence, it is Henstock and `⊥` integrable) with the same integral. The proof is based on [Russel A. Gordon, *The integrals of Lebesgue, Denjoy, Perron, and Henstock*][Gordon55]. @@ -18,11 +22,11 @@ Henstock and `⊥` integrable) with the same integral. The proof is based on integral, McShane integral, Bochner integral -/ -open_locale classical nnreal ennreal topological_space big_operators +open_locale classical nnreal ennreal topology big_operators universes u v -variables {ι : Type u} {E : Type v} [fintype ι] [normed_group E] [normed_space ℝ E] +variables {ι : Type u} {E : Type v} [fintype ι] [normed_add_comm_group E] [normed_space ℝ E] open measure_theory metric set finset filter box_integral @@ -36,7 +40,7 @@ lemma has_integral_indicator_const (l : integration_params) (hl : l.bRiemann = f has_integral.{u v v} I l (s.indicator (λ _, y)) μ.to_box_additive.to_smul ((μ (s ∩ I)).to_real • y) := begin - refine has_integral_of_mul (∥y∥) (λ ε ε0, _), + refine has_integral_of_mul (‖y‖) (λ ε ε0, _), lift ε to ℝ≥0 using ε0.le, rw nnreal.coe_pos at ε0, /- First we choose a closed set `F ⊆ s ∩ I.Icc` and an open set `U ⊇ s` such that both `(s ∩ I.Icc) \ F` and `U \ s` have measuer less than `ε`. -/ @@ -98,14 +102,14 @@ lemma has_integral_zero_of_ae_eq_zero {l : integration_params} {I : box ι} {f : (hl : l.bRiemann = ff) : has_integral.{u v v} I l f μ.to_box_additive.to_smul 0 := begin - /- Each set `{x | n < ∥f x∥ ≤ n + 1}`, `n : ℕ`, has measure zero. We cover it by an open set of + /- Each set `{x | n < ‖f x‖ ≤ n + 1}`, `n : ℕ`, has measure zero. We cover it by an open set of measure less than `ε / 2 ^ n / (n + 1)`. Then the norm of the integral sum is less than `ε`. -/ refine has_integral_iff.2 (λ ε ε0, _), lift ε to ℝ≥0 using ε0.lt.le, rw [gt_iff_lt, nnreal.coe_pos] at ε0, - rcases nnreal.exists_pos_sum_of_encodable ε0.ne' ℕ with ⟨δ, δ0, c, hδc, hcε⟩, + rcases nnreal.exists_pos_sum_of_countable ε0.ne' ℕ with ⟨δ, δ0, c, hδc, hcε⟩, haveI := fact.mk (I.measure_coe_lt_top μ), change μ.restrict I {x | f x ≠ 0} = 0 at hf, - set N : (ι → ℝ) → ℕ := λ x, ⌈∥f x∥⌉₊, + set N : (ι → ℝ) → ℕ := λ x, ⌈‖f x‖⌉₊, have N0 : ∀ {x}, N x = 0 ↔ f x = 0, by { intro x, simp [N] }, have : ∀ n, ∃ U ⊇ N ⁻¹' {n}, is_open U ∧ μ.restrict I U < δ n / n, { refine λ n, (N ⁻¹' {n}).exists_is_open_lt_of_lt _ _, @@ -127,7 +131,7 @@ begin rintro n -, dsimp [integral_sum], have : ∀ J ∈ π.filter (λ J, N (π.tag J) = n), - ∥(μ ↑J).to_real • f (π.tag J)∥ ≤ (μ J).to_real * n, + ‖(μ ↑J).to_real • f (π.tag J)‖ ≤ (μ J).to_real * n, { intros J hJ, rw tagged_prepartition.mem_filter at hJ, rw [norm_smul, real.norm_eq_abs, abs_of_nonneg ennreal.to_real_nonneg], exact mul_le_mul_of_nonneg_left (hJ.2 ▸ nat.le_ceil _) ennreal.to_real_nonneg }, @@ -171,7 +175,8 @@ lemma has_box_integral (f : simple_func (ι → ℝ) E) (μ : measure (ι → has_integral.{u v v} I l f μ.to_box_additive.to_smul (f.integral (μ.restrict I)) := begin induction f using measure_theory.simple_func.induction with y s hs f g hd hfi hgi, - { simpa [function.const, measure.restrict_apply hs] + { simpa only [measure.restrict_apply hs, const_zero, integral_piecewise_zero, integral_const, + measure.restrict_apply, measurable_set.univ, set.univ_inter] using box_integral.has_integral_indicator_const l hl hs I y μ }, { borelize E, haveI := fact.mk (I.measure_coe_lt_top μ), rw integral_add, @@ -214,7 +219,7 @@ begin have hfi' := λ n, ((f n).has_box_integral μ I l hl).integrable, have hfgi : tendsto (λ n, (f n).integral (μ.restrict I)) at_top (𝓝 $ ∫ x in I, g x ∂μ), from tendsto_integral_approx_on_of_measurable_of_range_subset hg.measurable hgi _ subset.rfl, - have hfg_mono : ∀ x {m n}, m ≤ n → ∥f n x - g x∥ ≤ ∥f m x - g x∥, + have hfg_mono : ∀ x {m n}, m ≤ n → ‖f n x - g x‖ ≤ ‖f m x - g x‖, { intros x m n hmn, rw [← dist_eq_norm, ← dist_eq_norm, dist_nndist, dist_nndist, nnreal.coe_le_coe, ← ennreal.coe_le_coe, ← edist_nndist, ← edist_nndist], @@ -223,9 +228,9 @@ begin to `r`, the integral sum is `(μ I + 1 + 1) * ε`-close to the Bochner integral. -/ refine has_integral_of_mul ((μ I).to_real + 1 + 1) (λ ε ε0, _), lift ε to ℝ≥0 using ε0.le, rw nnreal.coe_pos at ε0, have ε0' := ennreal.coe_pos.2 ε0, - /- Choose `N` such that the integral of `∥f N x - g x∥` is less than or equal to `ε`. -/ - obtain ⟨N₀, hN₀⟩ : ∃ N : ℕ, ∫ x in I, ∥f N x - g x∥ ∂μ ≤ ε, - { have : tendsto (λ n, ∫⁻ x in I, ∥f n x - g x∥₊ ∂μ) at_top (𝓝 0), + /- Choose `N` such that the integral of `‖f N x - g x‖` is less than or equal to `ε`. -/ + obtain ⟨N₀, hN₀⟩ : ∃ N : ℕ, ∫ x in I, ‖f N x - g x‖ ∂μ ≤ ε, + { have : tendsto (λ n, ∫⁻ x in I, ‖f n x - g x‖₊ ∂μ) at_top (𝓝 0), from simple_func.tendsto_approx_on_range_L1_nnnorm hg.measurable hgi, refine (this.eventually (ge_mem_nhds ε0')).exists.imp (λ N hN, _), exact integral_coe_le_of_lintegral_coe_le hN }, @@ -237,7 +242,7 @@ begin exact ((eventually_ge_at_top N₀).and $ this $ closed_ball_mem_nhds _ ε0).exists }, choose Nx hNx hNxε, /- We also choose a convergent series with `∑' i : ℕ, δ i < ε`. -/ - rcases nnreal.exists_pos_sum_of_encodable ε0.ne' ℕ with ⟨δ, δ0, c, hδc, hcε⟩, + rcases nnreal.exists_pos_sum_of_countable ε0.ne' ℕ with ⟨δ, δ0, c, hδc, hcε⟩, /- Since each simple function `fᵢ` is integrable, there exists `rᵢ : ℝⁿ → (0, ∞)` such that the integral sum of `f` over any tagged prepartition is `δᵢ`-close to the sum of integrals of `fᵢ` over the boxes of this prepartition. For each `x`, we choose `r (Nx x)` as the radius @@ -286,13 +291,13 @@ begin hNxn J hJ], exact (hfi _).mono_set (prepartition.le_of_mem _ hJ) } }, { /- For the last jump, we use the fact that the distance between `f (Nx x) x` and `g x` is less - than or equal to the distance between `f N₀ x` and `g x` and the integral of `∥f N₀ x - g x∥` + than or equal to the distance between `f N₀ x` and `g x` and the integral of `‖f N₀ x - g x‖` is less than or equal to `ε`. -/ refine le_trans _ hN₀, have hfi : ∀ n (J ∈ π), integrable_on (f n) ↑J μ, from λ n J hJ, (hfi n).mono_set (π.le_of_mem' J hJ), have hgi : ∀ J ∈ π, integrable_on g ↑J μ, from λ J hJ, hgi.mono_set (π.le_of_mem' J hJ), - have hfgi : ∀ n (J ∈ π), integrable_on (λ x, ∥f n x - g x∥) J μ, + have hfgi : ∀ n (J ∈ π), integrable_on (λ x, ‖f n x - g x‖) J μ, from λ n J hJ, ((hfi n J hJ).sub (hgi J hJ)).norm, rw [← hπp.Union_eq, prepartition.Union_def', integral_finset_bUnion π.boxes (λ J hJ, J.measurable_set_coe) π.pairwise_disjoint hgi, diff --git a/src/analysis/box_integral/partition/additive.lean b/src/analysis/box_integral/partition/additive.lean index 4053718388593..4932c78468f17 100644 --- a/src/analysis/box_integral/partition/additive.lean +++ b/src/analysis/box_integral/partition/additive.lean @@ -5,11 +5,13 @@ Authors: Yury Kudryashov -/ import analysis.box_integral.partition.split import analysis.normed_space.operator_norm -import data.set.intervals.proj_Icc /-! # Box additive functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We say that a function `f : box ι → M` from boxes in `ℝⁿ` to a commutative additive monoid `M` is *box additive* on subboxes of `I₀ : with_top (box ι)` if for any box `J`, `↑J ≤ I₀`, and a partition `π` of `J`, `f J = ∑ J' in π.boxes, f J'`. We use `I₀ : with_top (box ι)` instead of `I₀ : box ι` to @@ -45,8 +47,10 @@ structure box_additive_map (ι M : Type*) [add_comm_monoid M] (I : with_top (box (sum_partition_boxes' : ∀ J : box ι, ↑J ≤ I → ∀ π : prepartition J, π.is_partition → ∑ Ji in π.boxes, to_fun Ji = to_fun J) -localized "notation ι ` →ᵇᵃ `:25 M := box_integral.box_additive_map ι M ⊤" in box_integral -localized "notation ι ` →ᵇᵃ[`:25 I `] ` M := box_integral.box_additive_map ι M I" in box_integral +localized "notation (name := box_integral.box_additive_map.top) + ι ` →ᵇᵃ `:25 M := box_integral.box_additive_map ι M ⊤" in box_integral +localized "notation (name := box_integral.box_additive_map) + ι ` →ᵇᵃ[`:25 I `] ` M := box_integral.box_additive_map ι M I" in box_integral namespace box_additive_map @@ -83,7 +87,7 @@ instance : has_add (ι →ᵇᵃ[I₀] M) := ⟨λ f g, ⟨f + g, λ I hI π hπ, by simp only [pi.add_apply, sum_add_distrib, sum_partition_boxes _ hI hπ]⟩⟩ -instance {R} [monoid R] [distrib_mul_action R M] : has_scalar R (ι →ᵇᵃ[I₀] M) := +instance {R} [monoid R] [distrib_mul_action R M] : has_smul R (ι →ᵇᵃ[I₀] M) := ⟨λ r f, ⟨r • f, λ I hI π hπ, by simp only [pi.smul_apply, ←smul_sum, sum_partition_boxes _ hI hπ]⟩⟩ @@ -132,7 +136,7 @@ map. -/ /-- If `f` is a box additive function on subboxes of `I` and `π₁`, `π₂` are two prepartitions of `I` that cover the same part of `I`, then `∑ J in π₁.boxes, f J = ∑ J in π₂.boxes, f J`. -/ -lemma sum_boxes_congr [fintype ι] (f : ι →ᵇᵃ[I₀] M) (hI : ↑I ≤ I₀) {π₁ π₂ : prepartition I} +lemma sum_boxes_congr [finite ι] (f : ι →ᵇᵃ[I₀] M) (hI : ↑I ≤ I₀) {π₁ π₂ : prepartition I} (h : π₁.Union = π₂.Union) : ∑ J in π₁.boxes, f J = ∑ J in π₂.boxes, f J := begin @@ -153,7 +157,7 @@ end section to_smul -variables {E : Type*} [normed_group E] [normed_space ℝ E] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] /-- If `f` is a box-additive map, then so is the map sending `I` to the scalar multiplication by `f I` as a continuous linear map from `E` to itself. -/ diff --git a/src/analysis/box_integral/partition/basic.lean b/src/analysis/box_integral/partition/basic.lean index 8c879527a35d2..ce849353626fc 100644 --- a/src/analysis/box_integral/partition/basic.lean +++ b/src/analysis/box_integral/partition/basic.lean @@ -3,11 +3,15 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ +import algebra.big_operators.option import analysis.box_integral.box.basic /-! # Partitions of rectangular boxes in `ℝⁿ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define (pre)partitions of rectangular boxes in `ℝⁿ`. A partition of a box `I` in `ℝⁿ` (see `box_integral.prepartition` and `box_integral.prepartition.is_partition`) is a finite set of pairwise disjoint boxes such that their union is exactly `I`. We use `boxes : finset (box ι)` to @@ -64,7 +68,7 @@ lemma disjoint_coe_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (h : J₁ lemma eq_of_mem_of_mem (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hx₁ : x ∈ J₁) (hx₂ : x ∈ J₂) : J₁ = J₂ := -by_contra $ λ H, π.disjoint_coe_of_mem h₁ h₂ H ⟨hx₁, hx₂⟩ +by_contra $ λ H, (π.disjoint_coe_of_mem h₁ h₂ H).le_bot ⟨hx₁, hx₂⟩ lemma eq_of_le_of_le (h₁ : J₁ ∈ π) (h₂ : J₂ ∈ π) (hle₁ : J ≤ J₁) (hle₂ : J ≤ J₂) : J₁ = J₂ := @@ -190,8 +194,8 @@ lemma Union_subset : π.Union ⊆ I := Union₂_subset π.le_of_mem' lemma disjoint_boxes_of_disjoint_Union (h : disjoint π₁.Union π₂.Union) : disjoint π₁.boxes π₂.boxes := -finset.disjoint_left.2 $ λ J h₁ h₂, h.mono (π₁.subset_Union h₁) (π₂.subset_Union h₂) - ⟨J.upper_mem, J.upper_mem⟩ +finset.disjoint_left.2 $ λ J h₁ h₂, + disjoint.le_bot (h.mono (π₁.subset_Union h₁) (π₂.subset_Union h₂)) ⟨J.upper_mem, J.upper_mem⟩ lemma le_iff_nonempty_imp_le_and_Union_subset : π₁ ≤ π₂ ↔ (∀ (J ∈ π₁) (J' ∈ π₂), (J ∩ J' : set (ι → ℝ)).nonempty → J ≤ J') ∧ π₁.Union ⊆ π₂.Union := @@ -226,7 +230,9 @@ function. -/ pairwise_disjoint := begin simp only [set.pairwise, finset.mem_coe, finset.mem_bUnion], - rintro J₁' ⟨J₁, hJ₁, hJ₁'⟩ J₂' ⟨J₂, hJ₂, hJ₂'⟩ Hne x ⟨hx₁, hx₂⟩, apply Hne, + rintro J₁' ⟨J₁, hJ₁, hJ₁'⟩ J₂' ⟨J₂, hJ₂, hJ₂'⟩ Hne, + rw [function.on_fun, set.disjoint_left], + rintros x hx₁ hx₂, apply Hne, obtain rfl : J₁ = J₂, from π.eq_of_mem_of_mem hJ₁ hJ₂ ((πi J₁).le_of_mem hJ₁' hx₁) ((πi J₂).le_of_mem hJ₂' hx₂), @@ -376,7 +382,7 @@ lemma sum_of_with_bot {M : Type*} [add_comm_monoid M] (pairwise_disjoint : set.pairwise (boxes : set (with_bot (box ι))) disjoint) (f : box ι → M) : ∑ J in (of_with_bot boxes le_of_mem pairwise_disjoint).boxes, f J = - ∑ J in boxes, option.elim J 0 f := + ∑ J in boxes, option.elim 0 f J := finset.sum_erase_none _ _ /-- Restrict a prepartition to a box. -/ @@ -434,7 +440,7 @@ begin refine (eq_of_boxes_subset_Union_superset (λ J₁ h₁, _) _).symm, { refine (mem_restrict _).2 ⟨J₁, π.mem_bUnion.2 ⟨J, hJ, h₁⟩, (inf_of_le_right _).symm⟩, exact with_bot.coe_le_coe.2 (le_of_mem _ h₁) }, - { simp only [Union_restrict, Union_bUnion, set.subset_def, set.mem_inter_eq, set.mem_Union], + { simp only [Union_restrict, Union_bUnion, set.subset_def, set.mem_inter_iff, set.mem_Union], rintro x ⟨hxJ, J₁, h₁, hx⟩, obtain rfl : J = J₁, from π.eq_of_mem_of_mem hJ h₁ hxJ (Union_subset _ hx), exact hx } @@ -550,7 +556,7 @@ lemma distortion_le_of_mem (h : J ∈ π) : J.distortion ≤ π.distortion := le_sup h lemma distortion_le_iff {c : ℝ≥0} : π.distortion ≤ c ↔ ∀ J ∈ π, box.distortion J ≤ c := -sup_le_iff +finset.sup_le_iff lemma distortion_bUnion (π : prepartition I) (πi : Π J, prepartition J) : (π.bUnion πi).distortion = π.boxes.sup (λ J, (πi J).distortion) := @@ -629,7 +635,7 @@ lemma Union_bUnion_partition (h : ∀ J ∈ π, (πi J).is_partition) : (π.bUni Union_congr_of_surjective id surjective_id $ λ hJ, (h J hJ).Union_eq lemma is_partition_disj_union_of_eq_diff (h : π₂.Union = I \ π₁.Union) : - is_partition (π₁.disj_union π₂ (h.symm ▸ disjoint_diff)) := + is_partition (π₁.disj_union π₂ $ h.symm ▸ disjoint_sdiff_self_right) := is_partition_iff_Union_eq.2 $ (Union_disj_union _).trans $ by simp [h, π₁.Union_subset] end prepartition diff --git a/src/analysis/box_integral/partition/filter.lean b/src/analysis/box_integral/partition/filter.lean index b73ff899457a2..ce72861841768 100644 --- a/src/analysis/box_integral/partition/filter.lean +++ b/src/analysis/box_integral/partition/filter.lean @@ -9,6 +9,9 @@ import analysis.box_integral.partition.split /-! # Filters used in box-based integrals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + First we define a structure `box_integral.integration_params`. This structure will be used as an argument in the definition of `box_integral.integral` in order to use the same definition for a few well-known definitions of integrals based on partitions of a rectangular box into subboxes (Riemann @@ -41,7 +44,8 @@ The structure `box_integral.integration_params` has 3 boolean fields with the fo * `bDistortion`: the value `tt` means that `r` can depend on the maximal ratio of sides of the same box of a partition. Presence of this case make quite a few proofs harder but we can prove the - divergence theorem only for the filter `⊥ = {bRiemann := ff, bHenstock := tt, bDistortion := tt}`. + divergence theorem only for the filter + `box_integral.integration_params.GP = ⊥ = {bRiemann := ff, bHenstock := tt, bDistortion := tt}`. ### Well-known sets of parameters @@ -67,15 +71,15 @@ the library. that we allow tags to be outside of their boxes; the tags still have to be in the ambient closed box, and the partition still has to be subordinate to a function. -* `⊥` (`bRiemann = ff`, `bHenstock = tt`, `bDistortion = tt`): this is the least integration theory - in our list, i.e., all functions integrable in any other theory is integrable in this one as well. - This is a non-standard generalization of the Henstock-Kurzweil integral to higher dimension. - In dimension one, it generates the same filter as `Henstock`. In higher dimension, this - generalization defines an integration theory such that the divergence of any Fréchet - differentiable function `f` is integrable, and its integral is equal to the sum of integrals of - `f` over the faces of the box, taken with appropriate signs. +* `box_integral.integration_params.GP = ⊥` (`bRiemann = ff`, `bHenstock = tt`, `bDistortion = tt`): + this is the least integration theory in our list, i.e., all functions integrable in any other + theory is integrable in this one as well. This is a non-standard generalization of the + Henstock-Kurzweil integral to higher dimension. In dimension one, it generates the same filter as + `Henstock`. In higher dimension, this generalization defines an integration theory such that the + divergence of any Fréchet differentiable function `f` is integrable, and its integral is equal to + the sum of integrals of `f` over the faces of the box, taken with appropriate signs. - A function `f` is `⊥`-integrable if for any `ε > 0` and `c : ℝ≥0` there exists + A function `f` is `GP`-integrable if for any `ε > 0` and `c : ℝ≥0` there exists `r : (ι → ℝ) → {x : ℝ | 0 < x}` such that for any tagged partition `π` subordinate to `r`, if each tag belongs to the corresponding closed box and for each box `J ∈ π`, the maximal ratio of its sides is less than or equal to `c`, then the integral sum of `f` over `π` is `ε`-close to the @@ -161,7 +165,7 @@ integral, rectangular box, partition, filter -/ open set function filter metric finset bool -open_locale classical topological_space filter nnreal +open_locale classical topology filter nnreal noncomputable theory namespace box_integral @@ -183,7 +187,8 @@ used in the definition of a box-integrable function. * `bDistortion`: the value `tt` means that `r` can depend on the maximal ratio of sides of the same box of a partition. Presence of this case makes quite a few proofs harder but we can prove the - divergence theorem only for the filter `⊥ = {bRiemann := ff, bHenstock := tt, bDistortion := tt}`. + divergence theorem only for the filter + `box_integral.integration_params.GP = ⊥ = {bRiemann := ff, bHenstock := tt, bDistortion := tt}`. -/ @[ext] structure integration_params : Type := (bRiemann bHenstock bDistortion : bool) @@ -209,9 +214,10 @@ def iso_prod : integration_params ≃o bool × boolᵒᵈ × boolᵒᵈ := instance : bounded_order integration_params := iso_prod.symm.to_galois_insertion.lift_bounded_order -/-- The value `⊥` (`bRiemann = ff`, `bHenstock = tt`, `bDistortion = tt`) corresponds to a -generalization of the Henstock integral such that the Divergence theorem holds true without -additional integrability assumptions, see the module docstring for details. -/ +/-- The value +`box_integral.integration_params.GP = ⊥` (`bRiemann = ff`, `bHenstock = tt`, `bDistortion = tt`) +corresponds to a generalization of the Henstock integral such that the Divergence theorem holds true +without additional integrability assumptions, see the module docstring for details. -/ instance : inhabited integration_params := ⟨⊥⟩ instance : decidable_rel ((≤) : integration_params → integration_params → Prop) := @@ -239,10 +245,18 @@ discontinuous) positive function `r`; the tags may be outside of the correspondi (but still inside the ambient closed box `I.Icc`). -/ def McShane : integration_params := ⟨ff, ff, ff⟩ +/-- The `box_integral.integration_params` corresponding to the generalized Perron integral. In the +corresponding filter, we require that the tagged partition is subordinate to a (possibly, +discontinuous) positive function `r` and each tag belongs to the corresponding closed box. We also +require an upper estimate on the distortion of all boxes of the partition. -/ +def GP : integration_params := ⊥ + lemma Henstock_le_Riemann : Henstock ≤ Riemann := dec_trivial lemma Henstock_le_McShane : Henstock ≤ McShane := dec_trivial +lemma GP_le : GP ≤ l := bot_le + /-- The predicate corresponding to a base set of the filter defined by an `integration_params`. It says that @@ -322,14 +336,13 @@ lemma mem_base_set.exists_common_compl (h₁ : l.mem_base_set I c₁ r₁ π₁) ∃ π : prepartition I, π.Union = I \ π₁.Union ∧ (l.bDistortion → π.distortion ≤ c₁) ∧ (l.bDistortion → π.distortion ≤ c₂) := begin - wlog hc : c₁ ≤ c₂ := le_total c₁ c₂ using [c₁ c₂ r₁ r₂ π₁ π₂, c₂ c₁ r₂ r₁ π₂ π₁] tactic.skip, - { by_cases hD : (l.bDistortion : Prop), - { rcases h₁.4 hD with ⟨π, hπU, hπc⟩, - exact ⟨π, hπU, λ _, hπc, λ _, hπc.trans hc⟩ }, - { exact ⟨π₁.to_prepartition.compl, π₁.to_prepartition.Union_compl, - λ h, (hD h).elim, λ h, (hD h).elim⟩ } }, - { intros h₁ h₂ hU, - simpa [hU, and_comm] using this h₂ h₁ hU.symm } + wlog hc : c₁ ≤ c₂, + { simpa [hU, and_comm] using this h₂ h₁ hU.symm (le_of_not_le hc) }, + by_cases hD : (l.bDistortion : Prop), + { rcases h₁.4 hD with ⟨π, hπU, hπc⟩, + exact ⟨π, hπU, λ _, hπc, λ _, hπc.trans hc⟩ }, + { exact ⟨π₁.to_prepartition.compl, π₁.to_prepartition.Union_compl, + λ h, (hD h).elim, λ h, (hD h).elim⟩ } end protected lemma mem_base_set.union_compl_to_subordinate (hπ₁ : l.mem_base_set I c r₁ π₁) @@ -349,7 +362,7 @@ begin rcases hπ.4 hD with ⟨π₁, hπ₁U, hc⟩, set π₂ := π.filter (λ J, ¬p J), have : disjoint π₁.Union π₂.Union, - by simpa [π₂, hπ₁U] using (disjoint_diff.mono_left sdiff_le).symm, + by simpa [π₂, hπ₁U] using disjoint_sdiff_self_left.mono_right sdiff_le, refine ⟨π₁.disj_union π₂.to_prepartition this, _, _⟩, { suffices : ↑I \ π.Union ∪ π.Union \ (π.filter p).Union = ↑I \ (π.filter p).Union, by simpa *, have : (π.filter p).Union ⊆ π.Union, from bUnion_subset_bUnion_left (finset.filter_subset _ _), @@ -408,7 +421,7 @@ has_basis_binfi_principal' (λ r₁ hr₁ r₂ hr₂, ⟨_, hr₁.min hr₂, λ _, mem_base_set.mono _ le_rfl le_rfl (λ x hx, min_le_left _ _), λ _, mem_base_set.mono _ le_rfl le_rfl (λ x hx, min_le_right _ _)⟩) - ⟨λ _, ⟨1, @zero_lt_one ℝ _ _⟩, λ _ _, rfl⟩ + ⟨λ _, ⟨1, zero_lt_one⟩, λ _ _, rfl⟩ lemma has_basis_to_filter_distortion_Union (l : integration_params) (I : box ι) (c : ℝ≥0) (π₀ : prepartition I) : diff --git a/src/analysis/box_integral/partition/measure.lean b/src/analysis/box_integral/partition/measure.lean index c060cee89227d..ad540c3aab4ce 100644 --- a/src/analysis/box_integral/partition/measure.lean +++ b/src/analysis/box_integral/partition/measure.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ import analysis.box_integral.partition.additive -import measure_theory.measure.lebesgue +import measure_theory.measure.lebesgue.basic /-! # Box-additive functions defined by measures +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove a few simple facts about rectangular boxes, partitions, and measures: - given a box `I : box ι`, its coercion to `set (ι → ℝ)` and `I.Icc` are measurable sets; @@ -34,28 +37,27 @@ namespace box_integral open measure_theory namespace box +variables (I : box ι) -lemma measure_Icc_lt_top (I : box ι) (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] : - μ I.Icc < ∞ := +lemma measure_Icc_lt_top (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] : μ I.Icc < ∞ := show μ (Icc I.lower I.upper) < ∞, from I.is_compact_Icc.measure_lt_top -lemma measure_coe_lt_top (I : box ι) (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] : - μ I < ∞ := +lemma measure_coe_lt_top (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] : μ I < ∞ := (measure_mono $ coe_subset_Icc).trans_lt (I.measure_Icc_lt_top μ) -variables [fintype ι] (I : box ι) +section countable +variables [countable ι] lemma measurable_set_coe : measurable_set (I : set (ι → ℝ)) := -begin - rw [coe_eq_pi], - haveI := fintype.to_encodable ι, - exact measurable_set.univ_pi (λ i, measurable_set_Ioc) -end +by { rw coe_eq_pi, exact measurable_set.univ_pi (λ i, measurable_set_Ioc) } lemma measurable_set_Icc : measurable_set I.Icc := measurable_set_Icc -lemma measurable_set_Ioo : measurable_set I.Ioo := -(measurable_set_pi (finite.of_fintype _).countable).2 $ or.inl $ λ i hi, measurable_set_Ioo +lemma measurable_set_Ioo : measurable_set I.Ioo := measurable_set.univ_pi $ λ i, measurable_set_Ioo + +end countable + +variables [fintype ι] lemma coe_ae_eq_Icc : (I : set (ι → ℝ)) =ᵐ[volume] I.Icc := by { rw coe_eq_pi, exact measure.univ_pi_Ioc_ae_eq_Icc } @@ -65,7 +67,7 @@ measure.univ_pi_Ioo_ae_eq_Icc end box -lemma prepartition.measure_Union_to_real [fintype ι] {I : box ι} (π : prepartition I) +lemma prepartition.measure_Union_to_real [finite ι] {I : box ι} (π : prepartition I) (μ : measure (ι → ℝ)) [is_locally_finite_measure μ] : (μ π.Union).to_real = ∑ J in π.boxes, (μ J).to_real := begin @@ -115,11 +117,11 @@ namespace box_additive_map /-- Box-additive map sending each box `I` to the continuous linear endomorphism `x ↦ (volume I).to_real • x`. -/ -protected def volume {E : Type*} [normed_group E] [normed_space ℝ E] : +protected def volume {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] : ι →ᵇᵃ (E →L[ℝ] E) := (volume : measure (ι → ℝ)).to_box_additive.to_smul -lemma volume_apply {E : Type*} [normed_group E] [normed_space ℝ E] (I : box ι) (x : E) : +lemma volume_apply {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] (I : box ι) (x : E) : box_additive_map.volume I x = (∏ j, (I.upper j - I.lower j)) • x := congr_arg2 (•) I.volume_apply rfl diff --git a/src/analysis/box_integral/partition/split.lean b/src/analysis/box_integral/partition/split.lean index 4ff176158bffc..45dbc69989c9e 100644 --- a/src/analysis/box_integral/partition/split.lean +++ b/src/analysis/box_integral/partition/split.lean @@ -8,6 +8,9 @@ import analysis.box_integral.partition.basic /-! # Split a box along one or more hyperplanes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions A hyperplane `{x : ι → ℝ | x i = a}` splits a rectangular box `I : box_integral.box ι` into two @@ -58,7 +61,7 @@ mk' I.lower (update I.upper i (min x (I.upper i))) begin rw [split_lower, coe_mk'], ext y, - simp only [mem_univ_pi, mem_Ioc, mem_inter_eq, mem_coe, mem_set_of_eq, forall_and_distrib, + simp only [mem_univ_pi, mem_Ioc, mem_inter_iff, mem_coe, mem_set_of_eq, forall_and_distrib, ← pi.le_def, le_update_iff, le_min_iff, and_assoc, and_forall_ne i, mem_def], rw [and_comm (y i ≤ x), pi.le_def] end @@ -91,7 +94,7 @@ mk' (update I.lower i (max x (I.lower i))) I.upper begin rw [split_upper, coe_mk'], ext y, - simp only [mem_univ_pi, mem_Ioc, mem_inter_eq, mem_coe, mem_set_of_eq, forall_and_distrib, + simp only [mem_univ_pi, mem_Ioc, mem_inter_iff, mem_coe, mem_set_of_eq, forall_and_distrib, forall_update_iff I.lower (λ j z, z < y j), max_lt_iff, and_assoc (x < y i), and_forall_ne i, mem_def], exact and_comm _ _ @@ -119,7 +122,8 @@ lemma disjoint_split_lower_split_upper (I : box ι) (i : ι) (x : ℝ) : begin rw [← disjoint_with_bot_coe, coe_split_lower, coe_split_upper], refine (disjoint.inf_left' _ _).inf_right' _, - exact λ y (hy : y i ≤ x ∧ x < y i), not_lt_of_le hy.1 hy.2 + rw set.disjoint_left, + exact λ y (hle : y i ≤ x) hlt, not_lt_of_le hle hlt end lemma split_lower_ne_split_upper (I : box ι) (i : ι) (x : ℝ) : @@ -258,7 +262,7 @@ end section fintype -variable [fintype ι] +variable [finite ι] /-- Let `s` be a finite set of boxes in `ℝⁿ = ι → ℝ`. Then there exists a finite set `t₀` of hyperplanes (namely, the set of all hyperfaces of boxes in `s`) such that for any `t ⊇ t₀` @@ -269,6 +273,7 @@ lemma eventually_not_disjoint_imp_le_of_mem_split_many (s : finset (box ι)) : ∀ᶠ t : finset (ι × ℝ) in at_top, ∀ (I : box ι) (J ∈ s) (J' ∈ split_many I t), ¬disjoint (J : with_bot (box ι)) J' → J' ≤ J := begin + casesI nonempty_fintype ι, refine eventually_at_top.2 ⟨s.bUnion (λ J, finset.univ.bUnion (λ i, {(i, J.lower i), (i, J.upper i)})), λ t ht I J hJ J' hJ', not_disjoint_imp_le_of_subset_of_mem_split_many (λ i, _) hJ'⟩, diff --git a/src/analysis/box_integral/partition/subbox_induction.lean b/src/analysis/box_integral/partition/subbox_induction.lean index 3c24e8a148c1d..b059a5dae3ffc 100644 --- a/src/analysis/box_integral/partition/subbox_induction.lean +++ b/src/analysis/box_integral/partition/subbox_induction.lean @@ -9,6 +9,9 @@ import analysis.box_integral.partition.tagged /-! # Induction on subboxes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove (see `box_integral.tagged_partition.exists_is_Henstock_is_subordinate_homothetic`) that for every box `I` in `ℝⁿ` and a function `r : ℝⁿ → ℝ` positive on `I` there exists a tagged partition `π` of `I` such @@ -29,7 +32,7 @@ partition, tagged partition, Henstock integral namespace box_integral open set metric -open_locale classical topological_space +open_locale classical topology noncomputable theory variables {ι : Type*} [fintype ι] {I J : box ι} @@ -110,8 +113,7 @@ begin { intros J' hJ', rcases (split_center J).mem_bUnion_tagged.1 hJ' with ⟨J₁, h₁, h₂⟩, refine ⟨n J₁ J' + 1, λ i, _⟩, - simp only [hn J₁ h₁ J' h₂, upper_sub_lower_of_mem_split_center h₁, pow_succ, - div_div_eq_div_mul] }, + simp only [hn J₁ h₁ J' h₂, upper_sub_lower_of_mem_split_center h₁, pow_succ, div_div] }, refine ⟨_, hP, is_Henstock_bUnion_tagged.2 hHen, is_subordinate_bUnion_tagged.2 hr, hsub, _⟩, refine tagged_prepartition.distortion_of_const _ hP.nonempty_boxes (λ J' h', _), rcases hsub J' h' with ⟨n, hn⟩, @@ -206,7 +208,7 @@ def union_compl_to_subordinate (π₁ : tagged_prepartition I) (π₂ : preparti (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) : tagged_prepartition I := π₁.disj_union (π₂.to_subordinate r) - (((π₂.Union_to_subordinate r).trans hU).symm ▸ disjoint_diff) + (((π₂.Union_to_subordinate r).trans hU).symm ▸ disjoint_sdiff_self_right) lemma is_partition_union_compl_to_subordinate (π₁ : tagged_prepartition I) (π₂ : prepartition I) (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) : diff --git a/src/analysis/box_integral/partition/tagged.lean b/src/analysis/box_integral/partition/tagged.lean index a4fd86cb5eddf..ea6c3b12ebe9b 100644 --- a/src/analysis/box_integral/partition/tagged.lean +++ b/src/analysis/box_integral/partition/tagged.lean @@ -8,6 +8,9 @@ import analysis.box_integral.partition.basic /-! # Tagged partitions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A tagged (pre)partition is a (pre)partition `π` enriched with a tagged point for each box of ‵π`. For simplicity we require that the function `box_integral.tagged_prepartition.tag` is defined on all boxes `J : box ι` but use its values only on boxes of the partition. Given `π : @@ -295,7 +298,7 @@ dif_pos hJ lemma disj_union_tag_of_mem_right (h : disjoint π₁.Union π₂.Union) (hJ : J ∈ π₂) : (π₁.disj_union π₂ h).tag J = π₂.tag J := -dif_neg $ λ h₁, h ⟨π₁.subset_Union h₁ J.upper_mem, π₂.subset_Union hJ J.upper_mem⟩ +dif_neg $ λ h₁, h.le_bot ⟨π₁.subset_Union h₁ J.upper_mem, π₂.subset_Union hJ J.upper_mem⟩ lemma is_subordinate.disj_union [fintype ι] (h₁ : is_subordinate π₁ r) (h₂ : is_subordinate π₂ r) (h : disjoint π₁.Union π₂.Union) : @@ -336,7 +339,7 @@ lemma distortion_le_of_mem (h : J ∈ π) : J.distortion ≤ π.distortion := le_sup h lemma distortion_le_iff {c : ℝ≥0} : π.distortion ≤ c ↔ ∀ J ∈ π, box.distortion J ≤ c := -sup_le_iff +finset.sup_le_iff @[simp] lemma _root_.box_integral.prepartition.distortion_bUnion_tagged (π : prepartition I) (πi : Π J, tagged_prepartition J) : diff --git a/src/analysis/calculus/affine_map.lean b/src/analysis/calculus/affine_map.lean index 8aee84800f4ce..1d7e83abaa361 100644 --- a/src/analysis/calculus/affine_map.lean +++ b/src/analysis/calculus/affine_map.lean @@ -9,6 +9,9 @@ import analysis.calculus.cont_diff /-! # Smooth affine maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains results about smoothness of affine maps. ## Main definitions: @@ -19,12 +22,12 @@ This file contains results about smoothness of affine maps. namespace continuous_affine_map -variables {𝕜 V W : Type*} [nondiscrete_normed_field 𝕜] -variables [normed_group V] [normed_space 𝕜 V] -variables [normed_group W] [normed_space 𝕜 W] +variables {𝕜 V W : Type*} [nontrivially_normed_field 𝕜] +variables [normed_add_comm_group V] [normed_space 𝕜 V] +variables [normed_add_comm_group W] [normed_space 𝕜 W] /-- A continuous affine map between normed vector spaces is smooth. -/ -lemma cont_diff {n : with_top ℕ} (f : V →A[𝕜] W) : +lemma cont_diff {n : ℕ∞} (f : V →A[𝕜] W) : cont_diff 𝕜 n f := begin rw f.decomp, diff --git a/src/analysis/calculus/bump_function_findim.lean b/src/analysis/calculus/bump_function_findim.lean new file mode 100644 index 0000000000000..b46cf1c50c964 --- /dev/null +++ b/src/analysis/calculus/bump_function_findim.lean @@ -0,0 +1,553 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.calculus.series +import analysis.convolution +import analysis.inner_product_space.euclidean_dist +import measure_theory.measure.haar.normed_space +import data.set.pointwise.support + +/-! +# Bump functions in finite-dimensional vector spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `E` be a finite-dimensional real normed vector space. We show that any open set `s` in `E` is +exactly the support of a smooth function taking values in `[0, 1]`, +in `is_open.exists_smooth_support_eq`. + +Then we use this construction to construct bump functions with nice behavior, by convolving +the indicator function of `closed_ball 0 1` with a function as above with `s = ball 0 D`. +-/ + +noncomputable theory + +open set metric topological_space function asymptotics measure_theory finite_dimensional +continuous_linear_map filter measure_theory.measure +open_locale pointwise topology nnreal big_operators convolution + +variables {E : Type*} [normed_add_comm_group E] + +section + +variables [normed_space ℝ E] [finite_dimensional ℝ E] + +/-- If a set `s` is a neighborhood of `x`, then there exists a smooth function `f` taking +values in `[0, 1]`, supported in `s` and with `f x = 1`. -/ +theorem exists_smooth_tsupport_subset {s : set E} {x : E} (hs : s ∈ 𝓝 x) : + ∃ (f : E → ℝ), tsupport f ⊆ s ∧ has_compact_support f ∧ cont_diff ℝ ⊤ f ∧ + range f ⊆ Icc 0 1 ∧ f x = 1 := +begin + obtain ⟨d, d_pos, hd⟩ : ∃ (d : ℝ) (hr : 0 < d), euclidean.closed_ball x d ⊆ s, + from euclidean.nhds_basis_closed_ball.mem_iff.1 hs, + let c : cont_diff_bump (to_euclidean x) := + { r := d/2, + R := d, + r_pos := half_pos d_pos, + r_lt_R := half_lt_self d_pos }, + let f : E → ℝ := c ∘ to_euclidean, + have f_supp : f.support ⊆ euclidean.ball x d, + { assume y hy, + have : to_euclidean y ∈ function.support c, + by simpa only [f, function.mem_support, function.comp_app, ne.def] using hy, + rwa c.support_eq at this }, + have f_tsupp : tsupport f ⊆ euclidean.closed_ball x d, + { rw [tsupport, ← euclidean.closure_ball _ d_pos.ne'], + exact closure_mono f_supp }, + refine ⟨f, f_tsupp.trans hd, _, _, _, _⟩, + { refine is_compact_of_is_closed_bounded is_closed_closure _, + have : bounded (euclidean.closed_ball x d), from euclidean.is_compact_closed_ball.bounded, + apply this.mono _, + refine (is_closed.closure_subset_iff euclidean.is_closed_closed_ball).2 _, + exact f_supp.trans euclidean.ball_subset_closed_ball }, + { apply c.cont_diff.comp, + exact continuous_linear_equiv.cont_diff _ }, + { rintros t ⟨y, rfl⟩, + exact ⟨c.nonneg, c.le_one⟩ }, + { apply c.one_of_mem_closed_ball, + apply mem_closed_ball_self, + exact (half_pos d_pos).le } +end + +/-- Given an open set `s` in a finite-dimensional real normed vector space, there exists a smooth +function with values in `[0, 1]` whose support is exactly `s`. -/ +theorem is_open.exists_smooth_support_eq {s : set E} (hs : is_open s) : + ∃ (f : E → ℝ), f.support = s ∧ cont_diff ℝ ⊤ f ∧ set.range f ⊆ set.Icc 0 1 := +begin + /- For any given point `x` in `s`, one can construct a smooth function with support in `s` and + nonzero at `x`. By second-countability, it follows that we may cover `s` with the supports of + countably many such functions, say `g i`. + Then `∑ i, r i • g i` will be the desired function if `r i` is a sequence of positive numbers + tending quickly enough to zero. Indeed, this ensures that, for any `k ≤ i`, the `k`-th derivative + of `r i • g i` is bounded by a prescribed (summable) sequence `u i`. From this, the summability + of the series and of its successive derivatives follows. -/ + rcases eq_empty_or_nonempty s with rfl|h's, + { exact ⟨(λ x, 0), function.support_zero, cont_diff_const, + by simp only [range_const, singleton_subset_iff, left_mem_Icc, zero_le_one]⟩ }, + let ι := {f : E → ℝ // f.support ⊆ s ∧ has_compact_support f ∧ cont_diff ℝ ⊤ f ∧ + range f ⊆ Icc 0 1}, + obtain ⟨T, T_count, hT⟩ : ∃ T : set ι, T.countable ∧ (⋃ f ∈ T, support (f : E → ℝ)) = s, + { have : (⋃ (f : ι), (f : E → ℝ).support) = s, + { refine subset.antisymm (Union_subset (λ f, f.2.1)) _, + assume x hx, + rcases exists_smooth_tsupport_subset (hs.mem_nhds hx) with ⟨f, hf⟩, + let g : ι := ⟨f, (subset_tsupport f).trans hf.1, hf.2.1, hf.2.2.1, hf.2.2.2.1⟩, + have : x ∈ support (g : E → ℝ), + by simp only [hf.2.2.2.2, subtype.coe_mk, mem_support, ne.def, one_ne_zero, not_false_iff], + exact mem_Union_of_mem _ this }, + simp_rw ← this, + apply is_open_Union_countable, + rintros ⟨f, hf⟩, + exact hf.2.2.1.continuous.is_open_support }, + obtain ⟨g0, hg⟩ : ∃ (g0 : ℕ → ι), T = range g0, + { apply countable.exists_eq_range T_count, + rcases eq_empty_or_nonempty T with rfl|hT, + { simp only [Union_false, Union_empty] at hT, + simp only [←hT, not_nonempty_empty] at h's, + exact h's.elim }, + { exact hT } }, + let g : ℕ → E → ℝ := λ n, (g0 n).1, + have g_s : ∀ n, support (g n) ⊆ s := λ n, (g0 n).2.1, + have s_g : ∀ x ∈ s, ∃ n, x ∈ support (g n), + { assume x hx, + rw ← hT at hx, + obtain ⟨i, iT, hi⟩ : ∃ (i : ι) (hi : i ∈ T), x ∈ support (i : E → ℝ), + by simpa only [mem_Union] using hx, + rw [hg, mem_range] at iT, + rcases iT with ⟨n, hn⟩, + rw ← hn at hi, + exact ⟨n, hi⟩ }, + have g_smooth : ∀ n, cont_diff ℝ ⊤ (g n) := λ n, (g0 n).2.2.2.1, + have g_comp_supp : ∀ n, has_compact_support (g n) := λ n, (g0 n).2.2.1, + have g_nonneg : ∀ n x, 0 ≤ g n x, + from λ n x, ((g0 n).2.2.2.2 (mem_range_self x)).1, + obtain ⟨δ, δpos, c, δc, c_lt⟩ : + ∃ (δ : ℕ → ℝ≥0), (∀ (i : ℕ), 0 < δ i) ∧ ∃ (c : nnreal), has_sum δ c ∧ c < 1, + from nnreal.exists_pos_sum_of_countable one_ne_zero ℕ, + have : ∀ (n : ℕ), ∃ (r : ℝ), + 0 < r ∧ ∀ i ≤ n, ∀ x, ‖iterated_fderiv ℝ i (r • g n) x‖ ≤ δ n, + { assume n, + have : ∀ i, ∃ R, ∀ x, ‖iterated_fderiv ℝ i (λ x, g n x) x‖ ≤ R, + { assume i, + have : bdd_above (range (λ x, ‖iterated_fderiv ℝ i (λ (x : E), g n x) x‖)), + { apply ((g_smooth n).continuous_iterated_fderiv le_top).norm + .bdd_above_range_of_has_compact_support, + apply has_compact_support.comp_left _ norm_zero, + apply (g_comp_supp n).iterated_fderiv }, + rcases this with ⟨R, hR⟩, + exact ⟨R, λ x, hR (mem_range_self _)⟩ }, + choose R hR using this, + let M := max (((finset.range (n+1)).image R).max' (by simp)) 1, + have M_pos : 0 < M := zero_lt_one.trans_le (le_max_right _ _), + have δnpos : 0 < δ n := δpos n, + have IR : ∀ i ≤ n, R i ≤ M, + { assume i hi, + refine le_trans _ (le_max_left _ _), + apply finset.le_max', + apply finset.mem_image_of_mem, + simp only [finset.mem_range], + linarith }, + refine ⟨M⁻¹ * δ n, by positivity, λ i hi x, _⟩, + calc ‖iterated_fderiv ℝ i ((M⁻¹ * δ n) • g n) x‖ + = ‖(M⁻¹ * δ n) • iterated_fderiv ℝ i (g n) x‖ : + by { rw iterated_fderiv_const_smul_apply, exact (g_smooth n).of_le le_top } + ... = M⁻¹ * δ n * ‖iterated_fderiv ℝ i (g n) x‖ : + by { rw [norm_smul, real.norm_of_nonneg], positivity } + ... ≤ M⁻¹ * δ n * M : + mul_le_mul_of_nonneg_left ((hR i x).trans (IR i hi)) (by positivity) + ... = δ n : by field_simp [M_pos.ne'] }, + choose r rpos hr using this, + have S : ∀ x, summable (λ n, (r n • g n) x), + { assume x, + refine summable_of_nnnorm_bounded _ δc.summable (λ n, _), + rw [← nnreal.coe_le_coe, coe_nnnorm], + simpa only [norm_iterated_fderiv_zero] using hr n 0 (zero_le n) x }, + refine ⟨λ x, (∑' n, (r n • g n) x), _, _, _⟩, + { apply subset.antisymm, + { assume x hx, + simp only [pi.smul_apply, algebra.id.smul_eq_mul, mem_support, ne.def] at hx, + contrapose! hx, + have : ∀ n, g n x = 0, + { assume n, + contrapose! hx, + exact g_s n hx }, + simp only [this, mul_zero, tsum_zero] }, + { assume x hx, + obtain ⟨n, hn⟩ : ∃ n, x ∈ support (g n), from s_g x hx, + have I : 0 < r n * g n x, + from mul_pos (rpos n) (lt_of_le_of_ne (g_nonneg n x) (ne.symm hn)), + exact ne_of_gt (tsum_pos (S x) (λ i, mul_nonneg (rpos i).le (g_nonneg i x)) n I) } }, + { refine cont_diff_tsum_of_eventually (λ n, (g_smooth n).const_smul _) + (λ k hk, (nnreal.has_sum_coe.2 δc).summable) _, + assume i hi, + simp only [nat.cofinite_eq_at_top, pi.smul_apply, algebra.id.smul_eq_mul, + filter.eventually_at_top, ge_iff_le], + exact ⟨i, λ n hn x, hr _ _ hn _⟩ }, + { rintros - ⟨y, rfl⟩, + refine ⟨tsum_nonneg (λ n, mul_nonneg (rpos n).le (g_nonneg n y)), le_trans _ c_lt.le⟩, + have A : has_sum (λ n, (δ n : ℝ)) c, from nnreal.has_sum_coe.2 δc, + rw ← A.tsum_eq, + apply tsum_le_tsum _ (S y) A.summable, + assume n, + apply (le_abs_self _).trans, + simpa only [norm_iterated_fderiv_zero] using hr n 0 (zero_le n) y } +end + +end + +section + +namespace exists_cont_diff_bump_base + +/-- An auxiliary function to construct partitions of unity on finite-dimensional real vector spaces. +It is the characteristic function of the closed unit ball. -/ +def φ : E → ℝ := (closed_ball (0 : E) 1).indicator (λ y, (1 : ℝ)) + +variables [normed_space ℝ E] [finite_dimensional ℝ E] + +section helper_definitions + +variable (E) +lemma u_exists : ∃ u : E → ℝ, cont_diff ℝ ⊤ u ∧ + (∀ x, u x ∈ Icc (0 : ℝ) 1) ∧ (support u = ball 0 1) ∧ (∀ x, u (-x) = u x) := +begin + have A : is_open (ball (0 : E) 1), from is_open_ball, + obtain ⟨f, f_support, f_smooth, f_range⟩ : + ∃ (f : E → ℝ), f.support = ball (0 : E) 1 ∧ cont_diff ℝ ⊤ f ∧ set.range f ⊆ set.Icc 0 1, + from A.exists_smooth_support_eq, + have B : ∀ x, f x ∈ Icc (0 : ℝ) 1 := λ x, f_range (mem_range_self x), + refine ⟨λ x, (f x + f (-x)) / 2, _, _, _, _⟩, + { exact (f_smooth.add (f_smooth.comp cont_diff_neg)).div_const _ }, + { assume x, + split, + { linarith [(B x).1, (B (-x)).1] }, + { linarith [(B x).2, (B (-x)).2] } }, + { refine support_eq_iff.2 ⟨λ x hx, _, λ x hx, _⟩, + { apply ne_of_gt, + have : 0 < f x, + { apply lt_of_le_of_ne (B x).1 (ne.symm _), + rwa ← f_support at hx }, + linarith [(B (-x)).1] }, + { have I1 : x ∉ support f, by rwa f_support, + have I2 : -x ∉ support f, + { rw f_support, + simp only at hx, + simpa using hx }, + simp only [mem_support, not_not] at I1 I2, + simp only [I1, I2, add_zero, zero_div] } }, + { assume x, simp only [add_comm, neg_neg] } +end + +variable {E} + +/-- An auxiliary function to construct partitions of unity on finite-dimensional real vector spaces, +which is smooth, symmetric, and with support equal to the unit ball. -/ +def u (x : E) : ℝ := classical.some (u_exists E) x + +variable (E) +lemma u_smooth : cont_diff ℝ ⊤ (u : E → ℝ) := (classical.some_spec (u_exists E)).1 + +lemma u_continuous : continuous (u : E → ℝ) := (u_smooth E).continuous + +lemma u_support : support (u : E → ℝ) = ball 0 1 := (classical.some_spec (u_exists E)).2.2.1 + +lemma u_compact_support : has_compact_support (u : E → ℝ) := +begin + rw [has_compact_support_def, u_support, closure_ball (0 : E) one_ne_zero], + exact is_compact_closed_ball _ _, +end +variable {E} + +lemma u_nonneg (x : E) : 0 ≤ u x := ((classical.some_spec (u_exists E)).2.1 x).1 + +lemma u_le_one (x : E) : u x ≤ 1 := ((classical.some_spec (u_exists E)).2.1 x).2 + +lemma u_neg (x : E) : u (-x) = u x := (classical.some_spec (u_exists E)).2.2.2 x + +variables [measurable_space E] [borel_space E] + +local notation `μ` := measure_theory.measure.add_haar + +variable (E) +lemma u_int_pos : 0 < ∫ (x : E), u x ∂μ := +begin + refine (integral_pos_iff_support_of_nonneg u_nonneg _).mpr _, + { exact (u_continuous E).integrable_of_has_compact_support (u_compact_support E) }, + { rw u_support, exact measure_ball_pos _ _ zero_lt_one } +end +variable {E} + +/-- An auxiliary function to construct partitions of unity on finite-dimensional real vector spaces, +which is smooth, symmetric, with support equal to the ball of radius `D` and integral `1`. -/ +def W (D : ℝ) (x : E) : ℝ := ((∫ (x : E), u x ∂μ) * |D|^(finrank ℝ E))⁻¹ • u (D⁻¹ • x) + +lemma W_def (D : ℝ) : + (W D : E → ℝ) = λ x, ((∫ (x : E), u x ∂μ) * |D|^(finrank ℝ E))⁻¹ • u (D⁻¹ • x) := +by { ext1 x, refl } + +lemma W_nonneg (D : ℝ) (x : E) : 0 ≤ W D x := +begin + apply mul_nonneg _ (u_nonneg _), + apply inv_nonneg.2, + apply mul_nonneg (u_int_pos E).le, + apply pow_nonneg (abs_nonneg D) +end + +lemma W_mul_φ_nonneg (D : ℝ) (x y : E) : 0 ≤ W D y * φ (x - y) := +mul_nonneg (W_nonneg D y) (indicator_nonneg (by simp only [zero_le_one, implies_true_iff]) _) + +variable (E) + +lemma W_integral {D : ℝ} (Dpos : 0 < D) : ∫ (x : E), W D x ∂μ = 1 := +begin + simp_rw [W, integral_smul], + rw [integral_comp_inv_smul_of_nonneg μ (u : E → ℝ) Dpos.le, + abs_of_nonneg Dpos.le, mul_comm], + field_simp [Dpos.ne', (u_int_pos E).ne'], +end + +lemma W_support {D : ℝ} (Dpos : 0 < D) : support (W D : E → ℝ) = ball 0 D := +begin + have B : D • ball (0 : E) 1 = ball 0 D, + by rw [smul_unit_ball Dpos.ne', real.norm_of_nonneg Dpos.le], + have C : D ^ finrank ℝ E ≠ 0, from pow_ne_zero _ Dpos.ne', + simp only [W_def, algebra.id.smul_eq_mul, support_mul, support_inv, univ_inter, + support_comp_inv_smul₀ Dpos.ne', u_support, B, support_const (u_int_pos E).ne', + support_const C, abs_of_nonneg Dpos.le], +end + +lemma W_compact_support {D : ℝ} (Dpos : 0 < D) : has_compact_support (W D : E → ℝ) := +begin + rw [has_compact_support_def, W_support E Dpos, closure_ball (0 : E) Dpos.ne'], + exact is_compact_closed_ball _ _, +end +variable {E} + +/-- An auxiliary function to construct partitions of unity on finite-dimensional real vector spaces. +It is the convolution between a smooth function of integral `1` supported in the ball of radius `D`, +with the indicator function of the closed unit ball. Therefore, it is smooth, equal to `1` on the +ball of radius `1 - D`, with support equal to the ball of radius `1 + D`. -/ +def Y (D : ℝ) : E → ℝ := W D ⋆[lsmul ℝ ℝ, μ] φ + +lemma Y_neg (D : ℝ) (x : E) : Y D (-x) = Y D x := +begin + apply convolution_neg_of_neg_eq, + { apply eventually_of_forall (λ x, _), + simp only [W_def, u_neg, smul_neg, algebra.id.smul_eq_mul, mul_eq_mul_left_iff, + eq_self_iff_true, true_or], }, + { apply eventually_of_forall (λ x, _), + simp only [φ, indicator, mem_closed_ball_zero_iff, norm_neg] }, +end + +lemma Y_eq_one_of_mem_closed_ball {D : ℝ} {x : E} (Dpos : 0 < D) + (hx : x ∈ closed_ball (0 : E) (1 - D)) : Y D x = 1 := +begin + change (W D ⋆[lsmul ℝ ℝ, μ] φ) x = 1, + have B : ∀ (y : E), y ∈ ball x D → φ y = 1, + { have C : ball x D ⊆ ball 0 1, + { apply ball_subset_ball', + simp only [mem_closed_ball] at hx, + linarith only [hx] }, + assume y hy, + simp only [φ, indicator, mem_closed_ball, ite_eq_left_iff, not_le, zero_ne_one], + assume h'y, + linarith only [mem_ball.1 (C hy), h'y] }, + have Bx : φ x = 1, from B _ (mem_ball_self Dpos), + have B' : ∀ y, y ∈ ball x D → φ y = φ x, by { rw Bx, exact B }, + rw convolution_eq_right' _ (le_of_eq (W_support E Dpos)) B', + simp only [lsmul_apply, algebra.id.smul_eq_mul, integral_mul_right, W_integral E Dpos, Bx, + one_mul], +end + +lemma Y_eq_zero_of_not_mem_ball {D : ℝ} {x : E} (Dpos : 0 < D) + (hx : x ∉ ball (0 : E) (1 + D)) : Y D x = 0 := +begin + change (W D ⋆[lsmul ℝ ℝ, μ] φ) x = 0, + have B : ∀ y, y ∈ ball x D → φ y = 0, + { assume y hy, + simp only [φ, indicator, mem_closed_ball_zero_iff, ite_eq_right_iff, one_ne_zero], + assume h'y, + have C : ball y D ⊆ ball 0 (1+D), + { apply ball_subset_ball', + rw ← dist_zero_right at h'y, + linarith only [h'y] }, + exact hx (C (mem_ball_comm.1 hy)) }, + have Bx : φ x = 0, from B _ (mem_ball_self Dpos), + have B' : ∀ y, y ∈ ball x D → φ y = φ x, by { rw Bx, exact B }, + rw convolution_eq_right' _ (le_of_eq (W_support E Dpos)) B', + simp only [lsmul_apply, algebra.id.smul_eq_mul, Bx, mul_zero, integral_const] +end + +lemma Y_nonneg (D : ℝ) (x : E) : 0 ≤ Y D x := +integral_nonneg (W_mul_φ_nonneg D x) + +lemma Y_le_one {D : ℝ} (x : E) (Dpos : 0 < D) : Y D x ≤ 1 := +begin + have A : (W D ⋆[lsmul ℝ ℝ, μ] φ) x ≤ (W D ⋆[lsmul ℝ ℝ, μ] 1) x, + { apply convolution_mono_right_of_nonneg _ (W_nonneg D) + (indicator_le_self' (λ x hx, zero_le_one)) (λ x, zero_le_one), + refine (has_compact_support.convolution_exists_left _ (W_compact_support E Dpos) _ + (locally_integrable_const (1 : ℝ)) x).integrable, + exact continuous_const.mul ((u_continuous E).comp (continuous_id.const_smul _)) }, + have B : (W D ⋆[lsmul ℝ ℝ, μ] (λ y, (1 : ℝ))) x = 1, + by simp only [convolution, continuous_linear_map.map_smul, mul_inv_rev, coe_smul', mul_one, + lsmul_apply, algebra.id.smul_eq_mul, integral_mul_left, W_integral E Dpos, pi.smul_apply], + exact A.trans (le_of_eq B) +end + +lemma Y_pos_of_mem_ball {D : ℝ} {x : E} (Dpos : 0 < D) (D_lt_one : D < 1) + (hx : x ∈ ball (0 : E) (1 + D)) : 0 < Y D x := +begin + simp only [mem_ball_zero_iff] at hx, + refine (integral_pos_iff_support_of_nonneg (W_mul_φ_nonneg D x) _).2 _, + { have F_comp : has_compact_support (W D), + from W_compact_support E Dpos, + have B : locally_integrable (φ : E → ℝ) μ, + from (locally_integrable_const _).indicator measurable_set_closed_ball, + have C : continuous (W D : E → ℝ), + from continuous_const.mul ((u_continuous E).comp (continuous_id.const_smul _)), + exact (has_compact_support.convolution_exists_left (lsmul ℝ ℝ : ℝ →L[ℝ] ℝ →L[ℝ] ℝ) + F_comp C B x).integrable }, + { set z := (D / (1 + D)) • x with hz, + have B : 0 < 1 + D, by linarith, + have C : ball z (D * (1 + D- ‖x‖) / (1 + D)) ⊆ support (λ (y : E), W D y * φ (x - y)), + { assume y hy, + simp only [support_mul, W_support E Dpos], + simp only [φ, mem_inter_iff, mem_support, ne.def, indicator_apply_eq_zero, + mem_closed_ball_zero_iff, one_ne_zero, not_forall, not_false_iff, exists_prop, and_true], + split, + { apply ball_subset_ball' _ hy, + simp only [z, norm_smul, abs_of_nonneg Dpos.le, abs_of_nonneg B.le, dist_zero_right, + real.norm_eq_abs, abs_div], + simp only [div_le_iff B] with field_simps, + ring_nf }, + { have ID : ‖D / (1 + D) - 1‖ = 1 / (1 + D), + { rw real.norm_of_nonpos, + { simp only [B.ne', ne.def, not_false_iff, mul_one, neg_sub, add_tsub_cancel_right] + with field_simps}, + { simp only [B.ne', ne.def, not_false_iff, mul_one] with field_simps, + apply div_nonpos_of_nonpos_of_nonneg _ B.le, + linarith only, } }, + rw ← mem_closed_ball_iff_norm', + apply closed_ball_subset_closed_ball' _ (ball_subset_closed_ball hy), + rw [← one_smul ℝ x, dist_eq_norm, hz, ← sub_smul, one_smul, norm_smul, ID], + simp only [-one_div, -mul_eq_zero, B.ne', div_le_iff B] with field_simps, + simp only [mem_ball_zero_iff] at hx, + nlinarith only [hx, D_lt_one] } }, + apply lt_of_lt_of_le _ (measure_mono C), + apply measure_ball_pos, + exact div_pos (mul_pos Dpos (by linarith only [hx])) B } +end + +variable (E) + +lemma Y_smooth : cont_diff_on ℝ ⊤ (uncurry Y) ((Ioo (0 : ℝ) 1) ×ˢ (univ : set E)) := +begin + have hs : is_open (Ioo (0 : ℝ) (1 : ℝ)), from is_open_Ioo, + have hk : is_compact (closed_ball (0 : E) 1), from proper_space.is_compact_closed_ball _ _, + refine cont_diff_on_convolution_left_with_param (lsmul ℝ ℝ) hs hk _ _ _, + { rintros p x hp hx, + simp only [W, mul_inv_rev, algebra.id.smul_eq_mul, mul_eq_zero, inv_eq_zero], + right, + contrapose! hx, + have : p⁻¹ • x ∈ support u, from mem_support.2 hx, + simp only [u_support, norm_smul, mem_ball_zero_iff, real.norm_eq_abs, abs_inv, + abs_of_nonneg hp.1.le, ← div_eq_inv_mul, div_lt_one hp.1] at this, + rw mem_closed_ball_zero_iff, + exact this.le.trans hp.2.le }, + { exact (locally_integrable_const _).indicator measurable_set_closed_ball }, + { apply cont_diff_on.mul, + { refine (cont_diff_on_const.mul _).inv + (λ x hx, ne_of_gt (mul_pos (u_int_pos E) (pow_pos (abs_pos_of_pos hx.1.1) _))), + apply cont_diff_on.pow, + simp_rw [← real.norm_eq_abs], + apply @cont_diff_on.norm ℝ, + { exact cont_diff_on_fst }, + { assume x hx, exact ne_of_gt hx.1.1 } }, + { apply (u_smooth E).comp_cont_diff_on, + exact cont_diff_on.smul (cont_diff_on_fst.inv (λ x hx, ne_of_gt hx.1.1)) cont_diff_on_snd } }, +end + +lemma Y_support {D : ℝ} (Dpos : 0 < D) (D_lt_one : D < 1) : + support (Y D : E → ℝ) = ball (0 : E) (1 + D) := +support_eq_iff.2 ⟨λ x hx, (Y_pos_of_mem_ball Dpos D_lt_one hx).ne', + λ x hx, Y_eq_zero_of_not_mem_ball Dpos hx⟩ + +variable {E} + +end helper_definitions + +@[priority 100] +instance {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E] : + has_cont_diff_bump E := +begin + refine ⟨⟨_⟩⟩, + borelize E, + have IR : ∀ (R : ℝ), 1 < R → 0 < (R - 1) / (R + 1), + { assume R hR, apply div_pos; linarith }, + exact + { to_fun := λ R x, if 1 < R then Y ((R - 1) / (R + 1)) (((R + 1) / 2)⁻¹ • x) else 0, + mem_Icc := λ R x, begin + split_ifs, + { refine ⟨Y_nonneg _ _, Y_le_one _ (IR R h)⟩ }, + { simp only [pi.zero_apply, left_mem_Icc, zero_le_one] } + end, + symmetric := λ R x, begin + split_ifs, + { simp only [Y_neg, smul_neg] }, + { refl }, + end, + smooth := begin + suffices : cont_diff_on ℝ ⊤ + ((uncurry Y) ∘ (λ (p : ℝ × E), ((p.1 - 1) / (p.1 + 1), ((p.1 + 1)/2)⁻¹ • p.2))) + (Ioi 1 ×ˢ univ), + { apply this.congr, + rintros ⟨R, x⟩ ⟨(hR : 1 < R), hx⟩, + simp only [hR, uncurry_apply_pair, if_true, comp_app], }, + apply (Y_smooth E).comp, + { apply cont_diff_on.prod, + { refine (cont_diff_on_fst.sub cont_diff_on_const).div + (cont_diff_on_fst.add cont_diff_on_const) _, + rintros ⟨R, x⟩ ⟨(hR : 1 < R), hx⟩, + apply ne_of_gt, + dsimp only, + linarith, }, + { apply cont_diff_on.smul _ cont_diff_on_snd, + refine ((cont_diff_on_fst.add cont_diff_on_const).div_const _).inv _, + rintros ⟨R, x⟩ ⟨(hR : 1 < R), hx⟩, + apply ne_of_gt, + dsimp only, + linarith } }, + { rintros ⟨R, x⟩ ⟨(hR : 1 < R), hx⟩, + have A : 0 < (R - 1) / (R + 1), by { apply div_pos; linarith }, + have B : (R - 1) / (R + 1) < 1, by { apply (div_lt_one _ ).2; linarith }, + simp only [mem_preimage, prod_mk_mem_set_prod_eq, mem_Ioo, mem_univ, and_true, A, B] } + end, + eq_one := λ R hR x hx, begin + have A : 0 < R + 1, by linarith, + simp only [hR, if_true], + apply Y_eq_one_of_mem_closed_ball (IR R hR), + simp only [norm_smul, inv_div, mem_closed_ball_zero_iff, real.norm_eq_abs, abs_div, + abs_two, abs_of_nonneg A.le], + calc 2 / (R + 1) * ‖x‖ ≤ 2 / (R + 1) * 1 : + mul_le_mul_of_nonneg_left hx (div_nonneg zero_le_two A.le) + ... = 1 - (R - 1) / (R + 1) : by { field_simp [A.ne'], ring } + end, + support := λ R hR, begin + have A : 0 < (R + 1) / 2, by linarith, + have A' : 0 < R + 1, by linarith, + have C : (R - 1) / (R + 1) < 1, by { apply (div_lt_one _ ).2; linarith }, + simp only [hR, if_true, support_comp_inv_smul₀ A.ne', Y_support _ (IR R hR) C, + smul_ball A.ne', real.norm_of_nonneg A.le, smul_zero], + congr' 1, + field_simp [A'.ne'], + ring, + end }, +end + +end exists_cont_diff_bump_base + +end diff --git a/src/analysis/calculus/bump_function_inner.lean b/src/analysis/calculus/bump_function_inner.lean new file mode 100644 index 0000000000000..699f2dbea150b --- /dev/null +++ b/src/analysis/calculus/bump_function_inner.lean @@ -0,0 +1,590 @@ +/- +Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel, Floris van Doorn +-/ +import analysis.calculus.deriv.inv +import analysis.calculus.extend_deriv +import analysis.calculus.iterated_deriv +import analysis.inner_product_space.calculus +import analysis.special_functions.exp_deriv +import measure_theory.integral.set_integral + +/-! +# Infinitely smooth bump function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we construct several infinitely smooth functions with properties that an analytic +function cannot have: + +* `exp_neg_inv_glue` is equal to zero for `x ≤ 0` and is strictly positive otherwise; it is given by + `x ↦ exp (-1/x)` for `x > 0`; + +* `real.smooth_transition` is equal to zero for `x ≤ 0` and is equal to one for `x ≥ 1`; it is given + by `exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x))`; + +* `f : cont_diff_bump c`, where `c` is a point in a real vector space, is + a bundled smooth function such that + + - `f` is equal to `1` in `metric.closed_ball c f.r`; + - `support f = metric.ball c f.R`; + - `0 ≤ f x ≤ 1` for all `x`. + + The structure `cont_diff_bump` contains the data required to construct the + function: real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available + through `coe_fn`. + +* If `f : cont_diff_bump c` and `μ` is a measure on the domain of `f`, then `f.normed μ` + is a smooth bump function with integral `1` w.r.t. `μ`. +-/ + +noncomputable theory +open_locale classical topology + +open polynomial real filter set function +open_locale polynomial + +/-- `exp_neg_inv_glue` is the real function given by `x ↦ exp (-1/x)` for `x > 0` and `0` +for `x ≤ 0`. It is a basic building block to construct smooth partitions of unity. Its main property +is that it vanishes for `x ≤ 0`, it is positive for `x > 0`, and the junction between the two +behaviors is flat enough to retain smoothness. The fact that this function is `C^∞` is proved in +`exp_neg_inv_glue.smooth`. -/ +def exp_neg_inv_glue (x : ℝ) : ℝ := if x ≤ 0 then 0 else exp (-x⁻¹) + +namespace exp_neg_inv_glue + +/-- Our goal is to prove that `exp_neg_inv_glue` is `C^∞`. For this, we compute its successive +derivatives for `x > 0`. The `n`-th derivative is of the form `P_aux n (x) exp(-1/x) / x^(2 n)`, +where `P_aux n` is computed inductively. -/ +noncomputable def P_aux : ℕ → ℝ[X] +| 0 := 1 +| (n+1) := X^2 * (P_aux n).derivative + (1 - C ↑(2 * n) * X) * (P_aux n) + +/-- Formula for the `n`-th derivative of `exp_neg_inv_glue`, as an auxiliary function `f_aux`. -/ +def f_aux (n : ℕ) (x : ℝ) : ℝ := +if x ≤ 0 then 0 else (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n) + +/-- The `0`-th auxiliary function `f_aux 0` coincides with `exp_neg_inv_glue`, by definition. -/ +lemma f_aux_zero_eq : f_aux 0 = exp_neg_inv_glue := +begin + ext x, + by_cases h : x ≤ 0, + { simp [exp_neg_inv_glue, f_aux, h] }, + { simp [h, exp_neg_inv_glue, f_aux, ne_of_gt (not_le.1 h), P_aux] } +end + +/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n` +(given in this statement in unfolded form) is the `n+1`-th auxiliary function, since +the polynomial `P_aux (n+1)` was chosen precisely to ensure this. -/ +lemma f_aux_deriv (n : ℕ) (x : ℝ) (hx : x ≠ 0) : + has_deriv_at (λx, (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n)) + ((P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n + 1))) x := +begin + simp only [P_aux, eval_add, eval_sub, eval_mul, eval_pow, eval_X, eval_C, eval_one], + convert (((P_aux n).has_deriv_at x).mul + (((has_deriv_at_exp _).comp x (has_deriv_at_inv hx).neg))).div + (has_deriv_at_pow (2 * n) x) (pow_ne_zero _ hx) using 1, + rw div_eq_div_iff, + { have := pow_ne_zero 2 hx, field_simp only, + cases n, + { simp only [mul_zero, nat.cast_zero, mul_one], ring }, + { rw (id rfl : 2 * n.succ - 1 = 2 * n + 1), ring_exp } }, + all_goals { apply_rules [pow_ne_zero] }, +end + +/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n` +is the `n+1`-th auxiliary function. -/ +lemma f_aux_deriv_pos (n : ℕ) (x : ℝ) (hx : 0 < x) : + has_deriv_at (f_aux n) ((P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n + 1))) x := +begin + apply (f_aux_deriv n x (ne_of_gt hx)).congr_of_eventually_eq, + filter_upwards [lt_mem_nhds hx] with _ hy, + simp [f_aux, hy.not_le] +end + +/-- To get differentiability at `0` of the auxiliary functions, we need to know that their limit +is `0`, to be able to apply general differentiability extension theorems. This limit is checked in +this lemma. -/ +lemma f_aux_limit (n : ℕ) : + tendsto (λx, (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n)) (𝓝[>] 0) (𝓝 0) := +begin + have A : tendsto (λx, (P_aux n).eval x) (𝓝[>] 0) (𝓝 ((P_aux n).eval 0)) := + (P_aux n).continuous_within_at, + have B : tendsto (λx, exp (-x⁻¹) / x^(2 * n)) (𝓝[>] 0) (𝓝 0), + { convert (tendsto_pow_mul_exp_neg_at_top_nhds_0 (2 * n)).comp tendsto_inv_zero_at_top, + ext x, + field_simp }, + convert A.mul B; + simp [mul_div_assoc] +end + +/-- Deduce from the limiting behavior at `0` of its derivative and general differentiability +extension theorems that the auxiliary function `f_aux n` is differentiable at `0`, +with derivative `0`. -/ +lemma f_aux_deriv_zero (n : ℕ) : has_deriv_at (f_aux n) 0 0 := +begin + -- we check separately differentiability on the left and on the right + have A : has_deriv_within_at (f_aux n) (0 : ℝ) (Iic 0) 0, + { apply (has_deriv_at_const (0 : ℝ) (0 : ℝ)).has_deriv_within_at.congr, + { assume y hy, + simp at hy, + simp [f_aux, hy] }, + { simp [f_aux, le_refl] } }, + have B : has_deriv_within_at (f_aux n) (0 : ℝ) (Ici 0) 0, + { have diff : differentiable_on ℝ (f_aux n) (Ioi 0) := + λx hx, (f_aux_deriv_pos n x hx).differentiable_at.differentiable_within_at, + -- next line is the nontrivial bit of this proof, appealing to differentiability + -- extension results. + apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff _ self_mem_nhds_within, + { refine (f_aux_limit (n+1)).congr' _, + apply mem_of_superset self_mem_nhds_within (λx hx, _), + simp [(f_aux_deriv_pos n x hx).deriv] }, + { have : f_aux n 0 = 0, by simp [f_aux, le_refl], + simp only [continuous_within_at, this], + refine (f_aux_limit n).congr' _, + apply mem_of_superset self_mem_nhds_within (λx hx, _), + have : ¬(x ≤ 0), by simpa using hx, + simp [f_aux, this] } }, + simpa using A.union B, +end + +/-- At every point, the auxiliary function `f_aux n` has a derivative which is +equal to `f_aux (n+1)`. -/ +lemma f_aux_has_deriv_at (n : ℕ) (x : ℝ) : has_deriv_at (f_aux n) (f_aux (n+1) x) x := +begin + -- check separately the result for `x < 0`, where it is trivial, for `x > 0`, where it is done + -- in `f_aux_deriv_pos`, and for `x = 0`, done in + -- `f_aux_deriv_zero`. + rcases lt_trichotomy x 0 with hx|hx|hx, + { have : f_aux (n+1) x = 0, by simp [f_aux, le_of_lt hx], + rw this, + apply (has_deriv_at_const x (0 : ℝ)).congr_of_eventually_eq, + filter_upwards [gt_mem_nhds hx] with _ hy, + simp [f_aux, hy.le] }, + { have : f_aux (n + 1) 0 = 0, by simp [f_aux, le_refl], + rw [hx, this], + exact f_aux_deriv_zero n }, + { have : f_aux (n+1) x = (P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n+1)), + by simp [f_aux, not_le_of_gt hx], + rw this, + exact f_aux_deriv_pos n x hx }, +end + +/-- The successive derivatives of the auxiliary function `f_aux 0` are the +functions `f_aux n`, by induction. -/ +lemma f_aux_iterated_deriv (n : ℕ) : iterated_deriv n (f_aux 0) = f_aux n := +begin + induction n with n IH, + { simp }, + { simp [iterated_deriv_succ, IH], + ext x, + exact (f_aux_has_deriv_at n x).deriv } +end + +/-- The function `exp_neg_inv_glue` is smooth. -/ +protected theorem cont_diff {n} : cont_diff ℝ n exp_neg_inv_glue := +begin + rw ← f_aux_zero_eq, + apply cont_diff_of_differentiable_iterated_deriv (λ m hm, _), + rw f_aux_iterated_deriv m, + exact λ x, (f_aux_has_deriv_at m x).differentiable_at +end + +/-- The function `exp_neg_inv_glue` vanishes on `(-∞, 0]`. -/ +lemma zero_of_nonpos {x : ℝ} (hx : x ≤ 0) : exp_neg_inv_glue x = 0 := +by simp [exp_neg_inv_glue, hx] + +/-- The function `exp_neg_inv_glue` is positive on `(0, +∞)`. -/ +lemma pos_of_pos {x : ℝ} (hx : 0 < x) : 0 < exp_neg_inv_glue x := +by simp [exp_neg_inv_glue, not_le.2 hx, exp_pos] + +/-- The function exp_neg_inv_glue` is nonnegative. -/ +lemma nonneg (x : ℝ) : 0 ≤ exp_neg_inv_glue x := +begin + cases le_or_gt x 0, + { exact ge_of_eq (zero_of_nonpos h) }, + { exact le_of_lt (pos_of_pos h) } +end + +end exp_neg_inv_glue + +/-- An infinitely smooth function `f : ℝ → ℝ` such that `f x = 0` for `x ≤ 0`, +`f x = 1` for `1 ≤ x`, and `0 < f x < 1` for `0 < x < 1`. -/ +def real.smooth_transition (x : ℝ) : ℝ := +exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x)) + +namespace real + +namespace smooth_transition + +variables {x : ℝ} + +open exp_neg_inv_glue + +lemma pos_denom (x) : 0 < exp_neg_inv_glue x + exp_neg_inv_glue (1 - x) := +(zero_lt_one.lt_or_lt x).elim + (λ hx, add_pos_of_pos_of_nonneg (pos_of_pos hx) (nonneg _)) + (λ hx, add_pos_of_nonneg_of_pos (nonneg _) (pos_of_pos $ sub_pos.2 hx)) + +lemma one_of_one_le (h : 1 ≤ x) : smooth_transition x = 1 := +(div_eq_one_iff_eq $ (pos_denom x).ne').2 $ by rw [zero_of_nonpos (sub_nonpos.2 h), add_zero] + +lemma zero_of_nonpos (h : x ≤ 0) : smooth_transition x = 0 := +by rw [smooth_transition, zero_of_nonpos h, zero_div] + +@[simp] protected lemma zero : smooth_transition 0 = 0 := +zero_of_nonpos le_rfl + +@[simp] protected lemma one : smooth_transition 1 = 1 := +one_of_one_le le_rfl + +/-- Since `real.smooth_transition` is constant on $(-∞, 0]$ and $[1, ∞)$, applying it to the +projection of `x : ℝ` to $[0, 1]$ gives the same result as applying it to `x`. -/ +@[simp] protected lemma proj_Icc : + smooth_transition (proj_Icc (0 : ℝ) 1 zero_le_one x) = smooth_transition x := +begin + refine congr_fun (Icc_extend_eq_self zero_le_one smooth_transition (λ x hx, _) (λ x hx, _)) x, + { rw [smooth_transition.zero, zero_of_nonpos hx.le] }, + { rw [smooth_transition.one, one_of_one_le hx.le] } +end + +lemma le_one (x : ℝ) : smooth_transition x ≤ 1 := +(div_le_one (pos_denom x)).2 $ le_add_of_nonneg_right (nonneg _) + +lemma nonneg (x : ℝ) : 0 ≤ smooth_transition x := +div_nonneg (exp_neg_inv_glue.nonneg _) (pos_denom x).le + +lemma lt_one_of_lt_one (h : x < 1) : smooth_transition x < 1 := +(div_lt_one $ pos_denom x).2 $ lt_add_of_pos_right _ $ pos_of_pos $ sub_pos.2 h + +lemma pos_of_pos (h : 0 < x) : 0 < smooth_transition x := +div_pos (exp_neg_inv_glue.pos_of_pos h) (pos_denom x) + +protected lemma cont_diff {n} : cont_diff ℝ n smooth_transition := +exp_neg_inv_glue.cont_diff.div + (exp_neg_inv_glue.cont_diff.add $ exp_neg_inv_glue.cont_diff.comp $ + cont_diff_const.sub cont_diff_id) $ + λ x, (pos_denom x).ne' + +protected lemma cont_diff_at {x n} : cont_diff_at ℝ n smooth_transition x := +smooth_transition.cont_diff.cont_diff_at + +protected lemma continuous : continuous smooth_transition := +(@smooth_transition.cont_diff 0).continuous + +protected lemma continuous_at : continuous_at smooth_transition x := +smooth_transition.continuous.continuous_at + +end smooth_transition + +end real + +variables {E X : Type*} + +/-- `f : cont_diff_bump c`, where `c` is a point in a normed vector space, is a +bundled smooth function such that + +- `f` is equal to `1` in `metric.closed_ball c f.r`; +- `support f = metric.ball c f.R`; +- `0 ≤ f x ≤ 1` for all `x`. + +The structure `cont_diff_bump` contains the data required to construct the function: +real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through +`coe_fn` when the space is nice enough, i.e., satisfies the `has_cont_diff_bump` typeclass. -/ +structure cont_diff_bump (c : E) := +(r R : ℝ) +(r_pos : 0 < r) +(r_lt_R : r < R) + +/-- The base function from which one will construct a family of bump functions. One could +add more properties if they are useful and satisfied in the examples of inner product spaces +and finite dimensional vector spaces, notably derivative norm control in terms of `R - 1`. -/ +@[nolint has_nonempty_instance] +structure cont_diff_bump_base (E : Type*) [normed_add_comm_group E] [normed_space ℝ E] := +(to_fun : ℝ → E → ℝ) +(mem_Icc : ∀ (R : ℝ) (x : E), to_fun R x ∈ Icc (0 : ℝ) 1) +(symmetric : ∀ (R : ℝ) (x : E), to_fun R (-x) = to_fun R x) +(smooth : cont_diff_on ℝ ⊤ (uncurry to_fun) ((Ioi (1 : ℝ)) ×ˢ (univ : set E))) +(eq_one : ∀ (R : ℝ) (hR : 1 < R) (x : E) (hx : ‖x‖ ≤ 1), to_fun R x = 1) +(support : ∀ (R : ℝ) (hR : 1 < R), support (to_fun R) = metric.ball (0 : E) R) + +/-- A class registering that a real vector space admits bump functions. This will be instantiated +first for inner product spaces, and then for finite-dimensional normed spaces. +We use a specific class instead of `nonempty (cont_diff_bump_base E)` for performance reasons. -/ +class has_cont_diff_bump (E : Type*) [normed_add_comm_group E] [normed_space ℝ E] : Prop := +(out : nonempty (cont_diff_bump_base E)) + +/-- In a space with `C^∞` bump functions, register some function that will be used as a basis +to construct bump functions of arbitrary size around any point. -/ +def some_cont_diff_bump_base (E : Type*) [normed_add_comm_group E] [normed_space ℝ E] + [hb : has_cont_diff_bump E] : cont_diff_bump_base E := +nonempty.some hb.out + +/-- Any inner product space has smooth bump functions. -/ +@[priority 100] instance has_cont_diff_bump_of_inner_product_space + (E : Type*) [normed_add_comm_group E] [inner_product_space ℝ E] : has_cont_diff_bump E := +let e : cont_diff_bump_base E := +{ to_fun := λ R x, real.smooth_transition ((R - ‖x‖) / (R - 1)), + mem_Icc := λ R x, ⟨real.smooth_transition.nonneg _, real.smooth_transition.le_one _⟩, + symmetric := λ R x, by simp only [norm_neg], + smooth := begin + rintros ⟨R, x⟩ ⟨(hR : 1 < R), hx⟩, + apply cont_diff_at.cont_diff_within_at, + rcases eq_or_ne x 0 with rfl|hx, + { have : (λ (p : ℝ × E), real.smooth_transition ((p.1 - ‖p.2‖) / (p.1 - 1))) + =ᶠ[𝓝 (R, 0)] (λ p, 1), + { have A : tendsto (λ (p : ℝ × E), (p.1 - ‖p.2‖) / (p.1 - 1)) + (𝓝 (R, 0)) (𝓝 ((R - ‖(0 : E)‖) / (R - 1))), + { rw nhds_prod_eq, + apply (tendsto_fst.sub tendsto_snd.norm).div (tendsto_fst.sub tendsto_const_nhds), + exact (sub_pos.2 hR).ne' }, + have : ∀ᶠ (p : ℝ × E) in 𝓝 (R, 0), 1 < (p.1 - ‖p.2‖) / (p.1 - 1), + { apply (tendsto_order.1 A).1, + apply (one_lt_div (sub_pos.2 hR)).2, + simp only [norm_zero, tsub_zero, sub_lt_self_iff, zero_lt_one] }, + filter_upwards [this] with q hq, + exact real.smooth_transition.one_of_one_le hq.le }, + exact cont_diff_at_const.congr_of_eventually_eq this }, + { refine real.smooth_transition.cont_diff_at.comp _ _, + refine cont_diff_at.div _ _ (sub_pos.2 hR).ne', + { exact cont_diff_at_fst.sub (cont_diff_at_snd.norm ℝ hx) }, + { exact cont_diff_at_fst.sub cont_diff_at_const } } + end, + eq_one := λ R hR x hx, real.smooth_transition.one_of_one_le $ + (one_le_div (sub_pos.2 hR)).2 (sub_le_sub_left hx _), + support := λ R hR, begin + apply subset.antisymm, + { assume x hx, + simp only [mem_support] at hx, + contrapose! hx, + simp only [mem_ball_zero_iff, not_lt] at hx, + apply real.smooth_transition.zero_of_nonpos, + apply div_nonpos_of_nonpos_of_nonneg; + linarith }, + { assume x hx, + simp only [mem_ball_zero_iff] at hx, + apply (real.smooth_transition.pos_of_pos _).ne', + apply div_pos; + linarith } + end, } +in ⟨⟨e⟩⟩ + +namespace cont_diff_bump + +lemma R_pos {c : E} (f : cont_diff_bump c) : 0 < f.R := f.r_pos.trans f.r_lt_R + +lemma one_lt_R_div_r {c : E} (f : cont_diff_bump c) : 1 < f.R / f.r := +begin + rw one_lt_div f.r_pos, + exact f.r_lt_R +end + +instance (c : E) : inhabited (cont_diff_bump c) := ⟨⟨1, 2, zero_lt_one, one_lt_two⟩⟩ + +variables [normed_add_comm_group E] [normed_space ℝ E] [normed_add_comm_group X] [normed_space ℝ X] +[has_cont_diff_bump E] {c : E} (f : cont_diff_bump c) {x : E} {n : ℕ∞} + +/-- The function defined by `f : cont_diff_bump c`. Use automatic coercion to +function instead. -/ +def to_fun {c : E} (f : cont_diff_bump c) : E → ℝ := +λ x, (some_cont_diff_bump_base E).to_fun (f.R / f.r) (f.r⁻¹ • (x - c)) + +instance : has_coe_to_fun (cont_diff_bump c) (λ _, E → ℝ) := ⟨to_fun⟩ + +protected lemma «def» (x : E) : + f x = (some_cont_diff_bump_base E).to_fun (f.R / f.r) (f.r⁻¹ • (x - c)) := +rfl + +protected lemma sub (x : E) : f (c - x) = f (c + x) := +by simp [f.def, cont_diff_bump_base.symmetric] + +protected lemma neg (f : cont_diff_bump (0 : E)) (x : E) : f (- x) = f x := +by simp_rw [← zero_sub, f.sub, zero_add] + +open metric + +lemma one_of_mem_closed_ball (hx : x ∈ closed_ball c f.r) : + f x = 1 := +begin + apply cont_diff_bump_base.eq_one _ _ f.one_lt_R_div_r, + simpa only [norm_smul, norm_eq_abs, abs_inv, abs_of_nonneg f.r_pos.le, ← div_eq_inv_mul, + div_le_one f.r_pos] using mem_closed_ball_iff_norm.1 hx +end + +lemma nonneg : 0 ≤ f x := +(cont_diff_bump_base.mem_Icc ((some_cont_diff_bump_base E)) _ _).1 + +/-- A version of `cont_diff_bump.nonneg` with `x` explicit -/ +lemma nonneg' (x : E) : 0 ≤ f x := +f.nonneg + +lemma le_one : f x ≤ 1 := +(cont_diff_bump_base.mem_Icc ((some_cont_diff_bump_base E)) _ _).2 + +lemma pos_of_mem_ball (hx : x ∈ ball c f.R) : 0 < f x := +begin + refine lt_iff_le_and_ne.2 ⟨f.nonneg, ne.symm _⟩, + change (f.r)⁻¹ • (x - c) ∈ support ((some_cont_diff_bump_base E).to_fun (f.R / f.r)), + rw cont_diff_bump_base.support _ _ f.one_lt_R_div_r, + simp only [dist_eq_norm, mem_ball] at hx, + simpa only [norm_smul, mem_ball_zero_iff, norm_eq_abs, abs_inv, abs_of_nonneg f.r_pos.le, + ← div_eq_inv_mul] using (div_lt_div_right f.r_pos).2 hx, +end + +lemma zero_of_le_dist (hx : f.R ≤ dist x c) : f x = 0 := +begin + rw dist_eq_norm at hx, + suffices H : (f.r)⁻¹ • (x - c) ∉ support ((some_cont_diff_bump_base E).to_fun (f.R / f.r)), + by simpa only [mem_support, not_not] using H, + rw cont_diff_bump_base.support _ _ f.one_lt_R_div_r, + simp [norm_smul, norm_eq_abs, abs_inv, abs_of_nonneg f.r_pos.le, ← div_eq_inv_mul], + exact div_le_div_of_le f.r_pos.le hx, +end + +lemma support_eq : support (f : E → ℝ) = metric.ball c f.R := +begin + ext x, + suffices : f x ≠ 0 ↔ dist x c < f.R, by simpa [mem_support], + cases lt_or_le (dist x c) f.R with hx hx, + { simp only [hx, (f.pos_of_mem_ball hx).ne', ne.def, not_false_iff]}, + { simp only [hx.not_lt, f.zero_of_le_dist hx, ne.def, eq_self_iff_true, not_true] } +end + +lemma tsupport_eq : tsupport f = closed_ball c f.R := +by simp_rw [tsupport, f.support_eq, closure_ball _ f.R_pos.ne'] + +protected lemma has_compact_support [finite_dimensional ℝ E] : has_compact_support f := +by simp_rw [has_compact_support, f.tsupport_eq, is_compact_closed_ball] + +lemma eventually_eq_one_of_mem_ball (h : x ∈ ball c f.r) : + f =ᶠ[𝓝 x] 1 := +((is_open_lt (continuous_id.dist continuous_const) continuous_const).eventually_mem h).mono $ + λ z hz, f.one_of_mem_closed_ball (le_of_lt hz) + +lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 := +f.eventually_eq_one_of_mem_ball (mem_ball_self f.r_pos) + +/-- `cont_diff_bump` is `𝒞ⁿ` in all its arguments. -/ +protected lemma _root_.cont_diff_at.cont_diff_bump {c g : X → E} + {f : ∀ x, cont_diff_bump (c x)} {x : X} + (hc : cont_diff_at ℝ n c x) (hr : cont_diff_at ℝ n (λ x, (f x).r) x) + (hR : cont_diff_at ℝ n (λ x, (f x).R) x) + (hg : cont_diff_at ℝ n g x) : cont_diff_at ℝ n (λ x, f x (g x)) x := +begin + rcases eq_or_ne (g x) (c x) with hx|hx, + { have : (λ x, f x (g x)) =ᶠ[𝓝 x] (λ x, 1), + { have : dist (g x) (c x) < (f x).r, { simp_rw [hx, dist_self, (f x).r_pos] }, + have := continuous_at.eventually_lt (hg.continuous_at.dist hc.continuous_at) hr.continuous_at + this, + exact eventually_of_mem this + (λ x hx, (f x).one_of_mem_closed_ball (mem_set_of_eq.mp hx).le) }, + exact cont_diff_at_const.congr_of_eventually_eq this }, + { change cont_diff_at ℝ n ((uncurry (some_cont_diff_bump_base E).to_fun) ∘ + (λ (x : X), ((f x).R / (f x).r, ((f x).r)⁻¹ • (g x - c x)))) x, + have A : ((f x).R / (f x).r, ((f x).r)⁻¹ • (g x - c x)) ∈ Ioi (1 : ℝ) ×ˢ (univ : set E), + by simpa only [prod_mk_mem_set_prod_eq, mem_univ, and_true] using (f x).one_lt_R_div_r, + have B : Ioi (1 : ℝ) ×ˢ (univ : set E) ∈ 𝓝 ((f x).R / (f x).r, (f x).r⁻¹ • (g x - c x)), + from (is_open_Ioi.prod is_open_univ).mem_nhds A, + apply ((((some_cont_diff_bump_base E).smooth.cont_diff_within_at A).cont_diff_at B) + .of_le le_top).comp x _, + exact (hR.div hr (f x).r_pos.ne').prod ((hr.inv (f x).r_pos.ne').smul (hg.sub hc)) } +end + +lemma _root_.cont_diff.cont_diff_bump {c g : X → E} {f : ∀ x, cont_diff_bump (c x)} + (hc : cont_diff ℝ n c) (hr : cont_diff ℝ n (λ x, (f x).r)) (hR : cont_diff ℝ n (λ x, (f x).R)) + (hg : cont_diff ℝ n g) : cont_diff ℝ n (λ x, f x (g x)) := +by { rw [cont_diff_iff_cont_diff_at] at *, exact λ x, (hc x).cont_diff_bump (hr x) (hR x) (hg x) } + +protected lemma cont_diff : cont_diff ℝ n f := +cont_diff_const.cont_diff_bump cont_diff_const cont_diff_const cont_diff_id + +protected lemma cont_diff_at : cont_diff_at ℝ n f x := +f.cont_diff.cont_diff_at + +protected lemma cont_diff_within_at {s : set E} : cont_diff_within_at ℝ n f s x := +f.cont_diff_at.cont_diff_within_at + +protected lemma continuous : continuous f := +cont_diff_zero.mp f.cont_diff + +open measure_theory +variables [measurable_space E] {μ : measure E} + +/-- A bump function normed so that `∫ x, f.normed μ x ∂μ = 1`. -/ +protected def normed (μ : measure E) : E → ℝ := +λ x, f x / ∫ x, f x ∂μ + +lemma normed_def {μ : measure E} (x : E) : f.normed μ x = f x / ∫ x, f x ∂μ := +rfl + +lemma nonneg_normed (x : E) : 0 ≤ f.normed μ x := +div_nonneg f.nonneg $ integral_nonneg f.nonneg' + +lemma cont_diff_normed {n : ℕ∞} : cont_diff ℝ n (f.normed μ) := +f.cont_diff.div_const _ + +lemma continuous_normed : continuous (f.normed μ) := +f.continuous.div_const _ + +lemma normed_sub (x : E) : f.normed μ (c - x) = f.normed μ (c + x) := +by simp_rw [f.normed_def, f.sub] + +lemma normed_neg (f : cont_diff_bump (0 : E)) (x : E) : f.normed μ (- x) = f.normed μ x := +by simp_rw [f.normed_def, f.neg] + +variables [borel_space E] [finite_dimensional ℝ E] [is_locally_finite_measure μ] + +protected lemma integrable : integrable f μ := +f.continuous.integrable_of_has_compact_support f.has_compact_support + +protected lemma integrable_normed : integrable (f.normed μ) μ := +f.integrable.div_const _ + +variables [μ .is_open_pos_measure] + +lemma integral_pos : 0 < ∫ x, f x ∂μ := +begin + refine (integral_pos_iff_support_of_nonneg f.nonneg' f.integrable).mpr _, + rw [f.support_eq], + refine is_open_ball.measure_pos _ (nonempty_ball.mpr f.R_pos) +end + +lemma integral_normed : ∫ x, f.normed μ x ∂μ = 1 := +begin + simp_rw [cont_diff_bump.normed, div_eq_mul_inv, mul_comm (f _), ← smul_eq_mul, + integral_smul], + exact inv_mul_cancel (f.integral_pos.ne') +end + +lemma support_normed_eq : support (f.normed μ) = metric.ball c f.R := +by simp_rw [cont_diff_bump.normed, support_div, f.support_eq, + support_const f.integral_pos.ne', inter_univ] + +lemma tsupport_normed_eq : tsupport (f.normed μ) = metric.closed_ball c f.R := +by simp_rw [tsupport, f.support_normed_eq, closure_ball _ f.R_pos.ne'] + +lemma has_compact_support_normed : has_compact_support (f.normed μ) := +by simp_rw [has_compact_support, f.tsupport_normed_eq, is_compact_closed_ball] + +lemma tendsto_support_normed_small_sets {ι} {φ : ι → cont_diff_bump c} {l : filter ι} + (hφ : tendsto (λ i, (φ i).R) l (𝓝 0)) : + tendsto (λ i, support (λ x, (φ i).normed μ x)) l (𝓝 c).small_sets := +begin + simp_rw [normed_add_comm_group.tendsto_nhds_zero, real.norm_eq_abs, + abs_eq_self.mpr (φ _).R_pos.le] at hφ, + rw [tendsto_small_sets_iff], + intros t ht, + rcases metric.mem_nhds_iff.mp ht with ⟨ε, hε, ht⟩, + refine (hφ ε hε).mono (λ i hi, subset_trans _ ht), + simp_rw [(φ i).support_normed_eq], + exact ball_subset_ball hi.le +end + +variable (μ) +lemma integral_normed_smul [complete_space X] (z : X) : + ∫ x, f.normed μ x • z ∂μ = z := +by simp_rw [integral_smul_const, f.integral_normed, one_smul] + +end cont_diff_bump diff --git a/src/analysis/calculus/conformal/inner_product.lean b/src/analysis/calculus/conformal/inner_product.lean index 7d84a6b327469..b81bb673c1eda 100644 --- a/src/analysis/calculus/conformal/inner_product.lean +++ b/src/analysis/calculus/conformal/inner_product.lean @@ -9,13 +9,18 @@ import analysis.inner_product_space.conformal_linear_map /-! # Conformal maps between inner product spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A function between inner product spaces is which has a derivative at `x` is conformal at `x` iff the derivative preserves inner products up to a scalar multiple. -/ noncomputable theory -variables {E F : Type*} [inner_product_space ℝ E] [inner_product_space ℝ F] +variables {E F : Type*} +variables [normed_add_comm_group E] [normed_add_comm_group F] +variables [inner_product_space ℝ E] [inner_product_space ℝ F] open_locale real_inner_product_space diff --git a/src/analysis/calculus/conformal/normed_space.lean b/src/analysis/calculus/conformal/normed_space.lean index ed631ac4bab84..3806e1b137282 100644 --- a/src/analysis/calculus/conformal/normed_space.lean +++ b/src/analysis/calculus/conformal/normed_space.lean @@ -4,11 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yourong Zang -/ import analysis.normed_space.conformal_linear_map -import analysis.calculus.fderiv +import analysis.calculus.fderiv.add +import analysis.calculus.fderiv.mul +import analysis.calculus.fderiv.equiv +import analysis.calculus.fderiv.restrict_scalars /-! # Conformal Maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A continuous linear map between real normed spaces `X` and `Y` is `conformal_at` some point `x` if it is real differentiable at that point and its differential `is_conformal_linear_map`. @@ -26,7 +32,7 @@ if it is real differentiable at that point and its differential `is_conformal_li In `analysis.calculus.conformal.inner_product`: * `conformal_at_iff`: an equivalent definition of the conformality of a map -In `geometry.euclidean.basic`: +In `geometry.euclidean.angle.unoriented.conformal`: * `conformal_at.preserves_angle`: if a map is conformal at `x`, then its differential preserves all angles at `x` @@ -42,8 +48,8 @@ Maps such as the complex conjugate are considered to be conformal. noncomputable theory -variables {X Y Z : Type*} [normed_group X] [normed_group Y] [normed_group Z] - [normed_space ℝ X] [normed_space ℝ Y] [normed_space ℝ Z] +variables {X Y Z : Type*} [normed_add_comm_group X] [normed_add_comm_group Y] + [normed_add_comm_group Z] [normed_space ℝ X] [normed_space ℝ Y] [normed_space ℝ Z] section loc_conformality diff --git a/src/analysis/calculus/cont_diff.lean b/src/analysis/calculus/cont_diff.lean index 1cd0fd7da5153..6df49e6855c02 100644 --- a/src/analysis/calculus/cont_diff.lean +++ b/src/analysis/calculus/cont_diff.lean @@ -1,155 +1,38 @@ /- Copyright (c) 2019 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sébastien Gouëzel +Authors: Sébastien Gouëzel, Floris van Doorn -/ +import analysis.calculus.cont_diff_def +import analysis.calculus.deriv.inverse import analysis.calculus.mean_value -import analysis.normed_space.multilinear -import analysis.calculus.formal_multilinear_series +import analysis.normed_space.finite_dimension +import data.nat.choose.cast /-! -# Higher differentiability - -A function is `C^1` on a domain if it is differentiable there, and its derivative is continuous. -By induction, it is `C^n` if it is `C^{n-1}` and its (n-1)-th derivative is `C^1` there or, -equivalently, if it is `C^1` and its derivative is `C^{n-1}`. -Finally, it is `C^∞` if it is `C^n` for all n. - -We formalize these notions by defining iteratively the `n+1`-th derivative of a function as the -derivative of the `n`-th derivative. It is called `iterated_fderiv 𝕜 n f x` where `𝕜` is the -field, `n` is the number of iterations, `f` is the function and `x` is the point, and it is given -as an `n`-multilinear map. We also define a version `iterated_fderiv_within` relative to a domain, -as well as predicates `cont_diff_within_at`, `cont_diff_at`, `cont_diff_on` and -`cont_diff` saying that the function is `C^n` within a set at a point, at a point, on a set -and on the whole space respectively. - -To avoid the issue of choice when choosing a derivative in sets where the derivative is not -necessarily unique, `cont_diff_on` is not defined directly in terms of the -regularity of the specific choice `iterated_fderiv_within 𝕜 n f s` inside `s`, but in terms of the -existence of a nice sequence of derivatives, expressed with a predicate -`has_ftaylor_series_up_to_on`. - -We prove basic properties of these notions. - -## Main definitions and results -Let `f : E → F` be a map between normed vector spaces over a nondiscrete normed field `𝕜`. - -* `has_ftaylor_series_up_to n f p`: expresses that the formal multilinear series `p` is a sequence - of iterated derivatives of `f`, up to the `n`-th term (where `n` is a natural number or `∞`). -* `has_ftaylor_series_up_to_on n f p s`: same thing, but inside a set `s`. The notion of derivative - is now taken inside `s`. In particular, derivatives don't have to be unique. -* `cont_diff 𝕜 n f`: expresses that `f` is `C^n`, i.e., it admits a Taylor series up to - rank `n`. -* `cont_diff_on 𝕜 n f s`: expresses that `f` is `C^n` in `s`. -* `cont_diff_at 𝕜 n f x`: expresses that `f` is `C^n` around `x`. -* `cont_diff_within_at 𝕜 n f s x`: expresses that `f` is `C^n` around `x` within the set `s`. -* `iterated_fderiv_within 𝕜 n f s x` is an `n`-th derivative of `f` over the field `𝕜` on the - set `s` at the point `x`. It is a continuous multilinear map from `E^n` to `F`, defined as a - derivative within `s` of `iterated_fderiv_within 𝕜 (n-1) f s` if one exists, and `0` otherwise. -* `iterated_fderiv 𝕜 n f x` is the `n`-th derivative of `f` over the field `𝕜` at the point `x`. - It is a continuous multilinear map from `E^n` to `F`, defined as a derivative of - `iterated_fderiv 𝕜 (n-1) f` if one exists, and `0` otherwise. - -In sets of unique differentiability, `cont_diff_on 𝕜 n f s` can be expressed in terms of the -properties of `iterated_fderiv_within 𝕜 m f s` for `m ≤ n`. In the whole space, -`cont_diff 𝕜 n f` can be expressed in terms of the properties of `iterated_fderiv 𝕜 m f` -for `m ≤ n`. - -We also prove that the usual operations (addition, multiplication, difference, composition, and -so on) preserve `C^n` functions. - -## Implementation notes - -The definitions in this file are designed to work on any field `𝕜`. They are sometimes slightly more -complicated than the naive definitions one would guess from the intuition over the real or complex -numbers, but they are designed to circumvent the lack of gluing properties and partitions of unity -in general. In the usual situations, they coincide with the usual definitions. - -### Definition of `C^n` functions in domains - -One could define `C^n` functions in a domain `s` by fixing an arbitrary choice of derivatives (this -is what we do with `iterated_fderiv_within`) and requiring that all these derivatives up to `n` are -continuous. If the derivative is not unique, this could lead to strange behavior like two `C^n` -functions `f` and `g` on `s` whose sum is not `C^n`. A better definition is thus to say that a -function is `C^n` inside `s` if it admits a sequence of derivatives up to `n` inside `s`. - -This definition still has the problem that a function which is locally `C^n` would not need to -be `C^n`, as different choices of sequences of derivatives around different points might possibly -not be glued together to give a globally defined sequence of derivatives. (Note that this issue -can not happen over reals, thanks to partition of unity, but the behavior over a general field is -not so clear, and we want a definition for general fields). Also, there are locality -problems for the order parameter: one could image a function which, for each `n`, has a nice -sequence of derivatives up to order `n`, but they do not coincide for varying `n` and can therefore -not be glued to give rise to an infinite sequence of derivatives. This would give a function -which is `C^n` for all `n`, but not `C^∞`. We solve this issue by putting locality conditions -in space and order in our definition of `cont_diff_within_at` and `cont_diff_on`. -The resulting definition is slightly more complicated to work with (in fact not so much), but it -gives rise to completely satisfactory theorems. - -For instance, with this definition, a real function which is `C^m` (but not better) on `(-1/m, 1/m)` -for each natural `m` is by definition `C^∞` at `0`. - -There is another issue with the definition of `cont_diff_within_at 𝕜 n f s x`. We can -require the existence and good behavior of derivatives up to order `n` on a neighborhood of `x` -within `s`. However, this does not imply continuity or differentiability within `s` of the function -at `x` when `x` does not belong to `s`. Therefore, we require such existence and good behavior on -a neighborhood of `x` within `s ∪ {x}` (which appears as `insert x s` in this file). - -### Side of the composition, and universe issues - -With a naïve direct definition, the `n`-th derivative of a function belongs to the space -`E →L[𝕜] (E →L[𝕜] (E ... F)...)))` where there are n iterations of `E →L[𝕜]`. This space -may also be seen as the space of continuous multilinear functions on `n` copies of `E` with -values in `F`, by uncurrying. This is the point of view that is usually adopted in textbooks, -and that we also use. This means that the definition and the first proofs are slightly involved, -as one has to keep track of the uncurrying operation. The uncurrying can be done from the -left or from the right, amounting to defining the `n+1`-th derivative either as the derivative of -the `n`-th derivative, or as the `n`-th derivative of the derivative. -For proofs, it would be more convenient to use the latter approach (from the right), -as it means to prove things at the `n+1`-th step we only need to understand well enough the -derivative in `E →L[𝕜] F` (contrary to the approach from the left, where one would need to know -enough on the `n`-th derivative to deduce things on the `n+1`-th derivative). - -However, the definition from the right leads to a universe polymorphism problem: if we define -`iterated_fderiv 𝕜 (n + 1) f x = iterated_fderiv 𝕜 n (fderiv 𝕜 f) x` by induction, we need to -generalize over all spaces (as `f` and `fderiv 𝕜 f` don't take values in the same space). It is -only possible to generalize over all spaces in some fixed universe in an inductive definition. -For `f : E → F`, then `fderiv 𝕜 f` is a map `E → (E →L[𝕜] F)`. Therefore, the definition will only -work if `F` and `E →L[𝕜] F` are in the same universe. - -This issue does not appear with the definition from the left, where one does not need to generalize -over all spaces. Therefore, we use the definition from the left. This means some proofs later on -become a little bit more complicated: to prove that a function is `C^n`, the most efficient approach -is to exhibit a formula for its `n`-th derivative and prove it is continuous (contrary to the -inductive approach where one would prove smoothness statements without giving a formula for the -derivative). In the end, this approach is still satisfactory as it is good to have formulas for the -iterated derivatives in various constructions. - -One point where we depart from this explicit approach is in the proof of smoothness of a -composition: there is a formula for the `n`-th derivative of a composition (Faà di Bruno's formula), -but it is very complicated and barely usable, while the inductive proof is very simple. Thus, we -give the inductive proof. As explained above, it works by generalizing over the target space, hence -it only works well if all spaces belong to the same universe. To get the general version, we lift -things to a common universe using a trick. - -### Variables management - -The textbook definitions and proofs use various identifications and abuse of notations, for instance -when saying that the natural space in which the derivative lives, i.e., -`E →L[𝕜] (E →L[𝕜] ( ... →L[𝕜] F))`, is the same as a space of multilinear maps. When doing things -formally, we need to provide explicit maps for these identifications, and chase some diagrams to see -everything is compatible with the identifications. In particular, one needs to check that taking the -derivative and then doing the identification, or first doing the identification and then taking the -derivative, gives the same result. The key point for this is that taking the derivative commutes -with continuous linear equivalences. Therefore, we need to implement all our identifications with -continuous linear equivs. +# Higher differentiability of usual operations + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We prove that the usual operations (addition, multiplication, difference, composition, and +so on) preserve `C^n` functions. We also expand the API around `C^n` functions. + +## Main results + +* `cont_diff.comp` states that the composition of two `C^n` functions is `C^n`. +* `norm_iterated_fderiv_comp_le` gives the bound `n! * C * D ^ n` for the `n`-th derivative + of `g ∘ f` assuming that the derivatives of `g` are bounded by `C` and the `i`-th + derivative of `f` is bounded by `D ^ i`. + +Similar results are given for `C^n` functions on domains. ## Notations We use the notation `E [×n]→L[𝕜] F` for the space of continuous multilinear maps on `E^n` with values in `F`. This is the space in which the `n`-th derivative of a function from `E` to `F` lives. -In this file, we denote `⊤ : with_top ℕ` with `∞`. +In this file, we denote `⊤ : ℕ∞` with `∞`. ## Tags @@ -157,1356 +40,87 @@ derivative, differentiability, higher derivative, `C^n`, multilinear, Taylor ser -/ noncomputable theory -open_locale classical big_operators nnreal +open_locale classical big_operators nnreal nat -local notation `∞` := (⊤ : with_top ℕ) +local notation `∞` := (⊤ : ℕ∞) -universes u v w +universes u v w uD uE uF uG local attribute [instance, priority 1001] -normed_group.to_add_comm_group normed_space.to_module' add_comm_group.to_add_comm_monoid - -open set fin filter -open_locale topological_space - -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -{E : Type*} [normed_group E] [normed_space 𝕜 E] -{F : Type*} [normed_group F] [normed_space 𝕜 F] -{G : Type*} [normed_group G] [normed_space 𝕜 G] -{s s₁ t u : set E} {f f₁ : E → F} {g : F → G} {x : E} {c : F} -{b : E × F → G} {m n : with_top ℕ} - -/-! ### Functions with a Taylor series on a domain -/ - -variable {p : E → formal_multilinear_series 𝕜 E F} - -/-- `has_ftaylor_series_up_to_on n f p s` registers the fact that `p 0 = f` and `p (m+1)` is a -derivative of `p m` for `m < n`, and is continuous for `m ≤ n`. This is a predicate analogous to -`has_fderiv_within_at` but for higher order derivatives. -/ -structure has_ftaylor_series_up_to_on (n : with_top ℕ) - (f : E → F) (p : E → formal_multilinear_series 𝕜 E F) (s : set E) : Prop := -(zero_eq : ∀ x ∈ s, (p x 0).uncurry0 = f x) -(fderiv_within : ∀ (m : ℕ) (hm : (m : with_top ℕ) < n), ∀ x ∈ s, - has_fderiv_within_at (λ y, p y m) (p x m.succ).curry_left s x) -(cont : ∀ (m : ℕ) (hm : (m : with_top ℕ) ≤ n), continuous_on (λ x, p x m) s) - -lemma has_ftaylor_series_up_to_on.zero_eq' - (h : has_ftaylor_series_up_to_on n f p s) {x : E} (hx : x ∈ s) : - p x 0 = (continuous_multilinear_curry_fin0 𝕜 E F).symm (f x) := -by { rw ← h.zero_eq x hx, symmetry, exact continuous_multilinear_map.uncurry0_curry0 _ } - -/-- If two functions coincide on a set `s`, then a Taylor series for the first one is as well a -Taylor series for the second one. -/ -lemma has_ftaylor_series_up_to_on.congr - (h : has_ftaylor_series_up_to_on n f p s) (h₁ : ∀ x ∈ s, f₁ x = f x) : - has_ftaylor_series_up_to_on n f₁ p s := -begin - refine ⟨λ x hx, _, h.fderiv_within, h.cont⟩, - rw h₁ x hx, - exact h.zero_eq x hx -end - -lemma has_ftaylor_series_up_to_on.mono - (h : has_ftaylor_series_up_to_on n f p s) {t : set E} (hst : t ⊆ s) : - has_ftaylor_series_up_to_on n f p t := -⟨λ x hx, h.zero_eq x (hst hx), -λ m hm x hx, (h.fderiv_within m hm x (hst hx)).mono hst, -λ m hm, (h.cont m hm).mono hst⟩ - -lemma has_ftaylor_series_up_to_on.of_le - (h : has_ftaylor_series_up_to_on n f p s) (hmn : m ≤ n) : - has_ftaylor_series_up_to_on m f p s := -⟨h.zero_eq, -λ k hk x hx, h.fderiv_within k (lt_of_lt_of_le hk hmn) x hx, -λ k hk, h.cont k (le_trans hk hmn)⟩ - -lemma has_ftaylor_series_up_to_on.continuous_on - (h : has_ftaylor_series_up_to_on n f p s) : continuous_on f s := -begin - have := (h.cont 0 bot_le).congr (λ x hx, (h.zero_eq' hx).symm), - rwa linear_isometry_equiv.comp_continuous_on_iff at this -end - -lemma has_ftaylor_series_up_to_on_zero_iff : - has_ftaylor_series_up_to_on 0 f p s ↔ continuous_on f s ∧ (∀ x ∈ s, (p x 0).uncurry0 = f x) := -begin - refine ⟨λ H, ⟨H.continuous_on, H.zero_eq⟩, - λ H, ⟨H.2, λ m hm, false.elim (not_le.2 hm bot_le), _⟩⟩, - assume m hm, - obtain rfl : m = 0, by exact_mod_cast (hm.antisymm (zero_le _)), - have : ∀ x ∈ s, p x 0 = (continuous_multilinear_curry_fin0 𝕜 E F).symm (f x), - by { assume x hx, rw ← H.2 x hx, symmetry, exact continuous_multilinear_map.uncurry0_curry0 _ }, - rw [continuous_on_congr this, linear_isometry_equiv.comp_continuous_on_iff], - exact H.1 -end - -lemma has_ftaylor_series_up_to_on_top_iff : - (has_ftaylor_series_up_to_on ∞ f p s) ↔ (∀ (n : ℕ), has_ftaylor_series_up_to_on n f p s) := -begin - split, - { assume H n, exact H.of_le le_top }, - { assume H, - split, - { exact (H 0).zero_eq }, - { assume m hm, - apply (H m.succ).fderiv_within m (with_top.coe_lt_coe.2 (lt_add_one m)) }, - { assume m hm, - apply (H m).cont m le_rfl } } -end - -/-- If a function has a Taylor series at order at least `1`, then the term of order `1` of this -series is a derivative of `f`. -/ -lemma has_ftaylor_series_up_to_on.has_fderiv_within_at - (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : x ∈ s) : - has_fderiv_within_at f (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) s x := -begin - have A : ∀ y ∈ s, f y = (continuous_multilinear_curry_fin0 𝕜 E F) (p y 0), - { assume y hy, rw ← h.zero_eq y hy, refl }, - suffices H : has_fderiv_within_at - (λ y, continuous_multilinear_curry_fin0 𝕜 E F (p y 0)) - (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) s x, - by exact H.congr A (A x hx), - rw linear_isometry_equiv.comp_has_fderiv_within_at_iff', - have : ((0 : ℕ) : with_top ℕ) < n := - lt_of_lt_of_le (with_top.coe_lt_coe.2 nat.zero_lt_one) hn, - convert h.fderiv_within _ this x hx, - ext y v, - change (p x 1) (snoc 0 y) = (p x 1) (cons y v), - unfold_coes, - congr' with i, - rw unique.eq_default i, - refl -end - -lemma has_ftaylor_series_up_to_on.differentiable_on - (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) : differentiable_on 𝕜 f s := -λ x hx, (h.has_fderiv_within_at hn hx).differentiable_within_at - -/-- If a function has a Taylor series at order at least `1` on a neighborhood of `x`, then the term -of order `1` of this series is a derivative of `f` at `x`. -/ -lemma has_ftaylor_series_up_to_on.has_fderiv_at - (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : s ∈ 𝓝 x) : - has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) x := -(h.has_fderiv_within_at hn (mem_of_mem_nhds hx)).has_fderiv_at hx - -/-- If a function has a Taylor series at order at least `1` on a neighborhood of `x`, then -in a neighborhood of `x`, the term of order `1` of this series is a derivative of `f`. -/ -lemma has_ftaylor_series_up_to_on.eventually_has_fderiv_at - (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : s ∈ 𝓝 x) : - ∀ᶠ y in 𝓝 x, has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p y 1)) y := -(eventually_eventually_nhds.2 hx).mono $ λ y hy, h.has_fderiv_at hn hy - -/-- If a function has a Taylor series at order at least `1` on a neighborhood of `x`, then -it is differentiable at `x`. -/ -lemma has_ftaylor_series_up_to_on.differentiable_at - (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : s ∈ 𝓝 x) : - differentiable_at 𝕜 f x := -(h.has_fderiv_at hn hx).differentiable_at - -/-- `p` is a Taylor series of `f` up to `n+1` if and only if `p` is a Taylor series up to `n`, and -`p (n + 1)` is a derivative of `p n`. -/ -theorem has_ftaylor_series_up_to_on_succ_iff_left {n : ℕ} : - has_ftaylor_series_up_to_on (n + 1) f p s ↔ - has_ftaylor_series_up_to_on n f p s - ∧ (∀ x ∈ s, has_fderiv_within_at (λ y, p y n) (p x n.succ).curry_left s x) - ∧ continuous_on (λ x, p x (n + 1)) s := -begin - split, - { assume h, - exact ⟨h.of_le (with_top.coe_le_coe.2 (nat.le_succ n)), - h.fderiv_within _ (with_top.coe_lt_coe.2 (lt_add_one n)), - h.cont (n + 1) le_rfl⟩ }, - { assume h, - split, - { exact h.1.zero_eq }, - { assume m hm, - by_cases h' : m < n, - { exact h.1.fderiv_within m (with_top.coe_lt_coe.2 h') }, - { have : m = n := nat.eq_of_lt_succ_of_not_lt (with_top.coe_lt_coe.1 hm) h', - rw this, - exact h.2.1 } }, - { assume m hm, - by_cases h' : m ≤ n, - { apply h.1.cont m (with_top.coe_le_coe.2 h') }, - { have : m = (n + 1) := le_antisymm (with_top.coe_le_coe.1 hm) (not_le.1 h'), - rw this, - exact h.2.2 } } } -end - -/-- `p` is a Taylor series of `f` up to `n+1` if and only if `p.shift` is a Taylor series up to `n` -for `p 1`, which is a derivative of `f`. -/ -theorem has_ftaylor_series_up_to_on_succ_iff_right {n : ℕ} : - has_ftaylor_series_up_to_on ((n + 1) : ℕ) f p s ↔ - (∀ x ∈ s, (p x 0).uncurry0 = f x) - ∧ (∀ x ∈ s, has_fderiv_within_at (λ y, p y 0) (p x 1).curry_left s x) - ∧ has_ftaylor_series_up_to_on n - (λ x, continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) (λ x, (p x).shift) s := -begin - split, - { assume H, - refine ⟨H.zero_eq, H.fderiv_within 0 (with_top.coe_lt_coe.2 (nat.succ_pos n)), _⟩, - split, - { assume x hx, refl }, - { assume m (hm : (m : with_top ℕ) < n) x (hx : x ∈ s), - have A : (m.succ : with_top ℕ) < n.succ, - by { rw with_top.coe_lt_coe at ⊢ hm, exact nat.lt_succ_iff.mpr hm }, - change has_fderiv_within_at - ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm - ∘ (λ (y : E), p y m.succ)) - (p x m.succ.succ).curry_right.curry_left s x, - rw linear_isometry_equiv.comp_has_fderiv_within_at_iff', - convert H.fderiv_within _ A x hx, - ext y v, - change (p x m.succ.succ) (snoc (cons y (init v)) (v (last _))) - = (p x (nat.succ (nat.succ m))) (cons y v), - rw [← cons_snoc_eq_snoc_cons, snoc_init_self] }, - { assume m (hm : (m : with_top ℕ) ≤ n), - have A : (m.succ : with_top ℕ) ≤ n.succ, - by { rw with_top.coe_le_coe at ⊢ hm, exact nat.pred_le_iff.mp hm }, - change continuous_on ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm - ∘ (λ (y : E), p y m.succ)) s, - rw linear_isometry_equiv.comp_continuous_on_iff, - exact H.cont _ A } }, - { rintros ⟨Hzero_eq, Hfderiv_zero, Htaylor⟩, - split, - { exact Hzero_eq }, - { assume m (hm : (m : with_top ℕ) < n.succ) x (hx : x ∈ s), - cases m, - { exact Hfderiv_zero x hx }, - { have A : (m : with_top ℕ) < n, - by { rw with_top.coe_lt_coe at hm ⊢, exact nat.lt_of_succ_lt_succ hm }, - have : has_fderiv_within_at ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm - ∘ (λ (y : E), p y m.succ)) ((p x).shift m.succ).curry_left s x := - Htaylor.fderiv_within _ A x hx, - rw linear_isometry_equiv.comp_has_fderiv_within_at_iff' at this, - convert this, - ext y v, - change (p x (nat.succ (nat.succ m))) (cons y v) - = (p x m.succ.succ) (snoc (cons y (init v)) (v (last _))), - rw [← cons_snoc_eq_snoc_cons, snoc_init_self] } }, - { assume m (hm : (m : with_top ℕ) ≤ n.succ), - cases m, - { have : differentiable_on 𝕜 (λ x, p x 0) s := - λ x hx, (Hfderiv_zero x hx).differentiable_within_at, - exact this.continuous_on }, - { have A : (m : with_top ℕ) ≤ n, - by { rw with_top.coe_le_coe at hm ⊢, exact nat.lt_succ_iff.mp hm }, - have : continuous_on ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm - ∘ (λ (y : E), p y m.succ)) s := - Htaylor.cont _ A, - rwa linear_isometry_equiv.comp_continuous_on_iff at this } } } -end - -/-! ### Smooth functions within a set around a point -/ - -variable (𝕜) - -/-- A function is continuously differentiable up to order `n` within a set `s` at a point `x` if -it admits continuous derivatives up to order `n` in a neighborhood of `x` in `s ∪ {x}`. -For `n = ∞`, we only require that this holds up to any finite order (where the neighborhood may -depend on the finite order we consider). - -For instance, a real function which is `C^m` on `(-1/m, 1/m)` for each natural `m`, but not -better, is `C^∞` at `0` within `univ`. --/ -def cont_diff_within_at (n : with_top ℕ) (f : E → F) (s : set E) (x : E) := -∀ (m : ℕ), (m : with_top ℕ) ≤ n → - ∃ u ∈ 𝓝[insert x s] x, ∃ p : E → formal_multilinear_series 𝕜 E F, - has_ftaylor_series_up_to_on m f p u - -variable {𝕜} - -lemma cont_diff_within_at_nat {n : ℕ} : - cont_diff_within_at 𝕜 n f s x ↔ - ∃ u ∈ 𝓝[insert x s] x, ∃ p : E → formal_multilinear_series 𝕜 E F, - has_ftaylor_series_up_to_on n f p u := -⟨λ H, H n le_rfl, λ ⟨u, hu, p, hp⟩ m hm, ⟨u, hu, p, hp.of_le hm⟩⟩ - -lemma cont_diff_within_at.of_le - (h : cont_diff_within_at 𝕜 n f s x) (hmn : m ≤ n) : - cont_diff_within_at 𝕜 m f s x := -λ k hk, h k (le_trans hk hmn) - -lemma cont_diff_within_at_iff_forall_nat_le : - cont_diff_within_at 𝕜 n f s x ↔ ∀ m : ℕ, ↑m ≤ n → cont_diff_within_at 𝕜 m f s x := -⟨λ H m hm, H.of_le hm, λ H m hm, H m hm _ le_rfl⟩ - -lemma cont_diff_within_at_top : - cont_diff_within_at 𝕜 ∞ f s x ↔ ∀ (n : ℕ), cont_diff_within_at 𝕜 n f s x := -cont_diff_within_at_iff_forall_nat_le.trans $ by simp only [forall_prop_of_true, le_top] - -lemma cont_diff_within_at.continuous_within_at - (h : cont_diff_within_at 𝕜 n f s x) : continuous_within_at f s x := -begin - rcases h 0 bot_le with ⟨u, hu, p, H⟩, - rw [mem_nhds_within_insert] at hu, - exact (H.continuous_on.continuous_within_at hu.1).mono_of_mem hu.2 -end - -lemma cont_diff_within_at.congr_of_eventually_eq - (h : cont_diff_within_at 𝕜 n f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : - cont_diff_within_at 𝕜 n f₁ s x := -λ m hm, let ⟨u, hu, p, H⟩ := h m hm in -⟨{x ∈ u | f₁ x = f x}, filter.inter_mem hu (mem_nhds_within_insert.2 ⟨hx, h₁⟩), p, - (H.mono (sep_subset _ _)).congr (λ _, and.right)⟩ - -lemma cont_diff_within_at.congr_of_eventually_eq' - (h : cont_diff_within_at 𝕜 n f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : x ∈ s) : - cont_diff_within_at 𝕜 n f₁ s x := -h.congr_of_eventually_eq h₁ $ h₁.self_of_nhds_within hx - -lemma filter.eventually_eq.cont_diff_within_at_iff - (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : - cont_diff_within_at 𝕜 n f₁ s x ↔ cont_diff_within_at 𝕜 n f s x := -⟨λ H, cont_diff_within_at.congr_of_eventually_eq H h₁.symm hx.symm, -λ H, H.congr_of_eventually_eq h₁ hx⟩ - -lemma cont_diff_within_at.congr - (h : cont_diff_within_at 𝕜 n f s x) (h₁ : ∀ y ∈ s, f₁ y = f y) (hx : f₁ x = f x) : - cont_diff_within_at 𝕜 n f₁ s x := -h.congr_of_eventually_eq (filter.eventually_eq_of_mem self_mem_nhds_within h₁) hx - -lemma cont_diff_within_at.congr' - (h : cont_diff_within_at 𝕜 n f s x) (h₁ : ∀ y ∈ s, f₁ y = f y) (hx : x ∈ s) : - cont_diff_within_at 𝕜 n f₁ s x := -h.congr h₁ (h₁ _ hx) - -lemma cont_diff_within_at.mono_of_mem - (h : cont_diff_within_at 𝕜 n f s x) {t : set E} (hst : s ∈ 𝓝[t] x) : - cont_diff_within_at 𝕜 n f t x := -begin - assume m hm, - rcases h m hm with ⟨u, hu, p, H⟩, - exact ⟨u, nhds_within_le_of_mem (insert_mem_nhds_within_insert hst) hu, p, H⟩ -end - -lemma cont_diff_within_at.mono - (h : cont_diff_within_at 𝕜 n f s x) {t : set E} (hst : t ⊆ s) : - cont_diff_within_at 𝕜 n f t x := -h.mono_of_mem $ filter.mem_of_superset self_mem_nhds_within hst - -lemma cont_diff_within_at.congr_nhds - (h : cont_diff_within_at 𝕜 n f s x) {t : set E} (hst : 𝓝[s] x = 𝓝[t] x) : - cont_diff_within_at 𝕜 n f t x := -h.mono_of_mem $ hst ▸ self_mem_nhds_within - -lemma cont_diff_within_at_congr_nhds {t : set E} (hst : 𝓝[s] x = 𝓝[t] x) : - cont_diff_within_at 𝕜 n f s x ↔ cont_diff_within_at 𝕜 n f t x := -⟨λ h, h.congr_nhds hst, λ h, h.congr_nhds hst.symm⟩ - -lemma cont_diff_within_at_inter' (h : t ∈ 𝓝[s] x) : - cont_diff_within_at 𝕜 n f (s ∩ t) x ↔ cont_diff_within_at 𝕜 n f s x := -cont_diff_within_at_congr_nhds $ eq.symm $ nhds_within_restrict'' _ h - -lemma cont_diff_within_at_inter (h : t ∈ 𝓝 x) : - cont_diff_within_at 𝕜 n f (s ∩ t) x ↔ cont_diff_within_at 𝕜 n f s x := -cont_diff_within_at_inter' (mem_nhds_within_of_mem_nhds h) - -/-- If a function is `C^n` within a set at a point, with `n ≥ 1`, then it is differentiable -within this set at this point. -/ -lemma cont_diff_within_at.differentiable_within_at' - (h : cont_diff_within_at 𝕜 n f s x) (hn : 1 ≤ n) : - differentiable_within_at 𝕜 f (insert x s) x := -begin - rcases h 1 hn with ⟨u, hu, p, H⟩, - rcases mem_nhds_within.1 hu with ⟨t, t_open, xt, tu⟩, - rw inter_comm at tu, - have := ((H.mono tu).differentiable_on le_rfl) x ⟨mem_insert x s, xt⟩, - exact (differentiable_within_at_inter (is_open.mem_nhds t_open xt)).1 this, -end - -lemma cont_diff_within_at.differentiable_within_at - (h : cont_diff_within_at 𝕜 n f s x) (hn : 1 ≤ n) : - differentiable_within_at 𝕜 f s x := -(h.differentiable_within_at' hn).mono (subset_insert x s) - -/-- A function is `C^(n + 1)` on a domain iff locally, it has a derivative which is `C^n`. -/ -theorem cont_diff_within_at_succ_iff_has_fderiv_within_at {n : ℕ} : - cont_diff_within_at 𝕜 ((n + 1) : ℕ) f s x - ↔ ∃ u ∈ 𝓝[insert x s] x, ∃ f' : E → (E →L[𝕜] F), - (∀ x ∈ u, has_fderiv_within_at f (f' x) u x) ∧ (cont_diff_within_at 𝕜 n f' u x) := -begin - split, - { assume h, - rcases h n.succ le_rfl with ⟨u, hu, p, Hp⟩, - refine ⟨u, hu, λ y, (continuous_multilinear_curry_fin1 𝕜 E F) (p y 1), - λ y hy, Hp.has_fderiv_within_at (with_top.coe_le_coe.2 (nat.le_add_left 1 n)) hy, _⟩, - assume m hm, - refine ⟨u, _, λ (y : E), (p y).shift, _⟩, - { convert self_mem_nhds_within, - have : x ∈ insert x s, by simp, - exact (insert_eq_of_mem (mem_of_mem_nhds_within this hu)) }, - { rw has_ftaylor_series_up_to_on_succ_iff_right at Hp, - exact Hp.2.2.of_le hm } }, - { rintros ⟨u, hu, f', f'_eq_deriv, Hf'⟩, - rw cont_diff_within_at_nat, - rcases Hf' n le_rfl with ⟨v, hv, p', Hp'⟩, - refine ⟨v ∩ u, _, λ x, (p' x).unshift (f x), _⟩, - { apply filter.inter_mem _ hu, - apply nhds_within_le_of_mem hu, - exact nhds_within_mono _ (subset_insert x u) hv }, - { rw has_ftaylor_series_up_to_on_succ_iff_right, - refine ⟨λ y hy, rfl, λ y hy, _, _⟩, - { change has_fderiv_within_at (λ z, (continuous_multilinear_curry_fin0 𝕜 E F).symm (f z)) - ((formal_multilinear_series.unshift (p' y) (f y) 1).curry_left) (v ∩ u) y, - rw linear_isometry_equiv.comp_has_fderiv_within_at_iff', - convert (f'_eq_deriv y hy.2).mono (inter_subset_right v u), - rw ← Hp'.zero_eq y hy.1, - ext z, - change ((p' y 0) (init (@cons 0 (λ i, E) z 0))) (@cons 0 (λ i, E) z 0 (last 0)) - = ((p' y 0) 0) z, - unfold_coes, - congr }, - { convert (Hp'.mono (inter_subset_left v u)).congr (λ x hx, Hp'.zero_eq x hx.1), - { ext x y, - change p' x 0 (init (@snoc 0 (λ i : fin 1, E) 0 y)) y = p' x 0 0 y, - rw init_snoc }, - { ext x k v y, - change p' x k (init (@snoc k (λ i : fin k.succ, E) v y)) - (@snoc k (λ i : fin k.succ, E) v y (last k)) = p' x k v y, - rw [snoc_last, init_snoc] } } } } -end - -/-! ### Smooth functions within a set -/ - -variable (𝕜) - -/-- A function is continuously differentiable up to `n` on `s` if, for any point `x` in `s`, it -admits continuous derivatives up to order `n` on a neighborhood of `x` in `s`. - -For `n = ∞`, we only require that this holds up to any finite order (where the neighborhood may -depend on the finite order we consider). --/ -definition cont_diff_on (n : with_top ℕ) (f : E → F) (s : set E) := -∀ x ∈ s, cont_diff_within_at 𝕜 n f s x - -variable {𝕜} - -lemma cont_diff_on.cont_diff_within_at (h : cont_diff_on 𝕜 n f s) (hx : x ∈ s) : - cont_diff_within_at 𝕜 n f s x := -h x hx - -lemma cont_diff_within_at.cont_diff_on {m : ℕ} - (hm : (m : with_top ℕ) ≤ n) (h : cont_diff_within_at 𝕜 n f s x) : - ∃ u ∈ 𝓝[insert x s] x, u ⊆ insert x s ∧ cont_diff_on 𝕜 m f u := -begin - rcases h m hm with ⟨u, u_nhd, p, hp⟩, - refine ⟨u ∩ insert x s, filter.inter_mem u_nhd self_mem_nhds_within, - inter_subset_right _ _, _⟩, - assume y hy m' hm', - refine ⟨u ∩ insert x s, _, p, (hp.mono (inter_subset_left _ _)).of_le hm'⟩, - convert self_mem_nhds_within, - exact insert_eq_of_mem hy -end - -protected lemma cont_diff_within_at.eventually {n : ℕ} - (h : cont_diff_within_at 𝕜 n f s x) : - ∀ᶠ y in 𝓝[insert x s] x, cont_diff_within_at 𝕜 n f s y := -begin - rcases h.cont_diff_on le_rfl with ⟨u, hu, hu_sub, hd⟩, - have : ∀ᶠ (y : E) in 𝓝[insert x s] x, u ∈ 𝓝[insert x s] y ∧ y ∈ u, - from (eventually_nhds_within_nhds_within.2 hu).and hu, - refine this.mono (λ y hy, (hd y hy.2).mono_of_mem _), - exact nhds_within_mono y (subset_insert _ _) hy.1 -end - -lemma cont_diff_on.of_le (h : cont_diff_on 𝕜 n f s) (hmn : m ≤ n) : - cont_diff_on 𝕜 m f s := -λ x hx, (h x hx).of_le hmn - -lemma cont_diff_on_iff_forall_nat_le : - cont_diff_on 𝕜 n f s ↔ ∀ m : ℕ, ↑m ≤ n → cont_diff_on 𝕜 m f s := -⟨λ H m hm, H.of_le hm, λ H x hx m hm, H m hm x hx m le_rfl⟩ - -lemma cont_diff_on_top : - cont_diff_on 𝕜 ∞ f s ↔ ∀ (n : ℕ), cont_diff_on 𝕜 n f s := -cont_diff_on_iff_forall_nat_le.trans $ by simp only [le_top, forall_prop_of_true] - -lemma cont_diff_on_all_iff_nat : - (∀ n, cont_diff_on 𝕜 n f s) ↔ (∀ n : ℕ, cont_diff_on 𝕜 n f s) := -begin - refine ⟨λ H n, H n, _⟩, - rintro H (_|n), - exacts [cont_diff_on_top.2 H, H n] -end - -lemma cont_diff_on.continuous_on - (h : cont_diff_on 𝕜 n f s) : continuous_on f s := -λ x hx, (h x hx).continuous_within_at - -lemma cont_diff_on.congr - (h : cont_diff_on 𝕜 n f s) (h₁ : ∀ x ∈ s, f₁ x = f x) : - cont_diff_on 𝕜 n f₁ s := -λ x hx, (h x hx).congr h₁ (h₁ x hx) - -lemma cont_diff_on_congr (h₁ : ∀ x ∈ s, f₁ x = f x) : - cont_diff_on 𝕜 n f₁ s ↔ cont_diff_on 𝕜 n f s := -⟨λ H, H.congr (λ x hx, (h₁ x hx).symm), λ H, H.congr h₁⟩ - -lemma cont_diff_on.mono - (h : cont_diff_on 𝕜 n f s) {t : set E} (hst : t ⊆ s) : - cont_diff_on 𝕜 n f t := -λ x hx, (h x (hst hx)).mono hst - -lemma cont_diff_on.congr_mono - (hf : cont_diff_on 𝕜 n f s) (h₁ : ∀ x ∈ s₁, f₁ x = f x) (hs : s₁ ⊆ s) : - cont_diff_on 𝕜 n f₁ s₁ := -(hf.mono hs).congr h₁ - -/-- If a function is `C^n` on a set with `n ≥ 1`, then it is differentiable there. -/ -lemma cont_diff_on.differentiable_on - (h : cont_diff_on 𝕜 n f s) (hn : 1 ≤ n) : differentiable_on 𝕜 f s := -λ x hx, (h x hx).differentiable_within_at hn - -/-- If a function is `C^n` around each point in a set, then it is `C^n` on the set. -/ -lemma cont_diff_on_of_locally_cont_diff_on - (h : ∀ x ∈ s, ∃u, is_open u ∧ x ∈ u ∧ cont_diff_on 𝕜 n f (s ∩ u)) : - cont_diff_on 𝕜 n f s := -begin - assume x xs, - rcases h x xs with ⟨u, u_open, xu, hu⟩, - apply (cont_diff_within_at_inter _).1 (hu x ⟨xs, xu⟩), - exact is_open.mem_nhds u_open xu -end - -/-- A function is `C^(n + 1)` on a domain iff locally, it has a derivative which is `C^n`. -/ -theorem cont_diff_on_succ_iff_has_fderiv_within_at {n : ℕ} : - cont_diff_on 𝕜 ((n + 1) : ℕ) f s - ↔ ∀ x ∈ s, ∃ u ∈ 𝓝[insert x s] x, ∃ f' : E → (E →L[𝕜] F), - (∀ x ∈ u, has_fderiv_within_at f (f' x) u x) ∧ (cont_diff_on 𝕜 n f' u) := -begin - split, - { assume h x hx, - rcases (h x hx) n.succ le_rfl with ⟨u, hu, p, Hp⟩, - refine ⟨u, hu, λ y, (continuous_multilinear_curry_fin1 𝕜 E F) (p y 1), - λ y hy, Hp.has_fderiv_within_at (with_top.coe_le_coe.2 (nat.le_add_left 1 n)) hy, _⟩, - rw has_ftaylor_series_up_to_on_succ_iff_right at Hp, - assume z hz m hm, - refine ⟨u, _, λ (x : E), (p x).shift, Hp.2.2.of_le hm⟩, - convert self_mem_nhds_within, - exact insert_eq_of_mem hz, }, - { assume h x hx, - rw cont_diff_within_at_succ_iff_has_fderiv_within_at, - rcases h x hx with ⟨u, u_nhbd, f', hu, hf'⟩, - have : x ∈ u := mem_of_mem_nhds_within (mem_insert _ _) u_nhbd, - exact ⟨u, u_nhbd, f', hu, hf' x this⟩ } -end - -/-! ### Iterated derivative within a set -/ -variable (𝕜) - -/-- -The `n`-th derivative of a function along a set, defined inductively by saying that the `n+1`-th -derivative of `f` is the derivative of the `n`-th derivative of `f` along this set, together with -an uncurrying step to see it as a multilinear map in `n+1` variables.. --/ -noncomputable def iterated_fderiv_within (n : ℕ) (f : E → F) (s : set E) : - E → (E [×n]→L[𝕜] F) := -nat.rec_on n - (λ x, continuous_multilinear_map.curry0 𝕜 E (f x)) - (λ n rec x, continuous_linear_map.uncurry_left (fderiv_within 𝕜 rec s x)) - -/-- Formal Taylor series associated to a function within a set. -/ -def ftaylor_series_within (f : E → F) (s : set E) (x : E) : formal_multilinear_series 𝕜 E F := -λ n, iterated_fderiv_within 𝕜 n f s x - -variable {𝕜} - -@[simp] lemma iterated_fderiv_within_zero_apply (m : (fin 0) → E) : - (iterated_fderiv_within 𝕜 0 f s x : ((fin 0) → E) → F) m = f x := rfl - -lemma iterated_fderiv_within_zero_eq_comp : - iterated_fderiv_within 𝕜 0 f s = (continuous_multilinear_curry_fin0 𝕜 E F).symm ∘ f := rfl - -lemma iterated_fderiv_within_succ_apply_left {n : ℕ} (m : fin (n + 1) → E): - (iterated_fderiv_within 𝕜 (n + 1) f s x : (fin (n + 1) → E) → F) m - = (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n f s) s x : E → (E [×n]→L[𝕜] F)) - (m 0) (tail m) := rfl - -/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, -and the derivative of the `n`-th derivative. -/ -lemma iterated_fderiv_within_succ_eq_comp_left {n : ℕ} : - iterated_fderiv_within 𝕜 (n + 1) f s = - (continuous_multilinear_curry_left_equiv 𝕜 (λ(i : fin (n + 1)), E) F) - ∘ (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n f s) s) := rfl - -theorem iterated_fderiv_within_succ_apply_right {n : ℕ} - (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) (m : fin (n + 1) → E) : - (iterated_fderiv_within 𝕜 (n + 1) f s x : (fin (n + 1) → E) → F) m - = iterated_fderiv_within 𝕜 n (λy, fderiv_within 𝕜 f s y) s x (init m) (m (last n)) := -begin - induction n with n IH generalizing x, - { rw [iterated_fderiv_within_succ_eq_comp_left, iterated_fderiv_within_zero_eq_comp, - iterated_fderiv_within_zero_apply, - function.comp_apply, linear_isometry_equiv.comp_fderiv_within _ (hs x hx)], - refl }, - { let I := continuous_multilinear_curry_right_equiv' 𝕜 n E F, - have A : ∀ y ∈ s, iterated_fderiv_within 𝕜 n.succ f s y - = (I ∘ (iterated_fderiv_within 𝕜 n (λy, fderiv_within 𝕜 f s y) s)) y, - by { assume y hy, ext m, rw @IH m y hy, refl }, - calc - (iterated_fderiv_within 𝕜 (n+2) f s x : (fin (n+2) → E) → F) m = - (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n.succ f s) s x - : E → (E [×(n + 1)]→L[𝕜] F)) (m 0) (tail m) : rfl - ... = (fderiv_within 𝕜 (I ∘ (iterated_fderiv_within 𝕜 n (fderiv_within 𝕜 f s) s)) s x - : E → (E [×(n + 1)]→L[𝕜] F)) (m 0) (tail m) : - by rw fderiv_within_congr (hs x hx) A (A x hx) - ... = (I ∘ fderiv_within 𝕜 ((iterated_fderiv_within 𝕜 n (fderiv_within 𝕜 f s) s)) s x - : E → (E [×(n + 1)]→L[𝕜] F)) (m 0) (tail m) : - by { rw linear_isometry_equiv.comp_fderiv_within _ (hs x hx), refl } - ... = (fderiv_within 𝕜 ((iterated_fderiv_within 𝕜 n (λ y, fderiv_within 𝕜 f s y) s)) s x - : E → (E [×n]→L[𝕜] (E →L[𝕜] F))) (m 0) (init (tail m)) ((tail m) (last n)) : rfl - ... = iterated_fderiv_within 𝕜 (nat.succ n) (λ y, fderiv_within 𝕜 f s y) s x - (init m) (m (last (n + 1))) : - by { rw [iterated_fderiv_within_succ_apply_left, tail_init_eq_init_tail], refl } } -end - -/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, -and the `n`-th derivative of the derivative. -/ -lemma iterated_fderiv_within_succ_eq_comp_right {n : ℕ} (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : - iterated_fderiv_within 𝕜 (n + 1) f s x = - ((continuous_multilinear_curry_right_equiv' 𝕜 n E F) - ∘ (iterated_fderiv_within 𝕜 n (λy, fderiv_within 𝕜 f s y) s)) x := -by { ext m, rw iterated_fderiv_within_succ_apply_right hs hx, refl } - -@[simp] lemma iterated_fderiv_within_one_apply - (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) (m : (fin 1) → E) : - (iterated_fderiv_within 𝕜 1 f s x : ((fin 1) → E) → F) m - = (fderiv_within 𝕜 f s x : E → F) (m 0) := -by { rw [iterated_fderiv_within_succ_apply_right hs hx, iterated_fderiv_within_zero_apply], refl } - -/-- If two functions coincide on a set `s` of unique differentiability, then their iterated -differentials within this set coincide. -/ -lemma iterated_fderiv_within_congr {n : ℕ} - (hs : unique_diff_on 𝕜 s) (hL : ∀y∈s, f₁ y = f y) (hx : x ∈ s) : - iterated_fderiv_within 𝕜 n f₁ s x = iterated_fderiv_within 𝕜 n f s x := -begin - induction n with n IH generalizing x, - { ext m, simp [hL x hx] }, - { have : fderiv_within 𝕜 (λ y, iterated_fderiv_within 𝕜 n f₁ s y) s x - = fderiv_within 𝕜 (λ y, iterated_fderiv_within 𝕜 n f s y) s x := - fderiv_within_congr (hs x hx) (λ y hy, IH hy) (IH hx), - ext m, - rw [iterated_fderiv_within_succ_apply_left, iterated_fderiv_within_succ_apply_left, this] } -end - -/-- The iterated differential within a set `s` at a point `x` is not modified if one intersects -`s` with an open set containing `x`. -/ -lemma iterated_fderiv_within_inter_open {n : ℕ} (hu : is_open u) - (hs : unique_diff_on 𝕜 (s ∩ u)) (hx : x ∈ s ∩ u) : - iterated_fderiv_within 𝕜 n f (s ∩ u) x = iterated_fderiv_within 𝕜 n f s x := -begin - induction n with n IH generalizing x, - { ext m, simp }, - { have A : fderiv_within 𝕜 (λ y, iterated_fderiv_within 𝕜 n f (s ∩ u) y) (s ∩ u) x - = fderiv_within 𝕜 (λ y, iterated_fderiv_within 𝕜 n f s y) (s ∩ u) x := - fderiv_within_congr (hs x hx) (λ y hy, IH hy) (IH hx), - have B : fderiv_within 𝕜 (λ y, iterated_fderiv_within 𝕜 n f s y) (s ∩ u) x - = fderiv_within 𝕜 (λ y, iterated_fderiv_within 𝕜 n f s y) s x := - fderiv_within_inter (is_open.mem_nhds hu hx.2) - ((unique_diff_within_at_inter (is_open.mem_nhds hu hx.2)).1 (hs x hx)), - ext m, - rw [iterated_fderiv_within_succ_apply_left, iterated_fderiv_within_succ_apply_left, A, B] } -end - -/-- The iterated differential within a set `s` at a point `x` is not modified if one intersects -`s` with a neighborhood of `x` within `s`. -/ -lemma iterated_fderiv_within_inter' {n : ℕ} - (hu : u ∈ 𝓝[s] x) (hs : unique_diff_on 𝕜 s) (xs : x ∈ s) : - iterated_fderiv_within 𝕜 n f (s ∩ u) x = iterated_fderiv_within 𝕜 n f s x := -begin - obtain ⟨v, v_open, xv, vu⟩ : ∃ v, is_open v ∧ x ∈ v ∧ v ∩ s ⊆ u := mem_nhds_within.1 hu, - have A : (s ∩ u) ∩ v = s ∩ v, - { apply subset.antisymm (inter_subset_inter (inter_subset_left _ _) (subset.refl _)), - exact λ y ⟨ys, yv⟩, ⟨⟨ys, vu ⟨yv, ys⟩⟩, yv⟩ }, - have : iterated_fderiv_within 𝕜 n f (s ∩ v) x = iterated_fderiv_within 𝕜 n f s x := - iterated_fderiv_within_inter_open v_open (hs.inter v_open) ⟨xs, xv⟩, - rw ← this, - have : iterated_fderiv_within 𝕜 n f ((s ∩ u) ∩ v) x = iterated_fderiv_within 𝕜 n f (s ∩ u) x, - { refine iterated_fderiv_within_inter_open v_open _ ⟨⟨xs, vu ⟨xv, xs⟩⟩, xv⟩, - rw A, - exact hs.inter v_open }, - rw A at this, - rw ← this -end - -/-- The iterated differential within a set `s` at a point `x` is not modified if one intersects -`s` with a neighborhood of `x`. -/ -lemma iterated_fderiv_within_inter {n : ℕ} - (hu : u ∈ 𝓝 x) (hs : unique_diff_on 𝕜 s) (xs : x ∈ s) : - iterated_fderiv_within 𝕜 n f (s ∩ u) x = iterated_fderiv_within 𝕜 n f s x := -iterated_fderiv_within_inter' (mem_nhds_within_of_mem_nhds hu) hs xs - -@[simp] lemma cont_diff_on_zero : - cont_diff_on 𝕜 0 f s ↔ continuous_on f s := -begin - refine ⟨λ H, H.continuous_on, λ H, _⟩, - assume x hx m hm, - have : (m : with_top ℕ) = 0 := le_antisymm hm bot_le, - rw this, - refine ⟨insert x s, self_mem_nhds_within, ftaylor_series_within 𝕜 f s, _⟩, - rw has_ftaylor_series_up_to_on_zero_iff, - exact ⟨by rwa insert_eq_of_mem hx, λ x hx, by simp [ftaylor_series_within]⟩ -end - -lemma cont_diff_within_at_zero (hx : x ∈ s) : - cont_diff_within_at 𝕜 0 f s x ↔ ∃ u ∈ 𝓝[s] x, continuous_on f (s ∩ u) := -begin - split, - { intros h, - obtain ⟨u, H, p, hp⟩ := h 0 (by norm_num), - refine ⟨u, _, _⟩, - { simpa [hx] using H }, - { simp only [with_top.coe_zero, has_ftaylor_series_up_to_on_zero_iff] at hp, - exact hp.1.mono (inter_subset_right s u) } }, - { rintros ⟨u, H, hu⟩, - rw ← cont_diff_within_at_inter' H, - have h' : x ∈ s ∩ u := ⟨hx, mem_of_mem_nhds_within hx H⟩, - exact (cont_diff_on_zero.mpr hu).cont_diff_within_at h' } -end - -/-- On a set with unique differentiability, any choice of iterated differential has to coincide -with the one we have chosen in `iterated_fderiv_within 𝕜 m f s`. -/ -theorem has_ftaylor_series_up_to_on.eq_ftaylor_series_of_unique_diff_on - (h : has_ftaylor_series_up_to_on n f p s) - {m : ℕ} (hmn : (m : with_top ℕ) ≤ n) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : - p x m = iterated_fderiv_within 𝕜 m f s x := -begin - induction m with m IH generalizing x, - { rw [h.zero_eq' hx, iterated_fderiv_within_zero_eq_comp] }, - { have A : (m : with_top ℕ) < n := lt_of_lt_of_le (with_top.coe_lt_coe.2 (lt_add_one m)) hmn, - have : has_fderiv_within_at (λ (y : E), iterated_fderiv_within 𝕜 m f s y) - (continuous_multilinear_map.curry_left (p x (nat.succ m))) s x := - (h.fderiv_within m A x hx).congr (λ y hy, (IH (le_of_lt A) hy).symm) (IH (le_of_lt A) hx).symm, - rw [iterated_fderiv_within_succ_eq_comp_left, function.comp_apply, - this.fderiv_within (hs x hx)], - exact (continuous_multilinear_map.uncurry_curry_left _).symm } -end - -/-- When a function is `C^n` in a set `s` of unique differentiability, it admits -`ftaylor_series_within 𝕜 f s` as a Taylor series up to order `n` in `s`. -/ -theorem cont_diff_on.ftaylor_series_within - (h : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) : - has_ftaylor_series_up_to_on n f (ftaylor_series_within 𝕜 f s) s := -begin - split, - { assume x hx, - simp only [ftaylor_series_within, continuous_multilinear_map.uncurry0_apply, - iterated_fderiv_within_zero_apply] }, - { assume m hm x hx, - rcases (h x hx) m.succ (with_top.add_one_le_of_lt hm) with ⟨u, hu, p, Hp⟩, - rw insert_eq_of_mem hx at hu, - rcases mem_nhds_within.1 hu with ⟨o, o_open, xo, ho⟩, - rw inter_comm at ho, - have : p x m.succ = ftaylor_series_within 𝕜 f s x m.succ, - { change p x m.succ = iterated_fderiv_within 𝕜 m.succ f s x, - rw ← iterated_fderiv_within_inter (is_open.mem_nhds o_open xo) hs hx, - exact (Hp.mono ho).eq_ftaylor_series_of_unique_diff_on le_rfl - (hs.inter o_open) ⟨hx, xo⟩ }, - rw [← this, ← has_fderiv_within_at_inter (is_open.mem_nhds o_open xo)], - have A : ∀ y ∈ s ∩ o, p y m = ftaylor_series_within 𝕜 f s y m, - { rintros y ⟨hy, yo⟩, - change p y m = iterated_fderiv_within 𝕜 m f s y, - rw ← iterated_fderiv_within_inter (is_open.mem_nhds o_open yo) hs hy, - exact (Hp.mono ho).eq_ftaylor_series_of_unique_diff_on (with_top.coe_le_coe.2 (nat.le_succ m)) - (hs.inter o_open) ⟨hy, yo⟩ }, - exact ((Hp.mono ho).fderiv_within m (with_top.coe_lt_coe.2 (lt_add_one m)) x ⟨hx, xo⟩).congr - (λ y hy, (A y hy).symm) (A x ⟨hx, xo⟩).symm }, - { assume m hm, - apply continuous_on_of_locally_continuous_on, - assume x hx, - rcases h x hx m hm with ⟨u, hu, p, Hp⟩, - rcases mem_nhds_within.1 hu with ⟨o, o_open, xo, ho⟩, - rw insert_eq_of_mem hx at ho, - rw inter_comm at ho, - refine ⟨o, o_open, xo, _⟩, - have A : ∀ y ∈ s ∩ o, p y m = ftaylor_series_within 𝕜 f s y m, - { rintros y ⟨hy, yo⟩, - change p y m = iterated_fderiv_within 𝕜 m f s y, - rw ← iterated_fderiv_within_inter (is_open.mem_nhds o_open yo) hs hy, - exact (Hp.mono ho).eq_ftaylor_series_of_unique_diff_on le_rfl - (hs.inter o_open) ⟨hy, yo⟩ }, - exact ((Hp.mono ho).cont m le_rfl).congr (λ y hy, (A y hy).symm) } -end - -lemma cont_diff_on_of_continuous_on_differentiable_on - (Hcont : ∀ (m : ℕ), (m : with_top ℕ) ≤ n → - continuous_on (λ x, iterated_fderiv_within 𝕜 m f s x) s) - (Hdiff : ∀ (m : ℕ), (m : with_top ℕ) < n → - differentiable_on 𝕜 (λ x, iterated_fderiv_within 𝕜 m f s x) s) : - cont_diff_on 𝕜 n f s := -begin - assume x hx m hm, - rw insert_eq_of_mem hx, - refine ⟨s, self_mem_nhds_within, ftaylor_series_within 𝕜 f s, _⟩, - split, - { assume y hy, - simp only [ftaylor_series_within, continuous_multilinear_map.uncurry0_apply, - iterated_fderiv_within_zero_apply] }, - { assume k hk y hy, - convert (Hdiff k (lt_of_lt_of_le hk hm) y hy).has_fderiv_within_at, - simp only [ftaylor_series_within, iterated_fderiv_within_succ_eq_comp_left, - continuous_linear_equiv.coe_apply, function.comp_app, coe_fn_coe_base], - exact continuous_linear_map.curry_uncurry_left _ }, - { assume k hk, - exact Hcont k (le_trans hk hm) } -end - -lemma cont_diff_on_of_differentiable_on - (h : ∀(m : ℕ), (m : with_top ℕ) ≤ n → differentiable_on 𝕜 (iterated_fderiv_within 𝕜 m f s) s) : - cont_diff_on 𝕜 n f s := -cont_diff_on_of_continuous_on_differentiable_on - (λ m hm, (h m hm).continuous_on) (λ m hm, (h m (le_of_lt hm))) - -lemma cont_diff_on.continuous_on_iterated_fderiv_within {m : ℕ} - (h : cont_diff_on 𝕜 n f s) (hmn : (m : with_top ℕ) ≤ n) (hs : unique_diff_on 𝕜 s) : - continuous_on (iterated_fderiv_within 𝕜 m f s) s := -(h.ftaylor_series_within hs).cont m hmn - -lemma cont_diff_on.differentiable_on_iterated_fderiv_within {m : ℕ} - (h : cont_diff_on 𝕜 n f s) (hmn : (m : with_top ℕ) < n) (hs : unique_diff_on 𝕜 s) : - differentiable_on 𝕜 (iterated_fderiv_within 𝕜 m f s) s := -λ x hx, ((h.ftaylor_series_within hs).fderiv_within m hmn x hx).differentiable_within_at - -lemma cont_diff_on_iff_continuous_on_differentiable_on - (hs : unique_diff_on 𝕜 s) : - cont_diff_on 𝕜 n f s ↔ - (∀ (m : ℕ), (m : with_top ℕ) ≤ n → - continuous_on (λ x, iterated_fderiv_within 𝕜 m f s x) s) - ∧ (∀ (m : ℕ), (m : with_top ℕ) < n → - differentiable_on 𝕜 (λ x, iterated_fderiv_within 𝕜 m f s x) s) := -begin - split, - { assume h, - split, - { assume m hm, exact h.continuous_on_iterated_fderiv_within hm hs }, - { assume m hm, exact h.differentiable_on_iterated_fderiv_within hm hs } }, - { assume h, - exact cont_diff_on_of_continuous_on_differentiable_on h.1 h.2 } -end - -lemma cont_diff_on_succ_of_fderiv_within {n : ℕ} (hf : differentiable_on 𝕜 f s) - (h : cont_diff_on 𝕜 n (λ y, fderiv_within 𝕜 f s y) s) : - cont_diff_on 𝕜 ((n + 1) : ℕ) f s := -begin - intros x hx, - rw [cont_diff_within_at_succ_iff_has_fderiv_within_at, insert_eq_of_mem hx], - exact ⟨s, self_mem_nhds_within, fderiv_within 𝕜 f s, - λ y hy, (hf y hy).has_fderiv_within_at, h x hx⟩ -end - -/-- A function is `C^(n + 1)` on a domain with unique derivatives if and only if it is -differentiable there, and its derivative (expressed with `fderiv_within`) is `C^n`. -/ -theorem cont_diff_on_succ_iff_fderiv_within {n : ℕ} (hs : unique_diff_on 𝕜 s) : - cont_diff_on 𝕜 ((n + 1) : ℕ) f s ↔ - differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 n (λ y, fderiv_within 𝕜 f s y) s := -begin - refine ⟨λ H, _, λ h, cont_diff_on_succ_of_fderiv_within h.1 h.2⟩, - refine ⟨H.differentiable_on (with_top.coe_le_coe.2 (nat.le_add_left 1 n)), λ x hx, _⟩, - rcases cont_diff_within_at_succ_iff_has_fderiv_within_at.1 (H x hx) - with ⟨u, hu, f', hff', hf'⟩, - rcases mem_nhds_within.1 hu with ⟨o, o_open, xo, ho⟩, - rw [inter_comm, insert_eq_of_mem hx] at ho, - have := hf'.mono ho, - rw cont_diff_within_at_inter' (mem_nhds_within_of_mem_nhds (is_open.mem_nhds o_open xo)) - at this, - apply this.congr_of_eventually_eq' _ hx, - have : o ∩ s ∈ 𝓝[s] x := mem_nhds_within.2 ⟨o, o_open, xo, subset.refl _⟩, - rw inter_comm at this, - apply filter.eventually_eq_of_mem this (λ y hy, _), - have A : fderiv_within 𝕜 f (s ∩ o) y = f' y := - ((hff' y (ho hy)).mono ho).fderiv_within (hs.inter o_open y hy), - rwa fderiv_within_inter (is_open.mem_nhds o_open hy.2) (hs y hy.1) at A -end - -/-- A function is `C^(n + 1)` on an open domain if and only if it is -differentiable there, and its derivative (expressed with `fderiv`) is `C^n`. -/ -theorem cont_diff_on_succ_iff_fderiv_of_open {n : ℕ} (hs : is_open s) : - cont_diff_on 𝕜 ((n + 1) : ℕ) f s ↔ - differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 n (λ y, fderiv 𝕜 f y) s := -begin - rw cont_diff_on_succ_iff_fderiv_within hs.unique_diff_on, - congr' 2, - rw ← iff_iff_eq, - apply cont_diff_on_congr, - assume x hx, - exact fderiv_within_of_open hs hx -end - -/-- A function is `C^∞` on a domain with unique derivatives if and only if it is differentiable -there, and its derivative (expressed with `fderiv_within`) is `C^∞`. -/ -theorem cont_diff_on_top_iff_fderiv_within (hs : unique_diff_on 𝕜 s) : - cont_diff_on 𝕜 ∞ f s ↔ - differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 ∞ (λ y, fderiv_within 𝕜 f s y) s := -begin - split, - { assume h, - refine ⟨h.differentiable_on le_top, _⟩, - apply cont_diff_on_top.2 (λ n, ((cont_diff_on_succ_iff_fderiv_within hs).1 _).2), - exact h.of_le le_top }, - { assume h, - refine cont_diff_on_top.2 (λ n, _), - have A : (n : with_top ℕ) ≤ ∞ := le_top, - apply ((cont_diff_on_succ_iff_fderiv_within hs).2 ⟨h.1, h.2.of_le A⟩).of_le, - exact with_top.coe_le_coe.2 (nat.le_succ n) } -end - -/-- A function is `C^∞` on an open domain if and only if it is differentiable there, and its -derivative (expressed with `fderiv`) is `C^∞`. -/ -theorem cont_diff_on_top_iff_fderiv_of_open (hs : is_open s) : - cont_diff_on 𝕜 ∞ f s ↔ - differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 ∞ (λ y, fderiv 𝕜 f y) s := -begin - rw cont_diff_on_top_iff_fderiv_within hs.unique_diff_on, - congr' 2, - rw ← iff_iff_eq, - apply cont_diff_on_congr, - assume x hx, - exact fderiv_within_of_open hs hx -end - -lemma cont_diff_on.fderiv_within - (hf : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hmn : m + 1 ≤ n) : - cont_diff_on 𝕜 m (λ y, fderiv_within 𝕜 f s y) s := -begin - cases m, - { change ∞ + 1 ≤ n at hmn, - have : n = ∞, by simpa using hmn, - rw this at hf, - exact ((cont_diff_on_top_iff_fderiv_within hs).1 hf).2 }, - { change (m.succ : with_top ℕ) ≤ n at hmn, - exact ((cont_diff_on_succ_iff_fderiv_within hs).1 (hf.of_le hmn)).2 } -end - -lemma cont_diff_on.fderiv_of_open - (hf : cont_diff_on 𝕜 n f s) (hs : is_open s) (hmn : m + 1 ≤ n) : - cont_diff_on 𝕜 m (λ y, fderiv 𝕜 f y) s := -(hf.fderiv_within hs.unique_diff_on hmn).congr (λ x hx, (fderiv_within_of_open hs hx).symm) - -lemma cont_diff_on.continuous_on_fderiv_within - (h : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hn : 1 ≤ n) : - continuous_on (λ x, fderiv_within 𝕜 f s x) s := -((cont_diff_on_succ_iff_fderiv_within hs).1 (h.of_le hn)).2.continuous_on - -lemma cont_diff_on.continuous_on_fderiv_of_open - (h : cont_diff_on 𝕜 n f s) (hs : is_open s) (hn : 1 ≤ n) : - continuous_on (λ x, fderiv 𝕜 f x) s := -((cont_diff_on_succ_iff_fderiv_of_open hs).1 (h.of_le hn)).2.continuous_on - -/-- If a function is at least `C^1`, its bundled derivative (mapping `(x, v)` to `Df(x) v`) is -continuous. -/ -lemma cont_diff_on.continuous_on_fderiv_within_apply - (h : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hn : 1 ≤ n) : - continuous_on (λp : E × E, (fderiv_within 𝕜 f s p.1 : E → F) p.2) (s ×ˢ (univ : set E)) := -begin - have A : continuous (λq : (E →L[𝕜] F) × E, q.1 q.2) := is_bounded_bilinear_map_apply.continuous, - have B : continuous_on (λp : E × E, (fderiv_within 𝕜 f s p.1, p.2)) (s ×ˢ (univ : set E)), - { apply continuous_on.prod _ continuous_snd.continuous_on, - exact continuous_on.comp (h.continuous_on_fderiv_within hs hn) continuous_fst.continuous_on - (prod_subset_preimage_fst _ _) }, - exact A.comp_continuous_on B -end - -/-! ### Functions with a Taylor series on the whole space -/ - -/-- `has_ftaylor_series_up_to n f p` registers the fact that `p 0 = f` and `p (m+1)` is a -derivative of `p m` for `m < n`, and is continuous for `m ≤ n`. This is a predicate analogous to -`has_fderiv_at` but for higher order derivatives. -/ -structure has_ftaylor_series_up_to (n : with_top ℕ) - (f : E → F) (p : E → formal_multilinear_series 𝕜 E F) : Prop := -(zero_eq : ∀ x, (p x 0).uncurry0 = f x) -(fderiv : ∀ (m : ℕ) (hm : (m : with_top ℕ) < n), ∀ x, - has_fderiv_at (λ y, p y m) (p x m.succ).curry_left x) -(cont : ∀ (m : ℕ) (hm : (m : with_top ℕ) ≤ n), continuous (λ x, p x m)) - -lemma has_ftaylor_series_up_to.zero_eq' - (h : has_ftaylor_series_up_to n f p) (x : E) : - p x 0 = (continuous_multilinear_curry_fin0 𝕜 E F).symm (f x) := -by { rw ← h.zero_eq x, symmetry, exact continuous_multilinear_map.uncurry0_curry0 _ } - -lemma has_ftaylor_series_up_to_on_univ_iff : - has_ftaylor_series_up_to_on n f p univ ↔ has_ftaylor_series_up_to n f p := -begin - split, - { assume H, - split, - { exact λ x, H.zero_eq x (mem_univ x) }, - { assume m hm x, - rw ← has_fderiv_within_at_univ, - exact H.fderiv_within m hm x (mem_univ x) }, - { assume m hm, - rw continuous_iff_continuous_on_univ, - exact H.cont m hm } }, - { assume H, - split, - { exact λ x hx, H.zero_eq x }, - { assume m hm x hx, - rw has_fderiv_within_at_univ, - exact H.fderiv m hm x }, - { assume m hm, - rw ← continuous_iff_continuous_on_univ, - exact H.cont m hm } } -end - -lemma has_ftaylor_series_up_to.has_ftaylor_series_up_to_on - (h : has_ftaylor_series_up_to n f p) (s : set E) : - has_ftaylor_series_up_to_on n f p s := -(has_ftaylor_series_up_to_on_univ_iff.2 h).mono (subset_univ _) - -lemma has_ftaylor_series_up_to.of_le - (h : has_ftaylor_series_up_to n f p) (hmn : m ≤ n) : - has_ftaylor_series_up_to m f p := -by { rw ← has_ftaylor_series_up_to_on_univ_iff at h ⊢, exact h.of_le hmn } - -lemma has_ftaylor_series_up_to.continuous - (h : has_ftaylor_series_up_to n f p) : continuous f := -begin - rw ← has_ftaylor_series_up_to_on_univ_iff at h, - rw continuous_iff_continuous_on_univ, - exact h.continuous_on -end - -lemma has_ftaylor_series_up_to_zero_iff : - has_ftaylor_series_up_to 0 f p ↔ continuous f ∧ (∀ x, (p x 0).uncurry0 = f x) := -by simp [has_ftaylor_series_up_to_on_univ_iff.symm, continuous_iff_continuous_on_univ, - has_ftaylor_series_up_to_on_zero_iff] - -/-- If a function has a Taylor series at order at least `1`, then the term of order `1` of this -series is a derivative of `f`. -/ -lemma has_ftaylor_series_up_to.has_fderiv_at - (h : has_ftaylor_series_up_to n f p) (hn : 1 ≤ n) (x : E) : - has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) x := -begin - rw [← has_fderiv_within_at_univ], - exact (has_ftaylor_series_up_to_on_univ_iff.2 h).has_fderiv_within_at hn (mem_univ _) -end - -lemma has_ftaylor_series_up_to.differentiable - (h : has_ftaylor_series_up_to n f p) (hn : 1 ≤ n) : differentiable 𝕜 f := -λ x, (h.has_fderiv_at hn x).differentiable_at - -/-- `p` is a Taylor series of `f` up to `n+1` if and only if `p.shift` is a Taylor series up to `n` -for `p 1`, which is a derivative of `f`. -/ -theorem has_ftaylor_series_up_to_succ_iff_right {n : ℕ} : - has_ftaylor_series_up_to ((n + 1) : ℕ) f p ↔ - (∀ x, (p x 0).uncurry0 = f x) - ∧ (∀ x, has_fderiv_at (λ y, p y 0) (p x 1).curry_left x) - ∧ has_ftaylor_series_up_to n - (λ x, continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) (λ x, (p x).shift) := -by simp [has_ftaylor_series_up_to_on_succ_iff_right, has_ftaylor_series_up_to_on_univ_iff.symm, - -add_comm, -with_zero.coe_add] - -/-! ### Smooth functions at a point -/ - -variable (𝕜) - -/-- A function is continuously differentiable up to `n` at a point `x` if, for any integer `k ≤ n`, -there is a neighborhood of `x` where `f` admits derivatives up to order `n`, which are continuous. --/ -def cont_diff_at (n : with_top ℕ) (f : E → F) (x : E) := -cont_diff_within_at 𝕜 n f univ x - -variable {𝕜} - -theorem cont_diff_within_at_univ : - cont_diff_within_at 𝕜 n f univ x ↔ cont_diff_at 𝕜 n f x := -iff.rfl - -lemma cont_diff_at_top : - cont_diff_at 𝕜 ∞ f x ↔ ∀ (n : ℕ), cont_diff_at 𝕜 n f x := -by simp [← cont_diff_within_at_univ, cont_diff_within_at_top] - -lemma cont_diff_at.cont_diff_within_at - (h : cont_diff_at 𝕜 n f x) : cont_diff_within_at 𝕜 n f s x := -h.mono (subset_univ _) - -lemma cont_diff_within_at.cont_diff_at - (h : cont_diff_within_at 𝕜 n f s x) (hx : s ∈ 𝓝 x) : - cont_diff_at 𝕜 n f x := -by rwa [cont_diff_at, ← cont_diff_within_at_inter hx, univ_inter] - -lemma cont_diff_at.congr_of_eventually_eq - (h : cont_diff_at 𝕜 n f x) (hg : f₁ =ᶠ[𝓝 x] f) : - cont_diff_at 𝕜 n f₁ x := -h.congr_of_eventually_eq' (by rwa nhds_within_univ) (mem_univ x) - -lemma cont_diff_at.of_le - (h : cont_diff_at 𝕜 n f x) (hmn : m ≤ n) : - cont_diff_at 𝕜 m f x := -h.of_le hmn - -lemma cont_diff_at.continuous_at - (h : cont_diff_at 𝕜 n f x) : continuous_at f x := -by simpa [continuous_within_at_univ] using h.continuous_within_at - -/-- If a function is `C^n` with `n ≥ 1` at a point, then it is differentiable there. -/ -lemma cont_diff_at.differentiable_at - (h : cont_diff_at 𝕜 n f x) (hn : 1 ≤ n) : differentiable_at 𝕜 f x := -by simpa [hn, differentiable_within_at_univ] using h.differentiable_within_at - -/-- A function is `C^(n + 1)` at a point iff locally, it has a derivative which is `C^n`. -/ -theorem cont_diff_at_succ_iff_has_fderiv_at {n : ℕ} : - cont_diff_at 𝕜 ((n + 1) : ℕ) f x - ↔ (∃ f' : E → E →L[𝕜] F, (∃ u ∈ 𝓝 x, ∀ x ∈ u, has_fderiv_at f (f' x) x) - ∧ cont_diff_at 𝕜 n f' x) := -begin - rw [← cont_diff_within_at_univ, cont_diff_within_at_succ_iff_has_fderiv_within_at], - simp only [nhds_within_univ, exists_prop, mem_univ, insert_eq_of_mem], - split, - { rintros ⟨u, H, f', h_fderiv, h_cont_diff⟩, - rcases mem_nhds_iff.mp H with ⟨t, htu, ht, hxt⟩, - refine ⟨f', ⟨t, _⟩, h_cont_diff.cont_diff_at H⟩, - refine ⟨mem_nhds_iff.mpr ⟨t, subset.rfl, ht, hxt⟩, _⟩, - intros y hyt, - refine (h_fderiv y (htu hyt)).has_fderiv_at _, - exact mem_nhds_iff.mpr ⟨t, htu, ht, hyt⟩ }, - { rintros ⟨f', ⟨u, H, h_fderiv⟩, h_cont_diff⟩, - refine ⟨u, H, f', _, h_cont_diff.cont_diff_within_at⟩, - intros x hxu, - exact (h_fderiv x hxu).has_fderiv_within_at } -end - -protected theorem cont_diff_at.eventually {n : ℕ} (h : cont_diff_at 𝕜 n f x) : - ∀ᶠ y in 𝓝 x, cont_diff_at 𝕜 n f y := -by simpa [nhds_within_univ] using h.eventually - -/-! ### Smooth functions -/ - -variable (𝕜) - -/-- A function is continuously differentiable up to `n` if it admits derivatives up to -order `n`, which are continuous. Contrary to the case of definitions in domains (where derivatives -might not be unique) we do not need to localize the definition in space or time. --/ -definition cont_diff (n : with_top ℕ) (f : E → F) := -∃ p : E → formal_multilinear_series 𝕜 E F, has_ftaylor_series_up_to n f p - -variable {𝕜} - -theorem cont_diff_on_univ : cont_diff_on 𝕜 n f univ ↔ cont_diff 𝕜 n f := -begin - split, - { assume H, - use ftaylor_series_within 𝕜 f univ, - rw ← has_ftaylor_series_up_to_on_univ_iff, - exact H.ftaylor_series_within unique_diff_on_univ }, - { rintros ⟨p, hp⟩ x hx m hm, - exact ⟨univ, filter.univ_sets _, p, (hp.has_ftaylor_series_up_to_on univ).of_le hm⟩ } -end - -lemma cont_diff_iff_cont_diff_at : cont_diff 𝕜 n f ↔ ∀ x, cont_diff_at 𝕜 n f x := -by simp [← cont_diff_on_univ, cont_diff_on, cont_diff_at] - -lemma cont_diff.cont_diff_at (h : cont_diff 𝕜 n f) : cont_diff_at 𝕜 n f x := -cont_diff_iff_cont_diff_at.1 h x - -lemma cont_diff.cont_diff_within_at (h : cont_diff 𝕜 n f) : cont_diff_within_at 𝕜 n f s x := -h.cont_diff_at.cont_diff_within_at - -lemma cont_diff_top : cont_diff 𝕜 ∞ f ↔ ∀ (n : ℕ), cont_diff 𝕜 n f := -by simp [cont_diff_on_univ.symm, cont_diff_on_top] - -lemma cont_diff_all_iff_nat : (∀ n, cont_diff 𝕜 n f) ↔ (∀ n : ℕ, cont_diff 𝕜 n f) := -by simp only [← cont_diff_on_univ, cont_diff_on_all_iff_nat] - -lemma cont_diff.cont_diff_on (h : cont_diff 𝕜 n f) : cont_diff_on 𝕜 n f s := -(cont_diff_on_univ.2 h).mono (subset_univ _) - -@[simp] lemma cont_diff_zero : cont_diff 𝕜 0 f ↔ continuous f := -begin - rw [← cont_diff_on_univ, continuous_iff_continuous_on_univ], - exact cont_diff_on_zero -end - -lemma cont_diff_at_zero : cont_diff_at 𝕜 0 f x ↔ ∃ u ∈ 𝓝 x, continuous_on f u := -by { rw ← cont_diff_within_at_univ, simp [cont_diff_within_at_zero, nhds_within_univ] } - -theorem cont_diff_at_one_iff : cont_diff_at 𝕜 1 f x ↔ - ∃ f' : E → (E →L[𝕜] F), ∃ u ∈ 𝓝 x, continuous_on f' u ∧ ∀ x ∈ u, has_fderiv_at f (f' x) x := -by simp_rw [show (1 : with_top ℕ) = (0 + 1 : ℕ), from (zero_add 1).symm, - cont_diff_at_succ_iff_has_fderiv_at, show ((0 : ℕ) : with_top ℕ) = 0, from rfl, - cont_diff_at_zero, exists_mem_and_iff antitone_bforall antitone_continuous_on, and_comm] - -lemma cont_diff.of_le (h : cont_diff 𝕜 n f) (hmn : m ≤ n) : cont_diff 𝕜 m f := -cont_diff_on_univ.1 $ (cont_diff_on_univ.2 h).of_le hmn - -lemma cont_diff.of_succ {n : ℕ} (h : cont_diff 𝕜 (n + 1) f) : cont_diff 𝕜 n f := -h.of_le $ with_top.coe_le_coe.mpr le_self_add - -lemma cont_diff.one_of_succ {n : ℕ} (h : cont_diff 𝕜 (n + 1) f) : cont_diff 𝕜 1 f := -h.of_le $ with_top.coe_le_coe.mpr le_add_self - -lemma cont_diff.continuous (h : cont_diff 𝕜 n f) : continuous f := -cont_diff_zero.1 (h.of_le bot_le) - -/-- If a function is `C^n` with `n ≥ 1`, then it is differentiable. -/ -lemma cont_diff.differentiable (h : cont_diff 𝕜 n f) (hn : 1 ≤ n) : differentiable 𝕜 f := -differentiable_on_univ.1 $ (cont_diff_on_univ.2 h).differentiable_on hn - - -/-! ### Iterated derivative -/ - -variable (𝕜) - -/-- The `n`-th derivative of a function, as a multilinear map, defined inductively. -/ -noncomputable def iterated_fderiv (n : ℕ) (f : E → F) : - E → (E [×n]→L[𝕜] F) := -nat.rec_on n - (λ x, continuous_multilinear_map.curry0 𝕜 E (f x)) - (λ n rec x, continuous_linear_map.uncurry_left (fderiv 𝕜 rec x)) - -/-- Formal Taylor series associated to a function within a set. -/ -def ftaylor_series (f : E → F) (x : E) : formal_multilinear_series 𝕜 E F := -λ n, iterated_fderiv 𝕜 n f x - -variable {𝕜} - -@[simp] lemma iterated_fderiv_zero_apply (m : (fin 0) → E) : - (iterated_fderiv 𝕜 0 f x : ((fin 0) → E) → F) m = f x := rfl - -lemma iterated_fderiv_zero_eq_comp : - iterated_fderiv 𝕜 0 f = (continuous_multilinear_curry_fin0 𝕜 E F).symm ∘ f := rfl - -lemma iterated_fderiv_succ_apply_left {n : ℕ} (m : fin (n + 1) → E): - (iterated_fderiv 𝕜 (n + 1) f x : (fin (n + 1) → E) → F) m - = (fderiv 𝕜 (iterated_fderiv 𝕜 n f) x : E → (E [×n]→L[𝕜] F)) (m 0) (tail m) := rfl - -/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, -and the derivative of the `n`-th derivative. -/ -lemma iterated_fderiv_succ_eq_comp_left {n : ℕ} : - iterated_fderiv 𝕜 (n + 1) f = - (continuous_multilinear_curry_left_equiv 𝕜 (λ(i : fin (n + 1)), E) F) - ∘ (fderiv 𝕜 (iterated_fderiv 𝕜 n f)) := rfl - -lemma iterated_fderiv_within_univ {n : ℕ} : - iterated_fderiv_within 𝕜 n f univ = iterated_fderiv 𝕜 n f := -begin - induction n with n IH, - { ext x, simp }, - { ext x m, - rw [iterated_fderiv_succ_apply_left, iterated_fderiv_within_succ_apply_left, IH, - fderiv_within_univ] } -end - -/-- In an open set, the iterated derivative within this set coincides with the global iterated -derivative. -/ -lemma iterated_fderiv_within_of_is_open (n : ℕ) (hs : is_open s) : - eq_on (iterated_fderiv_within 𝕜 n f s) (iterated_fderiv 𝕜 n f) s := -begin - induction n with n IH, - { assume x hx, - ext1 m, - simp only [iterated_fderiv_within_zero_apply, iterated_fderiv_zero_apply] }, - { assume x hx, - rw [iterated_fderiv_succ_eq_comp_left, iterated_fderiv_within_succ_eq_comp_left], - dsimp, - congr' 1, - rw fderiv_within_of_open hs hx, - apply filter.eventually_eq.fderiv_eq, - filter_upwards [hs.mem_nhds hx], - exact IH } -end - -lemma ftaylor_series_within_univ : - ftaylor_series_within 𝕜 f univ = ftaylor_series 𝕜 f := -begin - ext1 x, ext1 n, - change iterated_fderiv_within 𝕜 n f univ x = iterated_fderiv 𝕜 n f x, - rw iterated_fderiv_within_univ -end - -theorem iterated_fderiv_succ_apply_right {n : ℕ} (m : fin (n + 1) → E) : - (iterated_fderiv 𝕜 (n + 1) f x : (fin (n + 1) → E) → F) m - = iterated_fderiv 𝕜 n (λy, fderiv 𝕜 f y) x (init m) (m (last n)) := -begin - rw [← iterated_fderiv_within_univ, ← iterated_fderiv_within_univ, ← fderiv_within_univ], - exact iterated_fderiv_within_succ_apply_right unique_diff_on_univ (mem_univ _) _ -end - -/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, -and the `n`-th derivative of the derivative. -/ -lemma iterated_fderiv_succ_eq_comp_right {n : ℕ} : - iterated_fderiv 𝕜 (n + 1) f x = - ((continuous_multilinear_curry_right_equiv' 𝕜 n E F) - ∘ (iterated_fderiv 𝕜 n (λy, fderiv 𝕜 f y))) x := -by { ext m, rw iterated_fderiv_succ_apply_right, refl } - -@[simp] lemma iterated_fderiv_one_apply (m : (fin 1) → E) : - (iterated_fderiv 𝕜 1 f x : ((fin 1) → E) → F) m - = (fderiv 𝕜 f x : E → F) (m 0) := -by { rw [iterated_fderiv_succ_apply_right, iterated_fderiv_zero_apply], refl } - -/-- When a function is `C^n` in a set `s` of unique differentiability, it admits -`ftaylor_series_within 𝕜 f s` as a Taylor series up to order `n` in `s`. -/ -theorem cont_diff_on_iff_ftaylor_series : - cont_diff 𝕜 n f ↔ has_ftaylor_series_up_to n f (ftaylor_series 𝕜 f) := -begin - split, - { rw [← cont_diff_on_univ, ← has_ftaylor_series_up_to_on_univ_iff, - ← ftaylor_series_within_univ], - exact λ h, cont_diff_on.ftaylor_series_within h unique_diff_on_univ }, - { assume h, exact ⟨ftaylor_series 𝕜 f, h⟩ } -end - -lemma cont_diff_iff_continuous_differentiable : - cont_diff 𝕜 n f ↔ - (∀ (m : ℕ), (m : with_top ℕ) ≤ n → continuous (λ x, iterated_fderiv 𝕜 m f x)) - ∧ (∀ (m : ℕ), (m : with_top ℕ) < n → differentiable 𝕜 (λ x, iterated_fderiv 𝕜 m f x)) := -by simp [cont_diff_on_univ.symm, continuous_iff_continuous_on_univ, - differentiable_on_univ.symm, iterated_fderiv_within_univ, - cont_diff_on_iff_continuous_on_differentiable_on unique_diff_on_univ] - -lemma cont_diff_of_differentiable_iterated_fderiv - (h : ∀(m : ℕ), (m : with_top ℕ) ≤ n → differentiable 𝕜 (iterated_fderiv 𝕜 m f)) : - cont_diff 𝕜 n f := -cont_diff_iff_continuous_differentiable.2 -⟨λ m hm, (h m hm).continuous, λ m hm, (h m (le_of_lt hm))⟩ - -/-- A function is `C^(n + 1)` if and only if it is differentiable, -and its derivative (formulated in terms of `fderiv`) is `C^n`. -/ -theorem cont_diff_succ_iff_fderiv {n : ℕ} : - cont_diff 𝕜 ((n + 1) : ℕ) f ↔ - differentiable 𝕜 f ∧ cont_diff 𝕜 n (λ y, fderiv 𝕜 f y) := -by simp [cont_diff_on_univ.symm, differentiable_on_univ.symm, fderiv_within_univ.symm, - - fderiv_within_univ, cont_diff_on_succ_iff_fderiv_within unique_diff_on_univ, - -with_zero.coe_add, -add_comm] - -theorem cont_diff_one_iff_fderiv : - cont_diff 𝕜 1 f ↔ differentiable 𝕜 f ∧ continuous (fderiv 𝕜 f) := -cont_diff_succ_iff_fderiv.trans $ iff.rfl.and cont_diff_zero - -/-- A function is `C^∞` if and only if it is differentiable, -and its derivative (formulated in terms of `fderiv`) is `C^∞`. -/ -theorem cont_diff_top_iff_fderiv : - cont_diff 𝕜 ∞ f ↔ - differentiable 𝕜 f ∧ cont_diff 𝕜 ∞ (λ y, fderiv 𝕜 f y) := -begin - simp [cont_diff_on_univ.symm, differentiable_on_univ.symm, fderiv_within_univ.symm, - - fderiv_within_univ], - rw cont_diff_on_top_iff_fderiv_within unique_diff_on_univ, -end - -lemma cont_diff.continuous_fderiv - (h : cont_diff 𝕜 n f) (hn : 1 ≤ n) : - continuous (λ x, fderiv 𝕜 f x) := -((cont_diff_succ_iff_fderiv).1 (h.of_le hn)).2.continuous - -/-- If a function is at least `C^1`, its bundled derivative (mapping `(x, v)` to `Df(x) v`) is -continuous. -/ -lemma cont_diff.continuous_fderiv_apply - (h : cont_diff 𝕜 n f) (hn : 1 ≤ n) : - continuous (λp : E × E, (fderiv 𝕜 f p.1 : E → F) p.2) := -begin - have A : continuous (λq : (E →L[𝕜] F) × E, q.1 q.2) := is_bounded_bilinear_map_apply.continuous, - have B : continuous (λp : E × E, (fderiv 𝕜 f p.1, p.2)), - { apply continuous.prod_mk _ continuous_snd, - exact continuous.comp (h.continuous_fderiv hn) continuous_fst }, - exact A.comp B -end +normed_add_comm_group.to_add_comm_group normed_space.to_module' add_comm_group.to_add_comm_monoid + +namespace finset + +/- TODO porting note: move the next two lemmas to the file `data.nat.choose.sum` -/ +/-- The sum of `(n+1).choose i * f i (n+1-i)` can be split into two sums at rank `n`, +respectively of `n.choose i * f i (n+1-i)` and `n.choose i * f (i+1) (n-i)`. -/ +lemma sum_choose_succ_mul {R : Type*} [semiring R] (f : ℕ → ℕ → R) (n : ℕ) : + ∑ i in range (n+2), ((n+1).choose i : R) * f i (n + 1 - i) = + ∑ i in range (n+1), (n.choose i : R) * f i (n + 1 - i) + + ∑ i in range (n+1), (n.choose i : R) * f (i + 1) (n - i) := +begin + have A : ∑ i in range (n + 1), (n.choose (i+1) : R) * f (i + 1) (n - i) + f 0 (n + 1) + = ∑ i in range (n+1), n.choose i * f i (n + 1 - i), + { rw [finset.sum_range_succ, finset.sum_range_succ'], + simp only [nat.choose_succ_self, algebra_map.coe_zero, zero_mul, add_zero, + nat.succ_sub_succ_eq_sub, nat.choose_zero_right, algebra_map.coe_one, one_mul, tsub_zero] }, + calc + ∑ i in finset.range (n+2), ((n+1).choose i : R) * f i (n + 1 - i) + = ∑ i in finset.range (n+1), ((n+1).choose (i+1) : R) * f (i+1) (n + 1 - (i+1)) + + f 0 (n + 1 - 0) : + begin + rw finset.sum_range_succ', + simp only [nat.choose_zero_right, algebra_map.coe_one, one_mul], + end + ... = ∑ i in finset.range (n+1), (n.choose i : R) * f i (n + 1 - i) + + ∑ i in finset.range (n+1), n.choose i * f (i + 1) (n - i) : + begin + simp only [nat.choose_succ_succ, nat.cast_add, nat.succ_sub_succ_eq_sub, tsub_zero, add_mul], + rw [finset.sum_add_distrib, ← A], + abel, + end +end + +/-- The sum along the antidiagonal of `(n+1).choose i * f i j` can be split into two sums along the +antidiagonal at rank `n`, respectively of `n.choose i * f i (j+1)` and `n.choose j * f (i+1) j`. -/ +lemma sum_antidiagonal_choose_succ_mul {R : Type*} [semiring R] (f : ℕ → ℕ → R) (n : ℕ) : + ∑ ij in nat.antidiagonal (n + 1), ((n + 1).choose ij.1 : R) * f ij.1 ij.2 = + ∑ ij in nat.antidiagonal n, (n.choose ij.1 : R) * f ij.1 (ij.2 + 1) + + ∑ ij in nat.antidiagonal n, (n.choose ij.2 : R) * f (ij.1 + 1) ij.2 := +begin + convert sum_choose_succ_mul f n using 1, + { exact nat.sum_antidiagonal_eq_sum_range_succ (λ i j, ((n+1).choose i : R) * f i j) (n+1) }, + congr' 1, + { rw nat.sum_antidiagonal_eq_sum_range_succ (λ i j, (n.choose i : R) * f i (j + 1)) n, + apply finset.sum_congr rfl (λ i hi, _), + have : n + 1 - i = n - i + 1, from nat.sub_add_comm (nat.lt_succ_iff.1 (finset.mem_range.1 hi)), + simp only [this] }, + { suffices H : ∑ ij in nat.antidiagonal n, (n.choose ij.2 : R) * f (ij.1 + 1) ij.2 + = ∑ ij in nat.antidiagonal n, (n.choose ij.1 : R) * f (ij.1 + 1) ij.2, + by rw [H, nat.sum_antidiagonal_eq_sum_range_succ (λ i j, (n.choose i : R) * f (i + 1) j) n], + apply finset.sum_congr rfl (λ i hi, _), + congr' 2, + apply nat.choose_symm_of_eq_add, + rw [← nat.mem_antidiagonal.1 hi, add_comm] } +end + +end finset + +open set fin filter function +open_locale topology + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{D : Type uD} [normed_add_comm_group D] [normed_space 𝕜 D] +{E : Type uE} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type uF} [normed_add_comm_group F] [normed_space 𝕜 F] +{G : Type uG} [normed_add_comm_group G] [normed_space 𝕜 G] +{X : Type*} [normed_add_comm_group X] [normed_space 𝕜 X] +{s s₁ t u : set E} {f f₁ : E → F} {g : F → G} {x x₀ : E} {c : F} +{b : E × F → G} {m n : ℕ∞} {p : E → formal_multilinear_series 𝕜 E F} /-! ### Constants -/ -lemma iterated_fderiv_within_zero_fun {n : ℕ} : +@[simp] lemma iterated_fderiv_zero_fun {n : ℕ} : iterated_fderiv 𝕜 n (λ x : E, (0 : F)) = 0 := begin induction n with n IH, @@ -1522,8 +136,8 @@ lemma cont_diff_zero_fun : cont_diff 𝕜 n (λ x : E, (0 : F)) := begin apply cont_diff_of_differentiable_iterated_fderiv (λm hm, _), - rw iterated_fderiv_within_zero_fun, - apply differentiable_const (0 : (E [×m]→L[𝕜] F)) + rw iterated_fderiv_zero_fun, + exact differentiable_const (0 : (E [×m]→L[𝕜] F)) end /-- @@ -1566,6 +180,21 @@ by { rw [subsingleton.elim f (λ _, 0)], exact cont_diff_within_at_const } cont_diff_on 𝕜 n f s := by { rw [subsingleton.elim f (λ _, 0)], exact cont_diff_on_const } +lemma iterated_fderiv_succ_const (n : ℕ) (c : F) : iterated_fderiv 𝕜 (n + 1) (λ (y : E), c) = 0 := +begin + ext x m, + simp only [iterated_fderiv_succ_apply_right, fderiv_const, pi.zero_apply, + iterated_fderiv_zero_fun, continuous_multilinear_map.zero_apply, + continuous_linear_map.zero_apply], +end + +lemma iterated_fderiv_const_of_ne {n : ℕ} (hn : n ≠ 0) (c : F) : + iterated_fderiv 𝕜 n (λ (y : E), c) = 0 := +begin + cases nat.exists_eq_succ_of_ne_zero hn with k hk, + rw [hk, iterated_fderiv_succ_const], +end + /-! ### Smoothness of linear functions -/ /-- @@ -1628,7 +257,7 @@ lemma has_ftaylor_series_up_to_on.continuous_linear_map_comp (g : F →L[𝕜] G has_ftaylor_series_up_to_on n (g ∘ f) (λ x k, g.comp_continuous_multilinear_map (p x k)) s := begin set L : Π m : ℕ, (E [×m]→L[𝕜] F) →L[𝕜] (E [×m]→L[𝕜] G) := - λ m, continuous_linear_map.comp_continuous_multilinear_mapL g, + λ m, continuous_linear_map.comp_continuous_multilinear_mapL 𝕜 (λ _, E) F G g, split, { exact λ x hx, congr_arg g (hf.zero_eq x hx) }, { intros m hm x hx, @@ -1650,14 +279,12 @@ end /-- Composition by continuous linear maps on the left preserves `C^n` functions in a domain at a point. -/ -lemma cont_diff_at.continuous_linear_map_comp (g : F →L[𝕜] G) - (hf : cont_diff_at 𝕜 n f x) : +lemma cont_diff_at.continuous_linear_map_comp (g : F →L[𝕜] G) (hf : cont_diff_at 𝕜 n f x) : cont_diff_at 𝕜 n (g ∘ f) x := cont_diff_within_at.continuous_linear_map_comp g hf /-- Composition by continuous linear maps on the left preserves `C^n` functions on domains. -/ -lemma cont_diff_on.continuous_linear_map_comp (g : F →L[𝕜] G) - (hf : cont_diff_on 𝕜 n f s) : +lemma cont_diff_on.continuous_linear_map_comp (g : F →L[𝕜] G) (hf : cont_diff_on 𝕜 n f s) : cont_diff_on 𝕜 n (g ∘ f) s := λ x hx, (hf x hx).continuous_linear_map_comp g @@ -1667,8 +294,101 @@ lemma cont_diff.continuous_linear_map_comp {f : E → F} (g : F →L[𝕜] G) cont_diff_on_univ.1 $ cont_diff_on.continuous_linear_map_comp _ (cont_diff_on_univ.2 hf) -/-- Composition by continuous linear equivs on the left respects higher differentiability on -domains. -/ +/-- The iterated derivative within a set of the composition with a linear map on the left is +obtained by applying the linear map to the iterated derivative. -/ +lemma continuous_linear_map.iterated_fderiv_within_comp_left + {f : E → F} (g : F →L[𝕜] G) (hf : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) + {i : ℕ} (hi : (i : ℕ∞) ≤ n) : + iterated_fderiv_within 𝕜 i (g ∘ f) s x = + g.comp_continuous_multilinear_map (iterated_fderiv_within 𝕜 i f s x) := +(((hf.ftaylor_series_within hs).continuous_linear_map_comp g).eq_ftaylor_series_of_unique_diff_on + hi hs hx).symm + +/-- The iterated derivative of the composition with a linear map on the left is +obtained by applying the linear map to the iterated derivative. -/ +lemma continuous_linear_map.iterated_fderiv_comp_left + {f : E → F} (g : F →L[𝕜] G) (hf : cont_diff 𝕜 n f) (x : E) {i : ℕ} (hi : (i : ℕ∞) ≤ n) : + iterated_fderiv 𝕜 i (g ∘ f) x = g.comp_continuous_multilinear_map (iterated_fderiv 𝕜 i f x) := +begin + simp only [← iterated_fderiv_within_univ], + exact g.iterated_fderiv_within_comp_left hf.cont_diff_on unique_diff_on_univ (mem_univ x) hi, +end + +/-- The iterated derivative within a set of the composition with a linear equiv on the left is +obtained by applying the linear equiv to the iterated derivative. This is true without +differentiability assumptions. -/ +lemma continuous_linear_equiv.iterated_fderiv_within_comp_left + (g : F ≃L[𝕜] G) (f : E → F) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) (i : ℕ) : + iterated_fderiv_within 𝕜 i (g ∘ f) s x = + (g : F →L[𝕜] G).comp_continuous_multilinear_map (iterated_fderiv_within 𝕜 i f s x) := +begin + induction i with i IH generalizing x, + { ext1 m, + simp only [iterated_fderiv_within_zero_apply, continuous_linear_equiv.coe_coe, + continuous_linear_map.comp_continuous_multilinear_map_coe, embedding_like.apply_eq_iff_eq] }, + { ext1 m, + rw iterated_fderiv_within_succ_apply_left, + have Z : fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i (g ∘ f) s) s x = + fderiv_within 𝕜 (λ y, g.comp_continuous_multilinear_mapL (λ (j : fin i), E) + (iterated_fderiv_within 𝕜 i f s y)) s x, + from fderiv_within_congr' @IH hx, + simp_rw Z, + rw (g.comp_continuous_multilinear_mapL (λ (j : fin i), E)).comp_fderiv_within (hs x hx), + simp only [continuous_linear_map.coe_comp', continuous_linear_equiv.coe_coe, comp_app, + continuous_linear_equiv.comp_continuous_multilinear_mapL_apply, + continuous_linear_map.comp_continuous_multilinear_map_coe, embedding_like.apply_eq_iff_eq], + rw iterated_fderiv_within_succ_apply_left } +end + +/-- Composition with a linear isometry on the left preserves the norm of the iterated +derivative within a set. -/ +lemma linear_isometry.norm_iterated_fderiv_within_comp_left + {f : E → F} (g : F →ₗᵢ[𝕜] G) (hf : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) + {i : ℕ} (hi : (i : ℕ∞) ≤ n) : + ‖iterated_fderiv_within 𝕜 i (g ∘ f) s x‖ = ‖iterated_fderiv_within 𝕜 i f s x‖ := +begin + have : iterated_fderiv_within 𝕜 i (g ∘ f) s x = + g.to_continuous_linear_map.comp_continuous_multilinear_map (iterated_fderiv_within 𝕜 i f s x), + from g.to_continuous_linear_map.iterated_fderiv_within_comp_left hf hs hx hi, + rw this, + apply linear_isometry.norm_comp_continuous_multilinear_map +end + +/-- Composition with a linear isometry on the left preserves the norm of the iterated +derivative. -/ +lemma linear_isometry.norm_iterated_fderiv_comp_left + {f : E → F} (g : F →ₗᵢ[𝕜] G) (hf : cont_diff 𝕜 n f) (x : E) {i : ℕ} (hi : (i : ℕ∞) ≤ n) : + ‖iterated_fderiv 𝕜 i (g ∘ f) x‖ = ‖iterated_fderiv 𝕜 i f x‖ := +begin + simp only [← iterated_fderiv_within_univ], + exact g.norm_iterated_fderiv_within_comp_left hf.cont_diff_on unique_diff_on_univ (mem_univ x) hi +end + +/-- Composition with a linear isometry equiv on the left preserves the norm of the iterated +derivative within a set. -/ +lemma linear_isometry_equiv.norm_iterated_fderiv_within_comp_left + (g : F ≃ₗᵢ[𝕜] G) (f : E → F) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) (i : ℕ) : + ‖iterated_fderiv_within 𝕜 i (g ∘ f) s x‖ = ‖iterated_fderiv_within 𝕜 i f s x‖ := +begin + have : iterated_fderiv_within 𝕜 i (g ∘ f) s x = + (g : F →L[𝕜] G).comp_continuous_multilinear_map (iterated_fderiv_within 𝕜 i f s x), + from g.to_continuous_linear_equiv.iterated_fderiv_within_comp_left f hs hx i, + rw this, + apply linear_isometry.norm_comp_continuous_multilinear_map g.to_linear_isometry, +end + +/-- Composition with a linear isometry equiv on the left preserves the norm of the iterated +derivative. -/ +lemma linear_isometry_equiv.norm_iterated_fderiv_comp_left + (g : F ≃ₗᵢ[𝕜] G) (f : E → F) (x : E) (i : ℕ) : + ‖iterated_fderiv 𝕜 i (g ∘ f) x‖ = ‖iterated_fderiv 𝕜 i f x‖ := +begin + rw [← iterated_fderiv_within_univ, ← iterated_fderiv_within_univ], + apply g.norm_iterated_fderiv_within_comp_left f unique_diff_on_univ (mem_univ x) i +end + +/-- Composition by continuous linear equivs on the left respects higher differentiability at a +point in a domain. -/ lemma continuous_linear_equiv.comp_cont_diff_within_at_iff (e : F ≃L[𝕜] G) : cont_diff_within_at 𝕜 n (e ∘ f) s x ↔ cont_diff_within_at 𝕜 n f s x := @@ -1676,6 +396,12 @@ lemma continuous_linear_equiv.comp_cont_diff_within_at_iff using H.continuous_linear_map_comp (e.symm : G →L[𝕜] F), λ H, H.continuous_linear_map_comp (e : F →L[𝕜] G)⟩ +/-- Composition by continuous linear equivs on the left respects higher differentiability at a +point. -/ +lemma continuous_linear_equiv.comp_cont_diff_at_iff (e : F ≃L[𝕜] G) : + cont_diff_at 𝕜 n (e ∘ f) x ↔ cont_diff_at 𝕜 n f x := +by simp only [← cont_diff_within_at_univ, e.comp_cont_diff_within_at_iff] + /-- Composition by continuous linear equivs on the left respects higher differentiability on domains. -/ lemma continuous_linear_equiv.comp_cont_diff_on_iff @@ -1683,6 +409,12 @@ lemma continuous_linear_equiv.comp_cont_diff_on_iff cont_diff_on 𝕜 n (e ∘ f) s ↔ cont_diff_on 𝕜 n f s := by simp [cont_diff_on, e.comp_cont_diff_within_at_iff] +/-- Composition by continuous linear equivs on the left respects higher differentiability. -/ +lemma continuous_linear_equiv.comp_cont_diff_iff + (e : F ≃L[𝕜] G) : + cont_diff 𝕜 n (e ∘ f) ↔ cont_diff 𝕜 n f := +by simp only [← cont_diff_on_univ, e.comp_cont_diff_on_iff] + /-- If `f` admits a Taylor series `p` in a set `s`, and `g` is linear, then `f ∘ g` admits a Taylor series in `g ⁻¹' s`, whose `k`-th term is given by `p k (g v₁, ..., g vₖ)` . -/ lemma has_ftaylor_series_up_to_on.comp_continuous_linear_map @@ -1739,6 +471,78 @@ lemma cont_diff.comp_continuous_linear_map {f : E → F} {g : G →L[𝕜] E} cont_diff_on_univ.1 $ cont_diff_on.comp_continuous_linear_map (cont_diff_on_univ.2 hf) _ +/-- The iterated derivative within a set of the composition with a linear map on the right is +obtained by composing the iterated derivative with the linear map. -/ +lemma continuous_linear_map.iterated_fderiv_within_comp_right + {f : E → F} (g : G →L[𝕜] E) (hf : cont_diff_on 𝕜 n f s) + (hs : unique_diff_on 𝕜 s) (h's : unique_diff_on 𝕜 (g⁻¹' s)) {x : G} + (hx : g x ∈ s) {i : ℕ} (hi : (i : ℕ∞) ≤ n) : + iterated_fderiv_within 𝕜 i (f ∘ g) (g ⁻¹' s) x = + (iterated_fderiv_within 𝕜 i f s (g x)).comp_continuous_linear_map (λ _, g) := +(((hf.ftaylor_series_within hs).comp_continuous_linear_map g).eq_ftaylor_series_of_unique_diff_on + hi h's hx).symm + +/-- The iterated derivative within a set of the composition with a linear equiv on the right is +obtained by composing the iterated derivative with the linear equiv. -/ +lemma continuous_linear_equiv.iterated_fderiv_within_comp_right + (g : G ≃L[𝕜] E) (f : E → F) (hs : unique_diff_on 𝕜 s) {x : G} (hx : g x ∈ s) (i : ℕ) : + iterated_fderiv_within 𝕜 i (f ∘ g) (g ⁻¹' s) x = + (iterated_fderiv_within 𝕜 i f s (g x)).comp_continuous_linear_map (λ _, g) := +begin + induction i with i IH generalizing x, + { ext1 m, + simp only [iterated_fderiv_within_zero_apply, + continuous_multilinear_map.comp_continuous_linear_map_apply] }, + { ext1 m, + simp only [continuous_multilinear_map.comp_continuous_linear_map_apply, + continuous_linear_equiv.coe_coe, iterated_fderiv_within_succ_apply_left], + have : fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i (f ∘ ⇑g) (⇑g ⁻¹' s)) (⇑g ⁻¹' s) x + = fderiv_within 𝕜 (λ y, continuous_multilinear_map.comp_continuous_linear_map_equivL _ + (λ (_x : fin i), g) (iterated_fderiv_within 𝕜 i f s (g y))) (g ⁻¹' s) x, + from fderiv_within_congr' @IH hx, + rw [this], + rw continuous_linear_equiv.comp_fderiv_within _ (g.unique_diff_on_preimage_iff.2 hs x hx), + simp only [continuous_linear_map.coe_comp', continuous_linear_equiv.coe_coe, comp_app, + continuous_multilinear_map.comp_continuous_linear_map_equivL_apply, + continuous_multilinear_map.comp_continuous_linear_map_apply], + rw continuous_linear_equiv.comp_right_fderiv_within _ (g.unique_diff_on_preimage_iff.2 hs x hx), + refl } +end + +/-- The iterated derivative of the composition with a linear map on the right is +obtained by composing the iterated derivative with the linear map. -/ +lemma continuous_linear_map.iterated_fderiv_comp_right + (g : G →L[𝕜] E) {f : E → F} (hf : cont_diff 𝕜 n f) (x : G) {i : ℕ} (hi : (i : ℕ∞) ≤ n) : + iterated_fderiv 𝕜 i (f ∘ g) x = + (iterated_fderiv 𝕜 i f (g x)).comp_continuous_linear_map (λ _, g) := +begin + simp only [← iterated_fderiv_within_univ], + apply g.iterated_fderiv_within_comp_right hf.cont_diff_on unique_diff_on_univ unique_diff_on_univ + (mem_univ _) hi, +end + +/-- Composition with a linear isometry on the right preserves the norm of the iterated derivative +within a set. -/ +lemma linear_isometry_equiv.norm_iterated_fderiv_within_comp_right + (g : G ≃ₗᵢ[𝕜] E) (f : E → F) (hs : unique_diff_on 𝕜 s) {x : G} (hx : g x ∈ s) (i : ℕ) : + ‖iterated_fderiv_within 𝕜 i (f ∘ g) (g ⁻¹' s) x‖ = ‖iterated_fderiv_within 𝕜 i f s (g x)‖ := +begin + have : iterated_fderiv_within 𝕜 i (f ∘ g) (g ⁻¹' s) x = + (iterated_fderiv_within 𝕜 i f s (g x)).comp_continuous_linear_map (λ _, g), + from g.to_continuous_linear_equiv.iterated_fderiv_within_comp_right f hs hx i, + rw [this, continuous_multilinear_map.norm_comp_continuous_linear_isometry_equiv] +end + +/-- Composition with a linear isometry on the right preserves the norm of the iterated derivative +within a set. -/ +lemma linear_isometry_equiv.norm_iterated_fderiv_comp_right + (g : G ≃ₗᵢ[𝕜] E) (f : E → F) (x : G) (i : ℕ) : + ‖iterated_fderiv 𝕜 i (f ∘ g) x‖ = ‖iterated_fderiv 𝕜 i f (g x)‖ := +begin + simp only [← iterated_fderiv_within_univ], + apply g.norm_iterated_fderiv_within_comp_right f unique_diff_on_univ (mem_univ (g x)) i, +end + /-- Composition by continuous linear equivs on the right respects higher differentiability at a point in a domain. -/ lemma continuous_linear_equiv.cont_diff_within_at_comp_iff (e : G ≃L[𝕜] E) : @@ -1753,6 +557,15 @@ begin exact H.comp_continuous_linear_map _ }, end +/-- Composition by continuous linear equivs on the right respects higher differentiability at a +point. -/ +lemma continuous_linear_equiv.cont_diff_at_comp_iff (e : G ≃L[𝕜] E) : + cont_diff_at 𝕜 n (f ∘ e) (e.symm x) ↔ cont_diff_at 𝕜 n f x := +begin + rw [← cont_diff_within_at_univ, ← cont_diff_within_at_univ, ← preimage_univ], + exact e.cont_diff_within_at_comp_iff +end + /-- Composition by continuous linear equivs on the right respects higher differentiability on domains. -/ lemma continuous_linear_equiv.cont_diff_on_comp_iff (e : G ≃L[𝕜] E) : @@ -1767,6 +580,14 @@ begin exact H.comp_continuous_linear_map (e.symm : E →L[𝕜] G) end +/-- Composition by continuous linear equivs on the right respects higher differentiability. -/ +lemma continuous_linear_equiv.cont_diff_comp_iff (e : G ≃L[𝕜] E) : + cont_diff 𝕜 n (f ∘ e) ↔ cont_diff 𝕜 n f := +begin + rw [← cont_diff_on_univ, ← cont_diff_on_univ, ← preimage_univ], + exact e.cont_diff_on_comp_iff +end + /-- If two functions `f` and `g` admit Taylor series `p` and `q` in a set `s`, then the cartesian product of `f` and `g` admits the cartesian product of `p` and `q` as a Taylor series. -/ lemma has_ftaylor_series_up_to_on.prod (hf : has_ftaylor_series_up_to_on n f p s) @@ -1847,14 +668,14 @@ which we have already proved previously. spaces live in the same universe. Use instead `cont_diff_on.comp` which removes the universe assumption (but is deduced from this one). -/ private lemma cont_diff_on.comp_same_univ - {Eu : Type u} [normed_group Eu] [normed_space 𝕜 Eu] - {Fu : Type u} [normed_group Fu] [normed_space 𝕜 Fu] - {Gu : Type u} [normed_group Gu] [normed_space 𝕜 Gu] + {Eu : Type u} [normed_add_comm_group Eu] [normed_space 𝕜 Eu] + {Fu : Type u} [normed_add_comm_group Fu] [normed_space 𝕜 Fu] + {Gu : Type u} [normed_add_comm_group Gu] [normed_space 𝕜 Gu] {s : set Eu} {t : set Fu} {g : Fu → Gu} {f : Eu → Fu} (hg : cont_diff_on 𝕜 n g t) (hf : cont_diff_on 𝕜 n f s) (st : s ⊆ f ⁻¹' t) : cont_diff_on 𝕜 n (g ∘ f) s := begin - unfreezingI { induction n using with_top.nat_induction with n IH Itop generalizing Eu Fu Gu }, + unfreezingI { induction n using enat.nat_induction with n IH Itop generalizing Eu Fu Gu }, { rw cont_diff_on_zero at hf hg ⊢, exact continuous_on.comp hg hf st }, { rw cont_diff_on_succ_iff_has_fderiv_within_at at hg ⊢, @@ -1886,14 +707,12 @@ begin { have A : cont_diff_on 𝕜 n (λ y, g' (f y)) w := IH g'_diff ((hf.of_le (with_top.coe_le_coe.2 (nat.le_succ n))).mono ws) wv, have B : cont_diff_on 𝕜 n f' w := f'_diff.mono wu, - have C : cont_diff_on 𝕜 n (λ y, (f' y, g' (f y))) w := - cont_diff_on.prod B A, - have D : cont_diff_on 𝕜 n (λ(p : (Eu →L[𝕜] Fu) × (Fu →L[𝕜] Gu)), p.2.comp p.1) univ := + have C : cont_diff_on 𝕜 n (λ y, (g' (f y), f' y)) w := A.prod B, + have D : cont_diff_on 𝕜 n (λ p : (Fu →L[𝕜] Gu) × (Eu →L[𝕜] Fu), p.1.comp p.2) univ := is_bounded_bilinear_map_comp.cont_diff.cont_diff_on, exact IH D C (subset_univ _) } }, { rw cont_diff_on_top at hf hg ⊢, - assume n, - apply Itop n (hg n) (hf n) st } + exact λ n, Itop n (hg n) (hf n) st } end /-- The composition of `C^n` functions on domains is `C^n`. -/ @@ -1903,22 +722,14 @@ lemma cont_diff_on.comp cont_diff_on 𝕜 n (g ∘ f) s := begin /- we lift all the spaces to a common universe, as we have already proved the result in this - situation. For the lift, we use the trick that `H` is isomorphic through a - continuous linear equiv to `continuous_multilinear_map 𝕜 (λ (i : fin 0), (E × F × G)) H`, and - continuous linear equivs respect smoothness classes. -/ - let Eu := continuous_multilinear_map 𝕜 (λ (i : fin 0), (E × F × G)) E, - letI : normed_group Eu := by apply_instance, - letI : normed_space 𝕜 Eu := by apply_instance, - let Fu := continuous_multilinear_map 𝕜 (λ (i : fin 0), (E × F × G)) F, - letI : normed_group Fu := by apply_instance, - letI : normed_space 𝕜 Fu := by apply_instance, - let Gu := continuous_multilinear_map 𝕜 (λ (i : fin 0), (E × F × G)) G, - letI : normed_group Gu := by apply_instance, - letI : normed_space 𝕜 Gu := by apply_instance, + situation. -/ + let Eu : Type (max uE uF uG) := ulift E, + let Fu : Type (max uE uF uG) := ulift.{(max uE uG) uF} F, + let Gu : Type (max uE uF uG) := ulift.{(max uE uF) uG} G, -- declare the isomorphisms - let isoE : Eu ≃L[𝕜] E := continuous_multilinear_curry_fin0 𝕜 (E × F × G) E, - let isoF : Fu ≃L[𝕜] F := continuous_multilinear_curry_fin0 𝕜 (E × F × G) F, - let isoG : Gu ≃L[𝕜] G := continuous_multilinear_curry_fin0 𝕜 (E × F × G) G, + have isoE : Eu ≃L[𝕜] E := continuous_linear_equiv.ulift, + have isoF : Fu ≃L[𝕜] F := continuous_linear_equiv.ulift, + have isoG : Gu ≃L[𝕜] G := continuous_linear_equiv.ulift, -- lift the functions to the new spaces, check smoothness there, and then go back. let fu : Eu → Fu := (isoF.symm ∘ f) ∘ isoE, have fu_diff : cont_diff_on 𝕜 n fu (isoE ⁻¹' s), @@ -1989,6 +800,15 @@ begin rwa [insert_eq_of_mem xmem, this] at Z, end +/-- The composition of `C^n` functions at points in domains is `C^n`, + with a weaker condition on `s` and `t`. -/ +lemma cont_diff_within_at.comp_of_mem + {s : set E} {t : set F} {g : F → G} {f : E → F} (x : E) + (hg : cont_diff_within_at 𝕜 n g t (f x)) + (hf : cont_diff_within_at 𝕜 n f s x) (hs : t ∈ 𝓝[f '' s] f x) : + cont_diff_within_at 𝕜 n (g ∘ f) s x := +(hg.mono_of_mem hs).comp x hf (subset_preimage_image f s) + /-- The composition of `C^n` functions at points in domains is `C^n`. -/ lemma cont_diff_within_at.comp' {s : set E} {t : set F} {g : F → G} {f : E → F} (x : E) @@ -2117,8 +937,9 @@ cont_diff_snd.cont_diff_within_at section n_ary variables {E₁ E₂ E₃ E₄ : Type*} -variables [normed_group E₁] [normed_group E₂] [normed_group E₃] [normed_group E₄] -variables [normed_space 𝕜 E₁] [normed_space 𝕜 E₂] [normed_space 𝕜 E₃] [normed_space 𝕜 E₄] +variables [normed_add_comm_group E₁] [normed_add_comm_group E₂] [normed_add_comm_group E₃] + [normed_add_comm_group E₄] [normed_space 𝕜 E₁] [normed_space 𝕜 E₂] [normed_space 𝕜 E₃] + [normed_space 𝕜 E₄] lemma cont_diff.comp₂ {g : E₁ × E₂ → G} {f₁ : F → E₁} {f₂ : F → E₂} (hg : cont_diff 𝕜 n g) (hf₁ : cont_diff 𝕜 n f₁) (hf₂ : cont_diff 𝕜 n f₂) : @@ -2130,8 +951,48 @@ lemma cont_diff.comp₃ {g : E₁ × E₂ × E₃ → G} {f₁ : F → E₁} {f (hf₃ : cont_diff 𝕜 n f₃) : cont_diff 𝕜 n (λ x, g (f₁ x, f₂ x, f₃ x)) := hg.comp₂ hf₁ $ hf₂.prod hf₃ +lemma cont_diff.comp_cont_diff_on₂ {g : E₁ × E₂ → G} {f₁ : F → E₁} {f₂ : F → E₂} {s : set F} + (hg : cont_diff 𝕜 n g) (hf₁ : cont_diff_on 𝕜 n f₁ s) (hf₂ : cont_diff_on 𝕜 n f₂ s) : + cont_diff_on 𝕜 n (λ x, g (f₁ x, f₂ x)) s := +hg.comp_cont_diff_on $ hf₁.prod hf₂ + +lemma cont_diff.comp_cont_diff_on₃ {g : E₁ × E₂ × E₃ → G} {f₁ : F → E₁} {f₂ : F → E₂} {f₃ : F → E₃} + {s : set F} (hg : cont_diff 𝕜 n g) (hf₁ : cont_diff_on 𝕜 n f₁ s) (hf₂ : cont_diff_on 𝕜 n f₂ s) + (hf₃ : cont_diff_on 𝕜 n f₃ s) : cont_diff_on 𝕜 n (λ x, g (f₁ x, f₂ x, f₃ x)) s := +hg.comp_cont_diff_on₂ hf₁ $ hf₂.prod hf₃ + end n_ary +section specific_bilinear_maps + +lemma cont_diff.clm_comp {g : X → F →L[𝕜] G} {f : X → E →L[𝕜] F} + (hg : cont_diff 𝕜 n g) (hf : cont_diff 𝕜 n f) : + cont_diff 𝕜 n (λ x, (g x).comp (f x)) := +is_bounded_bilinear_map_comp.cont_diff.comp₂ hg hf + +lemma cont_diff_on.clm_comp {g : X → F →L[𝕜] G} {f : X → E →L[𝕜] F} + {s : set X} (hg : cont_diff_on 𝕜 n g s) (hf : cont_diff_on 𝕜 n f s) : + cont_diff_on 𝕜 n (λ x, (g x).comp (f x)) s := +is_bounded_bilinear_map_comp.cont_diff.comp_cont_diff_on₂ hg hf + +lemma cont_diff.clm_apply {f : E → F →L[𝕜] G} {g : E → F} {n : ℕ∞} + (hf : cont_diff 𝕜 n f) (hg : cont_diff 𝕜 n g) : + cont_diff 𝕜 n (λ x, (f x) (g x)) := +is_bounded_bilinear_map_apply.cont_diff.comp₂ hf hg + +lemma cont_diff_on.clm_apply {f : E → F →L[𝕜] G} {g : E → F} {n : ℕ∞} + (hf : cont_diff_on 𝕜 n f s) (hg : cont_diff_on 𝕜 n g s) : + cont_diff_on 𝕜 n (λ x, (f x) (g x)) s := +is_bounded_bilinear_map_apply.cont_diff.comp_cont_diff_on₂ hf hg + +lemma cont_diff.smul_right {f : E → F →L[𝕜] 𝕜} {g : E → G} {n : ℕ∞} + (hf : cont_diff 𝕜 n f) (hg : cont_diff 𝕜 n g) : + cont_diff 𝕜 n (λ x, (f x).smul_right (g x)) := +-- giving the following implicit type arguments speeds up elaboration significantly +(@is_bounded_bilinear_map_smul_right 𝕜 _ F _ _ G _ _).cont_diff.comp₂ hf hg + +end specific_bilinear_maps + /-- The natural equivalence `(E × F) × G ≃ E × (F × G)` is smooth. @@ -2150,29 +1011,188 @@ Warning: see remarks attached to `cont_diff_prod_assoc` lemma cont_diff_prod_assoc_symm : cont_diff 𝕜 ⊤ $ (equiv.prod_assoc E F G).symm := (linear_isometry_equiv.prod_assoc 𝕜 E F G).symm.cont_diff -/-! ### Bundled derivatives -/ +/-! ### Bundled derivatives are smooth -/ + +/-- One direction of `cont_diff_within_at_succ_iff_has_fderiv_within_at`, but where all derivatives + are taken within the same set. Version for partial derivatives / functions with parameters. + If `f x` is a `C^n+1` family of functions and `g x` is a `C^n` family of points, then the + derivative of `f x` at `g x` depends in a `C^n` way on `x`. We give a general version of this fact + relative to sets which may not have unique derivatives, in the following form. + If `f : E × F → G` is `C^n+1` at `(x₀, g(x₀))` in `(s ∪ {x₀}) × t ⊆ E × F` and `g : E → F` is + `C^n` at `x₀` within some set `s ⊆ E`, then there is a function `f' : E → F →L[𝕜] G` + that is `C^n` at `x₀` within `s` such that for all `x` sufficiently close to `x₀` within + `s ∪ {x₀}` the function `y ↦ f x y` has derivative `f' x` at `g x` within `t ⊆ F`. + For convenience, we return an explicit set of `x`'s where this holds that is a subset of + `s ∪ {x₀}`. + We need one additional condition, namely that `t` is a neighborhood of `g(x₀)` within `g '' s`. + -/ +lemma cont_diff_within_at.has_fderiv_within_at_nhds {f : E → F → G} {g : E → F} + {t : set F} {n : ℕ} {x₀ : E} + (hf : cont_diff_within_at 𝕜 (n+1) (uncurry f) (insert x₀ s ×ˢ t) (x₀, g x₀)) + (hg : cont_diff_within_at 𝕜 n g s x₀) + (hgt : t ∈ 𝓝[g '' s] g x₀) : + ∃ v ∈ 𝓝[insert x₀ s] x₀, v ⊆ insert x₀ s ∧ ∃ f' : E → F →L[𝕜] G, + (∀ x ∈ v, has_fderiv_within_at (f x) (f' x) t (g x)) ∧ + cont_diff_within_at 𝕜 n (λ x, f' x) s x₀ := +begin + have hst : insert x₀ s ×ˢ t ∈ 𝓝[(λ x, (x, g x)) '' s] (x₀, g x₀), + { refine nhds_within_mono _ _ (nhds_within_prod self_mem_nhds_within hgt), + simp_rw [image_subset_iff, mk_preimage_prod, preimage_id', subset_inter_iff, subset_insert, + true_and, subset_preimage_image] }, + obtain ⟨v, hv, hvs, f', hvf', hf'⟩ := cont_diff_within_at_succ_iff_has_fderiv_within_at'.mp hf, + refine ⟨(λ z, (z, g z)) ⁻¹' v ∩ insert x₀ s, _, inter_subset_right _ _, + λ z, (f' (z, g z)).comp (continuous_linear_map.inr 𝕜 E F), _, _⟩, + { refine inter_mem _ self_mem_nhds_within, + have := mem_of_mem_nhds_within (mem_insert _ _) hv, + refine mem_nhds_within_insert.mpr ⟨this, _⟩, + refine (continuous_within_at_id.prod hg.continuous_within_at).preimage_mem_nhds_within' _, + rw [← nhds_within_le_iff] at hst hv ⊢, + refine (hst.trans $ nhds_within_mono _ $ subset_insert _ _).trans hv }, + { intros z hz, + have := hvf' (z, g z) hz.1, + refine this.comp _ (has_fderiv_at_prod_mk_right _ _).has_fderiv_within_at _, + exact maps_to'.mpr (image_prod_mk_subset_prod_right hz.2) }, + { exact (hf'.continuous_linear_map_comp $ (continuous_linear_map.compL 𝕜 F (E × F) G).flip + (continuous_linear_map.inr 𝕜 E F)).comp_of_mem x₀ + (cont_diff_within_at_id.prod hg) hst }, +end + +/-- The most general lemma stating that `x ↦ fderiv_within 𝕜 (f x) t (g x)` is `C^n` +at a point within a set. +To show that `x ↦ D_yf(x,y)g(x)` (taken within `t`) is `C^m` at `x₀` within `s`, we require that +* `f` is `C^n` at `(x₀, g(x₀))` within `(s ∪ {x₀}) × t` for `n ≥ m+1`. +* `g` is `C^m` at `x₀` within `s`; +* Derivatives are unique at `g(x)` within `t` for `x` sufficiently close to `x₀` within `s ∪ {x₀}`; +* `t` is a neighborhood of `g(x₀)` within `g '' s`; -/ +lemma cont_diff_within_at.fderiv_within'' {f : E → F → G} {g : E → F} + {t : set F} {n : ℕ∞} + (hf : cont_diff_within_at 𝕜 n (function.uncurry f) (insert x₀ s ×ˢ t) (x₀, g x₀)) + (hg : cont_diff_within_at 𝕜 m g s x₀) + (ht : ∀ᶠ x in 𝓝[insert x₀ s] x₀, unique_diff_within_at 𝕜 t (g x)) + (hmn : m + 1 ≤ n) + (hgt : t ∈ 𝓝[g '' s] g x₀) : + cont_diff_within_at 𝕜 m (λ x, fderiv_within 𝕜 (f x) t (g x)) s x₀ := +begin + have : ∀ k : ℕ, (k : ℕ∞) ≤ m → + cont_diff_within_at 𝕜 k (λ x, fderiv_within 𝕜 (f x) t (g x)) s x₀, + { intros k hkm, + obtain ⟨v, hv, -, f', hvf', hf'⟩ := + (hf.of_le $ (add_le_add_right hkm 1).trans hmn).has_fderiv_within_at_nhds (hg.of_le hkm) hgt, + refine hf'.congr_of_eventually_eq_insert _, + filter_upwards [hv, ht], + exact λ y hy h2y, (hvf' y hy).fderiv_within h2y }, + induction m using with_top.rec_top_coe, + { obtain rfl := eq_top_iff.mpr hmn, + rw [cont_diff_within_at_top], + exact λ m, this m le_top }, + exact this m le_rfl +end + +/-- A special case of `cont_diff_within_at.fderiv_within''` where we require that `s ⊆ g⁻¹(t)`. -/ +lemma cont_diff_within_at.fderiv_within' {f : E → F → G} {g : E → F} + {t : set F} {n : ℕ∞} + (hf : cont_diff_within_at 𝕜 n (function.uncurry f) (insert x₀ s ×ˢ t) (x₀, g x₀)) + (hg : cont_diff_within_at 𝕜 m g s x₀) + (ht : ∀ᶠ x in 𝓝[insert x₀ s] x₀, unique_diff_within_at 𝕜 t (g x)) + (hmn : m + 1 ≤ n) + (hst : s ⊆ g ⁻¹' t) : + cont_diff_within_at 𝕜 m (λ x, fderiv_within 𝕜 (f x) t (g x)) s x₀ := +hf.fderiv_within'' hg ht hmn $ mem_of_superset self_mem_nhds_within $ image_subset_iff.mpr hst + +/-- A special case of `cont_diff_within_at.fderiv_within'` where we require that `x₀ ∈ s` and there + are unique derivatives everywhere within `t`. -/ +lemma cont_diff_within_at.fderiv_within {f : E → F → G} {g : E → F} + {t : set F} {n : ℕ∞} + (hf : cont_diff_within_at 𝕜 n (function.uncurry f) (s ×ˢ t) (x₀, g x₀)) + (hg : cont_diff_within_at 𝕜 m g s x₀) + (ht : unique_diff_on 𝕜 t) + (hmn : m + 1 ≤ n) (hx₀ : x₀ ∈ s) + (hst : s ⊆ g ⁻¹' t) : + cont_diff_within_at 𝕜 m (λ x, fderiv_within 𝕜 (f x) t (g x)) s x₀ := +begin + rw [← insert_eq_self.mpr hx₀] at hf, + refine hf.fderiv_within' hg _ hmn hst, + rw [insert_eq_self.mpr hx₀], + exact eventually_of_mem self_mem_nhds_within (λ x hx, ht _ (hst hx)) +end + +/-- `x ↦ fderiv_within 𝕜 (f x) t (g x) (k x)` is smooth at a point within a set. -/ +lemma cont_diff_within_at.fderiv_within_apply {f : E → F → G} {g k : E → F} + {t : set F} {n : ℕ∞} + (hf : cont_diff_within_at 𝕜 n (function.uncurry f) (s ×ˢ t) (x₀, g x₀)) + (hg : cont_diff_within_at 𝕜 m g s x₀) + (hk : cont_diff_within_at 𝕜 m k s x₀) + (ht : unique_diff_on 𝕜 t) + (hmn : m + 1 ≤ n) (hx₀ : x₀ ∈ s) + (hst : s ⊆ g ⁻¹' t) : + cont_diff_within_at 𝕜 m (λ x, fderiv_within 𝕜 (f x) t (g x) (k x)) s x₀ := +(cont_diff_fst.clm_apply cont_diff_snd).cont_diff_at.comp_cont_diff_within_at x₀ + ((hf.fderiv_within hg ht hmn hx₀ hst).prod hk) + +/-- `fderiv_within 𝕜 f s` is smooth at `x₀` within `s`. -/ +lemma cont_diff_within_at.fderiv_within_right + (hf : cont_diff_within_at 𝕜 n f s x₀) (hs : unique_diff_on 𝕜 s) + (hmn : (m + 1 : ℕ∞) ≤ n) (hx₀s : x₀ ∈ s) : + cont_diff_within_at 𝕜 m (fderiv_within 𝕜 f s) s x₀ := +cont_diff_within_at.fderiv_within + (cont_diff_within_at.comp (x₀, x₀) hf cont_diff_within_at_snd $ prod_subset_preimage_snd s s) + cont_diff_within_at_id hs hmn hx₀s (by rw [preimage_id']) + +/-- `x ↦ fderiv 𝕜 (f x) (g x)` is smooth at `x₀`. -/ +lemma cont_diff_at.fderiv {f : E → F → G} {g : E → F} {n : ℕ∞} + (hf : cont_diff_at 𝕜 n (function.uncurry f) (x₀, g x₀)) + (hg : cont_diff_at 𝕜 m g x₀) + (hmn : m + 1 ≤ n) : + cont_diff_at 𝕜 m (λ x, fderiv 𝕜 (f x) (g x)) x₀ := +begin + simp_rw [← fderiv_within_univ], + refine (cont_diff_within_at.fderiv_within hf.cont_diff_within_at hg.cont_diff_within_at + unique_diff_on_univ hmn (mem_univ x₀) _).cont_diff_at univ_mem, + rw [preimage_univ] +end + +/-- `fderiv 𝕜 f` is smooth at `x₀`. -/ +lemma cont_diff_at.fderiv_right (hf : cont_diff_at 𝕜 n f x₀) (hmn : (m + 1 : ℕ∞) ≤ n) : + cont_diff_at 𝕜 m (fderiv 𝕜 f) x₀ := +cont_diff_at.fderiv (cont_diff_at.comp (x₀, x₀) hf cont_diff_at_snd) cont_diff_at_id hmn + +/-- `x ↦ fderiv 𝕜 (f x) (g x)` is smooth. -/ +lemma cont_diff.fderiv {f : E → F → G} {g : E → F} {n m : ℕ∞} + (hf : cont_diff 𝕜 m $ function.uncurry f) (hg : cont_diff 𝕜 n g) (hnm : n + 1 ≤ m) : + cont_diff 𝕜 n (λ x, fderiv 𝕜 (f x) (g x)) := +cont_diff_iff_cont_diff_at.mpr $ λ x, hf.cont_diff_at.fderiv hg.cont_diff_at hnm + +/-- `fderiv 𝕜 f` is smooth. -/ +lemma cont_diff.fderiv_right (hf : cont_diff 𝕜 n f) (hmn : (m + 1 : ℕ∞) ≤ n) : + cont_diff 𝕜 m (fderiv 𝕜 f) := +cont_diff_iff_cont_diff_at.mpr $ λ x, hf.cont_diff_at.fderiv_right hmn + +/-- `x ↦ fderiv 𝕜 (f x) (g x)` is continuous. -/ +lemma continuous.fderiv {f : E → F → G} {g : E → F} {n : ℕ∞} + (hf : cont_diff 𝕜 n $ function.uncurry f) (hg : continuous g) (hn : 1 ≤ n) : + continuous (λ x, fderiv 𝕜 (f x) (g x)) := +(hf.fderiv (cont_diff_zero.mpr hg) hn).continuous + +/-- `x ↦ fderiv 𝕜 (f x) (g x) (k x)` is smooth. -/ +lemma cont_diff.fderiv_apply {f : E → F → G} {g k : E → F} {n m : ℕ∞} + (hf : cont_diff 𝕜 m $ function.uncurry f) (hg : cont_diff 𝕜 n g) (hk : cont_diff 𝕜 n k) + (hnm : n + 1 ≤ m) : + cont_diff 𝕜 n (λ x, fderiv 𝕜 (f x) (g x) (k x)) := +(hf.fderiv hg hnm).clm_apply hk /-- The bundled derivative of a `C^{n+1}` function is `C^n`. -/ -lemma cont_diff_on_fderiv_within_apply {m n : with_top ℕ} {s : set E} +lemma cont_diff_on_fderiv_within_apply {m n : ℕ∞} {s : set E} {f : E → F} (hf : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hmn : m + 1 ≤ n) : - cont_diff_on 𝕜 m (λp : E × E, (fderiv_within 𝕜 f s p.1 : E →L[𝕜] F) p.2) - (s ×ˢ (univ : set E)) := -begin - have A : cont_diff 𝕜 m (λp : (E →L[𝕜] F) × E, p.1 p.2), - { apply is_bounded_bilinear_map.cont_diff, - exact is_bounded_bilinear_map_apply }, - have B : cont_diff_on 𝕜 m - (λ (p : E × E), ((fderiv_within 𝕜 f s p.fst), p.snd)) (s ×ˢ univ), - { apply cont_diff_on.prod _ _, - { have I : cont_diff_on 𝕜 m (λ (x : E), fderiv_within 𝕜 f s x) s := - hf.fderiv_within hs hmn, - have J : cont_diff_on 𝕜 m (λ (x : E × E), x.1) (s ×ˢ univ) := - cont_diff_fst.cont_diff_on, - exact cont_diff_on.comp I J (prod_subset_preimage_fst _ _) }, - { apply cont_diff.cont_diff_on _ , - apply is_bounded_linear_map.snd.cont_diff } }, - exact A.comp_cont_diff_on B -end + cont_diff_on 𝕜 m (λp : E × E, (fderiv_within 𝕜 f s p.1 : E →L[𝕜] F) p.2) (s ×ˢ univ) := +((hf.fderiv_within hs hmn).comp cont_diff_on_fst (prod_subset_preimage_fst _ _)).clm_apply + cont_diff_on_snd + +/-- If a function is at least `C^1`, its bundled derivative (mapping `(x, v)` to `Df(x) v`) is +continuous. -/ +lemma cont_diff_on.continuous_on_fderiv_within_apply + (hf : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hn : 1 ≤ n) : + continuous_on (λp : E × E, (fderiv_within 𝕜 f s p.1 : E → F) p.2) (s ×ˢ univ) := +(cont_diff_on_fderiv_within_apply hf hs $ by rwa [zero_add]).continuous_on /-- The bundled derivative of a `C^{n+1}` function is `C^n`. -/ lemma cont_diff.cont_diff_fderiv_apply {f : E → F} @@ -2190,8 +1210,8 @@ end section pi -variables {ι ι' : Type*} [fintype ι] [fintype ι'] {F' : ι → Type*} [Π i, normed_group (F' i)] - [Π i, normed_space 𝕜 (F' i)] {φ : Π i, E → F' i} +variables {ι ι' : Type*} [fintype ι] [fintype ι'] {F' : ι → Type*} + [Π i, normed_add_comm_group (F' i)] [Π i, normed_space 𝕜 (F' i)] {φ : Π i, E → F' i} {p' : Π i, E → formal_multilinear_series 𝕜 E (F' i)} {Φ : E → Π i, F' i} {P' : E → formal_multilinear_series 𝕜 E (Π i, F' i)} @@ -2261,6 +1281,8 @@ end pi /-! ### Sum of two functions -/ +section add + /- The sum is smooth. -/ lemma cont_diff_add : cont_diff 𝕜 n (λp : F × F, p.1 + p.2) := (is_bounded_linear_map.fst.add is_bounded_linear_map.snd).cont_diff @@ -2288,8 +1310,69 @@ lemma cont_diff_on.add {s : set E} {f g : E → F} cont_diff_on 𝕜 n (λx, f x + g x) s := λ x hx, (hf x hx).add (hg x hx) +variables {i : ℕ} + +/-- The iterated derivative of the sum of two functions is the sum of the iterated derivatives. +See also `iterated_fderiv_within_add_apply'`, which uses the spelling `(λ x, f x + g x)` +instead of `f + g`. -/ +lemma iterated_fderiv_within_add_apply {f g : E → F} + (hf : cont_diff_on 𝕜 i f s) (hg : cont_diff_on 𝕜 i g s) (hu : unique_diff_on 𝕜 s) + (hx : x ∈ s) : +iterated_fderiv_within 𝕜 i (f + g) s x = + iterated_fderiv_within 𝕜 i f s x + iterated_fderiv_within 𝕜 i g s x := +begin + induction i with i hi generalizing x, + { ext h, simp }, + { ext h, + have hi' : (i : ℕ∞) < i+1 := + with_top.coe_lt_coe.mpr (nat.lt_succ_self _), + have hdf : differentiable_on 𝕜 (iterated_fderiv_within 𝕜 i f s) s := + hf.differentiable_on_iterated_fderiv_within hi' hu, + have hdg : differentiable_on 𝕜 (iterated_fderiv_within 𝕜 i g s) s := + hg.differentiable_on_iterated_fderiv_within hi' hu, + have hcdf : cont_diff_on 𝕜 i f s := hf.of_le hi'.le, + have hcdg : cont_diff_on 𝕜 i g s := hg.of_le hi'.le, + calc iterated_fderiv_within 𝕜 (i+1) (f + g) s x h + = fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i (f + g) s) s x (h 0) (fin.tail h) : rfl + ... = fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i f s + iterated_fderiv_within 𝕜 i g s) s x + (h 0) (fin.tail h) : + by { rw [fderiv_within_congr' (λ _, hi hcdf hcdg) hx], refl } + ... = (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i f s) s + + fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i g s) s) x (h 0) (fin.tail h) : + by { rw [pi.add_def, fderiv_within_add (hu x hx) (hdf x hx) (hdg x hx)], refl } + ... = (iterated_fderiv_within 𝕜 (i+1) f s + iterated_fderiv_within 𝕜 (i+1) g s) x h : rfl } +end + +/-- The iterated derivative of the sum of two functions is the sum of the iterated derivatives. +This is the same as `iterated_fderiv_within_add_apply`, but using the spelling `(λ x, f x + g x)` +instead of `f + g`, which can be handy for some rewrites. +TODO: use one form consistently. -/ +lemma iterated_fderiv_within_add_apply' {f g : E → F} + (hf : cont_diff_on 𝕜 i f s) (hg : cont_diff_on 𝕜 i g s) (hu : unique_diff_on 𝕜 s) + (hx : x ∈ s) : +iterated_fderiv_within 𝕜 i (λ x, f x + g x) s x = + iterated_fderiv_within 𝕜 i f s x + iterated_fderiv_within 𝕜 i g s x := +iterated_fderiv_within_add_apply hf hg hu hx + +lemma iterated_fderiv_add_apply {i : ℕ} {f g : E → F} (hf : cont_diff 𝕜 i f) + (hg : cont_diff 𝕜 i g) : + iterated_fderiv 𝕜 i (f + g) x = iterated_fderiv 𝕜 i f x + iterated_fderiv 𝕜 i g x := +begin + simp_rw [←cont_diff_on_univ, ←iterated_fderiv_within_univ] at hf hg ⊢, + exact iterated_fderiv_within_add_apply hf hg unique_diff_on_univ (set.mem_univ _), +end + +lemma iterated_fderiv_add_apply' {i : ℕ} {f g : E → F} (hf : cont_diff 𝕜 i f) + (hg : cont_diff 𝕜 i g) : + iterated_fderiv 𝕜 i (λ x, f x + g x) x = iterated_fderiv 𝕜 i f x + iterated_fderiv 𝕜 i g x := +iterated_fderiv_add_apply hf hg + +end add + /-! ### Negative -/ +section neg + /- The negative is smooth. -/ lemma cont_diff_neg : cont_diff 𝕜 n (λp : F, -p) := is_bounded_linear_map.id.neg.cont_diff @@ -2314,6 +1397,34 @@ lemma cont_diff_on.neg {s : set E} {f : E → F} (hf : cont_diff_on 𝕜 n f s) : cont_diff_on 𝕜 n (λx, -f x) s := λ x hx, (hf x hx).neg +variables {i : ℕ} + +lemma iterated_fderiv_within_neg_apply {f : E → F} (hu : unique_diff_on 𝕜 s) (hx : x ∈ s) : + iterated_fderiv_within 𝕜 i (-f) s x = -iterated_fderiv_within 𝕜 i f s x := +begin + induction i with i hi generalizing x, + { ext h, simp }, + { ext h, + have hi' : (i : ℕ∞) < i+1 := + with_top.coe_lt_coe.mpr (nat.lt_succ_self _), + calc iterated_fderiv_within 𝕜 (i+1) (-f) s x h + = fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i (-f) s) s x (h 0) (fin.tail h) : rfl + ... = fderiv_within 𝕜 (-iterated_fderiv_within 𝕜 i f s) s x (h 0) (fin.tail h) : + by { rw [fderiv_within_congr' @hi hx], refl } + ... = -(fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i f s) s) x (h 0) (fin.tail h) : + by { rw [pi.neg_def, fderiv_within_neg (hu x hx)], refl } + ... = - (iterated_fderiv_within 𝕜 (i+1) f s) x h : rfl } +end + +lemma iterated_fderiv_neg_apply {i : ℕ} {f : E → F} : + iterated_fderiv 𝕜 i (-f) x = -iterated_fderiv 𝕜 i f x := +begin + simp_rw [←iterated_fderiv_within_univ], + exact iterated_fderiv_within_neg_apply unique_diff_on_univ (set.mem_univ _), +end + +end neg + /-! ### Subtraction -/ /-- The difference of two `C^n` functions within a set at a point is `C^n` within this set @@ -2370,77 +1481,116 @@ lemma cont_diff.sum {ι : Type*} {f : ι → E → F} {s : finset ι} (h : ∀ i ∈ s, cont_diff 𝕜 n (λ x, f i x)) : cont_diff 𝕜 n (λ x, (∑ i in s, f i x)) := -by simp [← cont_diff_on_univ] at *; exact cont_diff_on.sum h +by simp only [← cont_diff_on_univ] at *; exact cont_diff_on.sum h /-! ### Product of two functions -/ +section mul_prod + +variables {𝔸 𝔸' ι 𝕜' : Type*} [normed_ring 𝔸] [normed_algebra 𝕜 𝔸] + [normed_comm_ring 𝔸'] [normed_algebra 𝕜 𝔸'] [normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + /- The product is smooth. -/ -lemma cont_diff_mul : cont_diff 𝕜 n (λ p : 𝕜 × 𝕜, p.1 * p.2) := -is_bounded_bilinear_map_mul.cont_diff +lemma cont_diff_mul : cont_diff 𝕜 n (λ p : 𝔸 × 𝔸, p.1 * p.2) := +(continuous_linear_map.mul 𝕜 𝔸).is_bounded_bilinear_map.cont_diff /-- The product of two `C^n` functions within a set at a point is `C^n` within this set at this point. -/ -lemma cont_diff_within_at.mul {s : set E} {f g : E → 𝕜} +lemma cont_diff_within_at.mul {s : set E} {f g : E → 𝔸} (hf : cont_diff_within_at 𝕜 n f s x) (hg : cont_diff_within_at 𝕜 n g s x) : cont_diff_within_at 𝕜 n (λ x, f x * g x) s x := -cont_diff_mul.cont_diff_within_at.comp x (hf.prod hg) subset_preimage_univ +cont_diff_mul.comp_cont_diff_within_at (hf.prod hg) /-- The product of two `C^n` functions at a point is `C^n` at this point. -/ -lemma cont_diff_at.mul {f g : E → 𝕜} - (hf : cont_diff_at 𝕜 n f x) (hg : cont_diff_at 𝕜 n g x) : +lemma cont_diff_at.mul {f g : E → 𝔸} (hf : cont_diff_at 𝕜 n f x) (hg : cont_diff_at 𝕜 n g x) : cont_diff_at 𝕜 n (λ x, f x * g x) x := -by rw [← cont_diff_within_at_univ] at *; exact hf.mul hg +hf.mul hg /-- The product of two `C^n` functions on a domain is `C^n`. -/ -lemma cont_diff_on.mul {s : set E} {f g : E → 𝕜} - (hf : cont_diff_on 𝕜 n f s) (hg : cont_diff_on 𝕜 n g s) : +lemma cont_diff_on.mul {f g : E → 𝔸} (hf : cont_diff_on 𝕜 n f s) (hg : cont_diff_on 𝕜 n g s) : cont_diff_on 𝕜 n (λ x, f x * g x) s := λ x hx, (hf x hx).mul (hg x hx) /-- The product of two `C^n`functions is `C^n`. -/ -lemma cont_diff.mul {f g : E → 𝕜} (hf : cont_diff 𝕜 n f) (hg : cont_diff 𝕜 n g) : +lemma cont_diff.mul {f g : E → 𝔸} (hf : cont_diff 𝕜 n f) (hg : cont_diff 𝕜 n g) : cont_diff 𝕜 n (λ x, f x * g x) := cont_diff_mul.comp (hf.prod hg) -lemma cont_diff_within_at.div_const {f : E → 𝕜} {n} {c : 𝕜} - (hf : cont_diff_within_at 𝕜 n f s x) : - cont_diff_within_at 𝕜 n (λ x, f x / c) s x := -by simpa only [div_eq_mul_inv] using hf.mul cont_diff_within_at_const +lemma cont_diff_within_at_prod' {t : finset ι} {f : ι → E → 𝔸'} + (h : ∀ i ∈ t, cont_diff_within_at 𝕜 n (f i) s x) : + cont_diff_within_at 𝕜 n (∏ i in t, f i) s x := +finset.prod_induction f (λ f, cont_diff_within_at 𝕜 n f s x) (λ _ _, cont_diff_within_at.mul) + (@cont_diff_within_at_const _ _ _ _ _ _ _ _ _ _ _ 1) h -lemma cont_diff_at.div_const {f : E → 𝕜} {n} {c : 𝕜} (hf : cont_diff_at 𝕜 n f x) : - cont_diff_at 𝕜 n (λ x, f x / c) x := -by simpa only [div_eq_mul_inv] using hf.mul cont_diff_at_const +lemma cont_diff_within_at_prod {t : finset ι} {f : ι → E → 𝔸'} + (h : ∀ i ∈ t, cont_diff_within_at 𝕜 n (f i) s x) : + cont_diff_within_at 𝕜 n (λ y, ∏ i in t, f i y) s x := +by simpa only [← finset.prod_apply] using cont_diff_within_at_prod' h -lemma cont_diff_on.div_const {f : E → 𝕜} {n} {c : 𝕜} (hf : cont_diff_on 𝕜 n f s) : - cont_diff_on 𝕜 n (λ x, f x / c) s := -by simpa only [div_eq_mul_inv] using hf.mul cont_diff_on_const +lemma cont_diff_at_prod' {t : finset ι} {f : ι → E → 𝔸'} (h : ∀ i ∈ t, cont_diff_at 𝕜 n (f i) x) : + cont_diff_at 𝕜 n (∏ i in t, f i) x := +cont_diff_within_at_prod' h -lemma cont_diff.div_const {f : E → 𝕜} {n} {c : 𝕜} (hf : cont_diff 𝕜 n f) : - cont_diff 𝕜 n (λ x, f x / c) := -by simpa only [div_eq_mul_inv] using hf.mul cont_diff_const +lemma cont_diff_at_prod {t : finset ι} {f : ι → E → 𝔸'} (h : ∀ i ∈ t, cont_diff_at 𝕜 n (f i) x) : + cont_diff_at 𝕜 n (λ y, ∏ i in t, f i y) x := +cont_diff_within_at_prod h + +lemma cont_diff_on_prod' {t : finset ι} {f : ι → E → 𝔸'} (h : ∀ i ∈ t, cont_diff_on 𝕜 n (f i) s) : + cont_diff_on 𝕜 n (∏ i in t, f i) s := +λ x hx, cont_diff_within_at_prod' (λ i hi, h i hi x hx) + +lemma cont_diff_on_prod {t : finset ι} {f : ι → E → 𝔸'} (h : ∀ i ∈ t, cont_diff_on 𝕜 n (f i) s) : + cont_diff_on 𝕜 n (λ y, ∏ i in t, f i y) s := +λ x hx, cont_diff_within_at_prod (λ i hi, h i hi x hx) -lemma cont_diff.pow {f : E → 𝕜} - (hf : cont_diff 𝕜 n f) : +lemma cont_diff_prod' {t : finset ι} {f : ι → E → 𝔸'} (h : ∀ i ∈ t, cont_diff 𝕜 n (f i)) : + cont_diff 𝕜 n (∏ i in t, f i) := +cont_diff_iff_cont_diff_at.mpr $ λ x, cont_diff_at_prod' $ λ i hi, (h i hi).cont_diff_at + +lemma cont_diff_prod {t : finset ι} {f : ι → E → 𝔸'} (h : ∀ i ∈ t, cont_diff 𝕜 n (f i)) : + cont_diff 𝕜 n (λ y, ∏ i in t, f i y) := +cont_diff_iff_cont_diff_at.mpr $ λ x, cont_diff_at_prod $ λ i hi, (h i hi).cont_diff_at + +lemma cont_diff.pow {f : E → 𝔸} (hf : cont_diff 𝕜 n f) : ∀ m : ℕ, cont_diff 𝕜 n (λ x, (f x) ^ m) | 0 := by simpa using cont_diff_const | (m + 1) := by simpa [pow_succ] using hf.mul (cont_diff.pow m) -lemma cont_diff_at.pow {f : E → 𝕜} (hf : cont_diff_at 𝕜 n f x) - (m : ℕ) : cont_diff_at 𝕜 n (λ y, f y ^ m) x := -(cont_diff_id.pow m).cont_diff_at.comp x hf - -lemma cont_diff_within_at.pow {f : E → 𝕜} - (hf : cont_diff_within_at 𝕜 n f s x) (m : ℕ) : +lemma cont_diff_within_at.pow {f : E → 𝔸} (hf : cont_diff_within_at 𝕜 n f s x) (m : ℕ) : cont_diff_within_at 𝕜 n (λ y, f y ^ m) s x := -(cont_diff_id.pow m).cont_diff_at.comp_cont_diff_within_at x hf +(cont_diff_id.pow m).comp_cont_diff_within_at hf -lemma cont_diff_on.pow {f : E → 𝕜} - (hf : cont_diff_on 𝕜 n f s) (m : ℕ) : +lemma cont_diff_at.pow {f : E → 𝔸} (hf : cont_diff_at 𝕜 n f x) (m : ℕ) : + cont_diff_at 𝕜 n (λ y, f y ^ m) x := +hf.pow m + +lemma cont_diff_on.pow {f : E → 𝔸} (hf : cont_diff_on 𝕜 n f s) (m : ℕ) : cont_diff_on 𝕜 n (λ y, f y ^ m) s := λ y hy, (hf y hy).pow m +lemma cont_diff_within_at.div_const {f : E → 𝕜'} {n} + (hf : cont_diff_within_at 𝕜 n f s x) (c : 𝕜') : + cont_diff_within_at 𝕜 n (λ x, f x / c) s x := +by simpa only [div_eq_mul_inv] using hf.mul cont_diff_within_at_const + +lemma cont_diff_at.div_const {f : E → 𝕜'} {n} (hf : cont_diff_at 𝕜 n f x) (c : 𝕜') : + cont_diff_at 𝕜 n (λ x, f x / c) x := +hf.div_const c + +lemma cont_diff_on.div_const {f : E → 𝕜'} {n} (hf : cont_diff_on 𝕜 n f s) (c : 𝕜') : + cont_diff_on 𝕜 n (λ x, f x / c) s := +λ x hx, (hf x hx).div_const c + +lemma cont_diff.div_const {f : E → 𝕜'} {n} (hf : cont_diff 𝕜 n f) (c : 𝕜') : + cont_diff 𝕜 n (λ x, f x / c) := +by simpa only [div_eq_mul_inv] using hf.mul cont_diff_const + +end mul_prod + /-! ### Scalar multiplication -/ +section smul + /- The scalar multiplication is smooth. -/ lemma cont_diff_smul : cont_diff 𝕜 n (λ p : 𝕜 × F, p.1 • p.2) := is_bounded_bilinear_map_smul.cont_diff @@ -2469,11 +1619,78 @@ lemma cont_diff_on.smul {s : set E} {f : E → 𝕜} {g : E → F} cont_diff_on 𝕜 n (λ x, f x • g x) s := λ x hx, (hf x hx).smul (hg x hx) +end smul + +/-! ### Constant scalar multiplication -/ + +section const_smul + +variables {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] +variables [has_continuous_const_smul R F] + +/- The scalar multiplication with a constant is smooth. -/ +lemma cont_diff_const_smul (c : R) : cont_diff 𝕜 n (λ p : F, c • p) := +(c • continuous_linear_map.id 𝕜 F).cont_diff + +/-- The scalar multiplication of a constant and a `C^n` function within a set at a point is `C^n` +within this set at this point. -/ +lemma cont_diff_within_at.const_smul {s : set E} {f : E → F} {x : E} (c : R) + (hf : cont_diff_within_at 𝕜 n f s x) : cont_diff_within_at 𝕜 n (λ y, c • f y) s x := +(cont_diff_const_smul c).cont_diff_at.comp_cont_diff_within_at x hf + +/-- The scalar multiplication of a constant and a `C^n` function at a point is `C^n` at this +point. -/ +lemma cont_diff_at.const_smul {f : E → F} {x : E} (c : R) + (hf : cont_diff_at 𝕜 n f x) : cont_diff_at 𝕜 n (λ y, c • f y) x := +by rw [←cont_diff_within_at_univ] at *; exact hf.const_smul c + +/-- The scalar multiplication of a constant and a `C^n` function is `C^n`. -/ +lemma cont_diff.const_smul {f : E → F} (c : R) + (hf : cont_diff 𝕜 n f) : cont_diff 𝕜 n (λ y, c • f y) := +(cont_diff_const_smul c).comp hf + +/-- The scalar multiplication of a constant and a `C^n` on a domain is `C^n`. -/ +lemma cont_diff_on.const_smul {s : set E} {f : E → F} (c : R) + (hf : cont_diff_on 𝕜 n f s) : cont_diff_on 𝕜 n (λ y, c • f y) s := +λ x hx, (hf x hx).const_smul c + +variables {i : ℕ} {a : R} + +lemma iterated_fderiv_within_const_smul_apply (hf : cont_diff_on 𝕜 i f s) + (hu : unique_diff_on 𝕜 s) (hx : x ∈ s) : +iterated_fderiv_within 𝕜 i (a • f) s x = a • (iterated_fderiv_within 𝕜 i f s x) := +begin + induction i with i hi generalizing x, + { ext, simp }, + { ext h, + have hi' : (i : ℕ∞) < i+1 := + with_top.coe_lt_coe.mpr (nat.lt_succ_self _), + have hdf : differentiable_on 𝕜 (iterated_fderiv_within 𝕜 i f s) s := + hf.differentiable_on_iterated_fderiv_within hi' hu, + have hcdf : cont_diff_on 𝕜 i f s := hf.of_le hi'.le, + calc iterated_fderiv_within 𝕜 (i+1) (a • f) s x h + = fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i (a • f) s) s x (h 0) (fin.tail h) : rfl + ... = fderiv_within 𝕜 (a • iterated_fderiv_within 𝕜 i f s) s x (h 0) (fin.tail h) : + by { rw [fderiv_within_congr' (λ _, hi hcdf) hx], refl } + ... = (a • fderiv_within 𝕜 (iterated_fderiv_within 𝕜 i f s)) s x (h 0) (fin.tail h) : + by { rw [pi.smul_def, fderiv_within_const_smul (hu x hx) (hdf x hx)], refl } + ... = a • iterated_fderiv_within 𝕜 (i+1) f s x h : rfl } +end + +lemma iterated_fderiv_const_smul_apply {x : E} (hf : cont_diff 𝕜 i f) : + iterated_fderiv 𝕜 i (a • f) x = a • iterated_fderiv 𝕜 i f x := +begin + simp_rw [←cont_diff_on_univ, ←iterated_fderiv_within_univ] at *, + refine iterated_fderiv_within_const_smul_apply hf unique_diff_on_univ (set.mem_univ _), +end + +end const_smul + /-! ### Cartesian product of two functions -/ section prod_map -variables {E' : Type*} [normed_group E'] [normed_space 𝕜 E'] -variables {F' : Type*} [normed_group F'] [normed_space 𝕜 F'] +variables {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E'] +variables {F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜 F'] /-- The product map of two `C^n` functions within a set at a point is `C^n` within the product set at the product point. -/ @@ -2491,8 +1708,8 @@ lemma cont_diff_within_at.prod_map cont_diff_within_at.prod_map' hf hg /-- The product map of two `C^n` functions on a set is `C^n` on the product set. -/ -lemma cont_diff_on.prod_map {E' : Type*} [normed_group E'] [normed_space 𝕜 E'] - {F' : Type*} [normed_group F'] [normed_space 𝕜 F'] +lemma cont_diff_on.prod_map {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E'] + {F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜 F'] {s : set E} {t : set E'} {f : E → F} {g : E' → F'} (hf : cont_diff_on 𝕜 n f s) (hg : cont_diff_on 𝕜 n g t) : cont_diff_on 𝕜 n (prod.map f g) (s ×ˢ t) := @@ -2549,7 +1766,7 @@ derivative of inversion as a bilinear map of inversion itself. -/ lemma cont_diff_at_ring_inverse [complete_space R] (x : Rˣ) : cont_diff_at 𝕜 n ring.inverse (x : R) := begin - induction n using with_top.nat_induction with n IH Itop, + induction n using enat.nat_induction with n IH Itop, { intros m hm, refine ⟨{y : R | is_unit y}, _, _⟩, { simp [nhds_within_univ], @@ -2561,12 +1778,12 @@ begin exact (inverse_continuous_at x').continuous_within_at }, { simp [ftaylor_series_within] } } }, { apply cont_diff_at_succ_iff_has_fderiv_at.mpr, - refine ⟨λ (x : R), - lmul_left_right 𝕜 R (inverse x) (inverse x), _, _⟩, + refine ⟨λ (x : R), - mul_left_right 𝕜 R (inverse x) (inverse x), _, _⟩, { refine ⟨{y : R | is_unit y}, x.nhds, _⟩, rintros _ ⟨y, rfl⟩, rw [inverse_unit], exact has_fderiv_at_ring_inverse y }, - { convert (lmul_left_right_is_bounded_bilinear 𝕜 R).cont_diff.neg.comp_cont_diff_at + { convert (mul_left_right_is_bounded_bilinear 𝕜 R).cont_diff.neg.comp_cont_diff_at (x : R) (IH.prod IH) } }, { exact cont_diff_at_top.mpr Itop } end @@ -2653,12 +1870,8 @@ begin rw this, -- `O₁` and `O₂` are `cont_diff`, -- so we reduce to proving that `ring.inverse` is `cont_diff` - have h₁ : cont_diff 𝕜 n O₁, - from is_bounded_bilinear_map_comp.cont_diff.comp - (cont_diff_const.prod cont_diff_id), - have h₂ : cont_diff 𝕜 n O₂, - from is_bounded_bilinear_map_comp.cont_diff.comp - (cont_diff_id.prod cont_diff_const), + have h₁ : cont_diff 𝕜 n O₁ := cont_diff_id.clm_comp cont_diff_const, + have h₂ : cont_diff 𝕜 n O₂ := cont_diff_const.clm_comp cont_diff_id, refine h₁.cont_diff_at.comp _ (cont_diff_at.comp _ _ h₂.cont_diff_at), convert cont_diff_at_ring_inverse 𝕜 (1 : (E →L[𝕜] E)ˣ), simp [O₂, one_def] @@ -2682,7 +1895,7 @@ theorem local_homeomorph.cont_diff_at_symm [complete_space E] cont_diff_at 𝕜 n f.symm a := begin -- We prove this by induction on `n` - induction n using with_top.nat_induction with n IH Itop, + induction n using enat.nat_induction with n IH Itop, { rw cont_diff_at_zero, exact ⟨f.target, is_open.mem_nhds f.open_target ha, f.continuous_inv_fun⟩ }, { obtain ⟨f', ⟨u, hu, hff'⟩, hf'⟩ := cont_diff_at_succ_iff_has_fderiv_at.mp hf, @@ -2725,7 +1938,19 @@ begin exact Itop n (cont_diff_at_top.mp hf n) } end -/-- Let `f` be a local homeomorphism of a nondiscrete normed field, let `a` be a point in its +/-- If `f` is an `n` times continuously differentiable homeomorphism, +and if the derivative of `f` at each point is a continuous linear equivalence, +then `f.symm` is `n` times continuously differentiable. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +theorem homeomorph.cont_diff_symm [complete_space E] (f : E ≃ₜ F) {f₀' : E → E ≃L[𝕜] F} + (hf₀' : ∀ a, has_fderiv_at f (f₀' a : E →L[𝕜] F) a) (hf : cont_diff 𝕜 n (f : E → F)) : + cont_diff 𝕜 n (f.symm : F → E) := +cont_diff_iff_cont_diff_at.2 $ λ x, + f.to_local_homeomorph.cont_diff_at_symm (mem_univ x) (hf₀' _) hf.cont_diff_at + +/-- Let `f` be a local homeomorphism of a nontrivially normed field, let `a` be a point in its target. if `f` is `n` times continuously differentiable at `f.symm a`, and if the derivative at `f.symm a` is nonzero, then `f.symm` is `n` times continuously differentiable at the point `a`. @@ -2737,6 +1962,18 @@ theorem local_homeomorph.cont_diff_at_symm_deriv [complete_space 𝕜] cont_diff_at 𝕜 n f.symm a := f.cont_diff_at_symm ha (hf₀'.has_fderiv_at_equiv h₀) hf +/-- Let `f` be an `n` times continuously differentiable homeomorphism of a nontrivially normed +field. Suppose that the derivative of `f` is never equal to zero. Then `f.symm` is `n` times +continuously differentiable. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +theorem homeomorph.cont_diff_symm_deriv [complete_space 𝕜] (f : 𝕜 ≃ₜ 𝕜) {f' : 𝕜 → 𝕜} + (h₀ : ∀ x, f' x ≠ 0) (hf' : ∀ x, has_deriv_at f (f' x) x) (hf : cont_diff 𝕜 n (f : 𝕜 → 𝕜)) : + cont_diff 𝕜 n (f.symm : 𝕜 → 𝕜) := +cont_diff_iff_cont_diff_at.2 $ λ x, + f.to_local_homeomorph.cont_diff_at_symm_deriv (h₀ _) (mem_univ x) (hf' _) hf.cont_diff_at + end function_inverse @@ -2747,11 +1984,11 @@ open function finite_dimensional variables [complete_space 𝕜] /-- A family of continuous linear maps is `C^n` on `s` if all its applications are. -/ -lemma cont_diff_on_clm_apply {n : with_top ℕ} {f : E → F →L[𝕜] G} +lemma cont_diff_on_clm_apply {n : ℕ∞} {f : E → F →L[𝕜] G} {s : set E} [finite_dimensional 𝕜 F] : cont_diff_on 𝕜 n f s ↔ ∀ y, cont_diff_on 𝕜 n (λ x, f x y) s := begin - refine ⟨λ h y, (continuous_linear_map.apply 𝕜 G y).cont_diff.comp_cont_diff_on h, λ h, _⟩, + refine ⟨λ h y, h.clm_apply cont_diff_on_const, λ h, _⟩, let d := finrank 𝕜 F, have hd : d = finrank 𝕜 (fin d → 𝕜) := (finrank_fin_fun 𝕜).symm, let e₁ := continuous_linear_equiv.of_finrank_eq hd, @@ -2760,7 +1997,7 @@ begin exact e₂.symm.cont_diff.comp_cont_diff_on (cont_diff_on_pi.mpr (λ i, h _)) end -lemma cont_diff_clm_apply {n : with_top ℕ} {f : E → F →L[𝕜] G} [finite_dimensional 𝕜 F] : +lemma cont_diff_clm_apply_iff {n : ℕ∞} {f : E → F →L[𝕜] G} [finite_dimensional 𝕜 F] : cont_diff 𝕜 n f ↔ ∀ y, cont_diff 𝕜 n (λ x, f x y) := by simp_rw [← cont_diff_on_univ, cont_diff_on_clm_apply] @@ -2776,7 +2013,7 @@ This lemma avoids these universe issues, but only applies for finite dimensional lemma cont_diff_succ_iff_fderiv_apply [finite_dimensional 𝕜 E] {n : ℕ} {f : E → F} : cont_diff 𝕜 ((n + 1) : ℕ) f ↔ differentiable 𝕜 f ∧ ∀ y, cont_diff 𝕜 n (λ x, fderiv 𝕜 f x y) := -by rw [cont_diff_succ_iff_fderiv, cont_diff_clm_apply] +by rw [cont_diff_succ_iff_fderiv, cont_diff_clm_apply_iff] lemma cont_diff_on_succ_of_fderiv_apply [finite_dimensional 𝕜 E] {n : ℕ} {f : E → F} {s : set E} (hf : differentiable_on 𝕜 f s) @@ -2801,8 +2038,8 @@ section real variables {𝕂 : Type*} [is_R_or_C 𝕂] -{E' : Type*} [normed_group E'] [normed_space 𝕂 E'] -{F' : Type*} [normed_group F'] [normed_space 𝕂 F'] +{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕂 E'] +{F' : Type*} [normed_add_comm_group F'] [normed_space 𝕂 F'] /-- If a function has a Taylor series at order at least 1, then at points in the interior of the domain of definition, the term of order 1 of this series is a strict derivative of `f`. -/ @@ -2861,12 +2098,12 @@ lemma cont_diff.has_strict_deriv_at hf.cont_diff_at.has_strict_deriv_at hn /-- If `f` has a formal Taylor series `p` up to order `1` on `{x} ∪ s`, where `s` is a convex set, -and `∥p x 1∥₊ < K`, then `f` is `K`-Lipschitz in a neighborhood of `x` within `s`. -/ +and `‖p x 1‖₊ < K`, then `f` is `K`-Lipschitz in a neighborhood of `x` within `s`. -/ lemma has_ftaylor_series_up_to_on.exists_lipschitz_on_with_of_nnnorm_lt {E F : Type*} - [normed_group E] [normed_space ℝ E] [normed_group F] [normed_space ℝ F] {f : E → F} - {p : E → formal_multilinear_series ℝ E F} {s : set E} {x : E} + [normed_add_comm_group E] [normed_space ℝ E] [normed_add_comm_group F] [normed_space ℝ F] + {f : E → F} {p : E → formal_multilinear_series ℝ E F} {s : set E} {x : E} (hf : has_ftaylor_series_up_to_on 1 f p (insert x s)) (hs : convex ℝ s) (K : ℝ≥0) - (hK : ∥p x 1∥₊ < K) : + (hK : ‖p x 1‖₊ < K) : ∃ t ∈ 𝓝[s] x, lipschitz_on_with K f t := begin set f' := λ y, continuous_multilinear_curry_fin1 ℝ E F (p y 1), @@ -2875,15 +2112,15 @@ begin have hcont : continuous_within_at f' s x, from (continuous_multilinear_curry_fin1 ℝ E F).continuous_at.comp_continuous_within_at ((hf.cont _ le_rfl _ (mem_insert _ _)).mono (subset_insert x s)), - replace hK : ∥f' x∥₊ < K, by simpa only [linear_isometry_equiv.nnnorm_map], + replace hK : ‖f' x‖₊ < K, by simpa only [linear_isometry_equiv.nnnorm_map], exact hs.exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at_of_nnnorm_lt (eventually_nhds_within_iff.2 $ eventually_of_forall hder) hcont K hK end /-- If `f` has a formal Taylor series `p` up to order `1` on `{x} ∪ s`, where `s` is a convex set, then `f` is Lipschitz in a neighborhood of `x` within `s`. -/ -lemma has_ftaylor_series_up_to_on.exists_lipschitz_on_with {E F : Type*} - [normed_group E] [normed_space ℝ E] [normed_group F] [normed_space ℝ F] {f : E → F} +lemma has_ftaylor_series_up_to_on.exists_lipschitz_on_with {E F : Type*} [normed_add_comm_group E] + [normed_space ℝ E] [normed_add_comm_group F] [normed_space ℝ F] {f : E → F} {p : E → formal_multilinear_series ℝ E F} {s : set E} {x : E} (hf : has_ftaylor_series_up_to_on 1 f p (insert x s)) (hs : convex ℝ s) : ∃ K (t ∈ 𝓝[s] x), lipschitz_on_with K f t := @@ -2891,8 +2128,8 @@ lemma has_ftaylor_series_up_to_on.exists_lipschitz_on_with {E F : Type*} /-- If `f` is `C^1` within a conves set `s` at `x`, then it is Lipschitz on a neighborhood of `x` within `s`. -/ -lemma cont_diff_within_at.exists_lipschitz_on_with {E F : Type*} [normed_group E] - [normed_space ℝ E] [normed_group F] [normed_space ℝ F] {f : E → F} {s : set E} +lemma cont_diff_within_at.exists_lipschitz_on_with {E F : Type*} [normed_add_comm_group E] + [normed_space ℝ E] [normed_add_comm_group F] [normed_space ℝ F] {f : E → F} {s : set E} {x : E} (hf : cont_diff_within_at ℝ 1 f s x) (hs : convex ℝ s) : ∃ (K : ℝ≥0) (t ∈ 𝓝[s] x), lipschitz_on_with K f t := begin @@ -2906,10 +2143,10 @@ begin exact ⟨K, t, hst, hft⟩ end -/-- If `f` is `C^1` at `x` and `K > ∥fderiv 𝕂 f x∥`, then `f` is `K`-Lipschitz in a neighborhood of +/-- If `f` is `C^1` at `x` and `K > ‖fderiv 𝕂 f x‖`, then `f` is `K`-Lipschitz in a neighborhood of `x`. -/ lemma cont_diff_at.exists_lipschitz_on_with_of_nnnorm_lt {f : E' → F'} {x : E'} - (hf : cont_diff_at 𝕂 1 f x) (K : ℝ≥0) (hK : ∥fderiv 𝕂 f x∥₊ < K) : + (hf : cont_diff_at 𝕂 1 f x) (K : ℝ≥0) (hK : ‖fderiv 𝕂 f x‖₊ < K) : ∃ t ∈ 𝓝 x, lipschitz_on_with K f t := (hf.has_strict_fderiv_at le_rfl).exists_lipschitz_on_with_of_nnnorm_lt K hK @@ -2965,11 +2202,8 @@ theorem cont_diff_on_succ_iff_deriv_of_open {n : ℕ} (hs : is_open s₂) : differentiable_on 𝕜 f₂ s₂ ∧ cont_diff_on 𝕜 n (deriv f₂) s₂ := begin rw cont_diff_on_succ_iff_deriv_within hs.unique_diff_on, - congr' 2, - rw ← iff_iff_eq, - apply cont_diff_on_congr, - assume x hx, - exact deriv_within_of_open hs hx + congrm _ ∧ _, + exact cont_diff_on_congr (λ _, deriv_within_of_open hs) end /-- A function is `C^∞` on a domain with unique derivatives if and only if it is differentiable @@ -2985,7 +2219,7 @@ begin exact h.of_le le_top }, { assume h, refine cont_diff_on_top.2 (λ n, _), - have A : (n : with_top ℕ) ≤ ∞ := le_top, + have A : (n : ℕ∞) ≤ ∞ := le_top, apply ((cont_diff_on_succ_iff_deriv_within hs).2 ⟨h.1, h.2.of_le A⟩).of_le, exact with_top.coe_le_coe.2 (nat.le_succ n) } end @@ -2997,11 +2231,8 @@ theorem cont_diff_on_top_iff_deriv_of_open (hs : is_open s₂) : differentiable_on 𝕜 f₂ s₂ ∧ cont_diff_on 𝕜 ∞ (deriv f₂) s₂ := begin rw cont_diff_on_top_iff_deriv_within hs.unique_diff_on, - congr' 2, - rw ← iff_iff_eq, - apply cont_diff_on_congr, - assume x hx, - exact deriv_within_of_open hs hx + congrm _ ∧ _, + exact cont_diff_on_congr (λ _, deriv_within_of_open hs) end lemma cont_diff_on.deriv_within @@ -3013,7 +2244,7 @@ begin have : n = ∞, by simpa using hmn, rw this at hf, exact ((cont_diff_on_top_iff_deriv_within hs).1 hf).2 }, - { change (m.succ : with_top ℕ) ≤ n at hmn, + { change (m.succ : ℕ∞) ≤ n at hmn, exact ((cont_diff_on_succ_iff_deriv_within hs).1 (hf.of_le hmn)).2 } end @@ -3050,8 +2281,7 @@ theorem cont_diff_top_iff_deriv : cont_diff 𝕜 ∞ f₂ ↔ differentiable 𝕜 f₂ ∧ cont_diff 𝕜 ∞ (deriv f₂) := begin - simp [cont_diff_on_univ.symm, differentiable_on_univ.symm, deriv_within_univ.symm, - - deriv_within_univ], + simp only [← cont_diff_on_univ, ← differentiable_on_univ, ← deriv_within_univ], rw cont_diff_on_top_iff_deriv_within unique_diff_on_univ, end @@ -3059,6 +2289,16 @@ lemma cont_diff.continuous_deriv (h : cont_diff 𝕜 n f₂) (hn : 1 ≤ n) : continuous (deriv f₂) := (cont_diff_succ_iff_deriv.mp (h.of_le hn)).2.continuous +lemma cont_diff.iterate_deriv : + ∀ (n : ℕ) {f₂ : 𝕜 → F} (hf : cont_diff 𝕜 ∞ f₂), cont_diff 𝕜 ∞ (deriv^[n] f₂) +| 0 f₂ hf := hf +| (n + 1) f₂ hf := cont_diff.iterate_deriv n (cont_diff_top_iff_deriv.mp hf).2 + +lemma cont_diff.iterate_deriv' (n : ℕ) : + ∀ (k : ℕ) {f₂ : 𝕜 → F} (hf : cont_diff 𝕜 (n + k : ℕ) f₂), cont_diff 𝕜 n (deriv^[k] f₂) +| 0 f₂ hf := hf +| (n + 1) f₂ hf := cont_diff.iterate_deriv' n (cont_diff_succ_iff_deriv.mp hf).2 + end deriv section restrict_scalars @@ -3071,7 +2311,7 @@ situation where `ℂ` and `ℝ` are replaced respectively by `𝕜'` and `𝕜` over `𝕜`. -/ -variables (𝕜) {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] +variables (𝕜) {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] variables [normed_space 𝕜' E] [is_scalar_tower 𝕜 𝕜' E] variables [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] variables {p' : E → formal_multilinear_series 𝕜' E F} @@ -3110,3 +2350,542 @@ lemma cont_diff.restrict_scalars (h : cont_diff 𝕜' n f) : cont_diff_iff_cont_diff_at.2 $ λ x, h.cont_diff_at.restrict_scalars _ end restrict_scalars + +/-!## Quantitative bounds -/ + +/-- Bounding the norm of the iterated derivative of `B (f x) (g x)` within a set in terms of the +iterated derivatives of `f` and `g` when `B` is bilinear. This lemma is an auxiliary version +assuming all spaces live in the same universe, to enable an induction. Use instead +`continuous_linear_map.norm_iterated_fderiv_within_le_of_bilinear` that removes this assumption. -/ +lemma continuous_linear_map.norm_iterated_fderiv_within_le_of_bilinear_aux + {Du Eu Fu Gu : Type u} + [normed_add_comm_group Du] [normed_space 𝕜 Du] + [normed_add_comm_group Eu] [normed_space 𝕜 Eu] + [normed_add_comm_group Fu] [normed_space 𝕜 Fu] + [normed_add_comm_group Gu] [normed_space 𝕜 Gu] + (B : Eu →L[𝕜] Fu →L[𝕜] Gu) {f : Du → Eu} {g : Du → Fu} {n : ℕ} {s : set Du} {x : Du} + (hf : cont_diff_on 𝕜 n f s) (hg : cont_diff_on 𝕜 n g s) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : + ‖iterated_fderiv_within 𝕜 n (λ y, B (f y) (g y)) s x‖ + ≤ ‖B‖ * ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv_within 𝕜 i f s x‖ * ‖iterated_fderiv_within 𝕜 (n-i) g s x‖ := +begin + /- We argue by induction on `n`. The bound is trivial for `n = 0`. For `n + 1`, we write + the `(n+1)`-th derivative as the `n`-th derivative of the derivative `B f g' + B f' g`, and apply + the inductive assumption to each of those two terms. For this induction to make sense, + the spaces of linear maps that appear in the induction should be in the same universe as the + original spaces, which explains why we assume in the lemma that all spaces live in the same + universe. -/ + unfreezingI { induction n with n IH generalizing Eu Fu Gu}, + { simp only [←mul_assoc, norm_iterated_fderiv_within_zero, finset.range_one, finset.sum_singleton, + nat.choose_self, algebra_map.coe_one, one_mul], + apply ((B (f x)).le_op_norm (g x)).trans, + apply mul_le_mul_of_nonneg_right _ (norm_nonneg _), + exact B.le_op_norm (f x) }, + { have In : (n : ℕ∞) + 1 ≤ n.succ, by simp only [nat.cast_succ, le_refl], + have I1 : + ‖iterated_fderiv_within 𝕜 n (λ (y : Du), B.precompR Du (f y) (fderiv_within 𝕜 g s y)) s x‖ ≤ + ‖B‖ * ∑ (i : ℕ) in finset.range (n + 1), n.choose i * + ‖iterated_fderiv_within 𝕜 i f s x‖ * ‖iterated_fderiv_within 𝕜 (n + 1 - i) g s x‖ := calc + ‖iterated_fderiv_within 𝕜 n (λ (y : Du), B.precompR Du (f y) (fderiv_within 𝕜 g s y)) s x‖ + ≤ ‖B.precompR Du‖ * ∑ (i : ℕ) in finset.range (n + 1), n.choose i + * ‖iterated_fderiv_within 𝕜 i f s x‖ + * ‖iterated_fderiv_within 𝕜 (n - i) (fderiv_within 𝕜 g s) s x‖ : + IH _ (hf.of_le (nat.cast_le.2 (nat.le_succ n))) (hg.fderiv_within hs In) + ... ≤ ‖B‖ * ∑ (i : ℕ) in finset.range (n + 1), n.choose i + * ‖iterated_fderiv_within 𝕜 i f s x‖ + * ‖iterated_fderiv_within 𝕜 (n - i) (fderiv_within 𝕜 g s) s x‖ : + mul_le_mul_of_nonneg_right (B.norm_precompR_le Du) (finset.sum_nonneg' (λ i, by positivity)) + ... = _ : + begin + congr' 1, + apply finset.sum_congr rfl (λ i hi, _ ), + rw [nat.succ_sub (nat.lt_succ_iff.1 (finset.mem_range.1 hi)), + iterated_fderiv_within_succ_eq_comp_right hs hx, linear_isometry_equiv.norm_map], + end, + have I2 : + ‖iterated_fderiv_within 𝕜 n (λ (y : Du), B.precompL Du (fderiv_within 𝕜 f s y) (g y)) s x‖ ≤ + ‖B‖ * ∑ (i : ℕ) in finset.range (n + 1), n.choose i * + ‖iterated_fderiv_within 𝕜 (i + 1) f s x‖ * ‖iterated_fderiv_within 𝕜 (n - i) g s x‖ := calc + ‖iterated_fderiv_within 𝕜 n (λ (y : Du), B.precompL Du (fderiv_within 𝕜 f s y) (g y)) s x‖ + ≤ ‖B.precompL Du‖ * ∑ (i : ℕ) in finset.range (n + 1), n.choose i + * ‖iterated_fderiv_within 𝕜 i (fderiv_within 𝕜 f s) s x‖ + * ‖iterated_fderiv_within 𝕜 (n - i) g s x‖ : + IH _ (hf.fderiv_within hs In) (hg.of_le (nat.cast_le.2 (nat.le_succ n))) + ... ≤ ‖B‖ * ∑ (i : ℕ) in finset.range (n + 1), n.choose i + * ‖iterated_fderiv_within 𝕜 i (fderiv_within 𝕜 f s) s x‖ + * ‖iterated_fderiv_within 𝕜 (n - i) g s x‖ : + mul_le_mul_of_nonneg_right (B.norm_precompL_le Du) (finset.sum_nonneg' (λ i, by positivity)) + ... = _ : + begin + congr' 1, + apply finset.sum_congr rfl (λ i hi, _ ), + rw [iterated_fderiv_within_succ_eq_comp_right hs hx, linear_isometry_equiv.norm_map], + end, + have J : iterated_fderiv_within 𝕜 n + (λ (y : Du), fderiv_within 𝕜 (λ (y : Du), B (f y) (g y)) s y) s x + = iterated_fderiv_within 𝕜 n (λ y, B.precompR Du (f y) (fderiv_within 𝕜 g s y) + + B.precompL Du (fderiv_within 𝕜 f s y) (g y)) s x, + { apply iterated_fderiv_within_congr (λ y hy, _) hx, + have L : (1 : ℕ∞) ≤ n.succ, + by simpa only [enat.coe_one, nat.one_le_cast] using nat.succ_pos n, + exact B.fderiv_within_of_bilinear (hf.differentiable_on L y hy) + (hg.differentiable_on L y hy) (hs y hy) }, + rw [iterated_fderiv_within_succ_eq_comp_right hs hx, linear_isometry_equiv.norm_map, J], + have A : cont_diff_on 𝕜 n (λ y, B.precompR Du (f y) (fderiv_within 𝕜 g s y)) s, + from (B.precompR Du).is_bounded_bilinear_map.cont_diff.comp_cont_diff_on₂ + (hf.of_le (nat.cast_le.2 (nat.le_succ n))) (hg.fderiv_within hs In), + have A' : cont_diff_on 𝕜 n (λ y, B.precompL Du (fderiv_within 𝕜 f s y) (g y)) s, + from (B.precompL Du).is_bounded_bilinear_map.cont_diff.comp_cont_diff_on₂ + (hf.fderiv_within hs In) (hg.of_le (nat.cast_le.2 (nat.le_succ n))), + rw iterated_fderiv_within_add_apply' A A' hs hx, + apply (norm_add_le _ _).trans ((add_le_add I1 I2).trans (le_of_eq _)), + simp_rw [← mul_add, mul_assoc], + congr' 1, + exact (finset.sum_choose_succ_mul (λ i j, ‖iterated_fderiv_within 𝕜 i f s x‖ * + ‖iterated_fderiv_within 𝕜 j g s x‖) n).symm } +end + +/-- Bounding the norm of the iterated derivative of `B (f x) (g x)` within a set in terms of the +iterated derivatives of `f` and `g` when `B` is bilinear: +`‖D^n (x ↦ B (f x) (g x))‖ ≤ ‖B‖ ∑_{k ≤ n} n.choose k ‖D^k f‖ ‖D^{n-k} g‖` -/ +lemma continuous_linear_map.norm_iterated_fderiv_within_le_of_bilinear + (B : E →L[𝕜] F →L[𝕜] G) {f : D → E} {g : D → F} {N : ℕ∞} {s : set D} {x : D} + (hf : cont_diff_on 𝕜 N f s) (hg : cont_diff_on 𝕜 N g s) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) + {n : ℕ} (hn : (n : ℕ∞) ≤ N) : + ‖iterated_fderiv_within 𝕜 n (λ y, B (f y) (g y)) s x‖ + ≤ ‖B‖ * ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv_within 𝕜 i f s x‖ * ‖iterated_fderiv_within 𝕜 (n-i) g s x‖ := +begin + /- We reduce the bound to the case where all spaces live in the same universe (in which we + already have proved the result), by using linear isometries between the spaces and their `ulift` + to a common universe. These linear isometries preserve the norm of the iterated derivative. -/ + let Du : Type (max uD uE uF uG) := ulift.{(max uE uF uG) uD} D, + let Eu : Type (max uD uE uF uG) := ulift.{(max uD uF uG) uE} E, + let Fu : Type (max uD uE uF uG) := ulift.{(max uD uE uG) uF} F, + let Gu : Type (max uD uE uF uG) := ulift.{(max uD uE uF) uG} G, + have isoD : Du ≃ₗᵢ[𝕜] D := linear_isometry_equiv.ulift 𝕜 D, + have isoE : Eu ≃ₗᵢ[𝕜] E := linear_isometry_equiv.ulift 𝕜 E, + have isoF : Fu ≃ₗᵢ[𝕜] F := linear_isometry_equiv.ulift 𝕜 F, + have isoG : Gu ≃ₗᵢ[𝕜] G := linear_isometry_equiv.ulift 𝕜 G, + -- lift `f` and `g` to versions `fu` and `gu` on the lifted spaces. + let fu : Du → Eu := isoE.symm ∘ f ∘ isoD, + let gu : Du → Fu := isoF.symm ∘ g ∘ isoD, + -- lift the bilinear map `B` to a bilinear map `Bu` on the lifted spaces. + let Bu₀ : Eu →L[𝕜] Fu →L[𝕜] G, + from ((B.comp (isoE : Eu →L[𝕜] E)).flip.comp (isoF : Fu →L[𝕜] F)).flip, + let Bu : Eu →L[𝕜] Fu →L[𝕜] Gu, from continuous_linear_map.compL 𝕜 Eu (Fu →L[𝕜] G) (Fu →L[𝕜] Gu) + (continuous_linear_map.compL 𝕜 Fu G Gu (isoG.symm : G →L[𝕜] Gu)) Bu₀, + have Bu_eq : (λ y, Bu (fu y) (gu y)) = isoG.symm ∘ (λ y, B (f y) (g y)) ∘ isoD, + { ext1 y, + simp only [Bu, continuous_linear_map.compL_apply, function.comp_app, + continuous_linear_map.coe_comp', linear_isometry_equiv.coe_coe'', + continuous_linear_map.flip_apply, linear_isometry_equiv.apply_symm_apply] }, + -- All norms are preserved by the lifting process. + have Bu_le : ‖Bu‖ ≤ ‖B‖, + { refine continuous_linear_map.op_norm_le_bound _ (norm_nonneg _) (λ y, _), + refine continuous_linear_map.op_norm_le_bound _ (by positivity) (λ x, _ ), + simp only [Bu, continuous_linear_map.compL_apply, continuous_linear_map.coe_comp', + function.comp_app, linear_isometry_equiv.coe_coe'', continuous_linear_map.flip_apply, + linear_isometry_equiv.norm_map], + calc ‖B (isoE y) (isoF x)‖ + ≤ ‖B (isoE y)‖ * ‖isoF x‖ : continuous_linear_map.le_op_norm _ _ + ... ≤ ‖B‖ * ‖isoE y‖ * ‖isoF x‖ : + mul_le_mul_of_nonneg_right (continuous_linear_map.le_op_norm _ _) (norm_nonneg _) + ... = ‖B‖ * ‖y‖ * ‖x‖ : by simp only [linear_isometry_equiv.norm_map] }, + let su := isoD ⁻¹' s, + have hsu : unique_diff_on 𝕜 su, + from isoD.to_continuous_linear_equiv.unique_diff_on_preimage_iff.2 hs, + let xu := isoD.symm x, + have hxu : xu ∈ su, + by simpa only [set.mem_preimage, linear_isometry_equiv.apply_symm_apply] using hx, + have xu_x : isoD xu = x, by simp only [linear_isometry_equiv.apply_symm_apply], + have hfu : cont_diff_on 𝕜 n fu su, from isoE.symm.cont_diff.comp_cont_diff_on + ((hf.of_le hn).comp_continuous_linear_map (isoD : Du →L[𝕜] D)), + have hgu : cont_diff_on 𝕜 n gu su, from isoF.symm.cont_diff.comp_cont_diff_on + ((hg.of_le hn).comp_continuous_linear_map (isoD : Du →L[𝕜] D)), + have Nfu : ∀ i, ‖iterated_fderiv_within 𝕜 i fu su xu‖ = ‖iterated_fderiv_within 𝕜 i f s x‖, + { assume i, + rw linear_isometry_equiv.norm_iterated_fderiv_within_comp_left _ _ hsu hxu, + rw [linear_isometry_equiv.norm_iterated_fderiv_within_comp_right _ _ hs, xu_x], + rwa ← xu_x at hx }, + have Ngu : ∀ i, ‖iterated_fderiv_within 𝕜 i gu su xu‖ = ‖iterated_fderiv_within 𝕜 i g s x‖, + { assume i, + rw linear_isometry_equiv.norm_iterated_fderiv_within_comp_left _ _ hsu hxu, + rw [linear_isometry_equiv.norm_iterated_fderiv_within_comp_right _ _ hs, xu_x], + rwa ← xu_x at hx }, + have NBu : ‖iterated_fderiv_within 𝕜 n (λ y, Bu (fu y) (gu y)) su xu‖ = + ‖iterated_fderiv_within 𝕜 n (λ y, B (f y) (g y)) s x‖, + { rw Bu_eq, + rw linear_isometry_equiv.norm_iterated_fderiv_within_comp_left _ _ hsu hxu, + rw [linear_isometry_equiv.norm_iterated_fderiv_within_comp_right _ _ hs, xu_x], + rwa ← xu_x at hx }, + -- state the bound for the lifted objects, and deduce the original bound from it. + have : ‖iterated_fderiv_within 𝕜 n (λ y, Bu (fu y) (gu y)) su xu‖ + ≤ ‖Bu‖ * ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv_within 𝕜 i fu su xu‖ * ‖iterated_fderiv_within 𝕜 (n-i) gu su xu‖, + from Bu.norm_iterated_fderiv_within_le_of_bilinear_aux hfu hgu hsu hxu, + simp only [Nfu, Ngu, NBu] at this, + apply this.trans (mul_le_mul_of_nonneg_right Bu_le _), + exact finset.sum_nonneg' (λ i, by positivity), +end + +/-- Bounding the norm of the iterated derivative of `B (f x) (g x)` in terms of the +iterated derivatives of `f` and `g` when `B` is bilinear: +`‖D^n (x ↦ B (f x) (g x))‖ ≤ ‖B‖ ∑_{k ≤ n} n.choose k ‖D^k f‖ ‖D^{n-k} g‖` -/ +lemma continuous_linear_map.norm_iterated_fderiv_le_of_bilinear + (B : E →L[𝕜] F →L[𝕜] G) {f : D → E} {g : D → F} {N : ℕ∞} + (hf : cont_diff 𝕜 N f) (hg : cont_diff 𝕜 N g) (x : D) + {n : ℕ} (hn : (n : ℕ∞) ≤ N) : + ‖iterated_fderiv 𝕜 n (λ y, B (f y) (g y)) x‖ + ≤ ‖B‖ * ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv 𝕜 i f x‖ * ‖iterated_fderiv 𝕜 (n-i) g x‖ := +begin + simp_rw [← iterated_fderiv_within_univ], + exact B.norm_iterated_fderiv_within_le_of_bilinear hf.cont_diff_on hg.cont_diff_on + unique_diff_on_univ (mem_univ x) hn, +end + +/-- Bounding the norm of the iterated derivative of `B (f x) (g x)` within a set in terms of the +iterated derivatives of `f` and `g` when `B` is bilinear of norm at most `1`: +`‖D^n (x ↦ B (f x) (g x))‖ ≤ ∑_{k ≤ n} n.choose k ‖D^k f‖ ‖D^{n-k} g‖` -/ +lemma continuous_linear_map.norm_iterated_fderiv_within_le_of_bilinear_of_le_one + (B : E →L[𝕜] F →L[𝕜] G) {f : D → E} {g : D → F} {N : ℕ∞} {s : set D} {x : D} + (hf : cont_diff_on 𝕜 N f s) (hg : cont_diff_on 𝕜 N g s) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) + {n : ℕ} (hn : (n : ℕ∞) ≤ N) (hB : ‖B‖ ≤ 1) : + ‖iterated_fderiv_within 𝕜 n (λ y, B (f y) (g y)) s x‖ + ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv_within 𝕜 i f s x‖ * ‖iterated_fderiv_within 𝕜 (n-i) g s x‖ := +begin + apply (B.norm_iterated_fderiv_within_le_of_bilinear hf hg hs hx hn).trans, + apply mul_le_of_le_one_left (finset.sum_nonneg' (λ i, _)) hB, + positivity +end + +/-- Bounding the norm of the iterated derivative of `B (f x) (g x)` in terms of the +iterated derivatives of `f` and `g` when `B` is bilinear of norm at most `1`: +`‖D^n (x ↦ B (f x) (g x))‖ ≤ ∑_{k ≤ n} n.choose k ‖D^k f‖ ‖D^{n-k} g‖` -/ +lemma continuous_linear_map.norm_iterated_fderiv_le_of_bilinear_of_le_one + (B : E →L[𝕜] F →L[𝕜] G) {f : D → E} {g : D → F} {N : ℕ∞} + (hf : cont_diff 𝕜 N f) (hg : cont_diff 𝕜 N g) (x : D) + {n : ℕ} (hn : (n : ℕ∞) ≤ N) (hB : ‖B‖ ≤ 1) : + ‖iterated_fderiv 𝕜 n (λ y, B (f y) (g y)) x‖ + ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv 𝕜 i f x‖ * ‖iterated_fderiv 𝕜 (n-i) g x‖ := +begin + simp_rw [← iterated_fderiv_within_univ], + exact B.norm_iterated_fderiv_within_le_of_bilinear_of_le_one hf.cont_diff_on hg.cont_diff_on + unique_diff_on_univ (mem_univ x) hn hB, +end + +section + +variables {𝕜' : Type*} [normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] [normed_space 𝕜' F] + [is_scalar_tower 𝕜 𝕜' F] + +lemma norm_iterated_fderiv_within_smul_le + {f : E → 𝕜'} {g : E → F} {N : ℕ∞} (hf : cont_diff_on 𝕜 N f s) (hg : cont_diff_on 𝕜 N g s) + (hs : unique_diff_on 𝕜 s) {x : E} (hx : x ∈ s) {n : ℕ} (hn : (n : ℕ∞) ≤ N) : + ‖iterated_fderiv_within 𝕜 n (λ y, f y • g y) s x‖ + ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv_within 𝕜 i f s x‖ * ‖iterated_fderiv_within 𝕜 (n-i) g s x‖ := +(continuous_linear_map.lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] F →L[𝕜] F) + .norm_iterated_fderiv_within_le_of_bilinear_of_le_one hf hg hs hx hn + continuous_linear_map.op_norm_lsmul_le + +lemma norm_iterated_fderiv_smul_le + {f : E → 𝕜'} {g : E → F} {N : ℕ∞} (hf : cont_diff 𝕜 N f) (hg : cont_diff 𝕜 N g) + (x : E) {n : ℕ} (hn : (n : ℕ∞) ≤ N) : + ‖iterated_fderiv 𝕜 n (λ y, f y • g y) x‖ + ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv 𝕜 i f x‖ * ‖iterated_fderiv 𝕜 (n-i) g x‖ := +(continuous_linear_map.lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] F →L[𝕜] F) + .norm_iterated_fderiv_le_of_bilinear_of_le_one hf hg x hn + continuous_linear_map.op_norm_lsmul_le + +end + +section +variables {A : Type*} [normed_ring A] [normed_algebra 𝕜 A] + +lemma norm_iterated_fderiv_within_mul_le + {f : E → A} {g : E → A} {N : ℕ∞} (hf : cont_diff_on 𝕜 N f s) (hg : cont_diff_on 𝕜 N g s) + (hs : unique_diff_on 𝕜 s) {x : E} (hx : x ∈ s) {n : ℕ} (hn : (n : ℕ∞) ≤ N) : + ‖iterated_fderiv_within 𝕜 n (λ y, f y * g y) s x‖ + ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv_within 𝕜 i f s x‖ * ‖iterated_fderiv_within 𝕜 (n-i) g s x‖ := +(continuous_linear_map.mul 𝕜 A : A →L[𝕜] A →L[𝕜] A) + .norm_iterated_fderiv_within_le_of_bilinear_of_le_one hf hg hs hx hn + (continuous_linear_map.op_norm_mul_le _ _) + +lemma norm_iterated_fderiv_mul_le + {f : E → A} {g : E → A} {N : ℕ∞} (hf : cont_diff 𝕜 N f) (hg : cont_diff 𝕜 N g) + (x : E) {n : ℕ} (hn : (n : ℕ∞) ≤ N) : + ‖iterated_fderiv 𝕜 n (λ y, f y * g y) x‖ + ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) + * ‖iterated_fderiv 𝕜 i f x‖ * ‖iterated_fderiv 𝕜 (n-i) g x‖ := +begin + simp_rw [← iterated_fderiv_within_univ], + exact norm_iterated_fderiv_within_mul_le hf.cont_diff_on + hg.cont_diff_on unique_diff_on_univ (mem_univ x) hn, +end + +end + +/-- If the derivatives within a set of `g` at `f x` are bounded by `C`, and the `i`-th derivative +within a set of `f` at `x` is bounded by `D^i` for all `1 ≤ i ≤ n`, then the `n`-th derivative +of `g ∘ f` is bounded by `n! * C * D^n`. +This lemma proves this estimate assuming additionally that two of the spaces live in the same +universe, to make an induction possible. Use instead `norm_iterated_fderiv_within_comp_le` that +removes this assumption. -/ +lemma norm_iterated_fderiv_within_comp_le_aux + {Fu Gu : Type u} [normed_add_comm_group Fu] [normed_space 𝕜 Fu] + [normed_add_comm_group Gu] [normed_space 𝕜 Gu] + {g : Fu → Gu} {f : E → Fu} {n : ℕ} {s : set E} {t : set Fu} {x : E} + (hg : cont_diff_on 𝕜 n g t) (hf : cont_diff_on 𝕜 n f s) + (ht : unique_diff_on 𝕜 t) (hs : unique_diff_on 𝕜 s) + (hst : maps_to f s t) (hx : x ∈ s) + {C : ℝ} {D : ℝ} (hC : ∀ i, i ≤ n → ‖iterated_fderiv_within 𝕜 i g t (f x)‖ ≤ C) + (hD : ∀ i, 1 ≤ i → i ≤ n → ‖iterated_fderiv_within 𝕜 i f s x‖ ≤ D^i) : + ‖iterated_fderiv_within 𝕜 n (g ∘ f) s x‖ ≤ n! * C * D^n := +begin + /- We argue by induction on `n`, using that `D^(n+1) (g ∘ f) = D^n (g ' ∘ f ⬝ f')`. The successive + derivatives of `g' ∘ f` are controlled thanks to the inductive assumption, and those of `f'` are + controlled by assumption. + As composition of linear maps is a bilinear map, one may use + `continuous_linear_map.norm_iterated_fderiv_le_of_bilinear_of_le_one` to get from these a bound + on `D^n (g ' ∘ f ⬝ f')`. -/ + unfreezingI { induction n using nat.case_strong_induction_on with n IH generalizing Gu }, + { simpa only [norm_iterated_fderiv_within_zero, nat.factorial_zero, algebra_map.coe_one, + one_mul, pow_zero, mul_one] using hC 0 le_rfl }, + have M : (n : ℕ∞) < n.succ := nat.cast_lt.2 n.lt_succ_self, + have Cnonneg : 0 ≤ C := (norm_nonneg _).trans (hC 0 bot_le), + have Dnonneg : 0 ≤ D, + { have : 1 ≤ n+1, by simp only [le_add_iff_nonneg_left, zero_le'], + simpa only [pow_one] using (norm_nonneg _).trans (hD 1 le_rfl this) }, + -- use the inductive assumption to bound the derivatives of `g' ∘ f`. + have I : ∀ i ∈ finset.range (n+1), + ‖iterated_fderiv_within 𝕜 i ((fderiv_within 𝕜 g t) ∘ f) s x‖ ≤ i! * C * D^i, + { assume i hi, + simp only [finset.mem_range_succ_iff] at hi, + apply IH i hi, + apply hf.of_le (nat.cast_le.2 (hi.trans n.le_succ)), + { assume j hj h'j, + exact hD j hj (h'j.trans (hi.trans n.le_succ)) }, + { apply hg.fderiv_within ht, + simp only [nat.cast_succ], + exact add_le_add_right (nat.cast_le.2 hi) _ }, + { assume j hj, + have : ‖iterated_fderiv_within 𝕜 j (fderiv_within 𝕜 g t) t (f x)‖ + = ‖iterated_fderiv_within 𝕜 (j+1) g t (f x)‖, + by rw [iterated_fderiv_within_succ_eq_comp_right ht (hst hx), linear_isometry_equiv.norm_map], + rw this, + exact hC (j+1) (add_le_add (hj.trans hi) le_rfl) } }, + -- reformulate `hD` as a bound for the derivatives of `f'`. + have J : ∀ i, ‖iterated_fderiv_within 𝕜 (n - i) (fderiv_within 𝕜 f s) s x‖ ≤ D ^ (n - i + 1), + { assume i, + have : ‖iterated_fderiv_within 𝕜 (n - i) (fderiv_within 𝕜 f s) s x‖ + = ‖iterated_fderiv_within 𝕜 (n - i + 1) f s x‖, + by rw [iterated_fderiv_within_succ_eq_comp_right hs hx, linear_isometry_equiv.norm_map], + rw this, + apply hD, + { simp only [le_add_iff_nonneg_left, zero_le'] }, + { apply nat.succ_le_succ tsub_le_self } }, + -- Now put these together: first, notice that we have to bound `D^n (g' ∘ f ⬝ f')`. + calc + ‖iterated_fderiv_within 𝕜 (n+1) (g ∘ f) s x‖ = + ‖iterated_fderiv_within 𝕜 n (λ (y : E), fderiv_within 𝕜 (g ∘ f) s y) s x‖ : + by rw [iterated_fderiv_within_succ_eq_comp_right hs hx, linear_isometry_equiv.norm_map] + ... = ‖iterated_fderiv_within 𝕜 n (λ (y : E), continuous_linear_map.compL 𝕜 E Fu Gu + (fderiv_within 𝕜 g t (f y)) (fderiv_within 𝕜 f s y)) s x‖ : + begin + have L : (1 : ℕ∞) ≤ n.succ, by simpa only [enat.coe_one, nat.one_le_cast] using n.succ_pos, + congr' 1, + refine iterated_fderiv_within_congr (λ y hy, _) hx _, + apply fderiv_within.comp _ _ _ hst (hs y hy), + { exact hg.differentiable_on L _ (hst hy) }, + { exact hf.differentiable_on L _ hy } + end + -- bound it using the fact that the composition of linear maps is a bilinear operation, + -- for which we have bounds for the`n`-th derivative. + ... ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) * + ‖iterated_fderiv_within 𝕜 i ((fderiv_within 𝕜 g t) ∘ f) s x‖ + * ‖iterated_fderiv_within 𝕜 (n-i) (fderiv_within 𝕜 f s) s x‖ : + begin + have A : cont_diff_on 𝕜 n ((fderiv_within 𝕜 g t) ∘ f) s, + { apply cont_diff_on.comp _ (hf.of_le M.le) hst, + apply hg.fderiv_within ht, + simp only [nat.cast_succ, le_refl] }, + have B : cont_diff_on 𝕜 n (fderiv_within 𝕜 f s) s, + { apply hf.fderiv_within hs, + simp only [nat.cast_succ, le_refl] }, + exact (continuous_linear_map.compL 𝕜 E Fu Gu) + .norm_iterated_fderiv_within_le_of_bilinear_of_le_one A B hs hx + le_rfl (continuous_linear_map.norm_compL_le 𝕜 E Fu Gu), + end + -- bound each of the terms using the estimates on previous derivatives (that use the inductive + -- assumption for `g' ∘ f`). + ... ≤ ∑ i in finset.range (n+1), (n.choose i : ℝ) * (i! * C * D^i) * (D^(n-i+1)) : + begin + apply finset.sum_le_sum (λ i hi, _), + simp only [mul_assoc (n.choose i : ℝ)], + refine mul_le_mul_of_nonneg_left _ (nat.cast_nonneg _), + apply mul_le_mul (I i hi) (J i) (norm_nonneg _), + positivity, + end + -- We are left with trivial algebraic manipulations to see that this is smaller than + -- the claimed bound. + ... = ∑ i in finset.range (n+1), (n! : ℝ) * (i!⁻¹ * i!) * C * (D^i * D^(n-i+1)) * (n-i)!⁻¹ : + begin + apply finset.sum_congr rfl (λ i hi, _), + simp only [nat.cast_choose ℝ (finset.mem_range_succ_iff.1 hi), div_eq_inv_mul, mul_inv], + ring, + end + ... = ∑ i in finset.range (n+1), (n! : ℝ) * 1 * C * D^(n+1) * (n-i)!⁻¹ : + begin + apply finset.sum_congr rfl (λ i hi, _), + congr' 2, + { congr, + apply inv_mul_cancel, + simpa only [ne.def, nat.cast_eq_zero] using i.factorial_ne_zero }, + { rw ← pow_add, + congr' 1, + rw [nat.add_succ, nat.succ_inj'], + exact nat.add_sub_of_le (finset.mem_range_succ_iff.1 hi) } + end + ... ≤ ∑ i in finset.range (n+1), (n! : ℝ) * 1 * C * D^(n+1) * 1 : + begin + apply finset.sum_le_sum (λ i hi, _), + refine mul_le_mul_of_nonneg_left _ (by positivity), + apply inv_le_one, + simpa only [nat.one_le_cast] using (n-i).factorial_pos, + end + ... = (n+1)! * C * D^(n+1) : + by simp only [mul_assoc, mul_one, finset.sum_const, finset.card_range, nsmul_eq_mul, + nat.factorial_succ, nat.cast_mul], +end + +/-- If the derivatives within a set of `g` at `f x` are bounded by `C`, and the `i`-th derivative +within a set of `f` at `x` is bounded by `D^i` for all `1 ≤ i ≤ n`, then the `n`-th derivative +of `g ∘ f` is bounded by `n! * C * D^n`. -/ +lemma norm_iterated_fderiv_within_comp_le + {g : F → G} {f : E → F} {n : ℕ} {s : set E} {t : set F} {x : E} {N : ℕ∞} + (hg : cont_diff_on 𝕜 N g t) (hf : cont_diff_on 𝕜 N f s) (hn : (n : ℕ∞) ≤ N) + (ht : unique_diff_on 𝕜 t) (hs : unique_diff_on 𝕜 s) + (hst : maps_to f s t) (hx : x ∈ s) + {C : ℝ} {D : ℝ} (hC : ∀ i, i ≤ n → ‖iterated_fderiv_within 𝕜 i g t (f x)‖ ≤ C) + (hD : ∀ i, 1 ≤ i → i ≤ n → ‖iterated_fderiv_within 𝕜 i f s x‖ ≤ D^i) : + ‖iterated_fderiv_within 𝕜 n (g ∘ f) s x‖ ≤ n! * C * D^n := +begin + /- We reduce the bound to the case where all spaces live in the same universe (in which we + already have proved the result), by using linear isometries between the spaces and their `ulift` + to a common universe. These linear isometries preserve the norm of the iterated derivative. -/ + let Fu : Type (max uF uG) := ulift.{uG uF} F, + let Gu : Type (max uF uG) := ulift.{uF uG} G, + have isoF : Fu ≃ₗᵢ[𝕜] F := linear_isometry_equiv.ulift 𝕜 F, + have isoG : Gu ≃ₗᵢ[𝕜] G := linear_isometry_equiv.ulift 𝕜 G, + -- lift `f` and `g` to versions `fu` and `gu` on the lifted spaces. + let fu : E → Fu := isoF.symm ∘ f, + let gu : Fu → Gu := isoG.symm ∘ g ∘ isoF, + let tu := isoF ⁻¹' t, + have htu : unique_diff_on 𝕜 tu, + from isoF.to_continuous_linear_equiv.unique_diff_on_preimage_iff.2 ht, + have hstu : maps_to fu s tu, + { assume y hy, + simpa only [mem_preimage, linear_isometry_equiv.apply_symm_apply] using hst hy }, + have Ffu : isoF (fu x) = f x, by simp only [linear_isometry_equiv.apply_symm_apply], + -- All norms are preserved by the lifting process. + have hfu : cont_diff_on 𝕜 n fu s, from isoF.symm.cont_diff.comp_cont_diff_on (hf.of_le hn), + have hgu : cont_diff_on 𝕜 n gu tu, from isoG.symm.cont_diff.comp_cont_diff_on + ((hg.of_le hn).comp_continuous_linear_map (isoF : Fu →L[𝕜] F)), + have Nfu : ∀ i, ‖iterated_fderiv_within 𝕜 i fu s x‖ = ‖iterated_fderiv_within 𝕜 i f s x‖, + { assume i, + rw linear_isometry_equiv.norm_iterated_fderiv_within_comp_left _ _ hs hx }, + simp_rw [← Nfu] at hD, + have Ngu : ∀ i, ‖iterated_fderiv_within 𝕜 i gu tu (fu x)‖ + = ‖iterated_fderiv_within 𝕜 i g t (f x)‖, + { assume i, + rw linear_isometry_equiv.norm_iterated_fderiv_within_comp_left _ _ htu (hstu hx), + rw [linear_isometry_equiv.norm_iterated_fderiv_within_comp_right _ _ ht, Ffu], + rw Ffu, + exact hst hx }, + simp_rw [← Ngu] at hC, + have Nfgu : ‖iterated_fderiv_within 𝕜 n (g ∘ f) s x‖ = ‖iterated_fderiv_within 𝕜 n (gu ∘ fu) s x‖, + { have : gu ∘ fu = isoG.symm ∘ g ∘ f, + { ext x, + simp only [comp_app, linear_isometry_equiv.map_eq_iff, + linear_isometry_equiv.apply_symm_apply] }, + rw [this, linear_isometry_equiv.norm_iterated_fderiv_within_comp_left _ _ hs hx] }, + -- deduce the required bound from the one for `gu ∘ fu`. + rw Nfgu, + exact norm_iterated_fderiv_within_comp_le_aux hgu hfu htu hs hstu hx hC hD, +end + +/-- If the derivatives of `g` at `f x` are bounded by `C`, and the `i`-th derivative +of `f` at `x` is bounded by `D^i` for all `1 ≤ i ≤ n`, then the `n`-th derivative +of `g ∘ f` is bounded by `n! * C * D^n`. -/ +lemma norm_iterated_fderiv_comp_le + {g : F → G} {f : E → F} {n : ℕ} {N : ℕ∞} + (hg : cont_diff 𝕜 N g) (hf : cont_diff 𝕜 N f) (hn : (n : ℕ∞) ≤ N) (x : E) + {C : ℝ} {D : ℝ} (hC : ∀ i, i ≤ n → ‖iterated_fderiv 𝕜 i g (f x)‖ ≤ C) + (hD : ∀ i, 1 ≤ i → i ≤ n → ‖iterated_fderiv 𝕜 i f x‖ ≤ D^i) : + ‖iterated_fderiv 𝕜 n (g ∘ f) x‖ ≤ n! * C * D^n := +begin + simp_rw [← iterated_fderiv_within_univ] at ⊢ hC hD, + exact norm_iterated_fderiv_within_comp_le hg.cont_diff_on hf.cont_diff_on hn unique_diff_on_univ + unique_diff_on_univ (maps_to_univ _ _) (mem_univ x) hC hD, +end +section apply + +lemma norm_iterated_fderiv_within_clm_apply {f : E → (F →L[𝕜] G)} {g : E → F} {s : set E} {x : E} + {N : ℕ∞} {n : ℕ} (hf : cont_diff_on 𝕜 N f s) (hg : cont_diff_on 𝕜 N g s) (hs : unique_diff_on 𝕜 s) + (hx : x ∈ s) (hn : ↑n ≤ N) : + ‖iterated_fderiv_within 𝕜 n (λ y, (f y) (g y)) s x‖ ≤ + (finset.range (n + 1)).sum (λ i, ↑(n.choose i) * ‖iterated_fderiv_within 𝕜 i f s x‖ * + ‖iterated_fderiv_within 𝕜 (n - i) g s x‖) := +begin + let B : (F →L[𝕜] G) →L[𝕜] F →L[𝕜] G := + continuous_linear_map.flip (continuous_linear_map.apply 𝕜 G), + have hB : ‖B‖ ≤ 1 := + begin + simp only [continuous_linear_map.op_norm_flip, continuous_linear_map.apply], + refine continuous_linear_map.op_norm_le_bound _ zero_le_one (λ f, _), + simp only [continuous_linear_map.coe_id', id.def, one_mul], + end, + exact B.norm_iterated_fderiv_within_le_of_bilinear_of_le_one hf hg hs hx hn hB, +end + +lemma norm_iterated_fderiv_clm_apply {f : E → (F →L[𝕜] G)} {g : E → F} + {N : ℕ∞} {n : ℕ} (hf : cont_diff 𝕜 N f) (hg : cont_diff 𝕜 N g) (x : E) (hn : ↑n ≤ N): + ‖iterated_fderiv 𝕜 n (λ (y : E), (f y) (g y)) x‖ ≤ + (finset.range (n + 1)).sum (λ (i : ℕ), ↑(n.choose i) * ‖iterated_fderiv 𝕜 i f x‖ * + ‖iterated_fderiv 𝕜 (n - i) g x‖) := +begin + simp only [← iterated_fderiv_within_univ], + exact norm_iterated_fderiv_within_clm_apply hf.cont_diff_on hg.cont_diff_on unique_diff_on_univ + (set.mem_univ x) hn, +end + +lemma norm_iterated_fderiv_within_clm_apply_const {f : E → (F →L[𝕜] G)} {c : F} {s : set E} {x : E} + {N : ℕ∞} {n : ℕ} (hf : cont_diff_on 𝕜 N f s) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) + (hn : ↑n ≤ N) : ‖iterated_fderiv_within 𝕜 n (λ (y : E), (f y) c) s x‖ ≤ + ‖c‖ * ‖iterated_fderiv_within 𝕜 n f s x‖ := +begin + let g : (F →L[𝕜] G) →L[𝕜] G := continuous_linear_map.apply 𝕜 G c, + have h := g.norm_comp_continuous_multilinear_map_le (iterated_fderiv_within 𝕜 n f s x), + rw ← g.iterated_fderiv_within_comp_left hf hs hx hn at h, + refine h.trans (mul_le_mul_of_nonneg_right _ (norm_nonneg _)), + refine g.op_norm_le_bound (norm_nonneg _) (λ f, _), + rw [continuous_linear_map.apply_apply, mul_comm], + exact f.le_op_norm c, +end + +lemma norm_iterated_fderiv_clm_apply_const {f : E → (F →L[𝕜] G)} {c : F} {x : E} {N : ℕ∞} {n : ℕ} + (hf : cont_diff 𝕜 N f) (hn : ↑n ≤ N) : + ‖iterated_fderiv 𝕜 n (λ (y : E), (f y) c) x‖ ≤ ‖c‖ * ‖iterated_fderiv 𝕜 n f x‖ := +begin + simp only [← iterated_fderiv_within_univ], + refine norm_iterated_fderiv_within_clm_apply_const hf.cont_diff_on unique_diff_on_univ + (set.mem_univ x) hn, +end + +end apply diff --git a/src/analysis/calculus/cont_diff_def.lean b/src/analysis/calculus/cont_diff_def.lean new file mode 100644 index 0000000000000..bd25338ef2ea3 --- /dev/null +++ b/src/analysis/calculus/cont_diff_def.lean @@ -0,0 +1,1684 @@ +/- +Copyright (c) 2019 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.calculus.fderiv.add +import analysis.calculus.fderiv.mul +import analysis.calculus.fderiv.equiv +import analysis.calculus.fderiv.restrict_scalars +import analysis.calculus.formal_multilinear_series + +/-! +# Higher differentiability + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A function is `C^1` on a domain if it is differentiable there, and its derivative is continuous. +By induction, it is `C^n` if it is `C^{n-1}` and its (n-1)-th derivative is `C^1` there or, +equivalently, if it is `C^1` and its derivative is `C^{n-1}`. +Finally, it is `C^∞` if it is `C^n` for all n. + +We formalize these notions by defining iteratively the `n+1`-th derivative of a function as the +derivative of the `n`-th derivative. It is called `iterated_fderiv 𝕜 n f x` where `𝕜` is the +field, `n` is the number of iterations, `f` is the function and `x` is the point, and it is given +as an `n`-multilinear map. We also define a version `iterated_fderiv_within` relative to a domain, +as well as predicates `cont_diff_within_at`, `cont_diff_at`, `cont_diff_on` and +`cont_diff` saying that the function is `C^n` within a set at a point, at a point, on a set +and on the whole space respectively. + +To avoid the issue of choice when choosing a derivative in sets where the derivative is not +necessarily unique, `cont_diff_on` is not defined directly in terms of the +regularity of the specific choice `iterated_fderiv_within 𝕜 n f s` inside `s`, but in terms of the +existence of a nice sequence of derivatives, expressed with a predicate +`has_ftaylor_series_up_to_on`. + +We prove basic properties of these notions. + +## Main definitions and results +Let `f : E → F` be a map between normed vector spaces over a nontrivially normed field `𝕜`. + +* `has_ftaylor_series_up_to n f p`: expresses that the formal multilinear series `p` is a sequence + of iterated derivatives of `f`, up to the `n`-th term (where `n` is a natural number or `∞`). +* `has_ftaylor_series_up_to_on n f p s`: same thing, but inside a set `s`. The notion of derivative + is now taken inside `s`. In particular, derivatives don't have to be unique. +* `cont_diff 𝕜 n f`: expresses that `f` is `C^n`, i.e., it admits a Taylor series up to + rank `n`. +* `cont_diff_on 𝕜 n f s`: expresses that `f` is `C^n` in `s`. +* `cont_diff_at 𝕜 n f x`: expresses that `f` is `C^n` around `x`. +* `cont_diff_within_at 𝕜 n f s x`: expresses that `f` is `C^n` around `x` within the set `s`. +* `iterated_fderiv_within 𝕜 n f s x` is an `n`-th derivative of `f` over the field `𝕜` on the + set `s` at the point `x`. It is a continuous multilinear map from `E^n` to `F`, defined as a + derivative within `s` of `iterated_fderiv_within 𝕜 (n-1) f s` if one exists, and `0` otherwise. +* `iterated_fderiv 𝕜 n f x` is the `n`-th derivative of `f` over the field `𝕜` at the point `x`. + It is a continuous multilinear map from `E^n` to `F`, defined as a derivative of + `iterated_fderiv 𝕜 (n-1) f` if one exists, and `0` otherwise. + +In sets of unique differentiability, `cont_diff_on 𝕜 n f s` can be expressed in terms of the +properties of `iterated_fderiv_within 𝕜 m f s` for `m ≤ n`. In the whole space, +`cont_diff 𝕜 n f` can be expressed in terms of the properties of `iterated_fderiv 𝕜 m f` +for `m ≤ n`. + +## Implementation notes + +The definitions in this file are designed to work on any field `𝕜`. They are sometimes slightly more +complicated than the naive definitions one would guess from the intuition over the real or complex +numbers, but they are designed to circumvent the lack of gluing properties and partitions of unity +in general. In the usual situations, they coincide with the usual definitions. + +### Definition of `C^n` functions in domains + +One could define `C^n` functions in a domain `s` by fixing an arbitrary choice of derivatives (this +is what we do with `iterated_fderiv_within`) and requiring that all these derivatives up to `n` are +continuous. If the derivative is not unique, this could lead to strange behavior like two `C^n` +functions `f` and `g` on `s` whose sum is not `C^n`. A better definition is thus to say that a +function is `C^n` inside `s` if it admits a sequence of derivatives up to `n` inside `s`. + +This definition still has the problem that a function which is locally `C^n` would not need to +be `C^n`, as different choices of sequences of derivatives around different points might possibly +not be glued together to give a globally defined sequence of derivatives. (Note that this issue +can not happen over reals, thanks to partition of unity, but the behavior over a general field is +not so clear, and we want a definition for general fields). Also, there are locality +problems for the order parameter: one could image a function which, for each `n`, has a nice +sequence of derivatives up to order `n`, but they do not coincide for varying `n` and can therefore +not be glued to give rise to an infinite sequence of derivatives. This would give a function +which is `C^n` for all `n`, but not `C^∞`. We solve this issue by putting locality conditions +in space and order in our definition of `cont_diff_within_at` and `cont_diff_on`. +The resulting definition is slightly more complicated to work with (in fact not so much), but it +gives rise to completely satisfactory theorems. + +For instance, with this definition, a real function which is `C^m` (but not better) on `(-1/m, 1/m)` +for each natural `m` is by definition `C^∞` at `0`. + +There is another issue with the definition of `cont_diff_within_at 𝕜 n f s x`. We can +require the existence and good behavior of derivatives up to order `n` on a neighborhood of `x` +within `s`. However, this does not imply continuity or differentiability within `s` of the function +at `x` when `x` does not belong to `s`. Therefore, we require such existence and good behavior on +a neighborhood of `x` within `s ∪ {x}` (which appears as `insert x s` in this file). + +### Side of the composition, and universe issues + +With a naïve direct definition, the `n`-th derivative of a function belongs to the space +`E →L[𝕜] (E →L[𝕜] (E ... F)...)))` where there are n iterations of `E →L[𝕜]`. This space +may also be seen as the space of continuous multilinear functions on `n` copies of `E` with +values in `F`, by uncurrying. This is the point of view that is usually adopted in textbooks, +and that we also use. This means that the definition and the first proofs are slightly involved, +as one has to keep track of the uncurrying operation. The uncurrying can be done from the +left or from the right, amounting to defining the `n+1`-th derivative either as the derivative of +the `n`-th derivative, or as the `n`-th derivative of the derivative. +For proofs, it would be more convenient to use the latter approach (from the right), +as it means to prove things at the `n+1`-th step we only need to understand well enough the +derivative in `E →L[𝕜] F` (contrary to the approach from the left, where one would need to know +enough on the `n`-th derivative to deduce things on the `n+1`-th derivative). + +However, the definition from the right leads to a universe polymorphism problem: if we define +`iterated_fderiv 𝕜 (n + 1) f x = iterated_fderiv 𝕜 n (fderiv 𝕜 f) x` by induction, we need to +generalize over all spaces (as `f` and `fderiv 𝕜 f` don't take values in the same space). It is +only possible to generalize over all spaces in some fixed universe in an inductive definition. +For `f : E → F`, then `fderiv 𝕜 f` is a map `E → (E →L[𝕜] F)`. Therefore, the definition will only +work if `F` and `E →L[𝕜] F` are in the same universe. + +This issue does not appear with the definition from the left, where one does not need to generalize +over all spaces. Therefore, we use the definition from the left. This means some proofs later on +become a little bit more complicated: to prove that a function is `C^n`, the most efficient approach +is to exhibit a formula for its `n`-th derivative and prove it is continuous (contrary to the +inductive approach where one would prove smoothness statements without giving a formula for the +derivative). In the end, this approach is still satisfactory as it is good to have formulas for the +iterated derivatives in various constructions. + +One point where we depart from this explicit approach is in the proof of smoothness of a +composition: there is a formula for the `n`-th derivative of a composition (Faà di Bruno's formula), +but it is very complicated and barely usable, while the inductive proof is very simple. Thus, we +give the inductive proof. As explained above, it works by generalizing over the target space, hence +it only works well if all spaces belong to the same universe. To get the general version, we lift +things to a common universe using a trick. + +### Variables management + +The textbook definitions and proofs use various identifications and abuse of notations, for instance +when saying that the natural space in which the derivative lives, i.e., +`E →L[𝕜] (E →L[𝕜] ( ... →L[𝕜] F))`, is the same as a space of multilinear maps. When doing things +formally, we need to provide explicit maps for these identifications, and chase some diagrams to see +everything is compatible with the identifications. In particular, one needs to check that taking the +derivative and then doing the identification, or first doing the identification and then taking the +derivative, gives the same result. The key point for this is that taking the derivative commutes +with continuous linear equivalences. Therefore, we need to implement all our identifications with +continuous linear equivs. + +## Notations + +We use the notation `E [×n]→L[𝕜] F` for the space of continuous multilinear maps on `E^n` with +values in `F`. This is the space in which the `n`-th derivative of a function from `E` to `F` lives. + +In this file, we denote `⊤ : ℕ∞` with `∞`. + +## Tags + +derivative, differentiability, higher derivative, `C^n`, multilinear, Taylor series, formal series +-/ + +noncomputable theory +open_locale classical big_operators nnreal topology filter + +local notation `∞` := (⊤ : ℕ∞) + +local attribute [instance, priority 1001] +normed_add_comm_group.to_add_comm_group normed_space.to_module' add_comm_group.to_add_comm_monoid + +open set fin filter function + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +{G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +{X : Type*} [normed_add_comm_group X] [normed_space 𝕜 X] +{s s₁ t u : set E} {f f₁ : E → F} {g : F → G} {x x₀ : E} {c : F} +{m n : ℕ∞} {p : E → formal_multilinear_series 𝕜 E F} + +/-! ### Functions with a Taylor series on a domain -/ + +/-- `has_ftaylor_series_up_to_on n f p s` registers the fact that `p 0 = f` and `p (m+1)` is a +derivative of `p m` for `m < n`, and is continuous for `m ≤ n`. This is a predicate analogous to +`has_fderiv_within_at` but for higher order derivatives. -/ +structure has_ftaylor_series_up_to_on (n : ℕ∞) + (f : E → F) (p : E → formal_multilinear_series 𝕜 E F) (s : set E) : Prop := +(zero_eq : ∀ x ∈ s, (p x 0).uncurry0 = f x) +(fderiv_within : ∀ (m : ℕ) (hm : (m : ℕ∞) < n), ∀ x ∈ s, + has_fderiv_within_at (λ y, p y m) (p x m.succ).curry_left s x) +(cont : ∀ (m : ℕ) (hm : (m : ℕ∞) ≤ n), continuous_on (λ x, p x m) s) + +lemma has_ftaylor_series_up_to_on.zero_eq' + (h : has_ftaylor_series_up_to_on n f p s) {x : E} (hx : x ∈ s) : + p x 0 = (continuous_multilinear_curry_fin0 𝕜 E F).symm (f x) := +by { rw ← h.zero_eq x hx, symmetry, exact continuous_multilinear_map.uncurry0_curry0 _ } + +/-- If two functions coincide on a set `s`, then a Taylor series for the first one is as well a +Taylor series for the second one. -/ +lemma has_ftaylor_series_up_to_on.congr + (h : has_ftaylor_series_up_to_on n f p s) (h₁ : ∀ x ∈ s, f₁ x = f x) : + has_ftaylor_series_up_to_on n f₁ p s := +begin + refine ⟨λ x hx, _, h.fderiv_within, h.cont⟩, + rw h₁ x hx, + exact h.zero_eq x hx +end + +lemma has_ftaylor_series_up_to_on.mono + (h : has_ftaylor_series_up_to_on n f p s) {t : set E} (hst : t ⊆ s) : + has_ftaylor_series_up_to_on n f p t := +⟨λ x hx, h.zero_eq x (hst hx), +λ m hm x hx, (h.fderiv_within m hm x (hst hx)).mono hst, +λ m hm, (h.cont m hm).mono hst⟩ + +lemma has_ftaylor_series_up_to_on.of_le + (h : has_ftaylor_series_up_to_on n f p s) (hmn : m ≤ n) : + has_ftaylor_series_up_to_on m f p s := +⟨h.zero_eq, +λ k hk x hx, h.fderiv_within k (lt_of_lt_of_le hk hmn) x hx, +λ k hk, h.cont k (le_trans hk hmn)⟩ + +lemma has_ftaylor_series_up_to_on.continuous_on + (h : has_ftaylor_series_up_to_on n f p s) : continuous_on f s := +begin + have := (h.cont 0 bot_le).congr (λ x hx, (h.zero_eq' hx).symm), + rwa linear_isometry_equiv.comp_continuous_on_iff at this +end + +lemma has_ftaylor_series_up_to_on_zero_iff : + has_ftaylor_series_up_to_on 0 f p s ↔ continuous_on f s ∧ (∀ x ∈ s, (p x 0).uncurry0 = f x) := +begin + refine ⟨λ H, ⟨H.continuous_on, H.zero_eq⟩, + λ H, ⟨H.2, λ m hm, false.elim (not_le.2 hm bot_le), _⟩⟩, + assume m hm, + obtain rfl : m = 0, by exact_mod_cast (hm.antisymm (zero_le _)), + have : ∀ x ∈ s, p x 0 = (continuous_multilinear_curry_fin0 𝕜 E F).symm (f x), + by { assume x hx, rw ← H.2 x hx, symmetry, exact continuous_multilinear_map.uncurry0_curry0 _ }, + rw [continuous_on_congr this, linear_isometry_equiv.comp_continuous_on_iff], + exact H.1 +end + +lemma has_ftaylor_series_up_to_on_top_iff : + (has_ftaylor_series_up_to_on ∞ f p s) ↔ (∀ (n : ℕ), has_ftaylor_series_up_to_on n f p s) := +begin + split, + { assume H n, exact H.of_le le_top }, + { assume H, + split, + { exact (H 0).zero_eq }, + { assume m hm, + apply (H m.succ).fderiv_within m (with_top.coe_lt_coe.2 (lt_add_one m)) }, + { assume m hm, + apply (H m).cont m le_rfl } } +end + +/-- In the case that `n = ∞` we don't need the continuity assumption in +`has_ftaylor_series_up_to_on`. -/ +lemma has_ftaylor_series_up_to_on_top_iff' : has_ftaylor_series_up_to_on ∞ f p s ↔ + (∀ x ∈ s, (p x 0).uncurry0 = f x) ∧ + (∀ (m : ℕ), ∀ x ∈ s, has_fderiv_within_at (λ y, p y m) (p x m.succ).curry_left s x) := +-- Everything except for the continuity is trivial: +⟨λ h, ⟨h.1, λ m, h.2 m (with_top.coe_lt_top m)⟩, λ h, ⟨h.1, λ m _, h.2 m, λ m _ x hx, + -- The continuity follows from the existence of a derivative: + (h.2 m x hx).continuous_within_at⟩⟩ + +/-- If a function has a Taylor series at order at least `1`, then the term of order `1` of this +series is a derivative of `f`. -/ +lemma has_ftaylor_series_up_to_on.has_fderiv_within_at + (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : x ∈ s) : + has_fderiv_within_at f (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) s x := +begin + have A : ∀ y ∈ s, f y = (continuous_multilinear_curry_fin0 𝕜 E F) (p y 0), + { assume y hy, rw ← h.zero_eq y hy, refl }, + suffices H : has_fderiv_within_at + (λ y, continuous_multilinear_curry_fin0 𝕜 E F (p y 0)) + (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) s x, + by exact H.congr A (A x hx), + rw linear_isometry_equiv.comp_has_fderiv_within_at_iff', + have : ((0 : ℕ) : ℕ∞) < n := + lt_of_lt_of_le (with_top.coe_lt_coe.2 nat.zero_lt_one) hn, + convert h.fderiv_within _ this x hx, + ext y v, + change (p x 1) (snoc 0 y) = (p x 1) (cons y v), + unfold_coes, + congr' with i, + rw unique.eq_default i, + refl +end + +lemma has_ftaylor_series_up_to_on.differentiable_on + (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) : differentiable_on 𝕜 f s := +λ x hx, (h.has_fderiv_within_at hn hx).differentiable_within_at + +/-- If a function has a Taylor series at order at least `1` on a neighborhood of `x`, then the term +of order `1` of this series is a derivative of `f` at `x`. -/ +lemma has_ftaylor_series_up_to_on.has_fderiv_at + (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : s ∈ 𝓝 x) : + has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) x := +(h.has_fderiv_within_at hn (mem_of_mem_nhds hx)).has_fderiv_at hx + +/-- If a function has a Taylor series at order at least `1` on a neighborhood of `x`, then +in a neighborhood of `x`, the term of order `1` of this series is a derivative of `f`. -/ +lemma has_ftaylor_series_up_to_on.eventually_has_fderiv_at + (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : s ∈ 𝓝 x) : + ∀ᶠ y in 𝓝 x, has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p y 1)) y := +(eventually_eventually_nhds.2 hx).mono $ λ y hy, h.has_fderiv_at hn hy + +/-- If a function has a Taylor series at order at least `1` on a neighborhood of `x`, then +it is differentiable at `x`. -/ +lemma has_ftaylor_series_up_to_on.differentiable_at + (h : has_ftaylor_series_up_to_on n f p s) (hn : 1 ≤ n) (hx : s ∈ 𝓝 x) : + differentiable_at 𝕜 f x := +(h.has_fderiv_at hn hx).differentiable_at + +/-- `p` is a Taylor series of `f` up to `n+1` if and only if `p` is a Taylor series up to `n`, and +`p (n + 1)` is a derivative of `p n`. -/ +theorem has_ftaylor_series_up_to_on_succ_iff_left {n : ℕ} : + has_ftaylor_series_up_to_on (n + 1) f p s ↔ + has_ftaylor_series_up_to_on n f p s + ∧ (∀ x ∈ s, has_fderiv_within_at (λ y, p y n) (p x n.succ).curry_left s x) + ∧ continuous_on (λ x, p x (n + 1)) s := +begin + split, + { assume h, + exact ⟨h.of_le (with_top.coe_le_coe.2 (nat.le_succ n)), + h.fderiv_within _ (with_top.coe_lt_coe.2 (lt_add_one n)), + h.cont (n + 1) le_rfl⟩ }, + { assume h, + split, + { exact h.1.zero_eq }, + { assume m hm, + by_cases h' : m < n, + { exact h.1.fderiv_within m (with_top.coe_lt_coe.2 h') }, + { have : m = n := nat.eq_of_lt_succ_of_not_lt (with_top.coe_lt_coe.1 hm) h', + rw this, + exact h.2.1 } }, + { assume m hm, + by_cases h' : m ≤ n, + { apply h.1.cont m (with_top.coe_le_coe.2 h') }, + { have : m = (n + 1) := le_antisymm (with_top.coe_le_coe.1 hm) (not_le.1 h'), + rw this, + exact h.2.2 } } } +end + +/-- `p` is a Taylor series of `f` up to `n+1` if and only if `p.shift` is a Taylor series up to `n` +for `p 1`, which is a derivative of `f`. -/ +theorem has_ftaylor_series_up_to_on_succ_iff_right {n : ℕ} : + has_ftaylor_series_up_to_on ((n + 1) : ℕ) f p s ↔ + (∀ x ∈ s, (p x 0).uncurry0 = f x) + ∧ (∀ x ∈ s, has_fderiv_within_at (λ y, p y 0) (p x 1).curry_left s x) + ∧ has_ftaylor_series_up_to_on n + (λ x, continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) (λ x, (p x).shift) s := +begin + split, + { assume H, + refine ⟨H.zero_eq, H.fderiv_within 0 (with_top.coe_lt_coe.2 (nat.succ_pos n)), _⟩, + split, + { assume x hx, refl }, + { assume m (hm : (m : ℕ∞) < n) x (hx : x ∈ s), + have A : (m.succ : ℕ∞) < n.succ, + by { rw with_top.coe_lt_coe at ⊢ hm, exact nat.lt_succ_iff.mpr hm }, + change has_fderiv_within_at + ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm + ∘ (λ (y : E), p y m.succ)) + (p x m.succ.succ).curry_right.curry_left s x, + rw linear_isometry_equiv.comp_has_fderiv_within_at_iff', + convert H.fderiv_within _ A x hx, + ext y v, + change (p x m.succ.succ) (snoc (cons y (init v)) (v (last _))) + = (p x (nat.succ (nat.succ m))) (cons y v), + rw [← cons_snoc_eq_snoc_cons, snoc_init_self] }, + { assume m (hm : (m : ℕ∞) ≤ n), + have A : (m.succ : ℕ∞) ≤ n.succ, + by { rw with_top.coe_le_coe at ⊢ hm, exact nat.pred_le_iff.mp hm }, + change continuous_on ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm + ∘ (λ (y : E), p y m.succ)) s, + rw linear_isometry_equiv.comp_continuous_on_iff, + exact H.cont _ A } }, + { rintros ⟨Hzero_eq, Hfderiv_zero, Htaylor⟩, + split, + { exact Hzero_eq }, + { assume m (hm : (m : ℕ∞) < n.succ) x (hx : x ∈ s), + cases m, + { exact Hfderiv_zero x hx }, + { have A : (m : ℕ∞) < n, + by { rw with_top.coe_lt_coe at hm ⊢, exact nat.lt_of_succ_lt_succ hm }, + have : has_fderiv_within_at ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm + ∘ (λ (y : E), p y m.succ)) ((p x).shift m.succ).curry_left s x := + Htaylor.fderiv_within _ A x hx, + rw linear_isometry_equiv.comp_has_fderiv_within_at_iff' at this, + convert this, + ext y v, + change (p x (nat.succ (nat.succ m))) (cons y v) + = (p x m.succ.succ) (snoc (cons y (init v)) (v (last _))), + rw [← cons_snoc_eq_snoc_cons, snoc_init_self] } }, + { assume m (hm : (m : ℕ∞) ≤ n.succ), + cases m, + { have : differentiable_on 𝕜 (λ x, p x 0) s := + λ x hx, (Hfderiv_zero x hx).differentiable_within_at, + exact this.continuous_on }, + { have A : (m : ℕ∞) ≤ n, + by { rw with_top.coe_le_coe at hm ⊢, exact nat.lt_succ_iff.mp hm }, + have : continuous_on ((continuous_multilinear_curry_right_equiv' 𝕜 m E F).symm + ∘ (λ (y : E), p y m.succ)) s := + Htaylor.cont _ A, + rwa linear_isometry_equiv.comp_continuous_on_iff at this } } } +end + +/-! ### Smooth functions within a set around a point -/ + +variable (𝕜) + +/-- A function is continuously differentiable up to order `n` within a set `s` at a point `x` if +it admits continuous derivatives up to order `n` in a neighborhood of `x` in `s ∪ {x}`. +For `n = ∞`, we only require that this holds up to any finite order (where the neighborhood may +depend on the finite order we consider). + +For instance, a real function which is `C^m` on `(-1/m, 1/m)` for each natural `m`, but not +better, is `C^∞` at `0` within `univ`. +-/ +def cont_diff_within_at (n : ℕ∞) (f : E → F) (s : set E) (x : E) : Prop := +∀ (m : ℕ), (m : ℕ∞) ≤ n → + ∃ u ∈ 𝓝[insert x s] x, ∃ p : E → formal_multilinear_series 𝕜 E F, + has_ftaylor_series_up_to_on m f p u + +variable {𝕜} + +lemma cont_diff_within_at_nat {n : ℕ} : + cont_diff_within_at 𝕜 n f s x ↔ + ∃ u ∈ 𝓝[insert x s] x, ∃ p : E → formal_multilinear_series 𝕜 E F, + has_ftaylor_series_up_to_on n f p u := +⟨λ H, H n le_rfl, λ ⟨u, hu, p, hp⟩ m hm, ⟨u, hu, p, hp.of_le hm⟩⟩ + +lemma cont_diff_within_at.of_le + (h : cont_diff_within_at 𝕜 n f s x) (hmn : m ≤ n) : + cont_diff_within_at 𝕜 m f s x := +λ k hk, h k (le_trans hk hmn) + +lemma cont_diff_within_at_iff_forall_nat_le : + cont_diff_within_at 𝕜 n f s x ↔ ∀ m : ℕ, ↑m ≤ n → cont_diff_within_at 𝕜 m f s x := +⟨λ H m hm, H.of_le hm, λ H m hm, H m hm _ le_rfl⟩ + +lemma cont_diff_within_at_top : + cont_diff_within_at 𝕜 ∞ f s x ↔ ∀ (n : ℕ), cont_diff_within_at 𝕜 n f s x := +cont_diff_within_at_iff_forall_nat_le.trans $ by simp only [forall_prop_of_true, le_top] + +lemma cont_diff_within_at.continuous_within_at + (h : cont_diff_within_at 𝕜 n f s x) : continuous_within_at f s x := +begin + rcases h 0 bot_le with ⟨u, hu, p, H⟩, + rw [mem_nhds_within_insert] at hu, + exact (H.continuous_on.continuous_within_at hu.1).mono_of_mem hu.2 +end + +lemma cont_diff_within_at.congr_of_eventually_eq + (h : cont_diff_within_at 𝕜 n f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : + cont_diff_within_at 𝕜 n f₁ s x := +λ m hm, let ⟨u, hu, p, H⟩ := h m hm in +⟨{x ∈ u | f₁ x = f x}, filter.inter_mem hu (mem_nhds_within_insert.2 ⟨hx, h₁⟩), p, + (H.mono (sep_subset _ _)).congr (λ _, and.right)⟩ + +lemma cont_diff_within_at.congr_of_eventually_eq_insert + (h : cont_diff_within_at 𝕜 n f s x) (h₁ : f₁ =ᶠ[𝓝[insert x s] x] f) : + cont_diff_within_at 𝕜 n f₁ s x := +h.congr_of_eventually_eq (nhds_within_mono x (subset_insert x s) h₁) + (mem_of_mem_nhds_within (mem_insert x s) h₁ : _) + +lemma cont_diff_within_at.congr_of_eventually_eq' + (h : cont_diff_within_at 𝕜 n f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : x ∈ s) : + cont_diff_within_at 𝕜 n f₁ s x := +h.congr_of_eventually_eq h₁ $ h₁.self_of_nhds_within hx + +lemma filter.eventually_eq.cont_diff_within_at_iff + (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : + cont_diff_within_at 𝕜 n f₁ s x ↔ cont_diff_within_at 𝕜 n f s x := +⟨λ H, cont_diff_within_at.congr_of_eventually_eq H h₁.symm hx.symm, +λ H, H.congr_of_eventually_eq h₁ hx⟩ + +lemma cont_diff_within_at.congr + (h : cont_diff_within_at 𝕜 n f s x) (h₁ : ∀ y ∈ s, f₁ y = f y) (hx : f₁ x = f x) : + cont_diff_within_at 𝕜 n f₁ s x := +h.congr_of_eventually_eq (filter.eventually_eq_of_mem self_mem_nhds_within h₁) hx + +lemma cont_diff_within_at.congr' + (h : cont_diff_within_at 𝕜 n f s x) (h₁ : ∀ y ∈ s, f₁ y = f y) (hx : x ∈ s) : + cont_diff_within_at 𝕜 n f₁ s x := +h.congr h₁ (h₁ _ hx) + +lemma cont_diff_within_at.mono_of_mem + (h : cont_diff_within_at 𝕜 n f s x) {t : set E} (hst : s ∈ 𝓝[t] x) : + cont_diff_within_at 𝕜 n f t x := +begin + assume m hm, + rcases h m hm with ⟨u, hu, p, H⟩, + exact ⟨u, nhds_within_le_of_mem (insert_mem_nhds_within_insert hst) hu, p, H⟩ +end + +lemma cont_diff_within_at.mono + (h : cont_diff_within_at 𝕜 n f s x) {t : set E} (hst : t ⊆ s) : + cont_diff_within_at 𝕜 n f t x := +h.mono_of_mem $ filter.mem_of_superset self_mem_nhds_within hst + +lemma cont_diff_within_at.congr_nhds + (h : cont_diff_within_at 𝕜 n f s x) {t : set E} (hst : 𝓝[s] x = 𝓝[t] x) : + cont_diff_within_at 𝕜 n f t x := +h.mono_of_mem $ hst ▸ self_mem_nhds_within + +lemma cont_diff_within_at_congr_nhds {t : set E} (hst : 𝓝[s] x = 𝓝[t] x) : + cont_diff_within_at 𝕜 n f s x ↔ cont_diff_within_at 𝕜 n f t x := +⟨λ h, h.congr_nhds hst, λ h, h.congr_nhds hst.symm⟩ + +lemma cont_diff_within_at_inter' (h : t ∈ 𝓝[s] x) : + cont_diff_within_at 𝕜 n f (s ∩ t) x ↔ cont_diff_within_at 𝕜 n f s x := +cont_diff_within_at_congr_nhds $ eq.symm $ nhds_within_restrict'' _ h + +lemma cont_diff_within_at_inter (h : t ∈ 𝓝 x) : + cont_diff_within_at 𝕜 n f (s ∩ t) x ↔ cont_diff_within_at 𝕜 n f s x := +cont_diff_within_at_inter' (mem_nhds_within_of_mem_nhds h) + +lemma cont_diff_within_at_insert {y : E} : + cont_diff_within_at 𝕜 n f (insert y s) x ↔ cont_diff_within_at 𝕜 n f s x := +begin + simp_rw [cont_diff_within_at], + rcases eq_or_ne x y with rfl|h, + { simp_rw [insert_eq_of_mem (mem_insert _ _)] }, + simp_rw [insert_comm x y, nhds_within_insert_of_ne h] +end + +alias cont_diff_within_at_insert ↔ cont_diff_within_at.of_insert cont_diff_within_at.insert' + +lemma cont_diff_within_at.insert (h : cont_diff_within_at 𝕜 n f s x) : + cont_diff_within_at 𝕜 n f (insert x s) x := +h.insert' + +/-- If a function is `C^n` within a set at a point, with `n ≥ 1`, then it is differentiable +within this set at this point. -/ +lemma cont_diff_within_at.differentiable_within_at' + (h : cont_diff_within_at 𝕜 n f s x) (hn : 1 ≤ n) : + differentiable_within_at 𝕜 f (insert x s) x := +begin + rcases h 1 hn with ⟨u, hu, p, H⟩, + rcases mem_nhds_within.1 hu with ⟨t, t_open, xt, tu⟩, + rw inter_comm at tu, + have := ((H.mono tu).differentiable_on le_rfl) x ⟨mem_insert x s, xt⟩, + exact (differentiable_within_at_inter (is_open.mem_nhds t_open xt)).1 this, +end + +lemma cont_diff_within_at.differentiable_within_at + (h : cont_diff_within_at 𝕜 n f s x) (hn : 1 ≤ n) : + differentiable_within_at 𝕜 f s x := +(h.differentiable_within_at' hn).mono (subset_insert x s) + +/-- A function is `C^(n + 1)` on a domain iff locally, it has a derivative which is `C^n`. -/ +theorem cont_diff_within_at_succ_iff_has_fderiv_within_at {n : ℕ} : + cont_diff_within_at 𝕜 ((n + 1) : ℕ) f s x + ↔ ∃ u ∈ 𝓝[insert x s] x, ∃ f' : E → (E →L[𝕜] F), + (∀ x ∈ u, has_fderiv_within_at f (f' x) u x) ∧ (cont_diff_within_at 𝕜 n f' u x) := +begin + split, + { assume h, + rcases h n.succ le_rfl with ⟨u, hu, p, Hp⟩, + refine ⟨u, hu, λ y, (continuous_multilinear_curry_fin1 𝕜 E F) (p y 1), + λ y hy, Hp.has_fderiv_within_at (with_top.coe_le_coe.2 (nat.le_add_left 1 n)) hy, _⟩, + assume m hm, + refine ⟨u, _, λ (y : E), (p y).shift, _⟩, + { convert self_mem_nhds_within, + have : x ∈ insert x s, by simp, + exact (insert_eq_of_mem (mem_of_mem_nhds_within this hu)) }, + { rw has_ftaylor_series_up_to_on_succ_iff_right at Hp, + exact Hp.2.2.of_le hm } }, + { rintros ⟨u, hu, f', f'_eq_deriv, Hf'⟩, + rw cont_diff_within_at_nat, + rcases Hf' n le_rfl with ⟨v, hv, p', Hp'⟩, + refine ⟨v ∩ u, _, λ x, (p' x).unshift (f x), _⟩, + { apply filter.inter_mem _ hu, + apply nhds_within_le_of_mem hu, + exact nhds_within_mono _ (subset_insert x u) hv }, + { rw has_ftaylor_series_up_to_on_succ_iff_right, + refine ⟨λ y hy, rfl, λ y hy, _, _⟩, + { change has_fderiv_within_at (λ z, (continuous_multilinear_curry_fin0 𝕜 E F).symm (f z)) + ((formal_multilinear_series.unshift (p' y) (f y) 1).curry_left) (v ∩ u) y, + rw linear_isometry_equiv.comp_has_fderiv_within_at_iff', + convert (f'_eq_deriv y hy.2).mono (inter_subset_right v u), + rw ← Hp'.zero_eq y hy.1, + ext z, + change ((p' y 0) (init (@cons 0 (λ i, E) z 0))) (@cons 0 (λ i, E) z 0 (last 0)) + = ((p' y 0) 0) z, + unfold_coes, + congr, + dec_trivial }, + { convert (Hp'.mono (inter_subset_left v u)).congr (λ x hx, Hp'.zero_eq x hx.1), + { ext x y, + change p' x 0 (init (@snoc 0 (λ i : fin 1, E) 0 y)) y = p' x 0 0 y, + rw init_snoc }, + { ext x k v y, + change p' x k (init (@snoc k (λ i : fin k.succ, E) v y)) + (@snoc k (λ i : fin k.succ, E) v y (last k)) = p' x k v y, + rw [snoc_last, init_snoc] } } } } +end + +/-- A version of `cont_diff_within_at_succ_iff_has_fderiv_within_at` where all derivatives + are taken within the same set. -/ +lemma cont_diff_within_at_succ_iff_has_fderiv_within_at' {n : ℕ} : + cont_diff_within_at 𝕜 (n + 1 : ℕ) f s x + ↔ ∃ u ∈ 𝓝[insert x s] x, u ⊆ insert x s ∧ ∃ f' : E → E →L[𝕜] F, + (∀ x ∈ u, has_fderiv_within_at f (f' x) s x) ∧ cont_diff_within_at 𝕜 n f' s x := +begin + refine ⟨λ hf, _, _⟩, + { obtain ⟨u, hu, f', huf', hf'⟩ := cont_diff_within_at_succ_iff_has_fderiv_within_at.mp hf, + obtain ⟨w, hw, hxw, hwu⟩ := mem_nhds_within.mp hu, + rw [inter_comm] at hwu, + refine ⟨insert x s ∩ w, inter_mem_nhds_within _ (hw.mem_nhds hxw), inter_subset_left _ _, + f', λ y hy, _, _⟩, + { refine ((huf' y $ hwu hy).mono hwu).mono_of_mem _, + refine mem_of_superset _ (inter_subset_inter_left _ (subset_insert _ _)), + refine inter_mem_nhds_within _ (hw.mem_nhds hy.2) }, + { exact hf'.mono_of_mem (nhds_within_mono _ (subset_insert _ _) hu) } }, + { rw [← cont_diff_within_at_insert, cont_diff_within_at_succ_iff_has_fderiv_within_at, + insert_eq_of_mem (mem_insert _ _)], + rintro ⟨u, hu, hus, f', huf', hf'⟩, + refine ⟨u, hu, f', λ y hy, (huf' y hy).insert'.mono hus, hf'.insert.mono hus⟩ } +end + +/-! ### Smooth functions within a set -/ + +variable (𝕜) + +/-- A function is continuously differentiable up to `n` on `s` if, for any point `x` in `s`, it +admits continuous derivatives up to order `n` on a neighborhood of `x` in `s`. + +For `n = ∞`, we only require that this holds up to any finite order (where the neighborhood may +depend on the finite order we consider). +-/ +def cont_diff_on (n : ℕ∞) (f : E → F) (s : set E) : Prop := +∀ x ∈ s, cont_diff_within_at 𝕜 n f s x + +variable {𝕜} + +lemma has_ftaylor_series_up_to_on.cont_diff_on {f' : E → formal_multilinear_series 𝕜 E F} + (hf : has_ftaylor_series_up_to_on n f f' s) : cont_diff_on 𝕜 n f s := +begin + intros x hx m hm, + use s, + simp only [set.insert_eq_of_mem hx, self_mem_nhds_within, true_and], + exact ⟨f', hf.of_le hm⟩, +end + +lemma cont_diff_on.cont_diff_within_at (h : cont_diff_on 𝕜 n f s) (hx : x ∈ s) : + cont_diff_within_at 𝕜 n f s x := +h x hx + +lemma cont_diff_within_at.cont_diff_on' {m : ℕ} + (hm : (m : ℕ∞) ≤ n) (h : cont_diff_within_at 𝕜 n f s x) : + ∃ u, is_open u ∧ x ∈ u ∧ cont_diff_on 𝕜 m f (insert x s ∩ u) := +begin + rcases h m hm with ⟨t, ht, p, hp⟩, + rcases mem_nhds_within.1 ht with ⟨u, huo, hxu, hut⟩, + rw [inter_comm] at hut, + exact ⟨u, huo, hxu, (hp.mono hut).cont_diff_on⟩ +end + +lemma cont_diff_within_at.cont_diff_on {m : ℕ} + (hm : (m : ℕ∞) ≤ n) (h : cont_diff_within_at 𝕜 n f s x) : + ∃ u ∈ 𝓝[insert x s] x, u ⊆ insert x s ∧ cont_diff_on 𝕜 m f u := +let ⟨u, uo, xu, h⟩ := h.cont_diff_on' hm +in ⟨_, inter_mem_nhds_within _ (uo.mem_nhds xu), inter_subset_left _ _, h⟩ + +protected lemma cont_diff_within_at.eventually {n : ℕ} + (h : cont_diff_within_at 𝕜 n f s x) : + ∀ᶠ y in 𝓝[insert x s] x, cont_diff_within_at 𝕜 n f s y := +begin + rcases h.cont_diff_on le_rfl with ⟨u, hu, hu_sub, hd⟩, + have : ∀ᶠ (y : E) in 𝓝[insert x s] x, u ∈ 𝓝[insert x s] y ∧ y ∈ u, + from (eventually_nhds_within_nhds_within.2 hu).and hu, + refine this.mono (λ y hy, (hd y hy.2).mono_of_mem _), + exact nhds_within_mono y (subset_insert _ _) hy.1 +end + +lemma cont_diff_on.of_le (h : cont_diff_on 𝕜 n f s) (hmn : m ≤ n) : + cont_diff_on 𝕜 m f s := +λ x hx, (h x hx).of_le hmn + +lemma cont_diff_on.of_succ {n : ℕ} (h : cont_diff_on 𝕜 (n + 1) f s) : cont_diff_on 𝕜 n f s := +h.of_le $ with_top.coe_le_coe.mpr le_self_add + +lemma cont_diff_on.one_of_succ {n : ℕ} (h : cont_diff_on 𝕜 (n + 1) f s) : cont_diff_on 𝕜 1 f s := +h.of_le $ with_top.coe_le_coe.mpr le_add_self + +lemma cont_diff_on_iff_forall_nat_le : + cont_diff_on 𝕜 n f s ↔ ∀ m : ℕ, ↑m ≤ n → cont_diff_on 𝕜 m f s := +⟨λ H m hm, H.of_le hm, λ H x hx m hm, H m hm x hx m le_rfl⟩ + +lemma cont_diff_on_top : + cont_diff_on 𝕜 ∞ f s ↔ ∀ (n : ℕ), cont_diff_on 𝕜 n f s := +cont_diff_on_iff_forall_nat_le.trans $ by simp only [le_top, forall_prop_of_true] + +lemma cont_diff_on_all_iff_nat : + (∀ n, cont_diff_on 𝕜 n f s) ↔ (∀ n : ℕ, cont_diff_on 𝕜 n f s) := +begin + refine ⟨λ H n, H n, _⟩, + rintro H (_|n), + exacts [cont_diff_on_top.2 H, H n] +end + +lemma cont_diff_on.continuous_on + (h : cont_diff_on 𝕜 n f s) : continuous_on f s := +λ x hx, (h x hx).continuous_within_at + +lemma cont_diff_on.congr + (h : cont_diff_on 𝕜 n f s) (h₁ : ∀ x ∈ s, f₁ x = f x) : + cont_diff_on 𝕜 n f₁ s := +λ x hx, (h x hx).congr h₁ (h₁ x hx) + +lemma cont_diff_on_congr (h₁ : ∀ x ∈ s, f₁ x = f x) : + cont_diff_on 𝕜 n f₁ s ↔ cont_diff_on 𝕜 n f s := +⟨λ H, H.congr (λ x hx, (h₁ x hx).symm), λ H, H.congr h₁⟩ + +lemma cont_diff_on.mono + (h : cont_diff_on 𝕜 n f s) {t : set E} (hst : t ⊆ s) : + cont_diff_on 𝕜 n f t := +λ x hx, (h x (hst hx)).mono hst + +lemma cont_diff_on.congr_mono + (hf : cont_diff_on 𝕜 n f s) (h₁ : ∀ x ∈ s₁, f₁ x = f x) (hs : s₁ ⊆ s) : + cont_diff_on 𝕜 n f₁ s₁ := +(hf.mono hs).congr h₁ + +/-- If a function is `C^n` on a set with `n ≥ 1`, then it is differentiable there. -/ +lemma cont_diff_on.differentiable_on + (h : cont_diff_on 𝕜 n f s) (hn : 1 ≤ n) : differentiable_on 𝕜 f s := +λ x hx, (h x hx).differentiable_within_at hn + +/-- If a function is `C^n` around each point in a set, then it is `C^n` on the set. -/ +lemma cont_diff_on_of_locally_cont_diff_on + (h : ∀ x ∈ s, ∃u, is_open u ∧ x ∈ u ∧ cont_diff_on 𝕜 n f (s ∩ u)) : + cont_diff_on 𝕜 n f s := +begin + assume x xs, + rcases h x xs with ⟨u, u_open, xu, hu⟩, + apply (cont_diff_within_at_inter _).1 (hu x ⟨xs, xu⟩), + exact is_open.mem_nhds u_open xu +end + +/-- A function is `C^(n + 1)` on a domain iff locally, it has a derivative which is `C^n`. -/ +theorem cont_diff_on_succ_iff_has_fderiv_within_at {n : ℕ} : + cont_diff_on 𝕜 ((n + 1) : ℕ) f s + ↔ ∀ x ∈ s, ∃ u ∈ 𝓝[insert x s] x, ∃ f' : E → (E →L[𝕜] F), + (∀ x ∈ u, has_fderiv_within_at f (f' x) u x) ∧ (cont_diff_on 𝕜 n f' u) := +begin + split, + { assume h x hx, + rcases (h x hx) n.succ le_rfl with ⟨u, hu, p, Hp⟩, + refine ⟨u, hu, λ y, (continuous_multilinear_curry_fin1 𝕜 E F) (p y 1), + λ y hy, Hp.has_fderiv_within_at (with_top.coe_le_coe.2 (nat.le_add_left 1 n)) hy, _⟩, + rw has_ftaylor_series_up_to_on_succ_iff_right at Hp, + assume z hz m hm, + refine ⟨u, _, λ (x : E), (p x).shift, Hp.2.2.of_le hm⟩, + convert self_mem_nhds_within, + exact insert_eq_of_mem hz, }, + { assume h x hx, + rw cont_diff_within_at_succ_iff_has_fderiv_within_at, + rcases h x hx with ⟨u, u_nhbd, f', hu, hf'⟩, + have : x ∈ u := mem_of_mem_nhds_within (mem_insert _ _) u_nhbd, + exact ⟨u, u_nhbd, f', hu, hf' x this⟩ } +end + +/-! ### Iterated derivative within a set -/ +variable (𝕜) + +/-- +The `n`-th derivative of a function along a set, defined inductively by saying that the `n+1`-th +derivative of `f` is the derivative of the `n`-th derivative of `f` along this set, together with +an uncurrying step to see it as a multilinear map in `n+1` variables.. +-/ +noncomputable def iterated_fderiv_within (n : ℕ) (f : E → F) (s : set E) : + E → (E [×n]→L[𝕜] F) := +nat.rec_on n + (λ x, continuous_multilinear_map.curry0 𝕜 E (f x)) + (λ n rec x, continuous_linear_map.uncurry_left (fderiv_within 𝕜 rec s x)) + +/-- Formal Taylor series associated to a function within a set. -/ +def ftaylor_series_within (f : E → F) (s : set E) (x : E) : formal_multilinear_series 𝕜 E F := +λ n, iterated_fderiv_within 𝕜 n f s x + +variable {𝕜} + +@[simp] lemma iterated_fderiv_within_zero_apply (m : (fin 0) → E) : + (iterated_fderiv_within 𝕜 0 f s x : ((fin 0) → E) → F) m = f x := rfl + +lemma iterated_fderiv_within_zero_eq_comp : + iterated_fderiv_within 𝕜 0 f s = (continuous_multilinear_curry_fin0 𝕜 E F).symm ∘ f := rfl + +@[simp] lemma norm_iterated_fderiv_within_zero : + ‖iterated_fderiv_within 𝕜 0 f s x‖ = ‖f x‖ := +by rw [iterated_fderiv_within_zero_eq_comp, linear_isometry_equiv.norm_map] + +lemma iterated_fderiv_within_succ_apply_left {n : ℕ} (m : fin (n + 1) → E): + (iterated_fderiv_within 𝕜 (n + 1) f s x : (fin (n + 1) → E) → F) m + = (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n f s) s x : E → (E [×n]→L[𝕜] F)) + (m 0) (tail m) := rfl + +/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, +and the derivative of the `n`-th derivative. -/ +lemma iterated_fderiv_within_succ_eq_comp_left {n : ℕ} : + iterated_fderiv_within 𝕜 (n + 1) f s = + (continuous_multilinear_curry_left_equiv 𝕜 (λ(i : fin (n + 1)), E) F) + ∘ (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n f s) s) := rfl + +lemma norm_fderiv_within_iterated_fderiv_within {n : ℕ} : + ‖fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n f s) s x‖ = + ‖iterated_fderiv_within 𝕜 (n + 1) f s x‖ := +by rw [iterated_fderiv_within_succ_eq_comp_left, linear_isometry_equiv.norm_map] + +theorem iterated_fderiv_within_succ_apply_right {n : ℕ} + (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) (m : fin (n + 1) → E) : + (iterated_fderiv_within 𝕜 (n + 1) f s x : (fin (n + 1) → E) → F) m + = iterated_fderiv_within 𝕜 n (λy, fderiv_within 𝕜 f s y) s x (init m) (m (last n)) := +begin + induction n with n IH generalizing x, + { rw [iterated_fderiv_within_succ_eq_comp_left, iterated_fderiv_within_zero_eq_comp, + iterated_fderiv_within_zero_apply, + function.comp_apply, linear_isometry_equiv.comp_fderiv_within _ (hs x hx)], + refl }, + { let I := continuous_multilinear_curry_right_equiv' 𝕜 n E F, + have A : ∀ y ∈ s, iterated_fderiv_within 𝕜 n.succ f s y + = (I ∘ (iterated_fderiv_within 𝕜 n (λy, fderiv_within 𝕜 f s y) s)) y, + by { assume y hy, ext m, rw @IH m y hy, refl }, + calc + (iterated_fderiv_within 𝕜 (n+2) f s x : (fin (n+2) → E) → F) m = + (fderiv_within 𝕜 (iterated_fderiv_within 𝕜 n.succ f s) s x + : E → (E [×(n + 1)]→L[𝕜] F)) (m 0) (tail m) : rfl + ... = (fderiv_within 𝕜 (I ∘ (iterated_fderiv_within 𝕜 n (fderiv_within 𝕜 f s) s)) s x + : E → (E [×(n + 1)]→L[𝕜] F)) (m 0) (tail m) : + by rw fderiv_within_congr A (A x hx) + ... = (I ∘ fderiv_within 𝕜 ((iterated_fderiv_within 𝕜 n (fderiv_within 𝕜 f s) s)) s x + : E → (E [×(n + 1)]→L[𝕜] F)) (m 0) (tail m) : + by { rw linear_isometry_equiv.comp_fderiv_within _ (hs x hx), refl } + ... = (fderiv_within 𝕜 ((iterated_fderiv_within 𝕜 n (λ y, fderiv_within 𝕜 f s y) s)) s x + : E → (E [×n]→L[𝕜] (E →L[𝕜] F))) (m 0) (init (tail m)) ((tail m) (last n)) : rfl + ... = iterated_fderiv_within 𝕜 (nat.succ n) (λ y, fderiv_within 𝕜 f s y) s x + (init m) (m (last (n + 1))) : + by { rw [iterated_fderiv_within_succ_apply_left, tail_init_eq_init_tail], refl } } +end + +/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, +and the `n`-th derivative of the derivative. -/ +lemma iterated_fderiv_within_succ_eq_comp_right {n : ℕ} (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : + iterated_fderiv_within 𝕜 (n + 1) f s x = + ((continuous_multilinear_curry_right_equiv' 𝕜 n E F) + ∘ (iterated_fderiv_within 𝕜 n (λy, fderiv_within 𝕜 f s y) s)) x := +by { ext m, rw iterated_fderiv_within_succ_apply_right hs hx, refl } + +lemma norm_iterated_fderiv_within_fderiv_within {n : ℕ} (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : + ‖iterated_fderiv_within 𝕜 n (fderiv_within 𝕜 f s) s x‖ = + ‖iterated_fderiv_within 𝕜 (n + 1) f s x‖ := +by rw [iterated_fderiv_within_succ_eq_comp_right hs hx, linear_isometry_equiv.norm_map] + +@[simp] lemma iterated_fderiv_within_one_apply + (h : unique_diff_within_at 𝕜 s x) (m : fin 1 → E) : + (iterated_fderiv_within 𝕜 1 f s x : ((fin 1) → E) → F) m + = (fderiv_within 𝕜 f s x : E → F) (m 0) := +begin + simp only [iterated_fderiv_within_succ_apply_left, iterated_fderiv_within_zero_eq_comp, + (continuous_multilinear_curry_fin0 𝕜 E F).symm.comp_fderiv_within h], + refl +end + +lemma filter.eventually_eq.iterated_fderiv_within' (h : f₁ =ᶠ[𝓝[s] x] f) (ht : t ⊆ s) (n : ℕ) : + iterated_fderiv_within 𝕜 n f₁ t =ᶠ[𝓝[s] x] iterated_fderiv_within 𝕜 n f t := +begin + induction n with n ihn, + { exact h.mono (λ y hy, fun_like.ext _ _ $ λ _, hy) }, + { have : fderiv_within 𝕜 _ t =ᶠ[𝓝[s] x] fderiv_within 𝕜 _ t := ihn.fderiv_within' ht, + apply this.mono, + intros y hy, + simp only [iterated_fderiv_within_succ_eq_comp_left, hy, (∘)] } +end + +protected lemma filter.eventually_eq.iterated_fderiv_within (h : f₁ =ᶠ[𝓝[s] x] f) (n : ℕ) : + iterated_fderiv_within 𝕜 n f₁ s =ᶠ[𝓝[s] x] iterated_fderiv_within 𝕜 n f s := +h.iterated_fderiv_within' subset.rfl n + +/-- If two functions coincide in a neighborhood of `x` within a set `s` and at `x`, then their +iterated differentials within this set at `x` coincide. -/ +lemma filter.eventually_eq.iterated_fderiv_within_eq (h : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) + (n : ℕ) : iterated_fderiv_within 𝕜 n f₁ s x = iterated_fderiv_within 𝕜 n f s x := +have f₁ =ᶠ[𝓝[insert x s] x] f, by simpa [eventually_eq, hx], +(this.iterated_fderiv_within' (subset_insert _ _) n).self_of_nhds_within (mem_insert _ _) + +/-- If two functions coincide on a set `s`, then their iterated differentials within this set +coincide. See also `filter.eventually_eq.iterated_fderiv_within_eq` and +`filter.eventually_eq.iterated_fderiv_within`. -/ +lemma iterated_fderiv_within_congr (hs : eq_on f₁ f s) (hx : x ∈ s) (n : ℕ) : + iterated_fderiv_within 𝕜 n f₁ s x = iterated_fderiv_within 𝕜 n f s x := +(hs.eventually_eq.filter_mono inf_le_right).iterated_fderiv_within_eq (hs hx) _ + +/-- If two functions coincide on a set `s`, then their iterated differentials within this set +coincide. See also `filter.eventually_eq.iterated_fderiv_within_eq` and +`filter.eventually_eq.iterated_fderiv_within`. -/ +protected lemma set.eq_on.iterated_fderiv_within (hs : eq_on f₁ f s) (n : ℕ) : + eq_on (iterated_fderiv_within 𝕜 n f₁ s) (iterated_fderiv_within 𝕜 n f s) s := +λ x hx, iterated_fderiv_within_congr hs hx n + +lemma iterated_fderiv_within_eventually_congr_set' (y : E) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) (n : ℕ) : + iterated_fderiv_within 𝕜 n f s =ᶠ[𝓝 x] iterated_fderiv_within 𝕜 n f t := +begin + induction n with n ihn generalizing x, + { refl }, + { refine (eventually_nhds_nhds_within.2 h).mono (λ y hy, _), + simp only [iterated_fderiv_within_succ_eq_comp_left, (∘)], + rw [(ihn hy).fderiv_within_eq_nhds, fderiv_within_congr_set' _ hy] } +end + +lemma iterated_fderiv_within_eventually_congr_set (h : s =ᶠ[𝓝 x] t) (n : ℕ) : + iterated_fderiv_within 𝕜 n f s =ᶠ[𝓝 x] iterated_fderiv_within 𝕜 n f t := +iterated_fderiv_within_eventually_congr_set' x (h.filter_mono inf_le_left) n + +lemma iterated_fderiv_within_congr_set (h : s =ᶠ[𝓝 x] t) (n : ℕ) : + iterated_fderiv_within 𝕜 n f s x = iterated_fderiv_within 𝕜 n f t x := +(iterated_fderiv_within_eventually_congr_set h n).self_of_nhds + +/-- The iterated differential within a set `s` at a point `x` is not modified if one intersects +`s` with a neighborhood of `x` within `s`. -/ +lemma iterated_fderiv_within_inter' {n : ℕ} (hu : u ∈ 𝓝[s] x) : + iterated_fderiv_within 𝕜 n f (s ∩ u) x = iterated_fderiv_within 𝕜 n f s x := +iterated_fderiv_within_congr_set (nhds_within_eq_iff_eventually_eq.1 $ nhds_within_inter_of_mem' hu) + _ + +/-- The iterated differential within a set `s` at a point `x` is not modified if one intersects +`s` with a neighborhood of `x`. -/ +lemma iterated_fderiv_within_inter {n : ℕ} (hu : u ∈ 𝓝 x) : + iterated_fderiv_within 𝕜 n f (s ∩ u) x = iterated_fderiv_within 𝕜 n f s x := +iterated_fderiv_within_inter' (mem_nhds_within_of_mem_nhds hu) + +/-- The iterated differential within a set `s` at a point `x` is not modified if one intersects +`s` with an open set containing `x`. -/ +lemma iterated_fderiv_within_inter_open {n : ℕ} (hu : is_open u) (hx : x ∈ u) : + iterated_fderiv_within 𝕜 n f (s ∩ u) x = iterated_fderiv_within 𝕜 n f s x := +iterated_fderiv_within_inter (hu.mem_nhds hx) + +@[simp] lemma cont_diff_on_zero : + cont_diff_on 𝕜 0 f s ↔ continuous_on f s := +begin + refine ⟨λ H, H.continuous_on, λ H, _⟩, + assume x hx m hm, + have : (m : ℕ∞) = 0 := le_antisymm hm bot_le, + rw this, + refine ⟨insert x s, self_mem_nhds_within, ftaylor_series_within 𝕜 f s, _⟩, + rw has_ftaylor_series_up_to_on_zero_iff, + exact ⟨by rwa insert_eq_of_mem hx, λ x hx, by simp [ftaylor_series_within]⟩ +end + +lemma cont_diff_within_at_zero (hx : x ∈ s) : + cont_diff_within_at 𝕜 0 f s x ↔ ∃ u ∈ 𝓝[s] x, continuous_on f (s ∩ u) := +begin + split, + { intros h, + obtain ⟨u, H, p, hp⟩ := h 0 (by norm_num), + refine ⟨u, _, _⟩, + { simpa [hx] using H }, + { simp only [with_top.coe_zero, has_ftaylor_series_up_to_on_zero_iff] at hp, + exact hp.1.mono (inter_subset_right s u) } }, + { rintros ⟨u, H, hu⟩, + rw ← cont_diff_within_at_inter' H, + have h' : x ∈ s ∩ u := ⟨hx, mem_of_mem_nhds_within hx H⟩, + exact (cont_diff_on_zero.mpr hu).cont_diff_within_at h' } +end + +/-- On a set with unique differentiability, any choice of iterated differential has to coincide +with the one we have chosen in `iterated_fderiv_within 𝕜 m f s`. -/ +theorem has_ftaylor_series_up_to_on.eq_ftaylor_series_of_unique_diff_on + (h : has_ftaylor_series_up_to_on n f p s) + {m : ℕ} (hmn : (m : ℕ∞) ≤ n) (hs : unique_diff_on 𝕜 s) (hx : x ∈ s) : + p x m = iterated_fderiv_within 𝕜 m f s x := +begin + induction m with m IH generalizing x, + { rw [h.zero_eq' hx, iterated_fderiv_within_zero_eq_comp] }, + { have A : (m : ℕ∞) < n := lt_of_lt_of_le (with_top.coe_lt_coe.2 (lt_add_one m)) hmn, + have : has_fderiv_within_at (λ (y : E), iterated_fderiv_within 𝕜 m f s y) + (continuous_multilinear_map.curry_left (p x (nat.succ m))) s x := + (h.fderiv_within m A x hx).congr (λ y hy, (IH (le_of_lt A) hy).symm) (IH (le_of_lt A) hx).symm, + rw [iterated_fderiv_within_succ_eq_comp_left, function.comp_apply, + this.fderiv_within (hs x hx)], + exact (continuous_multilinear_map.uncurry_curry_left _).symm } +end + +/-- When a function is `C^n` in a set `s` of unique differentiability, it admits +`ftaylor_series_within 𝕜 f s` as a Taylor series up to order `n` in `s`. -/ +theorem cont_diff_on.ftaylor_series_within + (h : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) : + has_ftaylor_series_up_to_on n f (ftaylor_series_within 𝕜 f s) s := +begin + split, + { assume x hx, + simp only [ftaylor_series_within, continuous_multilinear_map.uncurry0_apply, + iterated_fderiv_within_zero_apply] }, + { assume m hm x hx, + rcases (h x hx) m.succ (enat.add_one_le_of_lt hm) with ⟨u, hu, p, Hp⟩, + rw insert_eq_of_mem hx at hu, + rcases mem_nhds_within.1 hu with ⟨o, o_open, xo, ho⟩, + rw inter_comm at ho, + have : p x m.succ = ftaylor_series_within 𝕜 f s x m.succ, + { change p x m.succ = iterated_fderiv_within 𝕜 m.succ f s x, + rw [← iterated_fderiv_within_inter_open o_open xo], + exact (Hp.mono ho).eq_ftaylor_series_of_unique_diff_on le_rfl + (hs.inter o_open) ⟨hx, xo⟩ }, + rw [← this, ← has_fderiv_within_at_inter (is_open.mem_nhds o_open xo)], + have A : ∀ y ∈ s ∩ o, p y m = ftaylor_series_within 𝕜 f s y m, + { rintros y ⟨hy, yo⟩, + change p y m = iterated_fderiv_within 𝕜 m f s y, + rw [← iterated_fderiv_within_inter_open o_open yo], + exact (Hp.mono ho).eq_ftaylor_series_of_unique_diff_on (with_top.coe_le_coe.2 (nat.le_succ m)) + (hs.inter o_open) ⟨hy, yo⟩ }, + exact ((Hp.mono ho).fderiv_within m (with_top.coe_lt_coe.2 (lt_add_one m)) x ⟨hx, xo⟩).congr + (λ y hy, (A y hy).symm) (A x ⟨hx, xo⟩).symm }, + { assume m hm, + apply continuous_on_of_locally_continuous_on, + assume x hx, + rcases h x hx m hm with ⟨u, hu, p, Hp⟩, + rcases mem_nhds_within.1 hu with ⟨o, o_open, xo, ho⟩, + rw insert_eq_of_mem hx at ho, + rw inter_comm at ho, + refine ⟨o, o_open, xo, _⟩, + have A : ∀ y ∈ s ∩ o, p y m = ftaylor_series_within 𝕜 f s y m, + { rintros y ⟨hy, yo⟩, + change p y m = iterated_fderiv_within 𝕜 m f s y, + rw [← iterated_fderiv_within_inter_open o_open yo], + exact (Hp.mono ho).eq_ftaylor_series_of_unique_diff_on le_rfl + (hs.inter o_open) ⟨hy, yo⟩ }, + exact ((Hp.mono ho).cont m le_rfl).congr (λ y hy, (A y hy).symm) } +end + +lemma cont_diff_on_of_continuous_on_differentiable_on + (Hcont : ∀ (m : ℕ), (m : ℕ∞) ≤ n → + continuous_on (λ x, iterated_fderiv_within 𝕜 m f s x) s) + (Hdiff : ∀ (m : ℕ), (m : ℕ∞) < n → + differentiable_on 𝕜 (λ x, iterated_fderiv_within 𝕜 m f s x) s) : + cont_diff_on 𝕜 n f s := +begin + assume x hx m hm, + rw insert_eq_of_mem hx, + refine ⟨s, self_mem_nhds_within, ftaylor_series_within 𝕜 f s, _⟩, + split, + { assume y hy, + simp only [ftaylor_series_within, continuous_multilinear_map.uncurry0_apply, + iterated_fderiv_within_zero_apply] }, + { assume k hk y hy, + convert (Hdiff k (lt_of_lt_of_le hk hm) y hy).has_fderiv_within_at, + simp only [ftaylor_series_within, iterated_fderiv_within_succ_eq_comp_left, + continuous_linear_equiv.coe_apply, function.comp_app, coe_fn_coe_base], + exact continuous_linear_map.curry_uncurry_left _ }, + { assume k hk, + exact Hcont k (le_trans hk hm) } +end + +lemma cont_diff_on_of_differentiable_on + (h : ∀(m : ℕ), (m : ℕ∞) ≤ n → differentiable_on 𝕜 (iterated_fderiv_within 𝕜 m f s) s) : + cont_diff_on 𝕜 n f s := +cont_diff_on_of_continuous_on_differentiable_on + (λ m hm, (h m hm).continuous_on) (λ m hm, (h m (le_of_lt hm))) + +lemma cont_diff_on.continuous_on_iterated_fderiv_within {m : ℕ} + (h : cont_diff_on 𝕜 n f s) (hmn : (m : ℕ∞) ≤ n) (hs : unique_diff_on 𝕜 s) : + continuous_on (iterated_fderiv_within 𝕜 m f s) s := +(h.ftaylor_series_within hs).cont m hmn + +lemma cont_diff_on.differentiable_on_iterated_fderiv_within {m : ℕ} + (h : cont_diff_on 𝕜 n f s) (hmn : (m : ℕ∞) < n) (hs : unique_diff_on 𝕜 s) : + differentiable_on 𝕜 (iterated_fderiv_within 𝕜 m f s) s := +λ x hx, ((h.ftaylor_series_within hs).fderiv_within m hmn x hx).differentiable_within_at + +lemma cont_diff_within_at.differentiable_within_at_iterated_fderiv_within {m : ℕ} + (h : cont_diff_within_at 𝕜 n f s x) (hmn : (m : ℕ∞) < n) + (hs : unique_diff_on 𝕜 (insert x s)) : + differentiable_within_at 𝕜 (iterated_fderiv_within 𝕜 m f s) s x := +begin + rcases h.cont_diff_on' (enat.add_one_le_of_lt hmn) with ⟨u, uo, xu, hu⟩, + set t := insert x s ∩ u, + have A : t =ᶠ[𝓝[≠] x] s, + { simp only [set_eventually_eq_iff_inf_principal, ← nhds_within_inter'], + rw [← inter_assoc, nhds_within_inter_of_mem', ← diff_eq_compl_inter, insert_diff_of_mem, + diff_eq_compl_inter], + exacts [rfl, mem_nhds_within_of_mem_nhds (uo.mem_nhds xu)] }, + have B : iterated_fderiv_within 𝕜 m f s =ᶠ[𝓝 x] iterated_fderiv_within 𝕜 m f t, + from iterated_fderiv_within_eventually_congr_set' _ A.symm _, + have C : differentiable_within_at 𝕜 (iterated_fderiv_within 𝕜 m f t) t x, + from hu.differentiable_on_iterated_fderiv_within (nat.cast_lt.2 m.lt_succ_self) (hs.inter uo) x + ⟨mem_insert _ _, xu⟩, + rw [differentiable_within_at_congr_set' _ A] at C, + exact C.congr_of_eventually_eq (B.filter_mono inf_le_left) B.self_of_nhds +end + +lemma cont_diff_on_iff_continuous_on_differentiable_on + (hs : unique_diff_on 𝕜 s) : + cont_diff_on 𝕜 n f s ↔ + (∀ (m : ℕ), (m : ℕ∞) ≤ n → + continuous_on (λ x, iterated_fderiv_within 𝕜 m f s x) s) + ∧ (∀ (m : ℕ), (m : ℕ∞) < n → + differentiable_on 𝕜 (λ x, iterated_fderiv_within 𝕜 m f s x) s) := +⟨λ h, ⟨λ m hm, h.continuous_on_iterated_fderiv_within hm hs, + λ m hm, h.differentiable_on_iterated_fderiv_within hm hs⟩, + λ h, cont_diff_on_of_continuous_on_differentiable_on h.1 h.2⟩ + +lemma cont_diff_on_succ_of_fderiv_within {n : ℕ} (hf : differentiable_on 𝕜 f s) + (h : cont_diff_on 𝕜 n (λ y, fderiv_within 𝕜 f s y) s) : + cont_diff_on 𝕜 ((n + 1) : ℕ) f s := +begin + intros x hx, + rw [cont_diff_within_at_succ_iff_has_fderiv_within_at, insert_eq_of_mem hx], + exact ⟨s, self_mem_nhds_within, fderiv_within 𝕜 f s, + λ y hy, (hf y hy).has_fderiv_within_at, h x hx⟩ +end + +/-- A function is `C^(n + 1)` on a domain with unique derivatives if and only if it is +differentiable there, and its derivative (expressed with `fderiv_within`) is `C^n`. -/ +theorem cont_diff_on_succ_iff_fderiv_within {n : ℕ} (hs : unique_diff_on 𝕜 s) : + cont_diff_on 𝕜 ((n + 1) : ℕ) f s ↔ + differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 n (λ y, fderiv_within 𝕜 f s y) s := +begin + refine ⟨λ H, _, λ h, cont_diff_on_succ_of_fderiv_within h.1 h.2⟩, + refine ⟨H.differentiable_on (with_top.coe_le_coe.2 (nat.le_add_left 1 n)), λ x hx, _⟩, + rcases cont_diff_within_at_succ_iff_has_fderiv_within_at.1 (H x hx) + with ⟨u, hu, f', hff', hf'⟩, + rcases mem_nhds_within.1 hu with ⟨o, o_open, xo, ho⟩, + rw [inter_comm, insert_eq_of_mem hx] at ho, + have := hf'.mono ho, + rw cont_diff_within_at_inter' (mem_nhds_within_of_mem_nhds (is_open.mem_nhds o_open xo)) + at this, + apply this.congr_of_eventually_eq' _ hx, + have : o ∩ s ∈ 𝓝[s] x := mem_nhds_within.2 ⟨o, o_open, xo, subset.refl _⟩, + rw inter_comm at this, + apply filter.eventually_eq_of_mem this (λ y hy, _), + have A : fderiv_within 𝕜 f (s ∩ o) y = f' y := + ((hff' y (ho hy)).mono ho).fderiv_within (hs.inter o_open y hy), + rwa fderiv_within_inter (o_open.mem_nhds hy.2) at A +end + +lemma cont_diff_on_succ_iff_has_fderiv_within {n : ℕ} (hs : unique_diff_on 𝕜 s) : + cont_diff_on 𝕜 ((n + 1) : ℕ) f s ↔ ∃ (f' : E → (E →L[𝕜] F)), + cont_diff_on 𝕜 n f' s ∧ ∀ x, x ∈ s → has_fderiv_within_at f (f' x) s x := +begin + rw cont_diff_on_succ_iff_fderiv_within hs, + refine ⟨λ h, ⟨fderiv_within 𝕜 f s, h.2, λ x hx, (h.1 x hx).has_fderiv_within_at⟩, λ h, _⟩, + rcases h with ⟨f', h1, h2⟩, + refine ⟨λ x hx, (h2 x hx).differentiable_within_at, λ x hx, _⟩, + exact (h1 x hx).congr' (λ y hy, (h2 y hy).fderiv_within (hs y hy)) hx, +end + +/-- A function is `C^(n + 1)` on an open domain if and only if it is +differentiable there, and its derivative (expressed with `fderiv`) is `C^n`. -/ +theorem cont_diff_on_succ_iff_fderiv_of_open {n : ℕ} (hs : is_open s) : + cont_diff_on 𝕜 ((n + 1) : ℕ) f s ↔ + differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 n (λ y, fderiv 𝕜 f y) s := +begin + rw cont_diff_on_succ_iff_fderiv_within hs.unique_diff_on, + congrm _ ∧ _, + apply cont_diff_on_congr, + assume x hx, + exact fderiv_within_of_open hs hx +end + +/-- A function is `C^∞` on a domain with unique derivatives if and only if it is differentiable +there, and its derivative (expressed with `fderiv_within`) is `C^∞`. -/ +theorem cont_diff_on_top_iff_fderiv_within (hs : unique_diff_on 𝕜 s) : + cont_diff_on 𝕜 ∞ f s ↔ + differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 ∞ (λ y, fderiv_within 𝕜 f s y) s := +begin + split, + { assume h, + refine ⟨h.differentiable_on le_top, _⟩, + apply cont_diff_on_top.2 (λ n, ((cont_diff_on_succ_iff_fderiv_within hs).1 _).2), + exact h.of_le le_top }, + { assume h, + refine cont_diff_on_top.2 (λ n, _), + have A : (n : ℕ∞) ≤ ∞ := le_top, + apply ((cont_diff_on_succ_iff_fderiv_within hs).2 ⟨h.1, h.2.of_le A⟩).of_le, + exact with_top.coe_le_coe.2 (nat.le_succ n) } +end + +/-- A function is `C^∞` on an open domain if and only if it is differentiable there, and its +derivative (expressed with `fderiv`) is `C^∞`. -/ +theorem cont_diff_on_top_iff_fderiv_of_open (hs : is_open s) : + cont_diff_on 𝕜 ∞ f s ↔ + differentiable_on 𝕜 f s ∧ cont_diff_on 𝕜 ∞ (λ y, fderiv 𝕜 f y) s := +begin + rw cont_diff_on_top_iff_fderiv_within hs.unique_diff_on, + congrm _ ∧ _, + apply cont_diff_on_congr, + assume x hx, + exact fderiv_within_of_open hs hx +end + +lemma cont_diff_on.fderiv_within + (hf : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hmn : m + 1 ≤ n) : + cont_diff_on 𝕜 m (λ y, fderiv_within 𝕜 f s y) s := +begin + cases m, + { change ∞ + 1 ≤ n at hmn, + have : n = ∞, by simpa using hmn, + rw this at hf, + exact ((cont_diff_on_top_iff_fderiv_within hs).1 hf).2 }, + { change (m.succ : ℕ∞) ≤ n at hmn, + exact ((cont_diff_on_succ_iff_fderiv_within hs).1 (hf.of_le hmn)).2 } +end + +lemma cont_diff_on.fderiv_of_open + (hf : cont_diff_on 𝕜 n f s) (hs : is_open s) (hmn : m + 1 ≤ n) : + cont_diff_on 𝕜 m (λ y, fderiv 𝕜 f y) s := +(hf.fderiv_within hs.unique_diff_on hmn).congr (λ x hx, (fderiv_within_of_open hs hx).symm) + +lemma cont_diff_on.continuous_on_fderiv_within + (h : cont_diff_on 𝕜 n f s) (hs : unique_diff_on 𝕜 s) (hn : 1 ≤ n) : + continuous_on (λ x, fderiv_within 𝕜 f s x) s := +((cont_diff_on_succ_iff_fderiv_within hs).1 (h.of_le hn)).2.continuous_on + +lemma cont_diff_on.continuous_on_fderiv_of_open + (h : cont_diff_on 𝕜 n f s) (hs : is_open s) (hn : 1 ≤ n) : + continuous_on (λ x, fderiv 𝕜 f x) s := +((cont_diff_on_succ_iff_fderiv_of_open hs).1 (h.of_le hn)).2.continuous_on + +/-! ### Functions with a Taylor series on the whole space -/ + +/-- `has_ftaylor_series_up_to n f p` registers the fact that `p 0 = f` and `p (m+1)` is a +derivative of `p m` for `m < n`, and is continuous for `m ≤ n`. This is a predicate analogous to +`has_fderiv_at` but for higher order derivatives. -/ +structure has_ftaylor_series_up_to (n : ℕ∞) + (f : E → F) (p : E → formal_multilinear_series 𝕜 E F) : Prop := +(zero_eq : ∀ x, (p x 0).uncurry0 = f x) +(fderiv : ∀ (m : ℕ) (hm : (m : ℕ∞) < n), ∀ x, + has_fderiv_at (λ y, p y m) (p x m.succ).curry_left x) +(cont : ∀ (m : ℕ) (hm : (m : ℕ∞) ≤ n), continuous (λ x, p x m)) + +lemma has_ftaylor_series_up_to.zero_eq' + (h : has_ftaylor_series_up_to n f p) (x : E) : + p x 0 = (continuous_multilinear_curry_fin0 𝕜 E F).symm (f x) := +by { rw ← h.zero_eq x, symmetry, exact continuous_multilinear_map.uncurry0_curry0 _ } + +lemma has_ftaylor_series_up_to_on_univ_iff : + has_ftaylor_series_up_to_on n f p univ ↔ has_ftaylor_series_up_to n f p := +begin + split, + { assume H, + split, + { exact λ x, H.zero_eq x (mem_univ x) }, + { assume m hm x, + rw ← has_fderiv_within_at_univ, + exact H.fderiv_within m hm x (mem_univ x) }, + { assume m hm, + rw continuous_iff_continuous_on_univ, + exact H.cont m hm } }, + { assume H, + split, + { exact λ x hx, H.zero_eq x }, + { assume m hm x hx, + rw has_fderiv_within_at_univ, + exact H.fderiv m hm x }, + { assume m hm, + rw ← continuous_iff_continuous_on_univ, + exact H.cont m hm } } +end + +lemma has_ftaylor_series_up_to.has_ftaylor_series_up_to_on + (h : has_ftaylor_series_up_to n f p) (s : set E) : + has_ftaylor_series_up_to_on n f p s := +(has_ftaylor_series_up_to_on_univ_iff.2 h).mono (subset_univ _) + +lemma has_ftaylor_series_up_to.of_le + (h : has_ftaylor_series_up_to n f p) (hmn : m ≤ n) : + has_ftaylor_series_up_to m f p := +by { rw ← has_ftaylor_series_up_to_on_univ_iff at h ⊢, exact h.of_le hmn } + +lemma has_ftaylor_series_up_to.continuous + (h : has_ftaylor_series_up_to n f p) : continuous f := +begin + rw ← has_ftaylor_series_up_to_on_univ_iff at h, + rw continuous_iff_continuous_on_univ, + exact h.continuous_on +end + +lemma has_ftaylor_series_up_to_zero_iff : + has_ftaylor_series_up_to 0 f p ↔ continuous f ∧ (∀ x, (p x 0).uncurry0 = f x) := +by simp [has_ftaylor_series_up_to_on_univ_iff.symm, continuous_iff_continuous_on_univ, + has_ftaylor_series_up_to_on_zero_iff] + +lemma has_ftaylor_series_up_to_top_iff : has_ftaylor_series_up_to ∞ f p ↔ + ∀ (n : ℕ), has_ftaylor_series_up_to n f p := +by simp only [← has_ftaylor_series_up_to_on_univ_iff, has_ftaylor_series_up_to_on_top_iff] + +/-- In the case that `n = ∞` we don't need the continuity assumption in +`has_ftaylor_series_up_to`. -/ +lemma has_ftaylor_series_up_to_top_iff' : has_ftaylor_series_up_to ∞ f p ↔ + (∀ x, (p x 0).uncurry0 = f x) ∧ + (∀ (m : ℕ) x, has_fderiv_at (λ y, p y m) (p x m.succ).curry_left x) := +by simp only [← has_ftaylor_series_up_to_on_univ_iff, has_ftaylor_series_up_to_on_top_iff', + mem_univ, forall_true_left, has_fderiv_within_at_univ] + +/-- If a function has a Taylor series at order at least `1`, then the term of order `1` of this +series is a derivative of `f`. -/ +lemma has_ftaylor_series_up_to.has_fderiv_at + (h : has_ftaylor_series_up_to n f p) (hn : 1 ≤ n) (x : E) : + has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) x := +begin + rw [← has_fderiv_within_at_univ], + exact (has_ftaylor_series_up_to_on_univ_iff.2 h).has_fderiv_within_at hn (mem_univ _) +end + +lemma has_ftaylor_series_up_to.differentiable + (h : has_ftaylor_series_up_to n f p) (hn : 1 ≤ n) : differentiable 𝕜 f := +λ x, (h.has_fderiv_at hn x).differentiable_at + +/-- `p` is a Taylor series of `f` up to `n+1` if and only if `p.shift` is a Taylor series up to `n` +for `p 1`, which is a derivative of `f`. -/ +theorem has_ftaylor_series_up_to_succ_iff_right {n : ℕ} : + has_ftaylor_series_up_to ((n + 1) : ℕ) f p ↔ + (∀ x, (p x 0).uncurry0 = f x) + ∧ (∀ x, has_fderiv_at (λ y, p y 0) (p x 1).curry_left x) + ∧ has_ftaylor_series_up_to n + (λ x, continuous_multilinear_curry_fin1 𝕜 E F (p x 1)) (λ x, (p x).shift) := +by simp only [has_ftaylor_series_up_to_on_succ_iff_right, ← has_ftaylor_series_up_to_on_univ_iff, + mem_univ, forall_true_left, has_fderiv_within_at_univ] + +/-! ### Smooth functions at a point -/ + +variable (𝕜) + +/-- A function is continuously differentiable up to `n` at a point `x` if, for any integer `k ≤ n`, +there is a neighborhood of `x` where `f` admits derivatives up to order `n`, which are continuous. +-/ +def cont_diff_at (n : ℕ∞) (f : E → F) (x : E) : Prop := +cont_diff_within_at 𝕜 n f univ x + +variable {𝕜} + +theorem cont_diff_within_at_univ : + cont_diff_within_at 𝕜 n f univ x ↔ cont_diff_at 𝕜 n f x := +iff.rfl + +lemma cont_diff_at_top : + cont_diff_at 𝕜 ∞ f x ↔ ∀ (n : ℕ), cont_diff_at 𝕜 n f x := +by simp [← cont_diff_within_at_univ, cont_diff_within_at_top] + +lemma cont_diff_at.cont_diff_within_at + (h : cont_diff_at 𝕜 n f x) : cont_diff_within_at 𝕜 n f s x := +h.mono (subset_univ _) + +lemma cont_diff_within_at.cont_diff_at + (h : cont_diff_within_at 𝕜 n f s x) (hx : s ∈ 𝓝 x) : + cont_diff_at 𝕜 n f x := +by rwa [cont_diff_at, ← cont_diff_within_at_inter hx, univ_inter] + +lemma cont_diff_at.congr_of_eventually_eq + (h : cont_diff_at 𝕜 n f x) (hg : f₁ =ᶠ[𝓝 x] f) : + cont_diff_at 𝕜 n f₁ x := +h.congr_of_eventually_eq' (by rwa nhds_within_univ) (mem_univ x) + +lemma cont_diff_at.of_le + (h : cont_diff_at 𝕜 n f x) (hmn : m ≤ n) : + cont_diff_at 𝕜 m f x := +h.of_le hmn + +lemma cont_diff_at.continuous_at + (h : cont_diff_at 𝕜 n f x) : continuous_at f x := +by simpa [continuous_within_at_univ] using h.continuous_within_at + +/-- If a function is `C^n` with `n ≥ 1` at a point, then it is differentiable there. -/ +lemma cont_diff_at.differentiable_at + (h : cont_diff_at 𝕜 n f x) (hn : 1 ≤ n) : differentiable_at 𝕜 f x := +by simpa [hn, differentiable_within_at_univ] using h.differentiable_within_at + +/-- A function is `C^(n + 1)` at a point iff locally, it has a derivative which is `C^n`. -/ +theorem cont_diff_at_succ_iff_has_fderiv_at {n : ℕ} : + cont_diff_at 𝕜 ((n + 1) : ℕ) f x + ↔ (∃ f' : E → E →L[𝕜] F, (∃ u ∈ 𝓝 x, ∀ x ∈ u, has_fderiv_at f (f' x) x) + ∧ cont_diff_at 𝕜 n f' x) := +begin + rw [← cont_diff_within_at_univ, cont_diff_within_at_succ_iff_has_fderiv_within_at], + simp only [nhds_within_univ, exists_prop, mem_univ, insert_eq_of_mem], + split, + { rintros ⟨u, H, f', h_fderiv, h_cont_diff⟩, + rcases mem_nhds_iff.mp H with ⟨t, htu, ht, hxt⟩, + refine ⟨f', ⟨t, _⟩, h_cont_diff.cont_diff_at H⟩, + refine ⟨mem_nhds_iff.mpr ⟨t, subset.rfl, ht, hxt⟩, _⟩, + intros y hyt, + refine (h_fderiv y (htu hyt)).has_fderiv_at _, + exact mem_nhds_iff.mpr ⟨t, htu, ht, hyt⟩ }, + { rintros ⟨f', ⟨u, H, h_fderiv⟩, h_cont_diff⟩, + refine ⟨u, H, f', _, h_cont_diff.cont_diff_within_at⟩, + intros x hxu, + exact (h_fderiv x hxu).has_fderiv_within_at } +end + +protected theorem cont_diff_at.eventually {n : ℕ} (h : cont_diff_at 𝕜 n f x) : + ∀ᶠ y in 𝓝 x, cont_diff_at 𝕜 n f y := +by simpa [nhds_within_univ] using h.eventually + +/-! ### Smooth functions -/ + +variable (𝕜) + +/-- A function is continuously differentiable up to `n` if it admits derivatives up to +order `n`, which are continuous. Contrary to the case of definitions in domains (where derivatives +might not be unique) we do not need to localize the definition in space or time. +-/ +def cont_diff (n : ℕ∞) (f : E → F) : Prop := +∃ p : E → formal_multilinear_series 𝕜 E F, has_ftaylor_series_up_to n f p + +variable {𝕜} + +/-- If `f` has a Taylor series up to `n`, then it is `C^n`. -/ +lemma has_ftaylor_series_up_to.cont_diff {f' : E → formal_multilinear_series 𝕜 E F} + (hf : has_ftaylor_series_up_to n f f') : cont_diff 𝕜 n f := ⟨f', hf⟩ + +theorem cont_diff_on_univ : cont_diff_on 𝕜 n f univ ↔ cont_diff 𝕜 n f := +begin + split, + { assume H, + use ftaylor_series_within 𝕜 f univ, + rw ← has_ftaylor_series_up_to_on_univ_iff, + exact H.ftaylor_series_within unique_diff_on_univ }, + { rintros ⟨p, hp⟩ x hx m hm, + exact ⟨univ, filter.univ_sets _, p, (hp.has_ftaylor_series_up_to_on univ).of_le hm⟩ } +end + +lemma cont_diff_iff_cont_diff_at : cont_diff 𝕜 n f ↔ ∀ x, cont_diff_at 𝕜 n f x := +by simp [← cont_diff_on_univ, cont_diff_on, cont_diff_at] + +lemma cont_diff.cont_diff_at (h : cont_diff 𝕜 n f) : cont_diff_at 𝕜 n f x := +cont_diff_iff_cont_diff_at.1 h x + +lemma cont_diff.cont_diff_within_at (h : cont_diff 𝕜 n f) : cont_diff_within_at 𝕜 n f s x := +h.cont_diff_at.cont_diff_within_at + +lemma cont_diff_top : cont_diff 𝕜 ∞ f ↔ ∀ (n : ℕ), cont_diff 𝕜 n f := +by simp [cont_diff_on_univ.symm, cont_diff_on_top] + +lemma cont_diff_all_iff_nat : (∀ n, cont_diff 𝕜 n f) ↔ (∀ n : ℕ, cont_diff 𝕜 n f) := +by simp only [← cont_diff_on_univ, cont_diff_on_all_iff_nat] + +lemma cont_diff.cont_diff_on (h : cont_diff 𝕜 n f) : cont_diff_on 𝕜 n f s := +(cont_diff_on_univ.2 h).mono (subset_univ _) + +@[simp] lemma cont_diff_zero : cont_diff 𝕜 0 f ↔ continuous f := +begin + rw [← cont_diff_on_univ, continuous_iff_continuous_on_univ], + exact cont_diff_on_zero +end + +lemma cont_diff_at_zero : cont_diff_at 𝕜 0 f x ↔ ∃ u ∈ 𝓝 x, continuous_on f u := +by { rw ← cont_diff_within_at_univ, simp [cont_diff_within_at_zero, nhds_within_univ] } + +theorem cont_diff_at_one_iff : cont_diff_at 𝕜 1 f x ↔ + ∃ f' : E → (E →L[𝕜] F), ∃ u ∈ 𝓝 x, continuous_on f' u ∧ ∀ x ∈ u, has_fderiv_at f (f' x) x := +by simp_rw [show (1 : ℕ∞) = (0 + 1 : ℕ), from (zero_add 1).symm, + cont_diff_at_succ_iff_has_fderiv_at, show ((0 : ℕ) : ℕ∞) = 0, from rfl, + cont_diff_at_zero, exists_mem_and_iff antitone_bforall antitone_continuous_on, and_comm] + +lemma cont_diff.of_le (h : cont_diff 𝕜 n f) (hmn : m ≤ n) : cont_diff 𝕜 m f := +cont_diff_on_univ.1 $ (cont_diff_on_univ.2 h).of_le hmn + +lemma cont_diff.of_succ {n : ℕ} (h : cont_diff 𝕜 (n + 1) f) : cont_diff 𝕜 n f := +h.of_le $ with_top.coe_le_coe.mpr le_self_add + +lemma cont_diff.one_of_succ {n : ℕ} (h : cont_diff 𝕜 (n + 1) f) : cont_diff 𝕜 1 f := +h.of_le $ with_top.coe_le_coe.mpr le_add_self + +lemma cont_diff.continuous (h : cont_diff 𝕜 n f) : continuous f := +cont_diff_zero.1 (h.of_le bot_le) + +/-- If a function is `C^n` with `n ≥ 1`, then it is differentiable. -/ +lemma cont_diff.differentiable (h : cont_diff 𝕜 n f) (hn : 1 ≤ n) : differentiable 𝕜 f := +differentiable_on_univ.1 $ (cont_diff_on_univ.2 h).differentiable_on hn + +lemma cont_diff_iff_forall_nat_le : + cont_diff 𝕜 n f ↔ ∀ m : ℕ, ↑m ≤ n → cont_diff 𝕜 m f := +by { simp_rw [← cont_diff_on_univ], exact cont_diff_on_iff_forall_nat_le } + +/-- A function is `C^(n+1)` iff it has a `C^n` derivative. -/ +lemma cont_diff_succ_iff_has_fderiv {n : ℕ} : cont_diff 𝕜 ((n + 1) : ℕ) f ↔ + ∃ (f' : E → (E →L[𝕜] F)), cont_diff 𝕜 n f' ∧ ∀ x, has_fderiv_at f (f' x) x := +by simp only [← cont_diff_on_univ, ← has_fderiv_within_at_univ, + cont_diff_on_succ_iff_has_fderiv_within (unique_diff_on_univ), set.mem_univ, forall_true_left] + +/-! ### Iterated derivative -/ + +variable (𝕜) + +/-- The `n`-th derivative of a function, as a multilinear map, defined inductively. -/ +noncomputable def iterated_fderiv (n : ℕ) (f : E → F) : + E → (E [×n]→L[𝕜] F) := +nat.rec_on n + (λ x, continuous_multilinear_map.curry0 𝕜 E (f x)) + (λ n rec x, continuous_linear_map.uncurry_left (fderiv 𝕜 rec x)) + +/-- Formal Taylor series associated to a function within a set. -/ +def ftaylor_series (f : E → F) (x : E) : formal_multilinear_series 𝕜 E F := +λ n, iterated_fderiv 𝕜 n f x + +variable {𝕜} + +@[simp] lemma iterated_fderiv_zero_apply (m : (fin 0) → E) : + (iterated_fderiv 𝕜 0 f x : ((fin 0) → E) → F) m = f x := rfl + +lemma iterated_fderiv_zero_eq_comp : + iterated_fderiv 𝕜 0 f = (continuous_multilinear_curry_fin0 𝕜 E F).symm ∘ f := rfl + +@[simp] lemma norm_iterated_fderiv_zero : + ‖iterated_fderiv 𝕜 0 f x‖ = ‖f x‖ := +by rw [iterated_fderiv_zero_eq_comp, linear_isometry_equiv.norm_map] + +lemma iterated_fderiv_with_zero_eq : + iterated_fderiv_within 𝕜 0 f s = iterated_fderiv 𝕜 0 f := +by { ext, refl } + +lemma iterated_fderiv_succ_apply_left {n : ℕ} (m : fin (n + 1) → E): + (iterated_fderiv 𝕜 (n + 1) f x : (fin (n + 1) → E) → F) m + = (fderiv 𝕜 (iterated_fderiv 𝕜 n f) x : E → (E [×n]→L[𝕜] F)) (m 0) (tail m) := rfl + +/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, +and the derivative of the `n`-th derivative. -/ +lemma iterated_fderiv_succ_eq_comp_left {n : ℕ} : + iterated_fderiv 𝕜 (n + 1) f = + (continuous_multilinear_curry_left_equiv 𝕜 (λ (i : fin (n + 1)), E) F) + ∘ (fderiv 𝕜 (iterated_fderiv 𝕜 n f)) := rfl + +/-- Writing explicitly the derivative of the `n`-th derivative as the composition of a currying +linear equiv, and the `n + 1`-th derivative. -/ +lemma fderiv_iterated_fderiv {n : ℕ} : + fderiv 𝕜 (iterated_fderiv 𝕜 n f) = + (continuous_multilinear_curry_left_equiv 𝕜 (λ (i : fin (n + 1)), E) F).symm + ∘ (iterated_fderiv 𝕜 (n + 1) f) := +begin + rw iterated_fderiv_succ_eq_comp_left, + ext1 x, + simp only [function.comp_app, linear_isometry_equiv.symm_apply_apply], +end + +lemma has_compact_support.iterated_fderiv (hf : has_compact_support f) (n : ℕ) : + has_compact_support (iterated_fderiv 𝕜 n f) := +begin + induction n with n IH, + { rw [iterated_fderiv_zero_eq_comp], + apply hf.comp_left, + exact linear_isometry_equiv.map_zero _ }, + { rw iterated_fderiv_succ_eq_comp_left, + apply (IH.fderiv 𝕜).comp_left, + exact linear_isometry_equiv.map_zero _ } +end +lemma norm_fderiv_iterated_fderiv {n : ℕ} : + ‖fderiv 𝕜 (iterated_fderiv 𝕜 n f) x‖ = ‖iterated_fderiv 𝕜 (n + 1) f x‖ := +by rw [iterated_fderiv_succ_eq_comp_left, linear_isometry_equiv.norm_map] + +lemma iterated_fderiv_within_univ {n : ℕ} : + iterated_fderiv_within 𝕜 n f univ = iterated_fderiv 𝕜 n f := +begin + induction n with n IH, + { ext x, simp }, + { ext x m, + rw [iterated_fderiv_succ_apply_left, iterated_fderiv_within_succ_apply_left, IH, + fderiv_within_univ] } +end + +/-- In an open set, the iterated derivative within this set coincides with the global iterated +derivative. -/ +lemma iterated_fderiv_within_of_is_open (n : ℕ) (hs : is_open s) : + eq_on (iterated_fderiv_within 𝕜 n f s) (iterated_fderiv 𝕜 n f) s := +begin + induction n with n IH, + { assume x hx, + ext1 m, + simp only [iterated_fderiv_within_zero_apply, iterated_fderiv_zero_apply] }, + { assume x hx, + rw [iterated_fderiv_succ_eq_comp_left, iterated_fderiv_within_succ_eq_comp_left], + dsimp, + congr' 1, + rw fderiv_within_of_open hs hx, + apply filter.eventually_eq.fderiv_eq, + filter_upwards [hs.mem_nhds hx], + exact IH } +end + +lemma ftaylor_series_within_univ : + ftaylor_series_within 𝕜 f univ = ftaylor_series 𝕜 f := +begin + ext1 x, ext1 n, + change iterated_fderiv_within 𝕜 n f univ x = iterated_fderiv 𝕜 n f x, + rw iterated_fderiv_within_univ +end + +theorem iterated_fderiv_succ_apply_right {n : ℕ} (m : fin (n + 1) → E) : + (iterated_fderiv 𝕜 (n + 1) f x : (fin (n + 1) → E) → F) m + = iterated_fderiv 𝕜 n (λy, fderiv 𝕜 f y) x (init m) (m (last n)) := +begin + rw [← iterated_fderiv_within_univ, ← iterated_fderiv_within_univ, ← fderiv_within_univ], + exact iterated_fderiv_within_succ_apply_right unique_diff_on_univ (mem_univ _) _ +end + +/-- Writing explicitly the `n+1`-th derivative as the composition of a currying linear equiv, +and the `n`-th derivative of the derivative. -/ +lemma iterated_fderiv_succ_eq_comp_right {n : ℕ} : + iterated_fderiv 𝕜 (n + 1) f x = + ((continuous_multilinear_curry_right_equiv' 𝕜 n E F) + ∘ (iterated_fderiv 𝕜 n (λy, fderiv 𝕜 f y))) x := +by { ext m, rw iterated_fderiv_succ_apply_right, refl } + +lemma norm_iterated_fderiv_fderiv {n : ℕ} : + ‖iterated_fderiv 𝕜 n (fderiv 𝕜 f) x‖ = ‖iterated_fderiv 𝕜 (n + 1) f x‖ := +by rw [iterated_fderiv_succ_eq_comp_right, linear_isometry_equiv.norm_map] + +@[simp] lemma iterated_fderiv_one_apply (m : (fin 1) → E) : + (iterated_fderiv 𝕜 1 f x : ((fin 1) → E) → F) m + = (fderiv 𝕜 f x : E → F) (m 0) := +by { rw [iterated_fderiv_succ_apply_right, iterated_fderiv_zero_apply], refl } + +/-- When a function is `C^n` in a set `s` of unique differentiability, it admits +`ftaylor_series_within 𝕜 f s` as a Taylor series up to order `n` in `s`. -/ +theorem cont_diff_iff_ftaylor_series : + cont_diff 𝕜 n f ↔ has_ftaylor_series_up_to n f (ftaylor_series 𝕜 f) := +begin + split, + { rw [← cont_diff_on_univ, ← has_ftaylor_series_up_to_on_univ_iff, + ← ftaylor_series_within_univ], + exact λ h, cont_diff_on.ftaylor_series_within h unique_diff_on_univ }, + { assume h, exact ⟨ftaylor_series 𝕜 f, h⟩ } +end + +lemma cont_diff_iff_continuous_differentiable : + cont_diff 𝕜 n f ↔ + (∀ (m : ℕ), (m : ℕ∞) ≤ n → continuous (λ x, iterated_fderiv 𝕜 m f x)) + ∧ (∀ (m : ℕ), (m : ℕ∞) < n → differentiable 𝕜 (λ x, iterated_fderiv 𝕜 m f x)) := +by simp [cont_diff_on_univ.symm, continuous_iff_continuous_on_univ, + differentiable_on_univ.symm, iterated_fderiv_within_univ, + cont_diff_on_iff_continuous_on_differentiable_on unique_diff_on_univ] + +/-- If `f` is `C^n` then its `m`-times iterated derivative is continuous for `m ≤ n`. -/ +lemma cont_diff.continuous_iterated_fderiv {m : ℕ} (hm : (m : ℕ∞) ≤ n) + (hf : cont_diff 𝕜 n f) : continuous (λ x, iterated_fderiv 𝕜 m f x) := +(cont_diff_iff_continuous_differentiable.mp hf).1 m hm + +/-- If `f` is `C^n` then its `m`-times iterated derivative is differentiable for `m < n`. -/ +lemma cont_diff.differentiable_iterated_fderiv {m : ℕ} (hm : (m : ℕ∞) < n) + (hf : cont_diff 𝕜 n f) : differentiable 𝕜 (λ x, iterated_fderiv 𝕜 m f x) := +(cont_diff_iff_continuous_differentiable.mp hf).2 m hm + +lemma cont_diff_of_differentiable_iterated_fderiv + (h : ∀(m : ℕ), (m : ℕ∞) ≤ n → differentiable 𝕜 (iterated_fderiv 𝕜 m f)) : + cont_diff 𝕜 n f := +cont_diff_iff_continuous_differentiable.2 +⟨λ m hm, (h m hm).continuous, λ m hm, (h m (le_of_lt hm))⟩ + +/-- A function is `C^(n + 1)` if and only if it is differentiable, +and its derivative (formulated in terms of `fderiv`) is `C^n`. -/ +theorem cont_diff_succ_iff_fderiv {n : ℕ} : + cont_diff 𝕜 ((n + 1) : ℕ) f ↔ + differentiable 𝕜 f ∧ cont_diff 𝕜 n (λ y, fderiv 𝕜 f y) := +by simp only [← cont_diff_on_univ, ← differentiable_on_univ, ← fderiv_within_univ, + cont_diff_on_succ_iff_fderiv_within unique_diff_on_univ] + +theorem cont_diff_one_iff_fderiv : + cont_diff 𝕜 1 f ↔ differentiable 𝕜 f ∧ continuous (fderiv 𝕜 f) := +cont_diff_succ_iff_fderiv.trans $ iff.rfl.and cont_diff_zero + +/-- A function is `C^∞` if and only if it is differentiable, +and its derivative (formulated in terms of `fderiv`) is `C^∞`. -/ +theorem cont_diff_top_iff_fderiv : + cont_diff 𝕜 ∞ f ↔ + differentiable 𝕜 f ∧ cont_diff 𝕜 ∞ (λ y, fderiv 𝕜 f y) := +begin + simp only [← cont_diff_on_univ, ← differentiable_on_univ, ← fderiv_within_univ], + rw cont_diff_on_top_iff_fderiv_within unique_diff_on_univ, +end + +lemma cont_diff.continuous_fderiv + (h : cont_diff 𝕜 n f) (hn : 1 ≤ n) : + continuous (λ x, fderiv 𝕜 f x) := +((cont_diff_succ_iff_fderiv).1 (h.of_le hn)).2.continuous + +/-- If a function is at least `C^1`, its bundled derivative (mapping `(x, v)` to `Df(x) v`) is +continuous. -/ +lemma cont_diff.continuous_fderiv_apply + (h : cont_diff 𝕜 n f) (hn : 1 ≤ n) : + continuous (λp : E × E, (fderiv 𝕜 f p.1 : E → F) p.2) := +have A : continuous (λq : (E →L[𝕜] F) × E, q.1 q.2) := is_bounded_bilinear_map_apply.continuous, +have B : continuous (λp : E × E, (fderiv 𝕜 f p.1, p.2)) := + ((h.continuous_fderiv hn).comp continuous_fst).prod_mk continuous_snd, +A.comp B diff --git a/src/analysis/calculus/darboux.lean b/src/analysis/calculus/darboux.lean index 6129224b96982..988217525e49e 100644 --- a/src/analysis/calculus/darboux.lean +++ b/src/analysis/calculus/darboux.lean @@ -8,27 +8,28 @@ import analysis.calculus.local_extr /-! # Darboux's theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that the derivative of a differentiable function on an interval takes all intermediate values. The proof is based on the [Wikipedia](https://en.wikipedia.org/wiki/Darboux%27s_theorem_(analysis)) page about this theorem. -/ open filter set -open_locale topological_space classical +open_locale topology classical variables {a b : ℝ} {f f' : ℝ → ℝ} /-- **Darboux's theorem**: if `a ≤ b` and `f' a < m < f' b`, then `f' c = m` for some -`c ∈ [a, b]`. -/ +`c ∈ (a, b)`. -/ theorem exists_has_deriv_within_at_eq_of_gt_of_lt (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x) {m : ℝ} (hma : f' a < m) (hmb : m < f' b) : - m ∈ f' '' (Icc a b) := + m ∈ f' '' Ioo a b := begin - have hab' : a < b, - { refine lt_of_le_of_ne hab (λ hab', _), - subst b, - exact lt_asymm hma hmb }, + rcases hab.eq_or_lt with rfl | hab', + { exact (lt_asymm hma hmb).elim }, set g : ℝ → ℝ := λ x, f x - m * x, have hg : ∀ x ∈ Icc a b, has_deriv_within_at g (f' x - m) (Icc a b) x, { intros x hx, @@ -37,73 +38,121 @@ begin from is_compact_Icc.exists_forall_le (nonempty_Icc.2 $ hab) (λ x hx, (hg x hx).continuous_within_at), have cmem' : c ∈ Ioo a b, - { cases eq_or_lt_of_le cmem.1 with hac hac, + { rcases cmem.1.eq_or_lt with rfl | hac, -- Show that `c` can't be equal to `a` - { subst c, - refine absurd (sub_nonneg.1 $ nonneg_of_mul_nonneg_left _ (sub_pos.2 hab')) + { refine absurd (sub_nonneg.1 $ nonneg_of_mul_nonneg_right _ (sub_pos.2 hab')) (not_le_of_lt hma), have : b - a ∈ pos_tangent_cone_at (Icc a b) a, from mem_pos_tangent_cone_at_of_segment_subset (segment_eq_Icc hab ▸ subset.refl _), simpa [-sub_nonneg, -continuous_linear_map.map_sub] using hc.localize.has_fderiv_within_at_nonneg (hg a (left_mem_Icc.2 hab)) this }, - cases eq_or_lt_of_le cmem.2 with hbc hbc, + rcases cmem.2.eq_or_gt with rfl | hcb, -- Show that `c` can't be equal to `b` - { subst c, - refine absurd (sub_nonpos.1 $ nonpos_of_mul_nonneg_right _ (sub_lt_zero.2 hab')) + { refine absurd (sub_nonpos.1 $ nonpos_of_mul_nonneg_right _ (sub_lt_zero.2 hab')) (not_le_of_lt hmb), have : a - b ∈ pos_tangent_cone_at (Icc a b) b, from mem_pos_tangent_cone_at_of_segment_subset (by rw [segment_symm, segment_eq_Icc hab]), simpa [-sub_nonneg, -continuous_linear_map.map_sub] using hc.localize.has_fderiv_within_at_nonneg (hg b (right_mem_Icc.2 hab)) this }, - exact ⟨hac, hbc⟩ }, - use [c, cmem], + exact ⟨hac, hcb⟩ }, + use [c, cmem'], rw [← sub_eq_zero], have : Icc a b ∈ 𝓝 c, by rwa [← mem_interior_iff_mem_nhds, interior_Icc], exact (hc.is_local_min this).has_deriv_at_eq_zero ((hg c cmem).has_deriv_at this) end -/-- **Darboux's theorem**: if `a ≤ b` and `f' a > m > f' b`, then `f' c = m` for some `c ∈ [a, b]`. +/-- **Darboux's theorem**: if `a ≤ b` and `f' b < m < f' a`, then `f' c = m` for some `c ∈ (a, b)`. -/ theorem exists_has_deriv_within_at_eq_of_lt_of_gt (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x) {m : ℝ} (hma : m < f' a) (hmb : f' b < m) : - m ∈ f' '' (Icc a b) := + m ∈ f' '' Ioo a b := let ⟨c, cmem, hc⟩ := exists_has_deriv_within_at_eq_of_gt_of_lt hab (λ x hx, (hf x hx).neg) (neg_lt_neg hma) (neg_lt_neg hmb) in ⟨c, cmem, neg_injective hc⟩ -/-- **Darboux's theorem**: the image of a convex set under `f'` is a convex set. -/ -theorem convex_image_has_deriv_at {s : set ℝ} (hs : convex ℝ s) - (hf : ∀ x ∈ s, has_deriv_at f (f' x) x) : - convex ℝ (f' '' s) := +/-- **Darboux's theorem**: the image of an `ord_connected` set under `f'` is an `ord_connected` +set, `has_deriv_within_at` version. -/ +theorem set.ord_connected.image_has_deriv_within_at {s : set ℝ} (hs : ord_connected s) + (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) : + ord_connected (f' '' s) := begin - refine ord_connected.convex ⟨_⟩, - rintros _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ m ⟨hma, hmb⟩, - cases eq_or_lt_of_le hma with hma hma, - by exact hma ▸ mem_image_of_mem f' ha, - cases eq_or_lt_of_le hmb with hmb hmb, - by exact hmb.symm ▸ mem_image_of_mem f' hb, + apply ord_connected_of_Ioo, + rintros _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ - m ⟨hma, hmb⟩, cases le_total a b with hab hab, - { have : Icc a b ⊆ s, from hs.ord_connected.out ha hb, + { have : Icc a b ⊆ s, from hs.out ha hb, rcases exists_has_deriv_within_at_eq_of_gt_of_lt hab - (λ x hx, (hf x $ this hx).has_deriv_within_at) hma hmb + (λ x hx, (hf x $ this hx).mono this) hma hmb with ⟨c, cmem, hc⟩, - exact ⟨c, this cmem, hc⟩ }, - { have : Icc b a ⊆ s, from hs.ord_connected.out hb ha, + exact ⟨c, this $ Ioo_subset_Icc_self cmem, hc⟩ }, + { have : Icc b a ⊆ s, from hs.out hb ha, rcases exists_has_deriv_within_at_eq_of_lt_of_gt hab - (λ x hx, (hf x $ this hx).has_deriv_within_at) hmb hma + (λ x hx, (hf x $ this hx).mono this) hmb hma with ⟨c, cmem, hc⟩, - exact ⟨c, this cmem, hc⟩ } + exact ⟨c, this $ Ioo_subset_Icc_self cmem, hc⟩ } end +/-- **Darboux's theorem**: the image of an `ord_connected` set under `f'` is an `ord_connected` +set, `deriv_within` version. -/ +theorem set.ord_connected.image_deriv_within {s : set ℝ} (hs : ord_connected s) + (hf : differentiable_on ℝ f s) : + ord_connected (deriv_within f s '' s) := +hs.image_has_deriv_within_at $ λ x hx, (hf x hx).has_deriv_within_at + +/-- **Darboux's theorem**: the image of an `ord_connected` set under `f'` is an `ord_connected` +set, `deriv` version. -/ +theorem set.ord_connected.image_deriv {s : set ℝ} (hs : ord_connected s) + (hf : ∀ x ∈ s, differentiable_at ℝ f x) : + ord_connected (deriv f '' s) := +hs.image_has_deriv_within_at $ λ x hx, (hf x hx).has_deriv_at.has_deriv_within_at + +/-- **Darboux's theorem**: the image of a convex set under `f'` is a convex set, +`has_deriv_within_at` version. -/ +theorem convex.image_has_deriv_within_at {s : set ℝ} (hs : convex ℝ s) + (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) : + convex ℝ (f' '' s) := +(hs.ord_connected.image_has_deriv_within_at hf).convex + +/-- **Darboux's theorem**: the image of a convex set under `f'` is a convex set, +`deriv_within` version. -/ +theorem convex.image_deriv_within {s : set ℝ} (hs : convex ℝ s) + (hf : differentiable_on ℝ f s) : + convex ℝ (deriv_within f s '' s) := +(hs.ord_connected.image_deriv_within hf).convex + +/-- **Darboux's theorem**: the image of a convex set under `f'` is a convex set, +`deriv` version. -/ +theorem convex.image_deriv {s : set ℝ} (hs : convex ℝ s) + (hf : ∀ x ∈ s, differentiable_at ℝ f x) : + convex ℝ (deriv f '' s) := +(hs.ord_connected.image_deriv hf).convex + +/-- **Darboux's theorem**: if `a ≤ b` and `f' a ≤ m ≤ f' b`, then `f' c = m` for some +`c ∈ [a, b]`. -/ +theorem exists_has_deriv_within_at_eq_of_ge_of_le + (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x) + {m : ℝ} (hma : f' a ≤ m) (hmb : m ≤ f' b) : + m ∈ f' '' Icc a b := +(ord_connected_Icc.image_has_deriv_within_at hf).out + (mem_image_of_mem _ (left_mem_Icc.2 hab)) (mem_image_of_mem _ (right_mem_Icc.2 hab)) ⟨hma, hmb⟩ + +/-- **Darboux's theorem**: if `a ≤ b` and `f' b ≤ m ≤ f' a`, then `f' c = m` for some +`c ∈ [a, b]`. -/ +theorem exists_has_deriv_within_at_eq_of_le_of_ge + (hab : a ≤ b) (hf : ∀ x ∈ (Icc a b), has_deriv_within_at f (f' x) (Icc a b) x) + {m : ℝ} (hma : f' a ≤ m) (hmb : m ≤ f' b) : + m ∈ f' '' Icc a b := +(ord_connected_Icc.image_has_deriv_within_at hf).out + (mem_image_of_mem _ (left_mem_Icc.2 hab)) (mem_image_of_mem _ (right_mem_Icc.2 hab)) ⟨hma, hmb⟩ + /-- If the derivative of a function is never equal to `m`, then either it is always greater than `m`, or it is always less than `m`. -/ -theorem deriv_forall_lt_or_forall_gt_of_forall_ne {s : set ℝ} (hs : convex ℝ s) - (hf : ∀ x ∈ s, has_deriv_at f (f' x) x) {m : ℝ} (hf' : ∀ x ∈ s, f' x ≠ m) : +theorem has_deriv_within_at_forall_lt_or_forall_gt_of_forall_ne {s : set ℝ} (hs : convex ℝ s) + (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) {m : ℝ} (hf' : ∀ x ∈ s, f' x ≠ m) : (∀ x ∈ s, f' x < m) ∨ (∀ x ∈ s, m < f' x) := begin contrapose! hf', rcases hf' with ⟨⟨b, hb, hmb⟩, ⟨a, ha, hma⟩⟩, - exact (convex_image_has_deriv_at hs hf).ord_connected.out (mem_image_of_mem f' ha) + exact (hs.ord_connected.image_has_deriv_within_at hf).out (mem_image_of_mem f' ha) (mem_image_of_mem f' hb) ⟨hma, hmb⟩ end diff --git a/src/analysis/calculus/deriv.lean b/src/analysis/calculus/deriv.lean deleted file mode 100644 index be36dec44fa9d..0000000000000 --- a/src/analysis/calculus/deriv.lean +++ /dev/null @@ -1,2149 +0,0 @@ -/- -Copyright (c) 2019 Gabriel Ebner. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Gabriel Ebner, Sébastien Gouëzel --/ -import analysis.calculus.fderiv -import data.polynomial.derivative -import linear_algebra.affine_space.slope - -/-! - -# One-dimensional derivatives - -This file defines the derivative of a function `f : 𝕜 → F` where `𝕜` is a -normed field and `F` is a normed space over this field. The derivative of -such a function `f` at a point `x` is given by an element `f' : F`. - -The theory is developed analogously to the [Fréchet -derivatives](./fderiv.html). We first introduce predicates defined in terms -of the corresponding predicates for Fréchet derivatives: - - - `has_deriv_at_filter f f' x L` states that the function `f` has the - derivative `f'` at the point `x` as `x` goes along the filter `L`. - - - `has_deriv_within_at f f' s x` states that the function `f` has the - derivative `f'` at the point `x` within the subset `s`. - - - `has_deriv_at f f' x` states that the function `f` has the derivative `f'` - at the point `x`. - - - `has_strict_deriv_at f f' x` states that the function `f` has the derivative `f'` - at the point `x` in the sense of strict differentiability, i.e., - `f y - f z = (y - z) • f' + o (y - z)` as `y, z → x`. - -For the last two notions we also define a functional version: - - - `deriv_within f s x` is a derivative of `f` at `x` within `s`. If the - derivative does not exist, then `deriv_within f s x` equals zero. - - - `deriv f x` is a derivative of `f` at `x`. If the derivative does not - exist, then `deriv f x` equals zero. - -The theorems `fderiv_within_deriv_within` and `fderiv_deriv` show that the -one-dimensional derivatives coincide with the general Fréchet derivatives. - -We also show the existence and compute the derivatives of: - - constants - - the identity function - - linear maps - - addition - - sum of finitely many functions - - negation - - subtraction - - multiplication - - inverse `x → x⁻¹` - - multiplication of two functions in `𝕜 → 𝕜` - - multiplication of a function in `𝕜 → 𝕜` and of a function in `𝕜 → E` - - composition of a function in `𝕜 → F` with a function in `𝕜 → 𝕜` - - composition of a function in `F → E` with a function in `𝕜 → F` - - inverse function (assuming that it exists; the inverse function theorem is in `inverse.lean`) - - division - - polynomials - -For most binary operations we also define `const_op` and `op_const` theorems for the cases when -the first or second argument is a constant. This makes writing chains of `has_deriv_at`'s easier, -and they more frequently lead to the desired result. - -We set up the simplifier so that it can compute the derivative of simple functions. For instance, -```lean -example (x : ℝ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) := -by { simp, ring } -``` - -## Implementation notes - -Most of the theorems are direct restatements of the corresponding theorems -for Fréchet derivatives. - -The strategy to construct simp lemmas that give the simplifier the possibility to compute -derivatives is the same as the one for differentiability statements, as explained in `fderiv.lean`. -See the explanations there. --/ - -universes u v w -noncomputable theory -open_locale classical topological_space big_operators filter ennreal polynomial -open filter asymptotics set -open continuous_linear_map (smul_right smul_right_one_eq_iff) - - -variables {𝕜 : Type u} [nondiscrete_normed_field 𝕜] - -section -variables {F : Type v} [normed_group F] [normed_space 𝕜 F] -variables {E : Type w} [normed_group E] [normed_space 𝕜 E] - -/-- -`f` has the derivative `f'` at the point `x` as `x` goes along the filter `L`. - -That is, `f x' = f x + (x' - x) • f' + o(x' - x)` where `x'` converges along the filter `L`. --/ -def has_deriv_at_filter (f : 𝕜 → F) (f' : F) (x : 𝕜) (L : filter 𝕜) := -has_fderiv_at_filter f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x L - -/-- -`f` has the derivative `f'` at the point `x` within the subset `s`. - -That is, `f x' = f x + (x' - x) • f' + o(x' - x)` where `x'` converges to `x` inside `s`. --/ -def has_deriv_within_at (f : 𝕜 → F) (f' : F) (s : set 𝕜) (x : 𝕜) := -has_deriv_at_filter f f' x (𝓝[s] x) - -/-- -`f` has the derivative `f'` at the point `x`. - -That is, `f x' = f x + (x' - x) • f' + o(x' - x)` where `x'` converges to `x`. --/ -def has_deriv_at (f : 𝕜 → F) (f' : F) (x : 𝕜) := -has_deriv_at_filter f f' x (𝓝 x) - -/-- `f` has the derivative `f'` at the point `x` in the sense of strict differentiability. - -That is, `f y - f z = (y - z) • f' + o(y - z)` as `y, z → x`. -/ -def has_strict_deriv_at (f : 𝕜 → F) (f' : F) (x : 𝕜) := -has_strict_fderiv_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x - -/-- -Derivative of `f` at the point `x` within the set `s`, if it exists. Zero otherwise. - -If the derivative exists (i.e., `∃ f', has_deriv_within_at f f' s x`), then -`f x' = f x + (x' - x) • deriv_within f s x + o(x' - x)` where `x'` converges to `x` inside `s`. --/ -def deriv_within (f : 𝕜 → F) (s : set 𝕜) (x : 𝕜) := -fderiv_within 𝕜 f s x 1 - -/-- -Derivative of `f` at the point `x`, if it exists. Zero otherwise. - -If the derivative exists (i.e., `∃ f', has_deriv_at f f' x`), then -`f x' = f x + (x' - x) • deriv f x + o(x' - x)` where `x'` converges to `x`. --/ -def deriv (f : 𝕜 → F) (x : 𝕜) := -fderiv 𝕜 f x 1 - -variables {f f₀ f₁ g : 𝕜 → F} -variables {f' f₀' f₁' g' : F} -variables {x : 𝕜} -variables {s t : set 𝕜} -variables {L L₁ L₂ : filter 𝕜} - -/-- Expressing `has_fderiv_at_filter f f' x L` in terms of `has_deriv_at_filter` -/ -lemma has_fderiv_at_filter_iff_has_deriv_at_filter {f' : 𝕜 →L[𝕜] F} : - has_fderiv_at_filter f f' x L ↔ has_deriv_at_filter f (f' 1) x L := -by simp [has_deriv_at_filter] - -lemma has_fderiv_at_filter.has_deriv_at_filter {f' : 𝕜 →L[𝕜] F} : - has_fderiv_at_filter f f' x L → has_deriv_at_filter f (f' 1) x L := -has_fderiv_at_filter_iff_has_deriv_at_filter.mp - -/-- Expressing `has_fderiv_within_at f f' s x` in terms of `has_deriv_within_at` -/ -lemma has_fderiv_within_at_iff_has_deriv_within_at {f' : 𝕜 →L[𝕜] F} : - has_fderiv_within_at f f' s x ↔ has_deriv_within_at f (f' 1) s x := -has_fderiv_at_filter_iff_has_deriv_at_filter - -/-- Expressing `has_deriv_within_at f f' s x` in terms of `has_fderiv_within_at` -/ -lemma has_deriv_within_at_iff_has_fderiv_within_at {f' : F} : - has_deriv_within_at f f' s x ↔ - has_fderiv_within_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') s x := -iff.rfl - -lemma has_fderiv_within_at.has_deriv_within_at {f' : 𝕜 →L[𝕜] F} : - has_fderiv_within_at f f' s x → has_deriv_within_at f (f' 1) s x := -has_fderiv_within_at_iff_has_deriv_within_at.mp - -lemma has_deriv_within_at.has_fderiv_within_at {f' : F} : - has_deriv_within_at f f' s x → has_fderiv_within_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') s x := -has_deriv_within_at_iff_has_fderiv_within_at.mp - -/-- Expressing `has_fderiv_at f f' x` in terms of `has_deriv_at` -/ -lemma has_fderiv_at_iff_has_deriv_at {f' : 𝕜 →L[𝕜] F} : - has_fderiv_at f f' x ↔ has_deriv_at f (f' 1) x := -has_fderiv_at_filter_iff_has_deriv_at_filter - -lemma has_fderiv_at.has_deriv_at {f' : 𝕜 →L[𝕜] F} : - has_fderiv_at f f' x → has_deriv_at f (f' 1) x := -has_fderiv_at_iff_has_deriv_at.mp - -lemma has_strict_fderiv_at_iff_has_strict_deriv_at {f' : 𝕜 →L[𝕜] F} : - has_strict_fderiv_at f f' x ↔ has_strict_deriv_at f (f' 1) x := -by simp [has_strict_deriv_at, has_strict_fderiv_at] - -protected lemma has_strict_fderiv_at.has_strict_deriv_at {f' : 𝕜 →L[𝕜] F} : - has_strict_fderiv_at f f' x → has_strict_deriv_at f (f' 1) x := -has_strict_fderiv_at_iff_has_strict_deriv_at.mp - -lemma has_strict_deriv_at_iff_has_strict_fderiv_at : - has_strict_deriv_at f f' x ↔ has_strict_fderiv_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x := -iff.rfl - -alias has_strict_deriv_at_iff_has_strict_fderiv_at ↔ has_strict_deriv_at.has_strict_fderiv_at _ - -/-- Expressing `has_deriv_at f f' x` in terms of `has_fderiv_at` -/ -lemma has_deriv_at_iff_has_fderiv_at {f' : F} : - has_deriv_at f f' x ↔ - has_fderiv_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x := -iff.rfl - -alias has_deriv_at_iff_has_fderiv_at ↔ has_deriv_at.has_fderiv_at _ - -lemma deriv_within_zero_of_not_differentiable_within_at - (h : ¬ differentiable_within_at 𝕜 f s x) : deriv_within f s x = 0 := -by { unfold deriv_within, rw fderiv_within_zero_of_not_differentiable_within_at, simp, assumption } - -lemma differentiable_within_at_of_deriv_within_ne_zero (h : deriv_within f s x ≠ 0) : - differentiable_within_at 𝕜 f s x := -not_imp_comm.1 deriv_within_zero_of_not_differentiable_within_at h - -lemma deriv_zero_of_not_differentiable_at (h : ¬ differentiable_at 𝕜 f x) : deriv f x = 0 := -by { unfold deriv, rw fderiv_zero_of_not_differentiable_at, simp, assumption } - -lemma differentiable_at_of_deriv_ne_zero (h : deriv f x ≠ 0) : differentiable_at 𝕜 f x := -not_imp_comm.1 deriv_zero_of_not_differentiable_at h - -theorem unique_diff_within_at.eq_deriv (s : set 𝕜) (H : unique_diff_within_at 𝕜 s x) - (h : has_deriv_within_at f f' s x) (h₁ : has_deriv_within_at f f₁' s x) : f' = f₁' := -smul_right_one_eq_iff.mp $ unique_diff_within_at.eq H h h₁ - -theorem has_deriv_at_filter_iff_tendsto : - has_deriv_at_filter f f' x L ↔ - tendsto (λ x' : 𝕜, ∥x' - x∥⁻¹ * ∥f x' - f x - (x' - x) • f'∥) L (𝓝 0) := -has_fderiv_at_filter_iff_tendsto - -theorem has_deriv_within_at_iff_tendsto : has_deriv_within_at f f' s x ↔ - tendsto (λ x', ∥x' - x∥⁻¹ * ∥f x' - f x - (x' - x) • f'∥) (𝓝[s] x) (𝓝 0) := -has_fderiv_at_filter_iff_tendsto - -theorem has_deriv_at_iff_tendsto : has_deriv_at f f' x ↔ - tendsto (λ x', ∥x' - x∥⁻¹ * ∥f x' - f x - (x' - x) • f'∥) (𝓝 x) (𝓝 0) := -has_fderiv_at_filter_iff_tendsto - -theorem has_strict_deriv_at.has_deriv_at (h : has_strict_deriv_at f f' x) : - has_deriv_at f f' x := -h.has_fderiv_at - -/-- If the domain has dimension one, then Fréchet derivative is equivalent to the classical -definition with a limit. In this version we have to take the limit along the subset `-{x}`, -because for `y=x` the slope equals zero due to the convention `0⁻¹=0`. -/ -lemma has_deriv_at_filter_iff_tendsto_slope {x : 𝕜} {L : filter 𝕜} : - has_deriv_at_filter f f' x L ↔ tendsto (slope f x) (L ⊓ 𝓟 {x}ᶜ) (𝓝 f') := -begin - conv_lhs { simp only [has_deriv_at_filter_iff_tendsto, (norm_inv _).symm, - (norm_smul _ _).symm, tendsto_zero_iff_norm_tendsto_zero.symm] }, - conv_rhs { rw [← nhds_translation_sub f', tendsto_comap_iff] }, - refine (tendsto_inf_principal_nhds_iff_of_forall_eq $ by simp).symm.trans (tendsto_congr' _), - refine (eventually_principal.2 $ λ z hz, _).filter_mono inf_le_right, - simp only [(∘)], - rw [smul_sub, ← mul_smul, inv_mul_cancel (sub_ne_zero.2 hz), one_smul, slope_def_module] -end - -lemma has_deriv_within_at_iff_tendsto_slope : - has_deriv_within_at f f' s x ↔ tendsto (slope f x) (𝓝[s \ {x}] x) (𝓝 f') := -begin - simp only [has_deriv_within_at, nhds_within, diff_eq, inf_assoc.symm, inf_principal.symm], - exact has_deriv_at_filter_iff_tendsto_slope -end - -lemma has_deriv_within_at_iff_tendsto_slope' (hs : x ∉ s) : - has_deriv_within_at f f' s x ↔ tendsto (slope f x) (𝓝[s] x) (𝓝 f') := -begin - convert ← has_deriv_within_at_iff_tendsto_slope, - exact diff_singleton_eq_self hs -end - -lemma has_deriv_at_iff_tendsto_slope : - has_deriv_at f f' x ↔ tendsto (slope f x) (𝓝[≠] x) (𝓝 f') := -has_deriv_at_filter_iff_tendsto_slope - -theorem has_deriv_within_at_congr_set {s t u : set 𝕜} - (hu : u ∈ 𝓝 x) (h : s ∩ u = t ∩ u) : - has_deriv_within_at f f' s x ↔ has_deriv_within_at f f' t x := -by simp_rw [has_deriv_within_at, nhds_within_eq_nhds_within' hu h] - -alias has_deriv_within_at_congr_set ↔ has_deriv_within_at.congr_set _ - -@[simp] lemma has_deriv_within_at_diff_singleton : - has_deriv_within_at f f' (s \ {x}) x ↔ has_deriv_within_at f f' s x := -by simp only [has_deriv_within_at_iff_tendsto_slope, sdiff_idem] - -@[simp] lemma has_deriv_within_at_Ioi_iff_Ici [partial_order 𝕜] : - has_deriv_within_at f f' (Ioi x) x ↔ has_deriv_within_at f f' (Ici x) x := -by rw [← Ici_diff_left, has_deriv_within_at_diff_singleton] - -alias has_deriv_within_at_Ioi_iff_Ici ↔ - has_deriv_within_at.Ici_of_Ioi has_deriv_within_at.Ioi_of_Ici - -@[simp] lemma has_deriv_within_at_Iio_iff_Iic [partial_order 𝕜] : - has_deriv_within_at f f' (Iio x) x ↔ has_deriv_within_at f f' (Iic x) x := -by rw [← Iic_diff_right, has_deriv_within_at_diff_singleton] - -alias has_deriv_within_at_Iio_iff_Iic ↔ - has_deriv_within_at.Iic_of_Iio has_deriv_within_at.Iio_of_Iic - -theorem has_deriv_within_at.Ioi_iff_Ioo [linear_order 𝕜] [order_closed_topology 𝕜] {x y : 𝕜} - (h : x < y) : - has_deriv_within_at f f' (Ioo x y) x ↔ has_deriv_within_at f f' (Ioi x) x := -has_deriv_within_at_congr_set (is_open_Iio.mem_nhds h) $ - by { rw [Ioi_inter_Iio, inter_eq_left_iff_subset], exact Ioo_subset_Iio_self } - -alias has_deriv_within_at.Ioi_iff_Ioo ↔ - has_deriv_within_at.Ioi_of_Ioo has_deriv_within_at.Ioo_of_Ioi - -theorem has_deriv_at_iff_is_o_nhds_zero : has_deriv_at f f' x ↔ - is_o (λh, f (x + h) - f x - h • f') (λh, h) (𝓝 0) := -has_fderiv_at_iff_is_o_nhds_zero - -theorem has_deriv_at_filter.mono (h : has_deriv_at_filter f f' x L₂) (hst : L₁ ≤ L₂) : - has_deriv_at_filter f f' x L₁ := -has_fderiv_at_filter.mono h hst - -theorem has_deriv_within_at.mono (h : has_deriv_within_at f f' t x) (hst : s ⊆ t) : - has_deriv_within_at f f' s x := -has_fderiv_within_at.mono h hst - -theorem has_deriv_at.has_deriv_at_filter (h : has_deriv_at f f' x) (hL : L ≤ 𝓝 x) : - has_deriv_at_filter f f' x L := -has_fderiv_at.has_fderiv_at_filter h hL - -theorem has_deriv_at.has_deriv_within_at - (h : has_deriv_at f f' x) : has_deriv_within_at f f' s x := -has_fderiv_at.has_fderiv_within_at h - -lemma has_deriv_within_at.differentiable_within_at (h : has_deriv_within_at f f' s x) : - differentiable_within_at 𝕜 f s x := -has_fderiv_within_at.differentiable_within_at h - -lemma has_deriv_at.differentiable_at (h : has_deriv_at f f' x) : differentiable_at 𝕜 f x := -has_fderiv_at.differentiable_at h - -@[simp] lemma has_deriv_within_at_univ : has_deriv_within_at f f' univ x ↔ has_deriv_at f f' x := -has_fderiv_within_at_univ - -theorem has_deriv_at.unique - (h₀ : has_deriv_at f f₀' x) (h₁ : has_deriv_at f f₁' x) : f₀' = f₁' := -smul_right_one_eq_iff.mp $ h₀.has_fderiv_at.unique h₁ - -lemma has_deriv_within_at_inter' (h : t ∈ 𝓝[s] x) : - has_deriv_within_at f f' (s ∩ t) x ↔ has_deriv_within_at f f' s x := -has_fderiv_within_at_inter' h - -lemma has_deriv_within_at_inter (h : t ∈ 𝓝 x) : - has_deriv_within_at f f' (s ∩ t) x ↔ has_deriv_within_at f f' s x := -has_fderiv_within_at_inter h - -lemma has_deriv_within_at.union (hs : has_deriv_within_at f f' s x) - (ht : has_deriv_within_at f f' t x) : - has_deriv_within_at f f' (s ∪ t) x := -begin - simp only [has_deriv_within_at, nhds_within_union], - exact hs.join ht, -end - -lemma has_deriv_within_at.nhds_within (h : has_deriv_within_at f f' s x) - (ht : s ∈ 𝓝[t] x) : has_deriv_within_at f f' t x := -(has_deriv_within_at_inter' ht).1 (h.mono (inter_subset_right _ _)) - -lemma has_deriv_within_at.has_deriv_at (h : has_deriv_within_at f f' s x) (hs : s ∈ 𝓝 x) : - has_deriv_at f f' x := -has_fderiv_within_at.has_fderiv_at h hs - -lemma differentiable_within_at.has_deriv_within_at (h : differentiable_within_at 𝕜 f s x) : - has_deriv_within_at f (deriv_within f s x) s x := -h.has_fderiv_within_at.has_deriv_within_at - -lemma differentiable_at.has_deriv_at (h : differentiable_at 𝕜 f x) : has_deriv_at f (deriv f x) x := -h.has_fderiv_at.has_deriv_at - -@[simp] lemma has_deriv_at_deriv_iff : has_deriv_at f (deriv f x) x ↔ differentiable_at 𝕜 f x := -⟨λ h, h.differentiable_at, λ h, h.has_deriv_at⟩ - -@[simp] lemma has_deriv_within_at_deriv_within_iff : - has_deriv_within_at f (deriv_within f s x) s x ↔ differentiable_within_at 𝕜 f s x := -⟨λ h, h.differentiable_within_at, λ h, h.has_deriv_within_at⟩ - -lemma differentiable_on.has_deriv_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : - has_deriv_at f (deriv f x) x := -(h.has_fderiv_at hs).has_deriv_at - -lemma has_deriv_at.deriv (h : has_deriv_at f f' x) : deriv f x = f' := -h.differentiable_at.has_deriv_at.unique h - -lemma deriv_eq {f' : 𝕜 → F} (h : ∀ x, has_deriv_at f (f' x) x) : deriv f = f' := -funext $ λ x, (h x).deriv - -lemma has_deriv_within_at.deriv_within - (h : has_deriv_within_at f f' s x) (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within f s x = f' := -hxs.eq_deriv _ h.differentiable_within_at.has_deriv_within_at h - -lemma fderiv_within_deriv_within : (fderiv_within 𝕜 f s x : 𝕜 → F) 1 = deriv_within f s x := -rfl - -lemma deriv_within_fderiv_within : - smul_right (1 : 𝕜 →L[𝕜] 𝕜) (deriv_within f s x) = fderiv_within 𝕜 f s x := -by simp [deriv_within] - -lemma fderiv_deriv : (fderiv 𝕜 f x : 𝕜 → F) 1 = deriv f x := -rfl - -lemma deriv_fderiv : - smul_right (1 : 𝕜 →L[𝕜] 𝕜) (deriv f x) = fderiv 𝕜 f x := -by simp [deriv] - -lemma differentiable_at.deriv_within (h : differentiable_at 𝕜 f x) - (hxs : unique_diff_within_at 𝕜 s x) : deriv_within f s x = deriv f x := -by { unfold deriv_within deriv, rw h.fderiv_within hxs } - -lemma deriv_within_subset (st : s ⊆ t) (ht : unique_diff_within_at 𝕜 s x) - (h : differentiable_within_at 𝕜 f t x) : - deriv_within f s x = deriv_within f t x := -((differentiable_within_at.has_deriv_within_at h).mono st).deriv_within ht - -@[simp] lemma deriv_within_univ : deriv_within f univ = deriv f := -by { ext, unfold deriv_within deriv, rw fderiv_within_univ } - -lemma deriv_within_inter (ht : t ∈ 𝓝 x) (hs : unique_diff_within_at 𝕜 s x) : - deriv_within f (s ∩ t) x = deriv_within f s x := -by { unfold deriv_within, rw fderiv_within_inter ht hs } - -lemma deriv_within_of_open (hs : is_open s) (hx : x ∈ s) : - deriv_within f s x = deriv f x := -by { unfold deriv_within, rw fderiv_within_of_open hs hx, refl } - -section congr -/-! ### Congruence properties of derivatives -/ - -theorem filter.eventually_eq.has_deriv_at_filter_iff - (h₀ : f₀ =ᶠ[L] f₁) (hx : f₀ x = f₁ x) (h₁ : f₀' = f₁') : - has_deriv_at_filter f₀ f₀' x L ↔ has_deriv_at_filter f₁ f₁' x L := -h₀.has_fderiv_at_filter_iff hx (by simp [h₁]) - -lemma has_deriv_at_filter.congr_of_eventually_eq (h : has_deriv_at_filter f f' x L) - (hL : f₁ =ᶠ[L] f) (hx : f₁ x = f x) : has_deriv_at_filter f₁ f' x L := -by rwa hL.has_deriv_at_filter_iff hx rfl - -lemma has_deriv_within_at.congr_mono (h : has_deriv_within_at f f' s x) (ht : ∀x ∈ t, f₁ x = f x) - (hx : f₁ x = f x) (h₁ : t ⊆ s) : has_deriv_within_at f₁ f' t x := -has_fderiv_within_at.congr_mono h ht hx h₁ - -lemma has_deriv_within_at.congr (h : has_deriv_within_at f f' s x) (hs : ∀x ∈ s, f₁ x = f x) - (hx : f₁ x = f x) : has_deriv_within_at f₁ f' s x := -h.congr_mono hs hx (subset.refl _) - -lemma has_deriv_within_at.congr_of_eventually_eq (h : has_deriv_within_at f f' s x) - (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : has_deriv_within_at f₁ f' s x := -has_deriv_at_filter.congr_of_eventually_eq h h₁ hx - -lemma has_deriv_within_at.congr_of_eventually_eq_of_mem (h : has_deriv_within_at f f' s x) - (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : x ∈ s) : has_deriv_within_at f₁ f' s x := -h.congr_of_eventually_eq h₁ (h₁.eq_of_nhds_within hx) - -lemma has_deriv_at.congr_of_eventually_eq (h : has_deriv_at f f' x) - (h₁ : f₁ =ᶠ[𝓝 x] f) : has_deriv_at f₁ f' x := -has_deriv_at_filter.congr_of_eventually_eq h h₁ (mem_of_mem_nhds h₁ : _) - -lemma filter.eventually_eq.deriv_within_eq (hs : unique_diff_within_at 𝕜 s x) - (hL : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : - deriv_within f₁ s x = deriv_within f s x := -by { unfold deriv_within, rw hL.fderiv_within_eq hs hx } - -lemma deriv_within_congr (hs : unique_diff_within_at 𝕜 s x) - (hL : ∀y∈s, f₁ y = f y) (hx : f₁ x = f x) : - deriv_within f₁ s x = deriv_within f s x := -by { unfold deriv_within, rw fderiv_within_congr hs hL hx } - -lemma filter.eventually_eq.deriv_eq (hL : f₁ =ᶠ[𝓝 x] f) : deriv f₁ x = deriv f x := -by { unfold deriv, rwa filter.eventually_eq.fderiv_eq } - -protected lemma filter.eventually_eq.deriv (h : f₁ =ᶠ[𝓝 x] f) : deriv f₁ =ᶠ[𝓝 x] deriv f := -h.eventually_eq_nhds.mono $ λ x h, h.deriv_eq - -end congr - -section id -/-! ### Derivative of the identity -/ -variables (s x L) - -theorem has_deriv_at_filter_id : has_deriv_at_filter id 1 x L := -(has_fderiv_at_filter_id x L).has_deriv_at_filter - -theorem has_deriv_within_at_id : has_deriv_within_at id 1 s x := -has_deriv_at_filter_id _ _ - -theorem has_deriv_at_id : has_deriv_at id 1 x := -has_deriv_at_filter_id _ _ - -theorem has_deriv_at_id' : has_deriv_at (λ (x : 𝕜), x) 1 x := -has_deriv_at_filter_id _ _ - -theorem has_strict_deriv_at_id : has_strict_deriv_at id 1 x := -(has_strict_fderiv_at_id x).has_strict_deriv_at - -lemma deriv_id : deriv id x = 1 := -has_deriv_at.deriv (has_deriv_at_id x) - -@[simp] lemma deriv_id' : deriv (@id 𝕜) = λ _, 1 := funext deriv_id - -@[simp] lemma deriv_id'' : deriv (λ x : 𝕜, x) = λ _, 1 := deriv_id' - -lemma deriv_within_id (hxs : unique_diff_within_at 𝕜 s x) : deriv_within id s x = 1 := -(has_deriv_within_at_id x s).deriv_within hxs - -end id - -section const -/-! ### Derivative of constant functions -/ -variables (c : F) (s x L) - -theorem has_deriv_at_filter_const : has_deriv_at_filter (λ x, c) 0 x L := -(has_fderiv_at_filter_const c x L).has_deriv_at_filter - -theorem has_strict_deriv_at_const : has_strict_deriv_at (λ x, c) 0 x := -(has_strict_fderiv_at_const c x).has_strict_deriv_at - -theorem has_deriv_within_at_const : has_deriv_within_at (λ x, c) 0 s x := -has_deriv_at_filter_const _ _ _ - -theorem has_deriv_at_const : has_deriv_at (λ x, c) 0 x := -has_deriv_at_filter_const _ _ _ - -lemma deriv_const : deriv (λ x, c) x = 0 := -has_deriv_at.deriv (has_deriv_at_const x c) - -@[simp] lemma deriv_const' : deriv (λ x:𝕜, c) = λ x, 0 := -funext (λ x, deriv_const x c) - -lemma deriv_within_const (hxs : unique_diff_within_at 𝕜 s x) : deriv_within (λ x, c) s x = 0 := -(has_deriv_within_at_const _ _ _).deriv_within hxs - -end const - -section continuous_linear_map -/-! ### Derivative of continuous linear maps -/ -variables (e : 𝕜 →L[𝕜] F) - -protected lemma continuous_linear_map.has_deriv_at_filter : has_deriv_at_filter e (e 1) x L := -e.has_fderiv_at_filter.has_deriv_at_filter - -protected lemma continuous_linear_map.has_strict_deriv_at : has_strict_deriv_at e (e 1) x := -e.has_strict_fderiv_at.has_strict_deriv_at - -protected lemma continuous_linear_map.has_deriv_at : has_deriv_at e (e 1) x := -e.has_deriv_at_filter - -protected lemma continuous_linear_map.has_deriv_within_at : has_deriv_within_at e (e 1) s x := -e.has_deriv_at_filter - -@[simp] protected lemma continuous_linear_map.deriv : deriv e x = e 1 := -e.has_deriv_at.deriv - -protected lemma continuous_linear_map.deriv_within (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within e s x = e 1 := -e.has_deriv_within_at.deriv_within hxs - -end continuous_linear_map - -section linear_map -/-! ### Derivative of bundled linear maps -/ -variables (e : 𝕜 →ₗ[𝕜] F) - -protected lemma linear_map.has_deriv_at_filter : has_deriv_at_filter e (e 1) x L := -e.to_continuous_linear_map₁.has_deriv_at_filter - -protected lemma linear_map.has_strict_deriv_at : has_strict_deriv_at e (e 1) x := -e.to_continuous_linear_map₁.has_strict_deriv_at - -protected lemma linear_map.has_deriv_at : has_deriv_at e (e 1) x := -e.has_deriv_at_filter - -protected lemma linear_map.has_deriv_within_at : has_deriv_within_at e (e 1) s x := -e.has_deriv_at_filter - -@[simp] protected lemma linear_map.deriv : deriv e x = e 1 := -e.has_deriv_at.deriv - -protected lemma linear_map.deriv_within (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within e s x = e 1 := -e.has_deriv_within_at.deriv_within hxs - -end linear_map - -section add -/-! ### Derivative of the sum of two functions -/ - -theorem has_deriv_at_filter.add - (hf : has_deriv_at_filter f f' x L) (hg : has_deriv_at_filter g g' x L) : - has_deriv_at_filter (λ y, f y + g y) (f' + g') x L := -by simpa using (hf.add hg).has_deriv_at_filter - -theorem has_strict_deriv_at.add - (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x) : - has_strict_deriv_at (λ y, f y + g y) (f' + g') x := -by simpa using (hf.add hg).has_strict_deriv_at - -theorem has_deriv_within_at.add - (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) : - has_deriv_within_at (λ y, f y + g y) (f' + g') s x := -hf.add hg - -theorem has_deriv_at.add - (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) : - has_deriv_at (λ x, f x + g x) (f' + g') x := -hf.add hg - -lemma deriv_within_add (hxs : unique_diff_within_at 𝕜 s x) - (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : - deriv_within (λy, f y + g y) s x = deriv_within f s x + deriv_within g s x := -(hf.has_deriv_within_at.add hg.has_deriv_within_at).deriv_within hxs - -@[simp] lemma deriv_add - (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : - deriv (λy, f y + g y) x = deriv f x + deriv g x := -(hf.has_deriv_at.add hg.has_deriv_at).deriv - -theorem has_deriv_at_filter.add_const - (hf : has_deriv_at_filter f f' x L) (c : F) : - has_deriv_at_filter (λ y, f y + c) f' x L := -add_zero f' ▸ hf.add (has_deriv_at_filter_const x L c) - -theorem has_deriv_within_at.add_const - (hf : has_deriv_within_at f f' s x) (c : F) : - has_deriv_within_at (λ y, f y + c) f' s x := -hf.add_const c - -theorem has_deriv_at.add_const - (hf : has_deriv_at f f' x) (c : F) : - has_deriv_at (λ x, f x + c) f' x := -hf.add_const c - -lemma deriv_within_add_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - deriv_within (λy, f y + c) s x = deriv_within f s x := -by simp only [deriv_within, fderiv_within_add_const hxs] - -lemma deriv_add_const (c : F) : deriv (λy, f y + c) x = deriv f x := -by simp only [deriv, fderiv_add_const] - -@[simp] lemma deriv_add_const' (c : F) : deriv (λ y, f y + c) = deriv f := -funext $ λ x, deriv_add_const c - -theorem has_deriv_at_filter.const_add (c : F) (hf : has_deriv_at_filter f f' x L) : - has_deriv_at_filter (λ y, c + f y) f' x L := -zero_add f' ▸ (has_deriv_at_filter_const x L c).add hf - -theorem has_deriv_within_at.const_add (c : F) (hf : has_deriv_within_at f f' s x) : - has_deriv_within_at (λ y, c + f y) f' s x := -hf.const_add c - -theorem has_deriv_at.const_add (c : F) (hf : has_deriv_at f f' x) : - has_deriv_at (λ x, c + f x) f' x := -hf.const_add c - -lemma deriv_within_const_add (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - deriv_within (λy, c + f y) s x = deriv_within f s x := -by simp only [deriv_within, fderiv_within_const_add hxs] - -lemma deriv_const_add (c : F) : deriv (λy, c + f y) x = deriv f x := -by simp only [deriv, fderiv_const_add] - -@[simp] lemma deriv_const_add' (c : F) : deriv (λ y, c + f y) = deriv f := -funext $ λ x, deriv_const_add c - -end add - -section sum -/-! ### Derivative of a finite sum of functions -/ - -open_locale big_operators - -variables {ι : Type*} {u : finset ι} {A : ι → (𝕜 → F)} {A' : ι → F} - -theorem has_deriv_at_filter.sum (h : ∀ i ∈ u, has_deriv_at_filter (A i) (A' i) x L) : - has_deriv_at_filter (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x L := -by simpa [continuous_linear_map.sum_apply] using (has_fderiv_at_filter.sum h).has_deriv_at_filter - -theorem has_strict_deriv_at.sum (h : ∀ i ∈ u, has_strict_deriv_at (A i) (A' i) x) : - has_strict_deriv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := -by simpa [continuous_linear_map.sum_apply] using (has_strict_fderiv_at.sum h).has_strict_deriv_at - -theorem has_deriv_within_at.sum (h : ∀ i ∈ u, has_deriv_within_at (A i) (A' i) s x) : - has_deriv_within_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) s x := -has_deriv_at_filter.sum h - -theorem has_deriv_at.sum (h : ∀ i ∈ u, has_deriv_at (A i) (A' i) x) : - has_deriv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := -has_deriv_at_filter.sum h - -lemma deriv_within_sum (hxs : unique_diff_within_at 𝕜 s x) - (h : ∀ i ∈ u, differentiable_within_at 𝕜 (A i) s x) : - deriv_within (λ y, ∑ i in u, A i y) s x = ∑ i in u, deriv_within (A i) s x := -(has_deriv_within_at.sum (λ i hi, (h i hi).has_deriv_within_at)).deriv_within hxs - -@[simp] lemma deriv_sum (h : ∀ i ∈ u, differentiable_at 𝕜 (A i) x) : - deriv (λ y, ∑ i in u, A i y) x = ∑ i in u, deriv (A i) x := -(has_deriv_at.sum (λ i hi, (h i hi).has_deriv_at)).deriv - -end sum - -section pi - -/-! ### Derivatives of functions `f : 𝕜 → Π i, E i` -/ - -variables {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_group (E' i)] - [Π i, normed_space 𝕜 (E' i)] {φ : 𝕜 → Π i, E' i} {φ' : Π i, E' i} - -@[simp] lemma has_strict_deriv_at_pi : - has_strict_deriv_at φ φ' x ↔ ∀ i, has_strict_deriv_at (λ x, φ x i) (φ' i) x := -has_strict_fderiv_at_pi' - -@[simp] lemma has_deriv_at_filter_pi : - has_deriv_at_filter φ φ' x L ↔ - ∀ i, has_deriv_at_filter (λ x, φ x i) (φ' i) x L := -has_fderiv_at_filter_pi' - -lemma has_deriv_at_pi : - has_deriv_at φ φ' x ↔ ∀ i, has_deriv_at (λ x, φ x i) (φ' i) x:= -has_deriv_at_filter_pi - -lemma has_deriv_within_at_pi : - has_deriv_within_at φ φ' s x ↔ ∀ i, has_deriv_within_at (λ x, φ x i) (φ' i) s x:= -has_deriv_at_filter_pi - -lemma deriv_within_pi (h : ∀ i, differentiable_within_at 𝕜 (λ x, φ x i) s x) - (hs : unique_diff_within_at 𝕜 s x) : - deriv_within φ s x = λ i, deriv_within (λ x, φ x i) s x := -(has_deriv_within_at_pi.2 (λ i, (h i).has_deriv_within_at)).deriv_within hs - -lemma deriv_pi (h : ∀ i, differentiable_at 𝕜 (λ x, φ x i) x) : - deriv φ x = λ i, deriv (λ x, φ x i) x := -(has_deriv_at_pi.2 (λ i, (h i).has_deriv_at)).deriv - -end pi - -section smul - -/-! ### Derivative of the multiplication of a scalar function and a vector function -/ - -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] - [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {c : 𝕜 → 𝕜'} {c' : 𝕜'} - -theorem has_deriv_within_at.smul - (hc : has_deriv_within_at c c' s x) (hf : has_deriv_within_at f f' s x) : - has_deriv_within_at (λ y, c y • f y) (c x • f' + c' • f x) s x := -by simpa using (has_fderiv_within_at.smul hc hf).has_deriv_within_at - -theorem has_deriv_at.smul - (hc : has_deriv_at c c' x) (hf : has_deriv_at f f' x) : - has_deriv_at (λ y, c y • f y) (c x • f' + c' • f x) x := -begin - rw [← has_deriv_within_at_univ] at *, - exact hc.smul hf -end - -theorem has_strict_deriv_at.smul - (hc : has_strict_deriv_at c c' x) (hf : has_strict_deriv_at f f' x) : - has_strict_deriv_at (λ y, c y • f y) (c x • f' + c' • f x) x := -by simpa using (hc.smul hf).has_strict_deriv_at - -lemma deriv_within_smul (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hf : differentiable_within_at 𝕜 f s x) : - deriv_within (λ y, c y • f y) s x = c x • deriv_within f s x + (deriv_within c s x) • f x := -(hc.has_deriv_within_at.smul hf.has_deriv_within_at).deriv_within hxs - -lemma deriv_smul (hc : differentiable_at 𝕜 c x) (hf : differentiable_at 𝕜 f x) : - deriv (λ y, c y • f y) x = c x • deriv f x + (deriv c x) • f x := -(hc.has_deriv_at.smul hf.has_deriv_at).deriv - -theorem has_deriv_within_at.smul_const - (hc : has_deriv_within_at c c' s x) (f : F) : - has_deriv_within_at (λ y, c y • f) (c' • f) s x := -begin - have := hc.smul (has_deriv_within_at_const x s f), - rwa [smul_zero, zero_add] at this -end - -theorem has_deriv_at.smul_const - (hc : has_deriv_at c c' x) (f : F) : - has_deriv_at (λ y, c y • f) (c' • f) x := -begin - rw [← has_deriv_within_at_univ] at *, - exact hc.smul_const f -end - -lemma deriv_within_smul_const (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (f : F) : - deriv_within (λ y, c y • f) s x = (deriv_within c s x) • f := -(hc.has_deriv_within_at.smul_const f).deriv_within hxs - -lemma deriv_smul_const (hc : differentiable_at 𝕜 c x) (f : F) : - deriv (λ y, c y • f) x = (deriv c x) • f := -(hc.has_deriv_at.smul_const f).deriv - -end smul - -section const_smul - -variables {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] - [has_continuous_const_smul R F] - -theorem has_strict_deriv_at.const_smul - (c : R) (hf : has_strict_deriv_at f f' x) : - has_strict_deriv_at (λ y, c • f y) (c • f') x := -by simpa using (hf.const_smul c).has_strict_deriv_at - -theorem has_deriv_at_filter.const_smul - (c : R) (hf : has_deriv_at_filter f f' x L) : - has_deriv_at_filter (λ y, c • f y) (c • f') x L := -by simpa using (hf.const_smul c).has_deriv_at_filter - -theorem has_deriv_within_at.const_smul - (c : R) (hf : has_deriv_within_at f f' s x) : - has_deriv_within_at (λ y, c • f y) (c • f') s x := -hf.const_smul c - -theorem has_deriv_at.const_smul (c : R) (hf : has_deriv_at f f' x) : - has_deriv_at (λ y, c • f y) (c • f') x := -hf.const_smul c - -lemma deriv_within_const_smul (hxs : unique_diff_within_at 𝕜 s x) - (c : R) (hf : differentiable_within_at 𝕜 f s x) : - deriv_within (λ y, c • f y) s x = c • deriv_within f s x := -(hf.has_deriv_within_at.const_smul c).deriv_within hxs - -lemma deriv_const_smul (c : R) (hf : differentiable_at 𝕜 f x) : - deriv (λ y, c • f y) x = c • deriv f x := -(hf.has_deriv_at.const_smul c).deriv - -end const_smul - -section neg -/-! ### Derivative of the negative of a function -/ - -theorem has_deriv_at_filter.neg (h : has_deriv_at_filter f f' x L) : - has_deriv_at_filter (λ x, -f x) (-f') x L := -by simpa using h.neg.has_deriv_at_filter - -theorem has_deriv_within_at.neg (h : has_deriv_within_at f f' s x) : - has_deriv_within_at (λ x, -f x) (-f') s x := -h.neg - -theorem has_deriv_at.neg (h : has_deriv_at f f' x) : has_deriv_at (λ x, -f x) (-f') x := -h.neg - -theorem has_strict_deriv_at.neg (h : has_strict_deriv_at f f' x) : - has_strict_deriv_at (λ x, -f x) (-f') x := -by simpa using h.neg.has_strict_deriv_at - -lemma deriv_within.neg (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λy, -f y) s x = - deriv_within f s x := -by simp only [deriv_within, fderiv_within_neg hxs, continuous_linear_map.neg_apply] - -lemma deriv.neg : deriv (λy, -f y) x = - deriv f x := -by simp only [deriv, fderiv_neg, continuous_linear_map.neg_apply] - -@[simp] lemma deriv.neg' : deriv (λy, -f y) = (λ x, - deriv f x) := -funext $ λ x, deriv.neg - -end neg - -section neg2 -/-! ### Derivative of the negation function (i.e `has_neg.neg`) -/ - -variables (s x L) - -theorem has_deriv_at_filter_neg : has_deriv_at_filter has_neg.neg (-1) x L := -has_deriv_at_filter.neg $ has_deriv_at_filter_id _ _ - -theorem has_deriv_within_at_neg : has_deriv_within_at has_neg.neg (-1) s x := -has_deriv_at_filter_neg _ _ - -theorem has_deriv_at_neg : has_deriv_at has_neg.neg (-1) x := -has_deriv_at_filter_neg _ _ - -theorem has_deriv_at_neg' : has_deriv_at (λ x, -x) (-1) x := -has_deriv_at_filter_neg _ _ - -theorem has_strict_deriv_at_neg : has_strict_deriv_at has_neg.neg (-1) x := -has_strict_deriv_at.neg $ has_strict_deriv_at_id _ - -lemma deriv_neg : deriv has_neg.neg x = -1 := -has_deriv_at.deriv (has_deriv_at_neg x) - -@[simp] lemma deriv_neg' : deriv (has_neg.neg : 𝕜 → 𝕜) = λ _, -1 := -funext deriv_neg - -@[simp] lemma deriv_neg'' : deriv (λ x : 𝕜, -x) x = -1 := -deriv_neg x - -lemma deriv_within_neg (hxs : unique_diff_within_at 𝕜 s x) : deriv_within has_neg.neg s x = -1 := -(has_deriv_within_at_neg x s).deriv_within hxs - -lemma differentiable_neg : differentiable 𝕜 (has_neg.neg : 𝕜 → 𝕜) := -differentiable.neg differentiable_id - -lemma differentiable_on_neg : differentiable_on 𝕜 (has_neg.neg : 𝕜 → 𝕜) s := -differentiable_on.neg differentiable_on_id - -end neg2 - -section sub -/-! ### Derivative of the difference of two functions -/ - -theorem has_deriv_at_filter.sub - (hf : has_deriv_at_filter f f' x L) (hg : has_deriv_at_filter g g' x L) : - has_deriv_at_filter (λ x, f x - g x) (f' - g') x L := -by simpa only [sub_eq_add_neg] using hf.add hg.neg - -theorem has_deriv_within_at.sub - (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) : - has_deriv_within_at (λ x, f x - g x) (f' - g') s x := -hf.sub hg - -theorem has_deriv_at.sub - (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) : - has_deriv_at (λ x, f x - g x) (f' - g') x := -hf.sub hg - -theorem has_strict_deriv_at.sub - (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x) : - has_strict_deriv_at (λ x, f x - g x) (f' - g') x := -by simpa only [sub_eq_add_neg] using hf.add hg.neg - -lemma deriv_within_sub (hxs : unique_diff_within_at 𝕜 s x) - (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : - deriv_within (λy, f y - g y) s x = deriv_within f s x - deriv_within g s x := -(hf.has_deriv_within_at.sub hg.has_deriv_within_at).deriv_within hxs - -@[simp] lemma deriv_sub - (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : - deriv (λ y, f y - g y) x = deriv f x - deriv g x := -(hf.has_deriv_at.sub hg.has_deriv_at).deriv - -theorem has_deriv_at_filter.is_O_sub (h : has_deriv_at_filter f f' x L) : - is_O (λ x', f x' - f x) (λ x', x' - x) L := -has_fderiv_at_filter.is_O_sub h - -theorem has_deriv_at_filter.is_O_sub_rev (hf : has_deriv_at_filter f f' x L) (hf' : f' ≠ 0) : - is_O (λ x', x' - x) (λ x', f x' - f x) L := -suffices antilipschitz_with ∥f'∥₊⁻¹ (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f'), from hf.is_O_sub_rev this, -(smul_right (1 : 𝕜 →L[𝕜] 𝕜) f').to_linear_map.antilipschitz_of_bound $ - λ x, by simp [norm_smul, ← div_eq_inv_mul, mul_div_cancel _ (mt norm_eq_zero.1 hf')] - -theorem has_deriv_at_filter.sub_const - (hf : has_deriv_at_filter f f' x L) (c : F) : - has_deriv_at_filter (λ x, f x - c) f' x L := -by simpa only [sub_eq_add_neg] using hf.add_const (-c) - -theorem has_deriv_within_at.sub_const - (hf : has_deriv_within_at f f' s x) (c : F) : - has_deriv_within_at (λ x, f x - c) f' s x := -hf.sub_const c - -theorem has_deriv_at.sub_const - (hf : has_deriv_at f f' x) (c : F) : - has_deriv_at (λ x, f x - c) f' x := -hf.sub_const c - -lemma deriv_within_sub_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - deriv_within (λy, f y - c) s x = deriv_within f s x := -by simp only [deriv_within, fderiv_within_sub_const hxs] - -lemma deriv_sub_const (c : F) : deriv (λ y, f y - c) x = deriv f x := -by simp only [deriv, fderiv_sub_const] - -theorem has_deriv_at_filter.const_sub (c : F) (hf : has_deriv_at_filter f f' x L) : - has_deriv_at_filter (λ x, c - f x) (-f') x L := -by simpa only [sub_eq_add_neg] using hf.neg.const_add c - -theorem has_deriv_within_at.const_sub (c : F) (hf : has_deriv_within_at f f' s x) : - has_deriv_within_at (λ x, c - f x) (-f') s x := -hf.const_sub c - -theorem has_strict_deriv_at.const_sub (c : F) (hf : has_strict_deriv_at f f' x) : - has_strict_deriv_at (λ x, c - f x) (-f') x := -by simpa only [sub_eq_add_neg] using hf.neg.const_add c - -theorem has_deriv_at.const_sub (c : F) (hf : has_deriv_at f f' x) : - has_deriv_at (λ x, c - f x) (-f') x := -hf.const_sub c - -lemma deriv_within_const_sub (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - deriv_within (λy, c - f y) s x = -deriv_within f s x := -by simp [deriv_within, fderiv_within_const_sub hxs] - -lemma deriv_const_sub (c : F) : deriv (λ y, c - f y) x = -deriv f x := -by simp only [← deriv_within_univ, - deriv_within_const_sub (unique_diff_within_at_univ : unique_diff_within_at 𝕜 _ _)] - -end sub - -section continuous -/-! ### Continuity of a function admitting a derivative -/ - -theorem has_deriv_at_filter.tendsto_nhds - (hL : L ≤ 𝓝 x) (h : has_deriv_at_filter f f' x L) : - tendsto f L (𝓝 (f x)) := -h.tendsto_nhds hL - -theorem has_deriv_within_at.continuous_within_at - (h : has_deriv_within_at f f' s x) : continuous_within_at f s x := -has_deriv_at_filter.tendsto_nhds inf_le_left h - -theorem has_deriv_at.continuous_at (h : has_deriv_at f f' x) : continuous_at f x := -has_deriv_at_filter.tendsto_nhds le_rfl h - -protected theorem has_deriv_at.continuous_on {f f' : 𝕜 → F} - (hderiv : ∀ x ∈ s, has_deriv_at f (f' x) x) : continuous_on f s := -λ x hx, (hderiv x hx).continuous_at.continuous_within_at - -end continuous - -section cartesian_product -/-! ### Derivative of the cartesian product of two functions -/ - -variables {G : Type w} [normed_group G] [normed_space 𝕜 G] -variables {f₂ : 𝕜 → G} {f₂' : G} - -lemma has_deriv_at_filter.prod - (hf₁ : has_deriv_at_filter f₁ f₁' x L) (hf₂ : has_deriv_at_filter f₂ f₂' x L) : - has_deriv_at_filter (λ x, (f₁ x, f₂ x)) (f₁', f₂') x L := -hf₁.prod hf₂ - -lemma has_deriv_within_at.prod - (hf₁ : has_deriv_within_at f₁ f₁' s x) (hf₂ : has_deriv_within_at f₂ f₂' s x) : - has_deriv_within_at (λ x, (f₁ x, f₂ x)) (f₁', f₂') s x := -hf₁.prod hf₂ - -lemma has_deriv_at.prod (hf₁ : has_deriv_at f₁ f₁' x) (hf₂ : has_deriv_at f₂ f₂' x) : - has_deriv_at (λ x, (f₁ x, f₂ x)) (f₁', f₂') x := -hf₁.prod hf₂ - -lemma has_strict_deriv_at.prod (hf₁ : has_strict_deriv_at f₁ f₁' x) - (hf₂ : has_strict_deriv_at f₂ f₂' x) : - has_strict_deriv_at (λ x, (f₁ x, f₂ x)) (f₁', f₂') x := -hf₁.prod hf₂ - -end cartesian_product - -section composition -/-! -### Derivative of the composition of a vector function and a scalar function - -We use `scomp` in lemmas on composition of vector valued and scalar valued functions, and `comp` -in lemmas on composition of scalar valued functions, in analogy for `smul` and `mul` (and also -because the `comp` version with the shorter name will show up much more often in applications). -The formula for the derivative involves `smul` in `scomp` lemmas, which can be reduced to -usual multiplication in `comp` lemmas. --/ - -/- For composition lemmas, we put x explicit to help the elaborator, as otherwise Lean tends to -get confused since there are too many possibilities for composition -/ -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] - [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {s' t' : set 𝕜'} - {h : 𝕜 → 𝕜'} {h₁ : 𝕜 → 𝕜} {h₂ : 𝕜' → 𝕜'} {h' h₂' : 𝕜'} {h₁' : 𝕜} - {g₁ : 𝕜' → F} {g₁' : F} {L' : filter 𝕜'} (x) - -theorem has_deriv_at_filter.scomp - (hg : has_deriv_at_filter g₁ g₁' (h x) L') - (hh : has_deriv_at_filter h h' x L) (hL : tendsto h L L'): - has_deriv_at_filter (g₁ ∘ h) (h' • g₁') x L := -by simpa using ((hg.restrict_scalars 𝕜).comp x hh hL).has_deriv_at_filter - -theorem has_deriv_within_at.scomp_has_deriv_at - (hg : has_deriv_within_at g₁ g₁' s' (h x)) - (hh : has_deriv_at h h' x) (hs : ∀ x, h x ∈ s') : - has_deriv_at (g₁ ∘ h) (h' • g₁') x := -hg.scomp x hh $ tendsto_inf.2 ⟨hh.continuous_at, tendsto_principal.2 $ eventually_of_forall hs⟩ - -theorem has_deriv_within_at.scomp - (hg : has_deriv_within_at g₁ g₁' t' (h x)) - (hh : has_deriv_within_at h h' s x) (hst : maps_to h s t') : - has_deriv_within_at (g₁ ∘ h) (h' • g₁') s x := -hg.scomp x hh $ hh.continuous_within_at.tendsto_nhds_within hst - -/-- The chain rule. -/ -theorem has_deriv_at.scomp - (hg : has_deriv_at g₁ g₁' (h x)) (hh : has_deriv_at h h' x) : - has_deriv_at (g₁ ∘ h) (h' • g₁') x := -hg.scomp x hh hh.continuous_at - -theorem has_strict_deriv_at.scomp - (hg : has_strict_deriv_at g₁ g₁' (h x)) (hh : has_strict_deriv_at h h' x) : - has_strict_deriv_at (g₁ ∘ h) (h' • g₁') x := -by simpa using ((hg.restrict_scalars 𝕜).comp x hh).has_strict_deriv_at - -theorem has_deriv_at.scomp_has_deriv_within_at - (hg : has_deriv_at g₁ g₁' (h x)) (hh : has_deriv_within_at h h' s x) : - has_deriv_within_at (g₁ ∘ h) (h' • g₁') s x := -has_deriv_within_at.scomp x hg.has_deriv_within_at hh (maps_to_univ _ _) - -lemma deriv_within.scomp - (hg : differentiable_within_at 𝕜' g₁ t' (h x)) (hh : differentiable_within_at 𝕜 h s x) - (hs : maps_to h s t') (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (g₁ ∘ h) s x = deriv_within h s x • deriv_within g₁ t' (h x) := -(has_deriv_within_at.scomp x hg.has_deriv_within_at hh.has_deriv_within_at hs).deriv_within hxs - -lemma deriv.scomp - (hg : differentiable_at 𝕜' g₁ (h x)) (hh : differentiable_at 𝕜 h x) : - deriv (g₁ ∘ h) x = deriv h x • deriv g₁ (h x) := -(has_deriv_at.scomp x hg.has_deriv_at hh.has_deriv_at).deriv - -/-! ### Derivative of the composition of a scalar and vector functions -/ - -theorem has_deriv_at_filter.comp_has_fderiv_at_filter {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} (x) - {L'' : filter E} (hh₂ : has_deriv_at_filter h₂ h₂' (f x) L') - (hf : has_fderiv_at_filter f f' x L'') (hL : tendsto f L'' L') : - has_fderiv_at_filter (h₂ ∘ f) (h₂' • f') x L'' := -by { convert (hh₂.restrict_scalars 𝕜).comp x hf hL, ext x, simp [mul_comm] } - -theorem has_strict_deriv_at.comp_has_strict_fderiv_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} (x) - (hh : has_strict_deriv_at h₂ h₂' (f x)) (hf : has_strict_fderiv_at f f' x) : - has_strict_fderiv_at (h₂ ∘ f) (h₂' • f') x := -begin - rw has_strict_deriv_at at hh, - convert (hh.restrict_scalars 𝕜).comp x hf, - ext x, - simp [mul_comm] -end - -theorem has_deriv_at.comp_has_fderiv_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} (x) - (hh : has_deriv_at h₂ h₂' (f x)) (hf : has_fderiv_at f f' x) : - has_fderiv_at (h₂ ∘ f) (h₂' • f') x := -hh.comp_has_fderiv_at_filter x hf hf.continuous_at - -theorem has_deriv_at.comp_has_fderiv_within_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} {s} (x) - (hh : has_deriv_at h₂ h₂' (f x)) (hf : has_fderiv_within_at f f' s x) : - has_fderiv_within_at (h₂ ∘ f) (h₂' • f') s x := -hh.comp_has_fderiv_at_filter x hf hf.continuous_within_at - -theorem has_deriv_within_at.comp_has_fderiv_within_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} {s t} (x) - (hh : has_deriv_within_at h₂ h₂' t (f x)) (hf : has_fderiv_within_at f f' s x) - (hst : maps_to f s t) : - has_fderiv_within_at (h₂ ∘ f) (h₂' • f') s x := -hh.comp_has_fderiv_at_filter x hf $ hf.continuous_within_at.tendsto_nhds_within hst - -/-! ### Derivative of the composition of two scalar functions -/ - -theorem has_deriv_at_filter.comp - (hh₂ : has_deriv_at_filter h₂ h₂' (h x) L') - (hh : has_deriv_at_filter h h' x L) (hL : tendsto h L L') : - has_deriv_at_filter (h₂ ∘ h) (h₂' * h') x L := -by { rw mul_comm, exact hh₂.scomp x hh hL } - -theorem has_deriv_within_at.comp - (hh₂ : has_deriv_within_at h₂ h₂' s' (h x)) - (hh : has_deriv_within_at h h' s x) (hst : maps_to h s s') : - has_deriv_within_at (h₂ ∘ h) (h₂' * h') s x := -by { rw mul_comm, exact hh₂.scomp x hh hst, } - -/-- The chain rule. -/ -theorem has_deriv_at.comp - (hh₂ : has_deriv_at h₂ h₂' (h x)) (hh : has_deriv_at h h' x) : - has_deriv_at (h₂ ∘ h) (h₂' * h') x := -hh₂.comp x hh hh.continuous_at - -theorem has_strict_deriv_at.comp - (hh₂ : has_strict_deriv_at h₂ h₂' (h x)) (hh : has_strict_deriv_at h h' x) : - has_strict_deriv_at (h₂ ∘ h) (h₂' * h') x := -by { rw mul_comm, exact hh₂.scomp x hh } - -theorem has_deriv_at.comp_has_deriv_within_at - (hh₂ : has_deriv_at h₂ h₂' (h x)) (hh : has_deriv_within_at h h' s x) : - has_deriv_within_at (h₂ ∘ h) (h₂' * h') s x := -hh₂.has_deriv_within_at.comp x hh (maps_to_univ _ _) - -lemma deriv_within.comp - (hh₂ : differentiable_within_at 𝕜' h₂ s' (h x)) (hh : differentiable_within_at 𝕜 h s x) - (hs : maps_to h s s') (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (h₂ ∘ h) s x = deriv_within h₂ s' (h x) * deriv_within h s x := -(hh₂.has_deriv_within_at.comp x hh.has_deriv_within_at hs).deriv_within hxs - -lemma deriv.comp - (hh₂ : differentiable_at 𝕜' h₂ (h x)) (hh : differentiable_at 𝕜 h x) : - deriv (h₂ ∘ h) x = deriv h₂ (h x) * deriv h x := -(hh₂.has_deriv_at.comp x hh.has_deriv_at).deriv - -protected lemma has_deriv_at_filter.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} - (hf : has_deriv_at_filter f f' x L) (hL : tendsto f L L) (hx : f x = x) (n : ℕ) : - has_deriv_at_filter (f^[n]) (f'^n) x L := -begin - have := hf.iterate hL hx n, - rwa [continuous_linear_map.smul_right_one_pow] at this -end - -protected lemma has_deriv_at.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} - (hf : has_deriv_at f f' x) (hx : f x = x) (n : ℕ) : - has_deriv_at (f^[n]) (f'^n) x := -begin - have := has_fderiv_at.iterate hf hx n, - rwa [continuous_linear_map.smul_right_one_pow] at this -end - -protected lemma has_deriv_within_at.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} - (hf : has_deriv_within_at f f' s x) (hx : f x = x) (hs : maps_to f s s) (n : ℕ) : - has_deriv_within_at (f^[n]) (f'^n) s x := -begin - have := has_fderiv_within_at.iterate hf hx hs n, - rwa [continuous_linear_map.smul_right_one_pow] at this -end - -protected lemma has_strict_deriv_at.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} - (hf : has_strict_deriv_at f f' x) (hx : f x = x) (n : ℕ) : - has_strict_deriv_at (f^[n]) (f'^n) x := -begin - have := hf.iterate hx n, - rwa [continuous_linear_map.smul_right_one_pow] at this -end - -end composition - -section composition_vector -/-! ### Derivative of the composition of a function between vector spaces and a function on `𝕜` -/ - -open continuous_linear_map - -variables {l : F → E} {l' : F →L[𝕜] E} -variable (x) - -/-- The composition `l ∘ f` where `l : F → E` and `f : 𝕜 → F`, has a derivative within a set -equal to the Fréchet derivative of `l` applied to the derivative of `f`. -/ -theorem has_fderiv_within_at.comp_has_deriv_within_at {t : set F} - (hl : has_fderiv_within_at l l' t (f x)) (hf : has_deriv_within_at f f' s x) - (hst : maps_to f s t) : - has_deriv_within_at (l ∘ f) (l' f') s x := -by simpa only [one_apply, one_smul, smul_right_apply, coe_comp', (∘)] - using (hl.comp x hf.has_fderiv_within_at hst).has_deriv_within_at - -theorem has_fderiv_at.comp_has_deriv_within_at - (hl : has_fderiv_at l l' (f x)) (hf : has_deriv_within_at f f' s x) : - has_deriv_within_at (l ∘ f) (l' f') s x := -hl.has_fderiv_within_at.comp_has_deriv_within_at x hf (maps_to_univ _ _) - -/-- The composition `l ∘ f` where `l : F → E` and `f : 𝕜 → F`, has a derivative equal to the -Fréchet derivative of `l` applied to the derivative of `f`. -/ -theorem has_fderiv_at.comp_has_deriv_at (hl : has_fderiv_at l l' (f x)) (hf : has_deriv_at f f' x) : - has_deriv_at (l ∘ f) (l' f') x := -has_deriv_within_at_univ.mp $ hl.comp_has_deriv_within_at x hf.has_deriv_within_at - -theorem has_strict_fderiv_at.comp_has_strict_deriv_at - (hl : has_strict_fderiv_at l l' (f x)) (hf : has_strict_deriv_at f f' x) : - has_strict_deriv_at (l ∘ f) (l' f') x := -by simpa only [one_apply, one_smul, smul_right_apply, coe_comp', (∘)] - using (hl.comp x hf.has_strict_fderiv_at).has_strict_deriv_at - -lemma fderiv_within.comp_deriv_within {t : set F} - (hl : differentiable_within_at 𝕜 l t (f x)) (hf : differentiable_within_at 𝕜 f s x) - (hs : maps_to f s t) (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (l ∘ f) s x = (fderiv_within 𝕜 l t (f x) : F → E) (deriv_within f s x) := -(hl.has_fderiv_within_at.comp_has_deriv_within_at x hf.has_deriv_within_at hs).deriv_within hxs - -lemma fderiv.comp_deriv - (hl : differentiable_at 𝕜 l (f x)) (hf : differentiable_at 𝕜 f x) : - deriv (l ∘ f) x = (fderiv 𝕜 l (f x) : F → E) (deriv f x) := -(hl.has_fderiv_at.comp_has_deriv_at x hf.has_deriv_at).deriv - -end composition_vector - -section mul -/-! ### Derivative of the multiplication of two functions -/ -variables {𝕜' 𝔸 : Type*} [normed_field 𝕜'] [normed_ring 𝔸] [normed_algebra 𝕜 𝕜'] - [normed_algebra 𝕜 𝔸] {c d : 𝕜 → 𝔸} {c' d' : 𝔸} {u v : 𝕜 → 𝕜'} - -theorem has_deriv_within_at.mul - (hc : has_deriv_within_at c c' s x) (hd : has_deriv_within_at d d' s x) : - has_deriv_within_at (λ y, c y * d y) (c' * d x + c x * d') s x := -begin - have := (has_fderiv_within_at.mul' hc hd).has_deriv_within_at, - rwa [continuous_linear_map.add_apply, continuous_linear_map.smul_apply, - continuous_linear_map.smul_right_apply, continuous_linear_map.smul_right_apply, - continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply, - one_smul, one_smul, add_comm] at this, -end - -theorem has_deriv_at.mul (hc : has_deriv_at c c' x) (hd : has_deriv_at d d' x) : - has_deriv_at (λ y, c y * d y) (c' * d x + c x * d') x := -begin - rw [← has_deriv_within_at_univ] at *, - exact hc.mul hd -end - -theorem has_strict_deriv_at.mul - (hc : has_strict_deriv_at c c' x) (hd : has_strict_deriv_at d d' x) : - has_strict_deriv_at (λ y, c y * d y) (c' * d x + c x * d') x := -begin - have := (has_strict_fderiv_at.mul' hc hd).has_strict_deriv_at, - rwa [continuous_linear_map.add_apply, continuous_linear_map.smul_apply, - continuous_linear_map.smul_right_apply, continuous_linear_map.smul_right_apply, - continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply, - one_smul, one_smul, add_comm] at this, -end - -lemma deriv_within_mul (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : - deriv_within (λ y, c y * d y) s x = deriv_within c s x * d x + c x * deriv_within d s x := -(hc.has_deriv_within_at.mul hd.has_deriv_within_at).deriv_within hxs - -@[simp] lemma deriv_mul (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : - deriv (λ y, c y * d y) x = deriv c x * d x + c x * deriv d x := -(hc.has_deriv_at.mul hd.has_deriv_at).deriv - -theorem has_deriv_within_at.mul_const (hc : has_deriv_within_at c c' s x) (d : 𝔸) : - has_deriv_within_at (λ y, c y * d) (c' * d) s x := -begin - convert hc.mul (has_deriv_within_at_const x s d), - rw [mul_zero, add_zero] -end - -theorem has_deriv_at.mul_const (hc : has_deriv_at c c' x) (d : 𝔸) : - has_deriv_at (λ y, c y * d) (c' * d) x := -begin - rw [← has_deriv_within_at_univ] at *, - exact hc.mul_const d -end - -theorem has_deriv_at_mul_const (c : 𝕜) : has_deriv_at (λ x, x * c) c x := -by simpa only [one_mul] using (has_deriv_at_id' x).mul_const c - -theorem has_strict_deriv_at.mul_const (hc : has_strict_deriv_at c c' x) (d : 𝔸) : - has_strict_deriv_at (λ y, c y * d) (c' * d) x := -begin - convert hc.mul (has_strict_deriv_at_const x d), - rw [mul_zero, add_zero] -end - -lemma deriv_within_mul_const (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (d : 𝔸) : - deriv_within (λ y, c y * d) s x = deriv_within c s x * d := -(hc.has_deriv_within_at.mul_const d).deriv_within hxs - -lemma deriv_mul_const (hc : differentiable_at 𝕜 c x) (d : 𝔸) : - deriv (λ y, c y * d) x = deriv c x * d := -(hc.has_deriv_at.mul_const d).deriv - -lemma deriv_mul_const_field (v : 𝕜') : - deriv (λ y, u y * v) x = deriv u x * v := -begin - by_cases hu : differentiable_at 𝕜 u x, - { exact deriv_mul_const hu v }, - { rw [deriv_zero_of_not_differentiable_at hu, zero_mul], - rcases eq_or_ne v 0 with rfl|hd, - { simp only [mul_zero, deriv_const] }, - { refine deriv_zero_of_not_differentiable_at (mt (λ H, _) hu), - simpa only [mul_inv_cancel_right₀ hd] using H.mul_const v⁻¹ } } -end - -@[simp] lemma deriv_mul_const_field' (v : 𝕜') : deriv (λ x, u x * v) = λ x, deriv u x * v := -funext $ λ _, deriv_mul_const_field v - -theorem has_deriv_within_at.const_mul (c : 𝔸) (hd : has_deriv_within_at d d' s x) : - has_deriv_within_at (λ y, c * d y) (c * d') s x := -begin - convert (has_deriv_within_at_const x s c).mul hd, - rw [zero_mul, zero_add] -end - -theorem has_deriv_at.const_mul (c : 𝔸) (hd : has_deriv_at d d' x) : - has_deriv_at (λ y, c * d y) (c * d') x := -begin - rw [← has_deriv_within_at_univ] at *, - exact hd.const_mul c -end - -theorem has_strict_deriv_at.const_mul (c : 𝔸) (hd : has_strict_deriv_at d d' x) : - has_strict_deriv_at (λ y, c * d y) (c * d') x := -begin - convert (has_strict_deriv_at_const _ _).mul hd, - rw [zero_mul, zero_add] -end - -lemma deriv_within_const_mul (hxs : unique_diff_within_at 𝕜 s x) - (c : 𝔸) (hd : differentiable_within_at 𝕜 d s x) : - deriv_within (λ y, c * d y) s x = c * deriv_within d s x := -(hd.has_deriv_within_at.const_mul c).deriv_within hxs - -lemma deriv_const_mul (c : 𝔸) (hd : differentiable_at 𝕜 d x) : - deriv (λ y, c * d y) x = c * deriv d x := -(hd.has_deriv_at.const_mul c).deriv - -lemma deriv_const_mul_field (u : 𝕜') : deriv (λ y, u * v y) x = u * deriv v x := -by simp only [mul_comm u, deriv_mul_const_field] - -@[simp] lemma deriv_const_mul_field' (u : 𝕜') : deriv (λ x, u * v x) = λ x, u * deriv v x := -funext (λ x, deriv_const_mul_field u) - -end mul - -section inverse -/-! ### Derivative of `x ↦ x⁻¹` -/ - -theorem has_strict_deriv_at_inv (hx : x ≠ 0) : has_strict_deriv_at has_inv.inv (-(x^2)⁻¹) x := -begin - suffices : is_o (λ p : 𝕜 × 𝕜, (p.1 - p.2) * ((x * x)⁻¹ - (p.1 * p.2)⁻¹)) - (λ (p : 𝕜 × 𝕜), (p.1 - p.2) * 1) (𝓝 (x, x)), - { refine this.congr' _ (eventually_of_forall $ λ _, mul_one _), - refine eventually.mono (is_open.mem_nhds (is_open_ne.prod is_open_ne) ⟨hx, hx⟩) _, - rintro ⟨y, z⟩ ⟨hy, hz⟩, - simp only [mem_set_of_eq] at hy hz, -- hy : y ≠ 0, hz : z ≠ 0 - field_simp [hx, hy, hz], ring, }, - refine (is_O_refl (λ p : 𝕜 × 𝕜, p.1 - p.2) _).mul_is_o ((is_o_one_iff _).2 _), - rw [← sub_self (x * x)⁻¹], - exact tendsto_const_nhds.sub ((continuous_mul.tendsto (x, x)).inv₀ $ mul_ne_zero hx hx) -end - -theorem has_deriv_at_inv (x_ne_zero : x ≠ 0) : - has_deriv_at (λy, y⁻¹) (-(x^2)⁻¹) x := -(has_strict_deriv_at_inv x_ne_zero).has_deriv_at - -theorem has_deriv_within_at_inv (x_ne_zero : x ≠ 0) (s : set 𝕜) : - has_deriv_within_at (λx, x⁻¹) (-(x^2)⁻¹) s x := -(has_deriv_at_inv x_ne_zero).has_deriv_within_at - -lemma differentiable_at_inv : - differentiable_at 𝕜 (λx, x⁻¹) x ↔ x ≠ 0:= -⟨λ H, normed_field.continuous_at_inv.1 H.continuous_at, - λ H, (has_deriv_at_inv H).differentiable_at⟩ - -lemma differentiable_within_at_inv (x_ne_zero : x ≠ 0) : - differentiable_within_at 𝕜 (λx, x⁻¹) s x := -(differentiable_at_inv.2 x_ne_zero).differentiable_within_at - -lemma differentiable_on_inv : differentiable_on 𝕜 (λx:𝕜, x⁻¹) {x | x ≠ 0} := -λx hx, differentiable_within_at_inv hx - -lemma deriv_inv : deriv (λx, x⁻¹) x = -(x^2)⁻¹ := -begin - rcases eq_or_ne x 0 with rfl|hne, - { simp [deriv_zero_of_not_differentiable_at (mt differentiable_at_inv.1 (not_not.2 rfl))] }, - { exact (has_deriv_at_inv hne).deriv } -end - -@[simp] lemma deriv_inv' : deriv (λ x : 𝕜, x⁻¹) = λ x, -(x ^ 2)⁻¹ := funext (λ x, deriv_inv) - -lemma deriv_within_inv (x_ne_zero : x ≠ 0) (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, x⁻¹) s x = -(x^2)⁻¹ := -begin - rw differentiable_at.deriv_within (differentiable_at_inv.2 x_ne_zero) hxs, - exact deriv_inv -end - -lemma has_fderiv_at_inv (x_ne_zero : x ≠ 0) : - has_fderiv_at (λx, x⁻¹) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) : 𝕜 →L[𝕜] 𝕜) x := -has_deriv_at_inv x_ne_zero - -lemma has_fderiv_within_at_inv (x_ne_zero : x ≠ 0) : - has_fderiv_within_at (λx, x⁻¹) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) : 𝕜 →L[𝕜] 𝕜) s x := -(has_fderiv_at_inv x_ne_zero).has_fderiv_within_at - -lemma fderiv_inv : - fderiv 𝕜 (λx, x⁻¹) x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) := -by rw [← deriv_fderiv, deriv_inv] - -lemma fderiv_within_inv (x_ne_zero : x ≠ 0) (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λx, x⁻¹) s x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) := -begin - rw differentiable_at.fderiv_within (differentiable_at_inv.2 x_ne_zero) hxs, - exact fderiv_inv -end - -variables {c : 𝕜 → 𝕜} {c' : 𝕜} - -lemma has_deriv_within_at.inv - (hc : has_deriv_within_at c c' s x) (hx : c x ≠ 0) : - has_deriv_within_at (λ y, (c y)⁻¹) (- c' / (c x)^2) s x := -begin - convert (has_deriv_at_inv hx).comp_has_deriv_within_at x hc, - field_simp -end - -lemma has_deriv_at.inv (hc : has_deriv_at c c' x) (hx : c x ≠ 0) : - has_deriv_at (λ y, (c y)⁻¹) (- c' / (c x)^2) x := -begin - rw ← has_deriv_within_at_univ at *, - exact hc.inv hx -end - -lemma differentiable_within_at.inv (hc : differentiable_within_at 𝕜 c s x) (hx : c x ≠ 0) : - differentiable_within_at 𝕜 (λx, (c x)⁻¹) s x := -(hc.has_deriv_within_at.inv hx).differentiable_within_at - -@[simp] lemma differentiable_at.inv (hc : differentiable_at 𝕜 c x) (hx : c x ≠ 0) : - differentiable_at 𝕜 (λx, (c x)⁻¹) x := -(hc.has_deriv_at.inv hx).differentiable_at - -lemma differentiable_on.inv (hc : differentiable_on 𝕜 c s) (hx : ∀ x ∈ s, c x ≠ 0) : - differentiable_on 𝕜 (λx, (c x)⁻¹) s := -λx h, (hc x h).inv (hx x h) - -@[simp] lemma differentiable.inv (hc : differentiable 𝕜 c) (hx : ∀ x, c x ≠ 0) : - differentiable 𝕜 (λx, (c x)⁻¹) := -λx, (hc x).inv (hx x) - -lemma deriv_within_inv' (hc : differentiable_within_at 𝕜 c s x) (hx : c x ≠ 0) - (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, (c x)⁻¹) s x = - (deriv_within c s x) / (c x)^2 := -(hc.has_deriv_within_at.inv hx).deriv_within hxs - -@[simp] lemma deriv_inv'' (hc : differentiable_at 𝕜 c x) (hx : c x ≠ 0) : - deriv (λx, (c x)⁻¹) x = - (deriv c x) / (c x)^2 := -(hc.has_deriv_at.inv hx).deriv - -end inverse - -section division -/-! ### Derivative of `x ↦ c x / d x` -/ - -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] - {c d : 𝕜 → 𝕜'} {c' d' : 𝕜'} - -lemma has_deriv_within_at.div - (hc : has_deriv_within_at c c' s x) (hd : has_deriv_within_at d d' s x) (hx : d x ≠ 0) : - has_deriv_within_at (λ y, c y / d y) ((c' * d x - c x * d') / (d x)^2) s x := -begin - convert hc.mul ((has_deriv_at_inv hx).comp_has_deriv_within_at x hd), - { simp only [div_eq_mul_inv] }, - { field_simp, ring } -end - -lemma has_strict_deriv_at.div (hc : has_strict_deriv_at c c' x) (hd : has_strict_deriv_at d d' x) - (hx : d x ≠ 0) : - has_strict_deriv_at (λ y, c y / d y) ((c' * d x - c x * d') / (d x)^2) x := -begin - convert hc.mul ((has_strict_deriv_at_inv hx).comp x hd), - { simp only [div_eq_mul_inv] }, - { field_simp, ring } -end - -lemma has_deriv_at.div (hc : has_deriv_at c c' x) (hd : has_deriv_at d d' x) (hx : d x ≠ 0) : - has_deriv_at (λ y, c y / d y) ((c' * d x - c x * d') / (d x)^2) x := -begin - rw ← has_deriv_within_at_univ at *, - exact hc.div hd hx -end - -lemma differentiable_within_at.div - (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) (hx : d x ≠ 0) : - differentiable_within_at 𝕜 (λx, c x / d x) s x := -((hc.has_deriv_within_at).div (hd.has_deriv_within_at) hx).differentiable_within_at - -@[simp] lemma differentiable_at.div - (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) (hx : d x ≠ 0) : - differentiable_at 𝕜 (λx, c x / d x) x := -((hc.has_deriv_at).div (hd.has_deriv_at) hx).differentiable_at - -lemma differentiable_on.div - (hc : differentiable_on 𝕜 c s) (hd : differentiable_on 𝕜 d s) (hx : ∀ x ∈ s, d x ≠ 0) : - differentiable_on 𝕜 (λx, c x / d x) s := -λx h, (hc x h).div (hd x h) (hx x h) - -@[simp] lemma differentiable.div - (hc : differentiable 𝕜 c) (hd : differentiable 𝕜 d) (hx : ∀ x, d x ≠ 0) : -differentiable 𝕜 (λx, c x / d x) := -λx, (hc x).div (hd x) (hx x) - -lemma deriv_within_div - (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) (hx : d x ≠ 0) - (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, c x / d x) s x - = ((deriv_within c s x) * d x - c x * (deriv_within d s x)) / (d x)^2 := -((hc.has_deriv_within_at).div (hd.has_deriv_within_at) hx).deriv_within hxs - -@[simp] lemma deriv_div - (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) (hx : d x ≠ 0) : - deriv (λx, c x / d x) x = ((deriv c x) * d x - c x * (deriv d x)) / (d x)^2 := -((hc.has_deriv_at).div (hd.has_deriv_at) hx).deriv - -lemma has_deriv_at.div_const (hc : has_deriv_at c c' x) (d : 𝕜') : - has_deriv_at (λ x, c x / d) (c' / d) x := -by simpa only [div_eq_mul_inv] using hc.mul_const d⁻¹ - -lemma has_deriv_within_at.div_const (hc : has_deriv_within_at c c' s x) (d : 𝕜') : - has_deriv_within_at (λ x, c x / d) (c' / d) s x := -by simpa only [div_eq_mul_inv] using hc.mul_const d⁻¹ - -lemma has_strict_deriv_at.div_const (hc : has_strict_deriv_at c c' x) (d : 𝕜') : - has_strict_deriv_at (λ x, c x / d) (c' / d) x := -by simpa only [div_eq_mul_inv] using hc.mul_const d⁻¹ - -lemma differentiable_within_at.div_const (hc : differentiable_within_at 𝕜 c s x) {d : 𝕜'} : - differentiable_within_at 𝕜 (λx, c x / d) s x := -(hc.has_deriv_within_at.div_const _).differentiable_within_at - -@[simp] lemma differentiable_at.div_const (hc : differentiable_at 𝕜 c x) {d : 𝕜'} : - differentiable_at 𝕜 (λ x, c x / d) x := -(hc.has_deriv_at.div_const _).differentiable_at - -lemma differentiable_on.div_const (hc : differentiable_on 𝕜 c s) {d : 𝕜'} : - differentiable_on 𝕜 (λx, c x / d) s := -λ x hx, (hc x hx).div_const - -@[simp] lemma differentiable.div_const (hc : differentiable 𝕜 c) {d : 𝕜'} : - differentiable 𝕜 (λx, c x / d) := -λ x, (hc x).div_const - -lemma deriv_within_div_const (hc : differentiable_within_at 𝕜 c s x) {d : 𝕜'} - (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, c x / d) s x = (deriv_within c s x) / d := -by simp [div_eq_inv_mul, deriv_within_const_mul, hc, hxs] - -@[simp] lemma deriv_div_const (d : 𝕜') : - deriv (λx, c x / d) x = (deriv c x) / d := -by simp only [div_eq_mul_inv, deriv_mul_const_field] - -end division - -section clm_comp_apply -/-! ### Derivative of the pointwise composition/application of continuous linear maps -/ - -open continuous_linear_map - -variables {G : Type*} [normed_group G] [normed_space 𝕜 G] {c : 𝕜 → F →L[𝕜] G} {c' : F →L[𝕜] G} - {d : 𝕜 → E →L[𝕜] F} {d' : E →L[𝕜] F} {u : 𝕜 → F} {u' : F} - -lemma has_strict_deriv_at.clm_comp (hc : has_strict_deriv_at c c' x) - (hd : has_strict_deriv_at d d' x) : - has_strict_deriv_at (λ y, (c y).comp (d y)) (c'.comp (d x) + (c x).comp d') x := -begin - have := (hc.has_strict_fderiv_at.clm_comp hd.has_strict_fderiv_at).has_strict_deriv_at, - rwa [add_apply, comp_apply, comp_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, - one_smul, add_comm] at this, -end - -lemma has_deriv_within_at.clm_comp (hc : has_deriv_within_at c c' s x) - (hd : has_deriv_within_at d d' s x) : - has_deriv_within_at (λ y, (c y).comp (d y)) (c'.comp (d x) + (c x).comp d') s x := -begin - have := (hc.has_fderiv_within_at.clm_comp hd.has_fderiv_within_at).has_deriv_within_at, - rwa [add_apply, comp_apply, comp_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, - one_smul, add_comm] at this, -end - -lemma has_deriv_at.clm_comp (hc : has_deriv_at c c' x) (hd : has_deriv_at d d' x) : - has_deriv_at (λ y, (c y).comp (d y)) - (c'.comp (d x) + (c x).comp d') x := -begin - rw [← has_deriv_within_at_univ] at *, - exact hc.clm_comp hd -end - -lemma deriv_within_clm_comp (hc : differentiable_within_at 𝕜 c s x) - (hd : differentiable_within_at 𝕜 d s x) (hxs : unique_diff_within_at 𝕜 s x): - deriv_within (λ y, (c y).comp (d y)) s x = - ((deriv_within c s x).comp (d x) + (c x).comp (deriv_within d s x)) := -(hc.has_deriv_within_at.clm_comp hd.has_deriv_within_at).deriv_within hxs - -lemma deriv_clm_comp (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : - deriv (λ y, (c y).comp (d y)) x = - ((deriv c x).comp (d x) + (c x).comp (deriv d x)) := -(hc.has_deriv_at.clm_comp hd.has_deriv_at).deriv - -lemma has_strict_deriv_at.clm_apply (hc : has_strict_deriv_at c c' x) - (hu : has_strict_deriv_at u u' x) : - has_strict_deriv_at (λ y, (c y) (u y)) (c' (u x) + c x u') x := -begin - have := (hc.has_strict_fderiv_at.clm_apply hu.has_strict_fderiv_at).has_strict_deriv_at, - rwa [add_apply, comp_apply, flip_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, - one_smul, add_comm] at this, -end - -lemma has_deriv_within_at.clm_apply (hc : has_deriv_within_at c c' s x) - (hu : has_deriv_within_at u u' s x) : - has_deriv_within_at (λ y, (c y) (u y)) (c' (u x) + c x u') s x := -begin - have := (hc.has_fderiv_within_at.clm_apply hu.has_fderiv_within_at).has_deriv_within_at, - rwa [add_apply, comp_apply, flip_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, - one_smul, add_comm] at this, -end - -lemma has_deriv_at.clm_apply (hc : has_deriv_at c c' x) (hu : has_deriv_at u u' x) : - has_deriv_at (λ y, (c y) (u y)) (c' (u x) + c x u') x := -begin - have := (hc.has_fderiv_at.clm_apply hu.has_fderiv_at).has_deriv_at, - rwa [add_apply, comp_apply, flip_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, - one_smul, add_comm] at this, -end - -lemma deriv_within_clm_apply (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hu : differentiable_within_at 𝕜 u s x) : - deriv_within (λ y, (c y) (u y)) s x = (deriv_within c s x (u x) + c x (deriv_within u s x)) := -(hc.has_deriv_within_at.clm_apply hu.has_deriv_within_at).deriv_within hxs - -lemma deriv_clm_apply (hc : differentiable_at 𝕜 c x) (hu : differentiable_at 𝕜 u x) : - deriv (λ y, (c y) (u y)) x = (deriv c x (u x) + c x (deriv u x)) := -(hc.has_deriv_at.clm_apply hu.has_deriv_at).deriv - -end clm_comp_apply - -theorem has_strict_deriv_at.has_strict_fderiv_at_equiv {f : 𝕜 → 𝕜} {f' x : 𝕜} - (hf : has_strict_deriv_at f f' x) (hf' : f' ≠ 0) : - has_strict_fderiv_at f - (continuous_linear_equiv.units_equiv_aut 𝕜 (units.mk0 f' hf') : 𝕜 →L[𝕜] 𝕜) x := -hf - -theorem has_deriv_at.has_fderiv_at_equiv {f : 𝕜 → 𝕜} {f' x : 𝕜} (hf : has_deriv_at f f' x) - (hf' : f' ≠ 0) : - has_fderiv_at f (continuous_linear_equiv.units_equiv_aut 𝕜 (units.mk0 f' hf') : 𝕜 →L[𝕜] 𝕜) x := -hf - -/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an -invertible derivative `f'` at `g a` in the strict sense, then `g` has the derivative `f'⁻¹` at `a` -in the strict sense. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have an -inverse function. -/ -theorem has_strict_deriv_at.of_local_left_inverse {f g : 𝕜 → 𝕜} {f' a : 𝕜} - (hg : continuous_at g a) (hf : has_strict_deriv_at f f' (g a)) (hf' : f' ≠ 0) - (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : - has_strict_deriv_at g f'⁻¹ a := -(hf.has_strict_fderiv_at_equiv hf').of_local_left_inverse hg hfg - -/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has a -nonzero derivative `f'` at `f.symm a` in the strict sense, then `f.symm` has the derivative `f'⁻¹` -at `a` in the strict sense. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have -an inverse function. -/ -lemma local_homeomorph.has_strict_deriv_at_symm (f : local_homeomorph 𝕜 𝕜) {a f' : 𝕜} - (ha : a ∈ f.target) (hf' : f' ≠ 0) (htff' : has_strict_deriv_at f f' (f.symm a)) : - has_strict_deriv_at f.symm f'⁻¹ a := -htff'.of_local_left_inverse (f.symm.continuous_at ha) hf' (f.eventually_right_inverse ha) - -/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an -invertible derivative `f'` at `g a`, then `g` has the derivative `f'⁻¹` at `a`. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have -an inverse function. -/ -theorem has_deriv_at.of_local_left_inverse {f g : 𝕜 → 𝕜} {f' a : 𝕜} - (hg : continuous_at g a) (hf : has_deriv_at f f' (g a)) (hf' : f' ≠ 0) - (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : - has_deriv_at g f'⁻¹ a := -(hf.has_fderiv_at_equiv hf').of_local_left_inverse hg hfg - -/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has an -nonzero derivative `f'` at `f.symm a`, then `f.symm` has the derivative `f'⁻¹` at `a`. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have -an inverse function. -/ -lemma local_homeomorph.has_deriv_at_symm (f : local_homeomorph 𝕜 𝕜) {a f' : 𝕜} - (ha : a ∈ f.target) (hf' : f' ≠ 0) (htff' : has_deriv_at f f' (f.symm a)) : - has_deriv_at f.symm f'⁻¹ a := -htff'.of_local_left_inverse (f.symm.continuous_at ha) hf' (f.eventually_right_inverse ha) - -lemma has_deriv_at.eventually_ne (h : has_deriv_at f f' x) (hf' : f' ≠ 0) : - ∀ᶠ z in 𝓝[≠] x, f z ≠ f x := -(has_deriv_at_iff_has_fderiv_at.1 h).eventually_ne - ⟨∥f'∥⁻¹, λ z, by field_simp [norm_smul, mt norm_eq_zero.1 hf']⟩ - -lemma has_deriv_at.tendsto_punctured_nhds (h : has_deriv_at f f' x) (hf' : f' ≠ 0) : - tendsto f (𝓝[≠] x) (𝓝[≠] (f x)) := -tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ - h.continuous_at.continuous_within_at (h.eventually_ne hf') - -theorem not_differentiable_within_at_of_local_left_inverse_has_deriv_within_at_zero - {f g : 𝕜 → 𝕜} {a : 𝕜} {s t : set 𝕜} (ha : a ∈ s) (hsu : unique_diff_within_at 𝕜 s a) - (hf : has_deriv_within_at f 0 t (g a)) (hst : maps_to g s t) (hfg : f ∘ g =ᶠ[𝓝[s] a] id) : - ¬differentiable_within_at 𝕜 g s a := -begin - intro hg, - have := (hf.comp a hg.has_deriv_within_at hst).congr_of_eventually_eq_of_mem hfg.symm ha, - simpa using hsu.eq_deriv _ this (has_deriv_within_at_id _ _) -end - -theorem not_differentiable_at_of_local_left_inverse_has_deriv_at_zero - {f g : 𝕜 → 𝕜} {a : 𝕜} (hf : has_deriv_at f 0 (g a)) (hfg : f ∘ g =ᶠ[𝓝 a] id) : - ¬differentiable_at 𝕜 g a := -begin - intro hg, - have := (hf.comp a hg.has_deriv_at).congr_of_eventually_eq hfg.symm, - simpa using this.unique (has_deriv_at_id a) -end - -end - -namespace polynomial -/-! ### Derivative of a polynomial -/ - -variables {x : 𝕜} {s : set 𝕜} -variable (p : 𝕜[X]) - -/-- The derivative (in the analysis sense) of a polynomial `p` is given by `p.derivative`. -/ -protected lemma has_strict_deriv_at (x : 𝕜) : - has_strict_deriv_at (λx, p.eval x) (p.derivative.eval x) x := -begin - apply p.induction_on, - { simp [has_strict_deriv_at_const] }, - { assume p q hp hq, - convert hp.add hq; - simp }, - { assume n a h, - convert h.mul (has_strict_deriv_at_id x), - { ext y, simp [pow_add, mul_assoc] }, - { simp [pow_add], ring } } -end - -/-- The derivative (in the analysis sense) of a polynomial `p` is given by `p.derivative`. -/ -protected lemma has_deriv_at (x : 𝕜) : has_deriv_at (λx, p.eval x) (p.derivative.eval x) x := -(p.has_strict_deriv_at x).has_deriv_at - -protected theorem has_deriv_within_at (x : 𝕜) (s : set 𝕜) : - has_deriv_within_at (λx, p.eval x) (p.derivative.eval x) s x := -(p.has_deriv_at x).has_deriv_within_at - -protected lemma differentiable_at : differentiable_at 𝕜 (λx, p.eval x) x := -(p.has_deriv_at x).differentiable_at - -protected lemma differentiable_within_at : differentiable_within_at 𝕜 (λx, p.eval x) s x := -p.differentiable_at.differentiable_within_at - -protected lemma differentiable : differentiable 𝕜 (λx, p.eval x) := -λx, p.differentiable_at - -protected lemma differentiable_on : differentiable_on 𝕜 (λx, p.eval x) s := -p.differentiable.differentiable_on - -@[simp] protected lemma deriv : deriv (λx, p.eval x) x = p.derivative.eval x := -(p.has_deriv_at x).deriv - -protected lemma deriv_within (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, p.eval x) s x = p.derivative.eval x := -begin - rw differentiable_at.deriv_within p.differentiable_at hxs, - exact p.deriv -end - -protected lemma has_fderiv_at (x : 𝕜) : - has_fderiv_at (λx, p.eval x) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x)) x := -p.has_deriv_at x - -protected lemma has_fderiv_within_at (x : 𝕜) : - has_fderiv_within_at (λx, p.eval x) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x)) s x := -(p.has_fderiv_at x).has_fderiv_within_at - -@[simp] protected lemma fderiv : - fderiv 𝕜 (λx, p.eval x) x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x) := -(p.has_fderiv_at x).fderiv - -protected lemma fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λx, p.eval x) s x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x) := -(p.has_fderiv_within_at x).fderiv_within hxs - -end polynomial - -section pow -/-! ### Derivative of `x ↦ x^n` for `n : ℕ` -/ -variables {x : 𝕜} {s : set 𝕜} {c : 𝕜 → 𝕜} {c' : 𝕜} -variable {n : ℕ } - -lemma has_strict_deriv_at_pow (n : ℕ) (x : 𝕜) : - has_strict_deriv_at (λx, x^n) ((n : 𝕜) * x^(n-1)) x := -begin - convert (polynomial.C (1 : 𝕜) * (polynomial.X)^n).has_strict_deriv_at x, - { simp }, - { rw [polynomial.derivative_C_mul_X_pow], simp } -end - -lemma has_deriv_at_pow (n : ℕ) (x : 𝕜) : has_deriv_at (λx, x^n) ((n : 𝕜) * x^(n-1)) x := -(has_strict_deriv_at_pow n x).has_deriv_at - -theorem has_deriv_within_at_pow (n : ℕ) (x : 𝕜) (s : set 𝕜) : - has_deriv_within_at (λx, x^n) ((n : 𝕜) * x^(n-1)) s x := -(has_deriv_at_pow n x).has_deriv_within_at - -lemma differentiable_at_pow : differentiable_at 𝕜 (λx, x^n) x := -(has_deriv_at_pow n x).differentiable_at - -lemma differentiable_within_at_pow : differentiable_within_at 𝕜 (λx, x^n) s x := -differentiable_at_pow.differentiable_within_at - -lemma differentiable_pow : differentiable 𝕜 (λx:𝕜, x^n) := -λx, differentiable_at_pow - -lemma differentiable_on_pow : differentiable_on 𝕜 (λx, x^n) s := -differentiable_pow.differentiable_on - -lemma deriv_pow : deriv (λx, x^n) x = (n : 𝕜) * x^(n-1) := -(has_deriv_at_pow n x).deriv - -@[simp] lemma deriv_pow' : deriv (λx, x^n) = λ x, (n : 𝕜) * x^(n-1) := -funext $ λ x, deriv_pow - -lemma deriv_within_pow (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, x^n) s x = (n : 𝕜) * x^(n-1) := -(has_deriv_within_at_pow n x s).deriv_within hxs - -lemma has_deriv_within_at.pow (hc : has_deriv_within_at c c' s x) : - has_deriv_within_at (λ y, (c y)^n) ((n : 𝕜) * (c x)^(n-1) * c') s x := -(has_deriv_at_pow n (c x)).comp_has_deriv_within_at x hc - -lemma has_deriv_at.pow (hc : has_deriv_at c c' x) : - has_deriv_at (λ y, (c y)^n) ((n : 𝕜) * (c x)^(n-1) * c') x := -by { rw ← has_deriv_within_at_univ at *, exact hc.pow } - -lemma differentiable_within_at.pow (hc : differentiable_within_at 𝕜 c s x) : - differentiable_within_at 𝕜 (λx, (c x)^n) s x := -hc.has_deriv_within_at.pow.differentiable_within_at - -@[simp] lemma differentiable_at.pow (hc : differentiable_at 𝕜 c x) : - differentiable_at 𝕜 (λx, (c x)^n) x := -hc.has_deriv_at.pow.differentiable_at - -lemma differentiable_on.pow (hc : differentiable_on 𝕜 c s) : - differentiable_on 𝕜 (λx, (c x)^n) s := -λx h, (hc x h).pow - -@[simp] lemma differentiable.pow (hc : differentiable 𝕜 c) : - differentiable 𝕜 (λx, (c x)^n) := -λx, (hc x).pow - -lemma deriv_within_pow' (hc : differentiable_within_at 𝕜 c s x) - (hxs : unique_diff_within_at 𝕜 s x) : - deriv_within (λx, (c x)^n) s x = (n : 𝕜) * (c x)^(n-1) * (deriv_within c s x) := -hc.has_deriv_within_at.pow.deriv_within hxs - -@[simp] lemma deriv_pow'' (hc : differentiable_at 𝕜 c x) : - deriv (λx, (c x)^n) x = (n : 𝕜) * (c x)^(n-1) * (deriv c x) := -hc.has_deriv_at.pow.deriv - -end pow - -section zpow -/-! ### Derivative of `x ↦ x^m` for `m : ℤ` -/ -variables {x : 𝕜} {s : set 𝕜} {m : ℤ} - -lemma has_strict_deriv_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) : - has_strict_deriv_at (λx, x^m) ((m : 𝕜) * x^(m-1)) x := -begin - have : ∀ m : ℤ, 0 < m → has_strict_deriv_at (λx, x^m) ((m:𝕜) * x^(m-1)) x, - { assume m hm, - lift m to ℕ using (le_of_lt hm), - simp only [zpow_coe_nat, int.cast_coe_nat], - convert has_strict_deriv_at_pow _ _ using 2, - rw [← int.coe_nat_one, ← int.coe_nat_sub, zpow_coe_nat], - norm_cast at hm, - exact nat.succ_le_of_lt hm }, - rcases lt_trichotomy m 0 with hm|hm|hm, - { have hx : x ≠ 0, from h.resolve_right hm.not_le, - have := (has_strict_deriv_at_inv _).scomp _ (this (-m) (neg_pos.2 hm)); - [skip, exact zpow_ne_zero_of_ne_zero hx _], - simp only [(∘), zpow_neg₀, one_div, inv_inv, smul_eq_mul] at this, - convert this using 1, - rw [sq, mul_inv₀, inv_inv, int.cast_neg, neg_mul, neg_mul_neg, - ← zpow_add₀ hx, mul_assoc, ← zpow_add₀ hx], congr, abel }, - { simp only [hm, zpow_zero, int.cast_zero, zero_mul, has_strict_deriv_at_const] }, - { exact this m hm } -end - -lemma has_deriv_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) : - has_deriv_at (λx, x^m) ((m : 𝕜) * x^(m-1)) x := -(has_strict_deriv_at_zpow m x h).has_deriv_at - -theorem has_deriv_within_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) (s : set 𝕜) : - has_deriv_within_at (λx, x^m) ((m : 𝕜) * x^(m-1)) s x := -(has_deriv_at_zpow m x h).has_deriv_within_at - -lemma differentiable_at_zpow : differentiable_at 𝕜 (λx, x^m) x ↔ x ≠ 0 ∨ 0 ≤ m := -⟨λ H, normed_field.continuous_at_zpow.1 H.continuous_at, - λ H, (has_deriv_at_zpow m x H).differentiable_at⟩ - -lemma differentiable_within_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) : - differentiable_within_at 𝕜 (λx, x^m) s x := -(differentiable_at_zpow.mpr h).differentiable_within_at - -lemma differentiable_on_zpow (m : ℤ) (s : set 𝕜) (h : (0 : 𝕜) ∉ s ∨ 0 ≤ m) : - differentiable_on 𝕜 (λx, x^m) s := -λ x hxs, differentiable_within_at_zpow m x $ h.imp_left $ ne_of_mem_of_not_mem hxs - -lemma deriv_zpow (m : ℤ) (x : 𝕜) : deriv (λ x, x ^ m) x = m * x ^ (m - 1) := -begin - by_cases H : x ≠ 0 ∨ 0 ≤ m, - { exact (has_deriv_at_zpow m x H).deriv }, - { rw deriv_zero_of_not_differentiable_at (mt differentiable_at_zpow.1 H), - push_neg at H, rcases H with ⟨rfl, hm⟩, - rw [zero_zpow _ ((sub_one_lt _).trans hm).ne, mul_zero] } -end - -@[simp] lemma deriv_zpow' (m : ℤ) : deriv (λ x : 𝕜, x ^ m) = λ x, m * x ^ (m - 1) := -funext $ deriv_zpow m - -lemma deriv_within_zpow (hxs : unique_diff_within_at 𝕜 s x) (h : x ≠ 0 ∨ 0 ≤ m) : - deriv_within (λx, x^m) s x = (m : 𝕜) * x^(m-1) := -(has_deriv_within_at_zpow m x h s).deriv_within hxs - -@[simp] lemma iter_deriv_zpow' (m : ℤ) (k : ℕ) : - deriv^[k] (λ x : 𝕜, x ^ m) = λ x, (∏ i in finset.range k, (m - i)) * x ^ (m - k) := -begin - induction k with k ihk, - { simp only [one_mul, int.coe_nat_zero, id, sub_zero, finset.prod_range_zero, - function.iterate_zero] }, - { simp only [function.iterate_succ_apply', ihk, deriv_const_mul_field', deriv_zpow', - finset.prod_range_succ, int.coe_nat_succ, ← sub_sub, int.cast_sub, int.cast_coe_nat, - mul_assoc], } -end - -lemma iter_deriv_zpow (m : ℤ) (x : 𝕜) (k : ℕ) : - deriv^[k] (λ y, y ^ m) x = (∏ i in finset.range k, (m - i)) * x ^ (m - k) := -congr_fun (iter_deriv_zpow' m k) x - -lemma iter_deriv_pow (n : ℕ) (x : 𝕜) (k : ℕ) : - deriv^[k] (λx:𝕜, x^n) x = (∏ i in finset.range k, (n - i)) * x^(n-k) := -begin - simp only [← zpow_coe_nat, iter_deriv_zpow, int.cast_coe_nat], - cases le_or_lt k n with hkn hnk, - { rw int.coe_nat_sub hkn }, - { have : ∏ i in finset.range k, (n - i : 𝕜) = 0, - from finset.prod_eq_zero (finset.mem_range.2 hnk) (sub_self _), - simp only [this, zero_mul] } -end - -@[simp] lemma iter_deriv_pow' (n k : ℕ) : - deriv^[k] (λ x : 𝕜, x ^ n) = λ x, (∏ i in finset.range k, (n - i)) * x ^ (n - k) := -funext $ λ x, iter_deriv_pow n x k - -lemma iter_deriv_inv (k : ℕ) (x : 𝕜) : - deriv^[k] has_inv.inv x = (∏ i in finset.range k, (-1 - i)) * x ^ (-1 - k : ℤ) := -by simpa only [zpow_neg_one, int.cast_neg, int.cast_one] using iter_deriv_zpow (-1) x k - -@[simp] lemma iter_deriv_inv' (k : ℕ) : - deriv^[k] has_inv.inv = λ x : 𝕜, (∏ i in finset.range k, (-1 - i)) * x ^ (-1 - k : ℤ) := -funext (iter_deriv_inv k) - -end zpow - -/-! ### Support of derivatives -/ - -section support - -open function -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] {f : 𝕜 → F} - -lemma support_deriv_subset : support (deriv f) ⊆ tsupport f := -begin - intros x, - rw [← not_imp_not], - intro h2x, - rw [not_mem_closure_support_iff_eventually_eq] at h2x, - exact nmem_support.mpr (h2x.deriv_eq.trans (deriv_const x 0)) -end - -lemma has_compact_support.deriv (hf : has_compact_support f) : has_compact_support (deriv f) := -hf.mono' support_deriv_subset - -end support - -/-! ### Upper estimates on liminf and limsup -/ - -section real - -variables {f : ℝ → ℝ} {f' : ℝ} {s : set ℝ} {x : ℝ} {r : ℝ} - -lemma has_deriv_within_at.limsup_slope_le (hf : has_deriv_within_at f f' s x) (hr : f' < r) : - ∀ᶠ z in 𝓝[s \ {x}] x, slope f x z < r := -has_deriv_within_at_iff_tendsto_slope.1 hf (is_open.mem_nhds is_open_Iio hr) - -lemma has_deriv_within_at.limsup_slope_le' (hf : has_deriv_within_at f f' s x) - (hs : x ∉ s) (hr : f' < r) : - ∀ᶠ z in 𝓝[s] x, slope f x z < r := -(has_deriv_within_at_iff_tendsto_slope' hs).1 hf (is_open.mem_nhds is_open_Iio hr) - -lemma has_deriv_within_at.liminf_right_slope_le - (hf : has_deriv_within_at f f' (Ici x) x) (hr : f' < r) : - ∃ᶠ z in 𝓝[>] x, slope f x z < r := -(hf.Ioi_of_Ici.limsup_slope_le' (lt_irrefl x) hr).frequently - -end real - -section real_space - -open metric - -variables {E : Type u} [normed_group E] [normed_space ℝ E] {f : ℝ → E} {f' : E} {s : set ℝ} - {x r : ℝ} - -/-- If `f` has derivative `f'` within `s` at `x`, then for any `r > ∥f'∥` the ratio -`∥f z - f x∥ / ∥z - x∥` is less than `r` in some neighborhood of `x` within `s`. -In other words, the limit superior of this ratio as `z` tends to `x` along `s` -is less than or equal to `∥f'∥`. -/ -lemma has_deriv_within_at.limsup_norm_slope_le - (hf : has_deriv_within_at f f' s x) (hr : ∥f'∥ < r) : - ∀ᶠ z in 𝓝[s] x, ∥z - x∥⁻¹ * ∥f z - f x∥ < r := -begin - have hr₀ : 0 < r, from lt_of_le_of_lt (norm_nonneg f') hr, - have A : ∀ᶠ z in 𝓝[s \ {x}] x, ∥(z - x)⁻¹ • (f z - f x)∥ ∈ Iio r, - from (has_deriv_within_at_iff_tendsto_slope.1 hf).norm (is_open.mem_nhds is_open_Iio hr), - have B : ∀ᶠ z in 𝓝[{x}] x, ∥(z - x)⁻¹ • (f z - f x)∥ ∈ Iio r, - from mem_of_superset self_mem_nhds_within - (singleton_subset_iff.2 $ by simp [hr₀]), - have C := mem_sup.2 ⟨A, B⟩, - rw [← nhds_within_union, diff_union_self, nhds_within_union, mem_sup] at C, - filter_upwards [C.1], - simp only [norm_smul, mem_Iio, norm_inv], - exact λ _, id -end - -/-- If `f` has derivative `f'` within `s` at `x`, then for any `r > ∥f'∥` the ratio -`(∥f z∥ - ∥f x∥) / ∥z - x∥` is less than `r` in some neighborhood of `x` within `s`. -In other words, the limit superior of this ratio as `z` tends to `x` along `s` -is less than or equal to `∥f'∥`. - -This lemma is a weaker version of `has_deriv_within_at.limsup_norm_slope_le` -where `∥f z∥ - ∥f x∥` is replaced by `∥f z - f x∥`. -/ -lemma has_deriv_within_at.limsup_slope_norm_le - (hf : has_deriv_within_at f f' s x) (hr : ∥f'∥ < r) : - ∀ᶠ z in 𝓝[s] x, ∥z - x∥⁻¹ * (∥f z∥ - ∥f x∥) < r := -begin - apply (hf.limsup_norm_slope_le hr).mono, - assume z hz, - refine lt_of_le_of_lt (mul_le_mul_of_nonneg_left (norm_sub_norm_le _ _) _) hz, - exact inv_nonneg.2 (norm_nonneg _) -end - -/-- If `f` has derivative `f'` within `(x, +∞)` at `x`, then for any `r > ∥f'∥` the ratio -`∥f z - f x∥ / ∥z - x∥` is frequently less than `r` as `z → x+0`. -In other words, the limit inferior of this ratio as `z` tends to `x+0` -is less than or equal to `∥f'∥`. See also `has_deriv_within_at.limsup_norm_slope_le` -for a stronger version using limit superior and any set `s`. -/ -lemma has_deriv_within_at.liminf_right_norm_slope_le - (hf : has_deriv_within_at f f' (Ici x) x) (hr : ∥f'∥ < r) : - ∃ᶠ z in 𝓝[>] x, ∥z - x∥⁻¹ * ∥f z - f x∥ < r := -(hf.Ioi_of_Ici.limsup_norm_slope_le hr).frequently - -/-- If `f` has derivative `f'` within `(x, +∞)` at `x`, then for any `r > ∥f'∥` the ratio -`(∥f z∥ - ∥f x∥) / (z - x)` is frequently less than `r` as `z → x+0`. -In other words, the limit inferior of this ratio as `z` tends to `x+0` -is less than or equal to `∥f'∥`. - -See also - -* `has_deriv_within_at.limsup_norm_slope_le` for a stronger version using - limit superior and any set `s`; -* `has_deriv_within_at.liminf_right_norm_slope_le` for a stronger version using - `∥f z - f x∥` instead of `∥f z∥ - ∥f x∥`. -/ -lemma has_deriv_within_at.liminf_right_slope_norm_le - (hf : has_deriv_within_at f f' (Ici x) x) (hr : ∥f'∥ < r) : - ∃ᶠ z in 𝓝[>] x, (z - x)⁻¹ * (∥f z∥ - ∥f x∥) < r := -begin - have := (hf.Ioi_of_Ici.limsup_slope_norm_le hr).frequently, - refine this.mp (eventually.mono self_mem_nhds_within _), - assume z hxz hz, - rwa [real.norm_eq_abs, abs_of_pos (sub_pos_of_lt hxz)] at hz -end - -end real_space diff --git a/src/analysis/calculus/deriv/add.lean b/src/analysis/calculus/deriv/add.lean new file mode 100644 index 0000000000000..c199f455536e6 --- /dev/null +++ b/src/analysis/calculus/deriv/add.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2019 Gabriel Ebner All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Ebner, Sébastien Gouëzel, Yury Kudryashov, Anatole Dedecker +-/ +import analysis.calculus.deriv.basic +import analysis.calculus.fderiv.add + +/-! +# One-dimensional derivatives of sums etc + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove formulas about derivatives of `f + g`, `-f`, `f - g`, and `∑ i, f i x` for +functions from the base field to a normed space over this field. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative +-/ + +universes u v w +open_locale classical topology big_operators filter ennreal +open filter asymptotics set + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L : filter 𝕜} + +section add +/-! ### Derivative of the sum of two functions -/ + +theorem has_deriv_at_filter.add + (hf : has_deriv_at_filter f f' x L) (hg : has_deriv_at_filter g g' x L) : + has_deriv_at_filter (λ y, f y + g y) (f' + g') x L := +by simpa using (hf.add hg).has_deriv_at_filter + +theorem has_strict_deriv_at.add + (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x) : + has_strict_deriv_at (λ y, f y + g y) (f' + g') x := +by simpa using (hf.add hg).has_strict_deriv_at + +theorem has_deriv_within_at.add + (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) : + has_deriv_within_at (λ y, f y + g y) (f' + g') s x := +hf.add hg + +theorem has_deriv_at.add + (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) : + has_deriv_at (λ x, f x + g x) (f' + g') x := +hf.add hg + +lemma deriv_within_add (hxs : unique_diff_within_at 𝕜 s x) + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : + deriv_within (λy, f y + g y) s x = deriv_within f s x + deriv_within g s x := +(hf.has_deriv_within_at.add hg.has_deriv_within_at).deriv_within hxs + +@[simp] lemma deriv_add + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + deriv (λy, f y + g y) x = deriv f x + deriv g x := +(hf.has_deriv_at.add hg.has_deriv_at).deriv + +theorem has_deriv_at_filter.add_const + (hf : has_deriv_at_filter f f' x L) (c : F) : + has_deriv_at_filter (λ y, f y + c) f' x L := +add_zero f' ▸ hf.add (has_deriv_at_filter_const x L c) + +theorem has_deriv_within_at.add_const + (hf : has_deriv_within_at f f' s x) (c : F) : + has_deriv_within_at (λ y, f y + c) f' s x := +hf.add_const c + +theorem has_deriv_at.add_const + (hf : has_deriv_at f f' x) (c : F) : + has_deriv_at (λ x, f x + c) f' x := +hf.add_const c + +lemma deriv_within_add_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + deriv_within (λy, f y + c) s x = deriv_within f s x := +by simp only [deriv_within, fderiv_within_add_const hxs] + +lemma deriv_add_const (c : F) : deriv (λy, f y + c) x = deriv f x := +by simp only [deriv, fderiv_add_const] + +@[simp] lemma deriv_add_const' (c : F) : deriv (λ y, f y + c) = deriv f := +funext $ λ x, deriv_add_const c + +theorem has_deriv_at_filter.const_add (c : F) (hf : has_deriv_at_filter f f' x L) : + has_deriv_at_filter (λ y, c + f y) f' x L := +zero_add f' ▸ (has_deriv_at_filter_const x L c).add hf + +theorem has_deriv_within_at.const_add (c : F) (hf : has_deriv_within_at f f' s x) : + has_deriv_within_at (λ y, c + f y) f' s x := +hf.const_add c + +theorem has_deriv_at.const_add (c : F) (hf : has_deriv_at f f' x) : + has_deriv_at (λ x, c + f x) f' x := +hf.const_add c + +lemma deriv_within_const_add (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + deriv_within (λy, c + f y) s x = deriv_within f s x := +by simp only [deriv_within, fderiv_within_const_add hxs] + +lemma deriv_const_add (c : F) : deriv (λy, c + f y) x = deriv f x := +by simp only [deriv, fderiv_const_add] + +@[simp] lemma deriv_const_add' (c : F) : deriv (λ y, c + f y) = deriv f := +funext $ λ x, deriv_const_add c + +end add + +section sum +/-! ### Derivative of a finite sum of functions -/ + +open_locale big_operators + +variables {ι : Type*} {u : finset ι} {A : ι → (𝕜 → F)} {A' : ι → F} + +theorem has_deriv_at_filter.sum (h : ∀ i ∈ u, has_deriv_at_filter (A i) (A' i) x L) : + has_deriv_at_filter (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x L := +by simpa [continuous_linear_map.sum_apply] using (has_fderiv_at_filter.sum h).has_deriv_at_filter + +theorem has_strict_deriv_at.sum (h : ∀ i ∈ u, has_strict_deriv_at (A i) (A' i) x) : + has_strict_deriv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := +by simpa [continuous_linear_map.sum_apply] using (has_strict_fderiv_at.sum h).has_strict_deriv_at + +theorem has_deriv_within_at.sum (h : ∀ i ∈ u, has_deriv_within_at (A i) (A' i) s x) : + has_deriv_within_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) s x := +has_deriv_at_filter.sum h + +theorem has_deriv_at.sum (h : ∀ i ∈ u, has_deriv_at (A i) (A' i) x) : + has_deriv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := +has_deriv_at_filter.sum h + +lemma deriv_within_sum (hxs : unique_diff_within_at 𝕜 s x) + (h : ∀ i ∈ u, differentiable_within_at 𝕜 (A i) s x) : + deriv_within (λ y, ∑ i in u, A i y) s x = ∑ i in u, deriv_within (A i) s x := +(has_deriv_within_at.sum (λ i hi, (h i hi).has_deriv_within_at)).deriv_within hxs + +@[simp] lemma deriv_sum (h : ∀ i ∈ u, differentiable_at 𝕜 (A i) x) : + deriv (λ y, ∑ i in u, A i y) x = ∑ i in u, deriv (A i) x := +(has_deriv_at.sum (λ i hi, (h i hi).has_deriv_at)).deriv + +end sum + + +section neg +/-! ### Derivative of the negative of a function -/ + +theorem has_deriv_at_filter.neg (h : has_deriv_at_filter f f' x L) : + has_deriv_at_filter (λ x, -f x) (-f') x L := +by simpa using h.neg.has_deriv_at_filter + +theorem has_deriv_within_at.neg (h : has_deriv_within_at f f' s x) : + has_deriv_within_at (λ x, -f x) (-f') s x := +h.neg + +theorem has_deriv_at.neg (h : has_deriv_at f f' x) : has_deriv_at (λ x, -f x) (-f') x := +h.neg + +theorem has_strict_deriv_at.neg (h : has_strict_deriv_at f f' x) : + has_strict_deriv_at (λ x, -f x) (-f') x := +by simpa using h.neg.has_strict_deriv_at + +lemma deriv_within.neg (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λy, -f y) s x = - deriv_within f s x := +by simp only [deriv_within, fderiv_within_neg hxs, continuous_linear_map.neg_apply] + +lemma deriv.neg : deriv (λy, -f y) x = - deriv f x := +by simp only [deriv, fderiv_neg, continuous_linear_map.neg_apply] + +@[simp] lemma deriv.neg' : deriv (λy, -f y) = (λ x, - deriv f x) := +funext $ λ x, deriv.neg + +end neg + +section neg2 +/-! ### Derivative of the negation function (i.e `has_neg.neg`) -/ + +variables (s x L) + +theorem has_deriv_at_filter_neg : has_deriv_at_filter has_neg.neg (-1) x L := +has_deriv_at_filter.neg $ has_deriv_at_filter_id _ _ + +theorem has_deriv_within_at_neg : has_deriv_within_at has_neg.neg (-1) s x := +has_deriv_at_filter_neg _ _ + +theorem has_deriv_at_neg : has_deriv_at has_neg.neg (-1) x := +has_deriv_at_filter_neg _ _ + +theorem has_deriv_at_neg' : has_deriv_at (λ x, -x) (-1) x := +has_deriv_at_filter_neg _ _ + +theorem has_strict_deriv_at_neg : has_strict_deriv_at has_neg.neg (-1) x := +has_strict_deriv_at.neg $ has_strict_deriv_at_id _ + +lemma deriv_neg : deriv has_neg.neg x = -1 := +has_deriv_at.deriv (has_deriv_at_neg x) + +@[simp] lemma deriv_neg' : deriv (has_neg.neg : 𝕜 → 𝕜) = λ _, -1 := +funext deriv_neg + +@[simp] lemma deriv_neg'' : deriv (λ x : 𝕜, -x) x = -1 := +deriv_neg x + +lemma deriv_within_neg (hxs : unique_diff_within_at 𝕜 s x) : deriv_within has_neg.neg s x = -1 := +(has_deriv_within_at_neg x s).deriv_within hxs + +lemma differentiable_neg : differentiable 𝕜 (has_neg.neg : 𝕜 → 𝕜) := +differentiable.neg differentiable_id + +lemma differentiable_on_neg : differentiable_on 𝕜 (has_neg.neg : 𝕜 → 𝕜) s := +differentiable_on.neg differentiable_on_id + +end neg2 + +section sub +/-! ### Derivative of the difference of two functions -/ + +theorem has_deriv_at_filter.sub + (hf : has_deriv_at_filter f f' x L) (hg : has_deriv_at_filter g g' x L) : + has_deriv_at_filter (λ x, f x - g x) (f' - g') x L := +by simpa only [sub_eq_add_neg] using hf.add hg.neg + +theorem has_deriv_within_at.sub + (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) : + has_deriv_within_at (λ x, f x - g x) (f' - g') s x := +hf.sub hg + +theorem has_deriv_at.sub + (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) : + has_deriv_at (λ x, f x - g x) (f' - g') x := +hf.sub hg + +theorem has_strict_deriv_at.sub + (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x) : + has_strict_deriv_at (λ x, f x - g x) (f' - g') x := +by simpa only [sub_eq_add_neg] using hf.add hg.neg + +lemma deriv_within_sub (hxs : unique_diff_within_at 𝕜 s x) + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : + deriv_within (λy, f y - g y) s x = deriv_within f s x - deriv_within g s x := +(hf.has_deriv_within_at.sub hg.has_deriv_within_at).deriv_within hxs + +@[simp] lemma deriv_sub + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + deriv (λ y, f y - g y) x = deriv f x - deriv g x := +(hf.has_deriv_at.sub hg.has_deriv_at).deriv + +theorem has_deriv_at_filter.sub_const + (hf : has_deriv_at_filter f f' x L) (c : F) : + has_deriv_at_filter (λ x, f x - c) f' x L := +by simpa only [sub_eq_add_neg] using hf.add_const (-c) + +theorem has_deriv_within_at.sub_const + (hf : has_deriv_within_at f f' s x) (c : F) : + has_deriv_within_at (λ x, f x - c) f' s x := +hf.sub_const c + +theorem has_deriv_at.sub_const + (hf : has_deriv_at f f' x) (c : F) : + has_deriv_at (λ x, f x - c) f' x := +hf.sub_const c + +lemma deriv_within_sub_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + deriv_within (λy, f y - c) s x = deriv_within f s x := +by simp only [deriv_within, fderiv_within_sub_const hxs] + +lemma deriv_sub_const (c : F) : deriv (λ y, f y - c) x = deriv f x := +by simp only [deriv, fderiv_sub_const] + +theorem has_deriv_at_filter.const_sub (c : F) (hf : has_deriv_at_filter f f' x L) : + has_deriv_at_filter (λ x, c - f x) (-f') x L := +by simpa only [sub_eq_add_neg] using hf.neg.const_add c + +theorem has_deriv_within_at.const_sub (c : F) (hf : has_deriv_within_at f f' s x) : + has_deriv_within_at (λ x, c - f x) (-f') s x := +hf.const_sub c + +theorem has_strict_deriv_at.const_sub (c : F) (hf : has_strict_deriv_at f f' x) : + has_strict_deriv_at (λ x, c - f x) (-f') x := +by simpa only [sub_eq_add_neg] using hf.neg.const_add c + +theorem has_deriv_at.const_sub (c : F) (hf : has_deriv_at f f' x) : + has_deriv_at (λ x, c - f x) (-f') x := +hf.const_sub c + +lemma deriv_within_const_sub (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + deriv_within (λy, c - f y) s x = -deriv_within f s x := +by simp [deriv_within, fderiv_within_const_sub hxs] + +lemma deriv_const_sub (c : F) : deriv (λ y, c - f y) x = -deriv f x := +by simp only [← deriv_within_univ, + deriv_within_const_sub (unique_diff_within_at_univ : unique_diff_within_at 𝕜 _ _)] + +end sub + diff --git a/src/analysis/calculus/deriv/basic.lean b/src/analysis/calculus/deriv/basic.lean new file mode 100644 index 0000000000000..f80d23c7f919e --- /dev/null +++ b/src/analysis/calculus/deriv/basic.lean @@ -0,0 +1,602 @@ +/- +Copyright (c) 2019 Gabriel Ebner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Ebner, Sébastien Gouëzel +-/ +import analysis.calculus.fderiv.basic + +/-! + +# One-dimensional derivatives + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the derivative of a function `f : 𝕜 → F` where `𝕜` is a +normed field and `F` is a normed space over this field. The derivative of +such a function `f` at a point `x` is given by an element `f' : F`. + +The theory is developed analogously to the [Fréchet +derivatives](./fderiv.html). We first introduce predicates defined in terms +of the corresponding predicates for Fréchet derivatives: + + - `has_deriv_at_filter f f' x L` states that the function `f` has the + derivative `f'` at the point `x` as `x` goes along the filter `L`. + + - `has_deriv_within_at f f' s x` states that the function `f` has the + derivative `f'` at the point `x` within the subset `s`. + + - `has_deriv_at f f' x` states that the function `f` has the derivative `f'` + at the point `x`. + + - `has_strict_deriv_at f f' x` states that the function `f` has the derivative `f'` + at the point `x` in the sense of strict differentiability, i.e., + `f y - f z = (y - z) • f' + o (y - z)` as `y, z → x`. + +For the last two notions we also define a functional version: + + - `deriv_within f s x` is a derivative of `f` at `x` within `s`. If the + derivative does not exist, then `deriv_within f s x` equals zero. + + - `deriv f x` is a derivative of `f` at `x`. If the derivative does not + exist, then `deriv f x` equals zero. + +The theorems `fderiv_within_deriv_within` and `fderiv_deriv` show that the +one-dimensional derivatives coincide with the general Fréchet derivatives. + +We also show the existence and compute the derivatives of: + - constants + - the identity function + - linear maps (in `linear.lean`) + - addition (in `add.lean`) + - sum of finitely many functions (in `add.lean`) + - negation (in `add.lean`) + - subtraction (in `add.lean`) + - star (in `star.lean`) + - multiplication of two functions in `𝕜 → 𝕜` (in `mul.lean`) + - multiplication of a function in `𝕜 → 𝕜` and of a function in `𝕜 → E` (in `mul.lean`) + - powers of a function (in `pow.lean` and `zpow.lean`) + - inverse `x → x⁻¹` (in `inv.lean`) + - division (in `inv.lean`) + - composition of a function in `𝕜 → F` with a function in `𝕜 → 𝕜` (in `comp.lean`) + - composition of a function in `F → E` with a function in `𝕜 → F` (in `comp.lean`) + - inverse function (assuming that it exists; the inverse function theorem is in `inverse.lean`) + - polynomials (in `polynomial.lean`) + +For most binary operations we also define `const_op` and `op_const` theorems for the cases when +the first or second argument is a constant. This makes writing chains of `has_deriv_at`'s easier, +and they more frequently lead to the desired result. + +We set up the simplifier so that it can compute the derivative of simple functions. For instance, +```lean +example (x : ℝ) : deriv (λ x, cos (sin x) * exp x) x = (cos(sin(x))-sin(sin(x))*cos(x))*exp(x) := +by { simp, ring } +``` + +## Implementation notes + +Most of the theorems are direct restatements of the corresponding theorems +for Fréchet derivatives. + +The strategy to construct simp lemmas that give the simplifier the possibility to compute +derivatives is the same as the one for differentiability statements, as explained in `fderiv.lean`. +See the explanations there. +-/ + +universes u v w +noncomputable theory +open_locale classical topology big_operators filter ennreal +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +/-- +`f` has the derivative `f'` at the point `x` as `x` goes along the filter `L`. + +That is, `f x' = f x + (x' - x) • f' + o(x' - x)` where `x'` converges along the filter `L`. +-/ +def has_deriv_at_filter (f : 𝕜 → F) (f' : F) (x : 𝕜) (L : filter 𝕜) := +has_fderiv_at_filter f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x L + +/-- +`f` has the derivative `f'` at the point `x` within the subset `s`. + +That is, `f x' = f x + (x' - x) • f' + o(x' - x)` where `x'` converges to `x` inside `s`. +-/ +def has_deriv_within_at (f : 𝕜 → F) (f' : F) (s : set 𝕜) (x : 𝕜) := +has_deriv_at_filter f f' x (𝓝[s] x) + +/-- +`f` has the derivative `f'` at the point `x`. + +That is, `f x' = f x + (x' - x) • f' + o(x' - x)` where `x'` converges to `x`. +-/ +def has_deriv_at (f : 𝕜 → F) (f' : F) (x : 𝕜) := +has_deriv_at_filter f f' x (𝓝 x) + +/-- `f` has the derivative `f'` at the point `x` in the sense of strict differentiability. + +That is, `f y - f z = (y - z) • f' + o(y - z)` as `y, z → x`. -/ +def has_strict_deriv_at (f : 𝕜 → F) (f' : F) (x : 𝕜) := +has_strict_fderiv_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x + +/-- +Derivative of `f` at the point `x` within the set `s`, if it exists. Zero otherwise. + +If the derivative exists (i.e., `∃ f', has_deriv_within_at f f' s x`), then +`f x' = f x + (x' - x) • deriv_within f s x + o(x' - x)` where `x'` converges to `x` inside `s`. +-/ +def deriv_within (f : 𝕜 → F) (s : set 𝕜) (x : 𝕜) := +fderiv_within 𝕜 f s x 1 + +/-- +Derivative of `f` at the point `x`, if it exists. Zero otherwise. + +If the derivative exists (i.e., `∃ f', has_deriv_at f f' x`), then +`f x' = f x + (x' - x) • deriv f x + o(x' - x)` where `x'` converges to `x`. +-/ +def deriv (f : 𝕜 → F) (x : 𝕜) := +fderiv 𝕜 f x 1 + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +/-- Expressing `has_fderiv_at_filter f f' x L` in terms of `has_deriv_at_filter` -/ +lemma has_fderiv_at_filter_iff_has_deriv_at_filter {f' : 𝕜 →L[𝕜] F} : + has_fderiv_at_filter f f' x L ↔ has_deriv_at_filter f (f' 1) x L := +by simp [has_deriv_at_filter] + +lemma has_fderiv_at_filter.has_deriv_at_filter {f' : 𝕜 →L[𝕜] F} : + has_fderiv_at_filter f f' x L → has_deriv_at_filter f (f' 1) x L := +has_fderiv_at_filter_iff_has_deriv_at_filter.mp + +/-- Expressing `has_fderiv_within_at f f' s x` in terms of `has_deriv_within_at` -/ +lemma has_fderiv_within_at_iff_has_deriv_within_at {f' : 𝕜 →L[𝕜] F} : + has_fderiv_within_at f f' s x ↔ has_deriv_within_at f (f' 1) s x := +has_fderiv_at_filter_iff_has_deriv_at_filter + +/-- Expressing `has_deriv_within_at f f' s x` in terms of `has_fderiv_within_at` -/ +lemma has_deriv_within_at_iff_has_fderiv_within_at {f' : F} : + has_deriv_within_at f f' s x ↔ + has_fderiv_within_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') s x := +iff.rfl + +lemma has_fderiv_within_at.has_deriv_within_at {f' : 𝕜 →L[𝕜] F} : + has_fderiv_within_at f f' s x → has_deriv_within_at f (f' 1) s x := +has_fderiv_within_at_iff_has_deriv_within_at.mp + +lemma has_deriv_within_at.has_fderiv_within_at {f' : F} : + has_deriv_within_at f f' s x → has_fderiv_within_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') s x := +has_deriv_within_at_iff_has_fderiv_within_at.mp + +/-- Expressing `has_fderiv_at f f' x` in terms of `has_deriv_at` -/ +lemma has_fderiv_at_iff_has_deriv_at {f' : 𝕜 →L[𝕜] F} : + has_fderiv_at f f' x ↔ has_deriv_at f (f' 1) x := +has_fderiv_at_filter_iff_has_deriv_at_filter + +lemma has_fderiv_at.has_deriv_at {f' : 𝕜 →L[𝕜] F} : + has_fderiv_at f f' x → has_deriv_at f (f' 1) x := +has_fderiv_at_iff_has_deriv_at.mp + +lemma has_strict_fderiv_at_iff_has_strict_deriv_at {f' : 𝕜 →L[𝕜] F} : + has_strict_fderiv_at f f' x ↔ has_strict_deriv_at f (f' 1) x := +by simp [has_strict_deriv_at, has_strict_fderiv_at] + +protected lemma has_strict_fderiv_at.has_strict_deriv_at {f' : 𝕜 →L[𝕜] F} : + has_strict_fderiv_at f f' x → has_strict_deriv_at f (f' 1) x := +has_strict_fderiv_at_iff_has_strict_deriv_at.mp + +lemma has_strict_deriv_at_iff_has_strict_fderiv_at : + has_strict_deriv_at f f' x ↔ has_strict_fderiv_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x := +iff.rfl + +alias has_strict_deriv_at_iff_has_strict_fderiv_at ↔ has_strict_deriv_at.has_strict_fderiv_at _ + +/-- Expressing `has_deriv_at f f' x` in terms of `has_fderiv_at` -/ +lemma has_deriv_at_iff_has_fderiv_at {f' : F} : + has_deriv_at f f' x ↔ + has_fderiv_at f (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') x := +iff.rfl + +alias has_deriv_at_iff_has_fderiv_at ↔ has_deriv_at.has_fderiv_at _ + +lemma deriv_within_zero_of_not_differentiable_within_at + (h : ¬ differentiable_within_at 𝕜 f s x) : deriv_within f s x = 0 := +by { unfold deriv_within, rw fderiv_within_zero_of_not_differentiable_within_at, simp, assumption } + +lemma differentiable_within_at_of_deriv_within_ne_zero (h : deriv_within f s x ≠ 0) : + differentiable_within_at 𝕜 f s x := +not_imp_comm.1 deriv_within_zero_of_not_differentiable_within_at h + +lemma deriv_zero_of_not_differentiable_at (h : ¬ differentiable_at 𝕜 f x) : deriv f x = 0 := +by { unfold deriv, rw fderiv_zero_of_not_differentiable_at, simp, assumption } + +lemma differentiable_at_of_deriv_ne_zero (h : deriv f x ≠ 0) : differentiable_at 𝕜 f x := +not_imp_comm.1 deriv_zero_of_not_differentiable_at h + +theorem unique_diff_within_at.eq_deriv (s : set 𝕜) (H : unique_diff_within_at 𝕜 s x) + (h : has_deriv_within_at f f' s x) (h₁ : has_deriv_within_at f f₁' s x) : f' = f₁' := +smul_right_one_eq_iff.mp $ unique_diff_within_at.eq H h h₁ + +theorem has_deriv_at_filter_iff_is_o : + has_deriv_at_filter f f' x L ↔ (λ x' : 𝕜, f x' - f x - (x' - x) • f') =o[L] (λ x', x' - x) := +iff.rfl + +theorem has_deriv_at_filter_iff_tendsto : + has_deriv_at_filter f f' x L ↔ + tendsto (λ x' : 𝕜, ‖x' - x‖⁻¹ * ‖f x' - f x - (x' - x) • f'‖) L (𝓝 0) := +has_fderiv_at_filter_iff_tendsto + +theorem has_deriv_within_at_iff_is_o : + has_deriv_within_at f f' s x + ↔ (λ x' : 𝕜, f x' - f x - (x' - x) • f') =o[𝓝[s] x] (λ x', x' - x) := +iff.rfl + +theorem has_deriv_within_at_iff_tendsto : has_deriv_within_at f f' s x ↔ + tendsto (λ x', ‖x' - x‖⁻¹ * ‖f x' - f x - (x' - x) • f'‖) (𝓝[s] x) (𝓝 0) := +has_fderiv_at_filter_iff_tendsto + +theorem has_deriv_at_iff_is_o : + has_deriv_at f f' x ↔ (λ x' : 𝕜, f x' - f x - (x' - x) • f') =o[𝓝 x] (λ x', x' - x) := +iff.rfl + +theorem has_deriv_at_iff_tendsto : has_deriv_at f f' x ↔ + tendsto (λ x', ‖x' - x‖⁻¹ * ‖f x' - f x - (x' - x) • f'‖) (𝓝 x) (𝓝 0) := +has_fderiv_at_filter_iff_tendsto + +theorem has_deriv_at_filter.is_O_sub (h : has_deriv_at_filter f f' x L) : + (λ x', f x' - f x) =O[L] (λ x', x' - x) := +has_fderiv_at_filter.is_O_sub h + +theorem has_deriv_at_filter.is_O_sub_rev (hf : has_deriv_at_filter f f' x L) (hf' : f' ≠ 0) : + (λ x', x' - x) =O[L] (λ x', f x' - f x) := +suffices antilipschitz_with ‖f'‖₊⁻¹ (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f'), from hf.is_O_sub_rev this, +add_monoid_hom_class.antilipschitz_of_bound (smul_right (1 : 𝕜 →L[𝕜] 𝕜) f') $ + λ x, by simp [norm_smul, ← div_eq_inv_mul, mul_div_cancel _ (mt norm_eq_zero.1 hf')] + +theorem has_strict_deriv_at.has_deriv_at (h : has_strict_deriv_at f f' x) : + has_deriv_at f f' x := +h.has_fderiv_at +theorem has_deriv_within_at_congr_set' {s t : set 𝕜} (y : 𝕜) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) : + has_deriv_within_at f f' s x ↔ has_deriv_within_at f f' t x := +has_fderiv_within_at_congr_set' y h + +theorem has_deriv_within_at_congr_set {s t : set 𝕜} (h : s =ᶠ[𝓝 x] t) : + has_deriv_within_at f f' s x ↔ has_deriv_within_at f f' t x := +has_fderiv_within_at_congr_set h + +alias has_deriv_within_at_congr_set ↔ has_deriv_within_at.congr_set _ + +@[simp] lemma has_deriv_within_at_diff_singleton : + has_deriv_within_at f f' (s \ {x}) x ↔ has_deriv_within_at f f' s x := +has_fderiv_within_at_diff_singleton _ + +@[simp] lemma has_deriv_within_at_Ioi_iff_Ici [partial_order 𝕜] : + has_deriv_within_at f f' (Ioi x) x ↔ has_deriv_within_at f f' (Ici x) x := +by rw [← Ici_diff_left, has_deriv_within_at_diff_singleton] + +alias has_deriv_within_at_Ioi_iff_Ici ↔ + has_deriv_within_at.Ici_of_Ioi has_deriv_within_at.Ioi_of_Ici + +@[simp] lemma has_deriv_within_at_Iio_iff_Iic [partial_order 𝕜] : + has_deriv_within_at f f' (Iio x) x ↔ has_deriv_within_at f f' (Iic x) x := +by rw [← Iic_diff_right, has_deriv_within_at_diff_singleton] + +alias has_deriv_within_at_Iio_iff_Iic ↔ + has_deriv_within_at.Iic_of_Iio has_deriv_within_at.Iio_of_Iic + +theorem has_deriv_within_at.Ioi_iff_Ioo [linear_order 𝕜] [order_closed_topology 𝕜] {x y : 𝕜} + (h : x < y) : + has_deriv_within_at f f' (Ioo x y) x ↔ has_deriv_within_at f f' (Ioi x) x := +has_fderiv_within_at_inter $ Iio_mem_nhds h + +alias has_deriv_within_at.Ioi_iff_Ioo ↔ + has_deriv_within_at.Ioi_of_Ioo has_deriv_within_at.Ioo_of_Ioi + +theorem has_deriv_at_iff_is_o_nhds_zero : has_deriv_at f f' x ↔ + (λh, f (x + h) - f x - h • f') =o[𝓝 0] (λh, h) := +has_fderiv_at_iff_is_o_nhds_zero + +theorem has_deriv_at_filter.mono (h : has_deriv_at_filter f f' x L₂) (hst : L₁ ≤ L₂) : + has_deriv_at_filter f f' x L₁ := +has_fderiv_at_filter.mono h hst + +theorem has_deriv_within_at.mono (h : has_deriv_within_at f f' t x) (hst : s ⊆ t) : + has_deriv_within_at f f' s x := +has_fderiv_within_at.mono h hst + +theorem has_deriv_within_at.mono_of_mem (h : has_deriv_within_at f f' t x) (hst : t ∈ 𝓝[s] x) : + has_deriv_within_at f f' s x := +has_fderiv_within_at.mono_of_mem h hst + +theorem has_deriv_at.has_deriv_at_filter (h : has_deriv_at f f' x) (hL : L ≤ 𝓝 x) : + has_deriv_at_filter f f' x L := +has_fderiv_at.has_fderiv_at_filter h hL + +theorem has_deriv_at.has_deriv_within_at + (h : has_deriv_at f f' x) : has_deriv_within_at f f' s x := +has_fderiv_at.has_fderiv_within_at h + +lemma has_deriv_within_at.differentiable_within_at (h : has_deriv_within_at f f' s x) : + differentiable_within_at 𝕜 f s x := +has_fderiv_within_at.differentiable_within_at h + +lemma has_deriv_at.differentiable_at (h : has_deriv_at f f' x) : differentiable_at 𝕜 f x := +has_fderiv_at.differentiable_at h + +@[simp] lemma has_deriv_within_at_univ : has_deriv_within_at f f' univ x ↔ has_deriv_at f f' x := +has_fderiv_within_at_univ + +theorem has_deriv_at.unique + (h₀ : has_deriv_at f f₀' x) (h₁ : has_deriv_at f f₁' x) : f₀' = f₁' := +smul_right_one_eq_iff.mp $ h₀.has_fderiv_at.unique h₁ + +lemma has_deriv_within_at_inter' (h : t ∈ 𝓝[s] x) : + has_deriv_within_at f f' (s ∩ t) x ↔ has_deriv_within_at f f' s x := +has_fderiv_within_at_inter' h + +lemma has_deriv_within_at_inter (h : t ∈ 𝓝 x) : + has_deriv_within_at f f' (s ∩ t) x ↔ has_deriv_within_at f f' s x := +has_fderiv_within_at_inter h + +lemma has_deriv_within_at.union (hs : has_deriv_within_at f f' s x) + (ht : has_deriv_within_at f f' t x) : + has_deriv_within_at f f' (s ∪ t) x := +hs.has_fderiv_within_at.union ht.has_fderiv_within_at + +lemma has_deriv_within_at.nhds_within (h : has_deriv_within_at f f' s x) + (ht : s ∈ 𝓝[t] x) : has_deriv_within_at f f' t x := +(has_deriv_within_at_inter' ht).1 (h.mono (inter_subset_right _ _)) + +lemma has_deriv_within_at.has_deriv_at (h : has_deriv_within_at f f' s x) (hs : s ∈ 𝓝 x) : + has_deriv_at f f' x := +has_fderiv_within_at.has_fderiv_at h hs + +lemma differentiable_within_at.has_deriv_within_at (h : differentiable_within_at 𝕜 f s x) : + has_deriv_within_at f (deriv_within f s x) s x := +h.has_fderiv_within_at.has_deriv_within_at + +lemma differentiable_at.has_deriv_at (h : differentiable_at 𝕜 f x) : has_deriv_at f (deriv f x) x := +h.has_fderiv_at.has_deriv_at + +@[simp] lemma has_deriv_at_deriv_iff : has_deriv_at f (deriv f x) x ↔ differentiable_at 𝕜 f x := +⟨λ h, h.differentiable_at, λ h, h.has_deriv_at⟩ + +@[simp] lemma has_deriv_within_at_deriv_within_iff : + has_deriv_within_at f (deriv_within f s x) s x ↔ differentiable_within_at 𝕜 f s x := +⟨λ h, h.differentiable_within_at, λ h, h.has_deriv_within_at⟩ + +lemma differentiable_on.has_deriv_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : + has_deriv_at f (deriv f x) x := +(h.has_fderiv_at hs).has_deriv_at + +lemma has_deriv_at.deriv (h : has_deriv_at f f' x) : deriv f x = f' := +h.differentiable_at.has_deriv_at.unique h + +lemma deriv_eq {f' : 𝕜 → F} (h : ∀ x, has_deriv_at f (f' x) x) : deriv f = f' := +funext $ λ x, (h x).deriv + +lemma has_deriv_within_at.deriv_within + (h : has_deriv_within_at f f' s x) (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within f s x = f' := +hxs.eq_deriv _ h.differentiable_within_at.has_deriv_within_at h + +lemma fderiv_within_deriv_within : (fderiv_within 𝕜 f s x : 𝕜 → F) 1 = deriv_within f s x := +rfl + +lemma deriv_within_fderiv_within : + smul_right (1 : 𝕜 →L[𝕜] 𝕜) (deriv_within f s x) = fderiv_within 𝕜 f s x := +by simp [deriv_within] + +lemma fderiv_deriv : (fderiv 𝕜 f x : 𝕜 → F) 1 = deriv f x := +rfl + +lemma deriv_fderiv : + smul_right (1 : 𝕜 →L[𝕜] 𝕜) (deriv f x) = fderiv 𝕜 f x := +by simp [deriv] + +lemma differentiable_at.deriv_within (h : differentiable_at 𝕜 f x) + (hxs : unique_diff_within_at 𝕜 s x) : deriv_within f s x = deriv f x := +by { unfold deriv_within deriv, rw h.fderiv_within hxs } + +theorem has_deriv_within_at.deriv_eq_zero (hd : has_deriv_within_at f 0 s x) + (H : unique_diff_within_at 𝕜 s x) : deriv f x = 0 := +(em' (differentiable_at 𝕜 f x)).elim deriv_zero_of_not_differentiable_at $ + λ h, H.eq_deriv _ h.has_deriv_at.has_deriv_within_at hd + +lemma deriv_within_of_mem (st : t ∈ 𝓝[s] x) (ht : unique_diff_within_at 𝕜 s x) + (h : differentiable_within_at 𝕜 f t x) : + deriv_within f s x = deriv_within f t x := +((differentiable_within_at.has_deriv_within_at h).mono_of_mem st).deriv_within ht + +lemma deriv_within_subset (st : s ⊆ t) (ht : unique_diff_within_at 𝕜 s x) + (h : differentiable_within_at 𝕜 f t x) : + deriv_within f s x = deriv_within f t x := +((differentiable_within_at.has_deriv_within_at h).mono st).deriv_within ht + +lemma deriv_within_congr_set' (y : 𝕜) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) : + deriv_within f s x = deriv_within f t x := +by simp only [deriv_within, fderiv_within_congr_set' y h] + +lemma deriv_within_congr_set (h : s =ᶠ[𝓝 x] t) : deriv_within f s x = deriv_within f t x := +by simp only [deriv_within, fderiv_within_congr_set h] + +@[simp] lemma deriv_within_univ : deriv_within f univ = deriv f := +by { ext, unfold deriv_within deriv, rw fderiv_within_univ } + +lemma deriv_within_inter (ht : t ∈ 𝓝 x) : + deriv_within f (s ∩ t) x = deriv_within f s x := +by { unfold deriv_within, rw fderiv_within_inter ht } + +lemma deriv_within_of_open (hs : is_open s) (hx : x ∈ s) : + deriv_within f s x = deriv f x := +by { unfold deriv_within, rw fderiv_within_of_open hs hx, refl } + +lemma deriv_mem_iff {f : 𝕜 → F} {s : set F} {x : 𝕜} : + deriv f x ∈ s ↔ (differentiable_at 𝕜 f x ∧ deriv f x ∈ s) ∨ + (¬differentiable_at 𝕜 f x ∧ (0 : F) ∈ s) := +by by_cases hx : differentiable_at 𝕜 f x; simp [deriv_zero_of_not_differentiable_at, *] + +lemma deriv_within_mem_iff {f : 𝕜 → F} {t : set 𝕜} {s : set F} {x : 𝕜} : + deriv_within f t x ∈ s ↔ (differentiable_within_at 𝕜 f t x ∧ deriv_within f t x ∈ s) ∨ + (¬differentiable_within_at 𝕜 f t x ∧ (0 : F) ∈ s) := +by by_cases hx : differentiable_within_at 𝕜 f t x; + simp [deriv_within_zero_of_not_differentiable_within_at, *] + +lemma differentiable_within_at_Ioi_iff_Ici [partial_order 𝕜] : + differentiable_within_at 𝕜 f (Ioi x) x ↔ differentiable_within_at 𝕜 f (Ici x) x := +⟨λ h, h.has_deriv_within_at.Ici_of_Ioi.differentiable_within_at, +λ h, h.has_deriv_within_at.Ioi_of_Ici.differentiable_within_at⟩ + +-- Golfed while splitting the file +lemma deriv_within_Ioi_eq_Ici {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] (f : ℝ → E) + (x : ℝ) : + deriv_within f (Ioi x) x = deriv_within f (Ici x) x := +begin + by_cases H : differentiable_within_at ℝ f (Ioi x) x, + { have A := H.has_deriv_within_at.Ici_of_Ioi, + have B := (differentiable_within_at_Ioi_iff_Ici.1 H).has_deriv_within_at, + simpa using (unique_diff_on_Ici x).eq le_rfl A B }, + { rw [deriv_within_zero_of_not_differentiable_within_at H, + deriv_within_zero_of_not_differentiable_within_at], + rwa differentiable_within_at_Ioi_iff_Ici at H } +end + +section congr +/-! ### Congruence properties of derivatives -/ + +theorem filter.eventually_eq.has_deriv_at_filter_iff + (h₀ : f₀ =ᶠ[L] f₁) (hx : f₀ x = f₁ x) (h₁ : f₀' = f₁') : + has_deriv_at_filter f₀ f₀' x L ↔ has_deriv_at_filter f₁ f₁' x L := +h₀.has_fderiv_at_filter_iff hx (by simp [h₁]) + +lemma has_deriv_at_filter.congr_of_eventually_eq (h : has_deriv_at_filter f f' x L) + (hL : f₁ =ᶠ[L] f) (hx : f₁ x = f x) : has_deriv_at_filter f₁ f' x L := +by rwa hL.has_deriv_at_filter_iff hx rfl + +lemma has_deriv_within_at.congr_mono (h : has_deriv_within_at f f' s x) (ht : ∀x ∈ t, f₁ x = f x) + (hx : f₁ x = f x) (h₁ : t ⊆ s) : has_deriv_within_at f₁ f' t x := +has_fderiv_within_at.congr_mono h ht hx h₁ + +lemma has_deriv_within_at.congr (h : has_deriv_within_at f f' s x) (hs : ∀x ∈ s, f₁ x = f x) + (hx : f₁ x = f x) : has_deriv_within_at f₁ f' s x := +h.congr_mono hs hx (subset.refl _) + +lemma has_deriv_within_at.congr_of_mem (h : has_deriv_within_at f f' s x) (hs : ∀x ∈ s, f₁ x = f x) + (hx : x ∈ s) : has_deriv_within_at f₁ f' s x := +h.congr hs (hs _ hx) + +lemma has_deriv_within_at.congr_of_eventually_eq (h : has_deriv_within_at f f' s x) + (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : has_deriv_within_at f₁ f' s x := +has_deriv_at_filter.congr_of_eventually_eq h h₁ hx + +lemma has_deriv_within_at.congr_of_eventually_eq_of_mem (h : has_deriv_within_at f f' s x) + (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : x ∈ s) : has_deriv_within_at f₁ f' s x := +h.congr_of_eventually_eq h₁ (h₁.eq_of_nhds_within hx) + +lemma has_deriv_at.congr_of_eventually_eq (h : has_deriv_at f f' x) + (h₁ : f₁ =ᶠ[𝓝 x] f) : has_deriv_at f₁ f' x := +has_deriv_at_filter.congr_of_eventually_eq h h₁ (mem_of_mem_nhds h₁ : _) + +lemma filter.eventually_eq.deriv_within_eq (hL : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : + deriv_within f₁ s x = deriv_within f s x := +by { unfold deriv_within, rw hL.fderiv_within_eq hx } + +lemma deriv_within_congr (hs : eq_on f₁ f s) (hx : f₁ x = f x) : + deriv_within f₁ s x = deriv_within f s x := +by { unfold deriv_within, rw fderiv_within_congr hs hx } + +lemma filter.eventually_eq.deriv_eq (hL : f₁ =ᶠ[𝓝 x] f) : deriv f₁ x = deriv f x := +by { unfold deriv, rwa filter.eventually_eq.fderiv_eq } + +protected lemma filter.eventually_eq.deriv (h : f₁ =ᶠ[𝓝 x] f) : deriv f₁ =ᶠ[𝓝 x] deriv f := +h.eventually_eq_nhds.mono $ λ x h, h.deriv_eq + +end congr + +section id +/-! ### Derivative of the identity -/ +variables (s x L) + +theorem has_deriv_at_filter_id : has_deriv_at_filter id 1 x L := +(has_fderiv_at_filter_id x L).has_deriv_at_filter + +theorem has_deriv_within_at_id : has_deriv_within_at id 1 s x := +has_deriv_at_filter_id _ _ + +theorem has_deriv_at_id : has_deriv_at id 1 x := +has_deriv_at_filter_id _ _ + +theorem has_deriv_at_id' : has_deriv_at (λ (x : 𝕜), x) 1 x := +has_deriv_at_filter_id _ _ + +theorem has_strict_deriv_at_id : has_strict_deriv_at id 1 x := +(has_strict_fderiv_at_id x).has_strict_deriv_at + +lemma deriv_id : deriv id x = 1 := +has_deriv_at.deriv (has_deriv_at_id x) + +@[simp] lemma deriv_id' : deriv (@id 𝕜) = λ _, 1 := funext deriv_id + +@[simp] lemma deriv_id'' : deriv (λ x : 𝕜, x) = λ _, 1 := deriv_id' + +lemma deriv_within_id (hxs : unique_diff_within_at 𝕜 s x) : deriv_within id s x = 1 := +(has_deriv_within_at_id x s).deriv_within hxs + +end id + +section const +/-! ### Derivative of constant functions -/ +variables (c : F) (s x L) + +theorem has_deriv_at_filter_const : has_deriv_at_filter (λ x, c) 0 x L := +(has_fderiv_at_filter_const c x L).has_deriv_at_filter + +theorem has_strict_deriv_at_const : has_strict_deriv_at (λ x, c) 0 x := +(has_strict_fderiv_at_const c x).has_strict_deriv_at + +theorem has_deriv_within_at_const : has_deriv_within_at (λ x, c) 0 s x := +has_deriv_at_filter_const _ _ _ + +theorem has_deriv_at_const : has_deriv_at (λ x, c) 0 x := +has_deriv_at_filter_const _ _ _ + +lemma deriv_const : deriv (λ x, c) x = 0 := +has_deriv_at.deriv (has_deriv_at_const x c) + +@[simp] lemma deriv_const' : deriv (λ x:𝕜, c) = λ x, 0 := +funext (λ x, deriv_const x c) + +lemma deriv_within_const (hxs : unique_diff_within_at 𝕜 s x) : deriv_within (λ x, c) s x = 0 := +(has_deriv_within_at_const _ _ _).deriv_within hxs + +end const + +section continuous +/-! ### Continuity of a function admitting a derivative -/ + +theorem has_deriv_at_filter.tendsto_nhds + (hL : L ≤ 𝓝 x) (h : has_deriv_at_filter f f' x L) : + tendsto f L (𝓝 (f x)) := +h.tendsto_nhds hL + +theorem has_deriv_within_at.continuous_within_at + (h : has_deriv_within_at f f' s x) : continuous_within_at f s x := +has_deriv_at_filter.tendsto_nhds inf_le_left h + +theorem has_deriv_at.continuous_at (h : has_deriv_at f f' x) : continuous_at f x := +has_deriv_at_filter.tendsto_nhds le_rfl h + +protected theorem has_deriv_at.continuous_on {f f' : 𝕜 → F} + (hderiv : ∀ x ∈ s, has_deriv_at f (f' x) x) : continuous_on f s := +λ x hx, (hderiv x hx).continuous_at.continuous_within_at + +end continuous + diff --git a/src/analysis/calculus/deriv/comp.lean b/src/analysis/calculus/deriv/comp.lean new file mode 100644 index 0000000000000..44c390d99966f --- /dev/null +++ b/src/analysis/calculus/deriv/comp.lean @@ -0,0 +1,266 @@ +/- +Copyright (c) 2019 Gabriel Ebner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Ebner, Sébastien Gouëzel, Yury Kudryashov, Yuyang Zhao +-/ +import analysis.calculus.deriv.basic +import analysis.calculus.fderiv.comp +import analysis.calculus.fderiv.restrict_scalars + +/-! +# One-dimensional derivatives of compositions of functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove the chain rule for the following cases: + +* `has_deriv_at.comp` etc: `f : 𝕜' → 𝕜'` composed with `g : 𝕜 → 𝕜'`; +* `has_deriv_at.scomp` etc: `f : 𝕜' → E` composed with `g : 𝕜 → 𝕜'`; +* `has_fderiv_at.comp_has_deriv_at` etc: `f : E → F` composed with `g : 𝕜 → E`; + +Here `𝕜` is the base normed field, `E` and `F` are normed spaces over `𝕜` and `𝕜'` is an algebra +over `𝕜` (e.g., `𝕜'=𝕜` or `𝕜=ℝ`, `𝕜'=ℂ`). + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, chain rule +-/ + +universes u v w +open_locale classical topology big_operators filter ennreal +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +section composition +/-! +### Derivative of the composition of a vector function and a scalar function + +We use `scomp` in lemmas on composition of vector valued and scalar valued functions, and `comp` +in lemmas on composition of scalar valued functions, in analogy for `smul` and `mul` (and also +because the `comp` version with the shorter name will show up much more often in applications). +The formula for the derivative involves `smul` in `scomp` lemmas, which can be reduced to +usual multiplication in `comp` lemmas. +-/ + +/- For composition lemmas, we put x explicit to help the elaborator, as otherwise Lean tends to +get confused since there are too many possibilities for composition -/ +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {s' t' : set 𝕜'} + {h : 𝕜 → 𝕜'} {h₁ : 𝕜 → 𝕜} {h₂ : 𝕜' → 𝕜'} {h' h₂' : 𝕜'} {h₁' : 𝕜} + {g₁ : 𝕜' → F} {g₁' : F} {L' : filter 𝕜'} (x) + +theorem has_deriv_at_filter.scomp + (hg : has_deriv_at_filter g₁ g₁' (h x) L') + (hh : has_deriv_at_filter h h' x L) (hL : tendsto h L L'): + has_deriv_at_filter (g₁ ∘ h) (h' • g₁') x L := +by simpa using ((hg.restrict_scalars 𝕜).comp x hh hL).has_deriv_at_filter + +theorem has_deriv_within_at.scomp_has_deriv_at + (hg : has_deriv_within_at g₁ g₁' s' (h x)) + (hh : has_deriv_at h h' x) (hs : ∀ x, h x ∈ s') : + has_deriv_at (g₁ ∘ h) (h' • g₁') x := +hg.scomp x hh $ tendsto_inf.2 ⟨hh.continuous_at, tendsto_principal.2 $ eventually_of_forall hs⟩ + +theorem has_deriv_within_at.scomp + (hg : has_deriv_within_at g₁ g₁' t' (h x)) + (hh : has_deriv_within_at h h' s x) (hst : maps_to h s t') : + has_deriv_within_at (g₁ ∘ h) (h' • g₁') s x := +hg.scomp x hh $ hh.continuous_within_at.tendsto_nhds_within hst + +/-- The chain rule. -/ +theorem has_deriv_at.scomp + (hg : has_deriv_at g₁ g₁' (h x)) (hh : has_deriv_at h h' x) : + has_deriv_at (g₁ ∘ h) (h' • g₁') x := +hg.scomp x hh hh.continuous_at + +theorem has_strict_deriv_at.scomp + (hg : has_strict_deriv_at g₁ g₁' (h x)) (hh : has_strict_deriv_at h h' x) : + has_strict_deriv_at (g₁ ∘ h) (h' • g₁') x := +by simpa using ((hg.restrict_scalars 𝕜).comp x hh).has_strict_deriv_at + +theorem has_deriv_at.scomp_has_deriv_within_at + (hg : has_deriv_at g₁ g₁' (h x)) (hh : has_deriv_within_at h h' s x) : + has_deriv_within_at (g₁ ∘ h) (h' • g₁') s x := +has_deriv_within_at.scomp x hg.has_deriv_within_at hh (maps_to_univ _ _) + +lemma deriv_within.scomp + (hg : differentiable_within_at 𝕜' g₁ t' (h x)) (hh : differentiable_within_at 𝕜 h s x) + (hs : maps_to h s t') (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (g₁ ∘ h) s x = deriv_within h s x • deriv_within g₁ t' (h x) := +(has_deriv_within_at.scomp x hg.has_deriv_within_at hh.has_deriv_within_at hs).deriv_within hxs + +lemma deriv.scomp + (hg : differentiable_at 𝕜' g₁ (h x)) (hh : differentiable_at 𝕜 h x) : + deriv (g₁ ∘ h) x = deriv h x • deriv g₁ (h x) := +(has_deriv_at.scomp x hg.has_deriv_at hh.has_deriv_at).deriv + +/-! ### Derivative of the composition of a scalar and vector functions -/ + +theorem has_deriv_at_filter.comp_has_fderiv_at_filter {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} (x) + {L'' : filter E} (hh₂ : has_deriv_at_filter h₂ h₂' (f x) L') + (hf : has_fderiv_at_filter f f' x L'') (hL : tendsto f L'' L') : + has_fderiv_at_filter (h₂ ∘ f) (h₂' • f') x L'' := +by { convert (hh₂.restrict_scalars 𝕜).comp x hf hL, ext x, simp [mul_comm] } + +theorem has_strict_deriv_at.comp_has_strict_fderiv_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} (x) + (hh : has_strict_deriv_at h₂ h₂' (f x)) (hf : has_strict_fderiv_at f f' x) : + has_strict_fderiv_at (h₂ ∘ f) (h₂' • f') x := +begin + rw has_strict_deriv_at at hh, + convert (hh.restrict_scalars 𝕜).comp x hf, + ext x, + simp [mul_comm] +end + +theorem has_deriv_at.comp_has_fderiv_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} (x) + (hh : has_deriv_at h₂ h₂' (f x)) (hf : has_fderiv_at f f' x) : + has_fderiv_at (h₂ ∘ f) (h₂' • f') x := +hh.comp_has_fderiv_at_filter x hf hf.continuous_at + +theorem has_deriv_at.comp_has_fderiv_within_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} {s} (x) + (hh : has_deriv_at h₂ h₂' (f x)) (hf : has_fderiv_within_at f f' s x) : + has_fderiv_within_at (h₂ ∘ f) (h₂' • f') s x := +hh.comp_has_fderiv_at_filter x hf hf.continuous_within_at + +theorem has_deriv_within_at.comp_has_fderiv_within_at {f : E → 𝕜'} {f' : E →L[𝕜] 𝕜'} {s t} (x) + (hh : has_deriv_within_at h₂ h₂' t (f x)) (hf : has_fderiv_within_at f f' s x) + (hst : maps_to f s t) : + has_fderiv_within_at (h₂ ∘ f) (h₂' • f') s x := +hh.comp_has_fderiv_at_filter x hf $ hf.continuous_within_at.tendsto_nhds_within hst + +/-! ### Derivative of the composition of two scalar functions -/ + +theorem has_deriv_at_filter.comp + (hh₂ : has_deriv_at_filter h₂ h₂' (h x) L') + (hh : has_deriv_at_filter h h' x L) (hL : tendsto h L L') : + has_deriv_at_filter (h₂ ∘ h) (h₂' * h') x L := +by { rw mul_comm, exact hh₂.scomp x hh hL } + +theorem has_deriv_within_at.comp + (hh₂ : has_deriv_within_at h₂ h₂' s' (h x)) + (hh : has_deriv_within_at h h' s x) (hst : maps_to h s s') : + has_deriv_within_at (h₂ ∘ h) (h₂' * h') s x := +by { rw mul_comm, exact hh₂.scomp x hh hst, } + +/-- The chain rule. -/ +theorem has_deriv_at.comp + (hh₂ : has_deriv_at h₂ h₂' (h x)) (hh : has_deriv_at h h' x) : + has_deriv_at (h₂ ∘ h) (h₂' * h') x := +hh₂.comp x hh hh.continuous_at + +theorem has_strict_deriv_at.comp + (hh₂ : has_strict_deriv_at h₂ h₂' (h x)) (hh : has_strict_deriv_at h h' x) : + has_strict_deriv_at (h₂ ∘ h) (h₂' * h') x := +by { rw mul_comm, exact hh₂.scomp x hh } + +theorem has_deriv_at.comp_has_deriv_within_at + (hh₂ : has_deriv_at h₂ h₂' (h x)) (hh : has_deriv_within_at h h' s x) : + has_deriv_within_at (h₂ ∘ h) (h₂' * h') s x := +hh₂.has_deriv_within_at.comp x hh (maps_to_univ _ _) + +lemma deriv_within.comp + (hh₂ : differentiable_within_at 𝕜' h₂ s' (h x)) (hh : differentiable_within_at 𝕜 h s x) + (hs : maps_to h s s') (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (h₂ ∘ h) s x = deriv_within h₂ s' (h x) * deriv_within h s x := +(hh₂.has_deriv_within_at.comp x hh.has_deriv_within_at hs).deriv_within hxs + +lemma deriv.comp + (hh₂ : differentiable_at 𝕜' h₂ (h x)) (hh : differentiable_at 𝕜 h x) : + deriv (h₂ ∘ h) x = deriv h₂ (h x) * deriv h x := +(hh₂.has_deriv_at.comp x hh.has_deriv_at).deriv + +protected lemma has_deriv_at_filter.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} + (hf : has_deriv_at_filter f f' x L) (hL : tendsto f L L) (hx : f x = x) (n : ℕ) : + has_deriv_at_filter (f^[n]) (f'^n) x L := +begin + have := hf.iterate hL hx n, + rwa [continuous_linear_map.smul_right_one_pow] at this +end + +protected lemma has_deriv_at.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} + (hf : has_deriv_at f f' x) (hx : f x = x) (n : ℕ) : + has_deriv_at (f^[n]) (f'^n) x := +begin + have := has_fderiv_at.iterate hf hx n, + rwa [continuous_linear_map.smul_right_one_pow] at this +end + +protected lemma has_deriv_within_at.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} + (hf : has_deriv_within_at f f' s x) (hx : f x = x) (hs : maps_to f s s) (n : ℕ) : + has_deriv_within_at (f^[n]) (f'^n) s x := +begin + have := has_fderiv_within_at.iterate hf hx hs n, + rwa [continuous_linear_map.smul_right_one_pow] at this +end + +protected lemma has_strict_deriv_at.iterate {f : 𝕜 → 𝕜} {f' : 𝕜} + (hf : has_strict_deriv_at f f' x) (hx : f x = x) (n : ℕ) : + has_strict_deriv_at (f^[n]) (f'^n) x := +begin + have := hf.iterate hx n, + rwa [continuous_linear_map.smul_right_one_pow] at this +end + +end composition + +section composition_vector +/-! ### Derivative of the composition of a function between vector spaces and a function on `𝕜` -/ + +open continuous_linear_map + +variables {l : F → E} {l' : F →L[𝕜] E} +variable (x) + +/-- The composition `l ∘ f` where `l : F → E` and `f : 𝕜 → F`, has a derivative within a set +equal to the Fréchet derivative of `l` applied to the derivative of `f`. -/ +theorem has_fderiv_within_at.comp_has_deriv_within_at {t : set F} + (hl : has_fderiv_within_at l l' t (f x)) (hf : has_deriv_within_at f f' s x) + (hst : maps_to f s t) : + has_deriv_within_at (l ∘ f) (l' f') s x := +by simpa only [one_apply, one_smul, smul_right_apply, coe_comp', (∘)] + using (hl.comp x hf.has_fderiv_within_at hst).has_deriv_within_at + +theorem has_fderiv_at.comp_has_deriv_within_at + (hl : has_fderiv_at l l' (f x)) (hf : has_deriv_within_at f f' s x) : + has_deriv_within_at (l ∘ f) (l' f') s x := +hl.has_fderiv_within_at.comp_has_deriv_within_at x hf (maps_to_univ _ _) + +/-- The composition `l ∘ f` where `l : F → E` and `f : 𝕜 → F`, has a derivative equal to the +Fréchet derivative of `l` applied to the derivative of `f`. -/ +theorem has_fderiv_at.comp_has_deriv_at (hl : has_fderiv_at l l' (f x)) (hf : has_deriv_at f f' x) : + has_deriv_at (l ∘ f) (l' f') x := +has_deriv_within_at_univ.mp $ hl.comp_has_deriv_within_at x hf.has_deriv_within_at + +theorem has_strict_fderiv_at.comp_has_strict_deriv_at + (hl : has_strict_fderiv_at l l' (f x)) (hf : has_strict_deriv_at f f' x) : + has_strict_deriv_at (l ∘ f) (l' f') x := +by simpa only [one_apply, one_smul, smul_right_apply, coe_comp', (∘)] + using (hl.comp x hf.has_strict_fderiv_at).has_strict_deriv_at + +lemma fderiv_within.comp_deriv_within {t : set F} + (hl : differentiable_within_at 𝕜 l t (f x)) (hf : differentiable_within_at 𝕜 f s x) + (hs : maps_to f s t) (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (l ∘ f) s x = (fderiv_within 𝕜 l t (f x) : F → E) (deriv_within f s x) := +(hl.has_fderiv_within_at.comp_has_deriv_within_at x hf.has_deriv_within_at hs).deriv_within hxs + +lemma fderiv.comp_deriv + (hl : differentiable_at 𝕜 l (f x)) (hf : differentiable_at 𝕜 f x) : + deriv (l ∘ f) x = (fderiv 𝕜 l (f x) : F → E) (deriv f x) := +(hl.has_fderiv_at.comp_has_deriv_at x hf.has_deriv_at).deriv + +end composition_vector + diff --git a/src/analysis/calculus/deriv/inv.lean b/src/analysis/calculus/deriv/inv.lean new file mode 100644 index 0000000000000..5895b4209ab95 --- /dev/null +++ b/src/analysis/calculus/deriv/inv.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2023 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.deriv.mul +import analysis.calculus.deriv.comp + +/-! +# Derivatives of `x ↦ x⁻¹` and `f x / g x` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove `(x⁻¹)' = -1 / x ^ 2`, `((f x)⁻¹)' = -f' x / (f x) ^ 2`, and +`(f x / g x)' = (f' x * g x - f x * g' x) / (g x) ^ 2` for different notions of derivative. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative +-/ + +universes u v w +open_locale classical topology big_operators filter ennreal +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L : filter 𝕜} + +section inverse +/-! ### Derivative of `x ↦ x⁻¹` -/ + +theorem has_strict_deriv_at_inv (hx : x ≠ 0) : has_strict_deriv_at has_inv.inv (-(x^2)⁻¹) x := +begin + suffices : (λ p : 𝕜 × 𝕜, (p.1 - p.2) * ((x * x)⁻¹ - (p.1 * p.2)⁻¹)) =o[𝓝 (x, x)] + (λ p, (p.1 - p.2) * 1), + { refine this.congr' _ (eventually_of_forall $ λ _, mul_one _), + refine eventually.mono ((is_open_ne.prod is_open_ne).mem_nhds ⟨hx, hx⟩) _, + rintro ⟨y, z⟩ ⟨hy, hz⟩, + simp only [mem_set_of_eq] at hy hz, -- hy : y ≠ 0, hz : z ≠ 0 + field_simp [hx, hy, hz], ring, }, + refine (is_O_refl (λ p : 𝕜 × 𝕜, p.1 - p.2) _).mul_is_o ((is_o_one_iff _).2 _), + rw [← sub_self (x * x)⁻¹], + exact tendsto_const_nhds.sub ((continuous_mul.tendsto (x, x)).inv₀ $ mul_ne_zero hx hx) +end + +theorem has_deriv_at_inv (x_ne_zero : x ≠ 0) : + has_deriv_at (λy, y⁻¹) (-(x^2)⁻¹) x := +(has_strict_deriv_at_inv x_ne_zero).has_deriv_at + +theorem has_deriv_within_at_inv (x_ne_zero : x ≠ 0) (s : set 𝕜) : + has_deriv_within_at (λx, x⁻¹) (-(x^2)⁻¹) s x := +(has_deriv_at_inv x_ne_zero).has_deriv_within_at + +lemma differentiable_at_inv : + differentiable_at 𝕜 (λx, x⁻¹) x ↔ x ≠ 0:= +⟨λ H, normed_field.continuous_at_inv.1 H.continuous_at, + λ H, (has_deriv_at_inv H).differentiable_at⟩ + +lemma differentiable_within_at_inv (x_ne_zero : x ≠ 0) : + differentiable_within_at 𝕜 (λx, x⁻¹) s x := +(differentiable_at_inv.2 x_ne_zero).differentiable_within_at + +lemma differentiable_on_inv : differentiable_on 𝕜 (λx:𝕜, x⁻¹) {x | x ≠ 0} := +λx hx, differentiable_within_at_inv hx + +lemma deriv_inv : deriv (λx, x⁻¹) x = -(x^2)⁻¹ := +begin + rcases eq_or_ne x 0 with rfl|hne, + { simp [deriv_zero_of_not_differentiable_at (mt differentiable_at_inv.1 (not_not.2 rfl))] }, + { exact (has_deriv_at_inv hne).deriv } +end + +@[simp] lemma deriv_inv' : deriv (λ x : 𝕜, x⁻¹) = λ x, -(x ^ 2)⁻¹ := funext (λ x, deriv_inv) + +lemma deriv_within_inv (x_ne_zero : x ≠ 0) (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, x⁻¹) s x = -(x^2)⁻¹ := +begin + rw differentiable_at.deriv_within (differentiable_at_inv.2 x_ne_zero) hxs, + exact deriv_inv +end + +lemma has_fderiv_at_inv (x_ne_zero : x ≠ 0) : + has_fderiv_at (λx, x⁻¹) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) : 𝕜 →L[𝕜] 𝕜) x := +has_deriv_at_inv x_ne_zero + +lemma has_fderiv_within_at_inv (x_ne_zero : x ≠ 0) : + has_fderiv_within_at (λx, x⁻¹) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) : 𝕜 →L[𝕜] 𝕜) s x := +(has_fderiv_at_inv x_ne_zero).has_fderiv_within_at + +lemma fderiv_inv : + fderiv 𝕜 (λx, x⁻¹) x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) := +by rw [← deriv_fderiv, deriv_inv] + +lemma fderiv_within_inv (x_ne_zero : x ≠ 0) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λx, x⁻¹) s x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (-(x^2)⁻¹) := +begin + rw differentiable_at.fderiv_within (differentiable_at_inv.2 x_ne_zero) hxs, + exact fderiv_inv +end + +variables {c : 𝕜 → 𝕜} {h : E → 𝕜} {c' : 𝕜} {z : E} {S : set E} + +lemma has_deriv_within_at.inv + (hc : has_deriv_within_at c c' s x) (hx : c x ≠ 0) : + has_deriv_within_at (λ y, (c y)⁻¹) (- c' / (c x)^2) s x := +begin + convert (has_deriv_at_inv hx).comp_has_deriv_within_at x hc, + field_simp +end + +lemma has_deriv_at.inv (hc : has_deriv_at c c' x) (hx : c x ≠ 0) : + has_deriv_at (λ y, (c y)⁻¹) (- c' / (c x)^2) x := +begin + rw ← has_deriv_within_at_univ at *, + exact hc.inv hx +end + +lemma differentiable_within_at.inv (hf : differentiable_within_at 𝕜 h S z) (hz : h z ≠ 0) : + differentiable_within_at 𝕜 (λx, (h x)⁻¹) S z := +(differentiable_at_inv.mpr hz).comp_differentiable_within_at z hf + +@[simp] lemma differentiable_at.inv (hf : differentiable_at 𝕜 h z) (hz : h z ≠ 0) : + differentiable_at 𝕜 (λx, (h x)⁻¹) z := +(differentiable_at_inv.mpr hz).comp z hf + +lemma differentiable_on.inv (hf : differentiable_on 𝕜 h S) (hz : ∀ x ∈ S, h x ≠ 0) : + differentiable_on 𝕜 (λx, (h x)⁻¹) S := +λx h, (hf x h).inv (hz x h) + +@[simp] lemma differentiable.inv (hf : differentiable 𝕜 h) (hz : ∀ x, h x ≠ 0) : + differentiable 𝕜 (λx, (h x)⁻¹) := +λx, (hf x).inv (hz x) + +lemma deriv_within_inv' (hc : differentiable_within_at 𝕜 c s x) (hx : c x ≠ 0) + (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, (c x)⁻¹) s x = - (deriv_within c s x) / (c x)^2 := +(hc.has_deriv_within_at.inv hx).deriv_within hxs + +@[simp] lemma deriv_inv'' (hc : differentiable_at 𝕜 c x) (hx : c x ≠ 0) : + deriv (λx, (c x)⁻¹) x = - (deriv c x) / (c x)^2 := +(hc.has_deriv_at.inv hx).deriv + +end inverse + +section division +/-! ### Derivative of `x ↦ c x / d x` -/ + +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + {c d : 𝕜 → 𝕜'} {c' d' : 𝕜'} + +lemma has_deriv_within_at.div + (hc : has_deriv_within_at c c' s x) (hd : has_deriv_within_at d d' s x) (hx : d x ≠ 0) : + has_deriv_within_at (λ y, c y / d y) ((c' * d x - c x * d') / (d x)^2) s x := +begin + convert hc.mul ((has_deriv_at_inv hx).comp_has_deriv_within_at x hd), + { simp only [div_eq_mul_inv] }, + { field_simp, ring } +end + +lemma has_strict_deriv_at.div (hc : has_strict_deriv_at c c' x) (hd : has_strict_deriv_at d d' x) + (hx : d x ≠ 0) : + has_strict_deriv_at (λ y, c y / d y) ((c' * d x - c x * d') / (d x)^2) x := +begin + convert hc.mul ((has_strict_deriv_at_inv hx).comp x hd), + { simp only [div_eq_mul_inv] }, + { field_simp, ring } +end + +lemma has_deriv_at.div (hc : has_deriv_at c c' x) (hd : has_deriv_at d d' x) (hx : d x ≠ 0) : + has_deriv_at (λ y, c y / d y) ((c' * d x - c x * d') / (d x)^2) x := +begin + rw ← has_deriv_within_at_univ at *, + exact hc.div hd hx +end + +lemma differentiable_within_at.div + (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) (hx : d x ≠ 0) : + differentiable_within_at 𝕜 (λx, c x / d x) s x := +((hc.has_deriv_within_at).div (hd.has_deriv_within_at) hx).differentiable_within_at + +@[simp] lemma differentiable_at.div + (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) (hx : d x ≠ 0) : + differentiable_at 𝕜 (λx, c x / d x) x := +((hc.has_deriv_at).div (hd.has_deriv_at) hx).differentiable_at + +lemma differentiable_on.div + (hc : differentiable_on 𝕜 c s) (hd : differentiable_on 𝕜 d s) (hx : ∀ x ∈ s, d x ≠ 0) : + differentiable_on 𝕜 (λx, c x / d x) s := +λx h, (hc x h).div (hd x h) (hx x h) + +@[simp] lemma differentiable.div + (hc : differentiable 𝕜 c) (hd : differentiable 𝕜 d) (hx : ∀ x, d x ≠ 0) : +differentiable 𝕜 (λx, c x / d x) := +λx, (hc x).div (hd x) (hx x) + +lemma deriv_within_div + (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) (hx : d x ≠ 0) + (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, c x / d x) s x + = ((deriv_within c s x) * d x - c x * (deriv_within d s x)) / (d x)^2 := +((hc.has_deriv_within_at).div (hd.has_deriv_within_at) hx).deriv_within hxs + +@[simp] lemma deriv_div + (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) (hx : d x ≠ 0) : + deriv (λx, c x / d x) x = ((deriv c x) * d x - c x * (deriv d x)) / (d x)^2 := +((hc.has_deriv_at).div (hd.has_deriv_at) hx).deriv + +end division diff --git a/src/analysis/calculus/deriv/inverse.lean b/src/analysis/calculus/deriv/inverse.lean new file mode 100644 index 0000000000000..6d1e9842d9a79 --- /dev/null +++ b/src/analysis/calculus/deriv/inverse.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2021 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.calculus.deriv.comp +import analysis.calculus.fderiv.equiv + +/-! +# Inverse function theorem - the easy half + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that `g' (f x) = (f' x)⁻¹` provided that `f` is strictly differentiable at +`x`, `f' x ≠ 0`, and `g` is a local left inverse of `f` that is continuous at `f x`. This is the +easy half of the inverse function theorem: the harder half states that `g` exists. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, inverse function +-/ + +universes u v w +open_locale classical topology big_operators filter ennreal +open filter asymptotics set + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +theorem has_strict_deriv_at.has_strict_fderiv_at_equiv {f : 𝕜 → 𝕜} {f' x : 𝕜} + (hf : has_strict_deriv_at f f' x) (hf' : f' ≠ 0) : + has_strict_fderiv_at f + (continuous_linear_equiv.units_equiv_aut 𝕜 (units.mk0 f' hf') : 𝕜 →L[𝕜] 𝕜) x := +hf + +theorem has_deriv_at.has_fderiv_at_equiv {f : 𝕜 → 𝕜} {f' x : 𝕜} (hf : has_deriv_at f f' x) + (hf' : f' ≠ 0) : + has_fderiv_at f (continuous_linear_equiv.units_equiv_aut 𝕜 (units.mk0 f' hf') : 𝕜 →L[𝕜] 𝕜) x := +hf + +/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an +invertible derivative `f'` at `g a` in the strict sense, then `g` has the derivative `f'⁻¹` at `a` +in the strict sense. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have an +inverse function. -/ +theorem has_strict_deriv_at.of_local_left_inverse {f g : 𝕜 → 𝕜} {f' a : 𝕜} + (hg : continuous_at g a) (hf : has_strict_deriv_at f f' (g a)) (hf' : f' ≠ 0) + (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : + has_strict_deriv_at g f'⁻¹ a := +(hf.has_strict_fderiv_at_equiv hf').of_local_left_inverse hg hfg + +/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has a +nonzero derivative `f'` at `f.symm a` in the strict sense, then `f.symm` has the derivative `f'⁻¹` +at `a` in the strict sense. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +lemma local_homeomorph.has_strict_deriv_at_symm (f : local_homeomorph 𝕜 𝕜) {a f' : 𝕜} + (ha : a ∈ f.target) (hf' : f' ≠ 0) (htff' : has_strict_deriv_at f f' (f.symm a)) : + has_strict_deriv_at f.symm f'⁻¹ a := +htff'.of_local_left_inverse (f.symm.continuous_at ha) hf' (f.eventually_right_inverse ha) + +/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an +invertible derivative `f'` at `g a`, then `g` has the derivative `f'⁻¹` at `a`. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +theorem has_deriv_at.of_local_left_inverse {f g : 𝕜 → 𝕜} {f' a : 𝕜} + (hg : continuous_at g a) (hf : has_deriv_at f f' (g a)) (hf' : f' ≠ 0) + (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : + has_deriv_at g f'⁻¹ a := +(hf.has_fderiv_at_equiv hf').of_local_left_inverse hg hfg + +/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has an +nonzero derivative `f'` at `f.symm a`, then `f.symm` has the derivative `f'⁻¹` at `a`. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +lemma local_homeomorph.has_deriv_at_symm (f : local_homeomorph 𝕜 𝕜) {a f' : 𝕜} + (ha : a ∈ f.target) (hf' : f' ≠ 0) (htff' : has_deriv_at f f' (f.symm a)) : + has_deriv_at f.symm f'⁻¹ a := +htff'.of_local_left_inverse (f.symm.continuous_at ha) hf' (f.eventually_right_inverse ha) + +lemma has_deriv_at.eventually_ne (h : has_deriv_at f f' x) (hf' : f' ≠ 0) : + ∀ᶠ z in 𝓝[≠] x, f z ≠ f x := +(has_deriv_at_iff_has_fderiv_at.1 h).eventually_ne + ⟨‖f'‖⁻¹, λ z, by field_simp [norm_smul, mt norm_eq_zero.1 hf']⟩ + +lemma has_deriv_at.tendsto_punctured_nhds (h : has_deriv_at f f' x) (hf' : f' ≠ 0) : + tendsto f (𝓝[≠] x) (𝓝[≠] (f x)) := +tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ + h.continuous_at.continuous_within_at (h.eventually_ne hf') + +theorem not_differentiable_within_at_of_local_left_inverse_has_deriv_within_at_zero + {f g : 𝕜 → 𝕜} {a : 𝕜} {s t : set 𝕜} (ha : a ∈ s) (hsu : unique_diff_within_at 𝕜 s a) + (hf : has_deriv_within_at f 0 t (g a)) (hst : maps_to g s t) (hfg : f ∘ g =ᶠ[𝓝[s] a] id) : + ¬differentiable_within_at 𝕜 g s a := +begin + intro hg, + have := (hf.comp a hg.has_deriv_within_at hst).congr_of_eventually_eq_of_mem hfg.symm ha, + simpa using hsu.eq_deriv _ this (has_deriv_within_at_id _ _) +end + +theorem not_differentiable_at_of_local_left_inverse_has_deriv_at_zero + {f g : 𝕜 → 𝕜} {a : 𝕜} (hf : has_deriv_at f 0 (g a)) (hfg : f ∘ g =ᶠ[𝓝 a] id) : + ¬differentiable_at 𝕜 g a := +begin + intro hg, + have := (hf.comp a hg.has_deriv_at).congr_of_eventually_eq hfg.symm, + simpa using this.unique (has_deriv_at_id a) +end diff --git a/src/analysis/calculus/deriv/linear.lean b/src/analysis/calculus/deriv/linear.lean new file mode 100644 index 0000000000000..45198e21eb2b0 --- /dev/null +++ b/src/analysis/calculus/deriv/linear.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2019 Gabriel Ebner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Ebner, Yury Kudryashov +-/ +import analysis.calculus.deriv.basic +import analysis.calculus.fderiv.linear + +/-! +# Derivatives of continuous linear maps from the base field + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that `f : 𝕜 →L[𝕜] E` (or `f : 𝕜 →ₗ[𝕜] E`) has derivative `f 1`. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, linear map +-/ + +universes u v w + +open_locale topology filter +open filter asymptotics set + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {x : 𝕜} +variables {s : set 𝕜} +variables {L : filter 𝕜} + +section continuous_linear_map +/-! ### Derivative of continuous linear maps -/ +variables (e : 𝕜 →L[𝕜] F) + +protected lemma continuous_linear_map.has_deriv_at_filter : has_deriv_at_filter e (e 1) x L := +e.has_fderiv_at_filter.has_deriv_at_filter + +protected lemma continuous_linear_map.has_strict_deriv_at : has_strict_deriv_at e (e 1) x := +e.has_strict_fderiv_at.has_strict_deriv_at + +protected lemma continuous_linear_map.has_deriv_at : has_deriv_at e (e 1) x := +e.has_deriv_at_filter + +protected lemma continuous_linear_map.has_deriv_within_at : has_deriv_within_at e (e 1) s x := +e.has_deriv_at_filter + +@[simp] protected lemma continuous_linear_map.deriv : deriv e x = e 1 := +e.has_deriv_at.deriv + +protected lemma continuous_linear_map.deriv_within (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within e s x = e 1 := +e.has_deriv_within_at.deriv_within hxs + +end continuous_linear_map + +section linear_map +/-! ### Derivative of bundled linear maps -/ +variables (e : 𝕜 →ₗ[𝕜] F) + +protected lemma linear_map.has_deriv_at_filter : has_deriv_at_filter e (e 1) x L := +e.to_continuous_linear_map₁.has_deriv_at_filter + +protected lemma linear_map.has_strict_deriv_at : has_strict_deriv_at e (e 1) x := +e.to_continuous_linear_map₁.has_strict_deriv_at + +protected lemma linear_map.has_deriv_at : has_deriv_at e (e 1) x := +e.has_deriv_at_filter + +protected lemma linear_map.has_deriv_within_at : has_deriv_within_at e (e 1) s x := +e.has_deriv_at_filter + +@[simp] protected lemma linear_map.deriv : deriv e x = e 1 := +e.has_deriv_at.deriv + +protected lemma linear_map.deriv_within (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within e s x = e 1 := +e.has_deriv_within_at.deriv_within hxs + +end linear_map + diff --git a/src/analysis/calculus/deriv/mul.lean b/src/analysis/calculus/deriv/mul.lean new file mode 100644 index 0000000000000..3a21aef1819eb --- /dev/null +++ b/src/analysis/calculus/deriv/mul.lean @@ -0,0 +1,401 @@ +/- +Copyright (c) 2019 Gabriel Ebner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Ebner, Anatole Dedecker, Yury Kudryashov +-/ +import analysis.calculus.deriv.basic +import analysis.calculus.fderiv.mul +import analysis.calculus.fderiv.add + +/-! +# Derivative of `f x * g x` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove formulas for `(f x * g x)'` and `(f x • g x)'`. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, multiplication +-/ + +universes u v w +noncomputable theory +open_locale classical topology big_operators filter ennreal +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +section smul + +/-! ### Derivative of the multiplication of a scalar function and a vector function -/ + +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {c : 𝕜 → 𝕜'} {c' : 𝕜'} + +theorem has_deriv_within_at.smul + (hc : has_deriv_within_at c c' s x) (hf : has_deriv_within_at f f' s x) : + has_deriv_within_at (λ y, c y • f y) (c x • f' + c' • f x) s x := +by simpa using (has_fderiv_within_at.smul hc hf).has_deriv_within_at + +theorem has_deriv_at.smul + (hc : has_deriv_at c c' x) (hf : has_deriv_at f f' x) : + has_deriv_at (λ y, c y • f y) (c x • f' + c' • f x) x := +begin + rw [← has_deriv_within_at_univ] at *, + exact hc.smul hf +end + +theorem has_strict_deriv_at.smul + (hc : has_strict_deriv_at c c' x) (hf : has_strict_deriv_at f f' x) : + has_strict_deriv_at (λ y, c y • f y) (c x • f' + c' • f x) x := +by simpa using (hc.smul hf).has_strict_deriv_at + +lemma deriv_within_smul (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hf : differentiable_within_at 𝕜 f s x) : + deriv_within (λ y, c y • f y) s x = c x • deriv_within f s x + (deriv_within c s x) • f x := +(hc.has_deriv_within_at.smul hf.has_deriv_within_at).deriv_within hxs + +lemma deriv_smul (hc : differentiable_at 𝕜 c x) (hf : differentiable_at 𝕜 f x) : + deriv (λ y, c y • f y) x = c x • deriv f x + (deriv c x) • f x := +(hc.has_deriv_at.smul hf.has_deriv_at).deriv + +theorem has_strict_deriv_at.smul_const + (hc : has_strict_deriv_at c c' x) (f : F) : + has_strict_deriv_at (λ y, c y • f) (c' • f) x := +begin + have := hc.smul (has_strict_deriv_at_const x f), + rwa [smul_zero, zero_add] at this, +end + +theorem has_deriv_within_at.smul_const + (hc : has_deriv_within_at c c' s x) (f : F) : + has_deriv_within_at (λ y, c y • f) (c' • f) s x := +begin + have := hc.smul (has_deriv_within_at_const x s f), + rwa [smul_zero, zero_add] at this +end + +theorem has_deriv_at.smul_const + (hc : has_deriv_at c c' x) (f : F) : + has_deriv_at (λ y, c y • f) (c' • f) x := +begin + rw [← has_deriv_within_at_univ] at *, + exact hc.smul_const f +end + +lemma deriv_within_smul_const (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (f : F) : + deriv_within (λ y, c y • f) s x = (deriv_within c s x) • f := +(hc.has_deriv_within_at.smul_const f).deriv_within hxs + +lemma deriv_smul_const (hc : differentiable_at 𝕜 c x) (f : F) : + deriv (λ y, c y • f) x = (deriv c x) • f := +(hc.has_deriv_at.smul_const f).deriv + +end smul + +section const_smul + +variables {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] + [has_continuous_const_smul R F] + +theorem has_strict_deriv_at.const_smul + (c : R) (hf : has_strict_deriv_at f f' x) : + has_strict_deriv_at (λ y, c • f y) (c • f') x := +by simpa using (hf.const_smul c).has_strict_deriv_at + +theorem has_deriv_at_filter.const_smul + (c : R) (hf : has_deriv_at_filter f f' x L) : + has_deriv_at_filter (λ y, c • f y) (c • f') x L := +by simpa using (hf.const_smul c).has_deriv_at_filter + +theorem has_deriv_within_at.const_smul + (c : R) (hf : has_deriv_within_at f f' s x) : + has_deriv_within_at (λ y, c • f y) (c • f') s x := +hf.const_smul c + +theorem has_deriv_at.const_smul (c : R) (hf : has_deriv_at f f' x) : + has_deriv_at (λ y, c • f y) (c • f') x := +hf.const_smul c + +lemma deriv_within_const_smul (hxs : unique_diff_within_at 𝕜 s x) + (c : R) (hf : differentiable_within_at 𝕜 f s x) : + deriv_within (λ y, c • f y) s x = c • deriv_within f s x := +(hf.has_deriv_within_at.const_smul c).deriv_within hxs + +lemma deriv_const_smul (c : R) (hf : differentiable_at 𝕜 f x) : + deriv (λ y, c • f y) x = c • deriv f x := +(hf.has_deriv_at.const_smul c).deriv + +end const_smul + +section mul +/-! ### Derivative of the multiplication of two functions -/ +variables {𝕜' 𝔸 : Type*} [normed_field 𝕜'] [normed_ring 𝔸] [normed_algebra 𝕜 𝕜'] + [normed_algebra 𝕜 𝔸] {c d : 𝕜 → 𝔸} {c' d' : 𝔸} {u v : 𝕜 → 𝕜'} + +theorem has_deriv_within_at.mul + (hc : has_deriv_within_at c c' s x) (hd : has_deriv_within_at d d' s x) : + has_deriv_within_at (λ y, c y * d y) (c' * d x + c x * d') s x := +begin + have := (has_fderiv_within_at.mul' hc hd).has_deriv_within_at, + rwa [continuous_linear_map.add_apply, continuous_linear_map.smul_apply, + continuous_linear_map.smul_right_apply, continuous_linear_map.smul_right_apply, + continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply, + one_smul, one_smul, add_comm] at this, +end + +theorem has_deriv_at.mul (hc : has_deriv_at c c' x) (hd : has_deriv_at d d' x) : + has_deriv_at (λ y, c y * d y) (c' * d x + c x * d') x := +begin + rw [← has_deriv_within_at_univ] at *, + exact hc.mul hd +end + +theorem has_strict_deriv_at.mul + (hc : has_strict_deriv_at c c' x) (hd : has_strict_deriv_at d d' x) : + has_strict_deriv_at (λ y, c y * d y) (c' * d x + c x * d') x := +begin + have := (has_strict_fderiv_at.mul' hc hd).has_strict_deriv_at, + rwa [continuous_linear_map.add_apply, continuous_linear_map.smul_apply, + continuous_linear_map.smul_right_apply, continuous_linear_map.smul_right_apply, + continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply, + one_smul, one_smul, add_comm] at this, +end + +lemma deriv_within_mul (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : + deriv_within (λ y, c y * d y) s x = deriv_within c s x * d x + c x * deriv_within d s x := +(hc.has_deriv_within_at.mul hd.has_deriv_within_at).deriv_within hxs + +@[simp] lemma deriv_mul (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : + deriv (λ y, c y * d y) x = deriv c x * d x + c x * deriv d x := +(hc.has_deriv_at.mul hd.has_deriv_at).deriv + +theorem has_deriv_within_at.mul_const (hc : has_deriv_within_at c c' s x) (d : 𝔸) : + has_deriv_within_at (λ y, c y * d) (c' * d) s x := +begin + convert hc.mul (has_deriv_within_at_const x s d), + rw [mul_zero, add_zero] +end + +theorem has_deriv_at.mul_const (hc : has_deriv_at c c' x) (d : 𝔸) : + has_deriv_at (λ y, c y * d) (c' * d) x := +begin + rw [← has_deriv_within_at_univ] at *, + exact hc.mul_const d +end + +theorem has_deriv_at_mul_const (c : 𝕜) : has_deriv_at (λ x, x * c) c x := +by simpa only [one_mul] using (has_deriv_at_id' x).mul_const c + +theorem has_strict_deriv_at.mul_const (hc : has_strict_deriv_at c c' x) (d : 𝔸) : + has_strict_deriv_at (λ y, c y * d) (c' * d) x := +begin + convert hc.mul (has_strict_deriv_at_const x d), + rw [mul_zero, add_zero] +end + +lemma deriv_within_mul_const (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (d : 𝔸) : + deriv_within (λ y, c y * d) s x = deriv_within c s x * d := +(hc.has_deriv_within_at.mul_const d).deriv_within hxs + +lemma deriv_mul_const (hc : differentiable_at 𝕜 c x) (d : 𝔸) : + deriv (λ y, c y * d) x = deriv c x * d := +(hc.has_deriv_at.mul_const d).deriv + +lemma deriv_mul_const_field (v : 𝕜') : + deriv (λ y, u y * v) x = deriv u x * v := +begin + by_cases hu : differentiable_at 𝕜 u x, + { exact deriv_mul_const hu v }, + { rw [deriv_zero_of_not_differentiable_at hu, zero_mul], + rcases eq_or_ne v 0 with rfl|hd, + { simp only [mul_zero, deriv_const] }, + { refine deriv_zero_of_not_differentiable_at (mt (λ H, _) hu), + simpa only [mul_inv_cancel_right₀ hd] using H.mul_const v⁻¹ } } +end + +@[simp] lemma deriv_mul_const_field' (v : 𝕜') : deriv (λ x, u x * v) = λ x, deriv u x * v := +funext $ λ _, deriv_mul_const_field v + +theorem has_deriv_within_at.const_mul (c : 𝔸) (hd : has_deriv_within_at d d' s x) : + has_deriv_within_at (λ y, c * d y) (c * d') s x := +begin + convert (has_deriv_within_at_const x s c).mul hd, + rw [zero_mul, zero_add] +end + +theorem has_deriv_at.const_mul (c : 𝔸) (hd : has_deriv_at d d' x) : + has_deriv_at (λ y, c * d y) (c * d') x := +begin + rw [← has_deriv_within_at_univ] at *, + exact hd.const_mul c +end + +theorem has_strict_deriv_at.const_mul (c : 𝔸) (hd : has_strict_deriv_at d d' x) : + has_strict_deriv_at (λ y, c * d y) (c * d') x := +begin + convert (has_strict_deriv_at_const _ _).mul hd, + rw [zero_mul, zero_add] +end + +lemma deriv_within_const_mul (hxs : unique_diff_within_at 𝕜 s x) + (c : 𝔸) (hd : differentiable_within_at 𝕜 d s x) : + deriv_within (λ y, c * d y) s x = c * deriv_within d s x := +(hd.has_deriv_within_at.const_mul c).deriv_within hxs + +lemma deriv_const_mul (c : 𝔸) (hd : differentiable_at 𝕜 d x) : + deriv (λ y, c * d y) x = c * deriv d x := +(hd.has_deriv_at.const_mul c).deriv + +lemma deriv_const_mul_field (u : 𝕜') : deriv (λ y, u * v y) x = u * deriv v x := +by simp only [mul_comm u, deriv_mul_const_field] + +@[simp] lemma deriv_const_mul_field' (u : 𝕜') : deriv (λ x, u * v x) = λ x, u * deriv v x := +funext (λ x, deriv_const_mul_field u) + +end mul + +section div + + +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + {c d : 𝕜 → 𝕜'} {c' d' : 𝕜'} + +lemma has_deriv_at.div_const (hc : has_deriv_at c c' x) (d : 𝕜') : + has_deriv_at (λ x, c x / d) (c' / d) x := +by simpa only [div_eq_mul_inv] using hc.mul_const d⁻¹ + +lemma has_deriv_within_at.div_const (hc : has_deriv_within_at c c' s x) (d : 𝕜') : + has_deriv_within_at (λ x, c x / d) (c' / d) s x := +by simpa only [div_eq_mul_inv] using hc.mul_const d⁻¹ + +lemma has_strict_deriv_at.div_const (hc : has_strict_deriv_at c c' x) (d : 𝕜') : + has_strict_deriv_at (λ x, c x / d) (c' / d) x := +by simpa only [div_eq_mul_inv] using hc.mul_const d⁻¹ + +lemma differentiable_within_at.div_const (hc : differentiable_within_at 𝕜 c s x) (d : 𝕜') : + differentiable_within_at 𝕜 (λx, c x / d) s x := +(hc.has_deriv_within_at.div_const _).differentiable_within_at + +@[simp] lemma differentiable_at.div_const (hc : differentiable_at 𝕜 c x) (d : 𝕜') : + differentiable_at 𝕜 (λ x, c x / d) x := +(hc.has_deriv_at.div_const _).differentiable_at + +lemma differentiable_on.div_const (hc : differentiable_on 𝕜 c s) (d : 𝕜') : + differentiable_on 𝕜 (λx, c x / d) s := +λ x hx, (hc x hx).div_const d + +@[simp] lemma differentiable.div_const (hc : differentiable 𝕜 c) (d : 𝕜') : + differentiable 𝕜 (λx, c x / d) := +λ x, (hc x).div_const d + +lemma deriv_within_div_const (hc : differentiable_within_at 𝕜 c s x) (d : 𝕜') + (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, c x / d) s x = (deriv_within c s x) / d := +by simp [div_eq_inv_mul, deriv_within_const_mul, hc, hxs] + +@[simp] lemma deriv_div_const (d : 𝕜') : + deriv (λx, c x / d) x = (deriv c x) / d := +by simp only [div_eq_mul_inv, deriv_mul_const_field] + +end div + +section clm_comp_apply +/-! ### Derivative of the pointwise composition/application of continuous linear maps -/ + +open continuous_linear_map + +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] {c : 𝕜 → F →L[𝕜] G} + {c' : F →L[𝕜] G} {d : 𝕜 → E →L[𝕜] F} {d' : E →L[𝕜] F} {u : 𝕜 → F} {u' : F} + +lemma has_strict_deriv_at.clm_comp (hc : has_strict_deriv_at c c' x) + (hd : has_strict_deriv_at d d' x) : + has_strict_deriv_at (λ y, (c y).comp (d y)) (c'.comp (d x) + (c x).comp d') x := +begin + have := (hc.has_strict_fderiv_at.clm_comp hd.has_strict_fderiv_at).has_strict_deriv_at, + rwa [add_apply, comp_apply, comp_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, + one_smul, add_comm] at this, +end + +lemma has_deriv_within_at.clm_comp (hc : has_deriv_within_at c c' s x) + (hd : has_deriv_within_at d d' s x) : + has_deriv_within_at (λ y, (c y).comp (d y)) (c'.comp (d x) + (c x).comp d') s x := +begin + have := (hc.has_fderiv_within_at.clm_comp hd.has_fderiv_within_at).has_deriv_within_at, + rwa [add_apply, comp_apply, comp_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, + one_smul, add_comm] at this, +end + +lemma has_deriv_at.clm_comp (hc : has_deriv_at c c' x) (hd : has_deriv_at d d' x) : + has_deriv_at (λ y, (c y).comp (d y)) + (c'.comp (d x) + (c x).comp d') x := +begin + rw [← has_deriv_within_at_univ] at *, + exact hc.clm_comp hd +end + +lemma deriv_within_clm_comp (hc : differentiable_within_at 𝕜 c s x) + (hd : differentiable_within_at 𝕜 d s x) (hxs : unique_diff_within_at 𝕜 s x): + deriv_within (λ y, (c y).comp (d y)) s x = + ((deriv_within c s x).comp (d x) + (c x).comp (deriv_within d s x)) := +(hc.has_deriv_within_at.clm_comp hd.has_deriv_within_at).deriv_within hxs + +lemma deriv_clm_comp (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : + deriv (λ y, (c y).comp (d y)) x = + ((deriv c x).comp (d x) + (c x).comp (deriv d x)) := +(hc.has_deriv_at.clm_comp hd.has_deriv_at).deriv + +lemma has_strict_deriv_at.clm_apply (hc : has_strict_deriv_at c c' x) + (hu : has_strict_deriv_at u u' x) : + has_strict_deriv_at (λ y, (c y) (u y)) (c' (u x) + c x u') x := +begin + have := (hc.has_strict_fderiv_at.clm_apply hu.has_strict_fderiv_at).has_strict_deriv_at, + rwa [add_apply, comp_apply, flip_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, + one_smul, add_comm] at this, +end + +lemma has_deriv_within_at.clm_apply (hc : has_deriv_within_at c c' s x) + (hu : has_deriv_within_at u u' s x) : + has_deriv_within_at (λ y, (c y) (u y)) (c' (u x) + c x u') s x := +begin + have := (hc.has_fderiv_within_at.clm_apply hu.has_fderiv_within_at).has_deriv_within_at, + rwa [add_apply, comp_apply, flip_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, + one_smul, add_comm] at this, +end + +lemma has_deriv_at.clm_apply (hc : has_deriv_at c c' x) (hu : has_deriv_at u u' x) : + has_deriv_at (λ y, (c y) (u y)) (c' (u x) + c x u') x := +begin + have := (hc.has_fderiv_at.clm_apply hu.has_fderiv_at).has_deriv_at, + rwa [add_apply, comp_apply, flip_apply, smul_right_apply, smul_right_apply, one_apply, one_smul, + one_smul, add_comm] at this, +end + +lemma deriv_within_clm_apply (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hu : differentiable_within_at 𝕜 u s x) : + deriv_within (λ y, (c y) (u y)) s x = (deriv_within c s x (u x) + c x (deriv_within u s x)) := +(hc.has_deriv_within_at.clm_apply hu.has_deriv_within_at).deriv_within hxs + +lemma deriv_clm_apply (hc : differentiable_at 𝕜 c x) (hu : differentiable_at 𝕜 u x) : + deriv (λ y, (c y) (u y)) x = (deriv c x (u x) + c x (deriv u x)) := +(hc.has_deriv_at.clm_apply hu.has_deriv_at).deriv + +end clm_comp_apply + diff --git a/src/analysis/calculus/deriv/polynomial.lean b/src/analysis/calculus/deriv/polynomial.lean new file mode 100644 index 0000000000000..9f1d651ae5b2c --- /dev/null +++ b/src/analysis/calculus/deriv/polynomial.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2019 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel, Eric Wieser +-/ +import analysis.calculus.deriv.pow +import analysis.calculus.deriv.add +import data.polynomial.algebra_map +import data.polynomial.derivative + +/-! +# Derivatives of polynomials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that derivatives of polynomials in the analysis sense agree with their +derivatives in the algebraic sense. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## TODO + +* Add results about multivariable polynomials. +* Generalize some (most?) results to an algebra over the base field. + +## Keywords + +derivative, polynomial +-/ + +universes u v w +open_locale classical topology big_operators filter ennreal polynomial +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +namespace polynomial +/-! ### Derivative of a polynomial -/ + +variables {R : Type*} [comm_semiring R] [algebra R 𝕜] +variables (p : 𝕜[X]) (q : R[X]) + +/-- The derivative (in the analysis sense) of a polynomial `p` is given by `p.derivative`. -/ +protected lemma has_strict_deriv_at (x : 𝕜) : + has_strict_deriv_at (λx, p.eval x) (p.derivative.eval x) x := +begin + induction p using polynomial.induction_on', + case h_add : p q hp hq { simpa using hp.add hq }, + case h_monomial : n a { simpa [mul_assoc] using (has_strict_deriv_at_pow n x).const_mul a } +end + +protected lemma has_strict_deriv_at_aeval (x : 𝕜) : + has_strict_deriv_at (λx, aeval x q) (aeval x q.derivative) x := +by simpa only [aeval_def, eval₂_eq_eval_map, derivative_map] + using (q.map (algebra_map R 𝕜)).has_strict_deriv_at x + +/-- The derivative (in the analysis sense) of a polynomial `p` is given by `p.derivative`. -/ +protected lemma has_deriv_at (x : 𝕜) : has_deriv_at (λx, p.eval x) (p.derivative.eval x) x := +(p.has_strict_deriv_at x).has_deriv_at + +protected lemma has_deriv_at_aeval (x : 𝕜) : + has_deriv_at (λx, aeval x q) (aeval x q.derivative) x := +(q.has_strict_deriv_at_aeval x).has_deriv_at + +protected theorem has_deriv_within_at (x : 𝕜) (s : set 𝕜) : + has_deriv_within_at (λx, p.eval x) (p.derivative.eval x) s x := +(p.has_deriv_at x).has_deriv_within_at + +protected theorem has_deriv_within_at_aeval (x : 𝕜) (s : set 𝕜) : + has_deriv_within_at (λx, aeval x q) (aeval x q.derivative) s x := +(q.has_deriv_at_aeval x).has_deriv_within_at + +protected lemma differentiable_at : differentiable_at 𝕜 (λx, p.eval x) x := +(p.has_deriv_at x).differentiable_at + +protected lemma differentiable_at_aeval : differentiable_at 𝕜 (λx, aeval x q) x := +(q.has_deriv_at_aeval x).differentiable_at + +protected lemma differentiable_within_at : differentiable_within_at 𝕜 (λx, p.eval x) s x := +p.differentiable_at.differentiable_within_at + +protected lemma differentiable_within_at_aeval : differentiable_within_at 𝕜 (λx, aeval x q) s x := +q.differentiable_at_aeval.differentiable_within_at + +protected lemma differentiable : differentiable 𝕜 (λx, p.eval x) := +λx, p.differentiable_at + +protected lemma differentiable_aeval : differentiable 𝕜 (λ x : 𝕜, aeval x q) := +λx, q.differentiable_at_aeval + +protected lemma differentiable_on : differentiable_on 𝕜 (λx, p.eval x) s := +p.differentiable.differentiable_on + +protected lemma differentiable_on_aeval : differentiable_on 𝕜 (λx, aeval x q) s := +q.differentiable_aeval.differentiable_on + +@[simp] protected lemma deriv : deriv (λx, p.eval x) x = p.derivative.eval x := +(p.has_deriv_at x).deriv + +@[simp] protected lemma deriv_aeval : deriv (λx, aeval x q) x = aeval x q.derivative := +(q.has_deriv_at_aeval x).deriv + +protected lemma deriv_within (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, p.eval x) s x = p.derivative.eval x := +begin + rw differentiable_at.deriv_within p.differentiable_at hxs, + exact p.deriv +end + +protected lemma deriv_within_aeval (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, aeval x q) s x = aeval x q.derivative := +by simpa only [aeval_def, eval₂_eq_eval_map, derivative_map] + using (q.map (algebra_map R 𝕜)).deriv_within hxs + +protected lemma has_fderiv_at (x : 𝕜) : + has_fderiv_at (λx, p.eval x) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x)) x := +p.has_deriv_at x + +protected lemma has_fderiv_at_aeval (x : 𝕜) : + has_fderiv_at (λx, aeval x q) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (aeval x q.derivative)) x := +q.has_deriv_at_aeval x + +protected lemma has_fderiv_within_at (x : 𝕜) : + has_fderiv_within_at (λx, p.eval x) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x)) s x := +(p.has_fderiv_at x).has_fderiv_within_at + +protected lemma has_fderiv_within_at_aeval (x : 𝕜) : + has_fderiv_within_at (λx, aeval x q) (smul_right (1 : 𝕜 →L[𝕜] 𝕜) (aeval x q.derivative)) s x := +(q.has_fderiv_at_aeval x).has_fderiv_within_at + +@[simp] protected lemma fderiv : + fderiv 𝕜 (λx, p.eval x) x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x) := +(p.has_fderiv_at x).fderiv + +@[simp] protected lemma fderiv_aeval : + fderiv 𝕜 (λx, aeval x q) x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (aeval x q.derivative) := +(q.has_fderiv_at_aeval x).fderiv + +protected lemma fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λx, p.eval x) s x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (p.derivative.eval x) := +(p.has_fderiv_within_at x).fderiv_within hxs + +protected lemma fderiv_within_aeval (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λx, aeval x q) s x = smul_right (1 : 𝕜 →L[𝕜] 𝕜) (aeval x q.derivative) := +(q.has_fderiv_within_at_aeval x).fderiv_within hxs + +end polynomial + diff --git a/src/analysis/calculus/deriv/pow.lean b/src/analysis/calculus/deriv/pow.lean new file mode 100644 index 0000000000000..8a35ec8a49940 --- /dev/null +++ b/src/analysis/calculus/deriv/pow.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2019 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.calculus.deriv.mul +import analysis.calculus.deriv.comp + +/-! +# Derivative of `(f x) ^ n`, `n : ℕ` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that `(x ^ n)' = n * x ^ (n - 1)`, where `n` is a natural number. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, power +-/ + +universes u v w +open_locale classical topology big_operators filter ennreal +open filter asymptotics set + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +/-! ### Derivative of `x ↦ x^n` for `n : ℕ` -/ +variables {c : 𝕜 → 𝕜} {c' : 𝕜} +variable (n : ℕ) + +lemma has_strict_deriv_at_pow : ∀ (n : ℕ) (x : 𝕜), + has_strict_deriv_at (λx, x^n) ((n : 𝕜) * x^(n-1)) x +| 0 x := by simp [has_strict_deriv_at_const] +| 1 x := by simpa using has_strict_deriv_at_id x +| (n + 1 + 1) x := by simpa [pow_succ', add_mul, mul_assoc] + using (has_strict_deriv_at_pow (n + 1) x).mul (has_strict_deriv_at_id x) + +lemma has_deriv_at_pow (n : ℕ) (x : 𝕜) : has_deriv_at (λx, x^n) ((n : 𝕜) * x^(n-1)) x := +(has_strict_deriv_at_pow n x).has_deriv_at + +theorem has_deriv_within_at_pow (n : ℕ) (x : 𝕜) (s : set 𝕜) : + has_deriv_within_at (λx, x^n) ((n : 𝕜) * x^(n-1)) s x := +(has_deriv_at_pow n x).has_deriv_within_at + +lemma differentiable_at_pow : differentiable_at 𝕜 (λx, x^n) x := +(has_deriv_at_pow n x).differentiable_at + +lemma differentiable_within_at_pow : differentiable_within_at 𝕜 (λx, x^n) s x := +(differentiable_at_pow n).differentiable_within_at + +lemma differentiable_pow : differentiable 𝕜 (λx:𝕜, x^n) := +λ x, differentiable_at_pow n + +lemma differentiable_on_pow : differentiable_on 𝕜 (λx, x^n) s := +(differentiable_pow n).differentiable_on + +lemma deriv_pow : deriv (λ x, x^n) x = (n : 𝕜) * x^(n-1) := +(has_deriv_at_pow n x).deriv + +@[simp] lemma deriv_pow' : deriv (λ x, x^n) = λ x, (n : 𝕜) * x^(n-1) := +funext $ λ x, deriv_pow n + +lemma deriv_within_pow (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, x^n) s x = (n : 𝕜) * x^(n-1) := +(has_deriv_within_at_pow n x s).deriv_within hxs + +lemma has_deriv_within_at.pow (hc : has_deriv_within_at c c' s x) : + has_deriv_within_at (λ y, (c y)^n) ((n : 𝕜) * (c x)^(n-1) * c') s x := +(has_deriv_at_pow n (c x)).comp_has_deriv_within_at x hc + +lemma has_deriv_at.pow (hc : has_deriv_at c c' x) : + has_deriv_at (λ y, (c y)^n) ((n : 𝕜) * (c x)^(n-1) * c') x := +by { rw ← has_deriv_within_at_univ at *, exact hc.pow n } + +lemma deriv_within_pow' (hc : differentiable_within_at 𝕜 c s x) + (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λx, (c x)^n) s x = (n : 𝕜) * (c x)^(n-1) * (deriv_within c s x) := +(hc.has_deriv_within_at.pow n).deriv_within hxs + +@[simp] lemma deriv_pow'' (hc : differentiable_at 𝕜 c x) : + deriv (λx, (c x)^n) x = (n : 𝕜) * (c x)^(n-1) * (deriv c x) := +(hc.has_deriv_at.pow n).deriv diff --git a/src/analysis/calculus/deriv/prod.lean b/src/analysis/calculus/deriv/prod.lean new file mode 100644 index 0000000000000..70b478ea5c399 --- /dev/null +++ b/src/analysis/calculus/deriv/prod.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2019 Gabriel Ebner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Gabriel Ebner, Yury Kudryashov +-/ +import analysis.calculus.deriv.basic +import analysis.calculus.fderiv.prod + +/-! +# Derivatives of functions taking values in product types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove lemmas about derivatives of functions `f : 𝕜 → E × F` and of functions +`f : 𝕜 → (Π i, E i)`. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative +-/ + +universes u v w +open_locale classical topology big_operators filter +open filter asymptotics set + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +section cartesian_product +/-! ### Derivative of the cartesian product of two functions -/ + +variables {G : Type w} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {f₂ : 𝕜 → G} {f₂' : G} + +lemma has_deriv_at_filter.prod + (hf₁ : has_deriv_at_filter f₁ f₁' x L) (hf₂ : has_deriv_at_filter f₂ f₂' x L) : + has_deriv_at_filter (λ x, (f₁ x, f₂ x)) (f₁', f₂') x L := +hf₁.prod hf₂ + +lemma has_deriv_within_at.prod + (hf₁ : has_deriv_within_at f₁ f₁' s x) (hf₂ : has_deriv_within_at f₂ f₂' s x) : + has_deriv_within_at (λ x, (f₁ x, f₂ x)) (f₁', f₂') s x := +hf₁.prod hf₂ + +lemma has_deriv_at.prod (hf₁ : has_deriv_at f₁ f₁' x) (hf₂ : has_deriv_at f₂ f₂' x) : + has_deriv_at (λ x, (f₁ x, f₂ x)) (f₁', f₂') x := +hf₁.prod hf₂ + +lemma has_strict_deriv_at.prod (hf₁ : has_strict_deriv_at f₁ f₁' x) + (hf₂ : has_strict_deriv_at f₂ f₂' x) : + has_strict_deriv_at (λ x, (f₁ x, f₂ x)) (f₁', f₂') x := +hf₁.prod hf₂ + +end cartesian_product + +section pi + +/-! ### Derivatives of functions `f : 𝕜 → Π i, E i` -/ + +variables {ι : Type*} [fintype ι] {E' : ι → Type*} [Π i, normed_add_comm_group (E' i)] + [Π i, normed_space 𝕜 (E' i)] {φ : 𝕜 → Π i, E' i} {φ' : Π i, E' i} + +@[simp] lemma has_strict_deriv_at_pi : + has_strict_deriv_at φ φ' x ↔ ∀ i, has_strict_deriv_at (λ x, φ x i) (φ' i) x := +has_strict_fderiv_at_pi' + +@[simp] lemma has_deriv_at_filter_pi : + has_deriv_at_filter φ φ' x L ↔ + ∀ i, has_deriv_at_filter (λ x, φ x i) (φ' i) x L := +has_fderiv_at_filter_pi' + +lemma has_deriv_at_pi : + has_deriv_at φ φ' x ↔ ∀ i, has_deriv_at (λ x, φ x i) (φ' i) x:= +has_deriv_at_filter_pi + +lemma has_deriv_within_at_pi : + has_deriv_within_at φ φ' s x ↔ ∀ i, has_deriv_within_at (λ x, φ x i) (φ' i) s x:= +has_deriv_at_filter_pi + +lemma deriv_within_pi (h : ∀ i, differentiable_within_at 𝕜 (λ x, φ x i) s x) + (hs : unique_diff_within_at 𝕜 s x) : + deriv_within φ s x = λ i, deriv_within (λ x, φ x i) s x := +(has_deriv_within_at_pi.2 (λ i, (h i).has_deriv_within_at)).deriv_within hs + +lemma deriv_pi (h : ∀ i, differentiable_at 𝕜 (λ x, φ x i) x) : + deriv φ x = λ i, deriv (λ x, φ x i) x := +(has_deriv_at_pi.2 (λ i, (h i).has_deriv_at)).deriv + +end pi + diff --git a/src/analysis/calculus/deriv/slope.lean b/src/analysis/calculus/deriv/slope.lean new file mode 100644 index 0000000000000..659b3e4190984 --- /dev/null +++ b/src/analysis/calculus/deriv/slope.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2019 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.calculus.deriv.basic +import linear_algebra.affine_space.slope + +/-! +# Derivative as the limit of the slope + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we relate the derivative of a function with its definition from a standard +undergraduate course as the limit of the slope `(f y - f x) / (y - x)` as `y` tends to `𝓝[≠] x`. +Since we are talking about functions taking values in a normed space instead of the base field, we +use `slope f x y = (y - x)⁻¹ • (f y - f x)` instead of division. + +We also prove some estimates on the upper/lower limits of the slope in terms of the derivative. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, slope +-/ + +universes u v w +noncomputable theory +open_locale classical topology big_operators filter ennreal +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + +section normed_field + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +/-- If the domain has dimension one, then Fréchet derivative is equivalent to the classical +definition with a limit. In this version we have to take the limit along the subset `-{x}`, +because for `y=x` the slope equals zero due to the convention `0⁻¹=0`. -/ +lemma has_deriv_at_filter_iff_tendsto_slope {x : 𝕜} {L : filter 𝕜} : + has_deriv_at_filter f f' x L ↔ tendsto (slope f x) (L ⊓ 𝓟 {x}ᶜ) (𝓝 f') := +begin + conv_lhs { simp only [has_deriv_at_filter_iff_tendsto, (norm_inv _).symm, + (norm_smul _ _).symm, tendsto_zero_iff_norm_tendsto_zero.symm] }, + conv_rhs { rw [← nhds_translation_sub f', tendsto_comap_iff] }, + refine (tendsto_inf_principal_nhds_iff_of_forall_eq $ by simp).symm.trans (tendsto_congr' _), + refine (eventually_principal.2 $ λ z hz, _).filter_mono inf_le_right, + simp only [(∘)], + rw [smul_sub, ← mul_smul, inv_mul_cancel (sub_ne_zero.2 hz), one_smul, slope_def_module] +end + +lemma has_deriv_within_at_iff_tendsto_slope : + has_deriv_within_at f f' s x ↔ tendsto (slope f x) (𝓝[s \ {x}] x) (𝓝 f') := +begin + simp only [has_deriv_within_at, nhds_within, diff_eq, inf_assoc.symm, inf_principal.symm], + exact has_deriv_at_filter_iff_tendsto_slope +end + +lemma has_deriv_within_at_iff_tendsto_slope' (hs : x ∉ s) : + has_deriv_within_at f f' s x ↔ tendsto (slope f x) (𝓝[s] x) (𝓝 f') := +begin + convert ← has_deriv_within_at_iff_tendsto_slope, + exact diff_singleton_eq_self hs +end + +lemma has_deriv_at_iff_tendsto_slope : + has_deriv_at f f' x ↔ tendsto (slope f x) (𝓝[≠] x) (𝓝 f') := +has_deriv_at_filter_iff_tendsto_slope + +end normed_field + +/-! ### Upper estimates on liminf and limsup -/ + +section real + +variables {f : ℝ → ℝ} {f' : ℝ} {s : set ℝ} {x : ℝ} {r : ℝ} + +lemma has_deriv_within_at.limsup_slope_le (hf : has_deriv_within_at f f' s x) (hr : f' < r) : + ∀ᶠ z in 𝓝[s \ {x}] x, slope f x z < r := +has_deriv_within_at_iff_tendsto_slope.1 hf (is_open.mem_nhds is_open_Iio hr) + +lemma has_deriv_within_at.limsup_slope_le' (hf : has_deriv_within_at f f' s x) + (hs : x ∉ s) (hr : f' < r) : + ∀ᶠ z in 𝓝[s] x, slope f x z < r := +(has_deriv_within_at_iff_tendsto_slope' hs).1 hf (is_open.mem_nhds is_open_Iio hr) + +lemma has_deriv_within_at.liminf_right_slope_le + (hf : has_deriv_within_at f f' (Ici x) x) (hr : f' < r) : + ∃ᶠ z in 𝓝[>] x, slope f x z < r := +(hf.Ioi_of_Ici.limsup_slope_le' (lt_irrefl x) hr).frequently + +end real + +section real_space + +open metric + +variables {E : Type u} [normed_add_comm_group E] [normed_space ℝ E] {f : ℝ → E} {f' : E} {s : set ℝ} + {x r : ℝ} + +/-- If `f` has derivative `f'` within `s` at `x`, then for any `r > ‖f'‖` the ratio +`‖f z - f x‖ / ‖z - x‖` is less than `r` in some neighborhood of `x` within `s`. +In other words, the limit superior of this ratio as `z` tends to `x` along `s` +is less than or equal to `‖f'‖`. -/ +lemma has_deriv_within_at.limsup_norm_slope_le + (hf : has_deriv_within_at f f' s x) (hr : ‖f'‖ < r) : + ∀ᶠ z in 𝓝[s] x, ‖z - x‖⁻¹ * ‖f z - f x‖ < r := +begin + have hr₀ : 0 < r, from lt_of_le_of_lt (norm_nonneg f') hr, + have A : ∀ᶠ z in 𝓝[s \ {x}] x, ‖(z - x)⁻¹ • (f z - f x)‖ ∈ Iio r, + from (has_deriv_within_at_iff_tendsto_slope.1 hf).norm (is_open.mem_nhds is_open_Iio hr), + have B : ∀ᶠ z in 𝓝[{x}] x, ‖(z - x)⁻¹ • (f z - f x)‖ ∈ Iio r, + from mem_of_superset self_mem_nhds_within + (singleton_subset_iff.2 $ by simp [hr₀]), + have C := mem_sup.2 ⟨A, B⟩, + rw [← nhds_within_union, diff_union_self, nhds_within_union, mem_sup] at C, + filter_upwards [C.1], + simp only [norm_smul, mem_Iio, norm_inv], + exact λ _, id +end + +/-- If `f` has derivative `f'` within `s` at `x`, then for any `r > ‖f'‖` the ratio +`(‖f z‖ - ‖f x‖) / ‖z - x‖` is less than `r` in some neighborhood of `x` within `s`. +In other words, the limit superior of this ratio as `z` tends to `x` along `s` +is less than or equal to `‖f'‖`. + +This lemma is a weaker version of `has_deriv_within_at.limsup_norm_slope_le` +where `‖f z‖ - ‖f x‖` is replaced by `‖f z - f x‖`. -/ +lemma has_deriv_within_at.limsup_slope_norm_le + (hf : has_deriv_within_at f f' s x) (hr : ‖f'‖ < r) : + ∀ᶠ z in 𝓝[s] x, ‖z - x‖⁻¹ * (‖f z‖ - ‖f x‖) < r := +begin + apply (hf.limsup_norm_slope_le hr).mono, + assume z hz, + refine lt_of_le_of_lt (mul_le_mul_of_nonneg_left (norm_sub_norm_le _ _) _) hz, + exact inv_nonneg.2 (norm_nonneg _) +end + +/-- If `f` has derivative `f'` within `(x, +∞)` at `x`, then for any `r > ‖f'‖` the ratio +`‖f z - f x‖ / ‖z - x‖` is frequently less than `r` as `z → x+0`. +In other words, the limit inferior of this ratio as `z` tends to `x+0` +is less than or equal to `‖f'‖`. See also `has_deriv_within_at.limsup_norm_slope_le` +for a stronger version using limit superior and any set `s`. -/ +lemma has_deriv_within_at.liminf_right_norm_slope_le + (hf : has_deriv_within_at f f' (Ici x) x) (hr : ‖f'‖ < r) : + ∃ᶠ z in 𝓝[>] x, ‖z - x‖⁻¹ * ‖f z - f x‖ < r := +(hf.Ioi_of_Ici.limsup_norm_slope_le hr).frequently + +/-- If `f` has derivative `f'` within `(x, +∞)` at `x`, then for any `r > ‖f'‖` the ratio +`(‖f z‖ - ‖f x‖) / (z - x)` is frequently less than `r` as `z → x+0`. +In other words, the limit inferior of this ratio as `z` tends to `x+0` +is less than or equal to `‖f'‖`. + +See also + +* `has_deriv_within_at.limsup_norm_slope_le` for a stronger version using + limit superior and any set `s`; +* `has_deriv_within_at.liminf_right_norm_slope_le` for a stronger version using + `‖f z - f x‖` instead of `‖f z‖ - ‖f x‖`. -/ +lemma has_deriv_within_at.liminf_right_slope_norm_le + (hf : has_deriv_within_at f f' (Ici x) x) (hr : ‖f'‖ < r) : + ∃ᶠ z in 𝓝[>] x, (z - x)⁻¹ * (‖f z‖ - ‖f x‖) < r := +begin + have := (hf.Ioi_of_Ici.limsup_slope_norm_le hr).frequently, + refine this.mp (eventually.mono self_mem_nhds_within _), + assume z hxz hz, + rwa [real.norm_eq_abs, abs_of_pos (sub_pos_of_lt hxz)] at hz +end + +end real_space diff --git a/src/analysis/calculus/deriv/star.lean b/src/analysis/calculus/deriv/star.lean new file mode 100644 index 0000000000000..1f75c711e9ad2 --- /dev/null +++ b/src/analysis/calculus/deriv/star.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import analysis.calculus.deriv.basic +import analysis.calculus.fderiv.star + +/-! +# Star operations on derivatives + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains the usual formulas (and existence assertions) for the derivative of the star +operation. Note that these only apply when the field that the derivative is respect to has a trivial +star operation; which as should be expected rules out `𝕜 = ℂ`. +-/ + +universes u v w +noncomputable theory +open_locale classical topology big_operators filter ennreal +open filter asymptotics set +open continuous_linear_map (smul_right smul_right_one_eq_iff) + + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {F : Type v} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type w} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {f f₀ f₁ g : 𝕜 → F} +variables {f' f₀' f₁' g' : F} +variables {x : 𝕜} +variables {s t : set 𝕜} +variables {L L₁ L₂ : filter 𝕜} + +section star +/-! ### Derivative of `x ↦ star x` -/ + +variables [star_ring 𝕜] [has_trivial_star 𝕜] [star_add_monoid F] [has_continuous_star F] +variable [star_module 𝕜 F] + +protected theorem has_deriv_at_filter.star (h : has_deriv_at_filter f f' x L) : + has_deriv_at_filter (λ x, star (f x)) (star f') x L := +by simpa using h.star.has_deriv_at_filter + +protected theorem has_deriv_within_at.star (h : has_deriv_within_at f f' s x) : + has_deriv_within_at (λ x, star (f x)) (star f') s x := +h.star + +protected theorem has_deriv_at.star (h : has_deriv_at f f' x) : + has_deriv_at (λ x, star (f x)) (star f') x := +h.star + +protected theorem has_strict_deriv_at.star (h : has_strict_deriv_at f f' x) : + has_strict_deriv_at (λ x, star (f x)) (star f') x := +by simpa using h.star.has_strict_deriv_at + +protected lemma deriv_within.star (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λ y, star (f y)) s x = star (deriv_within f s x) := +fun_like.congr_fun (fderiv_within_star hxs) _ + +protected lemma deriv.star : deriv (λ y, star (f y)) x = star (deriv f x) := +fun_like.congr_fun fderiv_star _ + +@[simp] protected lemma deriv.star' : deriv (λ y, star (f y)) = (λ x, star (deriv f x)) := +funext $ λ x, deriv.star + +end star diff --git a/src/analysis/calculus/deriv/support.lean b/src/analysis/calculus/deriv/support.lean new file mode 100644 index 0000000000000..adb9f0637a7ad --- /dev/null +++ b/src/analysis/calculus/deriv/support.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2022 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import analysis.calculus.deriv.basic + +/-! +# Support of the derivative of a function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that the (topological) support of a function includes the support of its +derivative. As a corollary, we show that the derivative of a function with compact support has +compact support. + +## Keywords + +derivative, support +-/ + +universes u v + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {E : Type v} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {f : 𝕜 → E} + +/-! ### Support of derivatives -/ + +section support + +open function + +lemma support_deriv_subset : support (deriv f) ⊆ tsupport f := +begin + intros x, + rw [← not_imp_not], + intro h2x, + rw [not_mem_tsupport_iff_eventually_eq] at h2x, + exact nmem_support.mpr (h2x.deriv_eq.trans (deriv_const x 0)) +end + +lemma has_compact_support.deriv (hf : has_compact_support f) : has_compact_support (deriv f) := +hf.mono' support_deriv_subset + +end support diff --git a/src/analysis/calculus/deriv/zpow.lean b/src/analysis/calculus/deriv/zpow.lean new file mode 100644 index 0000000000000..507b92f86380a --- /dev/null +++ b/src/analysis/calculus/deriv/zpow.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.deriv.pow +import analysis.calculus.deriv.inv + +/-! +# Derivatives of `x ^ m`, `m : ℤ` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove theorems about (iterated) derivatives of `x ^ m`, `m : ℤ`. + +For a more detailed overview of one-dimensional derivatives in mathlib, see the module docstring of +`analysis/calculus/deriv/basic`. + +## Keywords + +derivative, power +-/ + +universes u v w +open_locale classical topology big_operators filter +open filter asymptotics set + +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +variables {E : Type v} [normed_add_comm_group E] [normed_space 𝕜 E] + +variables {x : 𝕜} +variables {s : set 𝕜} +variables {m : ℤ} + +/-! ### Derivative of `x ↦ x^m` for `m : ℤ` -/ + +lemma has_strict_deriv_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) : + has_strict_deriv_at (λx, x^m) ((m : 𝕜) * x^(m-1)) x := +begin + have : ∀ m : ℤ, 0 < m → has_strict_deriv_at (λx, x^m) ((m:𝕜) * x^(m-1)) x, + { assume m hm, + lift m to ℕ using (le_of_lt hm), + simp only [zpow_coe_nat, int.cast_coe_nat], + convert has_strict_deriv_at_pow _ _ using 2, + rw [← int.coe_nat_one, ← int.coe_nat_sub, zpow_coe_nat], + norm_cast at hm, + exact nat.succ_le_of_lt hm }, + rcases lt_trichotomy m 0 with hm|hm|hm, + { have hx : x ≠ 0, from h.resolve_right hm.not_le, + have := (has_strict_deriv_at_inv _).scomp _ (this (-m) (neg_pos.2 hm)); + [skip, exact zpow_ne_zero_of_ne_zero hx _], + simp only [(∘), zpow_neg, one_div, inv_inv, smul_eq_mul] at this, + convert this using 1, + rw [sq, mul_inv, inv_inv, int.cast_neg, neg_mul, neg_mul_neg, + ← zpow_add₀ hx, mul_assoc, ← zpow_add₀ hx], congr, abel }, + { simp only [hm, zpow_zero, int.cast_zero, zero_mul, has_strict_deriv_at_const] }, + { exact this m hm } +end + +lemma has_deriv_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) : + has_deriv_at (λx, x^m) ((m : 𝕜) * x^(m-1)) x := +(has_strict_deriv_at_zpow m x h).has_deriv_at + +theorem has_deriv_within_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) (s : set 𝕜) : + has_deriv_within_at (λx, x^m) ((m : 𝕜) * x^(m-1)) s x := +(has_deriv_at_zpow m x h).has_deriv_within_at + +lemma differentiable_at_zpow : differentiable_at 𝕜 (λx, x^m) x ↔ x ≠ 0 ∨ 0 ≤ m := +⟨λ H, normed_field.continuous_at_zpow.1 H.continuous_at, + λ H, (has_deriv_at_zpow m x H).differentiable_at⟩ + +lemma differentiable_within_at_zpow (m : ℤ) (x : 𝕜) (h : x ≠ 0 ∨ 0 ≤ m) : + differentiable_within_at 𝕜 (λx, x^m) s x := +(differentiable_at_zpow.mpr h).differentiable_within_at + +lemma differentiable_on_zpow (m : ℤ) (s : set 𝕜) (h : (0 : 𝕜) ∉ s ∨ 0 ≤ m) : + differentiable_on 𝕜 (λx, x^m) s := +λ x hxs, differentiable_within_at_zpow m x $ h.imp_left $ ne_of_mem_of_not_mem hxs + +lemma deriv_zpow (m : ℤ) (x : 𝕜) : deriv (λ x, x ^ m) x = m * x ^ (m - 1) := +begin + by_cases H : x ≠ 0 ∨ 0 ≤ m, + { exact (has_deriv_at_zpow m x H).deriv }, + { rw deriv_zero_of_not_differentiable_at (mt differentiable_at_zpow.1 H), + push_neg at H, rcases H with ⟨rfl, hm⟩, + rw [zero_zpow _ ((sub_one_lt _).trans hm).ne, mul_zero] } +end + +@[simp] lemma deriv_zpow' (m : ℤ) : deriv (λ x : 𝕜, x ^ m) = λ x, m * x ^ (m - 1) := +funext $ deriv_zpow m + +lemma deriv_within_zpow (hxs : unique_diff_within_at 𝕜 s x) (h : x ≠ 0 ∨ 0 ≤ m) : + deriv_within (λx, x^m) s x = (m : 𝕜) * x^(m-1) := +(has_deriv_within_at_zpow m x h s).deriv_within hxs + +@[simp] lemma iter_deriv_zpow' (m : ℤ) (k : ℕ) : + deriv^[k] (λ x : 𝕜, x ^ m) = λ x, (∏ i in finset.range k, (m - i)) * x ^ (m - k) := +begin + induction k with k ihk, + { simp only [one_mul, int.coe_nat_zero, id, sub_zero, finset.prod_range_zero, + function.iterate_zero] }, + { simp only [function.iterate_succ_apply', ihk, deriv_const_mul_field', deriv_zpow', + finset.prod_range_succ, int.coe_nat_succ, ← sub_sub, int.cast_sub, int.cast_coe_nat, + mul_assoc], } +end + +lemma iter_deriv_zpow (m : ℤ) (x : 𝕜) (k : ℕ) : + deriv^[k] (λ y, y ^ m) x = (∏ i in finset.range k, (m - i)) * x ^ (m - k) := +congr_fun (iter_deriv_zpow' m k) x + +lemma iter_deriv_pow (n : ℕ) (x : 𝕜) (k : ℕ) : + deriv^[k] (λx:𝕜, x^n) x = (∏ i in finset.range k, (n - i)) * x^(n-k) := +begin + simp only [← zpow_coe_nat, iter_deriv_zpow, int.cast_coe_nat], + cases le_or_lt k n with hkn hnk, + { rw int.coe_nat_sub hkn }, + { have : ∏ i in finset.range k, (n - i : 𝕜) = 0, + from finset.prod_eq_zero (finset.mem_range.2 hnk) (sub_self _), + simp only [this, zero_mul] } +end + +@[simp] lemma iter_deriv_pow' (n k : ℕ) : + deriv^[k] (λ x : 𝕜, x ^ n) = λ x, (∏ i in finset.range k, (n - i)) * x ^ (n - k) := +funext $ λ x, iter_deriv_pow n x k + +lemma iter_deriv_inv (k : ℕ) (x : 𝕜) : + deriv^[k] has_inv.inv x = (∏ i in finset.range k, (-1 - i)) * x ^ (-1 - k : ℤ) := +by simpa only [zpow_neg_one, int.cast_neg, int.cast_one] using iter_deriv_zpow (-1) x k + +@[simp] lemma iter_deriv_inv' (k : ℕ) : + deriv^[k] has_inv.inv = λ x : 𝕜, (∏ i in finset.range k, (-1 - i)) * x ^ (-1 - k : ℤ) := +funext (iter_deriv_inv k) + +variables {f : E → 𝕜} {t : set E} {a : E} + +lemma differentiable_within_at.zpow (hf : differentiable_within_at 𝕜 f t a) (h : f a ≠ 0 ∨ 0 ≤ m) : + differentiable_within_at 𝕜 (λ x, f x ^ m) t a := +(differentiable_at_zpow.2 h).comp_differentiable_within_at a hf + +lemma differentiable_at.zpow (hf : differentiable_at 𝕜 f a) (h : f a ≠ 0 ∨ 0 ≤ m) : + differentiable_at 𝕜 (λ x, f x ^ m) a := +(differentiable_at_zpow.2 h).comp a hf + +lemma differentiable_on.zpow (hf : differentiable_on 𝕜 f t) (h : (∀ x ∈ t, f x ≠ 0) ∨ 0 ≤ m) : + differentiable_on 𝕜 (λ x, f x ^ m) t := +λ x hx, (hf x hx).zpow $ h.imp_left (λ h, h x hx) + +lemma differentiable.zpow (hf : differentiable 𝕜 f) (h : (∀ x, f x ≠ 0) ∨ 0 ≤ m) : + differentiable 𝕜 (λ x, f x ^ m) := +λ x, (hf x).zpow $ h.imp_left (λ h, h x) + diff --git a/src/analysis/calculus/diff_cont_on_cl.lean b/src/analysis/calculus/diff_cont_on_cl.lean new file mode 100644 index 0000000000000..7c9c611b29ebf --- /dev/null +++ b/src/analysis/calculus/diff_cont_on_cl.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2022 Yury G. Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury G. Kudryashov +-/ +import analysis.calculus.deriv.inv + +/-! +# Functions differentiable on a domain and continuous on its closure + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Many theorems in complex analysis assume that a function is complex differentiable on a domain and +is continuous on its closure. In this file we define a predicate `diff_cont_on_cl` that expresses +this property and prove basic facts about this predicate. +-/ + +open set filter metric +open_locale topology + +variables (𝕜 : Type*) {E F G : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E] + [normed_add_comm_group F] [normed_space 𝕜 E] [normed_space 𝕜 F] [normed_add_comm_group G] + [normed_space 𝕜 G] {f g : E → F} {s t : set E} {x : E} + +/-- A predicate saying that a function is differentiable on a set and is continuous on its +closure. This is a common assumption in complex analysis. -/ +@[protect_proj] structure diff_cont_on_cl (f : E → F) (s : set E) : Prop := +(differentiable_on : differentiable_on 𝕜 f s) +(continuous_on : continuous_on f (closure s)) + +variable {𝕜} + +lemma differentiable_on.diff_cont_on_cl (h : differentiable_on 𝕜 f (closure s)) : + diff_cont_on_cl 𝕜 f s := +⟨h.mono subset_closure, h.continuous_on⟩ + +lemma differentiable.diff_cont_on_cl (h : differentiable 𝕜 f) : diff_cont_on_cl 𝕜 f s := +⟨h.differentiable_on, h.continuous.continuous_on⟩ + +lemma is_closed.diff_cont_on_cl_iff (hs : is_closed s) : + diff_cont_on_cl 𝕜 f s ↔ differentiable_on 𝕜 f s := +⟨λ h, h.differentiable_on, λ h, ⟨h, hs.closure_eq.symm ▸ h.continuous_on⟩⟩ + +lemma diff_cont_on_cl_univ : diff_cont_on_cl 𝕜 f univ ↔ differentiable 𝕜 f := +is_closed_univ.diff_cont_on_cl_iff.trans differentiable_on_univ + +lemma diff_cont_on_cl_const {c : F} : + diff_cont_on_cl 𝕜 (λ x : E, c) s := +⟨differentiable_on_const c, continuous_on_const⟩ + +namespace diff_cont_on_cl + +lemma comp {g : G → E} {t : set G} (hf : diff_cont_on_cl 𝕜 f s) (hg : diff_cont_on_cl 𝕜 g t) + (h : maps_to g t s) : + diff_cont_on_cl 𝕜 (f ∘ g) t := +⟨hf.1.comp hg.1 h, hf.2.comp hg.2 $ h.closure_of_continuous_on hg.2⟩ + +lemma continuous_on_ball [normed_space ℝ E] {x : E} {r : ℝ} (h : diff_cont_on_cl 𝕜 f (ball x r)) : + continuous_on f (closed_ball x r) := +begin + rcases eq_or_ne r 0 with rfl|hr, + { rw closed_ball_zero, + exact continuous_on_singleton f x }, + { rw ← closure_ball x hr, + exact h.continuous_on } +end + +lemma mk_ball {x : E} {r : ℝ} (hd : differentiable_on 𝕜 f (ball x r)) + (hc : continuous_on f (closed_ball x r)) : diff_cont_on_cl 𝕜 f (ball x r) := +⟨hd, hc.mono $ closure_ball_subset_closed_ball⟩ + +protected lemma differentiable_at (h : diff_cont_on_cl 𝕜 f s) (hs : is_open s) (hx : x ∈ s) : + differentiable_at 𝕜 f x := +h.differentiable_on.differentiable_at $ hs.mem_nhds hx + +lemma differentiable_at' (h : diff_cont_on_cl 𝕜 f s) (hx : s ∈ 𝓝 x) : + differentiable_at 𝕜 f x := +h.differentiable_on.differentiable_at hx + +protected lemma mono (h : diff_cont_on_cl 𝕜 f s) (ht : t ⊆ s) : diff_cont_on_cl 𝕜 f t := +⟨h.differentiable_on.mono ht, h.continuous_on.mono (closure_mono ht)⟩ + +lemma add (hf : diff_cont_on_cl 𝕜 f s) (hg : diff_cont_on_cl 𝕜 g s) : + diff_cont_on_cl 𝕜 (f + g) s := +⟨hf.1.add hg.1, hf.2.add hg.2⟩ + +lemma add_const (hf : diff_cont_on_cl 𝕜 f s) (c : F) : + diff_cont_on_cl 𝕜 (λ x, f x + c) s := +hf.add diff_cont_on_cl_const + +lemma const_add (hf : diff_cont_on_cl 𝕜 f s) (c : F) : + diff_cont_on_cl 𝕜 (λ x, c + f x) s := +diff_cont_on_cl_const.add hf + +lemma neg (hf : diff_cont_on_cl 𝕜 f s) : diff_cont_on_cl 𝕜 (-f) s := ⟨hf.1.neg, hf.2.neg⟩ + +lemma sub (hf : diff_cont_on_cl 𝕜 f s) (hg : diff_cont_on_cl 𝕜 g s) : + diff_cont_on_cl 𝕜 (f - g) s := +⟨hf.1.sub hg.1, hf.2.sub hg.2⟩ + +lemma sub_const (hf : diff_cont_on_cl 𝕜 f s) (c : F) : diff_cont_on_cl 𝕜 (λ x, f x - c) s := +hf.sub diff_cont_on_cl_const + +lemma const_sub (hf : diff_cont_on_cl 𝕜 f s) (c : F) : diff_cont_on_cl 𝕜 (λ x, c - f x) s := +diff_cont_on_cl_const.sub hf + +lemma const_smul {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] + [has_continuous_const_smul R F] (hf : diff_cont_on_cl 𝕜 f s) (c : R) : + diff_cont_on_cl 𝕜 (c • f) s := +⟨hf.1.const_smul c, hf.2.const_smul c⟩ + +lemma smul {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {c : E → 𝕜'} {f : E → F} {s : set E} + (hc : diff_cont_on_cl 𝕜 c s) (hf : diff_cont_on_cl 𝕜 f s) : + diff_cont_on_cl 𝕜 (λ x, c x • f x) s := +⟨hc.1.smul hf.1, hc.2.smul hf.2⟩ + +lemma smul_const {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {c : E → 𝕜'} {s : set E} + (hc : diff_cont_on_cl 𝕜 c s) (y : F) : + diff_cont_on_cl 𝕜 (λ x, c x • y) s := +hc.smul diff_cont_on_cl_const + +lemma inv {f : E → 𝕜} (hf : diff_cont_on_cl 𝕜 f s) (h₀ : ∀ x ∈ closure s, f x ≠ 0) : + diff_cont_on_cl 𝕜 f⁻¹ s := +⟨differentiable_on_inv.comp hf.1 $ λ x hx, h₀ _ (subset_closure hx), hf.2.inv₀ h₀⟩ + +end diff_cont_on_cl + +lemma differentiable.comp_diff_cont_on_cl {g : G → E} {t : set G} + (hf : differentiable 𝕜 f) (hg : diff_cont_on_cl 𝕜 g t) : + diff_cont_on_cl 𝕜 (f ∘ g) t := +hf.diff_cont_on_cl.comp hg (maps_to_image _ _) + +lemma differentiable_on.diff_cont_on_cl_ball {U : set E} {c : E} {R : ℝ} + (hf : differentiable_on 𝕜 f U) (hc : closed_ball c R ⊆ U) : + diff_cont_on_cl 𝕜 f (ball c R) := +diff_cont_on_cl.mk_ball (hf.mono (ball_subset_closed_ball.trans hc)) (hf.continuous_on.mono hc) diff --git a/src/analysis/calculus/diff_on_int_cont.lean b/src/analysis/calculus/diff_on_int_cont.lean deleted file mode 100644 index 46ab34dde4d79..0000000000000 --- a/src/analysis/calculus/diff_on_int_cont.lean +++ /dev/null @@ -1,131 +0,0 @@ -/- -Copyright (c) 2022 Yury G. Kudryashov. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yury G. Kudryashov --/ -import analysis.calculus.deriv - -/-! -# Functions differentiable on a domain and continuous on its closure - -Many theorems in complex analysis assume that a function is complex differentiable on a domain and -is continuous on its closure. In this file we define a predicate `diff_cont_on_cl` that expresses -this property and prove basic facts about this predicate. --/ - -open set filter metric -open_locale topological_space - -variables (𝕜 : Type*) {E F G : Type*} [nondiscrete_normed_field 𝕜] [normed_group E] - [normed_group F] [normed_space 𝕜 E] [normed_space 𝕜 F] [normed_group G] [normed_space 𝕜 G] - {f g : E → F} {s t : set E} {x : E} - -/-- A predicate saying that a function is differentiable on a set and is continuous on its -closure. This is a common assumption in complex analysis. -/ -@[protect_proj] structure diff_cont_on_cl (f : E → F) (s : set E) : Prop := -(differentiable_on : differentiable_on 𝕜 f s) -(continuous_on : continuous_on f (closure s)) - -variable {𝕜} - -lemma differentiable_on.diff_cont_on_cl (h : differentiable_on 𝕜 f (closure s)) : - diff_cont_on_cl 𝕜 f s := -⟨h.mono subset_closure, h.continuous_on⟩ - -lemma differentiable.diff_cont_on_cl (h : differentiable 𝕜 f) : diff_cont_on_cl 𝕜 f s := -⟨h.differentiable_on, h.continuous.continuous_on⟩ - -lemma is_closed.diff_cont_on_cl_iff (hs : is_closed s) : - diff_cont_on_cl 𝕜 f s ↔ differentiable_on 𝕜 f s := -⟨λ h, h.differentiable_on, λ h, ⟨h, hs.closure_eq.symm ▸ h.continuous_on⟩⟩ - -lemma diff_cont_on_cl_univ : diff_cont_on_cl 𝕜 f univ ↔ differentiable 𝕜 f := -is_closed_univ.diff_cont_on_cl_iff.trans differentiable_on_univ - -lemma diff_cont_on_cl_const {c : F} : - diff_cont_on_cl 𝕜 (λ x : E, c) s := -⟨differentiable_on_const c, continuous_on_const⟩ - -namespace diff_cont_on_cl - -lemma comp {g : G → E} {t : set G} (hf : diff_cont_on_cl 𝕜 f s) (hg : diff_cont_on_cl 𝕜 g t) - (h : maps_to g t s) : - diff_cont_on_cl 𝕜 (f ∘ g) t := -⟨hf.1.comp hg.1 h, hf.2.comp hg.2 $ h.closure_of_continuous_on hg.2⟩ - -lemma continuous_on_ball [normed_space ℝ E] {x : E} {r : ℝ} (h : diff_cont_on_cl 𝕜 f (ball x r)) : - continuous_on f (closed_ball x r) := -begin - rcases eq_or_ne r 0 with rfl|hr, - { rw closed_ball_zero, - exact continuous_on_singleton f x }, - { rw ← closure_ball x hr, - exact h.continuous_on } -end - -lemma mk_ball {x : E} {r : ℝ} (hd : differentiable_on 𝕜 f (ball x r)) - (hc : continuous_on f (closed_ball x r)) : diff_cont_on_cl 𝕜 f (ball x r) := -⟨hd, hc.mono $ closure_ball_subset_closed_ball⟩ - -protected lemma differentiable_at (h : diff_cont_on_cl 𝕜 f s) (hs : is_open s) (hx : x ∈ s) : - differentiable_at 𝕜 f x := -h.differentiable_on.differentiable_at $ hs.mem_nhds hx - -lemma differentiable_at' (h : diff_cont_on_cl 𝕜 f s) (hx : s ∈ 𝓝 x) : - differentiable_at 𝕜 f x := -h.differentiable_on.differentiable_at hx - -protected lemma mono (h : diff_cont_on_cl 𝕜 f s) (ht : t ⊆ s) : diff_cont_on_cl 𝕜 f t := -⟨h.differentiable_on.mono ht, h.continuous_on.mono (closure_mono ht)⟩ - -lemma add (hf : diff_cont_on_cl 𝕜 f s) (hg : diff_cont_on_cl 𝕜 g s) : - diff_cont_on_cl 𝕜 (f + g) s := -⟨hf.1.add hg.1, hf.2.add hg.2⟩ - -lemma add_const (hf : diff_cont_on_cl 𝕜 f s) (c : F) : - diff_cont_on_cl 𝕜 (λ x, f x + c) s := -hf.add diff_cont_on_cl_const - -lemma const_add (hf : diff_cont_on_cl 𝕜 f s) (c : F) : - diff_cont_on_cl 𝕜 (λ x, c + f x) s := -diff_cont_on_cl_const.add hf - -lemma neg (hf : diff_cont_on_cl 𝕜 f s) : diff_cont_on_cl 𝕜 (-f) s := ⟨hf.1.neg, hf.2.neg⟩ - -lemma sub (hf : diff_cont_on_cl 𝕜 f s) (hg : diff_cont_on_cl 𝕜 g s) : - diff_cont_on_cl 𝕜 (f - g) s := -⟨hf.1.sub hg.1, hf.2.sub hg.2⟩ - -lemma sub_const (hf : diff_cont_on_cl 𝕜 f s) (c : F) : diff_cont_on_cl 𝕜 (λ x, f x - c) s := -hf.sub diff_cont_on_cl_const - -lemma const_sub (hf : diff_cont_on_cl 𝕜 f s) (c : F) : diff_cont_on_cl 𝕜 (λ x, c - f x) s := -diff_cont_on_cl_const.sub hf - -lemma const_smul {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] - [has_continuous_const_smul R F] (hf : diff_cont_on_cl 𝕜 f s) (c : R) : - diff_cont_on_cl 𝕜 (c • f) s := -⟨hf.1.const_smul c, hf.2.const_smul c⟩ - -lemma smul {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] - [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {c : E → 𝕜'} {f : E → F} {s : set E} - (hc : diff_cont_on_cl 𝕜 c s) (hf : diff_cont_on_cl 𝕜 f s) : - diff_cont_on_cl 𝕜 (λ x, c x • f x) s := -⟨hc.1.smul hf.1, hc.2.smul hf.2⟩ - -lemma smul_const {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] - [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] {c : E → 𝕜'} {s : set E} - (hc : diff_cont_on_cl 𝕜 c s) (y : F) : - diff_cont_on_cl 𝕜 (λ x, c x • y) s := -hc.smul diff_cont_on_cl_const - -lemma inv {f : E → 𝕜} (hf : diff_cont_on_cl 𝕜 f s) (h₀ : ∀ x ∈ closure s, f x ≠ 0) : - diff_cont_on_cl 𝕜 f⁻¹ s := -⟨differentiable_on_inv.comp hf.1 $ λ x hx, h₀ _ (subset_closure hx), hf.2.inv₀ h₀⟩ - -end diff_cont_on_cl - -lemma differentiable.comp_diff_cont_on_cl {g : G → E} {t : set G} - (hf : differentiable 𝕜 f) (hg : diff_cont_on_cl 𝕜 g t) : - diff_cont_on_cl 𝕜 (f ∘ g) t := -hf.diff_cont_on_cl.comp hg (maps_to_image _ _) diff --git a/src/analysis/calculus/dslope.lean b/src/analysis/calculus/dslope.lean index 418605813896e..594cc93865f6d 100644 --- a/src/analysis/calculus/dslope.lean +++ b/src/analysis/calculus/dslope.lean @@ -3,13 +3,16 @@ Copyright (c) 2022 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import analysis.calculus.deriv -import linear_algebra.affine_space.slope +import analysis.calculus.deriv.slope +import analysis.calculus.deriv.inv /-! # Slope of a differentiable function -Given a function `f : 𝕜 → E` from a nondiscrete normed field to a normed space over this field, +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given a function `f : 𝕜 → E` from a nontrivially normed field to a normed space over this field, `dslope f a b` is defined as `slope f a b = (b - a)⁻¹ • (f b - f a)` for `a ≠ b` and as `deriv f a` for `a = b`. @@ -17,10 +20,10 @@ In this file we define `dslope` and prove some basic lemmas about its continuity differentiability. -/ -open_locale classical topological_space filter +open_locale classical topology filter open function set filter -variables {𝕜 E : Type*} [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] +variables {𝕜 E : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] /-- `dslope f a b` is defined as `slope f a b = (b - a)⁻¹ • (f b - f a)` for `a ≠ b` and `deriv f a` for `a = b`. -/ @@ -33,7 +36,7 @@ variables {f : 𝕜 → E} {a b : 𝕜} {s : set 𝕜} lemma dslope_of_ne (f : 𝕜 → E) (h : b ≠ a) : dslope f a b = slope f a b := update_noteq h _ _ -lemma continuous_linear_map.dslope_comp {F : Type*} [normed_group F] [normed_space 𝕜 F] +lemma continuous_linear_map.dslope_comp {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] (f : E →L[𝕜] F) (g : 𝕜 → E) (a b : 𝕜) (H : a = b → differentiable_at 𝕜 g a) : dslope (f ∘ g) a b = f (dslope g a b) := begin diff --git a/src/analysis/calculus/extend_deriv.lean b/src/analysis/calculus/extend_deriv.lean index 2b1ef3254164b..b2c01107784ca 100644 --- a/src/analysis/calculus/extend_deriv.lean +++ b/src/analysis/calculus/extend_deriv.lean @@ -8,6 +8,9 @@ import analysis.calculus.mean_value /-! # Extending differentiability to the boundary +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We investigate how differentiable functions inside a set extend to differentiable functions on the boundary. For this, it suffices that the function and its derivative admit limits there. A general version of this statement is given in `has_fderiv_at_boundary_of_tendsto_fderiv`. @@ -20,11 +23,11 @@ of the one-dimensional derivative `deriv ℝ f`. -/ -variables {E : Type*} [normed_group E] [normed_space ℝ E] - {F : Type*} [normed_group F] [normed_space ℝ F] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] + {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] open filter set metric continuous_linear_map -open_locale topological_space +open_locale topology local attribute [mono] prod_mono /-- If a function `f` is differentiable in a convex open set and continuous on its closure, and its @@ -43,29 +46,29 @@ begin { rw ← closure_closure at hx, exact has_fderiv_within_at_of_not_mem_closure hx }, push_neg at hx, rw [has_fderiv_within_at, has_fderiv_at_filter, asymptotics.is_o_iff], - /- One needs to show that `∥f y - f x - f' (y - x)∥ ≤ ε ∥y - x∥` for `y` close to `x` in `closure + /- One needs to show that `‖f y - f x - f' (y - x)‖ ≤ ε ‖y - x‖` for `y` close to `x` in `closure s`, where `ε` is an arbitrary positive constant. By continuity of the functions, it suffices to prove this for nearby points inside `s`. In a neighborhood of `x`, the derivative of `f` is arbitrarily close to `f'` by assumption. The mean value inequality completes the proof. -/ assume ε ε_pos, - obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ y ∈ s, dist y x < δ → ∥fderiv ℝ f y - f'∥ < ε, + obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ y ∈ s, dist y x < δ → ‖fderiv ℝ f y - f'‖ < ε, by simpa [dist_zero_right] using tendsto_nhds_within_nhds.1 h ε ε_pos, set B := ball x δ, - suffices : ∀ y ∈ B ∩ (closure s), ∥f y - f x - (f' y - f' x)∥ ≤ ε * ∥y - x∥, + suffices : ∀ y ∈ B ∩ (closure s), ‖f y - f x - (f' y - f' x)‖ ≤ ε * ‖y - x‖, from mem_nhds_within_iff.2 ⟨δ, δ_pos, λy hy, by simpa using this y hy⟩, - suffices : ∀ p : E × E, p ∈ closure ((B ∩ s) ×ˢ (B ∩ s)) → ∥f p.2 - f p.1 - (f' p.2 - f' p.1)∥ - ≤ ε * ∥p.2 - p.1∥, + suffices : ∀ p : E × E, p ∈ closure ((B ∩ s) ×ˢ (B ∩ s)) → ‖f p.2 - f p.1 - (f' p.2 - f' p.1)‖ + ≤ ε * ‖p.2 - p.1‖, { rw closure_prod_eq at this, intros y y_in, apply this ⟨x, y⟩, - have : B ∩ closure s ⊆ closure (B ∩ s), from closure_inter_open is_open_ball, + have : B ∩ closure s ⊆ closure (B ∩ s), from is_open_ball.inter_closure, exact ⟨this ⟨mem_ball_self δ_pos, hx⟩, this y_in⟩ }, - have key : ∀ p : E × E, p ∈ (B ∩ s) ×ˢ (B ∩ s) → ∥f p.2 - f p.1 - (f' p.2 - f' p.1)∥ - ≤ ε * ∥p.2 - p.1∥, + have key : ∀ p : E × E, p ∈ (B ∩ s) ×ˢ (B ∩ s) → ‖f p.2 - f p.1 - (f' p.2 - f' p.1)‖ + ≤ ε * ‖p.2 - p.1‖, { rintros ⟨u, v⟩ ⟨u_in, v_in⟩, have conv : convex ℝ (B ∩ s) := (convex_ball _ _).inter s_conv, have diff : differentiable_on ℝ f (B ∩ s) := f_diff.mono (inter_subset_right _ _), - have bound : ∀ z ∈ (B ∩ s), ∥fderiv_within ℝ f (B ∩ s) z - f'∥ ≤ ε, + have bound : ∀ z ∈ (B ∩ s), ‖fderiv_within ℝ f (B ∩ s) z - f'‖ ≤ ε, { intros z z_in, convert le_of_lt (hδ _ z_in.2 z_in.1), have op : is_open (B ∩ s) := is_open_ball.inter s_open, @@ -131,7 +134,7 @@ begin have : has_deriv_within_at f e (Icc a b) a, { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure], exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' }, - exact this.nhds_within (mem_nhds_within_Ici_iff_exists_Icc_subset.2 ⟨b, ab, subset.refl _⟩) + exact this.nhds_within (Icc_mem_nhds_within_Ici $ left_mem_Ico.2 ab) end /-- If a function is differentiable on the left of a point `a : ℝ`, continuous at `a`, and @@ -170,7 +173,7 @@ begin have : has_deriv_within_at f e (Icc b a) a, { rw [has_deriv_within_at_iff_has_fderiv_within_at, ← t_closure], exact has_fderiv_at_boundary_of_tendsto_fderiv t_diff t_conv t_open t_cont t_diff' }, - exact this.nhds_within (mem_nhds_within_Iic_iff_exists_Icc_subset.2 ⟨b, ba, subset.refl _⟩) + exact this.nhds_within (Icc_mem_nhds_within_Iic $ right_mem_Ioc.2 ba) end /-- If a real function `f` has a derivative `g` everywhere but at a point, and `f` and `g` are diff --git a/src/analysis/calculus/fderiv.lean b/src/analysis/calculus/fderiv.lean deleted file mode 100644 index 605efad24ed3a..0000000000000 --- a/src/analysis/calculus/fderiv.lean +++ /dev/null @@ -1,3051 +0,0 @@ -/- -Copyright (c) 2019 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov --/ -import analysis.asymptotics.asymptotic_equivalent -import analysis.calculus.tangent_cone -import analysis.normed_space.bounded_linear_maps -import analysis.normed_space.units - -/-! -# The Fréchet derivative - -Let `E` and `F` be normed spaces, `f : E → F`, and `f' : E →L[𝕜] F` a -continuous 𝕜-linear map, where `𝕜` is a non-discrete normed field. Then - - `has_fderiv_within_at f f' s x` - -says that `f` has derivative `f'` at `x`, where the domain of interest -is restricted to `s`. We also have - - `has_fderiv_at f f' x := has_fderiv_within_at f f' x univ` - -Finally, - - `has_strict_fderiv_at f f' x` - -means that `f : E → F` has derivative `f' : E →L[𝕜] F` in the sense of strict differentiability, -i.e., `f y - f z - f'(y - z) = o(y - z)` as `y, z → x`. This notion is used in the inverse -function theorem, and is defined here only to avoid proving theorems like -`is_bounded_bilinear_map.has_fderiv_at` twice: first for `has_fderiv_at`, then for -`has_strict_fderiv_at`. - -## Main results - -In addition to the definition and basic properties of the derivative, this file contains the -usual formulas (and existence assertions) for the derivative of -* constants -* the identity -* bounded linear maps -* bounded bilinear maps -* sum of two functions -* sum of finitely many functions -* multiplication of a function by a scalar constant -* negative of a function -* subtraction of two functions -* multiplication of a function by a scalar function -* multiplication of two scalar functions -* composition of functions (the chain rule) -* inverse function (assuming that it exists; the inverse function theorem is in `inverse.lean`) - -For most binary operations we also define `const_op` and `op_const` theorems for the cases when -the first or second argument is a constant. This makes writing chains of `has_deriv_at`'s easier, -and they more frequently lead to the desired result. - -One can also interpret the derivative of a function `f : 𝕜 → E` as an element of `E` (by identifying -a linear function from `𝕜` to `E` with its value at `1`). Results on the Fréchet derivative are -translated to this more elementary point of view on the derivative in the file `deriv.lean`. The -derivative of polynomials is handled there, as it is naturally one-dimensional. - -The simplifier is set up to prove automatically that some functions are differentiable, or -differentiable at a point (but not differentiable on a set or within a set at a point, as checking -automatically that the good domains are mapped one to the other when using composition is not -something the simplifier can easily do). This means that one can write -`example (x : ℝ) : differentiable ℝ (λ x, sin (exp (3 + x^2)) - 5 * cos x) := by simp`. -If there are divisions, one needs to supply to the simplifier proofs that the denominators do -not vanish, as in -```lean -example (x : ℝ) (h : 1 + sin x ≠ 0) : differentiable_at ℝ (λ x, exp x / (1 + sin x)) x := -by simp [h] -``` -Of course, these examples only work once `exp`, `cos` and `sin` have been shown to be -differentiable, in `analysis.special_functions.trigonometric`. - -The simplifier is not set up to compute the Fréchet derivative of maps (as these are in general -complicated multidimensional linear maps), but it will compute one-dimensional derivatives, -see `deriv.lean`. - -## Implementation details - -The derivative is defined in terms of the `is_o` relation, but also -characterized in terms of the `tendsto` relation. - -We also introduce predicates `differentiable_within_at 𝕜 f s x` (where `𝕜` is the base field, -`f` the function to be differentiated, `x` the point at which the derivative is asserted to exist, -and `s` the set along which the derivative is defined), as well as `differentiable_at 𝕜 f x`, -`differentiable_on 𝕜 f s` and `differentiable 𝕜 f` to express the existence of a derivative. - -To be able to compute with derivatives, we write `fderiv_within 𝕜 f s x` and `fderiv 𝕜 f x` -for some choice of a derivative if it exists, and the zero function otherwise. This choice only -behaves well along sets for which the derivative is unique, i.e., those for which the tangent -directions span a dense subset of the whole space. The predicates `unique_diff_within_at s x` and -`unique_diff_on s`, defined in `tangent_cone.lean` express this property. We prove that indeed -they imply the uniqueness of the derivative. This is satisfied for open subsets, and in particular -for `univ`. This uniqueness only holds when the field is non-discrete, which we request at the very -beginning: otherwise, a derivative can be defined, but it has no interesting properties whatsoever. - -To make sure that the simplifier can prove automatically that functions are differentiable, we tag -many lemmas with the `simp` attribute, for instance those saying that the sum of differentiable -functions is differentiable, as well as their product, their cartesian product, and so on. A notable -exception is the chain rule: we do not mark as a simp lemma the fact that, if `f` and `g` are -differentiable, then their composition also is: `simp` would always be able to match this lemma, -by taking `f` or `g` to be the identity. Instead, for every reasonable function (say, `exp`), -we add a lemma that if `f` is differentiable then so is `(λ x, exp (f x))`. This means adding -some boilerplate lemmas, but these can also be useful in their own right. - -Tests for this ability of the simplifier (with more examples) are provided in -`tests/differentiable.lean`. - -## Tags - -derivative, differentiable, Fréchet, calculus - --/ - -open filter asymptotics continuous_linear_map set metric -open_locale topological_space classical nnreal filter asymptotics ennreal - -noncomputable theory - - -section - -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] -variables {G : Type*} [normed_group G] [normed_space 𝕜 G] -variables {G' : Type*} [normed_group G'] [normed_space 𝕜 G'] - -/-- A function `f` has the continuous linear map `f'` as derivative along the filter `L` if -`f x' = f x + f' (x' - x) + o (x' - x)` when `x'` converges along the filter `L`. This definition -is designed to be specialized for `L = 𝓝 x` (in `has_fderiv_at`), giving rise to the usual notion -of Fréchet derivative, and for `L = 𝓝[s] x` (in `has_fderiv_within_at`), giving rise to -the notion of Fréchet derivative along the set `s`. -/ -def has_fderiv_at_filter (f : E → F) (f' : E →L[𝕜] F) (x : E) (L : filter E) := -is_o (λ x', f x' - f x - f' (x' - x)) (λ x', x' - x) L - -/-- A function `f` has the continuous linear map `f'` as derivative at `x` within a set `s` if -`f x' = f x + f' (x' - x) + o (x' - x)` when `x'` tends to `x` inside `s`. -/ -def has_fderiv_within_at (f : E → F) (f' : E →L[𝕜] F) (s : set E) (x : E) := -has_fderiv_at_filter f f' x (𝓝[s] x) - -/-- A function `f` has the continuous linear map `f'` as derivative at `x` if -`f x' = f x + f' (x' - x) + o (x' - x)` when `x'` tends to `x`. -/ -def has_fderiv_at (f : E → F) (f' : E →L[𝕜] F) (x : E) := -has_fderiv_at_filter f f' x (𝓝 x) - -/-- A function `f` has derivative `f'` at `a` in the sense of *strict differentiability* -if `f x - f y - f' (x - y) = o(x - y)` as `x, y → a`. This form of differentiability is required, -e.g., by the inverse function theorem. Any `C^1` function on a vector space over `ℝ` is strictly -differentiable but this definition works, e.g., for vector spaces over `p`-adic numbers. -/ -def has_strict_fderiv_at (f : E → F) (f' : E →L[𝕜] F) (x : E) := -is_o (λ p : E × E, f p.1 - f p.2 - f' (p.1 - p.2)) (λ p : E × E, p.1 - p.2) (𝓝 (x, x)) - -variables (𝕜) - -/-- A function `f` is differentiable at a point `x` within a set `s` if it admits a derivative -there (possibly non-unique). -/ -def differentiable_within_at (f : E → F) (s : set E) (x : E) := -∃f' : E →L[𝕜] F, has_fderiv_within_at f f' s x - -/-- A function `f` is differentiable at a point `x` if it admits a derivative there (possibly -non-unique). -/ -def differentiable_at (f : E → F) (x : E) := -∃f' : E →L[𝕜] F, has_fderiv_at f f' x - -/-- If `f` has a derivative at `x` within `s`, then `fderiv_within 𝕜 f s x` is such a derivative. -Otherwise, it is set to `0`. -/ -def fderiv_within (f : E → F) (s : set E) (x : E) : E →L[𝕜] F := -if h : ∃f', has_fderiv_within_at f f' s x then classical.some h else 0 - -/-- If `f` has a derivative at `x`, then `fderiv 𝕜 f x` is such a derivative. Otherwise, it is -set to `0`. -/ -def fderiv (f : E → F) (x : E) : E →L[𝕜] F := -if h : ∃f', has_fderiv_at f f' x then classical.some h else 0 - -/-- `differentiable_on 𝕜 f s` means that `f` is differentiable within `s` at any point of `s`. -/ -def differentiable_on (f : E → F) (s : set E) := -∀x ∈ s, differentiable_within_at 𝕜 f s x - -/-- `differentiable 𝕜 f` means that `f` is differentiable at any point. -/ -def differentiable (f : E → F) := -∀x, differentiable_at 𝕜 f x - -variables {𝕜} -variables {f f₀ f₁ g : E → F} -variables {f' f₀' f₁' g' : E →L[𝕜] F} -variables (e : E →L[𝕜] F) -variables {x : E} -variables {s t : set E} -variables {L L₁ L₂ : filter E} - -lemma fderiv_within_zero_of_not_differentiable_within_at - (h : ¬ differentiable_within_at 𝕜 f s x) : fderiv_within 𝕜 f s x = 0 := -have ¬ ∃ f', has_fderiv_within_at f f' s x, from h, -by simp [fderiv_within, this] - -lemma fderiv_zero_of_not_differentiable_at (h : ¬ differentiable_at 𝕜 f x) : fderiv 𝕜 f x = 0 := -have ¬ ∃ f', has_fderiv_at f f' x, from h, -by simp [fderiv, this] - -section derivative_uniqueness -/- In this section, we discuss the uniqueness of the derivative. -We prove that the definitions `unique_diff_within_at` and `unique_diff_on` indeed imply the -uniqueness of the derivative. -/ - -/-- If a function f has a derivative f' at x, a rescaled version of f around x converges to f', -i.e., `n (f (x + (1/n) v) - f x)` converges to `f' v`. More generally, if `c n` tends to infinity -and `c n * d n` tends to `v`, then `c n * (f (x + d n) - f x)` tends to `f' v`. This lemma expresses -this fact, for functions having a derivative within a set. Its specific formulation is useful for -tangent cone related discussions. -/ -theorem has_fderiv_within_at.lim (h : has_fderiv_within_at f f' s x) {α : Type*} (l : filter α) - {c : α → 𝕜} {d : α → E} {v : E} (dtop : ∀ᶠ n in l, x + d n ∈ s) - (clim : tendsto (λ n, ∥c n∥) l at_top) - (cdlim : tendsto (λ n, c n • d n) l (𝓝 v)) : - tendsto (λn, c n • (f (x + d n) - f x)) l (𝓝 (f' v)) := -begin - have tendsto_arg : tendsto (λ n, x + d n) l (𝓝[s] x), - { conv in (𝓝[s] x) { rw ← add_zero x }, - rw [nhds_within, tendsto_inf], - split, - { apply tendsto_const_nhds.add (tangent_cone_at.lim_zero l clim cdlim) }, - { rwa tendsto_principal } }, - have : is_o (λ y, f y - f x - f' (y - x)) (λ y, y - x) (𝓝[s] x) := h, - have : is_o (λ n, f (x + d n) - f x - f' ((x + d n) - x)) (λ n, (x + d n) - x) l := - this.comp_tendsto tendsto_arg, - have : is_o (λ n, f (x + d n) - f x - f' (d n)) d l := by simpa only [add_sub_cancel'], - have : is_o (λn, c n • (f (x + d n) - f x - f' (d n))) (λn, c n • d n) l := - (is_O_refl c l).smul_is_o this, - have : is_o (λn, c n • (f (x + d n) - f x - f' (d n))) (λn, (1:ℝ)) l := - this.trans_is_O (is_O_one_of_tendsto ℝ cdlim), - have L1 : tendsto (λn, c n • (f (x + d n) - f x - f' (d n))) l (𝓝 0) := - (is_o_one_iff ℝ).1 this, - have L2 : tendsto (λn, f' (c n • d n)) l (𝓝 (f' v)) := - tendsto.comp f'.cont.continuous_at cdlim, - have L3 : tendsto (λn, (c n • (f (x + d n) - f x - f' (d n)) + f' (c n • d n))) - l (𝓝 (0 + f' v)) := - L1.add L2, - have : (λn, (c n • (f (x + d n) - f x - f' (d n)) + f' (c n • d n))) - = (λn, c n • (f (x + d n) - f x)), - by { ext n, simp [smul_add, smul_sub] }, - rwa [this, zero_add] at L3 -end - -/-- If `f'` and `f₁'` are two derivatives of `f` within `s` at `x`, then they are equal on the -tangent cone to `s` at `x` -/ -theorem has_fderiv_within_at.unique_on (hf : has_fderiv_within_at f f' s x) - (hg : has_fderiv_within_at f f₁' s x) : - eq_on f' f₁' (tangent_cone_at 𝕜 s x) := -λ y ⟨c, d, dtop, clim, cdlim⟩, - tendsto_nhds_unique (hf.lim at_top dtop clim cdlim) (hg.lim at_top dtop clim cdlim) - -/-- `unique_diff_within_at` achieves its goal: it implies the uniqueness of the derivative. -/ -theorem unique_diff_within_at.eq (H : unique_diff_within_at 𝕜 s x) - (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at f f₁' s x) : f' = f₁' := -continuous_linear_map.ext_on H.1 (hf.unique_on hg) - -theorem unique_diff_on.eq (H : unique_diff_on 𝕜 s) (hx : x ∈ s) - (h : has_fderiv_within_at f f' s x) (h₁ : has_fderiv_within_at f f₁' s x) : f' = f₁' := -(H x hx).eq h h₁ - -end derivative_uniqueness - -section fderiv_properties -/-! ### Basic properties of the derivative -/ - -theorem has_fderiv_at_filter_iff_tendsto : - has_fderiv_at_filter f f' x L ↔ - tendsto (λ x', ∥x' - x∥⁻¹ * ∥f x' - f x - f' (x' - x)∥) L (𝓝 0) := -have h : ∀ x', ∥x' - x∥ = 0 → ∥f x' - f x - f' (x' - x)∥ = 0, from λ x' hx', - by { rw [sub_eq_zero.1 (norm_eq_zero.1 hx')], simp }, -begin - unfold has_fderiv_at_filter, - rw [←is_o_norm_left, ←is_o_norm_right, is_o_iff_tendsto h], - exact tendsto_congr (λ _, div_eq_inv_mul), -end - -theorem has_fderiv_within_at_iff_tendsto : has_fderiv_within_at f f' s x ↔ - tendsto (λ x', ∥x' - x∥⁻¹ * ∥f x' - f x - f' (x' - x)∥) (𝓝[s] x) (𝓝 0) := -has_fderiv_at_filter_iff_tendsto - -theorem has_fderiv_at_iff_tendsto : has_fderiv_at f f' x ↔ - tendsto (λ x', ∥x' - x∥⁻¹ * ∥f x' - f x - f' (x' - x)∥) (𝓝 x) (𝓝 0) := -has_fderiv_at_filter_iff_tendsto - -theorem has_fderiv_at_iff_is_o_nhds_zero : has_fderiv_at f f' x ↔ - is_o (λh, f (x + h) - f x - f' h) (λh, h) (𝓝 0) := -begin - rw [has_fderiv_at, has_fderiv_at_filter, ← map_add_left_nhds_zero x, is_o_map], - simp [(∘)] -end - -/-- Converse to the mean value inequality: if `f` is differentiable at `x₀` and `C`-lipschitz -on a neighborhood of `x₀` then it its derivative at `x₀` has norm bounded by `C`. This version -only assumes that `∥f x - f x₀∥ ≤ C * ∥x - x₀∥` in a neighborhood of `x`. -/ -lemma has_fderiv_at.le_of_lip' {f : E → F} {f' : E →L[𝕜] F} {x₀ : E} (hf : has_fderiv_at f f' x₀) - {C : ℝ} (hC₀ : 0 ≤ C) (hlip : ∀ᶠ x in 𝓝 x₀, ∥f x - f x₀∥ ≤ C * ∥x - x₀∥) : ∥f'∥ ≤ C := -begin - refine le_of_forall_pos_le_add (λ ε ε0, op_norm_le_of_nhds_zero _ _), - exact add_nonneg hC₀ ε0.le, - rw [← map_add_left_nhds_zero x₀, eventually_map] at hlip, - filter_upwards [is_o_iff.1 (has_fderiv_at_iff_is_o_nhds_zero.1 hf) ε0, hlip] with y hy hyC, - rw add_sub_cancel' at hyC, - calc ∥f' y∥ ≤ ∥f (x₀ + y) - f x₀∥ + ∥f (x₀ + y) - f x₀ - f' y∥ : norm_le_insert _ _ - ... ≤ C * ∥y∥ + ε * ∥y∥ : add_le_add hyC hy - ... = (C + ε) * ∥y∥ : (add_mul _ _ _).symm -end - -/-- Converse to the mean value inequality: if `f` is differentiable at `x₀` and `C`-lipschitz -on a neighborhood of `x₀` then it its derivative at `x₀` has norm bounded by `C`. -/ -lemma has_fderiv_at.le_of_lip {f : E → F} {f' : E →L[𝕜] F} {x₀ : E} (hf : has_fderiv_at f f' x₀) - {s : set E} (hs : s ∈ 𝓝 x₀) {C : ℝ≥0} (hlip : lipschitz_on_with C f s) : ∥f'∥ ≤ C := -begin - refine hf.le_of_lip' C.coe_nonneg _, - filter_upwards [hs] with x hx using hlip.norm_sub_le hx (mem_of_mem_nhds hs), -end - -theorem has_fderiv_at_filter.mono (h : has_fderiv_at_filter f f' x L₂) (hst : L₁ ≤ L₂) : - has_fderiv_at_filter f f' x L₁ := -h.mono hst - -theorem has_fderiv_within_at.mono (h : has_fderiv_within_at f f' t x) (hst : s ⊆ t) : - has_fderiv_within_at f f' s x := -h.mono (nhds_within_mono _ hst) - -theorem has_fderiv_at.has_fderiv_at_filter (h : has_fderiv_at f f' x) (hL : L ≤ 𝓝 x) : - has_fderiv_at_filter f f' x L := -h.mono hL - -theorem has_fderiv_at.has_fderiv_within_at - (h : has_fderiv_at f f' x) : has_fderiv_within_at f f' s x := -h.has_fderiv_at_filter inf_le_left - -lemma has_fderiv_within_at.differentiable_within_at (h : has_fderiv_within_at f f' s x) : - differentiable_within_at 𝕜 f s x := -⟨f', h⟩ - -lemma has_fderiv_at.differentiable_at (h : has_fderiv_at f f' x) : differentiable_at 𝕜 f x := -⟨f', h⟩ - -@[simp] lemma has_fderiv_within_at_univ : - has_fderiv_within_at f f' univ x ↔ has_fderiv_at f f' x := -by { simp only [has_fderiv_within_at, nhds_within_univ], refl } - -lemma has_strict_fderiv_at.is_O_sub (hf : has_strict_fderiv_at f f' x) : - is_O (λ p : E × E, f p.1 - f p.2) (λ p : E × E, p.1 - p.2) (𝓝 (x, x)) := -hf.is_O.congr_of_sub.2 (f'.is_O_comp _ _) - -lemma has_fderiv_at_filter.is_O_sub (h : has_fderiv_at_filter f f' x L) : - is_O (λ x', f x' - f x) (λ x', x' - x) L := -h.is_O.congr_of_sub.2 (f'.is_O_sub _ _) - -protected lemma has_strict_fderiv_at.has_fderiv_at (hf : has_strict_fderiv_at f f' x) : - has_fderiv_at f f' x := -begin - rw [has_fderiv_at, has_fderiv_at_filter, is_o_iff], - exact (λ c hc, tendsto_id.prod_mk_nhds tendsto_const_nhds (is_o_iff.1 hf hc)) -end - -protected lemma has_strict_fderiv_at.differentiable_at (hf : has_strict_fderiv_at f f' x) : - differentiable_at 𝕜 f x := -hf.has_fderiv_at.differentiable_at - -/-- If `f` is strictly differentiable at `x` with derivative `f'` and `K > ∥f'∥₊`, then `f` is -`K`-Lipschitz in a neighborhood of `x`. -/ -lemma has_strict_fderiv_at.exists_lipschitz_on_with_of_nnnorm_lt (hf : has_strict_fderiv_at f f' x) - (K : ℝ≥0) (hK : ∥f'∥₊ < K) : ∃ s ∈ 𝓝 x, lipschitz_on_with K f s := -begin - have := hf.add_is_O_with (f'.is_O_with_comp _ _) hK, - simp only [sub_add_cancel, is_O_with] at this, - rcases exists_nhds_square this with ⟨U, Uo, xU, hU⟩, - exact ⟨U, Uo.mem_nhds xU, lipschitz_on_with_iff_norm_sub_le.2 $ - λ x hx y hy, hU (mk_mem_prod hx hy)⟩ -end - -/-- If `f` is strictly differentiable at `x` with derivative `f'`, then `f` is Lipschitz in a -neighborhood of `x`. See also `has_strict_fderiv_at.exists_lipschitz_on_with_of_nnnorm_lt` for a -more precise statement. -/ -lemma has_strict_fderiv_at.exists_lipschitz_on_with (hf : has_strict_fderiv_at f f' x) : - ∃ K (s ∈ 𝓝 x), lipschitz_on_with K f s := -(exists_gt _).imp hf.exists_lipschitz_on_with_of_nnnorm_lt - -/-- Directional derivative agrees with `has_fderiv`. -/ -lemma has_fderiv_at.lim (hf : has_fderiv_at f f' x) (v : E) {α : Type*} {c : α → 𝕜} - {l : filter α} (hc : tendsto (λ n, ∥c n∥) l at_top) : - tendsto (λ n, (c n) • (f (x + (c n)⁻¹ • v) - f x)) l (𝓝 (f' v)) := -begin - refine (has_fderiv_within_at_univ.2 hf).lim _ (univ_mem' (λ _, trivial)) hc _, - assume U hU, - refine (eventually_ne_of_tendsto_norm_at_top hc (0:𝕜)).mono (λ y hy, _), - convert mem_of_mem_nhds hU, - dsimp only, - rw [← mul_smul, mul_inv_cancel hy, one_smul] -end - -theorem has_fderiv_at.unique - (h₀ : has_fderiv_at f f₀' x) (h₁ : has_fderiv_at f f₁' x) : f₀' = f₁' := -begin - rw ← has_fderiv_within_at_univ at h₀ h₁, - exact unique_diff_within_at_univ.eq h₀ h₁ -end - -lemma has_fderiv_within_at_inter' (h : t ∈ 𝓝[s] x) : - has_fderiv_within_at f f' (s ∩ t) x ↔ has_fderiv_within_at f f' s x := -by simp [has_fderiv_within_at, nhds_within_restrict'' s h] - -lemma has_fderiv_within_at_inter (h : t ∈ 𝓝 x) : - has_fderiv_within_at f f' (s ∩ t) x ↔ has_fderiv_within_at f f' s x := -by simp [has_fderiv_within_at, nhds_within_restrict' s h] - -lemma has_fderiv_within_at.union (hs : has_fderiv_within_at f f' s x) - (ht : has_fderiv_within_at f f' t x) : - has_fderiv_within_at f f' (s ∪ t) x := -begin - simp only [has_fderiv_within_at, nhds_within_union], - exact hs.join ht, -end - -lemma has_fderiv_within_at.nhds_within (h : has_fderiv_within_at f f' s x) - (ht : s ∈ 𝓝[t] x) : has_fderiv_within_at f f' t x := -(has_fderiv_within_at_inter' ht).1 (h.mono (inter_subset_right _ _)) - -lemma has_fderiv_within_at.has_fderiv_at (h : has_fderiv_within_at f f' s x) (hs : s ∈ 𝓝 x) : - has_fderiv_at f f' x := -by rwa [← univ_inter s, has_fderiv_within_at_inter hs, has_fderiv_within_at_univ] at h - -lemma differentiable_within_at.differentiable_at - (h : differentiable_within_at 𝕜 f s x) (hs : s ∈ 𝓝 x) : differentiable_at 𝕜 f x := -h.imp (λ f' hf', hf'.has_fderiv_at hs) - -lemma differentiable_within_at.has_fderiv_within_at (h : differentiable_within_at 𝕜 f s x) : - has_fderiv_within_at f (fderiv_within 𝕜 f s x) s x := -begin - dunfold fderiv_within, - dunfold differentiable_within_at at h, - rw dif_pos h, - exact classical.some_spec h -end - -lemma differentiable_at.has_fderiv_at (h : differentiable_at 𝕜 f x) : - has_fderiv_at f (fderiv 𝕜 f x) x := -begin - dunfold fderiv, - dunfold differentiable_at at h, - rw dif_pos h, - exact classical.some_spec h -end - -lemma differentiable_on.has_fderiv_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : - has_fderiv_at f (fderiv 𝕜 f x) x := -((h x (mem_of_mem_nhds hs)).differentiable_at hs).has_fderiv_at - -lemma differentiable_on.differentiable_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : - differentiable_at 𝕜 f x := -(h.has_fderiv_at hs).differentiable_at - -lemma differentiable_on.eventually_differentiable_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : - ∀ᶠ y in 𝓝 x, differentiable_at 𝕜 f y := -(eventually_eventually_nhds.2 hs).mono $ λ y, h.differentiable_at - -lemma has_fderiv_at.fderiv (h : has_fderiv_at f f' x) : fderiv 𝕜 f x = f' := -by { ext, rw h.unique h.differentiable_at.has_fderiv_at } - -lemma fderiv_eq {f' : E → E →L[𝕜] F} (h : ∀ x, has_fderiv_at f (f' x) x) : fderiv 𝕜 f = f' := -funext $ λ x, (h x).fderiv - -/-- Converse to the mean value inequality: if `f` is differentiable at `x₀` and `C`-lipschitz -on a neighborhood of `x₀` then it its derivative at `x₀` has norm bounded by `C`. -Version using `fderiv`. -/ -lemma fderiv_at.le_of_lip {f : E → F} {x₀ : E} (hf : differentiable_at 𝕜 f x₀) - {s : set E} (hs : s ∈ 𝓝 x₀) {C : ℝ≥0} (hlip : lipschitz_on_with C f s) : ∥fderiv 𝕜 f x₀∥ ≤ C := -hf.has_fderiv_at.le_of_lip hs hlip - -lemma has_fderiv_within_at.fderiv_within - (h : has_fderiv_within_at f f' s x) (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 f s x = f' := -(hxs.eq h h.differentiable_within_at.has_fderiv_within_at).symm - -/-- If `x` is not in the closure of `s`, then `f` has any derivative at `x` within `s`, -as this statement is empty. -/ -lemma has_fderiv_within_at_of_not_mem_closure (h : x ∉ closure s) : - has_fderiv_within_at f f' s x := -begin - simp only [mem_closure_iff_nhds_within_ne_bot, ne_bot_iff, ne.def, not_not] at h, - simp [has_fderiv_within_at, has_fderiv_at_filter, h, is_o, is_O_with], -end - -lemma differentiable_within_at.mono (h : differentiable_within_at 𝕜 f t x) (st : s ⊆ t) : - differentiable_within_at 𝕜 f s x := -begin - rcases h with ⟨f', hf'⟩, - exact ⟨f', hf'.mono st⟩ -end - -lemma differentiable_within_at_univ : - differentiable_within_at 𝕜 f univ x ↔ differentiable_at 𝕜 f x := -by simp only [differentiable_within_at, has_fderiv_within_at_univ, differentiable_at] - -lemma differentiable_within_at_inter (ht : t ∈ 𝓝 x) : - differentiable_within_at 𝕜 f (s ∩ t) x ↔ differentiable_within_at 𝕜 f s x := -by simp only [differentiable_within_at, has_fderiv_within_at, has_fderiv_at_filter, - nhds_within_restrict' s ht] - -lemma differentiable_within_at_inter' (ht : t ∈ 𝓝[s] x) : - differentiable_within_at 𝕜 f (s ∩ t) x ↔ differentiable_within_at 𝕜 f s x := -by simp only [differentiable_within_at, has_fderiv_within_at, has_fderiv_at_filter, - nhds_within_restrict'' s ht] - -lemma differentiable_within_at.antimono (h : differentiable_within_at 𝕜 f s x) (hst : s ⊆ t) - (hx : s ∈ 𝓝[t] x) : - differentiable_within_at 𝕜 f t x := -by rwa [← differentiable_within_at_inter' hx, inter_eq_self_of_subset_right hst] - -lemma has_fderiv_within_at.antimono (h : has_fderiv_within_at f f' s x) (hst : s ⊆ t) - (hs : unique_diff_within_at 𝕜 s x) (hx : s ∈ 𝓝[t] x) : - has_fderiv_within_at f f' t x := -begin - have h' : has_fderiv_within_at f _ t x := - (h.differentiable_within_at.antimono hst hx).has_fderiv_within_at, - rwa hs.eq h (h'.mono hst), -end - -lemma differentiable_at.differentiable_within_at - (h : differentiable_at 𝕜 f x) : differentiable_within_at 𝕜 f s x := -(differentiable_within_at_univ.2 h).mono (subset_univ _) - -lemma differentiable.differentiable_at (h : differentiable 𝕜 f) : - differentiable_at 𝕜 f x := -h x - -lemma differentiable_at.fderiv_within - (h : differentiable_at 𝕜 f x) (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 f s x = fderiv 𝕜 f x := -begin - apply has_fderiv_within_at.fderiv_within _ hxs, - exact h.has_fderiv_at.has_fderiv_within_at -end - -lemma differentiable_on.mono (h : differentiable_on 𝕜 f t) (st : s ⊆ t) : - differentiable_on 𝕜 f s := -λx hx, (h x (st hx)).mono st - -lemma differentiable_on_univ : - differentiable_on 𝕜 f univ ↔ differentiable 𝕜 f := -by { simp [differentiable_on, differentiable_within_at_univ], refl } - -lemma differentiable.differentiable_on (h : differentiable 𝕜 f) : differentiable_on 𝕜 f s := -(differentiable_on_univ.2 h).mono (subset_univ _) - -lemma differentiable_on_of_locally_differentiable_on - (h : ∀x∈s, ∃u, is_open u ∧ x ∈ u ∧ differentiable_on 𝕜 f (s ∩ u)) : differentiable_on 𝕜 f s := -begin - assume x xs, - rcases h x xs with ⟨t, t_open, xt, ht⟩, - exact (differentiable_within_at_inter (is_open.mem_nhds t_open xt)).1 (ht x ⟨xs, xt⟩) -end - -lemma fderiv_within_subset (st : s ⊆ t) (ht : unique_diff_within_at 𝕜 s x) - (h : differentiable_within_at 𝕜 f t x) : - fderiv_within 𝕜 f s x = fderiv_within 𝕜 f t x := -((differentiable_within_at.has_fderiv_within_at h).mono st).fderiv_within ht - -lemma fderiv_within_subset' (st : s ⊆ t) (ht : unique_diff_within_at 𝕜 s x) (hx : s ∈ 𝓝[t] x) - (h : differentiable_within_at 𝕜 f s x) : - fderiv_within 𝕜 f s x = fderiv_within 𝕜 f t x := -fderiv_within_subset st ht (h.antimono st hx) - -@[simp] lemma fderiv_within_univ : fderiv_within 𝕜 f univ = fderiv 𝕜 f := -begin - ext x : 1, - by_cases h : differentiable_at 𝕜 f x, - { apply has_fderiv_within_at.fderiv_within _ unique_diff_within_at_univ, - rw has_fderiv_within_at_univ, - apply h.has_fderiv_at }, - { have : ¬ differentiable_within_at 𝕜 f univ x, - by contrapose! h; rwa ← differentiable_within_at_univ, - rw [fderiv_zero_of_not_differentiable_at h, - fderiv_within_zero_of_not_differentiable_within_at this] } -end - -lemma fderiv_within_inter (ht : t ∈ 𝓝 x) (hs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 f (s ∩ t) x = fderiv_within 𝕜 f s x := -begin - by_cases h : differentiable_within_at 𝕜 f (s ∩ t) x, - { apply fderiv_within_subset (inter_subset_left _ _) _ ((differentiable_within_at_inter ht).1 h), - apply hs.inter ht }, - { have : ¬ differentiable_within_at 𝕜 f s x, - by contrapose! h; rw differentiable_within_at_inter; assumption, - rw [fderiv_within_zero_of_not_differentiable_within_at h, - fderiv_within_zero_of_not_differentiable_within_at this] } -end - -lemma fderiv_within_of_mem_nhds (h : s ∈ 𝓝 x) : - fderiv_within 𝕜 f s x = fderiv 𝕜 f x := -begin - have : s = univ ∩ s, by simp only [univ_inter], - rw [this, ← fderiv_within_univ], - exact fderiv_within_inter h (unique_diff_on_univ _ (mem_univ _)) -end - -lemma fderiv_within_of_open (hs : is_open s) (hx : x ∈ s) : - fderiv_within 𝕜 f s x = fderiv 𝕜 f x := -fderiv_within_of_mem_nhds (is_open.mem_nhds hs hx) - -lemma fderiv_within_eq_fderiv (hs : unique_diff_within_at 𝕜 s x) (h : differentiable_at 𝕜 f x) : - fderiv_within 𝕜 f s x = fderiv 𝕜 f x := -begin - rw ← fderiv_within_univ, - exact fderiv_within_subset (subset_univ _) hs h.differentiable_within_at -end - -lemma fderiv_mem_iff {f : E → F} {s : set (E →L[𝕜] F)} {x : E} : - fderiv 𝕜 f x ∈ s ↔ (differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ s) ∨ - (0 : E →L[𝕜] F) ∈ s ∧ ¬differentiable_at 𝕜 f x := -begin - split, - { intro hfx, - by_cases hx : differentiable_at 𝕜 f x, - { exact or.inl ⟨hx, hfx⟩ }, - { rw [fderiv_zero_of_not_differentiable_at hx] at hfx, - exact or.inr ⟨hfx, hx⟩ } }, - { rintro (⟨hf, hf'⟩|⟨h₀, hx⟩), - { exact hf' }, - { rwa [fderiv_zero_of_not_differentiable_at hx] } } -end - -end fderiv_properties - -section continuous -/-! ### Deducing continuity from differentiability -/ - -theorem has_fderiv_at_filter.tendsto_nhds - (hL : L ≤ 𝓝 x) (h : has_fderiv_at_filter f f' x L) : - tendsto f L (𝓝 (f x)) := -begin - have : tendsto (λ x', f x' - f x) L (𝓝 0), - { refine h.is_O_sub.trans_tendsto (tendsto.mono_left _ hL), - rw ← sub_self x, exact tendsto_id.sub tendsto_const_nhds }, - have := tendsto.add this tendsto_const_nhds, - rw zero_add (f x) at this, - exact this.congr (by simp) -end - -theorem has_fderiv_within_at.continuous_within_at - (h : has_fderiv_within_at f f' s x) : continuous_within_at f s x := -has_fderiv_at_filter.tendsto_nhds inf_le_left h - -theorem has_fderiv_at.continuous_at (h : has_fderiv_at f f' x) : - continuous_at f x := -has_fderiv_at_filter.tendsto_nhds le_rfl h - -lemma differentiable_within_at.continuous_within_at (h : differentiable_within_at 𝕜 f s x) : - continuous_within_at f s x := -let ⟨f', hf'⟩ := h in hf'.continuous_within_at - -lemma differentiable_at.continuous_at (h : differentiable_at 𝕜 f x) : continuous_at f x := -let ⟨f', hf'⟩ := h in hf'.continuous_at - -lemma differentiable_on.continuous_on (h : differentiable_on 𝕜 f s) : continuous_on f s := -λx hx, (h x hx).continuous_within_at - -lemma differentiable.continuous (h : differentiable 𝕜 f) : continuous f := -continuous_iff_continuous_at.2 $ λx, (h x).continuous_at - -protected lemma has_strict_fderiv_at.continuous_at (hf : has_strict_fderiv_at f f' x) : - continuous_at f x := -hf.has_fderiv_at.continuous_at - -lemma has_strict_fderiv_at.is_O_sub_rev {f' : E ≃L[𝕜] F} - (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) x) : - is_O (λ p : E × E, p.1 - p.2) (λ p : E × E, f p.1 - f p.2) (𝓝 (x, x)) := -((f'.is_O_comp_rev _ _).trans (hf.trans_is_O (f'.is_O_comp_rev _ _)).right_is_O_add).congr -(λ _, rfl) (λ _, sub_add_cancel _ _) - -lemma has_fderiv_at_filter.is_O_sub_rev (hf : has_fderiv_at_filter f f' x L) {C} - (hf' : antilipschitz_with C f') : - is_O (λ x', x' - x) (λ x', f x' - f x) L := -have is_O (λ x', x' - x) (λ x', f' (x' - x)) L, - from is_O_iff.2 ⟨C, eventually_of_forall $ λ x', f'.to_linear_map.bound_of_antilipschitz hf' _⟩, -(this.trans (hf.trans_is_O this).right_is_O_add).congr (λ _, rfl) (λ _, sub_add_cancel _ _) - -end continuous - -section congr -/-! ### congr properties of the derivative -/ - -theorem filter.eventually_eq.has_strict_fderiv_at_iff - (h : f₀ =ᶠ[𝓝 x] f₁) (h' : ∀ y, f₀' y = f₁' y) : - has_strict_fderiv_at f₀ f₀' x ↔ has_strict_fderiv_at f₁ f₁' x := -begin - refine is_o_congr ((h.prod_mk_nhds h).mono _) (eventually_of_forall $ λ _, rfl), - rintros p ⟨hp₁, hp₂⟩, - simp only [*] -end - -theorem has_strict_fderiv_at.congr_of_eventually_eq (h : has_strict_fderiv_at f f' x) - (h₁ : f =ᶠ[𝓝 x] f₁) : has_strict_fderiv_at f₁ f' x := -(h₁.has_strict_fderiv_at_iff (λ _, rfl)).1 h - -theorem filter.eventually_eq.has_fderiv_at_filter_iff - (h₀ : f₀ =ᶠ[L] f₁) (hx : f₀ x = f₁ x) (h₁ : ∀ x, f₀' x = f₁' x) : - has_fderiv_at_filter f₀ f₀' x L ↔ has_fderiv_at_filter f₁ f₁' x L := -is_o_congr (h₀.mono $ λ y hy, by simp only [hy, h₁, hx]) (eventually_of_forall $ λ _, rfl) - -lemma has_fderiv_at_filter.congr_of_eventually_eq (h : has_fderiv_at_filter f f' x L) - (hL : f₁ =ᶠ[L] f) (hx : f₁ x = f x) : has_fderiv_at_filter f₁ f' x L := -(hL.has_fderiv_at_filter_iff hx $ λ _, rfl).2 h - -theorem filter.eventually_eq.has_fderiv_at_iff (h : f₀ =ᶠ[𝓝 x] f₁) : - has_fderiv_at f₀ f' x ↔ has_fderiv_at f₁ f' x := -h.has_fderiv_at_filter_iff h.eq_of_nhds (λ _, rfl) - -theorem filter.eventually_eq.differentiable_at_iff (h : f₀ =ᶠ[𝓝 x] f₁) : - differentiable_at 𝕜 f₀ x ↔ differentiable_at 𝕜 f₁ x := -exists_congr $ λ f', h.has_fderiv_at_iff - -theorem filter.eventually_eq.has_fderiv_within_at_iff (h : f₀ =ᶠ[𝓝[s] x] f₁) (hx : f₀ x = f₁ x) : - has_fderiv_within_at f₀ f' s x ↔ has_fderiv_within_at f₁ f' s x := -h.has_fderiv_at_filter_iff hx (λ _, rfl) - -theorem filter.eventually_eq.has_fderiv_within_at_iff_of_mem (h : f₀ =ᶠ[𝓝[s] x] f₁) (hx : x ∈ s) : - has_fderiv_within_at f₀ f' s x ↔ has_fderiv_within_at f₁ f' s x := -h.has_fderiv_within_at_iff (h.eq_of_nhds_within hx) - -theorem filter.eventually_eq.differentiable_within_at_iff (h : f₀ =ᶠ[𝓝[s] x] f₁) - (hx : f₀ x = f₁ x) : - differentiable_within_at 𝕜 f₀ s x ↔ differentiable_within_at 𝕜 f₁ s x := -exists_congr $ λ f', h.has_fderiv_within_at_iff hx - -theorem filter.eventually_eq.differentiable_within_at_iff_of_mem (h : f₀ =ᶠ[𝓝[s] x] f₁) - (hx : x ∈ s) : - differentiable_within_at 𝕜 f₀ s x ↔ differentiable_within_at 𝕜 f₁ s x := -h.differentiable_within_at_iff (h.eq_of_nhds_within hx) - -lemma has_fderiv_within_at.congr_mono (h : has_fderiv_within_at f f' s x) (ht : ∀x ∈ t, f₁ x = f x) - (hx : f₁ x = f x) (h₁ : t ⊆ s) : has_fderiv_within_at f₁ f' t x := -has_fderiv_at_filter.congr_of_eventually_eq (h.mono h₁) (filter.mem_inf_of_right ht) hx - -lemma has_fderiv_within_at.congr (h : has_fderiv_within_at f f' s x) (hs : ∀x ∈ s, f₁ x = f x) - (hx : f₁ x = f x) : has_fderiv_within_at f₁ f' s x := -h.congr_mono hs hx (subset.refl _) - -lemma has_fderiv_within_at.congr' (h : has_fderiv_within_at f f' s x) (hs : ∀x ∈ s, f₁ x = f x) - (hx : x ∈ s) : has_fderiv_within_at f₁ f' s x := -h.congr hs (hs x hx) - -lemma has_fderiv_within_at.congr_of_eventually_eq (h : has_fderiv_within_at f f' s x) - (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : has_fderiv_within_at f₁ f' s x := -has_fderiv_at_filter.congr_of_eventually_eq h h₁ hx - -lemma has_fderiv_at.congr_of_eventually_eq (h : has_fderiv_at f f' x) - (h₁ : f₁ =ᶠ[𝓝 x] f) : has_fderiv_at f₁ f' x := -has_fderiv_at_filter.congr_of_eventually_eq h h₁ (mem_of_mem_nhds h₁ : _) - -lemma differentiable_within_at.congr_mono (h : differentiable_within_at 𝕜 f s x) - (ht : ∀x ∈ t, f₁ x = f x) (hx : f₁ x = f x) (h₁ : t ⊆ s) : differentiable_within_at 𝕜 f₁ t x := -(has_fderiv_within_at.congr_mono h.has_fderiv_within_at ht hx h₁).differentiable_within_at - -lemma differentiable_within_at.congr (h : differentiable_within_at 𝕜 f s x) - (ht : ∀x ∈ s, f₁ x = f x) (hx : f₁ x = f x) : differentiable_within_at 𝕜 f₁ s x := -differentiable_within_at.congr_mono h ht hx (subset.refl _) - -lemma differentiable_within_at.congr_of_eventually_eq - (h : differentiable_within_at 𝕜 f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) - (hx : f₁ x = f x) : differentiable_within_at 𝕜 f₁ s x := -(h.has_fderiv_within_at.congr_of_eventually_eq h₁ hx).differentiable_within_at - -lemma differentiable_on.congr_mono (h : differentiable_on 𝕜 f s) (h' : ∀x ∈ t, f₁ x = f x) - (h₁ : t ⊆ s) : differentiable_on 𝕜 f₁ t := -λ x hx, (h x (h₁ hx)).congr_mono h' (h' x hx) h₁ - -lemma differentiable_on.congr (h : differentiable_on 𝕜 f s) (h' : ∀x ∈ s, f₁ x = f x) : - differentiable_on 𝕜 f₁ s := -λ x hx, (h x hx).congr h' (h' x hx) - -lemma differentiable_on_congr (h' : ∀x ∈ s, f₁ x = f x) : - differentiable_on 𝕜 f₁ s ↔ differentiable_on 𝕜 f s := -⟨λ h, differentiable_on.congr h (λy hy, (h' y hy).symm), -λ h, differentiable_on.congr h h'⟩ - -lemma differentiable_at.congr_of_eventually_eq (h : differentiable_at 𝕜 f x) (hL : f₁ =ᶠ[𝓝 x] f) : - differentiable_at 𝕜 f₁ x := -hL.differentiable_at_iff.2 h - -lemma differentiable_within_at.fderiv_within_congr_mono (h : differentiable_within_at 𝕜 f s x) - (hs : ∀x ∈ t, f₁ x = f x) (hx : f₁ x = f x) (hxt : unique_diff_within_at 𝕜 t x) (h₁ : t ⊆ s) : - fderiv_within 𝕜 f₁ t x = fderiv_within 𝕜 f s x := -(has_fderiv_within_at.congr_mono h.has_fderiv_within_at hs hx h₁).fderiv_within hxt - -lemma filter.eventually_eq.fderiv_within_eq (hs : unique_diff_within_at 𝕜 s x) - (hL : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : - fderiv_within 𝕜 f₁ s x = fderiv_within 𝕜 f s x := -if h : differentiable_within_at 𝕜 f s x -then has_fderiv_within_at.fderiv_within (h.has_fderiv_within_at.congr_of_eventually_eq hL hx) hs -else - have h' : ¬ differentiable_within_at 𝕜 f₁ s x, - from mt (λ h, h.congr_of_eventually_eq (hL.mono $ λ x, eq.symm) hx.symm) h, - by rw [fderiv_within_zero_of_not_differentiable_within_at h, - fderiv_within_zero_of_not_differentiable_within_at h'] - -lemma fderiv_within_congr (hs : unique_diff_within_at 𝕜 s x) - (hL : ∀y∈s, f₁ y = f y) (hx : f₁ x = f x) : - fderiv_within 𝕜 f₁ s x = fderiv_within 𝕜 f s x := -begin - apply filter.eventually_eq.fderiv_within_eq hs _ hx, - apply mem_of_superset self_mem_nhds_within, - exact hL -end - -lemma filter.eventually_eq.fderiv_eq (hL : f₁ =ᶠ[𝓝 x] f) : - fderiv 𝕜 f₁ x = fderiv 𝕜 f x := -begin - have A : f₁ x = f x := hL.eq_of_nhds, - rw [← fderiv_within_univ, ← fderiv_within_univ], - rw ← nhds_within_univ at hL, - exact hL.fderiv_within_eq unique_diff_within_at_univ A -end - -protected lemma filter.eventually_eq.fderiv (h : f₁ =ᶠ[𝓝 x] f) : - fderiv 𝕜 f₁ =ᶠ[𝓝 x] fderiv 𝕜 f := -h.eventually_eq_nhds.mono $ λ x h, h.fderiv_eq - -end congr - -section id -/-! ### Derivative of the identity -/ - -theorem has_strict_fderiv_at_id (x : E) : - has_strict_fderiv_at id (id 𝕜 E) x := -(is_o_zero _ _).congr_left $ by simp - -theorem has_fderiv_at_filter_id (x : E) (L : filter E) : - has_fderiv_at_filter id (id 𝕜 E) x L := -(is_o_zero _ _).congr_left $ by simp - -theorem has_fderiv_within_at_id (x : E) (s : set E) : - has_fderiv_within_at id (id 𝕜 E) s x := -has_fderiv_at_filter_id _ _ - -theorem has_fderiv_at_id (x : E) : has_fderiv_at id (id 𝕜 E) x := -has_fderiv_at_filter_id _ _ - -@[simp] lemma differentiable_at_id : differentiable_at 𝕜 id x := -(has_fderiv_at_id x).differentiable_at - -@[simp] lemma differentiable_at_id' : differentiable_at 𝕜 (λ x, x) x := -(has_fderiv_at_id x).differentiable_at - -lemma differentiable_within_at_id : differentiable_within_at 𝕜 id s x := -differentiable_at_id.differentiable_within_at - -@[simp] lemma differentiable_id : differentiable 𝕜 (id : E → E) := -λx, differentiable_at_id - -@[simp] lemma differentiable_id' : differentiable 𝕜 (λ (x : E), x) := -λx, differentiable_at_id - -lemma differentiable_on_id : differentiable_on 𝕜 id s := -differentiable_id.differentiable_on - -lemma fderiv_id : fderiv 𝕜 id x = id 𝕜 E := -has_fderiv_at.fderiv (has_fderiv_at_id x) - -@[simp] lemma fderiv_id' : fderiv 𝕜 (λ (x : E), x) x = continuous_linear_map.id 𝕜 E := -fderiv_id - -lemma fderiv_within_id (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 id s x = id 𝕜 E := -begin - rw differentiable_at.fderiv_within (differentiable_at_id) hxs, - exact fderiv_id -end - -lemma fderiv_within_id' (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λ (x : E), x) s x = continuous_linear_map.id 𝕜 E := -fderiv_within_id hxs - -end id - -section const -/-! ### derivative of a constant function -/ - -theorem has_strict_fderiv_at_const (c : F) (x : E) : - has_strict_fderiv_at (λ _, c) (0 : E →L[𝕜] F) x := -(is_o_zero _ _).congr_left $ λ _, by simp only [zero_apply, sub_self] - -theorem has_fderiv_at_filter_const (c : F) (x : E) (L : filter E) : - has_fderiv_at_filter (λ x, c) (0 : E →L[𝕜] F) x L := -(is_o_zero _ _).congr_left $ λ _, by simp only [zero_apply, sub_self] - -theorem has_fderiv_within_at_const (c : F) (x : E) (s : set E) : - has_fderiv_within_at (λ x, c) (0 : E →L[𝕜] F) s x := -has_fderiv_at_filter_const _ _ _ - -theorem has_fderiv_at_const (c : F) (x : E) : - has_fderiv_at (λ x, c) (0 : E →L[𝕜] F) x := -has_fderiv_at_filter_const _ _ _ - -@[simp] lemma differentiable_at_const (c : F) : differentiable_at 𝕜 (λx, c) x := -⟨0, has_fderiv_at_const c x⟩ - -lemma differentiable_within_at_const (c : F) : differentiable_within_at 𝕜 (λx, c) s x := -differentiable_at.differentiable_within_at (differentiable_at_const _) - -lemma fderiv_const_apply (c : F) : fderiv 𝕜 (λy, c) x = 0 := -has_fderiv_at.fderiv (has_fderiv_at_const c x) - -@[simp] lemma fderiv_const (c : F) : fderiv 𝕜 (λ (y : E), c) = 0 := -by { ext m, rw fderiv_const_apply, refl } - -lemma fderiv_within_const_apply (c : F) (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λy, c) s x = 0 := -begin - rw differentiable_at.fderiv_within (differentiable_at_const _) hxs, - exact fderiv_const_apply _ -end - -@[simp] lemma differentiable_const (c : F) : differentiable 𝕜 (λx : E, c) := -λx, differentiable_at_const _ - -lemma differentiable_on_const (c : F) : differentiable_on 𝕜 (λx, c) s := -(differentiable_const _).differentiable_on - -lemma has_fderiv_within_at_singleton (f : E → F) (x : E) : - has_fderiv_within_at f (0 : E →L[𝕜] F) {x} x := -by simp only [has_fderiv_within_at, nhds_within_singleton, has_fderiv_at_filter, is_o_pure, - continuous_linear_map.zero_apply, sub_self] - -lemma has_fderiv_at_of_subsingleton [h : subsingleton E] (f : E → F) (x : E) : - has_fderiv_at f (0 : E →L[𝕜] F) x := -begin - rw [← has_fderiv_within_at_univ, subsingleton_univ.eq_singleton_of_mem (mem_univ x)], - exact has_fderiv_within_at_singleton f x -end - -lemma differentiable_on_empty : differentiable_on 𝕜 f ∅ := λ x, false.elim - -lemma differentiable_on_singleton : differentiable_on 𝕜 f {x} := -forall_eq.2 (has_fderiv_within_at_singleton f x).differentiable_within_at - -lemma set.subsingleton.differentiable_on (hs : s.subsingleton) : differentiable_on 𝕜 f s := -hs.induction_on differentiable_on_empty (λ x, differentiable_on_singleton) - -end const - -section continuous_linear_map -/-! -### Continuous linear maps - -There are currently two variants of these in mathlib, the bundled version -(named `continuous_linear_map`, and denoted `E →L[𝕜] F`), and the unbundled version (with a -predicate `is_bounded_linear_map`). We give statements for both versions. -/ - -protected theorem continuous_linear_map.has_strict_fderiv_at {x : E} : - has_strict_fderiv_at e e x := -(is_o_zero _ _).congr_left $ λ x, by simp only [e.map_sub, sub_self] - -protected lemma continuous_linear_map.has_fderiv_at_filter : - has_fderiv_at_filter e e x L := -(is_o_zero _ _).congr_left $ λ x, by simp only [e.map_sub, sub_self] - -protected lemma continuous_linear_map.has_fderiv_within_at : has_fderiv_within_at e e s x := -e.has_fderiv_at_filter - -protected lemma continuous_linear_map.has_fderiv_at : has_fderiv_at e e x := -e.has_fderiv_at_filter - -@[simp] protected lemma continuous_linear_map.differentiable_at : differentiable_at 𝕜 e x := -e.has_fderiv_at.differentiable_at - -protected lemma continuous_linear_map.differentiable_within_at : differentiable_within_at 𝕜 e s x := -e.differentiable_at.differentiable_within_at - -@[simp] protected lemma continuous_linear_map.fderiv : fderiv 𝕜 e x = e := -e.has_fderiv_at.fderiv - -protected lemma continuous_linear_map.fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 e s x = e := -begin - rw differentiable_at.fderiv_within e.differentiable_at hxs, - exact e.fderiv -end - -@[simp] protected lemma continuous_linear_map.differentiable : differentiable 𝕜 e := -λx, e.differentiable_at - -protected lemma continuous_linear_map.differentiable_on : differentiable_on 𝕜 e s := -e.differentiable.differentiable_on - -lemma is_bounded_linear_map.has_fderiv_at_filter (h : is_bounded_linear_map 𝕜 f) : - has_fderiv_at_filter f h.to_continuous_linear_map x L := -h.to_continuous_linear_map.has_fderiv_at_filter - -lemma is_bounded_linear_map.has_fderiv_within_at (h : is_bounded_linear_map 𝕜 f) : - has_fderiv_within_at f h.to_continuous_linear_map s x := -h.has_fderiv_at_filter - -lemma is_bounded_linear_map.has_fderiv_at (h : is_bounded_linear_map 𝕜 f) : - has_fderiv_at f h.to_continuous_linear_map x := -h.has_fderiv_at_filter - -lemma is_bounded_linear_map.differentiable_at (h : is_bounded_linear_map 𝕜 f) : - differentiable_at 𝕜 f x := -h.has_fderiv_at.differentiable_at - -lemma is_bounded_linear_map.differentiable_within_at (h : is_bounded_linear_map 𝕜 f) : - differentiable_within_at 𝕜 f s x := -h.differentiable_at.differentiable_within_at - -lemma is_bounded_linear_map.fderiv (h : is_bounded_linear_map 𝕜 f) : - fderiv 𝕜 f x = h.to_continuous_linear_map := -has_fderiv_at.fderiv (h.has_fderiv_at) - -lemma is_bounded_linear_map.fderiv_within (h : is_bounded_linear_map 𝕜 f) - (hxs : unique_diff_within_at 𝕜 s x) : fderiv_within 𝕜 f s x = h.to_continuous_linear_map := -begin - rw differentiable_at.fderiv_within h.differentiable_at hxs, - exact h.fderiv -end - -lemma is_bounded_linear_map.differentiable (h : is_bounded_linear_map 𝕜 f) : - differentiable 𝕜 f := -λx, h.differentiable_at - -lemma is_bounded_linear_map.differentiable_on (h : is_bounded_linear_map 𝕜 f) : - differentiable_on 𝕜 f s := -h.differentiable.differentiable_on - -end continuous_linear_map - -section composition -/-! -### Derivative of the composition of two functions - -For composition lemmas, we put x explicit to help the elaborator, as otherwise Lean tends to -get confused since there are too many possibilities for composition -/ - -variable (x) - -theorem has_fderiv_at_filter.comp {g : F → G} {g' : F →L[𝕜] G} {L' : filter F} - (hg : has_fderiv_at_filter g g' (f x) L') - (hf : has_fderiv_at_filter f f' x L) (hL : tendsto f L L') : - has_fderiv_at_filter (g ∘ f) (g'.comp f') x L := -let eq₁ := (g'.is_O_comp _ _).trans_is_o hf in -let eq₂ := (hg.comp_tendsto hL).trans_is_O hf.is_O_sub in -by { refine eq₂.triangle (eq₁.congr_left (λ x', _)), simp } - -/- A readable version of the previous theorem, - a general form of the chain rule. -/ - -example {g : F → G} {g' : F →L[𝕜] G} - (hg : has_fderiv_at_filter g g' (f x) (L.map f)) - (hf : has_fderiv_at_filter f f' x L) : - has_fderiv_at_filter (g ∘ f) (g'.comp f') x L := -begin - unfold has_fderiv_at_filter at hg, - have : is_o (λ x', g (f x') - g (f x) - g' (f x' - f x)) (λ x', f x' - f x) L, - from hg.comp_tendsto le_rfl, - have eq₁ : is_o (λ x', g (f x') - g (f x) - g' (f x' - f x)) (λ x', x' - x) L, - from this.trans_is_O hf.is_O_sub, - have eq₂ : is_o (λ x', f x' - f x - f' (x' - x)) (λ x', x' - x) L, - from hf, - have : is_O - (λ x', g' (f x' - f x - f' (x' - x))) (λ x', f x' - f x - f' (x' - x)) L, - from g'.is_O_comp _ _, - have : is_o (λ x', g' (f x' - f x - f' (x' - x))) (λ x', x' - x) L, - from this.trans_is_o eq₂, - have eq₃ : is_o (λ x', g' (f x' - f x) - (g' (f' (x' - x)))) (λ x', x' - x) L, - by { refine this.congr_left _, simp}, - exact eq₁.triangle eq₃ -end - -theorem has_fderiv_within_at.comp {g : F → G} {g' : F →L[𝕜] G} {t : set F} - (hg : has_fderiv_within_at g g' t (f x)) (hf : has_fderiv_within_at f f' s x) - (hst : maps_to f s t) : - has_fderiv_within_at (g ∘ f) (g'.comp f') s x := -hg.comp x hf $ hf.continuous_within_at.tendsto_nhds_within hst - -theorem has_fderiv_at.comp_has_fderiv_within_at {g : F → G} {g' : F →L[𝕜] G} - (hg : has_fderiv_at g g' (f x)) (hf : has_fderiv_within_at f f' s x) : - has_fderiv_within_at (g ∘ f) (g'.comp f') s x := -hg.comp x hf hf.continuous_within_at - -/-- The chain rule. -/ -theorem has_fderiv_at.comp {g : F → G} {g' : F →L[𝕜] G} - (hg : has_fderiv_at g g' (f x)) (hf : has_fderiv_at f f' x) : - has_fderiv_at (g ∘ f) (g'.comp f') x := -hg.comp x hf hf.continuous_at - -lemma differentiable_within_at.comp {g : F → G} {t : set F} - (hg : differentiable_within_at 𝕜 g t (f x)) (hf : differentiable_within_at 𝕜 f s x) - (h : maps_to f s t) : differentiable_within_at 𝕜 (g ∘ f) s x := -(hg.has_fderiv_within_at.comp x hf.has_fderiv_within_at h).differentiable_within_at - -lemma differentiable_within_at.comp' {g : F → G} {t : set F} - (hg : differentiable_within_at 𝕜 g t (f x)) (hf : differentiable_within_at 𝕜 f s x) : - differentiable_within_at 𝕜 (g ∘ f) (s ∩ f⁻¹' t) x := -hg.comp x (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _) - -lemma differentiable_at.comp {g : F → G} - (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_at 𝕜 f x) : - differentiable_at 𝕜 (g ∘ f) x := -(hg.has_fderiv_at.comp x hf.has_fderiv_at).differentiable_at - -lemma differentiable_at.comp_differentiable_within_at {g : F → G} - (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_within_at 𝕜 f s x) : - differentiable_within_at 𝕜 (g ∘ f) s x := -hg.differentiable_within_at.comp x hf (maps_to_univ _ _) - -lemma fderiv_within.comp {g : F → G} {t : set F} - (hg : differentiable_within_at 𝕜 g t (f x)) (hf : differentiable_within_at 𝕜 f s x) - (h : maps_to f s t) (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (g ∘ f) s x = (fderiv_within 𝕜 g t (f x)).comp (fderiv_within 𝕜 f s x) := -(hg.has_fderiv_within_at.comp x (hf.has_fderiv_within_at) h).fderiv_within hxs - -lemma fderiv.comp {g : F → G} - (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_at 𝕜 f x) : - fderiv 𝕜 (g ∘ f) x = (fderiv 𝕜 g (f x)).comp (fderiv 𝕜 f x) := -(hg.has_fderiv_at.comp x hf.has_fderiv_at).fderiv - -lemma fderiv.comp_fderiv_within {g : F → G} - (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_within_at 𝕜 f s x) - (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (g ∘ f) s x = (fderiv 𝕜 g (f x)).comp (fderiv_within 𝕜 f s x) := -(hg.has_fderiv_at.comp_has_fderiv_within_at x hf.has_fderiv_within_at).fderiv_within hxs - -lemma differentiable_on.comp {g : F → G} {t : set F} - (hg : differentiable_on 𝕜 g t) (hf : differentiable_on 𝕜 f s) (st : maps_to f s t) : - differentiable_on 𝕜 (g ∘ f) s := -λx hx, differentiable_within_at.comp x (hg (f x) (st hx)) (hf x hx) st - -lemma differentiable.comp {g : F → G} (hg : differentiable 𝕜 g) (hf : differentiable 𝕜 f) : - differentiable 𝕜 (g ∘ f) := -λx, differentiable_at.comp x (hg (f x)) (hf x) - -lemma differentiable.comp_differentiable_on {g : F → G} (hg : differentiable 𝕜 g) - (hf : differentiable_on 𝕜 f s) : - differentiable_on 𝕜 (g ∘ f) s := -hg.differentiable_on.comp hf (maps_to_univ _ _) - -/-- The chain rule for derivatives in the sense of strict differentiability. -/ -protected lemma has_strict_fderiv_at.comp {g : F → G} {g' : F →L[𝕜] G} - (hg : has_strict_fderiv_at g g' (f x)) (hf : has_strict_fderiv_at f f' x) : - has_strict_fderiv_at (λ x, g (f x)) (g'.comp f') x := -((hg.comp_tendsto (hf.continuous_at.prod_map' hf.continuous_at)).trans_is_O hf.is_O_sub).triangle $ - by simpa only [g'.map_sub, f'.coe_comp'] using (g'.is_O_comp _ _).trans_is_o hf - -protected lemma differentiable.iterate {f : E → E} (hf : differentiable 𝕜 f) (n : ℕ) : - differentiable 𝕜 (f^[n]) := -nat.rec_on n differentiable_id (λ n ihn, ihn.comp hf) - -protected lemma differentiable_on.iterate {f : E → E} (hf : differentiable_on 𝕜 f s) - (hs : maps_to f s s) (n : ℕ) : - differentiable_on 𝕜 (f^[n]) s := -nat.rec_on n differentiable_on_id (λ n ihn, ihn.comp hf hs) - -variable {x} - -protected lemma has_fderiv_at_filter.iterate {f : E → E} {f' : E →L[𝕜] E} - (hf : has_fderiv_at_filter f f' x L) (hL : tendsto f L L) (hx : f x = x) (n : ℕ) : - has_fderiv_at_filter (f^[n]) (f'^n) x L := -begin - induction n with n ihn, - { exact has_fderiv_at_filter_id x L }, - { rw [function.iterate_succ, pow_succ'], - rw ← hx at ihn, - exact ihn.comp x hf hL } -end - -protected lemma has_fderiv_at.iterate {f : E → E} {f' : E →L[𝕜] E} - (hf : has_fderiv_at f f' x) (hx : f x = x) (n : ℕ) : - has_fderiv_at (f^[n]) (f'^n) x := -begin - refine hf.iterate _ hx n, - convert hf.continuous_at, - exact hx.symm -end - -protected lemma has_fderiv_within_at.iterate {f : E → E} {f' : E →L[𝕜] E} - (hf : has_fderiv_within_at f f' s x) (hx : f x = x) (hs : maps_to f s s) (n : ℕ) : - has_fderiv_within_at (f^[n]) (f'^n) s x := -begin - refine hf.iterate _ hx n, - convert tendsto_inf.2 ⟨hf.continuous_within_at, _⟩, - exacts [hx.symm, (tendsto_principal_principal.2 hs).mono_left inf_le_right] -end - -protected lemma has_strict_fderiv_at.iterate {f : E → E} {f' : E →L[𝕜] E} - (hf : has_strict_fderiv_at f f' x) (hx : f x = x) (n : ℕ) : - has_strict_fderiv_at (f^[n]) (f'^n) x := -begin - induction n with n ihn, - { exact has_strict_fderiv_at_id x }, - { rw [function.iterate_succ, pow_succ'], - rw ← hx at ihn, - exact ihn.comp x hf } -end - -protected lemma differentiable_at.iterate {f : E → E} (hf : differentiable_at 𝕜 f x) - (hx : f x = x) (n : ℕ) : - differentiable_at 𝕜 (f^[n]) x := -(hf.has_fderiv_at.iterate hx n).differentiable_at - -protected lemma differentiable_within_at.iterate {f : E → E} (hf : differentiable_within_at 𝕜 f s x) - (hx : f x = x) (hs : maps_to f s s) (n : ℕ) : - differentiable_within_at 𝕜 (f^[n]) s x := -(hf.has_fderiv_within_at.iterate hx hs n).differentiable_within_at - -end composition - -section cartesian_product -/-! ### Derivative of the cartesian product of two functions -/ - -section prod -variables {f₂ : E → G} {f₂' : E →L[𝕜] G} - -protected lemma has_strict_fderiv_at.prod - (hf₁ : has_strict_fderiv_at f₁ f₁' x) (hf₂ : has_strict_fderiv_at f₂ f₂' x) : - has_strict_fderiv_at (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') x := -hf₁.prod_left hf₂ - -lemma has_fderiv_at_filter.prod - (hf₁ : has_fderiv_at_filter f₁ f₁' x L) (hf₂ : has_fderiv_at_filter f₂ f₂' x L) : - has_fderiv_at_filter (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') x L := -hf₁.prod_left hf₂ - -lemma has_fderiv_within_at.prod - (hf₁ : has_fderiv_within_at f₁ f₁' s x) (hf₂ : has_fderiv_within_at f₂ f₂' s x) : - has_fderiv_within_at (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') s x := -hf₁.prod hf₂ - -lemma has_fderiv_at.prod (hf₁ : has_fderiv_at f₁ f₁' x) (hf₂ : has_fderiv_at f₂ f₂' x) : - has_fderiv_at (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') x := -hf₁.prod hf₂ - -lemma has_fderiv_at_prod_mk_left (e₀ : E) (f₀ : F) : - has_fderiv_at (λ e : E, (e, f₀)) (inl 𝕜 E F) e₀ := -(has_fderiv_at_id e₀).prod (has_fderiv_at_const f₀ e₀) - -lemma has_fderiv_at_prod_mk_right (e₀ : E) (f₀ : F) : - has_fderiv_at (λ f : F, (e₀, f)) (inr 𝕜 E F) f₀ := -(has_fderiv_at_const e₀ f₀).prod (has_fderiv_at_id f₀) - -lemma differentiable_within_at.prod - (hf₁ : differentiable_within_at 𝕜 f₁ s x) (hf₂ : differentiable_within_at 𝕜 f₂ s x) : - differentiable_within_at 𝕜 (λx:E, (f₁ x, f₂ x)) s x := -(hf₁.has_fderiv_within_at.prod hf₂.has_fderiv_within_at).differentiable_within_at - -@[simp] -lemma differentiable_at.prod (hf₁ : differentiable_at 𝕜 f₁ x) (hf₂ : differentiable_at 𝕜 f₂ x) : - differentiable_at 𝕜 (λx:E, (f₁ x, f₂ x)) x := -(hf₁.has_fderiv_at.prod hf₂.has_fderiv_at).differentiable_at - -lemma differentiable_on.prod (hf₁ : differentiable_on 𝕜 f₁ s) (hf₂ : differentiable_on 𝕜 f₂ s) : - differentiable_on 𝕜 (λx:E, (f₁ x, f₂ x)) s := -λx hx, differentiable_within_at.prod (hf₁ x hx) (hf₂ x hx) - -@[simp] -lemma differentiable.prod (hf₁ : differentiable 𝕜 f₁) (hf₂ : differentiable 𝕜 f₂) : - differentiable 𝕜 (λx:E, (f₁ x, f₂ x)) := -λ x, differentiable_at.prod (hf₁ x) (hf₂ x) - -lemma differentiable_at.fderiv_prod - (hf₁ : differentiable_at 𝕜 f₁ x) (hf₂ : differentiable_at 𝕜 f₂ x) : - fderiv 𝕜 (λx:E, (f₁ x, f₂ x)) x = (fderiv 𝕜 f₁ x).prod (fderiv 𝕜 f₂ x) := -(hf₁.has_fderiv_at.prod hf₂.has_fderiv_at).fderiv - -lemma differentiable_at.fderiv_within_prod - (hf₁ : differentiable_within_at 𝕜 f₁ s x) (hf₂ : differentiable_within_at 𝕜 f₂ s x) - (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λx:E, (f₁ x, f₂ x)) s x = - (fderiv_within 𝕜 f₁ s x).prod (fderiv_within 𝕜 f₂ s x) := -(hf₁.has_fderiv_within_at.prod hf₂.has_fderiv_within_at).fderiv_within hxs - -end prod - -section fst - -variables {f₂ : E → F × G} {f₂' : E →L[𝕜] F × G} {p : E × F} - -lemma has_strict_fderiv_at_fst : has_strict_fderiv_at (@prod.fst E F) (fst 𝕜 E F) p := -(fst 𝕜 E F).has_strict_fderiv_at - -protected lemma has_strict_fderiv_at.fst (h : has_strict_fderiv_at f₂ f₂' x) : - has_strict_fderiv_at (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') x := -has_strict_fderiv_at_fst.comp x h - -lemma has_fderiv_at_filter_fst {L : filter (E × F)} : - has_fderiv_at_filter (@prod.fst E F) (fst 𝕜 E F) p L := -(fst 𝕜 E F).has_fderiv_at_filter - -protected lemma has_fderiv_at_filter.fst (h : has_fderiv_at_filter f₂ f₂' x L) : - has_fderiv_at_filter (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') x L := -has_fderiv_at_filter_fst.comp x h tendsto_map - -lemma has_fderiv_at_fst : has_fderiv_at (@prod.fst E F) (fst 𝕜 E F) p := -has_fderiv_at_filter_fst - -protected lemma has_fderiv_at.fst (h : has_fderiv_at f₂ f₂' x) : - has_fderiv_at (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') x := -h.fst - -lemma has_fderiv_within_at_fst {s : set (E × F)} : - has_fderiv_within_at (@prod.fst E F) (fst 𝕜 E F) s p := -has_fderiv_at_filter_fst - -protected lemma has_fderiv_within_at.fst (h : has_fderiv_within_at f₂ f₂' s x) : - has_fderiv_within_at (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') s x := -h.fst - -lemma differentiable_at_fst : differentiable_at 𝕜 prod.fst p := -has_fderiv_at_fst.differentiable_at - -@[simp] protected lemma differentiable_at.fst (h : differentiable_at 𝕜 f₂ x) : - differentiable_at 𝕜 (λ x, (f₂ x).1) x := -differentiable_at_fst.comp x h - -lemma differentiable_fst : differentiable 𝕜 (prod.fst : E × F → E) := -λ x, differentiable_at_fst - -@[simp] protected lemma differentiable.fst (h : differentiable 𝕜 f₂) : - differentiable 𝕜 (λ x, (f₂ x).1) := -differentiable_fst.comp h - -lemma differentiable_within_at_fst {s : set (E × F)} : differentiable_within_at 𝕜 prod.fst s p := -differentiable_at_fst.differentiable_within_at - -protected lemma differentiable_within_at.fst (h : differentiable_within_at 𝕜 f₂ s x) : - differentiable_within_at 𝕜 (λ x, (f₂ x).1) s x := -differentiable_at_fst.comp_differentiable_within_at x h - -lemma differentiable_on_fst {s : set (E × F)} : differentiable_on 𝕜 prod.fst s := -differentiable_fst.differentiable_on - -protected lemma differentiable_on.fst (h : differentiable_on 𝕜 f₂ s) : - differentiable_on 𝕜 (λ x, (f₂ x).1) s := -differentiable_fst.comp_differentiable_on h - -lemma fderiv_fst : fderiv 𝕜 prod.fst p = fst 𝕜 E F := has_fderiv_at_fst.fderiv - -lemma fderiv.fst (h : differentiable_at 𝕜 f₂ x) : - fderiv 𝕜 (λ x, (f₂ x).1) x = (fst 𝕜 F G).comp (fderiv 𝕜 f₂ x) := -h.has_fderiv_at.fst.fderiv - -lemma fderiv_within_fst {s : set (E × F)} (hs : unique_diff_within_at 𝕜 s p) : - fderiv_within 𝕜 prod.fst s p = fst 𝕜 E F := -has_fderiv_within_at_fst.fderiv_within hs - -lemma fderiv_within.fst (hs : unique_diff_within_at 𝕜 s x) (h : differentiable_within_at 𝕜 f₂ s x) : - fderiv_within 𝕜 (λ x, (f₂ x).1) s x = (fst 𝕜 F G).comp (fderiv_within 𝕜 f₂ s x) := -h.has_fderiv_within_at.fst.fderiv_within hs - -end fst - -section snd - -variables {f₂ : E → F × G} {f₂' : E →L[𝕜] F × G} {p : E × F} - -lemma has_strict_fderiv_at_snd : has_strict_fderiv_at (@prod.snd E F) (snd 𝕜 E F) p := -(snd 𝕜 E F).has_strict_fderiv_at - -protected lemma has_strict_fderiv_at.snd (h : has_strict_fderiv_at f₂ f₂' x) : - has_strict_fderiv_at (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') x := -has_strict_fderiv_at_snd.comp x h - -lemma has_fderiv_at_filter_snd {L : filter (E × F)} : - has_fderiv_at_filter (@prod.snd E F) (snd 𝕜 E F) p L := -(snd 𝕜 E F).has_fderiv_at_filter - -protected lemma has_fderiv_at_filter.snd (h : has_fderiv_at_filter f₂ f₂' x L) : - has_fderiv_at_filter (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') x L := -has_fderiv_at_filter_snd.comp x h tendsto_map - -lemma has_fderiv_at_snd : has_fderiv_at (@prod.snd E F) (snd 𝕜 E F) p := -has_fderiv_at_filter_snd - -protected lemma has_fderiv_at.snd (h : has_fderiv_at f₂ f₂' x) : - has_fderiv_at (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') x := -h.snd - -lemma has_fderiv_within_at_snd {s : set (E × F)} : - has_fderiv_within_at (@prod.snd E F) (snd 𝕜 E F) s p := -has_fderiv_at_filter_snd - -protected lemma has_fderiv_within_at.snd (h : has_fderiv_within_at f₂ f₂' s x) : - has_fderiv_within_at (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') s x := -h.snd - -lemma differentiable_at_snd : differentiable_at 𝕜 prod.snd p := -has_fderiv_at_snd.differentiable_at - -@[simp] protected lemma differentiable_at.snd (h : differentiable_at 𝕜 f₂ x) : - differentiable_at 𝕜 (λ x, (f₂ x).2) x := -differentiable_at_snd.comp x h - -lemma differentiable_snd : differentiable 𝕜 (prod.snd : E × F → F) := -λ x, differentiable_at_snd - -@[simp] protected lemma differentiable.snd (h : differentiable 𝕜 f₂) : - differentiable 𝕜 (λ x, (f₂ x).2) := -differentiable_snd.comp h - -lemma differentiable_within_at_snd {s : set (E × F)} : differentiable_within_at 𝕜 prod.snd s p := -differentiable_at_snd.differentiable_within_at - -protected lemma differentiable_within_at.snd (h : differentiable_within_at 𝕜 f₂ s x) : - differentiable_within_at 𝕜 (λ x, (f₂ x).2) s x := -differentiable_at_snd.comp_differentiable_within_at x h - -lemma differentiable_on_snd {s : set (E × F)} : differentiable_on 𝕜 prod.snd s := -differentiable_snd.differentiable_on - -protected lemma differentiable_on.snd (h : differentiable_on 𝕜 f₂ s) : - differentiable_on 𝕜 (λ x, (f₂ x).2) s := -differentiable_snd.comp_differentiable_on h - -lemma fderiv_snd : fderiv 𝕜 prod.snd p = snd 𝕜 E F := has_fderiv_at_snd.fderiv - -lemma fderiv.snd (h : differentiable_at 𝕜 f₂ x) : - fderiv 𝕜 (λ x, (f₂ x).2) x = (snd 𝕜 F G).comp (fderiv 𝕜 f₂ x) := -h.has_fderiv_at.snd.fderiv - -lemma fderiv_within_snd {s : set (E × F)} (hs : unique_diff_within_at 𝕜 s p) : - fderiv_within 𝕜 prod.snd s p = snd 𝕜 E F := -has_fderiv_within_at_snd.fderiv_within hs - -lemma fderiv_within.snd (hs : unique_diff_within_at 𝕜 s x) (h : differentiable_within_at 𝕜 f₂ s x) : - fderiv_within 𝕜 (λ x, (f₂ x).2) s x = (snd 𝕜 F G).comp (fderiv_within 𝕜 f₂ s x) := -h.has_fderiv_within_at.snd.fderiv_within hs - -end snd - -section prod_map - -variables {f₂ : G → G'} {f₂' : G →L[𝕜] G'} {y : G} (p : E × G) - -protected theorem has_strict_fderiv_at.prod_map (hf : has_strict_fderiv_at f f' p.1) - (hf₂ : has_strict_fderiv_at f₂ f₂' p.2) : - has_strict_fderiv_at (prod.map f f₂) (f'.prod_map f₂') p := -(hf.comp p has_strict_fderiv_at_fst).prod (hf₂.comp p has_strict_fderiv_at_snd) - -protected theorem has_fderiv_at.prod_map (hf : has_fderiv_at f f' p.1) - (hf₂ : has_fderiv_at f₂ f₂' p.2) : - has_fderiv_at (prod.map f f₂) (f'.prod_map f₂') p := -(hf.comp p has_fderiv_at_fst).prod (hf₂.comp p has_fderiv_at_snd) - -@[simp] protected theorem differentiable_at.prod_map (hf : differentiable_at 𝕜 f p.1) - (hf₂ : differentiable_at 𝕜 f₂ p.2) : - differentiable_at 𝕜 (λ p : E × G, (f p.1, f₂ p.2)) p := -(hf.comp p differentiable_at_fst).prod (hf₂.comp p differentiable_at_snd) - -end prod_map - -end cartesian_product - -section const_smul - -variables {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] - [has_continuous_const_smul R F] - -/-! ### Derivative of a function multiplied by a constant -/ -theorem has_strict_fderiv_at.const_smul (h : has_strict_fderiv_at f f' x) (c : R) : - has_strict_fderiv_at (λ x, c • f x) (c • f') x := -(c • (1 : F →L[𝕜] F)).has_strict_fderiv_at.comp x h - -theorem has_fderiv_at_filter.const_smul (h : has_fderiv_at_filter f f' x L) (c : R) : - has_fderiv_at_filter (λ x, c • f x) (c • f') x L := -(c • (1 : F →L[𝕜] F)).has_fderiv_at_filter.comp x h tendsto_map - -theorem has_fderiv_within_at.const_smul (h : has_fderiv_within_at f f' s x) (c : R) : - has_fderiv_within_at (λ x, c • f x) (c • f') s x := -h.const_smul c - -theorem has_fderiv_at.const_smul (h : has_fderiv_at f f' x) (c : R) : - has_fderiv_at (λ x, c • f x) (c • f') x := -h.const_smul c - -lemma differentiable_within_at.const_smul (h : differentiable_within_at 𝕜 f s x) (c : R) : - differentiable_within_at 𝕜 (λy, c • f y) s x := -(h.has_fderiv_within_at.const_smul c).differentiable_within_at - -lemma differentiable_at.const_smul (h : differentiable_at 𝕜 f x) (c : R) : - differentiable_at 𝕜 (λy, c • f y) x := -(h.has_fderiv_at.const_smul c).differentiable_at - -lemma differentiable_on.const_smul (h : differentiable_on 𝕜 f s) (c : R) : - differentiable_on 𝕜 (λy, c • f y) s := -λx hx, (h x hx).const_smul c - -lemma differentiable.const_smul (h : differentiable 𝕜 f) (c : R) : - differentiable 𝕜 (λy, c • f y) := -λx, (h x).const_smul c - -lemma fderiv_within_const_smul (hxs : unique_diff_within_at 𝕜 s x) - (h : differentiable_within_at 𝕜 f s x) (c : R) : - fderiv_within 𝕜 (λy, c • f y) s x = c • fderiv_within 𝕜 f s x := -(h.has_fderiv_within_at.const_smul c).fderiv_within hxs - -lemma fderiv_const_smul (h : differentiable_at 𝕜 f x) (c : R) : - fderiv 𝕜 (λy, c • f y) x = c • fderiv 𝕜 f x := -(h.has_fderiv_at.const_smul c).fderiv - -end const_smul - -section add -/-! ### Derivative of the sum of two functions -/ - -theorem has_strict_fderiv_at.add (hf : has_strict_fderiv_at f f' x) - (hg : has_strict_fderiv_at g g' x) : - has_strict_fderiv_at (λ y, f y + g y) (f' + g') x := -(hf.add hg).congr_left $ λ y, by simp; abel - -theorem has_fderiv_at_filter.add - (hf : has_fderiv_at_filter f f' x L) (hg : has_fderiv_at_filter g g' x L) : - has_fderiv_at_filter (λ y, f y + g y) (f' + g') x L := -(hf.add hg).congr_left $ λ _, by simp; abel - -theorem has_fderiv_within_at.add - (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at g g' s x) : - has_fderiv_within_at (λ y, f y + g y) (f' + g') s x := -hf.add hg - -theorem has_fderiv_at.add - (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) : - has_fderiv_at (λ x, f x + g x) (f' + g') x := -hf.add hg - -lemma differentiable_within_at.add - (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : - differentiable_within_at 𝕜 (λ y, f y + g y) s x := -(hf.has_fderiv_within_at.add hg.has_fderiv_within_at).differentiable_within_at - -@[simp] lemma differentiable_at.add - (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : - differentiable_at 𝕜 (λ y, f y + g y) x := -(hf.has_fderiv_at.add hg.has_fderiv_at).differentiable_at - -lemma differentiable_on.add - (hf : differentiable_on 𝕜 f s) (hg : differentiable_on 𝕜 g s) : - differentiable_on 𝕜 (λy, f y + g y) s := -λx hx, (hf x hx).add (hg x hx) - -@[simp] lemma differentiable.add - (hf : differentiable 𝕜 f) (hg : differentiable 𝕜 g) : - differentiable 𝕜 (λy, f y + g y) := -λx, (hf x).add (hg x) - -lemma fderiv_within_add (hxs : unique_diff_within_at 𝕜 s x) - (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : - fderiv_within 𝕜 (λy, f y + g y) s x = fderiv_within 𝕜 f s x + fderiv_within 𝕜 g s x := -(hf.has_fderiv_within_at.add hg.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_add - (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : - fderiv 𝕜 (λy, f y + g y) x = fderiv 𝕜 f x + fderiv 𝕜 g x := -(hf.has_fderiv_at.add hg.has_fderiv_at).fderiv - -theorem has_strict_fderiv_at.add_const (hf : has_strict_fderiv_at f f' x) (c : F) : - has_strict_fderiv_at (λ y, f y + c) f' x := -add_zero f' ▸ hf.add (has_strict_fderiv_at_const _ _) - -theorem has_fderiv_at_filter.add_const - (hf : has_fderiv_at_filter f f' x L) (c : F) : - has_fderiv_at_filter (λ y, f y + c) f' x L := -add_zero f' ▸ hf.add (has_fderiv_at_filter_const _ _ _) - -theorem has_fderiv_within_at.add_const - (hf : has_fderiv_within_at f f' s x) (c : F) : - has_fderiv_within_at (λ y, f y + c) f' s x := -hf.add_const c - -theorem has_fderiv_at.add_const (hf : has_fderiv_at f f' x) (c : F): - has_fderiv_at (λ x, f x + c) f' x := -hf.add_const c - -lemma differentiable_within_at.add_const - (hf : differentiable_within_at 𝕜 f s x) (c : F) : - differentiable_within_at 𝕜 (λ y, f y + c) s x := -(hf.has_fderiv_within_at.add_const c).differentiable_within_at - -@[simp] lemma differentiable_within_at_add_const_iff (c : F) : - differentiable_within_at 𝕜 (λ y, f y + c) s x ↔ differentiable_within_at 𝕜 f s x := -⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ - -lemma differentiable_at.add_const - (hf : differentiable_at 𝕜 f x) (c : F) : - differentiable_at 𝕜 (λ y, f y + c) x := -(hf.has_fderiv_at.add_const c).differentiable_at - -@[simp] lemma differentiable_at_add_const_iff (c : F) : - differentiable_at 𝕜 (λ y, f y + c) x ↔ differentiable_at 𝕜 f x := -⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ - -lemma differentiable_on.add_const - (hf : differentiable_on 𝕜 f s) (c : F) : - differentiable_on 𝕜 (λy, f y + c) s := -λx hx, (hf x hx).add_const c - -@[simp] lemma differentiable_on_add_const_iff (c : F) : - differentiable_on 𝕜 (λ y, f y + c) s ↔ differentiable_on 𝕜 f s := -⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ - -lemma differentiable.add_const - (hf : differentiable 𝕜 f) (c : F) : - differentiable 𝕜 (λy, f y + c) := -λx, (hf x).add_const c - -@[simp] lemma differentiable_add_const_iff (c : F) : - differentiable 𝕜 (λ y, f y + c) ↔ differentiable 𝕜 f := -⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ - -lemma fderiv_within_add_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - fderiv_within 𝕜 (λy, f y + c) s x = fderiv_within 𝕜 f s x := -if hf : differentiable_within_at 𝕜 f s x -then (hf.has_fderiv_within_at.add_const c).fderiv_within hxs -else by { rw [fderiv_within_zero_of_not_differentiable_within_at hf, - fderiv_within_zero_of_not_differentiable_within_at], simpa } - -lemma fderiv_add_const (c : F) : fderiv 𝕜 (λy, f y + c) x = fderiv 𝕜 f x := -by simp only [← fderiv_within_univ, fderiv_within_add_const unique_diff_within_at_univ] - -theorem has_strict_fderiv_at.const_add (hf : has_strict_fderiv_at f f' x) (c : F) : - has_strict_fderiv_at (λ y, c + f y) f' x := -zero_add f' ▸ (has_strict_fderiv_at_const _ _).add hf - -theorem has_fderiv_at_filter.const_add - (hf : has_fderiv_at_filter f f' x L) (c : F) : - has_fderiv_at_filter (λ y, c + f y) f' x L := -zero_add f' ▸ (has_fderiv_at_filter_const _ _ _).add hf - -theorem has_fderiv_within_at.const_add - (hf : has_fderiv_within_at f f' s x) (c : F) : - has_fderiv_within_at (λ y, c + f y) f' s x := -hf.const_add c - -theorem has_fderiv_at.const_add - (hf : has_fderiv_at f f' x) (c : F): - has_fderiv_at (λ x, c + f x) f' x := -hf.const_add c - -lemma differentiable_within_at.const_add - (hf : differentiable_within_at 𝕜 f s x) (c : F) : - differentiable_within_at 𝕜 (λ y, c + f y) s x := -(hf.has_fderiv_within_at.const_add c).differentiable_within_at - -@[simp] lemma differentiable_within_at_const_add_iff (c : F) : - differentiable_within_at 𝕜 (λ y, c + f y) s x ↔ differentiable_within_at 𝕜 f s x := -⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ - -lemma differentiable_at.const_add - (hf : differentiable_at 𝕜 f x) (c : F) : - differentiable_at 𝕜 (λ y, c + f y) x := -(hf.has_fderiv_at.const_add c).differentiable_at - -@[simp] lemma differentiable_at_const_add_iff (c : F) : - differentiable_at 𝕜 (λ y, c + f y) x ↔ differentiable_at 𝕜 f x := -⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ - -lemma differentiable_on.const_add (hf : differentiable_on 𝕜 f s) (c : F) : - differentiable_on 𝕜 (λy, c + f y) s := -λx hx, (hf x hx).const_add c - -@[simp] lemma differentiable_on_const_add_iff (c : F) : - differentiable_on 𝕜 (λ y, c + f y) s ↔ differentiable_on 𝕜 f s := -⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ - -lemma differentiable.const_add (hf : differentiable 𝕜 f) (c : F) : - differentiable 𝕜 (λy, c + f y) := -λx, (hf x).const_add c - -@[simp] lemma differentiable_const_add_iff (c : F) : - differentiable 𝕜 (λ y, c + f y) ↔ differentiable 𝕜 f := -⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ - -lemma fderiv_within_const_add (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - fderiv_within 𝕜 (λy, c + f y) s x = fderiv_within 𝕜 f s x := -by simpa only [add_comm] using fderiv_within_add_const hxs c - -lemma fderiv_const_add (c : F) : fderiv 𝕜 (λy, c + f y) x = fderiv 𝕜 f x := -by simp only [add_comm c, fderiv_add_const] - -end add - -section sum -/-! ### Derivative of a finite sum of functions -/ - -open_locale big_operators - -variables {ι : Type*} {u : finset ι} {A : ι → (E → F)} {A' : ι → (E →L[𝕜] F)} - -theorem has_strict_fderiv_at.sum (h : ∀ i ∈ u, has_strict_fderiv_at (A i) (A' i) x) : - has_strict_fderiv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := -begin - dsimp [has_strict_fderiv_at] at *, - convert is_o.sum h, - simp [finset.sum_sub_distrib, continuous_linear_map.sum_apply] -end - -theorem has_fderiv_at_filter.sum (h : ∀ i ∈ u, has_fderiv_at_filter (A i) (A' i) x L) : - has_fderiv_at_filter (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x L := -begin - dsimp [has_fderiv_at_filter] at *, - convert is_o.sum h, - simp [continuous_linear_map.sum_apply] -end - -theorem has_fderiv_within_at.sum (h : ∀ i ∈ u, has_fderiv_within_at (A i) (A' i) s x) : - has_fderiv_within_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) s x := -has_fderiv_at_filter.sum h - -theorem has_fderiv_at.sum (h : ∀ i ∈ u, has_fderiv_at (A i) (A' i) x) : - has_fderiv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := -has_fderiv_at_filter.sum h - -theorem differentiable_within_at.sum (h : ∀ i ∈ u, differentiable_within_at 𝕜 (A i) s x) : - differentiable_within_at 𝕜 (λ y, ∑ i in u, A i y) s x := -has_fderiv_within_at.differentiable_within_at $ has_fderiv_within_at.sum $ -λ i hi, (h i hi).has_fderiv_within_at - -@[simp] theorem differentiable_at.sum (h : ∀ i ∈ u, differentiable_at 𝕜 (A i) x) : - differentiable_at 𝕜 (λ y, ∑ i in u, A i y) x := -has_fderiv_at.differentiable_at $ has_fderiv_at.sum $ λ i hi, (h i hi).has_fderiv_at - -theorem differentiable_on.sum (h : ∀ i ∈ u, differentiable_on 𝕜 (A i) s) : - differentiable_on 𝕜 (λ y, ∑ i in u, A i y) s := -λ x hx, differentiable_within_at.sum $ λ i hi, h i hi x hx - -@[simp] theorem differentiable.sum (h : ∀ i ∈ u, differentiable 𝕜 (A i)) : - differentiable 𝕜 (λ y, ∑ i in u, A i y) := -λ x, differentiable_at.sum $ λ i hi, h i hi x - -theorem fderiv_within_sum (hxs : unique_diff_within_at 𝕜 s x) - (h : ∀ i ∈ u, differentiable_within_at 𝕜 (A i) s x) : - fderiv_within 𝕜 (λ y, ∑ i in u, A i y) s x = (∑ i in u, fderiv_within 𝕜 (A i) s x) := -(has_fderiv_within_at.sum (λ i hi, (h i hi).has_fderiv_within_at)).fderiv_within hxs - -theorem fderiv_sum (h : ∀ i ∈ u, differentiable_at 𝕜 (A i) x) : - fderiv 𝕜 (λ y, ∑ i in u, A i y) x = (∑ i in u, fderiv 𝕜 (A i) x) := -(has_fderiv_at.sum (λ i hi, (h i hi).has_fderiv_at)).fderiv - -end sum - -section pi - -/-! -### Derivatives of functions `f : E → Π i, F' i` - -In this section we formulate `has_*fderiv*_pi` theorems as `iff`s, and provide two versions of each -theorem: - -* the version without `'` deals with `φ : Π i, E → F' i` and `φ' : Π i, E →L[𝕜] F' i` - and is designed to deduce differentiability of `λ x i, φ i x` from differentiability - of each `φ i`; -* the version with `'` deals with `Φ : E → Π i, F' i` and `Φ' : E →L[𝕜] Π i, F' i` - and is designed to deduce differentiability of the components `λ x, Φ x i` from - differentiability of `Φ`. --/ - -variables {ι : Type*} [fintype ι] {F' : ι → Type*} [Π i, normed_group (F' i)] - [Π i, normed_space 𝕜 (F' i)] {φ : Π i, E → F' i} {φ' : Π i, E →L[𝕜] F' i} - {Φ : E → Π i, F' i} {Φ' : E →L[𝕜] Π i, F' i} - -@[simp] lemma has_strict_fderiv_at_pi' : - has_strict_fderiv_at Φ Φ' x ↔ - ∀ i, has_strict_fderiv_at (λ x, Φ x i) ((proj i).comp Φ') x := -begin - simp only [has_strict_fderiv_at, continuous_linear_map.coe_pi], - exact is_o_pi -end - -@[simp] lemma has_strict_fderiv_at_pi : - has_strict_fderiv_at (λ x i, φ i x) (continuous_linear_map.pi φ') x ↔ - ∀ i, has_strict_fderiv_at (φ i) (φ' i) x := -has_strict_fderiv_at_pi' - -@[simp] lemma has_fderiv_at_filter_pi' : - has_fderiv_at_filter Φ Φ' x L ↔ - ∀ i, has_fderiv_at_filter (λ x, Φ x i) ((proj i).comp Φ') x L := -begin - simp only [has_fderiv_at_filter, continuous_linear_map.coe_pi], - exact is_o_pi -end - -lemma has_fderiv_at_filter_pi : - has_fderiv_at_filter (λ x i, φ i x) (continuous_linear_map.pi φ') x L ↔ - ∀ i, has_fderiv_at_filter (φ i) (φ' i) x L := -has_fderiv_at_filter_pi' - -@[simp] lemma has_fderiv_at_pi' : - has_fderiv_at Φ Φ' x ↔ - ∀ i, has_fderiv_at (λ x, Φ x i) ((proj i).comp Φ') x := -has_fderiv_at_filter_pi' - -lemma has_fderiv_at_pi : - has_fderiv_at (λ x i, φ i x) (continuous_linear_map.pi φ') x ↔ - ∀ i, has_fderiv_at (φ i) (φ' i) x := -has_fderiv_at_filter_pi - -@[simp] lemma has_fderiv_within_at_pi' : - has_fderiv_within_at Φ Φ' s x ↔ - ∀ i, has_fderiv_within_at (λ x, Φ x i) ((proj i).comp Φ') s x := -has_fderiv_at_filter_pi' - -lemma has_fderiv_within_at_pi : - has_fderiv_within_at (λ x i, φ i x) (continuous_linear_map.pi φ') s x ↔ - ∀ i, has_fderiv_within_at (φ i) (φ' i) s x := -has_fderiv_at_filter_pi - -@[simp] lemma differentiable_within_at_pi : - differentiable_within_at 𝕜 Φ s x ↔ - ∀ i, differentiable_within_at 𝕜 (λ x, Φ x i) s x := -⟨λ h i, (has_fderiv_within_at_pi'.1 h.has_fderiv_within_at i).differentiable_within_at, - λ h, (has_fderiv_within_at_pi.2 (λ i, (h i).has_fderiv_within_at)).differentiable_within_at⟩ - -@[simp] lemma differentiable_at_pi : - differentiable_at 𝕜 Φ x ↔ ∀ i, differentiable_at 𝕜 (λ x, Φ x i) x := -⟨λ h i, (has_fderiv_at_pi'.1 h.has_fderiv_at i).differentiable_at, - λ h, (has_fderiv_at_pi.2 (λ i, (h i).has_fderiv_at)).differentiable_at⟩ - -lemma differentiable_on_pi : - differentiable_on 𝕜 Φ s ↔ ∀ i, differentiable_on 𝕜 (λ x, Φ x i) s := -⟨λ h i x hx, differentiable_within_at_pi.1 (h x hx) i, - λ h x hx, differentiable_within_at_pi.2 (λ i, h i x hx)⟩ - -lemma differentiable_pi : - differentiable 𝕜 Φ ↔ ∀ i, differentiable 𝕜 (λ x, Φ x i) := -⟨λ h i x, differentiable_at_pi.1 (h x) i, λ h x, differentiable_at_pi.2 (λ i, h i x)⟩ - --- TODO: find out which version (`φ` or `Φ`) works better with `rw`/`simp` -lemma fderiv_within_pi (h : ∀ i, differentiable_within_at 𝕜 (φ i) s x) - (hs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λ x i, φ i x) s x = pi (λ i, fderiv_within 𝕜 (φ i) s x) := -(has_fderiv_within_at_pi.2 (λ i, (h i).has_fderiv_within_at)).fderiv_within hs - -lemma fderiv_pi (h : ∀ i, differentiable_at 𝕜 (φ i) x) : - fderiv 𝕜 (λ x i, φ i x) x = pi (λ i, fderiv 𝕜 (φ i) x) := -(has_fderiv_at_pi.2 (λ i, (h i).has_fderiv_at)).fderiv - -end pi - -section neg -/-! ### Derivative of the negative of a function -/ - -theorem has_strict_fderiv_at.neg (h : has_strict_fderiv_at f f' x) : - has_strict_fderiv_at (λ x, -f x) (-f') x := -(-1 : F →L[𝕜] F).has_strict_fderiv_at.comp x h - -theorem has_fderiv_at_filter.neg (h : has_fderiv_at_filter f f' x L) : - has_fderiv_at_filter (λ x, -f x) (-f') x L := -(-1 : F →L[𝕜] F).has_fderiv_at_filter.comp x h tendsto_map - -theorem has_fderiv_within_at.neg (h : has_fderiv_within_at f f' s x) : - has_fderiv_within_at (λ x, -f x) (-f') s x := -h.neg - -theorem has_fderiv_at.neg (h : has_fderiv_at f f' x) : - has_fderiv_at (λ x, -f x) (-f') x := -h.neg - -lemma differentiable_within_at.neg (h : differentiable_within_at 𝕜 f s x) : - differentiable_within_at 𝕜 (λy, -f y) s x := -h.has_fderiv_within_at.neg.differentiable_within_at - -@[simp] lemma differentiable_within_at_neg_iff : - differentiable_within_at 𝕜 (λy, -f y) s x ↔ differentiable_within_at 𝕜 f s x := -⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ - -lemma differentiable_at.neg (h : differentiable_at 𝕜 f x) : - differentiable_at 𝕜 (λy, -f y) x := -h.has_fderiv_at.neg.differentiable_at - -@[simp] lemma differentiable_at_neg_iff : - differentiable_at 𝕜 (λy, -f y) x ↔ differentiable_at 𝕜 f x := -⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ - -lemma differentiable_on.neg (h : differentiable_on 𝕜 f s) : - differentiable_on 𝕜 (λy, -f y) s := -λx hx, (h x hx).neg - -@[simp] lemma differentiable_on_neg_iff : - differentiable_on 𝕜 (λy, -f y) s ↔ differentiable_on 𝕜 f s := -⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ - -lemma differentiable.neg (h : differentiable 𝕜 f) : - differentiable 𝕜 (λy, -f y) := -λx, (h x).neg - -@[simp] lemma differentiable_neg_iff : differentiable 𝕜 (λy, -f y) ↔ differentiable 𝕜 f := -⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ - -lemma fderiv_within_neg (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (λy, -f y) s x = - fderiv_within 𝕜 f s x := -if h : differentiable_within_at 𝕜 f s x -then h.has_fderiv_within_at.neg.fderiv_within hxs -else by { rw [fderiv_within_zero_of_not_differentiable_within_at h, - fderiv_within_zero_of_not_differentiable_within_at, neg_zero], simpa } - -@[simp] lemma fderiv_neg : fderiv 𝕜 (λy, -f y) x = - fderiv 𝕜 f x := -by simp only [← fderiv_within_univ, fderiv_within_neg unique_diff_within_at_univ] - -end neg - -section sub -/-! ### Derivative of the difference of two functions -/ - -theorem has_strict_fderiv_at.sub - (hf : has_strict_fderiv_at f f' x) (hg : has_strict_fderiv_at g g' x) : - has_strict_fderiv_at (λ x, f x - g x) (f' - g') x := -by simpa only [sub_eq_add_neg] using hf.add hg.neg - -theorem has_fderiv_at_filter.sub - (hf : has_fderiv_at_filter f f' x L) (hg : has_fderiv_at_filter g g' x L) : - has_fderiv_at_filter (λ x, f x - g x) (f' - g') x L := -by simpa only [sub_eq_add_neg] using hf.add hg.neg - -theorem has_fderiv_within_at.sub - (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at g g' s x) : - has_fderiv_within_at (λ x, f x - g x) (f' - g') s x := -hf.sub hg - -theorem has_fderiv_at.sub - (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) : - has_fderiv_at (λ x, f x - g x) (f' - g') x := -hf.sub hg - -lemma differentiable_within_at.sub - (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : - differentiable_within_at 𝕜 (λ y, f y - g y) s x := -(hf.has_fderiv_within_at.sub hg.has_fderiv_within_at).differentiable_within_at - -@[simp] lemma differentiable_at.sub - (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : - differentiable_at 𝕜 (λ y, f y - g y) x := -(hf.has_fderiv_at.sub hg.has_fderiv_at).differentiable_at - -lemma differentiable_on.sub - (hf : differentiable_on 𝕜 f s) (hg : differentiable_on 𝕜 g s) : - differentiable_on 𝕜 (λy, f y - g y) s := -λx hx, (hf x hx).sub (hg x hx) - -@[simp] lemma differentiable.sub - (hf : differentiable 𝕜 f) (hg : differentiable 𝕜 g) : - differentiable 𝕜 (λy, f y - g y) := -λx, (hf x).sub (hg x) - -lemma fderiv_within_sub (hxs : unique_diff_within_at 𝕜 s x) - (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : - fderiv_within 𝕜 (λy, f y - g y) s x = fderiv_within 𝕜 f s x - fderiv_within 𝕜 g s x := -(hf.has_fderiv_within_at.sub hg.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_sub - (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : - fderiv 𝕜 (λy, f y - g y) x = fderiv 𝕜 f x - fderiv 𝕜 g x := -(hf.has_fderiv_at.sub hg.has_fderiv_at).fderiv - -theorem has_strict_fderiv_at.sub_const - (hf : has_strict_fderiv_at f f' x) (c : F) : - has_strict_fderiv_at (λ x, f x - c) f' x := -by simpa only [sub_eq_add_neg] using hf.add_const (-c) - -theorem has_fderiv_at_filter.sub_const - (hf : has_fderiv_at_filter f f' x L) (c : F) : - has_fderiv_at_filter (λ x, f x - c) f' x L := -by simpa only [sub_eq_add_neg] using hf.add_const (-c) - -theorem has_fderiv_within_at.sub_const - (hf : has_fderiv_within_at f f' s x) (c : F) : - has_fderiv_within_at (λ x, f x - c) f' s x := -hf.sub_const c - -theorem has_fderiv_at.sub_const - (hf : has_fderiv_at f f' x) (c : F) : - has_fderiv_at (λ x, f x - c) f' x := -hf.sub_const c - -lemma differentiable_within_at.sub_const - (hf : differentiable_within_at 𝕜 f s x) (c : F) : - differentiable_within_at 𝕜 (λ y, f y - c) s x := -(hf.has_fderiv_within_at.sub_const c).differentiable_within_at - -@[simp] lemma differentiable_within_at_sub_const_iff (c : F) : - differentiable_within_at 𝕜 (λ y, f y - c) s x ↔ differentiable_within_at 𝕜 f s x := -by simp only [sub_eq_add_neg, differentiable_within_at_add_const_iff] - -lemma differentiable_at.sub_const (hf : differentiable_at 𝕜 f x) (c : F) : - differentiable_at 𝕜 (λ y, f y - c) x := -(hf.has_fderiv_at.sub_const c).differentiable_at - -@[simp] lemma differentiable_at_sub_const_iff (c : F) : - differentiable_at 𝕜 (λ y, f y - c) x ↔ differentiable_at 𝕜 f x := -by simp only [sub_eq_add_neg, differentiable_at_add_const_iff] - -lemma differentiable_on.sub_const (hf : differentiable_on 𝕜 f s) (c : F) : - differentiable_on 𝕜 (λy, f y - c) s := -λx hx, (hf x hx).sub_const c - -@[simp] lemma differentiable_on_sub_const_iff (c : F) : - differentiable_on 𝕜 (λ y, f y - c) s ↔ differentiable_on 𝕜 f s := -by simp only [sub_eq_add_neg, differentiable_on_add_const_iff] - -lemma differentiable.sub_const (hf : differentiable 𝕜 f) (c : F) : - differentiable 𝕜 (λy, f y - c) := -λx, (hf x).sub_const c - -@[simp] lemma differentiable_sub_const_iff (c : F) : - differentiable 𝕜 (λ y, f y - c) ↔ differentiable 𝕜 f := -by simp only [sub_eq_add_neg, differentiable_add_const_iff] - -lemma fderiv_within_sub_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - fderiv_within 𝕜 (λy, f y - c) s x = fderiv_within 𝕜 f s x := -by simp only [sub_eq_add_neg, fderiv_within_add_const hxs] - -lemma fderiv_sub_const (c : F) : fderiv 𝕜 (λy, f y - c) x = fderiv 𝕜 f x := -by simp only [sub_eq_add_neg, fderiv_add_const] - -theorem has_strict_fderiv_at.const_sub - (hf : has_strict_fderiv_at f f' x) (c : F) : - has_strict_fderiv_at (λ x, c - f x) (-f') x := -by simpa only [sub_eq_add_neg] using hf.neg.const_add c - -theorem has_fderiv_at_filter.const_sub - (hf : has_fderiv_at_filter f f' x L) (c : F) : - has_fderiv_at_filter (λ x, c - f x) (-f') x L := -by simpa only [sub_eq_add_neg] using hf.neg.const_add c - -theorem has_fderiv_within_at.const_sub - (hf : has_fderiv_within_at f f' s x) (c : F) : - has_fderiv_within_at (λ x, c - f x) (-f') s x := -hf.const_sub c - -theorem has_fderiv_at.const_sub - (hf : has_fderiv_at f f' x) (c : F) : - has_fderiv_at (λ x, c - f x) (-f') x := -hf.const_sub c - -lemma differentiable_within_at.const_sub - (hf : differentiable_within_at 𝕜 f s x) (c : F) : - differentiable_within_at 𝕜 (λ y, c - f y) s x := -(hf.has_fderiv_within_at.const_sub c).differentiable_within_at - -@[simp] lemma differentiable_within_at_const_sub_iff (c : F) : - differentiable_within_at 𝕜 (λ y, c - f y) s x ↔ differentiable_within_at 𝕜 f s x := -by simp [sub_eq_add_neg] - -lemma differentiable_at.const_sub - (hf : differentiable_at 𝕜 f x) (c : F) : - differentiable_at 𝕜 (λ y, c - f y) x := -(hf.has_fderiv_at.const_sub c).differentiable_at - -@[simp] lemma differentiable_at_const_sub_iff (c : F) : - differentiable_at 𝕜 (λ y, c - f y) x ↔ differentiable_at 𝕜 f x := -by simp [sub_eq_add_neg] - -lemma differentiable_on.const_sub (hf : differentiable_on 𝕜 f s) (c : F) : - differentiable_on 𝕜 (λy, c - f y) s := -λx hx, (hf x hx).const_sub c - -@[simp] lemma differentiable_on_const_sub_iff (c : F) : - differentiable_on 𝕜 (λ y, c - f y) s ↔ differentiable_on 𝕜 f s := -by simp [sub_eq_add_neg] - -lemma differentiable.const_sub (hf : differentiable 𝕜 f) (c : F) : - differentiable 𝕜 (λy, c - f y) := -λx, (hf x).const_sub c - -@[simp] lemma differentiable_const_sub_iff (c : F) : - differentiable 𝕜 (λ y, c - f y) ↔ differentiable 𝕜 f := -by simp [sub_eq_add_neg] - -lemma fderiv_within_const_sub (hxs : unique_diff_within_at 𝕜 s x) (c : F) : - fderiv_within 𝕜 (λy, c - f y) s x = -fderiv_within 𝕜 f s x := -by simp only [sub_eq_add_neg, fderiv_within_const_add, fderiv_within_neg, hxs] - -lemma fderiv_const_sub (c : F) : fderiv 𝕜 (λy, c - f y) x = -fderiv 𝕜 f x := -by simp only [← fderiv_within_univ, fderiv_within_const_sub unique_diff_within_at_univ] - -end sub - -section bilinear_map -/-! ### Derivative of a bounded bilinear map -/ - -variables {b : E × F → G} {u : set (E × F) } - -open normed_field - -lemma is_bounded_bilinear_map.has_strict_fderiv_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : - has_strict_fderiv_at b (h.deriv p) p := -begin - rw has_strict_fderiv_at, - set T := (E × F) × (E × F), - have : is_o (λ q : T, b (q.1 - q.2)) (λ q : T, ∥q.1 - q.2∥ * 1) (𝓝 (p, p)), - { refine (h.is_O'.comp_tendsto le_top).trans_is_o _, - simp only [(∘)], - refine (is_O_refl (λ q : T, ∥q.1 - q.2∥) _).mul_is_o (is_o.norm_left $ (is_o_one_iff _).2 _), - rw [← sub_self p], - exact continuous_at_fst.sub continuous_at_snd }, - simp only [mul_one, is_o_norm_right] at this, - refine (is_o.congr_of_sub _).1 this, clear this, - convert_to is_o (λ q : T, h.deriv (p - q.2) (q.1 - q.2)) (λ q : T, q.1 - q.2) (𝓝 (p, p)), - { ext ⟨⟨x₁, y₁⟩, ⟨x₂, y₂⟩⟩, rcases p with ⟨x, y⟩, - simp only [is_bounded_bilinear_map_deriv_coe, prod.mk_sub_mk, h.map_sub_left, h.map_sub_right], - abel }, - have : is_o (λ q : T, p - q.2) (λ q, (1:ℝ)) (𝓝 (p, p)), - from (is_o_one_iff _).2 (sub_self p ▸ tendsto_const_nhds.sub continuous_at_snd), - apply is_bounded_bilinear_map_apply.is_O_comp.trans_is_o, - refine is_o.trans_is_O _ (is_O_const_mul_self 1 _ _).of_norm_right, - refine is_o.mul_is_O _ (is_O_refl _ _), - exact (((h.is_bounded_linear_map_deriv.is_O_id ⊤).comp_tendsto le_top : _).trans_is_o - this).norm_left -end - -lemma is_bounded_bilinear_map.has_fderiv_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : - has_fderiv_at b (h.deriv p) p := -(h.has_strict_fderiv_at p).has_fderiv_at - -lemma is_bounded_bilinear_map.has_fderiv_within_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : - has_fderiv_within_at b (h.deriv p) u p := -(h.has_fderiv_at p).has_fderiv_within_at - -lemma is_bounded_bilinear_map.differentiable_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : - differentiable_at 𝕜 b p := -(h.has_fderiv_at p).differentiable_at - -lemma is_bounded_bilinear_map.differentiable_within_at (h : is_bounded_bilinear_map 𝕜 b) - (p : E × F) : - differentiable_within_at 𝕜 b u p := -(h.differentiable_at p).differentiable_within_at - -lemma is_bounded_bilinear_map.fderiv (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : - fderiv 𝕜 b p = h.deriv p := -has_fderiv_at.fderiv (h.has_fderiv_at p) - -lemma is_bounded_bilinear_map.fderiv_within (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) - (hxs : unique_diff_within_at 𝕜 u p) : fderiv_within 𝕜 b u p = h.deriv p := -begin - rw differentiable_at.fderiv_within (h.differentiable_at p) hxs, - exact h.fderiv p -end - -lemma is_bounded_bilinear_map.differentiable (h : is_bounded_bilinear_map 𝕜 b) : - differentiable 𝕜 b := -λx, h.differentiable_at x - -lemma is_bounded_bilinear_map.differentiable_on (h : is_bounded_bilinear_map 𝕜 b) : - differentiable_on 𝕜 b u := -h.differentiable.differentiable_on - -end bilinear_map - -section clm_comp_apply -/-! ### Derivative of the pointwise composition/application of continuous linear maps -/ - -variables {H : Type*} [normed_group H] [normed_space 𝕜 H] {c : E → G →L[𝕜] H} - {c' : E →L[𝕜] G →L[𝕜] H} {d : E → F →L[𝕜] G} {d' : E →L[𝕜] F →L[𝕜] G} {u : E → G} - {u' : E →L[𝕜] G} - -lemma has_strict_fderiv_at.clm_comp (hc : has_strict_fderiv_at c c' x) - (hd : has_strict_fderiv_at d d' x) : has_strict_fderiv_at (λ y, (c y).comp (d y)) - ((compL 𝕜 F G H (c x)).comp d' + ((compL 𝕜 F G H).flip (d x)).comp c') x := -begin - rw add_comm, - exact (is_bounded_bilinear_map_comp.has_strict_fderiv_at (d x, c x)).comp x (hd.prod hc) -end - -lemma has_fderiv_within_at.clm_comp (hc : has_fderiv_within_at c c' s x) - (hd : has_fderiv_within_at d d' s x) : has_fderiv_within_at (λ y, (c y).comp (d y)) - ((compL 𝕜 F G H (c x)).comp d' + ((compL 𝕜 F G H).flip (d x)).comp c') s x := -begin - rw add_comm, - exact (is_bounded_bilinear_map_comp.has_fderiv_at (d x, c x)).comp_has_fderiv_within_at x - (hd.prod hc) -end - -lemma has_fderiv_at.clm_comp (hc : has_fderiv_at c c' x) - (hd : has_fderiv_at d d' x) : has_fderiv_at (λ y, (c y).comp (d y)) - ((compL 𝕜 F G H (c x)).comp d' + ((compL 𝕜 F G H).flip (d x)).comp c') x := -begin - rw add_comm, - exact (is_bounded_bilinear_map_comp.has_fderiv_at (d x, c x)).comp x (hd.prod hc) -end - -lemma differentiable_within_at.clm_comp - (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : - differentiable_within_at 𝕜 (λ y, (c y).comp (d y)) s x := -(hc.has_fderiv_within_at.clm_comp hd.has_fderiv_within_at).differentiable_within_at - -lemma differentiable_at.clm_comp (hc : differentiable_at 𝕜 c x) - (hd : differentiable_at 𝕜 d x) : differentiable_at 𝕜 (λ y, (c y).comp (d y)) x := -(hc.has_fderiv_at.clm_comp hd.has_fderiv_at).differentiable_at - -lemma differentiable_on.clm_comp (hc : differentiable_on 𝕜 c s) (hd : differentiable_on 𝕜 d s) : - differentiable_on 𝕜 (λ y, (c y).comp (d y)) s := -λx hx, (hc x hx).clm_comp (hd x hx) - -lemma differentiable.clm_comp (hc : differentiable 𝕜 c) (hd : differentiable 𝕜 d) : - differentiable 𝕜 (λ y, (c y).comp (d y)) := -λx, (hc x).clm_comp (hd x) - -lemma fderiv_within_clm_comp (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : - fderiv_within 𝕜 (λ y, (c y).comp (d y)) s x = - (compL 𝕜 F G H (c x)).comp (fderiv_within 𝕜 d s x) + - ((compL 𝕜 F G H).flip (d x)).comp (fderiv_within 𝕜 c s x) := -(hc.has_fderiv_within_at.clm_comp hd.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_clm_comp (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : - fderiv 𝕜 (λ y, (c y).comp (d y)) x = - (compL 𝕜 F G H (c x)).comp (fderiv 𝕜 d x) + - ((compL 𝕜 F G H).flip (d x)).comp (fderiv 𝕜 c x) := -(hc.has_fderiv_at.clm_comp hd.has_fderiv_at).fderiv - -lemma has_strict_fderiv_at.clm_apply (hc : has_strict_fderiv_at c c' x) - (hu : has_strict_fderiv_at u u' x) : - has_strict_fderiv_at (λ y, (c y) (u y)) ((c x).comp u' + c'.flip (u x)) x := -(is_bounded_bilinear_map_apply.has_strict_fderiv_at (c x, u x)).comp x (hc.prod hu) - -lemma has_fderiv_within_at.clm_apply (hc : has_fderiv_within_at c c' s x) - (hu : has_fderiv_within_at u u' s x) : - has_fderiv_within_at (λ y, (c y) (u y)) ((c x).comp u' + c'.flip (u x)) s x := -(is_bounded_bilinear_map_apply.has_fderiv_at (c x, u x)).comp_has_fderiv_within_at x (hc.prod hu) - -lemma has_fderiv_at.clm_apply (hc : has_fderiv_at c c' x) (hu : has_fderiv_at u u' x) : - has_fderiv_at (λ y, (c y) (u y)) ((c x).comp u' + c'.flip (u x)) x := -(is_bounded_bilinear_map_apply.has_fderiv_at (c x, u x)).comp x (hc.prod hu) - -lemma differentiable_within_at.clm_apply - (hc : differentiable_within_at 𝕜 c s x) (hu : differentiable_within_at 𝕜 u s x) : - differentiable_within_at 𝕜 (λ y, (c y) (u y)) s x := -(hc.has_fderiv_within_at.clm_apply hu.has_fderiv_within_at).differentiable_within_at - -lemma differentiable_at.clm_apply (hc : differentiable_at 𝕜 c x) - (hu : differentiable_at 𝕜 u x) : differentiable_at 𝕜 (λ y, (c y) (u y)) x := -(hc.has_fderiv_at.clm_apply hu.has_fderiv_at).differentiable_at - -lemma differentiable_on.clm_apply (hc : differentiable_on 𝕜 c s) (hu : differentiable_on 𝕜 u s) : - differentiable_on 𝕜 (λ y, (c y) (u y)) s := -λx hx, (hc x hx).clm_apply (hu x hx) - -lemma differentiable.clm_apply (hc : differentiable 𝕜 c) (hu : differentiable 𝕜 u) : - differentiable 𝕜 (λ y, (c y) (u y)) := -λx, (hc x).clm_apply (hu x) - -lemma fderiv_within_clm_apply (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hu : differentiable_within_at 𝕜 u s x) : - fderiv_within 𝕜 (λ y, (c y) (u y)) s x = - ((c x).comp (fderiv_within 𝕜 u s x) + (fderiv_within 𝕜 c s x).flip (u x)) := -(hc.has_fderiv_within_at.clm_apply hu.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_clm_apply (hc : differentiable_at 𝕜 c x) (hu : differentiable_at 𝕜 u x) : - fderiv 𝕜 (λ y, (c y) (u y)) x = ((c x).comp (fderiv 𝕜 u x) + (fderiv 𝕜 c x).flip (u x)) := -(hc.has_fderiv_at.clm_apply hu.has_fderiv_at).fderiv - -end clm_comp_apply - -section smul -/-! ### Derivative of the product of a scalar-valued function and a vector-valued function - -If `c` is a differentiable scalar-valued function and `f` is a differentiable vector-valued -function, then `λ x, c x • f x` is differentiable as well. Lemmas in this section works for -function `c` taking values in the base field, as well as in a normed algebra over the base -field: e.g., they work for `c : E → ℂ` and `f : E → F` provided that `F` is a complex -normed vector space. --/ - -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] - [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] -variables {c : E → 𝕜'} {c' : E →L[𝕜] 𝕜'} - -theorem has_strict_fderiv_at.smul (hc : has_strict_fderiv_at c c' x) - (hf : has_strict_fderiv_at f f' x) : - has_strict_fderiv_at (λ y, c y • f y) (c x • f' + c'.smul_right (f x)) x := -(is_bounded_bilinear_map_smul.has_strict_fderiv_at (c x, f x)).comp x $ - hc.prod hf - -theorem has_fderiv_within_at.smul - (hc : has_fderiv_within_at c c' s x) (hf : has_fderiv_within_at f f' s x) : - has_fderiv_within_at (λ y, c y • f y) (c x • f' + c'.smul_right (f x)) s x := -(is_bounded_bilinear_map_smul.has_fderiv_at (c x, f x)).comp_has_fderiv_within_at x $ - hc.prod hf - -theorem has_fderiv_at.smul (hc : has_fderiv_at c c' x) (hf : has_fderiv_at f f' x) : - has_fderiv_at (λ y, c y • f y) (c x • f' + c'.smul_right (f x)) x := -(is_bounded_bilinear_map_smul.has_fderiv_at (c x, f x)).comp x $ - hc.prod hf - -lemma differentiable_within_at.smul - (hc : differentiable_within_at 𝕜 c s x) (hf : differentiable_within_at 𝕜 f s x) : - differentiable_within_at 𝕜 (λ y, c y • f y) s x := -(hc.has_fderiv_within_at.smul hf.has_fderiv_within_at).differentiable_within_at - -@[simp] lemma differentiable_at.smul (hc : differentiable_at 𝕜 c x) (hf : differentiable_at 𝕜 f x) : - differentiable_at 𝕜 (λ y, c y • f y) x := -(hc.has_fderiv_at.smul hf.has_fderiv_at).differentiable_at - -lemma differentiable_on.smul (hc : differentiable_on 𝕜 c s) (hf : differentiable_on 𝕜 f s) : - differentiable_on 𝕜 (λ y, c y • f y) s := -λx hx, (hc x hx).smul (hf x hx) - -@[simp] lemma differentiable.smul (hc : differentiable 𝕜 c) (hf : differentiable 𝕜 f) : - differentiable 𝕜 (λ y, c y • f y) := -λx, (hc x).smul (hf x) - -lemma fderiv_within_smul (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hf : differentiable_within_at 𝕜 f s x) : - fderiv_within 𝕜 (λ y, c y • f y) s x = - c x • fderiv_within 𝕜 f s x + (fderiv_within 𝕜 c s x).smul_right (f x) := -(hc.has_fderiv_within_at.smul hf.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_smul (hc : differentiable_at 𝕜 c x) (hf : differentiable_at 𝕜 f x) : - fderiv 𝕜 (λ y, c y • f y) x = - c x • fderiv 𝕜 f x + (fderiv 𝕜 c x).smul_right (f x) := -(hc.has_fderiv_at.smul hf.has_fderiv_at).fderiv - -theorem has_strict_fderiv_at.smul_const (hc : has_strict_fderiv_at c c' x) (f : F) : - has_strict_fderiv_at (λ y, c y • f) (c'.smul_right f) x := -by simpa only [smul_zero, zero_add] using hc.smul (has_strict_fderiv_at_const f x) - -theorem has_fderiv_within_at.smul_const (hc : has_fderiv_within_at c c' s x) (f : F) : - has_fderiv_within_at (λ y, c y • f) (c'.smul_right f) s x := -by simpa only [smul_zero, zero_add] using hc.smul (has_fderiv_within_at_const f x s) - -theorem has_fderiv_at.smul_const (hc : has_fderiv_at c c' x) (f : F) : - has_fderiv_at (λ y, c y • f) (c'.smul_right f) x := -by simpa only [smul_zero, zero_add] using hc.smul (has_fderiv_at_const f x) - -lemma differentiable_within_at.smul_const - (hc : differentiable_within_at 𝕜 c s x) (f : F) : - differentiable_within_at 𝕜 (λ y, c y • f) s x := -(hc.has_fderiv_within_at.smul_const f).differentiable_within_at - -lemma differentiable_at.smul_const (hc : differentiable_at 𝕜 c x) (f : F) : - differentiable_at 𝕜 (λ y, c y • f) x := -(hc.has_fderiv_at.smul_const f).differentiable_at - -lemma differentiable_on.smul_const (hc : differentiable_on 𝕜 c s) (f : F) : - differentiable_on 𝕜 (λ y, c y • f) s := -λx hx, (hc x hx).smul_const f - -lemma differentiable.smul_const (hc : differentiable 𝕜 c) (f : F) : - differentiable 𝕜 (λ y, c y • f) := -λx, (hc x).smul_const f - -lemma fderiv_within_smul_const (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (f : F) : - fderiv_within 𝕜 (λ y, c y • f) s x = - (fderiv_within 𝕜 c s x).smul_right f := -(hc.has_fderiv_within_at.smul_const f).fderiv_within hxs - -lemma fderiv_smul_const (hc : differentiable_at 𝕜 c x) (f : F) : - fderiv 𝕜 (λ y, c y • f) x = (fderiv 𝕜 c x).smul_right f := -(hc.has_fderiv_at.smul_const f).fderiv - -end smul - -section mul -/-! ### Derivative of the product of two functions -/ - -variables {𝔸 𝔸' : Type*} [normed_ring 𝔸] [normed_comm_ring 𝔸'] [normed_algebra 𝕜 𝔸] - [normed_algebra 𝕜 𝔸'] {a b : E → 𝔸} {a' b' : E →L[𝕜] 𝔸} {c d : E → 𝔸'} {c' d' : E →L[𝕜] 𝔸'} - -theorem has_strict_fderiv_at.mul' {x : E} (ha : has_strict_fderiv_at a a' x) - (hb : has_strict_fderiv_at b b' x) : - has_strict_fderiv_at (λ y, a y * b y) (a x • b' + a'.smul_right (b x)) x := -((continuous_linear_map.lmul 𝕜 𝔸).is_bounded_bilinear_map.has_strict_fderiv_at (a x, b x)).comp x - (ha.prod hb) - -theorem has_strict_fderiv_at.mul - (hc : has_strict_fderiv_at c c' x) (hd : has_strict_fderiv_at d d' x) : - has_strict_fderiv_at (λ y, c y * d y) (c x • d' + d x • c') x := -by { convert hc.mul' hd, ext z, apply mul_comm } - -theorem has_fderiv_within_at.mul' - (ha : has_fderiv_within_at a a' s x) (hb : has_fderiv_within_at b b' s x) : - has_fderiv_within_at (λ y, a y * b y) (a x • b' + a'.smul_right (b x)) s x := -((continuous_linear_map.lmul 𝕜 𝔸).is_bounded_bilinear_map.has_fderiv_at - (a x, b x)).comp_has_fderiv_within_at x (ha.prod hb) - -theorem has_fderiv_within_at.mul - (hc : has_fderiv_within_at c c' s x) (hd : has_fderiv_within_at d d' s x) : - has_fderiv_within_at (λ y, c y * d y) (c x • d' + d x • c') s x := -by { convert hc.mul' hd, ext z, apply mul_comm } - -theorem has_fderiv_at.mul' - (ha : has_fderiv_at a a' x) (hb : has_fderiv_at b b' x) : - has_fderiv_at (λ y, a y * b y) (a x • b' + a'.smul_right (b x)) x := -((continuous_linear_map.lmul 𝕜 𝔸).is_bounded_bilinear_map.has_fderiv_at (a x, b x)).comp x - (ha.prod hb) - -theorem has_fderiv_at.mul (hc : has_fderiv_at c c' x) (hd : has_fderiv_at d d' x) : - has_fderiv_at (λ y, c y * d y) (c x • d' + d x • c') x := -by { convert hc.mul' hd, ext z, apply mul_comm } - -lemma differentiable_within_at.mul - (ha : differentiable_within_at 𝕜 a s x) (hb : differentiable_within_at 𝕜 b s x) : - differentiable_within_at 𝕜 (λ y, a y * b y) s x := -(ha.has_fderiv_within_at.mul' hb.has_fderiv_within_at).differentiable_within_at - -@[simp] lemma differentiable_at.mul (ha : differentiable_at 𝕜 a x) (hb : differentiable_at 𝕜 b x) : - differentiable_at 𝕜 (λ y, a y * b y) x := -(ha.has_fderiv_at.mul' hb.has_fderiv_at).differentiable_at - -lemma differentiable_on.mul (ha : differentiable_on 𝕜 a s) (hb : differentiable_on 𝕜 b s) : - differentiable_on 𝕜 (λ y, a y * b y) s := -λx hx, (ha x hx).mul (hb x hx) - -@[simp] lemma differentiable.mul (ha : differentiable 𝕜 a) (hb : differentiable 𝕜 b) : - differentiable 𝕜 (λ y, a y * b y) := -λx, (ha x).mul (hb x) - -lemma fderiv_within_mul' (hxs : unique_diff_within_at 𝕜 s x) - (ha : differentiable_within_at 𝕜 a s x) (hb : differentiable_within_at 𝕜 b s x) : - fderiv_within 𝕜 (λ y, a y * b y) s x = - a x • fderiv_within 𝕜 b s x + (fderiv_within 𝕜 a s x).smul_right (b x) := -(ha.has_fderiv_within_at.mul' hb.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_within_mul (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : - fderiv_within 𝕜 (λ y, c y * d y) s x = - c x • fderiv_within 𝕜 d s x + d x • fderiv_within 𝕜 c s x := -(hc.has_fderiv_within_at.mul hd.has_fderiv_within_at).fderiv_within hxs - -lemma fderiv_mul' (ha : differentiable_at 𝕜 a x) (hb : differentiable_at 𝕜 b x) : - fderiv 𝕜 (λ y, a y * b y) x = - a x • fderiv 𝕜 b x + (fderiv 𝕜 a x).smul_right (b x) := -(ha.has_fderiv_at.mul' hb.has_fderiv_at).fderiv - -lemma fderiv_mul (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : - fderiv 𝕜 (λ y, c y * d y) x = - c x • fderiv 𝕜 d x + d x • fderiv 𝕜 c x := -(hc.has_fderiv_at.mul hd.has_fderiv_at).fderiv - -theorem has_strict_fderiv_at.mul_const' (ha : has_strict_fderiv_at a a' x) (b : 𝔸) : - has_strict_fderiv_at (λ y, a y * b) (a'.smul_right b) x := -(((continuous_linear_map.lmul 𝕜 𝔸).flip b).has_strict_fderiv_at).comp x ha - -theorem has_strict_fderiv_at.mul_const (hc : has_strict_fderiv_at c c' x) (d : 𝔸') : - has_strict_fderiv_at (λ y, c y * d) (d • c') x := -by { convert hc.mul_const' d, ext z, apply mul_comm } - -theorem has_fderiv_within_at.mul_const' (ha : has_fderiv_within_at a a' s x) (b : 𝔸) : - has_fderiv_within_at (λ y, a y * b) (a'.smul_right b) s x := -(((continuous_linear_map.lmul 𝕜 𝔸).flip b).has_fderiv_at).comp_has_fderiv_within_at x ha - -theorem has_fderiv_within_at.mul_const (hc : has_fderiv_within_at c c' s x) (d : 𝔸') : - has_fderiv_within_at (λ y, c y * d) (d • c') s x := -by { convert hc.mul_const' d, ext z, apply mul_comm } - -theorem has_fderiv_at.mul_const' (ha : has_fderiv_at a a' x) (b : 𝔸) : - has_fderiv_at (λ y, a y * b) (a'.smul_right b) x := -(((continuous_linear_map.lmul 𝕜 𝔸).flip b).has_fderiv_at).comp x ha - -theorem has_fderiv_at.mul_const (hc : has_fderiv_at c c' x) (d : 𝔸') : - has_fderiv_at (λ y, c y * d) (d • c') x := -by { convert hc.mul_const' d, ext z, apply mul_comm } - -lemma differentiable_within_at.mul_const - (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : - differentiable_within_at 𝕜 (λ y, a y * b) s x := -(ha.has_fderiv_within_at.mul_const' b).differentiable_within_at - -lemma differentiable_at.mul_const (ha : differentiable_at 𝕜 a x) (b : 𝔸) : - differentiable_at 𝕜 (λ y, a y * b) x := -(ha.has_fderiv_at.mul_const' b).differentiable_at - -lemma differentiable_on.mul_const (ha : differentiable_on 𝕜 a s) (b : 𝔸) : - differentiable_on 𝕜 (λ y, a y * b) s := -λx hx, (ha x hx).mul_const b - -lemma differentiable.mul_const (ha : differentiable 𝕜 a) (b : 𝔸) : - differentiable 𝕜 (λ y, a y * b) := -λx, (ha x).mul_const b - -lemma fderiv_within_mul_const' (hxs : unique_diff_within_at 𝕜 s x) - (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : - fderiv_within 𝕜 (λ y, a y * b) s x = (fderiv_within 𝕜 a s x).smul_right b := -(ha.has_fderiv_within_at.mul_const' b).fderiv_within hxs - -lemma fderiv_within_mul_const (hxs : unique_diff_within_at 𝕜 s x) - (hc : differentiable_within_at 𝕜 c s x) (d : 𝔸') : - fderiv_within 𝕜 (λ y, c y * d) s x = d • fderiv_within 𝕜 c s x := -(hc.has_fderiv_within_at.mul_const d).fderiv_within hxs - -lemma fderiv_mul_const' (ha : differentiable_at 𝕜 a x) (b : 𝔸) : - fderiv 𝕜 (λ y, a y * b) x = (fderiv 𝕜 a x).smul_right b := -(ha.has_fderiv_at.mul_const' b).fderiv - -lemma fderiv_mul_const (hc : differentiable_at 𝕜 c x) (d : 𝔸') : - fderiv 𝕜 (λ y, c y * d) x = d • fderiv 𝕜 c x := -(hc.has_fderiv_at.mul_const d).fderiv - -theorem has_strict_fderiv_at.const_mul (ha : has_strict_fderiv_at a a' x) (b : 𝔸) : - has_strict_fderiv_at (λ y, b * a y) (b • a') x := -(((continuous_linear_map.lmul 𝕜 𝔸) b).has_strict_fderiv_at).comp x ha - -theorem has_fderiv_within_at.const_mul - (ha : has_fderiv_within_at a a' s x) (b : 𝔸) : - has_fderiv_within_at (λ y, b * a y) (b • a') s x := -(((continuous_linear_map.lmul 𝕜 𝔸) b).has_fderiv_at).comp_has_fderiv_within_at x ha - -theorem has_fderiv_at.const_mul (ha : has_fderiv_at a a' x) (b : 𝔸) : - has_fderiv_at (λ y, b * a y) (b • a') x := -(((continuous_linear_map.lmul 𝕜 𝔸) b).has_fderiv_at).comp x ha - -lemma differentiable_within_at.const_mul - (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : - differentiable_within_at 𝕜 (λ y, b * a y) s x := -(ha.has_fderiv_within_at.const_mul b).differentiable_within_at - -lemma differentiable_at.const_mul (ha : differentiable_at 𝕜 a x) (b : 𝔸) : - differentiable_at 𝕜 (λ y, b * a y) x := -(ha.has_fderiv_at.const_mul b).differentiable_at - -lemma differentiable_on.const_mul (ha : differentiable_on 𝕜 a s) (b : 𝔸) : - differentiable_on 𝕜 (λ y, b * a y) s := -λx hx, (ha x hx).const_mul b - -lemma differentiable.const_mul (ha : differentiable 𝕜 a) (b : 𝔸) : - differentiable 𝕜 (λ y, b * a y) := -λx, (ha x).const_mul b - -lemma fderiv_within_const_mul (hxs : unique_diff_within_at 𝕜 s x) - (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : - fderiv_within 𝕜 (λ y, b * a y) s x = b • fderiv_within 𝕜 a s x := -(ha.has_fderiv_within_at.const_mul b).fderiv_within hxs - -lemma fderiv_const_mul (ha : differentiable_at 𝕜 a x) (b : 𝔸) : - fderiv 𝕜 (λ y, b * a y) x = b • fderiv 𝕜 a x := -(ha.has_fderiv_at.const_mul b).fderiv - -end mul - -section algebra_inverse -variables {R : Type*} [normed_ring R] [normed_algebra 𝕜 R] [complete_space R] -open normed_ring continuous_linear_map ring - -/-- At an invertible element `x` of a normed algebra `R`, the Fréchet derivative of the inversion -operation is the linear map `λ t, - x⁻¹ * t * x⁻¹`. -/ -lemma has_fderiv_at_ring_inverse (x : Rˣ) : - has_fderiv_at ring.inverse (-lmul_left_right 𝕜 R ↑x⁻¹ ↑x⁻¹) x := -begin - have h_is_o : is_o (λ (t : R), inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) - (λ (t : R), t) (𝓝 0), - { refine (inverse_add_norm_diff_second_order x).trans_is_o ((is_o_norm_norm).mp _), - simp only [norm_pow, norm_norm], - have h12 : 1 < 2 := by norm_num, - convert (asymptotics.is_o_pow_pow h12).comp_tendsto tendsto_norm_zero, - ext, simp }, - have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0), - { refine tendsto_zero_iff_norm_tendsto_zero.mpr _, - exact tendsto_iff_norm_tendsto_zero.mp tendsto_id }, - simp only [has_fderiv_at, has_fderiv_at_filter], - convert h_is_o.comp_tendsto h_lim, - ext y, - simp only [coe_comp', function.comp_app, lmul_left_right_apply, neg_apply, inverse_unit x, - units.inv_mul, add_sub_cancel'_right, mul_sub, sub_mul, one_mul, sub_neg_eq_add] -end - -lemma differentiable_at_inverse (x : Rˣ) : differentiable_at 𝕜 (@ring.inverse R _) x := -(has_fderiv_at_ring_inverse x).differentiable_at - -lemma fderiv_inverse (x : Rˣ) : - fderiv 𝕜 (@ring.inverse R _) x = - lmul_left_right 𝕜 R ↑x⁻¹ ↑x⁻¹ := -(has_fderiv_at_ring_inverse x).fderiv - -end algebra_inverse - -namespace continuous_linear_equiv -/-! ### Differentiability of linear equivs, and invariance of differentiability -/ - -variable (iso : E ≃L[𝕜] F) - -protected lemma has_strict_fderiv_at : - has_strict_fderiv_at iso (iso : E →L[𝕜] F) x := -iso.to_continuous_linear_map.has_strict_fderiv_at - -protected lemma has_fderiv_within_at : - has_fderiv_within_at iso (iso : E →L[𝕜] F) s x := -iso.to_continuous_linear_map.has_fderiv_within_at - -protected lemma has_fderiv_at : has_fderiv_at iso (iso : E →L[𝕜] F) x := -iso.to_continuous_linear_map.has_fderiv_at_filter - -protected lemma differentiable_at : differentiable_at 𝕜 iso x := -iso.has_fderiv_at.differentiable_at - -protected lemma differentiable_within_at : - differentiable_within_at 𝕜 iso s x := -iso.differentiable_at.differentiable_within_at - -protected lemma fderiv : fderiv 𝕜 iso x = iso := -iso.has_fderiv_at.fderiv - -protected lemma fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 iso s x = iso := -iso.to_continuous_linear_map.fderiv_within hxs - -protected lemma differentiable : differentiable 𝕜 iso := -λx, iso.differentiable_at - -protected lemma differentiable_on : differentiable_on 𝕜 iso s := -iso.differentiable.differentiable_on - -lemma comp_differentiable_within_at_iff {f : G → E} {s : set G} {x : G} : - differentiable_within_at 𝕜 (iso ∘ f) s x ↔ differentiable_within_at 𝕜 f s x := -begin - refine ⟨λ H, _, λ H, iso.differentiable.differentiable_at.comp_differentiable_within_at x H⟩, - have : differentiable_within_at 𝕜 (iso.symm ∘ (iso ∘ f)) s x := - iso.symm.differentiable.differentiable_at.comp_differentiable_within_at x H, - rwa [← function.comp.assoc iso.symm iso f, iso.symm_comp_self] at this, -end - -lemma comp_differentiable_at_iff {f : G → E} {x : G} : - differentiable_at 𝕜 (iso ∘ f) x ↔ differentiable_at 𝕜 f x := -by rw [← differentiable_within_at_univ, ← differentiable_within_at_univ, - iso.comp_differentiable_within_at_iff] - -lemma comp_differentiable_on_iff {f : G → E} {s : set G} : - differentiable_on 𝕜 (iso ∘ f) s ↔ differentiable_on 𝕜 f s := -begin - rw [differentiable_on, differentiable_on], - simp only [iso.comp_differentiable_within_at_iff], -end - -lemma comp_differentiable_iff {f : G → E} : - differentiable 𝕜 (iso ∘ f) ↔ differentiable 𝕜 f := -begin - rw [← differentiable_on_univ, ← differentiable_on_univ], - exact iso.comp_differentiable_on_iff -end - -lemma comp_has_fderiv_within_at_iff - {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] E} : - has_fderiv_within_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') s x ↔ has_fderiv_within_at f f' s x := -begin - refine ⟨λ H, _, λ H, iso.has_fderiv_at.comp_has_fderiv_within_at x H⟩, - have A : f = iso.symm ∘ (iso ∘ f), by { rw [← function.comp.assoc, iso.symm_comp_self], refl }, - have B : f' = (iso.symm : F →L[𝕜] E).comp ((iso : E →L[𝕜] F).comp f'), - by rw [← continuous_linear_map.comp_assoc, iso.coe_symm_comp_coe, - continuous_linear_map.id_comp], - rw [A, B], - exact iso.symm.has_fderiv_at.comp_has_fderiv_within_at x H -end - -lemma comp_has_strict_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : - has_strict_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_strict_fderiv_at f f' x := -begin - refine ⟨λ H, _, λ H, iso.has_strict_fderiv_at.comp x H⟩, - convert iso.symm.has_strict_fderiv_at.comp x H; ext z; apply (iso.symm_apply_apply _).symm -end - -lemma comp_has_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : - has_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_fderiv_at f f' x := -by rw [← has_fderiv_within_at_univ, ← has_fderiv_within_at_univ, iso.comp_has_fderiv_within_at_iff] - -lemma comp_has_fderiv_within_at_iff' - {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] F} : - has_fderiv_within_at (iso ∘ f) f' s x ↔ - has_fderiv_within_at f ((iso.symm : F →L[𝕜] E).comp f') s x := -by rw [← iso.comp_has_fderiv_within_at_iff, ← continuous_linear_map.comp_assoc, - iso.coe_comp_coe_symm, continuous_linear_map.id_comp] - -lemma comp_has_fderiv_at_iff' {f : G → E} {x : G} {f' : G →L[𝕜] F} : - has_fderiv_at (iso ∘ f) f' x ↔ has_fderiv_at f ((iso.symm : F →L[𝕜] E).comp f') x := -by rw [← has_fderiv_within_at_univ, ← has_fderiv_within_at_univ, iso.comp_has_fderiv_within_at_iff'] - -lemma comp_fderiv_within {f : G → E} {s : set G} {x : G} - (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (iso ∘ f) s x = (iso : E →L[𝕜] F).comp (fderiv_within 𝕜 f s x) := -begin - by_cases h : differentiable_within_at 𝕜 f s x, - { rw [fderiv.comp_fderiv_within x iso.differentiable_at h hxs, iso.fderiv] }, - { have : ¬differentiable_within_at 𝕜 (iso ∘ f) s x, - from mt iso.comp_differentiable_within_at_iff.1 h, - rw [fderiv_within_zero_of_not_differentiable_within_at h, - fderiv_within_zero_of_not_differentiable_within_at this, - continuous_linear_map.comp_zero] } -end - -lemma comp_fderiv {f : G → E} {x : G} : - fderiv 𝕜 (iso ∘ f) x = (iso : E →L[𝕜] F).comp (fderiv 𝕜 f x) := -begin - rw [← fderiv_within_univ, ← fderiv_within_univ], - exact iso.comp_fderiv_within unique_diff_within_at_univ, -end - -end continuous_linear_equiv - -namespace linear_isometry_equiv -/-! ### Differentiability of linear isometry equivs, and invariance of differentiability -/ - -variable (iso : E ≃ₗᵢ[𝕜] F) - -protected lemma has_strict_fderiv_at : has_strict_fderiv_at iso (iso : E →L[𝕜] F) x := -(iso : E ≃L[𝕜] F).has_strict_fderiv_at - -protected lemma has_fderiv_within_at : has_fderiv_within_at iso (iso : E →L[𝕜] F) s x := -(iso : E ≃L[𝕜] F).has_fderiv_within_at - -protected lemma has_fderiv_at : has_fderiv_at iso (iso : E →L[𝕜] F) x := -(iso : E ≃L[𝕜] F).has_fderiv_at - -protected lemma differentiable_at : differentiable_at 𝕜 iso x := -iso.has_fderiv_at.differentiable_at - -protected lemma differentiable_within_at : - differentiable_within_at 𝕜 iso s x := -iso.differentiable_at.differentiable_within_at - -protected lemma fderiv : fderiv 𝕜 iso x = iso := iso.has_fderiv_at.fderiv - -protected lemma fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 iso s x = iso := -(iso : E ≃L[𝕜] F).fderiv_within hxs - -protected lemma differentiable : differentiable 𝕜 iso := -λx, iso.differentiable_at - -protected lemma differentiable_on : differentiable_on 𝕜 iso s := -iso.differentiable.differentiable_on - -lemma comp_differentiable_within_at_iff {f : G → E} {s : set G} {x : G} : - differentiable_within_at 𝕜 (iso ∘ f) s x ↔ differentiable_within_at 𝕜 f s x := -(iso : E ≃L[𝕜] F).comp_differentiable_within_at_iff - -lemma comp_differentiable_at_iff {f : G → E} {x : G} : - differentiable_at 𝕜 (iso ∘ f) x ↔ differentiable_at 𝕜 f x := -(iso : E ≃L[𝕜] F).comp_differentiable_at_iff - -lemma comp_differentiable_on_iff {f : G → E} {s : set G} : - differentiable_on 𝕜 (iso ∘ f) s ↔ differentiable_on 𝕜 f s := -(iso : E ≃L[𝕜] F).comp_differentiable_on_iff - -lemma comp_differentiable_iff {f : G → E} : - differentiable 𝕜 (iso ∘ f) ↔ differentiable 𝕜 f := -(iso : E ≃L[𝕜] F).comp_differentiable_iff - -lemma comp_has_fderiv_within_at_iff - {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] E} : - has_fderiv_within_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') s x ↔ has_fderiv_within_at f f' s x := -(iso : E ≃L[𝕜] F).comp_has_fderiv_within_at_iff - -lemma comp_has_strict_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : - has_strict_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_strict_fderiv_at f f' x := -(iso : E ≃L[𝕜] F).comp_has_strict_fderiv_at_iff - -lemma comp_has_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : - has_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_fderiv_at f f' x := -(iso : E ≃L[𝕜] F).comp_has_fderiv_at_iff - -lemma comp_has_fderiv_within_at_iff' - {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] F} : - has_fderiv_within_at (iso ∘ f) f' s x ↔ - has_fderiv_within_at f ((iso.symm : F →L[𝕜] E).comp f') s x := -(iso : E ≃L[𝕜] F).comp_has_fderiv_within_at_iff' - -lemma comp_has_fderiv_at_iff' {f : G → E} {x : G} {f' : G →L[𝕜] F} : - has_fderiv_at (iso ∘ f) f' x ↔ has_fderiv_at f ((iso.symm : F →L[𝕜] E).comp f') x := -(iso : E ≃L[𝕜] F).comp_has_fderiv_at_iff' - -lemma comp_fderiv_within {f : G → E} {s : set G} {x : G} - (hxs : unique_diff_within_at 𝕜 s x) : - fderiv_within 𝕜 (iso ∘ f) s x = (iso : E →L[𝕜] F).comp (fderiv_within 𝕜 f s x) := -(iso : E ≃L[𝕜] F).comp_fderiv_within hxs - -lemma comp_fderiv {f : G → E} {x : G} : - fderiv 𝕜 (iso ∘ f) x = (iso : E →L[𝕜] F).comp (fderiv 𝕜 f x) := -(iso : E ≃L[𝕜] F).comp_fderiv - -end linear_isometry_equiv - -/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an -invertible derivative `f'` at `g a` in the strict sense, then `g` has the derivative `f'⁻¹` at `a` -in the strict sense. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have an -inverse function. -/ -theorem has_strict_fderiv_at.of_local_left_inverse {f : E → F} {f' : E ≃L[𝕜] F} {g : F → E} {a : F} - (hg : continuous_at g a) (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) (g a)) - (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : - has_strict_fderiv_at g (f'.symm : F →L[𝕜] E) a := -begin - replace hg := hg.prod_map' hg, - replace hfg := hfg.prod_mk_nhds hfg, - have : is_O (λ p : F × F, g p.1 - g p.2 - f'.symm (p.1 - p.2)) - (λ p : F × F, f' (g p.1 - g p.2) - (p.1 - p.2)) (𝓝 (a, a)), - { refine ((f'.symm : F →L[𝕜] E).is_O_comp _ _).congr (λ x, _) (λ _, rfl), - simp }, - refine this.trans_is_o _, clear this, - refine ((hf.comp_tendsto hg).symm.congr' (hfg.mono _) - (eventually_of_forall $ λ _, rfl)).trans_is_O _, - { rintros p ⟨hp1, hp2⟩, - simp [hp1, hp2] }, - { refine (hf.is_O_sub_rev.comp_tendsto hg).congr' - (eventually_of_forall $ λ _, rfl) (hfg.mono _), - rintros p ⟨hp1, hp2⟩, - simp only [(∘), hp1, hp2] } -end - -/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an -invertible derivative `f'` at `g a`, then `g` has the derivative `f'⁻¹` at `a`. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have -an inverse function. -/ -theorem has_fderiv_at.of_local_left_inverse {f : E → F} {f' : E ≃L[𝕜] F} {g : F → E} {a : F} - (hg : continuous_at g a) (hf : has_fderiv_at f (f' : E →L[𝕜] F) (g a)) - (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : - has_fderiv_at g (f'.symm : F →L[𝕜] E) a := -begin - have : is_O (λ x : F, g x - g a - f'.symm (x - a)) (λ x : F, f' (g x - g a) - (x - a)) (𝓝 a), - { refine ((f'.symm : F →L[𝕜] E).is_O_comp _ _).congr (λ x, _) (λ _, rfl), - simp }, - refine this.trans_is_o _, clear this, - refine ((hf.comp_tendsto hg).symm.congr' (hfg.mono _) - (eventually_of_forall $ λ _, rfl)).trans_is_O _, - { rintros p hp, - simp [hp, hfg.self_of_nhds] }, - { refine ((hf.is_O_sub_rev f'.antilipschitz).comp_tendsto hg).congr' - (eventually_of_forall $ λ _, rfl) (hfg.mono _), - rintros p hp, - simp only [(∘), hp, hfg.self_of_nhds] } -end - -/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has an -invertible derivative `f'` in the sense of strict differentiability at `f.symm a`, then `f.symm` has -the derivative `f'⁻¹` at `a`. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have -an inverse function. -/ -lemma local_homeomorph.has_strict_fderiv_at_symm (f : local_homeomorph E F) {f' : E ≃L[𝕜] F} {a : F} - (ha : a ∈ f.target) (htff' : has_strict_fderiv_at f (f' : E →L[𝕜] F) (f.symm a)) : - has_strict_fderiv_at f.symm (f'.symm : F →L[𝕜] E) a := -htff'.of_local_left_inverse (f.symm.continuous_at ha) (f.eventually_right_inverse ha) - -/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has an -invertible derivative `f'` at `f.symm a`, then `f.symm` has the derivative `f'⁻¹` at `a`. - -This is one of the easy parts of the inverse function theorem: it assumes that we already have -an inverse function. -/ -lemma local_homeomorph.has_fderiv_at_symm (f : local_homeomorph E F) {f' : E ≃L[𝕜] F} {a : F} - (ha : a ∈ f.target) (htff' : has_fderiv_at f (f' : E →L[𝕜] F) (f.symm a)) : - has_fderiv_at f.symm (f'.symm : F →L[𝕜] E) a := -htff'.of_local_left_inverse (f.symm.continuous_at ha) (f.eventually_right_inverse ha) - -lemma has_fderiv_within_at.eventually_ne (h : has_fderiv_within_at f f' s x) - (hf' : ∃ C, ∀ z, ∥z∥ ≤ C * ∥f' z∥) : - ∀ᶠ z in 𝓝[s \ {x}] x, f z ≠ f x := -begin - rw [nhds_within, diff_eq, ← inf_principal, ← inf_assoc, eventually_inf_principal], - have A : is_O (λ z, z - x) (λ z, f' (z - x)) (𝓝[s] x) := - (is_O_iff.2 $ hf'.imp $ λ C hC, eventually_of_forall $ λ z, hC _), - have : (λ z, f z - f x) ~[𝓝[s] x] (λ z, f' (z - x)) := h.trans_is_O A, - simpa [not_imp_not, sub_eq_zero] using (A.trans this.is_O_symm).eq_zero_imp -end - -lemma has_fderiv_at.eventually_ne (h : has_fderiv_at f f' x) (hf' : ∃ C, ∀ z, ∥z∥ ≤ C * ∥f' z∥) : - ∀ᶠ z in 𝓝[≠] x, f z ≠ f x := -by simpa only [compl_eq_univ_diff] using (has_fderiv_within_at_univ.2 h).eventually_ne hf' - -end - -section -/- - In the special case of a normed space over the reals, - we can use scalar multiplication in the `tendsto` characterization - of the Fréchet derivative. --/ - - -variables {E : Type*} [normed_group E] [normed_space ℝ E] -variables {F : Type*} [normed_group F] [normed_space ℝ F] -variables {f : E → F} {f' : E →L[ℝ] F} {x : E} - -theorem has_fderiv_at_filter_real_equiv {L : filter E} : - tendsto (λ x' : E, ∥x' - x∥⁻¹ * ∥f x' - f x - f' (x' - x)∥) L (𝓝 0) ↔ - tendsto (λ x' : E, ∥x' - x∥⁻¹ • (f x' - f x - f' (x' - x))) L (𝓝 0) := -begin - symmetry, - rw [tendsto_iff_norm_tendsto_zero], refine tendsto_congr (λ x', _), - have : ∥x' - x∥⁻¹ ≥ 0, from inv_nonneg.mpr (norm_nonneg _), - simp [norm_smul, real.norm_eq_abs, abs_of_nonneg this] -end - -lemma has_fderiv_at.lim_real (hf : has_fderiv_at f f' x) (v : E) : - tendsto (λ (c:ℝ), c • (f (x + c⁻¹ • v) - f x)) at_top (𝓝 (f' v)) := -begin - apply hf.lim v, - rw tendsto_at_top_at_top, - exact λ b, ⟨b, λ a ha, le_trans ha (le_abs_self _)⟩ -end - -end - -section tangent_cone - -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -{E : Type*} [normed_group E] [normed_space 𝕜 E] -{F : Type*} [normed_group F] [normed_space 𝕜 F] -{f : E → F} {s : set E} {f' : E →L[𝕜] F} - -/-- The image of a tangent cone under the differential of a map is included in the tangent cone to -the image. -/ -lemma has_fderiv_within_at.maps_to_tangent_cone {x : E} (h : has_fderiv_within_at f f' s x) : - maps_to f' (tangent_cone_at 𝕜 s x) (tangent_cone_at 𝕜 (f '' s) (f x)) := -begin - rintros v ⟨c, d, dtop, clim, cdlim⟩, - refine ⟨c, (λn, f (x + d n) - f x), mem_of_superset dtop _, clim, - h.lim at_top dtop clim cdlim⟩, - simp [-mem_image, mem_image_of_mem] {contextual := tt} -end - -/-- If a set has the unique differentiability property at a point x, then the image of this set -under a map with onto derivative has also the unique differentiability property at the image point. --/ -lemma has_fderiv_within_at.unique_diff_within_at {x : E} (h : has_fderiv_within_at f f' s x) - (hs : unique_diff_within_at 𝕜 s x) (h' : dense_range f') : - unique_diff_within_at 𝕜 (f '' s) (f x) := -begin - refine ⟨h'.dense_of_maps_to f'.continuous hs.1 _, - h.continuous_within_at.mem_closure_image hs.2⟩, - show submodule.span 𝕜 (tangent_cone_at 𝕜 s x) ≤ - (submodule.span 𝕜 (tangent_cone_at 𝕜 (f '' s) (f x))).comap ↑f', - rw [submodule.span_le], - exact h.maps_to_tangent_cone.mono (subset.refl _) submodule.subset_span -end - -lemma unique_diff_on.image {f' : E → E →L[𝕜] F} (hs : unique_diff_on 𝕜 s) - (hf' : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (hd : ∀ x ∈ s, dense_range (f' x)) : - unique_diff_on 𝕜 (f '' s) := -ball_image_iff.2 $ λ x hx, (hf' x hx).unique_diff_within_at (hs x hx) (hd x hx) - -lemma has_fderiv_within_at.unique_diff_within_at_of_continuous_linear_equiv - {x : E} (e' : E ≃L[𝕜] F) (h : has_fderiv_within_at f (e' : E →L[𝕜] F) s x) - (hs : unique_diff_within_at 𝕜 s x) : - unique_diff_within_at 𝕜 (f '' s) (f x) := -h.unique_diff_within_at hs e'.surjective.dense_range - -lemma continuous_linear_equiv.unique_diff_on_image (e : E ≃L[𝕜] F) (h : unique_diff_on 𝕜 s) : - unique_diff_on 𝕜 (e '' s) := -h.image (λ x _, e.has_fderiv_within_at) (λ x hx, e.surjective.dense_range) - -@[simp] lemma continuous_linear_equiv.unique_diff_on_image_iff (e : E ≃L[𝕜] F) : - unique_diff_on 𝕜 (e '' s) ↔ unique_diff_on 𝕜 s := -⟨λ h, e.symm_image_image s ▸ e.symm.unique_diff_on_image h, e.unique_diff_on_image⟩ - -@[simp] lemma continuous_linear_equiv.unique_diff_on_preimage_iff (e : F ≃L[𝕜] E) : - unique_diff_on 𝕜 (e ⁻¹' s) ↔ unique_diff_on 𝕜 s := -by rw [← e.image_symm_eq_preimage, e.symm.unique_diff_on_image_iff] - -end tangent_cone - -section restrict_scalars -/-! -### Restricting from `ℂ` to `ℝ`, or generally from `𝕜'` to `𝕜` - -If a function is differentiable over `ℂ`, then it is differentiable over `ℝ`. In this paragraph, -we give variants of this statement, in the general situation where `ℂ` and `ℝ` are replaced -respectively by `𝕜'` and `𝕜` where `𝕜'` is a normed algebra over `𝕜`. --/ - -variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜] -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] [normed_space 𝕜' E] -variables [is_scalar_tower 𝕜 𝕜' E] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] [normed_space 𝕜' F] -variables [is_scalar_tower 𝕜 𝕜' F] -variables {f : E → F} {f' : E →L[𝕜'] F} {s : set E} {x : E} - -lemma has_strict_fderiv_at.restrict_scalars (h : has_strict_fderiv_at f f' x) : - has_strict_fderiv_at f (f'.restrict_scalars 𝕜) x := h - -lemma has_fderiv_at_filter.restrict_scalars {L} (h : has_fderiv_at_filter f f' x L) : - has_fderiv_at_filter f (f'.restrict_scalars 𝕜) x L := h - -lemma has_fderiv_at.restrict_scalars (h : has_fderiv_at f f' x) : - has_fderiv_at f (f'.restrict_scalars 𝕜) x := h - -lemma has_fderiv_within_at.restrict_scalars (h : has_fderiv_within_at f f' s x) : - has_fderiv_within_at f (f'.restrict_scalars 𝕜) s x := h - -lemma differentiable_at.restrict_scalars (h : differentiable_at 𝕜' f x) : - differentiable_at 𝕜 f x := -(h.has_fderiv_at.restrict_scalars 𝕜).differentiable_at - -lemma differentiable_within_at.restrict_scalars (h : differentiable_within_at 𝕜' f s x) : - differentiable_within_at 𝕜 f s x := -(h.has_fderiv_within_at.restrict_scalars 𝕜).differentiable_within_at - -lemma differentiable_on.restrict_scalars (h : differentiable_on 𝕜' f s) : - differentiable_on 𝕜 f s := -λx hx, (h x hx).restrict_scalars 𝕜 - -lemma differentiable.restrict_scalars (h : differentiable 𝕜' f) : - differentiable 𝕜 f := -λx, (h x).restrict_scalars 𝕜 - -lemma has_fderiv_within_at_of_restrict_scalars - {g' : E →L[𝕜] F} (h : has_fderiv_within_at f g' s x) - (H : f'.restrict_scalars 𝕜 = g') : has_fderiv_within_at f f' s x := -by { rw ← H at h, exact h } - -lemma has_fderiv_at_of_restrict_scalars {g' : E →L[𝕜] F} (h : has_fderiv_at f g' x) - (H : f'.restrict_scalars 𝕜 = g') : has_fderiv_at f f' x := -by { rw ← H at h, exact h } - -lemma differentiable_at.fderiv_restrict_scalars (h : differentiable_at 𝕜' f x) : - fderiv 𝕜 f x = (fderiv 𝕜' f x).restrict_scalars 𝕜 := -(h.has_fderiv_at.restrict_scalars 𝕜).fderiv - -lemma differentiable_within_at_iff_restrict_scalars - (hf : differentiable_within_at 𝕜 f s x) (hs : unique_diff_within_at 𝕜 s x) : - differentiable_within_at 𝕜' f s x ↔ - ∃ (g' : E →L[𝕜'] F), g'.restrict_scalars 𝕜 = fderiv_within 𝕜 f s x := -begin - split, - { rintros ⟨g', hg'⟩, - exact ⟨g', hs.eq (hg'.restrict_scalars 𝕜) hf.has_fderiv_within_at⟩, }, - { rintros ⟨f', hf'⟩, - exact ⟨f', has_fderiv_within_at_of_restrict_scalars 𝕜 hf.has_fderiv_within_at hf'⟩, }, -end - -lemma differentiable_at_iff_restrict_scalars (hf : differentiable_at 𝕜 f x) : - differentiable_at 𝕜' f x ↔ ∃ (g' : E →L[𝕜'] F), g'.restrict_scalars 𝕜 = fderiv 𝕜 f x := -begin - rw [← differentiable_within_at_univ, ← fderiv_within_univ], - exact differentiable_within_at_iff_restrict_scalars 𝕜 - hf.differentiable_within_at unique_diff_within_at_univ, -end - -end restrict_scalars - -/-! ### Support of derivatives -/ - -section support - -open function -variables (𝕜 : Type*) {E F : Type*} [nondiscrete_normed_field 𝕜] -variables [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] {f : E → F} - -lemma support_fderiv_subset : support (fderiv 𝕜 f) ⊆ tsupport f := -begin - intros x, - rw [← not_imp_not], - intro h2x, - rw [not_mem_closure_support_iff_eventually_eq] at h2x, - exact nmem_support.mpr (h2x.fderiv_eq.trans $ fderiv_const_apply 0), -end - -lemma has_compact_support.fderiv (hf : has_compact_support f) : has_compact_support (fderiv 𝕜 f) := -hf.mono' $ support_fderiv_subset 𝕜 - -end support diff --git a/src/analysis/calculus/fderiv/add.lean b/src/analysis/calculus/fderiv/add.lean new file mode 100644 index 0000000000000..459bb39412abe --- /dev/null +++ b/src/analysis/calculus/fderiv/add.lean @@ -0,0 +1,575 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.linear +import analysis.calculus.fderiv.comp + +/-! +# Additive operations on derivatives + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of + +* sum of finitely many functions +* multiplication of a function by a scalar constant +* negative of a function +* subtraction of two functions +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +section const_smul + +variables {R : Type*} [semiring R] [module R F] [smul_comm_class 𝕜 R F] + [has_continuous_const_smul R F] + +/-! ### Derivative of a function multiplied by a constant -/ +theorem has_strict_fderiv_at.const_smul (h : has_strict_fderiv_at f f' x) (c : R) : + has_strict_fderiv_at (λ x, c • f x) (c • f') x := +(c • (1 : F →L[𝕜] F)).has_strict_fderiv_at.comp x h + +theorem has_fderiv_at_filter.const_smul (h : has_fderiv_at_filter f f' x L) (c : R) : + has_fderiv_at_filter (λ x, c • f x) (c • f') x L := +(c • (1 : F →L[𝕜] F)).has_fderiv_at_filter.comp x h tendsto_map + +theorem has_fderiv_within_at.const_smul (h : has_fderiv_within_at f f' s x) (c : R) : + has_fderiv_within_at (λ x, c • f x) (c • f') s x := +h.const_smul c + +theorem has_fderiv_at.const_smul (h : has_fderiv_at f f' x) (c : R) : + has_fderiv_at (λ x, c • f x) (c • f') x := +h.const_smul c + +lemma differentiable_within_at.const_smul (h : differentiable_within_at 𝕜 f s x) (c : R) : + differentiable_within_at 𝕜 (λy, c • f y) s x := +(h.has_fderiv_within_at.const_smul c).differentiable_within_at + +lemma differentiable_at.const_smul (h : differentiable_at 𝕜 f x) (c : R) : + differentiable_at 𝕜 (λy, c • f y) x := +(h.has_fderiv_at.const_smul c).differentiable_at + +lemma differentiable_on.const_smul (h : differentiable_on 𝕜 f s) (c : R) : + differentiable_on 𝕜 (λy, c • f y) s := +λx hx, (h x hx).const_smul c + +lemma differentiable.const_smul (h : differentiable 𝕜 f) (c : R) : + differentiable 𝕜 (λy, c • f y) := +λx, (h x).const_smul c + +lemma fderiv_within_const_smul (hxs : unique_diff_within_at 𝕜 s x) + (h : differentiable_within_at 𝕜 f s x) (c : R) : + fderiv_within 𝕜 (λy, c • f y) s x = c • fderiv_within 𝕜 f s x := +(h.has_fderiv_within_at.const_smul c).fderiv_within hxs + +lemma fderiv_const_smul (h : differentiable_at 𝕜 f x) (c : R) : + fderiv 𝕜 (λy, c • f y) x = c • fderiv 𝕜 f x := +(h.has_fderiv_at.const_smul c).fderiv + +end const_smul + +section add + +/-! ### Derivative of the sum of two functions -/ + +theorem has_strict_fderiv_at.add (hf : has_strict_fderiv_at f f' x) + (hg : has_strict_fderiv_at g g' x) : + has_strict_fderiv_at (λ y, f y + g y) (f' + g') x := +(hf.add hg).congr_left $ λ y, + by { simp only [linear_map.sub_apply, linear_map.add_apply, map_sub, map_add, add_apply], abel } + +theorem has_fderiv_at_filter.add + (hf : has_fderiv_at_filter f f' x L) (hg : has_fderiv_at_filter g g' x L) : + has_fderiv_at_filter (λ y, f y + g y) (f' + g') x L := +(hf.add hg).congr_left $ λ _, + by { simp only [linear_map.sub_apply, linear_map.add_apply, map_sub, map_add, add_apply], abel } + +theorem has_fderiv_within_at.add + (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at g g' s x) : + has_fderiv_within_at (λ y, f y + g y) (f' + g') s x := +hf.add hg + +theorem has_fderiv_at.add + (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) : + has_fderiv_at (λ x, f x + g x) (f' + g') x := +hf.add hg + +lemma differentiable_within_at.add + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : + differentiable_within_at 𝕜 (λ y, f y + g y) s x := +(hf.has_fderiv_within_at.add hg.has_fderiv_within_at).differentiable_within_at + +@[simp] lemma differentiable_at.add + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + differentiable_at 𝕜 (λ y, f y + g y) x := +(hf.has_fderiv_at.add hg.has_fderiv_at).differentiable_at + +lemma differentiable_on.add + (hf : differentiable_on 𝕜 f s) (hg : differentiable_on 𝕜 g s) : + differentiable_on 𝕜 (λy, f y + g y) s := +λx hx, (hf x hx).add (hg x hx) + +@[simp] lemma differentiable.add + (hf : differentiable 𝕜 f) (hg : differentiable 𝕜 g) : + differentiable 𝕜 (λy, f y + g y) := +λx, (hf x).add (hg x) + +lemma fderiv_within_add (hxs : unique_diff_within_at 𝕜 s x) + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : + fderiv_within 𝕜 (λy, f y + g y) s x = fderiv_within 𝕜 f s x + fderiv_within 𝕜 g s x := +(hf.has_fderiv_within_at.add hg.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_add + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + fderiv 𝕜 (λy, f y + g y) x = fderiv 𝕜 f x + fderiv 𝕜 g x := +(hf.has_fderiv_at.add hg.has_fderiv_at).fderiv + +theorem has_strict_fderiv_at.add_const (hf : has_strict_fderiv_at f f' x) (c : F) : + has_strict_fderiv_at (λ y, f y + c) f' x := +add_zero f' ▸ hf.add (has_strict_fderiv_at_const _ _) + +theorem has_fderiv_at_filter.add_const + (hf : has_fderiv_at_filter f f' x L) (c : F) : + has_fderiv_at_filter (λ y, f y + c) f' x L := +add_zero f' ▸ hf.add (has_fderiv_at_filter_const _ _ _) + +theorem has_fderiv_within_at.add_const + (hf : has_fderiv_within_at f f' s x) (c : F) : + has_fderiv_within_at (λ y, f y + c) f' s x := +hf.add_const c + +theorem has_fderiv_at.add_const (hf : has_fderiv_at f f' x) (c : F): + has_fderiv_at (λ x, f x + c) f' x := +hf.add_const c + +lemma differentiable_within_at.add_const + (hf : differentiable_within_at 𝕜 f s x) (c : F) : + differentiable_within_at 𝕜 (λ y, f y + c) s x := +(hf.has_fderiv_within_at.add_const c).differentiable_within_at + +@[simp] lemma differentiable_within_at_add_const_iff (c : F) : + differentiable_within_at 𝕜 (λ y, f y + c) s x ↔ differentiable_within_at 𝕜 f s x := +⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ + +lemma differentiable_at.add_const + (hf : differentiable_at 𝕜 f x) (c : F) : + differentiable_at 𝕜 (λ y, f y + c) x := +(hf.has_fderiv_at.add_const c).differentiable_at + +@[simp] lemma differentiable_at_add_const_iff (c : F) : + differentiable_at 𝕜 (λ y, f y + c) x ↔ differentiable_at 𝕜 f x := +⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ + +lemma differentiable_on.add_const + (hf : differentiable_on 𝕜 f s) (c : F) : + differentiable_on 𝕜 (λy, f y + c) s := +λx hx, (hf x hx).add_const c + +@[simp] lemma differentiable_on_add_const_iff (c : F) : + differentiable_on 𝕜 (λ y, f y + c) s ↔ differentiable_on 𝕜 f s := +⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ + +lemma differentiable.add_const + (hf : differentiable 𝕜 f) (c : F) : + differentiable 𝕜 (λy, f y + c) := +λx, (hf x).add_const c + +@[simp] lemma differentiable_add_const_iff (c : F) : + differentiable 𝕜 (λ y, f y + c) ↔ differentiable 𝕜 f := +⟨λ h, by simpa using h.add_const (-c), λ h, h.add_const c⟩ + +lemma fderiv_within_add_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + fderiv_within 𝕜 (λy, f y + c) s x = fderiv_within 𝕜 f s x := +if hf : differentiable_within_at 𝕜 f s x +then (hf.has_fderiv_within_at.add_const c).fderiv_within hxs +else by { rw [fderiv_within_zero_of_not_differentiable_within_at hf, + fderiv_within_zero_of_not_differentiable_within_at], simpa } + +lemma fderiv_add_const (c : F) : fderiv 𝕜 (λy, f y + c) x = fderiv 𝕜 f x := +by simp only [← fderiv_within_univ, fderiv_within_add_const unique_diff_within_at_univ] + +theorem has_strict_fderiv_at.const_add (hf : has_strict_fderiv_at f f' x) (c : F) : + has_strict_fderiv_at (λ y, c + f y) f' x := +zero_add f' ▸ (has_strict_fderiv_at_const _ _).add hf + +theorem has_fderiv_at_filter.const_add + (hf : has_fderiv_at_filter f f' x L) (c : F) : + has_fderiv_at_filter (λ y, c + f y) f' x L := +zero_add f' ▸ (has_fderiv_at_filter_const _ _ _).add hf + +theorem has_fderiv_within_at.const_add + (hf : has_fderiv_within_at f f' s x) (c : F) : + has_fderiv_within_at (λ y, c + f y) f' s x := +hf.const_add c + +theorem has_fderiv_at.const_add + (hf : has_fderiv_at f f' x) (c : F): + has_fderiv_at (λ x, c + f x) f' x := +hf.const_add c + +lemma differentiable_within_at.const_add + (hf : differentiable_within_at 𝕜 f s x) (c : F) : + differentiable_within_at 𝕜 (λ y, c + f y) s x := +(hf.has_fderiv_within_at.const_add c).differentiable_within_at + +@[simp] lemma differentiable_within_at_const_add_iff (c : F) : + differentiable_within_at 𝕜 (λ y, c + f y) s x ↔ differentiable_within_at 𝕜 f s x := +⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ + +lemma differentiable_at.const_add + (hf : differentiable_at 𝕜 f x) (c : F) : + differentiable_at 𝕜 (λ y, c + f y) x := +(hf.has_fderiv_at.const_add c).differentiable_at + +@[simp] lemma differentiable_at_const_add_iff (c : F) : + differentiable_at 𝕜 (λ y, c + f y) x ↔ differentiable_at 𝕜 f x := +⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ + +lemma differentiable_on.const_add (hf : differentiable_on 𝕜 f s) (c : F) : + differentiable_on 𝕜 (λy, c + f y) s := +λx hx, (hf x hx).const_add c + +@[simp] lemma differentiable_on_const_add_iff (c : F) : + differentiable_on 𝕜 (λ y, c + f y) s ↔ differentiable_on 𝕜 f s := +⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ + +lemma differentiable.const_add (hf : differentiable 𝕜 f) (c : F) : + differentiable 𝕜 (λy, c + f y) := +λx, (hf x).const_add c + +@[simp] lemma differentiable_const_add_iff (c : F) : + differentiable 𝕜 (λ y, c + f y) ↔ differentiable 𝕜 f := +⟨λ h, by simpa using h.const_add (-c), λ h, h.const_add c⟩ + +lemma fderiv_within_const_add (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + fderiv_within 𝕜 (λy, c + f y) s x = fderiv_within 𝕜 f s x := +by simpa only [add_comm] using fderiv_within_add_const hxs c + +lemma fderiv_const_add (c : F) : fderiv 𝕜 (λy, c + f y) x = fderiv 𝕜 f x := +by simp only [add_comm c, fderiv_add_const] + +end add + +section sum +/-! ### Derivative of a finite sum of functions -/ + +open_locale big_operators + +variables {ι : Type*} {u : finset ι} {A : ι → (E → F)} {A' : ι → (E →L[𝕜] F)} + +theorem has_strict_fderiv_at.sum (h : ∀ i ∈ u, has_strict_fderiv_at (A i) (A' i) x) : + has_strict_fderiv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := +begin + dsimp [has_strict_fderiv_at] at *, + convert is_o.sum h, + simp [finset.sum_sub_distrib, continuous_linear_map.sum_apply] +end + +theorem has_fderiv_at_filter.sum (h : ∀ i ∈ u, has_fderiv_at_filter (A i) (A' i) x L) : + has_fderiv_at_filter (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x L := +begin + dsimp [has_fderiv_at_filter] at *, + convert is_o.sum h, + simp [continuous_linear_map.sum_apply] +end + +theorem has_fderiv_within_at.sum (h : ∀ i ∈ u, has_fderiv_within_at (A i) (A' i) s x) : + has_fderiv_within_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) s x := +has_fderiv_at_filter.sum h + +theorem has_fderiv_at.sum (h : ∀ i ∈ u, has_fderiv_at (A i) (A' i) x) : + has_fderiv_at (λ y, ∑ i in u, A i y) (∑ i in u, A' i) x := +has_fderiv_at_filter.sum h + +theorem differentiable_within_at.sum (h : ∀ i ∈ u, differentiable_within_at 𝕜 (A i) s x) : + differentiable_within_at 𝕜 (λ y, ∑ i in u, A i y) s x := +has_fderiv_within_at.differentiable_within_at $ has_fderiv_within_at.sum $ +λ i hi, (h i hi).has_fderiv_within_at + +@[simp] theorem differentiable_at.sum (h : ∀ i ∈ u, differentiable_at 𝕜 (A i) x) : + differentiable_at 𝕜 (λ y, ∑ i in u, A i y) x := +has_fderiv_at.differentiable_at $ has_fderiv_at.sum $ λ i hi, (h i hi).has_fderiv_at + +theorem differentiable_on.sum (h : ∀ i ∈ u, differentiable_on 𝕜 (A i) s) : + differentiable_on 𝕜 (λ y, ∑ i in u, A i y) s := +λ x hx, differentiable_within_at.sum $ λ i hi, h i hi x hx + +@[simp] theorem differentiable.sum (h : ∀ i ∈ u, differentiable 𝕜 (A i)) : + differentiable 𝕜 (λ y, ∑ i in u, A i y) := +λ x, differentiable_at.sum $ λ i hi, h i hi x + +theorem fderiv_within_sum (hxs : unique_diff_within_at 𝕜 s x) + (h : ∀ i ∈ u, differentiable_within_at 𝕜 (A i) s x) : + fderiv_within 𝕜 (λ y, ∑ i in u, A i y) s x = (∑ i in u, fderiv_within 𝕜 (A i) s x) := +(has_fderiv_within_at.sum (λ i hi, (h i hi).has_fderiv_within_at)).fderiv_within hxs + +theorem fderiv_sum (h : ∀ i ∈ u, differentiable_at 𝕜 (A i) x) : + fderiv 𝕜 (λ y, ∑ i in u, A i y) x = (∑ i in u, fderiv 𝕜 (A i) x) := +(has_fderiv_at.sum (λ i hi, (h i hi).has_fderiv_at)).fderiv + +end sum + +section neg +/-! ### Derivative of the negative of a function -/ + +theorem has_strict_fderiv_at.neg (h : has_strict_fderiv_at f f' x) : + has_strict_fderiv_at (λ x, -f x) (-f') x := +(-1 : F →L[𝕜] F).has_strict_fderiv_at.comp x h + +theorem has_fderiv_at_filter.neg (h : has_fderiv_at_filter f f' x L) : + has_fderiv_at_filter (λ x, -f x) (-f') x L := +(-1 : F →L[𝕜] F).has_fderiv_at_filter.comp x h tendsto_map + +theorem has_fderiv_within_at.neg (h : has_fderiv_within_at f f' s x) : + has_fderiv_within_at (λ x, -f x) (-f') s x := +h.neg + +theorem has_fderiv_at.neg (h : has_fderiv_at f f' x) : + has_fderiv_at (λ x, -f x) (-f') x := +h.neg + +lemma differentiable_within_at.neg (h : differentiable_within_at 𝕜 f s x) : + differentiable_within_at 𝕜 (λy, -f y) s x := +h.has_fderiv_within_at.neg.differentiable_within_at + +@[simp] lemma differentiable_within_at_neg_iff : + differentiable_within_at 𝕜 (λy, -f y) s x ↔ differentiable_within_at 𝕜 f s x := +⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ + +lemma differentiable_at.neg (h : differentiable_at 𝕜 f x) : + differentiable_at 𝕜 (λy, -f y) x := +h.has_fderiv_at.neg.differentiable_at + +@[simp] lemma differentiable_at_neg_iff : + differentiable_at 𝕜 (λy, -f y) x ↔ differentiable_at 𝕜 f x := +⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ + +lemma differentiable_on.neg (h : differentiable_on 𝕜 f s) : + differentiable_on 𝕜 (λy, -f y) s := +λx hx, (h x hx).neg + +@[simp] lemma differentiable_on_neg_iff : + differentiable_on 𝕜 (λy, -f y) s ↔ differentiable_on 𝕜 f s := +⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ + +lemma differentiable.neg (h : differentiable 𝕜 f) : + differentiable 𝕜 (λy, -f y) := +λx, (h x).neg + +@[simp] lemma differentiable_neg_iff : differentiable 𝕜 (λy, -f y) ↔ differentiable 𝕜 f := +⟨λ h, by simpa only [neg_neg] using h.neg, λ h, h.neg⟩ + +lemma fderiv_within_neg (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λy, -f y) s x = - fderiv_within 𝕜 f s x := +if h : differentiable_within_at 𝕜 f s x +then h.has_fderiv_within_at.neg.fderiv_within hxs +else by { rw [fderiv_within_zero_of_not_differentiable_within_at h, + fderiv_within_zero_of_not_differentiable_within_at, neg_zero], simpa } + +@[simp] lemma fderiv_neg : fderiv 𝕜 (λy, -f y) x = - fderiv 𝕜 f x := +by simp only [← fderiv_within_univ, fderiv_within_neg unique_diff_within_at_univ] + +end neg + +section sub +/-! ### Derivative of the difference of two functions -/ + +theorem has_strict_fderiv_at.sub + (hf : has_strict_fderiv_at f f' x) (hg : has_strict_fderiv_at g g' x) : + has_strict_fderiv_at (λ x, f x - g x) (f' - g') x := +by simpa only [sub_eq_add_neg] using hf.add hg.neg + +theorem has_fderiv_at_filter.sub + (hf : has_fderiv_at_filter f f' x L) (hg : has_fderiv_at_filter g g' x L) : + has_fderiv_at_filter (λ x, f x - g x) (f' - g') x L := +by simpa only [sub_eq_add_neg] using hf.add hg.neg + +theorem has_fderiv_within_at.sub + (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at g g' s x) : + has_fderiv_within_at (λ x, f x - g x) (f' - g') s x := +hf.sub hg + +theorem has_fderiv_at.sub + (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) : + has_fderiv_at (λ x, f x - g x) (f' - g') x := +hf.sub hg + +lemma differentiable_within_at.sub + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : + differentiable_within_at 𝕜 (λ y, f y - g y) s x := +(hf.has_fderiv_within_at.sub hg.has_fderiv_within_at).differentiable_within_at + +@[simp] lemma differentiable_at.sub + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + differentiable_at 𝕜 (λ y, f y - g y) x := +(hf.has_fderiv_at.sub hg.has_fderiv_at).differentiable_at + +lemma differentiable_on.sub + (hf : differentiable_on 𝕜 f s) (hg : differentiable_on 𝕜 g s) : + differentiable_on 𝕜 (λy, f y - g y) s := +λx hx, (hf x hx).sub (hg x hx) + +@[simp] lemma differentiable.sub + (hf : differentiable 𝕜 f) (hg : differentiable 𝕜 g) : + differentiable 𝕜 (λy, f y - g y) := +λx, (hf x).sub (hg x) + +lemma fderiv_within_sub (hxs : unique_diff_within_at 𝕜 s x) + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) : + fderiv_within 𝕜 (λy, f y - g y) s x = fderiv_within 𝕜 f s x - fderiv_within 𝕜 g s x := +(hf.has_fderiv_within_at.sub hg.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_sub + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + fderiv 𝕜 (λy, f y - g y) x = fderiv 𝕜 f x - fderiv 𝕜 g x := +(hf.has_fderiv_at.sub hg.has_fderiv_at).fderiv + +theorem has_strict_fderiv_at.sub_const + (hf : has_strict_fderiv_at f f' x) (c : F) : + has_strict_fderiv_at (λ x, f x - c) f' x := +by simpa only [sub_eq_add_neg] using hf.add_const (-c) + +theorem has_fderiv_at_filter.sub_const + (hf : has_fderiv_at_filter f f' x L) (c : F) : + has_fderiv_at_filter (λ x, f x - c) f' x L := +by simpa only [sub_eq_add_neg] using hf.add_const (-c) + +theorem has_fderiv_within_at.sub_const + (hf : has_fderiv_within_at f f' s x) (c : F) : + has_fderiv_within_at (λ x, f x - c) f' s x := +hf.sub_const c + +theorem has_fderiv_at.sub_const + (hf : has_fderiv_at f f' x) (c : F) : + has_fderiv_at (λ x, f x - c) f' x := +hf.sub_const c + +lemma differentiable_within_at.sub_const + (hf : differentiable_within_at 𝕜 f s x) (c : F) : + differentiable_within_at 𝕜 (λ y, f y - c) s x := +(hf.has_fderiv_within_at.sub_const c).differentiable_within_at + +@[simp] lemma differentiable_within_at_sub_const_iff (c : F) : + differentiable_within_at 𝕜 (λ y, f y - c) s x ↔ differentiable_within_at 𝕜 f s x := +by simp only [sub_eq_add_neg, differentiable_within_at_add_const_iff] + +lemma differentiable_at.sub_const (hf : differentiable_at 𝕜 f x) (c : F) : + differentiable_at 𝕜 (λ y, f y - c) x := +(hf.has_fderiv_at.sub_const c).differentiable_at + +@[simp] lemma differentiable_at_sub_const_iff (c : F) : + differentiable_at 𝕜 (λ y, f y - c) x ↔ differentiable_at 𝕜 f x := +by simp only [sub_eq_add_neg, differentiable_at_add_const_iff] + +lemma differentiable_on.sub_const (hf : differentiable_on 𝕜 f s) (c : F) : + differentiable_on 𝕜 (λy, f y - c) s := +λx hx, (hf x hx).sub_const c + +@[simp] lemma differentiable_on_sub_const_iff (c : F) : + differentiable_on 𝕜 (λ y, f y - c) s ↔ differentiable_on 𝕜 f s := +by simp only [sub_eq_add_neg, differentiable_on_add_const_iff] + +lemma differentiable.sub_const (hf : differentiable 𝕜 f) (c : F) : + differentiable 𝕜 (λy, f y - c) := +λx, (hf x).sub_const c + +@[simp] lemma differentiable_sub_const_iff (c : F) : + differentiable 𝕜 (λ y, f y - c) ↔ differentiable 𝕜 f := +by simp only [sub_eq_add_neg, differentiable_add_const_iff] + +lemma fderiv_within_sub_const (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + fderiv_within 𝕜 (λy, f y - c) s x = fderiv_within 𝕜 f s x := +by simp only [sub_eq_add_neg, fderiv_within_add_const hxs] + +lemma fderiv_sub_const (c : F) : fderiv 𝕜 (λy, f y - c) x = fderiv 𝕜 f x := +by simp only [sub_eq_add_neg, fderiv_add_const] + +theorem has_strict_fderiv_at.const_sub + (hf : has_strict_fderiv_at f f' x) (c : F) : + has_strict_fderiv_at (λ x, c - f x) (-f') x := +by simpa only [sub_eq_add_neg] using hf.neg.const_add c + +theorem has_fderiv_at_filter.const_sub + (hf : has_fderiv_at_filter f f' x L) (c : F) : + has_fderiv_at_filter (λ x, c - f x) (-f') x L := +by simpa only [sub_eq_add_neg] using hf.neg.const_add c + +theorem has_fderiv_within_at.const_sub + (hf : has_fderiv_within_at f f' s x) (c : F) : + has_fderiv_within_at (λ x, c - f x) (-f') s x := +hf.const_sub c + +theorem has_fderiv_at.const_sub + (hf : has_fderiv_at f f' x) (c : F) : + has_fderiv_at (λ x, c - f x) (-f') x := +hf.const_sub c + +lemma differentiable_within_at.const_sub + (hf : differentiable_within_at 𝕜 f s x) (c : F) : + differentiable_within_at 𝕜 (λ y, c - f y) s x := +(hf.has_fderiv_within_at.const_sub c).differentiable_within_at + +@[simp] lemma differentiable_within_at_const_sub_iff (c : F) : + differentiable_within_at 𝕜 (λ y, c - f y) s x ↔ differentiable_within_at 𝕜 f s x := +by simp [sub_eq_add_neg] + +lemma differentiable_at.const_sub + (hf : differentiable_at 𝕜 f x) (c : F) : + differentiable_at 𝕜 (λ y, c - f y) x := +(hf.has_fderiv_at.const_sub c).differentiable_at + +@[simp] lemma differentiable_at_const_sub_iff (c : F) : + differentiable_at 𝕜 (λ y, c - f y) x ↔ differentiable_at 𝕜 f x := +by simp [sub_eq_add_neg] + +lemma differentiable_on.const_sub (hf : differentiable_on 𝕜 f s) (c : F) : + differentiable_on 𝕜 (λy, c - f y) s := +λx hx, (hf x hx).const_sub c + +@[simp] lemma differentiable_on_const_sub_iff (c : F) : + differentiable_on 𝕜 (λ y, c - f y) s ↔ differentiable_on 𝕜 f s := +by simp [sub_eq_add_neg] + +lemma differentiable.const_sub (hf : differentiable 𝕜 f) (c : F) : + differentiable 𝕜 (λy, c - f y) := +λx, (hf x).const_sub c + +@[simp] lemma differentiable_const_sub_iff (c : F) : + differentiable 𝕜 (λ y, c - f y) ↔ differentiable 𝕜 f := +by simp [sub_eq_add_neg] + +lemma fderiv_within_const_sub (hxs : unique_diff_within_at 𝕜 s x) (c : F) : + fderiv_within 𝕜 (λy, c - f y) s x = -fderiv_within 𝕜 f s x := +by simp only [sub_eq_add_neg, fderiv_within_const_add, fderiv_within_neg, hxs] + +lemma fderiv_const_sub (c : F) : fderiv 𝕜 (λy, c - f y) x = -fderiv 𝕜 f x := +by simp only [← fderiv_within_univ, fderiv_within_const_sub unique_diff_within_at_univ] + +end sub + +end diff --git a/src/analysis/calculus/fderiv/basic.lean b/src/analysis/calculus/fderiv/basic.lean new file mode 100644 index 0000000000000..ca62479ba25cc --- /dev/null +++ b/src/analysis/calculus/fderiv/basic.lean @@ -0,0 +1,1030 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.asymptotics.asymptotic_equivalent +import analysis.calculus.tangent_cone +import analysis.normed_space.bounded_linear_maps + +/-! +# The Fréchet derivative + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `E` and `F` be normed spaces, `f : E → F`, and `f' : E →L[𝕜] F` a +continuous 𝕜-linear map, where `𝕜` is a non-discrete normed field. Then + + `has_fderiv_within_at f f' s x` + +says that `f` has derivative `f'` at `x`, where the domain of interest +is restricted to `s`. We also have + + `has_fderiv_at f f' x := has_fderiv_within_at f f' x univ` + +Finally, + + `has_strict_fderiv_at f f' x` + +means that `f : E → F` has derivative `f' : E →L[𝕜] F` in the sense of strict differentiability, +i.e., `f y - f z - f'(y - z) = o(y - z)` as `y, z → x`. This notion is used in the inverse +function theorem, and is defined here only to avoid proving theorems like +`is_bounded_bilinear_map.has_fderiv_at` twice: first for `has_fderiv_at`, then for +`has_strict_fderiv_at`. + +## Main results + +In addition to the definition and basic properties of the derivative, +the folder `analysis/calculus/fderiv/` contains the usual formulas +(and existence assertions) for the derivative of +* constants +* the identity +* bounded linear maps (`linear.lean`) +* bounded bilinear maps (`bilinear.lean`) +* sum of two functions (`add.lean`) +* sum of finitely many functions (`add.lean`) +* multiplication of a function by a scalar constant (`add.lean`) +* negative of a function (`add.lean`) +* subtraction of two functions (`add.lean`) +* multiplication of a function by a scalar function (`mul.lean`) +* multiplication of two scalar functions (`mul.lean`) +* composition of functions (the chain rule) (`comp.lean`) +* inverse function (`mul.lean`) + (assuming that it exists; the inverse function theorem is in `../inverse.lean`) + +For most binary operations we also define `const_op` and `op_const` theorems for the cases when +the first or second argument is a constant. This makes writing chains of `has_deriv_at`'s easier, +and they more frequently lead to the desired result. + +One can also interpret the derivative of a function `f : 𝕜 → E` as an element of `E` (by identifying +a linear function from `𝕜` to `E` with its value at `1`). Results on the Fréchet derivative are +translated to this more elementary point of view on the derivative in the file `deriv.lean`. The +derivative of polynomials is handled there, as it is naturally one-dimensional. + +The simplifier is set up to prove automatically that some functions are differentiable, or +differentiable at a point (but not differentiable on a set or within a set at a point, as checking +automatically that the good domains are mapped one to the other when using composition is not +something the simplifier can easily do). This means that one can write +`example (x : ℝ) : differentiable ℝ (λ x, sin (exp (3 + x^2)) - 5 * cos x) := by simp`. +If there are divisions, one needs to supply to the simplifier proofs that the denominators do +not vanish, as in +```lean +example (x : ℝ) (h : 1 + sin x ≠ 0) : differentiable_at ℝ (λ x, exp x / (1 + sin x)) x := +by simp [h] +``` +Of course, these examples only work once `exp`, `cos` and `sin` have been shown to be +differentiable, in `analysis.special_functions.trigonometric`. + +The simplifier is not set up to compute the Fréchet derivative of maps (as these are in general +complicated multidimensional linear maps), but it will compute one-dimensional derivatives, +see `deriv.lean`. + +## Implementation details + +The derivative is defined in terms of the `is_o` relation, but also +characterized in terms of the `tendsto` relation. + +We also introduce predicates `differentiable_within_at 𝕜 f s x` (where `𝕜` is the base field, +`f` the function to be differentiated, `x` the point at which the derivative is asserted to exist, +and `s` the set along which the derivative is defined), as well as `differentiable_at 𝕜 f x`, +`differentiable_on 𝕜 f s` and `differentiable 𝕜 f` to express the existence of a derivative. + +To be able to compute with derivatives, we write `fderiv_within 𝕜 f s x` and `fderiv 𝕜 f x` +for some choice of a derivative if it exists, and the zero function otherwise. This choice only +behaves well along sets for which the derivative is unique, i.e., those for which the tangent +directions span a dense subset of the whole space. The predicates `unique_diff_within_at s x` and +`unique_diff_on s`, defined in `tangent_cone.lean` express this property. We prove that indeed +they imply the uniqueness of the derivative. This is satisfied for open subsets, and in particular +for `univ`. This uniqueness only holds when the field is non-discrete, which we request at the very +beginning: otherwise, a derivative can be defined, but it has no interesting properties whatsoever. + +To make sure that the simplifier can prove automatically that functions are differentiable, we tag +many lemmas with the `simp` attribute, for instance those saying that the sum of differentiable +functions is differentiable, as well as their product, their cartesian product, and so on. A notable +exception is the chain rule: we do not mark as a simp lemma the fact that, if `f` and `g` are +differentiable, then their composition also is: `simp` would always be able to match this lemma, +by taking `f` or `g` to be the identity. Instead, for every reasonable function (say, `exp`), +we add a lemma that if `f` is differentiable then so is `(λ x, exp (f x))`. This means adding +some boilerplate lemmas, but these can also be useful in their own right. + +Tests for this ability of the simplifier (with more examples) are provided in +`tests/differentiable.lean`. + +## Tags + +derivative, differentiable, Fréchet, calculus + +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +/-- A function `f` has the continuous linear map `f'` as derivative along the filter `L` if +`f x' = f x + f' (x' - x) + o (x' - x)` when `x'` converges along the filter `L`. This definition +is designed to be specialized for `L = 𝓝 x` (in `has_fderiv_at`), giving rise to the usual notion +of Fréchet derivative, and for `L = 𝓝[s] x` (in `has_fderiv_within_at`), giving rise to +the notion of Fréchet derivative along the set `s`. -/ +def has_fderiv_at_filter (f : E → F) (f' : E →L[𝕜] F) (x : E) (L : filter E) := +(λ x', f x' - f x - f' (x' - x)) =o[L] (λ x', x' - x) + +/-- A function `f` has the continuous linear map `f'` as derivative at `x` within a set `s` if +`f x' = f x + f' (x' - x) + o (x' - x)` when `x'` tends to `x` inside `s`. -/ +def has_fderiv_within_at (f : E → F) (f' : E →L[𝕜] F) (s : set E) (x : E) := +has_fderiv_at_filter f f' x (𝓝[s] x) + +/-- A function `f` has the continuous linear map `f'` as derivative at `x` if +`f x' = f x + f' (x' - x) + o (x' - x)` when `x'` tends to `x`. -/ +def has_fderiv_at (f : E → F) (f' : E →L[𝕜] F) (x : E) := +has_fderiv_at_filter f f' x (𝓝 x) + +/-- A function `f` has derivative `f'` at `a` in the sense of *strict differentiability* +if `f x - f y - f' (x - y) = o(x - y)` as `x, y → a`. This form of differentiability is required, +e.g., by the inverse function theorem. Any `C^1` function on a vector space over `ℝ` is strictly +differentiable but this definition works, e.g., for vector spaces over `p`-adic numbers. -/ +def has_strict_fderiv_at (f : E → F) (f' : E →L[𝕜] F) (x : E) := +(λ p : E × E, f p.1 - f p.2 - f' (p.1 - p.2)) =o[𝓝 (x, x)] (λ p : E × E, p.1 - p.2) + +variables (𝕜) + +/-- A function `f` is differentiable at a point `x` within a set `s` if it admits a derivative +there (possibly non-unique). -/ +def differentiable_within_at (f : E → F) (s : set E) (x : E) := +∃f' : E →L[𝕜] F, has_fderiv_within_at f f' s x + +/-- A function `f` is differentiable at a point `x` if it admits a derivative there (possibly +non-unique). -/ +def differentiable_at (f : E → F) (x : E) := +∃f' : E →L[𝕜] F, has_fderiv_at f f' x + +/-- If `f` has a derivative at `x` within `s`, then `fderiv_within 𝕜 f s x` is such a derivative. +Otherwise, it is set to `0`. -/ +def fderiv_within (f : E → F) (s : set E) (x : E) : E →L[𝕜] F := +if h : ∃f', has_fderiv_within_at f f' s x then classical.some h else 0 + +/-- If `f` has a derivative at `x`, then `fderiv 𝕜 f x` is such a derivative. Otherwise, it is +set to `0`. -/ +def fderiv (f : E → F) (x : E) : E →L[𝕜] F := +if h : ∃f', has_fderiv_at f f' x then classical.some h else 0 + +/-- `differentiable_on 𝕜 f s` means that `f` is differentiable within `s` at any point of `s`. -/ +def differentiable_on (f : E → F) (s : set E) := +∀x ∈ s, differentiable_within_at 𝕜 f s x + +/-- `differentiable 𝕜 f` means that `f` is differentiable at any point. -/ +def differentiable (f : E → F) := +∀x, differentiable_at 𝕜 f x + +variables {𝕜} +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +lemma fderiv_within_zero_of_not_differentiable_within_at + (h : ¬ differentiable_within_at 𝕜 f s x) : fderiv_within 𝕜 f s x = 0 := +have ¬ ∃ f', has_fderiv_within_at f f' s x, from h, +by simp [fderiv_within, this] + +lemma fderiv_zero_of_not_differentiable_at (h : ¬ differentiable_at 𝕜 f x) : fderiv 𝕜 f x = 0 := +have ¬ ∃ f', has_fderiv_at f f' x, from h, +by simp [fderiv, this] + +section derivative_uniqueness +/- In this section, we discuss the uniqueness of the derivative. +We prove that the definitions `unique_diff_within_at` and `unique_diff_on` indeed imply the +uniqueness of the derivative. -/ + +/-- If a function f has a derivative f' at x, a rescaled version of f around x converges to f', +i.e., `n (f (x + (1/n) v) - f x)` converges to `f' v`. More generally, if `c n` tends to infinity +and `c n * d n` tends to `v`, then `c n * (f (x + d n) - f x)` tends to `f' v`. This lemma expresses +this fact, for functions having a derivative within a set. Its specific formulation is useful for +tangent cone related discussions. -/ +theorem has_fderiv_within_at.lim (h : has_fderiv_within_at f f' s x) {α : Type*} (l : filter α) + {c : α → 𝕜} {d : α → E} {v : E} (dtop : ∀ᶠ n in l, x + d n ∈ s) + (clim : tendsto (λ n, ‖c n‖) l at_top) + (cdlim : tendsto (λ n, c n • d n) l (𝓝 v)) : + tendsto (λn, c n • (f (x + d n) - f x)) l (𝓝 (f' v)) := +begin + have tendsto_arg : tendsto (λ n, x + d n) l (𝓝[s] x), + { conv in (𝓝[s] x) { rw ← add_zero x }, + rw [nhds_within, tendsto_inf], + split, + { apply tendsto_const_nhds.add (tangent_cone_at.lim_zero l clim cdlim) }, + { rwa tendsto_principal } }, + have : (λ y, f y - f x - f' (y - x)) =o[𝓝[s] x] (λ y, y - x) := h, + have : (λ n, f (x + d n) - f x - f' ((x + d n) - x)) =o[l] (λ n, (x + d n) - x) := + this.comp_tendsto tendsto_arg, + have : (λ n, f (x + d n) - f x - f' (d n)) =o[l] d := by simpa only [add_sub_cancel'], + have : (λ n, c n • (f (x + d n) - f x - f' (d n))) =o[l] (λ n, c n • d n) := + (is_O_refl c l).smul_is_o this, + have : (λ n, c n • (f (x + d n) - f x - f' (d n))) =o[l] (λ n, (1:ℝ)) := + this.trans_is_O (cdlim.is_O_one ℝ), + have L1 : tendsto (λn, c n • (f (x + d n) - f x - f' (d n))) l (𝓝 0) := + (is_o_one_iff ℝ).1 this, + have L2 : tendsto (λn, f' (c n • d n)) l (𝓝 (f' v)) := + tendsto.comp f'.cont.continuous_at cdlim, + have L3 : tendsto (λn, (c n • (f (x + d n) - f x - f' (d n)) + f' (c n • d n))) + l (𝓝 (0 + f' v)) := + L1.add L2, + have : (λn, (c n • (f (x + d n) - f x - f' (d n)) + f' (c n • d n))) + = (λn, c n • (f (x + d n) - f x)), + by { ext n, simp [smul_add, smul_sub] }, + rwa [this, zero_add] at L3 +end + +/-- If `f'` and `f₁'` are two derivatives of `f` within `s` at `x`, then they are equal on the +tangent cone to `s` at `x` -/ +theorem has_fderiv_within_at.unique_on (hf : has_fderiv_within_at f f' s x) + (hg : has_fderiv_within_at f f₁' s x) : + eq_on f' f₁' (tangent_cone_at 𝕜 s x) := +λ y ⟨c, d, dtop, clim, cdlim⟩, + tendsto_nhds_unique (hf.lim at_top dtop clim cdlim) (hg.lim at_top dtop clim cdlim) + +/-- `unique_diff_within_at` achieves its goal: it implies the uniqueness of the derivative. -/ +theorem unique_diff_within_at.eq (H : unique_diff_within_at 𝕜 s x) + (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at f f₁' s x) : f' = f₁' := +continuous_linear_map.ext_on H.1 (hf.unique_on hg) + +theorem unique_diff_on.eq (H : unique_diff_on 𝕜 s) (hx : x ∈ s) + (h : has_fderiv_within_at f f' s x) (h₁ : has_fderiv_within_at f f₁' s x) : f' = f₁' := +(H x hx).eq h h₁ + +end derivative_uniqueness + +section fderiv_properties +/-! ### Basic properties of the derivative -/ + +theorem has_fderiv_at_filter_iff_tendsto : + has_fderiv_at_filter f f' x L ↔ + tendsto (λ x', ‖x' - x‖⁻¹ * ‖f x' - f x - f' (x' - x)‖) L (𝓝 0) := +have h : ∀ x', ‖x' - x‖ = 0 → ‖f x' - f x - f' (x' - x)‖ = 0, from λ x' hx', + by { rw [sub_eq_zero.1 (norm_eq_zero.1 hx')], simp }, +begin + unfold has_fderiv_at_filter, + rw [←is_o_norm_left, ←is_o_norm_right, is_o_iff_tendsto h], + exact tendsto_congr (λ _, div_eq_inv_mul _ _), +end + +theorem has_fderiv_within_at_iff_tendsto : has_fderiv_within_at f f' s x ↔ + tendsto (λ x', ‖x' - x‖⁻¹ * ‖f x' - f x - f' (x' - x)‖) (𝓝[s] x) (𝓝 0) := +has_fderiv_at_filter_iff_tendsto + +theorem has_fderiv_at_iff_tendsto : has_fderiv_at f f' x ↔ + tendsto (λ x', ‖x' - x‖⁻¹ * ‖f x' - f x - f' (x' - x)‖) (𝓝 x) (𝓝 0) := +has_fderiv_at_filter_iff_tendsto + +theorem has_fderiv_at_iff_is_o_nhds_zero : has_fderiv_at f f' x ↔ + (λ h : E, f (x + h) - f x - f' h) =o[𝓝 0] (λh, h) := +begin + rw [has_fderiv_at, has_fderiv_at_filter, ← map_add_left_nhds_zero x, is_o_map], + simp [(∘)] +end + +/-- Converse to the mean value inequality: if `f` is differentiable at `x₀` and `C`-lipschitz +on a neighborhood of `x₀` then it its derivative at `x₀` has norm bounded by `C`. This version +only assumes that `‖f x - f x₀‖ ≤ C * ‖x - x₀‖` in a neighborhood of `x`. -/ +lemma has_fderiv_at.le_of_lip' {f : E → F} {f' : E →L[𝕜] F} {x₀ : E} (hf : has_fderiv_at f f' x₀) + {C : ℝ} (hC₀ : 0 ≤ C) (hlip : ∀ᶠ x in 𝓝 x₀, ‖f x - f x₀‖ ≤ C * ‖x - x₀‖) : ‖f'‖ ≤ C := +begin + refine le_of_forall_pos_le_add (λ ε ε0, op_norm_le_of_nhds_zero _ _), + exact add_nonneg hC₀ ε0.le, + rw [← map_add_left_nhds_zero x₀, eventually_map] at hlip, + filter_upwards [is_o_iff.1 (has_fderiv_at_iff_is_o_nhds_zero.1 hf) ε0, hlip] with y hy hyC, + rw add_sub_cancel' at hyC, + calc ‖f' y‖ ≤ ‖f (x₀ + y) - f x₀‖ + ‖f (x₀ + y) - f x₀ - f' y‖ : norm_le_insert _ _ + ... ≤ C * ‖y‖ + ε * ‖y‖ : add_le_add hyC hy + ... = (C + ε) * ‖y‖ : (add_mul _ _ _).symm +end + +/-- Converse to the mean value inequality: if `f` is differentiable at `x₀` and `C`-lipschitz +on a neighborhood of `x₀` then it its derivative at `x₀` has norm bounded by `C`. -/ +lemma has_fderiv_at.le_of_lip {f : E → F} {f' : E →L[𝕜] F} {x₀ : E} (hf : has_fderiv_at f f' x₀) + {s : set E} (hs : s ∈ 𝓝 x₀) {C : ℝ≥0} (hlip : lipschitz_on_with C f s) : ‖f'‖ ≤ C := +begin + refine hf.le_of_lip' C.coe_nonneg _, + filter_upwards [hs] with x hx using hlip.norm_sub_le hx (mem_of_mem_nhds hs), +end + +theorem has_fderiv_at_filter.mono (h : has_fderiv_at_filter f f' x L₂) (hst : L₁ ≤ L₂) : + has_fderiv_at_filter f f' x L₁ := +h.mono hst + +theorem has_fderiv_within_at.mono_of_mem (h : has_fderiv_within_at f f' t x) (hst : t ∈ 𝓝[s] x) : + has_fderiv_within_at f f' s x := +h.mono $ nhds_within_le_iff.mpr hst + +theorem has_fderiv_within_at.mono (h : has_fderiv_within_at f f' t x) (hst : s ⊆ t) : + has_fderiv_within_at f f' s x := +h.mono $ nhds_within_mono _ hst + +theorem has_fderiv_at.has_fderiv_at_filter (h : has_fderiv_at f f' x) (hL : L ≤ 𝓝 x) : + has_fderiv_at_filter f f' x L := +h.mono hL + +theorem has_fderiv_at.has_fderiv_within_at + (h : has_fderiv_at f f' x) : has_fderiv_within_at f f' s x := +h.has_fderiv_at_filter inf_le_left + +lemma has_fderiv_within_at.differentiable_within_at (h : has_fderiv_within_at f f' s x) : + differentiable_within_at 𝕜 f s x := +⟨f', h⟩ + +lemma has_fderiv_at.differentiable_at (h : has_fderiv_at f f' x) : differentiable_at 𝕜 f x := +⟨f', h⟩ + +@[simp] lemma has_fderiv_within_at_univ : + has_fderiv_within_at f f' univ x ↔ has_fderiv_at f f' x := +by { simp only [has_fderiv_within_at, nhds_within_univ], refl } + +alias has_fderiv_within_at_univ ↔ has_fderiv_within_at.has_fderiv_at_of_univ _ + +lemma has_fderiv_within_at_insert {y : E} : + has_fderiv_within_at f f' (insert y s) x ↔ has_fderiv_within_at f f' s x := +begin + rcases eq_or_ne x y with rfl|h, + { simp_rw [has_fderiv_within_at, has_fderiv_at_filter], + apply asymptotics.is_o_insert, + simp only [sub_self, map_zero] }, + refine ⟨λ h, h.mono $ subset_insert y s, λ hf, hf.mono_of_mem _⟩, + simp_rw [nhds_within_insert_of_ne h, self_mem_nhds_within] +end + +alias has_fderiv_within_at_insert ↔ has_fderiv_within_at.of_insert has_fderiv_within_at.insert' + +lemma has_fderiv_within_at.insert (h : has_fderiv_within_at f f' s x) : + has_fderiv_within_at f f' (insert x s) x := +h.insert' + +lemma has_fderiv_within_at_diff_singleton (y : E) : + has_fderiv_within_at f f' (s \ {y}) x ↔ has_fderiv_within_at f f' s x := +by rw [← has_fderiv_within_at_insert, insert_diff_singleton, has_fderiv_within_at_insert] + +lemma has_strict_fderiv_at.is_O_sub (hf : has_strict_fderiv_at f f' x) : + (λ p : E × E, f p.1 - f p.2) =O[𝓝 (x, x)] (λ p : E × E, p.1 - p.2) := +hf.is_O.congr_of_sub.2 (f'.is_O_comp _ _) + +lemma has_fderiv_at_filter.is_O_sub (h : has_fderiv_at_filter f f' x L) : + (λ x', f x' - f x) =O[L] (λ x', x' - x) := +h.is_O.congr_of_sub.2 (f'.is_O_sub _ _) + +protected lemma has_strict_fderiv_at.has_fderiv_at (hf : has_strict_fderiv_at f f' x) : + has_fderiv_at f f' x := +begin + rw [has_fderiv_at, has_fderiv_at_filter, is_o_iff], + exact (λ c hc, tendsto_id.prod_mk_nhds tendsto_const_nhds (is_o_iff.1 hf hc)) +end + +protected lemma has_strict_fderiv_at.differentiable_at (hf : has_strict_fderiv_at f f' x) : + differentiable_at 𝕜 f x := +hf.has_fderiv_at.differentiable_at + +/-- If `f` is strictly differentiable at `x` with derivative `f'` and `K > ‖f'‖₊`, then `f` is +`K`-Lipschitz in a neighborhood of `x`. -/ +lemma has_strict_fderiv_at.exists_lipschitz_on_with_of_nnnorm_lt (hf : has_strict_fderiv_at f f' x) + (K : ℝ≥0) (hK : ‖f'‖₊ < K) : ∃ s ∈ 𝓝 x, lipschitz_on_with K f s := +begin + have := hf.add_is_O_with (f'.is_O_with_comp _ _) hK, + simp only [sub_add_cancel, is_O_with] at this, + rcases exists_nhds_square this with ⟨U, Uo, xU, hU⟩, + exact ⟨U, Uo.mem_nhds xU, lipschitz_on_with_iff_norm_sub_le.2 $ + λ x hx y hy, hU (mk_mem_prod hx hy)⟩ +end + +/-- If `f` is strictly differentiable at `x` with derivative `f'`, then `f` is Lipschitz in a +neighborhood of `x`. See also `has_strict_fderiv_at.exists_lipschitz_on_with_of_nnnorm_lt` for a +more precise statement. -/ +lemma has_strict_fderiv_at.exists_lipschitz_on_with (hf : has_strict_fderiv_at f f' x) : + ∃ K (s ∈ 𝓝 x), lipschitz_on_with K f s := +(exists_gt _).imp hf.exists_lipschitz_on_with_of_nnnorm_lt + +/-- Directional derivative agrees with `has_fderiv`. -/ +lemma has_fderiv_at.lim (hf : has_fderiv_at f f' x) (v : E) {α : Type*} {c : α → 𝕜} + {l : filter α} (hc : tendsto (λ n, ‖c n‖) l at_top) : + tendsto (λ n, (c n) • (f (x + (c n)⁻¹ • v) - f x)) l (𝓝 (f' v)) := +begin + refine (has_fderiv_within_at_univ.2 hf).lim _ univ_mem hc _, + assume U hU, + refine (eventually_ne_of_tendsto_norm_at_top hc (0:𝕜)).mono (λ y hy, _), + convert mem_of_mem_nhds hU, + dsimp only, + rw [← mul_smul, mul_inv_cancel hy, one_smul] +end + +theorem has_fderiv_at.unique + (h₀ : has_fderiv_at f f₀' x) (h₁ : has_fderiv_at f f₁' x) : f₀' = f₁' := +begin + rw ← has_fderiv_within_at_univ at h₀ h₁, + exact unique_diff_within_at_univ.eq h₀ h₁ +end + +lemma has_fderiv_within_at_inter' (h : t ∈ 𝓝[s] x) : + has_fderiv_within_at f f' (s ∩ t) x ↔ has_fderiv_within_at f f' s x := +by simp [has_fderiv_within_at, nhds_within_restrict'' s h] + +lemma has_fderiv_within_at_inter (h : t ∈ 𝓝 x) : + has_fderiv_within_at f f' (s ∩ t) x ↔ has_fderiv_within_at f f' s x := +by simp [has_fderiv_within_at, nhds_within_restrict' s h] + +lemma has_fderiv_within_at.union (hs : has_fderiv_within_at f f' s x) + (ht : has_fderiv_within_at f f' t x) : + has_fderiv_within_at f f' (s ∪ t) x := +begin + simp only [has_fderiv_within_at, nhds_within_union], + exact hs.sup ht, +end + +lemma has_fderiv_within_at.nhds_within (h : has_fderiv_within_at f f' s x) + (ht : s ∈ 𝓝[t] x) : has_fderiv_within_at f f' t x := +(has_fderiv_within_at_inter' ht).1 (h.mono (inter_subset_right _ _)) + +lemma has_fderiv_within_at.has_fderiv_at (h : has_fderiv_within_at f f' s x) (hs : s ∈ 𝓝 x) : + has_fderiv_at f f' x := +by rwa [← univ_inter s, has_fderiv_within_at_inter hs, has_fderiv_within_at_univ] at h + +lemma differentiable_within_at.differentiable_at + (h : differentiable_within_at 𝕜 f s x) (hs : s ∈ 𝓝 x) : differentiable_at 𝕜 f x := +h.imp (λ f' hf', hf'.has_fderiv_at hs) + +lemma differentiable_within_at.has_fderiv_within_at (h : differentiable_within_at 𝕜 f s x) : + has_fderiv_within_at f (fderiv_within 𝕜 f s x) s x := +begin + dunfold fderiv_within, + dunfold differentiable_within_at at h, + rw dif_pos h, + exact classical.some_spec h +end + +lemma differentiable_at.has_fderiv_at (h : differentiable_at 𝕜 f x) : + has_fderiv_at f (fderiv 𝕜 f x) x := +begin + dunfold fderiv, + dunfold differentiable_at at h, + rw dif_pos h, + exact classical.some_spec h +end + +lemma differentiable_on.has_fderiv_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : + has_fderiv_at f (fderiv 𝕜 f x) x := +((h x (mem_of_mem_nhds hs)).differentiable_at hs).has_fderiv_at + +lemma differentiable_on.differentiable_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : + differentiable_at 𝕜 f x := +(h.has_fderiv_at hs).differentiable_at + +lemma differentiable_on.eventually_differentiable_at (h : differentiable_on 𝕜 f s) (hs : s ∈ 𝓝 x) : + ∀ᶠ y in 𝓝 x, differentiable_at 𝕜 f y := +(eventually_eventually_nhds.2 hs).mono $ λ y, h.differentiable_at + +lemma has_fderiv_at.fderiv (h : has_fderiv_at f f' x) : fderiv 𝕜 f x = f' := +by { ext, rw h.unique h.differentiable_at.has_fderiv_at } + +lemma fderiv_eq {f' : E → E →L[𝕜] F} (h : ∀ x, has_fderiv_at f (f' x) x) : fderiv 𝕜 f = f' := +funext $ λ x, (h x).fderiv + +/-- Converse to the mean value inequality: if `f` is differentiable at `x₀` and `C`-lipschitz +on a neighborhood of `x₀` then it its derivative at `x₀` has norm bounded by `C`. +Version using `fderiv`. -/ +lemma fderiv_at.le_of_lip {f : E → F} {x₀ : E} (hf : differentiable_at 𝕜 f x₀) + {s : set E} (hs : s ∈ 𝓝 x₀) {C : ℝ≥0} (hlip : lipschitz_on_with C f s) : ‖fderiv 𝕜 f x₀‖ ≤ C := +hf.has_fderiv_at.le_of_lip hs hlip + +lemma has_fderiv_within_at.fderiv_within + (h : has_fderiv_within_at f f' s x) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 f s x = f' := +(hxs.eq h h.differentiable_within_at.has_fderiv_within_at).symm + +/-- If `x` is not in the closure of `s`, then `f` has any derivative at `x` within `s`, +as this statement is empty. -/ +lemma has_fderiv_within_at_of_not_mem_closure (h : x ∉ closure s) : + has_fderiv_within_at f f' s x := +begin + simp only [mem_closure_iff_nhds_within_ne_bot, ne_bot_iff, ne.def, not_not] at h, + simp [has_fderiv_within_at, has_fderiv_at_filter, h, is_o, is_O_with], +end + +lemma differentiable_within_at.mono (h : differentiable_within_at 𝕜 f t x) (st : s ⊆ t) : + differentiable_within_at 𝕜 f s x := +begin + rcases h with ⟨f', hf'⟩, + exact ⟨f', hf'.mono st⟩ +end + +lemma differentiable_within_at.mono_of_mem (h : differentiable_within_at 𝕜 f s x) {t : set E} + (hst : s ∈ 𝓝[t] x) : + differentiable_within_at 𝕜 f t x := +(h.has_fderiv_within_at.mono_of_mem hst).differentiable_within_at + +lemma differentiable_within_at_univ : + differentiable_within_at 𝕜 f univ x ↔ differentiable_at 𝕜 f x := +by simp only [differentiable_within_at, has_fderiv_within_at_univ, differentiable_at] + +lemma differentiable_within_at_inter (ht : t ∈ 𝓝 x) : + differentiable_within_at 𝕜 f (s ∩ t) x ↔ differentiable_within_at 𝕜 f s x := +by simp only [differentiable_within_at, has_fderiv_within_at_inter ht] + +lemma differentiable_within_at_inter' (ht : t ∈ 𝓝[s] x) : + differentiable_within_at 𝕜 f (s ∩ t) x ↔ differentiable_within_at 𝕜 f s x := +by simp only [differentiable_within_at, has_fderiv_within_at_inter' ht] + +lemma differentiable_at.differentiable_within_at + (h : differentiable_at 𝕜 f x) : differentiable_within_at 𝕜 f s x := +(differentiable_within_at_univ.2 h).mono (subset_univ _) + +lemma differentiable.differentiable_at (h : differentiable 𝕜 f) : + differentiable_at 𝕜 f x := +h x + +lemma differentiable_at.fderiv_within + (h : differentiable_at 𝕜 f x) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 f s x = fderiv 𝕜 f x := +h.has_fderiv_at.has_fderiv_within_at.fderiv_within hxs + +lemma differentiable_on.mono (h : differentiable_on 𝕜 f t) (st : s ⊆ t) : + differentiable_on 𝕜 f s := +λ x hx, (h x (st hx)).mono st + +lemma differentiable_on_univ : + differentiable_on 𝕜 f univ ↔ differentiable 𝕜 f := +by simp only [differentiable_on, differentiable, differentiable_within_at_univ, mem_univ, + forall_true_left] + +lemma differentiable.differentiable_on (h : differentiable 𝕜 f) : differentiable_on 𝕜 f s := +(differentiable_on_univ.2 h).mono (subset_univ _) + +lemma differentiable_on_of_locally_differentiable_on + (h : ∀x∈s, ∃u, is_open u ∧ x ∈ u ∧ differentiable_on 𝕜 f (s ∩ u)) : differentiable_on 𝕜 f s := +begin + assume x xs, + rcases h x xs with ⟨t, t_open, xt, ht⟩, + exact (differentiable_within_at_inter (is_open.mem_nhds t_open xt)).1 (ht x ⟨xs, xt⟩) +end + +lemma fderiv_within_of_mem (st : t ∈ 𝓝[s] x) (ht : unique_diff_within_at 𝕜 s x) + (h : differentiable_within_at 𝕜 f t x) : + fderiv_within 𝕜 f s x = fderiv_within 𝕜 f t x := +((differentiable_within_at.has_fderiv_within_at h).mono_of_mem st).fderiv_within ht + +lemma fderiv_within_subset (st : s ⊆ t) (ht : unique_diff_within_at 𝕜 s x) + (h : differentiable_within_at 𝕜 f t x) : + fderiv_within 𝕜 f s x = fderiv_within 𝕜 f t x := +fderiv_within_of_mem (nhds_within_mono _ st self_mem_nhds_within) ht h + +lemma fderiv_within_inter (ht : t ∈ 𝓝 x) : + fderiv_within 𝕜 f (s ∩ t) x = fderiv_within 𝕜 f s x := +by simp only [fderiv_within, has_fderiv_within_at_inter ht] + +lemma fderiv_within_of_mem_nhds (h : s ∈ 𝓝 x) : + fderiv_within 𝕜 f s x = fderiv 𝕜 f x := +by simp only [fderiv, fderiv_within, has_fderiv_at, has_fderiv_within_at, nhds_within_eq_nhds.2 h] + +@[simp] lemma fderiv_within_univ : fderiv_within 𝕜 f univ = fderiv 𝕜 f := +funext $ λ _, fderiv_within_of_mem_nhds univ_mem + +lemma fderiv_within_of_open (hs : is_open s) (hx : x ∈ s) : + fderiv_within 𝕜 f s x = fderiv 𝕜 f x := +fderiv_within_of_mem_nhds (hs.mem_nhds hx) + +lemma fderiv_within_eq_fderiv (hs : unique_diff_within_at 𝕜 s x) (h : differentiable_at 𝕜 f x) : + fderiv_within 𝕜 f s x = fderiv 𝕜 f x := +begin + rw ← fderiv_within_univ, + exact fderiv_within_subset (subset_univ _) hs h.differentiable_within_at +end + +lemma fderiv_mem_iff {f : E → F} {s : set (E →L[𝕜] F)} {x : E} : + fderiv 𝕜 f x ∈ s ↔ (differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ s) ∨ + (¬differentiable_at 𝕜 f x ∧ (0 : E →L[𝕜] F) ∈ s) := +by by_cases hx : differentiable_at 𝕜 f x; simp [fderiv_zero_of_not_differentiable_at, *] + +lemma fderiv_within_mem_iff {f : E → F} {t : set E} {s : set (E →L[𝕜] F)} {x : E} : + fderiv_within 𝕜 f t x ∈ s ↔ (differentiable_within_at 𝕜 f t x ∧ fderiv_within 𝕜 f t x ∈ s) ∨ + (¬differentiable_within_at 𝕜 f t x ∧ (0 : E →L[𝕜] F) ∈ s) := +by by_cases hx : differentiable_within_at 𝕜 f t x; + simp [fderiv_within_zero_of_not_differentiable_within_at, *] + +lemma asymptotics.is_O.has_fderiv_within_at {s : set E} {x₀ : E} {n : ℕ} + (h : f =O[𝓝[s] x₀] λ x, ‖x - x₀‖^n) (hx₀ : x₀ ∈ s) (hn : 1 < n) : + has_fderiv_within_at f (0 : E →L[𝕜] F) s x₀ := +by simp_rw [has_fderiv_within_at, has_fderiv_at_filter, + h.eq_zero_of_norm_pow_within hx₀ $ zero_lt_one.trans hn, zero_apply, sub_zero, + h.trans_is_o ((is_o_pow_sub_sub x₀ hn).mono nhds_within_le_nhds)] + +lemma asymptotics.is_O.has_fderiv_at {x₀ : E} {n : ℕ} + (h : f =O[𝓝 x₀] λ x, ‖x - x₀‖^n) (hn : 1 < n) : + has_fderiv_at f (0 : E →L[𝕜] F) x₀ := +begin + rw [← nhds_within_univ] at h, + exact (h.has_fderiv_within_at (mem_univ _) hn).has_fderiv_at_of_univ +end + +lemma has_fderiv_within_at.is_O {f : E → F} {s : set E} {x₀ : E} {f' : E →L[𝕜] F} + (h : has_fderiv_within_at f f' s x₀) : + (λ x, f x - f x₀) =O[𝓝[s] x₀] λ x, x - x₀ := +by simpa only [sub_add_cancel] using h.is_O.add (is_O_sub f' (𝓝[s] x₀) x₀) + +lemma has_fderiv_at.is_O {f : E → F} {x₀ : E} {f' : E →L[𝕜] F} (h : has_fderiv_at f f' x₀) : + (λ x, f x - f x₀) =O[𝓝 x₀] λ x, x - x₀ := +by simpa only [sub_add_cancel] using h.is_O.add (is_O_sub f' (𝓝 x₀) x₀) + +end fderiv_properties + +section continuous +/-! ### Deducing continuity from differentiability -/ + +theorem has_fderiv_at_filter.tendsto_nhds + (hL : L ≤ 𝓝 x) (h : has_fderiv_at_filter f f' x L) : + tendsto f L (𝓝 (f x)) := +begin + have : tendsto (λ x', f x' - f x) L (𝓝 0), + { refine h.is_O_sub.trans_tendsto (tendsto.mono_left _ hL), + rw ← sub_self x, exact tendsto_id.sub tendsto_const_nhds }, + have := tendsto.add this tendsto_const_nhds, + rw zero_add (f x) at this, + exact this.congr (by simp only [sub_add_cancel, eq_self_iff_true, forall_const]) +end + +theorem has_fderiv_within_at.continuous_within_at + (h : has_fderiv_within_at f f' s x) : continuous_within_at f s x := +has_fderiv_at_filter.tendsto_nhds inf_le_left h + +theorem has_fderiv_at.continuous_at (h : has_fderiv_at f f' x) : + continuous_at f x := +has_fderiv_at_filter.tendsto_nhds le_rfl h + +lemma differentiable_within_at.continuous_within_at (h : differentiable_within_at 𝕜 f s x) : + continuous_within_at f s x := +let ⟨f', hf'⟩ := h in hf'.continuous_within_at + +lemma differentiable_at.continuous_at (h : differentiable_at 𝕜 f x) : continuous_at f x := +let ⟨f', hf'⟩ := h in hf'.continuous_at + +lemma differentiable_on.continuous_on (h : differentiable_on 𝕜 f s) : continuous_on f s := +λx hx, (h x hx).continuous_within_at + +lemma differentiable.continuous (h : differentiable 𝕜 f) : continuous f := +continuous_iff_continuous_at.2 $ λx, (h x).continuous_at + +protected lemma has_strict_fderiv_at.continuous_at (hf : has_strict_fderiv_at f f' x) : + continuous_at f x := +hf.has_fderiv_at.continuous_at + +lemma has_strict_fderiv_at.is_O_sub_rev {f' : E ≃L[𝕜] F} + (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) x) : + (λ p : E × E, p.1 - p.2) =O[𝓝 (x, x)](λ p : E × E, f p.1 - f p.2) := +((f'.is_O_comp_rev _ _).trans (hf.trans_is_O (f'.is_O_comp_rev _ _)).right_is_O_add).congr +(λ _, rfl) (λ _, sub_add_cancel _ _) + +lemma has_fderiv_at_filter.is_O_sub_rev (hf : has_fderiv_at_filter f f' x L) {C} + (hf' : antilipschitz_with C f') : + (λ x', x' - x) =O[L] (λ x', f x' - f x) := +have (λ x', x' - x) =O[L] (λ x', f' (x' - x)), + from is_O_iff.2 ⟨C, eventually_of_forall $ λ x', + zero_hom_class.bound_of_antilipschitz f' hf' _⟩, +(this.trans (hf.trans_is_O this).right_is_O_add).congr (λ _, rfl) (λ _, sub_add_cancel _ _) + +end continuous + +section congr +/-! ### congr properties of the derivative -/ + +lemma has_fderiv_within_at_congr_set' (y : E) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) : + has_fderiv_within_at f f' s x ↔ has_fderiv_within_at f f' t x := +calc has_fderiv_within_at f f' s x ↔ has_fderiv_within_at f f' (s \ {y}) x : + (has_fderiv_within_at_diff_singleton _).symm +... ↔ has_fderiv_within_at f f' (t \ {y}) x : + suffices 𝓝[s \ {y}] x = 𝓝[t \ {y}] x, by simp only [has_fderiv_within_at, this], + by simpa only [set_eventually_eq_iff_inf_principal, ← nhds_within_inter', diff_eq, inter_comm] + using h +... ↔ has_fderiv_within_at f f' t x : has_fderiv_within_at_diff_singleton _ + +lemma has_fderiv_within_at_congr_set (h : s =ᶠ[𝓝 x] t) : + has_fderiv_within_at f f' s x ↔ has_fderiv_within_at f f' t x := +has_fderiv_within_at_congr_set' x $ h.filter_mono inf_le_left + +lemma differentiable_within_at_congr_set' (y : E) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) : + differentiable_within_at 𝕜 f s x ↔ differentiable_within_at 𝕜 f t x := +exists_congr $ λ _, has_fderiv_within_at_congr_set' _ h + +lemma differentiable_within_at_congr_set (h : s =ᶠ[𝓝 x] t) : + differentiable_within_at 𝕜 f s x ↔ differentiable_within_at 𝕜 f t x := +exists_congr $ λ _, has_fderiv_within_at_congr_set h + +lemma fderiv_within_congr_set' (y : E) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) : + fderiv_within 𝕜 f s x = fderiv_within 𝕜 f t x := +by simp only [fderiv_within, has_fderiv_within_at_congr_set' y h] + +lemma fderiv_within_congr_set (h : s =ᶠ[𝓝 x] t) : + fderiv_within 𝕜 f s x = fderiv_within 𝕜 f t x := +fderiv_within_congr_set' x $ h.filter_mono inf_le_left + +lemma fderiv_within_eventually_congr_set' (y : E) (h : s =ᶠ[𝓝[{y}ᶜ] x] t) : + fderiv_within 𝕜 f s =ᶠ[𝓝 x] fderiv_within 𝕜 f t := +(eventually_nhds_nhds_within.2 h).mono $ λ _, fderiv_within_congr_set' y + +lemma fderiv_within_eventually_congr_set (h : s =ᶠ[𝓝 x] t) : + fderiv_within 𝕜 f s =ᶠ[𝓝 x] fderiv_within 𝕜 f t := +fderiv_within_eventually_congr_set' x $ h.filter_mono inf_le_left + +theorem filter.eventually_eq.has_strict_fderiv_at_iff + (h : f₀ =ᶠ[𝓝 x] f₁) (h' : ∀ y, f₀' y = f₁' y) : + has_strict_fderiv_at f₀ f₀' x ↔ has_strict_fderiv_at f₁ f₁' x := +begin + refine is_o_congr ((h.prod_mk_nhds h).mono _) (eventually_of_forall $ λ _, rfl), + rintros p ⟨hp₁, hp₂⟩, + simp only [*] +end + +theorem has_strict_fderiv_at.congr_of_eventually_eq (h : has_strict_fderiv_at f f' x) + (h₁ : f =ᶠ[𝓝 x] f₁) : has_strict_fderiv_at f₁ f' x := +(h₁.has_strict_fderiv_at_iff (λ _, rfl)).1 h + +theorem filter.eventually_eq.has_fderiv_at_filter_iff + (h₀ : f₀ =ᶠ[L] f₁) (hx : f₀ x = f₁ x) (h₁ : ∀ x, f₀' x = f₁' x) : + has_fderiv_at_filter f₀ f₀' x L ↔ has_fderiv_at_filter f₁ f₁' x L := +is_o_congr (h₀.mono $ λ y hy, by simp only [hy, h₁, hx]) (eventually_of_forall $ λ _, rfl) + +lemma has_fderiv_at_filter.congr_of_eventually_eq (h : has_fderiv_at_filter f f' x L) + (hL : f₁ =ᶠ[L] f) (hx : f₁ x = f x) : has_fderiv_at_filter f₁ f' x L := +(hL.has_fderiv_at_filter_iff hx $ λ _, rfl).2 h + +theorem filter.eventually_eq.has_fderiv_at_iff (h : f₀ =ᶠ[𝓝 x] f₁) : + has_fderiv_at f₀ f' x ↔ has_fderiv_at f₁ f' x := +h.has_fderiv_at_filter_iff h.eq_of_nhds (λ _, rfl) + +theorem filter.eventually_eq.differentiable_at_iff (h : f₀ =ᶠ[𝓝 x] f₁) : + differentiable_at 𝕜 f₀ x ↔ differentiable_at 𝕜 f₁ x := +exists_congr $ λ f', h.has_fderiv_at_iff + +theorem filter.eventually_eq.has_fderiv_within_at_iff (h : f₀ =ᶠ[𝓝[s] x] f₁) (hx : f₀ x = f₁ x) : + has_fderiv_within_at f₀ f' s x ↔ has_fderiv_within_at f₁ f' s x := +h.has_fderiv_at_filter_iff hx (λ _, rfl) + +theorem filter.eventually_eq.has_fderiv_within_at_iff_of_mem (h : f₀ =ᶠ[𝓝[s] x] f₁) (hx : x ∈ s) : + has_fderiv_within_at f₀ f' s x ↔ has_fderiv_within_at f₁ f' s x := +h.has_fderiv_within_at_iff (h.eq_of_nhds_within hx) + +theorem filter.eventually_eq.differentiable_within_at_iff (h : f₀ =ᶠ[𝓝[s] x] f₁) + (hx : f₀ x = f₁ x) : + differentiable_within_at 𝕜 f₀ s x ↔ differentiable_within_at 𝕜 f₁ s x := +exists_congr $ λ f', h.has_fderiv_within_at_iff hx + +theorem filter.eventually_eq.differentiable_within_at_iff_of_mem (h : f₀ =ᶠ[𝓝[s] x] f₁) + (hx : x ∈ s) : + differentiable_within_at 𝕜 f₀ s x ↔ differentiable_within_at 𝕜 f₁ s x := +h.differentiable_within_at_iff (h.eq_of_nhds_within hx) + +lemma has_fderiv_within_at.congr_mono (h : has_fderiv_within_at f f' s x) (ht : eq_on f₁ f t) + (hx : f₁ x = f x) (h₁ : t ⊆ s) : has_fderiv_within_at f₁ f' t x := +has_fderiv_at_filter.congr_of_eventually_eq (h.mono h₁) (filter.mem_inf_of_right ht) hx + +lemma has_fderiv_within_at.congr (h : has_fderiv_within_at f f' s x) (hs : eq_on f₁ f s) + (hx : f₁ x = f x) : has_fderiv_within_at f₁ f' s x := +h.congr_mono hs hx (subset.refl _) + +lemma has_fderiv_within_at.congr' (h : has_fderiv_within_at f f' s x) (hs : eq_on f₁ f s) + (hx : x ∈ s) : has_fderiv_within_at f₁ f' s x := +h.congr hs (hs hx) + +lemma has_fderiv_within_at.congr_of_eventually_eq (h : has_fderiv_within_at f f' s x) + (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : has_fderiv_within_at f₁ f' s x := +has_fderiv_at_filter.congr_of_eventually_eq h h₁ hx + +lemma has_fderiv_at.congr_of_eventually_eq (h : has_fderiv_at f f' x) + (h₁ : f₁ =ᶠ[𝓝 x] f) : has_fderiv_at f₁ f' x := +has_fderiv_at_filter.congr_of_eventually_eq h h₁ (mem_of_mem_nhds h₁ : _) + +lemma differentiable_within_at.congr_mono (h : differentiable_within_at 𝕜 f s x) + (ht : eq_on f₁ f t) (hx : f₁ x = f x) (h₁ : t ⊆ s) : differentiable_within_at 𝕜 f₁ t x := +(h.has_fderiv_within_at.congr_mono ht hx h₁).differentiable_within_at + +lemma differentiable_within_at.congr (h : differentiable_within_at 𝕜 f s x) + (ht : ∀x ∈ s, f₁ x = f x) (hx : f₁ x = f x) : differentiable_within_at 𝕜 f₁ s x := +differentiable_within_at.congr_mono h ht hx (subset.refl _) + +lemma differentiable_within_at.congr_of_eventually_eq + (h : differentiable_within_at 𝕜 f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) + (hx : f₁ x = f x) : differentiable_within_at 𝕜 f₁ s x := +(h.has_fderiv_within_at.congr_of_eventually_eq h₁ hx).differentiable_within_at + +lemma differentiable_on.congr_mono (h : differentiable_on 𝕜 f s) (h' : ∀x ∈ t, f₁ x = f x) + (h₁ : t ⊆ s) : differentiable_on 𝕜 f₁ t := +λ x hx, (h x (h₁ hx)).congr_mono h' (h' x hx) h₁ + +lemma differentiable_on.congr (h : differentiable_on 𝕜 f s) (h' : ∀x ∈ s, f₁ x = f x) : + differentiable_on 𝕜 f₁ s := +λ x hx, (h x hx).congr h' (h' x hx) + +lemma differentiable_on_congr (h' : ∀x ∈ s, f₁ x = f x) : + differentiable_on 𝕜 f₁ s ↔ differentiable_on 𝕜 f s := +⟨λ h, differentiable_on.congr h (λy hy, (h' y hy).symm), +λ h, differentiable_on.congr h h'⟩ + +lemma differentiable_at.congr_of_eventually_eq (h : differentiable_at 𝕜 f x) (hL : f₁ =ᶠ[𝓝 x] f) : + differentiable_at 𝕜 f₁ x := +hL.differentiable_at_iff.2 h + +lemma differentiable_within_at.fderiv_within_congr_mono (h : differentiable_within_at 𝕜 f s x) + (hs : eq_on f₁ f t) (hx : f₁ x = f x) (hxt : unique_diff_within_at 𝕜 t x) (h₁ : t ⊆ s) : + fderiv_within 𝕜 f₁ t x = fderiv_within 𝕜 f s x := +(has_fderiv_within_at.congr_mono h.has_fderiv_within_at hs hx h₁).fderiv_within hxt + +lemma filter.eventually_eq.fderiv_within_eq (hs : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) : + fderiv_within 𝕜 f₁ s x = fderiv_within 𝕜 f s x := +by simp only [fderiv_within, hs.has_fderiv_within_at_iff hx] + +lemma filter.eventually_eq.fderiv_within' (hs : f₁ =ᶠ[𝓝[s] x] f) (ht : t ⊆ s) : + fderiv_within 𝕜 f₁ t =ᶠ[𝓝[s] x] fderiv_within 𝕜 f t := +(eventually_nhds_within_nhds_within.2 hs).mp $ eventually_mem_nhds_within.mono $ λ y hys hs, + filter.eventually_eq.fderiv_within_eq (hs.filter_mono $ nhds_within_mono _ ht) + (hs.self_of_nhds_within hys) + +protected lemma filter.eventually_eq.fderiv_within (hs : f₁ =ᶠ[𝓝[s] x] f) : + fderiv_within 𝕜 f₁ s =ᶠ[𝓝[s] x] fderiv_within 𝕜 f s := +hs.fderiv_within' subset.rfl + +lemma filter.eventually_eq.fderiv_within_eq_nhds (h : f₁ =ᶠ[𝓝 x] f) : + fderiv_within 𝕜 f₁ s x = fderiv_within 𝕜 f s x := +(h.filter_mono nhds_within_le_nhds).fderiv_within_eq h.self_of_nhds + +lemma fderiv_within_congr (hs : eq_on f₁ f s) (hx : f₁ x = f x) : + fderiv_within 𝕜 f₁ s x = fderiv_within 𝕜 f s x := +(hs.eventually_eq.filter_mono inf_le_right).fderiv_within_eq hx + +lemma fderiv_within_congr' (hs : eq_on f₁ f s) (hx : x ∈ s) : + fderiv_within 𝕜 f₁ s x = fderiv_within 𝕜 f s x := +fderiv_within_congr hs (hs hx) + +lemma filter.eventually_eq.fderiv_eq (h : f₁ =ᶠ[𝓝 x] f) : + fderiv 𝕜 f₁ x = fderiv 𝕜 f x := +by rw [← fderiv_within_univ, ← fderiv_within_univ, h.fderiv_within_eq_nhds] + +protected lemma filter.eventually_eq.fderiv (h : f₁ =ᶠ[𝓝 x] f) : + fderiv 𝕜 f₁ =ᶠ[𝓝 x] fderiv 𝕜 f := +h.eventually_eq_nhds.mono $ λ x h, h.fderiv_eq + +end congr + +section id +/-! ### Derivative of the identity -/ + +theorem has_strict_fderiv_at_id (x : E) : + has_strict_fderiv_at id (id 𝕜 E) x := +(is_o_zero _ _).congr_left $ by simp + +theorem has_fderiv_at_filter_id (x : E) (L : filter E) : + has_fderiv_at_filter id (id 𝕜 E) x L := +(is_o_zero _ _).congr_left $ by simp + +theorem has_fderiv_within_at_id (x : E) (s : set E) : + has_fderiv_within_at id (id 𝕜 E) s x := +has_fderiv_at_filter_id _ _ + +theorem has_fderiv_at_id (x : E) : has_fderiv_at id (id 𝕜 E) x := +has_fderiv_at_filter_id _ _ + +@[simp] lemma differentiable_at_id : differentiable_at 𝕜 id x := +(has_fderiv_at_id x).differentiable_at + +@[simp] lemma differentiable_at_id' : differentiable_at 𝕜 (λ x, x) x := +(has_fderiv_at_id x).differentiable_at + +lemma differentiable_within_at_id : differentiable_within_at 𝕜 id s x := +differentiable_at_id.differentiable_within_at + +@[simp] lemma differentiable_id : differentiable 𝕜 (id : E → E) := +λx, differentiable_at_id + +@[simp] lemma differentiable_id' : differentiable 𝕜 (λ (x : E), x) := +λx, differentiable_at_id + +lemma differentiable_on_id : differentiable_on 𝕜 id s := +differentiable_id.differentiable_on + +lemma fderiv_id : fderiv 𝕜 id x = id 𝕜 E := +has_fderiv_at.fderiv (has_fderiv_at_id x) + +@[simp] lemma fderiv_id' : fderiv 𝕜 (λ (x : E), x) x = continuous_linear_map.id 𝕜 E := +fderiv_id + +lemma fderiv_within_id (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 id s x = id 𝕜 E := +begin + rw differentiable_at.fderiv_within (differentiable_at_id) hxs, + exact fderiv_id +end + +lemma fderiv_within_id' (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λ (x : E), x) s x = continuous_linear_map.id 𝕜 E := +fderiv_within_id hxs + +end id + +section const +/-! ### derivative of a constant function -/ + +theorem has_strict_fderiv_at_const (c : F) (x : E) : + has_strict_fderiv_at (λ _, c) (0 : E →L[𝕜] F) x := +(is_o_zero _ _).congr_left $ λ _, by simp only [zero_apply, sub_self] + +theorem has_fderiv_at_filter_const (c : F) (x : E) (L : filter E) : + has_fderiv_at_filter (λ x, c) (0 : E →L[𝕜] F) x L := +(is_o_zero _ _).congr_left $ λ _, by simp only [zero_apply, sub_self] + +theorem has_fderiv_within_at_const (c : F) (x : E) (s : set E) : + has_fderiv_within_at (λ x, c) (0 : E →L[𝕜] F) s x := +has_fderiv_at_filter_const _ _ _ + +theorem has_fderiv_at_const (c : F) (x : E) : + has_fderiv_at (λ x, c) (0 : E →L[𝕜] F) x := +has_fderiv_at_filter_const _ _ _ + +@[simp] lemma differentiable_at_const (c : F) : differentiable_at 𝕜 (λx, c) x := +⟨0, has_fderiv_at_const c x⟩ + +lemma differentiable_within_at_const (c : F) : differentiable_within_at 𝕜 (λx, c) s x := +differentiable_at.differentiable_within_at (differentiable_at_const _) + +lemma fderiv_const_apply (c : F) : fderiv 𝕜 (λy, c) x = 0 := +has_fderiv_at.fderiv (has_fderiv_at_const c x) + +@[simp] lemma fderiv_const (c : F) : fderiv 𝕜 (λ (y : E), c) = 0 := +by { ext m, rw fderiv_const_apply, refl } + +lemma fderiv_within_const_apply (c : F) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λy, c) s x = 0 := +begin + rw differentiable_at.fderiv_within (differentiable_at_const _) hxs, + exact fderiv_const_apply _ +end + +@[simp] lemma differentiable_const (c : F) : differentiable 𝕜 (λx : E, c) := +λx, differentiable_at_const _ + +lemma differentiable_on_const (c : F) : differentiable_on 𝕜 (λx, c) s := +(differentiable_const _).differentiable_on + +lemma has_fderiv_within_at_singleton (f : E → F) (x : E) : + has_fderiv_within_at f (0 : E →L[𝕜] F) {x} x := +by simp only [has_fderiv_within_at, nhds_within_singleton, has_fderiv_at_filter, is_o_pure, + continuous_linear_map.zero_apply, sub_self] + +lemma has_fderiv_at_of_subsingleton [h : subsingleton E] (f : E → F) (x : E) : + has_fderiv_at f (0 : E →L[𝕜] F) x := +begin + rw [← has_fderiv_within_at_univ, subsingleton_univ.eq_singleton_of_mem (mem_univ x)], + exact has_fderiv_within_at_singleton f x +end + +lemma differentiable_on_empty : differentiable_on 𝕜 f ∅ := λ x, false.elim + +lemma differentiable_on_singleton : differentiable_on 𝕜 f {x} := +forall_eq.2 (has_fderiv_within_at_singleton f x).differentiable_within_at + +lemma set.subsingleton.differentiable_on (hs : s.subsingleton) : differentiable_on 𝕜 f s := +hs.induction_on differentiable_on_empty (λ x, differentiable_on_singleton) + +lemma has_fderiv_at_zero_of_eventually_const + (c : F) (hf : f =ᶠ[𝓝 x] (λ y, c)) : + has_fderiv_at f (0 : E →L[𝕜] F) x := +(has_fderiv_at_const _ _).congr_of_eventually_eq hf + +end const + +end + +/-! ### Support of derivatives -/ + +section support + +open function +variables (𝕜 : Type*) {E F : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E] + [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F] {f : E → F} + +lemma support_fderiv_subset : support (fderiv 𝕜 f) ⊆ tsupport f := +begin + intros x, + rw [← not_imp_not, not_mem_tsupport_iff_eventually_eq, nmem_support], + exact λ hx, (hx.fderiv_eq.trans $ fderiv_const_apply 0), +end + +lemma tsupport_fderiv_subset : tsupport (fderiv 𝕜 f) ⊆ tsupport f := +closure_minimal (support_fderiv_subset 𝕜) is_closed_closure + +lemma has_compact_support.fderiv (hf : has_compact_support f) : has_compact_support (fderiv 𝕜 f) := +hf.mono' $ support_fderiv_subset 𝕜 + +end support diff --git a/src/analysis/calculus/fderiv/bilinear.lean b/src/analysis/calculus/fderiv/bilinear.lean new file mode 100644 index 0000000000000..2ce933af25aee --- /dev/null +++ b/src/analysis/calculus/fderiv/bilinear.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.prod + +/-! +# The derivative of bounded bilinear maps + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of +bounded bilinear maps. +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +section bilinear_map +/-! ### Derivative of a bounded bilinear map -/ + +variables {b : E × F → G} {u : set (E × F)} + +open normed_field + +lemma is_bounded_bilinear_map.has_strict_fderiv_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : + has_strict_fderiv_at b (h.deriv p) p := +begin + rw has_strict_fderiv_at, + set T := (E × F) × (E × F), + have : (λ q : T, b (q.1 - q.2)) =o[𝓝 (p, p)] (λ q : T, ‖q.1 - q.2‖ * 1), + { refine (h.is_O'.comp_tendsto le_top).trans_is_o _, + simp only [(∘)], + refine (is_O_refl (λ q : T, ‖q.1 - q.2‖) _).mul_is_o (is_o.norm_left $ (is_o_one_iff _).2 _), + rw [← sub_self p], + exact continuous_at_fst.sub continuous_at_snd }, + simp only [mul_one, is_o_norm_right] at this, + refine (is_o.congr_of_sub _).1 this, clear this, + convert_to (λ q : T, h.deriv (p - q.2) (q.1 - q.2)) =o[𝓝 (p, p)] (λ q : T, q.1 - q.2), + { ext ⟨⟨x₁, y₁⟩, ⟨x₂, y₂⟩⟩, rcases p with ⟨x, y⟩, + simp only [is_bounded_bilinear_map_deriv_coe, prod.mk_sub_mk, h.map_sub_left, h.map_sub_right], + abel }, + have : (λ q : T, p - q.2) =o[𝓝 (p, p)] (λ q, (1:ℝ)), + from (is_o_one_iff _).2 (sub_self p ▸ tendsto_const_nhds.sub continuous_at_snd), + apply is_bounded_bilinear_map_apply.is_O_comp.trans_is_o, + refine is_o.trans_is_O _ (is_O_const_mul_self 1 _ _).of_norm_right, + refine is_o.mul_is_O _ (is_O_refl _ _), + exact (((h.is_bounded_linear_map_deriv.is_O_id ⊤).comp_tendsto le_top : _).trans_is_o + this).norm_left +end + +lemma is_bounded_bilinear_map.has_fderiv_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : + has_fderiv_at b (h.deriv p) p := +(h.has_strict_fderiv_at p).has_fderiv_at + +lemma is_bounded_bilinear_map.has_fderiv_within_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : + has_fderiv_within_at b (h.deriv p) u p := +(h.has_fderiv_at p).has_fderiv_within_at + +lemma is_bounded_bilinear_map.differentiable_at (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : + differentiable_at 𝕜 b p := +(h.has_fderiv_at p).differentiable_at + +lemma is_bounded_bilinear_map.differentiable_within_at (h : is_bounded_bilinear_map 𝕜 b) + (p : E × F) : + differentiable_within_at 𝕜 b u p := +(h.differentiable_at p).differentiable_within_at + +lemma is_bounded_bilinear_map.fderiv (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) : + fderiv 𝕜 b p = h.deriv p := +has_fderiv_at.fderiv (h.has_fderiv_at p) + +lemma is_bounded_bilinear_map.fderiv_within (h : is_bounded_bilinear_map 𝕜 b) (p : E × F) + (hxs : unique_diff_within_at 𝕜 u p) : fderiv_within 𝕜 b u p = h.deriv p := +begin + rw differentiable_at.fderiv_within (h.differentiable_at p) hxs, + exact h.fderiv p +end + +lemma is_bounded_bilinear_map.differentiable (h : is_bounded_bilinear_map 𝕜 b) : + differentiable 𝕜 b := +λx, h.differentiable_at x + +lemma is_bounded_bilinear_map.differentiable_on (h : is_bounded_bilinear_map 𝕜 b) : + differentiable_on 𝕜 b u := +h.differentiable.differentiable_on + +variable (B : E →L[𝕜] F →L[𝕜] G) + +lemma continuous_linear_map.has_fderiv_within_at_of_bilinear + {f : G' → E} {g : G' → F} {f' : G' →L[𝕜] E} {g' : G' →L[𝕜] F} {x : G'} {s : set G'} + (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at g g' s x) : + has_fderiv_within_at (λ y, B (f y) (g y)) (B.precompR G' (f x) g' + B.precompL G' f' (g x)) s x := +(B.is_bounded_bilinear_map.has_fderiv_at (f x, g x)).comp_has_fderiv_within_at x (hf.prod hg) + +lemma continuous_linear_map.has_fderiv_at_of_bilinear + {f : G' → E} {g : G' → F} {f' : G' →L[𝕜] E} {g' : G' →L[𝕜] F} {x : G'} + (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) : + has_fderiv_at (λ y, B (f y) (g y)) (B.precompR G' (f x) g' + B.precompL G' f' (g x)) x := +(B.is_bounded_bilinear_map.has_fderiv_at (f x, g x)).comp x (hf.prod hg) + +lemma continuous_linear_map.fderiv_within_of_bilinear + {f : G' → E} {g : G' → F} {x : G'} {s : set G'} + (hf : differentiable_within_at 𝕜 f s x) (hg : differentiable_within_at 𝕜 g s x) + (hs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λ y, B (f y) (g y)) s x = + (B.precompR G' (f x) (fderiv_within 𝕜 g s x) + B.precompL G' (fderiv_within 𝕜 f s x) (g x)) := +(B.has_fderiv_within_at_of_bilinear hf.has_fderiv_within_at hg.has_fderiv_within_at).fderiv_within + hs + +lemma continuous_linear_map.fderiv_of_bilinear {f : G' → E} {g : G' → F} {x : G'} + (hf : differentiable_at 𝕜 f x) (hg : differentiable_at 𝕜 g x) : + fderiv 𝕜 (λ y, B (f y) (g y)) x = + (B.precompR G' (f x) (fderiv 𝕜 g x) + B.precompL G' (fderiv 𝕜 f x) (g x)) := +(B.has_fderiv_at_of_bilinear hf.has_fderiv_at hg.has_fderiv_at).fderiv + +end bilinear_map + +end diff --git a/src/analysis/calculus/fderiv/comp.lean b/src/analysis/calculus/fderiv/comp.lean new file mode 100644 index 0000000000000..4efc624e08dee --- /dev/null +++ b/src/analysis/calculus/fderiv/comp.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.basic + +/-! +# The derivative of a composition (chain rule) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of +composition of functions (the chain rule). +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + + +section composition +/-! +### Derivative of the composition of two functions + +For composition lemmas, we put x explicit to help the elaborator, as otherwise Lean tends to +get confused since there are too many possibilities for composition -/ + +variable (x) + +theorem has_fderiv_at_filter.comp {g : F → G} {g' : F →L[𝕜] G} {L' : filter F} + (hg : has_fderiv_at_filter g g' (f x) L') + (hf : has_fderiv_at_filter f f' x L) (hL : tendsto f L L') : + has_fderiv_at_filter (g ∘ f) (g'.comp f') x L := +let eq₁ := (g'.is_O_comp _ _).trans_is_o hf in +let eq₂ := (hg.comp_tendsto hL).trans_is_O hf.is_O_sub in +by { refine eq₂.triangle (eq₁.congr_left (λ x', _)), simp } + +/- A readable version of the previous theorem, + a general form of the chain rule. -/ + +example {g : F → G} {g' : F →L[𝕜] G} + (hg : has_fderiv_at_filter g g' (f x) (L.map f)) + (hf : has_fderiv_at_filter f f' x L) : + has_fderiv_at_filter (g ∘ f) (g'.comp f') x L := +begin + unfold has_fderiv_at_filter at hg, + have := calc (λ x', g (f x') - g (f x) - g' (f x' - f x)) =o[L] (λ x', f x' - f x) : + hg.comp_tendsto le_rfl + ... =O[L] (λ x', x' - x) : hf.is_O_sub, + refine this.triangle _, + calc (λ x' : E, g' (f x' - f x) - g'.comp f' (x' - x)) + =ᶠ[L] λ x', g' (f x' - f x - f' (x' - x)) : eventually_of_forall (λ x', by simp) + ... =O[L] λ x', f x' - f x - f' (x' - x) : g'.is_O_comp _ _ + ... =o[L] λ x', x' - x : hf +end + +theorem has_fderiv_within_at.comp {g : F → G} {g' : F →L[𝕜] G} {t : set F} + (hg : has_fderiv_within_at g g' t (f x)) (hf : has_fderiv_within_at f f' s x) + (hst : maps_to f s t) : + has_fderiv_within_at (g ∘ f) (g'.comp f') s x := +hg.comp x hf $ hf.continuous_within_at.tendsto_nhds_within hst + +theorem has_fderiv_at.comp_has_fderiv_within_at {g : F → G} {g' : F →L[𝕜] G} + (hg : has_fderiv_at g g' (f x)) (hf : has_fderiv_within_at f f' s x) : + has_fderiv_within_at (g ∘ f) (g'.comp f') s x := +hg.comp x hf hf.continuous_within_at + +theorem has_fderiv_within_at.comp_of_mem {g : F → G} {g' : F →L[𝕜] G} {t : set F} + (hg : has_fderiv_within_at g g' t (f x)) (hf : has_fderiv_within_at f f' s x) + (hst : tendsto f (𝓝[s] x) (𝓝[t] f x)) : + has_fderiv_within_at (g ∘ f) (g'.comp f') s x := +has_fderiv_at_filter.comp x hg hf hst + +/-- The chain rule. -/ +theorem has_fderiv_at.comp {g : F → G} {g' : F →L[𝕜] G} + (hg : has_fderiv_at g g' (f x)) (hf : has_fderiv_at f f' x) : + has_fderiv_at (g ∘ f) (g'.comp f') x := +hg.comp x hf hf.continuous_at + +lemma differentiable_within_at.comp {g : F → G} {t : set F} + (hg : differentiable_within_at 𝕜 g t (f x)) (hf : differentiable_within_at 𝕜 f s x) + (h : maps_to f s t) : differentiable_within_at 𝕜 (g ∘ f) s x := +(hg.has_fderiv_within_at.comp x hf.has_fderiv_within_at h).differentiable_within_at + +lemma differentiable_within_at.comp' {g : F → G} {t : set F} + (hg : differentiable_within_at 𝕜 g t (f x)) (hf : differentiable_within_at 𝕜 f s x) : + differentiable_within_at 𝕜 (g ∘ f) (s ∩ f⁻¹' t) x := +hg.comp x (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _) + +lemma differentiable_at.comp {g : F → G} + (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_at 𝕜 f x) : + differentiable_at 𝕜 (g ∘ f) x := +(hg.has_fderiv_at.comp x hf.has_fderiv_at).differentiable_at + +lemma differentiable_at.comp_differentiable_within_at {g : F → G} + (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_within_at 𝕜 f s x) : + differentiable_within_at 𝕜 (g ∘ f) s x := +hg.differentiable_within_at.comp x hf (maps_to_univ _ _) + +lemma fderiv_within.comp {g : F → G} {t : set F} + (hg : differentiable_within_at 𝕜 g t (f x)) (hf : differentiable_within_at 𝕜 f s x) + (h : maps_to f s t) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (g ∘ f) s x = (fderiv_within 𝕜 g t (f x)).comp (fderiv_within 𝕜 f s x) := +(hg.has_fderiv_within_at.comp x (hf.has_fderiv_within_at) h).fderiv_within hxs + +/-- A version of `fderiv_within.comp` that is useful to rewrite the composition of two derivatives + into a single derivative. This version always applies, but creates a new side-goal `f x = y`. -/ +lemma fderiv_within_fderiv_within {g : F → G} {f : E → F} {x : E} {y : F} {s : set E} {t : set F} + (hg : differentiable_within_at 𝕜 g t y) (hf : differentiable_within_at 𝕜 f s x) + (h : maps_to f s t) (hxs : unique_diff_within_at 𝕜 s x) (hy : f x = y) (v : E) : + fderiv_within 𝕜 g t y (fderiv_within 𝕜 f s x v) = fderiv_within 𝕜 (g ∘ f) s x v := +by { subst y, rw [fderiv_within.comp x hg hf h hxs], refl } + +/-- Ternary version of `fderiv_within.comp`, with equality assumptions of basepoints added, in + order to apply more easily as a rewrite from right-to-left. -/ +lemma fderiv_within.comp₃ {g' : G → G'} {g : F → G} {t : set F} {u : set G} {y : F} {y' : G} + (hg' : differentiable_within_at 𝕜 g' u y') (hg : differentiable_within_at 𝕜 g t y) + (hf : differentiable_within_at 𝕜 f s x) + (h2g : maps_to g t u) (h2f : maps_to f s t) + (h3g : g y = y') (h3f : f x = y) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (g' ∘ g ∘ f) s x = (fderiv_within 𝕜 g' u y').comp + ((fderiv_within 𝕜 g t y).comp (fderiv_within 𝕜 f s x)) := +begin + substs h3g h3f, + exact (hg'.has_fderiv_within_at.comp x + (hg.has_fderiv_within_at.comp x (hf.has_fderiv_within_at) h2f) $ h2g.comp h2f).fderiv_within hxs +end + +lemma fderiv.comp {g : F → G} + (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_at 𝕜 f x) : + fderiv 𝕜 (g ∘ f) x = (fderiv 𝕜 g (f x)).comp (fderiv 𝕜 f x) := +(hg.has_fderiv_at.comp x hf.has_fderiv_at).fderiv + +lemma fderiv.comp_fderiv_within {g : F → G} + (hg : differentiable_at 𝕜 g (f x)) (hf : differentiable_within_at 𝕜 f s x) + (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (g ∘ f) s x = (fderiv 𝕜 g (f x)).comp (fderiv_within 𝕜 f s x) := +(hg.has_fderiv_at.comp_has_fderiv_within_at x hf.has_fderiv_within_at).fderiv_within hxs + +lemma differentiable_on.comp {g : F → G} {t : set F} + (hg : differentiable_on 𝕜 g t) (hf : differentiable_on 𝕜 f s) (st : maps_to f s t) : + differentiable_on 𝕜 (g ∘ f) s := +λx hx, differentiable_within_at.comp x (hg (f x) (st hx)) (hf x hx) st + +lemma differentiable.comp {g : F → G} (hg : differentiable 𝕜 g) (hf : differentiable 𝕜 f) : + differentiable 𝕜 (g ∘ f) := +λx, differentiable_at.comp x (hg (f x)) (hf x) + +lemma differentiable.comp_differentiable_on {g : F → G} (hg : differentiable 𝕜 g) + (hf : differentiable_on 𝕜 f s) : + differentiable_on 𝕜 (g ∘ f) s := +hg.differentiable_on.comp hf (maps_to_univ _ _) + +/-- The chain rule for derivatives in the sense of strict differentiability. -/ +protected lemma has_strict_fderiv_at.comp {g : F → G} {g' : F →L[𝕜] G} + (hg : has_strict_fderiv_at g g' (f x)) (hf : has_strict_fderiv_at f f' x) : + has_strict_fderiv_at (λ x, g (f x)) (g'.comp f') x := +((hg.comp_tendsto (hf.continuous_at.prod_map' hf.continuous_at)).trans_is_O hf.is_O_sub).triangle $ + by simpa only [g'.map_sub, f'.coe_comp'] using (g'.is_O_comp _ _).trans_is_o hf + +protected lemma differentiable.iterate {f : E → E} (hf : differentiable 𝕜 f) (n : ℕ) : + differentiable 𝕜 (f^[n]) := +nat.rec_on n differentiable_id (λ n ihn, ihn.comp hf) + +protected lemma differentiable_on.iterate {f : E → E} (hf : differentiable_on 𝕜 f s) + (hs : maps_to f s s) (n : ℕ) : + differentiable_on 𝕜 (f^[n]) s := +nat.rec_on n differentiable_on_id (λ n ihn, ihn.comp hf hs) + +variable {x} + +protected lemma has_fderiv_at_filter.iterate {f : E → E} {f' : E →L[𝕜] E} + (hf : has_fderiv_at_filter f f' x L) (hL : tendsto f L L) (hx : f x = x) (n : ℕ) : + has_fderiv_at_filter (f^[n]) (f'^n) x L := +begin + induction n with n ihn, + { exact has_fderiv_at_filter_id x L }, + { rw [function.iterate_succ, pow_succ'], + rw ← hx at ihn, + exact ihn.comp x hf hL } +end + +protected lemma has_fderiv_at.iterate {f : E → E} {f' : E →L[𝕜] E} + (hf : has_fderiv_at f f' x) (hx : f x = x) (n : ℕ) : + has_fderiv_at (f^[n]) (f'^n) x := +begin + refine hf.iterate _ hx n, + convert hf.continuous_at, + exact hx.symm +end + +protected lemma has_fderiv_within_at.iterate {f : E → E} {f' : E →L[𝕜] E} + (hf : has_fderiv_within_at f f' s x) (hx : f x = x) (hs : maps_to f s s) (n : ℕ) : + has_fderiv_within_at (f^[n]) (f'^n) s x := +begin + refine hf.iterate _ hx n, + convert tendsto_inf.2 ⟨hf.continuous_within_at, _⟩, + exacts [hx.symm, (tendsto_principal_principal.2 hs).mono_left inf_le_right] +end + +protected lemma has_strict_fderiv_at.iterate {f : E → E} {f' : E →L[𝕜] E} + (hf : has_strict_fderiv_at f f' x) (hx : f x = x) (n : ℕ) : + has_strict_fderiv_at (f^[n]) (f'^n) x := +begin + induction n with n ihn, + { exact has_strict_fderiv_at_id x }, + { rw [function.iterate_succ, pow_succ'], + rw ← hx at ihn, + exact ihn.comp x hf } +end + +protected lemma differentiable_at.iterate {f : E → E} (hf : differentiable_at 𝕜 f x) + (hx : f x = x) (n : ℕ) : + differentiable_at 𝕜 (f^[n]) x := +(hf.has_fderiv_at.iterate hx n).differentiable_at + +protected lemma differentiable_within_at.iterate {f : E → E} (hf : differentiable_within_at 𝕜 f s x) + (hx : f x = x) (hs : maps_to f s s) (n : ℕ) : + differentiable_within_at 𝕜 (f^[n]) s x := +(hf.has_fderiv_within_at.iterate hx hs n).differentiable_within_at + +end composition + +end diff --git a/src/analysis/calculus/fderiv/equiv.lean b/src/analysis/calculus/fderiv/equiv.lean new file mode 100644 index 0000000000000..b3fdd1441a863 --- /dev/null +++ b/src/analysis/calculus/fderiv/equiv.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.linear +import analysis.calculus.fderiv.comp + +/-! +# The derivative of a linear equivalence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of +continuous linear equivalences. +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +namespace continuous_linear_equiv +/-! ### Differentiability of linear equivs, and invariance of differentiability -/ + +variable (iso : E ≃L[𝕜] F) + +protected lemma has_strict_fderiv_at : + has_strict_fderiv_at iso (iso : E →L[𝕜] F) x := +iso.to_continuous_linear_map.has_strict_fderiv_at + +protected lemma has_fderiv_within_at : + has_fderiv_within_at iso (iso : E →L[𝕜] F) s x := +iso.to_continuous_linear_map.has_fderiv_within_at + +protected lemma has_fderiv_at : has_fderiv_at iso (iso : E →L[𝕜] F) x := +iso.to_continuous_linear_map.has_fderiv_at_filter + +protected lemma differentiable_at : differentiable_at 𝕜 iso x := +iso.has_fderiv_at.differentiable_at + +protected lemma differentiable_within_at : + differentiable_within_at 𝕜 iso s x := +iso.differentiable_at.differentiable_within_at + +protected lemma fderiv : fderiv 𝕜 iso x = iso := +iso.has_fderiv_at.fderiv + +protected lemma fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 iso s x = iso := +iso.to_continuous_linear_map.fderiv_within hxs + +protected lemma differentiable : differentiable 𝕜 iso := +λx, iso.differentiable_at + +protected lemma differentiable_on : differentiable_on 𝕜 iso s := +iso.differentiable.differentiable_on + +lemma comp_differentiable_within_at_iff {f : G → E} {s : set G} {x : G} : + differentiable_within_at 𝕜 (iso ∘ f) s x ↔ differentiable_within_at 𝕜 f s x := +begin + refine ⟨λ H, _, λ H, iso.differentiable.differentiable_at.comp_differentiable_within_at x H⟩, + have : differentiable_within_at 𝕜 (iso.symm ∘ (iso ∘ f)) s x := + iso.symm.differentiable.differentiable_at.comp_differentiable_within_at x H, + rwa [← function.comp.assoc iso.symm iso f, iso.symm_comp_self] at this, +end + +lemma comp_differentiable_at_iff {f : G → E} {x : G} : + differentiable_at 𝕜 (iso ∘ f) x ↔ differentiable_at 𝕜 f x := +by rw [← differentiable_within_at_univ, ← differentiable_within_at_univ, + iso.comp_differentiable_within_at_iff] + +lemma comp_differentiable_on_iff {f : G → E} {s : set G} : + differentiable_on 𝕜 (iso ∘ f) s ↔ differentiable_on 𝕜 f s := +begin + rw [differentiable_on, differentiable_on], + simp only [iso.comp_differentiable_within_at_iff], +end + +lemma comp_differentiable_iff {f : G → E} : + differentiable 𝕜 (iso ∘ f) ↔ differentiable 𝕜 f := +begin + rw [← differentiable_on_univ, ← differentiable_on_univ], + exact iso.comp_differentiable_on_iff +end + +lemma comp_has_fderiv_within_at_iff + {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] E} : + has_fderiv_within_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') s x ↔ has_fderiv_within_at f f' s x := +begin + refine ⟨λ H, _, λ H, iso.has_fderiv_at.comp_has_fderiv_within_at x H⟩, + have A : f = iso.symm ∘ (iso ∘ f), by { rw [← function.comp.assoc, iso.symm_comp_self], refl }, + have B : f' = (iso.symm : F →L[𝕜] E).comp ((iso : E →L[𝕜] F).comp f'), + by rw [← continuous_linear_map.comp_assoc, iso.coe_symm_comp_coe, + continuous_linear_map.id_comp], + rw [A, B], + exact iso.symm.has_fderiv_at.comp_has_fderiv_within_at x H +end + +lemma comp_has_strict_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : + has_strict_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_strict_fderiv_at f f' x := +begin + refine ⟨λ H, _, λ H, iso.has_strict_fderiv_at.comp x H⟩, + convert iso.symm.has_strict_fderiv_at.comp x H; ext z; apply (iso.symm_apply_apply _).symm +end + +lemma comp_has_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : + has_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_fderiv_at f f' x := +by simp_rw [← has_fderiv_within_at_univ, iso.comp_has_fderiv_within_at_iff] + +lemma comp_has_fderiv_within_at_iff' + {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] F} : + has_fderiv_within_at (iso ∘ f) f' s x ↔ + has_fderiv_within_at f ((iso.symm : F →L[𝕜] E).comp f') s x := +by rw [← iso.comp_has_fderiv_within_at_iff, ← continuous_linear_map.comp_assoc, + iso.coe_comp_coe_symm, continuous_linear_map.id_comp] + +lemma comp_has_fderiv_at_iff' {f : G → E} {x : G} {f' : G →L[𝕜] F} : + has_fderiv_at (iso ∘ f) f' x ↔ has_fderiv_at f ((iso.symm : F →L[𝕜] E).comp f') x := +by simp_rw [← has_fderiv_within_at_univ, iso.comp_has_fderiv_within_at_iff'] + +lemma comp_fderiv_within {f : G → E} {s : set G} {x : G} + (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (iso ∘ f) s x = (iso : E →L[𝕜] F).comp (fderiv_within 𝕜 f s x) := +begin + by_cases h : differentiable_within_at 𝕜 f s x, + { rw [fderiv.comp_fderiv_within x iso.differentiable_at h hxs, iso.fderiv] }, + { have : ¬differentiable_within_at 𝕜 (iso ∘ f) s x, + from mt iso.comp_differentiable_within_at_iff.1 h, + rw [fderiv_within_zero_of_not_differentiable_within_at h, + fderiv_within_zero_of_not_differentiable_within_at this, + continuous_linear_map.comp_zero] } +end + +lemma comp_fderiv {f : G → E} {x : G} : + fderiv 𝕜 (iso ∘ f) x = (iso : E →L[𝕜] F).comp (fderiv 𝕜 f x) := +begin + rw [← fderiv_within_univ, ← fderiv_within_univ], + exact iso.comp_fderiv_within unique_diff_within_at_univ, +end + +lemma comp_right_differentiable_within_at_iff {f : F → G} {s : set F} {x : E} : + differentiable_within_at 𝕜 (f ∘ iso) (iso ⁻¹' s) x ↔ differentiable_within_at 𝕜 f s (iso x) := +begin + refine ⟨λ H, _, λ H, H.comp x iso.differentiable_within_at (maps_to_preimage _ s)⟩, + have : differentiable_within_at 𝕜 ((f ∘ iso) ∘ iso.symm) s (iso x), + { rw ← iso.symm_apply_apply x at H, + apply H.comp (iso x) iso.symm.differentiable_within_at, + assume y hy, + simpa only [mem_preimage, apply_symm_apply] using hy }, + rwa [function.comp.assoc, iso.self_comp_symm] at this, +end + +lemma comp_right_differentiable_at_iff {f : F → G} {x : E} : + differentiable_at 𝕜 (f ∘ iso) x ↔ differentiable_at 𝕜 f (iso x) := +by simp only [← differentiable_within_at_univ, ← iso.comp_right_differentiable_within_at_iff, + preimage_univ] + +lemma comp_right_differentiable_on_iff {f : F → G} {s : set F} : + differentiable_on 𝕜 (f ∘ iso) (iso ⁻¹' s) ↔ differentiable_on 𝕜 f s := +begin + refine ⟨λ H y hy, _, λ H y hy, iso.comp_right_differentiable_within_at_iff.2 (H _ hy)⟩, + rw [← iso.apply_symm_apply y, ← comp_right_differentiable_within_at_iff], + apply H, + simpa only [mem_preimage, apply_symm_apply] using hy, +end + +lemma comp_right_differentiable_iff {f : F → G} : + differentiable 𝕜 (f ∘ iso) ↔ differentiable 𝕜 f := +by simp only [← differentiable_on_univ, ← iso.comp_right_differentiable_on_iff, preimage_univ] + +lemma comp_right_has_fderiv_within_at_iff + {f : F → G} {s : set F} {x : E} {f' : F →L[𝕜] G} : + has_fderiv_within_at (f ∘ iso) (f'.comp (iso : E →L[𝕜] F)) (iso ⁻¹' s) x ↔ + has_fderiv_within_at f f' s (iso x) := +begin + refine ⟨λ H, _, λ H, H.comp x iso.has_fderiv_within_at (maps_to_preimage _ s)⟩, + rw [← iso.symm_apply_apply x] at H, + have A : f = (f ∘ iso) ∘ iso.symm, by { rw [function.comp.assoc, iso.self_comp_symm], refl }, + have B : f' = (f'.comp (iso : E →L[𝕜] F)).comp (iso.symm : F →L[𝕜] E), + by rw [continuous_linear_map.comp_assoc, iso.coe_comp_coe_symm, + continuous_linear_map.comp_id], + rw [A, B], + apply H.comp (iso x) iso.symm.has_fderiv_within_at, + assume y hy, + simpa only [mem_preimage, apply_symm_apply] using hy +end + +lemma comp_right_has_fderiv_at_iff {f : F → G} {x : E} {f' : F →L[𝕜] G} : + has_fderiv_at (f ∘ iso) (f'.comp (iso : E →L[𝕜] F)) x ↔ has_fderiv_at f f' (iso x) := +by simp only [← has_fderiv_within_at_univ, ← comp_right_has_fderiv_within_at_iff, preimage_univ] + +lemma comp_right_has_fderiv_within_at_iff' + {f : F → G} {s : set F} {x : E} {f' : E →L[𝕜] G} : + has_fderiv_within_at (f ∘ iso) f' (iso ⁻¹' s) x ↔ + has_fderiv_within_at f (f'.comp (iso.symm : F →L[𝕜] E)) s (iso x) := +by rw [← iso.comp_right_has_fderiv_within_at_iff, continuous_linear_map.comp_assoc, + iso.coe_symm_comp_coe, continuous_linear_map.comp_id] + +lemma comp_right_has_fderiv_at_iff' {f : F → G} {x : E} {f' : E →L[𝕜] G} : + has_fderiv_at (f ∘ iso) f' x ↔ has_fderiv_at f (f'.comp (iso.symm : F →L[𝕜] E)) (iso x) := +by simp only [← has_fderiv_within_at_univ, ← iso.comp_right_has_fderiv_within_at_iff', + preimage_univ] + +lemma comp_right_fderiv_within {f : F → G} {s : set F} {x : E} + (hxs : unique_diff_within_at 𝕜 (iso ⁻¹' s) x) : + fderiv_within 𝕜 (f ∘ iso) (iso ⁻¹'s) x = (fderiv_within 𝕜 f s (iso x)).comp (iso : E →L[𝕜] F) := +begin + by_cases h : differentiable_within_at 𝕜 f s (iso x), + { exact (iso.comp_right_has_fderiv_within_at_iff.2 (h.has_fderiv_within_at)).fderiv_within hxs }, + { have : ¬ differentiable_within_at 𝕜 (f ∘ iso) (iso ⁻¹' s) x, + { assume h', exact h (iso.comp_right_differentiable_within_at_iff.1 h') }, + rw [fderiv_within_zero_of_not_differentiable_within_at h, + fderiv_within_zero_of_not_differentiable_within_at this, continuous_linear_map.zero_comp] } +end + +lemma comp_right_fderiv {f : F → G} {x : E} : + fderiv 𝕜 (f ∘ iso) x = (fderiv 𝕜 f (iso x)).comp (iso : E →L[𝕜] F) := +begin + rw [← fderiv_within_univ, ← fderiv_within_univ, ← iso.comp_right_fderiv_within, preimage_univ], + exact unique_diff_within_at_univ, +end + +end continuous_linear_equiv + +namespace linear_isometry_equiv +/-! ### Differentiability of linear isometry equivs, and invariance of differentiability -/ + +variable (iso : E ≃ₗᵢ[𝕜] F) + +protected lemma has_strict_fderiv_at : has_strict_fderiv_at iso (iso : E →L[𝕜] F) x := +(iso : E ≃L[𝕜] F).has_strict_fderiv_at + +protected lemma has_fderiv_within_at : has_fderiv_within_at iso (iso : E →L[𝕜] F) s x := +(iso : E ≃L[𝕜] F).has_fderiv_within_at + +protected lemma has_fderiv_at : has_fderiv_at iso (iso : E →L[𝕜] F) x := +(iso : E ≃L[𝕜] F).has_fderiv_at + +protected lemma differentiable_at : differentiable_at 𝕜 iso x := +iso.has_fderiv_at.differentiable_at + +protected lemma differentiable_within_at : + differentiable_within_at 𝕜 iso s x := +iso.differentiable_at.differentiable_within_at + +protected lemma fderiv : fderiv 𝕜 iso x = iso := iso.has_fderiv_at.fderiv + +protected lemma fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 iso s x = iso := +(iso : E ≃L[𝕜] F).fderiv_within hxs + +protected lemma differentiable : differentiable 𝕜 iso := +λx, iso.differentiable_at + +protected lemma differentiable_on : differentiable_on 𝕜 iso s := +iso.differentiable.differentiable_on + +lemma comp_differentiable_within_at_iff {f : G → E} {s : set G} {x : G} : + differentiable_within_at 𝕜 (iso ∘ f) s x ↔ differentiable_within_at 𝕜 f s x := +(iso : E ≃L[𝕜] F).comp_differentiable_within_at_iff + +lemma comp_differentiable_at_iff {f : G → E} {x : G} : + differentiable_at 𝕜 (iso ∘ f) x ↔ differentiable_at 𝕜 f x := +(iso : E ≃L[𝕜] F).comp_differentiable_at_iff + +lemma comp_differentiable_on_iff {f : G → E} {s : set G} : + differentiable_on 𝕜 (iso ∘ f) s ↔ differentiable_on 𝕜 f s := +(iso : E ≃L[𝕜] F).comp_differentiable_on_iff + +lemma comp_differentiable_iff {f : G → E} : + differentiable 𝕜 (iso ∘ f) ↔ differentiable 𝕜 f := +(iso : E ≃L[𝕜] F).comp_differentiable_iff + +lemma comp_has_fderiv_within_at_iff + {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] E} : + has_fderiv_within_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') s x ↔ has_fderiv_within_at f f' s x := +(iso : E ≃L[𝕜] F).comp_has_fderiv_within_at_iff + +lemma comp_has_strict_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : + has_strict_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_strict_fderiv_at f f' x := +(iso : E ≃L[𝕜] F).comp_has_strict_fderiv_at_iff + +lemma comp_has_fderiv_at_iff {f : G → E} {x : G} {f' : G →L[𝕜] E} : + has_fderiv_at (iso ∘ f) ((iso : E →L[𝕜] F).comp f') x ↔ has_fderiv_at f f' x := +(iso : E ≃L[𝕜] F).comp_has_fderiv_at_iff + +lemma comp_has_fderiv_within_at_iff' + {f : G → E} {s : set G} {x : G} {f' : G →L[𝕜] F} : + has_fderiv_within_at (iso ∘ f) f' s x ↔ + has_fderiv_within_at f ((iso.symm : F →L[𝕜] E).comp f') s x := +(iso : E ≃L[𝕜] F).comp_has_fderiv_within_at_iff' + +lemma comp_has_fderiv_at_iff' {f : G → E} {x : G} {f' : G →L[𝕜] F} : + has_fderiv_at (iso ∘ f) f' x ↔ has_fderiv_at f ((iso.symm : F →L[𝕜] E).comp f') x := +(iso : E ≃L[𝕜] F).comp_has_fderiv_at_iff' + +lemma comp_fderiv_within {f : G → E} {s : set G} {x : G} + (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (iso ∘ f) s x = (iso : E →L[𝕜] F).comp (fderiv_within 𝕜 f s x) := +(iso : E ≃L[𝕜] F).comp_fderiv_within hxs + +lemma comp_fderiv {f : G → E} {x : G} : + fderiv 𝕜 (iso ∘ f) x = (iso : E →L[𝕜] F).comp (fderiv 𝕜 f x) := +(iso : E ≃L[𝕜] F).comp_fderiv + +end linear_isometry_equiv + +/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an +invertible derivative `f'` at `g a` in the strict sense, then `g` has the derivative `f'⁻¹` at `a` +in the strict sense. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have an +inverse function. -/ +theorem has_strict_fderiv_at.of_local_left_inverse {f : E → F} {f' : E ≃L[𝕜] F} {g : F → E} {a : F} + (hg : continuous_at g a) (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) (g a)) + (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : + has_strict_fderiv_at g (f'.symm : F →L[𝕜] E) a := +begin + replace hg := hg.prod_map' hg, + replace hfg := hfg.prod_mk_nhds hfg, + have : (λ p : F × F, g p.1 - g p.2 - f'.symm (p.1 - p.2)) =O[𝓝 (a, a)] + (λ p : F × F, f' (g p.1 - g p.2) - (p.1 - p.2)), + { refine ((f'.symm : F →L[𝕜] E).is_O_comp _ _).congr (λ x, _) (λ _, rfl), + simp }, + refine this.trans_is_o _, clear this, + refine ((hf.comp_tendsto hg).symm.congr' (hfg.mono _) + (eventually_of_forall $ λ _, rfl)).trans_is_O _, + { rintros p ⟨hp1, hp2⟩, + simp [hp1, hp2] }, + { refine (hf.is_O_sub_rev.comp_tendsto hg).congr' + (eventually_of_forall $ λ _, rfl) (hfg.mono _), + rintros p ⟨hp1, hp2⟩, + simp only [(∘), hp1, hp2] } +end + +/-- If `f (g y) = y` for `y` in some neighborhood of `a`, `g` is continuous at `a`, and `f` has an +invertible derivative `f'` at `g a`, then `g` has the derivative `f'⁻¹` at `a`. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +theorem has_fderiv_at.of_local_left_inverse {f : E → F} {f' : E ≃L[𝕜] F} {g : F → E} {a : F} + (hg : continuous_at g a) (hf : has_fderiv_at f (f' : E →L[𝕜] F) (g a)) + (hfg : ∀ᶠ y in 𝓝 a, f (g y) = y) : + has_fderiv_at g (f'.symm : F →L[𝕜] E) a := +begin + have : (λ x : F, g x - g a - f'.symm (x - a)) =O[𝓝 a] (λ x : F, f' (g x - g a) - (x - a)), + { refine ((f'.symm : F →L[𝕜] E).is_O_comp _ _).congr (λ x, _) (λ _, rfl), + simp }, + refine this.trans_is_o _, clear this, + refine ((hf.comp_tendsto hg).symm.congr' (hfg.mono _) + (eventually_of_forall $ λ _, rfl)).trans_is_O _, + { rintros p hp, + simp [hp, hfg.self_of_nhds] }, + { refine ((hf.is_O_sub_rev f'.antilipschitz).comp_tendsto hg).congr' + (eventually_of_forall $ λ _, rfl) (hfg.mono _), + rintros p hp, + simp only [(∘), hp, hfg.self_of_nhds] } +end + +/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has an +invertible derivative `f'` in the sense of strict differentiability at `f.symm a`, then `f.symm` has +the derivative `f'⁻¹` at `a`. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +lemma local_homeomorph.has_strict_fderiv_at_symm (f : local_homeomorph E F) {f' : E ≃L[𝕜] F} {a : F} + (ha : a ∈ f.target) (htff' : has_strict_fderiv_at f (f' : E →L[𝕜] F) (f.symm a)) : + has_strict_fderiv_at f.symm (f'.symm : F →L[𝕜] E) a := +htff'.of_local_left_inverse (f.symm.continuous_at ha) (f.eventually_right_inverse ha) + +/-- If `f` is a local homeomorphism defined on a neighbourhood of `f.symm a`, and `f` has an +invertible derivative `f'` at `f.symm a`, then `f.symm` has the derivative `f'⁻¹` at `a`. + +This is one of the easy parts of the inverse function theorem: it assumes that we already have +an inverse function. -/ +lemma local_homeomorph.has_fderiv_at_symm (f : local_homeomorph E F) {f' : E ≃L[𝕜] F} {a : F} + (ha : a ∈ f.target) (htff' : has_fderiv_at f (f' : E →L[𝕜] F) (f.symm a)) : + has_fderiv_at f.symm (f'.symm : F →L[𝕜] E) a := +htff'.of_local_left_inverse (f.symm.continuous_at ha) (f.eventually_right_inverse ha) + +lemma has_fderiv_within_at.eventually_ne (h : has_fderiv_within_at f f' s x) + (hf' : ∃ C, ∀ z, ‖z‖ ≤ C * ‖f' z‖) : + ∀ᶠ z in 𝓝[s \ {x}] x, f z ≠ f x := +begin + rw [nhds_within, diff_eq, ← inf_principal, ← inf_assoc, eventually_inf_principal], + have A : (λ z, z - x) =O[𝓝[s] x] (λ z, f' (z - x)) := + (is_O_iff.2 $ hf'.imp $ λ C hC, eventually_of_forall $ λ z, hC _), + have : (λ z, f z - f x) ~[𝓝[s] x] (λ z, f' (z - x)) := h.trans_is_O A, + simpa [not_imp_not, sub_eq_zero] using (A.trans this.is_O_symm).eq_zero_imp +end + +lemma has_fderiv_at.eventually_ne (h : has_fderiv_at f f' x) (hf' : ∃ C, ∀ z, ‖z‖ ≤ C * ‖f' z‖) : + ∀ᶠ z in 𝓝[≠] x, f z ≠ f x := +by simpa only [compl_eq_univ_diff] using (has_fderiv_within_at_univ.2 h).eventually_ne hf' + +end + +section +/- + In the special case of a normed space over the reals, + we can use scalar multiplication in the `tendsto` characterization + of the Fréchet derivative. +-/ + + +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] +variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] +variables {f : E → F} {f' : E →L[ℝ] F} {x : E} + +theorem has_fderiv_at_filter_real_equiv {L : filter E} : + tendsto (λ x' : E, ‖x' - x‖⁻¹ * ‖f x' - f x - f' (x' - x)‖) L (𝓝 0) ↔ + tendsto (λ x' : E, ‖x' - x‖⁻¹ • (f x' - f x - f' (x' - x))) L (𝓝 0) := +begin + symmetry, + rw [tendsto_iff_norm_tendsto_zero], refine tendsto_congr (λ x', _), + have : ‖x' - x‖⁻¹ ≥ 0, from inv_nonneg.mpr (norm_nonneg _), + simp [norm_smul, abs_of_nonneg this] +end + +lemma has_fderiv_at.lim_real (hf : has_fderiv_at f f' x) (v : E) : + tendsto (λ (c:ℝ), c • (f (x + c⁻¹ • v) - f x)) at_top (𝓝 (f' v)) := +begin + apply hf.lim v, + rw tendsto_at_top_at_top, + exact λ b, ⟨b, λ a ha, le_trans ha (le_abs_self _)⟩ +end + +end + +section tangent_cone + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +{f : E → F} {s : set E} {f' : E →L[𝕜] F} + +/-- The image of a tangent cone under the differential of a map is included in the tangent cone to +the image. -/ +lemma has_fderiv_within_at.maps_to_tangent_cone {x : E} (h : has_fderiv_within_at f f' s x) : + maps_to f' (tangent_cone_at 𝕜 s x) (tangent_cone_at 𝕜 (f '' s) (f x)) := +begin + rintros v ⟨c, d, dtop, clim, cdlim⟩, + refine ⟨c, (λn, f (x + d n) - f x), mem_of_superset dtop _, clim, + h.lim at_top dtop clim cdlim⟩, + simp [-mem_image, mem_image_of_mem] {contextual := tt} +end + +/-- If a set has the unique differentiability property at a point x, then the image of this set +under a map with onto derivative has also the unique differentiability property at the image point. +-/ +lemma has_fderiv_within_at.unique_diff_within_at {x : E} (h : has_fderiv_within_at f f' s x) + (hs : unique_diff_within_at 𝕜 s x) (h' : dense_range f') : + unique_diff_within_at 𝕜 (f '' s) (f x) := +begin + refine ⟨h'.dense_of_maps_to f'.continuous hs.1 _, + h.continuous_within_at.mem_closure_image hs.2⟩, + show submodule.span 𝕜 (tangent_cone_at 𝕜 s x) ≤ + (submodule.span 𝕜 (tangent_cone_at 𝕜 (f '' s) (f x))).comap f', + rw [submodule.span_le], + exact h.maps_to_tangent_cone.mono (subset.refl _) submodule.subset_span +end + +lemma unique_diff_on.image {f' : E → E →L[𝕜] F} (hs : unique_diff_on 𝕜 s) + (hf' : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (hd : ∀ x ∈ s, dense_range (f' x)) : + unique_diff_on 𝕜 (f '' s) := +ball_image_iff.2 $ λ x hx, (hf' x hx).unique_diff_within_at (hs x hx) (hd x hx) + +lemma has_fderiv_within_at.unique_diff_within_at_of_continuous_linear_equiv + {x : E} (e' : E ≃L[𝕜] F) (h : has_fderiv_within_at f (e' : E →L[𝕜] F) s x) + (hs : unique_diff_within_at 𝕜 s x) : + unique_diff_within_at 𝕜 (f '' s) (f x) := +h.unique_diff_within_at hs e'.surjective.dense_range + +lemma continuous_linear_equiv.unique_diff_on_image (e : E ≃L[𝕜] F) (h : unique_diff_on 𝕜 s) : + unique_diff_on 𝕜 (e '' s) := +h.image (λ x _, e.has_fderiv_within_at) (λ x hx, e.surjective.dense_range) + +@[simp] lemma continuous_linear_equiv.unique_diff_on_image_iff (e : E ≃L[𝕜] F) : + unique_diff_on 𝕜 (e '' s) ↔ unique_diff_on 𝕜 s := +⟨λ h, e.symm_image_image s ▸ e.symm.unique_diff_on_image h, e.unique_diff_on_image⟩ + +@[simp] lemma continuous_linear_equiv.unique_diff_on_preimage_iff (e : F ≃L[𝕜] E) : + unique_diff_on 𝕜 (e ⁻¹' s) ↔ unique_diff_on 𝕜 s := +by rw [← e.image_symm_eq_preimage, e.symm.unique_diff_on_image_iff] + +end tangent_cone diff --git a/src/analysis/calculus/fderiv/linear.lean b/src/analysis/calculus/fderiv/linear.lean new file mode 100644 index 0000000000000..73102958b1d4c --- /dev/null +++ b/src/analysis/calculus/fderiv/linear.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.basic + +/-! +# The derivative of bounded linear maps + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of +bounded linear maps. +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +section continuous_linear_map +/-! +### Continuous linear maps + +There are currently two variants of these in mathlib, the bundled version +(named `continuous_linear_map`, and denoted `E →L[𝕜] F`), and the unbundled version (with a +predicate `is_bounded_linear_map`). We give statements for both versions. -/ + +protected theorem continuous_linear_map.has_strict_fderiv_at {x : E} : + has_strict_fderiv_at e e x := +(is_o_zero _ _).congr_left $ λ x, by simp only [e.map_sub, sub_self] + +protected lemma continuous_linear_map.has_fderiv_at_filter : + has_fderiv_at_filter e e x L := +(is_o_zero _ _).congr_left $ λ x, by simp only [e.map_sub, sub_self] + +protected lemma continuous_linear_map.has_fderiv_within_at : has_fderiv_within_at e e s x := +e.has_fderiv_at_filter + +protected lemma continuous_linear_map.has_fderiv_at : has_fderiv_at e e x := +e.has_fderiv_at_filter + +@[simp] protected lemma continuous_linear_map.differentiable_at : differentiable_at 𝕜 e x := +e.has_fderiv_at.differentiable_at + +protected lemma continuous_linear_map.differentiable_within_at : differentiable_within_at 𝕜 e s x := +e.differentiable_at.differentiable_within_at + +@[simp] protected lemma continuous_linear_map.fderiv : fderiv 𝕜 e x = e := +e.has_fderiv_at.fderiv + +protected lemma continuous_linear_map.fderiv_within (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 e s x = e := +begin + rw differentiable_at.fderiv_within e.differentiable_at hxs, + exact e.fderiv +end + +@[simp] protected lemma continuous_linear_map.differentiable : differentiable 𝕜 e := +λx, e.differentiable_at + +protected lemma continuous_linear_map.differentiable_on : differentiable_on 𝕜 e s := +e.differentiable.differentiable_on + +lemma is_bounded_linear_map.has_fderiv_at_filter (h : is_bounded_linear_map 𝕜 f) : + has_fderiv_at_filter f h.to_continuous_linear_map x L := +h.to_continuous_linear_map.has_fderiv_at_filter + +lemma is_bounded_linear_map.has_fderiv_within_at (h : is_bounded_linear_map 𝕜 f) : + has_fderiv_within_at f h.to_continuous_linear_map s x := +h.has_fderiv_at_filter + +lemma is_bounded_linear_map.has_fderiv_at (h : is_bounded_linear_map 𝕜 f) : + has_fderiv_at f h.to_continuous_linear_map x := +h.has_fderiv_at_filter + +lemma is_bounded_linear_map.differentiable_at (h : is_bounded_linear_map 𝕜 f) : + differentiable_at 𝕜 f x := +h.has_fderiv_at.differentiable_at + +lemma is_bounded_linear_map.differentiable_within_at (h : is_bounded_linear_map 𝕜 f) : + differentiable_within_at 𝕜 f s x := +h.differentiable_at.differentiable_within_at + +lemma is_bounded_linear_map.fderiv (h : is_bounded_linear_map 𝕜 f) : + fderiv 𝕜 f x = h.to_continuous_linear_map := +has_fderiv_at.fderiv (h.has_fderiv_at) + +lemma is_bounded_linear_map.fderiv_within (h : is_bounded_linear_map 𝕜 f) + (hxs : unique_diff_within_at 𝕜 s x) : fderiv_within 𝕜 f s x = h.to_continuous_linear_map := +begin + rw differentiable_at.fderiv_within h.differentiable_at hxs, + exact h.fderiv +end + +lemma is_bounded_linear_map.differentiable (h : is_bounded_linear_map 𝕜 f) : + differentiable 𝕜 f := +λx, h.differentiable_at + +lemma is_bounded_linear_map.differentiable_on (h : is_bounded_linear_map 𝕜 f) : + differentiable_on 𝕜 f s := +h.differentiable.differentiable_on + +end continuous_linear_map + +end diff --git a/src/analysis/calculus/fderiv/mul.lean b/src/analysis/calculus/fderiv/mul.lean new file mode 100644 index 0000000000000..12ccaad983130 --- /dev/null +++ b/src/analysis/calculus/fderiv/mul.lean @@ -0,0 +1,554 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.bilinear + +/-! +# Multiplicative operations on derivatives + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of + +* multiplication of a function by a scalar function +* multiplication of two scalar functions +* inverse function (assuming that it exists; the inverse function theorem is in `../inverse.lean`) +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +section clm_comp_apply +/-! ### Derivative of the pointwise composition/application of continuous linear maps -/ + +variables {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H] {c : E → G →L[𝕜] H} + {c' : E →L[𝕜] G →L[𝕜] H} {d : E → F →L[𝕜] G} {d' : E →L[𝕜] F →L[𝕜] G} {u : E → G} + {u' : E →L[𝕜] G} + +lemma has_strict_fderiv_at.clm_comp (hc : has_strict_fderiv_at c c' x) + (hd : has_strict_fderiv_at d d' x) : has_strict_fderiv_at (λ y, (c y).comp (d y)) + ((compL 𝕜 F G H (c x)).comp d' + ((compL 𝕜 F G H).flip (d x)).comp c') x := +(is_bounded_bilinear_map_comp.has_strict_fderiv_at (c x, d x)).comp x $ hc.prod hd + +lemma has_fderiv_within_at.clm_comp (hc : has_fderiv_within_at c c' s x) + (hd : has_fderiv_within_at d d' s x) : has_fderiv_within_at (λ y, (c y).comp (d y)) + ((compL 𝕜 F G H (c x)).comp d' + ((compL 𝕜 F G H).flip (d x)).comp c') s x := +(is_bounded_bilinear_map_comp.has_fderiv_at (c x, d x)).comp_has_fderiv_within_at x $ hc.prod hd + +lemma has_fderiv_at.clm_comp (hc : has_fderiv_at c c' x) + (hd : has_fderiv_at d d' x) : has_fderiv_at (λ y, (c y).comp (d y)) + ((compL 𝕜 F G H (c x)).comp d' + ((compL 𝕜 F G H).flip (d x)).comp c') x := +(is_bounded_bilinear_map_comp.has_fderiv_at (c x, d x)).comp x $ hc.prod hd + +lemma differentiable_within_at.clm_comp + (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : + differentiable_within_at 𝕜 (λ y, (c y).comp (d y)) s x := +(hc.has_fderiv_within_at.clm_comp hd.has_fderiv_within_at).differentiable_within_at + +lemma differentiable_at.clm_comp (hc : differentiable_at 𝕜 c x) + (hd : differentiable_at 𝕜 d x) : differentiable_at 𝕜 (λ y, (c y).comp (d y)) x := +(hc.has_fderiv_at.clm_comp hd.has_fderiv_at).differentiable_at + +lemma differentiable_on.clm_comp (hc : differentiable_on 𝕜 c s) (hd : differentiable_on 𝕜 d s) : + differentiable_on 𝕜 (λ y, (c y).comp (d y)) s := +λx hx, (hc x hx).clm_comp (hd x hx) + +lemma differentiable.clm_comp (hc : differentiable 𝕜 c) (hd : differentiable 𝕜 d) : + differentiable 𝕜 (λ y, (c y).comp (d y)) := +λx, (hc x).clm_comp (hd x) + +lemma fderiv_within_clm_comp (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : + fderiv_within 𝕜 (λ y, (c y).comp (d y)) s x = + (compL 𝕜 F G H (c x)).comp (fderiv_within 𝕜 d s x) + + ((compL 𝕜 F G H).flip (d x)).comp (fderiv_within 𝕜 c s x) := +(hc.has_fderiv_within_at.clm_comp hd.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_clm_comp (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : + fderiv 𝕜 (λ y, (c y).comp (d y)) x = + (compL 𝕜 F G H (c x)).comp (fderiv 𝕜 d x) + + ((compL 𝕜 F G H).flip (d x)).comp (fderiv 𝕜 c x) := +(hc.has_fderiv_at.clm_comp hd.has_fderiv_at).fderiv + +lemma has_strict_fderiv_at.clm_apply (hc : has_strict_fderiv_at c c' x) + (hu : has_strict_fderiv_at u u' x) : + has_strict_fderiv_at (λ y, (c y) (u y)) ((c x).comp u' + c'.flip (u x)) x := +(is_bounded_bilinear_map_apply.has_strict_fderiv_at (c x, u x)).comp x (hc.prod hu) + +lemma has_fderiv_within_at.clm_apply (hc : has_fderiv_within_at c c' s x) + (hu : has_fderiv_within_at u u' s x) : + has_fderiv_within_at (λ y, (c y) (u y)) ((c x).comp u' + c'.flip (u x)) s x := +(is_bounded_bilinear_map_apply.has_fderiv_at (c x, u x)).comp_has_fderiv_within_at x (hc.prod hu) + +lemma has_fderiv_at.clm_apply (hc : has_fderiv_at c c' x) (hu : has_fderiv_at u u' x) : + has_fderiv_at (λ y, (c y) (u y)) ((c x).comp u' + c'.flip (u x)) x := +(is_bounded_bilinear_map_apply.has_fderiv_at (c x, u x)).comp x (hc.prod hu) + +lemma differentiable_within_at.clm_apply + (hc : differentiable_within_at 𝕜 c s x) (hu : differentiable_within_at 𝕜 u s x) : + differentiable_within_at 𝕜 (λ y, (c y) (u y)) s x := +(hc.has_fderiv_within_at.clm_apply hu.has_fderiv_within_at).differentiable_within_at + +lemma differentiable_at.clm_apply (hc : differentiable_at 𝕜 c x) + (hu : differentiable_at 𝕜 u x) : differentiable_at 𝕜 (λ y, (c y) (u y)) x := +(hc.has_fderiv_at.clm_apply hu.has_fderiv_at).differentiable_at + +lemma differentiable_on.clm_apply (hc : differentiable_on 𝕜 c s) (hu : differentiable_on 𝕜 u s) : + differentiable_on 𝕜 (λ y, (c y) (u y)) s := +λx hx, (hc x hx).clm_apply (hu x hx) + +lemma differentiable.clm_apply (hc : differentiable 𝕜 c) (hu : differentiable 𝕜 u) : + differentiable 𝕜 (λ y, (c y) (u y)) := +λx, (hc x).clm_apply (hu x) + +lemma fderiv_within_clm_apply (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hu : differentiable_within_at 𝕜 u s x) : + fderiv_within 𝕜 (λ y, (c y) (u y)) s x = + ((c x).comp (fderiv_within 𝕜 u s x) + (fderiv_within 𝕜 c s x).flip (u x)) := +(hc.has_fderiv_within_at.clm_apply hu.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_clm_apply (hc : differentiable_at 𝕜 c x) (hu : differentiable_at 𝕜 u x) : + fderiv 𝕜 (λ y, (c y) (u y)) x = ((c x).comp (fderiv 𝕜 u x) + (fderiv 𝕜 c x).flip (u x)) := +(hc.has_fderiv_at.clm_apply hu.has_fderiv_at).fderiv + +end clm_comp_apply + +section smul +/-! ### Derivative of the product of a scalar-valued function and a vector-valued function + +If `c` is a differentiable scalar-valued function and `f` is a differentiable vector-valued +function, then `λ x, c x • f x` is differentiable as well. Lemmas in this section works for +function `c` taking values in the base field, as well as in a normed algebra over the base +field: e.g., they work for `c : E → ℂ` and `f : E → F` provided that `F` is a complex +normed vector space. +-/ + +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] + [normed_space 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] +variables {c : E → 𝕜'} {c' : E →L[𝕜] 𝕜'} + +theorem has_strict_fderiv_at.smul (hc : has_strict_fderiv_at c c' x) + (hf : has_strict_fderiv_at f f' x) : + has_strict_fderiv_at (λ y, c y • f y) (c x • f' + c'.smul_right (f x)) x := +(is_bounded_bilinear_map_smul.has_strict_fderiv_at (c x, f x)).comp x $ + hc.prod hf + +theorem has_fderiv_within_at.smul + (hc : has_fderiv_within_at c c' s x) (hf : has_fderiv_within_at f f' s x) : + has_fderiv_within_at (λ y, c y • f y) (c x • f' + c'.smul_right (f x)) s x := +(is_bounded_bilinear_map_smul.has_fderiv_at (c x, f x)).comp_has_fderiv_within_at x $ + hc.prod hf + +theorem has_fderiv_at.smul (hc : has_fderiv_at c c' x) (hf : has_fderiv_at f f' x) : + has_fderiv_at (λ y, c y • f y) (c x • f' + c'.smul_right (f x)) x := +(is_bounded_bilinear_map_smul.has_fderiv_at (c x, f x)).comp x $ + hc.prod hf + +lemma differentiable_within_at.smul + (hc : differentiable_within_at 𝕜 c s x) (hf : differentiable_within_at 𝕜 f s x) : + differentiable_within_at 𝕜 (λ y, c y • f y) s x := +(hc.has_fderiv_within_at.smul hf.has_fderiv_within_at).differentiable_within_at + +@[simp] lemma differentiable_at.smul (hc : differentiable_at 𝕜 c x) (hf : differentiable_at 𝕜 f x) : + differentiable_at 𝕜 (λ y, c y • f y) x := +(hc.has_fderiv_at.smul hf.has_fderiv_at).differentiable_at + +lemma differentiable_on.smul (hc : differentiable_on 𝕜 c s) (hf : differentiable_on 𝕜 f s) : + differentiable_on 𝕜 (λ y, c y • f y) s := +λx hx, (hc x hx).smul (hf x hx) + +@[simp] lemma differentiable.smul (hc : differentiable 𝕜 c) (hf : differentiable 𝕜 f) : + differentiable 𝕜 (λ y, c y • f y) := +λx, (hc x).smul (hf x) + +lemma fderiv_within_smul (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hf : differentiable_within_at 𝕜 f s x) : + fderiv_within 𝕜 (λ y, c y • f y) s x = + c x • fderiv_within 𝕜 f s x + (fderiv_within 𝕜 c s x).smul_right (f x) := +(hc.has_fderiv_within_at.smul hf.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_smul (hc : differentiable_at 𝕜 c x) (hf : differentiable_at 𝕜 f x) : + fderiv 𝕜 (λ y, c y • f y) x = + c x • fderiv 𝕜 f x + (fderiv 𝕜 c x).smul_right (f x) := +(hc.has_fderiv_at.smul hf.has_fderiv_at).fderiv + +theorem has_strict_fderiv_at.smul_const (hc : has_strict_fderiv_at c c' x) (f : F) : + has_strict_fderiv_at (λ y, c y • f) (c'.smul_right f) x := +by simpa only [smul_zero, zero_add] using hc.smul (has_strict_fderiv_at_const f x) + +theorem has_fderiv_within_at.smul_const (hc : has_fderiv_within_at c c' s x) (f : F) : + has_fderiv_within_at (λ y, c y • f) (c'.smul_right f) s x := +by simpa only [smul_zero, zero_add] using hc.smul (has_fderiv_within_at_const f x s) + +theorem has_fderiv_at.smul_const (hc : has_fderiv_at c c' x) (f : F) : + has_fderiv_at (λ y, c y • f) (c'.smul_right f) x := +by simpa only [smul_zero, zero_add] using hc.smul (has_fderiv_at_const f x) + +lemma differentiable_within_at.smul_const + (hc : differentiable_within_at 𝕜 c s x) (f : F) : + differentiable_within_at 𝕜 (λ y, c y • f) s x := +(hc.has_fderiv_within_at.smul_const f).differentiable_within_at + +lemma differentiable_at.smul_const (hc : differentiable_at 𝕜 c x) (f : F) : + differentiable_at 𝕜 (λ y, c y • f) x := +(hc.has_fderiv_at.smul_const f).differentiable_at + +lemma differentiable_on.smul_const (hc : differentiable_on 𝕜 c s) (f : F) : + differentiable_on 𝕜 (λ y, c y • f) s := +λx hx, (hc x hx).smul_const f + +lemma differentiable.smul_const (hc : differentiable 𝕜 c) (f : F) : + differentiable 𝕜 (λ y, c y • f) := +λx, (hc x).smul_const f + +lemma fderiv_within_smul_const (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (f : F) : + fderiv_within 𝕜 (λ y, c y • f) s x = + (fderiv_within 𝕜 c s x).smul_right f := +(hc.has_fderiv_within_at.smul_const f).fderiv_within hxs + +lemma fderiv_smul_const (hc : differentiable_at 𝕜 c x) (f : F) : + fderiv 𝕜 (λ y, c y • f) x = (fderiv 𝕜 c x).smul_right f := +(hc.has_fderiv_at.smul_const f).fderiv + +end smul + +section mul +/-! ### Derivative of the product of two functions -/ + +variables {𝔸 𝔸' : Type*} [normed_ring 𝔸] [normed_comm_ring 𝔸'] [normed_algebra 𝕜 𝔸] + [normed_algebra 𝕜 𝔸'] {a b : E → 𝔸} {a' b' : E →L[𝕜] 𝔸} {c d : E → 𝔸'} {c' d' : E →L[𝕜] 𝔸'} + +theorem has_strict_fderiv_at.mul' {x : E} (ha : has_strict_fderiv_at a a' x) + (hb : has_strict_fderiv_at b b' x) : + has_strict_fderiv_at (λ y, a y * b y) (a x • b' + a'.smul_right (b x)) x := +((continuous_linear_map.mul 𝕜 𝔸).is_bounded_bilinear_map.has_strict_fderiv_at (a x, b x)).comp x + (ha.prod hb) + +theorem has_strict_fderiv_at.mul + (hc : has_strict_fderiv_at c c' x) (hd : has_strict_fderiv_at d d' x) : + has_strict_fderiv_at (λ y, c y * d y) (c x • d' + d x • c') x := +by { convert hc.mul' hd, ext z, apply mul_comm } + +theorem has_fderiv_within_at.mul' + (ha : has_fderiv_within_at a a' s x) (hb : has_fderiv_within_at b b' s x) : + has_fderiv_within_at (λ y, a y * b y) (a x • b' + a'.smul_right (b x)) s x := +((continuous_linear_map.mul 𝕜 𝔸).is_bounded_bilinear_map.has_fderiv_at + (a x, b x)).comp_has_fderiv_within_at x (ha.prod hb) + +theorem has_fderiv_within_at.mul + (hc : has_fderiv_within_at c c' s x) (hd : has_fderiv_within_at d d' s x) : + has_fderiv_within_at (λ y, c y * d y) (c x • d' + d x • c') s x := +by { convert hc.mul' hd, ext z, apply mul_comm } + +theorem has_fderiv_at.mul' + (ha : has_fderiv_at a a' x) (hb : has_fderiv_at b b' x) : + has_fderiv_at (λ y, a y * b y) (a x • b' + a'.smul_right (b x)) x := +((continuous_linear_map.mul 𝕜 𝔸).is_bounded_bilinear_map.has_fderiv_at (a x, b x)).comp x + (ha.prod hb) + +theorem has_fderiv_at.mul (hc : has_fderiv_at c c' x) (hd : has_fderiv_at d d' x) : + has_fderiv_at (λ y, c y * d y) (c x • d' + d x • c') x := +by { convert hc.mul' hd, ext z, apply mul_comm } + +lemma differentiable_within_at.mul + (ha : differentiable_within_at 𝕜 a s x) (hb : differentiable_within_at 𝕜 b s x) : + differentiable_within_at 𝕜 (λ y, a y * b y) s x := +(ha.has_fderiv_within_at.mul' hb.has_fderiv_within_at).differentiable_within_at + +@[simp] lemma differentiable_at.mul (ha : differentiable_at 𝕜 a x) (hb : differentiable_at 𝕜 b x) : + differentiable_at 𝕜 (λ y, a y * b y) x := +(ha.has_fderiv_at.mul' hb.has_fderiv_at).differentiable_at + +lemma differentiable_on.mul (ha : differentiable_on 𝕜 a s) (hb : differentiable_on 𝕜 b s) : + differentiable_on 𝕜 (λ y, a y * b y) s := +λx hx, (ha x hx).mul (hb x hx) + +@[simp] lemma differentiable.mul (ha : differentiable 𝕜 a) (hb : differentiable 𝕜 b) : + differentiable 𝕜 (λ y, a y * b y) := +λx, (ha x).mul (hb x) + +lemma differentiable_within_at.pow (ha : differentiable_within_at 𝕜 a s x) : + ∀ n : ℕ, differentiable_within_at 𝕜 (λ x, a x ^ n) s x +| 0 := by simp only [pow_zero, differentiable_within_at_const] +| (n + 1) := by simp only [pow_succ, differentiable_within_at.pow n, ha.mul] + +@[simp] lemma differentiable_at.pow (ha : differentiable_at 𝕜 a x) (n : ℕ) : + differentiable_at 𝕜 (λ x, a x ^ n) x := +differentiable_within_at_univ.mp $ ha.differentiable_within_at.pow n + +lemma differentiable_on.pow (ha : differentiable_on 𝕜 a s) (n : ℕ) : + differentiable_on 𝕜 (λ x, a x ^ n) s := +λ x h, (ha x h).pow n + +@[simp] lemma differentiable.pow (ha : differentiable 𝕜 a) (n : ℕ) : + differentiable 𝕜 (λ x, a x ^ n) := +λx, (ha x).pow n + +lemma fderiv_within_mul' (hxs : unique_diff_within_at 𝕜 s x) + (ha : differentiable_within_at 𝕜 a s x) (hb : differentiable_within_at 𝕜 b s x) : + fderiv_within 𝕜 (λ y, a y * b y) s x = + a x • fderiv_within 𝕜 b s x + (fderiv_within 𝕜 a s x).smul_right (b x) := +(ha.has_fderiv_within_at.mul' hb.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_within_mul (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (hd : differentiable_within_at 𝕜 d s x) : + fderiv_within 𝕜 (λ y, c y * d y) s x = + c x • fderiv_within 𝕜 d s x + d x • fderiv_within 𝕜 c s x := +(hc.has_fderiv_within_at.mul hd.has_fderiv_within_at).fderiv_within hxs + +lemma fderiv_mul' (ha : differentiable_at 𝕜 a x) (hb : differentiable_at 𝕜 b x) : + fderiv 𝕜 (λ y, a y * b y) x = + a x • fderiv 𝕜 b x + (fderiv 𝕜 a x).smul_right (b x) := +(ha.has_fderiv_at.mul' hb.has_fderiv_at).fderiv + +lemma fderiv_mul (hc : differentiable_at 𝕜 c x) (hd : differentiable_at 𝕜 d x) : + fderiv 𝕜 (λ y, c y * d y) x = + c x • fderiv 𝕜 d x + d x • fderiv 𝕜 c x := +(hc.has_fderiv_at.mul hd.has_fderiv_at).fderiv + +theorem has_strict_fderiv_at.mul_const' (ha : has_strict_fderiv_at a a' x) (b : 𝔸) : + has_strict_fderiv_at (λ y, a y * b) (a'.smul_right b) x := +(((continuous_linear_map.mul 𝕜 𝔸).flip b).has_strict_fderiv_at).comp x ha + +theorem has_strict_fderiv_at.mul_const (hc : has_strict_fderiv_at c c' x) (d : 𝔸') : + has_strict_fderiv_at (λ y, c y * d) (d • c') x := +by { convert hc.mul_const' d, ext z, apply mul_comm } + +theorem has_fderiv_within_at.mul_const' (ha : has_fderiv_within_at a a' s x) (b : 𝔸) : + has_fderiv_within_at (λ y, a y * b) (a'.smul_right b) s x := +(((continuous_linear_map.mul 𝕜 𝔸).flip b).has_fderiv_at).comp_has_fderiv_within_at x ha + +theorem has_fderiv_within_at.mul_const (hc : has_fderiv_within_at c c' s x) (d : 𝔸') : + has_fderiv_within_at (λ y, c y * d) (d • c') s x := +by { convert hc.mul_const' d, ext z, apply mul_comm } + +theorem has_fderiv_at.mul_const' (ha : has_fderiv_at a a' x) (b : 𝔸) : + has_fderiv_at (λ y, a y * b) (a'.smul_right b) x := +(((continuous_linear_map.mul 𝕜 𝔸).flip b).has_fderiv_at).comp x ha + +theorem has_fderiv_at.mul_const (hc : has_fderiv_at c c' x) (d : 𝔸') : + has_fderiv_at (λ y, c y * d) (d • c') x := +by { convert hc.mul_const' d, ext z, apply mul_comm } + +lemma differentiable_within_at.mul_const + (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : + differentiable_within_at 𝕜 (λ y, a y * b) s x := +(ha.has_fderiv_within_at.mul_const' b).differentiable_within_at + +lemma differentiable_at.mul_const (ha : differentiable_at 𝕜 a x) (b : 𝔸) : + differentiable_at 𝕜 (λ y, a y * b) x := +(ha.has_fderiv_at.mul_const' b).differentiable_at + +lemma differentiable_on.mul_const (ha : differentiable_on 𝕜 a s) (b : 𝔸) : + differentiable_on 𝕜 (λ y, a y * b) s := +λx hx, (ha x hx).mul_const b + +lemma differentiable.mul_const (ha : differentiable 𝕜 a) (b : 𝔸) : + differentiable 𝕜 (λ y, a y * b) := +λx, (ha x).mul_const b + +lemma fderiv_within_mul_const' (hxs : unique_diff_within_at 𝕜 s x) + (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : + fderiv_within 𝕜 (λ y, a y * b) s x = (fderiv_within 𝕜 a s x).smul_right b := +(ha.has_fderiv_within_at.mul_const' b).fderiv_within hxs + +lemma fderiv_within_mul_const (hxs : unique_diff_within_at 𝕜 s x) + (hc : differentiable_within_at 𝕜 c s x) (d : 𝔸') : + fderiv_within 𝕜 (λ y, c y * d) s x = d • fderiv_within 𝕜 c s x := +(hc.has_fderiv_within_at.mul_const d).fderiv_within hxs + +lemma fderiv_mul_const' (ha : differentiable_at 𝕜 a x) (b : 𝔸) : + fderiv 𝕜 (λ y, a y * b) x = (fderiv 𝕜 a x).smul_right b := +(ha.has_fderiv_at.mul_const' b).fderiv + +lemma fderiv_mul_const (hc : differentiable_at 𝕜 c x) (d : 𝔸') : + fderiv 𝕜 (λ y, c y * d) x = d • fderiv 𝕜 c x := +(hc.has_fderiv_at.mul_const d).fderiv + +theorem has_strict_fderiv_at.const_mul (ha : has_strict_fderiv_at a a' x) (b : 𝔸) : + has_strict_fderiv_at (λ y, b * a y) (b • a') x := +(((continuous_linear_map.mul 𝕜 𝔸) b).has_strict_fderiv_at).comp x ha + +theorem has_fderiv_within_at.const_mul + (ha : has_fderiv_within_at a a' s x) (b : 𝔸) : + has_fderiv_within_at (λ y, b * a y) (b • a') s x := +(((continuous_linear_map.mul 𝕜 𝔸) b).has_fderiv_at).comp_has_fderiv_within_at x ha + +theorem has_fderiv_at.const_mul (ha : has_fderiv_at a a' x) (b : 𝔸) : + has_fderiv_at (λ y, b * a y) (b • a') x := +(((continuous_linear_map.mul 𝕜 𝔸) b).has_fderiv_at).comp x ha + +lemma differentiable_within_at.const_mul + (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : + differentiable_within_at 𝕜 (λ y, b * a y) s x := +(ha.has_fderiv_within_at.const_mul b).differentiable_within_at + +lemma differentiable_at.const_mul (ha : differentiable_at 𝕜 a x) (b : 𝔸) : + differentiable_at 𝕜 (λ y, b * a y) x := +(ha.has_fderiv_at.const_mul b).differentiable_at + +lemma differentiable_on.const_mul (ha : differentiable_on 𝕜 a s) (b : 𝔸) : + differentiable_on 𝕜 (λ y, b * a y) s := +λx hx, (ha x hx).const_mul b + +lemma differentiable.const_mul (ha : differentiable 𝕜 a) (b : 𝔸) : + differentiable 𝕜 (λ y, b * a y) := +λx, (ha x).const_mul b + +lemma fderiv_within_const_mul (hxs : unique_diff_within_at 𝕜 s x) + (ha : differentiable_within_at 𝕜 a s x) (b : 𝔸) : + fderiv_within 𝕜 (λ y, b * a y) s x = b • fderiv_within 𝕜 a s x := +(ha.has_fderiv_within_at.const_mul b).fderiv_within hxs + +lemma fderiv_const_mul (ha : differentiable_at 𝕜 a x) (b : 𝔸) : + fderiv 𝕜 (λ y, b * a y) x = b • fderiv 𝕜 a x := +(ha.has_fderiv_at.const_mul b).fderiv + +end mul + +section algebra_inverse +variables {R : Type*} [normed_ring R] [normed_algebra 𝕜 R] [complete_space R] +open normed_ring continuous_linear_map ring + +/-- At an invertible element `x` of a normed algebra `R`, the Fréchet derivative of the inversion +operation is the linear map `λ t, - x⁻¹ * t * x⁻¹`. -/ +lemma has_fderiv_at_ring_inverse (x : Rˣ) : + has_fderiv_at ring.inverse (-mul_left_right 𝕜 R ↑x⁻¹ ↑x⁻¹) x := +begin + have h_is_o : (λ (t : R), inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) =o[𝓝 0] (λ (t : R), t), + { refine (inverse_add_norm_diff_second_order x).trans_is_o ((is_o_norm_norm).mp _), + simp only [norm_pow, norm_norm], + have h12 : 1 < 2 := by norm_num, + convert (asymptotics.is_o_pow_pow h12).comp_tendsto tendsto_norm_zero, + ext, simp }, + have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0), + { refine tendsto_zero_iff_norm_tendsto_zero.mpr _, + exact tendsto_iff_norm_tendsto_zero.mp tendsto_id }, + simp only [has_fderiv_at, has_fderiv_at_filter], + convert h_is_o.comp_tendsto h_lim, + ext y, + simp only [coe_comp', function.comp_app, mul_left_right_apply, neg_apply, inverse_unit x, + units.inv_mul, add_sub_cancel'_right, mul_sub, sub_mul, one_mul, sub_neg_eq_add] +end + +lemma differentiable_at_inverse {x : R} (hx : is_unit x) : + differentiable_at 𝕜 (@ring.inverse R _) x := +let ⟨u, hu⟩ := hx in hu ▸ (has_fderiv_at_ring_inverse u).differentiable_at + +lemma differentiable_within_at_inverse {x : R} (hx : is_unit x) (s : set R): + differentiable_within_at 𝕜 (@ring.inverse R _) s x := +(differentiable_at_inverse hx).differentiable_within_at + +lemma differentiable_on_inverse : differentiable_on 𝕜 (@ring.inverse R _) {x | is_unit x} := +λ x hx, differentiable_within_at_inverse hx _ + +lemma fderiv_inverse (x : Rˣ) : + fderiv 𝕜 (@ring.inverse R _) x = - mul_left_right 𝕜 R ↑x⁻¹ ↑x⁻¹ := +(has_fderiv_at_ring_inverse x).fderiv + +variables {h : E → R} {z : E} {S : set E} + +lemma differentiable_within_at.inverse (hf : differentiable_within_at 𝕜 h S z) + (hz : is_unit (h z)) : + differentiable_within_at 𝕜 (λ x, ring.inverse (h x)) S z := +(differentiable_at_inverse hz).comp_differentiable_within_at z hf + +@[simp] lemma differentiable_at.inverse (hf : differentiable_at 𝕜 h z) (hz : is_unit (h z)) : + differentiable_at 𝕜 (λ x, ring.inverse (h x)) z := +(differentiable_at_inverse hz).comp z hf + +lemma differentiable_on.inverse (hf : differentiable_on 𝕜 h S) (hz : ∀ x ∈ S, is_unit (h x)) : + differentiable_on 𝕜 (λ x, ring.inverse (h x)) S := +λ x h, (hf x h).inverse (hz x h) + +@[simp] lemma differentiable.inverse (hf : differentiable 𝕜 h) (hz : ∀ x, is_unit (h x)) : + differentiable 𝕜 (λ x, ring.inverse (h x)) := +λ x, (hf x).inverse (hz x) + +end algebra_inverse + +/-! ### Derivative of the inverse in a division ring + +Note these lemmas are primed as they need `complete_space R`, whereas the other lemmas in +`deriv/inv.lean` do not, but instead need `nontrivially_normed_field R`. +-/ + +section division_ring_inverse +variables {R : Type*} [normed_division_ring R] [normed_algebra 𝕜 R] [complete_space R] +open normed_ring continuous_linear_map ring + +/-- At an invertible element `x` of a normed division algebra `R`, the Fréchet derivative of the +inversion operation is the linear map `λ t, - x⁻¹ * t * x⁻¹`. -/ +lemma has_fderiv_at_inv' {x : R} (hx : x ≠ 0) : + has_fderiv_at has_inv.inv (-mul_left_right 𝕜 R x⁻¹ x⁻¹) x := +by simpa using has_fderiv_at_ring_inverse (units.mk0 _ hx) + +lemma differentiable_at_inv' {x : R} (hx : x ≠ 0) : differentiable_at 𝕜 has_inv.inv x := +(has_fderiv_at_inv' hx).differentiable_at + +lemma differentiable_within_at_inv' {x : R} (hx : x ≠ 0) (s : set R): + differentiable_within_at 𝕜 (λx, x⁻¹) s x := +(differentiable_at_inv' hx).differentiable_within_at + +lemma differentiable_on_inv' : differentiable_on 𝕜 (λ x : R, x⁻¹) {x | x ≠ 0} := +λ x hx, differentiable_within_at_inv' hx _ + +/-- Non-commutative version of `fderiv_inv` -/ +lemma fderiv_inv' {x : R} (hx : x ≠ 0) : + fderiv 𝕜 has_inv.inv x = - mul_left_right 𝕜 R x⁻¹ x⁻¹ := +(has_fderiv_at_inv' hx).fderiv + +/-- Non-commutative version of `fderiv_within_inv` -/ +lemma fderiv_within_inv' {s : set R} {x : R} (hx : x ≠ 0) (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λ x, x⁻¹) s x = - mul_left_right 𝕜 R x⁻¹ x⁻¹ := +begin + rw differentiable_at.fderiv_within (differentiable_at_inv' hx) hxs, + exact fderiv_inv' hx +end + +variables {h : E → R} {z : E} {S : set E} + +lemma differentiable_within_at.inv' (hf : differentiable_within_at 𝕜 h S z) (hz : h z ≠ 0) : + differentiable_within_at 𝕜 (λ x, (h x)⁻¹) S z := +(differentiable_at_inv' hz).comp_differentiable_within_at z hf + +@[simp] lemma differentiable_at.inv' (hf : differentiable_at 𝕜 h z) (hz : h z ≠ 0) : + differentiable_at 𝕜 (λ x, (h x)⁻¹) z := +(differentiable_at_inv' hz).comp z hf + +lemma differentiable_on.inv' (hf : differentiable_on 𝕜 h S) (hz : ∀ x ∈ S, h x ≠ 0) : + differentiable_on 𝕜 (λ x, (h x)⁻¹) S := +λ x h, (hf x h).inv' (hz x h) + +@[simp] lemma differentiable.inv' (hf : differentiable 𝕜 h) (hz : ∀ x, h x ≠ 0) : + differentiable 𝕜 (λ x, (h x)⁻¹) := +λ x, (hf x).inv' (hz x) + +end division_ring_inverse + +end diff --git a/src/analysis/calculus/fderiv/prod.lean b/src/analysis/calculus/fderiv/prod.lean new file mode 100644 index 0000000000000..d91f9ef1f8181 --- /dev/null +++ b/src/analysis/calculus/fderiv/prod.lean @@ -0,0 +1,386 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.linear +import analysis.calculus.fderiv.comp + +/-! +# Derivative of the cartesian product of functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of +cartesian products of functions, and functions into Pi-types. +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + + +section + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] + +variables {f f₀ f₁ g : E → F} +variables {f' f₀' f₁' g' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s t : set E} +variables {L L₁ L₂ : filter E} + +section cartesian_product +/-! ### Derivative of the cartesian product of two functions -/ + +section prod +variables {f₂ : E → G} {f₂' : E →L[𝕜] G} + +protected lemma has_strict_fderiv_at.prod + (hf₁ : has_strict_fderiv_at f₁ f₁' x) (hf₂ : has_strict_fderiv_at f₂ f₂' x) : + has_strict_fderiv_at (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') x := +hf₁.prod_left hf₂ + +lemma has_fderiv_at_filter.prod + (hf₁ : has_fderiv_at_filter f₁ f₁' x L) (hf₂ : has_fderiv_at_filter f₂ f₂' x L) : + has_fderiv_at_filter (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') x L := +hf₁.prod_left hf₂ + +lemma has_fderiv_within_at.prod + (hf₁ : has_fderiv_within_at f₁ f₁' s x) (hf₂ : has_fderiv_within_at f₂ f₂' s x) : + has_fderiv_within_at (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') s x := +hf₁.prod hf₂ + +lemma has_fderiv_at.prod (hf₁ : has_fderiv_at f₁ f₁' x) (hf₂ : has_fderiv_at f₂ f₂' x) : + has_fderiv_at (λx, (f₁ x, f₂ x)) (f₁'.prod f₂') x := +hf₁.prod hf₂ + +lemma has_fderiv_at_prod_mk_left (e₀ : E) (f₀ : F) : + has_fderiv_at (λ e : E, (e, f₀)) (inl 𝕜 E F) e₀ := +(has_fderiv_at_id e₀).prod (has_fderiv_at_const f₀ e₀) + +lemma has_fderiv_at_prod_mk_right (e₀ : E) (f₀ : F) : + has_fderiv_at (λ f : F, (e₀, f)) (inr 𝕜 E F) f₀ := +(has_fderiv_at_const e₀ f₀).prod (has_fderiv_at_id f₀) + +lemma differentiable_within_at.prod + (hf₁ : differentiable_within_at 𝕜 f₁ s x) (hf₂ : differentiable_within_at 𝕜 f₂ s x) : + differentiable_within_at 𝕜 (λx:E, (f₁ x, f₂ x)) s x := +(hf₁.has_fderiv_within_at.prod hf₂.has_fderiv_within_at).differentiable_within_at + +@[simp] +lemma differentiable_at.prod (hf₁ : differentiable_at 𝕜 f₁ x) (hf₂ : differentiable_at 𝕜 f₂ x) : + differentiable_at 𝕜 (λx:E, (f₁ x, f₂ x)) x := +(hf₁.has_fderiv_at.prod hf₂.has_fderiv_at).differentiable_at + +lemma differentiable_on.prod (hf₁ : differentiable_on 𝕜 f₁ s) (hf₂ : differentiable_on 𝕜 f₂ s) : + differentiable_on 𝕜 (λx:E, (f₁ x, f₂ x)) s := +λx hx, differentiable_within_at.prod (hf₁ x hx) (hf₂ x hx) + +@[simp] +lemma differentiable.prod (hf₁ : differentiable 𝕜 f₁) (hf₂ : differentiable 𝕜 f₂) : + differentiable 𝕜 (λx:E, (f₁ x, f₂ x)) := +λ x, differentiable_at.prod (hf₁ x) (hf₂ x) + +lemma differentiable_at.fderiv_prod + (hf₁ : differentiable_at 𝕜 f₁ x) (hf₂ : differentiable_at 𝕜 f₂ x) : + fderiv 𝕜 (λx:E, (f₁ x, f₂ x)) x = (fderiv 𝕜 f₁ x).prod (fderiv 𝕜 f₂ x) := +(hf₁.has_fderiv_at.prod hf₂.has_fderiv_at).fderiv + +lemma differentiable_within_at.fderiv_within_prod + (hf₁ : differentiable_within_at 𝕜 f₁ s x) (hf₂ : differentiable_within_at 𝕜 f₂ s x) + (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λx:E, (f₁ x, f₂ x)) s x = + (fderiv_within 𝕜 f₁ s x).prod (fderiv_within 𝕜 f₂ s x) := +(hf₁.has_fderiv_within_at.prod hf₂.has_fderiv_within_at).fderiv_within hxs + +end prod + +section fst + +variables {f₂ : E → F × G} {f₂' : E →L[𝕜] F × G} {p : E × F} + +lemma has_strict_fderiv_at_fst : has_strict_fderiv_at (@prod.fst E F) (fst 𝕜 E F) p := +(fst 𝕜 E F).has_strict_fderiv_at + +protected lemma has_strict_fderiv_at.fst (h : has_strict_fderiv_at f₂ f₂' x) : + has_strict_fderiv_at (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') x := +has_strict_fderiv_at_fst.comp x h + +lemma has_fderiv_at_filter_fst {L : filter (E × F)} : + has_fderiv_at_filter (@prod.fst E F) (fst 𝕜 E F) p L := +(fst 𝕜 E F).has_fderiv_at_filter + +protected lemma has_fderiv_at_filter.fst (h : has_fderiv_at_filter f₂ f₂' x L) : + has_fderiv_at_filter (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') x L := +has_fderiv_at_filter_fst.comp x h tendsto_map + +lemma has_fderiv_at_fst : has_fderiv_at (@prod.fst E F) (fst 𝕜 E F) p := +has_fderiv_at_filter_fst + +protected lemma has_fderiv_at.fst (h : has_fderiv_at f₂ f₂' x) : + has_fderiv_at (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') x := +h.fst + +lemma has_fderiv_within_at_fst {s : set (E × F)} : + has_fderiv_within_at (@prod.fst E F) (fst 𝕜 E F) s p := +has_fderiv_at_filter_fst + +protected lemma has_fderiv_within_at.fst (h : has_fderiv_within_at f₂ f₂' s x) : + has_fderiv_within_at (λ x, (f₂ x).1) ((fst 𝕜 F G).comp f₂') s x := +h.fst + +lemma differentiable_at_fst : differentiable_at 𝕜 prod.fst p := +has_fderiv_at_fst.differentiable_at + +@[simp] protected lemma differentiable_at.fst (h : differentiable_at 𝕜 f₂ x) : + differentiable_at 𝕜 (λ x, (f₂ x).1) x := +differentiable_at_fst.comp x h + +lemma differentiable_fst : differentiable 𝕜 (prod.fst : E × F → E) := +λ x, differentiable_at_fst + +@[simp] protected lemma differentiable.fst (h : differentiable 𝕜 f₂) : + differentiable 𝕜 (λ x, (f₂ x).1) := +differentiable_fst.comp h + +lemma differentiable_within_at_fst {s : set (E × F)} : differentiable_within_at 𝕜 prod.fst s p := +differentiable_at_fst.differentiable_within_at + +protected lemma differentiable_within_at.fst (h : differentiable_within_at 𝕜 f₂ s x) : + differentiable_within_at 𝕜 (λ x, (f₂ x).1) s x := +differentiable_at_fst.comp_differentiable_within_at x h + +lemma differentiable_on_fst {s : set (E × F)} : differentiable_on 𝕜 prod.fst s := +differentiable_fst.differentiable_on + +protected lemma differentiable_on.fst (h : differentiable_on 𝕜 f₂ s) : + differentiable_on 𝕜 (λ x, (f₂ x).1) s := +differentiable_fst.comp_differentiable_on h + +lemma fderiv_fst : fderiv 𝕜 prod.fst p = fst 𝕜 E F := has_fderiv_at_fst.fderiv + +lemma fderiv.fst (h : differentiable_at 𝕜 f₂ x) : + fderiv 𝕜 (λ x, (f₂ x).1) x = (fst 𝕜 F G).comp (fderiv 𝕜 f₂ x) := +h.has_fderiv_at.fst.fderiv + +lemma fderiv_within_fst {s : set (E × F)} (hs : unique_diff_within_at 𝕜 s p) : + fderiv_within 𝕜 prod.fst s p = fst 𝕜 E F := +has_fderiv_within_at_fst.fderiv_within hs + +lemma fderiv_within.fst (hs : unique_diff_within_at 𝕜 s x) (h : differentiable_within_at 𝕜 f₂ s x) : + fderiv_within 𝕜 (λ x, (f₂ x).1) s x = (fst 𝕜 F G).comp (fderiv_within 𝕜 f₂ s x) := +h.has_fderiv_within_at.fst.fderiv_within hs + +end fst + +section snd + +variables {f₂ : E → F × G} {f₂' : E →L[𝕜] F × G} {p : E × F} + +lemma has_strict_fderiv_at_snd : has_strict_fderiv_at (@prod.snd E F) (snd 𝕜 E F) p := +(snd 𝕜 E F).has_strict_fderiv_at + +protected lemma has_strict_fderiv_at.snd (h : has_strict_fderiv_at f₂ f₂' x) : + has_strict_fderiv_at (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') x := +has_strict_fderiv_at_snd.comp x h + +lemma has_fderiv_at_filter_snd {L : filter (E × F)} : + has_fderiv_at_filter (@prod.snd E F) (snd 𝕜 E F) p L := +(snd 𝕜 E F).has_fderiv_at_filter + +protected lemma has_fderiv_at_filter.snd (h : has_fderiv_at_filter f₂ f₂' x L) : + has_fderiv_at_filter (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') x L := +has_fderiv_at_filter_snd.comp x h tendsto_map + +lemma has_fderiv_at_snd : has_fderiv_at (@prod.snd E F) (snd 𝕜 E F) p := +has_fderiv_at_filter_snd + +protected lemma has_fderiv_at.snd (h : has_fderiv_at f₂ f₂' x) : + has_fderiv_at (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') x := +h.snd + +lemma has_fderiv_within_at_snd {s : set (E × F)} : + has_fderiv_within_at (@prod.snd E F) (snd 𝕜 E F) s p := +has_fderiv_at_filter_snd + +protected lemma has_fderiv_within_at.snd (h : has_fderiv_within_at f₂ f₂' s x) : + has_fderiv_within_at (λ x, (f₂ x).2) ((snd 𝕜 F G).comp f₂') s x := +h.snd + +lemma differentiable_at_snd : differentiable_at 𝕜 prod.snd p := +has_fderiv_at_snd.differentiable_at + +@[simp] protected lemma differentiable_at.snd (h : differentiable_at 𝕜 f₂ x) : + differentiable_at 𝕜 (λ x, (f₂ x).2) x := +differentiable_at_snd.comp x h + +lemma differentiable_snd : differentiable 𝕜 (prod.snd : E × F → F) := +λ x, differentiable_at_snd + +@[simp] protected lemma differentiable.snd (h : differentiable 𝕜 f₂) : + differentiable 𝕜 (λ x, (f₂ x).2) := +differentiable_snd.comp h + +lemma differentiable_within_at_snd {s : set (E × F)} : differentiable_within_at 𝕜 prod.snd s p := +differentiable_at_snd.differentiable_within_at + +protected lemma differentiable_within_at.snd (h : differentiable_within_at 𝕜 f₂ s x) : + differentiable_within_at 𝕜 (λ x, (f₂ x).2) s x := +differentiable_at_snd.comp_differentiable_within_at x h + +lemma differentiable_on_snd {s : set (E × F)} : differentiable_on 𝕜 prod.snd s := +differentiable_snd.differentiable_on + +protected lemma differentiable_on.snd (h : differentiable_on 𝕜 f₂ s) : + differentiable_on 𝕜 (λ x, (f₂ x).2) s := +differentiable_snd.comp_differentiable_on h + +lemma fderiv_snd : fderiv 𝕜 prod.snd p = snd 𝕜 E F := has_fderiv_at_snd.fderiv + +lemma fderiv.snd (h : differentiable_at 𝕜 f₂ x) : + fderiv 𝕜 (λ x, (f₂ x).2) x = (snd 𝕜 F G).comp (fderiv 𝕜 f₂ x) := +h.has_fderiv_at.snd.fderiv + +lemma fderiv_within_snd {s : set (E × F)} (hs : unique_diff_within_at 𝕜 s p) : + fderiv_within 𝕜 prod.snd s p = snd 𝕜 E F := +has_fderiv_within_at_snd.fderiv_within hs + +lemma fderiv_within.snd (hs : unique_diff_within_at 𝕜 s x) (h : differentiable_within_at 𝕜 f₂ s x) : + fderiv_within 𝕜 (λ x, (f₂ x).2) s x = (snd 𝕜 F G).comp (fderiv_within 𝕜 f₂ s x) := +h.has_fderiv_within_at.snd.fderiv_within hs + +end snd + +section prod_map + +variables {f₂ : G → G'} {f₂' : G →L[𝕜] G'} {y : G} (p : E × G) + +protected theorem has_strict_fderiv_at.prod_map (hf : has_strict_fderiv_at f f' p.1) + (hf₂ : has_strict_fderiv_at f₂ f₂' p.2) : + has_strict_fderiv_at (prod.map f f₂) (f'.prod_map f₂') p := +(hf.comp p has_strict_fderiv_at_fst).prod (hf₂.comp p has_strict_fderiv_at_snd) + +protected theorem has_fderiv_at.prod_map (hf : has_fderiv_at f f' p.1) + (hf₂ : has_fderiv_at f₂ f₂' p.2) : + has_fderiv_at (prod.map f f₂) (f'.prod_map f₂') p := +(hf.comp p has_fderiv_at_fst).prod (hf₂.comp p has_fderiv_at_snd) + +@[simp] protected theorem differentiable_at.prod_map (hf : differentiable_at 𝕜 f p.1) + (hf₂ : differentiable_at 𝕜 f₂ p.2) : + differentiable_at 𝕜 (λ p : E × G, (f p.1, f₂ p.2)) p := +(hf.comp p differentiable_at_fst).prod (hf₂.comp p differentiable_at_snd) + +end prod_map + +section pi + +/-! +### Derivatives of functions `f : E → Π i, F' i` + +In this section we formulate `has_*fderiv*_pi` theorems as `iff`s, and provide two versions of each +theorem: + +* the version without `'` deals with `φ : Π i, E → F' i` and `φ' : Π i, E →L[𝕜] F' i` + and is designed to deduce differentiability of `λ x i, φ i x` from differentiability + of each `φ i`; +* the version with `'` deals with `Φ : E → Π i, F' i` and `Φ' : E →L[𝕜] Π i, F' i` + and is designed to deduce differentiability of the components `λ x, Φ x i` from + differentiability of `Φ`. +-/ + +variables {ι : Type*} [fintype ι] {F' : ι → Type*} [Π i, normed_add_comm_group (F' i)] + [Π i, normed_space 𝕜 (F' i)] {φ : Π i, E → F' i} {φ' : Π i, E →L[𝕜] F' i} + {Φ : E → Π i, F' i} {Φ' : E →L[𝕜] Π i, F' i} + +@[simp] lemma has_strict_fderiv_at_pi' : + has_strict_fderiv_at Φ Φ' x ↔ + ∀ i, has_strict_fderiv_at (λ x, Φ x i) ((proj i).comp Φ') x := +begin + simp only [has_strict_fderiv_at, continuous_linear_map.coe_pi], + exact is_o_pi +end + +@[simp] lemma has_strict_fderiv_at_pi : + has_strict_fderiv_at (λ x i, φ i x) (continuous_linear_map.pi φ') x ↔ + ∀ i, has_strict_fderiv_at (φ i) (φ' i) x := +has_strict_fderiv_at_pi' + +@[simp] lemma has_fderiv_at_filter_pi' : + has_fderiv_at_filter Φ Φ' x L ↔ + ∀ i, has_fderiv_at_filter (λ x, Φ x i) ((proj i).comp Φ') x L := +begin + simp only [has_fderiv_at_filter, continuous_linear_map.coe_pi], + exact is_o_pi +end + +lemma has_fderiv_at_filter_pi : + has_fderiv_at_filter (λ x i, φ i x) (continuous_linear_map.pi φ') x L ↔ + ∀ i, has_fderiv_at_filter (φ i) (φ' i) x L := +has_fderiv_at_filter_pi' + +@[simp] lemma has_fderiv_at_pi' : + has_fderiv_at Φ Φ' x ↔ + ∀ i, has_fderiv_at (λ x, Φ x i) ((proj i).comp Φ') x := +has_fderiv_at_filter_pi' + +lemma has_fderiv_at_pi : + has_fderiv_at (λ x i, φ i x) (continuous_linear_map.pi φ') x ↔ + ∀ i, has_fderiv_at (φ i) (φ' i) x := +has_fderiv_at_filter_pi + +@[simp] lemma has_fderiv_within_at_pi' : + has_fderiv_within_at Φ Φ' s x ↔ + ∀ i, has_fderiv_within_at (λ x, Φ x i) ((proj i).comp Φ') s x := +has_fderiv_at_filter_pi' + +lemma has_fderiv_within_at_pi : + has_fderiv_within_at (λ x i, φ i x) (continuous_linear_map.pi φ') s x ↔ + ∀ i, has_fderiv_within_at (φ i) (φ' i) s x := +has_fderiv_at_filter_pi + +@[simp] lemma differentiable_within_at_pi : + differentiable_within_at 𝕜 Φ s x ↔ + ∀ i, differentiable_within_at 𝕜 (λ x, Φ x i) s x := +⟨λ h i, (has_fderiv_within_at_pi'.1 h.has_fderiv_within_at i).differentiable_within_at, + λ h, (has_fderiv_within_at_pi.2 (λ i, (h i).has_fderiv_within_at)).differentiable_within_at⟩ + +@[simp] lemma differentiable_at_pi : + differentiable_at 𝕜 Φ x ↔ ∀ i, differentiable_at 𝕜 (λ x, Φ x i) x := +⟨λ h i, (has_fderiv_at_pi'.1 h.has_fderiv_at i).differentiable_at, + λ h, (has_fderiv_at_pi.2 (λ i, (h i).has_fderiv_at)).differentiable_at⟩ + +lemma differentiable_on_pi : + differentiable_on 𝕜 Φ s ↔ ∀ i, differentiable_on 𝕜 (λ x, Φ x i) s := +⟨λ h i x hx, differentiable_within_at_pi.1 (h x hx) i, + λ h x hx, differentiable_within_at_pi.2 (λ i, h i x hx)⟩ + +lemma differentiable_pi : + differentiable 𝕜 Φ ↔ ∀ i, differentiable 𝕜 (λ x, Φ x i) := +⟨λ h i x, differentiable_at_pi.1 (h x) i, λ h x, differentiable_at_pi.2 (λ i, h i x)⟩ + +-- TODO: find out which version (`φ` or `Φ`) works better with `rw`/`simp` +lemma fderiv_within_pi (h : ∀ i, differentiable_within_at 𝕜 (φ i) s x) + (hs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λ x i, φ i x) s x = pi (λ i, fderiv_within 𝕜 (φ i) s x) := +(has_fderiv_within_at_pi.2 (λ i, (h i).has_fderiv_within_at)).fderiv_within hs + +lemma fderiv_pi (h : ∀ i, differentiable_at 𝕜 (φ i) x) : + fderiv 𝕜 (λ x i, φ i x) x = pi (λ i, fderiv 𝕜 (φ i) x) := +(has_fderiv_at_pi.2 (λ i, (h i).has_fderiv_at)).fderiv + +end pi + +end cartesian_product + +end diff --git a/src/analysis/calculus/fderiv/restrict_scalars.lean b/src/analysis/calculus/fderiv/restrict_scalars.lean new file mode 100644 index 0000000000000..d414c3f156487 --- /dev/null +++ b/src/analysis/calculus/fderiv/restrict_scalars.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2019 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Sébastien Gouëzel, Yury Kudryashov +-/ +import analysis.calculus.fderiv.basic + +/-! +# The derivative of the scalar restriction of a linear map + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of +the scalar restriction of a linear map. +-/ + +open filter asymptotics continuous_linear_map set metric +open_locale topology classical nnreal filter asymptotics ennreal + +noncomputable theory + +section restrict_scalars +/-! +### Restricting from `ℂ` to `ℝ`, or generally from `𝕜'` to `𝕜` + +If a function is differentiable over `ℂ`, then it is differentiable over `ℝ`. In this paragraph, +we give variants of this statement, in the general situation where `ℂ` and `ℝ` are replaced +respectively by `𝕜'` and `𝕜` where `𝕜'` is a normed algebra over `𝕜`. +-/ + +variables (𝕜 : Type*) [nontrivially_normed_field 𝕜] +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [normed_space 𝕜' E] +variables [is_scalar_tower 𝕜 𝕜' E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [normed_space 𝕜' F] +variables [is_scalar_tower 𝕜 𝕜' F] +variables {f : E → F} {f' : E →L[𝕜'] F} {s : set E} {x : E} + +lemma has_strict_fderiv_at.restrict_scalars (h : has_strict_fderiv_at f f' x) : + has_strict_fderiv_at f (f'.restrict_scalars 𝕜) x := h + +lemma has_fderiv_at_filter.restrict_scalars {L} (h : has_fderiv_at_filter f f' x L) : + has_fderiv_at_filter f (f'.restrict_scalars 𝕜) x L := h + +lemma has_fderiv_at.restrict_scalars (h : has_fderiv_at f f' x) : + has_fderiv_at f (f'.restrict_scalars 𝕜) x := h + +lemma has_fderiv_within_at.restrict_scalars (h : has_fderiv_within_at f f' s x) : + has_fderiv_within_at f (f'.restrict_scalars 𝕜) s x := h + +lemma differentiable_at.restrict_scalars (h : differentiable_at 𝕜' f x) : + differentiable_at 𝕜 f x := +(h.has_fderiv_at.restrict_scalars 𝕜).differentiable_at + +lemma differentiable_within_at.restrict_scalars (h : differentiable_within_at 𝕜' f s x) : + differentiable_within_at 𝕜 f s x := +(h.has_fderiv_within_at.restrict_scalars 𝕜).differentiable_within_at + +lemma differentiable_on.restrict_scalars (h : differentiable_on 𝕜' f s) : + differentiable_on 𝕜 f s := +λx hx, (h x hx).restrict_scalars 𝕜 + +lemma differentiable.restrict_scalars (h : differentiable 𝕜' f) : + differentiable 𝕜 f := +λx, (h x).restrict_scalars 𝕜 + +lemma has_fderiv_within_at_of_restrict_scalars + {g' : E →L[𝕜] F} (h : has_fderiv_within_at f g' s x) + (H : f'.restrict_scalars 𝕜 = g') : has_fderiv_within_at f f' s x := +by { rw ← H at h, exact h } + +lemma has_fderiv_at_of_restrict_scalars {g' : E →L[𝕜] F} (h : has_fderiv_at f g' x) + (H : f'.restrict_scalars 𝕜 = g') : has_fderiv_at f f' x := +by { rw ← H at h, exact h } + +lemma differentiable_at.fderiv_restrict_scalars (h : differentiable_at 𝕜' f x) : + fderiv 𝕜 f x = (fderiv 𝕜' f x).restrict_scalars 𝕜 := +(h.has_fderiv_at.restrict_scalars 𝕜).fderiv + +lemma differentiable_within_at_iff_restrict_scalars + (hf : differentiable_within_at 𝕜 f s x) (hs : unique_diff_within_at 𝕜 s x) : + differentiable_within_at 𝕜' f s x ↔ + ∃ (g' : E →L[𝕜'] F), g'.restrict_scalars 𝕜 = fderiv_within 𝕜 f s x := +begin + split, + { rintros ⟨g', hg'⟩, + exact ⟨g', hs.eq (hg'.restrict_scalars 𝕜) hf.has_fderiv_within_at⟩, }, + { rintros ⟨f', hf'⟩, + exact ⟨f', has_fderiv_within_at_of_restrict_scalars 𝕜 hf.has_fderiv_within_at hf'⟩, }, +end + +lemma differentiable_at_iff_restrict_scalars (hf : differentiable_at 𝕜 f x) : + differentiable_at 𝕜' f x ↔ ∃ (g' : E →L[𝕜'] F), g'.restrict_scalars 𝕜 = fderiv 𝕜 f x := +begin + rw [← differentiable_within_at_univ, ← fderiv_within_univ], + exact differentiable_within_at_iff_restrict_scalars 𝕜 + hf.differentiable_within_at unique_diff_within_at_univ, +end + +end restrict_scalars diff --git a/src/analysis/calculus/fderiv/star.lean b/src/analysis/calculus/fderiv/star.lean new file mode 100644 index 0000000000000..4eaf7d6b21c33 --- /dev/null +++ b/src/analysis/calculus/fderiv/star.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import analysis.calculus.fderiv.linear +import analysis.calculus.fderiv.comp +import analysis.calculus.fderiv.equiv +import analysis.normed_space.star.basic + +/-! +# Star operations on derivatives + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For detailed documentation of the Fréchet derivative, +see the module docstring of `analysis/calculus/fderiv/basic.lean`. + +This file contains the usual formulas (and existence assertions) for the derivative of the star +operation. Note that these only apply when the field that the derivative is respect to has a trivial +star operation; which as should be expected rules out `𝕜 = ℂ`. +-/ + +open_locale classical + + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [star_ring 𝕜] [has_trivial_star 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [star_add_monoid F] [normed_space 𝕜 F] + [star_module 𝕜 F] [has_continuous_star F] + +variables {f : E → F} +variables {f' : E →L[𝕜] F} +variables (e : E →L[𝕜] F) +variables {x : E} +variables {s : set E} +variables {L : filter E} + +theorem has_strict_fderiv_at.star (h : has_strict_fderiv_at f f' x) : + has_strict_fderiv_at (λ x, star (f x)) (((starL' 𝕜 : F ≃L[𝕜] F) : F →L[𝕜] F) ∘L f') x := +(starL' 𝕜 : F ≃L[𝕜] F).to_continuous_linear_map.has_strict_fderiv_at.comp x h + +theorem has_fderiv_at_filter.star (h : has_fderiv_at_filter f f' x L) : + has_fderiv_at_filter (λ x, star (f x)) (((starL' 𝕜 : F ≃L[𝕜] F) : F →L[𝕜] F) ∘L f') x L := +(starL' 𝕜 : F ≃L[𝕜] F).to_continuous_linear_map.has_fderiv_at_filter.comp x h filter.tendsto_map + +theorem has_fderiv_within_at.star (h : has_fderiv_within_at f f' s x) : + has_fderiv_within_at (λ x, star (f x)) (((starL' 𝕜 : F ≃L[𝕜] F) : F →L[𝕜] F) ∘L f') s x := +h.star + +theorem has_fderiv_at.star (h : has_fderiv_at f f' x) : + has_fderiv_at (λ x, star (f x)) (((starL' 𝕜 : F ≃L[𝕜] F) : F →L[𝕜] F) ∘L f') x := +h.star + +lemma differentiable_within_at.star (h : differentiable_within_at 𝕜 f s x) : + differentiable_within_at 𝕜 (λ y, star (f y)) s x := +h.has_fderiv_within_at.star.differentiable_within_at + +@[simp] lemma differentiable_within_at_star_iff : + differentiable_within_at 𝕜 (λ y, star (f y)) s x ↔ differentiable_within_at 𝕜 f s x := +(starL' 𝕜 : F ≃L[𝕜] F).comp_differentiable_within_at_iff + +lemma differentiable_at.star (h : differentiable_at 𝕜 f x) : + differentiable_at 𝕜 (λ y, star (f y)) x := +h.has_fderiv_at.star.differentiable_at + +@[simp] lemma differentiable_at_star_iff : + differentiable_at 𝕜 (λ y, star (f y)) x ↔ differentiable_at 𝕜 f x := +(starL' 𝕜 : F ≃L[𝕜] F).comp_differentiable_at_iff + +lemma differentiable_on.star (h : differentiable_on 𝕜 f s) : + differentiable_on 𝕜 (λ y, star (f y)) s := +λ x hx, (h x hx).star + +@[simp] lemma differentiable_on_star_iff : + differentiable_on 𝕜 (λ y, star (f y)) s ↔ differentiable_on 𝕜 f s := +(starL' 𝕜 : F ≃L[𝕜] F).comp_differentiable_on_iff + +lemma differentiable.star (h : differentiable 𝕜 f) : + differentiable 𝕜 (λ y, star (f y)) := +λx, (h x).star + +@[simp] lemma differentiable_star_iff : differentiable 𝕜 (λ y, star (f y)) ↔ differentiable 𝕜 f := +(starL' 𝕜 : F ≃L[𝕜] F).comp_differentiable_iff + +lemma fderiv_within_star (hxs : unique_diff_within_at 𝕜 s x) : + fderiv_within 𝕜 (λ y, star (f y)) s x = + ((starL' 𝕜 : F ≃L[𝕜] F) : F →L[𝕜] F) ∘L fderiv_within 𝕜 f s x := +(starL' 𝕜 : F ≃L[𝕜] F).comp_fderiv_within hxs + +@[simp] lemma fderiv_star : + fderiv 𝕜 (λ y, star (f y)) x = ((starL' 𝕜 : F ≃L[𝕜] F) : F →L[𝕜] F) ∘L fderiv 𝕜 f x := +(starL' 𝕜 : F ≃L[𝕜] F).comp_fderiv diff --git a/src/analysis/calculus/fderiv_analytic.lean b/src/analysis/calculus/fderiv_analytic.lean index b18d50ad74cf4..59431d132384c 100644 --- a/src/analysis/calculus/fderiv_analytic.lean +++ b/src/analysis/calculus/fderiv_analytic.lean @@ -3,13 +3,16 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import analysis.calculus.deriv import analysis.analytic.basic -import analysis.calculus.cont_diff +import analysis.calculus.deriv.basic +import analysis.calculus.cont_diff_def /-! # Frechet derivatives of analytic functions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A function expressible as a power series at a point has a Frechet derivative there. Also the special case in terms of `deriv` when the domain is 1-dimensional. -/ @@ -17,9 +20,9 @@ Also the special case in terms of `deriv` when the domain is 1-dimensional. open filter asymptotics open_locale ennreal -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] section fderiv @@ -30,7 +33,7 @@ lemma has_fpower_series_at.has_strict_fderiv_at (h : has_fpower_series_at f p x) has_strict_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p 1)) x := begin refine h.is_O_image_sub_norm_mul_norm_sub.trans_is_o (is_o.of_norm_right _), - refine is_o_iff_exists_eq_mul.2 ⟨λ y, ∥y - (x, x)∥, _, eventually_eq.rfl⟩, + refine is_o_iff_exists_eq_mul.2 ⟨λ y, ‖y - (x, x)‖, _, eventually_eq.rfl⟩, refine (continuous_id.sub continuous_const).norm.tendsto' _ _ _, rw [_root_.id, sub_self, norm_zero] end @@ -64,12 +67,12 @@ lemma analytic_on.differentiable_on (h : analytic_on 𝕜 f s) : λ y hy, (h y hy).differentiable_within_at lemma has_fpower_series_on_ball.has_fderiv_at [complete_space F] - (h : has_fpower_series_on_ball f p x r) {y : E} (hy : (∥y∥₊ : ℝ≥0∞) < r) : + (h : has_fpower_series_on_ball f p x r) {y : E} (hy : (‖y‖₊ : ℝ≥0∞) < r) : has_fderiv_at f (continuous_multilinear_curry_fin1 𝕜 E F (p.change_origin y 1)) (x + y) := (h.change_origin hy).has_fpower_series_at.has_fderiv_at lemma has_fpower_series_on_ball.fderiv_eq [complete_space F] - (h : has_fpower_series_on_ball f p x r) {y : E} (hy : (∥y∥₊ : ℝ≥0∞) < r) : + (h : has_fpower_series_on_ball f p x r) {y : E} (hy : (‖y‖₊ : ℝ≥0∞) < r) : fderiv 𝕜 f (x + y) = continuous_multilinear_curry_fin1 𝕜 E F (p.change_origin y 1) := (h.has_fderiv_at hy).fderiv @@ -121,7 +124,7 @@ begin end /-- An analytic function is infinitely differentiable. -/ -lemma analytic_on.cont_diff_on [complete_space F] (h : analytic_on 𝕜 f s) {n : with_top ℕ} : +lemma analytic_on.cont_diff_on [complete_space F] (h : analytic_on 𝕜 f s) {n : ℕ∞} : cont_diff_on 𝕜 n f s := begin let t := {x | analytic_at 𝕜 f x}, diff --git a/src/analysis/calculus/fderiv_measurable.lean b/src/analysis/calculus/fderiv_measurable.lean index f2090ae5b51eb..d3471ac69dd07 100644 --- a/src/analysis/calculus/fderiv_measurable.lean +++ b/src/analysis/calculus/fderiv_measurable.lean @@ -3,14 +3,16 @@ Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel, Yury Kudryashov -/ -import analysis.calculus.deriv -import measure_theory.constructions.borel_space -import measure_theory.function.strongly_measurable -import tactic.ring_exp +import analysis.calculus.deriv.basic +import measure_theory.constructions.borel_space.continuous_linear_map +import measure_theory.function.strongly_measurable.basic /-! # Derivative is measurable +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that the derivative of any function with complete codomain is a measurable function. Namely, we prove: @@ -20,6 +22,10 @@ function. Namely, we prove: is measurable; * `measurable_deriv`: the function `deriv f` is measurable (for `f : 𝕜 → F`). +We also show the same results for the right derivative on the real line +(see `measurable_deriv_within_Ici` and ``measurable_deriv_within_Ioi`), following the same +proof strategy. + ## Implementation We give a proof that avoids second-countability issues, by expressing the differentiability set @@ -46,7 +52,7 @@ differentiability exactly says that the map is well approximated by `L`). This i For the other direction, the difficulty is that `L` in the union may depend on `ε, r, s`. The key point is that, in fact, it doesn't depend too much on them. First, if `x` belongs both to `A (L, r, ε)` and `A (L', r, ε)`, then `L` and `L'` have to be close on a shell, and thus -`∥L - L'∥` is bounded by `ε` (see `norm_sub_le_of_mem_A`). Assume now `x ∈ D`. If one has two maps +`‖L - L'‖` is bounded by `ε` (see `norm_sub_le_of_mem_A`). Assume now `x ∈ D`. If one has two maps `L` and `L'` such that `x` belongs to `A (L, r, ε)` and to `A (L', r', ε')`, one deduces that `L` is close to `L'` by arguing as follows. Consider another scale `s` smaller than `r` and `r'`. Take a linear map `L₁` that approximates `f` around `x` both at scales `r` and `s` w.r.t. `ε` (it exists as @@ -72,12 +78,12 @@ noncomputable theory open set metric asymptotics filter continuous_linear_map open topological_space (second_countable_topology) measure_theory -open_locale topological_space +open_locale topology namespace continuous_linear_map -variables {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜] - [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F] +variables {𝕜 E F : Type*} [nontrivially_normed_field 𝕜] + [normed_add_comm_group E] [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F] lemma measurable_apply₂ [measurable_space E] [opens_measurable_space E] [second_countable_topology E] [second_countable_topology (E →L[𝕜] F)] @@ -87,9 +93,11 @@ is_bounded_bilinear_map_apply.continuous.measurable end continuous_linear_map -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] +section fderiv + +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] variables {f : E → F} (K : set (E →L[𝕜] F)) namespace fderiv_measurable_aux @@ -98,7 +106,7 @@ namespace fderiv_measurable_aux at scale `r` by the linear map `L`, up to an error `ε`. We tweak the definition to make sure that this is an open set.-/ def A (f : E → F) (L : E →L[𝕜] F) (r ε : ℝ) : set E := -{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ ball x r', ∥f z - f y - L (z-y)∥ ≤ ε * r} +{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ ball x r', ‖f z - f y - L (z-y)‖ ≤ ε * r} /-- The set `B f K r s ε` is the set of points `x` around which there exists a continuous linear map `L` belonging to `K` (a given set of continuous linear maps) that approximates well the @@ -137,7 +145,7 @@ end lemma le_of_mem_A {r ε : ℝ} {L : E →L[𝕜] F} {x : E} (hx : x ∈ A f L r ε) {y z : E} (hy : y ∈ closed_ball x (r/2)) (hz : z ∈ closed_ball x (r/2)) : - ∥f z - f y - L (z-y)∥ ≤ ε * r := + ‖f z - f y - L (z-y)‖ ≤ ε * r := begin rcases hx with ⟨r', r'mem, hr'⟩, exact hr' _ ((mem_closed_ball.1 hy).trans_lt r'mem.1) _ ((mem_closed_ball.1 hz).trans_lt r'mem.1) @@ -152,12 +160,12 @@ begin refine ⟨R, R_pos, λ r hr, _⟩, have : r ∈ Ioc (r/2) r := ⟨half_lt_self hr.1, le_rfl⟩, refine ⟨r, this, λ y hy z hz, _⟩, - calc ∥f z - f y - (fderiv 𝕜 f x) (z - y)∥ - = ∥(f z - f x - (fderiv 𝕜 f x) (z - x)) - (f y - f x - (fderiv 𝕜 f x) (y - x))∥ : + calc ‖f z - f y - (fderiv 𝕜 f x) (z - y)‖ + = ‖(f z - f x - (fderiv 𝕜 f x) (z - x)) - (f y - f x - (fderiv 𝕜 f x) (y - x))‖ : by { congr' 1, simp only [continuous_linear_map.map_sub], abel } - ... ≤ ∥(f z - f x - (fderiv 𝕜 f x) (z - x))∥ + ∥f y - f x - (fderiv 𝕜 f x) (y - x)∥ : + ... ≤ ‖(f z - f x - (fderiv 𝕜 f x) (z - x))‖ + ‖f y - f x - (fderiv 𝕜 f x) (y - x)‖ : norm_sub_le _ _ - ... ≤ ε / 2 * ∥z - x∥ + ε / 2 * ∥y - x∥ : + ... ≤ ε / 2 * ‖z - x‖ + ε / 2 * ‖y - x‖ : add_le_add (hR _ (lt_trans (mem_ball.1 hz) hr.2)) (hR _ (lt_trans (mem_ball.1 hy) hr.2)) ... ≤ ε / 2 * r + ε / 2 * r : add_le_add @@ -166,19 +174,19 @@ begin ... = ε * r : by ring end -lemma norm_sub_le_of_mem_A {c : 𝕜} (hc : 1 < ∥c∥) +lemma norm_sub_le_of_mem_A {c : 𝕜} (hc : 1 < ‖c‖) {r ε : ℝ} (hε : 0 < ε) (hr : 0 < r) {x : E} {L₁ L₂ : E →L[𝕜] F} - (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ∥L₁ - L₂∥ ≤ 4 * ∥c∥ * ε := + (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ‖L₁ - L₂‖ ≤ 4 * ‖c‖ * ε := begin - have : 0 ≤ 4 * ∥c∥ * ε := + have : 0 ≤ 4 * ‖c‖ * ε := mul_nonneg (mul_nonneg (by norm_num : (0 : ℝ) ≤ 4) (norm_nonneg _)) hε.le, refine op_norm_le_of_shell (half_pos hr) this hc _, assume y ley ylt, - rw [div_div_eq_div_mul, + rw [div_div, div_le_iff' (mul_pos (by norm_num : (0 : ℝ) < 2) (zero_lt_one.trans hc))] at ley, - calc ∥(L₁ - L₂) y∥ - = ∥(f (x + y) - f x - L₂ ((x + y) - x)) - (f (x + y) - f x - L₁ ((x + y) - x))∥ : by simp - ... ≤ ∥(f (x + y) - f x - L₂ ((x + y) - x))∥ + ∥(f (x + y) - f x - L₁ ((x + y) - x))∥ : + calc ‖(L₁ - L₂) y‖ + = ‖(f (x + y) - f x - L₂ ((x + y) - x)) - (f (x + y) - f x - L₁ ((x + y) - x))‖ : by simp + ... ≤ ‖(f (x + y) - f x - L₂ ((x + y) - x))‖ + ‖(f (x + y) - f x - L₁ ((x + y) - x))‖ : norm_sub_le _ _ ... ≤ ε * r + ε * r : begin @@ -191,8 +199,8 @@ begin { simp only [dist_eq_norm, add_sub_cancel', mem_closed_ball, ylt.le] } }, end ... = 2 * ε * r : by ring - ... ≤ 2 * ε * (2 * ∥c∥ * ∥y∥) : mul_le_mul_of_nonneg_left ley (mul_nonneg (by norm_num) hε.le) - ... = 4 * ∥c∥ * ε * ∥y∥ : by ring + ... ≤ 2 * ε * (2 * ‖c‖ * ‖y‖) : mul_le_mul_of_nonneg_left ley (mul_nonneg (by norm_num) hε.le) + ... = 4 * ‖c‖ * ε * ‖y‖ : by ring end /-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/ @@ -205,7 +213,7 @@ begin rcases mem_A_of_differentiable this hx.1 with ⟨R, R_pos, hR⟩, obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2) ^ n < R := exists_pow_lt_of_lt_one R_pos (by norm_num : (1 : ℝ)/2 < 1), - simp only [mem_Union, mem_Inter, B, mem_inter_eq], + simp only [mem_Union, mem_Inter, B, mem_inter_iff], refine ⟨n, λ p hp q hq, ⟨fderiv 𝕜 f x, hx.2, ⟨_, _⟩⟩⟩; { refine hR _ ⟨pow_pos (by norm_num) _, lt_of_le_of_lt _ hn⟩, exact pow_le_pow_of_le_one (by norm_num) (by norm_num) (by assumption) } @@ -217,7 +225,7 @@ lemma D_subset_differentiable_set {K : set (E →L[𝕜] F)} (hK : is_complete K begin have P : ∀ {n : ℕ}, (0 : ℝ) < (1/2) ^ n := pow_pos (by norm_num), rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, - have cpos : 0 < ∥c∥ := lt_trans zero_lt_one hc, + have cpos : 0 < ‖c‖ := lt_trans zero_lt_one hc, assume x hx, have : ∀ (e : ℕ), ∃ (n : ℕ), ∀ p q, n ≤ p → n ≤ q → ∃ L ∈ K, x ∈ A f L ((1/2) ^ p) ((1/2) ^ e) ∩ A f L ((1/2) ^ q) ((1/2) ^ e), @@ -238,55 +246,55 @@ begin `2 ^ (- r)`. And `L e' p' r` is close to `L e' p' q'` as both approximate `f` at scale `2 ^ (- p')`. -/ have M : ∀ e p q e' p' q', n e ≤ p → n e ≤ q → n e' ≤ p' → n e' ≤ q' → e ≤ e' → - ∥L e p q - L e' p' q'∥ ≤ 12 * ∥c∥ * (1/2) ^ e, + ‖L e p q - L e' p' q'‖ ≤ 12 * ‖c‖ * (1/2) ^ e, { assume e p q e' p' q' hp hq hp' hq' he', let r := max (n e) (n e'), have I : ((1:ℝ)/2)^e' ≤ (1/2)^e := pow_le_pow_of_le_one (by norm_num) (by norm_num) he', - have J1 : ∥L e p q - L e p r∥ ≤ 4 * ∥c∥ * (1/2)^e, + have J1 : ‖L e p q - L e p r‖ ≤ 4 * ‖c‖ * (1/2)^e, { have I1 : x ∈ A f (L e p q) ((1 / 2) ^ p) ((1/2)^e) := (hn e p q hp hq).2.1, have I2 : x ∈ A f (L e p r) ((1 / 2) ^ p) ((1/2)^e) := (hn e p r hp (le_max_left _ _)).2.1, exact norm_sub_le_of_mem_A hc P P I1 I2 }, - have J2 : ∥L e p r - L e' p' r∥ ≤ 4 * ∥c∥ * (1/2)^e, + have J2 : ‖L e p r - L e' p' r‖ ≤ 4 * ‖c‖ * (1/2)^e, { have I1 : x ∈ A f (L e p r) ((1 / 2) ^ r) ((1/2)^e) := (hn e p r hp (le_max_left _ _)).2.2, have I2 : x ∈ A f (L e' p' r) ((1 / 2) ^ r) ((1/2)^e') := (hn e' p' r hp' (le_max_right _ _)).2.2, exact norm_sub_le_of_mem_A hc P P I1 (A_mono _ _ I I2) }, - have J3 : ∥L e' p' r - L e' p' q'∥ ≤ 4 * ∥c∥ * (1/2)^e, + have J3 : ‖L e' p' r - L e' p' q'‖ ≤ 4 * ‖c‖ * (1/2)^e, { have I1 : x ∈ A f (L e' p' r) ((1 / 2) ^ p') ((1/2)^e') := (hn e' p' r hp' (le_max_right _ _)).2.1, have I2 : x ∈ A f (L e' p' q') ((1 / 2) ^ p') ((1/2)^e') := (hn e' p' q' hp' hq').2.1, exact norm_sub_le_of_mem_A hc P P (A_mono _ _ I I1) (A_mono _ _ I I2) }, - calc ∥L e p q - L e' p' q'∥ - = ∥(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')∥ : + calc ‖L e p q - L e' p' q'‖ + = ‖(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')‖ : by { congr' 1, abel } - ... ≤ ∥L e p q - L e p r∥ + ∥L e p r - L e' p' r∥ + ∥L e' p' r - L e' p' q'∥ : + ... ≤ ‖L e p q - L e p r‖ + ‖L e p r - L e' p' r‖ + ‖L e' p' r - L e' p' q'‖ : le_trans (norm_add_le _ _) (add_le_add_right (norm_add_le _ _) _) - ... ≤ 4 * ∥c∥ * (1/2)^e + 4 * ∥c∥ * (1/2)^e + 4 * ∥c∥ * (1/2)^e : + ... ≤ 4 * ‖c‖ * (1/2)^e + 4 * ‖c‖ * (1/2)^e + 4 * ‖c‖ * (1/2)^e : by apply_rules [add_le_add] - ... = 12 * ∥c∥ * (1/2)^e : by ring }, + ... = 12 * ‖c‖ * (1/2)^e : by ring }, /- For definiteness, use `L0 e = L e (n e) (n e)`, to have a single sequence. We claim that this is a Cauchy sequence. -/ let L0 : ℕ → (E →L[𝕜] F) := λ e, L e (n e) (n e), have : cauchy_seq L0, { rw metric.cauchy_seq_iff', assume ε εpos, - obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / (12 * ∥c∥) := + obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / (12 * ‖c‖) := exists_pow_lt_of_lt_one (div_pos εpos (mul_pos (by norm_num) cpos)) (by norm_num), refine ⟨e, λ e' he', _⟩, rw [dist_comm, dist_eq_norm], - calc ∥L0 e - L0 e'∥ - ≤ 12 * ∥c∥ * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he' - ... < 12 * ∥c∥ * (ε / (12 * ∥c∥)) : + calc ‖L0 e - L0 e'‖ + ≤ 12 * ‖c‖ * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he' + ... < 12 * ‖c‖ * (ε / (12 * ‖c‖)) : mul_lt_mul' le_rfl he (le_of_lt P) (mul_pos (by norm_num) cpos) ... = ε : by { field_simp [(by norm_num : (12 : ℝ) ≠ 0), ne_of_gt cpos], ring } }, /- As it is Cauchy, the sequence `L0` converges, to a limit `f'` in `K`.-/ obtain ⟨f', f'K, hf'⟩ : ∃ f' ∈ K, tendsto L0 at_top (𝓝 f') := cauchy_seq_tendsto_of_is_complete hK (λ e, (hn e (n e) (n e) le_rfl le_rfl).1) this, - have Lf' : ∀ e p, n e ≤ p → ∥L e (n e) p - f'∥ ≤ 12 * ∥c∥ * (1/2)^e, + have Lf' : ∀ e p, n e ≤ p → ‖L e (n e) p - f'‖ ≤ 12 * ‖c‖ * (1/2)^e, { assume e p hp, apply le_of_tendsto (tendsto_const_nhds.sub hf').norm, rw eventually_at_top, @@ -299,21 +307,21 @@ begin this makes it possible to cover all scales, and thus to obtain a good linear approximation in the whole ball of radius `(1/2)^(n e)`. -/ assume ε εpos, - have pos : 0 < 4 + 12 * ∥c∥ := + have pos : 0 < 4 + 12 * ‖c‖ := add_pos_of_pos_of_nonneg (by norm_num) (mul_nonneg (by norm_num) (norm_nonneg _)), - obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / (4 + 12 * ∥c∥) := + obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / (4 + 12 * ‖c‖) := exists_pow_lt_of_lt_one (div_pos εpos pos) (by norm_num), rw eventually_nhds_iff_ball, refine ⟨(1/2) ^ (n e + 1), P, λ y hy, _⟩, -- We need to show that `f (x + y) - f x - f' y` is small. For this, we will work at scale - -- `k` where `k` is chosen with `∥y∥ ∼ 2 ^ (-k)`. + -- `k` where `k` is chosen with `‖y‖ ∼ 2 ^ (-k)`. by_cases y_pos : y = 0, {simp [y_pos] }, - have yzero : 0 < ∥y∥ := norm_pos_iff.mpr y_pos, - have y_lt : ∥y∥ < (1/2) ^ (n e + 1), by simpa using mem_ball_iff_norm.1 hy, - have yone : ∥y∥ ≤ 1 := + have yzero : 0 < ‖y‖ := norm_pos_iff.mpr y_pos, + have y_lt : ‖y‖ < (1/2) ^ (n e + 1), by simpa using mem_ball_iff_norm.1 hy, + have yone : ‖y‖ ≤ 1 := le_trans (y_lt.le) (pow_le_one _ (by norm_num) (by norm_num)), -- define the scale `k`. - obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < ∥y∥ ∧ ∥y∥ ≤ (1/2) ^ k := + obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < ‖y‖ ∧ ‖y‖ ≤ (1/2) ^ k := exists_nat_pow_near_of_lt_one yzero yone (by norm_num : (0 : ℝ) < 1/2) (by norm_num : (1 : ℝ)/2 < 1), -- the scale is large enough (as `y` is small enough) @@ -327,31 +335,31 @@ begin rw km at hk h'k, -- `f` is well approximated by `L e (n e) k` at the relevant scale -- (in fact, we use `m = k - 1` instead of `k` because of the precise definition of `A`). - have J1 : ∥f (x + y) - f x - L e (n e) m ((x + y) - x)∥ ≤ (1/2) ^ e * (1/2) ^ m, + have J1 : ‖f (x + y) - f x - L e (n e) m ((x + y) - x)‖ ≤ (1/2) ^ e * (1/2) ^ m, { apply le_of_mem_A (hn e (n e) m le_rfl m_ge).2.2, { simp only [mem_closed_ball, dist_self], exact div_nonneg (le_of_lt P) (zero_le_two) }, { simpa only [dist_eq_norm, add_sub_cancel', mem_closed_ball, pow_succ', mul_one_div] using h'k } }, - have J2 : ∥f (x + y) - f x - L e (n e) m y∥ ≤ 4 * (1/2) ^ e * ∥y∥ := calc - ∥f (x + y) - f x - L e (n e) m y∥ ≤ (1/2) ^ e * (1/2) ^ m : + have J2 : ‖f (x + y) - f x - L e (n e) m y‖ ≤ 4 * (1/2) ^ e * ‖y‖ := calc + ‖f (x + y) - f x - L e (n e) m y‖ ≤ (1/2) ^ e * (1/2) ^ m : by simpa only [add_sub_cancel'] using J1 ... = 4 * (1/2) ^ e * (1/2) ^ (m + 2) : by { field_simp, ring_exp } - ... ≤ 4 * (1/2) ^ e * ∥y∥ : + ... ≤ 4 * (1/2) ^ e * ‖y‖ : mul_le_mul_of_nonneg_left (le_of_lt hk) (mul_nonneg (by norm_num) (le_of_lt P)), -- use the previous estimates to see that `f (x + y) - f x - f' y` is small. - calc ∥f (x + y) - f x - f' y∥ - = ∥(f (x + y) - f x - L e (n e) m y) + (L e (n e) m - f') y∥ : + calc ‖f (x + y) - f x - f' y‖ + = ‖(f (x + y) - f x - L e (n e) m y) + (L e (n e) m - f') y‖ : congr_arg _ (by simp) - ... ≤ 4 * (1/2) ^ e * ∥y∥ + 12 * ∥c∥ * (1/2) ^ e * ∥y∥ : + ... ≤ 4 * (1/2) ^ e * ‖y‖ + 12 * ‖c‖ * (1/2) ^ e * ‖y‖ : norm_add_le_of_le J2 ((le_op_norm _ _).trans (mul_le_mul_of_nonneg_right (Lf' _ _ m_ge) (norm_nonneg _))) - ... = (4 + 12 * ∥c∥) * ∥y∥ * (1/2) ^ e : by ring - ... ≤ (4 + 12 * ∥c∥) * ∥y∥ * (ε / (4 + 12 * ∥c∥)) : + ... = (4 + 12 * ‖c‖) * ‖y‖ * (1/2) ^ e : by ring + ... ≤ (4 + 12 * ‖c‖) * ‖y‖ * (ε / (4 + 12 * ‖c‖)) : mul_le_mul_of_nonneg_left he.le (mul_nonneg (add_nonneg (by norm_num) (mul_nonneg (by norm_num) (norm_nonneg _))) (norm_nonneg _)) - ... = ε * ∥y∥ : by { field_simp [ne_of_gt pos], ring } }, + ... = ε * ‖y‖ : by { field_simp [ne_of_gt pos], ring } }, rw ← this.fderiv at f'K, exact ⟨this.differentiable_at, f'K⟩ end @@ -372,8 +380,8 @@ is Borel-measurable. -/ theorem measurable_set_of_differentiable_at_of_is_complete {K : set (E →L[𝕜] F)} (hK : is_complete K) : measurable_set {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ K} := -by simp [differentiable_set_eq_D K hK, D, is_open_B.measurable_set, measurable_set.Inter_Prop, - measurable_set.Inter, measurable_set.Union] +by simp [differentiable_set_eq_D K hK, D, is_open_B.measurable_set, measurable_set.Inter, + measurable_set.Union] variable [complete_space F] @@ -391,11 +399,11 @@ end begin refine measurable_of_is_closed (λ s hs, _), have : fderiv 𝕜 f ⁻¹' s = {x | differentiable_at 𝕜 f x ∧ fderiv 𝕜 f x ∈ s} ∪ - {x | (0 : E →L[𝕜] F) ∈ s} ∩ {x | ¬differentiable_at 𝕜 f x} := + ({x | ¬differentiable_at 𝕜 f x} ∩ {x | (0 : E →L[𝕜] F) ∈ s}) := set.ext (λ x, mem_preimage.trans fderiv_mem_iff), rw this, exact (measurable_set_of_differentiable_at_of_is_complete _ _ hs.is_complete).union - ((measurable_set.const _).inter (measurable_set_of_differentiable_at _ _).compl) + ((measurable_set_of_differentiable_at _ _).compl.inter (measurable_set.const _)) end @[measurability] lemma measurable_fderiv_apply_const [measurable_space F] [borel_space F] (y : E) : @@ -421,3 +429,368 @@ lemma ae_strongly_measurable_deriv [measurable_space 𝕜] [opens_measurable_spa [second_countable_topology F] (f : 𝕜 → F) (μ : measure 𝕜) : ae_strongly_measurable (deriv f) μ := (strongly_measurable_deriv f).ae_strongly_measurable + +end fderiv + +section right_deriv + +variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] +variables {f : ℝ → F} (K : set F) + +namespace right_deriv_measurable_aux + +/-- The set `A f L r ε` is the set of points `x` around which the function `f` is well approximated +at scale `r` by the linear map `h ↦ h • L`, up to an error `ε`. We tweak the definition to +make sure that this is open on the right. -/ +def A (f : ℝ → F) (L : F) (r ε : ℝ) : set ℝ := +{x | ∃ r' ∈ Ioc (r/2) r, ∀ y z ∈ Icc x (x + r'), ‖f z - f y - (z-y) • L‖ ≤ ε * r} + +/-- The set `B f K r s ε` is the set of points `x` around which there exists a vector +`L` belonging to `K` (a given set of vectors) such that `h • L` approximates well `f (x + h)` +(up to an error `ε`), simultaneously at scales `r` and `s`. -/ +def B (f : ℝ → F) (K : set F) (r s ε : ℝ) : set ℝ := +⋃ (L ∈ K), (A f L r ε) ∩ (A f L s ε) + +/-- The set `D f K` is a complicated set constructed using countable intersections and unions. Its +main use is that, when `K` is complete, it is exactly the set of points where `f` is differentiable, +with a derivative in `K`. -/ +def D (f : ℝ → F) (K : set F) : set ℝ := +⋂ (e : ℕ), ⋃ (n : ℕ), ⋂ (p ≥ n) (q ≥ n), B f K ((1/2) ^ p) ((1/2) ^ q) ((1/2) ^ e) + +lemma A_mem_nhds_within_Ioi {L : F} {r ε x : ℝ} (hx : x ∈ A f L r ε) : + A f L r ε ∈ 𝓝[>] x := +begin + rcases hx with ⟨r', rr', hr'⟩, + rw mem_nhds_within_Ioi_iff_exists_Ioo_subset, + obtain ⟨s, s_gt, s_lt⟩ : ∃ (s : ℝ), r / 2 < s ∧ s < r' := exists_between rr'.1, + have : s ∈ Ioc (r/2) r := ⟨s_gt, le_of_lt (s_lt.trans_le rr'.2)⟩, + refine ⟨x + r' - s, by { simp only [mem_Ioi], linarith }, λ x' hx', ⟨s, this, _⟩⟩, + have A : Icc x' (x' + s) ⊆ Icc x (x + r'), + { apply Icc_subset_Icc hx'.1.le, + linarith [hx'.2] }, + assume y hy z hz, + exact hr' y (A hy) z (A hz) +end + +lemma B_mem_nhds_within_Ioi {K : set F} {r s ε x : ℝ} (hx : x ∈ B f K r s ε) : + B f K r s ε ∈ 𝓝[>] x := +begin + obtain ⟨L, LK, hL₁, hL₂⟩ : ∃ (L : F), L ∈ K ∧ x ∈ A f L r ε ∧ x ∈ A f L s ε, + by simpa only [B, mem_Union, mem_inter_iff, exists_prop] using hx, + filter_upwards [A_mem_nhds_within_Ioi hL₁, A_mem_nhds_within_Ioi hL₂] with y hy₁ hy₂, + simp only [B, mem_Union, mem_inter_iff, exists_prop], + exact ⟨L, LK, hy₁, hy₂⟩ +end + +lemma measurable_set_B {K : set F} {r s ε : ℝ} : measurable_set (B f K r s ε) := +measurable_set_of_mem_nhds_within_Ioi (λ x hx, B_mem_nhds_within_Ioi hx) + +lemma A_mono (L : F) (r : ℝ) {ε δ : ℝ} (h : ε ≤ δ) : + A f L r ε ⊆ A f L r δ := +begin + rintros x ⟨r', r'r, hr'⟩, + refine ⟨r', r'r, λ y hy z hz, (hr' y hy z hz).trans (mul_le_mul_of_nonneg_right h _)⟩, + linarith [hy.1, hy.2, r'r.2], +end + +lemma le_of_mem_A {r ε : ℝ} {L : F} {x : ℝ} (hx : x ∈ A f L r ε) + {y z : ℝ} (hy : y ∈ Icc x (x + r/2)) (hz : z ∈ Icc x (x + r/2)) : + ‖f z - f y - (z-y) • L‖ ≤ ε * r := +begin + rcases hx with ⟨r', r'mem, hr'⟩, + have A : x + r / 2 ≤ x + r', by linarith [r'mem.1], + exact hr' _ ((Icc_subset_Icc le_rfl A) hy) _ ((Icc_subset_Icc le_rfl A) hz), +end + +lemma mem_A_of_differentiable {ε : ℝ} (hε : 0 < ε) {x : ℝ} + (hx : differentiable_within_at ℝ f (Ici x) x) : + ∃ R > 0, ∀ r ∈ Ioo (0 : ℝ) R, x ∈ A f (deriv_within f (Ici x) x) r ε := +begin + have := hx.has_deriv_within_at, + simp_rw [has_deriv_within_at_iff_is_o, is_o_iff] at this, + rcases mem_nhds_within_Ici_iff_exists_Ico_subset.1 (this (half_pos hε)) with ⟨m, xm, hm⟩, + refine ⟨m - x, by linarith [show x < m, from xm], λ r hr, _⟩, + have : r ∈ Ioc (r/2) r := ⟨half_lt_self hr.1, le_rfl⟩, + refine ⟨r, this, λ y hy z hz, _⟩, + calc ‖f z - f y - (z - y) • deriv_within f (Ici x) x‖ + = ‖(f z - f x - (z - x) • deriv_within f (Ici x) x) + - (f y - f x - (y - x) • deriv_within f (Ici x) x)‖ : + by { congr' 1, simp only [sub_smul], abel } + ... ≤ ‖f z - f x - (z - x) • deriv_within f (Ici x) x‖ + + ‖f y - f x - (y - x) • deriv_within f (Ici x) x‖ : + norm_sub_le _ _ + ... ≤ ε / 2 * ‖z - x‖ + ε / 2 * ‖y - x‖ : + add_le_add (hm ⟨hz.1, hz.2.trans_lt (by linarith [hr.2])⟩) + (hm ⟨hy.1, hy.2.trans_lt (by linarith [hr.2])⟩) + ... ≤ ε / 2 * r + ε / 2 * r : + begin + apply add_le_add, + { apply mul_le_mul_of_nonneg_left _ (le_of_lt (half_pos hε)), + rw [real.norm_of_nonneg]; + linarith [hz.1, hz.2] }, + { apply mul_le_mul_of_nonneg_left _ (le_of_lt (half_pos hε)), + rw [real.norm_of_nonneg]; + linarith [hy.1, hy.2] }, + end + ... = ε * r : by ring +end + +lemma norm_sub_le_of_mem_A + {r x : ℝ} (hr : 0 < r) (ε : ℝ) {L₁ L₂ : F} + (h₁ : x ∈ A f L₁ r ε) (h₂ : x ∈ A f L₂ r ε) : ‖L₁ - L₂‖ ≤ 4 * ε := +begin + suffices H : ‖(r/2) • (L₁ - L₂)‖ ≤ (r / 2) * (4 * ε), + by rwa [norm_smul, real.norm_of_nonneg (half_pos hr).le, mul_le_mul_left (half_pos hr)] at H, + calc + ‖(r/2) • (L₁ - L₂)‖ + = ‖(f (x + r/2) - f x - (x + r/2 - x) • L₂) - (f (x + r/2) - f x - (x + r/2 - x) • L₁)‖ : + by simp [smul_sub] + ... ≤ ‖f (x + r/2) - f x - (x + r/2 - x) • L₂‖ + ‖f (x + r/2) - f x - (x + r/2 - x) • L₁‖ : + norm_sub_le _ _ + ... ≤ ε * r + ε * r : + begin + apply add_le_add, + { apply le_of_mem_A h₂; + simp [(half_pos hr).le] }, + { apply le_of_mem_A h₁; + simp [(half_pos hr).le] }, + end + ... = (r / 2) * (4 * ε) : by ring +end + +/-- Easy inclusion: a differentiability point with derivative in `K` belongs to `D f K`. -/ +lemma differentiable_set_subset_D : + {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} ⊆ D f K := +begin + assume x hx, + rw [D, mem_Inter], + assume e, + have : (0 : ℝ) < (1/2) ^ e := pow_pos (by norm_num) _, + rcases mem_A_of_differentiable this hx.1 with ⟨R, R_pos, hR⟩, + obtain ⟨n, hn⟩ : ∃ (n : ℕ), (1/2) ^ n < R := + exists_pow_lt_of_lt_one R_pos (by norm_num : (1 : ℝ)/2 < 1), + simp only [mem_Union, mem_Inter, B, mem_inter_iff], + refine ⟨n, λ p hp q hq, ⟨deriv_within f (Ici x) x, hx.2, ⟨_, _⟩⟩⟩; + { refine hR _ ⟨pow_pos (by norm_num) _, lt_of_le_of_lt _ hn⟩, + exact pow_le_pow_of_le_one (by norm_num) (by norm_num) (by assumption) } +end + +/-- Harder inclusion: at a point in `D f K`, the function `f` has a derivative, in `K`. -/ +lemma D_subset_differentiable_set {K : set F} (hK : is_complete K) : + D f K ⊆ {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} := +begin + have P : ∀ {n : ℕ}, (0 : ℝ) < (1/2) ^ n := pow_pos (by norm_num), + assume x hx, + have : ∀ (e : ℕ), ∃ (n : ℕ), ∀ p q, n ≤ p → n ≤ q → ∃ L ∈ K, + x ∈ A f L ((1/2) ^ p) ((1/2) ^ e) ∩ A f L ((1/2) ^ q) ((1/2) ^ e), + { assume e, + have := mem_Inter.1 hx e, + rcases mem_Union.1 this with ⟨n, hn⟩, + refine ⟨n, λ p q hp hq, _⟩, + simp only [mem_Inter, ge_iff_le] at hn, + rcases mem_Union.1 (hn p hp q hq) with ⟨L, hL⟩, + exact ⟨L, mem_Union.1 hL⟩, }, + /- Recast the assumptions: for each `e`, there exist `n e` and linear maps `L e p q` in `K` + such that, for `p, q ≥ n e`, then `f` is well approximated by `L e p q` at scale `2 ^ (-p)` and + `2 ^ (-q)`, with an error `2 ^ (-e)`. -/ + choose! n L hn using this, + /- All the operators `L e p q` that show up are close to each other. To prove this, we argue + that `L e p q` is close to `L e p r` (where `r` is large enough), as both approximate `f` at + scale `2 ^(- p)`. And `L e p r` is close to `L e' p' r` as both approximate `f` at scale + `2 ^ (- r)`. And `L e' p' r` is close to `L e' p' q'` as both approximate `f` at scale + `2 ^ (- p')`. -/ + have M : ∀ e p q e' p' q', n e ≤ p → n e ≤ q → n e' ≤ p' → n e' ≤ q' → e ≤ e' → + ‖L e p q - L e' p' q'‖ ≤ 12 * (1/2) ^ e, + { assume e p q e' p' q' hp hq hp' hq' he', + let r := max (n e) (n e'), + have I : ((1:ℝ)/2)^e' ≤ (1/2)^e := pow_le_pow_of_le_one (by norm_num) (by norm_num) he', + have J1 : ‖L e p q - L e p r‖ ≤ 4 * (1/2)^e, + { have I1 : x ∈ A f (L e p q) ((1 / 2) ^ p) ((1/2)^e) := + (hn e p q hp hq).2.1, + have I2 : x ∈ A f (L e p r) ((1 / 2) ^ p) ((1/2)^e) := + (hn e p r hp (le_max_left _ _)).2.1, + exact norm_sub_le_of_mem_A P _ I1 I2 }, + have J2 : ‖L e p r - L e' p' r‖ ≤ 4 * (1/2)^e, + { have I1 : x ∈ A f (L e p r) ((1 / 2) ^ r) ((1/2)^e) := + (hn e p r hp (le_max_left _ _)).2.2, + have I2 : x ∈ A f (L e' p' r) ((1 / 2) ^ r) ((1/2)^e') := + (hn e' p' r hp' (le_max_right _ _)).2.2, + exact norm_sub_le_of_mem_A P _ I1 (A_mono _ _ I I2) }, + have J3 : ‖L e' p' r - L e' p' q'‖ ≤ 4 * (1/2)^e, + { have I1 : x ∈ A f (L e' p' r) ((1 / 2) ^ p') ((1/2)^e') := + (hn e' p' r hp' (le_max_right _ _)).2.1, + have I2 : x ∈ A f (L e' p' q') ((1 / 2) ^ p') ((1/2)^e') := + (hn e' p' q' hp' hq').2.1, + exact norm_sub_le_of_mem_A P _ (A_mono _ _ I I1) (A_mono _ _ I I2) }, + calc ‖L e p q - L e' p' q'‖ + = ‖(L e p q - L e p r) + (L e p r - L e' p' r) + (L e' p' r - L e' p' q')‖ : + by { congr' 1, abel } + ... ≤ ‖L e p q - L e p r‖ + ‖L e p r - L e' p' r‖ + ‖L e' p' r - L e' p' q'‖ : + le_trans (norm_add_le _ _) (add_le_add_right (norm_add_le _ _) _) + ... ≤ 4 * (1/2)^e + 4 * (1/2)^e + 4 * (1/2)^e : + by apply_rules [add_le_add] + ... = 12 * (1/2)^e : by ring }, + /- For definiteness, use `L0 e = L e (n e) (n e)`, to have a single sequence. We claim that this + is a Cauchy sequence. -/ + let L0 : ℕ → F := λ e, L e (n e) (n e), + have : cauchy_seq L0, + { rw metric.cauchy_seq_iff', + assume ε εpos, + obtain ⟨e, he⟩ : ∃ (e : ℕ), (1/2) ^ e < ε / 12 := + exists_pow_lt_of_lt_one (div_pos εpos (by norm_num)) (by norm_num), + refine ⟨e, λ e' he', _⟩, + rw [dist_comm, dist_eq_norm], + calc ‖L0 e - L0 e'‖ + ≤ 12 * (1/2)^e : M _ _ _ _ _ _ le_rfl le_rfl le_rfl le_rfl he' + ... < 12 * (ε / 12) : + mul_lt_mul' le_rfl he (le_of_lt P) (by norm_num) + ... = ε : by { field_simp [(by norm_num : (12 : ℝ) ≠ 0)], ring } }, + /- As it is Cauchy, the sequence `L0` converges, to a limit `f'` in `K`.-/ + obtain ⟨f', f'K, hf'⟩ : ∃ f' ∈ K, tendsto L0 at_top (𝓝 f') := + cauchy_seq_tendsto_of_is_complete hK (λ e, (hn e (n e) (n e) le_rfl le_rfl).1) this, + have Lf' : ∀ e p, n e ≤ p → ‖L e (n e) p - f'‖ ≤ 12 * (1/2)^e, + { assume e p hp, + apply le_of_tendsto (tendsto_const_nhds.sub hf').norm, + rw eventually_at_top, + exact ⟨e, λ e' he', M _ _ _ _ _ _ le_rfl hp le_rfl le_rfl he'⟩ }, + /- Let us show that `f` has right derivative `f'` at `x`. -/ + have : has_deriv_within_at f f' (Ici x) x, + { simp only [has_deriv_within_at_iff_is_o, is_o_iff], + /- to get an approximation with a precision `ε`, we will replace `f` with `L e (n e) m` for + some large enough `e` (yielding a small error by uniform approximation). As one can vary `m`, + this makes it possible to cover all scales, and thus to obtain a good linear approximation in + the whole interval of length `(1/2)^(n e)`. -/ + assume ε εpos, + obtain ⟨e, he⟩ : ∃ (e : ℕ), (1 / 2) ^ e < ε / 16 := + exists_pow_lt_of_lt_one (div_pos εpos (by norm_num)) (by norm_num), + have xmem : x ∈ Ico x (x + (1/2)^(n e + 1)), + by simp only [one_div, left_mem_Ico, lt_add_iff_pos_right, inv_pos, pow_pos, zero_lt_bit0, + zero_lt_one], + filter_upwards [Icc_mem_nhds_within_Ici xmem] with y hy, + -- We need to show that `f y - f x - f' (y - x)` is small. For this, we will work at scale + -- `k` where `k` is chosen with `‖y - x‖ ∼ 2 ^ (-k)`. + rcases eq_or_lt_of_le hy.1 with rfl|xy, + { simp only [sub_self, zero_smul, norm_zero, mul_zero]}, + have yzero : 0 < y - x := sub_pos.2 xy, + have y_le : y - x ≤ (1/2) ^ (n e + 1), by linarith [hy.2], + have yone : y - x ≤ 1 := le_trans y_le (pow_le_one _ (by norm_num) (by norm_num)), + -- define the scale `k`. + obtain ⟨k, hk, h'k⟩ : ∃ (k : ℕ), (1/2) ^ (k + 1) < y - x ∧ y - x ≤ (1/2) ^ k := + exists_nat_pow_near_of_lt_one yzero yone (by norm_num : (0 : ℝ) < 1/2) + (by norm_num : (1 : ℝ)/2 < 1), + -- the scale is large enough (as `y - x` is small enough) + have k_gt : n e < k, + { have : ((1:ℝ)/2) ^ (k + 1) < (1/2) ^ (n e + 1) := lt_of_lt_of_le hk y_le, + rw pow_lt_pow_iff_of_lt_one (by norm_num : (0 : ℝ) < 1/2) (by norm_num) at this, + linarith }, + set m := k - 1 with hl, + have m_ge : n e ≤ m := nat.le_pred_of_lt k_gt, + have km : k = m + 1 := (nat.succ_pred_eq_of_pos (lt_of_le_of_lt (zero_le _) k_gt)).symm, + rw km at hk h'k, + -- `f` is well approximated by `L e (n e) k` at the relevant scale + -- (in fact, we use `m = k - 1` instead of `k` because of the precise definition of `A`). + have J : ‖f y - f x - (y - x) • L e (n e) m‖ ≤ 4 * (1/2) ^ e * ‖y - x‖ := calc + ‖f y - f x - (y - x) • L e (n e) m‖ ≤ (1/2) ^ e * (1/2) ^ m : + begin + apply le_of_mem_A (hn e (n e) m le_rfl m_ge).2.2, + { simp only [one_div, inv_pow, left_mem_Icc, le_add_iff_nonneg_right], + exact div_nonneg (inv_nonneg.2 (pow_nonneg zero_le_two _)) zero_le_two }, + { simp only [pow_add, tsub_le_iff_left] at h'k, + simpa only [hy.1, mem_Icc, true_and, one_div, pow_one] using h'k } + end + ... = 4 * (1/2) ^ e * (1/2) ^ (m + 2) : by { field_simp, ring_exp } + ... ≤ 4 * (1/2) ^ e * (y - x) : + mul_le_mul_of_nonneg_left (le_of_lt hk) (mul_nonneg (by norm_num) (le_of_lt P)) + ... = 4 * (1/2) ^ e * ‖y - x‖ : by rw [real.norm_of_nonneg yzero.le], + calc ‖f y - f x - (y - x) • f'‖ + = ‖(f y - f x - (y - x) • L e (n e) m) + (y - x) • (L e (n e) m - f')‖ : + by simp only [smul_sub, sub_add_sub_cancel] + ... ≤ 4 * (1/2) ^ e * ‖y - x‖ + ‖y - x‖ * (12 * (1/2) ^ e) : norm_add_le_of_le J + (by { rw [norm_smul], exact mul_le_mul_of_nonneg_left (Lf' _ _ m_ge) (norm_nonneg _) }) + ... = 16 * ‖y - x‖ * (1/2) ^ e : by ring + ... ≤ 16 * ‖y - x‖ * (ε / 16) : + mul_le_mul_of_nonneg_left he.le (mul_nonneg (by norm_num) (norm_nonneg _)) + ... = ε * ‖y - x‖ : by ring }, + rw ← this.deriv_within (unique_diff_on_Ici x x le_rfl) at f'K, + exact ⟨this.differentiable_within_at, f'K⟩, +end + +theorem differentiable_set_eq_D (hK : is_complete K) : + {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} = D f K := +subset.antisymm (differentiable_set_subset_D _) (D_subset_differentiable_set hK) + +end right_deriv_measurable_aux + +open right_deriv_measurable_aux + +variables (f) + +/-- The set of right differentiability points of a function, with derivative in a given complete +set, is Borel-measurable. -/ +theorem measurable_set_of_differentiable_within_at_Ici_of_is_complete + {K : set F} (hK : is_complete K) : + measurable_set {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ K} := +by simp [differentiable_set_eq_D K hK, D, measurable_set_B, measurable_set.Inter, + measurable_set.Union] + +variable [complete_space F] + +/-- The set of right differentiability points of a function taking values in a complete space is +Borel-measurable. -/ +theorem measurable_set_of_differentiable_within_at_Ici : + measurable_set {x | differentiable_within_at ℝ f (Ici x) x} := +begin + have : is_complete (univ : set F) := complete_univ, + convert measurable_set_of_differentiable_within_at_Ici_of_is_complete f this, + simp +end + +@[measurability] lemma measurable_deriv_within_Ici [measurable_space F] [borel_space F] : + measurable (λ x, deriv_within f (Ici x) x) := +begin + refine measurable_of_is_closed (λ s hs, _), + have : (λ x, deriv_within f (Ici x) x) ⁻¹' s = + {x | differentiable_within_at ℝ f (Ici x) x ∧ deriv_within f (Ici x) x ∈ s} ∪ + ({x | ¬differentiable_within_at ℝ f (Ici x) x} ∩ {x | (0 : F) ∈ s}) := + set.ext (λ x, mem_preimage.trans deriv_within_mem_iff), + rw this, + exact (measurable_set_of_differentiable_within_at_Ici_of_is_complete _ hs.is_complete).union + ((measurable_set_of_differentiable_within_at_Ici _).compl.inter (measurable_set.const _)) +end + +lemma strongly_measurable_deriv_within_Ici [second_countable_topology F] : + strongly_measurable (λ x, deriv_within f (Ici x) x) := +by { borelize F, exact (measurable_deriv_within_Ici f).strongly_measurable } + +lemma ae_measurable_deriv_within_Ici [measurable_space F] [borel_space F] + (μ : measure ℝ) : ae_measurable (λ x, deriv_within f (Ici x) x) μ := +(measurable_deriv_within_Ici f).ae_measurable + +lemma ae_strongly_measurable_deriv_within_Ici [second_countable_topology F] (μ : measure ℝ) : + ae_strongly_measurable (λ x, deriv_within f (Ici x) x) μ := +(strongly_measurable_deriv_within_Ici f).ae_strongly_measurable + +/-- The set of right differentiability points of a function taking values in a complete space is +Borel-measurable. -/ +theorem measurable_set_of_differentiable_within_at_Ioi : + measurable_set {x | differentiable_within_at ℝ f (Ioi x) x} := +by simpa [differentiable_within_at_Ioi_iff_Ici] + using measurable_set_of_differentiable_within_at_Ici f + +@[measurability] lemma measurable_deriv_within_Ioi [measurable_space F] [borel_space F] : + measurable (λ x, deriv_within f (Ioi x) x) := +by simpa [deriv_within_Ioi_eq_Ici] using measurable_deriv_within_Ici f + +lemma strongly_measurable_deriv_within_Ioi [second_countable_topology F] : + strongly_measurable (λ x, deriv_within f (Ioi x) x) := +by { borelize F, exact (measurable_deriv_within_Ioi f).strongly_measurable } + +lemma ae_measurable_deriv_within_Ioi [measurable_space F] [borel_space F] + (μ : measure ℝ) : ae_measurable (λ x, deriv_within f (Ioi x) x) μ := +(measurable_deriv_within_Ioi f).ae_measurable + +lemma ae_strongly_measurable_deriv_within_Ioi [second_countable_topology F] (μ : measure ℝ) : + ae_strongly_measurable (λ x, deriv_within f (Ioi x) x) μ := +(strongly_measurable_deriv_within_Ioi f).ae_strongly_measurable + +end right_deriv diff --git a/src/analysis/calculus/fderiv_symmetric.lean b/src/analysis/calculus/fderiv_symmetric.lean index 287cb61dec0ea..c631d08764501 100644 --- a/src/analysis/calculus/fderiv_symmetric.lean +++ b/src/analysis/calculus/fderiv_symmetric.lean @@ -3,13 +3,14 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ -import analysis.calculus.deriv import analysis.calculus.mean_value -import analysis.convex.topology /-! # Symmetry of the second derivative +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that, over the reals, the second derivative is symmetric. The most precise result is `convex.second_derivative_within_at_symmetric`. It asserts that, @@ -48,10 +49,10 @@ rectangle are contained in `s` by convexity. The general case follows by lineari -/ open asymptotics set -open_locale topological_space +open_locale topology -variables {E F : Type*} [normed_group E] [normed_space ℝ E] -[normed_group F] [normed_space ℝ F] +variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E] +[normed_add_comm_group F] [normed_space ℝ F] {s : set E} (s_conv : convex ℝ s) {f : E → F} {f' : E → (E →L[ℝ] F)} {f'' : E →L[ℝ] (E →L[ℝ] F)} (hf : ∀ x ∈ interior s, has_fderiv_at f (f' x) x) @@ -69,18 +70,18 @@ This is a technical statement used to show that the second derivative is symmetr -/ lemma convex.taylor_approx_two_segment {v w : E} (hv : x + v ∈ interior s) (hw : x + v + w ∈ interior s) : - is_o (λ (h : ℝ), f (x + h • v + h • w) - f (x + h • v) - h • f' x w - - h^2 • f'' v w - (h^2/2) • f'' w w) (λ h, h^2) (𝓝[>] (0 : ℝ)) := + (λ h : ℝ, f (x + h • v + h • w) - f (x + h • v) - h • f' x w + - h^2 • f'' v w - (h^2/2) • f'' w w) =o[𝓝[>] 0] (λ h, h^2) := begin - -- it suffices to check that the expression is bounded by `ε * ((∥v∥ + ∥w∥) * ∥w∥) * h^2` for + -- it suffices to check that the expression is bounded by `ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2` for -- small enough `h`, for any positive `ε`. - apply is_o.trans_is_O (is_o_iff.2 (λ ε εpos, _)) (is_O_const_mul_self ((∥v∥ + ∥w∥) * ∥w∥) _ _), + apply is_o.trans_is_O (is_o_iff.2 (λ ε εpos, _)) (is_O_const_mul_self ((‖v‖ + ‖w‖) * ‖w‖) _ _), -- consider a ball of radius `δ` around `x` in which the Taylor approximation for `f''` is -- good up to `δ`. rw [has_fderiv_within_at, has_fderiv_at_filter, is_o_iff] at hx, rcases metric.mem_nhds_within_iff.1 (hx εpos) with ⟨δ, δpos, sδ⟩, - have E1 : ∀ᶠ h in 𝓝[>] (0:ℝ), h * (∥v∥ + ∥w∥) < δ, - { have : filter.tendsto (λ h, h * (∥v∥ + ∥w∥)) (𝓝[>] (0:ℝ)) (𝓝 (0 * (∥v∥ + ∥w∥))) := + have E1 : ∀ᶠ h in 𝓝[>] (0:ℝ), h * (‖v‖ + ‖w‖) < δ, + { have : filter.tendsto (λ h, h * (‖v‖ + ‖w‖)) (𝓝[>] (0:ℝ)) (𝓝 (0 * (‖v‖ + ‖w‖))) := (continuous_id.mul continuous_const).continuous_within_at, apply (tendsto_order.1 this).2 δ, simpa only [zero_mul] using δpos }, @@ -127,19 +128,19 @@ begin ring }, apply_rules [has_deriv_at.has_deriv_within_at, has_deriv_at.smul_const, has_deriv_at_id', has_deriv_at.pow, has_deriv_at.mul_const] } }, - -- check that `g'` is uniformly bounded, with a suitable bound `ε * ((∥v∥ + ∥w∥) * ∥w∥) * h^2`. - have g'_bound : ∀ t ∈ Ico (0 : ℝ) 1, ∥g' t∥ ≤ ε * ((∥v∥ + ∥w∥) * ∥w∥) * h^2, + -- check that `g'` is uniformly bounded, with a suitable bound `ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2`. + have g'_bound : ∀ t ∈ Ico (0 : ℝ) 1, ‖g' t‖ ≤ ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2, { assume t ht, - have I : ∥h • v + (t * h) • w∥ ≤ h * (∥v∥ + ∥w∥) := calc - ∥h • v + (t * h) • w∥ ≤ ∥h • v∥ + ∥(t * h) • w∥ : norm_add_le _ _ - ... = h * ∥v∥ + t * (h * ∥w∥) : + have I : ‖h • v + (t * h) • w‖ ≤ h * (‖v‖ + ‖w‖) := calc + ‖h • v + (t * h) • w‖ ≤ ‖h • v‖ + ‖(t * h) • w‖ : norm_add_le _ _ + ... = h * ‖v‖ + t * (h * ‖w‖) : by simp only [norm_smul, real.norm_eq_abs, hpos.le, abs_of_nonneg, abs_mul, ht.left, mul_assoc] - ... ≤ h * ∥v∥ + 1 * (h * ∥w∥) : + ... ≤ h * ‖v‖ + 1 * (h * ‖w‖) : add_le_add le_rfl (mul_le_mul_of_nonneg_right ht.2.le (mul_nonneg hpos.le (norm_nonneg _))) - ... = h * (∥v∥ + ∥w∥) : by ring, - calc ∥g' t∥ = ∥(f' (x + h • v + (t * h) • w) - f' x - f'' (h • v + (t * h) • w)) (h • w)∥ : + ... = h * (‖v‖ + ‖w‖) : by ring, + calc ‖g' t‖ = ‖(f' (x + h • v + (t * h) • w) - f' x - f'' (h • v + (t * h) • w)) (h • w)‖ : begin rw hg', have : h * (t * h) = t * (h * h), by ring, @@ -147,9 +148,9 @@ begin continuous_linear_map.add_apply, pi.smul_apply, smul_sub, smul_add, smul_smul, ← sub_sub, continuous_linear_map.coe_smul', pi.sub_apply, continuous_linear_map.map_smul, this] end - ... ≤ ∥f' (x + h • v + (t * h) • w) - f' x - f'' (h • v + (t * h) • w)∥ * ∥h • w∥ : + ... ≤ ‖f' (x + h • v + (t * h) • w) - f' x - f'' (h • v + (t * h) • w)‖ * ‖h • w‖ : continuous_linear_map.le_op_norm _ _ - ... ≤ (ε * ∥h • v + (t * h) • w∥) * (∥h • w∥) : + ... ≤ (ε * ‖h • v + (t * h) • w‖) * (‖h • w‖) : begin apply mul_le_mul_of_nonneg_right _ (norm_nonneg _), have H : x + h • v + (t * h) • w ∈ metric.ball x δ ∩ interior s, @@ -158,7 +159,7 @@ begin exact I.trans_lt hδ }, simpa only [mem_set_of_eq, add_assoc x, add_sub_cancel'] using sδ H, end - ... ≤ (ε * (∥h • v∥ + ∥h • w∥)) * (∥h • w∥) : + ... ≤ (ε * (‖h • v‖ + ‖h • w‖)) * (‖h • w‖) : begin apply mul_le_mul_of_nonneg_right _ (norm_nonneg _), apply mul_le_mul_of_nonneg_left _ (εpos.le), @@ -167,10 +168,10 @@ begin simp only [norm_smul, real.norm_eq_abs, abs_mul, abs_of_nonneg, ht.1, hpos.le, mul_assoc], exact mul_le_of_le_one_left (mul_nonneg hpos.le (norm_nonneg _)) ht.2.le, end - ... = ε * ((∥v∥ + ∥w∥) * ∥w∥) * h^2 : + ... = ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2 : by { simp only [norm_smul, real.norm_eq_abs, abs_mul, abs_of_nonneg, hpos.le], ring } }, -- conclude using the mean value inequality - have I : ∥g 1 - g 0∥ ≤ ε * ((∥v∥ + ∥w∥) * ∥w∥) * h^2, by simpa only [mul_one, sub_zero] using + have I : ‖g 1 - g 0‖ ≤ ε * ((‖v‖ + ‖w‖) * ‖w‖) * h^2, by simpa only [mul_one, sub_zero] using norm_image_sub_le_of_norm_deriv_le_segment' g_deriv g'_bound 1 (right_mem_Icc.2 zero_le_one), convert I using 1, { congr' 1, @@ -188,9 +189,8 @@ In a setting where `f` is not guaranteed to be continuous at `f`, we can still get this if we use a quadrilateral based at `h v + h w`. -/ lemma convex.is_o_alternate_sum_square {v w : E} (h4v : x + (4 : ℝ) • v ∈ interior s) (h4w : x + (4 : ℝ) • w ∈ interior s) : - is_o (λ (h : ℝ), f (x + h • (2 • v + 2 • w)) + f (x + h • (v + w)) - - f (x + h • (2 • v + w)) - f (x + h • (v + 2 • w)) - h^2 • f'' v w) - (λ h, h^2) (𝓝[>] (0 : ℝ)) := + (λ h : ℝ, f (x + h • (2 • v + 2 • w)) + f (x + h • (v + w)) + - f (x + h • (2 • v + w)) - f (x + h • (v + 2 • w)) - h^2 • f'' v w) =o[𝓝[>] 0] (λ h, h^2) := begin have A : (1 : ℝ)/2 ∈ Ioc (0 : ℝ) 1 := ⟨by norm_num, by norm_num⟩, have B : (1 : ℝ)/2 ∈ Icc (0 : ℝ) 1 := ⟨by norm_num, by norm_num⟩, @@ -248,14 +248,14 @@ lemma convex.second_derivative_within_at_symmetric_of_mem_interior {v w : E} (h4v : x + (4 : ℝ) • v ∈ interior s) (h4w : x + (4 : ℝ) • w ∈ interior s) : f'' w v = f'' v w := begin - have A : is_o (λ (h : ℝ), h^2 • (f'' w v- f'' v w)) (λ h, h^2) (𝓝[>] (0 : ℝ)), + have A : (λ h : ℝ, h^2 • (f'' w v- f'' v w)) =o[𝓝[>] 0] (λ h, h^2), { convert (s_conv.is_o_alternate_sum_square hf xs hx h4v h4w).sub (s_conv.is_o_alternate_sum_square hf xs hx h4w h4v), ext h, simp only [add_comm, smul_add, smul_sub], abel }, - have B : is_o (λ (h : ℝ), f'' w v - f'' v w) (λ h, (1 : ℝ)) (𝓝[>] (0 : ℝ)), - { have : is_O (λ (h : ℝ), 1/h^2) (λ h, 1/h^2) (𝓝[>] (0 : ℝ)) := is_O_refl _ _, + have B : (λ h : ℝ, f'' w v - f'' v w) =o[𝓝[>] 0] (λ h, (1 : ℝ)), + { have : (λ h : ℝ, 1/h^2) =O[𝓝[>] 0] (λ h, 1/h^2) := is_O_refl _ _, have C := this.smul_is_o A, apply C.congr' _ _, { filter_upwards [self_mem_nhds_within], @@ -264,7 +264,7 @@ begin congr' 1, field_simp [has_lt.lt.ne' hpos] }, { filter_upwards [self_mem_nhds_within] with _ hpos, - field_simp [has_lt.lt.ne' hpos, has_scalar.smul], }, }, + field_simp [has_lt.lt.ne' hpos, has_smul.smul], }, }, simpa only [sub_eq_zero] using is_o_const_const_iff.1 B, end diff --git a/src/analysis/calculus/formal_multilinear_series.lean b/src/analysis/calculus/formal_multilinear_series.lean index 08490045b8cb5..78aba40aa4ea6 100644 --- a/src/analysis/calculus/formal_multilinear_series.lean +++ b/src/analysis/calculus/formal_multilinear_series.lean @@ -8,6 +8,9 @@ import analysis.normed_space.multilinear /-! # Formal multilinear series +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `formal_multilinear_series 𝕜 E F` to be a family of `n`-multilinear maps for all `n`, designed to model the sequence of derivatives of a function. In other files we use this notion to define `C^n` functions (called `cont_diff` in `mathlib`) and analytic functions. @@ -25,7 +28,7 @@ multilinear, formal series noncomputable theory open set fin -open_locale topological_space +open_locale topology variables {𝕜 𝕜' E F G : Type*} @@ -67,6 +70,12 @@ end module namespace formal_multilinear_series +protected lemma ext_iff {p q : formal_multilinear_series 𝕜 E F} : p = q ↔ ∀ n, p n = q n := +function.funext_iff + +protected lemma ne_iff {p q : formal_multilinear_series 𝕜 E F} : p ≠ q ↔ ∃ n, p n ≠ q n := +function.ne_iff + /-- Killing the zeroth coefficient in a formal multilinear series -/ def remove_zero (p : formal_multilinear_series 𝕜 E F) : formal_multilinear_series 𝕜 E F | 0 := 0 @@ -99,7 +108,7 @@ def comp_continuous_linear_map (p : formal_multilinear_series 𝕜 F G) (u : E (p : formal_multilinear_series 𝕜 F G) (u : E →L[𝕜] F) (n : ℕ) (v : fin n → E) : (p.comp_continuous_linear_map u) n v = p n (u ∘ v) := rfl -variables (𝕜) [comm_ring 𝕜'] [has_scalar 𝕜 𝕜'] +variables (𝕜) [comm_ring 𝕜'] [has_smul 𝕜 𝕜'] variables [module 𝕜' E] [has_continuous_const_smul 𝕜' E] [is_scalar_tower 𝕜 𝕜' E] variables [module 𝕜' F] [has_continuous_const_smul 𝕜' F] [is_scalar_tower 𝕜 𝕜' F] @@ -114,10 +123,10 @@ end namespace formal_multilinear_series -variables [nondiscrete_normed_field 𝕜] - [normed_group E] [normed_space 𝕜 E] - [normed_group F] [normed_space 𝕜 F] - [normed_group G] [normed_space 𝕜 G] +variables [nontrivially_normed_field 𝕜] + [normed_add_comm_group E] [normed_space 𝕜 E] + [normed_add_comm_group F] [normed_space 𝕜 F] + [normed_add_comm_group G] [normed_space 𝕜 G] variables (p : formal_multilinear_series 𝕜 E F) @@ -164,3 +173,142 @@ lemma comp_formal_multilinear_series_apply' rfl end continuous_linear_map + +namespace formal_multilinear_series + +section order + +variables [comm_ring 𝕜] {n : ℕ} + [add_comm_group E] [module 𝕜 E] [topological_space E] [topological_add_group E] + [has_continuous_const_smul 𝕜 E] + [add_comm_group F] [module 𝕜 F] [topological_space F] [topological_add_group F] + [has_continuous_const_smul 𝕜 F] + {p : formal_multilinear_series 𝕜 E F} + +/-- The index of the first non-zero coefficient in `p` (or `0` if all coefficients are zero). This + is the order of the isolated zero of an analytic function `f` at a point if `p` is the Taylor + series of `f` at that point. -/ +noncomputable def order (p : formal_multilinear_series 𝕜 E F) : ℕ := +Inf { n | p n ≠ 0 } + +@[simp] lemma order_zero : (0 : formal_multilinear_series 𝕜 E F).order = 0 := by simp [order] + +lemma ne_zero_of_order_ne_zero (hp : p.order ≠ 0) : p ≠ 0 := +λ h, by simpa [h] using hp + +lemma order_eq_find [decidable_pred (λ n, p n ≠ 0)] (hp : ∃ n, p n ≠ 0) : + p.order = nat.find hp := +by simp [order, Inf, hp] + +lemma order_eq_find' [decidable_pred (λ n, p n ≠ 0)] (hp : p ≠ 0) : + p.order = nat.find (formal_multilinear_series.ne_iff.mp hp) := +order_eq_find _ + +lemma order_eq_zero_iff (hp : p ≠ 0) : p.order = 0 ↔ p 0 ≠ 0 := +begin + classical, + have : ∃ n, p n ≠ 0 := formal_multilinear_series.ne_iff.mp hp, + simp [order_eq_find this, hp] +end + +lemma order_eq_zero_iff' : p.order = 0 ↔ p = 0 ∨ p 0 ≠ 0 := +by { by_cases h : p = 0; simp [h, order_eq_zero_iff] } + +lemma apply_order_ne_zero (hp : p ≠ 0) : p p.order ≠ 0 := +begin + classical, + let h := formal_multilinear_series.ne_iff.mp hp, + exact (order_eq_find h).symm ▸ nat.find_spec h +end + +lemma apply_order_ne_zero' (hp : p.order ≠ 0) : p p.order ≠ 0 := +apply_order_ne_zero (ne_zero_of_order_ne_zero hp) + +lemma apply_eq_zero_of_lt_order (hp : n < p.order) : p n = 0 := +begin + by_cases p = 0, + { simp [h] }, + { classical, + rw [order_eq_find' h] at hp, + simpa using nat.find_min _ hp } +end + +end order + +section coef + +variables [nontrivially_normed_field 𝕜] + [normed_add_comm_group E] [normed_space 𝕜 E] {s : E} + {p : formal_multilinear_series 𝕜 𝕜 E} {f : 𝕜 → E} + {n : ℕ} {z z₀ : 𝕜} {y : fin n → 𝕜} + +open_locale big_operators + +/-- The `n`th coefficient of `p` when seen as a power series. -/ +def coeff (p : formal_multilinear_series 𝕜 𝕜 E) (n : ℕ) : E := p n 1 + +lemma mk_pi_field_coeff_eq (p : formal_multilinear_series 𝕜 𝕜 E) (n : ℕ) : + continuous_multilinear_map.mk_pi_field 𝕜 (fin n) (p.coeff n) = p n := +(p n).mk_pi_field_apply_one_eq_self + +@[simp] lemma apply_eq_prod_smul_coeff : p n y = (∏ i, y i) • p.coeff n := +begin + convert (p n).to_multilinear_map.map_smul_univ y 1, + funext; simp only [pi.one_apply, algebra.id.smul_eq_mul, mul_one], +end + +lemma coeff_eq_zero : p.coeff n = 0 ↔ p n = 0 := +by rw [← mk_pi_field_coeff_eq p, continuous_multilinear_map.mk_pi_field_eq_zero_iff] + +@[simp] lemma apply_eq_pow_smul_coeff : p n (λ _, z) = z ^ n • p.coeff n := +by simp + +@[simp] lemma norm_apply_eq_norm_coef : ‖p n‖ = ‖coeff p n‖ := +by rw [← mk_pi_field_coeff_eq p, continuous_multilinear_map.norm_mk_pi_field] + +end coef + +section fslope + +variables [nontrivially_normed_field 𝕜] + [normed_add_comm_group E] [normed_space 𝕜 E] + {p : formal_multilinear_series 𝕜 𝕜 E} {n : ℕ} + +/-- The formal counterpart of `dslope`, corresponding to the expansion of `(f z - f 0) / z`. If `f` +has `p` as a power series, then `dslope f` has `fslope p` as a power series. -/ +noncomputable def fslope (p : formal_multilinear_series 𝕜 𝕜 E) : formal_multilinear_series 𝕜 𝕜 E := + λ n, (p (n + 1)).curry_left 1 + +@[simp] lemma coeff_fslope : p.fslope.coeff n = p.coeff (n + 1) := +begin + have : @fin.cons n (λ _, 𝕜) 1 (1 : fin n → 𝕜) = 1 := fin.cons_self_tail 1, + simp only [fslope, coeff, continuous_multilinear_map.curry_left_apply, this], +end + +@[simp] lemma coeff_iterate_fslope (k n : ℕ) : + (fslope^[k] p).coeff n = p.coeff (n + k) := +by induction k with k ih generalizing p; refl <|> simpa [ih] + +end fslope + +end formal_multilinear_series + +section const + +/-- The formal multilinear series where all terms of positive degree are equal to zero, and the term +of degree zero is `c`. It is the power series expansion of the constant function equal to `c` +everywhere. -/ +def const_formal_multilinear_series (𝕜 : Type*) [nontrivially_normed_field 𝕜] + (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] [has_continuous_const_smul 𝕜 E] + [topological_add_group E] {F : Type*} [normed_add_comm_group F] [topological_add_group F] + [normed_space 𝕜 F] [has_continuous_const_smul 𝕜 F] (c : F) : formal_multilinear_series 𝕜 E F +| 0 := continuous_multilinear_map.curry0 _ _ c +| _ := 0 + +@[simp] lemma const_formal_multilinear_series_apply [nontrivially_normed_field 𝕜] + [normed_add_comm_group E] [normed_add_comm_group F] [normed_space 𝕜 E] [normed_space 𝕜 F] + {c : F} {n : ℕ} (hn : n ≠ 0) : + const_formal_multilinear_series 𝕜 E c n = 0 := +nat.cases_on n (λ hn, (hn rfl).elim) (λ _ _, rfl) hn + +end const diff --git a/src/analysis/calculus/implicit.lean b/src/analysis/calculus/implicit.lean index 516859a89928d..21bbda6901e3a 100644 --- a/src/analysis/calculus/implicit.lean +++ b/src/analysis/calculus/implicit.lean @@ -9,6 +9,9 @@ import analysis.normed_space.complemented /-! # Implicit function theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove three versions of the implicit function theorem. First we define a structure `implicit_function_data` that holds arguments for the most general version of the implicit function theorem, see `implicit_function_data.implicit_function` @@ -45,10 +48,11 @@ implicit function, inverse function noncomputable theory -open_locale topological_space +open_locale topology open filter -open continuous_linear_map (fst snd subtype_val smul_right ker_prod) +open continuous_linear_map (fst snd smul_right ker_prod) open continuous_linear_equiv (of_bijective) +open linear_map (ker range) /-! ### General version @@ -87,11 +91,11 @@ such that * both functions are strictly differentiable at `a`; * the derivatives are surjective; * the kernels of the derivatives are complementary subspaces of `E`. -/ -@[nolint has_inhabited_instance] -structure implicit_function_data (𝕜 : Type*) [nondiscrete_normed_field 𝕜] - (E : Type*) [normed_group E] [normed_space 𝕜 E] [complete_space E] - (F : Type*) [normed_group F] [normed_space 𝕜 F] [complete_space F] - (G : Type*) [normed_group G] [normed_space 𝕜 G] [complete_space G] := +@[nolint has_nonempty_instance] +structure implicit_function_data (𝕜 : Type*) [nontrivially_normed_field 𝕜] + (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E] + (F : Type*) [normed_add_comm_group F] [normed_space 𝕜 F] [complete_space F] + (G : Type*) [normed_add_comm_group G] [normed_space 𝕜 G] [complete_space G] := (left_fun : E → F) (left_deriv : E →L[𝕜] F) (right_fun : E → G) @@ -99,16 +103,16 @@ structure implicit_function_data (𝕜 : Type*) [nondiscrete_normed_field 𝕜] (pt : E) (left_has_deriv : has_strict_fderiv_at left_fun left_deriv pt) (right_has_deriv : has_strict_fderiv_at right_fun right_deriv pt) -(left_range : left_deriv.range = ⊤) -(right_range : right_deriv.range = ⊤) -(is_compl_ker : is_compl left_deriv.ker right_deriv.ker) +(left_range : range left_deriv = ⊤) +(right_range : range right_deriv = ⊤) +(is_compl_ker : is_compl (ker left_deriv) (ker right_deriv)) namespace implicit_function_data -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] - {E : Type*} [normed_group E] [normed_space 𝕜 E] [complete_space E] - {F : Type*} [normed_group F] [normed_space 𝕜 F] [complete_space F] - {G : Type*} [normed_group G] [normed_space 𝕜 G] [complete_space G] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E] + {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [complete_space F] + {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] [complete_space G] (φ : implicit_function_data 𝕜 E F G) /-- The function given by `x ↦ (left_fun x, right_fun x)`. -/ @@ -203,9 +207,9 @@ Note that a map with these properties is not unique. E.g., different choices of complementary to `ker f'` lead to different maps `φ`. -/ -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] - {E : Type*} [normed_group E] [normed_space 𝕜 E] [complete_space E] - {F : Type*} [normed_group F] [normed_space 𝕜 F] [complete_space F] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E] + {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [complete_space F] {f : E → F} {f' : E →L[𝕜] F} {a : E} section defs @@ -215,8 +219,8 @@ variables (f f') /-- Data used to apply the generic implicit function theorem to the case of a strictly differentiable map such that its derivative is surjective and has a complemented kernel. -/ @[simp] def implicit_function_data_of_complemented (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : - implicit_function_data 𝕜 E F f'.ker := + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : + implicit_function_data 𝕜 E F (ker f') := { left_fun := f, left_deriv := f', right_fun := λ x, classical.some hker (x - a), @@ -232,58 +236,58 @@ differentiable map such that its derivative is surjective and has a complemented /-- A local homeomorphism between `E` and `F × f'.ker` sending level surfaces of `f` to vertical subspaces. -/ def implicit_to_local_homeomorph_of_complemented (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : - local_homeomorph E (F × f'.ker) := + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : + local_homeomorph E (F × (ker f')) := (implicit_function_data_of_complemented f f' hf hf' hker).to_local_homeomorph /-- Implicit function `g` defined by `f (g z y) = z`. -/ def implicit_function_of_complemented (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : - F → f'.ker → E := + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : + F → (ker f') → E := (implicit_function_data_of_complemented f f' hf hf' hker).implicit_function end defs @[simp] lemma implicit_to_local_homeomorph_of_complemented_fst (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) (x : E) : + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) (x : E) : (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker x).fst = f x := rfl lemma implicit_to_local_homeomorph_of_complemented_apply - (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) - (hker : f'.ker.closed_complemented) (y : E) : + (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) + (hker : (ker f').closed_complemented) (y : E) : hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker y = (f y, classical.some hker (y - a)) := rfl @[simp] lemma implicit_to_local_homeomorph_of_complemented_apply_ker - (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) - (hker : f'.ker.closed_complemented) (y : f'.ker) : + (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) + (hker : (ker f').closed_complemented) (y : ker f') : hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker (y + a) = (f (y + a), y) := by simp only [implicit_to_local_homeomorph_of_complemented_apply, add_sub_cancel, classical.some_spec hker] @[simp] lemma implicit_to_local_homeomorph_of_complemented_self - (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : + (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker a = (f a, 0) := by simp [hf.implicit_to_local_homeomorph_of_complemented_apply] lemma mem_implicit_to_local_homeomorph_of_complemented_source (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : a ∈ (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).source := mem_to_local_homeomorph_source _ lemma mem_implicit_to_local_homeomorph_of_complemented_target (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : - (f a, (0 : f'.ker)) ∈ (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).target := + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : + (f a, (0 : ker f')) ∈ (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).target := by simpa only [implicit_to_local_homeomorph_of_complemented_self] using ((hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).map_source $ (hf.mem_implicit_to_local_homeomorph_of_complemented_source hf' hker)) /-- `implicit_function_of_complemented` sends `(z, y)` to a point in `f ⁻¹' z`. -/ lemma map_implicit_function_of_complemented_eq (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : - ∀ᶠ (p : F × f'.ker) in 𝓝 (f a, 0), + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : + ∀ᶠ (p : F × (ker f')) in 𝓝 (f a, 0), f (hf.implicit_function_of_complemented f f' hf' hker p.1 p.2) = p.1 := ((hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).eventually_right_inverse $ hf.mem_implicit_to_local_homeomorph_of_complemented_target hf' hker).mono $ λ ⟨z, y⟩ h, @@ -292,13 +296,13 @@ lemma map_implicit_function_of_complemented_eq (hf : has_strict_fderiv_at f f' a /-- Any point in some neighborhood of `a` can be represented as `implicit_function` of some point. -/ lemma eq_implicit_function_of_complemented (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : ∀ᶠ x in 𝓝 a, hf.implicit_function_of_complemented f f' hf' hker (f x) (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker x).snd = x := (implicit_function_data_of_complemented f f' hf hf' hker).implicit_function_apply_image @[simp] lemma implicit_function_of_complemented_apply_image (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : hf.implicit_function_of_complemented f f' hf' hker (f a) 0 = a := begin convert (hf.implicit_to_local_homeomorph_of_complemented f f' hf' hker).left_inv @@ -307,12 +311,21 @@ begin end lemma to_implicit_function_of_complemented (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (hker : f'.ker.closed_complemented) : + (hf' : range f' = ⊤) (hker : (ker f').closed_complemented) : has_strict_fderiv_at (hf.implicit_function_of_complemented f f' hf' hker (f a)) - (subtype_val f'.ker) 0 := -by convert (implicit_function_data_of_complemented f f' hf hf' - hker).implicit_function_has_strict_fderiv_at (subtype_val f'.ker) _ _; - [skip, ext, ext]; simp [classical.some_spec hker] + (ker f').subtypeL 0 := +begin + convert (implicit_function_data_of_complemented f f' hf hf' + hker).implicit_function_has_strict_fderiv_at (ker f').subtypeL _ _, + swap, + { ext, simp only [classical.some_spec hker, implicit_function_data_of_complemented, + continuous_linear_map.coe_comp', submodule.coe_subtypeL', submodule.coe_subtype, + function.comp_app, continuous_linear_map.coe_id', id.def] }, + swap, + { ext, simp only [continuous_linear_map.coe_comp', submodule.coe_subtypeL', submodule.coe_subtype, + function.comp_app, linear_map.map_coe_ker, continuous_linear_map.zero_apply] }, + simp only [implicit_function_data_of_complemented, map_sub, sub_self], +end end complemented @@ -335,53 +348,53 @@ complementary to `ker f'` lead to different maps `φ`. section finite_dimensional -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [complete_space 𝕜] - {E : Type*} [normed_group E] [normed_space 𝕜 E] [complete_space E] - {F : Type*} [normed_group F] [normed_space 𝕜 F] [finite_dimensional 𝕜 F] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [complete_space 𝕜] + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [complete_space E] + {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] [finite_dimensional 𝕜 F] (f : E → F) (f' : E →L[𝕜] F) {a : E} /-- Given a map `f : E → F` to a finite dimensional space with a surjective derivative `f'`, returns a local homeomorphism between `E` and `F × ker f'`. -/ -def implicit_to_local_homeomorph (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) : - local_homeomorph E (F × f'.ker) := +def implicit_to_local_homeomorph (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) : + local_homeomorph E (F × (ker f')) := by haveI := finite_dimensional.complete 𝕜 F; exact hf.implicit_to_local_homeomorph_of_complemented f f' hf' f'.ker_closed_complemented_of_finite_dimensional_range /-- Implicit function `g` defined by `f (g z y) = z`. -/ -def implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) : - F → f'.ker → E := +def implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) : + F → (ker f') → E := function.curry $ (hf.implicit_to_local_homeomorph f f' hf').symm variables {f f'} @[simp] lemma implicit_to_local_homeomorph_fst (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) (x : E) : + (hf' : range f' = ⊤) (x : E) : (hf.implicit_to_local_homeomorph f f' hf' x).fst = f x := rfl @[simp] lemma implicit_to_local_homeomorph_apply_ker - (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) (y : f'.ker) : + (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) (y : ker f') : hf.implicit_to_local_homeomorph f f' hf' (y + a) = (f (y + a), y) := by apply implicit_to_local_homeomorph_of_complemented_apply_ker @[simp] lemma implicit_to_local_homeomorph_self - (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) : + (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) : hf.implicit_to_local_homeomorph f f' hf' a = (f a, 0) := by apply implicit_to_local_homeomorph_of_complemented_self lemma mem_implicit_to_local_homeomorph_source (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) : + (hf' : range f' = ⊤) : a ∈ (hf.implicit_to_local_homeomorph f f' hf').source := mem_to_local_homeomorph_source _ lemma mem_implicit_to_local_homeomorph_target (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) : - (f a, (0 : f'.ker)) ∈ (hf.implicit_to_local_homeomorph f f' hf').target := + (hf' : range f' = ⊤) : + (f a, (0 : ker f')) ∈ (hf.implicit_to_local_homeomorph f f' hf').target := by apply mem_implicit_to_local_homeomorph_of_complemented_target lemma tendsto_implicit_function (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) {α : Type*} {l : filter α} {g₁ : α → F} {g₂ : α → f'.ker} + (hf' : range f' = ⊤) {α : Type*} {l : filter α} {g₁ : α → F} {g₂ : α → ker f'} (h₁ : tendsto g₁ l (𝓝 $ f a)) (h₂ : tendsto g₂ l (𝓝 0)) : tendsto (λ t, hf.implicit_function f f' hf' (g₁ t) (g₂ t)) l (𝓝 a) := begin @@ -391,28 +404,28 @@ begin exact h₁.prod_mk_nhds h₂ end -alias tendsto_implicit_function ← filter.tendsto.implicit_function +alias tendsto_implicit_function ← _root_.filter.tendsto.implicit_function /-- `implicit_function` sends `(z, y)` to a point in `f ⁻¹' z`. -/ -lemma map_implicit_function_eq (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) : - ∀ᶠ (p : F × f'.ker) in 𝓝 (f a, 0), f (hf.implicit_function f f' hf' p.1 p.2) = p.1 := +lemma map_implicit_function_eq (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) : + ∀ᶠ (p : F × (ker f')) in 𝓝 (f a, 0), f (hf.implicit_function f f' hf' p.1 p.2) = p.1 := by apply map_implicit_function_of_complemented_eq @[simp] lemma implicit_function_apply_image (hf : has_strict_fderiv_at f f' a) - (hf' : f'.range = ⊤) : + (hf' : range f' = ⊤) : hf.implicit_function f f' hf' (f a) 0 = a := by apply implicit_function_of_complemented_apply_image /-- Any point in some neighborhood of `a` can be represented as `implicit_function` of some point. -/ -lemma eq_implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) : +lemma eq_implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) : ∀ᶠ x in 𝓝 a, hf.implicit_function f f' hf' (f x) (hf.implicit_to_local_homeomorph f f' hf' x).snd = x := by apply eq_implicit_function_of_complemented -lemma to_implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : f'.range = ⊤) : +lemma to_implicit_function (hf : has_strict_fderiv_at f f' a) (hf' : range f' = ⊤) : has_strict_fderiv_at (hf.implicit_function f f' hf' (f a)) - (subtype_val f'.ker) 0 := + (ker f').subtypeL 0 := by apply to_implicit_function_of_complemented end finite_dimensional diff --git a/src/analysis/calculus/inverse.lean b/src/analysis/calculus/inverse.lean index 4532272141c61..f84292e53e633 100644 --- a/src/analysis/calculus/inverse.lean +++ b/src/analysis/calculus/inverse.lean @@ -4,13 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov, Heather Macbeth, Sébastien Gouëzel -/ import analysis.calculus.cont_diff -import tactic.ring_exp import analysis.normed_space.banach -import topology.local_homeomorph /-! # Inverse function theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove the inverse function theorem. It says that if a map `f : E → F` has an invertible strict derivative `f'` at `a`, then it is locally invertible, and the inverse function has derivative `f' ⁻¹`. @@ -47,7 +48,7 @@ the inverse function, are formulated in `fderiv.lean`, `deriv.lean`, and `cont_d In the section about `approximates_linear_on` we introduce some `local notation` to make formulas shorter: -* by `N` we denote `∥f'⁻¹∥`; +* by `N` we denote `‖f'⁻¹‖`; * by `g` we denote the auxiliary contracting map `x ↦ x + f'.symm (y - f x)` used to prove that `{x | f x = y}` is nonempty. @@ -57,15 +58,15 @@ derivative, strictly differentiable, continuously differentiable, smooth, invers -/ open function set filter metric -open_locale topological_space classical nnreal +open_locale topology classical nnreal noncomputable theory -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] -variables {G : Type*} [normed_group G] [normed_space 𝕜 G] -variables {G' : Type*} [normed_group G'] [normed_space 𝕜 G'] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜 G'] variables {ε : ℝ} @@ -76,7 +77,7 @@ open continuous_linear_map (id) /-! ### Non-linear maps close to affine maps -In this section we study a map `f` such that `∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥` on an open set +In this section we study a map `f` such that `‖f x - f y - f' (x - y)‖ ≤ c * ‖x - y‖` on an open set `s`, where `f' : E →L[𝕜] F` is a continuous linear map and `c` is suitably small. Maps of this type behave like `f a + f' (x - a)` near each `a ∈ s`. @@ -100,13 +101,13 @@ lemmas. This approach makes it possible -/ /-- We say that `f` approximates a continuous linear map `f'` on `s` with constant `c`, -if `∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥` whenever `x, y ∈ s`. +if `‖f x - f y - f' (x - y)‖ ≤ c * ‖x - y‖` whenever `x, y ∈ s`. This predicate is defined to facilitate the splitting of the inverse function theorem into small lemmas. Some of these lemmas can be useful, e.g., to prove that the inverse function is defined on a specific set. -/ def approximates_linear_on (f : E → F) (f' : E →L[𝕜] F) (s : set E) (c : ℝ≥0) : Prop := -∀ (x ∈ s) (y ∈ s), ∥f x - f y - f' (x - y)∥ ≤ c * ∥x - y∥ +∀ (x ∈ s) (y ∈ s), ‖f x - f y - f' (x - y)‖ ≤ c * ‖x - y‖ @[simp] lemma approximates_linear_on_empty (f : E → F) (f' : E →L[𝕜] F) (c : ℝ≥0) : approximates_linear_on f f' ∅ c := @@ -141,7 +142,7 @@ begin end alias approximates_linear_on_iff_lipschitz_on_with ↔ - approximates_linear_on.lipschitz_on_with lipschitz_on_with.approximates_linear_on + lipschitz_on_with _root_.lipschitz_on_with.approximates_linear_on lemma lipschitz_sub (hf : approximates_linear_on f f' s c) : lipschitz_with c (λ x : s, f x - f' x) := @@ -153,7 +154,7 @@ begin end protected lemma lipschitz (hf : approximates_linear_on f f' s c) : - lipschitz_with (∥f'∥₊ + c) (s.restrict f) := + lipschitz_with (‖f'‖₊ + c) (s.restrict f) := by simpa only [restrict_apply, add_sub_cancel'_right] using (f'.lipschitz.restrict s).add hf.lipschitz_sub @@ -226,12 +227,12 @@ begin dist (f (g z)) y ≤ c * f'symm.nnnorm * dist (f z) y, { assume z hz hgz, set v := f'symm (y - f z) with hv, - calc dist (f (g z)) y = ∥f (z + v) - y∥ : by rw [dist_eq_norm] - ... = ∥f (z + v) - f z - f' v + f' v - (y - f z)∥ : by { congr' 1, abel } - ... = ∥f (z + v) - f z - f' ((z + v) - z)∥ : + calc dist (f (g z)) y = ‖f (z + v) - y‖ : by rw [dist_eq_norm] + ... = ‖f (z + v) - f z - f' v + f' v - (y - f z)‖ : by { congr' 1, abel } + ... = ‖f (z + v) - f z - f' ((z + v) - z)‖ : by simp only [continuous_linear_map.nonlinear_right_inverse.right_inv, add_sub_cancel', sub_add_cancel] - ... ≤ c * ∥(z + v) - z∥ : hf _ (hε hgz) _ (hε hz) + ... ≤ c * ‖(z + v) - z‖ : hf _ (hε hgz) _ (hε hz) ... ≤ c * (f'symm.nnnorm * dist (f z) y) : begin apply mul_le_mul_of_nonneg_left _ (nnreal.coe_nonneg c), simpa [hv, dist_eq_norm'] using f'symm.bound (y - f z), @@ -351,12 +352,12 @@ end locally_onto /-! From now on we assume that `f` approximates an invertible continuous linear map `f : E ≃L[𝕜] F`. -We also assume that either `E = {0}`, or `c < ∥f'⁻¹∥⁻¹`. We use `N` as an abbreviation for `∥f'⁻¹∥`. +We also assume that either `E = {0}`, or `c < ‖f'⁻¹‖⁻¹`. We use `N` as an abbreviation for `‖f'⁻¹‖`. -/ variables {f' : E ≃L[𝕜] F} {s : set E} {c : ℝ≥0} -local notation `N` := ∥(f'.symm : F →L[𝕜] E)∥₊ +local notation `N` := ‖(f'.symm : F →L[𝕜] E)‖₊ protected lemma antilipschitz (hf : approximates_linear_on f (f' : E →L[𝕜] F) s c) (hc : subsingleton E ∨ c < N⁻¹) : @@ -428,24 +429,24 @@ begin rcases (mem_image _ _ _).1 hx with ⟨x', x's, rfl⟩, rcases (mem_image _ _ _).1 hy with ⟨y', y's, rfl⟩, rw [← Af x', ← Af y', A.left_inv x's, A.left_inv y's], - calc ∥x' - y' - (f'.symm) (A x' - A y')∥ - ≤ N * ∥f' (x' - y' - (f'.symm) (A x' - A y'))∥ : + calc ‖x' - y' - (f'.symm) (A x' - A y')‖ + ≤ N * ‖f' (x' - y' - (f'.symm) (A x' - A y'))‖ : (f' : E →L[𝕜] F).bound_of_antilipschitz f'.antilipschitz _ - ... = N * ∥A y' - A x' - f' (y' - x')∥ : + ... = N * ‖A y' - A x' - f' (y' - x')‖ : begin congr' 2, simp only [continuous_linear_equiv.apply_symm_apply, continuous_linear_equiv.map_sub], abel, end - ... ≤ N * (c * ∥y' - x'∥) : + ... ≤ N * (c * ‖y' - x'‖) : mul_le_mul_of_nonneg_left (hf _ y's _ x's) (nnreal.coe_nonneg _) - ... ≤ N * (c * (((N⁻¹ - c)⁻¹ : ℝ≥0) * ∥A y' - A x'∥)) : + ... ≤ N * (c * (((N⁻¹ - c)⁻¹ : ℝ≥0) * ‖A y' - A x'‖)) : begin apply_rules [mul_le_mul_of_nonneg_left, nnreal.coe_nonneg], rw [← dist_eq_norm, ← dist_eq_norm], exact (hf.antilipschitz hc).le_mul_dist ⟨y', y's⟩ ⟨x', x's⟩, end - ... = (N * (N⁻¹ - c)⁻¹ * c : ℝ≥0) * ∥A x' - A y'∥ : + ... = (N * (N⁻¹ - c)⁻¹ * c : ℝ≥0) * ‖A x' - A y'‖ : by { simp only [norm_sub_rev, nonneg.coe_mul], ring } end @@ -481,11 +482,11 @@ omit cs /-- In a real vector space, a function `f` that approximates a linear equivalence on a subset `s` can be extended to a homeomorphism of the whole space. -/ -lemma exists_homeomorph_extension {E : Type*} [normed_group E] [normed_space ℝ E] - {F : Type*} [normed_group F] [normed_space ℝ F] [finite_dimensional ℝ F] +lemma exists_homeomorph_extension {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] + {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] [finite_dimensional ℝ F] {s : set E} {f : E → F} {f' : E ≃L[ℝ] F} {c : ℝ≥0} (hf : approximates_linear_on f (f' : E →L[ℝ] F) s c) - (hc : subsingleton E ∨ lipschitz_extension_constant F * c < (∥(f'.symm : F →L[ℝ] E)∥₊)⁻¹) : + (hc : subsingleton E ∨ lipschitz_extension_constant F * c < (‖(f'.symm : F →L[ℝ] E)‖₊)⁻¹) : ∃ g : E ≃ₜ F, eq_on f g s := begin -- the difference `f - f'` is Lipschitz on `s`. It can be extended to a Lipschitz function `u` @@ -555,13 +556,13 @@ end lemma map_nhds_eq_of_surj [complete_space E] [complete_space F] {f : E → F} {f' : E →L[𝕜] F} {a : E} - (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) (h : f'.range = ⊤) : + (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) (h : linear_map.range f' = ⊤) : map f (𝓝 a) = 𝓝 (f a) := begin let f'symm := f'.nonlinear_right_inverse_of_surjective h, set c : ℝ≥0 := f'symm.nnnorm⁻¹ / 2 with hc, have f'symm_pos : 0 < f'symm.nnnorm := f'.nonlinear_right_inverse_of_surjective_nnnorm_pos h, - have cpos : 0 < c, by simp [hc, nnreal.half_pos, nnreal.inv_pos, f'symm_pos], + have cpos : 0 < c, by simp [hc, half_pos, inv_pos, f'symm_pos], obtain ⟨s, s_nhds, hs⟩ : ∃ s ∈ 𝓝 a, approximates_linear_on f f' s c := hf.approximates_deriv_on_nhds (or.inr cpos), apply hs.map_nhds_eq f'symm s_nhds (or.inr (nnreal.half_lt_self _)), @@ -572,12 +573,12 @@ variables [cs : complete_space E] {f : E → F} {f' : E ≃L[𝕜] F} {a : E} lemma approximates_deriv_on_open_nhds (hf : has_strict_fderiv_at f (f' : E →L[𝕜] F) a) : ∃ (s : set E) (hs : a ∈ s ∧ is_open s), - approximates_linear_on f (f' : E →L[𝕜] F) s (∥(f'.symm : F →L[𝕜] E)∥₊⁻¹ / 2) := + approximates_linear_on f (f' : E →L[𝕜] F) s (‖(f'.symm : F →L[𝕜] E)‖₊⁻¹ / 2) := begin refine ((nhds_basis_opens a).exists_iff _).1 _, exact (λ s t, approximates_linear_on.mono_set), exact (hf.approximates_deriv_on_nhds $ f'.subsingleton_or_nnnorm_symm_pos.imp id $ - λ hf', nnreal.half_pos $ nnreal.inv_pos.2 $ hf') + λ hf', half_pos $ inv_pos.2 hf') end include cs @@ -593,7 +594,7 @@ approximates_linear_on.to_local_homeomorph f (classical.some hf.approximates_deriv_on_open_nhds) (classical.some_spec hf.approximates_deriv_on_open_nhds).snd (f'.subsingleton_or_nnnorm_symm_pos.imp id $ λ hf', nnreal.half_lt_self $ ne_of_gt $ - nnreal.inv_pos.2 $ hf') + inv_pos.2 hf') (classical.some_spec hf.approximates_deriv_on_open_nhds).fst.2 variable {f} @@ -725,14 +726,14 @@ is_open_map_iff_nhds_le.2 $ λ x, ((hf x).map_nhds_eq (h0 x)).ge namespace cont_diff_at variables {𝕂 : Type*} [is_R_or_C 𝕂] -variables {E' : Type*} [normed_group E'] [normed_space 𝕂 E'] -variables {F' : Type*} [normed_group F'] [normed_space 𝕂 F'] +variables {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕂 E'] +variables {F' : Type*} [normed_add_comm_group F'] [normed_space 𝕂 F'] variables [complete_space E'] (f : E' → F') {f' : E' ≃L[𝕂] F'} {a : E'} /-- Given a `cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative at `a`, returns a `local_homeomorph` with `to_fun = f` and `a ∈ source`. -/ def to_local_homeomorph - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : local_homeomorph E' F' := (hf.has_strict_fderiv_at' hf' hn).to_local_homeomorph f @@ -740,18 +741,18 @@ def to_local_homeomorph variable {f} @[simp] lemma to_local_homeomorph_coe - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : (hf.to_local_homeomorph f hf' hn : E' → F') = f := rfl lemma mem_to_local_homeomorph_source - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : a ∈ (hf.to_local_homeomorph f hf' hn).source := (hf.has_strict_fderiv_at' hf' hn).mem_to_local_homeomorph_source lemma image_mem_to_local_homeomorph_target - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : f a ∈ (hf.to_local_homeomorph f hf' hn).target := (hf.has_strict_fderiv_at' hf' hn).image_mem_to_local_homeomorph_target @@ -759,13 +760,13 @@ lemma image_mem_to_local_homeomorph_target /-- Given a `cont_diff` function over `𝕂` (which is `ℝ` or `ℂ`) with an invertible derivative at `a`, returns a function that is locally inverse to `f`. -/ def local_inverse - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : F' → E' := (hf.has_strict_fderiv_at' hf' hn).local_inverse f f' a lemma local_inverse_apply_image - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : hf.local_inverse hf' hn (f a) = a := (hf.has_strict_fderiv_at' hf' hn).local_inverse_apply_image @@ -774,7 +775,7 @@ lemma local_inverse_apply_image at `a`, the inverse function (produced by `cont_diff.to_local_homeomorph`) is also `cont_diff`. -/ lemma to_local_inverse - {n : with_top ℕ} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) + {n : ℕ∞} (hf : cont_diff_at 𝕂 n f a) (hf' : has_fderiv_at f (f' : E' →L[𝕂] F') a) (hn : 1 ≤ n) : cont_diff_at 𝕂 n (hf.local_inverse hf' hn) (f a) := begin diff --git a/src/analysis/calculus/iterated_deriv.lean b/src/analysis/calculus/iterated_deriv.lean index 2b5968487d568..1c1f1e4c36a40 100644 --- a/src/analysis/calculus/iterated_deriv.lean +++ b/src/analysis/calculus/iterated_deriv.lean @@ -3,19 +3,22 @@ Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ -import analysis.calculus.deriv -import analysis.calculus.cont_diff +import analysis.calculus.deriv.comp +import analysis.calculus.cont_diff_def /-! # One-dimensional iterated derivatives +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the `n`-th derivative of a function `f : 𝕜 → F` as a function `iterated_deriv n f : 𝕜 → F`, as well as a version on domains `iterated_deriv_within n f s : 𝕜 → F`, and prove their basic properties. ## Main definitions and results -Let `𝕜` be a nondiscrete normed field, and `F` a normed vector space over `𝕜`. Let `f : 𝕜 → F`. +Let `𝕜` be a nontrivially normed field, and `F` a normed vector space over `𝕜`. Let `f : 𝕜 → F`. * `iterated_deriv n f` is the `n`-th derivative of `f`, seen as a function from `𝕜` to `F`. It is defined as the `n`-th Fréchet derivative (which is a multilinear map) applied to the @@ -41,13 +44,13 @@ iterated Fréchet derivative. -/ noncomputable theory -open_locale classical topological_space big_operators +open_locale classical topology big_operators open filter asymptotics set -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] /-- The `n`-th iterated derivative of a function from `𝕜` to `F`, as a function from `𝕜` to `F`. -/ def iterated_deriv (n : ℕ) (f : 𝕜 → F) (x : 𝕜) : F := @@ -96,22 +99,26 @@ begin simp end +lemma norm_iterated_fderiv_within_eq_norm_iterated_deriv_within : + ‖iterated_fderiv_within 𝕜 n f s x‖ = ‖iterated_deriv_within n f s x‖ := +by rw [iterated_deriv_within_eq_equiv_comp, linear_isometry_equiv.norm_map] + @[simp] lemma iterated_deriv_within_zero : iterated_deriv_within 0 f s = f := by { ext x, simp [iterated_deriv_within] } -@[simp] lemma iterated_deriv_within_one (hs : unique_diff_on 𝕜 s) {x : 𝕜} (hx : x ∈ s): +@[simp] lemma iterated_deriv_within_one {x : 𝕜} (h : unique_diff_within_at 𝕜 s x): iterated_deriv_within 1 f s x = deriv_within f s x := -by { simp [iterated_deriv_within, iterated_fderiv_within_one_apply hs hx], refl } +by { simp only [iterated_deriv_within, iterated_fderiv_within_one_apply h], refl } /-- If the first `n` derivatives within a set of a function are continuous, and its first `n-1` derivatives are differentiable, then the function is `C^n`. This is not an equivalence in general, but this is an equivalence when the set has unique derivatives, see `cont_diff_on_iff_continuous_on_differentiable_on_deriv`. -/ -lemma cont_diff_on_of_continuous_on_differentiable_on_deriv {n : with_top ℕ} - (Hcont : ∀ (m : ℕ), (m : with_top ℕ) ≤ n → +lemma cont_diff_on_of_continuous_on_differentiable_on_deriv {n : ℕ∞} + (Hcont : ∀ (m : ℕ), (m : ℕ∞) ≤ n → continuous_on (λ x, iterated_deriv_within m f s x) s) - (Hdiff : ∀ (m : ℕ), (m : with_top ℕ) < n → + (Hdiff : ∀ (m : ℕ), (m : ℕ∞) < n → differentiable_on 𝕜 (λ x, iterated_deriv_within m f s x) s) : cont_diff_on 𝕜 n f s := begin @@ -125,8 +132,8 @@ first `n` derivatives are differentiable. This is slightly too strong as the con require on the `n`-th derivative is differentiability instead of continuity, but it has the advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal). -/ -lemma cont_diff_on_of_differentiable_on_deriv {n : with_top ℕ} - (h : ∀(m : ℕ), (m : with_top ℕ) ≤ n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) : +lemma cont_diff_on_of_differentiable_on_deriv {n : ℕ∞} + (h : ∀(m : ℕ), (m : ℕ∞) ≤ n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) : cont_diff_on 𝕜 n f s := begin apply cont_diff_on_of_differentiable_on, @@ -136,28 +143,33 @@ end /-- On a set with unique derivatives, a `C^n` function has derivatives up to `n` which are continuous. -/ -lemma cont_diff_on.continuous_on_iterated_deriv_within {n : with_top ℕ} {m : ℕ} - (h : cont_diff_on 𝕜 n f s) (hmn : (m : with_top ℕ) ≤ n) (hs : unique_diff_on 𝕜 s) : +lemma cont_diff_on.continuous_on_iterated_deriv_within {n : ℕ∞} {m : ℕ} + (h : cont_diff_on 𝕜 n f s) (hmn : (m : ℕ∞) ≤ n) (hs : unique_diff_on 𝕜 s) : continuous_on (iterated_deriv_within m f s) s := by simpa only [iterated_deriv_within_eq_equiv_comp, linear_isometry_equiv.comp_continuous_on_iff] using h.continuous_on_iterated_fderiv_within hmn hs +lemma cont_diff_within_at.differentiable_within_at_iterated_deriv_within {n : ℕ∞} {m : ℕ} + (h : cont_diff_within_at 𝕜 n f s x) (hmn : (m : ℕ∞) < n) (hs : unique_diff_on 𝕜 (insert x s)) : + differentiable_within_at 𝕜 (iterated_deriv_within m f s) s x := +by simpa only [iterated_deriv_within_eq_equiv_comp, + linear_isometry_equiv.comp_differentiable_within_at_iff] + using h.differentiable_within_at_iterated_fderiv_within hmn hs + /-- On a set with unique derivatives, a `C^n` function has derivatives less than `n` which are differentiable. -/ -lemma cont_diff_on.differentiable_on_iterated_deriv_within {n : with_top ℕ} {m : ℕ} - (h : cont_diff_on 𝕜 n f s) (hmn : (m : with_top ℕ) < n) (hs : unique_diff_on 𝕜 s) : +lemma cont_diff_on.differentiable_on_iterated_deriv_within {n : ℕ∞} {m : ℕ} + (h : cont_diff_on 𝕜 n f s) (hmn : (m : ℕ∞) < n) (hs : unique_diff_on 𝕜 s) : differentiable_on 𝕜 (iterated_deriv_within m f s) s := -by simpa only [iterated_deriv_within_eq_equiv_comp, - linear_isometry_equiv.comp_differentiable_on_iff] - using h.differentiable_on_iterated_fderiv_within hmn hs +λ x hx, (h x hx).differentiable_within_at_iterated_deriv_within hmn $ by rwa [insert_eq_of_mem hx] /-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be reformulated in terms of the one-dimensional derivative on sets with unique derivatives. -/ -lemma cont_diff_on_iff_continuous_on_differentiable_on_deriv {n : with_top ℕ} +lemma cont_diff_on_iff_continuous_on_differentiable_on_deriv {n : ℕ∞} (hs : unique_diff_on 𝕜 s) : cont_diff_on 𝕜 n f s ↔ - (∀m:ℕ, (m : with_top ℕ) ≤ n → continuous_on (iterated_deriv_within m f s) s) - ∧ (∀m:ℕ, (m : with_top ℕ) < n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) := + (∀m:ℕ, (m : ℕ∞) ≤ n → continuous_on (iterated_deriv_within m f s) s) + ∧ (∀m:ℕ, (m : ℕ∞) < n → differentiable_on 𝕜 (iterated_deriv_within m f s) s) := by simp only [cont_diff_on_iff_continuous_on_differentiable_on hs, iterated_fderiv_within_eq_equiv_comp, linear_isometry_equiv.comp_continuous_on_iff, linear_isometry_equiv.comp_differentiable_on_iff] @@ -185,7 +197,7 @@ begin induction n with n IH generalizing x, { simp }, { rw [iterated_deriv_within_succ (hs x hx), function.iterate_succ'], - exact deriv_within_congr (hs x hx) (λ y hy, IH hy) (IH hx) } + exact deriv_within_congr (λ y hy, IH hy) (IH hx) } end /-- The `n+1`-th iterated derivative within a set with unique derivatives can be obtained by @@ -222,6 +234,10 @@ lemma iterated_fderiv_apply_eq_iterated_deriv_mul_prod {m : (fin n) → 𝕜} : (iterated_fderiv 𝕜 n f x : ((fin n) → 𝕜) → F) m = (∏ i, m i) • iterated_deriv n f x := by { rw [iterated_deriv_eq_iterated_fderiv, ← continuous_multilinear_map.map_smul_univ], simp } +lemma norm_iterated_fderiv_eq_norm_iterated_deriv : + ‖iterated_fderiv 𝕜 n f x‖ = ‖iterated_deriv n f x‖ := +by rw [iterated_deriv_eq_equiv_comp, linear_isometry_equiv.norm_map] + @[simp] lemma iterated_deriv_zero : iterated_deriv 0 f = f := by { ext x, simp [iterated_deriv] } @@ -232,10 +248,10 @@ by { ext x, simp [iterated_deriv], refl } /-- The property of being `C^n`, initially defined in terms of the Fréchet derivative, can be reformulated in terms of the one-dimensional derivative. -/ -lemma cont_diff_iff_iterated_deriv {n : with_top ℕ} : +lemma cont_diff_iff_iterated_deriv {n : ℕ∞} : cont_diff 𝕜 n f ↔ -(∀m:ℕ, (m : with_top ℕ) ≤ n → continuous (iterated_deriv m f)) -∧ (∀m:ℕ, (m : with_top ℕ) < n → differentiable 𝕜 (iterated_deriv m f)) := +(∀m:ℕ, (m : ℕ∞) ≤ n → continuous (iterated_deriv m f)) +∧ (∀m:ℕ, (m : ℕ∞) < n → differentiable 𝕜 (iterated_deriv m f)) := by simp only [cont_diff_iff_continuous_differentiable, iterated_fderiv_eq_equiv_comp, linear_isometry_equiv.comp_continuous_iff, linear_isometry_equiv.comp_differentiable_iff] @@ -244,19 +260,19 @@ first `n` derivatives are differentiable. This is slightly too strong as the con require on the `n`-th derivative is differentiability instead of continuity, but it has the advantage of avoiding the discussion of continuity in the proof (and for `n = ∞` this is optimal). -/ -lemma cont_diff_of_differentiable_iterated_deriv {n : with_top ℕ} - (h : ∀(m : ℕ), (m : with_top ℕ) ≤ n → differentiable 𝕜 (iterated_deriv m f)) : +lemma cont_diff_of_differentiable_iterated_deriv {n : ℕ∞} + (h : ∀(m : ℕ), (m : ℕ∞) ≤ n → differentiable 𝕜 (iterated_deriv m f)) : cont_diff 𝕜 n f := cont_diff_iff_iterated_deriv.2 ⟨λ m hm, (h m hm).continuous, λ m hm, (h m (le_of_lt hm))⟩ -lemma cont_diff.continuous_iterated_deriv {n : with_top ℕ} (m : ℕ) - (h : cont_diff 𝕜 n f) (hmn : (m : with_top ℕ) ≤ n) : +lemma cont_diff.continuous_iterated_deriv {n : ℕ∞} (m : ℕ) + (h : cont_diff 𝕜 n f) (hmn : (m : ℕ∞) ≤ n) : continuous (iterated_deriv m f) := (cont_diff_iff_iterated_deriv.1 h).1 m hmn -lemma cont_diff.differentiable_iterated_deriv {n : with_top ℕ} (m : ℕ) - (h : cont_diff 𝕜 n f) (hmn : (m : with_top ℕ) < n) : +lemma cont_diff.differentiable_iterated_deriv {n : ℕ∞} (m : ℕ) + (h : cont_diff 𝕜 n f) (hmn : (m : ℕ∞) < n) : differentiable 𝕜 (iterated_deriv m f) := (cont_diff_iff_iterated_deriv.1 h).2 m hmn diff --git a/src/analysis/calculus/lagrange_multipliers.lean b/src/analysis/calculus/lagrange_multipliers.lean index c3afa9a53c422..4304f3d350b42 100644 --- a/src/analysis/calculus/lagrange_multipliers.lean +++ b/src/analysis/calculus/lagrange_multipliers.lean @@ -9,6 +9,9 @@ import linear_algebra.dual /-! # Lagrange multipliers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we formalize the [Lagrange multipliers](https://en.wikipedia.org/wiki/Lagrange_multiplier) method of solving conditional extremum problems: if a function `φ` has a local extremum at `x₀` on the set @@ -27,9 +30,9 @@ lagrange multiplier, local extremum -/ open filter set -open_locale topological_space filter big_operators -variables {E F : Type*} [normed_group E] [normed_space ℝ E] [complete_space E] - [normed_group F] [normed_space ℝ F] [complete_space F] +open_locale topology filter big_operators +variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] + [normed_add_comm_group F] [normed_space ℝ F] [complete_space F] {f : E → F} {φ : E → ℝ} {x₀ : E} {f' : E →L[ℝ] F} {φ' : E →L[ℝ] ℝ} /-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}` @@ -38,7 +41,7 @@ a complete space, then the linear map `x ↦ (f' x, φ' x)` is not surjective. - lemma is_local_extr_on.range_ne_top_of_has_strict_fderiv_at (hextr : is_local_extr_on φ {x | f x = f x₀} x₀) (hf' : has_strict_fderiv_at f f' x₀) (hφ' : has_strict_fderiv_at φ φ' x₀) : - (f'.prod φ').range ≠ ⊤ := + linear_map.range (f'.prod φ') ≠ ⊤ := begin intro htop, set fφ := λ x, (f x, φ x), @@ -68,11 +71,12 @@ begin refine ⟨Λ, Λ₀, e.map_ne_zero_iff.1 h0, λ x, _⟩, convert linear_map.congr_fun (linear_map.range_le_ker_iff.1 hΛ') x using 1, -- squeezed `simp [mul_comm]` to speed up elaboration - simp only [linear_map.coprod_equiv_apply, linear_equiv.refl_apply, - linear_map.ring_lmap_equiv_self_symm_apply, linear_map.comp_apply, - continuous_linear_map.coe_coe, continuous_linear_map.prod_apply, - linear_equiv.trans_apply, linear_equiv.prod_apply, linear_map.coprod_apply, - linear_map.smul_right_apply, linear_map.one_apply, smul_eq_mul, mul_comm] + simp only [mul_comm, algebra.id.smul_eq_mul, linear_equiv.trans_apply, linear_equiv.prod_apply, + linear_equiv.refl_apply, linear_map.ring_lmap_equiv_self_symm_apply, + linear_map.coprod_equiv_apply, continuous_linear_map.to_linear_map_eq_coe, + continuous_linear_map.coe_prod, linear_map.coprod_comp_prod, linear_map.add_apply, + linear_map.coe_comp, continuous_linear_map.coe_coe, linear_map.coe_smul_right, + linear_map.one_apply] end /-- Lagrange multipliers theorem: if `φ : E → ℝ` has a local extremum on the set `{x | f x = f x₀}` @@ -133,16 +137,17 @@ Then the derivatives `f' i : E → L[ℝ] ℝ` and `φ' : E →L[ℝ] ℝ` are l See also `is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at` for a version that that states existence of Lagrange multipliers `Λ` and `Λ₀` instead of using `¬linear_independent ℝ _` -/ -lemma is_local_extr_on.linear_dependent_of_has_strict_fderiv_at {ι : Type*} [fintype ι] +lemma is_local_extr_on.linear_dependent_of_has_strict_fderiv_at {ι : Type*} [finite ι] {f : ι → E → ℝ} {f' : ι → E →L[ℝ] ℝ} (hextr : is_local_extr_on φ {x | ∀ i, f i x = f i x₀} x₀) (hf' : ∀ i, has_strict_fderiv_at (f i) (f' i) x₀) (hφ' : has_strict_fderiv_at φ φ' x₀) : - ¬linear_independent ℝ (λ i, option.elim i φ' f' : option ι → E →L[ℝ] ℝ) := + ¬linear_independent ℝ (option.elim φ' f' : option ι → E →L[ℝ] ℝ) := begin + casesI nonempty_fintype ι, rw [fintype.linear_independent_iff], push_neg, rcases hextr.exists_multipliers_of_has_strict_fderiv_at hf' hφ' with ⟨Λ, Λ₀, hΛ, hΛf⟩, - refine ⟨λ i, option.elim i Λ₀ Λ, _, _⟩, + refine ⟨option.elim Λ₀ Λ, _, _⟩, { simpa [add_comm] using hΛf }, { simpa [function.funext_iff, not_and_distrib, or_comm, option.exists] using hΛ } end diff --git a/src/analysis/calculus/lhopital.lean b/src/analysis/calculus/lhopital.lean index 451bad09d3c04..8ab77bf182d86 100644 --- a/src/analysis/calculus/lhopital.lean +++ b/src/analysis/calculus/lhopital.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Anatole Dedecker -/ import analysis.calculus.mean_value +import analysis.calculus.deriv.inv /-! # L'Hôpital's rule for 0/0 indeterminate forms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove several forms of "L'Hopital's rule" for computing 0/0 indeterminate forms. The proof of `has_deriv_at.lhopital_zero_right_on_Ioo` is based on the one given in the corresponding @@ -29,7 +33,7 @@ L'Hôpital's rule, L'Hopital's rule -/ open filter set -open_locale filter topological_space pointwise +open_locale filter topology pointwise variables {a b : ℝ} (hab : a < b) {l : filter ℝ} {f f' g g' : ℝ → ℝ} @@ -96,8 +100,8 @@ theorem lhopital_zero_right_on_Ico (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b)) (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0) (hfa : f a = 0) (hga : g a = 0) - (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within a (Ioi a)) l) : - tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l := + (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[>] a) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l := begin refine lhopital_zero_right_on_Ioo hab hff' hgg' hg' _ _ hdiv, { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab], @@ -109,9 +113,9 @@ end theorem lhopital_zero_left_on_Ioo (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x) (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0) - (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0)) - (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) : - tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l := + (hfb : tendsto f (𝓝[<] b) (𝓝 0)) (hgb : tendsto g (𝓝[<] b) (𝓝 0)) + (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[<] b) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[<] b) l := begin -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details. have hdnf : ∀ x ∈ -Ioo a b, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x, @@ -138,8 +142,8 @@ theorem lhopital_zero_left_on_Ioc (hcf : continuous_on f (Ioc a b)) (hcg : continuous_on g (Ioc a b)) (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0) (hfb : f b = 0) (hgb : g b = 0) - (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) : - tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l := + (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[<] b) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[<] b) l := begin refine lhopital_zero_left_on_Ioo hab hff' hgg' hg' _ _ hdiv, { rw [← hfb, ← nhds_within_Ioo_eq_nhds_within_Iio hab], @@ -237,8 +241,8 @@ theorem lhopital_zero_right_on_Ico (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b)) (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0) (hfa : f a = 0) (hga : g a = 0) - (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within a (Ioi a)) l) : - tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l := + (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[>] a) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l := begin refine lhopital_zero_right_on_Ioo hab hdf hg' _ _ hdiv, { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab], @@ -250,9 +254,9 @@ end theorem lhopital_zero_left_on_Ioo (hdf : differentiable_on ℝ f (Ioo a b)) (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0) - (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0)) - (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within b (Iio b)) l) : - tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l := + (hfb : tendsto f (𝓝[<] b) (𝓝 0)) (hgb : tendsto g (𝓝[<] b) (𝓝 0)) + (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[<] b) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[<] b) l := begin have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x, from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2), @@ -354,16 +358,14 @@ end /-- L'Hôpital's rule for approaching a real, `has_deriv_at` version. This does not require anything about the situation at `a` -/ theorem lhopital_zero_nhds' - (hff' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at f (f' x) x) - (hgg' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at g (g' x) x) - (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, g' x ≠ 0) - (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0)) - (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[univ \ {a}] a) l) : - tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l := + (hff' : ∀ᶠ x in 𝓝[≠] a, has_deriv_at f (f' x) x) + (hgg' : ∀ᶠ x in 𝓝[≠] a, has_deriv_at g (g' x) x) + (hg' : ∀ᶠ x in 𝓝[≠] a, g' x ≠ 0) + (hfa : tendsto f (𝓝[≠] a) (𝓝 0)) (hga : tendsto g (𝓝[≠] a) (𝓝 0)) + (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[≠] a) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[≠] a) l := begin - have : univ \ {a} = Iio a ∪ Ioi a, - { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl }, - simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *, + simp only [←Iio_union_Ioi, nhds_within_union, tendsto_sup, eventually_sup] at *, exact ⟨lhopital_zero_nhds_left hff'.1 hgg'.1 hg'.1 hfa.1 hga.1 hdiv.1, lhopital_zero_nhds_right hff'.2 hgg'.2 hg'.2 hfa.2 hga.2 hdiv.2⟩ end @@ -375,7 +377,7 @@ theorem lhopital_zero_nhds (hg' : ∀ᶠ x in 𝓝 a, g' x ≠ 0) (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0)) (hdiv : tendsto (λ x, f' x / g' x) (𝓝 a) l) : - tendsto (λ x, f x / g x) (𝓝[univ \ {a}] a) l := + tendsto (λ x, f x / g x) (𝓝[≠] a) l := begin apply @lhopital_zero_nhds' _ _ _ f' _ g'; apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds; @@ -473,15 +475,13 @@ end /-- **L'Hôpital's rule** for approaching a real, `deriv` version. This does not require anything about the situation at `a` -/ theorem lhopital_zero_nhds' - (hdf : ∀ᶠ x in 𝓝[univ \ {a}] a, differentiable_at ℝ f x) - (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, deriv g x ≠ 0) - (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0)) - (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[univ \ {a}] a) l) : - tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l := + (hdf : ∀ᶠ x in 𝓝[≠] a, differentiable_at ℝ f x) + (hg' : ∀ᶠ x in 𝓝[≠] a, deriv g x ≠ 0) + (hfa : tendsto f (𝓝[≠] a) (𝓝 0)) (hga : tendsto g (𝓝[≠] a) (𝓝 0)) + (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[≠] a) l) : + tendsto (λ x, (f x) / (g x)) (𝓝[≠] a) l := begin - have : univ \ {a} = Iio a ∪ Ioi a, - { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl }, - simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *, + simp only [←Iio_union_Ioi, nhds_within_union, tendsto_sup, eventually_sup] at *, exact ⟨lhopital_zero_nhds_left hdf.1 hg'.1 hfa.1 hga.1 hdiv.1, lhopital_zero_nhds_right hdf.2 hg'.2 hfa.2 hga.2 hdiv.2⟩, end @@ -492,7 +492,7 @@ theorem lhopital_zero_nhds (hg' : ∀ᶠ x in 𝓝 a, deriv g x ≠ 0) (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0)) (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝 a) l) : - tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l := + tendsto (λ x, (f x) / (g x)) (𝓝[≠] a) l := begin apply lhopital_zero_nhds'; apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds; diff --git a/src/analysis/calculus/local_extr.lean b/src/analysis/calculus/local_extr.lean index 0b78a246c8959..4cdcfeacb43e7 100644 --- a/src/analysis/calculus/local_extr.lean +++ b/src/analysis/calculus/local_extr.lean @@ -3,15 +3,16 @@ Copyright (c) 2019 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import analysis.calculus.deriv -import data.polynomial.field_division +import analysis.calculus.deriv.polynomial import topology.algebra.order.extend_from import topology.algebra.polynomial -import topology.local_extr /-! # Local extrema of smooth functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions In a real normed space `E` we define `pos_tangent_cone_at (s : set E) (x : E)`. @@ -65,15 +66,15 @@ local extremum, Fermat's Theorem, Rolle's Theorem universes u v open filter set -open_locale topological_space classical polynomial +open_locale topology classical polynomial section module -variables {E : Type u} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {a : E} +variables {E : Type u} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {a : E} {f' : E →L[ℝ] ℝ} /-- "Positive" tangent cone to `s` at `x`; the only difference from `tangent_cone_at` -is that we require `c n → ∞` instead of `∥c n∥ → ∞`. One can think about `pos_tangent_cone_at` +is that we require `c n → ∞` instead of `‖c n‖ → ∞`. One can think about `pos_tangent_cone_at` as `tangent_cone_at nnreal` but we have no theory of normed semifields yet. -/ def pos_tangent_cone_at (s : set E) (x : E) : set E := {y : E | ∃(c : ℕ → ℝ) (d : ℕ → E), (∀ᶠ n in at_top, x + d n ∈ s) ∧ @@ -119,7 +120,7 @@ lemma is_local_max_on.has_fderiv_within_at_nonpos {s : set E} (h : is_local_max_ f' y ≤ 0 := begin rcases hy with ⟨c, d, hd, hc, hcd⟩, - have hc' : tendsto (λ n, ∥c n∥) at_top at_top, + have hc' : tendsto (λ n, ‖c n‖) at_top at_top, from tendsto_at_top_mono (λ n, le_abs_self _) hc, refine le_of_tendsto (hf.lim at_top hd hc' hcd) _, replace hd : tendsto (λ n, a + d n) at_top (𝓝[s] (a + 0)), @@ -357,24 +358,69 @@ end Rolle namespace polynomial -lemma card_root_set_le_derivative {F : Type*} [field F] [algebra F ℝ] (p : F[X]) : - fintype.card (p.root_set ℝ) ≤ fintype.card (p.derivative.root_set ℝ) + 1 := +open_locale big_operators + +/-- The number of roots of a real polynomial `p` is at most the number of roots of its derivative +that are not roots of `p` plus one. -/ +lemma card_roots_to_finset_le_card_roots_derivative_diff_roots_succ (p : ℝ[X]) : + p.roots.to_finset.card ≤ (p.derivative.roots.to_finset \ p.roots.to_finset).card + 1 := begin - haveI : char_zero F := - (ring_hom.char_zero_iff (algebra_map F ℝ).injective).mpr (by apply_instance), - by_cases hp : p = 0, - { simp_rw [hp, derivative_zero, root_set_zero, set.empty_card', zero_le_one] }, - by_cases hp' : p.derivative = 0, - { rw eq_C_of_nat_degree_eq_zero (nat_degree_eq_zero_of_derivative_eq_zero hp'), - simp_rw [root_set_C, set.empty_card', zero_le] }, - simp_rw [root_set_def, finset.coe_sort_coe, fintype.card_coe], - refine finset.card_le_of_interleaved (λ x hx y hy hxy, _), - rw [←finset.mem_coe, ←root_set_def, mem_root_set hp] at hx hy, - obtain ⟨z, hz1, hz2⟩ := exists_deriv_eq_zero (λ x : ℝ, aeval x p) hxy - p.continuous_aeval.continuous_on (hx.trans hy.symm), + cases eq_or_ne p.derivative 0 with hp' hp', + { rw [eq_C_of_derivative_eq_zero hp', roots_C, multiset.to_finset_zero, finset.card_empty], + exact zero_le _ }, + have hp : p ≠ 0, from ne_of_apply_ne derivative (by rwa [derivative_zero]), + refine finset.card_le_diff_of_interleaved (λ x hx y hy hxy hxy', _), + rw [multiset.mem_to_finset, mem_roots hp] at hx hy, + obtain ⟨z, hz1, hz2⟩ := exists_deriv_eq_zero (λ x : ℝ, eval x p) hxy + p.continuous_on (hx.trans hy.symm), refine ⟨z, _, hz1⟩, - rw [←finset.mem_coe, ←root_set_def, mem_root_set hp', ←hz2], - simp_rw [aeval_def, ←eval_map, polynomial.deriv, derivative_map], + rwa [multiset.mem_to_finset, mem_roots hp', is_root, ← p.deriv] end +/-- The number of roots of a real polynomial is at most the number of roots of its derivative plus +one. -/ +lemma card_roots_to_finset_le_derivative (p : ℝ[X]) : + p.roots.to_finset.card ≤ p.derivative.roots.to_finset.card + 1 := +p.card_roots_to_finset_le_card_roots_derivative_diff_roots_succ.trans $ + add_le_add_right (finset.card_mono $ finset.sdiff_subset _ _) _ + +/-- The number of roots of a real polynomial (counted with multiplicities) is at most the number of +roots of its derivative (counted with multiplicities) plus one. -/ +lemma card_roots_le_derivative (p : ℝ[X]) : p.roots.card ≤ p.derivative.roots.card + 1 := +calc p.roots.card = ∑ x in p.roots.to_finset, p.roots.count x : + (multiset.to_finset_sum_count_eq _).symm +... = ∑ x in p.roots.to_finset, (p.roots.count x - 1 + 1) : + eq.symm $ finset.sum_congr rfl $ λ x hx, tsub_add_cancel_of_le $ nat.succ_le_iff.2 $ + multiset.count_pos.2 $ multiset.mem_to_finset.1 hx +... = ∑ x in p.roots.to_finset, (p.root_multiplicity x - 1) + p.roots.to_finset.card : + by simp only [finset.sum_add_distrib, finset.card_eq_sum_ones, count_roots] +... ≤ ∑ x in p.roots.to_finset, p.derivative.root_multiplicity x + + ((p.derivative.roots.to_finset \ p.roots.to_finset).card + 1) : + add_le_add + (finset.sum_le_sum $ λ x hx, root_multiplicity_sub_one_le_derivative_root_multiplicity _ _) + p.card_roots_to_finset_le_card_roots_derivative_diff_roots_succ +... ≤ ∑ x in p.roots.to_finset, p.derivative.roots.count x + + (∑ x in p.derivative.roots.to_finset \ p.roots.to_finset, p.derivative.roots.count x + 1) : + begin + simp only [← count_roots], + refine add_le_add_left (add_le_add_right ((finset.card_eq_sum_ones _).trans_le _) _) _, + refine finset.sum_le_sum (λ x hx, nat.succ_le_iff.2 $ _), + rw [multiset.count_pos, ← multiset.mem_to_finset], + exact (finset.mem_sdiff.1 hx).1 + end +... = p.derivative.roots.card + 1 : + begin + rw [← add_assoc, ← finset.sum_union finset.disjoint_sdiff, finset.union_sdiff_self_eq_union, + ← multiset.to_finset_sum_count_eq, ← finset.sum_subset (finset.subset_union_right _ _)], + intros x hx₁ hx₂, + simpa only [multiset.mem_to_finset, multiset.count_eq_zero] using hx₂ + end + +/-- The number of real roots of a polynomial is at most the number of roots of its derivative plus +one. -/ +lemma card_root_set_le_derivative {F : Type*} [comm_ring F] [algebra F ℝ] (p : F[X]) : + fintype.card (p.root_set ℝ) ≤ fintype.card (p.derivative.root_set ℝ) + 1 := +by simpa only [root_set_def, finset.coe_sort_coe, fintype.card_coe, derivative_map] + using card_roots_to_finset_le_derivative (p.map (algebra_map F ℝ)) + end polynomial diff --git a/src/analysis/calculus/mean_value.lean b/src/analysis/calculus/mean_value.lean index bf83cd7b330ec..1fcb04ffbf97d 100644 --- a/src/analysis/calculus/mean_value.lean +++ b/src/analysis/calculus/mean_value.lean @@ -3,14 +3,19 @@ Copyright (c) 2019 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel, Yury Kudryashov -/ +import analysis.calculus.deriv.slope import analysis.calculus.local_extr import analysis.convex.slope -import analysis.convex.topology -import data.complex.is_R_or_C +import analysis.convex.normed +import data.is_R_or_C.basic +import topology.instances.real_vector_space /-! # The mean value inequality and equalities +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove the following facts: * `convex.norm_image_sub_le_of_norm_deriv_le` : if `f` is differentiable on a convex set `s` @@ -20,20 +25,20 @@ In this file we prove the following facts: so they work both for real and complex derivatives. * `image_le_of*`, `image_norm_le_of_*` : several similar lemmas deducing `f x ≤ B x` or - `∥f x∥ ≤ B x` from upper estimates on `f'` or `∥f'∥`, respectively. These lemmas differ by + `‖f x‖ ≤ B x` from upper estimates on `f'` or `‖f'‖`, respectively. These lemmas differ by their assumptions: * `of_liminf_*` lemmas assume that limit inferior of some ratio is less than `B' x`; * `of_deriv_right_*`, `of_norm_deriv_right_*` lemmas assume that the right derivative or its norm is less than `B' x`; - * `of_*_lt_*` lemmas assume a strict inequality whenever `f x = B x` or `∥f x∥ = B x`; + * `of_*_lt_*` lemmas assume a strict inequality whenever `f x = B x` or `‖f x‖ = B x`; * `of_*_le_*` lemmas assume a non-strict inequality everywhere on `[a, b)`; * name of a lemma ends with `'` if (1) it assumes that `B` is continuous on `[a, b]` and has a right derivative at every point of `[a, b)`, and (2) the lemma has a counterpart assuming that `B` is differentiable everywhere on `ℝ` * `norm_image_sub_le_*_segment` : if derivative of `f` on `[a, b]` is bounded above - by a constant `C`, then `∥f x - f a∥ ≤ C * ∥x - a∥`; several versions deal with + by a constant `C`, then `‖f x - f a‖ ≤ C * ‖x - a‖`; several versions deal with right derivative and derivative within `[a, b]` (`has_deriv_within_at` or `deriv_within`). * `convex.is_const_of_fderiv_within_eq_zero` : if a function has derivative `0` on a convex set `s`, @@ -64,11 +69,11 @@ In this file we prove the following facts: -/ -variables {E : Type*} [normed_group E] [normed_space ℝ E] - {F : Type*} [normed_group F] [normed_space ℝ F] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] + {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] open metric set asymptotics continuous_linear_map filter -open_locale classical topological_space nnreal +open_locale classical topology nnreal /-! ### One-dimensional fencing inequalities -/ @@ -244,62 +249,62 @@ variables {f : ℝ → E} {a b : ℝ} /-- General fencing theorem for continuous functions with an estimate on the derivative. Let `f` and `B` be continuous functions on `[a, b]` such that -* `∥f a∥ ≤ B a`; +* `‖f a‖ ≤ B a`; * `B` has right derivative at every point of `[a, b)`; -* for each `x ∈ [a, b)` the right-side limit inferior of `(∥f z∥ - ∥f x∥) / (z - x)` +* for each `x ∈ [a, b)` the right-side limit inferior of `(‖f z‖ - ‖f x‖) / (z - x)` is bounded above by a function `f'`; -* we have `f' x < B' x` whenever `∥f x∥ = B x`. +* we have `f' x < B' x` whenever `‖f x‖ = B x`. -Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. -/ -lemma image_norm_le_of_liminf_right_slope_norm_lt_deriv_boundary {E : Type*} [normed_group E] - {f : ℝ → E} {f' : ℝ → ℝ} (hf : continuous_on f (Icc a b)) - -- `hf'` actually says `liminf (∥f z∥ - ∥f x∥) / (z - x) ≤ f' x` +Then `‖f x‖ ≤ B x` everywhere on `[a, b]`. -/ +lemma image_norm_le_of_liminf_right_slope_norm_lt_deriv_boundary {E : Type*} + [normed_add_comm_group E] {f : ℝ → E} {f' : ℝ → ℝ} (hf : continuous_on f (Icc a b)) + -- `hf'` actually says `liminf (‖f z‖ - ‖f x‖) / (z - x) ≤ f' x` (hf' : ∀ x ∈ Ico a b, ∀ r, f' x < r → ∃ᶠ z in 𝓝[>] x, slope (norm ∘ f) x z < r) - {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : continuous_on B (Icc a b)) + {B B' : ℝ → ℝ} (ha : ‖f a‖ ≤ B a) (hB : continuous_on B (Icc a b)) (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x) - (bound : ∀ x ∈ Ico a b, ∥f x∥ = B x → f' x < B' x) : - ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x := + (bound : ∀ x ∈ Ico a b, ‖f x‖ = B x → f' x < B' x) : + ∀ ⦃x⦄, x ∈ Icc a b → ‖f x‖ ≤ B x := image_le_of_liminf_slope_right_lt_deriv_boundary' (continuous_norm.comp_continuous_on hf) hf' ha hB hB' bound /-- General fencing theorem for continuous functions with an estimate on the norm of the derivative. Let `f` and `B` be continuous functions on `[a, b]` such that -* `∥f a∥ ≤ B a`; +* `‖f a‖ ≤ B a`; * `f` and `B` have right derivatives `f'` and `B'` respectively at every point of `[a, b)`; -* the norm of `f'` is strictly less than `B'` whenever `∥f x∥ = B x`. +* the norm of `f'` is strictly less than `B'` whenever `‖f x‖ = B x`. -Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions +Then `‖f x‖ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions to make this theorem work for piecewise differentiable functions. -/ lemma image_norm_le_of_norm_deriv_right_lt_deriv_boundary' {f' : ℝ → E} (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x) - {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : continuous_on B (Icc a b)) + {B B' : ℝ → ℝ} (ha : ‖f a‖ ≤ B a) (hB : continuous_on B (Icc a b)) (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x) - (bound : ∀ x ∈ Ico a b, ∥f x∥ = B x → ∥f' x∥ < B' x) : - ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x := + (bound : ∀ x ∈ Ico a b, ‖f x‖ = B x → ‖f' x‖ < B' x) : + ∀ ⦃x⦄, x ∈ Icc a b → ‖f x‖ ≤ B x := image_norm_le_of_liminf_right_slope_norm_lt_deriv_boundary hf (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le hr) ha hB hB' bound /-- General fencing theorem for continuous functions with an estimate on the norm of the derivative. Let `f` and `B` be continuous functions on `[a, b]` such that -* `∥f a∥ ≤ B a`; +* `‖f a‖ ≤ B a`; * `f` has right derivative `f'` at every point of `[a, b)`; * `B` has derivative `B'` everywhere on `ℝ`; -* the norm of `f'` is strictly less than `B'` whenever `∥f x∥ = B x`. +* the norm of `f'` is strictly less than `B'` whenever `‖f x‖ = B x`. -Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions +Then `‖f x‖ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions to make this theorem work for piecewise differentiable functions. -/ lemma image_norm_le_of_norm_deriv_right_lt_deriv_boundary {f' : ℝ → E} (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x) - {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x) - (bound : ∀ x ∈ Ico a b, ∥f x∥ = B x → ∥f' x∥ < B' x) : - ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x := + {B B' : ℝ → ℝ} (ha : ‖f a‖ ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x) + (bound : ∀ x ∈ Ico a b, ‖f x‖ = B x → ‖f' x‖ < B' x) : + ∀ ⦃x⦄, x ∈ Icc a b → ‖f x‖ ≤ B x := image_norm_le_of_norm_deriv_right_lt_deriv_boundary' hf hf' ha (λ x hx, (hB x).continuous_at.continuous_within_at) (λ x hx, (hB x).has_deriv_within_at) bound @@ -307,51 +312,51 @@ image_norm_le_of_norm_deriv_right_lt_deriv_boundary' hf hf' ha /-- General fencing theorem for continuous functions with an estimate on the norm of the derivative. Let `f` and `B` be continuous functions on `[a, b]` such that -* `∥f a∥ ≤ B a`; +* `‖f a‖ ≤ B a`; * `f` and `B` have right derivatives `f'` and `B'` respectively at every point of `[a, b)`; -* we have `∥f' x∥ ≤ B x` everywhere on `[a, b)`. +* we have `‖f' x‖ ≤ B x` everywhere on `[a, b)`. -Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions +Then `‖f x‖ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions to make this theorem work for piecewise differentiable functions. -/ lemma image_norm_le_of_norm_deriv_right_le_deriv_boundary' {f' : ℝ → E} (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x) - {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : continuous_on B (Icc a b)) + {B B' : ℝ → ℝ} (ha : ‖f a‖ ≤ B a) (hB : continuous_on B (Icc a b)) (hB' : ∀ x ∈ Ico a b, has_deriv_within_at B (B' x) (Ici x) x) - (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ B' x) : - ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x := + (bound : ∀ x ∈ Ico a b, ‖f' x‖ ≤ B' x) : + ∀ ⦃x⦄, x ∈ Icc a b → ‖f x‖ ≤ B x := image_le_of_liminf_slope_right_le_deriv_boundary (continuous_norm.comp_continuous_on hf) ha hB hB' $ (λ x hx r hr, (hf' x hx).liminf_right_slope_norm_le (lt_of_le_of_lt (bound x hx) hr)) /-- General fencing theorem for continuous functions with an estimate on the norm of the derivative. Let `f` and `B` be continuous functions on `[a, b]` such that -* `∥f a∥ ≤ B a`; +* `‖f a‖ ≤ B a`; * `f` has right derivative `f'` at every point of `[a, b)`; * `B` has derivative `B'` everywhere on `ℝ`; -* we have `∥f' x∥ ≤ B x` everywhere on `[a, b)`. +* we have `‖f' x‖ ≤ B x` everywhere on `[a, b)`. -Then `∥f x∥ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions +Then `‖f x‖ ≤ B x` everywhere on `[a, b]`. We use one-sided derivatives in the assumptions to make this theorem work for piecewise differentiable functions. -/ lemma image_norm_le_of_norm_deriv_right_le_deriv_boundary {f' : ℝ → E} (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x) - {B B' : ℝ → ℝ} (ha : ∥f a∥ ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x) - (bound : ∀ x ∈ Ico a b, ∥f' x∥ ≤ B' x) : - ∀ ⦃x⦄, x ∈ Icc a b → ∥f x∥ ≤ B x := + {B B' : ℝ → ℝ} (ha : ‖f a‖ ≤ B a) (hB : ∀ x, has_deriv_at B (B' x) x) + (bound : ∀ x ∈ Ico a b, ‖f' x‖ ≤ B' x) : + ∀ ⦃x⦄, x ∈ Icc a b → ‖f x‖ ≤ B x := image_norm_le_of_norm_deriv_right_le_deriv_boundary' hf hf' ha (λ x hx, (hB x).continuous_at.continuous_within_at) (λ x hx, (hB x).has_deriv_within_at) bound /-- A function on `[a, b]` with the norm of the right derivative bounded by `C` -satisfies `∥f x - f a∥ ≤ C * (x - a)`. -/ +satisfies `‖f x - f a‖ ≤ C * (x - a)`. -/ theorem norm_image_sub_le_of_norm_deriv_right_le_segment {f' : ℝ → E} {C : ℝ} (hf : continuous_on f (Icc a b)) (hf' : ∀ x ∈ Ico a b, has_deriv_within_at f (f' x) (Ici x) x) - (bound : ∀x ∈ Ico a b, ∥f' x∥ ≤ C) : - ∀ x ∈ Icc a b, ∥f x - f a∥ ≤ C * (x - a) := + (bound : ∀x ∈ Ico a b, ‖f' x‖ ≤ C) : + ∀ x ∈ Icc a b, ‖f x - f a‖ ≤ C * (x - a) := begin let g := λ x, f x - f a, have hg : continuous_on g (Icc a b), from hf.sub continuous_on_const, @@ -367,12 +372,12 @@ begin end /-- A function on `[a, b]` with the norm of the derivative within `[a, b]` -bounded by `C` satisfies `∥f x - f a∥ ≤ C * (x - a)`, `has_deriv_within_at` +bounded by `C` satisfies `‖f x - f a‖ ≤ C * (x - a)`, `has_deriv_within_at` version. -/ theorem norm_image_sub_le_of_norm_deriv_le_segment' {f' : ℝ → E} {C : ℝ} (hf : ∀ x ∈ Icc a b, has_deriv_within_at f (f' x) (Icc a b) x) - (bound : ∀x ∈ Ico a b, ∥f' x∥ ≤ C) : - ∀ x ∈ Icc a b, ∥f x - f a∥ ≤ C * (x - a) := + (bound : ∀x ∈ Ico a b, ‖f' x‖ ≤ C) : + ∀ x ∈ Icc a b, ‖f x - f a‖ ≤ C * (x - a) := begin refine norm_image_sub_le_of_norm_deriv_right_le_segment (λ x hx, (hf x hx).continuous_within_at) (λ x hx, _) bound, @@ -380,32 +385,32 @@ begin end /-- A function on `[a, b]` with the norm of the derivative within `[a, b]` -bounded by `C` satisfies `∥f x - f a∥ ≤ C * (x - a)`, `deriv_within` +bounded by `C` satisfies `‖f x - f a‖ ≤ C * (x - a)`, `deriv_within` version. -/ theorem norm_image_sub_le_of_norm_deriv_le_segment {C : ℝ} (hf : differentiable_on ℝ f (Icc a b)) - (bound : ∀x ∈ Ico a b, ∥deriv_within f (Icc a b) x∥ ≤ C) : - ∀ x ∈ Icc a b, ∥f x - f a∥ ≤ C * (x - a) := + (bound : ∀x ∈ Ico a b, ‖deriv_within f (Icc a b) x‖ ≤ C) : + ∀ x ∈ Icc a b, ‖f x - f a‖ ≤ C * (x - a) := begin refine norm_image_sub_le_of_norm_deriv_le_segment' _ bound, exact λ x hx, (hf x hx).has_deriv_within_at end /-- A function on `[0, 1]` with the norm of the derivative within `[0, 1]` -bounded by `C` satisfies `∥f 1 - f 0∥ ≤ C`, `has_deriv_within_at` +bounded by `C` satisfies `‖f 1 - f 0‖ ≤ C`, `has_deriv_within_at` version. -/ theorem norm_image_sub_le_of_norm_deriv_le_segment_01' {f' : ℝ → E} {C : ℝ} (hf : ∀ x ∈ Icc (0:ℝ) 1, has_deriv_within_at f (f' x) (Icc (0:ℝ) 1) x) - (bound : ∀x ∈ Ico (0:ℝ) 1, ∥f' x∥ ≤ C) : - ∥f 1 - f 0∥ ≤ C := + (bound : ∀x ∈ Ico (0:ℝ) 1, ‖f' x‖ ≤ C) : + ‖f 1 - f 0‖ ≤ C := by simpa only [sub_zero, mul_one] using norm_image_sub_le_of_norm_deriv_le_segment' hf bound 1 (right_mem_Icc.2 zero_le_one) /-- A function on `[0, 1]` with the norm of the derivative within `[0, 1]` -bounded by `C` satisfies `∥f 1 - f 0∥ ≤ C`, `deriv_within` version. -/ +bounded by `C` satisfies `‖f 1 - f 0‖ ≤ C`, `deriv_within` version. -/ theorem norm_image_sub_le_of_norm_deriv_le_segment_01 {C : ℝ} (hf : differentiable_on ℝ f (Icc (0:ℝ) 1)) - (bound : ∀x ∈ Ico (0:ℝ) 1, ∥deriv_within f (Icc (0:ℝ) 1) x∥ ≤ C) : - ∥f 1 - f 0∥ ≤ C := + (bound : ∀x ∈ Ico (0:ℝ) 1, ‖deriv_within f (Icc (0:ℝ) 1) x‖ ≤ C) : + ‖f 1 - f 0‖ ≤ C := by simpa only [sub_zero, mul_one] using norm_image_sub_le_of_norm_deriv_le_segment hf bound 1 (right_mem_Icc.2 zero_le_one) @@ -420,7 +425,7 @@ theorem constant_of_deriv_within_zero (hdiff : differentiable_on ℝ f (Icc a b) (hderiv : ∀ x ∈ Ico a b, deriv_within f (Icc a b) x = 0) : ∀ x ∈ Icc a b, f x = f a := begin - have H : ∀ x ∈ Ico a b, ∥deriv_within f (Icc a b) x∥ ≤ 0 := + have H : ∀ x ∈ Ico a b, ‖deriv_within f (Icc a b) x‖ ≤ 0 := by simpa only [norm_le_zero_iff] using λ x hx, hderiv x hx, simpa only [zero_mul, norm_le_zero_iff, sub_eq_zero] using λ x hx, norm_image_sub_le_of_norm_deriv_le_segment hdiff H x hx, @@ -471,17 +476,18 @@ also assume `[normed_space ℝ E]` to have a notion of a `convex` set. -/ section -variables {𝕜 G : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] [normed_group G] [normed_space 𝕜 G] +variables {𝕜 G : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] [normed_add_comm_group G] + [normed_space 𝕜 G] namespace convex -variables {f : E → G} {C : ℝ} {s : set E} {x y : E} {f' : E → E →L[𝕜] G} {φ : E →L[𝕜] G} +variables {f g : E → G} {C : ℝ} {s : set E} {x y : E} {f' g' : E → E →L[𝕜] G} {φ : E →L[𝕜] G} /-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C`, then the function is `C`-Lipschitz. Version with `has_fderiv_within`. -/ theorem norm_image_sub_le_of_norm_has_fderiv_within_le - (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ := + (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ‖f' x‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x‖ ≤ C * ‖y - x‖ := begin letI : normed_space ℝ G := restrict_scalars.normed_space ℝ 𝕜 G, /- By composition with `t ↦ x + t • (y-x)`, we reduce to a statement for functions defined @@ -514,7 +520,7 @@ end `s`, then the function is `C`-Lipschitz on `s`. Version with `has_fderiv_within` and `lipschitz_on_with`. -/ theorem lipschitz_on_with_of_nnnorm_has_fderiv_within_le {C : ℝ≥0} - (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥₊ ≤ C) + (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ‖f' x‖₊ ≤ C) (hs : convex ℝ s) : lipschitz_on_with C f s := begin rw lipschitz_on_with_iff_norm_sub_le, @@ -524,17 +530,17 @@ end /-- Let `s` be a convex set in a real normed vector space `E`, let `f : E → G` be a function differentiable within `s` in a neighborhood of `x : E` with derivative `f'`. Suppose that `f'` is -continuous within `s` at `x`. Then for any number `K : ℝ≥0` larger than `∥f' x∥₊`, `f` is +continuous within `s` at `x`. Then for any number `K : ℝ≥0` larger than `‖f' x‖₊`, `f` is `K`-Lipschitz on some neighborhood of `x` within `s`. See also `convex.exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at` for a version that claims existence of `K` instead of an explicit estimate. -/ lemma exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at_of_nnnorm_lt (hs : convex ℝ s) {f : E → G} (hder : ∀ᶠ y in 𝓝[s] x, has_fderiv_within_at f (f' y) s y) - (hcont : continuous_within_at f' s x) (K : ℝ≥0) (hK : ∥f' x∥₊ < K) : + (hcont : continuous_within_at f' s x) (K : ℝ≥0) (hK : ‖f' x‖₊ < K) : ∃ t ∈ 𝓝[s] x, lipschitz_on_with K f t := begin obtain ⟨ε, ε0, hε⟩ : - ∃ ε > 0, ball x ε ∩ s ⊆ {y | has_fderiv_within_at f (f' y) s y ∧ ∥f' y∥₊ < K}, + ∃ ε > 0, ball x ε ∩ s ⊆ {y | has_fderiv_within_at f (f' y) s y ∧ ‖f' y‖₊ < K}, from mem_nhds_within_iff.1 (hder.and $ hcont.nnnorm.eventually (gt_mem_nhds hK)), rw inter_comm at hε, refine ⟨s ∩ ball x ε, inter_mem_nhds_within _ (ball_mem_nhds _ ε0), _⟩, @@ -544,7 +550,7 @@ end /-- Let `s` be a convex set in a real normed vector space `E`, let `f : E → G` be a function differentiable within `s` in a neighborhood of `x : E` with derivative `f'`. Suppose that `f'` is -continuous within `s` at `x`. Then for any number `K : ℝ≥0` larger than `∥f' x∥₊`, `f` is Lipschitz +continuous within `s` at `x`. Then for any number `K : ℝ≥0` larger than `‖f' x‖₊`, `f` is Lipschitz on some neighborhood of `x` within `s`. See also `convex.exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at_of_nnnorm_lt` for a version with an explicit estimate on the Lipschitz constant. -/ @@ -558,8 +564,8 @@ lemma exists_nhds_within_lipschitz_on_with_of_has_fderiv_within_at /-- The mean value theorem on a convex set: if the derivative of a function within this set is bounded by `C`, then the function is `C`-Lipschitz. Version with `fderiv_within`. -/ theorem norm_image_sub_le_of_norm_fderiv_within_le - (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥fderiv_within 𝕜 f s x∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ := + (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ‖fderiv_within 𝕜 f s x‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x‖ ≤ C * ‖y - x‖ := hs.norm_image_sub_le_of_norm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at) bound xs ys @@ -567,22 +573,22 @@ bound xs ys `s`, then the function is `C`-Lipschitz on `s`. Version with `fderiv_within` and `lipschitz_on_with`. -/ theorem lipschitz_on_with_of_nnnorm_fderiv_within_le {C : ℝ≥0} - (hf : differentiable_on 𝕜 f s) (bound : ∀ x ∈ s, ∥fderiv_within 𝕜 f s x∥₊ ≤ C) + (hf : differentiable_on 𝕜 f s) (bound : ∀ x ∈ s, ‖fderiv_within 𝕜 f s x‖₊ ≤ C) (hs : convex ℝ s) : lipschitz_on_with C f s:= hs.lipschitz_on_with_of_nnnorm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at) bound /-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C`, then the function is `C`-Lipschitz. Version with `fderiv`. -/ theorem norm_image_sub_le_of_norm_fderiv_le - (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥fderiv 𝕜 f x∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ := + (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ‖fderiv 𝕜 f x‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x‖ ≤ C * ‖y - x‖ := hs.norm_image_sub_le_of_norm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_at.has_fderiv_within_at) bound xs ys /-- The mean value theorem on a convex set: if the derivative of a function is bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`. Version with `fderiv` and `lipschitz_on_with`. -/ theorem lipschitz_on_with_of_nnnorm_fderiv_le {C : ℝ≥0} - (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥fderiv 𝕜 f x∥₊ ≤ C) + (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ‖fderiv 𝕜 f x‖₊ ≤ C) (hs : convex ℝ s) : lipschitz_on_with C f s := hs.lipschitz_on_with_of_nnnorm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_at.has_fderiv_within_at) bound @@ -591,8 +597,8 @@ hs.lipschitz_on_with_of_nnnorm_has_fderiv_within_le the derivative and a fixed linear map, rather than a bound on the derivative itself. Version with `has_fderiv_within`. -/ theorem norm_image_sub_le_of_norm_has_fderiv_within_le' - (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x - φ∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x - φ (y - x)∥ ≤ C * ∥y - x∥ := + (hf : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) (bound : ∀x∈s, ‖f' x - φ‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x - φ (y - x)‖ ≤ C * ‖y - x‖ := begin /- We subtract `φ` to define a new function `g` for which `g' = 0`, for which the previous theorem applies, `convex.norm_image_sub_le_of_norm_has_fderiv_within_le`. Then, we just need to glue @@ -600,23 +606,23 @@ begin let g := λy, f y - φ y, have hg : ∀ x ∈ s, has_fderiv_within_at g (f' x - φ) s x := λ x xs, (hf x xs).sub φ.has_fderiv_within_at, - calc ∥f y - f x - φ (y - x)∥ = ∥f y - f x - (φ y - φ x)∥ : by simp - ... = ∥(f y - φ y) - (f x - φ x)∥ : by abel - ... = ∥g y - g x∥ : by simp - ... ≤ C * ∥y - x∥ : convex.norm_image_sub_le_of_norm_has_fderiv_within_le hg bound hs xs ys, + calc ‖f y - f x - φ (y - x)‖ = ‖f y - f x - (φ y - φ x)‖ : by simp + ... = ‖(f y - φ y) - (f x - φ x)‖ : by abel + ... = ‖g y - g x‖ : by simp + ... ≤ C * ‖y - x‖ : convex.norm_image_sub_le_of_norm_has_fderiv_within_le hg bound hs xs ys, end /-- Variant of the mean value inequality on a convex set. Version with `fderiv_within`. -/ theorem norm_image_sub_le_of_norm_fderiv_within_le' - (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥fderiv_within 𝕜 f s x - φ∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x - φ (y - x)∥ ≤ C * ∥y - x∥ := + (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ‖fderiv_within 𝕜 f s x - φ‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x - φ (y - x)‖ ≤ C * ‖y - x‖ := hs.norm_image_sub_le_of_norm_has_fderiv_within_le' (λ x hx, (hf x hx).has_fderiv_within_at) bound xs ys /-- Variant of the mean value inequality on a convex set. Version with `fderiv`. -/ theorem norm_image_sub_le_of_norm_fderiv_le' - (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥fderiv 𝕜 f x - φ∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x - φ (y - x)∥ ≤ C * ∥y - x∥ := + (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ‖fderiv 𝕜 f x - φ‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x - φ (y - x)‖ ≤ C * ‖y - x‖ := hs.norm_image_sub_le_of_norm_has_fderiv_within_le' (λ x hx, (hf x hx).has_fderiv_at.has_fderiv_within_at) bound xs ys @@ -625,7 +631,7 @@ then it is a constant on this set. -/ theorem is_const_of_fderiv_within_eq_zero (hs : convex ℝ s) (hf : differentiable_on 𝕜 f s) (hf' : ∀ x ∈ s, fderiv_within 𝕜 f s x = 0) (hx : x ∈ s) (hy : y ∈ s) : f x = f y := -have bound : ∀ x ∈ s, ∥fderiv_within 𝕜 f s x∥ ≤ 0, +have bound : ∀ x ∈ s, ‖fderiv_within 𝕜 f s x‖ ≤ 0, from λ x hx, by simp only [hf' x hx, norm_zero], by simpa only [(dist_eq_norm _ _).symm, zero_mul, dist_le_zero, eq_comm] using hs.norm_image_sub_le_of_norm_fderiv_within_le hf bound hx hy @@ -636,6 +642,29 @@ theorem _root_.is_const_of_fderiv_eq_zero (hf : differentiable 𝕜 f) (hf' : convex_univ.is_const_of_fderiv_within_eq_zero hf.differentiable_on (λ x _, by rw fderiv_within_univ; exact hf' x) trivial trivial +/-- If two functions have equal Fréchet derivatives at every point of a convex set, and are equal at +one point in that set, then they are equal on that set. -/ +theorem eq_on_of_fderiv_within_eq (hs : convex ℝ s) + (hf : differentiable_on 𝕜 f s) (hg : differentiable_on 𝕜 g s) (hs' : unique_diff_on 𝕜 s) + (hf' : ∀ x ∈ s, fderiv_within 𝕜 f s x = fderiv_within 𝕜 g s x) (hx : x ∈ s) (hfgx : f x = g x) : + s.eq_on f g := +begin + intros y hy, + suffices : f x - g x = f y - g y, + { rwa [hfgx, sub_self, eq_comm, sub_eq_zero] at this }, + refine hs.is_const_of_fderiv_within_eq_zero (hf.sub hg) _ hx hy, + intros z hz, + rw [fderiv_within_sub (hs' _ hz) (hf _ hz) (hg _ hz), sub_eq_zero, hf' _ hz], +end + +theorem _root_.eq_of_fderiv_eq (hf : differentiable 𝕜 f) (hg : differentiable 𝕜 g) + (hf' : ∀ x, fderiv 𝕜 f x = fderiv 𝕜 g x) + (x : E) (hfgx : f x = g x) : + f = g := +suffices set.univ.eq_on f g, from funext $ λ x, this $ mem_univ x, +convex_univ.eq_on_of_fderiv_within_eq hf.differentiable_on hg.differentiable_on + unique_diff_on_univ (λ x hx, by simpa using hf' _) (mem_univ _) hfgx + end convex namespace convex @@ -645,8 +674,8 @@ variables {f f' : 𝕜 → G} {s : set 𝕜} {x y : 𝕜} /-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is bounded by `C`, then the function is `C`-Lipschitz. Version with `has_deriv_within`. -/ theorem norm_image_sub_le_of_norm_has_deriv_within_le {C : ℝ} - (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ := + (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (bound : ∀x∈s, ‖f' x‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x‖ ≤ C * ‖y - x‖ := convex.norm_image_sub_le_of_norm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at) (λ x hx, le_trans (by simp) (bound x hx)) hs xs ys @@ -654,7 +683,7 @@ convex.norm_image_sub_le_of_norm_has_fderiv_within_le (λ x hx, (hf x hx).has_fd bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`. Version with `has_deriv_within` and `lipschitz_on_with`. -/ theorem lipschitz_on_with_of_nnnorm_has_deriv_within_le {C : ℝ≥0} (hs : convex ℝ s) - (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (bound : ∀x∈s, ∥f' x∥₊ ≤ C) : + (hf : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (bound : ∀x∈s, ‖f' x‖₊ ≤ C) : lipschitz_on_with C f s := convex.lipschitz_on_with_of_nnnorm_has_fderiv_within_le (λ x hx, (hf x hx).has_fderiv_within_at) (λ x hx, le_trans (by simp) (bound x hx)) hs @@ -662,8 +691,8 @@ convex.lipschitz_on_with_of_nnnorm_has_fderiv_within_le (λ x hx, (hf x hx).has_ /-- The mean value theorem on a convex set in dimension 1: if the derivative of a function within this set is bounded by `C`, then the function is `C`-Lipschitz. Version with `deriv_within` -/ theorem norm_image_sub_le_of_norm_deriv_within_le {C : ℝ} - (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥deriv_within f s x∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ := + (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ‖deriv_within f s x‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x‖ ≤ C * ‖y - x‖ := hs.norm_image_sub_le_of_norm_has_deriv_within_le (λ x hx, (hf x hx).has_deriv_within_at) bound xs ys @@ -671,15 +700,15 @@ bound xs ys bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`. Version with `deriv_within` and `lipschitz_on_with`. -/ theorem lipschitz_on_with_of_nnnorm_deriv_within_le {C : ℝ≥0} (hs : convex ℝ s) - (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ∥deriv_within f s x∥₊ ≤ C) : + (hf : differentiable_on 𝕜 f s) (bound : ∀x∈s, ‖deriv_within f s x‖₊ ≤ C) : lipschitz_on_with C f s := hs.lipschitz_on_with_of_nnnorm_has_deriv_within_le (λ x hx, (hf x hx).has_deriv_within_at) bound /-- The mean value theorem on a convex set in dimension 1: if the derivative of a function is bounded by `C`, then the function is `C`-Lipschitz. Version with `deriv`. -/ theorem norm_image_sub_le_of_norm_deriv_le {C : ℝ} - (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥deriv f x∥ ≤ C) - (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ∥f y - f x∥ ≤ C * ∥y - x∥ := + (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ‖deriv f x‖ ≤ C) + (hs : convex ℝ s) (xs : x ∈ s) (ys : y ∈ s) : ‖f y - f x‖ ≤ C * ‖y - x‖ := hs.norm_image_sub_le_of_norm_has_deriv_within_le (λ x hx, (hf x hx).has_deriv_at.has_deriv_within_at) bound xs ys @@ -687,7 +716,7 @@ hs.norm_image_sub_le_of_norm_has_deriv_within_le bounded by `C` on `s`, then the function is `C`-Lipschitz on `s`. Version with `deriv` and `lipschitz_on_with`. -/ theorem lipschitz_on_with_of_nnnorm_deriv_le {C : ℝ≥0} - (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ∥deriv f x∥₊ ≤ C) + (hf : ∀ x ∈ s, differentiable_at 𝕜 f x) (bound : ∀x∈s, ‖deriv f x‖₊ ≤ C) (hs : convex ℝ s) : lipschitz_on_with C f s := hs.lipschitz_on_with_of_nnnorm_has_deriv_within_le (λ x hx, (hf x hx).has_deriv_at.has_deriv_within_at) bound @@ -695,7 +724,7 @@ hs.lipschitz_on_with_of_nnnorm_has_deriv_within_le /-- The mean value theorem set in dimension 1: if the derivative of a function is bounded by `C`, then the function is `C`-Lipschitz. Version with `deriv` and `lipschitz_with`. -/ theorem _root_.lipschitz_with_of_nnnorm_deriv_le {C : ℝ≥0} (hf : differentiable 𝕜 f) - (bound : ∀ x, ∥deriv f x∥₊ ≤ C) : lipschitz_with C f := + (bound : ∀ x, ‖deriv f x‖₊ ≤ C) : lipschitz_with C f := lipschitz_on_univ.1 $ convex_univ.lipschitz_on_with_of_nnnorm_deriv_le (λ x hx, hf x) (λ x hx, bound x) @@ -1037,11 +1066,112 @@ begin exact neg_convex_on_iff.mp (this.convex_on_of_deriv hD hf.neg hf'.neg), end -/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is differentiable on its interior, -and `f'` is strictly monotone on the interior, then `f` is strictly convex on `D`. -/ +lemma strict_mono_on.exists_slope_lt_deriv_aux {x y : ℝ} {f : ℝ → ℝ} + (hf : continuous_on f (Icc x y)) (hxy : x < y) + (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) (h : ∀ w ∈ Ioo x y, deriv f w ≠ 0) : + ∃ a ∈ Ioo x y, (f y - f x) / (y - x) < deriv f a := +begin + have A : differentiable_on ℝ f (Ioo x y), + from λ w wmem, (differentiable_at_of_deriv_ne_zero (h w wmem)).differentiable_within_at, + obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x), + from exists_deriv_eq_slope f hxy hf A, + rcases nonempty_Ioo.2 hay with ⟨b, ⟨hab, hby⟩⟩, + refine ⟨b, ⟨hxa.trans hab, hby⟩, _⟩, + rw ← ha, + exact hf'_mono ⟨hxa, hay⟩ ⟨hxa.trans hab, hby⟩ hab +end + +lemma strict_mono_on.exists_slope_lt_deriv {x y : ℝ} {f : ℝ → ℝ} + (hf : continuous_on f (Icc x y)) (hxy : x < y) + (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) : + ∃ a ∈ Ioo x y, (f y - f x) / (y - x) < deriv f a := +begin + by_cases h : ∀ w ∈ Ioo x y, deriv f w ≠ 0, + { apply strict_mono_on.exists_slope_lt_deriv_aux hf hxy hf'_mono h }, + { push_neg at h, + rcases h with ⟨w, ⟨hxw, hwy⟩, hw⟩, + obtain ⟨a, ⟨hxa, haw⟩, ha⟩ : ∃ (a : ℝ) (H : a ∈ Ioo x w), (f w - f x) / (w - x) < deriv f a, + { apply strict_mono_on.exists_slope_lt_deriv_aux _ hxw _ _, + { exact hf.mono (Icc_subset_Icc le_rfl hwy.le) }, + { exact hf'_mono.mono (Ioo_subset_Ioo le_rfl hwy.le) }, + { assume z hz, + rw ← hw, + apply ne_of_lt, + exact hf'_mono ⟨hz.1, hz.2.trans hwy⟩ ⟨hxw, hwy⟩ hz.2 } }, + obtain ⟨b, ⟨hwb, hby⟩, hb⟩ : ∃ (b : ℝ) (H : b ∈ Ioo w y), (f y - f w) / (y - w) < deriv f b, + { apply strict_mono_on.exists_slope_lt_deriv_aux _ hwy _ _, + { refine hf.mono (Icc_subset_Icc hxw.le le_rfl), }, + { exact hf'_mono.mono (Ioo_subset_Ioo hxw.le le_rfl) }, + { assume z hz, + rw ← hw, + apply ne_of_gt, + exact hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hz.1, hz.2⟩ hz.1, } }, + refine ⟨b, ⟨hxw.trans hwb, hby⟩, _⟩, + simp only [div_lt_iff, hxy, hxw, hwy, sub_pos] at ⊢ ha hb, + have : deriv f a * (w - x) < deriv f b * (w - x), + { apply mul_lt_mul _ le_rfl (sub_pos.2 hxw) _, + { exact hf'_mono ⟨hxa, haw.trans hwy⟩ ⟨hxw.trans hwb, hby⟩ (haw.trans hwb) }, + { rw ← hw, + exact (hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hwb, hby⟩ hwb).le } }, + linarith } +end + +lemma strict_mono_on.exists_deriv_lt_slope_aux {x y : ℝ} {f : ℝ → ℝ} + (hf : continuous_on f (Icc x y)) (hxy : x < y) + (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) (h : ∀ w ∈ Ioo x y, deriv f w ≠ 0) : + ∃ a ∈ Ioo x y, deriv f a < (f y - f x) / (y - x) := +begin + have A : differentiable_on ℝ f (Ioo x y), + from λ w wmem, (differentiable_at_of_deriv_ne_zero (h w wmem)).differentiable_within_at, + obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x), + from exists_deriv_eq_slope f hxy hf A, + rcases nonempty_Ioo.2 hxa with ⟨b, ⟨hxb, hba⟩⟩, + refine ⟨b, ⟨hxb, hba.trans hay⟩, _⟩, + rw ← ha, + exact hf'_mono ⟨hxb, hba.trans hay⟩ ⟨hxa, hay⟩ hba +end + +lemma strict_mono_on.exists_deriv_lt_slope {x y : ℝ} {f : ℝ → ℝ} + (hf : continuous_on f (Icc x y)) (hxy : x < y) + (hf'_mono : strict_mono_on (deriv f) (Ioo x y)) : + ∃ a ∈ Ioo x y, deriv f a < (f y - f x) / (y - x) := +begin + by_cases h : ∀ w ∈ Ioo x y, deriv f w ≠ 0, + { apply strict_mono_on.exists_deriv_lt_slope_aux hf hxy hf'_mono h }, + { push_neg at h, + rcases h with ⟨w, ⟨hxw, hwy⟩, hw⟩, + obtain ⟨a, ⟨hxa, haw⟩, ha⟩ : ∃ (a : ℝ) (H : a ∈ Ioo x w), deriv f a < (f w - f x) / (w - x), + { apply strict_mono_on.exists_deriv_lt_slope_aux _ hxw _ _, + { exact hf.mono (Icc_subset_Icc le_rfl hwy.le) }, + { exact hf'_mono.mono (Ioo_subset_Ioo le_rfl hwy.le) }, + { assume z hz, + rw ← hw, + apply ne_of_lt, + exact hf'_mono ⟨hz.1, hz.2.trans hwy⟩ ⟨hxw, hwy⟩ hz.2 } }, + obtain ⟨b, ⟨hwb, hby⟩, hb⟩ : ∃ (b : ℝ) (H : b ∈ Ioo w y), deriv f b < (f y - f w) / (y - w), + { apply strict_mono_on.exists_deriv_lt_slope_aux _ hwy _ _, + { refine hf.mono (Icc_subset_Icc hxw.le le_rfl), }, + { exact hf'_mono.mono (Ioo_subset_Ioo hxw.le le_rfl) }, + { assume z hz, + rw ← hw, + apply ne_of_gt, + exact hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hz.1, hz.2⟩ hz.1, } }, + refine ⟨a, ⟨hxa, haw.trans hwy⟩, _⟩, + simp only [lt_div_iff, hxy, hxw, hwy, sub_pos] at ⊢ ha hb, + have : deriv f a * (y - w) < deriv f b * (y - w), + { apply mul_lt_mul _ le_rfl (sub_pos.2 hwy) _, + { exact hf'_mono ⟨hxa, haw.trans hwy⟩ ⟨hxw.trans hwb, hby⟩ (haw.trans hwb) }, + { rw ← hw, + exact (hf'_mono ⟨hxw, hwy⟩ ⟨hxw.trans hwb, hby⟩ hwb).le } }, + linarith } +end + +/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, and `f'` is strictly monotone on the +interior, then `f` is strictly convex on `D`. +Note that we don't require differentiability, since it is guaranteed at all but at most +one point by the strict monotonicity of `f'`. -/ lemma strict_mono_on.strict_convex_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ} - (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D)) - (hf'_mono : strict_mono_on (deriv f) (interior D)) : + (hf : continuous_on f D) (hf' : strict_mono_on (deriv f) (interior D)) : strict_convex_on ℝ D f := strict_convex_on_of_slope_strict_mono_adjacent hD begin @@ -1054,27 +1184,29 @@ begin have hyzD : Icc y z ⊆ D, from subset.trans (Icc_subset_Icc_left $ le_of_lt hxy) hxzD, have hyzD' : Ioo y z ⊆ interior D, from subset_sUnion_of_mem ⟨is_open_Ioo, subset.trans Ioo_subset_Icc_self hyzD⟩, - -- Then we apply MVT to both `[x, y]` and `[y, z]` - obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, deriv f a = (f y - f x) / (y - x), - from exists_deriv_eq_slope f hxy (hf.mono hxyD) (hf'.mono hxyD'), - obtain ⟨b, ⟨hyb, hbz⟩, hb⟩ : ∃ b ∈ Ioo y z, deriv f b = (f z - f y) / (z - y), - from exists_deriv_eq_slope f hyz (hf.mono hyzD) (hf'.mono hyzD'), - rw [← ha, ← hb], - exact hf'_mono (hxyD' ⟨hxa, hay⟩) (hyzD' ⟨hyb, hbz⟩) (hay.trans hyb) + -- Then we get points `a` and `b` in each interval `[x, y]` and `[y, z]` where the derivatives + -- can be compared to the slopes between `x, y` and `y, z` respectively. + obtain ⟨a, ⟨hxa, hay⟩, ha⟩ : ∃ a ∈ Ioo x y, (f y - f x) / (y - x) < deriv f a, + from strict_mono_on.exists_slope_lt_deriv (hf.mono hxyD) hxy (hf'.mono hxyD'), + obtain ⟨b, ⟨hyb, hbz⟩, hb⟩ : ∃ b ∈ Ioo y z, deriv f b < (f z - f y) / (z - y), + from strict_mono_on.exists_deriv_lt_slope (hf.mono hyzD) hyz (hf'.mono hyzD'), + apply ha.trans (lt_trans _ hb), + exact hf' (hxyD' ⟨hxa, hay⟩) (hyzD' ⟨hyb, hbz⟩) (hay.trans hyb), end -/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is differentiable on its interior, -and `f'` is strictly antitone on the interior, then `f` is strictly concave on `D`. -/ +/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` and `f'` is strictly antitone on the +interior, then `f` is strictly concave on `D`. +Note that we don't require differentiability, since it is guaranteed at all but at most +one point by the strict antitonicity of `f'`. -/ lemma strict_anti_on.strict_concave_on_of_deriv {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ} - (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D)) - (h_anti : strict_anti_on (deriv f) (interior D)) : + (hf : continuous_on f D) (h_anti : strict_anti_on (deriv f) (interior D)) : strict_concave_on ℝ D f := begin have : strict_mono_on (deriv (-f)) (interior D), { intros x hx y hy hxy, convert neg_lt_neg (h_anti hx hy hxy); convert deriv.neg }, - exact neg_strict_convex_on_iff.mp (this.strict_convex_on_of_deriv hD hf.neg hf'.neg), + exact neg_strict_convex_on_iff.mp (this.strict_convex_on_of_deriv hD hf.neg), end /-- If a function `f` is differentiable and `f'` is monotone on `ℝ` then `f` is convex. -/ @@ -1089,20 +1221,19 @@ theorem antitone.concave_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable (hf'_anti.antitone_on _).concave_on_of_deriv convex_univ hf.continuous.continuous_on hf.differentiable_on -/-- If a function `f` is differentiable and `f'` is strictly monotone on `ℝ` then `f` is strictly -convex. -/ -lemma strict_mono.strict_convex_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f) - (hf'_mono : strict_mono (deriv f)) : - strict_convex_on ℝ univ f := -(hf'_mono.strict_mono_on _).strict_convex_on_of_deriv convex_univ hf.continuous.continuous_on - hf.differentiable_on - -/-- If a function `f` is differentiable and `f'` is strictly antitone on `ℝ` then `f` is strictly -concave. -/ -lemma strict_anti.strict_concave_on_univ_of_deriv {f : ℝ → ℝ} (hf : differentiable ℝ f) +/-- If a function `f` is continuous and `f'` is strictly monotone on `ℝ` then `f` is strictly +convex. Note that we don't require differentiability, since it is guaranteed at all but at most +one point by the strict monotonicity of `f'`. -/ +lemma strict_mono.strict_convex_on_univ_of_deriv {f : ℝ → ℝ} (hf : continuous f) + (hf'_mono : strict_mono (deriv f)) : strict_convex_on ℝ univ f := +(hf'_mono.strict_mono_on _).strict_convex_on_of_deriv convex_univ hf.continuous_on + +/-- If a function `f` is continuous and `f'` is strictly antitone on `ℝ` then `f` is strictly +concave. Note that we don't require differentiability, since it is guaranteed at all but at most +one point by the strict antitonicity of `f'`. -/ +lemma strict_anti.strict_concave_on_univ_of_deriv {f : ℝ → ℝ} (hf : continuous f) (hf'_anti : strict_anti (deriv f)) : strict_concave_on ℝ univ f := -(hf'_anti.strict_anti_on _).strict_concave_on_of_deriv convex_univ hf.continuous.continuous_on - hf.differentiable_on +(hf'_anti.strict_anti_on _).strict_concave_on_of_deriv convex_univ hf.continuous_on /-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its interior, and `f''` is nonnegative on the interior, then `f` is convex on `D`. -/ @@ -1124,72 +1255,68 @@ theorem concave_on_of_deriv2_nonpos {D : set ℝ} (hD : convex ℝ D) {f : ℝ (hD.interior.antitone_on_of_deriv_nonpos hf''.continuous_on (by rwa interior_interior) $ by rwa interior_interior).concave_on_of_deriv hD hf hf' -/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its -interior, and `f''` is strictly positive on the interior, then `f` is strictly convex on `D`. -Note that we don't require twice differentiability explicitly as it already implied by the second -derivative being strictly positive. -/ +/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` and `f''` is strictly positive on the +interior, then `f` is strictly convex on `D`. +Note that we don't require twice differentiability explicitly as it is already implied by the second +derivative being strictly positive, except at at most one point. -/ lemma strict_convex_on_of_deriv2_pos {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ} - (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D)) - (hf'' : ∀ x ∈ interior D, 0 < (deriv^[2] f) x) : + (hf : continuous_on f D) (hf'' : ∀ x ∈ interior D, 0 < (deriv^[2] f) x) : strict_convex_on ℝ D f := (hD.interior.strict_mono_on_of_deriv_pos (λ z hz, (differentiable_at_of_deriv_ne_zero (hf'' z hz).ne').differentiable_within_at - .continuous_within_at) $ by rwa interior_interior).strict_convex_on_of_deriv hD hf hf' + .continuous_within_at) $ by rwa interior_interior).strict_convex_on_of_deriv hD hf -/-- If a function `f` is continuous on a convex set `D ⊆ ℝ`, is twice differentiable on its -interior, and `f''` is strictly negative on the interior, then `f` is strictly concave on `D`. +/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` and `f''` is strictly negative on the +interior, then `f` is strictly concave on `D`. Note that we don't require twice differentiability explicitly as it already implied by the second -derivative being strictly negative. -/ +derivative being strictly negative, except at at most one point. -/ lemma strict_concave_on_of_deriv2_neg {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ} - (hf : continuous_on f D) (hf' : differentiable_on ℝ f (interior D)) - (hf'' : ∀ x ∈ interior D, deriv^[2] f x < 0) : + (hf : continuous_on f D) (hf'' : ∀ x ∈ interior D, deriv^[2] f x < 0) : strict_concave_on ℝ D f := (hD.interior.strict_anti_on_of_deriv_neg (λ z hz, (differentiable_at_of_deriv_ne_zero (hf'' z hz).ne).differentiable_within_at - .continuous_within_at) $ by rwa interior_interior).strict_concave_on_of_deriv hD hf hf' + .continuous_within_at) $ by rwa interior_interior).strict_concave_on_of_deriv hD hf /-- If a function `f` is twice differentiable on a open convex set `D ⊆ ℝ` and `f''` is nonnegative on `D`, then `f` is convex on `D`. -/ -theorem convex_on_open_of_deriv2_nonneg {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D) {f : ℝ → ℝ} +theorem convex_on_of_deriv2_nonneg' {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ} (hf' : differentiable_on ℝ f D) (hf'' : differentiable_on ℝ (deriv f) D) (hf''_nonneg : ∀ x ∈ D, 0 ≤ (deriv^[2] f) x) : convex_on ℝ D f := -convex_on_of_deriv2_nonneg hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf') - (by simpa [hD₂.interior_eq] using hf'') (by simpa [hD₂.interior_eq] using hf''_nonneg) +convex_on_of_deriv2_nonneg hD hf'.continuous_on (hf'.mono interior_subset) + (hf''.mono interior_subset) (λ x hx, hf''_nonneg x (interior_subset hx)) /-- If a function `f` is twice differentiable on an open convex set `D ⊆ ℝ` and `f''` is nonpositive on `D`, then `f` is concave on `D`. -/ -theorem concave_on_open_of_deriv2_nonpos {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D) {f : ℝ → ℝ} +theorem concave_on_of_deriv2_nonpos' {D : set ℝ} (hD : convex ℝ D) {f : ℝ → ℝ} (hf' : differentiable_on ℝ f D) (hf'' : differentiable_on ℝ (deriv f) D) (hf''_nonpos : ∀ x ∈ D, deriv^[2] f x ≤ 0) : concave_on ℝ D f := -concave_on_of_deriv2_nonpos hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf') - (by simpa [hD₂.interior_eq] using hf'') (by simpa [hD₂.interior_eq] using hf''_nonpos) - -/-- If a function `f` is twice differentiable on a open convex set `D ⊆ ℝ` and -`f''` is strictly positive on `D`, then `f` is strictly convex on `D`. -Note that we don't require twice differentiability explicitly as it already implied by the second -derivative being strictly positive. -/ -lemma strict_convex_on_open_of_deriv2_pos {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D) - {f : ℝ → ℝ} (hf' : differentiable_on ℝ f D) (hf'' : ∀ x ∈ D, 0 < (deriv^[2] f) x) : +concave_on_of_deriv2_nonpos hD hf'.continuous_on (hf'.mono interior_subset) + (hf''.mono interior_subset) (λ x hx, hf''_nonpos x (interior_subset hx)) + +/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` and `f''` is strictly positive on `D`, +then `f` is strictly convex on `D`. +Note that we don't require twice differentiability explicitly as it is already implied by the second +derivative being strictly positive, except at at most one point. -/ +lemma strict_convex_on_of_deriv2_pos' {D : set ℝ} (hD : convex ℝ D) + {f : ℝ → ℝ} (hf : continuous_on f D) (hf'' : ∀ x ∈ D, 0 < (deriv^[2] f) x) : strict_convex_on ℝ D f := -strict_convex_on_of_deriv2_pos hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf') $ - by simpa [hD₂.interior_eq] using hf'' - -/-- If a function `f` is twice differentiable on an open convex set `D ⊆ ℝ` and -`f''` is strictly negative on `D`, then `f` is strictly concave on `D`. -Note that we don't require twice differentiability explicitly as it already implied by the second -derivative being strictly negative. -/ -lemma strict_concave_on_open_of_deriv2_neg {D : set ℝ} (hD : convex ℝ D) (hD₂ : is_open D) - {f : ℝ → ℝ} (hf' : differentiable_on ℝ f D) (hf'' : ∀ x ∈ D, deriv^[2] f x < 0) : +strict_convex_on_of_deriv2_pos hD hf $ λ x hx, hf'' x (interior_subset hx) + +/-- If a function `f` is continuous on a convex set `D ⊆ ℝ` and `f''` is strictly negative on `D`, +then `f` is strictly concave on `D`. +Note that we don't require twice differentiability explicitly as it is already implied by the second +derivative being strictly negative, except at at most one point. -/ +lemma strict_concave_on_of_deriv2_neg' {D : set ℝ} (hD : convex ℝ D) + {f : ℝ → ℝ} (hf : continuous_on f D) (hf'' : ∀ x ∈ D, deriv^[2] f x < 0) : strict_concave_on ℝ D f := -strict_concave_on_of_deriv2_neg hD hf'.continuous_on (by simpa [hD₂.interior_eq] using hf') $ - by simpa [hD₂.interior_eq] using hf'' +strict_concave_on_of_deriv2_neg hD hf $ λ x hx, hf'' x (interior_subset hx) /-- If a function `f` is twice differentiable on `ℝ`, and `f''` is nonnegative on `ℝ`, then `f` is convex on `ℝ`. -/ theorem convex_on_univ_of_deriv2_nonneg {f : ℝ → ℝ} (hf' : differentiable ℝ f) (hf'' : differentiable ℝ (deriv f)) (hf''_nonneg : ∀ x, 0 ≤ (deriv^[2] f) x) : convex_on ℝ univ f := -convex_on_open_of_deriv2_nonneg convex_univ is_open_univ hf'.differentiable_on +convex_on_of_deriv2_nonneg' convex_univ hf'.differentiable_on hf''.differentiable_on (λ x _, hf''_nonneg x) /-- If a function `f` is twice differentiable on `ℝ`, and `f''` is nonpositive on `ℝ`, @@ -1197,26 +1324,26 @@ then `f` is concave on `ℝ`. -/ theorem concave_on_univ_of_deriv2_nonpos {f : ℝ → ℝ} (hf' : differentiable ℝ f) (hf'' : differentiable ℝ (deriv f)) (hf''_nonpos : ∀ x, deriv^[2] f x ≤ 0) : concave_on ℝ univ f := -concave_on_open_of_deriv2_nonpos convex_univ is_open_univ hf'.differentiable_on +concave_on_of_deriv2_nonpos' convex_univ hf'.differentiable_on hf''.differentiable_on (λ x _, hf''_nonpos x) -/-- If a function `f` is twice differentiable on `ℝ`, and `f''` is strictly positive on `ℝ`, +/-- If a function `f` is continuous on `ℝ`, and `f''` is strictly positive on `ℝ`, then `f` is strictly convex on `ℝ`. -Note that we don't require twice differentiability explicitly as it already implied by the second -derivative being strictly positive. -/ -lemma strict_convex_on_univ_of_deriv2_pos {f : ℝ → ℝ} (hf' : differentiable ℝ f) +Note that we don't require twice differentiability explicitly as it is already implied by the second +derivative being strictly positive, except at at most one point. -/ +lemma strict_convex_on_univ_of_deriv2_pos {f : ℝ → ℝ} (hf : continuous f) (hf'' : ∀ x, 0 < (deriv^[2] f) x) : strict_convex_on ℝ univ f := -strict_convex_on_open_of_deriv2_pos convex_univ is_open_univ hf'.differentiable_on $ λ x _, hf'' x +strict_convex_on_of_deriv2_pos' convex_univ hf.continuous_on $ λ x _, hf'' x -/-- If a function `f` is twice differentiable on `ℝ`, and `f''` is strictly negative on `ℝ`, +/-- If a function `f` is continuous on `ℝ`, and `f''` is strictly negative on `ℝ`, then `f` is strictly concave on `ℝ`. -Note that we don't require twice differentiability explicitly as it already implied by the second -derivative being strictly negative. -/ -lemma strict_concave_on_univ_of_deriv2_neg {f : ℝ → ℝ} (hf' : differentiable ℝ f) +Note that we don't require twice differentiability explicitly as it is already implied by the second +derivative being strictly negative, except at at most one point. -/ +lemma strict_concave_on_univ_of_deriv2_neg {f : ℝ → ℝ} (hf : continuous f) (hf'' : ∀ x, deriv^[2] f x < 0) : strict_concave_on ℝ univ f := -strict_concave_on_open_of_deriv2_neg convex_univ is_open_univ hf'.differentiable_on $ λ x _, hf'' x +strict_concave_on_of_deriv2_neg' convex_univ hf.continuous_on $ λ x _, hf'' x /-! ### Functions `f : E → ℝ` -/ @@ -1269,8 +1396,8 @@ make sense and are enough. Many formulations of the mean value inequality could balls over `ℝ` or `ℂ`. For now, we only include the ones that we need. -/ -variables {𝕜 : Type*} [is_R_or_C 𝕜] {G : Type*} [normed_group G] [normed_space 𝕜 G] - {H : Type*} [normed_group H] [normed_space 𝕜 H] {f : G → H} {f' : G → G →L[𝕜] H} {x : G} +variables {𝕜 : Type*} [is_R_or_C 𝕜] {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] + {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H] {f : G → H} {f' : G → G →L[𝕜] H} {x : G} /-- Over the reals or the complexes, a continuously differentiable function is strictly differentiable. -/ @@ -1287,7 +1414,7 @@ begin rintros ⟨a, b⟩ h, rw [← ball_prod_same, prod_mk_mem_set_prod_eq] at h, -- exploit the choice of ε as the modulus of continuity of f' - have hf' : ∀ x' ∈ ball x ε, ∥f' x' - f' x∥ ≤ c, + have hf' : ∀ x' ∈ ball x ε, ‖f' x' - f' x‖ ≤ c, { intros x' H', rw ← dist_eq_norm, exact le_of_lt (hε H').2 }, -- apply mean value theorem letI : normed_space ℝ G := restrict_scalars.normed_space ℝ 𝕜 G, diff --git a/src/analysis/calculus/monotone.lean b/src/analysis/calculus/monotone.lean new file mode 100644 index 0000000000000..2281735450d5e --- /dev/null +++ b/src/analysis/calculus/monotone.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.calculus.deriv.slope +import measure_theory.covering.one_dim +import order.monotone.extension + +/-! +# Differentiability of monotone functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that a monotone function `f : ℝ → ℝ` is differentiable almost everywhere, in +`monotone.ae_differentiable_at`. (We also give a version for a function monotone on a set, in +`monotone_on.ae_differentiable_within_at`.) + +If the function `f` is continuous, this follows directly from general differentiation of measure +theorems. Let `μ` be the Stieltjes measure associated to `f`. Then, almost everywhere, +`μ [x, y] / Leb [x, y]` (resp. `μ [y, x] / Leb [y, x]`) converges to the Radon-Nikodym derivative +of `μ` with respect to Lebesgue when `y` tends to `x` in `(x, +∞)` (resp. `(-∞, x)`), by +`vitali_family.ae_tendsto_rn_deriv`. As `μ [x, y] = f y - f x` and `Leb [x, y] = y - x`, this +gives differentiability right away. + +When `f` is only monotone, the same argument works up to small adjustments, as the associated +Stieltjes measure satisfies `μ [x, y] = f (y^+) - f (x^-)` (the right and left limits of `f` at `y` +and `x` respectively). One argues that `f (x^-) = f x` almost everywhere (in fact away from a +countable set), and moreover `f ((y - (y-x)^2)^+) ≤ f y ≤ f (y^+)`. This is enough to deduce the +limit of `(f y - f x) / (y - x)` by a lower and upper approximation argument from the known +behavior of `μ [x, y]`. +-/ + +open set filter function metric measure_theory measure_theory.measure is_unif_loc_doubling_measure +open_locale topology + +/-- If `(f y - f x) / (y - x)` converges to a limit as `y` tends to `x`, then the same goes if +`y` is shifted a little bit, i.e., `f (y + (y-x)^2) - f x) / (y - x)` converges to the same limit. +This lemma contains a slightly more general version of this statement (where one considers +convergence along some subfilter, typically `𝓝[<] x` or `𝓝[>] x`) tailored to the application +to almost everywhere differentiability of monotone functions. -/ +lemma tendsto_apply_add_mul_sq_div_sub {f : ℝ → ℝ} {x a c d : ℝ} {l : filter ℝ} (hl : l ≤ 𝓝[≠] x) + (hf : tendsto (λ y, (f y - d) / (y - x)) l (𝓝 a)) + (h' : tendsto (λ y, y + c * (y-x)^2) l l) : + tendsto (λ y, (f (y + c * (y-x)^2) - d) / (y - x)) l (𝓝 a) := +begin + have L : tendsto (λ y, (y + c * (y - x)^2 - x) / (y - x)) l (𝓝 1), + { have : tendsto (λ y, (1 + c * (y - x))) l (𝓝 (1 + c * (x - x))), + { apply tendsto.mono_left _ (hl.trans nhds_within_le_nhds), + exact ((tendsto_id.sub_const x).const_mul c).const_add 1 }, + simp only [_root_.sub_self, add_zero, mul_zero] at this, + apply tendsto.congr' (eventually.filter_mono hl _) this, + filter_upwards [self_mem_nhds_within] with y hy, + field_simp [sub_ne_zero.2 hy], + ring }, + have Z := (hf.comp h').mul L, + rw mul_one at Z, + apply tendsto.congr' _ Z, + have : ∀ᶠ y in l, y + c * (y-x)^2 ≠ x := by apply tendsto.mono_right h' hl self_mem_nhds_within, + filter_upwards [this] with y hy, + field_simp [sub_ne_zero.2 hy], +end + +/-- A Stieltjes function is almost everywhere differentiable, with derivative equal to the +Radon-Nikodym derivative of the associated Stieltjes measure with respect to Lebesgue. -/ +lemma stieltjes_function.ae_has_deriv_at (f : stieltjes_function) : + ∀ᵐ x, has_deriv_at f (rn_deriv f.measure volume x).to_real x := +begin + /- Denote by `μ` the Stieltjes measure associated to `f`. + The general theorem `vitali_family.ae_tendsto_rn_deriv` ensures that `μ [x, y] / (y - x)` tends + to the Radon-Nikodym derivative as `y` tends to `x` from the right. As `μ [x, y] = f y - f (x^-)` + and `f (x^-) = f x` almost everywhere, this gives differentiability on the right. + On the left, `μ [y, x] / (x - y)` again tends to the Radon-Nikodym derivative. + As `μ [y, x] = f x - f (y^-)`, this is not exactly the right result, so one uses a sandwiching + argument to deduce the convergence for `(f x - f y) / (x - y)`. -/ + filter_upwards [ + vitali_family.ae_tendsto_rn_deriv (vitali_family (volume : measure ℝ) 1) f.measure, + rn_deriv_lt_top f.measure volume, f.countable_left_lim_ne.ae_not_mem volume] with x hx h'x h''x, + -- Limit on the right, following from differentiation of measures + have L1 : tendsto (λ y, (f y - f x) / (y - x)) + (𝓝[>] x) (𝓝 ((rn_deriv f.measure volume x).to_real)), + { apply tendsto.congr' _ + ((ennreal.tendsto_to_real h'x.ne).comp (hx.comp (real.tendsto_Icc_vitali_family_right x))), + filter_upwards [self_mem_nhds_within], + rintros y (hxy : x < y), + simp only [comp_app, stieltjes_function.measure_Icc, real.volume_Icc, not_not.1 h''x], + rw [← ennreal.of_real_div_of_pos (sub_pos.2 hxy), ennreal.to_real_of_real], + exact div_nonneg (sub_nonneg.2 (f.mono hxy.le)) (sub_pos.2 hxy).le }, + -- Limit on the left, following from differentiation of measures. Its form is not exactly the one + -- we need, due to the appearance of a left limit. + have L2 : tendsto (λ y, (left_lim f y - f x) / (y - x)) + (𝓝[<] x) (𝓝 ((rn_deriv f.measure volume x).to_real)), + { apply tendsto.congr' _ + ((ennreal.tendsto_to_real h'x.ne).comp (hx.comp (real.tendsto_Icc_vitali_family_left x))), + filter_upwards [self_mem_nhds_within], + rintros y (hxy : y < x), + simp only [comp_app, stieltjes_function.measure_Icc, real.volume_Icc], + rw [← ennreal.of_real_div_of_pos (sub_pos.2 hxy), ennreal.to_real_of_real, ← neg_neg (y - x), + div_neg, neg_div', neg_sub, neg_sub], + exact div_nonneg (sub_nonneg.2 (f.mono.left_lim_le hxy.le)) (sub_pos.2 hxy).le }, + -- Shifting a little bit the limit on the left, by `(y - x)^2`. + have L3 : tendsto (λ y, (left_lim f (y + 1 * (y - x)^2) - f x) / (y - x)) + (𝓝[<] x) (𝓝 ((rn_deriv f.measure volume x).to_real)), + { apply tendsto_apply_add_mul_sq_div_sub (nhds_left'_le_nhds_ne x) L2, + apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within, + { apply tendsto.mono_left _ nhds_within_le_nhds, + have : tendsto (λ (y : ℝ), y + 1 * (y - x) ^ 2) (𝓝 x) (𝓝 (x + 1 * (x - x)^2)) := + tendsto_id.add (((tendsto_id.sub_const x).pow 2).const_mul 1), + simpa using this }, + { have : Ioo (x - 1) x ∈ 𝓝[<] x, + { apply Ioo_mem_nhds_within_Iio, exact ⟨by linarith, le_refl _⟩ }, + filter_upwards [this], + rintros y ⟨hy : x - 1 < y, h'y : y < x⟩, + rw mem_Iio, + nlinarith } }, + -- Deduce the correct limit on the left, by sandwiching. + have L4 : tendsto (λ y, (f y - f x) / (y - x)) + (𝓝[<] x) (𝓝 ((rn_deriv f.measure volume x).to_real)), + { apply tendsto_of_tendsto_of_tendsto_of_le_of_le' L3 L2, + { filter_upwards [self_mem_nhds_within], + rintros y (hy : y < x), + refine div_le_div_of_nonpos_of_le (by linarith) ((sub_le_sub_iff_right _).2 _), + apply f.mono.le_left_lim, + have : 0 < (x - y)^2 := sq_pos_of_pos (sub_pos.2 hy), + linarith }, + { filter_upwards [self_mem_nhds_within], + rintros y (hy : y < x), + refine div_le_div_of_nonpos_of_le (by linarith) _, + simpa only [sub_le_sub_iff_right] using f.mono.left_lim_le (le_refl y) } }, + -- prove the result by splitting into left and right limits. + rw [has_deriv_at_iff_tendsto_slope, slope_fun_def_field, ← nhds_left'_sup_nhds_right', + tendsto_sup], + exact ⟨L4, L1⟩ +end + +/-- A monotone function is almost everywhere differentiable, with derivative equal to the +Radon-Nikodym derivative of the associated Stieltjes measure with respect to Lebesgue. -/ +lemma monotone.ae_has_deriv_at {f : ℝ → ℝ} (hf : monotone f) : + ∀ᵐ x, has_deriv_at f (rn_deriv hf.stieltjes_function.measure volume x).to_real x := +begin + /- We already know that the Stieltjes function associated to `f` (i.e., `g : x ↦ f (x^+)`) is + differentiable almost everywhere. We reduce to this statement by sandwiching values of `f` with + values of `g`, by shifting with `(y - x)^2` (which has no influence on the relevant + scale `y - x`.)-/ + filter_upwards [hf.stieltjes_function.ae_has_deriv_at, + hf.countable_not_continuous_at.ae_not_mem volume] with x hx h'x, + have A : hf.stieltjes_function x = f x, + { rw [not_not, hf.continuous_at_iff_left_lim_eq_right_lim] at h'x, + apply le_antisymm _ (hf.le_right_lim (le_refl _)), + rw ← h'x, + exact hf.left_lim_le (le_refl _) }, + rw [has_deriv_at_iff_tendsto_slope, (nhds_left'_sup_nhds_right' x).symm, tendsto_sup, + slope_fun_def_field, A] at hx, + -- prove differentiability on the right, by sandwiching with values of `g` + have L1 : tendsto (λ y, (f y - f x) / (y - x)) (𝓝[>] x) + (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).to_real), + { -- limit of a helper function, with a small shift compared to `g` + have : tendsto (λ y, (hf.stieltjes_function (y + (-1) * (y-x)^2) - f x) / (y - x)) (𝓝[>] x) + (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).to_real), + { apply tendsto_apply_add_mul_sq_div_sub (nhds_right'_le_nhds_ne x) hx.2, + apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within, + { apply tendsto.mono_left _ nhds_within_le_nhds, + have : tendsto (λ (y : ℝ), y + (-1) * (y - x) ^ 2) (𝓝 x) (𝓝 (x + (-1) * (x - x)^2)) := + tendsto_id.add (((tendsto_id.sub_const x).pow 2).const_mul (-1)), + simpa using this }, + { have : Ioo x (x+1) ∈ 𝓝[>] x, + { apply Ioo_mem_nhds_within_Ioi, exact ⟨le_refl _, by linarith⟩ }, + filter_upwards [this], + rintros y ⟨hy : x < y, h'y : y < x + 1⟩, + rw mem_Ioi, + nlinarith } }, + -- apply the sandwiching argument, with the helper function and `g` + apply tendsto_of_tendsto_of_tendsto_of_le_of_le' this hx.2, + { filter_upwards [self_mem_nhds_within], + rintros y (hy : x < y), + have : 0 < (y - x)^2, from sq_pos_of_pos (sub_pos.2 hy), + apply div_le_div_of_le_of_nonneg _ (sub_pos.2 hy).le, + exact (sub_le_sub_iff_right _).2 (hf.right_lim_le (by linarith)) }, + { filter_upwards [self_mem_nhds_within], + rintros y (hy : x < y), + apply div_le_div_of_le_of_nonneg _ (sub_pos.2 hy).le, + exact (sub_le_sub_iff_right _).2 (hf.le_right_lim (le_refl y)) } }, + -- prove differentiability on the left, by sandwiching with values of `g` + have L2 : tendsto (λ y, (f y - f x) / (y - x)) (𝓝[<] x) + (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).to_real), + { -- limit of a helper function, with a small shift compared to `g` + have : tendsto (λ y, (hf.stieltjes_function (y + (-1) * (y-x)^2) - f x) / (y - x)) (𝓝[<] x) + (𝓝 (rn_deriv hf.stieltjes_function.measure volume x).to_real), + { apply tendsto_apply_add_mul_sq_div_sub (nhds_left'_le_nhds_ne x) hx.1, + apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within, + { apply tendsto.mono_left _ nhds_within_le_nhds, + have : tendsto (λ (y : ℝ), y + (-1) * (y - x) ^ 2) (𝓝 x) (𝓝 (x + (-1) * (x - x)^2)) := + tendsto_id.add (((tendsto_id.sub_const x).pow 2).const_mul (-1)), + simpa using this }, + { have : Ioo (x - 1) x ∈ 𝓝[<] x, + { apply Ioo_mem_nhds_within_Iio, exact ⟨by linarith, le_refl _⟩ }, + filter_upwards [this], + rintros y ⟨hy : x - 1 < y, h'y : y < x⟩, + rw mem_Iio, + nlinarith } }, + -- apply the sandwiching argument, with `g` and the helper function + apply tendsto_of_tendsto_of_tendsto_of_le_of_le' hx.1 this, + { filter_upwards [self_mem_nhds_within], + rintros y (hy : y < x), + apply div_le_div_of_nonpos_of_le (sub_neg.2 hy).le, + exact (sub_le_sub_iff_right _).2 (hf.le_right_lim (le_refl _)) }, + { filter_upwards [self_mem_nhds_within], + rintros y (hy : y < x), + have : 0 < (y - x)^2, from sq_pos_of_neg (sub_neg.2 hy), + apply div_le_div_of_nonpos_of_le (sub_neg.2 hy).le, + exact (sub_le_sub_iff_right _).2 (hf.right_lim_le (by linarith)) } }, + -- conclude global differentiability + rw [has_deriv_at_iff_tendsto_slope, slope_fun_def_field, (nhds_left'_sup_nhds_right' x).symm, + tendsto_sup], + exact ⟨L2, L1⟩ +end + +/-- A monotone real function is differentiable Lebesgue-almost everywhere. -/ +theorem monotone.ae_differentiable_at {f : ℝ → ℝ} (hf : monotone f) : + ∀ᵐ x, differentiable_at ℝ f x := +by filter_upwards [hf.ae_has_deriv_at] with x hx using hx.differentiable_at + +/-- A real function which is monotone on a set is differentiable Lebesgue-almost everywhere on +this set. This version does not assume that `s` is measurable. For a formulation with +`volume.restrict s` assuming that `s` is measurable, see `monotone_on.ae_differentiable_within_at`. +-/ +theorem monotone_on.ae_differentiable_within_at_of_mem + {f : ℝ → ℝ} {s : set ℝ} (hf : monotone_on f s) : + ∀ᵐ x, x ∈ s → differentiable_within_at ℝ f s x := +begin + /- We use a global monotone extension of `f`, and argue that this extension is differentiable + almost everywhere. Such an extension need not exist (think of `1/x` on `(0, +∞)`), but it exists + if one restricts first the function to a compact interval `[a, b]`. -/ + apply ae_of_mem_of_ae_of_mem_inter_Ioo, + assume a b as bs hab, + obtain ⟨g, hg, gf⟩ : ∃ (g : ℝ → ℝ), monotone g ∧ eq_on f g (s ∩ Icc a b) := + (hf.mono (inter_subset_left s (Icc a b))).exists_monotone_extension + (hf.map_bdd_below (inter_subset_left _ _) ⟨a, λ x hx, hx.2.1, as⟩) + (hf.map_bdd_above (inter_subset_left _ _) ⟨b, λ x hx, hx.2.2, bs⟩), + filter_upwards [hg.ae_differentiable_at] with x hx, + assume h'x, + apply hx.differentiable_within_at.congr_of_eventually_eq _ (gf ⟨h'x.1, h'x.2.1.le, h'x.2.2.le⟩), + have : Ioo a b ∈ 𝓝[s] x, from nhds_within_le_nhds (Ioo_mem_nhds h'x.2.1 h'x.2.2), + filter_upwards [self_mem_nhds_within, this] with y hy h'y, + exact gf ⟨hy, h'y.1.le, h'y.2.le⟩, +end + +/-- A real function which is monotone on a set is differentiable Lebesgue-almost everywhere on +this set. This version assumes that `s` is measurable and uses `volume.restrict s`. +For a formulation without measurability assumption, +see `monotone_on.ae_differentiable_within_at_of_mem`. -/ +theorem monotone_on.ae_differentiable_within_at + {f : ℝ → ℝ} {s : set ℝ} (hf : monotone_on f s) (hs : measurable_set s) : + ∀ᵐ x ∂(volume.restrict s), differentiable_within_at ℝ f s x := +begin + rw ae_restrict_iff' hs, + exact hf.ae_differentiable_within_at_of_mem +end diff --git a/src/analysis/calculus/parametric_integral.lean b/src/analysis/calculus/parametric_integral.lean index 1d52b259e2857..307f254a58143 100644 --- a/src/analysis/calculus/parametric_integral.lean +++ b/src/analysis/calculus/parametric_integral.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Patrick Massot. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Massot -/ -import measure_theory.integral.set_integral import analysis.calculus.mean_value +import measure_theory.integral.set_integral /-! # Derivatives of integrals depending on parameters +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A parametric integral is a function with shape `f = λ x : H, ∫ a : α, F x a ∂μ` for some `F : H → α → E`, where `H` and `E` are normed spaces and `α` is a measured space with measure `μ`. @@ -54,15 +57,15 @@ integral, derivative noncomputable theory open topological_space measure_theory filter metric -open_locale topological_space filter +open_locale topology filter variables {α : Type*} [measurable_space α] {μ : measure α} {𝕜 : Type*} [is_R_or_C 𝕜] - {E : Type*} [normed_group E] [normed_space ℝ E] [normed_space 𝕜 E] + {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [normed_space 𝕜 E] [complete_space E] - {H : Type*} [normed_group H] [normed_space 𝕜 H] + {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H] /-- Differentiation under integral of `x ↦ ∫ F x a` at a given point `x₀`, assuming `F x₀` is -integrable, `∥F x a - F x₀ a∥ ≤ bound a * ∥x - x₀∥` for `x` in a ball around `x₀` for ae `a` with +integrable, `‖F x a - F x₀ a‖ ≤ bound a * ‖x - x₀‖` for `x` in a ball around `x₀` for ae `a` with integrable Lipschitz bound `bound` (with a ball radius independent of `a`), and `F x` is ae-measurable for `x` in the same ball. See `has_fderiv_at_integral_of_dominated_loc_of_lip` for a slightly less general but usually more useful version. -/ @@ -72,22 +75,22 @@ lemma has_fderiv_at_integral_of_dominated_loc_of_lip' {F : H → α → E} {F' : (hF_meas : ∀ x ∈ ball x₀ ε, ae_strongly_measurable (F x) μ) (hF_int : integrable (F x₀) μ) (hF'_meas : ae_strongly_measurable F' μ) - (h_lipsch : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ∥F x a - F x₀ a∥ ≤ bound a * ∥x - x₀∥) + (h_lipsch : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F x a - F x₀ a‖ ≤ bound a * ‖x - x₀‖) (bound_integrable : integrable (bound : α → ℝ) μ) (h_diff : ∀ᵐ a ∂μ, has_fderiv_at (λ x, F x a) (F' a) x₀) : integrable F' μ ∧ has_fderiv_at (λ x, ∫ a, F x a ∂μ) (∫ a, F' a ∂μ) x₀ := begin have x₀_in : x₀ ∈ ball x₀ ε := mem_ball_self ε_pos, - have nneg : ∀ x, 0 ≤ ∥x - x₀∥⁻¹ := λ x, inv_nonneg.mpr (norm_nonneg _) , + have nneg : ∀ x, 0 ≤ ‖x - x₀‖⁻¹ := λ x, inv_nonneg.mpr (norm_nonneg _) , set b : α → ℝ := λ a, |bound a|, have b_int : integrable b μ := bound_integrable.norm, have b_nonneg : ∀ a, 0 ≤ b a := λ a, abs_nonneg _, - replace h_lipsch : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ∥F x a - F x₀ a∥ ≤ b a * ∥x - x₀∥, + replace h_lipsch : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F x a - F x₀ a‖ ≤ b a * ‖x - x₀‖, from h_lipsch.mono (λ a ha x hx, (ha x hx).trans $ mul_le_mul_of_nonneg_right (le_abs_self _) (norm_nonneg _)), have hF_int' : ∀ x ∈ ball x₀ ε, integrable (F x) μ, { intros x x_in, - have : ∀ᵐ a ∂μ, ∥F x₀ a - F x a∥ ≤ ε * b a, + have : ∀ᵐ a ∂μ, ‖F x₀ a - F x a‖ ≤ ε * b a, { simp only [norm_sub_rev (F x₀ _)], refine h_lipsch.mono (λ a ha, (ha x x_in).trans _), rw mul_comm ε, @@ -96,7 +99,7 @@ begin exact integrable_of_norm_sub_le (hF_meas x x_in) hF_int (integrable.const_mul bound_integrable.norm ε) this }, have hF'_int : integrable F' μ, - { have : ∀ᵐ a ∂μ, ∥F' a∥ ≤ b a, + { have : ∀ᵐ a ∂μ, ‖F' a‖ ≤ b a, { apply (h_diff.and h_lipsch).mono, rintros a ⟨ha_diff, ha_lip⟩, refine ha_diff.le_of_lip' (b_nonneg a) (mem_of_superset (ball_mem_nhds _ ε_pos) $ ha_lip) }, @@ -104,8 +107,8 @@ begin refine ⟨hF'_int, _⟩, have h_ball: ball x₀ ε ∈ 𝓝 x₀ := ball_mem_nhds x₀ ε_pos, have : ∀ᶠ x in 𝓝 x₀, - ∥x - x₀∥⁻¹ * ∥∫ a, F x a ∂μ - ∫ a, F x₀ a ∂μ - (∫ a, F' a ∂μ) (x - x₀)∥ = - ∥∫ a, ∥x - x₀∥⁻¹ • (F x a - F x₀ a - F' a (x - x₀)) ∂μ∥, + ‖x - x₀‖⁻¹ * ‖∫ a, F x a ∂μ - ∫ a, F x₀ a ∂μ - (∫ a, F' a ∂μ) (x - x₀)‖ = + ‖∫ a, ‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀)) ∂μ‖, { apply mem_of_superset (ball_mem_nhds _ ε_pos), intros x x_in, rw [set.mem_set_of_eq, ← norm_smul_of_nonneg (nneg _), integral_smul, @@ -113,7 +116,7 @@ begin exacts [hF_int' x x_in, hF_int, (hF_int' x x_in).sub hF_int, hF'_int.apply_continuous_linear_map _] }, rw [has_fderiv_at_iff_tendsto, tendsto_congr' this, ← tendsto_zero_iff_norm_tendsto_zero, - ← show ∫ (a : α), ∥x₀ - x₀∥⁻¹ • (F x₀ a - F x₀ a - (F' a) (x₀ - x₀)) ∂μ = 0, by simp], + ← show ∫ (a : α), ‖x₀ - x₀‖⁻¹ • (F x₀ a - F x₀ a - (F' a) (x₀ - x₀)) ∂μ = 0, by simp], apply tendsto_integral_filter_of_dominated_convergence, { filter_upwards [h_ball] with _ x_in, apply ae_strongly_measurable.const_smul, @@ -122,28 +125,28 @@ begin intros x hx, apply (h_diff.and h_lipsch).mono, rintros a ⟨ha_deriv, ha_bound⟩, - show ∥∥x - x₀∥⁻¹ • (F x a - F x₀ a - F' a (x - x₀))∥ ≤ b a + ∥F' a∥, - replace ha_bound : ∥F x a - F x₀ a∥ ≤ b a * ∥x - x₀∥ := ha_bound x hx, - calc ∥∥x - x₀∥⁻¹ • (F x a - F x₀ a - F' a (x - x₀))∥ - = ∥∥x - x₀∥⁻¹ • (F x a - F x₀ a) - ∥x - x₀∥⁻¹ • F' a (x - x₀)∥ : by rw smul_sub - ... ≤ ∥∥x - x₀∥⁻¹ • (F x a - F x₀ a)∥ + ∥∥x - x₀∥⁻¹ • F' a (x - x₀)∥ : norm_sub_le _ _ - ... = ∥x - x₀∥⁻¹ * ∥F x a - F x₀ a∥ + ∥x - x₀∥⁻¹ * ∥F' a (x - x₀)∥ : + show ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))‖ ≤ b a + ‖F' a‖, + replace ha_bound : ‖F x a - F x₀ a‖ ≤ b a * ‖x - x₀‖ := ha_bound x hx, + calc ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))‖ + = ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a) - ‖x - x₀‖⁻¹ • F' a (x - x₀)‖ : by rw smul_sub + ... ≤ ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a)‖ + ‖‖x - x₀‖⁻¹ • F' a (x - x₀)‖ : norm_sub_le _ _ + ... = ‖x - x₀‖⁻¹ * ‖F x a - F x₀ a‖ + ‖x - x₀‖⁻¹ * ‖F' a (x - x₀)‖ : by { rw [norm_smul_of_nonneg, norm_smul_of_nonneg] ; exact nneg _} - ... ≤ ∥x - x₀∥⁻¹ * (b a * ∥x - x₀∥) + ∥x - x₀∥⁻¹ * (∥F' a∥ * ∥x - x₀∥) : add_le_add _ _ - ... ≤ b a + ∥F' a∥ : _, + ... ≤ ‖x - x₀‖⁻¹ * (b a * ‖x - x₀‖) + ‖x - x₀‖⁻¹ * (‖F' a‖ * ‖x - x₀‖) : add_le_add _ _ + ... ≤ b a + ‖F' a‖ : _, exact mul_le_mul_of_nonneg_left ha_bound (nneg _), apply mul_le_mul_of_nonneg_left ((F' a).le_op_norm _) (nneg _), - by_cases h : ∥x - x₀∥ = 0, + by_cases h : ‖x - x₀‖ = 0, { simpa [h] using add_nonneg (b_nonneg a) (norm_nonneg (F' a)) }, { field_simp [h] } }, { exact b_int.add hF'_int.norm }, { apply h_diff.mono, intros a ha, - suffices : tendsto (λ x, ∥x - x₀∥⁻¹ • (F x a - F x₀ a - F' a (x - x₀))) (𝓝 x₀) (𝓝 0), + suffices : tendsto (λ x, ‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))) (𝓝 x₀) (𝓝 0), by simpa, rw tendsto_zero_iff_norm_tendsto_zero, - have : (λ x, ∥x - x₀∥⁻¹ * ∥F x a - F x₀ a - F' a (x - x₀)∥) = - λ x, ∥∥x - x₀∥⁻¹ • (F x a - F x₀ a - F' a (x - x₀))∥, + have : (λ x, ‖x - x₀‖⁻¹ * ‖F x a - F x₀ a - F' a (x - x₀)‖) = + λ x, ‖‖x - x₀‖⁻¹ • (F x a - F x₀ a - F' a (x - x₀))‖, { ext x, rw norm_smul_of_nonneg (nneg _) }, rwa [has_fderiv_at_iff_tendsto, this] at ha }, @@ -167,7 +170,7 @@ begin obtain ⟨δ, δ_pos, hδ⟩ : ∃ δ > 0, ∀ x ∈ ball x₀ δ, ae_strongly_measurable (F x) μ ∧ x ∈ ball x₀ ε, from eventually_nhds_iff_ball.mp (hF_meas.and (ball_mem_nhds x₀ ε_pos)), choose hδ_meas hδε using hδ, - replace h_lip : ∀ᵐ (a : α) ∂μ, ∀ x ∈ ball x₀ δ, ∥F x a - F x₀ a∥ ≤ |bound a| * ∥x - x₀∥, + replace h_lip : ∀ᵐ (a : α) ∂μ, ∀ x ∈ ball x₀ δ, ‖F x a - F x₀ a‖ ≤ |bound a| * ‖x - x₀‖, from h_lip.mono (λ a lip x hx, lip.norm_sub_le (hδε x hx) (mem_ball_self ε_pos)), replace bound_integrable := bound_integrable.norm, apply has_fderiv_at_integral_of_dominated_loc_of_lip' δ_pos; assumption @@ -183,7 +186,7 @@ lemma has_fderiv_at_integral_of_dominated_of_fderiv_le {F : H → α → E} {F' (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) μ) (hF_int : integrable (F x₀) μ) (hF'_meas : ae_strongly_measurable (F' x₀) μ) - (h_bound : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ∥F' x a∥ ≤ bound a) + (h_bound : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F' x a‖ ≤ bound a) (bound_integrable : integrable (bound : α → ℝ) μ) (h_diff : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, has_fderiv_at (λ x, F x a) (F' x a) x) : has_fderiv_at (λ x, ∫ a, F x a ∂μ) (∫ a, F' x₀ a ∂μ) x₀ := @@ -245,7 +248,7 @@ lemma has_deriv_at_integral_of_dominated_loc_of_deriv_le {F : 𝕜 → α → E} (hF_int : integrable (F x₀) μ) (hF'_meas : ae_strongly_measurable (F' x₀) μ) {bound : α → ℝ} - (h_bound : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ∥F' x a∥ ≤ bound a) + (h_bound : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, ‖F' x a‖ ≤ bound a) (bound_integrable : integrable bound μ) (h_diff : ∀ᵐ a ∂μ, ∀ x ∈ ball x₀ ε, has_deriv_at (λ x, F x a) (F' x a) x) : (integrable (F' x₀) μ) ∧ has_deriv_at (λn, ∫ a, F n a ∂μ) (∫ a, F' x₀ a ∂μ) x₀ := diff --git a/src/analysis/calculus/parametric_interval_integral.lean b/src/analysis/calculus/parametric_interval_integral.lean index b5cfe97ee45fa..0d9494850c02e 100644 --- a/src/analysis/calculus/parametric_interval_integral.lean +++ b/src/analysis/calculus/parametric_interval_integral.lean @@ -9,17 +9,20 @@ import measure_theory.integral.interval_integral /-! # Derivatives of interval integrals depending on parameters +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we restate theorems about derivatives of integrals depending on parameters for interval integrals. -/ open topological_space measure_theory filter metric -open_locale topological_space filter interval +open_locale topology filter interval variables {𝕜 : Type*} [is_R_or_C 𝕜] {μ : measure ℝ} - {E : Type*} [normed_group E] [normed_space ℝ E] [normed_space 𝕜 E] + {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [normed_space 𝕜 E] [complete_space E] - {H : Type*} [normed_group H] [normed_space 𝕜 H] + {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H] {a b ε : ℝ} {bound : ℝ → ℝ} namespace interval_integral @@ -39,8 +42,8 @@ lemma has_fderiv_at_integral_of_dominated_loc_of_lip {F : H → ℝ → E} {F' : interval_integrable F' μ a b ∧ has_fderiv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' t ∂μ) x₀ := begin - simp only [interval_integrable_iff, interval_integral_eq_integral_interval_oc, - ← ae_restrict_iff' measurable_set_interval_oc] at *, + simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc, + ← ae_restrict_iff' measurable_set_uIoc] at *, have := has_fderiv_at_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas h_lip bound_integrable h_diff, exact ⟨this.1, this.2.const_smul _⟩ @@ -55,13 +58,13 @@ lemma has_fderiv_at_integral_of_dominated_of_fderiv_le {F : H → ℝ → E} {F' (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict (Ι a b))) (hF_int : interval_integrable (F x₀) μ a b) (hF'_meas : ae_strongly_measurable (F' x₀) (μ.restrict (Ι a b))) - (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ∥F' x t∥ ≤ bound t) + (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ‖F' x t‖ ≤ bound t) (bound_integrable : interval_integrable bound μ a b) (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, has_fderiv_at (λ x, F x t) (F' x t) x) : has_fderiv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' x₀ t ∂μ) x₀ := begin - simp only [interval_integrable_iff, interval_integral_eq_integral_interval_oc, - ← ae_restrict_iff' measurable_set_interval_oc] at *, + simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc, + ← ae_restrict_iff' measurable_set_uIoc] at *, exact (has_fderiv_at_integral_of_dominated_of_fderiv_le ε_pos hF_meas hF_int hF'_meas h_bound bound_integrable h_diff).const_smul _ end @@ -82,8 +85,8 @@ lemma has_deriv_at_integral_of_dominated_loc_of_lip {F : 𝕜 → ℝ → E} {F' (interval_integrable F' μ a b) ∧ has_deriv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' t ∂μ) x₀ := begin - simp only [interval_integrable_iff, interval_integral_eq_integral_interval_oc, - ← ae_restrict_iff' measurable_set_interval_oc] at *, + simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc, + ← ae_restrict_iff' measurable_set_uIoc] at *, have := has_deriv_at_integral_of_dominated_loc_of_lip ε_pos hF_meas hF_int hF'_meas h_lipsch bound_integrable h_diff, exact ⟨this.1, this.2.const_smul _⟩ @@ -98,14 +101,14 @@ lemma has_deriv_at_integral_of_dominated_loc_of_deriv_le {F : 𝕜 → ℝ → E (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict (Ι a b))) (hF_int : interval_integrable (F x₀) μ a b) (hF'_meas : ae_strongly_measurable (F' x₀) (μ.restrict (Ι a b))) - (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ∥F' x t∥ ≤ bound t) + (h_bound : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, ‖F' x t‖ ≤ bound t) (bound_integrable : interval_integrable bound μ a b) (h_diff : ∀ᵐ t ∂μ, t ∈ Ι a b → ∀ x ∈ ball x₀ ε, has_deriv_at (λ x, F x t) (F' x t) x) : (interval_integrable (F' x₀) μ a b) ∧ has_deriv_at (λ x, ∫ t in a..b, F x t ∂μ) (∫ t in a..b, F' x₀ t ∂μ) x₀ := begin - simp only [interval_integrable_iff, interval_integral_eq_integral_interval_oc, - ← ae_restrict_iff' measurable_set_interval_oc] at *, + simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc, + ← ae_restrict_iff' measurable_set_uIoc] at *, have := has_deriv_at_integral_of_dominated_loc_of_deriv_le ε_pos hF_meas hF_int hF'_meas h_bound bound_integrable h_diff, exact ⟨this.1, this.2.const_smul _⟩ diff --git a/src/analysis/calculus/series.lean b/src/analysis/calculus/series.lean new file mode 100644 index 0000000000000..cc4856796a27a --- /dev/null +++ b/src/analysis/calculus/series.lean @@ -0,0 +1,309 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.calculus.uniform_limits_deriv +import analysis.calculus.cont_diff +import data.nat.cast.with_top + +/-! +# Smoothness of series + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that series of functions are continuous, or differentiable, or smooth, when each individual +function in the series is and additionally suitable uniform summable bounds are satisfied. + +More specifically, +* `continuous_tsum` ensures that a series of continuous functions is continuous. +* `differentiable_tsum` ensures that a series of differentiable functions is differentiable. +* `cont_diff_tsum` ensures that a series of smooth functions is smooth. + +We also give versions of these statements which are localized to a set. +-/ + +open set metric topological_space function asymptotics filter +open_locale topology nnreal big_operators + +variables {α β 𝕜 E F : Type*} + [is_R_or_C 𝕜] + [normed_add_comm_group E] [normed_space 𝕜 E] + [normed_add_comm_group F] [complete_space F] + {u : α → ℝ} + +/-! ### Continuity -/ + +/-- An infinite sum of functions with summable sup norm is the uniform limit of its partial sums. +Version relative to a set, with general index set. -/ +lemma tendsto_uniformly_on_tsum {f : α → β → F} (hu : summable u) {s : set β} + (hfu : ∀ n x, x ∈ s → ‖f n x‖ ≤ u n) : + tendsto_uniformly_on (λ (t : finset α), (λ x, ∑ n in t, f n x)) (λ x, ∑' n, f n x) at_top s := +begin + refine tendsto_uniformly_on_iff.2 (λ ε εpos, _), + filter_upwards [(tendsto_order.1 (tendsto_tsum_compl_at_top_zero u)).2 _ εpos] with t ht x hx, + have A : summable (λ n, ‖f n x‖), + from summable_of_nonneg_of_le (λ n, norm_nonneg _) (λ n, hfu n x hx) hu, + rw [dist_eq_norm, ← sum_add_tsum_subtype_compl (summable_of_summable_norm A) t, add_sub_cancel'], + apply lt_of_le_of_lt _ ht, + apply (norm_tsum_le_tsum_norm (A.subtype _)).trans, + exact tsum_le_tsum (λ n, hfu _ _ hx) (A.subtype _) (hu.subtype _) +end + +/-- An infinite sum of functions with summable sup norm is the uniform limit of its partial sums. +Version relative to a set, with index set `ℕ`. -/ +lemma tendsto_uniformly_on_tsum_nat {f : ℕ → β → F} {u : ℕ → ℝ} (hu : summable u) {s : set β} + (hfu : ∀ n x, x ∈ s → ‖f n x‖ ≤ u n) : + tendsto_uniformly_on (λ N, (λ x, ∑ n in finset.range N, f n x)) (λ x, ∑' n, f n x) at_top s := +λ v hv, tendsto_finset_range.eventually (tendsto_uniformly_on_tsum hu hfu v hv) + +/-- An infinite sum of functions with summable sup norm is the uniform limit of its partial sums. +Version with general index set. -/ +lemma tendsto_uniformly_tsum {f : α → β → F} (hu : summable u) + (hfu : ∀ n x, ‖f n x‖ ≤ u n) : + tendsto_uniformly (λ (t : finset α), (λ x, ∑ n in t, f n x)) (λ x, ∑' n, f n x) at_top := +by { rw ← tendsto_uniformly_on_univ, exact tendsto_uniformly_on_tsum hu (λ n x hx, hfu n x) } + +/-- An infinite sum of functions with summable sup norm is the uniform limit of its partial sums. +Version with index set `ℕ`. -/ +lemma tendsto_uniformly_tsum_nat {f : ℕ → β → F} {u : ℕ → ℝ} (hu : summable u) + (hfu : ∀ n x, ‖f n x‖ ≤ u n) : + tendsto_uniformly (λ N, (λ x, ∑ n in finset.range N, f n x)) (λ x, ∑' n, f n x) at_top := +λ v hv, tendsto_finset_range.eventually (tendsto_uniformly_tsum hu hfu v hv) + +/-- An infinite sum of functions with summable sup norm is continuous on a set if each individual +function is. -/ +lemma continuous_on_tsum [topological_space β] + {f : α → β → F} {s : set β} (hf : ∀ i, continuous_on (f i) s) (hu : summable u) + (hfu : ∀ n x, x ∈ s → ‖f n x‖ ≤ u n) : + continuous_on (λ x, ∑' n, f n x) s := +begin + classical, + refine (tendsto_uniformly_on_tsum hu hfu).continuous_on (eventually_of_forall _), + assume t, + exact continuous_on_finset_sum _ (λ i hi, hf i), +end + +/-- An infinite sum of functions with summable sup norm is continuous if each individual +function is. -/ +lemma continuous_tsum [topological_space β] + {f : α → β → F} (hf : ∀ i, continuous (f i)) (hu : summable u) + (hfu : ∀ n x, ‖f n x‖ ≤ u n) : + continuous (λ x, ∑' n, f n x) := +begin + simp_rw [continuous_iff_continuous_on_univ] at hf ⊢, + exact continuous_on_tsum hf hu (λ n x hx, hfu n x), +end + + +/-! ### Differentiability -/ + +variables [normed_space 𝕜 F] +variables {f : α → E → F} {f' : α → E → (E →L[𝕜] F)} {v : ℕ → α → ℝ} +{s : set E} {x₀ x : E} {N : ℕ∞} + +/-- Consider a series of functions `∑' n, f n x` on a preconnected open set. If the series converges +at a point, and all functions in the series are differentiable with a summable bound on the +derivatives, then the series converges everywhere on the set. -/ +lemma summable_of_summable_has_fderiv_at_of_is_preconnected + (hu : summable u) (hs : is_open s) (h's : is_preconnected s) + (hf : ∀ n x, x ∈ s → has_fderiv_at (f n) (f' n x) x) + (hf' : ∀ n x, x ∈ s → ‖f' n x‖ ≤ u n) + (hx₀ : x₀ ∈ s) (hf0 : summable (λ n, f n x₀)) {x : E} (hx : x ∈ s) : + summable (λ n, f n x) := +begin + rw summable_iff_cauchy_seq_finset at hf0 ⊢, + have A : uniform_cauchy_seq_on (λ (t : finset α), (λ x, ∑ i in t, f' i x)) at_top s, + from (tendsto_uniformly_on_tsum hu hf').uniform_cauchy_seq_on, + apply cauchy_map_of_uniform_cauchy_seq_on_fderiv hs h's A (λ t y hy, _) hx₀ hx hf0, + exact has_fderiv_at.sum (λ i hi, hf i y hy), +end + +/-- Consider a series of functions `∑' n, f n x` on a preconnected open set. If the series converges +at a point, and all functions in the series are differentiable with a summable bound on the +derivatives, then the series is differentiable on the set and its derivative is the sum of the +derivatives. -/ +lemma has_fderiv_at_tsum_of_is_preconnected + (hu : summable u) (hs : is_open s) (h's : is_preconnected s) + (hf : ∀ n x, x ∈ s → has_fderiv_at (f n) (f' n x) x) + (hf' : ∀ n x, x ∈ s → ‖f' n x‖ ≤ u n) + (hx₀ : x₀ ∈ s) (hf0 : summable (λ n, f n x₀)) (hx : x ∈ s) : + has_fderiv_at (λ y, ∑' n, f n y) (∑' n, f' n x) x := +begin + classical, + have A : ∀ (x : E), x ∈ s → tendsto (λ (t : finset α), ∑ n in t, f n x) at_top (𝓝 (∑' n, f n x)), + { assume y hy, + apply summable.has_sum, + exact summable_of_summable_has_fderiv_at_of_is_preconnected hu hs h's hf hf' hx₀ hf0 hy }, + apply has_fderiv_at_of_tendsto_uniformly_on hs + (tendsto_uniformly_on_tsum hu hf') (λ t y hy, _) A _ hx, + exact has_fderiv_at.sum (λ n hn, hf n y hy), +end + +/-- Consider a series of functions `∑' n, f n x`. If the series converges at a +point, and all functions in the series are differentiable with a summable bound on the derivatives, +then the series converges everywhere. -/ +lemma summable_of_summable_has_fderiv_at + (hu : summable u) (hf : ∀ n x, has_fderiv_at (f n) (f' n x) x) (hf' : ∀ n x, ‖f' n x‖ ≤ u n) + (hf0 : summable (λ n, f n x₀)) (x : E) : + summable (λ n, f n x) := +begin + letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _, + apply summable_of_summable_has_fderiv_at_of_is_preconnected hu is_open_univ + is_connected_univ.is_preconnected (λ n x hx, hf n x) + (λ n x hx, hf' n x) (mem_univ _) hf0 (mem_univ _), +end + +/-- Consider a series of functions `∑' n, f n x`. If the series converges at a +point, and all functions in the series are differentiable with a summable bound on the derivatives, +then the series is differentiable and its derivative is the sum of the derivatives. -/ +lemma has_fderiv_at_tsum + (hu : summable u) (hf : ∀ n x, has_fderiv_at (f n) (f' n x) x) (hf' : ∀ n x, ‖f' n x‖ ≤ u n) + (hf0 : summable (λ n, f n x₀)) (x : E) : + has_fderiv_at (λ y, ∑' n, f n y) (∑' n, f' n x) x := +begin + letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _, + exact has_fderiv_at_tsum_of_is_preconnected hu is_open_univ + is_connected_univ.is_preconnected (λ n x hx, hf n x) + (λ n x hx, hf' n x) (mem_univ _) hf0 (mem_univ _), +end + +/-- Consider a series of functions `∑' n, f n x`. If all functions in the series are differentiable +with a summable bound on the derivatives, then the series is differentiable. +Note that our assumptions do not ensure the pointwise convergence, but if there is no pointwise +convergence then the series is zero everywhere so the result still holds. -/ +lemma differentiable_tsum + (hu : summable u) (hf : ∀ n x, has_fderiv_at (f n) (f' n x) x) (hf' : ∀ n x, ‖f' n x‖ ≤ u n) : + differentiable 𝕜 (λ y, ∑' n, f n y) := +begin + by_cases h : ∃ x₀, summable (λ n, f n x₀), + { rcases h with ⟨x₀, hf0⟩, + assume x, + exact (has_fderiv_at_tsum hu hf hf' hf0 x).differentiable_at }, + { push_neg at h, + have : (λ x, ∑' n, f n x) = 0, + { ext1 x, exact tsum_eq_zero_of_not_summable (h x) }, + rw this, + exact differentiable_const 0 } +end + +lemma fderiv_tsum_apply + (hu : summable u) (hf : ∀ n, differentiable 𝕜 (f n)) (hf' : ∀ n x, ‖fderiv 𝕜 (f n) x‖ ≤ u n) + (hf0 : summable (λ n, f n x₀)) (x : E) : + fderiv 𝕜 (λ y, ∑' n, f n y) x = ∑' n, fderiv 𝕜 (f n) x := +(has_fderiv_at_tsum hu (λ n x, (hf n x).has_fderiv_at) hf' hf0 _).fderiv + +lemma fderiv_tsum + (hu : summable u) (hf : ∀ n, differentiable 𝕜 (f n)) (hf' : ∀ n x, ‖fderiv 𝕜 (f n) x‖ ≤ u n) + {x₀ : E} (hf0 : summable (λ n, f n x₀)) : + fderiv 𝕜 (λ y, ∑' n, f n y) = (λ x, ∑' n, fderiv 𝕜 (f n) x) := +by { ext1 x, exact fderiv_tsum_apply hu hf hf' hf0 x} + + +/-! ### Higher smoothness -/ + +/-- Consider a series of smooth functions, with summable uniform bounds on the successive +derivatives. Then the iterated derivative of the sum is the sum of the iterated derivative. -/ +lemma iterated_fderiv_tsum + (hf : ∀ i, cont_diff 𝕜 N (f i)) (hv : ∀ (k : ℕ), (k : ℕ∞) ≤ N → summable (v k)) + (h'f : ∀ (k : ℕ) (i : α) (x : E), (k : ℕ∞) ≤ N → ‖iterated_fderiv 𝕜 k (f i) x‖ ≤ v k i) + {k : ℕ} (hk : (k : ℕ∞) ≤ N) : + iterated_fderiv 𝕜 k (λ y, ∑' n, f n y) = (λ x, ∑' n, iterated_fderiv 𝕜 k (f n) x) := +begin + induction k with k IH, + { ext1 x, + simp_rw [iterated_fderiv_zero_eq_comp], + exact (continuous_multilinear_curry_fin0 𝕜 E F).symm.to_continuous_linear_equiv.map_tsum }, + { have h'k : (k : ℕ∞) < N, + from lt_of_lt_of_le (with_top.coe_lt_coe.2 (nat.lt_succ_self _)) hk, + have A : summable (λ n, iterated_fderiv 𝕜 k (f n) 0), + from summable_of_norm_bounded (v k) (hv k h'k.le) (λ n, h'f k n 0 h'k.le), + simp_rw [iterated_fderiv_succ_eq_comp_left, IH h'k.le], + rw fderiv_tsum (hv _ hk) (λ n, (hf n).differentiable_iterated_fderiv h'k) _ A, + { ext1 x, + exact (continuous_multilinear_curry_left_equiv 𝕜 (λ (i : fin (k + 1)), E) F) + .to_continuous_linear_equiv.map_tsum }, + { assume n x, + simpa only [iterated_fderiv_succ_eq_comp_left, linear_isometry_equiv.norm_map] + using h'f k.succ n x hk } } +end + +/-- Consider a series of smooth functions, with summable uniform bounds on the successive +derivatives. Then the iterated derivative of the sum is the sum of the iterated derivative. -/ +lemma iterated_fderiv_tsum_apply + (hf : ∀ i, cont_diff 𝕜 N (f i)) (hv : ∀ (k : ℕ), (k : ℕ∞) ≤ N → summable (v k)) + (h'f : ∀ (k : ℕ) (i : α) (x : E), (k : ℕ∞) ≤ N → ‖iterated_fderiv 𝕜 k (f i) x‖ ≤ v k i) + {k : ℕ} (hk : (k : ℕ∞) ≤ N) (x : E) : + iterated_fderiv 𝕜 k (λ y, ∑' n, f n y) x = ∑' n, iterated_fderiv 𝕜 k (f n) x := +by rw iterated_fderiv_tsum hf hv h'f hk + +/-- Consider a series of functions `∑' i, f i x`. Assume that each individual function `f i` is of +class `C^N`, and moreover there is a uniform summable upper bound on the `k`-th derivative +for each `k ≤ N`. Then the series is also `C^N`. -/ +lemma cont_diff_tsum + (hf : ∀ i, cont_diff 𝕜 N (f i)) (hv : ∀ (k : ℕ), (k : ℕ∞) ≤ N → summable (v k)) + (h'f : ∀ (k : ℕ) (i : α) (x : E), (k : ℕ∞) ≤ N → ‖iterated_fderiv 𝕜 k (f i) x‖ ≤ v k i) : + cont_diff 𝕜 N (λ x, ∑' i, f i x) := +begin + rw cont_diff_iff_continuous_differentiable, + split, + { assume m hm, + rw iterated_fderiv_tsum hf hv h'f hm, + refine continuous_tsum _ (hv m hm) _, + { assume i, + exact cont_diff.continuous_iterated_fderiv hm (hf i) }, + { assume n x, + exact h'f _ _ _ hm } }, + { assume m hm, + have h'm : ((m+1 : ℕ) : ℕ∞) ≤ N, + by simpa only [enat.coe_add, nat.cast_with_bot, enat.coe_one] using enat.add_one_le_of_lt hm, + rw iterated_fderiv_tsum hf hv h'f hm.le, + have A : ∀ n x, has_fderiv_at (iterated_fderiv 𝕜 m (f n)) + (fderiv 𝕜 (iterated_fderiv 𝕜 m (f n)) x) x, from λ n x, + (cont_diff.differentiable_iterated_fderiv hm (hf n)).differentiable_at.has_fderiv_at, + apply differentiable_tsum (hv _ h'm) A (λ n x, _), + rw [fderiv_iterated_fderiv, linear_isometry_equiv.norm_map], + exact h'f _ _ _ h'm } +end + +/-- Consider a series of functions `∑' i, f i x`. Assume that each individual function `f i` is of +class `C^N`, and moreover there is a uniform summable upper bound on the `k`-th derivative +for each `k ≤ N` (except maybe for finitely many `i`s). Then the series is also `C^N`. -/ +lemma cont_diff_tsum_of_eventually + (hf : ∀ i, cont_diff 𝕜 N (f i)) (hv : ∀ (k : ℕ), (k : ℕ∞) ≤ N → summable (v k)) + (h'f : ∀ (k : ℕ), (k : ℕ∞) ≤ N → ∀ᶠ i in (filter.cofinite : filter α), ∀ (x : E), + ‖iterated_fderiv 𝕜 k (f i) x‖ ≤ v k i) : + cont_diff 𝕜 N (λ x, ∑' i, f i x) := +begin + classical, + apply cont_diff_iff_forall_nat_le.2 (λ m hm, _), + let t : set α := + {i : α | ¬∀ (k : ℕ), k ∈ finset.range (m + 1) → ∀ x, ‖iterated_fderiv 𝕜 k (f i) x‖ ≤ v k i}, + have ht : set.finite t, + { have A : ∀ᶠ i in (filter.cofinite : filter α), ∀ (k : ℕ), k ∈ finset.range (m+1) → + ∀ (x : E), ‖iterated_fderiv 𝕜 k (f i) x‖ ≤ v k i, + { rw eventually_all_finset, + assume i hi, + apply h'f, + simp only [finset.mem_range_succ_iff] at hi, + exact (with_top.coe_le_coe.2 hi).trans hm }, + exact eventually_cofinite.2 A }, + let T : finset α := ht.to_finset, + have : (λ x, ∑' i, f i x) = (λ x, ∑ i in T, f i x) + (λ x, ∑' i : {i // i ∉ T}, f i x), + { ext1 x, + refine (sum_add_tsum_subtype_compl _ T).symm, + refine summable_of_norm_bounded_eventually _ (hv 0 (zero_le _)) _, + filter_upwards [h'f 0 (zero_le _)] with i hi, + simpa only [norm_iterated_fderiv_zero] using hi x }, + rw this, + apply (cont_diff.sum (λ i hi, (hf i).of_le hm)).add, + have h'u : ∀ (k : ℕ), (k : ℕ∞) ≤ m → summable ((v k) ∘ (coe : {i // i ∉ T} → α)), + from λ k hk, (hv k (hk.trans hm)).subtype _, + refine cont_diff_tsum (λ i, (hf i).of_le hm) h'u _, + rintros k ⟨i, hi⟩ x hk, + dsimp, + simp only [finite.mem_to_finset, mem_set_of_eq, finset.mem_range, not_forall, not_le, exists_prop, + not_exists, not_and, not_lt] at hi, + exact hi k (nat.lt_succ_iff.2 (with_top.coe_le_coe.1 hk)) x, +end diff --git a/src/analysis/calculus/specific_functions.lean b/src/analysis/calculus/specific_functions.lean deleted file mode 100644 index 8820b4018fe90..0000000000000 --- a/src/analysis/calculus/specific_functions.lean +++ /dev/null @@ -1,569 +0,0 @@ -/- -Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sébastien Gouëzel, Floris van Doorn --/ -import analysis.calculus.iterated_deriv -import analysis.inner_product_space.euclidean_dist -import measure_theory.function.locally_integrable -import measure_theory.integral.set_integral - -/-! -# Infinitely smooth bump function - -In this file we construct several infinitely smooth functions with properties that an analytic -function cannot have: - -* `exp_neg_inv_glue` is equal to zero for `x ≤ 0` and is strictly positive otherwise; it is given by - `x ↦ exp (-1/x)` for `x > 0`; - -* `real.smooth_transition` is equal to zero for `x ≤ 0` and is equal to one for `x ≥ 1`; it is given - by `exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x))`; - -* `f : cont_diff_bump_of_inner c`, where `c` is a point in an inner product space, is - a bundled smooth function such that - - - `f` is equal to `1` in `metric.closed_ball c f.r`; - - `support f = metric.ball c f.R`; - - `0 ≤ f x ≤ 1` for all `x`. - - The structure `cont_diff_bump_of_inner` contains the data required to construct the - function: real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available - through `coe_fn`. - -* If `f : cont_diff_bump_of_inner c` and `μ` is a measure on the domain of `f`, then `f.normed μ` - is a smooth bump function with integral `1` w.r.t. `μ`. - -* `f : cont_diff_bump c`, where `c` is a point in a finite dimensional real vector space, is a - bundled smooth function such that - - - `f` is equal to `1` in `euclidean.closed_ball c f.r`; - - `support f = euclidean.ball c f.R`; - - `0 ≤ f x ≤ 1` for all `x`. - - The structure `cont_diff_bump` contains the data required to construct the function: real - numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through `coe_fn`. --/ - -noncomputable theory -open_locale classical topological_space - -open polynomial real filter set function - -/-- `exp_neg_inv_glue` is the real function given by `x ↦ exp (-1/x)` for `x > 0` and `0` -for `x ≤ 0`. It is a basic building block to construct smooth partitions of unity. Its main property -is that it vanishes for `x ≤ 0`, it is positive for `x > 0`, and the junction between the two -behaviors is flat enough to retain smoothness. The fact that this function is `C^∞` is proved in -`exp_neg_inv_glue.smooth`. -/ -def exp_neg_inv_glue (x : ℝ) : ℝ := if x ≤ 0 then 0 else exp (-x⁻¹) - -namespace exp_neg_inv_glue - -/-- Our goal is to prove that `exp_neg_inv_glue` is `C^∞`. For this, we compute its successive -derivatives for `x > 0`. The `n`-th derivative is of the form `P_aux n (x) exp(-1/x) / x^(2 n)`, -where `P_aux n` is computed inductively. -/ -noncomputable def P_aux : ℕ → polynomial ℝ -| 0 := 1 -| (n+1) := X^2 * (P_aux n).derivative + (1 - C ↑(2 * n) * X) * (P_aux n) - -/-- Formula for the `n`-th derivative of `exp_neg_inv_glue`, as an auxiliary function `f_aux`. -/ -def f_aux (n : ℕ) (x : ℝ) : ℝ := -if x ≤ 0 then 0 else (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n) - -/-- The `0`-th auxiliary function `f_aux 0` coincides with `exp_neg_inv_glue`, by definition. -/ -lemma f_aux_zero_eq : f_aux 0 = exp_neg_inv_glue := -begin - ext x, - by_cases h : x ≤ 0, - { simp [exp_neg_inv_glue, f_aux, h] }, - { simp [h, exp_neg_inv_glue, f_aux, ne_of_gt (not_le.1 h), P_aux] } -end - -/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n` -(given in this statement in unfolded form) is the `n+1`-th auxiliary function, since -the polynomial `P_aux (n+1)` was chosen precisely to ensure this. -/ -lemma f_aux_deriv (n : ℕ) (x : ℝ) (hx : x ≠ 0) : - has_deriv_at (λx, (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n)) - ((P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n + 1))) x := -begin - have A : ∀ k : ℕ, 2 * (k + 1) - 1 = 2 * k + 1 := λ k, rfl, - convert (((P_aux n).has_deriv_at x).mul - (((has_deriv_at_exp _).comp x (has_deriv_at_inv hx).neg))).div - (has_deriv_at_pow (2 * n) x) (pow_ne_zero _ hx) using 1, - field_simp [hx, P_aux], - -- `ring_exp` can't solve `p ∨ q` goal generated by `mul_eq_mul_right_iff` - cases n; simp [nat.succ_eq_add_one, A, -mul_eq_mul_right_iff]; ring_exp -end - -/-- For positive values, the derivative of the `n`-th auxiliary function `f_aux n` -is the `n+1`-th auxiliary function. -/ -lemma f_aux_deriv_pos (n : ℕ) (x : ℝ) (hx : 0 < x) : - has_deriv_at (f_aux n) ((P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n + 1))) x := -begin - apply (f_aux_deriv n x (ne_of_gt hx)).congr_of_eventually_eq, - filter_upwards [lt_mem_nhds hx] with _ hy, - simp [f_aux, hy.not_le] -end - -/-- To get differentiability at `0` of the auxiliary functions, we need to know that their limit -is `0`, to be able to apply general differentiability extension theorems. This limit is checked in -this lemma. -/ -lemma f_aux_limit (n : ℕ) : - tendsto (λx, (P_aux n).eval x * exp (-x⁻¹) / x^(2 * n)) (𝓝[>] 0) (𝓝 0) := -begin - have A : tendsto (λx, (P_aux n).eval x) (𝓝[>] 0) (𝓝 ((P_aux n).eval 0)) := - (P_aux n).continuous_within_at, - have B : tendsto (λx, exp (-x⁻¹) / x^(2 * n)) (𝓝[>] 0) (𝓝 0), - { convert (tendsto_pow_mul_exp_neg_at_top_nhds_0 (2 * n)).comp tendsto_inv_zero_at_top, - ext x, - field_simp }, - convert A.mul B; - simp [mul_div_assoc] -end - -/-- Deduce from the limiting behavior at `0` of its derivative and general differentiability -extension theorems that the auxiliary function `f_aux n` is differentiable at `0`, -with derivative `0`. -/ -lemma f_aux_deriv_zero (n : ℕ) : has_deriv_at (f_aux n) 0 0 := -begin - -- we check separately differentiability on the left and on the right - have A : has_deriv_within_at (f_aux n) (0 : ℝ) (Iic 0) 0, - { apply (has_deriv_at_const (0 : ℝ) (0 : ℝ)).has_deriv_within_at.congr, - { assume y hy, - simp at hy, - simp [f_aux, hy] }, - { simp [f_aux, le_refl] } }, - have B : has_deriv_within_at (f_aux n) (0 : ℝ) (Ici 0) 0, - { have diff : differentiable_on ℝ (f_aux n) (Ioi 0) := - λx hx, (f_aux_deriv_pos n x hx).differentiable_at.differentiable_within_at, - -- next line is the nontrivial bit of this proof, appealing to differentiability - -- extension results. - apply has_deriv_at_interval_left_endpoint_of_tendsto_deriv diff _ self_mem_nhds_within, - { refine (f_aux_limit (n+1)).congr' _, - apply mem_of_superset self_mem_nhds_within (λx hx, _), - simp [(f_aux_deriv_pos n x hx).deriv] }, - { have : f_aux n 0 = 0, by simp [f_aux, le_refl], - simp only [continuous_within_at, this], - refine (f_aux_limit n).congr' _, - apply mem_of_superset self_mem_nhds_within (λx hx, _), - have : ¬(x ≤ 0), by simpa using hx, - simp [f_aux, this] } }, - simpa using A.union B, -end - -/-- At every point, the auxiliary function `f_aux n` has a derivative which is -equal to `f_aux (n+1)`. -/ -lemma f_aux_has_deriv_at (n : ℕ) (x : ℝ) : has_deriv_at (f_aux n) (f_aux (n+1) x) x := -begin - -- check separately the result for `x < 0`, where it is trivial, for `x > 0`, where it is done - -- in `f_aux_deriv_pos`, and for `x = 0`, done in - -- `f_aux_deriv_zero`. - rcases lt_trichotomy x 0 with hx|hx|hx, - { have : f_aux (n+1) x = 0, by simp [f_aux, le_of_lt hx], - rw this, - apply (has_deriv_at_const x (0 : ℝ)).congr_of_eventually_eq, - filter_upwards [gt_mem_nhds hx] with _ hy, - simp [f_aux, hy.le] }, - { have : f_aux (n + 1) 0 = 0, by simp [f_aux, le_refl], - rw [hx, this], - exact f_aux_deriv_zero n }, - { have : f_aux (n+1) x = (P_aux (n+1)).eval x * exp (-x⁻¹) / x^(2 * (n+1)), - by simp [f_aux, not_le_of_gt hx], - rw this, - exact f_aux_deriv_pos n x hx }, -end - -/-- The successive derivatives of the auxiliary function `f_aux 0` are the -functions `f_aux n`, by induction. -/ -lemma f_aux_iterated_deriv (n : ℕ) : iterated_deriv n (f_aux 0) = f_aux n := -begin - induction n with n IH, - { simp }, - { simp [iterated_deriv_succ, IH], - ext x, - exact (f_aux_has_deriv_at n x).deriv } -end - -/-- The function `exp_neg_inv_glue` is smooth. -/ -protected theorem cont_diff {n} : cont_diff ℝ n exp_neg_inv_glue := -begin - rw ← f_aux_zero_eq, - apply cont_diff_of_differentiable_iterated_deriv (λ m hm, _), - rw f_aux_iterated_deriv m, - exact λ x, (f_aux_has_deriv_at m x).differentiable_at -end - -/-- The function `exp_neg_inv_glue` vanishes on `(-∞, 0]`. -/ -lemma zero_of_nonpos {x : ℝ} (hx : x ≤ 0) : exp_neg_inv_glue x = 0 := -by simp [exp_neg_inv_glue, hx] - -/-- The function `exp_neg_inv_glue` is positive on `(0, +∞)`. -/ -lemma pos_of_pos {x : ℝ} (hx : 0 < x) : 0 < exp_neg_inv_glue x := -by simp [exp_neg_inv_glue, not_le.2 hx, exp_pos] - -/-- The function exp_neg_inv_glue` is nonnegative. -/ -lemma nonneg (x : ℝ) : 0 ≤ exp_neg_inv_glue x := -begin - cases le_or_gt x 0, - { exact ge_of_eq (zero_of_nonpos h) }, - { exact le_of_lt (pos_of_pos h) } -end - -end exp_neg_inv_glue - -/-- An infinitely smooth function `f : ℝ → ℝ` such that `f x = 0` for `x ≤ 0`, -`f x = 1` for `1 ≤ x`, and `0 < f x < 1` for `0 < x < 1`. -/ -def real.smooth_transition (x : ℝ) : ℝ := -exp_neg_inv_glue x / (exp_neg_inv_glue x + exp_neg_inv_glue (1 - x)) - -namespace real - -namespace smooth_transition - -variables {x : ℝ} - -open exp_neg_inv_glue - -lemma pos_denom (x) : 0 < exp_neg_inv_glue x + exp_neg_inv_glue (1 - x) := -((@zero_lt_one ℝ _ _).lt_or_lt x).elim - (λ hx, add_pos_of_pos_of_nonneg (pos_of_pos hx) (nonneg _)) - (λ hx, add_pos_of_nonneg_of_pos (nonneg _) (pos_of_pos $ sub_pos.2 hx)) - -lemma one_of_one_le (h : 1 ≤ x) : smooth_transition x = 1 := -(div_eq_one_iff_eq $ (pos_denom x).ne').2 $ by rw [zero_of_nonpos (sub_nonpos.2 h), add_zero] - -lemma zero_of_nonpos (h : x ≤ 0) : smooth_transition x = 0 := -by rw [smooth_transition, zero_of_nonpos h, zero_div] - -@[simp] protected lemma zero : smooth_transition 0 = 0 := -zero_of_nonpos le_rfl - -@[simp] protected lemma one : smooth_transition 1 = 1 := -one_of_one_le le_rfl - -lemma le_one (x : ℝ) : smooth_transition x ≤ 1 := -(div_le_one (pos_denom x)).2 $ le_add_of_nonneg_right (nonneg _) - -lemma nonneg (x : ℝ) : 0 ≤ smooth_transition x := -div_nonneg (exp_neg_inv_glue.nonneg _) (pos_denom x).le - -lemma lt_one_of_lt_one (h : x < 1) : smooth_transition x < 1 := -(div_lt_one $ pos_denom x).2 $ lt_add_of_pos_right _ $ pos_of_pos $ sub_pos.2 h - -lemma pos_of_pos (h : 0 < x) : 0 < smooth_transition x := -div_pos (exp_neg_inv_glue.pos_of_pos h) (pos_denom x) - -protected lemma cont_diff {n} : cont_diff ℝ n smooth_transition := -exp_neg_inv_glue.cont_diff.div - (exp_neg_inv_glue.cont_diff.add $ exp_neg_inv_glue.cont_diff.comp $ - cont_diff_const.sub cont_diff_id) $ - λ x, (pos_denom x).ne' - -protected lemma cont_diff_at {x n} : cont_diff_at ℝ n smooth_transition x := -smooth_transition.cont_diff.cont_diff_at - -protected lemma continuous : continuous smooth_transition := -(@smooth_transition.cont_diff 0).continuous - -end smooth_transition - -end real - -variables {E X : Type*} - -/-- `f : cont_diff_bump_of_inner c`, where `c` is a point in an inner product space, is a -bundled smooth function such that - -- `f` is equal to `1` in `metric.closed_ball c f.r`; -- `support f = metric.ball c f.R`; -- `0 ≤ f x ≤ 1` for all `x`. - -The structure `cont_diff_bump_of_inner` contains the data required to construct the function: -real numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through -`coe_fn`. -/ -structure cont_diff_bump_of_inner (c : E) := -(r R : ℝ) -(r_pos : 0 < r) -(r_lt_R : r < R) - -namespace cont_diff_bump_of_inner - -lemma R_pos {c : E} (f : cont_diff_bump_of_inner c) : 0 < f.R := f.r_pos.trans f.r_lt_R - -instance (c : E) : inhabited (cont_diff_bump_of_inner c) := ⟨⟨1, 2, zero_lt_one, one_lt_two⟩⟩ - -variables [inner_product_space ℝ E] [normed_group X] [normed_space ℝ X] -variables {c : E} (f : cont_diff_bump_of_inner c) {x : E} {n : with_top ℕ} - -/-- The function defined by `f : cont_diff_bump_of_inner c`. Use automatic coercion to -function instead. -/ -def to_fun (f : cont_diff_bump_of_inner c) : E → ℝ := -λ x, real.smooth_transition ((f.R - dist x c) / (f.R - f.r)) - -instance : has_coe_to_fun (cont_diff_bump_of_inner c) (λ _, E → ℝ) := ⟨to_fun⟩ - -protected lemma «def» (x : E) : f x = real.smooth_transition ((f.R - dist x c) / (f.R - f.r)) := -rfl - -protected lemma sub (x : E) : f (c - x) = f (c + x) := -by simp_rw [f.def, dist_self_sub_left, dist_self_add_left] - -protected lemma neg (f : cont_diff_bump_of_inner (0 : E)) (x : E) : f (- x) = f x := -by simp_rw [← zero_sub, f.sub, zero_add] - -open real (smooth_transition) real.smooth_transition metric - -lemma one_of_mem_closed_ball (hx : x ∈ closed_ball c f.r) : - f x = 1 := -one_of_one_le $ (one_le_div (sub_pos.2 f.r_lt_R)).2 $ sub_le_sub_left hx _ - -lemma nonneg : 0 ≤ f x := nonneg _ - -/-- A version of `cont_diff_bump_of_inner.nonneg` with `x` explicit -/ -lemma nonneg' (x : E) : 0 ≤ f x := -f.nonneg - -lemma le_one : f x ≤ 1 := le_one _ - -lemma pos_of_mem_ball (hx : x ∈ ball c f.R) : 0 < f x := -pos_of_pos $ div_pos (sub_pos.2 hx) (sub_pos.2 f.r_lt_R) - -lemma lt_one_of_lt_dist (h : f.r < dist x c) : f x < 1 := -lt_one_of_lt_one $ (div_lt_one (sub_pos.2 f.r_lt_R)).2 $ sub_lt_sub_left h _ - -lemma zero_of_le_dist (hx : f.R ≤ dist x c) : f x = 0 := -zero_of_nonpos $ div_nonpos_of_nonpos_of_nonneg (sub_nonpos.2 hx) (sub_nonneg.2 f.r_lt_R.le) - -lemma support_eq : support (f : E → ℝ) = metric.ball c f.R := -begin - ext x, - suffices : f x ≠ 0 ↔ dist x c < f.R, by simpa [mem_support], - cases lt_or_le (dist x c) f.R with hx hx, - { simp [hx, (f.pos_of_mem_ball hx).ne'] }, - { simp [hx.not_lt, f.zero_of_le_dist hx] } -end - -lemma tsupport_eq : tsupport f = closed_ball c f.R := -by simp_rw [tsupport, f.support_eq, closure_ball _ f.R_pos.ne'] - -protected lemma has_compact_support [finite_dimensional ℝ E] : has_compact_support f := -by simp_rw [has_compact_support, f.tsupport_eq, is_compact_closed_ball] - -lemma eventually_eq_one_of_mem_ball (h : x ∈ ball c f.r) : - f =ᶠ[𝓝 x] 1 := -((is_open_lt (continuous_id.dist continuous_const) continuous_const).eventually_mem h).mono $ - λ z hz, f.one_of_mem_closed_ball (le_of_lt hz) - -lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 := -f.eventually_eq_one_of_mem_ball (mem_ball_self f.r_pos) - -/-- `cont_diff_bump` is `𝒞ⁿ` in all its arguments. -/ -protected lemma _root_.cont_diff_at.cont_diff_bump {c g : X → E} - {f : ∀ x, cont_diff_bump_of_inner (c x)} {x : X} - (hc : cont_diff_at ℝ n c x) (hr : cont_diff_at ℝ n (λ x, (f x).r) x) - (hR : cont_diff_at ℝ n (λ x, (f x).R) x) - (hg : cont_diff_at ℝ n g x) : cont_diff_at ℝ n (λ x, f x (g x)) x := -begin - rcases eq_or_ne (g x) (c x) with hx|hx, - { have : (λ x, f x (g x)) =ᶠ[𝓝 x] (λ x, 1), - { have : dist (g x) (c x) < (f x).r, { simp_rw [hx, dist_self, (f x).r_pos] }, - have := continuous_at.eventually_lt (hg.continuous_at.dist hc.continuous_at) hr.continuous_at - this, - exact eventually_of_mem this - (λ x hx, (f x).one_of_mem_closed_ball (mem_set_of_eq.mp hx).le) }, - exact cont_diff_at_const.congr_of_eventually_eq this }, - { refine real.smooth_transition.cont_diff_at.comp x _, - refine ((hR.sub $ hg.dist hc hx).div (hR.sub hr) (sub_pos.mpr (f x).r_lt_R).ne') } -end - -lemma _root_.cont_diff.cont_diff_bump {c g : X → E} {f : ∀ x, cont_diff_bump_of_inner (c x)} - (hc : cont_diff ℝ n c) (hr : cont_diff ℝ n (λ x, (f x).r)) (hR : cont_diff ℝ n (λ x, (f x).R)) - (hg : cont_diff ℝ n g) : cont_diff ℝ n (λ x, f x (g x)) := -by { rw [cont_diff_iff_cont_diff_at] at *, exact λ x, (hc x).cont_diff_bump (hr x) (hR x) (hg x) } - -protected lemma cont_diff : cont_diff ℝ n f := -cont_diff_const.cont_diff_bump cont_diff_const cont_diff_const cont_diff_id - -protected lemma cont_diff_at : cont_diff_at ℝ n f x := -f.cont_diff.cont_diff_at - -protected lemma cont_diff_within_at {s : set E} : cont_diff_within_at ℝ n f s x := -f.cont_diff_at.cont_diff_within_at - -protected lemma continuous : continuous f := -cont_diff_zero.mp f.cont_diff - -open measure_theory -variables [measurable_space E] {μ : measure E} - -/-- A bump function normed so that `∫ x, f.normed μ x ∂μ = 1`. -/ -protected def normed (μ : measure E) : E → ℝ := -λ x, f x / ∫ x, f x ∂μ - -lemma normed_def {μ : measure E} (x : E) : f.normed μ x = f x / ∫ x, f x ∂μ := -rfl - -lemma nonneg_normed (x : E) : 0 ≤ f.normed μ x := -div_nonneg f.nonneg $ integral_nonneg f.nonneg' - -lemma cont_diff_normed {n : with_top ℕ} : cont_diff ℝ n (f.normed μ) := -f.cont_diff.div_const - -lemma continuous_normed : continuous (f.normed μ) := -f.continuous.div_const - -lemma normed_sub (x : E) : f.normed μ (c - x) = f.normed μ (c + x) := -by simp_rw [f.normed_def, f.sub] - -lemma normed_neg (f : cont_diff_bump_of_inner (0 : E)) (x : E) : f.normed μ (- x) = f.normed μ x := -by simp_rw [f.normed_def, f.neg] - -variables [borel_space E] [finite_dimensional ℝ E] [is_locally_finite_measure μ] - -protected lemma integrable : integrable f μ := -f.continuous.integrable_of_has_compact_support f.has_compact_support - -protected lemma integrable_normed : integrable (f.normed μ) μ := -f.integrable.div_const _ - -variables [μ .is_open_pos_measure] - -lemma integral_pos : 0 < ∫ x, f x ∂μ := -begin - refine (integral_pos_iff_support_of_nonneg f.nonneg' f.integrable).mpr _, - rw [f.support_eq], - refine is_open_ball.measure_pos _ (nonempty_ball.mpr f.R_pos) -end - -lemma integral_normed : ∫ x, f.normed μ x ∂μ = 1 := -begin - simp_rw [cont_diff_bump_of_inner.normed, div_eq_mul_inv, mul_comm (f _), ← smul_eq_mul, - integral_smul], - exact inv_mul_cancel (f.integral_pos.ne') -end - -lemma support_normed_eq : support (f.normed μ) = metric.ball c f.R := -by simp_rw [cont_diff_bump_of_inner.normed, support_div, f.support_eq, - support_const f.integral_pos.ne', inter_univ] - -lemma tsupport_normed_eq : tsupport (f.normed μ) = metric.closed_ball c f.R := -by simp_rw [tsupport, f.support_normed_eq, closure_ball _ f.R_pos.ne'] - -lemma has_compact_support_normed : has_compact_support (f.normed μ) := -by simp_rw [has_compact_support, f.tsupport_normed_eq, is_compact_closed_ball] - -variable (μ) -lemma integral_normed_smul (z : X) [complete_space X] : ∫ x, f.normed μ x • z ∂μ = z := -by simp_rw [integral_smul_const, f.integral_normed, one_smul] - -end cont_diff_bump_of_inner - -/-- `f : cont_diff_bump c`, where `c` is a point in a finite dimensional real vector space, is -a bundled smooth function such that - - - `f` is equal to `1` in `euclidean.closed_ball c f.r`; - - `support f = euclidean.ball c f.R`; - - `0 ≤ f x ≤ 1` for all `x`. - -The structure `cont_diff_bump` contains the data required to construct the function: real -numbers `r`, `R`, and proofs of `0 < r < R`. The function itself is available through `coe_fn`.-/ -structure cont_diff_bump [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] (c : E) - extends cont_diff_bump_of_inner (to_euclidean c) - -namespace cont_diff_bump - -variables [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {c x : E} - (f : cont_diff_bump c) - -/-- The function defined by `f : cont_diff_bump c`. Use automatic coercion to function -instead. -/ -def to_fun (f : cont_diff_bump c) : E → ℝ := f.to_cont_diff_bump_of_inner ∘ to_euclidean - -instance : has_coe_to_fun (cont_diff_bump c) (λ _, E → ℝ) := ⟨to_fun⟩ - -instance (c : E) : inhabited (cont_diff_bump c) := ⟨⟨default⟩⟩ - -lemma R_pos : 0 < f.R := f.to_cont_diff_bump_of_inner.R_pos - -lemma coe_eq_comp : ⇑f = f.to_cont_diff_bump_of_inner ∘ to_euclidean := rfl - -lemma one_of_mem_closed_ball (hx : x ∈ euclidean.closed_ball c f.r) : - f x = 1 := -f.to_cont_diff_bump_of_inner.one_of_mem_closed_ball hx - -lemma nonneg : 0 ≤ f x := f.to_cont_diff_bump_of_inner.nonneg - -lemma le_one : f x ≤ 1 := f.to_cont_diff_bump_of_inner.le_one - -lemma pos_of_mem_ball (hx : x ∈ euclidean.ball c f.R) : 0 < f x := -f.to_cont_diff_bump_of_inner.pos_of_mem_ball hx - -lemma lt_one_of_lt_dist (h : f.r < euclidean.dist x c) : f x < 1 := -f.to_cont_diff_bump_of_inner.lt_one_of_lt_dist h - -lemma zero_of_le_dist (hx : f.R ≤ euclidean.dist x c) : f x = 0 := -f.to_cont_diff_bump_of_inner.zero_of_le_dist hx - -lemma support_eq : support (f : E → ℝ) = euclidean.ball c f.R := -by rw [euclidean.ball_eq_preimage, ← f.to_cont_diff_bump_of_inner.support_eq, - ← support_comp_eq_preimage, coe_eq_comp] - -lemma tsupport_eq : tsupport f = euclidean.closed_ball c f.R := -by rw [tsupport, f.support_eq, euclidean.closure_ball _ f.R_pos.ne'] - -protected lemma has_compact_support : has_compact_support f := -by simp_rw [has_compact_support, f.tsupport_eq, euclidean.is_compact_closed_ball] - -lemma eventually_eq_one_of_mem_ball (h : x ∈ euclidean.ball c f.r) : - f =ᶠ[𝓝 x] 1 := -to_euclidean.continuous_at (f.to_cont_diff_bump_of_inner.eventually_eq_one_of_mem_ball h) - -lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 := -f.eventually_eq_one_of_mem_ball $ euclidean.mem_ball_self f.r_pos - -protected lemma cont_diff {n} : - cont_diff ℝ n f := -f.to_cont_diff_bump_of_inner.cont_diff.comp (to_euclidean : E ≃L[ℝ] _).cont_diff - -protected lemma cont_diff_at {n} : - cont_diff_at ℝ n f x := -f.cont_diff.cont_diff_at - -protected lemma cont_diff_within_at {s n} : - cont_diff_within_at ℝ n f s x := -f.cont_diff_at.cont_diff_within_at - -lemma exists_tsupport_subset {s : set E} (hs : s ∈ 𝓝 c) : - ∃ f : cont_diff_bump c, tsupport f ⊆ s := -let ⟨R, h0, hR⟩ := euclidean.nhds_basis_closed_ball.mem_iff.1 hs -in ⟨⟨⟨R / 2, R, half_pos h0, half_lt_self h0⟩⟩, by rwa tsupport_eq⟩ - -lemma exists_closure_subset {R : ℝ} (hR : 0 < R) - {s : set E} (hs : is_closed s) (hsR : s ⊆ euclidean.ball c R) : - ∃ f : cont_diff_bump c, f.R = R ∧ s ⊆ euclidean.ball c f.r := -begin - rcases euclidean.exists_pos_lt_subset_ball hR hs hsR with ⟨r, hr, hsr⟩, - exact ⟨⟨⟨r, R, hr.1, hr.2⟩⟩, rfl, hsr⟩ -end - -end cont_diff_bump - -open finite_dimensional metric - -/-- If `E` is a finite dimensional normed space over `ℝ`, then for any point `x : E` and its -neighborhood `s` there exists an infinitely smooth function with the following properties: - -* `f y = 1` in a neighborhood of `x`; -* `f y = 0` outside of `s`; -* moreover, `tsupport f ⊆ s` and `f` has compact support; -* `f y ∈ [0, 1]` for all `y`. - -This lemma is a simple wrapper around lemmas about bundled smooth bump functions, see -`cont_diff_bump`. -/ -lemma exists_cont_diff_bump_function_of_mem_nhds [normed_group E] [normed_space ℝ E] - [finite_dimensional ℝ E] {x : E} {s : set E} (hs : s ∈ 𝓝 x) : - ∃ f : E → ℝ, f =ᶠ[𝓝 x] 1 ∧ (∀ y, f y ∈ Icc (0 : ℝ) 1) ∧ cont_diff ℝ ⊤ f ∧ - has_compact_support f ∧ tsupport f ⊆ s := -let ⟨f, hf⟩ := cont_diff_bump.exists_tsupport_subset hs in -⟨f, f.eventually_eq_one, λ y, ⟨f.nonneg, f.le_one⟩, f.cont_diff, - f.has_compact_support, hf⟩ diff --git a/src/analysis/calculus/tangent_cone.lean b/src/analysis/calculus/tangent_cone.lean index 020647baa8a8e..3759c2c22d93a 100644 --- a/src/analysis/calculus/tangent_cone.lean +++ b/src/analysis/calculus/tangent_cone.lean @@ -3,13 +3,16 @@ Copyright (c) 2019 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ -import analysis.convex.basic +import analysis.convex.topology import analysis.normed_space.basic import analysis.specific_limits.basic /-! # Tangent cone +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define two predicates `unique_diff_within_at 𝕜 s x` and `unique_diff_on 𝕜 s` ensuring that, if a function has two derivatives, then they have to coincide. As a direct definition of this fact (quantifying on all target types and all functions) would depend on @@ -30,10 +33,10 @@ property of uniqueness of the derivative is therefore proved in `fderiv.lean`, b properties of the tangent cone we prove here. -/ -variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜] +variables (𝕜 : Type*) [nontrivially_normed_field 𝕜] open filter set -open_locale topological_space +open_locale topology section tangent_cone @@ -42,7 +45,7 @@ variables {E : Type*} [add_comm_monoid E] [module 𝕜 E] [topological_space E] /-- The set of all tangent directions to the set `s` at the point `x`. -/ def tangent_cone_at (s : set E) (x : E) : set E := {y : E | ∃(c : ℕ → 𝕜) (d : ℕ → E), (∀ᶠ n in at_top, x + d n ∈ s) ∧ - (tendsto (λn, ∥c n∥) at_top at_top) ∧ (tendsto (λn, c n • d n) at_top (𝓝 y))} + (tendsto (λn, ‖c n‖) at_top at_top) ∧ (tendsto (λn, c n • d n) at_top (𝓝 y))} /-- A property ensuring that the tangent cone to `s` at `x` spans a dense subset of the whole space. The main role of this property is to ensure that the differential within `s` at `x` is unique, @@ -63,9 +66,9 @@ def unique_diff_on (s : set E) : Prop := end tangent_cone -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] -variables {F : Type*} [normed_group F] [normed_space 𝕜 F] -variables {G : Type*} [normed_group G] [normed_space ℝ G] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] +variables {G : Type*} [normed_add_comm_group G] [normed_space ℝ G] variables {𝕜} {x y : E} {s t : set E} section tangent_cone @@ -99,19 +102,19 @@ end /-- Auxiliary lemma ensuring that, under the assumptions defining the tangent cone, the sequence `d` tends to 0 at infinity. -/ lemma tangent_cone_at.lim_zero {α : Type*} (l : filter α) {c : α → 𝕜} {d : α → E} - (hc : tendsto (λn, ∥c n∥) l at_top) (hd : tendsto (λn, c n • d n) l (𝓝 y)) : + (hc : tendsto (λn, ‖c n‖) l at_top) (hd : tendsto (λn, c n • d n) l (𝓝 y)) : tendsto d l (𝓝 0) := begin - have A : tendsto (λn, ∥c n∥⁻¹) l (𝓝 0) := tendsto_inv_at_top_zero.comp hc, - have B : tendsto (λn, ∥c n • d n∥) l (𝓝 ∥y∥) := + have A : tendsto (λn, ‖c n‖⁻¹) l (𝓝 0) := tendsto_inv_at_top_zero.comp hc, + have B : tendsto (λn, ‖c n • d n‖) l (𝓝 ‖y‖) := (continuous_norm.tendsto _).comp hd, - have C : tendsto (λn, ∥c n∥⁻¹ * ∥c n • d n∥) l (𝓝 (0 * ∥y∥)) := A.mul B, + have C : tendsto (λn, ‖c n‖⁻¹ * ‖c n • d n‖) l (𝓝 (0 * ‖y‖)) := A.mul B, rw zero_mul at C, - have : ∀ᶠ n in l, ∥c n∥⁻¹ * ∥c n • d n∥ = ∥d n∥, + have : ∀ᶠ n in l, ‖c n‖⁻¹ * ‖c n • d n‖ = ‖d n‖, { apply (eventually_ne_of_tendsto_norm_at_top hc 0).mono (λn hn, _), rw [norm_smul, ← mul_assoc, inv_mul_cancel, one_mul], rwa [ne.def, norm_eq_zero] }, - have D : tendsto (λ n, ∥d n∥) l (𝓝 0) := + have D : tendsto (λ n, ‖d n‖) l (𝓝 0) := tendsto.congr' this C, rw tendsto_zero_iff_norm_tendsto_zero, exact D @@ -145,7 +148,7 @@ lemma subset_tangent_cone_prod_left {t : set F} {y : F} (ht : y ∈ closure t) : linear_map.inl 𝕜 E F '' (tangent_cone_at 𝕜 s x) ⊆ tangent_cone_at 𝕜 (s ×ˢ t) (x, y) := begin rintros _ ⟨v, ⟨c, d, hd, hc, hy⟩, rfl⟩, - have : ∀n, ∃d', y + d' ∈ t ∧ ∥c n • d'∥ < ((1:ℝ)/2)^n, + have : ∀n, ∃d', y + d' ∈ t ∧ ‖c n • d'‖ < ((1:ℝ)/2)^n, { assume n, rcases mem_closure_iff_nhds.1 ht _ (eventually_nhds_norm_smul_sub_lt (c n) y (pow_pos one_half_pos n)) with ⟨z, hz, hzt⟩, @@ -166,7 +169,7 @@ lemma subset_tangent_cone_prod_right {t : set F} {y : F} linear_map.inr 𝕜 E F '' (tangent_cone_at 𝕜 t y) ⊆ tangent_cone_at 𝕜 (s ×ˢ t) (x, y) := begin rintros _ ⟨w, ⟨c, d, hd, hc, hy⟩, rfl⟩, - have : ∀n, ∃d', x + d' ∈ s ∧ ∥c n • d'∥ < ((1:ℝ)/2)^n, + have : ∀n, ∃d', x + d' ∈ s ∧ ‖c n • d'‖ < ((1:ℝ)/2)^n, { assume n, rcases mem_closure_iff_nhds.1 hs _ (eventually_nhds_norm_smul_sub_lt (c n) x (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩, @@ -183,13 +186,13 @@ end /-- The tangent cone of a product contains the tangent cone of each factor. -/ lemma maps_to_tangent_cone_pi {ι : Type*} [decidable_eq ι] {E : ι → Type*} - [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] + [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] {s : Π i, set (E i)} {x : Π i, E i} {i : ι} (hi : ∀ j ≠ i, x j ∈ closure (s j)) : maps_to (linear_map.single i : E i →ₗ[𝕜] Π j, E j) (tangent_cone_at 𝕜 (s i) (x i)) (tangent_cone_at 𝕜 (set.pi univ s) x) := begin rintros w ⟨c, d, hd, hc, hy⟩, - have : ∀ n (j ≠ i), ∃ d', x j + d' ∈ s j ∧ ∥c n • d'∥ < (1 / 2 : ℝ) ^ n, + have : ∀ n (j ≠ i), ∃ d', x j + d' ∈ s j ∧ ‖c n • d'‖ < (1 / 2 : ℝ) ^ n, { assume n j hj, rcases mem_closure_iff_nhds.1 (hi j hj) _ (eventually_nhds_norm_smul_sub_lt (c n) (x j) (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩, @@ -205,25 +208,25 @@ begin exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one } } end -/-- If a subset of a real vector space contains a segment, then the direction of this +/-- If a subset of a real vector space contains an open segment, then the direction of this segment belongs to the tangent cone at its endpoints. -/ -lemma mem_tangent_cone_of_segment_subset {s : set G} {x y : G} (h : segment ℝ x y ⊆ s) : +lemma mem_tangent_cone_of_open_segment_subset {s : set G} {x y : G} (h : open_segment ℝ x y ⊆ s) : y - x ∈ tangent_cone_at ℝ s x := begin - let c := λn:ℕ, (2:ℝ)^n, + let c := λn:ℕ, (2:ℝ)^(n+1), let d := λn:ℕ, (c n)⁻¹ • (y-x), refine ⟨c, d, filter.univ_mem' (λn, h _), _, _⟩, - show x + d n ∈ segment ℝ x y, - { rw segment_eq_image, + show x + d n ∈ open_segment ℝ x y, + { rw open_segment_eq_image, refine ⟨(c n)⁻¹, ⟨_, _⟩, _⟩, - { rw inv_nonneg, apply pow_nonneg, norm_num }, - { apply inv_le_one, apply one_le_pow_of_one_le, norm_num }, + { rw inv_pos, apply pow_pos, norm_num }, + { apply inv_lt_one, apply one_lt_pow _ (nat.succ_ne_zero _), norm_num }, { simp only [d, sub_smul, smul_sub, one_smul], abel } }, - show filter.tendsto (λ (n : ℕ), ∥c n∥) filter.at_top filter.at_top, - { have : (λ (n : ℕ), ∥c n∥) = c, + show filter.tendsto (λ (n : ℕ), ‖c n‖) filter.at_top filter.at_top, + { have : (λ (n : ℕ), ‖c n‖) = c, by { ext n, exact abs_of_nonneg (pow_nonneg (by norm_num) _) }, rw this, - exact tendsto_pow_at_top_at_top_of_one_lt (by norm_num) }, + exact (tendsto_pow_at_top_at_top_of_one_lt (by norm_num)).comp (tendsto_add_at_top_nat 1) }, show filter.tendsto (λ (n : ℕ), c n • d n) filter.at_top (𝓝 (y - x)), { have : (λ (n : ℕ), c n • d n) = (λn, y - x), { ext n, @@ -234,6 +237,12 @@ begin apply tendsto_const_nhds } end +/-- If a subset of a real vector space contains a segment, then the direction of this +segment belongs to the tangent cone at its endpoints. -/ +lemma mem_tangent_cone_of_segment_subset {s : set G} {x y : G} (h : segment ℝ x y ⊆ s) : + y - x ∈ tangent_cone_at ℝ s x := +mem_tangent_cone_of_open_segment_subset ((open_segment_subset_segment ℝ x y).trans h) + end tangent_cone section unique_diff @@ -318,8 +327,8 @@ begin exact (hs.1.prod ht.1).mono this end -lemma unique_diff_within_at.univ_pi (ι : Type*) [fintype ι] (E : ι → Type*) - [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] +lemma unique_diff_within_at.univ_pi (ι : Type*) [finite ι] (E : ι → Type*) + [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] (s : Π i, set (E i)) (x : Π i, E i) (h : ∀ i, unique_diff_within_at 𝕜 (s i) (x i)) : unique_diff_within_at 𝕜 (set.pi univ s) x := begin @@ -332,8 +341,8 @@ begin exact λ i, (maps_to_tangent_cone_pi $ λ j hj, (h j).2).mono subset.rfl submodule.subset_span end -lemma unique_diff_within_at.pi (ι : Type*) [fintype ι] (E : ι → Type*) - [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] +lemma unique_diff_within_at.pi (ι : Type*) [finite ι] (E : ι → Type*) + [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] (s : Π i, set (E i)) (x : Π i, E i) (I : set ι) (h : ∀ i ∈ I, unique_diff_within_at 𝕜 (s i) (x i)) : unique_diff_within_at 𝕜 (set.pi I s) x := @@ -351,37 +360,44 @@ lemma unique_diff_on.prod {t : set F} (hs : unique_diff_on 𝕜 s) (ht : unique_ /-- The finite product of a family of sets of unique differentiability is a set of unique differentiability. -/ -lemma unique_diff_on.pi (ι : Type*) [fintype ι] (E : ι → Type*) - [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] +lemma unique_diff_on.pi (ι : Type*) [finite ι] (E : ι → Type*) + [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] (s : Π i, set (E i)) (I : set ι) (h : ∀ i ∈ I, unique_diff_on 𝕜 (s i)) : unique_diff_on 𝕜 (set.pi I s) := λ x hx, unique_diff_within_at.pi _ _ _ _ _ $ λ i hi, h i hi (x i) (hx i hi) /-- The finite product of a family of sets of unique differentiability is a set of unique differentiability. -/ -lemma unique_diff_on.univ_pi (ι : Type*) [fintype ι] (E : ι → Type*) - [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] +lemma unique_diff_on.univ_pi (ι : Type*) [finite ι] (E : ι → Type*) + [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] (s : Π i, set (E i)) (h : ∀ i, unique_diff_on 𝕜 (s i)) : unique_diff_on 𝕜 (set.pi univ s) := unique_diff_on.pi _ _ _ _ $ λ i _, h i /-- In a real vector space, a convex set with nonempty interior is a set of unique -differentiability. -/ -theorem unique_diff_on_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty) : - unique_diff_on ℝ s := +differentiability at every point of its closure. -/ +theorem unique_diff_within_at_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty) + {x : G} (hx : x ∈ closure s) : unique_diff_within_at ℝ s x := begin - assume x xs, rcases hs with ⟨y, hy⟩, suffices : y - x ∈ interior (tangent_cone_at ℝ s x), - { refine ⟨dense.of_closure _, subset_closure xs⟩, + { refine ⟨dense.of_closure _, hx⟩, simp [(submodule.span ℝ (tangent_cone_at ℝ s x)).eq_top_of_nonempty_interior' ⟨y - x, interior_mono submodule.subset_span this⟩] }, - rw [mem_interior_iff_mem_nhds] at hy ⊢, + rw [mem_interior_iff_mem_nhds], + replace hy : interior s ∈ 𝓝 y := is_open.mem_nhds is_open_interior hy, apply mem_of_superset ((is_open_map_sub_right x).image_mem_nhds hy), rintros _ ⟨z, zs, rfl⟩, - exact mem_tangent_cone_of_segment_subset (conv.segment_subset xs zs) + refine mem_tangent_cone_of_open_segment_subset (subset.trans _ interior_subset), + exact conv.open_segment_closure_interior_subset_interior hx zs, end +/-- In a real vector space, a convex set with nonempty interior is a set of unique +differentiability. -/ +theorem unique_diff_on_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty) : + unique_diff_on ℝ s := +λ x xs, unique_diff_within_at_convex conv hs (subset_closure xs) + lemma unique_diff_on_Ici (a : ℝ) : unique_diff_on ℝ (Ici a) := unique_diff_on_convex (convex_Ici a) $ by simp only [interior_Ici, nonempty_Ioi] @@ -414,4 +430,14 @@ is_open_Ioo.unique_diff_on lemma unique_diff_on_Icc_zero_one : unique_diff_on ℝ (Icc (0:ℝ) 1) := unique_diff_on_Icc zero_lt_one +lemma unique_diff_within_at_Ioo {a b t : ℝ} (ht : t ∈ set.Ioo a b) : + unique_diff_within_at ℝ (set.Ioo a b) t := +is_open.unique_diff_within_at is_open_Ioo ht + +lemma unique_diff_within_at_Ioi (a : ℝ) : unique_diff_within_at ℝ (Ioi a) a := +unique_diff_within_at_convex (convex_Ioi a) (by simp) (by simp) + +lemma unique_diff_within_at_Iio (a : ℝ) : unique_diff_within_at ℝ (Iio a) a := +unique_diff_within_at_convex (convex_Iio a) (by simp) (by simp) + end unique_diff diff --git a/src/analysis/calculus/taylor.lean b/src/analysis/calculus/taylor.lean new file mode 100644 index 0000000000000..f7040ff75e28c --- /dev/null +++ b/src/analysis/calculus/taylor.lean @@ -0,0 +1,393 @@ +/- +Copyright (c) 2022 Moritz Doll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll +-/ +import analysis.calculus.iterated_deriv +import analysis.calculus.mean_value +import data.polynomial.module + +/-! +# Taylor's theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the Taylor polynomial of a real function `f : ℝ → E`, +where `E` is a normed vector space over `ℝ` and proves Taylor's theorem, +which states that if `f` is sufficiently smooth, then +`f` can be approximated by the Taylor polynomial up to an explicit error term. + +## Main definitions + +* `taylor_coeff_within`: the Taylor coefficient using `deriv_within` +* `taylor_within`: the Taylor polynomial using `deriv_within` + +## Main statements + +* `taylor_mean_remainder`: Taylor's theorem with the general form of the remainder term +* `taylor_mean_remainder_lagrange`: Taylor's theorem with the Lagrange remainder +* `taylor_mean_remainder_cauchy`: Taylor's theorem with the Cauchy remainder +* `exists_taylor_mean_remainder_bound`: Taylor's theorem for vector valued functions with a +polynomial bound on the remainder + +## TODO + +* the Peano form of the remainder +* the integral form of the remainder +* Generalization to higher dimensions + +## Tags + +Taylor polynomial, Taylor's theorem +-/ + + +open_locale big_operators interval topology nat +open set + +variables {𝕜 E F : Type*} +variables [normed_add_comm_group E] [normed_space ℝ E] + +/-- The `k`th coefficient of the Taylor polynomial. -/ +noncomputable +def taylor_coeff_within (f : ℝ → E) (k : ℕ) (s : set ℝ) (x₀ : ℝ) : E := +(k! : ℝ)⁻¹ • (iterated_deriv_within k f s x₀) + +/-- The Taylor polynomial with derivatives inside of a set `s`. + +The Taylor polynomial is given by +$$∑_{k=0}^n \frac{(x - x₀)^k}{k!} f^{(k)}(x₀),$$ +where $f^{(k)}(x₀)$ denotes the iterated derivative in the set `s`. -/ +noncomputable +def taylor_within (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ : ℝ) : polynomial_module ℝ E := +(finset.range (n+1)).sum (λ k, + polynomial_module.comp (polynomial.X - polynomial.C x₀) + (polynomial_module.single ℝ k (taylor_coeff_within f k s x₀))) + +/-- The Taylor polynomial with derivatives inside of a set `s` considered as a function `ℝ → E`-/ +noncomputable +def taylor_within_eval (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ x : ℝ) : E := +polynomial_module.eval x (taylor_within f n s x₀) + +lemma taylor_within_succ (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ : ℝ) : + taylor_within f (n+1) s x₀ = taylor_within f n s x₀ + + polynomial_module.comp (polynomial.X - polynomial.C x₀) + (polynomial_module.single ℝ (n+1) (taylor_coeff_within f (n+1) s x₀)) := +begin + dunfold taylor_within, + rw finset.sum_range_succ, +end + +@[simp] lemma taylor_within_eval_succ (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ x : ℝ) : + taylor_within_eval f (n+1) s x₀ x = taylor_within_eval f n s x₀ x + + (((n + 1 : ℝ) * n!)⁻¹ * (x - x₀)^(n+1)) • iterated_deriv_within (n + 1) f s x₀ := +begin + simp_rw [taylor_within_eval, taylor_within_succ, linear_map.map_add, polynomial_module.comp_eval], + congr, + simp only [polynomial.eval_sub, polynomial.eval_X, polynomial.eval_C, + polynomial_module.eval_single, mul_inv_rev], + dunfold taylor_coeff_within, + rw [←mul_smul, mul_comm, nat.factorial_succ, nat.cast_mul, nat.cast_add, nat.cast_one, + mul_inv_rev], +end + +/-- The Taylor polynomial of order zero evaluates to `f x`. -/ +@[simp] lemma taylor_within_zero_eval (f : ℝ → E) (s : set ℝ) (x₀ x : ℝ) : + taylor_within_eval f 0 s x₀ x = f x₀ := +begin + dunfold taylor_within_eval, + dunfold taylor_within, + dunfold taylor_coeff_within, + simp, +end + +/-- Evaluating the Taylor polynomial at `x = x₀` yields `f x`. -/ +@[simp] lemma taylor_within_eval_self (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ : ℝ) : + taylor_within_eval f n s x₀ x₀ = f x₀ := +begin + induction n with k hk, + { exact taylor_within_zero_eval _ _ _ _}, + simp [hk] +end + +lemma taylor_within_apply (f : ℝ → E) (n : ℕ) (s : set ℝ) (x₀ x : ℝ) : + taylor_within_eval f n s x₀ x = ∑ k in finset.range (n+1), + ((k! : ℝ)⁻¹ * (x - x₀)^k) • iterated_deriv_within k f s x₀ := +begin + induction n with k hk, + { simp }, + rw [taylor_within_eval_succ, finset.sum_range_succ, hk], + simp, +end + +/-- If `f` is `n` times continuous differentiable on a set `s`, then the Taylor polynomial + `taylor_within_eval f n s x₀ x` is continuous in `x₀`. -/ +lemma continuous_on_taylor_within_eval {f : ℝ → E} {x : ℝ} {n : ℕ} {s : set ℝ} + (hs : unique_diff_on ℝ s) (hf : cont_diff_on ℝ n f s) : + continuous_on (λ t, taylor_within_eval f n s t x) s := +begin + simp_rw taylor_within_apply, + refine continuous_on_finset_sum (finset.range (n+1)) (λ i hi, _), + refine (continuous_on_const.mul ((continuous_on_const.sub continuous_on_id).pow _)).smul _, + rw cont_diff_on_iff_continuous_on_differentiable_on_deriv hs at hf, + cases hf, + specialize hf_left i, + simp only [finset.mem_range] at hi, + refine (hf_left _), + simp only [with_top.coe_le_coe], + exact nat.lt_succ_iff.mp hi, +end + +/-- Helper lemma for calculating the derivative of the monomial that appears in Taylor expansions.-/ +lemma monomial_has_deriv_aux (t x : ℝ) (n : ℕ) : + has_deriv_at (λ y, (x - y)^(n+1)) (-(n+1) * (x - t)^n) t := +begin + simp_rw sub_eq_neg_add, + rw [←neg_one_mul, mul_comm (-1 : ℝ), mul_assoc, mul_comm (-1 : ℝ), ←mul_assoc], + convert @has_deriv_at.pow _ _ _ _ _ (n+1) ((has_deriv_at_id t).neg.add_const x), + simp only [nat.cast_add, nat.cast_one], +end + +lemma has_deriv_within_at_taylor_coeff_within {f : ℝ → E} {x y : ℝ} {k : ℕ} {s t : set ℝ} + (ht : unique_diff_within_at ℝ t y) (hs : s ∈ 𝓝[t] y) + (hf : differentiable_within_at ℝ (iterated_deriv_within (k+1) f s) s y) : + has_deriv_within_at (λ z, + (((k+1 : ℝ) * k!)⁻¹ * (x - z)^(k+1)) • iterated_deriv_within (k+1) f s z) + ((((k+1 : ℝ) * k!)⁻¹ * (x - y)^(k+1)) • iterated_deriv_within (k+2) f s y - + ((k! : ℝ)⁻¹ * (x - y)^k) • iterated_deriv_within (k+1) f s y) t y := +begin + replace hf : has_deriv_within_at (iterated_deriv_within (k+1) f s) + (iterated_deriv_within (k+2) f s y) t y := + begin + convert (hf.mono_of_mem hs).has_deriv_within_at, + rw iterated_deriv_within_succ (ht.mono_nhds (nhds_within_le_iff.mpr hs)), + exact (deriv_within_of_mem hs ht hf).symm + end, + have : has_deriv_within_at (λ t, (((k+1 : ℝ) * k!)⁻¹ * (x - t)^(k+1))) + (-((k! : ℝ)⁻¹ * (x - y)^k)) t y, + { -- Commuting the factors: + have : (-((k! : ℝ)⁻¹ * (x - y)^k)) = (((k+1 : ℝ) * k!)⁻¹ * (-(k+1) *(x - y)^k)), + { field_simp [nat.cast_add_one_ne_zero k, nat.factorial_ne_zero k], ring_nf }, + rw this, + exact (monomial_has_deriv_aux y x _).has_deriv_within_at.const_mul _ }, + convert this.smul hf, + field_simp [nat.cast_add_one_ne_zero k, nat.factorial_ne_zero k], + rw [neg_div, neg_smul, sub_eq_add_neg], +end + +/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`. + +Version for arbitrary sets -/ +lemma has_deriv_within_at_taylor_within_eval {f : ℝ → E} {x y : ℝ} {n : ℕ} {s s' : set ℝ} + (hs'_unique : unique_diff_within_at ℝ s' y) (hs_unique : unique_diff_on ℝ s) + (hs' : s' ∈ 𝓝[s] y) (hy : y ∈ s') (h : s' ⊆ s) + (hf : cont_diff_on ℝ n f s) + (hf' : differentiable_within_at ℝ (iterated_deriv_within n f s) s y) : + has_deriv_within_at (λ t, taylor_within_eval f n s t x) + (((n! : ℝ)⁻¹ * (x - y)^n) • (iterated_deriv_within (n+1) f s y)) s' y := +begin + induction n with k hk, + { simp only [taylor_within_zero_eval, nat.factorial_zero, nat.cast_one, inv_one, pow_zero, + mul_one, zero_add, one_smul], + simp only [iterated_deriv_within_zero] at hf', + rw iterated_deriv_within_one (hs_unique _ (h hy)), + exact hf'.has_deriv_within_at.mono h }, + simp_rw [nat.add_succ, taylor_within_eval_succ], + simp only [add_zero, nat.factorial_succ, nat.cast_mul, nat.cast_add, nat.cast_one], + have hdiff : differentiable_on ℝ (iterated_deriv_within k f s) s', + { have coe_lt_succ : (k : with_top ℕ) < k.succ := nat.cast_lt.2 k.lt_succ_self, + refine differentiable_on.mono _ h, + exact hf.differentiable_on_iterated_deriv_within coe_lt_succ hs_unique }, + specialize hk hf.of_succ ((hdiff y hy).mono_of_mem hs'), + convert hk.add (has_deriv_within_at_taylor_coeff_within hs'_unique + (nhds_within_mono _ h self_mem_nhds_within) hf'), + exact (add_sub_cancel'_right _ _).symm +end + +/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`. + +Version for open intervals -/ +lemma taylor_within_eval_has_deriv_at_Ioo {f : ℝ → E} {a b t : ℝ} (x : ℝ) {n : ℕ} + (hx : a < b) (ht : t ∈ Ioo a b) + (hf : cont_diff_on ℝ n f (Icc a b)) + (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc a b)) (Ioo a b)) : + has_deriv_at (λ y, taylor_within_eval f n (Icc a b) y x) + (((n! : ℝ)⁻¹ * (x - t)^n) • (iterated_deriv_within (n+1) f (Icc a b) t)) t := +have h_nhds : Ioo a b ∈ 𝓝 t := is_open_Ioo.mem_nhds ht, +have h_nhds' : Ioo a b ∈ 𝓝[Icc a b] t := nhds_within_le_nhds h_nhds, +(has_deriv_within_at_taylor_within_eval (unique_diff_within_at_Ioo ht) (unique_diff_on_Icc hx) + h_nhds' ht Ioo_subset_Icc_self hf $ (hf' t ht).mono_of_mem h_nhds').has_deriv_at h_nhds + +/-- Calculate the derivative of the Taylor polynomial with respect to `x₀`. + +Version for closed intervals -/ +lemma has_deriv_within_taylor_within_eval_at_Icc {f : ℝ → E} {a b t : ℝ} (x : ℝ) {n : ℕ} + (hx : a < b) (ht : t ∈ Icc a b) (hf : cont_diff_on ℝ n f (Icc a b)) + (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc a b)) (Icc a b)) : + has_deriv_within_at (λ y, taylor_within_eval f n (Icc a b) y x) + (((n! : ℝ)⁻¹ * (x - t)^n) • (iterated_deriv_within (n+1) f (Icc a b) t)) (Icc a b) t := +has_deriv_within_at_taylor_within_eval (unique_diff_on_Icc hx t ht) (unique_diff_on_Icc hx) + self_mem_nhds_within ht rfl.subset hf (hf' t ht) + +/-! ### Taylor's theorem with mean value type remainder estimate -/ + +/-- **Taylor's theorem** with the general mean value form of the remainder. + +We assume that `f` is `n+1`-times continuously differentiable in the closed set `Icc x₀ x` and +`n+1`-times differentiable on the open set `Ioo x₀ x`, and `g` is a differentiable function on +`Ioo x₀ x` and continuous on `Icc x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that +$$f(x) - (P_n f)(x₀, x) = \frac{(x - x')^n}{n!} \frac{g(x) - g(x₀)}{g' x'},$$ +where $P_n f$ denotes the Taylor polynomial of degree $n$. -/ +lemma taylor_mean_remainder {f : ℝ → ℝ} {g g' : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x) + (hf : cont_diff_on ℝ n f (Icc x₀ x)) + (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc x₀ x)) (Ioo x₀ x)) + (gcont : continuous_on g (Icc x₀ x)) + (gdiff : ∀ (x_1 : ℝ), x_1 ∈ Ioo x₀ x → has_deriv_at g (g' x_1) x_1) + (g'_ne : ∀ (x_1 : ℝ), x_1 ∈ Ioo x₀ x → g' x_1 ≠ 0) : + ∃ (x' : ℝ) (hx' : x' ∈ Ioo x₀ x), f x - taylor_within_eval f n (Icc x₀ x) x₀ x = + ((x - x')^n /n! * (g x - g x₀) / g' x') • + (iterated_deriv_within (n+1) f (Icc x₀ x) x') + := +begin + -- We apply the mean value theorem + rcases exists_ratio_has_deriv_at_eq_ratio_slope (λ t, taylor_within_eval f n (Icc x₀ x) t x) + (λ t, ((n! : ℝ)⁻¹ * (x - t)^n) • (iterated_deriv_within (n+1) f (Icc x₀ x) t)) hx + (continuous_on_taylor_within_eval (unique_diff_on_Icc hx) hf) + (λ _ hy, taylor_within_eval_has_deriv_at_Ioo x hx hy hf hf') + g g' gcont gdiff with ⟨y, hy, h⟩, + use [y, hy], + -- The rest is simplifications and trivial calculations + simp only [taylor_within_eval_self] at h, + rw [mul_comm, ←div_left_inj' (g'_ne y hy), mul_div_cancel _ (g'_ne y hy)] at h, + rw ←h, + field_simp [g'_ne y hy, n.factorial_ne_zero], + ring, +end + +/-- **Taylor's theorem** with the Lagrange form of the remainder. + +We assume that `f` is `n+1`-times continuously differentiable in the closed set `Icc x₀ x` and +`n+1`-times differentiable on the open set `Ioo x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that +$$f(x) - (P_n f)(x₀, x) = \frac{f^{(n+1)}(x') (x - x₀)^{n+1}}{(n+1)!},$$ +where $P_n f$ denotes the Taylor polynomial of degree $n$ and $f^{(n+1)}$ is the $n+1$-th iterated +derivative. -/ +lemma taylor_mean_remainder_lagrange {f : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x) + (hf : cont_diff_on ℝ n f (Icc x₀ x)) + (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc x₀ x)) (Ioo x₀ x)) : + ∃ (x' : ℝ) (hx' : x' ∈ Ioo x₀ x), f x - taylor_within_eval f n (Icc x₀ x) x₀ x = + (iterated_deriv_within (n+1) f (Icc x₀ x) x') * (x - x₀)^(n+1) /(n+1)! := +begin + have gcont : continuous_on (λ (t : ℝ), (x - t) ^ (n + 1)) (Icc x₀ x) := + by { refine continuous.continuous_on _, continuity }, + have xy_ne : ∀ (y : ℝ), y ∈ Ioo x₀ x → (x - y)^n ≠ 0 := + begin + intros y hy, + refine pow_ne_zero _ _, + rw [mem_Ioo] at hy, + rw sub_ne_zero, + exact hy.2.ne.symm, + end, + have hg' : ∀ (y : ℝ), y ∈ Ioo x₀ x → -(↑n + 1) * (x - y) ^ n ≠ 0 := + λ y hy, mul_ne_zero (neg_ne_zero.mpr (nat.cast_add_one_ne_zero n)) (xy_ne y hy), + -- We apply the general theorem with g(t) = (x - t)^(n+1) + rcases taylor_mean_remainder hx hf hf' gcont (λ y _, monomial_has_deriv_aux y x _) hg' + with ⟨y, hy, h⟩, + use [y, hy], + simp only [sub_self, zero_pow', ne.def, nat.succ_ne_zero, not_false_iff, zero_sub, mul_neg] at h, + rw [h, neg_div, ←div_neg, neg_mul, neg_neg], + field_simp [n.cast_add_one_ne_zero, n.factorial_ne_zero, xy_ne y hy], + ring, +end + +/-- **Taylor's theorem** with the Cauchy form of the remainder. + +We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc x₀ x` and +`n+1`-times differentiable on the open set `Ioo x₀ x`. Then there exists a `x' ∈ Ioo x₀ x` such that +$$f(x) - (P_n f)(x₀, x) = \frac{f^{(n+1)}(x') (x - x')^n (x-x₀)}{n!},$$ +where $P_n f$ denotes the Taylor polynomial of degree $n$ and $f^{(n+1)}$ is the $n+1$-th iterated +derivative. -/ +lemma taylor_mean_remainder_cauchy {f : ℝ → ℝ} {x x₀ : ℝ} {n : ℕ} (hx : x₀ < x) + (hf : cont_diff_on ℝ n f (Icc x₀ x)) + (hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc x₀ x)) (Ioo x₀ x)) : + ∃ (x' : ℝ) (hx' : x' ∈ Ioo x₀ x), f x - taylor_within_eval f n (Icc x₀ x) x₀ x = + (iterated_deriv_within (n+1) f (Icc x₀ x) x') * (x - x')^n /n! * (x - x₀) := +begin + have gcont : continuous_on id (Icc x₀ x) := continuous.continuous_on (by continuity), + have gdiff : (∀ (x_1 : ℝ), x_1 ∈ Ioo x₀ x → has_deriv_at id + ((λ (t : ℝ), (1 : ℝ)) x_1) x_1) := λ _ _, has_deriv_at_id _, + -- We apply the general theorem with g = id + rcases taylor_mean_remainder hx hf hf' gcont gdiff (λ _ _, by simp) with ⟨y, hy, h⟩, + use [y, hy], + rw h, + field_simp [n.factorial_ne_zero], + ring, +end + +/-- **Taylor's theorem** with a polynomial bound on the remainder + +We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc a b`. +The difference of `f` and its `n`-th Taylor polynomial can be estimated by +`C * (x - a)^(n+1) / n!` where `C` is a bound for the `n+1`-th iterated derivative of `f`. -/ +lemma taylor_mean_remainder_bound {f : ℝ → E} {a b C x : ℝ} {n : ℕ} + (hab : a ≤ b) (hf : cont_diff_on ℝ (n+1) f (Icc a b)) (hx : x ∈ Icc a b) + (hC : ∀ y ∈ Icc a b, ‖iterated_deriv_within (n + 1) f (Icc a b) y‖ ≤ C) : + ‖f x - taylor_within_eval f n (Icc a b) a x‖ ≤ C * (x - a)^(n+1) / n! := +begin + rcases eq_or_lt_of_le hab with rfl|h, + { rw [Icc_self, mem_singleton_iff] at hx, + simp [hx] }, + -- The nth iterated derivative is differentiable + have hf' : differentiable_on ℝ (iterated_deriv_within n f (Icc a b)) (Icc a b) := + hf.differentiable_on_iterated_deriv_within (with_top.coe_lt_coe.mpr n.lt_succ_self) + (unique_diff_on_Icc h), + -- We can uniformly bound the derivative of the Taylor polynomial + have h' : ∀ (y : ℝ) (hy : y ∈ Ico a x), + ‖((n! : ℝ)⁻¹ * (x - y) ^ n) • iterated_deriv_within (n + 1) f (Icc a b) y‖ + ≤ (n! : ℝ)⁻¹ * |(x - a)|^n * C, + { rintro y ⟨hay, hyx⟩, + rw [norm_smul, real.norm_eq_abs], + -- Estimate the iterated derivative by `C` + refine mul_le_mul _ (hC y ⟨hay, hyx.le.trans hx.2⟩) (by positivity) (by positivity), + -- The rest is a trivial calculation + rw [abs_mul, abs_pow, abs_inv, nat.abs_cast], + mono* with [0 ≤ (n! : ℝ)⁻¹], + any_goals { positivity }, + linarith [hx.1, hyx] }, + -- Apply the mean value theorem for vector valued functions: + have A : ∀ t ∈ Icc a x, has_deriv_within_at (λ y, taylor_within_eval f n (Icc a b) y x) + (((↑n!)⁻¹ * (x - t) ^ n) • iterated_deriv_within (n + 1) f (Icc a b) t) (Icc a x) t, + { assume t ht, + have I : Icc a x ⊆ Icc a b := Icc_subset_Icc_right hx.2, + exact (has_deriv_within_taylor_within_eval_at_Icc x h (I ht) hf.of_succ hf').mono I }, + have := norm_image_sub_le_of_norm_deriv_le_segment' A h' x (right_mem_Icc.2 hx.1), + simp only [taylor_within_eval_self] at this, + refine this.trans_eq _, + -- The rest is a trivial calculation + rw [abs_of_nonneg (sub_nonneg.mpr hx.1)], + ring_exp, +end + + +/-- **Taylor's theorem** with a polynomial bound on the remainder + +We assume that `f` is `n+1`-times continuously differentiable on the closed set `Icc a b`. +There exists a constant `C` such that for all `x ∈ Icc a b` the difference of `f` and its `n`-th +Taylor polynomial can be estimated by `C * (x - a)^(n+1)`. -/ +lemma exists_taylor_mean_remainder_bound {f : ℝ → E} {a b : ℝ} {n : ℕ} + (hab : a ≤ b) (hf : cont_diff_on ℝ (n+1) f (Icc a b)) : + ∃ C, ∀ x ∈ Icc a b, ‖f x - taylor_within_eval f n (Icc a b) a x‖ ≤ C * (x - a)^(n+1) := +begin + rcases eq_or_lt_of_le hab with rfl|h, + { refine ⟨0, λ x hx, _⟩, + have : a = x, by simpa [← le_antisymm_iff] using hx, + simp [← this] }, + -- We estimate by the supremum of the norm of the iterated derivative + let g : ℝ → ℝ := λ y, ‖iterated_deriv_within (n + 1) f (Icc a b) y‖, + use [has_Sup.Sup (g '' Icc a b) / n!], + intros x hx, + rw div_mul_eq_mul_div₀, + refine taylor_mean_remainder_bound hab hf hx (λ y, _), + exact (hf.continuous_on_iterated_deriv_within rfl.le $ unique_diff_on_Icc h) + .norm.le_Sup_image_Icc, +end diff --git a/src/analysis/calculus/uniform_limits_deriv.lean b/src/analysis/calculus/uniform_limits_deriv.lean new file mode 100644 index 0000000000000..a5b1a1b9b99a3 --- /dev/null +++ b/src/analysis/calculus/uniform_limits_deriv.lean @@ -0,0 +1,616 @@ +/- +Copyright (c) 2022 Kevin H. Wilson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin H. Wilson +-/ +import analysis.calculus.mean_value +import analysis.normed_space.is_R_or_C +import order.filter.curry + +/-! +# Swapping limits and derivatives via uniform convergence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The purpose of this file is to prove that the derivative of the pointwise limit of a sequence of +functions is the pointwise limit of the functions' derivatives when the derivatives converge +_uniformly_. The formal statement appears as `has_fderiv_at_of_tendsto_locally_uniformly_at`. + +## Main statements + +* `uniform_cauchy_seq_on_filter_of_fderiv`: If + 1. `f : ℕ → E → G` is a sequence of functions which have derivatives + `f' : ℕ → E → (E →L[𝕜] G)` on a neighborhood of `x`, + 2. the functions `f` converge at `x`, and + 3. the derivatives `f'` form a Cauchy sequence uniformly on a neighborhood of `x`, + then the `f` form a Cauchy sequence _uniformly_ on a neighborhood of `x` +* `has_fderiv_at_of_tendsto_uniformly_on_filter` : Suppose (1), (2), and (3) above are true. Let + `g` (resp. `g'`) be the limiting function of the `f` (resp. `g'`). Then `f'` is the derivative of + `g` on a neighborhood of `x` +* `has_fderiv_at_of_tendsto_uniformly_on`: An often-easier-to-use version of the above theorem when + *all* the derivatives exist and functions converge on a common open set and the derivatives + converge uniformly there. + +Each of the above statements also has variations that support `deriv` instead of `fderiv`. + +## Implementation notes + +Our technique for proving the main result is the famous "`ε / 3` proof." In words, you can find it +explained, for instance, at [this StackExchange post](https://math.stackexchange.com/questions/214218/uniform-convergence-of-derivatives-tao-14-2-7). +The subtlety is that we want to prove that the difference quotients of the `g` converge to the `g'`. +That is, we want to prove something like: + +``` +∀ ε > 0, ∃ δ > 0, ∀ y ∈ B_δ(x), |y - x|⁻¹ * |(g y - g x) - g' x (y - x)| < ε. +``` + +To do so, we will need to introduce a pair of quantifers + +```lean +∀ ε > 0, ∃ N, ∀ n ≥ N, ∃ δ > 0, ∀ y ∈ B_δ(x), |y - x|⁻¹ * |(g y - g x) - g' x (y - x)| < ε. +``` + +So how do we write this in terms of filters? Well, the initial definition of the derivative is + +```lean +tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (𝓝 x) (𝓝 0) +``` + +There are two ways we might introduce `n`. We could do: + +```lean +∀ᶠ (n : ℕ) in at_top, tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (𝓝 x) (𝓝 0) +``` + +but this is equivalent to the quantifier order `∃ N, ∀ n ≥ N, ∀ ε > 0, ∃ δ > 0, ∀ y ∈ B_δ(x)`, +which _implies_ our desired `∀ ∃ ∀ ∃ ∀` but is _not_ equivalent to it. On the other hand, we might +try + +```lean +tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (at_top ×ᶠ 𝓝 x) (𝓝 0) +``` + +but this is equivalent to the quantifer order `∀ ε > 0, ∃ N, ∃ δ > 0, ∀ n ≥ N, ∀ y ∈ B_δ(x)`, which +again _implies_ our desired `∀ ∃ ∀ ∃ ∀` but is not equivalent to it. + +So to get the quantifier order we want, we need to introduce a new filter construction, which we +call a "curried filter" + +```lean +tendsto (|y - x|⁻¹ * |(g y - g x) - g' x (y - x)|) (at_top.curry (𝓝 x)) (𝓝 0) +``` + +Then the above implications are `filter.tendsto.curry` and +`filter.tendsto.mono_left filter.curry_le_prod`. We will use both of these deductions as part of +our proof. + +We note that if you loosen the assumptions of the main theorem then the proof becomes quite a bit +easier. In particular, if you assume there is a common neighborhood `s` where all of the three +assumptions of `has_fderiv_at_of_tendsto_uniformly_on_filter` hold and that the `f'` are +continuous, then you can avoid the mean value theorem and much of the work around curried filters. + +## Tags + +uniform convergence, limits of derivatives +-/ + +open filter +open_locale uniformity filter topology + +section limits_of_derivatives + +variables {ι : Type*} {l : filter ι} + {E : Type*} [normed_add_comm_group E] + {𝕜 : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] + {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] + {f : ι → E → G} {g : E → G} {f' : ι → (E → (E →L[𝕜] G))} {g' : E → (E →L[𝕜] G)} + {x : E} + +/-- If a sequence of functions real or complex functions are eventually differentiable on a +neighborhood of `x`, they are Cauchy _at_ `x`, and their derivatives +are a uniform Cauchy sequence in a neighborhood of `x`, then the functions form a uniform Cauchy +sequence in a neighborhood of `x`. -/ +lemma uniform_cauchy_seq_on_filter_of_fderiv + (hf' : uniform_cauchy_seq_on_filter f' l (𝓝 x)) + (hf : ∀ᶠ (n : ι × E) in (l ×ᶠ 𝓝 x), has_fderiv_at (f n.1) (f' n.1 n.2) n.2) + (hfg : cauchy (map (λ n, f n x) l)) : + uniform_cauchy_seq_on_filter f l (𝓝 x) := +begin + letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _, + rw seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero at + hf' ⊢, + + suffices : tendsto_uniformly_on_filter + (λ (n : ι × ι) (z : E), f n.1 z - f n.2 z - (f n.1 x - f n.2 x)) 0 (l ×ᶠ l) (𝓝 x) ∧ + tendsto_uniformly_on_filter (λ (n : ι × ι) (z : E), f n.1 x - f n.2 x) 0 (l ×ᶠ l) (𝓝 x), + { have := this.1.add this.2, + rw add_zero at this, + exact this.congr (by simp), }, + split, + { -- This inequality follows from the mean value theorem. To apply it, we will need to shrink our + -- neighborhood to small enough ball + rw metric.tendsto_uniformly_on_filter_iff at hf' ⊢, + intros ε hε, + have := (tendsto_swap4_prod.eventually (hf.prod_mk hf)).diag_of_prod_right, + obtain ⟨a, b, c, d, e⟩ := eventually_prod_iff.1 ((hf' ε hε).and this), + obtain ⟨R, hR, hR'⟩ := metric.nhds_basis_ball.eventually_iff.mp d, + let r := min 1 R, + have hr : 0 < r, { simp [hR], }, + have hr' : ∀ ⦃y : E⦄, y ∈ metric.ball x r → c y, + { exact (λ y hy, hR' (lt_of_lt_of_le (metric.mem_ball.mp hy) (min_le_right _ _))), }, + have hxy : ∀ (y : E), y ∈ metric.ball x r → ‖y - x‖ < 1, + { intros y hy, + rw [metric.mem_ball, dist_eq_norm] at hy, + exact lt_of_lt_of_le hy (min_le_left _ _), }, + have hxyε : ∀ (y : E), y ∈ metric.ball x r → ε * ‖y - x‖ < ε, + { intros y hy, + exact (mul_lt_iff_lt_one_right hε.lt).mpr (hxy y hy), }, + + -- With a small ball in hand, apply the mean value theorem + refine eventually_prod_iff.mpr ⟨_, b, (λ e : E, metric.ball x r e), + eventually_mem_set.mpr (metric.nhds_basis_ball.mem_of_mem hr), (λ n hn y hy, _)⟩, + simp only [pi.zero_apply, dist_zero_left] at e ⊢, + refine lt_of_le_of_lt _ (hxyε y hy), + exact convex.norm_image_sub_le_of_norm_has_fderiv_within_le + (λ y hy, ((e hn (hr' hy)).2.1.sub (e hn (hr' hy)).2.2).has_fderiv_within_at) + (λ y hy, (e hn (hr' hy)).1.le) + (convex_ball x r) (metric.mem_ball_self hr) hy, }, + { -- This is just `hfg` run through `eventually_prod_iff` + refine metric.tendsto_uniformly_on_filter_iff.mpr (λ ε hε, _), + obtain ⟨t, ht, ht'⟩ := (metric.cauchy_iff.mp hfg).2 ε hε, + exact eventually_prod_iff.mpr + ⟨ (λ (n : ι × ι), (f n.1 x ∈ t) ∧ (f n.2 x ∈ t)), + eventually_prod_iff.mpr ⟨_, ht, _, ht, (λ n hn n' hn', ⟨hn, hn'⟩)⟩, + (λ y, true), + (by simp), + (λ n hn y hy, by simpa [norm_sub_rev, dist_eq_norm] using ht' _ hn.1 _ hn.2)⟩, }, +end + +/-- A variant of the second fundamental theorem of calculus (FTC-2): If a sequence of functions +between real or complex normed spaces are differentiable on a ball centered at `x`, they +form a Cauchy sequence _at_ `x`, and their derivatives are Cauchy uniformly on the ball, then the +functions form a uniform Cauchy sequence on the ball. + +NOTE: The fact that we work on a ball is typically all that is necessary to work with power series +and Dirichlet series (our primary use case). However, this can be generalized by replacing the ball +with any connected, bounded, open set and replacing uniform convergence with local uniform +convergence. See `cauchy_map_of_uniform_cauchy_seq_on_fderiv`. +-/ +lemma uniform_cauchy_seq_on_ball_of_fderiv + {r : ℝ} (hf' : uniform_cauchy_seq_on f' l (metric.ball x r)) + (hf : ∀ n : ι, ∀ y : E, y ∈ metric.ball x r → has_fderiv_at (f n) (f' n y) y) + (hfg : cauchy (map (λ n, f n x) l)) : + uniform_cauchy_seq_on f l (metric.ball x r) := +begin + letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _, + haveI : ne_bot l, from (cauchy_map_iff.1 hfg).1, + rcases le_or_lt r 0 with hr|hr, + { simp only [metric.ball_eq_empty.2 hr, uniform_cauchy_seq_on, set.mem_empty_iff_false, + is_empty.forall_iff, eventually_const, implies_true_iff] }, + rw seminormed_add_group.uniform_cauchy_seq_on_iff_tendsto_uniformly_on_zero at hf' ⊢, + suffices : tendsto_uniformly_on + (λ (n : ι × ι) (z : E), f n.1 z - f n.2 z - (f n.1 x - f n.2 x)) 0 + (l ×ᶠ l) (metric.ball x r) ∧ + tendsto_uniformly_on (λ (n : ι × ι) (z : E), f n.1 x - f n.2 x) 0 + (l ×ᶠ l) (metric.ball x r), + { have := this.1.add this.2, + rw add_zero at this, + refine this.congr _, + apply eventually_of_forall, + intros n z hz, + simp, }, + split, + { -- This inequality follows from the mean value theorem + rw metric.tendsto_uniformly_on_iff at hf' ⊢, + intros ε hε, + obtain ⟨q, hqpos, hq⟩ : ∃ q : ℝ, 0 < q ∧ q * r < ε, + { simp_rw mul_comm, + exact exists_pos_mul_lt hε.lt r, }, + apply (hf' q hqpos.gt).mono, + intros n hn y hy, + simp_rw [dist_eq_norm, pi.zero_apply, zero_sub, norm_neg] at hn ⊢, + have mvt := convex.norm_image_sub_le_of_norm_has_fderiv_within_le + (λ z hz, ((hf n.1 z hz).sub (hf n.2 z hz)).has_fderiv_within_at) + (λ z hz, (hn z hz).le) (convex_ball x r) (metric.mem_ball_self hr) hy, + refine lt_of_le_of_lt mvt _, + have : q * ‖y - x‖ < q * r, + { exact mul_lt_mul' rfl.le (by simpa only [dist_eq_norm] using metric.mem_ball.mp hy) + (norm_nonneg _) hqpos, }, + exact this.trans hq, }, + { -- This is just `hfg` run through `eventually_prod_iff` + refine metric.tendsto_uniformly_on_iff.mpr (λ ε hε, _), + obtain ⟨t, ht, ht'⟩ := (metric.cauchy_iff.mp hfg).2 ε hε, + rw eventually_prod_iff, + refine ⟨(λ n, f n x ∈ t), ht, (λ n, f n x ∈ t), ht, _⟩, + intros n hn n' hn' z hz, + rw [dist_eq_norm, pi.zero_apply, zero_sub, norm_neg, ←dist_eq_norm], + exact (ht' _ hn _ hn'), }, +end + +/-- If a sequence of functions between real or complex normed spaces are differentiable on a +preconnected open set, they form a Cauchy sequence _at_ `x`, and their derivatives are Cauchy +uniformly on the set, then the functions form a Cauchy sequence at any point in the set. -/ +lemma cauchy_map_of_uniform_cauchy_seq_on_fderiv + {s : set E} (hs : is_open s) (h's : is_preconnected s) + (hf' : uniform_cauchy_seq_on f' l s) + (hf : ∀ n : ι, ∀ y : E, y ∈ s → has_fderiv_at (f n) (f' n y) y) + {x₀ x : E} (hx₀ : x₀ ∈ s) (hx : x ∈ s) + (hfg : cauchy (map (λ n, f n x₀) l)) : + cauchy (map (λ n, f n x) l) := +begin + haveI : ne_bot l, from (cauchy_map_iff.1 hfg).1, + let t := {y | y ∈ s ∧ cauchy (map (λ n, f n y) l)}, + suffices H : s ⊆ t, from (H hx).2, + have A : ∀ x ε, x ∈ t → metric.ball x ε ⊆ s → metric.ball x ε ⊆ t, + from λ x ε xt hx y hy, ⟨hx hy, (uniform_cauchy_seq_on_ball_of_fderiv (hf'.mono hx) + (λ n y hy, hf n y (hx hy)) xt.2).cauchy_map hy⟩, + have open_t : is_open t, + { rw metric.is_open_iff, + assume x hx, + rcases metric.is_open_iff.1 hs x hx.1 with ⟨ε, εpos, hε⟩, + exact ⟨ε, εpos, A x ε hx hε⟩ }, + have st_nonempty : (s ∩ t).nonempty, from ⟨x₀, hx₀, ⟨hx₀, hfg⟩⟩, + suffices H : closure t ∩ s ⊆ t, from h's.subset_of_closure_inter_subset open_t st_nonempty H, + rintros x ⟨xt, xs⟩, + obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ) (H : ε > 0), metric.ball x ε ⊆ s, + from metric.is_open_iff.1 hs x xs, + obtain ⟨y, yt, hxy⟩ : ∃ (y : E) (yt : y ∈ t), dist x y < ε / 2, + from metric.mem_closure_iff.1 xt _ (half_pos εpos), + have B : metric.ball y (ε / 2) ⊆ metric.ball x ε, + { apply metric.ball_subset_ball', rw dist_comm, linarith }, + exact A y (ε / 2) yt (B.trans hε) (metric.mem_ball.2 hxy) +end + +/-- If `f_n → g` pointwise and the derivatives `(f_n)' → h` _uniformly_ converge, then +in fact for a fixed `y`, the difference quotients `‖z - y‖⁻¹ • (f_n z - f_n y)` converge +_uniformly_ to `‖z - y‖⁻¹ • (g z - g y)` -/ +lemma difference_quotients_converge_uniformly + (hf' : tendsto_uniformly_on_filter f' g' l (𝓝 x)) + (hf : ∀ᶠ (n : ι × E) in (l ×ᶠ 𝓝 x), has_fderiv_at (f n.1) (f' n.1 n.2) n.2) + (hfg : ∀ᶠ (y : E) in 𝓝 x, tendsto (λ n, f n y) l (𝓝 (g y))) : + tendsto_uniformly_on_filter + (λ n : ι, λ y : E, (‖y - x‖⁻¹ : 𝕜) • (f n y - f n x)) + (λ y : E, (‖y - x‖⁻¹ : 𝕜) • (g y - g x)) + l (𝓝 x) := +begin + letI : normed_space ℝ E, from normed_space.restrict_scalars ℝ 𝕜 _, + rcases eq_or_ne l ⊥ with hl|hl, + { simp only [hl, tendsto_uniformly_on_filter, bot_prod, eventually_bot, implies_true_iff] }, + haveI : ne_bot l := ⟨hl⟩, + refine uniform_cauchy_seq_on_filter.tendsto_uniformly_on_filter_of_tendsto _ + ((hfg.and (eventually_const.mpr hfg.self_of_nhds)).mono (λ y hy, (hy.1.sub hy.2).const_smul _)), + rw seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero, + rw metric.tendsto_uniformly_on_filter_iff, + + have hfg' := hf'.uniform_cauchy_seq_on_filter, + rw seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero at hfg', + rw metric.tendsto_uniformly_on_filter_iff at hfg', + intros ε hε, + obtain ⟨q, hqpos, hqε⟩ := exists_pos_rat_lt hε, + specialize hfg' (q : ℝ) (by simp [hqpos]), + + have := (tendsto_swap4_prod.eventually (hf.prod_mk hf)).diag_of_prod_right, + obtain ⟨a, b, c, d, e⟩ := eventually_prod_iff.1 (hfg'.and this), + obtain ⟨r, hr, hr'⟩ := metric.nhds_basis_ball.eventually_iff.mp d, + + rw eventually_prod_iff, + refine ⟨_, b, (λ e : E, metric.ball x r e), + eventually_mem_set.mpr (metric.nhds_basis_ball.mem_of_mem hr), (λ n hn y hy, _)⟩, + simp only [pi.zero_apply, dist_zero_left], + rw [← smul_sub, norm_smul, norm_inv, is_R_or_C.norm_coe_norm], + refine lt_of_le_of_lt _ hqε, + by_cases hyz' : x = y, { simp [hyz', hqpos.le], }, + have hyz : 0 < ‖y - x‖, + {rw norm_pos_iff, intros hy', exact hyz' (eq_of_sub_eq_zero hy').symm, }, + rw [inv_mul_le_iff hyz, mul_comm, sub_sub_sub_comm], + simp only [pi.zero_apply, dist_zero_left] at e, + refine convex.norm_image_sub_le_of_norm_has_fderiv_within_le + (λ y hy, ((e hn (hr' hy)).2.1.sub (e hn (hr' hy)).2.2).has_fderiv_within_at) + (λ y hy, (e hn (hr' hy)).1.le) + (convex_ball x r) (metric.mem_ball_self hr) hy, +end + +/-- `(d/dx) lim_{n → ∞} f n x = lim_{n → ∞} f' n x` when the `f' n` converge +_uniformly_ to their limit at `x`. + +In words the assumptions mean the following: + * `hf'`: The `f'` converge "uniformly at" `x` to `g'`. This does not mean that the `f' n` even + converge away from `x`! + * `hf`: For all `(y, n)` with `y` sufficiently close to `x` and `n` sufficiently large, `f' n` is + the derivative of `f n` + * `hfg`: The `f n` converge pointwise to `g` on a neighborhood of `x` -/ +lemma has_fderiv_at_of_tendsto_uniformly_on_filter [ne_bot l] + (hf' : tendsto_uniformly_on_filter f' g' l (𝓝 x)) + (hf : ∀ᶠ (n : ι × E) in (l ×ᶠ 𝓝 x), has_fderiv_at (f n.1) (f' n.1 n.2) n.2) + (hfg : ∀ᶠ y in 𝓝 x, tendsto (λ n, f n y) l (𝓝 (g y))) : + has_fderiv_at g (g' x) x := +begin + -- The proof strategy follows several steps: + -- 1. The quantifiers in the definition of the derivative are + -- `∀ ε > 0, ∃δ > 0, ∀y ∈ B_δ(x)`. We will introduce a quantifier in the middle: + -- `∀ ε > 0, ∃N, ∀n ≥ N, ∃δ > 0, ∀y ∈ B_δ(x)` which will allow us to introduce the `f(') n` + -- 2. The order of the quantifiers `hfg` are opposite to what we need. We will be able to swap + -- the quantifiers using the uniform convergence assumption + rw has_fderiv_at_iff_tendsto, + + -- Introduce extra quantifier via curried filters + suffices : tendsto + (λ (y : ι × E), ‖y.2 - x‖⁻¹ * ‖g y.2 - g x - (g' x) (y.2 - x)‖) (l.curry (𝓝 x)) (𝓝 0), + { rw metric.tendsto_nhds at this ⊢, + intros ε hε, + specialize this ε hε, + rw eventually_curry_iff at this, + simp only at this, + exact (eventually_const.mp this).mono (by simp only [imp_self, forall_const]), }, + + -- With the new quantifier in hand, we can perform the famous `ε/3` proof. Specifically, + -- we will break up the limit (the difference functions minus the derivative go to 0) into 3: + -- * The difference functions of the `f n` converge *uniformly* to the difference functions + -- of the `g n` + -- * The `f' n` are the derivatives of the `f n` + -- * The `f' n` converge to `g'` at `x` + conv + { congr, funext, + rw [← abs_norm, ← abs_inv, ← @is_R_or_C.norm_of_real 𝕜 _ _, + is_R_or_C.of_real_inv, ← norm_smul], }, + rw ←tendsto_zero_iff_norm_tendsto_zero, + have : (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • (g a.2 - g x - (g' x) (a.2 - x))) = + (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • (g a.2 - g x - (f a.1 a.2 - f a.1 x))) + + (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • ((f a.1 a.2 - f a.1 x) - + ((f' a.1 x) a.2 - (f' a.1 x) x))) + + (λ a : ι × E, (‖a.2 - x‖⁻¹ : 𝕜) • ((f' a.1 x - g' x) (a.2 - x))), + { ext, simp only [pi.add_apply], rw [←smul_add, ←smul_add], congr, + simp only [map_sub, sub_add_sub_cancel, continuous_linear_map.coe_sub', pi.sub_apply], }, + simp_rw this, + have : 𝓝 (0 : G) = 𝓝 (0 + 0 + 0), simp only [add_zero], + rw this, + refine tendsto.add (tendsto.add _ _) _, + simp only, + { have := difference_quotients_converge_uniformly hf' hf hfg, + rw metric.tendsto_uniformly_on_filter_iff at this, + rw metric.tendsto_nhds, + intros ε hε, + apply ((this ε hε).filter_mono curry_le_prod).mono, + intros n hn, + rw dist_eq_norm at hn ⊢, + rw ← smul_sub at hn, + rwa sub_zero, }, + { -- (Almost) the definition of the derivatives + rw metric.tendsto_nhds, + intros ε hε, + rw eventually_curry_iff, + refine hf.curry.mono (λ n hn, _), + have := hn.self_of_nhds, + rw [has_fderiv_at_iff_tendsto, metric.tendsto_nhds] at this, + refine (this ε hε).mono (λ y hy, _), + rw dist_eq_norm at hy ⊢, + simp only [sub_zero, map_sub, norm_mul, norm_inv, norm_norm] at hy ⊢, + rw [norm_smul, norm_inv, is_R_or_C.norm_coe_norm], + exact hy, }, + { -- hfg' after specializing to `x` and applying the definition of the operator norm + refine tendsto.mono_left _ curry_le_prod, + have h1: tendsto (λ n : ι × E, g' n.2 - f' n.1 n.2) (l ×ᶠ 𝓝 x) (𝓝 0), + { rw metric.tendsto_uniformly_on_filter_iff at hf', + exact metric.tendsto_nhds.mpr (λ ε hε, by simpa using hf' ε hε), }, + have h2: tendsto (λ n : ι, g' x - f' n x) l (𝓝 0), + { rw metric.tendsto_nhds at h1 ⊢, + exact (λ ε hε, (h1 ε hε).curry.mono (λ n hn, hn.self_of_nhds)), }, + have := (tendsto_fst.comp (h2.prod_map tendsto_id)), + refine squeeze_zero_norm _ (tendsto_zero_iff_norm_tendsto_zero.mp this), + intros n, + simp_rw [norm_smul, norm_inv, is_R_or_C.norm_coe_norm], + by_cases hx : x = n.2, { simp [hx], }, + have hnx : 0 < ‖n.2 - x‖, + { rw norm_pos_iff, intros hx', exact hx (eq_of_sub_eq_zero hx').symm, }, + rw [inv_mul_le_iff hnx, mul_comm], + simp only [function.comp_app, prod_map], + rw norm_sub_rev, + exact (f' n.1 x - g' x).le_op_norm (n.2 - x), }, +end + +lemma has_fderiv_at_of_tendsto_locally_uniformly_on [ne_bot l] {s : set E} (hs : is_open s) + (hf' : tendsto_locally_uniformly_on f' g' l s) + (hf : ∀ n, ∀ x ∈ s, has_fderiv_at (f n) (f' n x) x) + (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x))) + (hx : x ∈ s) : + has_fderiv_at g (g' x) x := +begin + have h1 : s ∈ 𝓝 x := hs.mem_nhds hx, + have h3 : set.univ ×ˢ s ∈ l ×ᶠ 𝓝 x := by simp only [h1, prod_mem_prod_iff, univ_mem, and_self], + have h4 : ∀ᶠ (n : ι × E) in l ×ᶠ 𝓝 x, has_fderiv_at (f n.1) (f' n.1 n.2) n.2, + from eventually_of_mem h3 (λ ⟨n, z⟩ ⟨hn, hz⟩, hf n z hz), + refine has_fderiv_at_of_tendsto_uniformly_on_filter _ h4 (eventually_of_mem h1 hfg), + simpa [is_open.nhds_within_eq hs hx] using tendsto_locally_uniformly_on_iff_filter.mp hf' x hx, +end + +/-- A slight variant of `has_fderiv_at_of_tendsto_locally_uniformly_on` with the assumption stated +in terms of `differentiable_on` rather than `has_fderiv_at`. This makes a few proofs nicer in +complex analysis where holomorphicity is assumed but the derivative is not known a priori. -/ +lemma has_fderiv_at_of_tendsto_locally_uniformly_on' [ne_bot l] {s : set E} (hs : is_open s) + (hf' : tendsto_locally_uniformly_on (fderiv 𝕜 ∘ f) g' l s) + (hf : ∀ n, differentiable_on 𝕜 (f n) s) + (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x))) + (hx : x ∈ s) : + has_fderiv_at g (g' x) x := +begin + refine has_fderiv_at_of_tendsto_locally_uniformly_on hs hf' (λ n z hz, _) hfg hx, + exact ((hf n z hz).differentiable_at (hs.mem_nhds hz)).has_fderiv_at +end + +/-- `(d/dx) lim_{n → ∞} f n x = lim_{n → ∞} f' n x` when the `f' n` converge +_uniformly_ to their limit on an open set containing `x`. -/ +lemma has_fderiv_at_of_tendsto_uniformly_on [ne_bot l] + {s : set E} (hs : is_open s) + (hf' : tendsto_uniformly_on f' g' l s) + (hf : ∀ (n : ι), ∀ (x : E), x ∈ s → has_fderiv_at (f n) (f' n x) x) + (hfg : ∀ (x : E), x ∈ s → tendsto (λ n, f n x) l (𝓝 (g x))) : + ∀ (x : E), x ∈ s → has_fderiv_at g (g' x) x := +λ x, has_fderiv_at_of_tendsto_locally_uniformly_on hs hf'.tendsto_locally_uniformly_on hf hfg + +/-- `(d/dx) lim_{n → ∞} f n x = lim_{n → ∞} f' n x` when the `f' n` converge +_uniformly_ to their limit. -/ +lemma has_fderiv_at_of_tendsto_uniformly [ne_bot l] + (hf' : tendsto_uniformly f' g' l) + (hf : ∀ (n : ι), ∀ (x : E), has_fderiv_at (f n) (f' n x) x) + (hfg : ∀ (x : E), tendsto (λ n, f n x) l (𝓝 (g x))) : + ∀ (x : E), has_fderiv_at g (g' x) x := +begin + intros x, + have hf : ∀ (n : ι), ∀ (x : E), x ∈ set.univ → has_fderiv_at (f n) (f' n x) x, { simp [hf], }, + have hfg : ∀ (x : E), x ∈ set.univ → tendsto (λ n, f n x) l (𝓝 (g x)), { simp [hfg], }, + have hf' : tendsto_uniformly_on f' g' l set.univ, { rwa tendsto_uniformly_on_univ, }, + refine has_fderiv_at_of_tendsto_uniformly_on is_open_univ hf' hf hfg x (set.mem_univ x), +end + +end limits_of_derivatives + +section deriv + +/-! ### `deriv` versions of above theorems + +In this section, we provide `deriv` equivalents of the `fderiv` lemmas in the previous section. +The protected function `promote_deriv` provides the translation between derivatives and Fréchet +derivatives +-/ + +variables {ι : Type*} {l : filter ι} + {𝕜 : Type*} [is_R_or_C 𝕜] + {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] + {f : ι → 𝕜 → G} {g : 𝕜 → G} {f' : ι → 𝕜 → G} {g' : 𝕜 → G} + {x : 𝕜} + +/-- If our derivatives converge uniformly, then the Fréchet derivatives converge uniformly -/ +lemma uniform_cauchy_seq_on_filter.one_smul_right {l' : filter 𝕜} + (hf' : uniform_cauchy_seq_on_filter f' l l') : + uniform_cauchy_seq_on_filter (λ n, λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (f' n z)) l l' := +begin + -- The tricky part of this proof is that operator norms are written in terms of `≤` whereas + -- metrics are written in terms of `<`. So we need to shrink `ε` utilizing the archimedean + -- property of `ℝ` + + rw [seminormed_add_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_zero, + metric.tendsto_uniformly_on_filter_iff] at hf' ⊢, + intros ε hε, + obtain ⟨q, hq, hq'⟩ := exists_between hε.lt, + apply (hf' q hq).mono, + intros n hn, + refine lt_of_le_of_lt _ hq', + simp only [dist_eq_norm, pi.zero_apply, zero_sub, norm_neg] at hn ⊢, + refine continuous_linear_map.op_norm_le_bound _ hq.le _, + intros z, + simp only [continuous_linear_map.coe_sub', pi.sub_apply, continuous_linear_map.smul_right_apply, + continuous_linear_map.one_apply], + rw [←smul_sub, norm_smul, mul_comm], + exact mul_le_mul hn.le rfl.le (norm_nonneg _) hq.le, +end + +lemma uniform_cauchy_seq_on_filter_of_deriv + (hf' : uniform_cauchy_seq_on_filter f' l (𝓝 x)) + (hf : ∀ᶠ (n : ι × 𝕜) in (l ×ᶠ 𝓝 x), has_deriv_at (f n.1) (f' n.1 n.2) n.2) + (hfg : cauchy (map (λ n, f n x) l)) : + uniform_cauchy_seq_on_filter f l (𝓝 x) := +begin + simp_rw has_deriv_at_iff_has_fderiv_at at hf, + exact uniform_cauchy_seq_on_filter_of_fderiv + hf'.one_smul_right hf hfg, +end + +lemma uniform_cauchy_seq_on_ball_of_deriv + {r : ℝ} (hf' : uniform_cauchy_seq_on f' l (metric.ball x r)) + (hf : ∀ n : ι, ∀ y : 𝕜, y ∈ metric.ball x r → has_deriv_at (f n) (f' n y) y) + (hfg : cauchy (map (λ n, f n x) l)) : + uniform_cauchy_seq_on f l (metric.ball x r) := +begin + simp_rw has_deriv_at_iff_has_fderiv_at at hf, + rw uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter at hf', + have hf' : uniform_cauchy_seq_on (λ n, λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (f' n z)) l + (metric.ball x r), + { rw uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter, + exact hf'.one_smul_right, }, + exact uniform_cauchy_seq_on_ball_of_fderiv hf' hf hfg, +end + +lemma has_deriv_at_of_tendsto_uniformly_on_filter [ne_bot l] + (hf' : tendsto_uniformly_on_filter f' g' l (𝓝 x)) + (hf : ∀ᶠ (n : ι × 𝕜) in (l ×ᶠ 𝓝 x), has_deriv_at (f n.1) (f' n.1 n.2) n.2) + (hfg : ∀ᶠ y in 𝓝 x, tendsto (λ n, f n y) l (𝓝 (g y))) : + has_deriv_at g (g' x) x := +begin + -- The first part of the proof rewrites `hf` and the goal to be functions so that Lean + -- can recognize them when we apply `has_fderiv_at_of_tendsto_uniformly_on_filter` + let F' := (λ n, λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (f' n z)), + let G' := λ z, (1 : 𝕜 →L[𝕜] 𝕜).smul_right (g' z), + simp_rw has_deriv_at_iff_has_fderiv_at at hf ⊢, + + -- Now we need to rewrite hf' in terms of continuous_linear_maps. The tricky part is that + -- operator norms are written in terms of `≤` whereas metrics are written in terms of `<`. So we + -- need to shrink `ε` utilizing the archimedean property of `ℝ` + have hf' : tendsto_uniformly_on_filter F' G' l (𝓝 x), + { rw metric.tendsto_uniformly_on_filter_iff at hf' ⊢, + intros ε hε, + obtain ⟨q, hq, hq'⟩ := exists_between hε.lt, + apply (hf' q hq).mono, + intros n hn, + refine lt_of_le_of_lt _ hq', + simp only [F', G', dist_eq_norm] at hn ⊢, + refine continuous_linear_map.op_norm_le_bound _ hq.le _, + intros z, + simp only [continuous_linear_map.coe_sub', pi.sub_apply, continuous_linear_map.smul_right_apply, + continuous_linear_map.one_apply], + rw [←smul_sub, norm_smul, mul_comm], + exact mul_le_mul hn.le rfl.le (norm_nonneg _) hq.le, }, + exact has_fderiv_at_of_tendsto_uniformly_on_filter hf' hf hfg, +end + +lemma has_deriv_at_of_tendsto_locally_uniformly_on [ne_bot l] {s : set 𝕜} (hs : is_open s) + (hf' : tendsto_locally_uniformly_on f' g' l s) + (hf : ∀ᶠ n in l, ∀ x ∈ s, has_deriv_at (f n) (f' n x) x) + (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x))) + (hx : x ∈ s) : + has_deriv_at g (g' x) x := +begin + have h1 : s ∈ 𝓝 x := hs.mem_nhds hx, + have h2 : ∀ᶠ (n : ι × 𝕜) in l ×ᶠ 𝓝 x, has_deriv_at (f n.1) (f' n.1 n.2) n.2, + from eventually_prod_iff.2 ⟨_, hf, λ x, x ∈ s, h1, λ n, id⟩, + refine has_deriv_at_of_tendsto_uniformly_on_filter _ h2 (eventually_of_mem h1 hfg), + simpa [is_open.nhds_within_eq hs hx] using tendsto_locally_uniformly_on_iff_filter.mp hf' x hx, +end + +/-- A slight variant of `has_deriv_at_of_tendsto_locally_uniformly_on` with the assumption stated in +terms of `differentiable_on` rather than `has_deriv_at`. This makes a few proofs nicer in complex +analysis where holomorphicity is assumed but the derivative is not known a priori. -/ +lemma has_deriv_at_of_tendsto_locally_uniformly_on' [ne_bot l] {s : set 𝕜} (hs : is_open s) + (hf' : tendsto_locally_uniformly_on (deriv ∘ f) g' l s) + (hf : ∀ᶠ n in l, differentiable_on 𝕜 (f n) s) + (hfg : ∀ x ∈ s, tendsto (λ n, f n x) l (𝓝 (g x))) + (hx : x ∈ s) : + has_deriv_at g (g' x) x := +begin + refine has_deriv_at_of_tendsto_locally_uniformly_on hs hf' _ hfg hx, + filter_upwards [hf] with n h z hz using ((h z hz).differentiable_at (hs.mem_nhds hz)).has_deriv_at +end + +lemma has_deriv_at_of_tendsto_uniformly_on [ne_bot l] + {s : set 𝕜} (hs : is_open s) + (hf' : tendsto_uniformly_on f' g' l s) + (hf : ∀ᶠ n in l, ∀ (x : 𝕜), x ∈ s → has_deriv_at (f n) (f' n x) x) + (hfg : ∀ (x : 𝕜), x ∈ s → tendsto (λ n, f n x) l (𝓝 (g x))) : + ∀ (x : 𝕜), x ∈ s → has_deriv_at g (g' x) x := +λ x, has_deriv_at_of_tendsto_locally_uniformly_on hs hf'.tendsto_locally_uniformly_on hf hfg + +lemma has_deriv_at_of_tendsto_uniformly [ne_bot l] + (hf' : tendsto_uniformly f' g' l) + (hf : ∀ᶠ n in l, ∀ (x : 𝕜), has_deriv_at (f n) (f' n x) x) + (hfg : ∀ (x : 𝕜), tendsto (λ n, f n x) l (𝓝 (g x))) : + ∀ (x : 𝕜), has_deriv_at g (g' x) x := +begin + intros x, + have hf : ∀ᶠ n in l, ∀ (x : 𝕜), x ∈ set.univ → has_deriv_at (f n) (f' n x) x, + by filter_upwards [hf] with n h x hx using h x, + have hfg : ∀ (x : 𝕜), x ∈ set.univ → tendsto (λ n, f n x) l (𝓝 (g x)), { simp [hfg], }, + have hf' : tendsto_uniformly_on f' g' l set.univ, { rwa tendsto_uniformly_on_univ, }, + exact has_deriv_at_of_tendsto_uniformly_on is_open_univ hf' hf hfg x (set.mem_univ x), +end + +end deriv diff --git a/src/analysis/complex/abs_max.lean b/src/analysis/complex/abs_max.lean index c00c4fa95b66b..5690a779be860 100644 --- a/src/analysis/complex/abs_max.lean +++ b/src/analysis/complex/abs_max.lean @@ -4,38 +4,87 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury G. Kudryashov -/ import analysis.complex.cauchy_integral -import analysis.convex.integral import analysis.normed_space.completion +import analysis.normed_space.extr import topology.algebra.order.extr_closure /-! # Maximum modulus principle -In this file we prove several versions of the maximum modulus principle. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -There are several statements that can be called "the maximum modulus principle" for maps between -normed complex spaces. +In this file we prove several versions of the maximum modulus principle. There are several +statements that can be called "the maximum modulus principle" for maps between normed complex +spaces. They differ by assumptions on the domain (any space, a nontrivial space, a finite +dimensional space), assumptions on the codomain (any space, a strictly convex space), and by +conclusion (either equality of norms or of the values of the function). -In the most general case, see `complex.norm_eventually_eq_of_is_local_max`, we can only say that for -a differentiable function `f : E → F`, if the norm has a local maximum at `z`, then *the norm* is -constant in a neighborhood of `z`. +## Main results -If the domain is a nontrivial finite dimensional space, then this implies the following version of -the maximum modulus principle, see `complex.exists_mem_frontier_is_max_on_norm`. If `f : E → F` is -complex differentiable on a nonempty compact set `K`, then there exists a point `z ∈ frontier K` -such that `λ z, ∥f z∥` takes it maximum value on `K` at `z`. +### Theorems for any codomain -Finally, if the codomain is a strictly convex space, then the function cannot have a local maximum -of the norm unless the function (not only its norm) is a constant. This version is not formalized -yet. +Consider a function `f : E → F` that is complex differentiable on a set `s`, is continuous on its +closure, and `‖f x‖` has a maximum on `s` at `c`. We prove the following theorems. + +- `complex.norm_eq_on_closed_ball_of_is_max_on`: if `s = metric.ball c r`, then `‖f x‖ = ‖f c‖` for + any `x` from the corresponding closed ball; + +- `complex.norm_eq_norm_of_is_max_on_of_ball_subset`: if `metric.ball c (dist w c) ⊆ s`, then + `‖f w‖ = ‖f c‖`; + +- `complex.norm_eq_on_of_is_preconnected_of_is_max_on`: if `U` is an open (pre)connected set, `f` is + complex differentiable on `U`, and `‖f x‖` has a maximum on `U` at `c ∈ U`, then `‖f x‖ = ‖f c‖` + for all `x ∈ U`; + +- `complex.norm_eq_on_closure_of_is_preconnected_of_is_max_on`: if `s` is open and (pre)connected + and `c ∈ s`, then `‖f x‖ = ‖f c‖` for all `x ∈ closure s`; + +- `complex.norm_eventually_eq_of_is_local_max`: if `f` is complex differentiable in a neighborhood + of `c` and `‖f x‖` has a local maximum at `c`, then `‖f x‖` is locally a constant in a + neighborhood of `c`. + +### Theorems for a strictly convex codomain + +If the codomain `F` is a strictly convex space, then in the lemmas from the previous section we can +prove `f w = f c` instead of `‖f w‖ = ‖f c‖`, see +`complex.eq_on_of_is_preconnected_of_is_max_on_norm`, +`complex.eq_on_closure_of_is_preconnected_of_is_max_on_norm`, +`complex.eq_of_is_max_on_of_ball_subset`, `complex.eq_on_closed_ball_of_is_max_on_norm`, and +`complex.eventually_eq_of_is_local_max_norm`. + +### Values on the frontier + +Finally, we prove some corollaries that relate the (norm of the) values of a function on a set to +its values on the frontier of the set. All these lemmas assume that `E` is a nontrivial space. In +this section `f g : E → F` are functions that are complex differentiable on a bounded set `s` and +are continuous on its closure. We prove the following theorems. + +- `complex.exists_mem_frontier_is_max_on_norm`: If `E` is a finite dimensional space and `s` is a + nonempty bounded set, then there exists a point `z ∈ frontier s` such that `λ z, ‖f z‖` takes it + maximum value on `closure s` at `z`. + +- `complex.norm_le_of_forall_mem_frontier_norm_le`: if `‖f z‖ ≤ C` for all `z ∈ frontier s`, then + `‖f z‖ ≤ C` for all `z ∈ s`; note that this theorem does not require `E` to be a finite + dimensional space. + +- `complex.eq_on_closure_of_eq_on_frontier`: if `f x = g x` on the frontier of `s`, then `f x = g x` + on `closure s`; + +- `complex.eq_on_of_eq_on_frontier`: if `f x = g x` on the frontier of `s`, then `f x = g x` + on `s`. + +## Tags + +maximum modulus principle, complex analysis -/ open topological_space metric set filter asymptotics function measure_theory affine_map -open_locale topological_space filter nnreal real +open_locale topology filter nnreal real universes u v w -variables {E : Type u} [normed_group E] [normed_space ℂ E] - {F : Type v} [normed_group F] [normed_space ℂ F] +variables {E : Type u} [normed_add_comm_group E] [normed_space ℂ E] + {F : Type v} [normed_add_comm_group F] [normed_space ℂ F] local postfix `̂`:100 := uniform_space.completion @@ -48,31 +97,31 @@ We split the proof into a series of lemmas. First we prove the principle for a f with an additional assumption that `F` is a complete space, then drop unneeded assumptions one by one. -The only "public API" lemmas in this section are TODO and -`complex.norm_eq_norm_of_is_max_on_of_closed_ball_subset`. +The lemmas with names `*_auxₙ` are considered to be private and should not be used outside of this +file. -/ lemma norm_max_aux₁ [complete_space F] {f : ℂ → F} {z w : ℂ} (hd : diff_cont_on_cl ℂ f (ball z (dist w z))) (hz : is_max_on (norm ∘ f) (closed_ball z (dist w z)) z) : - ∥f w∥ = ∥f z∥ := + ‖f w‖ = ‖f z‖ := begin /- Consider a circle of radius `r = dist w z`. -/ set r : ℝ := dist w z, have hw : w ∈ closed_ball z r, from mem_closed_ball.2 le_rfl, - /- Assume the converse. Since `∥f w∥ ≤ ∥f z∥`, we have `∥f w∥ < ∥f z∥`. -/ + /- Assume the converse. Since `‖f w‖ ≤ ‖f z‖`, we have `‖f w‖ < ‖f z‖`. -/ refine (is_max_on_iff.1 hz _ hw).antisymm (not_lt.1 _), - rintro hw_lt : ∥f w∥ < ∥f z∥, + rintro hw_lt : ‖f w‖ < ‖f z‖, have hr : 0 < r, from dist_pos.2 (ne_of_apply_ne (norm ∘ f) hw_lt.ne), /- Due to Cauchy integral formula, it suffices to prove the following inequality. -/ - suffices : ∥∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ∥ < 2 * π * ∥f z∥, + suffices : ‖∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ‖ < 2 * π * ‖f z‖, { refine this.ne _, have A : ∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ = (2 * π * I : ℂ) • f z := hd.circle_integral_sub_inv_smul (mem_ball_self hr), simp [A, norm_smul, real.pi_pos.le] }, - suffices : ∥∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ∥ < 2 * π * r * (∥f z∥ / r), + suffices : ‖∮ ζ in C(z, r), (ζ - z)⁻¹ • f ζ‖ < 2 * π * r * (‖f z‖ / r), by rwa [mul_assoc, mul_div_cancel' _ hr.ne'] at this, - /- This inequality is true because `∥(ζ - z)⁻¹ • f ζ∥ ≤ ∥f z∥ / r` for all `ζ` on the circle and + /- This inequality is true because `‖(ζ - z)⁻¹ • f ζ‖ ≤ ‖f z‖ / r` for all `ζ` on the circle and this inequality is strict at `ζ = w`. -/ have hsub : sphere z r ⊆ closed_ball z r, from sphere_subset_closed_ball, refine circle_integral.norm_integral_lt_of_norm_le_const_of_lt hr _ _ ⟨w, rfl, _⟩, @@ -80,11 +129,11 @@ begin { refine ((continuous_on_id.sub continuous_on_const).inv₀ _).smul (hd.continuous_on_ball.mono hsub), exact λ ζ hζ, sub_ne_zero.2 (ne_of_mem_sphere hζ hr.ne') }, - show ∀ ζ ∈ sphere z r, ∥(ζ - z)⁻¹ • f ζ∥ ≤ ∥f z∥ / r, + show ∀ ζ ∈ sphere z r, ‖(ζ - z)⁻¹ • f ζ‖ ≤ ‖f z‖ / r, { rintros ζ (hζ : abs (ζ - z) = r), rw [le_div_iff hr, norm_smul, norm_inv, norm_eq_abs, hζ, mul_comm, mul_inv_cancel_left₀ hr.ne'], exact hz (hsub hζ) }, - show ∥(w - z)⁻¹ • f w∥ < ∥f z∥ / r, + show ‖(w - z)⁻¹ • f w‖ < ‖f z‖ / r, { rw [norm_smul, norm_inv, norm_eq_abs, ← div_eq_inv_mul], exact (div_lt_div_right hr).2 hw_lt } end @@ -95,10 +144,10 @@ Now we drop the assumption `complete_space F` by embedding `F` into its completi lemma norm_max_aux₂ {f : ℂ → F} {z w : ℂ} (hd : diff_cont_on_cl ℂ f (ball z (dist w z))) (hz : is_max_on (norm ∘ f) (closed_ball z (dist w z)) z) : - ∥f w∥ = ∥f z∥ := + ‖f w‖ = ‖f z‖ := begin set e : F →L[ℂ] F̂ := uniform_space.completion.to_complL, - have he : ∀ x, ∥e x∥ = ∥x∥, from uniform_space.completion.norm_coe, + have he : ∀ x, ‖e x‖ = ‖x‖, from uniform_space.completion.norm_coe, replace hz : is_max_on (norm ∘ (e ∘ f)) (closed_ball z (dist w z)) z, by simpa only [is_max_on, (∘), he] using hz, simpa only [he] using norm_max_aux₁ (e.differentiable.comp_diff_cont_on_cl hd) hz @@ -111,7 +160,7 @@ assumption `is_max_on (norm ∘ f) (ball z r) z`. lemma norm_max_aux₃ {f : ℂ → F} {z w : ℂ} {r : ℝ} (hr : dist w z = r) (hd : diff_cont_on_cl ℂ f (ball z r)) (hz : is_max_on (norm ∘ f) (ball z r) z) : - ∥f w∥ = ∥f z∥ := + ‖f w‖ = ‖f z‖ := begin subst r, rcases eq_or_ne w z with rfl|hne, { refl }, @@ -119,23 +168,30 @@ begin exact norm_max_aux₂ hd (closure_ball z hne ▸ hz.closure hd.continuous_on.norm) end +/-! +### Maximum modulus principle for any codomain + +If we do not assume that the codomain is a strictly convex space, then we can only claim that the +**norm** `‖f x‖` is locally constant. +-/ + /-! Finally, we generalize the theorem from a disk in `ℂ` to a closed ball in any normed space. -/ /-- **Maximum modulus principle** on a closed ball: if `f : E → F` is continuous on a closed ball, -is complex differentiable on the corresponding open ball, and the norm `∥f w∥` takes its maximum -value on the open ball at its center, then the norm `∥f w∥` is constant on the closed ball. -/ +is complex differentiable on the corresponding open ball, and the norm `‖f w‖` takes its maximum +value on the open ball at its center, then the norm `‖f w‖` is constant on the closed ball. -/ lemma norm_eq_on_closed_ball_of_is_max_on {f : E → F} {z : E} {r : ℝ} (hd : diff_cont_on_cl ℂ f (ball z r)) (hz : is_max_on (norm ∘ f) (ball z r) z) : - eq_on (norm ∘ f) (const E ∥f z∥) (closed_ball z r) := + eq_on (norm ∘ f) (const E ‖f z‖) (closed_ball z r) := begin intros w hw, rw [mem_closed_ball, dist_comm] at hw, rcases eq_or_ne z w with rfl|hne, { refl }, set e : ℂ → E := line_map z w, have hde : differentiable ℂ e := (differentiable_id.smul_const (w - z)).add_const z, - suffices : ∥(f ∘ e) (1 : ℂ)∥ = ∥(f ∘ e) (0 : ℂ)∥, by simpa [e], + suffices : ‖(f ∘ e) (1 : ℂ)‖ = ‖(f ∘ e) (0 : ℂ)‖, by simpa [e], have hr : dist (1 : ℂ) 0 = 1, by simp, have hball : maps_to e (ball 0 1) (ball z r), { refine ((lipschitz_with_line_map z w).maps_to_ball @@ -145,24 +201,20 @@ begin (hz.comp_maps_to hball (line_map_apply_zero z w)) end -/-! -### Different forms of the maximum modulus principle --/ - /-- **Maximum modulus principle**: if `f : E → F` is complex differentiable on a set `s`, the norm -of `f` takes it maximum on `s` at `z` and `w` is a point such that the closed ball with center `z` -and radius `dist w z` is included in `s`, then `∥f w∥ = ∥f z∥`. -/ -lemma norm_eq_norm_of_is_max_on_of_closed_ball_subset {f : E → F} {s : set E} {z w : E} +of `f` takes it maximum on `s` at `z`, and `w` is a point such that the closed ball with center `z` +and radius `dist w z` is included in `s`, then `‖f w‖ = ‖f z‖`. -/ +lemma norm_eq_norm_of_is_max_on_of_ball_subset {f : E → F} {s : set E} {z w : E} (hd : diff_cont_on_cl ℂ f s) (hz : is_max_on (norm ∘ f) s z) (hsub : ball z (dist w z) ⊆ s) : - ∥f w∥ = ∥f z∥ := + ‖f w‖ = ‖f z‖ := norm_eq_on_closed_ball_of_is_max_on (hd.mono hsub) (hz.on_subset hsub) (mem_closed_ball.2 le_rfl) /-- **Maximum modulus principle**: if `f : E → F` is complex differentiable in a neighborhood of `c` -and the norm `∥f z∥` has a local maximum at `c`, then `∥f z∥` is locally constant in a neighborhood +and the norm `‖f z‖` has a local maximum at `c`, then `‖f z‖` is locally constant in a neighborhood of `c`. -/ lemma norm_eventually_eq_of_is_local_max {f : E → F} {c : E} (hd : ∀ᶠ z in 𝓝 c, differentiable_at ℂ f z) (hc : is_local_max (norm ∘ f) c) : - ∀ᶠ y in 𝓝 c, ∥f y∥ = ∥f c∥ := + ∀ᶠ y in 𝓝 c, ‖f y‖ = ‖f c‖ := begin rcases nhds_basis_closed_ball.eventually_iff.1 (hd.and hc) with ⟨r, hr₀, hr⟩, exact nhds_basis_closed_ball.eventually_iff.2 ⟨r, hr₀, norm_eq_on_closed_ball_of_is_max_on @@ -181,34 +233,174 @@ begin (λ x hx y hy, le_trans (hz.2 hy) hx.ge) end +/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a +complex normed space. Let `f : E → F` be a function that is complex differentiable on `U`. Suppose +that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then `‖f x‖ = ‖f c‖` for all `x ∈ U`. -/ +lemma norm_eq_on_of_is_preconnected_of_is_max_on {f : E → F} {U : set E} {c : E} + (hc : is_preconnected U) (ho : is_open U) (hd : differentiable_on ℂ f U) (hcU : c ∈ U) + (hm : is_max_on (norm ∘ f) U c) : + eq_on (norm ∘ f) (const E ‖f c‖) U := +begin + set V := U ∩ {z | is_max_on (norm ∘ f) U z}, + have hV : ∀ x ∈ V, ‖f x‖ = ‖f c‖, from λ x hx, le_antisymm (hm hx.1) (hx.2 hcU), + suffices : U ⊆ V, from λ x hx, hV x (this hx), + have hVo : is_open V, + { simpa only [ho.mem_nhds_iff, set_of_and, set_of_mem_eq] + using is_open_set_of_mem_nhds_and_is_max_on_norm hd }, + have hVne : (U ∩ V).nonempty := ⟨c, hcU, hcU, hm⟩, + set W := U ∩ {z | ‖f z‖ ≠ ‖f c‖}, + have hWo : is_open W, from hd.continuous_on.norm.preimage_open_of_open ho is_open_ne, + have hdVW : disjoint V W, from disjoint_left.mpr (λ x hxV hxW, hxW.2 (hV x hxV)), + have hUVW : U ⊆ V ∪ W, + from λ x hx, (eq_or_ne (‖f x‖) (‖f c‖)).imp (λ h, ⟨hx, λ y hy, (hm hy).out.trans_eq h.symm⟩) + (and.intro hx), + exact hc.subset_left_of_subset_union hVo hWo hdVW hUVW hVne, +end + +/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a +complex normed space. Let `f : E → F` be a function that is complex differentiable on `U` and is +continuous on its closure. Suppose that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then +`‖f x‖ = ‖f c‖` for all `x ∈ closure U`. -/ +lemma norm_eq_on_closure_of_is_preconnected_of_is_max_on {f : E → F} {U : set E} {c : E} + (hc : is_preconnected U) (ho : is_open U) (hd : diff_cont_on_cl ℂ f U) (hcU : c ∈ U) + (hm : is_max_on (norm ∘ f) U c) : + eq_on (norm ∘ f) (const E ‖f c‖) (closure U) := +(norm_eq_on_of_is_preconnected_of_is_max_on hc ho hd.differentiable_on hcU hm).of_subset_closure + hd.continuous_on.norm continuous_on_const subset_closure subset.rfl + +section strict_convex + +/-! +### The case of a strictly convex codomain + +If the codomain `F` is a strictly convex space, then we can claim equalities like `f w = f z` +instead of `‖f w‖ = ‖f z‖`. + +Instead of repeating the proof starting with lemmas about integrals, we apply a corresponding lemma +above twice: for `f` and for `λ x, f x + f c`. Then we have `‖f w‖ = ‖f z‖` and +`‖f w + f z‖ = ‖f z + f z‖`, thus `‖f w + f z‖ = ‖f w‖ + ‖f z‖`. This is only possible if +`f w = f z`, see `eq_of_norm_eq_of_norm_add_eq`. +-/ + +variables [strict_convex_space ℝ F] + +/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a +complex normed space. Let `f : E → F` be a function that is complex differentiable on `U`. Suppose +that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then `f x = f c` for all `x ∈ U`. + +TODO: change assumption from `is_max_on` to `is_local_max`. -/ +lemma eq_on_of_is_preconnected_of_is_max_on_norm {f : E → F} {U : set E} {c : E} + (hc : is_preconnected U) (ho : is_open U) (hd : differentiable_on ℂ f U) (hcU : c ∈ U) + (hm : is_max_on (norm ∘ f) U c) : + eq_on f (const E (f c)) U := +λ x hx, +have H₁ : ‖f x‖ = ‖f c‖, from norm_eq_on_of_is_preconnected_of_is_max_on hc ho hd hcU hm hx, +have H₂ : ‖f x + f c‖ = ‖f c + f c‖, + from norm_eq_on_of_is_preconnected_of_is_max_on hc ho (hd.add_const _) hcU hm.norm_add_self hx, +eq_of_norm_eq_of_norm_add_eq H₁ $ by simp only [H₂, same_ray.rfl.norm_add, H₁] + +/-- **Maximum modulus principle** on a connected set. Let `U` be a (pre)connected open set in a +complex normed space. Let `f : E → F` be a function that is complex differentiable on `U` and is +continuous on its closure. Suppose that `‖f x‖` takes its maximum value on `U` at `c ∈ U`. Then +`f x = f c` for all `x ∈ closure U`. -/ +lemma eq_on_closure_of_is_preconnected_of_is_max_on_norm {f : E → F} {U : set E} {c : E} + (hc : is_preconnected U) (ho : is_open U) (hd : diff_cont_on_cl ℂ f U) (hcU : c ∈ U) + (hm : is_max_on (norm ∘ f) U c) : + eq_on f (const E (f c)) (closure U) := +(eq_on_of_is_preconnected_of_is_max_on_norm hc ho hd.differentiable_on hcU hm).of_subset_closure + hd.continuous_on continuous_on_const subset_closure subset.rfl + +/-- **Maximum modulus principle**. Let `f : E → F` be a function between complex normed spaces. +Suppose that the codomain `F` is a strictly convex space, `f` is complex differentiable on a set +`s`, `f` is continuous on the closure of `s`, the norm of `f` takes it maximum on `s` at `z`, and +`w` is a point such that the closed ball with center `z` and radius `dist w z` is included in `s`, +then `f w = f z`. -/ +lemma eq_of_is_max_on_of_ball_subset {f : E → F} {s : set E} {z w : E} (hd : diff_cont_on_cl ℂ f s) + (hz : is_max_on (norm ∘ f) s z) (hsub : ball z (dist w z) ⊆ s) : + f w = f z := +have H₁ : ‖f w‖ = ‖f z‖, from norm_eq_norm_of_is_max_on_of_ball_subset hd hz hsub, +have H₂ : ‖f w + f z‖ = ‖f z + f z‖, + from norm_eq_norm_of_is_max_on_of_ball_subset (hd.add_const _) hz.norm_add_self hsub, +eq_of_norm_eq_of_norm_add_eq H₁ $ by simp only [H₂, same_ray.rfl.norm_add, H₁] + +/-- **Maximum modulus principle** on a closed ball. Suppose that a function `f : E → F` from a +normed complex space to a strictly convex normed complex space has the following properties: + +- it is continuous on a closed ball `metric.closed_ball z r`, +- it is complex differentiable on the corresponding open ball; +- the norm `‖f w‖` takes its maximum value on the open ball at its center. + +Then `f` is a constant on the closed ball. -/ +lemma eq_on_closed_ball_of_is_max_on_norm {f : E → F} {z : E} {r : ℝ} + (hd : diff_cont_on_cl ℂ f (ball z r)) (hz : is_max_on (norm ∘ f) (ball z r) z) : + eq_on f (const E (f z)) (closed_ball z r) := +λ x hx, eq_of_is_max_on_of_ball_subset hd hz $ ball_subset_ball hx + +/-- **Maximum modulus principle**: if `f : E → F` is complex differentiable in a neighborhood of `c` +and the norm `‖f z‖` has a local maximum at `c`, then `f` is locally constant in a neighborhood +of `c`. -/ +lemma eventually_eq_of_is_local_max_norm {f : E → F} {c : E} + (hd : ∀ᶠ z in 𝓝 c, differentiable_at ℂ f z) (hc : is_local_max (norm ∘ f) c) : + ∀ᶠ y in 𝓝 c, f y = f c := +begin + rcases nhds_basis_closed_ball.eventually_iff.1 (hd.and hc) with ⟨r, hr₀, hr⟩, + exact nhds_basis_closed_ball.eventually_iff.2 ⟨r, hr₀, eq_on_closed_ball_of_is_max_on_norm + (differentiable_on.diff_cont_on_cl $ + λ x hx, (hr $ closure_ball_subset_closed_ball hx).1.differentiable_within_at) + (λ x hx, (hr $ ball_subset_closed_ball hx).2)⟩ +end + +lemma eventually_eq_or_eq_zero_of_is_local_min_norm {f : E → ℂ} {c : E} + (hf : ∀ᶠ z in 𝓝 c, differentiable_at ℂ f z) (hc : is_local_min (norm ∘ f) c) : + (∀ᶠ z in 𝓝 c, f z = f c) ∨ (f c = 0) := +begin + refine or_iff_not_imp_right.mpr (λ h, _), + have h1 : ∀ᶠ z in 𝓝 c, f z ≠ 0 := hf.self_of_nhds.continuous_at.eventually_ne h, + have h2 : is_local_max (norm ∘ f)⁻¹ c := hc.inv (h1.mono (λ z, norm_pos_iff.mpr)), + have h3 : is_local_max (norm ∘ f⁻¹) c := by { refine h2.congr (eventually_of_forall _); simp }, + have h4 : ∀ᶠ z in 𝓝 c, differentiable_at ℂ f⁻¹ z, by filter_upwards [hf, h1] with z h using h.inv, + filter_upwards [eventually_eq_of_is_local_max_norm h4 h3] with z using inv_inj.mp +end + +end strict_convex + +/-! +### Maximum on a set vs maximum on its frontier + +In this section we prove corollaries of the maximum modulus principle that relate the values of a +function on a set to its values on the frontier of this set. +-/ + +variable [nontrivial E] + /-- **Maximum modulus principle**: if `f : E → F` is complex differentiable on a nonempty bounded set `U` and is continuous on its closure, then there exists a point `z ∈ frontier U` such that -`λ z, ∥f z∥` takes it maximum value on `closure U` at `z`. -/ -lemma exists_mem_frontier_is_max_on_norm [nontrivial E] [finite_dimensional ℂ E] - {f : E → F} {U : set E} (hb : bounded U) (hne : U.nonempty) (hd : diff_cont_on_cl ℂ f U) : +`λ z, ‖f z‖` takes it maximum value on `closure U` at `z`. -/ +lemma exists_mem_frontier_is_max_on_norm [finite_dimensional ℂ E] {f : E → F} {U : set E} + (hb : bounded U) (hne : U.nonempty) (hd : diff_cont_on_cl ℂ f U) : ∃ z ∈ frontier U, is_max_on (norm ∘ f) (closure U) z := begin have hc : is_compact (closure U), from hb.is_compact_closure, obtain ⟨w, hwU, hle⟩ : ∃ w ∈ closure U, is_max_on (norm ∘ f) (closure U) w, from hc.exists_forall_ge hne.closure hd.continuous_on.norm, - rw [closure_eq_interior_union_frontier, mem_union_eq] at hwU, + rw [closure_eq_interior_union_frontier, mem_union] at hwU, cases hwU, rotate, { exact ⟨w, hwU, hle⟩ }, have : interior U ≠ univ, from ne_top_of_le_ne_top hc.ne_univ interior_subset_closure, rcases exists_mem_frontier_inf_dist_compl_eq_dist hwU this with ⟨z, hzU, hzw⟩, refine ⟨z, frontier_interior_subset hzU, λ x hx, (mem_set_of_eq.mp $ hle hx).trans_eq _⟩, - refine (norm_eq_norm_of_is_max_on_of_closed_ball_subset hd (hle.on_subset subset_closure) _).symm, + refine (norm_eq_norm_of_is_max_on_of_ball_subset hd (hle.on_subset subset_closure) _).symm, rw [dist_comm, ← hzw], exact ball_inf_dist_compl_subset.trans interior_subset end /-- **Maximum modulus principle**: if `f : E → F` is complex differentiable on a bounded set `U` and -`∥f z∥ ≤ C` for any `z ∈ frontier U`, then the same is true for any `z ∈ closure U`. -/ -lemma norm_le_of_forall_mem_frontier_norm_le [nontrivial E] {f : E → F} {U : set E} (hU : bounded U) - (hd : diff_cont_on_cl ℂ f U) {C : ℝ} (hC : ∀ z ∈ frontier U, ∥f z∥ ≤ C) +`‖f z‖ ≤ C` for any `z ∈ frontier U`, then the same is true for any `z ∈ closure U`. -/ +lemma norm_le_of_forall_mem_frontier_norm_le {f : E → F} {U : set E} (hU : bounded U) + (hd : diff_cont_on_cl ℂ f U) {C : ℝ} (hC : ∀ z ∈ frontier U, ‖f z‖ ≤ C) {z : E} (hz : z ∈ closure U) : - ∥f z∥ ≤ C := + ‖f z‖ ≤ C := begin - rw [closure_eq_self_union_frontier, union_comm, mem_union_eq] at hz, + rw [closure_eq_self_union_frontier, union_comm, mem_union] at hz, cases hz, { exact hC z hz }, /- In case of a finite dimensional domain, one can just apply `complex.exists_mem_frontier_is_max_on_norm`. To make it work in any Banach space, we restrict @@ -221,25 +413,25 @@ begin from hd.comp hde.diff_cont_on_cl (maps_to_preimage _ _), have h₀ : (0 : ℂ) ∈ e ⁻¹' U, by simpa only [e, mem_preimage, line_map_apply_zero], rcases exists_mem_frontier_is_max_on_norm (hL.bounded_preimage hU) ⟨0, h₀⟩ hd with ⟨ζ, hζU, hζ⟩, - calc ∥f z∥ = ∥f (e 0)∥ : by simp only [e, line_map_apply_zero] - ... ≤ ∥f (e ζ)∥ : hζ (subset_closure h₀) + calc ‖f z‖ = ‖f (e 0)‖ : by simp only [e, line_map_apply_zero] + ... ≤ ‖f (e ζ)‖ : hζ (subset_closure h₀) ... ≤ C : hC _ (hde.continuous.frontier_preimage_subset _ hζU) end /-- If two complex differentiable functions `f g : E → F` are equal on the boundary of a bounded set `U`, then they are equal on `closure U`. -/ -lemma eq_on_closure_of_eq_on_frontier [nontrivial E] {f g : E → F} {U : set E} (hU : bounded U) +lemma eq_on_closure_of_eq_on_frontier {f g : E → F} {U : set E} (hU : bounded U) (hf : diff_cont_on_cl ℂ f U) (hg : diff_cont_on_cl ℂ g U) (hfg : eq_on f g (frontier U)) : eq_on f g (closure U) := begin - suffices H : ∀ z ∈ closure U, ∥(f - g) z∥ ≤ 0, by simpa [sub_eq_zero] using H, + suffices H : ∀ z ∈ closure U, ‖(f - g) z‖ ≤ 0, by simpa [sub_eq_zero] using H, refine λ z hz, norm_le_of_forall_mem_frontier_norm_le hU (hf.sub hg) (λ w hw, _) hz, simp [hfg hw] end /-- If two complex differentiable functions `f g : E → F` are equal on the boundary of a bounded set `U`, then they are equal on `U`. -/ -lemma eq_on_of_eq_on_frontier [nontrivial E] {f g : E → F} {U : set E} (hU : bounded U) +lemma eq_on_of_eq_on_frontier {f g : E → F} {U : set E} (hU : bounded U) (hf : diff_cont_on_cl ℂ f U) (hg : diff_cont_on_cl ℂ g U) (hfg : eq_on f g (frontier U)) : eq_on f g U := (eq_on_closure_of_eq_on_frontier hU hf hg hfg).mono subset_closure diff --git a/src/analysis/complex/arg.lean b/src/analysis/complex/arg.lean index 919daf70a0dcb..3ca878c0a8de3 100644 --- a/src/analysis/complex/arg.lean +++ b/src/analysis/complex/arg.lean @@ -10,6 +10,9 @@ import analysis.special_functions.complex.arg /-! # Rays in the complex numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file links the definition `same_ray ℝ x y` with the equality of arguments of complex numbers, the usual way this is considered. @@ -17,8 +20,8 @@ the usual way this is considered. * `complex.same_ray_iff` : Two complex numbers are on the same ray iff one of them is zero, or they have the same argument. -* `complex.abs_add_eq/complex.abs_sub_eq`: If two non zero complex numbers have different argument, - then the triangle inequality becomes strict. +* `complex.abs_add_eq/complex.abs_sub_eq`: If two non zero complex numbers have the same argument, + then the triangle inequality is an equality. -/ @@ -37,6 +40,14 @@ begin rw [mul_comm, eq_comm] end +lemma same_ray_iff_arg_div_eq_zero : same_ray ℝ x y ↔ arg (x / y) = 0 := +begin + rw [←real.angle.to_real_zero, ←arg_coe_angle_eq_iff_eq_to_real, same_ray_iff], + by_cases hx : x = 0, { simp [hx] }, + by_cases hy : y = 0, { simp [hy] }, + simp [hx, hy, arg_div_coe_angle, sub_eq_zero] +end + lemma abs_add_eq_iff : (x + y).abs = x.abs + y.abs ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg := same_ray_iff_norm_add.symm.trans same_ray_iff @@ -49,7 +60,7 @@ same_ray_iff.mpr $ or.inr $ or.inr h lemma abs_add_eq (h : x.arg = y.arg) : (x + y).abs = x.abs + y.abs := (same_ray_of_arg_eq h).norm_add -lemma abs_sub_eq (h : x.arg = y.arg) : (x - y).abs = ∥x.abs - y.abs∥ := +lemma abs_sub_eq (h : x.arg = y.arg) : (x - y).abs = ‖x.abs - y.abs‖ := (same_ray_of_arg_eq h).norm_sub end complex diff --git a/src/analysis/complex/basic.lean b/src/analysis/complex/basic.lean index ee6c02c4604af..9b8097b45dcf2 100644 --- a/src/analysis/complex/basic.lean +++ b/src/analysis/complex/basic.lean @@ -3,12 +3,18 @@ Copyright (c) Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ -import data.complex.determinant -import data.complex.is_R_or_C +import data.complex.module +import data.complex.exponential +import data.is_R_or_C.basic +import topology.algebra.infinite_sum.module +import topology.instances.real_vector_space /-! # Normed space structure on `ℂ`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file gathers basic facts on complex numbers of an analytic nature. ## Main results @@ -28,66 +34,108 @@ isometries in `of_real_li` and `conj_lie`. We also register the fact that `ℂ` is an `is_R_or_C` field. -/ -noncomputable theory +assert_not_exists absorbs + +noncomputable theory namespace complex -open_locale complex_conjugate +open_locale complex_conjugate topology instance : has_norm ℂ := ⟨abs⟩ -@[simp] lemma norm_eq_abs (z : ℂ) : ∥z∥ = abs z := rfl +@[simp] lemma norm_eq_abs (z : ℂ) : ‖z‖ = abs z := rfl + +lemma norm_exp_of_real_mul_I (t : ℝ) : ‖exp (t * I)‖ = 1 := +by simp only [norm_eq_abs, abs_exp_of_real_mul_I] -instance : normed_group ℂ := -normed_group.of_core ℂ -{ norm_eq_zero_iff := λ z, abs_eq_zero, - triangle := abs_add, - norm_neg := abs_neg } +instance : normed_add_comm_group ℂ := +add_group_norm.to_normed_add_comm_group +{ map_zero' := map_zero abs, + neg' := abs.map_neg, + eq_zero_of_map_eq_zero' := λ _, abs.eq_zero.1, + ..abs } instance : normed_field ℂ := { norm := abs, dist_eq := λ _ _, rfl, - norm_mul' := abs_mul, - .. complex.field } + norm_mul' := map_mul abs, + .. complex.field, .. complex.normed_add_comm_group } -instance : nondiscrete_normed_field ℂ := -{ non_trivial := ⟨2, by simp; norm_num⟩ } +instance : densely_normed_field ℂ := +{ lt_norm_lt := λ r₁ r₂ h₀ hr, let ⟨x, h⟩ := normed_field.exists_lt_norm_lt ℝ h₀ hr in + have this : ‖(‖x‖ : ℂ)‖ = ‖(‖x‖)‖, by simp only [norm_eq_abs, abs_of_real, real.norm_eq_abs], + ⟨‖x‖, by rwa [this, norm_norm]⟩ } instance {R : Type*} [normed_field R] [normed_algebra R ℝ] : normed_algebra R ℂ := { norm_smul_le := λ r x, begin - rw [norm_eq_abs, norm_eq_abs, ←algebra_map_smul ℝ r x, algebra.smul_def, abs_mul, - ←norm_algebra_map' ℝ r, coe_algebra_map, abs_of_real], + rw [norm_eq_abs, norm_eq_abs, ←algebra_map_smul ℝ r x, algebra.smul_def, map_mul, + ←norm_algebra_map' ℝ r, coe_algebra_map, abs_of_real], refl, end, to_algebra := complex.algebra } +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] + /-- The module structure from `module.complex_to_real` is a normed space. -/ @[priority 900] -- see Note [lower instance priority] -instance _root_.normed_space.complex_to_real {E : Type*} [normed_group E] [normed_space ℂ E] : - normed_space ℝ E := +instance _root_.normed_space.complex_to_real : normed_space ℝ E := normed_space.restrict_scalars ℝ ℂ E lemma dist_eq (z w : ℂ) : dist z w = abs (z - w) := rfl -lemma dist_self_conj (z : ℂ) : dist z (conj z) = 2 * |z.im| := -by simp only [dist_eq, sub_conj, of_real_mul, of_real_bit0, of_real_one, abs_mul, abs_two, - abs_of_real, abs_I, mul_one] +lemma dist_eq_re_im (z w : ℂ) : dist z w = real.sqrt ((z.re - w.re) ^ 2 + (z.im - w.im) ^ 2) := +by { rw [sq, sq], refl } + +@[simp] lemma dist_mk (x₁ y₁ x₂ y₂ : ℝ) : + dist (mk x₁ y₁) (mk x₂ y₂) = real.sqrt ((x₁ - x₂) ^ 2 + (y₁ - y₂) ^ 2) := +dist_eq_re_im _ _ + +lemma dist_of_re_eq {z w : ℂ} (h : z.re = w.re) : dist z w = dist z.im w.im := +by rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, zero_add, real.sqrt_sq_eq_abs, real.dist_eq] + +lemma nndist_of_re_eq {z w : ℂ} (h : z.re = w.re) : nndist z w = nndist z.im w.im := +nnreal.eq $ dist_of_re_eq h + +lemma edist_of_re_eq {z w : ℂ} (h : z.re = w.re) : edist z w = edist z.im w.im := +by rw [edist_nndist, edist_nndist, nndist_of_re_eq h] + +lemma dist_of_im_eq {z w : ℂ} (h : z.im = w.im) : dist z w = dist z.re w.re := +by rw [dist_eq_re_im, h, sub_self, zero_pow two_pos, add_zero, real.sqrt_sq_eq_abs, real.dist_eq] + +lemma nndist_of_im_eq {z w : ℂ} (h : z.im = w.im) : nndist z w = nndist z.re w.re := +nnreal.eq $ dist_of_im_eq h + +lemma edist_of_im_eq {z w : ℂ} (h : z.im = w.im) : edist z w = edist z.re w.re := +by rw [edist_nndist, edist_nndist, nndist_of_im_eq h] lemma dist_conj_self (z : ℂ) : dist (conj z) z = 2 * |z.im| := -by rw [dist_comm, dist_self_conj] +by rw [dist_of_re_eq (conj_re z), conj_im, dist_comm, real.dist_eq, sub_neg_eq_add, ← two_mul, + _root_.abs_mul, abs_of_pos (zero_lt_two' ℝ)] + +lemma nndist_conj_self (z : ℂ) : nndist (conj z) z = 2 * real.nnabs z.im := +nnreal.eq $ by rw [← dist_nndist, nnreal.coe_mul, nnreal.coe_two, real.coe_nnabs, dist_conj_self] + +lemma dist_self_conj (z : ℂ) : dist z (conj z) = 2 * |z.im| := +by rw [dist_comm, dist_conj_self] -@[simp] lemma norm_real (r : ℝ) : ∥(r : ℂ)∥ = ∥r∥ := abs_of_real _ +lemma nndist_self_conj (z : ℂ) : nndist z (conj z) = 2 * real.nnabs z.im := +by rw [nndist_comm, nndist_conj_self] -@[simp] lemma norm_rat (r : ℚ) : ∥(r : ℂ)∥ = |(r : ℝ)| := +@[simp] lemma comap_abs_nhds_zero : filter.comap abs (𝓝 0) = 𝓝 0 := comap_norm_nhds_zero + +lemma norm_real (r : ℝ) : ‖(r : ℂ)‖ = ‖r‖ := abs_of_real _ + +@[simp] lemma norm_rat (r : ℚ) : ‖(r : ℂ)‖ = |(r : ℝ)| := by { rw ← of_real_rat_cast, exact norm_real _ } -@[simp] lemma norm_nat (n : ℕ) : ∥(n : ℂ)∥ = n := abs_of_nat _ +@[simp] lemma norm_nat (n : ℕ) : ‖(n : ℂ)‖ = n := abs_of_nat _ -@[simp] lemma norm_int {n : ℤ} : ∥(n : ℂ)∥ = |n| := +@[simp] lemma norm_int {n : ℤ} : ‖(n : ℂ)‖ = |n| := by simp [← rat.cast_coe_int] {single_pass := tt} -lemma norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ∥(n : ℂ)∥ = n := +lemma norm_int_of_nonneg {n : ℤ} (hn : 0 ≤ n) : ‖(n : ℂ)‖ = n := by simp [hn] @[continuity] lemma continuous_abs : continuous abs := continuous_norm @@ -95,26 +143,56 @@ by simp [hn] @[continuity] lemma continuous_norm_sq : continuous norm_sq := by simpa [← norm_sq_eq_abs] using continuous_abs.pow 2 -@[simp, norm_cast] lemma nnnorm_real (r : ℝ) : ∥(r : ℂ)∥₊ = ∥r∥₊ := +@[simp, norm_cast] lemma nnnorm_real (r : ℝ) : ‖(r : ℂ)‖₊ = ‖r‖₊ := subtype.ext $ norm_real r -@[simp, norm_cast] lemma nnnorm_nat (n : ℕ) : ∥(n : ℂ)∥₊ = n := +@[simp, norm_cast] lemma nnnorm_nat (n : ℕ) : ‖(n : ℂ)‖₊ = n := subtype.ext $ by simp -@[simp, norm_cast] lemma nnnorm_int (n : ℤ) : ∥(n : ℂ)∥₊ = ∥n∥₊ := +@[simp, norm_cast] lemma nnnorm_int (n : ℤ) : ‖(n : ℂ)‖₊ = ‖n‖₊ := subtype.ext $ by simp only [coe_nnnorm, norm_int, int.norm_eq_abs] lemma nnnorm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) : - ∥ζ∥₊ = 1 := + ‖ζ‖₊ = 1 := begin refine (@pow_left_inj nnreal _ _ _ _ zero_le' zero_le' hn.bot_lt).mp _, rw [←nnnorm_pow, h, nnnorm_one, one_pow], end lemma norm_eq_one_of_pow_eq_one {ζ : ℂ} {n : ℕ} (h : ζ ^ n = 1) (hn : n ≠ 0) : - ∥ζ∥ = 1 := + ‖ζ‖ = 1 := congr_arg coe (nnnorm_eq_one_of_pow_eq_one h hn) +lemma equiv_real_prod_apply_le (z : ℂ) : ‖equiv_real_prod z‖ ≤ abs z := +by simp [prod.norm_def, abs_re_le_abs, abs_im_le_abs] + +lemma equiv_real_prod_apply_le' (z : ℂ) : ‖equiv_real_prod z‖ ≤ 1 * abs z := +by simpa using equiv_real_prod_apply_le z + +lemma lipschitz_equiv_real_prod : lipschitz_with 1 equiv_real_prod := +by simpa using + add_monoid_hom_class.lipschitz_of_bound equiv_real_prod_lm 1 equiv_real_prod_apply_le' + +lemma antilipschitz_equiv_real_prod : antilipschitz_with (nnreal.sqrt 2) equiv_real_prod := +by simpa using + add_monoid_hom_class.antilipschitz_of_bound equiv_real_prod_lm abs_le_sqrt_two_mul_max + +lemma uniform_embedding_equiv_real_prod : uniform_embedding equiv_real_prod := +antilipschitz_equiv_real_prod.uniform_embedding lipschitz_equiv_real_prod.uniform_continuous + +instance : complete_space ℂ := +(complete_space_congr uniform_embedding_equiv_real_prod).mpr infer_instance + +/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/ +@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }] +def equiv_real_prod_clm : ℂ ≃L[ℝ] ℝ × ℝ := +equiv_real_prod_lm.to_continuous_linear_equiv_of_bounds 1 (real.sqrt 2) +equiv_real_prod_apply_le' +(λ p, abs_le_sqrt_two_mul_max (equiv_real_prod.symm p)) + +instance : proper_space ℂ := +(id lipschitz_equiv_real_prod : lipschitz_with 1 equiv_real_prod_clm.to_homeomorph).proper_space + /-- The `abs` function on `ℂ` is proper. -/ lemma tendsto_abs_cocompact_at_top : filter.tendsto abs (filter.cocompact ℂ) filter.at_top := tendsto_norm_cocompact_at_top @@ -128,7 +206,7 @@ by simpa [mul_self_abs] using open continuous_linear_map /-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/ -def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_re_le_abs]) +def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [abs_re_le_abs]) @[continuity] lemma continuous_re : continuous re := re_clm.continuous @@ -136,15 +214,8 @@ def re_clm : ℂ →L[ℝ] ℝ := re_lm.mk_continuous 1 (λ x, by simp [real.nor @[simp] lemma re_clm_apply (z : ℂ) : (re_clm : ℂ → ℝ) z = z.re := rfl -@[simp] lemma re_clm_norm : ∥re_clm∥ = 1 := -le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $ -calc 1 = ∥re_clm 1∥ : by simp - ... ≤ ∥re_clm∥ : unit_le_op_norm _ _ (by simp) - -@[simp] lemma re_clm_nnnorm : ∥re_clm∥₊ = 1 := subtype.ext re_clm_norm - /-- Continuous linear map version of the real part function, from `ℂ` to `ℝ`. -/ -def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [real.norm_eq_abs, abs_im_le_abs]) +def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [abs_im_le_abs]) @[continuity] lemma continuous_im : continuous im := im_clm.continuous @@ -152,14 +223,7 @@ def im_clm : ℂ →L[ℝ] ℝ := im_lm.mk_continuous 1 (λ x, by simp [real.nor @[simp] lemma im_clm_apply (z : ℂ) : (im_clm : ℂ → ℝ) z = z.im := rfl -@[simp] lemma im_clm_norm : ∥im_clm∥ = 1 := -le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $ -calc 1 = ∥im_clm I∥ : by simp - ... ≤ ∥im_clm∥ : unit_le_op_norm _ _ (by simp) - -@[simp] lemma im_clm_nnnorm : ∥im_clm∥₊ = 1 := subtype.ext im_clm_norm - -lemma restrict_scalars_one_smul_right' {E : Type*} [normed_group E] [normed_space ℂ E] (x : E) : +lemma restrict_scalars_one_smul_right' (x : E) : continuous_linear_map.restrict_scalars ℝ ((1 : ℂ →L[ℂ] ℂ).smul_right x : ℂ →L[ℂ] E) = re_clm.smul_right x + I • im_clm.smul_right x := by { ext ⟨a, b⟩, simp [mk_eq_add_mul_I, add_smul, mul_smul, smul_comm I] } @@ -189,18 +253,19 @@ by rw [← dist_conj_conj, conj_conj] lemma nndist_conj_comm (z w : ℂ) : nndist (conj z) w = nndist z (conj w) := subtype.ext $ dist_conj_comm _ _ -/-- The determinant of `conj_lie`, as a linear map. -/ -@[simp] lemma det_conj_lie : (conj_lie.to_linear_equiv : ℂ →ₗ[ℝ] ℂ).det = -1 := -det_conj_ae - -/-- The determinant of `conj_lie`, as a linear equiv. -/ -@[simp] lemma linear_equiv_det_conj_lie : conj_lie.to_linear_equiv.det = -1 := -linear_equiv_det_conj_ae - instance : has_continuous_star ℂ := ⟨conj_lie.continuous⟩ @[continuity] lemma continuous_conj : continuous (conj : ℂ → ℂ) := continuous_star +/-- The only continuous ring homomorphisms from `ℂ` to `ℂ` are the identity and the complex +conjugation. -/ +lemma ring_hom_eq_id_or_conj_of_continuous {f : ℂ →+* ℂ} (hf : continuous f) : + f = ring_hom.id ℂ ∨ f = conj := +begin + refine (real_alg_hom_eq_id_or_conj $ alg_hom.mk' f $ map_real_smul f hf).imp (λ h, _) (λ h, _), + all_goals { convert congr_arg alg_hom.to_ring_hom h, ext1, refl, }, +end + /-- Continuous linear equiv version of the conj function, from `ℂ` to `ℂ`. -/ def conj_cle : ℂ ≃L[ℝ] ℂ := conj_lie @@ -208,11 +273,6 @@ def conj_cle : ℂ ≃L[ℝ] ℂ := conj_lie @[simp] lemma conj_cle_apply (z : ℂ) : conj_cle z = conj z := rfl -@[simp] lemma conj_cle_norm : ∥(conj_cle : ℂ →L[ℝ] ℂ)∥ = 1 := -conj_lie.to_linear_isometry.norm_to_continuous_linear_map - -@[simp] lemma conj_cle_nnorm : ∥(conj_cle : ℂ →L[ℝ] ℂ)∥₊ = 1 := subtype.ext conj_cle_norm - /-- Linear isometry version of the canonical embedding of `ℝ` in `ℂ`. -/ def of_real_li : ℝ →ₗᵢ[ℝ] ℂ := ⟨of_real_am.to_linear_map, norm_real⟩ @@ -220,6 +280,15 @@ lemma isometry_of_real : isometry (coe : ℝ → ℂ) := of_real_li.isometry @[continuity] lemma continuous_of_real : continuous (coe : ℝ → ℂ) := of_real_li.continuous +/-- The only continuous ring homomorphism from `ℝ` to `ℂ` is the identity. -/ +lemma ring_hom_eq_of_real_of_continuous {f : ℝ →+* ℂ} (h : continuous f) : + f = complex.of_real := +begin + convert congr_arg alg_hom.to_ring_hom + (subsingleton.elim (alg_hom.mk' f $ map_real_smul f h) $ algebra.of_id ℝ ℂ), + ext1, refl, +end + /-- Continuous linear map version of the canonical embedding of `ℝ` in `ℂ`. -/ def of_real_clm : ℝ →L[ℝ] ℂ := of_real_li.to_continuous_linear_map @@ -227,10 +296,6 @@ def of_real_clm : ℝ →L[ℝ] ℂ := of_real_li.to_continuous_linear_map @[simp] lemma of_real_clm_apply (x : ℝ) : of_real_clm x = x := rfl -@[simp] lemma of_real_clm_norm : ∥of_real_clm∥ = 1 := of_real_li.norm_to_continuous_linear_map - -@[simp] lemma of_real_clm_nnnorm : ∥of_real_clm∥₊ = 1 := subtype.ext $ of_real_clm_norm - noncomputable instance : is_R_or_C ℂ := { re := ⟨complex.re, complex.zero_re, complex.add_re⟩, im := ⟨complex.im, complex.zero_im, complex.add_im⟩, @@ -250,64 +315,152 @@ noncomputable instance : is_R_or_C ℂ := conj_I_ax := by simp only [complex.conj_I, ring_hom.coe_mk], norm_sq_eq_def_ax := λ z, by simp only [←complex.norm_sq_eq_abs, ←complex.norm_sq_apply, add_monoid_hom.coe_mk, complex.norm_eq_abs], - mul_im_I_ax := λ z, by simp only [mul_one, add_monoid_hom.coe_mk, complex.I_im], - inv_def_ax := λ z, by simp only [complex.inv_def, complex.norm_sq_eq_abs, complex.coe_algebra_map, - complex.of_real_eq_coe, complex.norm_eq_abs], - div_I_ax := complex.div_I } + mul_im_I_ax := λ z, by simp only [mul_one, add_monoid_hom.coe_mk, complex.I_im] } lemma _root_.is_R_or_C.re_eq_complex_re : ⇑(is_R_or_C.re : ℂ →+ ℝ) = complex.re := rfl lemma _root_.is_R_or_C.im_eq_complex_im : ⇑(is_R_or_C.im : ℂ →+ ℝ) = complex.im := rfl -section - -variables {α β γ : Type*} - [add_comm_monoid α] [topological_space α] [add_comm_monoid γ] [topological_space γ] - -/-- The natural `add_equiv` from `ℂ` to `ℝ × ℝ`. -/ -@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }] -def equiv_real_prod_add_hom : ℂ ≃+ ℝ × ℝ := -{ map_add' := by simp, .. equiv_real_prod } - -/-- The natural `linear_equiv` from `ℂ` to `ℝ × ℝ`. -/ -@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }] -def equiv_real_prod_add_hom_lm : ℂ ≃ₗ[ℝ] ℝ × ℝ := -{ map_smul' := by simp [equiv_real_prod_add_hom], .. equiv_real_prod_add_hom } - -/-- The natural `continuous_linear_equiv` from `ℂ` to `ℝ × ℝ`. -/ -@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }] -def equiv_real_prodₗ : ℂ ≃L[ℝ] ℝ × ℝ := -equiv_real_prod_add_hom_lm.to_continuous_linear_equiv +section complex_order +open_locale complex_order -end +lemma eq_coe_norm_of_nonneg {z : ℂ} (hz : 0 ≤ z) : z = ↑‖z‖ := +by rw [eq_re_of_real_le hz, is_R_or_C.norm_of_real, _root_.abs_of_nonneg (complex.le_def.2 hz).1] -lemma has_sum_iff {α} (f : α → ℂ) (c : ℂ) : - has_sum f c ↔ has_sum (λ x, (f x).re) c.re ∧ has_sum (λ x, (f x).im) c.im := -begin - -- For some reason, `continuous_linear_map.has_sum` is orders of magnitude faster than - -- `has_sum.mapL` here: - refine ⟨λ h, ⟨re_clm.has_sum h, im_clm.has_sum h⟩, _⟩, - rintro ⟨h₁, h₂⟩, - convert (h₁.prod_mk h₂).mapL equiv_real_prodₗ.symm.to_continuous_linear_map, - { ext x; refl }, - { cases c, refl } -end +end complex_order end complex namespace is_R_or_C +open_locale complex_conjugate + local notation `reC` := @is_R_or_C.re ℂ _ local notation `imC` := @is_R_or_C.im ℂ _ local notation `IC` := @is_R_or_C.I ℂ _ -local notation `absC` := @is_R_or_C.abs ℂ _ local notation `norm_sqC` := @is_R_or_C.norm_sq ℂ _ @[simp] lemma re_to_complex {x : ℂ} : reC x = x.re := rfl @[simp] lemma im_to_complex {x : ℂ} : imC x = x.im := rfl @[simp] lemma I_to_complex : IC = complex.I := rfl -@[simp] lemma norm_sq_to_complex {x : ℂ} : norm_sqC x = complex.norm_sq x := -by simp [is_R_or_C.norm_sq, complex.norm_sq] -@[simp] lemma abs_to_complex {x : ℂ} : absC x = complex.abs x := -by simp [is_R_or_C.abs, complex.abs] +@[simp] lemma norm_sq_to_complex {x : ℂ} : norm_sqC x = complex.norm_sq x := rfl + +section tsum +variables {α : Type*} (𝕜 : Type*) [is_R_or_C 𝕜] + +@[simp] lemma has_sum_conj {f : α → 𝕜} {x : 𝕜} : + has_sum (λ x, conj (f x)) x ↔ has_sum f (conj x) := +conj_cle.has_sum + +lemma has_sum_conj' {f : α → 𝕜} {x : 𝕜} : has_sum (λ x, conj (f x)) (conj x) ↔ has_sum f x := +conj_cle.has_sum' + +@[simp] lemma summable_conj {f : α → 𝕜} : summable (λ x, conj (f x)) ↔ summable f := +summable_star_iff + +variables {𝕜} + +lemma conj_tsum (f : α → 𝕜) : conj (∑' a, f a) = ∑' a, conj (f a) := +tsum_star + +variables (𝕜) + +@[simp, norm_cast] lemma has_sum_of_real {f : α → ℝ} {x : ℝ} : + has_sum (λ x, (f x : 𝕜)) x ↔ has_sum f x := +⟨λ h, by simpa only [is_R_or_C.re_clm_apply, is_R_or_C.of_real_re] using re_clm.has_sum h, + of_real_clm.has_sum⟩ + +@[simp, norm_cast] lemma summable_of_real {f : α → ℝ} : summable (λ x, (f x : 𝕜)) ↔ summable f := +⟨λ h, by simpa only [is_R_or_C.re_clm_apply, is_R_or_C.of_real_re] using re_clm.summable h, + of_real_clm.summable⟩ + +@[norm_cast] lemma of_real_tsum (f : α → ℝ) : (↑(∑' a, f a) : 𝕜) = ∑' a, f a := +begin + by_cases h : summable f, + { exact continuous_linear_map.map_tsum of_real_clm h }, + { rw [tsum_eq_zero_of_not_summable h, + tsum_eq_zero_of_not_summable ((summable_of_real _).not.mpr h), of_real_zero] } +end + +lemma has_sum_re {f : α → 𝕜} {x : 𝕜} (h : has_sum f x) : has_sum (λ x, re (f x)) (re x) := +re_clm.has_sum h + +lemma has_sum_im {f : α → 𝕜} {x : 𝕜} (h : has_sum f x) : has_sum (λ x, im (f x)) (im x) := +im_clm.has_sum h + +lemma re_tsum {f : α → 𝕜} (h : summable f) : re (∑' a, f a) = ∑' a, re (f a) := +re_clm.map_tsum h + +lemma im_tsum {f : α → 𝕜} (h : summable f) : im (∑' a, f a) = ∑' a, im (f a) := +im_clm.map_tsum h + +variables {𝕜} + +lemma has_sum_iff (f : α → 𝕜) (c : 𝕜) : + has_sum f c ↔ has_sum (λ x, re (f x)) (re c) ∧ has_sum (λ x, im (f x)) (im c) := +begin + refine ⟨λ h, ⟨has_sum_re _ h, has_sum_im _ h⟩, _⟩, + rintro ⟨h₁, h₂⟩, + rw ←is_R_or_C.re_add_im c, + convert ((has_sum_of_real 𝕜).mpr h₁).add (((has_sum_of_real 𝕜).mpr h₂).mul_right I), + simp_rw is_R_or_C.re_add_im, +end + +end tsum end is_R_or_C + +namespace complex +/-! +We have to repeat the lemmas about `is_R_or_C.re` and `is_R_or_C.im` as they are not syntactic +matches for `complex.re` and `complex.im`. + +We do not have this problem with `of_real` and `conj`, although we repeat them anyway for +discoverability and to avoid the need to unify `𝕜`. +-/ +section tsum +variables {α : Type*} + +open_locale complex_conjugate + +@[simp] lemma has_sum_conj {f : α → ℂ} {x : ℂ} : + has_sum (λ x, conj (f x)) x ↔ has_sum f (conj x) := +is_R_or_C.has_sum_conj _ + +lemma has_sum_conj' {f : α → ℂ} {x : ℂ} : has_sum (λ x, conj (f x)) (conj x) ↔ has_sum f x := +is_R_or_C.has_sum_conj' _ + +@[simp] lemma summable_conj {f : α → ℂ} : summable (λ x, conj (f x)) ↔ summable f := +is_R_or_C.summable_conj _ + +lemma conj_tsum (f : α → ℂ) : conj (∑' a, f a) = ∑' a, conj (f a) := +is_R_or_C.conj_tsum _ + +@[simp, norm_cast] lemma has_sum_of_real {f : α → ℝ} {x : ℝ} : + has_sum (λ x, (f x : ℂ)) x ↔ has_sum f x := +is_R_or_C.has_sum_of_real _ + +@[simp, norm_cast] lemma summable_of_real {f : α → ℝ} : summable (λ x, (f x : ℂ)) ↔ summable f := +is_R_or_C.summable_of_real _ + +@[norm_cast] lemma of_real_tsum (f : α → ℝ) : (↑(∑' a, f a) : ℂ) = ∑' a, f a := +is_R_or_C.of_real_tsum _ _ + +lemma has_sum_re {f : α → ℂ} {x : ℂ} (h : has_sum f x) : has_sum (λ x, (f x).re) x.re := +is_R_or_C.has_sum_re _ h + +lemma has_sum_im {f : α → ℂ} {x : ℂ} (h : has_sum f x) : has_sum (λ x, (f x).im) x.im := +is_R_or_C.has_sum_im _ h + +lemma re_tsum {f : α → ℂ} (h : summable f) : (∑' a, f a).re = ∑' a, (f a).re := +is_R_or_C.re_tsum _ h + +lemma im_tsum {f : α → ℂ} (h : summable f) : (∑' a, f a).im = ∑' a, (f a).im := +is_R_or_C.im_tsum _ h + +lemma has_sum_iff (f : α → ℂ) (c : ℂ) : + has_sum f c ↔ has_sum (λ x, (f x).re) c.re ∧ has_sum (λ x, (f x).im) c.im := +is_R_or_C.has_sum_iff _ _ + +end tsum + +end complex diff --git a/src/analysis/complex/cauchy_integral.lean b/src/analysis/complex/cauchy_integral.lean index 5263bbb4a1ec8..7e49ef907682b 100644 --- a/src/analysis/complex/cauchy_integral.lean +++ b/src/analysis/complex/cauchy_integral.lean @@ -3,18 +3,21 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import measure_theory.measure.complex_lebesgue +import measure_theory.measure.lebesgue.complex import measure_theory.integral.divergence_theorem import measure_theory.integral.circle_integral import analysis.calculus.dslope import analysis.analytic.basic import analysis.complex.re_im_topology -import analysis.calculus.diff_on_int_cont +import analysis.calculus.diff_cont_on_cl import data.real.cardinality /-! # Cauchy integral formula +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove the Cauchy-Goursat theorem and the Cauchy integral formula for integrals over circles. Most results are formulated for a function `f : ℂ → E` that takes values in a complex Banach space with second countable topology. @@ -143,13 +146,13 @@ Cauchy-Goursat theorem, Cauchy integral formula -/ open topological_space set measure_theory interval_integral metric filter function -open_locale interval real nnreal ennreal topological_space big_operators +open_locale interval real nnreal ennreal topology big_operators noncomputable theory universes u -variables {E : Type u} [normed_group E] [normed_space ℂ E] [complete_space E] +variables {E : Type u} [normed_add_comm_group E] [normed_space ℂ E] [complete_space E] namespace complex @@ -160,7 +163,7 @@ integral of `f` over the boundary of the rectangle is equal to the integral of $2i\frac{\partial f}{\partial \bar z}=i\frac{\partial f}{\partial x}-\frac{\partial f}{\partial y}$ over the rectangle. -/ lemma integral_boundary_rect_of_has_fderiv_at_real_off_countable (f : ℂ → E) - (f' : ℂ → ℂ →L[ℝ] E) (z w : ℂ) (s : set ℂ) (hs : countable s) + (f' : ℂ → ℂ →L[ℝ] E) (z w : ℂ) (s : set ℂ) (hs : s.countable) (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im])) (Hd : ∀ x ∈ (Ioo (min z.re w.re) (max z.re w.re) ×ℂ Ioo (min z.im w.im) (max z.im w.im)) \ s, has_fderiv_at f (f' x) x) @@ -169,17 +172,20 @@ lemma integral_boundary_rect_of_has_fderiv_at_real_off_countable (f : ℂ → E) (I • ∫ y : ℝ in z.im..w.im, f (re w + y * I)) - I • ∫ y : ℝ in z.im..w.im, f (re z + y * I) = ∫ x : ℝ in z.re..w.re, ∫ y : ℝ in z.im..w.im, I • f' (x + y * I) 1 - f' (x + y * I) I := begin - set e : (ℝ × ℝ) ≃L[ℝ] ℂ := equiv_real_prodₗ.symm, + set e : (ℝ × ℝ) ≃L[ℝ] ℂ := equiv_real_prod_clm.symm, have he : ∀ x y : ℝ, ↑x + ↑y * I = e (x, y), from λ x y, (mk_eq_add_mul_I x y).symm, have he₁ : e (1, 0) = 1 := rfl, have he₂ : e (0, 1) = I := rfl, simp only [he] at *, set F : (ℝ × ℝ) → E := f ∘ e, set F' : (ℝ × ℝ) → (ℝ × ℝ) →L[ℝ] E := λ p, (f' (e p)).comp (e : (ℝ × ℝ) →L[ℝ] ℂ), have hF' : ∀ p : ℝ × ℝ, (-(I • F' p)) (1, 0) + F' p (0, 1) = -(I • f' (e p) 1 - f' (e p) I), - { rintro ⟨x, y⟩, simp [F', he₁, he₂, ← sub_eq_neg_add], }, + { rintro ⟨x, y⟩, + simp only [continuous_linear_map.neg_apply, continuous_linear_map.smul_apply, F', + continuous_linear_map.comp_apply, continuous_linear_equiv.coe_coe, he₁, he₂, + neg_add_eq_sub, neg_sub], }, set R : set (ℝ × ℝ) := [z.re, w.re] ×ˢ [w.im, z.im], set t : set (ℝ × ℝ) := e ⁻¹' s, - rw [interval_swap z.im] at Hc Hi, rw [min_comm z.im, max_comm z.im] at Hd, + rw [uIcc_comm z.im] at Hc Hi, rw [min_comm z.im, max_comm z.im] at Hd, have hR : e ⁻¹' ([z.re, w.re] ×ℂ [w.im, z.im]) = R := rfl, have htc : continuous_on F R, from Hc.comp e.continuous_on hR.ge, have htd : ∀ p ∈ Ioo (min z.re w.re) (max z.re w.re) ×ˢ Ioo (min w.im z.im) (max w.im z.im) \ t, @@ -227,14 +233,14 @@ lemma integral_boundary_rect_of_differentiable_on_real (f : ℂ → E) (z w : integral_boundary_rect_of_has_fderiv_at_real_off_countable f (fderiv ℝ f) z w ∅ countable_empty Hd.continuous_on (λ x hx, Hd.has_fderiv_at $ by simpa only [← mem_interior_iff_mem_nhds, - interior_re_prod_im, interval, interior_Icc] using hx.1) Hi + interior_re_prod_im, uIcc, interior_Icc] using hx.1) Hi /-- **Cauchy-Goursat theorem** for a rectangle: the integral of a complex differentiable function over the boundary of a rectangle equals zero. More precisely, if `f` is continuous on a closed rectangle and is complex differentiable at all but countably many points of the corresponding open rectangle, then its integral over the boundary of the rectangle equals zero. -/ lemma integral_boundary_rect_eq_zero_of_differentiable_on_off_countable (f : ℂ → E) - (z w : ℂ) (s : set ℂ) (hs : countable s) (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im])) + (z w : ℂ) (s : set ℂ) (hs : s.countable) (Hc : continuous_on f ([z.re, w.re] ×ℂ [z.im, w.im])) (Hd : ∀ x ∈ (Ioo (min z.re w.re) (max z.re w.re) ×ℂ Ioo (min z.im w.im) (max z.im w.im)) \ s, differentiable_at ℂ f x) : (∫ x : ℝ in z.re..w.re, f (x + z.im * I)) - (∫ x : ℝ in z.re..w.re, f (x + w.im * I)) + @@ -271,12 +277,12 @@ integral_boundary_rect_eq_zero_of_continuous_on_of_differentiable_on f z w H.con H.mono $ inter_subset_inter (preimage_mono Ioo_subset_Icc_self) (preimage_mono Ioo_subset_Icc_self) -/-- If `f : ℂ → E` is continuous the closed annulus `r ≤ ∥z - c∥ ≤ R`, `0 < r ≤ R`, and is complex +/-- If `f : ℂ → E` is continuous the closed annulus `r ≤ ‖z - c‖ ≤ R`, `0 < r ≤ R`, and is complex differentiable at all but countably many points of its interior, then the integrals of -`f z / (z - c)` (formally, `(z - c)⁻¹ • f z`) over the circles `∥z - c∥ = r` and `∥z - c∥ = R` are +`f z / (z - c)` (formally, `(z - c)⁻¹ • f z`) over the circles `‖z - c‖ = r` and `‖z - c‖ = R` are equal to each other. -/ lemma circle_integral_sub_center_inv_smul_eq_of_differentiable_on_annulus_off_countable - {c : ℂ} {r R : ℝ} (h0 : 0 < r) (hle : r ≤ R) {f : ℂ → E} {s : set ℂ} (hs : countable s) + {c : ℂ} {r R : ℝ} (h0 : 0 < r) (hle : r ≤ R) {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R \ ball c r)) (hd : ∀ z ∈ ball c R \ closed_ball c r \ s, differentiable_at ℂ f z) : ∮ z in C(c, R), (z - c)⁻¹ • f z = ∮ z in C(c, r), (z - c)⁻¹ • f z := @@ -296,7 +302,7 @@ begin set R := [a, b] ×ℂ [0, 2 * π], set g : ℂ → ℂ := (+) c ∘ exp, have hdg : differentiable ℂ g := differentiable_exp.const_add _, - replace hs : countable (g ⁻¹' s) := (hs.preimage (add_right_injective c)).preimage_cexp, + replace hs : (g ⁻¹' s).countable := (hs.preimage (add_right_injective c)).preimage_cexp, have h_maps : maps_to g R A, { rintro z ⟨h, -⟩, simpa [dist_eq, g, abs_exp, hle] using h.symm }, replace hc : continuous_on (f ∘ g) R, from hc.comp hdg.continuous.continuous_on h_maps, @@ -310,11 +316,11 @@ begin end /-- **Cauchy-Goursat theorem** for an annulus. If `f : ℂ → E` is continuous on the closed annulus -`r ≤ ∥z - c∥ ≤ R`, `0 < r ≤ R`, and is complex differentiable at all but countably many points of -its interior, then the integrals of `f` over the circles `∥z - c∥ = r` and `∥z - c∥ = R` are equal +`r ≤ ‖z - c‖ ≤ R`, `0 < r ≤ R`, and is complex differentiable at all but countably many points of +its interior, then the integrals of `f` over the circles `‖z - c‖ = r` and `‖z - c‖ = R` are equal to each other. -/ lemma circle_integral_eq_of_differentiable_on_annulus_off_countable - {c : ℂ} {r R : ℝ} (h0 : 0 < r) (hle : r ≤ R) {f : ℂ → E} {s : set ℂ} (hs : countable s) + {c : ℂ} {r R : ℝ} (h0 : 0 < r) (hle : r ≤ R) {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R \ ball c r)) (hd : ∀ z ∈ ball c R \ closed_ball c r \ s, differentiable_at ℂ f z) : ∮ z in C(c, R), f z = ∮ z in C(c, r), f z := @@ -329,9 +335,9 @@ calc ∮ z in C(c, R), f z = ∮ z in C(c, R), (z - c)⁻¹ • (z - c) • f z /-- **Cauchy integral formula** for the value at the center of a disc. If `f` is continuous on a punctured closed disc of radius `R`, is differentiable at all but countably many points of the interior of this disc, and has a limit `y` at the center of the disc, then the integral -$\oint_{∥z-c∥=R} \frac{f(z)}{z-c}\,dz$ is equal to $2πiy`. -/ +$\oint_{‖z-c‖=R} \frac{f(z)}{z-c}\,dz$ is equal to $2πiy`. -/ lemma circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable_of_tendsto - {c : ℂ} {R : ℝ} (h0 : 0 < R) {f : ℂ → E} {y : E} {s : set ℂ} (hs : countable s) + {c : ℂ} {R : ℝ} (h0 : 0 < R) {f : ℂ → E} {y : E} {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R \ {c})) (hd : ∀ z ∈ ball c R \ {c} \ s, differentiable_at ℂ f z) (hy : tendsto f (𝓝[{c}ᶜ] c) (𝓝 y)) : ∮ z in C(c, R), (z - c)⁻¹ • f z = (2 * π * I : ℂ) • y := @@ -352,15 +358,15 @@ begin from λ z hz, ne_of_mem_of_not_mem hz (λ h, hr0.ne' $ dist_self c ▸ eq.symm h), /- The integral `∮ z in C(c, r), f z / (z - c)` does not depend on `0 < r ≤ R` and tends to `2πIy` as `r → 0`. -/ - calc ∥(∮ z in C(c, R), (z - c)⁻¹ • f z) - (2 * ↑π * I) • y∥ - = ∥(∮ z in C(c, r), (z - c)⁻¹ • f z) - ∮ z in C(c, r), (z - c)⁻¹ • y∥ : + calc ‖(∮ z in C(c, R), (z - c)⁻¹ • f z) - (2 * ↑π * I) • y‖ + = ‖(∮ z in C(c, r), (z - c)⁻¹ • f z) - ∮ z in C(c, r), (z - c)⁻¹ • y‖ : begin congr' 2, { exact circle_integral_sub_center_inv_smul_eq_of_differentiable_on_annulus_off_countable hr0 hrR hs (hc.mono hsub) (λ z hz, hd z ⟨hsub' hz.1, hz.2⟩) }, { simp [hr0.ne'] } end - ... = ∥∮ z in C(c, r), (z - c)⁻¹ • (f z - y)∥ : + ... = ‖∮ z in C(c, r), (z - c)⁻¹ • (f z - y)‖ : begin simp only [smul_sub], have hc' : continuous_on (λ z, (z - c)⁻¹) (sphere c r), @@ -386,7 +392,7 @@ end on a closed disc of radius `R` and is complex differentiable at all but countably many points of its interior, then the integral $\oint_{|z-c|=R} \frac{f(z)}{z-c}\,dz$ is equal to $2πiy`. -/ lemma circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable {R : ℝ} (h0 : 0 < R) - {f : ℂ → E} {c : ℂ} {s : set ℂ} (hs : countable s) + {f : ℂ → E} {c : ℂ} {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R)) (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) : ∮ z in C(c, R), (z - c)⁻¹ • f z = (2 * π * I : ℂ) • f c := circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable_of_tendsto h0 hs @@ -394,10 +400,10 @@ circle_integral_sub_center_inv_smul_of_differentiable_on_off_countable_of_tendst (hc.continuous_at $ closed_ball_mem_nhds _ h0).continuous_within_at /-- **Cauchy-Goursat theorem** for a disk: if `f : ℂ → E` is continuous on a closed disk -`{z | ∥z - c∥ ≤ R}` and is complex differentiable at all but countably many points of its interior, +`{z | ‖z - c‖ ≤ R}` and is complex differentiable at all but countably many points of its interior, then the integral $\oint_{|z-c|=R}f(z)\,dz$ equals zero. -/ lemma circle_integral_eq_zero_of_differentiable_on_off_countable {R : ℝ} (h0 : 0 ≤ R) {f : ℂ → E} - {c : ℂ} {s : set ℂ} (hs : countable s) (hc : continuous_on f (closed_ball c R)) + {c : ℂ} {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R)) (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) : ∮ z in C(c, R), f z = 0 := begin @@ -415,13 +421,13 @@ end `complex.circle_integral_sub_inv_smul_of_differentiable_on_off_countable`. This lemma assumes `w ∉ s` while the main lemma drops this assumption. -/ lemma circle_integral_sub_inv_smul_of_differentiable_on_off_countable_aux {R : ℝ} {c w : ℂ} - {f : ℂ → E} {s : set ℂ} (hs : countable s) (hw : w ∈ ball c R \ s) + {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hw : w ∈ ball c R \ s) (hc : continuous_on f (closed_ball c R)) (hd : ∀ x ∈ ball c R \ s, differentiable_at ℂ f x) : ∮ z in C(c, R), (z - w)⁻¹ • f z = (2 * π * I : ℂ) • f w := begin have hR : 0 < R := dist_nonneg.trans_lt hw.1, set F : ℂ → E := dslope f w, - have hws : countable (insert w s) := hs.insert _, + have hws : (insert w s).countable := hs.insert w, have hnhds : closed_ball c R ∈ 𝓝 w, from closed_ball_mem_nhds_of_mem hw.1, have hcF : continuous_on F (closed_ball c R), from (continuous_on_dslope $ closed_ball_mem_nhds_of_mem hw.1).2 ⟨hc, hd _ hw⟩, @@ -448,7 +454,7 @@ complex differentiable at all but countably many points of its interior, then fo interior we have $\frac{1}{2πi}\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=f(w)$. -/ lemma two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable - {R : ℝ} {c w : ℂ} {f : ℂ → E} {s : set ℂ} (hs : countable s) (hw : w ∈ ball c R) + {R : ℝ} {c w : ℂ} {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hw : w ∈ ball c R) (hc : continuous_on f (closed_ball c R)) (hd : ∀ x ∈ ball c R \ s, differentiable_at ℂ f x) : (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z = f w := begin @@ -475,10 +481,11 @@ begin with ⟨l, u, hlu₀, hlu_sub⟩, obtain ⟨x, hx⟩ : (Ioo l u \ g ⁻¹' s).nonempty, { refine nonempty_diff.2 (λ hsub, _), - have : countable (Ioo l u), + have : (Ioo l u).countable, from (hs.preimage ((add_right_injective w).comp of_real_injective)).mono hsub, - rw [← cardinal.mk_set_le_omega, cardinal.mk_Ioo_real (hlu₀.1.trans hlu₀.2)] at this, - exact this.not_lt cardinal.omega_lt_continuum }, + rw [← cardinal.le_aleph_0_iff_set_countable, + cardinal.mk_Ioo_real (hlu₀.1.trans hlu₀.2)] at this, + exact this.not_lt cardinal.aleph_0_lt_continuum }, exact ⟨g x, (hlu_sub hx.1).1, (hlu_sub hx.1).2, hx.2⟩ end @@ -487,7 +494,7 @@ complex differentiable at all but countably many points of its interior, then fo interior we have $\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=2πif(w)$. -/ lemma circle_integral_sub_inv_smul_of_differentiable_on_off_countable - {R : ℝ} {c w : ℂ} {f : ℂ → E} {s : set ℂ} (hs : countable s) (hw : w ∈ ball c R) + {R : ℝ} {c w : ℂ} {f : ℂ → E} {s : set ℂ} (hs : s.countable) (hw : w ∈ ball c R) (hc : continuous_on f (closed_ball c R)) (hd : ∀ x ∈ ball c R \ s, differentiable_at ℂ f x) : ∮ z in C(c, R), (z - w)⁻¹ • f z = (2 * π * I : ℂ) • f w := by { rw [← two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable @@ -502,6 +509,20 @@ lemma _root_.diff_cont_on_cl.circle_integral_sub_inv_smul {R : ℝ} {c w : ℂ} circle_integral_sub_inv_smul_of_differentiable_on_off_countable countable_empty hw h.continuous_on_ball $ λ x hx, h.differentiable_at is_open_ball hx.1 +/-- **Cauchy integral formula**: if `f : ℂ → E` is complex differentiable on an open disc and is +continuous on its closure, then for any `w` in this open ball we have +$\frac{1}{2πi}\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=f(w)$. -/ +lemma _root_.diff_cont_on_cl.two_pi_I_inv_smul_circle_integral_sub_inv_smul {R : ℝ} {c w : ℂ} + {f : ℂ → E} (hf : diff_cont_on_cl ℂ f (ball c R)) (hw : w ∈ ball c R) : + (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - w)⁻¹ • f z = f w := +begin + have hR : 0 < R := not_le.mp (ball_eq_empty.not.mp (nonempty_of_mem hw).ne_empty), + refine two_pi_I_inv_smul_circle_integral_sub_inv_smul_of_differentiable_on_off_countable + countable_empty hw _ _, + { simpa only [closure_ball c hR.ne.symm] using hf.continuous_on }, + { simpa only [diff_empty] using λ z hz, hf.differentiable_at is_open_ball hz } +end + /-- **Cauchy integral formula**: if `f : ℂ → E` is complex differentiable on a closed disc of radius `R`, then for any `w` in its interior we have $\oint_{|z-c|=R}(z-w)^{-1}f(z)\,dz=2πif(w)$. -/ lemma _root_.differentiable_on.circle_integral_sub_inv_smul {R : ℝ} {c w : ℂ} {f : ℂ → E} @@ -514,7 +535,7 @@ complex differentiable at all but countably many points of its interior, then fo interior we have $\oint_{|z-c|=R}\frac{f(z)}{z-w}dz=2\pi i\,f(w)$. -/ lemma circle_integral_div_sub_of_differentiable_on_off_countable {R : ℝ} {c w : ℂ} {s : set ℂ} - (hs : countable s) (hw : w ∈ ball c R) {f : ℂ → ℂ} (hc : continuous_on f (closed_ball c R)) + (hs : s.countable) (hw : w ∈ ball c R) {f : ℂ → ℂ} (hc : continuous_on f (closed_ball c R)) (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) : ∮ z in C(c, R), f z / (z - w) = 2 * π * I * f w := by simpa only [smul_eq_mul, div_eq_inv_mul] @@ -524,7 +545,7 @@ by simpa only [smul_eq_mul, div_eq_inv_mul] but countably many points of the corresponding open ball, then it is analytic on the open ball with coefficients of the power series given by Cauchy integral formulas. -/ lemma has_fpower_series_on_ball_of_differentiable_off_countable {R : ℝ≥0} {c : ℂ} {f : ℂ → E} - {s : set ℂ} (hs : countable s) (hc : continuous_on f (closed_ball c R)) + {s : set ℂ} (hs : s.countable) (hc : continuous_on f (closed_ball c R)) (hd : ∀ z ∈ ball c R \ s, differentiable_at ℂ f z) (hR : 0 < R) : has_fpower_series_on_ball f (cauchy_power_series f c R) c R := { r_le := le_radius_cauchy_power_series _ _ _, @@ -569,6 +590,10 @@ begin exact ((hd.mono hRs).has_fpower_series_on_ball hR0).analytic_at end +lemma _root_.differentiable_on.analytic_on {s : set ℂ} {f : ℂ → E} (hd : differentiable_on ℂ f s) + (hs : is_open s) : analytic_on ℂ f s := +λ z hz, hd.analytic_at (hs.mem_nhds hz) + /-- A complex differentiable function `f : ℂ → E` is analytic at every point. -/ protected lemma _root_.differentiable.analytic_at {f : ℂ → E} (hf : differentiable ℂ f) (z : ℂ) : analytic_at ℂ f z := diff --git a/src/analysis/complex/circle.lean b/src/analysis/complex/circle.lean index 7175cb06aaf94..1be99911891dd 100644 --- a/src/analysis/complex/circle.lean +++ b/src/analysis/complex/circle.lean @@ -5,10 +5,14 @@ Authors: Heather Macbeth -/ import analysis.special_functions.exp import topology.continuous_function.basic +import analysis.normed.field.unit_ball /-! # The circle +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `circle` to be the metric sphere (`metric.sphere`) in `ℂ` centred at `0` of radius `1`. We equip it with the following structure: @@ -36,14 +40,7 @@ open complex metric open_locale complex_conjugate /-- The unit circle in `ℂ`, here given the structure of a submonoid of `ℂ`. -/ -def circle : submonoid ℂ := -{ carrier := sphere (0:ℂ) 1, - one_mem' := by simp, - mul_mem' := λ a b, begin - simp only [norm_eq_abs, mem_sphere_zero_iff_norm], - intros ha hb, - simp [ha, hb], - end } +def circle : submonoid ℂ := submonoid.unit_sphere ℂ @[simp] lemma mem_circle_iff_abs {z : ℂ} : z ∈ circle ↔ abs z = 1 := mem_sphere_zero_iff_norm @@ -53,48 +50,36 @@ lemma circle_def : ↑circle = {z : ℂ | abs z = 1} := set.ext $ λ z, mem_circ mem_circle_iff_abs.mp z.2 lemma mem_circle_iff_norm_sq {z : ℂ} : z ∈ circle ↔ norm_sq z = 1 := -by rw [mem_circle_iff_abs, complex.abs, real.sqrt_eq_one] +by simp [complex.abs] @[simp] lemma norm_sq_eq_of_mem_circle (z : circle) : norm_sq z = 1 := by simp [norm_sq_eq_abs] lemma ne_zero_of_mem_circle (z : circle) : (z:ℂ) ≠ 0 := ne_zero_of_mem_unit_sphere z -instance : comm_group circle := -{ inv := λ z, ⟨conj (z : ℂ), by simp⟩, - mul_left_inv := λ z, subtype.ext $ by { simp [has_inv.inv, ← norm_sq_eq_conj_mul_self, - ← mul_self_abs] }, - .. circle.to_comm_monoid } +instance : comm_group circle := metric.sphere.comm_group -lemma coe_inv_circle_eq_conj (z : circle) : ↑(z⁻¹) = conj (z : ℂ) := rfl +@[simp] lemma coe_inv_circle (z : circle) : ↑(z⁻¹) = (z : ℂ)⁻¹ := rfl -@[simp] lemma coe_inv_circle (z : circle) : ↑(z⁻¹) = (z : ℂ)⁻¹ := -begin - rw coe_inv_circle_eq_conj, - apply eq_inv_of_mul_right_eq_one, - rw [mul_comm, ← complex.norm_sq_eq_conj_mul_self], - simp, -end +lemma coe_inv_circle_eq_conj (z : circle) : ↑(z⁻¹) = conj (z : ℂ) := +by rw [coe_inv_circle, inv_def, norm_sq_eq_of_mem_circle, inv_one, of_real_one, mul_one] @[simp] lemma coe_div_circle (z w : circle) : ↑(z / w) = (z:ℂ) / w := -show ↑(z * w⁻¹) = (z:ℂ) * w⁻¹, by simp +circle.subtype.map_div z w /-- The elements of the circle embed into the units. -/ -@[simps] -def circle.to_units : circle →* units ℂ := -{ to_fun := λ x, units.mk0 x $ ne_zero_of_mem_circle _, - map_one' := units.ext rfl, - map_mul' := λ x y, units.ext rfl } +def circle.to_units : circle →* units ℂ := unit_sphere_to_units ℂ + +-- written manually because `@[simps]` was slow and generated the wrong lemma +@[simp] lemma circle.to_units_apply (z : circle) : + circle.to_units z = units.mk0 z (ne_zero_of_mem_circle z) := rfl instance : compact_space circle := metric.sphere.compact_space _ _ --- the following result could instead be deduced from the Lie group structure on the circle using --- `topological_group_of_lie_group`, but that seems a little awkward since one has to first provide --- and then forget the model space -instance : topological_group circle := -{ continuous_mul := let h : continuous (λ x : circle, (x : ℂ)) := continuous_subtype_coe in - continuous_induced_rng (continuous_mul.comp (h.prod_map h)), - continuous_inv := continuous_induced_rng $ - complex.conj_cle.continuous.comp continuous_subtype_coe } +instance : topological_group circle := metric.sphere.topological_group + +/-- If `z` is a nonzero complex number, then `conj z / z` belongs to the unit circle. -/ +@[simps] def circle.of_conj_div_self (z : ℂ) (hz : z ≠ 0) : circle := +⟨conj z / z, mem_circle_iff_abs.2 $ by rw [map_div₀, abs_conj, div_self (complex.abs.ne_zero hz)]⟩ /-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ`. -/ def exp_map_circle : C(ℝ, circle) := diff --git a/src/analysis/complex/conformal.lean b/src/analysis/complex/conformal.lean index 9e8d060c0fb90..849a4a284010e 100644 --- a/src/analysis/complex/conformal.lean +++ b/src/analysis/complex/conformal.lean @@ -5,10 +5,14 @@ Authors: Yourong Zang -/ import analysis.complex.isometry import analysis.normed_space.conformal_linear_map +import analysis.normed_space.finite_dimension /-! # Conformal maps between complex vector spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove the sufficient and necessary conditions for a real-linear map between complex vector spaces to be conformal. @@ -39,24 +43,27 @@ conj_lie.to_linear_isometry.is_conformal_map section conformal_into_complex_normed -variables {E : Type*} [normed_group E] [normed_space ℝ E] [normed_space ℂ E] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [normed_space ℂ E] {z : ℂ} {g : ℂ →L[ℝ] E} {f : ℂ → E} lemma is_conformal_map_complex_linear {map : ℂ →L[ℂ] E} (nonzero : map ≠ 0) : is_conformal_map (map.restrict_scalars ℝ) := begin - have minor₁ : ∥map 1∥ ≠ 0, - { simpa [ext_ring_iff] using nonzero }, - refine ⟨∥map 1∥, minor₁, ⟨∥map 1∥⁻¹ • map, _⟩, _⟩, + have minor₁ : ‖map 1‖ ≠ 0, + { simpa only [ext_ring_iff, ne.def, norm_eq_zero] using nonzero}, + refine ⟨‖map 1‖, minor₁, ⟨‖map 1‖⁻¹ • map, _⟩, _⟩, { intros x, simp only [linear_map.smul_apply], have : x = x • 1 := by rw [smul_eq_mul, mul_one], nth_rewrite 0 [this], rw [_root_.coe_coe map, linear_map.coe_coe_is_scalar_tower], simp only [map.coe_coe, map.map_smul, norm_smul, norm_inv, norm_norm], - field_simp [minor₁], }, + field_simp only [one_mul] }, { ext1, - simp [minor₁] }, + simp only [minor₁, linear_map.smul_apply, _root_.coe_coe, linear_map.coe_coe_is_scalar_tower, + continuous_linear_map.coe_coe, coe_restrict_scalars', coe_smul', + linear_isometry.coe_to_continuous_linear_map, linear_isometry.coe_mk, pi.smul_apply, + smul_inv_smul₀, ne.def, not_false_iff] }, end lemma is_conformal_map_complex_linear_conj @@ -105,14 +112,15 @@ begin { rintros ⟨⟨map, rfl⟩ | ⟨map, hmap⟩, h₂⟩, { refine is_conformal_map_complex_linear _, contrapose! h₂ with w, - simp [w] }, + simp only [w, restrict_scalars_zero]}, { have minor₁ : g = (map.restrict_scalars ℝ) ∘L ↑conj_cle, { ext1, - simp [hmap] }, + simp only [hmap, coe_comp', continuous_linear_equiv.coe_coe, function.comp_app, + conj_cle_apply, star_ring_end_self_apply]}, rw minor₁ at ⊢ h₂, refine is_conformal_map_complex_linear_conj _, contrapose! h₂ with w, - simp [w] } } + simp only [w, restrict_scalars_zero, zero_comp]} } end end conformal_into_complex_plane diff --git a/src/analysis/complex/isometry.lean b/src/analysis/complex/isometry.lean index a6cf5209ba1b8..44eaf6f25e9c0 100644 --- a/src/analysis/complex/isometry.lean +++ b/src/analysis/complex/isometry.lean @@ -5,11 +5,14 @@ Authors: François Sunatori -/ import analysis.complex.circle import linear_algebra.determinant -import linear_algebra.general_linear_group +import linear_algebra.matrix.general_linear_group /-! # Isometries of the Complex Plane +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The lemma `linear_isometry_complex` states the classification of isometries in the complex plane. Specifically, isometries with rotations but without translation. The proof involves: @@ -29,13 +32,13 @@ noncomputable theory open complex open_locale complex_conjugate -local notation `|` x `|` := complex.abs x +local notation (name := complex.abs) `|` x `|` := complex.abs x /-- An element of the unit circle defines a `linear_isometry_equiv` from `ℂ` to itself, by rotation. -/ def rotation : circle →* (ℂ ≃ₗᵢ[ℝ] ℂ) := { to_fun := λ a, - { norm_map' := λ x, show |a * x| = |x|, by rw [complex.abs_mul, abs_coe_circle, one_mul], + { norm_map' := λ x, show |a * x| = |x|, by rw [map_mul, abs_coe_circle, one_mul], ..distrib_mul_action.to_linear_equiv ℝ ℂ a }, map_one' := linear_isometry_equiv.ext $ one_smul _, map_mul' := λ _ _, linear_isometry_equiv.ext $ mul_smul _ _ } @@ -75,14 +78,14 @@ function.left_inverse.injective rotation_of_rotation lemma linear_isometry.re_apply_eq_re_of_add_conj_eq (f : ℂ →ₗᵢ[ℝ] ℂ) (h₃ : ∀ z, z + conj z = f z + conj (f z)) (z : ℂ) : (f z).re = z.re := by simpa [ext_iff, add_re, add_im, conj_re, conj_im, ←two_mul, - (show (2 : ℝ) ≠ 0, by simp [two_ne_zero'])] using (h₃ z).symm + (show (2 : ℝ) ≠ 0, by simp [two_ne_zero])] using (h₃ z).symm lemma linear_isometry.im_apply_eq_im_or_neg_of_re_apply_eq_re {f : ℂ →ₗᵢ[ℝ] ℂ} (h₂ : ∀ z, (f z).re = z.re) (z : ℂ) : (f z).im = z.im ∨ (f z).im = -z.im := begin have h₁ := f.norm_map z, - simp only [complex.abs, norm_eq_abs] at h₁, + simp only [complex.abs_def, norm_eq_abs] at h₁, rwa [real.sqrt_inj (norm_sq_nonneg _) (norm_sq_nonneg _), norm_sq_apply (f z), norm_sq_apply z, h₂, add_left_cancel_iff, mul_self_eq_mul_self_iff] at h₁, end @@ -90,7 +93,7 @@ end lemma linear_isometry.im_apply_eq_im {f : ℂ →ₗᵢ[ℝ] ℂ} (h : f 1 = 1) (z : ℂ) : z + conj z = f z + conj (f z) := begin - have : ∥f z - 1∥ = ∥z - 1∥ := by rw [← f.norm_map (z - 1), f.map_sub, h], + have : ‖f z - 1‖ = ‖z - 1‖ := by rw [← f.norm_map (z - 1), f.map_sub, h], apply_fun λ x, x ^ 2 at this, simp only [norm_eq_abs, ←norm_sq_eq_abs] at this, rw [←of_real_inj, ←mul_conj, ←mul_conj] at this, @@ -141,7 +144,7 @@ begin end /-- The matrix representation of `rotation a` is equal to the conformal matrix -`![![re a, -im a], ![im a, re a]]`. -/ +`!![re a, -im a; im a, re a]`. -/ lemma to_matrix_rotation (a : circle) : linear_map.to_matrix basis_one_I basis_one_I (rotation a).to_linear_equiv = matrix.plane_conformal_matrix (re a) (im a) (by simp [pow_two, ←norm_sq_apply]) := diff --git a/src/analysis/complex/liouville.lean b/src/analysis/complex/liouville.lean index e84a587622e5e..aa2b6a8ae40eb 100644 --- a/src/analysis/complex/liouville.lean +++ b/src/analysis/complex/liouville.lean @@ -10,6 +10,9 @@ import analysis.normed_space.completion /-! # Liouville's theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove Liouville's theorem: if `f : E → F` is complex differentiable on the whole space and its range is bounded, then the function is a constant. Various versions of this theorem are formalized in `differentiable.apply_eq_apply_of_bounded`, @@ -21,11 +24,11 @@ The proof is based on the Cauchy integral formula for the derivative of an analy -/ open topological_space metric set filter asymptotics function measure_theory -open_locale topological_space filter nnreal real +open_locale topology filter nnreal real universes u v -variables {E : Type u} [normed_group E] [normed_space ℂ E] - {F : Type v} [normed_group F] [normed_space ℂ F] +variables {E : Type u} [normed_add_comm_group E] [normed_space ℂ E] + {F : Type v} [normed_add_comm_group F] [normed_space ℂ F] local postfix `̂`:100 := uniform_space.completion @@ -44,36 +47,35 @@ lemma deriv_eq_smul_circle_integral [complete_space F] {R : ℝ} {c : ℂ} {f : begin lift R to ℝ≥0 using hR.le, refine (hf.has_fpower_series_on_ball hR).has_fpower_series_at.deriv.trans _, - simp only [cauchy_power_series_apply, one_div, zpow_neg₀, pow_one, smul_smul, - zpow_two, mul_inv₀] + simp only [cauchy_power_series_apply, one_div, zpow_neg, pow_one, smul_smul, zpow_two, mul_inv] end lemma norm_deriv_le_aux [complete_space F] {c : ℂ} {R C : ℝ} {f : ℂ → F} (hR : 0 < R) - (hf : diff_cont_on_cl ℂ f (ball c R)) (hC : ∀ z ∈ sphere c R, ∥f z∥ ≤ C) : - ∥deriv f c∥ ≤ C / R := + (hf : diff_cont_on_cl ℂ f (ball c R)) (hC : ∀ z ∈ sphere c R, ‖f z‖ ≤ C) : + ‖deriv f c‖ ≤ C / R := begin - have : ∀ z ∈ sphere c R, ∥(z - c) ^ (-2 : ℤ) • f z∥ ≤ C / (R * R), + have : ∀ z ∈ sphere c R, ‖(z - c) ^ (-2 : ℤ) • f z‖ ≤ C / (R * R), from λ z (hz : abs (z - c) = R), by simpa [-mul_inv_rev, norm_smul, hz, zpow_two, ←div_eq_inv_mul] using (div_le_div_right (mul_pos hR hR)).2 (hC z hz), - calc ∥deriv f c∥ = ∥(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - c) ^ (-2 : ℤ) • f z∥ : + calc ‖deriv f c‖ = ‖(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - c) ^ (-2 : ℤ) • f z‖ : congr_arg norm (deriv_eq_smul_circle_integral hR hf) ... ≤ R * (C / (R * R)) : circle_integral.norm_two_pi_I_inv_smul_integral_le_of_norm_le_const hR.le this - ... = C / R : by rw [mul_div_comm, div_self_mul_self', div_eq_mul_inv] + ... = C / R : by rw [mul_div_left_comm, div_self_mul_self', div_eq_mul_inv] end /-- If `f` is complex differentiable on an open disc of radius `R > 0`, is continuous on its closure, and its values on the boundary circle of this disc are bounded from above by `C`, then the norm of its derivative at the center is at most `C / R`. -/ lemma norm_deriv_le_of_forall_mem_sphere_norm_le {c : ℂ} {R C : ℝ} {f : ℂ → F} (hR : 0 < R) - (hd : diff_cont_on_cl ℂ f (ball c R)) (hC : ∀ z ∈ sphere c R, ∥f z∥ ≤ C) : - ∥deriv f c∥ ≤ C / R := + (hd : diff_cont_on_cl ℂ f (ball c R)) (hC : ∀ z ∈ sphere c R, ‖f z‖ ≤ C) : + ‖deriv f c‖ ≤ C / R := begin set e : F →L[ℂ] F̂ := uniform_space.completion.to_complL, have : has_deriv_at (e ∘ f) (e (deriv f c)) c, from e.has_fderiv_at.comp_has_deriv_at c (hd.differentiable_at is_open_ball $ mem_ball_self hR).has_deriv_at, - calc ∥deriv f c∥ = ∥deriv (e ∘ f) c∥ : + calc ‖deriv f c‖ = ‖deriv (e ∘ f) c‖ : by { rw this.deriv, exact (uniform_space.completion.norm_coe _).symm } ... ≤ C / R : norm_deriv_le_aux hR (e.differentiable.comp_diff_cont_on_cl hd) @@ -86,12 +88,12 @@ lemma liouville_theorem_aux {f : ℂ → F} (hf : differentiable ℂ f) begin suffices : ∀ c, deriv f c = 0, from is_const_of_deriv_eq_zero hf this z w, clear z w, intro c, - obtain ⟨C, C₀, hC⟩ : ∃ C > (0 : ℝ), ∀ z, ∥f z∥ ≤ C, + obtain ⟨C, C₀, hC⟩ : ∃ C > (0 : ℝ), ∀ z, ‖f z‖ ≤ C, { rcases bounded_iff_forall_norm_le.1 hb with ⟨C, hC⟩, exact ⟨max C 1, lt_max_iff.2 (or.inr zero_lt_one), λ z, (hC (f z) (mem_range_self _)).trans (le_max_left _ _)⟩ }, refine norm_le_zero_iff.1 (le_of_forall_le_of_dense $ λ ε ε₀, _), - calc ∥deriv f c∥ ≤ C / (C / ε) : + calc ‖deriv f c‖ ≤ C / (C / ε) : norm_deriv_le_of_forall_mem_sphere_norm_le (div_pos C₀ ε₀) hf.diff_cont_on_cl (λ z _, hC z) ... = ε : div_div_cancel' C₀.lt.ne' end diff --git a/src/analysis/complex/locally_uniform_limit.lean b/src/analysis/complex/locally_uniform_limit.lean new file mode 100644 index 0000000000000..cc91ebd185d1f --- /dev/null +++ b/src/analysis/complex/locally_uniform_limit.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2022 Vincent Beffara. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Vincent Beffara +-/ +import analysis.complex.removable_singularity +import analysis.calculus.series + +/-! +# Locally uniform limits of holomorphic functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file gathers some results about locally uniform limits of holomorphic functions on an open +subset of the complex plane. + +## Main results + +* `tendsto_locally_uniformly_on.differentiable_on`: A locally uniform limit of holomorphic functions + is holomorphic. +* `tendsto_locally_uniformly_on.deriv`: Locally uniform convergence implies locally uniform + convergence of the derivatives to the derivative of the limit. +-/ + +open set metric measure_theory filter complex interval_integral +open_locale real topology + +variables {E ι : Type*} [normed_add_comm_group E] [normed_space ℂ E] [complete_space E] + {U K : set ℂ} {z : ℂ} {M r δ : ℝ} {φ : filter ι} {F : ι → ℂ → E} {f g : ℂ → E} + +namespace complex + +section cderiv + +/-- A circle integral which coincides with `deriv f z` whenever one can apply the Cauchy formula for +the derivative. It is useful in the proof that locally uniform limits of holomorphic functions are +holomorphic, because it depends continuously on `f` for the uniform topology. -/ +noncomputable def cderiv (r : ℝ) (f : ℂ → E) (z : ℂ) : E := +(2 * π * I : ℂ)⁻¹ • ∮ w in C(z, r), ((w - z) ^ 2)⁻¹ • f w + +lemma cderiv_eq_deriv (hU : is_open U) (hf : differentiable_on ℂ f U) (hr : 0 < r) + (hzr : closed_ball z r ⊆ U) : + cderiv r f z = deriv f z := +two_pi_I_inv_smul_circle_integral_sub_sq_inv_smul_of_differentiable hU hzr hf (mem_ball_self hr) + +lemma norm_cderiv_le (hr : 0 < r) (hf : ∀ w ∈ sphere z r, ‖f w‖ ≤ M) : + ‖cderiv r f z‖ ≤ M / r := +begin + have hM : 0 ≤ M, + { obtain ⟨w, hw⟩ : (sphere z r).nonempty := normed_space.sphere_nonempty.mpr hr.le, + exact (norm_nonneg _).trans (hf w hw) }, + have h1 : ∀ w ∈ sphere z r, ‖((w - z) ^ 2)⁻¹ • f w‖ ≤ M / r ^ 2, + { intros w hw, + simp only [mem_sphere_iff_norm, norm_eq_abs] at hw, + simp only [norm_smul, inv_mul_eq_div, hw, norm_eq_abs, map_inv₀, complex.abs_pow], + exact div_le_div hM (hf w hw) (sq_pos_of_pos hr) le_rfl }, + have h2 := circle_integral.norm_integral_le_of_norm_le_const hr.le h1, + simp only [cderiv, norm_smul], + refine (mul_le_mul le_rfl h2 (norm_nonneg _) (norm_nonneg _)).trans (le_of_eq _), + field_simp [_root_.abs_of_nonneg real.pi_pos.le, real.pi_pos.ne.symm, hr.ne.symm], + ring +end + +lemma cderiv_sub (hr : 0 < r) (hf : continuous_on f (sphere z r)) + (hg : continuous_on g (sphere z r)) : + cderiv r (f - g) z = cderiv r f z - cderiv r g z := +begin + have h1 : continuous_on (λ (w : ℂ), ((w - z) ^ 2)⁻¹) (sphere z r), + { refine ((continuous_id'.sub continuous_const).pow 2).continuous_on.inv₀ (λ w hw h, hr.ne _), + rwa [mem_sphere_iff_norm, sq_eq_zero_iff.mp h, norm_zero] at hw }, + simp_rw [cderiv, ← smul_sub], + congr' 1, + simpa only [pi.sub_apply, smul_sub] using circle_integral.integral_sub + ((h1.smul hf).circle_integrable hr.le) ((h1.smul hg).circle_integrable hr.le) +end + +lemma norm_cderiv_lt (hr : 0 < r) (hfM : ∀ w ∈ sphere z r, ‖f w‖ < M) + (hf : continuous_on f (sphere z r)) : + ‖cderiv r f z‖ < M / r := +begin + obtain ⟨L, hL1, hL2⟩ : ∃ L < M, ∀ w ∈ sphere z r, ‖f w‖ ≤ L, + { have e1 : (sphere z r).nonempty := normed_space.sphere_nonempty.mpr hr.le, + have e2 : continuous_on (λ w, ‖f w‖) (sphere z r), + from continuous_norm.comp_continuous_on hf, + obtain ⟨x, hx, hx'⟩ := (is_compact_sphere z r).exists_forall_ge e1 e2, + exact ⟨‖f x‖, hfM x hx, hx'⟩ }, + exact (norm_cderiv_le hr hL2).trans_lt ((div_lt_div_right hr).mpr hL1) +end + +lemma norm_cderiv_sub_lt (hr : 0 < r) (hfg : ∀ w ∈ sphere z r, ‖f w - g w‖ < M) + (hf : continuous_on f (sphere z r)) (hg : continuous_on g (sphere z r)) : + ‖cderiv r f z - cderiv r g z‖ < M / r := +cderiv_sub hr hf hg ▸ norm_cderiv_lt hr hfg (hf.sub hg) + +lemma tendsto_uniformly_on.cderiv (hF : tendsto_uniformly_on F f φ (cthickening δ K)) (hδ : 0 < δ) + (hFn : ∀ᶠ n in φ, continuous_on (F n) (cthickening δ K)) : + tendsto_uniformly_on (cderiv δ ∘ F) (cderiv δ f) φ K := +begin + by_cases φ = ⊥, + { simp only [h, tendsto_uniformly_on, eventually_bot, implies_true_iff]}, + haveI : φ.ne_bot := ne_bot_iff.2 h, + have e1 : continuous_on f (cthickening δ K) := tendsto_uniformly_on.continuous_on hF hFn, + rw [tendsto_uniformly_on_iff] at hF ⊢, + rintro ε hε, + filter_upwards [hF (ε * δ) (mul_pos hε hδ), hFn] with n h h' z hz, + simp_rw [dist_eq_norm] at h ⊢, + have e2 : ∀ w ∈ sphere z δ, ‖f w - F n w‖ < ε * δ, + from λ w hw1, h w (closed_ball_subset_cthickening hz δ (sphere_subset_closed_ball hw1)), + have e3 := sphere_subset_closed_ball.trans (closed_ball_subset_cthickening hz δ), + have hf : continuous_on f (sphere z δ), + from e1.mono (sphere_subset_closed_ball.trans (closed_ball_subset_cthickening hz δ)), + simpa only [mul_div_cancel _ hδ.ne.symm] using norm_cderiv_sub_lt hδ e2 hf (h'.mono e3) +end + +end cderiv + +section weierstrass + +lemma tendsto_uniformly_on_deriv_of_cthickening_subset (hf : tendsto_locally_uniformly_on F f φ U) + (hF : ∀ᶠ n in φ, differentiable_on ℂ (F n) U) {δ : ℝ} (hδ: 0 < δ) (hK : is_compact K) + (hU : is_open U) (hKU : cthickening δ K ⊆ U) : + tendsto_uniformly_on (deriv ∘ F) (cderiv δ f) φ K := +begin + have h1 : ∀ᶠ n in φ, continuous_on (F n) (cthickening δ K), + by filter_upwards [hF] with n h using h.continuous_on.mono hKU, + have h2 : is_compact (cthickening δ K), + from is_compact_of_is_closed_bounded is_closed_cthickening hK.bounded.cthickening, + have h3 : tendsto_uniformly_on F f φ (cthickening δ K), + from (tendsto_locally_uniformly_on_iff_forall_is_compact hU).mp hf (cthickening δ K) hKU h2, + apply (h3.cderiv hδ h1).congr, + filter_upwards [hF] with n h z hz, + exact cderiv_eq_deriv hU h hδ ((closed_ball_subset_cthickening hz δ).trans hKU) +end + +lemma exists_cthickening_tendsto_uniformly_on (hf : tendsto_locally_uniformly_on F f φ U) + (hF : ∀ᶠ n in φ, differentiable_on ℂ (F n) U) (hK : is_compact K) (hU : is_open U) (hKU : K ⊆ U) : + ∃ δ > 0, cthickening δ K ⊆ U ∧ tendsto_uniformly_on (deriv ∘ F) (cderiv δ f) φ K := +begin + obtain ⟨δ, hδ, hKδ⟩ := hK.exists_cthickening_subset_open hU hKU, + exact ⟨δ, hδ, hKδ, tendsto_uniformly_on_deriv_of_cthickening_subset hf hF hδ hK hU hKδ⟩ +end + +/-- A locally uniform limit of holomorphic functions on an open domain of the complex plane is +holomorphic (the derivatives converge locally uniformly to that of the limit, which is proved +as `tendsto_locally_uniformly_on.deriv`). -/ +theorem _root_.tendsto_locally_uniformly_on.differentiable_on [φ.ne_bot] + (hf : tendsto_locally_uniformly_on F f φ U) (hF : ∀ᶠ n in φ, differentiable_on ℂ (F n) U) + (hU : is_open U) : + differentiable_on ℂ f U := +begin + rintro x hx, + obtain ⟨K, ⟨hKx, hK⟩, hKU⟩ := (compact_basis_nhds x).mem_iff.mp (hU.mem_nhds hx), + obtain ⟨δ, hδ, -, h1⟩ := exists_cthickening_tendsto_uniformly_on hf hF hK hU hKU, + have h2 : interior K ⊆ U := interior_subset.trans hKU, + have h3 : ∀ᶠ n in φ, differentiable_on ℂ (F n) (interior K), + filter_upwards [hF] with n h using h.mono h2, + have h4 : tendsto_locally_uniformly_on F f φ (interior K) := hf.mono h2, + have h5 : tendsto_locally_uniformly_on (deriv ∘ F) (cderiv δ f) φ (interior K), + from h1.tendsto_locally_uniformly_on.mono interior_subset, + have h6 : ∀ x ∈ interior K, has_deriv_at f (cderiv δ f x) x, + from λ x h, has_deriv_at_of_tendsto_locally_uniformly_on' + is_open_interior h5 h3 (λ _, h4.tendsto_at) h, + have h7 : differentiable_on ℂ f (interior K), + from λ x hx, (h6 x hx).differentiable_at.differentiable_within_at, + exact (h7.differentiable_at (interior_mem_nhds.mpr hKx)).differentiable_within_at +end + +lemma _root_.tendsto_locally_uniformly_on.deriv (hf : tendsto_locally_uniformly_on F f φ U) + (hF : ∀ᶠ n in φ, differentiable_on ℂ (F n) U) (hU : is_open U) : + tendsto_locally_uniformly_on (deriv ∘ F) (deriv f) φ U := +begin + rw [tendsto_locally_uniformly_on_iff_forall_is_compact hU], + by_cases φ = ⊥, + { simp only [h, tendsto_uniformly_on, eventually_bot, implies_true_iff] }, + haveI : φ.ne_bot := ne_bot_iff.2 h, + rintro K hKU hK, + obtain ⟨δ, hδ, hK4, h⟩ := exists_cthickening_tendsto_uniformly_on hf hF hK hU hKU, + refine h.congr_right (λ z hz, cderiv_eq_deriv hU (hf.differentiable_on hF hU) hδ _), + exact (closed_ball_subset_cthickening hz δ).trans hK4, +end + +end weierstrass + +section tsums + +/-- If the terms in the sum `∑' (i : ι), F i` are uniformly bounded on `U` by a +summable function, and each term in the sum is differentiable on `U`, then so is the sum. -/ +lemma differentiable_on_tsum_of_summable_norm {u : ι → ℝ} + (hu : summable u) (hf : ∀ (i : ι), differentiable_on ℂ (F i) U) (hU : is_open U) + (hF_le : ∀ (i : ι) (w : ℂ), w ∈ U → ‖F i w‖ ≤ u i) : + differentiable_on ℂ (λ w : ℂ, ∑' (i : ι), F i w) U := +begin + classical, + have hc := (tendsto_uniformly_on_tsum hu hF_le).tendsto_locally_uniformly_on, + refine hc.differentiable_on (eventually_of_forall $ λ s, _) hU, + exact differentiable_on.sum (λ i hi, hf i), +end + +/-- If the terms in the sum `∑' (i : ι), F i` are uniformly bounded on `U` by a +summable function, then the sum of `deriv F i` at a point in `U` is the derivative of the +sum. -/ +lemma has_sum_deriv_of_summable_norm {u : ι → ℝ} + (hu : summable u) (hf : ∀ (i : ι), differentiable_on ℂ (F i) U) (hU : is_open U) + (hF_le : ∀ (i : ι) (w : ℂ), w ∈ U → ‖F i w‖ ≤ u i) (hz : z ∈ U) : + has_sum (λ (i : ι), deriv (F i) z) (deriv (λ w : ℂ, ∑' (i : ι), F i w) z) := +begin + rw has_sum, + have hc := (tendsto_uniformly_on_tsum hu hF_le).tendsto_locally_uniformly_on, + convert (hc.deriv (eventually_of_forall $ λ s, differentiable_on.sum + (λ i hi, hf i)) hU).tendsto_at hz using 1, + ext1 s, + exact (deriv_sum (λ i hi, (hf i).differentiable_at (hU.mem_nhds hz))).symm, +end + +end tsums + +end complex diff --git a/src/analysis/complex/open_mapping.lean b/src/analysis/complex/open_mapping.lean new file mode 100644 index 0000000000000..1aa8c27c29283 --- /dev/null +++ b/src/analysis/complex/open_mapping.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2022 Vincent Beffara. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Vincent Beffara +-/ +import analysis.analytic.isolated_zeros +import analysis.complex.cauchy_integral +import analysis.complex.abs_max + +/-! +# The open mapping theorem for holomorphic functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the open mapping theorem for holomorphic functions, namely that an analytic +function on a preconnected set of the complex plane is either constant or open. The main step is to +show a local version of the theorem that states that if `f` is analytic at a point `z₀`, then either +it is constant in a neighborhood of `z₀` or it maps any neighborhood of `z₀` to a neighborhood of +its image `f z₀`. The results extend in higher dimension to `g : E → ℂ`. + +The proof of the local version on `ℂ` goes through two main steps: first, assuming that the function +is not constant around `z₀`, use the isolated zero principle to show that `‖f z‖` is bounded below +on a small `sphere z₀ r` around `z₀`, and then use the maximum principle applied to the auxiliary +function `(λ z, ‖f z - v‖)` to show that any `v` close enough to `f z₀` is in `f '' ball z₀ r`. That +second step is implemented in `diff_cont_on_cl.ball_subset_image_closed_ball`. + +## Main results + +* `analytic_at.eventually_constant_or_nhds_le_map_nhds` is the local version of the open mapping + theorem around a point; +* `analytic_on.is_constant_or_is_open` is the open mapping theorem on a connected open set. +-/ + +open set filter metric complex +open_locale topology + +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {U : set E} + {f : ℂ → ℂ} {g : E → ℂ} {z₀ w : ℂ} {ε r m : ℝ} + +/-- If the modulus of a holomorphic function `f` is bounded below by `ε` on a circle, then its range +contains a disk of radius `ε / 2`. -/ +lemma diff_cont_on_cl.ball_subset_image_closed_ball (h : diff_cont_on_cl ℂ f (ball z₀ r)) + (hr : 0 < r) (hf : ∀ z ∈ sphere z₀ r, ε ≤ ‖f z - f z₀‖) (hz₀ : ∃ᶠ z in 𝓝 z₀, f z ≠ f z₀) : + ball (f z₀) (ε / 2) ⊆ f '' closed_ball z₀ r := +begin + /- This is a direct application of the maximum principle. Pick `v` close to `f z₀`, and look at + the function `λ z, ‖f z - v‖`: it is bounded below on the circle, and takes a small value at `z₀` + so it is not constant on the disk, which implies that its infimum is equal to `0` and hence that + `v` is in the range of `f`. -/ + rintro v hv, + have h1 : diff_cont_on_cl ℂ (λ z, f z - v) (ball z₀ r) := h.sub_const v, + have h2 : continuous_on (λ z, ‖f z - v‖) (closed_ball z₀ r), + from continuous_norm.comp_continuous_on (closure_ball z₀ hr.ne.symm ▸ h1.continuous_on), + have h3 : analytic_on ℂ f (ball z₀ r) := h.differentiable_on.analytic_on is_open_ball, + have h4 : ∀ z ∈ sphere z₀ r, ε / 2 ≤ ‖f z - v‖, + from λ z hz, by linarith [hf z hz, (show ‖v - f z₀‖ < ε / 2, from mem_ball.mp hv), + norm_sub_sub_norm_sub_le_norm_sub (f z) v (f z₀)], + have h5 : ‖f z₀ - v‖ < ε / 2 := by simpa [← dist_eq_norm, dist_comm] using mem_ball.mp hv, + obtain ⟨z, hz1, hz2⟩ : ∃ z ∈ ball z₀ r, is_local_min (λ z, ‖f z - v‖) z, + from exists_local_min_mem_ball h2 (mem_closed_ball_self hr.le) (λ z hz, h5.trans_le (h4 z hz)), + refine ⟨z, ball_subset_closed_ball hz1, sub_eq_zero.mp _⟩, + have h6 := h1.differentiable_on.eventually_differentiable_at (is_open_ball.mem_nhds hz1), + refine (eventually_eq_or_eq_zero_of_is_local_min_norm h6 hz2).resolve_left (λ key, _), + have h7 : ∀ᶠ w in 𝓝 z, f w = f z := by { filter_upwards [key] with h; field_simp }, + replace h7 : ∃ᶠ w in 𝓝[≠] z, f w = f z := (h7.filter_mono nhds_within_le_nhds).frequently, + have h8 : is_preconnected (ball z₀ r) := (convex_ball z₀ r).is_preconnected, + have h9 := h3.eq_on_of_preconnected_of_frequently_eq analytic_on_const h8 hz1 h7, + have h10 : f z = f z₀ := (h9 (mem_ball_self hr)).symm, + exact not_eventually.mpr hz₀ (mem_of_superset (ball_mem_nhds z₀ hr) (h10 ▸ h9)) +end + +/-- A function `f : ℂ → ℂ` which is analytic at a point `z₀` is either constant in a neighborhood +of `z₀`, or behaves locally like an open function (in the sense that the image of every neighborhood +of `z₀` is a neighborhood of `f z₀`, as in `is_open_map_iff_nhds_le`). For a function `f : E → ℂ` +the same result holds, see `analytic_at.eventually_constant_or_nhds_le_map_nhds`. -/ +lemma analytic_at.eventually_constant_or_nhds_le_map_nhds_aux (hf : analytic_at ℂ f z₀) : + (∀ᶠ z in 𝓝 z₀, f z = f z₀) ∨ (𝓝 (f z₀) ≤ map f (𝓝 z₀)) := +begin + /- The function `f` is analytic in a neighborhood of `z₀`; by the isolated zeros principle, if `f` + is not constant in a neighborhood of `z₀`, then it is nonzero, and therefore bounded below, on + every small enough circle around `z₀` and then `diff_cont_on_cl.ball_subset_image_closed_ball` + provides an explicit ball centered at `f z₀` contained in the range of `f`. -/ + refine or_iff_not_imp_left.mpr (λ h, _), + refine (nhds_basis_ball.le_basis_iff (nhds_basis_closed_ball.map f)).mpr (λ R hR, _), + have h1 := (hf.eventually_eq_or_eventually_ne analytic_at_const).resolve_left h, + have h2 : ∀ᶠ z in 𝓝 z₀, analytic_at ℂ f z := (is_open_analytic_at ℂ f).eventually_mem hf, + obtain ⟨ρ, hρ, h3, h4⟩ : ∃ ρ > 0, analytic_on ℂ f (closed_ball z₀ ρ) ∧ + ∀ z ∈ closed_ball z₀ ρ, z ≠ z₀ → f z ≠ f z₀, + by simpa only [set_of_and, subset_inter_iff] using + nhds_basis_closed_ball.mem_iff.mp (h2.and (eventually_nhds_within_iff.mp h1)), + replace h3 : diff_cont_on_cl ℂ f (ball z₀ ρ), + from ⟨h3.differentiable_on.mono ball_subset_closed_ball, + (closure_ball z₀ hρ.lt.ne.symm).symm ▸ h3.continuous_on⟩, + let r := ρ ⊓ R, + have hr : 0 < r := lt_inf_iff.mpr ⟨hρ, hR⟩, + have h5 : closed_ball z₀ r ⊆ closed_ball z₀ ρ := closed_ball_subset_closed_ball inf_le_left, + have h6 : diff_cont_on_cl ℂ f (ball z₀ r) := h3.mono (ball_subset_ball inf_le_left), + have h7 : ∀ z ∈ sphere z₀ r, f z ≠ f z₀, + from λ z hz, h4 z (h5 (sphere_subset_closed_ball hz)) (ne_of_mem_sphere hz hr.ne.symm), + have h8 : (sphere z₀ r).nonempty := normed_space.sphere_nonempty.mpr hr.le, + have h9 : continuous_on (λ x, ‖f x - f z₀‖) (sphere z₀ r), + from continuous_norm.comp_continuous_on + ((h6.sub_const (f z₀)).continuous_on_ball.mono sphere_subset_closed_ball), + obtain ⟨x, hx, hfx⟩ := (is_compact_sphere z₀ r).exists_forall_le h8 h9, + refine ⟨‖f x - f z₀‖ / 2, half_pos (norm_sub_pos_iff.mpr (h7 x hx)), _⟩, + exact (h6.ball_subset_image_closed_ball hr (λ z hz, hfx z hz) (not_eventually.mp h)).trans + (image_subset f (closed_ball_subset_closed_ball inf_le_right)) +end + +/-- The *open mapping theorem* for holomorphic functions, local version: is a function `g : E → ℂ` +is analytic at a point `z₀`, then either it is constant in a neighborhood of `z₀`, or it maps every +neighborhood of `z₀` to a neighborhood of `z₀`. For the particular case of a holomorphic function on +`ℂ`, see `analytic_at.eventually_constant_or_nhds_le_map_nhds_aux`. -/ +lemma analytic_at.eventually_constant_or_nhds_le_map_nhds {z₀ : E} (hg : analytic_at ℂ g z₀) : + (∀ᶠ z in 𝓝 z₀, g z = g z₀) ∨ (𝓝 (g z₀) ≤ map g (𝓝 z₀)) := +begin + /- The idea of the proof is to use the one-dimensional version applied to the restriction of `g` + to lines going through `z₀` (indexed by `sphere (0 : E) 1`). If the restriction is eventually + constant along each of these lines, then the identity theorem implies that `g` is constant on any + ball centered at `z₀` on which it is analytic, and in particular `g` is eventually constant. If on + the other hand there is one line along which `g` is not eventually constant, then the + one-dimensional version of the open mapping theorem can be used to conclude. -/ + let ray : E → ℂ → E := λ z t, z₀ + t • z, + let gray : E → ℂ → ℂ := λ z, (g ∘ ray z), + obtain ⟨r, hr, hgr⟩ := is_open_iff.mp (is_open_analytic_at ℂ g) z₀ hg, + have h1 : ∀ z ∈ sphere (0 : E) 1, analytic_on ℂ (gray z) (ball 0 r), + { refine λ z hz t ht, analytic_at.comp _ _, + { exact hgr (by simpa [ray, norm_smul, mem_sphere_zero_iff_norm.mp hz] using ht) }, + { exact analytic_at_const.add + ((continuous_linear_map.smul_right (continuous_linear_map.id ℂ ℂ) z).analytic_at t) } }, + by_cases (∀ z ∈ sphere (0 : E) 1, ∀ᶠ t in 𝓝 0, gray z t = gray z 0), + { left, -- If g is eventually constant along every direction, then it is eventually constant + refine eventually_of_mem (ball_mem_nhds z₀ hr) (λ z hz, _), + refine (eq_or_ne z z₀).cases_on (congr_arg g) (λ h', _), + replace h' : ‖z - z₀‖ ≠ 0 := by simpa only [ne.def, norm_eq_zero, sub_eq_zero], + let w : E := ‖z - z₀‖⁻¹ • (z - z₀), + have h3 : ∀ t ∈ ball (0 : ℂ) r, gray w t = g z₀, + { have e1 : is_preconnected (ball (0 : ℂ) r) := (convex_ball 0 r).is_preconnected, + have e2 : w ∈ sphere (0 : E) 1 := by simp [w, norm_smul, h'], + specialize h1 w e2, + apply h1.eq_on_of_preconnected_of_eventually_eq analytic_on_const e1 (mem_ball_self hr), + simpa [gray, ray] using h w e2 }, + have h4 : ‖z - z₀‖ < r := by simpa [dist_eq_norm] using mem_ball.mp hz, + replace h4 : ↑‖z - z₀‖ ∈ ball (0 : ℂ) r := by simpa only [mem_ball_zero_iff, norm_eq_abs, + abs_of_real, abs_norm], + simpa only [gray, ray, smul_smul, mul_inv_cancel h', one_smul, add_sub_cancel'_right, + function.comp_app, coe_smul] using h3 ↑‖z - z₀‖ h4 }, + { right, -- Otherwise, it is open along at least one direction and that implies the result + push_neg at h, + obtain ⟨z, hz, hrz⟩ := h, + specialize h1 z hz 0 (mem_ball_self hr), + have h7 := h1.eventually_constant_or_nhds_le_map_nhds_aux.resolve_left hrz, + rw [show gray z 0 = g z₀, by simp [gray, ray], ← map_compose] at h7, + refine h7.trans (map_mono _), + have h10 : continuous (λ (t : ℂ), z₀ + t • z), + from continuous_const.add (continuous_id'.smul continuous_const), + simpa using h10.tendsto 0 } +end + +/-- The *open mapping theorem* for holomorphic functions, global version: if a function `g : E → ℂ` +is analytic on a connected set `U`, then either it is constant on `U`, or it is open on `U` (in the +sense that it maps any open set contained in `U` to an open set in `ℂ`). -/ +theorem analytic_on.is_constant_or_is_open (hg : analytic_on ℂ g U) (hU : is_preconnected U) : + (∃ w, ∀ z ∈ U, g z = w) ∨ (∀ s ⊆ U, is_open s → is_open (g '' s)) := +begin + by_cases ∃ z₀ ∈ U, ∀ᶠ z in 𝓝 z₀, g z = g z₀, + { obtain ⟨z₀, hz₀, h⟩ := h, + exact or.inl ⟨g z₀, hg.eq_on_of_preconnected_of_eventually_eq analytic_on_const hU hz₀ h⟩ }, + { push_neg at h, + refine or.inr (λ s hs1 hs2, is_open_iff_mem_nhds.mpr _), + rintro z ⟨w, hw1, rfl⟩, + exact (hg w (hs1 hw1)).eventually_constant_or_nhds_le_map_nhds.resolve_left (h w (hs1 hw1)) + (image_mem_map (hs2.mem_nhds hw1)) } +end diff --git a/src/analysis/complex/operator_norm.lean b/src/analysis/complex/operator_norm.lean new file mode 100644 index 0000000000000..c6637634392fd --- /dev/null +++ b/src/analysis/complex/operator_norm.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.complex.basic +import analysis.normed_space.operator_norm +import data.complex.determinant + +/-! # The basic continuous linear maps associated to `ℂ` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The continuous linear maps `complex.re_clm` (real part), `complex.im_clm` (imaginary part), +`complex.conj_cle` (conjugation), and `complex.of_real_clm` (inclusion of `ℝ`) were introduced in +`analysis.complex.operator_norm`. This file contains a few calculations requiring more imports: +the operator norm and (for `complex.conj_cle`) the determinant. +-/ + +open continuous_linear_map + +namespace complex + +/-- The determinant of `conj_lie`, as a linear map. -/ +@[simp] lemma det_conj_lie : (conj_lie.to_linear_equiv : ℂ →ₗ[ℝ] ℂ).det = -1 := +det_conj_ae + +/-- The determinant of `conj_lie`, as a linear equiv. -/ +@[simp] lemma linear_equiv_det_conj_lie : conj_lie.to_linear_equiv.det = -1 := +linear_equiv_det_conj_ae + +@[simp] lemma re_clm_norm : ‖re_clm‖ = 1 := +le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $ +calc 1 = ‖re_clm 1‖ : by simp + ... ≤ ‖re_clm‖ : unit_le_op_norm _ _ (by simp) + +@[simp] lemma re_clm_nnnorm : ‖re_clm‖₊ = 1 := subtype.ext re_clm_norm + +@[simp] lemma im_clm_norm : ‖im_clm‖ = 1 := +le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _) $ +calc 1 = ‖im_clm I‖ : by simp + ... ≤ ‖im_clm‖ : unit_le_op_norm _ _ (by simp) + +@[simp] lemma im_clm_nnnorm : ‖im_clm‖₊ = 1 := subtype.ext im_clm_norm + +@[simp] lemma conj_cle_norm : ‖(conj_cle : ℂ →L[ℝ] ℂ)‖ = 1 := +conj_lie.to_linear_isometry.norm_to_continuous_linear_map + +@[simp] lemma conj_cle_nnorm : ‖(conj_cle : ℂ →L[ℝ] ℂ)‖₊ = 1 := subtype.ext conj_cle_norm + +@[simp] lemma of_real_clm_norm : ‖of_real_clm‖ = 1 := of_real_li.norm_to_continuous_linear_map + +@[simp] lemma of_real_clm_nnnorm : ‖of_real_clm‖₊ = 1 := subtype.ext $ of_real_clm_norm + +end complex diff --git a/src/analysis/complex/phragmen_lindelof.lean b/src/analysis/complex/phragmen_lindelof.lean new file mode 100644 index 0000000000000..770b81587ac39 --- /dev/null +++ b/src/analysis/complex/phragmen_lindelof.lean @@ -0,0 +1,868 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.complex.abs_max +import analysis.asymptotics.superpolynomial_decay + +/-! +# Phragmen-Lindelöf principle + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove several versions of the Phragmen-Lindelöf principle, a version of the maximum +modulus principle for an unbounded domain. + +## Main statements + +* `phragmen_lindelof.horizontal_strip`: the Phragmen-Lindelöf principle in a horizontal strip + `{z : ℂ | a < complex.im z < b}`; + +* `phragmen_lindelof.eq_zero_on_horizontal_strip`, `phragmen_lindelof.eq_on_horizontal_strip`: + extensionality lemmas based on the Phragmen-Lindelöf principle in a horizontal strip; + +* `phragmen_lindelof.vertical_strip`: the Phragmen-Lindelöf principle in a vertical strip + `{z : ℂ | a < complex.re z < b}`; + +* `phragmen_lindelof.eq_zero_on_vertical_strip`, `phragmen_lindelof.eq_on_vertical_strip`: + extensionality lemmas based on the Phragmen-Lindelöf principle in a vertical strip; + +* `phragmen_lindelof.quadrant_I`, `phragmen_lindelof.quadrant_II`, `phragmen_lindelof.quadrant_III`, + `phragmen_lindelof.quadrant_IV`: the Phragmen-Lindelöf principle in the coordinate quadrants; + +* `phragmen_lindelof.right_half_plane_of_tendsto_zero_on_real`, + `phragmen_lindelof.right_half_plane_of_bounded_on_real`: two versions of the Phragmen-Lindelöf + principle in the right half-plane; + +* `phragmen_lindelof.eq_zero_on_right_half_plane_of_superexponential_decay`, + `phragmen_lindelof.eq_on_right_half_plane_of_superexponential_decay`: extensionality lemmas based + on the Phragmen-Lindelöf principle in the right half-plane. + +In the case of the right half-plane, we prove a version of the Phragmen-Lindelöf principle that is +useful for Ilyashenko's proof of the individual finiteness theorem (a polynomial vector field on the +real plane has only finitely many limit cycles). +-/ + +open set function filter asymptotics metric complex +open_locale topology filter real + +local notation `expR` := real.exp + +namespace phragmen_lindelof + +/-! +### Auxiliary lemmas +-/ + +variables {E : Type*} [normed_add_comm_group E] + +/-- An auxiliary lemma that combines two double exponential estimates into a similar estimate +on the difference of the functions. -/ +lemma is_O_sub_exp_exp {a : ℝ} {f g : ℂ → E} {l : filter ℂ} {u : ℂ → ℝ} + (hBf : ∃ (c < a) B, f =O[l] (λ z, expR (B * expR (c * |u z|)))) + (hBg : ∃ (c < a) B, g =O[l] (λ z, expR (B * expR (c * |u z|)))) : + ∃ (c < a) B, (f - g) =O[l] (λ z, expR (B * expR (c * |u z|))) := +begin + have : ∀ {c₁ c₂ B₁ B₂}, c₁ ≤ c₂ → 0 ≤ B₂ → B₁ ≤ B₂ → ∀ z, + ‖expR (B₁ * expR (c₁ * |u z|))‖ ≤ ‖expR (B₂ * expR (c₂ * |u z|))‖, + { intros c₁ c₂ B₁ B₂ hc hB₀ hB z, + rw [real.norm_eq_abs, real.norm_eq_abs, real.abs_exp, real.abs_exp, real.exp_le_exp], + exact mul_le_mul hB (real.exp_le_exp.2 $ mul_le_mul_of_nonneg_right hc $ abs_nonneg _) + (real.exp_pos _).le hB₀ }, + rcases hBf with ⟨cf, hcf, Bf, hOf⟩, rcases hBg with ⟨cg, hcg, Bg, hOg⟩, + refine ⟨max cf cg, max_lt hcf hcg, max 0 (max Bf Bg), _⟩, + refine (hOf.trans_le $ this _ _ _).sub (hOg.trans_le $ this _ _ _), + exacts [le_max_left _ _, le_max_left _ _, (le_max_left _ _).trans (le_max_right _ _), + le_max_right _ _, le_max_left _ _, (le_max_right _ _).trans (le_max_right _ _)] +end + +/-- An auxiliary lemma that combines two “exponential of a power” estimates into a similar estimate +on the difference of the functions. -/ +lemma is_O_sub_exp_rpow {a : ℝ} {f g : ℂ → E} {l : filter ℂ} + (hBf : ∃ (c < a) B, f =O[comap complex.abs at_top ⊓ l] (λ z, expR (B * (abs z) ^ c))) + (hBg : ∃ (c < a) B, g =O[comap complex.abs at_top ⊓ l] (λ z, expR (B * (abs z) ^ c))) : + ∃ (c < a) B, (f - g) =O[comap complex.abs at_top ⊓ l] (λ z, expR (B * (abs z) ^ c)) := +begin + have : ∀ {c₁ c₂ B₁ B₂ : ℝ}, c₁ ≤ c₂ → 0 ≤ B₂ → B₁ ≤ B₂ → + (λ z : ℂ, expR (B₁ * (abs z) ^ c₁)) =O[comap complex.abs at_top ⊓ l] + (λ z, expR (B₂ * (abs z) ^ c₂)), + { have : ∀ᶠ z : ℂ in comap complex.abs at_top ⊓ l, 1 ≤ abs z, + from ((eventually_ge_at_top 1).comap _).filter_mono inf_le_left, + refine λ c₁ c₂ B₁ B₂ hc hB₀ hB, is_O.of_bound 1 (this.mono $ λ z hz, _), + rw [one_mul, real.norm_eq_abs, real.norm_eq_abs, real.abs_exp, real.abs_exp, real.exp_le_exp], + exact mul_le_mul hB (real.rpow_le_rpow_of_exponent_le hz hc) + (real.rpow_nonneg_of_nonneg (complex.abs.nonneg _) _) hB₀ }, + rcases hBf with ⟨cf, hcf, Bf, hOf⟩, rcases hBg with ⟨cg, hcg, Bg, hOg⟩, + refine ⟨max cf cg, max_lt hcf hcg, max 0 (max Bf Bg), _⟩, + refine (hOf.trans $ this _ _ _).sub (hOg.trans $ this _ _ _), + exacts [le_max_left _ _, le_max_left _ _, (le_max_left _ _).trans (le_max_right _ _), + le_max_right _ _, le_max_left _ _, (le_max_right _ _).trans (le_max_right _ _)] +end + +variables [normed_space ℂ E] {a b C : ℝ} {f g : ℂ → E} {z : ℂ} + +/-! +### Phragmen-Lindelöf principle in a horizontal strip +-/ + +/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < im z < b}`. +Let `f : ℂ → E` be a function such that + +* `f` is differentiable on `U` and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * exp(c * |re z|))` on `U` for some `c < π / (b - a)`; +* `‖f z‖` is bounded from above by a constant `C` on the boundary of `U`. + +Then `‖f z‖` is bounded by the same constant on the closed strip +`{z : ℂ | a ≤ im z ≤ b}`. Moreover, it suffices to verify the second assumption +only for sufficiently large values of `|re z|`. +-/ +lemma horizontal_strip (hfd : diff_cont_on_cl ℂ f (im ⁻¹' Ioo a b)) + (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.re|)))) + (hle_a : ∀ z : ℂ, im z = a → ‖f z‖ ≤ C) (hle_b : ∀ z, im z = b → ‖f z‖ ≤ C) + (hza : a ≤ im z) (hzb : im z ≤ b) : + ‖f z‖ ≤ C := +begin + -- If `im z = a` or `im z = b`, then we apply `hle_a` or `hle_b`, otherwise `im z ∈ Ioo a b`. + rw le_iff_eq_or_lt at hza hzb, + cases hza with hza hza, { exact hle_a _ hza.symm }, + cases hzb with hzb hzb, { exact hle_b _ hzb }, + -- WLOG, `0 < C`. + suffices : ∀ C' : ℝ, 0 < C' → (∀ w : ℂ, im w = a → ‖f w‖ ≤ C') → + (∀ w : ℂ, im w = b → ‖f w‖ ≤ C') → ‖f z‖ ≤ C', + { refine le_of_forall_le_of_dense (λ C' hC', this C' _ (λ w hw, _) (λ w hw, _)), + { refine ((norm_nonneg (f (a * I))).trans (hle_a _ _)).trans_lt hC', + rw [mul_I_im, of_real_re] }, + exacts [(hle_a _ hw).trans hC'.le, (hle_b _ hw).trans hC'.le] }, + clear_dependent C, intros C hC₀ hle_a hle_b, + -- After a change of variables, we deal with the strip `a - b < im z < a + b` instead + -- of `a < im z < b` + obtain ⟨a, b, rfl, rfl⟩ : ∃ a' b', a = a' - b' ∧ b = a' + b' := + ⟨(a + b) / 2, (b - a) / 2, by ring, by ring⟩, + have hab : a - b < a + b, from hza.trans hzb, + have hb : 0 < b, + by simpa only [sub_eq_add_neg, add_lt_add_iff_left, neg_lt_self_iff] using hab, + rw [add_sub_sub_cancel, ← two_mul, div_mul_eq_div_div] at hB, + have hπb : 0 < π / 2 / b, from div_pos real.pi_div_two_pos hb, + -- Choose some `c B : ℝ` satisfying `hB`, then choose `max c 0 < d < π / 2 / b`. + rcases hB with ⟨c, hc, B, hO⟩, + obtain ⟨d, ⟨hcd, hd₀⟩, hd⟩ : ∃ d, (c < d ∧ 0 < d) ∧ d < π / 2 / b, + by simpa only [max_lt_iff] using exists_between (max_lt hc hπb), + have hb' : d * b < π / 2, from (lt_div_iff hb).1 hd, + set aff : ℂ → ℂ := λ w, d * (w - a * I), + set g : ℝ → ℂ → ℂ := λ ε w, exp (ε * (exp (aff w) + exp (-aff w))), + /- Since `g ε z → 1` as `ε → 0⁻`, it suffices to prove that `‖g ε z • f z‖ ≤ C` + for all negative `ε`. -/ + suffices : ∀ᶠ ε : ℝ in 𝓝[<] 0, ‖g ε z • f z‖ ≤ C, + { refine le_of_tendsto (tendsto.mono_left _ nhds_within_le_nhds) this, + apply ((continuous_of_real.mul continuous_const).cexp.smul continuous_const).norm.tendsto', + simp, apply_instance }, + filter_upwards [self_mem_nhds_within] with ε ε₀, change ε < 0 at ε₀, + -- An upper estimate on `‖g ε w‖` that will be used in two branches of the proof. + obtain ⟨δ, δ₀, hδ⟩ : ∃ δ : ℝ, δ < 0 ∧ ∀ ⦃w⦄, im w ∈ Icc (a - b) (a + b) → + abs (g ε w) ≤ expR (δ * expR (d * |re w|)), + { refine ⟨ε * real.cos (d * b), mul_neg_of_neg_of_pos ε₀ (real.cos_pos_of_mem_Ioo $ abs_lt.1 $ + (abs_of_pos (mul_pos hd₀ hb)).symm ▸ hb'), λ w hw, _⟩, + replace hw : |im (aff w)| ≤ d * b, + { rw [← real.closed_ball_eq_Icc] at hw, + rwa [of_real_mul_im, sub_im, mul_I_im, of_real_re, _root_.abs_mul, abs_of_pos hd₀, + mul_le_mul_left hd₀] }, + simpa only [of_real_mul_re, _root_.abs_mul, abs_of_pos hd₀, sub_re, mul_I_re, of_real_im, + zero_mul, neg_zero, sub_zero] + using abs_exp_mul_exp_add_exp_neg_le_of_abs_im_le ε₀.le hw hb'.le }, + -- `abs (g ε w) ≤ 1` on the lines `w.im = a ± b` (actually, it holds everywhere in the strip) + have hg₁ : ∀ w, (im w = a - b ∨ im w = a + b) → abs (g ε w) ≤ 1, + { refine λ w hw, (hδ $ hw.by_cases _ _).trans (real.exp_le_one_iff.2 _), + exacts [λ h, h.symm ▸ left_mem_Icc.2 hab.le, λ h, h.symm ▸ right_mem_Icc.2 hab.le, + mul_nonpos_of_nonpos_of_nonneg δ₀.le (real.exp_pos _).le] }, + /- Our apriori estimate on `f` implies that `g ε w • f w → 0` as `|w.re| → ∞` along the strip. In + particular, its norm is less than or equal to `C` for sufficiently large `|w.re|`. -/ + obtain ⟨R, hzR, hR⟩ : ∃ R : ℝ, |z.re| < R ∧ ∀ w, |re w| = R → im w ∈ Ioo (a - b) (a + b) → + ‖g ε w • f w‖ ≤ C, + { refine ((eventually_gt_at_top _).and _).exists, + rcases hO.exists_pos with ⟨A, hA₀, hA⟩, + simp only [is_O_with_iff, eventually_inf_principal, eventually_comap, mem_Ioo, ← abs_lt, + mem_preimage, (∘), real.norm_eq_abs, abs_of_pos (real.exp_pos _)] at hA, + suffices : tendsto (λ R, expR (δ * expR (d * R) + B * expR (c * R) + real.log A)) at_top (𝓝 0), + { filter_upwards [this.eventually (ge_mem_nhds hC₀), hA] with R hR Hle w hre him, + calc ‖g ε w • f w‖ ≤ expR (δ * expR (d * R) + B * expR (c * R) + real.log A) : _ + ... ≤ C : hR, + rw [norm_smul, real.exp_add, ← hre, real.exp_add, real.exp_log hA₀, mul_assoc, mul_comm _ A], + exact mul_le_mul (hδ $ Ioo_subset_Icc_self him) (Hle _ hre him) (norm_nonneg _) + (real.exp_pos _).le }, + refine real.tendsto_exp_at_bot.comp _, + suffices H : tendsto (λ R, δ + B * (expR ((d - c) * R))⁻¹) at_top (𝓝 (δ + B * 0)), + { rw [mul_zero, add_zero] at H, + refine tendsto.at_bot_add _ tendsto_const_nhds, + simpa only [id, (∘), add_mul, mul_assoc, ← div_eq_inv_mul, ← real.exp_sub, + ← sub_mul, sub_sub_cancel] + using H.neg_mul_at_top δ₀ (real.tendsto_exp_at_top.comp $ + tendsto_const_nhds.mul_at_top hd₀ tendsto_id) }, + refine tendsto_const_nhds.add (tendsto_const_nhds.mul _), + exact tendsto_inv_at_top_zero.comp (real.tendsto_exp_at_top.comp $ + tendsto_const_nhds.mul_at_top (sub_pos.2 hcd) tendsto_id) }, + have hR₀ : 0 < R, from (_root_.abs_nonneg _).trans_lt hzR, + /- Finally, we apply the bounded version of the maximum modulus principle to the rectangle + `(-R, R) × (a - b, a + b)`. The function is bounded by `C` on the horizontal sides by assumption + (and because `‖g ε w‖ ≤ 1`) and on the vertical sides by the choice of `R`. -/ + have hgd : differentiable ℂ (g ε), + from ((((differentiable_id.sub_const _).const_mul _).cexp.add + ((differentiable_id.sub_const _).const_mul _).neg.cexp).const_mul _).cexp, + replace hd : diff_cont_on_cl ℂ (λ w, g ε w • f w) (Ioo (-R) R ×ℂ Ioo (a - b) (a + b)), + from (hgd.diff_cont_on_cl.smul hfd).mono (inter_subset_right _ _), + convert norm_le_of_forall_mem_frontier_norm_le ((bounded_Ioo _ _).re_prod_im (bounded_Ioo _ _)) + hd (λ w hw, _) _, + { have hwc := frontier_subset_closure hw, + rw [frontier_re_prod_im, closure_Ioo (neg_lt_self hR₀).ne, frontier_Ioo hab, + closure_Ioo hab.ne, frontier_Ioo (neg_lt_self hR₀)] at hw, + by_cases him : w.im = a - b ∨ w.im = a + b, + { rw [closure_re_prod_im, closure_Ioo (neg_lt_self hR₀).ne] at hwc, + rw [norm_smul, ← one_mul C], + exact mul_le_mul (hg₁ _ him) (him.by_cases (hle_a _) (hle_b _)) (norm_nonneg _) zero_le_one }, + { replace hw : w ∈ {-R, R} ×ℂ Icc (a - b) (a + b), from hw.resolve_left (λ h, him h.2), + have hw' := eq_endpoints_or_mem_Ioo_of_mem_Icc hw.2, rw ← or.assoc at hw', + exact hR _ ((abs_eq hR₀.le).2 hw.1.symm) (hw'.resolve_left him) } }, + { rw [closure_re_prod_im, closure_Ioo hab.ne, closure_Ioo (neg_lt_self hR₀).ne], + exact ⟨abs_le.1 hzR.le, ⟨hza.le, hzb.le⟩⟩ } +end + +/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < im z < b}`. +Let `f : ℂ → E` be a function such that + +* `f` is differentiable on `U` and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * exp(c * |re z|))` on `U` for some `c < π / (b - a)`; +* `f z = 0` on the boundary of `U`. + +Then `f` is equal to zero on the closed strip `{z : ℂ | a ≤ im z ≤ b}`. +-/ +lemma eq_zero_on_horizontal_strip (hd : diff_cont_on_cl ℂ f (im ⁻¹' Ioo a b)) + (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.re|)))) + (ha : ∀ z : ℂ, z.im = a → f z = 0) (hb : ∀ z : ℂ, z.im = b → f z = 0) : + eq_on f 0 (im ⁻¹' Icc a b) := +λ z hz, norm_le_zero_iff.1 $ horizontal_strip hd hB + (λ z hz, (ha z hz).symm ▸ norm_zero.le) (λ z hz, (hb z hz).symm ▸ norm_zero.le) hz.1 hz.2 + +/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < im z < b}`. +Let `f g : ℂ → E` be functions such that + +* `f` and `g` are differentiable on `U` and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * exp(c * |re z|))` on `U` for some + `c < π / (b - a)`; +* `f z = g z` on the boundary of `U`. + +Then `f` is equal to `g` on the closed strip `{z : ℂ | a ≤ im z ≤ b}`. +-/ +lemma eq_on_horizontal_strip {g : ℂ → E} (hdf : diff_cont_on_cl ℂ f (im ⁻¹' Ioo a b)) + (hBf : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.re|)))) + (hdg : diff_cont_on_cl ℂ g (im ⁻¹' Ioo a b)) + (hBg : ∃ (c < π / (b - a)) B, g =O[comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.re|)))) + (ha : ∀ z : ℂ, z.im = a → f z = g z) (hb : ∀ z : ℂ, z.im = b → f z = g z) : + eq_on f g (im ⁻¹' Icc a b) := +λ z hz, sub_eq_zero.1 (eq_zero_on_horizontal_strip (hdf.sub hdg) (is_O_sub_exp_exp hBf hBg) + (λ w hw, sub_eq_zero.2 (ha w hw)) (λ w hw, sub_eq_zero.2 (hb w hw)) hz) + +/-! +### Phragmen-Lindelöf principle in a vertical strip +-/ + +/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < re z < b}`. +Let `f : ℂ → E` be a function such that + +* `f` is differentiable on `U` and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * exp(c * |im z|))` on `U` for some `c < π / (b - a)`; +* `‖f z‖` is bounded from above by a constant `C` on the boundary of `U`. + +Then `‖f z‖` is bounded by the same constant on the closed strip +`{z : ℂ | a ≤ re z ≤ b}`. Moreover, it suffices to verify the second assumption +only for sufficiently large values of `|im z|`. +-/ +lemma vertical_strip (hfd : diff_cont_on_cl ℂ f (re ⁻¹' Ioo a b)) + (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.im|)))) + (hle_a : ∀ z : ℂ, re z = a → ‖f z‖ ≤ C) (hle_b : ∀ z, re z = b → ‖f z‖ ≤ C) + (hza : a ≤ re z) (hzb : re z ≤ b) : + ‖f z‖ ≤ C := +begin + suffices : ‖(λ z, f (z * (-I))) (z * I)‖ ≤ C, by simpa [mul_assoc] using this, + have H : maps_to (λ z, z * (-I)) (im ⁻¹' Ioo a b) (re ⁻¹' Ioo a b), + { intros z hz, simpa using hz }, + refine horizontal_strip (hfd.comp (differentiable_id.mul_const _).diff_cont_on_cl H) + _ (λ z hz, hle_a _ _) (λ z hz, hle_b _ _) _ _, + { refine Exists₃.imp (λ c hc B hO, _) hB, + have : tendsto (λ z, z * (-I)) (comap (has_abs.abs ∘ re) at_top ⊓ 𝓟 (im ⁻¹' Ioo a b)) + (comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)), + { refine (tendsto_comap_iff.2 _).inf H.tendsto, + simpa [(∘)] using tendsto_comap }, + simpa [(∘)] using hO.comp_tendsto this }, + all_goals { simpa } +end + +/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < re z < b}`. +Let `f : ℂ → E` be a function such that + +* `f` is differentiable on `U` and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * exp(c * |im z|))` on `U` for some `c < π / (b - a)`; +* `f z = 0` on the boundary of `U`. + +Then `f` is equal to zero on the closed strip `{z : ℂ | a ≤ re z ≤ b}`. +-/ +lemma eq_zero_on_vertical_strip (hd : diff_cont_on_cl ℂ f (re ⁻¹' Ioo a b)) + (hB : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.im|)))) + (ha : ∀ z : ℂ, re z = a → f z = 0) (hb : ∀ z : ℂ, re z = b → f z = 0) : + eq_on f 0 (re ⁻¹' Icc a b) := +λ z hz, norm_le_zero_iff.1 $ vertical_strip hd hB + (λ z hz, (ha z hz).symm ▸ norm_zero.le) (λ z hz, (hb z hz).symm ▸ norm_zero.le) hz.1 hz.2 + +/-- **Phragmen-Lindelöf principle** in a strip `U = {z : ℂ | a < re z < b}`. +Let `f g : ℂ → E` be functions such that + +* `f` and `g` are differentiable on `U` and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * exp(c * |im z|))` on `U` for some + `c < π / (b - a)`; +* `f z = g z` on the boundary of `U`. + +Then `f` is equal to `g` on the closed strip `{z : ℂ | a ≤ re z ≤ b}`. +-/ +lemma eq_on_vertical_strip {g : ℂ → E} (hdf : diff_cont_on_cl ℂ f (re ⁻¹' Ioo a b)) + (hBf : ∃ (c < π / (b - a)) B, f =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.im|)))) + (hdg : diff_cont_on_cl ℂ g (re ⁻¹' Ioo a b)) + (hBg : ∃ (c < π / (b - a)) B, g =O[comap (has_abs.abs ∘ im) at_top ⊓ 𝓟 (re ⁻¹' Ioo a b)] + (λ z, expR (B * expR (c * |z.im|)))) + (ha : ∀ z : ℂ, re z = a → f z = g z) (hb : ∀ z : ℂ, re z = b → f z = g z) : + eq_on f g (re ⁻¹' Icc a b) := +λ z hz, sub_eq_zero.1 (eq_zero_on_vertical_strip (hdf.sub hdg) (is_O_sub_exp_exp hBf hBg) + (λ w hw, sub_eq_zero.2 (ha w hw)) (λ w hw, sub_eq_zero.2 (hb w hw)) hz) + +/-! +### Phragmen-Lindelöf principle in coordinate quadrants +-/ + +/-- **Phragmen-Lindelöf principle** in the first quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open first quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open first quadrant + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant `C` on the boundary of the first quadrant. + +Then `‖f z‖` is bounded from above by the same constant on the closed first quadrant. -/ +lemma quadrant_I (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Ioi 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, 0 ≤ x → ‖f x‖ ≤ C) (him : ∀ x : ℝ, 0 ≤ x → ‖f (x * I)‖ ≤ C) + (hz_re : 0 ≤ z.re) (hz_im : 0 ≤ z.im) : + ‖f z‖ ≤ C := +begin + -- The case `z = 0` is trivial. + rcases eq_or_ne z 0 with rfl|hzne, { exact hre 0 le_rfl }, + -- Otherwise, `z = e ^ ζ` for some `ζ : ℂ`, `0 < Im ζ < π / 2`. + obtain ⟨ζ, hζ, rfl⟩ : ∃ ζ : ℂ, ζ.im ∈ Icc 0 (π / 2) ∧ exp ζ = z, + { refine ⟨log z, _, exp_log hzne⟩, + rw log_im, + exact ⟨arg_nonneg_iff.2 hz_im, arg_le_pi_div_two_iff.2 (or.inl hz_re)⟩ }, + clear hz_re hz_im hzne, + -- We are going to apply `phragmen_lindelof.horizontal_strip` to `f ∘ complex.exp` and `ζ`. + change ‖(f ∘ exp) ζ‖ ≤ C, + have H : maps_to exp (im ⁻¹' Ioo 0 (π / 2)) (Ioi 0 ×ℂ Ioi 0), + { intros z hz, + rw [mem_re_prod_im, exp_re, exp_im, mem_Ioi, mem_Ioi], + refine ⟨mul_pos (real.exp_pos _) + (real.cos_pos_of_mem_Ioo ⟨(neg_lt_zero.2 $ div_pos real.pi_pos two_pos).trans hz.1, hz.2⟩), + mul_pos (real.exp_pos _) + (real.sin_pos_of_mem_Ioo ⟨hz.1, hz.2.trans (half_lt_self real.pi_pos)⟩)⟩ }, + refine horizontal_strip (hd.comp differentiable_exp.diff_cont_on_cl H) _ _ _ hζ.1 hζ.2; + clear hζ ζ, + { -- The estimate `hB` on `f` implies the required estimate on + -- `f ∘ exp` with the same `c` and `B' = max B 0`. + rw [sub_zero, div_div_cancel' real.pi_pos.ne'], + rcases hB with ⟨c, hc, B, hO⟩, + refine ⟨c, hc, max B 0, _⟩, + rw [← comap_comap, comap_abs_at_top, comap_sup, inf_sup_right], + -- We prove separately the estimates as `ζ.re → ∞` and as `ζ.re → -∞` + refine is_O.sup _ ((hO.comp_tendsto $ tendsto_exp_comap_re_at_top.inf H.tendsto).trans $ + is_O.of_bound 1 _), + { -- For the estimate as `ζ.re → -∞`, note that `f` is continuous within the first quadrant at + -- zero, hence `f (exp ζ)` has a limit as `ζ.re → -∞`, `0 < ζ.im < π / 2`. + have hc : continuous_within_at f (Ioi 0 ×ℂ Ioi 0) 0, + { refine (hd.continuous_on _ _).mono subset_closure, + simp [closure_re_prod_im, mem_re_prod_im] }, + refine ((hc.tendsto.comp $ tendsto_exp_comap_re_at_bot.inf + H.tendsto).is_O_one ℝ).trans (is_O_of_le _ (λ w, _)), + rw [norm_one, real.norm_of_nonneg (real.exp_pos _).le, real.one_le_exp_iff], + exact mul_nonneg (le_max_right _ _) (real.exp_pos _).le }, + { -- For the estimate as `ζ.re → ∞`, we reuse the uppoer estimate on `f` + simp only [eventually_inf_principal, eventually_comap, comp_app, one_mul, + real.norm_of_nonneg (real.exp_pos _).le, abs_exp, ← real.exp_mul, real.exp_le_exp], + refine (eventually_ge_at_top 0).mono (λ x hx z hz hz', _), + rw [hz, _root_.abs_of_nonneg hx, mul_comm _ c], + exact mul_le_mul_of_nonneg_right (le_max_left _ _) (real.exp_pos _).le } }, + { -- If `ζ.im = 0`, then `complex.exp ζ` is a positive real number + intros ζ hζ, lift ζ to ℝ using hζ, + rw [comp_app, ← of_real_exp], + exact hre _ (real.exp_pos _).le }, + { -- If `ζ.im = π / 2`, then `complex.exp ζ` is a purely imaginary number with positive `im` + intros ζ hζ, + rw [← re_add_im ζ, hζ, comp_app, exp_add_mul_I, ← of_real_cos, ← of_real_sin, + real.cos_pi_div_two, real.sin_pi_div_two, of_real_zero, of_real_one, one_mul, zero_add, + ← of_real_exp], + exact him _ (real.exp_pos _).le } +end + +/-- **Phragmen-Lindelöf principle** in the first quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open first quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open first quadrant + for some `A`, `B`, and `c < 2`; +* `f` is equal to zero on the boundary of the first quadrant. + +Then `f` is equal to zero on the closed first quadrant. -/ +lemma eq_zero_on_quadrant_I (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Ioi 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, 0 ≤ x → f x = 0) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = 0) : + eq_on f 0 {z | 0 ≤ z.re ∧ 0 ≤ z.im} := +λ z hz, norm_le_zero_iff.1 $ quadrant_I hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx) + (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2 + +/-- **Phragmen-Lindelöf principle** in the first quadrant. Let `f g : ℂ → E` be functions such that + +* `f` and `g` are differentiable in the open first quadrant and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open first + quadrant for some `A`, `B`, and `c < 2`; +* `f` is equal to `g` on the boundary of the first quadrant. + +Then `f` is equal to `g` on the closed first quadrant. -/ +lemma eq_on_quadrant_I (hdf : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Ioi 0)) + (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hdg : diff_cont_on_cl ℂ g (Ioi 0 ×ℂ Ioi 0)) + (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, 0 ≤ x → f x = g x) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = g (x * I)) : + eq_on f g {z | 0 ≤ z.re ∧ 0 ≤ z.im} := +λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_I (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg) + (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz + +/-- **Phragmen-Lindelöf principle** in the second quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open second quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open second quadrant + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant `C` on the boundary of the second quadrant. + +Then `‖f z‖` is bounded from above by the same constant on the closed second quadrant. -/ +lemma quadrant_II (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Ioi 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, x ≤ 0 → ‖f x‖ ≤ C) (him : ∀ x : ℝ, 0 ≤ x → ‖f (x * I)‖ ≤ C) + (hz_re : z.re ≤ 0) (hz_im : 0 ≤ z.im) : + ‖f z‖ ≤ C := +begin + obtain ⟨z, rfl⟩ : ∃ z', z' * I = z, from ⟨z / I, div_mul_cancel _ I_ne_zero⟩, + simp only [mul_I_re, mul_I_im, neg_nonpos] at hz_re hz_im, + change ‖(f ∘ (* I)) z‖ ≤ C, + have H : maps_to (* I) (Ioi 0 ×ℂ Ioi 0) (Iio 0 ×ℂ Ioi 0), + { intros w hw, + simpa only [mem_re_prod_im, mul_I_re, mul_I_im, neg_lt_zero, mem_Iio] using hw.symm }, + refine quadrant_I (hd.comp (differentiable_id.mul_const _).diff_cont_on_cl H) + (Exists₃.imp (λ c hc B hO, _) hB) him (λ x hx, _) hz_im hz_re, + { simpa only [(∘), map_mul, abs_I, mul_one] + using hO.comp_tendsto ((tendsto_mul_right_cobounded I_ne_zero).inf H.tendsto) }, + { rw [comp_app, mul_assoc, I_mul_I, mul_neg_one, ← of_real_neg], + exact hre _ (neg_nonpos.2 hx) } +end + +/-- **Phragmen-Lindelöf principle** in the second quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open second quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open second quadrant + for some `A`, `B`, and `c < 2`; +* `f` is equal to zero on the boundary of the second quadrant. + +Then `f` is equal to zero on the closed second quadrant. -/ +lemma eq_zero_on_quadrant_II (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Ioi 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, x ≤ 0 → f x = 0) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = 0) : + eq_on f 0 {z | z.re ≤ 0 ∧ 0 ≤ z.im} := +λ z hz, norm_le_zero_iff.1 $ quadrant_II hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx) + (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2 + +/-- **Phragmen-Lindelöf principle** in the second quadrant. Let `f g : ℂ → E` be functions such that + +* `f` and `g` are differentiable in the open second quadrant and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open second + quadrant for some `A`, `B`, and `c < 2`; +* `f` is equal to `g` on the boundary of the second quadrant. + +Then `f` is equal to `g` on the closed second quadrant. -/ +lemma eq_on_quadrant_II (hdf : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Ioi 0)) + (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hdg : diff_cont_on_cl ℂ g (Iio 0 ×ℂ Ioi 0)) + (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Ioi 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, x ≤ 0 → f x = g x) (him : ∀ x : ℝ, 0 ≤ x → f (x * I) = g (x * I)) : + eq_on f g {z | z.re ≤ 0 ∧ 0 ≤ z.im} := +λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_II (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg) + (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz + +/-- **Phragmen-Lindelöf principle** in the third quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open third quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp (B * (abs z) ^ c)` on the open third quadrant + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant `C` on the boundary of the third quadrant. + +Then `‖f z‖` is bounded from above by the same constant on the closed third quadrant. -/ +lemma quadrant_III (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Iio 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, x ≤ 0 → ‖f x‖ ≤ C) (him : ∀ x : ℝ, x ≤ 0 → ‖f (x * I)‖ ≤ C) + (hz_re : z.re ≤ 0) (hz_im : z.im ≤ 0) : + ‖f z‖ ≤ C := +begin + obtain ⟨z, rfl⟩ : ∃ z', -z' = z, from ⟨-z, neg_neg z⟩, + simp only [neg_re, neg_im, neg_nonpos] at hz_re hz_im, + change ‖(f ∘ has_neg.neg) z‖ ≤ C, + have H : maps_to has_neg.neg (Ioi 0 ×ℂ Ioi 0) (Iio 0 ×ℂ Iio 0), + { intros w hw, + simpa only [mem_re_prod_im, neg_re, neg_im, neg_lt_zero, mem_Iio] using hw }, + refine quadrant_I (hd.comp differentiable_neg.diff_cont_on_cl H) _ (λ x hx, _) (λ x hx, _) + hz_re hz_im, + { refine Exists₃.imp (λ c hc B hO, _) hB, + simpa only [(∘), complex.abs.map_neg] + using hO.comp_tendsto (tendsto_neg_cobounded.inf H.tendsto) }, + { rw [comp_app, ← of_real_neg], + exact hre (-x) (neg_nonpos.2 hx) }, + { rw [comp_app, ← neg_mul, ← of_real_neg], + exact him (-x) (neg_nonpos.2 hx) } +end + +/-- **Phragmen-Lindelöf principle** in the third quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open third quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open third quadrant + for some `A`, `B`, and `c < 2`; +* `f` is equal to zero on the boundary of the third quadrant. + +Then `f` is equal to zero on the closed third quadrant. -/ +lemma eq_zero_on_quadrant_III (hd : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Iio 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, x ≤ 0 → f x = 0) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = 0) : + eq_on f 0 {z | z.re ≤ 0 ∧ z.im ≤ 0} := +λ z hz, norm_le_zero_iff.1 $ quadrant_III hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx) + (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2 + +/-- **Phragmen-Lindelöf principle** in the third quadrant. Let `f g : ℂ → E` be functions such that + +* `f` and `g` are differentiable in the open third quadrant and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open third + quadrant for some `A`, `B`, and `c < 2`; +* `f` is equal to `g` on the boundary of the third quadrant. + +Then `f` is equal to `g` on the closed third quadrant. -/ +lemma eq_on_quadrant_III (hdf : diff_cont_on_cl ℂ f (Iio 0 ×ℂ Iio 0)) + (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hdg : diff_cont_on_cl ℂ g (Iio 0 ×ℂ Iio 0)) + (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Iio 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, x ≤ 0 → f x = g x) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = g (x * I)) : + eq_on f g {z | z.re ≤ 0 ∧ z.im ≤ 0} := +λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_III (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg) + (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz + +/-- **Phragmen-Lindelöf principle** in the fourth quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open fourth quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open fourth quadrant + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant `C` on the boundary of the fourth quadrant. + +Then `‖f z‖` is bounded from above by the same constant on the closed fourth quadrant. -/ +lemma quadrant_IV (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Iio 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, 0 ≤ x → ‖f x‖ ≤ C) (him : ∀ x : ℝ, x ≤ 0 → ‖f (x * I)‖ ≤ C) + (hz_re : 0 ≤ z.re) (hz_im : z.im ≤ 0) : + ‖f z‖ ≤ C := +begin + obtain ⟨z, rfl⟩ : ∃ z', -z' = z, from ⟨-z, neg_neg z⟩, + simp only [neg_re, neg_im, neg_nonpos, neg_nonneg] at hz_re hz_im, + change ‖(f ∘ has_neg.neg) z‖ ≤ C, + have H : maps_to has_neg.neg (Iio 0 ×ℂ Ioi 0) (Ioi 0 ×ℂ Iio 0), + { intros w hw, + simpa only [mem_re_prod_im, neg_re, neg_im, neg_lt_zero, neg_pos, mem_Ioi, mem_Iio] using hw }, + refine quadrant_II (hd.comp differentiable_neg.diff_cont_on_cl H) _ (λ x hx, _) (λ x hx, _) + hz_re hz_im, + { refine Exists₃.imp (λ c hc B hO, _) hB, + simpa only [(∘), complex.abs.map_neg] + using hO.comp_tendsto (tendsto_neg_cobounded.inf H.tendsto) }, + { rw [comp_app, ← of_real_neg], + exact hre (-x) (neg_nonneg.2 hx) }, + { rw [comp_app, ← neg_mul, ← of_real_neg], + exact him (-x) (neg_nonpos.2 hx) } +end + +/-- **Phragmen-Lindelöf principle** in the fourth quadrant. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open fourth quadrant and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open fourth quadrant + for some `A`, `B`, and `c < 2`; +* `f` is equal to zero on the boundary of the fourth quadrant. + +Then `f` is equal to zero on the closed fourth quadrant. -/ +lemma eq_zero_on_quadrant_IV (hd : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Iio 0)) + (hB : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, 0 ≤ x → f x = 0) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = 0) : + eq_on f 0 {z | 0 ≤ z.re ∧ z.im ≤ 0} := +λ z hz, norm_le_zero_iff.1 $ quadrant_IV hd hB (λ x hx, norm_le_zero_iff.2 $ hre x hx) + (λ x hx, norm_le_zero_iff.2 $ him x hx) hz.1 hz.2 + +/-- **Phragmen-Lindelöf principle** in the fourth quadrant. Let `f g : ℂ → E` be functions such that + +* `f` and `g` are differentiable in the open fourth quadrant and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open fourth + quadrant for some `A`, `B`, and `c < 2`; +* `f` is equal to `g` on the boundary of the fourth quadrant. + +Then `f` is equal to `g` on the closed fourth quadrant. -/ +lemma eq_on_quadrant_IV (hdf : diff_cont_on_cl ℂ f (Ioi 0 ×ℂ Iio 0)) + (hBf : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hdg : diff_cont_on_cl ℂ g (Ioi 0 ×ℂ Iio 0)) + (hBg : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 (Ioi 0 ×ℂ Iio 0)] + (λ z, expR (B * (abs z) ^ c))) + (hre : ∀ x : ℝ, 0 ≤ x → f x = g x) (him : ∀ x : ℝ, x ≤ 0 → f (x * I) = g (x * I)) : + eq_on f g {z | 0 ≤ z.re ∧ z.im ≤ 0} := +λ z hz, sub_eq_zero.1 $ eq_zero_on_quadrant_IV (hdf.sub hdg) (is_O_sub_exp_rpow hBf hBg) + (λ x hx, sub_eq_zero.2 $ hre x hx) (λ x hx, sub_eq_zero.2 $ him x hx) hz + +/-! +### Phragmen-Lindelöf principle in the right half-plane +-/ + +/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open right half-plane and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open right half-plane + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant `C` on the imaginary axis; +* `f x → 0` as `x : ℝ` tends to infinity. + +Then `‖f z‖` is bounded from above by the same constant on the closed right half-plane. +See also `phragmen_lindelof.right_half_plane_of_bounded_on_real` for a stronger version. -/ +lemma right_half_plane_of_tendsto_zero_on_real (hd : diff_cont_on_cl ℂ f {z | 0 < z.re}) + (hexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}] + (λ z, expR (B * (abs z) ^ c))) + (hre : tendsto (λ x : ℝ, f x) at_top (𝓝 0)) (him : ∀ x : ℝ, ‖f (x * I)‖ ≤ C) (hz : 0 ≤ z.re) : + ‖f z‖ ≤ C := +begin + /- We are going to apply the Phragmen-Lindelöf principle in the first and fourth quadrants. + The lemmas immediately imply that for any upper estimate `C'` on `‖f x‖`, `x : ℝ`, `0 ≤ x`, + the number `max C C'` is an upper estimate on `f` in the whole right half-plane. -/ + revert z, + have hle : ∀ C', (∀ x : ℝ, 0 ≤ x → ‖f x‖ ≤ C') → ∀ z : ℂ, 0 ≤ z.re → ‖f z‖ ≤ max C C', + { intros C' hC' z hz, + cases le_total z.im 0, + { refine quadrant_IV (hd.mono $ λ _, and.left) (Exists₃.imp (λ c hc B hO, _) hexp) + (λ x hx, (hC' x hx).trans $ le_max_right _ _) (λ x hx, (him x).trans (le_max_left _ _)) + hz h, + exact hO.mono (inf_le_inf_left _ $ principal_mono.2 $ λ _, and.left) }, + { refine quadrant_I (hd.mono $ λ _, and.left) (Exists₃.imp (λ c hc B hO, _) hexp) + (λ x hx, (hC' x hx).trans $ le_max_right _ _) (λ x hx, (him x).trans (le_max_left _ _)) + hz h, + exact hO.mono (inf_le_inf_left _ $ principal_mono.2 $ λ _, and.left) } }, + -- Since `f` is continuous on `Ici 0` and `‖f x‖` tends to zero as `x → ∞`, + -- the norm `‖f x‖` takes its maximum value at some `x₀ : ℝ`. + obtain ⟨x₀, hx₀, hmax⟩ : ∃ x : ℝ, 0 ≤ x ∧ ∀ y : ℝ, 0 ≤ y → ‖f y‖ ≤ ‖f x‖, + { have hfc : continuous_on (λ x : ℝ, f x) (Ici 0), + { refine hd.continuous_on.comp continuous_of_real.continuous_on (λ x hx, _), + rwa closure_set_of_lt_re }, + by_cases h₀ : ∀ x : ℝ, 0 ≤ x → f x = 0, + { refine ⟨0, le_rfl, λ y hy, _⟩, rw [h₀ y hy, h₀ 0 le_rfl] }, + push_neg at h₀, + rcases h₀ with ⟨x₀, hx₀, hne⟩, + have hlt : ‖(0 : E)‖ < ‖f x₀‖, by rwa [norm_zero, norm_pos_iff], + suffices : ∀ᶠ x : ℝ in cocompact ℝ ⊓ 𝓟 (Ici 0), ‖f x‖ ≤ ‖f x₀‖, + by simpa only [exists_prop] using hfc.norm.exists_forall_ge' is_closed_Ici hx₀ this, + rw [real.cocompact_eq, inf_sup_right, (disjoint_at_bot_principal_Ici (0 : ℝ)).eq_bot, + bot_sup_eq], + exact (hre.norm.eventually $ ge_mem_nhds hlt).filter_mono inf_le_left }, + cases le_or_lt (‖f x₀‖) C, + { -- If `‖f x₀‖ ≤ C`, then `hle` implies the required estimate + simpa only [max_eq_left h] using hle _ hmax }, + { -- Otherwise, `‖f z‖ ≤ ‖f x₀‖` for all `z` in the right half-plane due to `hle`. + replace hmax : is_max_on (norm ∘ f) {z | 0 < z.re} x₀, + { rintros z (hz : 0 < z.re), + simpa [max_eq_right h.le] using hle _ hmax _ hz.le }, + -- Due to the maximum modulus principle applied to the closed ball of radius `x₀.re`, + -- `‖f 0‖ = ‖f x₀‖`. + have : ‖f 0‖ = ‖f x₀‖, + { apply norm_eq_norm_of_is_max_on_of_ball_subset hd hmax, + -- move to a lemma? + intros z hz, + rw [mem_ball, dist_zero_left, dist_eq, norm_eq_abs, complex.abs_of_nonneg hx₀] at hz, + rw mem_set_of_eq, + contrapose! hz, + calc x₀ ≤ x₀ - z.re : (le_sub_self_iff _).2 hz + ... ≤ |x₀ - z.re| : le_abs_self _ + ... = |(z - x₀).re| : by rw [sub_re, of_real_re, _root_.abs_sub_comm] + ... ≤ abs (z - x₀) : abs_re_le_abs _ }, + -- Thus we have `C < ‖f x₀‖ = ‖f 0‖ ≤ C`. Contradiction completes the proof. + refine (h.not_le $ this ▸ _).elim, + simpa using him 0 } +end + +/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open right half-plane and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open right half-plane + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant `C` on the imaginary axis; +* `‖f x‖` is bounded from above by a constant for large real values of `x`. + +Then `‖f z‖` is bounded from above by `C` on the closed right half-plane. +See also `phragmen_lindelof.right_half_plane_of_tendsto_zero_on_real` for a weaker version. -/ +lemma right_half_plane_of_bounded_on_real (hd : diff_cont_on_cl ℂ f {z | 0 < z.re}) + (hexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}] + (λ z, expR (B * (abs z) ^ c))) + (hre : is_bounded_under (≤) at_top (λ x : ℝ, ‖f x‖)) + (him : ∀ x : ℝ, ‖f (x * I)‖ ≤ C) (hz : 0 ≤ z.re) : + ‖f z‖ ≤ C := +begin + -- For each `ε < 0`, the function `λ z, exp (ε * z) • f z` satisfies assumptions of + -- `right_half_plane_of_tendsto_zero_on_real`, hence `‖exp (ε * z) • f z‖ ≤ C` for all `ε < 0`. + -- Taking the limit as `ε → 0`, we obtain the required inequality. + suffices : ∀ᶠ ε : ℝ in 𝓝[<] 0, ‖exp (ε * z) • f z‖ ≤ C, + { refine le_of_tendsto (tendsto.mono_left _ nhds_within_le_nhds) this, + apply ((continuous_of_real.mul continuous_const).cexp.smul continuous_const).norm.tendsto', + simp, apply_instance }, + filter_upwards [self_mem_nhds_within] with ε ε₀, change ε < 0 at ε₀, + set g : ℂ → E := λ z, exp (ε * z) • f z, change ‖g z‖ ≤ C, + replace hd : diff_cont_on_cl ℂ g {z : ℂ | 0 < z.re}, + from (differentiable_id.const_mul _).cexp.diff_cont_on_cl.smul hd, + have hgn : ∀ z, ‖g z‖ = expR (ε * z.re) * ‖f z‖, + { intro z, rw [norm_smul, norm_eq_abs, abs_exp, of_real_mul_re] }, + refine right_half_plane_of_tendsto_zero_on_real hd _ _ (λ y, _) hz, + { refine Exists₃.imp (λ c hc B hO, (is_O.of_bound 1 _).trans hO) hexp, + refine (eventually_inf_principal.2 $ eventually_of_forall $ λ z hz, _), + rw [hgn, one_mul], + refine mul_le_of_le_one_left (norm_nonneg _) (real.exp_le_one_iff.2 _), + exact mul_nonpos_of_nonpos_of_nonneg ε₀.le (le_of_lt hz) }, + { simp_rw [g, ← of_real_mul, ← of_real_exp, coe_smul], + have h₀ : tendsto (λ x : ℝ, expR (ε * x)) at_top (𝓝 0), + from real.tendsto_exp_at_bot.comp (tendsto_const_nhds.neg_mul_at_top ε₀ tendsto_id), + exact h₀.zero_smul_is_bounded_under_le hre }, + { rw [hgn, of_real_mul_re, I_re, mul_zero, mul_zero, real.exp_zero, one_mul], + exact him y } +end + +/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f : ℂ → E` be a function such that + +* `f` is differentiable in the open right half-plane and is continuous on its closure; +* `‖f z‖` is bounded from above by `A * exp(B * (abs z) ^ c)` on the open right half-plane + for some `c < 2`; +* `‖f z‖` is bounded from above by a constant on the imaginary axis; +* `f x`, `x : ℝ`, tends to zero superexponentially fast as `x → ∞`: + for any natural `n`, `exp (n * x) * ‖f x‖` tends to zero as `x → ∞`. + +Then `f` is equal to zero on the closed right half-plane. -/ +lemma eq_zero_on_right_half_plane_of_superexponential_decay + (hd : diff_cont_on_cl ℂ f {z | 0 < z.re}) + (hexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}] + (λ z, expR (B * (abs z) ^ c))) + (hre : superpolynomial_decay at_top expR (λ x, ‖f x‖)) + (him : ∃ C, ∀ x : ℝ, ‖f (x * I)‖ ≤ C) : + eq_on f 0 {z : ℂ | 0 ≤ z.re} := +begin + rcases him with ⟨C, hC⟩, + -- Due to continuity, it suffices to prove the equality on the open right half-plane. + suffices : ∀ z : ℂ, 0 < z.re → f z = 0, + { simpa only [closure_set_of_lt_re] using eq_on.of_subset_closure this hd.continuous_on + continuous_on_const subset_closure subset.rfl }, + -- Consider $g_n(z)=e^{nz}f(z)$. + set g : ℕ → ℂ → E := λ n z, (exp z) ^ n • f z, + have hg : ∀ n z, ‖g n z‖ = (expR z.re) ^ n * ‖f z‖, + { intros n z, simp only [norm_smul, norm_eq_abs, complex.abs_pow, abs_exp] }, + intros z hz, + -- Since `e^{nz} → ∞` as `n → ∞`, it suffices to show that each `g_n` is bounded from above by `C` + suffices H : ∀ n : ℕ, ‖g n z‖ ≤ C, + { contrapose! H, + simp only [hg], + exact (((tendsto_pow_at_top_at_top_of_one_lt (real.one_lt_exp_iff.2 hz)).at_top_mul + (norm_pos_iff.2 H) tendsto_const_nhds).eventually (eventually_gt_at_top C)).exists }, + intro n, + -- This estimate follows from the Phragmen-Lindelöf principle in the right half-plane. + refine right_half_plane_of_tendsto_zero_on_real + ((differentiable_exp.pow n).diff_cont_on_cl.smul hd) _ _ (λ y, _) hz.le, + { rcases hexp with ⟨c, hc, B, hO⟩, + refine ⟨max c 1, max_lt hc one_lt_two, n + max B 0, is_O.of_norm_left _⟩, + simp only [hg], + refine ((is_O_refl (λ z : ℂ, expR z.re ^ n) _).mul hO.norm_left).trans (is_O.of_bound 1 _), + simp only [← real.exp_nat_mul, ← real.exp_add, real.norm_of_nonneg (real.exp_pos _).le, + real.exp_le_exp, add_mul, eventually_inf_principal, eventually_comap, one_mul], + filter_upwards [eventually_ge_at_top (1 : ℝ)] with r hr z hzr hre, subst r, + refine add_le_add (mul_le_mul_of_nonneg_left _ n.cast_nonneg) _, + { calc z.re ≤ abs z : re_le_abs _ + ... = abs z ^ (1 : ℝ) : (real.rpow_one _).symm + ... ≤ abs z ^ (max c 1) : real.rpow_le_rpow_of_exponent_le hr (le_max_right _ _) }, + { exact mul_le_mul (le_max_left _ _) (real.rpow_le_rpow_of_exponent_le hr (le_max_left _ _)) + (real.rpow_nonneg_of_nonneg (complex.abs.nonneg _) _) (le_max_right _ _) } }, + { rw tendsto_zero_iff_norm_tendsto_zero, simp only [hg], + exact hre n }, + { rw [hg, of_real_mul_re, I_re, mul_zero, real.exp_zero, one_pow, one_mul], + exact hC y } +end + +/-- **Phragmen-Lindelöf principle** in the right half-plane. Let `f g : ℂ → E` be functions such +that + +* `f` and `g` are differentiable in the open right half-plane and are continuous on its closure; +* `‖f z‖` and `‖g z‖` are bounded from above by `A * exp(B * (abs z) ^ c)` on the open right + half-plane for some `c < 2`; +* `‖f z‖` and `‖g z‖` are bounded from above by constants on the imaginary axis; +* `f x - g x`, `x : ℝ`, tends to zero superexponentially fast as `x → ∞`: + for any natural `n`, `exp (n * x) * ‖f x - g x‖` tends to zero as `x → ∞`. + +Then `f` is equal to `g` on the closed right half-plane. -/ +lemma eq_on_right_half_plane_of_superexponential_decay {g : ℂ → E} + (hfd : diff_cont_on_cl ℂ f {z | 0 < z.re}) (hgd : diff_cont_on_cl ℂ g {z | 0 < z.re}) + (hfexp : ∃ (c < (2 : ℝ)) B, f =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}] + (λ z, expR (B * (abs z) ^ c))) + (hgexp : ∃ (c < (2 : ℝ)) B, g =O[comap complex.abs at_top ⊓ 𝓟 {z | 0 < z.re}] + (λ z, expR (B * (abs z) ^ c))) + (hre : superpolynomial_decay at_top expR (λ x, ‖f x - g x‖)) + (hfim : ∃ C, ∀ x : ℝ, ‖f (x * I)‖ ≤ C) (hgim : ∃ C, ∀ x : ℝ, ‖g (x * I)‖ ≤ C) : + eq_on f g {z : ℂ | 0 ≤ z.re} := +begin + suffices : eq_on (f - g) 0 {z : ℂ | 0 ≤ z.re}, + by simpa only [eq_on, pi.sub_apply, pi.zero_apply, sub_eq_zero] using this, + refine eq_zero_on_right_half_plane_of_superexponential_decay (hfd.sub hgd) _ hre _, + { set l : filter ℂ := comap complex.abs at_top ⊓ 𝓟 {z : ℂ | 0 < z.re}, + suffices : ∀ {c₁ c₂ B₁ B₂ : ℝ}, c₁ ≤ c₂ → B₁ ≤ B₂ → 0 ≤ B₂ → + (λ z, expR (B₁ * abs z ^ c₁)) =O[l] (λ z, expR (B₂ * abs z ^ c₂)), + { rcases hfexp with ⟨cf, hcf, Bf, hOf⟩, rcases hgexp with ⟨cg, hcg, Bg, hOg⟩, + refine ⟨max cf cg, max_lt hcf hcg, max 0 (max Bf Bg), _⟩, + refine is_O.sub (hOf.trans $ this _ _ _) (hOg.trans $ this _ _ _); simp }, + intros c₁ c₂ B₁ B₂ hc hB hB₂, + have : ∀ᶠ z : ℂ in l, 1 ≤ abs z, + from ((eventually_ge_at_top 1).comap _).filter_mono inf_le_left, + refine is_O.of_bound 1 (this.mono $ λ z hz, _), + simp only [real.norm_of_nonneg (real.exp_pos _).le, real.exp_le_exp, one_mul], + exact mul_le_mul hB (real.rpow_le_rpow_of_exponent_le hz hc) + (real.rpow_nonneg_of_nonneg (complex.abs.nonneg _) _) hB₂ }, + { rcases hfim with ⟨Cf, hCf⟩, rcases hgim with ⟨Cg, hCg⟩, + exact ⟨Cf + Cg, λ x, norm_sub_le_of_le (hCf x) (hCg x)⟩ } +end + +end phragmen_lindelof diff --git a/src/analysis/complex/polynomial.lean b/src/analysis/complex/polynomial.lean index 3860efd63ac09..db5074f4ea358 100644 --- a/src/analysis/complex/polynomial.lean +++ b/src/analysis/complex/polynomial.lean @@ -1,99 +1,39 @@ /- Copyright (c) 2019 Chris Hughes All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes +Authors: Chris Hughes, Junyan Xu -/ -import analysis.special_functions.pow +import analysis.complex.liouville import field_theory.is_alg_closed.basic -import topology.algebra.polynomial /-! # The fundamental theorem of algebra -This file proves that every nonconstant complex polynomial has a root. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves that every nonconstant complex polynomial has a root using Liouville's theorem. As a consequence, the complex numbers are algebraically closed. -/ -open complex polynomial metric filter is_absolute_value set -open_locale classical +open polynomial +open_locale polynomial namespace complex -/- The following proof uses the method given at - --/ /-- **Fundamental theorem of algebra**: every non constant complex polynomial has a root -/ -lemma exists_root {f : polynomial ℂ} (hf : 0 < degree f) : ∃ z : ℂ, is_root f z := -let ⟨z₀, hz₀⟩ := f.exists_forall_norm_le in -exists.intro z₀ $ classical.by_contradiction $ λ hf0, -have hfX : f - C (f.eval z₀) ≠ 0, - from mt sub_eq_zero.1 (λ h, not_le_of_gt hf (h.symm ▸ degree_C_le)), -let n := root_multiplicity z₀ (f - C (f.eval z₀)) in -let g := (f - C (f.eval z₀)) /ₘ ((X - C z₀) ^ n) in -have hg0 : g.eval z₀ ≠ 0, from eval_div_by_monic_pow_root_multiplicity_ne_zero _ hfX, -have hg : g * (X - C z₀) ^ n = f - C (f.eval z₀), - from div_by_monic_mul_pow_root_multiplicity_eq _ _, -have hn0 : 0 < n, from nat.pos_of_ne_zero $ λ hn0, by simpa [g, hn0] using hg0, -let ⟨δ', hδ'₁, hδ'₂⟩ := continuous_iff.1 (polynomial.continuous g) z₀ - ((g.eval z₀).abs) (complex.abs_pos.2 hg0) in -let δ := min (min (δ' / 2) 1) (((f.eval z₀).abs / (g.eval z₀).abs) / 2) in -have hf0' : 0 < (f.eval z₀).abs, from complex.abs_pos.2 hf0, -have hg0' : 0 < abs (eval z₀ g), from complex.abs_pos.2 hg0, -have hfg0 : 0 < (f.eval z₀).abs / abs (eval z₀ g), from div_pos hf0' hg0', -have hδ0 : 0 < δ, from lt_min (lt_min (half_pos hδ'₁) (by norm_num)) (half_pos hfg0), -have hδ : ∀ z : ℂ, abs (z - z₀) = δ → abs (g.eval z - g.eval z₀) < (g.eval z₀).abs, - from λ z hz, hδ'₂ z (by rw [complex.dist_eq, hz]; - exact ((min_le_left _ _).trans (min_le_left _ _)).trans_lt (half_lt_self hδ'₁)), -have hδ1 : δ ≤ 1, from le_trans (min_le_left _ _) (min_le_right _ _), -let F : polynomial ℂ := C (f.eval z₀) + C (g.eval z₀) * (X - C z₀) ^ n in -let z' := (-f.eval z₀ * (g.eval z₀).abs * δ ^ n / - ((f.eval z₀).abs * g.eval z₀)) ^ (n⁻¹ : ℂ) + z₀ in -have hF₁ : F.eval z' = f.eval z₀ - f.eval z₀ * (g.eval z₀).abs * δ ^ n / (f.eval z₀).abs, - by simp only [F, cpow_nat_inv_pow _ hn0, div_eq_mul_inv, eval_pow, mul_assoc, - mul_comm (g.eval z₀), mul_left_comm (g.eval z₀), mul_left_comm (g.eval z₀)⁻¹, mul_inv₀, - inv_mul_cancel hg0, eval_C, eval_add, eval_neg, sub_eq_add_neg, eval_mul, eval_X, - add_neg_cancel_right, neg_mul, mul_one, div_eq_mul_inv]; - simp only [mul_comm, mul_left_comm, mul_assoc], -have hδs : (g.eval z₀).abs * δ ^ n / (f.eval z₀).abs < 1, - from (div_lt_one hf0').2 $ (lt_div_iff' hg0').1 $ - calc δ ^ n ≤ δ ^ 1 : pow_le_pow_of_le_one (le_of_lt hδ0) hδ1 hn0 - ... = δ : pow_one _ - ... ≤ ((f.eval z₀).abs / (g.eval z₀).abs) / 2 : min_le_right _ _ - ... < _ : half_lt_self (div_pos hf0' hg0'), -have hF₂ : (F.eval z').abs = (f.eval z₀).abs - (g.eval z₀).abs * δ ^ n, - from calc (F.eval z').abs = (f.eval z₀ - f.eval z₀ * (g.eval z₀).abs - * δ ^ n / (f.eval z₀).abs).abs : congr_arg abs hF₁ - ... = abs (f.eval z₀) * complex.abs (1 - (g.eval z₀).abs * δ ^ n / - (f.eval z₀).abs : ℝ) : by rw [← complex.abs_mul]; - exact congr_arg complex.abs - (by simp [mul_add, add_mul, mul_assoc, div_eq_mul_inv, sub_eq_add_neg]) - ... = _ : by rw [complex.abs_of_nonneg (sub_nonneg.2 (le_of_lt hδs)), - mul_sub, mul_div_cancel' _ (ne.symm (ne_of_lt hf0')), mul_one], -have hef0 : abs (eval z₀ g) * (eval z₀ f).abs ≠ 0, - from mul_ne_zero (mt complex.abs_eq_zero.1 hg0) (mt complex.abs_eq_zero.1 hf0), -have hz'z₀ : abs (z' - z₀) = δ, - by simp [z', mul_assoc, mul_left_comm _ (_ ^ n), mul_comm _ (_ ^ n), - mul_comm (eval z₀ f).abs, _root_.mul_div_cancel _ hef0, of_real_mul, - neg_mul, neg_div, is_absolute_value.abv_pow complex.abs, - complex.abs_of_nonneg (le_of_lt hδ0), real.pow_nat_rpow_nat_inv (le_of_lt hδ0) hn0], -have hF₃ : (f.eval z' - F.eval z').abs < (g.eval z₀).abs * δ ^ n, - from calc (f.eval z' - F.eval z').abs - = (g.eval z' - g.eval z₀).abs * (z' - z₀).abs ^ n : - by rw [← eq_sub_iff_add_eq.1 hg, ← is_absolute_value.abv_pow complex.abs, - ← complex.abs_mul, sub_mul]; - simp [F, eval_pow, eval_add, eval_mul, eval_sub, eval_C, eval_X, eval_neg, add_sub_cancel, - sub_eq_add_neg, add_assoc] - ... = (g.eval z' - g.eval z₀).abs * δ ^ n : by rw hz'z₀ - ... < _ : (mul_lt_mul_right (pow_pos hδ0 _)).2 (hδ _ hz'z₀), -lt_irrefl (f.eval z₀).abs $ - calc (f.eval z₀).abs ≤ (f.eval z').abs : hz₀ _ - ... = (F.eval z' + (f.eval z' - F.eval z')).abs : by simp - ... ≤ (F.eval z').abs + (f.eval z' - F.eval z').abs : complex.abs_add _ _ - ... < (f.eval z₀).abs - (g.eval z₀).abs * δ ^ n + (g.eval z₀).abs * δ ^ n : - add_lt_add_of_le_of_lt (by rw hF₂) hF₃ - ... = (f.eval z₀).abs : sub_add_cancel _ _ +lemma exists_root {f : ℂ[X]} (hf : 0 < degree f) : ∃ z : ℂ, is_root f z := +begin + contrapose! hf, + obtain ⟨c, hc⟩ := (f.differentiable.inv hf).exists_const_forall_eq_of_bounded _, + { obtain rfl : f = C c⁻¹ := polynomial.funext (λ z, by rw [eval_C, ← hc z, inv_inv]), + exact degree_C_le }, + { obtain ⟨z₀, h₀⟩ := f.exists_forall_norm_le, + simp only [bounded_iff_forall_norm_le, set.forall_range_iff, norm_inv], + exact ⟨‖eval z₀ f‖⁻¹, λ z, inv_le_inv_of_le (norm_pos_iff.2 $ hf z₀) (h₀ z)⟩ }, +end instance is_alg_closed : is_alg_closed ℂ := is_alg_closed.of_exists_root _ $ λ p _ hp, complex.exists_root $ degree_pos_of_irreducible hp diff --git a/src/analysis/complex/re_im_topology.lean b/src/analysis/complex/re_im_topology.lean index 08072675acf49..e86d1e2b077d3 100644 --- a/src/analysis/complex/re_im_topology.lean +++ b/src/analysis/complex/re_im_topology.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ import analysis.complex.basic -import topology.fiber_bundle +import topology.fiber_bundle.is_homeomorphic_trivial_bundle /-! # Closure, interior, and frontier of preimages under `re` and `im` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this fact we use the fact that `ℂ` is naturally homeomorphic to `ℝ × ℝ` to deduce some topological properties of `complex.re` and `complex.im`. @@ -16,7 +19,7 @@ topological properties of `complex.re` and `complex.im`. Each statement about `complex.re` listed below has a counterpart about `complex.im`. -* `complex.is_trivial_topological_fiber_bundle_re`: `complex.re` turns `ℂ` into a trivial +* `complex.is_homeomorphic_trivial_fiber_bundle_re`: `complex.re` turns `ℂ` into a trivial topological fiber bundle over `ℝ`; * `complex.is_open_map_re`, `complex.quotient_map_re`: in particular, `complex.re` is an open map and is a quotient map; @@ -31,30 +34,24 @@ Each statement about `complex.re` listed below has a counterpart about `complex. complex, real part, imaginary part, closure, interior, frontier -/ -open topological_fiber_bundle set +open set noncomputable theory namespace complex /-- `complex.re` turns `ℂ` into a trivial topological fiber bundle over `ℝ`. -/ -lemma is_trivial_topological_fiber_bundle_re : is_trivial_topological_fiber_bundle ℝ re := -⟨equiv_real_prodₗ.to_homeomorph, λ z, rfl⟩ +lemma is_homeomorphic_trivial_fiber_bundle_re : is_homeomorphic_trivial_fiber_bundle ℝ re := +⟨equiv_real_prod_clm.to_homeomorph, λ z, rfl⟩ /-- `complex.im` turns `ℂ` into a trivial topological fiber bundle over `ℝ`. -/ -lemma is_trivial_topological_fiber_bundle_im : is_trivial_topological_fiber_bundle ℝ im := -⟨equiv_real_prodₗ.to_homeomorph.trans (homeomorph.prod_comm ℝ ℝ), λ z, rfl⟩ - -lemma is_topological_fiber_bundle_re : is_topological_fiber_bundle ℝ re := -is_trivial_topological_fiber_bundle_re.is_topological_fiber_bundle - -lemma is_topological_fiber_bundle_im : is_topological_fiber_bundle ℝ im := -is_trivial_topological_fiber_bundle_im.is_topological_fiber_bundle +lemma is_homeomorphic_trivial_fiber_bundle_im : is_homeomorphic_trivial_fiber_bundle ℝ im := +⟨equiv_real_prod_clm.to_homeomorph.trans (homeomorph.prod_comm ℝ ℝ), λ z, rfl⟩ -lemma is_open_map_re : is_open_map re := is_topological_fiber_bundle_re.is_open_map_proj -lemma is_open_map_im : is_open_map im := is_topological_fiber_bundle_im.is_open_map_proj +lemma is_open_map_re : is_open_map re := is_homeomorphic_trivial_fiber_bundle_re.is_open_map_proj +lemma is_open_map_im : is_open_map im := is_homeomorphic_trivial_fiber_bundle_im.is_open_map_proj -lemma quotient_map_re : quotient_map re := is_topological_fiber_bundle_re.quotient_map_proj -lemma quotient_map_im : quotient_map im := is_topological_fiber_bundle_im.quotient_map_proj +lemma quotient_map_re : quotient_map re := is_homeomorphic_trivial_fiber_bundle_re.quotient_map_proj +lemma quotient_map_im : quotient_map im := is_homeomorphic_trivial_fiber_bundle_im.quotient_map_proj lemma interior_preimage_re (s : set ℝ) : interior (re ⁻¹' s) = re ⁻¹' (interior s) := (is_open_map_re.preimage_interior_eq_interior_preimage continuous_re _).symm @@ -123,8 +120,8 @@ by simpa only [frontier_Ioi] using frontier_preimage_re (Ioi a) by simpa only [frontier_Ioi] using frontier_preimage_im (Ioi a) lemma closure_re_prod_im (s t : set ℝ) : closure (s ×ℂ t) = closure s ×ℂ closure t := -by simpa only [← preimage_eq_preimage equiv_real_prodₗ.symm.to_homeomorph.surjective, - equiv_real_prodₗ.symm.to_homeomorph.preimage_closure] +by simpa only [← preimage_eq_preimage equiv_real_prod_clm.symm.to_homeomorph.surjective, + equiv_real_prod_clm.symm.to_homeomorph.preimage_closure] using @closure_prod_eq _ _ _ _ s t lemma interior_re_prod_im (s t : set ℝ) : interior (s ×ℂ t) = interior s ×ℂ interior t := @@ -132,8 +129,8 @@ by rw [re_prod_im, re_prod_im, interior_inter, interior_preimage_re, interior_pr lemma frontier_re_prod_im (s t : set ℝ) : frontier (s ×ℂ t) = (closure s ×ℂ frontier t) ∪ (frontier s ×ℂ closure t) := -by simpa only [← preimage_eq_preimage equiv_real_prodₗ.symm.to_homeomorph.surjective, - equiv_real_prodₗ.symm.to_homeomorph.preimage_frontier] +by simpa only [← preimage_eq_preimage equiv_real_prod_clm.symm.to_homeomorph.surjective, + equiv_real_prod_clm.symm.to_homeomorph.preimage_frontier] using frontier_prod_eq s t lemma frontier_set_of_le_re_and_le_im (a b : ℝ) : @@ -158,4 +155,4 @@ lemma is_closed.re_prod_im (hs : is_closed s) (ht : is_closed t) : is_closed (s (hs.preimage continuous_re).inter (ht.preimage continuous_im) lemma metric.bounded.re_prod_im (hs : bounded s) (ht : bounded t) : bounded (s ×ℂ t) := -equiv_real_prodₗ.antilipschitz.bounded_preimage (hs.prod ht) +antilipschitz_equiv_real_prod.bounded_preimage (hs.prod ht) diff --git a/src/analysis/complex/real_deriv.lean b/src/analysis/complex/real_deriv.lean index 6dd836813f070..b5923fc628e07 100644 --- a/src/analysis/complex/real_deriv.lean +++ b/src/analysis/complex/real_deriv.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel, Yourong Zang -/ import analysis.calculus.cont_diff +import analysis.calculus.deriv.linear import analysis.complex.conformal import analysis.calculus.conformal.normed_space /-! # Real differentiability of complex-differentiable functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `has_deriv_at.real_of_complex` expresses that, if a function on `ℂ` is differentiable (over `ℂ`), then its restriction to `ℝ` is differentiable over `ℝ`, with derivative the real part of the complex derivative. @@ -51,8 +55,9 @@ begin simpa using (C.comp z (B.comp z A)).has_strict_deriv_at end -/-- If a complex function is differentiable at a real point, then the induced real function is also -differentiable at this point, with a derivative equal to the real part of the complex derivative. -/ +/-- If a complex function `e` is differentiable at a real point, then the function `ℝ → ℝ` given by +the real part of `e` is also differentiable at this point, with a derivative equal to the real part +of the complex derivative. -/ theorem has_deriv_at.real_of_complex (h : has_deriv_at e e' z) : has_deriv_at (λx:ℝ, (e x).re) e'.re z := begin @@ -64,7 +69,7 @@ begin simpa using (C.comp z (B.comp z A)).has_deriv_at end -theorem cont_diff_at.real_of_complex {n : with_top ℕ} (h : cont_diff_at ℂ n e z) : +theorem cont_diff_at.real_of_complex {n : ℕ∞} (h : cont_diff_at ℂ n e z) : cont_diff_at ℝ n (λ x : ℝ, (e x).re) z := begin have A : cont_diff_at ℝ n (coe : ℝ → ℂ) z, @@ -74,12 +79,12 @@ begin exact C.comp z (B.comp z A) end -theorem cont_diff.real_of_complex {n : with_top ℕ} (h : cont_diff ℂ n e) : +theorem cont_diff.real_of_complex {n : ℕ∞} (h : cont_diff ℂ n e) : cont_diff ℝ n (λ x : ℝ, (e x).re) := cont_diff_iff_cont_diff_at.2 $ λ x, h.cont_diff_at.real_of_complex -variables {E : Type*} [normed_group E] [normed_space ℂ E] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] lemma has_strict_deriv_at.complex_to_real_fderiv' {f : ℂ → E} {x : ℂ} {f' : E} (h : has_strict_deriv_at f f' x) : @@ -115,6 +120,19 @@ lemma has_deriv_within_at.complex_to_real_fderiv {f : ℂ → ℂ} {s : set ℂ} by simpa only [complex.restrict_scalars_one_smul_right] using h.has_fderiv_within_at.restrict_scalars ℝ +/-- If a complex function `e` is differentiable at a real point, then its restriction to `ℝ` is +differentiable there as a function `ℝ → ℂ`, with the same derivative. -/ +lemma has_deriv_at.comp_of_real (hf : has_deriv_at e e' ↑z) : has_deriv_at (λ (y:ℝ), e ↑y) e' z := +by simpa only [of_real_clm_apply, of_real_one, mul_one] + using hf.comp z of_real_clm.has_deriv_at + +/-- If a function `f : ℝ → ℝ` is differentiable at a (real) point `x`, then it is also +differentiable as a function `ℝ → ℂ`. -/ +lemma has_deriv_at.of_real_comp {f : ℝ → ℝ} {u : ℝ} (hf : has_deriv_at f u z) : +has_deriv_at (λ (y:ℝ), ↑(f y) : ℝ → ℂ) u z := +by simpa only [of_real_clm_apply, of_real_one, real_smul, mul_one] + using of_real_clm.has_deriv_at.scomp z hf + end real_deriv_of_complex section conformality @@ -122,7 +140,7 @@ section conformality open complex continuous_linear_map open_locale complex_conjugate -variables {E : Type*} [normed_group E] [normed_space ℂ E] {z : ℂ} {f : ℂ → E} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {z : ℂ} {f : ℂ → E} /-- A real differentiable function of the complex plane into some complex normed space `E` is conformal at a point `z` if it is holomorphic at that point with a nonvanishing differential. diff --git a/src/analysis/complex/removable_singularity.lean b/src/analysis/complex/removable_singularity.lean index e1055784943f8..784b50e998e6d 100644 --- a/src/analysis/complex/removable_singularity.lean +++ b/src/analysis/complex/removable_singularity.lean @@ -10,6 +10,9 @@ import analysis.complex.cauchy_integral /-! # Removable singularity theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove Riemann's removable singularity theorem: if `f : ℂ → E` is complex differentiable in a punctured neighborhood of a point `c` and is bounded in a punctured neighborhood of `c` (or, more generally, $f(z) - f(c)=o((z-c)^{-1})$), then it has a limit at `c` and the @@ -17,10 +20,10 @@ function `function.update f c (lim (𝓝[≠] c) f)` is complex differentiable i -/ open topological_space metric set filter asymptotics function -open_locale topological_space filter nnreal +open_locale topology filter nnreal real universe u -variables {E : Type u} [normed_group E] [normed_space ℂ E] [complete_space E] +variables {E : Type u} [normed_add_comm_group E] [normed_space ℂ E] [complete_space E] namespace complex @@ -65,7 +68,7 @@ is complex differentiable on `s \ {c}`, and $f(z) - f(c)=o((z-c)^{-1})$, then `f equal to `lim (𝓝[≠] c) f` at `c` is complex differentiable on `s`. -/ lemma differentiable_on_update_lim_of_is_o {f : ℂ → E} {s : set ℂ} {c : ℂ} (hc : s ∈ 𝓝 c) (hd : differentiable_on ℂ f (s \ {c})) - (ho : is_o (λ z, f z - f c) (λ z, (z - c)⁻¹) (𝓝[≠] c)) : + (ho : (λ z, f z - f c) =o[𝓝[≠] c] (λ z, (z - c)⁻¹)) : differentiable_on ℂ (update f c (lim (𝓝[≠] c) f)) s := begin set F : ℂ → E := λ z, (z - c) • f z with hF, @@ -88,7 +91,7 @@ end be equal to `lim (𝓝[≠] c) f` at `c` is complex differentiable on `{c} ∪ s`. -/ lemma differentiable_on_update_lim_insert_of_is_o {f : ℂ → E} {s : set ℂ} {c : ℂ} (hc : s ∈ 𝓝[≠] c) (hd : differentiable_on ℂ f s) - (ho : is_o (λ z, f z - f c) (λ z, (z - c)⁻¹) (𝓝[≠] c)) : + (ho : (λ z, f z - f c) =o[𝓝[≠] c] (λ z, (z - c)⁻¹)) : differentiable_on ℂ (update f c (lim (𝓝[≠] c) f)) (insert c s) := differentiable_on_update_lim_of_is_o (insert_mem_nhds_iff.2 hc) (hd.mono $ λ z hz, hz.1.resolve_left hz.2) ho @@ -101,14 +104,14 @@ lemma differentiable_on_update_lim_of_bdd_above {f : ℂ → E} {s : set ℂ} {c (hb : bdd_above (norm ∘ f '' (s \ {c}))) : differentiable_on ℂ (update f c (lim (𝓝[≠] c) f)) s := differentiable_on_update_lim_of_is_o hc hd $ is_bounded_under.is_o_sub_self_inv $ - let ⟨C, hC⟩ := hb in ⟨C + ∥f c∥, eventually_map.2 $ mem_nhds_within_iff_exists_mem_nhds_inter.2 + let ⟨C, hC⟩ := hb in ⟨C + ‖f c‖, eventually_map.2 $ mem_nhds_within_iff_exists_mem_nhds_inter.2 ⟨s, hc, λ z hz, norm_sub_le_of_le (hC $ mem_image_of_mem _ hz) le_rfl⟩⟩ /-- **Removable singularity** theorem: if a function `f : ℂ → E` is complex differentiable on a punctured neighborhood of `c` and $f(z) - f(c)=o((z-c)^{-1})$, then `f` has a limit at `c`. -/ lemma tendsto_lim_of_differentiable_on_punctured_nhds_of_is_o {f : ℂ → E} {c : ℂ} (hd : ∀ᶠ z in 𝓝[≠] c, differentiable_at ℂ f z) - (ho : is_o (λ z, f z - f c) (λ z, (z - c)⁻¹) (𝓝[≠] c)) : + (ho : (λ z, f z - f c) =o[𝓝[≠] c] (λ z, (z - c)⁻¹)) : tendsto f (𝓝[≠] c) (𝓝 $ lim (𝓝[≠] c) f) := begin rw eventually_nhds_within_iff at hd, @@ -122,8 +125,39 @@ end bounded on a punctured neighborhood of `c`, then `f` has a limit at `c`. -/ lemma tendsto_lim_of_differentiable_on_punctured_nhds_of_bounded_under {f : ℂ → E} {c : ℂ} (hd : ∀ᶠ z in 𝓝[≠] c, differentiable_at ℂ f z) - (hb : is_bounded_under (≤) (𝓝[≠] c) (λ z, ∥f z - f c∥)) : + (hb : is_bounded_under (≤) (𝓝[≠] c) (λ z, ‖f z - f c‖)) : tendsto f (𝓝[≠] c) (𝓝 $ lim (𝓝[≠] c) f) := tendsto_lim_of_differentiable_on_punctured_nhds_of_is_o hd hb.is_o_sub_self_inv +/-- The Cauchy formula for the derivative of a holomorphic function. -/ +lemma two_pi_I_inv_smul_circle_integral_sub_sq_inv_smul_of_differentiable + {U : set ℂ} (hU : is_open U) {c w₀ : ℂ} {R : ℝ} {f : ℂ → E} + (hc : closed_ball c R ⊆ U) (hf : differentiable_on ℂ f U) (hw₀ : w₀ ∈ ball c R) : + (2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), ((z - w₀) ^ 2)⁻¹ • f z = deriv f w₀ := +begin + -- We apply the removable singularity theorem and the Cauchy formula to `dslope f w₀` + have hR : 0 < R := not_le.mp (ball_eq_empty.not.mp (nonempty_of_mem hw₀).ne_empty), + have hf' : differentiable_on ℂ (dslope f w₀) U, + from (differentiable_on_dslope (hU.mem_nhds ((ball_subset_closed_ball.trans hc) hw₀))).mpr hf, + have h0 := (hf'.diff_cont_on_cl_ball hc).two_pi_I_inv_smul_circle_integral_sub_inv_smul hw₀, + rw [← dslope_same, ← h0], + congr' 1, + transitivity ∮ z in C(c, R), ((z - w₀) ^ 2)⁻¹ • (f z - f w₀), + { have h1 : continuous_on (λ (z : ℂ), ((z - w₀) ^ 2)⁻¹) (sphere c R), + { refine ((continuous_id'.sub continuous_const).pow 2).continuous_on.inv₀ (λ w hw h, _), + exact sphere_disjoint_ball.ne_of_mem hw hw₀ (sub_eq_zero.mp (sq_eq_zero_iff.mp h)) }, + have h2 : circle_integrable (λ (z : ℂ), ((z - w₀) ^ 2)⁻¹ • f z) c R, + { refine continuous_on.circle_integrable (pos_of_mem_ball hw₀).le _, + exact h1.smul (hf.continuous_on.mono (sphere_subset_closed_ball.trans hc)) }, + have h3 : circle_integrable (λ (z : ℂ), ((z - w₀) ^ 2)⁻¹ • f w₀) c R, + from continuous_on.circle_integrable (pos_of_mem_ball hw₀).le (h1.smul continuous_on_const), + have h4 : ∮ (z : ℂ) in C(c, R), ((z - w₀) ^ 2)⁻¹ = 0, + by simpa using circle_integral.integral_sub_zpow_of_ne (dec_trivial : (-2 : ℤ) ≠ -1) c w₀ R, + simp only [smul_sub, circle_integral.integral_sub h2 h3, h4, + circle_integral.integral_smul_const, zero_smul, sub_zero] }, + { refine circle_integral.integral_congr (pos_of_mem_ball hw₀).le (λ z hz, _), + simp only [dslope_of_ne, metric.sphere_disjoint_ball.ne_of_mem hz hw₀, slope, ← smul_assoc, sq, + mul_inv, ne.def, not_false_iff, vsub_eq_sub, algebra.id.smul_eq_mul] } +end + end complex diff --git a/src/analysis/complex/roots_of_unity.lean b/src/analysis/complex/roots_of_unity.lean deleted file mode 100644 index 69b5a6ed11723..0000000000000 --- a/src/analysis/complex/roots_of_unity.lean +++ /dev/null @@ -1,173 +0,0 @@ -/- -Copyright (c) 2020 Johan Commelin. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johan Commelin --/ -import analysis.special_functions.complex.log -import ring_theory.roots_of_unity - -/-! -# Complex roots of unity - -In this file we show that the `n`-th complex roots of unity -are exactly the complex numbers `e ^ (2 * real.pi * complex.I * (i / n))` for `i ∈ finset.range n`. - -## Main declarations - -* `complex.mem_roots_of_unity`: the complex `n`-th roots of unity are exactly the - complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`. -* `complex.card_roots_of_unity`: the number of `n`-th roots of unity is exactly `n`. - --/ - -namespace complex - -open polynomial real -open_locale nat real - -lemma is_primitive_root_exp_of_coprime (i n : ℕ) (h0 : n ≠ 0) (hi : i.coprime n) : - is_primitive_root (exp (2 * π * I * (i / n))) n := -begin - rw is_primitive_root.iff_def, - simp only [← exp_nat_mul, exp_eq_one_iff], - have hn0 : (n : ℂ) ≠ 0, by exact_mod_cast h0, - split, - { use i, - field_simp [hn0, mul_comm (i : ℂ), mul_comm (n : ℂ)] }, - { simp only [hn0, mul_right_comm _ _ ↑n, mul_left_inj' two_pi_I_ne_zero, ne.def, not_false_iff, - mul_comm _ (i : ℂ), ← mul_assoc _ (i : ℂ), exists_imp_distrib] with field_simps, - norm_cast, - rintro l k hk, - have : n ∣ i * l, - { rw [← int.coe_nat_dvd, hk], apply dvd_mul_left }, - exact hi.symm.dvd_of_dvd_mul_left this } -end - -lemma is_primitive_root_exp (n : ℕ) (h0 : n ≠ 0) : is_primitive_root (exp (2 * π * I / n)) n := -by simpa only [nat.cast_one, one_div] - using is_primitive_root_exp_of_coprime 1 n h0 n.coprime_one_left - -lemma is_primitive_root_iff (ζ : ℂ) (n : ℕ) (hn : n ≠ 0) : - is_primitive_root ζ n ↔ (∃ (i < (n : ℕ)) (hi : i.coprime n), exp (2 * π * I * (i / n)) = ζ) := -begin - have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast hn, - split, swap, - { rintro ⟨i, -, hi, rfl⟩, exact is_primitive_root_exp_of_coprime i n hn hi }, - intro h, - obtain ⟨i, hi, rfl⟩ := - (is_primitive_root_exp n hn).eq_pow_of_pow_eq_one h.pow_eq_one (nat.pos_of_ne_zero hn), - refine ⟨i, hi, ((is_primitive_root_exp n hn).pow_iff_coprime (nat.pos_of_ne_zero hn) i).mp h, _⟩, - rw [← exp_nat_mul], - congr' 1, - field_simp [hn0, mul_comm (i : ℂ)] -end - -/-- The complex `n`-th roots of unity are exactly the -complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`. -/ -lemma mem_roots_of_unity (n : ℕ+) (x : units ℂ) : - x ∈ roots_of_unity n ℂ ↔ (∃ i < (n : ℕ), exp (2 * π * I * (i / n)) = x) := -begin - rw [mem_roots_of_unity, units.ext_iff, units.coe_pow, units.coe_one], - have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast (n.ne_zero), - split, - { intro h, - obtain ⟨i, hi, H⟩ : ∃ i < (n : ℕ), exp (2 * π * I / n) ^ i = x, - { simpa only using (is_primitive_root_exp n n.ne_zero).eq_pow_of_pow_eq_one h n.pos }, - refine ⟨i, hi, _⟩, - rw [← H, ← exp_nat_mul], - congr' 1, - field_simp [hn0, mul_comm (i : ℂ)] }, - { rintro ⟨i, hi, H⟩, - rw [← H, ← exp_nat_mul, exp_eq_one_iff], - use i, - field_simp [hn0, mul_comm ((n : ℕ) : ℂ), mul_comm (i : ℂ)] } -end - -lemma card_roots_of_unity (n : ℕ+) : fintype.card (roots_of_unity n ℂ) = n := -(is_primitive_root_exp n n.ne_zero).card_roots_of_unity - -lemma card_primitive_roots (k : ℕ) : (primitive_roots k ℂ).card = φ k := -begin - by_cases h : k = 0, - { simp [h] }, - exact (is_primitive_root_exp k h).card_primitive_roots, -end - -end complex - -lemma is_primitive_root.norm'_eq_one {ζ : ℂ} {n : ℕ} (h : is_primitive_root ζ n) (hn : n ≠ 0) : - ∥ζ∥ = 1 := complex.norm_eq_one_of_pow_eq_one h.pow_eq_one hn - -lemma is_primitive_root.nnnorm_eq_one {ζ : ℂ} {n : ℕ} (h : is_primitive_root ζ n) (hn : n ≠ 0) : - ∥ζ∥₊ = 1 := subtype.ext $ h.norm'_eq_one hn - -lemma is_primitive_root.arg_ext {n m : ℕ} {ζ μ : ℂ} (hζ : is_primitive_root ζ n) - (hμ : is_primitive_root μ m) (hn : n ≠ 0) (hm : m ≠ 0) (h : ζ.arg = μ.arg) : ζ = μ := -complex.ext_abs_arg ((hζ.norm'_eq_one hn).trans (hμ.norm'_eq_one hm).symm) h - -lemma is_primitive_root.arg_eq_zero_iff {n : ℕ} {ζ : ℂ} (hζ : is_primitive_root ζ n) - (hn : n ≠ 0) : ζ.arg = 0 ↔ ζ = 1 := -⟨λ h, hζ.arg_ext is_primitive_root.one hn one_ne_zero (h.trans complex.arg_one.symm), - λ h, h.symm ▸ complex.arg_one⟩ - -lemma is_primitive_root.arg_eq_pi_iff {n : ℕ} {ζ : ℂ} (hζ : is_primitive_root ζ n) - (hn : n ≠ 0) : ζ.arg = real.pi ↔ ζ = -1 := -⟨λ h, hζ.arg_ext (is_primitive_root.neg_one 0 two_ne_zero.symm) hn two_ne_zero - (h.trans complex.arg_neg_one.symm), λ h, h.symm ▸ complex.arg_neg_one⟩ - -lemma is_primitive_root.arg {n : ℕ} {ζ : ℂ} (h : is_primitive_root ζ n) (hn : n ≠ 0) : - ∃ i : ℤ, ζ.arg = i / n * (2 * real.pi) ∧ is_coprime i n ∧ i.nat_abs < n := -begin - rw complex.is_primitive_root_iff _ _ hn at h, - obtain ⟨i, h, hin, rfl⟩ := h, - rw [mul_comm, ←mul_assoc, complex.exp_mul_I], - refine ⟨if i * 2 ≤ n then i else i - n, _, _, _⟩, - work_on_goal 2 - { replace hin := nat.is_coprime_iff_coprime.mpr hin, - split_ifs with _, - { exact hin }, - { convert hin.add_mul_left_left (-1), - rw [mul_neg_one, sub_eq_add_neg] } }, - work_on_goal 2 - { split_ifs with h₂, - { exact_mod_cast h }, - suffices : (i - n : ℤ).nat_abs = n - i, - { rw this, - apply tsub_lt_self hn.bot_lt, - contrapose! h₂, - rw [nat.eq_zero_of_le_zero h₂, zero_mul], - exact zero_le _ }, - rw [←int.nat_abs_neg, neg_sub, int.nat_abs_eq_iff], - exact or.inl (int.coe_nat_sub h.le).symm }, - split_ifs with h₂, - { convert complex.arg_cos_add_sin_mul_I _, - { push_cast }, - { push_cast }, - field_simp [hn], - refine ⟨(neg_lt_neg real.pi_pos).trans_le _, _⟩, - { rw neg_zero, - exact mul_nonneg (mul_nonneg i.cast_nonneg $ by simp [real.pi_pos.le]) (by simp) }, - rw [←mul_rotate', mul_div_assoc], - rw ←mul_one n at h₂, - exact mul_le_of_le_one_right real.pi_pos.le - ((div_le_iff' $ by exact_mod_cast (pos_of_gt h)).mpr $ by exact_mod_cast h₂) }, - rw [←complex.cos_sub_two_pi, ←complex.sin_sub_two_pi], - convert complex.arg_cos_add_sin_mul_I _, - { push_cast, - rw [←sub_one_mul, sub_div, div_self], - exact_mod_cast hn }, - { push_cast, - rw [←sub_one_mul, sub_div, div_self], - exact_mod_cast hn }, - field_simp [hn], - refine ⟨_, le_trans _ real.pi_pos.le⟩, - work_on_goal 2 - { rw [mul_div_assoc], - exact mul_nonpos_of_nonpos_of_nonneg (sub_nonpos.mpr $ by exact_mod_cast h.le) - (div_nonneg (by simp [real.pi_pos.le]) $ by simp) }, - rw [←mul_rotate', mul_div_assoc, neg_lt, ←mul_neg, mul_lt_iff_lt_one_right real.pi_pos, - ←neg_div, ←neg_mul, neg_sub, div_lt_iff, one_mul, sub_mul, sub_lt, ←mul_sub_one], - norm_num, - exact_mod_cast not_le.mp h₂, - { exact (nat.cast_pos.mpr hn.bot_lt) } -end diff --git a/src/analysis/complex/schwarz.lean b/src/analysis/complex/schwarz.lean index ae1002ae85c86..3a51789fa3216 100644 --- a/src/analysis/complex/schwarz.lean +++ b/src/analysis/complex/schwarz.lean @@ -9,6 +9,9 @@ import analysis.complex.removable_singularity /-! # Schwarz lemma +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove several versions of the Schwarz lemma. * `complex.norm_deriv_le_div_of_maps_to_ball`, `complex.abs_deriv_le_div_of_maps_to_ball`: if @@ -47,21 +50,22 @@ Schwarz lemma -/ open metric set function filter topological_space -open_locale topological_space +open_locale topology namespace complex section space -variables {E : Type*} [normed_group E] [normed_space ℂ E] {R R₁ R₂ : ℝ} {f : ℂ → E} {c z : ℂ} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {R R₁ R₂ : ℝ} {f : ℂ → E} + {c z z₀ : ℂ} /-- An auxiliary lemma for `complex.norm_dslope_le_div_of_maps_to_ball`. -/ lemma schwarz_aux {f : ℂ → ℂ} (hd : differentiable_on ℂ f (ball c R₁)) (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (hz : z ∈ ball c R₁) : - ∥dslope f c z∥ ≤ R₂ / R₁ := + ‖dslope f c z‖ ≤ R₂ / R₁ := begin have hR₁ : 0 < R₁, from nonempty_ball.1 ⟨z, hz⟩, - suffices : ∀ᶠ r in 𝓝[<] R₁, ∥dslope f c z∥ ≤ R₂ / r, + suffices : ∀ᶠ r in 𝓝[<] R₁, ‖dslope f c z‖ ≤ R₂ / r, { refine ge_of_tendsto _ this, exact (tendsto_const_nhds.div tendsto_id hR₁.ne').mono_left nhds_within_le_nhds }, rw mem_ball at hz, @@ -76,8 +80,8 @@ begin { rw frontier_ball c hr₀.ne', intros z hz, have hz' : z ≠ c, from ne_of_mem_sphere hz hr₀.ne', - rw [dslope_of_ne _ hz', slope_def_module, norm_smul, norm_inv, - (mem_sphere_iff_norm _ _ _).1 hz, ← div_eq_inv_mul, div_le_div_right hr₀, ← dist_eq_norm], + rw [dslope_of_ne _ hz', slope_def_module, norm_smul, norm_inv, mem_sphere_iff_norm.1 hz, + ← div_eq_inv_mul, div_le_div_right hr₀, ← dist_eq_norm], exact le_of_lt (h_maps (mem_ball.2 (by { rw mem_sphere.1 hz, exact hr.2 }))) }, { rw [closure_ball c hr₀.ne', mem_closed_ball], exact hr.1.le } @@ -86,18 +90,18 @@ end /-- Two cases of the **Schwarz Lemma** (derivative and distance), merged together. -/ lemma norm_dslope_le_div_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R₁)) (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (hz : z ∈ ball c R₁) : - ∥dslope f c z∥ ≤ R₂ / R₁ := + ‖dslope f c z‖ ≤ R₂ / R₁ := begin have hR₁ : 0 < R₁, from nonempty_ball.1 ⟨z, hz⟩, have hR₂ : 0 < R₂, from nonempty_ball.1 ⟨f z, h_maps hz⟩, cases eq_or_ne (dslope f c z) 0 with hc hc, { rw [hc, norm_zero], exact div_nonneg hR₂.le hR₁.le }, rcases exists_dual_vector ℂ _ hc with ⟨g, hg, hgf⟩, - have hg' : ∥g∥₊ = 1, from nnreal.eq hg, - have hg₀ : ∥g∥₊ ≠ 0, by simpa only [hg'] using one_ne_zero, - calc ∥dslope f c z∥ = ∥dslope (g ∘ f) c z∥ : + have hg' : ‖g‖₊ = 1, from nnreal.eq hg, + have hg₀ : ‖g‖₊ ≠ 0, by simpa only [hg'] using one_ne_zero, + calc ‖dslope f c z‖ = ‖dslope (g ∘ f) c z‖ : begin - rw [g.dslope_comp, hgf, is_R_or_C.norm_of_real, norm_norm], + rw [g.dslope_comp, hgf, is_R_or_C.norm_of_real, abs_norm], exact λ _, hd.differentiable_at (ball_mem_nhds _ hR₁) end ... ≤ R₂ / R₁ : @@ -108,12 +112,43 @@ begin end end +/-- Equality case in the **Schwarz Lemma**: in the setup of `norm_dslope_le_div_of_maps_to_ball`, if +`‖dslope f c z₀‖ = R₂ / R₁` holds at a point in the ball then the map `f` is affine. -/ +lemma affine_of_maps_to_ball_of_exists_norm_dslope_eq_div [complete_space E] + [strict_convex_space ℝ E] (hd : differentiable_on ℂ f (ball c R₁)) + (h_maps : set.maps_to f (ball c R₁) (ball (f c) R₂)) (h_z₀ : z₀ ∈ ball c R₁) + (h_eq : ‖dslope f c z₀‖ = R₂ / R₁) : + set.eq_on f (λ z, f c + (z - c) • dslope f c z₀) (ball c R₁) := +begin + set g := dslope f c, + rintro z hz, + by_cases z = c, { simp [h] }, + have h_R₁ : 0 < R₁ := nonempty_ball.mp ⟨_, h_z₀⟩, + have g_le_div : ∀ z ∈ ball c R₁, ‖g z‖ ≤ R₂ / R₁, + from λ z hz, norm_dslope_le_div_of_maps_to_ball hd h_maps hz, + have g_max : is_max_on (norm ∘ g) (ball c R₁) z₀, + from is_max_on_iff.mpr (λ z hz, by simpa [h_eq] using g_le_div z hz), + have g_diff : differentiable_on ℂ g (ball c R₁), + from (differentiable_on_dslope (is_open_ball.mem_nhds (mem_ball_self h_R₁))).mpr hd, + have : g z = g z₀ := eq_on_of_is_preconnected_of_is_max_on_norm (convex_ball c R₁).is_preconnected + is_open_ball g_diff h_z₀ g_max hz, + simp [← this] +end + +lemma affine_of_maps_to_ball_of_exists_norm_dslope_eq_div' [complete_space E] + [strict_convex_space ℝ E] (hd : differentiable_on ℂ f (ball c R₁)) + (h_maps : set.maps_to f (ball c R₁) (ball (f c) R₂)) + (h_z₀ : ∃ z₀ ∈ ball c R₁, ‖dslope f c z₀‖ = R₂ / R₁) : + ∃ C : E, ‖C‖ = R₂ / R₁ ∧ set.eq_on f (λ z, f c + (z - c) • C) (ball c R₁) := +let ⟨z₀, h_z₀, h_eq⟩ := h_z₀ in + ⟨dslope f c z₀, h_eq, affine_of_maps_to_ball_of_exists_norm_dslope_eq_div hd h_maps h_z₀ h_eq⟩ + /-- The **Schwarz Lemma**: if `f : ℂ → E` sends an open disk with center `c` and a positive radius `R₁` to an open ball with center `f c` and radius `R₂`, then the absolute value of the derivative of `f` at `c` is at most the ratio `R₂ / R₁`. -/ lemma norm_deriv_le_div_of_maps_to_ball (hd : differentiable_on ℂ f (ball c R₁)) (h_maps : maps_to f (ball c R₁) (ball (f c) R₂)) (h₀ : 0 < R₁) : - ∥deriv f c∥ ≤ R₂ / R₁ := + ‖deriv f c‖ ≤ R₂ / R₁ := by simpa only [dslope_same] using norm_dslope_le_div_of_maps_to_ball hd h_maps (mem_ball_self h₀) /-- The **Schwarz Lemma**: if `f : ℂ → E` sends an open disk with center `c` and radius `R₁` to an diff --git a/src/analysis/complex/unit_disc/basic.lean b/src/analysis/complex/unit_disc/basic.lean new file mode 100644 index 0000000000000..a93174aad280f --- /dev/null +++ b/src/analysis/complex/unit_disc/basic.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.complex.circle +import analysis.normed_space.ball_action + +/-! +# Poincaré disc + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `complex.unit_disc` to be the unit disc in the complex plane. We also +introduce some basic operations on this disc. +-/ + +open set function metric +open_locale big_operators +noncomputable theory + +local notation `conj'` := star_ring_end ℂ + +namespace complex + +/-- Complex unit disc. -/ +@[derive [comm_semigroup, has_distrib_neg, λ α, has_coe α ℂ, topological_space]] +def unit_disc : Type := ball (0 : ℂ) 1 +localized "notation `𝔻` := complex.unit_disc" in unit_disc + +namespace unit_disc + +lemma coe_injective : injective (coe : 𝔻 → ℂ) := subtype.coe_injective + +lemma abs_lt_one (z : 𝔻) : abs (z : ℂ) < 1 := mem_ball_zero_iff.1 z.2 + +lemma abs_ne_one (z : 𝔻) : abs (z : ℂ) ≠ 1 := z.abs_lt_one.ne + +lemma norm_sq_lt_one (z : 𝔻) : norm_sq z < 1 := +@one_pow ℝ _ 2 ▸ (real.sqrt_lt' one_pos).1 z.abs_lt_one + +lemma coe_ne_one (z : 𝔻) : (z : ℂ) ≠ 1 := +ne_of_apply_ne abs $ (map_one abs).symm ▸ z.abs_ne_one + +lemma coe_ne_neg_one (z : 𝔻) : (z : ℂ) ≠ -1 := +ne_of_apply_ne abs $ by { rw [abs.map_neg, map_one], exact z.abs_ne_one } + +lemma one_add_coe_ne_zero (z : 𝔻) : (1 + z : ℂ) ≠ 0 := +mt neg_eq_iff_add_eq_zero.2 z.coe_ne_neg_one.symm + +@[simp, norm_cast] lemma coe_mul (z w : 𝔻) : ↑(z * w) = (z * w : ℂ) := rfl + +/-- A constructor that assumes `abs z < 1` instead of `dist z 0 < 1` and returns an element +of `𝔻` instead of `↥metric.ball (0 : ℂ) 1`. -/ +def mk (z : ℂ) (hz : abs z < 1) : 𝔻 := ⟨z, mem_ball_zero_iff.2 hz⟩ + +@[simp] lemma coe_mk (z : ℂ) (hz : abs z < 1) : (mk z hz : ℂ) = z := rfl + +@[simp] lemma mk_coe (z : 𝔻) (hz : abs (z : ℂ) < 1 := z.abs_lt_one) : + mk z hz = z := +subtype.eta _ _ + +@[simp] lemma mk_neg (z : ℂ) (hz : abs (-z) < 1) : + mk (-z) hz = -mk z (abs.map_neg z ▸ hz) := +rfl + +instance : semigroup_with_zero 𝔻 := +{ zero := mk 0 $ (map_zero _).trans_lt one_pos, + zero_mul := λ z, coe_injective $ zero_mul _, + mul_zero := λ z, coe_injective $ mul_zero _, + .. unit_disc.comm_semigroup} + +@[simp] lemma coe_zero : ((0 : 𝔻) : ℂ) = 0 := rfl +@[simp] lemma coe_eq_zero {z : 𝔻} : (z : ℂ) = 0 ↔ z = 0 := coe_injective.eq_iff' coe_zero +instance : inhabited 𝔻 := ⟨0⟩ + +instance circle_action : mul_action circle 𝔻 := mul_action_sphere_ball + +instance is_scalar_tower_circle_circle : is_scalar_tower circle circle 𝔻 := +is_scalar_tower_sphere_sphere_ball + +instance is_scalar_tower_circle : is_scalar_tower circle 𝔻 𝔻 := is_scalar_tower_sphere_ball_ball +instance smul_comm_class_circle : smul_comm_class circle 𝔻 𝔻 := smul_comm_class_sphere_ball_ball +instance smul_comm_class_circle' : smul_comm_class 𝔻 circle 𝔻 := smul_comm_class.symm _ _ _ + +@[simp, norm_cast] lemma coe_smul_circle (z : circle) (w : 𝔻) : ↑(z • w) = (z * w : ℂ) := rfl + +instance closed_ball_action : mul_action (closed_ball (0 : ℂ) 1) 𝔻 := mul_action_closed_ball_ball + +instance is_scalar_tower_closed_ball_closed_ball : + is_scalar_tower (closed_ball (0 : ℂ) 1) (closed_ball (0 : ℂ) 1) 𝔻 := +is_scalar_tower_closed_ball_closed_ball_ball + +instance is_scalar_tower_closed_ball : is_scalar_tower (closed_ball (0 : ℂ) 1) 𝔻 𝔻 := +is_scalar_tower_closed_ball_ball_ball + +instance smul_comm_class_closed_ball : smul_comm_class (closed_ball (0 : ℂ) 1) 𝔻 𝔻 := +⟨λ a b c, subtype.ext $ mul_left_comm _ _ _⟩ + +instance smul_comm_class_closed_ball' : smul_comm_class 𝔻 (closed_ball (0 : ℂ) 1) 𝔻 := +smul_comm_class.symm _ _ _ + +instance smul_comm_class_circle_closed_ball : smul_comm_class circle (closed_ball (0 : ℂ) 1) 𝔻 := +smul_comm_class_sphere_closed_ball_ball + +instance smul_comm_class_closed_ball_circle : smul_comm_class (closed_ball (0 : ℂ) 1) circle 𝔻 := +smul_comm_class.symm _ _ _ + +@[simp, norm_cast] +lemma coe_smul_closed_ball (z : closed_ball (0 : ℂ) 1) (w : 𝔻) : ↑(z • w) = (z * w : ℂ) := rfl + +/-- Real part of a point of the unit disc. -/ +def re (z : 𝔻) : ℝ := re z + +/-- Imaginary part of a point of the unit disc. -/ +def im (z : 𝔻) : ℝ := im z + +@[simp, norm_cast] lemma re_coe (z : 𝔻) : (z : ℂ).re = z.re := rfl +@[simp, norm_cast] lemma im_coe (z : 𝔻) : (z : ℂ).im = z.im := rfl +@[simp] lemma re_neg (z : 𝔻) : (-z).re = -z.re := rfl +@[simp] lemma im_neg (z : 𝔻) : (-z).im = -z.im := rfl + +/-- Conjugate point of the unit disc. -/ +def conj (z : 𝔻) : 𝔻 := mk (conj' ↑z) $ (abs_conj z).symm ▸ z.abs_lt_one + +@[simp, norm_cast] lemma coe_conj (z : 𝔻) : (z.conj : ℂ) = conj' ↑z := rfl +@[simp] lemma conj_zero : conj 0 = 0 := coe_injective (map_zero conj') +@[simp] lemma conj_conj (z : 𝔻) : conj (conj z) = z := coe_injective $ complex.conj_conj z +@[simp] lemma conj_neg (z : 𝔻) : (-z).conj = -z.conj := rfl +@[simp] lemma re_conj (z : 𝔻) : z.conj.re = z.re := rfl +@[simp] lemma im_conj (z : 𝔻) : z.conj.im = -z.im := rfl +@[simp] lemma conj_mul (z w : 𝔻) : (z * w).conj = z.conj * w.conj := subtype.ext $ map_mul _ _ _ + +end unit_disc + +end complex diff --git a/src/analysis/complex/upper_half_plane.lean b/src/analysis/complex/upper_half_plane.lean deleted file mode 100644 index 82bafe1df3ed8..0000000000000 --- a/src/analysis/complex/upper_half_plane.lean +++ /dev/null @@ -1,171 +0,0 @@ -/- -Copyright (c) 2021 Alex Kontorovich and Heather Macbeth and Marc Masdeu. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Alex Kontorovich, Heather Macbeth, Marc Masdeu --/ - -import linear_algebra.special_linear_group -import analysis.complex.basic -import group_theory.group_action.defs - -/-! -# The upper half plane and its automorphisms - -This file defines `upper_half_plane` to be the upper half plane in `ℂ`. - -We furthermore equip it with the structure of an `SL(2,ℝ)` action by -fractional linear transformations. - -We define the notation `ℍ` for the upper half plane available in the locale -`upper_half_plane` so as not to conflict with the quaternions. --/ - -noncomputable theory - -open matrix matrix.special_linear_group - -open_locale classical big_operators matrix_groups - -local attribute [instance] fintype.card_fin_even - -/- Disable this instances as it is not the simp-normal form, and having them disabled ensures -we state lemmas in this file without spurious `coe_fn` terms. -/ -local attribute [-instance] matrix.special_linear_group.has_coe_to_fun - -local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _ - -/-- The open upper half plane -/ -@[derive [topological_space, λ α, has_coe α ℂ]] -def upper_half_plane := {point : ℂ // 0 < point.im} - -localized "notation `ℍ` := upper_half_plane" in upper_half_plane - -namespace upper_half_plane - -instance : inhabited ℍ := ⟨⟨complex.I, by simp⟩⟩ - -/-- Imaginary part -/ -def im (z : ℍ) := (z : ℂ).im - -/-- Real part -/ -def re (z : ℍ) := (z : ℂ).re - -@[simp] lemma coe_im (z : ℍ) : (z : ℂ).im = z.im := rfl - -@[simp] lemma coe_re (z : ℍ) : (z : ℂ).re = z.re := rfl - -lemma im_pos (z : ℍ) : 0 < z.im := z.2 - -lemma im_ne_zero (z : ℍ) : z.im ≠ 0 := z.im_pos.ne' - -lemma ne_zero (z : ℍ) : (z : ℂ) ≠ 0 := -mt (congr_arg complex.im) z.im_ne_zero - -lemma norm_sq_pos (z : ℍ) : 0 < complex.norm_sq (z : ℂ) := -by { rw complex.norm_sq_pos, exact z.ne_zero } - -lemma norm_sq_ne_zero (z : ℍ) : complex.norm_sq (z : ℂ) ≠ 0 := (norm_sq_pos z).ne' - -/-- Numerator of the formula for a fractional linear transformation -/ -@[simp] def num (g : SL(2, ℝ)) (z : ℍ) : ℂ := (↑ₘg 0 0 : ℝ) * z + (↑ₘg 0 1 : ℝ) - -/-- Denominator of the formula for a fractional linear transformation -/ -@[simp] def denom (g : SL(2, ℝ)) (z : ℍ) : ℂ := (↑ₘg 1 0 : ℝ) * z + (↑ₘg 1 1 : ℝ) - -lemma linear_ne_zero (cd : fin 2 → ℝ) (z : ℍ) (h : cd ≠ 0) : (cd 0 : ℂ) * z + cd 1 ≠ 0 := -begin - contrapose! h, - have : cd 0 = 0, -- we will need this twice - { apply_fun complex.im at h, - simpa only [z.im_ne_zero, complex.add_im, add_zero, coe_im, zero_mul, or_false, - complex.of_real_im, complex.zero_im, complex.mul_im, mul_eq_zero] using h, }, - simp only [this, zero_mul, complex.of_real_zero, zero_add, complex.of_real_eq_zero] at h, - ext i, - fin_cases i; assumption, -end - -lemma denom_ne_zero (g : SL(2, ℝ)) (z : ℍ) : denom g z ≠ 0 := -linear_ne_zero (↑ₘg 1) z (g.row_ne_zero 1) - -lemma norm_sq_denom_pos (g : SL(2, ℝ)) (z : ℍ) : 0 < complex.norm_sq (denom g z) := -complex.norm_sq_pos.mpr (denom_ne_zero g z) - -lemma norm_sq_denom_ne_zero (g : SL(2, ℝ)) (z : ℍ) : complex.norm_sq (denom g z) ≠ 0 := -ne_of_gt (norm_sq_denom_pos g z) - -/-- Fractional linear transformation -/ -def smul_aux' (g : SL(2, ℝ)) (z : ℍ) : ℂ := num g z / denom g z - -lemma smul_aux'_im (g : SL(2, ℝ)) (z : ℍ) : - (smul_aux' g z).im = z.im / (denom g z).norm_sq := -begin - rw [smul_aux', complex.div_im], - set NsqBot := (denom g z).norm_sq, - have : NsqBot ≠ 0, - { simp only [denom_ne_zero g z, monoid_with_zero_hom.map_eq_zero, ne.def, not_false_iff], }, - field_simp [smul_aux'], - convert congr_arg (λ x, x * z.im * NsqBot ^ 2) g.det_coe using 1, - { rw det_fin_two ↑g, - ring }, - { ring } -end - -/-- Fractional linear transformation -/ -def smul_aux (g : SL(2,ℝ)) (z : ℍ) : ℍ := -⟨smul_aux' g z, -by { rw smul_aux'_im, exact div_pos z.im_pos (complex.norm_sq_pos.mpr (denom_ne_zero g z)) }⟩ - -lemma denom_cocycle (x y : SL(2,ℝ)) (z : ℍ) : - denom (x * y) z = denom x (smul_aux y z) * denom y z := -begin - change _ = (_ * (_ / _) + _) * _, - field_simp [denom_ne_zero, -denom, -num], - simp [matrix.mul, dot_product, fin.sum_univ_succ], - ring -end - -lemma mul_smul' (x y : SL(2, ℝ)) (z : ℍ) : - smul_aux (x * y) z = smul_aux x (smul_aux y z) := -begin - ext1, - change _ / _ = (_ * (_ / _) + _) * _, - rw denom_cocycle, - field_simp [denom_ne_zero, -denom, -num], - simp [matrix.mul, dot_product, fin.sum_univ_succ], - ring -end - -/-- The action of `SL(2, ℝ)` on the upper half-plane by fractional linear transformations. -/ -instance : mul_action SL(2, ℝ) ℍ := -{ smul := smul_aux, - one_smul := λ z, by { ext1, change _ / _ = _, simp }, - mul_smul := mul_smul' } - -@[simp] lemma coe_smul (g : SL(2, ℝ)) (z : ℍ) : ↑(g • z) = num g z / denom g z := rfl -@[simp] lemma re_smul (g : SL(2, ℝ)) (z : ℍ) : (g • z).re = (num g z / denom g z).re := rfl - -lemma im_smul (g : SL(2, ℝ)) (z : ℍ) : (g • z).im = (num g z / denom g z).im := rfl - -lemma im_smul_eq_div_norm_sq (g : SL(2, ℝ)) (z : ℍ) : - (g • z).im = z.im / (complex.norm_sq (denom g z)) := -smul_aux'_im g z - -@[simp] lemma neg_smul (g : SL(2,ℝ)) (z : ℍ) : -g • z = g • z := -begin - ext1, - change _ / _ = _ / _, - field_simp [denom_ne_zero, -denom, -num], - simp, - ring, -end - -lemma c_mul_im_sq_le_norm_sq_denom (z : ℍ) (g : SL(2, ℝ)) : - ((↑ₘg 1 0 : ℝ) * (z.im))^2 ≤ complex.norm_sq (denom g z) := -begin - let c := (↑ₘg 1 0 : ℝ), - let d := (↑ₘg 1 1 : ℝ), - calc (c * z.im)^2 ≤ (c * z.im)^2 + (c * z.re + d)^2 : by nlinarith - ... = complex.norm_sq (denom g z) : by simp [complex.norm_sq]; ring, -end - -end upper_half_plane diff --git a/src/analysis/complex/upper_half_plane/basic.lean b/src/analysis/complex/upper_half_plane/basic.lean new file mode 100644 index 0000000000000..02d2506086cf0 --- /dev/null +++ b/src/analysis/complex/upper_half_plane/basic.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2021 Alex Kontorovich and Heather Macbeth and Marc Masdeu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alex Kontorovich, Heather Macbeth, Marc Masdeu +-/ +import data.fintype.parity +import linear_algebra.matrix.special_linear_group +import analysis.complex.basic +import group_theory.group_action.defs +import linear_algebra.matrix.general_linear_group +import tactic.linear_combination + +/-! +# The upper half plane and its automorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines `upper_half_plane` to be the upper half plane in `ℂ`. + +We furthermore equip it with the structure of an `GL_pos 2 ℝ` action by +fractional linear transformations. + +We define the notation `ℍ` for the upper half plane available in the locale +`upper_half_plane` so as not to conflict with the quaternions. +-/ + +noncomputable theory + +open matrix matrix.special_linear_group + +open_locale classical big_operators matrix_groups + +local attribute [instance] fintype.card_fin_even + +/- Disable these instances as they are not the simp-normal form, and having them disabled ensures +we state lemmas in this file without spurious `coe_fn` terms. -/ +local attribute [-instance] matrix.special_linear_group.has_coe_to_fun +local attribute [-instance] matrix.general_linear_group.has_coe_to_fun + +local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _ +local notation `↑ₘ[`:1024 R `]` := @coe _ (matrix (fin 2) (fin 2) R) _ + +local notation `GL(` n `, ` R `)`⁺ := matrix.GL_pos (fin n) R + +/-- The open upper half plane -/ +@[derive [λ α, has_coe α ℂ]] +def upper_half_plane := {point : ℂ // 0 < point.im} + +localized "notation (name := upper_half_plane) `ℍ` := upper_half_plane" in upper_half_plane + +namespace upper_half_plane + +instance : inhabited ℍ := ⟨⟨complex.I, by simp⟩⟩ + +instance can_lift : can_lift ℂ ℍ coe (λ z, 0 < z.im) := subtype.can_lift (λ z, 0 < z.im) + +/-- Imaginary part -/ +def im (z : ℍ) := (z : ℂ).im + +/-- Real part -/ +def re (z : ℍ) := (z : ℂ).re + +/-- Constructor for `upper_half_plane`. It is useful if `⟨z, h⟩` makes Lean use a wrong +typeclass instance. -/ +def mk (z : ℂ) (h : 0 < z.im) : ℍ := ⟨z, h⟩ + +@[simp] lemma coe_im (z : ℍ) : (z : ℂ).im = z.im := rfl + +@[simp] lemma coe_re (z : ℍ) : (z : ℂ).re = z.re := rfl + +@[simp] lemma mk_re (z : ℂ) (h : 0 < z.im) : (mk z h).re = z.re := rfl +@[simp] lemma mk_im (z : ℂ) (h : 0 < z.im) : (mk z h).im = z.im := rfl +@[simp] lemma coe_mk (z : ℂ) (h : 0 < z.im) : (mk z h : ℂ) = z := rfl +@[simp] lemma mk_coe (z : ℍ) (h : 0 < (z : ℂ).im := z.2) : mk z h = z := subtype.eta z h + +lemma re_add_im (z : ℍ) : (z.re + z.im * complex.I : ℂ) = z := +complex.re_add_im z + +lemma im_pos (z : ℍ) : 0 < z.im := z.2 + +lemma im_ne_zero (z : ℍ) : z.im ≠ 0 := z.im_pos.ne' + +lemma ne_zero (z : ℍ) : (z : ℂ) ≠ 0 := +mt (congr_arg complex.im) z.im_ne_zero + +lemma norm_sq_pos (z : ℍ) : 0 < complex.norm_sq (z : ℂ) := +by { rw complex.norm_sq_pos, exact z.ne_zero } + +lemma norm_sq_ne_zero (z : ℍ) : complex.norm_sq (z : ℂ) ≠ 0 := (norm_sq_pos z).ne' + +lemma im_inv_neg_coe_pos (z : ℍ) : 0 < ((-z : ℂ)⁻¹).im := +by simpa using div_pos z.property (norm_sq_pos z) + +/-- Numerator of the formula for a fractional linear transformation -/ +@[simp] def num (g : GL(2, ℝ)⁺) (z : ℍ) : ℂ := (↑ₘg 0 0 : ℝ) * z + (↑ₘg 0 1 : ℝ) + +/-- Denominator of the formula for a fractional linear transformation -/ +@[simp] def denom (g : GL(2, ℝ)⁺) (z : ℍ) : ℂ := (↑ₘg 1 0 : ℝ) * z + (↑ₘg 1 1 : ℝ) + +lemma linear_ne_zero (cd : fin 2 → ℝ) (z : ℍ) (h : cd ≠ 0) : (cd 0 : ℂ) * z + cd 1 ≠ 0 := +begin + contrapose! h, + have : cd 0 = 0, -- we will need this twice + { apply_fun complex.im at h, + simpa only [z.im_ne_zero, complex.add_im, add_zero, coe_im, zero_mul, or_false, + complex.of_real_im, complex.zero_im, complex.mul_im, mul_eq_zero] using h, }, + simp only [this, zero_mul, complex.of_real_zero, zero_add, complex.of_real_eq_zero] at h, + ext i, + fin_cases i; assumption, +end + +lemma denom_ne_zero (g : GL(2, ℝ)⁺) (z : ℍ) : denom g z ≠ 0 := +begin + intro H, + have DET := (mem_GL_pos _).1 g.prop, + have hz := z.prop, + simp only [general_linear_group.coe_det_apply] at DET, + have H1 : (↑ₘg 1 0 : ℝ) = 0 ∨ z.im = 0, by simpa using congr_arg complex.im H, + cases H1, + { simp only [H1, complex.of_real_zero, denom, coe_fn_eq_coe, zero_mul, zero_add, + complex.of_real_eq_zero] at H, + rw [←coe_coe, (matrix.det_fin_two (↑g : matrix (fin 2) (fin 2) ℝ))] at DET, + simp only [coe_coe,H, H1, mul_zero, sub_zero, lt_self_iff_false] at DET, + exact DET, }, + { change z.im > 0 at hz, + linarith, } +end + +lemma norm_sq_denom_pos (g : GL(2, ℝ)⁺) (z : ℍ) : 0 < complex.norm_sq (denom g z) := +complex.norm_sq_pos.mpr (denom_ne_zero g z) + +lemma norm_sq_denom_ne_zero (g : GL(2, ℝ)⁺) (z : ℍ) : complex.norm_sq (denom g z) ≠ 0 := +ne_of_gt (norm_sq_denom_pos g z) + +/-- Fractional linear transformation, also known as the Moebius transformation -/ +def smul_aux' (g : GL(2, ℝ)⁺) (z : ℍ) : ℂ := num g z / denom g z + +lemma smul_aux'_im (g : GL(2, ℝ)⁺) (z : ℍ) : + (smul_aux' g z).im = ((det ↑ₘg) * z.im) / (denom g z).norm_sq := +begin + rw [smul_aux', complex.div_im], + set NsqBot := (denom g z).norm_sq, + have : NsqBot ≠ 0, + { simp only [denom_ne_zero g z, map_eq_zero, ne.def, not_false_iff], }, + field_simp [smul_aux', -coe_coe], + rw (matrix.det_fin_two (↑ₘg)), + ring, +end + +/-- Fractional linear transformation, also known as the Moebius transformation -/ +def smul_aux (g : GL(2, ℝ)⁺) (z : ℍ) : ℍ := + ⟨smul_aux' g z, begin + rw smul_aux'_im, + convert (mul_pos ((mem_GL_pos _).1 g.prop) + (div_pos z.im_pos (complex.norm_sq_pos.mpr (denom_ne_zero g z)))), + simp only [general_linear_group.coe_det_apply, coe_coe], + ring +end⟩ + +lemma denom_cocycle (x y : GL(2, ℝ)⁺) (z : ℍ) : + denom (x * y) z = denom x (smul_aux y z) * denom y z := +begin + change _ = (_ * (_ / _) + _) * _, + field_simp [denom_ne_zero, -denom, -num], + simp only [matrix.mul, dot_product, fin.sum_univ_succ, denom, num, coe_coe, subgroup.coe_mul, + general_linear_group.coe_mul, fintype.univ_of_subsingleton, fin.mk_zero, + finset.sum_singleton, fin.succ_zero_eq_one, complex.of_real_add, complex.of_real_mul], + ring +end + +lemma mul_smul' (x y : GL(2, ℝ)⁺) (z : ℍ) : + smul_aux (x * y) z = smul_aux x (smul_aux y z) := +begin + ext1, + change _ / _ = (_ * (_ / _) + _) * _, + rw denom_cocycle, + field_simp [denom_ne_zero, -denom, -num], + simp only [matrix.mul, dot_product, fin.sum_univ_succ, num, denom, coe_coe, subgroup.coe_mul, + general_linear_group.coe_mul, fintype.univ_of_subsingleton, fin.mk_zero, + finset.sum_singleton, fin.succ_zero_eq_one, complex.of_real_add, complex.of_real_mul], + ring +end + +/-- The action of ` GL_pos 2 ℝ` on the upper half-plane by fractional linear transformations. -/ +instance : mul_action (GL(2, ℝ)⁺) ℍ := +{ smul := smul_aux, + one_smul := λ z, by { ext1, change _ / _ = _, + simp [coe_fn_coe_base'] }, + mul_smul := mul_smul' } + +section modular_scalar_towers + +variable (Γ : subgroup (special_linear_group (fin 2) ℤ)) + +instance SL_action {R : Type*} [comm_ring R] [algebra R ℝ] : mul_action SL(2, R) ℍ := +mul_action.comp_hom ℍ $ (special_linear_group.to_GL_pos).comp $ map (algebra_map R ℝ) + +instance : has_coe SL(2,ℤ) (GL(2, ℝ)⁺) := ⟨λ g , ((g : SL(2, ℝ)) : (GL(2, ℝ)⁺))⟩ + +instance SL_on_GL_pos : has_smul SL(2,ℤ) (GL(2, ℝ)⁺) := ⟨λ s g, s * g⟩ + +lemma SL_on_GL_pos_smul_apply (s : SL(2,ℤ)) (g : (GL(2, ℝ)⁺)) (z : ℍ) : + (s • g) • z = ( (s : GL(2, ℝ)⁺) * g) • z := rfl + +instance SL_to_GL_tower : is_scalar_tower SL(2,ℤ) (GL(2, ℝ)⁺) ℍ := +{ smul_assoc := by {intros s g z, simp only [SL_on_GL_pos_smul_apply, coe_coe], apply mul_smul',},} + +instance subgroup_GL_pos : has_smul Γ (GL(2, ℝ)⁺) := ⟨λ s g, s * g⟩ + +lemma subgroup_on_GL_pos_smul_apply (s : Γ) (g : (GL(2, ℝ)⁺)) (z : ℍ) : + (s • g) • z = ( (s : GL(2, ℝ)⁺) * g) • z := rfl + +instance subgroup_on_GL_pos : is_scalar_tower Γ (GL(2, ℝ)⁺) ℍ := +{ smul_assoc := + by {intros s g z, simp only [subgroup_on_GL_pos_smul_apply, coe_coe], apply mul_smul',},} + +instance subgroup_SL : has_smul Γ SL(2,ℤ) := ⟨λ s g, s * g⟩ + +lemma subgroup_on_SL_apply (s : Γ) (g : SL(2,ℤ) ) (z : ℍ) : + (s • g) • z = ( (s : SL(2, ℤ)) * g) • z := rfl + +instance subgroup_to_SL_tower : is_scalar_tower Γ SL(2,ℤ) ℍ := +{ smul_assoc := λ s g z, by { rw subgroup_on_SL_apply, apply mul_action.mul_smul } } + +end modular_scalar_towers + +lemma special_linear_group_apply {R : Type*} [comm_ring R] [algebra R ℝ] (g : SL(2, R)) (z : ℍ) : + g • z = mk ((((↑(↑ₘ[R] g 0 0) : ℝ) : ℂ) * z + ((↑(↑ₘ[R] g 0 1) : ℝ) : ℂ)) / + (((↑(↑ₘ[R] g 1 0) : ℝ) : ℂ) * z + ((↑(↑ₘ[R] g 1 1) : ℝ) : ℂ))) (g • z).property := +rfl + +@[simp] lemma coe_smul (g : GL(2, ℝ)⁺) (z : ℍ) : ↑(g • z) = num g z / denom g z := rfl +@[simp] lemma re_smul (g : GL(2, ℝ)⁺) (z : ℍ) : (g • z).re = (num g z / denom g z).re := rfl +lemma im_smul (g : GL(2, ℝ)⁺) (z : ℍ) : (g • z).im = (num g z / denom g z).im := rfl + +lemma im_smul_eq_div_norm_sq (g : GL(2, ℝ)⁺) (z : ℍ) : + (g • z).im = (det ↑ₘg * z.im) / (complex.norm_sq (denom g z)) := smul_aux'_im g z + +@[simp] lemma neg_smul (g : GL(2, ℝ)⁺) (z : ℍ) : -g • z = g • z := +begin + ext1, + change _ / _ = _ / _, + field_simp [denom_ne_zero, -denom, -num], + simp only [num, denom, coe_coe, complex.of_real_neg, neg_mul, GL_pos.coe_neg_GL, units.coe_neg, + pi.neg_apply], + ring_nf, +end + +section SL_modular_action + +variables (g : SL(2, ℤ)) (z : ℍ) (Γ : subgroup SL(2,ℤ)) + +@[simp] lemma sl_moeb (A : SL(2,ℤ)) (z : ℍ) : A • z = (A : (GL(2, ℝ)⁺)) • z := rfl +lemma subgroup_moeb (A : Γ) (z : ℍ) : A • z = (A : (GL(2, ℝ)⁺)) • z := rfl +@[simp] lemma subgroup_to_sl_moeb (A : Γ) (z : ℍ) : A • z = (A : SL(2,ℤ)) • z := rfl + +@[simp] lemma SL_neg_smul (g : SL(2,ℤ)) (z : ℍ) : -g • z = g • z := +begin +simp only [coe_GL_pos_neg, sl_moeb, coe_coe, coe_int_neg, neg_smul], +end + +lemma c_mul_im_sq_le_norm_sq_denom (z : ℍ) (g : SL(2, ℝ)) : + ((↑ₘg 1 0 : ℝ) * (z.im))^2 ≤ complex.norm_sq (denom g z) := +begin + let c := (↑ₘg 1 0 : ℝ), + let d := (↑ₘg 1 1 : ℝ), + calc (c * z.im)^2 ≤ (c * z.im)^2 + (c * z.re + d)^2 : by nlinarith + ... = complex.norm_sq (denom g z) : by simp [complex.norm_sq]; ring, +end + +lemma special_linear_group.im_smul_eq_div_norm_sq : + (g • z).im = z.im / (complex.norm_sq (denom g z)) := +begin + convert (im_smul_eq_div_norm_sq g z), + simp only [coe_coe, general_linear_group.coe_det_apply,coe_GL_pos_coe_GL_coe_matrix, + int.coe_cast_ring_hom,(g : SL(2,ℝ)).prop, one_mul], +end + +lemma denom_apply (g : SL(2, ℤ)) (z : ℍ) : denom g z = (↑g : matrix (fin 2) (fin 2) ℤ) 1 0 * z + + (↑g : matrix (fin 2) (fin 2) ℤ) 1 1 := by simp + +end SL_modular_action + +section pos_real_action + +instance pos_real_action : mul_action {x : ℝ // 0 < x} ℍ := +{ smul := λ x z, mk ((x : ℝ) • z) $ by simpa using mul_pos x.2 z.2, + one_smul := λ z, subtype.ext $ one_smul _ _, + mul_smul := λ x y z, subtype.ext $ mul_smul (x : ℝ) y (z : ℂ) } + +variables (x : {x : ℝ // 0 < x}) (z : ℍ) + +@[simp] lemma coe_pos_real_smul : ↑(x • z) = (x : ℝ) • (z : ℂ) := rfl +@[simp] lemma pos_real_im : (x • z).im = x * z.im := complex.smul_im _ _ +@[simp] lemma pos_real_re : (x • z).re = x * z.re := complex.smul_re _ _ + +end pos_real_action + +section real_add_action + +instance : add_action ℝ ℍ := +{ vadd := λ x z, mk (x + z) $ by simpa using z.im_pos, + zero_vadd := λ z, subtype.ext $ by simp, + add_vadd := λ x y z, subtype.ext $ by simp [add_assoc] } + +variables (x : ℝ) (z : ℍ) + +@[simp] lemma coe_vadd : ↑(x +ᵥ z) = (x + z : ℂ) := rfl +@[simp] lemma vadd_re : (x +ᵥ z).re = x + z.re := rfl +@[simp] lemma vadd_im : (x +ᵥ z).im = z.im := zero_add _ + +end real_add_action + +/- these next few lemmas are *not* flagged `@simp` because of the constructors on the RHS; +instead we use the versions with coercions to `ℂ` as simp lemmas instead. -/ +lemma modular_S_smul (z : ℍ) : modular_group.S • z = mk (-z : ℂ)⁻¹ z.im_inv_neg_coe_pos := +by { rw special_linear_group_apply, simp [modular_group.S, neg_div, inv_neg], } + +lemma modular_T_zpow_smul (z : ℍ) (n : ℤ) : modular_group.T ^ n • z = (n : ℝ) +ᵥ z := +begin + rw [←subtype.coe_inj, coe_vadd, add_comm, special_linear_group_apply, coe_mk, + modular_group.coe_T_zpow], + simp only [of_apply, cons_val_zero, algebra_map.coe_one, complex.of_real_one, one_mul, + cons_val_one, head_cons, algebra_map.coe_zero, zero_mul, zero_add, div_one], +end + +lemma modular_T_smul (z : ℍ) : modular_group.T • z = (1 : ℝ) +ᵥ z := +by simpa only [algebra_map.coe_one] using modular_T_zpow_smul z 1 + +lemma exists_SL2_smul_eq_of_apply_zero_one_eq_zero (g : SL(2, ℝ)) (hc : ↑ₘ[ℝ] g 1 0 = 0) : + ∃ (u : {x : ℝ // 0 < x}) (v : ℝ), + ((•) g : ℍ → ℍ) = (λ z, v +ᵥ z) ∘ (λ z, u • z) := +begin + obtain ⟨a, b, ha, rfl⟩ := g.fin_two_exists_eq_mk_of_apply_zero_one_eq_zero hc, + refine ⟨⟨_, mul_self_pos.mpr ha⟩, b * a, _⟩, + ext1 ⟨z, hz⟩, ext1, + suffices : ↑a * z * a + b * a = b * a + a * a * z, + { rw special_linear_group_apply, simpa [add_mul], }, + ring, +end + +lemma exists_SL2_smul_eq_of_apply_zero_one_ne_zero (g : SL(2, ℝ)) (hc : ↑ₘ[ℝ] g 1 0 ≠ 0) : + ∃ (u : {x : ℝ // 0 < x}) (v w : ℝ), + ((•) g : ℍ → ℍ) = ((+ᵥ) w : ℍ → ℍ) ∘ ((•) modular_group.S : ℍ → ℍ) + ∘ ((+ᵥ) v : ℍ → ℍ) ∘ ((•) u : ℍ → ℍ) := +begin + have h_denom := denom_ne_zero g, + induction g using matrix.special_linear_group.fin_two_induction with a b c d h, + replace hc : c ≠ 0, { simpa using hc, }, + refine ⟨⟨_, mul_self_pos.mpr hc⟩, c * d, a / c, _⟩, + ext1 ⟨z, hz⟩, ext1, + suffices : (↑a * z + b) / (↑c * z + d) = a / c - (c * d + ↑c * ↑c * z)⁻¹, + { rw special_linear_group_apply, + simpa only [inv_neg, modular_S_smul, subtype.coe_mk, coe_vadd, complex.of_real_mul, + coe_pos_real_smul, complex.real_smul, function.comp_app, complex.of_real_div] }, + replace hc : (c : ℂ) ≠ 0, { norm_cast, assumption, }, + replace h_denom : ↑c * z + d ≠ 0, { simpa using h_denom ⟨z, hz⟩, }, + have h_aux : (c : ℂ) * d + ↑c * ↑c * z ≠ 0, + { rw [mul_assoc, ← mul_add, add_comm], exact mul_ne_zero hc h_denom, }, + replace h : (a * d - b * c : ℂ) = (1 : ℂ), { norm_cast, assumption, }, + field_simp, + linear_combination (-(z * ↑c ^ 2) - ↑c * ↑d) * h, +end + +end upper_half_plane diff --git a/src/analysis/complex/upper_half_plane/functions_bounded_at_infty.lean b/src/analysis/complex/upper_half_plane/functions_bounded_at_infty.lean new file mode 100644 index 0000000000000..26d6235065751 --- /dev/null +++ b/src/analysis/complex/upper_half_plane/functions_bounded_at_infty.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2022 Chris Birkbeck. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Birkbeck, David Loeffler +-/ + +import algebra.module.submodule.basic +import analysis.complex.upper_half_plane.basic +import order.filter.zero_and_bounded_at_filter + +/-! +# Bounded at infinity + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For complex valued functions on the upper half plane, this file defines the filter `at_im_infty` +required for defining when functions are bounded at infinity and zero at infinity. +Both of which are relevant for defining modular forms. + +-/ + +open complex filter + +open_locale topology upper_half_plane + +noncomputable theory + +namespace upper_half_plane + +/-- Filter for approaching `i∞`. -/ +def at_im_infty := filter.at_top.comap upper_half_plane.im + +lemma at_im_infty_basis : (at_im_infty).has_basis (λ _, true) (λ (i : ℝ), im ⁻¹' set.Ici i) := +filter.has_basis.comap upper_half_plane.im filter.at_top_basis + +lemma at_im_infty_mem (S : set ℍ) : S ∈ at_im_infty ↔ (∃ A : ℝ, ∀ z : ℍ, A ≤ im z → z ∈ S) := +begin + simp only [at_im_infty, filter.mem_comap', filter.mem_at_top_sets, ge_iff_le, set.mem_set_of_eq, + upper_half_plane.coe_im], + refine ⟨λ ⟨a, h⟩, ⟨a, (λ z hz, h (im z) hz rfl)⟩, _⟩, + rintro ⟨A, h⟩, + refine ⟨A, λ b hb x hx, h x _⟩, + rwa hx, +end + +/-- A function ` f : ℍ → α` is bounded at infinity if it is bounded along `at_im_infty`. -/ +def is_bounded_at_im_infty {α : Type*} [has_norm α] (f : ℍ → α) : Prop := +bounded_at_filter at_im_infty f + +/-- A function ` f : ℍ → α` is zero at infinity it is zero along `at_im_infty`. -/ +def is_zero_at_im_infty {α : Type*} [has_zero α] [topological_space α] (f : ℍ → α) : Prop := +zero_at_filter at_im_infty f + +lemma zero_form_is_bounded_at_im_infty {α : Type*} [normed_field α] : + is_bounded_at_im_infty (0 : ℍ → α) := const_bounded_at_filter at_im_infty (0:α) + +/-- Module of functions that are zero at infinity. -/ +def zero_at_im_infty_submodule (α : Type*) [normed_field α] : submodule α (ℍ → α) := +zero_at_filter_submodule at_im_infty + +/-- ubalgebra of functions that are bounded at infinity. -/ +def bounded_at_im_infty_subalgebra (α : Type*) [normed_field α] : subalgebra α (ℍ → α) := +bounded_filter_subalgebra at_im_infty + +lemma is_bounded_at_im_infty.mul {f g : ℍ → ℂ} (hf : is_bounded_at_im_infty f) + (hg : is_bounded_at_im_infty g) : is_bounded_at_im_infty (f * g) := +by simpa only [pi.one_apply, mul_one, norm_eq_abs] using hf.mul hg + +lemma bounded_mem (f : ℍ → ℂ) : + is_bounded_at_im_infty f ↔ ∃ (M A : ℝ), ∀ z : ℍ, A ≤ im z → abs (f z) ≤ M := +by simp [is_bounded_at_im_infty, bounded_at_filter, asymptotics.is_O_iff, filter.eventually, + at_im_infty_mem] + +lemma zero_at_im_infty (f : ℍ → ℂ) : + is_zero_at_im_infty f ↔ ∀ ε : ℝ, 0 < ε → ∃ A : ℝ, ∀ z : ℍ, A ≤ im z → abs (f z) ≤ ε := +begin + rw [is_zero_at_im_infty, zero_at_filter, tendsto_iff_forall_eventually_mem], + split, + { simp_rw [filter.eventually, at_im_infty_mem], + intros h ε hε, + simpa using (h (metric.closed_ball (0 : ℂ) ε) (metric.closed_ball_mem_nhds (0 : ℂ) hε))}, + { simp_rw metric.mem_nhds_iff, + intros h s hs, + simp_rw [filter.eventually, at_im_infty_mem], + obtain ⟨ε, h1, h2⟩ := hs, + have h11 : 0 < (ε/2), by {linarith,}, + obtain ⟨A, hA⟩ := (h (ε/2) h11), + use A, + intros z hz, + have hzs : f z ∈ s, + { apply h2, + simp only [mem_ball_zero_iff, norm_eq_abs], + apply lt_of_le_of_lt (hA z hz), + linarith }, + apply hzs,} +end + +end upper_half_plane diff --git a/src/analysis/complex/upper_half_plane/manifold.lean b/src/analysis/complex/upper_half_plane/manifold.lean new file mode 100644 index 0000000000000..0c070195cc5dd --- /dev/null +++ b/src/analysis/complex/upper_half_plane/manifold.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2022 Chris Birkbeck. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Birkbeck +-/ +import analysis.complex.upper_half_plane.topology +import geometry.manifold.cont_mdiff_mfderiv +/-! +# Manifold structure on the upper half plane. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define the complex manifold structure on the upper half-plane. +-/ + +open_locale upper_half_plane manifold + +namespace upper_half_plane + +noncomputable instance : charted_space ℂ ℍ := +upper_half_plane.open_embedding_coe.singleton_charted_space + +instance : smooth_manifold_with_corners 𝓘(ℂ) ℍ := +upper_half_plane.open_embedding_coe.singleton_smooth_manifold_with_corners 𝓘(ℂ) + +/-- The inclusion map `ℍ → ℂ` is a smooth map of manifolds. -/ +lemma smooth_coe : smooth 𝓘(ℂ) 𝓘(ℂ) (coe : ℍ → ℂ) := +λ x, cont_mdiff_at_ext_chart_at + +/-- The inclusion map `ℍ → ℂ` is a differentiable map of manifolds. -/ +lemma mdifferentiable_coe : mdifferentiable 𝓘(ℂ) 𝓘(ℂ) (coe : ℍ → ℂ) := +smooth_coe.mdifferentiable + +end upper_half_plane diff --git a/src/analysis/complex/upper_half_plane/metric.lean b/src/analysis/complex/upper_half_plane/metric.lean new file mode 100644 index 0000000000000..f240cfc3adbd2 --- /dev/null +++ b/src/analysis/complex/upper_half_plane/metric.lean @@ -0,0 +1,377 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.complex.upper_half_plane.topology +import analysis.special_functions.arsinh +import geometry.euclidean.inversion + +/-! +# Metric on the upper half-plane + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define a `metric_space` structure on the `upper_half_plane`. We use hyperbolic +(Poincaré) distance given by +`dist z w = 2 * arsinh (dist (z : ℂ) w / (2 * real.sqrt (z.im * w.im)))` instead of the induced +Euclidean distance because the hyperbolic distance is invariant under holomorphic automorphisms of +the upper half-plane. However, we ensure that the projection to `topological_space` is +definitionally equal to the induced topological space structure. + +We also prove that a metric ball/closed ball/sphere in Poincaré metric is a Euclidean ball/closed +ball/sphere with another center and radius. + +-/ + +noncomputable theory + +open_locale upper_half_plane complex_conjugate nnreal topology matrix_groups +open set metric filter real + +variables {z w : ℍ} {r R : ℝ} + +namespace upper_half_plane + +instance : has_dist ℍ := +⟨λ z w, 2 * arsinh (dist (z : ℂ) w / (2 * sqrt (z.im * w.im)))⟩ + +lemma dist_eq (z w : ℍ) : dist z w = 2 * arsinh (dist (z : ℂ) w / (2 * sqrt (z.im * w.im))) := +rfl + +lemma sinh_half_dist (z w : ℍ) : + sinh (dist z w / 2) = dist (z : ℂ) w / (2 * sqrt (z.im * w.im)) := +by rw [dist_eq, mul_div_cancel_left (arsinh _) two_ne_zero, sinh_arsinh] + +lemma cosh_half_dist (z w : ℍ) : + cosh (dist z w / 2) = dist (z : ℂ) (conj (w : ℂ)) / (2 * sqrt (z.im * w.im)) := +begin + have H₁ : (2 ^ 2 : ℝ) = 4, by norm_num1, + have H₂ : 0 < z.im * w.im, from mul_pos z.im_pos w.im_pos, + have H₃ : 0 < 2 * sqrt (z.im * w.im), from mul_pos two_pos (sqrt_pos.2 H₂), + rw [← sq_eq_sq (cosh_pos _).le (div_nonneg dist_nonneg H₃.le), cosh_sq', sinh_half_dist, div_pow, + div_pow, one_add_div (pow_ne_zero 2 H₃.ne'), mul_pow, sq_sqrt H₂.le, H₁], + congr' 1, + simp only [complex.dist_eq, complex.sq_abs, complex.norm_sq_sub, complex.norm_sq_conj, + complex.conj_conj, complex.mul_re, complex.conj_re, complex.conj_im, coe_im], + ring +end + +lemma tanh_half_dist (z w : ℍ) : + tanh (dist z w / 2) = dist (z : ℂ) w / dist (z : ℂ) (conj ↑w) := +begin + rw [tanh_eq_sinh_div_cosh, sinh_half_dist, cosh_half_dist, div_div_div_comm, div_self, div_one], + exact (mul_pos (zero_lt_two' ℝ) (sqrt_pos.2 $ mul_pos z.im_pos w.im_pos)).ne' +end + +lemma exp_half_dist (z w : ℍ) : + exp (dist z w / 2) = (dist (z : ℂ) w + dist (z : ℂ) (conj ↑w)) / (2 * sqrt (z.im * w.im)) := +by rw [← sinh_add_cosh, sinh_half_dist, cosh_half_dist, add_div] + +lemma cosh_dist (z w : ℍ) : cosh (dist z w) = 1 + dist (z : ℂ) w ^ 2 / (2 * z.im * w.im) := +by rw [dist_eq, cosh_two_mul, cosh_sq', add_assoc, ← two_mul, sinh_arsinh, div_pow, mul_pow, + sq_sqrt (mul_pos z.im_pos w.im_pos).le, sq (2 : ℝ), mul_assoc, ← mul_div_assoc, + mul_assoc, mul_div_mul_left _ _ (two_ne_zero' ℝ)] + +lemma sinh_half_dist_add_dist (a b c : ℍ) : + sinh ((dist a b + dist b c) / 2) = + (dist (a : ℂ) b * dist (c : ℂ) (conj ↑b) + dist (b : ℂ) c * dist (a : ℂ) (conj ↑b)) / + (2 * sqrt (a.im * c.im) * dist (b : ℂ) (conj ↑b)) := +begin + simp only [add_div _ _ (2 : ℝ), sinh_add, sinh_half_dist, cosh_half_dist, div_mul_div_comm], + rw [← add_div, complex.dist_self_conj, coe_im, abs_of_pos b.im_pos, mul_comm (dist ↑b _), + dist_comm (b : ℂ), complex.dist_conj_comm, mul_mul_mul_comm, mul_mul_mul_comm _ _ _ b.im], + congr' 2, + rw [sqrt_mul, sqrt_mul, sqrt_mul, mul_comm (sqrt a.im), mul_mul_mul_comm, mul_self_sqrt, + mul_comm]; exact (im_pos _).le +end + +protected lemma dist_comm (z w : ℍ) : dist z w = dist w z := +by simp only [dist_eq, dist_comm (z : ℂ), mul_comm] + +lemma dist_le_iff_le_sinh : + dist z w ≤ r ↔ dist (z : ℂ) w / (2 * sqrt (z.im * w.im)) ≤ sinh (r / 2) := +by rw [← div_le_div_right (zero_lt_two' ℝ), ← sinh_le_sinh, sinh_half_dist] + +lemma dist_eq_iff_eq_sinh : + dist z w = r ↔ dist (z : ℂ) w / (2 * sqrt (z.im * w.im)) = sinh (r / 2) := +by rw [← div_left_inj' (two_ne_zero' ℝ), ← sinh_inj, sinh_half_dist] + +lemma dist_eq_iff_eq_sq_sinh (hr : 0 ≤ r) : + dist z w = r ↔ dist (z : ℂ) w ^ 2 / (4 * z.im * w.im) = sinh (r / 2) ^ 2 := +begin + rw [dist_eq_iff_eq_sinh, ← sq_eq_sq, div_pow, mul_pow, sq_sqrt, mul_assoc], + { norm_num }, + { exact (mul_pos z.im_pos w.im_pos).le }, + { exact div_nonneg dist_nonneg (mul_nonneg zero_le_two $ sqrt_nonneg _) }, + { exact sinh_nonneg_iff.2 (div_nonneg hr zero_le_two) } +end + +protected lemma dist_triangle (a b c : ℍ) : dist a c ≤ dist a b + dist b c := +begin + rw [dist_le_iff_le_sinh, sinh_half_dist_add_dist, + div_mul_eq_div_div _ _ (dist _ _), le_div_iff, div_mul_eq_mul_div], + { exact div_le_div_of_le (mul_nonneg zero_le_two (sqrt_nonneg _)) + (euclidean_geometry.mul_dist_le_mul_dist_add_mul_dist (a : ℂ) b c (conj ↑b)) }, + { rw [dist_comm, dist_pos, ne.def, complex.conj_eq_iff_im], + exact b.im_ne_zero } +end + +lemma dist_le_dist_coe_div_sqrt (z w : ℍ) : + dist z w ≤ dist (z : ℂ) w / sqrt (z.im * w.im) := +begin + rw [dist_le_iff_le_sinh, ← div_mul_eq_div_div_swap, self_le_sinh_iff], + exact div_nonneg dist_nonneg (mul_nonneg zero_le_two (sqrt_nonneg _)) +end + +/-- An auxiliary `metric_space` instance on the upper half-plane. This instance has bad projection +to `topological_space`. We replace it later. -/ +def metric_space_aux : metric_space ℍ := +{ dist := dist, + dist_self := λ z, by rw [dist_eq, dist_self, zero_div, arsinh_zero, mul_zero], + dist_comm := upper_half_plane.dist_comm, + dist_triangle := upper_half_plane.dist_triangle, + eq_of_dist_eq_zero := λ z w h, + by simpa [dist_eq, real.sqrt_eq_zero', (mul_pos z.im_pos w.im_pos).not_le, subtype.coe_inj] + using h } + +open complex + +lemma cosh_dist' (z w : ℍ) : + real.cosh (dist z w) = ((z.re - w.re) ^ 2 + z.im ^ 2 + w.im ^ 2) / (2 * z.im * w.im) := +have H : 0 < 2 * z.im * w.im, from mul_pos (mul_pos two_pos z.im_pos) w.im_pos, +by { field_simp [cosh_dist, complex.dist_eq, complex.sq_abs, norm_sq_apply, H, H.ne'], ring } + +/-- Euclidean center of the circle with center `z` and radius `r` in the hyperbolic metric. -/ +def center (z : ℍ) (r : ℝ) : ℍ := ⟨⟨z.re, z.im * cosh r⟩, mul_pos z.im_pos (cosh_pos _)⟩ + +@[simp] lemma center_re (z r) : (center z r).re = z.re := rfl +@[simp] lemma center_im (z r) : (center z r).im = z.im * cosh r := rfl + +@[simp] lemma center_zero (z : ℍ) : center z 0 = z := +subtype.ext $ ext rfl $ by rw [coe_im, coe_im, center_im, real.cosh_zero, mul_one] + +lemma dist_coe_center_sq (z w : ℍ) (r : ℝ) : + dist (z : ℂ) (w.center r) ^ 2 = + 2 * z.im * w.im * (cosh (dist z w) - cosh r) + (w.im * sinh r) ^ 2 := +begin + have H : 2 * z.im * w.im ≠ 0, by apply_rules [mul_ne_zero, two_ne_zero, im_ne_zero], + simp only [complex.dist_eq, complex.sq_abs, norm_sq_apply, coe_re, coe_im, center_re, center_im, + cosh_dist', mul_div_cancel' _ H, sub_sq z.im, mul_pow, real.cosh_sq, sub_re, sub_im, mul_sub, + ← sq], + ring +end + +lemma dist_coe_center (z w : ℍ) (r : ℝ) : + dist (z : ℂ) (w.center r) = + sqrt (2 * z.im * w.im * (cosh (dist z w) - cosh r) + (w.im * sinh r) ^ 2) := +by rw [← sqrt_sq dist_nonneg, dist_coe_center_sq] + +lemma cmp_dist_eq_cmp_dist_coe_center (z w : ℍ) (r : ℝ) : + cmp (dist z w) r = cmp (dist (z : ℂ) (w.center r)) (w.im * sinh r) := +begin + letI := metric_space_aux, + cases lt_or_le r 0 with hr₀ hr₀, + { transitivity ordering.gt, + exacts [(hr₀.trans_le dist_nonneg).cmp_eq_gt, + ((mul_neg_of_pos_of_neg w.im_pos (sinh_neg_iff.2 hr₀)).trans_le + dist_nonneg).cmp_eq_gt.symm] }, + have hr₀' : 0 ≤ w.im * sinh r, from mul_nonneg w.im_pos.le (sinh_nonneg_iff.2 hr₀), + have hzw₀ : 0 < 2 * z.im * w.im, from mul_pos (mul_pos two_pos z.im_pos) w.im_pos, + simp only [← cosh_strict_mono_on.cmp_map_eq dist_nonneg hr₀, + ← (@strict_mono_on_pow ℝ _ _ two_pos).cmp_map_eq dist_nonneg hr₀', dist_coe_center_sq], + rw [← cmp_mul_pos_left hzw₀, ← cmp_sub_zero, ← mul_sub, ← cmp_add_right, zero_add], +end + +lemma dist_eq_iff_dist_coe_center_eq : dist z w = r ↔ dist (z : ℂ) (w.center r) = w.im * sinh r := +eq_iff_eq_of_cmp_eq_cmp (cmp_dist_eq_cmp_dist_coe_center z w r) + +@[simp] lemma dist_self_center (z : ℍ) (r : ℝ) : dist (z : ℂ) (z.center r) = z.im * (cosh r - 1) := +begin + rw [dist_of_re_eq (z.center_re r).symm, dist_comm, real.dist_eq, mul_sub, mul_one], + exact abs_of_nonneg (sub_nonneg.2 $ le_mul_of_one_le_right z.im_pos.le (one_le_cosh _)) +end + +@[simp] lemma dist_center_dist (z w : ℍ) : + dist (z : ℂ) (w.center (dist z w)) = w.im * sinh (dist z w) := +dist_eq_iff_dist_coe_center_eq.1 rfl + +lemma dist_lt_iff_dist_coe_center_lt : + dist z w < r ↔ dist (z : ℂ) (w.center r) < w.im * sinh r := +lt_iff_lt_of_cmp_eq_cmp (cmp_dist_eq_cmp_dist_coe_center z w r) + +lemma lt_dist_iff_lt_dist_coe_center : + r < dist z w ↔ w.im * sinh r < dist (z : ℂ) (w.center r) := +lt_iff_lt_of_cmp_eq_cmp (cmp_eq_cmp_symm.1 $ cmp_dist_eq_cmp_dist_coe_center z w r) + +lemma dist_le_iff_dist_coe_center_le : + dist z w ≤ r ↔ dist (z : ℂ) (w.center r) ≤ w.im * sinh r := +le_iff_le_of_cmp_eq_cmp (cmp_dist_eq_cmp_dist_coe_center z w r) + +lemma le_dist_iff_le_dist_coe_center : + r < dist z w ↔ w.im * sinh r < dist (z : ℂ) (w.center r) := +lt_iff_lt_of_cmp_eq_cmp (cmp_eq_cmp_symm.1 $ cmp_dist_eq_cmp_dist_coe_center z w r) + +/-- For two points on the same vertical line, the distance is equal to the distance between the +logarithms of their imaginary parts. -/ +lemma dist_of_re_eq (h : z.re = w.re) : dist z w = dist (log z.im) (log w.im) := +begin + have h₀ : 0 < z.im / w.im, from div_pos z.im_pos w.im_pos, + rw [dist_eq_iff_dist_coe_center_eq, real.dist_eq, ← abs_sinh, ← log_div z.im_ne_zero w.im_ne_zero, + sinh_log h₀, dist_of_re_eq, coe_im, coe_im, center_im, cosh_abs, cosh_log h₀, inv_div]; + [skip, exact h], + nth_rewrite 3 [← abs_of_pos w.im_pos], + simp only [← _root_.abs_mul, coe_im, real.dist_eq], + congr' 1, + field_simp [z.im_pos, w.im_pos, z.im_ne_zero, w.im_ne_zero], + ring +end + +/-- Hyperbolic distance between two points is greater than or equal to the distance between the +logarithms of their imaginary parts. -/ +lemma dist_log_im_le (z w : ℍ) : dist (log z.im) (log w.im) ≤ dist z w := +calc dist (log z.im) (log w.im) = @dist ℍ _ ⟨⟨0, z.im⟩, z.im_pos⟩ ⟨⟨0, w.im⟩, w.im_pos⟩ : + eq.symm $ @dist_of_re_eq ⟨⟨0, z.im⟩, z.im_pos⟩ ⟨⟨0, w.im⟩, w.im_pos⟩ rfl +... ≤ dist z w : + mul_le_mul_of_nonneg_left (arsinh_le_arsinh.2 $ div_le_div_of_le + (mul_nonneg zero_le_two (sqrt_nonneg _)) $ + by simpa [sqrt_sq_eq_abs] using complex.abs_im_le_abs (z - w)) zero_le_two + +lemma im_le_im_mul_exp_dist (z w : ℍ) : z.im ≤ w.im * exp (dist z w) := +begin + rw [← div_le_iff' w.im_pos, ← exp_log z.im_pos, ← exp_log w.im_pos, ← real.exp_sub, exp_le_exp], + exact (le_abs_self _).trans (dist_log_im_le z w) +end + +lemma im_div_exp_dist_le (z w : ℍ) : z.im / exp (dist z w) ≤ w.im := +(div_le_iff (exp_pos _)).2 (im_le_im_mul_exp_dist z w) + +/-- An upper estimate on the complex distance between two points in terms of the hyperbolic distance +and the imaginary part of one of the points. -/ +lemma dist_coe_le (z w : ℍ) : dist (z : ℂ) w ≤ w.im * (exp (dist z w) - 1) := +calc dist (z : ℂ) w ≤ dist (z : ℂ) (w.center (dist z w)) + dist (w : ℂ) (w.center (dist z w)) : + dist_triangle_right _ _ _ +... = w.im * (exp (dist z w) - 1) : + by rw [dist_center_dist, dist_self_center, ← mul_add, ← add_sub_assoc, real.sinh_add_cosh] + +/-- An upper estimate on the complex distance between two points in terms of the hyperbolic distance +and the imaginary part of one of the points. -/ +lemma le_dist_coe (z w : ℍ) : w.im * (1 - exp (-dist z w)) ≤ dist (z : ℂ) w := +calc w.im * (1 - exp (-dist z w)) + = dist (z : ℂ) (w.center (dist z w)) - dist (w : ℂ) (w.center (dist z w)) : + by { rw [dist_center_dist, dist_self_center, ← real.cosh_sub_sinh], ring } +... ≤ dist (z : ℂ) w : sub_le_iff_le_add.2 $ dist_triangle _ _ _ + +/-- The hyperbolic metric on the upper half plane. We ensure that the projection to +`topological_space` is definitionally equal to the subtype topology. -/ +instance : metric_space ℍ := metric_space_aux.replace_topology $ +begin + refine le_antisymm (continuous_id_iff_le.1 _) _, + { refine (@continuous_iff_continuous_dist _ _ metric_space_aux.to_pseudo_metric_space _ _).2 _, + have : ∀ (x : ℍ × ℍ), 2 * real.sqrt (x.1.im * x.2.im) ≠ 0, + from λ x, mul_ne_zero two_ne_zero (real.sqrt_pos.2 $ mul_pos x.1.im_pos x.2.im_pos).ne', + -- `continuity` fails to apply `continuous.div` + apply_rules [continuous.div, continuous.mul, continuous_const, continuous.arsinh, + continuous.dist, continuous_coe.comp, continuous_fst, continuous_snd, + real.continuous_sqrt.comp, continuous_im.comp] }, + { letI : metric_space ℍ := metric_space_aux, + refine le_of_nhds_le_nhds (λ z, _), + rw [nhds_induced], + refine (nhds_basis_ball.le_basis_iff (nhds_basis_ball.comap _)).2 (λ R hR, _), + have h₁ : 1 < R / im z + 1, from lt_add_of_pos_left _ (div_pos hR z.im_pos), + have h₀ : 0 < R / im z + 1, from one_pos.trans h₁, + refine ⟨log (R / im z + 1), real.log_pos h₁, _⟩, + refine λ w hw, (dist_coe_le w z).trans_lt _, + rwa [← lt_div_iff' z.im_pos, sub_lt_iff_lt_add, ← real.lt_log_iff_exp_lt h₀] } +end + +lemma im_pos_of_dist_center_le {z : ℍ} {r : ℝ} {w : ℂ} (h : dist w (center z r) ≤ z.im * sinh r) : + 0 < w.im := +calc 0 < z.im * (cosh r - sinh r) : mul_pos z.im_pos (sub_pos.2 $ sinh_lt_cosh _) +... = (z.center r).im - z.im * sinh r : mul_sub _ _ _ +... ≤ (z.center r).im - dist (z.center r : ℂ) w : sub_le_sub_left (by rwa [dist_comm]) _ +... ≤ w.im : sub_le_comm.1 $ (le_abs_self _).trans (abs_im_le_abs $ z.center r - w) + +lemma image_coe_closed_ball (z : ℍ) (r : ℝ) : + (coe : ℍ → ℂ) '' closed_ball z r = closed_ball (z.center r) (z.im * sinh r) := +begin + ext w, split, + { rintro ⟨w, hw, rfl⟩, + exact dist_le_iff_dist_coe_center_le.1 hw }, + { intro hw, + lift w to ℍ using im_pos_of_dist_center_le hw, + exact mem_image_of_mem _ (dist_le_iff_dist_coe_center_le.2 hw) }, +end + +lemma image_coe_ball (z : ℍ) (r : ℝ) : + (coe : ℍ → ℂ) '' ball z r = ball (z.center r) (z.im * sinh r) := +begin + ext w, split, + { rintro ⟨w, hw, rfl⟩, + exact dist_lt_iff_dist_coe_center_lt.1 hw }, + { intro hw, + lift w to ℍ using im_pos_of_dist_center_le (ball_subset_closed_ball hw), + exact mem_image_of_mem _ (dist_lt_iff_dist_coe_center_lt.2 hw) }, +end + +lemma image_coe_sphere (z : ℍ) (r : ℝ) : + (coe : ℍ → ℂ) '' sphere z r = sphere (z.center r) (z.im * sinh r) := +begin + ext w, split, + { rintro ⟨w, hw, rfl⟩, + exact dist_eq_iff_dist_coe_center_eq.1 hw }, + { intro hw, + lift w to ℍ using im_pos_of_dist_center_le (sphere_subset_closed_ball hw), + exact mem_image_of_mem _ (dist_eq_iff_dist_coe_center_eq.2 hw) }, +end + +instance : proper_space ℍ := +begin + refine ⟨λ z r, _⟩, + rw [← inducing_coe.is_compact_iff, image_coe_closed_ball], + apply is_compact_closed_ball +end + +lemma isometry_vertical_line (a : ℝ) : isometry (λ y, mk ⟨a, exp y⟩ (exp_pos y)) := +begin + refine isometry.of_dist_eq (λ y₁ y₂, _), + rw [dist_of_re_eq], + exacts [congr_arg2 _ (log_exp _) (log_exp _), rfl] +end + +lemma isometry_real_vadd (a : ℝ) : isometry ((+ᵥ) a : ℍ → ℍ) := +isometry.of_dist_eq $ λ y₁ y₂, by simp only [dist_eq, coe_vadd, vadd_im, dist_add_left] + +lemma isometry_pos_mul (a : {x : ℝ // 0 < x}) : isometry ((•) a : ℍ → ℍ) := +begin + refine isometry.of_dist_eq (λ y₁ y₂, _), + simp only [dist_eq, coe_pos_real_smul, pos_real_im], congr' 2, + rw [dist_smul₀, mul_mul_mul_comm, real.sqrt_mul (mul_self_nonneg _), real.sqrt_mul_self_eq_abs, + real.norm_eq_abs, mul_left_comm], + exact mul_div_mul_left _ _ (mt _root_.abs_eq_zero.1 a.2.ne') +end + +/-- `SL(2, ℝ)` acts on the upper half plane as an isometry.-/ +instance : has_isometric_smul SL(2, ℝ) ℍ := +⟨λ g, +begin + have h₀ : isometry (λ z, modular_group.S • z : ℍ → ℍ) := isometry.of_dist_eq (λ y₁ y₂, by + { have h₁ : 0 ≤ im y₁ * im y₂ := mul_nonneg y₁.property.le y₂.property.le, + have h₂ : complex.abs (y₁ * y₂) ≠ 0, { simp [y₁.ne_zero, y₂.ne_zero], }, + simp only [dist_eq, modular_S_smul, inv_neg, neg_div, div_mul_div_comm, coe_mk, mk_im, div_one, + complex.inv_im, complex.neg_im, coe_im, neg_neg, complex.norm_sq_neg, mul_eq_mul_left_iff, + real.arsinh_inj, bit0_eq_zero, one_ne_zero, or_false, dist_neg_neg, mul_neg, neg_mul, + dist_inv_inv₀ y₁.ne_zero y₂.ne_zero, ← absolute_value.map_mul, + ← complex.norm_sq_mul, real.sqrt_div h₁, ← complex.abs_apply, mul_div (2 : ℝ), + div_div_div_comm, div_self h₂, complex.norm_eq_abs], }), + by_cases hc : g 1 0 = 0, + { obtain ⟨u, v, h⟩ := exists_SL2_smul_eq_of_apply_zero_one_eq_zero g hc, + rw h, + exact (isometry_real_vadd v).comp (isometry_pos_mul u), }, + { obtain ⟨u, v, w, h⟩ := exists_SL2_smul_eq_of_apply_zero_one_ne_zero g hc, + rw h, + exact (isometry_real_vadd w).comp (h₀.comp $ (isometry_real_vadd v).comp $ isometry_pos_mul u) } +end⟩ + +end upper_half_plane diff --git a/src/analysis/complex/upper_half_plane/topology.lean b/src/analysis/complex/upper_half_plane/topology.lean new file mode 100644 index 0000000000000..63eeb52de6c0e --- /dev/null +++ b/src/analysis/complex/upper_half_plane/topology.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2022 Yury G. Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury G. Kudryashov +-/ +import analysis.complex.upper_half_plane.basic +import analysis.convex.contractible +import analysis.convex.normed +import analysis.convex.complex +import analysis.complex.re_im_topology +import topology.homotopy.contractible + +/-! +# Topology on the upper half plane + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we introduce a `topological_space` structure on the upper half plane and provide +various instances. +-/ + +noncomputable theory +open set filter function topological_space complex +open_locale filter topology upper_half_plane + +namespace upper_half_plane + +instance : topological_space ℍ := subtype.topological_space + +lemma open_embedding_coe : open_embedding (coe : ℍ → ℂ) := +is_open.open_embedding_subtype_coe $ is_open_lt continuous_const complex.continuous_im + +lemma embedding_coe : embedding (coe : ℍ → ℂ) := embedding_subtype_coe +lemma continuous_coe : continuous (coe : ℍ → ℂ) := embedding_coe.continuous + +lemma continuous_re : continuous re := complex.continuous_re.comp continuous_coe +lemma continuous_im : continuous im := complex.continuous_im.comp continuous_coe + +instance : topological_space.second_countable_topology ℍ := +topological_space.subtype.second_countable_topology _ _ + +instance : t3_space ℍ := subtype.t3_space +instance : normal_space ℍ := normal_space_of_t3_second_countable ℍ + +instance : contractible_space ℍ := +(convex_halfspace_im_gt 0).contractible_space ⟨I, one_pos.trans_eq I_im.symm⟩ + +instance : loc_path_connected_space ℍ := +loc_path_connected_of_is_open $ is_open_lt continuous_const complex.continuous_im + +instance : noncompact_space ℍ := +begin + refine ⟨λ h, _⟩, + have : is_compact (complex.im ⁻¹' Ioi 0), from is_compact_iff_is_compact_univ.2 h, + replace := this.is_closed.closure_eq, + rw [closure_preimage_im, closure_Ioi, set.ext_iff] at this, + exact absurd ((this 0).1 left_mem_Ici) (lt_irrefl _) +end + +instance : locally_compact_space ℍ := open_embedding_coe.locally_compact_space + +end upper_half_plane diff --git a/src/analysis/constant_speed.lean b/src/analysis/constant_speed.lean new file mode 100644 index 0000000000000..aa5b84190414f --- /dev/null +++ b/src/analysis/constant_speed.lean @@ -0,0 +1,291 @@ +/- +Copyright (c) 2023 Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémi Bottinelli +-/ +import data.set.function +import analysis.bounded_variation +import tactic.swap_var +/-! +# Constant speed + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the notion of constant (and unit) speed for a function `f : ℝ → E` with +pseudo-emetric structure on `E` with respect to a set `s : set ℝ` and "speed" `l : ℝ≥0`, and shows +that if `f` has locally bounded variation on `s`, it can be obtained (up to distance zero, on `s`), +as a composite `φ ∘ (variation_on_from_to f s a)`, where `φ` has unit speed and `a ∈ s`. + +## Main definitions + +* `has_constant_speed_on_with f s l`, stating that the speed of `f` on `s` is `l`. +* `has_unit_speed_on f s`, stating that the speed of `f` on `s` is `1`. +* `natural_parameterization f s a : ℝ → E`, the unit speed reparameterization of `f` on `s` relative + to `a`. + +## Main statements + +* `unique_unit_speed_on_Icc_zero` proves that if `f` and `f ∘ φ` are both naturally + parameterized on closed intervals starting at `0`, then `φ` must be the identity on + those intervals. +* `edist_natural_parameterization_eq_zero` proves that if `f` has locally bounded variation, then + precomposing `natural_parameterization f s a` with `variation_on_from_to f s a` yields a function + at distance zero from `f` on `s`. +* `has_unit_speed_natural_parameterization` proves that if `f` has locally bounded + variation, then `natural_parameterization f s a` has unit speed on `s`. + +## Tags + +arc-length, parameterization +-/ + +open_locale big_operators nnreal ennreal +open set measure_theory classical + +variables {α : Type*} [linear_order α] {E : Type*} [pseudo_emetric_space E] +variables (f : ℝ → E) (s : set ℝ) (l : ℝ≥0) + +/-- +`f` has constant speed `l` on `s` if the variation of `f` on `s ∩ Icc x y` is equal to +`l * (y - x)` for any `x y` in `s`. +-/ +def has_constant_speed_on_with := +∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), evariation_on f (s ∩ Icc x y) = ennreal.of_real (l * (y - x)) + +variables {f} {s} {l} + +lemma has_constant_speed_on_with.has_locally_bounded_variation_on + (h : has_constant_speed_on_with f s l) : has_locally_bounded_variation_on f s := λ x y hx hy, +by simp only [has_bounded_variation_on, h hx hy, ne.def, ennreal.of_real_ne_top, not_false_iff] + +lemma has_constant_speed_on_with_of_subsingleton + (f : ℝ → E) {s : set ℝ} (hs : s.subsingleton) (l : ℝ≥0) : has_constant_speed_on_with f s l := +begin + rintro x hx y hy, cases hs hx hy, + rw evariation_on.subsingleton f (λ y hy z hz, hs hy.1 hz.1 : (s ∩ Icc x x).subsingleton), + simp only [sub_self, mul_zero, ennreal.of_real_zero], +end + +lemma has_constant_speed_on_with_iff_ordered : + has_constant_speed_on_with f s l ↔ + ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), (x ≤ y) → + evariation_on f (s ∩ Icc x y) = ennreal.of_real (l * (y - x)) := +begin + refine ⟨λ h x xs y ys xy, h xs ys, λ h x xs y ys, _⟩, + rcases le_total x y with xy|yx, + { exact h xs ys xy, }, + { rw [evariation_on.subsingleton, ennreal.of_real_of_nonpos], + { exact mul_nonpos_of_nonneg_of_nonpos l.prop (sub_nonpos_of_le yx), }, + { rintro z ⟨zs, xz, zy⟩ w ⟨ws, xw, wy⟩, + cases le_antisymm (zy.trans yx) xz, + cases le_antisymm (wy.trans yx) xw, + refl, }, }, +end + +lemma has_constant_speed_on_with_iff_variation_on_from_to_eq : + has_constant_speed_on_with f s l ↔ (has_locally_bounded_variation_on f s ∧ + ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), variation_on_from_to f s x y = l * (y - x)) := +begin + split, + { rintro h, refine ⟨h.has_locally_bounded_variation_on, λ x xs y ys, _⟩, + rw has_constant_speed_on_with_iff_ordered at h, + rcases le_total x y with xy|yx, + { rw [variation_on_from_to.eq_of_le f s xy, h xs ys xy, + ennreal.to_real_of_real (mul_nonneg l.prop (sub_nonneg.mpr xy))], }, + { rw [variation_on_from_to.eq_of_ge f s yx, h ys xs yx, + ennreal.to_real_of_real (mul_nonneg l.prop (sub_nonneg.mpr yx)), + mul_comm ↑l, mul_comm ↑l, ←neg_mul, neg_sub], }, }, + { rw has_constant_speed_on_with_iff_ordered, + rintro h x xs y ys xy, + rw [←h.2 xs ys, variation_on_from_to.eq_of_le f s xy, + ennreal.of_real_to_real (h.1 x y xs ys)], }, +end + +lemma has_constant_speed_on_with.union {t : set ℝ} + (hfs : has_constant_speed_on_with f s l) (hft : has_constant_speed_on_with f t l) + {x : ℝ} (hs : is_greatest s x) (ht : is_least t x) : has_constant_speed_on_with f (s ∪ t) l := +begin + rw has_constant_speed_on_with_iff_ordered at hfs hft ⊢, + rintro z (zs|zt) y (ys|yt) zy, + { have : (s ∪ t) ∩ Icc z y = (s ∩ Icc z y), by + { ext w, split, + { rintro ⟨(ws|wt), zw, wy⟩, + { exact ⟨ws, zw, wy⟩, }, + { exact ⟨(le_antisymm (wy.trans (hs.2 ys)) (ht.2 wt)).symm ▸ hs.1, zw, wy⟩, }, }, + { rintro ⟨ws, zwy⟩, exact ⟨or.inl ws, zwy⟩, }, }, + rw [this, hfs zs ys zy], }, + { have : (s ∪ t) ∩ Icc z y = (s ∩ Icc z x) ∪ (t ∩ Icc x y), by + { ext w, split, + { rintro ⟨(ws|wt), zw, wy⟩, + exacts [or.inl ⟨ws, zw, hs.2 ws⟩, or.inr ⟨wt, ht.2 wt, wy⟩], }, + { rintro (⟨ws, zw, wx⟩|⟨wt, xw, wy⟩), + exacts [⟨or.inl ws, zw, wx.trans (ht.2 yt)⟩, ⟨or.inr wt, (hs.2 zs).trans xw, wy⟩], }, }, + rw [this, + @evariation_on.union _ _ _ _ f _ _ x, + hfs zs hs.1 (hs.2 zs), hft ht.1 yt (ht.2 yt), + ←ennreal.of_real_add (mul_nonneg l.prop (sub_nonneg.mpr (hs.2 zs))) + (mul_nonneg l.prop (sub_nonneg.mpr (ht.2 yt))) ], + ring_nf, + exacts [⟨⟨hs.1, hs.2 zs, le_rfl⟩, λ w ⟨ws, zw, wx⟩, wx⟩, + ⟨⟨ht.1, le_rfl, ht.2 yt⟩, λ w ⟨wt, xw, wy⟩, xw⟩], }, + { cases le_antisymm zy ((hs.2 ys).trans (ht.2 zt)), + simp only [Icc_self, sub_self, mul_zero, ennreal.of_real_zero], + exact evariation_on.subsingleton _ (λ _ ⟨_, uz⟩ _ ⟨_, vz⟩, uz.trans vz.symm), }, + { have : (s ∪ t) ∩ Icc z y = (t ∩ Icc z y), by + { ext w, split, + { rintro ⟨(ws|wt), zw, wy⟩, + { exact ⟨(le_antisymm ((ht.2 zt).trans zw) (hs.2 ws)) ▸ ht.1, zw, wy⟩, }, + { exact ⟨wt, zw, wy⟩, }, }, + { rintro ⟨wt, zwy⟩, exact ⟨or.inr wt, zwy⟩, }, }, + rw [this, hft zt yt zy], } +end + +lemma has_constant_speed_on_with.Icc_Icc {x y z : ℝ} + (hfs : has_constant_speed_on_with f (Icc x y) l) + (hft : has_constant_speed_on_with f (Icc y z) l) : has_constant_speed_on_with f (Icc x z) l := +begin + rcases le_total x y with xy|yx, + rcases le_total y z with yz|zy, + { rw ←set.Icc_union_Icc_eq_Icc xy yz, + exact hfs.union hft (is_greatest_Icc xy) (is_least_Icc yz), }, + { rintro u ⟨xu, uz⟩ v ⟨xv, vz⟩, + rw [Icc_inter_Icc, sup_of_le_right xu, inf_of_le_right vz, + ←hfs ⟨xu, uz.trans zy⟩ ⟨xv, vz.trans zy⟩, + Icc_inter_Icc, sup_of_le_right xu, inf_of_le_right (vz.trans zy)], }, + { rintro u ⟨xu, uz⟩ v ⟨xv, vz⟩, + rw [Icc_inter_Icc, sup_of_le_right xu, inf_of_le_right vz, + ←hft ⟨yx.trans xu, uz⟩ ⟨yx.trans xv, vz⟩, + Icc_inter_Icc, sup_of_le_right (yx.trans xu), inf_of_le_right (vz)], }, +end + +lemma has_constant_speed_on_with_zero_iff : + has_constant_speed_on_with f s 0 ↔ ∀ x y ∈ s, edist (f x) (f y) = 0 := +begin + dsimp [has_constant_speed_on_with], + simp only [zero_mul, ennreal.of_real_zero, ←evariation_on.eq_zero_iff], + split, + { by_contra', + obtain ⟨h, hfs⟩ := this, + simp_rw evariation_on.eq_zero_iff at hfs h, + push_neg at hfs, + obtain ⟨x, xs, y, ys, hxy⟩ := hfs, + rcases le_total x y with xy|yx, + { exact hxy (h xs ys x ⟨xs, le_rfl, xy⟩ y ⟨ys, xy, le_rfl⟩), }, + { rw edist_comm at hxy, + exact hxy (h ys xs y ⟨ys, le_rfl, yx⟩ x ⟨xs, yx, le_rfl⟩), }, }, + { rintro h x xs y ys, + refine le_antisymm _ (zero_le'), + rw ←h, + exact evariation_on.mono f (inter_subset_left s (Icc x y)), }, +end + +lemma has_constant_speed_on_with.ratio {l' : ℝ≥0} (hl' : l' ≠ 0) {φ : ℝ → ℝ} + (φm : monotone_on φ s) + (hfφ : has_constant_speed_on_with (f ∘ φ) s l) + (hf : has_constant_speed_on_with f (φ '' s) l') + ⦃x : ℝ⦄ (xs : x ∈ s) : eq_on φ (λ y, (l / l') * (y - x) + (φ x)) s := +begin + rintro y ys, + rw [←sub_eq_iff_eq_add, mul_comm, ←mul_div_assoc, + eq_div_iff (nnreal.coe_ne_zero.mpr hl')], + rw has_constant_speed_on_with_iff_variation_on_from_to_eq at hf, + rw has_constant_speed_on_with_iff_variation_on_from_to_eq at hfφ, + symmetry, + calc (y - x) * l + = l * (y - x) : by rw mul_comm + ... = variation_on_from_to (f ∘ φ) s x y : (hfφ.2 xs ys).symm + ... = variation_on_from_to f (φ '' s) (φ x) (φ y) : + variation_on_from_to.comp_eq_of_monotone_on f φ φm xs ys + ... = l' * (φ y - φ x) : hf.2 ⟨x,xs,rfl⟩ ⟨y,ys,rfl⟩ + ... = (φ y - φ x) * l' : by rw mul_comm, +end + +/-- `f` has unit speed on `s` if it is linearly parameterized by `l = 1` on `s`. -/ +def has_unit_speed_on (f : ℝ → E) (s : set ℝ) := has_constant_speed_on_with f s 1 + +lemma has_unit_speed_on.union {t : set ℝ} {x : ℝ} + (hfs : has_unit_speed_on f s) (hft : has_unit_speed_on f t) + (hs : is_greatest s x) (ht : is_least t x) : has_unit_speed_on f (s ∪ t) := +has_constant_speed_on_with.union hfs hft hs ht + +lemma has_unit_speed_on.Icc_Icc {x y z : ℝ} + (hfs : has_unit_speed_on f (Icc x y)) (hft : has_unit_speed_on f (Icc y z)) : + has_unit_speed_on f (Icc x z) := +has_constant_speed_on_with.Icc_Icc hfs hft + +/-- +If both `f` and `f ∘ φ` have unit speed (on `t` and `s` respectively) and `φ` +monotonically maps `s` onto `t`, then `φ` is just a translation (on `s`). +-/ +lemma unique_unit_speed {φ : ℝ → ℝ} (φm : monotone_on φ s) + (hfφ : has_unit_speed_on (f ∘ φ) s) (hf : has_unit_speed_on f (φ '' s)) + ⦃x : ℝ⦄ (xs : x ∈ s) : eq_on φ (λ y, (y - x) + (φ x)) s := +begin + dsimp only [has_unit_speed_on] at hf hfφ, + convert has_constant_speed_on_with.ratio one_ne_zero φm hfφ hf xs, + simp only [nonneg.coe_one, div_self, ne.def, one_ne_zero, not_false_iff, one_mul], +end + +/-- +If both `f` and `f ∘ φ` have unit speed (on `Icc 0 t` and `Icc 0 s` respectively) +and `φ` monotonically maps `Icc 0 s` onto `Icc 0 t`, then `φ` is the identity on `Icc 0 s` +-/ +lemma unique_unit_speed_on_Icc_zero {s t : ℝ} (hs : 0 ≤ s) (ht : 0 ≤ t) + {φ : ℝ → ℝ} (φm : monotone_on φ $ Icc 0 s) (φst : φ '' (Icc 0 s) = (Icc 0 t)) + (hfφ : has_unit_speed_on (f ∘ φ) (Icc 0 s)) + (hf : has_unit_speed_on f (Icc 0 t)) : eq_on φ id (Icc 0 s) := +begin + rw ←φst at hf, + convert unique_unit_speed φm hfφ hf ⟨le_rfl, hs⟩, + have : φ 0 = 0, by + { obtain ⟨x,xs,hx⟩ := φst.rec_on (surj_on_image φ (Icc 0 s)) ⟨le_rfl, ht⟩, + exact le_antisymm (hx.rec_on (φm ⟨le_rfl,hs⟩ xs xs.1)) + (φst.rec_on (maps_to_image φ (Icc 0 s)) (⟨le_rfl, hs⟩)).1, }, + simp only [tsub_zero, this, add_zero], + refl, +end + +/-- +The natural parameterization of `f` on `s`, which, if `f` has locally bounded variation on `s`, +* has unit speed on `s` + (by `natural_parameterization_has_unit_speed`). +* composed with `variation_on_from_to f s a`, is at distance zero from `f` + (by `natural_parameterization_edist_zero`). +-/ +noncomputable def natural_parameterization (f : α → E) (s : set α) (a : α) : ℝ → E := +f ∘ (@function.inv_fun_on _ _ ⟨a⟩ (variation_on_from_to f s a) s) + +lemma edist_natural_parameterization_eq_zero {f : α → E} {s : set α} + (hf : has_locally_bounded_variation_on f s) {a : α} (as : a ∈ s) {b : α} (bs : b ∈ s) : + edist (natural_parameterization f s a (variation_on_from_to f s a b)) (f b) = 0 := +begin + dsimp only [natural_parameterization], + haveI : nonempty α := ⟨a⟩, + let c := function.inv_fun_on (variation_on_from_to f s a) s (variation_on_from_to f s a b), + obtain ⟨cs, hc⟩ := @function.inv_fun_on_pos _ _ _ s + (variation_on_from_to f s a) (variation_on_from_to f s a b) ⟨b, bs, rfl⟩, + rw [variation_on_from_to.eq_left_iff hf as cs bs] at hc, + apply variation_on_from_to.edist_zero_of_eq_zero hf cs bs hc, +end + +lemma has_unit_speed_natural_parameterization (f : α → E) {s : set α} + (hf : has_locally_bounded_variation_on f s) {a : α} (as : a ∈ s) : + has_unit_speed_on (natural_parameterization f s a) (variation_on_from_to f s a '' s) := +begin + dsimp only [has_unit_speed_on], + rw has_constant_speed_on_with_iff_ordered, + rintro _ ⟨b, bs, rfl⟩ _ ⟨c, cs, rfl⟩ h, + rcases le_total c b with cb|bc, + { rw [nnreal.coe_one, one_mul, le_antisymm h (variation_on_from_to.monotone_on hf as cs bs cb), + sub_self, ennreal.of_real_zero, Icc_self, evariation_on.subsingleton], + exact λ x hx y hy, hx.2.trans hy.2.symm, }, + { rw [nnreal.coe_one, one_mul, sub_eq_add_neg, variation_on_from_to.eq_neg_swap, neg_neg, + add_comm, variation_on_from_to.add hf bs as cs, ←variation_on_from_to.eq_neg_swap f], + rw [←evariation_on.comp_inter_Icc_eq_of_monotone_on (natural_parameterization f s a) _ + (variation_on_from_to.monotone_on hf as) bs cs], + rw [@evariation_on.eq_of_edist_zero_on _ _ _ _ _ f], + { rw [variation_on_from_to.eq_of_le _ _ bc, ennreal.of_real_to_real (hf b c bs cs)], }, + { rintro x ⟨xs, bx, xc⟩, + exact edist_natural_parameterization_eq_zero hf as xs, }, }, +end diff --git a/src/analysis/convex/basic.lean b/src/analysis/convex/basic.lean index 3d5eda6686d7c..d1520b6a6ab74 100644 --- a/src/analysis/convex/basic.lean +++ b/src/analysis/convex/basic.lean @@ -3,18 +3,17 @@ Copyright (c) 2019 Alexander Bentkamp. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Alexander Bentkamp, Yury Kudriashov, Yaël Dillies -/ -import algebra.order.invertible import algebra.order.module -import linear_algebra.affine_space.midpoint +import analysis.convex.star import linear_algebra.affine_space.affine_subspace -import linear_algebra.ray /-! # Convex sets and functions in vector spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In a 𝕜-vector space, we define the following objects and properties. -* `segment 𝕜 x y`: Closed segment joining `x` and `y`. -* `open_segment 𝕜 x y`: Open segment joining `x` and `y`. * `convex 𝕜 s`: A set `s` is convex if for any two points `x y ∈ s` it includes `segment 𝕜 x y`. * `std_simplex 𝕜 ι`: The standard simplex in `ι → 𝕜` (currently requires `fintype ι`). It is the intersection of the positive quadrant with the hyperplane `s.sum = 1`. @@ -22,494 +21,15 @@ In a 𝕜-vector space, we define the following objects and properties. We also provide various equivalent versions of the definitions above, prove that some specific sets are convex. -## Notations - -We provide the following notation: -* `[x -[𝕜] y] = segment 𝕜 x y` in locale `convex` - ## TODO Generalize all this file to affine spaces. - -Should we rename `segment` and `open_segment` to `convex.Icc` and `convex.Ioo`? Should we also -define `clopen_segment`/`convex.Ico`/`convex.Ioc`? -/ variables {𝕜 E F β : Type*} open linear_map set -open_locale big_operators classical pointwise - -/-! ### Segment -/ - -section ordered_semiring -variables [ordered_semiring 𝕜] [add_comm_monoid E] - -section has_scalar -variables (𝕜) [has_scalar 𝕜 E] - -/-- Segments in a vector space. -/ -def segment (x y : E) : set E := -{z : E | ∃ (a b : 𝕜) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1), a • x + b • y = z} - -/-- Open segment in a vector space. Note that `open_segment 𝕜 x x = {x}` instead of being `∅` when -the base semiring has some element between `0` and `1`. -/ -def open_segment (x y : E) : set E := -{z : E | ∃ (a b : 𝕜) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1), a • x + b • y = z} - -localized "notation `[` x ` -[` 𝕜 `] ` y `]` := segment 𝕜 x y" in convex - -lemma segment_eq_image₂ (x y : E) : - [x -[𝕜] y] = (λ p : 𝕜 × 𝕜, p.1 • x + p.2 • y) '' {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 = 1} := -by simp only [segment, image, prod.exists, mem_set_of_eq, exists_prop, and_assoc] - -lemma open_segment_eq_image₂ (x y : E) : - open_segment 𝕜 x y = - (λ p : 𝕜 × 𝕜, p.1 • x + p.2 • y) '' {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 = 1} := -by simp only [open_segment, image, prod.exists, mem_set_of_eq, exists_prop, and_assoc] - -lemma segment_symm (x y : E) : [x -[𝕜] y] = [y -[𝕜] x] := -set.ext $ λ z, -⟨λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩, - λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩ - -lemma open_segment_symm (x y : E) : - open_segment 𝕜 x y = open_segment 𝕜 y x := -set.ext $ λ z, -⟨λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩, - λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩ - -lemma open_segment_subset_segment (x y : E) : - open_segment 𝕜 x y ⊆ [x -[𝕜] y] := -λ z ⟨a, b, ha, hb, hab, hz⟩, ⟨a, b, ha.le, hb.le, hab, hz⟩ - -lemma segment_subset_iff {x y : E} {s : set E} : - [x -[𝕜] y] ⊆ s ↔ ∀ a b : 𝕜, 0 ≤ a → 0 ≤ b → a + b = 1 → a • x + b • y ∈ s := -⟨λ H a b ha hb hab, H ⟨a, b, ha, hb, hab, rfl⟩, - λ H z ⟨a, b, ha, hb, hab, hz⟩, hz ▸ H a b ha hb hab⟩ - -lemma open_segment_subset_iff {x y : E} {s : set E} : - open_segment 𝕜 x y ⊆ s ↔ ∀ a b : 𝕜, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s := -⟨λ H a b ha hb hab, H ⟨a, b, ha, hb, hab, rfl⟩, - λ H z ⟨a, b, ha, hb, hab, hz⟩, hz ▸ H a b ha hb hab⟩ - -end has_scalar - -open_locale convex - -section mul_action_with_zero -variables (𝕜) [mul_action_with_zero 𝕜 E] - -lemma left_mem_segment (x y : E) : x ∈ [x -[𝕜] y] := -⟨1, 0, zero_le_one, le_refl 0, add_zero 1, by rw [zero_smul, one_smul, add_zero]⟩ - -lemma right_mem_segment (x y : E) : y ∈ [x -[𝕜] y] := -segment_symm 𝕜 y x ▸ left_mem_segment 𝕜 y x - -end mul_action_with_zero - -section module -variables (𝕜) [module 𝕜 E] {x y z : E} {s : set E} - -@[simp] lemma segment_same (x : E) : [x -[𝕜] x] = {x} := -set.ext $ λ z, ⟨λ ⟨a, b, ha, hb, hab, hz⟩, - by simpa only [(add_smul _ _ _).symm, mem_singleton_iff, hab, one_smul, eq_comm] using hz, - λ h, mem_singleton_iff.1 h ▸ left_mem_segment 𝕜 z z⟩ - -lemma insert_endpoints_open_segment (x y : E) : - insert x (insert y (open_segment 𝕜 x y)) = [x -[𝕜] y] := -begin - simp only [subset_antisymm_iff, insert_subset, left_mem_segment, right_mem_segment, - open_segment_subset_segment, true_and], - rintro z ⟨a, b, ha, hb, hab, rfl⟩, - refine hb.eq_or_gt.imp _ (λ hb', ha.eq_or_gt.imp _ _), - { rintro rfl, - rw add_zero at hab, - rw [hab, one_smul, zero_smul, add_zero] }, - { rintro rfl, - rw zero_add at hab, - rw [hab, one_smul, zero_smul, zero_add] }, - { exact λ ha', ⟨a, b, ha', hb', hab, rfl⟩ } -end - -variables {𝕜} - -lemma mem_open_segment_of_ne_left_right (hx : x ≠ z) (hy : y ≠ z) (hz : z ∈ [x -[𝕜] y]) : - z ∈ open_segment 𝕜 x y := -begin - rw [← insert_endpoints_open_segment] at hz, - exact ((hz.resolve_left hx.symm).resolve_left hy.symm) -end - -lemma open_segment_subset_iff_segment_subset (hx : x ∈ s) (hy : y ∈ s) : - open_segment 𝕜 x y ⊆ s ↔ [x -[𝕜] y] ⊆ s := -by simp only [← insert_endpoints_open_segment, insert_subset, *, true_and] - -end module -end ordered_semiring - -open_locale convex - -section ordered_ring -variables [ordered_ring 𝕜] - -section add_comm_group -variables (𝕜) [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] - -section densely_ordered -variables [nontrivial 𝕜] [densely_ordered 𝕜] - -@[simp] lemma open_segment_same (x : E) : - open_segment 𝕜 x x = {x} := -set.ext $ λ z, ⟨λ ⟨a, b, ha, hb, hab, hz⟩, - by simpa only [← add_smul, mem_singleton_iff, hab, one_smul, eq_comm] using hz, - λ (h : z = x), begin - obtain ⟨a, ha₀, ha₁⟩ := densely_ordered.dense (0 : 𝕜) 1 zero_lt_one, - refine ⟨a, 1 - a, ha₀, sub_pos_of_lt ha₁, add_sub_cancel'_right _ _, _⟩, - rw [←add_smul, add_sub_cancel'_right, one_smul, h], - end⟩ - -end densely_ordered - -lemma segment_eq_image (x y : E) : [x -[𝕜] y] = (λ θ : 𝕜, (1 - θ) • x + θ • y) '' Icc (0 : 𝕜) 1 := -set.ext $ λ z, - ⟨λ ⟨a, b, ha, hb, hab, hz⟩, - ⟨b, ⟨hb, hab ▸ le_add_of_nonneg_left ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩, - λ ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩, ⟨1-θ, θ, sub_nonneg.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩ - -lemma open_segment_eq_image (x y : E) : - open_segment 𝕜 x y = (λ (θ : 𝕜), (1 - θ) • x + θ • y) '' Ioo (0 : 𝕜) 1 := -set.ext $ λ z, - ⟨λ ⟨a, b, ha, hb, hab, hz⟩, - ⟨b, ⟨hb, hab ▸ lt_add_of_pos_left _ ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩, - λ ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩, ⟨1 - θ, θ, sub_pos.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩ - -lemma segment_eq_image' (x y : E) : - [x -[𝕜] y] = (λ (θ : 𝕜), x + θ • (y - x)) '' Icc (0 : 𝕜) 1 := -by { convert segment_eq_image 𝕜 x y, ext θ, simp only [smul_sub, sub_smul, one_smul], abel } - -lemma open_segment_eq_image' (x y : E) : - open_segment 𝕜 x y = (λ (θ : 𝕜), x + θ • (y - x)) '' Ioo (0 : 𝕜) 1 := -by { convert open_segment_eq_image 𝕜 x y, ext θ, simp only [smul_sub, sub_smul, one_smul], abel } - -lemma segment_eq_image_line_map (x y : E) : - [x -[𝕜] y] = affine_map.line_map x y '' Icc (0 : 𝕜) 1 := -by { convert segment_eq_image 𝕜 x y, ext, exact affine_map.line_map_apply_module _ _ _ } - -lemma open_segment_eq_image_line_map (x y : E) : - open_segment 𝕜 x y = affine_map.line_map x y '' Ioo (0 : 𝕜) 1 := -by { convert open_segment_eq_image 𝕜 x y, ext, exact affine_map.line_map_apply_module _ _ _ } - -lemma segment_image (f : E →ₗ[𝕜] F) (a b : E) : f '' [a -[𝕜] b] = [f a -[𝕜] f b] := -set.ext (λ x, by simp_rw [segment_eq_image, mem_image, exists_exists_and_eq_and, map_add, map_smul]) - -@[simp] lemma open_segment_image (f : E →ₗ[𝕜] F) (a b : E) : - f '' open_segment 𝕜 a b = open_segment 𝕜 (f a) (f b) := -set.ext (λ x, by simp_rw [open_segment_eq_image, mem_image, exists_exists_and_eq_and, map_add, - map_smul]) - -lemma mem_segment_translate (a : E) {x b c} : a + x ∈ [a + b -[𝕜] a + c] ↔ x ∈ [b -[𝕜] c] := -begin - rw [segment_eq_image', segment_eq_image'], - refine exists_congr (λ θ, and_congr iff.rfl _), - simp only [add_sub_add_left_eq_sub, add_assoc, add_right_inj], -end - -@[simp] lemma mem_open_segment_translate (a : E) {x b c : E} : - a + x ∈ open_segment 𝕜 (a + b) (a + c) ↔ x ∈ open_segment 𝕜 b c := -begin - rw [open_segment_eq_image', open_segment_eq_image'], - refine exists_congr (λ θ, and_congr iff.rfl _), - simp only [add_sub_add_left_eq_sub, add_assoc, add_right_inj], -end - -lemma segment_translate_preimage (a b c : E) : (λ x, a + x) ⁻¹' [a + b -[𝕜] a + c] = [b -[𝕜] c] := -set.ext $ λ x, mem_segment_translate 𝕜 a - -lemma open_segment_translate_preimage (a b c : E) : - (λ x, a + x) ⁻¹' open_segment 𝕜 (a + b) (a + c) = open_segment 𝕜 b c := -set.ext $ λ x, mem_open_segment_translate 𝕜 a - -lemma segment_translate_image (a b c : E) : (λ x, a + x) '' [b -[𝕜] c] = [a + b -[𝕜] a + c] := -segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ $ add_left_surjective a - -lemma open_segment_translate_image (a b c : E) : - (λ x, a + x) '' open_segment 𝕜 b c = open_segment 𝕜 (a + b) (a + c) := -open_segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ $ add_left_surjective a - -end add_comm_group -end ordered_ring - -lemma same_ray_of_mem_segment [ordered_comm_ring 𝕜] [add_comm_group E] [module 𝕜 E] - {x y z : E} (h : x ∈ [y -[𝕜] z]) : same_ray 𝕜 (x - y) (z - x) := -begin - rw segment_eq_image' at h, - rcases h with ⟨θ, ⟨hθ₀, hθ₁⟩, rfl⟩, - simpa only [add_sub_cancel', ← sub_sub, sub_smul, one_smul] - using (same_ray_nonneg_smul_left (z - y) hθ₀).nonneg_smul_right (sub_nonneg.2 hθ₁) -end - -section linear_ordered_ring -variables [linear_ordered_ring 𝕜] - -section add_comm_group -variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] - -lemma midpoint_mem_segment [invertible (2 : 𝕜)] (x y : E) : - midpoint 𝕜 x y ∈ [x -[𝕜] y] := -begin - rw segment_eq_image_line_map, - exact ⟨⅟2, ⟨inv_of_nonneg.mpr zero_le_two, inv_of_le_one one_le_two⟩, rfl⟩, -end - -lemma mem_segment_sub_add [invertible (2 : 𝕜)] (x y : E) : - x ∈ [x-y -[𝕜] x+y] := -begin - convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _, - rw midpoint_sub_add -end - -lemma mem_segment_add_sub [invertible (2 : 𝕜)] (x y : E) : - x ∈ [x+y -[𝕜] x-y] := -begin - convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _, - rw midpoint_add_sub -end - -@[simp] lemma left_mem_open_segment_iff [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] {x y : E} : - x ∈ open_segment 𝕜 x y ↔ x = y := -begin - split, - { rintro ⟨a, b, ha, hb, hab, hx⟩, - refine smul_right_injective _ hb.ne' ((add_right_inj (a • x)).1 _), - rw [hx, ←add_smul, hab, one_smul] }, - { rintro rfl, - rw open_segment_same, - exact mem_singleton _ } -end - -@[simp] lemma right_mem_open_segment_iff [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] {x y : E} : - y ∈ open_segment 𝕜 x y ↔ x = y := -by rw [open_segment_symm, left_mem_open_segment_iff, eq_comm] - -end add_comm_group -end linear_ordered_ring - -section linear_ordered_field -variables [linear_ordered_field 𝕜] - -section add_comm_group -variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {x y z : E} - -lemma mem_segment_iff_same_ray : x ∈ [y -[𝕜] z] ↔ same_ray 𝕜 (x - y) (z - x) := -begin - refine ⟨same_ray_of_mem_segment, λ h, _⟩, - rcases h.exists_eq_smul_add with ⟨a, b, ha, hb, hab, hxy, hzx⟩, - rw [add_comm, sub_add_sub_cancel] at hxy hzx, - rw [← mem_segment_translate _ (-x), neg_add_self], - refine ⟨b, a, hb, ha, add_comm a b ▸ hab, _⟩, - rw [← sub_eq_neg_add, ← neg_sub, hxy, ← sub_eq_neg_add, hzx, smul_neg, smul_comm, neg_add_self] -end - -lemma mem_segment_iff_div : x ∈ [y -[𝕜] z] ↔ - ∃ a b : 𝕜, 0 ≤ a ∧ 0 ≤ b ∧ 0 < a + b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x := -begin - split, - { rintro ⟨a, b, ha, hb, hab, rfl⟩, - use [a, b, ha, hb], - simp * }, - { rintro ⟨a, b, ha, hb, hab, rfl⟩, - refine ⟨a / (a + b), b / (a + b), div_nonneg ha hab.le, div_nonneg hb hab.le, _, rfl⟩, - rw [← add_div, div_self hab.ne'] } -end - -lemma mem_open_segment_iff_div : x ∈ open_segment 𝕜 y z ↔ - ∃ a b : 𝕜, 0 < a ∧ 0 < b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x := -begin - split, - { rintro ⟨a, b, ha, hb, hab, rfl⟩, - use [a, b, ha, hb], - rw [hab, div_one, div_one] }, - { rintro ⟨a, b, ha, hb, rfl⟩, - have hab : 0 < a + b, from add_pos ha hb, - refine ⟨a / (a + b), b / (a + b), div_pos ha hab, div_pos hb hab, _, rfl⟩, - rw [← add_div, div_self hab.ne'] } -end - -end add_comm_group -end linear_ordered_field - -/-! -#### Segments in an ordered space -Relates `segment`, `open_segment` and `set.Icc`, `set.Ico`, `set.Ioc`, `set.Ioo` --/ -section ordered_semiring -variables [ordered_semiring 𝕜] - -section ordered_add_comm_monoid -variables [ordered_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] - -lemma segment_subset_Icc {x y : E} (h : x ≤ y) : [x -[𝕜] y] ⊆ Icc x y := -begin - rintro z ⟨a, b, ha, hb, hab, rfl⟩, - split, - calc - x = a • x + b • x :(convex.combo_self hab _).symm - ... ≤ a • x + b • y : add_le_add_left (smul_le_smul_of_nonneg h hb) _, - calc - a • x + b • y - ≤ a • y + b • y : add_le_add_right (smul_le_smul_of_nonneg h ha) _ - ... = y : convex.combo_self hab _, -end - -end ordered_add_comm_monoid - -section ordered_cancel_add_comm_monoid -variables [ordered_cancel_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] - -lemma open_segment_subset_Ioo {x y : E} (h : x < y) : open_segment 𝕜 x y ⊆ Ioo x y := -begin - rintro z ⟨a, b, ha, hb, hab, rfl⟩, - split, - calc - x = a • x + b • x : (convex.combo_self hab _).symm - ... < a • x + b • y : add_lt_add_left (smul_lt_smul_of_pos h hb) _, - calc - a • x + b • y - < a • y + b • y : add_lt_add_right (smul_lt_smul_of_pos h ha) _ - ... = y : convex.combo_self hab _, -end - -end ordered_cancel_add_comm_monoid - -section linear_ordered_add_comm_monoid -variables [linear_ordered_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] {𝕜} - -lemma segment_subset_interval (x y : E) : [x -[𝕜] y] ⊆ interval x y := -begin - cases le_total x y, - { rw interval_of_le h, - exact segment_subset_Icc h }, - { rw [interval_of_ge h, segment_symm], - exact segment_subset_Icc h } -end - -lemma convex.min_le_combo (x y : E) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) : - min x y ≤ a • x + b • y := -(segment_subset_interval x y ⟨_, _, ha, hb, hab, rfl⟩).1 - -lemma convex.combo_le_max (x y : E) {a b : 𝕜} (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) : - a • x + b • y ≤ max x y := -(segment_subset_interval x y ⟨_, _, ha, hb, hab, rfl⟩).2 - -end linear_ordered_add_comm_monoid -end ordered_semiring - -section linear_ordered_field -variables [linear_ordered_field 𝕜] - -lemma Icc_subset_segment {x y : 𝕜} : Icc x y ⊆ [x -[𝕜] y] := -begin - rintro z ⟨hxz, hyz⟩, - obtain rfl | h := (hxz.trans hyz).eq_or_lt, - { rw segment_same, - exact hyz.antisymm hxz }, - rw ←sub_nonneg at hxz hyz, - rw ←sub_pos at h, - refine ⟨(y - z) / (y - x), (z - x) / (y - x), div_nonneg hyz h.le, div_nonneg hxz h.le, _, _⟩, - { rw [←add_div, sub_add_sub_cancel, div_self h.ne'] }, - { rw [smul_eq_mul, smul_eq_mul, ←mul_div_right_comm, ←mul_div_right_comm, ←add_div, - div_eq_iff h.ne', add_comm, sub_mul, sub_mul, mul_comm x, sub_add_sub_cancel, mul_sub] } -end - -@[simp] lemma segment_eq_Icc {x y : 𝕜} (h : x ≤ y) : [x -[𝕜] y] = Icc x y := -(segment_subset_Icc h).antisymm Icc_subset_segment - -lemma Ioo_subset_open_segment {x y : 𝕜} : Ioo x y ⊆ open_segment 𝕜 x y := -λ z hz, mem_open_segment_of_ne_left_right hz.1.ne hz.2.ne' - (Icc_subset_segment $ Ioo_subset_Icc_self hz) - -@[simp] lemma open_segment_eq_Ioo {x y : 𝕜} (h : x < y) : open_segment 𝕜 x y = Ioo x y := -(open_segment_subset_Ioo h).antisymm Ioo_subset_open_segment - -lemma segment_eq_Icc' (x y : 𝕜) : [x -[𝕜] y] = Icc (min x y) (max x y) := -begin - cases le_total x y, - { rw [segment_eq_Icc h, max_eq_right h, min_eq_left h] }, - { rw [segment_symm, segment_eq_Icc h, max_eq_left h, min_eq_right h] } -end - -lemma open_segment_eq_Ioo' {x y : 𝕜} (hxy : x ≠ y) : - open_segment 𝕜 x y = Ioo (min x y) (max x y) := -begin - cases hxy.lt_or_lt, - { rw [open_segment_eq_Ioo h, max_eq_right h.le, min_eq_left h.le] }, - { rw [open_segment_symm, open_segment_eq_Ioo h, max_eq_left h.le, min_eq_right h.le] } -end - -lemma segment_eq_interval (x y : 𝕜) : [x -[𝕜] y] = interval x y := -segment_eq_Icc' _ _ - -/-- A point is in an `Icc` iff it can be expressed as a convex combination of the endpoints. -/ -lemma convex.mem_Icc {x y : 𝕜} (h : x ≤ y) {z : 𝕜} : - z ∈ Icc x y ↔ ∃ (a b : 𝕜), 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z := -begin - rw ←segment_eq_Icc h, - simp_rw [←exists_prop], - refl, -end - -/-- A point is in an `Ioo` iff it can be expressed as a strict convex combination of the endpoints. --/ -lemma convex.mem_Ioo {x y : 𝕜} (h : x < y) {z : 𝕜} : - z ∈ Ioo x y ↔ ∃ (a b : 𝕜), 0 < a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z := -begin - rw ←open_segment_eq_Ioo h, - simp_rw [←exists_prop], - refl, -end - -/-- A point is in an `Ioc` iff it can be expressed as a semistrict convex combination of the -endpoints. -/ -lemma convex.mem_Ioc {x y : 𝕜} (h : x < y) {z : 𝕜} : - z ∈ Ioc x y ↔ ∃ (a b : 𝕜), 0 ≤ a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z := -begin - split, - { rintro hz, - obtain ⟨a, b, ha, hb, hab, rfl⟩ := (convex.mem_Icc h.le).1 (Ioc_subset_Icc_self hz), - obtain rfl | hb' := hb.eq_or_lt, - { rw add_zero at hab, - rw [hab, one_mul, zero_mul, add_zero] at hz, - exact (hz.1.ne rfl).elim }, - { exact ⟨a, b, ha, hb', hab, rfl⟩ } }, - { rintro ⟨a, b, ha, hb, hab, rfl⟩, - obtain rfl | ha' := ha.eq_or_lt, - { rw zero_add at hab, - rwa [hab, one_mul, zero_mul, zero_add, right_mem_Ioc] }, - { exact Ioo_subset_Ioc_self ((convex.mem_Ioo h).2 ⟨a, b, ha', hb, hab, rfl⟩) } } -end - -/-- A point is in an `Ico` iff it can be expressed as a semistrict convex combination of the -endpoints. -/ -lemma convex.mem_Ico {x y : 𝕜} (h : x < y) {z : 𝕜} : - z ∈ Ico x y ↔ ∃ (a b : 𝕜), 0 < a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z := -begin - split, - { rintro hz, - obtain ⟨a, b, ha, hb, hab, rfl⟩ := (convex.mem_Icc h.le).1 (Ico_subset_Icc_self hz), - obtain rfl | ha' := ha.eq_or_lt, - { rw zero_add at hab, - rw [hab, one_mul, zero_mul, zero_add] at hz, - exact (hz.2.ne rfl).elim }, - { exact ⟨a, b, ha', hb, hab, rfl⟩ } }, - { rintro ⟨a, b, ha, hb, hab, rfl⟩, - obtain rfl | hb' := hb.eq_or_lt, - { rw add_zero at hab, - rwa [hab, one_mul, zero_mul, add_zero, left_mem_Ico] }, - { exact Ioo_subset_Ico_self ((convex.mem_Ioo h).2 ⟨a, b, ha, hb', hab, rfl⟩) } } -end - -end linear_ordered_field +open_locale big_operators classical convex pointwise /-! ### Convexity of sets -/ @@ -519,19 +39,18 @@ variables [ordered_semiring 𝕜] section add_comm_monoid variables [add_comm_monoid E] [add_comm_monoid F] -section has_scalar -variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 F] (s : set E) +section has_smul +variables (𝕜) [has_smul 𝕜 E] [has_smul 𝕜 F] (s : set E) {x : E} /-- Convexity of sets. -/ -def convex : Prop := -∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → - a • x + b • y ∈ s +def convex : Prop := ∀ ⦃x : E⦄, x ∈ s → star_convex 𝕜 x s variables {𝕜 s} -lemma convex_iff_segment_subset : - convex 𝕜 s ↔ ∀ ⦃x y⦄, x ∈ s → y ∈ s → [x -[𝕜] y] ⊆ s := -forall₄_congr $ λ x y hx hy, (segment_subset_iff _).symm +lemma convex.star_convex (hs : convex 𝕜 s) (hx : x ∈ s) : star_convex 𝕜 x s := hs hx + +lemma convex_iff_segment_subset : convex 𝕜 s ↔ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → [x -[𝕜] y] ⊆ s := +forall₂_congr $ λ x hx, star_convex_iff_segment_subset lemma convex.segment_subset (h : convex 𝕜 s) {x y : E} (hx : x ∈ s) (hy : y ∈ s) : [x -[𝕜] y] ⊆ s := @@ -549,23 +68,20 @@ iff.intro rintro hA a b ha hb hab w ⟨au, bv, ⟨u, hu, rfl⟩, ⟨v, hv, rfl⟩, rfl⟩, exact hA hu hv ha hb hab end - (λ h x y hx hy a b ha hb hab, + (λ h x hx y hy a b ha hb hab, (h ha hb hab) (set.add_mem_add ⟨_, hx, rfl⟩ ⟨_, hy, rfl⟩)) alias convex_iff_pointwise_add_subset ↔ convex.set_combo_subset _ -lemma convex_empty : convex 𝕜 (∅ : set E) := -λ x y, false.elim +lemma convex_empty : convex 𝕜 (∅ : set E) := λ x, false.elim -lemma convex_univ : convex 𝕜 (set.univ : set E) := λ _ _ _ _ _ _ _ _ _, trivial +lemma convex_univ : convex 𝕜 (set.univ : set E) := λ _ _, star_convex_univ _ lemma convex.inter {t : set E} (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s ∩ t) := -λ x y (hx : x ∈ s ∩ t) (hy : y ∈ s ∩ t) a b (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1), - ⟨hs hx.left hy.left ha hb hab, ht hx.right hy.right ha hb hab⟩ +λ x hx, (hs hx.1).inter (ht hx.2) lemma convex_sInter {S : set (set E)} (h : ∀ s ∈ S, convex 𝕜 s) : convex 𝕜 (⋂₀ S) := -assume x y hx hy a b ha hb hab s hs, -h s hs (hx s hs) (hy s hs) ha hb hab +λ x hx, star_convex_sInter $ λ s hs, h _ hs $ hx _ hs lemma convex_Inter {ι : Sort*} {s : ι → set E} (h : ∀ i, convex 𝕜 (s i)) : convex 𝕜 (⋂ i, s i) := (sInter_range s) ▸ convex_sInter $ forall_range_iff.2 h @@ -575,25 +91,19 @@ lemma convex_Inter₂ {ι : Sort*} {κ : ι → Sort*} {s : Π i, κ i → set E convex 𝕜 (⋂ i j, s i j) := convex_Inter $ λ i, convex_Inter $ h i -lemma convex.prod {s : set E} {t : set F} (hs : convex 𝕜 s) (ht : convex 𝕜 t) : - convex 𝕜 (s ×ˢ t) := -begin - intros x y hx hy a b ha hb hab, - apply mem_prod.2, - exact ⟨hs (mem_prod.1 hx).1 (mem_prod.1 hy).1 ha hb hab, - ht (mem_prod.1 hx).2 (mem_prod.1 hy).2 ha hb hab⟩ -end +lemma convex.prod {s : set E} {t : set F} (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s ×ˢ t) := +λ x hx, (hs hx.1).prod (ht hx.2) lemma convex_pi {ι : Type*} {E : ι → Type*} [Π i, add_comm_monoid (E i)] - [Π i, has_scalar 𝕜 (E i)] {s : set ι} {t : Π i, set (E i)} (ht : ∀ i, convex 𝕜 (t i)) : + [Π i, has_smul 𝕜 (E i)] {s : set ι} {t : Π i, set (E i)} (ht : ∀ ⦃i⦄, i ∈ s → convex 𝕜 (t i)) : convex 𝕜 (s.pi t) := -λ x y hx hy a b ha hb hab i hi, ht i (hx i hi) (hy i hi) ha hb hab +λ x hx, star_convex_pi $ λ i hi, ht hi $ hx _ hi lemma directed.convex_Union {ι : Sort*} {s : ι → set E} (hdir : directed (⊆) s) (hc : ∀ ⦃i : ι⦄, convex 𝕜 (s i)) : convex 𝕜 (⋃ i, s i) := begin - rintro x y hx hy a b ha hb hab, + rintro x hx y hy a b ha hb hab, rw mem_Union at ⊢ hx hy, obtain ⟨i, hx⟩ := hx, obtain ⟨j, hy⟩ := hy, @@ -609,41 +119,56 @@ begin exact (directed_on_iff_directed.1 hdir).convex_Union (λ A, hc A.2), end -end has_scalar +end has_smul section module -variables [module 𝕜 E] [module 𝕜 F] {s : set E} +variables [module 𝕜 E] [module 𝕜 F] {s : set E} {x : E} lemma convex_iff_open_segment_subset : - convex 𝕜 s ↔ ∀ ⦃x y⦄, x ∈ s → y ∈ s → open_segment 𝕜 x y ⊆ s := -convex_iff_segment_subset.trans $ forall₄_congr $ λ x y hx hy, - (open_segment_subset_iff_segment_subset hx hy).symm + convex 𝕜 s ↔ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → open_segment 𝕜 x y ⊆ s := +forall₂_congr $ λ x, star_convex_iff_open_segment_subset lemma convex_iff_forall_pos : - convex 𝕜 s ↔ ∀ ⦃x y⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 + convex 𝕜 s ↔ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s := -convex_iff_open_segment_subset.trans $ forall₄_congr $ λ x y hx hy, - open_segment_subset_iff 𝕜 +forall₂_congr $ λ x, star_convex_iff_forall_pos lemma convex_iff_pairwise_pos : convex 𝕜 s ↔ s.pairwise (λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s) := begin refine convex_iff_forall_pos.trans ⟨λ h x hx y hy _, h hx hy, _⟩, - intros h x y hx hy a b ha hb hab, + intros h x hx y hy a b ha hb hab, obtain rfl | hxy := eq_or_ne x y, { rwa convex.combo_self hab }, { exact h hx hy hxy ha hb hab }, end +lemma convex.star_convex_iff (hs : convex 𝕜 s) (h : s.nonempty) : star_convex 𝕜 x s ↔ x ∈ s := +⟨λ hxs, hxs.mem h, hs.star_convex⟩ + protected lemma set.subsingleton.convex {s : set E} (h : s.subsingleton) : convex 𝕜 s := convex_iff_pairwise_pos.mpr (h.pairwise _) lemma convex_singleton (c : E) : convex 𝕜 ({c} : set E) := subsingleton_singleton.convex +lemma convex_zero : convex 𝕜 (0 : set E) := +convex_singleton _ + +lemma convex_segment (x y : E) : convex 𝕜 [x -[𝕜] y] := +begin + rintro p ⟨ap, bp, hap, hbp, habp, rfl⟩ q ⟨aq, bq, haq, hbq, habq, rfl⟩ a b ha hb hab, + refine ⟨a * ap + b * aq, a * bp + b * bq, + add_nonneg (mul_nonneg ha hap) (mul_nonneg hb haq), + add_nonneg (mul_nonneg ha hbp) (mul_nonneg hb hbq), _, _⟩, + { rw [add_add_add_comm, ←mul_add, ←mul_add, habp, habq, mul_one, mul_one, hab] }, + { simp_rw [add_smul, mul_smul, smul_add], + exact add_add_add_comm _ _ _ _ } +end + lemma convex.linear_image (hs : convex 𝕜 s) (f : E →ₗ[𝕜] F) : convex 𝕜 (f '' s) := begin - intros x y hx hy a b ha hb hab, + intros x hx y hy a b ha hb hab, obtain ⟨x', hx', rfl⟩ := mem_image_iff_bex.1 hx, obtain ⟨y', hy', rfl⟩ := mem_image_iff_bex.1 hy, exact ⟨a • x' + b • y', hs hx' hy' ha hb hab, by rw [f.map_add, f.map_smul, f.map_smul]⟩, @@ -656,7 +181,7 @@ hs.linear_image $ hf.mk' f lemma convex.linear_preimage {s : set F} (hs : convex 𝕜 s) (f : E →ₗ[𝕜] F) : convex 𝕜 (f ⁻¹' s) := begin - intros x y hx hy a b ha hb hab, + intros x hx y hy a b ha hb hab, rw [mem_preimage, f.map_add, f.map_smul, f.map_smul], exact hs hx hy ha hb hab, end @@ -668,19 +193,42 @@ hs.linear_preimage $ hf.mk' f lemma convex.add {t : set E} (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s + t) := by { rw ← add_image_prod, exact (hs.prod ht).is_linear_image is_linear_map.is_linear_map_add } -lemma convex.translate (hs : convex 𝕜 s) (z : E) : convex 𝕜 ((λ x, z + x) '' s) := -begin - intros x y hx hy a b ha hb hab, - obtain ⟨x', hx', rfl⟩ := mem_image_iff_bex.1 hx, - obtain ⟨y', hy', rfl⟩ := mem_image_iff_bex.1 hy, - refine ⟨a • x' + b • y', hs hx' hy' ha hb hab, _⟩, - rw [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul], -end +variables (𝕜 E) + +/-- The convex sets form an additive submonoid under pointwise addition. -/ +def convex_add_submonoid : add_submonoid (set E) := +{ carrier := {s : set E | convex 𝕜 s}, + zero_mem' := convex_zero, + add_mem' := λ s t, convex.add } + +@[simp, norm_cast] +lemma coe_convex_add_submonoid : ↑(convex_add_submonoid 𝕜 E) = {s : set E | convex 𝕜 s} := rfl + +variables {𝕜 E} + +@[simp] lemma mem_convex_add_submonoid {s : set E} : + s ∈ convex_add_submonoid 𝕜 E ↔ convex 𝕜 s := +iff.rfl + +lemma convex_list_sum {l : list (set E)} (h : ∀ i ∈ l, convex 𝕜 i) : convex 𝕜 l.sum := +(convex_add_submonoid 𝕜 E).list_sum_mem h + +lemma convex_multiset_sum {s : multiset (set E)} (h : ∀ i ∈ s, convex 𝕜 i) : convex 𝕜 s.sum := +(convex_add_submonoid 𝕜 E).multiset_sum_mem _ h + +lemma convex_sum {ι} {s : finset ι} (t : ι → set E) (h : ∀ i ∈ s, convex 𝕜 (t i)) : + convex 𝕜 (∑ i in s, t i) := +(convex_add_submonoid 𝕜 E).sum_mem h + +lemma convex.vadd (hs : convex 𝕜 s) (z : E) : convex 𝕜 (z +ᵥ s) := +by { simp_rw [←image_vadd, vadd_eq_add, ←singleton_add], exact (convex_singleton _).add hs } + +lemma convex.translate (hs : convex 𝕜 s) (z : E) : convex 𝕜 ((λ x, z + x) '' s) := hs.vadd _ /-- The translation of a convex set is also convex. -/ lemma convex.translate_preimage_right (hs : convex 𝕜 s) (z : E) : convex 𝕜 ((λ x, z + x) ⁻¹' s) := begin - intros x y hx hy a b ha hb hab, + intros x hx y hy a b ha hb hab, have h := hs hx hy ha hb hab, rwa [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul] at h, end @@ -693,7 +241,7 @@ section ordered_add_comm_monoid variables [ordered_add_comm_monoid β] [module 𝕜 β] [ordered_smul 𝕜 β] lemma convex_Iic (r : β) : convex 𝕜 (Iic r) := -λ x y hx hy a b ha hb hab, +λ x hx y hy a b ha hb hab, calc a • x + b • y ≤ a • r + b • r @@ -727,7 +275,7 @@ variables [ordered_cancel_add_comm_monoid β] [module 𝕜 β] [ordered_smul lemma convex_Iio (r : β) : convex 𝕜 (Iio r) := begin - intros x y hx hy a b ha hb hab, + intros x hx y hy a b ha hb hab, obtain rfl | ha' := ha.eq_or_lt, { rw zero_add at hab, rwa [zero_smul, zero_add, hab, one_smul] }, @@ -763,8 +311,7 @@ end ordered_cancel_add_comm_monoid section linear_ordered_add_comm_monoid variables [linear_ordered_add_comm_monoid β] [module 𝕜 β] [ordered_smul 𝕜 β] -lemma convex_interval (r s : β) : convex 𝕜 (interval r s) := -convex_Icc _ _ +lemma convex_uIcc (r s : β) : convex 𝕜 (uIcc r s) := convex_Icc _ _ end linear_ordered_add_comm_monoid end module @@ -776,13 +323,13 @@ variables [linear_ordered_add_comm_monoid E] [ordered_add_comm_monoid β] [modul lemma monotone_on.convex_le (hf : monotone_on f s) (hs : convex 𝕜 s) (r : β) : convex 𝕜 {x ∈ s | f x ≤ r} := -λ x y hx hy a b ha hb hab, ⟨hs hx.1 hy.1 ha hb hab, +λ x hx y hy a b ha hb hab, ⟨hs hx.1 hy.1 ha hb hab, (hf (hs hx.1 hy.1 ha hb hab) (max_rec' s hx.1 hy.1) (convex.combo_le_max x y ha hb hab)).trans (max_rec' _ hx.2 hy.2)⟩ lemma monotone_on.convex_lt (hf : monotone_on f s) (hs : convex 𝕜 s) (r : β) : convex 𝕜 {x ∈ s | f x < r} := -λ x y hx hy a b ha hb hab, ⟨hs hx.1 hy.1 ha hb hab, +λ x hx y hy a b ha hb hab, ⟨hs hx.1 hy.1 ha hb hab, (hf (hs hx.1 hy.1 ha hb hab) (max_rec' s hx.1 hy.1) (convex.combo_le_max x y ha hb hab)).trans_lt (max_rec' _ hx.2 hy.2)⟩ @@ -843,43 +390,6 @@ lemma antitone.convex_gt (hf : antitone f) (r : β) : set.sep_univ.subst ((hf.antitone_on univ).convex_gt convex_univ r) end linear_ordered_add_comm_monoid - -section add_comm_group -variables [add_comm_group E] [module 𝕜 E] {s t : set E} - -lemma convex.combo_eq_vadd {a b : 𝕜} {x y : E} (h : a + b = 1) : - a • x + b • y = b • (y - x) + x := -calc - a • x + b • y = (b • y - b • x) + (a • x + b • x) : by abel - ... = b • (y - x) + x : by rw [smul_sub, convex.combo_self h] - -lemma convex.sub {s : set (E × E)} (hs : convex 𝕜 s) : convex 𝕜 ((λ x : E × E, x.1 - x.2) '' s) := -hs.is_linear_image is_linear_map.is_linear_map_sub - -lemma convex_segment (x y : E) : convex 𝕜 [x -[𝕜] y] := -begin - rintro p q ⟨ap, bp, hap, hbp, habp, rfl⟩ ⟨aq, bq, haq, hbq, habq, rfl⟩ a b ha hb hab, - refine ⟨a * ap + b * aq, a * bp + b * bq, - add_nonneg (mul_nonneg ha hap) (mul_nonneg hb haq), - add_nonneg (mul_nonneg ha hbp) (mul_nonneg hb hbq), _, _⟩, - { rw [add_add_add_comm, ←mul_add, ←mul_add, habp, habq, mul_one, mul_one, hab] }, - { simp_rw [add_smul, mul_smul, smul_add], - exact add_add_add_comm _ _ _ _ } -end - -lemma convex_open_segment (a b : E) : convex 𝕜 (open_segment 𝕜 a b) := -begin - rw convex_iff_open_segment_subset, - rintro p q ⟨ap, bp, hap, hbp, habp, rfl⟩ ⟨aq, bq, haq, hbq, habq, rfl⟩ z ⟨a, b, ha, hb, hab, rfl⟩, - refine ⟨a * ap + b * aq, a * bp + b * bq, - add_pos (mul_pos ha hap) (mul_pos hb haq), - add_pos (mul_pos ha hbp) (mul_pos hb hbq), _, _⟩, - { rw [add_add_add_comm, ←mul_add, ←mul_add, habp, habq, mul_one, mul_one, hab] }, - { simp_rw [add_smul, mul_smul, smul_add], - exact add_add_add_comm _ _ _ _ } -end - -end add_comm_group end ordered_semiring section ordered_comm_semiring @@ -895,19 +405,30 @@ lemma convex.smul_preimage (hs : convex 𝕜 s) (c : 𝕜) : convex 𝕜 ((λ z, hs.linear_preimage (linear_map.lsmul _ _ c) lemma convex.affinity (hs : convex 𝕜 s) (z : E) (c : 𝕜) : convex 𝕜 ((λ x, z + c • x) '' s) := -begin - have h := (hs.smul c).translate z, - rwa [←image_smul, image_image] at h, -end +by simpa only [←image_smul, ←image_vadd, image_image] using (hs.smul c).vadd z end add_comm_monoid end ordered_comm_semiring +section strict_ordered_comm_semiring +variables [strict_ordered_comm_semiring 𝕜] [add_comm_group E] [module 𝕜 E] + +lemma convex_open_segment (a b : E) : convex 𝕜 (open_segment 𝕜 a b) := +begin + rw convex_iff_open_segment_subset, + rintro p ⟨ap, bp, hap, hbp, habp, rfl⟩ q ⟨aq, bq, haq, hbq, habq, rfl⟩ z ⟨a, b, ha, hb, hab, rfl⟩, + refine ⟨a * ap + b * aq, a * bp + b * bq, by positivity, by positivity, _, _⟩, + { rw [add_add_add_comm, ←mul_add, ←mul_add, habp, habq, mul_one, mul_one, hab] }, + { simp_rw [add_smul, mul_smul, smul_add, add_add_add_comm] } +end + +end strict_ordered_comm_semiring + section ordered_ring variables [ordered_ring 𝕜] section add_comm_group -variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s : set E} +variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s t : set E} lemma convex.add_smul_mem (hs : convex 𝕜 s) {x y : E} (hx : x ∈ s) (hy : x + y ∈ s) {t : 𝕜} (ht : t ∈ Icc (0 : 𝕜) 1) : x + t • y ∈ s := @@ -933,46 +454,26 @@ end /-- Affine subspaces are convex. -/ lemma affine_subspace.convex (Q : affine_subspace 𝕜 E) : convex 𝕜 (Q : set E) := begin - intros x y hx hy a b ha hb hab, + intros x hx y hy a b ha hb hab, rw [eq_sub_of_add_eq hab, ← affine_map.line_map_apply_module], exact affine_map.line_map_mem b hx hy, end -/-- -Applying an affine map to an affine combination of two points yields -an affine combination of the images. --/ -lemma convex.combo_affine_apply {a b : 𝕜} {x y : E} {f : E →ᵃ[𝕜] F} (h : a + b = 1) : - f (a • x + b • y) = a • f x + b • f y := -begin - simp only [convex.combo_eq_vadd h, ← vsub_eq_sub], - exact f.apply_line_map _ _ _, -end - /-- The preimage of a convex set under an affine map is convex. -/ lemma convex.affine_preimage (f : E →ᵃ[𝕜] F) {s : set F} (hs : convex 𝕜 s) : convex 𝕜 (f ⁻¹' s) := -begin - intros x y xs ys a b ha hb hab, - rw [mem_preimage, convex.combo_affine_apply hab], - exact hs xs ys ha hb hab, -end +λ x hx, (hs hx).affine_preimage _ /-- The image of a convex set under an affine map is convex. -/ -lemma convex.affine_image (f : E →ᵃ[𝕜] F) {s : set E} (hs : convex 𝕜 s) : - convex 𝕜 (f '' s) := -begin - rintro x y ⟨x', ⟨hx', hx'f⟩⟩ ⟨y', ⟨hy', hy'f⟩⟩ a b ha hb hab, - refine ⟨a • x' + b • y', ⟨hs hx' hy' ha hb hab, _⟩⟩, - rw [convex.combo_affine_apply hab, hx'f, hy'f] -end +lemma convex.affine_image (f : E →ᵃ[𝕜] F) (hs : convex 𝕜 s) : convex 𝕜 (f '' s) := +by { rintro _ ⟨x, hx, rfl⟩, exact (hs hx).affine_image _ } lemma convex.neg (hs : convex 𝕜 s) : convex 𝕜 (-s) := -by { rw ←set.image_neg, exact hs.is_linear_image is_linear_map.is_linear_map_neg } - -lemma convex.neg_preimage (hs : convex 𝕜 s) : convex 𝕜 ((λ z, -z) ⁻¹' s) := hs.is_linear_preimage is_linear_map.is_linear_map_neg +lemma convex.sub (hs : convex 𝕜 s) (ht : convex 𝕜 t) : convex 𝕜 (s - t) := +by { rw sub_eq_add_neg, exact hs.add ht.neg } + end add_comm_group end ordered_ring @@ -984,14 +485,9 @@ variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] /-- Alternative definition of set convexity, using division. -/ lemma convex_iff_div : - convex 𝕜 s ↔ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, + convex 𝕜 s ↔ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → 0 < a + b → (a / (a + b)) • x + (b / (a + b)) • y ∈ s := -begin - simp only [convex_iff_segment_subset, subset_def, mem_segment_iff_div], - refine forall₄_congr (λ x y hx hy, ⟨λ H a b ha hb hab, H _ ⟨a, b, ha, hb, hab, rfl⟩, _⟩), - rintro H _ ⟨a, b, ha, hb, hab, rfl⟩, - exact H ha hb hab -end +forall₂_congr $ λ x hx, star_convex_iff_div lemma convex.mem_smul_of_zero_mem (h : convex 𝕜 s) {x : E} (zero_mem : (0 : E) ∈ s) (hx : x ∈ s) {t : 𝕜} (ht : 1 ≤ t) : @@ -1016,9 +512,9 @@ begin exact ⟨p • v, q • v, smul_mem_smul_set hv, smul_mem_smul_set hv, (add_smul _ _ _).symm⟩ }, { rintro ⟨v₁, v₂, ⟨v₁₁, h₁₂, rfl⟩, ⟨v₂₁, h₂₂, rfl⟩, rfl⟩, have hpq := add_pos hp' hq', - exact mem_smul_set.2 ⟨_, h_conv h₁₂ h₂₂ (div_pos hp' hpq).le (div_pos hq' hpq).le + refine mem_smul_set.2 ⟨_, h_conv h₁₂ h₂₂ _ _ (by rw [←div_self hpq.ne', add_div] : p / (p + q) + q / (p + q) = 1), - by simp only [← mul_smul, smul_add, mul_div_cancel' _ hpq.ne']⟩ } + by simp only [← mul_smul, smul_add, mul_div_cancel' _ hpq.ne']⟩; positivity } end end add_comm_group @@ -1035,7 +531,7 @@ lemma set.ord_connected.convex_of_chain [ordered_semiring 𝕜] [ordered_add_com [module 𝕜 E] [ordered_smul 𝕜 E] {s : set E} (hs : s.ord_connected) (h : is_chain (≤) s) : convex 𝕜 s := begin - refine convex_iff_segment_subset.mpr (λ x y hx hy, _), + refine convex_iff_segment_subset.mpr (λ x hx y hy, _), obtain hxy | hyx := h.total hx hy, { exact (segment_subset_Icc hxy).trans (hs.out hx hy) }, { rw segment_symm, @@ -1049,10 +545,7 @@ hs.convex_of_chain $ is_chain_of_trichotomous s lemma convex_iff_ord_connected [linear_ordered_field 𝕜] {s : set 𝕜} : convex 𝕜 s ↔ s.ord_connected := -begin - simp_rw [convex_iff_segment_subset, segment_eq_interval, ord_connected_iff_interval_subset], - exact forall_congr (λ x, forall_swap) -end +by simp_rw [convex_iff_segment_subset, segment_eq_uIcc, ord_connected_iff_uIcc_subset] alias convex_iff_ord_connected ↔ convex.ord_connected _ @@ -1060,16 +553,13 @@ end /-! #### Convexity of submodules/subspaces -/ -section submodule -open submodule +namespace submodule +variables [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] -lemma submodule.convex [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] (K : submodule 𝕜 E) : - convex 𝕜 (↑K : set E) := +protected lemma convex (K : submodule 𝕜 E) : convex 𝕜 (↑K : set E) := by { repeat {intro}, refine add_mem (smul_mem _ _ _) (smul_mem _ _ _); assumption } -lemma subspace.convex [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] (K : subspace 𝕜 E) : - convex 𝕜 (↑K : set E) := -K.convex +protected lemma star_convex (K : submodule 𝕜 E) : star_convex 𝕜 (0 : E) K := K.convex K.zero_mem end submodule @@ -1086,11 +576,11 @@ def std_simplex : set (ι → 𝕜) := lemma std_simplex_eq_inter : std_simplex 𝕜 ι = (⋂ x, {f | 0 ≤ f x}) ∩ {f | ∑ x, f x = 1} := -by { ext f, simp only [std_simplex, set.mem_inter_eq, set.mem_Inter, set.mem_set_of_eq] } +by { ext f, simp only [std_simplex, set.mem_inter_iff, set.mem_Inter, set.mem_set_of_eq] } lemma convex_std_simplex : convex 𝕜 (std_simplex 𝕜 ι) := begin - refine λ f g hf hg a b ha hb hab, ⟨λ x, _, _⟩, + refine λ f hf g hg a b ha hb hab, ⟨λ x, _, _⟩, { apply_rules [add_nonneg, mul_nonneg, hf.1, hg.1] }, { erw [finset.sum_add_distrib, ← finset.smul_sum, ← finset.smul_sum, hf.2, hg.2, smul_eq_mul, smul_eq_mul, mul_one, mul_one], diff --git a/src/analysis/convex/between.lean b/src/analysis/convex/between.lean new file mode 100644 index 0000000000000..6d7e41fd38dff --- /dev/null +++ b/src/analysis/convex/between.lean @@ -0,0 +1,854 @@ +/- +Copyright (c) 2022 Joseph Myers. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Myers +-/ +import data.set.intervals.group +import analysis.convex.segment +import linear_algebra.affine_space.finite_dimensional +import tactic.field_simp +import algebra.char_p.invertible + +/-! +# Betweenness in affine spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines notions of a point in an affine space being between two given points. + +## Main definitions + +* `affine_segment R x y`: The segment of points weakly between `x` and `y`. +* `wbtw R x y z`: The point `y` is weakly between `x` and `z`. +* `sbtw R x y z`: The point `y` is strictly between `x` and `z`. + +-/ + +variables (R : Type*) {V V' P P' : Type*} + +open affine_equiv affine_map + +open_locale big_operators + +section ordered_ring + +variables [ordered_ring R] [add_comm_group V] [module R V] [add_torsor V P] +variables [add_comm_group V'] [module R V'] [add_torsor V' P'] + +include V + +/-- The segment of points weakly between `x` and `y`. When convexity is refactored to support +abstract affine combination spaces, this will no longer need to be a separate definition from +`segment`. However, lemmas involving `+ᵥ` or `-ᵥ` will still be relevant after such a +refactoring, as distinct from versions involving `+` or `-` in a module. -/ +def affine_segment (x y : P) := line_map x y '' (set.Icc (0 : R) 1) + +lemma affine_segment_eq_segment (x y : V) : affine_segment R x y = segment R x y := +by rw [segment_eq_image_line_map, affine_segment] + +lemma affine_segment_comm (x y : P) : affine_segment R x y = affine_segment R y x := +begin + refine set.ext (λ z, _), + split; + { rintro ⟨t, ht, hxy⟩, + refine ⟨1 - t, _, _⟩, + { rwa [set.sub_mem_Icc_iff_right, sub_self, sub_zero] }, + { rwa [line_map_apply_one_sub] } }, +end + +lemma left_mem_affine_segment (x y : P) : x ∈ affine_segment R x y := +⟨0, set.left_mem_Icc.2 zero_le_one, line_map_apply_zero _ _⟩ + +lemma right_mem_affine_segment (x y : P) : y ∈ affine_segment R x y := +⟨1, set.right_mem_Icc.2 zero_le_one, line_map_apply_one _ _⟩ + +@[simp] lemma affine_segment_same (x : P) : affine_segment R x x = {x} := +by simp_rw [affine_segment, line_map_same, affine_map.coe_const, + (set.nonempty_Icc.mpr zero_le_one).image_const] + +include V' + +variables {R} + +@[simp] lemma affine_segment_image (f : P →ᵃ[R] P') (x y : P) : + f '' affine_segment R x y = affine_segment R (f x) (f y) := +begin + rw [affine_segment, affine_segment, set.image_image, ←comp_line_map], + refl +end + +omit V' + +variables (R) + +@[simp] lemma affine_segment_const_vadd_image (x y : P) (v : V) : + ((+ᵥ) v) '' affine_segment R x y = affine_segment R (v +ᵥ x) (v +ᵥ y) := +affine_segment_image (affine_equiv.const_vadd R P v : P →ᵃ[R] P) x y + +@[simp] lemma affine_segment_vadd_const_image (x y : V) (p : P) : + (+ᵥ p) '' affine_segment R x y = affine_segment R (x +ᵥ p) (y +ᵥ p) := +affine_segment_image (affine_equiv.vadd_const R p : V →ᵃ[R] P) x y + +@[simp] lemma affine_segment_const_vsub_image (x y p : P) : + ((-ᵥ) p) '' affine_segment R x y = affine_segment R (p -ᵥ x) (p -ᵥ y) := +affine_segment_image (affine_equiv.const_vsub R p : P →ᵃ[R] V) x y + +@[simp] lemma affine_segment_vsub_const_image (x y p : P) : + (-ᵥ p) '' affine_segment R x y = affine_segment R (x -ᵥ p) (y -ᵥ p) := +affine_segment_image ((affine_equiv.vadd_const R p).symm : P →ᵃ[R] V) x y + +variables {R} + +@[simp] lemma mem_const_vadd_affine_segment {x y z : P} (v : V) : + v +ᵥ z ∈ affine_segment R (v +ᵥ x) (v +ᵥ y) ↔ z ∈ affine_segment R x y := +by rw [←affine_segment_const_vadd_image, (add_action.injective v).mem_set_image] + +@[simp] lemma mem_vadd_const_affine_segment {x y z : V} (p : P) : + z +ᵥ p ∈ affine_segment R (x +ᵥ p) (y +ᵥ p) ↔ z ∈ affine_segment R x y := +by rw [←affine_segment_vadd_const_image, (vadd_right_injective p).mem_set_image] +variables {R} + +@[simp] lemma mem_const_vsub_affine_segment {x y z : P} (p : P) : + p -ᵥ z ∈ affine_segment R (p -ᵥ x) (p -ᵥ y) ↔ z ∈ affine_segment R x y := +by rw [←affine_segment_const_vsub_image, (vsub_right_injective p).mem_set_image] + +@[simp] lemma mem_vsub_const_affine_segment {x y z : P} (p : P) : + z -ᵥ p ∈ affine_segment R (x -ᵥ p) (y -ᵥ p) ↔ z ∈ affine_segment R x y := +by rw [←affine_segment_vsub_const_image, (vsub_left_injective p).mem_set_image] + +variables (R) + +/-- The point `y` is weakly between `x` and `z`. -/ +def wbtw (x y z : P) : Prop := y ∈ affine_segment R x z + +/-- The point `y` is strictly between `x` and `z`. -/ +def sbtw (x y z : P) : Prop := wbtw R x y z ∧ y ≠ x ∧ y ≠ z + +variables {R} + +include V' + +lemma wbtw.map {x y z : P} (h : wbtw R x y z) (f : P →ᵃ[R] P') : wbtw R (f x) (f y) (f z) := +begin + rw [wbtw, ←affine_segment_image], + exact set.mem_image_of_mem _ h +end + +lemma function.injective.wbtw_map_iff {x y z : P} {f : P →ᵃ[R] P'} (hf : function.injective f) : + wbtw R (f x) (f y) (f z) ↔ wbtw R x y z := +begin + refine ⟨λ h, _, λ h, h.map _⟩, + rwa [wbtw, ←affine_segment_image, hf.mem_set_image] at h +end + +lemma function.injective.sbtw_map_iff {x y z : P} {f : P →ᵃ[R] P'} (hf : function.injective f) : + sbtw R (f x) (f y) (f z) ↔ sbtw R x y z := +by simp_rw [sbtw, hf.wbtw_map_iff, hf.ne_iff] + +@[simp] lemma affine_equiv.wbtw_map_iff {x y z : P} (f : P ≃ᵃ[R] P') : + wbtw R (f x) (f y) (f z) ↔ wbtw R x y z := +begin + refine function.injective.wbtw_map_iff (_ : function.injective f.to_affine_map), + exact f.injective +end + +@[simp] lemma affine_equiv.sbtw_map_iff {x y z : P} (f : P ≃ᵃ[R] P') : + sbtw R (f x) (f y) (f z) ↔ sbtw R x y z := +begin + refine function.injective.sbtw_map_iff (_ : function.injective f.to_affine_map), + exact f.injective +end + +omit V' + +@[simp] lemma wbtw_const_vadd_iff {x y z : P} (v : V) : + wbtw R (v +ᵥ x) (v +ᵥ y) (v +ᵥ z) ↔ wbtw R x y z := +mem_const_vadd_affine_segment _ + +@[simp] lemma wbtw_vadd_const_iff {x y z : V} (p : P) : + wbtw R (x +ᵥ p) (y +ᵥ p) (z +ᵥ p) ↔ wbtw R x y z := +mem_vadd_const_affine_segment _ + +@[simp] lemma wbtw_const_vsub_iff {x y z : P} (p : P) : + wbtw R (p -ᵥ x) (p -ᵥ y) (p -ᵥ z) ↔ wbtw R x y z := +mem_const_vsub_affine_segment _ + +@[simp] lemma wbtw_vsub_const_iff {x y z : P} (p : P) : + wbtw R (x -ᵥ p) (y -ᵥ p) (z -ᵥ p) ↔ wbtw R x y z := +mem_vsub_const_affine_segment _ + +@[simp] lemma sbtw_const_vadd_iff {x y z : P} (v : V) : + sbtw R (v +ᵥ x) (v +ᵥ y) (v +ᵥ z) ↔ sbtw R x y z := +by simp_rw [sbtw, wbtw_const_vadd_iff, (add_action.injective v).ne_iff] + +@[simp] lemma sbtw_vadd_const_iff {x y z : V} (p : P) : + sbtw R (x +ᵥ p) (y +ᵥ p) (z +ᵥ p) ↔ sbtw R x y z := +by simp_rw [sbtw, wbtw_vadd_const_iff, (vadd_right_injective p).ne_iff] + +@[simp] lemma sbtw_const_vsub_iff {x y z : P} (p : P) : + sbtw R (p -ᵥ x) (p -ᵥ y) (p -ᵥ z) ↔ sbtw R x y z := +by simp_rw [sbtw, wbtw_const_vsub_iff, (vsub_right_injective p).ne_iff] + +@[simp] lemma sbtw_vsub_const_iff {x y z : P} (p : P) : + sbtw R (x -ᵥ p) (y -ᵥ p) (z -ᵥ p) ↔ sbtw R x y z := +by simp_rw [sbtw, wbtw_vsub_const_iff, (vsub_left_injective p).ne_iff] + +lemma sbtw.wbtw {x y z : P} (h : sbtw R x y z) : wbtw R x y z := +h.1 + +lemma sbtw.ne_left {x y z : P} (h : sbtw R x y z) : y ≠ x := +h.2.1 + +lemma sbtw.left_ne {x y z : P} (h : sbtw R x y z) : x ≠ y := +h.2.1.symm + +lemma sbtw.ne_right {x y z : P} (h : sbtw R x y z) : y ≠ z := +h.2.2 + +lemma sbtw.right_ne {x y z : P} (h : sbtw R x y z) : z ≠ y := +h.2.2.symm + +lemma sbtw.mem_image_Ioo {x y z : P} (h : sbtw R x y z) : + y ∈ line_map x z '' (set.Ioo (0 : R) 1) := +begin + rcases h with ⟨⟨t, ht, rfl⟩, hyx, hyz⟩, + rcases set.eq_endpoints_or_mem_Ioo_of_mem_Icc ht with rfl|rfl|ho, + { exfalso, simpa using hyx }, + { exfalso, simpa using hyz }, + { exact ⟨t, ho, rfl⟩ } +end + +lemma wbtw.mem_affine_span {x y z : P} (h : wbtw R x y z) : y ∈ line[R, x, z] := +begin + rcases h with ⟨r, ⟨-, rfl⟩⟩, + exact line_map_mem_affine_span_pair _ _ _ +end + +lemma wbtw_comm {x y z : P} : wbtw R x y z ↔ wbtw R z y x := +by rw [wbtw, wbtw, affine_segment_comm] + +alias wbtw_comm ↔ wbtw.symm _ + +lemma sbtw_comm {x y z : P} : sbtw R x y z ↔ sbtw R z y x := +by rw [sbtw, sbtw, wbtw_comm, ←and_assoc, ←and_assoc, and.right_comm] + +alias sbtw_comm ↔ sbtw.symm _ + +variables (R) + +@[simp] lemma wbtw_self_left (x y : P) : wbtw R x x y := +left_mem_affine_segment _ _ _ + +@[simp] lemma wbtw_self_right (x y : P) : wbtw R x y y := +right_mem_affine_segment _ _ _ + +@[simp] lemma wbtw_self_iff {x y : P} : wbtw R x y x ↔ y = x := +begin + refine ⟨λ h, _, λ h, _⟩, + { simpa [wbtw, affine_segment] using h }, + { rw h, + exact wbtw_self_left R x x } +end + +@[simp] lemma not_sbtw_self_left (x y : P) : ¬ sbtw R x x y := +λ h, h.ne_left rfl + +@[simp] lemma not_sbtw_self_right (x y : P) : ¬ sbtw R x y y := +λ h, h.ne_right rfl + +variables {R} + +lemma wbtw.left_ne_right_of_ne_left {x y z : P} (h : wbtw R x y z) (hne : y ≠ x) : x ≠ z := +begin + rintro rfl, + rw wbtw_self_iff at h, + exact hne h +end + +lemma wbtw.left_ne_right_of_ne_right {x y z : P} (h : wbtw R x y z) (hne : y ≠ z) : x ≠ z := +begin + rintro rfl, + rw wbtw_self_iff at h, + exact hne h +end + +lemma sbtw.left_ne_right {x y z : P} (h : sbtw R x y z) : x ≠ z := +h.wbtw.left_ne_right_of_ne_left h.2.1 + +lemma sbtw_iff_mem_image_Ioo_and_ne [no_zero_smul_divisors R V] {x y z : P} : + sbtw R x y z ↔ y ∈ line_map x z '' (set.Ioo (0 : R) 1) ∧ x ≠ z := +begin + refine ⟨λ h, ⟨h.mem_image_Ioo, h.left_ne_right⟩, λ h, _⟩, + rcases h with ⟨⟨t, ht, rfl⟩, hxz⟩, + refine ⟨⟨t, set.mem_Icc_of_Ioo ht, rfl⟩, _⟩, + rw [line_map_apply, ←@vsub_ne_zero V, ←@vsub_ne_zero V _ _ _ _ z, vadd_vsub_assoc, + vadd_vsub_assoc, ←neg_vsub_eq_vsub_rev z x, ←@neg_one_smul R, ←add_smul, + ←sub_eq_add_neg], + simp [smul_ne_zero, hxz.symm, sub_eq_zero, ht.1.ne.symm, ht.2.ne] +end + +variables (R) + +@[simp] lemma not_sbtw_self (x y : P) : ¬ sbtw R x y x := +λ h, h.left_ne_right rfl + +lemma wbtw_swap_left_iff [no_zero_smul_divisors R V] {x y : P} (z : P) : + (wbtw R x y z ∧ wbtw R y x z) ↔ x = y := +begin + split, + { rintro ⟨hxyz, hyxz⟩, + rcases hxyz with ⟨ty, hty, rfl⟩, + rcases hyxz with ⟨tx, htx, hx⟩, + simp_rw [line_map_apply, ←add_vadd] at hx, + rw [←@vsub_eq_zero_iff_eq V, vadd_vsub, vsub_vadd_eq_vsub_sub, smul_sub, smul_smul, + ←sub_smul, ←add_smul, smul_eq_zero] at hx, + rcases hx with h|h, + { nth_rewrite 0 ←mul_one tx at h, + rw [←mul_sub, add_eq_zero_iff_neg_eq] at h, + have h' : ty = 0, + { refine le_antisymm _ hty.1, + rw [←h, left.neg_nonpos_iff], + exact mul_nonneg htx.1 (sub_nonneg.2 hty.2) }, + simp [h'] }, + { rw vsub_eq_zero_iff_eq at h, + simp [h] } }, + { rintro rfl, + exact ⟨wbtw_self_left _ _ _, wbtw_self_left _ _ _⟩ } +end + +lemma wbtw_swap_right_iff [no_zero_smul_divisors R V] (x : P) {y z : P} : + (wbtw R x y z ∧ wbtw R x z y) ↔ y = z := +begin + nth_rewrite 0 wbtw_comm, + nth_rewrite 1 wbtw_comm, + rw eq_comm, + exact wbtw_swap_left_iff R x +end + +lemma wbtw_rotate_iff [no_zero_smul_divisors R V] (x : P) {y z : P} : + (wbtw R x y z ∧ wbtw R z x y) ↔ x = y := +by rw [wbtw_comm, wbtw_swap_right_iff, eq_comm] + +variables {R} + +lemma wbtw.swap_left_iff [no_zero_smul_divisors R V] {x y z : P} (h : wbtw R x y z) : + wbtw R y x z ↔ x = y := +by rw [←wbtw_swap_left_iff R z, and_iff_right h] + +lemma wbtw.swap_right_iff [no_zero_smul_divisors R V] {x y z : P} (h : wbtw R x y z) : + wbtw R x z y ↔ y = z := +by rw [←wbtw_swap_right_iff R x, and_iff_right h] + +lemma wbtw.rotate_iff [no_zero_smul_divisors R V] {x y z : P} (h : wbtw R x y z) : + wbtw R z x y ↔ x = y := +by rw [←wbtw_rotate_iff R x, and_iff_right h] + +lemma sbtw.not_swap_left [no_zero_smul_divisors R V] {x y z : P} (h : sbtw R x y z) : + ¬ wbtw R y x z := +λ hs, h.left_ne (h.wbtw.swap_left_iff.1 hs) + +lemma sbtw.not_swap_right [no_zero_smul_divisors R V] {x y z : P} (h : sbtw R x y z) : + ¬ wbtw R x z y := +λ hs, h.ne_right (h.wbtw.swap_right_iff.1 hs) + +lemma sbtw.not_rotate [no_zero_smul_divisors R V] {x y z : P} (h : sbtw R x y z) : + ¬ wbtw R z x y := +λ hs, h.left_ne (h.wbtw.rotate_iff.1 hs) + +@[simp] lemma wbtw_line_map_iff [no_zero_smul_divisors R V] {x y : P} {r : R} : + wbtw R x (line_map x y r) y ↔ x = y ∨ r ∈ set.Icc (0 : R) 1 := +begin + by_cases hxy : x = y, { simp [hxy] }, + rw [or_iff_right hxy, wbtw, affine_segment, (line_map_injective R hxy).mem_set_image] +end + +@[simp] lemma sbtw_line_map_iff [no_zero_smul_divisors R V] {x y : P} {r : R} : + sbtw R x (line_map x y r) y ↔ x ≠ y ∧ r ∈ set.Ioo (0 : R) 1 := +begin + rw [sbtw_iff_mem_image_Ioo_and_ne, and_comm, and_congr_right], + intro hxy, + rw (line_map_injective R hxy).mem_set_image +end + +omit V + +@[simp] lemma wbtw_mul_sub_add_iff [no_zero_divisors R] {x y r : R} : + wbtw R x (r * (y - x) + x) y ↔ x = y ∨ r ∈ set.Icc (0 : R) 1 := +wbtw_line_map_iff + +@[simp] lemma sbtw_mul_sub_add_iff [no_zero_divisors R] {x y r : R} : + sbtw R x (r * (y - x) + x) y ↔ x ≠ y ∧ r ∈ set.Ioo (0 : R) 1 := +sbtw_line_map_iff + +@[simp] lemma wbtw_zero_one_iff {x : R} : wbtw R 0 x 1 ↔ x ∈ set.Icc (0 : R) 1 := +begin + simp_rw [wbtw, affine_segment, set.mem_image, line_map_apply_ring], + simp +end + +@[simp] lemma wbtw_one_zero_iff {x : R} : wbtw R 1 x 0 ↔ x ∈ set.Icc (0 : R) 1 := +by rw [wbtw_comm, wbtw_zero_one_iff] + +@[simp] lemma sbtw_zero_one_iff {x : R} : sbtw R 0 x 1 ↔ x ∈ set.Ioo (0 : R) 1 := +begin + rw [sbtw, wbtw_zero_one_iff, set.mem_Icc, set.mem_Ioo], + exact ⟨λ h, ⟨h.1.1.lt_of_ne (ne.symm h.2.1), h.1.2.lt_of_ne h.2.2⟩, + λ h, ⟨⟨h.1.le, h.2.le⟩, h.1.ne', h.2.ne⟩⟩ +end + +@[simp] lemma sbtw_one_zero_iff {x : R} : sbtw R 1 x 0 ↔ x ∈ set.Ioo (0 : R) 1 := +by rw [sbtw_comm, sbtw_zero_one_iff] + +include V + +lemma wbtw.trans_left {w x y z : P} (h₁ : wbtw R w y z) (h₂ : wbtw R w x y) : wbtw R w x z := +begin + rcases h₁ with ⟨t₁, ht₁, rfl⟩, + rcases h₂ with ⟨t₂, ht₂, rfl⟩, + refine ⟨t₂ * t₁, ⟨mul_nonneg ht₂.1 ht₁.1, mul_le_one ht₂.2 ht₁.1 ht₁.2⟩, _⟩, + simp [line_map_apply, smul_smul] +end + +lemma wbtw.trans_right {w x y z : P} (h₁ : wbtw R w x z) (h₂ : wbtw R x y z) : wbtw R w y z := +begin + rw wbtw_comm at *, + exact h₁.trans_left h₂ +end + +lemma wbtw.trans_sbtw_left [no_zero_smul_divisors R V] {w x y z : P} (h₁ : wbtw R w y z) + (h₂ : sbtw R w x y) : sbtw R w x z := +begin + refine ⟨h₁.trans_left h₂.wbtw, h₂.ne_left, _⟩, + rintro rfl, + exact h₂.right_ne ((wbtw_swap_right_iff R w).1 ⟨h₁, h₂.wbtw⟩) +end + +lemma wbtw.trans_sbtw_right [no_zero_smul_divisors R V] {w x y z : P} (h₁ : wbtw R w x z) + (h₂ : sbtw R x y z) : sbtw R w y z := +begin + rw wbtw_comm at *, + rw sbtw_comm at *, + exact h₁.trans_sbtw_left h₂ +end + +lemma sbtw.trans_left [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R w y z) + (h₂ : sbtw R w x y) : sbtw R w x z := +h₁.wbtw.trans_sbtw_left h₂ + +lemma sbtw.trans_right [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R w x z) + (h₂ : sbtw R x y z) : sbtw R w y z := +h₁.wbtw.trans_sbtw_right h₂ + +lemma wbtw.trans_left_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : wbtw R w y z) + (h₂ : wbtw R w x y) (h : y ≠ z) : x ≠ z := +begin + rintro rfl, + exact h (h₁.swap_right_iff.1 h₂) +end + +lemma wbtw.trans_right_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : wbtw R w x z) + (h₂ : wbtw R x y z) (h : w ≠ x) : w ≠ y := +begin + rintro rfl, + exact h (h₁.swap_left_iff.1 h₂) +end + +lemma sbtw.trans_wbtw_left_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R w y z) + (h₂ : wbtw R w x y) : x ≠ z := +h₁.wbtw.trans_left_ne h₂ h₁.ne_right + +lemma sbtw.trans_wbtw_right_ne [no_zero_smul_divisors R V] {w x y z : P} (h₁ : sbtw R w x z) + (h₂ : wbtw R x y z) : w ≠ y := +h₁.wbtw.trans_right_ne h₂ h₁.left_ne + +lemma sbtw.affine_combination_of_mem_affine_span_pair [no_zero_divisors R] + [no_zero_smul_divisors R V] {ι : Type*} {p : ι → P} (ha : affine_independent R p) + {w w₁ w₂ : ι → R} {s : finset ι} (hw : ∑ i in s, w i = 1) (hw₁ : ∑ i in s, w₁ i = 1) + (hw₂ : ∑ i in s, w₂ i = 1) + (h : s.affine_combination R p w ∈ + line[R, s.affine_combination R p w₁, s.affine_combination R p w₂]) + {i : ι} (his : i ∈ s) (hs : sbtw R (w₁ i) (w i) (w₂ i)) : + sbtw R (s.affine_combination R p w₁) (s.affine_combination R p w) (s.affine_combination R p w₂) := +begin + rw affine_combination_mem_affine_span_pair ha hw hw₁ hw₂ at h, + rcases h with ⟨r, hr⟩, + dsimp only at hr, + rw [hr i his, sbtw_mul_sub_add_iff] at hs, + change ∀ i ∈ s, w i = ((r • (w₂ - w₁) + w₁) i) at hr, + rw s.affine_combination_congr hr (λ _ _, rfl), + dsimp only, + rw [←s.weighted_vsub_vadd_affine_combination, s.weighted_vsub_const_smul, + ←s.affine_combination_vsub, ←line_map_apply, sbtw_line_map_iff, and_iff_left hs.2, + ←@vsub_ne_zero V, s.affine_combination_vsub], + intro hz, + have hw₁w₂ : ∑ i in s, (w₁ - w₂) i = 0, + { simp_rw [pi.sub_apply, finset.sum_sub_distrib, hw₁, hw₂, sub_self] }, + refine hs.1 _, + have ha' := ha s (w₁ - w₂) hw₁w₂ hz i his, + rwa [pi.sub_apply, sub_eq_zero] at ha' +end + +end ordered_ring + +section strict_ordered_comm_ring +variables [strict_ordered_comm_ring R] [add_comm_group V] [module R V] [add_torsor V P] + +include V + +variables {R} + +lemma wbtw.same_ray_vsub {x y z : P} (h : wbtw R x y z) : same_ray R (y -ᵥ x) (z -ᵥ y) := +begin + rcases h with ⟨t, ⟨ht0, ht1⟩, rfl⟩, + simp_rw line_map_apply, + rcases ht0.lt_or_eq with ht0' | rfl, swap, { simp }, + rcases ht1.lt_or_eq with ht1' | rfl, swap, { simp }, + refine or.inr (or.inr ⟨1 - t, t, sub_pos.2 ht1', ht0', _⟩), + simp [vsub_vadd_eq_vsub_sub, smul_sub, smul_smul, ←sub_smul], + ring_nf +end + +lemma wbtw.same_ray_vsub_left {x y z : P} (h : wbtw R x y z) : same_ray R (y -ᵥ x) (z -ᵥ x) := +begin + rcases h with ⟨t, ⟨ht0, ht1⟩, rfl⟩, + simpa [line_map_apply] using same_ray_nonneg_smul_left (z -ᵥ x) ht0 +end + +lemma wbtw.same_ray_vsub_right {x y z : P} (h : wbtw R x y z) : same_ray R (z -ᵥ x) (z -ᵥ y) := +begin + rcases h with ⟨t, ⟨ht0, ht1⟩, rfl⟩, + simpa [line_map_apply, vsub_vadd_eq_vsub_sub, sub_smul] using + same_ray_nonneg_smul_right (z -ᵥ x) (sub_nonneg.2 ht1) +end + +end strict_ordered_comm_ring + +section linear_ordered_ring + +variables [linear_ordered_ring R] [add_comm_group V] [module R V] [add_torsor V P] + +include V + +variables {R} + +/-- Suppose lines from two vertices of a triangle to interior points of the opposite side meet at +`p`. Then `p` lies in the interior of the first (and by symmetry the other) segment from a +vertex to the point on the opposite side. -/ +lemma sbtw_of_sbtw_of_sbtw_of_mem_affine_span_pair [no_zero_smul_divisors R V] + {t : affine.triangle R P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂) {p₁ p₂ p : P} + (h₁ : sbtw R (t.points i₂) p₁ (t.points i₃)) (h₂ : sbtw R (t.points i₁) p₂ (t.points i₃)) + (h₁' : p ∈ line[R, t.points i₁, p₁]) (h₂' : p ∈ line[R, t.points i₂, p₂]) : + sbtw R (t.points i₁) p p₁ := +begin + -- Should not be needed; see comments on local instances in `data.sign`. + letI : decidable_rel ((<) : R → R → Prop) := linear_ordered_ring.decidable_lt, + have h₁₃ : i₁ ≠ i₃, { rintro rfl, simpa using h₂ }, + have h₂₃ : i₂ ≠ i₃, { rintro rfl, simpa using h₁ }, + have h3 : ∀ i : fin 3, i = i₁ ∨ i = i₂ ∨ i = i₃, { clear h₁ h₂ h₁' h₂', dec_trivial! }, + have hu : (finset.univ : finset (fin 3)) = {i₁, i₂, i₃}, { clear h₁ h₂ h₁' h₂', dec_trivial! }, + have hp : p ∈ affine_span R (set.range t.points), + { have hle : line[R, t.points i₁, p₁] ≤ affine_span R (set.range t.points), + { refine affine_span_pair_le_of_mem_of_mem (mem_affine_span _ (set.mem_range_self _)) _, + have hle : line[R, t.points i₂, t.points i₃] ≤ affine_span R (set.range t.points), + { refine affine_span_mono _ _, simp [set.insert_subset] }, + rw affine_subspace.le_def' at hle, + exact hle _ h₁.wbtw.mem_affine_span }, + rw affine_subspace.le_def' at hle, + exact hle _ h₁' }, + have h₁i := h₁.mem_image_Ioo, + have h₂i := h₂.mem_image_Ioo, + rw set.mem_image at h₁i h₂i, + rcases h₁i with ⟨r₁, ⟨hr₁0, hr₁1⟩, rfl⟩, + rcases h₂i with ⟨r₂, ⟨hr₂0, hr₂1⟩, rfl⟩, + rcases eq_affine_combination_of_mem_affine_span_of_fintype hp with ⟨w, hw, rfl⟩, + have h₁s := sign_eq_of_affine_combination_mem_affine_span_single_line_map t.independent hw + (finset.mem_univ _) (finset.mem_univ _) (finset.mem_univ _) h₁₂ h₁₃ h₂₃ hr₁0 hr₁1 h₁', + have h₂s := sign_eq_of_affine_combination_mem_affine_span_single_line_map t.independent hw + (finset.mem_univ _) (finset.mem_univ _) (finset.mem_univ _) h₁₂.symm h₂₃ h₁₃ hr₂0 hr₂1 h₂', + dsimp only at h₁s h₂s, + rw [←finset.univ.affine_combination_affine_combination_single_weights R t.points + (finset.mem_univ i₁), + ←finset.univ.affine_combination_affine_combination_line_map_weights t.points + (finset.mem_univ _) (finset.mem_univ _)] at ⊢ h₁', + refine sbtw.affine_combination_of_mem_affine_span_pair t.independent hw + (finset.univ.sum_affine_combination_single_weights R (finset.mem_univ _)) + (finset.univ.sum_affine_combination_line_map_weights (finset.mem_univ _) (finset.mem_univ _) _) + h₁' (finset.mem_univ i₁) _, + rw [finset.affine_combination_single_weights_apply_self, + finset.affine_combination_line_map_weights_apply_of_ne h₁₂ h₁₃, sbtw_one_zero_iff], + have hs : ∀ i : fin 3, sign (w i) = sign (w i₃), + { intro i, + rcases h3 i with rfl | rfl | rfl, + { exact h₂s }, + { exact h₁s }, + { refl } }, + have hss : sign (∑ i, w i) = 1, { simp [hw] }, + have hs' := sign_sum (finset.univ_nonempty) (sign (w i₃)) (λ i _, hs i), + rw hs' at hss, + simp_rw [hss, sign_eq_one_iff] at hs, + refine ⟨hs i₁, _⟩, + rw hu at hw, + rw [finset.sum_insert, finset.sum_insert, finset.sum_singleton] at hw, + { by_contra hle, + rw not_lt at hle, + exact (hle.trans_lt (lt_add_of_pos_right _ (left.add_pos (hs i₂) (hs i₃)))).ne' hw }, + { simp [h₂₃] }, + { simp [h₁₂, h₁₃] } +end + +end linear_ordered_ring + +section linear_ordered_field + +variables [linear_ordered_field R] [add_comm_group V] [module R V] [add_torsor V P] + +include V + +variables {R} + +lemma wbtw_iff_left_eq_or_right_mem_image_Ici {x y z : P} : + wbtw R x y z ↔ x = y ∨ z ∈ line_map x y '' (set.Ici (1 : R)) := +begin + refine ⟨λ h, _, λ h, _⟩, + { rcases h with ⟨r, ⟨hr0, hr1⟩, rfl⟩, + rcases hr0.lt_or_eq with hr0' | rfl, + { rw set.mem_image, + refine or.inr ⟨r⁻¹, one_le_inv hr0' hr1, _⟩, + simp only [line_map_apply, smul_smul, vadd_vsub], + rw [inv_mul_cancel hr0'.ne', one_smul, vsub_vadd] }, + { simp } }, + { rcases h with rfl | ⟨r, ⟨hr, rfl⟩⟩, + { exact wbtw_self_left _ _ _ }, + { rw set.mem_Ici at hr, + refine ⟨r⁻¹, ⟨inv_nonneg.2 (zero_le_one.trans hr), inv_le_one hr⟩, _⟩, + simp only [line_map_apply, smul_smul, vadd_vsub], + rw [inv_mul_cancel (one_pos.trans_le hr).ne', one_smul, vsub_vadd] } } +end + +lemma wbtw.right_mem_image_Ici_of_left_ne {x y z : P} (h : wbtw R x y z) (hne : x ≠ y) : + z ∈ line_map x y '' (set.Ici (1 : R)) := +(wbtw_iff_left_eq_or_right_mem_image_Ici.1 h).resolve_left hne + +lemma wbtw.right_mem_affine_span_of_left_ne {x y z : P} (h : wbtw R x y z) (hne : x ≠ y) : + z ∈ line[R, x, y] := +begin + rcases h.right_mem_image_Ici_of_left_ne hne with ⟨r, ⟨-, rfl⟩⟩, + exact line_map_mem_affine_span_pair _ _ _ +end + +lemma sbtw_iff_left_ne_and_right_mem_image_IoI {x y z : P} : + sbtw R x y z ↔ x ≠ y ∧ z ∈ line_map x y '' (set.Ioi (1 : R)) := +begin + refine ⟨λ h, ⟨h.left_ne, _⟩, λ h, _⟩, + { obtain ⟨r, ⟨hr, rfl⟩⟩ := h.wbtw.right_mem_image_Ici_of_left_ne h.left_ne, + rw [set.mem_Ici] at hr, + rcases hr.lt_or_eq with hrlt | rfl, + { exact set.mem_image_of_mem _ hrlt }, + { exfalso, simpa using h } }, + { rcases h with ⟨hne, r, hr, rfl⟩, + rw set.mem_Ioi at hr, + refine ⟨wbtw_iff_left_eq_or_right_mem_image_Ici.2 (or.inr (set.mem_image_of_mem _ + (set.mem_of_mem_of_subset hr set.Ioi_subset_Ici_self))), hne.symm, _⟩, + rw [line_map_apply, ←@vsub_ne_zero V, vsub_vadd_eq_vsub_sub], + nth_rewrite 0 ←one_smul R (y -ᵥ x), + rw [←sub_smul, smul_ne_zero_iff, vsub_ne_zero, sub_ne_zero], + exact ⟨hr.ne, hne.symm⟩ } +end + +lemma sbtw.right_mem_image_Ioi {x y z : P} (h : sbtw R x y z) : + z ∈ line_map x y '' (set.Ioi (1 : R)) := +(sbtw_iff_left_ne_and_right_mem_image_IoI.1 h).2 + +lemma sbtw.right_mem_affine_span {x y z : P} (h : sbtw R x y z) : z ∈ line[R, x, y] := +h.wbtw.right_mem_affine_span_of_left_ne h.left_ne + +lemma wbtw_iff_right_eq_or_left_mem_image_Ici {x y z : P} : + wbtw R x y z ↔ z = y ∨ x ∈ line_map z y '' (set.Ici (1 : R)) := +by rw [wbtw_comm, wbtw_iff_left_eq_or_right_mem_image_Ici] + +lemma wbtw.left_mem_image_Ici_of_right_ne {x y z : P} (h : wbtw R x y z) (hne : z ≠ y) : + x ∈ line_map z y '' (set.Ici (1 : R)) := +h.symm.right_mem_image_Ici_of_left_ne hne + +lemma wbtw.left_mem_affine_span_of_right_ne {x y z : P} (h : wbtw R x y z) (hne : z ≠ y) : + x ∈ line[R, z, y] := +h.symm.right_mem_affine_span_of_left_ne hne + +lemma sbtw_iff_right_ne_and_left_mem_image_IoI {x y z : P} : + sbtw R x y z ↔ z ≠ y ∧ x ∈ line_map z y '' (set.Ioi (1 : R)) := +by rw [sbtw_comm, sbtw_iff_left_ne_and_right_mem_image_IoI] + +lemma sbtw.left_mem_image_Ioi {x y z : P} (h : sbtw R x y z) : + x ∈ line_map z y '' (set.Ioi (1 : R)) := +h.symm.right_mem_image_Ioi + +lemma sbtw.left_mem_affine_span {x y z : P} (h : sbtw R x y z) : x ∈ line[R, z, y] := +h.symm.right_mem_affine_span + +lemma wbtw_smul_vadd_smul_vadd_of_nonneg_of_le (x : P) (v : V) {r₁ r₂ : R} (hr₁ : 0 ≤ r₁) + (hr₂ : r₁ ≤ r₂) : wbtw R x (r₁ • v +ᵥ x) (r₂ • v +ᵥ x) := +begin + refine ⟨r₁ / r₂, ⟨div_nonneg hr₁ (hr₁.trans hr₂), div_le_one_of_le hr₂ (hr₁.trans hr₂)⟩, _⟩, + by_cases h : r₁ = 0, { simp [h] }, + simp [line_map_apply, smul_smul, ((hr₁.lt_of_ne' h).trans_le hr₂).ne.symm] +end + +lemma wbtw_or_wbtw_smul_vadd_of_nonneg (x : P) (v : V) {r₁ r₂ : R} (hr₁ : 0 ≤ r₁) (hr₂ : 0 ≤ r₂) : + wbtw R x (r₁ • v +ᵥ x) (r₂ • v +ᵥ x) ∨ wbtw R x (r₂ • v +ᵥ x) (r₁ • v +ᵥ x) := +begin + rcases le_total r₁ r₂ with h|h, + { exact or.inl (wbtw_smul_vadd_smul_vadd_of_nonneg_of_le x v hr₁ h) }, + { exact or.inr (wbtw_smul_vadd_smul_vadd_of_nonneg_of_le x v hr₂ h) } +end + +lemma wbtw_smul_vadd_smul_vadd_of_nonpos_of_le (x : P) (v : V) {r₁ r₂ : R} (hr₁ : r₁ ≤ 0) + (hr₂ : r₂ ≤ r₁) : wbtw R x (r₁ • v +ᵥ x) (r₂ • v +ᵥ x) := +begin + convert wbtw_smul_vadd_smul_vadd_of_nonneg_of_le x (-v) (left.nonneg_neg_iff.2 hr₁) + (neg_le_neg_iff.2 hr₂) using 1; + rw neg_smul_neg +end + +lemma wbtw_or_wbtw_smul_vadd_of_nonpos (x : P) (v : V) {r₁ r₂ : R} (hr₁ : r₁ ≤ 0) (hr₂ : r₂ ≤ 0) : + wbtw R x (r₁ • v +ᵥ x) (r₂ • v +ᵥ x) ∨ wbtw R x (r₂ • v +ᵥ x) (r₁ • v +ᵥ x) := +begin + rcases le_total r₁ r₂ with h|h, + { exact or.inr (wbtw_smul_vadd_smul_vadd_of_nonpos_of_le x v hr₂ h) }, + { exact or.inl (wbtw_smul_vadd_smul_vadd_of_nonpos_of_le x v hr₁ h) } +end + +lemma wbtw_smul_vadd_smul_vadd_of_nonpos_of_nonneg (x : P) (v : V) {r₁ r₂ : R} (hr₁ : r₁ ≤ 0) + (hr₂ : 0 ≤ r₂) : wbtw R (r₁ • v +ᵥ x) x (r₂ • v +ᵥ x) := +begin + convert wbtw_smul_vadd_smul_vadd_of_nonneg_of_le (r₁ • v +ᵥ x) v (left.nonneg_neg_iff.2 hr₁) + (neg_le_sub_iff_le_add.2 ((le_add_iff_nonneg_left r₁).2 hr₂)) using 1; + simp [sub_smul, ←add_vadd] +end + +lemma wbtw_smul_vadd_smul_vadd_of_nonneg_of_nonpos (x : P) (v : V) {r₁ r₂ : R} (hr₁ : 0 ≤ r₁) + (hr₂ : r₂ ≤ 0) : wbtw R (r₁ • v +ᵥ x) x (r₂ • v +ᵥ x) := +begin + rw wbtw_comm, + exact wbtw_smul_vadd_smul_vadd_of_nonpos_of_nonneg x v hr₂ hr₁ +end + +lemma wbtw.trans_left_right {w x y z : P} (h₁ : wbtw R w y z) (h₂ : wbtw R w x y) : wbtw R x y z := +begin + rcases h₁ with ⟨t₁, ht₁, rfl⟩, + rcases h₂ with ⟨t₂, ht₂, rfl⟩, + refine ⟨(t₁ - t₂ * t₁) / (1 - t₂ * t₁), + ⟨div_nonneg (sub_nonneg.2 (mul_le_of_le_one_left ht₁.1 ht₂.2)) + (sub_nonneg.2 (mul_le_one ht₂.2 ht₁.1 ht₁.2)), + div_le_one_of_le (sub_le_sub_right ht₁.2 _) + (sub_nonneg.2 (mul_le_one ht₂.2 ht₁.1 ht₁.2))⟩, _⟩, + simp only [line_map_apply, smul_smul, ←add_vadd, vsub_vadd_eq_vsub_sub, smul_sub, ←sub_smul, + ←add_smul, vadd_vsub, vadd_right_cancel_iff, div_mul_eq_mul_div, div_sub_div_same], + nth_rewrite 0 [←mul_one (t₁ - t₂ * t₁)], + rw [←mul_sub, mul_div_assoc], + by_cases h : 1 - t₂ * t₁ = 0, + { rw [sub_eq_zero, eq_comm] at h, + rw h, + suffices : t₁ = 1, by simp [this], + exact eq_of_le_of_not_lt ht₁.2 + (λ ht₁lt, (mul_lt_one_of_nonneg_of_lt_one_right ht₂.2 ht₁.1 ht₁lt).ne h) }, + { rw div_self h, + ring_nf } +end + +lemma wbtw.trans_right_left {w x y z : P} (h₁ : wbtw R w x z) (h₂ : wbtw R x y z) : wbtw R w x y := +begin + rw wbtw_comm at *, + exact h₁.trans_left_right h₂ +end + +lemma sbtw.trans_left_right {w x y z : P} (h₁ : sbtw R w y z) (h₂ : sbtw R w x y) : sbtw R x y z := +⟨h₁.wbtw.trans_left_right h₂.wbtw, h₂.right_ne, h₁.ne_right⟩ + +lemma sbtw.trans_right_left {w x y z : P} (h₁ : sbtw R w x z) (h₂ : sbtw R x y z) : sbtw R w x y := +⟨h₁.wbtw.trans_right_left h₂.wbtw, h₁.ne_left, h₂.left_ne⟩ + +lemma wbtw.collinear {x y z : P} (h : wbtw R x y z) : collinear R ({x, y, z} : set P) := +begin + rw collinear_iff_exists_forall_eq_smul_vadd, + refine ⟨x, z -ᵥ x, _⟩, + intros p hp, + simp_rw [set.mem_insert_iff, set.mem_singleton_iff] at hp, + rcases hp with rfl|rfl|rfl, + { refine ⟨0, _⟩, simp }, + { rcases h with ⟨t, -, rfl⟩, + exact ⟨t, rfl⟩ }, + { refine ⟨1, _⟩, simp } +end + +lemma collinear.wbtw_or_wbtw_or_wbtw {x y z : P} (h : collinear R ({x, y, z} : set P)) : + wbtw R x y z ∨ wbtw R y z x ∨ wbtw R z x y := +begin + rw collinear_iff_of_mem (set.mem_insert _ _) at h, + rcases h with ⟨v, h⟩, + simp_rw [set.mem_insert_iff, set.mem_singleton_iff] at h, + have hy := h y (or.inr (or.inl rfl)), + have hz := h z (or.inr (or.inr rfl)), + rcases hy with ⟨ty, rfl⟩, + rcases hz with ⟨tz, rfl⟩, + rcases lt_trichotomy ty 0 with hy0|rfl|hy0, + { rcases lt_trichotomy tz 0 with hz0|rfl|hz0, + { nth_rewrite 1 wbtw_comm, + rw ←or_assoc, + exact or.inl (wbtw_or_wbtw_smul_vadd_of_nonpos _ _ hy0.le hz0.le) }, + { simp }, + { exact or.inr (or.inr (wbtw_smul_vadd_smul_vadd_of_nonneg_of_nonpos _ _ hz0.le hy0.le)) } }, + { simp }, + { rcases lt_trichotomy tz 0 with hz0|rfl|hz0, + { refine or.inr (or.inr (wbtw_smul_vadd_smul_vadd_of_nonpos_of_nonneg _ _ hz0.le hy0.le)) }, + { simp }, + { nth_rewrite 1 wbtw_comm, + rw ←or_assoc, + exact or.inl (wbtw_or_wbtw_smul_vadd_of_nonneg _ _ hy0.le hz0.le) } } +end + +lemma wbtw_iff_same_ray_vsub {x y z : P} : wbtw R x y z ↔ same_ray R (y -ᵥ x) (z -ᵥ y) := +begin + refine ⟨wbtw.same_ray_vsub, λ h, _⟩, + rcases h with h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩, + { rw vsub_eq_zero_iff_eq at h, simp [h] }, + { rw vsub_eq_zero_iff_eq at h, simp [h] }, + { refine ⟨r₂ / (r₁ + r₂), + ⟨div_nonneg hr₂.le (add_nonneg hr₁.le hr₂.le), + div_le_one_of_le (le_add_of_nonneg_left hr₁.le) (add_nonneg hr₁.le hr₂.le)⟩, _⟩, + have h' : z = r₂⁻¹ • r₁ • (y -ᵥ x) +ᵥ y, { simp [h, hr₂.ne'] }, + rw eq_comm, + simp only [line_map_apply, h', vadd_vsub_assoc, smul_smul, ←add_smul, eq_vadd_iff_vsub_eq, + smul_add], + convert (one_smul _ _).symm, + field_simp [(add_pos hr₁ hr₂).ne', hr₂.ne'], + ring } +end + +variables (R) + +lemma wbtw_point_reflection (x y : P) : wbtw R y x (point_reflection R x y) := +begin + refine ⟨2⁻¹, ⟨by norm_num, by norm_num⟩, _⟩, + rw [line_map_apply, point_reflection_apply, vadd_vsub_assoc, ←two_smul R (x -ᵥ y)], + simp +end + +lemma sbtw_point_reflection_of_ne {x y : P} (h : x ≠ y) : sbtw R y x (point_reflection R x y) := +begin + refine ⟨wbtw_point_reflection _ _ _, h, _⟩, + nth_rewrite 0 [←point_reflection_self R x], + exact (point_reflection_involutive R x).injective.ne h +end + +lemma wbtw_midpoint (x y : P) : wbtw R x (midpoint R x y) y := +by { convert wbtw_point_reflection R (midpoint R x y) x, simp } + +lemma sbtw_midpoint_of_ne {x y : P} (h : x ≠ y) : sbtw R x (midpoint R x y) y := +begin + have h : midpoint R x y ≠ x, { simp [h] }, + convert sbtw_point_reflection_of_ne R h, + simp +end + +end linear_ordered_field diff --git a/src/analysis/convex/body.lean b/src/analysis/convex/body.lean new file mode 100644 index 0000000000000..bba94350b7b54 --- /dev/null +++ b/src/analysis/convex/body.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2022 Paul A. Reichert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Paul A. Reichert +-/ +import analysis.convex.basic +import analysis.normed_space.basic +import topology.metric_space.hausdorff_distance + +/-! +# Convex bodies + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains the definition of the type `convex_body V` +consisting of +convex, compact, nonempty subsets of a real topological vector space `V`. + +`convex_body V` is a module over the nonnegative reals (`nnreal`) and a pseudo-metric space. +If `V` is a normed space, `convex_body V` is a metric space. + +## TODO + +- define positive convex bodies, requiring the interior to be nonempty +- introduce support sets +- Characterise the interaction of the distance with algebraic operations, eg + `dist (a • K) (a • L) = ‖a‖ * dist K L`, `dist (a +ᵥ K) (a +ᵥ L) = dist K L` + +## Tags + +convex, convex body +-/ + +open_locale pointwise +open_locale nnreal + +variables {V : Type*} + +/-- +Let `V` be a real topological vector space. A subset of `V` is a convex body if and only if +it is convex, compact, and nonempty. +-/ +structure convex_body (V : Type*) [topological_space V] [add_comm_monoid V] [has_smul ℝ V] := +(carrier : set V) +(convex' : convex ℝ carrier) +(is_compact' : is_compact carrier) +(nonempty' : carrier.nonempty) + +namespace convex_body +section TVS +variables [topological_space V] [add_comm_group V] [module ℝ V] + +instance : set_like (convex_body V) V := +{ coe := convex_body.carrier, + coe_injective' := λ K L h, by { cases K, cases L, congr' } } + +protected lemma convex (K : convex_body V) : convex ℝ (K : set V) := K.convex' +protected lemma is_compact (K : convex_body V) : is_compact (K : set V) := K.is_compact' +protected lemma nonempty (K : convex_body V) : (K : set V).nonempty := K.nonempty' + +@[ext] +protected lemma ext {K L : convex_body V} (h : (K : set V) = L) : K = L := set_like.ext' h + +@[simp] +lemma coe_mk (s : set V) (h₁ h₂ h₃) : (mk s h₁ h₂ h₃ : set V) = s := rfl + +section has_continuous_add +variables [has_continuous_add V] + +instance : add_monoid (convex_body V) := +-- we cannot write K + L to avoid reducibility issues with the set.has_add instance +{ add := λ K L, ⟨set.image2 (+) K L, + K.convex.add L.convex, + K.is_compact.add L.is_compact, + K.nonempty.add L.nonempty⟩, + add_assoc := λ K L M, by { ext, simp only [coe_mk, set.image2_add, add_assoc] }, + zero := ⟨0, convex_singleton 0, is_compact_singleton, set.singleton_nonempty 0⟩, + zero_add := λ K, by { ext, simp only [coe_mk, set.image2_add, zero_add] }, + add_zero := λ K, by { ext, simp only [coe_mk, set.image2_add, add_zero] } } + +@[simp] +lemma coe_add (K L : convex_body V) : (↑(K + L) : set V) = (K : set V) + L := rfl + +@[simp] +lemma coe_zero : (↑(0 : convex_body V) : set V) = 0 := rfl + +instance : inhabited (convex_body V) := ⟨0⟩ + +instance : add_comm_monoid (convex_body V) := +{ add_comm := λ K L, by { ext, simp only [coe_add, add_comm] }, + .. convex_body.add_monoid } + +end has_continuous_add + +variables [has_continuous_smul ℝ V] + +instance : has_smul ℝ (convex_body V) := +{ smul := λ c K, ⟨c • (K : set V), K.convex.smul _, K.is_compact.smul _, K.nonempty.smul_set⟩ } + +@[simp] +lemma coe_smul (c : ℝ) (K : convex_body V) : (↑(c • K) : set V) = c • (K : set V) := rfl + +variables [has_continuous_add V] + +instance : distrib_mul_action ℝ (convex_body V) := +{ to_has_smul := convex_body.has_smul, + one_smul := λ K, by { ext, simp only [coe_smul, one_smul] }, + mul_smul := λ c d K, by { ext, simp only [coe_smul, mul_smul] }, + smul_add := λ c K L, by { ext, simp only [coe_smul, coe_add, smul_add] }, + smul_zero := λ c, by { ext, simp only [coe_smul, coe_zero, smul_zero] } } + +@[simp] +lemma coe_smul' (c : ℝ≥0) (K : convex_body V) : (↑(c • K) : set V) = c • (K : set V) := rfl + +/-- +The convex bodies in a fixed space $V$ form a module over the nonnegative reals. +-/ +instance : module ℝ≥0 (convex_body V) := +{ add_smul := λ c d K, + begin + ext1, + simp only [coe_smul, coe_add], + exact convex.add_smul K.convex (nnreal.coe_nonneg _) (nnreal.coe_nonneg _), + end, + zero_smul := λ K, by { ext1, exact set.zero_smul_set K.nonempty } } + +end TVS + +section seminormed_add_comm_group +variables [seminormed_add_comm_group V] [normed_space ℝ V] (K L : convex_body V) + +protected lemma bounded : metric.bounded (K : set V) := K.is_compact.bounded + +lemma Hausdorff_edist_ne_top {K L : convex_body V} : emetric.Hausdorff_edist (K : set V) L ≠ ⊤ := +by apply_rules [metric.Hausdorff_edist_ne_top_of_nonempty_of_bounded, convex_body.nonempty, + convex_body.bounded] + +/-- Convex bodies in a fixed seminormed space $V$ form a pseudo-metric space under the Hausdorff +metric. -/ +noncomputable instance : pseudo_metric_space (convex_body V) := +{ dist := λ K L, metric.Hausdorff_dist (K : set V) L, + dist_self := λ _, metric.Hausdorff_dist_self_zero, + dist_comm := λ _ _, metric.Hausdorff_dist_comm, + dist_triangle := λ K L M, metric.Hausdorff_dist_triangle Hausdorff_edist_ne_top } + +@[simp, norm_cast] +lemma Hausdorff_dist_coe : metric.Hausdorff_dist (K : set V) L = dist K L := rfl + +@[simp, norm_cast] lemma Hausdorff_edist_coe : emetric.Hausdorff_edist (K : set V) L = edist K L := +by { rw edist_dist, exact (ennreal.of_real_to_real Hausdorff_edist_ne_top).symm } + +end seminormed_add_comm_group + +section normed_add_comm_group +variables [normed_add_comm_group V] [normed_space ℝ V] + +/-- Convex bodies in a fixed normed space `V` form a metric space under the Hausdorff metric. -/ +noncomputable instance : metric_space (convex_body V) := +{ eq_of_dist_eq_zero := λ K L hd, convex_body.ext $ + (K.is_compact.is_closed.Hausdorff_dist_zero_iff_eq + L.is_compact.is_closed Hausdorff_edist_ne_top).mp hd } + +end normed_add_comm_group +end convex_body diff --git a/src/analysis/convex/caratheodory.lean b/src/analysis/convex/caratheodory.lean index 1ffbb069d37cd..850b28641e0d3 100644 --- a/src/analysis/convex/caratheodory.lean +++ b/src/analysis/convex/caratheodory.lean @@ -10,6 +10,9 @@ import tactic.field_simp /-! # Carathéodory's convexity theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Convex hull can be regarded as a refinement of affine span. Both are closure operators but whereas convex hull takes values in the lattice of convex subsets, affine span takes values in the much coarser sublattice of affine subspaces. diff --git a/src/analysis/convex/combination.lean b/src/analysis/convex/combination.lean index 6ca98dd4f3f06..15443b1b1fa4f 100644 --- a/src/analysis/convex/combination.lean +++ b/src/analysis/convex/combination.lean @@ -10,6 +10,9 @@ import linear_algebra.affine_space.basis /-! # Convex combinations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines convex combinations of points in a vector space. ## Main declarations @@ -23,12 +26,13 @@ mathematical arguments go: one doesn't change weights, but merely adds some. Thi lemmas unconditional on the sum of the weights being `1`. -/ -open set -open_locale big_operators classical +open set function +open_locale big_operators classical pointwise universes u u' -variables {R E F ι ι' : Type*} [linear_ordered_field R] [add_comm_group E] [add_comm_group F] - [module R E] [module R F] {s : set E} +variables {R E F ι ι' α : Type*} [linear_ordered_field R] [add_comm_group E] [add_comm_group F] + [linear_ordered_add_comm_group α] [module R E] [module R F] [module R α] [ordered_smul R α] + {s : set E} /-- Center of mass of a finite collection of points with prescribed weights. Note that we require neither `0 ≤ w i` nor `∑ w = 1`. -/ @@ -73,9 +77,7 @@ lemma finset.center_mass_segment' (s : finset ι) (t : finset ι') (ws : ι → R) (zs : ι → E) (wt : ι' → R) (zt : ι' → E) (hws : ∑ i in s, ws i = 1) (hwt : ∑ i in t, wt i = 1) (a b : R) (hab : a + b = 1) : a • s.center_mass ws zs + b • t.center_mass wt zt = - (s.map function.embedding.inl ∪ t.map function.embedding.inr).center_mass - (sum.elim (λ i, a * ws i) (λ j, b * wt j)) - (sum.elim zs zt) := + (s.disj_sum t).center_mass (sum.elim (λ i, a * ws i) (λ j, b * wt j)) (sum.elim zs zt) := begin rw [s.center_mass_eq_of_sum_1 _ hws, t.center_mass_eq_of_sum_1 _ hwt, smul_sum, smul_sum, ← finset.sum_sum_elim, finset.center_mass_eq_of_sum_1], @@ -121,6 +123,25 @@ lemma finset.center_mass_filter_ne_zero : finset.center_mass_subset z (filter_subset _ _) $ λ i hit hit', by simpa only [hit, mem_filter, true_and, ne.def, not_not] using hit' +namespace finset + +lemma center_mass_le_sup {s : finset ι} {f : ι → α} {w : ι → R} + (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : 0 < ∑ i in s, w i) : + s.center_mass w f ≤ s.sup' (nonempty_of_ne_empty $ by { rintro rfl, simpa using hw₁ }) f := +begin + rw [center_mass, inv_smul_le_iff hw₁, sum_smul], + exact sum_le_sum (λ i hi, smul_le_smul_of_nonneg (le_sup' _ hi) $ hw₀ i hi), + apply_instance, +end + +lemma inf_le_center_mass {s : finset ι} {f : ι → α} {w : ι → R} + (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : 0 < ∑ i in s, w i) : + s.inf' (nonempty_of_ne_empty $ by { rintro rfl, simpa using hw₁ }) f ≤ s.center_mass w f := +@center_mass_le_sup R _ αᵒᵈ _ _ _ _ _ _ _ hw₀ hw₁ + +end finset + + variable {z} /-- The center of mass of a finite subset of a convex set belongs to the set @@ -153,13 +174,33 @@ lemma convex.sum_mem (hs : convex R s) (h₀ : ∀ i ∈ t, 0 ≤ w i) (h₁ : by simpa only [h₁, center_mass, inv_one, one_smul] using hs.center_mass_mem h₀ (h₁.symm ▸ zero_lt_one) hz +/-- A version of `convex.sum_mem` for `finsum`s. If `s` is a convex set, `w : ι → R` is a family of +nonnegative weights with sum one and `z : ι → E` is a family of elements of a module over `R` such +that `z i ∈ s` whenever `w i ≠ 0``, then the sum `∑ᶠ i, w i • z i` belongs to `s`. See also +`partition_of_unity.finsum_smul_mem_convex`. -/ +lemma convex.finsum_mem {ι : Sort*} {w : ι → R} {z : ι → E} {s : set E} + (hs : convex R s) (h₀ : ∀ i, 0 ≤ w i) (h₁ : ∑ᶠ i, w i = 1) (hz : ∀ i, w i ≠ 0 → z i ∈ s) : + ∑ᶠ i, w i • z i ∈ s := +begin + have hfin_w : (support (w ∘ plift.down)).finite, + { by_contra H, + rw [finsum, dif_neg H] at h₁, + exact zero_ne_one h₁ }, + have hsub : support ((λ i, w i • z i) ∘ plift.down) ⊆ hfin_w.to_finset, + from (support_smul_subset_left _ _).trans hfin_w.coe_to_finset.ge, + rw [finsum_eq_sum_plift_of_support_subset hsub], + refine hs.sum_mem (λ _ _, h₀ _) _ (λ i hi, hz _ _), + { rwa [finsum, dif_pos hfin_w] at h₁ }, + { rwa [hfin_w.mem_to_finset] at hi } +end + lemma convex_iff_sum_mem : convex R s ↔ (∀ (t : finset E) (w : E → R), (∀ i ∈ t, 0 ≤ w i) → ∑ i in t, w i = 1 → (∀ x ∈ t, x ∈ s) → ∑ x in t, w x • x ∈ s ) := begin refine ⟨λ hs t w hw₀ hw₁ hts, hs.sum_mem hw₀ hw₁ hts, _⟩, - intros h x y hx hy a b ha hb hab, + intros h x hx y hy a b ha hb hab, by_cases h_cases: x = y, { rw [h_cases, ←add_smul, hab, one_smul], exact hy }, { convert h {x, y} (λ z, if z = y then b else a) _ _ _, @@ -185,7 +226,7 @@ t.center_mass_mem_convex_hull hw₀ hws (λ i, mem_coe.2) lemma affine_combination_eq_center_mass {ι : Type*} {t : finset ι} {p : ι → E} {w : ι → R} (hw₂ : ∑ i in t, w i = 1) : - affine_combination t p w = center_mass t w p := + t.affine_combination R p w = center_mass t w p := begin rw [affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one _ w _ hw₂ (0 : E), finset.weighted_vsub_of_point_apply, vadd_eq_add, add_zero, t.center_mass_eq_of_sum_1 _ hw₂], @@ -194,7 +235,7 @@ end lemma affine_combination_mem_convex_hull {s : finset ι} {v : ι → E} {w : ι → R} (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1) : - s.affine_combination v w ∈ convex_hull R (range v) := + s.affine_combination R v w ∈ convex_hull R (range v) := begin rw affine_combination_eq_center_mass hw₁, apply s.center_mass_mem_convex_hull hw₀, @@ -220,14 +261,13 @@ end lemma convex_hull_range_eq_exists_affine_combination (v : ι → E) : convex_hull R (range v) = { x | ∃ (s : finset ι) (w : ι → R) - (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1), s.affine_combination v w = x } := + (hw₀ : ∀ i ∈ s, 0 ≤ w i) (hw₁ : s.sum w = 1), s.affine_combination R v w = x } := begin refine subset.antisymm (convex_hull_min _ _) _, { intros x hx, obtain ⟨i, hi⟩ := set.mem_range.mp hx, refine ⟨{i}, function.const ι (1 : R), by simp, by simp, by simp [hi]⟩, }, - { rw convex, - rintros x y ⟨s, w, hw₀, hw₁, rfl⟩ ⟨s', w', hw₀', hw₁', rfl⟩ a b ha hb hab, + { rintro x ⟨s, w, hw₀, hw₁, rfl⟩ y ⟨s', w', hw₀', hw₁', rfl⟩ a b ha hb hab, let W : ι → R := λ i, (if i ∈ s then a * w i else 0) + (if i ∈ s' then b * w' i else 0), have hW₁ : (s ∪ s').sum W = 1, { rw [sum_add_distrib, ← sum_subset (subset_union_left s s'), @@ -263,18 +303,18 @@ begin use [punit, {punit.star}, λ _, 1, λ _, x, λ _ _, zero_le_one, finset.sum_singleton, λ _ _, hx], simp only [finset.center_mass, finset.sum_singleton, inv_one, one_smul] }, - { rintros x y ⟨ι, sx, wx, zx, hwx₀, hwx₁, hzx, rfl⟩ ⟨ι', sy, wy, zy, hwy₀, hwy₁, hzy, rfl⟩ + { rintros x ⟨ι, sx, wx, zx, hwx₀, hwx₁, hzx, rfl⟩ y ⟨ι', sy, wy, zy, hwy₀, hwy₁, hzy, rfl⟩ a b ha hb hab, rw [finset.center_mass_segment' _ _ _ _ _ _ hwx₁ hwy₁ _ _ hab], refine ⟨_, _, _, _, _, _, _, rfl⟩, { rintros i hi, - rw [finset.mem_union, finset.mem_map, finset.mem_map] at hi, + rw [finset.mem_disj_sum] at hi, rcases hi with ⟨j, hj, rfl⟩|⟨j, hj, rfl⟩; simp only [sum.elim_inl, sum.elim_inr]; apply_rules [mul_nonneg, hwx₀, hwy₀] }, - { simp [finset.sum_sum_elim, finset.mul_sum.symm, *] }, + { simp [finset.sum_sum_elim, finset.mul_sum.symm, *], }, { intros i hi, - rw [finset.mem_union, finset.mem_map, finset.mem_map] at hi, + rw [finset.mem_disj_sum] at hi, rcases hi with ⟨j, hj, rfl⟩|⟨j, hj, rfl⟩; apply_rules [hzx, hzy] } }, { rintros _ ⟨ι, t, w, z, hw₀, hw₁, hz, rfl⟩, exact t.center_mass_mem_convex_hull hw₀ (hw₁.symm ▸ zero_lt_one) hz } @@ -290,8 +330,7 @@ begin refine ⟨_, _, _, finset.center_mass_ite_eq _ _ _ hx⟩, { intros, split_ifs, exacts [zero_le_one, le_refl 0] }, { rw [finset.sum_ite_eq, if_pos hx] } }, - { rintros x y ⟨wx, hwx₀, hwx₁, rfl⟩ ⟨wy, hwy₀, hwy₁, rfl⟩ - a b ha hb hab, + { rintro x ⟨wx, hwx₀, hwx₁, rfl⟩ y ⟨wy, hwy₀, hwy₁, rfl⟩ a b ha hb hab, rw [finset.center_mass_segment _ _ _ _ hwx₁ hwy₁ _ _ hab], refine ⟨_, _, _, rfl⟩, { rintros i hi, @@ -302,7 +341,12 @@ begin (hw₁.symm ▸ zero_lt_one) (λ x hx, hx) } end -lemma set.finite.convex_hull_eq {s : set E} (hs : finite s) : +lemma finset.mem_convex_hull {s : finset E} {x : E} : + x ∈ convex_hull R (s : set E) ↔ + ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y) (hw₁ : ∑ y in s, w y = 1), s.center_mass w id = x := +by rw [finset.convex_hull_eq, set.mem_set_of_eq] + +lemma set.finite.convex_hull_eq {s : set E} (hs : s.finite) : convex_hull R s = {x : E | ∃ (w : E → R) (hw₀ : ∀ y ∈ s, 0 ≤ w y) (hw₁ : ∑ y in hs.to_finset, w y = 1), hs.to_finset.center_mass w id = x} := by simpa only [set.finite.coe_to_finset, set.finite.mem_to_finset, exists_prop] @@ -325,17 +369,14 @@ begin { exact Union_subset (λ i, Union_subset convex_hull_mono), }, end -lemma convex_hull_prod (s : set E) (t : set F) : - convex_hull R (s ×ˢ t) = convex_hull R s ×ˢ convex_hull R t := +lemma mk_mem_convex_hull_prod {t : set F} {x : E} {y : F} (hx : x ∈ convex_hull R s) + (hy : y ∈ convex_hull R t) : + (x, y) ∈ convex_hull R (s ×ˢ t) := begin - refine set.subset.antisymm _ _, - { exact convex_hull_min (set.prod_mono (subset_convex_hull _ _) $ subset_convex_hull _ _) - ((convex_convex_hull _ _).prod $ convex_convex_hull _ _) }, - rintro ⟨x, y⟩ ⟨hx, hy⟩, rw convex_hull_eq at ⊢ hx hy, obtain ⟨ι, a, w, S, hw, hw', hS, hSp⟩ := hx, obtain ⟨κ, b, v, T, hv, hv', hT, hTp⟩ := hy, - have h_sum : ∑ (i : ι × κ) in a.product b, w i.fst * v i.snd = 1, + have h_sum : ∑ (i : ι × κ) in a ×ˢ b, w i.fst * v i.snd = 1, { rw [finset.sum_product, ← hw'], congr, ext i, @@ -343,7 +384,7 @@ begin { congr, ext, simp [mul_comm] }, rw [this, ← finset.sum_mul, hv'], simp }, - refine ⟨ι × κ, a.product b, λ p, (w p.1) * (v p.2), λ p, (S p.1, T p.2), + refine ⟨ι × κ, a ×ˢ b, λ p, (w p.1) * (v p.2), λ p, (S p.1, T p.2), λ p hp, _, h_sum, λ p hp, _, _⟩, { rw mem_product at hp, exact mul_nonneg (hw p.1 hp.1) (hv p.2 hp.2) }, @@ -367,6 +408,39 @@ begin rw [←finset.sum_smul, hw', one_smul] } end +@[simp] lemma convex_hull_prod (s : set E) (t : set F) : + convex_hull R (s ×ˢ t) = convex_hull R s ×ˢ convex_hull R t := +subset.antisymm (convex_hull_min (prod_mono (subset_convex_hull _ _) $ subset_convex_hull _ _) $ + (convex_convex_hull _ _).prod $ convex_convex_hull _ _) $ + prod_subset_iff.2 $ λ x hx y, mk_mem_convex_hull_prod hx + +lemma convex_hull_add (s t : set E) : convex_hull R (s + t) = convex_hull R s + convex_hull R t := +by simp_rw [←image2_add, ←image_prod, is_linear_map.is_linear_map_add.convex_hull_image, + convex_hull_prod] + +variables (R E) +/-- `convex_hull` is an additive monoid morphism under pointwise addition. -/ +@[simps] +def convex_hull_add_monoid_hom : set E →+ set E := +{ to_fun := convex_hull R, + map_add' := convex_hull_add, + map_zero' := convex_hull_zero } +variables {R E} + +lemma convex_hull_sub (s t : set E) : convex_hull R (s - t) = convex_hull R s - convex_hull R t := +by simp_rw [sub_eq_add_neg, convex_hull_add, convex_hull_neg] + +lemma convex_hull_list_sum (l : list (set E)) : convex_hull R l.sum = (l.map $ convex_hull R).sum := +map_list_sum (convex_hull_add_monoid_hom R E) l + +lemma convex_hull_multiset_sum (s : multiset (set E)) : + convex_hull R s.sum = (s.map $ convex_hull R).sum := +map_multiset_sum (convex_hull_add_monoid_hom R E) s + +lemma convex_hull_sum {ι} (s : finset ι) (t : ι → set E) : + convex_hull R (∑ i in s, t i) = ∑ i in s, convex_hull R (t i):= +map_sum (convex_hull_add_monoid_hom R E) _ _ + /-! ### `std_simplex` -/ variables (ι) [fintype ι] {f : ι → R} @@ -392,7 +466,7 @@ under the linear map sending each function `w` to `∑ x in s, w x • x`. Since we have no sums over finite sets, we use sum over `@finset.univ _ hs.fintype`. The map is defined in terms of operations on `(s → ℝ) →ₗ[ℝ] ℝ` so that later we will not need to prove that this map is linear. -/ -lemma set.finite.convex_hull_eq_image {s : set E} (hs : finite s) : +lemma set.finite.convex_hull_eq_image {s : set E} (hs : s.finite) : convex_hull R s = by haveI := hs.fintype; exact (⇑(∑ x : s, (@linear_map.proj R s _ (λ i, R) _ _ x).smul_right x.1)) '' (std_simplex R s) := begin @@ -410,19 +484,18 @@ lemma mem_Icc_of_mem_std_simplex (hf : f ∈ std_simplex R ι) (x) : /-- The convex hull of an affine basis is the intersection of the half-spaces defined by the corresponding barycentric coordinates. -/ -lemma convex_hull_affine_basis_eq_nonneg_barycentric {ι : Type*} (b : affine_basis ι R E) : - convex_hull R (range b.points) = { x | ∀ i, 0 ≤ b.coord i x } := +lemma affine_basis.convex_hull_eq_nonneg_coord {ι : Type*} (b : affine_basis ι R E) : + convex_hull R (range b) = {x | ∀ i, 0 ≤ b.coord i x} := begin rw convex_hull_range_eq_exists_affine_combination, ext x, - split, + refine ⟨_, λ hx, _⟩, { rintros ⟨s, w, hw₀, hw₁, rfl⟩ i, by_cases hi : i ∈ s, { rw b.coord_apply_combination_of_mem hi hw₁, exact hw₀ i hi, }, { rw b.coord_apply_combination_of_not_mem hi hw₁, }, }, - { intros hx, - have hx' : x ∈ affine_span R (range b.points), + { have hx' : x ∈ affine_span R (range b), { rw b.tot, exact affine_subspace.mem_top R E x, }, obtain ⟨s, w, hw₁, rfl⟩ := (mem_affine_span_iff_eq_affine_combination R E).mp hx', refine ⟨s, w, _, hw₁, rfl⟩, diff --git a/src/analysis/convex/complex.lean b/src/analysis/convex/complex.lean index d22d1c1b96700..58d32f143c96d 100644 --- a/src/analysis/convex/complex.lean +++ b/src/analysis/convex/complex.lean @@ -9,6 +9,9 @@ import data.complex.module /-! # Convexity of half spaces in ℂ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The open and closed half-spaces in ℂ given by an inequality on either the real or imaginary part are all convex over ℝ. -/ diff --git a/src/analysis/convex/cone.lean b/src/analysis/convex/cone.lean deleted file mode 100644 index b45d9b5b99da6..0000000000000 --- a/src/analysis/convex/cone.lean +++ /dev/null @@ -1,619 +0,0 @@ -/- -Copyright (c) 2020 Yury Kudryashov All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yury Kudryashov, Frédéric Dupuis --/ -import analysis.convex.hull -import analysis.inner_product_space.basic - -/-! -# Convex cones - -In a `𝕜`-module `E`, we define a convex cone as a set `s` such that `a • x + b • y ∈ s` whenever -`x, y ∈ s` and `a, b > 0`. We prove that convex cones form a `complete_lattice`, and define their -images (`convex_cone.map`) and preimages (`convex_cone.comap`) under linear maps. - -We define pointed, blunt, flat and salient cones, and prove the correspondence between -convex cones and ordered modules. - -We also define `convex.to_cone` to be the minimal cone that includes a given convex set. - -We define `set.inner_dual_cone` to be the cone consisting of all points `y` such that for -all points `x` in a given set `0 ≤ ⟪ x, y ⟫`. - -## Main statements - -We prove two extension theorems: -* `riesz_extension`: - [M. Riesz extension theorem](https://en.wikipedia.org/wiki/M._Riesz_extension_theorem) says that - if `s` is a convex cone in a real vector space `E`, `p` is a submodule of `E` - such that `p + s = E`, and `f` is a linear function `p → ℝ` which is - nonnegative on `p ∩ s`, then there exists a globally defined linear function - `g : E → ℝ` that agrees with `f` on `p`, and is nonnegative on `s`. -* `exists_extension_of_le_sublinear`: - Hahn-Banach theorem: if `N : E → ℝ` is a sublinear map, `f` is a linear map - defined on a subspace of `E`, and `f x ≤ N x` for all `x` in the domain of `f`, - then `f` can be extended to the whole space to a linear map `g` such that `g x ≤ N x` - for all `x` - -## Implementation notes - -While `convex 𝕜` is a predicate on sets, `convex_cone 𝕜 E` is a bundled convex cone. - -## References - -* https://en.wikipedia.org/wiki/Convex_cone --/ - - -open set linear_map -open_locale classical pointwise - -variables {𝕜 E F G : Type*} - -/-! ### Definition of `convex_cone` and basic properties -/ - -section definitions -variables (𝕜 E) [ordered_semiring 𝕜] - -/-- A convex cone is a subset `s` of a `𝕜`-module such that `a • x + b • y ∈ s` whenever `a, b > 0` -and `x, y ∈ s`. -/ -structure convex_cone [add_comm_monoid E] [has_scalar 𝕜 E] := -(carrier : set E) -(smul_mem' : ∀ ⦃c : 𝕜⦄, 0 < c → ∀ ⦃x : E⦄, x ∈ carrier → c • x ∈ carrier) -(add_mem' : ∀ ⦃x⦄ (hx : x ∈ carrier) ⦃y⦄ (hy : y ∈ carrier), x + y ∈ carrier) - -end definitions - -variables {𝕜 E} - -namespace convex_cone -section ordered_semiring -variables [ordered_semiring 𝕜] [add_comm_monoid E] - -section has_scalar -variables [has_scalar 𝕜 E] (S T : convex_cone 𝕜 E) - -instance : has_coe (convex_cone 𝕜 E) (set E) := ⟨convex_cone.carrier⟩ - -instance : has_mem E (convex_cone 𝕜 E) := ⟨λ m S, m ∈ S.carrier⟩ - -instance : has_le (convex_cone 𝕜 E) := ⟨λ S T, S.carrier ⊆ T.carrier⟩ - -instance : has_lt (convex_cone 𝕜 E) := ⟨λ S T, S.carrier ⊂ T.carrier⟩ - -@[simp, norm_cast] lemma mem_coe {x : E} : x ∈ (S : set E) ↔ x ∈ S := iff.rfl - -@[simp] lemma mem_mk {s : set E} {h₁ h₂ x} : x ∈ @mk 𝕜 _ _ _ _ s h₁ h₂ ↔ x ∈ s := iff.rfl - -/-- Two `convex_cone`s are equal if the underlying sets are equal. -/ -theorem ext' {S T : convex_cone 𝕜 E} (h : (S : set E) = T) : S = T := -by cases S; cases T; congr' - -/-- Two `convex_cone`s are equal if and only if the underlying sets are equal. -/ -protected theorem ext'_iff {S T : convex_cone 𝕜 E} : (S : set E) = T ↔ S = T := -⟨ext', λ h, h ▸ rfl⟩ - -/-- Two `convex_cone`s are equal if they have the same elements. -/ -@[ext] theorem ext {S T : convex_cone 𝕜 E} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := ext' $ set.ext h - -lemma smul_mem {c : 𝕜} {x : E} (hc : 0 < c) (hx : x ∈ S) : c • x ∈ S := S.smul_mem' hc hx - -lemma add_mem ⦃x⦄ (hx : x ∈ S) ⦃y⦄ (hy : y ∈ S) : x + y ∈ S := S.add_mem' hx hy - -instance : has_inf (convex_cone 𝕜 E) := -⟨λ S T, ⟨S ∩ T, λ c hc x hx, ⟨S.smul_mem hc hx.1, T.smul_mem hc hx.2⟩, - λ x hx y hy, ⟨S.add_mem hx.1 hy.1, T.add_mem hx.2 hy.2⟩⟩⟩ - -lemma coe_inf : ((S ⊓ T : convex_cone 𝕜 E) : set E) = ↑S ∩ ↑T := rfl - -lemma mem_inf {x} : x ∈ S ⊓ T ↔ x ∈ S ∧ x ∈ T := iff.rfl - -instance : has_Inf (convex_cone 𝕜 E) := -⟨λ S, ⟨⋂ s ∈ S, ↑s, - λ c hc x hx, mem_bInter $ λ s hs, s.smul_mem hc $ mem_Inter₂.1 hx s hs, - λ x hx y hy, mem_bInter $ λ s hs, s.add_mem (mem_Inter₂.1 hx s hs) (mem_Inter₂.1 hy s hs)⟩⟩ - -lemma mem_Inf {x : E} {S : set (convex_cone 𝕜 E)} : x ∈ Inf S ↔ ∀ s ∈ S, x ∈ s := mem_Inter₂ - -variables (𝕜) - -instance : has_bot (convex_cone 𝕜 E) := ⟨⟨∅, λ c hc x, false.elim, λ x, false.elim⟩⟩ - -lemma mem_bot (x : E) : x ∈ (⊥ : convex_cone 𝕜 E) = false := rfl - -instance : has_top (convex_cone 𝕜 E) := ⟨⟨univ, λ c hc x hx, mem_univ _, λ x hx y hy, mem_univ _⟩⟩ - -lemma mem_top (x : E) : x ∈ (⊤ : convex_cone 𝕜 E) := mem_univ x - -instance : complete_lattice (convex_cone 𝕜 E) := -{ le := (≤), - lt := (<), - bot := (⊥), - bot_le := λ S x, false.elim, - top := (⊤), - le_top := λ S x hx, mem_top 𝕜 x, - inf := (⊓), - Inf := has_Inf.Inf, - sup := λ a b, Inf {x | a ≤ x ∧ b ≤ x}, - Sup := λ s, Inf {T | ∀ S ∈ s, S ≤ T}, - le_sup_left := λ a b, λ x hx, mem_Inf.2 $ λ s hs, hs.1 hx, - le_sup_right := λ a b, λ x hx, mem_Inf.2 $ λ s hs, hs.2 hx, - sup_le := λ a b c ha hb x hx, mem_Inf.1 hx c ⟨ha, hb⟩, - le_inf := λ a b c ha hb x hx, ⟨ha hx, hb hx⟩, - inf_le_left := λ a b x, and.left, - inf_le_right := λ a b x, and.right, - le_Sup := λ s p hs x hx, mem_Inf.2 $ λ t ht, ht p hs hx, - Sup_le := λ s p hs x hx, mem_Inf.1 hx p hs, - le_Inf := λ s a ha x hx, mem_Inf.2 $ λ t ht, ha t ht hx, - Inf_le := λ s a ha x hx, mem_Inf.1 hx _ ha, - .. partial_order.lift (coe : convex_cone 𝕜 E → set E) (λ a b, ext') } - -instance : inhabited (convex_cone 𝕜 E) := ⟨⊥⟩ - -end has_scalar - -section module -variables [module 𝕜 E] (S : convex_cone 𝕜 E) - -protected lemma convex : convex 𝕜 (S : set E) := -convex_iff_forall_pos.2 $ λ x y hx hy a b ha hb hab, - S.add_mem (S.smul_mem ha hx) (S.smul_mem hb hy) - -end module -end ordered_semiring - -section linear_ordered_field -variables [linear_ordered_field 𝕜] - -section add_comm_monoid -variables [add_comm_monoid E] [add_comm_monoid F] [add_comm_monoid G] - -section mul_action -variables [mul_action 𝕜 E] (S : convex_cone 𝕜 E) - -lemma smul_mem_iff {c : 𝕜} (hc : 0 < c) {x : E} : - c • x ∈ S ↔ x ∈ S := -⟨λ h, inv_smul_smul₀ hc.ne' x ▸ S.smul_mem (inv_pos.2 hc) h, S.smul_mem hc⟩ - -end mul_action - -section module -variables [module 𝕜 E] [module 𝕜 F] [module 𝕜 G] - -/-- The image of a convex cone under a `𝕜`-linear map is a convex cone. -/ -def map (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 E) : convex_cone 𝕜 F := -{ carrier := f '' S, - smul_mem' := λ c hc y ⟨x, hx, hy⟩, hy ▸ f.map_smul c x ▸ mem_image_of_mem f (S.smul_mem hc hx), - add_mem' := λ y₁ ⟨x₁, hx₁, hy₁⟩ y₂ ⟨x₂, hx₂, hy₂⟩, hy₁ ▸ hy₂ ▸ f.map_add x₁ x₂ ▸ - mem_image_of_mem f (S.add_mem hx₁ hx₂) } - -lemma map_map (g : F →ₗ[𝕜] G) (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 E) : - (S.map f).map g = S.map (g.comp f) := -ext' $ image_image g f S - -@[simp] lemma map_id (S : convex_cone 𝕜 E) : S.map linear_map.id = S := ext' $ image_id _ - -/-- The preimage of a convex cone under a `𝕜`-linear map is a convex cone. -/ -def comap (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 F) : convex_cone 𝕜 E := -{ carrier := f ⁻¹' S, - smul_mem' := λ c hc x hx, by { rw [mem_preimage, f.map_smul c], exact S.smul_mem hc hx }, - add_mem' := λ x hx y hy, by { rw [mem_preimage, f.map_add], exact S.add_mem hx hy } } - -@[simp] lemma comap_id (S : convex_cone 𝕜 E) : S.comap linear_map.id = S := ext' preimage_id - -lemma comap_comap (g : F →ₗ[𝕜] G) (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 G) : - (S.comap g).comap f = S.comap (g.comp f) := -ext' $ preimage_comp.symm - -@[simp] lemma mem_comap {f : E →ₗ[𝕜] F} {S : convex_cone 𝕜 F} {x : E} : x ∈ S.comap f ↔ f x ∈ S := -iff.rfl - -end module -end add_comm_monoid - -section ordered_add_comm_group -variables [ordered_add_comm_group E] [module 𝕜 E] - -/-- -Constructs an ordered module given an `ordered_add_comm_group`, a cone, and a proof that -the order relation is the one defined by the cone. --/ -lemma to_ordered_smul (S : convex_cone 𝕜 E) (h : ∀ x y : E, x ≤ y ↔ y - x ∈ S) : - ordered_smul 𝕜 E := -ordered_smul.mk' -begin - intros x y z xy hz, - rw [h (z • x) (z • y), ←smul_sub z y x], - exact smul_mem S hz ((h x y).mp xy.le), -end - -end ordered_add_comm_group -end linear_ordered_field - -/-! ### Convex cones with extra properties -/ - -section ordered_semiring -variables [ordered_semiring 𝕜] - -section add_comm_monoid -variables [add_comm_monoid E] [has_scalar 𝕜 E] (S : convex_cone 𝕜 E) - -/-- A convex cone is pointed if it includes `0`. -/ -def pointed (S : convex_cone 𝕜 E) : Prop := (0 : E) ∈ S - -/-- A convex cone is blunt if it doesn't include `0`. -/ -def blunt (S : convex_cone 𝕜 E) : Prop := (0 : E) ∉ S - -lemma pointed_iff_not_blunt (S : convex_cone 𝕜 E) : S.pointed ↔ ¬S.blunt := -⟨λ h₁ h₂, h₂ h₁, not_not.mp⟩ - -lemma blunt_iff_not_pointed (S : convex_cone 𝕜 E) : S.blunt ↔ ¬S.pointed := -by rw [pointed_iff_not_blunt, not_not] - -end add_comm_monoid - -section add_comm_group -variables [add_comm_group E] [has_scalar 𝕜 E] (S : convex_cone 𝕜 E) - -/-- A convex cone is flat if it contains some nonzero vector `x` and its opposite `-x`. -/ -def flat : Prop := ∃ x ∈ S, x ≠ (0 : E) ∧ -x ∈ S - -/-- A convex cone is salient if it doesn't include `x` and `-x` for any nonzero `x`. -/ -def salient : Prop := ∀ x ∈ S, x ≠ (0 : E) → -x ∉ S - -lemma salient_iff_not_flat (S : convex_cone 𝕜 E) : S.salient ↔ ¬S.flat := -begin - split, - { rintros h₁ ⟨x, xs, H₁, H₂⟩, - exact h₁ x xs H₁ H₂ }, - { intro h, - unfold flat at h, - push_neg at h, - exact h } -end - -/-- A flat cone is always pointed (contains `0`). -/ -lemma flat.pointed {S : convex_cone 𝕜 E} (hS : S.flat) : S.pointed := -begin - obtain ⟨x, hx, _, hxneg⟩ := hS, - rw [pointed, ←add_neg_self x], - exact add_mem S hx hxneg, -end - -/-- A blunt cone (one not containing `0`) is always salient. -/ -lemma blunt.salient {S : convex_cone 𝕜 E} : S.blunt → S.salient := -begin - rw [salient_iff_not_flat, blunt_iff_not_pointed], - exact mt flat.pointed, -end - -/-- A pointed convex cone defines a preorder. -/ -def to_preorder (h₁ : S.pointed) : preorder E := -{ le := λ x y, y - x ∈ S, - le_refl := λ x, by change x - x ∈ S; rw [sub_self x]; exact h₁, - le_trans := λ x y z xy zy, by simpa using add_mem S zy xy } - -/-- A pointed and salient cone defines a partial order. -/ -def to_partial_order (h₁ : S.pointed) (h₂ : S.salient) : partial_order E := -{ le_antisymm := - begin - intros a b ab ba, - by_contradiction h, - have h' : b - a ≠ 0 := λ h'', h (eq_of_sub_eq_zero h'').symm, - have H := h₂ (b-a) ab h', - rw neg_sub b a at H, - exact H ba, - end, - ..to_preorder S h₁ } - -/-- A pointed and salient cone defines an `ordered_add_comm_group`. -/ -def to_ordered_add_comm_group (h₁ : S.pointed) (h₂ : S.salient) : - ordered_add_comm_group E := -{ add_le_add_left := - begin - intros a b hab c, - change c + b - (c + a) ∈ S, - rw add_sub_add_left_eq_sub, - exact hab, - end, - ..to_partial_order S h₁ h₂, - ..show add_comm_group E, by apply_instance } - -end add_comm_group -end ordered_semiring - -/-! ### Positive cone of an ordered module -/ - -section positive_cone -variables (𝕜 E) [ordered_semiring 𝕜] [ordered_add_comm_group E] [module 𝕜 E] [ordered_smul 𝕜 E] - -/-- -The positive cone is the convex cone formed by the set of nonnegative elements in an ordered -module. --/ -def positive_cone : convex_cone 𝕜 E := -{ carrier := {x | 0 ≤ x}, - smul_mem' := - begin - rintro c hc x (hx : _ ≤ _), - rw ←smul_zero c, - exact smul_le_smul_of_nonneg hx hc.le, - end, - add_mem' := λ x (hx : _ ≤ _) y (hy : _ ≤ _), add_nonneg hx hy } - -/-- The positive cone of an ordered module is always salient. -/ -lemma salient_positive_cone : salient (positive_cone 𝕜 E) := -λ x xs hx hx', lt_irrefl (0 : E) - (calc - 0 < x : lt_of_le_of_ne xs hx.symm - ... ≤ x + (-x) : le_add_of_nonneg_right hx' - ... = 0 : add_neg_self x) - -/-- The positive cone of an ordered module is always pointed. -/ -lemma pointed_positive_cone : pointed (positive_cone 𝕜 E) := le_refl 0 - -end positive_cone -end convex_cone - -/-! ### Cone over a convex set -/ - -section cone_from_convex -variables [linear_ordered_field 𝕜] [ordered_add_comm_group E] [module 𝕜 E] - -namespace convex - -/-- The set of vectors proportional to those in a convex set forms a convex cone. -/ -def to_cone (s : set E) (hs : convex 𝕜 s) : convex_cone 𝕜 E := -begin - apply convex_cone.mk (⋃ (c : 𝕜) (H : 0 < c), c • s); - simp only [mem_Union, mem_smul_set], - { rintros c c_pos _ ⟨c', c'_pos, x, hx, rfl⟩, - exact ⟨c * c', mul_pos c_pos c'_pos, x, hx, (smul_smul _ _ _).symm⟩ }, - { rintros _ ⟨cx, cx_pos, x, hx, rfl⟩ _ ⟨cy, cy_pos, y, hy, rfl⟩, - have : 0 < cx + cy, from add_pos cx_pos cy_pos, - refine ⟨_, this, _, convex_iff_div.1 hs hx hy cx_pos.le cy_pos.le this, _⟩, - simp only [smul_add, smul_smul, mul_div_assoc', mul_div_cancel_left _ this.ne'] } -end - -variables {s : set E} (hs : convex 𝕜 s) {x : E} - -lemma mem_to_cone : x ∈ hs.to_cone s ↔ ∃ (c : 𝕜), 0 < c ∧ ∃ y ∈ s, c • y = x := -by simp only [to_cone, convex_cone.mem_mk, mem_Union, mem_smul_set, eq_comm, exists_prop] - -lemma mem_to_cone' : x ∈ hs.to_cone s ↔ ∃ (c : 𝕜), 0 < c ∧ c • x ∈ s := -begin - refine hs.mem_to_cone.trans ⟨_, _⟩, - { rintros ⟨c, hc, y, hy, rfl⟩, - exact ⟨c⁻¹, inv_pos.2 hc, by rwa [smul_smul, inv_mul_cancel hc.ne', one_smul]⟩ }, - { rintros ⟨c, hc, hcx⟩, - exact ⟨c⁻¹, inv_pos.2 hc, _, hcx, by rw [smul_smul, inv_mul_cancel hc.ne', one_smul]⟩ } -end - -lemma subset_to_cone : s ⊆ hs.to_cone s := -λ x hx, hs.mem_to_cone'.2 ⟨1, zero_lt_one, by rwa one_smul⟩ - -/-- `hs.to_cone s` is the least cone that includes `s`. -/ -lemma to_cone_is_least : is_least { t : convex_cone 𝕜 E | s ⊆ t } (hs.to_cone s) := -begin - refine ⟨hs.subset_to_cone, λ t ht x hx, _⟩, - rcases hs.mem_to_cone.1 hx with ⟨c, hc, y, hy, rfl⟩, - exact t.smul_mem hc (ht hy) -end - -lemma to_cone_eq_Inf : hs.to_cone s = Inf { t : convex_cone 𝕜 E | s ⊆ t } := -hs.to_cone_is_least.is_glb.Inf_eq.symm - -end convex - -lemma convex_hull_to_cone_is_least (s : set E) : - is_least {t : convex_cone 𝕜 E | s ⊆ t} ((convex_convex_hull 𝕜 s).to_cone _) := -begin - convert (convex_convex_hull 𝕜 s).to_cone_is_least, - ext t, - exact ⟨λ h, convex_hull_min h t.convex, (subset_convex_hull 𝕜 s).trans⟩, -end - -lemma convex_hull_to_cone_eq_Inf (s : set E) : - (convex_convex_hull 𝕜 s).to_cone _ = Inf {t : convex_cone 𝕜 E | s ⊆ t} := -(convex_hull_to_cone_is_least s).is_glb.Inf_eq.symm - -end cone_from_convex - -/-! -### M. Riesz extension theorem - -Given a convex cone `s` in a vector space `E`, a submodule `p`, and a linear `f : p → ℝ`, assume -that `f` is nonnegative on `p ∩ s` and `p + s = E`. Then there exists a globally defined linear -function `g : E → ℝ` that agrees with `f` on `p`, and is nonnegative on `s`. - -We prove this theorem using Zorn's lemma. `riesz_extension.step` is the main part of the proof. -It says that if the domain `p` of `f` is not the whole space, then `f` can be extended to a larger -subspace `p ⊔ span ℝ {y}` without breaking the non-negativity condition. - -In `riesz_extension.exists_top` we use Zorn's lemma to prove that we can extend `f` -to a linear map `g` on `⊤ : submodule E`. Mathematically this is the same as a linear map on `E` -but in Lean `⊤ : submodule E` is isomorphic but is not equal to `E`. In `riesz_extension` -we use this isomorphism to prove the theorem. --/ - -variables [add_comm_group E] [module ℝ E] - -namespace riesz_extension -open submodule -variables (s : convex_cone ℝ E) (f : linear_pmap ℝ E ℝ) - -/-- Induction step in M. Riesz extension theorem. Given a convex cone `s` in a vector space `E`, -a partially defined linear map `f : f.domain → ℝ`, assume that `f` is nonnegative on `f.domain ∩ p` -and `p + s = E`. If `f` is not defined on the whole `E`, then we can extend it to a larger -submodule without breaking the non-negativity condition. -/ -lemma step (nonneg : ∀ x : f.domain, (x : E) ∈ s → 0 ≤ f x) - (dense : ∀ y, ∃ x : f.domain, (x : E) + y ∈ s) (hdom : f.domain ≠ ⊤) : - ∃ g, f < g ∧ ∀ x : g.domain, (x : E) ∈ s → 0 ≤ g x := -begin - obtain ⟨y, -, hy⟩ : ∃ (y : E) (h : y ∈ ⊤), y ∉ f.domain, - { exact @set_like.exists_of_lt (submodule ℝ E) _ _ _ _ (lt_top_iff_ne_top.2 hdom) }, - obtain ⟨c, le_c, c_le⟩ : - ∃ c, (∀ x : f.domain, -(x:E) - y ∈ s → f x ≤ c) ∧ (∀ x : f.domain, (x:E) + y ∈ s → c ≤ f x), - { set Sp := f '' {x : f.domain | (x:E) + y ∈ s}, - set Sn := f '' {x : f.domain | -(x:E) - y ∈ s}, - suffices : (upper_bounds Sn ∩ lower_bounds Sp).nonempty, - by simpa only [set.nonempty, upper_bounds, lower_bounds, ball_image_iff] using this, - refine exists_between_of_forall_le (nonempty.image f _) (nonempty.image f (dense y)) _, - { rcases (dense (-y)) with ⟨x, hx⟩, - rw [← neg_neg x, add_subgroup_class.coe_neg, ← sub_eq_add_neg] at hx, - exact ⟨_, hx⟩ }, - rintros a ⟨xn, hxn, rfl⟩ b ⟨xp, hxp, rfl⟩, - have := s.add_mem hxp hxn, - rw [add_assoc, add_sub_cancel'_right, ← sub_eq_add_neg, ← add_subgroup_class.coe_sub] at this, - replace := nonneg _ this, - rwa [f.map_sub, sub_nonneg] at this }, - have hy' : y ≠ 0, from λ hy₀, hy (hy₀.symm ▸ zero_mem _), - refine ⟨f.sup_span_singleton y (-c) hy, _, _⟩, - { refine lt_iff_le_not_le.2 ⟨f.left_le_sup _ _, λ H, _⟩, - replace H := linear_pmap.domain_mono.monotone H, - rw [linear_pmap.domain_sup_span_singleton, sup_le_iff, span_le, singleton_subset_iff] at H, - exact hy H.2 }, - { rintros ⟨z, hz⟩ hzs, - rcases mem_sup.1 hz with ⟨x, hx, y', hy', rfl⟩, - rcases mem_span_singleton.1 hy' with ⟨r, rfl⟩, - simp only [subtype.coe_mk] at hzs, - erw [linear_pmap.sup_span_singleton_apply_mk _ _ _ _ _ hx, smul_neg, - ← sub_eq_add_neg, sub_nonneg], - rcases lt_trichotomy r 0 with hr|hr|hr, - { have : -(r⁻¹ • x) - y ∈ s, - by rwa [← s.smul_mem_iff (neg_pos.2 hr), smul_sub, smul_neg, neg_smul, neg_neg, smul_smul, - mul_inv_cancel hr.ne, one_smul, sub_eq_add_neg, neg_smul, neg_neg], - replace := le_c (r⁻¹ • ⟨x, hx⟩) this, - rwa [← mul_le_mul_left (neg_pos.2 hr), neg_mul, neg_mul, - neg_le_neg_iff, f.map_smul, smul_eq_mul, ← mul_assoc, mul_inv_cancel hr.ne, - one_mul] at this }, - { subst r, - simp only [zero_smul, add_zero] at hzs ⊢, - apply nonneg, - exact hzs }, - { have : r⁻¹ • x + y ∈ s, - by rwa [← s.smul_mem_iff hr, smul_add, smul_smul, mul_inv_cancel hr.ne', one_smul], - replace := c_le (r⁻¹ • ⟨x, hx⟩) this, - rwa [← mul_le_mul_left hr, f.map_smul, smul_eq_mul, ← mul_assoc, - mul_inv_cancel hr.ne', one_mul] at this } } -end - -theorem exists_top (p : linear_pmap ℝ E ℝ) - (hp_nonneg : ∀ x : p.domain, (x : E) ∈ s → 0 ≤ p x) - (hp_dense : ∀ y, ∃ x : p.domain, (x : E) + y ∈ s) : - ∃ q ≥ p, q.domain = ⊤ ∧ ∀ x : q.domain, (x : E) ∈ s → 0 ≤ q x := -begin - replace hp_nonneg : p ∈ { p | _ }, by { rw mem_set_of_eq, exact hp_nonneg }, - obtain ⟨q, hqs, hpq, hq⟩ := zorn_nonempty_partial_order₀ _ _ _ hp_nonneg, - { refine ⟨q, hpq, _, hqs⟩, - contrapose! hq, - rcases step s q hqs _ hq with ⟨r, hqr, hr⟩, - { exact ⟨r, hr, hqr.le, hqr.ne'⟩ }, - { exact λ y, let ⟨x, hx⟩ := hp_dense y in ⟨of_le hpq.left x, hx⟩ } }, - { intros c hcs c_chain y hy, - clear hp_nonneg hp_dense p, - have cne : c.nonempty := ⟨y, hy⟩, - refine ⟨linear_pmap.Sup c c_chain.directed_on, _, λ _, linear_pmap.le_Sup c_chain.directed_on⟩, - rintros ⟨x, hx⟩ hxs, - have hdir : directed_on (≤) (linear_pmap.domain '' c), - from directed_on_image.2 (c_chain.directed_on.mono linear_pmap.domain_mono.monotone), - rcases (mem_Sup_of_directed (cne.image _) hdir).1 hx with ⟨_, ⟨f, hfc, rfl⟩, hfx⟩, - have : f ≤ linear_pmap.Sup c c_chain.directed_on, from linear_pmap.le_Sup _ hfc, - convert ← hcs hfc ⟨x, hfx⟩ hxs, - apply this.2, refl } -end - -end riesz_extension - -/-- M. **Riesz extension theorem**: given a convex cone `s` in a vector space `E`, a submodule `p`, -and a linear `f : p → ℝ`, assume that `f` is nonnegative on `p ∩ s` and `p + s = E`. Then -there exists a globally defined linear function `g : E → ℝ` that agrees with `f` on `p`, -and is nonnegative on `s`. -/ -theorem riesz_extension (s : convex_cone ℝ E) (f : linear_pmap ℝ E ℝ) - (nonneg : ∀ x : f.domain, (x : E) ∈ s → 0 ≤ f x) (dense : ∀ y, ∃ x : f.domain, (x : E) + y ∈ s) : - ∃ g : E →ₗ[ℝ] ℝ, (∀ x : f.domain, g x = f x) ∧ (∀ x ∈ s, 0 ≤ g x) := -begin - rcases riesz_extension.exists_top s f nonneg dense with ⟨⟨g_dom, g⟩, ⟨hpg, hfg⟩, htop, hgs⟩, - clear hpg, - refine ⟨g ∘ₗ ↑(linear_equiv.of_top _ htop).symm, _, _⟩; - simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.of_top_symm_apply], - { exact λ x, (hfg (submodule.coe_mk _ _).symm).symm }, - { exact λ x hx, hgs ⟨x, _⟩ hx } -end - -/-- **Hahn-Banach theorem**: if `N : E → ℝ` is a sublinear map, `f` is a linear map -defined on a subspace of `E`, and `f x ≤ N x` for all `x` in the domain of `f`, -then `f` can be extended to the whole space to a linear map `g` such that `g x ≤ N x` -for all `x`. -/ -theorem exists_extension_of_le_sublinear (f : linear_pmap ℝ E ℝ) (N : E → ℝ) - (N_hom : ∀ (c : ℝ), 0 < c → ∀ x, N (c • x) = c * N x) - (N_add : ∀ x y, N (x + y) ≤ N x + N y) - (hf : ∀ x : f.domain, f x ≤ N x) : - ∃ g : E →ₗ[ℝ] ℝ, (∀ x : f.domain, g x = f x) ∧ (∀ x, g x ≤ N x) := -begin - let s : convex_cone ℝ (E × ℝ) := - { carrier := {p : E × ℝ | N p.1 ≤ p.2 }, - smul_mem' := λ c hc p hp, - calc N (c • p.1) = c * N p.1 : N_hom c hc p.1 - ... ≤ c * p.2 : mul_le_mul_of_nonneg_left hp hc.le, - add_mem' := λ x hx y hy, (N_add _ _).trans (add_le_add hx hy) }, - obtain ⟨g, g_eq, g_nonneg⟩ := - riesz_extension s ((-f).coprod (linear_map.id.to_pmap ⊤)) _ _; - try { simp only [linear_pmap.coprod_apply, to_pmap_apply, id_apply, - linear_pmap.neg_apply, ← sub_eq_neg_add, sub_nonneg, subtype.coe_mk] at * }, - replace g_eq : ∀ (x : f.domain) (y : ℝ), g (x, y) = y - f x, - { intros x y, - simpa only [subtype.coe_mk, subtype.coe_eta] using g_eq ⟨(x, y), ⟨x.2, trivial⟩⟩ }, - { refine ⟨-g.comp (inl ℝ E ℝ), _, _⟩; simp only [neg_apply, inl_apply, comp_apply], - { intro x, simp [g_eq x 0] }, - { intro x, - have A : (x, N x) = (x, 0) + (0, N x), by simp, - have B := g_nonneg ⟨x, N x⟩ (le_refl (N x)), - rw [A, map_add, ← neg_le_iff_add_nonneg'] at B, - have C := g_eq 0 (N x), - simp only [submodule.coe_zero, f.map_zero, sub_zero] at C, - rwa ← C } }, - { exact λ x hx, le_trans (hf _) hx }, - { rintros ⟨x, y⟩, - refine ⟨⟨(0, N x - y), ⟨f.domain.zero_mem, trivial⟩⟩, _⟩, - simp only [convex_cone.mem_mk, mem_set_of_eq, subtype.coe_mk, prod.fst_add, prod.snd_add, - zero_add, sub_add_cancel] } -end - -/-! ### The dual cone -/ - -section dual -variables {H : Type*} [inner_product_space ℝ H] (s t : set H) -open_locale real_inner_product_space - -/-- The dual cone is the cone consisting of all points `y` such that for -all points `x` in a given set `0 ≤ ⟪ x, y ⟫`. -/ -def set.inner_dual_cone (s : set H) : convex_cone ℝ H := -{ carrier := { y | ∀ x ∈ s, 0 ≤ ⟪ x, y ⟫ }, - smul_mem' := λ c hc y hy x hx, - begin - rw real_inner_smul_right, - exact mul_nonneg hc.le (hy x hx) - end, - add_mem' := λ u hu v hv x hx, - begin - rw inner_add_right, - exact add_nonneg (hu x hx) (hv x hx) - end } - -lemma mem_inner_dual_cone (y : H) (s : set H) : - y ∈ s.inner_dual_cone ↔ ∀ x ∈ s, 0 ≤ ⟪ x, y ⟫ := by refl - -@[simp] lemma inner_dual_cone_empty : (∅ : set H).inner_dual_cone = ⊤ := -convex_cone.ext' (eq_univ_of_forall - (λ x y hy, false.elim (set.not_mem_empty _ hy))) - -lemma inner_dual_cone_le_inner_dual_cone (h : t ⊆ s) : - s.inner_dual_cone ≤ t.inner_dual_cone := -λ y hy x hx, hy x (h hx) - -lemma pointed_inner_dual_cone : s.inner_dual_cone.pointed := -λ x hx, by rw inner_zero_right - -end dual diff --git a/src/analysis/convex/cone/basic.lean b/src/analysis/convex/cone/basic.lean new file mode 100644 index 0000000000000..3feb656d347f0 --- /dev/null +++ b/src/analysis/convex/cone/basic.lean @@ -0,0 +1,717 @@ +/- +Copyright (c) 2020 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Frédéric Dupuis +-/ +import analysis.convex.hull +import data.real.basic +import linear_algebra.linear_pmap + +/-! +# Convex cones + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In a `𝕜`-module `E`, we define a convex cone as a set `s` such that `a • x + b • y ∈ s` whenever +`x, y ∈ s` and `a, b > 0`. We prove that convex cones form a `complete_lattice`, and define their +images (`convex_cone.map`) and preimages (`convex_cone.comap`) under linear maps. + +We define pointed, blunt, flat and salient cones, and prove the correspondence between +convex cones and ordered modules. + +We define `convex.to_cone` to be the minimal cone that includes a given convex set. + +## Main statements + +We prove two extension theorems: +* `riesz_extension`: + [M. Riesz extension theorem](https://en.wikipedia.org/wiki/M._Riesz_extension_theorem) says that + if `s` is a convex cone in a real vector space `E`, `p` is a submodule of `E` + such that `p + s = E`, and `f` is a linear function `p → ℝ` which is + nonnegative on `p ∩ s`, then there exists a globally defined linear function + `g : E → ℝ` that agrees with `f` on `p`, and is nonnegative on `s`. +* `exists_extension_of_le_sublinear`: + Hahn-Banach theorem: if `N : E → ℝ` is a sublinear map, `f` is a linear map + defined on a subspace of `E`, and `f x ≤ N x` for all `x` in the domain of `f`, + then `f` can be extended to the whole space to a linear map `g` such that `g x ≤ N x` + for all `x` + +We prove the following theorems: +* `convex_cone.hyperplane_separation_of_nonempty_of_is_closed_of_nmem`: + This variant of the + [hyperplane separation theorem](https://en.wikipedia.org/wiki/Hyperplane_separation_theorem) + states that given a nonempty, closed, convex cone `K` in a complete, real inner product space `H` + and a point `b` disjoint from it, there is a vector `y` which separates `b` from `K` in the sense + that for all points `x` in `K`, `0 ≤ ⟪x, y⟫_ℝ` and `⟪y, b⟫_ℝ < 0`. This is also a geometric + interpretation of the + [Farkas lemma](https://en.wikipedia.org/wiki/Farkas%27_lemma#Geometric_interpretation). +* `convex_cone.inner_dual_cone_of_inner_dual_cone_eq_self`: + +## Implementation notes + +While `convex 𝕜` is a predicate on sets, `convex_cone 𝕜 E` is a bundled convex cone. + +## References + +* https://en.wikipedia.org/wiki/Convex_cone +* [Stephen P. Boyd and Lieven Vandenberghe, *Convex Optimization*][boydVandenberghe2004] +* [Emo Welzl and Bernd Gärtner, *Cone Programming*][welzl_garter] +-/ + +assert_not_exists normed_space + +open set linear_map +open_locale classical pointwise + +variables {𝕜 E F G : Type*} + +/-! ### Definition of `convex_cone` and basic properties -/ + +section definitions +variables (𝕜 E) [ordered_semiring 𝕜] + +/-- A convex cone is a subset `s` of a `𝕜`-module such that `a • x + b • y ∈ s` whenever `a, b > 0` +and `x, y ∈ s`. -/ +structure convex_cone [add_comm_monoid E] [has_smul 𝕜 E] := +(carrier : set E) +(smul_mem' : ∀ ⦃c : 𝕜⦄, 0 < c → ∀ ⦃x : E⦄, x ∈ carrier → c • x ∈ carrier) +(add_mem' : ∀ ⦃x⦄ (hx : x ∈ carrier) ⦃y⦄ (hy : y ∈ carrier), x + y ∈ carrier) + +end definitions + +variables {𝕜 E} + +namespace convex_cone +section ordered_semiring +variables [ordered_semiring 𝕜] [add_comm_monoid E] + +section has_smul +variables [has_smul 𝕜 E] (S T : convex_cone 𝕜 E) + +instance : set_like (convex_cone 𝕜 E) E := +{ coe := carrier, + coe_injective' := λ S T h, by cases S; cases T; congr' } + +@[simp] lemma coe_mk {s : set E} {h₁ h₂} : ↑(@mk 𝕜 _ _ _ _ s h₁ h₂) = s := rfl + +@[simp] lemma mem_mk {s : set E} {h₁ h₂ x} : x ∈ @mk 𝕜 _ _ _ _ s h₁ h₂ ↔ x ∈ s := iff.rfl + +/-- Two `convex_cone`s are equal if they have the same elements. -/ +@[ext] theorem ext {S T : convex_cone 𝕜 E} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h + +lemma smul_mem {c : 𝕜} {x : E} (hc : 0 < c) (hx : x ∈ S) : c • x ∈ S := S.smul_mem' hc hx + +lemma add_mem ⦃x⦄ (hx : x ∈ S) ⦃y⦄ (hy : y ∈ S) : x + y ∈ S := S.add_mem' hx hy + +instance : add_mem_class (convex_cone 𝕜 E) E := +{ add_mem := λ c a b ha hb, add_mem c ha hb } + +instance : has_inf (convex_cone 𝕜 E) := +⟨λ S T, ⟨S ∩ T, λ c hc x hx, ⟨S.smul_mem hc hx.1, T.smul_mem hc hx.2⟩, + λ x hx y hy, ⟨S.add_mem hx.1 hy.1, T.add_mem hx.2 hy.2⟩⟩⟩ + +@[simp] lemma coe_inf : ((S ⊓ T : convex_cone 𝕜 E) : set E) = ↑S ∩ ↑T := rfl + +lemma mem_inf {x} : x ∈ S ⊓ T ↔ x ∈ S ∧ x ∈ T := iff.rfl + +instance : has_Inf (convex_cone 𝕜 E) := +⟨λ S, ⟨⋂ s ∈ S, ↑s, + λ c hc x hx, mem_bInter $ λ s hs, s.smul_mem hc $ mem_Inter₂.1 hx s hs, + λ x hx y hy, mem_bInter $ λ s hs, s.add_mem (mem_Inter₂.1 hx s hs) (mem_Inter₂.1 hy s hs)⟩⟩ + +@[simp] lemma coe_Inf (S : set (convex_cone 𝕜 E)) : ↑(Inf S) = ⋂ s ∈ S, (s : set E) := rfl + +lemma mem_Inf {x : E} {S : set (convex_cone 𝕜 E)} : x ∈ Inf S ↔ ∀ s ∈ S, x ∈ s := mem_Inter₂ + +@[simp] lemma coe_infi {ι : Sort*} (f : ι → convex_cone 𝕜 E) : ↑(infi f) = ⋂ i, (f i : set E) := +by simp [infi] + +lemma mem_infi {ι : Sort*} {x : E} {f : ι → convex_cone 𝕜 E} : x ∈ infi f ↔ ∀ i, x ∈ f i := +mem_Inter₂.trans $ by simp + +variables (𝕜) + +instance : has_bot (convex_cone 𝕜 E) := ⟨⟨∅, λ c hc x, false.elim, λ x, false.elim⟩⟩ + +lemma mem_bot (x : E) : x ∈ (⊥ : convex_cone 𝕜 E) = false := rfl + +@[simp] lemma coe_bot : ↑(⊥ : convex_cone 𝕜 E) = (∅ : set E) := rfl + +instance : has_top (convex_cone 𝕜 E) := ⟨⟨univ, λ c hc x hx, mem_univ _, λ x hx y hy, mem_univ _⟩⟩ + +lemma mem_top (x : E) : x ∈ (⊤ : convex_cone 𝕜 E) := mem_univ x + +@[simp] lemma coe_top : ↑(⊤ : convex_cone 𝕜 E) = (univ : set E) := rfl + +instance : complete_lattice (convex_cone 𝕜 E) := +{ le := (≤), + lt := (<), + bot := (⊥), + bot_le := λ S x, false.elim, + top := (⊤), + le_top := λ S x hx, mem_top 𝕜 x, + inf := (⊓), + Inf := has_Inf.Inf, + sup := λ a b, Inf {x | a ≤ x ∧ b ≤ x}, + Sup := λ s, Inf {T | ∀ S ∈ s, S ≤ T}, + le_sup_left := λ a b, λ x hx, mem_Inf.2 $ λ s hs, hs.1 hx, + le_sup_right := λ a b, λ x hx, mem_Inf.2 $ λ s hs, hs.2 hx, + sup_le := λ a b c ha hb x hx, mem_Inf.1 hx c ⟨ha, hb⟩, + le_inf := λ a b c ha hb x hx, ⟨ha hx, hb hx⟩, + inf_le_left := λ a b x, and.left, + inf_le_right := λ a b x, and.right, + le_Sup := λ s p hs x hx, mem_Inf.2 $ λ t ht, ht p hs hx, + Sup_le := λ s p hs x hx, mem_Inf.1 hx p hs, + le_Inf := λ s a ha x hx, mem_Inf.2 $ λ t ht, ha t ht hx, + Inf_le := λ s a ha x hx, mem_Inf.1 hx _ ha, + .. set_like.partial_order } + +instance : inhabited (convex_cone 𝕜 E) := ⟨⊥⟩ + +end has_smul + +section module +variables [module 𝕜 E] (S : convex_cone 𝕜 E) + +protected lemma convex : convex 𝕜 (S : set E) := +convex_iff_forall_pos.2 $ λ x hx y hy a b ha hb _, S.add_mem (S.smul_mem ha hx) (S.smul_mem hb hy) + +end module +end ordered_semiring + +section linear_ordered_field +variables [linear_ordered_field 𝕜] + +section add_comm_monoid +variables [add_comm_monoid E] [add_comm_monoid F] [add_comm_monoid G] + +section mul_action +variables [mul_action 𝕜 E] (S : convex_cone 𝕜 E) + +lemma smul_mem_iff {c : 𝕜} (hc : 0 < c) {x : E} : + c • x ∈ S ↔ x ∈ S := +⟨λ h, inv_smul_smul₀ hc.ne' x ▸ S.smul_mem (inv_pos.2 hc) h, S.smul_mem hc⟩ + +end mul_action + +section module +variables [module 𝕜 E] [module 𝕜 F] [module 𝕜 G] + +/-- The image of a convex cone under a `𝕜`-linear map is a convex cone. -/ +def map (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 E) : convex_cone 𝕜 F := +{ carrier := f '' S, + smul_mem' := λ c hc y ⟨x, hx, hy⟩, hy ▸ f.map_smul c x ▸ mem_image_of_mem f (S.smul_mem hc hx), + add_mem' := λ y₁ ⟨x₁, hx₁, hy₁⟩ y₂ ⟨x₂, hx₂, hy₂⟩, hy₁ ▸ hy₂ ▸ f.map_add x₁ x₂ ▸ + mem_image_of_mem f (S.add_mem hx₁ hx₂) } + +@[simp] lemma mem_map {f : E →ₗ[𝕜] F} {S : convex_cone 𝕜 E} {y : F} : + y ∈ S.map f ↔ ∃ x ∈ S, f x = y := +mem_image_iff_bex + +lemma map_map (g : F →ₗ[𝕜] G) (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 E) : + (S.map f).map g = S.map (g.comp f) := +set_like.coe_injective $ image_image g f S + +@[simp] lemma map_id (S : convex_cone 𝕜 E) : S.map linear_map.id = S := +set_like.coe_injective $ image_id _ + +/-- The preimage of a convex cone under a `𝕜`-linear map is a convex cone. -/ +def comap (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 F) : convex_cone 𝕜 E := +{ carrier := f ⁻¹' S, + smul_mem' := λ c hc x hx, by { rw [mem_preimage, f.map_smul c], exact S.smul_mem hc hx }, + add_mem' := λ x hx y hy, by { rw [mem_preimage, f.map_add], exact S.add_mem hx hy } } + +@[simp] lemma coe_comap (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 F) : (S.comap f : set E) = f ⁻¹' S := rfl + +@[simp] lemma comap_id (S : convex_cone 𝕜 E) : S.comap linear_map.id = S := +set_like.coe_injective preimage_id + +lemma comap_comap (g : F →ₗ[𝕜] G) (f : E →ₗ[𝕜] F) (S : convex_cone 𝕜 G) : + (S.comap g).comap f = S.comap (g.comp f) := +set_like.coe_injective $ preimage_comp.symm + +@[simp] lemma mem_comap {f : E →ₗ[𝕜] F} {S : convex_cone 𝕜 F} {x : E} : x ∈ S.comap f ↔ f x ∈ S := +iff.rfl + +end module +end add_comm_monoid + +section ordered_add_comm_group +variables [ordered_add_comm_group E] [module 𝕜 E] + +/-- +Constructs an ordered module given an `ordered_add_comm_group`, a cone, and a proof that +the order relation is the one defined by the cone. +-/ +lemma to_ordered_smul (S : convex_cone 𝕜 E) (h : ∀ x y : E, x ≤ y ↔ y - x ∈ S) : + ordered_smul 𝕜 E := +ordered_smul.mk' +begin + intros x y z xy hz, + rw [h (z • x) (z • y), ←smul_sub z y x], + exact smul_mem S hz ((h x y).mp xy.le), +end + +end ordered_add_comm_group +end linear_ordered_field + +/-! ### Convex cones with extra properties -/ + +section ordered_semiring +variables [ordered_semiring 𝕜] + +section add_comm_monoid +variables [add_comm_monoid E] [has_smul 𝕜 E] (S : convex_cone 𝕜 E) + +/-- A convex cone is pointed if it includes `0`. -/ +def pointed (S : convex_cone 𝕜 E) : Prop := (0 : E) ∈ S + +/-- A convex cone is blunt if it doesn't include `0`. -/ +def blunt (S : convex_cone 𝕜 E) : Prop := (0 : E) ∉ S + +lemma pointed_iff_not_blunt (S : convex_cone 𝕜 E) : S.pointed ↔ ¬S.blunt := +⟨λ h₁ h₂, h₂ h₁, not_not.mp⟩ + +lemma blunt_iff_not_pointed (S : convex_cone 𝕜 E) : S.blunt ↔ ¬S.pointed := +by rw [pointed_iff_not_blunt, not_not] + +lemma pointed.mono {S T : convex_cone 𝕜 E} (h : S ≤ T) : S.pointed → T.pointed := @h _ + +lemma blunt.anti {S T : convex_cone 𝕜 E} (h : T ≤ S) : S.blunt → T.blunt := (∘ @@h) + +end add_comm_monoid + +section add_comm_group +variables [add_comm_group E] [has_smul 𝕜 E] (S : convex_cone 𝕜 E) + +/-- A convex cone is flat if it contains some nonzero vector `x` and its opposite `-x`. -/ +def flat : Prop := ∃ x ∈ S, x ≠ (0 : E) ∧ -x ∈ S + +/-- A convex cone is salient if it doesn't include `x` and `-x` for any nonzero `x`. -/ +def salient : Prop := ∀ x ∈ S, x ≠ (0 : E) → -x ∉ S + +lemma salient_iff_not_flat (S : convex_cone 𝕜 E) : S.salient ↔ ¬S.flat := +begin + split, + { rintros h₁ ⟨x, xs, H₁, H₂⟩, + exact h₁ x xs H₁ H₂ }, + { intro h, + unfold flat at h, + push_neg at h, + exact h } +end + +lemma flat.mono {S T : convex_cone 𝕜 E} (h : S ≤ T) : S.flat → T.flat +| ⟨x, hxS, hx, hnxS⟩ := ⟨x, h hxS, hx, h hnxS⟩ + +lemma salient.anti {S T : convex_cone 𝕜 E} (h : T ≤ S) : S.salient → T.salient := +λ hS x hxT hx hnT, hS x (h hxT) hx (h hnT) + +/-- A flat cone is always pointed (contains `0`). -/ +lemma flat.pointed {S : convex_cone 𝕜 E} (hS : S.flat) : S.pointed := +begin + obtain ⟨x, hx, _, hxneg⟩ := hS, + rw [pointed, ←add_neg_self x], + exact add_mem S hx hxneg, +end + +/-- A blunt cone (one not containing `0`) is always salient. -/ +lemma blunt.salient {S : convex_cone 𝕜 E} : S.blunt → S.salient := +begin + rw [salient_iff_not_flat, blunt_iff_not_pointed], + exact mt flat.pointed, +end + +/-- A pointed convex cone defines a preorder. -/ +def to_preorder (h₁ : S.pointed) : preorder E := +{ le := λ x y, y - x ∈ S, + le_refl := λ x, by change x - x ∈ S; rw [sub_self x]; exact h₁, + le_trans := λ x y z xy zy, by simpa using add_mem S zy xy } + +/-- A pointed and salient cone defines a partial order. -/ +def to_partial_order (h₁ : S.pointed) (h₂ : S.salient) : partial_order E := +{ le_antisymm := + begin + intros a b ab ba, + by_contradiction h, + have h' : b - a ≠ 0 := λ h'', h (eq_of_sub_eq_zero h'').symm, + have H := h₂ (b-a) ab h', + rw neg_sub b a at H, + exact H ba, + end, + ..to_preorder S h₁ } + +/-- A pointed and salient cone defines an `ordered_add_comm_group`. -/ +def to_ordered_add_comm_group (h₁ : S.pointed) (h₂ : S.salient) : + ordered_add_comm_group E := +{ add_le_add_left := + begin + intros a b hab c, + change c + b - (c + a) ∈ S, + rw add_sub_add_left_eq_sub, + exact hab, + end, + ..to_partial_order S h₁ h₂, + ..show add_comm_group E, by apply_instance } + +end add_comm_group + +section module +variables [add_comm_monoid E] [module 𝕜 E] + +instance : has_zero (convex_cone 𝕜 E) := ⟨⟨0, λ _ _, by simp, λ _, by simp⟩⟩ + +@[simp] lemma mem_zero (x : E) : x ∈ (0 : convex_cone 𝕜 E) ↔ x = 0 := iff.rfl +@[simp] lemma coe_zero : ((0 : convex_cone 𝕜 E) : set E) = 0 := rfl + +lemma pointed_zero : (0 : convex_cone 𝕜 E).pointed := by rw [pointed, mem_zero] + +instance : has_add (convex_cone 𝕜 E) := ⟨ λ K₁ K₂, +{ carrier := {z | ∃ (x y : E), x ∈ K₁ ∧ y ∈ K₂ ∧ x + y = z}, + smul_mem' := + begin + rintro c hc _ ⟨x, y, hx, hy, rfl⟩, + rw smul_add, + use [c • x, c • y, K₁.smul_mem hc hx, K₂.smul_mem hc hy], + end, + add_mem' := + begin + rintro _ ⟨x₁, x₂, hx₁, hx₂, rfl⟩ y ⟨y₁, y₂, hy₁, hy₂, rfl⟩, + use [x₁ + y₁, x₂ + y₂, K₁.add_mem hx₁ hy₁, K₂.add_mem hx₂ hy₂], + abel, + end } ⟩ + +@[simp] lemma mem_add {K₁ K₂ : convex_cone 𝕜 E} {a : E} : + a ∈ K₁ + K₂ ↔ ∃ (x y : E), x ∈ K₁ ∧ y ∈ K₂ ∧ x + y = a := iff.rfl + +instance : add_zero_class (convex_cone 𝕜 E) := +⟨0, has_add.add, λ _, by {ext, simp}, λ _, by {ext, simp}⟩ + +instance : add_comm_semigroup (convex_cone 𝕜 E) := +{ add := has_add.add, + add_assoc := λ _ _ _, set_like.coe_injective $ set.add_comm_semigroup.add_assoc _ _ _, + add_comm := λ _ _, set_like.coe_injective $ set.add_comm_semigroup.add_comm _ _ } + +end module +end ordered_semiring + +end convex_cone + +namespace submodule + +/-! ### Submodules are cones -/ + +section ordered_semiring +variables [ordered_semiring 𝕜] + +section add_comm_monoid +variables [add_comm_monoid E] [module 𝕜 E] + +/-- Every submodule is trivially a convex cone. -/ +def to_convex_cone (S : submodule 𝕜 E) : convex_cone 𝕜 E := +{ carrier := S, + smul_mem' := λ c hc x hx, S.smul_mem c hx, + add_mem' := λ x hx y hy, S.add_mem hx hy } + +@[simp] lemma coe_to_convex_cone (S : submodule 𝕜 E) : ↑S.to_convex_cone = (S : set E) := rfl + +@[simp] lemma mem_to_convex_cone {x : E} {S : submodule 𝕜 E} : x ∈ S.to_convex_cone ↔ x ∈ S := +iff.rfl + +@[simp] lemma to_convex_cone_le_iff {S T : submodule 𝕜 E} : + S.to_convex_cone ≤ T.to_convex_cone ↔ S ≤ T := +iff.rfl + +@[simp] lemma to_convex_cone_bot : (⊥ : submodule 𝕜 E).to_convex_cone = 0 := rfl +@[simp] lemma to_convex_cone_top : (⊤ : submodule 𝕜 E).to_convex_cone = ⊤ := rfl + +@[simp] lemma to_convex_cone_inf (S T : submodule 𝕜 E) : + (S ⊓ T).to_convex_cone = S.to_convex_cone ⊓ T.to_convex_cone := +rfl + +@[simp] lemma pointed_to_convex_cone (S : submodule 𝕜 E) : S.to_convex_cone.pointed := S.zero_mem + +end add_comm_monoid +end ordered_semiring + +end submodule + +namespace convex_cone + +/-! ### Positive cone of an ordered module -/ + +section positive_cone +variables (𝕜 E) [ordered_semiring 𝕜] [ordered_add_comm_group E] [module 𝕜 E] [ordered_smul 𝕜 E] + +/-- +The positive cone is the convex cone formed by the set of nonnegative elements in an ordered +module. +-/ +def positive : convex_cone 𝕜 E := +{ carrier := set.Ici 0, + smul_mem' := λ c hc x (hx : _ ≤ _), smul_nonneg hc.le hx, + add_mem' := λ x (hx : _ ≤ _) y (hy : _ ≤ _), add_nonneg hx hy } + +@[simp] lemma mem_positive {x : E} : x ∈ positive 𝕜 E ↔ 0 ≤ x := iff.rfl +@[simp] lemma coe_positive : ↑(positive 𝕜 E) = set.Ici (0 : E) := rfl + +/-- The positive cone of an ordered module is always salient. -/ +lemma salient_positive : salient (positive 𝕜 E) := +λ x xs hx hx', lt_irrefl (0 : E) + (calc + 0 < x : lt_of_le_of_ne xs hx.symm + ... ≤ x + (-x) : le_add_of_nonneg_right hx' + ... = 0 : add_neg_self x) + +/-- The positive cone of an ordered module is always pointed. -/ +lemma pointed_positive : pointed (positive 𝕜 E) := le_refl 0 + +/-- The cone of strictly positive elements. + +Note that this naming diverges from the mathlib convention of `pos` and `nonneg` due to "positive +cone" (`convex_cone.positive`) being established terminology for the non-negative elements. -/ +def strictly_positive : convex_cone 𝕜 E := +{ carrier := set.Ioi 0, + smul_mem' := λ c hc x (hx : _ < _), smul_pos hc hx, + add_mem' := λ x hx y hy, add_pos hx hy } + +@[simp] lemma mem_strictly_positive {x : E} : x ∈ strictly_positive 𝕜 E ↔ 0 < x := iff.rfl +@[simp] lemma coe_strictly_positive : ↑(strictly_positive 𝕜 E) = set.Ioi (0 : E) := rfl + +lemma positive_le_strictly_positive : strictly_positive 𝕜 E ≤ positive 𝕜 E := λ x, le_of_lt + +/-- The strictly positive cone of an ordered module is always salient. -/ +lemma salient_strictly_positive : salient (strictly_positive 𝕜 E) := +(salient_positive 𝕜 E).anti $ positive_le_strictly_positive 𝕜 E + +/-- The strictly positive cone of an ordered module is always blunt. -/ +lemma blunt_strictly_positive : blunt (strictly_positive 𝕜 E) := lt_irrefl 0 + +end positive_cone +end convex_cone + +/-! ### Cone over a convex set -/ + +section cone_from_convex +variables [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] + +namespace convex + +/-- The set of vectors proportional to those in a convex set forms a convex cone. -/ +def to_cone (s : set E) (hs : convex 𝕜 s) : convex_cone 𝕜 E := +begin + apply convex_cone.mk (⋃ (c : 𝕜) (H : 0 < c), c • s); + simp only [mem_Union, mem_smul_set], + { rintros c c_pos _ ⟨c', c'_pos, x, hx, rfl⟩, + exact ⟨c * c', mul_pos c_pos c'_pos, x, hx, (smul_smul _ _ _).symm⟩ }, + { rintros _ ⟨cx, cx_pos, x, hx, rfl⟩ _ ⟨cy, cy_pos, y, hy, rfl⟩, + have : 0 < cx + cy, from add_pos cx_pos cy_pos, + refine ⟨_, this, _, convex_iff_div.1 hs hx hy cx_pos.le cy_pos.le this, _⟩, + simp only [smul_add, smul_smul, mul_div_assoc', mul_div_cancel_left _ this.ne'] } +end + +variables {s : set E} (hs : convex 𝕜 s) {x : E} + +lemma mem_to_cone : x ∈ hs.to_cone s ↔ ∃ (c : 𝕜), 0 < c ∧ ∃ y ∈ s, c • y = x := +by simp only [to_cone, convex_cone.mem_mk, mem_Union, mem_smul_set, eq_comm, exists_prop] + +lemma mem_to_cone' : x ∈ hs.to_cone s ↔ ∃ (c : 𝕜), 0 < c ∧ c • x ∈ s := +begin + refine hs.mem_to_cone.trans ⟨_, _⟩, + { rintros ⟨c, hc, y, hy, rfl⟩, + exact ⟨c⁻¹, inv_pos.2 hc, by rwa [smul_smul, inv_mul_cancel hc.ne', one_smul]⟩ }, + { rintros ⟨c, hc, hcx⟩, + exact ⟨c⁻¹, inv_pos.2 hc, _, hcx, by rw [smul_smul, inv_mul_cancel hc.ne', one_smul]⟩ } +end + +lemma subset_to_cone : s ⊆ hs.to_cone s := +λ x hx, hs.mem_to_cone'.2 ⟨1, zero_lt_one, by rwa one_smul⟩ + +/-- `hs.to_cone s` is the least cone that includes `s`. -/ +lemma to_cone_is_least : is_least { t : convex_cone 𝕜 E | s ⊆ t } (hs.to_cone s) := +begin + refine ⟨hs.subset_to_cone, λ t ht x hx, _⟩, + rcases hs.mem_to_cone.1 hx with ⟨c, hc, y, hy, rfl⟩, + exact t.smul_mem hc (ht hy) +end + +lemma to_cone_eq_Inf : hs.to_cone s = Inf { t : convex_cone 𝕜 E | s ⊆ t } := +hs.to_cone_is_least.is_glb.Inf_eq.symm + +end convex + +lemma convex_hull_to_cone_is_least (s : set E) : + is_least {t : convex_cone 𝕜 E | s ⊆ t} ((convex_convex_hull 𝕜 s).to_cone _) := +begin + convert (convex_convex_hull 𝕜 s).to_cone_is_least, + ext t, + exact ⟨λ h, convex_hull_min h t.convex, (subset_convex_hull 𝕜 s).trans⟩, +end + +lemma convex_hull_to_cone_eq_Inf (s : set E) : + (convex_convex_hull 𝕜 s).to_cone _ = Inf {t : convex_cone 𝕜 E | s ⊆ t} := +eq.symm $ is_glb.Inf_eq $ is_least.is_glb $ convex_hull_to_cone_is_least s + +end cone_from_convex + +/-! +### M. Riesz extension theorem + +Given a convex cone `s` in a vector space `E`, a submodule `p`, and a linear `f : p → ℝ`, assume +that `f` is nonnegative on `p ∩ s` and `p + s = E`. Then there exists a globally defined linear +function `g : E → ℝ` that agrees with `f` on `p`, and is nonnegative on `s`. + +We prove this theorem using Zorn's lemma. `riesz_extension.step` is the main part of the proof. +It says that if the domain `p` of `f` is not the whole space, then `f` can be extended to a larger +subspace `p ⊔ span ℝ {y}` without breaking the non-negativity condition. + +In `riesz_extension.exists_top` we use Zorn's lemma to prove that we can extend `f` +to a linear map `g` on `⊤ : submodule E`. Mathematically this is the same as a linear map on `E` +but in Lean `⊤ : submodule E` is isomorphic but is not equal to `E`. In `riesz_extension` +we use this isomorphism to prove the theorem. +-/ + +variables [add_comm_group E] [module ℝ E] + +namespace riesz_extension +open submodule +variables (s : convex_cone ℝ E) (f : E →ₗ.[ℝ] ℝ) + +/-- Induction step in M. Riesz extension theorem. Given a convex cone `s` in a vector space `E`, +a partially defined linear map `f : f.domain → ℝ`, assume that `f` is nonnegative on `f.domain ∩ p` +and `p + s = E`. If `f` is not defined on the whole `E`, then we can extend it to a larger +submodule without breaking the non-negativity condition. -/ +lemma step (nonneg : ∀ x : f.domain, (x : E) ∈ s → 0 ≤ f x) + (dense : ∀ y, ∃ x : f.domain, (x : E) + y ∈ s) (hdom : f.domain ≠ ⊤) : + ∃ g, f < g ∧ ∀ x : g.domain, (x : E) ∈ s → 0 ≤ g x := +begin + obtain ⟨y, -, hy⟩ : ∃ (y : E) (h : y ∈ ⊤), y ∉ f.domain, + { exact @set_like.exists_of_lt (submodule ℝ E) _ _ _ _ (lt_top_iff_ne_top.2 hdom) }, + obtain ⟨c, le_c, c_le⟩ : + ∃ c, (∀ x : f.domain, -(x:E) - y ∈ s → f x ≤ c) ∧ (∀ x : f.domain, (x:E) + y ∈ s → c ≤ f x), + { set Sp := f '' {x : f.domain | (x:E) + y ∈ s}, + set Sn := f '' {x : f.domain | -(x:E) - y ∈ s}, + suffices : (upper_bounds Sn ∩ lower_bounds Sp).nonempty, + by simpa only [set.nonempty, upper_bounds, lower_bounds, ball_image_iff] using this, + refine exists_between_of_forall_le (nonempty.image f _) (nonempty.image f (dense y)) _, + { rcases (dense (-y)) with ⟨x, hx⟩, + rw [← neg_neg x, add_subgroup_class.coe_neg, ← sub_eq_add_neg] at hx, + exact ⟨_, hx⟩ }, + rintros a ⟨xn, hxn, rfl⟩ b ⟨xp, hxp, rfl⟩, + have := s.add_mem hxp hxn, + rw [add_assoc, add_sub_cancel'_right, ← sub_eq_add_neg, ← add_subgroup_class.coe_sub] at this, + replace := nonneg _ this, + rwa [f.map_sub, sub_nonneg] at this }, + have hy' : y ≠ 0, from λ hy₀, hy (hy₀.symm ▸ zero_mem _), + refine ⟨f.sup_span_singleton y (-c) hy, _, _⟩, + { refine lt_iff_le_not_le.2 ⟨f.left_le_sup _ _, λ H, _⟩, + replace H := linear_pmap.domain_mono.monotone H, + rw [linear_pmap.domain_sup_span_singleton, sup_le_iff, span_le, singleton_subset_iff] at H, + exact hy H.2 }, + { rintros ⟨z, hz⟩ hzs, + rcases mem_sup.1 hz with ⟨x, hx, y', hy', rfl⟩, + rcases mem_span_singleton.1 hy' with ⟨r, rfl⟩, + simp only [subtype.coe_mk] at hzs, + erw [linear_pmap.sup_span_singleton_apply_mk _ _ _ _ _ hx, smul_neg, + ← sub_eq_add_neg, sub_nonneg], + rcases lt_trichotomy r 0 with hr|hr|hr, + { have : -(r⁻¹ • x) - y ∈ s, + by rwa [← s.smul_mem_iff (neg_pos.2 hr), smul_sub, smul_neg, neg_smul, neg_neg, smul_smul, + mul_inv_cancel hr.ne, one_smul, sub_eq_add_neg, neg_smul, neg_neg], + replace := le_c (r⁻¹ • ⟨x, hx⟩) this, + rwa [← mul_le_mul_left (neg_pos.2 hr), neg_mul, neg_mul, + neg_le_neg_iff, f.map_smul, smul_eq_mul, ← mul_assoc, mul_inv_cancel hr.ne, + one_mul] at this }, + { subst r, + simp only [zero_smul, add_zero] at hzs ⊢, + apply nonneg, + exact hzs }, + { have : r⁻¹ • x + y ∈ s, + by rwa [← s.smul_mem_iff hr, smul_add, smul_smul, mul_inv_cancel hr.ne', one_smul], + replace := c_le (r⁻¹ • ⟨x, hx⟩) this, + rwa [← mul_le_mul_left hr, f.map_smul, smul_eq_mul, ← mul_assoc, + mul_inv_cancel hr.ne', one_mul] at this } } +end + +theorem exists_top (p : E →ₗ.[ℝ] ℝ) + (hp_nonneg : ∀ x : p.domain, (x : E) ∈ s → 0 ≤ p x) + (hp_dense : ∀ y, ∃ x : p.domain, (x : E) + y ∈ s) : + ∃ q ≥ p, q.domain = ⊤ ∧ ∀ x : q.domain, (x : E) ∈ s → 0 ≤ q x := +begin + replace hp_nonneg : p ∈ { p | _ }, by { rw mem_set_of_eq, exact hp_nonneg }, + obtain ⟨q, hqs, hpq, hq⟩ := zorn_nonempty_partial_order₀ _ _ _ hp_nonneg, + { refine ⟨q, hpq, _, hqs⟩, + contrapose! hq, + rcases step s q hqs _ hq with ⟨r, hqr, hr⟩, + { exact ⟨r, hr, hqr.le, hqr.ne'⟩ }, + { exact λ y, let ⟨x, hx⟩ := hp_dense y in ⟨of_le hpq.left x, hx⟩ } }, + { intros c hcs c_chain y hy, + clear hp_nonneg hp_dense p, + have cne : c.nonempty := ⟨y, hy⟩, + refine ⟨linear_pmap.Sup c c_chain.directed_on, _, λ _, linear_pmap.le_Sup c_chain.directed_on⟩, + rintros ⟨x, hx⟩ hxs, + have hdir : directed_on (≤) (linear_pmap.domain '' c), + from directed_on_image.2 (c_chain.directed_on.mono linear_pmap.domain_mono.monotone), + rcases (mem_Sup_of_directed (cne.image _) hdir).1 hx with ⟨_, ⟨f, hfc, rfl⟩, hfx⟩, + have : f ≤ linear_pmap.Sup c c_chain.directed_on, from linear_pmap.le_Sup _ hfc, + convert ← hcs hfc ⟨x, hfx⟩ hxs, + apply this.2, refl } +end + +end riesz_extension + +/-- M. **Riesz extension theorem**: given a convex cone `s` in a vector space `E`, a submodule `p`, +and a linear `f : p → ℝ`, assume that `f` is nonnegative on `p ∩ s` and `p + s = E`. Then +there exists a globally defined linear function `g : E → ℝ` that agrees with `f` on `p`, +and is nonnegative on `s`. -/ +theorem riesz_extension (s : convex_cone ℝ E) (f : E →ₗ.[ℝ] ℝ) + (nonneg : ∀ x : f.domain, (x : E) ∈ s → 0 ≤ f x) (dense : ∀ y, ∃ x : f.domain, (x : E) + y ∈ s) : + ∃ g : E →ₗ[ℝ] ℝ, (∀ x : f.domain, g x = f x) ∧ (∀ x ∈ s, 0 ≤ g x) := +begin + rcases riesz_extension.exists_top s f nonneg dense with ⟨⟨g_dom, g⟩, ⟨hpg, hfg⟩, htop, hgs⟩, + clear hpg, + refine ⟨g ∘ₗ ↑(linear_equiv.of_top _ htop).symm, _, _⟩; + simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.of_top_symm_apply], + { exact λ x, (hfg (submodule.coe_mk _ _).symm).symm }, + { exact λ x hx, hgs ⟨x, _⟩ hx } +end + +/-- **Hahn-Banach theorem**: if `N : E → ℝ` is a sublinear map, `f` is a linear map +defined on a subspace of `E`, and `f x ≤ N x` for all `x` in the domain of `f`, +then `f` can be extended to the whole space to a linear map `g` such that `g x ≤ N x` +for all `x`. -/ +theorem exists_extension_of_le_sublinear (f : E →ₗ.[ℝ] ℝ) (N : E → ℝ) + (N_hom : ∀ (c : ℝ), 0 < c → ∀ x, N (c • x) = c * N x) + (N_add : ∀ x y, N (x + y) ≤ N x + N y) + (hf : ∀ x : f.domain, f x ≤ N x) : + ∃ g : E →ₗ[ℝ] ℝ, (∀ x : f.domain, g x = f x) ∧ (∀ x, g x ≤ N x) := +begin + let s : convex_cone ℝ (E × ℝ) := + { carrier := {p : E × ℝ | N p.1 ≤ p.2 }, + smul_mem' := λ c hc p hp, + calc N (c • p.1) = c * N p.1 : N_hom c hc p.1 + ... ≤ c * p.2 : mul_le_mul_of_nonneg_left hp hc.le, + add_mem' := λ x hx y hy, (N_add _ _).trans (add_le_add hx hy) }, + obtain ⟨g, g_eq, g_nonneg⟩ := + riesz_extension s ((-f).coprod (linear_map.id.to_pmap ⊤)) _ _; + try { simp only [linear_pmap.coprod_apply, to_pmap_apply, id_apply, + linear_pmap.neg_apply, ← sub_eq_neg_add, sub_nonneg, subtype.coe_mk] at * }, + replace g_eq : ∀ (x : f.domain) (y : ℝ), g (x, y) = y - f x, + { intros x y, + simpa only [subtype.coe_mk, subtype.coe_eta] using g_eq ⟨(x, y), ⟨x.2, trivial⟩⟩ }, + { refine ⟨-g.comp (inl ℝ E ℝ), _, _⟩; simp only [neg_apply, inl_apply, comp_apply], + { intro x, simp [g_eq x 0] }, + { intro x, + have A : (x, N x) = (x, 0) + (0, N x), by simp, + have B := g_nonneg ⟨x, N x⟩ (le_refl (N x)), + rw [A, map_add, ← neg_le_iff_add_nonneg'] at B, + have C := g_eq 0 (N x), + simp only [submodule.coe_zero, f.map_zero, sub_zero] at C, + rwa ← C } }, + { exact λ x hx, le_trans (hf _) hx }, + { rintros ⟨x, y⟩, + refine ⟨⟨(0, N x - y), ⟨f.domain.zero_mem, trivial⟩⟩, _⟩, + simp only [convex_cone.mem_mk, mem_set_of_eq, subtype.coe_mk, prod.fst_add, prod.snd_add, + zero_add, sub_add_cancel] } +end diff --git a/src/analysis/convex/cone/dual.lean b/src/analysis/convex/cone/dual.lean new file mode 100644 index 0000000000000..c8d05c0bce19a --- /dev/null +++ b/src/analysis/convex/cone/dual.lean @@ -0,0 +1,213 @@ +/- +Copyright (c) 2021 Alexander Bentkamp. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alexander Bentkamp +-/ +import analysis.convex.cone.basic +import analysis.inner_product_space.projection + +/-! +# Convex cones in inner product spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define `set.inner_dual_cone` to be the cone consisting of all points `y` such that for +all points `x` in a given set `0 ≤ ⟪ x, y ⟫`. + +## Main statements + +We prove the following theorems: +* `convex_cone.inner_dual_cone_of_inner_dual_cone_eq_self`: + The `inner_dual_cone` of the `inner_dual_cone` of a nonempty, closed, convex cone is itself. + +-/ + + +open set linear_map +open_locale classical pointwise + +variables {𝕜 E F G : Type*} + + +/-! ### The dual cone -/ + +section dual +variables {H : Type*} [normed_add_comm_group H] [inner_product_space ℝ H] (s t : set H) +open_locale real_inner_product_space + +/-- The dual cone is the cone consisting of all points `y` such that for +all points `x` in a given set `0 ≤ ⟪ x, y ⟫`. -/ +def set.inner_dual_cone (s : set H) : convex_cone ℝ H := +{ carrier := { y | ∀ x ∈ s, 0 ≤ ⟪ x, y ⟫ }, + smul_mem' := λ c hc y hy x hx, + begin + rw real_inner_smul_right, + exact mul_nonneg hc.le (hy x hx) + end, + add_mem' := λ u hu v hv x hx, + begin + rw inner_add_right, + exact add_nonneg (hu x hx) (hv x hx) + end } + +@[simp] lemma mem_inner_dual_cone (y : H) (s : set H) : + y ∈ s.inner_dual_cone ↔ ∀ x ∈ s, 0 ≤ ⟪ x, y ⟫ := iff.rfl + +@[simp] lemma inner_dual_cone_empty : (∅ : set H).inner_dual_cone = ⊤ := +eq_top_iff.mpr $ λ x hy y, false.elim + +/-- Dual cone of the convex cone {0} is the total space. -/ +@[simp] lemma inner_dual_cone_zero : (0 : set H).inner_dual_cone = ⊤ := +eq_top_iff.mpr $ λ x hy y (hy : y = 0), hy.symm ▸ (inner_zero_left _).ge + +/-- Dual cone of the total space is the convex cone {0}. -/ +@[simp] lemma inner_dual_cone_univ : (univ : set H).inner_dual_cone = 0 := +begin + suffices : ∀ x : H, x ∈ (univ : set H).inner_dual_cone → x = 0, + { apply set_like.coe_injective, + exact eq_singleton_iff_unique_mem.mpr ⟨λ x hx, (inner_zero_right _).ge, this⟩ }, + exact λ x hx, by simpa [←real_inner_self_nonpos] using hx (-x) (mem_univ _), +end + +lemma inner_dual_cone_le_inner_dual_cone (h : t ⊆ s) : + s.inner_dual_cone ≤ t.inner_dual_cone := +λ y hy x hx, hy x (h hx) + +lemma pointed_inner_dual_cone : s.inner_dual_cone.pointed := +λ x hx, by rw inner_zero_right + +/-- The inner dual cone of a singleton is given by the preimage of the positive cone under the +linear map `λ y, ⟪x, y⟫`. -/ +lemma inner_dual_cone_singleton (x : H) : + ({x} : set H).inner_dual_cone = (convex_cone.positive ℝ ℝ).comap (innerₛₗ ℝ x) := +convex_cone.ext $ λ i, forall_eq + +lemma inner_dual_cone_union (s t : set H) : + (s ∪ t).inner_dual_cone = s.inner_dual_cone ⊓ t.inner_dual_cone := +le_antisymm + (le_inf (λ x hx y hy, hx _ $ or.inl hy) (λ x hx y hy, hx _ $ or.inr hy)) + (λ x hx y, or.rec (hx.1 _) (hx.2 _)) + +lemma inner_dual_cone_insert (x : H) (s : set H) : + (insert x s).inner_dual_cone = set.inner_dual_cone {x} ⊓ s.inner_dual_cone := +by rw [insert_eq, inner_dual_cone_union] + +lemma inner_dual_cone_Union {ι : Sort*} (f : ι → set H) : + (⋃ i, f i).inner_dual_cone = ⨅ i, (f i).inner_dual_cone := +begin + refine le_antisymm (le_infi $ λ i x hx y hy, hx _ $ mem_Union_of_mem _ hy) _, + intros x hx y hy, + rw [convex_cone.mem_infi] at hx, + obtain ⟨j, hj⟩ := mem_Union.mp hy, + exact hx _ _ hj, +end + +lemma inner_dual_cone_sUnion (S : set (set H)) : + (⋃₀ S).inner_dual_cone = Inf (set.inner_dual_cone '' S) := +by simp_rw [Inf_image, sUnion_eq_bUnion, inner_dual_cone_Union] + +/-- The dual cone of `s` equals the intersection of dual cones of the points in `s`. -/ +lemma inner_dual_cone_eq_Inter_inner_dual_cone_singleton : + (s.inner_dual_cone : set H) = ⋂ i : s, (({i} : set H).inner_dual_cone : set H) := +by rw [←convex_cone.coe_infi, ←inner_dual_cone_Union, Union_of_singleton_coe] + +lemma is_closed_inner_dual_cone : is_closed (s.inner_dual_cone : set H) := +begin + -- reduce the problem to showing that dual cone of a singleton `{x}` is closed + rw inner_dual_cone_eq_Inter_inner_dual_cone_singleton, + apply is_closed_Inter, + intros x, + + -- the dual cone of a singleton `{x}` is the preimage of `[0, ∞)` under `inner x` + have h : ↑({x} : set H).inner_dual_cone = (inner x : H → ℝ) ⁻¹' set.Ici 0, + { rw [inner_dual_cone_singleton, convex_cone.coe_comap, convex_cone.coe_positive, + innerₛₗ_apply_coe] }, + + -- the preimage is closed as `inner x` is continuous and `[0, ∞)` is closed + rw h, + exact is_closed_Ici.preimage (by continuity), +end + +lemma convex_cone.pointed_of_nonempty_of_is_closed (K : convex_cone ℝ H) + (ne : (K : set H).nonempty) (hc : is_closed (K : set H)) : K.pointed := +begin + obtain ⟨x, hx⟩ := ne, + let f : ℝ → H := (• x), + + -- f (0, ∞) is a subset of K + have fI : f '' set.Ioi 0 ⊆ (K : set H), + { rintro _ ⟨_, h, rfl⟩, + exact K.smul_mem (set.mem_Ioi.1 h) hx }, + + -- closure of f (0, ∞) is a subset of K + have clf : closure (f '' set.Ioi 0) ⊆ (K : set H) := hc.closure_subset_iff.2 fI, + + -- f is continuous at 0 from the right + have fc : continuous_within_at f (set.Ioi (0 : ℝ)) 0 := + (continuous_id.smul continuous_const).continuous_within_at, + + -- 0 belongs to the closure of the f (0, ∞) + have mem₀ := fc.mem_closure_image (by rw [closure_Ioi (0 : ℝ), mem_Ici]), + + -- as 0 ∈ closure f (0, ∞) and closure f (0, ∞) ⊆ K, 0 ∈ K. + have f₀ : f 0 = 0 := zero_smul ℝ x, + simpa only [f₀, convex_cone.pointed, ← set_like.mem_coe] using mem_of_subset_of_mem clf mem₀, +end + +section complete_space +variables [complete_space H] + +/-- This is a stronger version of the Hahn-Banach separation theorem for closed convex cones. This +is also the geometric interpretation of Farkas' lemma. -/ +theorem convex_cone.hyperplane_separation_of_nonempty_of_is_closed_of_nmem (K : convex_cone ℝ H) + (ne : (K : set H).nonempty) (hc : is_closed (K : set H)) {b : H} (disj : b ∉ K) : + ∃ (y : H), (∀ x : H, x ∈ K → 0 ≤ ⟪x, y⟫_ℝ) ∧ ⟪y, b⟫_ℝ < 0 := +begin + -- let `z` be the point in `K` closest to `b` + obtain ⟨z, hzK, infi⟩ := exists_norm_eq_infi_of_complete_convex ne hc.is_complete K.convex b, + + -- for any `w` in `K`, we have `⟪b - z, w - z⟫_ℝ ≤ 0` + have hinner := (norm_eq_infi_iff_real_inner_le_zero K.convex hzK).1 infi, + + -- set `y := z - b` + use z - b, + + split, + { -- the rest of the proof is a straightforward calculation + rintros x hxK, + specialize hinner _ (K.add_mem hxK hzK), + rwa [add_sub_cancel, real_inner_comm, ← neg_nonneg, neg_eq_neg_one_mul, + ← real_inner_smul_right, neg_smul, one_smul, neg_sub] at hinner }, + { -- as `K` is closed and non-empty, it is pointed + have hinner₀ := hinner 0 (K.pointed_of_nonempty_of_is_closed ne hc), + + -- the rest of the proof is a straightforward calculation + rw [zero_sub, inner_neg_right, right.neg_nonpos_iff] at hinner₀, + have hbz : b - z ≠ 0 := by { rw sub_ne_zero, contrapose! hzK, rwa ← hzK }, + rw [← neg_zero, lt_neg, ← neg_one_mul, ← real_inner_smul_left, smul_sub, neg_smul, one_smul, + neg_smul, neg_sub_neg, one_smul], + calc 0 < ⟪b - z, b - z⟫_ℝ : lt_of_not_le ((iff.not real_inner_self_nonpos).2 hbz) + ... = ⟪b - z, b - z⟫_ℝ + 0 : (add_zero _).symm + ... ≤ ⟪b - z, b - z⟫_ℝ + ⟪b - z, z⟫_ℝ : add_le_add rfl.ge hinner₀ + ... = ⟪b - z, b - z + z⟫_ℝ : (inner_add_right _ _ _).symm + ... = ⟪b - z, b⟫_ℝ : by rw sub_add_cancel }, +end + +/-- The inner dual of inner dual of a non-empty, closed convex cone is itself. -/ +theorem convex_cone.inner_dual_cone_of_inner_dual_cone_eq_self (K : convex_cone ℝ H) + (ne : (K : set H).nonempty) (hc : is_closed (K : set H)) : + ((K : set H).inner_dual_cone : set H).inner_dual_cone = K := +begin + ext x, + split, + { rw [mem_inner_dual_cone, ← set_like.mem_coe], + contrapose!, + exact K.hyperplane_separation_of_nonempty_of_is_closed_of_nmem ne hc }, + { rintro hxK y h, + specialize h x hxK, + rwa real_inner_comm }, +end + +end complete_space +end dual diff --git a/src/analysis/convex/cone/proper.lean b/src/analysis/convex/cone/proper.lean new file mode 100644 index 0000000000000..8a76a074f3ae9 --- /dev/null +++ b/src/analysis/convex/cone/proper.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2022 Apurva Nakade All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Apurva Nakade +-/ +import analysis.convex.cone.dual +import analysis.inner_product_space.adjoint + +/-! +# Proper cones + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define a proper cone as a nonempty, closed, convex cone. Proper cones are used in defining conic +programs which generalize linear programs. A linear program is a conic program for the positive +cone. We then prove Farkas' lemma for conic programs following the proof in the reference below. +Farkas' lemma is equivalent to strong duality. So, once have the definitions of conic programs and +linear programs, the results from this file can be used to prove duality theorems. + +## TODO + +The next steps are: +- Add convex_cone_class that extends set_like and replace the below instance +- Define the positive cone as a proper cone. +- Define primal and dual cone programs and prove weak duality. +- Prove regular and strong duality for cone programs using Farkas' lemma (see reference). +- Define linear programs and prove LP duality as a special case of cone duality. +- Find a better reference (textbook instead of lecture notes). +- Show submodules are (proper) cones. + +## References + +- [B. Gartner and J. Matousek, Cone Programming][gartnerMatousek] + +-/ + +open continuous_linear_map filter set + +namespace convex_cone + +variables {𝕜 : Type*} [ordered_semiring 𝕜] +variables {E : Type*} [add_comm_monoid E] [topological_space E] [has_continuous_add E] + [has_smul 𝕜 E] [has_continuous_const_smul 𝕜 E] + +/-- The closure of a convex cone inside a topological space as a convex cone. This +construction is mainly used for defining maps between proper cones. -/ +protected def closure (K : convex_cone 𝕜 E) : convex_cone 𝕜 E := +{ carrier := closure ↑K, + smul_mem' := + λ c hc _ h₁, map_mem_closure (continuous_id'.const_smul c) h₁ (λ _ h₂, K.smul_mem hc h₂), + add_mem' := λ _ h₁ _ h₂, map_mem_closure₂ continuous_add h₁ h₂ K.add_mem } + +@[simp, norm_cast] lemma coe_closure (K : convex_cone 𝕜 E) : (K.closure : set E) = closure K := rfl + +@[simp] protected lemma mem_closure {K : convex_cone 𝕜 E} {a : E} : + a ∈ K.closure ↔ a ∈ closure (K : set E) := iff.rfl + +@[simp] lemma closure_eq {K L : convex_cone 𝕜 E} : K.closure = L ↔ closure (K : set E) = L := +set_like.ext'_iff + +end convex_cone + +/-- A proper cone is a convex cone `K` that is nonempty and closed. Proper cones have the nice +property that the dual of the dual of a proper cone is itself. This makes them useful for defining +cone programs and proving duality theorems. -/ +structure proper_cone (𝕜 : Type*) (E : Type*) + [ordered_semiring 𝕜] [add_comm_monoid E] [topological_space E] [has_smul 𝕜 E] + extends convex_cone 𝕜 E := +(nonempty' : (carrier : set E).nonempty) +(is_closed' : is_closed (carrier : set E)) + +namespace proper_cone + +section has_smul + +variables {𝕜 : Type*} [ordered_semiring 𝕜] +variables {E : Type*} [add_comm_monoid E] [topological_space E] [has_smul 𝕜 E] + +instance : has_coe (proper_cone 𝕜 E) (convex_cone 𝕜 E) := ⟨λ K, K.1⟩ + +@[simp] lemma to_convex_cone_eq_coe (K : proper_cone 𝕜 E) : K.to_convex_cone = K := rfl + +lemma ext' : function.injective (coe : proper_cone 𝕜 E → convex_cone 𝕜 E) := +λ S T h, by cases S; cases T; congr' + +-- TODO: add convex_cone_class that extends set_like and replace the below instance +instance : set_like (proper_cone 𝕜 E) E := +{ coe := λ K, K.carrier, + coe_injective' := λ _ _ h, proper_cone.ext' (set_like.coe_injective h) } + +@[ext] lemma ext {S T : proper_cone 𝕜 E} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := set_like.ext h + +@[simp] lemma mem_coe {x : E} {K : proper_cone 𝕜 E} : x ∈ (K : convex_cone 𝕜 E) ↔ x ∈ K := iff.rfl + +protected lemma nonempty (K : proper_cone 𝕜 E) : (K : set E).nonempty := K.nonempty' + +protected lemma is_closed (K : proper_cone 𝕜 E) : is_closed (K : set E) := K.is_closed' + +end has_smul + +section module + +variables {𝕜 : Type*} [ordered_semiring 𝕜] +variables {E : Type*} [add_comm_monoid E] [topological_space E] [t1_space E] [module 𝕜 E] + +instance : has_zero (proper_cone 𝕜 E) := +⟨ { to_convex_cone := 0, + nonempty' := ⟨0, rfl⟩, + is_closed' := is_closed_singleton } ⟩ + +instance : inhabited (proper_cone 𝕜 E) := ⟨0⟩ + +@[simp] lemma mem_zero (x : E) : x ∈ (0 : proper_cone 𝕜 E) ↔ x = 0 := iff.rfl +@[simp, norm_cast] lemma coe_zero : ↑(0 : proper_cone 𝕜 E) = (0 : convex_cone 𝕜 E) := rfl + +lemma pointed_zero : (0 : proper_cone 𝕜 E).pointed := by simp [convex_cone.pointed_zero] + +end module + +section inner_product_space + +variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] +variables {F : Type*} [normed_add_comm_group F] [inner_product_space ℝ F] +variables {G : Type*} [normed_add_comm_group G] [inner_product_space ℝ G] + +protected lemma pointed (K : proper_cone ℝ E) : (K : convex_cone ℝ E).pointed := +(K : convex_cone ℝ E).pointed_of_nonempty_of_is_closed K.nonempty K.is_closed + +/-- The closure of image of a proper cone under a continuous `ℝ`-linear map is a proper cone. We +use continuous maps here so that the comap of f is also a map between proper cones. -/ +noncomputable def map (f : E →L[ℝ] F) (K : proper_cone ℝ E) : proper_cone ℝ F := +{ to_convex_cone := convex_cone.closure (convex_cone.map (f : E →ₗ[ℝ] F) ↑K), + nonempty' := ⟨ 0, subset_closure $ set_like.mem_coe.2 $ convex_cone.mem_map.2 + ⟨0, K.pointed, map_zero _⟩ ⟩, + is_closed' := is_closed_closure } + +@[simp, norm_cast] lemma coe_map (f : E →L[ℝ] F) (K : proper_cone ℝ E) : + ↑(K.map f) = (convex_cone.map (f : E →ₗ[ℝ] F) ↑K).closure := rfl + +@[simp] lemma mem_map {f : E →L[ℝ] F} {K : proper_cone ℝ E} {y : F} : + y ∈ K.map f ↔ y ∈ (convex_cone.map (f : E →ₗ[ℝ] F) ↑K).closure := iff.rfl + +@[simp] lemma map_id (K : proper_cone ℝ E) : K.map (continuous_linear_map.id ℝ E) = K := +proper_cone.ext' $ by simpa using is_closed.closure_eq K.is_closed + +/-- The inner dual cone of a proper cone is a proper cone. -/ +def dual (K : proper_cone ℝ E): (proper_cone ℝ E) := +{ to_convex_cone := (K : set E).inner_dual_cone, + nonempty' := ⟨0, pointed_inner_dual_cone _⟩, + is_closed' := is_closed_inner_dual_cone _ } + +@[simp, norm_cast] +lemma coe_dual (K : proper_cone ℝ E) : ↑(dual K) = (K : set E).inner_dual_cone := rfl + +@[simp] lemma mem_dual {K : proper_cone ℝ E} {y : E} : + y ∈ dual K ↔ ∀ ⦃x⦄, x ∈ K → 0 ≤ ⟪x, y⟫_ℝ := +by {rw [← mem_coe, coe_dual, mem_inner_dual_cone _ _], refl} + +/-- The preimage of a proper cone under a continuous `ℝ`-linear map is a proper cone. -/ +noncomputable def comap (f : E →L[ℝ] F) (S : proper_cone ℝ F) : proper_cone ℝ E := +{ to_convex_cone := convex_cone.comap (f : E →ₗ[ℝ] F) S, + nonempty' := ⟨ 0, + begin + simp only [convex_cone.comap, mem_preimage, map_zero, set_like.mem_coe, mem_coe], + apply proper_cone.pointed, + end ⟩, + is_closed' := + begin + simp only [convex_cone.comap, continuous_linear_map.coe_coe], + apply is_closed.preimage f.2 S.is_closed, + end } + +@[simp] lemma coe_comap (f : E →L[ℝ] F) (S : proper_cone ℝ F) : (S.comap f : set E) = f ⁻¹' S := +rfl + +@[simp] lemma comap_id (S : convex_cone ℝ E) : S.comap linear_map.id = S := +set_like.coe_injective preimage_id + +lemma comap_comap (g : F →L[ℝ] G) (f : E →L[ℝ] F) (S : proper_cone ℝ G) : + (S.comap g).comap f = S.comap (g.comp f) := +set_like.coe_injective $ preimage_comp.symm + +@[simp] lemma mem_comap {f : E →L[ℝ] F} {S : proper_cone ℝ F} {x : E} : x ∈ S.comap f ↔ f x ∈ S := +iff.rfl + +end inner_product_space + +section complete_space + +variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] [complete_space E] +variables {F : Type*} [normed_add_comm_group F] [inner_product_space ℝ F] [complete_space F] + +/-- The dual of the dual of a proper cone is itself. -/ +@[simp] theorem dual_dual (K : proper_cone ℝ E) : K.dual.dual = K := proper_cone.ext' $ + (K : convex_cone ℝ E).inner_dual_cone_of_inner_dual_cone_eq_self K.nonempty K.is_closed + +/-- This is a relative version of +`convex_cone.hyperplane_separation_of_nonempty_of_is_closed_of_nmem`, which we recover by setting +`f` to be the identity map. This is a geometric interpretation of the Farkas' lemma +stated using proper cones. -/ +theorem hyperplane_separation (K : proper_cone ℝ E) {f : E →L[ℝ] F} {b : F} : + b ∈ K.map f ↔ ∀ y : F, (adjoint f y) ∈ K.dual → 0 ≤ ⟪y, b⟫_ℝ := iff.intro +begin + -- suppose `b ∈ K.map f` + simp only [proper_cone.mem_map, proper_cone.mem_dual, adjoint_inner_right, + convex_cone.mem_closure, mem_closure_iff_seq_limit], + + -- there is a sequence `seq : ℕ → F` in the image of `f` that converges to `b` + rintros ⟨seq, hmem, htends⟩ y hinner, + + suffices h : ∀ n, 0 ≤ ⟪y, seq n⟫_ℝ, from ge_of_tendsto' (continuous.seq_continuous + (continuous.inner (@continuous_const _ _ _ _ y) continuous_id) htends) h, + + intro n, + obtain ⟨_, h, hseq⟩ := hmem n, + simpa only [← hseq, real_inner_comm] using (hinner h), +end +begin + -- proof by contradiction + -- suppose `b ∉ K.map f` + intro h, + contrapose! h, + + -- as `b ∉ K.map f`, there is a hyperplane `y` separating `b` from `K.map f` + obtain ⟨y, hxy, hyb⟩ := convex_cone.hyperplane_separation_of_nonempty_of_is_closed_of_nmem _ + (K.map f).nonempty (K.map f).is_closed h, + + -- the rest of the proof is a straightforward algebraic manipulation + refine ⟨y, _, hyb⟩, + simp_rw [proper_cone.mem_dual, adjoint_inner_right], + intros x hxK, + apply hxy (f x), + rw [to_convex_cone_eq_coe, proper_cone.coe_map], + apply subset_closure, + rw [set_like.mem_coe, convex_cone.mem_map], + use ⟨x, hxK, rfl⟩, +end + +theorem hyperplane_separation_of_nmem (K : proper_cone ℝ E) {f : E →L[ℝ] F} {b : F} + (disj : b ∉ K.map f) : ∃ y : F, (adjoint f y) ∈ K.dual ∧ ⟪y, b⟫_ℝ < 0 := +by { contrapose! disj, rwa K.hyperplane_separation } + +end complete_space + +end proper_cone diff --git a/src/analysis/convex/contractible.lean b/src/analysis/convex/contractible.lean new file mode 100644 index 0000000000000..88bf959d51e58 --- /dev/null +++ b/src/analysis/convex/contractible.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.convex.star +import topology.homotopy.contractible + +/-! +# A convex set is contractible + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that a (star) convex set in a real topological vector space is a contractible +topological space. +-/ + +variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E] + [has_continuous_add E] [has_continuous_smul ℝ E] {s : set E} {x : E} + +/-- A non-empty star convex set is a contractible space. -/ +protected lemma star_convex.contractible_space (h : star_convex ℝ x s) (hne : s.nonempty) : + contractible_space s := +begin + refine (contractible_iff_id_nullhomotopic _).2 ⟨⟨x, h.mem hne⟩, + ⟨⟨⟨λ p, ⟨p.1.1 • x + (1 - p.1.1) • p.2, _⟩, _⟩, λ x, _, λ x, _⟩⟩⟩, + { exact h p.2.2 p.1.2.1 (sub_nonneg.2 p.1.2.2) (add_sub_cancel'_right _ _) }, + { exact ((continuous_subtype_val.fst'.smul continuous_const).add + ((continuous_const.sub continuous_subtype_val.fst').smul + continuous_subtype_val.snd')).subtype_mk _ }, + { ext1, simp }, + { ext1, simp } +end + +/-- A non-empty convex set is a contractible space. -/ +protected lemma convex.contractible_space (hs : convex ℝ s) (hne : s.nonempty) : + contractible_space s := +let ⟨x, hx⟩ := hne in (hs.star_convex hx).contractible_space hne + +@[priority 100] instance real_topological_vector_space.contractible_space : contractible_space E := +(homeomorph.set.univ E).contractible_space_iff.mp $ convex_univ.contractible_space set.univ_nonempty diff --git a/src/analysis/convex/exposed.lean b/src/analysis/convex/exposed.lean index 5a08c049de696..c8e7f15e4f45b 100644 --- a/src/analysis/convex/exposed.lean +++ b/src/analysis/convex/exposed.lean @@ -5,16 +5,20 @@ Authors: Yaël Dillies, Bhavik Mehta -/ import analysis.convex.extreme import analysis.convex.function -import analysis.normed_space.ordered +import topology.algebra.module.basic +import topology.order.basic /-! # Exposed sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines exposed sets and exposed points for sets in a real vector space. An exposed subset of `A` is a subset of `A` that is the set of all maximal points of a functional (a continuous linear map `E → 𝕜`) over `A`. By convention, `∅` is an exposed subset of all sets. -This allows for better functioriality of the definition (the intersection of two exposed subsets is +This allows for better functoriality of the definition (the intersection of two exposed subsets is exposed, faces of a polytope form a bounded lattice). This is an analytic notion of "being on the side of". It is stronger than being extreme (see `is_exposed.is_extreme`), but weaker (for exposed points) than being a vertex. @@ -45,15 +49,23 @@ More not-yet-PRed stuff is available on the branch `sperner_again`. open_locale classical affine big_operators open set -variables (𝕜 : Type*) {E : Type*} [normed_linear_ordered_field 𝕜] [normed_group E] - [normed_space 𝕜 E] {l : E →L[𝕜] 𝕜} {A B C : set E} {X : finset E} {x : E} +section preorder_semiring + +variables (𝕜 : Type*) {E : Type*} [topological_space 𝕜] [semiring 𝕜] [preorder 𝕜] + [add_comm_monoid E] [topological_space E] [module 𝕜 E] {A B : set E} /-- A set `B` is exposed with respect to `A` iff it maximizes some functional over `A` (and contains all points maximizing it). Written `is_exposed 𝕜 A B`. -/ def is_exposed (A B : set E) : Prop := B.nonempty → ∃ l : E →L[𝕜] 𝕜, B = {x ∈ A | ∀ y ∈ A, l y ≤ l x} -variables {𝕜} +end preorder_semiring + +section ordered_ring + +variables {𝕜 : Type*} {E : Type*} [topological_space 𝕜] [ordered_ring 𝕜] + [add_comm_monoid E] [topological_space E] [module 𝕜 E] + {l : E →L[𝕜] 𝕜} {A B C : set E} {X : finset E} {x : E} /-- A useful way to build exposed sets from intersecting `A` with halfspaces (modelled by an inequality with a functional). -/ @@ -95,25 +107,36 @@ begin (λ x hx, ⟨hBA hx.1, λ y hy, (hw.2 y hy).trans (hx.2 w (hCB hw))⟩)⟩, end -/-- If `B` is an exposed subset of `A`, then `B` is the intersection of `A` with some closed +/-- If `B` is a nonempty exposed subset of `A`, then `B` is the intersection of `A` with some closed halfspace. The converse is *not* true. It would require that the corresponding open halfspace doesn't intersect `A`. -/ -lemma eq_inter_halfspace (hAB : is_exposed 𝕜 A B) : +lemma eq_inter_halfspace' {A B : set E} (hAB : is_exposed 𝕜 A B) (hB : B.nonempty) : ∃ l : E →L[𝕜] 𝕜, ∃ a, B = {x ∈ A | a ≤ l x} := begin - obtain hB | hB := B.eq_empty_or_nonempty, - { refine ⟨0, 1, _⟩, - rw [hB, eq_comm, eq_empty_iff_forall_not_mem], - rintro x ⟨-, h⟩, - rw continuous_linear_map.zero_apply at h, - linarith }, obtain ⟨l, rfl⟩ := hAB hB, obtain ⟨w, hw⟩ := hB, exact ⟨l, l w, subset.antisymm (λ x hx, ⟨hx.1, hx.2 w hw.1⟩) (λ x hx, ⟨hx.1, λ y hy, (hw.2 y hy).trans hx.2⟩)⟩, end -protected lemma inter (hB : is_exposed 𝕜 A B) (hC : is_exposed 𝕜 A C) : +/-- For nontrivial `𝕜`, if `B` is an exposed subset of `A`, then `B` is the intersection of `A` with +some closed halfspace. The converse is *not* true. It would require that the corresponding open +halfspace doesn't intersect `A`. -/ +lemma eq_inter_halfspace [nontrivial 𝕜] {A B : set E} (hAB : is_exposed 𝕜 A B) : + ∃ l : E →L[𝕜] 𝕜, ∃ a, B = {x ∈ A | a ≤ l x} := +begin + obtain rfl | hB := B.eq_empty_or_nonempty, + { refine ⟨0, 1, _⟩, + rw [eq_comm, eq_empty_iff_forall_not_mem], + rintro x ⟨-, h⟩, + rw continuous_linear_map.zero_apply at h, + have : ¬ ((1:𝕜) ≤ 0) := not_le_of_lt zero_lt_one, + contradiction }, + exact hAB.eq_inter_halfspace' hB, +end + +protected lemma inter [has_continuous_add 𝕜] {A B C : set E} (hB : is_exposed 𝕜 A B) + (hC : is_exposed 𝕜 A C) : is_exposed 𝕜 A (B ∩ C) := begin rintro ⟨w, hwB, hwC⟩, @@ -130,7 +153,7 @@ begin (hx w hwB.1)) } end -lemma sInter {F : finset (set E)} (hF : F.nonempty) +lemma sInter [has_continuous_add 𝕜] {F : finset (set E)} (hF : F.nonempty) (hAF : ∀ B ∈ F, is_exposed 𝕜 A B) : is_exposed 𝕜 A (⋂₀ F) := begin @@ -138,7 +161,7 @@ begin refine finset.induction _ _, { rintro h, exfalso, - exact empty_not_nonempty h }, + exact not_nonempty_empty h }, rintro C F _ hF _ hCF, rw [finset.coe_insert, sInter_insert], obtain rfl | hFnemp := F.eq_empty_or_nonempty, @@ -164,42 +187,18 @@ begin exact hC.inter_left hCA, end -protected lemma is_extreme (hAB : is_exposed 𝕜 A B) : - is_extreme 𝕜 A B := -begin - refine ⟨hAB.subset, λ x₁ hx₁A x₂ hx₂A x hxB hx, _⟩, - obtain ⟨l, rfl⟩ := hAB ⟨x, hxB⟩, - have hl : convex_on 𝕜 univ l := l.to_linear_map.convex_on convex_univ, - have hlx₁ := hxB.2 x₁ hx₁A, - have hlx₂ := hxB.2 x₂ hx₂A, - refine ⟨⟨hx₁A, λ y hy, _⟩, ⟨hx₂A, λ y hy, _⟩⟩, - { rw hlx₁.antisymm (hl.le_left_of_right_le (mem_univ _) (mem_univ _) hx hlx₂), - exact hxB.2 y hy }, - { rw hlx₂.antisymm (hl.le_right_of_left_le (mem_univ _) (mem_univ _) hx hlx₁), - exact hxB.2 y hy } -end - -protected lemma convex (hAB : is_exposed 𝕜 A B) (hA : convex 𝕜 A) : - convex 𝕜 B := +protected lemma is_closed [order_closed_topology 𝕜] {A B : set E} + (hAB : is_exposed 𝕜 A B) (hA : is_closed A) : is_closed B := begin obtain rfl | hB := B.eq_empty_or_nonempty, - { exact convex_empty }, - obtain ⟨l, rfl⟩ := hAB hB, - exact λ x₁ x₂ hx₁ hx₂ a b ha hb hab, ⟨hA hx₁.1 hx₂.1 ha hb hab, λ y hy, - ((l.to_linear_map.concave_on convex_univ).convex_ge _ - ⟨mem_univ _, hx₁.2 y hy⟩ ⟨mem_univ _, hx₂.2 y hy⟩ ha hb hab).2⟩, -end - -protected lemma is_closed [order_closed_topology 𝕜] (hAB : is_exposed 𝕜 A B) (hA : is_closed A) : - is_closed B := -begin - obtain ⟨l, a, rfl⟩ := hAB.eq_inter_halfspace, + { simp }, + obtain ⟨l, a, rfl⟩ := hAB.eq_inter_halfspace' hB, exact hA.is_closed_le continuous_on_const l.continuous.continuous_on, end -protected lemma is_compact [order_closed_topology 𝕜] (hAB : is_exposed 𝕜 A B) (hA : is_compact A) : - is_compact B := -compact_of_is_closed_subset hA (hAB.is_closed hA.is_closed) hAB.subset +protected lemma is_compact [order_closed_topology 𝕜] [t2_space E] {A B : set E} + (hAB : is_exposed 𝕜 A B) (hA : is_compact A) : is_compact B := +is_compact_of_is_closed_subset hA (hAB.is_closed hA.is_closed) hAB.subset end is_exposed @@ -237,7 +236,48 @@ begin exact ⟨hl.1.1, l, λ y hy, ⟨hl.1.2 y hy, λ hxy, hl.2 y ⟨hy, λ z hz, (hl.1.2 z hz).trans hxy⟩⟩⟩, end +end ordered_ring + +section linear_ordered_ring + +variables {𝕜 : Type*} {E : Type*} [topological_space 𝕜] [linear_ordered_ring 𝕜] + [add_comm_monoid E] [topological_space E] [module 𝕜 E] + {A B C : set E} + +namespace is_exposed + +protected lemma convex (hAB : is_exposed 𝕜 A B) (hA : convex 𝕜 A) : + convex 𝕜 B := +begin + obtain rfl | hB := B.eq_empty_or_nonempty, + { exact convex_empty }, + obtain ⟨l, rfl⟩ := hAB hB, + exact λ x₁ hx₁ x₂ hx₂ a b ha hb hab, ⟨hA hx₁.1 hx₂.1 ha hb hab, λ y hy, + ((l.to_linear_map.concave_on convex_univ).convex_ge _ + ⟨mem_univ _, hx₁.2 y hy⟩ ⟨mem_univ _, hx₂.2 y hy⟩ ha hb hab).2⟩, +end + +protected lemma is_extreme (hAB : is_exposed 𝕜 A B) : + is_extreme 𝕜 A B := +begin + refine ⟨hAB.subset, λ x₁ hx₁A x₂ hx₂A x hxB hx, _⟩, + obtain ⟨l, rfl⟩ := hAB ⟨x, hxB⟩, + have hl : convex_on 𝕜 univ l := l.to_linear_map.convex_on convex_univ, + have hlx₁ := hxB.2 x₁ hx₁A, + have hlx₂ := hxB.2 x₂ hx₂A, + refine ⟨⟨hx₁A, λ y hy, _⟩, ⟨hx₂A, λ y hy, _⟩⟩, + { have := @convex_on.le_left_of_right_le 𝕜 E 𝕜 _ _ _, + rw hlx₁.antisymm (hl.le_left_of_right_le (mem_univ _) (mem_univ _) hx hlx₂), + exact hxB.2 y hy }, + { rw hlx₂.antisymm (hl.le_right_of_left_le (mem_univ _) (mem_univ _) hx hlx₁), + exact hxB.2 y hy } +end + +end is_exposed + lemma exposed_points_subset_extreme_points : A.exposed_points 𝕜 ⊆ A.extreme_points 𝕜 := λ x hx, mem_extreme_points_iff_extreme_singleton.2 (mem_exposed_points_iff_exposed_singleton.1 hx).is_extreme + +end linear_ordered_ring diff --git a/src/analysis/convex/extrema.lean b/src/analysis/convex/extrema.lean index 340be610d6774..416e8a5a1fdcd 100644 --- a/src/analysis/convex/extrema.lean +++ b/src/analysis/convex/extrema.lean @@ -11,6 +11,9 @@ import topology.metric_space.basic /-! # Minima and maxima of convex functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that if a function `f : E → β` is convex, then a local minimum is also a global minimum, and likewise for concave functions. -/ @@ -21,7 +24,7 @@ variables {E β : Type*} [add_comm_group E] [topological_space E] {s : set E} open set filter function -open_locale classical topological_space +open_locale classical topology /-- Helper lemma for the more general case: `is_min_on.of_is_local_min_on_of_convex_on`. diff --git a/src/analysis/convex/extreme.lean b/src/analysis/convex/extreme.lean index cde58f3eb43ff..810e6ceec6282 100644 --- a/src/analysis/convex/extreme.lean +++ b/src/analysis/convex/extreme.lean @@ -8,6 +8,9 @@ import analysis.convex.hull /-! # Extreme sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines extreme sets and extreme points for sets in a module. An extreme set of `A` is a subset of `A` that is as far as it can get in any outward direction: If @@ -35,28 +38,28 @@ See chapter 8 of [Barry Simon, *Convexity*][simon2011] ## TODO -Define intrinsic frontier and prove lemmas related to extreme sets and points. +Prove lemmas relating extreme sets and points to the intrinsic frontier. More not-yet-PRed stuff is available on the branch `sperner_again`. -/ -open_locale classical affine -open set +open function set +open_locale affine classical -variables (𝕜 : Type*) {E : Type*} +variables {𝕜 E F ι : Type*} {π : ι → Type*} -section has_scalar -variables [ordered_semiring 𝕜] [add_comm_monoid E] [has_scalar 𝕜 E] +section has_smul +variables (𝕜) [ordered_semiring 𝕜] [add_comm_monoid E] [has_smul 𝕜 E] /-- A set `B` is an extreme subset of `A` if `B ⊆ A` and all points of `B` only belong to open segments whose ends are in `B`. -/ def is_extreme (A B : set E) : Prop := -B ⊆ A ∧ ∀ x₁ x₂ ∈ A, ∀ x ∈ B, x ∈ open_segment 𝕜 x₁ x₂ → x₁ ∈ B ∧ x₂ ∈ B +B ⊆ A ∧ ∀ ⦃x₁⦄, x₁ ∈ A → ∀ ⦃x₂⦄, x₂ ∈ A → ∀ ⦃x⦄, x ∈ B → x ∈ open_segment 𝕜 x₁ x₂ → x₁ ∈ B ∧ x₂ ∈ B /-- A point `x` is an extreme point of a set `A` if `x` belongs to no open segment with ends in `A`, except for the obvious `open_segment x x`. -/ def set.extreme_points (A : set E) : set E := -{x ∈ A | ∀ (x₁ x₂ ∈ A), x ∈ open_segment 𝕜 x₁ x₂ → x₁ = x ∧ x₂ = x} +{x ∈ A | ∀ ⦃x₁⦄, x₁ ∈ A → ∀ ⦃x₂⦄, x₂ ∈ A → x ∈ open_segment 𝕜 x₁ x₂ → x₁ = x ∧ x₂ = x} @[refl] protected lemma is_extreme.refl (A : set E) : is_extreme 𝕜 A A := @@ -72,8 +75,8 @@ is_extreme.refl 𝕜 A is_extreme 𝕜 A C := begin refine ⟨subset.trans hBC.1 hAB.1, λ x₁ hx₁A x₂ hx₂A x hxC hx, _⟩, - obtain ⟨hx₁B, hx₂B⟩ := hAB.2 x₁ hx₁A x₂ hx₂A x (hBC.1 hxC) hx, - exact hBC.2 x₁ hx₁B x₂ hx₂B x hxC hx, + obtain ⟨hx₁B, hx₂B⟩ := hAB.2 hx₁A hx₂A (hBC.1 hxC) hx, + exact hBC.2 hx₁B hx₂B hxC hx, end protected lemma is_extreme.antisymm : @@ -89,51 +92,43 @@ lemma is_extreme.inter (hAB : is_extreme 𝕜 A B) (hAC : is_extreme 𝕜 A C) : is_extreme 𝕜 A (B ∩ C) := begin use subset.trans (inter_subset_left _ _) hAB.1, - rintro x₁ x₂ hx₁A hx₂A x ⟨hxB, hxC⟩ hx, - obtain ⟨hx₁B, hx₂B⟩ := hAB.2 x₁ x₂ hx₁A hx₂A x hxB hx, - obtain ⟨hx₁C, hx₂C⟩ := hAC.2 x₁ x₂ hx₁A hx₂A x hxC hx, + rintro x₁ hx₁A x₂ hx₂A x ⟨hxB, hxC⟩ hx, + obtain ⟨hx₁B, hx₂B⟩ := hAB.2 hx₁A hx₂A hxB hx, + obtain ⟨hx₁C, hx₂C⟩ := hAC.2 hx₁A hx₂A hxC hx, exact ⟨⟨hx₁B, hx₁C⟩, hx₂B, hx₂C⟩, end protected lemma is_extreme.mono (hAC : is_extreme 𝕜 A C) (hBA : B ⊆ A) (hCB : C ⊆ B) : is_extreme 𝕜 B C := -⟨hCB, λ x₁ hx₁B x₂ hx₂B x hxC hx, hAC.2 x₁ (hBA hx₁B) x₂ (hBA hx₂B) x hxC hx⟩ +⟨hCB, λ x₁ hx₁B x₂ hx₂B x hxC hx, hAC.2 (hBA hx₁B) (hBA hx₂B) hxC hx⟩ -lemma is_extreme_Inter {ι : Type*} [nonempty ι] {F : ι → set E} +lemma is_extreme_Inter {ι : Sort*} [nonempty ι] {F : ι → set E} (hAF : ∀ i : ι, is_extreme 𝕜 A (F i)) : is_extreme 𝕜 A (⋂ i : ι, F i) := begin obtain i := classical.arbitrary ι, - use Inter_subset_of_subset i (hAF i).1, - rintro x₁ x₂ hx₁A hx₂A x hxF hx, + refine ⟨Inter_subset_of_subset i (hAF i).1, λ x₁ hx₁A x₂ hx₂A x hxF hx, _⟩, simp_rw mem_Inter at ⊢ hxF, - have h := λ i, (hAF i).2 x₁ x₂ hx₁A hx₂A x (hxF i) hx, + have h := λ i, (hAF i).2 hx₁A hx₂A (hxF i) hx, exact ⟨λ i, (h i).1, λ i, (h i).2⟩, end -lemma is_extreme_bInter {F : set (set E)} (hF : F.nonempty) - (hAF : ∀ B ∈ F, is_extreme 𝕜 A B) : +lemma is_extreme_bInter {F : set (set E)} (hF : F.nonempty) (hA : ∀ B ∈ F, is_extreme 𝕜 A B) : is_extreme 𝕜 A (⋂ B ∈ F, B) := -begin - obtain ⟨B, hB⟩ := hF, - refine ⟨(bInter_subset_of_mem hB).trans (hAF B hB).1, λ x₁ x₂ hx₁A hx₂A x hxF hx, _⟩, - simp_rw mem_Inter₂ at ⊢ hxF, - have h := λ B hB, (hAF B hB).2 x₁ x₂ hx₁A hx₂A x (hxF B hB) hx, - exact ⟨λ B hB, (h B hB).1, λ B hB, (h B hB).2⟩, -end +by { haveI := hF.to_subtype, simpa only [Inter_subtype] using is_extreme_Inter (λ i : F, hA _ i.2) } lemma is_extreme_sInter {F : set (set E)} (hF : F.nonempty) (hAF : ∀ B ∈ F, is_extreme 𝕜 A B) : is_extreme 𝕜 A (⋂₀ F) := begin obtain ⟨B, hB⟩ := hF, - refine ⟨(sInter_subset_of_mem hB).trans (hAF B hB).1, λ x₁ x₂ hx₁A hx₂A x hxF hx, _⟩, + refine ⟨(sInter_subset_of_mem hB).trans (hAF B hB).1, λ x₁ hx₁A x₂ hx₂A x hxF hx, _⟩, simp_rw mem_sInter at ⊢ hxF, - have h := λ B hB, (hAF B hB).2 x₁ x₂ hx₁A hx₂A x (hxF B hB) hx, + have h := λ B hB, (hAF B hB).2 hx₁A hx₂A (hxF B hB) hx, exact ⟨λ B hB, (h B hB).1, λ B hB, (h B hB).2⟩, end -lemma extreme_points_def : +lemma mem_extreme_points : x ∈ A.extreme_points 𝕜 ↔ x ∈ A ∧ ∀ (x₁ x₂ ∈ A), x ∈ open_segment 𝕜 x₁ x₂ → x₁ = x ∧ x₂ = x := iff.rfl @@ -141,11 +136,11 @@ iff.rfl lemma mem_extreme_points_iff_extreme_singleton : x ∈ A.extreme_points 𝕜 ↔ is_extreme 𝕜 A {x} := begin - refine ⟨_, λ hx, ⟨singleton_subset_iff.1 hx.1, λ x₁ x₂ hx₁ hx₂, hx.2 x₁ x₂ hx₁ hx₂ x rfl⟩⟩, + refine ⟨_, λ hx, ⟨singleton_subset_iff.1 hx.1, λ x₁ hx₁ x₂ hx₂, hx.2 hx₁ hx₂ rfl⟩⟩, rintro ⟨hxA, hAx⟩, use singleton_subset_iff.2 hxA, - rintro x₁ x₂ hx₁A hx₂A y (rfl : y = x), - exact hAx x₁ x₂ hx₁A hx₂A, + rintro x₁ hx₁A x₂ hx₂A y (rfl : y = x), + exact hAx hx₁A hx₂A, end lemma extreme_points_subset : A.extreme_points 𝕜 ⊆ A := λ x hx, hx.1 @@ -161,7 +156,7 @@ extreme_points_subset.antisymm $ singleton_subset_iff.2 lemma inter_extreme_points_subset_extreme_points_of_subset (hBA : B ⊆ A) : B ∩ A.extreme_points 𝕜 ⊆ B.extreme_points 𝕜 := -λ x ⟨hxB, hxA⟩, ⟨hxB, λ x₁ hx₁ x₂ hx₂ hx, hxA.2 x₁ (hBA hx₁) x₂ (hBA hx₂) hx⟩ +λ x ⟨hxB, hxA⟩, ⟨hxB, λ x₁ hx₁ x₂ hx₂ hx, hxA.2 (hBA hx₁) (hBA hx₂) hx⟩ lemma is_extreme.extreme_points_subset_extreme_points (hAB : is_extreme 𝕜 A B) : B.extreme_points 𝕜 ⊆ A.extreme_points 𝕜 := @@ -173,15 +168,61 @@ lemma is_extreme.extreme_points_eq (hAB : is_extreme 𝕜 A B) : subset.antisymm (λ x hx, ⟨hx.1, hAB.extreme_points_subset_extreme_points hx⟩) (inter_extreme_points_subset_extreme_points_of_subset hAB.1) -end has_scalar +end has_smul section ordered_semiring -variables {𝕜} [ordered_semiring 𝕜] [add_comm_group E] [module 𝕜 E] {A B : set E} {x : E} +variables [ordered_semiring 𝕜] [add_comm_group E] [add_comm_group F] [Π i, add_comm_group (π i)] + [module 𝕜 E] [module 𝕜 F] [Π i, module 𝕜 (π i)] {A B : set E} {x : E} lemma is_extreme.convex_diff (hA : convex 𝕜 A) (hAB : is_extreme 𝕜 A B) : convex 𝕜 (A \ B) := -convex_iff_open_segment_subset.2 (λ x₁ x₂ ⟨hx₁A, hx₁B⟩ ⟨hx₂A, hx₂B⟩ x hx, - ⟨hA.open_segment_subset hx₁A hx₂A hx, λ hxB, hx₁B (hAB.2 x₁ hx₁A x₂ hx₂A x hxB hx).1⟩) +convex_iff_open_segment_subset.2 (λ x₁ ⟨hx₁A, hx₁B⟩ x₂ ⟨hx₂A, hx₂B⟩ x hx, + ⟨hA.open_segment_subset hx₁A hx₂A hx, λ hxB, hx₁B (hAB.2 hx₁A hx₂A hxB hx).1⟩) + +@[simp] lemma extreme_points_prod (s : set E) (t : set F) : + (s ×ˢ t).extreme_points 𝕜 = s.extreme_points 𝕜 ×ˢ t.extreme_points 𝕜 := +begin + ext, + refine (and_congr_right $ λ hx, ⟨λ h, _, λ h, _⟩).trans (and_and_and_comm _ _ _ _), + split, + { rintro x₁ hx₁ x₂ hx₂ hx_fst, + refine (h (mk_mem_prod hx₁ hx.2) (mk_mem_prod hx₂ hx.2) _).imp + (congr_arg prod.fst) (congr_arg prod.fst), + rw ←prod.image_mk_open_segment_left, + exact ⟨_, hx_fst, prod.mk.eta⟩ }, + { rintro x₁ hx₁ x₂ hx₂ hx_snd, + refine (h (mk_mem_prod hx.1 hx₁) (mk_mem_prod hx.1 hx₂) _).imp + (congr_arg prod.snd) (congr_arg prod.snd), + rw ←prod.image_mk_open_segment_right, + exact ⟨_, hx_snd, prod.mk.eta⟩ }, + { rintro x₁ hx₁ x₂ hx₂ ⟨a, b, ha, hb, hab, hx'⟩, + simp_rw prod.ext_iff, + exact (and_and_and_comm _ _ _ _).1 + ⟨h.1 hx₁.1 hx₂.1 ⟨a, b, ha, hb, hab, congr_arg prod.fst hx'⟩, + h.2 hx₁.2 hx₂.2 ⟨a, b, ha, hb, hab, congr_arg prod.snd hx'⟩⟩ } +end + +@[simp] lemma extreme_points_pi (s : Π i, set (π i)) : + (univ.pi s).extreme_points 𝕜 = univ.pi (λ i, (s i).extreme_points 𝕜) := +begin + ext, + simp only [mem_extreme_points, mem_pi, mem_univ, true_implies_iff, @forall_and_distrib ι], + refine and_congr_right (λ hx, ⟨λ h i, _, λ h, _⟩), + { rintro x₁ hx₁ x₂ hx₂ hi, + refine (h (update x i x₁) _ (update x i x₂) _ _).imp (λ h₁, by rw [←h₁, update_same]) + (λ h₂, by rw [←h₂, update_same]), + iterate 2 + { rintro j, + obtain rfl | hji := eq_or_ne j i, + { rwa update_same }, + { rw update_noteq hji, + exact hx _ } }, + rw ←pi.image_update_open_segment, + exact ⟨_, hi, update_eq_self _ _⟩ }, + { rintro x₁ hx₁ x₂ hx₂ ⟨a, b, ha, hb, hab, hx'⟩, + simp_rw [funext_iff, ←forall_and_distrib], + exact λ i, h _ _ (hx₁ _) _ (hx₂ _) ⟨a, b, ha, hb, hab, congr_fun hx' _⟩ } +end end ordered_semiring diff --git a/src/analysis/convex/function.lean b/src/analysis/convex/function.lean index 94cd592ec2d38..bd2752936998c 100644 --- a/src/analysis/convex/function.lean +++ b/src/analysis/convex/function.lean @@ -4,14 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Alexander Bentkamp, François Dupuis -/ import analysis.convex.basic -import order.order_dual -import tactic.field_simp -import tactic.linarith -import tactic.ring /-! # Convex and concave functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines convex and concave functions in vector spaces and proves the finite Jensen inequality. The integral version can be found in `analysis.convex.integral`. @@ -31,7 +30,7 @@ a convex set. open finset linear_map set open_locale big_operators classical convex pointwise -variables {𝕜 E F β ι : Type*} +variables {𝕜 E F α β ι : Type*} section ordered_semiring variables [ordered_semiring 𝕜] @@ -40,33 +39,33 @@ section add_comm_monoid variables [add_comm_monoid E] [add_comm_monoid F] section ordered_add_comm_monoid -variables [ordered_add_comm_monoid β] +variables [ordered_add_comm_monoid α] [ordered_add_comm_monoid β] -section has_scalar -variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 β] (s : set E) (f : E → β) +section has_smul +variables (𝕜) [has_smul 𝕜 E] [has_smul 𝕜 α] [has_smul 𝕜 β] (s : set E) (f : E → β) {g : β → α} /-- Convexity of functions -/ def convex_on : Prop := convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → f (a • x + b • y) ≤ a • f x + b • f y /-- Concavity of functions -/ def concave_on : Prop := convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → a • f x + b • f y ≤ f (a • x + b • y) /-- Strict convexity of functions -/ def strict_convex_on : Prop := convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) < a • f x + b • f y /-- Strict concavity of functions -/ def strict_concave_on : Prop := convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y < f (a • x + b • y) variables {𝕜 s f} @@ -89,30 +88,74 @@ lemma concave_on_id {s : set β} (hs : convex 𝕜 s) : concave_on 𝕜 s id := lemma convex_on.subset {t : set E} (hf : convex_on 𝕜 t f) (hst : s ⊆ t) (hs : convex 𝕜 s) : convex_on 𝕜 s f := -⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩ +⟨hs, λ x hx y hy, hf.2 (hst hx) (hst hy)⟩ lemma concave_on.subset {t : set E} (hf : concave_on 𝕜 t f) (hst : s ⊆ t) (hs : convex 𝕜 s) : concave_on 𝕜 s f := -⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩ +⟨hs, λ x hx y hy, hf.2 (hst hx) (hst hy)⟩ lemma strict_convex_on.subset {t : set E} (hf : strict_convex_on 𝕜 t f) (hst : s ⊆ t) (hs : convex 𝕜 s) : strict_convex_on 𝕜 s f := -⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩ +⟨hs, λ x hx y hy, hf.2 (hst hx) (hst hy)⟩ lemma strict_concave_on.subset {t : set E} (hf : strict_concave_on 𝕜 t f) (hst : s ⊆ t) (hs : convex 𝕜 s) : strict_concave_on 𝕜 s f := -⟨hs, λ x y hx hy, hf.2 (hst hx) (hst hy)⟩ - -end has_scalar - +⟨hs, λ x hx y hy, hf.2 (hst hx) (hst hy)⟩ + +lemma convex_on.comp (hg : convex_on 𝕜 (f '' s) g) (hf : convex_on 𝕜 s f) + (hg' : monotone_on g (f '' s)) : convex_on 𝕜 s (g ∘ f) := +⟨hf.1, λ x hx y hy a b ha hb hab, (hg' (mem_image_of_mem f $ hf.1 hx hy ha hb hab) + (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab) $ hf.2 hx hy ha hb hab).trans $ + hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab⟩ + +lemma concave_on.comp (hg : concave_on 𝕜 (f '' s) g) (hf : concave_on 𝕜 s f) + (hg' : monotone_on g (f '' s)) : concave_on 𝕜 s (g ∘ f) := +⟨hf.1, λ x hx y hy a b ha hb hab, + (hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab).trans $ + hg' (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha hb hab) + (mem_image_of_mem f $ hf.1 hx hy ha hb hab) $ hf.2 hx hy ha hb hab⟩ + +lemma convex_on.comp_concave_on (hg : convex_on 𝕜 (f '' s) g) (hf : concave_on 𝕜 s f) + (hg' : antitone_on g (f '' s)) : convex_on 𝕜 s (g ∘ f) := +hg.dual.comp hf hg' + +lemma concave_on.comp_convex_on (hg : concave_on 𝕜 (f '' s) g) (hf : convex_on 𝕜 s f) + (hg' : antitone_on g (f '' s)) : concave_on 𝕜 s (g ∘ f) := +hg.dual.comp hf hg' + +lemma strict_convex_on.comp (hg : strict_convex_on 𝕜 (f '' s) g) (hf : strict_convex_on 𝕜 s f) + (hg' : strict_mono_on g (f '' s)) (hf' : s.inj_on f) : strict_convex_on 𝕜 s (g ∘ f) := +⟨hf.1, λ x hx y hy hxy a b ha hb hab, (hg' (mem_image_of_mem f $ hf.1 hx hy ha.le hb.le hab) + (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha.le hb.le hab) $ + hf.2 hx hy hxy ha hb hab).trans $ + hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) (mt (hf' hx hy) hxy) ha hb hab⟩ + +lemma strict_concave_on.comp (hg : strict_concave_on 𝕜 (f '' s) g) (hf : strict_concave_on 𝕜 s f) + (hg' : strict_mono_on g (f '' s)) (hf' : s.inj_on f) : strict_concave_on 𝕜 s (g ∘ f) := +⟨hf.1, λ x hx y hy hxy a b ha hb hab, + (hg.2 (mem_image_of_mem f hx) (mem_image_of_mem f hy) (mt (hf' hx hy) hxy) ha hb hab).trans $ + hg' (hg.1 (mem_image_of_mem f hx) (mem_image_of_mem f hy) ha.le hb.le hab) + (mem_image_of_mem f $ hf.1 hx hy ha.le hb.le hab) $ hf.2 hx hy hxy ha hb hab⟩ + +lemma strict_convex_on.comp_strict_concave_on (hg : strict_convex_on 𝕜 (f '' s) g) + (hf : strict_concave_on 𝕜 s f) (hg' : strict_anti_on g (f '' s)) (hf' : s.inj_on f) : + strict_convex_on 𝕜 s (g ∘ f) := +hg.dual.comp hf hg' hf' + +lemma strict_concave_on.comp_strict_convex_on (hg : strict_concave_on 𝕜 (f '' s) g) + (hf : strict_convex_on 𝕜 s f) (hg' : strict_anti_on g (f '' s)) (hf' : s.inj_on f) : + strict_concave_on 𝕜 s (g ∘ f) := +hg.dual.comp hf hg' hf' + +end has_smul section distrib_mul_action -variables [has_scalar 𝕜 E] [distrib_mul_action 𝕜 β] {s : set E} {f g : E → β} +variables [has_smul 𝕜 E] [distrib_mul_action 𝕜 β] {s : set E} {f g : E → β} lemma convex_on.add (hf : convex_on 𝕜 s f) (hg : convex_on 𝕜 s g) : convex_on 𝕜 s (f + g) := -⟨hf.1, λ x y hx hy a b ha hb hab, +⟨hf.1, λ x hx y hy a b ha hb hab, calc f (a • x + b • y) + g (a • x + b • y) ≤ (a • f x + b • f y) + (a • g x + b • g y) : add_le_add (hf.2 hx hy ha hb hab) (hg.2 hx hy ha hb hab) @@ -125,7 +168,7 @@ hf.dual.add hg end distrib_mul_action section module -variables [has_scalar 𝕜 E] [module 𝕜 β] {s : set E} {f : E → β} +variables [has_smul 𝕜 E] [module 𝕜 β] {s : set E} {f : E → β} lemma convex_on_const (c : β) (hs : convex 𝕜 s) : convex_on 𝕜 s (λ x:E, c) := ⟨hs, λ x y _ _ a b _ _ hab, (convex.combo_self hab c).ge⟩ @@ -135,8 +178,8 @@ lemma concave_on_const (c : β) (hs : convex 𝕜 s) : concave_on 𝕜 s (λ x:E lemma convex_on_of_convex_epigraph (h : convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2}) : convex_on 𝕜 s f := -⟨λ x y hx hy a b ha hb hab, (@h (x, f x) (y, f y) ⟨hx, le_rfl⟩ ⟨hy, le_rfl⟩ a b ha hb hab).1, - λ x y hx hy a b ha hb hab, (@h (x, f x) (y, f y) ⟨hx, le_rfl⟩ ⟨hy, le_rfl⟩ a b ha hb hab).2⟩ +⟨λ x hx y hy a b ha hb hab, (@h (x, f x) ⟨hx, le_rfl⟩ (y, f y) ⟨hy, le_rfl⟩ a b ha hb hab).1, + λ x hx y hy a b ha hb hab, (@h (x, f x) ⟨hx, le_rfl⟩ (y, f y) ⟨hy, le_rfl⟩ a b ha hb hab).2⟩ lemma concave_on_of_convex_hypograph (h : convex 𝕜 {p : E × β | p.1 ∈ s ∧ p.2 ≤ f p.1}) : concave_on 𝕜 s f := @@ -145,11 +188,11 @@ lemma concave_on_of_convex_hypograph (h : convex 𝕜 {p : E × β | p.1 ∈ s end module section ordered_smul -variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} +variables [has_smul 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} lemma convex_on.convex_le (hf : convex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x ≤ r} := -λ x y hx hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha hb hab, +λ x hx y hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha hb hab, calc f (a • x + b • y) ≤ a • f x + b • f y : hf.2 hx.1 hy.1 ha hb hab ... ≤ a • r + b • r : add_le_add (smul_le_smul_of_nonneg hx.2 ha) @@ -163,7 +206,7 @@ hf.dual.convex_le r lemma convex_on.convex_epigraph (hf : convex_on 𝕜 s f) : convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 ≤ p.2} := begin - rintro ⟨x, r⟩ ⟨y, t⟩ ⟨hx, hr⟩ ⟨hy, ht⟩ a b ha hb hab, + rintro ⟨x, r⟩ ⟨hx, hr⟩ ⟨y, t⟩ ⟨hy, ht⟩ a b ha hb hab, refine ⟨hf.1 hx hy ha hb hab, _⟩, calc f (a • x + b • y) ≤ a • f x + b • f y : hf.2 hx hy ha hb hab ... ≤ a • r + b • t : add_le_add (smul_le_smul_of_nonneg hr ha) @@ -185,12 +228,12 @@ lemma concave_on_iff_convex_hypograph : end ordered_smul section module -variables [module 𝕜 E] [has_scalar 𝕜 β] {s : set E} {f : E → β} +variables [module 𝕜 E] [has_smul 𝕜 β] {s : set E} {f : E → β} /-- Right translation preserves convexity. -/ lemma convex_on.translate_right (hf : convex_on 𝕜 s f) (c : E) : convex_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, c + z)) := -⟨hf.1.translate_preimage_right _, λ x y hx hy a b ha hb hab, +⟨hf.1.translate_preimage_right _, λ x hx y hy a b ha hb hab, calc f (c + (a • x + b • y)) = f (a • (c + x) + b • (c + y)) : by rw [smul_add, smul_add, add_add_add_comm, convex.combo_self hab] @@ -218,11 +261,11 @@ variables [module 𝕜 E] [module 𝕜 β] lemma convex_on_iff_forall_pos {s : set E} {f : E → β} : convex_on 𝕜 s f ↔ convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) ≤ a • f x + b • f y := begin - refine and_congr_right' ⟨λ h x y hx hy a b ha hb hab, h hx hy ha.le hb.le hab, - λ h x y hx hy a b ha hb hab, _⟩, + refine and_congr_right' ⟨λ h x hx y hy a b ha hb hab, h hx hy ha.le hb.le hab, + λ h x hx y hy a b ha hb hab, _⟩, obtain rfl | ha' := ha.eq_or_lt, { rw [zero_add] at hab, subst b, simp_rw [zero_smul, zero_add, one_smul] }, obtain rfl | hb' := hb.eq_or_lt, @@ -232,7 +275,7 @@ end lemma concave_on_iff_forall_pos {s : set E} {f : E → β} : concave_on 𝕜 s f ↔ convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y ≤ f (a • x + b • y) := @convex_on_iff_forall_pos 𝕜 E βᵒᵈ _ _ _ _ _ _ _ @@ -243,7 +286,7 @@ lemma convex_on_iff_pairwise_pos {s : set E} {f : E → β} : begin rw convex_on_iff_forall_pos, refine and_congr_right' ⟨λ h x hx y hy _ a b ha hb hab, h hx hy ha hb hab, - λ h x y hx hy a b ha hb hab, _⟩, + λ h x hx y hy a b ha hb hab, _⟩, obtain rfl | hxy := eq_or_ne x y, { rw [convex.combo_self hab, convex.combo_self hab] }, exact h hx hy hxy ha hb hab, @@ -298,13 +341,14 @@ verify the inequality `f (a • x + b • y) ≤ a • f x + b • f y` only for `b`. The main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/ lemma linear_order.convex_on_of_lt (hs : convex 𝕜 s) - (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → + (hf : ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) ≤ a • f x + b • f y) : convex_on 𝕜 s f := begin refine convex_on_iff_pairwise_pos.2 ⟨hs, λ x hx y hy hxy a b ha hb hab, _⟩, - wlog h : x ≤ y using [x y a b, y x b a], - { exact le_total _ _ }, - exact hf hx hy (h.lt_of_ne hxy) ha hb hab, + wlog h : x < y, + { rw [add_comm (a • x), add_comm (a • f x)], rw add_comm at hab, + refine this hs hf y hy x hx hxy.symm b a hb ha hab (hxy.lt_or_lt.resolve_left h), }, + exact hf hx hy h ha hb hab, end /-- For a function on a convex set in a linearly ordered space (where the order and the algebraic @@ -312,30 +356,31 @@ structures aren't necessarily compatible), in order to prove that it is concave verify the inequality `a • f x + b • f y ≤ f (a • x + b • y)` for `x < y` and positive `a`, `b`. The main use case is `E = ℝ` however one can apply it, e.g., to `ℝ^n` with lexicographic order. -/ lemma linear_order.concave_on_of_lt (hs : convex 𝕜 s) - (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → + (hf : ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y ≤ f (a • x + b • y)) : concave_on 𝕜 s f := @linear_order.convex_on_of_lt _ _ βᵒᵈ _ _ _ _ _ _ s f hs hf /-- For a function on a convex set in a linearly ordered space (where the order and the algebraic -structures aren't necessarily compatible), in order to prove that it is convex, it suffices to -verify the inequality `f (a • x + b • y) ≤ a • f x + b • f y` for `x < y` and positive `a`, `b`. The -main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/ +structures aren't necessarily compatible), in order to prove that it is strictly convex, it suffices +to verify the inequality `f (a • x + b • y) < a • f x + b • f y` for `x < y` and positive `a`, `b`. +The main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/ lemma linear_order.strict_convex_on_of_lt (hs : convex 𝕜 s) - (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → + (hf : ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → f (a • x + b • y) < a • f x + b • f y) : strict_convex_on 𝕜 s f := begin - refine ⟨hs, λ x y hx hy hxy a b ha hb hab, _⟩, - wlog h : x ≤ y using [x y a b, y x b a], - { exact le_total _ _ }, - exact hf hx hy (h.lt_of_ne hxy) ha hb hab, + refine ⟨hs, λ x hx y hy hxy a b ha hb hab, _⟩, + wlog h : x < y, + { rw [add_comm (a • x), add_comm (a • f x)], rw add_comm at hab, + refine this hs hf y hy x hx hxy.symm b a hb ha hab (hxy.lt_or_lt.resolve_left h), }, + exact hf hx hy h ha hb hab, end /-- For a function on a convex set in a linearly ordered space (where the order and the algebraic -structures aren't necessarily compatible), in order to prove that it is concave it suffices to -verify the inequality `a • f x + b • f y ≤ f (a • x + b • y)` for `x < y` and positive `a`, `b`. The -main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/ +structures aren't necessarily compatible), in order to prove that it is strictly concave it suffices +to verify the inequality `a • f x + b • f y < f (a • x + b • y)` for `x < y` and positive `a`, `b`. +The main use case is `E = 𝕜` however one can apply it, e.g., to `𝕜^n` with lexicographic order. -/ lemma linear_order.strict_concave_on_of_lt (hs : convex 𝕜 s) - (hf : ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → + (hf : ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x < y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • f x + b • f y < f (a • x + b • y)) : strict_concave_on 𝕜 s f := @linear_order.strict_convex_on_of_lt _ _ βᵒᵈ _ _ _ _ _ _ _ _ hs hf @@ -343,12 +388,12 @@ end linear_order end module section module -variables [module 𝕜 E] [module 𝕜 F] [has_scalar 𝕜 β] +variables [module 𝕜 E] [module 𝕜 F] [has_smul 𝕜 β] /-- If `g` is convex on `s`, so is `(f ∘ g)` on `f ⁻¹' s` for a linear `f`. -/ lemma convex_on.comp_linear_map {f : F → β} {s : set F} (hf : convex_on 𝕜 s f) (g : E →ₗ[𝕜] F) : convex_on 𝕜 (g ⁻¹' s) (f ∘ g) := -⟨hf.1.linear_preimage _, λ x y hx hy a b ha hb hab, +⟨hf.1.linear_preimage _, λ x hx y hy a b ha hb hab, calc f (g (a • x + b • y)) = f (a • (g x) + b • (g y)) : by rw [g.map_add, g.map_smul, g.map_smul] ... ≤ a • f (g x) + b • f (g y) : hf.2 hx hy ha hb hab⟩ @@ -365,16 +410,36 @@ section ordered_cancel_add_comm_monoid variables [ordered_cancel_add_comm_monoid β] section distrib_mul_action -variables [has_scalar 𝕜 E] [distrib_mul_action 𝕜 β] {s : set E} {f g : E → β} +variables [has_smul 𝕜 E] [distrib_mul_action 𝕜 β] {s : set E} {f g : E → β} + +lemma strict_convex_on.add_convex_on (hf : strict_convex_on 𝕜 s f) (hg : convex_on 𝕜 s g) : + strict_convex_on 𝕜 s (f + g) := +⟨hf.1, λ x hx y hy hxy a b ha hb hab, + calc + f (a • x + b • y) + g (a • x + b • y) < (a • f x + b • f y) + (a • g x + b • g y) + : add_lt_add_of_lt_of_le (hf.2 hx hy hxy ha hb hab) (hg.2 hx hy ha.le hb.le hab) + ... = a • (f x + g x) + b • (f y + g y) : by rw [smul_add, smul_add, add_add_add_comm]⟩ + +lemma convex_on.add_strict_convex_on (hf : convex_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) : + strict_convex_on 𝕜 s (f + g) := +(add_comm g f) ▸ hg.add_convex_on hf lemma strict_convex_on.add (hf : strict_convex_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) : strict_convex_on 𝕜 s (f + g) := -⟨hf.1, λ x y hx hy hxy a b ha hb hab, +⟨hf.1, λ x hx y hy hxy a b ha hb hab, calc f (a • x + b • y) + g (a • x + b • y) < (a • f x + b • f y) + (a • g x + b • g y) : add_lt_add (hf.2 hx hy hxy ha hb hab) (hg.2 hx hy hxy ha hb hab) ... = a • (f x + g x) + b • (f y + g y) : by rw [smul_add, smul_add, add_add_add_comm]⟩ +lemma strict_concave_on.add_concave_on (hf : strict_concave_on 𝕜 s f) (hg : concave_on 𝕜 s g) : + strict_concave_on 𝕜 s (f + g) := +hf.dual.add_convex_on hg.dual + +lemma concave_on.add_strict_concave_on (hf : concave_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) : + strict_concave_on 𝕜 s (f + g) := +hf.dual.add_strict_convex_on hg.dual + lemma strict_concave_on.add (hf : strict_concave_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) : strict_concave_on 𝕜 s (f + g) := hf.dual.add hg @@ -385,7 +450,7 @@ section module variables [module 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} lemma convex_on.convex_lt (hf : convex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x < r} := -convex_iff_forall_pos.2 $ λ x y hx hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha.le hb.le hab, +convex_iff_forall_pos.2 $ λ x hx y hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha.le hb.le hab, calc f (a • x + b • y) ≤ a • f x + b • f y : hf.2 hx.1 hy.1 ha.le hb.le hab @@ -415,7 +480,7 @@ hf.dual.open_segment_subset_strict_epigraph p q hp hq lemma convex_on.convex_strict_epigraph (hf : convex_on 𝕜 s f) : convex 𝕜 {p : E × β | p.1 ∈ s ∧ f p.1 < p.2} := convex_iff_open_segment_subset.mpr $ - λ p q hp hq, hf.open_segment_subset_strict_epigraph p q hp ⟨hq.1, hq.2.le⟩ + λ p hp q hq, hf.open_segment_subset_strict_epigraph p q hp ⟨hq.1, hq.2.le⟩ lemma concave_on.convex_strict_hypograph (hf : concave_on 𝕜 s f) : convex 𝕜 {p : E × β | p.1 ∈ s ∧ p.2 < f p.1} := @@ -425,14 +490,14 @@ end module end ordered_cancel_add_comm_monoid section linear_ordered_add_comm_monoid -variables [linear_ordered_add_comm_monoid β] [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] +variables [linear_ordered_add_comm_monoid β] [has_smul 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f g : E → β} /-- The pointwise maximum of convex functions is convex. -/ lemma convex_on.sup (hf : convex_on 𝕜 s f) (hg : convex_on 𝕜 s g) : convex_on 𝕜 s (f ⊔ g) := begin - refine ⟨hf.left, λ x y hx hy a b ha hb hab, sup_le _ _⟩, + refine ⟨hf.left, λ x hx y hy a b ha hb hab, sup_le _ _⟩, { calc f (a • x + b • y) ≤ a • f x + b • f y : hf.right hx hy ha hb hab ... ≤ a • (f x ⊔ g x) + b • (f y ⊔ g y) : add_le_add (smul_le_smul_of_nonneg le_sup_left ha) @@ -451,7 +516,7 @@ hf.dual.sup hg /-- The pointwise maximum of strictly convex functions is strictly convex. -/ lemma strict_convex_on.sup (hf : strict_convex_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) : strict_convex_on 𝕜 s (f ⊔ g) := -⟨hf.left, λ x y hx hy hxy a b ha hb hab, max_lt +⟨hf.left, λ x hx y hy hxy a b ha hb hab, max_lt (calc f (a • x + b • y) < a • f x + b • f y : hf.2 hx hy hxy ha hb hab ... ≤ a • (f x ⊔ g x) + b • (f y ⊔ g y) : add_le_add (smul_le_smul_of_nonneg le_sup_left ha.le) @@ -534,7 +599,7 @@ section linear_ordered_cancel_add_comm_monoid variables [linear_ordered_cancel_add_comm_monoid β] section ordered_smul -variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f g : E → β} +variables [has_smul 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f g : E → β} lemma convex_on.le_left_of_right_le' (hf : convex_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 ≤ b) (hab : a + b = 1) (hfy : f y ≤ f (a • x + b • y)) : @@ -561,7 +626,7 @@ begin exact hf.le_left_of_right_le' hy hx hb ha hab hfx, end -lemma concave_on.le_right_of_left_le' (hf : concave_on 𝕜 s f) {x y : E} {a b : 𝕜} +lemma concave_on.right_le_of_le_left' (hf : concave_on 𝕜 s f) {x y : E} {a b : 𝕜} (hx : x ∈ s) (hy : y ∈ s) (ha : 0 ≤ a) (hb : 0 < b) (hab : a + b = 1) (hfx : f (a • x + b • y) ≤ f x) : f y ≤ f (a • x + b • y) := @@ -588,7 +653,7 @@ begin exact hf.le_right_of_left_le' hx hy ha.le hb hab hxz, end -lemma concave_on.le_right_of_left_le (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) +lemma concave_on.right_le_of_le_left (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f z ≤ f x) : f y ≤ f z := hf.dual.le_right_of_left_le hx hy hz hxz @@ -600,29 +665,25 @@ variables [module 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f /- The following lemmas don't require `module 𝕜 E` if you add the hypothesis `x ≠ y`. At the time of the writing, we decided the resulting lemmas wouldn't be useful. Feel free to reintroduce them. -/ -lemma strict_convex_on.lt_left_of_right_lt' (hf : strict_convex_on 𝕜 s f) {x y : E} (hx : x ∈ s) +lemma convex_on.lt_left_of_right_lt' (hf : convex_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) (hfy : f y < f (a • x + b • y)) : f (a • x + b • y) < f x := not_le.1 $ λ h, lt_irrefl (f (a • x + b • y)) $ calc f (a • x + b • y) - < a • f x + b • f y : hf.2 hx hy begin - rintro rfl, - rw convex.combo_self hab at hfy, - exact lt_irrefl _ hfy, - end ha hb hab + ≤ a • f x + b • f y : hf.2 hx hy ha.le hb.le hab ... < a • f (a • x + b • y) + b • f (a • x + b • y) : add_lt_add_of_le_of_lt (smul_le_smul_of_nonneg h ha.le) (smul_lt_smul_of_pos hfy hb) ... = f (a • x + b • y) : convex.combo_self hab _ -lemma strict_concave_on.left_lt_of_lt_right' (hf : strict_concave_on 𝕜 s f) {x y : E} (hx : x ∈ s) +lemma concave_on.left_lt_of_lt_right' (hf : concave_on 𝕜 s f) {x y : E} (hx : x ∈ s) (hy : y ∈ s) {a b : 𝕜} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) (hfy : f (a • x + b • y) < f y) : f x < f (a • x + b • y) := hf.dual.lt_left_of_right_lt' hx hy ha hb hab hfy -lemma strict_convex_on.lt_right_of_left_lt' (hf : strict_convex_on 𝕜 s f) {x y : E} {a b : 𝕜} +lemma convex_on.lt_right_of_left_lt' (hf : convex_on 𝕜 s f) {x y : E} {a b : 𝕜} (hx : x ∈ s) (hy : y ∈ s) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) (hfx : f x < f (a • x + b • y)) : f (a • x + b • y) < f y := @@ -631,13 +692,13 @@ begin exact hf.lt_left_of_right_lt' hy hx hb ha hab hfx, end -lemma strict_concave_on.lt_right_of_left_lt' (hf : strict_concave_on 𝕜 s f) {x y : E} {a b : 𝕜} +lemma concave_on.lt_right_of_left_lt' (hf : concave_on 𝕜 s f) {x y : E} {a b : 𝕜} (hx : x ∈ s) (hy : y ∈ s) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) (hfx : f (a • x + b • y) < f x) : f y < f (a • x + b • y) := hf.dual.lt_right_of_left_lt' hx hy ha hb hab hfx -lemma strict_convex_on.lt_left_of_right_lt (hf : strict_convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s) +lemma convex_on.lt_left_of_right_lt (hf : convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hyz : f y < f z) : f z < f x := begin @@ -645,12 +706,12 @@ begin exact hf.lt_left_of_right_lt' hx hy ha hb hab hyz, end -lemma strict_concave_on.left_lt_of_lt_right (hf : strict_concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) +lemma concave_on.left_lt_of_lt_right (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hyz : f z < f y) : f x < f z := hf.dual.lt_left_of_right_lt hx hy hz hyz -lemma strict_convex_on.lt_right_of_left_lt (hf : strict_convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s) +lemma convex_on.lt_right_of_left_lt (hf : convex_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f x < f z) : f z < f y := begin @@ -658,7 +719,7 @@ begin exact hf.lt_right_of_left_lt' hx hy ha hb hab hxz, end -lemma strict_concave_on.lt_right_of_left_lt (hf : strict_concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) +lemma concave_on.lt_right_of_left_lt (hf : concave_on 𝕜 s f) {x y z : E} (hx : x ∈ s) (hy : y ∈ s) (hz : z ∈ open_segment 𝕜 x y) (hxz : f z < f x) : f y < f z := hf.dual.lt_right_of_left_lt hx hy hz hxz @@ -667,18 +728,18 @@ end module end linear_ordered_cancel_add_comm_monoid section ordered_add_comm_group -variables [ordered_add_comm_group β] [has_scalar 𝕜 E] [module 𝕜 β] {s : set E} {f : E → β} +variables [ordered_add_comm_group β] [has_smul 𝕜 E] [module 𝕜 β] {s : set E} {f g : E → β} /-- A function `-f` is convex iff `f` is concave. -/ @[simp] lemma neg_convex_on_iff : convex_on 𝕜 s (-f) ↔ concave_on 𝕜 s f := begin split, { rintro ⟨hconv, h⟩, - refine ⟨hconv, λ x y hx hy a b ha hb hab, _⟩, + refine ⟨hconv, λ x hx y hy a b ha hb hab, _⟩, simp [neg_apply, neg_le, add_comm] at h, exact h hx hy ha hb hab }, { rintro ⟨hconv, h⟩, - refine ⟨hconv, λ x y hx hy a b ha hb hab, _⟩, + refine ⟨hconv, λ x hx y hy a b ha hb hab, _⟩, rw ←neg_le_neg_iff, simp_rw [neg_add, pi.neg_apply, smul_neg, neg_neg], exact h hx hy ha hb hab } @@ -693,11 +754,11 @@ by rw [← neg_convex_on_iff, neg_neg f] begin split, { rintro ⟨hconv, h⟩, - refine ⟨hconv, λ x y hx hy hxy a b ha hb hab, _⟩, + refine ⟨hconv, λ x hx y hy hxy a b ha hb hab, _⟩, simp [neg_apply, neg_lt, add_comm] at h, exact h hx hy hxy ha hb hab }, { rintro ⟨hconv, h⟩, - refine ⟨hconv, λ x y hx hy hxy a b ha hb hab, _⟩, + refine ⟨hconv, λ x hx y hy hxy a b ha hb hab, _⟩, rw ←neg_lt_neg_iff, simp_rw [neg_add, pi.neg_apply, smul_neg, neg_neg], exact h hx hy hxy ha hb hab } @@ -712,17 +773,47 @@ alias neg_concave_on_iff ↔ _ convex_on.neg alias neg_strict_convex_on_iff ↔ _ strict_concave_on.neg alias neg_strict_concave_on_iff ↔ _ strict_convex_on.neg +lemma convex_on.sub (hf : convex_on 𝕜 s f) (hg : concave_on 𝕜 s g) : convex_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add hg.neg + +lemma concave_on.sub (hf : concave_on 𝕜 s f) (hg : convex_on 𝕜 s g) : concave_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add hg.neg + +lemma strict_convex_on.sub (hf : strict_convex_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) : + strict_convex_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add hg.neg + +lemma strict_concave_on.sub (hf : strict_concave_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) : + strict_concave_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add hg.neg + +lemma convex_on.sub_strict_concave_on (hf : convex_on 𝕜 s f) (hg : strict_concave_on 𝕜 s g) : + strict_convex_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add_strict_convex_on hg.neg + +lemma concave_on.sub_strict_convex_on (hf : concave_on 𝕜 s f) (hg : strict_convex_on 𝕜 s g) : + strict_concave_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add_strict_concave_on hg.neg + +lemma strict_convex_on.sub_concave_on (hf : strict_convex_on 𝕜 s f) (hg : concave_on 𝕜 s g) : + strict_convex_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add_convex_on hg.neg + +lemma strict_concave_on.sub_convex_on (hf : strict_concave_on 𝕜 s f) (hg : convex_on 𝕜 s g) : + strict_concave_on 𝕜 s (f - g) := +(sub_eq_add_neg f g).symm ▸ hf.add_concave_on hg.neg + end ordered_add_comm_group end add_comm_monoid section add_cancel_comm_monoid -variables [add_cancel_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E] [has_scalar 𝕜 β] +variables [add_cancel_comm_monoid E] [ordered_add_comm_monoid β] [module 𝕜 E] [has_smul 𝕜 β] {s : set E} {f : E → β} /-- Right translation preserves strict convexity. -/ lemma strict_convex_on.translate_right (hf : strict_convex_on 𝕜 s f) (c : E) : strict_convex_on 𝕜 ((λ z, c + z) ⁻¹' s) (f ∘ (λ z, c + z)) := -⟨hf.1.translate_preimage_right _, λ x y hx hy hxy a b ha hb hab, +⟨hf.1.translate_preimage_right _, λ x hx y hy hxy a b ha hb hab, calc f (c + (a • x + b • y)) = f (a • (c + x) + b • (c + y)) : by rw [smul_add, smul_add, add_add_add_comm, convex.combo_self hab] @@ -753,10 +844,10 @@ section ordered_add_comm_monoid variables [ordered_add_comm_monoid β] section module -variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} +variables [has_smul 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} lemma convex_on.smul {c : 𝕜} (hc : 0 ≤ c) (hf : convex_on 𝕜 s f) : convex_on 𝕜 s (λ x, c • f x) := -⟨hf.1, λ x y hx hy a b ha hb hab, +⟨hf.1, λ x hx y hy a b ha hb hab, calc c • f (a • x + b • y) ≤ c • (a • f x + b • f y) : smul_le_smul_of_nonneg (hf.2 hx hy ha hb hab) hc @@ -778,12 +869,12 @@ section ordered_add_comm_monoid variables [ordered_add_comm_monoid β] section module -variables [module 𝕜 E] [module 𝕜 F] [has_scalar 𝕜 β] +variables [module 𝕜 E] [module 𝕜 F] [has_smul 𝕜 β] /-- If a function is convex on `s`, it remains convex when precomposed by an affine map. -/ lemma convex_on.comp_affine_map {f : F → β} (g : E →ᵃ[𝕜] F) {s : set F} (hf : convex_on 𝕜 s f) : convex_on 𝕜 (g ⁻¹' s) (f ∘ g) := -⟨hf.1.affine_preimage _, λ x y hx hy a b ha hb hab, +⟨hf.1.affine_preimage _, λ x hx y hy a b ha hb hab, calc (f ∘ g) (a • x + b • y) = f (g (a • x + b • y)) : rfl ... = f (a • (g x) + b • (g y)) : by rw [convex.combo_affine_apply hab] @@ -804,48 +895,73 @@ variables [linear_ordered_field 𝕜] [add_comm_monoid E] section ordered_add_comm_monoid variables [ordered_add_comm_monoid β] -section has_scalar -variables [has_scalar 𝕜 E] [has_scalar 𝕜 β] {s : set E} +section has_smul +variables [has_smul 𝕜 E] [has_smul 𝕜 β] {s : set E} lemma convex_on_iff_div {f : E → β} : - convex_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → 0 < a + b - → f ((a/(a+b)) • x + (b/(a+b)) • y) ≤ (a/(a+b)) • f x + (b/(a+b)) • f y := + convex_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → + 0 < a + b → f ((a/(a+b)) • x + (b/(a+b)) • y) ≤ (a/(a+b)) • f x + (b/(a+b)) • f y := and_congr iff.rfl ⟨begin - intros h x y hx hy a b ha hb hab, + intros h x hx y hy a b ha hb hab, apply h hx hy (div_nonneg ha hab.le) (div_nonneg hb hab.le), rw [←add_div, div_self hab.ne'], end, begin - intros h x y hx hy a b ha hb hab, + intros h x hx y hy a b ha hb hab, simpa [hab, zero_lt_one] using h hx hy ha hb, end⟩ lemma concave_on_iff_div {f : E → β} : - concave_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b + concave_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → 0 < a + b → (a/(a+b)) • f x + (b/(a+b)) • f y ≤ f ((a/(a+b)) • x + (b/(a+b)) • y) := @convex_on_iff_div _ _ βᵒᵈ _ _ _ _ _ _ _ lemma strict_convex_on_iff_div {f : E → β} : - strict_convex_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a + strict_convex_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → f ((a/(a+b)) • x + (b/(a+b)) • y) < (a/(a+b)) • f x + (b/(a+b)) • f y := and_congr iff.rfl ⟨begin - intros h x y hx hy hxy a b ha hb, + intros h x hx y hy hxy a b ha hb, have hab := add_pos ha hb, apply h hx hy hxy (div_pos ha hab) (div_pos hb hab), rw [←add_div, div_self hab.ne'], end, begin - intros h x y hx hy hxy a b ha hb hab, + intros h x hx y hy hxy a b ha hb hab, simpa [hab, zero_lt_one] using h hx hy hxy ha hb, end⟩ lemma strict_concave_on_iff_div {f : E → β} : - strict_concave_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a + strict_concave_on 𝕜 s f ↔ convex 𝕜 s ∧ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → (a/(a+b)) • f x + (b/(a+b)) • f y < f ((a/(a+b)) • x + (b/(a+b)) • y) := @strict_convex_on_iff_div _ _ βᵒᵈ _ _ _ _ _ _ _ -end has_scalar +end has_smul end ordered_add_comm_monoid end linear_ordered_field + +section + +variables [linear_ordered_field 𝕜] [linear_ordered_cancel_add_comm_monoid β] [module 𝕜 β] + [ordered_smul 𝕜 β] {x y z : 𝕜} {s : set 𝕜} {f : 𝕜 → β} + +lemma convex_on.le_right_of_left_le'' (hf : convex_on 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s) + (hxy : x < y) (hyz : y ≤ z) (h : f x ≤ f y) : f y ≤ f z := +hyz.eq_or_lt.elim (λ hyz, (congr_arg f hyz).le) + (λ hyz, hf.le_right_of_left_le hx hz (Ioo_subset_open_segment ⟨hxy, hyz⟩) h) + +lemma convex_on.le_left_of_right_le'' (hf : convex_on 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s) + (hxy : x ≤ y) (hyz : y < z) (h : f z ≤ f y) : f y ≤ f x := +hxy.eq_or_lt.elim (λ hxy, (congr_arg f hxy).ge) + (λ hxy, hf.le_left_of_right_le hx hz (Ioo_subset_open_segment ⟨hxy, hyz⟩) h) + +lemma concave_on.right_le_of_le_left'' (hf : concave_on 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s) + (hxy : x < y) (hyz : y ≤ z) (h : f y ≤ f x) : f z ≤ f y := +hf.dual.le_right_of_left_le'' hx hz hxy hyz h + +lemma concave_on.left_le_of_le_right'' (hf : concave_on 𝕜 s f) (hx : x ∈ s) (hz : z ∈ s) + (hxy : x ≤ y) (hyz : y < z) (h : f y ≤ f z) : f x ≤ f y := +hf.dual.le_left_of_right_le'' hx hz hxy hyz h + +end diff --git a/src/analysis/convex/gauge.lean b/src/analysis/convex/gauge.lean index d3892e2c33aac..2304cd00b55fe 100644 --- a/src/analysis/convex/gauge.lean +++ b/src/analysis/convex/gauge.lean @@ -3,13 +3,18 @@ Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Bhavik Mehta -/ -import analysis.convex.star +import analysis.convex.basic import analysis.normed_space.pointwise import analysis.seminorm +import data.is_R_or_C.basic +import tactic.congrm /-! # The Minkowksi functional +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the Minkowski functional, aka gauge. The Minkowski functional of a set `s` is the function which associates each point to how much you @@ -35,11 +40,11 @@ Minkowski functional, gauge -/ open normed_field set -open_locale pointwise +open_locale pointwise topology nnreal noncomputable theory -variables {E : Type*} +variables {𝕜 E F : Type*} section add_comm_group variables [add_comm_group E] [module ℝ E] @@ -56,9 +61,7 @@ lemma gauge_def : gauge s x = Inf {r ∈ set.Ioi 0 | x ∈ r • s} := rfl the set. -/ lemma gauge_def' : gauge s x = Inf {r ∈ set.Ioi 0 | r⁻¹ • x ∈ s} := begin - unfold gauge, - congr' 1, - ext r, + congrm Inf (λ r, _), exact and_congr_right (λ hr, mem_smul_set_iff_inv_smul_mem₀ hr.ne' _ _), end @@ -102,7 +105,7 @@ begin end @[simp] lemma gauge_empty : gauge (∅ : set E) = 0 := -by { ext, simp only [gauge_def', real.Inf_empty, mem_empty_eq, pi.zero_apply, sep_false] } +by { ext, simp only [gauge_def', real.Inf_empty, mem_empty_iff_false, pi.zero_apply, sep_false] } lemma gauge_of_subset_zero (h : s ⊆ 0) : gauge s = 0 := by { obtain rfl | rfl := subset_singleton_iff_eq.1 h, exacts [gauge_empty, gauge_zero'] } @@ -113,14 +116,19 @@ lemma gauge_nonneg (x : E) : 0 ≤ gauge s x := real.Inf_nonneg _ $ λ x hx, hx. lemma gauge_neg (symmetric : ∀ x ∈ s, -x ∈ s) (x : E) : gauge s (-x) = gauge s x := begin have : ∀ x, -x ∈ s ↔ x ∈ s := λ x, ⟨λ h, by simpa using symmetric _ h, symmetric x⟩, - rw [gauge_def', gauge_def'], - simp_rw [smul_neg, this], + simp_rw [gauge_def', smul_neg, this] end +lemma gauge_neg_set_neg (x : E) : gauge (-s) (-x) = gauge s x := +by simp_rw [gauge_def', smul_neg, neg_mem_neg] + +lemma gauge_neg_set_eq_gauge_neg (x : E) : gauge (-s) x = gauge s (-x) := +by rw [← gauge_neg_set_neg, neg_neg] + lemma gauge_le_of_mem (ha : 0 ≤ a) (hx : x ∈ a • s) : gauge s x ≤ a := begin obtain rfl | ha' := ha.eq_or_lt, - { rw [mem_singleton_iff.1 (zero_smul_subset _ hx), gauge_zero] }, + { rw [mem_singleton_iff.1 (zero_smul_set_subset _ hx), gauge_zero] }, { exact cInf_le gauge_set_bdd_below ⟨ha', hx⟩ } end @@ -136,8 +144,7 @@ begin suffices : (r⁻¹ * δ) • δ⁻¹ • x ∈ s, { rwa [smul_smul, mul_inv_cancel_right₀ δ_pos.ne'] at this }, rw mem_smul_set_iff_inv_smul_mem₀ δ_pos.ne' at hδ, - refine hs₁.smul_mem_of_zero_mem hs₀ hδ - ⟨mul_nonneg (inv_nonneg.2 hr'.le) δ_pos.le, _⟩, + refine hs₁.smul_mem_of_zero_mem hs₀ hδ ⟨by positivity, _⟩, rw [inv_mul_le_iff hr', mul_one], exact hδr.le }, { have hε' := (lt_add_iff_pos_right a).2 (half_pos hε), @@ -200,7 +207,7 @@ begin rintro b ⟨hb, x, hx', rfl⟩, refine not_lt.1 (λ hba, hx _), have ha := hb.trans hba, - refine ⟨(a⁻¹ * b) • x, hs₀ hx' (mul_nonneg (inv_nonneg.2 ha.le) hb.le) _, _⟩, + refine ⟨(a⁻¹ * b) • x, hs₀ hx' (by positivity) _, _⟩, { rw ←div_eq_inv_mul, exact div_le_one_of_le hba.le ha.le }, { rw [←mul_smul, mul_inv_cancel_left₀ ha.ne'] } @@ -222,7 +229,7 @@ begin rw [gauge_def', gauge_def', ←real.Inf_smul_of_nonneg ha], congr' 1, ext r, - simp_rw [set.mem_smul_set, set.mem_sep_eq], + simp_rw [set.mem_smul_set, set.mem_sep_iff], split, { rintro ⟨hr, hx⟩, simp_rw mem_Ioi at ⊢ hr, @@ -240,29 +247,17 @@ begin exact smul_mem_smul_set hx } end -/-- In textbooks, this is the homogeneity of the Minkowksi functional. -/ -lemma gauge_smul [module α E] [is_scalar_tower α ℝ (set E)] {s : set E} - (symmetric : ∀ x ∈ s, -x ∈ s) (r : α) (x : E) : - gauge s (r • x) = abs r • gauge s x := -begin - rw ←gauge_smul_of_nonneg (abs_nonneg r), - obtain h | h := abs_choice r, - { rw h }, - { rw [h, neg_smul, gauge_neg symmetric] }, - { apply_instance } -end - lemma gauge_smul_left_of_nonneg [mul_action_with_zero α E] [smul_comm_class α ℝ ℝ] [is_scalar_tower α ℝ ℝ] [is_scalar_tower α ℝ E] {s : set E} {a : α} (ha : 0 ≤ a) : gauge (a • s) = a⁻¹ • gauge s := begin obtain rfl | ha' := ha.eq_or_lt, - { rw [inv_zero, zero_smul, gauge_of_subset_zero (zero_smul_subset _)] }, + { rw [inv_zero, zero_smul, gauge_of_subset_zero (zero_smul_set_subset _)] }, ext, rw [gauge_def', pi.smul_apply, gauge_def', ←real.Inf_smul_of_nonneg (inv_nonneg.2 ha)], congr' 1, ext r, - simp_rw [set.mem_smul_set, set.mem_sep_eq], + simp_rw [set.mem_smul_set, set.mem_sep_iff], split, { rintro ⟨hr, y, hy, h⟩, simp_rw [mem_Ioi] at ⊢ hr, @@ -293,6 +288,24 @@ end end linear_ordered_field +section is_R_or_C +variables [is_R_or_C 𝕜] [module 𝕜 E] [is_scalar_tower ℝ 𝕜 E] + +lemma gauge_norm_smul (hs : balanced 𝕜 s) (r : 𝕜) (x : E) : gauge s (‖r‖ • x) = gauge s (r • x) := +begin + unfold gauge, + congr' with θ, + rw @is_R_or_C.real_smul_eq_coe_smul 𝕜, + refine and_congr_right (λ hθ, (hs.smul _).mem_smul_iff _), + rw [is_R_or_C.norm_of_real, abs_norm], +end + +/-- If `s` is balanced, then the Minkowski functional is ℂ-homogeneous. -/ +lemma gauge_smul (hs : balanced 𝕜 s) (r : 𝕜) (x : E) : gauge s (r • x) = ‖r‖ * gauge s x := +by { rw [←smul_eq_mul, ←gauge_smul_of_nonneg (norm_nonneg r), gauge_norm_smul hs], apply_instance } + +end is_R_or_C + section topological_space variables [topological_space E] [has_continuous_smul ℝ E] @@ -362,30 +375,33 @@ begin have hab : 0 < a + b := add_pos ha hb, apply gauge_le_of_mem hab.le, have := convex_iff_div.1 hs hx hy ha.le hb.le hab, - rwa [smul_smul, smul_smul, mul_comm_div', mul_comm_div', ←mul_div_assoc, ←mul_div_assoc, - mul_inv_cancel ha.ne', mul_inv_cancel hb.ne', ←smul_add, one_div, - ←mem_smul_set_iff_inv_smul_mem₀ hab.ne'] at this, + rwa [smul_smul, smul_smul, ←mul_div_right_comm, ←mul_div_right_comm, mul_inv_cancel ha.ne', + mul_inv_cancel hb.ne', ←smul_add, one_div, ←mem_smul_set_iff_inv_smul_mem₀ hab.ne'] at this, end -/-- `gauge s` as a seminorm when `s` is symmetric, convex and absorbent. -/ -@[simps] def gauge_seminorm (hs₀ : ∀ x ∈ s, -x ∈ s) (hs₁ : convex ℝ s) (hs₂ : absorbent ℝ s) : - seminorm ℝ E := -{ to_fun := gauge s, - smul' := λ r x, by rw [gauge_smul hs₀, real.norm_eq_abs, smul_eq_mul]; apply_instance, - triangle' := gauge_add_le hs₁ hs₂ } +section is_R_or_C +variables [is_R_or_C 𝕜] [module 𝕜 E] [is_scalar_tower ℝ 𝕜 E] -section gauge_seminorm -variables {hs₀ : ∀ x ∈ s, -x ∈ s} {hs₁ : convex ℝ s} {hs₂ : absorbent ℝ s} +/-- `gauge s` as a seminorm when `s` is balanced, convex and absorbent. -/ +@[simps] def gauge_seminorm (hs₀ : balanced 𝕜 s) (hs₁ : convex ℝ s) (hs₂ : absorbent ℝ s) : + seminorm 𝕜 E := +seminorm.of (gauge s) (gauge_add_le hs₁ hs₂) (gauge_smul hs₀) -section topological_space -variables [topological_space E] [has_continuous_smul ℝ E] +variables {hs₀ : balanced 𝕜 s} {hs₁ : convex ℝ s} {hs₂ : absorbent ℝ s} [topological_space E] + [has_continuous_smul ℝ E] lemma gauge_seminorm_lt_one_of_open (hs : is_open s) {x : E} (hx : x ∈ s) : gauge_seminorm hs₀ hs₁ hs₂ x < 1 := gauge_lt_one_of_mem_of_open hs₁ hs₂.zero_mem hs hx -end topological_space -end gauge_seminorm +lemma gauge_seminorm_ball_one (hs : is_open s) : + (gauge_seminorm hs₀ hs₁ hs₂).ball 0 1 = s := +begin + rw seminorm.ball_zero_eq, + exact gauge_lt_one_eq_self_of_open hs₁ hs₂.zero_mem hs +end + +end is_R_or_C /-- Any seminorm arises as the gauge of its unit ball. -/ @[simp] protected lemma seminorm.gauge_ball (p : seminorm ℝ E) : gauge (p.ball 0 1) = p := @@ -394,53 +410,37 @@ begin obtain hp | hp := {r : ℝ | 0 < r ∧ x ∈ r • p.ball 0 1}.eq_empty_or_nonempty, { rw [gauge, hp, real.Inf_empty], by_contra, - have hpx : 0 < p x := (p.nonneg x).lt_of_ne h, + have hpx : 0 < p x := (map_nonneg _ _).lt_of_ne h, have hpx₂ : 0 < 2 * p x := mul_pos zero_lt_two hpx, refine hp.subset ⟨hpx₂, (2 * p x)⁻¹ • x, _, smul_inv_smul₀ hpx₂.ne' _⟩, - rw [p.mem_ball_zero, p.smul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpx₂), inv_mul_lt_iff hpx₂, - mul_one], + rw [p.mem_ball_zero, map_smul_eq_mul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpx₂), + inv_mul_lt_iff hpx₂, mul_one], exact lt_mul_of_one_lt_left hpx one_lt_two }, refine is_glb.cInf_eq ⟨λ r, _, λ r hr, le_of_forall_pos_le_add $ λ ε hε, _⟩ hp, { rintro ⟨hr, y, hy, rfl⟩, rw p.mem_ball_zero at hy, - rw [p.smul, real.norm_eq_abs, abs_of_pos hr], + rw [map_smul_eq_mul, real.norm_eq_abs, abs_of_pos hr], exact mul_le_of_le_one_right hr.le hy.le }, - { have hpε : 0 < p x + ε := add_pos_of_nonneg_of_pos (p.nonneg _) hε, + { have hpε : 0 < p x + ε := by positivity, refine hr ⟨hpε, (p x + ε)⁻¹ • x, _, smul_inv_smul₀ hpε.ne' _⟩, - rw [p.mem_ball_zero, p.smul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpε), inv_mul_lt_iff hpε, - mul_one], + rw [p.mem_ball_zero, map_smul_eq_mul, real.norm_eq_abs, abs_of_pos (inv_pos.2 hpε), + inv_mul_lt_iff hpε, mul_one], exact lt_add_of_pos_right _ hε } end lemma seminorm.gauge_seminorm_ball (p : seminorm ℝ E) : - gauge_seminorm (λ x, p.symmetric_ball_zero 1) (p.convex_ball 0 1) + gauge_seminorm (p.balanced_ball_zero 1) (p.convex_ball 0 1) (p.absorbent_ball_zero zero_lt_one) = p := fun_like.coe_injective p.gauge_ball end add_comm_group section norm -variables [semi_normed_group E] [normed_space ℝ E] {s : set E} {r : ℝ} {x : E} +variables [seminormed_add_comm_group E] [normed_space ℝ E] {s : set E} {r : ℝ} {x : E} -lemma gauge_unit_ball (x : E) : gauge (metric.ball (0 : E) 1) x = ∥x∥ := -begin - obtain rfl | hx := eq_or_ne x 0, - { rw [norm_zero, gauge_zero] }, - refine (le_of_forall_pos_le_add $ λ ε hε, _).antisymm _, - { have := add_pos_of_nonneg_of_pos (norm_nonneg x) hε, - refine gauge_le_of_mem this.le _, - rw [smul_ball this.ne', smul_zero, real.norm_of_nonneg this.le, mul_one, mem_ball_zero_iff], - exact lt_add_of_pos_right _ hε }, - refine le_gauge_of_not_mem balanced_ball_zero.star_convex - (absorbent_ball_zero zero_lt_one).absorbs (λ h, _), - obtain hx' | hx' := eq_or_ne (∥x∥) 0, - { rw hx' at h, - exact hx (zero_smul_subset _ h) }, - { rw [mem_smul_set_iff_inv_smul_mem₀ hx', mem_ball_zero_iff, norm_smul, norm_inv, norm_norm, - inv_mul_cancel hx'] at h, - exact lt_irrefl _ h } -end +lemma gauge_unit_ball (x : E) : gauge (metric.ball (0 : E) 1) x = ‖x‖ := +by rw [← ball_norm_seminorm ℝ, seminorm.gauge_ball, coe_norm_seminorm] -lemma gauge_ball (hr : 0 < r) (x : E) : gauge (metric.ball (0 : E) r) x = ∥x∥ / r := +lemma gauge_ball (hr : 0 < r) (x : E) : gauge (metric.ball (0 : E) r) x = ‖x‖ / r := begin rw [←smul_unit_ball_of_pos hr, gauge_smul_left, pi.smul_apply, gauge_unit_ball, smul_eq_mul, abs_of_nonneg hr.le, div_eq_inv_mul], @@ -448,7 +448,7 @@ begin exact λ _, id, end -lemma mul_gauge_le_norm (hs : metric.ball (0 : E) r ⊆ s) : r * gauge s x ≤ ∥x∥ := +lemma mul_gauge_le_norm (hs : metric.ball (0 : E) r ⊆ s) : r * gauge s x ≤ ‖x‖ := begin obtain hr | hr := le_or_lt r 0, { exact (mul_nonpos_of_nonpos_of_nonneg hr $ gauge_nonneg _).trans (norm_nonneg _) }, @@ -456,4 +456,23 @@ begin exact gauge_mono (absorbent_ball_zero hr) hs x, end +lemma convex.lipschitz_with_gauge {r : ℝ≥0} (hc : convex ℝ s) (hr : 0 < r) + (hs : metric.ball (0 : E) r ⊆ s) : + lipschitz_with r⁻¹ (gauge s) := +have absorbent ℝ (metric.ball (0 : E) r) := absorbent_ball_zero hr, +lipschitz_with.of_le_add_mul _ $ λ x y, + calc gauge s x = gauge s (y + (x - y)) : by simp + ... ≤ gauge s y + gauge s (x - y) : gauge_add_le hc (this.subset hs) _ _ + ... ≤ gauge s y + ‖x - y‖ / r : + add_le_add_left ((gauge_mono this hs (x - y)).trans_eq (gauge_ball hr _)) _ + ... = gauge s y + r⁻¹ * dist x y : by rw [dist_eq_norm, div_eq_inv_mul] + +lemma convex.uniform_continuous_gauge (hc : convex ℝ s) (h₀ : s ∈ 𝓝 (0 : E)) : + uniform_continuous (gauge s) := +begin + obtain ⟨r, hr₀, hr⟩ := metric.mem_nhds_iff.1 h₀, + lift r to ℝ≥0 using le_of_lt hr₀, + exact (hc.lipschitz_with_gauge hr₀ hr).uniform_continuous +end + end norm diff --git a/src/analysis/convex/hull.lean b/src/analysis/convex/hull.lean index c1be4b97d039b..535a17885c56f 100644 --- a/src/analysis/convex/hull.lean +++ b/src/analysis/convex/hull.lean @@ -9,6 +9,9 @@ import order.closure /-! # Convex hull +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the convex hull of a set `s` in a module. `convex_hull 𝕜 s` is the smallest convex set containing `s`. In order theory speak, this is a closure operator. @@ -20,6 +23,7 @@ while the impact on writing code is minimal as `convex_hull 𝕜 s` is automatic -/ open set +open_locale pointwise variables {𝕜 E F : Type*} @@ -46,15 +50,24 @@ lemma subset_convex_hull : s ⊆ convex_hull 𝕜 s := (convex_hull 𝕜).le_clo lemma convex_convex_hull : convex 𝕜 (convex_hull 𝕜 s) := closure_operator.closure_mem_mk₃ s -variables {𝕜 s} {t : set E} +lemma convex_hull_eq_Inter : convex_hull 𝕜 s = ⋂ (t : set E) (hst : s ⊆ t) (ht : convex 𝕜 t), t := +rfl + +variables {𝕜 s} {t : set E} {x y : E} + +lemma mem_convex_hull_iff : x ∈ convex_hull 𝕜 s ↔ ∀ t, s ⊆ t → convex 𝕜 t → x ∈ t := +by simp_rw [convex_hull_eq_Inter, mem_Inter] lemma convex_hull_min (hst : s ⊆ t) (ht : convex 𝕜 t) : convex_hull 𝕜 s ⊆ t := closure_operator.closure_le_mk₃_iff (show s ≤ t, from hst) ht +lemma convex.convex_hull_subset_iff (ht : convex 𝕜 t) : convex_hull 𝕜 s ⊆ t ↔ s ⊆ t := +⟨(subset_convex_hull _ _).trans, λ h, convex_hull_min h ht⟩ + @[mono] lemma convex_hull_mono (hst : s ⊆ t) : convex_hull 𝕜 s ⊆ convex_hull 𝕜 t := (convex_hull 𝕜).monotone hst -lemma convex.convex_hull_eq {s : set E} (hs : convex 𝕜 s) : convex_hull 𝕜 s = s := +lemma convex.convex_hull_eq (hs : convex 𝕜 s) : convex_hull 𝕜 s = s := closure_operator.mem_mk₃_closed hs @[simp] lemma convex_hull_univ : convex_hull 𝕜 (univ : set E) = univ := @@ -74,14 +87,39 @@ end @[simp] lemma convex_hull_nonempty_iff : (convex_hull 𝕜 s).nonempty ↔ s.nonempty := begin - rw [←ne_empty_iff_nonempty, ←ne_empty_iff_nonempty, ne.def, ne.def], + rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, ne.def], exact not_congr convex_hull_empty_iff, end -@[simp] -lemma convex_hull_singleton {x : E} : convex_hull 𝕜 ({x} : set E) = {x} := +alias convex_hull_nonempty_iff ↔ _ set.nonempty.convex_hull + +attribute [protected] set.nonempty.convex_hull + +lemma segment_subset_convex_hull (hx : x ∈ s) (hy : y ∈ s) : segment 𝕜 x y ⊆ convex_hull 𝕜 s := +(convex_convex_hull _ _).segment_subset (subset_convex_hull _ _ hx) (subset_convex_hull _ _ hy) + +@[simp] lemma convex_hull_singleton (x : E) : convex_hull 𝕜 ({x} : set E) = {x} := (convex_singleton x).convex_hull_eq +@[simp] lemma convex_hull_zero : convex_hull 𝕜 (0 : set E) = 0 := +convex_hull_singleton 0 + +@[simp] lemma convex_hull_pair (x y : E) : convex_hull 𝕜 {x, y} = segment 𝕜 x y := +begin + refine (convex_hull_min _ $ convex_segment _ _).antisymm + (segment_subset_convex_hull (mem_insert _ _) $ mem_insert_of_mem _ $ mem_singleton _), + rw [insert_subset, singleton_subset_iff], + exact ⟨left_mem_segment _ _ _, right_mem_segment _ _ _⟩, +end + +lemma convex_hull_convex_hull_union_left (s t : set E) : + convex_hull 𝕜 (convex_hull 𝕜 s ∪ t) = convex_hull 𝕜 (s ∪ t) := +closure_operator.closure_sup_closure_left _ _ _ + +lemma convex_hull_convex_hull_union_right (s t : set E) : + convex_hull 𝕜 (s ∪ convex_hull 𝕜 t) = convex_hull 𝕜 (s ∪ t) := +closure_operator.closure_sup_closure_right _ _ _ + lemma convex.convex_remove_iff_not_mem_convex_hull_remove {s : set E} (hs : convex 𝕜 s) (x : E) : convex 𝕜 (s \ {x}) ↔ x ∉ convex_hull 𝕜 (s \ {x}) := begin @@ -95,21 +133,6 @@ begin by { rintro (rfl : y = x), exact hx hy }⟩), end -lemma is_linear_map.image_convex_hull {f : E → F} (hf : is_linear_map 𝕜 f) : - f '' (convex_hull 𝕜 s) = convex_hull 𝕜 (f '' s) := -begin - apply set.subset.antisymm , - { rw set.image_subset_iff, - exact convex_hull_min (set.image_subset_iff.1 $ subset_convex_hull 𝕜 $ f '' s) - ((convex_convex_hull 𝕜 (f '' s)).is_linear_preimage hf) }, - { exact convex_hull_min (set.image_subset _ $ subset_convex_hull 𝕜 s) - ((convex_convex_hull 𝕜 s).is_linear_image hf) } -end - -lemma linear_map.image_convex_hull (f : E →ₗ[𝕜] F) : - f '' (convex_hull 𝕜 s) = convex_hull 𝕜 (f '' s) := -f.is_linear.image_convex_hull - lemma is_linear_map.convex_hull_image {f : E → F} (hf : is_linear_map 𝕜 f) (s : set E) : convex_hull 𝕜 (f '' s) = f '' convex_hull 𝕜 s := set.subset.antisymm (convex_hull_min (image_subset _ (subset_convex_hull 𝕜 s)) $ @@ -125,6 +148,14 @@ f.is_linear.convex_hull_image s end add_comm_monoid end ordered_semiring +section ordered_comm_semiring +variables [ordered_comm_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] + +lemma convex_hull_smul (a : 𝕜) (s : set E) : convex_hull 𝕜 (a • s) = a • convex_hull 𝕜 s := +(linear_map.lsmul _ _ a).convex_hull_image _ + +end ordered_comm_semiring + section ordered_ring variables [ordered_ring 𝕜] @@ -132,7 +163,7 @@ section add_comm_group variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] (s : set E) lemma affine_map.image_convex_hull (f : E →ᵃ[𝕜] F) : - f '' (convex_hull 𝕜 s) = convex_hull 𝕜 (f '' s) := + f '' convex_hull 𝕜 s = convex_hull 𝕜 (f '' s) := begin apply set.subset.antisymm, { rw set.image_subset_iff, @@ -153,6 +184,9 @@ begin exact convex_hull_subset_affine_span s, end +lemma convex_hull_neg (s : set E) : convex_hull 𝕜 (-s) = -convex_hull 𝕜 s := +by { simp_rw ←image_neg, exact (affine_map.image_convex_hull _ $ -1).symm } + end add_comm_group end ordered_ring end convex_hull diff --git a/src/analysis/convex/independent.lean b/src/analysis/convex/independent.lean index 42e5193fbc833..146ec06b43de8 100644 --- a/src/analysis/convex/independent.lean +++ b/src/analysis/convex/independent.lean @@ -9,6 +9,9 @@ import analysis.convex.extreme /-! # Convex independence +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines convex independent families of points. Convex independence is closely related to affine independence. In both cases, no point can be diff --git a/src/analysis/convex/integral.lean b/src/analysis/convex/integral.lean index 224b5b0f9c6e4..11d6ab7a75741 100644 --- a/src/analysis/convex/integral.lean +++ b/src/analysis/convex/integral.lean @@ -11,6 +11,9 @@ import measure_theory.integral.average /-! # Jensen's inequality for integrals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove several forms of Jensen's inequality for integrals. - for convex sets: `convex.average_mem`, `convex.set_average_mem`, `convex.integral_mem`; @@ -35,12 +38,12 @@ convex, integral, center mass, average value, Jensen's inequality -/ open measure_theory measure_theory.measure metric set filter topological_space function -open_locale topological_space big_operators ennreal convex +open_locale topology big_operators ennreal convex variables {α E F : Type*} {m0 : measurable_space α} - [normed_group E] [normed_space ℝ E] [complete_space E] - [normed_group F] [normed_space ℝ F] [complete_space F] - {μ : measure α} {s : set E} + [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] + [normed_add_comm_group F] [normed_space ℝ F] [complete_space F] + {μ : measure α} {s : set E} {t : set α} {f : α → E} {g : E → ℝ} {C : ℝ} /-! ### Non-strict Jensen's inequality @@ -49,8 +52,8 @@ variables {α E F : Type*} {m0 : measurable_space α} /-- If `μ` is a probability measure on `α`, `s` is a convex closed set in `E`, and `f` is an integrable function sending `μ`-a.e. points to `s`, then the expected value of `f` belongs to `s`: `∫ x, f x ∂μ ∈ s`. See also `convex.sum_mem` for a finite sum version of this lemma. -/ -lemma convex.integral_mem [is_probability_measure μ] {s : set E} (hs : convex ℝ s) - (hsc : is_closed s) {f : α → E} (hf : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) : +lemma convex.integral_mem [is_probability_measure μ] (hs : convex ℝ s) (hsc : is_closed s) + (hf : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) : ∫ x, f x ∂μ ∈ s := begin borelize E, @@ -82,8 +85,8 @@ end /-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`: `⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/ -lemma convex.average_mem [is_finite_measure μ] {s : set E} (hs : convex ℝ s) (hsc : is_closed s) - (hμ : μ ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) : +lemma convex.average_mem [is_finite_measure μ] (hs : convex ℝ s) (hsc : is_closed s) (hμ : μ ≠ 0) + (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) : ⨍ x, f x ∂μ ∈ s := begin haveI : is_probability_measure ((μ univ)⁻¹ • μ), @@ -95,9 +98,8 @@ end /-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`: `⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/ -lemma convex.set_average_mem {t : set α} {s : set E} (hs : convex ℝ s) (hsc : is_closed s) - (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) - (hfi : integrable_on f t μ) : +lemma convex.set_average_mem (hs : convex ℝ s) (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) + (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) : ⨍ x in t, f x ∂μ ∈ s := begin haveI : fact (μ t < ∞) := ⟨ht.lt_top⟩, @@ -108,24 +110,23 @@ end /-- If `μ` is a non-zero finite measure on `α`, `s` is a convex set in `E`, and `f` is an integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `closure s`: `⨍ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version of this lemma. -/ -lemma convex.set_average_mem_closure {t : set α} {s : set E} (hs : convex ℝ s) - (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) - (hfi : integrable_on f t μ) : +lemma convex.set_average_mem_closure (hs : convex ℝ s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) + (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) : ⨍ x in t, f x ∂μ ∈ closure s := hs.closure.set_average_mem is_closed_closure h0 ht (hfs.mono $ λ x hx, subset_closure hx) hfi -lemma convex_on.average_mem_epigraph [is_finite_measure μ] {s : set E} {g : E → ℝ} - (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E} - (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : +lemma convex_on.average_mem_epigraph [is_finite_measure μ] (hg : convex_on ℝ s g) + (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s) + (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : (⨍ x, f x ∂μ, ⨍ x, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2} := have ht_mem : ∀ᵐ x ∂μ, (f x, g (f x)) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2}, from hfs.mono (λ x hx, ⟨hx, le_rfl⟩), by simpa only [average_pair hfi hgi] using hg.convex_epigraph.average_mem (hsc.epigraph hgc) hμ ht_mem (hfi.prod_mk hgi) -lemma concave_on.average_mem_hypograph [is_finite_measure μ] {s : set E} {g : E → ℝ} - (hg : concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E} - (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : +lemma concave_on.average_mem_hypograph [is_finite_measure μ] (hg : concave_on ℝ s g) + (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s) + (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : (⨍ x, f x ∂μ, ⨍ x, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ p.2 ≤ g p.1} := by simpa only [mem_set_of_eq, pi.neg_apply, average_neg, neg_le_neg_iff] using hg.neg.average_mem_epigraph hgc.neg hsc hμ hfs hfi hgi.neg @@ -135,9 +136,9 @@ set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a func `μ`-a.e. points to `s`, then the value of `g` at the average value of `f` is less than or equal to the average value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also `convex_on.map_center_mass_le` for a finite sum version of this lemma. -/ -lemma convex_on.map_average_le [is_finite_measure μ] {s : set E} {g : E → ℝ} - (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E} - (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : +lemma convex_on.map_average_le [is_finite_measure μ] (hg : convex_on ℝ s g) + (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s) + (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : g (⨍ x, f x ∂μ) ≤ ⨍ x, g (f x) ∂μ := (hg.average_mem_epigraph hgc hsc hμ hfs hfi hgi).2 @@ -146,9 +147,9 @@ set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a func `μ`-a.e. points to `s`, then the average value of `g ∘ f` is less than or equal to the value of `g` at the average value of `f` provided that both `f` and `g ∘ f` are integrable. See also `concave_on.le_map_center_mass` for a finite sum version of this lemma. -/ -lemma concave_on.le_map_average [is_finite_measure μ] {s : set E} {g : E → ℝ} - (hg : concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E} - (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : +lemma concave_on.le_map_average [is_finite_measure μ] (hg : concave_on ℝ s g) + (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) (hfs : ∀ᵐ x ∂μ, f x ∈ s) + (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : ⨍ x, g (f x) ∂μ ≤ g (⨍ x, f x ∂μ) := (hg.average_mem_hypograph hgc hsc hμ hfs hfi hgi).2 @@ -157,10 +158,9 @@ set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a func `μ`-a.e. points of a set `t` to `s`, then the value of `g` at the average value of `f` over `t` is less than or equal to the average value of `g ∘ f` over `t` provided that both `f` and `g ∘ f` are integrable. -/ -lemma convex_on.set_average_mem_epigraph {s : set E} {g : E → ℝ} (hg : convex_on ℝ s g) - (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0) - (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) - (hgi : integrable_on (g ∘ f) t μ) : +lemma convex_on.set_average_mem_epigraph (hg : convex_on ℝ s g) (hgc : continuous_on g s) + (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) + (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) : (⨍ x in t, f x ∂μ, ⨍ x in t, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2} := begin haveI : fact (μ t < ∞) := ⟨ht.lt_top⟩, @@ -173,10 +173,9 @@ set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a func `μ`-a.e. points of a set `t` to `s`, then the average value of `g ∘ f` over `t` is less than or equal to the value of `g` at the average value of `f` over `t` provided that both `f` and `g ∘ f` are integrable. -/ -lemma concave_on.set_average_mem_hypograph {s : set E} {g : E → ℝ} (hg : concave_on ℝ s g) - (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0) - (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) - (hgi : integrable_on (g ∘ f) t μ) : +lemma concave_on.set_average_mem_hypograph (hg : concave_on ℝ s g) (hgc : continuous_on g s) + (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) + (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) : (⨍ x in t, f x ∂μ, ⨍ x in t, g (f x) ∂μ) ∈ {p : E × ℝ | p.1 ∈ s ∧ p.2 ≤ g p.1} := by simpa only [mem_set_of_eq, pi.neg_apply, average_neg, neg_le_neg_iff] using hg.neg.set_average_mem_epigraph hgc.neg hsc h0 ht hfs hfi hgi.neg @@ -186,10 +185,9 @@ set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a func `μ`-a.e. points of a set `t` to `s`, then the value of `g` at the average value of `f` over `t` is less than or equal to the average value of `g ∘ f` over `t` provided that both `f` and `g ∘ f` are integrable. -/ -lemma convex_on.map_set_average_le {s : set E} {g : E → ℝ} (hg : convex_on ℝ s g) - (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0) - (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) - (hgi : integrable_on (g ∘ f) t μ) : +lemma convex_on.map_set_average_le (hg : convex_on ℝ s g) (hgc : continuous_on g s) + (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) + (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) : g (⨍ x in t, f x ∂μ) ≤ ⨍ x in t, g (f x) ∂μ := (hg.set_average_mem_epigraph hgc hsc h0 ht hfs hfi hgi).2 @@ -198,10 +196,9 @@ set `s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a func `μ`-a.e. points of a set `t` to `s`, then the average value of `g ∘ f` over `t` is less than or equal to the value of `g` at the average value of `f` over `t` provided that both `f` and `g ∘ f` are integrable. -/ -lemma concave_on.le_map_set_average {s : set E} {g : E → ℝ} (hg : concave_on ℝ s g) - (hgc : continuous_on g s) (hsc : is_closed s) {t : set α} (h0 : μ t ≠ 0) - (ht : μ t ≠ ∞) {f : α → E} (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) (hfi : integrable_on f t μ) - (hgi : integrable_on (g ∘ f) t μ) : +lemma concave_on.le_map_set_average (hg : concave_on ℝ s g) (hgc : continuous_on g s) + (hsc : is_closed s) (h0 : μ t ≠ 0) (ht : μ t ≠ ∞) (hfs : ∀ᵐ x ∂μ.restrict t, f x ∈ s) + (hfi : integrable_on f t μ) (hgi : integrable_on (g ∘ f) t μ) : ⨍ x in t, g (f x) ∂μ ≤ g (⨍ x in t, f x ∂μ) := (hg.set_average_mem_hypograph hgc hsc h0 ht hfs hfi hgi).2 @@ -210,9 +207,9 @@ set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function to `s`, then the value of `g` at the expected value of `f` is less than or equal to the expected value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also `convex_on.map_center_mass_le` for a finite sum version of this lemma. -/ -lemma convex_on.map_integral_le [is_probability_measure μ] {s : set E} {g : E → ℝ} - (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E} - (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : +lemma convex_on.map_integral_le [is_probability_measure μ] (hg : convex_on ℝ s g) + (hgc : continuous_on g s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) + (hgi : integrable (g ∘ f) μ) : g (∫ x, f x ∂μ) ≤ ∫ x, g (f x) ∂μ := by simpa only [average_eq_integral] using hg.map_average_le hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi @@ -221,9 +218,9 @@ by simpa only [average_eq_integral] set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function sending `μ`-a.e. points to `s`, then the expected value of `g ∘ f` is less than or equal to the value of `g` at the expected value of `f` provided that both `f` and `g ∘ f` are integrable. -/ -lemma concave_on.le_map_integral [is_probability_measure μ] {s : set E} {g : E → ℝ} - (hg : concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E} - (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : +lemma concave_on.le_map_integral [is_probability_measure μ] (hg : concave_on ℝ s g) + (hgc : continuous_on g s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) + (hgi : integrable (g ∘ f) μ) : ∫ x, g (f x) ∂μ ≤ g (∫ x, f x ∂μ) := by simpa only [average_eq_integral] using hg.le_map_average hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi @@ -233,32 +230,30 @@ by simpa only [average_eq_integral] -/ /-- If `f : α → E` is an integrable function, then either it is a.e. equal to the constant -`⨍ x, f x ∂μ` or there exists a measurable set such that `μ s ≠ 0`, `μ sᶜ ≠ 0`, and the average -values of `f` over `s` and `sᶜ` are different. -/ -lemma measure_theory.integrable.ae_eq_const_or_exists_average_ne_compl [is_finite_measure μ] - {f : α → E} (hfi : integrable f μ) : - (f =ᵐ[μ] const α (⨍ x, f x ∂μ)) ∨ ∃ s, measurable_set s ∧ μ s ≠ 0 ∧ μ sᶜ ≠ 0 ∧ - ⨍ x in s, f x ∂μ ≠ ⨍ x in sᶜ, f x ∂μ := +`⨍ x, f x ∂μ` or there exists a measurable set such that `μ t ≠ 0`, `μ tᶜ ≠ 0`, and the average +values of `f` over `t` and `tᶜ` are different. -/ +lemma ae_eq_const_or_exists_average_ne_compl [is_finite_measure μ] (hfi : integrable f μ) : + (f =ᵐ[μ] const α (⨍ x, f x ∂μ)) ∨ ∃ t, measurable_set t ∧ μ t ≠ 0 ∧ μ tᶜ ≠ 0 ∧ + ⨍ x in t, f x ∂μ ≠ ⨍ x in tᶜ, f x ∂μ := begin refine or_iff_not_imp_right.mpr (λ H, _), push_neg at H, - refine hfi.ae_eq_of_forall_set_integral_eq _ _ (integrable_const _) (λ s hs hs', _), clear hs', + refine hfi.ae_eq_of_forall_set_integral_eq _ _ (integrable_const _) (λ t ht ht', _), clear ht', simp only [const_apply, set_integral_const], - by_cases h₀ : μ s = 0, + by_cases h₀ : μ t = 0, { rw [restrict_eq_zero.2 h₀, integral_zero_measure, h₀, ennreal.zero_to_real, zero_smul] }, - by_cases h₀' : μ sᶜ = 0, + by_cases h₀' : μ tᶜ = 0, { rw ← ae_eq_univ at h₀', rw [restrict_congr_set h₀', restrict_univ, measure_congr h₀', measure_smul_average] }, - have := average_mem_open_segment_compl_self hs.null_measurable_set h₀ h₀' hfi, - rw [← H s hs h₀ h₀', open_segment_same, mem_singleton_iff] at this, + have := average_mem_open_segment_compl_self ht.null_measurable_set h₀ h₀' hfi, + rw [← H t ht h₀ h₀', open_segment_same, mem_singleton_iff] at this, rw [this, measure_smul_set_average _ (measure_ne_top μ _)] end /-- If an integrable function `f : α → E` takes values in a convex set `s` and for some set `t` of positive measure, the average value of `f` over `t` belongs to the interior of `s`, then the average of `f` over the whole space belongs to the interior of `s`. -/ -lemma convex.average_mem_interior_of_set [is_finite_measure μ] {t : set α} {s : set E} - (hs : convex ℝ s) (h0 : μ t ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) - (hfi : integrable f μ) (ht : ⨍ x in t, f x ∂μ ∈ interior s) : +lemma convex.average_mem_interior_of_set [is_finite_measure μ] (hs : convex ℝ s) (h0 : μ t ≠ 0) + (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (ht : ⨍ x in t, f x ∂μ ∈ interior s) : ⨍ x, f x ∂μ ∈ interior s := begin rw ← measure_to_measurable at h0, rw ← restrict_to_measurable (measure_ne_top μ t) at ht, @@ -274,15 +269,14 @@ end /-- If an integrable function `f : α → E` takes values in a strictly convex closed set `s`, then either it is a.e. equal to its average value, or its average value belongs to the interior of `s`. -/ -lemma strict_convex.ae_eq_const_or_average_mem_interior [is_finite_measure μ] {s : set E} - (hs : strict_convex ℝ s) (hsc : is_closed s) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) - (hfi : integrable f μ) : +lemma strict_convex.ae_eq_const_or_average_mem_interior [is_finite_measure μ] + (hs : strict_convex ℝ s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) : f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ ⨍ x, f x ∂μ ∈ interior s := begin have : ∀ {t}, μ t ≠ 0 → ⨍ x in t, f x ∂μ ∈ s, from λ t ht, hs.convex.set_average_mem hsc ht (measure_ne_top _ _) (ae_restrict_of_ae hfs) hfi.integrable_on, - refine hfi.ae_eq_const_or_exists_average_ne_compl.imp_right _, + refine (ae_eq_const_or_exists_average_ne_compl hfi).imp_right _, rintro ⟨t, hm, h₀, h₀', hne⟩, exact hs.open_segment_subset (this h₀) (this h₀') hne (average_mem_open_segment_compl_self hm.null_measurable_set h₀ h₀' hfi) @@ -291,15 +285,15 @@ end /-- **Jensen's inequality**, strict version: if an integrable function `f : α → E` takes values in a convex closed set `s`, and `g : E → ℝ` is continuous and strictly convex on `s`, then either `f` is a.e. equal to its average value, or `g (⨍ x, f x ∂μ) < ⨍ x, g (f x) ∂μ`. -/ -lemma strict_convex_on.ae_eq_const_or_map_average_lt [is_finite_measure μ] {s : set E} {g : E → ℝ} - (hg : strict_convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E} +lemma strict_convex_on.ae_eq_const_or_map_average_lt [is_finite_measure μ] + (hg : strict_convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ g (⨍ x, f x ∂μ) < ⨍ x, g (f x) ∂μ := begin have : ∀ {t}, μ t ≠ 0 → ⨍ x in t, f x ∂μ ∈ s ∧ g (⨍ x in t, f x ∂μ) ≤ ⨍ x in t, g (f x) ∂μ, from λ t ht, hg.convex_on.set_average_mem_epigraph hgc hsc ht (measure_ne_top _ _) (ae_restrict_of_ae hfs) hfi.integrable_on hgi.integrable_on, - refine hfi.ae_eq_const_or_exists_average_ne_compl.imp_right _, + refine (ae_eq_const_or_exists_average_ne_compl hfi).imp_right _, rintro ⟨t, hm, h₀, h₀', hne⟩, rcases average_mem_open_segment_compl_self hm.null_measurable_set h₀ h₀' (hfi.prod_mk hgi) with ⟨a, b, ha, hb, hab, h_avg⟩, @@ -317,27 +311,27 @@ end /-- **Jensen's inequality**, strict version: if an integrable function `f : α → E` takes values in a convex closed set `s`, and `g : E → ℝ` is continuous and strictly concave on `s`, then either `f` is a.e. equal to its average value, or `⨍ x, g (f x) ∂μ < g (⨍ x, f x ∂μ)`. -/ -lemma strict_concave_on.ae_eq_const_or_lt_map_average [is_finite_measure μ] {s : set E} {g : E → ℝ} - (hg : strict_concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E} +lemma strict_concave_on.ae_eq_const_or_lt_map_average [is_finite_measure μ] + (hg : strict_concave_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) : f =ᵐ[μ] const α (⨍ x, f x ∂μ) ∨ ⨍ x, g (f x) ∂μ < g (⨍ x, f x ∂μ) := by simpa only [pi.neg_apply, average_neg, neg_lt_neg_iff] using hg.neg.ae_eq_const_or_map_average_lt hgc.neg hsc hfs hfi hgi.neg -/-- If `E` is a strictly normed space and `f : α → E` is a function such that `∥f x∥ ≤ C` a.e., then -either this function is a.e. equal to its average value, or the norm of its average value is -strictly less than `C`. -/ +/-- If `E` is a strictly convex normed space and `f : α → E` is a function such that `‖f x‖ ≤ C` +a.e., then either this function is a.e. equal to its average value, or the norm of its average value +is strictly less than `C`. -/ lemma ae_eq_const_or_norm_average_lt_of_norm_le_const [strict_convex_space ℝ E] - {f : α → E} {C : ℝ} (h_le : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) : - (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ∥⨍ x, f x ∂μ∥ < C := + (h_le : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) : + (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ‖⨍ x, f x ∂μ‖ < C := begin cases le_or_lt C 0 with hC0 hC0, { have : f =ᵐ[μ] 0, from h_le.mono (λ x hx, norm_le_zero_iff.1 (hx.trans hC0)), simp only [average_congr this, pi.zero_apply, average_zero], exact or.inl this }, by_cases hfi : integrable f μ, swap, - by simp [average_def', integral_undef hfi, hC0, ennreal.to_real_pos_iff], - cases (le_top : μ univ ≤ ∞).eq_or_lt with hμt hμt, { simp [average_def', hμt, hC0] }, + by simp [average_eq, integral_undef hfi, hC0, ennreal.to_real_pos_iff], + cases (le_top : μ univ ≤ ∞).eq_or_lt with hμt hμt, { simp [average_eq, hμt, hC0] }, haveI : is_finite_measure μ := ⟨hμt⟩, replace h_le : ∀ᵐ x ∂μ, f x ∈ closed_ball (0 : E) C, by simpa only [mem_closed_ball_zero_iff], simpa only [interior_closed_ball _ hC0.ne', mem_ball_zero_iff] @@ -345,17 +339,29 @@ begin is_closed_ball h_le hfi end -/-- If `E` is a strictly normed space and `f : α → E` is a function such that `∥f x∥ ≤ C` a.e., then -either this function is a.e. equal to its average value, or the norm of its integral is strictly -less than `(μ univ).to_real * C`. -/ +/-- If `E` is a strictly convex normed space and `f : α → E` is a function such that `‖f x‖ ≤ C` +a.e., then either this function is a.e. equal to its average value, or the norm of its integral is +strictly less than `(μ univ).to_real * C`. -/ lemma ae_eq_const_or_norm_integral_lt_of_norm_le_const [strict_convex_space ℝ E] - [is_finite_measure μ] {f : α → E} {C : ℝ} (h_le : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) : - (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ∥∫ x, f x ∂μ∥ < (μ univ).to_real * C := + [is_finite_measure μ] (h_le : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) : + (f =ᵐ[μ] const α ⨍ x, f x ∂μ) ∨ ‖∫ x, f x ∂μ‖ < (μ univ).to_real * C := begin cases eq_or_ne μ 0 with h₀ h₀, { left, simp [h₀] }, have hμ : 0 < (μ univ).to_real, by simp [ennreal.to_real_pos_iff, pos_iff_ne_zero, h₀, measure_lt_top], refine (ae_eq_const_or_norm_average_lt_of_norm_le_const h_le).imp_right (λ H, _), - rwa [average_def', norm_smul, norm_inv, real.norm_eq_abs, abs_of_pos hμ, + rwa [average_eq, norm_smul, norm_inv, real.norm_eq_abs, abs_of_pos hμ, ← div_eq_inv_mul, div_lt_iff' hμ] at H end + +/-- If `E` is a strictly convex normed space and `f : α → E` is a function such that `‖f x‖ ≤ C` +a.e. on a set `t` of finite measure, then either this function is a.e. equal to its average value on +`t`, or the norm of its integral over `t` is strictly less than `(μ t).to_real * C`. -/ +lemma ae_eq_const_or_norm_set_integral_lt_of_norm_le_const [strict_convex_space ℝ E] + (ht : μ t ≠ ∞) (h_le : ∀ᵐ x ∂μ.restrict t, ‖f x‖ ≤ C) : + (f =ᵐ[μ.restrict t] const α ⨍ x in t, f x ∂μ) ∨ ‖∫ x in t, f x ∂μ‖ < (μ t).to_real * C := +begin + haveI := fact.mk ht.lt_top, + rw [← restrict_apply_univ], + exact ae_eq_const_or_norm_integral_lt_of_norm_le_const h_le +end diff --git a/src/analysis/convex/intrinsic.lean b/src/analysis/convex/intrinsic.lean new file mode 100644 index 0000000000000..f3e91c330fe29 --- /dev/null +++ b/src/analysis/convex/intrinsic.lean @@ -0,0 +1,309 @@ +/- +Copyright (c) 2023 Paul Reichert. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Paul Reichert, Yaël Dillies +-/ +import analysis.normed_space.add_torsor_bases + +/-! +# Intrinsic frontier and interior + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the intrinsic frontier, interior and closure of a set in a normed additive torsor. +These are also known as relative frontier, interior, closure. + +The intrinsic frontier/interior/closure of a set `s` is the frontier/interior/closure of `s` +considered as a set in its affine span. + +The intrinsic interior is in general greater than the topological interior, the intrinsic frontier +in general less than the topological frontier, and the intrinsic closure in cases of interest the +same as the topological closure. + +## Definitions + +* `intrinsic_interior`: Intrinsic interior +* `intrinsic_frontier`: Intrinsic frontier +* `intrinsic_closure`: Intrinsic closure + +## Results + +The main results are: +* `affine_isometry.image_intrinsic_interior`/`affine_isometry.image_intrinsic_frontier`/ + `affine_isometry.image_intrinsic_closure`: Intrinsic interiors/frontiers/closures commute with + taking the image under an affine isometry. +* `set.nonempty.intrinsic_interior`: The intrinsic interior of a nonempty convex set is nonempty. + +## References + +* Chapter 8 of [Barry Simon, *Convexity*][simon2011] +* Chapter 1 of [Rolf Schneider, *Convex Bodies: The Brunn-Minkowski theory*][schneider2013]. + +## TODO + +* `is_closed s → is_extreme 𝕜 s (intrinsic_frontier 𝕜 s)` +* `x ∈ s → y ∈ intrinsic_interior 𝕜 s → open_segment 𝕜 x y ⊆ intrinsic_interior 𝕜 s` +-/ + +open affine_subspace set +open_locale pointwise + +variables {𝕜 V W Q P : Type*} + +section add_torsor +variables (𝕜) [ring 𝕜] [add_comm_group V] [module 𝕜 V] [topological_space P] [add_torsor V P] + {s t : set P} {x : P} +include V + +/-- The intrinsic interior of a set is its interior considered as a set in its affine span. -/ +def intrinsic_interior (s : set P) : set P := coe '' interior (coe ⁻¹' s : set $ affine_span 𝕜 s) + +/-- The intrinsic frontier of a set is its frontier considered as a set in its affine span. -/ +def intrinsic_frontier (s : set P) : set P := coe '' frontier (coe ⁻¹' s : set $ affine_span 𝕜 s) + +/-- The intrinsic closure of a set is its closure considered as a set in its affine span. -/ +def intrinsic_closure (s : set P) : set P := coe '' closure (coe ⁻¹' s : set $ affine_span 𝕜 s) + +variables {𝕜} + +@[simp] lemma mem_intrinsic_interior : + x ∈ intrinsic_interior 𝕜 s ↔ ∃ y, y ∈ interior (coe ⁻¹' s : set $ affine_span 𝕜 s) ∧ ↑y = x := +mem_image _ _ _ + +@[simp] lemma mem_intrinsic_frontier : + x ∈ intrinsic_frontier 𝕜 s ↔ ∃ y, y ∈ frontier (coe ⁻¹' s : set $ affine_span 𝕜 s) ∧ ↑y = x := +mem_image _ _ _ + +@[simp] lemma mem_intrinsic_closure : + x ∈ intrinsic_closure 𝕜 s ↔ ∃ y, y ∈ closure (coe ⁻¹' s : set $ affine_span 𝕜 s) ∧ ↑y = x := +mem_image _ _ _ + +lemma intrinsic_interior_subset : intrinsic_interior 𝕜 s ⊆ s := image_subset_iff.2 interior_subset + +lemma intrinsic_frontier_subset (hs : is_closed s) : intrinsic_frontier 𝕜 s ⊆ s := +image_subset_iff.2 (hs.preimage continuous_induced_dom).frontier_subset + +lemma intrinsic_frontier_subset_intrinsic_closure : + intrinsic_frontier 𝕜 s ⊆ intrinsic_closure 𝕜 s := +image_subset _ frontier_subset_closure + +lemma subset_intrinsic_closure : s ⊆ intrinsic_closure 𝕜 s := +λ x hx, ⟨⟨x, subset_affine_span _ _ hx⟩, subset_closure hx, rfl⟩ + +@[simp] lemma intrinsic_interior_empty : intrinsic_interior 𝕜 (∅ : set P) = ∅ := +by simp [intrinsic_interior] + +@[simp] lemma intrinsic_frontier_empty : intrinsic_frontier 𝕜 (∅ : set P) = ∅ := +by simp [intrinsic_frontier] + +@[simp] lemma intrinsic_closure_empty : intrinsic_closure 𝕜 (∅ : set P) = ∅ := +by simp [intrinsic_closure] + +@[simp] lemma intrinsic_closure_nonempty : (intrinsic_closure 𝕜 s).nonempty ↔ s.nonempty := +⟨by { simp_rw nonempty_iff_ne_empty, rintro h rfl, exact h intrinsic_closure_empty }, + nonempty.mono subset_intrinsic_closure⟩ + +alias intrinsic_closure_nonempty ↔ set.nonempty.of_intrinsic_closure set.nonempty.intrinsic_closure + +attribute [protected] set.nonempty.intrinsic_closure + +@[simp] lemma intrinsic_interior_singleton (x : P) : intrinsic_interior 𝕜 ({x} : set P) = {x} := +by simpa only [intrinsic_interior, preimage_coe_affine_span_singleton, interior_univ, image_univ, + subtype.range_coe] using coe_affine_span_singleton _ _ _ + +@[simp] lemma intrinsic_frontier_singleton (x : P) : intrinsic_frontier 𝕜 ({x} : set P) = ∅ := +by rw [intrinsic_frontier, preimage_coe_affine_span_singleton, frontier_univ, image_empty] + +@[simp] lemma intrinsic_closure_singleton (x : P) : intrinsic_closure 𝕜 ({x} : set P) = {x} := +by simpa only [intrinsic_closure, preimage_coe_affine_span_singleton, closure_univ, image_univ, + subtype.range_coe] using coe_affine_span_singleton _ _ _ + +/-! +Note that neither `intrinsic_interior` nor `intrinsic_frontier` is monotone. +-/ + +lemma intrinsic_closure_mono (h : s ⊆ t) : intrinsic_closure 𝕜 s ⊆ intrinsic_closure 𝕜 t := +begin + refine image_subset_iff.2 (λ x hx, ⟨set.inclusion (affine_span_mono _ h) x, + (continuous_inclusion _).closure_preimage_subset _ $ closure_mono _ hx, rfl⟩), + exact λ y hy, h hy, +end + +lemma interior_subset_intrinsic_interior : interior s ⊆ intrinsic_interior 𝕜 s := +λ x hx, ⟨⟨x, subset_affine_span _ _ $ interior_subset hx⟩, + preimage_interior_subset_interior_preimage continuous_subtype_coe hx, rfl⟩ + +lemma intrinsic_closure_subset_closure : intrinsic_closure 𝕜 s ⊆ closure s := +image_subset_iff.2 $ continuous_subtype_coe.closure_preimage_subset _ + +lemma intrinsic_frontier_subset_frontier : intrinsic_frontier 𝕜 s ⊆ frontier s := +image_subset_iff.2 $ continuous_subtype_coe.frontier_preimage_subset _ + +lemma intrinsic_closure_subset_affine_span : intrinsic_closure 𝕜 s ⊆ affine_span 𝕜 s := +(image_subset_range _ _).trans subtype.range_coe.subset + +@[simp] lemma intrinsic_closure_diff_intrinsic_frontier (s : set P) : + intrinsic_closure 𝕜 s \ intrinsic_frontier 𝕜 s = intrinsic_interior 𝕜 s := +(image_diff subtype.coe_injective _ _).symm.trans $ + by rw [closure_diff_frontier, intrinsic_interior] + +@[simp] lemma intrinsic_closure_diff_intrinsic_interior (s : set P) : + intrinsic_closure 𝕜 s \ intrinsic_interior 𝕜 s = intrinsic_frontier 𝕜 s := +(image_diff subtype.coe_injective _ _).symm + +@[simp] lemma intrinsic_interior_union_intrinsic_frontier (s : set P) : + intrinsic_interior 𝕜 s ∪ intrinsic_frontier 𝕜 s = intrinsic_closure 𝕜 s := +by simp [intrinsic_closure, intrinsic_interior, intrinsic_frontier, + closure_eq_interior_union_frontier, image_union] + +@[simp] lemma intrinsic_frontier_union_intrinsic_interior (s : set P) : + intrinsic_frontier 𝕜 s ∪ intrinsic_interior 𝕜 s = intrinsic_closure 𝕜 s := +by rw [union_comm, intrinsic_interior_union_intrinsic_frontier] + +lemma is_closed_intrinsic_closure (hs : is_closed (affine_span 𝕜 s : set P)) : + is_closed (intrinsic_closure 𝕜 s) := +(closed_embedding_subtype_coe hs).is_closed_map _ is_closed_closure + +lemma is_closed_intrinsic_frontier (hs : is_closed (affine_span 𝕜 s : set P)) : + is_closed (intrinsic_frontier 𝕜 s) := +(closed_embedding_subtype_coe hs).is_closed_map _ is_closed_frontier + +@[simp] lemma affine_span_intrinsic_closure (s : set P) : + affine_span 𝕜 (intrinsic_closure 𝕜 s) = affine_span 𝕜 s := +(affine_span_le.2 intrinsic_closure_subset_affine_span).antisymm $ + affine_span_mono _ subset_intrinsic_closure + +protected lemma is_closed.intrinsic_closure (hs : is_closed (coe ⁻¹' s : set $ affine_span 𝕜 s)) : + intrinsic_closure 𝕜 s = s := +begin + rw [intrinsic_closure, hs.closure_eq, image_preimage_eq_of_subset], + exact (subset_affine_span _ _).trans subtype.range_coe.superset, +end + +@[simp] lemma intrinsic_closure_idem (s : set P) : + intrinsic_closure 𝕜 (intrinsic_closure 𝕜 s) = intrinsic_closure 𝕜 s := +begin + refine is_closed.intrinsic_closure _, + set t := affine_span 𝕜 (intrinsic_closure 𝕜 s) with ht, + clear_value t, + obtain rfl := ht.trans (affine_span_intrinsic_closure _), + rw [intrinsic_closure, preimage_image_eq _ subtype.coe_injective], + exact is_closed_closure, +end + +end add_torsor + +namespace affine_isometry +variables [normed_field 𝕜] [seminormed_add_comm_group V] [seminormed_add_comm_group W] + [normed_space 𝕜 V] [normed_space 𝕜 W] [metric_space P] [pseudo_metric_space Q] + [normed_add_torsor V P] [normed_add_torsor W Q] +include V W + +local attribute [instance, nolint fails_quickly] affine_subspace.to_normed_add_torsor + affine_subspace.nonempty_map + +@[simp] lemma image_intrinsic_interior (φ : P →ᵃⁱ[𝕜] Q) (s : set P) : + intrinsic_interior 𝕜 (φ '' s) = φ '' intrinsic_interior 𝕜 s := +begin + obtain rfl | hs := s.eq_empty_or_nonempty, + { simp only [intrinsic_interior_empty, image_empty] }, + haveI : nonempty s := hs.to_subtype, + let f := ((affine_span 𝕜 s).isometry_equiv_map φ).to_homeomorph, + have : φ.to_affine_map ∘ coe ∘ f.symm = coe := funext isometry_equiv_map.apply_symm_apply, + rw [intrinsic_interior, intrinsic_interior, ←φ.coe_to_affine_map, ←map_span φ.to_affine_map s, + ←this, ←function.comp.assoc, image_comp, image_comp, f.symm.image_interior, f.image_symm, + ←preimage_comp, function.comp.assoc, f.symm_comp_self, affine_isometry.coe_to_affine_map, + function.comp.right_id, preimage_comp, φ.injective.preimage_image], +end + +@[simp] lemma image_intrinsic_frontier (φ : P →ᵃⁱ[𝕜] Q) (s : set P) : + intrinsic_frontier 𝕜 (φ '' s) = φ '' intrinsic_frontier 𝕜 s := +begin + obtain rfl | hs := s.eq_empty_or_nonempty, + { simp }, + haveI : nonempty s := hs.to_subtype, + let f := ((affine_span 𝕜 s).isometry_equiv_map φ).to_homeomorph, + have : φ.to_affine_map ∘ coe ∘ f.symm = coe := funext isometry_equiv_map.apply_symm_apply, + rw [intrinsic_frontier, intrinsic_frontier, ←φ.coe_to_affine_map, ←map_span φ.to_affine_map s, + ←this, ←function.comp.assoc, image_comp, image_comp, f.symm.image_frontier, f.image_symm, + ←preimage_comp, function.comp.assoc, f.symm_comp_self, affine_isometry.coe_to_affine_map, + function.comp.right_id, preimage_comp, φ.injective.preimage_image], +end + +@[simp] lemma image_intrinsic_closure (φ : P →ᵃⁱ[𝕜] Q) (s : set P) : + intrinsic_closure 𝕜 (φ '' s) = φ '' intrinsic_closure 𝕜 s := +begin + obtain rfl | hs := s.eq_empty_or_nonempty, + { simp }, + haveI : nonempty s := hs.to_subtype, + let f := ((affine_span 𝕜 s).isometry_equiv_map φ).to_homeomorph, + have : φ.to_affine_map ∘ coe ∘ f.symm = coe := funext isometry_equiv_map.apply_symm_apply, + rw [intrinsic_closure, intrinsic_closure, ←φ.coe_to_affine_map, ←map_span φ.to_affine_map s, + ←this, ←function.comp.assoc, image_comp, image_comp, f.symm.image_closure, f.image_symm, + ←preimage_comp, function.comp.assoc, f.symm_comp_self, affine_isometry.coe_to_affine_map, + function.comp.right_id, preimage_comp, φ.injective.preimage_image], +end + +end affine_isometry + +section normed_add_torsor +variables (𝕜) [nontrivially_normed_field 𝕜] [complete_space 𝕜] [normed_add_comm_group V] + [normed_space 𝕜 V] [finite_dimensional 𝕜 V] [metric_space P] [normed_add_torsor V P] (s : set P) +include V + +@[simp] lemma intrinsic_closure_eq_closure : intrinsic_closure 𝕜 s = closure s := +begin + ext x, + simp only [mem_closure_iff, mem_intrinsic_closure], + refine ⟨_, λ h, ⟨⟨x, _⟩, _, subtype.coe_mk _ _⟩⟩, + { rintro ⟨x, h, rfl⟩ t ht hx, + obtain ⟨z, hz₁, hz₂⟩ := h _ (continuous_induced_dom.is_open_preimage t ht) hx, + exact ⟨z, hz₁, hz₂⟩ }, + { by_contradiction hc, + obtain ⟨z, hz₁, hz₂⟩ := h _ (affine_span 𝕜 s).closed_of_finite_dimensional.is_open_compl hc, + exact hz₁ (subset_affine_span 𝕜 s hz₂) }, + { rintro _ ⟨t, ht, rfl⟩ hx, + obtain ⟨y, hyt, hys⟩ := h _ ht hx, + exact ⟨⟨_, subset_affine_span 𝕜 s hys⟩, hyt, hys⟩ } +end + +variables {𝕜} + +@[simp] lemma closure_diff_intrinsic_interior (s : set P) : + closure s \ intrinsic_interior 𝕜 s = intrinsic_frontier 𝕜 s := +intrinsic_closure_eq_closure 𝕜 s ▸ intrinsic_closure_diff_intrinsic_interior s + +@[simp] lemma closure_diff_intrinsic_frontier (s : set P) : + closure s \ intrinsic_frontier 𝕜 s = intrinsic_interior 𝕜 s := +intrinsic_closure_eq_closure 𝕜 s ▸ intrinsic_closure_diff_intrinsic_frontier s + +end normed_add_torsor + +private lemma aux {α β : Type*} [topological_space α] [topological_space β] (φ : α ≃ₜ β) + (s : set β) : + (interior s).nonempty ↔ (interior (φ ⁻¹' s)).nonempty := +by rw [←φ.image_symm, ←φ.symm.image_interior, nonempty_image_iff] + +variables [normed_add_comm_group V] [normed_space ℝ V] [finite_dimensional ℝ V] {s : set V} + +/-- The intrinsic interior of a nonempty convex set is nonempty. -/ +protected lemma set.nonempty.intrinsic_interior (hscv : convex ℝ s) (hsne : s.nonempty) : + (intrinsic_interior ℝ s).nonempty := +begin + haveI := hsne.coe_sort, + obtain ⟨p, hp⟩ := hsne, + let p' : affine_span ℝ s := ⟨p, subset_affine_span _ _ hp⟩, + rw [intrinsic_interior, nonempty_image_iff, + aux (affine_isometry_equiv.const_vsub ℝ p').symm.to_homeomorph, + convex.interior_nonempty_iff_affine_span_eq_top, affine_isometry_equiv.coe_to_homeomorph, + ←affine_isometry_equiv.coe_to_affine_equiv, ←comap_span, affine_span_coe_preimage_eq_top, + comap_top], + exact hscv.affine_preimage ((affine_span ℝ s).subtype.comp + (affine_isometry_equiv.const_vsub ℝ p').symm.to_affine_equiv.to_affine_map), +end + +lemma intrinsic_interior_nonempty (hs : convex ℝ s) : + (intrinsic_interior ℝ s).nonempty ↔ s.nonempty := +⟨by { simp_rw nonempty_iff_ne_empty, rintro h rfl, exact h intrinsic_interior_empty }, + set.nonempty.intrinsic_interior hs⟩ diff --git a/src/analysis/convex/jensen.lean b/src/analysis/convex/jensen.lean index a548eb26f0c6b..e65f7726f8ea6 100644 --- a/src/analysis/convex/jensen.lean +++ b/src/analysis/convex/jensen.lean @@ -9,6 +9,9 @@ import analysis.convex.function /-! # Jensen's inequality and maximum principle for convex functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove the finite Jensen inequality and the finite maximum principle for convex functions. The integral versions are to be found in `analysis.convex.integral`. @@ -74,7 +77,21 @@ end jensen section maximum_principle variables [linear_ordered_field 𝕜] [add_comm_group E] [linear_ordered_add_comm_group β] [module 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} {t : finset ι} {w : ι → 𝕜} - {p : ι → E} + {p : ι → E} {x : E} + +lemma le_sup_of_mem_convex_hull {s : finset E} (hf : convex_on 𝕜 (convex_hull 𝕜 (s : set E)) f) + (hx : x ∈ convex_hull 𝕜 (s : set E)) : + f x ≤ s.sup' (coe_nonempty.1 $ convex_hull_nonempty_iff.1 ⟨x, hx⟩) f := +begin + obtain ⟨w, hw₀, hw₁, rfl⟩ := mem_convex_hull.1 hx, + exact (hf.map_center_mass_le hw₀ (by positivity) $ subset_convex_hull _ _).trans + (center_mass_le_sup hw₀ $ by positivity), +end + +lemma inf_le_of_mem_convex_hull {s : finset E} (hf : concave_on 𝕜 (convex_hull 𝕜 (s : set E)) f) + (hx : x ∈ convex_hull 𝕜 (s : set E)) : + s.inf' (coe_nonempty.1 $ convex_hull_nonempty_iff.1 ⟨x, hx⟩) f ≤ f x := +le_sup_of_mem_convex_hull hf.dual hx /-- If a function `f` is convex on `s`, then the value it takes at some center of mass of points of `s` is less than the value it takes on one of those points. -/ @@ -83,9 +100,8 @@ lemma convex_on.exists_ge_of_center_mass (h : convex_on 𝕜 s f) ∃ i ∈ t, f (t.center_mass w p) ≤ f (p i) := begin set y := t.center_mass w p, - suffices h : ∃ i ∈ t.filter (λ i, w i ≠ 0), w i • f y ≤ w i • (f ∘ p) i, - { obtain ⟨i, hi, hfi⟩ := h, - rw mem_filter at hi, + rsuffices ⟨i, hi, hfi⟩ : ∃ i ∈ t.filter (λ i, w i ≠ 0), w i • f y ≤ w i • (f ∘ p) i, + { rw mem_filter at hi, exact ⟨i, hi.1, (smul_le_smul_iff_of_pos $ (hw₀ i hi.1).lt_of_ne hi.2.symm).1 hfi⟩ }, have hw' : (0 : 𝕜) < ∑ i in filter (λ i, w i ≠ 0) t, w i := by rwa sum_filter_ne_zero, refine exists_le_of_sum_le (nonempty_of_sum_ne_zero hw'.ne') _, diff --git a/src/analysis/convex/join.lean b/src/analysis/convex/join.lean new file mode 100644 index 0000000000000..1a0ec117a51c7 --- /dev/null +++ b/src/analysis/convex/join.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import analysis.convex.combination + +/-! +# Convex join + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the convex join of two sets. The convex join of `s` and `t` is the union of the +segments with one end in `s` and the other in `t`. This is notably a useful gadget to deal with +convex hulls of finite sets. +-/ + +open set +open_locale big_operators + +variables {ι : Sort*} {𝕜 E : Type*} + +section ordered_semiring +variables (𝕜) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] {s t s₁ s₂ t₁ t₂ u : set E} + {x y : E} + +/-- The join of two sets is the union of the segments joining them. This can be interpreted as the +topological join, but within the original space. -/ +def convex_join (s t : set E) : set E := ⋃ (x ∈ s) (y ∈ t), segment 𝕜 x y + +variables {𝕜} + +lemma mem_convex_join : x ∈ convex_join 𝕜 s t ↔ ∃ (a ∈ s) (b ∈ t), x ∈ segment 𝕜 a b := +by simp [convex_join] + +lemma convex_join_comm (s t : set E) : convex_join 𝕜 s t = convex_join 𝕜 t s := +(Union₂_comm _).trans $ by simp_rw [convex_join, segment_symm] + +lemma convex_join_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : convex_join 𝕜 s₁ t₁ ⊆ convex_join 𝕜 s₂ t₂ := +bUnion_mono hs $ λ x hx, bUnion_mono ht $ λ y hy, subset.rfl + +lemma convex_join_mono_left (hs : s₁ ⊆ s₂) : convex_join 𝕜 s₁ t ⊆ convex_join 𝕜 s₂ t := +convex_join_mono hs subset.rfl + +lemma convex_join_mono_right (ht : t₁ ⊆ t₂) : convex_join 𝕜 s t₁ ⊆ convex_join 𝕜 s t₂ := +convex_join_mono subset.rfl ht + +@[simp] lemma convex_join_empty_left (t : set E) : convex_join 𝕜 ∅ t = ∅ := by simp [convex_join] +@[simp] lemma convex_join_empty_right (s : set E) : convex_join 𝕜 s ∅ = ∅ := by simp [convex_join] + +@[simp] lemma convex_join_singleton_left (t : set E) (x : E) : + convex_join 𝕜 {x} t = ⋃ (y ∈ t), segment 𝕜 x y := by simp [convex_join] + +@[simp] lemma convex_join_singleton_right (s : set E) (y : E) : + convex_join 𝕜 s {y} = ⋃ (x ∈ s), segment 𝕜 x y := by simp [convex_join] + +@[simp] lemma convex_join_singletons (x : E) : convex_join 𝕜 {x} {y} = segment 𝕜 x y := +by simp [convex_join] + +@[simp] lemma convex_join_union_left (s₁ s₂ t : set E) : + convex_join 𝕜 (s₁ ∪ s₂) t = convex_join 𝕜 s₁ t ∪ convex_join 𝕜 s₂ t := +by simp_rw [convex_join, mem_union, Union_or, Union_union_distrib] + +@[simp] lemma convex_join_union_right (s t₁ t₂ : set E) : + convex_join 𝕜 s (t₁ ∪ t₂) = convex_join 𝕜 s t₁ ∪ convex_join 𝕜 s t₂ := +by simp_rw [convex_join, mem_union, Union_or, Union_union_distrib] + +@[simp] lemma convex_join_Union_left (s : ι → set E) (t : set E) : + convex_join 𝕜 (⋃ i, s i) t = ⋃ i, convex_join 𝕜 (s i) t := +by { simp_rw [convex_join, mem_Union, Union_exists], exact Union_comm _ } + +@[simp] lemma convex_join_Union_right (s : set E) (t : ι → set E) : + convex_join 𝕜 s (⋃ i, t i) = ⋃ i, convex_join 𝕜 s (t i) := +by simp_rw [convex_join_comm s, convex_join_Union_left] + +lemma segment_subset_convex_join (hx : x ∈ s) (hy : y ∈ t) : segment 𝕜 x y ⊆ convex_join 𝕜 s t := +(subset_Union₂ y hy).trans (subset_Union₂ x hx) + +lemma subset_convex_join_left (h : t.nonempty) : s ⊆ convex_join 𝕜 s t := +λ x hx, let ⟨y, hy⟩ := h in segment_subset_convex_join hx hy $ left_mem_segment _ _ _ + +lemma subset_convex_join_right (h : s.nonempty) : t ⊆ convex_join 𝕜 s t := +λ y hy, let ⟨x, hx⟩ := h in segment_subset_convex_join hx hy $ right_mem_segment _ _ _ + +lemma convex_join_subset (hs : s ⊆ u) (ht : t ⊆ u) (hu : convex 𝕜 u) : convex_join 𝕜 s t ⊆ u := +Union₂_subset $ λ x hx, Union₂_subset $ λ y hy, hu.segment_subset (hs hx) (ht hy) + +lemma convex_join_subset_convex_hull (s t : set E) : convex_join 𝕜 s t ⊆ convex_hull 𝕜 (s ∪ t) := +convex_join_subset ((subset_union_left _ _).trans $ subset_convex_hull _ _) + ((subset_union_right _ _).trans $ subset_convex_hull _ _) $ convex_convex_hull _ _ + +end ordered_semiring + +section linear_ordered_field +variables [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] {s t u : set E} {x y : E} + +lemma convex_join_assoc_aux (s t u : set E) : + convex_join 𝕜 (convex_join 𝕜 s t) u ⊆ convex_join 𝕜 s (convex_join 𝕜 t u) := +begin + simp_rw [subset_def, mem_convex_join], + rintro _ ⟨z, ⟨x, hx, y, hy, a₁, b₁, ha₁, hb₁, hab₁, rfl⟩, z, hz, a₂, b₂, ha₂, hb₂, hab₂, rfl⟩, + obtain rfl | hb₂ := hb₂.eq_or_lt, + { refine ⟨x, hx, y, ⟨y, hy, z, hz, left_mem_segment _ _ _⟩, a₁, b₁, ha₁, hb₁, hab₁, _⟩, + rw add_zero at hab₂, + rw [hab₂, one_smul, zero_smul, add_zero] }, + have ha₂b₁ : 0 ≤ a₂ * b₁ := mul_nonneg ha₂ hb₁, + have hab : 0 < a₂ * b₁ + b₂ := add_pos_of_nonneg_of_pos ha₂b₁ hb₂, + refine ⟨x, hx, ((a₂ * b₁) / (a₂ * b₁ + b₂)) • y + (b₂ / (a₂ * b₁ + b₂)) • z, + ⟨y, hy, z, hz, _, _, _, _, _, rfl⟩, a₂ * a₁, a₂ * b₁ + b₂, mul_nonneg ha₂ ha₁, hab.le, _, _⟩, + { exact div_nonneg ha₂b₁ hab.le }, + { exact div_nonneg hb₂.le hab.le }, + { rw [←add_div, div_self hab.ne'] }, + { rw [←add_assoc, ←mul_add, hab₁, mul_one, hab₂] }, + { simp_rw [smul_add, ←mul_smul, mul_div_cancel' _ hab.ne', add_assoc] } +end + +lemma convex_join_assoc (s t u : set E) : + convex_join 𝕜 (convex_join 𝕜 s t) u = convex_join 𝕜 s (convex_join 𝕜 t u) := +begin + refine (convex_join_assoc_aux _ _ _).antisymm _, + simp_rw [convex_join_comm s, convex_join_comm _ u], + exact convex_join_assoc_aux _ _ _, +end + +lemma convex_join_left_comm (s t u : set E) : + convex_join 𝕜 s (convex_join 𝕜 t u) = convex_join 𝕜 t (convex_join 𝕜 s u) := +by simp_rw [←convex_join_assoc, convex_join_comm] + +lemma convex_join_right_comm (s t u : set E) : + convex_join 𝕜 (convex_join 𝕜 s t) u = convex_join 𝕜 (convex_join 𝕜 s u) t := +by simp_rw [convex_join_assoc, convex_join_comm] + +lemma convex_join_convex_join_convex_join_comm (s t u v : set E) : + convex_join 𝕜 (convex_join 𝕜 s t) (convex_join 𝕜 u v) = + convex_join 𝕜 (convex_join 𝕜 s u) (convex_join 𝕜 t v) := +by simp_rw [←convex_join_assoc, convex_join_right_comm] + +lemma convex_hull_insert (hs : s.nonempty) : + convex_hull 𝕜 (insert x s) = convex_join 𝕜 {x} (convex_hull 𝕜 s) := +begin + classical, + refine (convex_join_subset ((singleton_subset_iff.2 $ mem_insert _ _).trans $ subset_convex_hull + _ _) (convex_hull_mono $ subset_insert _ _) $ convex_convex_hull _ _).antisymm' (λ x hx, _), + rw convex_hull_eq at hx, + obtain ⟨ι, t, w, z, hw₀, hw₁, hz, rfl⟩ := hx, + have : (∑ i in t.filter (λ i, z i = x), w i) • x + ∑ i in t.filter (λ i, z i ≠ x), w i • z i = + t.center_mass w z, + { rw [finset.center_mass_eq_of_sum_1 _ _ hw₁, finset.sum_smul], + convert finset.sum_filter_add_sum_filter_not _ _ (w • z) using 2, + refine finset.sum_congr rfl (λ i hi, _), + rw [pi.smul_apply', (finset.mem_filter.1 hi).2] }, + rw ←this, + have hw₀' : ∀ i ∈ t.filter (λ i, z i ≠ x), 0 ≤ w i := λ i hi, hw₀ _ $ finset.filter_subset _ _ hi, + obtain hw | hw := (finset.sum_nonneg hw₀').eq_or_gt, + { rw [←finset.sum_filter_add_sum_filter_not _ (λ i, z i = x), hw, add_zero] at hw₁, + rw [hw₁, one_smul, finset.sum_eq_zero, add_zero], + { exact subset_convex_join_left hs.convex_hull (mem_singleton _) }, + simp_rw finset.sum_eq_zero_iff_of_nonneg hw₀' at hw, + rintro i hi, + rw [hw _ hi, zero_smul] }, + refine mem_convex_join.2 ⟨x, mem_singleton _, (t.filter $ λ i, z i ≠ x).center_mass w z, + finset.center_mass_mem_convex_hull _ hw₀' hw (λ i hi, _), + ∑ i in t.filter (λ i, z i = x), w i, ∑ i in t.filter (λ i, z i ≠ x), w i, + finset.sum_nonneg (λ i hi, hw₀ _ $ finset.filter_subset _ _ hi), finset.sum_nonneg hw₀', _, _⟩, + { rw finset.mem_filter at hi, + exact mem_of_mem_insert_of_ne (hz _ hi.1) hi.2 }, + { rw [finset.sum_filter_add_sum_filter_not, hw₁] }, + { rw [finset.center_mass, smul_inv_smul₀ hw.ne', finset.sum_smul] } +end + +lemma convex_join_segments (a b c d : E) : + convex_join 𝕜 (segment 𝕜 a b) (segment 𝕜 c d) = convex_hull 𝕜 {a, b, c, d} := +by simp only [convex_hull_insert, insert_nonempty, singleton_nonempty, convex_hull_pair, + ←convex_join_assoc, convex_join_singletons] + +lemma convex_join_segment_singleton (a b c : E) : + convex_join 𝕜 (segment 𝕜 a b) {c} = convex_hull 𝕜 {a, b, c} := +by rw [←pair_eq_singleton, ←convex_join_segments, segment_same, pair_eq_singleton] + +lemma convex_join_singleton_segment (a b c : E) : + convex_join 𝕜 {a} (segment 𝕜 b c) = convex_hull 𝕜 {a, b, c} := +by rw [←segment_same 𝕜, convex_join_segments, insert_idem] + +protected lemma convex.convex_join (hs : convex 𝕜 s) (ht : convex 𝕜 t) : + convex 𝕜 (convex_join 𝕜 s t) := +begin + rw convex_iff_segment_subset at ⊢ ht hs, + simp_rw mem_convex_join, + rintro x ⟨xa, hxa, xb, hxb, hx⟩ y ⟨ya, hya, yb, hyb, hy⟩, + refine (segment_subset_convex_join hx hy).trans _, + have triv : ({xa, xb, ya, yb} : set E) = {xa, ya, xb, yb} := by simp only [set.insert_comm], + rw [convex_join_segments, triv, ←convex_join_segments], + exact convex_join_mono (hs hxa hya) (ht hxb hyb), +end + +protected lemma convex.convex_hull_union (hs : convex 𝕜 s) (ht : convex 𝕜 t) (hs₀ : s.nonempty) + (ht₀ : t.nonempty) : + convex_hull 𝕜 (s ∪ t) = convex_join 𝕜 s t := +(convex_hull_min (union_subset (subset_convex_join_left ht₀) $ subset_convex_join_right hs₀) $ + hs.convex_join ht).antisymm $ convex_join_subset_convex_hull _ _ + +lemma convex_hull_union (hs : s.nonempty) (ht : t.nonempty) : + convex_hull 𝕜 (s ∪ t) = convex_join 𝕜 (convex_hull 𝕜 s) (convex_hull 𝕜 t) := +begin + rw [←convex_hull_convex_hull_union_left, ←convex_hull_convex_hull_union_right], + exact (convex_convex_hull 𝕜 s).convex_hull_union (convex_convex_hull 𝕜 t) + hs.convex_hull ht.convex_hull, +end + +end linear_ordered_field diff --git a/src/analysis/convex/krein_milman.lean b/src/analysis/convex/krein_milman.lean new file mode 100644 index 0000000000000..8ae0817cf2298 --- /dev/null +++ b/src/analysis/convex/krein_milman.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import analysis.convex.exposed +import analysis.normed_space.hahn_banach.separation + +/-! +# The Krein-Milman theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the Krein-Milman lemma and the Krein-Milman theorem. + +## The lemma + +The lemma states that a nonempty compact set `s` has an extreme point. The proof goes: +1. Using Zorn's lemma, find a minimal nonempty closed `t` that is an extreme subset of `s`. We will + show that `t` is a singleton, thus corresponding to an extreme point. +2. By contradiction, `t` contains two distinct points `x` and `y`. +3. With the (geometric) Hahn-Banach theorem, find an hyperplane that separates `x` and `y`. +4. Look at the extreme (actually exposed) subset of `t` obtained by going the furthest away from + the separating hyperplane in the direction of `x`. It is nonempty, closed and an extreme subset + of `s`. +5. It is a strict subset of `t` (`y` isn't in it), so `t` isn't minimal. Absurd. + +## The theorem + +The theorem states that a compact convex set `s` is the closure of the convex hull of its extreme +points. It is an almost immediate strengthening of the lemma. The proof goes: +1. By contradiction, `s \ closure (convex_hull ℝ (extreme_points ℝ s))` is nonempty, say with `x`. +2. With the (geometric) Hahn-Banach theorem, find an hyperplane that separates `x` from + `closure (convex_hull ℝ (extreme_points ℝ s))`. +3. Look at the extreme (actually exposed) subset of + `s \ closure (convex_hull ℝ (extreme_points ℝ s))` obtained by going the furthest away from the + separating hyperplane. It is nonempty by assumption of nonemptiness and compactness, so by the + lemma it has an extreme point. +4. This point is also an extreme point of `s`. Absurd. + +## Related theorems + +When the space is finite dimensional, the `closure` can be dropped to strengthen the result of the +Krein-Milman theorem. This leads to the Minkowski-Carathéodory theorem (currently not in mathlib). +Birkhoff's theorem is the Minkowski-Carathéodory theorem applied to the set of bistochastic +matrices, permutation matrices being the extreme points. + +## References + +See chapter 8 of [Barry Simon, *Convexity*][simon2011] + +-/ + +open set +open_locale classical + +variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E] [t2_space E] + [topological_add_group E] [has_continuous_smul ℝ E] [locally_convex_space ℝ E] {s : set E} + +/-- **Krein-Milman lemma**: In a LCTVS, any nonempty compact set has an extreme point. -/ +lemma is_compact.has_extreme_point (hscomp : is_compact s) (hsnemp : s.nonempty) : + (s.extreme_points ℝ).nonempty := +begin + let S : set (set E) := {t | t.nonempty ∧ is_closed t ∧ is_extreme ℝ s t}, + rsuffices ⟨t, ⟨⟨x, hxt⟩, htclos, hst⟩, hBmin⟩ : ∃ t ∈ S, ∀ u ∈ S, u ⊆ t → u = t, + { refine ⟨x, mem_extreme_points_iff_extreme_singleton.2 _⟩, + rwa ←eq_singleton_iff_unique_mem.2 ⟨hxt, λ y hyB, _⟩, + by_contra hyx, + obtain ⟨l, hl⟩ := geometric_hahn_banach_point_point hyx, + obtain ⟨z, hzt, hz⟩ := (is_compact_of_is_closed_subset hscomp htclos hst.1).exists_forall_ge + ⟨x, hxt⟩ l.continuous.continuous_on, + have h : is_exposed ℝ t {z ∈ t | ∀ w ∈ t, l w ≤ l z} := λ h, ⟨l, rfl⟩, + rw ←hBmin {z ∈ t | ∀ w ∈ t, l w ≤ l z} ⟨⟨z, hzt, hz⟩, h.is_closed htclos, hst.trans + h.is_extreme⟩ (t.sep_subset _) at hyB, + exact hl.not_le (hyB.2 x hxt) }, + refine zorn_superset _ (λ F hFS hF, _), + obtain rfl | hFnemp := F.eq_empty_or_nonempty, + { exact ⟨s, ⟨hsnemp, hscomp.is_closed, is_extreme.rfl⟩, λ _, false.elim⟩ }, + refine ⟨⋂₀ F, ⟨_, is_closed_sInter $ λ t ht, (hFS ht).2.1, is_extreme_sInter hFnemp $ + λ t ht, (hFS ht).2.2⟩, λ t ht, sInter_subset_of_mem ht⟩, + haveI : nonempty ↥F := hFnemp.to_subtype, + rw sInter_eq_Inter, + refine is_compact.nonempty_Inter_of_directed_nonempty_compact_closed _ (λ t u, _) + (λ t, (hFS t.mem).1) + (λ t, is_compact_of_is_closed_subset hscomp (hFS t.mem).2.1 (hFS t.mem).2.2.1) + (λ t, (hFS t.mem).2.1), + obtain htu | hut := hF.total t.mem u.mem, + exacts [⟨t, subset.rfl, htu⟩, ⟨u, hut, subset.rfl⟩], +end + +/-- **Krein-Milman theorem**: In a LCTVS, any compact convex set is the closure of the convex hull + of its extreme points. -/ +lemma closure_convex_hull_extreme_points (hscomp : is_compact s) (hAconv : convex ℝ s) : + closure (convex_hull ℝ $ s.extreme_points ℝ) = s := +begin + apply (closure_minimal (convex_hull_min extreme_points_subset hAconv) hscomp.is_closed).antisymm, + by_contra hs, + obtain ⟨x, hxA, hxt⟩ := not_subset.1 hs, + obtain ⟨l, r, hlr, hrx⟩ := geometric_hahn_banach_closed_point (convex_convex_hull _ _).closure + is_closed_closure hxt, + have h : is_exposed ℝ s {y ∈ s | ∀ z ∈ s, l z ≤ l y} := λ _, ⟨l, rfl⟩, + obtain ⟨z, hzA, hz⟩ := hscomp.exists_forall_ge ⟨x, hxA⟩ l.continuous.continuous_on, + obtain ⟨y, hy⟩ := (h.is_compact hscomp).has_extreme_point ⟨z, hzA, hz⟩, + linarith [hlr _ (subset_closure $ subset_convex_hull _ _ $ + h.is_extreme.extreme_points_subset_extreme_points hy), hy.1.2 x hxA], +end diff --git a/src/analysis/convex/measure.lean b/src/analysis/convex/measure.lean index cf1486d21fdaa..e80f6a9481d9c 100644 --- a/src/analysis/convex/measure.lean +++ b/src/analysis/convex/measure.lean @@ -5,21 +5,24 @@ Authors: Yury Kudryashov -/ import analysis.convex.topology import analysis.normed_space.add_torsor_bases -import measure_theory.measure.haar_lebesgue +import measure_theory.measure.lebesgue.eq_haar /-! # Convex sets are null-measurable +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `E` be a finite dimensional real vector space, let `μ` be a Haar measure on `E`, let `s` be a convex set in `E`. Then the frontier of `s` has measure zero (see `convex.add_haar_frontier`), hence `s` is a `measure_theory.null_measurable_set` (see `convex.null_measurable_set`). -/ open measure_theory measure_theory.measure set metric filter finite_dimensional (finrank) -open_locale topological_space nnreal ennreal +open_locale topology nnreal ennreal -variables {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E] - [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ] {s : set E} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E] + [borel_space E] [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ] {s : set E} namespace convex diff --git a/src/analysis/convex/normed.lean b/src/analysis/convex/normed.lean new file mode 100644 index 0000000000000..91399a8f31073 --- /dev/null +++ b/src/analysis/convex/normed.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2020 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alexander Bentkamp, Yury Kudryashov +-/ +import analysis.convex.jensen +import analysis.convex.topology +import analysis.normed.group.pointwise +import analysis.normed_space.ray + +/-! +# Topological and metric properties of convex sets in normed spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We prove the following facts: + +* `convex_on_norm`, `convex_on_dist` : norm and distance to a fixed point is convex on any convex + set; +* `convex_on_univ_norm`, `convex_on_univ_dist` : norm and distance to a fixed point is convex on + the whole space; +* `convex_hull_ediam`, `convex_hull_diam` : convex hull of a set has the same (e)metric diameter + as the original set; +* `bounded_convex_hull` : convex hull of a set is bounded if and only if the original set + is bounded. +* `bounded_std_simplex`, `is_closed_std_simplex`, `compact_std_simplex`: topological properties + of the standard simplex. +-/ + +variables {ι : Type*} {E : Type*} + +open metric set +open_locale pointwise convex + +variables [seminormed_add_comm_group E] [normed_space ℝ E] {s t : set E} + +/-- The norm on a real normed space is convex on any convex set. See also `seminorm.convex_on` +and `convex_on_univ_norm`. -/ +lemma convex_on_norm (hs : convex ℝ s) : convex_on ℝ s norm := +⟨hs, λ x hx y hy a b ha hb hab, + calc ‖a • x + b • y‖ ≤ ‖a • x‖ + ‖b • y‖ : norm_add_le _ _ + ... = a * ‖x‖ + b * ‖y‖ + : by rw [norm_smul, norm_smul, real.norm_of_nonneg ha, real.norm_of_nonneg hb]⟩ + +/-- The norm on a real normed space is convex on the whole space. See also `seminorm.convex_on` +and `convex_on_norm`. -/ +lemma convex_on_univ_norm : convex_on ℝ univ (norm : E → ℝ) := convex_on_norm convex_univ + +lemma convex_on_dist (z : E) (hs : convex ℝ s) : convex_on ℝ s (λ z', dist z' z) := +by simpa [dist_eq_norm, preimage_preimage] + using (convex_on_norm (hs.translate (-z))).comp_affine_map + (affine_map.id ℝ E - affine_map.const ℝ E z) + +lemma convex_on_univ_dist (z : E) : convex_on ℝ univ (λz', dist z' z) := +convex_on_dist z convex_univ + +lemma convex_ball (a : E) (r : ℝ) : convex ℝ (metric.ball a r) := +by simpa only [metric.ball, sep_univ] using (convex_on_univ_dist a).convex_lt r + +lemma convex_closed_ball (a : E) (r : ℝ) : convex ℝ (metric.closed_ball a r) := +by simpa only [metric.closed_ball, sep_univ] using (convex_on_univ_dist a).convex_le r + +lemma convex.thickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (thickening δ s) := +by { rw ←add_ball_zero, exact hs.add (convex_ball 0 _) } + +lemma convex.cthickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (cthickening δ s) := +begin + obtain hδ | hδ := le_total 0 δ, + { rw cthickening_eq_Inter_thickening hδ, + exact convex_Inter₂ (λ _ _, hs.thickening _) }, + { rw cthickening_of_nonpos hδ, + exact hs.closure } +end + +/-- Given a point `x` in the convex hull of `s` and a point `y`, there exists a point +of `s` at distance at least `dist x y` from `y`. -/ +lemma convex_hull_exists_dist_ge {s : set E} {x : E} (hx : x ∈ convex_hull ℝ s) (y : E) : + ∃ x' ∈ s, dist x y ≤ dist x' y := +(convex_on_dist y (convex_convex_hull ℝ _)).exists_ge_of_mem_convex_hull hx + +/-- Given a point `x` in the convex hull of `s` and a point `y` in the convex hull of `t`, +there exist points `x' ∈ s` and `y' ∈ t` at distance at least `dist x y`. -/ +lemma convex_hull_exists_dist_ge2 {s t : set E} {x y : E} + (hx : x ∈ convex_hull ℝ s) (hy : y ∈ convex_hull ℝ t) : + ∃ (x' ∈ s) (y' ∈ t), dist x y ≤ dist x' y' := +begin + rcases convex_hull_exists_dist_ge hx y with ⟨x', hx', Hx'⟩, + rcases convex_hull_exists_dist_ge hy x' with ⟨y', hy', Hy'⟩, + use [x', hx', y', hy'], + exact le_trans Hx' (dist_comm y x' ▸ dist_comm y' x' ▸ Hy') +end + +/-- Emetric diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/ +@[simp] lemma convex_hull_ediam (s : set E) : + emetric.diam (convex_hull ℝ s) = emetric.diam s := +begin + refine (emetric.diam_le $ λ x hx y hy, _).antisymm (emetric.diam_mono $ subset_convex_hull ℝ s), + rcases convex_hull_exists_dist_ge2 hx hy with ⟨x', hx', y', hy', H⟩, + rw edist_dist, + apply le_trans (ennreal.of_real_le_of_real H), + rw ← edist_dist, + exact emetric.edist_le_diam_of_mem hx' hy' +end + +/-- Diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/ +@[simp] lemma convex_hull_diam (s : set E) : + metric.diam (convex_hull ℝ s) = metric.diam s := +by simp only [metric.diam, convex_hull_ediam] + +/-- Convex hull of `s` is bounded if and only if `s` is bounded. -/ +@[simp] lemma bounded_convex_hull {s : set E} : + metric.bounded (convex_hull ℝ s) ↔ metric.bounded s := +by simp only [metric.bounded_iff_ediam_ne_top, convex_hull_ediam] + +@[priority 100] +instance normed_space.path_connected : path_connected_space E := +topological_add_group.path_connected + +@[priority 100] +instance normed_space.loc_path_connected : loc_path_connected_space E := +loc_path_connected_of_bases (λ x, metric.nhds_basis_ball) + (λ x r r_pos, (convex_ball x r).is_path_connected $ by simp [r_pos]) + +lemma dist_add_dist_of_mem_segment {x y z : E} (h : y ∈ [x -[ℝ] z]) : + dist x y + dist y z = dist x z := +begin + simp only [dist_eq_norm, mem_segment_iff_same_ray] at *, + simpa only [sub_add_sub_cancel', norm_sub_rev] using h.norm_add.symm +end + +/-- The set of vectors in the same ray as `x` is connected. -/ +lemma is_connected_set_of_same_ray (x : E) : is_connected {y | same_ray ℝ x y} := +begin + by_cases hx : x = 0, { simpa [hx] using is_connected_univ }, + simp_rw ←exists_nonneg_left_iff_same_ray hx, + exact is_connected_Ici.image _ ((continuous_id.smul continuous_const).continuous_on) +end + +/-- The set of nonzero vectors in the same ray as the nonzero vector `x` is connected. -/ +lemma is_connected_set_of_same_ray_and_ne_zero {x : E} (hx : x ≠ 0) : + is_connected {y | same_ray ℝ x y ∧ y ≠ 0} := +begin + simp_rw ←exists_pos_left_iff_same_ray_and_ne_zero hx, + exact is_connected_Ioi.image _ ((continuous_id.smul continuous_const).continuous_on) +end diff --git a/src/analysis/convex/partition_of_unity.lean b/src/analysis/convex/partition_of_unity.lean new file mode 100644 index 0000000000000..1518123f88636 --- /dev/null +++ b/src/analysis/convex/partition_of_unity.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import topology.partition_of_unity +import analysis.convex.combination + +/-! +# Partition of unity and convex sets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove the following lemma, see `exists_continuous_forall_mem_convex_of_local`. Let +`X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be a +topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for each +point `x : X`, there exists a neighborhood `U ∈ 𝓝 X` and a function `g : X → E` that is continuous +on `U` and sends each `y ∈ U` to a point of `t y`. Then there exists a continuous map `g : C(X, E)` +such that `g x ∈ t x` for all `x`. + +We also formulate a useful corollary, see `exists_continuous_forall_mem_convex_of_local_const`, that +assumes that local functions `g` are constants. + +## Tags + +partition of unity +-/ + +open set function +open_locale big_operators topology + +variables {ι X E : Type*} [topological_space X] [add_comm_group E] [module ℝ E] + +lemma partition_of_unity.finsum_smul_mem_convex {s : set X} (f : partition_of_unity ι X s) + {g : ι → X → E} {t : set E} {x : X} (hx : x ∈ s) (hg : ∀ i, f i x ≠ 0 → g i x ∈ t) + (ht : convex ℝ t) : + ∑ᶠ i, f i x • g i x ∈ t := +ht.finsum_mem (λ i, f.nonneg _ _) (f.sum_eq_one hx) hg + +variables [normal_space X] [paracompact_space X] [topological_space E] [has_continuous_add E] + [has_continuous_smul ℝ E] {t : X → set E} + +/-- Let `X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be +a topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for +each point `x : X`, there exists a neighborhood `U ∈ 𝓝 X` and a function `g : X → E` that is +continuous on `U` and sends each `y ∈ U` to a point of `t y`. Then there exists a continuous map +`g : C(X, E)` such that `g x ∈ t x` for all `x`. See also +`exists_continuous_forall_mem_convex_of_local_const`. -/ +lemma exists_continuous_forall_mem_convex_of_local (ht : ∀ x, convex ℝ (t x)) + (H : ∀ x : X, ∃ (U ∈ 𝓝 x) (g : X → E), continuous_on g U ∧ ∀ y ∈ U, g y ∈ t y) : ∃ + g : C(X, E), ∀ x, g x ∈ t x := +begin + choose U hU g hgc hgt using H, + obtain ⟨f, hf⟩ := partition_of_unity.exists_is_subordinate is_closed_univ (λ x, interior (U x)) + (λ x, is_open_interior) (λ x hx, mem_Union.2 ⟨x, mem_interior_iff_mem_nhds.2 (hU x)⟩), + refine ⟨⟨λ x, ∑ᶠ i, f i x • g i x, + hf.continuous_finsum_smul (λ i, is_open_interior) $ λ i, (hgc i).mono interior_subset⟩, + λ x, f.finsum_smul_mem_convex (mem_univ x) (λ i hi, hgt _ _ _) (ht _)⟩, + exact interior_subset (hf _ $ subset_closure hi) +end + +/-- Let `X` be a normal paracompact topological space (e.g., any extended metric space). Let `E` be +a topological real vector space. Let `t : X → set E` be a family of convex sets. Suppose that for +each point `x : X`, there exists a vector `c : E` that belongs to `t y` for all `y` in a +neighborhood of `x`. Then there exists a continuous map `g : C(X, E)` such that `g x ∈ t x` for all +`x`. See also `exists_continuous_forall_mem_convex_of_local`. -/ +lemma exists_continuous_forall_mem_convex_of_local_const (ht : ∀ x, convex ℝ (t x)) + (H : ∀ x : X, ∃ c : E, ∀ᶠ y in 𝓝 x, c ∈ t y) : + ∃ g : C(X, E), ∀ x, g x ∈ t x := +exists_continuous_forall_mem_convex_of_local ht $ λ x, + let ⟨c, hc⟩ := H x in ⟨_, hc, λ _, c, continuous_on_const, λ y, id⟩ diff --git a/src/analysis/convex/proj_Icc.lean b/src/analysis/convex/proj_Icc.lean new file mode 100644 index 0000000000000..3115cdffd85d2 --- /dev/null +++ b/src/analysis/convex/proj_Icc.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2023 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import analysis.convex.function +import data.set.intervals.proj_Icc + +/-! +# Convexity of extension from intervals + +This file proves that constantly extending monotone/antitone functions preserves their convexity. + +## TODO + +We could deduplicate the proofs if we had a typeclass stating that `segment 𝕜 x y = [x -[𝕜] y]` as +`𝕜ᵒᵈ` respects it if `𝕜` does, while `𝕜ᵒᵈ` isn't a `linear_ordered_field` if `𝕜` is. +-/ + +open set + +variables {𝕜 β : Type*} [linear_ordered_field 𝕜] [linear_ordered_add_comm_monoid β] [has_smul 𝕜 β] + {s : set 𝕜} {f : 𝕜 → β} {z : 𝕜} + +/-- A convex set extended towards minus infinity is convex. -/ +protected lemma convex.Ici_extend (hf : convex 𝕜 s) : + convex 𝕜 {x | Ici_extend (restrict (Ici z) (∈ s)) x} := +by { rw convex_iff_ord_connected at ⊢ hf, exact hf.restrict.Ici_extend } + +/-- A convex set extended towards infinity is convex. -/ +protected lemma convex.Iic_extend (hf : convex 𝕜 s) : + convex 𝕜 {x | Iic_extend (restrict (Iic z) (∈ s)) x} := +by { rw convex_iff_ord_connected at ⊢ hf, exact hf.restrict.Iic_extend } + +/-- A convex monotone function extended constantly towards minus infinity is convex. -/ +protected lemma convex_on.Ici_extend (hf : convex_on 𝕜 s f) (hf' : monotone_on f s) : + convex_on 𝕜 {x | Ici_extend (restrict (Ici z) (∈ s)) x} (Ici_extend $ restrict (Ici z) f) := +begin + refine ⟨hf.1.Ici_extend, λ x hx y hy a b ha hb hab, _⟩, + dsimp [Ici_extend_apply] at ⊢ hx hy, + refine (hf' (hf.1.ord_connected.uIcc_subset hx hy $ monotone.image_uIcc_subset (λ _ _, max_le_max + le_rfl) $ mem_image_of_mem _ $ convex_uIcc _ _ left_mem_uIcc right_mem_uIcc ha hb hab) + (hf.1 hx hy ha hb hab) _).trans (hf.2 hx hy ha hb hab), + rw [smul_max ha z, smul_max hb z], + refine le_trans _ max_add_add_le_max_add_max, + rw [convex.combo_self hab, smul_eq_mul, smul_eq_mul], +end + +/-- A convex antitone function extended constantly towards infinity is convex. -/ +protected lemma convex_on.Iic_extend (hf : convex_on 𝕜 s f) (hf' : antitone_on f s) : + convex_on 𝕜 {x | Iic_extend (restrict (Iic z) (∈ s)) x} (Iic_extend $ restrict (Iic z) f) := +begin + refine ⟨hf.1.Iic_extend, λ x hx y hy a b ha hb hab, _⟩, + dsimp [Iic_extend_apply] at ⊢ hx hy, + refine (hf' (hf.1 hx hy ha hb hab) (hf.1.ord_connected.uIcc_subset hx hy $ + monotone.image_uIcc_subset (λ _ _, min_le_min le_rfl) $ mem_image_of_mem _ $ + convex_uIcc _ _ left_mem_uIcc right_mem_uIcc ha hb hab) _).trans (hf.2 hx hy ha hb hab), + rw [smul_min ha z, smul_min hb z], + refine min_add_min_le_min_add_add.trans _ , + rw [convex.combo_self hab, smul_eq_mul, smul_eq_mul], +end + +/-- A concave antitone function extended constantly minus towards infinity is concave. -/ +protected lemma concave_on.Ici_extend (hf : concave_on 𝕜 s f) (hf' : antitone_on f s) : + concave_on 𝕜 {x | Ici_extend (restrict (Ici z) (∈ s)) x} (Ici_extend $ restrict (Ici z) f) := +hf.dual.Ici_extend hf'.dual_right + +/-- A concave monotone function extended constantly towards infinity is concave. -/ +protected lemma concave_on.Iic_extend (hf : concave_on 𝕜 s f) (hf' : monotone_on f s) : + concave_on 𝕜 {x | Iic_extend (restrict (Iic z) (∈ s)) x} (Iic_extend $ restrict (Iic z) f) := +hf.dual.Iic_extend hf'.dual_right + +/-- A convex monotone function extended constantly towards minus infinity is convex. -/ +protected lemma convex_on.Ici_extend_of_monotone (hf : convex_on 𝕜 univ f) (hf' : monotone f) : + convex_on 𝕜 univ (Ici_extend $ restrict (Ici z) f) := +hf.Ici_extend $ hf'.monotone_on _ + +/-- A convex antitone function extended constantly towards infinity is convex. -/ +protected lemma convex_on.Iic_extend_of_antitone (hf : convex_on 𝕜 univ f) (hf' : antitone f) : + convex_on 𝕜 univ (Iic_extend $ restrict (Iic z) f) := +hf.Iic_extend $ hf'.antitone_on _ + +/-- A concave antitone function extended constantly minus towards infinity is concave. -/ +protected lemma concave_on.Ici_extend_of_antitone (hf : concave_on 𝕜 univ f) (hf' : antitone f) : + concave_on 𝕜 univ (Ici_extend $ restrict (Ici z) f) := +hf.Ici_extend $ hf'.antitone_on _ + +/-- A concave monotone function extended constantly towards infinity is concave. -/ +protected lemma concave_on.Iic_extend_of_monotone (hf : concave_on 𝕜 univ f) (hf' : monotone f) : + concave_on 𝕜 univ (Iic_extend $ restrict (Iic z) f) := +hf.Iic_extend $ hf'.monotone_on _ diff --git a/src/analysis/convex/quasiconvex.lean b/src/analysis/convex/quasiconvex.lean index a89dceac86ea5..5cdb6f4f8cd7e 100644 --- a/src/analysis/convex/quasiconvex.lean +++ b/src/analysis/convex/quasiconvex.lean @@ -8,6 +8,9 @@ import analysis.convex.function /-! # Quasiconvex and quasiconcave functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines quasiconvexity, quasiconcavity and quasilinearity of functions, which are generalizations of unimodality and monotonicity. Convexity implies quasiconvexity, concavity implies quasiconcavity, and monotonicity implies quasilinearity. @@ -21,11 +24,6 @@ quasiconcavity, and monotonicity implies quasilinearity. * `quasilinear_on 𝕜 s f`: Quasilinearity of the function `f` on the set `s` with scalars `𝕜`. This means that `f` is both quasiconvex and quasiconcave. -## TODO - -Prove that a quasilinear function between two linear orders is either monotone or antitone. This is -not hard but quite a pain to go about as there are many cases to consider. - ## References * https://en.wikipedia.org/wiki/Quasiconvex_function @@ -42,7 +40,7 @@ section add_comm_monoid variables [add_comm_monoid E] [add_comm_monoid F] section ordered_add_comm_monoid -variables (𝕜) [ordered_add_comm_monoid β] [has_scalar 𝕜 E] (s : set E) (f : E → β) +variables (𝕜) [ordered_add_comm_monoid β] [has_smul 𝕜 E] (s : set E) (f : E → β) /-- A function is quasiconvex if all its sublevels are convex. This means that, for all `r`, `{x ∈ s | f x ≤ r}` is `𝕜`-convex. -/ @@ -75,10 +73,10 @@ lemma convex.quasiconcave_on_of_convex_ge (hs : convex 𝕜 s) (h : ∀ r, conve @convex.quasiconvex_on_of_convex_le 𝕜 E βᵒᵈ _ _ _ _ _ _ hs h lemma quasiconvex_on.convex [is_directed β (≤)] (hf : quasiconvex_on 𝕜 s f) : convex 𝕜 s := -λ x y hx hy a b ha hb hab, +λ x hx y hy a b ha hb hab, let ⟨z, hxz, hyz⟩ := exists_ge_ge (f x) (f y) in (hf _ ⟨hx, hxz⟩ ⟨hy, hyz⟩ ha hb hab).1 -lemma quasiconcave_on.convex [is_directed β (swap (≤))] (hf : quasiconcave_on 𝕜 s f) : convex 𝕜 s := +lemma quasiconcave_on.convex [is_directed β (≥)] (hf : quasiconcave_on 𝕜 s f) : convex 𝕜 s := hf.dual.convex end ordered_add_comm_monoid @@ -86,14 +84,14 @@ end ordered_add_comm_monoid section linear_ordered_add_comm_monoid variables [linear_ordered_add_comm_monoid β] -section has_scalar -variables [has_scalar 𝕜 E] {s : set E} {f g : E → β} +section has_smul +variables [has_smul 𝕜 E] {s : set E} {f g : E → β} lemma quasiconvex_on.sup (hf : quasiconvex_on 𝕜 s f) (hg : quasiconvex_on 𝕜 s g) : quasiconvex_on 𝕜 s (f ⊔ g) := begin intro r, - simp_rw [pi.sup_def, sup_le_iff, ←set.sep_inter_sep], + simp_rw [pi.sup_def, sup_le_iff, set.sep_and], exact (hf r).inter (hg r), end @@ -103,33 +101,33 @@ hf.dual.sup hg lemma quasiconvex_on_iff_le_max : quasiconvex_on 𝕜 s f ↔ convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → f (a • x + b • y) ≤ max (f x) (f y) := -⟨λ hf, ⟨hf.convex, λ x y hx hy a b ha hb hab, +⟨λ hf, ⟨hf.convex, λ x hx y hy a b ha hb hab, (hf _ ⟨hx, le_max_left _ _⟩ ⟨hy, le_max_right _ _⟩ ha hb hab).2⟩, - λ hf r x y hx hy a b ha hb hab, + λ hf r x hx y hy a b ha hb hab, ⟨hf.1 hx.1 hy.1 ha hb hab, (hf.2 hx.1 hy.1 ha hb hab).trans $ max_le hx.2 hy.2⟩⟩ lemma quasiconcave_on_iff_min_le : quasiconcave_on 𝕜 s f ↔ convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → min (f x) (f y) ≤ f (a • x + b • y) := @quasiconvex_on_iff_le_max 𝕜 E βᵒᵈ _ _ _ _ _ _ -lemma quasilinear_on_iff_mem_interval : +lemma quasilinear_on_iff_mem_uIcc : quasilinear_on 𝕜 s f ↔ convex 𝕜 s ∧ - ∀ ⦃x y : E⦄, x ∈ s → y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → - f (a • x + b • y) ∈ interval (f x) (f y) := + ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 ≤ a → 0 ≤ b → a + b = 1 → + f (a • x + b • y) ∈ uIcc (f x) (f y) := begin rw [quasilinear_on, quasiconvex_on_iff_le_max, quasiconcave_on_iff_min_le, and_and_and_comm, and_self], apply and_congr_right', - simp_rw [←forall_and_distrib, interval, mem_Icc, and_comm], + simp_rw [←forall_and_distrib, ←Icc_min_max, mem_Icc, and_comm], end lemma quasiconvex_on.convex_lt (hf : quasiconvex_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | f x < r} := begin - refine λ x y hx hy a b ha hb hab, _, + refine λ x hx y hy a b ha hb hab, _, have h := hf _ ⟨hx.1, le_max_left _ _⟩ ⟨hy.1, le_max_right _ _⟩ ha hb hab, exact ⟨h.1, h.2.trans_lt $ max_lt hx.2 hy.2⟩, end @@ -137,10 +135,10 @@ end lemma quasiconcave_on.convex_gt (hf : quasiconcave_on 𝕜 s f) (r : β) : convex 𝕜 {x ∈ s | r < f x} := hf.dual.convex_lt r -end has_scalar +end has_smul section ordered_smul -variables [has_scalar 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} +variables [has_smul 𝕜 E] [module 𝕜 β] [ordered_smul 𝕜 β] {s : set E} {f : E → β} lemma convex_on.quasiconvex_on (hf : convex_on 𝕜 s f) : quasiconvex_on 𝕜 s f := hf.convex_le @@ -196,3 +194,21 @@ lemma antitone.quasilinear_on (hf : antitone f) : quasilinear_on 𝕜 univ f := end linear_ordered_add_comm_monoid end ordered_semiring + +section linear_ordered_field +variables [linear_ordered_field 𝕜] [linear_ordered_add_comm_monoid β] {s : set 𝕜} {f : 𝕜 → β} + +lemma quasilinear_on.monotone_on_or_antitone_on (hf : quasilinear_on 𝕜 s f) : + monotone_on f s ∨ antitone_on f s := +begin + simp_rw [monotone_on_or_antitone_on_iff_uIcc, ←segment_eq_uIcc], + rintro a ha b hb c hc h, + refine ⟨((hf.2 _).segment_subset _ _ h).2, ((hf.1 _).segment_subset _ _ h).2⟩; simp [*], +end + +lemma quasilinear_on_iff_monotone_on_or_antitone_on (hs : convex 𝕜 s) : + quasilinear_on 𝕜 s f ↔ monotone_on f s ∨ antitone_on f s := +⟨λ h, h.monotone_on_or_antitone_on, + λ h, h.elim (λ h, h.quasilinear_on hs) (λ h, h.quasilinear_on hs)⟩ + +end linear_ordered_field diff --git a/src/analysis/convex/segment.lean b/src/analysis/convex/segment.lean new file mode 100644 index 0000000000000..6e0d57aed67d8 --- /dev/null +++ b/src/analysis/convex/segment.lean @@ -0,0 +1,592 @@ +/- +Copyright (c) 2019 Alexander Bentkamp. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Alexander Bentkamp, Yury Kudryashov, Yaël Dillies +-/ +import algebra.order.invertible +import algebra.order.smul +import linear_algebra.affine_space.midpoint +import linear_algebra.ray +import tactic.positivity + +/-! +# Segments in vector spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In a 𝕜-vector space, we define the following objects and properties. +* `segment 𝕜 x y`: Closed segment joining `x` and `y`. +* `open_segment 𝕜 x y`: Open segment joining `x` and `y`. + +## Notations + +We provide the following notation: +* `[x -[𝕜] y] = segment 𝕜 x y` in locale `convex` + +## TODO + +Generalize all this file to affine spaces. + +Should we rename `segment` and `open_segment` to `convex.Icc` and `convex.Ioo`? Should we also +define `clopen_segment`/`convex.Ico`/`convex.Ioc`? +-/ + +variables {𝕜 E F G ι : Type*} {π : ι → Type*} + +open function set +open_locale pointwise + +section ordered_semiring +variables [ordered_semiring 𝕜] [add_comm_monoid E] + +section has_smul +variables (𝕜) [has_smul 𝕜 E] {s : set E} {x y : E} + +/-- Segments in a vector space. -/ +def segment (x y : E) : set E := +{z : E | ∃ (a b : 𝕜) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1), a • x + b • y = z} + +/-- Open segment in a vector space. Note that `open_segment 𝕜 x x = {x}` instead of being `∅` when +the base semiring has some element between `0` and `1`. -/ +def open_segment (x y : E) : set E := +{z : E | ∃ (a b : 𝕜) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1), a • x + b • y = z} + +localized "notation (name := segment) `[` x ` -[` 𝕜 `] ` y `]` := segment 𝕜 x y" in convex + +lemma segment_eq_image₂ (x y : E) : + [x -[𝕜] y] = (λ p : 𝕜 × 𝕜, p.1 • x + p.2 • y) '' {p | 0 ≤ p.1 ∧ 0 ≤ p.2 ∧ p.1 + p.2 = 1} := +by simp only [segment, image, prod.exists, mem_set_of_eq, exists_prop, and_assoc] + +lemma open_segment_eq_image₂ (x y : E) : + open_segment 𝕜 x y = + (λ p : 𝕜 × 𝕜, p.1 • x + p.2 • y) '' {p | 0 < p.1 ∧ 0 < p.2 ∧ p.1 + p.2 = 1} := +by simp only [open_segment, image, prod.exists, mem_set_of_eq, exists_prop, and_assoc] + +lemma segment_symm (x y : E) : [x -[𝕜] y] = [y -[𝕜] x] := +set.ext $ λ z, +⟨λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩, + λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩ + +lemma open_segment_symm (x y : E) : open_segment 𝕜 x y = open_segment 𝕜 y x := +set.ext $ λ z, +⟨λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩, + λ ⟨a, b, ha, hb, hab, H⟩, ⟨b, a, hb, ha, (add_comm _ _).trans hab, (add_comm _ _).trans H⟩⟩ + +lemma open_segment_subset_segment (x y : E) : open_segment 𝕜 x y ⊆ [x -[𝕜] y] := +λ z ⟨a, b, ha, hb, hab, hz⟩, ⟨a, b, ha.le, hb.le, hab, hz⟩ + +lemma segment_subset_iff : + [x -[𝕜] y] ⊆ s ↔ ∀ a b : 𝕜, 0 ≤ a → 0 ≤ b → a + b = 1 → a • x + b • y ∈ s := +⟨λ H a b ha hb hab, H ⟨a, b, ha, hb, hab, rfl⟩, + λ H z ⟨a, b, ha, hb, hab, hz⟩, hz ▸ H a b ha hb hab⟩ + +lemma open_segment_subset_iff : + open_segment 𝕜 x y ⊆ s ↔ ∀ a b : 𝕜, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s := +⟨λ H a b ha hb hab, H ⟨a, b, ha, hb, hab, rfl⟩, + λ H z ⟨a, b, ha, hb, hab, hz⟩, hz ▸ H a b ha hb hab⟩ + +end has_smul + +open_locale convex + +section mul_action_with_zero +variables (𝕜) [mul_action_with_zero 𝕜 E] + +lemma left_mem_segment (x y : E) : x ∈ [x -[𝕜] y] := +⟨1, 0, zero_le_one, le_refl 0, add_zero 1, by rw [zero_smul, one_smul, add_zero]⟩ + +lemma right_mem_segment (x y : E) : y ∈ [x -[𝕜] y] := segment_symm 𝕜 y x ▸ left_mem_segment 𝕜 y x + +end mul_action_with_zero + +section module +variables (𝕜) [module 𝕜 E] {s : set E} {x y z : E} + +@[simp] lemma segment_same (x : E) : [x -[𝕜] x] = {x} := +set.ext $ λ z, ⟨λ ⟨a, b, ha, hb, hab, hz⟩, + by simpa only [(add_smul _ _ _).symm, mem_singleton_iff, hab, one_smul, eq_comm] using hz, + λ h, mem_singleton_iff.1 h ▸ left_mem_segment 𝕜 z z⟩ + +lemma insert_endpoints_open_segment (x y : E) : + insert x (insert y (open_segment 𝕜 x y)) = [x -[𝕜] y] := +begin + simp only [subset_antisymm_iff, insert_subset, left_mem_segment, right_mem_segment, + open_segment_subset_segment, true_and], + rintro z ⟨a, b, ha, hb, hab, rfl⟩, + refine hb.eq_or_gt.imp _ (λ hb', ha.eq_or_gt.imp _ $ λ ha', _), + { rintro rfl, + rw [← add_zero a, hab, one_smul, zero_smul, add_zero] }, + { rintro rfl, + rw [← zero_add b, hab, one_smul, zero_smul, zero_add] }, + { exact ⟨a, b, ha', hb', hab, rfl⟩ } +end + +variables {𝕜} + +lemma mem_open_segment_of_ne_left_right (hx : x ≠ z) (hy : y ≠ z) (hz : z ∈ [x -[𝕜] y]) : + z ∈ open_segment 𝕜 x y := +begin + rw [←insert_endpoints_open_segment] at hz, + exact ((hz.resolve_left hx.symm).resolve_left hy.symm) +end + +lemma open_segment_subset_iff_segment_subset (hx : x ∈ s) (hy : y ∈ s) : + open_segment 𝕜 x y ⊆ s ↔ [x -[𝕜] y] ⊆ s := +by simp only [←insert_endpoints_open_segment, insert_subset, *, true_and] + +end module +end ordered_semiring + +open_locale convex + +section ordered_ring +variables (𝕜) [ordered_ring 𝕜] [add_comm_group E] [add_comm_group F] [add_comm_group G] [module 𝕜 E] + [module 𝕜 F] + +section densely_ordered +variables [nontrivial 𝕜] [densely_ordered 𝕜] + +@[simp] lemma open_segment_same (x : E) : open_segment 𝕜 x x = {x} := +set.ext $ λ z, ⟨λ ⟨a, b, ha, hb, hab, hz⟩, + by simpa only [←add_smul, mem_singleton_iff, hab, one_smul, eq_comm] using hz, + λ (h : z = x), begin + obtain ⟨a, ha₀, ha₁⟩ := densely_ordered.dense (0 : 𝕜) 1 zero_lt_one, + refine ⟨a, 1 - a, ha₀, sub_pos_of_lt ha₁, add_sub_cancel'_right _ _, _⟩, + rw [←add_smul, add_sub_cancel'_right, one_smul, h], + end⟩ + +end densely_ordered + +lemma segment_eq_image (x y : E) : [x -[𝕜] y] = (λ θ : 𝕜, (1 - θ) • x + θ • y) '' Icc (0 : 𝕜) 1 := +set.ext $ λ z, + ⟨λ ⟨a, b, ha, hb, hab, hz⟩, + ⟨b, ⟨hb, hab ▸ le_add_of_nonneg_left ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩, + λ ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩, ⟨1-θ, θ, sub_nonneg.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩ + +lemma open_segment_eq_image (x y : E) : + open_segment 𝕜 x y = (λ (θ : 𝕜), (1 - θ) • x + θ • y) '' Ioo (0 : 𝕜) 1 := +set.ext $ λ z, + ⟨λ ⟨a, b, ha, hb, hab, hz⟩, + ⟨b, ⟨hb, hab ▸ lt_add_of_pos_left _ ha⟩, hab ▸ hz ▸ by simp only [add_sub_cancel]⟩, + λ ⟨θ, ⟨hθ₀, hθ₁⟩, hz⟩, ⟨1 - θ, θ, sub_pos.2 hθ₁, hθ₀, sub_add_cancel _ _, hz⟩⟩ + +lemma segment_eq_image' (x y : E) : [x -[𝕜] y] = (λ (θ : 𝕜), x + θ • (y - x)) '' Icc (0 : 𝕜) 1 := +by { convert segment_eq_image 𝕜 x y, ext θ, simp only [smul_sub, sub_smul, one_smul], abel } + +lemma open_segment_eq_image' (x y : E) : + open_segment 𝕜 x y = (λ (θ : 𝕜), x + θ • (y - x)) '' Ioo (0 : 𝕜) 1 := +by { convert open_segment_eq_image 𝕜 x y, ext θ, simp only [smul_sub, sub_smul, one_smul], abel } + +lemma segment_eq_image_line_map (x y : E) : [x -[𝕜] y] = affine_map.line_map x y '' Icc (0 : 𝕜) 1 := +by { convert segment_eq_image 𝕜 x y, ext, exact affine_map.line_map_apply_module _ _ _ } + +lemma open_segment_eq_image_line_map (x y : E) : + open_segment 𝕜 x y = affine_map.line_map x y '' Ioo (0 : 𝕜) 1 := +by { convert open_segment_eq_image 𝕜 x y, ext, exact affine_map.line_map_apply_module _ _ _ } + +@[simp] lemma image_segment (f : E →ᵃ[𝕜] F) (a b : E) : f '' [a -[𝕜] b] = [f a -[𝕜] f b] := +set.ext $ λ x, by simp_rw [segment_eq_image_line_map, mem_image, exists_exists_and_eq_and, + affine_map.apply_line_map] + +@[simp] lemma image_open_segment (f : E →ᵃ[𝕜] F) (a b : E) : + f '' open_segment 𝕜 a b = open_segment 𝕜 (f a) (f b) := +set.ext $ λ x, by simp_rw [open_segment_eq_image_line_map, mem_image, exists_exists_and_eq_and, + affine_map.apply_line_map] + +@[simp] lemma vadd_segment [add_torsor G E] [vadd_comm_class G E E] (a : G) (b c : E) : + a +ᵥ [b -[𝕜] c] = [a +ᵥ b -[𝕜] a +ᵥ c] := +image_segment 𝕜 ⟨_, linear_map.id, λ _ _, vadd_comm _ _ _⟩ b c + +@[simp] lemma vadd_open_segment [add_torsor G E] [vadd_comm_class G E E] (a : G) (b c : E) : + a +ᵥ open_segment 𝕜 b c = open_segment 𝕜 (a +ᵥ b) (a +ᵥ c) := +image_open_segment 𝕜 ⟨_, linear_map.id, λ _ _, vadd_comm _ _ _⟩ b c + +@[simp] lemma mem_segment_translate (a : E) {x b c} : a + x ∈ [a + b -[𝕜] a + c] ↔ x ∈ [b -[𝕜] c] := +by simp_rw [←vadd_eq_add, ←vadd_segment, vadd_mem_vadd_set_iff] + +@[simp] lemma mem_open_segment_translate (a : E) {x b c : E} : + a + x ∈ open_segment 𝕜 (a + b) (a + c) ↔ x ∈ open_segment 𝕜 b c := +by simp_rw [←vadd_eq_add, ←vadd_open_segment, vadd_mem_vadd_set_iff] + +lemma segment_translate_preimage (a b c : E) : (λ x, a + x) ⁻¹' [a + b -[𝕜] a + c] = [b -[𝕜] c] := +set.ext $ λ x, mem_segment_translate 𝕜 a + +lemma open_segment_translate_preimage (a b c : E) : + (λ x, a + x) ⁻¹' open_segment 𝕜 (a + b) (a + c) = open_segment 𝕜 b c := +set.ext $ λ x, mem_open_segment_translate 𝕜 a + +lemma segment_translate_image (a b c : E) : (λ x, a + x) '' [b -[𝕜] c] = [a + b -[𝕜] a + c] := +segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ $ add_left_surjective a + +lemma open_segment_translate_image (a b c : E) : + (λ x, a + x) '' open_segment 𝕜 b c = open_segment 𝕜 (a + b) (a + c) := +open_segment_translate_preimage 𝕜 a b c ▸ image_preimage_eq _ $ add_left_surjective a + +end ordered_ring + +lemma same_ray_of_mem_segment [strict_ordered_comm_ring 𝕜] [add_comm_group E] [module 𝕜 E] + {x y z : E} (h : x ∈ [y -[𝕜] z]) : same_ray 𝕜 (x - y) (z - x) := +begin + rw segment_eq_image' at h, + rcases h with ⟨θ, ⟨hθ₀, hθ₁⟩, rfl⟩, + simpa only [add_sub_cancel', ←sub_sub, sub_smul, one_smul] + using (same_ray_nonneg_smul_left (z - y) hθ₀).nonneg_smul_right (sub_nonneg.2 hθ₁) +end + +section linear_ordered_ring +variables [linear_ordered_ring 𝕜] [add_comm_group E] [module 𝕜 E] {x y : E} + +lemma midpoint_mem_segment [invertible (2 : 𝕜)] (x y : E) : midpoint 𝕜 x y ∈ [x -[𝕜] y] := +begin + rw segment_eq_image_line_map, + exact ⟨⅟2, ⟨inv_of_nonneg.mpr zero_le_two, inv_of_le_one one_le_two⟩, rfl⟩, +end + +lemma mem_segment_sub_add [invertible (2 : 𝕜)] (x y : E) : x ∈ [x - y -[𝕜] x + y] := +by { convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _, rw midpoint_sub_add } + +lemma mem_segment_add_sub [invertible (2 : 𝕜)] (x y : E) : x ∈ [x + y -[𝕜] x - y] := +by { convert @midpoint_mem_segment 𝕜 _ _ _ _ _ _ _, rw midpoint_add_sub } + +@[simp] lemma left_mem_open_segment_iff [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] : + x ∈ open_segment 𝕜 x y ↔ x = y := +begin + split, + { rintro ⟨a, b, ha, hb, hab, hx⟩, + refine smul_right_injective _ hb.ne' ((add_right_inj (a • x)).1 _), + rw [hx, ←add_smul, hab, one_smul] }, + { rintro rfl, + rw open_segment_same, + exact mem_singleton _ } +end + +@[simp] lemma right_mem_open_segment_iff [densely_ordered 𝕜] [no_zero_smul_divisors 𝕜 E] : + y ∈ open_segment 𝕜 x y ↔ x = y := +by rw [open_segment_symm, left_mem_open_segment_iff, eq_comm] + +end linear_ordered_ring + +section linear_ordered_semifield +variables [linear_ordered_semifield 𝕜] [add_comm_group E] [module 𝕜 E] {x y z : E} + +lemma mem_segment_iff_div : x ∈ [y -[𝕜] z] ↔ + ∃ a b : 𝕜, 0 ≤ a ∧ 0 ≤ b ∧ 0 < a + b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x := +begin + split, + { rintro ⟨a, b, ha, hb, hab, rfl⟩, + use [a, b, ha, hb], + simp * }, + { rintro ⟨a, b, ha, hb, hab, rfl⟩, + refine ⟨a / (a + b), b / (a + b), div_nonneg ha hab.le, div_nonneg hb hab.le, _, rfl⟩, + rw [←add_div, div_self hab.ne'] } +end + +lemma mem_open_segment_iff_div : x ∈ open_segment 𝕜 y z ↔ + ∃ a b : 𝕜, 0 < a ∧ 0 < b ∧ (a / (a + b)) • y + (b / (a + b)) • z = x := +begin + split, + { rintro ⟨a, b, ha, hb, hab, rfl⟩, + use [a, b, ha, hb], + rw [hab, div_one, div_one] }, + { rintro ⟨a, b, ha, hb, rfl⟩, + have hab : 0 < a + b := by positivity, + refine ⟨a / (a + b), b / (a + b), by positivity, by positivity, _, rfl⟩, + rw [←add_div, div_self hab.ne'] } +end + +end linear_ordered_semifield + +section linear_ordered_field +variables [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] {x y z : E} + +lemma mem_segment_iff_same_ray : x ∈ [y -[𝕜] z] ↔ same_ray 𝕜 (x - y) (z - x) := +begin + refine ⟨same_ray_of_mem_segment, λ h, _⟩, + rcases h.exists_eq_smul_add with ⟨a, b, ha, hb, hab, hxy, hzx⟩, + rw [add_comm, sub_add_sub_cancel] at hxy hzx, + rw [←mem_segment_translate _ (-x), neg_add_self], + refine ⟨b, a, hb, ha, add_comm a b ▸ hab, _⟩, + rw [←sub_eq_neg_add, ←neg_sub, hxy, ←sub_eq_neg_add, hzx, smul_neg, smul_comm, neg_add_self] +end + +open affine_map + +/-- If `z = line_map x y c` is a point on the line passing through `x` and `y`, then the open +segment `open_segment 𝕜 x y` is included in the union of the open segments `open_segment 𝕜 x z`, +`open_segment 𝕜 z y`, and the point `z`. Informally, `(x, y) ⊆ {z} ∪ (x, z) ∪ (z, y)`. -/ +lemma open_segment_subset_union (x y : E) {z : E} (hz : z ∈ range (line_map x y : 𝕜 → E)) : + open_segment 𝕜 x y ⊆ insert z (open_segment 𝕜 x z ∪ open_segment 𝕜 z y) := +begin + rcases hz with ⟨c, rfl⟩, + simp only [open_segment_eq_image_line_map, ← maps_to'], + rintro a ⟨h₀, h₁⟩, + rcases lt_trichotomy a c with hac|rfl|hca, + { right, left, + have hc : 0 < c, from h₀.trans hac, + refine ⟨a / c, ⟨div_pos h₀ hc, (div_lt_one hc).2 hac⟩, _⟩, + simp only [← homothety_eq_line_map, ← homothety_mul_apply, div_mul_cancel _ hc.ne'] }, + { left, refl }, + { right, right, + have hc : 0 < 1 - c, from sub_pos.2 (hca.trans h₁), + simp only [← line_map_apply_one_sub y], + refine ⟨(a - c) / (1 - c), ⟨div_pos (sub_pos.2 hca) hc, + (div_lt_one hc).2 $ sub_lt_sub_right h₁ _⟩, _⟩, + simp only [← homothety_eq_line_map, ← homothety_mul_apply, sub_mul, one_mul, + div_mul_cancel _ hc.ne', sub_sub_sub_cancel_right] } +end + +end linear_ordered_field + +/-! +#### Segments in an ordered space + +Relates `segment`, `open_segment` and `set.Icc`, `set.Ico`, `set.Ioc`, `set.Ioo` +-/ +section ordered_semiring +variables [ordered_semiring 𝕜] + +section ordered_add_comm_monoid +variables [ordered_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] {x y : E} + +lemma segment_subset_Icc (h : x ≤ y) : [x -[𝕜] y] ⊆ Icc x y := +begin + rintro z ⟨a, b, ha, hb, hab, rfl⟩, + split, + calc + x = a • x + b • x :(convex.combo_self hab _).symm + ... ≤ a • x + b • y : add_le_add_left (smul_le_smul_of_nonneg h hb) _, + calc + a • x + b • y + ≤ a • y + b • y : add_le_add_right (smul_le_smul_of_nonneg h ha) _ + ... = y : convex.combo_self hab _, +end + +end ordered_add_comm_monoid + +section ordered_cancel_add_comm_monoid +variables [ordered_cancel_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] {x y : E} + +lemma open_segment_subset_Ioo (h : x < y) : open_segment 𝕜 x y ⊆ Ioo x y := +begin + rintro z ⟨a, b, ha, hb, hab, rfl⟩, + split, + calc + x = a • x + b • x : (convex.combo_self hab _).symm + ... < a • x + b • y : add_lt_add_left (smul_lt_smul_of_pos h hb) _, + calc + a • x + b • y + < a • y + b • y : add_lt_add_right (smul_lt_smul_of_pos h ha) _ + ... = y : convex.combo_self hab _, +end + +end ordered_cancel_add_comm_monoid + +section linear_ordered_add_comm_monoid +variables [linear_ordered_add_comm_monoid E] [module 𝕜 E] [ordered_smul 𝕜 E] {𝕜} {a b : 𝕜} + +lemma segment_subset_uIcc (x y : E) : [x -[𝕜] y] ⊆ uIcc x y := +begin + cases le_total x y, + { rw uIcc_of_le h, + exact segment_subset_Icc h }, + { rw [uIcc_of_ge h, segment_symm], + exact segment_subset_Icc h } +end + +lemma convex.min_le_combo (x y : E) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) : + min x y ≤ a • x + b • y := +(segment_subset_uIcc x y ⟨_, _, ha, hb, hab, rfl⟩).1 + +lemma convex.combo_le_max (x y : E) (ha : 0 ≤ a) (hb : 0 ≤ b) (hab : a + b = 1) : + a • x + b • y ≤ max x y := +(segment_subset_uIcc x y ⟨_, _, ha, hb, hab, rfl⟩).2 + +end linear_ordered_add_comm_monoid +end ordered_semiring + +section linear_ordered_field +variables [linear_ordered_field 𝕜] {x y z : 𝕜} + +lemma Icc_subset_segment : Icc x y ⊆ [x -[𝕜] y] := +begin + rintro z ⟨hxz, hyz⟩, + obtain rfl | h := (hxz.trans hyz).eq_or_lt, + { rw segment_same, + exact hyz.antisymm hxz }, + rw ←sub_nonneg at hxz hyz, + rw ←sub_pos at h, + refine ⟨(y - z) / (y - x), (z - x) / (y - x), div_nonneg hyz h.le, div_nonneg hxz h.le, _, _⟩, + { rw [←add_div, sub_add_sub_cancel, div_self h.ne'] }, + { rw [smul_eq_mul, smul_eq_mul, ←mul_div_right_comm, ←mul_div_right_comm, ←add_div, + div_eq_iff h.ne', add_comm, sub_mul, sub_mul, mul_comm x, sub_add_sub_cancel, mul_sub] } +end + +@[simp] lemma segment_eq_Icc (h : x ≤ y) : [x -[𝕜] y] = Icc x y := +(segment_subset_Icc h).antisymm Icc_subset_segment + +lemma Ioo_subset_open_segment : Ioo x y ⊆ open_segment 𝕜 x y := +λ z hz, mem_open_segment_of_ne_left_right hz.1.ne hz.2.ne' $ Icc_subset_segment $ + Ioo_subset_Icc_self hz + +@[simp] lemma open_segment_eq_Ioo (h : x < y) : open_segment 𝕜 x y = Ioo x y := +(open_segment_subset_Ioo h).antisymm Ioo_subset_open_segment + +lemma segment_eq_Icc' (x y : 𝕜) : [x -[𝕜] y] = Icc (min x y) (max x y) := +begin + cases le_total x y, + { rw [segment_eq_Icc h, max_eq_right h, min_eq_left h] }, + { rw [segment_symm, segment_eq_Icc h, max_eq_left h, min_eq_right h] } +end + +lemma open_segment_eq_Ioo' (hxy : x ≠ y) : open_segment 𝕜 x y = Ioo (min x y) (max x y) := +begin + cases hxy.lt_or_lt, + { rw [open_segment_eq_Ioo h, max_eq_right h.le, min_eq_left h.le] }, + { rw [open_segment_symm, open_segment_eq_Ioo h, max_eq_left h.le, min_eq_right h.le] } +end + +lemma segment_eq_uIcc (x y : 𝕜) : [x -[𝕜] y] = uIcc x y := segment_eq_Icc' _ _ + +/-- A point is in an `Icc` iff it can be expressed as a convex combination of the endpoints. -/ +lemma convex.mem_Icc (h : x ≤ y) : + z ∈ Icc x y ↔ ∃ a b, 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z := +by { rw ←segment_eq_Icc h, simp_rw [←exists_prop], refl } + +/-- A point is in an `Ioo` iff it can be expressed as a strict convex combination of the endpoints. +-/ +lemma convex.mem_Ioo (h : x < y) : + z ∈ Ioo x y ↔ ∃ a b, 0 < a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z := +by { rw ←open_segment_eq_Ioo h, simp_rw [←exists_prop], refl } + +/-- A point is in an `Ioc` iff it can be expressed as a semistrict convex combination of the +endpoints. -/ +lemma convex.mem_Ioc (h : x < y) : + z ∈ Ioc x y ↔ ∃ a b, 0 ≤ a ∧ 0 < b ∧ a + b = 1 ∧ a * x + b * y = z := +begin + refine ⟨λ hz, _, _⟩, + { obtain ⟨a, b, ha, hb, hab, rfl⟩ := (convex.mem_Icc h.le).1 (Ioc_subset_Icc_self hz), + obtain rfl | hb' := hb.eq_or_lt, + { rw add_zero at hab, + rw [hab, one_mul, zero_mul, add_zero] at hz, + exact (hz.1.ne rfl).elim }, + { exact ⟨a, b, ha, hb', hab, rfl⟩ } }, + { rintro ⟨a, b, ha, hb, hab, rfl⟩, + obtain rfl | ha' := ha.eq_or_lt, + { rw zero_add at hab, + rwa [hab, one_mul, zero_mul, zero_add, right_mem_Ioc] }, + { exact Ioo_subset_Ioc_self ((convex.mem_Ioo h).2 ⟨a, b, ha', hb, hab, rfl⟩) } } +end + +/-- A point is in an `Ico` iff it can be expressed as a semistrict convex combination of the +endpoints. -/ +lemma convex.mem_Ico (h : x < y) : + z ∈ Ico x y ↔ ∃ a b, 0 < a ∧ 0 ≤ b ∧ a + b = 1 ∧ a * x + b * y = z := +begin + refine ⟨λ hz, _, _⟩, + { obtain ⟨a, b, ha, hb, hab, rfl⟩ := (convex.mem_Icc h.le).1 (Ico_subset_Icc_self hz), + obtain rfl | ha' := ha.eq_or_lt, + { rw zero_add at hab, + rw [hab, one_mul, zero_mul, zero_add] at hz, + exact (hz.2.ne rfl).elim }, + { exact ⟨a, b, ha', hb, hab, rfl⟩ } }, + { rintro ⟨a, b, ha, hb, hab, rfl⟩, + obtain rfl | hb' := hb.eq_or_lt, + { rw add_zero at hab, + rwa [hab, one_mul, zero_mul, add_zero, left_mem_Ico] }, + { exact Ioo_subset_Ico_self ((convex.mem_Ioo h).2 ⟨a, b, ha, hb', hab, rfl⟩) } } +end + +end linear_ordered_field + +namespace prod +variables [ordered_semiring 𝕜] [add_comm_monoid E] [add_comm_monoid F] [module 𝕜 E] [module 𝕜 F] + +lemma segment_subset (x y : E × F) : segment 𝕜 x y ⊆ segment 𝕜 x.1 y.1 ×ˢ segment 𝕜 x.2 y.2 := +begin + rintro z ⟨a, b, ha, hb, hab, hz⟩, + exact ⟨⟨a, b, ha, hb, hab, congr_arg prod.fst hz⟩, a, b, ha, hb, hab, congr_arg prod.snd hz⟩, +end + +lemma open_segment_subset (x y : E × F) : + open_segment 𝕜 x y ⊆ open_segment 𝕜 x.1 y.1 ×ˢ open_segment 𝕜 x.2 y.2 := +begin + rintro z ⟨a, b, ha, hb, hab, hz⟩, + exact ⟨⟨a, b, ha, hb, hab, congr_arg prod.fst hz⟩, a, b, ha, hb, hab, congr_arg prod.snd hz⟩, +end + +lemma image_mk_segment_left (x₁ x₂ : E) (y : F) : + (λ x, (x, y)) '' [x₁ -[𝕜] x₂] = [(x₁, y) -[𝕜] (x₂, y)] := +begin + ext ⟨x', y'⟩, + simp_rw [set.mem_image, segment, set.mem_set_of, prod.smul_mk, prod.mk_add_mk, + prod.mk.inj_iff, ←exists_and_distrib_right, @exists_comm E, exists_eq_left'], + refine exists₅_congr (λ a b ha hb hab, _), + rw convex.combo_self hab, +end + +lemma image_mk_segment_right (x : E) (y₁ y₂ : F) : + (λ y, (x, y)) '' [y₁ -[𝕜] y₂] = [(x, y₁) -[𝕜] (x, y₂)] := +begin + ext ⟨x', y'⟩, + simp_rw [set.mem_image, segment, set.mem_set_of, prod.smul_mk, prod.mk_add_mk, + prod.mk.inj_iff, ←exists_and_distrib_right, @exists_comm F, exists_eq_left'], + refine exists₅_congr (λ a b ha hb hab, _), + rw convex.combo_self hab, +end + +lemma image_mk_open_segment_left (x₁ x₂ : E) (y : F) : + (λ x, (x, y)) '' open_segment 𝕜 x₁ x₂ = open_segment 𝕜 (x₁, y) (x₂, y) := +begin + ext ⟨x', y'⟩, + simp_rw [set.mem_image, open_segment, set.mem_set_of, prod.smul_mk, prod.mk_add_mk, + prod.mk.inj_iff, ←exists_and_distrib_right, @exists_comm E, exists_eq_left'], + refine exists₅_congr (λ a b ha hb hab, _), + rw convex.combo_self hab, +end + +@[simp] lemma image_mk_open_segment_right (x : E) (y₁ y₂ : F) : + (λ y, (x, y)) '' open_segment 𝕜 y₁ y₂ = open_segment 𝕜 (x, y₁) (x, y₂) := +begin + ext ⟨x', y'⟩, + simp_rw [set.mem_image, open_segment, set.mem_set_of, prod.smul_mk, prod.mk_add_mk, + prod.mk.inj_iff, ←exists_and_distrib_right, @exists_comm F, exists_eq_left'], + refine exists₅_congr (λ a b ha hb hab, _), + rw convex.combo_self hab, +end + +end prod + +namespace pi +variables [ordered_semiring 𝕜] [Π i, add_comm_monoid (π i)] [Π i, module 𝕜 (π i)] {s : set ι} + +lemma segment_subset (x y : Π i, π i) : segment 𝕜 x y ⊆ s.pi (λ i, segment 𝕜 (x i) (y i)) := +by { rintro z ⟨a, b, ha, hb, hab, hz⟩ i -, exact ⟨a, b, ha, hb, hab, congr_fun hz i⟩ } + +lemma open_segment_subset (x y : Π i, π i) : + open_segment 𝕜 x y ⊆ s.pi (λ i, open_segment 𝕜 (x i) (y i)) := +by { rintro z ⟨a, b, ha, hb, hab, hz⟩ i -, exact ⟨a, b, ha, hb, hab, congr_fun hz i⟩ } + +variables [decidable_eq ι] + +lemma image_update_segment (i : ι) (x₁ x₂ : π i) (y : Π i, π i) : + update y i '' [x₁ -[𝕜] x₂] = [update y i x₁ -[𝕜] update y i x₂] := +begin + ext z, + simp_rw [set.mem_image, segment, set.mem_set_of, ←update_smul, ←update_add, update_eq_iff, + ←exists_and_distrib_right, @exists_comm (π i), exists_eq_left'], + refine exists₅_congr (λ a b ha hb hab, _), + rw convex.combo_self hab, +end + +lemma image_update_open_segment (i : ι) (x₁ x₂ : π i) (y : Π i, π i) : + update y i '' open_segment 𝕜 x₁ x₂ = open_segment 𝕜 (update y i x₁) (update y i x₂) := +begin + ext z, + simp_rw [set.mem_image, open_segment, set.mem_set_of, ←update_smul, ←update_add, update_eq_iff, + ←exists_and_distrib_right, @exists_comm (π i), exists_eq_left'], + refine exists₅_congr (λ a b ha hb hab, _), + rw convex.combo_self hab, +end + +end pi diff --git a/src/analysis/convex/side.lean b/src/analysis/convex/side.lean new file mode 100644 index 0000000000000..b4f12bc9539d7 --- /dev/null +++ b/src/analysis/convex/side.lean @@ -0,0 +1,932 @@ +/- +Copyright (c) 2022 Joseph Myers. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Myers +-/ +import analysis.convex.between +import analysis.convex.normed +import analysis.normed.group.add_torsor + +/-! +# Sides of affine subspaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines notions of two points being on the same or opposite sides of an affine subspace. + +## Main definitions + +* `s.w_same_side x y`: The points `x` and `y` are weakly on the same side of the affine + subspace `s`. +* `s.s_same_side x y`: The points `x` and `y` are strictly on the same side of the affine + subspace `s`. +* `s.w_opp_side x y`: The points `x` and `y` are weakly on opposite sides of the affine + subspace `s`. +* `s.s_opp_side x y`: The points `x` and `y` are strictly on opposite sides of the affine + subspace `s`. + +-/ + +variables {R V V' P P' : Type*} + +open affine_equiv affine_map + +namespace affine_subspace + +section strict_ordered_comm_ring + +variables [strict_ordered_comm_ring R] [add_comm_group V] [module R V] [add_torsor V P] +variables [add_comm_group V'] [module R V'] [add_torsor V' P'] + +include V + +/-- The points `x` and `y` are weakly on the same side of `s`. -/ +def w_same_side (s : affine_subspace R P) (x y : P) : Prop := +∃ p₁ p₂ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) + +/-- The points `x` and `y` are strictly on the same side of `s`. -/ +def s_same_side (s : affine_subspace R P) (x y : P) : Prop := +s.w_same_side x y ∧ x ∉ s ∧ y ∉ s + +/-- The points `x` and `y` are weakly on opposite sides of `s`. -/ +def w_opp_side (s : affine_subspace R P) (x y : P) : Prop := +∃ p₁ p₂ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) + +/-- The points `x` and `y` are strictly on opposite sides of `s`. -/ +def s_opp_side (s : affine_subspace R P) (x y : P) : Prop := +s.w_opp_side x y ∧ x ∉ s ∧ y ∉ s + +include V' + +lemma w_same_side.map {s : affine_subspace R P} {x y : P} (h : s.w_same_side x y) + (f : P →ᵃ[R] P') : (s.map f).w_same_side (f x) (f y) := +begin + rcases h with ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨f p₁, mem_map_of_mem f hp₁, f p₂, mem_map_of_mem f hp₂, _⟩, + simp_rw [←linear_map_vsub], + exact h.map f.linear +end + +lemma _root_.function.injective.w_same_side_map_iff {s : affine_subspace R P} {x y : P} + {f : P →ᵃ[R] P'} (hf : function.injective f) : + (s.map f).w_same_side (f x) (f y) ↔ s.w_same_side x y := +begin + refine ⟨λ h, _, λ h, h.map _⟩, + rcases h with ⟨fp₁, hfp₁, fp₂, hfp₂, h⟩, + rw mem_map at hfp₁ hfp₂, + rcases hfp₁ with ⟨p₁, hp₁, rfl⟩, + rcases hfp₂ with ⟨p₂, hp₂, rfl⟩, + refine ⟨p₁, hp₁, p₂, hp₂, _⟩, + simp_rw [←linear_map_vsub, (f.linear_injective_iff.2 hf).same_ray_map_iff] at h, + exact h +end + +lemma _root_.function.injective.s_same_side_map_iff {s : affine_subspace R P} {x y : P} + {f : P →ᵃ[R] P'} (hf : function.injective f) : + (s.map f).s_same_side (f x) (f y) ↔ s.s_same_side x y := +by simp_rw [s_same_side, hf.w_same_side_map_iff, mem_map_iff_mem_of_injective hf] + +@[simp] lemma _root_.affine_equiv.w_same_side_map_iff {s : affine_subspace R P} {x y : P} + (f : P ≃ᵃ[R] P') : (s.map ↑f).w_same_side (f x) (f y) ↔ s.w_same_side x y := +(show function.injective f.to_affine_map, from f.injective).w_same_side_map_iff + +@[simp] lemma _root_.affine_equiv.s_same_side_map_iff {s : affine_subspace R P} {x y : P} + (f : P ≃ᵃ[R] P') : (s.map ↑f).s_same_side (f x) (f y) ↔ s.s_same_side x y := +(show function.injective f.to_affine_map, from f.injective).s_same_side_map_iff + +lemma w_opp_side.map {s : affine_subspace R P} {x y : P} (h : s.w_opp_side x y) + (f : P →ᵃ[R] P') : (s.map f).w_opp_side (f x) (f y) := +begin + rcases h with ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨f p₁, mem_map_of_mem f hp₁, f p₂, mem_map_of_mem f hp₂, _⟩, + simp_rw [←linear_map_vsub], + exact h.map f.linear +end + +lemma _root_.function.injective.w_opp_side_map_iff {s : affine_subspace R P} {x y : P} + {f : P →ᵃ[R] P'} (hf : function.injective f) : + (s.map f).w_opp_side (f x) (f y) ↔ s.w_opp_side x y := +begin + refine ⟨λ h, _, λ h, h.map _⟩, + rcases h with ⟨fp₁, hfp₁, fp₂, hfp₂, h⟩, + rw mem_map at hfp₁ hfp₂, + rcases hfp₁ with ⟨p₁, hp₁, rfl⟩, + rcases hfp₂ with ⟨p₂, hp₂, rfl⟩, + refine ⟨p₁, hp₁, p₂, hp₂, _⟩, + simp_rw [←linear_map_vsub, (f.linear_injective_iff.2 hf).same_ray_map_iff] at h, + exact h +end + +lemma _root_.function.injective.s_opp_side_map_iff {s : affine_subspace R P} {x y : P} + {f : P →ᵃ[R] P'} (hf : function.injective f) : + (s.map f).s_opp_side (f x) (f y) ↔ s.s_opp_side x y := +by simp_rw [s_opp_side, hf.w_opp_side_map_iff, mem_map_iff_mem_of_injective hf] + +@[simp] lemma _root_.affine_equiv.w_opp_side_map_iff {s : affine_subspace R P} {x y : P} + (f : P ≃ᵃ[R] P') : (s.map ↑f).w_opp_side (f x) (f y) ↔ s.w_opp_side x y := +(show function.injective f.to_affine_map, from f.injective).w_opp_side_map_iff + +@[simp] lemma _root_.affine_equiv.s_opp_side_map_iff {s : affine_subspace R P} {x y : P} + (f : P ≃ᵃ[R] P') : (s.map ↑f).s_opp_side (f x) (f y) ↔ s.s_opp_side x y := +(show function.injective f.to_affine_map, from f.injective).s_opp_side_map_iff + +omit V' + +lemma w_same_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.w_same_side x y) : + (s : set P).nonempty := +⟨h.some, h.some_spec.some⟩ + +lemma s_same_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) : + (s : set P).nonempty := +⟨h.1.some, h.1.some_spec.some⟩ + +lemma w_opp_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.w_opp_side x y) : + (s : set P).nonempty := +⟨h.some, h.some_spec.some⟩ + +lemma s_opp_side.nonempty {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + (s : set P).nonempty := +⟨h.1.some, h.1.some_spec.some⟩ + +lemma s_same_side.w_same_side {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) : + s.w_same_side x y := +h.1 + +lemma s_same_side.left_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) : + x ∉ s := +h.2.1 + +lemma s_same_side.right_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) : + y ∉ s := +h.2.2 + +lemma s_opp_side.w_opp_side {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + s.w_opp_side x y := +h.1 + +lemma s_opp_side.left_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + x ∉ s := +h.2.1 + +lemma s_opp_side.right_not_mem {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + y ∉ s := +h.2.2 + +lemma w_same_side_comm {s : affine_subspace R P} {x y : P} : + s.w_same_side x y ↔ s.w_same_side y x := +⟨λ ⟨p₁, hp₁, p₂, hp₂, h⟩, ⟨p₂, hp₂, p₁, hp₁, h.symm⟩, + λ ⟨p₁, hp₁, p₂, hp₂, h⟩, ⟨p₂, hp₂, p₁, hp₁, h.symm⟩⟩ + +alias w_same_side_comm ↔ w_same_side.symm _ + +lemma s_same_side_comm {s : affine_subspace R P} {x y : P} : + s.s_same_side x y ↔ s.s_same_side y x := +by rw [s_same_side, s_same_side, w_same_side_comm, and_comm (x ∉ s)] + +alias s_same_side_comm ↔ s_same_side.symm _ + +lemma w_opp_side_comm {s : affine_subspace R P} {x y : P} : + s.w_opp_side x y ↔ s.w_opp_side y x := +begin + split, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨p₂, hp₂, p₁, hp₁, _⟩, + rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] }, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨p₂, hp₂, p₁, hp₁, _⟩, + rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] } +end + +alias w_opp_side_comm ↔ w_opp_side.symm _ + +lemma s_opp_side_comm {s : affine_subspace R P} {x y : P} : + s.s_opp_side x y ↔ s.s_opp_side y x := +by rw [s_opp_side, s_opp_side, w_opp_side_comm, and_comm (x ∉ s)] + +alias s_opp_side_comm ↔ s_opp_side.symm _ + +lemma not_w_same_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).w_same_side x y := +by simp [w_same_side, not_mem_bot] + +lemma not_s_same_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).s_same_side x y := +λ h, not_w_same_side_bot x y h.w_same_side + +lemma not_w_opp_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).w_opp_side x y := +by simp [w_opp_side, not_mem_bot] + +lemma not_s_opp_side_bot (x y : P) : ¬ (⊥ : affine_subspace R P).s_opp_side x y := +λ h, not_w_opp_side_bot x y h.w_opp_side + +@[simp] lemma w_same_side_self_iff {s : affine_subspace R P} {x : P} : + s.w_same_side x x ↔ (s : set P).nonempty := +⟨λ h, h.nonempty, λ ⟨p, hp⟩, ⟨p, hp, p, hp, same_ray.rfl⟩⟩ + +lemma s_same_side_self_iff {s : affine_subspace R P} {x : P} : + s.s_same_side x x ↔ (s : set P).nonempty ∧ x ∉ s := +⟨λ ⟨h, hx, _⟩, ⟨w_same_side_self_iff.1 h, hx⟩, λ ⟨h, hx⟩, ⟨w_same_side_self_iff.2 h, hx, hx⟩⟩ + +lemma w_same_side_of_left_mem {s : affine_subspace R P} {x : P} (y : P) (hx : x ∈ s) : + s.w_same_side x y := +begin + refine ⟨x, hx, x, hx, _⟩, + simp +end + +lemma w_same_side_of_right_mem {s : affine_subspace R P} (x : P) {y : P} (hy : y ∈ s) : + s.w_same_side x y := +(w_same_side_of_left_mem x hy).symm + +lemma w_opp_side_of_left_mem {s : affine_subspace R P} {x : P} (y : P) (hx : x ∈ s) : + s.w_opp_side x y := +begin + refine ⟨x, hx, x, hx, _⟩, + simp +end + +lemma w_opp_side_of_right_mem {s : affine_subspace R P} (x : P) {y : P} (hy : y ∈ s) : + s.w_opp_side x y := +(w_opp_side_of_left_mem x hy).symm + +lemma w_same_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.w_same_side (v +ᵥ x) y ↔ s.w_same_side x y := +begin + split, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨-v +ᵥ p₁, + affine_subspace.vadd_mem_of_mem_direction (submodule.neg_mem _ hv) hp₁, p₂, hp₂, _⟩, + rwa [vsub_vadd_eq_vsub_sub, sub_neg_eq_add, add_comm, ←vadd_vsub_assoc] }, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨v +ᵥ p₁, + affine_subspace.vadd_mem_of_mem_direction hv hp₁, p₂, hp₂, _⟩, + rwa vadd_vsub_vadd_cancel_left } +end + +lemma w_same_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.w_same_side x (v +ᵥ y) ↔ s.w_same_side x y := +by rw [w_same_side_comm, w_same_side_vadd_left_iff hv, w_same_side_comm] + +lemma s_same_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.s_same_side (v +ᵥ x) y ↔ s.s_same_side x y := +by rw [s_same_side, s_same_side, w_same_side_vadd_left_iff hv, + vadd_mem_iff_mem_of_mem_direction hv] + +lemma s_same_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.s_same_side x (v +ᵥ y) ↔ s.s_same_side x y := +by rw [s_same_side_comm, s_same_side_vadd_left_iff hv, s_same_side_comm] + +lemma w_opp_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.w_opp_side (v +ᵥ x) y ↔ s.w_opp_side x y := +begin + split, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨-v +ᵥ p₁, + affine_subspace.vadd_mem_of_mem_direction (submodule.neg_mem _ hv) hp₁, p₂, hp₂, _⟩, + rwa [vsub_vadd_eq_vsub_sub, sub_neg_eq_add, add_comm, ←vadd_vsub_assoc] }, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + refine ⟨v +ᵥ p₁, + affine_subspace.vadd_mem_of_mem_direction hv hp₁, p₂, hp₂, _⟩, + rwa vadd_vsub_vadd_cancel_left } +end + +lemma w_opp_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.w_opp_side x (v +ᵥ y) ↔ s.w_opp_side x y := +by rw [w_opp_side_comm, w_opp_side_vadd_left_iff hv, w_opp_side_comm] + +lemma s_opp_side_vadd_left_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.s_opp_side (v +ᵥ x) y ↔ s.s_opp_side x y := +by rw [s_opp_side, s_opp_side, w_opp_side_vadd_left_iff hv, + vadd_mem_iff_mem_of_mem_direction hv] + +lemma s_opp_side_vadd_right_iff {s : affine_subspace R P} {x y : P} {v : V} + (hv : v ∈ s.direction) : s.s_opp_side x (v +ᵥ y) ↔ s.s_opp_side x y := +by rw [s_opp_side_comm, s_opp_side_vadd_left_iff hv, s_opp_side_comm] + +lemma w_same_side_smul_vsub_vadd_left {s : affine_subspace R P} {p₁ p₂ : P} (x : P) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 ≤ t) : s.w_same_side (t • (x -ᵥ p₁) +ᵥ p₂) x := +begin + refine ⟨p₂, hp₂, p₁, hp₁, _⟩, + rw vadd_vsub, + exact same_ray_nonneg_smul_left _ ht +end + +lemma w_same_side_smul_vsub_vadd_right {s : affine_subspace R P} {p₁ p₂ : P} (x : P) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 ≤ t) : s.w_same_side x (t • (x -ᵥ p₁) +ᵥ p₂) := +(w_same_side_smul_vsub_vadd_left x hp₁ hp₂ ht).symm + +lemma w_same_side_line_map_left {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R} + (ht : 0 ≤ t) : s.w_same_side (line_map x y t) y := +w_same_side_smul_vsub_vadd_left y h h ht + +lemma w_same_side_line_map_right {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R} + (ht : 0 ≤ t) : s.w_same_side y (line_map x y t) := +(w_same_side_line_map_left y h ht).symm + +lemma w_opp_side_smul_vsub_vadd_left {s : affine_subspace R P} {p₁ p₂ : P} (x : P) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t ≤ 0) : s.w_opp_side (t • (x -ᵥ p₁) +ᵥ p₂) x := +begin + refine ⟨p₂, hp₂, p₁, hp₁, _⟩, + rw [vadd_vsub, ←neg_neg t, neg_smul, ←smul_neg, neg_vsub_eq_vsub_rev], + exact same_ray_nonneg_smul_left _ (neg_nonneg.2 ht) +end + +lemma w_opp_side_smul_vsub_vadd_right {s : affine_subspace R P} {p₁ p₂ : P} (x : P) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t ≤ 0) : s.w_opp_side x (t • (x -ᵥ p₁) +ᵥ p₂) := +(w_opp_side_smul_vsub_vadd_left x hp₁ hp₂ ht).symm + +lemma w_opp_side_line_map_left {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R} + (ht : t ≤ 0) : s.w_opp_side (line_map x y t) y := +w_opp_side_smul_vsub_vadd_left y h h ht + +lemma w_opp_side_line_map_right {s : affine_subspace R P} {x : P} (y : P) (h : x ∈ s) {t : R} + (ht : t ≤ 0) : s.w_opp_side y (line_map x y t) := +(w_opp_side_line_map_left y h ht).symm + +lemma _root_.wbtw.w_same_side₂₃ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z) + (hx : x ∈ s) : s.w_same_side y z := +begin + rcases h with ⟨t, ⟨ht0, -⟩, rfl⟩, + exact w_same_side_line_map_left z hx ht0 +end + +lemma _root_.wbtw.w_same_side₃₂ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z) + (hx : x ∈ s) : s.w_same_side z y := +(h.w_same_side₂₃ hx).symm + +lemma _root_.wbtw.w_same_side₁₂ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z) + (hz : z ∈ s) : s.w_same_side x y := +h.symm.w_same_side₃₂ hz + +lemma _root_.wbtw.w_same_side₂₁ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z) + (hz : z ∈ s) : s.w_same_side y x := +h.symm.w_same_side₂₃ hz + +lemma _root_.wbtw.w_opp_side₁₃ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z) + (hy : y ∈ s) : s.w_opp_side x z := +begin + rcases h with ⟨t, ⟨ht0, ht1⟩, rfl⟩, + refine ⟨_, hy, _, hy, _⟩, + rcases ht1.lt_or_eq with ht1' | rfl, swap, { simp }, + rcases ht0.lt_or_eq with ht0' | rfl, swap, { simp }, + refine or.inr (or.inr ⟨1 - t, t, sub_pos.2 ht1', ht0', _⟩), + simp_rw [line_map_apply, vadd_vsub_assoc, vsub_vadd_eq_vsub_sub, ←neg_vsub_eq_vsub_rev z x, + vsub_self, zero_sub, ←neg_one_smul R (z -ᵥ x), ←add_smul, smul_neg, ←neg_smul, + smul_smul], + ring_nf +end + +lemma _root_.wbtw.w_opp_side₃₁ {s : affine_subspace R P} {x y z : P} (h : wbtw R x y z) + (hy : y ∈ s) : s.w_opp_side z x := +h.symm.w_opp_side₁₃ hy + +end strict_ordered_comm_ring + +section linear_ordered_field + +variables [linear_ordered_field R] [add_comm_group V] [module R V] [add_torsor V P] +variables [add_comm_group V'] [module R V'] [add_torsor V' P'] + +include V + +variables {R} + +@[simp] lemma w_opp_side_self_iff {s : affine_subspace R P} {x : P} : s.w_opp_side x x ↔ x ∈ s := +begin + split, + { rintro ⟨p₁, hp₁, p₂, hp₂, h⟩, + obtain ⟨a, -, -, -, -, h₁, -⟩ := h.exists_eq_smul_add, + rw [add_comm, vsub_add_vsub_cancel, ←eq_vadd_iff_vsub_eq] at h₁, + rw h₁, + exact s.smul_vsub_vadd_mem a hp₂ hp₁ hp₁ }, + { exact λ h, ⟨x, h, x, h, same_ray.rfl⟩ } +end + +lemma not_s_opp_side_self (s : affine_subspace R P) (x : P) : ¬s.s_opp_side x x := +by simp [s_opp_side] + +lemma w_same_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) : + s.w_same_side x y ↔ x ∈ s ∨ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) := +begin + split, + { rintro ⟨p₁', hp₁', p₂', hp₂', h0 | h0 | ⟨r₁, r₂, hr₁, hr₂, hr⟩⟩, + { rw vsub_eq_zero_iff_eq at h0, + rw h0, + exact or.inl hp₁' }, + { refine or.inr ⟨p₂', hp₂', _⟩, + rw h0, + exact same_ray.zero_right _ }, + { refine or.inr ⟨(r₁ / r₂) • (p₁ -ᵥ p₁') +ᵥ p₂', s.smul_vsub_vadd_mem _ h hp₁' hp₂', + or.inr (or.inr ⟨r₁, r₂, hr₁, hr₂, _⟩)⟩, + rw [vsub_vadd_eq_vsub_sub, smul_sub, ←hr, smul_smul, mul_div_cancel' _ hr₂.ne.symm, + ←smul_sub, vsub_sub_vsub_cancel_right] } }, + { rintro (h' | h'), + { exact w_same_side_of_left_mem y h' }, + { exact ⟨p₁, h, h'⟩ } } +end + +lemma w_same_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) : + s.w_same_side x y ↔ y ∈ s ∨ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) := +begin + rw [w_same_side_comm, w_same_side_iff_exists_left h], + simp_rw same_ray_comm +end + +lemma s_same_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) : + s.s_same_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) := +begin + rw [s_same_side, and_comm, w_same_side_iff_exists_left h, and_assoc, and.congr_right_iff], + intro hx, + rw or_iff_right hx +end + +lemma s_same_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) : + s.s_same_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (y -ᵥ p₂) := +begin + rw [s_same_side_comm, s_same_side_iff_exists_left h, ←and_assoc, and_comm (y ∉ s), and_assoc], + simp_rw same_ray_comm +end + +lemma w_opp_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) : + s.w_opp_side x y ↔ x ∈ s ∨ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) := +begin + split, + { rintro ⟨p₁', hp₁', p₂', hp₂', h0 | h0 | ⟨r₁, r₂, hr₁, hr₂, hr⟩⟩, + { rw vsub_eq_zero_iff_eq at h0, + rw h0, + exact or.inl hp₁' }, + { refine or.inr ⟨p₂', hp₂', _⟩, + rw h0, + exact same_ray.zero_right _ }, + { refine or.inr ⟨(-r₁ / r₂) • (p₁ -ᵥ p₁') +ᵥ p₂', s.smul_vsub_vadd_mem _ h hp₁' hp₂', + or.inr (or.inr ⟨r₁, r₂, hr₁, hr₂, _⟩)⟩, + rw [vadd_vsub_assoc, smul_add, ←hr, smul_smul, neg_div, mul_neg, + mul_div_cancel' _ hr₂.ne.symm, neg_smul, neg_add_eq_sub, ←smul_sub, + vsub_sub_vsub_cancel_right] } }, + { rintro (h' | h'), + { exact w_opp_side_of_left_mem y h' }, + { exact ⟨p₁, h, h'⟩ } } +end + +lemma w_opp_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) : + s.w_opp_side x y ↔ y ∈ s ∨ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) := +begin + rw [w_opp_side_comm, w_opp_side_iff_exists_left h], + split, + { rintro (hy | ⟨p, hp, hr⟩), { exact or.inl hy }, + refine or.inr ⟨p, hp, _⟩, + rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] }, + { rintro (hy | ⟨p, hp, hr⟩), { exact or.inl hy }, + refine or.inr ⟨p, hp, _⟩, + rwa [same_ray_comm, ←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] } +end + +lemma s_opp_side_iff_exists_left {s : affine_subspace R P} {x y p₁ : P} (h : p₁ ∈ s) : + s.s_opp_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₂ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) := +begin + rw [s_opp_side, and_comm, w_opp_side_iff_exists_left h, and_assoc, and.congr_right_iff], + intro hx, + rw or_iff_right hx +end + +lemma s_opp_side_iff_exists_right {s : affine_subspace R P} {x y p₂ : P} (h : p₂ ∈ s) : + s.s_opp_side x y ↔ x ∉ s ∧ y ∉ s ∧ ∃ p₁ ∈ s, same_ray R (x -ᵥ p₁) (p₂ -ᵥ y) := +begin + rw [s_opp_side, and_comm, w_opp_side_iff_exists_right h, and_assoc, and.congr_right_iff, + and.congr_right_iff], + rintro hx hy, + rw or_iff_right hy +end + +lemma w_same_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.w_same_side x y) + (hyz : s.w_same_side y z) (hy : y ∉ s) : s.w_same_side x z := +begin + rcases hxy with ⟨p₁, hp₁, p₂, hp₂, hxy⟩, + rw [w_same_side_iff_exists_left hp₂, or_iff_right hy] at hyz, + rcases hyz with ⟨p₃, hp₃, hyz⟩, + refine ⟨p₁, hp₁, p₃, hp₃, hxy.trans hyz _⟩, + refine λ h, false.elim _, + rw vsub_eq_zero_iff_eq at h, + exact hy (h.symm ▸ hp₂) +end + +lemma w_same_side.trans_s_same_side {s : affine_subspace R P} {x y z : P} + (hxy : s.w_same_side x y) (hyz : s.s_same_side y z) : s.w_same_side x z := +hxy.trans hyz.1 hyz.2.1 + +lemma w_same_side.trans_w_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_same_side x y) + (hyz : s.w_opp_side y z) (hy : y ∉ s) : s.w_opp_side x z := +begin + rcases hxy with ⟨p₁, hp₁, p₂, hp₂, hxy⟩, + rw [w_opp_side_iff_exists_left hp₂, or_iff_right hy] at hyz, + rcases hyz with ⟨p₃, hp₃, hyz⟩, + refine ⟨p₁, hp₁, p₃, hp₃, hxy.trans hyz _⟩, + refine λ h, false.elim _, + rw vsub_eq_zero_iff_eq at h, + exact hy (h.symm ▸ hp₂) +end + +lemma w_same_side.trans_s_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_same_side x y) + (hyz : s.s_opp_side y z) : s.w_opp_side x z := +hxy.trans_w_opp_side hyz.1 hyz.2.1 + +lemma s_same_side.trans_w_same_side {s : affine_subspace R P} {x y z : P} + (hxy : s.s_same_side x y) (hyz : s.w_same_side y z) : s.w_same_side x z := +(hyz.symm.trans_s_same_side hxy.symm).symm + +lemma s_same_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.s_same_side x y) + (hyz : s.s_same_side y z) : s.s_same_side x z := +⟨hxy.w_same_side.trans_s_same_side hyz, hxy.2.1, hyz.2.2⟩ + +lemma s_same_side.trans_w_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_same_side x y) + (hyz : s.w_opp_side y z) : s.w_opp_side x z := +hxy.w_same_side.trans_w_opp_side hyz hxy.2.2 + +lemma s_same_side.trans_s_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_same_side x y) + (hyz : s.s_opp_side y z) : s.s_opp_side x z := +⟨hxy.trans_w_opp_side hyz.1, hxy.2.1, hyz.2.2⟩ + +lemma w_opp_side.trans_w_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y) + (hyz : s.w_same_side y z) (hy : y ∉ s) : s.w_opp_side x z := +(hyz.symm.trans_w_opp_side hxy.symm hy).symm + +lemma w_opp_side.trans_s_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y) + (hyz : s.s_same_side y z) : s.w_opp_side x z := +hxy.trans_w_same_side hyz.1 hyz.2.1 + +lemma w_opp_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y) + (hyz : s.w_opp_side y z) (hy : y ∉ s) : s.w_same_side x z := +begin + rcases hxy with ⟨p₁, hp₁, p₂, hp₂, hxy⟩, + rw [w_opp_side_iff_exists_left hp₂, or_iff_right hy] at hyz, + rcases hyz with ⟨p₃, hp₃, hyz⟩, + rw [←same_ray_neg_iff, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev] at hyz, + refine ⟨p₁, hp₁, p₃, hp₃, hxy.trans hyz _⟩, + refine λ h, false.elim _, + rw vsub_eq_zero_iff_eq at h, + exact hy (h ▸ hp₂) +end + +lemma w_opp_side.trans_s_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.w_opp_side x y) + (hyz : s.s_opp_side y z) : s.w_same_side x z := +hxy.trans hyz.1 hyz.2.1 + +lemma s_opp_side.trans_w_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y) + (hyz : s.w_same_side y z) : s.w_opp_side x z := +(hyz.symm.trans_s_opp_side hxy.symm).symm + +lemma s_opp_side.trans_s_same_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y) + (hyz : s.s_same_side y z) : s.s_opp_side x z := +(hyz.symm.trans_s_opp_side hxy.symm).symm + +lemma s_opp_side.trans_w_opp_side {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y) + (hyz : s.w_opp_side y z) : s.w_same_side x z := +(hyz.symm.trans_s_opp_side hxy.symm).symm + +lemma s_opp_side.trans {s : affine_subspace R P} {x y z : P} (hxy : s.s_opp_side x y) + (hyz : s.s_opp_side y z) : s.s_same_side x z := +⟨hxy.trans_w_opp_side hyz.1, hxy.2.1, hyz.2.2⟩ + +lemma w_same_side_and_w_opp_side_iff {s : affine_subspace R P} {x y : P} : + (s.w_same_side x y ∧ s.w_opp_side x y) ↔ (x ∈ s ∨ y ∈ s) := +begin + split, + { rintro ⟨hs, ho⟩, + rw w_opp_side_comm at ho, + by_contra h, + rw not_or_distrib at h, + exact h.1 (w_opp_side_self_iff.1 (hs.trans_w_opp_side ho h.2)) }, + { rintro (h | h), + { exact ⟨w_same_side_of_left_mem y h, w_opp_side_of_left_mem y h⟩ }, + { exact ⟨w_same_side_of_right_mem x h, w_opp_side_of_right_mem x h⟩ } } +end + +lemma w_same_side.not_s_opp_side {s : affine_subspace R P} {x y : P} (h : s.w_same_side x y) : + ¬s.s_opp_side x y := +begin + intro ho, + have hxy := w_same_side_and_w_opp_side_iff.1 ⟨h, ho.1⟩, + rcases hxy with hx | hy, + { exact ho.2.1 hx }, + { exact ho.2.2 hy } +end + +lemma s_same_side.not_w_opp_side {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) : + ¬s.w_opp_side x y := +begin + intro ho, + have hxy := w_same_side_and_w_opp_side_iff.1 ⟨h.1, ho⟩, + rcases hxy with hx | hy, + { exact h.2.1 hx }, + { exact h.2.2 hy } +end + +lemma s_same_side.not_s_opp_side {s : affine_subspace R P} {x y : P} (h : s.s_same_side x y) : + ¬s.s_opp_side x y := +λ ho, h.not_w_opp_side ho.1 + +lemma w_opp_side.not_s_same_side {s : affine_subspace R P} {x y : P} (h : s.w_opp_side x y) : + ¬s.s_same_side x y := +λ hs, hs.not_w_opp_side h + +lemma s_opp_side.not_w_same_side {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + ¬s.w_same_side x y := +λ hs, hs.not_s_opp_side h + +lemma s_opp_side.not_s_same_side {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + ¬s.s_same_side x y := +λ hs, h.not_w_same_side hs.1 + +lemma w_opp_side_iff_exists_wbtw {s : affine_subspace R P} {x y : P} : + s.w_opp_side x y ↔ ∃ p ∈ s, wbtw R x p y := +begin + refine ⟨λ h, _, λ ⟨p, hp, h⟩, h.w_opp_side₁₃ hp⟩, + rcases h with ⟨p₁, hp₁, p₂, hp₂, (h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩)⟩, + { rw vsub_eq_zero_iff_eq at h, + rw h, + exact ⟨p₁, hp₁, wbtw_self_left _ _ _⟩ }, + { rw vsub_eq_zero_iff_eq at h, + rw ←h, + exact ⟨p₂, hp₂, wbtw_self_right _ _ _⟩ }, + { refine ⟨line_map x y (r₂ / (r₁ + r₂)), _, _⟩, + { rw [line_map_apply, ←vsub_vadd x p₁, ←vsub_vadd y p₂, vsub_vadd_eq_vsub_sub, + vadd_vsub_assoc, ←vadd_assoc, vadd_eq_add], + convert s.smul_vsub_vadd_mem (r₂ / (r₁ + r₂)) hp₂ hp₁ hp₁, + rw [add_comm (y -ᵥ p₂), smul_sub, smul_add, add_sub_assoc, add_assoc, add_right_eq_self, + div_eq_inv_mul, ←neg_vsub_eq_vsub_rev, smul_neg, ←smul_smul, ←h, smul_smul, + ←neg_smul, ←sub_smul, ←div_eq_inv_mul, ←div_eq_inv_mul, ←neg_div, ←sub_div, + sub_eq_add_neg, ←neg_add, neg_div, div_self (left.add_pos hr₁ hr₂).ne.symm, + neg_one_smul, neg_add_self] }, + { exact set.mem_image_of_mem _ ⟨div_nonneg hr₂.le (left.add_pos hr₁ hr₂).le, + div_le_one_of_le (le_add_of_nonneg_left hr₁.le) + (left.add_pos hr₁ hr₂).le⟩ } } +end + +lemma s_opp_side.exists_sbtw {s : affine_subspace R P} {x y : P} (h : s.s_opp_side x y) : + ∃ p ∈ s, sbtw R x p y := +begin + obtain ⟨p, hp, hw⟩ := w_opp_side_iff_exists_wbtw.1 h.w_opp_side, + refine ⟨p, hp, hw, _, _⟩, + { rintro rfl, + exact h.2.1 hp }, + { rintro rfl, + exact h.2.2 hp }, +end + +lemma _root_.sbtw.s_opp_side_of_not_mem_of_mem {s : affine_subspace R P} {x y z : P} + (h : sbtw R x y z) (hx : x ∉ s) (hy : y ∈ s) : s.s_opp_side x z := +begin + refine ⟨h.wbtw.w_opp_side₁₃ hy, hx, λ hz, hx _⟩, + rcases h with ⟨⟨t, ⟨ht0, ht1⟩, rfl⟩, hyx, hyz⟩, + rw line_map_apply at hy, + have ht : t ≠ 1, { rintro rfl, simpa [line_map_apply] using hyz }, + have hy' := vsub_mem_direction hy hz, + rw [vadd_vsub_assoc, ←neg_vsub_eq_vsub_rev z, ←neg_one_smul R (z -ᵥ x), ←add_smul, + ←sub_eq_add_neg, s.direction.smul_mem_iff (sub_ne_zero_of_ne ht)] at hy', + rwa vadd_mem_iff_mem_of_mem_direction (submodule.smul_mem _ _ hy') at hy +end + +lemma s_same_side_smul_vsub_vadd_left {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 < t) : s.s_same_side (t • (x -ᵥ p₁) +ᵥ p₂) x := +begin + refine ⟨w_same_side_smul_vsub_vadd_left x hp₁ hp₂ ht.le, λ h, hx _, hx⟩, + rwa [vadd_mem_iff_mem_direction _ hp₂, s.direction.smul_mem_iff ht.ne.symm, + vsub_right_mem_direction_iff_mem hp₁] at h +end + +lemma s_same_side_smul_vsub_vadd_right {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : 0 < t) : s.s_same_side x (t • (x -ᵥ p₁) +ᵥ p₂) := +(s_same_side_smul_vsub_vadd_left hx hp₁ hp₂ ht).symm + +lemma s_same_side_line_map_left {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s) + {t : R} (ht : 0 < t) : s.s_same_side (line_map x y t) y := +s_same_side_smul_vsub_vadd_left hy hx hx ht + +lemma s_same_side_line_map_right {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s) + {t : R} (ht : 0 < t) : s.s_same_side y (line_map x y t) := +(s_same_side_line_map_left hx hy ht).symm + +lemma s_opp_side_smul_vsub_vadd_left {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t < 0) : s.s_opp_side (t • (x -ᵥ p₁) +ᵥ p₂) x := +begin + refine ⟨w_opp_side_smul_vsub_vadd_left x hp₁ hp₂ ht.le, λ h, hx _, hx⟩, + rwa [vadd_mem_iff_mem_direction _ hp₂, s.direction.smul_mem_iff ht.ne, + vsub_right_mem_direction_iff_mem hp₁] at h +end + +lemma s_opp_side_smul_vsub_vadd_right {s : affine_subspace R P} {x p₁ p₂ : P} (hx : x ∉ s) + (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) {t : R} (ht : t < 0) : s.s_opp_side x (t • (x -ᵥ p₁) +ᵥ p₂) := +(s_opp_side_smul_vsub_vadd_left hx hp₁ hp₂ ht).symm + +lemma s_opp_side_line_map_left {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s) + {t : R} (ht : t < 0) : s.s_opp_side (line_map x y t) y := +s_opp_side_smul_vsub_vadd_left hy hx hx ht + +lemma s_opp_side_line_map_right {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s) + {t : R} (ht : t < 0) : s.s_opp_side y (line_map x y t) := +(s_opp_side_line_map_left hx hy ht).symm + +lemma set_of_w_same_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) : + {y | s.w_same_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Ici 0) s := +begin + ext y, + simp_rw [set.mem_set_of, set.mem_image2, set.mem_Ici, mem_coe], + split, + { rw [w_same_side_iff_exists_left hp, or_iff_right hx], + rintro ⟨p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩, + { rw vsub_eq_zero_iff_eq at h, + exact false.elim (hx (h.symm ▸ hp)) }, + { rw vsub_eq_zero_iff_eq at h, + refine ⟨0, p₂, le_refl _, hp₂, _⟩, + simp [h] }, + { refine ⟨r₁ / r₂, p₂, (div_pos hr₁ hr₂).le, hp₂, _⟩, + rw [div_eq_inv_mul, ←smul_smul, h, smul_smul, inv_mul_cancel hr₂.ne.symm, one_smul, + vsub_vadd] } }, + { rintro ⟨t, p', ht, hp', rfl⟩, + exact w_same_side_smul_vsub_vadd_right x hp hp' ht } +end + +lemma set_of_s_same_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) : + {y | s.s_same_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Ioi 0) s := +begin + ext y, + simp_rw [set.mem_set_of, set.mem_image2, set.mem_Ioi, mem_coe], + split, + { rw s_same_side_iff_exists_left hp, + rintro ⟨-, hy, p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩, + { rw vsub_eq_zero_iff_eq at h, + exact false.elim (hx (h.symm ▸ hp)) }, + { rw vsub_eq_zero_iff_eq at h, + exact false.elim (hy (h.symm ▸ hp₂)) }, + { refine ⟨r₁ / r₂, p₂, div_pos hr₁ hr₂, hp₂, _⟩, + rw [div_eq_inv_mul, ←smul_smul, h, smul_smul, inv_mul_cancel hr₂.ne.symm, one_smul, + vsub_vadd] } }, + { rintro ⟨t, p', ht, hp', rfl⟩, + exact s_same_side_smul_vsub_vadd_right hx hp hp' ht } +end + +lemma set_of_w_opp_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) : + {y | s.w_opp_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Iic 0) s := +begin + ext y, + simp_rw [set.mem_set_of, set.mem_image2, set.mem_Iic, mem_coe], + split, + { rw [w_opp_side_iff_exists_left hp, or_iff_right hx], + rintro ⟨p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩, + { rw vsub_eq_zero_iff_eq at h, + exact false.elim (hx (h.symm ▸ hp)) }, + { rw vsub_eq_zero_iff_eq at h, + refine ⟨0, p₂, le_refl _, hp₂, _⟩, + simp [h] }, + { refine ⟨-r₁ / r₂, p₂, (div_neg_of_neg_of_pos (left.neg_neg_iff.2 hr₁) hr₂).le, hp₂, _⟩, + rw [div_eq_inv_mul, ←smul_smul, neg_smul, h, smul_neg, smul_smul, + inv_mul_cancel hr₂.ne.symm, one_smul, neg_vsub_eq_vsub_rev, vsub_vadd] } }, + { rintro ⟨t, p', ht, hp', rfl⟩, + exact w_opp_side_smul_vsub_vadd_right x hp hp' ht } +end + +lemma set_of_s_opp_side_eq_image2 {s : affine_subspace R P} {x p : P} (hx : x ∉ s) (hp : p ∈ s) : + {y | s.s_opp_side x y} = set.image2 (λ (t : R) q, t • (x -ᵥ p) +ᵥ q) (set.Iio 0) s := +begin + ext y, + simp_rw [set.mem_set_of, set.mem_image2, set.mem_Iio, mem_coe], + split, + { rw s_opp_side_iff_exists_left hp, + rintro ⟨-, hy, p₂, hp₂, h | h | ⟨r₁, r₂, hr₁, hr₂, h⟩⟩, + { rw vsub_eq_zero_iff_eq at h, + exact false.elim (hx (h.symm ▸ hp)) }, + { rw vsub_eq_zero_iff_eq at h, + exact false.elim (hy (h ▸ hp₂)) }, + { refine ⟨-r₁ / r₂, p₂, div_neg_of_neg_of_pos (left.neg_neg_iff.2 hr₁) hr₂, hp₂, _⟩, + rw [div_eq_inv_mul, ←smul_smul, neg_smul, h, smul_neg, smul_smul, + inv_mul_cancel hr₂.ne.symm, one_smul, neg_vsub_eq_vsub_rev, vsub_vadd] } }, + { rintro ⟨t, p', ht, hp', rfl⟩, + exact s_opp_side_smul_vsub_vadd_right hx hp hp' ht } +end + +lemma w_opp_side_point_reflection {s : affine_subspace R P} {x : P} (y : P) (hx : x ∈ s) : + s.w_opp_side y (point_reflection R x y) := +(wbtw_point_reflection R _ _).w_opp_side₁₃ hx + +lemma s_opp_side_point_reflection {s : affine_subspace R P} {x y : P} (hx : x ∈ s) (hy : y ∉ s) : + s.s_opp_side y (point_reflection R x y) := +begin + refine (sbtw_point_reflection_of_ne R (λ h, hy _)).s_opp_side_of_not_mem_of_mem hy hx, + rwa ←h +end + +end linear_ordered_field + +section normed + +variables [seminormed_add_comm_group V] [normed_space ℝ V] [pseudo_metric_space P] +variables [normed_add_torsor V P] + +include V + +lemma is_connected_set_of_w_same_side {s : affine_subspace ℝ P} (x : P) + (h : (s : set P).nonempty) : is_connected {y | s.w_same_side x y} := +begin + obtain ⟨p, hp⟩ := h, + haveI : nonempty s := ⟨⟨p, hp⟩⟩, + by_cases hx : x ∈ s, + { convert is_connected_univ, + { simp [w_same_side_of_left_mem, hx] }, + { exact add_torsor.connected_space V P } }, + { rw [set_of_w_same_side_eq_image2 hx hp, ←set.image_prod], + refine (is_connected_Ici.prod (is_connected_iff_connected_space.2 _)).image _ + ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on, + convert add_torsor.connected_space s.direction s } +end + +lemma is_preconnected_set_of_w_same_side (s : affine_subspace ℝ P) (x : P) : + is_preconnected {y | s.w_same_side x y} := +begin + rcases set.eq_empty_or_nonempty (s : set P) with h | h, + { convert is_preconnected_empty, + rw coe_eq_bot_iff at h, + simp only [h, not_w_same_side_bot], + refl }, + { exact (is_connected_set_of_w_same_side x h).is_preconnected } +end + +lemma is_connected_set_of_s_same_side {s : affine_subspace ℝ P} {x : P} (hx : x ∉ s) + (h : (s : set P).nonempty) : is_connected {y | s.s_same_side x y} := +begin + obtain ⟨p, hp⟩ := h, + haveI : nonempty s := ⟨⟨p, hp⟩⟩, + rw [set_of_s_same_side_eq_image2 hx hp, ←set.image_prod], + refine (is_connected_Ioi.prod (is_connected_iff_connected_space.2 _)).image _ + ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on, + convert add_torsor.connected_space s.direction s +end + +lemma is_preconnected_set_of_s_same_side (s : affine_subspace ℝ P) (x : P) : + is_preconnected {y | s.s_same_side x y} := +begin + rcases set.eq_empty_or_nonempty (s : set P) with h | h, + { convert is_preconnected_empty, + rw coe_eq_bot_iff at h, + simp only [h, not_s_same_side_bot], + refl }, + { by_cases hx : x ∈ s, + { convert is_preconnected_empty, + simp only [hx, s_same_side, not_true, false_and, and_false], + refl }, + { exact (is_connected_set_of_s_same_side hx h).is_preconnected } } +end + +lemma is_connected_set_of_w_opp_side {s : affine_subspace ℝ P} (x : P) + (h : (s : set P).nonempty) : is_connected {y | s.w_opp_side x y} := +begin + obtain ⟨p, hp⟩ := h, + haveI : nonempty s := ⟨⟨p, hp⟩⟩, + by_cases hx : x ∈ s, + { convert is_connected_univ, + { simp [w_opp_side_of_left_mem, hx] }, + { exact add_torsor.connected_space V P } }, + { rw [set_of_w_opp_side_eq_image2 hx hp, ←set.image_prod], + refine (is_connected_Iic.prod (is_connected_iff_connected_space.2 _)).image _ + ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on, + convert add_torsor.connected_space s.direction s } +end + +lemma is_preconnected_set_of_w_opp_side (s : affine_subspace ℝ P) (x : P) : + is_preconnected {y | s.w_opp_side x y} := +begin + rcases set.eq_empty_or_nonempty (s : set P) with h | h, + { convert is_preconnected_empty, + rw coe_eq_bot_iff at h, + simp only [h, not_w_opp_side_bot], + refl }, + { exact (is_connected_set_of_w_opp_side x h).is_preconnected } +end + +lemma is_connected_set_of_s_opp_side {s : affine_subspace ℝ P} {x : P} (hx : x ∉ s) + (h : (s : set P).nonempty) : is_connected {y | s.s_opp_side x y} := +begin + obtain ⟨p, hp⟩ := h, + haveI : nonempty s := ⟨⟨p, hp⟩⟩, + rw [set_of_s_opp_side_eq_image2 hx hp, ←set.image_prod], + refine (is_connected_Iio.prod (is_connected_iff_connected_space.2 _)).image _ + ((continuous_fst.smul continuous_const).vadd continuous_snd).continuous_on, + convert add_torsor.connected_space s.direction s +end + +lemma is_preconnected_set_of_s_opp_side (s : affine_subspace ℝ P) (x : P) : + is_preconnected {y | s.s_opp_side x y} := +begin + rcases set.eq_empty_or_nonempty (s : set P) with h | h, + { convert is_preconnected_empty, + rw coe_eq_bot_iff at h, + simp only [h, not_s_opp_side_bot], + refl }, + { by_cases hx : x ∈ s, + { convert is_preconnected_empty, + simp only [hx, s_opp_side, not_true, false_and, and_false], + refl }, + { exact (is_connected_set_of_s_opp_side hx h).is_preconnected } } +end + +end normed + +end affine_subspace diff --git a/src/analysis/convex/simplicial_complex/basic.lean b/src/analysis/convex/simplicial_complex/basic.lean index 20a7e59aa8b21..f29d4b3381658 100644 --- a/src/analysis/convex/simplicial_complex/basic.lean +++ b/src/analysis/convex/simplicial_complex/basic.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Bhavik Mehta -/ -import analysis.convex.topology -import tactic.by_contra +import analysis.convex.hull +import linear_algebra.affine_space.independent /-! # Simplicial complexes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define simplicial complexes in `𝕜`-modules. A simplicial complex is a collection of simplices closed by inclusion (of vertices) and intersection (of underlying sets). @@ -91,7 +94,7 @@ begin classical, by_contra' h, refine h.2 (s ∩ t) (K.down_closed hs (inter_subset_left _ _) $ λ hst, h.1 $ - (K.inter_subset_convex_hull hs ht).trans _) _, + disjoint_iff_inf_le.mpr $ (K.inter_subset_convex_hull hs ht).trans _) _, { rw [←coe_inter, hst, coe_empty, convex_hull_empty], refl }, { rw [coe_inter, convex_hull_inter_convex_hull hs ht] } diff --git a/src/analysis/convex/slope.lean b/src/analysis/convex/slope.lean index dd5cc0fac9273..b8e68c71b0c0e 100644 --- a/src/analysis/convex/slope.lean +++ b/src/analysis/convex/slope.lean @@ -4,10 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudriashov, Malo Jaffré -/ import analysis.convex.function +import tactic.field_simp +import tactic.linarith /-! # Slopes of convex functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file relates convexity/concavity of functions in a linearly ordered field and the monotonicity of their slopes. @@ -97,9 +102,8 @@ lemma convex_on_of_slope_mono_adjacent (hs : convex 𝕜 s) (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z → (f y - f x) / (y - x) ≤ (f z - f y) / (z - y)) : convex_on 𝕜 s f := -linear_order.convex_on_of_lt hs +linear_order.convex_on_of_lt hs $ λ x hx z hz hxz a b ha hb hab, begin - assume x z hx hz hxz a b ha hb hab, let y := a * x + b * z, have hxy : x < y, { rw [← one_mul x, ← hab, add_mul], @@ -140,9 +144,8 @@ lemma strict_convex_on_of_slope_strict_mono_adjacent (hs : convex 𝕜 s) (hf : ∀ {x y z : 𝕜}, x ∈ s → z ∈ s → x < y → y < z → (f y - f x) / (y - x) < (f z - f y) / (z - y)) : strict_convex_on 𝕜 s f := -linear_order.strict_convex_on_of_lt hs +linear_order.strict_convex_on_of_lt hs $ λ x hx z hz hxz a b ha hb hab, begin - assume x z hx hz hxz a b ha hb hab, let y := a * x + b * z, have hxy : x < y, { rw [← one_mul x, ← hab, add_mul], @@ -213,3 +216,146 @@ lemma strict_concave_on_iff_slope_strict_anti_adjacent : (f z - f y) / (z - y) < (f y - f x) / (y - x) := ⟨λ h, ⟨h.1, λ x y z, h.slope_anti_adjacent⟩, λ h, strict_concave_on_of_slope_strict_anti_adjacent h.1 h.2⟩ + +lemma convex_on.secant_mono_aux1 (hf : convex_on 𝕜 s f) + {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) : + (z - x) * f y ≤ (z - y) * f x + (y - x) * f z := +begin + have hxy' : 0 < y - x := by linarith, + have hyz' : 0 < z - y := by linarith, + have hxz' : 0 < z - x := by linarith, + rw ← le_div_iff' hxz', + have ha : 0 ≤ (z - y) / (z - x) := by positivity, + have hb : 0 ≤ (y - x) / (z - x) := by positivity, + calc f y = f ((z - y) / (z - x) * x + (y - x) / (z - x) * z) : _ + ... ≤ (z - y) / (z - x) * f x + (y - x) / (z - x) * f z : hf.2 hx hz ha hb _ + ... = ((z - y) * f x + (y - x) * f z) / (z - x) : _, + { congr' 1, + field_simp [hxy'.ne', hyz'.ne', hxz'.ne'], + ring }, + { field_simp [hxy'.ne', hyz'.ne', hxz'.ne'] }, + { field_simp [hxy'.ne', hyz'.ne', hxz'.ne'] } +end + +lemma convex_on.secant_mono_aux2 (hf : convex_on 𝕜 s f) + {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) : + (f y - f x) / (y - x) ≤ (f z - f x) / (z - x) := +begin + have hxy' : 0 < y - x := by linarith, + have hxz' : 0 < z - x := by linarith, + rw div_le_div_iff hxy' hxz', + linarith only [hf.secant_mono_aux1 hx hz hxy hyz], +end + +lemma convex_on.secant_mono_aux3 (hf : convex_on 𝕜 s f) + {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) : + (f z - f x) / (z - x) ≤ (f z - f y) / (z - y) := +begin + have hyz' : 0 < z - y := by linarith, + have hxz' : 0 < z - x := by linarith, + rw div_le_div_iff hxz' hyz', + linarith only [hf.secant_mono_aux1 hx hz hxy hyz], +end + +lemma convex_on.secant_mono (hf : convex_on 𝕜 s f) + {a x y : 𝕜} (ha : a ∈ s) (hx : x ∈ s) (hy : y ∈ s) (hxa : x ≠ a) (hya : y ≠ a) (hxy : x ≤ y) : + (f x - f a) / (x - a) ≤ (f y - f a) / (y - a) := +begin + rcases eq_or_lt_of_le hxy with rfl | hxy, + { simp }, + cases lt_or_gt_of_ne hxa with hxa hxa, + { cases lt_or_gt_of_ne hya with hya hya, + { convert hf.secant_mono_aux3 hx ha hxy hya using 1; + rw ← neg_div_neg_eq; + field_simp, }, + { convert hf.slope_mono_adjacent hx hy hxa hya using 1, + rw ← neg_div_neg_eq; + field_simp, } }, + { exact hf.secant_mono_aux2 ha hy hxa hxy, }, +end + +lemma strict_convex_on.secant_strict_mono_aux1 (hf : strict_convex_on 𝕜 s f) + {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) : + (z - x) * f y < (z - y) * f x + (y - x) * f z := +begin + have hxy' : 0 < y - x := by linarith, + have hyz' : 0 < z - y := by linarith, + have hxz' : 0 < z - x := by linarith, + rw ← lt_div_iff' hxz', + have ha : 0 < (z - y) / (z - x) := by positivity, + have hb : 0 < (y - x) / (z - x) := by positivity, + calc f y = f ((z - y) / (z - x) * x + (y - x) / (z - x) * z) : _ + ... < (z - y) / (z - x) * f x + (y - x) / (z - x) * f z : hf.2 hx hz (by linarith) ha hb _ + ... = ((z - y) * f x + (y - x) * f z) / (z - x) : _, + { congr' 1, + field_simp [hxy'.ne', hyz'.ne', hxz'.ne'], + ring }, + { field_simp [hxy'.ne', hyz'.ne', hxz'.ne'] }, + { field_simp [hxy'.ne', hyz'.ne', hxz'.ne'] } +end + +lemma strict_convex_on.secant_strict_mono_aux2 (hf : strict_convex_on 𝕜 s f) + {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) : + (f y - f x) / (y - x) < (f z - f x) / (z - x) := +begin + have hxy' : 0 < y - x := by linarith, + have hxz' : 0 < z - x := by linarith, + rw div_lt_div_iff hxy' hxz', + linarith only [hf.secant_strict_mono_aux1 hx hz hxy hyz], +end + +lemma strict_convex_on.secant_strict_mono_aux3 (hf : strict_convex_on 𝕜 s f) + {x y z : 𝕜} (hx : x ∈ s) (hz : z ∈ s) (hxy : x < y) (hyz : y < z) : + (f z - f x) / (z - x) < (f z - f y) / (z - y) := +begin + have hyz' : 0 < z - y := by linarith, + have hxz' : 0 < z - x := by linarith, + rw div_lt_div_iff hxz' hyz', + linarith only [hf.secant_strict_mono_aux1 hx hz hxy hyz], +end + +lemma strict_convex_on.secant_strict_mono (hf : strict_convex_on 𝕜 s f) + {a x y : 𝕜} (ha : a ∈ s) (hx : x ∈ s) (hy : y ∈ s) (hxa : x ≠ a) (hya : y ≠ a) (hxy : x < y) : + (f x - f a) / (x - a) < (f y - f a) / (y - a) := +begin + cases lt_or_gt_of_ne hxa with hxa hxa, + { cases lt_or_gt_of_ne hya with hya hya, + { convert hf.secant_strict_mono_aux3 hx ha hxy hya using 1; + rw ← neg_div_neg_eq; + field_simp, }, + { convert hf.slope_strict_mono_adjacent hx hy hxa hya using 1, + rw ← neg_div_neg_eq; + field_simp, } }, + { exact hf.secant_strict_mono_aux2 ha hy hxa hxy, }, +end + +lemma strict_concave_on.secant_strict_mono (hf : strict_concave_on 𝕜 s f) + {a x y : 𝕜} (ha : a ∈ s) (hx : x ∈ s) (hy : y ∈ s) (hxa : x ≠ a) (hya : y ≠ a) (hxy : x < y) : + (f y - f a) / (y - a) < (f x - f a) / (x - a) := +begin + have key := hf.neg.secant_strict_mono ha hx hy hxa hya hxy, + simp only [pi.neg_apply] at key, + rw ← neg_lt_neg_iff, + convert key using 1; field_simp, +end + +/-- If `f` is convex on a set `s` in a linearly ordered field, and `f x < f y` for two points +`x < y` in `s`, then `f` is strictly monotone on `s ∩ [y, ∞)`. -/ +lemma convex_on.strict_mono_of_lt (hf : convex_on 𝕜 s f) + {x y : 𝕜} (hx : x ∈ s) (hxy : x < y) (hxy' : f x < f y) : + strict_mono_on f (s ∩ set.Ici y) := +begin + intros u hu v hv huv, + have step1 : ∀ {z : 𝕜}, z ∈ s ∩ set.Ioi y → f y < f z, + { refine λ z hz, hf.lt_right_of_left_lt hx hz.1 _ hxy', + rw open_segment_eq_Ioo (hxy.trans hz.2), + exact ⟨hxy, hz.2⟩ }, + rcases eq_or_lt_of_le hu.2 with rfl | hu2, + { exact step1 ⟨hv.1, huv⟩ }, + { refine hf.lt_right_of_left_lt _ hv.1 _ (step1 ⟨hu.1, hu2⟩), + { apply hf.1.segment_subset hx hu.1, + rw segment_eq_Icc (hxy.le.trans hu.2), + exact ⟨hxy.le, hu.2⟩ }, + { rw open_segment_eq_Ioo (hu2.trans huv), + exact ⟨hu2, huv⟩ } }, +end diff --git a/src/analysis/convex/specific_functions.lean b/src/analysis/convex/specific_functions.lean deleted file mode 100644 index d5c55c7f462ae..0000000000000 --- a/src/analysis/convex/specific_functions.lean +++ /dev/null @@ -1,227 +0,0 @@ -/- -Copyright (c) 2020 Yury Kudryashov. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yury Kudryashov, Sébastien Gouëzel --/ -import analysis.calculus.mean_value -import analysis.special_functions.pow_deriv - -/-! -# Collection of convex functions - -In this file we prove that the following functions are convex: - -* `strict_convex_on_exp` : The exponential function is strictly convex. -* `even.convex_on_pow`, `even.strict_convex_on_pow` : For an even `n : ℕ`, `λ x, x ^ n` is convex - and strictly convex when `2 ≤ n`. -* `convex_on_pow`, `strict_convex_on_pow` : For `n : ℕ`, `λ x, x ^ n` is convex on $[0, +∞)$ and - strictly convex when `2 ≤ n`. -* `convex_on_zpow`, `strict_convex_on_zpow` : For `m : ℤ`, `λ x, x ^ m` is convex on $[0, +∞)$ and - strictly convex when `m ≠ 0, 1`. -* `convex_on_rpow`, `strict_convex_on_rpow` : For `p : ℝ`, `λ x, x ^ p` is convex on $[0, +∞)$ when - `1 ≤ p` and strictly convex when `1 < p`. -* `strict_concave_on_log_Ioi`, `strict_concave_on_log_Iio`: `real.log` is strictly concave on - $(0, +∞)$ and $(-∞, 0)$ respectively. - -## TODO - -For `p : ℝ`, prove that `λ x, x ^ p` is concave when `0 ≤ p ≤ 1` and strictly concave when -`0 < p < 1`. --/ - -open real set -open_locale big_operators - -/-- `exp` is strictly convex on the whole real line. -/ -lemma strict_convex_on_exp : strict_convex_on ℝ univ exp := -strict_convex_on_univ_of_deriv2_pos differentiable_exp (λ x, (iter_deriv_exp 2).symm ▸ exp_pos x) - -/-- `exp` is convex on the whole real line. -/ -lemma convex_on_exp : convex_on ℝ univ exp := strict_convex_on_exp.convex_on - -/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even -/ -lemma even.convex_on_pow {n : ℕ} (hn : even n) : convex_on ℝ set.univ (λ x : ℝ, x^n) := -begin - apply convex_on_univ_of_deriv2_nonneg differentiable_pow, - { simp only [deriv_pow', differentiable.mul, differentiable_const, differentiable_pow] }, - { intro x, - obtain ⟨k, hk⟩ := (hn.tsub_even $ even_bit0 _).exists_two_nsmul _, - rw [iter_deriv_pow, finset.prod_range_cast_nat_sub, hk, nsmul_eq_mul, pow_mul'], - exact mul_nonneg (nat.cast_nonneg _) (pow_two_nonneg _) } -end - -/-- `x^n`, `n : ℕ` is strictly convex on the whole real line whenever `n ≠ 0` is even. -/ -lemma even.strict_convex_on_pow {n : ℕ} (hn : even n) (h : n ≠ 0) : - strict_convex_on ℝ set.univ (λ x : ℝ, x^n) := -begin - apply strict_mono.strict_convex_on_univ_of_deriv differentiable_pow, - rw deriv_pow', - replace h := nat.pos_of_ne_zero h, - exact strict_mono.const_mul (odd.strict_mono_pow $ nat.even.sub_odd h hn $ nat.odd_iff.2 rfl) - (nat.cast_pos.2 h), -end - -/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n` -/ -lemma convex_on_pow (n : ℕ) : convex_on ℝ (Ici 0) (λ x : ℝ, x^n) := -begin - apply convex_on_of_deriv2_nonneg (convex_Ici _) (continuous_pow n).continuous_on - differentiable_on_pow, - { simp only [deriv_pow'], exact (@differentiable_on_pow ℝ _ _ _).const_mul (n : ℝ) }, - { intros x hx, - rw [iter_deriv_pow, finset.prod_range_cast_nat_sub], - exact mul_nonneg (nat.cast_nonneg _) (pow_nonneg (interior_subset hx) _) } -end - -/-- `x^n`, `n : ℕ` is strictly convex on `[0, +∞)` for all `n` greater than `2`. -/ -lemma strict_convex_on_pow {n : ℕ} (hn : 2 ≤ n) : strict_convex_on ℝ (Ici 0) (λ x : ℝ, x^n) := -begin - apply strict_mono_on.strict_convex_on_of_deriv (convex_Ici _) (continuous_on_pow _) - differentiable_on_pow, - rw [deriv_pow', interior_Ici], - exact λ x (hx : 0 < x) y hy hxy, mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_left hxy hx.le $ - nat.sub_pos_of_lt hn) (nat.cast_pos.2 $ zero_lt_two.trans_le hn), -end - -lemma finset.prod_nonneg_of_card_nonpos_even - {α β : Type*} [linear_ordered_comm_ring β] - {f : α → β} [decidable_pred (λ x, f x ≤ 0)] - {s : finset α} (h0 : even (s.filter (λ x, f x ≤ 0)).card) : - 0 ≤ ∏ x in s, f x := -calc 0 ≤ (∏ x in s, ((if f x ≤ 0 then (-1:β) else 1) * f x)) : - finset.prod_nonneg (λ x _, by - { split_ifs with hx hx, by simp [hx], simp at hx ⊢, exact le_of_lt hx }) -... = _ : by rw [finset.prod_mul_distrib, finset.prod_ite, finset.prod_const_one, - mul_one, finset.prod_const, neg_one_pow_eq_pow_mod_two, nat.even_iff.1 h0, pow_zero, one_mul] - -lemma int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : even n) : - 0 ≤ ∏ k in finset.range n, (m - k) := -begin - rcases hn with ⟨n, rfl⟩, - induction n with n ihn, { simp }, - rw ← two_mul at ihn, - rw [← two_mul, nat.succ_eq_add_one, mul_add, mul_one, bit0, ← add_assoc, finset.prod_range_succ, - finset.prod_range_succ, mul_assoc], - refine mul_nonneg ihn _, generalize : (1 + 1) * n = k, - cases le_or_lt m k with hmk hmk, - { have : m ≤ k + 1, from hmk.trans (lt_add_one ↑k).le, - exact mul_nonneg_of_nonpos_of_nonpos (sub_nonpos_of_le hmk) (sub_nonpos_of_le this) }, - { exact mul_nonneg (sub_nonneg_of_le hmk.le) (sub_nonneg_of_le hmk) } -end - -lemma int_prod_range_pos {m : ℤ} {n : ℕ} (hn : even n) (hm : m ∉ Ico (0 : ℤ) n) : - 0 < ∏ k in finset.range n, (m - k) := -begin - refine (int_prod_range_nonneg m n hn).lt_of_ne (λ h, hm _), - rw [eq_comm, finset.prod_eq_zero_iff] at h, - obtain ⟨a, ha, h⟩ := h, - rw sub_eq_zero.1 h, - exact ⟨int.coe_zero_le _, int.coe_nat_lt.2 $ finset.mem_range.1 ha⟩, -end - -/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` -/ -lemma convex_on_zpow (m : ℤ) : convex_on ℝ (Ioi 0) (λ x : ℝ, x^m) := -begin - have : ∀ n : ℤ, differentiable_on ℝ (λ x, x ^ n) (Ioi (0 : ℝ)), - from λ n, differentiable_on_zpow _ _ (or.inl $ lt_irrefl _), - apply convex_on_of_deriv2_nonneg (convex_Ioi 0); - try { simp only [interior_Ioi, deriv_zpow'] }, - { exact (this _).continuous_on }, - { exact this _ }, - { exact (this _).const_mul _ }, - { intros x hx, - simp only [iter_deriv_zpow, ← int.cast_coe_nat, ← int.cast_sub, ← int.cast_prod], - refine mul_nonneg (int.cast_nonneg.2 _) (zpow_nonneg (le_of_lt hx) _), - exact int_prod_range_nonneg _ _ (even_bit0 1) } -end - -/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` except `0` and `1`. -/ -lemma strict_convex_on_zpow {m : ℤ} (hm₀ : m ≠ 0) (hm₁ : m ≠ 1) : - strict_convex_on ℝ (Ioi 0) (λ x : ℝ, x^m) := -begin - have : ∀ n : ℤ, differentiable_on ℝ (λ x, x ^ n) (Ioi (0 : ℝ)), - from λ n, differentiable_on_zpow _ _ (or.inl $ lt_irrefl _), - apply strict_convex_on_of_deriv2_pos (convex_Ioi 0), - { exact (this _).continuous_on }, - all_goals { rw interior_Ioi }, - { exact this _ }, - intros x hx, - simp only [iter_deriv_zpow, ← int.cast_coe_nat, ← int.cast_sub, ← int.cast_prod], - refine mul_pos (int.cast_pos.2 _) (zpow_pos_of_pos hx _), - refine int_prod_range_pos (even_bit0 1) (λ hm, _), - norm_cast at hm, - rw ←finset.coe_Ico at hm, - fin_cases hm, - { exact hm₀ rfl }, - { exact hm₁ rfl } -end - -lemma convex_on_rpow {p : ℝ} (hp : 1 ≤ p) : convex_on ℝ (Ici 0) (λ x : ℝ, x^p) := -begin - have A : deriv (λ (x : ℝ), x ^ p) = λ x, p * x^(p-1), by { ext x, simp [hp] }, - apply convex_on_of_deriv2_nonneg (convex_Ici 0), - { exact continuous_on_id.rpow_const (λ x _, or.inr (zero_le_one.trans hp)) }, - { exact (differentiable_rpow_const hp).differentiable_on }, - { rw A, - assume x hx, - replace hx : x ≠ 0, by { simp at hx, exact ne_of_gt hx }, - simp [differentiable_at.differentiable_within_at, hx] }, - { assume x hx, - replace hx : 0 < x, by simpa using hx, - suffices : 0 ≤ p * ((p - 1) * x ^ (p - 1 - 1)), by simpa [ne_of_gt hx, A], - apply mul_nonneg (le_trans zero_le_one hp), - exact mul_nonneg (sub_nonneg_of_le hp) (rpow_nonneg_of_nonneg hx.le _) } -end - -lemma strict_convex_on_rpow {p : ℝ} (hp : 1 < p) : strict_convex_on ℝ (Ici 0) (λ x : ℝ, x^p) := -begin - have A : deriv (λ (x : ℝ), x ^ p) = λ x, p * x^(p-1), by { ext x, simp [hp.le] }, - apply strict_convex_on_of_deriv2_pos (convex_Ici 0), - { exact continuous_on_id.rpow_const (λ x _, or.inr (zero_le_one.trans hp.le)) }, - { exact (differentiable_rpow_const hp.le).differentiable_on }, - rw interior_Ici, - rintro x (hx : 0 < x), - suffices : 0 < p * ((p - 1) * x ^ (p - 1 - 1)), by simpa [ne_of_gt hx, A], - exact mul_pos (zero_lt_one.trans hp) (mul_pos (sub_pos_of_lt hp) (rpow_pos_of_pos hx _)), -end - -lemma strict_concave_on_log_Ioi : strict_concave_on ℝ (Ioi 0) log := -begin - have h₁ : Ioi 0 ⊆ ({0} : set ℝ)ᶜ, - { exact λ x (hx : 0 < x) (hx' : x = 0), hx.ne' hx' }, - refine strict_concave_on_open_of_deriv2_neg (convex_Ioi 0) is_open_Ioi - (differentiable_on_log.mono h₁) (λ x (hx : 0 < x), _), - rw [function.iterate_succ, function.iterate_one], - change (deriv (deriv log)) x < 0, - rw [deriv_log', deriv_inv], - exact neg_neg_of_pos (inv_pos.2 $ sq_pos_of_ne_zero _ hx.ne'), -end - -lemma strict_concave_on_log_Iio : strict_concave_on ℝ (Iio 0) log := -begin - have h₁ : Iio 0 ⊆ ({0} : set ℝ)ᶜ, - { exact λ x (hx : x < 0) (hx' : x = 0), hx.ne hx' }, - refine strict_concave_on_open_of_deriv2_neg (convex_Iio 0) is_open_Iio - (differentiable_on_log.mono h₁) (λ x (hx : x < 0), _), - rw [function.iterate_succ, function.iterate_one], - change (deriv (deriv log)) x < 0, - rw [deriv_log', deriv_inv], - exact neg_neg_of_pos (inv_pos.2 $ sq_pos_of_ne_zero _ hx.ne), -end - -open_locale real - -lemma strict_concave_on_sin_Icc : strict_concave_on ℝ (Icc 0 π) sin := -begin - apply strict_concave_on_of_deriv2_neg (convex_Icc _ _) continuous_on_sin - differentiable_sin.differentiable_on (λ x hx, _), - rw interior_Icc at hx, - simp [sin_pos_of_mem_Ioo hx], -end - -lemma strict_concave_on_cos_Icc : strict_concave_on ℝ (Icc (-(π/2)) (π/2)) cos := -begin - apply strict_concave_on_of_deriv2_neg (convex_Icc _ _) continuous_on_cos - differentiable_cos.differentiable_on (λ x hx, _), - rw interior_Icc at hx, - simp [cos_pos_of_mem_Ioo hx], -end diff --git a/src/analysis/convex/specific_functions/basic.lean b/src/analysis/convex/specific_functions/basic.lean new file mode 100644 index 0000000000000..e79cfe707bc79 --- /dev/null +++ b/src/analysis/convex/specific_functions/basic.lean @@ -0,0 +1,285 @@ +/- +Copyright (c) 2020 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Sébastien Gouëzel, Heather Macbeth +-/ +import analysis.convex.slope +import analysis.special_functions.pow.real +import tactic.linear_combination + +/-! +# Collection of convex functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that the following functions are convex or strictly convex: + +* `strict_convex_on_exp` : The exponential function is strictly convex. +* `even.convex_on_pow`: For an even `n : ℕ`, `λ x, x ^ n` is convex. +* `convex_on_pow`: For `n : ℕ`, `λ x, x ^ n` is convex on $[0, +∞)$. +* `convex_on_zpow`: For `m : ℤ`, `λ x, x ^ m` is convex on $[0, +∞)$. +* `strict_concave_on_log_Ioi`, `strict_concave_on_log_Iio`: `real.log` is strictly concave on + $(0, +∞)$ and $(-∞, 0)$ respectively. +* `convex_on_rpow`, `strict_convex_on_rpow` : For `p : ℝ`, `λ x, x ^ p` is convex on $[0, +∞)$ when + `1 ≤ p` and strictly convex when `1 < p`. + +The proofs in this file are deliberately elementary, *not* by appealing to the sign of the second +derivative. This is in order to keep this file early in the import hierarchy, since it is on the +path to Hölder's and Minkowski's inequalities and after that to Lp spaces and most of measure +theory. + +## TODO + +For `p : ℝ`, prove that `λ x, x ^ p` is concave when `0 ≤ p ≤ 1` and strictly concave when +`0 < p < 1`. +-/ + +open real set +open_locale big_operators nnreal + +/-- `exp` is strictly convex on the whole real line. + +We give an elementary proof rather than using the second derivative test, since this lemma is +needed early in the analysis library. -/ +lemma strict_convex_on_exp : strict_convex_on ℝ univ exp := +begin + apply strict_convex_on_of_slope_strict_mono_adjacent convex_univ, + rintros x y z - - hxy hyz, + transitivity exp y, + { have h1 : 0 < y - x := by linarith, + have h2 : x - y < 0 := by linarith, + rw div_lt_iff h1, + calc exp y - exp x = exp y - exp y * exp (x - y) : by rw ← exp_add; ring_nf + ... = exp y * (1 - exp (x - y)) : by ring + ... < exp y * (-(x - y)) : mul_lt_mul_of_pos_left _ y.exp_pos + ... = exp y * (y - x) : by ring, + linarith [add_one_lt_exp_of_nonzero h2.ne] }, + { have h1 : 0 < z - y := by linarith, + rw lt_div_iff h1, + calc exp y * (z - y) < exp y * (exp (z - y) - 1) : mul_lt_mul_of_pos_left _ y.exp_pos + ... = exp (z - y) * exp y - exp y : by ring + ... ≤ exp z - exp y : by rw ← exp_add; ring_nf, + linarith [add_one_lt_exp_of_nonzero h1.ne'] }, +end + +/-- `exp` is convex on the whole real line. -/ +lemma convex_on_exp : convex_on ℝ univ exp := strict_convex_on_exp.convex_on + +/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n`. + +We give an elementary proof rather than using the second derivative test, since this lemma is +needed early in the analysis library. -/ +lemma convex_on_pow (n : ℕ) : convex_on ℝ (Ici 0) (λ x : ℝ, x^n) := +begin + induction n with k IH, + { exact convex_on_const (1:ℝ) (convex_Ici _) }, + refine ⟨convex_Ici _, _⟩, + rintros a (ha : 0 ≤ a) b (hb : 0 ≤ b) μ ν hμ hν h, + have H := IH.2 ha hb hμ hν h, + have : 0 ≤ (b ^ k - a ^ k) * (b - a) * μ * ν, + { cases le_or_lt a b with hab hab, + { have : a ^ k ≤ b ^ k := pow_le_pow_of_le_left ha hab k, + have : 0 ≤ (b ^ k - a ^ k) * (b - a) := by nlinarith, + positivity, }, + { have : b ^ k ≤ a ^ k := pow_le_pow_of_le_left hb hab.le k, + have : 0 ≤ (b ^ k - a ^ k) * (b - a) := by nlinarith, + positivity, } }, + calc (μ * a + ν * b) ^ k.succ = (μ * a + ν * b) * (μ * a + ν * b) ^ k : by ring_exp + ... ≤ (μ * a + ν * b) * (μ * a ^ k + ν * b ^ k) : mul_le_mul_of_nonneg_left H (by positivity) + ... ≤ (μ * a + ν * b) * (μ * a ^ k + ν * b ^ k) + (b ^ k - a ^ k) * (b - a) * μ * ν : by linarith + ... = (μ + ν) * (μ * a ^ k.succ + ν * b ^ k.succ) : by ring_exp + ... = μ * a ^ k.succ + ν * b ^ k.succ : by rw h; ring_exp, +end + +/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even. + +We give an elementary proof rather than using the second derivative test, since this lemma is +needed early in the analysis library. -/ +lemma even.convex_on_pow {n : ℕ} (hn : even n) : convex_on ℝ set.univ (λ x : ℝ, x^n) := +begin + refine ⟨convex_univ, _⟩, + intros a ha b hb μ ν hμ hν h, + obtain ⟨k, rfl⟩ := hn.exists_two_nsmul _, + have : 0 ≤ (a - b) ^ 2 * μ * ν := by positivity, + calc (μ * a + ν * b) ^ (2 * k) = ((μ * a + ν * b) ^ 2) ^ k : by rw pow_mul + ... ≤ ((μ + ν) * (μ * a ^ 2 + ν * b ^ 2)) ^ k : pow_le_pow_of_le_left (by positivity) _ k + ... = (μ * a ^ 2 + ν * b ^ 2) ^ k : by rw h; ring_exp + ... ≤ μ * (a ^ 2) ^ k + ν * (b ^ 2) ^ k : _ + ... ≤ μ * a ^ (2 * k) + ν * b ^ (2 * k) : by ring_exp, + { linarith }, + { refine (convex_on_pow k).2 _ _ hμ hν h; dsimp; positivity }, +end + +/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m`. + +We give an elementary proof rather than using the second derivative test, since this lemma is +needed early in the analysis library. -/ +lemma convex_on_zpow : ∀ m : ℤ, convex_on ℝ (Ioi 0) (λ x : ℝ, x^m) +| (n : ℕ) := +begin + simp_rw zpow_coe_nat, + exact (convex_on_pow n).subset Ioi_subset_Ici_self (convex_Ioi _) +end +| -[1+ n] := +begin + simp_rw zpow_neg_succ_of_nat, + refine ⟨convex_Ioi _, _⟩, + rintros a (ha : 0 < a) b (hb : 0 < b) μ ν hμ hν h, + have ha' : 0 < a ^ (n + 1) := by positivity, + have hb' : 0 < b ^ (n + 1) := by positivity, + field_simp [ha.ne', hb.ne', ha'.ne', hb'.ne'], + rw div_le_div_iff, + { calc 1 * (a ^ (n + 1) * b ^ (n + 1)) + = ((μ + ν) ^ 2 * (a * b)) ^ (n + 1) : by rw h; ring_exp + ... ≤ ((μ * b + ν * a) * (μ * a + ν * b)) ^ (n + 1) : pow_le_pow_of_le_left _ _ _ + ... = (μ * b + ν * a) ^ (n + 1) * (μ * a + ν * b) ^ (n + 1) : by rw mul_pow + ... ≤ (μ * b ^ (n + 1) + ν * a ^ (n + 1)) * (μ * a + ν * b) ^ (n + 1) : _, + { positivity }, + { have : 0 ≤ μ * ν * (a - b) ^ 2 := by positivity, + linarith }, + { apply mul_le_mul_of_nonneg_right ((convex_on_pow (n + 1)).2 hb.le ha.le hμ hν h), + positivity } }, + { have : 0 < μ * a + ν * b := by cases le_or_lt a b; nlinarith, + positivity }, + { positivity }, +end + +/- `real.log` is strictly concave on $(0, +∞)$. + +We give an elementary proof rather than using the second derivative test, since this lemma is +needed early in the analysis library. -/ +lemma strict_concave_on_log_Ioi : strict_concave_on ℝ (Ioi 0) log := +begin + apply strict_concave_on_of_slope_strict_anti_adjacent (convex_Ioi (0:ℝ)), + rintros x y z (hx : 0 < x) (hz : 0 < z) hxy hyz, + have hy : 0 < y := hx.trans hxy, + transitivity y⁻¹, + { have h : 0 < z - y := by linarith, + rw div_lt_iff h, + have hyz' : 0 < z / y := by positivity, + have hyz'' : z / y ≠ 1, + { contrapose! h, + rw div_eq_one_iff_eq hy.ne' at h, + simp [h] }, + calc log z - log y = log (z / y) : by rw ← log_div hz.ne' hy.ne' + ... < z / y - 1 : log_lt_sub_one_of_pos hyz' hyz'' + ... = y⁻¹ * (z - y) : by field_simp [hy.ne'] }, + { have h : 0 < y - x := by linarith, + rw lt_div_iff h, + have hxy' : 0 < x / y := by positivity, + have hxy'' : x / y ≠ 1, + { contrapose! h, + rw div_eq_one_iff_eq hy.ne' at h, + simp [h] }, + calc y⁻¹ * (y - x) = 1 - x / y : by field_simp [hy.ne'] + ... < - log (x / y) : by linarith [log_lt_sub_one_of_pos hxy' hxy''] + ... = - (log x - log y) : by rw log_div hx.ne' hy.ne' + ... = log y - log x : by ring }, +end + +/-- **Bernoulli's inequality** for real exponents, strict version: for `1 < p` and `-1 ≤ s`, with +`s ≠ 0`, we have `1 + p * s < (1 + s) ^ p`. -/ +lemma one_add_mul_self_lt_rpow_one_add {s : ℝ} (hs : -1 ≤ s) (hs' : s ≠ 0) {p : ℝ} (hp : 1 < p) : + 1 + p * s < (1 + s) ^ p := +begin + rcases eq_or_lt_of_le hs with rfl | hs, + { have : p ≠ 0 := by positivity, + simpa [zero_rpow this], }, + have hs1 : 0 < 1 + s := by linarith, + cases le_or_lt (1 + p * s) 0 with hs2 hs2, + { exact hs2.trans_lt (rpow_pos_of_pos hs1 _) }, + rw [rpow_def_of_pos hs1, ← exp_log hs2], + apply exp_strict_mono, + have hp : 0 < p := by positivity, + have hs3 : 1 + s ≠ 1 := by contrapose! hs'; linarith, + have hs4 : 1 + p * s ≠ 1 := by contrapose! hs'; nlinarith, + cases lt_or_gt_of_ne hs' with hs' hs', + { rw [← div_lt_iff hp, ← div_lt_div_right_of_neg hs'], + convert strict_concave_on_log_Ioi.secant_strict_mono zero_lt_one hs2 hs1 hs4 hs3 _ using 1, + { field_simp [log_one] }, + { field_simp [log_one] }, + { nlinarith } }, + { rw [← div_lt_iff hp, ← div_lt_div_right hs'], + convert strict_concave_on_log_Ioi.secant_strict_mono zero_lt_one hs1 hs2 hs3 hs4 _ using 1, + { field_simp [log_one, hp.ne'], }, + { field_simp [log_one] }, + { nlinarith } }, +end + +/-- **Bernoulli's inequality** for real exponents, non-strict version: for `1 ≤ p` and `-1 ≤ s` +we have `1 + p * s ≤ (1 + s) ^ p`. -/ +lemma one_add_mul_self_le_rpow_one_add {s : ℝ} (hs : -1 ≤ s) {p : ℝ} (hp : 1 ≤ p) : + 1 + p * s ≤ (1 + s) ^ p := +begin + rcases eq_or_lt_of_le hp with rfl | hp, + { simp }, + by_cases hs' : s = 0, + { simp [hs'] }, + exact (one_add_mul_self_lt_rpow_one_add hs hs' hp).le, +end + +/- For `p : ℝ` with `1 < p`, `λ x, x ^ p` is strictly convex on $[0, +∞)$. + +We give an elementary proof rather than using the second derivative test, since this lemma is +needed early in the analysis library. -/ +lemma strict_convex_on_rpow {p : ℝ} (hp : 1 < p) : strict_convex_on ℝ (Ici 0) (λ x : ℝ, x^p) := +begin + apply strict_convex_on_of_slope_strict_mono_adjacent (convex_Ici (0:ℝ)), + rintros x y z (hx : 0 ≤ x) (hz : 0 ≤ z) hxy hyz, + have hy : 0 < y := by linarith, + have hy' : 0 < y ^ p := rpow_pos_of_pos hy _, + have H1 : y ^ ((p - 1) + 1) = y ^ (p - 1) * y := rpow_add_one hy.ne' _, + ring_nf at H1, + transitivity p * y ^ (p - 1), + { have hyx' : x - y < 0 := by linarith only [hxy], + have h3 : 0 < y - x := by linarith only [hxy], + have hyx'' : x / y < 1 := by rwa div_lt_one hy, + have hyx''' : x / y - 1 < 0 := by linarith only [hyx''], + have hyx'''' : 0 ≤ x / y := by positivity, + have hyx''''' : -1 ≤ x / y - 1 := by linarith only [hyx''''], + have : 1 - (1 + ((x / y) - 1)) ^ p < - p * ((x / y) - 1), + { linarith [one_add_mul_self_lt_rpow_one_add hyx''''' hyx'''.ne hp] }, + rw [div_lt_iff h3, ← div_lt_div_right hy'], + convert this using 1, + { have H : (x / y) ^ p = x ^ p / y ^ p := div_rpow hx hy.le _, + ring_nf at ⊢ H, + field_simp [hy.ne', hy'.ne'] at ⊢ H, + linear_combination H }, + { field_simp [hy.ne', hy'.ne'], + linear_combination p * (-y + x) * H1 }, }, + { have hyz' : 0 < z - y := by linarith only [hyz], + have hyz'' : 1 < z / y := by rwa one_lt_div hy, + have hyz''' : 0 < z / y - 1 := by linarith only [hyz''], + have hyz'''' : -1 ≤ z / y - 1 := by linarith only [hyz''], + have : p * ((z / y) - 1) < (1 + ((z / y) - 1)) ^ p - 1, + { linarith [one_add_mul_self_lt_rpow_one_add hyz'''' hyz'''.ne' hp] }, + rw [lt_div_iff hyz', ← div_lt_div_right hy'], + convert this using 1, + { field_simp [hy.ne', hy'.ne'], + linear_combination - p * (z - y) * H1, }, + { have H : (z / y) ^ p = z ^ p / y ^ p := div_rpow hz hy.le _, + ring_nf at ⊢ H, + field_simp [hy.ne', hy'.ne'] at ⊢ H, + linear_combination -H } }, +end + +lemma convex_on_rpow {p : ℝ} (hp : 1 ≤ p) : convex_on ℝ (Ici 0) (λ x : ℝ, x^p) := +begin + rcases eq_or_lt_of_le hp with rfl | hp, + { simpa using convex_on_id (convex_Ici _), }, + exact (strict_convex_on_rpow hp).convex_on, +end + +lemma strict_concave_on_log_Iio : strict_concave_on ℝ (Iio 0) log := +begin + refine ⟨convex_Iio _, _⟩, + rintros x (hx : x < 0) y (hy : y < 0) hxy a b ha hb hab, + have hx' : 0 < -x := by linarith, + have hy' : 0 < -y := by linarith, + have hxy' : - x ≠ - y := by contrapose! hxy; linarith, + calc a • log x + b • log y = a • log (-x) + b • log (-y) : by simp_rw [log_neg_eq_log] + ... < log (a • (-x) + b • (-y)) : strict_concave_on_log_Ioi.2 hx' hy' hxy' ha hb hab + ... = log (- (a • x + b • y)) : by congr' 1; simp only [algebra.id.smul_eq_mul]; ring + ... = _ : by rw log_neg_eq_log, +end diff --git a/src/analysis/convex/specific_functions/deriv.lean b/src/analysis/convex/specific_functions/deriv.lean new file mode 100644 index 0000000000000..60aa49399d058 --- /dev/null +++ b/src/analysis/convex/specific_functions/deriv.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2020 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Sébastien Gouëzel +-/ +import analysis.calculus.deriv.zpow +import analysis.special_functions.pow.deriv +import analysis.special_functions.sqrt + +/-! +# Collection of convex functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that certain specific functions are strictly convex, including the following: + +* `even.strict_convex_on_pow` : For an even `n : ℕ` with `2 ≤ n`, `λ x, x ^ n` is strictly convex. +* `strict_convex_on_pow` : For `n : ℕ`, with `2 ≤ n`, `λ x, x ^ n` is strictly convex on $[0, +∞)$. +* `strict_convex_on_zpow` : For `m : ℤ` with `m ≠ 0, 1`, `λ x, x ^ m` is strictly convex on + $[0, +∞)$. +* `strict_concave_on_sin_Icc` : `sin` is strictly concave on $[0, π]$ +* `strict_concave_on_cos_Icc` : `cos` is strictly concave on $[-π/2, π/2]$ + +## TODO + +These convexity lemmas are proved by checking the sign of the second derivative. If desired, most +of these could also be switched to elementary proofs, like in +`analysis.convex.specific_functions.basic`. + +-/ + +open real set +open_locale big_operators nnreal + +/-- `x^n`, `n : ℕ` is strictly convex on `[0, +∞)` for all `n` greater than `2`. -/ +lemma strict_convex_on_pow {n : ℕ} (hn : 2 ≤ n) : strict_convex_on ℝ (Ici 0) (λ x : ℝ, x^n) := +begin + apply strict_mono_on.strict_convex_on_of_deriv (convex_Ici _) (continuous_on_pow _), + rw [deriv_pow', interior_Ici], + exact λ x (hx : 0 < x) y hy hxy, mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_left hxy hx.le $ + nat.sub_pos_of_lt hn) (nat.cast_pos.2 $ zero_lt_two.trans_le hn), +end + +/-- `x^n`, `n : ℕ` is strictly convex on the whole real line whenever `n ≠ 0` is even. -/ +lemma even.strict_convex_on_pow {n : ℕ} (hn : even n) (h : n ≠ 0) : + strict_convex_on ℝ set.univ (λ x : ℝ, x^n) := +begin + apply strict_mono.strict_convex_on_univ_of_deriv (continuous_pow n), + rw deriv_pow', + replace h := nat.pos_of_ne_zero h, + exact strict_mono.const_mul (odd.strict_mono_pow $ nat.even.sub_odd h hn $ nat.odd_iff.2 rfl) + (nat.cast_pos.2 h), +end + +lemma finset.prod_nonneg_of_card_nonpos_even + {α β : Type*} [linear_ordered_comm_ring β] + {f : α → β} [decidable_pred (λ x, f x ≤ 0)] + {s : finset α} (h0 : even (s.filter (λ x, f x ≤ 0)).card) : + 0 ≤ ∏ x in s, f x := +calc 0 ≤ (∏ x in s, ((if f x ≤ 0 then (-1:β) else 1) * f x)) : + finset.prod_nonneg (λ x _, by + { split_ifs with hx hx, by simp [hx], simp at hx ⊢, exact le_of_lt hx }) +... = _ : by rw [finset.prod_mul_distrib, finset.prod_ite, finset.prod_const_one, + mul_one, finset.prod_const, neg_one_pow_eq_pow_mod_two, nat.even_iff.1 h0, pow_zero, one_mul] + +lemma int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : even n) : + 0 ≤ ∏ k in finset.range n, (m - k) := +begin + rcases hn with ⟨n, rfl⟩, + induction n with n ihn, { simp }, + rw ← two_mul at ihn, + rw [← two_mul, nat.succ_eq_add_one, mul_add, mul_one, bit0, ← add_assoc, finset.prod_range_succ, + finset.prod_range_succ, mul_assoc], + refine mul_nonneg ihn _, generalize : (1 + 1) * n = k, + cases le_or_lt m k with hmk hmk, + { have : m ≤ k + 1, from hmk.trans (lt_add_one ↑k).le, + convert mul_nonneg_of_nonpos_of_nonpos (sub_nonpos_of_le hmk) _, + convert sub_nonpos_of_le this }, + { exact mul_nonneg (sub_nonneg_of_le hmk.le) (sub_nonneg_of_le hmk) } +end + +lemma int_prod_range_pos {m : ℤ} {n : ℕ} (hn : even n) (hm : m ∉ Ico (0 : ℤ) n) : + 0 < ∏ k in finset.range n, (m - k) := +begin + refine (int_prod_range_nonneg m n hn).lt_of_ne (λ h, hm _), + rw [eq_comm, finset.prod_eq_zero_iff] at h, + obtain ⟨a, ha, h⟩ := h, + rw sub_eq_zero.1 h, + exact ⟨int.coe_zero_le _, int.coe_nat_lt.2 $ finset.mem_range.1 ha⟩, +end + +/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` except `0` and `1`. -/ +lemma strict_convex_on_zpow {m : ℤ} (hm₀ : m ≠ 0) (hm₁ : m ≠ 1) : + strict_convex_on ℝ (Ioi 0) (λ x : ℝ, x^m) := +begin + apply strict_convex_on_of_deriv2_pos' (convex_Ioi 0), + { exact (continuous_on_zpow₀ m).mono (λ x hx, ne_of_gt hx) }, + intros x hx, + rw iter_deriv_zpow, + refine mul_pos _ (zpow_pos_of_pos hx _), + exact_mod_cast int_prod_range_pos (even_bit0 1) (λ hm, _), + norm_cast at hm, + rw ← finset.coe_Ico at hm, + fin_cases hm; cc, +end + +section sqrt_mul_log + +lemma has_deriv_at_sqrt_mul_log {x : ℝ} (hx : x ≠ 0) : + has_deriv_at (λ x, sqrt x * log x) ((2 + log x) / (2 * sqrt x)) x := +begin + convert (has_deriv_at_sqrt hx).mul (has_deriv_at_log hx), + rw [add_div, div_mul_right (sqrt x) two_ne_zero, ←div_eq_mul_inv, sqrt_div_self', + add_comm, div_eq_mul_one_div, mul_comm], +end + +lemma deriv_sqrt_mul_log (x : ℝ) : deriv (λ x, sqrt x * log x) x = (2 + log x) / (2 * sqrt x) := +begin + cases lt_or_le 0 x with hx hx, + { exact (has_deriv_at_sqrt_mul_log hx.ne').deriv }, + { rw [sqrt_eq_zero_of_nonpos hx, mul_zero, div_zero], + refine has_deriv_within_at.deriv_eq_zero _ (unique_diff_on_Iic 0 x hx), + refine (has_deriv_within_at_const x _ 0).congr_of_mem (λ x hx, _) hx, + rw [sqrt_eq_zero_of_nonpos hx, zero_mul] }, +end + +lemma deriv_sqrt_mul_log' : deriv (λ x, sqrt x * log x) = λ x, (2 + log x) / (2 * sqrt x) := +funext deriv_sqrt_mul_log + +lemma deriv2_sqrt_mul_log (x : ℝ) : + deriv^[2] (λ x, sqrt x * log x) x = -log x / (4 * sqrt x ^ 3) := +begin + simp only [nat.iterate, deriv_sqrt_mul_log'], + cases le_or_lt x 0 with hx hx, + { rw [sqrt_eq_zero_of_nonpos hx, zero_pow zero_lt_three, mul_zero, div_zero], + refine has_deriv_within_at.deriv_eq_zero _ (unique_diff_on_Iic 0 x hx), + refine (has_deriv_within_at_const _ _ 0).congr_of_mem (λ x hx, _) hx, + rw [sqrt_eq_zero_of_nonpos hx, mul_zero, div_zero] }, + { have h₀ : sqrt x ≠ 0, from sqrt_ne_zero'.2 hx, + convert (((has_deriv_at_log hx.ne').const_add 2).div + ((has_deriv_at_sqrt hx.ne').const_mul 2) $ mul_ne_zero two_ne_zero h₀).deriv using 1, + nth_rewrite 2 [← mul_self_sqrt hx.le], + field_simp, ring }, +end + +lemma strict_concave_on_sqrt_mul_log_Ioi : strict_concave_on ℝ (set.Ioi 1) (λ x, sqrt x * log x) := +begin + apply strict_concave_on_of_deriv2_neg' (convex_Ioi 1) _ (λ x hx, _), + { exact continuous_sqrt.continuous_on.mul + (continuous_on_log.mono (λ x hx, ne_of_gt (zero_lt_one.trans hx))) }, + { rw [deriv2_sqrt_mul_log x], + exact div_neg_of_neg_of_pos (neg_neg_of_pos (log_pos hx)) + (mul_pos four_pos (pow_pos (sqrt_pos.mpr (zero_lt_one.trans hx)) 3)) }, +end + +end sqrt_mul_log + +open_locale real + +lemma strict_concave_on_sin_Icc : strict_concave_on ℝ (Icc 0 π) sin := +begin + apply strict_concave_on_of_deriv2_neg (convex_Icc _ _) continuous_on_sin (λ x hx, _), + rw interior_Icc at hx, + simp [sin_pos_of_mem_Ioo hx], +end + +lemma strict_concave_on_cos_Icc : strict_concave_on ℝ (Icc (-(π/2)) (π/2)) cos := +begin + apply strict_concave_on_of_deriv2_neg (convex_Icc _ _) continuous_on_cos (λ x hx, _), + rw interior_Icc at hx, + simp [cos_pos_of_mem_Ioo hx], +end diff --git a/src/analysis/convex/star.lean b/src/analysis/convex/star.lean index 9701796bbe1c7..6544563a61111 100644 --- a/src/analysis/convex/star.lean +++ b/src/analysis/convex/star.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import analysis.convex.basic +import analysis.convex.segment /-! # Star-convex sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This files defines star-convex sets (aka star domains, star-shaped set, radially convex set). A set is star-convex at `x` if every segment from `x` to a point in the set is contained in the set. @@ -44,7 +47,7 @@ A nonempty open star-convex set in `ℝ^n` is diffeomorphic to the entire space. open set open_locale convex pointwise -variables {𝕜 E F β : Type*} +variables {𝕜 E F : Type*} section ordered_semiring variables [ordered_semiring 𝕜] @@ -52,8 +55,8 @@ variables [ordered_semiring 𝕜] section add_comm_monoid variables [add_comm_monoid E] [add_comm_monoid F] -section has_scalar -variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 F] (x : E) (s : set E) +section has_smul +variables (𝕜) [has_smul 𝕜 E] [has_smul 𝕜 F] (x : E) (s : set E) /-- Star-convexity of sets. `s` is star-convex at `x` if every segment from `x` to a point in `s` is contained in `s`. -/ @@ -62,12 +65,6 @@ def star_convex : Prop := variables {𝕜 x s} {t : set E} -lemma convex_iff_forall_star_convex : convex 𝕜 s ↔ ∀ x ∈ s, star_convex 𝕜 x s := -forall_congr $ λ x, forall_swap - -lemma convex.star_convex (h : convex 𝕜 s) (hx : x ∈ s) : star_convex 𝕜 x s := -convex_iff_forall_star_convex.1 h _ hx - lemma star_convex_iff_segment_subset : star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → [x -[𝕜] y] ⊆ s := begin split, @@ -140,12 +137,12 @@ lemma star_convex.prod {y : F} {s : set E} {t : set F} (hs : star_convex 𝕜 x λ y hy a b ha hb hab, ⟨hs hy.1 ha hb hab, ht hy.2 ha hb hab⟩ lemma star_convex_pi {ι : Type*} {E : ι → Type*} [Π i, add_comm_monoid (E i)] - [Π i, has_scalar 𝕜 (E i)] {x : Π i, E i} {s : set ι} {t : Π i, set (E i)} - (ht : ∀ i, star_convex 𝕜 (x i) (t i)) : + [Π i, has_smul 𝕜 (E i)] {x : Π i, E i} {s : set ι} {t : Π i, set (E i)} + (ht : ∀ ⦃i⦄, i ∈ s → star_convex 𝕜 (x i) (t i)) : star_convex 𝕜 x (s.pi t) := -λ y hy a b ha hb hab i hi, ht i (hy i hi) ha hb hab +λ y hy a b ha hb hab i hi, ht hi (hy i hi) ha hb hab -end has_scalar +end has_smul section module variables [module 𝕜 E] [module 𝕜 F] {x y z : E} {s : set E} @@ -157,9 +154,6 @@ begin rw [one_smul, zero_smul, add_zero], end -lemma convex.star_convex_iff (hs : convex 𝕜 s) (h : s.nonempty) : star_convex 𝕜 x s ↔ x ∈ s := -⟨λ hxs, hxs.mem h, hs.star_convex⟩ - lemma star_convex_iff_forall_pos (hx : x ∈ s) : star_convex 𝕜 x s ↔ ∀ ⦃y⦄, y ∈ s → ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ s := begin @@ -270,7 +264,7 @@ end add_comm_monoid section add_comm_group variables [add_comm_group E] [module 𝕜 E] {x y : E} -lemma star_convex.sub {s : set (E × E)} (hs : star_convex 𝕜 (x, y) s) : +lemma star_convex.sub' {s : set (E × E)} (hs : star_convex 𝕜 (x, y) s) : star_convex 𝕜 (x - y) ((λ x : E × E, x.1 - x.2) '' s) := hs.is_linear_image is_linear_map.is_linear_map_sub @@ -310,16 +304,16 @@ lemma star_convex_zero_iff : star_convex 𝕜 0 s ↔ ∀ ⦃x : E⦄, x ∈ s → ∀ ⦃a : 𝕜⦄, 0 ≤ a → a ≤ 1 → a • x ∈ s := begin refine forall_congr (λ x, forall_congr $ λ hx, ⟨λ h a ha₀ ha₁, _, λ h a b ha hb hab, _⟩), - { simpa only [sub_add_cancel, eq_self_iff_true, forall_true_left, zero_add, smul_zero'] using + { simpa only [sub_add_cancel, eq_self_iff_true, forall_true_left, zero_add, smul_zero] using h (sub_nonneg_of_le ha₁) ha₀ }, - { rw [smul_zero', zero_add], + { rw [smul_zero, zero_add], exact h hb (by { rw ←hab, exact le_add_of_nonneg_left ha }) } end end add_comm_monoid section add_comm_group -variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {x y : E} {s : set E} +variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {x y : E} {s t : set E} lemma star_convex.add_smul_mem (hs : star_convex 𝕜 x s) (hy : x + y ∈ s) {t : 𝕜} (ht₀ : 0 ≤ t) (ht₁ : t ≤ 1) : @@ -363,11 +357,12 @@ begin rw [convex.combo_affine_apply hab, hy'f], end -lemma star_convex.neg (hs : star_convex 𝕜 x s) : star_convex 𝕜 (-x) ((λ z, -z) '' s) := -hs.is_linear_image is_linear_map.is_linear_map_neg +lemma star_convex.neg (hs : star_convex 𝕜 x s) : star_convex 𝕜 (-x) (-s) := +by { rw ←image_neg, exact hs.is_linear_image is_linear_map.is_linear_map_neg } -lemma star_convex.neg_preimage (hs : star_convex 𝕜 (-x) s) : star_convex 𝕜 x ((λ z, -z) ⁻¹' s) := -hs.is_linear_preimage is_linear_map.is_linear_map_neg +lemma star_convex.sub (hs : star_convex 𝕜 x s) (ht : star_convex 𝕜 y t) : + star_convex 𝕜 (x - y) (s - t) := +by { simp_rw sub_eq_add_neg, exact hs.add ht.neg } end add_comm_group end ordered_ring @@ -442,26 +437,8 @@ end lemma star_convex_iff_ord_connected [linear_ordered_field 𝕜] {x : 𝕜} {s : set 𝕜} (hx : x ∈ s) : star_convex 𝕜 x s ↔ s.ord_connected := -by simp_rw [ord_connected_iff_interval_subset_left hx, star_convex_iff_segment_subset, - segment_eq_interval] +by simp_rw [ord_connected_iff_uIcc_subset_left hx, star_convex_iff_segment_subset, segment_eq_uIcc] alias star_convex_iff_ord_connected ↔ star_convex.ord_connected _ end ord_connected - -/-! #### Star-convexity of submodules/subspaces -/ - -section submodule -open submodule - -lemma submodule.star_convex [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] - (K : submodule 𝕜 E) : - star_convex 𝕜 (0 : E) K := -K.convex.star_convex K.zero_mem - -lemma subspace.star_convex [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] - (K : subspace 𝕜 E) : - star_convex 𝕜 (0 : E) K := -K.convex.star_convex K.zero_mem - -end submodule diff --git a/src/analysis/convex/stone_separation.lean b/src/analysis/convex/stone_separation.lean new file mode 100644 index 0000000000000..903563a4ec4c8 --- /dev/null +++ b/src/analysis/convex/stone_separation.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import analysis.convex.join + +/-! +# Stone's separation theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file prove Stone's separation theorem. This tells us that any two disjoint convex sets can be +separated by a convex set whose complement is also convex. + +In locally convex real topological vector spaces, the Hahn-Banach separation theorems provide +stronger statements: one may find a separating hyperplane, instead of merely a convex set whose +complement is convex. +-/ + +open set +open_locale big_operators + +variables {𝕜 E ι : Type*} [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] {s t : set E} + +/-- In a tetrahedron with vertices `x`, `y`, `p`, `q`, any segment `[u, v]` joining the opposite +edges `[x, p]` and `[y, q]` passes through any triangle of vertices `p`, `q`, `z` where +`z ∈ [x, y]`. -/ +lemma not_disjoint_segment_convex_hull_triple {p q u v x y z : E} + (hz : z ∈ segment 𝕜 x y) (hu : u ∈ segment 𝕜 x p) (hv : v ∈ segment 𝕜 y q) : + ¬ disjoint (segment 𝕜 u v) (convex_hull 𝕜 {p, q, z}) := +begin + rw not_disjoint_iff, + obtain ⟨az, bz, haz, hbz, habz, rfl⟩ := hz, + obtain rfl | haz' := haz.eq_or_lt, + { rw zero_add at habz, + rw [zero_smul, zero_add, habz, one_smul], + refine ⟨v, right_mem_segment _ _ _, segment_subset_convex_hull _ _ hv⟩; simp }, + obtain ⟨av, bv, hav, hbv, habv, rfl⟩ := hv, + obtain rfl | hav' := hav.eq_or_lt, + { rw zero_add at habv, + rw [zero_smul, zero_add, habv, one_smul], + exact ⟨q, right_mem_segment _ _ _, subset_convex_hull _ _ $ by simp⟩ }, + obtain ⟨au, bu, hau, hbu, habu, rfl⟩ := hu, + have hab : 0 < az * av + bz * au := + add_pos_of_pos_of_nonneg (mul_pos haz' hav') (mul_nonneg hbz hau), + refine ⟨(az * av / (az * av + bz * au)) • (au • x + bu • p) + + (bz * au / (az * av + bz * au)) • (av • y + bv • q), ⟨_, _, _, _, _, rfl⟩, _⟩, + { exact div_nonneg (mul_nonneg haz hav) hab.le }, + { exact div_nonneg (mul_nonneg hbz hau) hab.le }, + { rw [←add_div, div_self hab.ne'] }, + rw [smul_add, smul_add, add_add_add_comm, add_comm, ←mul_smul, ←mul_smul], + classical, + let w : fin 3 → 𝕜 := ![az * av * bu, bz * au * bv, au * av], + let z : fin 3 → E := ![p, q, az • x + bz • y], + have hw₀ : ∀ i, 0 ≤ w i, + { rintro i, + fin_cases i, + { exact mul_nonneg (mul_nonneg haz hav) hbu }, + { exact mul_nonneg (mul_nonneg hbz hau) hbv }, + { exact mul_nonneg hau hav } }, + have hw : ∑ i, w i = az * av + bz * au, + { transitivity az * av * bu + (bz * au * bv + au * av), + { simp [w, fin.sum_univ_succ, fin.sum_univ_zero] }, + rw [←one_mul (au * av), ←habz, add_mul, ←add_assoc, add_add_add_comm, mul_assoc, ←mul_add, + mul_assoc, ←mul_add, mul_comm av, ←add_mul, ←mul_add, add_comm bu, add_comm bv, habu, habv, + one_mul, mul_one] }, + have hz : ∀ i, z i ∈ ({p, q, az • x + bz • y} : set E), + { rintro i, + fin_cases i; simp [z] }, + convert finset.center_mass_mem_convex_hull (finset.univ : finset (fin 3)) (λ i _, hw₀ i) + (by rwa hw) (λ i _, hz i), + rw finset.center_mass, + simp_rw [div_eq_inv_mul, hw, mul_assoc, mul_smul (az * av + bz * au)⁻¹, ←smul_add, add_assoc, + ←mul_assoc], + congr' 3, + rw [←mul_smul, ←mul_rotate, mul_right_comm, mul_smul, ←mul_smul _ av, mul_rotate, mul_smul _ bz, + ←smul_add], + simp only [list.map, list.pmap, nat.add_def, add_zero, fin.mk_bit0, + fin.mk_one, list.foldr_cons, list.foldr_nil], + refl, +end + +/-- **Stone's Separation Theorem** -/ +lemma exists_convex_convex_compl_subset (hs : convex 𝕜 s) (ht : convex 𝕜 t) (hst : disjoint s t) : + ∃ C : set E, convex 𝕜 C ∧ convex 𝕜 Cᶜ ∧ s ⊆ C ∧ t ⊆ Cᶜ := +begin + let S : set (set E) := {C | convex 𝕜 C ∧ disjoint C t}, + obtain ⟨C, hC, hsC, hCmax⟩ := zorn_subset_nonempty S + (λ c hcS hc ⟨t, ht⟩, ⟨⋃₀ c, ⟨hc.directed_on.convex_sUnion (λ s hs, (hcS hs).1), + disjoint_sUnion_left.2 $ λ c hc, (hcS hc).2⟩, λ s, subset_sUnion_of_mem⟩) s ⟨hs, hst⟩, + refine ⟨C, hC.1, convex_iff_segment_subset.2 $ λ x hx y hy z hz hzC, _, hsC, + hC.2.subset_compl_left⟩, + suffices h : ∀ c ∈ Cᶜ, ∃ a ∈ C, (segment 𝕜 c a ∩ t).nonempty, + { obtain ⟨p, hp, u, hu, hut⟩ := h x hx, + obtain ⟨q, hq, v, hv, hvt⟩ := h y hy, + refine not_disjoint_segment_convex_hull_triple hz hu hv + (hC.2.symm.mono (ht.segment_subset hut hvt) $ convex_hull_min _ hC.1), + simp [insert_subset, hp, hq, singleton_subset_iff.2 hzC] }, + rintro c hc, + by_contra' h, + suffices h : disjoint (convex_hull 𝕜 (insert c C)) t, + { rw ←hCmax _ ⟨convex_convex_hull _ _, h⟩ + ((subset_insert _ _).trans $ subset_convex_hull _ _) at hc, + exact hc (subset_convex_hull _ _ $ mem_insert _ _) }, + rw [convex_hull_insert ⟨z, hzC⟩, convex_join_singleton_left], + refine disjoint_Union₂_left.2 (λ a ha, disjoint_iff_inf_le.mpr $ λ b hb, h a _ ⟨b, hb⟩), + rwa ←hC.1.convex_hull_eq, +end diff --git a/src/analysis/convex/strict.lean b/src/analysis/convex/strict.lean index fae867240a565..8b9d0655d2936 100644 --- a/src/analysis/convex/strict.lean +++ b/src/analysis/convex/strict.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ import analysis.convex.basic -import topology.algebra.order.basic +import topology.algebra.order.group /-! # Strictly convex sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines strictly convex sets. A set is strictly convex if the open segment between any two distinct points lies in its interior. @@ -28,8 +31,8 @@ variables [ordered_semiring 𝕜] [topological_space E] [topological_space F] section add_comm_monoid variables [add_comm_monoid E] [add_comm_monoid F] -section has_scalar -variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 F] (s : set E) +section has_smul +variables (𝕜) [has_smul 𝕜 E] [has_smul 𝕜 F] (s : set E) /-- A set is strictly convex if the open segment between any two distinct points lies is in its interior. This basically means "convex and not flat on the boundary". -/ @@ -88,7 +91,7 @@ begin exact (directed_on_iff_directed.1 hdir).strict_convex_Union (λ s, hS _ s.2), end -end has_scalar +end has_smul section module variables [module 𝕜 E] [module 𝕜 F] {s : set E} @@ -97,11 +100,12 @@ protected lemma strict_convex.convex (hs : strict_convex 𝕜 s) : convex 𝕜 s convex_iff_pairwise_pos.2 $ λ x hx y hy hxy a b ha hb hab, interior_subset $ hs hx hy hxy ha hb hab /-- An open convex set is strictly convex. -/ -protected lemma convex.strict_convex (h : is_open s) (hs : convex 𝕜 s) : strict_convex 𝕜 s := +protected lemma convex.strict_convex_of_open (h : is_open s) (hs : convex 𝕜 s) : + strict_convex 𝕜 s := λ x hx y hy _ a b ha hb hab, h.interior_eq.symm ▸ hs hx hy ha.le hb.le hab lemma is_open.strict_convex_iff (h : is_open s) : strict_convex 𝕜 s ↔ convex 𝕜 s := -⟨strict_convex.convex, convex.strict_convex h⟩ +⟨strict_convex.convex, convex.strict_convex_of_open h⟩ lemma strict_convex_singleton (c : E) : strict_convex 𝕜 ({c} : set E) := pairwise_singleton _ _ @@ -141,40 +145,25 @@ section linear_ordered_cancel_add_comm_monoid variables [topological_space β] [linear_ordered_cancel_add_comm_monoid β] [order_topology β] [module 𝕜 β] [ordered_smul 𝕜 β] -lemma strict_convex_Iic (r : β) : strict_convex 𝕜 (Iic r) := +protected lemma set.ord_connected.strict_convex {s : set β} (hs : ord_connected s) : + strict_convex 𝕜 s := begin - rintro x (hx : x ≤ r) y (hy : y ≤ r) hxy a b ha hb hab, - refine (subset_interior_iff_subset_of_open is_open_Iio).2 Iio_subset_Iic_self _, - rw ←convex.combo_self hab r, - obtain rfl | hx := hx.eq_or_lt, - { exact add_lt_add_left (smul_lt_smul_of_pos (hy.lt_of_ne hxy.symm) hb) _ }, - obtain rfl | hy := hy.eq_or_lt, - { exact add_lt_add_right (smul_lt_smul_of_pos hx ha) _ }, - { exact add_lt_add (smul_lt_smul_of_pos hx ha) (smul_lt_smul_of_pos hy hb) } + refine strict_convex_iff_open_segment_subset.2 (λ x hx y hy hxy, _), + cases hxy.lt_or_lt with hlt hlt; [skip, rw [open_segment_symm]]; + exact (open_segment_subset_Ioo hlt).trans (is_open_Ioo.subset_interior_iff.2 $ + Ioo_subset_Icc_self.trans $ hs.out ‹_› ‹_›) end -lemma strict_convex_Ici (r : β) : strict_convex 𝕜 (Ici r) := @strict_convex_Iic 𝕜 βᵒᵈ _ _ _ _ _ _ r - -lemma strict_convex_Icc (r s : β) : strict_convex 𝕜 (Icc r s) := -(strict_convex_Ici r).inter $ strict_convex_Iic s - -lemma strict_convex_Iio (r : β) : strict_convex 𝕜 (Iio r) := -(convex_Iio r).strict_convex is_open_Iio - -lemma strict_convex_Ioi (r : β) : strict_convex 𝕜 (Ioi r) := -(convex_Ioi r).strict_convex is_open_Ioi - -lemma strict_convex_Ioo (r s : β) : strict_convex 𝕜 (Ioo r s) := -(strict_convex_Ioi r).inter $ strict_convex_Iio s - -lemma strict_convex_Ico (r s : β) : strict_convex 𝕜 (Ico r s) := -(strict_convex_Ici r).inter $ strict_convex_Iio s - -lemma strict_convex_Ioc (r s : β) : strict_convex 𝕜 (Ioc r s) := -(strict_convex_Ioi r).inter $ strict_convex_Iic s - -lemma strict_convex_interval (r s : β) : strict_convex 𝕜 (interval r s) := -strict_convex_Icc _ _ +lemma strict_convex_Iic (r : β) : strict_convex 𝕜 (Iic r) := ord_connected_Iic.strict_convex +lemma strict_convex_Ici (r : β) : strict_convex 𝕜 (Ici r) := ord_connected_Ici.strict_convex +lemma strict_convex_Iio (r : β) : strict_convex 𝕜 (Iio r) := ord_connected_Iio.strict_convex +lemma strict_convex_Ioi (r : β) : strict_convex 𝕜 (Ioi r) := ord_connected_Ioi.strict_convex +lemma strict_convex_Icc (r s : β) : strict_convex 𝕜 (Icc r s) := ord_connected_Icc.strict_convex +lemma strict_convex_Ioo (r s : β) : strict_convex 𝕜 (Ioo r s) := ord_connected_Ioo.strict_convex +lemma strict_convex_Ico (r s : β) : strict_convex 𝕜 (Ico r s) := ord_connected_Ico.strict_convex +lemma strict_convex_Ioc (r s : β) : strict_convex 𝕜 (Ioc r s) := ord_connected_Ioc.strict_convex +lemma strict_convex_uIcc (r s : β) : strict_convex 𝕜 (uIcc r s) := strict_convex_Icc _ _ +lemma strict_convex_uIoc (r s : β) : strict_convex 𝕜 (uIoc r s) := strict_convex_Ioc _ _ end linear_ordered_cancel_add_comm_monoid end module @@ -281,7 +270,7 @@ section ordered_ring variables [ordered_ring 𝕜] [topological_space E] [topological_space F] section add_comm_group -variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s : set E} {x y : E} +variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s t : set E} {x y : E} lemma strict_convex.eq_of_open_segment_subset_frontier [nontrivial 𝕜] [densely_ordered 𝕜] (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s) (h : open_segment 𝕜 x y ⊆ frontier s) : @@ -339,14 +328,15 @@ begin convex.combo_affine_apply hab⟩⟩, end -lemma strict_convex.neg [topological_add_group E] (hs : strict_convex 𝕜 s) : - strict_convex 𝕜 ((λ z, -z) '' s) := -hs.is_linear_image is_linear_map.is_linear_map_neg (homeomorph.neg E).is_open_map +variables [topological_add_group E] -lemma strict_convex.neg_preimage [topological_add_group E] (hs : strict_convex 𝕜 s) : - strict_convex 𝕜 ((λ z, -z) ⁻¹' s) := +lemma strict_convex.neg (hs : strict_convex 𝕜 s) : strict_convex 𝕜 (-s) := hs.is_linear_preimage is_linear_map.is_linear_map_neg continuous_id.neg neg_injective +lemma strict_convex.sub (hs : strict_convex 𝕜 s) (ht : strict_convex 𝕜 t) : + strict_convex 𝕜 (s - t) := +(sub_eq_add_neg s t).symm ▸ hs.add ht.neg + end add_comm_group end ordered_ring @@ -384,27 +374,13 @@ Relates `convex` and `set.ord_connected`. -/ section -variables [topological_space E] +variables [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜] {s : set 𝕜} /-- A set in a linear ordered field is strictly convex if and only if it is convex. -/ -@[simp] lemma strict_convex_iff_convex [linear_ordered_field 𝕜] [topological_space 𝕜] - [order_topology 𝕜] {s : set 𝕜} : - strict_convex 𝕜 s ↔ convex 𝕜 s := -begin - refine ⟨strict_convex.convex, λ hs, strict_convex_iff_open_segment_subset.2 (λ x hx y hy hxy, _)⟩, - obtain h | h := hxy.lt_or_lt, - { refine (open_segment_subset_Ioo h).trans _, - rw ←interior_Icc, - exact interior_mono (Icc_subset_segment.trans $ hs.segment_subset hx hy) }, - { rw open_segment_symm, - refine (open_segment_subset_Ioo h).trans _, - rw ←interior_Icc, - exact interior_mono (Icc_subset_segment.trans $ hs.segment_subset hy hx) } -end +@[simp] lemma strict_convex_iff_convex : strict_convex 𝕜 s ↔ convex 𝕜 s := +⟨strict_convex.convex, λ hs, hs.ord_connected.strict_convex⟩ -lemma strict_convex_iff_ord_connected [linear_ordered_field 𝕜] [topological_space 𝕜] - [order_topology 𝕜] {s : set 𝕜} : - strict_convex 𝕜 s ↔ s.ord_connected := +lemma strict_convex_iff_ord_connected : strict_convex 𝕜 s ↔ s.ord_connected := strict_convex_iff_convex.trans convex_iff_ord_connected alias strict_convex_iff_ord_connected ↔ strict_convex.ord_connected _ diff --git a/src/analysis/convex/strict_convex_between.lean b/src/analysis/convex/strict_convex_between.lean new file mode 100644 index 0000000000000..0cfcd2f643848 --- /dev/null +++ b/src/analysis/convex/strict_convex_between.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2022 Joseph Myers. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joseph Myers +-/ +import analysis.convex.between +import analysis.convex.strict_convex_space + +/-! +# Betweenness in affine spaces for strictly convex spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves results about betweenness for points in an affine space for a strictly convex +space. + +-/ + +variables {V P : Type*} [normed_add_comm_group V] [normed_space ℝ V] [pseudo_metric_space P] +variables [normed_add_torsor V P] [strict_convex_space ℝ V] + +include V + +lemma sbtw.dist_lt_max_dist (p : P) {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : + dist p₂ p < max (dist p₁ p) (dist p₃ p) := +begin + have hp₁p₃ : p₁ -ᵥ p ≠ p₃ -ᵥ p, { by simpa using h.left_ne_right }, + rw [sbtw, ←wbtw_vsub_const_iff p, wbtw, affine_segment_eq_segment, + ←insert_endpoints_open_segment, set.mem_insert_iff, set.mem_insert_iff] at h, + rcases h with ⟨h | h | h, hp₂p₁, hp₂p₃⟩, + { rw vsub_left_cancel_iff at h, exact false.elim (hp₂p₁ h) }, + { rw vsub_left_cancel_iff at h, exact false.elim (hp₂p₃ h) }, + { rw [open_segment_eq_image, set.mem_image] at h, + rcases h with ⟨r, ⟨hr0, hr1⟩, hr⟩, + simp_rw [@dist_eq_norm_vsub V, ←hr], + exact norm_combo_lt_of_ne (le_max_left _ _) (le_max_right _ _) hp₁p₃ (sub_pos.2 hr1) hr0 + (by abel) } +end + +lemma wbtw.dist_le_max_dist (p : P) {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) : + dist p₂ p ≤ max (dist p₁ p) (dist p₃ p) := +begin + by_cases hp₁ : p₂ = p₁, { simp [hp₁] }, + by_cases hp₃ : p₂ = p₃, { simp [hp₃] }, + have hs : sbtw ℝ p₁ p₂ p₃ := ⟨h, hp₁, hp₃⟩, + exact (hs.dist_lt_max_dist _).le +end + +/-- Given three collinear points, two (not equal) with distance `r` from `p` and one with +distance at most `r` from `p`, the third point is weakly between the other two points. -/ +lemma collinear.wbtw_of_dist_eq_of_dist_le {p p₁ p₂ p₃ : P} {r : ℝ} + (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : dist p₁ p = r) (hp₂ : dist p₂ p ≤ r) + (hp₃ : dist p₃ p = r) (hp₁p₃ : p₁ ≠ p₃) : wbtw ℝ p₁ p₂ p₃ := +begin + rcases h.wbtw_or_wbtw_or_wbtw with hw | hw | hw, + { exact hw }, + { by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] }, + have hs : sbtw ℝ p₂ p₃ p₁ := ⟨hw, hp₃p₂, hp₁p₃.symm⟩, + have hs' := hs.dist_lt_max_dist p, + rw [hp₁, hp₃, lt_max_iff, lt_self_iff_false, or_false] at hs', + exact false.elim (hp₂.not_lt hs') }, + { by_cases hp₁p₂ : p₁ = p₂, { simp [hp₁p₂] }, + have hs : sbtw ℝ p₃ p₁ p₂ := ⟨hw, hp₁p₃, hp₁p₂⟩, + have hs' := hs.dist_lt_max_dist p, + rw [hp₁, hp₃, lt_max_iff, lt_self_iff_false, false_or] at hs', + exact false.elim (hp₂.not_lt hs') } +end + +/-- Given three collinear points, two (not equal) with distance `r` from `p` and one with +distance less than `r` from `p`, the third point is strictly between the other two points. -/ +lemma collinear.sbtw_of_dist_eq_of_dist_lt {p p₁ p₂ p₃ : P} {r : ℝ} + (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : dist p₁ p = r) (hp₂ : dist p₂ p < r) + (hp₃ : dist p₃ p = r) (hp₁p₃ : p₁ ≠ p₃) : sbtw ℝ p₁ p₂ p₃ := +begin + refine ⟨h.wbtw_of_dist_eq_of_dist_le hp₁ hp₂.le hp₃ hp₁p₃, _, _⟩, + { rintro rfl, exact hp₂.ne hp₁ }, + { rintro rfl, exact hp₂.ne hp₃ } +end diff --git a/src/analysis/convex/strict_convex_space.lean b/src/analysis/convex/strict_convex_space.lean index e34040c3aae52..189e75c6b3c98 100644 --- a/src/analysis/convex/strict_convex_space.lean +++ b/src/analysis/convex/strict_convex_space.lean @@ -3,14 +3,19 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Yury Kudryashov -/ +import analysis.convex.normed import analysis.convex.strict -import analysis.convex.topology -import analysis.normed_space.ordered +import analysis.normed.order.basic +import analysis.normed_space.add_torsor import analysis.normed_space.pointwise +import analysis.normed_space.affine_isometry /-! # Strictly convex spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines strictly convex spaces. A normed space is strictly convex if all closed balls are strictly convex. This does **not** mean that the norm is strictly convex (in fact, it never is). @@ -32,14 +37,16 @@ In a strictly convex space, we prove - `norm_add_lt_of_not_same_ray`, `same_ray_iff_norm_add`, `dist_add_dist_eq_iff`: the triangle inequality `dist x y + dist y z ≤ dist x z` is a strict inequality unless `y` belongs to the segment `[x -[ℝ] z]`. +- `isometry.affine_isometry_of_strict_convex_space`: an isometry of `normed_add_torsor`s for real + normed spaces, strictly convex in the case of the codomain, is an affine isometry. We also provide several lemmas that can be used as alternative constructors for `strict_convex ℝ E`: - `strict_convex_space.of_strict_convex_closed_unit_ball`: if `closed_ball (0 : E) 1` is strictly convex, then `E` is a strictly convex space; -- `strict_convex_space.of_norm_add`: if `∥x + y∥ = ∥x∥ + ∥y∥` implies `same_ray ℝ x y` for all - `x y : E`, then `E` is a strictly convex space. +- `strict_convex_space.of_norm_add`: if `‖x + y‖ = ‖x‖ + ‖y‖` implies `same_ray ℝ x y` for all + nonzero `x y : E`, then `E` is a strictly convex space. ## Implementation notes @@ -59,12 +66,12 @@ require balls of positive radius with center at the origin to be strictly convex then prove that any closed ball is strictly convex in `strict_convex_closed_ball` below. See also `strict_convex_space.of_strict_convex_closed_unit_ball`. -/ -class strict_convex_space (𝕜 E : Type*) [normed_linear_ordered_field 𝕜] [normed_group E] +class strict_convex_space (𝕜 E : Type*) [normed_linear_ordered_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] : Prop := (strict_convex_closed_ball : ∀ r : ℝ, 0 < r → strict_convex 𝕜 (closed_ball (0 : E) r)) variables (𝕜 : Type*) {E : Type*} [normed_linear_ordered_field 𝕜] - [normed_group E] [normed_space 𝕜 E] + [normed_add_comm_group E] [normed_space 𝕜 E] /-- A closed ball in a strictly convex space is strictly convex. -/ lemma strict_convex_closed_ball [strict_convex_space 𝕜 E] (x : E) (r : ℝ) : @@ -84,74 +91,63 @@ lemma strict_convex_space.of_strict_convex_closed_unit_ball strict_convex_space 𝕜 E := ⟨λ r hr, by simpa only [smul_closed_unit_ball_of_nonneg hr.le] using h.smul r⟩ -/-- If `∥x + y∥ = ∥x∥ + ∥y∥` implies that `x y : E` are in the same ray, then `E` is a strictly -convex space. -/ -lemma strict_convex_space.of_norm_add (h : ∀ x y : E, ∥x + y∥ = ∥x∥ + ∥y∥ → same_ray ℝ x y) : +/-- Strict convexity is equivalent to `‖a • x + b • y‖ < 1` for all `x` and `y` of norm at most `1` +and all strictly positive `a` and `b` such that `a + b = 1`. This lemma shows that it suffices to +check this for points of norm one and some `a`, `b` such that `a + b = 1`. -/ +lemma strict_convex_space.of_norm_combo_lt_one + (h : ∀ x y : E, ‖x‖ = 1 → ‖y‖ = 1 → x ≠ y → ∃ a b : ℝ, a + b = 1 ∧ ‖a • x + b • y‖ < 1) : strict_convex_space ℝ E := begin - refine strict_convex_space.of_strict_convex_closed_unit_ball ℝ (λ x hx y hy hne a b ha hb hab, _), - have hx' := hx, have hy' := hy, - rw [← closure_closed_ball, closure_eq_interior_union_frontier, - frontier_closed_ball (0 : E) one_ne_zero] at hx hy, - cases hx, { exact (convex_closed_ball _ _).combo_interior_self_mem_interior hx hy' ha hb.le hab }, - cases hy, { exact (convex_closed_ball _ _).combo_self_interior_mem_interior hx' hy ha.le hb hab }, - rw [interior_closed_ball (0 : E) one_ne_zero, mem_ball_zero_iff], - have hx₁ : ∥x∥ = 1, from mem_sphere_zero_iff_norm.1 hx, - have hy₁ : ∥y∥ = 1, from mem_sphere_zero_iff_norm.1 hy, - have ha' : ∥a∥ = a, from real.norm_of_nonneg ha.le, - have hb' : ∥b∥ = b, from real.norm_of_nonneg hb.le, - calc ∥a • x + b • y∥ < ∥a • x∥ + ∥b • y∥ : (norm_add_le _ _).lt_of_ne (λ H, hne _) - ... = 1 : by simpa only [norm_smul, hx₁, hy₁, mul_one, ha', hb'], - simpa only [norm_smul, hx₁, hy₁, ha', hb', mul_one, smul_comm a, smul_right_inj ha.ne', - smul_right_inj hb.ne'] using (h _ _ H).norm_smul_eq.symm + refine strict_convex_space.of_strict_convex_closed_unit_ball ℝ + ((convex_closed_ball _ _).strict_convex' $ λ x hx y hy hne, _), + rw [interior_closed_ball (0 : E) one_ne_zero, closed_ball_diff_ball, mem_sphere_zero_iff_norm] + at hx hy, + rcases h x y hx hy hne with ⟨a, b, hab, hlt⟩, + use b, + rwa [affine_map.line_map_apply_module, interior_closed_ball (0 : E) one_ne_zero, + mem_ball_zero_iff, sub_eq_iff_eq_add.2 hab.symm] end -lemma strict_convex_space.of_norm_add_lt_aux {a b c d : ℝ} (ha : 0 < a) (hab : a + b = 1) - (hc : 0 < c) (hd : 0 < d) (hcd : c + d = 1) (hca : c ≤ a) {x y : E} (hy : ∥y∥ ≤ 1) - (hxy : ∥a • x + b • y∥ < 1) : - ∥c • x + d • y∥ < 1 := +lemma strict_convex_space.of_norm_combo_ne_one + (h : ∀ x y : E, ‖x‖ = 1 → ‖y‖ = 1 → x ≠ y → + ∃ a b : ℝ, 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ ‖a • x + b • y‖ ≠ 1) : + strict_convex_space ℝ E := begin - have hbd : b ≤ d, - { refine le_of_add_le_add_left (hab.trans_le _), - rw ←hcd, - exact add_le_add_right hca _ }, - have h₁ : 0 < c / a := div_pos hc ha, - have h₂ : 0 ≤ d - c / a * b, - { rw [sub_nonneg, mul_comm_div', ←le_div_iff' hc], - exact div_le_div hd.le hbd hc hca }, - calc ∥c • x + d • y∥ = ∥(c / a) • (a • x + b • y) + (d - c / a * b) • y∥ - : by rw [smul_add, ←mul_smul, ←mul_smul, div_mul_cancel _ ha.ne', sub_smul, - add_add_sub_cancel] - ... ≤ ∥(c / a) • (a • x + b • y)∥ + ∥(d - c / a * b) • y∥ : norm_add_le _ _ - ... = c / a * ∥a • x + b • y∥ + (d - c / a * b) * ∥y∥ - : by rw [norm_smul_of_nonneg h₁.le, norm_smul_of_nonneg h₂] - ... < c / a * 1 + (d - c / a * b) * 1 - : add_lt_add_of_lt_of_le (mul_lt_mul_of_pos_left hxy h₁) (mul_le_mul_of_nonneg_left hy h₂) - ... = 1 : begin - nth_rewrite 0 ←hab, - rw [mul_add, div_mul_cancel _ ha.ne', mul_one, add_add_sub_cancel, hcd], - end, + refine strict_convex_space.of_strict_convex_closed_unit_ball ℝ + ((convex_closed_ball _ _).strict_convex _), + simp only [interior_closed_ball _ one_ne_zero, closed_ball_diff_ball, set.pairwise, + frontier_closed_ball _ one_ne_zero, mem_sphere_zero_iff_norm], + intros x hx y hy hne, + rcases h x y hx hy hne with ⟨a, b, ha, hb, hab, hne'⟩, + exact ⟨_, ⟨a, b, ha, hb, hab, rfl⟩, mt mem_sphere_zero_iff_norm.1 hne'⟩ end -/-- Strict convexity is equivalent to `∥a • x + b • y∥ < 1` for all `x` and `y` of norm at most `1` -and all strictly positive `a` and `b` such that `a + b = 1`. This shows that we only need to check -it for fixed `a` and `b`. -/ -lemma strict_convex_space.of_norm_add_lt {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) - (h : ∀ x y : E, ∥x∥ ≤ 1 → ∥y∥ ≤ 1 → x ≠ y → ∥a • x + b • y∥ < 1) : +lemma strict_convex_space.of_norm_add_ne_two + (h : ∀ ⦃x y : E⦄, ‖x‖ = 1 → ‖y‖ = 1 → x ≠ y → ‖x + y‖ ≠ 2) : strict_convex_space ℝ E := begin - refine strict_convex_space.of_strict_convex_closed_unit_ball _ (λ x hx y hy hxy c d hc hd hcd, _), - rw [interior_closed_ball (0 : E) one_ne_zero, mem_ball_zero_iff], - rw mem_closed_ball_zero_iff at hx hy, - obtain hca | hac := le_total c a, - { exact strict_convex_space.of_norm_add_lt_aux ha hab hc hd hcd hca hy (h _ _ hx hy hxy) }, - rw add_comm at ⊢ hab hcd, - refine strict_convex_space.of_norm_add_lt_aux hb hab hd hc hcd _ hx _, - { refine le_of_add_le_add_right (hcd.trans_le _), - rw ←hab, - exact add_le_add_left hac _ }, - { rw add_comm, - exact h _ _ hx hy hxy } + refine strict_convex_space.of_norm_combo_ne_one + (λ x y hx hy hne, ⟨1/2, 1/2, one_half_pos.le, one_half_pos.le, add_halves _, _⟩), + rw [← smul_add, norm_smul, real.norm_of_nonneg one_half_pos.le, one_div, + ← div_eq_inv_mul, ne.def, div_eq_one_iff_eq (two_ne_zero' ℝ)], + exact h hx hy hne, +end + +lemma strict_convex_space.of_pairwise_sphere_norm_ne_two + (h : (sphere (0 : E) 1).pairwise $ λ x y, ‖x + y‖ ≠ 2) : + strict_convex_space ℝ E := +strict_convex_space.of_norm_add_ne_two $ λ x y hx hy, + h (mem_sphere_zero_iff_norm.2 hx) (mem_sphere_zero_iff_norm.2 hy) + +/-- If `‖x + y‖ = ‖x‖ + ‖y‖` implies that `x y : E` are in the same ray, then `E` is a strictly +convex space. See also a more -/ +lemma strict_convex_space.of_norm_add + (h : ∀ x y : E, ‖x‖ = 1 → ‖y‖ = 1 → ‖x + y‖ = 2 → same_ray ℝ x y) : + strict_convex_space ℝ E := +begin + refine strict_convex_space.of_pairwise_sphere_norm_ne_two (λ x hx y hy, mt $ λ h₂, _), + rw mem_sphere_zero_iff_norm at hx hy, + exact (same_ray_iff_of_norm_eq (hx.trans hy.symm)).1 (h x y hx hy h₂) end variables [strict_convex_space ℝ E] {x y z : E} {a b r : ℝ} @@ -176,21 +172,21 @@ lemma open_segment_subset_ball_of_ne (hx : x ∈ closed_ball z r) (hy : y ∈ cl /-- If `x` and `y` are two distinct vectors of norm at most `r`, then a convex combination of `x` and `y` with positive coefficients has norm strictly less than `r`. -/ -lemma norm_combo_lt_of_ne (hx : ∥x∥ ≤ r) (hy : ∥y∥ ≤ r) (hne : x ≠ y) (ha : 0 < a) (hb : 0 < b) - (hab : a + b = 1) : ∥a • x + b • y∥ < r := +lemma norm_combo_lt_of_ne (hx : ‖x‖ ≤ r) (hy : ‖y‖ ≤ r) (hne : x ≠ y) (ha : 0 < a) (hb : 0 < b) + (hab : a + b = 1) : ‖a • x + b • y‖ < r := begin simp only [← mem_ball_zero_iff, ← mem_closed_ball_zero_iff] at hx hy ⊢, exact combo_mem_ball_of_ne hx hy hne ha hb hab end -/-- In a strictly convex space, if `x` and `y` are not in the same ray, then `∥x + y∥ < ∥x∥ + -∥y∥`. -/ -lemma norm_add_lt_of_not_same_ray (h : ¬same_ray ℝ x y) : ∥x + y∥ < ∥x∥ + ∥y∥ := +/-- In a strictly convex space, if `x` and `y` are not in the same ray, then `‖x + y‖ < ‖x‖ + +‖y‖`. -/ +lemma norm_add_lt_of_not_same_ray (h : ¬same_ray ℝ x y) : ‖x + y‖ < ‖x‖ + ‖y‖ := begin simp only [same_ray_iff_inv_norm_smul_eq, not_or_distrib, ← ne.def] at h, rcases h with ⟨hx, hy, hne⟩, rw ← norm_pos_iff at hx hy, - have hxy : 0 < ∥x∥ + ∥y∥ := add_pos hx hy, + have hxy : 0 < ‖x‖ + ‖y‖ := add_pos hx hy, have := combo_mem_ball_of_ne (inv_norm_smul_mem_closed_unit_ball x) (inv_norm_smul_mem_closed_unit_ball y) hne (div_pos hx hxy) (div_pos hy hxy) (by rw [← add_div, div_self hxy.ne']), @@ -199,13 +195,13 @@ begin real.norm_of_nonneg (inv_pos.2 hxy).le, ← div_eq_inv_mul, div_lt_one hxy] at this end -lemma lt_norm_sub_of_not_same_ray (h : ¬same_ray ℝ x y) : ∥x∥ - ∥y∥ < ∥x - y∥ := +lemma lt_norm_sub_of_not_same_ray (h : ¬same_ray ℝ x y) : ‖x‖ - ‖y‖ < ‖x - y‖ := begin nth_rewrite 0 ←sub_add_cancel x y at ⊢ h, exact sub_lt_iff_lt_add.2 (norm_add_lt_of_not_same_ray $ λ H', h $ H'.add_left same_ray.rfl), end -lemma abs_lt_norm_sub_of_not_same_ray (h : ¬same_ray ℝ x y) : |∥x∥ - ∥y∥| < ∥x - y∥ := +lemma abs_lt_norm_sub_of_not_same_ray (h : ¬same_ray ℝ x y) : |‖x‖ - ‖y‖| < ‖x - y‖ := begin refine abs_sub_lt_iff.2 ⟨lt_norm_sub_of_not_same_ray h, _⟩, rw norm_sub_rev, @@ -214,18 +210,23 @@ end /-- In a strictly convex space, two vectors `x`, `y` are in the same ray if and only if the triangle inequality for `x` and `y` becomes an equality. -/ -lemma same_ray_iff_norm_add : same_ray ℝ x y ↔ ∥x + y∥ = ∥x∥ + ∥y∥ := +lemma same_ray_iff_norm_add : same_ray ℝ x y ↔ ‖x + y‖ = ‖x‖ + ‖y‖ := ⟨same_ray.norm_add, λ h, not_not.1 $ λ h', (norm_add_lt_of_not_same_ray h').ne h⟩ +/-- If `x` and `y` are two vectors in a strictly convex space have the same norm and the norm of +their sum is equal to the sum of their norms, then they are equal. -/ +lemma eq_of_norm_eq_of_norm_add_eq (h₁ : ‖x‖ = ‖y‖) (h₂ : ‖x + y‖ = ‖x‖ + ‖y‖) : x = y := +(same_ray_iff_norm_add.mpr h₂).eq_of_norm_eq h₁ + /-- In a strictly convex space, two vectors `x`, `y` are not in the same ray if and only if the triangle inequality for `x` and `y` is strict. -/ -lemma not_same_ray_iff_norm_add_lt : ¬ same_ray ℝ x y ↔ ∥x + y∥ < ∥x∥ + ∥y∥ := +lemma not_same_ray_iff_norm_add_lt : ¬ same_ray ℝ x y ↔ ‖x + y‖ < ‖x‖ + ‖y‖ := same_ray_iff_norm_add.not.trans (norm_add_le _ _).lt_iff_ne.symm -lemma same_ray_iff_norm_sub : same_ray ℝ x y ↔ ∥x - y∥ = |∥x∥ - ∥y∥| := +lemma same_ray_iff_norm_sub : same_ray ℝ x y ↔ ‖x - y‖ = |‖x‖ - ‖y‖| := ⟨same_ray.norm_sub, λ h, not_not.1 $ λ h', (abs_lt_norm_sub_of_not_same_ray h').ne' h⟩ -lemma not_same_ray_iff_abs_lt_norm_sub : ¬ same_ray ℝ x y ↔ |∥x∥ - ∥y∥| < ∥x - y∥ := +lemma not_same_ray_iff_abs_lt_norm_sub : ¬ same_ray ℝ x y ↔ |‖x‖ - ‖y‖| < ‖x - y‖ := same_ray_iff_norm_sub.not.trans $ ne_comm.trans (abs_norm_sub_norm_le _ _).lt_iff_ne.symm /-- In a strictly convex space, the triangle inequality turns into an equality if and only if the @@ -234,7 +235,69 @@ lemma dist_add_dist_eq_iff : dist x y + dist y z = dist x z ↔ y ∈ [x -[ℝ] by simp only [mem_segment_iff_same_ray, same_ray_iff_norm_add, dist_eq_norm', sub_add_sub_cancel', eq_comm] -lemma norm_midpoint_lt_iff (h : ∥x∥ = ∥y∥) : ∥(1/2 : ℝ) • (x + y)∥ < ∥x∥ ↔ x ≠ y := +lemma norm_midpoint_lt_iff (h : ‖x‖ = ‖y‖) : ‖(1/2 : ℝ) • (x + y)‖ < ‖x‖ ↔ x ≠ y := by rw [norm_smul, real.norm_of_nonneg (one_div_nonneg.2 zero_le_two), ←inv_eq_one_div, - ←div_eq_inv_mul, div_lt_iff (@zero_lt_two ℝ _ _), mul_two, ←not_same_ray_iff_of_norm_eq h, + ←div_eq_inv_mul, div_lt_iff (zero_lt_two' ℝ), mul_two, ←not_same_ray_iff_of_norm_eq h, not_same_ray_iff_norm_add_lt, h] + +variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] +variables {PF : Type*} {PE : Type*} [metric_space PF] [metric_space PE] +variables [normed_add_torsor F PF] [normed_add_torsor E PE] + +include E + +lemma eq_line_map_of_dist_eq_mul_of_dist_eq_mul {x y z : PE} (hxy : dist x y = r * dist x z) + (hyz : dist y z = (1 - r) * dist x z) : + y = affine_map.line_map x z r := +begin + have : y -ᵥ x ∈ [(0 : E) -[ℝ] z -ᵥ x], + { rw [← dist_add_dist_eq_iff, dist_zero_left, dist_vsub_cancel_right, ← dist_eq_norm_vsub', + ← dist_eq_norm_vsub', hxy, hyz, ← add_mul, add_sub_cancel'_right, one_mul] }, + rcases eq_or_ne x z with rfl|hne, + { obtain rfl : y = x, by simpa, + simp }, + { rw [← dist_ne_zero] at hne, + rcases this with ⟨a, b, ha, hb, hab, H⟩, + rw [smul_zero, zero_add] at H, + have H' := congr_arg norm H, + rw [norm_smul, real.norm_of_nonneg hb, ← dist_eq_norm_vsub', ← dist_eq_norm_vsub', hxy, + mul_left_inj' hne] at H', + rw [affine_map.line_map_apply, ← H', H, vsub_vadd] }, +end + +lemma eq_midpoint_of_dist_eq_half {x y z : PE} (hx : dist x y = dist x z / 2) + (hy : dist y z = dist x z / 2) : y = midpoint ℝ x z := +begin + apply eq_line_map_of_dist_eq_mul_of_dist_eq_mul, + { rwa [inv_of_eq_inv, ← div_eq_inv_mul] }, + { rwa [inv_of_eq_inv, ← one_div, sub_half, one_div, ← div_eq_inv_mul] } +end + +namespace isometry + +include F + +/-- An isometry of `normed_add_torsor`s for real normed spaces, strictly convex in the case of +the codomain, is an affine isometry. Unlike Mazur-Ulam, this does not require the isometry to +be surjective. -/ +noncomputable def affine_isometry_of_strict_convex_space {f : PF → PE} (hi : isometry f) : + PF →ᵃⁱ[ℝ] PE := +{ norm_map := λ x, by simp [affine_map.of_map_midpoint, ←dist_eq_norm_vsub E, hi.dist_eq], + ..affine_map.of_map_midpoint f (λ x y, begin + apply eq_midpoint_of_dist_eq_half, + { rw [hi.dist_eq, hi.dist_eq, dist_left_midpoint, real.norm_of_nonneg zero_le_two, + div_eq_inv_mul] }, + { rw [hi.dist_eq, hi.dist_eq, dist_midpoint_right, real.norm_of_nonneg zero_le_two, + div_eq_inv_mul] }, + end) hi.continuous } + +@[simp] lemma coe_affine_isometry_of_strict_convex_space {f : PF → PE} (hi : isometry f) : + ⇑(hi.affine_isometry_of_strict_convex_space) = f := +rfl + +@[simp] lemma affine_isometry_of_strict_convex_space_apply {f : PF → PE} (hi : isometry f) + (p : PF) : + hi.affine_isometry_of_strict_convex_space p = f p := +rfl + +end isometry diff --git a/src/analysis/convex/topology.lean b/src/analysis/convex/topology.lean index ab37411b7b782..c8248ad88ad89 100644 --- a/src/analysis/convex/topology.lean +++ b/src/analysis/convex/topology.lean @@ -3,43 +3,37 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Alexander Bentkamp, Yury Kudryashov -/ -import analysis.convex.jensen -import analysis.normed.group.pointwise -import analysis.normed_space.finite_dimension -import analysis.normed_space.ray +import analysis.convex.combination +import analysis.convex.strict import topology.path_connected import topology.algebra.affine +import topology.algebra.module.basic /-! -# Topological and metric properties of convex sets +# Topological properties of convex sets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. We prove the following facts: * `convex.interior` : interior of a convex set is convex; * `convex.closure` : closure of a convex set is convex; * `set.finite.compact_convex_hull` : convex hull of a finite set is compact; -* `set.finite.is_closed_convex_hull` : convex hull of a finite set is closed; -* `convex_on_norm`, `convex_on_dist` : norm and distance to a fixed point is convex on any convex - set; -* `convex_on_univ_norm`, `convex_on_univ_dist` : norm and distance to a fixed point is convex on - the whole space; -* `convex_hull_ediam`, `convex_hull_diam` : convex hull of a set has the same (e)metric diameter - as the original set; -* `bounded_convex_hull` : convex hull of a set is bounded if and only if the original set - is bounded. -* `bounded_std_simplex`, `is_closed_std_simplex`, `compact_std_simplex`: topological properties - of the standard simplex; +* `set.finite.is_closed_convex_hull` : convex hull of a finite set is closed. -/ -variables {ι : Type*} {E : Type*} +assert_not_exists has_norm open metric set open_locale pointwise convex +variables {ι 𝕜 E : Type*} + lemma real.convex_iff_is_preconnected {s : set ℝ} : convex ℝ s ↔ is_preconnected s := convex_iff_ord_connected.trans is_preconnected_iff_ord_connected.symm -alias real.convex_iff_is_preconnected ↔ convex.is_preconnected is_preconnected.convex +alias real.convex_iff_is_preconnected ↔ _ is_preconnected.convex /-! ### Standard simplex -/ @@ -52,11 +46,10 @@ lemma std_simplex_subset_closed_ball : std_simplex ℝ ι ⊆ metric.closed_ball 0 1 := begin assume f hf, - rw [metric.mem_closed_ball, dist_zero_right], - refine (nnreal.coe_one ▸ nnreal.coe_le_coe.2 $ finset.sup_le $ λ x hx, _), - change |f x| ≤ 1, - rw [abs_of_nonneg $ hf.1 x], - exact (mem_Icc_of_mem_std_simplex hf x).2 + rw [metric.mem_closed_ball, dist_pi_le_iff zero_le_one], + intros x, + rw [pi.zero_apply, real.dist_0_eq_abs, abs_of_nonneg $ hf.1 x], + exact (mem_Icc_of_mem_std_simplex hf x).2, end variable (ι) @@ -72,16 +65,43 @@ lemma is_closed_std_simplex : is_closed (std_simplex ℝ ι) := (is_closed_eq (continuous_finset_sum _ $ λ x _, continuous_apply x) continuous_const) /-- `std_simplex ℝ ι` is compact. -/ -lemma compact_std_simplex : is_compact (std_simplex ℝ ι) := -metric.compact_iff_closed_bounded.2 ⟨is_closed_std_simplex ι, bounded_std_simplex ι⟩ +lemma is_compact_std_simplex : is_compact (std_simplex ℝ ι) := +metric.is_compact_iff_is_closed_bounded.2 ⟨is_closed_std_simplex ι, bounded_std_simplex ι⟩ end std_simplex /-! ### Topological vector space -/ +section topological_space +variables [linear_ordered_ring 𝕜] [densely_ordered 𝕜] [topological_space 𝕜] [order_topology 𝕜] + [add_comm_group E] [topological_space E] [has_continuous_add E] [module 𝕜 E] + [has_continuous_smul 𝕜 E] {x y : E} + +lemma segment_subset_closure_open_segment : [x -[𝕜] y] ⊆ closure (open_segment 𝕜 x y) := +begin + rw [segment_eq_image, open_segment_eq_image, ←closure_Ioo (zero_ne_one' 𝕜)], + exact image_closure_subset_closure_image (by continuity), +end + +end topological_space + +section pseudo_metric_space +variables [linear_ordered_ring 𝕜] [densely_ordered 𝕜] [pseudo_metric_space 𝕜] [order_topology 𝕜] + [proper_space 𝕜] [compact_Icc_space 𝕜] [add_comm_group E] [topological_space E] [t2_space E] + [has_continuous_add E] [module 𝕜 E] [has_continuous_smul 𝕜 E] + +@[simp] lemma closure_open_segment (x y : E) : closure (open_segment 𝕜 x y) = [x -[𝕜] y] := +begin + rw [segment_eq_image, open_segment_eq_image, ←closure_Ioo (zero_ne_one' 𝕜)], + exact (image_closure_of_is_compact (bounded_Ioo _ _).is_compact_closure $ + continuous.continuous_on $ by continuity).symm, +end + +end pseudo_metric_space + section has_continuous_const_smul -variables {𝕜 : Type*} [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E] +variables [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E] [topological_add_group E] [has_continuous_const_smul 𝕜 E] /-- If `s` is a convex set, then `a • interior s + b • closure s ⊆ interior s` for all `0 < a`, @@ -192,18 +212,50 @@ hs.add_smul_mem_interior' (subset_closure hx) hy ht /-- In a topological vector space, the interior of a convex set is convex. -/ protected lemma convex.interior {s : set E} (hs : convex 𝕜 s) : convex 𝕜 (interior s) := -convex_iff_open_segment_subset.mpr $ λ x y hx hy, +convex_iff_open_segment_subset.mpr $ λ x hx y hy, hs.open_segment_closure_interior_subset_interior (interior_subset_closure hx) hy /-- In a topological vector space, the closure of a convex set is convex. -/ protected lemma convex.closure {s : set E} (hs : convex 𝕜 s) : convex 𝕜 (closure s) := -λ x y hx hy a b ha hb hab, +λ x hx y hy a b ha hb hab, let f : E → E → E := λ x' y', a • x' + b • y' in -have hf : continuous (λ p : E × E, f p.1 p.2), from - (continuous_fst.const_smul _).add (continuous_snd.const_smul _), -show f x y ∈ closure s, from - mem_closure_of_continuous2 hf hx hy (λ x' hx' y' hy', subset_closure - (hs hx' hy' ha hb hab)) +have hf : continuous (function.uncurry f), + from (continuous_fst.const_smul _).add (continuous_snd.const_smul _), +show f x y ∈ closure s, + from map_mem_closure₂ hf hx hy (λ x' hx' y' hy', hs hx' hy' ha hb hab) + +open affine_map + +/-- A convex set `s` is strictly convex provided that for any two distinct points of +`s \ interior s`, the line passing through these points has nonempty intersection with +`interior s`. -/ +protected lemma convex.strict_convex' {s : set E} (hs : convex 𝕜 s) + (h : (s \ interior s).pairwise $ λ x y, ∃ c : 𝕜, line_map x y c ∈ interior s) : + strict_convex 𝕜 s := +begin + refine strict_convex_iff_open_segment_subset.2 _, + intros x hx y hy hne, + by_cases hx' : x ∈ interior s, { exact hs.open_segment_interior_self_subset_interior hx' hy }, + by_cases hy' : y ∈ interior s, { exact hs.open_segment_self_interior_subset_interior hx hy' }, + rcases h ⟨hx, hx'⟩ ⟨hy, hy'⟩ hne with ⟨c, hc⟩, + refine (open_segment_subset_union x y ⟨c, rfl⟩).trans (insert_subset.2 ⟨hc, union_subset _ _⟩), + exacts [hs.open_segment_self_interior_subset_interior hx hc, + hs.open_segment_interior_self_subset_interior hc hy] +end + +/-- A convex set `s` is strictly convex provided that for any two distinct points `x`, `y` of +`s \ interior s`, the segment with endpoints `x`, `y` has nonempty intersection with +`interior s`. -/ +protected lemma convex.strict_convex {s : set E} (hs : convex 𝕜 s) + (h : (s \ interior s).pairwise $ λ x y, ([x -[𝕜] y] \ frontier s).nonempty) : + strict_convex 𝕜 s := +begin + refine (hs.strict_convex' $ h.imp_on $ λ x hx y hy hne, _), + simp only [segment_eq_image_line_map, ← self_diff_frontier], + rintro ⟨_, ⟨⟨c, hc, rfl⟩, hcs⟩⟩, + refine ⟨c, hs.segment_subset hx.1 hy.1 _, hcs⟩, + exact (segment_eq_image_line_map 𝕜 x y).symm ▸ mem_image_of_mem _ hc +end end has_continuous_const_smul @@ -213,17 +265,17 @@ variables [add_comm_group E] [module ℝ E] [topological_space E] [topological_add_group E] [has_continuous_smul ℝ E] /-- Convex hull of a finite set is compact. -/ -lemma set.finite.compact_convex_hull {s : set E} (hs : finite s) : +lemma set.finite.compact_convex_hull {s : set E} (hs : s.finite) : is_compact (convex_hull ℝ s) := begin rw [hs.convex_hull_eq_image], - apply (compact_std_simplex _).image, + apply (is_compact_std_simplex _).image, haveI := hs.fintype, apply linear_map.continuous_on_pi end /-- Convex hull of a finite set is closed. -/ -lemma set.finite.is_closed_convex_hull [t2_space E] {s : set E} (hs : finite s) : +lemma set.finite.is_closed_convex_hull [t2_space E] {s : set E} (hs : s.finite) : is_closed (convex_hull ℝ s) := hs.compact_convex_hull.is_closed @@ -241,7 +293,7 @@ begin have hne : t ≠ 0, from (one_pos.trans ht).ne', refine ⟨homothety x t⁻¹ y, hs.open_segment_interior_closure_subset_interior hx hy _, (affine_equiv.homothety_units_mul_hom x (units.mk0 t hne)).apply_symm_apply y⟩, - rw [open_segment_eq_image_line_map, ← inv_one, ← inv_Ioi (@one_pos ℝ _ _), ← image_inv, + rw [open_segment_eq_image_line_map, ← inv_one, ← inv_Ioi (zero_lt_one' ℝ), ← image_inv, image_image, homothety_eq_line_map], exact mem_image_of_mem _ ht end @@ -265,6 +317,7 @@ lemma convex.subset_interior_image_homothety_of_one_lt {s : set E} (hs : convex s ⊆ interior (homothety x t '' s) := subset_closure.trans $ hs.closure_subset_interior_image_homothety_of_one_lt hx t ht +/-- A nonempty convex set is path connected. -/ protected lemma convex.is_path_connected {s : set E} (hconv : convex ℝ s) (hne : s.nonempty) : is_path_connected s := begin @@ -276,6 +329,16 @@ begin (line_map_apply_one _ _) H end +/-- A nonempty convex set is connected. -/ +protected lemma convex.is_connected {s : set E} (h : convex ℝ s) (hne : s.nonempty) : + is_connected s := +(h.is_path_connected hne).is_connected + +/-- A convex set is preconnected. -/ +protected lemma convex.is_preconnected {s : set E} (h : convex ℝ s) : is_preconnected s := +s.eq_empty_or_nonempty.elim (λ h, h.symm ▸ is_preconnected_empty) + (λ hne, (h.is_connected hne).is_preconnected) + /-- Every topological vector space over ℝ is path connected. @@ -285,113 +348,3 @@ protected lemma topological_add_group.path_connected : path_connected_space E := path_connected_space_iff_univ.mpr $ convex_univ.is_path_connected ⟨(0 : E), trivial⟩ end has_continuous_smul - -/-! ### Normed vector space -/ - -section normed_space -variables [semi_normed_group E] [normed_space ℝ E] {s t : set E} - -/-- The norm on a real normed space is convex on any convex set. See also `seminorm.convex_on` -and `convex_on_univ_norm`. -/ -lemma convex_on_norm (hs : convex ℝ s) : convex_on ℝ s norm := -⟨hs, λ x y hx hy a b ha hb hab, - calc ∥a • x + b • y∥ ≤ ∥a • x∥ + ∥b • y∥ : norm_add_le _ _ - ... = a * ∥x∥ + b * ∥y∥ - : by rw [norm_smul, norm_smul, real.norm_of_nonneg ha, real.norm_of_nonneg hb]⟩ - -/-- The norm on a real normed space is convex on the whole space. See also `seminorm.convex_on` -and `convex_on_norm`. -/ -lemma convex_on_univ_norm : convex_on ℝ univ (norm : E → ℝ) := convex_on_norm convex_univ - -lemma convex_on_dist (z : E) (hs : convex ℝ s) : convex_on ℝ s (λ z', dist z' z) := -by simpa [dist_eq_norm, preimage_preimage] - using (convex_on_norm (hs.translate (-z))).comp_affine_map - (affine_map.id ℝ E - affine_map.const ℝ E z) - -lemma convex_on_univ_dist (z : E) : convex_on ℝ univ (λz', dist z' z) := -convex_on_dist z convex_univ - -lemma convex_ball (a : E) (r : ℝ) : convex ℝ (metric.ball a r) := -by simpa only [metric.ball, sep_univ] using (convex_on_univ_dist a).convex_lt r - -lemma convex_closed_ball (a : E) (r : ℝ) : convex ℝ (metric.closed_ball a r) := -by simpa only [metric.closed_ball, sep_univ] using (convex_on_univ_dist a).convex_le r - -lemma convex.thickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (thickening δ s) := -by { rw ←add_ball_zero, exact hs.add (convex_ball 0 _) } - -lemma convex.cthickening (hs : convex ℝ s) (δ : ℝ) : convex ℝ (cthickening δ s) := -begin - obtain hδ | hδ := le_total 0 δ, - { rw cthickening_eq_Inter_thickening hδ, - exact convex_Inter₂ (λ _ _, hs.thickening _) }, - { rw cthickening_of_nonpos hδ, - exact hs.closure } -end - -/-- If `s`, `t` are disjoint convex sets, `s` is compact and `t` is closed then we can find open -disjoint convex sets containing them. -/ -lemma disjoint.exists_open_convexes (disj : disjoint s t) (hs₁ : convex ℝ s) (hs₂ : is_compact s) - (ht₁ : convex ℝ t) (ht₂ : is_closed t) : - ∃ u v, is_open u ∧ is_open v ∧ convex ℝ u ∧ convex ℝ v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v := -let ⟨δ, hδ, hst⟩ := disj.exists_thickenings hs₂ ht₂ in - ⟨_, _, is_open_thickening, is_open_thickening, hs₁.thickening _, ht₁.thickening _, - self_subset_thickening hδ _, self_subset_thickening hδ _, hst⟩ - -/-- Given a point `x` in the convex hull of `s` and a point `y`, there exists a point -of `s` at distance at least `dist x y` from `y`. -/ -lemma convex_hull_exists_dist_ge {s : set E} {x : E} (hx : x ∈ convex_hull ℝ s) (y : E) : - ∃ x' ∈ s, dist x y ≤ dist x' y := -(convex_on_dist y (convex_convex_hull ℝ _)).exists_ge_of_mem_convex_hull hx - -/-- Given a point `x` in the convex hull of `s` and a point `y` in the convex hull of `t`, -there exist points `x' ∈ s` and `y' ∈ t` at distance at least `dist x y`. -/ -lemma convex_hull_exists_dist_ge2 {s t : set E} {x y : E} - (hx : x ∈ convex_hull ℝ s) (hy : y ∈ convex_hull ℝ t) : - ∃ (x' ∈ s) (y' ∈ t), dist x y ≤ dist x' y' := -begin - rcases convex_hull_exists_dist_ge hx y with ⟨x', hx', Hx'⟩, - rcases convex_hull_exists_dist_ge hy x' with ⟨y', hy', Hy'⟩, - use [x', hx', y', hy'], - exact le_trans Hx' (dist_comm y x' ▸ dist_comm y' x' ▸ Hy') -end - -/-- Emetric diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/ -@[simp] lemma convex_hull_ediam (s : set E) : - emetric.diam (convex_hull ℝ s) = emetric.diam s := -begin - refine (emetric.diam_le $ λ x hx y hy, _).antisymm (emetric.diam_mono $ subset_convex_hull ℝ s), - rcases convex_hull_exists_dist_ge2 hx hy with ⟨x', hx', y', hy', H⟩, - rw edist_dist, - apply le_trans (ennreal.of_real_le_of_real H), - rw ← edist_dist, - exact emetric.edist_le_diam_of_mem hx' hy' -end - -/-- Diameter of the convex hull of a set `s` equals the emetric diameter of `s. -/ -@[simp] lemma convex_hull_diam (s : set E) : - metric.diam (convex_hull ℝ s) = metric.diam s := -by simp only [metric.diam, convex_hull_ediam] - -/-- Convex hull of `s` is bounded if and only if `s` is bounded. -/ -@[simp] lemma bounded_convex_hull {s : set E} : - metric.bounded (convex_hull ℝ s) ↔ metric.bounded s := -by simp only [metric.bounded_iff_ediam_ne_top, convex_hull_ediam] - -@[priority 100] -instance normed_space.path_connected : path_connected_space E := -topological_add_group.path_connected - -@[priority 100] -instance normed_space.loc_path_connected : loc_path_connected_space E := -loc_path_connected_of_bases (λ x, metric.nhds_basis_ball) - (λ x r r_pos, (convex_ball x r).is_path_connected $ by simp [r_pos]) - -lemma dist_add_dist_of_mem_segment {x y z : E} (h : y ∈ [x -[ℝ] z]) : - dist x y + dist y z = dist x z := -begin - simp only [dist_eq_norm, mem_segment_iff_same_ray] at *, - simpa only [sub_add_sub_cancel', norm_sub_rev] using h.norm_add.symm -end - -end normed_space diff --git a/src/analysis/convex/uniform.lean b/src/analysis/convex/uniform.lean new file mode 100644 index 0000000000000..e8c1bab9550df --- /dev/null +++ b/src/analysis/convex/uniform.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import analysis.convex.strict_convex_space + +/-! +# Uniformly convex spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines uniformly convex spaces, which are real normed vector spaces in which for all +strictly positive `ε`, there exists some strictly positive `δ` such that `ε ≤ ‖x - y‖` implies +`‖x + y‖ ≤ 2 - δ` for all `x` and `y` of norm at most than `1`. This means that the triangle +inequality is strict with a uniform bound, as opposed to strictly convex spaces where the triangle +inequality is strict but not necessarily uniformly (`‖x + y‖ < ‖x‖ + ‖y‖` for all `x` and `y` not in +the same ray). + +## Main declarations + +`uniform_convex_space E` means that `E` is a uniformly convex space. + +## TODO + +* Milman-Pettis +* Hanner's inequalities + +## Tags + +convex, uniformly convex +-/ + +open set metric +open_locale convex pointwise + +/-- A *uniformly convex space* is a real normed space where the triangle inequality is strict with a +uniform bound. Namely, over the `x` and `y` of norm `1`, `‖x + y‖` is uniformly bounded above +by a constant `< 2` when `‖x - y‖` is uniformly bounded below by a positive constant. + +See also `uniform_convex_space.of_uniform_convex_closed_unit_ball`. -/ +class uniform_convex_space (E : Type*) [seminormed_add_comm_group E] : Prop := +(uniform_convex : ∀ ⦃ε : ℝ⦄, 0 < ε → ∃ δ, 0 < δ ∧ + ∀ ⦃x : E⦄, ‖x‖ = 1 → ∀ ⦃y⦄, ‖y‖ = 1 → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 - δ) + +variables {E : Type*} + +section seminormed_add_comm_group +variables (E) [seminormed_add_comm_group E] [uniform_convex_space E] {ε : ℝ} + +lemma exists_forall_sphere_dist_add_le_two_sub (hε : 0 < ε) : + ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ = 1 → ∀ ⦃y⦄, ‖y‖ = 1 → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 - δ := +uniform_convex_space.uniform_convex hε + +variables [normed_space ℝ E] + +lemma exists_forall_closed_ball_dist_add_le_two_sub (hε : 0 < ε) : + ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ ≤ 1 → ∀ ⦃y⦄, ‖y‖ ≤ 1 → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 - δ := +begin + have hε' : 0 < ε / 3 := div_pos hε zero_lt_three, + obtain ⟨δ, hδ, h⟩ := exists_forall_sphere_dist_add_le_two_sub E hε', + set δ' := min (1/2) (min (ε/3) $ δ/3), + refine ⟨δ', lt_min one_half_pos $ lt_min hε' (div_pos hδ zero_lt_three), λ x hx y hy hxy, _⟩, + obtain hx' | hx' := le_or_lt (‖x‖) (1 - δ'), + { exact (norm_add_le_of_le hx' hy).trans (sub_add_eq_add_sub _ _ _).le }, + obtain hy' | hy' := le_or_lt (‖y‖) (1 - δ'), + { exact (norm_add_le_of_le hx hy').trans (add_sub_assoc _ _ _).ge }, + have hδ' : 0 < 1 - δ' := sub_pos_of_lt (min_lt_of_left_lt one_half_lt_one), + have h₁ : ∀ z : E, 1 - δ' < ‖z‖ → ‖‖z‖⁻¹ • z‖ = 1, + { rintro z hz, + rw [norm_smul_of_nonneg (inv_nonneg.2 $ norm_nonneg _), inv_mul_cancel (hδ'.trans hz).ne'] }, + have h₂ : ∀ z : E, ‖z‖ ≤ 1 → 1 - δ' ≤ ‖z‖ → ‖‖z‖⁻¹ • z - z‖ ≤ δ', + { rintro z hz hδz, + nth_rewrite 2 ←one_smul ℝ z, + rwa [←sub_smul, norm_smul_of_nonneg (sub_nonneg_of_le $ one_le_inv (hδ'.trans_le hδz) hz), + sub_mul, inv_mul_cancel (hδ'.trans_le hδz).ne', one_mul, sub_le_comm] }, + set x' := ‖x‖⁻¹ • x, + set y' := ‖y‖⁻¹ • y, + have hxy' : ε/3 ≤ ‖x' - y'‖ := + calc ε/3 = ε - (ε/3 + ε/3) : by ring + ... ≤ ‖x - y‖ - (‖x' - x‖ + ‖y' - y‖) : sub_le_sub hxy (add_le_add + ((h₂ _ hx hx'.le).trans $ min_le_of_right_le $ min_le_left _ _) $ + (h₂ _ hy hy'.le).trans $ min_le_of_right_le $ min_le_left _ _) + ... ≤ _ : begin + have : ∀ x' y', x - y = x' - y' + (x - x') + (y' - y) := λ _ _, by abel, + rw [sub_le_iff_le_add, norm_sub_rev _ x, ←add_assoc, this], + exact norm_add₃_le _ _ _, + end, + calc ‖x + y‖ ≤ ‖x' + y'‖ + ‖x' - x‖ + ‖y' - y‖ : begin + have : ∀ x' y', x + y = x' + y' + (x - x') + (y - y') := λ _ _, by abel, + rw [norm_sub_rev, norm_sub_rev y', this], + exact norm_add₃_le _ _ _, + end + ... ≤ 2 - δ + δ' + δ' + : add_le_add_three (h (h₁ _ hx') (h₁ _ hy') hxy') (h₂ _ hx hx'.le) (h₂ _ hy hy'.le) + ... ≤ 2 - δ' : begin + rw [←le_sub_iff_add_le, ←le_sub_iff_add_le, sub_sub, sub_sub], + refine sub_le_sub_left _ _, + ring_nf, + rw ←mul_div_cancel' δ three_ne_zero, + exact mul_le_mul_of_nonneg_left (min_le_of_right_le $ min_le_right _ _) three_pos.le, + end, +end + +lemma exists_forall_closed_ball_dist_add_le_two_mul_sub (hε : 0 < ε) (r : ℝ) : + ∃ δ, 0 < δ ∧ ∀ ⦃x : E⦄, ‖x‖ ≤ r → ∀ ⦃y⦄, ‖y‖ ≤ r → ε ≤ ‖x - y‖ → ‖x + y‖ ≤ 2 * r - δ := +begin + obtain hr | hr := le_or_lt r 0, + { exact ⟨1, one_pos, λ x hx y hy h, (hε.not_le $ h.trans $ (norm_sub_le _ _).trans $ + add_nonpos (hx.trans hr) (hy.trans hr)).elim⟩ }, + obtain ⟨δ, hδ, h⟩ := exists_forall_closed_ball_dist_add_le_two_sub E (div_pos hε hr), + refine ⟨δ * r, mul_pos hδ hr, λ x hx y hy hxy, _⟩, + rw [←div_le_one hr, div_eq_inv_mul, ←norm_smul_of_nonneg (inv_nonneg.2 hr.le)] at hx hy; + try { apply_instance }, + have := h hx hy, + simp_rw [←smul_add, ←smul_sub, norm_smul_of_nonneg (inv_nonneg.2 hr.le), ←div_eq_inv_mul, + div_le_div_right hr, div_le_iff hr, sub_mul] at this, + exact this hxy, +end + +end seminormed_add_comm_group + +variables [normed_add_comm_group E] [normed_space ℝ E] [uniform_convex_space E] + +@[priority 100] -- See note [lower instance priority] +instance uniform_convex_space.to_strict_convex_space : strict_convex_space ℝ E := +strict_convex_space.of_norm_add_ne_two $ λ x y hx hy hxy, + let ⟨δ, hδ, h⟩ := exists_forall_closed_ball_dist_add_le_two_sub E (norm_sub_pos_iff.2 hxy) + in ((h hx.le hy.le le_rfl).trans_lt $ sub_lt_self _ hδ).ne diff --git a/src/analysis/convolution.lean b/src/analysis/convolution.lean new file mode 100644 index 0000000000000..199a713352ea1 --- /dev/null +++ b/src/analysis/convolution.lean @@ -0,0 +1,1641 @@ +/- +Copyright (c) 2022 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import analysis.calculus.bump_function_inner +import analysis.calculus.parametric_integral +import measure_theory.constructions.prod.integral +import measure_theory.function.locally_integrable +import measure_theory.group.integration +import measure_theory.group.prod +import measure_theory.integral.interval_integral + +/-! +# Convolution of functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the convolution on two functions, i.e. `x ↦ ∫ f(t)g(x - t) ∂t`. +In the general case, these functions can be vector-valued, and have an arbitrary (additive) +group as domain. We use a continuous bilinear operation `L` on these function values as +"multiplication". The domain must be equipped with a Haar measure `μ` +(though many individual results have weaker conditions on `μ`). + +For many applications we can take `L = lsmul ℝ ℝ` or `L = mul ℝ ℝ`. + +We also define `convolution_exists` and `convolution_exists_at` to state that the convolution is +well-defined (everywhere or at a single point). These conditions are needed for pointwise +computations (e.g. `convolution_exists_at.distrib_add`), but are generally not stong enough for any +local (or global) properties of the convolution. For this we need stronger assumptions on `f` +and/or `g`, and generally if we impose stronger conditions on one of the functions, we can impose +weaker conditions on the other. +We have proven many of the properties of the convolution assuming one of these functions +has compact support (in which case the other function only needs to be locally integrable). +We still need to prove the properties for other pairs of conditions (e.g. both functions are +rapidly decreasing) + +# Design Decisions + +We use a bilinear map `L` to "multiply" the two functions in the integrand. +This generality has several advantages + +* This allows us to compute the total derivative of the convolution, in case the functions are + multivariate. The total derivative is again a convolution, but where the codomains of the + functions can be higher-dimensional. See `has_compact_support.has_fderiv_at_convolution_right`. +* This allows us to use `@[to_additive]` everywhere (which would not be possible if we would use + `mul`/`smul` in the integral, since `@[to_additive]` will incorrectly also try to additivize + those definitions). +* We need to support the case where at least one of the functions is vector-valued, but if we use + `smul` to multiply the functions, that would be an asymmetric definition. + +# Main Definitions +* `convolution f g L μ x = (f ⋆[L, μ] g) x = ∫ t, L (f t) (g (x - t)) ∂μ` is the convolution of + `f` and `g` w.r.t. the continuous bilinear map `L` and measure `μ`. +* `convolution_exists_at f g x L μ` states that the convolution `(f ⋆[L, μ] g) x` is well-defined + (i.e. the integral exists). +* `convolution_exists f g L μ` states that the convolution `f ⋆[L, μ] g` is well-defined at each + point. + +# Main Results +* `has_compact_support.has_fderiv_at_convolution_right` and + `has_compact_support.has_fderiv_at_convolution_left`: we can compute the total derivative + of the convolution as a convolution with the total derivative of the right (left) function. +* `has_compact_support.cont_diff_convolution_right` and + `has_compact_support.cont_diff_convolution_left`: the convolution is `𝒞ⁿ` if one of the functions + is `𝒞ⁿ` with compact support and the other function in locally integrable. + +Versions of these statements for functions depending on a parameter are also given. + +* `convolution_tendsto_right`: Given a sequence of nonnegative normalized functions whose support + tends to a small neighborhood around `0`, the convolution tends to the right argument. + This is specialized to bump functions in `cont_diff_bump.convolution_tendsto_right`. + +# Notation +The following notations are localized in the locale `convolution`: +* `f ⋆[L, μ] g` for the convolution. Note: you have to use parentheses to apply the convolution + to an argument: `(f ⋆[L, μ] g) x`. +* `f ⋆[L] g := f ⋆[L, volume] g` +* `f ⋆ g := f ⋆[lsmul ℝ ℝ] g` + +# To do +* Existence and (uniform) continuity of the convolution if + one of the maps is in `ℒ^p` and the other in `ℒ^q` with `1 / p + 1 / q = 1`. + This might require a generalization of `measure_theory.mem_ℒp.smul` where `smul` is generalized + to a continuous bilinear map. + (see e.g. [Fremlin, *Measure Theory* (volume 2)][fremlin_vol2], 255K) +* The convolution is a `ae_strongly_measurable` function + (see e.g. [Fremlin, *Measure Theory* (volume 2)][fremlin_vol2], 255I). +* Prove properties about the convolution if both functions are rapidly decreasing. +* Use `@[to_additive]` everywhere +-/ + +open set function filter measure_theory measure_theory.measure topological_space +open continuous_linear_map metric +open_locale pointwise topology nnreal filter + +universes u𝕜 uG uE uE' uE'' uF uF' uF'' uP + +variables {𝕜 : Type u𝕜} {G : Type uG} {E : Type uE} {E' : Type uE'} {E'' : Type uE''} +{F : Type uF} {F' : Type uF'} {F'' : Type uF''} {P : Type uP} + +variables [normed_add_comm_group E] [normed_add_comm_group E'] [normed_add_comm_group E''] + [normed_add_comm_group F] + {f f' : G → E} {g g' : G → E'} {x x' : G} {y y' : E} + +section nontrivially_normed_field + +variables [nontrivially_normed_field 𝕜] +variables [normed_space 𝕜 E] [normed_space 𝕜 E'] [normed_space 𝕜 E''] [normed_space 𝕜 F] +variables (L : E →L[𝕜] E' →L[𝕜] F) + +section no_measurability + +variables [add_group G] [topological_space G] + +lemma convolution_integrand_bound_right_of_le_of_subset + {C : ℝ} (hC : ∀ i, ‖g i‖ ≤ C) {x t : G} {s u : set G} (hx : x ∈ s) (hu : - tsupport g + s ⊆ u) : + ‖L (f t) (g (x - t))‖ ≤ u.indicator (λ t, ‖L‖ * ‖f t‖ * C) t := +begin + refine le_indicator (λ t ht, _) (λ t ht, _) t, + { refine (L.le_op_norm₂ _ _).trans _, + apply mul_le_mul_of_nonneg_left (hC _) (mul_nonneg (norm_nonneg _) (norm_nonneg _)) }, + { have : x - t ∉ support g, + { refine mt (λ hxt, _) ht, + apply hu, + refine ⟨_, _, set.neg_mem_neg.mpr (subset_closure hxt), hx, _⟩, + rw [neg_sub, sub_add_cancel] }, + rw [nmem_support.mp this, (L _).map_zero, norm_zero] } +end + +lemma has_compact_support.convolution_integrand_bound_right_of_subset (hcg : has_compact_support g) + (hg : continuous g) {x t : G} {s u : set G} (hx : x ∈ s) (hu : - tsupport g + s ⊆ u) : + ‖L (f t) (g (x - t))‖ ≤ u.indicator (λ t, ‖L‖ * ‖f t‖ * (⨆ i, ‖g i‖)) t := +begin + apply convolution_integrand_bound_right_of_le_of_subset _ (λ i, _) hx hu, + exact le_csupr (hg.norm.bdd_above_range_of_has_compact_support hcg.norm) _, +end + +lemma has_compact_support.convolution_integrand_bound_right (hcg : has_compact_support g) + (hg : continuous g) {x t : G} {s : set G} (hx : x ∈ s) : + ‖L (f t) (g (x - t))‖ ≤ (- tsupport g + s).indicator (λ t, ‖L‖ * ‖f t‖ * (⨆ i, ‖g i‖)) t := +hcg.convolution_integrand_bound_right_of_subset L hg hx subset.rfl + +lemma continuous.convolution_integrand_fst [has_continuous_sub G] (hg : continuous g) (t : G) : + continuous (λ x, L (f t) (g (x - t))) := +L.continuous₂.comp₂ continuous_const $ hg.comp $ continuous_id.sub continuous_const + +lemma has_compact_support.convolution_integrand_bound_left (hcf : has_compact_support f) + (hf : continuous f) {x t : G} {s : set G} (hx : x ∈ s) : + ‖L (f (x - t)) (g t)‖ ≤ (- tsupport f + s).indicator (λ t, ‖L‖ * (⨆ i, ‖f i‖) * ‖g t‖) t := +by { convert hcf.convolution_integrand_bound_right L.flip hf hx, + simp_rw [L.op_norm_flip, mul_right_comm] } + +end no_measurability + +section measurability + +variables [measurable_space G] {μ ν : measure G} + +/-- The convolution of `f` and `g` exists at `x` when the function `t ↦ L (f t) (g (x - t))` is +integrable. There are various conditions on `f` and `g` to prove this. -/ +def convolution_exists_at [has_sub G] (f : G → E) (g : G → E') (x : G) (L : E →L[𝕜] E' →L[𝕜] F) + (μ : measure G . volume_tac) : Prop := +integrable (λ t, L (f t) (g (x - t))) μ + +/-- The convolution of `f` and `g` exists when the function `t ↦ L (f t) (g (x - t))` is integrable +for all `x : G`. There are various conditions on `f` and `g` to prove this. -/ +def convolution_exists [has_sub G] (f : G → E) (g : G → E') (L : E →L[𝕜] E' →L[𝕜] F) + (μ : measure G . volume_tac) : Prop := +∀ x : G, convolution_exists_at f g x L μ + +section convolution_exists + +variables {L} +lemma convolution_exists_at.integrable [has_sub G] {x : G} (h : convolution_exists_at f g x L μ) : + integrable (λ t, L (f t) (g (x - t))) μ := +h + +variables (L) + +section group + +variables [add_group G] + +lemma measure_theory.ae_strongly_measurable.convolution_integrand' + [has_measurable_add₂ G] [has_measurable_neg G] [sigma_finite ν] + (hf : ae_strongly_measurable f ν) + (hg : ae_strongly_measurable g $ map (λ (p : G × G), p.1 - p.2) (μ.prod ν)) : + ae_strongly_measurable (λ p : G × G, L (f p.2) (g (p.1 - p.2))) (μ.prod ν) := +L.ae_strongly_measurable_comp₂ hf.snd $ hg.comp_measurable measurable_sub + + +section + +variables [has_measurable_add G] [has_measurable_neg G] + +lemma measure_theory.ae_strongly_measurable.convolution_integrand_snd' + (hf : ae_strongly_measurable f μ) {x : G} + (hg : ae_strongly_measurable g $ map (λ t, x - t) μ) : + ae_strongly_measurable (λ t, L (f t) (g (x - t))) μ := +L.ae_strongly_measurable_comp₂ hf $ hg.comp_measurable $ measurable_id.const_sub x + +lemma measure_theory.ae_strongly_measurable.convolution_integrand_swap_snd' + {x : G} (hf : ae_strongly_measurable f $ map (λ t, x - t) μ) + (hg : ae_strongly_measurable g μ) : ae_strongly_measurable (λ t, L (f (x - t)) (g t)) μ := +L.ae_strongly_measurable_comp₂ (hf.comp_measurable $ measurable_id.const_sub x) hg + +/-- A sufficient condition to prove that `f ⋆[L, μ] g` exists. +We assume that `f` is integrable on a set `s` and `g` is bounded and ae strongly measurable +on `x₀ - s` (note that both properties hold if `g` is continuous with compact support). -/ +lemma bdd_above.convolution_exists_at' {x₀ : G} + {s : set G} (hbg : bdd_above ((λ i, ‖g i‖) '' ((λ t, - t + x₀) ⁻¹' s))) + (hs : measurable_set s) (h2s : support (λ t, L (f t) (g (x₀ - t))) ⊆ s) + (hf : integrable_on f s μ) (hmg : ae_strongly_measurable g $ map (λ t, x₀ - t) (μ.restrict s)) : + convolution_exists_at f g x₀ L μ := +begin + rw [convolution_exists_at, ← integrable_on_iff_integrable_of_support_subset h2s], + set s' := (λ t, - t + x₀) ⁻¹' s, + have : ∀ᵐ (t : G) ∂(μ.restrict s), + ‖L (f t) (g (x₀ - t))‖ ≤ s.indicator (λ t, ‖L‖ * ‖f t‖ * ⨆ i : s', ‖g i‖) t, + { refine eventually_of_forall _, + refine le_indicator (λ t ht, _) (λ t ht, _), + { refine (L.le_op_norm₂ _ _).trans _, + refine mul_le_mul_of_nonneg_left + (le_csupr_set hbg $ mem_preimage.mpr _) + (mul_nonneg (norm_nonneg _) (norm_nonneg _)), + rwa [neg_sub, sub_add_cancel] }, + { have : t ∉ support (λ t, L (f t) (g (x₀ - t))) := mt (λ h, h2s h) ht, + rw [nmem_support.mp this, norm_zero] } }, + refine integrable.mono' _ _ this, + { rw [integrable_indicator_iff hs], exact ((hf.norm.const_mul _).mul_const _).integrable_on }, + { exact hf.ae_strongly_measurable.convolution_integrand_snd' L hmg } +end + +/-- If `‖f‖ *[μ] ‖g‖` exists, then `f *[L, μ] g` exists. -/ +lemma convolution_exists_at.of_norm' {x₀ : G} + (h : convolution_exists_at (λ x, ‖f x‖) (λ x, ‖g x‖) x₀ (mul ℝ ℝ) μ) + (hmf : ae_strongly_measurable f μ) + (hmg : ae_strongly_measurable g $ map (λ t, x₀ - t) μ) : + convolution_exists_at f g x₀ L μ := +begin + refine (h.const_mul ‖L‖).mono' (hmf.convolution_integrand_snd' L hmg) + (eventually_of_forall $ λ x, _), + rw [mul_apply', ← mul_assoc], + apply L.le_op_norm₂, +end + +end + +section left +variables [has_measurable_add₂ G] [has_measurable_neg G] [sigma_finite μ] [is_add_right_invariant μ] + +lemma measure_theory.ae_strongly_measurable.convolution_integrand_snd + (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) + (x : G) : ae_strongly_measurable (λ t, L (f t) (g (x - t))) μ := +hf.convolution_integrand_snd' L $ hg.mono' $ + (quasi_measure_preserving_sub_left_of_right_invariant μ x).absolutely_continuous + +lemma measure_theory.ae_strongly_measurable.convolution_integrand_swap_snd + (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) + (x : G) : ae_strongly_measurable (λ t, L (f (x - t)) (g t)) μ := +(hf.mono' (quasi_measure_preserving_sub_left_of_right_invariant μ x).absolutely_continuous) + .convolution_integrand_swap_snd' L hg + +/-- If `‖f‖ *[μ] ‖g‖` exists, then `f *[L, μ] g` exists. -/ +lemma convolution_exists_at.of_norm {x₀ : G} + (h : convolution_exists_at (λ x, ‖f x‖) (λ x, ‖g x‖) x₀ (mul ℝ ℝ) μ) + (hmf : ae_strongly_measurable f μ) + (hmg : ae_strongly_measurable g μ) : + convolution_exists_at f g x₀ L μ := +h.of_norm' L hmf $ hmg.mono' + (quasi_measure_preserving_sub_left_of_right_invariant μ x₀).absolutely_continuous + +end left + +section right + +variables [has_measurable_add₂ G] [has_measurable_neg G] +[sigma_finite μ] [is_add_right_invariant μ] [sigma_finite ν] + +lemma measure_theory.ae_strongly_measurable.convolution_integrand + (hf : ae_strongly_measurable f ν) (hg : ae_strongly_measurable g μ) : + ae_strongly_measurable (λ p : G × G, L (f p.2) (g (p.1 - p.2))) (μ.prod ν) := +hf.convolution_integrand' L $ hg.mono' + (quasi_measure_preserving_sub_of_right_invariant μ ν).absolutely_continuous + +lemma measure_theory.integrable.convolution_integrand (hf : integrable f ν) (hg : integrable g μ) : + integrable (λ p : G × G, L (f p.2) (g (p.1 - p.2))) (μ.prod ν) := +begin + have h_meas : ae_strongly_measurable (λ (p : G × G), L (f p.2) (g (p.1 - p.2))) (μ.prod ν) := + hf.ae_strongly_measurable.convolution_integrand L hg.ae_strongly_measurable, + have h2_meas : ae_strongly_measurable (λ (y : G), ∫ (x : G), ‖L (f y) (g (x - y))‖ ∂μ) ν := + h_meas.prod_swap.norm.integral_prod_right', + simp_rw [integrable_prod_iff' h_meas], + refine ⟨eventually_of_forall (λ t, (L (f t)).integrable_comp (hg.comp_sub_right t)), _⟩, + refine integrable.mono' _ h2_meas (eventually_of_forall $ + λ t, (_ : _ ≤ ‖L‖ * ‖f t‖ * ∫ x, ‖g (x - t)‖ ∂μ)), + { simp_rw [integral_sub_right_eq_self (λ t, ‖ g t ‖)], + exact (hf.norm.const_mul _).mul_const _ }, + { simp_rw [← integral_mul_left], + rw [real.norm_of_nonneg], + { exact integral_mono_of_nonneg (eventually_of_forall $ λ t, norm_nonneg _) + ((hg.comp_sub_right t).norm.const_mul _) (eventually_of_forall $ λ t, L.le_op_norm₂ _ _) }, + exact integral_nonneg (λ x, norm_nonneg _) } +end + +lemma measure_theory.integrable.ae_convolution_exists (hf : integrable f ν) (hg : integrable g μ) : + ∀ᵐ x ∂μ, convolution_exists_at f g x L ν := +((integrable_prod_iff $ hf.ae_strongly_measurable.convolution_integrand L + hg.ae_strongly_measurable).mp $ hf.convolution_integrand L hg).1 + +end right + +variables [topological_space G] [topological_add_group G] [borel_space G] + +lemma has_compact_support.convolution_exists_at {x₀ : G} + (h : has_compact_support (λ t, L (f t) (g (x₀ - t)))) (hf : locally_integrable f μ) + (hg : continuous g) : convolution_exists_at f g x₀ L μ := +begin + let u := (homeomorph.neg G).trans (homeomorph.add_right x₀), + let v := (homeomorph.neg G).trans (homeomorph.add_left x₀), + apply ((u.is_compact_preimage.mpr h).bdd_above_image hg.norm.continuous_on).convolution_exists_at' + L is_closed_closure.measurable_set subset_closure (hf.integrable_on_is_compact h), + have A : ae_strongly_measurable (g ∘ ⇑v) + (μ.restrict (tsupport (λ (t : G), (L (f t)) (g (x₀ - t))))), + { apply (hg.comp v.continuous).continuous_on.ae_strongly_measurable_of_is_compact h, + exact (is_closed_tsupport _).measurable_set }, + convert ((v.continuous.measurable.measure_preserving + (μ.restrict (tsupport (λ t, L (f t) (g (x₀ - t)))))).ae_strongly_measurable_comp_iff + v.to_measurable_equiv.measurable_embedding).1 A, + ext x, + simp only [homeomorph.neg, sub_eq_add_neg, coe_to_add_units, homeomorph.trans_apply, + equiv.neg_apply, equiv.to_fun_as_coe, homeomorph.homeomorph_mk_coe, equiv.coe_fn_mk, + homeomorph.coe_add_left], +end + +lemma has_compact_support.convolution_exists_right + (hcg : has_compact_support g) (hf : locally_integrable f μ) (hg : continuous g) : + convolution_exists f g L μ := +begin + intro x₀, + refine has_compact_support.convolution_exists_at L _ hf hg, + refine (hcg.comp_homeomorph (homeomorph.sub_left x₀)).mono _, + refine λ t, mt (λ ht : g (x₀ - t) = 0, _), + simp_rw [ht, (L _).map_zero] +end + +lemma has_compact_support.convolution_exists_left_of_continuous_right + (hcf : has_compact_support f) (hf : locally_integrable f μ) (hg : continuous g) : + convolution_exists f g L μ := +begin + intro x₀, + refine has_compact_support.convolution_exists_at L _ hf hg, + refine hcf.mono _, + refine λ t, mt (λ ht : f t = 0, _), + simp_rw [ht, L.map_zero₂] +end + +end group + +section comm_group + +variables [add_comm_group G] + +section measurable_group + +variables [has_measurable_neg G] [is_add_left_invariant μ] + +/-- A sufficient condition to prove that `f ⋆[L, μ] g` exists. +We assume that the integrand has compact support and `g` is bounded on this support (note that +both properties hold if `g` is continuous with compact support). We also require that `f` is +integrable on the support of the integrand, and that both functions are strongly measurable. + +This is a variant of `bdd_above.convolution_exists_at'` in an abelian group with a left-invariant +measure. This allows us to state the boundedness and measurability of `g` in a more natural way. -/ +lemma bdd_above.convolution_exists_at [has_measurable_add₂ G] [sigma_finite μ] {x₀ : G} + {s : set G} (hbg : bdd_above ((λ i, ‖g i‖) '' ((λ t, x₀ - t) ⁻¹' s))) + (hs : measurable_set s) (h2s : support (λ t, L (f t) (g (x₀ - t))) ⊆ s) + (hf : integrable_on f s μ) (hmg : ae_strongly_measurable g μ) : + convolution_exists_at f g x₀ L μ := +begin + refine bdd_above.convolution_exists_at' L _ hs h2s hf _, + { simp_rw [← sub_eq_neg_add, hbg] }, + { have : ae_strongly_measurable g (map (λ (t : G), x₀ - t) μ), from hmg.mono' + (quasi_measure_preserving_sub_left_of_right_invariant μ x₀).absolutely_continuous, + apply this.mono_measure, + exact map_mono_of_ae_measurable restrict_le_self + (measurable_const.sub measurable_id').ae_measurable } +end + +variables {L} [has_measurable_add G] [is_neg_invariant μ] + +lemma convolution_exists_at_flip : + convolution_exists_at g f x L.flip μ ↔ convolution_exists_at f g x L μ := +by simp_rw [convolution_exists_at, ← integrable_comp_sub_left (λ t, L (f t) (g (x - t))) x, + sub_sub_cancel, flip_apply] + +lemma convolution_exists_at.integrable_swap (h : convolution_exists_at f g x L μ) : + integrable (λ t, L (f (x - t)) (g t)) μ := +by { convert h.comp_sub_left x, simp_rw [sub_sub_self] } + +lemma convolution_exists_at_iff_integrable_swap : + convolution_exists_at f g x L μ ↔ integrable (λ t, L (f (x - t)) (g t)) μ := +convolution_exists_at_flip.symm + +end measurable_group + +variables [topological_space G] [topological_add_group G] [borel_space G] + [is_add_left_invariant μ] [is_neg_invariant μ] + +lemma has_compact_support.convolution_exists_left + (hcf : has_compact_support f) (hf : continuous f) (hg : locally_integrable g μ) : + convolution_exists f g L μ := +λ x₀, convolution_exists_at_flip.mp $ hcf.convolution_exists_right L.flip hg hf x₀ + +lemma has_compact_support.convolution_exists_right_of_continuous_left + (hcg : has_compact_support g) (hf : continuous f) (hg : locally_integrable g μ) : + convolution_exists f g L μ := +λ x₀, convolution_exists_at_flip.mp $ + hcg.convolution_exists_left_of_continuous_right L.flip hg hf x₀ + +end comm_group + +end convolution_exists + +variables [normed_space ℝ F] [complete_space F] + +/-- The convolution of two functions `f` and `g` with respect to a continuous bilinear map `L` and +measure `μ`. It is defined to be `(f ⋆[L, μ] g) x = ∫ t, L (f t) (g (x - t)) ∂μ`. -/ +noncomputable def convolution [has_sub G] (f : G → E) (g : G → E') (L : E →L[𝕜] E' →L[𝕜] F) + (μ : measure G . volume_tac) : G → F := +λ x, ∫ t, L (f t) (g (x - t)) ∂μ + +localized "notation (name := convolution) f ` ⋆[`:67 L:67 `, ` μ:67 `] `:0 g:66 := + convolution f g L μ" in convolution +localized "notation (name := convolution.volume) f ` ⋆[`:67 L:67 `]`:0 g:66 := + convolution f g L measure_theory.measure_space.volume" in convolution +localized "notation (name := convolution.lsmul) f ` ⋆ `:67 g:66 := + convolution f g (continuous_linear_map.lsmul ℝ ℝ) measure_theory.measure_space.volume" + in convolution + +lemma convolution_def [has_sub G] : (f ⋆[L, μ] g) x = ∫ t, L (f t) (g (x - t)) ∂μ := rfl + +/-- The definition of convolution where the bilinear operator is scalar multiplication. +Note: it often helps the elaborator to give the type of the convolution explicitly. -/ +lemma convolution_lsmul [has_sub G] {f : G → 𝕜} {g : G → F} : + (f ⋆[lsmul 𝕜 𝕜, μ] g : G → F) x = ∫ t, f t • g (x - t) ∂μ := rfl + +/-- The definition of convolution where the bilinear operator is multiplication. -/ +lemma convolution_mul [has_sub G] [normed_space ℝ 𝕜] [complete_space 𝕜] {f : G → 𝕜} {g : G → 𝕜} : + (f ⋆[mul 𝕜 𝕜, μ] g) x = ∫ t, f t * g (x - t) ∂μ := rfl + +section group + +variables {L} [add_group G] + +lemma smul_convolution [smul_comm_class ℝ 𝕜 F] + {y : 𝕜} : (y • f) ⋆[L, μ] g = y • (f ⋆[L, μ] g) := +by { ext, simp only [pi.smul_apply, convolution_def, ← integral_smul, L.map_smul₂] } + +lemma convolution_smul [smul_comm_class ℝ 𝕜 F] + {y : 𝕜} : f ⋆[L, μ] (y • g) = y • (f ⋆[L, μ] g) := +by { ext, simp only [pi.smul_apply, convolution_def, ← integral_smul, (L _).map_smul] } + +@[simp] lemma zero_convolution : 0 ⋆[L, μ] g = 0 := +by { ext, simp_rw [convolution_def, pi.zero_apply, L.map_zero₂, integral_zero] } + +@[simp] lemma convolution_zero : f ⋆[L, μ] 0 = 0 := +by { ext, simp_rw [convolution_def, pi.zero_apply, (L _).map_zero, integral_zero] } + +lemma convolution_exists_at.distrib_add {x : G} (hfg : convolution_exists_at f g x L μ) + (hfg' : convolution_exists_at f g' x L μ) : + (f ⋆[L, μ] (g + g')) x = (f ⋆[L, μ] g) x + (f ⋆[L, μ] g') x := +by simp only [convolution_def, (L _).map_add, pi.add_apply, integral_add hfg hfg'] + +lemma convolution_exists.distrib_add (hfg : convolution_exists f g L μ) + (hfg' : convolution_exists f g' L μ) : f ⋆[L, μ] (g + g') = f ⋆[L, μ] g + f ⋆[L, μ] g' := +by { ext, exact (hfg x).distrib_add (hfg' x) } + +lemma convolution_exists_at.add_distrib {x : G} (hfg : convolution_exists_at f g x L μ) + (hfg' : convolution_exists_at f' g x L μ) : + ((f + f') ⋆[L, μ] g) x = (f ⋆[L, μ] g) x + (f' ⋆[L, μ] g) x := +by simp only [convolution_def, L.map_add₂, pi.add_apply, integral_add hfg hfg'] + +lemma convolution_exists.add_distrib (hfg : convolution_exists f g L μ) + (hfg' : convolution_exists f' g L μ) : (f + f') ⋆[L, μ] g = f ⋆[L, μ] g + f' ⋆[L, μ] g := +by { ext, exact (hfg x).add_distrib (hfg' x) } + +lemma convolution_mono_right {f g g' : G → ℝ} + (hfg : convolution_exists_at f g x (lsmul ℝ ℝ) μ) + (hfg' : convolution_exists_at f g' x (lsmul ℝ ℝ) μ) + (hf : ∀ x, 0 ≤ f x) (hg : ∀ x, g x ≤ g' x) : + (f ⋆[lsmul ℝ ℝ, μ] g) x ≤ (f ⋆[lsmul ℝ ℝ, μ] g') x := +begin + apply integral_mono hfg hfg', + simp only [lsmul_apply, algebra.id.smul_eq_mul], + assume t, + apply mul_le_mul_of_nonneg_left (hg _) (hf _), +end + +lemma convolution_mono_right_of_nonneg {f g g' : G → ℝ} + (hfg' : convolution_exists_at f g' x (lsmul ℝ ℝ) μ) + (hf : ∀ x, 0 ≤ f x) (hg : ∀ x, g x ≤ g' x) (hg' : ∀ x, 0 ≤ g' x) : + (f ⋆[lsmul ℝ ℝ, μ] g) x ≤ (f ⋆[lsmul ℝ ℝ, μ] g') x := +begin + by_cases H : convolution_exists_at f g x (lsmul ℝ ℝ) μ, + { exact convolution_mono_right H hfg' hf hg }, + have : (f ⋆[lsmul ℝ ℝ, μ] g) x = 0 := integral_undef H, + rw this, + exact integral_nonneg (λ y, mul_nonneg (hf y) (hg' (x - y))), +end + +variables (L) + +lemma convolution_congr [has_measurable_add₂ G] [has_measurable_neg G] + [sigma_finite μ] [is_add_right_invariant μ] (h1 : f =ᵐ[μ] f') (h2 : g =ᵐ[μ] g') : + f ⋆[L, μ] g = f' ⋆[L, μ] g' := +begin + ext x, + apply integral_congr_ae, + exact (h1.prod_mk $ h2.comp_tendsto + (quasi_measure_preserving_sub_left_of_right_invariant μ x).tendsto_ae).fun_comp ↿(λ x y, L x y) +end + +lemma support_convolution_subset_swap : support (f ⋆[L, μ] g) ⊆ support g + support f := +begin + intros x h2x, + by_contra hx, + apply h2x, + simp_rw [set.mem_add, not_exists, not_and_distrib, nmem_support] at hx, + rw [convolution_def], + convert integral_zero G F, + ext t, + rcases hx (x - t) t with h|h|h, + { rw [h, (L _).map_zero] }, + { rw [h, L.map_zero₂] }, + { exact (h $ sub_add_cancel x t).elim } +end + +section +variables [has_measurable_add₂ G] [has_measurable_neg G] [sigma_finite μ] [is_add_right_invariant μ] + +lemma measure_theory.integrable.integrable_convolution (hf : integrable f μ) (hg : integrable g μ) : + integrable (f ⋆[L, μ] g) μ := +(hf.convolution_integrand L hg).integral_prod_left + +end + +variables [topological_space G] +variables [topological_add_group G] + +lemma has_compact_support.convolution [t2_space G] (hcf : has_compact_support f) + (hcg : has_compact_support g) : has_compact_support (f ⋆[L, μ] g) := +is_compact_of_is_closed_subset (hcg.is_compact.add hcf) is_closed_closure $ closure_minimal + ((support_convolution_subset_swap L).trans $ add_subset_add subset_closure subset_closure) + (hcg.is_compact.add hcf).is_closed + +variables [borel_space G] [first_countable_topology G] +[topological_space P] [first_countable_topology P] + +/-- The convolution `f * g` is continuous if `f` is locally integrable and `g` is continuous and +compactly supported. Version where `g` depends on an additional parameter in a subset `s` of +a parameter space `P` (and the compact support `k` is independent of the parameter in `s`), +not assuming `t2_space G`. -/ +lemma continuous_on_convolution_right_with_param' + {g : P → G → E'} {s : set P} {k : set G} (hk : is_compact k) (h'k : is_closed k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : continuous_on (↿g) (s ×ˢ univ)) : + continuous_on (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2) (s ×ˢ univ) := +begin + assume q₀ hq₀, + replace hq₀ : q₀.1 ∈ s, by simpa only [mem_prod, mem_univ, and_true] using hq₀, + have A : ∀ p ∈ s, continuous (g p), + { assume p hp, + apply hg.comp_continuous (continuous_const.prod_mk continuous_id') (λ x, _), + simpa only [prod_mk_mem_set_prod_eq, mem_univ, and_true] using hp }, + have B : ∀ p ∈ s, tsupport (g p) ⊆ k := + λ p hp, closure_minimal (support_subset_iff'.2 (λ z hz, hgs _ _ hp hz)) h'k, + /- We find a small neighborhood of `{q₀.1} × k` on which the function is uniformly bounded. + This follows from the continuity at all points of the compact set `k`. -/ + obtain ⟨w, C, w_open, q₀w, Cnonneg, hw⟩ : + ∃ w C, is_open w ∧ q₀.1 ∈ w ∧ 0 ≤ C ∧ ∀ p x, p ∈ w ∩ s → ‖g p x‖ ≤ C, + { have A : is_compact ({q₀.1} ×ˢ k), from is_compact_singleton.prod hk, + obtain ⟨t, kt, t_open, ht⟩ : + ∃ t, {q₀.1} ×ˢ k ⊆ t ∧ is_open t ∧ bounded (↿g '' (t ∩ s ×ˢ univ)), + { apply exists_is_open_bounded_image_inter_of_is_compact_of_continuous_on A _ hg, + simp only [prod_subset_prod_iff, hq₀, singleton_subset_iff, subset_univ, and_self, true_or] }, + obtain ⟨C, Cpos, hC⟩ : ∃ C, 0 < C ∧ (↿g) '' (t ∩ s ×ˢ univ) ⊆ closed_ball (0 : E') C, + from ht.subset_ball_lt 0 0, + obtain ⟨w, w_open, q₀w, hw⟩ : ∃ w, is_open w ∧ q₀.1 ∈ w ∧ w ×ˢ k ⊆ t, + { obtain ⟨w, v, w_open, v_open, hw, hv, hvw⟩ : + ∃ (w : set P) (v : set G), is_open w ∧ is_open v ∧ {q₀.fst} ⊆ w ∧ k ⊆ v ∧ w ×ˢ v ⊆ t, + from generalized_tube_lemma is_compact_singleton hk t_open kt, + exact ⟨w, w_open, singleton_subset_iff.1 hw, + subset.trans (set.prod_mono subset.rfl hv) hvw⟩ }, + refine ⟨w, C, w_open, q₀w, Cpos.le, _⟩, + rintros p x ⟨hp, hps⟩, + by_cases hx : x ∈ k, + { have H : (p, x) ∈ t, + { apply hw, + simp only [prod_mk_mem_set_prod_eq, hp, hx, and_true], }, + have H' : (p, x) ∈ (s ×ˢ univ : set (P × G)), + by simpa only [prod_mk_mem_set_prod_eq, mem_univ, and_true] using hps, + have : g p x ∈ closed_ball (0 : E') C, from hC (mem_image_of_mem _ ⟨H, H'⟩), + rwa mem_closed_ball_zero_iff at this }, + { have : g p x = 0, from hgs _ _ hps hx, + rw this, + simpa only [norm_zero] using Cpos.le } }, + have I1 : ∀ᶠ (q : P × G) in 𝓝[s ×ˢ univ] q₀, + ae_strongly_measurable (λ (a : G), L (f a) (g q.1 (q.2 - a))) μ, + { filter_upwards [self_mem_nhds_within], + rintros ⟨p, x⟩ ⟨hp, hx⟩, + refine (has_compact_support.convolution_exists_right L _ hf (A _ hp) _).1, + exact is_compact_of_is_closed_subset hk (is_closed_tsupport _) (B p hp) }, + let K' := - k + {q₀.2}, + have hK' : is_compact K' := hk.neg.add is_compact_singleton, + obtain ⟨U, U_open, K'U, hU⟩ : ∃ U, is_open U ∧ K' ⊆ U ∧ integrable_on f U μ, + from hf.integrable_on_nhds_is_compact hK', + let bound : G → ℝ := indicator U (λ a, ‖L‖ * ‖f a‖ * C), + have I2 : ∀ᶠ (q : P × G) in 𝓝[s ×ˢ univ] q₀, ∀ᵐ a ∂μ, ‖L (f a) (g q.1 (q.2 - a))‖ ≤ bound a, + { obtain ⟨V, V_mem, hV⟩ : ∃ (V : set G) (H : V ∈ 𝓝 (0 : G)), K' + V ⊆ U, + from compact_open_separated_add_right hK' U_open K'U, + have : ((w ∩ s) ×ˢ ({q₀.2} + V) : set (P × G)) ∈ 𝓝[s ×ˢ univ] q₀, + { conv_rhs { rw [← @prod.mk.eta _ _ q₀, nhds_within_prod_eq, nhds_within_univ] }, + refine filter.prod_mem_prod _ (singleton_add_mem_nhds_of_nhds_zero q₀.2 V_mem), + exact mem_nhds_within_iff_exists_mem_nhds_inter.2 ⟨w, w_open.mem_nhds q₀w, subset.rfl⟩ }, + filter_upwards [this], + rintros ⟨p, x⟩ hpx, + simp only [prod_mk_mem_set_prod_eq] at hpx, + apply eventually_of_forall (λ a, _), + apply convolution_integrand_bound_right_of_le_of_subset _ _ hpx.2 _, + { assume x, + exact hw _ _ hpx.1 }, + { rw ← add_assoc, + apply subset.trans (add_subset_add_right (add_subset_add_right _)) hV, + rw neg_subset_neg, + exact B p hpx.1.2 } }, + have I3 : integrable bound μ, + { rw [integrable_indicator_iff U_open.measurable_set], + exact (hU.norm.const_mul _).mul_const _ }, + have I4 : ∀ᵐ (a : G) ∂μ, continuous_within_at (λ (q : P × G), L (f a) (g q.1 (q.2 - a))) + (s ×ˢ univ) q₀, + { apply eventually_of_forall (λ a, _), + suffices H : continuous_within_at (λ (q : P × G), (f a, g q.1 (q.2 - a))) (s ×ˢ univ) q₀, + from L.continuous₂.continuous_at.comp_continuous_within_at H, + apply continuous_within_at_const.prod, + change continuous_within_at (λ (q : P × G), ↿g (q.1, q.2 - a)) (s ×ˢ univ) q₀, + have : continuous_at (λ (q : P × G), (q.1, q.2 - a)) (q₀.1, q₀.2), + from (continuous_fst.prod_mk (continuous_snd.sub continuous_const)).continuous_at, + rw ← @prod.mk.eta _ _ q₀, + have h'q₀ : (q₀.1, q₀.2 - a) ∈ (s ×ˢ univ : set (P × G)) := ⟨hq₀, mem_univ _⟩, + refine continuous_within_at.comp (hg _ h'q₀) this.continuous_within_at _, + rintros ⟨q, x⟩ ⟨hq, hx⟩, + exact ⟨hq, mem_univ _⟩ }, + exact continuous_within_at_of_dominated I1 I2 I3 I4, +end + +/-- The convolution `f * g` is continuous if `f` is locally integrable and `g` is continuous and +compactly supported. Version where `g` depends on an additional parameter in a subset `s` of +a parameter space `P` (and the compact support `k` is independent of the parameter in `s`). -/ +lemma continuous_on_convolution_right_with_param + [t2_space G] {g : P → G → E'} {s : set P} {k : set G} (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : continuous_on (↿g) (s ×ˢ univ)) : + continuous_on (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2) (s ×ˢ univ) := +continuous_on_convolution_right_with_param' L hk hk.is_closed hgs hf hg + +/-- The convolution `f * g` is continuous if `f` is locally integrable and `g` is continuous and +compactly supported. Version where `g` depends on an additional parameter in an open subset `s` of +a parameter space `P` (and the compact support `k` is independent of the parameter in `s`), +given in terms of compositions with an additional continuous map. +Version not assuming `t2_space G`. -/ +lemma continuous_on_convolution_right_with_param_comp' + {s : set P} {v : P → G} (hv : continuous_on v s) + {g : P → G → E'} {k : set G} + (hk : is_compact k) (h'k : is_closed k) (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : continuous_on (↿g) (s ×ˢ univ)) : + continuous_on (λ x, (f ⋆[L, μ] g x) (v x)) s := +begin + apply (continuous_on_convolution_right_with_param' L hk h'k hgs hf hg).comp + (continuous_on_id.prod hv), + assume x hx, + simp only [hx, prod_mk_mem_set_prod_eq, mem_univ, and_self, id.def], +end + +/-- The convolution `f * g` is continuous if `f` is locally integrable and `g` is continuous and +compactly supported. Version where `g` depends on an additional parameter in an open subset `s` of +a parameter space `P` (and the compact support `k` is independent of the parameter in `s`), +given in terms of compositions with an additional continuous map. -/ +lemma continuous_on_convolution_right_with_param_comp [t2_space G] + {s : set P} {v : P → G} (hv : continuous_on v s) + {g : P → G → E'} {k : set G} + (hk : is_compact k) (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : continuous_on (↿g) (s ×ˢ univ)) : + continuous_on (λ x, (f ⋆[L, μ] g x) (v x)) s := +continuous_on_convolution_right_with_param_comp' L hv hk hk.is_closed hgs hf hg + +/-- The convolution is continuous if one function is locally integrable and the other has compact +support and is continuous. -/ +lemma has_compact_support.continuous_convolution_right + (hcg : has_compact_support g) (hf : locally_integrable f μ) + (hg : continuous g) : continuous (f ⋆[L, μ] g) := +begin + rw continuous_iff_continuous_on_univ, + let g' : G → G → E' := λ p q, g q, + have : continuous_on (↿g') (univ ×ˢ univ) := (hg.comp continuous_snd).continuous_on, + exact continuous_on_convolution_right_with_param_comp' L + (continuous_iff_continuous_on_univ.1 continuous_id) hcg (is_closed_tsupport _) + (λ p x hp hx, image_eq_zero_of_nmem_tsupport hx) hf this, +end + +/-- The convolution is continuous if one function is integrable and the other is bounded and +continuous. -/ +lemma bdd_above.continuous_convolution_right_of_integrable [second_countable_topology G] + (hbg : bdd_above (range (λ x, ‖g x‖))) (hf : integrable f μ) (hg : continuous g) : + continuous (f ⋆[L, μ] g) := +begin + refine continuous_iff_continuous_at.mpr (λ x₀, _), + have : ∀ᶠ x in 𝓝 x₀, ∀ᵐ (t : G) ∂μ, + ‖L (f t) (g (x - t))‖ ≤ ‖L‖ * ‖f t‖ * (⨆ i, ‖g i‖), + { refine eventually_of_forall (λ x, eventually_of_forall $ λ t, _), + refine (L.le_op_norm₂ _ _).trans _, + exact mul_le_mul_of_nonneg_left (le_csupr hbg $ x - t) + (mul_nonneg (norm_nonneg _) (norm_nonneg _)) }, + refine continuous_at_of_dominated _ this _ _, + { exact eventually_of_forall + (λ x, hf.ae_strongly_measurable.convolution_integrand_snd' L hg.ae_strongly_measurable) }, + { exact (hf.norm.const_mul _).mul_const _ }, + { exact eventually_of_forall (λ t, (L.continuous₂.comp₂ continuous_const $ + hg.comp $ continuous_id.sub $ by apply continuous_const).continuous_at) } +end + +end group + +section comm_group + +variables [add_comm_group G] + +lemma support_convolution_subset : support (f ⋆[L, μ] g) ⊆ support f + support g := +(support_convolution_subset_swap L).trans (add_comm _ _).subset + +variables [is_add_left_invariant μ] [is_neg_invariant μ] + +section measurable +variables [has_measurable_neg G] +variables [has_measurable_add G] + +variable (L) +/-- Commutativity of convolution -/ +lemma convolution_flip : g ⋆[L.flip, μ] f = f ⋆[L, μ] g := +begin + ext1 x, + simp_rw [convolution_def], + rw [← integral_sub_left_eq_self _ μ x], + simp_rw [sub_sub_self, flip_apply] +end + +/-- The symmetric definition of convolution. -/ +lemma convolution_eq_swap : (f ⋆[L, μ] g) x = ∫ t, L (f (x - t)) (g t) ∂μ := +by { rw [← convolution_flip], refl } + +/-- The symmetric definition of convolution where the bilinear operator is scalar multiplication. -/ +lemma convolution_lsmul_swap {f : G → 𝕜} {g : G → F}: + (f ⋆[lsmul 𝕜 𝕜, μ] g : G → F) x = ∫ t, f (x - t) • g t ∂μ := +convolution_eq_swap _ + +/-- The symmetric definition of convolution where the bilinear operator is multiplication. -/ +lemma convolution_mul_swap [normed_space ℝ 𝕜] [complete_space 𝕜] {f : G → 𝕜} {g : G → 𝕜} : + (f ⋆[mul 𝕜 𝕜, μ] g) x = ∫ t, f (x - t) * g t ∂μ := +convolution_eq_swap _ + +/-- The convolution of two even functions is also even. -/ +lemma convolution_neg_of_neg_eq (h1 : ∀ᵐ x ∂μ, f (-x) = f x) (h2 : ∀ᵐ x ∂μ, g (-x) = g x) : + (f ⋆[L, μ] g) (-x) = (f ⋆[L, μ] g) x := +calc ∫ (t : G), (L (f t)) (g (-x - t)) ∂μ + = ∫ (t : G), (L (f (-t))) (g (x + t)) ∂μ : + begin + apply integral_congr_ae, + filter_upwards [h1, (eventually_add_left_iff μ x).2 h2] with t ht h't, + simp_rw [ht, ← h't, neg_add'], + end +... = ∫ (t : G), (L (f t)) (g (x - t)) ∂μ : + by { rw ← integral_neg_eq_self, simp only [neg_neg, ← sub_eq_add_neg] } + +end measurable + +variables [topological_space G] +variables [topological_add_group G] +variables [borel_space G] + +lemma has_compact_support.continuous_convolution_left [first_countable_topology G] + (hcf : has_compact_support f) (hf : continuous f) (hg : locally_integrable g μ) : + continuous (f ⋆[L, μ] g) := +by { rw [← convolution_flip], exact hcf.continuous_convolution_right L.flip hg hf } + +lemma bdd_above.continuous_convolution_left_of_integrable [second_countable_topology G] + (hbf : bdd_above (range (λ x, ‖f x‖))) (hf : continuous f) (hg : integrable g μ) : + continuous (f ⋆[L, μ] g) := +by { rw [← convolution_flip], exact hbf.continuous_convolution_right_of_integrable L.flip hg hf } + +end comm_group + +section normed_add_comm_group + +variables [seminormed_add_comm_group G] + +/-- Compute `(f ⋆ g) x₀` if the support of the `f` is within `metric.ball 0 R`, and `g` is constant +on `metric.ball x₀ R`. + +We can simplify the RHS further if we assume `f` is integrable, but also if `L = (•)` or more +generally if `L` has a `antilipschitz_with`-condition. -/ +lemma convolution_eq_right' {x₀ : G} {R : ℝ} + (hf : support f ⊆ ball (0 : G) R) + (hg : ∀ x ∈ ball x₀ R, g x = g x₀) : (f ⋆[L, μ] g) x₀ = ∫ t, L (f t) (g x₀) ∂μ := +begin + have h2 : ∀ t, L (f t) (g (x₀ - t)) = L (f t) (g x₀), + { intro t, by_cases ht : t ∈ support f, + { have h2t := hf ht, + rw [mem_ball_zero_iff] at h2t, + specialize hg (x₀ - t), + rw [sub_eq_add_neg, add_mem_ball_iff_norm, norm_neg, ← sub_eq_add_neg] at hg, + rw [hg h2t] }, + { rw [nmem_support] at ht, + simp_rw [ht, L.map_zero₂] } }, + simp_rw [convolution_def, h2], +end + +variables [borel_space G] [second_countable_topology G] +variables [is_add_left_invariant μ] [sigma_finite μ] + +/-- Approximate `(f ⋆ g) x₀` if the support of the `f` is bounded within a ball, and `g` is near +`g x₀` on a ball with the same radius around `x₀`. See `dist_convolution_le` for a special case. + +We can simplify the second argument of `dist` further if we add some extra type-classes on `E` +and `𝕜` or if `L` is scalar multiplication. -/ +lemma dist_convolution_le' {x₀ : G} {R ε : ℝ} {z₀ : E'} + (hε : 0 ≤ ε) + (hif : integrable f μ) + (hf : support f ⊆ ball (0 : G) R) + (hmg : ae_strongly_measurable g μ) + (hg : ∀ x ∈ ball x₀ R, dist (g x) z₀ ≤ ε) : + dist ((f ⋆[L, μ] g : G → F) x₀) (∫ t, L (f t) z₀ ∂μ) ≤ ‖L‖ * ∫ x, ‖f x‖ ∂μ * ε := +begin + have hfg : convolution_exists_at f g x₀ L μ, + { refine bdd_above.convolution_exists_at L _ metric.is_open_ball.measurable_set + (subset_trans _ hf) hif.integrable_on hmg, + swap, { refine λ t, mt (λ ht : f t = 0, _), simp_rw [ht, L.map_zero₂] }, + rw [bdd_above_def], + refine ⟨‖z₀‖ + ε, _⟩, + rintro _ ⟨x, hx, rfl⟩, + refine norm_le_norm_add_const_of_dist_le (hg x _), + rwa [mem_ball_iff_norm, norm_sub_rev, ← mem_ball_zero_iff] }, + have h2 : ∀ t, dist (L (f t) (g (x₀ - t))) (L (f t) z₀) ≤ ‖L (f t)‖ * ε, + { intro t, by_cases ht : t ∈ support f, + { have h2t := hf ht, + rw [mem_ball_zero_iff] at h2t, + specialize hg (x₀ - t), + rw [sub_eq_add_neg, add_mem_ball_iff_norm, norm_neg, ← sub_eq_add_neg] at hg, + refine ((L (f t)).dist_le_op_norm _ _).trans _, + exact mul_le_mul_of_nonneg_left (hg h2t) (norm_nonneg _) }, + { rw [nmem_support] at ht, + simp_rw [ht, L.map_zero₂, L.map_zero, norm_zero, zero_mul, dist_self] } }, + simp_rw [convolution_def], + simp_rw [dist_eq_norm] at h2 ⊢, + rw [← integral_sub hfg.integrable], swap, { exact (L.flip z₀).integrable_comp hif }, + refine (norm_integral_le_of_norm_le ((L.integrable_comp hif).norm.mul_const ε) + (eventually_of_forall h2)).trans _, + rw [integral_mul_right], + refine mul_le_mul_of_nonneg_right _ hε, + have h3 : ∀ t, ‖L (f t)‖ ≤ ‖L‖ * ‖f t‖, + { intros t, + exact L.le_op_norm (f t) }, + refine (integral_mono (L.integrable_comp hif).norm (hif.norm.const_mul _) h3).trans_eq _, + rw [integral_mul_left] +end + +variables [normed_space ℝ E] [normed_space ℝ E'] [complete_space E'] + +/-- Approximate `f ⋆ g` if the support of the `f` is bounded within a ball, and `g` is near `g x₀` +on a ball with the same radius around `x₀`. + +This is a special case of `dist_convolution_le'` where `L` is `(•)`, `f` has integral 1 and `f` is +nonnegative. -/ +lemma dist_convolution_le {f : G → ℝ} {x₀ : G} {R ε : ℝ} {z₀ : E'} + (hε : 0 ≤ ε) + (hf : support f ⊆ ball (0 : G) R) + (hnf : ∀ x, 0 ≤ f x) + (hintf : ∫ x, f x ∂μ = 1) + (hmg : ae_strongly_measurable g μ) + (hg : ∀ x ∈ ball x₀ R, dist (g x) z₀ ≤ ε) : + dist ((f ⋆[lsmul ℝ ℝ, μ] g : G → E') x₀) z₀ ≤ ε := +begin + have hif : integrable f μ, + { by_contra hif, exact zero_ne_one ((integral_undef hif).symm.trans hintf) }, + convert (dist_convolution_le' _ hε hif hf hmg hg).trans _, + { simp_rw [lsmul_apply, integral_smul_const, hintf, one_smul] }, + { simp_rw [real.norm_of_nonneg (hnf _), hintf, mul_one], + exact (mul_le_mul_of_nonneg_right op_norm_lsmul_le hε).trans_eq (one_mul ε) } +end + +/-- `(φ i ⋆ g i) (k i)` tends to `z₀` as `i` tends to some filter `l` if +* `φ` is a sequence of nonnegative functions with integral `1` as `i` tends to `l`; +* The support of `φ` tends to small neighborhoods around `(0 : G)` as `i` tends to `l`; +* `g i` is `mu`-a.e. strongly measurable as `i` tends to `l`; +* `g i x` tends to `z₀` as `(i, x)` tends to `l ×ᶠ 𝓝 x₀`; +* `k i` tends to `x₀`. + +See also `cont_diff_bump.convolution_tendsto_right`. +-/ +lemma convolution_tendsto_right + {ι} {g : ι → G → E'} {l : filter ι} {x₀ : G} {z₀ : E'} + {φ : ι → G → ℝ} {k : ι → G} + (hnφ : ∀ᶠ i in l, ∀ x, 0 ≤ φ i x) + (hiφ : ∀ᶠ i in l, ∫ x, φ i x ∂μ = 1) -- todo: we could weaken this to "the integral tends to 1" + (hφ : tendsto (λ n, support (φ n)) l (𝓝 0).small_sets) + (hmg : ∀ᶠ i in l, ae_strongly_measurable (g i) μ) + (hcg : tendsto (uncurry g) (l ×ᶠ 𝓝 x₀) (𝓝 z₀)) + (hk : tendsto k l (𝓝 x₀)) : + tendsto (λ i : ι, (φ i ⋆[lsmul ℝ ℝ, μ] g i : G → E') (k i)) l (𝓝 z₀) := +begin + simp_rw [tendsto_small_sets_iff] at hφ, + rw [metric.tendsto_nhds] at hcg ⊢, + simp_rw [metric.eventually_prod_nhds_iff] at hcg, + intros ε hε, + have h2ε : 0 < ε / 3 := div_pos hε (by norm_num), + obtain ⟨p, hp, δ, hδ, hgδ⟩ := hcg _ h2ε, + dsimp only [uncurry] at hgδ, + have h2k := hk.eventually (ball_mem_nhds x₀ $ half_pos hδ), + have h2φ := (hφ (ball (0 : G) _) $ ball_mem_nhds _ (half_pos hδ)), + filter_upwards [hp, h2k, h2φ, hnφ, hiφ, hmg] with i hpi hki hφi hnφi hiφi hmgi, + have hgi : dist (g i (k i)) z₀ < ε / 3 := hgδ hpi (hki.trans $ half_lt_self hδ), + have h1 : ∀ x' ∈ ball (k i) (δ / 2), dist (g i x') (g i (k i)) ≤ ε / 3 + ε / 3, + { intros x' hx', + refine (dist_triangle_right _ _ _).trans (add_le_add (hgδ hpi _).le hgi.le), + exact ((dist_triangle _ _ _).trans_lt (add_lt_add hx'.out hki)).trans_eq (add_halves δ) }, + have := dist_convolution_le (add_pos h2ε h2ε).le hφi hnφi hiφi hmgi h1, + refine ((dist_triangle _ _ _).trans_lt (add_lt_add_of_le_of_lt this hgi)).trans_eq _, + field_simp, ring_nf +end + +end normed_add_comm_group + +namespace cont_diff_bump + +variables {n : ℕ∞} +variables [normed_space ℝ E'] +variables [normed_add_comm_group G] [normed_space ℝ G] [has_cont_diff_bump G] +variables [complete_space E'] +variables {a : G} {φ : cont_diff_bump (0 : G)} + +/-- If `φ` is a bump function, compute `(φ ⋆ g) x₀` if `g` is constant on `metric.ball x₀ φ.R`. -/ +lemma convolution_eq_right {x₀ : G} + (hg : ∀ x ∈ ball x₀ φ.R, g x = g x₀) : (φ ⋆[lsmul ℝ ℝ, μ] g : G → E') x₀ = integral μ φ • g x₀ := +by simp_rw [convolution_eq_right' _ φ.support_eq.subset hg, lsmul_apply, integral_smul_const] + +variables [borel_space G] +variables [is_locally_finite_measure μ] [is_open_pos_measure μ] +variables [finite_dimensional ℝ G] + +/-- If `φ` is a normed bump function, compute `φ ⋆ g` if `g` is constant on `metric.ball x₀ φ.R`. -/ +lemma normed_convolution_eq_right {x₀ : G} + (hg : ∀ x ∈ ball x₀ φ.R, g x = g x₀) : (φ.normed μ ⋆[lsmul ℝ ℝ, μ] g : G → E') x₀ = g x₀ := +by { simp_rw [convolution_eq_right' _ φ.support_normed_eq.subset hg, lsmul_apply], + exact integral_normed_smul φ μ (g x₀) } + +variables [is_add_left_invariant μ] + +/-- If `φ` is a normed bump function, approximate `(φ ⋆ g) x₀` if `g` is near `g x₀` on a ball with +radius `φ.R` around `x₀`. -/ +lemma dist_normed_convolution_le {x₀ : G} {ε : ℝ} + (hmg : ae_strongly_measurable g μ) + (hg : ∀ x ∈ ball x₀ φ.R, dist (g x) (g x₀) ≤ ε) : + dist ((φ.normed μ ⋆[lsmul ℝ ℝ, μ] g : G → E') x₀) (g x₀) ≤ ε := +dist_convolution_le (by simp_rw [← dist_self (g x₀), hg x₀ (mem_ball_self φ.R_pos)]) + φ.support_normed_eq.subset φ.nonneg_normed φ.integral_normed hmg hg + +/-- `(φ i ⋆ g i) (k i)` tends to `z₀` as `i` tends to some filter `l` if +* `φ` is a sequence of normed bump functions such that `(φ i).R` tends to `0` as `i` tends to `l`; +* `g i` is `mu`-a.e. strongly measurable as `i` tends to `l`; +* `g i x` tends to `z₀` as `(i, x)` tends to `l ×ᶠ 𝓝 x₀`; +* `k i` tends to `x₀`. -/ +lemma convolution_tendsto_right {ι} {φ : ι → cont_diff_bump (0 : G)} + {g : ι → G → E'} {k : ι → G} {x₀ : G} {z₀ : E'} {l : filter ι} + (hφ : tendsto (λ i, (φ i).R) l (𝓝 0)) + (hig : ∀ᶠ i in l, ae_strongly_measurable (g i) μ) + (hcg : tendsto (uncurry g) (l ×ᶠ 𝓝 x₀) (𝓝 z₀)) + (hk : tendsto k l (𝓝 x₀)) : + tendsto (λ i, ((λ x, (φ i).normed μ x) ⋆[lsmul ℝ ℝ, μ] g i : G → E') (k i)) l (𝓝 z₀) := +convolution_tendsto_right (eventually_of_forall $ λ i, (φ i).nonneg_normed) + (eventually_of_forall $ λ i, (φ i).integral_normed) + (tendsto_support_normed_small_sets hφ) hig hcg hk + +/-- Special case of `cont_diff_bump.convolution_tendsto_right` where `g` is continuous, + and the limit is taken only in the first function. -/ +lemma convolution_tendsto_right_of_continuous {ι} {φ : ι → cont_diff_bump (0 : G)} + {l : filter ι} (hφ : tendsto (λ i, (φ i).R) l (𝓝 0)) + (hg : continuous g) (x₀ : G) : + tendsto (λ i, ((λ x, (φ i).normed μ x) ⋆[lsmul ℝ ℝ, μ] g : G → E') x₀) l (𝓝 (g x₀)) := +convolution_tendsto_right hφ (eventually_of_forall $ λ _, hg.ae_strongly_measurable) + ((hg.tendsto x₀).comp tendsto_snd) tendsto_const_nhds + +end cont_diff_bump + +end measurability + +end nontrivially_normed_field + +open_locale convolution + +section is_R_or_C + +variables [is_R_or_C 𝕜] +variables [normed_space 𝕜 E] +variables [normed_space 𝕜 E'] +variables [normed_space 𝕜 E''] +variables [normed_space ℝ F] [normed_space 𝕜 F] +variables {n : ℕ∞} +variables [complete_space F] +variables [measurable_space G] {μ ν : measure G} +variables (L : E →L[𝕜] E' →L[𝕜] F) + +section assoc +variables [normed_add_comm_group F'] [normed_space ℝ F'] [normed_space 𝕜 F'] [complete_space F'] +variables [normed_add_comm_group F''] [normed_space ℝ F''] [normed_space 𝕜 F''] [complete_space F''] +variables {k : G → E''} +variables (L₂ : F →L[𝕜] E'' →L[𝕜] F') +variables (L₃ : E →L[𝕜] F'' →L[𝕜] F') +variables (L₄ : E' →L[𝕜] E'' →L[𝕜] F'') +variables [add_group G] +variables [sigma_finite μ] [sigma_finite ν] [is_add_right_invariant μ] + +lemma integral_convolution + [has_measurable_add₂ G] [has_measurable_neg G] + [normed_space ℝ E] [normed_space ℝ E'] + [complete_space E] [complete_space E'] + (hf : integrable f ν) (hg : integrable g μ) : + ∫ x, (f ⋆[L, ν] g) x ∂μ = L (∫ x, f x ∂ν) (∫ x, g x ∂μ) := +begin + refine (integral_integral_swap (by apply hf.convolution_integrand L hg)).trans _, + simp_rw [integral_comp_comm _ (hg.comp_sub_right _), integral_sub_right_eq_self], + exact (L.flip (∫ x, g x ∂μ)).integral_comp_comm hf +end + +variables [has_measurable_add₂ G] [is_add_right_invariant ν] [has_measurable_neg G] + +/-- Convolution is associative. This has a weak but inconvenient integrability condition. +See also `convolution_assoc`. -/ +lemma convolution_assoc' (hL : ∀ (x : E) (y : E') (z : E''), L₂ (L x y) z = L₃ x (L₄ y z)) + {x₀ : G} + (hfg : ∀ᵐ y ∂μ, convolution_exists_at f g y L ν) + (hgk : ∀ᵐ x ∂ν, convolution_exists_at g k x L₄ μ) + (hi : integrable (uncurry (λ x y, (L₃ (f y)) ((L₄ (g (x - y))) (k (x₀ - x))))) (μ.prod ν)) : + ((f ⋆[L, ν] g) ⋆[L₂, μ] k) x₀ = (f ⋆[L₃, ν] (g ⋆[L₄, μ] k)) x₀ := +calc ((f ⋆[L, ν] g) ⋆[L₂, μ] k) x₀ + = ∫ t, L₂ (∫ s, L (f s) (g (t - s)) ∂ν) (k (x₀ - t)) ∂μ : rfl + ... = ∫ t, ∫ s, L₂ (L (f s) (g (t - s))) (k (x₀ - t)) ∂ν ∂μ : + integral_congr_ae (hfg.mono $ λ t ht, ((L₂.flip (k (x₀ - t))).integral_comp_comm ht).symm) + ... = ∫ t, ∫ s, L₃ (f s) (L₄ (g (t - s)) (k (x₀ - t))) ∂ν ∂μ : by simp_rw hL + ... = ∫ s, ∫ t, L₃ (f s) (L₄ (g (t - s)) (k (x₀ - t))) ∂μ ∂ν : by rw [integral_integral_swap hi] + ... = ∫ s, ∫ u, L₃ (f s) (L₄ (g u) (k ((x₀ - s) - u))) ∂μ ∂ν : begin + congr', ext t, + rw [eq_comm, ← integral_sub_right_eq_self _ t], + { simp_rw [sub_sub_sub_cancel_right] }, + { apply_instance }, + end + ... = ∫ s, L₃ (f s) (∫ u, L₄ (g u) (k ((x₀ - s) - u)) ∂μ) ∂ν : begin + refine integral_congr_ae _, + refine ((quasi_measure_preserving_sub_left_of_right_invariant ν x₀).ae hgk).mono (λ t ht, _), + exact (L₃ (f t)).integral_comp_comm ht, + end + ... = (f ⋆[L₃, ν] (g ⋆[L₄, μ] k)) x₀ : rfl + +/-- Convolution is associative. This requires that +* all maps are a.e. strongly measurable w.r.t one of the measures +* `f ⋆[L, ν] g` exists almost everywhere +* `‖g‖ ⋆[μ] ‖k‖` exists almost everywhere +* `‖f‖ ⋆[ν] (‖g‖ ⋆[μ] ‖k‖)` exists at `x₀` -/ +lemma convolution_assoc (hL : ∀ (x : E) (y : E') (z : E''), L₂ (L x y) z = L₃ x (L₄ y z)) + {x₀ : G} + (hf : ae_strongly_measurable f ν) + (hg : ae_strongly_measurable g μ) + (hk : ae_strongly_measurable k μ) + (hfg : ∀ᵐ y ∂μ, convolution_exists_at f g y L ν) + (hgk : ∀ᵐ x ∂ν, convolution_exists_at (λ x, ‖g x‖) (λ x, ‖k x‖) x (mul ℝ ℝ) μ) + (hfgk : convolution_exists_at (λ x, ‖f x‖) ((λ x, ‖g x‖) ⋆[mul ℝ ℝ, μ] (λ x, ‖k x‖)) + x₀ (mul ℝ ℝ) ν) : + ((f ⋆[L, ν] g) ⋆[L₂, μ] k) x₀ = (f ⋆[L₃, ν] (g ⋆[L₄, μ] k)) x₀ := +begin + refine convolution_assoc' L L₂ L₃ L₄ hL hfg (hgk.mono $ λ x hx, hx.of_norm L₄ hg hk) _, + /- the following is similar to `integrable.convolution_integrand` -/ + have h_meas : ae_strongly_measurable + (uncurry (λ x y, L₃ (f y) (L₄ (g x) (k (x₀ - y - x))))) (μ.prod ν), + { refine L₃.ae_strongly_measurable_comp₂ hf.snd _, + refine L₄.ae_strongly_measurable_comp₂ hg.fst _, + refine (hk.mono' _).comp_measurable ((measurable_const.sub measurable_snd).sub measurable_fst), + refine quasi_measure_preserving.absolutely_continuous _, + refine quasi_measure_preserving.prod_of_left + ((measurable_const.sub measurable_snd).sub measurable_fst) (eventually_of_forall $ λ y, _), + dsimp only, + exact quasi_measure_preserving_sub_left_of_right_invariant μ _ }, + have h2_meas : ae_strongly_measurable (λ y, ∫ x, ‖L₃ (f y) (L₄ (g x) (k (x₀ - y - x)))‖ ∂μ) ν := + h_meas.prod_swap.norm.integral_prod_right', + have h3 : map (λ z : G × G, (z.1 - z.2, z.2)) (μ.prod ν) = μ.prod ν := + (measure_preserving_sub_prod μ ν).map_eq, + suffices : integrable (uncurry (λ x y, L₃ (f y) (L₄ (g x) (k (x₀ - y - x))))) (μ.prod ν), + { rw [← h3] at this, + convert this.comp_measurable (measurable_sub.prod_mk measurable_snd), + ext ⟨x, y⟩, + simp_rw [uncurry, function.comp_apply, sub_sub_sub_cancel_right] }, + simp_rw [integrable_prod_iff' h_meas], + refine ⟨((quasi_measure_preserving_sub_left_of_right_invariant ν x₀).ae hgk).mono + (λ t ht, (L₃ (f t)).integrable_comp $ ht.of_norm L₄ hg hk), _⟩, + refine (hfgk.const_mul (‖L₃‖ * ‖L₄‖)).mono' h2_meas + (((quasi_measure_preserving_sub_left_of_right_invariant ν x₀).ae hgk).mono $ λ t ht, _), + { simp_rw [convolution_def, mul_apply', mul_mul_mul_comm ‖L₃‖ ‖L₄‖, ← integral_mul_left], + rw [real.norm_of_nonneg], + { refine integral_mono_of_nonneg (eventually_of_forall $ λ t, norm_nonneg _) + ((ht.const_mul _).const_mul _) (eventually_of_forall $ λ s, _), + refine (L₃.le_op_norm₂ _ _).trans _, + refine mul_le_mul_of_nonneg_left _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)), + rw [← mul_assoc], + apply L₄.le_op_norm₂ }, + exact integral_nonneg (λ x, norm_nonneg _) } +end + +end assoc + +variables [normed_add_comm_group G] [borel_space G] + +lemma convolution_precompR_apply {g : G → E'' →L[𝕜] E'} + (hf : locally_integrable f μ) (hcg : has_compact_support g) (hg : continuous g) + (x₀ : G) (x : E'') : (f ⋆[L.precompR E'', μ] g) x₀ x = (f ⋆[L, μ] (λ a, g a x)) x₀ := +begin + have := hcg.convolution_exists_right (L.precompR E'' : _) hf hg x₀, + simp_rw [convolution_def, continuous_linear_map.integral_apply this], + refl, +end + +variables [normed_space 𝕜 G] [sigma_finite μ] [is_add_left_invariant μ] + +/-- Compute the total derivative of `f ⋆ g` if `g` is `C^1` with compact support and `f` is locally +integrable. To write down the total derivative as a convolution, we use +`continuous_linear_map.precompR`. -/ +lemma has_compact_support.has_fderiv_at_convolution_right + (hcg : has_compact_support g) (hf : locally_integrable f μ) (hg : cont_diff 𝕜 1 g) (x₀ : G) : + has_fderiv_at (f ⋆[L, μ] g) ((f ⋆[L.precompR G, μ] fderiv 𝕜 g) x₀) x₀ := +begin + rcases hcg.eq_zero_or_finite_dimensional 𝕜 hg.continuous with rfl|fin_dim, + { have : fderiv 𝕜 (0 : G → E') = 0, from fderiv_const (0 : E'), + simp only [this, convolution_zero, pi.zero_apply], + exact has_fderiv_at_const (0 : F) x₀ }, + resetI, + haveI : proper_space G, from finite_dimensional.proper_is_R_or_C 𝕜 G, + set L' := L.precompR G, + have h1 : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (λ t, L (f t) (g (x - t))) μ := + eventually_of_forall + (hf.ae_strongly_measurable.convolution_integrand_snd L hg.continuous.ae_strongly_measurable), + have h2 : ∀ x, ae_strongly_measurable (λ t, L' (f t) (fderiv 𝕜 g (x - t))) μ, + { exact hf.ae_strongly_measurable.convolution_integrand_snd L' + (hg.continuous_fderiv le_rfl).ae_strongly_measurable }, + have h3 : ∀ x t, has_fderiv_at (λ x, g (x - t)) (fderiv 𝕜 g (x - t)) x, + { intros x t, + simpa using (hg.differentiable le_rfl).differentiable_at.has_fderiv_at.comp x + ((has_fderiv_at_id x).sub (has_fderiv_at_const t x)) }, + let K' := - tsupport (fderiv 𝕜 g) + closed_ball x₀ 1, + have hK' : is_compact K' := (hcg.fderiv 𝕜).neg.add (is_compact_closed_ball x₀ 1), + refine has_fderiv_at_integral_of_dominated_of_fderiv_le + zero_lt_one h1 _ (h2 x₀) _ _ _, + { exact K'.indicator (λ t, ‖L'‖ * ‖f t‖ * (⨆ x, ‖fderiv 𝕜 g x‖)) }, + { exact hcg.convolution_exists_right L hf hg.continuous x₀ }, + { refine eventually_of_forall (λ t x hx, _), + exact (hcg.fderiv 𝕜).convolution_integrand_bound_right L' + (hg.continuous_fderiv le_rfl) (ball_subset_closed_ball hx) }, + { rw [integrable_indicator_iff hK'.measurable_set], + exact ((hf.integrable_on_is_compact hK').norm.const_mul _).mul_const _ }, + { exact eventually_of_forall (λ t x hx, (L _).has_fderiv_at.comp x (h3 x t)) }, +end + +lemma has_compact_support.has_fderiv_at_convolution_left [is_neg_invariant μ] + (hcf : has_compact_support f) (hf : cont_diff 𝕜 1 f) (hg : locally_integrable g μ) (x₀ : G) : + has_fderiv_at (f ⋆[L, μ] g) ((fderiv 𝕜 f ⋆[L.precompL G, μ] g) x₀) x₀ := +begin + simp only [← convolution_flip] {single_pass := tt}, + exact hcf.has_fderiv_at_convolution_right L.flip hg hf x₀, +end + +end is_R_or_C + +section real +/-! The one-variable case -/ + +variables [is_R_or_C 𝕜] +variables [normed_space 𝕜 E] +variables [normed_space 𝕜 E'] +variables [normed_space ℝ F] [normed_space 𝕜 F] +variables {f₀ : 𝕜 → E} {g₀ : 𝕜 → E'} +variables {n : ℕ∞} +variables (L : E →L[𝕜] E' →L[𝕜] F) +variables [complete_space F] +variables {μ : measure 𝕜} +variables [is_add_left_invariant μ] [sigma_finite μ] + +lemma has_compact_support.has_deriv_at_convolution_right + (hf : locally_integrable f₀ μ) (hcg : has_compact_support g₀) (hg : cont_diff 𝕜 1 g₀) + (x₀ : 𝕜) : + has_deriv_at (f₀ ⋆[L, μ] g₀) ((f₀ ⋆[L, μ] deriv g₀) x₀) x₀ := +begin + convert (hcg.has_fderiv_at_convolution_right L hf hg x₀).has_deriv_at, + rw [convolution_precompR_apply L hf (hcg.fderiv 𝕜) (hg.continuous_fderiv le_rfl)], + refl, +end + +lemma has_compact_support.has_deriv_at_convolution_left [is_neg_invariant μ] + (hcf : has_compact_support f₀) (hf : cont_diff 𝕜 1 f₀) + (hg : locally_integrable g₀ μ) (x₀ : 𝕜) : + has_deriv_at (f₀ ⋆[L, μ] g₀) ((deriv f₀ ⋆[L, μ] g₀) x₀) x₀ := +begin + simp only [← convolution_flip] {single_pass := tt}, + exact hcf.has_deriv_at_convolution_right L.flip hg hf x₀, +end + +end real + +section with_param + +variables [is_R_or_C 𝕜] [normed_space 𝕜 E] [normed_space 𝕜 E'] [normed_space 𝕜 E''] +[normed_space ℝ F] [normed_space 𝕜 F] [complete_space F] [measurable_space G] +[normed_add_comm_group G] [borel_space G] [normed_space 𝕜 G] +[normed_add_comm_group P] [normed_space 𝕜 P] +{μ : measure G} (L : E →L[𝕜] E' →L[𝕜] F) + +/-- The derivative of the convolution `f * g` is given by `f * Dg`, when `f` is locally integrable +and `g` is `C^1` and compactly supported. Version where `g` depends on an additional parameter in an +open subset `s` of a parameter space `P` (and the compact support `k` is independent of the +parameter in `s`). -/ +lemma has_fderiv_at_convolution_right_with_param + {g : P → G → E'} {s : set P} {k : set G} (hs : is_open s) (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : cont_diff_on 𝕜 1 ↿g (s ×ˢ univ)) + (q₀ : P × G) (hq₀ : q₀.1 ∈ s) : + has_fderiv_at (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2) + ((f ⋆[L.precompR (P × G), μ] (λ (x : G), fderiv 𝕜 ↿g (q₀.1, x))) q₀.2) q₀ := +begin + let g' := fderiv 𝕜 ↿g, + have A : ∀ p ∈ s, continuous (g p), + { assume p hp, + apply hg.continuous_on.comp_continuous (continuous_const.prod_mk continuous_id') (λ x, _), + simpa only [prod_mk_mem_set_prod_eq, mem_univ, and_true] using hp }, + have A' : ∀ (q : P × G), q.1 ∈ s → s ×ˢ univ ∈ 𝓝 q, + { assume q hq, + apply (hs.prod is_open_univ).mem_nhds, + simpa only [mem_prod, mem_univ, and_true] using hq }, + /- The derivative of `g` vanishes away from `k`. -/ + have g'_zero : ∀ p x, p ∈ s → x ∉ k → g' (p, x) = 0, + { assume p x hp hx, + refine (has_fderiv_at_zero_of_eventually_const 0 _).fderiv, + have M2 : kᶜ ∈ 𝓝 x, from is_open.mem_nhds hk.is_closed.is_open_compl hx, + have M1 : s ∈ 𝓝 p, from hs.mem_nhds hp, + rw nhds_prod_eq, + filter_upwards [prod_mem_prod M1 M2], + rintros ⟨p, y⟩ ⟨hp, hy⟩, + exact hgs p y hp hy }, + /- We find a small neighborhood of `{q₀.1} × k` on which the derivative is uniformly bounded. This + follows from the continuity at all points of the compact set `k`. -/ + obtain ⟨ε, C, εpos, Cnonneg, h₀ε, hε⟩ : + ∃ ε C, 0 < ε ∧ 0 ≤ C ∧ ball q₀.1 ε ⊆ s ∧ ∀ p x, ‖p - q₀.1‖ < ε → ‖g' (p, x)‖ ≤ C, + { have A : is_compact ({q₀.1} ×ˢ k), from is_compact_singleton.prod hk, + obtain ⟨t, kt, t_open, ht⟩ : ∃ t, {q₀.1} ×ˢ k ⊆ t ∧ is_open t ∧ bounded (g' '' t), + { have B : continuous_on g' (s ×ˢ univ), + from hg.continuous_on_fderiv_of_open (hs.prod is_open_univ) le_rfl, + apply exists_is_open_bounded_image_of_is_compact_of_continuous_on A + (hs.prod is_open_univ) _ B, + simp only [prod_subset_prod_iff, hq₀, singleton_subset_iff, subset_univ, and_self, true_or] }, + obtain ⟨ε, εpos, hε, h'ε⟩ : + ∃ (ε : ℝ), 0 < ε ∧ thickening ε ({q₀.fst} ×ˢ k) ⊆ t ∧ ball q₀.1 ε ⊆ s, + { obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ), 0 < ε ∧ thickening ε ({q₀.fst} ×ˢ k) ⊆ t, + from A.exists_thickening_subset_open t_open kt, + obtain ⟨δ, δpos, hδ⟩ : ∃ (δ : ℝ) (H : 0 < δ), ball q₀.1 δ ⊆ s, + from metric.is_open_iff.1 hs _ hq₀, + refine ⟨min ε δ, lt_min εpos δpos, _, _⟩, + { exact subset.trans (thickening_mono (min_le_left _ _) _) hε }, + { exact subset.trans (ball_subset_ball (min_le_right _ _)) hδ } }, + obtain ⟨C, Cpos, hC⟩ : ∃ C, 0 < C ∧ g' '' t ⊆ closed_ball 0 C, from ht.subset_ball_lt 0 0, + refine ⟨ε, C, εpos, Cpos.le, h'ε, λ p x hp, _⟩, + have hps : p ∈ s, from h'ε (mem_ball_iff_norm.2 hp), + by_cases hx : x ∈ k, + { have H : (p, x) ∈ t, + { apply hε, + refine mem_thickening_iff.2 ⟨(q₀.1, x), _, _⟩, + { simp only [hx, singleton_prod, mem_image, prod.mk.inj_iff, eq_self_iff_true, true_and, + exists_eq_right] }, + { rw ← dist_eq_norm at hp, + simpa only [prod.dist_eq, εpos, dist_self, max_lt_iff, and_true] using hp } }, + have : g' (p, x) ∈ closed_ball (0 : P × G →L[𝕜] E') C, from hC (mem_image_of_mem _ H), + rwa mem_closed_ball_zero_iff at this }, + { have : g' (p, x) = 0, from g'_zero _ _ hps hx, + rw this, + simpa only [norm_zero] using Cpos.le } }, + /- Now, we wish to apply a theorem on differentiation of integrals. For this, we need to check + trivial measurability or integrability assumptions (in `I1`, `I2`, `I3`), as well as a uniform + integrability assumption over the derivative (in `I4` and `I5`) and pointwise differentiability + in `I6`. -/ + have I1 : ∀ᶠ (x : P × G) in 𝓝 q₀, + ae_strongly_measurable (λ (a : G), L (f a) (g x.1 (x.2 - a))) μ, + { filter_upwards [A' q₀ hq₀], + rintros ⟨p, x⟩ ⟨hp, hx⟩, + refine (has_compact_support.convolution_exists_right L _ hf (A _ hp) _).1, + apply is_compact_of_is_closed_subset hk (is_closed_tsupport _), + exact closure_minimal (support_subset_iff'.2 (λ z hz, hgs _ _ hp hz)) hk.is_closed, }, + have I2 : integrable (λ (a : G), L (f a) (g q₀.1 (q₀.2 - a))) μ, + { have M : has_compact_support (g q₀.1), + from has_compact_support.intro hk (λ x hx, hgs q₀.1 x hq₀ hx), + apply M.convolution_exists_right L hf (A q₀.1 hq₀) q₀.2 }, + have I3 : ae_strongly_measurable (λ (a : G), (L (f a)).comp (g' (q₀.fst, q₀.snd - a))) μ, + { have T : has_compact_support (λ y, g' (q₀.1, y)), + from has_compact_support.intro hk (λ x hx, g'_zero q₀.1 x hq₀ hx), + apply (has_compact_support.convolution_exists_right (L.precompR (P × G) : _) T hf _ q₀.2).1, + have : continuous_on g' (s ×ˢ univ), + from hg.continuous_on_fderiv_of_open (hs.prod is_open_univ) le_rfl, + apply this.comp_continuous (continuous_const.prod_mk continuous_id'), + assume x, + simpa only [prod_mk_mem_set_prod_eq, mem_univ, and_true] using hq₀ }, + set K' := - k + {q₀.2} with K'_def, + have hK' : is_compact K' := hk.neg.add is_compact_singleton, + obtain ⟨U, U_open, K'U, hU⟩ : ∃ U, is_open U ∧ K' ⊆ U ∧ integrable_on f U μ, + from hf.integrable_on_nhds_is_compact hK', + obtain ⟨δ, δpos, δε, hδ⟩ : ∃ δ, (0 : ℝ) < δ ∧ δ ≤ ε ∧ K' + ball 0 δ ⊆ U, + { obtain ⟨V, V_mem, hV⟩ : ∃ (V : set G) (V_mem : V ∈ 𝓝 (0 : G)), K' + V ⊆ U, + from compact_open_separated_add_right hK' U_open K'U, + rcases metric.mem_nhds_iff.1 V_mem with ⟨δ, δpos, hδ⟩, + refine ⟨min δ ε, lt_min δpos εpos, min_le_right _ _, _⟩, + exact (add_subset_add_left ((ball_subset_ball (min_le_left _ _)).trans hδ)).trans hV }, + let bound : G → ℝ := indicator U (λ a, ‖L.precompR (P × G)‖ * ‖f a‖ * C), + have I4 : ∀ᵐ (a : G) ∂μ, ∀ (x : P × G), dist x q₀ < δ → + ‖L.precompR (P × G) (f a) (g' (x.fst, x.snd - a))‖ ≤ bound a, + { apply eventually_of_forall, + assume a x hx, + rw [prod.dist_eq, dist_eq_norm, dist_eq_norm] at hx, + have : -tsupport (λ a, g' (x.1, a)) + ball q₀.2 δ ⊆ U, + { apply subset.trans _ hδ, + rw [K'_def, add_assoc], + apply add_subset_add, + { rw neg_subset_neg, + apply closure_minimal (support_subset_iff'.2 (λ z hz, _)) hk.is_closed, + apply g'_zero x.1 z (h₀ε _) hz, + rw mem_ball_iff_norm, + exact ((le_max_left _ _).trans_lt hx).trans_le δε }, + { simp only [add_ball, thickening_singleton, zero_vadd] } }, + apply convolution_integrand_bound_right_of_le_of_subset _ _ _ this, + { assume y, + exact hε _ _ (((le_max_left _ _).trans_lt hx).trans_le δε) }, + { rw mem_ball_iff_norm, + exact (le_max_right _ _).trans_lt hx } }, + have I5 : integrable bound μ, + { rw [integrable_indicator_iff U_open.measurable_set], + exact (hU.norm.const_mul _).mul_const _ }, + have I6 : ∀ᵐ (a : G) ∂μ, ∀ (x : P × G), dist x q₀ < δ → + has_fderiv_at (λ (x : P × G), L (f a) (g x.1 (x.2 - a))) + ((L (f a)).comp (g' (x.fst, x.snd - a))) x, + { apply eventually_of_forall, + assume a x hx, + apply (L _).has_fderiv_at.comp x, + have N : s ×ˢ univ ∈ 𝓝 (x.1, x.2 - a), + { apply A', + apply h₀ε, + rw prod.dist_eq at hx, + exact lt_of_lt_of_le (lt_of_le_of_lt (le_max_left _ _) hx) δε }, + have Z := ((hg.differentiable_on le_rfl).differentiable_at N).has_fderiv_at, + have Z' : has_fderiv_at (λ (x : P × G), (x.1, x.2 - a)) (continuous_linear_map.id 𝕜 (P × G)) x, + { have : (λ (x : P × G), (x.1, x.2 - a)) = id - (λ x, (0, a)), + { ext x; simp only [pi.sub_apply, id.def, prod.fst_sub, sub_zero, prod.snd_sub] }, + simp_rw [this], + exact (has_fderiv_at_id x).sub_const (0, a) }, + exact Z.comp x Z' }, + exact has_fderiv_at_integral_of_dominated_of_fderiv_le δpos I1 I2 I3 I4 I5 I6, +end + +/-- The convolution `f * g` is `C^n` when `f` is locally integrable and `g` is `C^n` and compactly +supported. Version where `g` depends on an additional parameter in an open subset `s` of a +parameter space `P` (and the compact support `k` is independent of the parameter in `s`). +In this version, all the types belong to the same universe (to get an induction working in the +proof). Use instead `cont_diff_on_convolution_right_with_param`, which removes this restriction. -/ +lemma cont_diff_on_convolution_right_with_param_aux + {G : Type uP} {E' : Type uP} {F : Type uP} {P : Type uP} + [normed_add_comm_group E'] [normed_add_comm_group F] + [normed_space 𝕜 E'] [normed_space ℝ F] [normed_space 𝕜 F] [complete_space F] + [measurable_space G] {μ : measure G} [normed_add_comm_group G] [borel_space G] [normed_space 𝕜 G] + [normed_add_comm_group P] [normed_space 𝕜 P] + {f : G → E} {n : ℕ∞} (L : E →L[𝕜] E' →L[𝕜] F) + {g : P → G → E'} + {s : set P} {k : set G} (hs : is_open s) (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : cont_diff_on 𝕜 n ↿g (s ×ˢ univ)) : + cont_diff_on 𝕜 n (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2) (s ×ˢ univ) := +begin + /- We have a formula for the derivation of `f * g`, which is of the same form, thanks to + `has_fderiv_at_convolution_right_with_param`. Therefore, we can prove the result by induction on + `n` (but for this we need the spaces at the different steps of the induction to live in the same + universe, which is why we make the assumption in the lemma that all the relevant spaces + come from the same universe). -/ + unfreezingI { induction n using enat.nat_induction with n ih ih generalizing g E' F }, + { rw [cont_diff_on_zero] at hg ⊢, + exact continuous_on_convolution_right_with_param L hk hgs hf hg }, + { let f' : P → G → (P × G →L[𝕜] F) := λ p a, + (f ⋆[L.precompR (P × G), μ] (λ (x : G), fderiv 𝕜 (uncurry g) (p, x))) a, + have A : ∀ (q₀ : P × G), q₀.1 ∈ s → + has_fderiv_at (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2) (f' q₀.1 q₀.2) q₀, + from has_fderiv_at_convolution_right_with_param L hs hk hgs hf hg.one_of_succ, + rw cont_diff_on_succ_iff_fderiv_of_open (hs.prod (@is_open_univ G _)) at ⊢ hg, + split, + { rintros ⟨p, x⟩ ⟨hp, hx⟩, + exact (A (p, x) hp).differentiable_at.differentiable_within_at, }, + { suffices H : cont_diff_on 𝕜 n ↿f' (s ×ˢ univ), + { apply H.congr, + rintros ⟨p, x⟩ ⟨hp, hx⟩, + exact (A (p, x) hp).fderiv }, + have B : ∀ (p : P) (x : G), p ∈ s → x ∉ k → fderiv 𝕜 (uncurry g) (p, x) = 0, + { assume p x hp hx, + apply (has_fderiv_at_zero_of_eventually_const (0 : E') _).fderiv, + have M2 : kᶜ ∈ 𝓝 x, from is_open.mem_nhds hk.is_closed.is_open_compl hx, + have M1 : s ∈ 𝓝 p, from hs.mem_nhds hp, + rw nhds_prod_eq, + filter_upwards [prod_mem_prod M1 M2], + rintros ⟨p, y⟩ ⟨hp, hy⟩, + exact hgs p y hp hy }, + apply ih (L.precompR (P × G) : _) B, + convert hg.2, + apply funext, + rintros ⟨p, x⟩, + refl } }, + { rw [cont_diff_on_top] at hg ⊢, + assume n, + exact ih n L hgs (hg n) } +end + +/-- The convolution `f * g` is `C^n` when `f` is locally integrable and `g` is `C^n` and compactly +supported. Version where `g` depends on an additional parameter in an open subset `s` of a +parameter space `P` (and the compact support `k` is independent of the parameter in `s`). -/ +lemma cont_diff_on_convolution_right_with_param + {f : G → E} {n : ℕ∞} (L : E →L[𝕜] E' →L[𝕜] F) {g : P → G → E'} + {s : set P} {k : set G} (hs : is_open s) (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : cont_diff_on 𝕜 n ↿g (s ×ˢ univ)) : + cont_diff_on 𝕜 n (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2) (s ×ˢ univ) := +begin + /- The result is known when all the universes are the same, from + `cont_diff_on_convolution_right_with_param_aux`. We reduce to this situation by pushing + everything through `ulift` continuous linear equivalences. -/ + let eG : Type (max uG uE' uF uP) := ulift G, + borelize eG, + let eE' : Type (max uE' uG uF uP) := ulift E', + let eF : Type (max uF uG uE' uP) := ulift F, + let eP : Type (max uP uG uE' uF) := ulift P, + have isoG : eG ≃L[𝕜] G := continuous_linear_equiv.ulift, + have isoE' : eE' ≃L[𝕜] E' := continuous_linear_equiv.ulift, + have isoF : eF ≃L[𝕜] F := continuous_linear_equiv.ulift, + have isoP : eP ≃L[𝕜] P := continuous_linear_equiv.ulift, + let ef := f ∘ isoG, + let eμ : measure eG := measure.map isoG.symm μ, + let eg : eP → eG → eE' := λ ep ex, isoE'.symm (g (isoP ep) (isoG ex)), + let eL := continuous_linear_map.comp + ((continuous_linear_equiv.arrow_congr isoE' isoF).symm : (E' →L[𝕜] F) →L[𝕜] eE' →L[𝕜] eF) L, + let R := (λ (q : eP × eG), (ef ⋆[eL, eμ] eg q.1) q.2), + have R_contdiff : cont_diff_on 𝕜 n R ((isoP ⁻¹' s) ×ˢ univ), + { have hek : is_compact (isoG ⁻¹' k), + from isoG.to_homeomorph.closed_embedding.is_compact_preimage hk, + have hes : is_open (isoP ⁻¹' s), from isoP.continuous.is_open_preimage _ hs, + refine cont_diff_on_convolution_right_with_param_aux eL hes hek _ _ _, + { assume p x hp hx, + simp only [comp_app, continuous_linear_equiv.prod_apply, linear_isometry_equiv.coe_coe, + continuous_linear_equiv.map_eq_zero_iff], + exact hgs _ _ hp hx }, + { apply (locally_integrable_map_homeomorph isoG.symm.to_homeomorph).2, + convert hf, + ext1 x, + simp only [ef, continuous_linear_equiv.coe_to_homeomorph, comp_app, + continuous_linear_equiv.apply_symm_apply], }, + { apply isoE'.symm.cont_diff.comp_cont_diff_on, + apply hg.comp ((isoP.prod isoG).cont_diff).cont_diff_on, + rintros ⟨p, x⟩ ⟨hp, hx⟩, + simpa only [mem_preimage, continuous_linear_equiv.prod_apply, prod_mk_mem_set_prod_eq, + mem_univ, and_true] using hp } }, + have A : cont_diff_on 𝕜 n (isoF ∘ R ∘ (isoP.prod isoG).symm) (s ×ˢ univ), + { apply isoF.cont_diff.comp_cont_diff_on, + apply R_contdiff.comp (continuous_linear_equiv.cont_diff _).cont_diff_on, + rintros ⟨p, x⟩ ⟨hp, hx⟩, + simpa only [mem_preimage, mem_prod, mem_univ, and_true, continuous_linear_equiv.prod_symm, + continuous_linear_equiv.prod_apply, continuous_linear_equiv.apply_symm_apply] using hp }, + have : isoF ∘ R ∘ (isoP.prod isoG).symm = (λ (q : P × G), (f ⋆[L, μ] g q.1) q.2), + { apply funext, + rintros ⟨p, x⟩, + simp only [R, linear_isometry_equiv.coe_coe, comp_app, continuous_linear_equiv.prod_symm, + continuous_linear_equiv.prod_apply], + simp only [convolution, eL, coe_comp', continuous_linear_equiv.coe_coe, comp_app, eμ], + rw [closed_embedding.integral_map, ← isoF.integral_comp_comm], + swap, { exact isoG.symm.to_homeomorph.closed_embedding }, + congr' 1, + ext1 a, + simp only [ef, eg, comp_app, continuous_linear_equiv.apply_symm_apply, coe_comp', + continuous_linear_equiv.prod_apply, continuous_linear_equiv.map_sub, + continuous_linear_equiv.arrow_congr, continuous_linear_equiv.arrow_congrSL_symm_apply, + continuous_linear_equiv.coe_coe, comp_app, continuous_linear_equiv.apply_symm_apply ] }, + simp_rw [this] at A, + exact A, +end + +/-- The convolution `f * g` is `C^n` when `f` is locally integrable and `g` is `C^n` and compactly +supported. Version where `g` depends on an additional parameter in an open subset `s` of a +parameter space `P` (and the compact support `k` is independent of the parameter in `s`), +given in terms of composition with an additional smooth function. -/ +lemma cont_diff_on_convolution_right_with_param_comp + {n : ℕ∞} (L : E →L[𝕜] E' →L[𝕜] F) + {s : set P} {v : P → G} (hv : cont_diff_on 𝕜 n v s) + {f : G → E} {g : P → G → E'} {k : set G} (hs : is_open s) (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : cont_diff_on 𝕜 n ↿g (s ×ˢ univ)) : + cont_diff_on 𝕜 n (λ x, (f ⋆[L, μ] g x) (v x)) s := +begin + apply (cont_diff_on_convolution_right_with_param L hs hk hgs hf hg).comp + (cont_diff_on_id.prod hv), + assume x hx, + simp only [hx, mem_preimage, prod_mk_mem_set_prod_eq, mem_univ, and_self, id.def], +end + +/-- The convolution `g * f` is `C^n` when `f` is locally integrable and `g` is `C^n` and compactly +supported. Version where `g` depends on an additional parameter in an open subset `s` of a +parameter space `P` (and the compact support `k` is independent of the parameter in `s`). -/ +lemma cont_diff_on_convolution_left_with_param [μ.is_add_left_invariant] [μ.is_neg_invariant] + (L : E' →L[𝕜] E →L[𝕜] F) {f : G → E} {n : ℕ∞} + {g : P → G → E'} {s : set P} {k : set G} (hs : is_open s) (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : cont_diff_on 𝕜 n ↿g (s ×ˢ univ)) : + cont_diff_on 𝕜 n (λ (q : P × G), (g q.1 ⋆[L, μ] f) q.2) (s ×ˢ univ) := +by simpa only [convolution_flip] + using cont_diff_on_convolution_right_with_param L.flip hs hk hgs hf hg + +/-- The convolution `g * f` is `C^n` when `f` is locally integrable and `g` is `C^n` and compactly +supported. Version where `g` depends on an additional parameter in an open subset `s` of a +parameter space `P` (and the compact support `k` is independent of the parameter in `s`), +given in terms of composition with additional smooth functions. -/ +lemma cont_diff_on_convolution_left_with_param_comp [μ.is_add_left_invariant] [μ.is_neg_invariant] + (L : E' →L[𝕜] E →L[𝕜] F) {s : set P} {n : ℕ∞} {v : P → G} (hv : cont_diff_on 𝕜 n v s) + {f : G → E} {g : P → G → E'} {k : set G} (hs : is_open s) (hk : is_compact k) + (hgs : ∀ p, ∀ x, p ∈ s → x ∉ k → g p x = 0) + (hf : locally_integrable f μ) (hg : cont_diff_on 𝕜 n ↿g (s ×ˢ univ)) : + cont_diff_on 𝕜 n (λ x, (g x ⋆[L, μ] f) (v x)) s := +begin + apply (cont_diff_on_convolution_left_with_param L hs hk hgs hf hg).comp (cont_diff_on_id.prod hv), + assume x hx, + simp only [hx, mem_preimage, prod_mk_mem_set_prod_eq, mem_univ, and_self, id.def], +end + +lemma has_compact_support.cont_diff_convolution_right {n : ℕ∞} + (hcg : has_compact_support g) (hf : locally_integrable f μ) (hg : cont_diff 𝕜 n g) : + cont_diff 𝕜 n (f ⋆[L, μ] g) := +begin + rcases exists_compact_iff_has_compact_support.2 hcg with ⟨k, hk, h'k⟩, + rw ← cont_diff_on_univ, + exact cont_diff_on_convolution_right_with_param_comp L cont_diff_on_id is_open_univ hk + (λ p x hp hx, h'k x hx) hf (hg.comp cont_diff_snd).cont_diff_on, +end + +lemma has_compact_support.cont_diff_convolution_left [μ.is_add_left_invariant] [μ.is_neg_invariant] + {n : ℕ∞} (hcf : has_compact_support f) (hf : cont_diff 𝕜 n f) (hg : locally_integrable g μ) : + cont_diff 𝕜 n (f ⋆[L, μ] g) := +by { rw [← convolution_flip], exact hcf.cont_diff_convolution_right L.flip hg hf } + +end with_param + +section nonneg + +variables [normed_space ℝ E] [normed_space ℝ E'] [normed_space ℝ F] [complete_space F] + +/-- The forward convolution of two functions `f` and `g` on `ℝ`, with respect to a continuous +bilinear map `L` and measure `ν`. It is defined to be the function mapping `x` to +`∫ t in 0..x, L (f t) (g (x - t)) ∂ν` if `0 < x`, and 0 otherwise. -/ +noncomputable def pos_convolution + (f : ℝ → E) (g : ℝ → E') (L : E →L[ℝ] E' →L[ℝ] F) (ν : measure ℝ . volume_tac) : ℝ → F := +indicator (Ioi (0:ℝ)) (λ x, ∫ t in 0..x, L (f t) (g (x - t)) ∂ν) + +lemma pos_convolution_eq_convolution_indicator + (f : ℝ → E) (g : ℝ → E') (L : E →L[ℝ] E' →L[ℝ] F) (ν : measure ℝ . volume_tac) [has_no_atoms ν] : + pos_convolution f g L ν = convolution (indicator (Ioi 0) f) (indicator (Ioi 0) g) L ν := +begin + ext1 x, + rw [convolution, pos_convolution, indicator], + split_ifs, + { rw [interval_integral.integral_of_le (le_of_lt h), + integral_Ioc_eq_integral_Ioo, + ←integral_indicator (measurable_set_Ioo : measurable_set (Ioo 0 x))], + congr' 1 with t : 1, + have : (t ≤ 0) ∨ (t ∈ Ioo 0 x) ∨ (x ≤ t), + { rcases le_or_lt t 0 with h | h, + { exact or.inl h }, + { rcases lt_or_le t x with h' | h', + exacts [or.inr (or.inl ⟨h, h'⟩), or.inr (or.inr h')] } }, + rcases this with ht|ht|ht, + { rw [indicator_of_not_mem (not_mem_Ioo_of_le ht), indicator_of_not_mem (not_mem_Ioi.mpr ht), + continuous_linear_map.map_zero, continuous_linear_map.zero_apply] }, + { rw [indicator_of_mem ht, indicator_of_mem (mem_Ioi.mpr ht.1), + indicator_of_mem (mem_Ioi.mpr $ sub_pos.mpr ht.2)] }, + { rw [indicator_of_not_mem (not_mem_Ioo_of_ge ht), + indicator_of_not_mem (not_mem_Ioi.mpr (sub_nonpos_of_le ht)), + continuous_linear_map.map_zero] } }, + { convert (integral_zero ℝ F).symm, + ext1 t, + by_cases ht : 0 < t, + { rw [indicator_of_not_mem (_ : x - t ∉ Ioi 0), continuous_linear_map.map_zero], + rw not_mem_Ioi at h ⊢, + exact sub_nonpos.mpr (h.trans ht.le) }, + { rw [indicator_of_not_mem (mem_Ioi.not.mpr ht), continuous_linear_map.map_zero, + continuous_linear_map.zero_apply] } } +end + +lemma integrable_pos_convolution {f : ℝ → E} {g : ℝ → E'} {μ ν : measure ℝ} + [sigma_finite μ] [sigma_finite ν] [is_add_right_invariant μ] [has_no_atoms ν] + (hf : integrable_on f (Ioi 0) ν) (hg : integrable_on g (Ioi 0) μ) (L : E →L[ℝ] E' →L[ℝ] F) : + integrable (pos_convolution f g L ν) μ := +begin + rw ←integrable_indicator_iff (measurable_set_Ioi : measurable_set (Ioi (0:ℝ))) at hf hg, + rw pos_convolution_eq_convolution_indicator f g L ν, + exact (hf.convolution_integrand L hg).integral_prod_left, +end + +/-- The integral over `Ioi 0` of a forward convolution of two functions is equal to the product +of their integrals over this set. (Compare `integral_convolution` for the two-sided convolution.) -/ +lemma integral_pos_convolution [complete_space E] [complete_space E'] {μ ν : measure ℝ} + [sigma_finite μ] [sigma_finite ν] [is_add_right_invariant μ] [has_no_atoms ν] + {f : ℝ → E} {g : ℝ → E'} (hf : integrable_on f (Ioi 0) ν) + (hg : integrable_on g (Ioi 0) μ) (L : E →L[ℝ] E' →L[ℝ] F) : + ∫ x:ℝ in Ioi 0, (∫ t:ℝ in 0..x, L (f t) (g (x - t)) ∂ν) ∂μ = + L (∫ x:ℝ in Ioi 0, f x ∂ν) (∫ x:ℝ in Ioi 0, g x ∂μ) := +begin + rw ←integrable_indicator_iff (measurable_set_Ioi : measurable_set (Ioi (0:ℝ))) at hf hg, + simp_rw ←integral_indicator measurable_set_Ioi, + convert integral_convolution L hf hg using 2, + apply pos_convolution_eq_convolution_indicator, +end + +end nonneg diff --git a/src/analysis/fourier.lean b/src/analysis/fourier.lean deleted file mode 100644 index 159b337ce02c0..0000000000000 --- a/src/analysis/fourier.lean +++ /dev/null @@ -1,259 +0,0 @@ -/- -Copyright (c) 2021 Heather Macbeth. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Heather Macbeth --/ -import analysis.complex.circle -import analysis.inner_product_space.l2_space -import measure_theory.function.continuous_map_dense -import measure_theory.function.l2_space -import measure_theory.measure.haar -import measure_theory.group.integration -import topology.metric_space.emetric_paracompact -import topology.continuous_function.stone_weierstrass - -/-! - -# Fourier analysis on the circle - -This file contains basic results on Fourier series. - -## Main definitions - -* `haar_circle`, Haar measure on the circle, normalized to have total measure `1` -* instances `measure_space`, `is_probability_measure` for the circle with respect to this measure -* for `n : ℤ`, `fourier n` is the monomial `λ z, z ^ n`, bundled as a continuous map from `circle` - to `ℂ` -* for `n : ℤ` and `p : ℝ≥0∞`, `fourier_Lp p n` is an abbreviation for the monomial `fourier n` - considered as an element of the Lᵖ-space `Lp ℂ p haar_circle`, via the embedding - `continuous_map.to_Lp` -* `fourier_series` is the canonical isometric isomorphism from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)` - induced by taking Fourier series - -## Main statements - -The theorem `span_fourier_closure_eq_top` states that the span of the monomials `fourier n` is -dense in `C(circle, ℂ)`, i.e. that its `submodule.topological_closure` is `⊤`. This follows from -the Stone-Weierstrass theorem after checking that it is a subalgebra, closed under conjugation, and -separates points. - -The theorem `span_fourier_Lp_closure_eq_top` states that for `1 ≤ p < ∞` the span of the monomials -`fourier_Lp` is dense in `Lp ℂ p haar_circle`, i.e. that its `submodule.topological_closure` is -`⊤`. This follows from the previous theorem using general theory on approximation of Lᵖ functions -by continuous functions. - -The theorem `orthonormal_fourier` states that the monomials `fourier_Lp 2 n` form an orthonormal -set (in the L² space of the circle). - -The last two results together provide that the functions `fourier_Lp 2 n` form a Hilbert basis for -L²; this is named as `fourier_series`. - -Parseval's identity, `tsum_sq_fourier_series_repr`, is a direct consequence of the construction of -this Hilbert basis. --/ - -noncomputable theory -open_locale ennreal complex_conjugate classical -open topological_space continuous_map measure_theory measure_theory.measure algebra submodule set - -/-! ### Choice of measure on the circle -/ - -section haar_circle -/-! We make the circle into a measure space, using the Haar measure normalized to have total -measure 1. -/ - -instance : measurable_space circle := borel circle -instance : borel_space circle := ⟨rfl⟩ - -/-- Haar measure on the circle, normalized to have total measure 1. -/ -@[derive is_haar_measure] -def haar_circle : measure circle := haar_measure ⊤ - -instance : is_probability_measure haar_circle := ⟨haar_measure_self⟩ - -instance : measure_space circle := -{ volume := haar_circle, - .. circle.measurable_space } - -end haar_circle - -/-! ### Monomials on the circle -/ - -section monomials - -/-- The family of monomials `λ z, z ^ n`, parametrized by `n : ℤ` and considered as bundled -continuous maps from `circle` to `ℂ`. -/ -@[simps] def fourier (n : ℤ) : C(circle, ℂ) := -{ to_fun := λ z, z ^ n, - continuous_to_fun := continuous_subtype_coe.zpow₀ n $ λ z, or.inl (ne_zero_of_mem_circle z) } - -@[simp] lemma fourier_zero {z : circle} : fourier 0 z = 1 := rfl - -@[simp] lemma fourier_neg {n : ℤ} {z : circle} : fourier (-n) z = conj (fourier n z) := -by simp [← coe_inv_circle_eq_conj z] - -@[simp] lemma fourier_add {m n : ℤ} {z : circle} : - fourier (m + n) z = (fourier m z) * (fourier n z) := -by simp [zpow_add₀ (ne_zero_of_mem_circle z)] - -/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ`; equivalently, polynomials in -`z` and `conj z`. -/ -def fourier_subalgebra : subalgebra ℂ C(circle, ℂ) := algebra.adjoin ℂ (range fourier) - -/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is in fact the linear span of -these functions. -/ -lemma fourier_subalgebra_coe : fourier_subalgebra.to_submodule = span ℂ (range fourier) := -begin - apply adjoin_eq_span_of_subset, - refine subset.trans _ submodule.subset_span, - intros x hx, - apply submonoid.closure_induction hx (λ _, id) ⟨0, rfl⟩, - rintros _ _ ⟨m, rfl⟩ ⟨n, rfl⟩, - refine ⟨m + n, _⟩, - ext1 z, - exact fourier_add, -end - -/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` separates points. -/ -lemma fourier_subalgebra_separates_points : fourier_subalgebra.separates_points := -begin - intros x y hxy, - refine ⟨_, ⟨fourier 1, _, rfl⟩, _⟩, - { exact subset_adjoin ⟨1, rfl⟩ }, - { simp [hxy] } -end - -/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is invariant under complex -conjugation. -/ -lemma fourier_subalgebra_conj_invariant : - conj_invariant_subalgebra (fourier_subalgebra.restrict_scalars ℝ) := -begin - rintros _ ⟨f, hf, rfl⟩, - change _ ∈ fourier_subalgebra, - change _ ∈ fourier_subalgebra at hf, - apply adjoin_induction hf, - { rintros _ ⟨n, rfl⟩, - suffices : fourier (-n) ∈ fourier_subalgebra, - { convert this, - ext1, - simp }, - exact subset_adjoin ⟨-n, rfl⟩ }, - { intros c, - exact fourier_subalgebra.algebra_map_mem (conj c) }, - { intros f g hf hg, - convert fourier_subalgebra.add_mem hf hg, - exact alg_hom.map_add _ f g, }, - { intros f g hf hg, - convert fourier_subalgebra.mul_mem hf hg, - exact alg_hom.map_mul _ f g, } -end - -/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is dense. -/ -lemma fourier_subalgebra_closure_eq_top : fourier_subalgebra.topological_closure = ⊤ := -continuous_map.subalgebra_complex_topological_closure_eq_top_of_separates_points - fourier_subalgebra - fourier_subalgebra_separates_points - fourier_subalgebra_conj_invariant - -/-- The linear span of the monomials `z ^ n` is dense in `C(circle, ℂ)`. -/ -lemma span_fourier_closure_eq_top : (span ℂ (range fourier)).topological_closure = ⊤ := -begin - rw ← fourier_subalgebra_coe, - exact congr_arg subalgebra.to_submodule fourier_subalgebra_closure_eq_top, -end - -/-- The family of monomials `λ z, z ^ n`, parametrized by `n : ℤ` and considered as elements of -the `Lp` space of functions on `circle` taking values in `ℂ`. -/ -abbreviation fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) : Lp ℂ p haar_circle := -to_Lp p haar_circle ℂ (fourier n) - -lemma coe_fn_fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) : - ⇑(fourier_Lp p n) =ᵐ[haar_circle] fourier n := -coe_fn_to_Lp haar_circle (fourier n) - -/-- For each `1 ≤ p < ∞`, the linear span of the monomials `z ^ n` is dense in -`Lp ℂ p haar_circle`. -/ -lemma span_fourier_Lp_closure_eq_top {p : ℝ≥0∞} [fact (1 ≤ p)] (hp : p ≠ ∞) : - (span ℂ (range (fourier_Lp p))).topological_closure = ⊤ := -begin - convert (continuous_map.to_Lp_dense_range ℂ hp haar_circle ℂ).topological_closure_map_submodule - span_fourier_closure_eq_top, - rw [map_span, range_comp], - simp -end - -/-- For `n ≠ 0`, a rotation by `n⁻¹ * real.pi` negates the monomial `z ^ n`. -/ -lemma fourier_add_half_inv_index {n : ℤ} (hn : n ≠ 0) (z : circle) : - fourier n ((exp_map_circle (n⁻¹ * real.pi) * z)) = - fourier n z := -begin - have : ↑n * ((↑n)⁻¹ * ↑real.pi * complex.I) = ↑real.pi * complex.I, - { have : (n:ℂ) ≠ 0 := by exact_mod_cast hn, - field_simp, - ring }, - simp [mul_zpow₀, ← complex.exp_int_mul, complex.exp_pi_mul_I, this] -end - -/-- The monomials `z ^ n` are an orthonormal set with respect to Haar measure on the circle. -/ -lemma orthonormal_fourier : orthonormal ℂ (fourier_Lp 2) := -begin - rw orthonormal_iff_ite, - intros i j, - rw continuous_map.inner_to_Lp haar_circle (fourier i) (fourier j), - split_ifs, - { simp [h, is_probability_measure.measure_univ, ← fourier_neg, ← fourier_add, -fourier_to_fun] }, - simp only [← fourier_add, ← fourier_neg], - have hij : -i + j ≠ 0, - { rw add_comm, - exact sub_ne_zero.mpr (ne.symm h) }, - exact integral_eq_zero_of_mul_left_eq_neg (fourier_add_half_inv_index hij) -end - -end monomials - -section fourier - -/-- We define `fourier_series` to be a `ℤ`-indexed Hilbert basis for `Lp ℂ 2 haar_circle`, which by -definition is an isometric isomorphism from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)`. -/ -def fourier_series : hilbert_basis ℤ ℂ (Lp ℂ 2 haar_circle) := -hilbert_basis.mk orthonormal_fourier (span_fourier_Lp_closure_eq_top (by norm_num)) - -/-- The elements of the Hilbert basis `fourier_series` for `Lp ℂ 2 haar_circle` are the functions -`fourier_Lp 2`, the monomials `λ z, z ^ n` on the circle considered as elements of `L2`. -/ -@[simp] lemma coe_fourier_series : ⇑fourier_series = fourier_Lp 2 := hilbert_basis.coe_mk _ _ - -/-- Under the isometric isomorphism `fourier_series` from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)`, the -`i`-th coefficient is the integral over the circle of `λ t, t ^ (-i) * f t`. -/ -lemma fourier_series_repr (f : Lp ℂ 2 haar_circle) (i : ℤ) : - fourier_series.repr f i = ∫ t : circle, t ^ (-i) * f t ∂ haar_circle := -begin - transitivity ∫ t : circle, conj ((fourier_Lp 2 i : circle → ℂ) t) * f t ∂ haar_circle, - { simp [fourier_series.repr_apply_apply f i, measure_theory.L2.inner_def] }, - apply integral_congr_ae, - filter_upwards [coe_fn_fourier_Lp 2 i] with _ ht, - rw [ht, ← fourier_neg], - simp [-fourier_neg] -end - -/-- The Fourier series of an `L2` function `f` sums to `f`, in the `L2` topology on the circle. -/ -lemma has_sum_fourier_series (f : Lp ℂ 2 haar_circle) : - has_sum (λ i, fourier_series.repr f i • fourier_Lp 2 i) f := -by simpa using hilbert_basis.has_sum_repr fourier_series f - -/-- **Parseval's identity**: the sum of the squared norms of the Fourier coefficients equals the -`L2` norm of the function. -/ -lemma tsum_sq_fourier_series_repr (f : Lp ℂ 2 haar_circle) : - ∑' i : ℤ, ∥fourier_series.repr f i∥ ^ 2 = ∫ t : circle, ∥f t∥ ^ 2 ∂ haar_circle := -begin - have H₁ : ∥fourier_series.repr f∥ ^ 2 = ∑' i, ∥fourier_series.repr f i∥ ^ 2, - { exact_mod_cast lp.norm_rpow_eq_tsum _ (fourier_series.repr f), - norm_num }, - have H₂ : ∥fourier_series.repr f∥ ^ 2 = ∥f∥ ^2 := by simp, - have H₃ := congr_arg is_R_or_C.re (@L2.inner_def circle ℂ ℂ _ _ _ _ f f), - rw ← integral_re at H₃, - { simp only [← norm_sq_eq_inner] at H₃, - rw [← H₁, H₂], - exact H₃ }, - { exact L2.integrable_inner f f }, -end - -end fourier diff --git a/src/analysis/fourier/add_circle.lean b/src/analysis/fourier/add_circle.lean new file mode 100644 index 0000000000000..a5e5f3877cfdd --- /dev/null +++ b/src/analysis/fourier/add_circle.lean @@ -0,0 +1,544 @@ +/- +Copyright (c) 2021 Heather Macbeth. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Heather Macbeth, David Loeffler +-/ +import analysis.special_functions.exp_deriv +import analysis.special_functions.complex.circle +import analysis.inner_product_space.l2_space +import measure_theory.function.continuous_map_dense +import measure_theory.function.l2_space +import measure_theory.group.integration +import measure_theory.integral.periodic +import topology.continuous_function.stone_weierstrass +import measure_theory.integral.fund_thm_calculus + +/-! + +# Fourier analysis on the additive circle + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains basic results on Fourier series for functions on the additive circle +`add_circle T = ℝ / ℤ • T`. + +## Main definitions + +* `haar_add_circle`, Haar measure on `add_circle T`, normalized to have total measure `1`. (Note + that this is not the same normalisation as the standard measure defined in `integral.periodic`, + so we do not declare it as a `measure_space` instance, to avoid confusion.) +* for `n : ℤ`, `fourier n` is the monomial `λ x, exp (2 π i n x / T)`, bundled as a continuous map + from `add_circle T` to `ℂ`. +* `fourier_basis` is the Hilbert basis of `Lp ℂ 2 haar_add_circle` given by the images of the + monomials `fourier n`. +* `fourier_coeff f n`, for `f : add_circle T → E` (with `E` a complete normed `ℂ`-vector space), is + the `n`-th Fourier coefficient of `f`, defined as an integral over `add_circle T`. The lemma + `fourier_coeff_eq_interval_integral` expresses this as an integral over `[a, a + T]` for any real + `a`. +* `fourier_coeff_on`, for `f : ℝ → E` and `a < b` reals, is the `n`-th Fourier + coefficient of the unique periodic function of period `b - a` which agrees with `f` on `(a, b]`. + The lemma `fourier_coeff_on_eq_integral` expresses this as an integral over `[a, b]`. + +## Main statements + +The theorem `span_fourier_closure_eq_top` states that the span of the monomials `fourier n` is +dense in `C(add_circle T, ℂ)`, i.e. that its `submodule.topological_closure` is `⊤`. This follows +from the Stone-Weierstrass theorem after checking that the span is a subalgebra, is closed under +conjugation, and separates points. + +Using this and general theory on approximation of Lᵖ functions by continuous functions, we deduce +(`span_fourier_Lp_closure_eq_top`) that for any `1 ≤ p < ∞`, the span of the Fourier monomials is +dense in the Lᵖ space of `add_circle T`. For `p = 2` we show (`orthonormal_fourier`) that the +monomials are also orthonormal, so they form a Hilbert basis for L², which is named as +`fourier_basis`; in particular, for `L²` functions `f`, the Fourier series of `f` converges to `f` +in the `L²` topology (`has_sum_fourier_series_L2`). Parseval's identity, `tsum_sq_fourier_coeff`, is +a direct consequence. + +For continuous maps `f : add_circle T → ℂ`, the theorem +`continuous_map.has_sum_fourier_series_of_summable` states that if the sequence of Fourier +coefficients of `f` is summable, then the Fourier series `∑ (i:ℤ), f.fourier_coeff i * fourier i` +converges to `f` in the uniform-convergence topology of `C(add_circle T, ℂ)`. +-/ + +noncomputable theory +open_locale ennreal complex_conjugate real +open topological_space continuous_map measure_theory measure_theory.measure algebra submodule set + +variables {T : ℝ} + +namespace add_circle + +/-! ### Map from `add_circle` to `circle` -/ + +lemma scaled_exp_map_periodic : + function.periodic (λ x, exp_map_circle (2 * π / T * x)) T := +begin + -- The case T = 0 is not interesting, but it is true, so we prove it to save hypotheses + rcases eq_or_ne T 0 with rfl | hT, + { intro x, simp }, + { intro x, simp_rw mul_add, rw [div_mul_cancel _ hT, periodic_exp_map_circle] } +end + +/-- The canonical map `λ x, exp (2 π i x / T)` from `ℝ / ℤ • T` to the unit circle in `ℂ`. +If `T = 0` we understand this as the constant function 1. -/ +def to_circle : add_circle T → circle := (@scaled_exp_map_periodic T).lift + +lemma to_circle_add (x : add_circle T) (y : add_circle T) : + to_circle (x + y) = to_circle x * to_circle y := +begin + induction x using quotient_add_group.induction_on', + induction y using quotient_add_group.induction_on', + simp_rw [←quotient_add_group.coe_add, to_circle, function.periodic.lift_coe, + mul_add, exp_map_circle_add], +end + +lemma continuous_to_circle : continuous (@to_circle T) := +continuous_coinduced_dom.mpr (exp_map_circle.continuous.comp $ continuous_const.mul continuous_id') + +lemma injective_to_circle (hT : T ≠ 0) : function.injective (@to_circle T) := +begin + intros a b h, + induction a using quotient_add_group.induction_on', + induction b using quotient_add_group.induction_on', + simp_rw [to_circle, function.periodic.lift_coe] at h, + obtain ⟨m, hm⟩ := exp_map_circle_eq_exp_map_circle.mp h.symm, + simp_rw [quotient_add_group.eq, add_subgroup.mem_zmultiples_iff, zsmul_eq_mul], + use m, + field_simp [real.two_pi_pos.ne'] at hm, + rw ← mul_right_inj' real.two_pi_pos.ne', + linarith +end + +/-! ### Measure on `add_circle T` + +In this file we use the Haar measure on `add_circle T` normalised to have total measure 1 (which is +**not** the same as the standard measure defined in `topology.instances.add_circle`). -/ + +variables [hT : fact (0 < T)] +include hT + +/-- Haar measure on the additive circle, normalised to have total measure 1. -/ +@[derive is_add_haar_measure] +def haar_add_circle : measure (add_circle T) := add_haar_measure ⊤ + +instance : is_probability_measure (@haar_add_circle T _) := + is_probability_measure.mk add_haar_measure_self + +lemma volume_eq_smul_haar_add_circle : + (volume : measure (add_circle T)) = ennreal.of_real T • haar_add_circle := rfl + +end add_circle + +open add_circle + +section monomials + +/-- The family of exponential monomials `λ x, exp (2 π i n x / T)`, parametrized by `n : ℤ` and +considered as bundled continuous maps from `ℝ / ℤ • T` to `ℂ`. -/ +def fourier (n : ℤ) : C(add_circle T, ℂ) := +{ to_fun := λ x, to_circle (n • x), + continuous_to_fun := continuous_induced_dom.comp $ continuous_to_circle.comp $ continuous_zsmul _} + +@[simp] lemma fourier_apply {n : ℤ} {x : add_circle T} : fourier n x = to_circle (n • x) := rfl + +@[simp] lemma fourier_coe_apply {n : ℤ} {x : ℝ} : + fourier n (x : add_circle T) = complex.exp (2 * π * complex.I * n * x / T) := +begin + rw [fourier_apply, ←quotient_add_group.coe_zsmul, to_circle, function.periodic.lift_coe, + exp_map_circle_apply, complex.of_real_mul, complex.of_real_div, complex.of_real_mul, + zsmul_eq_mul, complex.of_real_mul, complex.of_real_int_cast, complex.of_real_bit0, + complex.of_real_one], + congr' 1, ring, +end + +@[simp] lemma fourier_zero {x : add_circle T} : fourier 0 x = 1 := +begin + induction x using quotient_add_group.induction_on', + simp only [fourier_coe_apply, algebra_map.coe_zero, mul_zero, zero_mul, + zero_div, complex.exp_zero], +end + +@[simp] lemma fourier_eval_zero (n : ℤ) : fourier n (0 : add_circle T) = 1 := +by rw [←quotient_add_group.coe_zero, fourier_coe_apply, complex.of_real_zero, + mul_zero, zero_div, complex.exp_zero] + +@[simp] lemma fourier_one {x : add_circle T} : fourier 1 x = to_circle x := +by rw [fourier_apply, one_zsmul] + +@[simp] lemma fourier_neg {n : ℤ} {x : add_circle T} : fourier (-n) x = conj (fourier n x) := +begin + induction x using quotient_add_group.induction_on', + simp_rw [fourier_apply, to_circle, ←quotient_add_group.coe_zsmul, + function.periodic.lift_coe, ←coe_inv_circle_eq_conj, ←exp_map_circle_neg, neg_smul, mul_neg], +end + +@[simp] lemma fourier_add {m n : ℤ} {x : add_circle T} : + fourier (m + n) x = fourier m x * fourier n x := +by simp_rw [fourier_apply, add_zsmul, to_circle_add, coe_mul_unit_sphere] + +lemma fourier_norm [fact (0 < T)] (n : ℤ) : ‖@fourier T n‖ = 1 := +begin + rw continuous_map.norm_eq_supr_norm, + have : ∀ (x : add_circle T), ‖fourier n x‖ = 1 := λ x, abs_coe_circle _, + simp_rw this, + exact @csupr_const _ _ _ has_zero.nonempty _, +end + +/-- For `n ≠ 0`, a translation by `T / 2 / n` negates the function `fourier n`. -/ +lemma fourier_add_half_inv_index {n : ℤ} (hn : n ≠ 0) (hT : 0 < T) (x : add_circle T) : + fourier n (x + ((T / 2 / n) : ℝ)) = - fourier n x := +begin + rw [fourier_apply, zsmul_add, ←quotient_add_group.coe_zsmul, to_circle_add, coe_mul_unit_sphere], + have : (n : ℂ) ≠ 0 := by simpa using hn, + have : ((@to_circle T ((n • (T / 2 / n)) : ℝ)) : ℂ) = -1, + { rw [zsmul_eq_mul, to_circle, function.periodic.lift_coe, exp_map_circle_apply], + replace hT := complex.of_real_ne_zero.mpr hT.ne', + convert complex.exp_pi_mul_I using 3, + field_simp, ring, }, + rw this, simp, +end + +/-- The subalgebra of `C(add_circle T, ℂ)` generated by `fourier n` for `n ∈ ℤ` . -/ +def fourier_subalgebra : subalgebra ℂ C(add_circle T, ℂ) := algebra.adjoin ℂ (range fourier) + +/-- The subalgebra of `C(add_circle T, ℂ)` generated by `fourier n` for `n ∈ ℤ` is in fact the +linear span of these functions. -/ +lemma fourier_subalgebra_coe : (@fourier_subalgebra T).to_submodule = span ℂ (range fourier) := +begin + apply adjoin_eq_span_of_subset, + refine subset.trans _ submodule.subset_span, + intros x hx, + apply submonoid.closure_induction hx (λ _, id) ⟨0, _⟩, + { rintros _ _ ⟨m, rfl⟩ ⟨n, rfl⟩, + refine ⟨m + n, _⟩, + ext1 z, + exact fourier_add }, + { ext1 z, exact fourier_zero } +end + +/-- The subalgebra of `C(add_circle T, ℂ)` generated by `fourier n` for `n ∈ ℤ` is invariant under +complex conjugation. -/ +lemma fourier_subalgebra_conj_invariant : + conj_invariant_subalgebra ((@fourier_subalgebra T).restrict_scalars ℝ) := +begin + apply subalgebra_conj_invariant, + rintros _ ⟨n, rfl⟩, + exact ⟨-n, ext (λ _, fourier_neg)⟩ +end + +variables [hT : fact (0 < T)] +include hT + +/-- The subalgebra of `C(add_circle T, ℂ)` generated by `fourier n` for `n ∈ ℤ` +separates points. -/ +lemma fourier_subalgebra_separates_points : (@fourier_subalgebra T).separates_points := +begin + intros x y hxy, + refine ⟨_, ⟨fourier 1, subset_adjoin ⟨1, rfl⟩, rfl⟩, _⟩, + dsimp only, rw [fourier_one, fourier_one], + contrapose! hxy, + rw subtype.coe_inj at hxy, + exact injective_to_circle hT.elim.ne' hxy, +end + +/-- The subalgebra of `C(add_circle T, ℂ)` generated by `fourier n` for `n ∈ ℤ` is dense. -/ +lemma fourier_subalgebra_closure_eq_top : (@fourier_subalgebra T).topological_closure = ⊤ := +continuous_map.subalgebra_is_R_or_C_topological_closure_eq_top_of_separates_points + fourier_subalgebra fourier_subalgebra_separates_points fourier_subalgebra_conj_invariant + +/-- The linear span of the monomials `fourier n` is dense in `C(add_circle T, ℂ)`. -/ +lemma span_fourier_closure_eq_top : (span ℂ (range $ @fourier T)).topological_closure = ⊤ := +begin + rw ← fourier_subalgebra_coe, + exact congr_arg subalgebra.to_submodule fourier_subalgebra_closure_eq_top, +end + +/-- The family of monomials `fourier n`, parametrized by `n : ℤ` and considered as +elements of the `Lp` space of functions `add_circle T → ℂ`. -/ +abbreviation fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) : Lp ℂ p (@haar_add_circle T hT) := +to_Lp p haar_add_circle ℂ (fourier n) + +lemma coe_fn_fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) : + (@fourier_Lp T hT p _ n) =ᵐ[haar_add_circle] fourier n := coe_fn_to_Lp haar_add_circle (fourier n) + +/-- For each `1 ≤ p < ∞`, the linear span of the monomials `fourier n` is dense in +`Lp ℂ p haar_circle`. -/ +lemma span_fourier_Lp_closure_eq_top {p : ℝ≥0∞} [fact (1 ≤ p)] (hp : p ≠ ∞) : + (span ℂ (range (@fourier_Lp T _ p _))).topological_closure = ⊤ := +begin + convert (continuous_map.to_Lp_dense_range ℂ (@haar_add_circle T hT) hp ℂ + ).topological_closure_map_submodule (span_fourier_closure_eq_top), + rw [map_span, range_comp], + simp only [continuous_linear_map.coe_coe], +end + +/-- The monomials `fourier n` are an orthonormal set with respect to normalised Haar measure. -/ +lemma orthonormal_fourier : orthonormal ℂ (@fourier_Lp T _ 2 _) := +begin + rw orthonormal_iff_ite, + intros i j, + rw continuous_map.inner_to_Lp (@haar_add_circle T hT) (fourier i) (fourier j), + simp_rw [←fourier_neg, ←fourier_add], + split_ifs, + { simp_rw [h, neg_add_self], + have : ⇑(@fourier T 0) = (λ x, 1 : (add_circle T) → ℂ), + { ext1, exact fourier_zero }, + rw [this, integral_const, measure_univ, ennreal.one_to_real, complex.real_smul, + complex.of_real_one, mul_one] }, + have hij : -i + j ≠ 0, + { rw add_comm, + exact sub_ne_zero.mpr (ne.symm h) }, + convert integral_eq_zero_of_add_right_eq_neg (fourier_add_half_inv_index hij hT.elim), + exact is_add_left_invariant.is_add_right_invariant +end + +end monomials + +section scope_hT -- everything from here on needs `0 < T` +variables [hT : fact (0 < T)] +include hT + + +section fourier_coeff +variables {E : Type} [normed_add_comm_group E] [normed_space ℂ E] [complete_space E] + +/-- The `n`-th Fourier coefficient of a function `add_circle T → E`, for `E` a complete normed +`ℂ`-vector space, defined as the integral over `add_circle T` of `fourier (-n) t • f t`. -/ +def fourier_coeff (f : add_circle T → E) (n : ℤ) : E := +∫ (t : add_circle T), fourier (-n) t • f t ∂ haar_add_circle + +/-- The Fourier coefficients of a function on `add_circle T` can be computed as an integral +over `[a, a + T]`, for any real `a`. -/ +lemma fourier_coeff_eq_interval_integral (f : add_circle T → E) (n : ℤ) (a : ℝ) : + fourier_coeff f n = (1 / T) • ∫ x in a .. a + T, @fourier T (-n) x • f x := +begin + have : ∀ (x : ℝ), @fourier T (-n) x • f x = (λ (z : add_circle T), @fourier T (-n) z • f z) x, + { intro x, refl, }, + simp_rw this, + rw [fourier_coeff, add_circle.interval_integral_preimage T a, + volume_eq_smul_haar_add_circle, integral_smul_measure, ennreal.to_real_of_real hT.out.le, + ←smul_assoc, smul_eq_mul, one_div_mul_cancel hT.out.ne', one_smul], +end + +lemma fourier_coeff.const_smul (f : add_circle T → E) (c : ℂ) (n : ℤ) : + fourier_coeff (c • f) n = c • fourier_coeff f n := +by simp_rw [fourier_coeff, pi.smul_apply, ←smul_assoc, smul_eq_mul, mul_comm, ←smul_eq_mul, + smul_assoc, integral_smul] + +lemma fourier_coeff.const_mul (f : add_circle T → ℂ) (c : ℂ) (n : ℤ) : + fourier_coeff (λ x, c * f x) n = c * fourier_coeff f n := +fourier_coeff.const_smul f c n + +omit hT + +/-- For a function on `ℝ`, the Fourier coefficients of `f` on `[a, b]` are defined as the +Fourier coefficients of the unique periodic function agreeing with `f` on `Ioc a b`. -/ +def fourier_coeff_on {a b : ℝ} (hab : a < b) (f : ℝ → E) (n : ℤ) : E := +begin + haveI := fact.mk (by linarith : 0 < b - a), + exact fourier_coeff (add_circle.lift_Ioc (b - a) a f) n +end + +lemma fourier_coeff_on_eq_integral {a b : ℝ} (f : ℝ → E) (n : ℤ) (hab : a < b) : + fourier_coeff_on hab f n = + (1 / (b - a)) • ∫ x in a ..b, fourier (-n) (x : add_circle (b - a)) • f x := +begin + rw [fourier_coeff_on, fourier_coeff_eq_interval_integral _ _ a], + congr' 1, + rw [add_sub, add_sub_cancel'], + simp_rw interval_integral.integral_of_le hab.le, + refine set_integral_congr measurable_set_Ioc (λ x hx, _), + dsimp only, + rwa [lift_Ioc_coe_apply], + rwa [add_sub, add_sub_cancel'], +end + +lemma fourier_coeff_on.const_smul {a b : ℝ} (f : ℝ → E) (c : ℂ) (n : ℤ) (hab : a < b) : + fourier_coeff_on hab (c • f) n = c • fourier_coeff_on hab f n := +by apply fourier_coeff.const_smul + +lemma fourier_coeff_on.const_mul {a b : ℝ} (f : ℝ → ℂ) (c : ℂ) (n : ℤ) (hab : a < b) : + fourier_coeff_on hab (λ x, c * f x) n = c * fourier_coeff_on hab f n := +fourier_coeff_on.const_smul _ _ _ _ + +include hT + +lemma fourier_coeff_lift_Ioc_eq {a : ℝ} (f : ℝ → ℂ) (n : ℤ) : + fourier_coeff (add_circle.lift_Ioc T a f) n = + fourier_coeff_on (lt_add_of_pos_right a hT.out) f n := +begin + rw [fourier_coeff_on_eq_integral, fourier_coeff_eq_interval_integral, add_sub_cancel' a T], + congr' 1, + refine interval_integral.integral_congr_ae (ae_of_all _ (λ x hx, _)), + rw lift_Ioc_coe_apply, + rwa uIoc_of_le (lt_add_of_pos_right a hT.out).le at hx, +end + +lemma fourier_coeff_lift_Ico_eq {a : ℝ} (f : ℝ → ℂ) (n : ℤ) : + fourier_coeff (add_circle.lift_Ico T a f) n = + fourier_coeff_on (lt_add_of_pos_right a hT.out) f n := +begin + rw [fourier_coeff_on_eq_integral, fourier_coeff_eq_interval_integral _ _ a, add_sub_cancel' a T], + congr' 1, + simp_rw [interval_integral.integral_of_le (lt_add_of_pos_right a hT.out).le, + integral_Ioc_eq_integral_Ioo], + refine set_integral_congr measurable_set_Ioo (λ x hx, _), + dsimp only, + rw lift_Ico_coe_apply (Ioo_subset_Ico_self hx), +end + +end fourier_coeff + +section fourier_L2 + +/-- We define `fourier_basis` to be a `ℤ`-indexed Hilbert basis for `Lp ℂ 2 haar_add_circle`, +which by definition is an isometric isomorphism from `Lp ℂ 2 haar_add_circle` to `ℓ²(ℤ, ℂ)`. -/ +def fourier_basis : hilbert_basis ℤ ℂ (Lp ℂ 2 $ @haar_add_circle T hT) := +hilbert_basis.mk orthonormal_fourier (span_fourier_Lp_closure_eq_top (by norm_num)).ge + +/-- The elements of the Hilbert basis `fourier_basis` are the functions `fourier_Lp 2`, i.e. the +monomials `fourier n` on the circle considered as elements of `L²`. -/ +@[simp] lemma coe_fourier_basis : ⇑(@fourier_basis _ hT) = fourier_Lp 2 := hilbert_basis.coe_mk _ _ + +/-- Under the isometric isomorphism `fourier_basis` from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)`, the +`i`-th coefficient is `fourier_coeff f i`, i.e., the integral over `add_circle T` of +`λ t, fourier (-i) t * f t` with respect to the Haar measure of total mass 1. -/ +lemma fourier_basis_repr (f : Lp ℂ 2 $ @haar_add_circle T hT) (i : ℤ) : + fourier_basis.repr f i = fourier_coeff f i := +begin + transitivity ∫ (t : add_circle T), + conj (((@fourier_Lp T hT 2 _ i) : add_circle T → ℂ) t) * f t ∂ haar_add_circle, + { simp [fourier_basis.repr_apply_apply f i, measure_theory.L2.inner_def] }, + { apply integral_congr_ae, + filter_upwards [coe_fn_fourier_Lp 2 i] with _ ht, + rw [ht, ←fourier_neg, smul_eq_mul], } +end + +/-- The Fourier series of an `L2` function `f` sums to `f`, in the `L²` space of `add_circle T`. -/ +lemma has_sum_fourier_series_L2 (f : Lp ℂ 2 $ @haar_add_circle T hT) : + has_sum (λ i, fourier_coeff f i • fourier_Lp 2 i) f := +by { simp_rw ←fourier_basis_repr, simpa using hilbert_basis.has_sum_repr fourier_basis f } + +/-- **Parseval's identity**: for an `L²` function `f` on `add_circle T`, the sum of the squared +norms of the Fourier coefficients equals the `L²` norm of `f`. -/ +lemma tsum_sq_fourier_coeff (f : Lp ℂ 2 $ @haar_add_circle T hT) : + ∑' i : ℤ, ‖fourier_coeff f i‖ ^ 2 = ∫ (t : add_circle T), ‖f t‖ ^ 2 ∂ haar_add_circle := +begin + simp_rw ←fourier_basis_repr, + have H₁ : ‖fourier_basis.repr f‖ ^ 2 = ∑' i, ‖fourier_basis.repr f i‖ ^ 2, + { exact_mod_cast lp.norm_rpow_eq_tsum _ (fourier_basis.repr f), + norm_num }, + have H₂ : ‖fourier_basis.repr f‖ ^ 2 = ‖f‖ ^ 2 := by simp, + have H₃ := congr_arg is_R_or_C.re (@L2.inner_def (add_circle T) ℂ ℂ _ _ _ _ _ f f), + rw ← integral_re at H₃, + { simp only [← norm_sq_eq_inner] at H₃, + rw [← H₁, H₂, H₃], }, + { exact L2.integrable_inner f f }, +end + +end fourier_L2 + +section convergence + +variables (f : C(add_circle T, ℂ)) + +lemma fourier_coeff_to_Lp (n : ℤ) : + fourier_coeff (to_Lp 2 haar_add_circle ℂ f) n = fourier_coeff f n := +integral_congr_ae (filter.eventually_eq.mul + (filter.eventually_of_forall (by tauto)) + (continuous_map.coe_fn_to_ae_eq_fun haar_add_circle f)) + +variables {f} + +/-- If the sequence of Fourier coefficients of `f` is summable, then the Fourier series converges +uniformly to `f`. -/ +lemma has_sum_fourier_series_of_summable (h : summable (fourier_coeff f)) : + has_sum (λ i, fourier_coeff f i • fourier i) f := +begin + have sum_L2 := has_sum_fourier_series_L2 (to_Lp 2 haar_add_circle ℂ f), + simp_rw fourier_coeff_to_Lp at sum_L2, + refine continuous_map.has_sum_of_has_sum_Lp (summable_of_summable_norm _) sum_L2, + simp_rw [norm_smul, fourier_norm, mul_one, summable_norm_iff], + exact h, +end + +/-- If the sequence of Fourier coefficients of `f` is summable, then the Fourier series of `f` +converges everywhere pointwise to `f`. -/ +lemma has_pointwise_sum_fourier_series_of_summable + (h : summable (fourier_coeff f)) (x : add_circle T) : + has_sum (λ i, fourier_coeff f i • fourier i x) (f x) := +(continuous_map.eval_clm ℂ x).has_sum (has_sum_fourier_series_of_summable h) + +end convergence + +end scope_hT + + +section deriv + +open complex interval_integral +open_locale interval + +variables (T) + +lemma has_deriv_at_fourier (n : ℤ) (x : ℝ) : has_deriv_at (λ y:ℝ, fourier n (y : add_circle T)) + (2 * π * I * n / T * fourier n (x : add_circle T)) x := +begin + simp_rw [fourier_coe_apply], + refine (_ : has_deriv_at (λ y, exp (2 * π * I * n * y / T)) _ _).comp_of_real, + rw (λ α β, by ring : ∀ (α β : ℂ), α * exp β = exp β * α), + refine (has_deriv_at_exp _).comp x _, + convert has_deriv_at_mul_const (2 * ↑π * I * ↑n / T), + ext1 y, ring, +end + +lemma has_deriv_at_fourier_neg (n : ℤ) (x : ℝ) : + has_deriv_at (λ y:ℝ, fourier (-n) (y : add_circle T)) + (-2 * π * I * n / T * fourier (-n) (x : add_circle T)) x := +by simpa using has_deriv_at_fourier T (-n) x + +variables {T} + +lemma has_antideriv_at_fourier_neg (hT : fact (0 < T)) {n : ℤ} (hn : n ≠ 0) (x : ℝ) : + has_deriv_at (λ (y : ℝ), (T : ℂ) / (-2 * π * I * n) * fourier (-n) (y : add_circle T)) + (fourier (-n) (x : add_circle T)) x := +begin + convert (has_deriv_at_fourier_neg T n x).div_const (-2 * π * I * n / T) using 1, + { ext1 y, rw div_div_eq_mul_div, ring, }, + { rw mul_div_cancel_left, + simp only [ne.def, div_eq_zero_iff, neg_eq_zero, mul_eq_zero, bit0_eq_zero, one_ne_zero, + of_real_eq_zero, false_or, int.cast_eq_zero, not_or_distrib], + exact ⟨⟨⟨real.pi_ne_zero, I_ne_zero⟩, hn⟩, hT.out.ne'⟩ }, +end + +/-- Express Fourier coefficients of `f` on an interval in terms of those of its derivative. -/ +lemma fourier_coeff_on_of_has_deriv_at {a b : ℝ} (hab : a < b) {f f' : ℝ → ℂ} {n : ℤ} + (hn : n ≠ 0) (hf : ∀ x, x ∈ [a, b] → has_deriv_at f (f' x) x) + (hf' : interval_integrable f' volume a b) : + fourier_coeff_on hab f n = + 1 / (-2 * π * I * n) * (fourier (-n) (a : add_circle (b - a)) * (f b - f a) + - (b - a) * fourier_coeff_on hab f' n) := +begin + rw ←of_real_sub, + have hT : fact (0 < b - a) := ⟨by linarith⟩, + simp_rw [fourier_coeff_on_eq_integral, smul_eq_mul, real_smul, of_real_div, of_real_one], + conv { for (fourier _ _ * _) [1, 2, 3] { rw mul_comm } }, + rw integral_mul_deriv_eq_deriv_mul hf (λ x hx, has_antideriv_at_fourier_neg hT hn x) hf' + (((map_continuous (fourier (-n))).comp (add_circle.continuous_mk' _)).interval_integrable _ _), + dsimp only, + have : ∀ (u v w : ℂ), u * ( (b - a : ℝ) / v * w) = (b - a : ℝ) / v * (u * w) := by {intros, ring}, + conv in (interval_integral _ _ _ _) { congr, funext, rw this, }, + rw (by ring : ((b - a : ℝ) : ℂ) / ((-2) * π * I * n) + = ((b - a : ℝ) : ℂ) * (1 / ((-2) * π * I * n))), + have s2 : (b : add_circle (b - a)) = (a : add_circle (b - a)), + { simpa using coe_add_period (b - a) a, }, + rw [s2, integral_const_mul, ←sub_mul, mul_sub, mul_sub], + congr' 1, + { conv_lhs {rw [mul_comm, mul_div, mul_one]}, + rw [div_eq_iff (of_real_ne_zero.mpr hT.out.ne')], + ring, }, + { ring, }, +end + +end deriv diff --git a/src/analysis/fourier/fourier_transform.lean b/src/analysis/fourier/fourier_transform.lean new file mode 100644 index 0000000000000..99c4df079aeed --- /dev/null +++ b/src/analysis/fourier/fourier_transform.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ + +import analysis.complex.circle +import measure_theory.group.integration +import measure_theory.measure.haar.of_basis + +/-! +# The Fourier transform + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We set up the Fourier transform for complex-valued functions on finite-dimensional spaces. + +## Design choices + +In namespace `vector_fourier`, we define the Fourier integral in the following context: +* `𝕜` is a commutative ring. +* `V` and `W` are `𝕜`-modules. +* `e` is a unitary additive character of `𝕜`, i.e. a homomorphism `(multiplicative 𝕜) →* circle`. +* `μ` is a measure on `V`. +* `L` is a `𝕜`-bilinear form `V × W → 𝕜`. +* `E` is a complete normed `ℂ`-vector space. + +With these definitions, we define `fourier_integral` to be the map from functions `V → E` to +functions `W → E` that sends `f` to + +`λ w, ∫ v in V, e [-L v w] • f v ∂μ`, + +where `e [x]` is notational sugar for `(e (multiplicative.of_add x) : ℂ)` (available in locale +`fourier_transform`). This includes the cases `W` is the dual of `V` and `L` is the canonical +pairing, or `W = V` and `L` is a bilinear form (e.g. an inner product). + +In namespace `fourier`, we consider the more familiar special case when `V = W = 𝕜` and `L` is the +multiplication map (but still allowing `𝕜` to be an arbitrary ring equipped with a measure). + +The most familiar case of all is when `V = W = 𝕜 = ℝ`, `L` is multiplication, `μ` is volume, and +`e` is `real.fourier_char`, i.e. the character `λ x, exp ((2 * π * x) * I)`. The Fourier integral +in this case is defined as `real.fourier_integral`. + +## Main results + +At present the only nontrivial lemma we prove is `continuous_fourier_integral`, stating that the +Fourier transform of an integrable function is continuous (under mild assumptions). +-/ + +noncomputable theory + +local notation `𝕊` := circle + +open measure_theory filter + +open_locale topology + +-- To avoid messing around with multiplicative vs. additive characters, we make a notation. +localized "notation e `[` x `]` := (e (multiplicative.of_add x) : ℂ)" in fourier_transform + +/-! ## Fourier theory for functions on general vector spaces -/ +namespace vector_fourier + +variables + {𝕜 : Type*} [comm_ring 𝕜] + {V : Type*} [add_comm_group V] [module 𝕜 V] [measurable_space V] + {W : Type*} [add_comm_group W] [module 𝕜 W] + {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] + +section defs + +variables [complete_space E] + +/-- The Fourier transform integral for `f : V → E`, with respect to a bilinear form `L : V × W → 𝕜` +and an additive character `e`. -/ +def fourier_integral + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) + (f : V → E) (w : W) : E := +∫ v, e [-L v w] • f v ∂μ + +lemma fourier_integral_smul_const + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) + (f : V → E) (r : ℂ) : + fourier_integral e μ L (r • f) = r • (fourier_integral e μ L f) := +begin + ext1 w, + simp only [pi.smul_apply, fourier_integral, smul_comm _ r, integral_smul], +end + +/-- The uniform norm of the Fourier integral of `f` is bounded by the `L¹` norm of `f`. -/ +lemma norm_fourier_integral_le_integral_norm (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) + (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) (f : V → E) (w : W) : + ‖fourier_integral e μ L f w‖ ≤ ∫ (v : V), ‖f v‖ ∂μ := +begin + refine (norm_integral_le_integral_norm _).trans (le_of_eq _), + simp_rw [norm_smul, complex.norm_eq_abs, abs_coe_circle, one_mul], +end + +/-- The Fourier integral converts right-translation into scalar multiplication by a phase factor.-/ +lemma fourier_integral_comp_add_right [has_measurable_add V] + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure V) [μ.is_add_right_invariant] + (L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜) (f : V → E) (v₀ : V) : + fourier_integral e μ L (f ∘ (λ v, v + v₀)) = λ w, e [L v₀ w] • fourier_integral e μ L f w := +begin + ext1 w, + dsimp only [fourier_integral, function.comp_apply], + conv in (L _) { rw ←add_sub_cancel v v₀ }, + rw integral_add_right_eq_self (λ (v : V), e [-L (v - v₀) w] • f v), + swap, apply_instance, + dsimp only, + rw ←integral_smul, + congr' 1 with v, + rw [←smul_assoc, smul_eq_mul, ←submonoid.coe_mul, ←e.map_mul, ←of_add_add, ←linear_map.neg_apply, + ←sub_eq_add_neg, ←linear_map.sub_apply, linear_map.map_sub, neg_sub] +end + +end defs + +section continuous +/- In this section we assume 𝕜, V, W have topologies, and L, e are continuous (but f needn't be). + This is used to ensure that `e [-L v w]` is (ae strongly) measurable. We could get away with + imposing only a measurable-space structure on 𝕜 (it doesn't have to be the Borel sigma-algebra of + a topology); but it seems hard to imagine cases where this extra generality would be useful, and + allowing it would complicate matters in the most important use cases. +-/ + +variables [topological_space 𝕜] [topological_ring 𝕜] [topological_space V] [borel_space V] + [topological_space W] {e : (multiplicative 𝕜) →* 𝕊} {μ : measure V} {L : V →ₗ[𝕜] W →ₗ[𝕜] 𝕜} + +/-- For any `w`, the Fourier integral is convergent iff `f` is integrable. -/ +lemma fourier_integral_convergent_iff (he : continuous e) (hL : continuous (λ p : V × W, L p.1 p.2)) + {f : V → E} (w : W) : + integrable f μ ↔ integrable (λ (v : V), (e [-L v w]) • f v) μ := +begin + -- first prove one-way implication + have aux : ∀ {g : V → E} (hg : integrable g μ) (x : W), + integrable (λ (v : V), (e [-L v x]) • g v) μ, + { intros g hg x, + have c : continuous (λ v, e[-L v x]), + { refine (continuous_induced_rng.mp he).comp (continuous_of_add.comp (continuous.neg _)), + exact hL.comp (continuous_prod_mk.mpr ⟨continuous_id, continuous_const⟩) }, + rw ←integrable_norm_iff (c.ae_strongly_measurable.smul hg.1), + convert hg.norm, + ext1 v, + rw [norm_smul, complex.norm_eq_abs, abs_coe_circle, one_mul] }, + -- then use it for both directions + refine ⟨λ hf, aux hf w, λ hf, _⟩, + convert aux hf (-w), + ext1 v, + rw [←smul_assoc, smul_eq_mul, ←submonoid.coe_mul, ←monoid_hom.map_mul, + ←of_add_add, linear_map.map_neg, neg_neg, ←sub_eq_add_neg, sub_self, of_add_zero, + monoid_hom.map_one, submonoid.coe_one, one_smul], +end + +variables [complete_space E] + +lemma fourier_integral_add + (he : continuous e) (hL : continuous (λ p : V × W, L p.1 p.2)) + {f g : V → E} (hf : integrable f μ) (hg : integrable g μ) : + (fourier_integral e μ L f) + (fourier_integral e μ L g) = fourier_integral e μ L (f + g) := +begin + ext1 w, + dsimp only [pi.add_apply, fourier_integral], + simp_rw smul_add, + rw integral_add, + { exact (fourier_integral_convergent_iff he hL w).mp hf }, + { exact (fourier_integral_convergent_iff he hL w).mp hg }, +end + +/-- The Fourier integral of an `L^1` function is a continuous function. -/ +lemma fourier_integral_continuous [topological_space.first_countable_topology W] + (he : continuous e) (hL : continuous (λ p : V × W, L p.1 p.2)) + {f : V → E} (hf : integrable f μ) : + continuous (fourier_integral e μ L f) := +begin + apply continuous_of_dominated, + { exact λ w, ((fourier_integral_convergent_iff he hL w).mp hf).1 }, + { refine λ w, ae_of_all _ (λ v, _), + { exact λ v, ‖f v‖ }, + { rw [norm_smul, complex.norm_eq_abs, abs_coe_circle, one_mul] } }, + { exact hf.norm }, + { rw continuous_induced_rng at he, + refine ae_of_all _ (λ v, (he.comp (continuous_of_add.comp _)).smul continuous_const), + refine (hL.comp (continuous_prod_mk.mpr ⟨continuous_const, continuous_id⟩)).neg } +end + +end continuous + +end vector_fourier + +/-! ## Fourier theory for functions on `𝕜` -/ +namespace fourier + +variables {𝕜 : Type*} [comm_ring 𝕜] [measurable_space 𝕜] + {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] + +section defs + +variables [complete_space E] + +/-- The Fourier transform integral for `f : 𝕜 → E`, with respect to the measure `μ` and additive +character `e`. -/ +def fourier_integral + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (w : 𝕜) : E := +vector_fourier.fourier_integral e μ (linear_map.mul 𝕜 𝕜) f w + +lemma fourier_integral_def (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (w : 𝕜) : + fourier_integral e μ f w = ∫ (v : 𝕜), e[-(v * w)] • f v ∂μ := +rfl + +lemma fourier_integral_smul_const + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (r : ℂ) : + fourier_integral e μ (r • f) = r • (fourier_integral e μ f) := +vector_fourier.fourier_integral_smul_const _ _ _ _ _ + +/-- The uniform norm of the Fourier transform of `f` is bounded by the `L¹` norm of `f`. -/ +lemma norm_fourier_integral_le_integral_norm + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) (f : 𝕜 → E) (w : 𝕜) : + ‖fourier_integral e μ f w‖ ≤ ∫ x : 𝕜, ‖f x‖ ∂μ := +vector_fourier.norm_fourier_integral_le_integral_norm _ _ _ _ _ + +/-- The Fourier transform converts right-translation into scalar multiplication by a phase factor.-/ +lemma fourier_integral_comp_add_right [has_measurable_add 𝕜] + (e : (multiplicative 𝕜) →* 𝕊) (μ : measure 𝕜) [μ.is_add_right_invariant] (f : 𝕜 → E) (v₀ : 𝕜) : + fourier_integral e μ (f ∘ (λ v, v + v₀)) = λ w, e [v₀ * w] • fourier_integral e μ f w := +vector_fourier.fourier_integral_comp_add_right _ _ _ _ _ + +end defs + +end fourier + +open_locale real + +namespace real + +/-- The standard additive character of `ℝ`, given by `λ x, exp (2 * π * x * I)`. -/ +def fourier_char : (multiplicative ℝ) →* 𝕊 := +{ to_fun := λ z, exp_map_circle (2 * π * z.to_add), + map_one' := by rw [to_add_one, mul_zero, exp_map_circle_zero], + map_mul' := λ x y, by rw [to_add_mul, mul_add, exp_map_circle_add] } + +lemma fourier_char_apply (x : ℝ) : + real.fourier_char [x] = complex.exp (↑(2 * π * x) * complex.I) := +by refl + +@[continuity] +lemma continuous_fourier_char : continuous real.fourier_char := +(map_continuous exp_map_circle).comp (continuous_const.mul continuous_to_add) + +variables {E : Type*} [normed_add_comm_group E] [complete_space E] [normed_space ℂ E] + +lemma vector_fourier_integral_eq_integral_exp_smul + {V : Type*} [add_comm_group V] [module ℝ V] [measurable_space V] + {W : Type*} [add_comm_group W] [module ℝ W] + (L : V →ₗ[ℝ] W →ₗ[ℝ] ℝ) (μ : measure V) (f : V → E) (w : W) : + vector_fourier.fourier_integral fourier_char μ L f w + = ∫ (v : V), complex.exp (↑(-2 * π * L v w) * complex.I) • f v ∂μ := +by simp_rw [vector_fourier.fourier_integral, real.fourier_char_apply, mul_neg, neg_mul] + +/-- The Fourier integral for `f : ℝ → E`, with respect to the standard additive character and +measure on `ℝ`. -/ +def fourier_integral (f : ℝ → E) (w : ℝ) := fourier.fourier_integral fourier_char volume f w + +lemma fourier_integral_def (f : ℝ → E) (w : ℝ) : + fourier_integral f w = ∫ (v : ℝ), fourier_char [-(v * w)] • f v := +rfl + +localized "notation (name := fourier_integral) `𝓕` := real.fourier_integral" in fourier_transform + +lemma fourier_integral_eq_integral_exp_smul + {E : Type*} [normed_add_comm_group E] [complete_space E] [normed_space ℂ E] + (f : ℝ → E) (w : ℝ) : + 𝓕 f w = ∫ (v : ℝ), complex.exp (↑(-2 * π * v * w) * complex.I) • f v := +by simp_rw [fourier_integral_def, real.fourier_char_apply, mul_neg, neg_mul, mul_assoc] + +end real diff --git a/src/analysis/fourier/poisson_summation.lean b/src/analysis/fourier/poisson_summation.lean new file mode 100644 index 0000000000000..7c7f257793639 --- /dev/null +++ b/src/analysis/fourier/poisson_summation.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ +import analysis.fourier.add_circle +import analysis.fourier.fourier_transform +import analysis.p_series +import analysis.schwartz_space +import measure_theory.measure.lebesgue.integral + +/-! +# Poisson's summation formula + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We prove Poisson's summation formula `∑ (n : ℤ), f n = ∑ (n : ℤ), 𝓕 f n`, where `𝓕 f` is the +Fourier transform of `f`, under the following hypotheses: +* `f` is a continuous function `ℝ → ℂ`. +* The sum `∑ (n : ℤ), 𝓕 f n` is convergent. +* For all compacts `K ⊂ ℝ`, the sum `∑ (n : ℤ), sup { ‖f(x + n)‖ | x ∈ K }` is convergent. +See `real.tsum_eq_tsum_fourier_integral` for this formulation. + +These hypotheses are potentially a little awkward to apply, so we also provide the less general but +easier-to-use result `real.tsum_eq_tsum_fourier_integral_of_rpow_decay`, in which we assume `f` and +`𝓕 f` both decay as `|x| ^ (-b)` for some `b > 1`, and the even more specific result +`schwartz_map.tsum_eq_tsum_fourier_integral`, where we assume that both `f` and `𝓕 f` are Schwartz +functions. + +## TODO + +At the moment `schwartz_map.tsum_eq_tsum_fourier_integral` requires separate proofs that both `f` +and `𝓕 f` are Schwartz functions. In fact, `𝓕 f` is automatically Schwartz if `f` is; and once +we have this lemma in the library, we should adjust the hypotheses here accordingly. +-/ + +noncomputable theory + +open function (hiding comp_apply) complex (hiding abs_of_nonneg) real set (hiding restrict_apply) + topological_space filter measure_theory asymptotics + +open_locale real big_operators filter fourier_transform + +local attribute [instance] real.fact_zero_lt_one + +open continuous_map + +/-- The key lemma for Poisson summation: the `m`-th Fourier coefficient of the periodic function +`∑' n : ℤ, f (x + n)` is the value at `m` of the Fourier transform of `f`. -/ +lemma real.fourier_coeff_tsum_comp_add {f : C(ℝ, ℂ)} + (hf : ∀ (K : compacts ℝ), summable (λ n : ℤ, ‖(f.comp (continuous_map.add_right n)).restrict K‖)) + (m : ℤ) : + fourier_coeff (periodic.lift $ f.periodic_tsum_comp_add_zsmul 1) m = 𝓕 f m := +begin + -- NB: This proof can be shortened somewhat by telescoping together some of the steps in the calc + -- block, but I think it's more legible this way. We start with preliminaries about the integrand. + let e : C(ℝ, ℂ) := (fourier (-m)).comp ⟨(coe : ℝ → unit_add_circle), continuous_quotient_mk⟩, + have neK : ∀ (K : compacts ℝ) (g : C(ℝ, ℂ)), ‖(e * g).restrict K‖ = ‖g.restrict K‖, + { have : ∀ (x : ℝ), ‖e x‖ = 1, from λ x, abs_coe_circle _, + intros K g, + simp_rw [norm_eq_supr_norm, restrict_apply, mul_apply, norm_mul, this, one_mul] }, + have eadd : ∀ (n : ℤ), e.comp (continuous_map.add_right n) = e, + { intro n, ext1 x, + have : periodic e 1, from periodic.comp (λ x, add_circle.coe_add_period 1 x) _, + simpa only [mul_one] using this.int_mul n x }, + -- Now the main argument. First unwind some definitions. + calc fourier_coeff (periodic.lift $ f.periodic_tsum_comp_add_zsmul 1) m + = ∫ x in 0..1, e x * (∑' n : ℤ, f.comp (continuous_map.add_right n)) x : + by simp_rw [fourier_coeff_eq_interval_integral _ m 0, div_one, one_smul, zero_add, comp_apply, + coe_mk, periodic.lift_coe, zsmul_one, smul_eq_mul] + -- Transform sum in C(ℝ, ℂ) evaluated at x into pointwise sum of values. + ... = ∫ x in 0..1, (∑' n : ℤ, (e * f.comp (continuous_map.add_right n)) x) : + by simp_rw [coe_mul, pi.mul_apply, ←tsum_apply (summable_of_locally_summable_norm hf), + tsum_mul_left] + -- Swap sum and integral. + ... = ∑' n : ℤ, ∫ x in 0..1, (e * f.comp (continuous_map.add_right n)) x : + begin + refine (interval_integral.tsum_interval_integral_eq_of_summable_norm _).symm, + convert hf ⟨uIcc 0 1, is_compact_uIcc⟩, + exact funext (λ n, neK _ _) + end + ... = ∑' n : ℤ, ∫ x in 0..1, (e * f).comp (continuous_map.add_right n) x : + begin + simp only [continuous_map.comp_apply, mul_comp] at eadd ⊢, + simp_rw eadd, + end + -- Rearrange sum of interval integrals into an integral over `ℝ`. + ... = ∫ x, e x * f x : + begin + suffices : integrable ⇑(e * f), from this.has_sum_interval_integral_comp_add_int.tsum_eq, + apply integrable_of_summable_norm_Icc, + convert hf ⟨Icc 0 1, is_compact_Icc⟩, + simp_rw [continuous_map.comp_apply, mul_comp] at eadd ⊢, + simp_rw eadd, + exact funext (λ n, neK ⟨Icc 0 1, is_compact_Icc⟩ _), + end + -- Minor tidying to finish + ... = 𝓕 f m : + begin + rw fourier_integral_eq_integral_exp_smul, + congr' 1 with x : 1, + rw [smul_eq_mul, comp_apply, coe_mk, fourier_coe_apply], + congr' 2, + push_cast, + ring + end +end + +/-- **Poisson's summation formula**, most general form. -/ +theorem real.tsum_eq_tsum_fourier_integral {f : C(ℝ, ℂ)} + (h_norm : ∀ (K : compacts ℝ), + summable (λ n : ℤ, ‖(f.comp $ continuous_map.add_right n).restrict K‖)) + (h_sum : summable (λ n : ℤ, 𝓕 f n)) : + ∑' (n : ℤ), f n = ∑' (n : ℤ), 𝓕 f n := +begin + let F : C(unit_add_circle, ℂ) := ⟨(f.periodic_tsum_comp_add_zsmul 1).lift, + continuous_coinduced_dom.mpr (map_continuous _)⟩, + have : summable (fourier_coeff F), + { convert h_sum, + exact funext (λ n, real.fourier_coeff_tsum_comp_add h_norm n) }, + convert (has_pointwise_sum_fourier_series_of_summable this 0).tsum_eq.symm using 1, + { have := (has_sum_apply (summable_of_locally_summable_norm h_norm).has_sum 0).tsum_eq, + simpa only [coe_mk, ←quotient_add_group.coe_zero, periodic.lift_coe, zsmul_one, comp_apply, + coe_add_right, zero_add] using this }, + { congr' 1 with n : 1, + rw [←real.fourier_coeff_tsum_comp_add h_norm n, fourier_eval_zero, smul_eq_mul, mul_one], + refl }, +end + +section rpow_decay + +variables {E : Type*} [normed_add_comm_group E] + +/-- If `f` is `O(x ^ (-b))` at infinity, then so is the function +`λ x, ‖f.restrict (Icc (x + R) (x + S))‖` for any fixed `R` and `S`. -/ +lemma is_O_norm_Icc_restrict_at_top {f : C(ℝ, E)} {b : ℝ} (hb : 0 < b) + (hf : is_O at_top f (λ x : ℝ, |x| ^ (-b))) (R S : ℝ) : + is_O at_top (λ x : ℝ, ‖f.restrict (Icc (x + R) (x + S))‖) (λ x : ℝ, |x| ^ (-b)) := +begin + -- First establish an explicit estimate on decay of inverse powers. + -- This is logically independent of the rest of the proof, but of no mathematical interest in + -- itself, so it is proved using `async` rather than being formulated as a separate lemma. + have claim : ∀ (x : ℝ), max 0 (-2 * R) < x → + ∀ (y : ℝ), x + R ≤ y → y ^ (-b) ≤ (1 / 2) ^ (-b) * x ^ (-b), + { intros x hx y hy, + rw max_lt_iff at hx, + have hxR : 0 < x + R, + { rcases le_or_lt 0 R with h|h, + { exact add_pos_of_pos_of_nonneg hx.1 h }, + { rw [←sub_lt_iff_lt_add, zero_sub], + refine lt_trans _ hx.2, + rwa [neg_mul, neg_lt_neg_iff, two_mul, add_lt_iff_neg_left] } }, + have hy' : 0 < y, from hxR.trans_le hy, + have : y ^ (-b) ≤ (x + R) ^ (-b), + { rw [rpow_neg hy'.le, rpow_neg hxR.le, + inv_le_inv (rpow_pos_of_pos hy' _) (rpow_pos_of_pos hxR _)], + exact rpow_le_rpow hxR.le hy hb.le }, + refine this.trans _, + rw [←mul_rpow one_half_pos.le hx.1.le, rpow_neg (mul_pos one_half_pos hx.1).le, + rpow_neg hxR.le], + refine inv_le_inv_of_le (rpow_pos_of_pos (mul_pos one_half_pos hx.1) _) _, + exact rpow_le_rpow (mul_pos one_half_pos hx.1).le (by linarith) hb.le }, + -- Now the main proof. + obtain ⟨c, hc, hc'⟩ := hf.exists_pos, + simp only [is_O, is_O_with, eventually_at_top] at hc' ⊢, + obtain ⟨d, hd⟩ := hc', + refine ⟨c * (1 / 2) ^ (-b), ⟨max (1 + max 0 (-2 * R)) (d - R), λ x hx, _⟩⟩, + rw [ge_iff_le, max_le_iff] at hx, + have hx' : max 0 (-2 * R) < x, by linarith, + rw max_lt_iff at hx', + rw [norm_norm, continuous_map.norm_le _ + (mul_nonneg (mul_nonneg hc.le $ rpow_nonneg_of_nonneg one_half_pos.le _) (norm_nonneg _))], + refine λ y, (hd y.1 (by linarith [hx.1, y.2.1])).trans _, + have A : ∀ (x : ℝ), 0 ≤ |x| ^ (-b), from λ x, by positivity, + rwa [mul_assoc, mul_le_mul_left hc, norm_of_nonneg (A _), norm_of_nonneg (A _)], + convert claim x (by linarith only [hx.1]) y.1 y.2.1, + { apply abs_of_nonneg, linarith [y.2.1] }, + { exact abs_of_pos hx'.1 }, +end + +lemma is_O_norm_Icc_restrict_at_bot {f : C(ℝ, E)} {b : ℝ} (hb : 0 < b) + (hf : is_O at_bot f (λ x : ℝ, |x| ^ (-b))) (R S : ℝ) : + is_O at_bot (λ x : ℝ, ‖f.restrict (Icc (x + R) (x + S))‖) (λ x : ℝ, |x| ^ (-b)) := +begin + have h1 : is_O at_top (f.comp (continuous_map.mk _ continuous_neg)) (λ x : ℝ, |x| ^ (-b)), + { convert hf.comp_tendsto tendsto_neg_at_top_at_bot, + ext1 x, simp only [function.comp_app, abs_neg] }, + have h2 := (is_O_norm_Icc_restrict_at_top hb h1 (-S) (-R)).comp_tendsto tendsto_neg_at_bot_at_top, + have : ((λ (x : ℝ), |x| ^ -b) ∘ has_neg.neg) = (λ (x : ℝ), |x| ^ -b), + { ext1 x, simp only [function.comp_app, abs_neg] }, + rw this at h2, + refine (is_O_of_le _ (λ x, _)).trans h2, -- equality holds, but less work to prove `≤` alone + rw [norm_norm, function.comp_app, norm_norm, continuous_map.norm_le _ (norm_nonneg _)], + rintro ⟨x, hx⟩, + rw [continuous_map.restrict_apply_mk], + refine (le_of_eq _).trans (continuous_map.norm_coe_le_norm _ ⟨-x, _⟩), + { exact ⟨by linarith [hx.2], by linarith [hx.1]⟩ }, + { rw [continuous_map.restrict_apply_mk, continuous_map.comp_apply, continuous_map.coe_mk, + neg_neg] } +end + +lemma is_O_norm_restrict_cocompact (f : C(ℝ, E)) {b : ℝ} (hb : 0 < b) + (hf : is_O (cocompact ℝ) f (λ x : ℝ, |x| ^ (-b))) (K : compacts ℝ) : + is_O (cocompact ℝ) (λ x, ‖(f.comp (continuous_map.add_right x)).restrict K‖) (λ x, |x| ^ (-b)) := +begin + obtain ⟨r, hr⟩ := K.is_compact.bounded.subset_ball 0, + rw [closed_ball_eq_Icc, zero_add, zero_sub] at hr, + have : ∀ (x : ℝ), ‖(f.comp (continuous_map.add_right x)).restrict K‖ ≤ + ‖f.restrict (Icc (x - r) (x + r))‖, + { intro x, + rw continuous_map.norm_le _ (norm_nonneg _), + rintro ⟨y, hy⟩, + refine (le_of_eq _).trans (continuous_map.norm_coe_le_norm _ ⟨y + x, _⟩), + exact ⟨by linarith [(hr hy).1], by linarith [(hr hy).2]⟩, + simp_rw [continuous_map.restrict_apply, continuous_map.comp_apply, + continuous_map.coe_add_right, subtype.coe_mk] }, + simp_rw [cocompact_eq, is_O_sup] at hf ⊢, + split, + { refine (is_O_of_le at_bot _).trans (is_O_norm_Icc_restrict_at_bot hb hf.1 (-r) r), + simp_rw norm_norm, exact this }, + { refine (is_O_of_le at_top _).trans (is_O_norm_Icc_restrict_at_top hb hf.2 (-r) r), + simp_rw norm_norm, exact this }, +end + + +/-- **Poisson's summation formula**, assuming that `f` decays as +`|x| ^ (-b)` for some `1 < b` and its Fourier transform is summable. -/ +lemma real.tsum_eq_tsum_fourier_integral_of_rpow_decay_of_summable {f : ℝ → ℂ} (hc : continuous f) + {b : ℝ} (hb : 1 < b) (hf : is_O (cocompact ℝ) f (λ x : ℝ, |x| ^ (-b))) + (hFf : summable (λ n : ℤ, 𝓕 f n)) : + ∑' (n : ℤ), f n = ∑' (n : ℤ), 𝓕 f n := +real.tsum_eq_tsum_fourier_integral + (λ K, summable_of_is_O (real.summable_abs_int_rpow hb) + ((is_O_norm_restrict_cocompact (continuous_map.mk _ hc) + (zero_lt_one.trans hb) hf K).comp_tendsto int.tendsto_coe_cofinite)) hFf + +/-- **Poisson's summation formula**, assuming that both `f` and its Fourier transform decay as +`|x| ^ (-b)` for some `1 < b`. (This is the one-dimensional case of Corollary VII.2.6 of Stein and +Weiss, *Introduction to Fourier analysis on Euclidean spaces*.) -/ +lemma real.tsum_eq_tsum_fourier_integral_of_rpow_decay {f : ℝ → ℂ} (hc : continuous f) + {b : ℝ} (hb : 1 < b) (hf : is_O (cocompact ℝ) f (λ x : ℝ, |x| ^ (-b))) + (hFf : is_O (cocompact ℝ) (𝓕 f) (λ x : ℝ, |x| ^ (-b))) : + ∑' (n : ℤ), f n = ∑' (n : ℤ), 𝓕 f n := +real.tsum_eq_tsum_fourier_integral_of_rpow_decay_of_summable hc hb hf + (summable_of_is_O (real.summable_abs_int_rpow hb) (hFf.comp_tendsto int.tendsto_coe_cofinite)) + +end rpow_decay + +section schwartz + +/-- **Poisson's summation formula** for Schwartz functions. -/ +lemma schwartz_map.tsum_eq_tsum_fourier_integral + (f g : schwartz_map ℝ ℂ) (hfg : 𝓕 f = g) : + ∑' (n : ℤ), f n = ∑' (n : ℤ), g n := +begin + -- We know that Schwartz functions are `O(‖x ^ (-b)‖)` for *every* `b`; for this argument we take + -- `b = 2` and work with that. + simp_rw ←hfg, + exact real.tsum_eq_tsum_fourier_integral_of_rpow_decay f.continuous one_lt_two + (f.is_O_cocompact_rpow (-2)) (by simpa only [hfg] using g.is_O_cocompact_rpow (-2)) +end + +end schwartz diff --git a/src/analysis/fourier/riemann_lebesgue_lemma.lean b/src/analysis/fourier/riemann_lebesgue_lemma.lean new file mode 100644 index 0000000000000..d986b81e740a8 --- /dev/null +++ b/src/analysis/fourier/riemann_lebesgue_lemma.lean @@ -0,0 +1,323 @@ +/- +Copyright (c) 2022 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ + +import analysis.fourier.fourier_transform +import analysis.inner_product_space.dual +import analysis.inner_product_space.euclidean_dist +import measure_theory.function.continuous_map_dense +import measure_theory.group.integration +import measure_theory.integral.set_integral +import measure_theory.measure.haar.normed_space +import topology.metric_space.emetric_paracompact + +/-! +# The Riemann-Lebesgue Lemma + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove the Riemann-Lebesgue lemma, for functions on finite-dimensional real vector +spaces `V`: if `f` is a function on `V` (valued in a complete normed space `E`), then the +Fourier transform of `f`, viewed as a function on the dual space of `V`, tends to 0 along the +cocompact filter. Here the Fourier transform is defined by + +`λ w : V →L[ℝ] ℝ, ∫ (v : V), exp (↑(2 * π * w v) * I) • f x`. + +This is true for arbitrary functions, but is only interesting for `L¹` functions (if `f` is not +integrable then the integral is zero for all `w`). This is proved first for continuous +compactly-supported functions on inner-product spaces; then we pass to arbitrary functions using the +density of continuous compactly-supported functions in `L¹` space. Finally we generalise from +inner-product spaces to arbitrary finite-dimensional spaces, by choosing a continuous linear +equivalence to an inner-product space. + +## Main results + +- `tendsto_integral_exp_inner_smul_cocompact` : for `V` a finite-dimensional real inner product + space and `f : V → E`, the function `λ w : V, ∫ v : V, exp (2 * π * ⟪w, v⟫ * I) • f v` tends to 0 + along `cocompact V`. +- `tendsto_integral_exp_smul_cocompact` : for `V` a finite-dimensional real vector space (endowed + with its unique Hausdorff topological vector space structure), and `W` the dual of `V`, the + function `λ w : W, ∫ v : V, exp (2 * π * w v * I) • f v` tends to along `cocompact W`. +- `real.tendsto_integral_exp_smul_cocompact`: special case of functions on `ℝ`. +- `real.zero_at_infty_fourier_integral` and `real.zero_at_infty_vector_fourier_integral`: + reformulations explicitly using the Fourier integral. +-/ +noncomputable theory + +open measure_theory filter complex set finite_dimensional +open_locale filter topology real ennreal fourier_transform real_inner_product_space nnreal + +variables {E V : Type*} [normed_add_comm_group E] [normed_space ℂ E] {f : V → E} + +local notation `e` := real.fourier_char + +section inner_product_space + +variables [normed_add_comm_group V] [measurable_space V] [borel_space V] + [inner_product_space ℝ V] [finite_dimensional ℝ V] + +/-- The integrand in the Riemann-Lebesgue lemma for `f` is integrable iff `f` is. -/ +lemma fourier_integrand_integrable (w : V) : + integrable f ↔ integrable (λ v : V, e [-⟪v, w⟫] • f v) := +begin + have hL : continuous (λ p : V × V, bilin_form_of_real_inner.to_lin p.1 p.2) := continuous_inner, + rw vector_fourier.fourier_integral_convergent_iff real.continuous_fourier_char hL w, + { simp only [bilin_form.to_lin_apply, bilin_form_of_real_inner_apply] }, + { apply_instance }, +end + +variables [complete_space E] + +local notation `i` := λ w, (1 / (2 * ‖w‖ ^ 2)) • w + +/-- Shifting `f` by `(1 / (2 * ‖w‖ ^ 2)) • w` negates the integral in the Riemann-Lebesgue lemma. -/ +lemma fourier_integral_half_period_translate {w : V} (hw : w ≠ 0) : + ∫ (v : V), e [-⟪v, w⟫] • f (v + i w) = -∫ (v : V), e [-⟪v, w⟫] • f v := +begin + have hiw : ⟪i w, w⟫ = 1 / 2, + { rw [inner_smul_left, inner_self_eq_norm_sq_to_K, is_R_or_C.coe_real_eq_id, id.def, + is_R_or_C.conj_to_real, ←div_div, div_mul_cancel], + rwa [ne.def, sq_eq_zero_iff, norm_eq_zero] }, + have : (λ v : V, e [-⟪v, w⟫] • f (v + i w)) = (λ v : V, (λ x : V, -e[-⟪x, w⟫] • f x) (v + i w)), + { ext1 v, + simp_rw [inner_add_left, hiw, real.fourier_char_apply, neg_add, mul_add, of_real_add, add_mul, + exp_add], + have : 2 * π * -(1 / 2) = -π, by { field_simp, ring }, + rw [this, of_real_neg, neg_mul, exp_neg, exp_pi_mul_I, inv_neg, inv_one, mul_neg_one, neg_neg]}, + rw [this, integral_add_right_eq_self], + simp only [neg_smul, integral_neg], +end + +/-- Rewrite the Fourier integral in a form that allows us to use uniform continuity. -/ +lemma fourier_integral_eq_half_sub_half_period_translate {w : V} (hw : w ≠ 0) (hf : integrable f) : + ∫ v : V, e[-⟪v, w⟫] • f v = (1 / (2 : ℂ)) • ∫ v : V, e[-⟪v, w⟫] • (f v - f (v + i w)) := +begin + simp_rw [smul_sub], + rw [integral_sub, fourier_integral_half_period_translate hw, sub_eq_add_neg, neg_neg, + ←two_smul ℂ _, ←@smul_assoc _ _ _ _ _ _ (is_scalar_tower.left ℂ), smul_eq_mul], + norm_num, + exacts [(fourier_integrand_integrable w).mp hf, + (fourier_integrand_integrable w).mp (hf.comp_add_right _)], +end + +/-- Riemann-Lebesgue Lemma for continuous and compactly-supported functions: the integral +`∫ v, exp (-2 * π * ⟪w, v⟫ * I) • f v` tends to 0 wrt `cocompact V`. Note that this is primarily +of interest as a preparatory step for the more general result +`tendsto_integral_exp_inner_smul_cocompact` in which `f` can be arbitrary. -/ +lemma tendsto_integral_exp_inner_smul_cocompact_of_continuous_compact_support + (hf1 : continuous f) (hf2 : has_compact_support f) : + tendsto (λ w : V, ∫ v : V, e[-⟪v, w⟫] • f v) (cocompact V) (𝓝 0) := +begin + refine normed_add_comm_group.tendsto_nhds_zero.mpr (λ ε hε, _), + suffices : ∃ (T : ℝ), ∀ (w : V), T ≤ ‖w‖ → ‖∫ (v : V), e[-⟪v, w⟫] • f v‖ < ε, + { simp_rw [←comap_dist_left_at_top_eq_cocompact (0 : V), eventually_comap, eventually_at_top, + dist_eq_norm', sub_zero], + exact let ⟨T, hT⟩ := this in ⟨T, (λ b hb v hv, hT v (hv.symm ▸ hb))⟩ }, + obtain ⟨R, hR_pos, hR_bd⟩ : ∃ (R : ℝ), 0 < R ∧ ∀ (x : V), R ≤ ‖x‖ → f x = 0, + from hf2.exists_pos_le_norm, + let A := {v : V | ‖v‖ ≤ R + 1}, + have mA : measurable_set A, + { suffices : A = metric.closed_ball (0 : V) (R + 1), + by { rw this, exact metric.is_closed_ball.measurable_set }, + simp_rw [A, metric.closed_ball, dist_eq_norm, sub_zero] }, + obtain ⟨B, hB_pos, hB_vol⟩ : ∃ (B : ℝ≥0), 0 < B ∧ volume A ≤ B, + { have hc : is_compact A, by simpa only [metric.closed_ball, dist_eq_norm, sub_zero] + using is_compact_closed_ball (0 : V) _, + let B₀ := volume A, + replace hc : B₀ < ⊤ := hc.measure_lt_top, + refine ⟨B₀.to_nnreal + 1, add_pos_of_nonneg_of_pos B₀.to_nnreal.coe_nonneg one_pos, _⟩, + rw [ennreal.coe_add, ennreal.coe_one, ennreal.coe_to_nnreal hc.ne], + exact le_self_add }, + --* Use uniform continuity to choose δ such that `‖x - y‖ < δ` implies `‖f x - f y‖ < ε / B`. + obtain ⟨δ, hδ1, hδ2⟩ := metric.uniform_continuous_iff.mp + (hf2.uniform_continuous_of_continuous hf1) (ε / B) (div_pos hε hB_pos), + refine ⟨1 / 2 + 1 / (2 * δ), λ w hw_bd, _⟩, + have hw_ne : w ≠ 0, + { contrapose! hw_bd, rw [hw_bd, norm_zero], + exact add_pos one_half_pos (one_div_pos.mpr $ mul_pos two_pos hδ1) }, + have hw'_nm : ‖i w‖ = 1 / (2 * ‖w‖), + { rw [norm_smul, norm_div, real.norm_of_nonneg (mul_nonneg two_pos.le $ sq_nonneg _), norm_one, + sq, ←div_div, ←div_div, ←div_div, div_mul_cancel _ (norm_eq_zero.not.mpr hw_ne)] }, + --* Rewrite integral in terms of `f v - f (v + w')`. + rw [fourier_integral_eq_half_sub_half_period_translate hw_ne + (hf1.integrable_of_has_compact_support hf2), norm_smul, norm_eq_abs, ←complex.of_real_one, + ←of_real_bit0, ←of_real_div, complex.abs_of_nonneg one_half_pos.le], + have : ε = (1 / 2) * (2 * ε), by { field_simp, rw mul_comm }, + rw [this, mul_lt_mul_left (one_half_pos : (0:ℝ) < 1/2)], + refine lt_of_le_of_lt (norm_integral_le_integral_norm _) _, + simp_rw [norm_smul, norm_eq_abs, abs_coe_circle, one_mul], + --* Show integral can be taken over A only. + have int_A : ∫ (v : V), ‖f v - f (v + i w)‖ = ∫ v in A, ‖f v - f (v + i w)‖, + { refine (set_integral_eq_integral_of_forall_compl_eq_zero (λ v hv, _)).symm, + dsimp only [A] at hv, + simp only [A, mem_set_of_eq, not_le] at hv, + rw [hR_bd v _, hR_bd (v + i w) _, sub_zero, norm_zero], + { rw ←sub_neg_eq_add, + refine le_trans _ (norm_sub_norm_le _ _), + rw [le_sub_iff_add_le, norm_neg], + refine le_trans _ hv.le, + rw [add_le_add_iff_left, hw'_nm, ←div_div], + refine (div_le_one $ norm_pos_iff.mpr hw_ne).mpr _, + refine le_trans (le_add_of_nonneg_right $ one_div_nonneg.mpr $ _) hw_bd, + exact (mul_pos (zero_lt_two' ℝ) hδ1).le }, + { exact ((le_add_iff_nonneg_right _).mpr zero_le_one).trans hv.le } }, + rw int_A, clear int_A, + --* Bound integral using fact that `‖f v - f (v + w')‖` is small. + have bdA : ∀ v : V, (v ∈ A) → ‖ ‖f v - f (v + i w) ‖ ‖ ≤ ε / B, + { simp_rw norm_norm, + simp_rw dist_eq_norm at hδ2, + refine (λ x _, (hδ2 _).le), + rw [sub_add_cancel', norm_neg, hw'_nm, ←div_div, div_lt_iff (norm_pos_iff.mpr hw_ne), + ←div_lt_iff' hδ1, div_div], + refine (lt_add_of_pos_left _ _).trans_le hw_bd, + exact one_half_pos, }, + have bdA2 := norm_set_integral_le_of_norm_le_const (hB_vol.trans_lt ennreal.coe_lt_top) bdA _, + swap, { apply continuous.ae_strongly_measurable, + exact (continuous_norm.comp $ continuous.sub hf1 $ continuous.comp hf1 $ + continuous_id'.add continuous_const) }, + have : ‖ _ ‖ = ∫ (v : V) in A, ‖f v - f (v + i w)‖ := + real.norm_of_nonneg (set_integral_nonneg mA (λ x hx, norm_nonneg _)), + rw this at bdA2, + refine bdA2.trans_lt _, + rw [div_mul_eq_mul_div, div_lt_iff (nnreal.coe_pos.mpr hB_pos), mul_comm (2 : ℝ), mul_assoc, + mul_lt_mul_left hε], + rw ← ennreal.to_real_le_to_real at hB_vol, + { refine hB_vol.trans_lt _, + rw [(by refl : (↑B : ennreal).to_real = ↑B), two_mul], + exact lt_add_of_pos_left _ hB_pos }, + exacts [(hB_vol.trans_lt ennreal.coe_lt_top).ne, ennreal.coe_lt_top.ne], +end + +variables (f) + +/-- Riemann-Lebesgue lemma for functions on a real inner-product space: the integral +`∫ v, exp (-2 * π * ⟪w, v⟫ * I) • f v` tends to 0 as `w → ∞`. -/ +theorem tendsto_integral_exp_inner_smul_cocompact : + tendsto (λ w : V, ∫ v, e [-⟪v, w⟫] • f v) (cocompact V) (𝓝 0) := +begin + by_cases hfi : integrable f, swap, + { convert tendsto_const_nhds, + ext1 w, + apply integral_undef, + rwa ←fourier_integrand_integrable w }, + refine metric.tendsto_nhds.mpr (λ ε hε, _), + obtain ⟨g, hg_supp, hfg, hg_cont, -⟩ := + hfi.exists_has_compact_support_integral_sub_le (div_pos hε two_pos), + refine ((metric.tendsto_nhds.mp + (tendsto_integral_exp_inner_smul_cocompact_of_continuous_compact_support hg_cont hg_supp)) _ + (div_pos hε two_pos)).mp (eventually_of_forall (λ w hI, _)), + rw dist_eq_norm at hI ⊢, + have : ‖(∫ v, e [-⟪v, w⟫] • f v) - (∫ v, e [-⟪v, w⟫] • g v)‖ ≤ ε / 2, + { refine le_trans _ hfg, + simp_rw [←integral_sub ((fourier_integrand_integrable w).mp hfi) + ((fourier_integrand_integrable w).mp (hg_cont.integrable_of_has_compact_support hg_supp)), + ←smul_sub, ←pi.sub_apply], + exact vector_fourier.norm_fourier_integral_le_integral_norm e volume + bilin_form_of_real_inner.to_lin (f - g) w }, + replace := add_lt_add_of_le_of_lt this hI, + rw add_halves at this, + refine ((le_of_eq _).trans (norm_add_le _ _)).trans_lt this, + simp only [sub_zero, sub_add_cancel], +end + +/-- The Riemann-Lebesgue lemma for functions on `ℝ`. -/ +lemma real.tendsto_integral_exp_smul_cocompact (f : ℝ → E) : + tendsto (λ w : ℝ, ∫ v : ℝ, e [-(v * w)] • f v) (cocompact ℝ) (𝓝 0) := +tendsto_integral_exp_inner_smul_cocompact f + +/-- The Riemann-Lebesgue lemma for functions on `ℝ`, formulated via `real.fourier_integral`. -/ +theorem real.zero_at_infty_fourier_integral (f : ℝ → E) : + tendsto (𝓕 f) (cocompact ℝ) (𝓝 0) := +tendsto_integral_exp_inner_smul_cocompact f + +/-- Riemann-Lebesgue lemma for functions on a finite-dimensional inner-product space, formulated +via dual space. **Do not use** -- it is only a stepping stone to +`tendsto_integral_exp_smul_cocompact` where the inner-product-space structure isn't required. -/ +lemma tendsto_integral_exp_smul_cocompact_of_inner_product (μ : measure V) [μ.is_add_haar_measure] : + tendsto (λ w : V →L[ℝ] ℝ, ∫ v, e[-w v] • f v ∂μ) (cocompact (V →L[ℝ] ℝ)) (𝓝 0) := +begin + obtain ⟨C, C_ne_zero, C_ne_top, hC⟩ := μ.is_add_haar_measure_eq_smul_is_add_haar_measure volume, + rw hC, + simp_rw integral_smul_measure, + rw ←(smul_zero _ : C.to_real • (0 : E) = 0), + apply tendsto.const_smul, + let A := (inner_product_space.to_dual ℝ V).symm, + have : (λ w : V →L[ℝ] ℝ, ∫ v, e[-w v] • f v) = (λ w : V, ∫ v, e[-⟪v, w⟫] • f v) ∘ A, + { ext1 w, + congr' 1 with v : 1, + rw [←inner_conj_symm, is_R_or_C.conj_to_real, inner_product_space.to_dual_symm_apply, + real.fourier_char_apply], }, + rw this, + exact (tendsto_integral_exp_inner_smul_cocompact f).comp + A.to_homeomorph.to_cocompact_map.cocompact_tendsto', +end + +end inner_product_space + +section no_inner_product + +variables + (f) [add_comm_group V] [topological_space V] [topological_add_group V] [t2_space V] + [measurable_space V] [borel_space V] + [module ℝ V] [has_continuous_smul ℝ V] [finite_dimensional ℝ V] + [complete_space E] + +/-- Riemann-Lebesgue lemma for functions on a finite-dimensional real vector space, formulated via +dual space. -/ +theorem tendsto_integral_exp_smul_cocompact (μ : measure V) [μ.is_add_haar_measure] : + tendsto (λ w : V →L[ℝ] ℝ, ∫ v, e[-w v] • f v ∂μ) (cocompact (V →L[ℝ] ℝ)) (𝓝 0) := +begin + -- We have already proved the result for inner-product spaces, formulated in a way which doesn't + -- refer to the inner product. So we choose an arbitrary inner-product space isomorphic to V + -- and port the result over from there. + let V' := euclidean_space ℝ (fin (finrank ℝ V)), + have A : V ≃L[ℝ] V' := to_euclidean, + borelize V', + -- various equivs derived from A + let Aₘ : measurable_equiv V V' := A.to_homeomorph.to_measurable_equiv, + -- isomorphism between duals derived from A -- need to do continuity as a separate step in order + -- to apply `linear_map.continuous_of_finite_dimensional`. + let Adualₗ : (V →L[ℝ] ℝ) ≃ₗ[ℝ] (V' →L[ℝ] ℝ) := + { to_fun := λ t, t.comp A.symm.to_continuous_linear_map, + inv_fun := λ t, t.comp A.to_continuous_linear_map, + map_add' := by + { intros t s, ext1 v, simp only [continuous_linear_map.coe_comp', function.comp_app, + continuous_linear_map.add_apply] }, + map_smul' := by + { intros x f, ext1 v, simp only [ring_hom.id_apply, continuous_linear_map.coe_comp', + function.comp_app, continuous_linear_map.smul_apply] }, + left_inv := by + { intro w, ext1 v, simp only [continuous_linear_equiv.coe_def_rev, + continuous_linear_map.coe_comp', continuous_linear_equiv.coe_coe, + function.comp_app, continuous_linear_equiv.symm_apply_apply] }, + right_inv := by + { intro w, ext1 v, simp only [continuous_linear_equiv.coe_def_rev, + continuous_linear_map.coe_comp', continuous_linear_equiv.coe_coe, + function.comp_app, continuous_linear_equiv.apply_symm_apply] }, }, + let Adual : (V →L[ℝ] ℝ) ≃L[ℝ] (V' →L[ℝ] ℝ) := + { continuous_to_fun := Adualₗ.to_linear_map.continuous_of_finite_dimensional, + continuous_inv_fun := Adualₗ.symm.to_linear_map.continuous_of_finite_dimensional, + .. Adualₗ }, + haveI : (μ.map Aₘ).is_add_haar_measure, + from measure.map_continuous_linear_equiv.is_add_haar_measure _ A, + convert (tendsto_integral_exp_smul_cocompact_of_inner_product (f ∘ A.symm) (μ.map Aₘ)).comp + Adual.to_homeomorph.to_cocompact_map.cocompact_tendsto', + ext1 w, + rw [function.comp_app, integral_map_equiv], + congr' 1 with v : 1, + congr; + exact (continuous_linear_equiv.symm_apply_apply A v).symm, +end + +/-- The Riemann-Lebesgue lemma, formulated in terms of `vector_fourier.fourier_integral` (with the +pairing in the definition of `fourier_integral` taken to be the canonical pairing between `V` and +its dual space). -/ +theorem real.zero_at_infty_vector_fourier_integral (μ : measure V) [μ.is_add_haar_measure] : + tendsto (vector_fourier.fourier_integral e μ (top_dual_pairing ℝ V).flip f) + (cocompact (V →L[ℝ] ℝ)) (𝓝 0) := +tendsto_integral_exp_smul_cocompact f μ + +end no_inner_product diff --git a/src/analysis/hofer.lean b/src/analysis/hofer.lean index 3b890a10cb598..990eebfa14f74 100644 --- a/src/analysis/hofer.lean +++ b/src/analysis/hofer.lean @@ -8,6 +8,9 @@ import analysis.specific_limits.basic /-! # Hofer's lemma +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This is an elementary lemma about complete metric spaces. It is motivated by an application to the bubbling-off analysis for holomorphic curves in symplectic topology. We are *very* far away from having these applications, but the proof here is a nice @@ -18,11 +21,15 @@ example of a proof needing to construct a sequence by induction in the middle of * H. Hofer and C. Viterbo, *The Weinstein conjecture in the presence of holomorphic spheres* -/ -open_locale classical topological_space big_operators +open_locale classical topology big_operators open filter finset local notation `d` := dist +@[simp] lemma pos_div_pow_pos {α : Type*} [linear_ordered_semifield α] {a b : α} (ha : 0 < a) + (hb : 0 < b) (k : ℕ) : 0 < a/b^k := +div_pos ha (pow_pos hb k) + lemma hofer {X: Type*} [metric_space X] [complete_space X] (x : X) (ε : ℝ) (ε_pos : 0 < ε) {ϕ : X → ℝ} (cont : continuous ϕ) (nonneg : ∀ y, 0 ≤ ϕ y) : @@ -35,14 +42,13 @@ begin have reformulation : ∀ x' (k : ℕ), ε * ϕ x ≤ ε / 2 ^ k * ϕ x' ↔ 2^k * ϕ x ≤ ϕ x', { intros x' k, rw [div_mul_eq_mul_div, le_div_iff, mul_assoc, mul_le_mul_left ε_pos, mul_comm], - exact pow_pos (by norm_num) k, }, + positivity }, -- Now let's specialize to `ε/2^k` replace H : ∀ k : ℕ, ∀ x', d x' x ≤ 2 * ε ∧ 2^k * ϕ x ≤ ϕ x' → ∃ y, d x' y ≤ ε/2^k ∧ 2 * ϕ x' < ϕ y, { intros k x', push_neg at H, - simpa [reformulation] using - H (ε/2^k) (by simp [ε_pos, zero_lt_two]) x' (by simp [ε_pos, zero_lt_two, one_le_two]) }, + simpa [reformulation] using H (ε/2^k) (by simp [ε_pos]) x' (by simp [ε_pos.le, one_le_two]) }, clear reformulation, haveI : nonempty X := ⟨x⟩, choose! F hF using H, -- Use the axiom of choice @@ -84,7 +90,7 @@ begin -- Hence u is Cauchy have cauchy_u : cauchy_seq u, { refine cauchy_seq_of_le_geometric _ ε one_half_lt_one (λ n, _), - simpa only [one_div, inv_pow₀] using key₁ n }, + simpa only [one_div, inv_pow] using key₁ n }, -- So u converges to some y obtain ⟨y, limy⟩ : ∃ y, tendsto u at_top (𝓝 y), from complete_space.complete cauchy_u, diff --git a/src/analysis/inner_product_space/adjoint.lean b/src/analysis/inner_product_space/adjoint.lean index 8660c23653d90..768e5627ed4a4 100644 --- a/src/analysis/inner_product_space/adjoint.lean +++ b/src/analysis/inner_product_space/adjoint.lean @@ -10,6 +10,9 @@ import analysis.inner_product_space.pi_L2 /-! # Adjoint of operators on Hilbert spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given an operator `A : E →L[𝕜] F`, where `E` and `F` are Hilbert spaces, its adjoint `adjoint A : F →L[𝕜] E` is the unique operator such that `⟪x, A y⟫ = ⟪adjoint A x, y⟫` for all `x` and `y`. @@ -40,13 +43,18 @@ adjoint -/ noncomputable theory -open inner_product_space continuous_linear_map is_R_or_C +open is_R_or_C open_locale complex_conjugate variables {𝕜 E F G : Type*} [is_R_or_C 𝕜] +variables [normed_add_comm_group E] [normed_add_comm_group F] [normed_add_comm_group G] variables [inner_product_space 𝕜 E] [inner_product_space 𝕜 F] [inner_product_space 𝕜 G] local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y +/-! ### Adjoint operator -/ + +open inner_product_space + namespace continuous_linear_map variables [complete_space E] [complete_space G] @@ -66,7 +74,7 @@ by { simp only [adjoint_aux_apply, to_dual_symm_apply, to_sesq_form_apply_coe, c innerSL_apply_coe]} lemma adjoint_aux_inner_right (A : E →L[𝕜] F) (x : E) (y : F) : ⟪x, adjoint_aux A y⟫ = ⟪A x, y⟫ := -by rw [←inner_conj_sym, adjoint_aux_inner_left, inner_conj_sym] +by rw [←inner_conj_symm, adjoint_aux_inner_left, inner_conj_symm] variables [complete_space F] @@ -77,7 +85,7 @@ begin rw [adjoint_aux_inner_right, adjoint_aux_inner_left], end -@[simp] lemma adjoint_aux_norm (A : E →L[𝕜] F) : ∥adjoint_aux A∥ = ∥A∥ := +@[simp] lemma adjoint_aux_norm (A : E →L[𝕜] F) : ‖adjoint_aux A‖ = ‖A‖ := begin refine le_antisymm _ _, { refine continuous_linear_map.op_norm_le_bound _ (norm_nonneg _) (λ x, _), @@ -96,7 +104,7 @@ linear_isometry_equiv.of_surjective ..adjoint_aux } (λ A, ⟨adjoint_aux A, adjoint_aux_adjoint_aux A⟩) -localized "postfix `†`:1000 := continuous_linear_map.adjoint" in inner_product +localized "postfix (name := adjoint) `†`:1000 := continuous_linear_map.adjoint" in inner_product /-- The fundamental property of the adjoint. -/ lemma adjoint_inner_left (A : E →L[𝕜] F) (x : E) (y : F) : ⟪A† y, x⟫ = ⟪y, A x⟫ := @@ -119,20 +127,20 @@ begin simp only [adjoint_inner_right, continuous_linear_map.coe_comp', function.comp_app], end -lemma apply_norm_sq_eq_inner_adjoint_left (A : E →L[𝕜] E) (x : E) : ∥A x∥^2 = re ⟪(A† * A) x, x⟫ := +lemma apply_norm_sq_eq_inner_adjoint_left (A : E →L[𝕜] E) (x : E) : ‖A x‖^2 = re ⟪(A† * A) x, x⟫ := have h : ⟪(A† * A) x, x⟫ = ⟪A x, A x⟫ := by { rw [←adjoint_inner_left], refl }, by rw [h, ←inner_self_eq_norm_sq _] lemma apply_norm_eq_sqrt_inner_adjoint_left (A : E →L[𝕜] E) (x : E) : - ∥A x∥ = real.sqrt (re ⟪(A† * A) x, x⟫) := + ‖A x‖ = real.sqrt (re ⟪(A† * A) x, x⟫) := by rw [←apply_norm_sq_eq_inner_adjoint_left, real.sqrt_sq (norm_nonneg _)] -lemma apply_norm_sq_eq_inner_adjoint_right (A : E →L[𝕜] E) (x : E) : ∥A x∥^2 = re ⟪x, (A† * A) x⟫ := +lemma apply_norm_sq_eq_inner_adjoint_right (A : E →L[𝕜] E) (x : E) : ‖A x‖^2 = re ⟪x, (A† * A) x⟫ := have h : ⟪x, (A† * A) x⟫ = ⟪A x, A x⟫ := by { rw [←adjoint_inner_right], refl }, by rw [h, ←inner_self_eq_norm_sq _] lemma apply_norm_eq_sqrt_inner_adjoint_right (A : E →L[𝕜] E) (x : E) : - ∥A x∥ = real.sqrt (re ⟪x, (A† * A) x⟫) := + ‖A x‖ = real.sqrt (re ⟪x, (A† * A) x⟫) := by rw [←apply_norm_sq_eq_inner_adjoint_right, real.sqrt_sq (norm_nonneg _)] /-- The adjoint is unique: a map `A` is the adjoint of `B` iff it satisfies `⟪A x, y⟫ = ⟪x, B y⟫` @@ -145,6 +153,30 @@ begin exact ext_inner_right 𝕜 (λ y, by simp only [adjoint_inner_left, h x y]) end +@[simp] lemma adjoint_id : (continuous_linear_map.id 𝕜 E).adjoint = continuous_linear_map.id 𝕜 E := +begin + refine eq.symm _, + rw eq_adjoint_iff, + simp, +end + +lemma _root_.submodule.adjoint_subtypeL (U : submodule 𝕜 E) + [complete_space U] : + (U.subtypeL)† = orthogonal_projection U := +begin + symmetry, + rw eq_adjoint_iff, + intros x u, + rw [U.coe_inner, inner_orthogonal_projection_left_eq_right, + orthogonal_projection_mem_subspace_eq_self], + refl +end + +lemma _root_.submodule.adjoint_orthogonal_projection (U : submodule 𝕜 E) + [complete_space U] : + (orthogonal_projection U : E →L[𝕜] U)† = U.subtypeL := +by rw [← U.adjoint_subtypeL, adjoint_adjoint] + /-- `E →L[𝕜] E` is a star algebra with the adjoint as the star operation. -/ instance : has_star (E →L[𝕜] E) := ⟨adjoint⟩ instance : has_involutive_star (E →L[𝕜] E) := ⟨adjoint_adjoint⟩ @@ -154,28 +186,33 @@ instance : star_module 𝕜 (E →L[𝕜] E) := ⟨linear_isometry_equiv.map_smu lemma star_eq_adjoint (A : E →L[𝕜] E) : star A = A† := rfl +/-- A continuous linear operator is self-adjoint iff it is equal to its adjoint. -/ +lemma is_self_adjoint_iff' {A : E →L[𝕜] E} : is_self_adjoint A ↔ A.adjoint = A := iff.rfl + instance : cstar_ring (E →L[𝕜] E) := ⟨begin intros A, rw [star_eq_adjoint], refine le_antisymm _ _, - { calc ∥A† * A∥ ≤ ∥A†∥ * ∥A∥ : op_norm_comp_le _ _ - ... = ∥A∥ * ∥A∥ : by rw [linear_isometry_equiv.norm_map] }, + { calc ‖A† * A‖ ≤ ‖A†‖ * ‖A‖ : op_norm_comp_le _ _ + ... = ‖A‖ * ‖A‖ : by rw [linear_isometry_equiv.norm_map] }, { rw [←sq, ←real.sqrt_le_sqrt_iff (norm_nonneg _), real.sqrt_sq (norm_nonneg _)], refine op_norm_le_bound _ (real.sqrt_nonneg _) (λ x, _), have := calc - re ⟪(A† * A) x, x⟫ ≤ ∥(A† * A) x∥ * ∥x∥ : re_inner_le_norm _ _ - ... ≤ ∥A† * A∥ * ∥x∥ * ∥x∥ : mul_le_mul_of_nonneg_right + re ⟪(A† * A) x, x⟫ ≤ ‖(A† * A) x‖ * ‖x‖ : re_inner_le_norm _ _ + ... ≤ ‖A† * A‖ * ‖x‖ * ‖x‖ : mul_le_mul_of_nonneg_right (le_op_norm _ _) (norm_nonneg _), - calc ∥A x∥ = real.sqrt (re ⟪(A† * A) x, x⟫) : by rw [apply_norm_eq_sqrt_inner_adjoint_left] - ... ≤ real.sqrt (∥A† * A∥ * ∥x∥ * ∥x∥) : real.sqrt_le_sqrt this - ... = real.sqrt (∥A† * A∥) * ∥x∥ + calc ‖A x‖ = real.sqrt (re ⟪(A† * A) x, x⟫) : by rw [apply_norm_eq_sqrt_inner_adjoint_left] + ... ≤ real.sqrt (‖A† * A‖ * ‖x‖ * ‖x‖) : real.sqrt_le_sqrt this + ... = real.sqrt (‖A† * A‖) * ‖x‖ : by rw [mul_assoc, real.sqrt_mul (norm_nonneg _), real.sqrt_mul_self (norm_nonneg _)] } end⟩ section real -variables {E' : Type*} {F' : Type*} [inner_product_space ℝ E'] [inner_product_space ℝ F'] +variables {E' : Type*} {F' : Type*} +variables [normed_add_comm_group E'] [normed_add_comm_group F'] +variables [inner_product_space ℝ E'] [inner_product_space ℝ F'] variables [complete_space E'] [complete_space F'] -- Todo: Generalize this to `is_R_or_C`. @@ -189,6 +226,84 @@ end real end continuous_linear_map +/-! ### Self-adjoint operators -/ + +namespace is_self_adjoint + +open continuous_linear_map + +variables [complete_space E] [complete_space F] + +lemma adjoint_eq {A : E →L[𝕜] E} (hA : is_self_adjoint A) : A.adjoint = A := hA + +/-- Every self-adjoint operator on an inner product space is symmetric. -/ +lemma is_symmetric {A : E →L[𝕜] E} (hA : is_self_adjoint A) : + (A : E →ₗ[𝕜] E).is_symmetric := +λ x y, by rw_mod_cast [←A.adjoint_inner_right, hA.adjoint_eq] + +/-- Conjugating preserves self-adjointness -/ +lemma conj_adjoint {T : E →L[𝕜] E} (hT : is_self_adjoint T) (S : E →L[𝕜] F) : + is_self_adjoint (S ∘L T ∘L S.adjoint) := +begin + rw is_self_adjoint_iff' at ⊢ hT, + simp only [hT, adjoint_comp, adjoint_adjoint], + exact continuous_linear_map.comp_assoc _ _ _, +end + +/-- Conjugating preserves self-adjointness -/ +lemma adjoint_conj {T : E →L[𝕜] E} (hT : is_self_adjoint T) (S : F →L[𝕜] E) : + is_self_adjoint (S.adjoint ∘L T ∘L S) := +begin + rw is_self_adjoint_iff' at ⊢ hT, + simp only [hT, adjoint_comp, adjoint_adjoint], + exact continuous_linear_map.comp_assoc _ _ _, +end + +lemma _root_.continuous_linear_map.is_self_adjoint_iff_is_symmetric {A : E →L[𝕜] E} : + is_self_adjoint A ↔ (A : E →ₗ[𝕜] E).is_symmetric := +⟨λ hA, hA.is_symmetric, λ hA, ext $ λ x, ext_inner_right 𝕜 $ + λ y, (A.adjoint_inner_left y x).symm ▸ (hA x y).symm⟩ + +lemma _root_.linear_map.is_symmetric.is_self_adjoint {A : E →L[𝕜] E} + (hA : (A : E →ₗ[𝕜] E).is_symmetric) : is_self_adjoint A := +by rwa ←continuous_linear_map.is_self_adjoint_iff_is_symmetric at hA + +/-- The orthogonal projection is self-adjoint. -/ +lemma _root_.orthogonal_projection_is_self_adjoint (U : submodule 𝕜 E) + [complete_space U] : + is_self_adjoint (U.subtypeL ∘L orthogonal_projection U) := +(orthogonal_projection_is_symmetric U).is_self_adjoint + +lemma conj_orthogonal_projection {T : E →L[𝕜] E} + (hT : is_self_adjoint T) (U : submodule 𝕜 E) [complete_space U] : + is_self_adjoint (U.subtypeL ∘L orthogonal_projection U ∘L T ∘L U.subtypeL ∘L + orthogonal_projection U) := +begin + rw ←continuous_linear_map.comp_assoc, + nth_rewrite 0 ←(orthogonal_projection_is_self_adjoint U).adjoint_eq, + refine hT.adjoint_conj _, +end + +end is_self_adjoint + +namespace linear_map + +variables [complete_space E] +variables {T : E →ₗ[𝕜] E} + +/-- The **Hellinger--Toeplitz theorem**: Construct a self-adjoint operator from an everywhere + defined symmetric operator.-/ +def is_symmetric.to_self_adjoint (hT : is_symmetric T) : self_adjoint (E →L[𝕜] E) := +⟨⟨T, hT.continuous⟩, continuous_linear_map.is_self_adjoint_iff_is_symmetric.mpr hT⟩ + +lemma is_symmetric.coe_to_self_adjoint (hT : is_symmetric T) : + (hT.to_self_adjoint : E →ₗ[𝕜] E) = T := rfl + +lemma is_symmetric.to_self_adjoint_apply (hT : is_symmetric T) {x : E} : + hT.to_self_adjoint x = T x := rfl + +end linear_map + namespace linear_map variables [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] [finite_dimensional 𝕜 G] @@ -197,8 +312,9 @@ local attribute [instance, priority 20] finite_dimensional.complete /-- The adjoint of an operator from the finite-dimensional inner product space E to the finite- dimensional inner product space F. -/ def adjoint : (E →ₗ[𝕜] F) ≃ₗ⋆[𝕜] (F →ₗ[𝕜] E) := - (linear_map.to_continuous_linear_map.trans continuous_linear_map.adjoint.to_linear_equiv).trans - linear_map.to_continuous_linear_map.symm +((linear_map.to_continuous_linear_map : (E →ₗ[𝕜] F) ≃ₗ[𝕜] (E →L[𝕜] F)).trans + continuous_linear_map.adjoint.to_linear_equiv).trans + linear_map.to_continuous_linear_map.symm lemma adjoint_to_continuous_linear_map (A : E →ₗ[𝕜] F) : A.adjoint.to_continuous_linear_map = A.to_continuous_linear_map.adjoint := rfl @@ -274,10 +390,6 @@ begin refine ext_inner_right_basis b (λ i, by simp only [h i, adjoint_inner_left]), end -lemma is_self_adjoint_iff_eq_adjoint (A : E →ₗ[𝕜] E) : - is_self_adjoint A ↔ A = A.adjoint := -by rw [is_self_adjoint, ← linear_map.eq_adjoint_iff] - /-- `E →ₗ[𝕜] E` is a star algebra with the adjoint as the star operation. -/ instance : has_star (E →ₗ[𝕜] E) := ⟨adjoint⟩ instance : has_involutive_star (E →ₗ[𝕜] E) := ⟨adjoint_adjoint⟩ @@ -287,9 +399,18 @@ instance : star_module 𝕜 (E →ₗ[𝕜] E) := ⟨linear_equiv.map_smulₛₗ lemma star_eq_adjoint (A : E →ₗ[𝕜] E) : star A = A.adjoint := rfl +/-- A continuous linear operator is self-adjoint iff it is equal to its adjoint. -/ +lemma is_self_adjoint_iff' {A : E →ₗ[𝕜] E} : is_self_adjoint A ↔ A.adjoint = A := iff.rfl + +lemma is_symmetric_iff_is_self_adjoint (A : E →ₗ[𝕜] E) : + is_symmetric A ↔ is_self_adjoint A := +by { rw [is_self_adjoint_iff', is_symmetric, ← linear_map.eq_adjoint_iff], exact eq_comm } + section real -variables {E' : Type*} {F' : Type*} [inner_product_space ℝ E'] [inner_product_space ℝ F'] +variables {E' : Type*} {F' : Type*} +variables [normed_add_comm_group E'] [normed_add_comm_group F'] +variables [inner_product_space ℝ E'] [inner_product_space ℝ F'] variables [finite_dimensional ℝ E'] [finite_dimensional ℝ F'] -- Todo: Generalize this to `is_R_or_C`. @@ -300,19 +421,18 @@ lemma is_adjoint_pair_inner (A : E' →ₗ[ℝ] F') : end real -/-- The Gram operator T†T is self-adjoint. -/ -lemma is_self_adjoint_adjoint_mul_self (T : E →ₗ[𝕜] E) : is_self_adjoint (T.adjoint * T) := -λ x y, by simp only [linear_map.mul_apply, linear_map.adjoint_inner_left, - linear_map.adjoint_inner_right] +/-- The Gram operator T†T is symmetric. -/ +lemma is_symmetric_adjoint_mul_self (T : E →ₗ[𝕜] E) : is_symmetric (T.adjoint * T) := +λ x y, by simp only [mul_apply, adjoint_inner_left, adjoint_inner_right] /-- The Gram operator T†T is a positive operator. -/ lemma re_inner_adjoint_mul_self_nonneg (T : E →ₗ[𝕜] E) (x : E) : - 0 ≤ is_R_or_C.re ⟪ x, (T.adjoint * T) x ⟫ := by {simp only [linear_map.mul_apply, - linear_map.adjoint_inner_right, inner_self_eq_norm_sq_to_K], norm_cast, exact sq_nonneg _} + 0 ≤ re ⟪ x, (T.adjoint * T) x ⟫ := by {simp only [mul_apply, adjoint_inner_right, + inner_self_eq_norm_sq_to_K], norm_cast, exact sq_nonneg _} @[simp] lemma im_inner_adjoint_mul_self_eq_zero (T : E →ₗ[𝕜] E) (x : E) : - is_R_or_C.im ⟪ x, linear_map.adjoint T (T x) ⟫ = 0 := by {simp only [linear_map.mul_apply, - linear_map.adjoint_inner_right, inner_self_eq_norm_sq_to_K], norm_cast} + im ⟪ x, linear_map.adjoint T (T x) ⟫ = 0 := by {simp only [mul_apply, + adjoint_inner_right, inner_self_eq_norm_sq_to_K], norm_cast} end linear_map @@ -322,14 +442,13 @@ open_locale complex_conjugate /-- The adjoint of the linear map associated to a matrix is the linear map associated to the conjugate transpose of that matrix. -/ -lemma conj_transpose_eq_adjoint (A : matrix m n 𝕜) : - to_lin' A.conj_transpose = - @linear_map.adjoint _ (euclidean_space 𝕜 n) (euclidean_space 𝕜 m) _ _ _ _ _ (to_lin' A) := +lemma to_euclidean_lin_conj_transpose_eq_adjoint (A : matrix m n 𝕜) : + A.conj_transpose.to_euclidean_lin = A.to_euclidean_lin.adjoint := begin - rw @linear_map.eq_adjoint_iff _ (euclidean_space 𝕜 m) (euclidean_space 𝕜 n), + rw linear_map.eq_adjoint_iff, intros x y, - convert dot_product_assoc (conj ∘ (id x : m → 𝕜)) y A using 1, - simp [dot_product, mul_vec, ring_hom.map_sum, ← star_ring_end_apply, mul_comm], + simp_rw [euclidean_space.inner_eq_star_dot_product, pi_Lp_equiv_to_euclidean_lin, + to_lin'_apply, star_mul_vec, conj_transpose_conj_transpose, dot_product_mul_vec], end end matrix diff --git a/src/analysis/inner_product_space/basic.lean b/src/analysis/inner_product_space/basic.lean index 7414b5e7a66f7..173e0f0282104 100644 --- a/src/analysis/inner_product_space/basic.lean +++ b/src/analysis/inner_product_space/basic.lean @@ -5,17 +5,20 @@ Authors: Zhouhang Zhou, Sébastien Gouëzel, Frédéric Dupuis -/ import algebra.direct_sum.module import analysis.complex.basic +import analysis.convex.uniform +import analysis.normed_space.completion import analysis.normed_space.bounded_linear_maps -import analysis.convex.strict_convex_space import linear_algebra.bilinear_form -import linear_algebra.sesquilinear_form /-! # Inner product space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines inner product spaces and proves the basic properties. We do not formally -define Hilbert spaces, but they can be obtained using the pair of assumptions -`[inner_product_space 𝕜 E] [complete_space E]`. +define Hilbert spaces, but they can be obtained using the set of assumptions +`[normed_add_comm_group E] [inner_product_space 𝕜 E] [complete_space E]`. An inner product space is a vector space endowed with an inner product. It generalizes the notion of dot product in `ℝ^n` and provides the means of defining the length of a vector and the angle between @@ -39,9 +42,6 @@ product structure on `n → 𝕜` for `𝕜 = ℝ` or `ℂ`, see `euclidean_spac the sum of the norm-squares of the inner products `⟪v i, x⟫` is no more than the norm-square of `x`. For the existence of orthonormal bases, Hilbert bases, etc., see the file `analysis.inner_product_space.projection`. -- The `orthogonal_complement` of a submodule `K` is defined, and basic API established. Some of - the more subtle results about the orthogonal complement are delayed to - `analysis.inner_product_space.projection`. ## Notation @@ -49,8 +49,6 @@ We globally denote the real and complex inner products by `⟪·, ·⟫_ℝ` and We also provide two notation namespaces: `real_inner_product_space`, `complex_inner_product_space`, which respectively introduce the plain notation `⟪·, ·⟫` for the real and complex inner product. -The orthogonal complement of a submodule `K` is denoted by `Kᗮ`. - ## Implementation notes We choose the convention that inner products are conjugate linear in the first argument and linear @@ -70,7 +68,7 @@ The Coq code is available at the following address: 0, - { refine lt_of_le_of_ne inner_self_nonneg _, - intro H, - apply hy', - rw ext_iff, - exact ⟨by simp only [H, zero_re'], - by simp only [inner_self_nonneg_im, add_monoid_hom.map_zero]⟩ }, - have h₆ : re ⟪y, y⟫ ≠ 0 := ne_of_gt h₅, - have hmain := calc - 0 ≤ re ⟪x - T • y, x - T • y⟫ - : inner_self_nonneg - ... = re ⟪x, x⟫ - re ⟪T • y, x⟫ - re ⟪x, T • y⟫ + re ⟪T • y, T • y⟫ - : by simp only [inner_sub_sub_self, inner_smul_left, inner_smul_right, h₁, h₂, - neg_mul, add_monoid_hom.map_add, mul_re, - conj_im, add_monoid_hom.map_sub, mul_neg, conj_re, neg_neg] - ... = re ⟪x, x⟫ - re (T† * ⟪y, x⟫) - re (T * ⟪x, y⟫) + re (T * T† * ⟪y, y⟫) - : by simp only [inner_smul_left, inner_smul_right, mul_assoc] - ... = re ⟪x, x⟫ - re (⟪x, y⟫ / ⟪y, y⟫ * ⟪y, x⟫) - : by field_simp [-mul_re, inner_conj_sym, hT, ring_hom.map_div, h₁, h₃] - ... = re ⟪x, x⟫ - re (⟪x, y⟫ * ⟪y, x⟫ / ⟪y, y⟫) - : by rw [div_mul_eq_mul_div_comm, ←mul_div_assoc] - ... = re ⟪x, x⟫ - re (⟪x, y⟫ * ⟪y, x⟫ / re ⟪y, y⟫) - : by conv_lhs { rw [h₄] } - ... = re ⟪x, x⟫ - re (⟪x, y⟫ * ⟪y, x⟫) / re ⟪y, y⟫ - : by rw [div_re_of_real] - ... = re ⟪x, x⟫ - abs (⟪x, y⟫ * ⟪y, x⟫) / re ⟪y, y⟫ - : by rw [inner_mul_conj_re_abs] - ... = re ⟪x, x⟫ - abs ⟪x, y⟫ * abs ⟪y, x⟫ / re ⟪y, y⟫ - : by rw is_R_or_C.abs_mul, - have hmain' : abs ⟪x, y⟫ * abs ⟪y, x⟫ / re ⟪y, y⟫ ≤ re ⟪x, x⟫ := by linarith, - have := (mul_le_mul_right h₅).mpr hmain', - rwa [div_mul_cancel (abs ⟪x, y⟫ * abs ⟪y, x⟫) h₆] at this } + rcases eq_or_ne x 0 with (rfl | hx), + { simp only [inner_zero_left, map_zero, zero_mul, norm_zero] }, + { have hx' : 0 < norm_sqF x := inner_self_nonneg.lt_of_ne' (mt norm_sq_eq_zero.1 hx), + rw [← sub_nonneg, ← mul_nonneg_iff_right_nonneg_of_pos hx', ← norm_sq, ← norm_sq, + norm_inner_symm y, ← sq, ← cauchy_schwarz_aux], + exact inner_self_nonneg } end /-- Norm constructed from a `inner_product_space.core` structure, defined to be the square root @@ -297,157 +286,143 @@ def to_has_norm : has_norm F := local attribute [instance] to_has_norm -lemma norm_eq_sqrt_inner (x : F) : ∥x∥ = sqrt (re ⟪x, x⟫) := rfl +lemma norm_eq_sqrt_inner (x : F) : ‖x‖ = sqrt (re ⟪x, x⟫) := rfl -lemma inner_self_eq_norm_mul_norm (x : F) : re ⟪x, x⟫ = ∥x∥ * ∥x∥ := +lemma inner_self_eq_norm_mul_norm (x : F) : re ⟪x, x⟫ = ‖x‖ * ‖x‖ := by rw [norm_eq_sqrt_inner, ←sqrt_mul inner_self_nonneg (re ⟪x, x⟫), sqrt_mul_self inner_self_nonneg] -lemma sqrt_norm_sq_eq_norm {x : F} : sqrt (norm_sqF x) = ∥x∥ := rfl +lemma sqrt_norm_sq_eq_norm (x : F) : sqrt (norm_sqF x) = ‖x‖ := rfl /-- Cauchy–Schwarz inequality with norm -/ -lemma abs_inner_le_norm (x y : F) : abs ⟪x, y⟫ ≤ ∥x∥ * ∥y∥ := -nonneg_le_nonneg_of_sq_le_sq (mul_nonneg (sqrt_nonneg _) (sqrt_nonneg _)) -begin - have H : ∥x∥ * ∥y∥ * (∥x∥ * ∥y∥) = re ⟪y, y⟫ * re ⟪x, x⟫, - { simp only [inner_self_eq_norm_mul_norm], ring, }, - rw H, - conv - begin - to_lhs, congr, rw [inner_abs_conj_sym], - end, - exact inner_mul_inner_self_le y x, -end +lemma norm_inner_le_norm (x y : F) : ‖⟪x, y⟫‖ ≤ ‖x‖ * ‖y‖ := +nonneg_le_nonneg_of_sq_le_sq (mul_nonneg (sqrt_nonneg _) (sqrt_nonneg _)) $ + calc ‖⟪x, y⟫‖ * ‖⟪x, y⟫‖ = ‖⟪x, y⟫‖ * ‖⟪y, x⟫‖ : by rw [norm_inner_symm] + ... ≤ re ⟪x, x⟫ * re ⟪y, y⟫ : inner_mul_inner_self_le x y + ... = ‖x‖ * ‖y‖ * (‖x‖ * ‖y‖) : by simp only [inner_self_eq_norm_mul_norm]; ring /-- Normed group structure constructed from an `inner_product_space.core` structure -/ -def to_normed_group : normed_group F := -normed_group.of_core F -{ norm_eq_zero_iff := assume x, - begin - split, - { intro H, - change sqrt (re ⟪x, x⟫) = 0 at H, - rw [sqrt_eq_zero inner_self_nonneg] at H, - apply (inner_self_eq_zero : ⟪x, x⟫ = 0 ↔ x = 0).mp, - rw ext_iff, - exact ⟨by simp [H], by simp [inner_self_im_zero]⟩ }, - { rintro rfl, - change sqrt (re ⟪0, 0⟫) = 0, - simp only [sqrt_zero, inner_zero_right, add_monoid_hom.map_zero] } - end, - triangle := assume x y, - begin - have h₁ : abs ⟪x, y⟫ ≤ ∥x∥ * ∥y∥ := abs_inner_le_norm _ _, - have h₂ : re ⟪x, y⟫ ≤ abs ⟪x, y⟫ := re_le_abs _, - have h₃ : re ⟪x, y⟫ ≤ ∥x∥ * ∥y∥ := by linarith, - have h₄ : re ⟪y, x⟫ ≤ ∥x∥ * ∥y∥ := by rwa [←inner_conj_sym, conj_re], - have : ∥x + y∥ * ∥x + y∥ ≤ (∥x∥ + ∥y∥) * (∥x∥ + ∥y∥), - { simp [←inner_self_eq_norm_mul_norm, inner_add_add_self, add_mul, mul_add, mul_comm], +def to_normed_add_comm_group : normed_add_comm_group F := +add_group_norm.to_normed_add_comm_group +{ to_fun := λ x, sqrt (re ⟪x, x⟫), + map_zero' := by simp only [sqrt_zero, inner_zero_right, map_zero], + neg' := λ x, by simp only [inner_neg_left, neg_neg, inner_neg_right], + add_le' := λ x y, begin + have h₁ : ‖⟪x, y⟫‖ ≤ ‖x‖ * ‖y‖ := norm_inner_le_norm _ _, + have h₂ : re ⟪x, y⟫ ≤ ‖⟪x, y⟫‖ := re_le_norm _, + have h₃ : re ⟪x, y⟫ ≤ ‖x‖ * ‖y‖ := h₂.trans h₁, + have h₄ : re ⟪y, x⟫ ≤ ‖x‖ * ‖y‖ := by rwa [←inner_conj_symm, conj_re], + have : ‖x + y‖ * ‖x + y‖ ≤ (‖x‖ + ‖y‖) * (‖x‖ + ‖y‖), + { simp only [←inner_self_eq_norm_mul_norm, inner_add_add_self, mul_add, mul_comm, map_add], linarith }, - exact nonneg_le_nonneg_of_sq_le_sq (add_nonneg (sqrt_nonneg _) (sqrt_nonneg _)) this + exact nonneg_le_nonneg_of_sq_le_sq (add_nonneg (sqrt_nonneg _) (sqrt_nonneg _)) this, end, - norm_neg := λ x, by simp only [norm, inner_neg_left, neg_neg, inner_neg_right] } + eq_zero_of_map_eq_zero' := λ x hx, norm_sq_eq_zero.1 $ (sqrt_eq_zero inner_self_nonneg).1 hx } -local attribute [instance] to_normed_group +local attribute [instance] to_normed_add_comm_group /-- Normed space structure constructed from a `inner_product_space.core` structure -/ def to_normed_space : normed_space 𝕜 F := { norm_smul_le := assume r x, begin rw [norm_eq_sqrt_inner, inner_smul_left, inner_smul_right, ←mul_assoc], - rw [conj_mul_eq_norm_sq_left, of_real_mul_re, sqrt_mul, ←inner_norm_sq_eq_inner_self, - of_real_re], + rw [is_R_or_C.conj_mul, of_real_mul_re, sqrt_mul, ← coe_norm_sq_eq_inner_self, of_real_re], { simp [sqrt_norm_sq_eq_norm, is_R_or_C.sqrt_norm_sq_eq_norm] }, { exact norm_sq_nonneg r } end } -end inner_product_space.of_core +end inner_product_space.core + +section +local attribute [instance] inner_product_space.core.to_normed_add_comm_group /-- Given a `inner_product_space.core` structure on a space, one can use it to turn -the space into an inner product space, constructing the norm out of the inner product -/ +the space into an inner product space. The `normed_add_comm_group` structure is expected +to already be defined with `inner_product_space.of_core.to_normed_add_comm_group`. -/ def inner_product_space.of_core [add_comm_group F] [module 𝕜 F] (c : inner_product_space.core 𝕜 F) : inner_product_space 𝕜 F := begin - letI : normed_group F := @inner_product_space.of_core.to_normed_group 𝕜 F _ _ _ c, - letI : normed_space 𝕜 F := @inner_product_space.of_core.to_normed_space 𝕜 F _ _ _ c, + letI : normed_space 𝕜 F := @inner_product_space.core.to_normed_space 𝕜 F _ _ _ c, exact { norm_sq_eq_inner := λ x, begin - have h₁ : ∥x∥^2 = (sqrt (re (c.inner x x))) ^ 2 := rfl, - have h₂ : 0 ≤ re (c.inner x x) := inner_product_space.of_core.inner_self_nonneg, + have h₁ : ‖x‖^2 = (sqrt (re (c.inner x x))) ^ 2 := rfl, + have h₂ : 0 ≤ re (c.inner x x) := inner_product_space.core.inner_self_nonneg, simp [h₁, sq_sqrt, h₂], end, ..c } end +end + /-! ### Properties of inner product spaces -/ -variables [inner_product_space 𝕜 E] [inner_product_space ℝ F] +variables [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables [normed_add_comm_group F] [inner_product_space ℝ F] variables [dec_E : decidable_eq E] local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y local notation `IK` := @is_R_or_C.I 𝕜 _ -local notation `absR` := has_abs.abs -local notation `absK` := @is_R_or_C.abs 𝕜 _ local postfix `†`:90 := star_ring_end _ export inner_product_space (norm_sq_eq_inner) section basic_properties -@[simp] lemma inner_conj_sym (x y : E) : ⟪y, x⟫† = ⟪x, y⟫ := inner_product_space.conj_sym _ _ -lemma real_inner_comm (x y : F) : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := @inner_conj_sym ℝ _ _ _ x y +@[simp] lemma inner_conj_symm (x y : E) : ⟪y, x⟫† = ⟪x, y⟫ := inner_product_space.conj_symm _ _ +lemma real_inner_comm (x y : F) : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := @inner_conj_symm ℝ _ _ _ _ x y -lemma inner_eq_zero_sym {x y : E} : ⟪x, y⟫ = 0 ↔ ⟪y, x⟫ = 0 := -⟨λ h, by simp [←inner_conj_sym, h], λ h, by simp [←inner_conj_sym, h]⟩ +lemma inner_eq_zero_symm {x y : E} : ⟪x, y⟫ = 0 ↔ ⟪y, x⟫ = 0 := +by { rw [← inner_conj_symm], exact star_eq_zero } -@[simp] lemma inner_self_nonneg_im {x : E} : im ⟪x, x⟫ = 0 := +@[simp] lemma inner_self_im (x : E) : im ⟪x, x⟫ = 0 := by rw [← @of_real_inj 𝕜, im_eq_conj_sub]; simp -lemma inner_self_im_zero {x : E} : im ⟪x, x⟫ = 0 := inner_self_nonneg_im - -lemma inner_add_left {x y z : E} : ⟪x + y, z⟫ = ⟪x, z⟫ + ⟪y, z⟫ := +lemma inner_add_left (x y z : E) : ⟪x + y, z⟫ = ⟪x, z⟫ + ⟪y, z⟫ := inner_product_space.add_left _ _ _ -lemma inner_add_right {x y z : E} : ⟪x, y + z⟫ = ⟪x, y⟫ + ⟪x, z⟫ := -by { rw [←inner_conj_sym, inner_add_left, ring_hom.map_add], simp only [inner_conj_sym] } +lemma inner_add_right (x y z : E) : ⟪x, y + z⟫ = ⟪x, y⟫ + ⟪x, z⟫ := +by { rw [←inner_conj_symm, inner_add_left, ring_hom.map_add], simp only [inner_conj_symm] } -lemma inner_re_symm {x y : E} : re ⟪x, y⟫ = re ⟪y, x⟫ := -by rw [←inner_conj_sym, conj_re] +lemma inner_re_symm (x y : E) : re ⟪x, y⟫ = re ⟪y, x⟫ := +by rw [←inner_conj_symm, conj_re] -lemma inner_im_symm {x y : E} : im ⟪x, y⟫ = -im ⟪y, x⟫ := -by rw [←inner_conj_sym, conj_im] +lemma inner_im_symm (x y : E) : im ⟪x, y⟫ = -im ⟪y, x⟫ := +by rw [←inner_conj_symm, conj_im] -lemma inner_smul_left {x y : E} {r : 𝕜} : ⟪r • x, y⟫ = r† * ⟪x, y⟫ := +lemma inner_smul_left (x y : E) (r : 𝕜) : ⟪r • x, y⟫ = r† * ⟪x, y⟫ := inner_product_space.smul_left _ _ _ -lemma real_inner_smul_left {x y : F} {r : ℝ} : ⟪r • x, y⟫_ℝ = r * ⟪x, y⟫_ℝ := inner_smul_left +lemma real_inner_smul_left (x y : F) (r : ℝ) : ⟪r • x, y⟫_ℝ = r * ⟪x, y⟫_ℝ := inner_smul_left _ _ _ -lemma inner_smul_real_left {x y : E} {r : ℝ} : ⟪(r : 𝕜) • x, y⟫ = r • ⟪x, y⟫ := +lemma inner_smul_real_left (x y : E) (r : ℝ) : ⟪(r : 𝕜) • x, y⟫ = r • ⟪x, y⟫ := by { rw [inner_smul_left, conj_of_real, algebra.smul_def], refl } -lemma inner_smul_right {x y : E} {r : 𝕜} : ⟪x, r • y⟫ = r * ⟪x, y⟫ := -by rw [←inner_conj_sym, inner_smul_left, ring_hom.map_mul, conj_conj, inner_conj_sym] -lemma real_inner_smul_right {x y : F} {r : ℝ} : ⟪x, r • y⟫_ℝ = r * ⟪x, y⟫_ℝ := inner_smul_right +lemma inner_smul_right (x y : E) (r : 𝕜) : ⟪x, r • y⟫ = r * ⟪x, y⟫ := +by rw [←inner_conj_symm, inner_smul_left, ring_hom.map_mul, conj_conj, inner_conj_symm] +lemma real_inner_smul_right (x y : F) (r : ℝ) : ⟪x, r • y⟫_ℝ = r * ⟪x, y⟫_ℝ := +inner_smul_right _ _ _ -lemma inner_smul_real_right {x y : E} {r : ℝ} : ⟪x, (r : 𝕜) • y⟫ = r • ⟪x, y⟫ := +lemma inner_smul_real_right (x y : E) (r : ℝ) : ⟪x, (r : 𝕜) • y⟫ = r • ⟪x, y⟫ := by { rw [inner_smul_right, algebra.smul_def], refl } -/-- The inner product as a sesquilinear form. -/ +/-- The inner product as a sesquilinear form. + +Note that in the case `𝕜 = ℝ` this is a bilinear form. -/ @[simps] def sesq_form_of_inner : E →ₗ[𝕜] E →ₗ⋆[𝕜] 𝕜 := linear_map.mk₂'ₛₗ (ring_hom.id 𝕜) (star_ring_end _) (λ x y, ⟪y, x⟫) - (λ x y z, inner_add_right) - (λ r x y, inner_smul_right) - (λ x y z, inner_add_left) - (λ r x y, inner_smul_left) + (λ x y z, inner_add_right _ _ _) + (λ r x y, inner_smul_right _ _ _) + (λ x y z, inner_add_left _ _ _) + (λ r x y, inner_smul_left _ _ _) /-- The real inner product as a bilinear form. -/ @[simps] def bilin_form_of_real_inner : bilin_form ℝ F := { bilin := inner, - bilin_add_left := λ x y z, inner_add_left, - bilin_smul_left := λ a x y, inner_smul_left, - bilin_add_right := λ x y z, inner_add_right, - bilin_smul_right := λ a x y, inner_smul_right } + bilin_add_left := inner_add_left, + bilin_smul_left := λ a x y, inner_smul_left _ _ _, + bilin_add_right := inner_add_right, + bilin_smul_right := λ a x y, inner_smul_right _ _ _ } /-- An inner product with a sum on the left. -/ lemma sum_inner {ι : Type*} (s : finset ι) (f : ι → E) (x : E) : @@ -461,204 +436,151 @@ lemma inner_sum {ι : Type*} (s : finset ι) (f : ι → E) (x : E) : lemma finsupp.sum_inner {ι : Type*} (l : ι →₀ 𝕜) (v : ι → E) (x : E) : ⟪l.sum (λ (i : ι) (a : 𝕜), a • v i), x⟫ = l.sum (λ (i : ι) (a : 𝕜), (conj a) • ⟪v i, x⟫) := -by { convert sum_inner l.support (λ a, l a • v a) x, simp [inner_smul_left, finsupp.sum] } +by { convert sum_inner l.support (λ a, l a • v a) x, + simp only [inner_smul_left, finsupp.sum, smul_eq_mul] } /-- An inner product with a sum on the right, `finsupp` version. -/ lemma finsupp.inner_sum {ι : Type*} (l : ι →₀ 𝕜) (v : ι → E) (x : E) : ⟪x, l.sum (λ (i : ι) (a : 𝕜), a • v i)⟫ = l.sum (λ (i : ι) (a : 𝕜), a • ⟪x, v i⟫) := -by { convert inner_sum l.support (λ a, l a • v a) x, simp [inner_smul_right, finsupp.sum] } +by { convert inner_sum l.support (λ a, l a • v a) x, + simp only [inner_smul_right, finsupp.sum, smul_eq_mul] } lemma dfinsupp.sum_inner {ι : Type*} [dec : decidable_eq ι] {α : ι → Type*} [Π i, add_zero_class (α i)] [Π i (x : α i), decidable (x ≠ 0)] (f : Π i, α i → E) (l : Π₀ i, α i) (x : E) : ⟪l.sum f, x⟫ = l.sum (λ i a, ⟪f i a, x⟫) := -by simp [dfinsupp.sum, sum_inner] {contextual := tt} +by simp only [dfinsupp.sum, sum_inner, smul_eq_mul] {contextual := tt} lemma dfinsupp.inner_sum {ι : Type*} [dec : decidable_eq ι] {α : ι → Type*} [Π i, add_zero_class (α i)] [Π i (x : α i), decidable (x ≠ 0)] (f : Π i, α i → E) (l : Π₀ i, α i) (x : E) : ⟪x, l.sum f⟫ = l.sum (λ i a, ⟪x, f i a⟫) := -by simp [dfinsupp.sum, inner_sum] {contextual := tt} +by simp only [dfinsupp.sum, inner_sum, smul_eq_mul] {contextual := tt} -@[simp] lemma inner_zero_left {x : E} : ⟪0, x⟫ = 0 := +@[simp] lemma inner_zero_left (x : E) : ⟪0, x⟫ = 0 := by rw [← zero_smul 𝕜 (0:E), inner_smul_left, ring_hom.map_zero, zero_mul] -lemma inner_re_zero_left {x : E} : re ⟪0, x⟫ = 0 := +lemma inner_re_zero_left (x : E) : re ⟪0, x⟫ = 0 := by simp only [inner_zero_left, add_monoid_hom.map_zero] -@[simp] lemma inner_zero_right {x : E} : ⟪x, 0⟫ = 0 := -by rw [←inner_conj_sym, inner_zero_left, ring_hom.map_zero] +@[simp] lemma inner_zero_right (x : E) : ⟪x, 0⟫ = 0 := +by rw [←inner_conj_symm, inner_zero_left, ring_hom.map_zero] -lemma inner_re_zero_right {x : E} : re ⟪x, 0⟫ = 0 := +lemma inner_re_zero_right (x : E) : re ⟪x, 0⟫ = 0 := by simp only [inner_zero_right, add_monoid_hom.map_zero] lemma inner_self_nonneg {x : E} : 0 ≤ re ⟪x, x⟫ := -by rw [←norm_sq_eq_inner]; exact pow_nonneg (norm_nonneg x) 2 -lemma real_inner_self_nonneg {x : F} : 0 ≤ ⟪x, x⟫_ℝ := @inner_self_nonneg ℝ F _ _ x +inner_product_space.to_core.nonneg_re x -@[simp] lemma inner_self_eq_zero {x : E} : ⟪x, x⟫ = 0 ↔ x = 0 := -begin - split, - { intro h, - have h₁ : re ⟪x, x⟫ = 0 := by rw is_R_or_C.ext_iff at h; simp [h.1], - rw [←norm_sq_eq_inner x] at h₁, - rw [←norm_eq_zero], - exact pow_eq_zero h₁ }, - { rintro rfl, - exact inner_zero_left } -end +lemma real_inner_self_nonneg {x : F} : 0 ≤ ⟪x, x⟫_ℝ := @inner_self_nonneg ℝ F _ _ _ x -@[simp] lemma inner_self_nonpos {x : E} : re ⟪x, x⟫ ≤ 0 ↔ x = 0 := -begin - split, - { intro h, - rw ←inner_self_eq_zero, - have H₁ : re ⟪x, x⟫ ≥ 0, exact inner_self_nonneg, - have H₂ : re ⟪x, x⟫ = 0, exact le_antisymm h H₁, - rw is_R_or_C.ext_iff, - exact ⟨by simp [H₂], by simp [inner_self_nonneg_im]⟩ }, - { rintro rfl, - simp only [inner_zero_left, add_monoid_hom.map_zero] } -end +@[simp] lemma inner_self_re_to_K (x : E) : (re ⟪x, x⟫ : 𝕜) = ⟪x, x⟫ := +((is_R_or_C.is_real_tfae (⟪x, x⟫ : 𝕜)).out 2 3).2 (inner_self_im _) -lemma real_inner_self_nonpos {x : F} : ⟪x, x⟫_ℝ ≤ 0 ↔ x = 0 := -by { have h := @inner_self_nonpos ℝ F _ _ x, simpa using h } - -@[simp] lemma inner_self_re_to_K {x : E} : (re ⟪x, x⟫ : 𝕜) = ⟪x, x⟫ := -by rw is_R_or_C.ext_iff; exact ⟨by simp, by simp [inner_self_nonneg_im]⟩ +lemma inner_self_eq_norm_sq_to_K (x : E) : ⟪x, x⟫ = (‖x‖ ^ 2 : 𝕜) := +by rw [← inner_self_re_to_K, ← norm_sq_eq_inner, of_real_pow] -lemma inner_self_eq_norm_sq_to_K (x : E) : ⟪x, x⟫ = (∥x∥ ^ 2 : 𝕜) := -begin - suffices : (is_R_or_C.re ⟪x, x⟫ : 𝕜) = ∥x∥ ^ 2, - { simpa [inner_self_re_to_K] using this }, - exact_mod_cast (norm_sq_eq_inner x).symm -end - -lemma inner_self_re_abs {x : E} : re ⟪x, x⟫ = abs ⟪x, x⟫ := +lemma inner_self_re_eq_norm (x : E) : re ⟪x, x⟫ = ‖⟪x, x⟫‖ := begin conv_rhs { rw [←inner_self_re_to_K] }, symmetry, - exact is_R_or_C.abs_of_nonneg inner_self_nonneg, + exact norm_of_nonneg inner_self_nonneg, end -lemma inner_self_abs_to_K {x : E} : (absK ⟪x, x⟫ : 𝕜) = ⟪x, x⟫ := -by { rw [←inner_self_re_abs], exact inner_self_re_to_K } +lemma inner_self_norm_to_K (x : E) : (‖⟪x, x⟫‖ : 𝕜) = ⟪x, x⟫ := +by { rw [←inner_self_re_eq_norm], exact inner_self_re_to_K _ } + +lemma real_inner_self_abs (x : F) : |⟪x, x⟫_ℝ| = ⟪x, x⟫_ℝ := +@inner_self_norm_to_K ℝ F _ _ _ x + +@[simp] lemma inner_self_eq_zero {x : E} : ⟪x, x⟫ = 0 ↔ x = 0 := +by rw [inner_self_eq_norm_sq_to_K, sq_eq_zero_iff, of_real_eq_zero, norm_eq_zero] + +lemma inner_self_ne_zero {x : E} : ⟪x, x⟫ ≠ 0 ↔ x ≠ 0 := +inner_self_eq_zero.not -lemma real_inner_self_abs {x : F} : absR ⟪x, x⟫_ℝ = ⟪x, x⟫_ℝ := -by { have h := @inner_self_abs_to_K ℝ F _ _ x, simpa using h } +@[simp] lemma inner_self_nonpos {x : E} : re ⟪x, x⟫ ≤ 0 ↔ x = 0 := +by rw [← norm_sq_eq_inner, (sq_nonneg _).le_iff_eq, sq_eq_zero_iff, norm_eq_zero] + +lemma real_inner_self_nonpos {x : F} : ⟪x, x⟫_ℝ ≤ 0 ↔ x = 0 := +@inner_self_nonpos ℝ F _ _ _ x -lemma inner_abs_conj_sym {x y : E} : abs ⟪x, y⟫ = abs ⟪y, x⟫ := -by rw [←inner_conj_sym, abs_conj] +lemma norm_inner_symm (x y : E) : ‖⟪x, y⟫‖ = ‖⟪y, x⟫‖ := +by rw [←inner_conj_symm, norm_conj] -@[simp] lemma inner_neg_left {x y : E} : ⟪-x, y⟫ = -⟪x, y⟫ := +@[simp] lemma inner_neg_left (x y : E) : ⟪-x, y⟫ = -⟪x, y⟫ := by { rw [← neg_one_smul 𝕜 x, inner_smul_left], simp } -@[simp] lemma inner_neg_right {x y : E} : ⟪x, -y⟫ = -⟪x, y⟫ := -by rw [←inner_conj_sym, inner_neg_left]; simp only [ring_hom.map_neg, inner_conj_sym] +@[simp] lemma inner_neg_right (x y : E) : ⟪x, -y⟫ = -⟪x, y⟫ := +by rw [←inner_conj_symm, inner_neg_left]; simp only [ring_hom.map_neg, inner_conj_symm] -lemma inner_neg_neg {x y : E} : ⟪-x, -y⟫ = ⟪x, y⟫ := by simp +lemma inner_neg_neg (x y : E) : ⟪-x, -y⟫ = ⟪x, y⟫ := by simp -@[simp] lemma inner_self_conj {x : E} : ⟪x, x⟫† = ⟪x, x⟫ := -by rw [is_R_or_C.ext_iff]; exact ⟨by rw [conj_re], by rw [conj_im, inner_self_im_zero, neg_zero]⟩ +@[simp] lemma inner_self_conj (x : E) : ⟪x, x⟫† = ⟪x, x⟫ := +by rw [is_R_or_C.ext_iff]; exact ⟨by rw [conj_re], by rw [conj_im, inner_self_im, neg_zero]⟩ -lemma inner_sub_left {x y z : E} : ⟪x - y, z⟫ = ⟪x, z⟫ - ⟪y, z⟫ := +lemma inner_sub_left (x y z : E) : ⟪x - y, z⟫ = ⟪x, z⟫ - ⟪y, z⟫ := by { simp [sub_eq_add_neg, inner_add_left] } -lemma inner_sub_right {x y z : E} : ⟪x, y - z⟫ = ⟪x, y⟫ - ⟪x, z⟫ := +lemma inner_sub_right (x y z : E) : ⟪x, y - z⟫ = ⟪x, y⟫ - ⟪x, z⟫ := by { simp [sub_eq_add_neg, inner_add_right] } -lemma inner_mul_conj_re_abs {x y : E} : re (⟪x, y⟫ * ⟪y, x⟫) = abs (⟪x, y⟫ * ⟪y, x⟫) := -by { rw [←inner_conj_sym, mul_comm], exact re_eq_abs_of_mul_conj (inner y x), } +lemma inner_mul_symm_re_eq_norm (x y : E) : re (⟪x, y⟫ * ⟪y, x⟫) = ‖⟪x, y⟫ * ⟪y, x⟫‖ := +by { rw [←inner_conj_symm, mul_comm], exact re_eq_norm_of_mul_conj (inner y x), } /-- Expand `⟪x + y, x + y⟫` -/ -lemma inner_add_add_self {x y : E} : ⟪x + y, x + y⟫ = ⟪x, x⟫ + ⟪x, y⟫ + ⟪y, x⟫ + ⟪y, y⟫ := +lemma inner_add_add_self (x y : E) : ⟪x + y, x + y⟫ = ⟪x, x⟫ + ⟪x, y⟫ + ⟪y, x⟫ + ⟪y, y⟫ := by simp only [inner_add_left, inner_add_right]; ring /-- Expand `⟪x + y, x + y⟫_ℝ` -/ -lemma real_inner_add_add_self {x y : F} : ⟪x + y, x + y⟫_ℝ = ⟪x, x⟫_ℝ + 2 * ⟪x, y⟫_ℝ + ⟪y, y⟫_ℝ := +lemma real_inner_add_add_self (x y : F) : ⟪x + y, x + y⟫_ℝ = ⟪x, x⟫_ℝ + 2 * ⟪x, y⟫_ℝ + ⟪y, y⟫_ℝ := begin - have : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := by rw [←inner_conj_sym]; refl, - simp [inner_add_add_self, this], + have : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := by rw [←inner_conj_symm]; refl, + simp only [inner_add_add_self, this, add_left_inj], ring, end /- Expand `⟪x - y, x - y⟫` -/ -lemma inner_sub_sub_self {x y : E} : ⟪x - y, x - y⟫ = ⟪x, x⟫ - ⟪x, y⟫ - ⟪y, x⟫ + ⟪y, y⟫ := +lemma inner_sub_sub_self (x y : E) : ⟪x - y, x - y⟫ = ⟪x, x⟫ - ⟪x, y⟫ - ⟪y, x⟫ + ⟪y, y⟫ := by simp only [inner_sub_left, inner_sub_right]; ring /-- Expand `⟪x - y, x - y⟫_ℝ` -/ -lemma real_inner_sub_sub_self {x y : F} : ⟪x - y, x - y⟫_ℝ = ⟪x, x⟫_ℝ - 2 * ⟪x, y⟫_ℝ + ⟪y, y⟫_ℝ := +lemma real_inner_sub_sub_self (x y : F) : ⟪x - y, x - y⟫_ℝ = ⟪x, x⟫_ℝ - 2 * ⟪x, y⟫_ℝ + ⟪y, y⟫_ℝ := begin - have : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := by rw [←inner_conj_sym]; refl, - simp [inner_sub_sub_self, this], + have : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := by rw [←inner_conj_symm]; refl, + simp only [inner_sub_sub_self, this, add_left_inj], ring, end +variable (𝕜) +include 𝕜 + +lemma ext_inner_left {x y : E} (h : ∀ v, ⟪v, x⟫ = ⟪v, y⟫) : x = y := +by rw [←sub_eq_zero, ←@inner_self_eq_zero 𝕜, inner_sub_right, sub_eq_zero, h (x - y)] + +lemma ext_inner_right {x y : E} (h : ∀ v, ⟪x, v⟫ = ⟪y, v⟫) : x = y := +by rw [←sub_eq_zero, ←@inner_self_eq_zero 𝕜, inner_sub_left, sub_eq_zero, h (x - y)] + +omit 𝕜 +variable {𝕜} + /-- Parallelogram law -/ lemma parallelogram_law {x y : E} : ⟪x + y, x + y⟫ + ⟪x - y, x - y⟫ = 2 * (⟪x, x⟫ + ⟪y, y⟫) := by simp [inner_add_add_self, inner_sub_sub_self, two_mul, sub_eq_add_neg, add_comm, add_left_comm] -/-- Cauchy–Schwarz inequality. This proof follows "Proof 2" on Wikipedia. -/ -lemma inner_mul_inner_self_le (x y : E) : abs ⟪x, y⟫ * abs ⟪y, x⟫ ≤ re ⟪x, x⟫ * re ⟪y, y⟫ := +/-- **Cauchy–Schwarz inequality**. -/ +lemma inner_mul_inner_self_le (x y : E) : ‖⟪x, y⟫‖ * ‖⟪y, x⟫‖ ≤ re ⟪x, x⟫ * re ⟪y, y⟫ := begin - by_cases hy : y = 0, - { rw [hy], simp only [is_R_or_C.abs_zero, inner_zero_left, mul_zero, add_monoid_hom.map_zero] }, - { change y ≠ 0 at hy, - have hy' : ⟪y, y⟫ ≠ 0 := λ h, by rw [inner_self_eq_zero] at h; exact hy h, - set T := ⟪y, x⟫ / ⟪y, y⟫ with hT, - have h₁ : re ⟪y, x⟫ = re ⟪x, y⟫ := inner_re_symm, - have h₂ : im ⟪y, x⟫ = -im ⟪x, y⟫ := inner_im_symm, - have h₃ : ⟪y, x⟫ * ⟪x, y⟫ * ⟪y, y⟫ / (⟪y, y⟫ * ⟪y, y⟫) = ⟪y, x⟫ * ⟪x, y⟫ / ⟪y, y⟫, - { rw [mul_div_assoc], - have : ⟪y, y⟫ / (⟪y, y⟫ * ⟪y, y⟫) = 1 / ⟪y, y⟫ := - by rw [div_mul_eq_div_mul_one_div, div_self hy', one_mul], - rw [this, div_eq_mul_inv, one_mul, ←div_eq_mul_inv] }, - have h₄ : ⟪y, y⟫ = re ⟪y, y⟫ := by simp, - have h₅ : re ⟪y, y⟫ > 0, - { refine lt_of_le_of_ne inner_self_nonneg _, - intro H, - apply hy', - rw is_R_or_C.ext_iff, - exact ⟨by simp only [H, zero_re'], - by simp only [inner_self_nonneg_im, add_monoid_hom.map_zero]⟩ }, - have h₆ : re ⟪y, y⟫ ≠ 0 := ne_of_gt h₅, - have hmain := calc - 0 ≤ re ⟪x - T • y, x - T • y⟫ - : inner_self_nonneg - ... = re ⟪x, x⟫ - re ⟪T • y, x⟫ - re ⟪x, T • y⟫ + re ⟪T • y, T • y⟫ - : by simp only [inner_sub_sub_self, inner_smul_left, inner_smul_right, h₁, h₂, - neg_mul, add_monoid_hom.map_add, conj_im, - add_monoid_hom.map_sub, mul_neg, conj_re, neg_neg, mul_re] - ... = re ⟪x, x⟫ - re (T† * ⟪y, x⟫) - re (T * ⟪x, y⟫) + re (T * T† * ⟪y, y⟫) - : by simp only [inner_smul_left, inner_smul_right, mul_assoc] - ... = re ⟪x, x⟫ - re (⟪x, y⟫ / ⟪y, y⟫ * ⟪y, x⟫) - : by field_simp [-mul_re, hT, ring_hom.map_div, h₁, h₃, inner_conj_sym] - ... = re ⟪x, x⟫ - re (⟪x, y⟫ * ⟪y, x⟫ / ⟪y, y⟫) - : by rw [div_mul_eq_mul_div_comm, ←mul_div_assoc] - ... = re ⟪x, x⟫ - re (⟪x, y⟫ * ⟪y, x⟫ / re ⟪y, y⟫) - : by conv_lhs { rw [h₄] } - ... = re ⟪x, x⟫ - re (⟪x, y⟫ * ⟪y, x⟫) / re ⟪y, y⟫ - : by rw [div_re_of_real] - ... = re ⟪x, x⟫ - abs (⟪x, y⟫ * ⟪y, x⟫) / re ⟪y, y⟫ - : by rw [inner_mul_conj_re_abs] - ... = re ⟪x, x⟫ - abs ⟪x, y⟫ * abs ⟪y, x⟫ / re ⟪y, y⟫ - : by rw is_R_or_C.abs_mul, - have hmain' : abs ⟪x, y⟫ * abs ⟪y, x⟫ / re ⟪y, y⟫ ≤ re ⟪x, x⟫ := by linarith, - have := (mul_le_mul_right h₅).mpr hmain', - rwa [div_mul_cancel (abs ⟪x, y⟫ * abs ⟪y, x⟫) h₆] at this } + letI c : inner_product_space.core 𝕜 E := inner_product_space.to_core, + exact inner_product_space.core.inner_mul_inner_self_le x y end /-- Cauchy–Schwarz inequality for real inner products. -/ lemma real_inner_mul_inner_self_le (x y : F) : ⟪x, y⟫_ℝ * ⟪x, y⟫_ℝ ≤ ⟪x, x⟫_ℝ * ⟪y, y⟫_ℝ := -begin - have h₁ : ⟪y, x⟫_ℝ = ⟪x, y⟫_ℝ := by rw [←inner_conj_sym]; refl, - have h₂ := @inner_mul_inner_self_le ℝ F _ _ x y, - dsimp at h₂, - have h₃ := abs_mul_abs_self ⟪x, y⟫_ℝ, - rw [h₁] at h₂, - simpa [h₃] using h₂, -end +calc ⟪x, y⟫_ℝ * ⟪x, y⟫_ℝ ≤ ‖⟪x, y⟫_ℝ‖ * ‖⟪y, x⟫_ℝ‖ : + by { rw [real_inner_comm y, ← norm_mul], exact le_abs_self _ } +... ≤ ⟪x, x⟫_ℝ * ⟪y, y⟫_ℝ : @inner_mul_inner_self_le ℝ _ _ _ _ x y /-- A family of vectors is linearly independent if they are nonzero and orthogonal. -/ @@ -687,7 +609,7 @@ include 𝕜 /-- An orthonormal set of vectors in an `inner_product_space` -/ def orthonormal (v : ι → E) : Prop := -(∀ i, ∥v i∥ = 1) ∧ (∀ {i j}, i ≠ j → ⟪v i, v j⟫ = 0) +(∀ i, ‖v i‖ = 1) ∧ (∀ {i j}, i ≠ j → ⟪v i, v j⟫ = 0) omit 𝕜 @@ -707,8 +629,8 @@ begin { intros h, split, { intros i, - have h' : ∥v i∥ ^ 2 = 1 ^ 2 := by simp [norm_sq_eq_inner, h i i], - have h₁ : 0 ≤ ∥v i∥ := norm_nonneg _, + have h' : ‖v i‖ ^ 2 = 1 ^ 2 := by simp [@norm_sq_eq_inner 𝕜, h i i], + have h₁ : 0 ≤ ‖v i‖ := norm_nonneg _, have h₂ : (0:ℝ) ≤ 1 := zero_le_one, rwa sq_eq_sq h₁ h₂ at h' }, { intros i j hij, @@ -758,14 +680,15 @@ hv.inner_right_sum l (finset.mem_univ _) vectors picks out the coefficient of that vector. -/ lemma orthonormal.inner_left_finsupp {v : ι → E} (hv : orthonormal 𝕜 v) (l : ι →₀ 𝕜) (i : ι) : ⟪finsupp.total ι E 𝕜 v l, v i⟫ = conj (l i) := -by rw [← inner_conj_sym, hv.inner_right_finsupp] +by rw [← inner_conj_symm, hv.inner_right_finsupp] /-- The inner product of a linear combination of a set of orthonormal vectors with one of those vectors picks out the coefficient of that vector. -/ lemma orthonormal.inner_left_sum {v : ι → E} (hv : orthonormal 𝕜 v) (l : ι → 𝕜) {s : finset ι} {i : ι} (hi : i ∈ s) : ⟪∑ i in s, (l i) • (v i), v i⟫ = conj (l i) := -by classical; simp [sum_inner, inner_smul_left, orthonormal_iff_ite.mp hv, hi] +by classical; simp only +[sum_inner, inner_smul_left, orthonormal_iff_ite.mp hv, hi, mul_boole, finset.sum_ite_eq', if_true] /-- The inner product of a linear combination of a set of orthonormal vectors with one of those vectors picks out the coefficient of that vector. -/ @@ -779,14 +702,14 @@ a sum over the first `finsupp`. -/ lemma orthonormal.inner_finsupp_eq_sum_left {v : ι → E} (hv : orthonormal 𝕜 v) (l₁ l₂ : ι →₀ 𝕜) : ⟪finsupp.total ι E 𝕜 v l₁, finsupp.total ι E 𝕜 v l₂⟫ = l₁.sum (λ i y, conj y * l₂ i) := -by simp [finsupp.total_apply _ l₁, finsupp.sum_inner, hv.inner_right_finsupp] +by simp only [l₁.total_apply _, finsupp.sum_inner, hv.inner_right_finsupp, smul_eq_mul] /-- The inner product of two linear combinations of a set of orthonormal vectors, expressed as a sum over the second `finsupp`. -/ lemma orthonormal.inner_finsupp_eq_sum_right {v : ι → E} (hv : orthonormal 𝕜 v) (l₁ l₂ : ι →₀ 𝕜) : ⟪finsupp.total ι E 𝕜 v l₁, finsupp.total ι E 𝕜 v l₂⟫ = l₂.sum (λ i y, conj (l₁ i) * y) := -by simp [finsupp.total_apply _ l₂, finsupp.inner_sum, hv.inner_left_finsupp, mul_comm] +by simp only [l₂.total_apply _, finsupp.inner_sum, hv.inner_left_finsupp, mul_comm, smul_eq_mul] /-- The inner product of two linear combinations of a set of orthonormal vectors, expressed as a sum. -/ @@ -815,7 +738,7 @@ begin intros l hl, ext i, have key : ⟪v i, finsupp.total ι E 𝕜 v l⟫ = ⟪v i, 0⟫ := by rw hl, - simpa [hv.inner_right_finsupp] using key + simpa only [hv.inner_right_finsupp, inner_zero_right] using key end /-- A subfamily of an orthonormal family (i.e., a composition with an injective map) is an @@ -831,6 +754,23 @@ begin simp [hf.eq_iff] end +/-- An injective family `v : ι → E` is orthonormal if and only if `coe : (range v) → E` is +orthonormal. -/ +lemma orthonormal_subtype_range {v : ι → E} (hv : function.injective v) : + orthonormal 𝕜 (coe : set.range v → E) ↔ orthonormal 𝕜 v := +begin + let f : ι ≃ set.range v := equiv.of_injective v hv, + refine ⟨λ h, h.comp f f.injective, λ h, _⟩, + rw ← equiv.self_comp_of_injective_symm hv, + exact h.comp f.symm f.symm.injective, +end + +/-- If `v : ι → E` is an orthonormal family, then `coe : (range v) → E` is an orthonormal +family. -/ +lemma orthonormal.to_subtype_range {v : ι → E} (hv : orthonormal 𝕜 v) : + orthonormal 𝕜 (coe : set.range v → E) := +(orthonormal_subtype_range hv.linear_independent.injective).2 hv + /-- A linear combination of some subset of an orthonormal set is orthogonal to other members of the set. -/ lemma orthonormal.inner_finsupp_eq_zero @@ -839,7 +779,7 @@ lemma orthonormal.inner_finsupp_eq_zero ⟪finsupp.total ι E 𝕜 v l, v i⟫ = 0 := begin rw finsupp.mem_supported' at hl, - simp [hv.inner_left_finsupp, hl i hi], + simp only [hv.inner_left_finsupp, hl i hi, map_zero], end /-- Given an orthonormal family, a second family of vectors is orthonormal if every vector equals @@ -851,7 +791,8 @@ begin rw orthonormal_iff_ite at *, intros i j, cases hw i with hi hi; cases hw j with hj hj; split_ifs with h; - simpa [hi, hj, h] using hv i j + simpa only [hi, hj, h, inner_neg_right, inner_neg_left, + neg_neg, eq_self_iff_true, neg_eq_zero] using hv i j end /- The material that follows, culminating in the existence of a maximal orthonormal subset, is @@ -897,7 +838,7 @@ end lemma orthonormal.ne_zero {v : ι → E} (hv : orthonormal 𝕜 v) (i : ι) : v i ≠ 0 := begin - have : ∥v i∥ ≠ 0, + have : ‖v i‖ ≠ 0, { rw hv.1 i, norm_num }, simpa using this @@ -920,150 +861,134 @@ end orthonormal_sets section norm -lemma norm_eq_sqrt_inner (x : E) : ∥x∥ = sqrt (re ⟪x, x⟫) := -begin - have h₁ : ∥x∥^2 = re ⟪x, x⟫ := norm_sq_eq_inner x, - have h₂ := congr_arg sqrt h₁, - simpa using h₂, -end +lemma norm_eq_sqrt_inner (x : E) : ‖x‖ = sqrt (re ⟪x, x⟫) := +calc ‖x‖ = sqrt (‖x‖ ^ 2) : (sqrt_sq (norm_nonneg _)).symm +... = sqrt (re ⟪x, x⟫) : congr_arg _ (norm_sq_eq_inner _) -lemma norm_eq_sqrt_real_inner (x : F) : ∥x∥ = sqrt ⟪x, x⟫_ℝ := -by { have h := @norm_eq_sqrt_inner ℝ F _ _ x, simpa using h } +lemma norm_eq_sqrt_real_inner (x : F) : ‖x‖ = sqrt ⟪x, x⟫_ℝ := +@norm_eq_sqrt_inner ℝ _ _ _ _ x -lemma inner_self_eq_norm_mul_norm (x : E) : re ⟪x, x⟫ = ∥x∥ * ∥x∥ := -by rw [norm_eq_sqrt_inner, ←sqrt_mul inner_self_nonneg (re ⟪x, x⟫), +lemma inner_self_eq_norm_mul_norm (x : E) : re ⟪x, x⟫ = ‖x‖ * ‖x‖ := +by rw [@norm_eq_sqrt_inner 𝕜, ←sqrt_mul inner_self_nonneg (re ⟪x, x⟫), sqrt_mul_self inner_self_nonneg] -lemma inner_self_eq_norm_sq (x : E) : re ⟪x, x⟫ = ∥x∥^2 := +lemma inner_self_eq_norm_sq (x : E) : re ⟪x, x⟫ = ‖x‖^2 := by rw [pow_two, inner_self_eq_norm_mul_norm] -lemma real_inner_self_eq_norm_mul_norm (x : F) : ⟪x, x⟫_ℝ = ∥x∥ * ∥x∥ := -by { have h := @inner_self_eq_norm_mul_norm ℝ F _ _ x, simpa using h } +lemma real_inner_self_eq_norm_mul_norm (x : F) : ⟪x, x⟫_ℝ = ‖x‖ * ‖x‖ := +by { have h := @inner_self_eq_norm_mul_norm ℝ F _ _ _ x, simpa using h } -lemma real_inner_self_eq_norm_sq (x : F) : ⟪x, x⟫_ℝ = ∥x∥^2 := +lemma real_inner_self_eq_norm_sq (x : F) : ⟪x, x⟫_ℝ = ‖x‖^2 := by rw [pow_two, real_inner_self_eq_norm_mul_norm] +variables (𝕜) /-- Expand the square -/ -lemma norm_add_sq {x y : E} : ∥x + y∥^2 = ∥x∥^2 + 2 * (re ⟪x, y⟫) + ∥y∥^2 := +lemma norm_add_sq (x y : E) : ‖x + y‖^2 = ‖x‖^2 + 2 * (re ⟪x, y⟫) + ‖y‖^2 := begin - repeat {rw [sq, ←inner_self_eq_norm_mul_norm]}, + repeat {rw [sq, ←@inner_self_eq_norm_mul_norm 𝕜]}, rw [inner_add_add_self, two_mul], simp only [add_assoc, add_left_inj, add_right_inj, add_monoid_hom.map_add], - rw [←inner_conj_sym, conj_re], + rw [←inner_conj_symm, conj_re], end alias norm_add_sq ← norm_add_pow_two /-- Expand the square -/ -lemma norm_add_sq_real {x y : F} : ∥x + y∥^2 = ∥x∥^2 + 2 * ⟪x, y⟫_ℝ + ∥y∥^2 := -by { have h := @norm_add_sq ℝ F _ _, simpa using h } +lemma norm_add_sq_real (x y : F) : ‖x + y‖^2 = ‖x‖^2 + 2 * ⟪x, y⟫_ℝ + ‖y‖^2 := +by { have h := @norm_add_sq ℝ _ _ _ _ x y, simpa using h } alias norm_add_sq_real ← norm_add_pow_two_real /-- Expand the square -/ -lemma norm_add_mul_self {x y : E} : ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + 2 * (re ⟪x, y⟫) + ∥y∥ * ∥y∥ := -by { repeat {rw [← sq]}, exact norm_add_sq } +lemma norm_add_mul_self (x y : E) : ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + 2 * (re ⟪x, y⟫) + ‖y‖ * ‖y‖ := +by { repeat {rw [← sq]}, exact norm_add_sq _ _ } /-- Expand the square -/ -lemma norm_add_mul_self_real {x y : F} : ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + 2 * ⟪x, y⟫_ℝ + ∥y∥ * ∥y∥ := -by { have h := @norm_add_mul_self ℝ F _ _, simpa using h } +lemma norm_add_mul_self_real (x y : F) : ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + 2 * ⟪x, y⟫_ℝ + ‖y‖ * ‖y‖ := +by { have h := @norm_add_mul_self ℝ _ _ _ _ x y, simpa using h } /-- Expand the square -/ -lemma norm_sub_sq {x y : E} : ∥x - y∥^2 = ∥x∥^2 - 2 * (re ⟪x, y⟫) + ∥y∥^2 := -begin - repeat {rw [sq, ←inner_self_eq_norm_mul_norm]}, - rw [inner_sub_sub_self], - calc - re (⟪x, x⟫ - ⟪x, y⟫ - ⟪y, x⟫ + ⟪y, y⟫) - = re ⟪x, x⟫ - re ⟪x, y⟫ - re ⟪y, x⟫ + re ⟪y, y⟫ : by simp - ... = -re ⟪y, x⟫ - re ⟪x, y⟫ + re ⟪x, x⟫ + re ⟪y, y⟫ : by ring - ... = -re (⟪x, y⟫†) - re ⟪x, y⟫ + re ⟪x, x⟫ + re ⟪y, y⟫ : by rw [inner_conj_sym] - ... = -re ⟪x, y⟫ - re ⟪x, y⟫ + re ⟪x, x⟫ + re ⟪y, y⟫ : by rw [conj_re] - ... = re ⟪x, x⟫ - 2*re ⟪x, y⟫ + re ⟪y, y⟫ : by ring -end +lemma norm_sub_sq (x y : E) : ‖x - y‖^2 = ‖x‖^2 - 2 * (re ⟪x, y⟫) + ‖y‖^2 := +by rw [sub_eq_add_neg, @norm_add_sq 𝕜 _ _ _ _ x (-y), norm_neg, inner_neg_right, map_neg, mul_neg, + sub_eq_add_neg] alias norm_sub_sq ← norm_sub_pow_two /-- Expand the square -/ -lemma norm_sub_sq_real {x y : F} : ∥x - y∥^2 = ∥x∥^2 - 2 * ⟪x, y⟫_ℝ + ∥y∥^2 := -norm_sub_sq +lemma norm_sub_sq_real (x y : F) : ‖x - y‖^2 = ‖x‖^2 - 2 * ⟪x, y⟫_ℝ + ‖y‖^2 := +@norm_sub_sq ℝ _ _ _ _ _ _ alias norm_sub_sq_real ← norm_sub_pow_two_real /-- Expand the square -/ -lemma norm_sub_mul_self {x y : E} : ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ - 2 * re ⟪x, y⟫ + ∥y∥ * ∥y∥ := -by { repeat {rw [← sq]}, exact norm_sub_sq } +lemma norm_sub_mul_self (x y : E) : ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ - 2 * re ⟪x, y⟫ + ‖y‖ * ‖y‖ := +by { repeat {rw [← sq]}, exact norm_sub_sq _ _ } /-- Expand the square -/ -lemma norm_sub_mul_self_real {x y : F} : ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ - 2 * ⟪x, y⟫_ℝ + ∥y∥ * ∥y∥ := -by { have h := @norm_sub_mul_self ℝ F _ _, simpa using h } +lemma norm_sub_mul_self_real (x y : F) : ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ - 2 * ⟪x, y⟫_ℝ + ‖y‖ * ‖y‖ := +by { have h := @norm_sub_mul_self ℝ _ _ _ _ x y, simpa using h } /-- Cauchy–Schwarz inequality with norm -/ -lemma abs_inner_le_norm (x y : E) : abs ⟪x, y⟫ ≤ ∥x∥ * ∥y∥ := -nonneg_le_nonneg_of_sq_le_sq (mul_nonneg (norm_nonneg _) (norm_nonneg _)) +lemma norm_inner_le_norm (x y : E) : ‖⟪x, y⟫‖ ≤ ‖x‖ * ‖y‖ := begin - have : ∥x∥ * ∥y∥ * (∥x∥ * ∥y∥) = (re ⟪x, x⟫) * (re ⟪y, y⟫), - simp only [inner_self_eq_norm_mul_norm], ring, - rw this, - conv_lhs { congr, skip, rw [inner_abs_conj_sym] }, - exact inner_mul_inner_self_le _ _ + rw [norm_eq_sqrt_inner x, norm_eq_sqrt_inner y], + letI : inner_product_space.core 𝕜 E := inner_product_space.to_core, + exact inner_product_space.core.norm_inner_le_norm x y end -lemma norm_inner_le_norm (x y : E) : ∥⟪x, y⟫∥ ≤ ∥x∥ * ∥y∥ := -(is_R_or_C.norm_eq_abs _).le.trans (abs_inner_le_norm x y) - -lemma nnnorm_inner_le_nnnorm (x y : E) : ∥⟪x, y⟫∥₊ ≤ ∥x∥₊ * ∥y∥₊ := +lemma nnnorm_inner_le_nnnorm (x y : E) : ‖⟪x, y⟫‖₊ ≤ ‖x‖₊ * ‖y‖₊ := norm_inner_le_norm x y -lemma re_inner_le_norm (x y : E) : re ⟪x, y⟫ ≤ ∥x∥ * ∥y∥ := -le_trans (re_le_abs (inner x y)) (abs_inner_le_norm x y) +lemma re_inner_le_norm (x y : E) : re ⟪x, y⟫ ≤ ‖x‖ * ‖y‖ := +le_trans (re_le_norm (inner x y)) (norm_inner_le_norm x y) /-- Cauchy–Schwarz inequality with norm -/ -lemma abs_real_inner_le_norm (x y : F) : absR ⟪x, y⟫_ℝ ≤ ∥x∥ * ∥y∥ := -by { have h := @abs_inner_le_norm ℝ F _ _ x y, simpa using h } +lemma abs_real_inner_le_norm (x y : F) : |⟪x, y⟫_ℝ| ≤ ‖x‖ * ‖y‖ := +(real.norm_eq_abs _).ge.trans (norm_inner_le_norm x y) /-- Cauchy–Schwarz inequality with norm -/ -lemma real_inner_le_norm (x y : F) : ⟪x, y⟫_ℝ ≤ ∥x∥ * ∥y∥ := +lemma real_inner_le_norm (x y : F) : ⟪x, y⟫_ℝ ≤ ‖x‖ * ‖y‖ := le_trans (le_abs_self _) (abs_real_inner_le_norm _ _) include 𝕜 +variables (𝕜) lemma parallelogram_law_with_norm (x y : E) : - ∥x + y∥ * ∥x + y∥ + ∥x - y∥ * ∥x - y∥ = 2 * (∥x∥ * ∥x∥ + ∥y∥ * ∥y∥) := + ‖x + y‖ * ‖x + y‖ + ‖x - y‖ * ‖x - y‖ = 2 * (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖) := begin - simp only [← inner_self_eq_norm_mul_norm], + simp only [← @inner_self_eq_norm_mul_norm 𝕜], rw [← re.map_add, parallelogram_law, two_mul, two_mul], simp only [re.map_add], end lemma parallelogram_law_with_nnnorm (x y : E) : - ∥x + y∥₊ * ∥x + y∥₊ + ∥x - y∥₊ * ∥x - y∥₊ = 2 * (∥x∥₊ * ∥x∥₊ + ∥y∥₊ * ∥y∥₊) := -subtype.ext $ parallelogram_law_with_norm x y - + ‖x + y‖₊ * ‖x + y‖₊ + ‖x - y‖₊ * ‖x - y‖₊ = 2 * (‖x‖₊ * ‖x‖₊ + ‖y‖₊ * ‖y‖₊) := +subtype.ext $ parallelogram_law_with_norm 𝕜 x y +variables {𝕜} omit 𝕜 /-- Polarization identity: The real part of the inner product, in terms of the norm. -/ lemma re_inner_eq_norm_add_mul_self_sub_norm_mul_self_sub_norm_mul_self_div_two (x y : E) : - re ⟪x, y⟫ = (∥x + y∥ * ∥x + y∥ - ∥x∥ * ∥x∥ - ∥y∥ * ∥y∥) / 2 := -by { rw norm_add_mul_self, ring } + re ⟪x, y⟫ = (‖x + y‖ * ‖x + y‖ - ‖x‖ * ‖x‖ - ‖y‖ * ‖y‖) / 2 := +by { rw @norm_add_mul_self 𝕜, ring } /-- Polarization identity: The real part of the inner product, in terms of the norm. -/ lemma re_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two (x y : E) : - re ⟪x, y⟫ = (∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ - ∥x - y∥ * ∥x - y∥) / 2 := -by { rw [norm_sub_mul_self], ring } + re ⟪x, y⟫ = (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ - ‖x - y‖ * ‖x - y‖) / 2 := +by { rw [@norm_sub_mul_self 𝕜], ring } /-- Polarization identity: The real part of the inner product, in terms of the norm. -/ lemma re_inner_eq_norm_add_mul_self_sub_norm_sub_mul_self_div_four (x y : E) : - re ⟪x, y⟫ = (∥x + y∥ * ∥x + y∥ - ∥x - y∥ * ∥x - y∥) / 4 := -by { rw [norm_add_mul_self, norm_sub_mul_self], ring } + re ⟪x, y⟫ = (‖x + y‖ * ‖x + y‖ - ‖x - y‖ * ‖x - y‖) / 4 := +by { rw [@norm_add_mul_self 𝕜, @norm_sub_mul_self 𝕜], ring } /-- Polarization identity: The imaginary part of the inner product, in terms of the norm. -/ lemma im_inner_eq_norm_sub_I_smul_mul_self_sub_norm_add_I_smul_mul_self_div_four (x y : E) : - im ⟪x, y⟫ = (∥x - IK • y∥ * ∥x - IK • y∥ - ∥x + IK • y∥ * ∥x + IK • y∥) / 4 := -by { simp only [norm_add_mul_self, norm_sub_mul_self, inner_smul_right, I_mul_re], ring } + im ⟪x, y⟫ = (‖x - IK • y‖ * ‖x - IK • y‖ - ‖x + IK • y‖ * ‖x + IK • y‖) / 4 := +by { simp only [@norm_add_mul_self 𝕜, @norm_sub_mul_self 𝕜, inner_smul_right, I_mul_re], ring } /-- Polarization identity: The inner product, in terms of the norm. -/ lemma inner_eq_sum_norm_sq_div_four (x y : E) : - ⟪x, y⟫ = (∥x + y∥ ^ 2 - ∥x - y∥ ^ 2 + (∥x - IK • y∥ ^ 2 - ∥x + IK • y∥ ^ 2) * IK) / 4 := + ⟪x, y⟫ = (‖x + y‖ ^ 2 - ‖x - y‖ ^ 2 + (‖x - IK • y‖ ^ 2 - ‖x + IK • y‖ ^ 2) * IK) / 4 := begin rw [← re_add_im ⟪x, y⟫, re_inner_eq_norm_add_mul_self_sub_norm_sub_mul_self_div_four, im_inner_eq_norm_sub_I_smul_mul_self_sub_norm_add_I_smul_mul_self_div_four], @@ -1071,10 +996,39 @@ begin simp only [sq, ← mul_div_right_comm, ← add_div] end +/-- Formula for the distance between the images of two nonzero points under an inversion with center +zero. See also `euclidean_geometry.dist_inversion_inversion` for inversions around a general +point. -/ +lemma dist_div_norm_sq_smul {x y : F} (hx : x ≠ 0) (hy : y ≠ 0) (R : ℝ) : + dist ((R / ‖x‖) ^ 2 • x) ((R / ‖y‖) ^ 2 • y) = (R ^ 2 / (‖x‖ * ‖y‖)) * dist x y := +have hx' : ‖x‖ ≠ 0, from norm_ne_zero_iff.2 hx, +have hy' : ‖y‖ ≠ 0, from norm_ne_zero_iff.2 hy, +calc dist ((R / ‖x‖) ^ 2 • x) ((R / ‖y‖) ^ 2 • y) + = sqrt (‖(R / ‖x‖) ^ 2 • x - (R / ‖y‖) ^ 2 • y‖^2) : + by rw [dist_eq_norm, sqrt_sq (norm_nonneg _)] +... = sqrt ((R ^ 2 / (‖x‖ * ‖y‖)) ^ 2 * ‖x - y‖ ^ 2) : + congr_arg sqrt $ by { field_simp [sq, norm_sub_mul_self_real, norm_smul, real_inner_smul_left, + inner_smul_right, real.norm_of_nonneg (mul_self_nonneg _)], ring } +... = (R ^ 2 / (‖x‖ * ‖y‖)) * dist x y : + by rw [sqrt_mul (sq_nonneg _), sqrt_sq (norm_nonneg _), + sqrt_sq (div_nonneg (sq_nonneg _) (mul_nonneg (norm_nonneg _) (norm_nonneg _))), dist_eq_norm] + +@[priority 100] -- See note [lower instance priority] +instance inner_product_space.to_uniform_convex_space : uniform_convex_space F := +⟨λ ε hε, begin + refine ⟨2 - sqrt (4 - ε^2), sub_pos_of_lt $ (sqrt_lt' zero_lt_two).2 _, λ x hx y hy hxy, _⟩, + { norm_num, + exact pow_pos hε _ }, + rw sub_sub_cancel, + refine le_sqrt_of_sq_le _, + rw [sq, eq_sub_iff_add_eq.2 (parallelogram_law_with_norm ℝ x y), ←sq (‖x - y‖), hx, hy], + norm_num, + exact pow_le_pow_of_le_left hε.le hxy _, +end⟩ + section complex -variables {V : Type*} -[inner_product_space ℂ V] +variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℂ V] /-- A complex polarization identity, with a linear map @@ -1104,7 +1058,7 @@ begin end /-- -If `⟪T x, x⟫_ℂ = 0` for all x, then T = 0. +A linear map `T` is zero, if and only if the identity `⟪T x, x⟫_ℂ = 0` holds for all `x`. -/ lemma inner_map_self_eq_zero (T : V →ₗ[ℂ] V) : (∀ (x : V), ⟪T x, x⟫_ℂ = 0) ↔ T = 0 := @@ -1112,19 +1066,31 @@ begin split, { intro hT, ext x, - simp only [linear_map.zero_apply, ← inner_self_eq_zero, inner_map_polarization, hT], + simp only [linear_map.zero_apply, ← @inner_self_eq_zero ℂ, inner_map_polarization, hT], norm_num }, { rintro rfl x, simp only [linear_map.zero_apply, inner_zero_left] } end +/-- +Two linear maps `S` and `T` are equal, if and only if the identity `⟪S x, x⟫_ℂ = ⟪T x, x⟫_ℂ` holds +for all `x`. +-/ +lemma ext_inner_map (S T : V →ₗ[ℂ] V) : + (∀ (x : V), ⟪S x, x⟫_ℂ = ⟪T x, x⟫_ℂ) ↔ S = T := +begin + rw [←sub_eq_zero, ←inner_map_self_eq_zero], + refine forall_congr (λ x, _), + rw [linear_map.sub_apply, inner_sub_left, sub_eq_zero], +end + end complex section variables {ι : Type*} {ι' : Type*} {ι'' : Type*} -variables {E' : Type*} [inner_product_space 𝕜 E'] -variables {E'' : Type*} [inner_product_space 𝕜 E''] +variables {E' : Type*} [normed_add_comm_group E'] [inner_product_space 𝕜 E'] +variables {E'' : Type*} [normed_add_comm_group E''] [inner_product_space 𝕜 E''] /-- A linear isometry preserves the inner product. -/ @[simp] lemma linear_isometry.inner_map_map (f : E →ₗᵢ[𝕜] E') (x y : E) : ⟪f x, f y⟫ = ⟪x, y⟫ := @@ -1137,7 +1103,7 @@ f.to_linear_isometry.inner_map_map x y /-- A linear map that preserves the inner product is a linear isometry. -/ def linear_map.isometry_of_inner (f : E →ₗ[𝕜] E') (h : ∀ x y, ⟪f x, f y⟫ = ⟪x, y⟫) : E →ₗᵢ[𝕜] E' := -⟨f, λ x, by simp only [norm_eq_sqrt_inner, h]⟩ +⟨f, λ x, by simp only [@norm_eq_sqrt_inner 𝕜, h]⟩ @[simp] lemma linear_map.coe_isometry_of_inner (f : E →ₗ[𝕜] E') (h) : ⇑(f.isometry_of_inner h) = f := rfl @@ -1157,21 +1123,25 @@ def linear_equiv.isometry_of_inner (f : E ≃ₗ[𝕜] E') (h : ∀ x y, ⟪f x, (f.isometry_of_inner h).to_linear_equiv = f := rfl /-- A linear isometry preserves the property of being orthonormal. -/ -lemma orthonormal.comp_linear_isometry {v : ι → E} (hv : orthonormal 𝕜 v) (f : E →ₗᵢ[𝕜] E') : - orthonormal 𝕜 (f ∘ v) := +lemma linear_isometry.orthonormal_comp_iff {v : ι → E} (f : E →ₗᵢ[𝕜] E') : + orthonormal 𝕜 (f ∘ v) ↔ orthonormal 𝕜 v := begin classical, - simp_rw [orthonormal_iff_ite, linear_isometry.inner_map_map, ←orthonormal_iff_ite], - exact hv + simp_rw [orthonormal_iff_ite, linear_isometry.inner_map_map] end +/-- A linear isometry preserves the property of being orthonormal. -/ +lemma orthonormal.comp_linear_isometry {v : ι → E} (hv : orthonormal 𝕜 v) (f : E →ₗᵢ[𝕜] E') : + orthonormal 𝕜 (f ∘ v) := +by rwa f.orthonormal_comp_iff + /-- A linear isometric equivalence preserves the property of being orthonormal. -/ lemma orthonormal.comp_linear_isometry_equiv {v : ι → E} (hv : orthonormal 𝕜 v) (f : E ≃ₗᵢ[𝕜] E') : orthonormal 𝕜 (f ∘ v) := hv.comp_linear_isometry f.to_linear_isometry /-- A linear isometric equivalence, applied with `basis.map`, preserves the property of being -orthonormal. --/ +orthonormal. -/ lemma orthonormal.map_linear_isometry_equiv {v : basis ι 𝕜 E} (hv : orthonormal 𝕜 v) (f : E ≃ₗᵢ[𝕜] E') : orthonormal 𝕜 (v.map f.to_linear_equiv) := hv.comp_linear_isometry_equiv f @@ -1236,16 +1206,19 @@ basis.equiv_apply _ _ _ _ @[simp] lemma orthonormal.equiv_refl {v : basis ι 𝕜 E} (hv : orthonormal 𝕜 v) : hv.equiv hv (equiv.refl ι) = linear_isometry_equiv.refl 𝕜 E := -v.ext_linear_isometry_equiv $ λ i, by simp +v.ext_linear_isometry_equiv $ λ i, + by simp only [orthonormal.equiv_apply, equiv.coe_refl, id.def, linear_isometry_equiv.coe_refl] @[simp] lemma orthonormal.equiv_symm {v : basis ι 𝕜 E} (hv : orthonormal 𝕜 v) {v' : basis ι' 𝕜 E'} (hv' : orthonormal 𝕜 v') (e : ι ≃ ι') : (hv.equiv hv' e).symm = hv'.equiv hv e.symm := -v'.ext_linear_isometry_equiv $ λ i, (hv.equiv hv' e).injective (by simp) +v'.ext_linear_isometry_equiv $ λ i, (hv.equiv hv' e).injective $ + by simp only [linear_isometry_equiv.apply_symm_apply, orthonormal.equiv_apply, e.apply_symm_apply] @[simp] lemma orthonormal.equiv_trans {v : basis ι 𝕜 E} (hv : orthonormal 𝕜 v) {v' : basis ι' 𝕜 E'} (hv' : orthonormal 𝕜 v') (e : ι ≃ ι') {v'' : basis ι'' 𝕜 E''} (hv'' : orthonormal 𝕜 v'') (e' : ι' ≃ ι'') : (hv.equiv hv' e).trans (hv'.equiv hv'' e') = hv.equiv hv'' (e.trans e') := -v.ext_linear_isometry_equiv $ λ i, by simp +v.ext_linear_isometry_equiv $ λ i, + by simp only [linear_isometry_equiv.trans_apply, orthonormal.equiv_apply, e.coe_trans] lemma orthonormal.map_equiv {v : basis ι 𝕜 E} (hv : orthonormal 𝕜 v) {v' : basis ι' 𝕜 E'} (hv' : orthonormal 𝕜 v') (e : ι ≃ ι') : @@ -1256,60 +1229,73 @@ end /-- Polarization identity: The real inner product, in terms of the norm. -/ lemma real_inner_eq_norm_add_mul_self_sub_norm_mul_self_sub_norm_mul_self_div_two (x y : F) : - ⟪x, y⟫_ℝ = (∥x + y∥ * ∥x + y∥ - ∥x∥ * ∥x∥ - ∥y∥ * ∥y∥) / 2 := + ⟪x, y⟫_ℝ = (‖x + y‖ * ‖x + y‖ - ‖x‖ * ‖x‖ - ‖y‖ * ‖y‖) / 2 := re_to_real.symm.trans $ re_inner_eq_norm_add_mul_self_sub_norm_mul_self_sub_norm_mul_self_div_two x y /-- Polarization identity: The real inner product, in terms of the norm. -/ lemma real_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two (x y : F) : - ⟪x, y⟫_ℝ = (∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ - ∥x - y∥ * ∥x - y∥) / 2 := + ⟪x, y⟫_ℝ = (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ - ‖x - y‖ * ‖x - y‖) / 2 := re_to_real.symm.trans $ re_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two x y /-- Pythagorean theorem, if-and-only-if vector inner product form. -/ lemma norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero (x y : F) : - ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ ↔ ⟪x, y⟫_ℝ = 0 := + ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ ⟪x, y⟫_ℝ = 0 := begin - rw [norm_add_mul_self, add_right_cancel_iff, add_right_eq_self, mul_eq_zero], + rw [@norm_add_mul_self ℝ, add_right_cancel_iff, add_right_eq_self, mul_eq_zero], norm_num end +/-- Pythagorean theorem, if-and-if vector inner product form using square roots. -/ +lemma norm_add_eq_sqrt_iff_real_inner_eq_zero {x y : F} : + ‖x + y‖ = sqrt (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖) ↔ ⟪x, y⟫_ℝ = 0 := +by rw [←norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero, eq_comm, + sqrt_eq_iff_mul_self_eq (add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)) (norm_nonneg _)] + /-- Pythagorean theorem, vector inner product form. -/ lemma norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero (x y : E) (h : ⟪x, y⟫ = 0) : - ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ := + ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ := begin - rw [norm_add_mul_self, add_right_cancel_iff, add_right_eq_self, mul_eq_zero], + rw [@norm_add_mul_self 𝕜, add_right_cancel_iff, add_right_eq_self, mul_eq_zero], apply or.inr, simp only [h, zero_re'], end /-- Pythagorean theorem, vector inner product form. -/ lemma norm_add_sq_eq_norm_sq_add_norm_sq_real {x y : F} (h : ⟪x, y⟫_ℝ = 0) : - ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ := + ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ := (norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero x y).2 h /-- Pythagorean theorem, subtracting vectors, if-and-only-if vector inner product form. -/ lemma norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero (x y : F) : - ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ ↔ ⟪x, y⟫_ℝ = 0 := + ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ ⟪x, y⟫_ℝ = 0 := begin - rw [norm_sub_mul_self, add_right_cancel_iff, sub_eq_add_neg, add_right_eq_self, neg_eq_zero, + rw [@norm_sub_mul_self ℝ, add_right_cancel_iff, sub_eq_add_neg, add_right_eq_self, neg_eq_zero, mul_eq_zero], norm_num end +/-- Pythagorean theorem, subtracting vectors, if-and-if vector inner product form using square +roots. -/ +lemma norm_sub_eq_sqrt_iff_real_inner_eq_zero {x y : F} : + ‖x - y‖ = sqrt (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖) ↔ ⟪x, y⟫_ℝ = 0 := +by rw [←norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero, eq_comm, + sqrt_eq_iff_mul_self_eq (add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)) (norm_nonneg _)] + /-- Pythagorean theorem, subtracting vectors, vector inner product form. -/ lemma norm_sub_sq_eq_norm_sq_add_norm_sq_real {x y : F} (h : ⟪x, y⟫_ℝ = 0) : - ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ := + ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ := (norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero x y).2 h /-- The sum and difference of two vectors are orthogonal if and only if they have the same norm. -/ -lemma real_inner_add_sub_eq_zero_iff (x y : F) : ⟪x + y, x - y⟫_ℝ = 0 ↔ ∥x∥ = ∥y∥ := +lemma real_inner_add_sub_eq_zero_iff (x y : F) : ⟪x + y, x - y⟫_ℝ = 0 ↔ ‖x‖ = ‖y‖ := begin conv_rhs { rw ←mul_self_inj_of_nonneg (norm_nonneg _) (norm_nonneg _) }, - simp only [←inner_self_eq_norm_mul_norm, inner_add_left, inner_sub_right, + simp only [←@inner_self_eq_norm_mul_norm ℝ, inner_add_left, inner_sub_right, real_inner_comm y x, sub_eq_zero, re_to_real], split, { intro h, @@ -1320,193 +1306,178 @@ begin end /-- Given two orthogonal vectors, their sum and difference have equal norms. -/ -lemma norm_sub_eq_norm_add {v w : E} (h : ⟪v, w⟫ = 0) : ∥w - v∥ = ∥w + v∥ := +lemma norm_sub_eq_norm_add {v w : E} (h : ⟪v, w⟫ = 0) : ‖w - v‖ = ‖w + v‖ := begin rw ←mul_self_inj_of_nonneg (norm_nonneg _) (norm_nonneg _), - simp [h, ←inner_self_eq_norm_mul_norm, inner_add_left, inner_add_right, inner_sub_left, - inner_sub_right, inner_re_symm] + simp only [h, ←@inner_self_eq_norm_mul_norm 𝕜, sub_neg_eq_add, sub_zero, map_sub, zero_re', + zero_sub, + add_zero, map_add, inner_add_right, inner_sub_left, inner_sub_right, inner_re_symm, zero_add] end /-- The real inner product of two vectors, divided by the product of their norms, has absolute value at most 1. -/ -lemma abs_real_inner_div_norm_mul_norm_le_one (x y : F) : absR (⟪x, y⟫_ℝ / (∥x∥ * ∥y∥)) ≤ 1 := +lemma abs_real_inner_div_norm_mul_norm_le_one (x y : F) : |⟪x, y⟫_ℝ / (‖x‖ * ‖y‖)| ≤ 1 := begin - rw _root_.abs_div, - by_cases h : 0 = absR (∥x∥ * ∥y∥), - { rw [←h, div_zero], - norm_num }, - { change 0 ≠ absR (∥x∥ * ∥y∥) at h, - rw div_le_iff' (lt_of_le_of_ne (ge_iff_le.mp (_root_.abs_nonneg (∥x∥ * ∥y∥))) h), - convert abs_real_inner_le_norm x y using 1, - rw [_root_.abs_mul, _root_.abs_of_nonneg (norm_nonneg x), _root_.abs_of_nonneg (norm_nonneg y), - mul_one] } + rw [abs_div, abs_mul, abs_norm, abs_norm], + exact div_le_one_of_le (abs_real_inner_le_norm x y) (by positivity) end /-- The inner product of a vector with a multiple of itself. -/ -lemma real_inner_smul_self_left (x : F) (r : ℝ) : ⟪r • x, x⟫_ℝ = r * (∥x∥ * ∥x∥) := +lemma real_inner_smul_self_left (x : F) (r : ℝ) : ⟪r • x, x⟫_ℝ = r * (‖x‖ * ‖x‖) := by rw [real_inner_smul_left, ←real_inner_self_eq_norm_mul_norm] /-- The inner product of a vector with a multiple of itself. -/ -lemma real_inner_smul_self_right (x : F) (r : ℝ) : ⟪x, r • x⟫_ℝ = r * (∥x∥ * ∥x∥) := +lemma real_inner_smul_self_right (x : F) (r : ℝ) : ⟪x, r • x⟫_ℝ = r * (‖x‖ * ‖x‖) := by rw [inner_smul_right, ←real_inner_self_eq_norm_mul_norm] /-- The inner product of a nonzero vector with a nonzero multiple of itself, divided by the product of their norms, has absolute value 1. -/ -lemma abs_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul - {x : E} {r : 𝕜} (hx : x ≠ 0) (hr : r ≠ 0) : abs ⟪x, r • x⟫ / (∥x∥ * ∥r • x∥) = 1 := +lemma norm_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul + {x : E} {r : 𝕜} (hx : x ≠ 0) (hr : r ≠ 0) : ‖⟪x, r • x⟫‖ / (‖x‖ * ‖r • x‖) = 1 := begin - have hx' : ∥x∥ ≠ 0 := by simp [norm_eq_zero, hx], - have hr' : abs r ≠ 0 := by simp [is_R_or_C.abs_eq_zero, hr], - rw [inner_smul_right, is_R_or_C.abs_mul, ←inner_self_re_abs, inner_self_eq_norm_mul_norm, - norm_smul], - rw [is_R_or_C.norm_eq_abs, ←mul_assoc, ←div_div_eq_div_mul, mul_div_cancel _ hx', - ←div_div_eq_div_mul, mul_comm, mul_div_cancel _ hr', div_self hx'], + have hx' : ‖x‖ ≠ 0 := by simp [hx], + have hr' : ‖r‖ ≠ 0 := by simp [hr], + rw [inner_smul_right, norm_mul, ← inner_self_re_eq_norm, inner_self_eq_norm_mul_norm, norm_smul], + rw [← mul_assoc, ← div_div, mul_div_cancel _ hx', + ← div_div, mul_comm, mul_div_cancel _ hr', div_self hx'], end /-- The inner product of a nonzero vector with a nonzero multiple of itself, divided by the product of their norms, has absolute value 1. -/ lemma abs_real_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul - {x : F} {r : ℝ} (hx : x ≠ 0) (hr : r ≠ 0) : absR ⟪x, r • x⟫_ℝ / (∥x∥ * ∥r • x∥) = 1 := -begin - rw ← abs_to_real, - exact abs_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul hx hr -end + {x : F} {r : ℝ} (hx : x ≠ 0) (hr : r ≠ 0) : |⟪x, r • x⟫_ℝ| / (‖x‖ * ‖r • x‖) = 1 := +norm_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul hx hr /-- The inner product of a nonzero vector with a positive multiple of itself, divided by the product of their norms, has value 1. -/ lemma real_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_pos_mul - {x : F} {r : ℝ} (hx : x ≠ 0) (hr : 0 < r) : ⟪x, r • x⟫_ℝ / (∥x∥ * ∥r • x∥) = 1 := + {x : F} {r : ℝ} (hx : x ≠ 0) (hr : 0 < r) : ⟪x, r • x⟫_ℝ / (‖x‖ * ‖r • x‖) = 1 := begin - rw [real_inner_smul_self_right, norm_smul, real.norm_eq_abs, ←mul_assoc ∥x∥, mul_comm _ (absR r), - mul_assoc, _root_.abs_of_nonneg (le_of_lt hr), div_self], - exact mul_ne_zero (ne_of_gt hr) - (λ h, hx (norm_eq_zero.1 (eq_zero_of_mul_self_eq_zero h))) + rw [real_inner_smul_self_right, norm_smul, real.norm_eq_abs, ←mul_assoc ‖x‖, mul_comm _ (|r|), + mul_assoc, abs_of_nonneg hr.le, div_self], + exact mul_ne_zero hr.ne' (mul_self_ne_zero.2 (norm_ne_zero_iff.2 hx)) end /-- The inner product of a nonzero vector with a negative multiple of itself, divided by the product of their norms, has value -1. -/ lemma real_inner_div_norm_mul_norm_eq_neg_one_of_ne_zero_of_neg_mul - {x : F} {r : ℝ} (hx : x ≠ 0) (hr : r < 0) : ⟪x, r • x⟫_ℝ / (∥x∥ * ∥r • x∥) = -1 := + {x : F} {r : ℝ} (hx : x ≠ 0) (hr : r < 0) : ⟪x, r • x⟫_ℝ / (‖x‖ * ‖r • x‖) = -1 := begin - rw [real_inner_smul_self_right, norm_smul, real.norm_eq_abs, ←mul_assoc ∥x∥, mul_comm _ (absR r), + rw [real_inner_smul_self_right, norm_smul, real.norm_eq_abs, ←mul_assoc ‖x‖, mul_comm _ (|r|), mul_assoc, abs_of_neg hr, neg_mul, div_neg_eq_neg_div, div_self], - exact mul_ne_zero (ne_of_lt hr) - (λ h, hx (norm_eq_zero.1 (eq_zero_of_mul_self_eq_zero h))) + exact mul_ne_zero hr.ne (mul_self_ne_zero.2 (norm_ne_zero_iff.2 hx)) +end + +lemma norm_inner_eq_norm_tfae (x y : E) : + tfae [‖⟪x, y⟫‖ = ‖x‖ * ‖y‖, + x = 0 ∨ y = (⟪x, y⟫ / ⟪x, x⟫) • x, + x = 0 ∨ ∃ r : 𝕜, y = r • x, + x = 0 ∨ y ∈ 𝕜 ∙ x] := +begin + tfae_have : 1 → 2, + { refine λ h, or_iff_not_imp_left.2 (λ hx₀, _), + have : ‖x‖ ^ 2 ≠ 0 := pow_ne_zero _ (norm_ne_zero_iff.2 hx₀), + rw [← sq_eq_sq (norm_nonneg _) (mul_nonneg (norm_nonneg _) (norm_nonneg _)), + mul_pow, ← mul_right_inj' this, eq_comm, ← sub_eq_zero, ← mul_sub] at h, + simp only [@norm_sq_eq_inner 𝕜] at h, + letI : inner_product_space.core 𝕜 E := inner_product_space.to_core, + erw [← inner_product_space.core.cauchy_schwarz_aux, + inner_product_space.core.norm_sq_eq_zero, sub_eq_zero] at h, + rw [div_eq_inv_mul, mul_smul, h, inv_smul_smul₀], + rwa [inner_self_ne_zero] }, + tfae_have : 2 → 3, from λ h, h.imp_right (λ h', ⟨_, h'⟩), + tfae_have : 3 → 1, + { rintro (rfl | ⟨r, rfl⟩); simp [inner_smul_right, norm_smul, inner_self_eq_norm_sq_to_K, + inner_self_eq_norm_mul_norm, sq, mul_left_comm] }, + tfae_have : 3 ↔ 4, by simp only [submodule.mem_span_singleton, eq_comm], + tfae_finish end +/-- +If the inner product of two vectors is equal to the product of their norms, then the two vectors +are multiples of each other. One form of the equality case for Cauchy-Schwarz. +Compare `inner_eq_norm_mul_iff`, which takes the stronger hypothesis `⟪x, y⟫ = ‖x‖ * ‖y‖`. -/ +lemma norm_inner_eq_norm_iff {x y : E} (hx₀ : x ≠ 0) (hy₀ : y ≠ 0) : + ‖⟪x, y⟫‖ = ‖x‖ * ‖y‖ ↔ ∃ (r : 𝕜), r ≠ 0 ∧ y = r • x := +calc ‖⟪x, y⟫‖ = ‖x‖ * ‖y‖ ↔ x = 0 ∨ ∃ r : 𝕜, y = r • x : + (@norm_inner_eq_norm_tfae 𝕜 _ _ _ _ x y).out 0 2 +... ↔ ∃ r : 𝕜, y = r • x : or_iff_right hx₀ +... ↔ ∃ r : 𝕜, r ≠ 0 ∧ y = r • x : + ⟨λ ⟨r, h⟩, ⟨r, λ hr₀, hy₀ $ h.symm ▸ smul_eq_zero.2 $ or.inl hr₀, h⟩, λ ⟨r, hr₀, h⟩, ⟨r, h⟩⟩ + /-- The inner product of two vectors, divided by the product of their norms, has absolute value 1 if and only if they are nonzero and one is a multiple of the other. One form of equality case for Cauchy-Schwarz. -/ -lemma abs_inner_div_norm_mul_norm_eq_one_iff (x y : E) : - abs (⟪x, y⟫ / (∥x∥ * ∥y∥)) = 1 ↔ (x ≠ 0 ∧ ∃ (r : 𝕜), r ≠ 0 ∧ y = r • x) := +lemma norm_inner_div_norm_mul_norm_eq_one_iff (x y : E) : + ‖(⟪x, y⟫ / (‖x‖ * ‖y‖))‖ = 1 ↔ (x ≠ 0 ∧ ∃ (r : 𝕜), r ≠ 0 ∧ y = r • x) := begin split, { intro h, - have hx0 : x ≠ 0, - { intro hx0, - rw [hx0, inner_zero_left, zero_div] at h, - norm_num at h, }, - refine and.intro hx0 _, - set r := ⟪x, y⟫ / (∥x∥ * ∥x∥) with hr, - use r, - set t := y - r • x with ht, - have ht0 : ⟪x, t⟫ = 0, - { rw [ht, inner_sub_right, inner_smul_right, hr], - norm_cast, - rw [←inner_self_eq_norm_mul_norm, inner_self_re_to_K, - div_mul_cancel _ (λ h, hx0 (inner_self_eq_zero.1 h)), sub_self] }, - replace h : ∥r • x∥ / ∥t + r • x∥ = 1, - { rw [←sub_add_cancel y (r • x), ←ht, inner_add_right, ht0, zero_add, inner_smul_right, - is_R_or_C.abs_div, is_R_or_C.abs_mul, ←inner_self_re_abs, - inner_self_eq_norm_mul_norm] at h, - norm_cast at h, - rwa [_root_.abs_mul, abs_norm_eq_norm, abs_norm_eq_norm, ←mul_assoc, mul_comm, - mul_div_mul_left _ _ (λ h, hx0 (norm_eq_zero.1 h)), ←is_R_or_C.norm_eq_abs, - ←norm_smul] at h }, - have hr0 : r ≠ 0, - { intro hr0, - rw [hr0, zero_smul, norm_zero, zero_div] at h, - norm_num at h }, - refine and.intro hr0 _, - have h2 : ∥r • x∥ ^ 2 = ∥t + r • x∥ ^ 2, - { rw [eq_of_div_eq_one h] }, - replace h2 : ⟪r • x, r • x⟫ = ⟪t, t⟫ + ⟪t, r • x⟫ + ⟪r • x, t⟫ + ⟪r • x, r • x⟫, - { rw [sq, sq, ←inner_self_eq_norm_mul_norm, ←inner_self_eq_norm_mul_norm ] at h2, - have h2' := congr_arg (λ z : ℝ, (z : 𝕜)) h2, - simp_rw [inner_self_re_to_K, inner_add_add_self] at h2', - exact h2' }, - conv at h2 in ⟪r • x, t⟫ { rw [inner_smul_left, ht0, mul_zero] }, - symmetry' at h2, - have h₁ : ⟪t, r • x⟫ = 0 := by { rw [inner_smul_right, ←inner_conj_sym, ht0], simp }, - rw [add_zero, h₁, add_left_eq_self, add_zero, inner_self_eq_zero] at h2, - rw h2 at ht, - exact eq_of_sub_eq_zero ht.symm }, - { intro h, - rcases h with ⟨hx, ⟨r, ⟨hr, hy⟩⟩⟩, - rw [hy, is_R_or_C.abs_div], - norm_cast, - rw [_root_.abs_mul, abs_norm_eq_norm, abs_norm_eq_norm], - exact abs_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul hx hr } + have hx₀ : x ≠ 0 := λ h₀, by simpa [h₀] using h, + have hy₀ : y ≠ 0 := λ h₀, by simpa [h₀] using h, + refine ⟨hx₀, (norm_inner_eq_norm_iff hx₀ hy₀).1 $ eq_of_div_eq_one _⟩, + simpa using h }, + { rintro ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩, + simp only [norm_div, norm_mul, norm_of_real, abs_norm], + exact norm_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_ne_zero_mul hx hr } end /-- The inner product of two vectors, divided by the product of their norms, has absolute value 1 if and only if they are nonzero and one is a multiple of the other. One form of equality case for Cauchy-Schwarz. -/ lemma abs_real_inner_div_norm_mul_norm_eq_one_iff (x y : F) : - absR (⟪x, y⟫_ℝ / (∥x∥ * ∥y∥)) = 1 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r ≠ 0 ∧ y = r • x) := + |⟪x, y⟫_ℝ / (‖x‖ * ‖y‖)| = 1 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r ≠ 0 ∧ y = r • x) := +@norm_inner_div_norm_mul_norm_eq_one_iff ℝ F _ _ _ x y + +lemma inner_eq_norm_mul_iff_div {x y : E} (h₀ : x ≠ 0) : + ⟪x, y⟫ = (‖x‖ : 𝕜) * ‖y‖ ↔ (‖y‖ / ‖x‖ : 𝕜) • x = y := begin - have := @abs_inner_div_norm_mul_norm_eq_one_iff ℝ F _ _ x y, - simpa [coe_real_eq_id] using this, + have h₀' := h₀, + rw [← norm_ne_zero_iff, ne.def, ← @of_real_eq_zero 𝕜] at h₀', + split; intro h, + { have : x = 0 ∨ y = (⟪x, y⟫ / ⟪x, x⟫ : 𝕜) • x := + ((@norm_inner_eq_norm_tfae 𝕜 _ _ _ _ x y).out 0 1).1 (by simp [h]), + rw [this.resolve_left h₀, h], + simp [norm_smul, inner_self_norm_to_K, h₀'] }, + { conv_lhs { rw [← h, inner_smul_right, inner_self_eq_norm_sq_to_K] }, + field_simp [sq, mul_left_comm] } end -/-- -If the inner product of two vectors is equal to the product of their norms, then the two vectors -are multiples of each other. One form of the equality case for Cauchy-Schwarz. -Compare `inner_eq_norm_mul_iff`, which takes the stronger hypothesis `⟪x, y⟫ = ∥x∥ * ∥y∥`. -/ -lemma abs_inner_eq_norm_iff (x y : E) (hx0 : x ≠ 0) (hy0 : y ≠ 0): - abs ⟪x, y⟫ = ∥x∥ * ∥y∥ ↔ ∃ (r : 𝕜), r ≠ 0 ∧ y = r • x := +/-- If the inner product of two vectors is equal to the product of their norms (i.e., +`⟪x, y⟫ = ‖x‖ * ‖y‖`), then the two vectors are nonnegative real multiples of each other. One form +of the equality case for Cauchy-Schwarz. +Compare `norm_inner_eq_norm_iff`, which takes the weaker hypothesis `abs ⟪x, y⟫ = ‖x‖ * ‖y‖`. -/ +lemma inner_eq_norm_mul_iff {x y : E} : + ⟪x, y⟫ = (‖x‖ : 𝕜) * ‖y‖ ↔ (‖y‖ : 𝕜) • x = (‖x‖ : 𝕜) • y := begin - have hx0' : ∥x∥ ≠ 0 := by simp [norm_eq_zero, hx0], - have hy0' : ∥y∥ ≠ 0 := by simp [norm_eq_zero, hy0], - have hxy0 : ∥x∥ * ∥y∥ ≠ 0 := by simp [hx0', hy0'], - have h₁ : abs ⟪x, y⟫ = ∥x∥ * ∥y∥ ↔ abs (⟪x, y⟫ / (∥x∥ * ∥y∥)) = 1, - { refine ⟨_ ,_⟩, - { intro h, - norm_cast, - rw [is_R_or_C.abs_div, h, abs_of_real, _root_.abs_mul, abs_norm_eq_norm, abs_norm_eq_norm], - exact div_self hxy0 }, - { intro h, - norm_cast at h, - rwa [is_R_or_C.abs_div, abs_of_real, _root_.abs_mul, abs_norm_eq_norm, abs_norm_eq_norm, - div_eq_one_iff_eq hxy0] at h } }, - rw [h₁, abs_inner_div_norm_mul_norm_eq_one_iff x y], - simp [hx0] + rcases eq_or_ne x 0 with (rfl | h₀), + { simp }, + { rw [inner_eq_norm_mul_iff_div h₀, div_eq_inv_mul, mul_smul, inv_smul_eq_iff₀], + rwa [ne.def, of_real_eq_zero, norm_eq_zero] }, end +/-- If the inner product of two vectors is equal to the product of their norms (i.e., +`⟪x, y⟫ = ‖x‖ * ‖y‖`), then the two vectors are nonnegative real multiples of each other. One form +of the equality case for Cauchy-Schwarz. +Compare `norm_inner_eq_norm_iff`, which takes the weaker hypothesis `abs ⟪x, y⟫ = ‖x‖ * ‖y‖`. -/ +lemma inner_eq_norm_mul_iff_real {x y : F} : ⟪x, y⟫_ℝ = ‖x‖ * ‖y‖ ↔ ‖y‖ • x = ‖x‖ • y := +inner_eq_norm_mul_iff + /-- The inner product of two vectors, divided by the product of their norms, has value 1 if and only if they are nonzero and one is a positive multiple of the other. -/ lemma real_inner_div_norm_mul_norm_eq_one_iff (x y : F) : - ⟪x, y⟫_ℝ / (∥x∥ * ∥y∥) = 1 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), 0 < r ∧ y = r • x) := + ⟪x, y⟫_ℝ / (‖x‖ * ‖y‖) = 1 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), 0 < r ∧ y = r • x) := begin split, { intro h, - have ha := h, - apply_fun absR at ha, - norm_num at ha, - rcases (abs_real_inner_div_norm_mul_norm_eq_one_iff x y).1 ha with ⟨hx, ⟨r, ⟨hr, hy⟩⟩⟩, - use [hx, r], - refine and.intro _ hy, - by_contradiction hrneg, - rw hy at h, - rw real_inner_div_norm_mul_norm_eq_neg_one_of_ne_zero_of_neg_mul hx - (lt_of_le_of_ne (le_of_not_lt hrneg) hr) at h, - norm_num at h }, - { intro h, - rcases h with ⟨hx, ⟨r, ⟨hr, hy⟩⟩⟩, - rw hy, + have hx₀ : x ≠ 0 := λ h₀, by simpa [h₀] using h, + have hy₀ : y ≠ 0 := λ h₀, by simpa [h₀] using h, + refine ⟨hx₀, ‖y‖ / ‖x‖, div_pos (norm_pos_iff.2 hy₀) (norm_pos_iff.2 hx₀), _⟩, + exact ((inner_eq_norm_mul_iff_div hx₀).1 (eq_of_div_eq_one h)).symm }, + { rintro ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩, exact real_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_pos_mul hx hr } end @@ -1514,94 +1485,29 @@ end norms, has value -1 if and only if they are nonzero and one is a negative multiple of the other. -/ lemma real_inner_div_norm_mul_norm_eq_neg_one_iff (x y : F) : - ⟪x, y⟫_ℝ / (∥x∥ * ∥y∥) = -1 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r < 0 ∧ y = r • x) := + ⟪x, y⟫_ℝ / (‖x‖ * ‖y‖) = -1 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r < 0 ∧ y = r • x) := begin - split, - { intro h, - have ha := h, - apply_fun absR at ha, - norm_num at ha, - rcases (abs_real_inner_div_norm_mul_norm_eq_one_iff x y).1 ha with ⟨hx, ⟨r, ⟨hr, hy⟩⟩⟩, - use [hx, r], - refine and.intro _ hy, - by_contradiction hrpos, - rw hy at h, - rw real_inner_div_norm_mul_norm_eq_one_of_ne_zero_of_pos_mul hx - (lt_of_le_of_ne (le_of_not_lt hrpos) hr.symm) at h, - norm_num at h }, - { intro h, - rcases h with ⟨hx, ⟨r, ⟨hr, hy⟩⟩⟩, - rw hy, - exact real_inner_div_norm_mul_norm_eq_neg_one_of_ne_zero_of_neg_mul hx hr } -end - -/-- If the inner product of two vectors is equal to the product of their norms (i.e., -`⟪x, y⟫ = ∥x∥ * ∥y∥`), then the two vectors are nonnegative real multiples of each other. One form -of the equality case for Cauchy-Schwarz. -Compare `abs_inner_eq_norm_iff`, which takes the weaker hypothesis `abs ⟪x, y⟫ = ∥x∥ * ∥y∥`. -/ -lemma inner_eq_norm_mul_iff {x y : E} : - ⟪x, y⟫ = (∥x∥ : 𝕜) * ∥y∥ ↔ (∥y∥ : 𝕜) • x = (∥x∥ : 𝕜) • y := -begin - by_cases h : (x = 0 ∨ y = 0), -- WLOG `x` and `y` are nonzero - { cases h; simp [h] }, - calc ⟪x, y⟫ = (∥x∥ : 𝕜) * ∥y∥ ↔ ∥x∥ * ∥y∥ = re ⟪x, y⟫ : - begin - norm_cast, - split, - { intros h', - simp [h'] }, - { have cauchy_schwarz := abs_inner_le_norm x y, - intros h', - rw h' at ⊢ cauchy_schwarz, - rwa re_eq_self_of_le } - end - ... ↔ 2 * ∥x∥ * ∥y∥ * (∥x∥ * ∥y∥ - re ⟪x, y⟫) = 0 : - by simp [h, show (2:ℝ) ≠ 0, by norm_num, sub_eq_zero] - ... ↔ ∥(∥y∥:𝕜) • x - (∥x∥:𝕜) • y∥ * ∥(∥y∥:𝕜) • x - (∥x∥:𝕜) • y∥ = 0 : - begin - simp only [norm_sub_mul_self, inner_smul_left, inner_smul_right, norm_smul, conj_of_real, - is_R_or_C.norm_eq_abs, abs_of_real, of_real_im, of_real_re, mul_re, abs_norm_eq_norm], - refine eq.congr _ rfl, - ring - end - ... ↔ (∥y∥ : 𝕜) • x = (∥x∥ : 𝕜) • y : by simp [norm_sub_eq_zero_iff] -end - -/-- If the inner product of two vectors is equal to the product of their norms (i.e., -`⟪x, y⟫ = ∥x∥ * ∥y∥`), then the two vectors are nonnegative real multiples of each other. One form -of the equality case for Cauchy-Schwarz. -Compare `abs_inner_eq_norm_iff`, which takes the weaker hypothesis `abs ⟪x, y⟫ = ∥x∥ * ∥y∥`. -/ -lemma inner_eq_norm_mul_iff_real {x y : F} : ⟪x, y⟫_ℝ = ∥x∥ * ∥y∥ ↔ ∥y∥ • x = ∥x∥ • y := -inner_eq_norm_mul_iff - -/-- An inner product space is strictly convex. We do not register this as an instance for an inner -space over `𝕜`, `is_R_or_C 𝕜`, because there is no order of the typeclass argument that does not -lead to a search of `[is_scalar_tower ℝ ?m E]` with unknown `?m`. -/ -instance inner_product_space.strict_convex_space : strict_convex_space ℝ F := -begin - refine strict_convex_space.of_norm_add (λ x y h, _), - rw [same_ray_iff_norm_smul_eq, eq_comm, ← inner_eq_norm_mul_iff_real, - real_inner_eq_norm_add_mul_self_sub_norm_mul_self_sub_norm_mul_self_div_two, h, - add_mul_self_eq, sub_sub, add_sub_add_right_eq_sub, add_sub_cancel', mul_assoc, - mul_div_cancel_left], - exact _root_.two_ne_zero + rw [← neg_eq_iff_eq_neg, ← neg_div, ← inner_neg_right, ← norm_neg y, + real_inner_div_norm_mul_norm_eq_one_iff, (@neg_surjective ℝ _).exists], + refine iff.rfl.and (exists_congr $ λ r, _), + rw [neg_pos, neg_smul, neg_inj] end /-- If the inner product of two unit vectors is `1`, then the two vectors are equal. One form of the equality case for Cauchy-Schwarz. -/ -lemma inner_eq_norm_mul_iff_of_norm_one {x y : E} (hx : ∥x∥ = 1) (hy : ∥y∥ = 1) : +lemma inner_eq_one_iff_of_norm_one {x y : E} (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) : ⟪x, y⟫ = 1 ↔ x = y := by { convert inner_eq_norm_mul_iff using 2; simp [hx, hy] } lemma inner_lt_norm_mul_iff_real {x y : F} : - ⟪x, y⟫_ℝ < ∥x∥ * ∥y∥ ↔ ∥y∥ • x ≠ ∥x∥ • y := -calc ⟪x, y⟫_ℝ < ∥x∥ * ∥y∥ - ↔ ⟪x, y⟫_ℝ ≠ ∥x∥ * ∥y∥ : ⟨ne_of_lt, lt_of_le_of_ne (real_inner_le_norm _ _)⟩ -... ↔ ∥y∥ • x ≠ ∥x∥ • y : not_congr inner_eq_norm_mul_iff_real + ⟪x, y⟫_ℝ < ‖x‖ * ‖y‖ ↔ ‖y‖ • x ≠ ‖x‖ • y := +calc ⟪x, y⟫_ℝ < ‖x‖ * ‖y‖ + ↔ ⟪x, y⟫_ℝ ≠ ‖x‖ * ‖y‖ : ⟨ne_of_lt, lt_of_le_of_ne (real_inner_le_norm _ _)⟩ +... ↔ ‖y‖ • x ≠ ‖x‖ • y : not_congr inner_eq_norm_mul_iff_real /-- If the inner product of two unit vectors is strictly less than `1`, then the two vectors are distinct. One form of the equality case for Cauchy-Schwarz. -/ -lemma inner_lt_one_iff_real_of_norm_one {x y : F} (hx : ∥x∥ = 1) (hy : ∥y∥ = 1) : +lemma inner_lt_one_iff_real_of_norm_one {x y : F} (hx : ‖x‖ = 1) (hy : ‖y‖ = 1) : ⟪x, y⟫_ℝ < 1 ↔ x ≠ y := by { convert inner_lt_norm_mul_iff_real; simp [hx, hy] } @@ -1611,7 +1517,7 @@ lemma inner_sum_smul_sum_smul_of_sum_eq_zero {ι₁ : Type*} {s₁ : finset ι (v₁ : ι₁ → F) (h₁ : ∑ i in s₁, w₁ i = 0) {ι₂ : Type*} {s₂ : finset ι₂} {w₂ : ι₂ → ℝ} (v₂ : ι₂ → F) (h₂ : ∑ i in s₂, w₂ i = 0) : ⟪(∑ i₁ in s₁, w₁ i₁ • v₁ i₁), (∑ i₂ in s₂, w₂ i₂ • v₂ i₂)⟫_ℝ = - (-∑ i₁ in s₁, ∑ i₂ in s₂, w₁ i₁ * w₂ i₂ * (∥v₁ i₁ - v₂ i₂∥ * ∥v₁ i₁ - v₂ i₂∥)) / 2 := + (-∑ i₁ in s₁, ∑ i₂ in s₂, w₁ i₁ * w₂ i₂ * (‖v₁ i₁ - v₂ i₂‖ * ‖v₁ i₁ - v₂ i₂‖)) / 2 := by simp_rw [sum_inner, inner_sum, real_inner_smul_left, real_inner_smul_right, real_inner_eq_norm_mul_self_add_norm_mul_self_sub_norm_sub_mul_self_div_two, ←div_sub_div_same, ←div_add_div_same, mul_sub_left_distrib, left_distrib, @@ -1619,72 +1525,74 @@ by simp_rw [sum_inner, inner_sum, real_inner_smul_left, real_inner_smul_right, h₁, h₂, zero_mul, mul_zero, finset.sum_const_zero, zero_add, zero_sub, finset.mul_sum, neg_div, finset.sum_div, mul_div_assoc, mul_assoc] +variables (𝕜) + /-- The inner product as a sesquilinear map. -/ def innerₛₗ : E →ₗ⋆[𝕜] E →ₗ[𝕜] 𝕜 := -linear_map.mk₂'ₛₗ _ _ (λ v w, ⟪v, w⟫) (λ _ _ _, inner_add_left) (λ _ _ _, inner_smul_left) -(λ _ _ _, inner_add_right) (λ _ _ _, inner_smul_right) +linear_map.mk₂'ₛₗ _ _ (λ v w, ⟪v, w⟫) inner_add_left (λ _ _ _, inner_smul_left _ _ _) + inner_add_right (λ _ _ _, inner_smul_right _ _ _) -@[simp] lemma innerₛₗ_apply_coe (v : E) : (innerₛₗ v : E → 𝕜) = λ w, ⟪v, w⟫ := rfl +@[simp] lemma innerₛₗ_apply_coe (v : E) : ⇑(innerₛₗ 𝕜 v) = λ w, ⟪v, w⟫ := rfl -@[simp] lemma innerₛₗ_apply (v w : E) : innerₛₗ v w = ⟪v, w⟫ := rfl +@[simp] lemma innerₛₗ_apply (v w : E) : innerₛₗ 𝕜 v w = ⟪v, w⟫ := rfl /-- The inner product as a continuous sesquilinear map. Note that `to_dual_map` (resp. `to_dual`) in `inner_product_space.dual` is a version of this given as a linear isometry (resp. linear isometric equivalence). -/ def innerSL : E →L⋆[𝕜] E →L[𝕜] 𝕜 := -linear_map.mk_continuous₂ innerₛₗ 1 +linear_map.mk_continuous₂ (innerₛₗ 𝕜) 1 (λ x y, by simp only [norm_inner_le_norm, one_mul, innerₛₗ_apply]) -@[simp] lemma innerSL_apply_coe (v : E) : (innerSL v : E → 𝕜) = λ w, ⟪v, w⟫ := rfl +@[simp] lemma innerSL_apply_coe (v : E) : ⇑(innerSL 𝕜 v) = λ w, ⟪v, w⟫ := rfl -@[simp] lemma innerSL_apply (v w : E) : innerSL v w = ⟪v, w⟫ := rfl +@[simp] lemma innerSL_apply (v w : E) : innerSL 𝕜 v w = ⟪v, w⟫ := rfl /-- `innerSL` is an isometry. Note that the associated `linear_isometry` is defined in `inner_product_space.dual` as `to_dual_map`. -/ -@[simp] lemma innerSL_apply_norm {x : E} : ∥(innerSL x : E →L[𝕜] 𝕜)∥ = ∥x∥ := +@[simp] lemma innerSL_apply_norm (x : E) : ‖innerSL 𝕜 x‖ = ‖x‖ := begin - refine le_antisymm ((innerSL x).op_norm_le_bound (norm_nonneg _) (λ y, norm_inner_le_norm _ _)) _, - cases eq_or_lt_of_le (norm_nonneg x) with h h, - { have : x = 0 := norm_eq_zero.mp (eq.symm h), - simp [this] }, - { refine (mul_le_mul_right h).mp _, - calc ∥x∥ * ∥x∥ = ∥x∥ ^ 2 : by ring - ... = re ⟪x, x⟫ : norm_sq_eq_inner _ - ... ≤ abs ⟪x, x⟫ : re_le_abs _ - ... = ∥innerSL x x∥ : by { rw [←is_R_or_C.norm_eq_abs], refl } - ... ≤ ∥innerSL x∥ * ∥x∥ : (innerSL x).le_op_norm _ } + refine le_antisymm ((innerSL 𝕜 x).op_norm_le_bound (norm_nonneg _) + (λ y, norm_inner_le_norm _ _)) _, + rcases eq_or_ne x 0 with (rfl | h), + { simp }, + { refine (mul_le_mul_right (norm_pos_iff.2 h)).mp _, + calc ‖x‖ * ‖x‖ = ‖(⟪x, x⟫ : 𝕜)‖ : by rw [← sq, inner_self_eq_norm_sq_to_K, norm_pow, + norm_of_real, abs_norm] + ... ≤ ‖innerSL 𝕜 x‖ * ‖x‖ : (innerSL 𝕜 x).le_op_norm _ } end /-- The inner product as a continuous sesquilinear map, with the two arguments flipped. -/ def innerSL_flip : E →L[𝕜] E →L⋆[𝕜] 𝕜 := @continuous_linear_map.flipₗᵢ' 𝕜 𝕜 𝕜 E E 𝕜 _ _ _ _ _ _ _ _ _ (ring_hom.id 𝕜) (star_ring_end 𝕜) _ _ - innerSL + (innerSL 𝕜) -@[simp] lemma innerSL_flip_apply {x y : E} : innerSL_flip x y = ⟪y, x⟫ := rfl +@[simp] lemma innerSL_flip_apply (x y : E) : innerSL_flip 𝕜 x y = ⟪y, x⟫ := rfl + +variables {𝕜} namespace continuous_linear_map -variables {E' : Type*} [inner_product_space 𝕜 E'] +variables {E' : Type*} [normed_add_comm_group E'] [inner_product_space 𝕜 E'] /-- Given `f : E →L[𝕜] E'`, construct the continuous sesquilinear form `λ x y, ⟪x, A y⟫`, given as a continuous linear map. -/ def to_sesq_form : (E →L[𝕜] E') →L[𝕜] E' →L⋆[𝕜] E →L[𝕜] 𝕜 := ↑((continuous_linear_map.flipₗᵢ' E E' 𝕜 (star_ring_end 𝕜) (ring_hom.id 𝕜)).to_continuous_linear_equiv) ∘L -(continuous_linear_map.compSL E E' (E' →L⋆[𝕜] 𝕜) (ring_hom.id 𝕜) (ring_hom.id 𝕜) innerSL_flip) +(continuous_linear_map.compSL E E' (E' →L⋆[𝕜] 𝕜) (ring_hom.id 𝕜) (ring_hom.id 𝕜) (innerSL_flip 𝕜)) @[simp] lemma to_sesq_form_apply_coe (f : E →L[𝕜] E') (x : E') : - to_sesq_form f x = (innerSL x).comp f := rfl + to_sesq_form f x = (innerSL 𝕜 x).comp f := rfl -lemma to_sesq_form_apply_norm_le {f : E →L[𝕜] E'} {v : E'} : ∥to_sesq_form f v∥ ≤ ∥f∥ * ∥v∥ := +lemma to_sesq_form_apply_norm_le {f : E →L[𝕜] E'} {v : E'} : ‖to_sesq_form f v‖ ≤ ‖f‖ * ‖v‖ := begin refine op_norm_le_bound _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _, intro x, - have h₁ : ∥f x∥ ≤ ∥f∥ * ∥x∥ := le_op_norm _ _, - have h₂ := @norm_inner_le_norm 𝕜 E' _ _ v (f x), - calc ∥⟪v, f x⟫∥ ≤ ∥v∥ * ∥f x∥ : h₂ - ... ≤ ∥v∥ * (∥f∥ * ∥x∥) : mul_le_mul_of_nonneg_left h₁ (norm_nonneg v) - ... = ∥f∥ * ∥v∥ * ∥x∥ : by ring, + have h₁ : ‖f x‖ ≤ ‖f‖ * ‖x‖ := le_op_norm _ _, + have h₂ := @norm_inner_le_norm 𝕜 E' _ _ _ v (f x), + calc ‖⟪v, f x⟫‖ ≤ ‖v‖ * ‖f x‖ : h₂ + ... ≤ ‖v‖ * (‖f‖ * ‖x‖) : mul_le_mul_of_nonneg_left h₁ (norm_nonneg v) + ... = ‖f‖ * ‖v‖ * ‖x‖ : by ring, end end continuous_linear_map @@ -1699,10 +1607,10 @@ instance may be not definitionally equal to some other “natural” instance. S -/ lemma is_bounded_bilinear_map_inner [normed_space ℝ E] : is_bounded_bilinear_map ℝ (λ p : E × E, ⟪p.1, p.2⟫) := -{ add_left := λ _ _ _, inner_add_left, +{ add_left := inner_add_left, smul_left := λ r x y, by simp only [← algebra_map_smul 𝕜 r x, algebra_map_eq_of_real, inner_smul_real_left], - add_right := λ _ _ _, inner_add_right, + add_right := inner_add_right, smul_right := λ r x y, by simp only [← algebra_map_smul 𝕜 r y, algebra_map_eq_of_real, inner_smul_real_right], bound := ⟨1, zero_lt_one, λ x y, @@ -1716,42 +1624,42 @@ variables {ι: Type*} (x : E) {v : ι → E} /-- Bessel's inequality for finite sums. -/ lemma orthonormal.sum_inner_products_le {s : finset ι} (hv : orthonormal 𝕜 v) : - ∑ i in s, ∥⟪v i, x⟫∥ ^ 2 ≤ ∥x∥ ^ 2 := + ∑ i in s, ‖⟪v i, x⟫‖ ^ 2 ≤ ‖x‖ ^ 2 := begin have h₂ : ∑ i in s, ∑ j in s, ⟪v i, x⟫ * ⟪x, v j⟫ * ⟪v j, v i⟫ = (∑ k in s, (⟪v k, x⟫ * ⟪x, v k⟫) : 𝕜), { exact hv.inner_left_right_finset }, - have h₃ : ∀ z : 𝕜, re (z * conj (z)) = ∥z∥ ^ 2, + have h₃ : ∀ z : 𝕜, re (z * conj (z)) = ‖z‖ ^ 2, { intro z, simp only [mul_conj, norm_sq_eq_def'], norm_cast, }, - suffices hbf: ∥x - ∑ i in s, ⟪v i, x⟫ • (v i)∥ ^ 2 = ∥x∥ ^ 2 - ∑ i in s, ∥⟪v i, x⟫∥ ^ 2, + suffices hbf: ‖x - ∑ i in s, ⟪v i, x⟫ • (v i)‖ ^ 2 = ‖x‖ ^ 2 - ∑ i in s, ‖⟪v i, x⟫‖ ^ 2, { rw [←sub_nonneg, ←hbf], simp only [norm_nonneg, pow_nonneg], }, - rw [norm_sub_sq, sub_add], - simp only [inner_product_space.norm_sq_eq_inner, inner_sum], - simp only [sum_inner, two_mul, inner_smul_right, inner_conj_sym, ←mul_assoc, h₂, ←h₃, - inner_conj_sym, add_monoid_hom.map_sum, finset.mul_sum, ←finset.sum_sub_distrib, inner_smul_left, + rw [@norm_sub_sq 𝕜, sub_add], + simp only [@inner_product_space.norm_sq_eq_inner 𝕜, inner_sum], + simp only [sum_inner, two_mul, inner_smul_right, inner_conj_symm, ←mul_assoc, h₂, ←h₃, + inner_conj_symm, add_monoid_hom.map_sum, finset.mul_sum, ←finset.sum_sub_distrib, inner_smul_left, add_sub_cancel'], end /-- Bessel's inequality. -/ lemma orthonormal.tsum_inner_products_le (hv : orthonormal 𝕜 v) : - ∑' i, ∥⟪v i, x⟫∥ ^ 2 ≤ ∥x∥ ^ 2 := + ∑' i, ‖⟪v i, x⟫‖ ^ 2 ≤ ‖x‖ ^ 2 := begin refine tsum_le_of_sum_le' _ (λ s, hv.sum_inner_products_le x), simp only [norm_nonneg, pow_nonneg] end /-- The sum defined in Bessel's inequality is summable. -/ -lemma orthonormal.inner_products_summable (hv : orthonormal 𝕜 v) : summable (λ i, ∥⟪v i, x⟫∥ ^ 2) := +lemma orthonormal.inner_products_summable (hv : orthonormal 𝕜 v) : summable (λ i, ‖⟪v i, x⟫‖ ^ 2) := begin - use ⨆ s : finset ι, ∑ i in s, ∥⟪v i, x⟫∥ ^ 2, + use ⨆ s : finset ι, ∑ i in s, ‖⟪v i, x⟫‖ ^ 2, apply has_sum_of_is_lub_of_nonneg, { intro b, simp only [norm_nonneg, pow_nonneg], }, { refine is_lub_csupr _, - use ∥x∥ ^ 2, + use ‖x‖ ^ 2, rintro y ⟨s, rfl⟩, exact hv.sum_inner_products_le x } end @@ -1760,12 +1668,12 @@ end bessels_inequality /-- A field `𝕜` satisfying `is_R_or_C` is itself a `𝕜`-inner product space. -/ instance is_R_or_C.inner_product_space : inner_product_space 𝕜 𝕜 := -{ inner := (λ x y, (conj x) * y), +{ inner := λ x y, conj x * y, norm_sq_eq_inner := λ x, by { unfold inner, rw [mul_comm, mul_conj, of_real_re, norm_sq_eq_def'] }, - conj_sym := λ x y, by simp [mul_comm], - add_left := λ x y z, by simp [inner, add_mul], - smul_left := λ x y z, by simp [inner, mul_assoc] } + conj_symm := λ x y, by simp only [mul_comm, map_mul, star_ring_end_self_apply], + add_left := λ x y z, by simp only [add_mul, map_add], + smul_left := λ x y z, by simp only [mul_assoc, smul_eq_mul, map_mul] } @[simp] lemma is_R_or_C.inner_apply (x y : 𝕜) : ⟪x, y⟫ = (conj x) * y := rfl @@ -1774,15 +1682,26 @@ instance is_R_or_C.inner_product_space : inner_product_space 𝕜 𝕜 := /-- Induced inner product on a submodule. -/ instance submodule.inner_product_space (W : submodule 𝕜 E) : inner_product_space 𝕜 W := { inner := λ x y, ⟪(x:E), (y:E)⟫, - conj_sym := λ _ _, inner_conj_sym _ _ , - norm_sq_eq_inner := λ _, norm_sq_eq_inner _, - add_left := λ _ _ _ , inner_add_left, - smul_left := λ _ _ _, inner_smul_left, + conj_symm := λ _ _, inner_conj_symm _ _, + norm_sq_eq_inner := λ x, norm_sq_eq_inner (x : E), + add_left := λ _ _ _, inner_add_left _ _ _, + smul_left := λ _ _ _, inner_smul_left _ _ _, ..submodule.normed_space W } /-- The inner product on submodules is the same as on the ambient space. -/ @[simp] lemma submodule.coe_inner (W : submodule 𝕜 E) (x y : W) : ⟪x, y⟫ = ⟪(x:E), ↑y⟫ := rfl +lemma orthonormal.cod_restrict {ι : Type*} {v : ι → E} (hv : orthonormal 𝕜 v) + (s : submodule 𝕜 E) (hvs : ∀ i, v i ∈ s) : + @orthonormal 𝕜 s _ _ _ ι (set.cod_restrict v s hvs) := +s.subtypeₗᵢ.orthonormal_comp_iff.mp hv + +lemma orthonormal_span {ι : Type*} {v : ι → E} (hv : orthonormal 𝕜 v) : + @orthonormal 𝕜 (submodule.span 𝕜 (set.range v)) _ _ _ ι + (λ i : ι, ⟨v i, submodule.subset_span (set.mem_range_self i)⟩) := +hv.cod_restrict (submodule.span 𝕜 (set.range v)) + (λ i, submodule.subset_span (set.mem_range_self i)) + /-! ### Families of mutually-orthogonal subspaces of an inner product space -/ section orthogonal_family @@ -1794,21 +1713,24 @@ open_locale direct_sum The simple way to express this concept would be as a condition on `V : ι → submodule 𝕜 E`. We We instead implement it as a condition on a family of inner product spaces each equipped with an isometric embedding into `E`, thus making it a property of morphisms rather than subobjects. +The connection to the subobject spelling is shown in `orthogonal_family_iff_pairwise`. This definition is less lightweight, but allows for better definitional properties when the inner product space structure on each of the submodules is important -- for example, when considering their Hilbert sum (`pi_lp V 2`). For example, given an orthonormal set of vectors `v : ι → E`, we have an associated orthogonal family of one-dimensional subspaces of `E`, which it is convenient to be able to discuss using `ι → 𝕜` rather than `Π i : ι, span 𝕜 (v i)`. -/ -def orthogonal_family {G : ι → Type*} [Π i, inner_product_space 𝕜 (G i)] (V : Π i, G i →ₗᵢ[𝕜] E) : +def orthogonal_family (G : ι → Type*) + [Π i, normed_add_comm_group (G i)] [Π i, inner_product_space 𝕜 (G i)] (V : Π i, G i →ₗᵢ[𝕜] E) : Prop := ∀ ⦃i j⦄, i ≠ j → ∀ v : G i, ∀ w : G j, ⟪V i v, V j w⟫ = 0 -variables {𝕜} {G : ι → Type*} [Π i, inner_product_space 𝕜 (G i)] {V : Π i, G i →ₗᵢ[𝕜] E} - (hV : orthogonal_family 𝕜 V) [dec_V : Π i (x : G i), decidable (x ≠ 0)] +variables {𝕜} {G : ι → Type*} + [Π i, normed_add_comm_group (G i)] [Π i, inner_product_space 𝕜 (G i)] {V : Π i, G i →ₗᵢ[𝕜] E} + (hV : orthogonal_family 𝕜 G V) [dec_V : Π i (x : G i), decidable (x ≠ 0)] lemma orthonormal.orthogonal_family {v : ι → E} (hv : orthonormal 𝕜 v) : - @orthogonal_family 𝕜 _ _ _ _ (λ i : ι, 𝕜) _ + orthogonal_family 𝕜 (λ i : ι, 𝕜) (λ i, linear_isometry.to_span_singleton 𝕜 E (hv.1 i)) := λ i j hij a b, by simp [inner_smul_left, inner_smul_right, hv.2 hij] @@ -1833,8 +1755,8 @@ begin simp only [dfinsupp.sum, submodule.coe_inner, finset.sum_ite_eq, ite_eq_left_iff, dfinsupp.mem_support_to_fun], split_ifs with h h, - { simp }, - { simp [of_not_not h] }, + { simp only [linear_isometry.inner_map_map] }, + { simp only [of_not_not h, inner_zero_right] }, end omit dec_ι dec_V @@ -1845,33 +1767,34 @@ calc ⟪V i v, ∑ j : ι, V j (l j)⟫ = ∑ j : ι, ⟪V i v, V j (l j)⟫: by rw inner_sum ... = ∑ j, ite (i = j) ⟪V i v, V j (l j)⟫ 0 : congr_arg (finset.sum finset.univ) $ funext $ λ j, (hV.eq_ite v (l j)) -... = ⟪v, l i⟫ : by simp +... = ⟪v, l i⟫ : by simp only [finset.sum_ite_eq, finset.mem_univ, (V i).inner_map_map, if_true] lemma orthogonal_family.inner_sum (l₁ l₂ : Π i, G i) (s : finset ι) : ⟪∑ i in s, V i (l₁ i), ∑ j in s, V j (l₂ j)⟫ = ∑ i in s, ⟪l₁ i, l₂ i⟫ := by classical; calc ⟪∑ i in s, V i (l₁ i), ∑ j in s, V j (l₂ j)⟫ - = ∑ j in s, ∑ i in s, ⟪V i (l₁ i), V j (l₂ j)⟫ : by simp [sum_inner, inner_sum] + = ∑ j in s, ∑ i in s, ⟪V i (l₁ i), V j (l₂ j)⟫ : by simp only [sum_inner, inner_sum] ... = ∑ j in s, ∑ i in s, ite (i = j) ⟪V i (l₁ i), V j (l₂ j)⟫ 0 : begin congr' with i, congr' with j, apply hV.eq_ite, end -... = ∑ i in s, ⟪l₁ i, l₂ i⟫ : by simp [finset.sum_ite_of_true] +... = ∑ i in s, ⟪l₁ i, l₂ i⟫ : by simp only [finset.sum_ite_of_true, + finset.sum_ite_eq', linear_isometry.inner_map_map, imp_self, implies_true_iff] lemma orthogonal_family.norm_sum (l : Π i, G i) (s : finset ι) : - ∥∑ i in s, V i (l i)∥ ^ 2 = ∑ i in s, ∥l i∥ ^ 2 := + ‖∑ i in s, V i (l i)‖ ^ 2 = ∑ i in s, ‖l i‖ ^ 2 := begin - have : (∥∑ i in s, V i (l i)∥ ^ 2 : 𝕜) = ∑ i in s, ∥l i∥ ^ 2, - { simp [← inner_self_eq_norm_sq_to_K, hV.inner_sum] }, + have : (‖∑ i in s, V i (l i)‖ ^ 2 : 𝕜) = ∑ i in s, ‖l i‖ ^ 2, + { simp only [← inner_self_eq_norm_sq_to_K, hV.inner_sum] }, exact_mod_cast this, end /-- The composition of an orthogonal family of subspaces with an injective function is also an orthogonal family. -/ lemma orthogonal_family.comp {γ : Type*} {f : γ → ι} (hf : function.injective f) : - orthogonal_family 𝕜 (λ g : γ, (V (f g) : G (f g) →ₗᵢ[𝕜] E)) := + orthogonal_family 𝕜 (λ g, G (f g)) (λ g, V (f g)) := λ i j hij v w, hV (hf.ne hij) v w lemma orthogonal_family.orthonormal_sigma_orthonormal {α : ι → Type*} {v_family : Π i, (α i) → G i} @@ -1880,64 +1803,64 @@ lemma orthogonal_family.orthonormal_sigma_orthonormal {α : ι → Type*} {v_fam begin split, { rintros ⟨i, v⟩, - simpa using (hv_family i).1 v }, + simpa only [linear_isometry.norm_map] using (hv_family i).left v }, rintros ⟨i, v⟩ ⟨j, w⟩ hvw, by_cases hij : i = j, { subst hij, - have : v ≠ w := by simpa using hvw, - simpa using (hv_family i).2 this }, + have : v ≠ w := λ h, by { subst h, exact hvw rfl }, + simpa only [linear_isometry.inner_map_map] using (hv_family i).2 this }, { exact hV hij (v_family i v) (v_family j w) } end include dec_ι lemma orthogonal_family.norm_sq_diff_sum (f : Π i, G i) (s₁ s₂ : finset ι) : - ∥∑ i in s₁, V i (f i) - ∑ i in s₂, V i (f i)∥ ^ 2 - = ∑ i in s₁ \ s₂, ∥f i∥ ^ 2 + ∑ i in s₂ \ s₁, ∥f i∥ ^ 2 := + ‖∑ i in s₁, V i (f i) - ∑ i in s₂, V i (f i)‖ ^ 2 + = ∑ i in s₁ \ s₂, ‖f i‖ ^ 2 + ∑ i in s₂ \ s₁, ‖f i‖ ^ 2 := begin rw [← finset.sum_sdiff_sub_sum_sdiff, sub_eq_add_neg, ← finset.sum_neg_distrib], let F : Π i, G i := λ i, if i ∈ s₁ then f i else - (f i), have hF₁ : ∀ i ∈ s₁ \ s₂, F i = f i := λ i hi, if_pos (finset.sdiff_subset _ _ hi), have hF₂ : ∀ i ∈ s₂ \ s₁, F i = - f i := λ i hi, if_neg (finset.mem_sdiff.mp hi).2, - have hF : ∀ i, ∥F i∥ = ∥f i∥, + have hF : ∀ i, ‖F i‖ = ‖f i‖, { intros i, - dsimp [F], + dsimp only [F], split_ifs; - simp, }, - have : ∥∑ i in s₁ \ s₂, V i (F i) + ∑ i in s₂ \ s₁, V i (F i)∥ ^ 2 = - ∑ i in s₁ \ s₂, ∥F i∥ ^ 2 + ∑ i in s₂ \ s₁, ∥F i∥ ^ 2, + simp only [eq_self_iff_true, norm_neg], }, + have : ‖∑ i in s₁ \ s₂, V i (F i) + ∑ i in s₂ \ s₁, V i (F i)‖ ^ 2 = + ∑ i in s₁ \ s₂, ‖F i‖ ^ 2 + ∑ i in s₂ \ s₁, ‖F i‖ ^ 2, { have hs : disjoint (s₁ \ s₂) (s₂ \ s₁) := disjoint_sdiff_sdiff, simpa only [finset.sum_union hs] using hV.norm_sum F (s₁ \ s₂ ∪ s₂ \ s₁) }, convert this using 4, { refine finset.sum_congr rfl (λ i hi, _), - simp [hF₁ i hi] }, + simp only [hF₁ i hi] }, { refine finset.sum_congr rfl (λ i hi, _), - simp [hF₂ i hi] }, - { simp [hF] }, - { simp [hF] }, + simp only [hF₂ i hi, linear_isometry.map_neg] }, + { simp only [hF] }, + { simp only [hF] }, end omit dec_ι /-- A family `f` of mutually-orthogonal elements of `E` is summable, if and only if -`(λ i, ∥f i∥ ^ 2)` is summable. -/ +`(λ i, ‖f i‖ ^ 2)` is summable. -/ lemma orthogonal_family.summable_iff_norm_sq_summable [complete_space E] (f : Π i, G i) : - summable (λ i, V i (f i)) ↔ summable (λ i, ∥f i∥ ^ 2) := + summable (λ i, V i (f i)) ↔ summable (λ i, ‖f i‖ ^ 2) := begin classical, - simp only [summable_iff_cauchy_seq_finset, normed_group.cauchy_seq_iff, real.norm_eq_abs], + simp only [summable_iff_cauchy_seq_finset, normed_add_comm_group.cauchy_seq_iff, + real.norm_eq_abs], split, { intros hf ε hε, obtain ⟨a, H⟩ := hf _ (sqrt_pos.mpr hε), use a, intros s₁ hs₁ s₂ hs₂, rw ← finset.sum_sdiff_sub_sum_sdiff, - refine (_root_.abs_sub _ _).trans_lt _, - have : ∀ i, 0 ≤ ∥f i∥ ^ 2 := λ i : ι, sq_nonneg _, + refine (abs_sub _ _).trans_lt _, + have : ∀ i, 0 ≤ ‖f i‖ ^ 2 := λ i : ι, sq_nonneg _, simp only [finset.abs_sum_of_nonneg' this], - have : ∑ i in s₁ \ s₂, ∥f i∥ ^ 2 + ∑ i in s₂ \ s₁, ∥f i∥ ^ 2 < (sqrt ε) ^ 2, - { rw ← hV.norm_sq_diff_sum, - apply sq_lt_sq, - rw [_root_.abs_of_nonneg (sqrt_nonneg _), _root_.abs_of_nonneg (norm_nonneg _)], + have : ∑ i in s₁ \ s₂, ‖f i‖ ^ 2 + ∑ i in s₂ \ s₁, ‖f i‖ ^ 2 < (sqrt ε) ^ 2, + { rw [← hV.norm_sq_diff_sum, sq_lt_sq, abs_of_nonneg (sqrt_nonneg _), + abs_of_nonneg (norm_nonneg _)], exact H s₁ hs₁ s₂ hs₂ }, have hη := sq_sqrt (le_of_lt hε), linarith }, @@ -1949,13 +1872,13 @@ begin refine (abs_lt_of_sq_lt_sq' _ (le_of_lt hε)).2, have has : a ≤ s₁ ⊓ s₂ := le_inf hs₁ hs₂, rw hV.norm_sq_diff_sum, - have Hs₁ : ∑ (x : ι) in s₁ \ s₂, ∥f x∥ ^ 2 < ε ^ 2 / 2, + have Hs₁ : ∑ (x : ι) in s₁ \ s₂, ‖f x‖ ^ 2 < ε ^ 2 / 2, { convert H _ hs₁ _ has, have : s₁ ⊓ s₂ ⊆ s₁ := finset.inter_subset_left _ _, rw [← finset.sum_sdiff this, add_tsub_cancel_right, finset.abs_sum_of_nonneg'], { simp }, { exact λ i, sq_nonneg _ } }, - have Hs₂ : ∑ (x : ι) in s₂ \ s₁, ∥f x∥ ^ 2 < ε ^ 2 /2, + have Hs₂ : ∑ (x : ι) in s₂ \ s₁, ‖f x‖ ^ 2 < ε ^ 2 /2, { convert H _ hs₂ _ has, have : s₁ ⊓ s₂ ⊆ s₂ := finset.inter_subset_right _ _, rw [← finset.sum_sdiff this, add_tsub_cancel_right, finset.abs_sum_of_nonneg'], @@ -1970,7 +1893,7 @@ omit hV elements each from a different subspace in the family is linearly independent. In particular, the pairwise intersections of elements of the family are 0. -/ lemma orthogonal_family.independent {V : ι → submodule 𝕜 E} - (hV : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) : + (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : complete_lattice.independent V := begin classical, @@ -1981,21 +1904,21 @@ begin rw linear_map.mem_ker at hv, ext i, suffices : ⟪(v i : E), v i⟫ = 0, - { simpa using this }, + { simpa only [inner_self_eq_zero] using this }, calc ⟪(v i : E), v i⟫ = ⟪(v i : E), dfinsupp.lsum ℕ (λ i, (V i).subtype) v⟫ : - by simpa [dfinsupp.sum_add_hom_apply, submodule.coe_subtype] + by simpa only [dfinsupp.sum_add_hom_apply, dfinsupp.lsum_apply_apply] using (hV.inner_right_dfinsupp v i (v i)).symm - ... = 0 : by simp [hv], + ... = 0 : by simp only [hv, inner_zero_right], end include dec_ι -lemma direct_sum.submodule_is_internal.collected_basis_orthonormal {V : ι → submodule 𝕜 E} - (hV : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) - (hV_sum : direct_sum.submodule_is_internal (λ i, V i)) +lemma direct_sum.is_internal.collected_basis_orthonormal {V : ι → submodule 𝕜 E} + (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) + (hV_sum : direct_sum.is_internal (λ i, V i)) {α : ι → Type*} {v_family : Π i, basis (α i) 𝕜 (V i)} (hv_family : ∀ i, orthonormal 𝕜 (v_family i)) : orthonormal 𝕜 (hV_sum.collected_basis v_family) := -by simpa using hV.orthonormal_sigma_orthonormal hv_family +by simpa only [hV_sum.collected_basis_coe] using hV.orthonormal_sigma_orthonormal hv_family end orthogonal_family @@ -2017,13 +1940,13 @@ proof to obtain a real inner product space structure from a given `𝕜`-inner p structure. -/ def inner_product_space.is_R_or_C_to_real : inner_product_space ℝ E := { norm_sq_eq_inner := norm_sq_eq_inner, - conj_sym := λ x y, inner_re_symm, + conj_symm := λ x y, inner_re_symm _ _, add_left := λ x y z, by { change re ⟪x + y, z⟫ = re ⟪x, z⟫ + re ⟪y, z⟫, - simp [inner_add_left] }, + simp only [inner_add_left, map_add] }, smul_left := λ x y r, by { change re ⟪(r : 𝕜) • x, y⟫ = r * re ⟪x, y⟫, - simp [inner_smul_left] }, + simp only [inner_smul_left, conj_of_real, of_real_mul_re] }, ..has_inner.is_R_or_C_to_real 𝕜 E, ..normed_space.restrict_scalars ℝ 𝕜 E } @@ -2039,9 +1962,19 @@ by simp [real_inner_eq_re_inner, inner_smul_right] omit 𝕜 /-- A complex inner product implies a real inner product -/ -instance inner_product_space.complex_to_real [inner_product_space ℂ G] : inner_product_space ℝ G := +instance inner_product_space.complex_to_real + [normed_add_comm_group G] [inner_product_space ℂ G] : inner_product_space ℝ G := inner_product_space.is_R_or_C_to_real ℂ G +@[simp] protected lemma complex.inner (w z : ℂ) : ⟪w, z⟫_ℝ = (conj w * z).re := rfl + +/-- The inner product on an inner product space of dimension 2 can be evaluated in terms +of a complex-number representation of the space. -/ +lemma inner_map_complex [normed_add_comm_group G] [inner_product_space ℝ G] + (f : G ≃ₗᵢ[ℝ] ℂ) (x y : G) : + ⟪x, y⟫_ℝ = (conj (f x) * f y).re := +by rw [← complex.inner, f.inner_map_map] + end is_R_or_C_to_real section continuous @@ -2080,6 +2013,7 @@ lemma continuous_on.inner (hf : continuous_on f s) (hg : continuous_on g s) : continuous_on (λ t, ⟪f t, g t⟫) s := λ x hx, (hf x hx).inner (hg x hx) +@[continuity] lemma continuous.inner (hf : continuous f) (hg : continuous g) : continuous (λ t, ⟪f t, g t⟫) := continuous_iff_continuous_at.2 $ λ x, hf.continuous_at.inner hg.continuous_at @@ -2099,235 +2033,68 @@ lemma continuous_linear_map.re_apply_inner_self_continuous (T : E →L[𝕜] E) re_clm.continuous.comp $ T.continuous.inner continuous_id lemma continuous_linear_map.re_apply_inner_self_smul (T : E →L[𝕜] E) (x : E) {c : 𝕜} : - T.re_apply_inner_self (c • x) = ∥c∥ ^ 2 * T.re_apply_inner_self x := + T.re_apply_inner_self (c • x) = ‖c‖ ^ 2 * T.re_apply_inner_self x := by simp only [continuous_linear_map.map_smul, continuous_linear_map.re_apply_inner_self_apply, inner_smul_left, inner_smul_right, ← mul_assoc, mul_conj, norm_sq_eq_def', ← smul_re, - algebra.smul_def (∥c∥ ^ 2) ⟪T x, x⟫, algebra_map_eq_of_real] + algebra.smul_def (‖c‖ ^ 2) ⟪T x, x⟫, algebra_map_eq_of_real] end re_apply_inner_self -/-! ### The orthogonal complement -/ - -section orthogonal -variables (K : submodule 𝕜 E) - -/-- The subspace of vectors orthogonal to a given subspace. -/ -def submodule.orthogonal : submodule 𝕜 E := -{ carrier := {v | ∀ u ∈ K, ⟪u, v⟫ = 0}, - zero_mem' := λ _ _, inner_zero_right, - add_mem' := λ x y hx hy u hu, by rw [inner_add_right, hx u hu, hy u hu, add_zero], - smul_mem' := λ c x hx u hu, by rw [inner_smul_right, hx u hu, mul_zero] } - -notation K`ᗮ`:1200 := submodule.orthogonal K - -/-- When a vector is in `Kᗮ`. -/ -lemma submodule.mem_orthogonal (v : E) : v ∈ Kᗮ ↔ ∀ u ∈ K, ⟪u, v⟫ = 0 := iff.rfl - -/-- When a vector is in `Kᗮ`, with the inner product the -other way round. -/ -lemma submodule.mem_orthogonal' (v : E) : v ∈ Kᗮ ↔ ∀ u ∈ K, ⟪v, u⟫ = 0 := -by simp_rw [submodule.mem_orthogonal, inner_eq_zero_sym] - -variables {K} - -/-- A vector in `K` is orthogonal to one in `Kᗮ`. -/ -lemma submodule.inner_right_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪u, v⟫ = 0 := -(K.mem_orthogonal v).1 hv u hu - -/-- A vector in `Kᗮ` is orthogonal to one in `K`. -/ -lemma submodule.inner_left_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪v, u⟫ = 0 := -by rw [inner_eq_zero_sym]; exact submodule.inner_right_of_mem_orthogonal hu hv - -/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/ -lemma inner_right_of_mem_orthogonal_singleton (u : E) {v : E} (hv : v ∈ (𝕜 ∙ u)ᗮ) : ⟪u, v⟫ = 0 := -submodule.inner_right_of_mem_orthogonal (submodule.mem_span_singleton_self u) hv - -/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/ -lemma inner_left_of_mem_orthogonal_singleton (u : E) {v : E} (hv : v ∈ (𝕜 ∙ u)ᗮ) : ⟪v, u⟫ = 0 := -submodule.inner_left_of_mem_orthogonal (submodule.mem_span_singleton_self u) hv - -/-- A vector orthogonal to `u` lies in `(𝕜 ∙ u)ᗮ`. -/ -lemma mem_orthogonal_singleton_of_inner_right (u : E) {v : E} (hv : ⟪u, v⟫ = 0) : v ∈ (𝕜 ∙ u)ᗮ := -begin - intros w hw, - rw submodule.mem_span_singleton at hw, - obtain ⟨c, rfl⟩ := hw, - simp [inner_smul_left, hv], -end - -/-- A vector orthogonal to `u` lies in `(𝕜 ∙ u)ᗮ`. -/ -lemma mem_orthogonal_singleton_of_inner_left (u : E) {v : E} (hv : ⟪v, u⟫ = 0) : v ∈ (𝕜 ∙ u)ᗮ := -mem_orthogonal_singleton_of_inner_right u $ inner_eq_zero_sym.2 hv - -variables (K) - -/-- `K` and `Kᗮ` have trivial intersection. -/ -lemma submodule.inf_orthogonal_eq_bot : K ⊓ Kᗮ = ⊥ := -begin - rw submodule.eq_bot_iff, - intros x, - rw submodule.mem_inf, - exact λ ⟨hx, ho⟩, inner_self_eq_zero.1 (ho x hx) -end - -/-- `K` and `Kᗮ` have trivial intersection. -/ -lemma submodule.orthogonal_disjoint : disjoint K Kᗮ := -by simp [disjoint_iff, K.inf_orthogonal_eq_bot] - -/-- `Kᗮ` can be characterized as the intersection of the kernels of the operations of -inner product with each of the elements of `K`. -/ -lemma orthogonal_eq_inter : Kᗮ = ⨅ v : K, (innerSL (v:E)).ker := -begin - apply le_antisymm, - { rw le_infi_iff, - rintros ⟨v, hv⟩ w hw, - simpa using hw _ hv }, - { intros v hv w hw, - simp only [submodule.mem_infi] at hv, - exact hv ⟨w, hw⟩ } -end - -/-- The orthogonal complement of any submodule `K` is closed. -/ -lemma submodule.is_closed_orthogonal : is_closed (Kᗮ : set E) := -begin - rw orthogonal_eq_inter K, - convert is_closed_Inter (λ v : K, (innerSL (v:E)).is_closed_ker), - simp -end - -/-- In a complete space, the orthogonal complement of any submodule `K` is complete. -/ -instance [complete_space E] : complete_space Kᗮ := K.is_closed_orthogonal.complete_space_coe - -variables (𝕜 E) - -/-- `submodule.orthogonal` gives a `galois_connection` between -`submodule 𝕜 E` and its `order_dual`. -/ -lemma submodule.orthogonal_gc : - @galois_connection (submodule 𝕜 E) (submodule 𝕜 E)ᵒᵈ _ _ - submodule.orthogonal submodule.orthogonal := -λ K₁ K₂, ⟨λ h v hv u hu, submodule.inner_left_of_mem_orthogonal hv (h hu), - λ h v hv u hu, submodule.inner_left_of_mem_orthogonal hv (h hu)⟩ - -variables {𝕜 E} - -/-- `submodule.orthogonal` reverses the `≤` ordering of two -subspaces. -/ -lemma submodule.orthogonal_le {K₁ K₂ : submodule 𝕜 E} (h : K₁ ≤ K₂) : K₂ᗮ ≤ K₁ᗮ := -(submodule.orthogonal_gc 𝕜 E).monotone_l h - -/-- `submodule.orthogonal.orthogonal` preserves the `≤` ordering of two -subspaces. -/ -lemma submodule.orthogonal_orthogonal_monotone {K₁ K₂ : submodule 𝕜 E} (h : K₁ ≤ K₂) : - K₁ᗮᗮ ≤ K₂ᗮᗮ := -submodule.orthogonal_le (submodule.orthogonal_le h) - -/-- `K` is contained in `Kᗮᗮ`. -/ -lemma submodule.le_orthogonal_orthogonal : K ≤ Kᗮᗮ := (submodule.orthogonal_gc 𝕜 E).le_u_l _ - -/-- The inf of two orthogonal subspaces equals the subspace orthogonal -to the sup. -/ -lemma submodule.inf_orthogonal (K₁ K₂ : submodule 𝕜 E) : K₁ᗮ ⊓ K₂ᗮ = (K₁ ⊔ K₂)ᗮ := -(submodule.orthogonal_gc 𝕜 E).l_sup.symm - -/-- The inf of an indexed family of orthogonal subspaces equals the -subspace orthogonal to the sup. -/ -lemma submodule.infi_orthogonal {ι : Type*} (K : ι → submodule 𝕜 E) : (⨅ i, (K i)ᗮ) = (supr K)ᗮ := -(submodule.orthogonal_gc 𝕜 E).l_supr.symm - -/-- The inf of a set of orthogonal subspaces equals the subspace orthogonal to the sup. -/ -lemma submodule.Inf_orthogonal (s : set $ submodule 𝕜 E) : (⨅ K ∈ s, Kᗮ) = (Sup s)ᗮ := -(submodule.orthogonal_gc 𝕜 E).l_Sup.symm - -@[simp] lemma submodule.top_orthogonal_eq_bot : (⊤ : submodule 𝕜 E)ᗮ = ⊥ := -begin - ext, - rw [submodule.mem_bot, submodule.mem_orthogonal], - exact ⟨λ h, inner_self_eq_zero.mp (h x submodule.mem_top), by { rintro rfl, simp }⟩ -end - -@[simp] lemma submodule.bot_orthogonal_eq_top : (⊥ : submodule 𝕜 E)ᗮ = ⊤ := -begin - rw [← submodule.top_orthogonal_eq_bot, eq_top_iff], - exact submodule.le_orthogonal_orthogonal ⊤ -end - -@[simp] lemma submodule.orthogonal_eq_top_iff : Kᗮ = ⊤ ↔ K = ⊥ := -begin - refine ⟨_, by { rintro rfl, exact submodule.bot_orthogonal_eq_top }⟩, - intro h, - have : K ⊓ Kᗮ = ⊥ := K.orthogonal_disjoint.eq_bot, - rwa [h, inf_comm, top_inf_eq] at this -end - -end orthogonal - -/-! ### Self-adjoint operators -/ - -namespace inner_product_space - -/-- A (not necessarily bounded) operator on an inner product space is self-adjoint, if for all -`x`, `y`, we have `⟪T x, y⟫ = ⟪x, T y⟫`. -/ -def is_self_adjoint (T : E →ₗ[𝕜] E) : Prop := ∀ x y, ⟪T x, y⟫ = ⟪x, T y⟫ - -/-- An operator `T` on a `ℝ`-inner product space is self-adjoint if and only if it is -`bilin_form.is_self_adjoint` with respect to the bilinear form given by the inner product. -/ -lemma is_self_adjoint_iff_bilin_form (T : F →ₗ[ℝ] F) : - is_self_adjoint T ↔ bilin_form_of_real_inner.is_self_adjoint T := -by simp [is_self_adjoint, bilin_form.is_self_adjoint, bilin_form.is_adjoint_pair] - -lemma is_self_adjoint.conj_inner_sym {T : E →ₗ[𝕜] E} (hT : is_self_adjoint T) (x y : E) : - conj ⟪T x, y⟫ = ⟪T y, x⟫ := -by rw [hT x y, inner_conj_sym] - -@[simp] lemma is_self_adjoint.apply_clm {T : E →L[𝕜] E} (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) - (x y : E) : - ⟪T x, y⟫ = ⟪x, T y⟫ := -hT x y - -/-- For a self-adjoint operator `T`, the function `λ x, ⟪T x, x⟫` is real-valued. -/ -@[simp] lemma is_self_adjoint.coe_re_apply_inner_self_apply - {T : E →L[𝕜] E} (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) (x : E) : - (T.re_apply_inner_self x : 𝕜) = ⟪T x, x⟫ := -begin - suffices : ∃ r : ℝ, ⟪T x, x⟫ = r, - { obtain ⟨r, hr⟩ := this, - simp [hr, T.re_apply_inner_self_apply] }, - rw ← eq_conj_iff_real, - exact hT.conj_inner_sym x x -end - -/-- If a self-adjoint operator preserves a submodule, its restriction to that submodule is -self-adjoint. -/ -lemma is_self_adjoint.restrict_invariant {T : E →ₗ[𝕜] E} (hT : is_self_adjoint T) - {V : submodule 𝕜 E} (hV : ∀ v ∈ V, T v ∈ V) : - is_self_adjoint (T.restrict hV) := -λ v w, hT v w - -section complex - -variables {V : Type*} - [inner_product_space ℂ V] - -/-- A linear operator on a complex inner product space is self-adjoint precisely when -`⟪T v, v⟫_ℂ` is real for all v.-/ -lemma is_self_adjoint_iff_inner_map_self_real (T : V →ₗ[ℂ] V): - is_self_adjoint T ↔ ∀ (v : V), conj ⟪T v, v⟫_ℂ = ⟪T v, v⟫_ℂ := -begin - split, - { intros hT v, - apply is_self_adjoint.conj_inner_sym hT }, - { intros h x y, - nth_rewrite 1 ← inner_conj_sym, - nth_rewrite 1 inner_map_polarization, - simp only [star_ring_end_apply, star_div', star_sub, star_add, star_mul], - simp only [← star_ring_end_apply], - rw [h (x + y), h (x - y), h (x + complex.I • y), h (x - complex.I • y)], - simp only [complex.conj_I], - rw inner_map_polarization', - norm_num, - ring }, -end - -end complex - -end inner_product_space +namespace uniform_space.completion + +open uniform_space function + +instance {𝕜' E' : Type*} [topological_space 𝕜'] [uniform_space E'] [has_inner 𝕜' E'] : + has_inner 𝕜' (completion E') := +{ inner := curry $ (dense_inducing_coe.prod dense_inducing_coe).extend (uncurry inner) } + +@[simp] lemma inner_coe (a b : E) : + inner (a : completion E) (b : completion E) = (inner a b : 𝕜) := +(dense_inducing_coe.prod dense_inducing_coe).extend_eq + (continuous_inner : continuous (uncurry inner : E × E → 𝕜)) (a, b) + +protected lemma continuous_inner : + continuous (uncurry inner : completion E × completion E → 𝕜) := +begin + let inner' : E →+ E →+ 𝕜 := + { to_fun := λ x, (innerₛₗ 𝕜 x).to_add_monoid_hom, + map_zero' := by ext x; exact inner_zero_left _, + map_add' := λ x y, by ext z; exact inner_add_left _ _ _ }, + have : continuous (λ p : E × E, inner' p.1 p.2) := continuous_inner, + rw [completion.has_inner, uncurry_curry _], + change continuous (((dense_inducing_to_compl E).prod (dense_inducing_to_compl E)).extend + (λ p : E × E, inner' p.1 p.2)), + exact (dense_inducing_to_compl E).extend_Z_bilin (dense_inducing_to_compl E) this, +end + +protected lemma continuous.inner {α : Type*} [topological_space α] + {f g : α → completion E} (hf : continuous f) (hg : continuous g) : + continuous (λ x : α, inner (f x) (g x) : α → 𝕜) := +uniform_space.completion.continuous_inner.comp (hf.prod_mk hg : _) + +instance : inner_product_space 𝕜 (completion E) := +{ norm_sq_eq_inner := λ x, completion.induction_on x + (is_closed_eq + (continuous_norm.pow 2) + (continuous_re.comp (continuous.inner continuous_id' continuous_id'))) + (λ a, by simp only [norm_coe, inner_coe, inner_self_eq_norm_sq]), + conj_symm := λ x y, completion.induction_on₂ x y + (is_closed_eq + (continuous_conj.comp (continuous.inner continuous_snd continuous_fst)) + (continuous.inner continuous_fst continuous_snd)) + (λ a b, by simp only [inner_coe, inner_conj_symm]), + add_left := λ x y z, completion.induction_on₃ x y z + (is_closed_eq + (continuous.inner (continuous_fst.add (continuous_fst.comp continuous_snd)) + (continuous_snd.comp continuous_snd)) + ((continuous.inner continuous_fst (continuous_snd.comp continuous_snd)).add + (continuous.inner (continuous_fst.comp continuous_snd) + (continuous_snd.comp continuous_snd)))) + (λ a b c, by simp only [← coe_add, inner_coe, inner_add_left]), + smul_left := λ x y c, completion.induction_on₂ x y + (is_closed_eq + (continuous.inner (continuous_fst.const_smul c) continuous_snd) + ((continuous_mul_left _).comp (continuous.inner continuous_fst continuous_snd))) + (λ a b, by simp only [← coe_smul c a, inner_coe, inner_smul_left]) } + +end uniform_space.completion diff --git a/src/analysis/inner_product_space/calculus.lean b/src/analysis/inner_product_space/calculus.lean index 13facd861ef66..74af70e275aee 100644 --- a/src/analysis/inner_product_space/calculus.lean +++ b/src/analysis/inner_product_space/calculus.lean @@ -3,34 +3,48 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import analysis.inner_product_space.basic +import analysis.inner_product_space.pi_L2 import analysis.special_functions.sqrt /-! -# Derivative of the inner product +# Calculus in inner product spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. In this file we prove that the inner product and square of the norm in an inner space are infinitely `ℝ`-smooth. In order to state these results, we need a `normed_space ℝ E` instance. Though we can deduce this structure from `inner_product_space 𝕜 E`, this instance may be not definitionally equal to some other “natural” instance. So, we assume `[normed_space ℝ E]`. + +We also prove that functions to a `euclidean_space` are (higher) differentiable if and only if +their components are. This follows from the corresponding fact for finite product of normed spaces, +and from the equivalence of norms in finite dimensions. + +## TODO + +The last part of the file should be generalized to `pi_Lp`. -/ noncomputable theory open is_R_or_C real filter -open_locale big_operators classical topological_space +open_locale big_operators classical topology + +section deriv_inner variables {𝕜 E F : Type*} [is_R_or_C 𝕜] -variables [inner_product_space 𝕜 E] [inner_product_space ℝ F] +variables [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables [normed_add_comm_group F] [inner_product_space ℝ F] local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y -variables [normed_space ℝ E] +variables (𝕜) [normed_space ℝ E] /-- Derivative of the inner product. -/ def fderiv_inner_clm (p : E × E) : E × E →L[ℝ] 𝕜 := is_bounded_bilinear_map_inner.deriv p @[simp] lemma fderiv_inner_clm_apply (p x : E × E) : - fderiv_inner_clm p x = ⟪p.1, x.2⟫ + ⟪x.1, p.2⟫ := rfl + fderiv_inner_clm 𝕜 p x = ⟪p.1, x.2⟫ + ⟪x.1, p.2⟫ := rfl lemma cont_diff_inner {n} : cont_diff ℝ n (λ p : E × E, ⟪p.1, p.2⟫) := is_bounded_bilinear_map_inner.cont_diff @@ -42,8 +56,8 @@ cont_diff_inner.cont_diff_at lemma differentiable_inner : differentiable ℝ (λ p : E × E, ⟪p.1, p.2⟫) := is_bounded_bilinear_map_inner.differentiable_at -variables {G : Type*} [normed_group G] [normed_space ℝ G] - {f g : G → E} {f' g' : G →L[ℝ] E} {s : set G} {x : G} {n : with_top ℕ} +variables {G : Type*} [normed_add_comm_group G] [normed_space ℝ G] + {f g : G → E} {f' g' : G →L[ℝ] E} {s : set G} {x : G} {n : ℕ∞} include 𝕜 @@ -55,11 +69,11 @@ cont_diff_at_inner.comp_cont_diff_within_at x (hf.prod hg) lemma cont_diff_at.inner (hf : cont_diff_at ℝ n f x) (hg : cont_diff_at ℝ n g x) : cont_diff_at ℝ n (λ x, ⟪f x, g x⟫) x := -hf.inner hg +hf.inner 𝕜 hg lemma cont_diff_on.inner (hf : cont_diff_on ℝ n f s) (hg : cont_diff_on ℝ n g s) : cont_diff_on ℝ n (λ x, ⟪f x, g x⟫) s := -λ x hx, (hf x hx).inner (hg x hx) +λ x hx, (hf x hx).inner 𝕜 (hg x hx) lemma cont_diff.inner (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) : cont_diff ℝ n (λ x, ⟪f x, g x⟫) := @@ -67,27 +81,27 @@ cont_diff_inner.comp (hf.prod hg) lemma has_fderiv_within_at.inner (hf : has_fderiv_within_at f f' s x) (hg : has_fderiv_within_at g g' s x) : - has_fderiv_within_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm (f x, g x)).comp $ f'.prod g') s x := + has_fderiv_within_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm 𝕜 (f x, g x)).comp $ f'.prod g') s x := (is_bounded_bilinear_map_inner.has_fderiv_at (f x, g x)).comp_has_fderiv_within_at x (hf.prod hg) lemma has_strict_fderiv_at.inner (hf : has_strict_fderiv_at f f' x) (hg : has_strict_fderiv_at g g' x) : - has_strict_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm (f x, g x)).comp $ f'.prod g') x := + has_strict_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm 𝕜 (f x, g x)).comp $ f'.prod g') x := (is_bounded_bilinear_map_inner.has_strict_fderiv_at (f x, g x)).comp x (hf.prod hg) lemma has_fderiv_at.inner (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) : - has_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm (f x, g x)).comp $ f'.prod g') x := + has_fderiv_at (λ t, ⟪f t, g t⟫) ((fderiv_inner_clm 𝕜 (f x, g x)).comp $ f'.prod g') x := (is_bounded_bilinear_map_inner.has_fderiv_at (f x, g x)).comp x (hf.prod hg) lemma has_deriv_within_at.inner {f g : ℝ → E} {f' g' : E} {s : set ℝ} {x : ℝ} (hf : has_deriv_within_at f f' s x) (hg : has_deriv_within_at g g' s x) : has_deriv_within_at (λ t, ⟪f t, g t⟫) (⟪f x, g'⟫ + ⟪f', g x⟫) s x := -by simpa using (hf.has_fderiv_within_at.inner hg.has_fderiv_within_at).has_deriv_within_at +by simpa using (hf.has_fderiv_within_at.inner 𝕜 hg.has_fderiv_within_at).has_deriv_within_at lemma has_deriv_at.inner {f g : ℝ → E} {f' g' : E} {x : ℝ} : has_deriv_at f f' x → has_deriv_at g g' x → has_deriv_at (λ t, ⟪f t, g t⟫) (⟪f x, g'⟫ + ⟪f', g x⟫) x := -by simpa only [← has_deriv_within_at_univ] using has_deriv_within_at.inner +by simpa only [← has_deriv_within_at_univ] using has_deriv_within_at.inner 𝕜 lemma differentiable_within_at.inner (hf : differentiable_within_at ℝ f s x) (hg : differentiable_within_at ℝ g s x) : @@ -101,142 +115,263 @@ lemma differentiable_at.inner (hf : differentiable_at ℝ f x) (hg : differentia lemma differentiable_on.inner (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s) : differentiable_on ℝ (λ x, ⟪f x, g x⟫) s := -λ x hx, (hf x hx).inner (hg x hx) +λ x hx, (hf x hx).inner 𝕜 (hg x hx) lemma differentiable.inner (hf : differentiable ℝ f) (hg : differentiable ℝ g) : differentiable ℝ (λ x, ⟪f x, g x⟫) := -λ x, (hf x).inner (hg x) +λ x, (hf x).inner 𝕜 (hg x) lemma fderiv_inner_apply (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) (y : G) : fderiv ℝ (λ t, ⟪f t, g t⟫) x y = ⟪f x, fderiv ℝ g x y⟫ + ⟪fderiv ℝ f x y, g x⟫ := -by { rw [(hf.has_fderiv_at.inner hg.has_fderiv_at).fderiv], refl } +by { rw [(hf.has_fderiv_at.inner 𝕜 hg.has_fderiv_at).fderiv], refl } lemma deriv_inner_apply {f g : ℝ → E} {x : ℝ} (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) : deriv (λ t, ⟪f t, g t⟫) x = ⟪f x, deriv g x⟫ + ⟪deriv f x, g x⟫ := -(hf.has_deriv_at.inner hg.has_deriv_at).deriv +(hf.has_deriv_at.inner 𝕜 hg.has_deriv_at).deriv -lemma cont_diff_norm_sq : cont_diff ℝ n (λ x : E, ∥x∥ ^ 2) := +lemma cont_diff_norm_sq : cont_diff ℝ n (λ x : E, ‖x‖ ^ 2) := begin - simp only [sq, ← inner_self_eq_norm_mul_norm], - exact (re_clm : 𝕜 →L[ℝ] ℝ).cont_diff.comp (cont_diff_id.inner cont_diff_id) + simp only [sq, ← @inner_self_eq_norm_mul_norm 𝕜], + exact (re_clm : 𝕜 →L[ℝ] ℝ).cont_diff.comp (cont_diff_id.inner 𝕜 cont_diff_id) end lemma cont_diff.norm_sq (hf : cont_diff ℝ n f) : - cont_diff ℝ n (λ x, ∥f x∥ ^ 2) := -cont_diff_norm_sq.comp hf + cont_diff ℝ n (λ x, ‖f x‖ ^ 2) := +(cont_diff_norm_sq 𝕜).comp hf lemma cont_diff_within_at.norm_sq (hf : cont_diff_within_at ℝ n f s x) : - cont_diff_within_at ℝ n (λ y, ∥f y∥ ^ 2) s x := -cont_diff_norm_sq.cont_diff_at.comp_cont_diff_within_at x hf + cont_diff_within_at ℝ n (λ y, ‖f y‖ ^ 2) s x := +(cont_diff_norm_sq 𝕜).cont_diff_at.comp_cont_diff_within_at x hf lemma cont_diff_at.norm_sq (hf : cont_diff_at ℝ n f x) : - cont_diff_at ℝ n (λ y, ∥f y∥ ^ 2) x := -hf.norm_sq + cont_diff_at ℝ n (λ y, ‖f y‖ ^ 2) x := +hf.norm_sq 𝕜 lemma cont_diff_at_norm {x : E} (hx : x ≠ 0) : cont_diff_at ℝ n norm x := -have ∥id x∥ ^ 2 ≠ 0, from pow_ne_zero _ (norm_pos_iff.2 hx).ne', -by simpa only [id, sqrt_sq, norm_nonneg] using cont_diff_at_id.norm_sq.sqrt this +have ‖id x‖ ^ 2 ≠ 0, from pow_ne_zero _ (norm_pos_iff.2 hx).ne', +by simpa only [id, sqrt_sq, norm_nonneg] using (cont_diff_at_id.norm_sq 𝕜).sqrt this lemma cont_diff_at.norm (hf : cont_diff_at ℝ n f x) (h0 : f x ≠ 0) : - cont_diff_at ℝ n (λ y, ∥f y∥) x := -(cont_diff_at_norm h0).comp x hf + cont_diff_at ℝ n (λ y, ‖f y‖) x := +(cont_diff_at_norm 𝕜 h0).comp x hf lemma cont_diff_at.dist (hf : cont_diff_at ℝ n f x) (hg : cont_diff_at ℝ n g x) (hne : f x ≠ g x) : cont_diff_at ℝ n (λ y, dist (f y) (g y)) x := -by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) } +by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) } lemma cont_diff_within_at.norm (hf : cont_diff_within_at ℝ n f s x) (h0 : f x ≠ 0) : - cont_diff_within_at ℝ n (λ y, ∥f y∥) s x := -(cont_diff_at_norm h0).comp_cont_diff_within_at x hf + cont_diff_within_at ℝ n (λ y, ‖f y‖) s x := +(cont_diff_at_norm 𝕜 h0).comp_cont_diff_within_at x hf lemma cont_diff_within_at.dist (hf : cont_diff_within_at ℝ n f s x) (hg : cont_diff_within_at ℝ n g s x) (hne : f x ≠ g x) : cont_diff_within_at ℝ n (λ y, dist (f y) (g y)) s x := -by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) } +by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) } lemma cont_diff_on.norm_sq (hf : cont_diff_on ℝ n f s) : - cont_diff_on ℝ n (λ y, ∥f y∥ ^ 2) s := -(λ x hx, (hf x hx).norm_sq) + cont_diff_on ℝ n (λ y, ‖f y‖ ^ 2) s := +(λ x hx, (hf x hx).norm_sq 𝕜) lemma cont_diff_on.norm (hf : cont_diff_on ℝ n f s) (h0 : ∀ x ∈ s, f x ≠ 0) : - cont_diff_on ℝ n (λ y, ∥f y∥) s := -λ x hx, (hf x hx).norm (h0 x hx) + cont_diff_on ℝ n (λ y, ‖f y‖) s := +λ x hx, (hf x hx).norm 𝕜 (h0 x hx) lemma cont_diff_on.dist (hf : cont_diff_on ℝ n f s) (hg : cont_diff_on ℝ n g s) (hne : ∀ x ∈ s, f x ≠ g x) : cont_diff_on ℝ n (λ y, dist (f y) (g y)) s := -λ x hx, (hf x hx).dist (hg x hx) (hne x hx) +λ x hx, (hf x hx).dist 𝕜 (hg x hx) (hne x hx) lemma cont_diff.norm (hf : cont_diff ℝ n f) (h0 : ∀ x, f x ≠ 0) : - cont_diff ℝ n (λ y, ∥f y∥) := -cont_diff_iff_cont_diff_at.2 $ λ x, hf.cont_diff_at.norm (h0 x) + cont_diff ℝ n (λ y, ‖f y‖) := +cont_diff_iff_cont_diff_at.2 $ λ x, hf.cont_diff_at.norm 𝕜 (h0 x) lemma cont_diff.dist (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) (hne : ∀ x, f x ≠ g x) : cont_diff ℝ n (λ y, dist (f y) (g y)) := cont_diff_iff_cont_diff_at.2 $ - λ x, hf.cont_diff_at.dist hg.cont_diff_at (hne x) + λ x, hf.cont_diff_at.dist 𝕜 hg.cont_diff_at (hne x) omit 𝕜 lemma has_strict_fderiv_at_norm_sq (x : F) : - has_strict_fderiv_at (λ x, ∥x∥ ^ 2) (bit0 (innerSL x)) x := + has_strict_fderiv_at (λ x, ‖x‖ ^ 2) (bit0 (innerSL ℝ x)) x := begin - simp only [sq, ← inner_self_eq_norm_mul_norm], - convert (has_strict_fderiv_at_id x).inner (has_strict_fderiv_at_id x), + simp only [sq, ← @inner_self_eq_norm_mul_norm ℝ], + convert (has_strict_fderiv_at_id x).inner ℝ (has_strict_fderiv_at_id x), ext y, simp [bit0, real_inner_comm], end include 𝕜 lemma differentiable_at.norm_sq (hf : differentiable_at ℝ f x) : - differentiable_at ℝ (λ y, ∥f y∥ ^ 2) x := -(cont_diff_at_id.norm_sq.differentiable_at le_rfl).comp x hf + differentiable_at ℝ (λ y, ‖f y‖ ^ 2) x := +((cont_diff_at_id.norm_sq 𝕜).differentiable_at le_rfl).comp x hf lemma differentiable_at.norm (hf : differentiable_at ℝ f x) (h0 : f x ≠ 0) : - differentiable_at ℝ (λ y, ∥f y∥) x := -((cont_diff_at_norm h0).differentiable_at le_rfl).comp x hf + differentiable_at ℝ (λ y, ‖f y‖) x := +((cont_diff_at_norm 𝕜 h0).differentiable_at le_rfl).comp x hf lemma differentiable_at.dist (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) (hne : f x ≠ g x) : differentiable_at ℝ (λ y, dist (f y) (g y)) x := -by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) } +by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) } -lemma differentiable.norm_sq (hf : differentiable ℝ f) : differentiable ℝ (λ y, ∥f y∥ ^ 2) := -λ x, (hf x).norm_sq +lemma differentiable.norm_sq (hf : differentiable ℝ f) : differentiable ℝ (λ y, ‖f y‖ ^ 2) := +λ x, (hf x).norm_sq 𝕜 lemma differentiable.norm (hf : differentiable ℝ f) (h0 : ∀ x, f x ≠ 0) : - differentiable ℝ (λ y, ∥f y∥) := -λ x, (hf x).norm (h0 x) + differentiable ℝ (λ y, ‖f y‖) := +λ x, (hf x).norm 𝕜 (h0 x) lemma differentiable.dist (hf : differentiable ℝ f) (hg : differentiable ℝ g) (hne : ∀ x, f x ≠ g x) : differentiable ℝ (λ y, dist (f y) (g y)) := -λ x, (hf x).dist (hg x) (hne x) +λ x, (hf x).dist 𝕜 (hg x) (hne x) lemma differentiable_within_at.norm_sq (hf : differentiable_within_at ℝ f s x) : - differentiable_within_at ℝ (λ y, ∥f y∥ ^ 2) s x := -(cont_diff_at_id.norm_sq.differentiable_at le_rfl).comp_differentiable_within_at x hf + differentiable_within_at ℝ (λ y, ‖f y‖ ^ 2) s x := +((cont_diff_at_id.norm_sq 𝕜).differentiable_at le_rfl).comp_differentiable_within_at x hf lemma differentiable_within_at.norm (hf : differentiable_within_at ℝ f s x) (h0 : f x ≠ 0) : - differentiable_within_at ℝ (λ y, ∥f y∥) s x := -((cont_diff_at_id.norm h0).differentiable_at le_rfl).comp_differentiable_within_at x hf + differentiable_within_at ℝ (λ y, ‖f y‖) s x := +((cont_diff_at_id.norm 𝕜 h0).differentiable_at le_rfl).comp_differentiable_within_at x hf lemma differentiable_within_at.dist (hf : differentiable_within_at ℝ f s x) (hg : differentiable_within_at ℝ g s x) (hne : f x ≠ g x) : differentiable_within_at ℝ (λ y, dist (f y) (g y)) s x := -by { simp only [dist_eq_norm], exact (hf.sub hg).norm (sub_ne_zero.2 hne) } +by { simp only [dist_eq_norm], exact (hf.sub hg).norm 𝕜 (sub_ne_zero.2 hne) } lemma differentiable_on.norm_sq (hf : differentiable_on ℝ f s) : - differentiable_on ℝ (λ y, ∥f y∥ ^ 2) s := -λ x hx, (hf x hx).norm_sq + differentiable_on ℝ (λ y, ‖f y‖ ^ 2) s := +λ x hx, (hf x hx).norm_sq 𝕜 lemma differentiable_on.norm (hf : differentiable_on ℝ f s) (h0 : ∀ x ∈ s, f x ≠ 0) : - differentiable_on ℝ (λ y, ∥f y∥) s := -λ x hx, (hf x hx).norm (h0 x hx) + differentiable_on ℝ (λ y, ‖f y‖) s := +λ x hx, (hf x hx).norm 𝕜 (h0 x hx) lemma differentiable_on.dist (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s) (hne : ∀ x ∈ s, f x ≠ g x) : differentiable_on ℝ (λ y, dist (f y) (g y)) s := -λ x hx, (hf x hx).dist (hg x hx) (hne x hx) +λ x hx, (hf x hx).dist 𝕜 (hg x hx) (hne x hx) + +end deriv_inner + +section pi_like + +open continuous_linear_map + +variables {𝕜 ι H : Type*} [is_R_or_C 𝕜] [normed_add_comm_group H] [normed_space 𝕜 H] + [fintype ι] {f : H → euclidean_space 𝕜 ι} {f' : H →L[𝕜] euclidean_space 𝕜 ι} {t : set H} {y : H} + +lemma differentiable_within_at_euclidean : + differentiable_within_at 𝕜 f t y ↔ ∀ i, differentiable_within_at 𝕜 (λ x, f x i) t y := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_within_at_iff, differentiable_within_at_pi], + refl +end + +lemma differentiable_at_euclidean : + differentiable_at 𝕜 f y ↔ ∀ i, differentiable_at 𝕜 (λ x, f x i) y := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_at_iff, differentiable_at_pi], + refl +end + +lemma differentiable_on_euclidean : + differentiable_on 𝕜 f t ↔ ∀ i, differentiable_on 𝕜 (λ x, f x i) t := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_on_iff, differentiable_on_pi], + refl +end + +lemma differentiable_euclidean : + differentiable 𝕜 f ↔ ∀ i, differentiable 𝕜 (λ x, f x i) := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_differentiable_iff, differentiable_pi], + refl +end + +lemma has_strict_fderiv_at_euclidean : + has_strict_fderiv_at f f' y ↔ ∀ i, has_strict_fderiv_at (λ x, f x i) + (euclidean_space.proj i ∘L f') y := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_has_strict_fderiv_at_iff, has_strict_fderiv_at_pi'], + refl +end + +lemma has_fderiv_within_at_euclidean : + has_fderiv_within_at f f' t y ↔ ∀ i, has_fderiv_within_at (λ x, f x i) + (euclidean_space.proj i ∘L f') t y := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_has_fderiv_within_at_iff, has_fderiv_within_at_pi'], + refl +end + +lemma cont_diff_within_at_euclidean {n : ℕ∞} : + cont_diff_within_at 𝕜 n f t y ↔ ∀ i, cont_diff_within_at 𝕜 n (λ x, f x i) t y := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_within_at_iff, cont_diff_within_at_pi], + refl +end + +lemma cont_diff_at_euclidean {n : ℕ∞} : + cont_diff_at 𝕜 n f y ↔ ∀ i, cont_diff_at 𝕜 n (λ x, f x i) y := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_at_iff, cont_diff_at_pi], + refl +end + +lemma cont_diff_on_euclidean {n : ℕ∞} : + cont_diff_on 𝕜 n f t ↔ ∀ i, cont_diff_on 𝕜 n (λ x, f x i) t := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_on_iff, cont_diff_on_pi], + refl +end + +lemma cont_diff_euclidean {n : ℕ∞} : + cont_diff 𝕜 n f ↔ ∀ i, cont_diff 𝕜 n (λ x, f x i) := +begin + rw [← (euclidean_space.equiv ι 𝕜).comp_cont_diff_iff, cont_diff_pi], + refl +end + +end pi_like + +section diffeomorph_unit_ball + +open metric (hiding mem_nhds_iff) + +variables {n : ℕ∞} {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] + +lemma cont_diff_homeomorph_unit_ball : + cont_diff ℝ n $ λ (x : E), (homeomorph_unit_ball x : E) := +begin + suffices : cont_diff ℝ n (λ x, (1 + ‖x‖^2).sqrt⁻¹), { exact this.smul cont_diff_id, }, + have h : ∀ (x : E), 0 < 1 + ‖x‖ ^ 2 := λ x, by positivity, + refine cont_diff.inv _ (λ x, real.sqrt_ne_zero'.mpr (h x)), + exact (cont_diff_const.add $ cont_diff_norm_sq ℝ).sqrt (λ x, (h x).ne.symm), +end + +lemma cont_diff_on_homeomorph_unit_ball_symm + {f : E → E} (h : ∀ y (hy : y ∈ ball (0 : E) 1), f y = homeomorph_unit_ball.symm ⟨y, hy⟩) : + cont_diff_on ℝ n f $ ball 0 1 := +begin + intros y hy, + apply cont_diff_at.cont_diff_within_at, + have hf : f =ᶠ[𝓝 y] λ y, (1 - ‖(y : E)‖^2).sqrt⁻¹ • (y : E), + { rw eventually_eq_iff_exists_mem, + refine ⟨ball (0 : E) 1, mem_nhds_iff.mpr ⟨ball (0 : E) 1, set.subset.refl _, is_open_ball, hy⟩, + λ z hz, _⟩, + rw h z hz, + refl, }, + refine cont_diff_at.congr_of_eventually_eq _ hf, + suffices : cont_diff_at ℝ n (λy, (1 - ‖(y : E)‖^2).sqrt⁻¹) y, { exact this.smul cont_diff_at_id }, + have h : 0 < 1 - ‖(y : E)‖^2, by rwa [mem_ball_zero_iff, ← _root_.abs_one, ← abs_norm, + ← sq_lt_sq, one_pow, ← sub_pos] at hy, + refine cont_diff_at.inv _ (real.sqrt_ne_zero'.mpr h), + refine cont_diff_at.comp _ (cont_diff_at_sqrt h.ne.symm) _, + exact cont_diff_at_const.sub (cont_diff_norm_sq ℝ).cont_diff_at, +end + +end diffeomorph_unit_ball diff --git a/src/analysis/inner_product_space/conformal_linear_map.lean b/src/analysis/inner_product_space/conformal_linear_map.lean index d02ee93c30e53..a62d2e97b02e0 100644 --- a/src/analysis/inner_product_space/conformal_linear_map.lean +++ b/src/analysis/inner_product_space/conformal_linear_map.lean @@ -9,10 +9,15 @@ import analysis.inner_product_space.basic /-! # Conformal maps between inner product spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In an inner product space, a map is conformal iff it preserves inner products up to a scalar factor. -/ -variables {E F : Type*} [inner_product_space ℝ E] [inner_product_space ℝ F] +variables {E F : Type*} +variables [normed_add_comm_group E] [normed_add_comm_group F] +variables [inner_product_space ℝ E] [inner_product_space ℝ F] open linear_isometry continuous_linear_map open_locale real_inner_product_space diff --git a/src/analysis/inner_product_space/dual.lean b/src/analysis/inner_product_space/dual.lean index 38225668822d5..2ec353f8c15f2 100644 --- a/src/analysis/inner_product_space/dual.lean +++ b/src/analysis/inner_product_space/dual.lean @@ -10,6 +10,9 @@ import analysis.normed_space.star.basic /-! # The Fréchet-Riesz representation theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We consider an inner product space `E` over `𝕜`, which is either `ℝ` or `ℂ`. We define `to_dual_map`, a conjugate-linear isometric embedding of `E` into its dual, which maps an element `x` of the space to `λ y, ⟪x, y⟫`. @@ -42,7 +45,7 @@ namespace inner_product_space open is_R_or_C continuous_linear_map variables (𝕜 : Type*) -variables (E : Type*) [is_R_or_C 𝕜] [inner_product_space 𝕜 E] +variables (E : Type*) [is_R_or_C 𝕜] [normed_add_comm_group E] [inner_product_space 𝕜 E] local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y local postfix `†`:90 := star_ring_end _ @@ -54,36 +57,17 @@ If `E` is complete, this operation is surjective, hence a conjugate-linear isome see `to_dual`. -/ def to_dual_map : E →ₗᵢ⋆[𝕜] normed_space.dual 𝕜 E := -{ norm_map' := λ _, innerSL_apply_norm, - ..innerSL } +{ norm_map' := innerSL_apply_norm _, + ..innerSL 𝕜 } variables {E} @[simp] lemma to_dual_map_apply {x y : E} : to_dual_map 𝕜 E x y = ⟪x, y⟫ := rfl -lemma innerSL_norm [nontrivial E] : ∥(innerSL : E →L⋆[𝕜] E →L[𝕜] 𝕜)∥ = 1 := -show ∥(to_dual_map 𝕜 E).to_continuous_linear_map∥ = 1, +lemma innerSL_norm [nontrivial E] : ‖(innerSL 𝕜 : E →L⋆[𝕜] E →L[𝕜] 𝕜)‖ = 1 := +show ‖(to_dual_map 𝕜 E).to_continuous_linear_map‖ = 1, from linear_isometry.norm_to_continuous_linear_map _ -variable (𝕜) -include 𝕜 -lemma ext_inner_left {x y : E} (h : ∀ v, ⟪v, x⟫ = ⟪v, y⟫) : x = y := -begin - apply (to_dual_map 𝕜 E).map_eq_iff.mp, - ext v, - rw [to_dual_map_apply, to_dual_map_apply, ←inner_conj_sym], - nth_rewrite_rhs 0 [←inner_conj_sym], - exact congr_arg conj (h v) -end - -lemma ext_inner_right {x y : E} (h : ∀ v, ⟪x, v⟫ = ⟪y, v⟫) : x = y := -begin - refine ext_inner_left 𝕜 (λ v, _), - rw [←inner_conj_sym], - nth_rewrite_rhs 0 [←inner_conj_sym], - exact congr_arg conj (h v) -end -omit 𝕜 variable {𝕜} lemma ext_inner_left_basis {ι : Type*} {x y : E} (b : basis ι 𝕜 E) @@ -93,8 +77,8 @@ begin refine (function.injective.eq_iff continuous_linear_map.coe_injective).mp (basis.ext b _), intro i, simp only [to_dual_map_apply, continuous_linear_map.coe_coe], - rw [←inner_conj_sym], - nth_rewrite_rhs 0 [←inner_conj_sym], + rw [←inner_conj_symm], + nth_rewrite_rhs 0 [←inner_conj_symm], exact congr_arg conj (h i) end @@ -102,8 +86,8 @@ lemma ext_inner_right_basis {ι : Type*} {x y : E} (b : basis ι 𝕜 E) (h : ∀ i : ι, ⟪x, b i⟫ = ⟪y, b i⟫) : x = y := begin refine ext_inner_left_basis b (λ i, _), - rw [←inner_conj_sym], - nth_rewrite_rhs 0 [←inner_conj_sym], + rw [←inner_conj_symm], + nth_rewrite_rhs 0 [←inner_conj_symm], exact congr_arg conj (h i) end @@ -118,7 +102,7 @@ def to_dual : E ≃ₗᵢ⋆[𝕜] normed_space.dual 𝕜 E := linear_isometry_equiv.of_surjective (to_dual_map 𝕜 E) begin intros ℓ, - set Y := ker ℓ with hY, + set Y := linear_map.ker ℓ with hY, by_cases htriv : Y = ⊤, { have hℓ : ℓ = 0, { have h' := linear_map.ker_eq_top.mp htriv, @@ -133,8 +117,8 @@ begin refine ⟨((ℓ z)† / ⟪z, z⟫) • z, _⟩, ext x, have h₁ : (ℓ z) • x - (ℓ x) • z ∈ Y, - { rw [mem_ker, map_sub, map_smul, map_smul, algebra.id.smul_eq_mul, algebra.id.smul_eq_mul, - mul_comm], + { rw [linear_map.mem_ker, map_sub, continuous_linear_map.map_smul, + continuous_linear_map.map_smul, algebra.id.smul_eq_mul, algebra.id.smul_eq_mul, mul_comm], exact sub_self (ℓ x * ℓ z) }, have h₂ : (ℓ z) * ⟪z, x⟫ = (ℓ x) * ⟪z, z⟫, { have h₃ := calc @@ -144,18 +128,13 @@ begin exact sub_eq_zero.mp (eq.symm h₃) }, have h₄ := calc ⟪((ℓ z)† / ⟪z, z⟫) • z, x⟫ = (ℓ z) / ⟪z, z⟫ * ⟪z, x⟫ - : by simp [inner_smul_left, ring_hom.map_div, conj_conj] + : by simp [inner_smul_left, conj_conj] ... = (ℓ z) * ⟪z, x⟫ / ⟪z, z⟫ : by rw [←div_mul_eq_mul_div] ... = (ℓ x) * ⟪z, z⟫ / ⟪z, z⟫ : by rw [h₂] ... = ℓ x - : begin - have : ⟪z, z⟫ ≠ 0, - { change z = 0 → false at z_ne_0, - rwa ←inner_self_eq_zero at z_ne_0 }, - field_simp [this] - end, + : by field_simp [inner_self_ne_zero.2 z_ne_0], exact h₄ } end diff --git a/src/analysis/inner_product_space/euclidean_dist.lean b/src/analysis/inner_product_space/euclidean_dist.lean index 3fbd0fbeb4f4d..7cc795527ac2c 100644 --- a/src/analysis/inner_product_space/euclidean_dist.lean +++ b/src/analysis/inner_product_space/euclidean_dist.lean @@ -9,24 +9,32 @@ import analysis.inner_product_space.pi_L2 /-! # Euclidean distance on a finite dimensional space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When we define a smooth bump function on a normed space, it is useful to have a smooth distance on the space. Since the default distance is not guaranteed to be smooth, we define `to_euclidean` to be -an equivalence between a finite dimensional normed space and the standard Euclidean space of the -same dimension. Then we define `euclidean.dist x y = dist (to_euclidean x) (to_euclidean y)` and +an equivalence between a finite dimensional topological vector space and the standard Euclidean +space of the same dimension. +Then we define `euclidean.dist x y = dist (to_euclidean x) (to_euclidean y)` and provide some definitions (`euclidean.ball`, `euclidean.closed_ball`) and simple lemmas about this distance. This way we hide the usage of `to_euclidean` behind an API. -/ -open_locale topological_space +open_locale topology open set -variables {E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] +variables {E : Type*} +[add_comm_group E] [topological_space E] [topological_add_group E] [t2_space E] +[module ℝ E] [has_continuous_smul ℝ E] [finite_dimensional ℝ E] + noncomputable theory +open finite_dimensional /-- If `E` is a finite dimensional space over `ℝ`, then `to_euclidean` is a continuous `ℝ`-linear equivalence between `E` and the Euclidean space of the same dimension. -/ -def to_euclidean : E ≃L[ℝ] euclidean_space ℝ (fin $ finite_dimensional.finrank ℝ E) := +def to_euclidean : E ≃L[ℝ] euclidean_space ℝ (fin $ finrank ℝ E) := continuous_linear_equiv.of_finrank_eq finrank_euclidean_space_fin.symm namespace euclidean @@ -87,7 +95,7 @@ end lemma nhds_basis_closed_ball {x : E} : (𝓝 x).has_basis (λ r : ℝ, 0 < r) (closed_ball x) := begin - rw [to_euclidean.to_homeomorph.nhds_eq_comap], + rw [to_euclidean.to_homeomorph.nhds_eq_comap x], exact metric.nhds_basis_closed_ball.comap _ end @@ -97,7 +105,7 @@ nhds_basis_closed_ball.mem_of_mem hr lemma nhds_basis_ball {x : E} : (𝓝 x).has_basis (λ r : ℝ, 0 < r) (ball x) := begin - rw [to_euclidean.to_homeomorph.nhds_eq_comap], + rw [to_euclidean.to_homeomorph.nhds_eq_comap x], exact metric.nhds_basis_ball.comap _ end @@ -106,7 +114,9 @@ nhds_basis_ball.mem_of_mem hr end euclidean -variables {F : Type*} [normed_group F] [normed_space ℝ F] {f g : F → E} {n : with_top ℕ} +variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] + {G : Type*} [normed_add_comm_group G] [normed_space ℝ G] [finite_dimensional ℝ G] + {f g : F → G} {n : ℕ∞} lemma cont_diff.euclidean_dist (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) (h : ∀ x, f x ≠ g x) : @@ -114,6 +124,6 @@ lemma cont_diff.euclidean_dist (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) begin simp only [euclidean.dist], apply @cont_diff.dist ℝ, - exacts [(@to_euclidean E _ _ _).cont_diff.comp hf, - (@to_euclidean E _ _ _).cont_diff.comp hg, λ x, to_euclidean.injective.ne (h x)] + exacts [(@to_euclidean G _ _ _ _ _ _ _).cont_diff.comp hf, + (@to_euclidean G _ _ _ _ _ _ _).cont_diff.comp hg, λ x, to_euclidean.injective.ne (h x)] end diff --git a/src/analysis/inner_product_space/gram_schmidt_ortho.lean b/src/analysis/inner_product_space/gram_schmidt_ortho.lean index 1ec388b30788e..ad0ae5dd303c5 100644 --- a/src/analysis/inner_product_space/gram_schmidt_ortho.lean +++ b/src/analysis/inner_product_space/gram_schmidt_ortho.lean @@ -1,14 +1,18 @@ /- Copyright (c) 2022 Jiale Miao. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jiale Miao, Kevin Buzzard +Authors: Jiale Miao, Kevin Buzzard, Alexander Bentkamp -/ -import analysis.inner_product_space.projection +import analysis.inner_product_space.pi_L2 +import linear_algebra.matrix.block /-! # Gram-Schmidt Orthogonalization and Orthonormalization +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we introduce Gram-Schmidt Orthogonalization and Orthonormalization. The Gram-Schmidt process takes a set of vectors as input @@ -22,184 +26,382 @@ and outputs a set of orthogonal vectors which have the same span. - `span_gram_schmidt` : `gram_schmidt` preserves span of vectors. - `gram_schmidt_ne_zero` : - If the input of the first `n + 1` vectors of `gram_schmidt` are linearly independent, - then the output of the first `n + 1` vectors are non-zero. + If the input vectors of `gram_schmidt` are linearly independent, + then the output vectors are non-zero. +- `gram_schmidt_basis` : + The basis produced by the Gram-Schmidt process when given a basis as input. - `gram_schmidt_normed` : the normalized `gram_schmidt` (i.e each vector in `gram_schmidt_normed` has unit length.) - `gram_schmidt_orthornormal` : `gram_schmidt_normed` produces an orthornormal system of vectors. - -## TODO - Construct a version with an orthonormal basis from Gram-Schmidt process. +- `gram_schmidt_orthonormal_basis`: orthonormal basis constructed by the Gram-Schmidt process from + an indexed set of vectors of the right size -/ open_locale big_operators +open finset submodule finite_dimensional + +variables (𝕜 : Type*) {E : Type*} [is_R_or_C 𝕜] [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables {ι : Type*} [linear_order ι] [locally_finite_order_bot ι] [is_well_order ι (<)] -variables (𝕜 : Type*) {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E] +local attribute [instance] is_well_order.to_has_well_founded local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y /-- The Gram-Schmidt process takes a set of vectors as input and outputs a set of orthogonal vectors which have the same span. -/ -noncomputable def gram_schmidt (f : ℕ → E) : ℕ → E -| n := f n - ∑ i : fin n, orthogonal_projection (𝕜 ∙ gram_schmidt i) (f n) -using_well_founded {dec_tac := `[exact i.prop]} +noncomputable def gram_schmidt (f : ι → E) : ι → E +| n := f n - ∑ i : Iio n, orthogonal_projection (𝕜 ∙ gram_schmidt i) (f n) +using_well_founded { dec_tac := `[exact mem_Iio.1 i.2] } -/-- `gram_schmidt_def` turns the sum over `fin n` into a sum over `ℕ`. -/ -lemma gram_schmidt_def (f : ℕ → E) (n : ℕ) : - gram_schmidt 𝕜 f n = f n - ∑ i in finset.range n, +/-- This lemma uses `∑ i in` instead of `∑ i :`.-/ +lemma gram_schmidt_def (f : ι → E) (n : ι): + gram_schmidt 𝕜 f n = f n - ∑ i in Iio n, orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) := -begin - rw gram_schmidt, - congr' 1, - exact fin.sum_univ_eq_sum_range (λ i, - (orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) : E)) n, -end +by { rw [←sum_attach, attach_eq_univ, gram_schmidt], refl } -lemma gram_schmidt_def' (f : ℕ → E) (n : ℕ): - f n = gram_schmidt 𝕜 f n + ∑ i in finset.range n, +lemma gram_schmidt_def' (f : ι → E) (n : ι): + f n = gram_schmidt 𝕜 f n + ∑ i in Iio n, orthogonal_projection (𝕜 ∙ gram_schmidt 𝕜 f i) (f n) := -by simp only [gram_schmidt_def, sub_add_cancel] +by rw [gram_schmidt_def, sub_add_cancel] -@[simp] lemma gram_schmidt_zero (f : ℕ → E) : - gram_schmidt 𝕜 f 0 = f 0 := -by simp only [gram_schmidt, fintype.univ_of_is_empty, finset.sum_empty, sub_zero] +lemma gram_schmidt_def'' (f : ι → E) (n : ι): + f n = gram_schmidt 𝕜 f n + + ∑ i in Iio n, (⟪gram_schmidt 𝕜 f i, f n⟫ / ‖gram_schmidt 𝕜 f i‖ ^ 2) • gram_schmidt 𝕜 f i := +begin + convert gram_schmidt_def' 𝕜 f n, + ext i, + rw orthogonal_projection_singleton, +end + +@[simp] lemma gram_schmidt_zero {ι : Type*} [linear_order ι] [locally_finite_order ι] + [order_bot ι] [is_well_order ι (<)] (f : ι → E) : gram_schmidt 𝕜 f ⊥ = f ⊥ := +by rw [gram_schmidt_def, Iio_eq_Ico, finset.Ico_self, finset.sum_empty, sub_zero] /-- **Gram-Schmidt Orthogonalisation**: `gram_schmidt` produces an orthogonal system of vectors. -/ -theorem gram_schmidt_orthogonal (f : ℕ → E) {a b : ℕ} (h₀ : a ≠ b) : +theorem gram_schmidt_orthogonal (f : ι → E) {a b : ι} (h₀ : a ≠ b) : ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0 := begin - suffices : ∀ a b : ℕ, a < b → ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0, + suffices : ∀ a b : ι, a < b → ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0, { cases h₀.lt_or_lt with ha hb, { exact this _ _ ha, }, - { rw inner_eq_zero_sym, + { rw inner_eq_zero_symm, exact this _ _ hb, }, }, clear h₀ a b, intros a b h₀, - induction b using nat.strong_induction_on with b ih generalizing a, + revert a, + apply well_founded.induction (@is_well_founded.wf ι (<) _) b, + intros b ih a h₀, simp only [gram_schmidt_def 𝕜 f b, inner_sub_right, inner_sum, orthogonal_projection_singleton, inner_smul_right], - rw finset.sum_eq_single_of_mem a (finset.mem_range.mpr h₀), + rw finset.sum_eq_single_of_mem a (finset.mem_Iio.mpr h₀), { by_cases h : gram_schmidt 𝕜 f a = 0, { simp only [h, inner_zero_left, zero_div, zero_mul, sub_zero], }, { rw [← inner_self_eq_norm_sq_to_K, div_mul_cancel, sub_self], - rwa [ne.def, inner_self_eq_zero], }, }, + rwa [inner_self_ne_zero], }, }, simp_intros i hi hia only [finset.mem_range], simp only [mul_eq_zero, div_eq_zero_iff, inner_self_eq_zero], right, cases hia.lt_or_lt with hia₁ hia₂, - { rw inner_eq_zero_sym, - exact ih a h₀ i hia₁, }, - { exact ih i hi a hia₂, }, + { rw inner_eq_zero_symm, + exact ih a h₀ i hia₁ }, + { exact ih i (mem_Iio.1 hi) a hia₂ } end /-- This is another version of `gram_schmidt_orthogonal` using `pairwise` instead. -/ -theorem gram_schmidt_pairwise_orthogonal (f : ℕ → E) : +theorem gram_schmidt_pairwise_orthogonal (f : ι → E) : pairwise (λ a b, ⟪gram_schmidt 𝕜 f a, gram_schmidt 𝕜 f b⟫ = 0) := -@gram_schmidt_orthogonal 𝕜 _ _ _ f +λ a b, gram_schmidt_orthogonal 𝕜 f + +lemma gram_schmidt_inv_triangular (v : ι → E) {i j : ι} (hij : i < j) : + ⟪gram_schmidt 𝕜 v j, v i⟫ = 0 := +begin + rw gram_schmidt_def'' 𝕜 v, + simp only [inner_add_right, inner_sum, inner_smul_right], + set b : ι → E := gram_schmidt 𝕜 v, + convert zero_add (0:𝕜), + { exact gram_schmidt_orthogonal 𝕜 v hij.ne' }, + apply finset.sum_eq_zero, + rintros k hki', + have hki : k < i := by simpa using hki', + have : ⟪b j, b k⟫ = 0 := gram_schmidt_orthogonal 𝕜 v (hki.trans hij).ne', + simp [this], +end open submodule set order -/-- `gram_schmidt` preserves span of vectors. -/ -lemma span_gram_schmidt (f : ℕ → E) (c : ℕ) : +lemma mem_span_gram_schmidt (f : ι → E) {i j : ι} (hij : i ≤ j) : + f i ∈ span 𝕜 (gram_schmidt 𝕜 f '' Iic j) := +begin + rw [gram_schmidt_def' 𝕜 f i], + simp_rw orthogonal_projection_singleton, + exact submodule.add_mem _ (subset_span $ mem_image_of_mem _ hij) + (submodule.sum_mem _ $ λ k hk, smul_mem (span 𝕜 (gram_schmidt 𝕜 f '' Iic j)) _ $ + subset_span $ mem_image_of_mem (gram_schmidt 𝕜 f) $ (finset.mem_Iio.1 hk).le.trans hij), +end + +lemma gram_schmidt_mem_span (f : ι → E) : + ∀ {j i}, i ≤ j → gram_schmidt 𝕜 f i ∈ span 𝕜 (f '' Iic j) +| j := λ i hij, +begin + rw [gram_schmidt_def 𝕜 f i], + simp_rw orthogonal_projection_singleton, + refine submodule.sub_mem _ (subset_span (mem_image_of_mem _ hij)) + (submodule.sum_mem _ $ λ k hk, _), + let hkj : k < j := (finset.mem_Iio.1 hk).trans_le hij, + exact smul_mem _ _ (span_mono (image_subset f $ Iic_subset_Iic.2 hkj.le) $ + gram_schmidt_mem_span le_rfl), +end +using_well_founded { dec_tac := `[assumption] } + +lemma span_gram_schmidt_Iic (f : ι → E) (c : ι) : span 𝕜 (gram_schmidt 𝕜 f '' Iic c) = span 𝕜 (f '' Iic c) := +span_eq_span (set.image_subset_iff.2 $ λ i, gram_schmidt_mem_span _ _) $ + set.image_subset_iff.2 $ λ i, mem_span_gram_schmidt _ _ + +lemma span_gram_schmidt_Iio (f : ι → E) (c : ι) : + span 𝕜 (gram_schmidt 𝕜 f '' Iio c) = span 𝕜 (f '' Iio c) := +span_eq_span + (set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ Iic_subset_Iio.2 hi) $ + gram_schmidt_mem_span _ _ le_rfl) $ + set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ Iic_subset_Iio.2 hi) $ + mem_span_gram_schmidt _ _ le_rfl + +/-- `gram_schmidt` preserves span of vectors. -/ +lemma span_gram_schmidt (f : ι → E) : span 𝕜 (range (gram_schmidt 𝕜 f)) = span 𝕜 (range f) := +span_eq_span (range_subset_iff.2 $ λ i, span_mono (image_subset_range _ _) $ + gram_schmidt_mem_span _ _ le_rfl) $ + range_subset_iff.2 $ λ i, span_mono (image_subset_range _ _) $ mem_span_gram_schmidt _ _ le_rfl + +lemma gram_schmidt_of_orthogonal {f : ι → E} (hf : pairwise (λ i j, ⟪f i, f j⟫ = 0)) : + gram_schmidt 𝕜 f = f := begin - induction c with c hc, - { simp only [Iic, gram_schmidt_zero, le_zero_iff, set_of_eq_eq_singleton, image_singleton], }, - have h₀ : ∀ b, b ∈ finset.range c.succ → gram_schmidt 𝕜 f b ∈ span 𝕜 (f '' Iic c), - { simp_intros b hb only [finset.mem_range, nat.succ_eq_add_one], - rw ← hc, - refine subset_span _, - simp only [mem_image, mem_Iic], - refine ⟨b, by linarith, by refl⟩, }, - rw [← nat.succ_eq_succ, Iic_succ], - simp only [span_insert, image_insert_eq, hc], - apply le_antisymm, - { simp only [nat.succ_eq_succ,gram_schmidt_def 𝕜 f c.succ, orthogonal_projection_singleton, - sup_le_iff, span_singleton_le_iff_mem, le_sup_right, and_true], - apply submodule.sub_mem _ _ _, - { exact mem_sup_left (mem_span_singleton_self (f c.succ)), }, - { exact submodule.sum_mem _ (λ b hb, mem_sup_right (smul_mem _ _ (h₀ b hb))), }, }, - { rw [nat.succ_eq_succ, gram_schmidt_def' 𝕜 f c.succ], - simp only [orthogonal_projection_singleton, - sup_le_iff, span_singleton_le_iff_mem, le_sup_right, and_true], - apply submodule.add_mem _ _ _, - { exact mem_sup_left (mem_span_singleton_self (gram_schmidt 𝕜 f c.succ)), }, - { exact submodule.sum_mem _ (λ b hb, mem_sup_right (smul_mem _ _ (h₀ b hb))), }, }, -end - -/-- If the input of the first `n + 1` vectors of `gram_schmidt` are linearly independent, -then the output of the first `n + 1` vectors are non-zero. -/ -lemma gram_schmidt_ne_zero (f : ℕ → E) (n : ℕ) - (h₀ : linear_independent 𝕜 (f ∘ (coe : fin n.succ → ℕ))) : - gram_schmidt 𝕜 f n ≠ 0 := -begin - induction n with n hn, - { intro h, - simp only [gram_schmidt_zero, ne.def] at h, - exact linear_independent.ne_zero 0 h₀ (by simp only [function.comp_app, fin.coe_zero, h]), }, - { by_contra h₁, - rw nat.succ_eq_add_one at hn h₀ h₁, - have h₂ := gram_schmidt_def' 𝕜 f n.succ, - simp only [nat.succ_eq_add_one, h₁, orthogonal_projection_singleton, zero_add] at h₂, - have h₃ : f (n + 1) ∈ span 𝕜 (f '' Iic n), - { rw [h₂, ← span_gram_schmidt 𝕜 f n], - apply submodule.sum_mem _ _, - simp_intros a ha only [finset.mem_range], - apply submodule.smul_mem _ _ _, - refine subset_span _, - simp only [mem_image, mem_Iic], - exact ⟨a, by linarith, by refl⟩, }, - change linear_independent 𝕜 (f ∘ (coe : fin (n + 2) → ℕ)) at h₀, - have h₄ : ((n + 1) : fin (n + 2)) ∉ (coe : fin (n + 2) → ℕ) ⁻¹' (Iic n), - { simp only [mem_preimage, mem_Iic, not_le], - norm_cast, - rw fin.coe_coe_of_lt; - linarith, }, - apply linear_independent.not_mem_span_image h₀ h₄, - rw [image_comp, image_preimage_eq_inter_range], - simp only [function.comp_app, subtype.range_coe_subtype], - convert h₃, - { norm_cast, - refine fin.coe_coe_of_lt (by linarith), }, - { simp only [inter_eq_left_iff_subset, Iic, set_of_subset_set_of], - exact (λ a ha, by linarith), }, }, -end - -/-- If the input of `gram_schmidt` is linearly independent, then the output is non-zero. -/ -lemma gram_schmidt_ne_zero' (f : ℕ → E) (h₀ : linear_independent 𝕜 f) (n : ℕ) : + ext i, + rw gram_schmidt_def, + transitivity f i - 0, + { congr, + apply finset.sum_eq_zero, + intros j hj, + rw coe_eq_zero, + suffices : span 𝕜 (f '' set.Iic j) ⟂ 𝕜 ∙ f i, + { apply orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero, + rw mem_orthogonal_singleton_iff_inner_left, + rw ←mem_orthogonal_singleton_iff_inner_right, + exact this (gram_schmidt_mem_span 𝕜 f (le_refl j)) }, + rw is_ortho_span, + rintros u ⟨k, hk, rfl⟩ v (rfl : v = f i), + apply hf, + exact (lt_of_le_of_lt hk (finset.mem_Iio.mp hj)).ne }, + { simp }, +end + +variables {𝕜} + +lemma gram_schmidt_ne_zero_coe + {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 (f ∘ (coe : set.Iic n → ι))) : gram_schmidt 𝕜 f n ≠ 0 := -gram_schmidt_ne_zero 𝕜 f n (linear_independent.comp h₀ _ (fin.coe_injective)) +begin + by_contra h, + have h₁ : f n ∈ span 𝕜 (f '' Iio n), + { rw [← span_gram_schmidt_Iio 𝕜 f n, gram_schmidt_def' _ f, h, zero_add], + apply submodule.sum_mem _ _, + simp_intros a ha only [finset.mem_Ico], + simp only [set.mem_image, set.mem_Iio, orthogonal_projection_singleton], + apply submodule.smul_mem _ _ _, + rw finset.mem_Iio at ha, + refine subset_span ⟨a, ha, by refl⟩ }, + have h₂ : (f ∘ (coe : set.Iic n → ι)) ⟨n, le_refl n⟩ + ∈ span 𝕜 (f ∘ (coe : set.Iic n → ι) '' Iio ⟨n, le_refl n⟩), + { rw [image_comp], + convert h₁ using 3, + ext i, + simpa using @le_of_lt _ _ i n }, + apply linear_independent.not_mem_span_image h₀ _ h₂, + simp only [set.mem_Iio, lt_self_iff_false, not_false_iff] +end + +/-- If the input vectors of `gram_schmidt` are linearly independent, +then the output vectors are non-zero. -/ +lemma gram_schmidt_ne_zero {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 f) : + gram_schmidt 𝕜 f n ≠ 0 := +gram_schmidt_ne_zero_coe _ (linear_independent.comp h₀ _ subtype.coe_injective) + +/-- `gram_schmidt` produces a triangular matrix of vectors when given a basis. -/ +lemma gram_schmidt_triangular {i j : ι} (hij : i < j) (b : basis ι 𝕜 E) : + b.repr (gram_schmidt 𝕜 b i) j = 0 := +begin + have : gram_schmidt 𝕜 b i ∈ span 𝕜 (gram_schmidt 𝕜 b '' set.Iio j), + from subset_span ((set.mem_image _ _ _).2 ⟨i, hij, rfl⟩), + have : gram_schmidt 𝕜 b i ∈ span 𝕜 (b '' set.Iio j), + by rwa [← span_gram_schmidt_Iio 𝕜 b j], + have : ↑(((b.repr) (gram_schmidt 𝕜 b i)).support) ⊆ set.Iio j, + from basis.repr_support_subset_of_mem_span b (set.Iio j) this, + exact (finsupp.mem_supported' _ _).1 + ((finsupp.mem_supported 𝕜 _).2 this) j set.not_mem_Iio_self, +end + +/-- `gram_schmidt` produces linearly independent vectors when given linearly independent vectors. -/ +lemma gram_schmidt_linear_independent {f : ι → E} (h₀ : linear_independent 𝕜 f) : + linear_independent 𝕜 (gram_schmidt 𝕜 f) := +linear_independent_of_ne_zero_of_inner_eq_zero + (λ i, gram_schmidt_ne_zero _ h₀) (λ i j, gram_schmidt_orthogonal 𝕜 f) + +/-- When given a basis, `gram_schmidt` produces a basis. -/ +noncomputable def gram_schmidt_basis (b : basis ι 𝕜 E) : basis ι 𝕜 E := +basis.mk + (gram_schmidt_linear_independent b.linear_independent) + ((span_gram_schmidt 𝕜 b).trans b.span_eq).ge + +lemma coe_gram_schmidt_basis (b : basis ι 𝕜 E) : + (gram_schmidt_basis b : ι → E) = gram_schmidt 𝕜 b := basis.coe_mk _ _ + +variables (𝕜) /-- the normalized `gram_schmidt` (i.e each vector in `gram_schmidt_normed` has unit length.) -/ -noncomputable def gram_schmidt_normed (f : ℕ → E) (n : ℕ) : E := -(∥gram_schmidt 𝕜 f n∥ : 𝕜)⁻¹ • (gram_schmidt 𝕜 f n) +noncomputable def gram_schmidt_normed (f : ι → E) (n : ι) : E := +(‖gram_schmidt 𝕜 f n‖ : 𝕜)⁻¹ • (gram_schmidt 𝕜 f n) -lemma gram_schmidt_normed_unit_length (f : ℕ → E) (n : ℕ) - (h₀ : linear_independent 𝕜 (f ∘ (coe : fin n.succ → ℕ))) : - ∥gram_schmidt_normed 𝕜 f n∥ = 1 := -by simp only [gram_schmidt_ne_zero 𝕜 f n h₀, - gram_schmidt_normed, norm_smul_inv_norm, ne.def, not_false_iff] +variables {𝕜} -lemma gram_schmidt_normed_unit_length' (f : ℕ → E) (n : ℕ) - (h₀ : linear_independent 𝕜 f) : - ∥gram_schmidt_normed 𝕜 f n∥ = 1 := -by simp only [gram_schmidt_ne_zero' 𝕜 f h₀, +lemma gram_schmidt_normed_unit_length_coe + {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 (f ∘ (coe : set.Iic n → ι))) : + ‖gram_schmidt_normed 𝕜 f n‖ = 1 := +by simp only [gram_schmidt_ne_zero_coe n h₀, gram_schmidt_normed, norm_smul_inv_norm, ne.def, not_false_iff] +lemma gram_schmidt_normed_unit_length {f : ι → E} (n : ι) (h₀ : linear_independent 𝕜 f) : + ‖gram_schmidt_normed 𝕜 f n‖ = 1 := +gram_schmidt_normed_unit_length_coe _ (linear_independent.comp h₀ _ subtype.coe_injective) + +lemma gram_schmidt_normed_unit_length' {f : ι → E} {n : ι} (hn : gram_schmidt_normed 𝕜 f n ≠ 0) : + ‖gram_schmidt_normed 𝕜 f n‖ = 1 := +begin + rw gram_schmidt_normed at *, + rw [norm_smul_inv_norm], + simpa using hn, +end + /-- **Gram-Schmidt Orthonormalization**: -`gram_schmidt_normed` produces an orthornormal system of vectors. -/ -theorem gram_schmidt_orthonormal (f : ℕ → E) (h₀ : linear_independent 𝕜 f) : +`gram_schmidt_normed` applied to a linearly independent set of vectors produces an orthornormal +system of vectors. -/ +theorem gram_schmidt_orthonormal {f : ι → E} (h₀ : linear_independent 𝕜 f) : orthonormal 𝕜 (gram_schmidt_normed 𝕜 f) := begin unfold orthonormal, split, - { simp only [gram_schmidt_normed_unit_length', h₀, forall_const], }, + { simp only [gram_schmidt_normed_unit_length, h₀, eq_self_iff_true, implies_true_iff], }, { intros i j hij, simp only [gram_schmidt_normed, inner_smul_left, inner_smul_right, is_R_or_C.conj_inv, is_R_or_C.conj_of_real, mul_eq_zero, inv_eq_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero], repeat { right }, - exact gram_schmidt_orthogonal 𝕜 f hij, }, + exact gram_schmidt_orthogonal 𝕜 f hij } end + +/-- **Gram-Schmidt Orthonormalization**: +`gram_schmidt_normed` produces an orthornormal system of vectors after removing the vectors which +become zero in the process. -/ +lemma gram_schmidt_orthonormal' (f : ι → E) : + orthonormal 𝕜 (λ i : {i | gram_schmidt_normed 𝕜 f i ≠ 0}, gram_schmidt_normed 𝕜 f i) := +begin + refine ⟨λ i, gram_schmidt_normed_unit_length' i.prop, _⟩, + rintros i j (hij : ¬ _), + rw subtype.ext_iff at hij, + simp [gram_schmidt_normed, inner_smul_left, inner_smul_right, gram_schmidt_orthogonal 𝕜 f hij], +end + +lemma span_gram_schmidt_normed (f : ι → E) (s : set ι) : + span 𝕜 (gram_schmidt_normed 𝕜 f '' s) = span 𝕜 (gram_schmidt 𝕜 f '' s) := +begin + refine span_eq_span (set.image_subset_iff.2 $ λ i hi, smul_mem _ _ $ subset_span $ + mem_image_of_mem _ hi) + (set.image_subset_iff.2 $ λ i hi, span_mono (image_subset _ $ singleton_subset_set_iff.2 hi) _), + simp only [coe_singleton, set.image_singleton], + by_cases h : gram_schmidt 𝕜 f i = 0, + { simp [h] }, + { refine mem_span_singleton.2 ⟨‖gram_schmidt 𝕜 f i‖, smul_inv_smul₀ _ _⟩, + exact_mod_cast (norm_ne_zero_iff.2 h) } +end + +lemma span_gram_schmidt_normed_range (f : ι → E) : + span 𝕜 (range (gram_schmidt_normed 𝕜 f)) = span 𝕜 (range (gram_schmidt 𝕜 f)) := +by simpa only [image_univ.symm] using span_gram_schmidt_normed f univ + +section orthonormal_basis +variables [fintype ι] [finite_dimensional 𝕜 E] (h : finrank 𝕜 E = fintype.card ι) (f : ι → E) +include h + +/-- Given an indexed family `f : ι → E` of vectors in an inner product space `E`, for which the +size of the index set is the dimension of `E`, produce an orthonormal basis for `E` which agrees +with the orthonormal set produced by the Gram-Schmidt orthonormalization process on the elements of +`ι` for which this process gives a nonzero number. -/ +noncomputable def gram_schmidt_orthonormal_basis : orthonormal_basis ι 𝕜 E := +((gram_schmidt_orthonormal' f).exists_orthonormal_basis_extension_of_card_eq h).some + +lemma gram_schmidt_orthonormal_basis_apply {f : ι → E} {i : ι} + (hi : gram_schmidt_normed 𝕜 f i ≠ 0) : + gram_schmidt_orthonormal_basis h f i = gram_schmidt_normed 𝕜 f i := +((gram_schmidt_orthonormal' f).exists_orthonormal_basis_extension_of_card_eq h).some_spec i hi + +lemma gram_schmidt_orthonormal_basis_apply_of_orthogonal {f : ι → E} + (hf : pairwise (λ i j, ⟪f i, f j⟫ = 0)) {i : ι} (hi : f i ≠ 0) : + gram_schmidt_orthonormal_basis h f i = (‖f i‖⁻¹ : 𝕜) • f i := +begin + have H : gram_schmidt_normed 𝕜 f i = (‖f i‖⁻¹ : 𝕜) • f i, + { rw [gram_schmidt_normed, gram_schmidt_of_orthogonal 𝕜 hf] }, + rw [gram_schmidt_orthonormal_basis_apply h, H], + simpa [H] using hi, +end + +lemma inner_gram_schmidt_orthonormal_basis_eq_zero {f : ι → E} {i : ι} + (hi : gram_schmidt_normed 𝕜 f i = 0) (j : ι) : + ⟪gram_schmidt_orthonormal_basis h f i, f j⟫ = 0 := +begin + rw ←mem_orthogonal_singleton_iff_inner_right, + suffices : span 𝕜 (gram_schmidt_normed 𝕜 f '' Iic j) ⟂ 𝕜 ∙ gram_schmidt_orthonormal_basis h f i, + { apply this, + rw span_gram_schmidt_normed, + exact mem_span_gram_schmidt 𝕜 f le_rfl }, + rw is_ortho_span, + rintros u ⟨k, hk, rfl⟩ v (rfl : v = _), + by_cases hk : gram_schmidt_normed 𝕜 f k = 0, + { rw [hk, inner_zero_left] }, + rw ← gram_schmidt_orthonormal_basis_apply h hk, + have : k ≠ i, + { rintros rfl, + exact hk hi }, + exact (gram_schmidt_orthonormal_basis h f).orthonormal.2 this, +end + +lemma gram_schmidt_orthonormal_basis_inv_triangular {i j : ι} (hij : i < j) : + ⟪gram_schmidt_orthonormal_basis h f j, f i⟫ = 0 := +begin + by_cases hi : gram_schmidt_normed 𝕜 f j = 0, + { rw inner_gram_schmidt_orthonormal_basis_eq_zero h hi }, + { simp [gram_schmidt_orthonormal_basis_apply h hi, gram_schmidt_normed, inner_smul_left, + gram_schmidt_inv_triangular 𝕜 f hij] } +end + +lemma gram_schmidt_orthonormal_basis_inv_triangular' {i j : ι} (hij : i < j) : + (gram_schmidt_orthonormal_basis h f).repr (f i) j = 0 := +by simpa [orthonormal_basis.repr_apply_apply] + using gram_schmidt_orthonormal_basis_inv_triangular h f hij + +/-- Given an indexed family `f : ι → E` of vectors in an inner product space `E`, for which the +size of the index set is the dimension of `E`, the matrix of coefficients of `f` with respect to the +orthonormal basis `gram_schmidt_orthonormal_basis` constructed from `f` is upper-triangular. -/ +lemma gram_schmidt_orthonormal_basis_inv_block_triangular : + ((gram_schmidt_orthonormal_basis h f).to_basis.to_matrix f).block_triangular id := +λ i j, gram_schmidt_orthonormal_basis_inv_triangular' h f + +lemma gram_schmidt_orthonormal_basis_det : + (gram_schmidt_orthonormal_basis h f).to_basis.det f = + ∏ i, ⟪gram_schmidt_orthonormal_basis h f i, f i⟫ := +begin + convert matrix.det_of_upper_triangular (gram_schmidt_orthonormal_basis_inv_block_triangular h f), + ext i, + exact ((gram_schmidt_orthonormal_basis h f).repr_apply_apply (f i) i).symm, +end + +end orthonormal_basis diff --git a/src/analysis/inner_product_space/l2_space.lean b/src/analysis/inner_product_space/l2_space.lean index 93269208a2498..10d087817b0ce 100644 --- a/src/analysis/inner_product_space/l2_space.lean +++ b/src/analysis/inner_product_space/l2_space.lean @@ -5,16 +5,23 @@ Authors: Heather Macbeth -/ import analysis.inner_product_space.projection import analysis.normed_space.lp_space +import analysis.inner_product_space.pi_L2 /-! # Hilbert sum of a family of inner product spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a family `(G : ι → Type*) [Π i, inner_product_space 𝕜 (G i)]` of inner product spaces, this file equips `lp G 2` with an inner product space structure, where `lp G 2` consists of those -dependent functions `f : Π i, G i` for which `∑' i, ∥f i∥ ^ 2`, the sum of the norms-squared, is +dependent functions `f : Π i, G i` for which `∑' i, ‖f i‖ ^ 2`, the sum of the norms-squared, is summable. This construction is sometimes called the *Hilbert sum* of the family `G`. By choosing `G` to be `ι → 𝕜`, the Hilbert space `ℓ²(ι, 𝕜)` may be seen as a special case of this construction. +We also define a *predicate* `is_hilbert_sum 𝕜 G V`, where `V : Π i, G i →ₗᵢ[𝕜] E`, expressing that +`V` is an `orthogonal_family` and that the associated map `lp G 2 →ₗᵢ[𝕜] E` is surjective. + ## Main definitions * `orthogonal_family.linear_isometry`: Given a Hilbert space `E`, a family `G` of inner product @@ -22,10 +29,14 @@ summable. This construction is sometimes called the *Hilbert sum* of the family mutually-orthogonal images, there is an induced isometric embedding of the Hilbert sum of `G` into `E`. -* `orthogonal_family.linear_isometry_equiv`: Given a Hilbert space `E`, a family `G` of inner - product spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` - with mutually-orthogonal images whose span is dense in `E`, there is an induced isometric - isomorphism of the Hilbert sum of `G` with `E`. +* `is_hilbert_sum`: Given a Hilbert space `E`, a family `G` of inner product + spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E`, + `is_hilbert_sum 𝕜 G V` means that `V` is an `orthogonal_family` and that the above + linear isometry is surjective. + +* `is_hilbert_sum.linear_isometry_equiv`: If a Hilbert space `E` is a Hilbert sum of the + inner product spaces `G i` with respect to the family `V : Π i, G i →ₗᵢ[𝕜] E`, then the + corresponding `orthogonal_family.linear_isometry` can be upgraded to a `linear_isometry_equiv`. * `hilbert_basis`: We define a *Hilbert basis* of a Hilbert space `E` to be a structure whose single field `hilbert_basis.repr` is an isometric isomorphism of `E` with `ℓ²(ι, 𝕜)` (i.e., the Hilbert @@ -72,16 +83,17 @@ Hilbert space, Hilbert sum, l2, Hilbert basis, unitary equivalence, isometric is -/ open is_R_or_C submodule filter -open_locale big_operators nnreal ennreal classical complex_conjugate +open_locale big_operators nnreal ennreal classical complex_conjugate topology noncomputable theory variables {ι : Type*} -variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [inner_product_space 𝕜 E] [cplt : complete_space E] -variables {G : ι → Type*} [Π i, inner_product_space 𝕜 (G i)] +variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} +variables [normed_add_comm_group E] [inner_product_space 𝕜 E] [cplt : complete_space E] +variables {G : ι → Type*} [Π i, normed_add_comm_group (G i)] [Π i, inner_product_space 𝕜 (G i)] local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y -notation `ℓ²(` ι `,` 𝕜 `)` := lp (λ i : ι, 𝕜) 2 +notation `ℓ²(`ι`, `𝕜`)` := lp (λ i : ι, 𝕜) 2 /-! ### Inner product space structure on `lp G 2` -/ @@ -89,8 +101,8 @@ namespace lp lemma summable_inner (f g : lp G 2) : summable (λ i, ⟪f i, g i⟫) := begin - -- Apply the Direct Comparison Test, comparing with ∑' i, ∥f i∥ * ∥g i∥ (summable by Hölder) - refine summable_of_norm_bounded (λ i, ∥f i∥ * ∥g i∥) (lp.summable_mul _ f g) _, + -- Apply the Direct Comparison Test, comparing with ∑' i, ‖f i‖ * ‖g i‖ (summable by Hölder) + refine summable_of_norm_bounded (λ i, ‖f i‖ * ‖g i‖) (lp.summable_mul _ f g) _, { rw real.is_conjugate_exponent_iff; norm_num }, intros i, -- Then apply Cauchy-Schwarz pointwise @@ -100,19 +112,19 @@ end instance : inner_product_space 𝕜 (lp G 2) := { inner := λ f g, ∑' i, ⟪f i, g i⟫, norm_sq_eq_inner := λ f, begin - calc ∥f∥ ^ 2 = ∥f∥ ^ (2:ℝ≥0∞).to_real : by norm_cast - ... = ∑' i, ∥f i∥ ^ (2:ℝ≥0∞).to_real : lp.norm_rpow_eq_tsum _ f - ... = ∑' i, ∥f i∥ ^ 2 : by norm_cast - ... = ∑' i, re ⟪f i, f i⟫ : by simp only [norm_sq_eq_inner] + calc ‖f‖ ^ 2 = ‖f‖ ^ (2:ℝ≥0∞).to_real : by norm_cast + ... = ∑' i, ‖f i‖ ^ (2:ℝ≥0∞).to_real : lp.norm_rpow_eq_tsum _ f + ... = ∑' i, ‖f i‖ ^ 2 : by norm_cast + ... = ∑' i, re ⟪f i, f i⟫ : by simp only [@norm_sq_eq_inner 𝕜] ... = re (∑' i, ⟪f i, f i⟫) : (is_R_or_C.re_clm.map_tsum _).symm ... = _ : by congr, { norm_num }, { exact summable_inner f f }, end, - conj_sym := λ f g, begin + conj_symm := λ f g, begin calc conj _ = conj ∑' i, ⟪g i, f i⟫ : by congr ... = ∑' i, conj ⟪g i, f i⟫ : is_R_or_C.conj_cle.map_tsum - ... = ∑' i, ⟪f i, g i⟫ : by simp only [inner_conj_sym] + ... = ∑' i, ⟪f i, g i⟫ : by simp only [inner_conj_symm] ... = _ : by congr, end, add_left := λ f₁ f₂ g, begin @@ -152,14 +164,14 @@ begin end lemma inner_single_right (i : ι) (a : G i) (f : lp G 2) : ⟪f, lp.single 2 i a⟫ = ⟪f i, a⟫ := -by simpa [inner_conj_sym] using congr_arg conj (inner_single_left i a f) +by simpa [inner_conj_symm] using congr_arg conj (@inner_single_left _ 𝕜 _ _ _ _ i a f) end lp /-! ### Identification of a general Hilbert space `E` with a Hilbert sum -/ namespace orthogonal_family -variables {V : Π i, G i →ₗᵢ[𝕜] E} (hV : orthogonal_family 𝕜 V) +variables {V : Π i, G i →ₗᵢ[𝕜] E} (hV : orthogonal_family 𝕜 G V) include cplt hV @@ -178,11 +190,11 @@ protected def linear_isometry : lp G 2 →ₗᵢ[𝕜] E := map_add' := λ f g, by simp only [tsum_add (hV.summable_of_lp f) (hV.summable_of_lp g), lp.coe_fn_add, pi.add_apply, linear_isometry.map_add], map_smul' := λ c f, by simpa only [linear_isometry.map_smul, pi.smul_apply, lp.coe_fn_smul] - using tsum_const_smul (hV.summable_of_lp f), + using tsum_const_smul c (hV.summable_of_lp f), norm_map' := λ f, begin classical, -- needed for lattice instance on `finset ι`, for `filter.at_top_ne_bot` have H : 0 < (2:ℝ≥0∞).to_real := by norm_num, - suffices : ∥∑' (i : ι), V i (f i)∥ ^ ((2:ℝ≥0∞).to_real) = ∥f∥ ^ ((2:ℝ≥0∞).to_real), + suffices : ‖∑' (i : ι), V i (f i)‖ ^ ((2:ℝ≥0∞).to_real) = ‖f‖ ^ ((2:ℝ≥0∞).to_real), { exact real.rpow_left_inj_on H.ne' (norm_nonneg _) (norm_nonneg _) this }, refine tendsto_nhds_unique _ (lp.has_sum_norm H f), convert (hV.summable_of_lp f).has_sum.norm.rpow_const (or.inr H.le), @@ -241,70 +253,127 @@ begin exact hV.linear_isometry.isometry.uniform_inducing.is_complete_range.is_closed } end -/-- A mutually orthogonal family of complete subspaces of `E`, whose range is dense in `E`, induces -a isometric isomorphism from E to `lp 2` of the subspaces. +end orthogonal_family + +section is_hilbert_sum + +variables (𝕜 G) (V : Π i, G i →ₗᵢ[𝕜] E) (F : ι → submodule 𝕜 E) +include cplt + +/-- Given a family of Hilbert spaces `G : ι → Type*`, a Hilbert sum of `G` consists of a Hilbert +space `E` and an orthogonal family `V : Π i, G i →ₗᵢ[𝕜] E` such that the induced isometry +`Φ : lp G 2 → E` is surjective. + +Keeping in mind that `lp G 2` is "the" external Hilbert sum of `G : ι → Type*`, this is analogous +to `direct_sum.is_internal`, except that we don't express it in terms of actual submodules. -/ +@[protect_proj] structure is_hilbert_sum : Prop := of_surjective :: +(orthogonal_family : orthogonal_family 𝕜 G V) +(surjective_isometry : function.surjective (orthogonal_family.linear_isometry)) + +variables {𝕜 G V} + +/-- If `V : Π i, G i →ₗᵢ[𝕜] E` is an orthogonal family such that the supremum of the ranges of +`V i` is dense, then `(E, V)` is a Hilbert sum of `G`. -/ +lemma is_hilbert_sum.mk [Π i, complete_space $ G i] + (hVortho : orthogonal_family 𝕜 G V) + (hVtotal : ⊤ ≤ (⨆ i, (V i).to_linear_map.range).topological_closure) : + is_hilbert_sum 𝕜 G V := +{ orthogonal_family := hVortho, + surjective_isometry := + begin + rw [←linear_isometry.coe_to_linear_map], + exact linear_map.range_eq_top.mp (eq_top_iff.mpr $ + hVtotal.trans_eq hVortho.range_linear_isometry.symm) + end } + +/-- This is `orthogonal_family.is_hilbert_sum` in the case of actual inclusions from subspaces. -/ +lemma is_hilbert_sum.mk_internal [Π i, complete_space $ F i] + (hFortho : orthogonal_family 𝕜 (λ i, F i) (λ i, (F i).subtypeₗᵢ)) + (hFtotal : ⊤ ≤ (⨆ i, (F i)).topological_closure) : + is_hilbert_sum 𝕜 (λ i, F i) (λ i, (F i).subtypeₗᵢ) := +is_hilbert_sum.mk hFortho (by simpa [subtypeₗᵢ_to_linear_map, range_subtype] using hFtotal) + +/-- *A* Hilbert sum `(E, V)` of `G` is canonically isomorphic to *the* Hilbert sum of `G`, +i.e `lp G 2`. Note that this goes in the opposite direction from `orthogonal_family.linear_isometry`. -/ -noncomputable def linear_isometry_equiv [Π i, complete_space (G i)] - (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) : +noncomputable def is_hilbert_sum.linear_isometry_equiv (hV : is_hilbert_sum 𝕜 G V) : E ≃ₗᵢ[𝕜] lp G 2 := linear_isometry_equiv.symm $ linear_isometry_equiv.of_surjective -hV.linear_isometry -begin - refine linear_map.range_eq_top.mp _, - rw ← hV', - rw hV.range_linear_isometry, -end +hV.orthogonal_family.linear_isometry hV.surjective_isometry -/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an orthogonal family `G`, +/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G` and `lp G 2`, a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`. -/ -protected lemma linear_isometry_equiv_symm_apply [Π i, complete_space (G i)] - (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (w : lp G 2) : - (hV.linear_isometry_equiv hV').symm w = ∑' i, V i (w i) := -by simp [orthogonal_family.linear_isometry_equiv, orthogonal_family.linear_isometry_apply] +protected lemma is_hilbert_sum.linear_isometry_equiv_symm_apply + (hV : is_hilbert_sum 𝕜 G V) (w : lp G 2) : + hV.linear_isometry_equiv.symm w = ∑' i, V i (w i) := +by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.linear_isometry_apply] -/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an orthogonal family `G`, +/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G` and `lp G 2`, a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`, and this sum indeed converges. -/ -protected lemma has_sum_linear_isometry_equiv_symm [Π i, complete_space (G i)] - (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (w : lp G 2) : - has_sum (λ i, V i (w i)) ((hV.linear_isometry_equiv hV').symm w) := -by simp [orthogonal_family.linear_isometry_equiv, orthogonal_family.has_sum_linear_isometry] +protected lemma is_hilbert_sum.has_sum_linear_isometry_equiv_symm + (hV : is_hilbert_sum 𝕜 G V) (w : lp G 2) : + has_sum (λ i, V i (w i)) (hV.linear_isometry_equiv.symm w) := +by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.has_sum_linear_isometry] -/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an `ι`-indexed orthogonal -family `G`, an "elementary basis vector" in `lp G 2` supported at `i : ι` is the image of the +/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and +`lp G 2`, an "elementary basis vector" in `lp G 2` supported at `i : ι` is the image of the associated element in `E`. -/ -@[simp] protected lemma linear_isometry_equiv_symm_apply_single [Π i, complete_space (G i)] - (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) {i : ι} (x : G i) : - (hV.linear_isometry_equiv hV').symm (lp.single 2 i x) = V i x := -by simp [orthogonal_family.linear_isometry_equiv, orthogonal_family.linear_isometry_apply_single] +@[simp] protected lemma is_hilbert_sum.linear_isometry_equiv_symm_apply_single + (hV : is_hilbert_sum 𝕜 G V) {i : ι} (x : G i) : + hV.linear_isometry_equiv.symm (lp.single 2 i x) = V i x := +by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.linear_isometry_apply_single] -/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an `ι`-indexed orthogonal -family `G`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of +/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and +`lp G 2`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of elements of `E`. -/ -@[simp] protected lemma linear_isometry_equiv_symm_apply_dfinsupp_sum_single - [Π i, complete_space (G i)] - (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (W₀ : Π₀ (i : ι), G i) : - (hV.linear_isometry_equiv hV').symm (W₀.sum (lp.single 2)) = (W₀.sum (λ i, V i)) := -by simp [orthogonal_family.linear_isometry_equiv, +@[simp] protected lemma is_hilbert_sum.linear_isometry_equiv_symm_apply_dfinsupp_sum_single + (hV : is_hilbert_sum 𝕜 G V) (W₀ : Π₀ (i : ι), G i) : + hV.linear_isometry_equiv.symm (W₀.sum (lp.single 2)) = (W₀.sum (λ i, V i)) := +by simp [is_hilbert_sum.linear_isometry_equiv, orthogonal_family.linear_isometry_apply_dfinsupp_sum_single] -/-- In the canonical isometric isomorphism `E ≃ₗᵢ[𝕜] lp G 2` induced by an `ι`-indexed orthogonal -family `G`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of +/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and +`lp G 2`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of elements of `E`. -/ -@[simp] protected lemma linear_isometry_equiv_apply_dfinsupp_sum_single - [Π i, complete_space (G i)] - (hV' : (⨆ i, (V i).to_linear_map.range).topological_closure = ⊤) (W₀ : Π₀ (i : ι), G i) : - (hV.linear_isometry_equiv hV' (W₀.sum (λ i, V i)) : Π i, G i) = W₀ := +@[simp] protected lemma is_hilbert_sum.linear_isometry_equiv_apply_dfinsupp_sum_single + (hV : is_hilbert_sum 𝕜 G V) (W₀ : Π₀ (i : ι), G i) : + (hV.linear_isometry_equiv (W₀.sum (λ i, V i)) : Π i, G i) = W₀ := begin - rw ← hV.linear_isometry_equiv_symm_apply_dfinsupp_sum_single hV', + rw ← hV.linear_isometry_equiv_symm_apply_dfinsupp_sum_single, rw linear_isometry_equiv.apply_symm_apply, ext i, simp [dfinsupp.sum, lp.single_apply] {contextual := tt}, end -end orthogonal_family +/-- Given a total orthonormal family `v : ι → E`, `E` is a Hilbert sum of `λ i : ι, 𝕜` relative to +the family of linear isometries `λ i, λ k, k • v i`. -/ +lemma orthonormal.is_hilbert_sum {v : ι → E} (hv : orthonormal 𝕜 v) + (hsp : ⊤ ≤ (span 𝕜 (set.range v)).topological_closure) : + is_hilbert_sum 𝕜 (λ i : ι, 𝕜) (λ i, linear_isometry.to_span_singleton 𝕜 E (hv.1 i)) := +is_hilbert_sum.mk hv.orthogonal_family +begin + convert hsp, + simp [← linear_map.span_singleton_eq_range, ← submodule.span_Union], +end + +lemma submodule.is_hilbert_sum_orthogonal (K : submodule 𝕜 E) [hK : complete_space K] : + is_hilbert_sum 𝕜 (λ b, ↥(cond b K Kᗮ)) (λ b, (cond b K Kᗮ).subtypeₗᵢ) := +begin + haveI : Π b, complete_space ↥(cond b K Kᗮ), + { intro b, + cases b; + exact orthogonal.complete_space K <|> assumption }, + refine is_hilbert_sum.mk_internal _ K.orthogonal_family_self _, + refine le_trans _ (submodule.le_topological_closure _), + rw [supr_bool_eq, cond, cond], + refine codisjoint.top_le _, + exact submodule.is_compl_orthogonal_of_complete_space.codisjoint +end + +end is_hilbert_sum /-! ### Hilbert bases -/ @@ -360,6 +429,7 @@ begin exact (↑(b.repr.symm.to_continuous_linear_equiv) : ℓ²(ι, 𝕜) →L[𝕜] E).has_sum this }, ext i, apply b.repr.injective, + letI : normed_space 𝕜 ↥(lp (λ i : ι, 𝕜) 2) := by apply_instance, have : lp.single 2 i (f i * 1) = f i • lp.single 2 i 1 := lp.single_smul 2 i (1:𝕜) (f i), rw mul_one at this, rw [linear_isometry_equiv.map_smul, b.repr_self, ← this, @@ -386,32 +456,78 @@ begin exact subset_span ⟨i, rfl⟩ end +protected lemma has_sum_inner_mul_inner (b : hilbert_basis ι 𝕜 E) (x y : E) : + has_sum (λ i, ⟪x, b i⟫ * ⟪b i, y⟫) ⟪x, y⟫ := +begin + convert (b.has_sum_repr y).mapL (innerSL _ x), + ext i, + rw [innerSL_apply, b.repr_apply_apply, inner_smul_right, mul_comm] +end + +protected lemma summable_inner_mul_inner (b : hilbert_basis ι 𝕜 E) (x y : E) : + summable (λ i, ⟪x, b i⟫ * ⟪b i, y⟫) := +(b.has_sum_inner_mul_inner x y).summable + +protected lemma tsum_inner_mul_inner (b : hilbert_basis ι 𝕜 E) (x y : E) : + ∑' i, ⟪x, b i⟫ * ⟪b i, y⟫ = ⟪x, y⟫ := +(b.has_sum_inner_mul_inner x y).tsum_eq + +-- Note : this should be `b.repr` composed with an identification of `lp (λ i : ι, 𝕜) p` with +-- `pi_Lp p (λ i : ι, 𝕜)` (in this case with `p = 2`), but we don't have this yet (July 2022). +/-- A finite Hilbert basis is an orthonormal basis. -/ +protected def to_orthonormal_basis [fintype ι] (b : hilbert_basis ι 𝕜 E) : + orthonormal_basis ι 𝕜 E := +orthonormal_basis.mk b.orthonormal +begin + refine eq.ge _, + have := (span 𝕜 (finset.univ.image b : set E)).closed_of_finite_dimensional, + simpa only [finset.coe_image, finset.coe_univ, set.image_univ, hilbert_basis.dense_span] using + this.submodule_topological_closure_eq.symm +end + +@[simp] lemma coe_to_orthonormal_basis [fintype ι] (b : hilbert_basis ι 𝕜 E) : + (b.to_orthonormal_basis : ι → E) = b := +orthonormal_basis.coe_mk _ _ + +protected lemma has_sum_orthogonal_projection {U : submodule 𝕜 E} + [complete_space U] (b : hilbert_basis ι 𝕜 U) (x : E) : + has_sum (λ i, ⟪(b i : E), x⟫ • b i) (orthogonal_projection U x) := +by simpa only [b.repr_apply_apply, inner_orthogonal_projection_eq_of_mem_left] + using b.has_sum_repr (orthogonal_projection U x) + +lemma finite_spans_dense (b : hilbert_basis ι 𝕜 E) : + (⨆ J : finset ι, span 𝕜 (J.image b : set E)).topological_closure = ⊤ := +eq_top_iff.mpr $ b.dense_span.ge.trans +begin + simp_rw [← submodule.span_Union], + exact topological_closure_mono (span_mono $ set.range_subset_iff.mpr $ + λ i, set.mem_Union_of_mem {i} $ finset.mem_coe.mpr $ finset.mem_image_of_mem _ $ + finset.mem_singleton_self i) +end + variables {v : ι → E} (hv : orthonormal 𝕜 v) include hv cplt /-- An orthonormal family of vectors whose span is dense in the whole module is a Hilbert basis. -/ -protected def mk (hsp : (span 𝕜 (set.range v)).topological_closure = ⊤) : +protected def mk (hsp : ⊤ ≤ (span 𝕜 (set.range v)).topological_closure) : hilbert_basis ι 𝕜 E := hilbert_basis.of_repr $ -hv.orthogonal_family.linear_isometry_equiv -begin - convert hsp, - simp [← linear_map.span_singleton_eq_range, ← submodule.span_Union], -end +(hv.is_hilbert_sum hsp).linear_isometry_equiv + +lemma _root_.orthonormal.linear_isometry_equiv_symm_apply_single_one (h i) : + (hv.is_hilbert_sum h).linear_isometry_equiv.symm (lp.single 2 i 1) = v i := +by rw [is_hilbert_sum.linear_isometry_equiv_symm_apply_single, + linear_isometry.to_span_singleton_apply, one_smul] -@[simp] protected lemma coe_mk (hsp : (span 𝕜 (set.range v)).topological_closure = ⊤) : +@[simp] protected lemma coe_mk (hsp : ⊤ ≤ (span 𝕜 (set.range v)).topological_closure) : ⇑(hilbert_basis.mk hv hsp) = v := -begin - ext i, - show (hilbert_basis.mk hv hsp).repr.symm _ = v i, - simp [hilbert_basis.mk] -end +by apply (funext $ orthonormal.linear_isometry_equiv_symm_apply_single_one hv hsp) /-- An orthonormal family of vectors whose span has trivial orthogonal complement is a Hilbert basis. -/ protected def mk_of_orthogonal_eq_bot (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) : hilbert_basis ι 𝕜 E := hilbert_basis.mk hv -(by rw [← orthogonal_orthogonal_eq_closure, orthogonal_eq_top_iff, hsp]) +(by rw [← orthogonal_orthogonal_eq_closure, ← eq_top_iff, orthogonal_eq_top_iff, hsp]) @[simp] protected lemma coe_of_orthogonal_eq_bot_mk (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) : ⇑(hilbert_basis.mk_of_orthogonal_eq_bot hv hsp) = v := @@ -419,6 +535,19 @@ hilbert_basis.coe_mk hv _ omit hv +-- Note : this should be `b.repr` composed with an identification of `lp (λ i : ι, 𝕜) p` with +-- `pi_Lp p (λ i : ι, 𝕜)` (in this case with `p = 2`), but we don't have this yet (July 2022). +/-- An orthonormal basis is an Hilbert basis. -/ +protected def _root_.orthonormal_basis.to_hilbert_basis [fintype ι] (b : orthonormal_basis ι 𝕜 E) : + hilbert_basis ι 𝕜 E := +hilbert_basis.mk b.orthonormal $ +by simpa only [← orthonormal_basis.coe_to_basis, b.to_basis.span_eq, eq_top_iff] + using @subset_closure E _ _ + +@[simp] lemma _root_.orthonormal_basis.coe_to_hilbert_basis [fintype ι] + (b : orthonormal_basis ι 𝕜 E) : (b.to_hilbert_basis : ι → E) = b := +hilbert_basis.coe_mk _ _ + /-- A Hilbert space admits a Hilbert basis extending a given orthonormal subset. -/ lemma _root_.orthonormal.exists_hilbert_basis_extension {s : set E} (hs : orthonormal 𝕜 (coe : s → E)) : diff --git a/src/analysis/inner_product_space/lax_milgram.lean b/src/analysis/inner_product_space/lax_milgram.lean index 15c7b647b2708..27354056f5634 100644 --- a/src/analysis/inner_product_space/lax_milgram.lean +++ b/src/analysis/inner_product_space/lax_milgram.lean @@ -12,11 +12,14 @@ import topology.metric_space.antilipschitz /-! # The Lax-Milgram Theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We consider an Hilbert space `V` over `ℝ` equipped with a bounded bilinear form `B : V →L[ℝ] V →L[ℝ] ℝ`. Recall that a bilinear form `B : V →L[ℝ] V →L[ℝ] ℝ` is *coercive* -iff `∃ C, (0 < C) ∧ ∀ u, C * ∥u∥ * ∥u∥ ≤ B u u`. +iff `∃ C, (0 < C) ∧ ∀ u, C * ‖u‖ * ‖u‖ ≤ B u u`. Under the hypothesis that `B` is coercive we prove the Lax-Milgram theorem: that is, the map `inner_product_space.continuous_linear_map_of_bilin` from @@ -34,29 +37,29 @@ dual, Lax-Milgram -/ noncomputable theory -open is_R_or_C linear_map continuous_linear_map inner_product_space +open is_R_or_C linear_map continuous_linear_map inner_product_space linear_map (ker range) open_locale real_inner_product_space nnreal universe u namespace is_coercive -variables {V : Type u} [inner_product_space ℝ V] [complete_space V] +variables {V : Type u} [normed_add_comm_group V] [inner_product_space ℝ V] [complete_space V] variables {B : V →L[ℝ] V →L[ℝ] ℝ} -local postfix `♯`:1025 := @continuous_linear_map_of_bilin ℝ V _ _ _ +local postfix `♯`:1025 := @continuous_linear_map_of_bilin ℝ V _ _ _ _ lemma bounded_below (coercive : is_coercive B) : - ∃ C, 0 < C ∧ ∀ v, C * ∥v∥ ≤ ∥B♯ v∥ := + ∃ C, 0 < C ∧ ∀ v, C * ‖v‖ ≤ ‖B♯ v‖ := begin rcases coercive with ⟨C, C_ge_0, coercivity⟩, refine ⟨C, C_ge_0, _⟩, intro v, - by_cases h : 0 < ∥v∥, + by_cases h : 0 < ‖v‖, { refine (mul_le_mul_right h).mp _, - calc C * ∥v∥ * ∥v∥ + calc C * ‖v‖ * ‖v‖ ≤ B v v : coercivity v ... = ⟪B♯ v, v⟫_ℝ : (continuous_linear_map_of_bilin_apply ℝ B v v).symm - ... ≤ ∥B♯ v∥ * ∥v∥ : real_inner_le_norm (B♯ v) v, }, + ... ≤ ‖B♯ v‖ * ‖v‖ : real_inner_le_norm (B♯ v) v, }, { have : v = 0 := by simpa using h, simp [this], } end @@ -66,42 +69,42 @@ lemma antilipschitz (coercive : is_coercive B) : begin rcases coercive.bounded_below with ⟨C, C_pos, below_bound⟩, refine ⟨(C⁻¹).to_nnreal, real.to_nnreal_pos.mpr (inv_pos.mpr C_pos), _⟩, - refine linear_map.antilipschitz_of_bound B♯ _, + refine continuous_linear_map.antilipschitz_of_bound B♯ _, simp_rw [real.coe_to_nnreal', max_eq_left_of_lt (inv_pos.mpr C_pos), ←inv_mul_le_iff (inv_pos.mpr C_pos)], simpa using below_bound, end -lemma ker_eq_bot (coercive : is_coercive B) : B♯.ker = ⊥ := +lemma ker_eq_bot (coercive : is_coercive B) : ker B♯ = ⊥ := begin - rw [←ker_coe, linear_map.ker_eq_bot], + rw [linear_map_class.ker_eq_bot], rcases coercive.antilipschitz with ⟨_, _, antilipschitz⟩, exact antilipschitz.injective, end -lemma closed_range (coercive : is_coercive B) : is_closed (B♯.range : set V) := +lemma closed_range (coercive : is_coercive B) : is_closed (range B♯ : set V) := begin rcases coercive.antilipschitz with ⟨_, _, antilipschitz⟩, exact antilipschitz.is_closed_range B♯.uniform_continuous, end -lemma range_eq_top (coercive : is_coercive B) : B♯.range = ⊤ := +lemma range_eq_top (coercive : is_coercive B) : range B♯ = ⊤ := begin haveI := coercive.closed_range.complete_space_coe, - rw ← B♯.range.orthogonal_orthogonal, + rw ← (range B♯).orthogonal_orthogonal, rw submodule.eq_top_iff', intros v w mem_w_orthogonal, rcases coercive with ⟨C, C_pos, coercivity⟩, obtain rfl : w = 0, { rw [←norm_eq_zero, ←mul_self_eq_zero, ←mul_right_inj' C_pos.ne', mul_zero, ←mul_assoc], apply le_antisymm, - { calc C * ∥w∥ * ∥w∥ + { calc C * ‖w‖ * ‖w‖ ≤ B w w : coercivity w ... = ⟪B♯ w, w⟫_ℝ : (continuous_linear_map_of_bilin_apply ℝ B w w).symm ... = 0 : mem_w_orthogonal _ ⟨w, rfl⟩ }, { exact mul_nonneg (mul_nonneg C_pos.le (norm_nonneg w)) (norm_nonneg w) } }, - exact inner_zero_left, + exact inner_zero_left _, end /-- diff --git a/src/analysis/inner_product_space/linear_pmap.lean b/src/analysis/inner_product_space/linear_pmap.lean new file mode 100644 index 0000000000000..0613e2dfe34cd --- /dev/null +++ b/src/analysis/inner_product_space/linear_pmap.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2022 Moritz Doll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll +-/ + +import analysis.inner_product_space.adjoint +import topology.algebra.module.linear_pmap +import topology.algebra.module.basic + +/-! + +# Partially defined linear operators on Hilbert spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We will develop the basics of the theory of unbounded operators on Hilbert spaces. + +## Main definitions + +* `linear_pmap.is_formal_adjoint`: An operator `T` is a formal adjoint of `S` if for all `x` in the + domain of `T` and `y` in the domain of `S`, we have that `⟪T x, y⟫ = ⟪x, S y⟫`. +* `linear_pmap.adjoint`: The adjoint of a map `E →ₗ.[𝕜] F` as a map `F →ₗ.[𝕜] E`. + +## Main statements + +* `linear_pmap.adjoint_is_formal_adjoint`: The adjoint is a formal adjoint +* `linear_pmap.is_formal_adjoint.le_adjoint`: Every formal adjoint is contained in the adjoint +* `continuous_linear_map.to_pmap_adjoint_eq_adjoint_to_pmap_of_dense`: The adjoint on + `continuous_linear_map` and `linear_pmap` coincide. + +## Notation + +* For `T : E →ₗ.[𝕜] F` the adjoint can be written as `T†`. + This notation is localized in `linear_pmap`. + +## Implementation notes + +We use the junk value pattern to define the adjoint for all `linear_pmap`s. In the case that +`T : E →ₗ.[𝕜] F` is not densely defined the adjoint `T†` is the zero map from `T.adjoint_domain` to +`E`. + +## References + +* [J. Weidmann, *Linear Operators in Hilbert Spaces*][weidmann_linear] + +## Tags + +Unbounded operators, closed operators +-/ + + +noncomputable theory + +open is_R_or_C +open_locale complex_conjugate classical + +variables {𝕜 E F G : Type*} [is_R_or_C 𝕜] +variables [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables [normed_add_comm_group F] [inner_product_space 𝕜 F] + +local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y + +namespace linear_pmap + +/-- An operator `T` is a formal adjoint of `S` if for all `x` in the domain of `T` and `y` in the +domain of `S`, we have that `⟪T x, y⟫ = ⟪x, S y⟫`. -/ +def is_formal_adjoint (T : E →ₗ.[𝕜] F) (S : F →ₗ.[𝕜] E) : Prop := +∀ (x : T.domain) (y : S.domain), ⟪T x, y⟫ = ⟪(x : E), S y⟫ + +variables {T : E →ₗ.[𝕜] F} {S : F →ₗ.[𝕜] E} + +@[protected] lemma is_formal_adjoint.symm (h : T.is_formal_adjoint S) : S.is_formal_adjoint T := +λ y _, by rw [←inner_conj_symm, ←inner_conj_symm (y : F), h] + +variables (T) + +/-- The domain of the adjoint operator. + +This definition is needed to construct the adjoint operator and the preferred version to use is +`T.adjoint.domain` instead of `T.adjoint_domain`. -/ +def adjoint_domain : submodule 𝕜 F := +{ carrier := {y | continuous ((innerₛₗ 𝕜 y).comp T.to_fun)}, + zero_mem' := by { rw [set.mem_set_of_eq, linear_map.map_zero, linear_map.zero_comp], + exact continuous_zero }, + add_mem' := λ x y hx hy, by { rw [set.mem_set_of_eq, linear_map.map_add] at *, exact hx.add hy }, + smul_mem' := λ a x hx, by { rw [set.mem_set_of_eq, linear_map.map_smulₛₗ] at *, + exact hx.const_smul (conj a) } } + +/-- The operator `λ x, ⟪y, T x⟫` considered as a continuous linear operator from `T.adjoint_domain` +to `𝕜`. -/ +def adjoint_domain_mk_clm (y : T.adjoint_domain) : T.domain →L[𝕜] 𝕜 := +⟨(innerₛₗ 𝕜 (y : F)).comp T.to_fun, y.prop⟩ + +lemma adjoint_domain_mk_clm_apply (y : T.adjoint_domain) (x : T.domain) : + adjoint_domain_mk_clm T y x = ⟪(y : F), T x⟫ := rfl + +variable {T} +variable (hT : dense (T.domain : set E)) + +include hT + +/-- The unique continuous extension of the operator `adjoint_domain_mk_clm` to `E`. -/ +def adjoint_domain_mk_clm_extend (y : T.adjoint_domain) : + E →L[𝕜] 𝕜 := +(T.adjoint_domain_mk_clm y).extend (submodule.subtypeL T.domain) + hT.dense_range_coe uniform_embedding_subtype_coe.to_uniform_inducing + +@[simp] lemma adjoint_domain_mk_clm_extend_apply (y : T.adjoint_domain) (x : T.domain) : + adjoint_domain_mk_clm_extend hT y (x : E) = ⟪(y : F), T x⟫ := +continuous_linear_map.extend_eq _ _ _ _ _ + +variables [complete_space E] + +/-- The adjoint as a linear map from its domain to `E`. + +This is an auxiliary definition needed to define the adjoint operator as a `linear_pmap` without +the assumption that `T.domain` is dense. -/ +def adjoint_aux : T.adjoint_domain →ₗ[𝕜] E := +{ to_fun := λ y, (inner_product_space.to_dual 𝕜 E).symm (adjoint_domain_mk_clm_extend hT y), + map_add' := λ x y, hT.eq_of_inner_left $ λ _, + by simp only [inner_add_left, submodule.coe_add, inner_product_space.to_dual_symm_apply, + adjoint_domain_mk_clm_extend_apply], + map_smul' := λ _ _, hT.eq_of_inner_left $ λ _, + by simp only [inner_smul_left, submodule.coe_smul_of_tower, ring_hom.id_apply, + inner_product_space.to_dual_symm_apply, adjoint_domain_mk_clm_extend_apply] } + +lemma adjoint_aux_inner (y : T.adjoint_domain) (x : T.domain) : + ⟪adjoint_aux hT y, x⟫ = ⟪(y : F), T x⟫ := +by simp only [adjoint_aux, linear_map.coe_mk, inner_product_space.to_dual_symm_apply, + adjoint_domain_mk_clm_extend_apply] + +lemma adjoint_aux_unique (y : T.adjoint_domain) {x₀ : E} + (hx₀ : ∀ x : T.domain, ⟪x₀, x⟫ = ⟪(y : F), T x⟫) : adjoint_aux hT y = x₀ := +hT.eq_of_inner_left (λ v, (adjoint_aux_inner hT _ _).trans (hx₀ v).symm) + +omit hT + +variable (T) + +/-- The adjoint operator as a partially defined linear operator. -/ +def adjoint : F →ₗ.[𝕜] E := +{ domain := T.adjoint_domain, + to_fun := if hT : dense (T.domain : set E) then adjoint_aux hT else 0 } + +localized "postfix (name := adjoint) `†`:1100 := linear_pmap.adjoint" in linear_pmap + +lemma mem_adjoint_domain_iff (y : F) : + y ∈ T†.domain ↔ continuous ((innerₛₗ 𝕜 y).comp T.to_fun) := iff.rfl + +variable {T} + +lemma mem_adjoint_domain_of_exists (y : F) (h : ∃ w : E, ∀ (x : T.domain), ⟪w, x⟫ = ⟪y, T x⟫) : + y ∈ T†.domain := +begin + cases h with w hw, + rw T.mem_adjoint_domain_iff, + have : continuous ((innerSL 𝕜 w).comp T.domain.subtypeL) := by continuity, + convert this using 1, + exact funext (λ x, (hw x).symm), +end + +lemma adjoint_apply_of_not_dense (hT : ¬ dense (T.domain : set E)) (y : T†.domain) : T† y = 0 := +begin + change (if hT : dense (T.domain : set E) then adjoint_aux hT else 0) y = _, + simp only [hT, not_false_iff, dif_neg, linear_map.zero_apply], +end + +include hT + +lemma adjoint_apply_of_dense (y : T†.domain) : T† y = adjoint_aux hT y := +begin + change (if hT : dense (T.domain : set E) then adjoint_aux hT else 0) y = _, + simp only [hT, dif_pos, linear_map.coe_mk], +end + +lemma adjoint_apply_eq (y : T†.domain) {x₀ : E} + (hx₀ : ∀ x : T.domain, ⟪x₀, x⟫ = ⟪(y : F), T x⟫) : T† y = x₀ := +(adjoint_apply_of_dense hT y).symm ▸ adjoint_aux_unique hT _ hx₀ + +/-- The fundamental property of the adjoint. -/ +lemma adjoint_is_formal_adjoint : T†.is_formal_adjoint T := +λ x, (adjoint_apply_of_dense hT x).symm ▸ adjoint_aux_inner hT x + +/-- The adjoint is maximal in the sense that it contains every formal adjoint. -/ +lemma is_formal_adjoint.le_adjoint (h : T.is_formal_adjoint S) : S ≤ T† := +-- Trivially, every `x : S.domain` is in `T.adjoint.domain` +⟨λ x hx, mem_adjoint_domain_of_exists _ ⟨S ⟨x, hx⟩, h.symm ⟨x, hx⟩⟩, + -- Equality on `S.domain` follows from equality + -- `⟪v, S x⟫ = ⟪v, T.adjoint y⟫` for all `v : T.domain`: + λ _ _ hxy, (adjoint_apply_eq hT _ (λ _, by rw [h.symm, hxy])).symm⟩ + +end linear_pmap + +namespace continuous_linear_map + +variables [complete_space E] [complete_space F] +variables (A : E →L[𝕜] F) {p : submodule 𝕜 E} + +/-- Restricting `A` to a dense submodule and taking the `linear_pmap.adjoint` is the same +as taking the `continuous_linear_map.adjoint` interpreted as a `linear_pmap`. -/ +lemma to_pmap_adjoint_eq_adjoint_to_pmap_of_dense (hp : dense (p : set E)) : + (A.to_pmap p).adjoint = A.adjoint.to_pmap ⊤ := +begin + ext, + { simp only [to_linear_map_eq_coe, linear_map.to_pmap_domain, submodule.mem_top, iff_true, + linear_pmap.mem_adjoint_domain_iff, linear_map.coe_comp, innerₛₗ_apply_coe], + exact ((innerSL 𝕜 x).comp $ A.comp $ submodule.subtypeL _).cont }, + intros x y hxy, + refine linear_pmap.adjoint_apply_eq hp _ (λ v, _), + simp only [adjoint_inner_left, hxy, linear_map.to_pmap_apply, to_linear_map_eq_coe, coe_coe], +end + +end continuous_linear_map diff --git a/src/analysis/inner_product_space/of_norm.lean b/src/analysis/inner_product_space/of_norm.lean new file mode 100644 index 0000000000000..7c36dba00df14 --- /dev/null +++ b/src/analysis/inner_product_space/of_norm.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2020 Heather Macbeth. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Heather Macbeth +-/ + +import topology.algebra.algebra +import analysis.inner_product_space.basic + +/-! +# Inner product space derived from a norm + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines an `inner_product_space` instance from a norm that respects the +parallellogram identity. The parallelogram identity is a way to express the inner product of `x` and +`y` in terms of the norms of `x`, `y`, `x + y`, `x - y`. + +## Main results + +- `inner_product_space.of_norm`: a normed space whose norm respects the parallellogram identity, + can be seen as an inner product space. + +## Implementation notes + +We define `inner_` + +$$\langle x, y \rangle := \frac{1}{4} (‖x + y‖^2 - ‖x - y‖^2 + i ‖ix + y‖ ^ 2 - i ‖ix - y‖^2)$$ + +and use the parallelogram identity + +$$‖x + y‖^2 + ‖x - y‖^2 = 2 (‖x‖^2 + ‖y‖^2)$$ + +to prove it is an inner product, i.e., that it is conjugate-symmetric (`inner_.conj_symm`) and +linear in the first argument. `add_left` is proved by judicious application of the parallelogram +identity followed by tedious arithmetic. `smul_left` is proved step by step, first noting that +$\langle λ x, y \rangle = λ \langle x, y \rangle$ for $λ ∈ ℕ$, $λ = -1$, hence $λ ∈ ℤ$ and $λ ∈ ℚ$ +by arithmetic. Then by continuity and the fact that ℚ is dense in ℝ, the same is true for ℝ. +The case of ℂ then follows by applying the result for ℝ and more arithmetic. + +## TODO + +Move upstream to `analysis.inner_product_space.basic`. + +## References + +- [Jordan, P. and von Neumann, J., *On inner products in linear, metric spaces*][Jordan1935] +- https://math.stackexchange.com/questions/21792/norms-induced-by-inner-products-and-the-parallelogram-law +- https://math.dartmouth.edu/archive/m113w10/public_html/jordan-vneumann-thm.pdf + +## Tags + +inner product space, Hilbert space, norm +-/ + +open is_R_or_C +open_locale complex_conjugate + +variables {𝕜 : Type*} [is_R_or_C 𝕜] (E : Type*) [normed_add_comm_group E] + +/-- Predicate for the parallelogram identity to hold in a normed group. This is a scalar-less +version of `inner_product_space`. If you have an `inner_product_spaceable` assumption, you can +locally upgrade that to `inner_product_space 𝕜 E` using `casesI nonempty_inner_product_space 𝕜 E`. +-/ +class inner_product_spaceable : Prop := +(parallelogram_identity : + ∀ x y : E, ‖x + y‖ * ‖x + y‖ + ‖x - y‖ * ‖x - y‖ = 2 * (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖)) + +variables (𝕜) {E} + +lemma inner_product_space.to_inner_product_spaceable [inner_product_space 𝕜 E] : + inner_product_spaceable E := +⟨parallelogram_law_with_norm 𝕜⟩ + +@[priority 100] -- See note [lower instance priority] +instance inner_product_space.to_inner_product_spaceable_of_real [inner_product_space ℝ E] : + inner_product_spaceable E := +⟨parallelogram_law_with_norm ℝ⟩ + +variables [normed_space 𝕜 E] + +local notation `𝓚` := algebra_map ℝ 𝕜 + +/-- Auxiliary definition of the inner product derived from the norm. -/ +private noncomputable def inner_ (x y : E) : 𝕜 := +4⁻¹ * ((𝓚 ‖x + y‖) * (𝓚 ‖x + y‖) - (𝓚 ‖x - y‖) * (𝓚 ‖x - y‖) + + (I:𝕜) * (𝓚 ‖(I:𝕜) • x + y‖) * (𝓚 ‖(I:𝕜) • x + y‖) + - (I:𝕜) * (𝓚 ‖(I:𝕜) • x - y‖) * (𝓚 ‖(I:𝕜) • x - y‖)) + +namespace inner_product_spaceable + +variables {𝕜} (E) + +/-- Auxiliary definition for the `add_left` property -/ +private def inner_prop (r : 𝕜) : Prop := ∀ x y : E, inner_ 𝕜 (r • x) y = conj r * inner_ 𝕜 x y + +variables {E} + +lemma inner_prop_neg_one : inner_prop E ((-1 : ℤ) : 𝕜) := +begin + intros x y, + simp only [inner_, neg_mul_eq_neg_mul, one_mul, int.cast_one, one_smul, ring_hom.map_one, + map_neg, int.cast_neg, neg_smul, neg_one_mul], + rw neg_mul_comm, + congr' 1, + have h₁ : ‖-x - y‖ = ‖x + y‖, + { rw [←neg_add', norm_neg], }, + have h₂ : ‖-x + y‖ = ‖x - y‖, + { rw [←neg_sub, norm_neg, sub_eq_neg_add], }, + have h₃ : ‖(I : 𝕜) • (-x) + y‖ = ‖(I : 𝕜) • x - y‖, + { rw [←neg_sub, norm_neg, sub_eq_neg_add, ←smul_neg], }, + have h₄ : ‖(I : 𝕜) • (-x) - y‖ = ‖(I : 𝕜) • x + y‖, + { rw [smul_neg, ←neg_add', norm_neg] }, + rw [h₁, h₂, h₃, h₄], + ring, +end + +lemma continuous.inner_ {f g : ℝ → E} (hf : continuous f) (hg : continuous g) : + continuous (λ x, inner_ 𝕜 (f x) (g x)) := +by { unfold inner_, continuity } + +lemma inner_.norm_sq (x : E) : ‖x‖ ^ 2 = re (inner_ 𝕜 x x) := +begin + simp only [inner_], + have h₁ : norm_sq (4 : 𝕜) = 16, + { have : ((4 : ℝ) : 𝕜) = (4 : 𝕜), + { simp only [of_real_one, of_real_bit0] }, + rw [←this, norm_sq_eq_def', + is_R_or_C.norm_of_nonneg (by norm_num : (0 : ℝ) ≤ 4)], + norm_num }, + have h₂ : ‖x + x‖ = 2 * ‖x‖, + { rw [←two_smul 𝕜, norm_smul, is_R_or_C.norm_two] }, + simp only [inner, h₁, h₂, one_im, bit0_zero, add_zero, norm_zero, I_re, of_real_im, map_add, + bit0_im, zero_div, zero_mul, add_monoid_hom.map_neg, of_real_re, map_sub, sub_zero, inv_re, + one_re, inv_im, bit0_re, mul_re, mul_zero, sub_self, neg_zero, algebra_map_eq_of_real], + ring, +end + +lemma inner_.conj_symm (x y : E) : conj (inner_ 𝕜 y x) = inner_ 𝕜 x y := +begin + simp only [inner_], + have h4 : conj (4⁻¹ : 𝕜) = 4⁻¹, + { rw [is_R_or_C.conj_inv, ←of_real_one, ←of_real_bit0, ←of_real_bit0, conj_of_real] }, + rw [map_mul, h4], + congr' 1, + simp only [map_sub, map_add, algebra_map_eq_of_real, ←of_real_mul, conj_of_real, map_mul, conj_I], + rw [add_comm y x, norm_sub_rev], + by_cases hI : (I : 𝕜) = 0, + { simp only [hI, neg_zero, zero_mul] }, + have h₁ : ‖(I : 𝕜) • y - x‖ = ‖(I : 𝕜) • x + y‖, + { transitivity ‖(I : 𝕜) • ((I : 𝕜) • y - x)‖, + { rw [norm_smul, norm_I_of_ne_zero hI, one_mul] }, + { rw [smul_sub, smul_smul, I_mul_I_of_nonzero hI, neg_one_smul, ←neg_add', add_comm, + norm_neg] } }, + have h₂ : ‖(I : 𝕜) • y + x‖ = ‖(I : 𝕜) • x - y‖, + { transitivity ‖(I : 𝕜) • ((I : 𝕜) • y + x)‖, + { rw [norm_smul, norm_I_of_ne_zero hI, one_mul] }, + { rw [smul_add, smul_smul, I_mul_I_of_nonzero hI, neg_one_smul, ←neg_add_eq_sub] }}, + rw [h₁, h₂, ←sub_add_eq_add_sub], + simp only [neg_mul, sub_eq_add_neg, neg_neg], +end + +variables [inner_product_spaceable E] + +private lemma add_left_aux1 (x y z : E) : + ‖x + y + z‖ * ‖x + y + z‖ = + (‖2 • x + y‖ * ‖2 • x + y‖ + ‖2 • z + y‖ * ‖2 • z + y‖) / 2 - ‖x - z‖ * ‖x - z‖ := +begin + rw [eq_sub_iff_add_eq, eq_div_iff (two_ne_zero' ℝ), mul_comm _ (2 : ℝ), eq_comm], + convert parallelogram_identity (x + y + z) (x - z) using 4; { rw two_smul, abel } +end + +private lemma add_left_aux2 (x y z : E) : + ‖x + y - z‖ * ‖x + y - z‖ = + (‖2 • x + y‖ * ‖2 • x + y‖ + ‖y - 2 • z‖ * ‖y - 2 • z‖) / 2 - ‖x + z‖ * ‖x + z‖ := +begin + rw [eq_sub_iff_add_eq, eq_div_iff (two_ne_zero' ℝ), mul_comm _ (2 : ℝ), eq_comm], + have h₀ := parallelogram_identity (x + y - z) (x + z), + convert h₀ using 4; { rw two_smul, abel } +end + +private lemma add_left_aux2' (x y z : E) : + ‖x + y + z‖ * ‖x + y + z‖ - ‖x + y - z‖ * ‖x + y - z‖ = + ‖x + z‖ * ‖x + z‖ - ‖x - z‖ * ‖x - z‖ + + (‖2 • z + y‖ * ‖2 • z + y‖ - ‖y - 2 • z‖ * ‖y - 2 • z‖) / 2 := +by { rw [add_left_aux1 , add_left_aux2], ring } + +private lemma add_left_aux3 (y z : E) : + ‖2 • z + y‖ * ‖2 • z + y‖ = 2 * (‖y + z‖ * ‖y + z‖ + ‖z‖ * ‖z‖) - ‖y‖ * ‖y‖ := +begin + apply eq_sub_of_add_eq, + convert parallelogram_identity (y + z) z using 4; { try { rw two_smul }, abel } +end + +private lemma add_left_aux4 (y z : E) : + ‖y - 2 • z‖ * ‖y - 2 • z‖ = 2 * (‖y - z‖ * ‖y - z‖ + ‖z‖ * ‖z‖) - ‖y‖ * ‖y‖ := +begin + apply eq_sub_of_add_eq', + have h₀ := parallelogram_identity (y - z) z, + convert h₀ using 4; { try { rw two_smul }, abel } +end + +private lemma add_left_aux4' (y z : E) : + (‖2 • z + y‖ * ‖2 • z + y‖ - ‖y - 2 • z‖ * ‖y - 2 • z‖) / 2 = + (‖y + z‖ * ‖y + z‖) - (‖y - z‖ * ‖y - z‖) := +by { rw [add_left_aux3 , add_left_aux4], ring } + +private lemma add_left_aux5 (x y z : E) : + ‖(I : 𝕜) • (x + y) + z‖ * ‖(I : 𝕜) • (x + y) + z‖ = + (‖(I : 𝕜) • (2 • x + y)‖ * ‖(I : 𝕜) • (2 • x + y)‖ + + ‖(I : 𝕜) • y + 2 • z‖ * ‖(I : 𝕜) • y + 2 • z‖) / 2 - ‖(I : 𝕜) • x - z‖ * ‖(I : 𝕜) • x - z‖ := +begin + rw [eq_sub_iff_add_eq, eq_div_iff (two_ne_zero' ℝ), mul_comm _ (2 : ℝ), eq_comm], + have h₀ := parallelogram_identity ((I : 𝕜) • (x + y) + z) ((I : 𝕜) • x - z), + convert h₀ using 4; { try { simp only [two_smul, smul_add] }, abel } +end + +private lemma add_left_aux6 (x y z : E) : + ‖(I : 𝕜) • (x + y) - z‖ * ‖(I : 𝕜) • (x + y) - z‖ = + (‖(I : 𝕜) • (2 • x + y)‖ * ‖(I : 𝕜) • (2 • x + y)‖ + + ‖(I : 𝕜) • y - 2 • z‖ * ‖(I : 𝕜) • y - 2 • z‖) / 2 - + ‖(I : 𝕜) • x + z‖ * ‖(I : 𝕜) • x + z‖ := +begin + rw [eq_sub_iff_add_eq, eq_div_iff (two_ne_zero' ℝ), mul_comm _ (2 : ℝ), eq_comm], + have h₀ := parallelogram_identity ((I : 𝕜) • (x + y) - z) ((I : 𝕜) • x + z), + convert h₀ using 4; { try { simp only [two_smul, smul_add] }, abel } +end + +private lemma add_left_aux7 (y z : E) : + ‖(I : 𝕜) • y + 2 • z‖ * ‖(I : 𝕜) • y + 2 • z‖ = + 2 * (‖(I : 𝕜) • y + z‖ * ‖(I : 𝕜) • y + z‖ + ‖z‖ * ‖z‖) - ‖(I : 𝕜) • y‖ * ‖(I : 𝕜) • y‖ := +begin + apply eq_sub_of_add_eq, + have h₀ := parallelogram_identity ((I : 𝕜) • y + z) z, + convert h₀ using 4; { try { simp only [two_smul, smul_add] }, abel } +end + +private lemma add_left_aux8 (y z : E) : + ‖(I : 𝕜) • y - 2 • z‖ * ‖(I : 𝕜) • y - 2 • z‖ = + 2 * (‖(I : 𝕜) • y - z‖ * ‖(I : 𝕜) • y - z‖ + ‖z‖ * ‖z‖) - ‖(I : 𝕜) • y‖ * ‖(I : 𝕜) • y‖ := +begin + apply eq_sub_of_add_eq', + have h₀ := parallelogram_identity ((I : 𝕜) • y - z) z, + convert h₀ using 4; { try { simp only [two_smul, smul_add] }, abel } +end + +lemma add_left (x y z : E) : inner_ 𝕜 (x + y) z = inner_ 𝕜 x z + inner_ 𝕜 y z := +begin + simp only [inner_, ←mul_add], + congr, + simp only [mul_assoc, ←map_mul, add_sub_assoc, ←mul_sub, ←map_sub], + rw add_add_add_comm, + simp only [←map_add, ←mul_add], + congr, + { rw [←add_sub_assoc, add_left_aux2', add_left_aux4'] }, + { rw [add_left_aux5, add_left_aux6, add_left_aux7, add_left_aux8], + simp only [map_sub, map_mul, map_add, div_eq_mul_inv], + ring } +end + +lemma nat (n : ℕ) (x y : E) : inner_ 𝕜 ((n : 𝕜) • x) y = (n : 𝕜) * inner_ 𝕜 x y := +begin + induction n with n ih, + { simp only [inner_, nat.nat_zero_eq_zero, zero_sub, nat.cast_zero, zero_mul, eq_self_iff_true, + zero_smul, zero_add, mul_zero, sub_self, norm_neg, smul_zero], }, + { simp only [nat.cast_succ, add_smul, one_smul], + rw [add_left, ih, add_mul, one_mul] } +end + +private lemma nat_prop (r : ℕ) : inner_prop E (r : 𝕜) := +λ x y, by { simp only [map_nat_cast], exact nat r x y } + +private lemma int_prop (n : ℤ) : inner_prop E (n : 𝕜) := +begin + intros x y, + rw ←n.sign_mul_nat_abs, + simp only [int.cast_coe_nat, map_nat_cast, map_int_cast, int.cast_mul, map_mul, mul_smul], + obtain hn | rfl | hn := lt_trichotomy n 0, + { rw [int.sign_eq_neg_one_of_neg hn, inner_prop_neg_one ((n.nat_abs : 𝕜) • x), nat], + simp only [map_neg, neg_mul, one_mul, mul_eq_mul_left_iff, true_or, + int.nat_abs_eq_zero, eq_self_iff_true, int.cast_one, map_one, neg_inj, nat.cast_eq_zero, + int.cast_neg] }, + { simp only [inner_, int.cast_zero, zero_sub, nat.cast_zero, zero_mul, eq_self_iff_true, + int.sign_zero, zero_smul, zero_add, mul_zero, smul_zero, sub_self, norm_neg, + int.nat_abs_zero] }, + { rw int.sign_eq_one_of_pos hn, + simp only [one_mul, mul_eq_mul_left_iff, true_or, int.nat_abs_eq_zero, eq_self_iff_true, + int.cast_one, one_smul, nat.cast_eq_zero, nat] } +end + +private lemma rat_prop (r : ℚ) : inner_prop E (r : 𝕜) := +begin + intros x y, + have : (r.denom : 𝕜) ≠ 0, + { haveI : char_zero 𝕜 := is_R_or_C.char_zero_R_or_C, + exact_mod_cast r.pos.ne' }, + rw [←r.num_div_denom, ←mul_right_inj' this, ←nat r.denom _ y, smul_smul, rat.cast_div], + simp only [map_nat_cast, rat.cast_coe_nat, map_int_cast, rat.cast_coe_int, map_div₀], + rw [←mul_assoc, mul_div_cancel' _ this, int_prop _ x, map_int_cast], +end + +private lemma real_prop (r : ℝ) : inner_prop E (r : 𝕜) := +begin + intros x y, + revert r, + rw ←function.funext_iff, + refine rat.dense_embedding_coe_real.dense.equalizer _ _ (funext $ λ X, _), + { exact (continuous_of_real.smul continuous_const).inner_ continuous_const }, + { exact (continuous_conj.comp continuous_of_real).mul continuous_const }, + { simp only [function.comp_app, is_R_or_C.of_real_rat_cast, rat_prop _ _] } +end + +private lemma I_prop : inner_prop E (I : 𝕜) := +begin + by_cases hI : (I : 𝕜) = 0, + { rw [hI, ←nat.cast_zero], exact nat_prop _ }, + intros x y, + have hI' : (-I : 𝕜) * I = 1, + { rw [←inv_I, inv_mul_cancel hI], }, + rw [conj_I, inner_, inner_, mul_left_comm], + congr' 1, + rw [smul_smul, I_mul_I_of_nonzero hI, neg_one_smul], + rw [mul_sub, mul_add, mul_sub, + mul_assoc I (𝓚 ‖I • x - y‖), ←mul_assoc (-I) I, hI', one_mul, + mul_assoc I (𝓚 ‖I • x + y‖), ←mul_assoc (-I) I, hI', one_mul], + have h₁ : ‖-x - y‖ = ‖x + y‖, + { rw [←neg_add', norm_neg], }, + have h₂ : ‖-x + y‖ = ‖x - y‖, + { rw [←neg_sub, norm_neg, sub_eq_neg_add], }, + rw [h₁, h₂], + simp only [sub_eq_add_neg, mul_assoc], + rw [←neg_mul_eq_neg_mul, ←neg_mul_eq_neg_mul], + abel +end + +lemma inner_prop (r : 𝕜) : inner_prop E r := +begin + intros x y, + rw [←re_add_im r, add_smul, add_left, real_prop _ x, ←smul_smul, real_prop _ _ y, I_prop, + map_add, map_mul, conj_of_real, conj_of_real, conj_I], + ring, +end + +end inner_product_spaceable + +open inner_product_spaceable + +/-- **Fréchet–von Neumann–Jordan Theorem**. A normed space `E` whose norm satisfies the +parallelogram identity can be given a compatible inner product. -/ +noncomputable def inner_product_space.of_norm + (h : ∀ x y : E, ‖x + y‖ * ‖x + y‖ + ‖x - y‖ * ‖x - y‖ = 2 * (‖x‖ * ‖x‖ + ‖y‖ * ‖y‖)) : + inner_product_space 𝕜 E := +begin + haveI : inner_product_spaceable E := ⟨h⟩, + exact + { inner := inner_ 𝕜, + norm_sq_eq_inner := inner_.norm_sq, + conj_symm := inner_.conj_symm, + add_left := add_left, + smul_left := λ _ _ _, inner_prop _ _ _ } +end + +variables (𝕜 E) [inner_product_spaceable E] + +/-- **Fréchet–von Neumann–Jordan Theorem**. A normed space `E` whose norm satisfies the +parallelogram identity can be given a compatible inner product. Do +`casesI nonempty_inner_product_space 𝕜 E` to locally upgrade `inner_product_spaceable E` to +`inner_product_space 𝕜 E`. -/ +lemma nonempty_inner_product_space : nonempty (inner_product_space 𝕜 E) := +⟨{ inner := inner_ 𝕜, + norm_sq_eq_inner := inner_.norm_sq, + conj_symm := inner_.conj_symm, + add_left := add_left, + smul_left := λ _ _ _, inner_prop _ _ _ }⟩ + +variables {𝕜 E} [normed_space ℝ E] + +-- TODO: Replace `inner_product_space.to_uniform_convex_space` +@[priority 100] -- See note [lower instance priority] +instance inner_product_spaceable.to_uniform_convex_space : uniform_convex_space E := +by { casesI nonempty_inner_product_space ℝ E, apply_instance } diff --git a/src/analysis/inner_product_space/orientation.lean b/src/analysis/inner_product_space/orientation.lean index a9c97374111ff..db8a8457ae7c7 100644 --- a/src/analysis/inner_product_space/orientation.lean +++ b/src/analysis/inner_product_space/orientation.lean @@ -1,60 +1,356 @@ /- Copyright (c) 2022 Joseph Myers. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Joseph Myers +Authors: Joseph Myers, Heather Macbeth -/ -import analysis.inner_product_space.projection +import analysis.inner_product_space.gram_schmidt_ortho import linear_algebra.orientation /-! # Orientations of real inner product spaces. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides definitions and proves lemmas about orientations of real inner product spaces. ## Main definitions +* `orthonormal_basis.adjust_to_orientation` takes an orthonormal basis and an orientation, and + returns an orthonormal basis with that orientation: either the original orthonormal basis, or one + constructed by negating a single (arbitrary) basis vector. * `orientation.fin_orthonormal_basis` is an orthonormal basis, indexed by `fin n`, with the given -orientation. + orientation. +* `orientation.volume_form` is a nonvanishing top-dimensional alternating form on an oriented real + inner product space, uniquely defined by compatibility with the orientation and inner product + structure. + +## Main theorems + +* `orientation.volume_form_apply_le` states that the result of applying the volume form to a set of + `n` vectors, where `n` is the dimension the inner product space, is bounded by the product of the + lengths of the vectors. +* `orientation.abs_volume_form_apply_of_pairwise_orthogonal` states that the result of applying the + volume form to a set of `n` orthogonal vectors, where `n` is the dimension the inner product + space, is equal up to sign to the product of the lengths of the vectors. -/ noncomputable theory -variables {E : Type*} [inner_product_space ℝ E] -variables {ι : Type*} [fintype ι] [decidable_eq ι] +variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] open finite_dimensional +open_locale big_operators real_inner_product_space + +namespace orthonormal_basis +variables {ι : Type*} [fintype ι] [decidable_eq ι] [ne : nonempty ι] (e f : orthonormal_basis ι ℝ E) + (x : orientation ℝ E ι) + +/-- The change-of-basis matrix between two orthonormal bases with the same orientation has +determinant 1. -/ +lemma det_to_matrix_orthonormal_basis_of_same_orientation + (h : e.to_basis.orientation = f.to_basis.orientation) : + e.to_basis.det f = 1 := +begin + apply (e.det_to_matrix_orthonormal_basis_real f).resolve_right, + have : 0 < e.to_basis.det f, + { rw e.to_basis.orientation_eq_iff_det_pos at h, + simpa using h }, + linarith, +end + +/-- The change-of-basis matrix between two orthonormal bases with the opposite orientations has +determinant -1. -/ +lemma det_to_matrix_orthonormal_basis_of_opposite_orientation + (h : e.to_basis.orientation ≠ f.to_basis.orientation) : + e.to_basis.det f = -1 := +begin + contrapose! h, + simp [e.to_basis.orientation_eq_iff_det_pos, + (e.det_to_matrix_orthonormal_basis_real f).resolve_right h], +end -/-- `basis.adjust_to_orientation`, applied to an orthonormal basis, produces an orthonormal -basis. -/ -lemma orthonormal.orthonormal_adjust_to_orientation [nonempty ι] {e : basis ι ℝ E} - (h : orthonormal ℝ e) (x : orientation ℝ E ι) : orthonormal ℝ (e.adjust_to_orientation x) := -h.orthonormal_of_forall_eq_or_eq_neg (e.adjust_to_orientation_apply_eq_or_eq_neg x) +variables {e f} + +/-- Two orthonormal bases with the same orientation determine the same "determinant" top-dimensional +form on `E`, and conversely. -/ +lemma same_orientation_iff_det_eq_det : + e.to_basis.det = f.to_basis.det ↔ e.to_basis.orientation = f.to_basis.orientation := +begin + split, + { intros h, + dsimp [basis.orientation], + congr' }, + { intros h, + rw e.to_basis.det.eq_smul_basis_det f.to_basis, + simp [e.det_to_matrix_orthonormal_basis_of_same_orientation f h], }, +end + +variables (e f) + +/-- Two orthonormal bases with opposite orientations determine opposite "determinant" +top-dimensional forms on `E`. -/ +lemma det_eq_neg_det_of_opposite_orientation + (h : e.to_basis.orientation ≠ f.to_basis.orientation) : + e.to_basis.det = -f.to_basis.det := +begin + rw e.to_basis.det.eq_smul_basis_det f.to_basis, + simp [e.det_to_matrix_orthonormal_basis_of_opposite_orientation f h], +end + +section adjust_to_orientation +include ne + +/-- `orthonormal_basis.adjust_to_orientation`, applied to an orthonormal basis, preserves the +property of orthonormality. -/ +lemma orthonormal_adjust_to_orientation : orthonormal ℝ (e.to_basis.adjust_to_orientation x) := +begin + apply e.orthonormal.orthonormal_of_forall_eq_or_eq_neg, + simpa using e.to_basis.adjust_to_orientation_apply_eq_or_eq_neg x +end + +/-- Given an orthonormal basis and an orientation, return an orthonormal basis giving that +orientation: either the original basis, or one constructed by negating a single (arbitrary) basis +vector. -/ +def adjust_to_orientation : orthonormal_basis ι ℝ E := +(e.to_basis.adjust_to_orientation x).to_orthonormal_basis (e.orthonormal_adjust_to_orientation x) + +lemma to_basis_adjust_to_orientation : + (e.adjust_to_orientation x).to_basis = e.to_basis.adjust_to_orientation x := +(e.to_basis.adjust_to_orientation x).to_basis_to_orthonormal_basis _ + +/-- `adjust_to_orientation` gives an orthonormal basis with the required orientation. -/ +@[simp] lemma orientation_adjust_to_orientation : + (e.adjust_to_orientation x).to_basis.orientation = x := +begin + rw e.to_basis_adjust_to_orientation, + exact e.to_basis.orientation_adjust_to_orientation x, +end + +/-- Every basis vector from `adjust_to_orientation` is either that from the original basis or its +negation. -/ +lemma adjust_to_orientation_apply_eq_or_eq_neg (i : ι) : + e.adjust_to_orientation x i = e i ∨ e.adjust_to_orientation x i = -(e i) := +by simpa [← e.to_basis_adjust_to_orientation] + using e.to_basis.adjust_to_orientation_apply_eq_or_eq_neg x i + +lemma det_adjust_to_orientation : + (e.adjust_to_orientation x).to_basis.det = e.to_basis.det + ∨ (e.adjust_to_orientation x).to_basis.det = -e.to_basis.det := +by simpa using e.to_basis.det_adjust_to_orientation x + +lemma abs_det_adjust_to_orientation (v : ι → E) : + |(e.adjust_to_orientation x).to_basis.det v| = |e.to_basis.det v| := +by simp [to_basis_adjust_to_orientation] + +end adjust_to_orientation + +end orthonormal_basis + +namespace orientation +variables {n : ℕ} + +open orthonormal_basis /-- An orthonormal basis, indexed by `fin n`, with the given orientation. -/ -protected def orientation.fin_orthonormal_basis {n : ℕ} (hn : 0 < n) (h : finrank ℝ E = n) - (x : orientation ℝ E (fin n)) : basis (fin n) ℝ E := +protected def fin_orthonormal_basis (hn : 0 < n) (h : finrank ℝ E = n) + (x : orientation ℝ E (fin n)) : orthonormal_basis (fin n) ℝ E := begin haveI := fin.pos_iff_nonempty.1 hn, haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E), - exact (fin_std_orthonormal_basis h).adjust_to_orientation x + exact ((std_orthonormal_basis _ _).reindex $ fin_congr h).adjust_to_orientation x end -/-- `orientation.fin_orthonormal_basis` is orthonormal. -/ -protected lemma orientation.fin_orthonormal_basis_orthonormal {n : ℕ} (hn : 0 < n) +/-- `orientation.fin_orthonormal_basis` gives a basis with the required orientation. -/ +@[simp] lemma fin_orthonormal_basis_orientation (hn : 0 < n) (h : finrank ℝ E = n) (x : orientation ℝ E (fin n)) : - orthonormal ℝ (x.fin_orthonormal_basis hn h) := + (x.fin_orthonormal_basis hn h).to_basis.orientation = x := begin haveI := fin.pos_iff_nonempty.1 hn, haveI := finite_dimensional_of_finrank (h.symm ▸ hn : 0 < finrank ℝ E), - exact (fin_std_orthonormal_basis_orthonormal h).orthonormal_adjust_to_orientation _ + exact ((std_orthonormal_basis _ _).reindex $ fin_congr h).orientation_adjust_to_orientation x end -/-- `orientation.fin_orthonormal_basis` gives a basis with the required orientation. -/ -@[simp] lemma orientation.fin_orthonormal_basis_orientation {n : ℕ} (hn : 0 < n) - (h : finrank ℝ E = n) (x : orientation ℝ E (fin n)) : - (x.fin_orthonormal_basis hn h).orientation = x := +section volume_form +variables [_i : fact (finrank ℝ E = n)] (o : orientation ℝ E (fin n)) + +include _i o + +/-- The volume form on an oriented real inner product space, a nonvanishing top-dimensional +alternating form uniquely defined by compatibility with the orientation and inner product structure. +-/ +@[irreducible] def volume_form : alternating_map ℝ E ℝ (fin n) := begin - haveI := fin.pos_iff_nonempty.1 hn, - exact basis.orientation_adjust_to_orientation _ _ + classical, + unfreezingI { cases n }, + { let opos : alternating_map ℝ E ℝ (fin 0) := alternating_map.const_of_is_empty ℝ E (fin 0) (1:ℝ), + exact o.eq_or_eq_neg_of_is_empty.by_cases (λ _, opos) (λ _, -opos) }, + { exact (o.fin_orthonormal_basis n.succ_pos _i.out).to_basis.det } +end + +omit _i o + +@[simp] lemma volume_form_zero_pos [_i : fact (finrank ℝ E = 0)] : + orientation.volume_form (positive_orientation : orientation ℝ E (fin 0)) + = alternating_map.const_linear_equiv_of_is_empty 1 := +by simp [volume_form, or.by_cases, if_pos] + +lemma volume_form_zero_neg [_i : fact (finrank ℝ E = 0)] : + orientation.volume_form (-positive_orientation : orientation ℝ E (fin 0)) + = - alternating_map.const_linear_equiv_of_is_empty 1 := +begin + dsimp [volume_form, or.by_cases, positive_orientation], + apply if_neg, + rw [ray_eq_iff, same_ray_comm], + intros h, + simpa using + congr_arg alternating_map.const_linear_equiv_of_is_empty.symm (eq_zero_of_same_ray_self_neg h), end + +include _i o + +/-- The volume form on an oriented real inner product space can be evaluated as the determinant with +respect to any orthonormal basis of the space compatible with the orientation. -/ +lemma volume_form_robust (b : orthonormal_basis (fin n) ℝ E) (hb : b.to_basis.orientation = o) : + o.volume_form = b.to_basis.det := +begin + unfreezingI { cases n }, + { classical, + have : o = positive_orientation := hb.symm.trans b.to_basis.orientation_is_empty, + simp [volume_form, or.by_cases, dif_pos this] }, + { dsimp [volume_form], + rw [same_orientation_iff_det_eq_det, hb], + exact o.fin_orthonormal_basis_orientation _ _ }, +end + +/-- The volume form on an oriented real inner product space can be evaluated as the determinant with +respect to any orthonormal basis of the space compatible with the orientation. -/ +lemma volume_form_robust_neg (b : orthonormal_basis (fin n) ℝ E) + (hb : b.to_basis.orientation ≠ o) : + o.volume_form = - b.to_basis.det := +begin + unfreezingI { cases n }, + { classical, + have : positive_orientation ≠ o := by rwa b.to_basis.orientation_is_empty at hb, + simp [volume_form, or.by_cases, dif_neg this.symm] }, + let e : orthonormal_basis (fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (fact.out _), + dsimp [volume_form], + apply e.det_eq_neg_det_of_opposite_orientation b, + convert hb.symm, + exact o.fin_orthonormal_basis_orientation _ _, +end + +@[simp] lemma volume_form_neg_orientation : (-o).volume_form = - o.volume_form := +begin + unfreezingI { cases n }, + { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp [volume_form_zero_neg] }, + let e : orthonormal_basis (fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (fact.out _), + have h₁ : e.to_basis.orientation = o := o.fin_orthonormal_basis_orientation _ _, + have h₂ : e.to_basis.orientation ≠ -o, + { symmetry, + rw [e.to_basis.orientation_ne_iff_eq_neg, h₁] }, + rw [o.volume_form_robust e h₁, (-o).volume_form_robust_neg e h₂], +end + +lemma volume_form_robust' (b : orthonormal_basis (fin n) ℝ E) (v : fin n → E) : + |o.volume_form v| = |b.to_basis.det v| := +begin + unfreezingI { cases n }, + { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp }, + { rw [o.volume_form_robust (b.adjust_to_orientation o) (b.orientation_adjust_to_orientation o), + b.abs_det_adjust_to_orientation] }, +end + +/-- Let `v` be an indexed family of `n` vectors in an oriented `n`-dimensional real inner +product space `E`. The output of the volume form of `E` when evaluated on `v` is bounded in absolute +value by the product of the norms of the vectors `v i`. -/ +lemma abs_volume_form_apply_le (v : fin n → E) : |o.volume_form v| ≤ ∏ i : fin n, ‖v i‖ := +begin + unfreezingI { cases n }, + { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp }, + haveI : finite_dimensional ℝ E := fact_finite_dimensional_of_finrank_eq_succ n, + have : finrank ℝ E = fintype.card (fin n.succ) := by simpa using _i.out, + let b : orthonormal_basis (fin n.succ) ℝ E := gram_schmidt_orthonormal_basis this v, + have hb : b.to_basis.det v = ∏ i, ⟪b i, v i⟫ := gram_schmidt_orthonormal_basis_det this v, + rw [o.volume_form_robust' b, hb, finset.abs_prod], + apply finset.prod_le_prod, + { intros i hi, + positivity }, + intros i hi, + convert abs_real_inner_le_norm (b i) (v i), + simp [b.orthonormal.1 i], +end + +lemma volume_form_apply_le (v : fin n → E) : o.volume_form v ≤ ∏ i : fin n, ‖v i‖ := +(le_abs_self _).trans (o.abs_volume_form_apply_le v) + +/-- Let `v` be an indexed family of `n` orthogonal vectors in an oriented `n`-dimensional +real inner product space `E`. The output of the volume form of `E` when evaluated on `v` is, up to +sign, the product of the norms of the vectors `v i`. -/ +lemma abs_volume_form_apply_of_pairwise_orthogonal + {v : fin n → E} (hv : pairwise (λ i j, ⟪v i, v j⟫ = 0)) : + |o.volume_form v| = ∏ i : fin n, ‖v i‖ := +begin + unfreezingI { cases n }, + { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp }, + haveI : finite_dimensional ℝ E := fact_finite_dimensional_of_finrank_eq_succ n, + have hdim : finrank ℝ E = fintype.card (fin n.succ) := by simpa using _i.out, + let b : orthonormal_basis (fin n.succ) ℝ E := gram_schmidt_orthonormal_basis hdim v, + have hb : b.to_basis.det v = ∏ i, ⟪b i, v i⟫ := gram_schmidt_orthonormal_basis_det hdim v, + rw [o.volume_form_robust' b, hb, finset.abs_prod], + by_cases h : ∃ i, v i = 0, + obtain ⟨i, hi⟩ := h, + { rw [finset.prod_eq_zero (finset.mem_univ i), finset.prod_eq_zero (finset.mem_univ i)]; + simp [hi] }, + push_neg at h, + congr, + ext i, + have hb : b i = ‖v i‖⁻¹ • v i := gram_schmidt_orthonormal_basis_apply_of_orthogonal hdim hv (h i), + simp only [hb, inner_smul_left, real_inner_self_eq_norm_mul_norm, is_R_or_C.conj_to_real], + rw abs_of_nonneg, + { have : ‖v i‖ ≠ 0 := by simpa using h i, + field_simp }, + { positivity }, +end + +/-- The output of the volume form of an oriented real inner product space `E` when evaluated on an +orthonormal basis is ±1. -/ +lemma abs_volume_form_apply_of_orthonormal (v : orthonormal_basis (fin n) ℝ E) : + |o.volume_form v| = 1 := +by simpa [o.volume_form_robust' v v] using congr_arg abs v.to_basis.det_self + +lemma volume_form_map {F : Type*} + [normed_add_comm_group F] [inner_product_space ℝ F] [fact (finrank ℝ F = n)] + (φ : E ≃ₗᵢ[ℝ] F) (x : fin n → F) : + (orientation.map (fin n) φ.to_linear_equiv o).volume_form x = o.volume_form (φ.symm ∘ x) := +begin + unfreezingI { cases n }, + { refine o.eq_or_eq_neg_of_is_empty.elim _ _; rintros rfl; simp }, + let e : orthonormal_basis (fin n.succ) ℝ E := o.fin_orthonormal_basis n.succ_pos (fact.out _), + have he : e.to_basis.orientation = o := + (o.fin_orthonormal_basis_orientation n.succ_pos (fact.out _)), + have heφ : (e.map φ).to_basis.orientation = orientation.map (fin n.succ) φ.to_linear_equiv o, + { rw ← he, + exact (e.to_basis.orientation_map φ.to_linear_equiv) }, + rw (orientation.map (fin n.succ) φ.to_linear_equiv o).volume_form_robust (e.map φ) heφ, + rw o.volume_form_robust e he, + simp, +end + +/-- The volume form is invariant under pullback by a positively-oriented isometric automorphism. -/ +lemma volume_form_comp_linear_isometry_equiv (φ : E ≃ₗᵢ[ℝ] E) + (hφ : 0 < (φ.to_linear_equiv : E →ₗ[ℝ] E).det) (x : fin n → E) : + o.volume_form (φ ∘ x) = o.volume_form x := +begin + convert o.volume_form_map φ (φ ∘ x), + { symmetry, + rwa ← o.map_eq_iff_det_pos φ.to_linear_equiv at hφ, + rw [_i.out, fintype.card_fin] }, + { ext, + simp } +end + +end volume_form + +end orientation diff --git a/src/analysis/inner_product_space/orthogonal.lean b/src/analysis/inner_product_space/orthogonal.lean new file mode 100644 index 0000000000000..e82e720f6a709 --- /dev/null +++ b/src/analysis/inner_product_space/orthogonal.lean @@ -0,0 +1,358 @@ +/- +Copyright (c) 2019 Zhouhang Zhou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Zhouhang Zhou, Sébastien Gouëzel, Frédéric Dupuis +-/ +import linear_algebra.bilinear_form +import analysis.inner_product_space.basic + +/-! +# Orthogonal complements of submodules + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, the `orthogonal` complement of a submodule `K` is defined, and basic API established. +Some of the more subtle results about the orthogonal complement are delayed to +`analysis.inner_product_space.projection`. + +See also `bilin_form.orthogonal` for orthogonality with respect to a general bilinear form. + +## Notation + +The orthogonal complement of a submodule `K` is denoted by `Kᗮ`. + +The proposition that two submodules are orthogonal, `submodule.is_ortho`, is denoted by `U ⟂ V`. +Note this is not the same unicode symbol as `⊥` (`has_bot`). +-/ + +variables {𝕜 E F : Type*} [is_R_or_C 𝕜] +variables [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables [normed_add_comm_group F] [inner_product_space 𝕜 F] +local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y + +namespace submodule + +variables (K : submodule 𝕜 E) + +/-- The subspace of vectors orthogonal to a given subspace. -/ +def orthogonal : submodule 𝕜 E := +{ carrier := {v | ∀ u ∈ K, ⟪u, v⟫ = 0}, + zero_mem' := λ _ _, inner_zero_right _, + add_mem' := λ x y hx hy u hu, by rw [inner_add_right, hx u hu, hy u hu, add_zero], + smul_mem' := λ c x hx u hu, by rw [inner_smul_right, hx u hu, mul_zero] } + +notation K`ᗮ`:1200 := orthogonal K + +/-- When a vector is in `Kᗮ`. -/ +lemma mem_orthogonal (v : E) : v ∈ Kᗮ ↔ ∀ u ∈ K, ⟪u, v⟫ = 0 := iff.rfl + +/-- When a vector is in `Kᗮ`, with the inner product the +other way round. -/ +lemma mem_orthogonal' (v : E) : v ∈ Kᗮ ↔ ∀ u ∈ K, ⟪v, u⟫ = 0 := +by simp_rw [mem_orthogonal, inner_eq_zero_symm] + +variables {K} + +/-- A vector in `K` is orthogonal to one in `Kᗮ`. -/ +lemma inner_right_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪u, v⟫ = 0 := +(K.mem_orthogonal v).1 hv u hu + +/-- A vector in `Kᗮ` is orthogonal to one in `K`. -/ +lemma inner_left_of_mem_orthogonal {u v : E} (hu : u ∈ K) (hv : v ∈ Kᗮ) : ⟪v, u⟫ = 0 := +by rw [inner_eq_zero_symm]; exact inner_right_of_mem_orthogonal hu hv + +/-- A vector is in `(𝕜 ∙ u)ᗮ` iff it is orthogonal to `u`. -/ +lemma mem_orthogonal_singleton_iff_inner_right {u v : E} : v ∈ (𝕜 ∙ u)ᗮ ↔ ⟪u, v⟫ = 0 := +begin + refine ⟨inner_right_of_mem_orthogonal (mem_span_singleton_self u), _⟩, + intros hv w hw, + rw mem_span_singleton at hw, + obtain ⟨c, rfl⟩ := hw, + simp [inner_smul_left, hv], +end + +/-- A vector in `(𝕜 ∙ u)ᗮ` is orthogonal to `u`. -/ +lemma mem_orthogonal_singleton_iff_inner_left {u v : E} : v ∈ (𝕜 ∙ u)ᗮ ↔ ⟪v, u⟫ = 0 := +by rw [mem_orthogonal_singleton_iff_inner_right, inner_eq_zero_symm] + +lemma sub_mem_orthogonal_of_inner_left {x y : E} + (h : ∀ (v : K), ⟪x, v⟫ = ⟪y, v⟫) : x - y ∈ Kᗮ := +begin + rw mem_orthogonal', + intros u hu, + rw [inner_sub_left, sub_eq_zero], + exact h ⟨u, hu⟩, +end + +lemma sub_mem_orthogonal_of_inner_right {x y : E} + (h : ∀ (v : K), ⟪(v : E), x⟫ = ⟪(v : E), y⟫) : x - y ∈ Kᗮ := +begin + intros u hu, + rw [inner_sub_right, sub_eq_zero], + exact h ⟨u, hu⟩, +end + +variables (K) + +/-- `K` and `Kᗮ` have trivial intersection. -/ +lemma inf_orthogonal_eq_bot : K ⊓ Kᗮ = ⊥ := +begin + rw eq_bot_iff, + intros x, + rw mem_inf, + exact λ ⟨hx, ho⟩, inner_self_eq_zero.1 (ho x hx) +end + +/-- `K` and `Kᗮ` have trivial intersection. -/ +lemma orthogonal_disjoint : disjoint K Kᗮ := +by simp [disjoint_iff, K.inf_orthogonal_eq_bot] + +/-- `Kᗮ` can be characterized as the intersection of the kernels of the operations of +inner product with each of the elements of `K`. -/ +lemma orthogonal_eq_inter : Kᗮ = ⨅ v : K, linear_map.ker (innerSL 𝕜 (v : E)) := +begin + apply le_antisymm, + { rw le_infi_iff, + rintros ⟨v, hv⟩ w hw, + simpa using hw _ hv }, + { intros v hv w hw, + simp only [mem_infi] at hv, + exact hv ⟨w, hw⟩ } +end + +/-- The orthogonal complement of any submodule `K` is closed. -/ +lemma is_closed_orthogonal : is_closed (Kᗮ : set E) := +begin + rw orthogonal_eq_inter K, + have := λ v : K, continuous_linear_map.is_closed_ker (innerSL 𝕜 (v : E)), + convert is_closed_Inter this, + simp only [infi_coe], +end + +/-- In a complete space, the orthogonal complement of any submodule `K` is complete. -/ +instance [complete_space E] : complete_space Kᗮ := K.is_closed_orthogonal.complete_space_coe + +variables (𝕜 E) + +/-- `orthogonal` gives a `galois_connection` between +`submodule 𝕜 E` and its `order_dual`. -/ +lemma orthogonal_gc : + @galois_connection (submodule 𝕜 E) (submodule 𝕜 E)ᵒᵈ _ _ + orthogonal orthogonal := +λ K₁ K₂, ⟨λ h v hv u hu, inner_left_of_mem_orthogonal hv (h hu), + λ h v hv u hu, inner_left_of_mem_orthogonal hv (h hu)⟩ + +variables {𝕜 E} + +/-- `orthogonal` reverses the `≤` ordering of two +subspaces. -/ +lemma orthogonal_le {K₁ K₂ : submodule 𝕜 E} (h : K₁ ≤ K₂) : K₂ᗮ ≤ K₁ᗮ := +(orthogonal_gc 𝕜 E).monotone_l h + +/-- `orthogonal.orthogonal` preserves the `≤` ordering of two +subspaces. -/ +lemma orthogonal_orthogonal_monotone {K₁ K₂ : submodule 𝕜 E} (h : K₁ ≤ K₂) : + K₁ᗮᗮ ≤ K₂ᗮᗮ := +orthogonal_le (orthogonal_le h) + +/-- `K` is contained in `Kᗮᗮ`. -/ +lemma le_orthogonal_orthogonal : K ≤ Kᗮᗮ := (orthogonal_gc 𝕜 E).le_u_l _ + +/-- The inf of two orthogonal subspaces equals the subspace orthogonal +to the sup. -/ +lemma inf_orthogonal (K₁ K₂ : submodule 𝕜 E) : K₁ᗮ ⊓ K₂ᗮ = (K₁ ⊔ K₂)ᗮ := +(orthogonal_gc 𝕜 E).l_sup.symm + +/-- The inf of an indexed family of orthogonal subspaces equals the +subspace orthogonal to the sup. -/ +lemma infi_orthogonal {ι : Type*} (K : ι → submodule 𝕜 E) : (⨅ i, (K i)ᗮ) = (supr K)ᗮ := +(orthogonal_gc 𝕜 E).l_supr.symm + +/-- The inf of a set of orthogonal subspaces equals the subspace orthogonal to the sup. -/ +lemma Inf_orthogonal (s : set $ submodule 𝕜 E) : (⨅ K ∈ s, Kᗮ) = (Sup s)ᗮ := +(orthogonal_gc 𝕜 E).l_Sup.symm + +@[simp] lemma top_orthogonal_eq_bot : (⊤ : submodule 𝕜 E)ᗮ = ⊥ := +begin + ext, + rw [mem_bot, mem_orthogonal], + exact ⟨λ h, inner_self_eq_zero.mp (h x mem_top), by { rintro rfl, simp }⟩ +end + +@[simp] lemma bot_orthogonal_eq_top : (⊥ : submodule 𝕜 E)ᗮ = ⊤ := +begin + rw [← top_orthogonal_eq_bot, eq_top_iff], + exact le_orthogonal_orthogonal ⊤ +end + +@[simp] lemma orthogonal_eq_top_iff : Kᗮ = ⊤ ↔ K = ⊥ := +begin + refine ⟨_, by { rintro rfl, exact bot_orthogonal_eq_top }⟩, + intro h, + have : K ⊓ Kᗮ = ⊥ := K.orthogonal_disjoint.eq_bot, + rwa [h, inf_comm, top_inf_eq] at this +end + +lemma orthogonal_family_self : + orthogonal_family 𝕜 (λ b, ↥(cond b K Kᗮ)) (λ b, (cond b K Kᗮ).subtypeₗᵢ) +| tt tt := absurd rfl +| tt ff := λ _ x y, inner_right_of_mem_orthogonal x.prop y.prop +| ff tt := λ _ x y, inner_left_of_mem_orthogonal y.prop x.prop +| ff ff := absurd rfl + +end submodule + +@[simp] +lemma bilin_form_of_real_inner_orthogonal {E} [normed_add_comm_group E] [inner_product_space ℝ E] + (K : submodule ℝ E) : + bilin_form_of_real_inner.orthogonal K = Kᗮ := rfl + +/-! +### Orthogonality of submodules + +In this section we define `submodule.is_ortho U V`, with notation `U ⟂ V`. + +The API roughly matches that of `disjoint`. +-/ +namespace submodule + +/-- The proposition that two submodules are orthogonal. Has notation `U ⟂ V`. -/ +def is_ortho (U V : submodule 𝕜 E) : Prop := +U ≤ Vᗮ + +infix ` ⟂ `:50 := submodule.is_ortho + +lemma is_ortho_iff_le {U V : submodule 𝕜 E} : U ⟂ V ↔ U ≤ Vᗮ := iff.rfl + +@[symm] +lemma is_ortho.symm {U V : submodule 𝕜 E} (h : U ⟂ V) : V ⟂ U := +(le_orthogonal_orthogonal _).trans (orthogonal_le h) +lemma is_ortho_comm {U V : submodule 𝕜 E} : U ⟂ V ↔ V ⟂ U := ⟨is_ortho.symm, is_ortho.symm⟩ +lemma symmetric_is_ortho : symmetric (is_ortho : submodule 𝕜 E → submodule 𝕜 E → Prop) := +λ _ _, is_ortho.symm + +lemma is_ortho.inner_eq {U V : submodule 𝕜 E} (h : U ⟂ V) {u v : E} (hu : u ∈ U) (hv : v ∈ V) : + ⟪u, v⟫ = 0 := +h.symm hv _ hu + +lemma is_ortho_iff_inner_eq {U V : submodule 𝕜 E} : U ⟂ V ↔ ∀ (u ∈ U) (v ∈ V), ⟪u, v⟫ = 0 := +forall₄_congr $ λ u hu v hv, inner_eq_zero_symm + +/- TODO: generalize `submodule.map₂` to semilinear maps, so that we can state +`U ⟂ V ↔ submodule.map₂ (innerₛₗ 𝕜) U V ≤ ⊥`. -/ + +@[simp] lemma is_ortho_bot_left {V : submodule 𝕜 E} : ⊥ ⟂ V := bot_le +@[simp] lemma is_ortho_bot_right {U : submodule 𝕜 E} : U ⟂ ⊥ := is_ortho_bot_left.symm + +lemma is_ortho.mono_left {U₁ U₂ V : submodule 𝕜 E} (hU : U₂ ≤ U₁) (h : U₁ ⟂ V) : U₂ ⟂ V := +hU.trans h + +lemma is_ortho.mono_right {U V₁ V₂ : submodule 𝕜 E} (hV : V₂ ≤ V₁) (h : U ⟂ V₁) : U ⟂ V₂ := +(h.symm.mono_left hV).symm + +lemma is_ortho.mono {U₁ V₁ U₂ V₂ : submodule 𝕜 E} (hU : U₂ ≤ U₁) (hV : V₂ ≤ V₁) (h : U₁ ⟂ V₁) : + U₂ ⟂ V₂ := +(h.mono_right hV).mono_left hU + +@[simp] +lemma is_ortho_self {U : submodule 𝕜 E} : U ⟂ U ↔ U = ⊥ := +⟨λ h, eq_bot_iff.mpr $ λ x hx, inner_self_eq_zero.mp (h hx x hx), λ h, h.symm ▸ is_ortho_bot_left⟩ + +@[simp] lemma is_ortho_orthogonal_right (U : submodule 𝕜 E) : U ⟂ Uᗮ := +le_orthogonal_orthogonal _ + +@[simp] lemma is_ortho_orthogonal_left (U : submodule 𝕜 E) : Uᗮ ⟂ U := +(is_ortho_orthogonal_right U).symm + +lemma is_ortho.le {U V : submodule 𝕜 E} (h : U ⟂ V) : U ≤ Vᗮ := h +lemma is_ortho.ge {U V : submodule 𝕜 E} (h : U ⟂ V) : V ≤ Uᗮ := h.symm +@[simp] +lemma is_ortho_top_right {U : submodule 𝕜 E} : U ⟂ ⊤ ↔ U = ⊥ := +⟨λ h, eq_bot_iff.mpr $ λ x hx, inner_self_eq_zero.mp (h hx _ mem_top), + λ h, h.symm ▸ is_ortho_bot_left⟩ + +@[simp] +lemma is_ortho_top_left {V : submodule 𝕜 E} : ⊤ ⟂ V ↔ V = ⊥ := +is_ortho_comm.trans is_ortho_top_right + +/-- Orthogonal submodules are disjoint. -/ +lemma is_ortho.disjoint {U V : submodule 𝕜 E} (h : U ⟂ V) : disjoint U V := +(submodule.orthogonal_disjoint _).mono_right h.symm + +@[simp] lemma is_ortho_sup_left {U₁ U₂ V : submodule 𝕜 E} : U₁ ⊔ U₂ ⟂ V ↔ U₁ ⟂ V ∧ U₂ ⟂ V := +sup_le_iff + +@[simp] lemma is_ortho_sup_right {U V₁ V₂ : submodule 𝕜 E} : U ⟂ V₁ ⊔ V₂ ↔ U ⟂ V₁ ∧ U ⟂ V₂ := +is_ortho_comm.trans $ is_ortho_sup_left.trans $ is_ortho_comm.and is_ortho_comm + +@[simp] lemma is_ortho_Sup_left {U : set (submodule 𝕜 E)} {V : submodule 𝕜 E} : + Sup U ⟂ V ↔ ∀ Uᵢ ∈ U, Uᵢ ⟂ V := +Sup_le_iff + +@[simp] lemma is_ortho_Sup_right {U : submodule 𝕜 E} {V : set (submodule 𝕜 E)} : + U ⟂ Sup V ↔ ∀ Vᵢ ∈ V, U ⟂ Vᵢ := +is_ortho_comm.trans $ is_ortho_Sup_left.trans $ by simp_rw is_ortho_comm + +@[simp] lemma is_ortho_supr_left {ι : Sort*} {U : ι → submodule 𝕜 E} {V : submodule 𝕜 E} : + supr U ⟂ V ↔ ∀ i, U i ⟂ V := +supr_le_iff + +@[simp] lemma is_ortho_supr_right {ι : Sort*} {U : submodule 𝕜 E} {V : ι → submodule 𝕜 E} : + U ⟂ supr V ↔ ∀ i, U ⟂ V i := +is_ortho_comm.trans $ is_ortho_supr_left.trans $ by simp_rw is_ortho_comm + +@[simp] lemma is_ortho_span {s t : set E} : + span 𝕜 s ⟂ span 𝕜 t ↔ ∀ ⦃u⦄, u ∈ s → ∀ ⦃v⦄, v ∈ t → ⟪u, v⟫ = 0 := +begin + simp_rw [span_eq_supr_of_singleton_spans s, span_eq_supr_of_singleton_spans t, + is_ortho_supr_left, is_ortho_supr_right, is_ortho_iff_le, span_le, set.subset_def, + set_like.mem_coe, mem_orthogonal_singleton_iff_inner_left, set.mem_singleton_iff, forall_eq], +end + +lemma is_ortho.map (f : E →ₗᵢ[𝕜] F) {U V : submodule 𝕜 E} (h : U ⟂ V) : U.map f ⟂ V.map f := +begin + rw is_ortho_iff_inner_eq at *, + simp_rw [mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂, + linear_isometry.inner_map_map], + exact h, +end + +lemma is_ortho.comap (f : E →ₗᵢ[𝕜] F) {U V : submodule 𝕜 F} (h : U ⟂ V) : U.comap f ⟂ V.comap f := +begin + rw is_ortho_iff_inner_eq at *, + simp_rw [mem_comap, ←f.inner_map_map], + intros u hu v hv, + exact h _ hu _ hv, +end + +@[simp] lemma is_ortho.map_iff (f : E ≃ₗᵢ[𝕜] F) {U V : submodule 𝕜 E} : U.map f ⟂ V.map f ↔ U ⟂ V := +⟨λ h, begin + have hf : ∀ p : submodule 𝕜 E, (p.map f).comap f.to_linear_isometry = p := + comap_map_eq_of_injective f.injective, + simpa only [hf] using h.comap f.to_linear_isometry, +end, is_ortho.map f.to_linear_isometry⟩ + +@[simp] lemma is_ortho.comap_iff (f : E ≃ₗᵢ[𝕜] F) {U V : submodule 𝕜 F} : + U.comap f ⟂ V.comap f ↔ U ⟂ V := +⟨λ h, begin + have hf : ∀ p : submodule 𝕜 F, (p.comap f).map f.to_linear_isometry = p := + map_comap_eq_of_surjective f.surjective, + simpa only [hf] using h.map f.to_linear_isometry, +end, is_ortho.comap f.to_linear_isometry⟩ + +end submodule + +lemma orthogonal_family_iff_pairwise {ι} {V : ι → submodule 𝕜 E} : + orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ) ↔ pairwise ((⟂) on V) := +forall₃_congr $ λ i j hij, + subtype.forall.trans $ forall₂_congr $ λ x hx, subtype.forall.trans $ forall₂_congr $ λ y hy, + inner_eq_zero_symm + +alias orthogonal_family_iff_pairwise ↔ orthogonal_family.pairwise orthogonal_family.of_pairwise + +/-- Two submodules in an orthogonal family with different indices are orthogonal. -/ +lemma orthogonal_family.is_ortho {ι} {V : ι → submodule 𝕜 E} + (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) {i j : ι} (hij : i ≠ j) : + V i ⟂ V j := +hV.pairwise hij diff --git a/src/analysis/inner_product_space/pi_L2.lean b/src/analysis/inner_product_space/pi_L2.lean index 774acfea5dc85..ccad358197ccc 100644 --- a/src/analysis/inner_product_space/pi_L2.lean +++ b/src/analysis/inner_product_space/pi_L2.lean @@ -5,16 +5,30 @@ Authors: Joseph Myers, Sébastien Gouëzel, Heather Macbeth -/ import analysis.inner_product_space.projection import analysis.normed_space.pi_Lp +import linear_algebra.finite_dimensional +import linear_algebra.unitary_group /-! # `L²` inner product space structure on finite products of inner product spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The `L²` norm on a finite product of inner product spaces is compatible with an inner product $$ \langle x, y\rangle = \sum \langle x_i, y_i \rangle. $$ This is recorded in this file as an inner product space instance on `pi_Lp 2`. +This file develops the notion of a finite dimensional Hilbert space over `𝕜 = ℂ, ℝ`, referred to as +`E`. We define an `orthonormal_basis 𝕜 ι E` as a linear isometric equivalence +between `E` and `euclidean_space 𝕜 ι`. Then `std_orthonormal_basis` shows that such an equivalence +always exists if `E` is finite dimensional. We provide language for converting between a basis +that is orthonormal and an orthonormal basis (e.g. `basis.to_orthonormal_basis`). We show that +orthonormal bases for each summand in a direct sum of spaces can be combined into an orthonormal +basis for the the whole sum in `direct_sum.submodule_is_internal.subordinate_orthonormal_basis`. In +the last section, various properties of matrices are explored. + ## Main definitions - `euclidean_space 𝕜 n`: defined to be `pi_Lp 2 (n → 𝕜)` for any `fintype n`, i.e., the space @@ -27,23 +41,30 @@ This is recorded in this file as an inner product space instance on `pi_Lp 2`. - `basis.to_orthonormal_basis`: constructs an `orthonormal_basis` for a finite-dimensional Euclidean space from a `basis` which is `orthonormal`. -- `linear_isometry_equiv.of_inner_product_space`: provides an arbitrary isometry to Euclidean space - from a given finite-dimensional inner product space, induced by choosing an arbitrary basis. +- `orthonormal.exists_orthonormal_basis_extension`: provides an existential result of an + `orthonormal_basis` extending a given orthonormal set + +- `exists_orthonormal_basis`: provides an orthonormal basis on a finite dimensional vector space + +- `std_orthonormal_basis`: provides an arbitrarily-chosen `orthonormal_basis` of a given finite + dimensional inner product space -- `complex.isometry_euclidean`: standard isometry from `ℂ` to `euclidean_space ℝ (fin 2)` +For consequences in infinite dimension (Hilbert bases, etc.), see the file +`analysis.inner_product_space.l2_space`. -/ -open real set filter is_R_or_C -open_locale big_operators uniformity topological_space nnreal ennreal complex_conjugate direct_sum +open real set filter is_R_or_C submodule function +open_locale big_operators uniformity topology nnreal ennreal complex_conjugate direct_sum noncomputable theory -variables {ι : Type*} -variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [inner_product_space 𝕜 E] -variables {E' : Type*} [inner_product_space 𝕜 E'] -variables {F : Type*} [inner_product_space ℝ F] -variables {F' : Type*} [inner_product_space ℝ F'] +variables {ι : Type*} {ι' : Type*} +variables {𝕜 : Type*} [is_R_or_C 𝕜] +variables {E : Type*} [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables {E' : Type*} [normed_add_comm_group E'] [inner_product_space 𝕜 E'] +variables {F : Type*} [normed_add_comm_group F] [inner_product_space ℝ F] +variables {F' : Type*} [normed_add_comm_group F'] [inner_product_space ℝ F'] local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y /- @@ -52,25 +73,19 @@ then `Π i, f i` is an inner product space as well. Since `Π i, f i` is endowed we use instead `pi_Lp 2 f` for the product space, which is endowed with the `L^2` norm. -/ instance pi_Lp.inner_product_space {ι : Type*} [fintype ι] (f : ι → Type*) - [Π i, inner_product_space 𝕜 (f i)] : inner_product_space 𝕜 (pi_Lp 2 f) := + [Π i, normed_add_comm_group (f i)] [Π i, inner_product_space 𝕜 (f i)] : + inner_product_space 𝕜 (pi_Lp 2 f) := { inner := λ x y, ∑ i, inner (x i) (y i), - norm_sq_eq_inner := - begin - intro x, - have h₂ : 0 ≤ ∑ (i : ι), ∥x i∥ ^ (2 : ℝ) := - finset.sum_nonneg (λ j hj, rpow_nonneg_of_nonneg (norm_nonneg (x j)) 2), - simp only [norm, add_monoid_hom.map_sum, ← norm_sq_eq_inner, one_div], - rw [← rpow_nat_cast ((∑ (i : ι), ∥x i∥ ^ (2 : ℝ)) ^ (2 : ℝ)⁻¹) 2, ← rpow_mul h₂], - norm_num, - end, - conj_sym := + norm_sq_eq_inner := λ x, + by simp only [pi_Lp.norm_sq_eq_of_L2, add_monoid_hom.map_sum, ← norm_sq_eq_inner, one_div], + conj_symm := begin intros x y, unfold inner, rw ring_hom.map_sum, apply finset.sum_congr rfl, rintros z -, - apply inner_conj_sym, + apply inner_conj_symm, end, add_left := λ x y z, show ∑ i, inner (x i + y i) (z i) = ∑ i, inner (x i) (z i) + ∑ i, inner (y i) (z i), @@ -80,24 +95,35 @@ instance pi_Lp.inner_product_space {ι : Type*} [fintype ι] (f : ι → Type*) by simp only [finset.mul_sum, inner_smul_left] } @[simp] lemma pi_Lp.inner_apply {ι : Type*} [fintype ι] {f : ι → Type*} - [Π i, inner_product_space 𝕜 (f i)] (x y : pi_Lp 2 f) : + [Π i, normed_add_comm_group (f i)] [Π i, inner_product_space 𝕜 (f i)] (x y : pi_Lp 2 f) : ⟪x, y⟫ = ∑ i, ⟪x i, y i⟫ := rfl -lemma pi_Lp.norm_eq_of_L2 {ι : Type*} [fintype ι] {f : ι → Type*} - [Π i, inner_product_space 𝕜 (f i)] (x : pi_Lp 2 f) : - ∥x∥ = sqrt (∑ (i : ι), ∥x i∥ ^ 2) := -by { rw [pi_Lp.norm_eq_of_nat 2]; simp [sqrt_eq_rpow] } - /-- The standard real/complex Euclidean space, functions on a finite type. For an `n`-dimensional space use `euclidean_space 𝕜 (fin n)`. -/ @[reducible, nolint unused_arguments] def euclidean_space (𝕜 : Type*) [is_R_or_C 𝕜] (n : Type*) [fintype n] : Type* := pi_Lp 2 (λ (i : n), 𝕜) +lemma euclidean_space.nnnorm_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n] + (x : euclidean_space 𝕜 n) : ‖x‖₊ = nnreal.sqrt (∑ i, ‖x i‖₊ ^ 2) := +pi_Lp.nnnorm_eq_of_L2 x + lemma euclidean_space.norm_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n] - (x : euclidean_space 𝕜 n) : ∥x∥ = real.sqrt (∑ (i : n), ∥x i∥ ^ 2) := -pi_Lp.norm_eq_of_L2 x + (x : euclidean_space 𝕜 n) : ‖x‖ = real.sqrt (∑ i, ‖x i‖ ^ 2) := +by simpa only [real.coe_sqrt, nnreal.coe_sum] using congr_arg (coe : ℝ≥0 → ℝ) x.nnnorm_eq + +lemma euclidean_space.dist_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n] + (x y : euclidean_space 𝕜 n) : dist x y = (∑ i, dist (x i) (y i) ^ 2).sqrt := +(pi_Lp.dist_eq_of_L2 x y : _) + +lemma euclidean_space.nndist_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n] + (x y : euclidean_space 𝕜 n) : nndist x y = (∑ i, nndist (x i) (y i) ^ 2).sqrt := +(pi_Lp.nndist_eq_of_L2 x y : _) + +lemma euclidean_space.edist_eq {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n] + (x y : euclidean_space 𝕜 n) : edist x y = (∑ i, edist (x i) (y i) ^ 2) ^ (1 / 2 : ℝ) := +(pi_Lp.edist_eq_of_L2 x y : _) variables [fintype ι] @@ -113,16 +139,22 @@ instance : inner_product_space 𝕜 (euclidean_space 𝕜 ι) := by apply_instan lemma finrank_euclidean_space_fin {n : ℕ} : finite_dimensional.finrank 𝕜 (euclidean_space 𝕜 (fin n)) = n := by simp +lemma euclidean_space.inner_eq_star_dot_product (x y : euclidean_space 𝕜 ι) : + ⟪x, y⟫ = matrix.dot_product (star $ pi_Lp.equiv _ _ x) (pi_Lp.equiv _ _ y) := rfl + +lemma euclidean_space.inner_pi_Lp_equiv_symm (x y : ι → 𝕜) : + ⟪(pi_Lp.equiv 2 _).symm x, (pi_Lp.equiv 2 _).symm y⟫ = matrix.dot_product (star x) y := rfl + /-- A finite, mutually orthogonal family of subspaces of `E`, which span `E`, induce an isometry from `E` to `pi_Lp 2` of the subspaces equipped with the `L2` inner product. -/ -def direct_sum.submodule_is_internal.isometry_L2_of_orthogonal_family - [decidable_eq ι] {V : ι → submodule 𝕜 E} (hV : direct_sum.submodule_is_internal V) - (hV' : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) : +def direct_sum.is_internal.isometry_L2_of_orthogonal_family + [decidable_eq ι] {V : ι → submodule 𝕜 E} (hV : direct_sum.is_internal V) + (hV' : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : E ≃ₗᵢ[𝕜] pi_Lp 2 (λ i, V i) := begin let e₁ := direct_sum.linear_equiv_fun_on_fintype 𝕜 ι (λ i, V i), - let e₂ := linear_equiv.of_bijective _ hV.injective hV.surjective, - refine (e₂.symm.trans e₁).isometry_of_inner _, + let e₂ := linear_equiv.of_bijective (direct_sum.coe_linear_map V) hV, + refine linear_equiv.isometry_of_inner (e₂.symm.trans e₁) _, suffices : ∀ v w, ⟪v, w⟫ = ⟪e₂ (e₁.symm v), e₂ (e₁.symm w)⟫, { intros v₀ w₀, convert this (e₁ (e₂.symm v₀)) (e₁ (e₂.symm w₀)); @@ -133,32 +165,63 @@ begin { congr; simp } end -@[simp] lemma direct_sum.submodule_is_internal.isometry_L2_of_orthogonal_family_symm_apply - [decidable_eq ι] {V : ι → submodule 𝕜 E} (hV : direct_sum.submodule_is_internal V) - (hV' : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) +@[simp] lemma direct_sum.is_internal.isometry_L2_of_orthogonal_family_symm_apply + [decidable_eq ι] {V : ι → submodule 𝕜 E} (hV : direct_sum.is_internal V) + (hV' : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) (w : pi_Lp 2 (λ i, V i)) : (hV.isometry_L2_of_orthogonal_family hV').symm w = ∑ i, (w i : E) := begin classical, let e₁ := direct_sum.linear_equiv_fun_on_fintype 𝕜 ι (λ i, V i), - let e₂ := linear_equiv.of_bijective _ hV.injective hV.surjective, + let e₂ := linear_equiv.of_bijective (direct_sum.coe_linear_map V) hV, suffices : ∀ v : ⨁ i, V i, e₂ v = ∑ i, e₁ v i, { exact this (e₁.symm w) }, intros v, - simp [e₂, direct_sum.submodule_coe, direct_sum.to_module, dfinsupp.sum_add_hom_apply] + simp [e₂, direct_sum.coe_linear_map, direct_sum.to_module, dfinsupp.sum_add_hom_apply] end end +variables (ι 𝕜) + +-- TODO : This should be generalized to `pi_Lp` with finite dimensional factors. +/-- `pi_Lp.linear_equiv` upgraded to a continuous linear map between `euclidean_space 𝕜 ι` +and `ι → 𝕜`. -/ +@[simps] def euclidean_space.equiv : + euclidean_space 𝕜 ι ≃L[𝕜] (ι → 𝕜) := +(pi_Lp.linear_equiv 2 𝕜 (λ i : ι, 𝕜)).to_continuous_linear_equiv + +variables {ι 𝕜} + +-- TODO : This should be generalized to `pi_Lp`. +/-- The projection on the `i`-th coordinate of `euclidean_space 𝕜 ι`, as a linear map. -/ +@[simps] def euclidean_space.projₗ (i : ι) : + euclidean_space 𝕜 ι →ₗ[𝕜] 𝕜 := +(linear_map.proj i).comp (pi_Lp.linear_equiv 2 𝕜 (λ i : ι, 𝕜) : euclidean_space 𝕜 ι →ₗ[𝕜] ι → 𝕜) + +-- TODO : This should be generalized to `pi_Lp`. +/-- The projection on the `i`-th coordinate of `euclidean_space 𝕜 ι`, +as a continuous linear map. -/ +@[simps] def euclidean_space.proj (i : ι) : + euclidean_space 𝕜 ι →L[𝕜] 𝕜 := +⟨euclidean_space.projₗ i, continuous_apply i⟩ + +-- TODO : This should be generalized to `pi_Lp`. /-- The vector given in euclidean space by being `1 : 𝕜` at coordinate `i : ι` and `0 : 𝕜` at all other coordinates. -/ def euclidean_space.single [decidable_eq ι] (i : ι) (a : 𝕜) : euclidean_space 𝕜 ι := -pi.single i a +(pi_Lp.equiv _ _).symm (pi.single i a) + +@[simp] lemma pi_Lp.equiv_single [decidable_eq ι] (i : ι) (a : 𝕜) : + pi_Lp.equiv _ _ (euclidean_space.single i a) = pi.single i a := rfl + +@[simp] lemma pi_Lp.equiv_symm_single [decidable_eq ι] (i : ι) (a : 𝕜) : + (pi_Lp.equiv _ _).symm (pi.single i a) = euclidean_space.single i a := rfl @[simp] theorem euclidean_space.single_apply [decidable_eq ι] (i : ι) (a : 𝕜) (j : ι) : (euclidean_space.single i a) j = ite (j = i) a 0 := -by { rw [euclidean_space.single, ← pi.single_apply i a j] } +by { rw [euclidean_space.single, pi_Lp.equiv_symm_apply, ← pi.single_apply i a j] } lemma euclidean_space.inner_single_left [decidable_eq ι] (i : ι) (a : 𝕜) (v : euclidean_space 𝕜 ι) : ⟪euclidean_space.single i (a : 𝕜), v⟫ = conj a * (v i) := @@ -166,9 +229,45 @@ by simp [apply_ite conj] lemma euclidean_space.inner_single_right [decidable_eq ι] (i : ι) (a : 𝕜) (v : euclidean_space 𝕜 ι) : - ⟪v, euclidean_space.single i (a : 𝕜)⟫ = a * conj (v i) := + ⟪v, euclidean_space.single i (a : 𝕜)⟫ = a * conj (v i) := by simp [apply_ite conj, mul_comm] +@[simp] lemma euclidean_space.norm_single [decidable_eq ι] (i : ι) (a : 𝕜) : + ‖euclidean_space.single i (a : 𝕜)‖ = ‖a‖ := +(pi_Lp.norm_equiv_symm_single 2 (λ i, 𝕜) i a : _) + +@[simp] lemma euclidean_space.nnnorm_single [decidable_eq ι] (i : ι) (a : 𝕜) : + ‖euclidean_space.single i (a : 𝕜)‖₊ = ‖a‖₊ := +(pi_Lp.nnnorm_equiv_symm_single 2 (λ i, 𝕜) i a : _) + +@[simp] lemma euclidean_space.dist_single_same [decidable_eq ι] (i : ι) (a b : 𝕜) : + dist (euclidean_space.single i (a : 𝕜)) (euclidean_space.single i (b : 𝕜)) = dist a b := +(pi_Lp.dist_equiv_symm_single_same 2 (λ i, 𝕜) i a b : _) + +@[simp] lemma euclidean_space.nndist_single_same [decidable_eq ι] (i : ι) (a b : 𝕜) : + nndist (euclidean_space.single i (a : 𝕜)) (euclidean_space.single i (b : 𝕜)) = nndist a b := +(pi_Lp.nndist_equiv_symm_single_same 2 (λ i, 𝕜) i a b : _) + +@[simp] lemma euclidean_space.edist_single_same [decidable_eq ι] (i : ι) (a b : 𝕜) : + edist (euclidean_space.single i (a : 𝕜)) (euclidean_space.single i (b : 𝕜)) = edist a b := +(pi_Lp.edist_equiv_symm_single_same 2 (λ i, 𝕜) i a b : _) + +/-- `euclidean_space.single` forms an orthonormal family. -/ +lemma euclidean_space.orthonormal_single [decidable_eq ι] : + orthonormal 𝕜 (λ i : ι, euclidean_space.single i (1 : 𝕜)) := +begin + simp_rw [orthonormal_iff_ite, euclidean_space.inner_single_left, map_one, one_mul, + euclidean_space.single_apply], + intros i j, + refl, +end + +lemma euclidean_space.pi_Lp_congr_left_single [decidable_eq ι] {ι' : Type*} [fintype ι'] + [decidable_eq ι'] (e : ι' ≃ ι) (i' : ι') (v : 𝕜): + linear_isometry_equiv.pi_Lp_congr_left 2 𝕜 𝕜 e (euclidean_space.single i' v) = + euclidean_space.single (e i') v := +linear_isometry_equiv.pi_Lp_congr_left_single e i' _ + variables (ι 𝕜 E) /-- An orthonormal basis on E is an identification of `E` with its dimensional-matching @@ -186,18 +285,23 @@ instance : inhabited (orthonormal_basis ι 𝕜 (euclidean_space 𝕜 ι)) := instance : has_coe_to_fun (orthonormal_basis ι 𝕜 E) (λ _, ι → E) := { coe := λ b i, by classical; exact b.repr.symm (euclidean_space.single i (1 : 𝕜)) } +@[simp] lemma coe_of_repr [decidable_eq ι] (e : E ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι) : + ⇑(orthonormal_basis.of_repr e) = λ i, e.symm (euclidean_space.single i (1 : 𝕜)) := +begin + rw coe_fn, + unfold has_coe_to_fun.coe, + funext, + congr, + simp only [eq_iff_true_of_subsingleton], +end + @[simp] protected lemma repr_symm_single [decidable_eq ι] (b : orthonormal_basis ι 𝕜 E) (i : ι) : b.repr.symm (euclidean_space.single i (1:𝕜)) = b i := by { classical, congr, simp, } @[simp] protected lemma repr_self [decidable_eq ι] (b : orthonormal_basis ι 𝕜 E) (i : ι) : b.repr (b i) = euclidean_space.single i (1:𝕜) := -begin - classical, - rw [← b.repr_symm_single i, linear_isometry_equiv.apply_symm_apply], - congr, - simp, -end +by rw [← b.repr_symm_single i, linear_isometry_equiv.apply_symm_apply] protected lemma repr_apply_apply (b : orthonormal_basis ι 𝕜 E) (v : E) (i : ι) : b.repr v i = ⟪b i, v⟫ := @@ -213,13 +317,11 @@ begin classical, rw orthonormal_iff_ite, intros i j, - rw [← b.repr.inner_map_map (b i) (b j), b.repr_self i, b.repr_self j], - rw euclidean_space.inner_single_left, - rw euclidean_space.single_apply, - simp only [mul_boole, map_one], + rw [← b.repr.inner_map_map (b i) (b j), b.repr_self i, b.repr_self j, + euclidean_space.inner_single_left, euclidean_space.single_apply, map_one, one_mul], end -/-- The `basis ι 𝕜 E` underlying the `orthonormal_basis` --/ +/-- The `basis ι 𝕜 E` underlying the `orthonormal_basis` -/ protected def to_basis (b : orthonormal_basis ι 𝕜 E) : basis ι 𝕜 E := basis.of_equiv_fun b.repr.to_linear_equiv @@ -228,25 +330,60 @@ basis.of_equiv_fun b.repr.to_linear_equiv begin change ⇑(basis.of_equiv_fun b.repr.to_linear_equiv) = b, ext j, + classical, rw basis.coe_of_equiv_fun, - simp only [orthonormal_basis.repr_symm_single], congr, end @[simp] protected lemma coe_to_basis_repr (b : orthonormal_basis ι 𝕜 E) : b.to_basis.equiv_fun = b.repr.to_linear_equiv := -begin - change (basis.of_equiv_fun b.repr.to_linear_equiv).equiv_fun = b.repr.to_linear_equiv, - ext x j, - simp only [basis.of_equiv_fun_repr_apply, eq_self_iff_true, - linear_isometry_equiv.coe_to_linear_equiv, basis.equiv_fun_apply], -end +basis.equiv_fun_of_equiv_fun _ + +@[simp] protected lemma coe_to_basis_repr_apply (b : orthonormal_basis ι 𝕜 E) (x : E) (i : ι) : + b.to_basis.repr x i = b.repr x i := +by {rw [← basis.equiv_fun_apply, orthonormal_basis.coe_to_basis_repr, + linear_isometry_equiv.coe_to_linear_equiv]} + +protected lemma sum_repr (b : orthonormal_basis ι 𝕜 E) (x : E) : + ∑ i, b.repr x i • b i = x := +by { simp_rw [← b.coe_to_basis_repr_apply, ← b.coe_to_basis], exact b.to_basis.sum_repr x } protected lemma sum_repr_symm (b : orthonormal_basis ι 𝕜 E) (v : euclidean_space 𝕜 ι) : ∑ i , v i • b i = (b.repr.symm v) := -by { classical, simpa using (b.to_basis.equiv_fun_symm_apply v).symm } +by { simpa using (b.to_basis.equiv_fun_symm_apply v).symm } -variable {v : ι → E} +protected lemma sum_inner_mul_inner (b : orthonormal_basis ι 𝕜 E) (x y : E) : + ∑ i, ⟪x, b i⟫ * ⟪b i, y⟫ = ⟪x, y⟫ := +begin + have := congr_arg (innerSL 𝕜 x) (b.sum_repr y), + rw map_sum at this, + convert this, + ext i, + rw [smul_hom_class.map_smul, b.repr_apply_apply, mul_comm], + refl, +end + +protected lemma orthogonal_projection_eq_sum {U : submodule 𝕜 E} [complete_space U] + (b : orthonormal_basis ι 𝕜 U) (x : E) : + orthogonal_projection U x = ∑ i, ⟪(b i : E), x⟫ • b i := +by simpa only [b.repr_apply_apply, inner_orthogonal_projection_eq_of_mem_left] + using (b.sum_repr (orthogonal_projection U x)).symm + +/-- Mapping an orthonormal basis along a `linear_isometry_equiv`. -/ +protected def map {G : Type*} + [normed_add_comm_group G] [inner_product_space 𝕜 G] (b : orthonormal_basis ι 𝕜 E) + (L : E ≃ₗᵢ[𝕜] G) : + orthonormal_basis ι 𝕜 G := +{ repr := L.symm.trans b.repr } + +@[simp] protected lemma map_apply {G : Type*} [normed_add_comm_group G] [inner_product_space 𝕜 G] + (b : orthonormal_basis ι 𝕜 E) (L : E ≃ₗᵢ[𝕜] G) (i : ι) : + b.map L i = L (b i) := rfl + +@[simp] protected lemma to_basis_map {G : Type*} [normed_add_comm_group G] [inner_product_space 𝕜 G] + (b : orthonormal_basis ι 𝕜 E) (L : E ≃ₗᵢ[𝕜] G) : + (b.map L).to_basis = b.to_basis.map L.to_linear_equiv := +rfl /-- A basis that is orthonormal is an orthonormal basis. -/ def _root_.basis.to_orthonormal_basis (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) : @@ -283,102 +420,351 @@ calc (v.to_orthonormal_basis hv : ι → E) = ((v.to_orthonormal_basis hv).to_ba by { classical, rw orthonormal_basis.coe_to_basis } ... = (v : ι → E) : by simp -/-- An orthonormal set that spans is an orthonormal basis -/ -protected def mk (hon : orthonormal 𝕜 v) (hsp: submodule.span 𝕜 (set.range v) = ⊤): +variable {v : ι → E} + +/-- A finite orthonormal set that spans is an orthonormal basis -/ +protected def mk (hon : orthonormal 𝕜 v) (hsp: ⊤ ≤ submodule.span 𝕜 (set.range v)): orthonormal_basis ι 𝕜 E := (basis.mk (orthonormal.linear_independent hon) hsp).to_orthonormal_basis (by rwa basis.coe_mk) @[simp] -protected lemma coe_mk (hon : orthonormal 𝕜 v) (hsp: submodule.span 𝕜 (set.range v) = ⊤) : +protected lemma coe_mk (hon : orthonormal 𝕜 v) (hsp: ⊤ ≤ submodule.span 𝕜 (set.range v)) : ⇑(orthonormal_basis.mk hon hsp) = v := by classical; rw [orthonormal_basis.mk, _root_.basis.coe_to_orthonormal_basis, basis.coe_mk] +/-- Any finite subset of a orthonormal family is an `orthonormal_basis` for its span. -/ +protected def span [decidable_eq E] {v' : ι' → E} (h : orthonormal 𝕜 v') (s : finset ι') : + orthonormal_basis s 𝕜 (span 𝕜 (s.image v' : set E)) := +let + e₀' : basis s 𝕜 _ := basis.span (h.linear_independent.comp (coe : s → ι') subtype.coe_injective), + e₀ : orthonormal_basis s 𝕜 _ := orthonormal_basis.mk + begin + convert orthonormal_span (h.comp (coe : s → ι') subtype.coe_injective), + ext, + simp [e₀', basis.span_apply], + end e₀'.span_eq.ge, + φ : span 𝕜 (s.image v' : set E) ≃ₗᵢ[𝕜] span 𝕜 (range (v' ∘ (coe : s → ι'))) := + linear_isometry_equiv.of_eq _ _ + begin + rw [finset.coe_image, image_eq_range], + refl + end +in +e₀.map φ.symm + +@[simp] protected lemma span_apply [decidable_eq E] + {v' : ι' → E} (h : orthonormal 𝕜 v') (s : finset ι') (i : s) : + (orthonormal_basis.span h s i : E) = v' i := +by simp only [orthonormal_basis.span, basis.span_apply, linear_isometry_equiv.of_eq_symm, + orthonormal_basis.map_apply, orthonormal_basis.coe_mk, + linear_isometry_equiv.coe_of_eq_apply] + +open submodule + +/-- A finite orthonormal family of vectors whose span has trivial orthogonal complement is an +orthonormal basis. -/ +protected def mk_of_orthogonal_eq_bot (hon : orthonormal 𝕜 v) (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) : + orthonormal_basis ι 𝕜 E := +orthonormal_basis.mk hon +begin + refine eq.ge _, + haveI : finite_dimensional 𝕜 (span 𝕜 (range v)) := + finite_dimensional.span_of_finite 𝕜 (finite_range v), + haveI : complete_space (span 𝕜 (range v)) := finite_dimensional.complete 𝕜 _, + rwa orthogonal_eq_bot_iff at hsp, +end + +@[simp] protected lemma coe_of_orthogonal_eq_bot_mk (hon : orthonormal 𝕜 v) + (hsp : (span 𝕜 (set.range v))ᗮ = ⊥) : + ⇑(orthonormal_basis.mk_of_orthogonal_eq_bot hon hsp) = v := +orthonormal_basis.coe_mk hon _ + +variables [fintype ι'] + +/-- `b.reindex (e : ι ≃ ι')` is an `orthonormal_basis` indexed by `ι'` -/ +def reindex (b : orthonormal_basis ι 𝕜 E) (e : ι ≃ ι') : orthonormal_basis ι' 𝕜 E := +orthonormal_basis.of_repr (b.repr.trans (linear_isometry_equiv.pi_Lp_congr_left 2 𝕜 𝕜 e)) + +protected lemma reindex_apply (b : orthonormal_basis ι 𝕜 E) (e : ι ≃ ι') (i' : ι') : + (b.reindex e) i' = b (e.symm i') := +begin + classical, + dsimp [reindex, orthonormal_basis.has_coe_to_fun], + rw coe_of_repr, + dsimp, + rw [← b.repr_symm_single, linear_isometry_equiv.pi_Lp_congr_left_symm, + euclidean_space.pi_Lp_congr_left_single], +end + +@[simp] protected lemma coe_reindex (b : orthonormal_basis ι 𝕜 E) (e : ι ≃ ι') : + ⇑(b.reindex e) = ⇑b ∘ ⇑(e.symm) := +funext (b.reindex_apply e) + +@[simp] protected lemma repr_reindex + (b : orthonormal_basis ι 𝕜 E) (e : ι ≃ ι') (x : E) (i' : ι') : + (b.reindex e).repr x i' = b.repr x (e.symm i') := +by { classical, + rw [orthonormal_basis.repr_apply_apply, b.repr_apply_apply, orthonormal_basis.coe_reindex] } + end orthonormal_basis -/-- If `f : E ≃ₗᵢ[𝕜] E'` is a linear isometry of inner product spaces then an orthonormal basis `v` -of `E` determines a linear isometry `e : E' ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι`. This result states that -`e` may be obtained either by transporting `v` to `E'` or by composing with the linear isometry -`E ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι` provided by `v`. -/ -@[simp] lemma basis.map_isometry_euclidean_of_orthonormal (v : basis ι 𝕜 E) (hv : orthonormal 𝕜 v) - (f : E ≃ₗᵢ[𝕜] E') : - ((v.map f.to_linear_equiv).to_orthonormal_basis (hv.map_linear_isometry_equiv f)).repr = - f.symm.trans (v.to_orthonormal_basis hv).repr := -linear_isometry_equiv.to_linear_equiv_injective $ v.map_equiv_fun _ - -/-- `ℂ` is isometric to `ℝ²` with the Euclidean inner product. -/ -def complex.isometry_euclidean : ℂ ≃ₗᵢ[ℝ] (euclidean_space ℝ (fin 2)) := +/-- `![1, I]` is an orthonormal basis for `ℂ` considered as a real inner product space. -/ +def complex.orthonormal_basis_one_I : orthonormal_basis (fin 2) ℝ ℂ := (complex.basis_one_I.to_orthonormal_basis begin rw orthonormal_iff_ite, intros i, fin_cases i; intros j; fin_cases j; simp [real_inner_eq_re_inner] -end).repr +end) -@[simp] lemma complex.isometry_euclidean_symm_apply (x : euclidean_space ℝ (fin 2)) : - complex.isometry_euclidean.symm x = (x 0) + (x 1) * I := -begin - convert complex.basis_one_I.equiv_fun_symm_apply x, - { simpa }, - { simp }, -end +@[simp] lemma complex.orthonormal_basis_one_I_repr_apply (z : ℂ) : + complex.orthonormal_basis_one_I.repr z = ![z.re, z.im] := +rfl -lemma complex.isometry_euclidean_proj_eq_self (z : ℂ) : - ↑(complex.isometry_euclidean z 0) + ↑(complex.isometry_euclidean z 1) * (I : ℂ) = z := -by rw [← complex.isometry_euclidean_symm_apply (complex.isometry_euclidean z), - complex.isometry_euclidean.symm_apply_apply z] +@[simp] lemma complex.orthonormal_basis_one_I_repr_symm_apply (x : euclidean_space ℝ (fin 2)) : + complex.orthonormal_basis_one_I.repr.symm x = (x 0) + (x 1) * I := +rfl -@[simp] lemma complex.isometry_euclidean_apply_zero (z : ℂ) : - complex.isometry_euclidean z 0 = z.re := -by { conv_rhs { rw ← complex.isometry_euclidean_proj_eq_self z }, simp } +@[simp] lemma complex.to_basis_orthonormal_basis_one_I : + complex.orthonormal_basis_one_I.to_basis = complex.basis_one_I := +basis.to_basis_to_orthonormal_basis _ _ -@[simp] lemma complex.isometry_euclidean_apply_one (z : ℂ) : - complex.isometry_euclidean z 1 = z.im := -by { conv_rhs { rw ← complex.isometry_euclidean_proj_eq_self z }, simp } +@[simp] lemma complex.coe_orthonormal_basis_one_I : + (complex.orthonormal_basis_one_I : (fin 2) → ℂ) = ![1, I] := +by simp [complex.orthonormal_basis_one_I] /-- The isometry between `ℂ` and a two-dimensional real inner product space given by a basis. -/ -def complex.isometry_of_orthonormal {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) : ℂ ≃ₗᵢ[ℝ] F := -complex.isometry_euclidean.trans (v.to_orthonormal_basis hv).repr.symm +def complex.isometry_of_orthonormal (v : orthonormal_basis (fin 2) ℝ F) : ℂ ≃ₗᵢ[ℝ] F := +complex.orthonormal_basis_one_I.repr.trans v.repr.symm -@[simp] lemma complex.map_isometry_of_orthonormal {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) +@[simp] lemma complex.map_isometry_of_orthonormal (v : orthonormal_basis (fin 2) ℝ F) (f : F ≃ₗᵢ[ℝ] F') : - complex.isometry_of_orthonormal (hv.map_linear_isometry_equiv f) = - (complex.isometry_of_orthonormal hv).trans f := -by simp [complex.isometry_of_orthonormal, linear_isometry_equiv.trans_assoc] + complex.isometry_of_orthonormal (v.map f) = + (complex.isometry_of_orthonormal v).trans f := +by simp [complex.isometry_of_orthonormal, linear_isometry_equiv.trans_assoc, orthonormal_basis.map] lemma complex.isometry_of_orthonormal_symm_apply - {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) (f : F) : - (complex.isometry_of_orthonormal hv).symm f = (v.coord 0 f : ℂ) + (v.coord 1 f : ℂ) * I := + (v : orthonormal_basis (fin 2) ℝ F) (f : F) : + (complex.isometry_of_orthonormal v).symm f + = (v.to_basis.coord 0 f : ℂ) + (v.to_basis.coord 1 f : ℂ) * I := by simp [complex.isometry_of_orthonormal] lemma complex.isometry_of_orthonormal_apply - {v : basis (fin 2) ℝ F} (hv : orthonormal ℝ v) (z : ℂ) : - complex.isometry_of_orthonormal hv z = z.re • v 0 + z.im • v 1 := -by simp [complex.isometry_of_orthonormal, (dec_trivial : (finset.univ : finset (fin 2)) = {0, 1})] + (v : orthonormal_basis (fin 2) ℝ F) (z : ℂ) : + complex.isometry_of_orthonormal v z = z.re • v 0 + z.im • v 1 := +by simp [complex.isometry_of_orthonormal, ← v.sum_repr_symm] open finite_dimensional -/-- Given a natural number `n` equal to the `finrank` of a finite-dimensional inner product space, -there exists an isometry from the space to `euclidean_space 𝕜 (fin n)`. -/ -def linear_isometry_equiv.of_inner_product_space - [finite_dimensional 𝕜 E] {n : ℕ} (hn : finrank 𝕜 E = n) : - E ≃ₗᵢ[𝕜] (euclidean_space 𝕜 (fin n)) := -((fin_std_orthonormal_basis hn).to_orthonormal_basis - (fin_std_orthonormal_basis_orthonormal hn)).repr +/-! ### Matrix representation of an orthonormal basis with respect to another -/ + +section to_matrix +variables [decidable_eq ι] + +section +variables (a b : orthonormal_basis ι 𝕜 E) + +/-- The change-of-basis matrix between two orthonormal bases `a`, `b` is a unitary matrix. -/ +lemma orthonormal_basis.to_matrix_orthonormal_basis_mem_unitary : + a.to_basis.to_matrix b ∈ matrix.unitary_group ι 𝕜 := +begin + rw matrix.mem_unitary_group_iff', + ext i j, + convert a.repr.inner_map_map (b i) (b j), + rw orthonormal_iff_ite.mp b.orthonormal i j, + refl, +end + +/-- The determinant of the change-of-basis matrix between two orthonormal bases `a`, `b` has +unit length. -/ +@[simp] lemma orthonormal_basis.det_to_matrix_orthonormal_basis : + ‖a.to_basis.det b‖ = 1 := +begin + have : (norm_sq (a.to_basis.det b) : 𝕜) = 1, + { simpa [is_R_or_C.mul_conj] + using (matrix.det_of_mem_unitary (a.to_matrix_orthonormal_basis_mem_unitary b)).2 }, + norm_cast at this, + rwa [← sqrt_norm_sq_eq_norm, sqrt_eq_one], +end + +end + +section real +variables (a b : orthonormal_basis ι ℝ F) + +/-- The change-of-basis matrix between two orthonormal bases `a`, `b` is an orthogonal matrix. -/ +lemma orthonormal_basis.to_matrix_orthonormal_basis_mem_orthogonal : + a.to_basis.to_matrix b ∈ matrix.orthogonal_group ι ℝ := +a.to_matrix_orthonormal_basis_mem_unitary b + +/-- The determinant of the change-of-basis matrix between two orthonormal bases `a`, `b` is ±1. -/ +lemma orthonormal_basis.det_to_matrix_orthonormal_basis_real : + a.to_basis.det b = 1 ∨ a.to_basis.det b = -1 := +begin + rw ← sq_eq_one_iff, + simpa [unitary, sq] using matrix.det_of_mem_unitary (a.to_matrix_orthonormal_basis_mem_unitary b) +end + +end real + +end to_matrix + +/-! ### Existence of orthonormal basis, etc. -/ + +section finite_dimensional + +variables {v : set E} + +variables {A : ι → submodule 𝕜 E} + +/-- Given an internal direct sum decomposition of a module `M`, and an orthonormal basis for each +of the components of the direct sum, the disjoint union of these orthonormal bases is an +orthonormal basis for `M`. -/ +noncomputable def direct_sum.is_internal.collected_orthonormal_basis + (hV : orthogonal_family 𝕜 (λ i, A i) (λ i, (A i).subtypeₗᵢ)) + [decidable_eq ι] (hV_sum : direct_sum.is_internal (λ i, A i)) {α : ι → Type*} + [Π i, fintype (α i)] (v_family : Π i, orthonormal_basis (α i) 𝕜 (A i)) : + orthonormal_basis (Σ i, α i) 𝕜 E := +(hV_sum.collected_basis (λ i, (v_family i).to_basis)).to_orthonormal_basis $ +by simpa using hV.orthonormal_sigma_orthonormal + (show (∀ i, orthonormal 𝕜 (v_family i).to_basis), by simp) + +lemma direct_sum.is_internal.collected_orthonormal_basis_mem [decidable_eq ι] + (h : direct_sum.is_internal A) {α : ι → Type*} + [Π i, fintype (α i)] (hV : orthogonal_family 𝕜 (λ i, A i) (λ i, (A i).subtypeₗᵢ)) + (v : Π i, orthonormal_basis (α i) 𝕜 (A i)) (a : Σ i, α i) : + h.collected_orthonormal_basis hV v a ∈ A a.1 := +by simp [direct_sum.is_internal.collected_orthonormal_basis] + +variables [finite_dimensional 𝕜 E] + +/-- In a finite-dimensional `inner_product_space`, any orthonormal subset can be extended to an +orthonormal basis. -/ +lemma _root_.orthonormal.exists_orthonormal_basis_extension (hv : orthonormal 𝕜 (coe : v → E)) : + ∃ {u : finset E} (b : orthonormal_basis u 𝕜 E), v ⊆ u ∧ ⇑b = coe := +begin + obtain ⟨u₀, hu₀s, hu₀, hu₀_max⟩ := exists_maximal_orthonormal hv, + rw maximal_orthonormal_iff_orthogonal_complement_eq_bot hu₀ at hu₀_max, + have hu₀_finite : u₀.finite := hu₀.linear_independent.finite, + let u : finset E := hu₀_finite.to_finset, + let fu : ↥u ≃ ↥u₀ := equiv.cast (congr_arg coe_sort hu₀_finite.coe_to_finset), + have hfu : (coe : u → E) = (coe : u₀ → E) ∘ fu := by { ext, simp }, + have hu : orthonormal 𝕜 (coe : u → E) := by simpa [hfu] using hu₀.comp _ fu.injective, + refine ⟨u, orthonormal_basis.mk_of_orthogonal_eq_bot hu _, _, _⟩, + { simpa using hu₀_max }, + { simpa using hu₀s }, + { simp }, +end + +lemma _root_.orthonormal.exists_orthonormal_basis_extension_of_card_eq + {ι : Type*} [fintype ι] (card_ι : finrank 𝕜 E = fintype.card ι) {v : ι → E} {s : set ι} + (hv : orthonormal 𝕜 (s.restrict v)) : + ∃ b : orthonormal_basis ι 𝕜 E, ∀ i ∈ s, b i = v i := +begin + have hsv : injective (s.restrict v) := hv.linear_independent.injective, + have hX : orthonormal 𝕜 (coe : set.range (s.restrict v) → E), + { rwa orthonormal_subtype_range hsv }, + obtain ⟨Y, b₀, hX, hb₀⟩ := hX.exists_orthonormal_basis_extension, + have hιY : fintype.card ι = Y.card, + { refine (card_ι.symm.trans _), + exact finite_dimensional.finrank_eq_card_finset_basis b₀.to_basis }, + have hvsY : s.maps_to v Y := (s.maps_to_image v).mono_right (by rwa ← range_restrict), + have hsv' : set.inj_on v s, + { rw set.inj_on_iff_injective, + exact hsv }, + obtain ⟨g, hg⟩ := hvsY.exists_equiv_extend_of_card_eq hιY hsv', + use b₀.reindex g.symm, + intros i hi, + { simp [hb₀, hg i hi] }, +end + +variables (𝕜 E) + +/-- A finite-dimensional inner product space admits an orthonormal basis. -/ +lemma _root_.exists_orthonormal_basis : + ∃ (w : finset E) (b : orthonormal_basis w 𝕜 E), ⇑b = (coe : w → E) := +let ⟨w, hw, hw', hw''⟩ := (orthonormal_empty 𝕜 E).exists_orthonormal_basis_extension in +⟨w, hw, hw''⟩ + +/-- A finite-dimensional `inner_product_space` has an orthonormal basis. -/ +@[irreducible] def std_orthonormal_basis : orthonormal_basis (fin (finrank 𝕜 E)) 𝕜 E := +begin + let b := classical.some (classical.some_spec $ exists_orthonormal_basis 𝕜 E), + rw [finrank_eq_card_basis b.to_basis], + exact b.reindex (fintype.equiv_fin_of_card_eq rfl), +end + +/-- An orthonormal basis of `ℝ` is made either of the vector `1`, or of the vector `-1`. -/ +lemma orthonormal_basis_one_dim (b : orthonormal_basis ι ℝ ℝ) : + ⇑b = (λ _, (1 : ℝ)) ∨ ⇑b = (λ _, (-1 : ℝ)) := +begin + haveI : unique ι, from b.to_basis.unique, + have : b default = 1 ∨ b default = - 1, + { have : ‖b default‖ = 1, from b.orthonormal.1 _, + rwa [real.norm_eq_abs, abs_eq (zero_le_one : (0 : ℝ) ≤ 1)] at this }, + rw eq_const_of_unique b, + refine this.imp _ _; simp, +end + +variables {𝕜 E} + +section subordinate_orthonormal_basis +open direct_sum +variables {n : ℕ} (hn : finrank 𝕜 E = n) [decidable_eq ι] + {V : ι → submodule 𝕜 E} (hV : is_internal V) + +/-- Exhibit a bijection between `fin n` and the index set of a certain basis of an `n`-dimensional +inner product space `E`. This should not be accessed directly, but only via the subsequent API. -/ +@[irreducible] def direct_sum.is_internal.sigma_orthonormal_basis_index_equiv + (hV' : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : + (Σ i, fin (finrank 𝕜 (V i))) ≃ fin n := +let b := hV.collected_orthonormal_basis hV' (λ i, (std_orthonormal_basis 𝕜 (V i))) in +fintype.equiv_fin_of_card_eq $ (finite_dimensional.finrank_eq_card_basis b.to_basis).symm.trans hn + +/-- An `n`-dimensional `inner_product_space` equipped with a decomposition as an internal direct +sum has an orthonormal basis indexed by `fin n` and subordinate to that direct sum. -/ +@[irreducible] def direct_sum.is_internal.subordinate_orthonormal_basis + (hV' : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : + orthonormal_basis (fin n) 𝕜 E := +((hV.collected_orthonormal_basis hV' (λ i, (std_orthonormal_basis 𝕜 (V i)))).reindex + (hV.sigma_orthonormal_basis_index_equiv hn hV')) + +/-- An `n`-dimensional `inner_product_space` equipped with a decomposition as an internal direct +sum has an orthonormal basis indexed by `fin n` and subordinate to that direct sum. This function +provides the mapping by which it is subordinate. -/ +@[irreducible] def direct_sum.is_internal.subordinate_orthonormal_basis_index + (a : fin n) (hV' : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : ι := +((hV.sigma_orthonormal_basis_index_equiv hn hV').symm a).1 + +/-- The basis constructed in `orthogonal_family.subordinate_orthonormal_basis` is subordinate to +the `orthogonal_family` in question. -/ +lemma direct_sum.is_internal.subordinate_orthonormal_basis_subordinate + (a : fin n) (hV' : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : + (hV.subordinate_orthonormal_basis hn hV' a) ∈ + V (hV.subordinate_orthonormal_basis_index hn a hV') := +by simpa only [direct_sum.is_internal.subordinate_orthonormal_basis, + orthonormal_basis.coe_reindex, direct_sum.is_internal.subordinate_orthonormal_basis_index] + using hV.collected_orthonormal_basis_mem hV' (λ i, (std_orthonormal_basis 𝕜 (V i))) + ((hV.sigma_orthonormal_basis_index_equiv hn hV').symm a) + +end subordinate_orthonormal_basis + +end finite_dimensional local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ /-- Given a natural number `n` one less than the `finrank` of a finite-dimensional inner product space, there exists an isometry from the orthogonal complement of a nonzero singleton to `euclidean_space 𝕜 (fin n)`. -/ -def linear_isometry_equiv.from_orthogonal_span_singleton +def orthonormal_basis.from_orthogonal_span_singleton (n : ℕ) [fact (finrank 𝕜 E = n + 1)] {v : E} (hv : v ≠ 0) : - (𝕜 ∙ v)ᗮ ≃ₗᵢ[𝕜] (euclidean_space 𝕜 (fin n)) := -linear_isometry_equiv.of_inner_product_space (finrank_orthogonal_span_singleton hv) + orthonormal_basis (fin n) 𝕜 (𝕜 ∙ v)ᗮ := +(std_orthonormal_basis _ _).reindex $ fin_congr $ finrank_orthogonal_span_singleton hv section linear_isometry -variables {V : Type*} [inner_product_space 𝕜 V] [finite_dimensional 𝕜 V] +variables {V : Type*} [normed_add_comm_group V] [inner_product_space 𝕜 V] [finite_dimensional 𝕜 V] variables {S : submodule 𝕜 V} {L : S →ₗᵢ[𝕜] V} @@ -401,13 +787,9 @@ begin ... = finrank 𝕜 V - finrank 𝕜 S : by simp only [linear_map.finrank_range_of_inj L.injective] ... = finrank 𝕜 Sᗮ : by simp only - [← S.finrank_add_finrank_orthogonal, add_tsub_cancel_left] - ... = d : dim_S_perp, - let BS := ((fin_std_orthonormal_basis dim_S_perp).to_orthonormal_basis - (fin_std_orthonormal_basis_orthonormal dim_S_perp)), - let BLS := ((fin_std_orthonormal_basis dim_LS_perp).to_orthonormal_basis - (fin_std_orthonormal_basis_orthonormal dim_LS_perp)), - exact BS.repr.trans BLS.repr.symm }, + [← S.finrank_add_finrank_orthogonal, add_tsub_cancel_left], + exact (std_orthonormal_basis 𝕜 Sᗮ).repr.trans + ((std_orthonormal_basis 𝕜 LSᗮ).reindex $ fin_congr dim_LS_perp).repr.symm }, let L3 := (LS)ᗮ.subtypeₗᵢ.comp E.to_linear_isometry, -- Project onto S and Sᗮ haveI : complete_space S := finite_dimensional.complete 𝕜 S, @@ -417,7 +799,7 @@ begin -- Build a linear map from the isometries on S and Sᗮ let M := L.to_linear_map.comp p1 + L3.to_linear_map.comp p2, -- Prove that M is an isometry - have M_norm_map : ∀ (x : V), ∥M x∥ = ∥x∥, + have M_norm_map : ∀ (x : V), ‖M x‖ = ‖x‖, { intro x, -- Apply M to the orthogonal decomposition of x have Mx_decomp : M x = L (p1 x) + L3 (p2 x), @@ -425,7 +807,8 @@ begin linear_isometry.coe_to_linear_map]}, -- Mx_decomp is the orthogonal decomposition of M x have Mx_orth : ⟪ L (p1 x), L3 (p2 x) ⟫ = 0, - { have Lp1x : L (p1 x) ∈ L.to_linear_map.range := L.to_linear_map.mem_range_self (p1 x), + { have Lp1x : L (p1 x) ∈ L.to_linear_map.range := + linear_map.mem_range_self L.to_linear_map (p1 x), have Lp2x : L3 (p2 x) ∈ (L.to_linear_map.range)ᗮ, { simp only [L3, linear_isometry.coe_comp, function.comp_app, submodule.coe_subtypeₗᵢ, ← submodule.range_subtype (LSᗮ)], @@ -462,18 +845,41 @@ section matrix open_locale matrix -variables {n m : ℕ} +variables {m n : Type*} + +namespace matrix +variables [fintype m] [fintype n] [decidable_eq n] + +/-- `matrix.to_lin'` adapted for `euclidean_space 𝕜 _`. -/ +def to_euclidean_lin : matrix m n 𝕜 ≃ₗ[𝕜] (euclidean_space 𝕜 n →ₗ[𝕜] euclidean_space 𝕜 m) := +matrix.to_lin' ≪≫ₗ linear_equiv.arrow_congr + (pi_Lp.linear_equiv _ 𝕜 (λ _ : n, 𝕜)).symm (pi_Lp.linear_equiv _ 𝕜 (λ _ : m, 𝕜)).symm + +@[simp] +lemma to_euclidean_lin_pi_Lp_equiv_symm (A : matrix m n 𝕜) (x : n → 𝕜) : + A.to_euclidean_lin ((pi_Lp.equiv _ _).symm x) = (pi_Lp.equiv _ _).symm (A.to_lin' x) := rfl + +@[simp] +lemma pi_Lp_equiv_to_euclidean_lin (A : matrix m n 𝕜) (x : euclidean_space 𝕜 n) : + pi_Lp.equiv _ _ (A.to_euclidean_lin x) = A.to_lin' (pi_Lp.equiv _ _ x) := rfl + +/- `matrix.to_euclidean_lin` is the same as `matrix.to_lin` applied to `pi_Lp.basis_fun`, -/ +lemma to_euclidean_lin_eq_to_lin : + (to_euclidean_lin : matrix m n 𝕜 ≃ₗ[𝕜] _) = + matrix.to_lin (pi_Lp.basis_fun _ _ _) (pi_Lp.basis_fun _ _ _) := rfl + +end matrix -local notation `⟪`x`, `y`⟫ₘ` := @inner 𝕜 (euclidean_space 𝕜 (fin m)) _ x y -local notation `⟪`x`, `y`⟫ₙ` := @inner 𝕜 (euclidean_space 𝕜 (fin n)) _ x y +local notation `⟪`x`, `y`⟫ₑ` := @inner 𝕜 _ _ ((pi_Lp.equiv 2 _).symm x) ((pi_Lp.equiv 2 _).symm y) -/-- The inner product of a row of A and a row of B is an entry of B ⬝ Aᴴ. -/ -lemma inner_matrix_row_row (A B : matrix (fin n) (fin m) 𝕜) (i j : (fin n)) : - ⟪A i, B j⟫ₘ = (B ⬝ Aᴴ) j i := by {simp only [inner, matrix.mul_apply, star_ring_end_apply, - matrix.conj_transpose_apply,mul_comm]} +/-- The inner product of a row of `A` and a row of `B` is an entry of `B ⬝ Aᴴ`. -/ +lemma inner_matrix_row_row [fintype n] (A B : matrix m n 𝕜) (i j : m) : + ⟪A i, B j⟫ₑ = (B ⬝ Aᴴ) j i := +by simp_rw [euclidean_space.inner_pi_Lp_equiv_symm, matrix.mul_apply', matrix.dot_product_comm, + matrix.conj_transpose_apply, pi.star_def] -/-- The inner product of a column of A and a column of B is an entry of Aᴴ ⬝ B -/ -lemma inner_matrix_col_col (A B : matrix (fin n) (fin m) 𝕜) (i j : (fin m)) : - ⟪Aᵀ i, Bᵀ j⟫ₙ = (Aᴴ ⬝ B) i j := rfl +/-- The inner product of a column of `A` and a column of `B` is an entry of `Aᴴ ⬝ B`. -/ +lemma inner_matrix_col_col [fintype m] (A B : matrix m n 𝕜) (i j : n) : + ⟪Aᵀ i, Bᵀ j⟫ₑ = (Aᴴ ⬝ B) i j := rfl end matrix diff --git a/src/analysis/inner_product_space/positive.lean b/src/analysis/inner_product_space/positive.lean new file mode 100644 index 0000000000000..d9437594cc446 --- /dev/null +++ b/src/analysis/inner_product_space/positive.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2022 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anatole Dedecker +-/ +import analysis.inner_product_space.adjoint + +/-! +# Positive operators + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define positive operators in a Hilbert space. We follow Bourbaki's choice +of requiring self adjointness in the definition. + +## Main definitions + +* `is_positive` : a continuous linear map is positive if it is self adjoint and + `∀ x, 0 ≤ re ⟪T x, x⟫` + +## Main statements + +* `continuous_linear_map.is_positive.conj_adjoint` : if `T : E →L[𝕜] E` is positive, + then for any `S : E →L[𝕜] F`, `S ∘L T ∘L S†` is also positive. +* `continuous_linear_map.is_positive_iff_complex` : in a ***complex*** hilbert space, + checking that `⟪T x, x⟫` is a nonnegative real number for all `x` suffices to prove that + `T` is positive + +## References + +* [Bourbaki, *Topological Vector Spaces*][bourbaki1987] + +## Tags + +Positive operator +-/ + +open inner_product_space is_R_or_C continuous_linear_map +open_locale inner_product complex_conjugate + +namespace continuous_linear_map + +variables {𝕜 E F : Type*} [is_R_or_C 𝕜] +variables [normed_add_comm_group E] [normed_add_comm_group F] +variables [inner_product_space 𝕜 E] [inner_product_space 𝕜 F] +variables [complete_space E] [complete_space F] +local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y + +/-- A continuous linear endomorphism `T` of a Hilbert space is **positive** if it is self adjoint + and `∀ x, 0 ≤ re ⟪T x, x⟫`. -/ +def is_positive (T : E →L[𝕜] E) : Prop := + is_self_adjoint T ∧ ∀ x, 0 ≤ T.re_apply_inner_self x + +lemma is_positive.is_self_adjoint {T : E →L[𝕜] E} (hT : is_positive T) : + is_self_adjoint T := +hT.1 + +lemma is_positive.inner_nonneg_left {T : E →L[𝕜] E} (hT : is_positive T) (x : E) : + 0 ≤ re ⟪T x, x⟫ := +hT.2 x + +lemma is_positive.inner_nonneg_right {T : E →L[𝕜] E} (hT : is_positive T) (x : E) : + 0 ≤ re ⟪x, T x⟫ := +by rw inner_re_symm; exact hT.inner_nonneg_left x + +lemma is_positive_zero : is_positive (0 : E →L[𝕜] E) := +begin + refine ⟨is_self_adjoint_zero _, λ x, _⟩, + change 0 ≤ re ⟪_, _⟫, + rw [zero_apply, inner_zero_left, zero_hom_class.map_zero] +end + +lemma is_positive_one : is_positive (1 : E →L[𝕜] E) := +⟨is_self_adjoint_one _, λ x, inner_self_nonneg⟩ + +lemma is_positive.add {T S : E →L[𝕜] E} (hT : T.is_positive) + (hS : S.is_positive) : (T + S).is_positive := +begin + refine ⟨hT.is_self_adjoint.add hS.is_self_adjoint, λ x, _⟩, + rw [re_apply_inner_self, add_apply, inner_add_left, map_add], + exact add_nonneg (hT.inner_nonneg_left x) (hS.inner_nonneg_left x) +end + +lemma is_positive.conj_adjoint {T : E →L[𝕜] E} + (hT : T.is_positive) (S : E →L[𝕜] F) : (S ∘L T ∘L S†).is_positive := +begin + refine ⟨hT.is_self_adjoint.conj_adjoint S, λ x, _⟩, + rw [re_apply_inner_self, comp_apply, ← adjoint_inner_right], + exact hT.inner_nonneg_left _ +end + +lemma is_positive.adjoint_conj {T : E →L[𝕜] E} + (hT : T.is_positive) (S : F →L[𝕜] E) : (S† ∘L T ∘L S).is_positive := +begin + convert hT.conj_adjoint (S†), + rw adjoint_adjoint +end + +lemma is_positive.conj_orthogonal_projection (U : submodule 𝕜 E) {T : E →L[𝕜] E} + (hT : T.is_positive) [complete_space U] : + (U.subtypeL ∘L orthogonal_projection U ∘L T ∘L U.subtypeL ∘L + orthogonal_projection U).is_positive := +begin + have := hT.conj_adjoint (U.subtypeL ∘L orthogonal_projection U), + rwa (orthogonal_projection_is_self_adjoint U).adjoint_eq at this +end + +lemma is_positive.orthogonal_projection_comp {T : E →L[𝕜] E} + (hT : T.is_positive) (U : submodule 𝕜 E) [complete_space U] : + (orthogonal_projection U ∘L T ∘L U.subtypeL).is_positive := +begin + have := hT.conj_adjoint (orthogonal_projection U : E →L[𝕜] U), + rwa [U.adjoint_orthogonal_projection] at this, +end + +section complex + +variables {E' : Type*} [normed_add_comm_group E'] [inner_product_space ℂ E'] [complete_space E'] + +lemma is_positive_iff_complex (T : E' →L[ℂ] E') : + is_positive T ↔ ∀ x, (re ⟪T x, x⟫_ℂ : ℂ) = ⟪T x, x⟫_ℂ ∧ 0 ≤ re ⟪T x, x⟫_ℂ := +begin + simp_rw [is_positive, forall_and_distrib, is_self_adjoint_iff_is_symmetric, + linear_map.is_symmetric_iff_inner_map_self_real, conj_eq_iff_re], + refl +end + +end complex + +end continuous_linear_map diff --git a/src/analysis/inner_product_space/projection.lean b/src/analysis/inner_product_space/projection.lean index 79a4cd03405e2..3e772563a5854 100644 --- a/src/analysis/inner_product_space/projection.lean +++ b/src/analysis/inner_product_space/projection.lean @@ -3,17 +3,23 @@ Copyright (c) 2019 Zhouhang Zhou. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Zhouhang Zhou, Frédéric Dupuis, Heather Macbeth -/ +import algebra.direct_sum.decomposition import analysis.convex.basic -import analysis.inner_product_space.basic +import analysis.inner_product_space.orthogonal +import analysis.inner_product_space.symmetric import analysis.normed_space.is_R_or_C +import data.is_R_or_C.lemmas /-! # The orthogonal projection +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a nonempty complete subspace `K` of an inner product space `E`, this file constructs `orthogonal_projection K : E →L[𝕜] K`, the orthogonal projection of `E` onto `K`. This map satisfies: for any point `u` in `E`, the point `v = orthogonal_projection K u` in `K` minimizes the -distance `∥u - v∥` to `u`. +distance `‖u - v‖` to `u`. Also a linear isometry equivalence `reflection K : E ≃ₗᵢ[𝕜] E` is constructed, by choosing, for each `u : E`, the point `reflection K u` to satisfy @@ -27,14 +33,6 @@ defined in `analysis.inner_product_space.basic`); the lemma `submodule.sup_orthogonal_of_is_complete`, stating that for a complete subspace `K` of `E` we have `K ⊔ Kᗮ = ⊤`, is a typical example. -The last section covers orthonormal bases, etc. The lemma -`maximal_orthonormal_iff_orthogonal_complement_eq_bot` states that an orthonormal set in an inner -product space is maximal, if and only the orthogonal complement of its span is trivial. -Various consequences are stated for finite-dimensional `E`, including that a maximal orthonormal -set is a basis (`maximal_orthonormal_iff_basis_of_finite_dimensional`); these consequences require -the theory on the orthogonal complement developed earlier in this file. For consequences in -infinite dimension (Hilbert bases, etc.), see the file `analysis.inner_product_space.l2_space`. - ## References The orthogonal projection construction is adapted from @@ -46,12 +44,13 @@ The Coq code is available at the following address: δ`); + -- such that `‖u - w n‖ < δ + 1 / (n + 1)` (which implies `‖u - w n‖ --> δ`); -- maybe this should be a separate lemma - have exists_seq : ∃ w : ℕ → K, ∀ n, ∥u - w n∥ < δ + 1 / (n + 1), + have exists_seq : ∃ w : ℕ → K, ∀ n, ‖u - w n‖ < δ + 1 / (n + 1), { have hδ : ∀n:ℕ, δ < δ + 1 / (n + 1), from λ n, lt_add_of_le_of_pos le_rfl nat.one_div_pos_of_nat, have h := λ n, exists_lt_of_cinfi_lt (hδ n), let w : ℕ → K := λ n, classical.some (h n), exact ⟨w, λ n, classical.some_spec (h n)⟩ }, rcases exists_seq with ⟨w, hw⟩, - have norm_tendsto : tendsto (λ n, ∥u - w n∥) at_top (nhds δ), + have norm_tendsto : tendsto (λ n, ‖u - w n‖) at_top (nhds δ), { have h : tendsto (λ n:ℕ, δ) at_top (nhds δ) := tendsto_const_nhds, have h' : tendsto (λ n:ℕ, δ + 1 / (n + 1)) at_top (nhds δ), { convert h.add tendsto_one_div_add_at_top_nhds_0_nat, simp only [add_zero] }, @@ -103,18 +102,18 @@ begin let wp := ((w p):F), let wq := ((w q):F), let a := u - wq, let b := u - wp, let half := 1 / (2:ℝ), let div := 1 / ((N:ℝ) + 1), - have : 4 * ∥u - half • (wq + wp)∥ * ∥u - half • (wq + wp)∥ + ∥wp - wq∥ * ∥wp - wq∥ = - 2 * (∥a∥ * ∥a∥ + ∥b∥ * ∥b∥) := + have : 4 * ‖u - half • (wq + wp)‖ * ‖u - half • (wq + wp)‖ + ‖wp - wq‖ * ‖wp - wq‖ = + 2 * (‖a‖ * ‖a‖ + ‖b‖ * ‖b‖) := calc - 4 * ∥u - half•(wq + wp)∥ * ∥u - half•(wq + wp)∥ + ∥wp - wq∥ * ∥wp - wq∥ - = (2*∥u - half•(wq + wp)∥) * (2 * ∥u - half•(wq + wp)∥) + ∥wp-wq∥*∥wp-wq∥ : by ring - ... = (absR ((2:ℝ)) * ∥u - half•(wq + wp)∥) * (absR ((2:ℝ)) * ∥u - half•(wq+wp)∥) + - ∥wp-wq∥*∥wp-wq∥ : + 4 * ‖u - half•(wq + wp)‖ * ‖u - half•(wq + wp)‖ + ‖wp - wq‖ * ‖wp - wq‖ + = (2*‖u - half•(wq + wp)‖) * (2 * ‖u - half•(wq + wp)‖) + ‖wp-wq‖*‖wp-wq‖ : by ring + ... = (absR ((2:ℝ)) * ‖u - half•(wq + wp)‖) * (absR ((2:ℝ)) * ‖u - half•(wq+wp)‖) + + ‖wp-wq‖*‖wp-wq‖ : by { rw _root_.abs_of_nonneg, exact zero_le_two } - ... = ∥(2:ℝ) • (u - half • (wq + wp))∥ * ∥(2:ℝ) • (u - half • (wq + wp))∥ + - ∥wp-wq∥ * ∥wp-wq∥ : + ... = ‖(2:ℝ) • (u - half • (wq + wp))‖ * ‖(2:ℝ) • (u - half • (wq + wp))‖ + + ‖wp-wq‖ * ‖wp-wq‖ : by simp [norm_smul] - ... = ∥a + b∥ * ∥a + b∥ + ∥a - b∥ * ∥a - b∥ : + ... = ‖a + b‖ * ‖a + b‖ + ‖a - b‖ * ‖a - b‖ : begin rw [smul_sub, smul_smul, mul_one_div_cancel (_root_.two_ne_zero : (2 : ℝ) ≠ 0), ← one_add_one_eq_two, add_smul], @@ -123,28 +122,29 @@ begin have eq₂ : u + u - (wq + wp) = a + b, show u + u - (wq + wp) = (u - wq) + (u - wp), abel, rw [eq₁, eq₂], end - ... = 2 * (∥a∥ * ∥a∥ + ∥b∥ * ∥b∥) : parallelogram_law_with_norm _ _, - have eq : δ ≤ ∥u - half • (wq + wp)∥, + ... = 2 * (‖a‖ * ‖a‖ + ‖b‖ * ‖b‖) : parallelogram_law_with_norm ℝ _ _, + have eq : δ ≤ ‖u - half • (wq + wp)‖, { rw smul_add, apply δ_le', apply h₂, repeat {exact subtype.mem _}, repeat {exact le_of_lt one_half_pos}, exact add_halves 1 }, - have eq₁ : 4 * δ * δ ≤ 4 * ∥u - half • (wq + wp)∥ * ∥u - half • (wq + wp)∥, - { mono, mono, norm_num, apply mul_nonneg, norm_num, exact norm_nonneg _ }, - have eq₂ : ∥a∥ * ∥a∥ ≤ (δ + div) * (δ + div) := + have eq₁ : 4 * δ * δ ≤ 4 * ‖u - half • (wq + wp)‖ * ‖u - half • (wq + wp)‖, + { simp_rw mul_assoc, + exact mul_le_mul_of_nonneg_left (mul_self_le_mul_self zero_le_δ eq) zero_le_four }, + have eq₂ : ‖a‖ * ‖a‖ ≤ (δ + div) * (δ + div) := mul_self_le_mul_self (norm_nonneg _) (le_trans (le_of_lt $ hw q) (add_le_add_left (nat.one_div_le_one_div hq) _)), - have eq₂' : ∥b∥ * ∥b∥ ≤ (δ + div) * (δ + div) := + have eq₂' : ‖b‖ * ‖b‖ ≤ (δ + div) * (δ + div) := mul_self_le_mul_self (norm_nonneg _) (le_trans (le_of_lt $ hw p) (add_le_add_left (nat.one_div_le_one_div hp) _)), rw dist_eq_norm, apply nonneg_le_nonneg_of_sq_le_sq, { exact sqrt_nonneg _ }, rw mul_self_sqrt, calc - ∥wp - wq∥ * ∥wp - wq∥ = 2 * (∥a∥*∥a∥ + ∥b∥*∥b∥) - - 4 * ∥u - half • (wq+wp)∥ * ∥u - half • (wq+wp)∥ : by { rw ← this, simp } - ... ≤ 2 * (∥a∥ * ∥a∥ + ∥b∥ * ∥b∥) - 4 * δ * δ : sub_le_sub_left eq₁ _ + ‖wp - wq‖ * ‖wp - wq‖ = 2 * (‖a‖*‖a‖ + ‖b‖*‖b‖) - + 4 * ‖u - half • (wq+wp)‖ * ‖u - half • (wq+wp)‖ : by { rw ← this, simp } + ... ≤ 2 * (‖a‖ * ‖a‖ + ‖b‖ * ‖b‖) - 4 * δ * δ : sub_le_sub_left eq₁ _ ... ≤ 2 * ((δ + div) * (δ + div) + (δ + div) * (δ + div)) - 4 * δ * δ : sub_le_sub_right (mul_le_mul_of_nonneg_left (add_le_add eq₂ eq₂') (by norm_num)) _ ... = 8 * δ * div + 4 * div * div : by ring, @@ -168,9 +168,9 @@ begin -- Prove that it satisfies all requirements. rcases cauchy_seq_tendsto_of_is_complete h₁ (λ n, _) seq_is_cauchy with ⟨v, hv, w_tendsto⟩, use v, use hv, - have h_cont : continuous (λ v, ∥u - v∥) := + have h_cont : continuous (λ v, ‖u - v‖) := continuous.comp continuous_norm (continuous.sub continuous_const continuous_id), - have : tendsto (λ n, ∥u - w n∥) at_top (nhds ∥u - v∥), + have : tendsto (λ n, ‖u - w n‖) at_top (nhds ‖u - v‖), convert (tendsto.comp h_cont.continuous_at w_tendsto), exact tendsto_nhds_unique this norm_tendsto, exact subtype.mem _ @@ -179,49 +179,49 @@ end /-- Characterization of minimizers for the projection on a convex set in a real inner product space. -/ theorem norm_eq_infi_iff_real_inner_le_zero {K : set F} (h : convex ℝ K) {u : F} {v : F} - (hv : v ∈ K) : ∥u - v∥ = (⨅ w : K, ∥u - w∥) ↔ ∀ w ∈ K, ⟪u - v, w - v⟫_ℝ ≤ 0 := + (hv : v ∈ K) : ‖u - v‖ = (⨅ w : K, ‖u - w‖) ↔ ∀ w ∈ K, ⟪u - v, w - v⟫_ℝ ≤ 0 := iff.intro begin assume eq w hw, - let δ := ⨅ w : K, ∥u - w∥, let p := ⟪u - v, w - v⟫_ℝ, let q := ∥w - v∥^2, + let δ := ⨅ w : K, ‖u - w‖, let p := ⟪u - v, w - v⟫_ℝ, let q := ‖w - v‖^2, letI : nonempty K := ⟨⟨v, hv⟩⟩, have zero_le_δ : 0 ≤ δ, apply le_cinfi, intro, exact norm_nonneg _, - have δ_le : ∀ w : K, δ ≤ ∥u - w∥, + have δ_le : ∀ w : K, δ ≤ ‖u - w‖, assume w, apply cinfi_le, use (0:ℝ), rintros _ ⟨_, rfl⟩, exact norm_nonneg _, - have δ_le' : ∀ w ∈ K, δ ≤ ∥u - w∥ := assume w hw, δ_le ⟨w, hw⟩, + have δ_le' : ∀ w ∈ K, δ ≤ ‖u - w‖ := assume w hw, δ_le ⟨w, hw⟩, have : ∀θ:ℝ, 0 < θ → θ ≤ 1 → 2 * p ≤ θ * q, assume θ hθ₁ hθ₂, - have : ∥u - v∥^2 ≤ ∥u - v∥^2 - 2 * θ * ⟪u - v, w - v⟫_ℝ + θ*θ*∥w - v∥^2 := + have : ‖u - v‖^2 ≤ ‖u - v‖^2 - 2 * θ * ⟪u - v, w - v⟫_ℝ + θ*θ*‖w - v‖^2 := calc - ∥u - v∥^2 ≤ ∥u - (θ•w + (1-θ)•v)∥^2 : + ‖u - v‖^2 ≤ ‖u - (θ•w + (1-θ)•v)‖^2 : begin simp only [sq], apply mul_self_le_mul_self (norm_nonneg _), rw [eq], apply δ_le', apply h hw hv, exacts [le_of_lt hθ₁, sub_nonneg.2 hθ₂, add_sub_cancel'_right _ _], end - ... = ∥(u - v) - θ • (w - v)∥^2 : + ... = ‖(u - v) - θ • (w - v)‖^2 : begin have : u - (θ•w + (1-θ)•v) = (u - v) - θ • (w - v), { rw [smul_sub, sub_smul, one_smul], simp only [sub_eq_add_neg, add_comm, add_left_comm, add_assoc, neg_add_rev] }, rw this end - ... = ∥u - v∥^2 - 2 * θ * inner (u - v) (w - v) + θ*θ*∥w - v∥^2 : + ... = ‖u - v‖^2 - 2 * θ * inner (u - v) (w - v) + θ*θ*‖w - v‖^2 : begin - rw [norm_sub_sq, inner_smul_right, norm_smul], + rw [@norm_sub_sq ℝ, inner_smul_right, norm_smul], simp only [sq], - show ∥u-v∥*∥u-v∥-2*(θ*inner(u-v)(w-v))+absR (θ)*∥w-v∥*(absR (θ)*∥w-v∥)= - ∥u-v∥*∥u-v∥-2*θ*inner(u-v)(w-v)+θ*θ*(∥w-v∥*∥w-v∥), + show ‖u-v‖*‖u-v‖-2*(θ*inner(u-v)(w-v))+absR (θ)*‖w-v‖*(absR (θ)*‖w-v‖)= + ‖u-v‖*‖u-v‖-2*θ*inner(u-v)(w-v)+θ*θ*(‖w-v‖*‖w-v‖), rw abs_of_pos hθ₁, ring end, - have eq₁ : ∥u-v∥^2-2*θ*inner(u-v)(w-v)+θ*θ*∥w-v∥^2=∥u-v∥^2+(θ*θ*∥w-v∥^2-2*θ*inner(u-v)(w-v)), + have eq₁ : ‖u-v‖^2-2*θ*inner(u-v)(w-v)+θ*θ*‖w-v‖^2=‖u-v‖^2+(θ*θ*‖w-v‖^2-2*θ*inner(u-v)(w-v)), by abel, rw [eq₁, le_add_iff_nonneg_right] at this, - have eq₂ : θ*θ*∥w-v∥^2-2*θ*inner(u-v)(w-v)=θ*(θ*∥w-v∥^2-2*inner(u-v)(w-v)), ring, + have eq₂ : θ*θ*‖w-v‖^2-2*θ*inner(u-v)(w-v)=θ*(θ*‖w-v‖^2-2*inner(u-v)(w-v)), ring, rw eq₂ at this, - have := le_of_sub_nonneg (nonneg_of_mul_nonneg_left this hθ₁), + have := le_of_sub_nonneg (nonneg_of_mul_nonneg_right this hθ₁), exact this, by_cases hq : q = 0, { rw hq at this, @@ -249,13 +249,13 @@ begin apply nonneg_le_nonneg_of_sq_le_sq (norm_nonneg _), have := h w w.2, calc - ∥u - v∥ * ∥u - v∥ ≤ ∥u - v∥ * ∥u - v∥ - 2 * inner (u - v) ((w:F) - v) : by linarith - ... ≤ ∥u - v∥^2 - 2 * inner (u - v) ((w:F) - v) + ∥(w:F) - v∥^2 : + ‖u - v‖ * ‖u - v‖ ≤ ‖u - v‖ * ‖u - v‖ - 2 * inner (u - v) ((w:F) - v) : by linarith + ... ≤ ‖u - v‖^2 - 2 * inner (u - v) ((w:F) - v) + ‖(w:F) - v‖^2 : by { rw sq, refine le_add_of_nonneg_right _, exact sq_nonneg _ } - ... = ∥(u - v) - (w - v)∥^2 : norm_sub_sq.symm - ... = ∥u - w∥ * ∥u - w∥ : + ... = ‖(u - v) - (w - v)‖^2 : (@norm_sub_sq ℝ _ _ _ _ _ _).symm + ... = ‖u - w‖ * ‖u - w‖ : by { have : (u - v) - (w - v) = u - w, abel, rw [this, sq] } }, - { show (⨅ (w : K), ∥u - w∥) ≤ (λw:K, ∥u - w∥) ⟨v, hv⟩, + { show (⨅ (w : K), ‖u - w‖) ≤ (λw:K, ‖u - w‖) ⟨v, hv⟩, apply cinfi_le, use 0, rintros y ⟨z, rfl⟩, exact norm_nonneg _ } end @@ -264,11 +264,11 @@ variables (K : submodule 𝕜 E) /-- Existence of projections on complete subspaces. Let `u` be a point in an inner product space, and let `K` be a nonempty complete subspace. -Then there exists a (unique) `v` in `K` that minimizes the distance `∥u - v∥` to `u`. +Then there exists a (unique) `v` in `K` that minimizes the distance `‖u - v‖` to `u`. This point `v` is usually called the orthogonal projection of `u` onto `K`. -/ theorem exists_norm_eq_infi_of_complete_subspace - (h : is_complete (↑K : set E)) : ∀ u : E, ∃ v ∈ K, ∥u - v∥ = ⨅ w : (K : set E), ∥u - w∥ := + (h : is_complete (↑K : set E)) : ∀ u : E, ∃ v ∈ K, ‖u - v‖ = ⨅ w : (K : set E), ‖u - w‖ := begin letI : inner_product_space ℝ E := inner_product_space.is_R_or_C_to_real 𝕜 E, letI : module ℝ E := restrict_scalars.module ℝ 𝕜 E, @@ -279,13 +279,13 @@ end /-- Characterization of minimizers in the projection on a subspace, in the real case. Let `u` be a point in a real inner product space, and let `K` be a nonempty subspace. -Then point `v` minimizes the distance `∥u - v∥` over points in `K` if and only if +Then point `v` minimizes the distance `‖u - v‖` over points in `K` if and only if for all `w ∈ K`, `⟪u - v, w⟫ = 0` (i.e., `u - v` is orthogonal to the subspace `K`). This is superceded by `norm_eq_infi_iff_inner_eq_zero` that gives the same conclusion over any `is_R_or_C` field. -/ theorem norm_eq_infi_iff_real_inner_eq_zero (K : submodule ℝ F) {u : F} {v : F} - (hv : v ∈ K) : ∥u - v∥ = (⨅ w : (↑K : set F), ∥u - w∥) ↔ ∀ w ∈ K, ⟪u - v, w⟫_ℝ = 0 := + (hv : v ∈ K) : ‖u - v‖ = (⨅ w : (↑K : set F), ‖u - w‖) ↔ ∀ w ∈ K, ⟪u - v, w⟫_ℝ = 0 := iff.intro begin assume h, @@ -322,11 +322,11 @@ end /-- Characterization of minimizers in the projection on a subspace. Let `u` be a point in an inner product space, and let `K` be a nonempty subspace. -Then point `v` minimizes the distance `∥u - v∥` over points in `K` if and only if +Then point `v` minimizes the distance `‖u - v‖` over points in `K` if and only if for all `w ∈ K`, `⟪u - v, w⟫ = 0` (i.e., `u - v` is orthogonal to the subspace `K`) -/ theorem norm_eq_infi_iff_inner_eq_zero {u : E} {v : E} - (hv : v ∈ K) : ∥u - v∥ = (⨅ w : (↑K : set E), ∥u - w∥) ↔ ∀ w ∈ K, ⟪u - v, w⟫ = 0 := + (hv : v ∈ K) : ‖u - v‖ = (⨅ w : K, ‖u - w‖) ↔ ∀ w ∈ K, ⟪u - v, w⟫ = 0 := begin letI : inner_product_space ℝ E := inner_product_space.is_R_or_C_to_real 𝕜 E, letI : module ℝ E := restrict_scalars.module ℝ 𝕜 E, @@ -388,7 +388,7 @@ lemma eq_orthogonal_projection_fn_of_mem_of_inner_eq_zero {u v : E} (hvm : v ∈ K) (hvo : ∀ w ∈ K, ⟪u - v, w⟫ = 0) : orthogonal_projection_fn K u = v := begin - rw [←sub_eq_zero, ←inner_self_eq_zero], + rw [←sub_eq_zero, ←@inner_self_eq_zero 𝕜], have hvs : orthogonal_projection_fn K u - v ∈ K := submodule.sub_mem K (orthogonal_projection_fn_mem u) hvm, have huo : ⟪u - orthogonal_projection_fn K u, orthogonal_projection_fn K u - v⟫ = 0 := @@ -402,8 +402,8 @@ end variables (K) lemma orthogonal_projection_fn_norm_sq (v : E) : - ∥v∥ * ∥v∥ = ∥v - (orthogonal_projection_fn K v)∥ * ∥v - (orthogonal_projection_fn K v)∥ - + ∥orthogonal_projection_fn K v∥ * ∥orthogonal_projection_fn K v∥ := + ‖v‖ * ‖v‖ = ‖v - (orthogonal_projection_fn K v)‖ * ‖v - (orthogonal_projection_fn K v)‖ + + ‖orthogonal_projection_fn K v‖ * ‖orthogonal_projection_fn K v‖ := begin set p := orthogonal_projection_fn K v, have h' : ⟪v - p, p⟫ = 0, @@ -422,7 +422,7 @@ linear_map.mk_continuous have ho : ∀ w ∈ K, ⟪x + y - (orthogonal_projection_fn K x + orthogonal_projection_fn K y), w⟫ = 0, { intros w hw, - rw [add_sub_comm, inner_add_left, orthogonal_projection_fn_inner_eq_zero _ w hw, + rw [add_sub_add_comm, inner_add_left, orthogonal_projection_fn_inner_eq_zero _ w hw, orthogonal_projection_fn_inner_eq_zero _ w hw, add_zero] }, ext, simp [eq_orthogonal_projection_fn_of_mem_of_inner_eq_zero hm ho] @@ -440,7 +440,7 @@ linear_map.mk_continuous (λ x, begin simp only [one_mul, linear_map.coe_mk], refine le_of_pow_le_pow 2 (norm_nonneg _) (by norm_num) _, - change ∥orthogonal_projection_fn K x∥ ^ 2 ≤ ∥x∥ ^ 2, + change ‖orthogonal_projection_fn K x‖ ^ 2 ≤ ‖x‖ ^ 2, nlinarith [orthogonal_projection_fn_norm_sq K x] end) @@ -462,7 +462,7 @@ orthogonal_projection_fn_inner_eq_zero v v - orthogonal_projection K v ∈ Kᗮ := begin intros w hw, - rw inner_eq_zero_sym, + rw inner_eq_zero_symm, exact orthogonal_projection_inner_eq_zero _ _ hw end @@ -473,6 +473,14 @@ lemma eq_orthogonal_projection_of_mem_of_inner_eq_zero (orthogonal_projection K u : E) = v := eq_orthogonal_projection_fn_of_mem_of_inner_eq_zero hvm hvo +/-- The orthogonal projection of `y` on `U` minimizes the distance `‖y - x‖` for `x ∈ U`. -/ +lemma orthogonal_projection_minimal {U : submodule 𝕜 E} [complete_space U] (y : E) : + ‖y - orthogonal_projection U y‖ = ⨅ x : U, ‖y - x‖ := +begin + rw norm_eq_infi_iff_inner_eq_zero _ (submodule.coe_mem _), + exact orthogonal_projection_inner_eq_zero _ +end + /-- The orthogonal projections onto equal subspaces are coerced back to the same point in `E`. -/ lemma eq_orthogonal_projection_of_eq_submodule {K' : submodule 𝕜 E} [complete_space K'] (h : K = K') (u : E) : @@ -497,21 +505,39 @@ begin { simp } end -lemma linear_isometry.map_orthogonal_projection {E E' : Type*} [inner_product_space 𝕜 E] - [inner_product_space 𝕜 E'] (f : E →ₗᵢ[𝕜] E') (p : submodule 𝕜 E) [complete_space p] +lemma linear_isometry.map_orthogonal_projection {E E' : Type*} + [normed_add_comm_group E] [normed_add_comm_group E'] + [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] + (f : E →ₗᵢ[𝕜] E') (p : submodule 𝕜 E) [complete_space p] (x : E) : f (orthogonal_projection p x) = orthogonal_projection (p.map f.to_linear_map) (f x) := begin - refine (eq_orthogonal_projection_of_mem_of_inner_eq_zero (submodule.apply_coe_mem_map _ _) $ + refine (eq_orthogonal_projection_of_mem_of_inner_eq_zero _ $ λ y hy, _).symm, + refine submodule.apply_coe_mem_map _ _, rcases hy with ⟨x', hx', rfl : f x' = y⟩, - rw [f.coe_to_linear_map, ← f.map_sub, f.inner_map_map, - orthogonal_projection_inner_eq_zero x x' hx'] + rw [← f.map_sub, f.inner_map_map, orthogonal_projection_inner_eq_zero x x' hx'] +end + +lemma linear_isometry.map_orthogonal_projection' {E E' : Type*} + [normed_add_comm_group E] [normed_add_comm_group E'] + [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] + (f : E →ₗᵢ[𝕜] E') (p : submodule 𝕜 E) [complete_space p] + (x : E) : + f (orthogonal_projection p x) = orthogonal_projection (p.map f) (f x) := +begin + refine (eq_orthogonal_projection_of_mem_of_inner_eq_zero _ $ + λ y hy, _).symm, + refine submodule.apply_coe_mem_map _ _, + rcases hy with ⟨x', hx', rfl : f x' = y⟩, + rw [← f.map_sub, f.inner_map_map, orthogonal_projection_inner_eq_zero x x' hx'] end /-- Orthogonal projection onto the `submodule.map` of a subspace. -/ -lemma orthogonal_projection_map_apply {E E' : Type*} [inner_product_space 𝕜 E] - [inner_product_space 𝕜 E'] (f : E ≃ₗᵢ[𝕜] E') (p : submodule 𝕜 E) [complete_space p] +lemma orthogonal_projection_map_apply {E E' : Type*} + [normed_add_comm_group E] [normed_add_comm_group E'] + [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] + (f : E ≃ₗᵢ[𝕜] E') (p : submodule 𝕜 E) [complete_space p] (x : E') : (orthogonal_projection (p.map (f.to_linear_equiv : E →ₗ[𝕜] E')) x : E') = f (orthogonal_projection p (f.symm x)) := @@ -525,44 +551,44 @@ by ext variables (K) /-- The orthogonal projection has norm `≤ 1`. -/ -lemma orthogonal_projection_norm_le : ∥orthogonal_projection K∥ ≤ 1 := +lemma orthogonal_projection_norm_le : ‖orthogonal_projection K‖ ≤ 1 := linear_map.mk_continuous_norm_le _ (by norm_num) _ variables (𝕜) lemma smul_orthogonal_projection_singleton {v : E} (w : E) : - (∥v∥ ^ 2 : 𝕜) • (orthogonal_projection (𝕜 ∙ v) w : E) = ⟪v, w⟫ • v := + (‖v‖ ^ 2 : 𝕜) • (orthogonal_projection (𝕜 ∙ v) w : E) = ⟪v, w⟫ • v := begin - suffices : ↑(orthogonal_projection (𝕜 ∙ v) ((∥v∥ ^ 2 : 𝕜) • w)) = ⟪v, w⟫ • v, + suffices : ↑(orthogonal_projection (𝕜 ∙ v) ((‖v‖ ^ 2 : 𝕜) • w)) = ⟪v, w⟫ • v, { simpa using this }, apply eq_orthogonal_projection_of_mem_of_inner_eq_zero, { rw submodule.mem_span_singleton, use ⟪v, w⟫ }, { intros x hx, obtain ⟨c, rfl⟩ := submodule.mem_span_singleton.mp hx, - have hv : ↑∥v∥ ^ 2 = ⟪v, v⟫ := by { norm_cast, simp [norm_sq_eq_inner] }, - simp [inner_sub_left, inner_smul_left, inner_smul_right, ring_equiv.map_div, mul_comm, hv, - inner_product_space.conj_sym, hv] } + have hv : ↑‖v‖ ^ 2 = ⟪v, v⟫ := by { norm_cast, simp [@norm_sq_eq_inner 𝕜] }, + simp [inner_sub_left, inner_smul_left, inner_smul_right, map_div₀, mul_comm, hv, + inner_product_space.conj_symm, hv] } end /-- Formula for orthogonal projection onto a single vector. -/ lemma orthogonal_projection_singleton {v : E} (w : E) : - (orthogonal_projection (𝕜 ∙ v) w : E) = (⟪v, w⟫ / ∥v∥ ^ 2) • v := + (orthogonal_projection (𝕜 ∙ v) w : E) = (⟪v, w⟫ / ‖v‖ ^ 2) • v := begin by_cases hv : v = 0, { rw [hv, eq_orthogonal_projection_of_eq_submodule (submodule.span_zero_singleton 𝕜)], { simp }, { apply_instance } }, - have hv' : ∥v∥ ≠ 0 := ne_of_gt (norm_pos_iff.mpr hv), - have key : ((∥v∥ ^ 2 : 𝕜)⁻¹ * ∥v∥ ^ 2) • ↑(orthogonal_projection (𝕜 ∙ v) w) - = ((∥v∥ ^ 2 : 𝕜)⁻¹ * ⟪v, w⟫) • v, + have hv' : ‖v‖ ≠ 0 := ne_of_gt (norm_pos_iff.mpr hv), + have key : ((‖v‖ ^ 2 : 𝕜)⁻¹ * ‖v‖ ^ 2) • ↑(orthogonal_projection (𝕜 ∙ v) w) + = ((‖v‖ ^ 2 : 𝕜)⁻¹ * ⟪v, w⟫) • v, { simp [mul_smul, smul_orthogonal_projection_singleton 𝕜 w] }, convert key; field_simp [hv'] end /-- Formula for orthogonal projection onto a single unit vector. -/ -lemma orthogonal_projection_unit_singleton {v : E} (hv : ∥v∥ = 1) (w : E) : +lemma orthogonal_projection_unit_singleton {v : E} (hv : ‖v‖ = 1) (w : E) : (orthogonal_projection (𝕜 ∙ v) w : E) = ⟪v, w⟫ • v := by { rw ← smul_orthogonal_projection_singleton 𝕜 w, simp [hv] } @@ -644,13 +670,17 @@ lemma reflection_mem_subspace_eq_self {x : E} (hx : x ∈ K) : reflection K x = (reflection_eq_self_iff x).mpr hx /-- Reflection in the `submodule.map` of a subspace. -/ -lemma reflection_map_apply {E E' : Type*} [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] +lemma reflection_map_apply {E E' : Type*} + [normed_add_comm_group E] [normed_add_comm_group E'] + [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] (f : E ≃ₗᵢ[𝕜] E') (K : submodule 𝕜 E) [complete_space K] (x : E') : reflection (K.map (f.to_linear_equiv : E →ₗ[𝕜] E')) x = f (reflection K (f.symm x)) := by simp [bit0, reflection_apply, orthogonal_projection_map_apply f K x] /-- Reflection in the `submodule.map` of a subspace. -/ -lemma reflection_map {E E' : Type*} [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] +lemma reflection_map {E E' : Type*} + [normed_add_comm_group E] [normed_add_comm_group E'] + [inner_product_space 𝕜 E] [inner_product_space 𝕜 E'] (f : E ≃ₗᵢ[𝕜] E') (K : submodule 𝕜 E) [complete_space K] : reflection (K.map (f.to_linear_equiv : E →ₗ[𝕜] E')) = f.symm.trans ((reflection K).trans f) := linear_isometry_equiv.ext $ reflection_map_apply f K @@ -705,11 +735,11 @@ begin { obtain ⟨y, hy, z, hz, rfl⟩ := K.exists_sum_mem_mem_orthogonal v, intros hv, have hz' : z = 0, - { have hyz : ⟪z, y⟫ = 0 := by simp [hz y hy, inner_eq_zero_sym], + { have hyz : ⟪z, y⟫ = 0 := by simp [hz y hy, inner_eq_zero_symm], simpa [inner_add_right, hyz] using hv z hz }, simp [hy, hz'] }, { intros hv w hw, - rw inner_eq_zero_sym, + rw inner_eq_zero_symm, exact hw v hv } end @@ -717,7 +747,7 @@ lemma submodule.orthogonal_orthogonal_eq_closure [complete_space E] : Kᗮᗮ = K.topological_closure := begin refine le_antisymm _ _, - { convert submodule.orthogonal_orthogonal_monotone K.submodule_topological_closure, + { convert submodule.orthogonal_orthogonal_monotone K.le_topological_closure, haveI : complete_space K.topological_closure := K.is_closed_topological_closure.complete_space_coe, rw K.topological_closure.orthogonal_orthogonal }, @@ -728,7 +758,7 @@ variables {K} /-- If `K` is complete, `K` and `Kᗮ` are complements of each other. -/ lemma submodule.is_compl_orthogonal_of_complete_space [complete_space K] : is_compl K Kᗮ := -⟨K.orthogonal_disjoint, le_of_eq submodule.sup_orthogonal_of_complete_space.symm⟩ +⟨K.orthogonal_disjoint, codisjoint_iff.2 submodule.sup_orthogonal_of_complete_space⟩ @[simp] lemma submodule.orthogonal_eq_bot_iff [complete_space (K : set E)] : Kᗮ = ⊥ ↔ K = ⊤ := @@ -744,7 +774,7 @@ orthogonal projection. -/ lemma eq_orthogonal_projection_of_mem_orthogonal [complete_space K] {u v : E} (hv : v ∈ K) (hvo : u - v ∈ Kᗮ) : (orthogonal_projection K u : E) = v := -eq_orthogonal_projection_fn_of_mem_of_inner_eq_zero hv (λ w, inner_eq_zero_sym.mp ∘ (hvo w)) +eq_orthogonal_projection_fn_of_mem_of_inner_eq_zero hv (λ w, inner_eq_zero_symm.mp ∘ (hvo w)) /-- A point in `K` with the orthogonality property (here characterized in terms of `Kᗮ`) must be the orthogonal projection. -/ @@ -759,6 +789,39 @@ lemma orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero orthogonal_projection K v = 0 := by { ext, convert eq_orthogonal_projection_of_mem_orthogonal _ _; simp [hv] } +/-- The projection into `U` from an orthogonal submodule `V` is the zero map. -/ +lemma submodule.is_ortho.orthogonal_projection_comp_subtypeL {U V : submodule 𝕜 E} + [complete_space U] (h : U ⟂ V) : + orthogonal_projection U ∘L V.subtypeL = 0 := +continuous_linear_map.ext $ λ v, + orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero $ h.symm v.prop + +/-- The projection into `U` from `V` is the zero map if and only if `U` and `V` are orthogonal. -/ +lemma orthogonal_projection_comp_subtypeL_eq_zero_iff {U V : submodule 𝕜 E} + [complete_space U] : + orthogonal_projection U ∘L V.subtypeL = 0 ↔ U ⟂ V := +⟨λ h u hu v hv, begin + convert orthogonal_projection_inner_eq_zero v u hu using 2, + have : orthogonal_projection U v = 0 := fun_like.congr_fun h ⟨_, hv⟩, + rw [this, submodule.coe_zero, sub_zero] +end, submodule.is_ortho.orthogonal_projection_comp_subtypeL⟩ + +lemma orthogonal_projection_eq_linear_proj [complete_space K] (x : E) : + orthogonal_projection K x = + K.linear_proj_of_is_compl _ submodule.is_compl_orthogonal_of_complete_space x := +begin + have : is_compl K Kᗮ := submodule.is_compl_orthogonal_of_complete_space, + nth_rewrite 0 [← submodule.linear_proj_add_linear_proj_of_is_compl_eq_self this x], + rw [map_add, orthogonal_projection_mem_subspace_eq_self, + orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero (submodule.coe_mem _), + add_zero] +end + +lemma orthogonal_projection_coe_linear_map_eq_linear_proj [complete_space K] : + (orthogonal_projection K : E →ₗ[𝕜] K) = + K.linear_proj_of_is_compl _ submodule.is_compl_orthogonal_of_complete_space := +linear_map.ext $ orthogonal_projection_eq_linear_proj + /-- The reflection in `K` of an element of `Kᗮ` is its negation. -/ lemma reflection_mem_subspace_orthogonal_complement_eq_neg [complete_space K] {v : E} (hv : v ∈ Kᗮ) : @@ -771,6 +834,110 @@ lemma orthogonal_projection_mem_subspace_orthogonal_precomplement_eq_zero orthogonal_projection Kᗮ v = 0 := orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero (K.le_orthogonal_orthogonal hv) +/-- If `U ≤ V`, then projecting on `V` and then on `U` is the same as projecting on `U`. -/ +lemma orthogonal_projection_orthogonal_projection_of_le {U V : submodule 𝕜 E} [complete_space U] + [complete_space V] (h : U ≤ V) (x : E) : + orthogonal_projection U (orthogonal_projection V x) = orthogonal_projection U x := +eq.symm $ by simpa only [sub_eq_zero, map_sub] using + orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero + (submodule.orthogonal_le h (sub_orthogonal_projection_mem_orthogonal x)) + +/-- Given a monotone family `U` of complete submodules of `E` and a fixed `x : E`, +the orthogonal projection of `x` on `U i` tends to the orthogonal projection of `x` on +`(⨆ i, U i).topological_closure` along `at_top`. -/ +lemma orthogonal_projection_tendsto_closure_supr [complete_space E] {ι : Type*} + [semilattice_sup ι] (U : ι → submodule 𝕜 E) [∀ i, complete_space (U i)] + (hU : monotone U) (x : E) : + filter.tendsto (λ i, (orthogonal_projection (U i) x : E)) at_top + (𝓝 (orthogonal_projection (⨆ i, U i).topological_closure x : E)) := +begin + casesI is_empty_or_nonempty ι, + { rw filter_eq_bot_of_is_empty (at_top : filter ι), + exact tendsto_bot }, + let y := (orthogonal_projection (⨆ i, U i).topological_closure x : E), + have proj_x : ∀ i, orthogonal_projection (U i) x = orthogonal_projection (U i) y := + λ i, (orthogonal_projection_orthogonal_projection_of_le + ((le_supr U i).trans (supr U).le_topological_closure) _).symm, + suffices : ∀ ε > 0, ∃ I, ∀ i ≥ I, ‖(orthogonal_projection (U i) y : E) - y‖ < ε, + { simpa only [proj_x, normed_add_comm_group.tendsto_at_top] using this }, + intros ε hε, + obtain ⟨a, ha, hay⟩ : ∃ a ∈ ⨆ i, U i, dist y a < ε, + { have y_mem : y ∈ (⨆ i, U i).topological_closure := submodule.coe_mem _, + rw [← set_like.mem_coe, submodule.topological_closure_coe, metric.mem_closure_iff] at y_mem, + exact y_mem ε hε }, + rw dist_eq_norm at hay, + obtain ⟨I, hI⟩ : ∃ I, a ∈ U I, + { rwa [submodule.mem_supr_of_directed _ (hU.directed_le)] at ha }, + refine ⟨I, λ i (hi : I ≤ i), _⟩, + rw [norm_sub_rev, orthogonal_projection_minimal], + refine lt_of_le_of_lt _ hay, + change _ ≤ ‖y - (⟨a, hU hi hI⟩ : U i)‖, + exact cinfi_le ⟨0, set.forall_range_iff.mpr $ λ _, norm_nonneg _⟩ _, +end + +/-- Given a monotone family `U` of complete submodules of `E` with dense span supremum, +and a fixed `x : E`, the orthogonal projection of `x` on `U i` tends to `x` along `at_top`. -/ +lemma orthogonal_projection_tendsto_self [complete_space E] {ι : Type*} [semilattice_sup ι] + (U : ι → submodule 𝕜 E) [∀ t, complete_space (U t)] (hU : monotone U) + (x : E) (hU' : ⊤ ≤ (⨆ t, U t).topological_closure) : + filter.tendsto (λ t, (orthogonal_projection (U t) x : E)) at_top (𝓝 x) := +begin + rw ← eq_top_iff at hU', + convert orthogonal_projection_tendsto_closure_supr U hU x, + rw orthogonal_projection_eq_self_iff.mpr _, + rw hU', + trivial +end + +/-- The orthogonal complement satisfies `Kᗮᗮᗮ = Kᗮ`. -/ +lemma submodule.triorthogonal_eq_orthogonal [complete_space E] : Kᗮᗮᗮ = Kᗮ := +begin + rw Kᗮ.orthogonal_orthogonal_eq_closure, + exact K.is_closed_orthogonal.submodule_topological_closure_eq, +end + +/-- The closure of `K` is the full space iff `Kᗮ` is trivial. -/ +lemma submodule.topological_closure_eq_top_iff [complete_space E] : + K.topological_closure = ⊤ ↔ Kᗮ = ⊥ := +begin + rw ←submodule.orthogonal_orthogonal_eq_closure, + split; intro h, + { rw [←submodule.triorthogonal_eq_orthogonal, h, submodule.top_orthogonal_eq_bot] }, + { rw [h, submodule.bot_orthogonal_eq_top] } +end + +namespace dense + +open submodule + +variables {x y : E} [complete_space E] + +/-- If `S` is dense and `x - y ∈ Kᗮ`, then `x = y`. -/ +lemma eq_of_sub_mem_orthogonal (hK : dense (K : set E)) (h : x - y ∈ Kᗮ) : x = y := +begin + rw [dense_iff_topological_closure_eq_top, topological_closure_eq_top_iff] at hK, + rwa [hK, submodule.mem_bot, sub_eq_zero] at h, +end + +lemma eq_zero_of_mem_orthogonal (hK : dense (K : set E)) (h : x ∈ Kᗮ) : x = 0 := +hK.eq_of_sub_mem_orthogonal (by rwa [sub_zero]) + +lemma eq_of_inner_left (hK : dense (K : set E)) (h : ∀ v : K, ⟪x, v⟫ = ⟪y, v⟫) : x = y := +hK.eq_of_sub_mem_orthogonal (submodule.sub_mem_orthogonal_of_inner_left h) + +lemma eq_zero_of_inner_left (hK : dense (K : set E)) (h : ∀ v : K, ⟪x, v⟫ = 0) : x = 0 := +hK.eq_of_inner_left (λ v, by rw [inner_zero_left, h v]) + +lemma eq_of_inner_right (hK : dense (K : set E)) + (h : ∀ v : K, ⟪(v : E), x⟫ = ⟪(v : E), y⟫) : x = y := +hK.eq_of_sub_mem_orthogonal (submodule.sub_mem_orthogonal_of_inner_right h) + +lemma eq_zero_of_inner_right (hK : dense (K : set E)) + (h : ∀ v : K, ⟪(v : E), x⟫ = 0) : x = 0 := +hK.eq_of_inner_right (λ v, by rw [inner_zero_right, h v]) + +end dense + /-- The reflection in `Kᗮ` of an element of `K` is its negation. -/ lemma reflection_mem_subspace_orthogonal_precomplement_eq_neg [complete_space E] {v : E} (hv : v ∈ K) : @@ -788,7 +955,7 @@ lemma reflection_orthogonal_complement_singleton_eq_neg [complete_space E] (v : reflection (𝕜 ∙ v)ᗮ v = -v := reflection_mem_subspace_orthogonal_precomplement_eq_neg (submodule.mem_span_singleton_self v) -lemma reflection_sub [complete_space F] {v w : F} (h : ∥v∥ = ∥w∥) : +lemma reflection_sub [complete_space F] {v w : F} (h : ‖v‖ = ‖w‖) : reflection (ℝ ∙ (v - w))ᗮ v = w := begin set R : F ≃ₗᵢ[ℝ] F := reflection (ℝ ∙ (v - w))ᗮ, @@ -798,7 +965,7 @@ begin have h₁ : R (v - w) = -(v - w) := reflection_orthogonal_complement_singleton_eq_neg (v - w), have h₂ : R (v + w) = v + w, { apply reflection_mem_subspace_eq_self, - apply mem_orthogonal_singleton_of_inner_left, + rw submodule.mem_orthogonal_singleton_iff_inner_left, rw real_inner_add_sub_eq_zero_iff, exact h }, convert congr_arg2 (+) h₂ h₁ using 1, @@ -825,13 +992,13 @@ end /-- The Pythagorean theorem, for an orthogonal projection.-/ lemma norm_sq_eq_add_norm_sq_projection (x : E) (S : submodule 𝕜 E) [complete_space E] [complete_space S] : - ∥x∥^2 = ∥orthogonal_projection S x∥^2 + ∥orthogonal_projection Sᗮ x∥^2 := + ‖x‖^2 = ‖orthogonal_projection S x‖^2 + ‖orthogonal_projection Sᗮ x‖^2 := begin let p1 := orthogonal_projection S, let p2 := orthogonal_projection Sᗮ, have x_decomp : x = p1 x + p2 x := eq_sum_orthogonal_projection_self_orthogonal_complement S x, - have x_orth : ⟪ p1 x, p2 x ⟫ = 0 := + have x_orth : ⟪ (p1 x : E), p2 x ⟫ = 0 := submodule.inner_right_of_mem_orthogonal (set_like.coe_mem (p1 x)) (set_like.coe_mem (p2 x)), nth_rewrite 0 [x_decomp], simp only [sq, norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero ((p1 x) : E) (p2 x) x_orth, @@ -848,19 +1015,30 @@ lemma id_eq_sum_orthogonal_projection_self_orthogonal_complement + Kᗮ.subtypeL.comp (orthogonal_projection Kᗮ) := by { ext w, exact eq_sum_orthogonal_projection_self_orthogonal_complement K w } +@[simp] lemma inner_orthogonal_projection_eq_of_mem_right [complete_space K] (u : K) (v : E) : + ⟪orthogonal_projection K v, u⟫ = ⟪v, u⟫ := +calc ⟪orthogonal_projection K v, u⟫ + = ⟪(orthogonal_projection K v : E), u⟫ : K.coe_inner _ _ +... = ⟪(orthogonal_projection K v : E), u⟫ + ⟪v - orthogonal_projection K v, u⟫ : + by rw [orthogonal_projection_inner_eq_zero _ _ (submodule.coe_mem _), add_zero] +... = ⟪v, u⟫ : + by rw [← inner_add_left, add_sub_cancel'_right] + +@[simp] lemma inner_orthogonal_projection_eq_of_mem_left [complete_space K] (u : K) (v : E) : + ⟪u, orthogonal_projection K v⟫ = ⟪(u : E), v⟫ := +by rw [← inner_conj_symm, ← inner_conj_symm (u : E), inner_orthogonal_projection_eq_of_mem_right] + /-- The orthogonal projection is self-adjoint. -/ -lemma inner_orthogonal_projection_left_eq_right [complete_space E] +lemma inner_orthogonal_projection_left_eq_right [complete_space K] (u v : E) : ⟪↑(orthogonal_projection K u), v⟫ = ⟪u, orthogonal_projection K v⟫ := -begin - nth_rewrite 0 eq_sum_orthogonal_projection_self_orthogonal_complement K v, - nth_rewrite 1 eq_sum_orthogonal_projection_self_orthogonal_complement K u, - rw [inner_add_left, inner_add_right, - submodule.inner_right_of_mem_orthogonal (submodule.coe_mem (orthogonal_projection K u)) - (submodule.coe_mem (orthogonal_projection Kᗮ v)), - submodule.inner_left_of_mem_orthogonal (submodule.coe_mem (orthogonal_projection K v)) - (submodule.coe_mem (orthogonal_projection Kᗮ u))], -end +by rw [← inner_orthogonal_projection_eq_of_mem_left, inner_orthogonal_projection_eq_of_mem_right] + +/-- The orthogonal projection is symmetric. -/ +lemma orthogonal_projection_is_symmetric + [complete_space K] : + (K.subtypeL ∘L orthogonal_projection K : E →ₗ[𝕜] E).is_symmetric := +inner_orthogonal_projection_left_eq_right K open finite_dimensional @@ -873,7 +1051,7 @@ lemma submodule.finrank_add_inf_finrank_orthogonal {K₁ K₂ : submodule 𝕜 E begin haveI := submodule.finite_dimensional_of_le h, haveI := proper_is_R_or_C 𝕜 K₁, - have hd := submodule.dim_sup_add_dim_inf_eq K₁ (K₁ᗮ ⊓ K₂), + have hd := submodule.finrank_sup_add_finrank_inf_eq K₁ (K₁ᗮ ⊓ K₂), rw [←inf_assoc, (submodule.orthogonal_disjoint K₁).eq_bot, bot_inf_eq, finrank_bot, submodule.sup_orthogonal_inf_of_complete_space h] at hd, rw add_zero at hd, @@ -920,7 +1098,7 @@ specifically at most as many reflections as the dimension of the complement of t of `φ`. -/ lemma linear_isometry_equiv.reflections_generate_dim_aux [finite_dimensional ℝ F] {n : ℕ} (φ : F ≃ₗᵢ[ℝ] F) - (hn : finrank ℝ (continuous_linear_map.id ℝ F - φ.to_continuous_linear_equiv).kerᗮ ≤ n) : + (hn : finrank ℝ (ker (continuous_linear_map.id ℝ F - φ))ᗮ ≤ n) : ∃ l : list F, l.length ≤ n ∧ φ = (l.map (λ v, reflection (ℝ ∙ v)ᗮ)).prod := begin -- We prove this by strong induction on `n`, the dimension of the orthogonal complement of the @@ -928,16 +1106,17 @@ begin induction n with n IH generalizing φ, { -- Base case: `n = 0`, the fixed subspace is the whole space, so `φ = id` refine ⟨[], rfl.le, show φ = 1, from _⟩, - have : (continuous_linear_map.id ℝ F - φ.to_continuous_linear_equiv).ker = ⊤, - { rwa [nat.le_zero_iff, finrank_eq_zero, submodule.orthogonal_eq_bot_iff] at hn }, + have : ker (continuous_linear_map.id ℝ F - φ) = ⊤, + { rwa [le_zero_iff, finrank_eq_zero, submodule.orthogonal_eq_bot_iff] at hn }, symmetry, ext x, have := linear_map.congr_fun (linear_map.ker_eq_top.mp this) x, - rwa [continuous_linear_map.coe_sub, linear_map.zero_apply, linear_map.sub_apply, sub_eq_zero] - at this }, + simpa only [sub_eq_zero, continuous_linear_map.to_linear_map_eq_coe, + continuous_linear_map.coe_sub, linear_map.sub_apply, linear_map.zero_apply] + using this }, { -- Inductive step. Let `W` be the fixed subspace of `φ`. We suppose its complement to have -- dimension at most n + 1. - let W := (continuous_linear_map.id ℝ F - φ.to_continuous_linear_equiv).ker, + let W := ker (continuous_linear_map.id ℝ F - φ), have hW : ∀ w ∈ W, φ w = w := λ w hw, (sub_eq_zero.mp hw).symm, by_cases hn' : finrank ℝ Wᗮ ≤ n, { obtain ⟨V, hV₁, hV₂⟩ := IH φ hn', @@ -956,7 +1135,7 @@ begin let x : F := v - φ v, let ρ := reflection (ℝ ∙ x)ᗮ, -- Notation: Let `V` be the fixed subspace of `φ.trans ρ` - let V := (continuous_linear_map.id ℝ F - (φ.trans ρ).to_continuous_linear_equiv).ker, + let V := ker (continuous_linear_map.id ℝ F - (φ.trans ρ)), have hV : ∀ w, ρ (φ w) = w → w ∈ V, { intros w hw, change w - ρ (φ w) = 0, @@ -967,7 +1146,7 @@ begin apply hV, rw hW w hw, refine reflection_mem_subspace_eq_self _, - apply mem_orthogonal_singleton_of_inner_left, + rw submodule.mem_orthogonal_singleton_iff_inner_left, exact submodule.sub_mem _ v.prop hφv _ hw }, -- `v` is also fixed by `φ.trans ρ` have H₁V : (v : F) ∈ V, @@ -1021,37 +1200,99 @@ end orthogonal section orthogonal_family variables {ι : Type*} -/-- An orthogonal family of subspaces of `E` satisfies `direct_sum.submodule_is_internal` (that is, +/-- An orthogonal family of subspaces of `E` satisfies `direct_sum.is_internal` (that is, they provide an internal direct sum decomposition of `E`) if and only if their span has trivial orthogonal complement. -/ -lemma orthogonal_family.submodule_is_internal_iff_of_is_complete [decidable_eq ι] - {V : ι → submodule 𝕜 E} (hV : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) +lemma orthogonal_family.is_internal_iff_of_is_complete [decidable_eq ι] + {V : ι → submodule 𝕜 E} (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) (hc : is_complete (↑(supr V) : set E)) : - direct_sum.submodule_is_internal V ↔ (supr V)ᗮ = ⊥ := + direct_sum.is_internal V ↔ (supr V)ᗮ = ⊥ := begin haveI : complete_space ↥(supr V) := hc.complete_space_coe, - simp only [direct_sum.submodule_is_internal_iff_independent_and_supr_eq_top, hV.independent, + simp only [direct_sum.is_internal_submodule_iff_independent_and_supr_eq_top, hV.independent, true_and, submodule.orthogonal_eq_bot_iff] end -/-- An orthogonal family of subspaces of `E` satisfies `direct_sum.submodule_is_internal` (that is, +/-- An orthogonal family of subspaces of `E` satisfies `direct_sum.is_internal` (that is, they provide an internal direct sum decomposition of `E`) if and only if their span has trivial orthogonal complement. -/ -lemma orthogonal_family.submodule_is_internal_iff [decidable_eq ι] [finite_dimensional 𝕜 E] - {V : ι → submodule 𝕜 E} (hV : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) : - direct_sum.submodule_is_internal V ↔ (supr V)ᗮ = ⊥ := +lemma orthogonal_family.is_internal_iff [decidable_eq ι] [finite_dimensional 𝕜 E] + {V : ι → submodule 𝕜 E} (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) : + direct_sum.is_internal V ↔ (supr V)ᗮ = ⊥ := begin haveI h := finite_dimensional.proper_is_R_or_C 𝕜 ↥(supr V), - exact hV.submodule_is_internal_iff_of_is_complete + exact hV.is_internal_iff_of_is_complete (complete_space_coe_iff_is_complete.mp infer_instance) end +open_locale direct_sum + +/-- If `x` lies within an orthogonal family `v`, it can be expressed as a sum of projections. -/ +lemma orthogonal_family.sum_projection_of_mem_supr [fintype ι] + {V : ι → submodule 𝕜 E} [∀ i, complete_space ↥(V i)] + (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) (x : E) (hx : x ∈ supr V) : + ∑ i, (orthogonal_projection (V i) x : E) = x := +begin + refine submodule.supr_induction _ hx (λ i x hx, _) _ (λ x y hx hy, _), + { refine (finset.sum_eq_single_of_mem i (finset.mem_univ _) $ λ j _ hij, _).trans + (orthogonal_projection_eq_self_iff.mpr hx), + rw [orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero, submodule.coe_zero], + exact hV.is_ortho hij.symm hx }, + { simp_rw [map_zero, submodule.coe_zero, finset.sum_const_zero] }, + { simp_rw [map_add, submodule.coe_add, finset.sum_add_distrib], + exact congr_arg2 (+) hx hy }, +end + +/-- If a family of submodules is orthogonal, then the `orthogonal_projection` on a direct sum +is just the coefficient of that direct sum. -/ +lemma orthogonal_family.projection_direct_sum_coe_add_hom [decidable_eq ι] + {V : ι → submodule 𝕜 E} (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) + (x : ⨁ i, V i) (i : ι) [complete_space ↥(V i)] : + orthogonal_projection (V i) (direct_sum.coe_add_monoid_hom V x) = x i := +begin + induction x using direct_sum.induction_on with j x x y hx hy, + { simp }, + { simp_rw [direct_sum.coe_add_monoid_hom_of, direct_sum.of, dfinsupp.single_add_hom_apply], + obtain rfl | hij := decidable.eq_or_ne i j, + { rw [orthogonal_projection_mem_subspace_eq_self, dfinsupp.single_eq_same] }, + { rw [orthogonal_projection_mem_subspace_orthogonal_complement_eq_zero, + dfinsupp.single_eq_of_ne hij.symm], + exact hV.is_ortho hij.symm x.prop } }, + { simp_rw [map_add, dfinsupp.add_apply], + exact congr_arg2 (+) hx hy }, +end + +/-- If a family of submodules is orthogonal and they span the whole space, then the orthogonal +projection provides a means to decompose the space into its submodules. + +The projection function is `decompose V x i = orthogonal_projection (V i) x`. + +See note [reducible non-instances]. -/ +@[reducible] +def orthogonal_family.decomposition [decidable_eq ι] [fintype ι] {V : ι → submodule 𝕜 E} + [∀ i, complete_space ↥(V i)] + (hV : orthogonal_family 𝕜 (λ i, V i) (λ i, (V i).subtypeₗᵢ)) (h : supr V = ⊤) : + direct_sum.decomposition V := +{ decompose' := λ x, dfinsupp.equiv_fun_on_fintype.symm $ λ i, orthogonal_projection (V i) x, + left_inv := λ x, begin + dsimp only, + letI := λ i, classical.dec_eq (V i), + rw [direct_sum.coe_add_monoid_hom, direct_sum.to_add_monoid, dfinsupp.lift_add_hom_apply, + dfinsupp.sum_add_hom_apply, dfinsupp.sum_eq_sum_fintype], + { simp_rw [equiv.apply_symm_apply, add_submonoid_class.coe_subtype], + exact hV.sum_projection_of_mem_supr _ ((h.ge : _) submodule.mem_top),}, + { intro i, + exact map_zero _ }, + end, + right_inv := λ x, begin + dsimp only, + simp_rw [hV.projection_direct_sum_coe_add_hom, dfinsupp.equiv_fun_on_fintype_symm_coe], + end } + end orthogonal_family section orthonormal_basis -/-! ### Existence of orthonormal basis, etc. -/ - variables {𝕜 E} {v : set E} open finite_dimensional submodule set @@ -1067,8 +1308,8 @@ begin -- ** direction 1: nonempty orthogonal complement implies nonmaximal rintros ⟨x, hx', hx⟩, -- take a nonzero vector and normalize it - let e := (∥x∥⁻¹ : 𝕜) • x, - have he : ∥e∥ = 1 := by simp [e, norm_smul_inv_norm hx], + let e := (‖x‖⁻¹ : 𝕜) • x, + have he : ‖e‖ = 1 := by simp [e, norm_smul_inv_norm hx], have he' : e ∈ (span 𝕜 v)ᗮ := smul_mem' _ _ hx', have he'' : e ∉ v, { intros hev, @@ -1078,13 +1319,13 @@ begin have : e ≠ 0 := hv.ne_zero ⟨e, hev⟩, contradiction }, -- put this together with `v` to provide a candidate orthonormal basis for the whole space - refine ⟨v.insert e, v.subset_insert e, ⟨_, _⟩, (v.ne_insert_of_not_mem he'').symm⟩, - { -- show that the elements of `v.insert e` have unit length + refine ⟨insert e v, v.subset_insert e, ⟨_, _⟩, (v.ne_insert_of_not_mem he'').symm⟩, + { -- show that the elements of `insert e v` have unit length rintros ⟨a, ha'⟩, cases eq_or_mem_of_mem_insert ha' with ha ha, { simp [ha, he] }, { exact hv.1 ⟨a, ha⟩ } }, - { -- show that the elements of `v.insert e` are orthogonal + { -- show that the elements of `insert e v` are orthogonal have h_end : ∀ a ∈ v, ⟪a, e⟫ = 0, { intros a ha, exact he' a (submodule.subset_span ha) }, @@ -1096,7 +1337,7 @@ begin intros hbe', apply hab', simp [ha, hbe'] }, - rw inner_eq_zero_sym, + rw inner_eq_zero_symm, simpa [ha] using h_end b hb }, rintros ⟨b, hb'⟩ hab', cases eq_or_mem_of_mem_insert hb' with hb hb, @@ -1121,8 +1362,6 @@ begin exact hu.inner_finsupp_eq_zero hxv' hl } end -section finite_dimensional - variables [finite_dimensional 𝕜 E] /-- An orthonormal set in a finite-dimensional `inner_product_space` is maximal, if and only if it @@ -1138,109 +1377,9 @@ begin have hv_coe : range (coe : v → E) = v := by simp, split, { refine λ h, ⟨basis.mk hv.linear_independent _, basis.coe_mk _ _⟩, - convert h }, + convert h.ge }, { rintros ⟨h, coe_h⟩, rw [← h.span_eq, coe_h, hv_coe] } end -/-- In a finite-dimensional `inner_product_space`, any orthonormal subset can be extended to an -orthonormal basis. -/ -lemma exists_subset_is_orthonormal_basis - (hv : orthonormal 𝕜 (coe : v → E)) : - ∃ (u ⊇ v) (b : basis u 𝕜 E), orthonormal 𝕜 b ∧ ⇑b = coe := -begin - obtain ⟨u, hus, hu, hu_max⟩ := exists_maximal_orthonormal hv, - obtain ⟨b, hb⟩ := (maximal_orthonormal_iff_basis_of_finite_dimensional hu).mp hu_max, - exact ⟨u, hus, b, by rwa hb, hb⟩ -end - -variables (𝕜 E) - -/-- Index for an arbitrary orthonormal basis on a finite-dimensional `inner_product_space`. -/ -def orthonormal_basis_index : set E := -classical.some (exists_subset_is_orthonormal_basis (orthonormal_empty 𝕜 E)) - - -/-- A finite-dimensional `inner_product_space` has an orthonormal basis. -/ -def std_orthonormal_basis : - basis (orthonormal_basis_index 𝕜 E) 𝕜 E := -(exists_subset_is_orthonormal_basis (orthonormal_empty 𝕜 E)).some_spec.some_spec.some - -lemma std_orthonormal_basis_orthonormal : - orthonormal 𝕜 (std_orthonormal_basis 𝕜 E) := -(exists_subset_is_orthonormal_basis (orthonormal_empty 𝕜 E)).some_spec.some_spec.some_spec.1 - -@[simp] lemma coe_std_orthonormal_basis : - ⇑(std_orthonormal_basis 𝕜 E) = coe := -(exists_subset_is_orthonormal_basis (orthonormal_empty 𝕜 E)).some_spec.some_spec.some_spec.2 - -instance : fintype (orthonormal_basis_index 𝕜 E) := -@is_noetherian.fintype_basis_index _ _ _ _ _ _ - (is_noetherian.iff_fg.2 infer_instance) (std_orthonormal_basis 𝕜 E) - -variables {𝕜 E} - -/-- An `n`-dimensional `inner_product_space` has an orthonormal basis indexed by `fin n`. -/ -def fin_std_orthonormal_basis {n : ℕ} (hn : finrank 𝕜 E = n) : - basis (fin n) 𝕜 E := -have h : fintype.card (orthonormal_basis_index 𝕜 E) = n, -by rw [← finrank_eq_card_basis (std_orthonormal_basis 𝕜 E), hn], -(std_orthonormal_basis 𝕜 E).reindex (fintype.equiv_fin_of_card_eq h) - -lemma fin_std_orthonormal_basis_orthonormal {n : ℕ} (hn : finrank 𝕜 E = n) : - orthonormal 𝕜 (fin_std_orthonormal_basis hn) := -suffices orthonormal 𝕜 (std_orthonormal_basis _ _ ∘ equiv.symm _), -by { simp only [fin_std_orthonormal_basis, basis.coe_reindex], assumption }, -- simpa doesn't work? -(std_orthonormal_basis_orthonormal 𝕜 E).comp _ (equiv.injective _) - -section subordinate_orthonormal_basis -open direct_sum -variables {n : ℕ} (hn : finrank 𝕜 E = n) {ι : Type*} [fintype ι] [decidable_eq ι] - {V : ι → submodule 𝕜 E} (hV : submodule_is_internal V) - -/-- Exhibit a bijection between `fin n` and the index set of a certain basis of an `n`-dimensional -inner product space `E`. This should not be accessed directly, but only via the subsequent API. -/ -@[irreducible] def direct_sum.submodule_is_internal.sigma_orthonormal_basis_index_equiv : - (Σ i, orthonormal_basis_index 𝕜 (V i)) ≃ fin n := -let b := hV.collected_basis (λ i, std_orthonormal_basis 𝕜 (V i)) in -fintype.equiv_fin_of_card_eq $ (finite_dimensional.finrank_eq_card_basis b).symm.trans hn - -/-- An `n`-dimensional `inner_product_space` equipped with a decomposition as an internal direct -sum has an orthonormal basis indexed by `fin n` and subordinate to that direct sum. -/ -@[irreducible] def direct_sum.submodule_is_internal.subordinate_orthonormal_basis : - basis (fin n) 𝕜 E := -(hV.collected_basis (λ i, std_orthonormal_basis 𝕜 (V i))).reindex - (hV.sigma_orthonormal_basis_index_equiv hn) - -/-- An `n`-dimensional `inner_product_space` equipped with a decomposition as an internal direct -sum has an orthonormal basis indexed by `fin n` and subordinate to that direct sum. This function -provides the mapping by which it is subordinate. -/ -def direct_sum.submodule_is_internal.subordinate_orthonormal_basis_index (a : fin n) : ι := -((hV.sigma_orthonormal_basis_index_equiv hn).symm a).1 - -/-- The basis constructed in `orthogonal_family.subordinate_orthonormal_basis` is orthonormal. -/ -lemma direct_sum.submodule_is_internal.subordinate_orthonormal_basis_orthonormal - (hV' : @orthogonal_family 𝕜 _ _ _ _ (λ i, V i) _ (λ i, (V i).subtypeₗᵢ)) : - orthonormal 𝕜 (hV.subordinate_orthonormal_basis hn) := -begin - simp only [direct_sum.submodule_is_internal.subordinate_orthonormal_basis, basis.coe_reindex], - have : orthonormal 𝕜 (hV.collected_basis (λ i, std_orthonormal_basis 𝕜 (V i))) := - hV.collected_basis_orthonormal hV' (λ i, std_orthonormal_basis_orthonormal 𝕜 (V i)), - exact this.comp _ (equiv.injective _), -end - -/-- The basis constructed in `orthogonal_family.subordinate_orthonormal_basis` is subordinate to -the `orthogonal_family` in question. -/ -lemma direct_sum.submodule_is_internal.subordinate_orthonormal_basis_subordinate (a : fin n) : - hV.subordinate_orthonormal_basis hn a ∈ V (hV.subordinate_orthonormal_basis_index hn a) := -by simpa only [direct_sum.submodule_is_internal.subordinate_orthonormal_basis, basis.coe_reindex] - using hV.collected_basis_mem (λ i, std_orthonormal_basis 𝕜 (V i)) - ((hV.sigma_orthonormal_basis_index_equiv hn).symm a) - -attribute [irreducible] direct_sum.submodule_is_internal.subordinate_orthonormal_basis_index - -end subordinate_orthonormal_basis - -end finite_dimensional - end orthonormal_basis diff --git a/src/analysis/inner_product_space/rayleigh.lean b/src/analysis/inner_product_space/rayleigh.lean index 862b986327016..7d9b1bed9dbca 100644 --- a/src/analysis/inner_product_space/rayleigh.lean +++ b/src/analysis/inner_product_space/rayleigh.lean @@ -5,36 +5,40 @@ Authors: Heather Macbeth, Frédéric Dupuis -/ import analysis.inner_product_space.calculus import analysis.inner_product_space.dual +import analysis.inner_product_space.adjoint import analysis.calculus.lagrange_multipliers -import linear_algebra.eigenspace +import linear_algebra.eigenspace.basic /-! # The Rayleigh quotient +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The Rayleigh quotient of a self-adjoint operator `T` on an inner product space `E` is the function -`λ x, ⟪T x, x⟫ / ∥x∥ ^ 2`. +`λ x, ⟪T x, x⟫ / ‖x‖ ^ 2`. The main results of this file are `is_self_adjoint.has_eigenvector_of_is_max_on` and `is_self_adjoint.has_eigenvector_of_is_min_on`, which state that if `E` is complete, and if the Rayleigh quotient attains its global maximum/minimum over some sphere at the point `x₀`, then `x₀` -is an eigenvector of `T`, and the `supr`/`infi` of `λ x, ⟪T x, x⟫ / ∥x∥ ^ 2` is the corresponding +is an eigenvector of `T`, and the `supr`/`infi` of `λ x, ⟪T x, x⟫ / ‖x‖ ^ 2` is the corresponding eigenvalue. The corollaries `is_self_adjoint.has_eigenvalue_supr_of_finite_dimensional` and `is_self_adjoint.has_eigenvalue_supr_of_finite_dimensional` state that if `E` is finite-dimensional and nontrivial, then `T` has some (nonzero) eigenvectors with eigenvalue the `supr`/`infi` of -`λ x, ⟪T x, x⟫ / ∥x∥ ^ 2`. +`λ x, ⟪T x, x⟫ / ‖x‖ ^ 2`. ## TODO A slightly more elaborate corollary is that if `E` is complete and `T` is a compact operator, then -`T` has some (nonzero) eigenvector with eigenvalue either `⨆ x, ⟪T x, x⟫ / ∥x∥ ^ 2` or -`⨅ x, ⟪T x, x⟫ / ∥x∥ ^ 2` (not necessarily both). +`T` has some (nonzero) eigenvector with eigenvalue either `⨆ x, ⟪T x, x⟫ / ‖x‖ ^ 2` or +`⨅ x, ⟪T x, x⟫ / ‖x‖ ^ 2` (not necessarily both). -/ variables {𝕜 : Type*} [is_R_or_C 𝕜] -variables {E : Type*} [inner_product_space 𝕜 E] +variables {E : Type*} [normed_add_comm_group E] [inner_product_space 𝕜 E] local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y open_locale nnreal @@ -43,15 +47,15 @@ open module.End metric namespace continuous_linear_map variables (T : E →L[𝕜] E) -local notation `rayleigh_quotient` := λ x : E, T.re_apply_inner_self x / ∥(x:E)∥ ^ 2 +local notation `rayleigh_quotient` := λ x : E, T.re_apply_inner_self x / ‖(x:E)‖ ^ 2 lemma rayleigh_smul (x : E) {c : 𝕜} (hc : c ≠ 0) : rayleigh_quotient (c • x) = rayleigh_quotient x := begin by_cases hx : x = 0, { simp [hx] }, - have : ∥c∥ ≠ 0 := by simp [hc], - have : ∥x∥ ≠ 0 := by simp [hx], + have : ‖c‖ ≠ 0 := by simp [hc], + have : ‖x‖ ≠ 0 := by simp [hx], field_simp [norm_smul, T.re_apply_inner_self_smul], ring end @@ -62,11 +66,11 @@ begin ext a, split, { rintros ⟨x, (hx : x ≠ 0), hxT⟩, - have : ∥x∥ ≠ 0 := by simp [hx], - let c : 𝕜 := ↑∥x∥⁻¹ * r, + have : ‖x‖ ≠ 0 := by simp [hx], + let c : 𝕜 := ↑‖x‖⁻¹ * r, have : c ≠ 0 := by simp [c, hx, hr.ne'], refine ⟨c • x, _, _⟩, - { field_simp [norm_smul, is_R_or_C.norm_eq_abs, abs_of_nonneg hr.le] }, + { field_simp [norm_smul, abs_of_pos hr] }, { rw T.rayleigh_smul x this, exact hxT } }, { rintros ⟨x, hx, hxT⟩, @@ -76,55 +80,56 @@ end lemma supr_rayleigh_eq_supr_rayleigh_sphere {r : ℝ} (hr : 0 < r) : (⨆ x : {x : E // x ≠ 0}, rayleigh_quotient x) = ⨆ x : sphere (0:E) r, rayleigh_quotient x := show (⨆ x : ({0} : set E)ᶜ, rayleigh_quotient x) = _, -by simp only [@csupr_set _ _ _ _ rayleigh_quotient, T.image_rayleigh_eq_image_rayleigh_sphere hr] +by simp only [←@Sup_image' _ _ _ _ rayleigh_quotient, T.image_rayleigh_eq_image_rayleigh_sphere hr] lemma infi_rayleigh_eq_infi_rayleigh_sphere {r : ℝ} (hr : 0 < r) : (⨅ x : {x : E // x ≠ 0}, rayleigh_quotient x) = ⨅ x : sphere (0:E) r, rayleigh_quotient x := show (⨅ x : ({0} : set E)ᶜ, rayleigh_quotient x) = _, -by simp only [@cinfi_set _ _ _ _ rayleigh_quotient, T.image_rayleigh_eq_image_rayleigh_sphere hr] +by simp only [←@Inf_image' _ _ _ _ rayleigh_quotient, T.image_rayleigh_eq_image_rayleigh_sphere hr] end continuous_linear_map -namespace inner_product_space namespace is_self_adjoint section real -variables {F : Type*} [inner_product_space ℝ F] +variables {F : Type*} [normed_add_comm_group F] [inner_product_space ℝ F] -lemma has_strict_fderiv_at_re_apply_inner_self - {T : F →L[ℝ] F} (hT : is_self_adjoint (T : F →ₗ[ℝ] F)) (x₀ : F) : - has_strict_fderiv_at T.re_apply_inner_self (bit0 (innerSL (T x₀))) x₀ := +lemma _root_.linear_map.is_symmetric.has_strict_fderiv_at_re_apply_inner_self + {T : F →L[ℝ] F} (hT : (T : F →ₗ[ℝ] F).is_symmetric) (x₀ : F) : + has_strict_fderiv_at T.re_apply_inner_self (_root_.bit0 (innerSL ℝ (T x₀))) x₀ := begin - convert T.has_strict_fderiv_at.inner (has_strict_fderiv_at_id x₀), + convert T.has_strict_fderiv_at.inner _ (has_strict_fderiv_at_id x₀), ext y, - simp [bit0, hT.apply_clm x₀ y, real_inner_comm x₀] + simp_rw [_root_.bit0, continuous_linear_map.comp_apply, continuous_linear_map.add_apply, + innerSL_apply, fderiv_inner_clm_apply, id.def, continuous_linear_map.prod_apply, + continuous_linear_map.id_apply, hT.apply_clm x₀ y, real_inner_comm _ x₀], end variables [complete_space F] {T : F →L[ℝ] F} -local notation `rayleigh_quotient` := λ x : F, T.re_apply_inner_self x / ∥(x:F)∥ ^ 2 +local notation `rayleigh_quotient` := λ x : F, T.re_apply_inner_self x / ‖(x:F)‖ ^ 2 -lemma linearly_dependent_of_is_local_extr_on (hT : is_self_adjoint (T : F →ₗ[ℝ] F)) - {x₀ : F} (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:F) ∥x₀∥) x₀) : +lemma linearly_dependent_of_is_local_extr_on (hT : is_self_adjoint T) + {x₀ : F} (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:F) ‖x₀‖) x₀) : ∃ a b : ℝ, (a, b) ≠ 0 ∧ a • x₀ + b • T x₀ = 0 := begin - have H : is_local_extr_on T.re_apply_inner_self {x : F | ∥x∥ ^ 2 = ∥x₀∥ ^ 2} x₀, + have H : is_local_extr_on T.re_apply_inner_self {x : F | ‖x‖ ^ 2 = ‖x₀‖ ^ 2} x₀, { convert hextr, ext x, simp [dist_eq_norm] }, -- find Lagrange multipliers for the function `T.re_apply_inner_self` and the - -- hypersurface-defining function `λ x, ∥x∥ ^ 2` + -- hypersurface-defining function `λ x, ‖x‖ ^ 2` obtain ⟨a, b, h₁, h₂⟩ := is_local_extr_on.exists_multipliers_of_has_strict_fderiv_at_1d H - (has_strict_fderiv_at_norm_sq x₀) (hT.has_strict_fderiv_at_re_apply_inner_self x₀), + (has_strict_fderiv_at_norm_sq x₀) (hT.is_symmetric.has_strict_fderiv_at_re_apply_inner_self x₀), refine ⟨a, b, h₁, _⟩, apply (inner_product_space.to_dual_map ℝ F).injective, simp only [linear_isometry.map_add, linear_isometry.map_smul, linear_isometry.map_zero], - change a • innerSL x₀ + b • innerSL (T x₀) = 0, + change a • innerSL _ x₀ + b • innerSL _ (T x₀) = 0, apply smul_right_injective (F →L[ℝ] ℝ) (two_ne_zero : (2:ℝ) ≠ 0), - simpa only [bit0, add_smul, smul_add, one_smul, add_zero] using h₂ + simpa only [_root_.bit0, add_smul, smul_add, one_smul, add_zero] using h₂ end -lemma eq_smul_self_of_is_local_extr_on_real (hT : is_self_adjoint (T : F →ₗ[ℝ] F)) - {x₀ : F} (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:F) ∥x₀∥) x₀) : +lemma eq_smul_self_of_is_local_extr_on_real (hT : is_self_adjoint T) + {x₀ : F} (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:F) ‖x₀‖) x₀) : T x₀ = (rayleigh_quotient x₀) • x₀ := begin obtain ⟨a, b, h₁, h₂⟩ := hT.linearly_dependent_of_is_local_extr_on hextr, @@ -139,9 +144,9 @@ begin have hc : T x₀ = c • x₀, { have : b * (b⁻¹ * a) = a := by field_simp [mul_comm], apply smul_right_injective F hb, - simp [c, ← neg_eq_of_add_eq_zero h₂, ← mul_smul, this] }, + simp [c, eq_neg_of_add_eq_zero_left h₂, ← mul_smul, this] }, convert hc, - have : ∥x₀∥ ≠ 0 := by simp [hx₀], + have : ‖x₀‖ ≠ 0 := by simp [hx₀], field_simp, simpa [inner_smul_left, real_inner_self_eq_norm_mul_norm, sq] using congr_arg (λ x, ⟪x, x₀⟫_ℝ) hc, end @@ -150,27 +155,21 @@ end real section complete_space variables [complete_space E] {T : E →L[𝕜] E} -local notation `rayleigh_quotient` := λ x : E, T.re_apply_inner_self x / ∥(x:E)∥ ^ 2 +local notation `rayleigh_quotient` := λ x : E, T.re_apply_inner_self x / ‖(x:E)‖ ^ 2 -lemma eq_smul_self_of_is_local_extr_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E} - (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) : +lemma eq_smul_self_of_is_local_extr_on (hT : is_self_adjoint T) {x₀ : E} + (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:E) ‖x₀‖) x₀) : T x₀ = (↑(rayleigh_quotient x₀) : 𝕜) • x₀ := begin letI := inner_product_space.is_R_or_C_to_real 𝕜 E, - let S : E →L[ℝ] E := - @continuous_linear_map.restrict_scalars 𝕜 E E _ _ _ _ _ _ _ ℝ _ _ _ _ T, - have hSA : is_self_adjoint (S : E →ₗ[ℝ] E) := λ x y, by - { have := hT x y, - simp only [continuous_linear_map.coe_coe] at this, - simp only [real_inner_eq_re_inner, this, continuous_linear_map.coe_restrict_scalars, - continuous_linear_map.coe_coe, linear_map.coe_restrict_scalars_eq_coe] }, - exact eq_smul_self_of_is_local_extr_on_real hSA hextr, + let hSA := hT.is_symmetric.restrict_scalars.to_self_adjoint.prop, + exact hSA.eq_smul_self_of_is_local_extr_on_real hextr, end /-- For a self-adjoint operator `T`, a local extremum of the Rayleigh quotient of `T` on a sphere centred at the origin is an eigenvector of `T`. -/ -lemma has_eigenvector_of_is_local_extr_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E} - (hx₀ : x₀ ≠ 0) (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) : +lemma has_eigenvector_of_is_local_extr_on (hT : is_self_adjoint T) {x₀ : E} + (hx₀ : x₀ ≠ 0) (hextr : is_local_extr_on T.re_apply_inner_self (sphere (0:E) ‖x₀‖) x₀) : has_eigenvector (T : E →ₗ[𝕜] E) ↑(rayleigh_quotient x₀) x₀ := begin refine ⟨_, hx₀⟩, @@ -181,103 +180,108 @@ end /-- For a self-adjoint operator `T`, a maximum of the Rayleigh quotient of `T` on a sphere centred at the origin is an eigenvector of `T`, with eigenvalue the global supremum of the Rayleigh quotient. -/ -lemma has_eigenvector_of_is_max_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E} - (hx₀ : x₀ ≠ 0) (hextr : is_max_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) : +lemma has_eigenvector_of_is_max_on (hT : is_self_adjoint T) {x₀ : E} + (hx₀ : x₀ ≠ 0) (hextr : is_max_on T.re_apply_inner_self (sphere (0:E) ‖x₀‖) x₀) : has_eigenvector (T : E →ₗ[𝕜] E) ↑(⨆ x : {x : E // x ≠ 0}, rayleigh_quotient x) x₀ := begin convert hT.has_eigenvector_of_is_local_extr_on hx₀ (or.inr hextr.localize), - have hx₀' : 0 < ∥x₀∥ := by simp [hx₀], - have hx₀'' : x₀ ∈ sphere (0:E) (∥x₀∥) := by simp, + have hx₀' : 0 < ‖x₀‖ := by simp [hx₀], + have hx₀'' : x₀ ∈ sphere (0:E) (‖x₀‖) := by simp, rw T.supr_rayleigh_eq_supr_rayleigh_sphere hx₀', refine is_max_on.supr_eq hx₀'' _, intros x hx, dsimp, - have : ∥x∥ = ∥x₀∥ := by simpa using hx, + have : ‖x‖ = ‖x₀‖ := by simpa using hx, rw this, - exact div_le_div_of_le (sq_nonneg ∥x₀∥) (hextr hx) + exact div_le_div_of_le (sq_nonneg ‖x₀‖) (hextr hx) end /-- For a self-adjoint operator `T`, a minimum of the Rayleigh quotient of `T` on a sphere centred at the origin is an eigenvector of `T`, with eigenvalue the global infimum of the Rayleigh quotient. -/ -lemma has_eigenvector_of_is_min_on (hT : is_self_adjoint (T : E →ₗ[𝕜] E)) {x₀ : E} - (hx₀ : x₀ ≠ 0) (hextr : is_min_on T.re_apply_inner_self (sphere (0:E) ∥x₀∥) x₀) : +lemma has_eigenvector_of_is_min_on (hT : is_self_adjoint T) {x₀ : E} + (hx₀ : x₀ ≠ 0) (hextr : is_min_on T.re_apply_inner_self (sphere (0:E) ‖x₀‖) x₀) : has_eigenvector (T : E →ₗ[𝕜] E) ↑(⨅ x : {x : E // x ≠ 0}, rayleigh_quotient x) x₀ := begin convert hT.has_eigenvector_of_is_local_extr_on hx₀ (or.inl hextr.localize), - have hx₀' : 0 < ∥x₀∥ := by simp [hx₀], - have hx₀'' : x₀ ∈ sphere (0:E) (∥x₀∥) := by simp, + have hx₀' : 0 < ‖x₀‖ := by simp [hx₀], + have hx₀'' : x₀ ∈ sphere (0:E) (‖x₀‖) := by simp, rw T.infi_rayleigh_eq_infi_rayleigh_sphere hx₀', refine is_min_on.infi_eq hx₀'' _, intros x hx, dsimp, - have : ∥x∥ = ∥x₀∥ := by simpa using hx, + have : ‖x‖ = ‖x₀‖ := by simpa using hx, rw this, - exact div_le_div_of_le (sq_nonneg ∥x₀∥) (hextr hx) + exact div_le_div_of_le (sq_nonneg ‖x₀‖) (hextr hx) end end complete_space +end is_self_adjoint + section finite_dimensional variables [finite_dimensional 𝕜 E] [_i : nontrivial E] {T : E →ₗ[𝕜] E} +namespace linear_map + +namespace is_symmetric + include _i -/-- The supremum of the Rayleigh quotient of a self-adjoint operator `T` on a nontrivial +/-- The supremum of the Rayleigh quotient of a symmetric operator `T` on a nontrivial finite-dimensional vector space is an eigenvalue for that operator. -/ -lemma has_eigenvalue_supr_of_finite_dimensional (hT : is_self_adjoint T) : - has_eigenvalue T ↑(⨆ x : {x : E // x ≠ 0}, is_R_or_C.re ⟪T x, x⟫ / ∥(x:E)∥ ^ 2) := +lemma has_eigenvalue_supr_of_finite_dimensional (hT : T.is_symmetric) : + has_eigenvalue T ↑(⨆ x : {x : E // x ≠ 0}, is_R_or_C.re ⟪T x, x⟫ / ‖(x:E)‖ ^ 2) := begin haveI := finite_dimensional.proper_is_R_or_C 𝕜 E, - let T' : E →L[𝕜] E := T.to_continuous_linear_map, - have hT' : is_self_adjoint (T' : E →ₗ[𝕜] E) := hT, + let T' := hT.to_self_adjoint, obtain ⟨x, hx⟩ : ∃ x : E, x ≠ 0 := exists_ne 0, - have H₁ : is_compact (sphere (0:E) ∥x∥) := is_compact_sphere _ _, - have H₂ : (sphere (0:E) ∥x∥).nonempty := ⟨x, by simp⟩, + have H₁ : is_compact (sphere (0:E) ‖x‖) := is_compact_sphere _ _, + have H₂ : (sphere (0:E) ‖x‖).nonempty := ⟨x, by simp⟩, -- key point: in finite dimension, a continuous function on the sphere has a max obtain ⟨x₀, hx₀', hTx₀⟩ := - H₁.exists_forall_ge H₂ T'.re_apply_inner_self_continuous.continuous_on, - have hx₀ : ∥x₀∥ = ∥x∥ := by simpa using hx₀', - have : is_max_on T'.re_apply_inner_self (sphere 0 ∥x₀∥) x₀, + H₁.exists_forall_ge H₂ T'.val.re_apply_inner_self_continuous.continuous_on, + have hx₀ : ‖x₀‖ = ‖x‖ := by simpa using hx₀', + have : is_max_on T'.val.re_apply_inner_self (sphere 0 ‖x₀‖) x₀, { simpa only [← hx₀] using hTx₀ }, have hx₀_ne : x₀ ≠ 0, - { have : ∥x₀∥ ≠ 0 := by simp only [hx₀, norm_eq_zero, hx, ne.def, not_false_iff], + { have : ‖x₀‖ ≠ 0 := by simp only [hx₀, norm_eq_zero, hx, ne.def, not_false_iff], simpa [← norm_eq_zero, ne.def] }, - exact has_eigenvalue_of_has_eigenvector (hT'.has_eigenvector_of_is_max_on hx₀_ne this) + exact has_eigenvalue_of_has_eigenvector (T'.prop.has_eigenvector_of_is_max_on hx₀_ne this) end -/-- The infimum of the Rayleigh quotient of a self-adjoint operator `T` on a nontrivial +/-- The infimum of the Rayleigh quotient of a symmetric operator `T` on a nontrivial finite-dimensional vector space is an eigenvalue for that operator. -/ -lemma has_eigenvalue_infi_of_finite_dimensional (hT : is_self_adjoint T) : - has_eigenvalue T ↑(⨅ x : {x : E // x ≠ 0}, is_R_or_C.re ⟪T x, x⟫ / ∥(x:E)∥ ^ 2) := +lemma has_eigenvalue_infi_of_finite_dimensional (hT : T.is_symmetric) : + has_eigenvalue T ↑(⨅ x : {x : E // x ≠ 0}, is_R_or_C.re ⟪T x, x⟫ / ‖(x:E)‖ ^ 2) := begin haveI := finite_dimensional.proper_is_R_or_C 𝕜 E, - let T' : E →L[𝕜] E := T.to_continuous_linear_map, - have hT' : is_self_adjoint (T' : E →ₗ[𝕜] E) := hT, + let T' := hT.to_self_adjoint, obtain ⟨x, hx⟩ : ∃ x : E, x ≠ 0 := exists_ne 0, - have H₁ : is_compact (sphere (0:E) ∥x∥) := is_compact_sphere _ _, - have H₂ : (sphere (0:E) ∥x∥).nonempty := ⟨x, by simp⟩, + have H₁ : is_compact (sphere (0:E) ‖x‖) := is_compact_sphere _ _, + have H₂ : (sphere (0:E) ‖x‖).nonempty := ⟨x, by simp⟩, -- key point: in finite dimension, a continuous function on the sphere has a min obtain ⟨x₀, hx₀', hTx₀⟩ := - H₁.exists_forall_le H₂ T'.re_apply_inner_self_continuous.continuous_on, - have hx₀ : ∥x₀∥ = ∥x∥ := by simpa using hx₀', - have : is_min_on T'.re_apply_inner_self (sphere 0 ∥x₀∥) x₀, + H₁.exists_forall_le H₂ T'.val.re_apply_inner_self_continuous.continuous_on, + have hx₀ : ‖x₀‖ = ‖x‖ := by simpa using hx₀', + have : is_min_on T'.val.re_apply_inner_self (sphere 0 ‖x₀‖) x₀, { simpa only [← hx₀] using hTx₀ }, have hx₀_ne : x₀ ≠ 0, - { have : ∥x₀∥ ≠ 0 := by simp only [hx₀, norm_eq_zero, hx, ne.def, not_false_iff], + { have : ‖x₀‖ ≠ 0 := by simp only [hx₀, norm_eq_zero, hx, ne.def, not_false_iff], simpa [← norm_eq_zero, ne.def] }, - exact has_eigenvalue_of_has_eigenvector (hT'.has_eigenvector_of_is_min_on hx₀_ne this) + exact has_eigenvalue_of_has_eigenvector (T'.prop.has_eigenvector_of_is_min_on hx₀_ne this) end omit _i lemma subsingleton_of_no_eigenvalue_finite_dimensional - (hT : is_self_adjoint T) (hT' : ∀ μ : 𝕜, module.End.eigenspace (T : E →ₗ[𝕜] E) μ = ⊥) : + (hT : T.is_symmetric) (hT' : ∀ μ : 𝕜, module.End.eigenspace (T : E →ₗ[𝕜] E) μ = ⊥) : subsingleton E := (subsingleton_or_nontrivial E).resolve_right (λ h, by exactI absurd (hT' _) hT.has_eigenvalue_supr_of_finite_dimensional) -end finite_dimensional +end is_symmetric -end is_self_adjoint -end inner_product_space +end linear_map + +end finite_dimensional diff --git a/src/analysis/inner_product_space/spectrum.lean b/src/analysis/inner_product_space/spectrum.lean index e79c6c18ddf81..6c3e285e142f5 100644 --- a/src/analysis/inner_product_space/spectrum.lean +++ b/src/analysis/inner_product_space/spectrum.lean @@ -5,9 +5,14 @@ Authors: Heather Macbeth -/ import analysis.inner_product_space.rayleigh import analysis.inner_product_space.pi_L2 +import algebra.direct_sum.decomposition +import linear_algebra.eigenspace.minpoly /-! # Spectral theory of self-adjoint operators +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file covers the spectral theory of self-adjoint operators on an inner product space. The first part of the file covers general properties, true without any condition on boundedness or @@ -44,17 +49,17 @@ self-adjoint operator, spectral theorem, diagonalization theorem -/ variables {𝕜 : Type*} [is_R_or_C 𝕜] [dec_𝕜 : decidable_eq 𝕜] -variables {E : Type*} [inner_product_space 𝕜 E] +variables {E : Type*} [normed_add_comm_group E] [inner_product_space 𝕜 E] local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y open_locale big_operators complex_conjugate open module.End -namespace inner_product_space -namespace is_self_adjoint +namespace linear_map +namespace is_symmetric -variables {T : E →ₗ[𝕜] E} (hT : is_self_adjoint T) +variables {T : E →ₗ[𝕜] E} (hT : T.is_symmetric) include hT /-- A self-adjoint operator preserves orthogonal complements of its eigenspaces. -/ @@ -76,7 +81,7 @@ end /-- The eigenspaces of a self-adjoint operator are mutually orthogonal. -/ lemma orthogonal_family_eigenspaces : - @orthogonal_family 𝕜 _ _ _ _ (λ μ, eigenspace T μ) _ (λ μ, (eigenspace T μ).subtypeₗᵢ) := + orthogonal_family 𝕜 (λ μ, eigenspace T μ) (λ μ, (eigenspace T μ).subtypeₗᵢ) := begin rintros μ ν hμν ⟨v, hv⟩ ⟨w, hw⟩, by_cases hv' : v = 0, @@ -88,8 +93,7 @@ begin end lemma orthogonal_family_eigenspaces' : - @orthogonal_family 𝕜 _ _ _ _ (λ μ : eigenvalues T, eigenspace T μ) _ - (λ μ, (eigenspace T μ).subtypeₗᵢ) := + orthogonal_family 𝕜 (λ μ : eigenvalues T, eigenspace T μ) (λ μ, (eigenspace T μ).subtypeₗᵢ) := hT.orthogonal_family_eigenspaces.comp subtype.coe_injective /-- The mutual orthogonal complement of the eigenspaces of a self-adjoint operator on an inner @@ -108,8 +112,8 @@ lemma orthogonal_supr_eigenspaces (μ : 𝕜) : begin set p : submodule 𝕜 E := (⨆ μ, eigenspace T μ)ᗮ, refine eigenspace_restrict_eq_bot hT.orthogonal_supr_eigenspaces_invariant _, - have H₂ : p ≤ (eigenspace T μ)ᗮ := submodule.orthogonal_le (le_supr _ _), - exact (eigenspace T μ).orthogonal_disjoint.mono_right H₂ + have H₂ : eigenspace T μ ⟂ p := (submodule.is_ortho_orthogonal_right _).mono_left (le_supr _ _), + exact H₂.disjoint end /-! ### Finite-dimensional theory -/ @@ -120,7 +124,7 @@ variables [finite_dimensional 𝕜 E] finite-dimensional inner product space is trivial. -/ lemma orthogonal_supr_eigenspaces_eq_bot : (⨆ μ, eigenspace T μ)ᗮ = ⊥ := begin - have hT' : is_self_adjoint _ := hT.restrict_invariant hT.orthogonal_supr_eigenspaces_invariant, + have hT' : is_symmetric _ := hT.restrict_invariant hT.orthogonal_supr_eigenspaces_invariant, -- a self-adjoint operator on a nontrivial inner product space has an eigenvalue haveI := hT'.subsingleton_of_no_eigenvalue_finite_dimensional hT.orthogonal_supr_eigenspaces, exact submodule.eq_bot_of_subsingleton _, @@ -131,12 +135,31 @@ show (⨆ μ : {μ // (eigenspace T μ) ≠ ⊥}, eigenspace T μ)ᗮ = ⊥, by rw [supr_ne_bot_subtype, hT.orthogonal_supr_eigenspaces_eq_bot] include dec_𝕜 +omit hT +/-- The eigenspaces of a self-adjoint operator on a finite-dimensional inner product space `E` gives +an internal direct sum decomposition of `E`. + +Note this takes `hT` as a `fact` to allow it to be an instance. -/ +noncomputable instance direct_sum_decomposition [hT : fact T.is_symmetric] : + direct_sum.decomposition (λ μ : eigenvalues T, eigenspace T μ) := +begin + haveI h : ∀ μ : eigenvalues T, complete_space (eigenspace T μ) := λ μ, by apply_instance, + exact hT.out.orthogonal_family_eigenspaces'.decomposition + (submodule.orthogonal_eq_bot_iff.mp hT.out.orthogonal_supr_eigenspaces_eq_bot'), +end + +lemma direct_sum_decompose_apply [hT : fact T.is_symmetric] (x : E) (μ : eigenvalues T) : + direct_sum.decompose (λ μ : eigenvalues T, eigenspace T μ) x μ + = orthogonal_projection (eigenspace T μ) x := +rfl -/-- The eigenspaces of a self-adjoint operator on a finite-dimensional inner product space `E` give +include hT + +/-- The eigenspaces of a self-adjoint operator on a finite-dimensional inner product space `E` gives an internal direct sum decomposition of `E`. -/ -lemma direct_sum_submodule_is_internal : - direct_sum.submodule_is_internal (λ μ : eigenvalues T, eigenspace T μ) := -hT.orthogonal_family_eigenspaces'.submodule_is_internal_iff.mpr +lemma direct_sum_is_internal : + direct_sum.is_internal (λ μ : eigenvalues T, eigenspace T μ) := +hT.orthogonal_family_eigenspaces'.is_internal_iff.mpr hT.orthogonal_supr_eigenspaces_eq_bot' section version1 @@ -144,12 +167,12 @@ section version1 /-- Isometry from an inner product space `E` to the direct sum of the eigenspaces of some self-adjoint operator `T` on `E`. -/ noncomputable def diagonalization : E ≃ₗᵢ[𝕜] pi_Lp 2 (λ μ : eigenvalues T, eigenspace T μ) := -hT.direct_sum_submodule_is_internal.isometry_L2_of_orthogonal_family +hT.direct_sum_is_internal.isometry_L2_of_orthogonal_family hT.orthogonal_family_eigenspaces' @[simp] lemma diagonalization_symm_apply (w : pi_Lp 2 (λ μ : eigenvalues T, eigenspace T μ)) : hT.diagonalization.symm w = ∑ μ, w μ := -hT.direct_sum_submodule_is_internal.isometry_L2_of_orthogonal_family_symm_apply +hT.direct_sum_is_internal.isometry_L2_of_orthogonal_family_symm_apply hT.orthogonal_family_eigenspaces' w /-- *Diagonalization theorem*, *spectral theorem*; version 1: A self-adjoint operator `T` on a @@ -160,13 +183,11 @@ lemma diagonalization_apply_self_apply (v : E) (μ : eigenvalues T) : begin suffices : ∀ w : pi_Lp 2 (λ μ : eigenvalues T, eigenspace T μ), (T (hT.diagonalization.symm w)) = hT.diagonalization.symm (λ μ, (μ : 𝕜) • w μ), - { simpa [linear_isometry_equiv.symm_apply_apply, -is_self_adjoint.diagonalization_symm_apply] + { simpa only [linear_isometry_equiv.symm_apply_apply, linear_isometry_equiv.apply_symm_apply] using congr_arg (λ w, hT.diagonalization w μ) (this (hT.diagonalization v)) }, intros w, - have hwT : ∀ μ : eigenvalues T, T (w μ) = (μ : 𝕜) • w μ, - { intros μ, - simpa [mem_eigenspace_iff] using (w μ).prop }, - simp [hwT], + have hwT : ∀ μ, T (w μ) = (μ : 𝕜) • w μ := λ μ, mem_eigenspace_iff.1 (w μ).2, + simp only [hwT, diagonalization_symm_apply, map_sum, submodule.coe_smul_of_tower], end end version1 @@ -179,88 +200,86 @@ finite-dimensional inner product space `E`. TODO Postcompose with a permutation so that these eigenvectors are listed in increasing order of eigenvalue. -/ -noncomputable def eigenvector_basis : basis (fin n) 𝕜 E := -hT.direct_sum_submodule_is_internal.subordinate_orthonormal_basis hn - -lemma eigenvector_basis_orthonormal : orthonormal 𝕜 (hT.eigenvector_basis hn) := -hT.direct_sum_submodule_is_internal.subordinate_orthonormal_basis_orthonormal hn +@[irreducible] noncomputable def eigenvector_basis : orthonormal_basis (fin n) 𝕜 E := +hT.direct_sum_is_internal.subordinate_orthonormal_basis hn hT.orthogonal_family_eigenspaces' /-- The sequence of real eigenvalues associated to the standard orthonormal basis of eigenvectors for a self-adjoint operator `T` on `E`. TODO Postcompose with a permutation so that these eigenvalues are listed in increasing order. -/ -noncomputable def eigenvalues (i : fin n) : ℝ := -@is_R_or_C.re 𝕜 _ $ hT.direct_sum_submodule_is_internal.subordinate_orthonormal_basis_index hn i +@[irreducible] noncomputable def eigenvalues (i : fin n) : ℝ := +@is_R_or_C.re 𝕜 _ $ + hT.direct_sum_is_internal.subordinate_orthonormal_basis_index hn i + hT.orthogonal_family_eigenspaces' lemma has_eigenvector_eigenvector_basis (i : fin n) : has_eigenvector T (hT.eigenvalues hn i) (hT.eigenvector_basis hn i) := begin let v : E := hT.eigenvector_basis hn i, - let μ : 𝕜 := hT.direct_sum_submodule_is_internal.subordinate_orthonormal_basis_index hn i, + let μ : 𝕜 := hT.direct_sum_is_internal.subordinate_orthonormal_basis_index + hn i hT.orthogonal_family_eigenspaces', + simp_rw [eigenvalues], change has_eigenvector T (is_R_or_C.re μ) v, have key : has_eigenvector T μ v, { have H₁ : v ∈ eigenspace T μ, - { exact hT.direct_sum_submodule_is_internal.subordinate_orthonormal_basis_subordinate hn i }, - have H₂ : v ≠ 0 := (hT.eigenvector_basis_orthonormal hn).ne_zero i, + { simp_rw [v, eigenvector_basis], + exact hT.direct_sum_is_internal.subordinate_orthonormal_basis_subordinate + hn i hT.orthogonal_family_eigenspaces' }, + have H₂ : v ≠ 0 := by simpa using (hT.eigenvector_basis hn).to_basis.ne_zero i, exact ⟨H₁, H₂⟩ }, have re_μ : ↑(is_R_or_C.re μ) = μ, - { rw ← is_R_or_C.eq_conj_iff_re, + { rw ← is_R_or_C.conj_eq_iff_re, exact hT.conj_eigenvalue_eq_self (has_eigenvalue_of_has_eigenvector key) }, simpa [re_μ] using key, end lemma has_eigenvalue_eigenvalues (i : fin n) : has_eigenvalue T (hT.eigenvalues hn i) := - module.End.has_eigenvalue_of_has_eigenvector (hT.has_eigenvector_eigenvector_basis hn i) - -attribute [irreducible] eigenvector_basis eigenvalues +module.End.has_eigenvalue_of_has_eigenvector (hT.has_eigenvector_eigenvector_basis hn i) @[simp] lemma apply_eigenvector_basis (i : fin n) : T (hT.eigenvector_basis hn i) = (hT.eigenvalues hn i : 𝕜) • hT.eigenvector_basis hn i := mem_eigenspace_iff.mp (hT.has_eigenvector_eigenvector_basis hn i).1 -/-- An isometry from an inner product space `E` to Euclidean space, induced by a choice of -orthonormal basis of eigenvectors for a self-adjoint operator `T` on `E`. -/ -noncomputable def diagonalization_basis : E ≃ₗᵢ[𝕜] euclidean_space 𝕜 (fin n) := -((hT.eigenvector_basis hn).to_orthonormal_basis (hT.eigenvector_basis_orthonormal hn)).repr - -@[simp] lemma diagonalization_basis_symm_apply (w : euclidean_space 𝕜 (fin n)) : - (hT.diagonalization_basis hn).symm w = ∑ i, w i • hT.eigenvector_basis hn i := -by simp [diagonalization_basis] - /-- *Diagonalization theorem*, *spectral theorem*; version 2: A self-adjoint operator `T` on a finite-dimensional inner product space `E` acts diagonally on the identification of `E` with Euclidean space induced by an orthonormal basis of eigenvectors of `T`. -/ lemma diagonalization_basis_apply_self_apply (v : E) (i : fin n) : - hT.diagonalization_basis hn (T v) i = hT.eigenvalues hn i * hT.diagonalization_basis hn v i := + (hT.eigenvector_basis hn).repr (T v) i = + hT.eigenvalues hn i * (hT.eigenvector_basis hn).repr v i := begin suffices : ∀ w : euclidean_space 𝕜 (fin n), - T ((hT.diagonalization_basis hn).symm w) - = (hT.diagonalization_basis hn).symm (λ i, hT.eigenvalues hn i * w i), - { simpa [-diagonalization_basis_symm_apply] using - congr_arg (λ v, hT.diagonalization_basis hn v i) (this (hT.diagonalization_basis hn v)) }, + T ((hT.eigenvector_basis hn).repr.symm w) + = (hT.eigenvector_basis hn).repr.symm (λ i, hT.eigenvalues hn i * w i), + { simpa [orthonormal_basis.sum_repr_symm] using + congr_arg (λ v, (hT.eigenvector_basis hn).repr v i) + (this ((hT.eigenvector_basis hn).repr v)) }, intros w, - simp [mul_comm, mul_smul], + simp_rw [← orthonormal_basis.sum_repr_symm, linear_map.map_sum, + linear_map.map_smul, apply_eigenvector_basis], + apply fintype.sum_congr, + intros a, + rw [smul_smul, mul_comm], end end version2 -end is_self_adjoint -end inner_product_space +end is_symmetric +end linear_map section nonneg @[simp] lemma inner_product_apply_eigenvector {μ : 𝕜} {v : E} {T : E →ₗ[𝕜] E} - (h : v ∈ module.End.eigenspace T μ) : ⟪v, T v⟫ = μ * ∥v∥ ^ 2 := + (h : v ∈ module.End.eigenspace T μ) : ⟪v, T v⟫ = μ * ‖v‖ ^ 2 := by simp only [mem_eigenspace_iff.mp h, inner_smul_right, inner_self_eq_norm_sq_to_K] lemma eigenvalue_nonneg_of_nonneg {μ : ℝ} {T : E →ₗ[𝕜] E} (hμ : has_eigenvalue T μ) (hnn : ∀ (x : E), 0 ≤ is_R_or_C.re ⟪x, T x⟫) : 0 ≤ μ := begin obtain ⟨v, hv⟩ := hμ.exists_has_eigenvector, - have hpos : 0 < ∥v∥ ^ 2, by simpa only [sq_pos_iff, norm_ne_zero_iff] using hv.2, - have : is_R_or_C.re ⟪v, T v⟫ = μ * ∥v∥ ^ 2, + have hpos : 0 < ‖v‖ ^ 2, by simpa only [sq_pos_iff, norm_ne_zero_iff] using hv.2, + have : is_R_or_C.re ⟪v, T v⟫ = μ * ‖v‖ ^ 2, { exact_mod_cast congr_arg is_R_or_C.re (inner_product_apply_eigenvector hv.1) }, exact (zero_le_mul_right hpos).mp (this ▸ hnn v), end @@ -269,8 +288,8 @@ lemma eigenvalue_pos_of_pos {μ : ℝ} {T : E →ₗ[𝕜] E} (hμ : has_eigenva (hnn : ∀ (x : E), 0 < is_R_or_C.re ⟪x, T x⟫) : 0 < μ := begin obtain ⟨v, hv⟩ := hμ.exists_has_eigenvector, - have hpos : 0 < ∥v∥ ^ 2, by simpa only [sq_pos_iff, norm_ne_zero_iff] using hv.2, - have : is_R_or_C.re ⟪v, T v⟫ = μ * ∥v∥ ^ 2, + have hpos : 0 < ‖v‖ ^ 2, by simpa only [sq_pos_iff, norm_ne_zero_iff] using hv.2, + have : is_R_or_C.re ⟪v, T v⟫ = μ * ‖v‖ ^ 2, { exact_mod_cast congr_arg is_R_or_C.re (inner_product_apply_eigenvector hv.1) }, exact (zero_lt_mul_right hpos).mp (this ▸ hnn v), end diff --git a/src/analysis/inner_product_space/symmetric.lean b/src/analysis/inner_product_space/symmetric.lean new file mode 100644 index 0000000000000..19ad96eb1dc37 --- /dev/null +++ b/src/analysis/inner_product_space/symmetric.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2022 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll, Frédéric Dupuis, Heather Macbeth +-/ +import analysis.inner_product_space.basic +import analysis.normed_space.banach +import linear_algebra.sesquilinear_form + +/-! +# Symmetric linear maps in an inner product space + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines and proves basic theorems about symmetric **not necessarily bounded** operators +on an inner product space, i.e linear maps `T : E → E` such that `∀ x y, ⟪T x, y⟫ = ⟪x, T y⟫`. + +In comparison to `is_self_adjoint`, this definition works for non-continuous linear maps, and +doesn't rely on the definition of the adjoint, which allows it to be stated in non-complete space. + +## Main definitions + +* `linear_map.is_symmetric`: a (not necessarily bounded) operator on an inner product space is +symmetric, if for all `x`, `y`, we have `⟪T x, y⟫ = ⟪x, T y⟫` + +## Main statements + +* `is_symmetric.continuous`: if a symmetric operator is defined on a complete space, then + it is automatically continuous. + +## Tags + +self-adjoint, symmetric +-/ + +open is_R_or_C +open_locale complex_conjugate + +variables {𝕜 E E' F G : Type*} [is_R_or_C 𝕜] +variables [normed_add_comm_group E] [inner_product_space 𝕜 E] +variables [normed_add_comm_group F] [inner_product_space 𝕜 F] +variables [normed_add_comm_group G] [inner_product_space 𝕜 G] +variables [normed_add_comm_group E'] [inner_product_space ℝ E'] +local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y + +namespace linear_map + +/-! ### Symmetric operators -/ + +/-- A (not necessarily bounded) operator on an inner product space is symmetric, if for all +`x`, `y`, we have `⟪T x, y⟫ = ⟪x, T y⟫`. -/ +def is_symmetric (T : E →ₗ[𝕜] E) : Prop := ∀ x y, ⟪T x, y⟫ = ⟪x, T y⟫ + +section real + +variables + +/-- An operator `T` on an inner product space is symmetric if and only if it is +`linear_map.is_self_adjoint` with respect to the sesquilinear form given by the inner product. -/ +lemma is_symmetric_iff_sesq_form (T : E →ₗ[𝕜] E) : + T.is_symmetric ↔ + @linear_map.is_self_adjoint 𝕜 E _ _ _ (star_ring_end 𝕜) sesq_form_of_inner T := +⟨λ h x y, (h y x).symm, λ h x y, (h y x).symm⟩ + +end real + +lemma is_symmetric.conj_inner_sym {T : E →ₗ[𝕜] E} (hT : is_symmetric T) (x y : E) : + conj ⟪T x, y⟫ = ⟪T y, x⟫ := +by rw [hT x y, inner_conj_symm] + +@[simp] lemma is_symmetric.apply_clm {T : E →L[𝕜] E} (hT : is_symmetric (T : E →ₗ[𝕜] E)) + (x y : E) : ⟪T x, y⟫ = ⟪x, T y⟫ := +hT x y + +lemma is_symmetric_zero : (0 : E →ₗ[𝕜] E).is_symmetric := +λ x y, (inner_zero_right x : ⟪x, 0⟫ = 0).symm ▸ (inner_zero_left y : ⟪0, y⟫ = 0) + +lemma is_symmetric_id : (linear_map.id : E →ₗ[𝕜] E).is_symmetric := +λ x y, rfl + +lemma is_symmetric.add {T S : E →ₗ[𝕜] E} (hT : T.is_symmetric) (hS : S.is_symmetric) : + (T + S).is_symmetric := +begin + intros x y, + rw [linear_map.add_apply, inner_add_left, hT x y, hS x y, ← inner_add_right], + refl +end + +/-- The **Hellinger--Toeplitz theorem**: if a symmetric operator is defined on a complete space, + then it is automatically continuous. -/ +lemma is_symmetric.continuous [complete_space E] {T : E →ₗ[𝕜] E} (hT : is_symmetric T) : + continuous T := +begin + -- We prove it by using the closed graph theorem + refine T.continuous_of_seq_closed_graph (λ u x y hu hTu, _), + rw [←sub_eq_zero, ←@inner_self_eq_zero 𝕜], + have hlhs : ∀ k : ℕ, ⟪T (u k) - T x, y - T x⟫ = ⟪u k - x, T (y - T x)⟫ := + by { intro k, rw [←T.map_sub, hT] }, + refine tendsto_nhds_unique ((hTu.sub_const _).inner tendsto_const_nhds) _, + simp_rw hlhs, + rw ←inner_zero_left (T (y - T x)), + refine filter.tendsto.inner _ tendsto_const_nhds, + rw ←sub_self x, + exact hu.sub_const _, +end + +/-- For a symmetric operator `T`, the function `λ x, ⟪T x, x⟫` is real-valued. -/ +@[simp] lemma is_symmetric.coe_re_apply_inner_self_apply + {T : E →L[𝕜] E} (hT : is_symmetric (T : E →ₗ[𝕜] E)) (x : E) : + (T.re_apply_inner_self x : 𝕜) = ⟪T x, x⟫ := +begin + rsuffices ⟨r, hr⟩ : ∃ r : ℝ, ⟪T x, x⟫ = r, + { simp [hr, T.re_apply_inner_self_apply] }, + rw ← conj_eq_iff_real, + exact hT.conj_inner_sym x x +end + +/-- If a symmetric operator preserves a submodule, its restriction to that submodule is +symmetric. -/ +lemma is_symmetric.restrict_invariant {T : E →ₗ[𝕜] E} (hT : is_symmetric T) + {V : submodule 𝕜 E} (hV : ∀ v ∈ V, T v ∈ V) : + is_symmetric (T.restrict hV) := +λ v w, hT v w + +lemma is_symmetric.restrict_scalars {T : E →ₗ[𝕜] E} (hT : T.is_symmetric) : + @linear_map.is_symmetric ℝ E _ _ (inner_product_space.is_R_or_C_to_real 𝕜 E) + (@linear_map.restrict_scalars ℝ 𝕜 _ _ _ _ _ _ + (inner_product_space.is_R_or_C_to_real 𝕜 E).to_module + (inner_product_space.is_R_or_C_to_real 𝕜 E).to_module _ _ _ T) := +λ x y, by simp [hT x y, real_inner_eq_re_inner, linear_map.coe_restrict_scalars_eq_coe] + +section complex + +variables {V : Type*} + [normed_add_comm_group V] [inner_product_space ℂ V] + +/-- A linear operator on a complex inner product space is symmetric precisely when +`⟪T v, v⟫_ℂ` is real for all v.-/ +lemma is_symmetric_iff_inner_map_self_real (T : V →ₗ[ℂ] V): + is_symmetric T ↔ ∀ (v : V), conj ⟪T v, v⟫_ℂ = ⟪T v, v⟫_ℂ := +begin + split, + { intros hT v, + apply is_symmetric.conj_inner_sym hT }, + { intros h x y, + nth_rewrite 1 ← inner_conj_symm, + nth_rewrite 1 inner_map_polarization, + simp only [star_ring_end_apply, star_div', star_sub, star_add, star_mul], + simp only [← star_ring_end_apply], + rw [h (x + y), h (x - y), h (x + complex.I • y), h (x - complex.I • y)], + simp only [complex.conj_I], + rw inner_map_polarization', + norm_num, + ring }, +end + +end complex + +/-- Polarization identity for symmetric linear maps. +See `inner_map_polarization` for the complex version without the symmetric assumption. -/ +lemma is_symmetric.inner_map_polarization {T : E →ₗ[𝕜] E} (hT : T.is_symmetric) (x y : E) : + ⟪T x, y⟫ = (⟪T (x + y), x + y⟫ - ⟪T (x - y), x - y⟫ - + I * ⟪T (x + (I : 𝕜) • y), x + (I : 𝕜) • y⟫ + + I * ⟪T (x - (I : 𝕜) • y), x - (I : 𝕜) • y⟫) / 4 := +begin + rcases @I_mul_I_ax 𝕜 _ with (h | h), + { simp_rw [h, zero_mul, sub_zero, add_zero, map_add, map_sub, inner_add_left, + inner_add_right, inner_sub_left, inner_sub_right, hT x, ← inner_conj_symm x (T y)], + suffices : (re ⟪T y, x⟫ : 𝕜) = ⟪T y, x⟫, + { rw conj_eq_iff_re.mpr this, + ring, }, + { rw ← re_add_im ⟪T y, x⟫, + simp_rw [h, mul_zero, add_zero], + norm_cast, } }, + { simp_rw [map_add, map_sub, inner_add_left, inner_add_right, inner_sub_left, inner_sub_right, + linear_map.map_smul, inner_smul_left, inner_smul_right, is_R_or_C.conj_I, mul_add, + mul_sub, sub_sub, ← mul_assoc, mul_neg, h, neg_neg, one_mul, neg_one_mul], + ring, }, +end + +/-- A symmetric linear map `T` is zero if and only if `⟪T x, x⟫_ℝ = 0` for all `x`. +See `inner_map_self_eq_zero` for the complex version without the symmetric assumption. -/ +lemma is_symmetric.inner_map_self_eq_zero {T : E →ₗ[𝕜] E} (hT : T.is_symmetric) : + (∀ x, ⟪T x, x⟫ = 0) ↔ T = 0 := +begin + simp_rw [linear_map.ext_iff, zero_apply], + refine ⟨λ h x, _, λ h, by simp_rw [h, inner_zero_left, forall_const]⟩, + rw [← @inner_self_eq_zero 𝕜, hT.inner_map_polarization], + simp_rw [h _], + ring, +end + +end linear_map diff --git a/src/analysis/inner_product_space/two_dim.lean b/src/analysis/inner_product_space/two_dim.lean new file mode 100644 index 0000000000000..f353988543fa0 --- /dev/null +++ b/src/analysis/inner_product_space/two_dim.lean @@ -0,0 +1,652 @@ +/- +Copyright (c) 2022 Heather Macbeth. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Heather Macbeth +-/ +import analysis.inner_product_space.dual +import analysis.inner_product_space.orientation +import data.complex.orientation +import tactic.linear_combination + +/-! +# Oriented two-dimensional real inner product spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines constructions specific to the geometry of an oriented two-dimensional real inner +product space `E`. + +## Main declarations + +* `orientation.area_form`: an antisymmetric bilinear form `E →ₗ[ℝ] E →ₗ[ℝ] ℝ` (usual notation `ω`). + Morally, when `ω` is evaluated on two vectors, it gives the oriented area of the parallelogram + they span. (But mathlib does not yet have a construction of oriented area, and in fact the + construction of oriented area should pass through `ω`.) + +* `orientation.right_angle_rotation`: an isometric automorphism `E ≃ₗᵢ[ℝ] E` (usual notation `J`). + This automorphism squares to -1. In a later file, rotations (`orientation.rotation`) are defined, + in such a way that this automorphism is equal to rotation by 90 degrees. + +* `orientation.basis_right_angle_rotation`: for a nonzero vector `x` in `E`, the basis `![x, J x]` + for `E`. + +* `orientation.kahler`: a complex-valued real-bilinear map `E →ₗ[ℝ] E →ₗ[ℝ] ℂ`. Its real part is the + inner product and its imaginary part is `orientation.area_form`. For vectors `x` and `y` in `E`, + the complex number `o.kahler x y` has modulus `‖x‖ * ‖y‖`. In a later file, oriented angles + (`orientation.oangle`) are defined, in such a way that the argument of `o.kahler x y` is the + oriented angle from `x` to `y`. + +## Main results + +* `orientation.right_angle_rotation_right_angle_rotation`: the identity `J (J x) = - x` + +* `orientation.nonneg_inner_and_area_form_eq_zero_iff_same_ray`: `x`, `y` are in the same ray, if + and only if `0 ≤ ⟪x, y⟫` and `ω x y = 0` + +* `orientation.kahler_mul`: the identity `o.kahler x a * o.kahler a y = ‖a‖ ^ 2 * o.kahler x y` + +* `complex.area_form`, `complex.right_angle_rotation`, `complex.kahler`: the concrete + interpretations of `area_form`, `right_angle_rotation`, `kahler` for the oriented real inner + product space `ℂ` + +* `orientation.area_form_map_complex`, `orientation.right_angle_rotation_map_complex`, + `orientation.kahler_map_complex`: given an orientation-preserving isometry from `E` to `ℂ`, + expressions for `area_form`, `right_angle_rotation`, `kahler` as the pullback of their concrete + interpretations on `ℂ` + +## Implementation notes + +Notation `ω` for `orientation.area_form` and `J` for `orientation.right_angle_rotation` should be +defined locally in each file which uses them, since otherwise one would need a more cumbersome +notation which mentions the orientation explicitly (something like `ω[o]`). Write + +``` +local notation `ω` := o.area_form +local notation `J` := o.right_angle_rotation +``` + +-/ + +noncomputable theory + +open_locale real_inner_product_space complex_conjugate +open finite_dimensional + +local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ + +variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E] [fact (finrank ℝ E = 2)] + (o : orientation ℝ E (fin 2)) + +namespace orientation + +include o + +/-- An antisymmetric bilinear form on an oriented real inner product space of dimension 2 (usual +notation `ω`). When evaluated on two vectors, it gives the oriented area of the parallelogram they +span. -/ +@[irreducible] def area_form : E →ₗ[ℝ] E →ₗ[ℝ] ℝ := +begin + let z : alternating_map ℝ E ℝ (fin 0) ≃ₗ[ℝ] ℝ := + alternating_map.const_linear_equiv_of_is_empty.symm, + let y : alternating_map ℝ E ℝ (fin 1) →ₗ[ℝ] E →ₗ[ℝ] ℝ := + (linear_map.llcomp ℝ E (alternating_map ℝ E ℝ (fin 0)) ℝ z) ∘ₗ + alternating_map.curry_left_linear_map, + exact y ∘ₗ (alternating_map.curry_left_linear_map o.volume_form), +end + +omit o + +local notation `ω` := o.area_form + +lemma area_form_to_volume_form (x y : E) : ω x y = o.volume_form ![x, y] := by simp [area_form] + +@[simp] lemma area_form_apply_self (x : E) : ω x x = 0 := +begin + rw area_form_to_volume_form, + refine o.volume_form.map_eq_zero_of_eq ![x, x] _ (_ : (0 : fin 2) ≠ 1), + { simp }, + { norm_num } +end + +lemma area_form_swap (x y : E) : ω x y = - ω y x := +begin + simp only [area_form_to_volume_form], + convert o.volume_form.map_swap ![y, x] (_ : (0 : fin 2) ≠ 1), + { ext i, + fin_cases i; refl }, + { norm_num } +end + +@[simp] lemma area_form_neg_orientation : (-o).area_form = -o.area_form := +begin + ext x y, + simp [area_form_to_volume_form] +end + +/-- Continuous linear map version of `orientation.area_form`, useful for calculus. -/ +def area_form' : E →L[ℝ] (E →L[ℝ] ℝ) := +((↑(linear_map.to_continuous_linear_map : (E →ₗ[ℝ] ℝ) ≃ₗ[ℝ] (E →L[ℝ] ℝ))) + ∘ₗ o.area_form).to_continuous_linear_map + +@[simp] lemma area_form'_apply (x : E) : + o.area_form' x = (o.area_form x).to_continuous_linear_map := +rfl + +lemma abs_area_form_le (x y : E) : |ω x y| ≤ ‖x‖ * ‖y‖ := +by simpa [area_form_to_volume_form, fin.prod_univ_succ] using o.abs_volume_form_apply_le ![x, y] + +lemma area_form_le (x y : E) : ω x y ≤ ‖x‖ * ‖y‖ := +by simpa [area_form_to_volume_form, fin.prod_univ_succ] using o.volume_form_apply_le ![x, y] + +lemma abs_area_form_of_orthogonal {x y : E} (h : ⟪x, y⟫ = 0) : |ω x y| = ‖x‖ * ‖y‖ := +begin + rw [o.area_form_to_volume_form, o.abs_volume_form_apply_of_pairwise_orthogonal], + { simp [fin.prod_univ_succ] }, + intros i j hij, + fin_cases i; fin_cases j, + { simpa }, + { simpa using h }, + { simpa [real_inner_comm] using h }, + { simpa } +end + +lemma area_form_map {F : Type*} + [normed_add_comm_group F] [inner_product_space ℝ F] [fact (finrank ℝ F = 2)] + (φ : E ≃ₗᵢ[ℝ] F) (x y : F) : + (orientation.map (fin 2) φ.to_linear_equiv o).area_form x y = o.area_form (φ.symm x) (φ.symm y) := +begin + have : φ.symm ∘ ![x, y] = ![φ.symm x, φ.symm y], + { ext i, + fin_cases i; refl }, + simp [area_form_to_volume_form, volume_form_map, this], +end + +/-- The area form is invariant under pullback by a positively-oriented isometric automorphism. -/ +lemma area_form_comp_linear_isometry_equiv (φ : E ≃ₗᵢ[ℝ] E) + (hφ : 0 < (φ.to_linear_equiv : E →ₗ[ℝ] E).det) (x y : E) : + o.area_form (φ x) (φ y) = o.area_form x y := +begin + convert o.area_form_map φ (φ x) (φ y), + { symmetry, + rwa ← o.map_eq_iff_det_pos φ.to_linear_equiv at hφ, + rw [fact.out (finrank ℝ E = 2), fintype.card_fin] }, + { simp }, + { simp } +end + +/-- Auxiliary construction for `orientation.right_angle_rotation`, rotation by 90 degrees in an +oriented real inner product space of dimension 2. -/ +@[irreducible] def right_angle_rotation_aux₁ : E →ₗ[ℝ] E := +let to_dual : E ≃ₗ[ℝ] (E →ₗ[ℝ] ℝ) := + (inner_product_space.to_dual ℝ E).to_linear_equiv ≪≫ₗ linear_map.to_continuous_linear_map.symm in +↑to_dual.symm ∘ₗ ω + +@[simp] lemma inner_right_angle_rotation_aux₁_left (x y : E) : + ⟪o.right_angle_rotation_aux₁ x, y⟫ = ω x y := +by simp only [right_angle_rotation_aux₁, linear_equiv.trans_symm, linear_equiv.coe_trans, + linear_equiv.coe_coe, inner_product_space.to_dual_symm_apply, eq_self_iff_true, + linear_map.coe_to_continuous_linear_map', linear_isometry_equiv.coe_to_linear_equiv, + linear_map.comp_apply, linear_equiv.symm_symm, + linear_isometry_equiv.to_linear_equiv_symm] + +@[simp] lemma inner_right_angle_rotation_aux₁_right (x y : E) : + ⟪x, o.right_angle_rotation_aux₁ y⟫ = - ω x y := +begin + rw real_inner_comm, + simp [o.area_form_swap y x], +end + +/-- Auxiliary construction for `orientation.right_angle_rotation`, rotation by 90 degrees in an +oriented real inner product space of dimension 2. -/ +def right_angle_rotation_aux₂ : E →ₗᵢ[ℝ] E := +{ norm_map' := λ x, begin + dsimp, + refine le_antisymm _ _, + { cases eq_or_lt_of_le (norm_nonneg (o.right_angle_rotation_aux₁ x)) with h h, + { rw ← h, + positivity }, + refine le_of_mul_le_mul_right _ h, + rw [← real_inner_self_eq_norm_mul_norm, o.inner_right_angle_rotation_aux₁_left], + exact o.area_form_le x (o.right_angle_rotation_aux₁ x) }, + { let K : submodule ℝ E := ℝ ∙ x, + haveI : nontrivial Kᗮ, + { apply @finite_dimensional.nontrivial_of_finrank_pos ℝ, + have : finrank ℝ K ≤ finset.card {x}, + { rw ← set.to_finset_singleton, + exact finrank_span_le_card ({x} : set E) }, + have : finset.card {x} = 1 := finset.card_singleton x, + have : finrank ℝ K + finrank ℝ Kᗮ = finrank ℝ E := K.finrank_add_finrank_orthogonal, + have : finrank ℝ E = 2 := fact.out _, + linarith }, + obtain ⟨w, hw₀⟩ : ∃ w : Kᗮ, w ≠ 0 := exists_ne 0, + have hw' : ⟪x, (w:E)⟫ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2, + have hw : (w:E) ≠ 0 := λ h, hw₀ (submodule.coe_eq_zero.mp h), + refine le_of_mul_le_mul_right _ (by rwa norm_pos_iff : 0 < ‖(w:E)‖), + rw ← o.abs_area_form_of_orthogonal hw', + rw ← o.inner_right_angle_rotation_aux₁_left x w, + exact abs_real_inner_le_norm (o.right_angle_rotation_aux₁ x) w }, + end, + .. o.right_angle_rotation_aux₁ } + +@[simp] lemma right_angle_rotation_aux₁_right_angle_rotation_aux₁ (x : E) : + o.right_angle_rotation_aux₁ (o.right_angle_rotation_aux₁ x) = - x := +begin + apply ext_inner_left ℝ, + intros y, + have : ⟪o.right_angle_rotation_aux₁ y, o.right_angle_rotation_aux₁ x⟫ = ⟪y, x⟫ := + linear_isometry.inner_map_map o.right_angle_rotation_aux₂ y x, + rw [o.inner_right_angle_rotation_aux₁_right, ← o.inner_right_angle_rotation_aux₁_left, this, + inner_neg_right], +end + +/-- An isometric automorphism of an oriented real inner product space of dimension 2 (usual notation +`J`). This automorphism squares to -1. We will define rotations in such a way that this +automorphism is equal to rotation by 90 degrees. -/ +@[irreducible] def right_angle_rotation : E ≃ₗᵢ[ℝ] E := +linear_isometry_equiv.of_linear_isometry + o.right_angle_rotation_aux₂ + (-o.right_angle_rotation_aux₁) + (by ext; simp [right_angle_rotation_aux₂]) + (by ext; simp [right_angle_rotation_aux₂]) + +local notation `J` := o.right_angle_rotation + +@[simp] lemma inner_right_angle_rotation_left (x y : E) : ⟪J x, y⟫ = ω x y := +begin + rw right_angle_rotation, + exact o.inner_right_angle_rotation_aux₁_left x y +end + +@[simp] lemma inner_right_angle_rotation_right (x y : E) : ⟪x, J y⟫ = - ω x y := +begin + rw right_angle_rotation, + exact o.inner_right_angle_rotation_aux₁_right x y +end + +@[simp] lemma right_angle_rotation_right_angle_rotation (x : E) : J (J x) = - x := +begin + rw right_angle_rotation, + exact o.right_angle_rotation_aux₁_right_angle_rotation_aux₁ x +end + +@[simp] lemma right_angle_rotation_symm : + linear_isometry_equiv.symm J = linear_isometry_equiv.trans J (linear_isometry_equiv.neg ℝ) := +begin + rw right_angle_rotation, + exact linear_isometry_equiv.to_linear_isometry_injective rfl +end + +@[simp] lemma inner_right_angle_rotation_self (x : E) : ⟪J x, x⟫ = 0 := by simp + +lemma inner_right_angle_rotation_swap (x y : E) : ⟪x, J y⟫ = - ⟪J x, y⟫ := by simp + +lemma inner_right_angle_rotation_swap' (x y : E) : ⟪J x, y⟫ = - ⟪x, J y⟫ := +by simp [o.inner_right_angle_rotation_swap x y] + +lemma inner_comp_right_angle_rotation (x y : E) : ⟪J x, J y⟫ = ⟪x, y⟫ := +linear_isometry_equiv.inner_map_map J x y + +@[simp] lemma area_form_right_angle_rotation_left (x y : E) : ω (J x) y = - ⟪x, y⟫ := +by rw [← o.inner_comp_right_angle_rotation, o.inner_right_angle_rotation_right, neg_neg] + +@[simp] lemma area_form_right_angle_rotation_right (x y : E) : ω x (J y) = ⟪x, y⟫ := +by rw [← o.inner_right_angle_rotation_left, o.inner_comp_right_angle_rotation] + +@[simp] lemma area_form_comp_right_angle_rotation (x y : E) : ω (J x) (J y) = ω x y := +by simp + +@[simp] lemma right_angle_rotation_trans_right_angle_rotation : + linear_isometry_equiv.trans J J = linear_isometry_equiv.neg ℝ := +by ext; simp + +lemma right_angle_rotation_neg_orientation (x : E) : + (-o).right_angle_rotation x = - o.right_angle_rotation x := +begin + apply ext_inner_right ℝ, + intros y, + rw inner_right_angle_rotation_left, + simp +end + +@[simp] lemma right_angle_rotation_trans_neg_orientation : + (-o).right_angle_rotation = o.right_angle_rotation.trans (linear_isometry_equiv.neg ℝ) := +linear_isometry_equiv.ext $ o.right_angle_rotation_neg_orientation + +lemma right_angle_rotation_map {F : Type*} + [normed_add_comm_group F] [inner_product_space ℝ F] [fact (finrank ℝ F = 2)] + (φ : E ≃ₗᵢ[ℝ] F) (x : F) : + (orientation.map (fin 2) φ.to_linear_equiv o).right_angle_rotation x + = φ (o.right_angle_rotation (φ.symm x)) := +begin + apply ext_inner_right ℝ, + intros y, + rw inner_right_angle_rotation_left, + transitivity ⟪J (φ.symm x), φ.symm y⟫, + { simp [o.area_form_map] }, + transitivity ⟪φ (J (φ.symm x)), φ (φ.symm y)⟫, + { rw φ.inner_map_map }, + { simp }, +end + +/-- `J` commutes with any positively-oriented isometric automorphism. -/ +lemma linear_isometry_equiv_comp_right_angle_rotation (φ : E ≃ₗᵢ[ℝ] E) + (hφ : 0 < (φ.to_linear_equiv : E →ₗ[ℝ] E).det) (x : E) : + φ (J x) = J (φ x) := +begin + convert (o.right_angle_rotation_map φ (φ x)).symm, + { simp }, + { symmetry, + rwa ← o.map_eq_iff_det_pos φ.to_linear_equiv at hφ, + rw [fact.out (finrank ℝ E = 2), fintype.card_fin] }, +end + +lemma right_angle_rotation_map' {F : Type*} + [normed_add_comm_group F] [inner_product_space ℝ F] [fact (finrank ℝ F = 2)] + (φ : E ≃ₗᵢ[ℝ] F) : + (orientation.map (fin 2) φ.to_linear_equiv o).right_angle_rotation + = (φ.symm.trans o.right_angle_rotation).trans φ := +linear_isometry_equiv.ext $ o.right_angle_rotation_map φ + +/-- `J` commutes with any positively-oriented isometric automorphism. -/ +lemma linear_isometry_equiv_comp_right_angle_rotation' (φ : E ≃ₗᵢ[ℝ] E) + (hφ : 0 < (φ.to_linear_equiv : E →ₗ[ℝ] E).det) : + linear_isometry_equiv.trans J φ = φ.trans J := +linear_isometry_equiv.ext $ o.linear_isometry_equiv_comp_right_angle_rotation φ hφ + +/-- For a nonzero vector `x` in an oriented two-dimensional real inner product space `E`, +`![x, J x]` forms an (orthogonal) basis for `E`. -/ +def basis_right_angle_rotation (x : E) (hx : x ≠ 0) : basis (fin 2) ℝ E := +@basis_of_linear_independent_of_card_eq_finrank ℝ _ _ _ _ _ _ _ ![x, J x] +(linear_independent_of_ne_zero_of_inner_eq_zero (λ i, by { fin_cases i; simp [hx] }) + begin + intros i j hij, + fin_cases i; fin_cases j, + { simpa }, + { simp }, + { simp }, + { simpa } + end) +(fact.out (finrank ℝ E = 2)).symm + +@[simp] lemma coe_basis_right_angle_rotation (x : E) (hx : x ≠ 0) : + ⇑(o.basis_right_angle_rotation x hx) = ![x, J x] := +coe_basis_of_linear_independent_of_card_eq_finrank _ _ + +/-- For vectors `a x y : E`, the identity `⟪a, x⟫ * ⟪a, y⟫ + ω a x * ω a y = ‖a‖ ^ 2 * ⟪x, y⟫`. (See +`orientation.inner_mul_inner_add_area_form_mul_area_form` for the "applied" form.)-/ +lemma inner_mul_inner_add_area_form_mul_area_form' (a x : E) : + ⟪a, x⟫ • innerₛₗ ℝ a + ω a x • ω a = ‖a‖ ^ 2 • innerₛₗ ℝ x := +begin + by_cases ha : a = 0, + { simp [ha] }, + apply (o.basis_right_angle_rotation a ha).ext, + intros i, + fin_cases i, + { simp only [real_inner_self_eq_norm_sq, algebra.id.smul_eq_mul, innerₛₗ_apply, + linear_map.smul_apply, linear_map.add_apply, matrix.cons_val_zero, + o.coe_basis_right_angle_rotation, o.area_form_apply_self, real_inner_comm], + ring }, + { simp only [real_inner_self_eq_norm_sq, algebra.id.smul_eq_mul, innerₛₗ_apply, + linear_map.smul_apply, neg_inj, linear_map.add_apply, matrix.cons_val_one, matrix.head_cons, + o.coe_basis_right_angle_rotation, o.area_form_right_angle_rotation_right, + o.area_form_apply_self, o.inner_right_angle_rotation_right], + rw o.area_form_swap, + ring, } +end + +/-- For vectors `a x y : E`, the identity `⟪a, x⟫ * ⟪a, y⟫ + ω a x * ω a y = ‖a‖ ^ 2 * ⟪x, y⟫`. -/ +lemma inner_mul_inner_add_area_form_mul_area_form (a x y : E) : + ⟪a, x⟫ * ⟪a, y⟫ + ω a x * ω a y = ‖a‖ ^ 2 * ⟪x, y⟫ := +congr_arg (λ f : E →ₗ[ℝ] ℝ, f y) (o.inner_mul_inner_add_area_form_mul_area_form' a x) + +lemma inner_sq_add_area_form_sq (a b : E) : ⟪a, b⟫ ^ 2 + ω a b ^ 2 = ‖a‖ ^ 2 * ‖b‖ ^ 2 := +by simpa [sq, real_inner_self_eq_norm_sq] using o.inner_mul_inner_add_area_form_mul_area_form a b b + +/-- For vectors `a x y : E`, the identity `⟪a, x⟫ * ω a y - ω a x * ⟪a, y⟫ = ‖a‖ ^ 2 * ω x y`. (See +`orientation.inner_mul_area_form_sub` for the "applied" form.) -/ +lemma inner_mul_area_form_sub' (a x : E) : + ⟪a, x⟫ • ω a - ω a x • innerₛₗ ℝ a = ‖a‖ ^ 2 • ω x := +begin + by_cases ha : a = 0, + { simp [ha] }, + apply (o.basis_right_angle_rotation a ha).ext, + intros i, + fin_cases i, + { simp only [o.coe_basis_right_angle_rotation, o.area_form_apply_self, o.area_form_swap a x, + real_inner_self_eq_norm_sq, algebra.id.smul_eq_mul, innerₛₗ_apply, linear_map.sub_apply, + linear_map.smul_apply, matrix.cons_val_zero], + ring }, + { simp only [o.area_form_right_angle_rotation_right, o.area_form_apply_self, + o.coe_basis_right_angle_rotation, o.inner_right_angle_rotation_right, + real_inner_self_eq_norm_sq, real_inner_comm, algebra.id.smul_eq_mul, innerₛₗ_apply, + linear_map.smul_apply, linear_map.sub_apply, matrix.cons_val_one, matrix.head_cons], + ring}, +end + +/-- For vectors `a x y : E`, the identity `⟪a, x⟫ * ω a y - ω a x * ⟪a, y⟫ = ‖a‖ ^ 2 * ω x y`. -/ +lemma inner_mul_area_form_sub (a x y : E) : ⟪a, x⟫ * ω a y - ω a x * ⟪a, y⟫ = ‖a‖ ^ 2 * ω x y := +congr_arg (λ f : E →ₗ[ℝ] ℝ, f y) (o.inner_mul_area_form_sub' a x) + +lemma nonneg_inner_and_area_form_eq_zero_iff_same_ray (x y : E) : + 0 ≤ ⟪x, y⟫ ∧ ω x y = 0 ↔ same_ray ℝ x y := +begin + by_cases hx : x = 0, + { simp [hx] }, + split, + { let a : ℝ := (o.basis_right_angle_rotation x hx).repr y 0, + let b : ℝ := (o.basis_right_angle_rotation x hx).repr y 1, + suffices : 0 ≤ a * ‖x‖ ^ 2 ∧ b * ‖x‖ ^ 2 = 0 → same_ray ℝ x (a • x + b • J x), + { rw ← (o.basis_right_angle_rotation x hx).sum_repr y, + simp only [fin.sum_univ_succ, coe_basis_right_angle_rotation, matrix.cons_val_zero, + fin.succ_zero_eq_one', fintype.univ_of_is_empty, finset.sum_empty, o.area_form_apply_self, + map_smul, map_add, map_zero, inner_smul_left, inner_smul_right, inner_add_left, + inner_add_right, inner_zero_right, linear_map.add_apply, matrix.cons_val_one, + matrix.head_cons, algebra.id.smul_eq_mul, o.area_form_right_angle_rotation_right, mul_zero, + add_zero, zero_add, neg_zero, o.inner_right_angle_rotation_right, o.area_form_apply_self, + real_inner_self_eq_norm_sq], + exact this }, + rintros ⟨ha, hb⟩, + have hx' : 0 < ‖x‖ := by simpa using hx, + have ha' : 0 ≤ a := nonneg_of_mul_nonneg_left ha (by positivity), + have hb' : b = 0 := eq_zero_of_ne_zero_of_mul_right_eq_zero (pow_ne_zero 2 hx'.ne') hb, + simpa [hb'] using same_ray_nonneg_smul_right x ha' }, + { intros h, + obtain ⟨r, hr, rfl⟩ := h.exists_nonneg_left hx, + simp only [inner_smul_right, real_inner_self_eq_norm_sq, linear_map.map_smulₛₗ, + area_form_apply_self, algebra.id.smul_eq_mul, mul_zero, eq_self_iff_true, and_true], + positivity }, +end + +/-- A complex-valued real-bilinear map on an oriented real inner product space of dimension 2. Its +real part is the inner product and its imaginary part is `orientation.area_form`. + +On `ℂ` with the standard orientation, `kahler w z = conj w * z`; see `complex.kahler`. -/ +def kahler : E →ₗ[ℝ] E →ₗ[ℝ] ℂ := +(linear_map.llcomp ℝ E ℝ ℂ complex.of_real_clm) ∘ₗ innerₛₗ ℝ ++ (linear_map.llcomp ℝ E ℝ ℂ ((linear_map.lsmul ℝ ℂ).flip complex.I)) ∘ₗ ω + +lemma kahler_apply_apply (x y : E) : o.kahler x y = ⟪x, y⟫ + ω x y • complex.I := rfl + +lemma kahler_swap (x y : E) : o.kahler x y = conj (o.kahler y x) := +begin + simp only [kahler_apply_apply], + rw [real_inner_comm, area_form_swap], + simp, +end + +@[simp] lemma kahler_apply_self (x : E) : o.kahler x x = ‖x‖ ^ 2 := +by simp [kahler_apply_apply, real_inner_self_eq_norm_sq] + +@[simp] lemma kahler_right_angle_rotation_left (x y : E) : + o.kahler (J x) y = - complex.I * o.kahler x y := +begin + simp only [o.area_form_right_angle_rotation_left, o.inner_right_angle_rotation_left, + o.kahler_apply_apply, complex.of_real_neg, complex.real_smul], + linear_combination ω x y * complex.I_sq, +end + +@[simp] lemma kahler_right_angle_rotation_right (x y : E) : + o.kahler x (J y) = complex.I * o.kahler x y := +begin + simp only [o.area_form_right_angle_rotation_right, o.inner_right_angle_rotation_right, + o.kahler_apply_apply, complex.of_real_neg, complex.real_smul], + linear_combination - ω x y * complex.I_sq, +end + +@[simp] lemma kahler_comp_right_angle_rotation (x y : E) : o.kahler (J x) (J y) = o.kahler x y := +begin + simp only [kahler_right_angle_rotation_left, kahler_right_angle_rotation_right], + linear_combination - o.kahler x y * complex.I_sq, +end + +@[simp] lemma kahler_neg_orientation (x y : E) : (-o).kahler x y = conj (o.kahler x y) := +by simp [kahler_apply_apply] + +lemma kahler_mul (a x y : E) : o.kahler x a * o.kahler a y = ‖a‖ ^ 2 * o.kahler x y := +begin + transitivity (↑(‖a‖ ^ 2) : ℂ) * o.kahler x y, + { ext, + { simp only [o.kahler_apply_apply, complex.add_im, complex.add_re, complex.I_im, complex.I_re, + complex.mul_im, complex.mul_re, complex.of_real_im, complex.of_real_re, complex.real_smul], + rw [real_inner_comm a x, o.area_form_swap x a], + linear_combination o.inner_mul_inner_add_area_form_mul_area_form a x y }, + { simp only [o.kahler_apply_apply, complex.add_im, complex.add_re, complex.I_im, complex.I_re, + complex.mul_im, complex.mul_re, complex.of_real_im, complex.of_real_re, complex.real_smul], + rw [real_inner_comm a x, o.area_form_swap x a], + linear_combination o.inner_mul_area_form_sub a x y } }, + { norm_cast }, +end + +lemma norm_sq_kahler (x y : E) : complex.norm_sq (o.kahler x y) = ‖x‖ ^ 2 * ‖y‖ ^ 2 := +by simpa [kahler_apply_apply, complex.norm_sq, sq] using o.inner_sq_add_area_form_sq x y + +lemma abs_kahler (x y : E) : complex.abs (o.kahler x y) = ‖x‖ * ‖y‖ := +begin + rw [← sq_eq_sq, complex.sq_abs], + { linear_combination o.norm_sq_kahler x y }, + { positivity }, + { positivity } +end + +lemma norm_kahler (x y : E) : ‖o.kahler x y‖ = ‖x‖ * ‖y‖ := by simpa using o.abs_kahler x y + +lemma eq_zero_or_eq_zero_of_kahler_eq_zero {x y : E} (hx : o.kahler x y = 0) : x = 0 ∨ y = 0 := +begin + have : ‖x‖ * ‖y‖ = 0 := by simpa [hx] using (o.norm_kahler x y).symm, + cases eq_zero_or_eq_zero_of_mul_eq_zero this with h h, + { left, + simpa using h }, + { right, + simpa using h }, +end + +lemma kahler_eq_zero_iff (x y : E) : o.kahler x y = 0 ↔ x = 0 ∨ y = 0 := +begin + refine ⟨o.eq_zero_or_eq_zero_of_kahler_eq_zero, _⟩, + rintros (rfl | rfl); + simp, +end + +lemma kahler_ne_zero {x y : E} (hx : x ≠ 0) (hy : y ≠ 0) : o.kahler x y ≠ 0 := +begin + apply mt o.eq_zero_or_eq_zero_of_kahler_eq_zero, + tauto, +end + +lemma kahler_ne_zero_iff (x y : E) : o.kahler x y ≠ 0 ↔ x ≠ 0 ∧ y ≠ 0 := +begin + refine ⟨_, λ h, o.kahler_ne_zero h.1 h.2⟩, + contrapose, + simp only [not_and_distrib, not_not, kahler_apply_apply, complex.real_smul], + rintros (rfl | rfl); + simp, +end + +lemma kahler_map {F : Type*} + [normed_add_comm_group F] [inner_product_space ℝ F] [fact (finrank ℝ F = 2)] + (φ : E ≃ₗᵢ[ℝ] F) (x y : F) : + (orientation.map (fin 2) φ.to_linear_equiv o).kahler x y = o.kahler (φ.symm x) (φ.symm y) := +by simp [kahler_apply_apply, area_form_map] + +/-- The bilinear map `kahler` is invariant under pullback by a positively-oriented isometric +automorphism. -/ +lemma kahler_comp_linear_isometry_equiv (φ : E ≃ₗᵢ[ℝ] E) + (hφ : 0 < (φ.to_linear_equiv : E →ₗ[ℝ] E).det) (x y : E) : + o.kahler (φ x) (φ y) = o.kahler x y := +by simp [kahler_apply_apply, o.area_form_comp_linear_isometry_equiv φ hφ] + +end orientation + +namespace complex + +local attribute [instance] complex.finrank_real_complex_fact + +@[simp] protected lemma area_form (w z : ℂ) : complex.orientation.area_form w z = (conj w * z).im := +begin + let o := complex.orientation, + simp only [o.area_form_to_volume_form, o.volume_form_robust complex.orthonormal_basis_one_I rfl, + basis.det_apply, matrix.det_fin_two, basis.to_matrix_apply,to_basis_orthonormal_basis_one_I, + matrix.cons_val_zero, coe_basis_one_I_repr, matrix.cons_val_one, matrix.head_cons, mul_im, + conj_re, conj_im], + ring, +end + +@[simp] protected lemma right_angle_rotation (z : ℂ) : + complex.orientation.right_angle_rotation z = I * z := +begin + apply ext_inner_right ℝ, + intros w, + rw orientation.inner_right_angle_rotation_left, + simp only [complex.area_form, complex.inner, mul_re, mul_im, conj_re, conj_im, map_mul, conj_I, + neg_re, neg_im, I_re, I_im], + ring, +end + +@[simp] protected lemma kahler (w z : ℂ) : + complex.orientation.kahler w z = conj w * z := +begin + rw orientation.kahler_apply_apply, + ext1; simp, +end + +end complex + +namespace orientation + +local notation `ω` := o.area_form +local notation `J` := o.right_angle_rotation + +open complex + +/-- The area form on an oriented real inner product space of dimension 2 can be evaluated in terms +of a complex-number representation of the space. -/ +lemma area_form_map_complex (f : E ≃ₗᵢ[ℝ] ℂ) + (hf : (orientation.map (fin 2) f.to_linear_equiv o) = complex.orientation) (x y : E) : + ω x y = (conj (f x) * f y).im := +begin + rw [← complex.area_form, ← hf, o.area_form_map], + simp, +end + +/-- The rotation by 90 degrees on an oriented real inner product space of dimension 2 can be +evaluated in terms of a complex-number representation of the space. -/ +lemma right_angle_rotation_map_complex (f : E ≃ₗᵢ[ℝ] ℂ) + (hf : (orientation.map (fin 2) f.to_linear_equiv o) = complex.orientation) (x : E) : + f (J x) = I * f x := +begin + rw [← complex.right_angle_rotation, ← hf, o.right_angle_rotation_map], + simp, +end + +/-- The Kahler form on an oriented real inner product space of dimension 2 can be evaluated in terms +of a complex-number representation of the space. -/ +lemma kahler_map_complex (f : E ≃ₗᵢ[ℝ] ℂ) + (hf : (orientation.map (fin 2) f.to_linear_equiv o) = complex.orientation) (x y : E) : + o.kahler x y = conj (f x) * f y := +begin + rw [← complex.kahler, ← hf, o.kahler_map], + simp, +end + +end orientation diff --git a/src/analysis/locally_convex/abs_convex.lean b/src/analysis/locally_convex/abs_convex.lean new file mode 100644 index 0000000000000..b302e21cb2d3c --- /dev/null +++ b/src/analysis/locally_convex/abs_convex.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2022 Moritz Doll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll +-/ +import analysis.locally_convex.balanced_core_hull +import analysis.locally_convex.with_seminorms +import analysis.convex.gauge + +/-! +# Absolutely convex sets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A set is called absolutely convex or disked if it is convex and balanced. +The importance of absolutely convex sets comes from the fact that every locally convex +topological vector space has a basis consisting of absolutely convex sets. + +## Main definitions + +* `gauge_seminorm_family`: the seminorm family induced by all open absolutely convex neighborhoods +of zero. + +## Main statements + +* `with_gauge_seminorm_family`: the topology of a locally convex space is induced by the family +`gauge_seminorm_family`. + +## Todo + +* Define the disked hull + +## Tags + +disks, convex, balanced +-/ + + +open normed_field set +open_locale big_operators nnreal pointwise topology + +variables {𝕜 E F G ι : Type*} + +section nontrivially_normed_field + +variables (𝕜 E) {s : set E} + +variables [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables [module ℝ E] [smul_comm_class ℝ 𝕜 E] +variables [topological_space E] [locally_convex_space ℝ E] [has_continuous_smul 𝕜 E] + +lemma nhds_basis_abs_convex : (𝓝 (0 : E)).has_basis + (λ (s : set E), s ∈ 𝓝 (0 : E) ∧ balanced 𝕜 s ∧ convex ℝ s) id := +begin + refine (locally_convex_space.convex_basis_zero ℝ E).to_has_basis (λ s hs, _) + (λ s hs, ⟨s, ⟨hs.1, hs.2.2⟩, rfl.subset⟩), + refine ⟨convex_hull ℝ (balanced_core 𝕜 s), _, convex_hull_min (balanced_core_subset s) hs.2⟩, + refine ⟨filter.mem_of_superset (balanced_core_mem_nhds_zero hs.1) (subset_convex_hull ℝ _), _⟩, + refine ⟨balanced_convex_hull_of_balanced (balanced_core_balanced s), _⟩, + exact convex_convex_hull ℝ (balanced_core 𝕜 s), +end + +variables [has_continuous_smul ℝ E] [topological_add_group E] + +lemma nhds_basis_abs_convex_open : (𝓝 (0 : E)).has_basis + (λ (s : set E), (0 : E) ∈ s ∧ is_open s ∧ balanced 𝕜 s ∧ convex ℝ s) id := +begin + refine (nhds_basis_abs_convex 𝕜 E).to_has_basis _ _, + { rintros s ⟨hs_nhds, hs_balanced, hs_convex⟩, + refine ⟨interior s, _, interior_subset⟩, + exact ⟨mem_interior_iff_mem_nhds.mpr hs_nhds, is_open_interior, + hs_balanced.interior (mem_interior_iff_mem_nhds.mpr hs_nhds), hs_convex.interior⟩ }, + rintros s ⟨hs_zero, hs_open, hs_balanced, hs_convex⟩, + exact ⟨s, ⟨hs_open.mem_nhds hs_zero, hs_balanced, hs_convex⟩, rfl.subset⟩, +end + +end nontrivially_normed_field + +section absolutely_convex_sets + +variables [topological_space E] [add_comm_monoid E] [has_zero E] [semi_normed_ring 𝕜] +variables [has_smul 𝕜 E] [has_smul ℝ E] + +variables (𝕜 E) + +/-- The type of absolutely convex open sets. -/ +def abs_convex_open_sets := +{ s : set E // (0 : E) ∈ s ∧ is_open s ∧ balanced 𝕜 s ∧ convex ℝ s } + +instance abs_convex_open_sets.has_coe : has_coe (abs_convex_open_sets 𝕜 E) (set E) := ⟨subtype.val⟩ + +namespace abs_convex_open_sets + +variables {𝕜 E} + +lemma coe_zero_mem (s : abs_convex_open_sets 𝕜 E) : (0 : E) ∈ (s : set E) := s.2.1 + +lemma coe_is_open (s : abs_convex_open_sets 𝕜 E) : is_open (s : set E) := s.2.2.1 + +lemma coe_nhds (s : abs_convex_open_sets 𝕜 E) : (s : set E) ∈ 𝓝 (0 : E) := +s.coe_is_open.mem_nhds s.coe_zero_mem + +lemma coe_balanced (s : abs_convex_open_sets 𝕜 E) : balanced 𝕜 (s : set E) := s.2.2.2.1 + +lemma coe_convex (s : abs_convex_open_sets 𝕜 E) : convex ℝ (s : set E) := s.2.2.2.2 + +end abs_convex_open_sets + +instance : nonempty (abs_convex_open_sets 𝕜 E) := +begin + rw ←exists_true_iff_nonempty, + dunfold abs_convex_open_sets, + rw subtype.exists, + exact ⟨set.univ, ⟨mem_univ 0, is_open_univ, balanced_univ, convex_univ⟩, trivial⟩, +end + +end absolutely_convex_sets + +variables [is_R_or_C 𝕜] +variables [add_comm_group E] [topological_space E] +variables [module 𝕜 E] [module ℝ E] [is_scalar_tower ℝ 𝕜 E] +variables [has_continuous_smul ℝ E] + +variables (𝕜 E) + +/-- The family of seminorms defined by the gauges of absolute convex open sets. -/ +noncomputable +def gauge_seminorm_family : seminorm_family 𝕜 E (abs_convex_open_sets 𝕜 E) := +λ s, gauge_seminorm s.coe_balanced s.coe_convex (absorbent_nhds_zero s.coe_nhds) + +variables {𝕜 E} + +lemma gauge_seminorm_family_ball (s : abs_convex_open_sets 𝕜 E) : + (gauge_seminorm_family 𝕜 E s).ball 0 1 = (s : set E) := +begin + dunfold gauge_seminorm_family, + rw seminorm.ball_zero_eq, + simp_rw gauge_seminorm_to_fun, + exact gauge_lt_one_eq_self_of_open s.coe_convex s.coe_zero_mem s.coe_is_open, +end + +variables [topological_add_group E] [has_continuous_smul 𝕜 E] +variables [smul_comm_class ℝ 𝕜 E] [locally_convex_space ℝ E] + +/-- The topology of a locally convex space is induced by the gauge seminorm family. -/ +lemma with_gauge_seminorm_family : with_seminorms (gauge_seminorm_family 𝕜 E) := +begin + refine seminorm_family.with_seminorms_of_has_basis _ _, + refine (nhds_basis_abs_convex_open 𝕜 E).to_has_basis (λ s hs, _) (λ s hs, _), + { refine ⟨s, ⟨_, rfl.subset⟩⟩, + convert (gauge_seminorm_family _ _).basis_sets_singleton_mem ⟨s, hs⟩ one_pos, + rw [gauge_seminorm_family_ball, subtype.coe_mk] }, + refine ⟨s, ⟨_, rfl.subset⟩⟩, + rw seminorm_family.basis_sets_iff at hs, + rcases hs with ⟨t, r, hr, rfl⟩, + rw [seminorm.ball_finset_sup_eq_Inter _ _ _ hr], + -- We have to show that the intersection contains zero, is open, balanced, and convex + refine ⟨mem_Inter₂.mpr (λ _ _, by simp [seminorm.mem_ball_zero, hr]), + is_open_bInter (to_finite _) (λ S _, _), + balanced_Inter₂ (λ _ _, seminorm.balanced_ball_zero _ _), + convex_Inter₂ (λ _ _, seminorm.convex_ball _ _ _)⟩, + -- The only nontrivial part is to show that the ball is open + have hr' : r = ‖(r : 𝕜)‖ * 1 := by simp [abs_of_pos hr], + have hr'' : (r : 𝕜) ≠ 0 := by simp [hr.ne'], + rw [hr', ← seminorm.smul_ball_zero hr'', gauge_seminorm_family_ball], + exact S.coe_is_open.smul₀ hr'' +end diff --git a/src/analysis/locally_convex/balanced_core_hull.lean b/src/analysis/locally_convex/balanced_core_hull.lean index 6b962ff17cc7a..0533613a15d02 100644 --- a/src/analysis/locally_convex/balanced_core_hull.lean +++ b/src/analysis/locally_convex/balanced_core_hull.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Moritz Doll -/ import analysis.locally_convex.basic -import order.closure /-! # Balanced Core and Balanced Hull +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `balanced_core`: The largest balanced subset of a set `s`. @@ -23,7 +25,7 @@ import order.closure The balanced core and hull are implemented differently: for the core we take the obvious definition of the union over all balanced sets that are contained in `s`, whereas for the hull, we take the -union over `r • s`, for `r` the scalars with `∥r∥ ≤ 1`. We show that `balanced_hull` has the +union over `r • s`, for `r` the scalars with `‖r‖ ≤ 1`. We show that `balanced_hull` has the defining properties of a hull in `balanced.hull_minimal` and `subset_balanced_hull`. For the core we need slightly stronger assumptions to obtain a characterization as an intersection, this is `balanced_core_eq_Inter`. @@ -39,7 +41,7 @@ balanced open set -open_locale pointwise topological_space filter +open_locale pointwise topology filter variables {𝕜 E ι : Type*} @@ -49,49 +51,35 @@ section balanced_hull section semi_normed_ring variables [semi_normed_ring 𝕜] -section has_scalar -variables [has_scalar 𝕜 E] - -variables (𝕜) +section has_smul +variables (𝕜) [has_smul 𝕜 E] {s t : set E} {x : E} /-- The largest balanced subset of `s`.-/ def balanced_core (s : set E) := ⋃₀ {t : set E | balanced 𝕜 t ∧ t ⊆ s} /-- Helper definition to prove `balanced_core_eq_Inter`-/ -def balanced_core_aux (s : set E) := ⋂ (r : 𝕜) (hr : 1 ≤ ∥r∥), r • s +def balanced_core_aux (s : set E) := ⋂ (r : 𝕜) (hr : 1 ≤ ‖r‖), r • s /-- The smallest balanced superset of `s`.-/ -def balanced_hull (s : set E) := ⋃ (r : 𝕜) (hr : ∥r∥ ≤ 1), r • s +def balanced_hull (s : set E) := ⋃ (r : 𝕜) (hr : ‖r‖ ≤ 1), r • s variables {𝕜} -lemma balanced_core_subset (s : set E) : balanced_core 𝕜 s ⊆ s := -begin - refine sUnion_subset (λ t ht, _), - simp only [mem_set_of_eq] at ht, - exact ht.2, -end +lemma balanced_core_subset (s : set E) : balanced_core 𝕜 s ⊆ s := sUnion_subset $ λ t ht, ht.2 -lemma balanced_core_emptyset : balanced_core 𝕜 (∅ : set E) = ∅ := -set.eq_empty_of_subset_empty (balanced_core_subset _) +lemma balanced_core_empty : balanced_core 𝕜 (∅ : set E) = ∅ := +eq_empty_of_subset_empty (balanced_core_subset _) -lemma balanced_core_mem_iff {s : set E} {x : E} : x ∈ balanced_core 𝕜 s ↔ - ∃ t : set E, balanced 𝕜 t ∧ t ⊆ s ∧ x ∈ t := +lemma mem_balanced_core_iff : x ∈ balanced_core 𝕜 s ↔ ∃ t, balanced 𝕜 t ∧ t ⊆ s ∧ x ∈ t := by simp_rw [balanced_core, mem_sUnion, mem_set_of_eq, exists_prop, and_assoc] -lemma smul_balanced_core_subset (s : set E) {a : 𝕜} (ha : ∥a∥ ≤ 1) : +lemma smul_balanced_core_subset (s : set E) {a : 𝕜} (ha : ‖a‖ ≤ 1) : a • balanced_core 𝕜 s ⊆ balanced_core 𝕜 s := begin - rw subset_def, - intros x hx, - rw mem_smul_set at hx, - rcases hx with ⟨y, hy, hx⟩, - rw balanced_core_mem_iff at hy, + rintro x ⟨y, hy, rfl⟩, + rw mem_balanced_core_iff at hy, rcases hy with ⟨t, ht1, ht2, hy⟩, - rw ←hx, - refine ⟨t, _, ht1 a ha (smul_mem_smul_set hy)⟩, - rw mem_set_of_eq, - exact ⟨ht1, ht2⟩, + exact ⟨t, ⟨ht1, ht2⟩, ht1 a ha (smul_mem_smul_set hy)⟩, end lemma balanced_core_balanced (s : set E) : balanced 𝕜 (balanced_core 𝕜 s) := @@ -99,60 +87,37 @@ lemma balanced_core_balanced (s : set E) : balanced 𝕜 (balanced_core 𝕜 s) /-- The balanced core of `t` is maximal in the sense that it contains any balanced subset `s` of `t`.-/ -lemma balanced.subset_core_of_subset {s t : set E} (hs : balanced 𝕜 s) (h : s ⊆ t): - s ⊆ balanced_core 𝕜 t := -begin - refine subset_sUnion_of_mem _, - rw [mem_set_of_eq], - exact ⟨hs, h⟩, -end +lemma balanced.subset_core_of_subset (hs : balanced 𝕜 s) (h : s ⊆ t) : s ⊆ balanced_core 𝕜 t := +subset_sUnion_of_mem ⟨hs, h⟩ -lemma balanced_core_aux_mem_iff (s : set E) (x : E) : x ∈ balanced_core_aux 𝕜 s ↔ - ∀ (r : 𝕜) (hr : 1 ≤ ∥r∥), x ∈ r • s := -by rw [balanced_core_aux, set.mem_Inter₂] +lemma mem_balanced_core_aux_iff : x ∈ balanced_core_aux 𝕜 s ↔ ∀ r : 𝕜, 1 ≤ ‖r‖ → x ∈ r • s := +mem_Inter₂ -lemma balanced_hull_mem_iff (s : set E) (x : E) : x ∈ balanced_hull 𝕜 s ↔ - ∃ (r : 𝕜) (hr : ∥r∥ ≤ 1), x ∈ r • s := -by rw [balanced_hull, set.mem_Union₂] +lemma mem_balanced_hull_iff : x ∈ balanced_hull 𝕜 s ↔ ∃ (r : 𝕜) (hr : ‖r‖ ≤ 1), x ∈ r • s := +mem_Union₂ -/-- The balanced core of `s` is minimal in the sense that it is contained in any balanced superset +/-- The balanced hull of `s` is minimal in the sense that it is contained in any balanced superset `t` of `s`. -/ -lemma balanced.hull_subset_of_subset {s t : set E} (ht : balanced 𝕜 t) (h : s ⊆ t) : - balanced_hull 𝕜 s ⊆ t := -begin - intros x hx, - rcases (balanced_hull_mem_iff _ _).mp hx with ⟨r, hr, hx⟩, - rcases mem_smul_set.mp hx with ⟨y, hy, hx⟩, - rw ←hx, - exact balanced_mem ht (h hy) hr, -end +lemma balanced.hull_subset_of_subset (ht : balanced 𝕜 t) (h : s ⊆ t) : balanced_hull 𝕜 s ⊆ t := +λ x hx, by { obtain ⟨r, hr, y, hy, rfl⟩ := mem_balanced_hull_iff.1 hx, exact ht.smul_mem hr (h hy) } -end has_scalar +end has_smul -section add_comm_monoid +section module +variables [add_comm_group E] [module 𝕜 E] {s : set E} -variables [add_comm_monoid E] [module 𝕜 E] +lemma balanced_core_zero_mem (hs : (0 : E) ∈ s) : (0 : E) ∈ balanced_core 𝕜 s := +mem_balanced_core_iff.2 ⟨0, balanced_zero, zero_subset.2 hs, zero_mem_zero⟩ -lemma balanced_core_nonempty_iff {s : set E} : (balanced_core 𝕜 s).nonempty ↔ (0 : E) ∈ s := -begin - split; intro h, - { cases h with x hx, - have h' : balanced 𝕜 (balanced_core 𝕜 s) := balanced_core_balanced s, - have h'' := h' 0 (has_le.le.trans norm_zero.le zero_le_one), - refine mem_of_subset_of_mem (subset.trans h'' (balanced_core_subset s)) _, - exact mem_smul_set.mpr ⟨x, hx, zero_smul _ _⟩ }, - refine nonempty_of_mem (mem_of_subset_of_mem _ (mem_singleton 0)), - exact balanced.subset_core_of_subset zero_singleton_balanced (singleton_subset_iff.mpr h), -end - -lemma balanced_core_zero_mem {s : set E} (hs: (0 : E) ∈ s) : (0 : E) ∈ balanced_core 𝕜 s := -balanced_core_mem_iff.mpr - ⟨{0}, zero_singleton_balanced, singleton_subset_iff.mpr hs, mem_singleton 0⟩ +lemma balanced_core_nonempty_iff : (balanced_core 𝕜 s).nonempty ↔ (0 : E) ∈ s := +⟨λ h, zero_subset.1 $ (zero_smul_set h).superset.trans $ (balanced_core_balanced s (0 : 𝕜) $ + norm_zero.trans_le zero_le_one).trans $ balanced_core_subset _, + λ h, ⟨0, balanced_core_zero_mem h⟩⟩ variables (𝕜) lemma subset_balanced_hull [norm_one_class 𝕜] {s : set E} : s ⊆ balanced_hull 𝕜 s := -λ _ hx, (balanced_hull_mem_iff _ _).mpr ⟨1, norm_one.le, mem_smul_set.mp ⟨_, hx, one_smul _ _⟩⟩ +λ _ hx, mem_balanced_hull_iff.2 ⟨1, norm_one.le, _, hx, one_smul _ _⟩ variables {𝕜} @@ -160,100 +125,69 @@ lemma balanced_hull.balanced (s : set E) : balanced 𝕜 (balanced_hull 𝕜 s) begin intros a ha, simp_rw [balanced_hull, smul_set_Union₂, subset_def, mem_Union₂], - intros x hx, - rcases hx with ⟨r, hr, hx⟩, - use [a • r], - split, - { rw smul_eq_mul, - refine has_le.le.trans (semi_normed_ring.norm_mul _ _) _, - refine mul_le_one ha (norm_nonneg r) hr }, - rw smul_assoc, - exact hx, + rintro x ⟨r, hr, hx⟩, + rw ←smul_assoc at hx, + exact ⟨a • r, (semi_normed_ring.norm_mul _ _).trans (mul_le_one ha (norm_nonneg r) hr), hx⟩, end -end add_comm_monoid - +end module end semi_normed_ring section normed_field -variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] {s t : set E} @[simp] lemma balanced_core_aux_empty : balanced_core_aux 𝕜 (∅ : set E) = ∅ := begin - rw [balanced_core_aux, set.Inter₂_eq_empty_iff], - intros _, - simp only [smul_set_empty, mem_empty_eq, not_false_iff, exists_prop, and_true], - exact ⟨1, norm_one.ge⟩, + simp_rw [balanced_core_aux, Inter₂_eq_empty_iff, smul_set_empty], + exact λ _, ⟨1, norm_one.ge, not_mem_empty _⟩, end lemma balanced_core_aux_subset (s : set E) : balanced_core_aux 𝕜 s ⊆ s := -begin - rw subset_def, - intros x hx, - rw balanced_core_aux_mem_iff at hx, - have h := hx 1 norm_one.ge, - rw one_smul at h, - exact h, -end +λ x hx, by simpa only [one_smul] using mem_balanced_core_aux_iff.1 hx 1 norm_one.ge -lemma balanced_core_aux_balanced {s : set E} (h0 : (0 : E) ∈ balanced_core_aux 𝕜 s): +lemma balanced_core_aux_balanced (h0 : (0 : E) ∈ balanced_core_aux 𝕜 s): balanced 𝕜 (balanced_core_aux 𝕜 s) := begin - intros a ha x hx, - rcases mem_smul_set.mp hx with ⟨y, hy, hx⟩, - by_cases (a = 0), - { simp[h] at hx, - rw ←hx, - exact h0 }, - rw [←hx, balanced_core_aux_mem_iff], - rw balanced_core_aux_mem_iff at hy, + rintro a ha x ⟨y, hy, rfl⟩, + obtain rfl | h := eq_or_ne a 0, + { rwa zero_smul }, + rw mem_balanced_core_aux_iff at ⊢ hy, intros r hr, - have h'' : 1 ≤ ∥a⁻¹ • r∥ := - begin - rw smul_eq_mul, - simp only [norm_mul, norm_inv], - exact one_le_mul_of_one_le_of_one_le (one_le_inv (norm_pos_iff.mpr h) ha) hr, - end, + have h'' : 1 ≤ ‖a⁻¹ • r‖, + { rw [norm_smul, norm_inv], + exact one_le_mul_of_one_le_of_one_le (one_le_inv (norm_pos_iff.mpr h) ha) hr }, have h' := hy (a⁻¹ • r) h'', - rw smul_assoc at h', - exact (mem_inv_smul_set_iff₀ h _ _).mp h', + rwa [smul_assoc, mem_inv_smul_set_iff₀ h] at h', end -lemma balanced_core_aux_maximal {s t : set E} (h : t ⊆ s) (ht : balanced 𝕜 t) : - t ⊆ balanced_core_aux 𝕜 s := +lemma balanced_core_aux_maximal (h : t ⊆ s) (ht : balanced 𝕜 t) : t ⊆ balanced_core_aux 𝕜 s := begin - intros x hx, - rw balanced_core_aux_mem_iff, - intros r hr, - rw mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp (lt_of_lt_of_le zero_lt_one hr)), - refine h (balanced_mem ht hx _), + refine λ x hx, mem_balanced_core_aux_iff.2 (λ r hr, _), + rw mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp $ zero_lt_one.trans_le hr), + refine h (ht.smul_mem _ hx), rw norm_inv, exact inv_le_one hr, end -lemma balanced_core_subset_balanced_core_aux {s : set E} : - balanced_core 𝕜 s ⊆ balanced_core_aux 𝕜 s := +lemma balanced_core_subset_balanced_core_aux : balanced_core 𝕜 s ⊆ balanced_core_aux 𝕜 s := balanced_core_aux_maximal (balanced_core_subset s) (balanced_core_balanced s) -lemma balanced_core_eq_Inter {s : set E} (hs : (0 : E) ∈ s) : - balanced_core 𝕜 s = ⋂ (r : 𝕜) (hr : 1 ≤ ∥r∥), r • s := +lemma balanced_core_eq_Inter (hs : (0 : E) ∈ s) : + balanced_core 𝕜 s = ⋂ (r : 𝕜) (hr : 1 ≤ ‖r‖), r • s := begin - rw ←balanced_core_aux, - refine subset_antisymm balanced_core_subset_balanced_core_aux _, - refine balanced.subset_core_of_subset (balanced_core_aux_balanced _) (balanced_core_aux_subset s), - refine mem_of_subset_of_mem balanced_core_subset_balanced_core_aux (balanced_core_zero_mem hs), + refine balanced_core_subset_balanced_core_aux.antisymm _, + refine (balanced_core_aux_balanced _).subset_core_of_subset (balanced_core_aux_subset s), + exact balanced_core_subset_balanced_core_aux (balanced_core_zero_mem hs), end -lemma subset_balanced_core {U V : set E} (hV' : (0 : E) ∈ V) - (hUV : ∀ (a : 𝕜) (ha : ∥a∥ ≤ 1), a • U ⊆ V) : - U ⊆ balanced_core 𝕜 V := +lemma subset_balanced_core (ht : (0 : E) ∈ t) (hst : ∀ (a : 𝕜) (ha : ‖a‖ ≤ 1), a • s ⊆ t) : + s ⊆ balanced_core 𝕜 t := begin - rw balanced_core_eq_Inter hV', - refine set.subset_Inter₂ (λ a ha, _), - rw [←one_smul 𝕜 U, ←mul_inv_cancel (norm_pos_iff.mp (lt_of_lt_of_le zero_lt_one ha)), - ←smul_eq_mul, smul_assoc], - refine set.smul_set_mono (hUV a⁻¹ _), + rw balanced_core_eq_Inter ht, + refine subset_Inter₂ (λ a ha, _), + rw ←smul_inv_smul₀ (norm_pos_iff.mp $ zero_lt_one.trans_le ha) s, + refine smul_set_mono (hst _ _), rw [norm_inv], exact inv_le_one ha, end @@ -266,10 +200,10 @@ end balanced_hull section topology -variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E] - [has_continuous_smul 𝕜 E] +variables [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E] + [has_continuous_smul 𝕜 E] {U : set E} -lemma balanced_core_is_closed {U : set E} (hU : is_closed U) : is_closed (balanced_core 𝕜 U) := +protected lemma is_closed.balanced_core (hU : is_closed U) : is_closed (balanced_core 𝕜 U) := begin by_cases h : (0 : E) ∈ U, { rw balanced_core_eq_Inter h, @@ -280,48 +214,45 @@ begin refine is_closed_map_smul_of_ne_zero ha' U hU }, convert is_closed_empty, contrapose! h, - exact balanced_core_nonempty_iff.mp (set.ne_empty_iff_nonempty.mp h), + exact balanced_core_nonempty_iff.mp (set.nonempty_iff_ne_empty.2 h), end -lemma balanced_core_mem_nhds_zero {U : set E} (hU : U ∈ 𝓝 (0 : E)) : - balanced_core 𝕜 U ∈ 𝓝 (0 : E) := +lemma balanced_core_mem_nhds_zero (hU : U ∈ 𝓝 (0 : E)) : balanced_core 𝕜 U ∈ 𝓝 (0 : E) := begin -- Getting neighborhoods of the origin for `0 : 𝕜` and `0 : E` - have h : filter.tendsto (λ (x : 𝕜 × E), x.fst • x.snd) (𝓝 (0,0)) (𝓝 ((0 : 𝕜) • (0 : E))) := - continuous_iff_continuous_at.mp has_continuous_smul.continuous_smul (0, 0), - rw [smul_zero] at h, - have h' := filter.has_basis.prod (@metric.nhds_basis_ball 𝕜 _ 0) (filter.basis_sets (𝓝 (0 : E))), - simp_rw [←nhds_prod_eq, id.def] at h', - have h'' := filter.tendsto.basis_left h h' U hU, - rcases h'' with ⟨x, hx, h''⟩, - cases normed_field.exists_norm_lt 𝕜 hx.left with y hy, - have hy' : y ≠ 0 := norm_pos_iff.mp hy.1, - let W := y • x.snd, - rw ←filter.exists_mem_subset_iff, - refine ⟨W, (set_smul_mem_nhds_zero_iff hy').mpr hx.2, _⟩, - -- It remains to show that `W ⊆ balanced_core 𝕜 U` - refine subset_balanced_core (mem_of_mem_nhds hU) (λ a ha, _), - refine set.subset.trans (λ z hz, _) (set.maps_to'.mp h''), - rw [set.image_prod, set.image2_smul], - rw set.mem_smul_set at hz, - rcases hz with ⟨z', hz', hz⟩, - rw [←hz, set.mem_smul], - refine ⟨a • y, y⁻¹ • z', _, _, _⟩, - { rw [algebra.id.smul_eq_mul, mem_ball_zero_iff, norm_mul, ←one_mul x.fst], - exact mul_lt_mul' ha hy.2 hy.1.le zero_lt_one }, - { convert set.smul_mem_smul_set hz', - rw [←smul_assoc y⁻¹ y x.snd, smul_eq_mul, inv_mul_cancel hy', one_smul] }, - rw [smul_assoc, ←smul_assoc y y⁻¹ z', smul_eq_mul, mul_inv_cancel hy', one_smul], + obtain ⟨r, V, hr, hV, hrVU⟩ : ∃ (r : ℝ) (V : set E), 0 < r ∧ V ∈ 𝓝 (0 : E) ∧ + ∀ (c : 𝕜) (y : E), ‖c‖ < r → y ∈ V → c • y ∈ U, + { have h : filter.tendsto (λ (x : 𝕜 × E), x.fst • x.snd) (𝓝 (0,0)) (𝓝 0), + from continuous_smul.tendsto' (0, 0) _ (smul_zero _), + simpa only [← prod.exists', ← prod.forall', ← and_imp, ← and.assoc, exists_prop] + using h.basis_left (normed_add_comm_group.nhds_zero_basis_norm_lt.prod_nhds + ((𝓝 _).basis_sets)) U hU }, + rcases normed_field.exists_norm_lt 𝕜 hr with ⟨y, hy₀, hyr⟩, + rw [norm_pos_iff] at hy₀, + have : y • V ∈ 𝓝 (0 : E) := (set_smul_mem_nhds_zero_iff hy₀).mpr hV, + -- It remains to show that `y • V ⊆ balanced_core 𝕜 U` + refine filter.mem_of_superset this (subset_balanced_core (mem_of_mem_nhds hU) $ λ a ha, _), + rw [smul_smul], + rintro _ ⟨z, hz, rfl⟩, + refine hrVU _ _ _ hz, + rw [norm_mul, ← one_mul r], + exact mul_lt_mul' ha hyr (norm_nonneg y) one_pos end variables (𝕜 E) +lemma nhds_basis_balanced : (𝓝 (0 : E)).has_basis + (λ (s : set E), s ∈ 𝓝 (0 : E) ∧ balanced 𝕜 s) id := +filter.has_basis_self.mpr + (λ s hs, ⟨balanced_core 𝕜 s, balanced_core_mem_nhds_zero hs, + balanced_core_balanced s, balanced_core_subset s⟩) + lemma nhds_basis_closed_balanced [regular_space E] : (𝓝 (0 : E)).has_basis (λ (s : set E), s ∈ 𝓝 (0 : E) ∧ is_closed s ∧ balanced 𝕜 s) id := begin refine (closed_nhds_basis 0).to_has_basis (λ s hs, _) (λ s hs, ⟨s, ⟨hs.1, hs.2.1⟩, rfl.subset⟩), refine ⟨balanced_core 𝕜 s, ⟨balanced_core_mem_nhds_zero hs.1, _⟩, balanced_core_subset s⟩, - refine ⟨balanced_core_is_closed hs.2, balanced_core_balanced s⟩ + exact ⟨hs.2.balanced_core, balanced_core_balanced s⟩ end end topology diff --git a/src/analysis/locally_convex/basic.lean b/src/analysis/locally_convex/basic.lean index e85a878843e3b..49ce8cc61ba98 100644 --- a/src/analysis/locally_convex/basic.lean +++ b/src/analysis/locally_convex/basic.lean @@ -3,11 +3,16 @@ Copyright (c) 2019 Jean Lo. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jean Lo, Bhavik Mehta, Yaël Dillies -/ +import analysis.convex.basic +import analysis.convex.hull import analysis.normed_space.basic /-! # Local convexity +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines absorbent and balanced sets. An absorbent set is one that "surrounds" the origin. The idea is made precise by requiring that any @@ -35,19 +40,19 @@ absorbent, balanced, locally convex, LCTVS -/ open set -open_locale pointwise topological_space +open_locale pointwise topology -variables {𝕜 𝕝 E ι : Type*} +variables {𝕜 𝕝 E : Type*} {ι : Sort*} {κ : ι → Sort*} section semi_normed_ring variables [semi_normed_ring 𝕜] -section has_scalar -variables (𝕜) [has_scalar 𝕜 E] +section has_smul +variables (𝕜) [has_smul 𝕜 E] /-- A set `A` absorbs another set `B` if `B` is contained in all scalings of `A` by elements of sufficiently large norm. -/ -def absorbs (A B : set E) := ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ∥a∥ → B ⊆ a • A +def absorbs (A B : set E) := ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ‖a‖ → B ⊆ a • A variables {𝕜} {s t u v A B : set E} @@ -72,13 +77,13 @@ end ⟨λ h, ⟨h.mono_right $ subset_union_left _ _, h.mono_right $ subset_union_right _ _⟩, λ h, h.1.union h.2⟩ -lemma absorbs_Union_finset {s : set E} {t : finset ι} {f : ι → set E} : - absorbs 𝕜 s (⋃ (i ∈ t), f i) ↔ ∀ i ∈ t, absorbs 𝕜 s (f i) := +lemma absorbs_Union_finset {ι : Type*} {t : finset ι} {f : ι → set E} : + absorbs 𝕜 s (⋃ i ∈ t, f i) ↔ ∀ i ∈ t, absorbs 𝕜 s (f i) := begin classical, induction t using finset.induction_on with i t ht hi, { simp only [finset.not_mem_empty, set.Union_false, set.Union_empty, absorbs_empty, - forall_false_left, implies_true_iff] }, + is_empty.forall_iff, implies_true_iff] }, rw [finset.set_bUnion_insert, absorbs_union, hi], split; intro h, { refine λ _ hi', (finset.mem_insert.mp hi').elim _ (h.2 _), @@ -86,8 +91,8 @@ begin exact ⟨h i (finset.mem_insert_self i t), λ i' hi', h i' (finset.mem_insert_of_mem hi')⟩, end -lemma set.finite.absorbs_Union {s : set E} {t : set ι} {f : ι → set E} (hi : t.finite) : - absorbs 𝕜 s (⋃ (i : ι) (hy : i ∈ t), f i) ↔ ∀ i ∈ t, absorbs 𝕜 s (f i) := +lemma set.finite.absorbs_Union {ι : Type*} {s : set E} {t : set ι} {f : ι → set E} (hi : t.finite) : + absorbs 𝕜 s (⋃ i ∈ t, f i) ↔ ∀ i ∈ t, absorbs 𝕜 s (f i) := begin lift t to finset ι using hi, simp only [finset.mem_coe], @@ -97,7 +102,7 @@ end variables (𝕜) /-- A set is absorbent if it absorbs every singleton. -/ -def absorbent (A : set E) := ∀ x, ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ∥a∥ → x ∈ a • A +def absorbent (A : set E) := ∀ x, ∃ r, 0 < r ∧ ∀ a : 𝕜, r ≤ ‖a‖ → x ∈ a • A variables {𝕜} @@ -113,7 +118,7 @@ by simp_rw [absorbs, absorbent, singleton_subset_iff] lemma absorbent.absorbs (hs : absorbent 𝕜 s) {x : E} : absorbs 𝕜 s {x} := absorbent_iff_forall_absorbs_singleton.1 hs _ -lemma absorbent_iff_nonneg_lt : absorbent 𝕜 A ↔ ∀ x, ∃ r, 0 ≤ r ∧ ∀ ⦃a : 𝕜⦄, r < ∥a∥ → x ∈ a • A := +lemma absorbent_iff_nonneg_lt : absorbent 𝕜 A ↔ ∀ x, ∃ r, 0 ≤ r ∧ ∀ ⦃a : 𝕜⦄, r < ‖a‖ → x ∈ a • A := forall_congr $ λ x, ⟨λ ⟨r, hr, hx⟩, ⟨r, hr.le, λ a ha, hx a ha.le⟩, λ ⟨r, hr, hx⟩, ⟨r + 1, add_pos_of_nonneg_of_pos hr zero_lt_one, λ a ha, hx ((lt_add_of_pos_right r zero_lt_one).trans_le ha)⟩⟩ @@ -128,73 +133,81 @@ end variables (𝕜) /-- A set `A` is balanced if `a • A` is contained in `A` whenever `a` has norm at most `1`. -/ -def balanced (A : set E) := ∀ a : 𝕜, ∥a∥ ≤ 1 → a • A ⊆ A +def balanced (A : set E) := ∀ a : 𝕜, ‖a‖ ≤ 1 → a • A ⊆ A variables {𝕜} -lemma balanced_mem {s : set E} (hs : balanced 𝕜 s) {x : E} (hx : x ∈ s) {a : 𝕜} (ha : ∥a∥ ≤ 1) : - a • x ∈ s := -mem_of_subset_of_mem (hs a ha) (smul_mem_smul_set hx) +lemma balanced_iff_smul_mem : balanced 𝕜 s ↔ ∀ ⦃a : 𝕜⦄, ‖a‖ ≤ 1 → ∀ ⦃x : E⦄, x ∈ s → a • x ∈ s := +forall₂_congr $ λ a ha, smul_set_subset_iff + +alias balanced_iff_smul_mem ↔ balanced.smul_mem _ + +@[simp] lemma balanced_empty : balanced 𝕜 (∅ : set E) := +λ _ _, by { rw smul_set_empty } -lemma balanced_univ : balanced 𝕜 (univ : set E) := λ a ha, subset_univ _ +@[simp] lemma balanced_univ : balanced 𝕜 (univ : set E) := λ a ha, subset_univ _ lemma balanced.union (hA : balanced 𝕜 A) (hB : balanced 𝕜 B) : balanced 𝕜 (A ∪ B) := -begin - intros a ha t ht, - rw smul_set_union at ht, - exact ht.imp (λ x, hA _ ha x) (λ x, hB _ ha x), -end +λ a ha, smul_set_union.subset.trans $ union_subset_union (hA _ ha) $ hB _ ha lemma balanced.inter (hA : balanced 𝕜 A) (hB : balanced 𝕜 B) : balanced 𝕜 (A ∩ B) := -begin - rintro a ha _ ⟨x, ⟨hx₁, hx₂⟩, rfl⟩, - exact ⟨hA _ ha ⟨_, hx₁, rfl⟩, hB _ ha ⟨_, hx₂, rfl⟩⟩, -end +λ a ha, smul_set_inter_subset.trans $ inter_subset_inter (hA _ ha) $ hB _ ha -end has_scalar +lemma balanced_Union {f : ι → set E} (h : ∀ i, balanced 𝕜 (f i)) : balanced 𝕜 (⋃ i, f i) := +λ a ha, (smul_set_Union _ _).subset.trans $ Union_mono $ λ _, h _ _ ha -section add_comm_monoid -variables [add_comm_monoid E] [module 𝕜 E] {s s' t t' u v A B : set E} +lemma balanced_Union₂ {f : Π i, κ i → set E} (h : ∀ i j, balanced 𝕜 (f i j)) : + balanced 𝕜 (⋃ i j, f i j) := +balanced_Union $ λ _, balanced_Union $ h _ -lemma absorbs.add (h : absorbs 𝕜 s t) (h' : absorbs 𝕜 s' t') : absorbs 𝕜 (s + s') (t + t') := -begin - rcases h with ⟨r, hr, h⟩, - rcases h' with ⟨r', hr', h'⟩, - refine ⟨max r r', lt_max_of_lt_left hr, λ a ha, _⟩, - rw smul_add, - exact set.add_subset_add (h a (le_of_max_le_left ha)) (h' a (le_of_max_le_right ha)), -end +lemma balanced_Inter {f : ι → set E} (h : ∀ i, balanced 𝕜 (f i)) : balanced 𝕜 (⋂ i, f i) := +λ a ha, (smul_set_Inter_subset _ _).trans $ Inter_mono $ λ _, h _ _ ha -lemma balanced.add (hA₁ : balanced 𝕜 A) (hA₂ : balanced 𝕜 B) : balanced 𝕜 (A + B) := -begin - rintro a ha _ ⟨_, ⟨x, y, hx, hy, rfl⟩, rfl⟩, - rw smul_add, - exact add_mem_add (hA₁ _ ha ⟨_, hx, rfl⟩) (hA₂ _ ha ⟨_, hy, rfl⟩), -end +lemma balanced_Inter₂ {f : Π i, κ i → set E} (h : ∀ i j, balanced 𝕜 (f i j)) : + balanced 𝕜 (⋂ i j, f i j) := +balanced_Inter $ λ _, balanced_Inter $ h _ -lemma zero_singleton_balanced : balanced 𝕜 ({0} : set E) := -λ a ha, by simp only [smul_set_singleton, smul_zero] +variables [has_smul 𝕝 E] [smul_comm_class 𝕜 𝕝 E] -end add_comm_monoid -end semi_normed_ring +lemma balanced.smul (a : 𝕝) (hs : balanced 𝕜 s) : balanced 𝕜 (a • s) := +λ b hb, (smul_comm _ _ _).subset.trans $ smul_set_mono $ hs _ hb -section normed_comm_ring -variables [normed_comm_ring 𝕜] [add_comm_monoid E] [module 𝕜 E] {A B : set E} (a : 𝕜) +end has_smul -lemma balanced.smul (hA : balanced 𝕜 A) : balanced 𝕜 (a • A) := -begin - rintro b hb _ ⟨_, ⟨x, hx, rfl⟩, rfl⟩, - exact ⟨b • x, hA _ hb ⟨_, hx, rfl⟩, smul_comm _ _ _⟩, -end +section module +variables [add_comm_group E] [module 𝕜 E] {s s₁ s₂ t t₁ t₂ : set E} + +lemma absorbs.neg : absorbs 𝕜 s t → absorbs 𝕜 (-s) (-t) := +Exists.imp $ λ r, and.imp_right $ forall₂_imp $ λ _ _ h, + (neg_subset_neg.2 h).trans (smul_set_neg _ _).superset + +lemma balanced.neg : balanced 𝕜 s → balanced 𝕜 (-s) := +forall₂_imp $ λ _ _ h, (smul_set_neg _ _).subset.trans $ neg_subset_neg.2 h + +lemma absorbs.add : absorbs 𝕜 s₁ t₁ → absorbs 𝕜 s₂ t₂ → absorbs 𝕜 (s₁ + s₂) (t₁ + t₂) := +λ ⟨r₁, hr₁, h₁⟩ ⟨r₂, hr₂, h₂⟩, ⟨max r₁ r₂, lt_max_of_lt_left hr₁, λ a ha, (add_subset_add + (h₁ _ $ le_of_max_le_left ha) $ h₂ _ $ le_of_max_le_right ha).trans (smul_add _ _ _).superset⟩ + +lemma balanced.add (hs : balanced 𝕜 s) (ht : balanced 𝕜 t) : balanced 𝕜 (s + t) := +λ a ha, (smul_add _ _ _).subset.trans $ add_subset_add (hs _ ha) $ ht _ ha -end normed_comm_ring +lemma absorbs.sub (h₁ : absorbs 𝕜 s₁ t₁) (h₂ : absorbs 𝕜 s₂ t₂) : absorbs 𝕜 (s₁ - s₂) (t₁ - t₂) := +by { simp_rw sub_eq_add_neg, exact h₁.add h₂.neg } + +lemma balanced.sub (hs : balanced 𝕜 s) (ht : balanced 𝕜 t) : balanced 𝕜 (s - t) := +by { simp_rw sub_eq_add_neg, exact hs.add ht.neg } + +lemma balanced_zero : balanced 𝕜 (0 : set E) := λ a ha, (smul_zero _).subset + +end module +end semi_normed_ring section normed_field variables [normed_field 𝕜] [normed_ring 𝕝] [normed_space 𝕜 𝕝] [add_comm_group E] [module 𝕜 E] - [smul_with_zero 𝕝 E] [is_scalar_tower 𝕜 𝕝 E] {s t u v A B : set E} {a b : 𝕜} + [smul_with_zero 𝕝 E] [is_scalar_tower 𝕜 𝕝 E] {s t u v A B : set E} {x : E} {a b : 𝕜} /-- Scalar multiplication (by possibly different types) of a balanced set is monotone. -/ -lemma balanced.smul_mono (hs : balanced 𝕝 s) {a : 𝕝} {b : 𝕜} (h : ∥a∥ ≤ ∥b∥) : a • s ⊆ b • s := +lemma balanced.smul_mono (hs : balanced 𝕝 s) {a : 𝕝} {b : 𝕜} (h : ‖a‖ ≤ ‖b‖) : a • s ⊆ b • s := begin obtain rfl | hb := eq_or_ne b 0, { rw norm_zero at h, @@ -220,7 +233,7 @@ begin exact inv_le_one ha, end -lemma balanced.subset_smul (hA : balanced 𝕜 A) (ha : 1 ≤ ∥a∥) : A ⊆ a • A := +lemma balanced.subset_smul (hA : balanced 𝕜 A) (ha : 1 ≤ ‖a‖) : A ⊆ a • A := begin refine (subset_set_smul_iff₀ _).2 (hA (a⁻¹) _), { rintro rfl, @@ -230,9 +243,24 @@ begin exact inv_le_one ha } end -lemma balanced.smul_eq (hA : balanced 𝕜 A) (ha : ∥a∥ = 1) : a • A = A := +lemma balanced.smul_eq (hA : balanced 𝕜 A) (ha : ‖a‖ = 1) : a • A = A := (hA _ ha.le).antisymm $ hA.subset_smul ha.ge +lemma balanced.mem_smul_iff (hs : balanced 𝕜 s) (h : ‖a‖ = ‖b‖) : a • x ∈ s ↔ b • x ∈ s := +begin + obtain rfl | hb := eq_or_ne b 0, + { rw [norm_zero, norm_eq_zero] at h, + rw h }, + have ha : a ≠ 0 := norm_ne_zero_iff.1 (ne_of_eq_of_ne h $ norm_ne_zero_iff.2 hb), + split; intro h'; [rw ←inv_mul_cancel_right₀ ha b, rw ←inv_mul_cancel_right₀ hb a]; + { rw [←smul_eq_mul, smul_assoc], + refine hs.smul_mem _ h', + simp [←h, ha] } +end + +lemma balanced.neg_mem_iff (hs : balanced 𝕜 s) : -x ∈ s ↔ x ∈ s := +by convert hs.mem_smul_iff (norm_neg 1); simp only [neg_smul, one_smul] + lemma absorbs.inter (hs : absorbs 𝕜 s u) (ht : absorbs 𝕜 t u) : absorbs 𝕜 (s ∩ t) u := begin obtain ⟨a, ha, hs⟩ := hs, @@ -266,10 +294,10 @@ begin (by rwa [mem_preimage, zero_smul]), have hr₃ := inv_pos.mpr (half_pos hr₁), refine ⟨(r / 2)⁻¹, hr₃, λ a ha₁, _⟩, - have ha₂ : 0 < ∥a∥ := hr₃.trans_le ha₁, + have ha₂ : 0 < ‖a‖ := hr₃.trans_le ha₁, refine (mem_smul_set_iff_inv_smul_mem₀ (norm_pos_iff.mp ha₂) _ _).2 (hw₁ $ hr₂ _), rw [metric.mem_ball, dist_zero_right, norm_inv], - calc ∥a∥⁻¹ ≤ r/2 : (inv_le (half_pos hr₁) ha₂).mp ha₁ + calc ‖a‖⁻¹ ≤ r/2 : (inv_le (half_pos hr₁) ha₂).mp ha₁ ... < r : half_lt_self hr₁, end @@ -301,8 +329,8 @@ lemma balanced.closure (hA : balanced 𝕜 A) : balanced 𝕜 (closure A) := end normed_field -section nondiscrete_normed_field -variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] {s : set E} +section nontrivially_normed_field +variables [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] {s : set E} lemma absorbs_zero_iff : absorbs 𝕜 s 0 ↔ (0 : E) ∈ s := begin @@ -317,4 +345,31 @@ end lemma absorbent.zero_mem (hs : absorbent 𝕜 s) : (0 : E) ∈ s := absorbs_zero_iff.1 $ absorbent_iff_forall_absorbs_singleton.1 hs _ -end nondiscrete_normed_field +variables [module ℝ E] [smul_comm_class ℝ 𝕜 E] + +lemma balanced_convex_hull_of_balanced (hs : balanced 𝕜 s) : balanced 𝕜 (convex_hull ℝ s) := +begin + suffices : convex ℝ {x | ∀ a : 𝕜, ‖a‖ ≤ 1 → a • x ∈ convex_hull ℝ s}, + { rw balanced_iff_smul_mem at hs ⊢, + refine λ a ha x hx, convex_hull_min _ this hx a ha, + exact λ y hy a ha, subset_convex_hull ℝ s (hs ha hy) }, + intros x hx y hy u v hu hv huv a ha, + simp only [smul_add, ← smul_comm], + exact convex_convex_hull ℝ s (hx a ha) (hy a ha) hu hv huv +end + +end nontrivially_normed_field + +section real +variables [add_comm_group E] [module ℝ E] {s : set E} + +lemma balanced_iff_neg_mem (hs : convex ℝ s) : balanced ℝ s ↔ ∀ ⦃x⦄, x ∈ s → -x ∈ s := +begin + refine ⟨λ h x, h.neg_mem_iff.2, λ h a ha, smul_set_subset_iff.2 $ λ x hx, _⟩, + rw [real.norm_eq_abs, abs_le] at ha, + rw [show a = -((1 - a) / 2) + (a - -1)/2, by ring, add_smul, neg_smul, ←smul_neg], + exact hs (h hx) hx (div_nonneg (sub_nonneg_of_le ha.2) zero_le_two) + (div_nonneg (sub_nonneg_of_le ha.1) zero_le_two) (by ring), +end + +end real diff --git a/src/analysis/locally_convex/bounded.lean b/src/analysis/locally_convex/bounded.lean index 5fc941f541e5e..d44d4d45c5eb3 100644 --- a/src/analysis/locally_convex/bounded.lean +++ b/src/analysis/locally_convex/bounded.lean @@ -4,13 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Moritz Doll -/ import analysis.locally_convex.basic +import analysis.locally_convex.balanced_core_hull +import analysis.seminorm import topology.bornology.basic import topology.algebra.uniform_group -import analysis.locally_convex.balanced_core_hull +import topology.uniform_space.cauchy /-! # Von Neumann Boundedness +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines natural or von Neumann bounded sets and proves elementary properties. ## Main declarations @@ -21,8 +26,14 @@ absorbs `s`. ## Main results -* `bornology.is_vonN_bounded_of_topological_space_le`: A coarser topology admits more +* `bornology.is_vonN_bounded.of_topological_space_le`: A coarser topology admits more von Neumann-bounded sets. +* `bornology.is_vonN_bounded.image`: A continuous linear image of a bounded set is bounded. +* `bornology.is_vonN_bounded_iff_smul_tendsto_zero`: Given any sequence `ε` of scalars which tends + to `𝓝[≠] 0`, we have that a set `S` is bounded if and only if for any sequence `x : ℕ → S`, + `ε • x` tends to 0. This shows that bounded sets are completely determined by sequences, which is + the key fact for proving that sequential continuity implies continuity for linear maps defined on + a bornological space ## References @@ -30,9 +41,10 @@ von Neumann-bounded sets. -/ -variables {𝕜 E ι : Type*} +variables {𝕜 𝕜' E E' F ι : Type*} -open_locale topological_space pointwise +open set filter +open_locale topology pointwise namespace bornology @@ -41,7 +53,7 @@ section semi_normed_ring section has_zero variables (𝕜) -variables [semi_normed_ring 𝕜] [has_scalar 𝕜 E] [has_zero E] +variables [semi_normed_ring 𝕜] [has_smul 𝕜 E] [has_zero E] variables [topological_space E] /-- A set `s` is von Neumann bounded if every neighborhood of 0 absorbs `s`. -/ @@ -93,6 +105,92 @@ lemma is_vonN_bounded.of_topological_space_le {t t' : topological_space E} (h : end multiple_topologies +section image + +variables {𝕜₁ 𝕜₂ : Type*} [normed_division_ring 𝕜₁] [normed_division_ring 𝕜₂] + [add_comm_group E] [module 𝕜₁ E] [add_comm_group F] [module 𝕜₂ F] + [topological_space E] [topological_space F] + +/-- A continuous linear image of a bounded set is bounded. -/ +lemma is_vonN_bounded.image {σ : 𝕜₁ →+* 𝕜₂} [ring_hom_surjective σ] [ring_hom_isometric σ] + {s : set E} (hs : is_vonN_bounded 𝕜₁ s) (f : E →SL[σ] F) : + is_vonN_bounded 𝕜₂ (f '' s) := +begin + let σ' := ring_equiv.of_bijective σ ⟨σ.injective, σ.is_surjective⟩, + have σ_iso : isometry σ := add_monoid_hom_class.isometry_of_norm σ + (λ x, ring_hom_isometric.is_iso), + have σ'_symm_iso : isometry σ'.symm := σ_iso.right_inv σ'.right_inv, + have f_tendsto_zero := f.continuous.tendsto 0, + rw map_zero at f_tendsto_zero, + intros V hV, + rcases hs (f_tendsto_zero hV) with ⟨r, hrpos, hr⟩, + refine ⟨r, hrpos, λ a ha, _⟩, + rw ← σ'.apply_symm_apply a, + have hanz : a ≠ 0 := norm_pos_iff.mp (hrpos.trans_le ha), + have : σ'.symm a ≠ 0 := (map_ne_zero σ'.symm.to_ring_hom).mpr hanz, + change _ ⊆ σ _ • _, + rw [set.image_subset_iff, preimage_smul_setₛₗ _ _ _ f this.is_unit], + refine hr (σ'.symm a) _, + rwa σ'_symm_iso.norm_map_of_map_zero (map_zero _) +end + +end image + +section sequence + +variables {𝕝 : Type*} [normed_field 𝕜] [nontrivially_normed_field 𝕝] [add_comm_group E] [module 𝕜 E] + [module 𝕝 E] [topological_space E] [has_continuous_smul 𝕝 E] + +lemma is_vonN_bounded.smul_tendsto_zero {S : set E} {ε : ι → 𝕜} {x : ι → E} {l : filter ι} + (hS : is_vonN_bounded 𝕜 S) (hxS : ∀ᶠ n in l, x n ∈ S) (hε : tendsto ε l (𝓝 0)) : + tendsto (ε • x) l (𝓝 0) := +begin + rw tendsto_def at *, + intros V hV, + rcases hS hV with ⟨r, r_pos, hrS⟩, + filter_upwards [hxS, hε _ (metric.ball_mem_nhds 0 $ inv_pos.mpr r_pos)] with n hnS hnr, + by_cases this : ε n = 0, + { simp [this, mem_of_mem_nhds hV] }, + { rw [mem_preimage, mem_ball_zero_iff, lt_inv (norm_pos_iff.mpr this) r_pos, ← norm_inv] at hnr, + rw [mem_preimage, pi.smul_apply', ← set.mem_inv_smul_set_iff₀ this], + exact hrS _ (hnr.le) hnS }, +end + +lemma is_vonN_bounded_of_smul_tendsto_zero {ε : ι → 𝕝} {l : filter ι} [l.ne_bot] + (hε : ∀ᶠ n in l, ε n ≠ 0) {S : set E} + (H : ∀ x : ι → E, (∀ n, x n ∈ S) → tendsto (ε • x) l (𝓝 0)) : + is_vonN_bounded 𝕝 S := +begin + rw (nhds_basis_balanced 𝕝 E).is_vonN_bounded_basis_iff, + by_contra' H', + rcases H' with ⟨V, ⟨hV, hVb⟩, hVS⟩, + have : ∀ᶠ n in l, ∃ x : S, (ε n) • (x : E) ∉ V, + { filter_upwards [hε] with n hn, + rw absorbs at hVS, + push_neg at hVS, + rcases hVS _ (norm_pos_iff.mpr $ inv_ne_zero hn) with ⟨a, haε, haS⟩, + rcases set.not_subset.mp haS with ⟨x, hxS, hx⟩, + refine ⟨⟨x, hxS⟩, λ hnx, _⟩, + rw ← set.mem_inv_smul_set_iff₀ hn at hnx, + exact hx (hVb.smul_mono haε hnx) }, + rcases this.choice with ⟨x, hx⟩, + refine filter.frequently_false l (filter.eventually.frequently _), + filter_upwards [hx, (H (coe ∘ x) (λ n, (x n).2)).eventually (eventually_mem_set.mpr hV)] + using λ n, id +end + +/-- Given any sequence `ε` of scalars which tends to `𝓝[≠] 0`, we have that a set `S` is bounded + if and only if for any sequence `x : ℕ → S`, `ε • x` tends to 0. This actually works for any + indexing type `ι`, but in the special case `ι = ℕ` we get the important fact that convergent + sequences fully characterize bounded sets. -/ +lemma is_vonN_bounded_iff_smul_tendsto_zero {ε : ι → 𝕝} {l : filter ι} [l.ne_bot] + (hε : tendsto ε l (𝓝[≠] 0)) {S : set E} : + is_vonN_bounded 𝕝 S ↔ ∀ x : ι → E, (∀ n, x n ∈ S) → tendsto (ε • x) l (𝓝 0) := +⟨λ hS x hxS, hS.smul_tendsto_zero (eventually_of_forall hxS) (le_trans hε nhds_within_le_nhds), + is_vonN_bounded_of_smul_tendsto_zero (hε self_mem_nhds_within)⟩ + +end sequence + section normed_field variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] @@ -130,9 +228,8 @@ end bornology section uniform_add_group -variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables (𝕜) [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] variables [uniform_space E] [uniform_add_group E] [has_continuous_smul 𝕜 E] -variables [regular_space E] lemma totally_bounded.is_vonN_bounded {s : set E} (hs : totally_bounded s) : bornology.is_vonN_bounded 𝕜 s := @@ -142,7 +239,7 @@ begin have h : filter.tendsto (λ (x : E × E), x.fst + x.snd) (𝓝 (0,0)) (𝓝 ((0 : E) + (0 : E))) := tendsto_add, rw add_zero at h, - have h' := (nhds_basis_closed_balanced 𝕜 E).prod (nhds_basis_closed_balanced 𝕜 E), + have h' := (nhds_basis_balanced 𝕜 E).prod (nhds_basis_balanced 𝕜 E), simp_rw [←nhds_prod_eq, id.def] at h', rcases h.basis_left h' U hU with ⟨x, hx, h''⟩, rcases hs x.snd hx.2.1 with ⟨t, ht, hs⟩, @@ -155,7 +252,88 @@ begin simpa only [hz] using h'' hz' }, refine λ y hy, absorbs.mono_left _ hx_fstsnd, rw [←set.singleton_vadd, vadd_eq_add], - exact (absorbent_nhds_zero hx.1.1).absorbs.add hx.2.2.2.absorbs_self, + exact (absorbent_nhds_zero hx.1.1).absorbs.add hx.2.2.absorbs_self, end end uniform_add_group + +section vonN_bornology_eq_metric + +variables (𝕜 E) [nontrivially_normed_field 𝕜] [seminormed_add_comm_group E] [normed_space 𝕜 E] + +namespace normed_space + +lemma is_vonN_bounded_ball (r : ℝ) : + bornology.is_vonN_bounded 𝕜 (metric.ball (0 : E) r) := +begin + rw [metric.nhds_basis_ball.is_vonN_bounded_basis_iff, ← ball_norm_seminorm 𝕜 E], + exact λ ε hε, (norm_seminorm 𝕜 E).ball_zero_absorbs_ball_zero hε +end + +lemma is_vonN_bounded_closed_ball (r : ℝ) : + bornology.is_vonN_bounded 𝕜 (metric.closed_ball (0 : E) r) := +(is_vonN_bounded_ball 𝕜 E (r+1)).subset (metric.closed_ball_subset_ball $ by linarith) + +lemma is_vonN_bounded_iff (s : set E) : + bornology.is_vonN_bounded 𝕜 s ↔ bornology.is_bounded s := +begin + rw [← metric.bounded_iff_is_bounded, metric.bounded_iff_subset_ball (0 : E)], + split, + { intros h, + rcases h (metric.ball_mem_nhds 0 zero_lt_one) with ⟨ρ, hρ, hρball⟩, + rcases normed_field.exists_lt_norm 𝕜 ρ with ⟨a, ha⟩, + specialize hρball a ha.le, + rw [← ball_norm_seminorm 𝕜 E, seminorm.smul_ball_zero (norm_pos_iff.1 $ hρ.trans ha), + ball_norm_seminorm, mul_one] at hρball, + exact ⟨‖a‖, hρball.trans metric.ball_subset_closed_ball⟩ }, + { exact λ ⟨C, hC⟩, (is_vonN_bounded_closed_ball 𝕜 E C).subset hC } +end + +lemma is_vonN_bounded_iff' (s : set E) : + bornology.is_vonN_bounded 𝕜 s ↔ ∃ r : ℝ, ∀ (x : E) (hx : x ∈ s), ‖x‖ ≤ r := +by rw [normed_space.is_vonN_bounded_iff, ←metric.bounded_iff_is_bounded, bounded_iff_forall_norm_le] + +lemma image_is_vonN_bounded_iff (f : E' → E) (s : set E') : + bornology.is_vonN_bounded 𝕜 (f '' s) ↔ ∃ r : ℝ, ∀ (x : E') (hx : x ∈ s), ‖f x‖ ≤ r := +by simp_rw [is_vonN_bounded_iff', set.ball_image_iff] + +/-- In a normed space, the von Neumann bornology (`bornology.vonN_bornology`) is equal to the +metric bornology. -/ +lemma vonN_bornology_eq : bornology.vonN_bornology 𝕜 E = pseudo_metric_space.to_bornology := +begin + rw bornology.ext_iff_is_bounded, + intro s, + rw bornology.is_bounded_iff_is_vonN_bounded, + exact is_vonN_bounded_iff 𝕜 E s +end + +variable (𝕜) + +lemma is_bounded_iff_subset_smul_ball {s : set E} : + bornology.is_bounded s ↔ ∃ a : 𝕜, s ⊆ a • metric.ball 0 1 := +begin + rw ← is_vonN_bounded_iff 𝕜, + split, + { intros h, + rcases h (metric.ball_mem_nhds 0 zero_lt_one) with ⟨ρ, hρ, hρball⟩, + rcases normed_field.exists_lt_norm 𝕜 ρ with ⟨a, ha⟩, + exact ⟨a, hρball a ha.le⟩ }, + { rintros ⟨a, ha⟩, + exact ((is_vonN_bounded_ball 𝕜 E 1).image (a • 1 : E →L[𝕜] E)).subset ha } +end + +lemma is_bounded_iff_subset_smul_closed_ball {s : set E} : + bornology.is_bounded s ↔ ∃ a : 𝕜, s ⊆ a • metric.closed_ball 0 1 := +begin + split, + { rw is_bounded_iff_subset_smul_ball 𝕜, + exact exists_imp_exists + (λ a ha, ha.trans $ set.smul_set_mono $ metric.ball_subset_closed_ball) }, + { rw ← is_vonN_bounded_iff 𝕜, + rintros ⟨a, ha⟩, + exact ((is_vonN_bounded_closed_ball 𝕜 E 1).image (a • 1 : E →L[𝕜] E)).subset ha } +end + +end normed_space + +end vonN_bornology_eq_metric diff --git a/src/analysis/locally_convex/continuous_of_bounded.lean b/src/analysis/locally_convex/continuous_of_bounded.lean new file mode 100644 index 0000000000000..d21f6381b2046 --- /dev/null +++ b/src/analysis/locally_convex/continuous_of_bounded.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2022 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll +-/ +import analysis.locally_convex.bounded +import data.is_R_or_C.basic + +/-! +# Continuity and Von Neumann boundedness + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This files proves that for `E` and `F` two topological vector spaces over `ℝ` or `ℂ`, +if `E` is first countable, then every locally bounded linear map `E →ₛₗ[σ] F` is continuous +(this is `linear_map.continuous_of_locally_bounded`). + +We keep this file separate from `analysis/locally_convex/bounded` in order not to import +`analysis/normed_space/is_R_or_C` there, because defining the strong topology on the space of +continuous linear maps will require importing `analysis/locally_convex/bounded` in +`analysis/normed_space/operator_norm`. + +## References + +* [Bourbaki, *Topological Vector Spaces*][bourbaki1987] + +-/ + +open topological_space bornology filter +open_locale topology pointwise + +variables {𝕜 𝕜' E F : Type*} +variables [add_comm_group E] [uniform_space E] [uniform_add_group E] +variables [add_comm_group F] [uniform_space F] + +section nontrivially_normed_field + +variables [uniform_add_group F] +variables [nontrivially_normed_field 𝕜] [module 𝕜 E] [module 𝕜 F] [has_continuous_smul 𝕜 E] + +/-- Construct a continuous linear map from a linear map `f : E →ₗ[𝕜] F` and the existence of a +neighborhood of zero that gets mapped into a bounded set in `F`. -/ +def linear_map.clm_of_exists_bounded_image (f : E →ₗ[𝕜] F) + (h : ∃ (V : set E) (hV : V ∈ 𝓝 (0 : E)), bornology.is_vonN_bounded 𝕜 (f '' V)) : E →L[𝕜] F := +⟨f, begin + -- It suffices to show that `f` is continuous at `0`. + refine continuous_of_continuous_at_zero f _, + rw [continuous_at_def, f.map_zero], + intros U hU, + -- Continuity means that `U ∈ 𝓝 0` implies that `f ⁻¹' U ∈ 𝓝 0`. + rcases h with ⟨V, hV, h⟩, + rcases h hU with ⟨r, hr, h⟩, + rcases normed_field.exists_lt_norm 𝕜 r with ⟨x, hx⟩, + specialize h x hx.le, + -- After unfolding all the definitions, we know that `f '' V ⊆ x • U`. We use this to show the + -- inclusion `x⁻¹ • V ⊆ f⁻¹' U`. + have x_ne := norm_pos_iff.mp (hr.trans hx), + have : x⁻¹ • V ⊆ f⁻¹' U := + calc x⁻¹ • V ⊆ x⁻¹ • (f⁻¹' (f '' V)) : set.smul_set_mono (set.subset_preimage_image ⇑f V) + ... ⊆ x⁻¹ • (f⁻¹' (x • U)) : set.smul_set_mono (set.preimage_mono h) + ... = f⁻¹' (x⁻¹ • (x • U)) : + by ext; simp only [set.mem_inv_smul_set_iff₀ x_ne, set.mem_preimage, linear_map.map_smul] + ... ⊆ f⁻¹' U : by rw inv_smul_smul₀ x_ne _, + -- Using this inclusion, it suffices to show that `x⁻¹ • V` is in `𝓝 0`, which is trivial. + refine mem_of_superset _ this, + convert set_smul_mem_nhds_smul hV (inv_ne_zero x_ne), + exact (smul_zero _).symm, +end⟩ + +lemma linear_map.clm_of_exists_bounded_image_coe {f : E →ₗ[𝕜] F} + {h : ∃ (V : set E) (hV : V ∈ 𝓝 (0 : E)), bornology.is_vonN_bounded 𝕜 (f '' V)} : + (f.clm_of_exists_bounded_image h : E →ₗ[𝕜] F) = f := rfl + +@[simp] lemma linear_map.clm_of_exists_bounded_image_apply {f : E →ₗ[𝕜] F} + {h : ∃ (V : set E) (hV : V ∈ 𝓝 (0 : E)), bornology.is_vonN_bounded 𝕜 (f '' V)} {x : E} : + f.clm_of_exists_bounded_image h x = f x := rfl + +end nontrivially_normed_field + +section is_R_or_C + +open topological_space bornology + +variables [first_countable_topology E] +variables [is_R_or_C 𝕜] [module 𝕜 E] [has_continuous_smul 𝕜 E] +variables [is_R_or_C 𝕜'] [module 𝕜' F] [has_continuous_smul 𝕜' F] +variables {σ : 𝕜 →+* 𝕜'} + +lemma linear_map.continuous_at_zero_of_locally_bounded (f : E →ₛₗ[σ] F) + (hf : ∀ (s : set E) (hs : is_vonN_bounded 𝕜 s), is_vonN_bounded 𝕜' (f '' s)) : + continuous_at f 0 := +begin + -- Assume that f is not continuous at 0 + by_contradiction, + -- We use a decreasing balanced basis for 0 : E and a balanced basis for 0 : F + -- and reformulate non-continuity in terms of these bases + rcases (nhds_basis_balanced 𝕜 E).exists_antitone_subbasis with ⟨b, bE1, bE⟩, + simp only [id.def] at bE, + have bE' : (𝓝 (0 : E)).has_basis (λ (x : ℕ), x ≠ 0) (λ n : ℕ, (n : 𝕜)⁻¹ • b n) := + begin + refine bE.1.to_has_basis _ _, + { intros n _, + use n+1, + simp only [ne.def, nat.succ_ne_zero, not_false_iff, nat.cast_add, nat.cast_one, true_and], + -- `b (n + 1) ⊆ b n` follows from `antitone`. + have h : b (n + 1) ⊆ b n := bE.2 (by simp), + refine subset_trans _ h, + rintros y ⟨x, hx, hy⟩, + -- Since `b (n + 1)` is balanced `(n+1)⁻¹ b (n + 1) ⊆ b (n + 1)` + rw ←hy, + refine (bE1 (n+1)).2.smul_mem _ hx, + have h' : 0 < (n : ℝ) + 1 := n.cast_add_one_pos, + rw [norm_inv, ←nat.cast_one, ←nat.cast_add, is_R_or_C.norm_nat_cast, nat.cast_add, + nat.cast_one, inv_le h' zero_lt_one], + simp }, + intros n hn, + -- The converse direction follows from continuity of the scalar multiplication + have hcont : continuous_at (λ (x : E), (n : 𝕜) • x) 0 := + (continuous_const_smul (n : 𝕜)).continuous_at, + simp only [continuous_at, map_zero, smul_zero] at hcont, + rw bE.1.tendsto_left_iff at hcont, + rcases hcont (b n) (bE1 n).1 with ⟨i, _, hi⟩, + refine ⟨i, trivial, λ x hx, ⟨(n : 𝕜) • x, hi hx, _⟩⟩, + simp [←mul_smul, hn], + end, + rw [continuous_at, map_zero, bE'.tendsto_iff (nhds_basis_balanced 𝕜' F)] at h, + push_neg at h, + rcases h with ⟨V, ⟨hV, hV'⟩, h⟩, + simp only [id.def, forall_true_left] at h, + -- There exists `u : ℕ → E` such that for all `n : ℕ` we have `u n ∈ n⁻¹ • b n` and `f (u n) ∉ V` + choose! u hu hu' using h, + -- The sequence `(λ n, n • u n)` converges to `0` + have h_tendsto : tendsto (λ n : ℕ, (n : 𝕜) • u n) at_top (𝓝 (0 : E)) := + begin + apply bE.tendsto, + intros n, + by_cases h : n = 0, + { rw [h, nat.cast_zero, zero_smul], + refine mem_of_mem_nhds (bE.1.mem_of_mem $ by triv) }, + rcases hu n h with ⟨y, hy, hu1⟩, + convert hy, + rw [←hu1, ←mul_smul], + simp only [h, mul_inv_cancel, ne.def, nat.cast_eq_zero, not_false_iff, one_smul], + end, + -- The image `(λ n, n • u n)` is von Neumann bounded: + have h_bounded : is_vonN_bounded 𝕜 (set.range (λ n : ℕ, (n : 𝕜) • u n)) := + h_tendsto.cauchy_seq.totally_bounded_range.is_vonN_bounded 𝕜, + -- Since `range u` is bounded it absorbs `V` + rcases hf _ h_bounded hV with ⟨r, hr, h'⟩, + cases exists_nat_gt r with n hn, + -- We now find a contradiction between `f (u n) ∉ V` and the absorbing property + have h1 : r ≤ ‖(n : 𝕜')‖ := + by { rw [is_R_or_C.norm_nat_cast], exact hn.le }, + have hn' : 0 < ‖(n : 𝕜')‖ := lt_of_lt_of_le hr h1, + rw [norm_pos_iff, ne.def, nat.cast_eq_zero] at hn', + have h'' : f (u n) ∈ V := + begin + simp only [set.image_subset_iff] at h', + specialize h' (n : 𝕜') h1 (set.mem_range_self n), + simp only [set.mem_preimage, linear_map.map_smulₛₗ, map_nat_cast] at h', + rcases h' with ⟨y, hy, h'⟩, + apply_fun (λ y : F, (n : 𝕜')⁻¹ • y) at h', + simp only [hn', inv_smul_smul₀, ne.def, nat.cast_eq_zero, not_false_iff] at h', + rwa ←h', + end, + exact hu' n hn' h'', +end + +/-- If `E` is first countable, then every locally bounded linear map `E →ₛₗ[σ] F` is continuous. -/ +lemma linear_map.continuous_of_locally_bounded [uniform_add_group F] (f : E →ₛₗ[σ] F) + (hf : ∀ (s : set E) (hs : is_vonN_bounded 𝕜 s), is_vonN_bounded 𝕜' (f '' s)) : + continuous f := +(uniform_continuous_of_continuous_at_zero f $ f.continuous_at_zero_of_locally_bounded hf).continuous + +end is_R_or_C diff --git a/src/analysis/locally_convex/polar.lean b/src/analysis/locally_convex/polar.lean index 6c2d73ba3e9be..a52213b20468d 100644 --- a/src/analysis/locally_convex/polar.lean +++ b/src/analysis/locally_convex/polar.lean @@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Moritz Doll, Kalle Kytölä -/ -import analysis.normed.normed_field -import analysis.convex.basic +import analysis.normed.field.basic import linear_algebra.sesquilinear_form import topology.algebra.module.weak_dual /-! # Polar set +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define the polar set. There are different notions of the polar, we will define the *absolute polar*. The advantage over the real polar is that we can define the absolute polar for any bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`, where `𝕜` is a normed commutative ring and @@ -38,6 +40,7 @@ polar variables {𝕜 E F : Type*} +open_locale topology namespace linear_map @@ -47,23 +50,23 @@ variables [normed_comm_ring 𝕜] [add_comm_monoid E] [add_comm_monoid F] variables [module 𝕜 E] [module 𝕜 F] variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) -/-- The (absolute) polar of `s : set E` is given by the set of all `y : F` such that `∥B x y∥ ≤ 1` +/-- The (absolute) polar of `s : set E` is given by the set of all `y : F` such that `‖B x y‖ ≤ 1` for all `x ∈ s`.-/ def polar (s : set E) : set F := - {y : F | ∀ x ∈ s, ∥B x y∥ ≤ 1 } + {y : F | ∀ x ∈ s, ‖B x y‖ ≤ 1 } lemma polar_mem_iff (s : set E) (y : F) : - y ∈ B.polar s ↔ ∀ x ∈ s, ∥B x y∥ ≤ 1 := iff.rfl + y ∈ B.polar s ↔ ∀ x ∈ s, ‖B x y‖ ≤ 1 := iff.rfl lemma polar_mem (s : set E) (y : F) (hy : y ∈ B.polar s) : - ∀ x ∈ s, ∥B x y∥ ≤ 1 := hy + ∀ x ∈ s, ‖B x y‖ ≤ 1 := hy @[simp] lemma zero_mem_polar (s : set E) : (0 : F) ∈ B.polar s := λ _ _, by simp only [map_zero, norm_zero, zero_le_one] lemma polar_eq_Inter {s : set E} : - B.polar s = ⋂ x ∈ s, {y : F | ∥B x y∥ ≤ 1} := + B.polar s = ⋂ x ∈ s, {y : F | ‖B x y‖ ≤ 1} := by { ext, simp only [polar_mem_iff, set.mem_Inter, set.mem_set_of_eq] } /-- The map `B.polar : set E → set F` forms an order-reversing Galois connection with @@ -102,7 +105,7 @@ end /-- The polar set is closed in the weak topology induced by `B.flip`. -/ lemma polar_weak_closed (s : set E) : - @is_closed _ (weak_bilin.topological_space B.flip) (B.polar s) := + is_closed[weak_bilin.topological_space B.flip] (B.polar s) := begin rw polar_eq_Inter, refine is_closed_Inter (λ x, is_closed_Inter (λ _, _)), @@ -111,9 +114,9 @@ end end normed_ring -section nondiscrete_normed_field +section nontrivially_normed_field -variables [nondiscrete_normed_field 𝕜] [add_comm_monoid E] [add_comm_monoid F] +variables [nontrivially_normed_field 𝕜] [add_comm_monoid E] [add_comm_monoid F] variables [module 𝕜 E] [module 𝕜 F] variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) @@ -124,13 +127,13 @@ begin refine ⟨by simp only [zero_mem_polar], λ y hy, h _ (λ x, _)⟩, refine norm_le_zero_iff.mp (le_of_forall_le_of_dense $ λ ε hε, _), rcases normed_field.exists_norm_lt 𝕜 hε with ⟨c, hc, hcε⟩, - calc ∥B x y∥ = ∥c∥ * ∥B (c⁻¹ • x) y∥ : + calc ‖B x y‖ = ‖c‖ * ‖B (c⁻¹ • x) y‖ : by rw [B.map_smul, linear_map.smul_apply, algebra.id.smul_eq_mul, norm_mul, norm_inv, mul_inv_cancel_left₀ hc.ne'] ... ≤ ε * 1 : mul_le_mul hcε.le (hy _ trivial) (norm_nonneg _) hε.le ... = ε : mul_one _ end -end nondiscrete_normed_field +end nontrivially_normed_field end linear_map diff --git a/src/analysis/locally_convex/strong_topology.lean b/src/analysis/locally_convex/strong_topology.lean new file mode 100644 index 0000000000000..24943723ea67b --- /dev/null +++ b/src/analysis/locally_convex/strong_topology.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2022 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anatole Dedecker +-/ +import topology.algebra.module.strong_topology +import topology.algebra.module.locally_convex + +/-! +# Local convexity of the strong topology + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove that the strong topology on `E →L[ℝ] F` is locally convex provided that `F` is +locally convex. + +## References + +* [N. Bourbaki, *Topological Vector Spaces*][bourbaki1987] + +## Todo + +* Characterization in terms of seminorms + +## Tags + +locally convex, bounded convergence +-/ + +open_locale topology uniform_convergence + +variables {R 𝕜₁ 𝕜₂ E F : Type*} + +namespace continuous_linear_map + +variables [add_comm_group E] [topological_space E] + [add_comm_group F] [topological_space F] [topological_add_group F] + +section general + +variables (R) +variables [ordered_semiring R] +variables [normed_field 𝕜₁] [normed_field 𝕜₂] [module 𝕜₁ E] [module 𝕜₂ F] {σ : 𝕜₁ →+* 𝕜₂} +variables [module R F] [has_continuous_const_smul R F] [locally_convex_space R F] + [smul_comm_class 𝕜₂ R F] + +lemma strong_topology.locally_convex_space (𝔖 : set (set E)) (h𝔖₁ : 𝔖.nonempty) + (h𝔖₂ : directed_on (⊆) 𝔖) : + @locally_convex_space R (E →SL[σ] F) _ _ _ (strong_topology σ F 𝔖) := +begin + letI : topological_space (E →SL[σ] F) := strong_topology σ F 𝔖, + haveI : topological_add_group (E →SL[σ] F) := strong_topology.topological_add_group _ _ _, + refine locally_convex_space.of_basis_zero _ _ _ _ + (strong_topology.has_basis_nhds_zero_of_basis _ _ _ h𝔖₁ h𝔖₂ + (locally_convex_space.convex_basis_zero R F)) _, + rintros ⟨S, V⟩ ⟨hS, hVmem, hVconvex⟩ f hf g hg a b ha hb hab x hx, + exact hVconvex (hf x hx) (hg x hx) ha hb hab, +end + +end general + +section bounded_sets + +variables [ordered_semiring R] +variables [normed_field 𝕜₁] [normed_field 𝕜₂] [module 𝕜₁ E] [module 𝕜₂ F] {σ : 𝕜₁ →+* 𝕜₂} +variables [module R F] [has_continuous_const_smul R F] [locally_convex_space R F] + [smul_comm_class 𝕜₂ R F] + +instance : locally_convex_space R (E →SL[σ] F) := +strong_topology.locally_convex_space R _ ⟨∅, bornology.is_vonN_bounded_empty 𝕜₁ E⟩ + (directed_on_of_sup_mem $ λ _ _, bornology.is_vonN_bounded.union) + +end bounded_sets + +end continuous_linear_map diff --git a/src/analysis/locally_convex/weak_dual.lean b/src/analysis/locally_convex/weak_dual.lean index 164e1d336a29c..7a93c7c14106e 100644 --- a/src/analysis/locally_convex/weak_dual.lean +++ b/src/analysis/locally_convex/weak_dual.lean @@ -4,19 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Moritz Doll -/ import topology.algebra.module.weak_dual -import analysis.normed.normed_field +import analysis.normed.field.basic import analysis.locally_convex.with_seminorms /-! # Weak Dual in Topological Vector Spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove that the weak topology induced by a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜` is locally -convex and we explicit give a neighborhood basis in terms of the family of seminorms `λ x, ∥B x y∥` +convex and we explicit give a neighborhood basis in terms of the family of seminorms `λ x, ‖B x y‖` for `y : F`. ## Main definitions -* `linear_map.to_seminorm`: turn a linear form `f : E →ₗ[𝕜] 𝕜` into a seminorm `λ x, ∥f x∥`. +* `linear_map.to_seminorm`: turn a linear form `f : E →ₗ[𝕜] 𝕜` into a seminorm `λ x, ‖f x‖`. * `linear_map.to_seminorm_family`: turn a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜` into a map `F → seminorm 𝕜 E`. @@ -39,7 +42,7 @@ weak dual, seminorm variables {𝕜 E F ι : Type*} -open_locale topological_space +open_locale topology section bilin_form @@ -48,20 +51,18 @@ namespace linear_map variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [add_comm_group F] [module 𝕜 F] /-- Construct a seminorm from a linear form `f : E →ₗ[𝕜] 𝕜` over a normed field `𝕜` by -`λ x, ∥f x∥` -/ +`λ x, ‖f x‖` -/ def to_seminorm (f : E →ₗ[𝕜] 𝕜) : seminorm 𝕜 E := -{ to_fun := λ x, ∥f x∥, - smul' := λ a x, by simp only [map_smulₛₗ, ring_hom.id_apply, smul_eq_mul, norm_mul], - triangle' := λ x x', by { simp only [map_add, add_apply], exact norm_add_le _ _ } } +(norm_seminorm 𝕜 𝕜).comp f lemma coe_to_seminorm {f : E →ₗ[𝕜] 𝕜} : - ⇑f.to_seminorm = λ x, ∥f x∥ := rfl + ⇑f.to_seminorm = λ x, ‖f x‖ := rfl @[simp] lemma to_seminorm_apply {f : E →ₗ[𝕜] 𝕜} {x : E} : - f.to_seminorm x = ∥f x∥ := rfl + f.to_seminorm x = ‖f x‖ := rfl lemma to_seminorm_ball_zero {f : E →ₗ[𝕜] 𝕜} {r : ℝ} : - seminorm.ball f.to_seminorm 0 r = { x : E | ∥f x∥ < r} := + seminorm.ball f.to_seminorm 0 r = { x : E | ‖f x‖ < r} := by simp only [seminorm.ball_zero_eq, to_seminorm_apply] lemma to_seminorm_comp (f : F →ₗ[𝕜] 𝕜) (g : E →ₗ[𝕜] F) : @@ -73,7 +74,7 @@ def to_seminorm_family (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : seminorm_famil λ y, (B.flip y).to_seminorm @[simp] lemma to_seminorm_family_apply {B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜} {x y} : - (B.to_seminorm_family y) x = ∥B x y∥ := rfl + (B.to_seminorm_family y) x = ‖B x y‖ := rfl end linear_map @@ -100,7 +101,7 @@ begin simp only [id.def], let U' := hU₁.to_finset, by_cases hU₃ : U.fst.nonempty, - { have hU₃' : U'.nonempty := (set.finite.to_finset.nonempty hU₁).mpr hU₃, + { have hU₃' : U'.nonempty := hU₁.to_finset_nonempty.mpr hU₃, refine ⟨(U'.sup p).ball 0 $ U'.inf' hU₃' U.snd, p.basis_sets_mem _ $ (finset.lt_inf'_iff _).2 $ λ y hy, hU₂ y $ (hU₁.mem_to_finset).mp hy, λ x hx y hy, _⟩, simp only [set.mem_preimage, set.mem_pi, mem_ball_zero_iff], @@ -125,8 +126,8 @@ begin exact hx y hy, end -instance : with_seminorms - (linear_map.to_seminorm_family B : F → seminorm 𝕜 (weak_bilin B)) := +lemma linear_map.weak_bilin_with_seminorms (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : + with_seminorms (linear_map.to_seminorm_family B : F → seminorm 𝕜 (weak_bilin B)) := seminorm_family.with_seminorms_of_has_basis _ B.has_basis_weak_bilin end topology @@ -137,6 +138,6 @@ variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [add_comm_group variables [nonempty ι] [normed_space ℝ 𝕜] [module ℝ E] [is_scalar_tower ℝ 𝕜 E] instance {B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜} : locally_convex_space ℝ (weak_bilin B) := -seminorm_family.to_locally_convex_space B.to_seminorm_family +(B.weak_bilin_with_seminorms).to_locally_convex_space end locally_convex diff --git a/src/analysis/locally_convex/with_seminorms.lean b/src/analysis/locally_convex/with_seminorms.lean index 12bef187ce7d9..38e1afa83d665 100644 --- a/src/analysis/locally_convex/with_seminorms.lean +++ b/src/analysis/locally_convex/with_seminorms.lean @@ -6,10 +6,15 @@ Authors: Moritz Doll, Anatole Dedecker import analysis.seminorm import analysis.locally_convex.bounded +import topology.algebra.filter_basis +import topology.algebra.module.locally_convex /-! # Topology induced by a family of seminorms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `seminorm_family.basis_sets`: The set of open seminorm balls for a family of seminorms. @@ -19,23 +24,35 @@ bounded by a finite number of seminorms in `E`. ## Main statements -* `continuous_from_bounded`: A bounded linear map `f : E →ₗ[𝕜] F` is continuous. -* `seminorm_family.to_locally_convex_space`: A space equipped with a family of seminorms is locally +* `with_seminorms.to_locally_convex_space`: A space equipped with a family of seminorms is locally convex. +* `with_seminorms.first_countable`: A space is first countable if it's topology is induced by a +countable family of seminorms. + +## Continuity of semilinear maps + +If `E` and `F` are topological vector space with the topology induced by a family of seminorms, then +we have a direct method to prove that a linear map is continuous: +* `seminorm.continuous_from_bounded`: A bounded linear map `f : E →ₗ[𝕜] F` is continuous. -## TODO +If the topology of a space `E` is induced by a family of seminorms, then we can characterize von +Neumann boundedness in terms of that seminorm family. Together with +`linear_map.continuous_of_locally_bounded` this gives general criterion for continuity. -Show that for any locally convex space there exist seminorms that induce the topology. +* `with_seminorms.is_vonN_bounded_iff_finset_seminorm_bounded` +* `with_seminorms.is_vonN_bounded_iff_seminorm_bounded` +* `with_seminorms.image_is_vonN_bounded_iff_finset_seminorm_bounded` +* `with_seminorms.image_is_vonN_bounded_iff_seminorm_bounded` ## Tags seminorm, locally convex -/ -open normed_field set seminorm -open_locale big_operators nnreal pointwise topological_space +open normed_field set seminorm topological_space +open_locale big_operators nnreal pointwise topology -variables {𝕜 E F G ι ι' : Type*} +variables {𝕜 𝕜₂ 𝕝 𝕝₂ E F G ι ι' : Type*} section filter_basis @@ -96,7 +113,7 @@ lemma basis_sets_zero (U) (hU : U ∈ p.basis_sets) : (0 : E) ∈ U := begin rcases p.basis_sets_iff.mp hU with ⟨ι', r, hr, hU⟩, - rw [hU, mem_ball_zero, (ι'.sup p).zero], + rw [hU, mem_ball_zero, map_zero], exact hr, end @@ -128,12 +145,12 @@ lemma basis_sets_smul_right (v : E) (U : set E) begin rcases p.basis_sets_iff.mp hU with ⟨s, r, hr, hU⟩, rw [hU, filter.eventually_iff], - simp_rw [(s.sup p).mem_ball_zero, (s.sup p).smul], + simp_rw [(s.sup p).mem_ball_zero, map_smul_eq_mul], by_cases h : 0 < (s.sup p) v, { simp_rw (lt_div_iff h).symm, rw ←_root_.ball_zero_eq, exact metric.ball_mem_nhds 0 (div_pos hr h) }, - simp_rw [le_antisymm (not_lt.mp h) ((s.sup p).nonneg v), mul_zero, hr], + simp_rw [le_antisymm (not_lt.mp h) (map_nonneg _ v), mul_zero, hr], exact is_open.mem_nhds is_open_univ (mem_univ 0), end @@ -158,10 +175,10 @@ begin rw hU, by_cases h : x ≠ 0, { rw [(s.sup p).smul_ball_preimage 0 r x h, smul_zero], - use (s.sup p).ball 0 (r / ∥x∥), + use (s.sup p).ball 0 (r / ‖x‖), exact ⟨p.basis_sets_mem s (div_pos hr (norm_pos_iff.mpr h)), subset.rfl⟩ }, refine ⟨(s.sup p).ball 0 r, p.basis_sets_mem s hr, _⟩, - simp only [not_ne_iff.mp h, subset_def, mem_ball_zero, hr, mem_univ, seminorm.zero, + simp only [not_ne_iff.mp h, subset_def, mem_ball_zero, hr, mem_univ, map_zero, implies_true_iff, preimage_const_of_mem, zero_smul], end @@ -199,55 +216,50 @@ section bounded namespace seminorm -variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [add_comm_group F] [module 𝕜 F] +variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables [normed_field 𝕜₂] [add_comm_group F] [module 𝕜₂ F] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] -- Todo: This should be phrased entirely in terms of the von Neumann bornology. /-- The proposition that a linear map is bounded between spaces with families of seminorms. -/ -def is_bounded (p : ι → seminorm 𝕜 E) (q : ι' → seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : Prop := - ∀ i, ∃ s : finset ι, ∃ C : ℝ≥0, C ≠ 0 ∧ (q i).comp f ≤ C • s.sup p +def is_bounded (p : ι → seminorm 𝕜 E) (q : ι' → seminorm 𝕜₂ F) (f : E →ₛₗ[σ₁₂] F) : Prop := + ∀ i, ∃ s : finset ι, ∃ C : ℝ≥0, (q i).comp f ≤ C • s.sup p lemma is_bounded_const (ι' : Type*) [nonempty ι'] - {p : ι → seminorm 𝕜 E} {q : seminorm 𝕜 F} (f : E →ₗ[𝕜] F) : - is_bounded p (λ _ : ι', q) f ↔ ∃ (s : finset ι) C : ℝ≥0, C ≠ 0 ∧ q.comp f ≤ C • s.sup p := + {p : ι → seminorm 𝕜 E} {q : seminorm 𝕜₂ F} (f : E →ₛₗ[σ₁₂] F) : + is_bounded p (λ _ : ι', q) f ↔ ∃ (s : finset ι) C : ℝ≥0, q.comp f ≤ C • s.sup p := by simp only [is_bounded, forall_const] lemma const_is_bounded (ι : Type*) [nonempty ι] - {p : seminorm 𝕜 E} {q : ι' → seminorm 𝕜 F} (f : E →ₗ[𝕜] F) : - is_bounded (λ _ : ι, p) q f ↔ ∀ i, ∃ C : ℝ≥0, C ≠ 0 ∧ (q i).comp f ≤ C • p := + {p : seminorm 𝕜 E} {q : ι' → seminorm 𝕜₂ F} (f : E →ₛₗ[σ₁₂] F) : + is_bounded (λ _ : ι, p) q f ↔ ∀ i, ∃ C : ℝ≥0, (q i).comp f ≤ C • p := begin split; intros h i, - { rcases h i with ⟨s, C, hC, h⟩, - exact ⟨C, hC, le_trans h (smul_le_smul (finset.sup_le (λ _ _, le_rfl)) le_rfl)⟩ }, + { rcases h i with ⟨s, C, h⟩, + exact ⟨C, le_trans h (smul_le_smul (finset.sup_le (λ _ _, le_rfl)) le_rfl)⟩ }, use [{classical.arbitrary ι}], simp only [h, finset.sup_singleton], end -lemma is_bounded_sup {p : ι → seminorm 𝕜 E} {q : ι' → seminorm 𝕜 F} - {f : E →ₗ[𝕜] F} (hf : is_bounded p q f) (s' : finset ι') : - ∃ (C : ℝ≥0) (s : finset ι), 0 < C ∧ (s'.sup q).comp f ≤ C • (s.sup p) := +lemma is_bounded_sup {p : ι → seminorm 𝕜 E} {q : ι' → seminorm 𝕜₂ F} + {f : E →ₛₗ[σ₁₂] F} (hf : is_bounded p q f) (s' : finset ι') : + ∃ (C : ℝ≥0) (s : finset ι), (s'.sup q).comp f ≤ C • (s.sup p) := begin classical, - by_cases hs' : ¬s'.nonempty, - { refine ⟨1, ∅, zero_lt_one, _⟩, - rw [finset.not_nonempty_iff_eq_empty.mp hs', finset.sup_empty, seminorm.bot_eq_zero, zero_comp], - exact seminorm.nonneg _ }, - rw not_not at hs', + obtain rfl | hs' := s'.eq_empty_or_nonempty, + { exact ⟨1, ∅, by simp [seminorm.bot_eq_zero]⟩ }, choose fₛ fC hf using hf, use [s'.card • s'.sup fC, finset.bUnion s' fₛ], - split, - { refine nsmul_pos _ (ne_of_gt (finset.nonempty.card_pos hs')), - cases finset.nonempty.bex hs' with j hj, - exact lt_of_lt_of_le (zero_lt_iff.mpr (and.elim_left (hf j))) (finset.le_sup hj) }, have hs : ∀ i : ι', i ∈ s' → (q i).comp f ≤ s'.sup fC • ((finset.bUnion s' fₛ).sup p) := begin intros i hi, - refine le_trans (and.elim_right (hf i)) (smul_le_smul _ (finset.le_sup hi)), + refine (hf i).trans (smul_le_smul _ (finset.le_sup hi)), exact finset.sup_mono (finset.subset_bUnion_of_mem fₛ hi), end, - refine le_trans (comp_mono f (finset_sup_le_sum q s')) _, + refine (comp_mono f (finset_sup_le_sum q s')).trans _, simp_rw [←pullback_apply, add_monoid_hom.map_sum, pullback_apply], - refine le_trans (finset.sum_le_sum hs) _, + refine (finset.sum_le_sum hs).trans _, rw [finset.sum_const, smul_assoc], exact le_rfl, end @@ -261,35 +273,149 @@ section topology variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι] /-- The proposition that the topology of `E` is induced by a family of seminorms `p`. -/ -class with_seminorms (p : seminorm_family 𝕜 E ι) [t : topological_space E] : Prop := +structure with_seminorms (p : seminorm_family 𝕜 E ι) [t : topological_space E] : Prop := (topology_eq_with_seminorms : t = p.module_filter_basis.topology) -lemma seminorm_family.with_seminorms_eq (p : seminorm_family 𝕜 E ι) [t : topological_space E] - [with_seminorms p] : t = p.module_filter_basis.topology := -with_seminorms.topology_eq_with_seminorms +lemma with_seminorms.with_seminorms_eq {p : seminorm_family 𝕜 E ι} [t : topological_space E] + (hp : with_seminorms p) : t = p.module_filter_basis.topology := hp.1 variables [topological_space E] -variables (p : seminorm_family 𝕜 E ι) [with_seminorms p] +variables {p : seminorm_family 𝕜 E ι} -lemma seminorm_family.has_basis : (𝓝 (0 : E)).has_basis +lemma with_seminorms.topological_add_group (hp : with_seminorms p) : topological_add_group E := +begin + rw hp.with_seminorms_eq, + exact add_group_filter_basis.is_topological_add_group _ +end + +lemma with_seminorms.has_basis (hp : with_seminorms p) : (𝓝 (0 : E)).has_basis (λ (s : set E), s ∈ p.basis_sets) id := begin - rw (congr_fun (congr_arg (@nhds E) p.with_seminorms_eq) 0), + rw (congr_fun (congr_arg (@nhds E) hp.1) 0), exact add_group_filter_basis.nhds_zero_has_basis _, end + +lemma with_seminorms.has_basis_zero_ball (hp : with_seminorms p) : (𝓝 (0 : E)).has_basis + (λ sr : finset ι × ℝ, 0 < sr.2) (λ sr, (sr.1.sup p).ball 0 sr.2) := +begin + refine ⟨λ V, _⟩, + simp only [hp.has_basis.mem_iff, seminorm_family.basis_sets_iff, prod.exists], + split, + { rintros ⟨-, ⟨s, r, hr, rfl⟩, hV⟩, + exact ⟨s, r, hr, hV⟩ }, + { rintros ⟨s, r, hr, hV⟩, + exact ⟨_, ⟨s, r, hr, rfl⟩, hV⟩ } +end + +lemma with_seminorms.has_basis_ball (hp : with_seminorms p) {x : E} : (𝓝 (x : E)).has_basis + (λ sr : finset ι × ℝ, 0 < sr.2) (λ sr, (sr.1.sup p).ball x sr.2) := +begin + haveI : topological_add_group E := hp.topological_add_group, + rw [← map_add_left_nhds_zero], + convert (hp.has_basis_zero_ball.map ((+) x)), + ext sr : 1, + have : (sr.fst.sup p).ball (x +ᵥ 0) sr.snd = x +ᵥ (sr.fst.sup p).ball 0 sr.snd + := eq.symm (seminorm.vadd_ball (sr.fst.sup p)), + rwa [vadd_eq_add, add_zero] at this, +end + +/-- The `x`-neighbourhoods of a space whose topology is induced by a family of seminorms +are exactly the sets which contain seminorm balls around `x`.-/ +lemma with_seminorms.mem_nhds_iff (hp : with_seminorms p) (x : E) (U : set E) : + U ∈ nhds x ↔ ∃ (s : finset ι) (r > 0), (s.sup p).ball x r ⊆ U := +by rw [hp.has_basis_ball.mem_iff, prod.exists] + +/-- The open sets of a space whose topology is induced by a family of seminorms +are exactly the sets which contain seminorm balls around all of their points.-/ +lemma with_seminorms.is_open_iff_mem_balls (hp : with_seminorms p) (U : set E) : + is_open U ↔ ∀ x ∈ U, ∃ (s : finset ι) (r > 0), (s.sup p).ball x r ⊆ U := +by simp_rw [←with_seminorms.mem_nhds_iff hp _ U, is_open_iff_mem_nhds] + +/- Note that through the following lemmas, one also immediately has that separating families +of seminorms induce T₂ and T₃ topologies by `topological_add_group.t2_space` +and `topological_add_group.t3_space` -/ +/-- A separating family of seminorms induces a T₁ topology. -/ +lemma with_seminorms.t1_of_separating (hp : with_seminorms p) (h : ∀ x ≠ 0, ∃ i, p i x ≠ 0) : + t1_space E := +begin + haveI := hp.topological_add_group, + refine topological_add_group.t1_space _ _, + rw [← is_open_compl_iff, hp.is_open_iff_mem_balls], + rintros x (hx : x ≠ 0), + cases h x hx with i pi_nonzero, + refine ⟨{i}, p i x, by positivity, subset_compl_singleton_iff.mpr _⟩, + rw [finset.sup_singleton, mem_ball, zero_sub, map_neg_eq_map, not_lt] +end + +/-- A family of seminorms inducing a T₁ topology is separating. -/ +lemma with_seminorms.separating_of_t1 [t1_space E] (hp : with_seminorms p) (x : E) (hx : x ≠ 0) : + ∃ i, p i x ≠ 0 := +begin + have := ((t1_space_tfae E).out 0 9).mp infer_instance, + by_contra' h, + refine hx (this _), + rw hp.has_basis_zero_ball.specializes_iff, + rintros ⟨s, r⟩ (hr : 0 < r), + simp only [ball_finset_sup_eq_Inter _ _ _ hr, mem_Inter₂, mem_ball_zero, h, hr, forall_true_iff], +end + +/-- A family of seminorms is separating iff it induces a T₁ topology. -/ +lemma with_seminorms.separating_iff_t1 (hp : with_seminorms p) : + (∀ x ≠ 0, ∃ i, p i x ≠ 0) ↔ t1_space E := +begin + refine ⟨with_seminorms.t1_of_separating hp, _⟩, + introI, + exact with_seminorms.separating_of_t1 hp, +end + end topology +section tendsto + +variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι] [topological_space E] +variables {p : seminorm_family 𝕜 E ι} + +/-- Convergence along filters for `with_seminorms`. + +Variant with `finset.sup`. -/ +lemma with_seminorms.tendsto_nhds' (hp : with_seminorms p) (u : F → E) {f : filter F} (y₀ : E) : + filter.tendsto u f (𝓝 y₀) ↔ ∀ (s : finset ι) ε, 0 < ε → ∀ᶠ x in f, s.sup p (u x - y₀) < ε := +by simp [hp.has_basis_ball.tendsto_right_iff] + +/-- Convergence along filters for `with_seminorms`. -/ +lemma with_seminorms.tendsto_nhds (hp : with_seminorms p) (u : F → E) {f : filter F} (y₀ : E) : + filter.tendsto u f (𝓝 y₀) ↔ ∀ i ε, 0 < ε → ∀ᶠ x in f, p i (u x - y₀) < ε := +begin + rw hp.tendsto_nhds' u y₀, + exact ⟨λ h i, by simpa only [finset.sup_singleton] using h {i}, + λ h s ε hε, (s.eventually_all.2 $ λ i _, h i ε hε).mono (λ _, finset_sup_apply_lt hε)⟩, +end + +variables [semilattice_sup F] [nonempty F] + +/-- Limit `→ ∞` for `with_seminorms`. -/ +lemma with_seminorms.tendsto_nhds_at_top (hp : with_seminorms p) (u : F → E) (y₀ : E) : + filter.tendsto u filter.at_top (𝓝 y₀) ↔ ∀ i ε, 0 < ε → ∃ x₀, ∀ x, x₀ ≤ x → p i (u x - y₀) < ε := +begin + rw hp.tendsto_nhds u y₀, + exact forall₃_congr (λ _ _ _, filter.eventually_at_top), +end + +end tendsto + section topological_add_group variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] -variables [topological_space E] [topological_add_group E] +variables [t : topological_space E] [topological_add_group E] variables [nonempty ι] +include t + lemma seminorm_family.with_seminorms_of_nhds (p : seminorm_family 𝕜 E ι) (h : 𝓝 (0 : E) = p.module_filter_basis.to_filter_basis.filter) : with_seminorms p := begin - refine ⟨topological_add_group.ext (by apply_instance) + refine ⟨topological_add_group.ext infer_instance (p.add_group_filter_basis.is_topological_add_group) _⟩, rw add_group_filter_basis.nhds_zero_eq, exact h, @@ -310,17 +436,56 @@ begin exact add_group_filter_basis.nhds_zero_eq _, end +lemma with_seminorms.continuous_seminorm [nontrivially_normed_field 𝕝] + [module 𝕝 E] [has_continuous_const_smul 𝕝 E] {p : seminorm_family 𝕝 E ι} (hp : with_seminorms p) + (i : ι) : continuous (p i) := +begin + refine seminorm.continuous one_pos _, + rw [p.with_seminorms_iff_nhds_eq_infi.mp hp, ball_zero_eq_preimage_ball], + exact filter.mem_infi_of_mem i (filter.preimage_mem_comap $ metric.ball_mem_nhds _ one_pos) +end + +/-- The topology induced by a family of seminorms is exactly the infimum of the ones induced by +each seminorm individually. We express this as a characterization of `with_seminorms p`. -/ +lemma seminorm_family.with_seminorms_iff_topological_space_eq_infi (p : seminorm_family 𝕜 E ι) : + with_seminorms p ↔ t = ⨅ i, (p i).to_add_group_seminorm.to_seminormed_add_comm_group + .to_uniform_space.to_topological_space := +begin + rw [p.with_seminorms_iff_nhds_eq_infi, topological_add_group.ext_iff infer_instance + (topological_add_group_infi $ λ i, infer_instance), nhds_infi], + congrm (_ = ⨅ i, _), + exact @comap_norm_nhds_zero _ (p i).to_add_group_seminorm.to_seminormed_add_group, + all_goals {apply_instance} +end + +omit t + +/-- The uniform structure induced by a family of seminorms is exactly the infimum of the ones +induced by each seminorm individually. We express this as a characterization of +`with_seminorms p`. -/ +lemma seminorm_family.with_seminorms_iff_uniform_space_eq_infi [u : uniform_space E] + [uniform_add_group E] (p : seminorm_family 𝕜 E ι) : + with_seminorms p ↔ u = ⨅ i, (p i).to_add_group_seminorm.to_seminormed_add_comm_group + .to_uniform_space := +begin + rw [p.with_seminorms_iff_nhds_eq_infi, uniform_add_group.ext_iff infer_instance + (uniform_add_group_infi $ λ i, infer_instance), to_topological_space_infi, nhds_infi], + congrm (_ = ⨅ i, _), + exact @comap_norm_nhds_zero _ (p i).to_add_group_seminorm.to_seminormed_add_group, + all_goals {apply_instance} +end + end topological_add_group section normed_space /-- The topology of a `normed_space 𝕜 E` is induced by the seminorm `norm_seminorm 𝕜 E`. -/ -instance norm_with_seminorms (𝕜 E) [normed_field 𝕜] [semi_normed_group E] [normed_space 𝕜 E] : +lemma norm_with_seminorms (𝕜 E) [normed_field 𝕜] [seminormed_add_comm_group E] [normed_space 𝕜 E] : with_seminorms (λ (_ : fin 1), norm_seminorm 𝕜 E) := begin let p : seminorm_family 𝕜 E (fin 1) := λ _, norm_seminorm 𝕜 E, - refine ⟨topological_add_group.ext normed_top_group - (p.add_group_filter_basis.is_topological_add_group) _⟩, + refine ⟨seminormed_add_comm_group.to_topological_add_group.ext + p.add_group_filter_basis.is_topological_add_group _⟩, refine filter.has_basis.eq_of_same_basis metric.nhds_basis_ball _, rw ←ball_norm_seminorm 𝕜 E, refine filter.has_basis.to_has_basis p.add_group_filter_basis.nhds_zero_has_basis _ @@ -337,16 +502,17 @@ end end normed_space -section nondiscrete_normed_field +section nontrivially_normed_field -variables [nondiscrete_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι] -variables (p : seminorm_family 𝕜 E ι) -variables [topological_space E] [with_seminorms p] +variables [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι] +variables {p : seminorm_family 𝕜 E ι} +variables [topological_space E] -lemma bornology.is_vonN_bounded_iff_finset_seminorm_bounded {s : set E} : +lemma with_seminorms.is_vonN_bounded_iff_finset_seminorm_bounded {s : set E} + (hp : with_seminorms p) : bornology.is_vonN_bounded 𝕜 s ↔ ∀ I : finset ι, ∃ r (hr : 0 < r), ∀ (x ∈ s), I.sup p x < r := begin - rw (p.has_basis).is_vonN_bounded_basis_iff, + rw (hp.has_basis).is_vonN_bounded_basis_iff, split, { intros h I, simp only [id.def] at h, @@ -354,8 +520,8 @@ begin rcases h with ⟨r, hr, h⟩, cases normed_field.exists_lt_norm 𝕜 r with a ha, specialize h a (le_of_lt ha), - rw [seminorm.smul_ball_zero (lt_trans hr ha), mul_one] at h, - refine ⟨∥a∥, lt_trans hr ha, _⟩, + rw [seminorm.smul_ball_zero (norm_pos_iff.1 $ hr.trans ha), mul_one] at h, + refine ⟨‖a‖, lt_trans hr ha, _⟩, intros x hx, specialize h hx, exact (finset.sup I p).mem_ball_zero.mp h }, @@ -368,10 +534,15 @@ begin exact (finset.sup I p).ball_zero_absorbs_ball_zero hr, end -lemma bornology.is_vonN_bounded_iff_seminorm_bounded {s : set E} : +lemma with_seminorms.image_is_vonN_bounded_iff_finset_seminorm_bounded (f : G → E) {s : set G} + (hp : with_seminorms p) : bornology.is_vonN_bounded 𝕜 (f '' s) ↔ + ∀ I : finset ι, ∃ r (hr : 0 < r), ∀ (x ∈ s), I.sup p (f x) < r := +by simp_rw [hp.is_vonN_bounded_iff_finset_seminorm_bounded, set.ball_image_iff] + +lemma with_seminorms.is_vonN_bounded_iff_seminorm_bounded {s : set E} (hp : with_seminorms p) : bornology.is_vonN_bounded 𝕜 s ↔ ∀ i : ι, ∃ r (hr : 0 < r), ∀ (x ∈ s), p i x < r := begin - rw bornology.is_vonN_bounded_iff_finset_seminorm_bounded p, + rw hp.is_vonN_bounded_iff_finset_seminorm_bounded, split, { intros hI i, convert hI {i}, @@ -390,53 +561,81 @@ begin exact ⟨1, zero_lt_one, λ _ _, zero_lt_one⟩, end -end nondiscrete_normed_field +lemma with_seminorms.image_is_vonN_bounded_iff_seminorm_bounded (f : G → E) {s : set G} + (hp : with_seminorms p) : + bornology.is_vonN_bounded 𝕜 (f '' s) ↔ ∀ i : ι, ∃ r (hr : 0 < r), ∀ (x ∈ s), p i (f x) < r := +by simp_rw [hp.is_vonN_bounded_iff_seminorm_bounded, set.ball_image_iff] + +end nontrivially_normed_field section continuous_bounded namespace seminorm -variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [add_comm_group F] [module 𝕜 F] +variables [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables [normed_field 𝕝] [module 𝕝 E] +variables [nontrivially_normed_field 𝕜₂] [add_comm_group F] [module 𝕜₂ F] +variables [normed_field 𝕝₂] [module 𝕝₂ F] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] +variables {τ₁₂ : 𝕝 →+* 𝕝₂} [ring_hom_isometric τ₁₂] variables [nonempty ι] [nonempty ι'] -lemma continuous_from_bounded (p : seminorm_family 𝕜 E ι) (q : seminorm_family 𝕜 F ι') - [uniform_space E] [uniform_add_group E] [with_seminorms p] - [uniform_space F] [uniform_add_group F] [with_seminorms q] - (f : E →ₗ[𝕜] F) (hf : seminorm.is_bounded p q f) : continuous f := -begin - refine uniform_continuous.continuous _, - refine add_monoid_hom.uniform_continuous_of_continuous_at_zero f.to_add_monoid_hom _, - rw [f.to_add_monoid_hom_coe, continuous_at_def, f.map_zero, p.with_seminorms_eq], - intros U hU, - rw [q.with_seminorms_eq, add_group_filter_basis.nhds_zero_eq, filter_basis.mem_filter_iff] at hU, - rcases hU with ⟨V, hV : V ∈ q.basis_sets, hU⟩, - rcases q.basis_sets_iff.mp hV with ⟨s₂, r, hr, hV⟩, - rw hV at hU, - rw [p.add_group_filter_basis.nhds_zero_eq, filter_basis.mem_filter_iff], - rcases (seminorm.is_bounded_sup hf s₂) with ⟨C, s₁, hC, hf⟩, - refine ⟨(s₁.sup p).ball 0 (r/C), p.basis_sets_mem _ (div_pos hr (nnreal.coe_pos.mpr hC)), _⟩, - refine subset.trans _ (preimage_mono hU), - simp_rw [←linear_map.map_zero f, ←ball_comp], +lemma continuous_of_continuous_comp {q : seminorm_family 𝕝₂ F ι'} + [topological_space E] [topological_add_group E] + [topological_space F] [topological_add_group F] (hq : with_seminorms q) + (f : E →ₛₗ[τ₁₂] F) (hf : ∀ i, continuous ((q i).comp f)) : continuous f := +begin + refine continuous_of_continuous_at_zero f _, + simp_rw [continuous_at, f.map_zero, q.with_seminorms_iff_nhds_eq_infi.mp hq, filter.tendsto_infi, + filter.tendsto_comap_iff], + intros i, + convert (hf i).continuous_at, + exact (map_zero _).symm +end + +lemma continuous_iff_continuous_comp + {q : seminorm_family 𝕜₂ F ι'} [topological_space E] [topological_add_group E] + [topological_space F] [topological_add_group F] [has_continuous_const_smul 𝕜₂ F] + (hq : with_seminorms q) (f : E →ₛₗ[σ₁₂] F) : + continuous f ↔ ∀ i, continuous ((q i).comp f) := +⟨λ h i, continuous.comp (hq.continuous_seminorm i) h, continuous_of_continuous_comp hq f⟩ + +lemma continuous_from_bounded {p : seminorm_family 𝕝 E ι} {q : seminorm_family 𝕝₂ F ι'} + [topological_space E] [topological_add_group E] (hp : with_seminorms p) + [topological_space F] [topological_add_group F] (hq : with_seminorms q) + (f : E →ₛₗ[τ₁₂] F) (hf : seminorm.is_bounded p q f) : continuous f := +begin + refine continuous_of_continuous_comp hq _ (λ i, seminorm.continuous_of_continuous_at_zero _), + rw [metric.continuous_at_iff', map_zero], + intros r hr, + rcases hf i with ⟨s₁, C, hf⟩, + have hC' : 0 < C + 1 := by positivity, + rw hp.has_basis.eventually_iff, + refine ⟨(s₁.sup p).ball 0 (r/(C + 1)), p.basis_sets_mem _ (by positivity), _⟩, + simp_rw [ ←metric.mem_ball, ←mem_preimage, ←ball_zero_eq_preimage_ball], refine subset.trans _ (ball_antitone hf), - rw ball_smul (s₁.sup p) hC, + norm_cast, + rw ← ball_smul (s₁.sup p) hC', + refine ball_antitone (smul_le_smul le_rfl _), + simp only [le_add_iff_nonneg_right, zero_le'], end -lemma cont_with_seminorms_normed_space (F) [semi_normed_group F] [normed_space 𝕜 F] +lemma cont_with_seminorms_normed_space (F) [seminormed_add_comm_group F] [normed_space 𝕝₂ F] [uniform_space E] [uniform_add_group E] - (p : ι → seminorm 𝕜 E) [with_seminorms p] (f : E →ₗ[𝕜] F) - (hf : ∃ (s : finset ι) C : ℝ≥0, C ≠ 0 ∧ (norm_seminorm 𝕜 F).comp f ≤ C • s.sup p) : + {p : ι → seminorm 𝕝 E} (hp : with_seminorms p) (f : E →ₛₗ[τ₁₂] F) + (hf : ∃ (s : finset ι) C : ℝ≥0, (norm_seminorm 𝕝₂ F).comp f ≤ C • s.sup p) : continuous f := begin rw ←seminorm.is_bounded_const (fin 1) at hf, - exact continuous_from_bounded p (λ _ : fin 1, norm_seminorm 𝕜 F) f hf, + exact continuous_from_bounded hp (norm_with_seminorms 𝕝₂ F) f hf, end -lemma cont_normed_space_to_with_seminorms (E) [semi_normed_group E] [normed_space 𝕜 E] +lemma cont_normed_space_to_with_seminorms (E) [seminormed_add_comm_group E] [normed_space 𝕝 E] [uniform_space F] [uniform_add_group F] - (q : ι → seminorm 𝕜 F) [with_seminorms q] (f : E →ₗ[𝕜] F) - (hf : ∀ i : ι, ∃ C : ℝ≥0, C ≠ 0 ∧ (q i).comp f ≤ C • (norm_seminorm 𝕜 E)) : continuous f := + {q : ι → seminorm 𝕝₂ F} (hq : with_seminorms q) (f : E →ₛₗ[τ₁₂] F) + (hf : ∀ i : ι, ∃ C : ℝ≥0, (q i).comp f ≤ C • (norm_seminorm 𝕝 E)) : continuous f := begin rw ←seminorm.const_is_bounded (fin 1) at hf, - exact continuous_from_bounded (λ _ : fin 1, norm_seminorm 𝕜 E) q f hf, + exact continuous_from_bounded (norm_with_seminorms 𝕝 E) hq f hf, end end seminorm @@ -451,11 +650,11 @@ variables [nonempty ι] [normed_field 𝕜] [normed_space ℝ 𝕜] [add_comm_group E] [module 𝕜 E] [module ℝ E] [is_scalar_tower ℝ 𝕜 E] [topological_space E] [topological_add_group E] -lemma seminorm_family.to_locally_convex_space (p : seminorm_family 𝕜 E ι) [with_seminorms p] : +lemma with_seminorms.to_locally_convex_space {p : seminorm_family 𝕜 E ι} (hp : with_seminorms p) : locally_convex_space ℝ E := begin apply of_basis_zero ℝ E id (λ s, s ∈ p.basis_sets), - { rw [p.with_seminorms_eq, add_group_filter_basis.nhds_eq _, add_group_filter_basis.N_zero], + { rw [hp.1, add_group_filter_basis.nhds_eq _, add_group_filter_basis.N_zero], exact filter_basis.has_basis _ }, { intros s hs, change s ∈ set.Union _ at hs, @@ -468,13 +667,13 @@ end locally_convex_space section normed_space -variables (𝕜) [normed_field 𝕜] [normed_space ℝ 𝕜] [semi_normed_group E] +variables (𝕜) [normed_field 𝕜] [normed_space ℝ 𝕜] [seminormed_add_comm_group E] /-- Not an instance since `𝕜` can't be inferred. See `normed_space.to_locally_convex_space` for a slightly weaker instance version. -/ lemma normed_space.to_locally_convex_space' [normed_space 𝕜 E] [module ℝ E] [is_scalar_tower ℝ 𝕜 E] : locally_convex_space ℝ E := -seminorm_family.to_locally_convex_space (λ _ : fin 1, norm_seminorm 𝕜 E) +(norm_with_seminorms 𝕜 E).to_locally_convex_space /-- See `normed_space.to_locally_convex_space'` for a slightly stronger version which is not an instance. -/ @@ -483,3 +682,70 @@ instance normed_space.to_locally_convex_space [normed_space ℝ E] : normed_space.to_locally_convex_space' ℝ end normed_space + +section topological_constructions + +variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables [normed_field 𝕜₂] [add_comm_group F] [module 𝕜₂ F] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] + +/-- The family of seminorms obtained by composing each seminorm by a linear map. -/ +def seminorm_family.comp (q : seminorm_family 𝕜₂ F ι) (f : E →ₛₗ[σ₁₂] F) : + seminorm_family 𝕜 E ι := +λ i, (q i).comp f + +lemma seminorm_family.comp_apply (q : seminorm_family 𝕜₂ F ι) (i : ι) (f : E →ₛₗ[σ₁₂] F) : + q.comp f i = (q i).comp f := +rfl + +lemma seminorm_family.finset_sup_comp (q : seminorm_family 𝕜₂ F ι) (s : finset ι) + (f : E →ₛₗ[σ₁₂] F) : (s.sup q).comp f = s.sup (q.comp f) := +begin + ext x, + rw [seminorm.comp_apply, seminorm.finset_sup_apply, seminorm.finset_sup_apply], + refl +end + +variables [topological_space F] [topological_add_group F] + +lemma linear_map.with_seminorms_induced [hι : nonempty ι] {q : seminorm_family 𝕜₂ F ι} + (hq : with_seminorms q) (f : E →ₛₗ[σ₁₂] F) : + @with_seminorms 𝕜 E ι _ _ _ _ (q.comp f) (induced f infer_instance) := +begin + letI : topological_space E := induced f infer_instance, + letI : topological_add_group E := topological_add_group_induced f, + rw [(q.comp f).with_seminorms_iff_nhds_eq_infi, nhds_induced, map_zero, + q.with_seminorms_iff_nhds_eq_infi.mp hq, filter.comap_infi], + refine infi_congr (λ i, _), + exact filter.comap_comap +end + +lemma inducing.with_seminorms [hι : nonempty ι] {q : seminorm_family 𝕜₂ F ι} + (hq : with_seminorms q) [topological_space E] {f : E →ₛₗ[σ₁₂] F} (hf : inducing f) : + with_seminorms (q.comp f) := +begin + rw hf.induced, + exact f.with_seminorms_induced hq +end + +end topological_constructions + +section topological_properties + +variables [nontrivially_normed_field 𝕜] [add_comm_group E] [module 𝕜 E] [nonempty ι] [countable ι] +variables {p : seminorm_family 𝕜 E ι} +variables [uniform_space E] [uniform_add_group E] + +/-- If the topology of a space is induced by a countable family of seminorms, then the topology +is first countable. -/ +lemma with_seminorms.first_countable (hp : with_seminorms p) : + topological_space.first_countable_topology E := +begin + haveI : (𝓝 (0 : E)).is_countably_generated, + { rw p.with_seminorms_iff_nhds_eq_infi.mp hp, + exact filter.infi.is_countably_generated _ }, + haveI : (uniformity E).is_countably_generated := uniform_add_group.uniformity_countably_generated, + exact uniform_space.first_countable_topology E, +end + +end topological_properties diff --git a/src/analysis/matrix.lean b/src/analysis/matrix.lean index 82b0140bd377f..45b429a99d94e 100644 --- a/src/analysis/matrix.lean +++ b/src/analysis/matrix.lean @@ -10,26 +10,29 @@ import analysis.inner_product_space.pi_L2 /-! # Matrices as a normed space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we provide the following non-instances for norms on matrices: * The elementwise norm: - * `matrix.semi_normed_group` - * `matrix.normed_group` + * `matrix.seminormed_add_comm_group` + * `matrix.normed_add_comm_group` * `matrix.normed_space` * The Frobenius norm: - * `matrix.frobenius_semi_normed_group` - * `matrix.frobenius_normed_group` + * `matrix.frobenius_seminormed_add_comm_group` + * `matrix.frobenius_normed_add_comm_group` * `matrix.frobenius_normed_space` * `matrix.frobenius_normed_ring` * `matrix.frobenius_normed_algebra` * The $L^\infty$ operator norm: - * `matrix.linfty_op_semi_normed_group` - * `matrix.linfty_op_normed_group` + * `matrix.linfty_op_seminormed_add_comm_group` + * `matrix.linfty_op_normed_add_comm_group` * `matrix.linfty_op_normed_space` * `matrix.linfty_op_non_unital_semi_normed_ring` * `matrix.linfty_op_semi_normed_ring` @@ -53,69 +56,69 @@ variables {R l m n α β : Type*} [fintype l] [fintype m] [fintype n] section linf_linf -section semi_normed_group -variables [semi_normed_group α] [semi_normed_group β] +section seminormed_add_comm_group +variables [seminormed_add_comm_group α] [seminormed_add_comm_group β] /-- Seminormed group instance (using sup norm of sup norm) for matrices over a seminormed group. Not declared as an instance because there are several natural choices for defining the norm of a matrix. -/ -protected def semi_normed_group : semi_normed_group (matrix m n α) := -pi.semi_normed_group +protected def seminormed_add_comm_group : seminormed_add_comm_group (matrix m n α) := +pi.seminormed_add_comm_group -local attribute [instance] matrix.semi_normed_group +local attribute [instance] matrix.seminormed_add_comm_group lemma norm_le_iff {r : ℝ} (hr : 0 ≤ r) {A : matrix m n α} : - ∥A∥ ≤ r ↔ ∀ i j, ∥A i j∥ ≤ r := -by simp [pi_norm_le_iff hr] + ‖A‖ ≤ r ↔ ∀ i j, ‖A i j‖ ≤ r := +by simp [pi_norm_le_iff_of_nonneg hr] lemma nnnorm_le_iff {r : ℝ≥0} {A : matrix m n α} : - ∥A∥₊ ≤ r ↔ ∀ i j, ∥A i j∥₊ ≤ r := + ‖A‖₊ ≤ r ↔ ∀ i j, ‖A i j‖₊ ≤ r := by simp [pi_nnnorm_le_iff] lemma norm_lt_iff {r : ℝ} (hr : 0 < r) {A : matrix m n α} : - ∥A∥ < r ↔ ∀ i j, ∥A i j∥ < r := + ‖A‖ < r ↔ ∀ i j, ‖A i j‖ < r := by simp [pi_norm_lt_iff hr] lemma nnnorm_lt_iff {r : ℝ≥0} (hr : 0 < r) {A : matrix m n α} : - ∥A∥₊ < r ↔ ∀ i j, ∥A i j∥₊ < r := + ‖A‖₊ < r ↔ ∀ i j, ‖A i j‖₊ < r := by simp [pi_nnnorm_lt_iff hr] lemma norm_entry_le_entrywise_sup_norm (A : matrix m n α) {i : m} {j : n} : - ∥A i j∥ ≤ ∥A∥ := + ‖A i j‖ ≤ ‖A‖ := (norm_le_pi_norm (A i) j).trans (norm_le_pi_norm A i) lemma nnnorm_entry_le_entrywise_sup_nnnorm (A : matrix m n α) {i : m} {j : n} : - ∥A i j∥₊ ≤ ∥A∥₊ := + ‖A i j‖₊ ≤ ‖A‖₊ := (nnnorm_le_pi_nnnorm (A i) j).trans (nnnorm_le_pi_nnnorm A i) -@[simp] lemma nnnorm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ∥f a∥₊ = ∥a∥₊) : - ∥A.map f∥₊ = ∥A∥₊ := -by simp_rw [pi.nnnorm_def, matrix.map, hf] -@[simp] lemma norm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ∥f a∥ = ∥a∥) : - ∥A.map f∥ = ∥A∥ := +@[simp] lemma nnnorm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖₊ = ‖a‖₊) : + ‖A.map f‖₊ = ‖A‖₊ := +by simp_rw [pi.nnnorm_def, matrix.map_apply, hf] +@[simp] lemma norm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖ = ‖a‖) : + ‖A.map f‖ = ‖A‖ := (congr_arg (coe : ℝ≥0 → ℝ) $ nnnorm_map_eq A f $ λ a, subtype.ext $ hf a : _) -@[simp] lemma nnnorm_transpose (A : matrix m n α) : ∥Aᵀ∥₊ = ∥A∥₊ := +@[simp] lemma nnnorm_transpose (A : matrix m n α) : ‖Aᵀ‖₊ = ‖A‖₊ := by { simp_rw [pi.nnnorm_def], exact finset.sup_comm _ _ _ } -@[simp] lemma norm_transpose (A : matrix m n α) : ∥Aᵀ∥ = ∥A∥ := congr_arg coe $ nnnorm_transpose A +@[simp] lemma norm_transpose (A : matrix m n α) : ‖Aᵀ‖ = ‖A‖ := congr_arg coe $ nnnorm_transpose A @[simp] lemma nnnorm_conj_transpose [star_add_monoid α] [normed_star_group α] (A : matrix m n α) : - ∥Aᴴ∥₊ = ∥A∥₊ := + ‖Aᴴ‖₊ = ‖A‖₊ := (nnnorm_map_eq _ _ nnnorm_star).trans A.nnnorm_transpose @[simp] lemma norm_conj_transpose [star_add_monoid α] [normed_star_group α] (A : matrix m n α) : - ∥Aᴴ∥ = ∥A∥ := + ‖Aᴴ‖ = ‖A‖ := congr_arg coe $ nnnorm_conj_transpose A instance [star_add_monoid α] [normed_star_group α] : normed_star_group (matrix m m α) := ⟨norm_conj_transpose⟩ -@[simp] lemma nnnorm_col (v : m → α) : ∥col v∥₊ = ∥v∥₊ := by simp [pi.nnnorm_def] -@[simp] lemma norm_col (v : m → α) : ∥col v∥ = ∥v∥ := congr_arg coe $ nnnorm_col v +@[simp] lemma nnnorm_col (v : m → α) : ‖col v‖₊ = ‖v‖₊ := by simp [pi.nnnorm_def] +@[simp] lemma norm_col (v : m → α) : ‖col v‖ = ‖v‖ := congr_arg coe $ nnnorm_col v -@[simp] lemma nnnorm_row (v : n → α) : ∥row v∥₊ = ∥v∥₊ := by simp [pi.nnnorm_def] -@[simp] lemma norm_row (v : n → α) : ∥row v∥ = ∥v∥ := congr_arg coe $ nnnorm_row v +@[simp] lemma nnnorm_row (v : n → α) : ‖row v‖₊ = ‖v‖₊ := by simp [pi.nnnorm_def] +@[simp] lemma norm_row (v : n → α) : ‖row v‖ = ‖v‖ := congr_arg coe $ nnnorm_row v -@[simp] lemma nnnorm_diagonal [decidable_eq n] (v : n → α) : ∥diagonal v∥₊ = ∥v∥₊ := +@[simp] lemma nnnorm_diagonal [decidable_eq n] (v : n → α) : ‖diagonal v‖₊ = ‖v‖₊ := begin simp_rw pi.nnnorm_def, congr' 1 with i : 1, @@ -128,26 +131,28 @@ begin rw diagonal_apply_eq } end -@[simp] lemma norm_diagonal [decidable_eq n] (v : n → α) : ∥diagonal v∥ = ∥v∥ := +@[simp] lemma norm_diagonal [decidable_eq n] (v : n → α) : ‖diagonal v‖ = ‖v‖ := congr_arg coe $ nnnorm_diagonal v /-- Note this is safe as an instance as it carries no data. -/ +@[nolint fails_quickly] instance [nonempty n] [decidable_eq n] [has_one α] [norm_one_class α] : norm_one_class (matrix n n α) := ⟨(norm_diagonal _).trans $ norm_one⟩ -end semi_normed_group +end seminormed_add_comm_group /-- Normed group instance (using sup norm of sup norm) for matrices over a normed group. Not declared as an instance because there are several natural choices for defining the norm of a matrix. -/ -protected def normed_group [normed_group α] : normed_group (matrix m n α) := -pi.normed_group +protected def normed_add_comm_group [normed_add_comm_group α] : + normed_add_comm_group (matrix m n α) := +pi.normed_add_comm_group section normed_space -local attribute [instance] matrix.semi_normed_group +local attribute [instance] matrix.seminormed_add_comm_group -variables [normed_field R] [semi_normed_group α] [normed_space R α] +variables [normed_field R] [seminormed_add_comm_group α] [normed_space R α] /-- Normed space instance (using sup norm of sup norm) for matrices over a normed space. Not declared as an instance because there are several natural choices for defining the norm of a @@ -172,59 +177,60 @@ section linfty_op declared as an instance because there are several natural choices for defining the norm of a matrix. -/ local attribute [instance] -protected def linfty_op_semi_normed_group [semi_normed_group α] : - semi_normed_group (matrix m n α) := -(by apply_instance : semi_normed_group (m → pi_Lp 1 (λ j : n, α))) +protected def linfty_op_seminormed_add_comm_group [seminormed_add_comm_group α] : + seminormed_add_comm_group (matrix m n α) := +(by apply_instance : seminormed_add_comm_group (m → pi_Lp 1 (λ j : n, α))) /-- Normed group instance (using sup norm of L1 norm) for matrices over a normed ring. Not declared as an instance because there are several natural choices for defining the norm of a matrix. -/ local attribute [instance] -protected def linfty_op_normed_group [normed_group α] : - normed_group (matrix m n α) := -(by apply_instance : normed_group (m → pi_Lp 1 (λ j : n, α))) +protected def linfty_op_normed_add_comm_group [normed_add_comm_group α] : + normed_add_comm_group (matrix m n α) := +(by apply_instance : normed_add_comm_group (m → pi_Lp 1 (λ j : n, α))) /-- Normed space instance (using sup norm of L1 norm) for matrices over a normed space. Not declared as an instance because there are several natural choices for defining the norm of a matrix. -/ local attribute [instance] -protected def linfty_op_normed_space [normed_field R] [semi_normed_group α] [normed_space R α] : +protected def linfty_op_normed_space [normed_field R] [seminormed_add_comm_group α] + [normed_space R α] : normed_space R (matrix m n α) := (by apply_instance : normed_space R (m → pi_Lp 1 (λ j : n, α))) -section semi_normed_group -variables [semi_normed_group α] +section seminormed_add_comm_group +variables [seminormed_add_comm_group α] lemma linfty_op_norm_def (A : matrix m n α) : - ∥A∥ = ((finset.univ : finset m).sup (λ i : m, ∑ j : n, ∥A i j∥₊) : ℝ≥0) := -by simp_rw [pi.norm_def, pi_Lp.nnnorm_eq, div_one, nnreal.rpow_one] + ‖A‖ = ((finset.univ : finset m).sup (λ i : m, ∑ j : n, ‖A i j‖₊) : ℝ≥0) := +by simp [pi.norm_def, pi_Lp.nnnorm_eq_sum ennreal.one_ne_top] lemma linfty_op_nnnorm_def (A : matrix m n α) : - ∥A∥₊ = (finset.univ : finset m).sup (λ i : m, ∑ j : n, ∥A i j∥₊) := + ‖A‖₊ = (finset.univ : finset m).sup (λ i : m, ∑ j : n, ‖A i j‖₊) := subtype.ext $ linfty_op_norm_def A @[simp] lemma linfty_op_nnnorm_col (v : m → α) : - ∥col v∥₊ = ∥v∥₊ := + ‖col v‖₊ = ‖v‖₊ := begin rw [linfty_op_nnnorm_def, pi.nnnorm_def], simp, end @[simp] lemma linfty_op_norm_col (v : m → α) : - ∥col v∥ = ∥v∥ := + ‖col v‖ = ‖v‖ := congr_arg coe $ linfty_op_nnnorm_col v @[simp] lemma linfty_op_nnnorm_row (v : n → α) : - ∥row v∥₊ = ∑ i, ∥v i∥₊ := + ‖row v‖₊ = ∑ i, ‖v i‖₊ := by simp [linfty_op_nnnorm_def] @[simp] lemma linfty_op_norm_row (v : n → α) : - ∥row v∥ = ∑ i, ∥v i∥ := + ‖row v‖ = ∑ i, ‖v i‖ := (congr_arg coe $ linfty_op_nnnorm_row v).trans $ by simp [nnreal.coe_sum] @[simp] lemma linfty_op_nnnorm_diagonal [decidable_eq m] (v : m → α) : - ∥diagonal v∥₊ = ∥v∥₊ := + ‖diagonal v‖₊ = ‖v‖₊ := begin rw [linfty_op_nnnorm_def, pi.nnnorm_def], congr' 1 with i : 1, @@ -235,40 +241,40 @@ end @[simp] lemma linfty_op_norm_diagonal [decidable_eq m] (v : m → α) : - ∥diagonal v∥ = ∥v∥ := + ‖diagonal v‖ = ‖v‖ := congr_arg coe $ linfty_op_nnnorm_diagonal v -end semi_normed_group +end seminormed_add_comm_group section non_unital_semi_normed_ring variables [non_unital_semi_normed_ring α] -lemma linfty_op_nnnorm_mul (A : matrix l m α) (B : matrix m n α) : ∥A ⬝ B∥₊ ≤ ∥A∥₊ * ∥B∥₊ := +lemma linfty_op_nnnorm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖₊ ≤ ‖A‖₊ * ‖B‖₊ := begin simp_rw [linfty_op_nnnorm_def, matrix.mul_apply], - calc finset.univ.sup (λ i, ∑ k, ∥∑ j, A i j * B j k∥₊) - ≤ finset.univ.sup (λ i, ∑ k j, ∥A i j∥₊ * ∥B j k∥₊) : + calc finset.univ.sup (λ i, ∑ k, ‖∑ j, A i j * B j k‖₊) + ≤ finset.univ.sup (λ i, ∑ k j, ‖A i j‖₊ * ‖B j k‖₊) : finset.sup_mono_fun $ λ i hi, finset.sum_le_sum $ λ k hk, nnnorm_sum_le_of_le _ $ λ j hj, nnnorm_mul_le _ _ - ... = finset.univ.sup (λ i, ∑ j, (∥A i j∥₊ * ∑ k, ∥B j k∥₊)) : + ... = finset.univ.sup (λ i, ∑ j, (‖A i j‖₊ * ∑ k, ‖B j k‖₊)) : by simp_rw [@finset.sum_comm _ m n, finset.mul_sum] - ... ≤ finset.univ.sup (λ i, ∑ j, ∥A i j∥₊ * finset.univ.sup (λ i, ∑ j, ∥B i j∥₊)) : + ... ≤ finset.univ.sup (λ i, ∑ j, ‖A i j‖₊ * finset.univ.sup (λ i, ∑ j, ‖B i j‖₊)) : finset.sup_mono_fun $ λ i hi, finset.sum_le_sum $ λ j hj, mul_le_mul_of_nonneg_left (finset.le_sup hj) (zero_le _) - ... ≤ finset.univ.sup (λ i, ∑ j, ∥A i j∥₊) * finset.univ.sup (λ i, ∑ j, ∥B i j∥₊) : + ... ≤ finset.univ.sup (λ i, ∑ j, ‖A i j‖₊) * finset.univ.sup (λ i, ∑ j, ‖B i j‖₊) : by simp_rw [←finset.sum_mul, ←nnreal.finset_sup_mul], end -lemma linfty_op_norm_mul (A : matrix l m α) (B : matrix m n α) : ∥A ⬝ B∥ ≤ ∥A∥ * ∥B∥ := +lemma linfty_op_norm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖ ≤ ‖A‖ * ‖B‖ := linfty_op_nnnorm_mul _ _ -lemma linfty_op_nnnorm_mul_vec (A : matrix l m α) (v : m → α) : ∥A.mul_vec v∥₊ ≤ ∥A∥₊ * ∥v∥₊ := +lemma linfty_op_nnnorm_mul_vec (A : matrix l m α) (v : m → α) : ‖A.mul_vec v‖₊ ≤ ‖A‖₊ * ‖v‖₊ := begin rw [←linfty_op_nnnorm_col (A.mul_vec v), ←linfty_op_nnnorm_col v], exact linfty_op_nnnorm_mul A (col v), end -lemma linfty_op_norm_mul_vec (A : matrix l m α) (v : m → α) : ∥matrix.mul_vec A v∥ ≤ ∥A∥ * ∥v∥ := +lemma linfty_op_norm_mul_vec (A : matrix l m α) (v : m → α) : ‖matrix.mul_vec A v‖ ≤ ‖A‖ * ‖v‖ := linfty_op_nnnorm_mul_vec _ _ end non_unital_semi_normed_ring @@ -280,7 +286,7 @@ local attribute [instance] protected def linfty_op_non_unital_semi_normed_ring [non_unital_semi_normed_ring α] : non_unital_semi_normed_ring (matrix n n α) := { norm_mul := linfty_op_norm_mul, - .. matrix.linfty_op_semi_normed_group, + .. matrix.linfty_op_seminormed_add_comm_group, .. matrix.non_unital_ring } /-- The `L₁-L∞` norm preserves one on non-empty matrices. Note this is safe as an instance, as it @@ -339,101 +345,109 @@ open_locale matrix big_operators declared as an instance because there are several natural choices for defining the norm of a matrix. -/ local attribute [instance] -def frobenius_semi_normed_group [semi_normed_group α] : - semi_normed_group (matrix m n α) := -(by apply_instance : semi_normed_group (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α)))) +def frobenius_seminormed_add_comm_group [seminormed_add_comm_group α] : + seminormed_add_comm_group (matrix m n α) := +(by apply_instance : seminormed_add_comm_group (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α)))) /-- Normed group instance (using frobenius norm) for matrices over a normed group. Not declared as an instance because there are several natural choices for defining the norm of a matrix. -/ local attribute [instance] -def frobenius_normed_group [normed_group α] : - normed_group (matrix m n α) := -(by apply_instance : normed_group (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α)))) +def frobenius_normed_add_comm_group [normed_add_comm_group α] : + normed_add_comm_group (matrix m n α) := +(by apply_instance : normed_add_comm_group (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α)))) /-- Normed space instance (using frobenius norm) for matrices over a normed space. Not declared as an instance because there are several natural choices for defining the norm of a matrix. -/ local attribute [instance] -def frobenius_normed_space [normed_field R] [semi_normed_group α] [normed_space R α] : +def frobenius_normed_space [normed_field R] [seminormed_add_comm_group α] [normed_space R α] : normed_space R (matrix m n α) := (by apply_instance : normed_space R (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α)))) -section semi_normed_group -variables [semi_normed_group α] [semi_normed_group β] +section seminormed_add_comm_group +variables [seminormed_add_comm_group α] [seminormed_add_comm_group β] lemma frobenius_nnnorm_def (A : matrix m n α) : - ∥A∥₊ = (∑ i j, ∥A i j∥₊ ^ (2 : ℝ)) ^ (1/2 : ℝ) := -by simp_rw [pi_Lp.nnnorm_eq, ←nnreal.rpow_mul, div_mul_cancel (1 : ℝ) two_ne_zero, nnreal.rpow_one] + ‖A‖₊ = (∑ i j, ‖A i j‖₊ ^ (2 : ℝ)) ^ (1/2 : ℝ) := +by simp_rw [pi_Lp.nnnorm_eq_of_L2, nnreal.sq_sqrt, nnreal.sqrt_eq_rpow, nnreal.rpow_two] lemma frobenius_norm_def (A : matrix m n α) : - ∥A∥ = (∑ i j, ∥A i j∥ ^ (2 : ℝ)) ^ (1/2 : ℝ) := + ‖A‖ = (∑ i j, ‖A i j‖ ^ (2 : ℝ)) ^ (1/2 : ℝ) := (congr_arg coe (frobenius_nnnorm_def A)).trans $ by simp [nnreal.coe_sum] -@[simp] lemma frobenius_nnnorm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ∥f a∥₊ = ∥a∥₊) : - ∥A.map f∥₊ = ∥A∥₊ := -by simp_rw [frobenius_nnnorm_def, matrix.map, hf] -@[simp] lemma frobenius_norm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ∥f a∥ = ∥a∥) : - ∥A.map f∥ = ∥A∥ := +@[simp] lemma frobenius_nnnorm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖₊ = ‖a‖₊) : + ‖A.map f‖₊ = ‖A‖₊ := +by simp_rw [frobenius_nnnorm_def, matrix.map_apply, hf] +@[simp] lemma frobenius_norm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖ = ‖a‖) : + ‖A.map f‖ = ‖A‖ := (congr_arg (coe : ℝ≥0 → ℝ) $ frobenius_nnnorm_map_eq A f $ λ a, subtype.ext $ hf a : _) -@[simp] lemma frobenius_nnnorm_transpose (A : matrix m n α) : ∥Aᵀ∥₊ = ∥A∥₊ := +@[simp] lemma frobenius_nnnorm_transpose (A : matrix m n α) : ‖Aᵀ‖₊ = ‖A‖₊ := by { rw [frobenius_nnnorm_def, frobenius_nnnorm_def, finset.sum_comm], refl } -@[simp] lemma frobenius_norm_transpose (A : matrix m n α) : ∥Aᵀ∥ = ∥A∥ := +@[simp] lemma frobenius_norm_transpose (A : matrix m n α) : ‖Aᵀ‖ = ‖A‖ := congr_arg coe $ frobenius_nnnorm_transpose A @[simp] lemma frobenius_nnnorm_conj_transpose [star_add_monoid α] [normed_star_group α] - (A : matrix m n α) : ∥Aᴴ∥₊ = ∥A∥₊ := + (A : matrix m n α) : ‖Aᴴ‖₊ = ‖A‖₊ := (frobenius_nnnorm_map_eq _ _ nnnorm_star).trans A.frobenius_nnnorm_transpose @[simp] lemma frobenius_norm_conj_transpose [star_add_monoid α] [normed_star_group α] - (A : matrix m n α) : ∥Aᴴ∥ = ∥A∥ := + (A : matrix m n α) : ‖Aᴴ‖ = ‖A‖ := congr_arg coe $ frobenius_nnnorm_conj_transpose A instance frobenius_normed_star_group [star_add_monoid α] [normed_star_group α] : normed_star_group (matrix m m α) := ⟨frobenius_norm_conj_transpose⟩ -@[simp] lemma frobenius_norm_row (v : m → α) : ∥row v∥ = ∥(pi_Lp.equiv 2 _).symm v∥ := -by { rw [frobenius_norm_def, fintype.sum_unique], refl } -@[simp] lemma frobenius_nnnorm_row (v : m → α) : ∥row v∥₊ = ∥(pi_Lp.equiv 2 _).symm v∥₊ := +@[simp] lemma frobenius_norm_row (v : m → α) : ‖row v‖ = ‖(pi_Lp.equiv 2 _).symm v‖ := +begin + rw [frobenius_norm_def, fintype.sum_unique, pi_Lp.norm_eq_of_L2, real.sqrt_eq_rpow], + simp only [row_apply, real.rpow_two, pi_Lp.equiv_symm_apply], +end +@[simp] lemma frobenius_nnnorm_row (v : m → α) : ‖row v‖₊ = ‖(pi_Lp.equiv 2 _).symm v‖₊ := subtype.ext $ frobenius_norm_row v -@[simp] lemma frobenius_norm_col (v : n → α) : ∥col v∥ = ∥(pi_Lp.equiv 2 _).symm v∥ := -by { simp_rw [frobenius_norm_def, fintype.sum_unique], refl } -@[simp] lemma frobenius_nnnorm_col (v : n → α) : ∥col v∥₊ = ∥(pi_Lp.equiv 2 _).symm v∥₊ := +@[simp] lemma frobenius_norm_col (v : n → α) : ‖col v‖ = ‖(pi_Lp.equiv 2 _).symm v‖ := +begin + simp_rw [frobenius_norm_def, fintype.sum_unique, pi_Lp.norm_eq_of_L2, real.sqrt_eq_rpow], + simp only [col_apply, real.rpow_two, pi_Lp.equiv_symm_apply] +end +@[simp] lemma frobenius_nnnorm_col (v : n → α) : ‖col v‖₊ = ‖(pi_Lp.equiv 2 _).symm v‖₊ := subtype.ext $ frobenius_norm_col v @[simp] lemma frobenius_nnnorm_diagonal [decidable_eq n] (v : n → α) : - ∥diagonal v∥₊ = ∥(pi_Lp.equiv 2 _).symm v∥₊ := + ‖diagonal v‖₊ = ‖(pi_Lp.equiv 2 _).symm v‖₊ := begin - simp_rw [frobenius_nnnorm_def, ←finset.sum_product', finset.univ_product_univ, pi_Lp.nnnorm_eq], + simp_rw [frobenius_nnnorm_def, ←finset.sum_product', finset.univ_product_univ, + pi_Lp.nnnorm_eq_of_L2], let s := (finset.univ : finset n).map ⟨λ i : n, (i, i), λ i j h, congr_arg prod.fst h⟩, rw ←finset.sum_subset (finset.subset_univ s) (λ i hi his, _), - { rw finset.sum_map, + { rw [finset.sum_map, nnreal.sqrt_eq_rpow], dsimp, - simp_rw diagonal_apply_eq }, + simp_rw [diagonal_apply_eq, nnreal.rpow_two] }, { suffices : i.1 ≠ i.2, { rw [diagonal_apply_ne _ this, nnnorm_zero, nnreal.zero_rpow two_ne_zero], }, intro h, exact finset.mem_map.not.mp his ⟨i.1, finset.mem_univ _, prod.ext rfl h⟩ } end @[simp] lemma frobenius_norm_diagonal [decidable_eq n] (v : n → α) : - ∥diagonal v∥ = ∥(pi_Lp.equiv 2 _).symm v∥ := + ‖diagonal v‖ = ‖(pi_Lp.equiv 2 _).symm v‖ := (congr_arg coe $ frobenius_nnnorm_diagonal v : _).trans rfl -end semi_normed_group +end seminormed_add_comm_group -lemma frobenius_nnnorm_one [decidable_eq n] [semi_normed_group α] [has_one α] : - ∥(1 : matrix n n α)∥₊ = nnreal.sqrt (fintype.card n) * ∥(1 : α)∥₊:= +lemma frobenius_nnnorm_one [decidable_eq n] [seminormed_add_comm_group α] [has_one α] : + ‖(1 : matrix n n α)‖₊ = nnreal.sqrt (fintype.card n) * ‖(1 : α)‖₊:= begin refine (frobenius_nnnorm_diagonal _).trans _, - simp_rw [pi_Lp.nnnorm_equiv_symm_const, nnreal.sqrt_eq_rpow], + simp_rw [pi_Lp.nnnorm_equiv_symm_const ennreal.two_ne_top, nnreal.sqrt_eq_rpow], + simp only [ennreal.to_real_div, ennreal.one_to_real, ennreal.to_real_bit0], end section is_R_or_C variables [is_R_or_C α] -lemma frobenius_nnnorm_mul (A : matrix l m α) (B : matrix m n α) : ∥A ⬝ B∥₊ ≤ ∥A∥₊ * ∥B∥₊ := +lemma frobenius_nnnorm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖₊ ≤ ‖A‖₊ * ‖B‖₊ := begin simp_rw [frobenius_nnnorm_def, matrix.mul_apply], rw [←nnreal.mul_rpow, @finset.sum_comm _ n m, finset.sum_mul_sum, finset.sum_product], @@ -442,15 +456,15 @@ begin rw [← nnreal.rpow_le_rpow_iff one_half_pos, ← nnreal.rpow_mul, mul_div_cancel' (1 : ℝ) two_ne_zero, nnreal.rpow_one, nnreal.mul_rpow], dsimp only, - have := @nnnorm_inner_le_nnnorm α _ _ _ + have := @nnnorm_inner_le_nnnorm α _ _ _ _ ((pi_Lp.equiv 2 (λ i, α)).symm (λ j, star (A i j))) ((pi_Lp.equiv 2 (λ i, α)).symm (λ k, B k j)), simpa only [pi_Lp.equiv_symm_apply, pi_Lp.inner_apply, - is_R_or_C.inner_apply, star_ring_end_apply, pi.nnnorm_def, pi_Lp.nnnorm_eq, - star_star, nnnorm_star] using this, + is_R_or_C.inner_apply, star_ring_end_apply, pi.nnnorm_def, pi_Lp.nnnorm_eq_of_L2, + star_star, nnnorm_star, nnreal.sqrt_eq_rpow, nnreal.rpow_two] using this, end -lemma frobenius_norm_mul (A : matrix l m α) (B : matrix m n α) : ∥A ⬝ B∥ ≤ ∥A∥ * ∥B∥ := +lemma frobenius_norm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖ ≤ ‖A‖ * ‖B‖ := frobenius_nnnorm_mul A B /-- Normed ring instance (using frobenius norm) for matrices over `ℝ` or `ℂ`. Not @@ -460,7 +474,7 @@ local attribute [instance] def frobenius_normed_ring [decidable_eq m] : normed_ring (matrix m m α) := { norm := has_norm.norm, norm_mul := frobenius_norm_mul, - ..matrix.frobenius_semi_normed_group } + ..matrix.frobenius_seminormed_add_comm_group } /-- Normed algebra instance (using frobenius norm) for matrices over `ℝ` or `ℂ`. Not declared as an instance because there are several natural choices for defining the norm of a diff --git a/src/analysis/mean_inequalities.lean b/src/analysis/mean_inequalities.lean index 24c0346cfc7ed..62cbe6a4393f3 100644 --- a/src/analysis/mean_inequalities.lean +++ b/src/analysis/mean_inequalities.lean @@ -3,12 +3,17 @@ Copyright (c) 2019 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne -/ -import analysis.convex.specific_functions +import analysis.convex.jensen +import analysis.convex.specific_functions.basic +import analysis.special_functions.pow.nnreal import data.real.conjugate_exponents /-! # Mean value inequalities +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove several inequalities for finite sums, including AM-GM inequality, Young's inequality, Hölder inequality, and Minkowski inequality. Versions for integrals of some of these inequalities are available in `measure_theory.mean_inequalities`. @@ -340,7 +345,7 @@ begin let f' := λ i, (f i) / (∑ i in s, (f i) ^ p) ^ (1 / p), let g' := λ i, (g i) / (∑ i in s, (g i) ^ q) ^ (1 / q), suffices : ∑ i in s, f' i * g' i ≤ 1, - { simp_rw [f', g', div_mul_div_comm₀, ← sum_div] at this, + { simp_rw [f', g', div_mul_div_comm, ← sum_div] at this, rwa [div_le_iff, one_mul] at this, refine mul_ne_zero _ _, { rw [ne.def, rpow_eq_zero_iff, not_and_distrib], exact or.inl hF_zero, }, diff --git a/src/analysis/mean_inequalities_pow.lean b/src/analysis/mean_inequalities_pow.lean index af0dfc85fa815..e639c518c2bff 100644 --- a/src/analysis/mean_inequalities_pow.lean +++ b/src/analysis/mean_inequalities_pow.lean @@ -3,11 +3,17 @@ Copyright (c) 2019 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne -/ -import analysis.convex.specific_functions +import analysis.convex.jensen +import analysis.convex.specific_functions.basic +import analysis.special_functions.pow.nnreal +import tactic.positivity /-! # Mean value inequalities +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove several mean inequalities for finite sums. Versions for integrals of some of these inequalities are available in `measure_theory.mean_inequalities`. @@ -57,6 +63,23 @@ theorem pow_arith_mean_le_arith_mean_pow_of_even (w z : ι → ℝ) (hw : ∀ i (∑ i in s, w i * z i) ^ n ≤ ∑ i in s, (w i * z i ^ n) := hn.convex_on_pow.map_sum_le hw hw' (λ _ _, trivial) +/-- Specific case of Jensen's inequality for sums of powers -/ +lemma pow_sum_div_card_le_sum_pow {f : ι → ℝ} (n : ℕ) (hf : ∀ a ∈ s, 0 ≤ f a) : + (∑ x in s, f x) ^ (n + 1) / s.card ^ n ≤ ∑ x in s, (f x) ^ (n + 1) := +begin + rcases s.eq_empty_or_nonempty with rfl | hs, + { simp_rw [finset.sum_empty, zero_pow' _ (nat.succ_ne_zero n), zero_div] }, + { have hs0 : 0 < (s.card : ℝ) := nat.cast_pos.2 hs.card_pos, + suffices : (∑ x in s, f x / s.card) ^ (n + 1) ≤ ∑ x in s, (f x ^ (n + 1) / s.card), + { rwa [← finset.sum_div, ← finset.sum_div, div_pow, pow_succ' (s.card : ℝ), + ← div_div, div_le_iff hs0, div_mul, div_self hs0.ne', div_one] at this }, + have := @convex_on.map_sum_le ℝ ℝ ℝ ι _ _ _ _ _ _ (set.Ici 0) (λ x, x ^ (n + 1)) s + (λ _, 1 / s.card) (coe ∘ f) (convex_on_pow (n + 1)) _ _ (λ i hi, set.mem_Ici.2 (hf i hi)), + { simpa only [inv_mul_eq_div, one_div, algebra.id.smul_eq_mul] using this }, + { simp only [one_div, inv_nonneg, nat.cast_nonneg, implies_true_iff] }, + { simpa only [one_div, finset.sum_const, nsmul_eq_mul] using mul_inv_cancel hs0.ne' } } +end + theorem zpow_arith_mean_le_arith_mean_zpow (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i) (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 < z i) (m : ℤ) : (∑ i in s, w i * z i) ^ m ≤ ∑ i in s, (w i * z i ^ m) := @@ -71,7 +94,7 @@ theorem arith_mean_le_rpow_mean (w z : ι → ℝ) (hw : ∀ i ∈ s, 0 ≤ w i) (hw' : ∑ i in s, w i = 1) (hz : ∀ i ∈ s, 0 ≤ z i) {p : ℝ} (hp : 1 ≤ p) : ∑ i in s, w i * z i ≤ (∑ i in s, (w i * z i ^ p)) ^ (1 / p) := begin - have : 0 < p := lt_of_lt_of_le zero_lt_one hp, + have : 0 < p := by positivity, rw [← rpow_le_rpow_iff _ _ this, ← rpow_mul, one_div_mul_cancel (ne_of_gt this), rpow_one], exact rpow_arith_mean_le_arith_mean_rpow s w z hw hw' hz hp, all_goals { apply_rules [sum_nonneg, rpow_nonneg_of_nonneg], @@ -90,6 +113,11 @@ theorem pow_arith_mean_le_arith_mean_pow (w z : ι → ℝ≥0) (hw' : ∑ i in by exact_mod_cast real.pow_arith_mean_le_arith_mean_pow s _ _ (λ i _, (w i).coe_nonneg) (by exact_mod_cast hw') (λ i _, (z i).coe_nonneg) n +lemma pow_sum_div_card_le_sum_pow (f : ι → ℝ≥0) (n : ℕ) : + (∑ x in s, f x) ^ (n + 1) / s.card ^ n ≤ ∑ x in s, (f x) ^ (n + 1) := +by simpa only [← nnreal.coe_le_coe, nnreal.coe_sum, nonneg.coe_div, nnreal.coe_pow] using + @real.pow_sum_div_card_le_sum_pow ι s (coe ∘ f) n (λ _ _, nnreal.coe_nonneg _) + /-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0`-valued functions and real exponents. -/ theorem rpow_arith_mean_le_arith_mean_rpow (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) {p : ℝ} @@ -108,6 +136,20 @@ begin { simp [hw', fin.sum_univ_succ], }, end +/-- Unweighted mean inequality, version for two elements of `ℝ≥0` and real exponents. -/ +theorem rpow_add_le_mul_rpow_add_rpow (z₁ z₂ : ℝ≥0) {p : ℝ} (hp : 1 ≤ p) : + (z₁ + z₂) ^ p ≤ 2^(p-1) * (z₁ ^ p + z₂ ^ p) := +begin + rcases eq_or_lt_of_le hp with rfl|h'p, + { simp only [rpow_one, sub_self, rpow_zero, one_mul] }, + convert rpow_arith_mean_le_arith_mean2_rpow (1/2) (1/2) (2 * z₁) (2 * z₂) (add_halves 1) hp, + { simp only [one_div, inv_mul_cancel_left₀, ne.def, bit0_eq_zero, one_ne_zero, not_false_iff] }, + { simp only [one_div, inv_mul_cancel_left₀, ne.def, bit0_eq_zero, one_ne_zero, not_false_iff] }, + { have A : p - 1 ≠ 0 := ne_of_gt (sub_pos.2 h'p), + simp only [mul_rpow, rpow_sub' _ A, div_eq_inv_mul, rpow_one, mul_one], + ring } +end + /-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0`-valued functions and real exponents. -/ theorem arith_mean_le_rpow_mean (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = 1) {p : ℝ} @@ -116,10 +158,6 @@ theorem arith_mean_le_rpow_mean (w z : ι → ℝ≥0) (hw' : ∑ i in s, w i = by exact_mod_cast real.arith_mean_le_rpow_mean s _ _ (λ i _, (w i).coe_nonneg) (by exact_mod_cast hw') (λ i _, (z i).coe_nonneg) hp -end nnreal - -namespace nnreal - private lemma add_rpow_le_one_of_add_le_one {p : ℝ} (a b : ℝ≥0) (hab : a + b ≤ 1) (hp1 : 1 ≤ p) : a ^ p + b ^ p ≤ 1 := @@ -133,7 +171,7 @@ end lemma add_rpow_le_rpow_add {p : ℝ} (a b : ℝ≥0) (hp1 : 1 ≤ p) : a ^ p + b ^ p ≤ (a + b) ^ p := begin - have hp_pos : 0 < p := lt_of_lt_of_le zero_lt_one hp1, + have hp_pos : 0 < p := by positivity, by_cases h_zero : a + b = 0, { simp [add_eq_zero_iff.mp h_zero, hp_pos.ne'] }, have h_nonzero : ¬(a = 0 ∧ b = 0), by rwa add_eq_zero_iff at h_zero, @@ -171,9 +209,11 @@ begin rwa one_div_div at h_rpow_add_rpow_le_add, end -lemma rpow_add_le_add_rpow {p : ℝ} (a b : ℝ≥0) (hp_pos : 0 < p) (hp1 : p ≤ 1) : +lemma rpow_add_le_add_rpow {p : ℝ} (a b : ℝ≥0) (hp : 0 ≤ p) (hp1 : p ≤ 1) : (a + b) ^ p ≤ a ^ p + b ^ p := begin + rcases hp.eq_or_lt with rfl|hp_pos, + { simp }, have h := rpow_add_rpow_le a b hp_pos hp1, rw one_div_one at h, repeat { rw nnreal.rpow_one at h }, @@ -190,12 +230,12 @@ theorem rpow_arith_mean_le_arith_mean_rpow (w z : ι → ℝ≥0∞) (hw' : ∑ (hp : 1 ≤ p) : (∑ i in s, w i * z i) ^ p ≤ ∑ i in s, (w i * z i ^ p) := begin - have hp_pos : 0 < p, from lt_of_lt_of_le zero_lt_one hp, - have hp_nonneg : 0 ≤ p, from le_of_lt hp_pos, + have hp_pos : 0 < p, positivity, + have hp_nonneg : 0 ≤ p, positivity, have hp_not_nonpos : ¬ p ≤ 0, by simp [hp_pos], have hp_not_neg : ¬ p < 0, by simp [hp_nonneg], have h_top_iff_rpow_top : ∀ (i : ι) (hi : i ∈ s), w i * z i = ⊤ ↔ w i * (z i) ^ p = ⊤, - by simp [hp_pos, hp_nonneg, hp_not_nonpos, hp_not_neg], + by simp [ennreal.mul_eq_top, hp_pos, hp_nonneg, hp_not_nonpos, hp_not_neg], refine le_of_top_imp_top_of_to_nnreal_le _ _, { -- first, prove `(∑ i in s, w i * z i) ^ p = ⊤ → ∑ i in s, (w i * z i ^ p) = ⊤` rw [rpow_eq_top_iff, sum_eq_top_iff, sum_eq_top_iff], @@ -245,14 +285,26 @@ begin { simp [hw', fin.sum_univ_succ], }, end -end ennreal - -namespace ennreal +/-- Unweighted mean inequality, version for two elements of `ℝ≥0∞` and real exponents. -/ +theorem rpow_add_le_mul_rpow_add_rpow (z₁ z₂ : ℝ≥0∞) {p : ℝ} (hp : 1 ≤ p) : + (z₁ + z₂) ^ p ≤ 2^(p-1) * (z₁ ^ p + z₂ ^ p) := +begin + rcases eq_or_lt_of_le hp with rfl|h'p, + { simp only [rpow_one, sub_self, rpow_zero, one_mul, le_refl], }, + convert rpow_arith_mean_le_arith_mean2_rpow + (1/2) (1/2) (2 * z₁) (2 * z₂) (ennreal.add_halves 1) hp, + { simp [← mul_assoc, ennreal.inv_mul_cancel two_ne_zero two_ne_top] }, + { simp [← mul_assoc, ennreal.inv_mul_cancel two_ne_zero two_ne_top] }, + { have A : p - 1 ≠ 0 := ne_of_gt (sub_pos.2 h'p), + simp only [mul_rpow_of_nonneg _ _ (zero_le_one.trans hp), rpow_sub _ _ two_ne_zero two_ne_top, + ennreal.div_eq_inv_mul, rpow_one, mul_one], + ring } +end lemma add_rpow_le_rpow_add {p : ℝ} (a b : ℝ≥0∞) (hp1 : 1 ≤ p) : a ^ p + b ^ p ≤ (a + b) ^ p := begin - have hp_pos : 0 < p := lt_of_lt_of_le zero_lt_one hp1, + have hp_pos : 0 < p := by positivity, by_cases h_top : a + b = ⊤, { rw ←@ennreal.rpow_eq_top_iff_of_pos (a + b) p hp_pos at h_top, rw h_top, @@ -276,8 +328,7 @@ theorem rpow_add_rpow_le {p q : ℝ} (a b : ℝ≥0∞) (hp_pos : 0 < p) (hpq : (a ^ q + b ^ q) ^ (1/q) ≤ (a ^ p + b ^ p) ^ (1/p) := begin have h_rpow : ∀ a : ℝ≥0∞, a^q = (a^p)^(q/p), - from λ a, by rw [←ennreal.rpow_mul, div_eq_inv_mul, ←mul_assoc, - _root_.mul_inv_cancel hp_pos.ne.symm, one_mul], + from λ a, by rw [← ennreal.rpow_mul, _root_.mul_div_cancel' _ hp_pos.ne'], have h_rpow_add_rpow_le_add : ((a^p)^(q/p) + (b^p)^(q/p)) ^ (1/(q/p)) ≤ a^p + b^p, { refine rpow_add_rpow_le_add (a^p) (b^p) _, rwa one_le_div hp_pos, }, @@ -286,9 +337,14 @@ begin rwa one_div_div at h_rpow_add_rpow_le_add, end -lemma rpow_add_le_add_rpow {p : ℝ} (a b : ℝ≥0∞) (hp_pos : 0 < p) (hp1 : p ≤ 1) : +lemma rpow_add_le_add_rpow {p : ℝ} (a b : ℝ≥0∞) (hp : 0 ≤ p) (hp1 : p ≤ 1) : (a + b) ^ p ≤ a ^ p + b ^ p := begin + rcases hp.eq_or_lt with rfl|hp_pos, + { suffices : (1 : ℝ≥0∞) ≤ 1 + 1, + { simpa using this }, + norm_cast, + norm_num }, have h := rpow_add_rpow_le a b hp_pos hp1, rw one_div_one at h, repeat { rw ennreal.rpow_one at h }, diff --git a/src/analysis/mellin_transform.lean b/src/analysis/mellin_transform.lean new file mode 100644 index 0000000000000..ac6518d306041 --- /dev/null +++ b/src/analysis/mellin_transform.lean @@ -0,0 +1,499 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ + +import analysis.special_functions.improper_integrals +import analysis.calculus.parametric_integral +import measure_theory.measure.haar.normed_space + +/-! # The Mellin transform + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define the Mellin transform of a locally integrable function on `Ioi 0`, and show it is +differentiable in a suitable vertical strip. + +## Main statements + +- `mellin` : the Mellin transform `∫ (t : ℝ) in Ioi 0, t ^ (s - 1) • f t`, + where `s` is a complex number. +- `has_mellin`: shorthand asserting that the Mellin transform exists and has a given value + (analogous to `has_sum`). +- `mellin_differentiable_at_of_is_O_rpow` : if `f` is `O(x ^ (-a))` at infinity, and + `O(x ^ (-b))` at 0, then `mellin f` is holomorphic on the domain `b < re s < a`. + +-/ + +open measure_theory set filter asymptotics topological_space + +namespace complex + +/- Porting note: move this to `analysis.special_functions.pow.complex` -/ +lemma cpow_mul_of_real_nonneg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) (z : ℂ) : + (x : ℂ) ^ (↑y * z) = (↑(x ^ y) : ℂ) ^ z := +begin + rw [cpow_mul, of_real_cpow hx], + { rw [←of_real_log hx, ←of_real_mul, of_real_im, neg_lt_zero], exact real.pi_pos }, + { rw [←of_real_log hx, ←of_real_mul, of_real_im], exact real.pi_pos.le }, +end + +end complex + +open real complex (hiding exp log abs_of_nonneg) + +open_locale topology + +noncomputable theory + +section defs + +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] + +/-- Predicate on `f` and `s` asserting that the Mellin integral is well-defined. -/ +def mellin_convergent (f : ℝ → E) (s : ℂ) : Prop := +integrable_on (λ t : ℝ, (t : ℂ) ^ (s - 1) • f t) (Ioi 0) + +lemma mellin_convergent.const_smul {f : ℝ → E} {s : ℂ} (hf : mellin_convergent f s) + {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E] [smul_comm_class ℂ 𝕜 E] (c : 𝕜) : + mellin_convergent (λ t, c • f t) s := +by simpa only [mellin_convergent, smul_comm] using hf.smul c + +lemma mellin_convergent.cpow_smul {f : ℝ → E} {s a : ℂ} : + mellin_convergent (λ t, (t : ℂ) ^ a • f t) s ↔ mellin_convergent f (s + a) := +begin + refine integrable_on_congr_fun (λ t ht, _) measurable_set_Ioi, + simp_rw [←sub_add_eq_add_sub, cpow_add _ _ (of_real_ne_zero.2 $ ne_of_gt ht), mul_smul], +end + +lemma mellin_convergent.div_const {f : ℝ → ℂ} {s : ℂ} (hf : mellin_convergent f s) (a : ℂ) : + mellin_convergent (λ t, f t / a) s := +by simpa only [mellin_convergent, smul_eq_mul, ←mul_div_assoc] using hf.div_const a + +lemma mellin_convergent.comp_mul_left {f : ℝ → E} {s : ℂ} {a : ℝ} (ha : 0 < a) : + mellin_convergent (λ t, f (a * t)) s ↔ mellin_convergent f s := +begin + have := integrable_on_Ioi_comp_mul_left_iff (λ t : ℝ, (t : ℂ) ^ (s - 1) • f t) 0 ha, + rw mul_zero at this, + have h1 : eq_on (λ t : ℝ, (↑(a * t) : ℂ) ^ (s - 1) • f (a * t)) + ((a : ℂ) ^ (s - 1) • (λ t : ℝ, (t : ℂ) ^ (s - 1) • f (a * t))) (Ioi 0), + { intros t ht, + simp only [of_real_mul, mul_cpow_of_real_nonneg ha.le (le_of_lt ht), mul_smul, pi.smul_apply] }, + have h2 : (a : ℂ) ^ (s - 1) ≠ 0, + { rw [ne.def, cpow_eq_zero_iff, not_and_distrib, of_real_eq_zero], exact or.inl ha.ne' }, + simp_rw [mellin_convergent, ←this, integrable_on_congr_fun h1 measurable_set_Ioi, integrable_on, + integrable_smul_iff h2], +end + +lemma mellin_convergent.comp_rpow {f : ℝ → E} {s : ℂ} {a : ℝ} (ha : a ≠ 0) : + mellin_convergent (λ t, f (t ^ a)) s ↔ mellin_convergent f (s / a) := +begin + simp_rw mellin_convergent, + letI u : normed_space ℝ E := normed_space.complex_to_real, -- why isn't this automatic? + conv_rhs { rw ←@integrable_on_Ioi_comp_rpow_iff' _ _ u _ a ha }, + refine integrable_on_congr_fun (λ t ht, _) measurable_set_Ioi, + dsimp only [pi.smul_apply], + rw [←complex.coe_smul (t ^ (a - 1)), ←mul_smul, ←cpow_mul_of_real_nonneg (le_of_lt ht), + of_real_cpow (le_of_lt ht), ←cpow_add _ _ (of_real_ne_zero.mpr (ne_of_gt ht)), of_real_sub, + of_real_one, mul_sub, mul_div_cancel' _ (of_real_ne_zero.mpr ha), mul_one, add_comm, + ←add_sub_assoc, sub_add_cancel], +end + +variables [complete_space E] + +/-- The Mellin transform of a function `f` (for a complex exponent `s`), defined as the integral of +`t ^ (s - 1) • f` over `Ioi 0`. -/ +def mellin (f : ℝ → E) (s : ℂ) : E := +∫ t : ℝ in Ioi 0, (t : ℂ) ^ (s - 1) • f t + +-- next few lemmas don't require convergence of the Mellin transform (they are just 0 = 0 otherwise) + +lemma mellin_cpow_smul (f : ℝ → E) (s a : ℂ) : + mellin (λ t, (t : ℂ) ^ a • f t) s = mellin f (s + a) := +begin + refine set_integral_congr measurable_set_Ioi (λ t ht, _), + simp_rw [←sub_add_eq_add_sub, cpow_add _ _ (of_real_ne_zero.2 $ ne_of_gt ht), mul_smul], +end + +lemma mellin_const_smul (f : ℝ → E) (s : ℂ) + {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E] [smul_comm_class ℂ 𝕜 E] (c : 𝕜) : + mellin (λ t, c • f t) s = c • mellin f s := +by simp only [mellin, smul_comm, integral_smul] + +lemma mellin_div_const (f : ℝ → ℂ) (s a : ℂ) : + mellin (λ t, f t / a) s = mellin f s / a := +by simp_rw [mellin, smul_eq_mul, ←mul_div_assoc, integral_div] + +lemma mellin_comp_rpow (f : ℝ → E) (s : ℂ) {a : ℝ} (ha : a ≠ 0) : + mellin (λ t, f (t ^ a)) s = |a|⁻¹ • mellin f (s / a) := +begin + -- note: this is also true for a = 0 (both sides are zero), but this is mathematically + -- uninteresting and rather time-consuming to check + simp_rw mellin, + conv_rhs { rw [←integral_comp_rpow_Ioi _ ha, ←integral_smul] }, + refine set_integral_congr measurable_set_Ioi (λ t ht, _), + dsimp only, + rw [←mul_smul, ←mul_assoc, inv_mul_cancel, one_mul, ←smul_assoc, real_smul], + show |a| ≠ 0, { contrapose! ha, exact abs_eq_zero.mp ha }, + rw [of_real_cpow (le_of_lt ht), ←cpow_mul_of_real_nonneg (le_of_lt ht), + ←cpow_add _ _ (of_real_ne_zero.mpr $ ne_of_gt ht), of_real_sub, of_real_one, mul_sub, + mul_div_cancel' _ (of_real_ne_zero.mpr ha), add_comm, ←add_sub_assoc, mul_one, sub_add_cancel] +end + +lemma mellin_comp_mul_left (f : ℝ → E) (s : ℂ) {a : ℝ} (ha : 0 < a) : + mellin (λ t, f (a * t)) s = (a : ℂ) ^ (-s) • mellin f s := +begin + simp_rw mellin, + have : eq_on (λ t : ℝ, (t : ℂ) ^ (s - 1) • f (a * t)) + (λ t : ℝ, (a : ℂ) ^ (1 - s) • (λ u : ℝ, (u : ℂ) ^ (s - 1) • f u) (a * t)) (Ioi 0), + { intros t ht, + dsimp only, + rw [of_real_mul, mul_cpow_of_real_nonneg ha.le (le_of_lt ht), ←mul_smul, + (by ring : 1 - s = -(s - 1)), cpow_neg, inv_mul_cancel_left₀], + rw [ne.def, cpow_eq_zero_iff, of_real_eq_zero, not_and_distrib], + exact or.inl ha.ne' }, + rw [set_integral_congr measurable_set_Ioi this, integral_smul, + integral_comp_mul_left_Ioi _ _ ha, mul_zero, ←complex.coe_smul, ←mul_smul, sub_eq_add_neg, + cpow_add _ _ (of_real_ne_zero.mpr ha.ne'), cpow_one, abs_of_pos (inv_pos.mpr ha), of_real_inv, + mul_assoc, mul_comm, inv_mul_cancel_right₀ (of_real_ne_zero.mpr ha.ne')] +end + +lemma mellin_comp_mul_right (f : ℝ → E) (s : ℂ) {a : ℝ} (ha : 0 < a) : + mellin (λ t, f (t * a)) s = (a : ℂ) ^ (-s) • mellin f s := +by simpa only [mul_comm] using mellin_comp_mul_left f s ha + +lemma mellin_comp_inv (f : ℝ → E) (s : ℂ) : mellin (λ t, f (t⁻¹)) s = mellin f (-s) := +by simp_rw [←rpow_neg_one, mellin_comp_rpow _ _ (neg_ne_zero.mpr one_ne_zero), abs_neg, abs_one, + inv_one, one_smul, of_real_neg, of_real_one, div_neg, div_one] + +/-- Predicate standing for "the Mellin transform of `f` is defined at `s` and equal to `m`". This +shortens some arguments. -/ +def has_mellin (f : ℝ → E) (s : ℂ) (m : E) : Prop := mellin_convergent f s ∧ mellin f s = m + +lemma has_mellin_add {f g : ℝ → E} {s : ℂ} + (hf : mellin_convergent f s) (hg : mellin_convergent g s) : + has_mellin (λ t, f t + g t) s (mellin f s + mellin g s) := +⟨by simpa only [mellin_convergent, smul_add] using hf.add hg, + by simpa only [mellin, smul_add] using integral_add hf hg⟩ + +lemma has_mellin_sub {f g : ℝ → E} {s : ℂ} + (hf : mellin_convergent f s) (hg : mellin_convergent g s) : + has_mellin (λ t, f t - g t) s (mellin f s - mellin g s) := +⟨by simpa only [mellin_convergent, smul_sub] using hf.sub hg, + by simpa only [mellin, smul_sub] using integral_sub hf hg⟩ + +end defs + +variables {E : Type*} [normed_add_comm_group E] + +section mellin_convergent +/-! ## Convergence of Mellin transform integrals -/ + +/-- Auxiliary lemma to reduce convergence statements from vector-valued functions to real +scalar-valued functions. -/ +lemma mellin_convergent_iff_norm [normed_space ℂ E] {f : ℝ → E} + {T : set ℝ} (hT : T ⊆ Ioi 0) (hT' : measurable_set T) + (hfc : ae_strongly_measurable f $ volume.restrict $ Ioi 0) {s : ℂ} : + integrable_on (λ t : ℝ, (t : ℂ) ^ (s - 1) • f t) T + ↔ integrable_on (λ t : ℝ, t ^ (s.re - 1) * ‖f t‖) T := +begin + have : ae_strongly_measurable (λ t : ℝ, (t : ℂ) ^ (s - 1) • f t) (volume.restrict T), + { refine ((continuous_at.continuous_on _).ae_strongly_measurable hT').smul (hfc.mono_set hT), + exact λ t ht, continuous_at_of_real_cpow_const _ _ (or.inr $ ne_of_gt (hT ht)) }, + rw [integrable_on, ←integrable_norm_iff this, ←integrable_on], + refine integrable_on_congr_fun (λ t ht, _) hT', + simp_rw [norm_smul, complex.norm_eq_abs, abs_cpow_eq_rpow_re_of_pos (hT ht), sub_re, one_re], +end + +/-- If `f` is a locally integrable real-valued function which is `O(x ^ (-a))` at `∞`, then for any +`s < a`, its Mellin transform converges on some neighbourhood of `+∞`. -/ +lemma mellin_convergent_top_of_is_O + {f : ℝ → ℝ} (hfc : ae_strongly_measurable f $ volume.restrict (Ioi 0)) + {a s : ℝ} (hf : is_O at_top f (λ t, t ^ (-a))) (hs : s < a) : + ∃ (c : ℝ), 0 < c ∧ integrable_on (λ t : ℝ, t ^ (s - 1) * f t) (Ioi c) := +begin + obtain ⟨d, hd, hd'⟩ := hf.exists_pos, + simp_rw [is_O_with, eventually_at_top] at hd', + obtain ⟨e, he⟩ := hd', + have he' : 0 < max e 1, from zero_lt_one.trans_le (le_max_right _ _), + refine ⟨max e 1, he', _, _⟩, + { refine ae_strongly_measurable.mul _ (hfc.mono_set (Ioi_subset_Ioi he'.le)), + refine (continuous_at.continuous_on (λ t ht, _)).ae_strongly_measurable measurable_set_Ioi, + exact continuous_at_rpow_const _ _ (or.inl $ (he'.trans ht).ne') }, + { have : ∀ᵐ (t : ℝ) ∂volume.restrict (Ioi $ max e 1), + ‖t ^ (s - 1) * f t‖ ≤ t ^ ((s - 1) + -a) * d, + { refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (λ t ht, _)), + have ht' : 0 < t, from he'.trans ht, + rw [norm_mul, rpow_add ht', ←norm_of_nonneg (rpow_nonneg_of_nonneg ht'.le (-a)), + mul_assoc, mul_comm _ d, norm_of_nonneg (rpow_nonneg_of_nonneg ht'.le _)], + exact mul_le_mul_of_nonneg_left (he t ((le_max_left e 1).trans_lt ht).le) + (rpow_pos_of_pos ht' _).le }, + refine (has_finite_integral.mul_const _ _).mono' this, + exact (integrable_on_Ioi_rpow_of_lt (by linarith) he').has_finite_integral } +end + +/-- If `f` is a locally integrable real-valued function which is `O(x ^ (-b))` at `0`, then for any +`b < s`, its Mellin transform converges on some right neighbourhood of `0`. -/ +lemma mellin_convergent_zero_of_is_O + {b : ℝ} {f : ℝ → ℝ} (hfc : ae_strongly_measurable f $ volume.restrict (Ioi 0)) + (hf : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) {s : ℝ} (hs : b < s) : + ∃ (c : ℝ), 0 < c ∧ integrable_on (λ t : ℝ, t ^ (s - 1) * f t) (Ioc 0 c) := +begin + obtain ⟨d, hd, hd'⟩ := hf.exists_pos, + simp_rw [is_O_with, eventually_nhds_within_iff, metric.eventually_nhds_iff, gt_iff_lt] at hd', + obtain ⟨ε, hε, hε'⟩ := hd', + refine ⟨ε, hε, integrable_on_Ioc_iff_integrable_on_Ioo.mpr ⟨_, _⟩⟩, + { refine ae_strongly_measurable.mul _ (hfc.mono_set Ioo_subset_Ioi_self), + refine (continuous_at.continuous_on (λ t ht, _)).ae_strongly_measurable measurable_set_Ioo, + exact continuous_at_rpow_const _ _ (or.inl ht.1.ne') }, + { apply has_finite_integral.mono', + { show has_finite_integral (λ t, d * t ^ (s - b - 1)) _, + refine (integrable.has_finite_integral _).const_mul _, + rw [←integrable_on, ←integrable_on_Ioc_iff_integrable_on_Ioo, + ←interval_integrable_iff_integrable_Ioc_of_le hε.le], + exact interval_integral.interval_integrable_rpow' (by linarith) }, + { refine (ae_restrict_iff' measurable_set_Ioo).mpr (eventually_of_forall $ λ t ht, _), + rw [mul_comm, norm_mul], + specialize hε' _ ht.1, + { rw [dist_eq_norm, sub_zero, norm_of_nonneg (le_of_lt ht.1)], + exact ht.2 }, + { refine (mul_le_mul_of_nonneg_right hε' (norm_nonneg _)).trans _, + simp_rw [norm_of_nonneg (rpow_nonneg_of_nonneg (le_of_lt ht.1) _), mul_assoc], + refine mul_le_mul_of_nonneg_left (le_of_eq _) hd.le, + rw ←rpow_add ht.1, + congr' 1, + abel } } }, +end + +/-- If `f` is a locally integrable real-valued function on `Ioi 0` which is `O(x ^ (-a))` at `∞` +and `O(x ^ (-b))` at `0`, then its Mellin transform integral converges for `b < s < a`. -/ +lemma mellin_convergent_of_is_O_scalar + {a b : ℝ} {f : ℝ → ℝ} {s : ℝ} + (hfc : locally_integrable_on f $ Ioi 0) + (hf_top : is_O at_top f (λ t, t ^ (-a))) (hs_top : s < a) + (hf_bot : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) (hs_bot : b < s) : + integrable_on (λ t : ℝ, t ^ (s - 1) * f t) (Ioi 0) := +begin + obtain ⟨c1, hc1, hc1'⟩ := mellin_convergent_top_of_is_O hfc.ae_strongly_measurable hf_top hs_top, + obtain ⟨c2, hc2, hc2'⟩ := mellin_convergent_zero_of_is_O hfc.ae_strongly_measurable hf_bot hs_bot, + have : Ioi 0 = Ioc 0 c2 ∪ Ioc c2 c1 ∪ Ioi c1, + { rw [union_assoc, Ioc_union_Ioi (le_max_right _ _), Ioc_union_Ioi + ((min_le_left _ _).trans (le_max_right _ _)), min_eq_left (lt_min hc2 hc1).le] }, + rw [this, integrable_on_union, integrable_on_union], + refine ⟨⟨hc2', integrable_on_Icc_iff_integrable_on_Ioc.mp _⟩, hc1'⟩, + refine (hfc.continuous_on_mul _ is_open_Ioi).integrable_on_compact_subset + (λ t ht, (hc2.trans_le ht.1 : 0 < t)) is_compact_Icc, + exact continuous_at.continuous_on (λ t ht, continuous_at_rpow_const _ _ $ or.inl $ ne_of_gt ht), +end + +lemma mellin_convergent_of_is_O_rpow [normed_space ℂ E] + {a b : ℝ} {f : ℝ → E} {s : ℂ} + (hfc : locally_integrable_on f $ Ioi 0) + (hf_top : is_O at_top f (λ t, t ^ (-a))) (hs_top : s.re < a) + (hf_bot : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) (hs_bot : b < s.re) : + mellin_convergent f s := +begin + rw [mellin_convergent, mellin_convergent_iff_norm (subset_refl _) measurable_set_Ioi + hfc.ae_strongly_measurable], + exact mellin_convergent_of_is_O_scalar + hfc.norm hf_top.norm_left hs_top hf_bot.norm_left hs_bot, +end + +end mellin_convergent + +section mellin_diff + +/-- If `f` is `O(x ^ (-a))` as `x → +∞`, then `log • f` is `O(x ^ (-b))` for every `b < a`. -/ +lemma is_O_rpow_top_log_smul [normed_space ℝ E] {a b : ℝ} {f : ℝ → E} + (hab : b < a) (hf : is_O at_top f (λ t, t ^ (-a))) : + is_O at_top (λ t : ℝ, log t • f t) (λ t, t ^ (-b)) := +begin + refine ((is_o_log_rpow_at_top (sub_pos.mpr hab)).is_O.smul hf).congr' + (eventually_of_forall (λ t, by refl)) + ((eventually_gt_at_top 0).mp (eventually_of_forall (λ t ht, _))), + rw [smul_eq_mul, ←rpow_add ht, ←sub_eq_add_neg, sub_eq_add_neg a, add_sub_cancel'], +end + +/-- If `f` is `O(x ^ (-a))` as `x → 0`, then `log • f` is `O(x ^ (-b))` for every `a < b`. -/ +lemma is_O_rpow_zero_log_smul [normed_space ℝ E] {a b : ℝ} {f : ℝ → E} + (hab : a < b) (hf : is_O (𝓝[>] 0) f (λ t, t ^ (-a))) : + is_O (𝓝[>] 0) (λ t : ℝ, log t • f t) (λ t, t ^ (-b)) := +begin + have : is_o (𝓝[>] 0) log (λ t : ℝ, t ^ (a - b)), + { refine ((is_o_log_rpow_at_top (sub_pos.mpr hab)).neg_left.comp_tendsto + tendsto_inv_zero_at_top).congr' + (eventually_nhds_within_iff.mpr $ eventually_of_forall (λ t ht, _)) + (eventually_nhds_within_iff.mpr $ eventually_of_forall (λ t ht, _)), + { simp_rw [function.comp_app, ←one_div, log_div one_ne_zero (ne_of_gt ht), real.log_one, + zero_sub, neg_neg] }, + { simp_rw [function.comp_app, inv_rpow (le_of_lt ht), ←rpow_neg (le_of_lt ht), neg_sub] } }, + refine (this.is_O.smul hf).congr' + (eventually_of_forall (λ t, by refl)) + (eventually_nhds_within_iff.mpr (eventually_of_forall (λ t ht, _))), + simp_rw [smul_eq_mul, ←rpow_add ht], + congr' 1, + abel, +end + +/-- Suppose `f` is locally integrable on `(0, ∞)`, is `O(x ^ (-a))` as `x → ∞`, and is +`O(x ^ (-b))` as `x → 0`. Then its Mellin transform is differentiable on the domain `b < re s < a`, +with derivative equal to the Mellin transform of `log • f`. -/ +theorem mellin_has_deriv_of_is_O_rpow [complete_space E] [normed_space ℂ E] + {a b : ℝ} {f : ℝ → E} {s : ℂ} + (hfc : locally_integrable_on f $ Ioi 0) + (hf_top : is_O at_top f (λ t, t ^ (-a))) (hs_top : s.re < a) + (hf_bot : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) (hs_bot : b < s.re) : + mellin_convergent (λ t, log t • f t) s ∧ + has_deriv_at (mellin f) (mellin (λ t, log t • f t) s) s := +begin + let F : ℂ → ℝ → E := λ z t, (t : ℂ) ^ (z - 1) • f t, + let F' : ℂ → ℝ → E := λ z t, ((t : ℂ) ^ (z - 1) * log t) • f t, + have hab : b < a := hs_bot.trans hs_top, + -- A convenient radius of ball within which we can uniformly bound the derivative. + obtain ⟨v, hv0, hv1, hv2⟩ : ∃ (v : ℝ), (0 < v) ∧ (v < s.re - b) ∧ (v < a - s.re), + { obtain ⟨w, hw1, hw2⟩ := exists_between (sub_pos.mpr hs_top), + obtain ⟨w', hw1', hw2'⟩ := exists_between (sub_pos.mpr hs_bot), + exact ⟨min w w', lt_min hw1 hw1', + (min_le_right _ _).trans_lt hw2', (min_le_left _ _).trans_lt hw2⟩ }, + let bound : ℝ → ℝ := λ t : ℝ, (t ^ (s.re + v - 1) + t ^ (s.re - v - 1)) * |log t| * ‖f t‖, + have h1 : ∀ᶠ (z : ℂ) in 𝓝 s, ae_strongly_measurable (F z) (volume.restrict $ Ioi 0), + { refine eventually_of_forall (λ z, ae_strongly_measurable.smul _ hfc.ae_strongly_measurable), + refine continuous_on.ae_strongly_measurable _ measurable_set_Ioi, + refine continuous_at.continuous_on (λ t ht, _), + exact (continuous_at_of_real_cpow_const _ _ (or.inr $ ne_of_gt ht)), }, + have h2 : integrable_on (F s) (Ioi 0), + { exact mellin_convergent_of_is_O_rpow hfc hf_top hs_top hf_bot hs_bot }, + have h3 : ae_strongly_measurable (F' s) (volume.restrict $ Ioi 0), + { apply locally_integrable_on.ae_strongly_measurable, + refine hfc.continuous_on_smul is_open_Ioi ((continuous_at.continuous_on (λ t ht, _)).mul _), + { exact continuous_at_of_real_cpow_const _ _ (or.inr $ ne_of_gt ht) }, + { refine continuous_of_real.comp_continuous_on _, + exact continuous_on_log.mono (subset_compl_singleton_iff.mpr not_mem_Ioi_self) } }, + have h4 : (∀ᵐ (t : ℝ) ∂volume.restrict (Ioi 0), ∀ (z : ℂ), + z ∈ metric.ball s v → ‖F' z t‖ ≤ bound t), + { refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ $ λ t ht z hz, _), + simp_rw [bound, F', norm_smul, norm_mul, complex.norm_eq_abs (log _), complex.abs_of_real, + mul_assoc], + refine mul_le_mul_of_nonneg_right _ (mul_nonneg (abs_nonneg _) (norm_nonneg _)), + rw [complex.norm_eq_abs, abs_cpow_eq_rpow_re_of_pos ht], + rcases le_or_lt 1 t, + { refine le_add_of_le_of_nonneg (rpow_le_rpow_of_exponent_le h _) + (rpow_nonneg_of_nonneg (zero_le_one.trans h) _), + rw [sub_re, one_re, sub_le_sub_iff_right], + rw [mem_ball_iff_norm, complex.norm_eq_abs] at hz, + have hz' := (re_le_abs _).trans hz.le, + rwa [sub_re, sub_le_iff_le_add'] at hz' }, + { refine le_add_of_nonneg_of_le (rpow_pos_of_pos ht _).le + (rpow_le_rpow_of_exponent_ge ht h.le _), + rw [sub_re, one_re, sub_le_iff_le_add, sub_add_cancel], + rw [mem_ball_iff_norm', complex.norm_eq_abs] at hz, + have hz' := (re_le_abs _).trans hz.le, + rwa [sub_re, sub_le_iff_le_add, ←sub_le_iff_le_add'] at hz', } }, + have h5 : integrable_on bound (Ioi 0), + { simp_rw [bound, add_mul, mul_assoc], + suffices : ∀ {j : ℝ} (hj : b < j) (hj' : j < a), + integrable_on (λ (t : ℝ), t ^ (j - 1) * (|log t| * ‖f t‖)) (Ioi 0) volume, + { refine integrable.add (this _ _) (this _ _), + all_goals { linarith } }, + { intros j hj hj', + obtain ⟨w, hw1, hw2⟩ := exists_between hj, + obtain ⟨w', hw1', hw2'⟩ := exists_between hj', + refine mellin_convergent_of_is_O_scalar _ _ hw1' _ hw2, + { simp_rw mul_comm, + refine hfc.norm.mul_continuous_on _ is_open_Ioi, + refine continuous.comp_continuous_on continuous_abs (continuous_on_log.mono _), + exact subset_compl_singleton_iff.mpr not_mem_Ioi_self }, + { refine (is_O_rpow_top_log_smul hw2' hf_top).norm_left.congr' _ (eventually_eq.refl _ _), + refine (eventually_gt_at_top 0).mp (eventually_of_forall (λ t ht, _)), + simp only [norm_smul, real.norm_eq_abs] }, + { refine (is_O_rpow_zero_log_smul hw1 hf_bot).norm_left.congr' _ (eventually_eq.refl _ _), + refine eventually_nhds_within_iff.mpr (eventually_of_forall (λ t ht, _)), + simp only [norm_smul, real.norm_eq_abs] } } }, + have h6 : ∀ᵐ (t : ℝ) ∂volume.restrict (Ioi 0), ∀ (y : ℂ), + y ∈ metric.ball s v → has_deriv_at (λ (z : ℂ), F z t) (F' y t) y, + { dsimp only [F, F'], + refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ $ λ t ht y hy, _), + have ht' : (t : ℂ) ≠ 0 := of_real_ne_zero.mpr (ne_of_gt ht), + have u1 : has_deriv_at (λ z : ℂ, (t : ℂ) ^ (z - 1)) (t ^ (y - 1) * log t) y, + { convert ((has_deriv_at_id' y).sub_const 1).const_cpow (or.inl ht') using 1, + rw of_real_log (le_of_lt ht), + ring }, + exact u1.smul_const (f t) }, + have main := has_deriv_at_integral_of_dominated_loc_of_deriv_le hv0 h1 h2 h3 h4 h5 h6, + exact ⟨by simpa only [F', mul_smul] using main.1, by simpa only [F', mul_smul] using main.2⟩ +end + +/-- Suppose `f` is locally integrable on `(0, ∞)`, is `O(x ^ (-a))` as `x → ∞`, and is +`O(x ^ (-b))` as `x → 0`. Then its Mellin transform is differentiable on the domain `b < re s < a`. +-/ +lemma mellin_differentiable_at_of_is_O_rpow [complete_space E] [normed_space ℂ E] + {a b : ℝ} {f : ℝ → E} {s : ℂ} + (hfc : locally_integrable_on f $ Ioi 0) + (hf_top : is_O at_top f (λ t, t ^ (-a))) (hs_top : s.re < a) + (hf_bot : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) (hs_bot : b < s.re) : + differentiable_at ℂ (mellin f) s := +(mellin_has_deriv_of_is_O_rpow hfc hf_top hs_top hf_bot hs_bot).2.differentiable_at + +end mellin_diff + +section exp_decay + +/-- If `f` is locally integrable, decays exponentially at infinity, and is `O(x ^ (-b))` at 0, then +its Mellin transform converges for `b < s.re`. -/ +lemma mellin_convergent_of_is_O_rpow_exp [normed_space ℂ E] + {a b : ℝ} (ha : 0 < a) {f : ℝ → E} {s : ℂ} + (hfc : locally_integrable_on f $ Ioi 0) + (hf_top : is_O at_top f (λ t, exp (-a * t))) + (hf_bot : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) (hs_bot : b < s.re) : + mellin_convergent f s := +mellin_convergent_of_is_O_rpow hfc (hf_top.trans (is_o_exp_neg_mul_rpow_at_top ha _).is_O) + (lt_add_one _) hf_bot hs_bot + +/-- If `f` is locally integrable, decays exponentially at infinity, and is `O(x ^ (-b))` at 0, then +its Mellin transform is holomorphic on `b < s.re`. -/ +lemma mellin_differentiable_at_of_is_O_rpow_exp [complete_space E] [normed_space ℂ E] + {a b : ℝ} (ha : 0 < a) {f : ℝ → E} {s : ℂ} + (hfc : locally_integrable_on f $ Ioi 0) + (hf_top : is_O at_top f (λ t, exp (-a * t))) + (hf_bot : is_O (𝓝[>] 0) f (λ t, t ^ (-b))) (hs_bot : b < s.re) : + differentiable_at ℂ (mellin f) s := +mellin_differentiable_at_of_is_O_rpow hfc (hf_top.trans (is_o_exp_neg_mul_rpow_at_top ha _).is_O) + (lt_add_one _) hf_bot hs_bot + +end exp_decay + +section mellin_Ioc +/-! +## Mellin transforms of functions on `Ioc 0 1` +-/ + +/-- The Mellin transform of the indicator function of `Ioc 0 1`. -/ +lemma has_mellin_one_Ioc {s : ℂ} (hs : 0 < re s) : + has_mellin (indicator (Ioc 0 1) (λ t, 1 : ℝ → ℂ)) s (1 / s) := +begin + have aux1 : -1 < (s - 1).re, by simpa only [sub_re, one_re, sub_eq_add_neg] + using lt_add_of_pos_left _ hs, + have aux2 : s ≠ 0, by { contrapose! hs, rw [hs, zero_re] }, + have aux3 : measurable_set (Ioc (0 : ℝ) 1), from measurable_set_Ioc, + simp_rw [has_mellin, mellin, mellin_convergent, ←indicator_smul, integrable_on, + integrable_indicator_iff aux3, smul_eq_mul, integral_indicator aux3, + mul_one, integrable_on, measure.restrict_restrict_of_subset Ioc_subset_Ioi_self], + rw [←integrable_on, ←interval_integrable_iff_integrable_Ioc_of_le zero_le_one], + refine ⟨interval_integral.interval_integrable_cpow' aux1, _⟩, + rw [←interval_integral.integral_of_le zero_le_one, integral_cpow (or.inl aux1), sub_add_cancel, + of_real_zero, of_real_one, one_cpow, zero_cpow aux2, sub_zero] +end + +/-- The Mellin transform of a power function restricted to `Ioc 0 1`. -/ +lemma has_mellin_cpow_Ioc (a : ℂ) {s : ℂ} (hs : 0 < re s + re a) : + has_mellin (indicator (Ioc 0 1) (λ t, ↑t ^ a : ℝ → ℂ)) s (1 / (s + a)) := +begin + have := has_mellin_one_Ioc (by rwa add_re : 0 < (s + a).re), + simp_rw [has_mellin, ←mellin_convergent.cpow_smul, ←mellin_cpow_smul, ←indicator_smul, + smul_eq_mul, mul_one] at this, + exact this +end + +end mellin_Ioc diff --git a/src/analysis/normed/field/basic.lean b/src/analysis/normed/field/basic.lean new file mode 100644 index 0000000000000..bd9a12ae695e5 --- /dev/null +++ b/src/analysis/normed/field/basic.lean @@ -0,0 +1,869 @@ +/- +Copyright (c) 2018 Patrick Massot. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Patrick Massot, Johannes Hölzl +-/ +import algebra.algebra.subalgebra.basic +import analysis.normed.group.basic +import topology.instances.ennreal + +/-! +# Normed fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define (semi)normed rings and fields. We also prove some theorems about these +definitions. +-/ + +variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*} + +open filter metric +open_locale topology big_operators nnreal ennreal uniformity pointwise + +/-- A non-unital seminormed ring is a not-necessarily-unital ring +endowed with a seminorm which satisfies the inequality `‖x y‖ ≤ ‖x‖ ‖y‖`. -/ +class non_unital_semi_normed_ring (α : Type*) + extends has_norm α, non_unital_ring α, pseudo_metric_space α := +(dist_eq : ∀ x y, dist x y = norm (x - y)) +(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) + +/-- A seminormed ring is a ring endowed with a seminorm which satisfies the inequality +`‖x y‖ ≤ ‖x‖ ‖y‖`. -/ +class semi_normed_ring (α : Type*) extends has_norm α, ring α, pseudo_metric_space α := +(dist_eq : ∀ x y, dist x y = norm (x - y)) +(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) + +/-- A seminormed ring is a non-unital seminormed ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance semi_normed_ring.to_non_unital_semi_normed_ring [β : semi_normed_ring α] : + non_unital_semi_normed_ring α := +{ ..β } + +/-- A non-unital normed ring is a not-necessarily-unital ring +endowed with a norm which satisfies the inequality `‖x y‖ ≤ ‖x‖ ‖y‖`. -/ +class non_unital_normed_ring (α : Type*) extends has_norm α, non_unital_ring α, metric_space α := +(dist_eq : ∀ x y, dist x y = norm (x - y)) +(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) + +/-- A non-unital normed ring is a non-unital seminormed ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance non_unital_normed_ring.to_non_unital_semi_normed_ring [β : non_unital_normed_ring α] : + non_unital_semi_normed_ring α := +{ ..β } + +/-- A normed ring is a ring endowed with a norm which satisfies the inequality `‖x y‖ ≤ ‖x‖ ‖y‖`. -/ +class normed_ring (α : Type*) extends has_norm α, ring α, metric_space α := +(dist_eq : ∀ x y, dist x y = norm (x - y)) +(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) + +/-- A normed division ring is a division ring endowed with a seminorm which satisfies the equality +`‖x y‖ = ‖x‖ ‖y‖`. -/ +class normed_division_ring (α : Type*) extends has_norm α, division_ring α, metric_space α := +(dist_eq : ∀ x y, dist x y = norm (x - y)) +(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b) + +/-- A normed division ring is a normed ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance normed_division_ring.to_normed_ring [β : normed_division_ring α] : normed_ring α := +{ norm_mul := λ a b, (normed_division_ring.norm_mul' a b).le, + ..β } + +/-- A normed ring is a seminormed ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance normed_ring.to_semi_normed_ring [β : normed_ring α] : semi_normed_ring α := +{ ..β } + +/-- A normed ring is a non-unital normed ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance normed_ring.to_non_unital_normed_ring [β : normed_ring α] : non_unital_normed_ring α := +{ ..β } + +/-- A seminormed commutative ring is a commutative ring endowed with a seminorm which satisfies +the inequality `‖x y‖ ≤ ‖x‖ ‖y‖`. -/ +class semi_normed_comm_ring (α : Type*) extends semi_normed_ring α := +(mul_comm : ∀ x y : α, x * y = y * x) + +/-- A normed commutative ring is a commutative ring endowed with a norm which satisfies +the inequality `‖x y‖ ≤ ‖x‖ ‖y‖`. -/ +class normed_comm_ring (α : Type*) extends normed_ring α := +(mul_comm : ∀ x y : α, x * y = y * x) + +/-- A normed commutative ring is a seminormed commutative ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance normed_comm_ring.to_semi_normed_comm_ring [β : normed_comm_ring α] : + semi_normed_comm_ring α := { ..β } + +instance : normed_comm_ring punit := +{ norm_mul := λ _ _, by simp, + ..punit.normed_add_comm_group, + ..punit.comm_ring, } + +/-- A mixin class with the axiom `‖1‖ = 1`. Many `normed_ring`s and all `normed_field`s satisfy this +axiom. -/ +class norm_one_class (α : Type*) [has_norm α] [has_one α] : Prop := +(norm_one : ‖(1:α)‖ = 1) + +export norm_one_class (norm_one) + +attribute [simp] norm_one + +@[simp] lemma nnnorm_one [seminormed_add_comm_group α] [has_one α] [norm_one_class α] : + ‖(1 : α)‖₊ = 1 := +nnreal.eq norm_one + +lemma norm_one_class.nontrivial (α : Type*) [seminormed_add_comm_group α] [has_one α] + [norm_one_class α] : + nontrivial α := +nontrivial_of_ne 0 1 $ ne_of_apply_ne norm $ by simp + +@[priority 100] -- see Note [lower instance priority] +instance semi_normed_comm_ring.to_comm_ring [β : semi_normed_comm_ring α] : comm_ring α := { ..β } + +@[priority 100] -- see Note [lower instance priority] +instance non_unital_normed_ring.to_normed_add_comm_group [β : non_unital_normed_ring α] : + normed_add_comm_group α := +{ ..β } + +@[priority 100] -- see Note [lower instance priority] +instance non_unital_semi_normed_ring.to_seminormed_add_comm_group [non_unital_semi_normed_ring α] : + seminormed_add_comm_group α := { ..‹non_unital_semi_normed_ring α› } + +instance [seminormed_add_comm_group α] [has_one α] [norm_one_class α] : norm_one_class (ulift α) := +⟨by simp [ulift.norm_def]⟩ + +instance prod.norm_one_class [seminormed_add_comm_group α] [has_one α] [norm_one_class α] + [seminormed_add_comm_group β] [has_one β] [norm_one_class β] : + norm_one_class (α × β) := +⟨by simp [prod.norm_def]⟩ + +instance pi.norm_one_class {ι : Type*} {α : ι → Type*} [nonempty ι] [fintype ι] + [Π i, seminormed_add_comm_group (α i)] [Π i, has_one (α i)] [∀ i, norm_one_class (α i)] : + norm_one_class (Π i, α i) := +⟨by simp [pi.norm_def, finset.sup_const finset.univ_nonempty]⟩ + +instance mul_opposite.norm_one_class [seminormed_add_comm_group α] [has_one α] [norm_one_class α] : + norm_one_class αᵐᵒᵖ := +⟨@norm_one α _ _ _⟩ + +section non_unital_semi_normed_ring +variables [non_unital_semi_normed_ring α] + +lemma norm_mul_le (a b : α) : (‖a*b‖) ≤ (‖a‖) * (‖b‖) := +non_unital_semi_normed_ring.norm_mul _ _ + +lemma nnnorm_mul_le (a b : α) : ‖a * b‖₊ ≤ ‖a‖₊ * ‖b‖₊ := +by simpa only [←norm_to_nnreal, ←real.to_nnreal_mul (norm_nonneg _)] + using real.to_nnreal_mono (norm_mul_le _ _) + +lemma one_le_norm_one (β) [normed_ring β] [nontrivial β] : 1 ≤ ‖(1 : β)‖ := +(le_mul_iff_one_le_left $ norm_pos_iff.mpr (one_ne_zero : (1 : β) ≠ 0)).mp + (by simpa only [mul_one] using norm_mul_le (1 : β) 1) + +lemma one_le_nnnorm_one (β) [normed_ring β] [nontrivial β] : 1 ≤ ‖(1 : β)‖₊ := +one_le_norm_one β + +lemma filter.tendsto.zero_mul_is_bounded_under_le {f g : ι → α} {l : filter ι} + (hf : tendsto f l (𝓝 0)) (hg : is_bounded_under (≤) l (norm ∘ g)) : + tendsto (λ x, f x * g x) l (𝓝 0) := +hf.op_zero_is_bounded_under_le hg (*) norm_mul_le + +lemma filter.is_bounded_under_le.mul_tendsto_zero {f g : ι → α} {l : filter ι} + (hf : is_bounded_under (≤) l (norm ∘ f)) (hg : tendsto g l (𝓝 0)) : + tendsto (λ x, f x * g x) l (𝓝 0) := +hg.op_zero_is_bounded_under_le hf (flip (*)) (λ x y, ((norm_mul_le y x).trans_eq (mul_comm _ _))) + +/-- In a seminormed ring, the left-multiplication `add_monoid_hom` is bounded. -/ +lemma mul_left_bound (x : α) : + ∀ (y:α), ‖add_monoid_hom.mul_left x y‖ ≤ ‖x‖ * ‖y‖ := +norm_mul_le x + +/-- In a seminormed ring, the right-multiplication `add_monoid_hom` is bounded. -/ +lemma mul_right_bound (x : α) : + ∀ (y:α), ‖add_monoid_hom.mul_right x y‖ ≤ ‖x‖ * ‖y‖ := +λ y, by {rw mul_comm, convert norm_mul_le y x} + +instance : non_unital_semi_normed_ring (ulift α) := +{ norm_mul := λ x y, (norm_mul_le x.down y.down : _), + .. ulift.seminormed_add_comm_group } + +/-- Non-unital seminormed ring structure on the product of two non-unital seminormed rings, + using the sup norm. -/ +instance prod.non_unital_semi_normed_ring [non_unital_semi_normed_ring β] : + non_unital_semi_normed_ring (α × β) := +{ norm_mul := assume x y, + calc + ‖x * y‖ = ‖(x.1*y.1, x.2*y.2)‖ : rfl + ... = (max ‖x.1*y.1‖ ‖x.2*y.2‖) : rfl + ... ≤ (max (‖x.1‖*‖y.1‖) (‖x.2‖*‖y.2‖)) : + max_le_max (norm_mul_le (x.1) (y.1)) (norm_mul_le (x.2) (y.2)) + ... = (max (‖x.1‖*‖y.1‖) (‖y.2‖*‖x.2‖)) : by simp[mul_comm] + ... ≤ (max (‖x.1‖) (‖x.2‖)) * (max (‖y.2‖) (‖y.1‖)) : + by apply max_mul_mul_le_max_mul_max; simp [norm_nonneg] + ... = (max (‖x.1‖) (‖x.2‖)) * (max (‖y.1‖) (‖y.2‖)) : by simp [max_comm] + ... = (‖x‖*‖y‖) : rfl, + ..prod.seminormed_add_comm_group } + +/-- Non-unital seminormed ring structure on the product of finitely many non-unital seminormed +rings, using the sup norm. -/ +instance pi.non_unital_semi_normed_ring {π : ι → Type*} [fintype ι] + [Π i, non_unital_semi_normed_ring (π i)] : + non_unital_semi_normed_ring (Π i, π i) := +{ norm_mul := λ x y, nnreal.coe_mono $ + calc finset.univ.sup (λ i, ‖x i * y i‖₊) + ≤ finset.univ.sup ((λ i, ‖x i‖₊) * (λ i, ‖y i‖₊)) : + finset.sup_mono_fun $ λ b hb, norm_mul_le _ _ + ... ≤ finset.univ.sup (λ i, ‖x i‖₊) * finset.univ.sup (λ i, ‖y i‖₊) : + finset.sup_mul_le_mul_sup_of_nonneg _ (λ i _, zero_le _) (λ i _, zero_le _), + ..pi.seminormed_add_comm_group } + +instance mul_opposite.non_unital_semi_normed_ring : non_unital_semi_normed_ring αᵐᵒᵖ := +{ norm_mul := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, + (norm_mul_le y x).trans_eq (mul_comm _ _), + ..mul_opposite.seminormed_add_comm_group } + +end non_unital_semi_normed_ring + +section semi_normed_ring + +variables [semi_normed_ring α] + +/-- A subalgebra of a seminormed ring is also a seminormed ring, with the restriction of the norm. + +See note [implicit instance arguments]. -/ +instance subalgebra.semi_normed_ring {𝕜 : Type*} {_ : comm_ring 𝕜} + {E : Type*} [semi_normed_ring E] {_ : algebra 𝕜 E} (s : subalgebra 𝕜 E) : semi_normed_ring s := +{ norm_mul := λ a b, norm_mul_le a.1 b.1, + ..s.to_submodule.seminormed_add_comm_group } + +/-- A subalgebra of a normed ring is also a normed ring, with the restriction of the norm. + +See note [implicit instance arguments]. -/ +instance subalgebra.normed_ring {𝕜 : Type*} {_ : comm_ring 𝕜} + {E : Type*} [normed_ring E] {_ : algebra 𝕜 E} (s : subalgebra 𝕜 E) : normed_ring s := +{ ..s.semi_normed_ring } + +lemma nat.norm_cast_le : ∀ n : ℕ, ‖(n : α)‖ ≤ n * ‖(1 : α)‖ +| 0 := by simp +| (n + 1) := by { rw [n.cast_succ, n.cast_succ, add_mul, one_mul], + exact norm_add_le_of_le (nat.norm_cast_le n) le_rfl } + +lemma list.norm_prod_le' : ∀ {l : list α}, l ≠ [] → ‖l.prod‖ ≤ (l.map norm).prod +| [] h := (h rfl).elim +| [a] _ := by simp +| (a :: b :: l) _ := + begin + rw [list.map_cons, list.prod_cons, @list.prod_cons _ _ _ ‖a‖], + refine le_trans (norm_mul_le _ _) (mul_le_mul_of_nonneg_left _ (norm_nonneg _)), + exact list.norm_prod_le' (list.cons_ne_nil b l) + end + +lemma list.nnnorm_prod_le' {l : list α} (hl : l ≠ []) : ‖l.prod‖₊ ≤ (l.map nnnorm).prod := +(list.norm_prod_le' hl).trans_eq $ by simp [nnreal.coe_list_prod, list.map_map] + +lemma list.norm_prod_le [norm_one_class α] : ∀ l : list α, ‖l.prod‖ ≤ (l.map norm).prod +| [] := by simp +| (a::l) := list.norm_prod_le' (list.cons_ne_nil a l) + +lemma list.nnnorm_prod_le [norm_one_class α] (l : list α) : ‖l.prod‖₊ ≤ (l.map nnnorm).prod := +l.norm_prod_le.trans_eq $ by simp [nnreal.coe_list_prod, list.map_map] + +lemma finset.norm_prod_le' {α : Type*} [normed_comm_ring α] (s : finset ι) (hs : s.nonempty) + (f : ι → α) : + ‖∏ i in s, f i‖ ≤ ∏ i in s, ‖f i‖ := +begin + rcases s with ⟨⟨l⟩, hl⟩, + have : l.map f ≠ [], by simpa using hs, + simpa using list.norm_prod_le' this +end + +lemma finset.nnnorm_prod_le' {α : Type*} [normed_comm_ring α] (s : finset ι) (hs : s.nonempty) + (f : ι → α) : + ‖∏ i in s, f i‖₊ ≤ ∏ i in s, ‖f i‖₊ := +(s.norm_prod_le' hs f).trans_eq $ by simp [nnreal.coe_prod] + +lemma finset.norm_prod_le {α : Type*} [normed_comm_ring α] [norm_one_class α] (s : finset ι) + (f : ι → α) : + ‖∏ i in s, f i‖ ≤ ∏ i in s, ‖f i‖ := +begin + rcases s with ⟨⟨l⟩, hl⟩, + simpa using (l.map f).norm_prod_le +end + +lemma finset.nnnorm_prod_le {α : Type*} [normed_comm_ring α] [norm_one_class α] (s : finset ι) + (f : ι → α) : + ‖∏ i in s, f i‖₊ ≤ ∏ i in s, ‖f i‖₊ := +(s.norm_prod_le f).trans_eq $ by simp [nnreal.coe_prod] + +/-- If `α` is a seminormed ring, then `‖a ^ n‖₊ ≤ ‖a‖₊ ^ n` for `n > 0`. +See also `nnnorm_pow_le`. -/ +lemma nnnorm_pow_le' (a : α) : ∀ {n : ℕ}, 0 < n → ‖a ^ n‖₊ ≤ ‖a‖₊ ^ n +| 1 h := by simp only [pow_one] +| (n + 2) h := by simpa only [pow_succ _ (n + 1)] using + le_trans (nnnorm_mul_le _ _) (mul_le_mul_left' (nnnorm_pow_le' n.succ_pos) _) + +/-- If `α` is a seminormed ring with `‖1‖₊ = 1`, then `‖a ^ n‖₊ ≤ ‖a‖₊ ^ n`. +See also `nnnorm_pow_le'`.-/ +lemma nnnorm_pow_le [norm_one_class α] (a : α) (n : ℕ) : ‖a ^ n‖₊ ≤ ‖a‖₊ ^ n := +nat.rec_on n (by simp only [pow_zero, nnnorm_one]) (λ k hk, nnnorm_pow_le' a k.succ_pos) + +/-- If `α` is a seminormed ring, then `‖a ^ n‖ ≤ ‖a‖ ^ n` for `n > 0`. See also `norm_pow_le`. -/ +lemma norm_pow_le' (a : α) {n : ℕ} (h : 0 < n) : ‖a ^ n‖ ≤ ‖a‖ ^ n := +by simpa only [nnreal.coe_pow, coe_nnnorm] using nnreal.coe_mono (nnnorm_pow_le' a h) + +/-- If `α` is a seminormed ring with `‖1‖ = 1`, then `‖a ^ n‖ ≤ ‖a‖ ^ n`. See also `norm_pow_le'`.-/ +lemma norm_pow_le [norm_one_class α] (a : α) (n : ℕ) : ‖a ^ n‖ ≤ ‖a‖ ^ n := +nat.rec_on n (by simp only [pow_zero, norm_one]) (λ n hn, norm_pow_le' a n.succ_pos) + +lemma eventually_norm_pow_le (a : α) : ∀ᶠ (n:ℕ) in at_top, ‖a ^ n‖ ≤ ‖a‖ ^ n := +eventually_at_top.mpr ⟨1, λ b h, norm_pow_le' a (nat.succ_le_iff.mp h)⟩ + +instance : semi_normed_ring (ulift α) := +{ .. ulift.non_unital_semi_normed_ring, + .. ulift.seminormed_add_comm_group } + +/-- Seminormed ring structure on the product of two seminormed rings, + using the sup norm. -/ +instance prod.semi_normed_ring [semi_normed_ring β] : + semi_normed_ring (α × β) := +{ ..prod.non_unital_semi_normed_ring, + ..prod.seminormed_add_comm_group, } + +/-- Seminormed ring structure on the product of finitely many seminormed rings, + using the sup norm. -/ +instance pi.semi_normed_ring {π : ι → Type*} [fintype ι] + [Π i, semi_normed_ring (π i)] : + semi_normed_ring (Π i, π i) := +{ ..pi.non_unital_semi_normed_ring, + ..pi.seminormed_add_comm_group, } + +instance mul_opposite.semi_normed_ring : semi_normed_ring αᵐᵒᵖ := +{ ..mul_opposite.non_unital_semi_normed_ring, + ..mul_opposite.seminormed_add_comm_group } + +end semi_normed_ring + +section non_unital_normed_ring +variables [non_unital_normed_ring α] + +instance : non_unital_normed_ring (ulift α) := +{ .. ulift.non_unital_semi_normed_ring, + .. ulift.seminormed_add_comm_group } + +/-- Non-unital normed ring structure on the product of two non-unital normed rings, +using the sup norm. -/ +instance prod.non_unital_normed_ring [non_unital_normed_ring β] : + non_unital_normed_ring (α × β) := +{ norm_mul := norm_mul_le, + ..prod.seminormed_add_comm_group } + +/-- Normed ring structure on the product of finitely many non-unital normed rings, using the sup +norm. -/ +instance pi.non_unital_normed_ring {π : ι → Type*} [fintype ι] [Π i, non_unital_normed_ring (π i)] : + non_unital_normed_ring (Π i, π i) := +{ norm_mul := norm_mul_le, + ..pi.normed_add_comm_group } + +instance mul_opposite.non_unital_normed_ring : non_unital_normed_ring αᵐᵒᵖ := +{ norm_mul := norm_mul_le, + ..mul_opposite.normed_add_comm_group } + +end non_unital_normed_ring + +section normed_ring + +variables [normed_ring α] + +lemma units.norm_pos [nontrivial α] (x : αˣ) : 0 < ‖(x:α)‖ := +norm_pos_iff.mpr (units.ne_zero x) + +lemma units.nnnorm_pos [nontrivial α] (x : αˣ) : 0 < ‖(x:α)‖₊ := +x.norm_pos + +instance : normed_ring (ulift α) := +{ .. ulift.semi_normed_ring, + .. ulift.normed_add_comm_group } + +/-- Normed ring structure on the product of two normed rings, using the sup norm. -/ +instance prod.normed_ring [normed_ring β] : normed_ring (α × β) := +{ norm_mul := norm_mul_le, + ..prod.normed_add_comm_group } + +/-- Normed ring structure on the product of finitely many normed rings, using the sup norm. -/ +instance pi.normed_ring {π : ι → Type*} [fintype ι] [Π i, normed_ring (π i)] : + normed_ring (Π i, π i) := +{ norm_mul := norm_mul_le, + ..pi.normed_add_comm_group } + +instance mul_opposite.normed_ring : normed_ring αᵐᵒᵖ := +{ norm_mul := norm_mul_le, + ..mul_opposite.normed_add_comm_group } + +end normed_ring + +@[priority 100] -- see Note [lower instance priority] +instance semi_normed_ring_top_monoid [non_unital_semi_normed_ring α] : has_continuous_mul α := +⟨ continuous_iff_continuous_at.2 $ λ x, tendsto_iff_norm_tendsto_zero.2 $ + begin + have : ∀ e : α × α, ‖e.1 * e.2 - x.1 * x.2‖ ≤ ‖e.1‖ * ‖e.2 - x.2‖ + ‖e.1 - x.1‖ * ‖x.2‖, + { intro e, + calc ‖e.1 * e.2 - x.1 * x.2‖ ≤ ‖e.1 * (e.2 - x.2) + (e.1 - x.1) * x.2‖ : + by rw [mul_sub, sub_mul, sub_add_sub_cancel] + ... ≤ ‖e.1‖ * ‖e.2 - x.2‖ + ‖e.1 - x.1‖ * ‖x.2‖ : + norm_add_le_of_le (norm_mul_le _ _) (norm_mul_le _ _) }, + refine squeeze_zero (λ e, norm_nonneg _) this _, + convert ((continuous_fst.tendsto x).norm.mul ((continuous_snd.tendsto x).sub + tendsto_const_nhds).norm).add + (((continuous_fst.tendsto x).sub tendsto_const_nhds).norm.mul _), + show tendsto _ _ _, from tendsto_const_nhds, + simp + end ⟩ + +/-- A seminormed ring is a topological ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance semi_normed_top_ring [non_unital_semi_normed_ring α] : topological_ring α := { } + +section normed_division_ring + +variables [normed_division_ring α] + +@[simp] lemma norm_mul (a b : α) : ‖a * b‖ = ‖a‖ * ‖b‖ := +normed_division_ring.norm_mul' a b + +@[priority 900] +instance normed_division_ring.to_norm_one_class : norm_one_class α := +⟨mul_left_cancel₀ (mt norm_eq_zero.1 (one_ne_zero' α)) $ + by rw [← norm_mul, mul_one, mul_one]⟩ + +instance is_absolute_value_norm : is_absolute_value (norm : α → ℝ) := +{ abv_nonneg := norm_nonneg, + abv_eq_zero := λ _, norm_eq_zero, + abv_add := norm_add_le, + abv_mul := norm_mul } + +@[simp] lemma nnnorm_mul (a b : α) : ‖a * b‖₊ = ‖a‖₊ * ‖b‖₊ := +nnreal.eq $ norm_mul a b + +/-- `norm` as a `monoid_with_zero_hom`. -/ +@[simps] def norm_hom : α →*₀ ℝ := ⟨norm, norm_zero, norm_one, norm_mul⟩ + +/-- `nnnorm` as a `monoid_with_zero_hom`. -/ +@[simps] def nnnorm_hom : α →*₀ ℝ≥0 := ⟨nnnorm, nnnorm_zero, nnnorm_one, nnnorm_mul⟩ + +@[simp] lemma norm_pow (a : α) : ∀ (n : ℕ), ‖a ^ n‖ = ‖a‖ ^ n := +(norm_hom.to_monoid_hom : α →* ℝ).map_pow a + +@[simp] lemma nnnorm_pow (a : α) (n : ℕ) : ‖a ^ n‖₊ = ‖a‖₊ ^ n := +(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_pow a n + +protected lemma list.norm_prod (l : list α) : ‖l.prod‖ = (l.map norm).prod := +(norm_hom.to_monoid_hom : α →* ℝ).map_list_prod _ + +protected lemma list.nnnorm_prod (l : list α) : ‖l.prod‖₊ = (l.map nnnorm).prod := +(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_list_prod _ + +@[simp] lemma norm_div (a b : α) : ‖a / b‖ = ‖a‖ / ‖b‖ := map_div₀ (norm_hom : α →*₀ ℝ) a b + +@[simp] lemma nnnorm_div (a b : α) : ‖a / b‖₊ = ‖a‖₊ / ‖b‖₊ := map_div₀ (nnnorm_hom : α →*₀ ℝ≥0) a b + +@[simp] lemma norm_inv (a : α) : ‖a⁻¹‖ = ‖a‖⁻¹ := map_inv₀ (norm_hom : α →*₀ ℝ) a + +@[simp] lemma nnnorm_inv (a : α) : ‖a⁻¹‖₊ = ‖a‖₊⁻¹ := +nnreal.eq $ by simp + +@[simp] lemma norm_zpow : ∀ (a : α) (n : ℤ), ‖a^n‖ = ‖a‖^n := map_zpow₀ (norm_hom : α →*₀ ℝ) + +@[simp] lemma nnnorm_zpow : ∀ (a : α) (n : ℤ), ‖a ^ n‖₊ = ‖a‖₊ ^ n := +map_zpow₀ (nnnorm_hom : α →*₀ ℝ≥0) + +lemma dist_inv_inv₀ {z w : α} (hz : z ≠ 0) (hw : w ≠ 0) : + dist z⁻¹ w⁻¹ = (dist z w) / (‖z‖ * ‖w‖) := +by rw [dist_eq_norm, inv_sub_inv' hz hw, norm_mul, norm_mul, norm_inv, norm_inv, mul_comm ‖z‖⁻¹, + mul_assoc, dist_eq_norm', div_eq_mul_inv, mul_inv] + +lemma nndist_inv_inv₀ {z w : α} (hz : z ≠ 0) (hw : w ≠ 0) : + nndist z⁻¹ w⁻¹ = (nndist z w) / (‖z‖₊ * ‖w‖₊) := +by { rw ← nnreal.coe_eq, simp [-nnreal.coe_eq, dist_inv_inv₀ hz hw], } + +/-- Multiplication on the left by a nonzero element of a normed division ring tends to infinity at +infinity. TODO: use `bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`. -/ +lemma filter.tendsto_mul_left_cobounded {a : α} (ha : a ≠ 0) : + tendsto ((*) a) (comap norm at_top) (comap norm at_top) := +by simpa only [tendsto_comap_iff, (∘), norm_mul] + using tendsto_const_nhds.mul_at_top (norm_pos_iff.2 ha) tendsto_comap + +/-- Multiplication on the right by a nonzero element of a normed division ring tends to infinity at +infinity. TODO: use `bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`. -/ +lemma filter.tendsto_mul_right_cobounded {a : α} (ha : a ≠ 0) : + tendsto (λ x, x * a) (comap norm at_top) (comap norm at_top) := +by simpa only [tendsto_comap_iff, (∘), norm_mul] + using tendsto_comap.at_top_mul (norm_pos_iff.2 ha) tendsto_const_nhds + +@[priority 100] -- see Note [lower instance priority] +instance normed_division_ring.to_has_continuous_inv₀ : has_continuous_inv₀ α := +begin + refine ⟨λ r r0, tendsto_iff_norm_tendsto_zero.2 _⟩, + have r0' : 0 < ‖r‖ := norm_pos_iff.2 r0, + rcases exists_between r0' with ⟨ε, ε0, εr⟩, + have : ∀ᶠ e in 𝓝 r, ‖e⁻¹ - r⁻¹‖ ≤ ‖r - e‖ / ‖r‖ / ε, + { filter_upwards [(is_open_lt continuous_const continuous_norm).eventually_mem εr] with e he, + have e0 : e ≠ 0 := norm_pos_iff.1 (ε0.trans he), + calc ‖e⁻¹ - r⁻¹‖ = ‖r‖⁻¹ * ‖r - e‖ * ‖e‖⁻¹ : by + { rw [←norm_inv, ←norm_inv, ←norm_mul, ←norm_mul, mul_sub, sub_mul, mul_assoc _ e, + inv_mul_cancel r0, mul_inv_cancel e0, one_mul, mul_one] } + ... = ‖r - e‖ / ‖r‖ / ‖e‖ : by field_simp [mul_comm] + ... ≤ ‖r - e‖ / ‖r‖ / ε : + div_le_div_of_le_left (div_nonneg (norm_nonneg _) (norm_nonneg _)) ε0 he.le }, + refine squeeze_zero' (eventually_of_forall $ λ _, norm_nonneg _) this _, + refine (((continuous_const.sub continuous_id).norm.div_const _).div_const _).tendsto' _ _ _, + simp, +end + +/-- A normed division ring is a topological division ring. -/ +@[priority 100] -- see Note [lower instance priority] +instance normed_division_ring.to_topological_division_ring : topological_division_ring α := +{ } + +lemma norm_map_one_of_pow_eq_one [monoid β] (φ : β →* α) {x : β} {k : ℕ+} + (h : x ^ (k : ℕ) = 1) : + ‖φ x‖ = 1 := +begin + rw [← pow_left_inj, ← norm_pow, ← map_pow, h, map_one, norm_one, one_pow], + exacts [norm_nonneg _, zero_le_one, k.pos], +end + +lemma norm_one_of_pow_eq_one {x : α} {k : ℕ+} (h : x ^ (k : ℕ) = 1) : + ‖x‖ = 1 := +norm_map_one_of_pow_eq_one (monoid_hom.id α) h + +end normed_division_ring + +/-- A normed field is a field with a norm satisfying ‖x y‖ = ‖x‖ ‖y‖. -/ +class normed_field (α : Type*) extends has_norm α, field α, metric_space α := +(dist_eq : ∀ x y, dist x y = norm (x - y)) +(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b) + +/-- A nontrivially normed field is a normed field in which there is an element of norm different +from `0` and `1`. This makes it possible to bring any element arbitrarily close to `0` by +multiplication by the powers of any element, and thus to relate algebra and topology. -/ +class nontrivially_normed_field (α : Type*) extends normed_field α := +(non_trivial : ∃ x : α, 1 < ‖x‖) + +/-- A densely normed field is a normed field for which the image of the norm is dense in `ℝ≥0`, +which means it is also nontrivially normed. However, not all nontrivally normed fields are densely +normed; in particular, the `padic`s exhibit this fact. -/ +class densely_normed_field (α : Type*) extends normed_field α := +(lt_norm_lt : ∀ x y : ℝ, 0 ≤ x → x < y → ∃ a : α, x < ‖a‖ ∧ ‖a‖ < y) + +section normed_field + +/-- A densely normed field is always a nontrivially normed field. +See note [lower instance priority]. -/ +@[priority 100] +instance densely_normed_field.to_nontrivially_normed_field [densely_normed_field α] : + nontrivially_normed_field α := +{ non_trivial := let ⟨a, h, _⟩ := densely_normed_field.lt_norm_lt 1 2 zero_le_one one_lt_two in + ⟨a, h⟩ } + +variables [normed_field α] + +@[priority 100] -- see Note [lower instance priority] +instance normed_field.to_normed_division_ring : normed_division_ring α := +{ ..‹normed_field α› } + +@[priority 100] -- see Note [lower instance priority] +instance normed_field.to_normed_comm_ring : normed_comm_ring α := +{ norm_mul := λ a b, (norm_mul a b).le, ..‹normed_field α› } + +@[simp] lemma norm_prod (s : finset β) (f : β → α) : + ‖∏ b in s, f b‖ = ∏ b in s, ‖f b‖ := +(norm_hom.to_monoid_hom : α →* ℝ).map_prod f s + +@[simp] lemma nnnorm_prod (s : finset β) (f : β → α) : + ‖∏ b in s, f b‖₊ = ∏ b in s, ‖f b‖₊ := +(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_prod f s + +end normed_field + +namespace normed_field + +section nontrivially + +variables (α) [nontrivially_normed_field α] + +lemma exists_one_lt_norm : ∃x : α, 1 < ‖x‖ := ‹nontrivially_normed_field α›.non_trivial + +lemma exists_lt_norm (r : ℝ) : ∃ x : α, r < ‖x‖ := +let ⟨w, hw⟩ := exists_one_lt_norm α in +let ⟨n, hn⟩ := pow_unbounded_of_one_lt r hw in +⟨w^n, by rwa norm_pow⟩ + +lemma exists_norm_lt {r : ℝ} (hr : 0 < r) : ∃ x : α, 0 < ‖x‖ ∧ ‖x‖ < r := +let ⟨w, hw⟩ := exists_lt_norm α r⁻¹ in +⟨w⁻¹, by rwa [← set.mem_Ioo, norm_inv, ← set.mem_inv, set.inv_Ioo_0_left hr]⟩ + +lemma exists_norm_lt_one : ∃x : α, 0 < ‖x‖ ∧ ‖x‖ < 1 := +exists_norm_lt α one_pos + +variable {α} + +@[instance] +lemma punctured_nhds_ne_bot (x : α) : ne_bot (𝓝[≠] x) := +begin + rw [← mem_closure_iff_nhds_within_ne_bot, metric.mem_closure_iff], + rintros ε ε0, + rcases exists_norm_lt α ε0 with ⟨b, hb0, hbε⟩, + refine ⟨x + b, mt (set.mem_singleton_iff.trans add_right_eq_self).1 $ norm_pos_iff.1 hb0, _⟩, + rwa [dist_comm, dist_eq_norm, add_sub_cancel'], +end + +@[instance] +lemma nhds_within_is_unit_ne_bot : ne_bot (𝓝[{x : α | is_unit x}] 0) := +by simpa only [is_unit_iff_ne_zero] using punctured_nhds_ne_bot (0:α) + +end nontrivially + +section densely + +variables (α) [densely_normed_field α] + +lemma exists_lt_norm_lt {r₁ r₂ : ℝ} (h₀ : 0 ≤ r₁) (h : r₁ < r₂) : ∃ x : α, r₁ < ‖x‖ ∧ ‖x‖ < r₂ := +densely_normed_field.lt_norm_lt r₁ r₂ h₀ h + +lemma exists_lt_nnnorm_lt {r₁ r₂ : ℝ≥0} (h : r₁ < r₂) : ∃ x : α, r₁ < ‖x‖₊ ∧ ‖x‖₊ < r₂ := +by exact_mod_cast exists_lt_norm_lt α r₁.prop h + +instance densely_ordered_range_norm : densely_ordered (set.range (norm : α → ℝ)) := +{ dense := + begin + rintro ⟨-, x, rfl⟩ ⟨-, y, rfl⟩ hxy, + exact let ⟨z, h⟩ := exists_lt_norm_lt α (norm_nonneg _) hxy in ⟨⟨‖z‖, z, rfl⟩, h⟩, + end } + +instance densely_ordered_range_nnnorm : densely_ordered (set.range (nnnorm : α → ℝ≥0)) := +{ dense := + begin + rintro ⟨-, x, rfl⟩ ⟨-, y, rfl⟩ hxy, + exact let ⟨z, h⟩ := exists_lt_nnnorm_lt α hxy in ⟨⟨‖z‖₊, z, rfl⟩, h⟩, + end } + +lemma dense_range_nnnorm : dense_range (nnnorm : α → ℝ≥0) := +dense_of_exists_between $ λ _ _ hr, let ⟨x, h⟩ := exists_lt_nnnorm_lt α hr in ⟨‖x‖₊, ⟨x, rfl⟩, h⟩ + +end densely + +end normed_field + +instance : normed_comm_ring ℝ := +{ norm_mul := λ x y, (abs_mul x y).le, + .. real.normed_add_comm_group, + .. real.comm_ring } + +noncomputable instance : normed_field ℝ := +{ norm_mul' := abs_mul, + .. real.normed_add_comm_group } + +noncomputable instance : densely_normed_field ℝ := +{ lt_norm_lt := λ _ _ h₀ hr, let ⟨x, h⟩ := exists_between hr in + ⟨x, by rwa [real.norm_eq_abs, abs_of_nonneg (h₀.trans h.1.le)]⟩ } + +namespace real + +lemma to_nnreal_mul_nnnorm {x : ℝ} (y : ℝ) (hx : 0 ≤ x) : x.to_nnreal * ‖y‖₊ = ‖x * y‖₊ := +by simp [real.to_nnreal_of_nonneg, nnnorm, norm_of_nonneg, hx] + +lemma nnnorm_mul_to_nnreal (x : ℝ) {y : ℝ} (hy : 0 ≤ y) : ‖x‖₊ * y.to_nnreal = ‖x * y‖₊ := +by simp [real.to_nnreal_of_nonneg, nnnorm, norm_of_nonneg, hy] + +end real + +namespace nnreal + +open_locale nnreal + +@[simp] lemma norm_eq (x : ℝ≥0) : ‖(x : ℝ)‖ = x := +by rw [real.norm_eq_abs, x.abs_eq] + +@[simp] lemma nnnorm_eq (x : ℝ≥0) : ‖(x : ℝ)‖₊ = x := +nnreal.eq $ real.norm_of_nonneg x.2 + +end nnreal + +@[simp] lemma norm_norm [seminormed_add_comm_group α] (x : α) : ‖‖x‖‖ = ‖x‖ := +real.norm_of_nonneg (norm_nonneg _) + +@[simp] lemma nnnorm_norm [seminormed_add_comm_group α] (a : α) : ‖‖a‖‖₊ = ‖a‖₊ := +by simpa [real.nnnorm_of_nonneg (norm_nonneg a)] + +/-- A restatement of `metric_space.tendsto_at_top` in terms of the norm. -/ +lemma normed_add_comm_group.tendsto_at_top [nonempty α] [semilattice_sup α] {β : Type*} + [seminormed_add_comm_group β] {f : α → β} {b : β} : + tendsto f at_top (𝓝 b) ↔ ∀ ε, 0 < ε → ∃ N, ∀ n, N ≤ n → ‖f n - b‖ < ε := +(at_top_basis.tendsto_iff metric.nhds_basis_ball).trans (by simp [dist_eq_norm]) + +/-- +A variant of `normed_add_comm_group.tendsto_at_top` that +uses `∃ N, ∀ n > N, ...` rather than `∃ N, ∀ n ≥ N, ...` +-/ +lemma normed_add_comm_group.tendsto_at_top' [nonempty α] [semilattice_sup α] [no_max_order α] + {β : Type*} [seminormed_add_comm_group β] + {f : α → β} {b : β} : + tendsto f at_top (𝓝 b) ↔ ∀ ε, 0 < ε → ∃ N, ∀ n, N < n → ‖f n - b‖ < ε := +(at_top_basis_Ioi.tendsto_iff metric.nhds_basis_ball).trans (by simp [dist_eq_norm]) + +instance : normed_comm_ring ℤ := +{ norm_mul := λ m n, le_of_eq $ by simp only [norm, int.cast_mul, abs_mul], + mul_comm := mul_comm, + .. int.normed_add_comm_group } + +instance : norm_one_class ℤ := +⟨by simp [← int.norm_cast_real]⟩ + +instance : normed_field ℚ := +{ norm_mul' := λ r₁ r₂, by simp only [norm, rat.cast_mul, abs_mul], + .. rat.normed_add_comm_group } + +instance : densely_normed_field ℚ := +{ lt_norm_lt := λ r₁ r₂ h₀ hr, let ⟨q, h⟩ := exists_rat_btwn hr in + ⟨q, by { unfold norm, rwa abs_of_pos (h₀.trans_lt h.1) } ⟩ } + +section ring_hom_isometric + +variables {R₁ : Type*} {R₂ : Type*} {R₃ : Type*} + +/-- This class states that a ring homomorphism is isometric. This is a sufficient assumption +for a continuous semilinear map to be bounded and this is the main use for this typeclass. -/ +class ring_hom_isometric [semiring R₁] [semiring R₂] [has_norm R₁] [has_norm R₂] + (σ : R₁ →+* R₂) : Prop := +(is_iso : ∀ {x : R₁}, ‖σ x‖ = ‖x‖) + +attribute [simp] ring_hom_isometric.is_iso + +variables [semi_normed_ring R₁] [semi_normed_ring R₂] [semi_normed_ring R₃] + +instance ring_hom_isometric.ids : ring_hom_isometric (ring_hom.id R₁) := +⟨λ x, rfl⟩ + +end ring_hom_isometric + +/-! ### Induced normed structures -/ + +section induced + +variables {F : Type*} (R S : Type*) + +/-- A non-unital ring homomorphism from an `non_unital_ring` to a `non_unital_semi_normed_ring` +induces a `non_unital_semi_normed_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def non_unital_semi_normed_ring.induced [non_unital_ring R] [non_unital_semi_normed_ring S] + [non_unital_ring_hom_class F R S] (f : F) : non_unital_semi_normed_ring R := +{ norm_mul := λ x y, by { unfold norm, exact (map_mul f x y).symm ▸ norm_mul_le (f x) (f y) }, + .. seminormed_add_comm_group.induced R S f } + +/-- An injective non-unital ring homomorphism from an `non_unital_ring` to a +`non_unital_normed_ring` induces a `non_unital_normed_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def non_unital_normed_ring.induced [non_unital_ring R] [non_unital_normed_ring S] + [non_unital_ring_hom_class F R S] (f : F) (hf : function.injective f) : + non_unital_normed_ring R := +{ .. non_unital_semi_normed_ring.induced R S f, + .. normed_add_comm_group.induced R S f hf } + +/-- A non-unital ring homomorphism from an `ring` to a `semi_normed_ring` induces a +`semi_normed_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def semi_normed_ring.induced [ring R] [semi_normed_ring S] [non_unital_ring_hom_class F R S] + (f : F) : semi_normed_ring R := +{ .. non_unital_semi_normed_ring.induced R S f, + .. seminormed_add_comm_group.induced R S f } + +/-- An injective non-unital ring homomorphism from an `ring` to a `normed_ring` induces a +`normed_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def normed_ring.induced [ring R] [normed_ring S] [non_unital_ring_hom_class F R S] (f : F) + (hf : function.injective f) : normed_ring R := +{ .. non_unital_semi_normed_ring.induced R S f, + .. normed_add_comm_group.induced R S f hf } + +/-- A non-unital ring homomorphism from a `comm_ring` to a `semi_normed_ring` induces a +`semi_normed_comm_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def semi_normed_comm_ring.induced [comm_ring R] [semi_normed_ring S] + [non_unital_ring_hom_class F R S] (f : F) : semi_normed_comm_ring R := +{ mul_comm := mul_comm, + .. non_unital_semi_normed_ring.induced R S f, + .. seminormed_add_comm_group.induced R S f } + +/-- An injective non-unital ring homomorphism from an `comm_ring` to a `normed_ring` induces a +`normed_comm_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def normed_comm_ring.induced [comm_ring R] [normed_ring S] [non_unital_ring_hom_class F R S] (f : F) + (hf : function.injective f) : normed_comm_ring R := +{ .. semi_normed_comm_ring.induced R S f, + .. normed_add_comm_group.induced R S f hf } + +/-- An injective non-unital ring homomorphism from an `division_ring` to a `normed_ring` induces a +`normed_division_ring` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def normed_division_ring.induced [division_ring R] [normed_division_ring S] + [non_unital_ring_hom_class F R S] (f : F) (hf : function.injective f) : normed_division_ring R := +{ norm_mul' := λ x y, by { unfold norm, exact (map_mul f x y).symm ▸ norm_mul (f x) (f y) }, + .. normed_add_comm_group.induced R S f hf } + +/-- An injective non-unital ring homomorphism from an `field` to a `normed_ring` induces a +`normed_field` structure on the domain. + +See note [reducible non-instances] -/ +@[reducible] +def normed_field.induced [field R] [normed_field S] + [non_unital_ring_hom_class F R S] (f : F) (hf : function.injective f) : normed_field R := +{ .. normed_division_ring.induced R S f hf } + +/-- A ring homomorphism from a `ring R` to a `semi_normed_ring S` which induces the norm structure +`semi_normed_ring.induced` makes `R` satisfy `‖(1 : R)‖ = 1` whenever `‖(1 : S)‖ = 1`. -/ +lemma norm_one_class.induced {F : Type*} (R S : Type*) [ring R] [semi_normed_ring S] + [norm_one_class S] [ring_hom_class F R S] (f : F) : + @norm_one_class R (semi_normed_ring.induced R S f).to_has_norm _ := +{ norm_one := (congr_arg norm (map_one f)).trans norm_one } + +end induced + +namespace subring_class + +variables {S R : Type*} [set_like S R] + +instance to_semi_normed_ring [semi_normed_ring R] [subring_class S R] (s : S) : + semi_normed_ring s := +semi_normed_ring.induced s R (subring_class.subtype s) + +instance to_normed_ring [normed_ring R] [subring_class S R] (s : S) : + normed_ring s := +normed_ring.induced s R (subring_class.subtype s) subtype.val_injective + +instance to_semi_normed_comm_ring [semi_normed_comm_ring R] [h : subring_class S R] (s : S) : + semi_normed_comm_ring s := +{ mul_comm := mul_comm, .. subring_class.to_semi_normed_ring s } + +instance to_normed_comm_ring [normed_comm_ring R] [subring_class S R] (s : S) : + normed_comm_ring s := +{ mul_comm := mul_comm, .. subring_class.to_normed_ring s } + +end subring_class + +-- Guard again import creep. +assert_not_exists restrict_scalars diff --git a/src/analysis/normed/field/infinite_sum.lean b/src/analysis/normed/field/infinite_sum.lean new file mode 100644 index 0000000000000..67888a205379c --- /dev/null +++ b/src/analysis/normed/field/infinite_sum.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2021 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anatole Dedecker +-/ +import analysis.normed.field.basic +import analysis.normed.group.infinite_sum + +/-! # Multiplying two infinite sums in a normed ring + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we prove various results about `(∑' x : ι, f x) * (∑' y : ι', g y)` in a normed +ring. There are similar results proven in `topology/algebra/infinite_sum` (e.g `tsum_mul_tsum`), +but in a normed ring we get summability results which aren't true in general. + +We first establish results about arbitrary index types, `β` and `γ`, and then we specialize to +`β = γ = ℕ` to prove the Cauchy product formula +(see `tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`). +!-/ + +variables {α : Type*} {ι : Type*} {ι' : Type*} [normed_ring α] + +open_locale big_operators classical +open finset + +/-! ### Arbitrary index types -/ + +lemma summable.mul_of_nonneg {f : ι → ℝ} {g : ι' → ℝ} + (hf : summable f) (hg : summable g) (hf' : 0 ≤ f) (hg' : 0 ≤ g) : + summable (λ (x : ι × ι'), f x.1 * g x.2) := +let ⟨s, hf⟩ := hf in +let ⟨t, hg⟩ := hg in +suffices this : ∀ u : finset (ι × ι'), ∑ x in u, f x.1 * g x.2 ≤ s*t, + from summable_of_sum_le (λ x, mul_nonneg (hf' _) (hg' _)) this, +assume u, +calc ∑ x in u, f x.1 * g x.2 + ≤ ∑ x in u.image prod.fst ×ˢ u.image prod.snd, f x.1 * g x.2 : + sum_mono_set_of_nonneg (λ x, mul_nonneg (hf' _) (hg' _)) subset_product +... = ∑ x in u.image prod.fst, ∑ y in u.image prod.snd, f x * g y : sum_product +... = ∑ x in u.image prod.fst, f x * ∑ y in u.image prod.snd, g y : + sum_congr rfl (λ x _, mul_sum.symm) +... ≤ ∑ x in u.image prod.fst, f x * t : + sum_le_sum + (λ x _, mul_le_mul_of_nonneg_left (sum_le_has_sum _ (λ _ _, hg' _) hg) (hf' _)) +... = (∑ x in u.image prod.fst, f x) * t : sum_mul.symm +... ≤ s * t : + mul_le_mul_of_nonneg_right (sum_le_has_sum _ (λ _ _, hf' _) hf) (hg.nonneg $ λ _, hg' _) + +lemma summable.mul_norm {f : ι → α} {g : ι' → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + summable (λ (x : ι × ι'), ‖f x.1 * g x.2‖) := +summable_of_nonneg_of_le (λ x, norm_nonneg (f x.1 * g x.2)) (λ x, norm_mul_le (f x.1) (g x.2)) + (hf.mul_of_nonneg hg (λ x, norm_nonneg $ f x) (λ x, norm_nonneg $ g x) : _) + +lemma summable_mul_of_summable_norm [complete_space α] {f : ι → α} {g : ι' → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + summable (λ (x : ι × ι'), f x.1 * g x.2) := +summable_of_summable_norm (hf.mul_norm hg) + +/-- Product of two infinites sums indexed by arbitrary types. + See also `tsum_mul_tsum` if `f` and `g` are *not* absolutely summable. -/ +lemma tsum_mul_tsum_of_summable_norm [complete_space α] {f : ι → α} {g : ι' → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + (∑' x, f x) * (∑' y, g y) = (∑' z : ι × ι', f z.1 * g z.2) := +tsum_mul_tsum (summable_of_summable_norm hf) (summable_of_summable_norm hg) + (summable_mul_of_summable_norm hf hg) + +/-! ### `ℕ`-indexed families (Cauchy product) + +We prove two versions of the Cauchy product formula. The first one is +`tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm`, where the `n`-th term is a sum over +`finset.range (n+1)` involving `nat` subtraction. +In order to avoid `nat` subtraction, we also provide +`tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`, +where the `n`-th term is a sum over all pairs `(k, l)` such that `k+l=n`, which corresponds to the +`finset` `finset.nat.antidiagonal n`. -/ + +section nat + +open finset.nat + +lemma summable_norm_sum_mul_antidiagonal_of_summable_norm {f g : ℕ → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + summable (λ n, ‖∑ kl in antidiagonal n, f kl.1 * g kl.2‖) := +begin + have := summable_sum_mul_antidiagonal_of_summable_mul + (summable.mul_of_nonneg hf hg (λ _, norm_nonneg _) (λ _, norm_nonneg _)), + refine summable_of_nonneg_of_le (λ _, norm_nonneg _) _ this, + intros n, + calc ‖∑ kl in antidiagonal n, f kl.1 * g kl.2‖ + ≤ ∑ kl in antidiagonal n, ‖f kl.1 * g kl.2‖ : norm_sum_le _ _ + ... ≤ ∑ kl in antidiagonal n, ‖f kl.1‖ * ‖g kl.2‖ : sum_le_sum (λ i _, norm_mul_le _ _) +end + +/-- The Cauchy product formula for the product of two infinite sums indexed by `ℕ`, + expressed by summing on `finset.nat.antidiagonal`. + See also `tsum_mul_tsum_eq_tsum_sum_antidiagonal` if `f` and `g` are + *not* absolutely summable. -/ +lemma tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm [complete_space α] {f g : ℕ → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ kl in antidiagonal n, f kl.1 * g kl.2 := +tsum_mul_tsum_eq_tsum_sum_antidiagonal (summable_of_summable_norm hf) (summable_of_summable_norm hg) + (summable_mul_of_summable_norm hf hg) + +lemma summable_norm_sum_mul_range_of_summable_norm {f g : ℕ → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + summable (λ n, ‖∑ k in range (n+1), f k * g (n - k)‖) := +begin + simp_rw ← sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l), + exact summable_norm_sum_mul_antidiagonal_of_summable_norm hf hg +end + +/-- The Cauchy product formula for the product of two infinite sums indexed by `ℕ`, + expressed by summing on `finset.range`. + See also `tsum_mul_tsum_eq_tsum_sum_range` if `f` and `g` are + *not* absolutely summable. -/ +lemma tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm [complete_space α] {f g : ℕ → α} + (hf : summable (λ x, ‖f x‖)) (hg : summable (λ x, ‖g x‖)) : + (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ k in range (n+1), f k * g (n - k) := +begin + simp_rw ← sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l), + exact tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm hf hg +end + +end nat diff --git a/src/analysis/normed/field/unit_ball.lean b/src/analysis/normed/field/unit_ball.lean new file mode 100644 index 0000000000000..397e10d308943 --- /dev/null +++ b/src/analysis/normed/field/unit_ball.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Heather Macbeth +-/ +import analysis.normed.field.basic +import analysis.normed.group.ball_sphere + +/-! +# Algebraic structures on unit balls and spheres + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define algebraic structures (`semigroup`, `comm_semigroup`, `monoid`, `comm_monoid`, +`group`, `comm_group`) on `metric.ball (0 : 𝕜) 1`, `metric.closed_ball (0 : 𝕜) 1`, and +`metric.sphere (0 : 𝕜) 1`. In each case we use the weakest possible typeclass assumption on `𝕜`, +from `non_unital_semi_normed_ring` to `normed_field`. +-/ + +open set metric + +variables {𝕜 : Type*} + +/-- Unit ball in a non unital semi normed ring as a bundled `subsemigroup`. -/ +def subsemigroup.unit_ball (𝕜 : Type*) [non_unital_semi_normed_ring 𝕜] : + subsemigroup 𝕜 := +{ carrier := ball (0 : 𝕜) 1, + mul_mem' := λ x y hx hy, + begin + rw [mem_ball_zero_iff] at *, + exact (norm_mul_le x y).trans_lt (mul_lt_one_of_nonneg_of_lt_one_left (norm_nonneg _) + hx hy.le) + end } + +instance [non_unital_semi_normed_ring 𝕜] : semigroup (ball (0 : 𝕜) 1) := +mul_mem_class.to_semigroup (subsemigroup.unit_ball 𝕜) + +instance [non_unital_semi_normed_ring 𝕜] : has_continuous_mul (ball (0 : 𝕜) 1) := +(subsemigroup.unit_ball 𝕜).has_continuous_mul + +instance [semi_normed_comm_ring 𝕜] : comm_semigroup (ball (0 : 𝕜) 1) := +mul_mem_class.to_comm_semigroup (subsemigroup.unit_ball 𝕜) + +instance [non_unital_semi_normed_ring 𝕜] : has_distrib_neg (ball (0 : 𝕜) 1) := +subtype.coe_injective.has_distrib_neg (coe : ball (0 : 𝕜) 1 → 𝕜) (λ _, rfl) (λ _ _, rfl) + +@[simp, norm_cast] lemma coe_mul_unit_ball [non_unital_semi_normed_ring 𝕜] (x y : ball (0 : 𝕜) 1) : + ↑(x * y) = (x * y : 𝕜) := rfl + +/-- Closed unit ball in a non unital semi normed ring as a bundled `subsemigroup`. -/ +def subsemigroup.unit_closed_ball (𝕜 : Type*) [non_unital_semi_normed_ring 𝕜] : + subsemigroup 𝕜 := +{ carrier := closed_ball 0 1, + mul_mem' := λ x y hx hy, + begin + rw [mem_closed_ball_zero_iff] at *, + exact (norm_mul_le x y).trans (mul_le_one hx (norm_nonneg _) hy) + end } + +instance [non_unital_semi_normed_ring 𝕜] : semigroup (closed_ball (0 : 𝕜) 1) := +mul_mem_class.to_semigroup (subsemigroup.unit_closed_ball 𝕜) + +instance [non_unital_semi_normed_ring 𝕜] : has_distrib_neg (closed_ball (0 : 𝕜) 1) := +subtype.coe_injective.has_distrib_neg (coe : closed_ball (0 : 𝕜) 1 → 𝕜) (λ _, rfl) (λ _ _, rfl) + +instance [non_unital_semi_normed_ring 𝕜] : has_continuous_mul (closed_ball (0 : 𝕜) 1) := +(subsemigroup.unit_closed_ball 𝕜).has_continuous_mul + +@[simp, norm_cast] +lemma coe_mul_unit_closed_ball [non_unital_semi_normed_ring 𝕜] (x y : closed_ball (0 : 𝕜) 1) : + ↑(x * y) = (x * y : 𝕜) := rfl + +/-- Closed unit ball in a semi normed ring as a bundled `submonoid`. -/ +def submonoid.unit_closed_ball (𝕜 : Type*) [semi_normed_ring 𝕜] [norm_one_class 𝕜] : + submonoid 𝕜 := +{ carrier := closed_ball 0 1, + one_mem' := mem_closed_ball_zero_iff.2 norm_one.le, + .. subsemigroup.unit_closed_ball 𝕜 } + +instance [semi_normed_ring 𝕜] [norm_one_class 𝕜] : monoid (closed_ball (0 : 𝕜) 1) := +submonoid_class.to_monoid (submonoid.unit_closed_ball 𝕜) + +instance [semi_normed_comm_ring 𝕜] [norm_one_class 𝕜] : comm_monoid (closed_ball (0 : 𝕜) 1) := +submonoid_class.to_comm_monoid (submonoid.unit_closed_ball 𝕜) + +@[simp, norm_cast] +lemma coe_one_unit_closed_ball [semi_normed_ring 𝕜] [norm_one_class 𝕜] : + ((1 : closed_ball (0 : 𝕜) 1) : 𝕜) = 1 := rfl + +@[simp, norm_cast] +lemma coe_pow_unit_closed_ball [semi_normed_ring 𝕜] [norm_one_class 𝕜] + (x : closed_ball (0 : 𝕜) 1) (n : ℕ) : + ↑(x ^ n) = (x ^ n : 𝕜) := rfl + +/-- Unit sphere in a normed division ring as a bundled `submonoid`. -/ +def submonoid.unit_sphere (𝕜 : Type*) [normed_division_ring 𝕜] : submonoid 𝕜 := +{ carrier := sphere (0 : 𝕜) 1, + mul_mem' := λ x y hx hy, by { rw [mem_sphere_zero_iff_norm] at *, simp * }, + one_mem' := mem_sphere_zero_iff_norm.2 norm_one } + +instance [normed_division_ring 𝕜] : has_inv (sphere (0 : 𝕜) 1) := +⟨λ x, ⟨x⁻¹, mem_sphere_zero_iff_norm.2 $ + by rw [norm_inv, mem_sphere_zero_iff_norm.1 x.coe_prop, inv_one]⟩⟩ + +@[simp, norm_cast] +lemma coe_inv_unit_sphere [normed_division_ring 𝕜] (x : sphere (0 : 𝕜) 1) : ↑x⁻¹ = (x⁻¹ : 𝕜) := rfl + +instance [normed_division_ring 𝕜] : has_div (sphere (0 : 𝕜) 1) := +⟨λ x y, ⟨x / y, mem_sphere_zero_iff_norm.2 $ by rw [norm_div, mem_sphere_zero_iff_norm.1 x.coe_prop, + mem_sphere_zero_iff_norm.1 y.coe_prop, div_one]⟩⟩ + +@[simp, norm_cast] +lemma coe_div_unit_sphere [normed_division_ring 𝕜] (x y : sphere (0 : 𝕜) 1) : + ↑(x / y) = (x / y : 𝕜) := rfl + +instance [normed_division_ring 𝕜] : has_pow (sphere (0 : 𝕜) 1) ℤ := +⟨λ x n, ⟨x ^ n, by rw [mem_sphere_zero_iff_norm, norm_zpow, + mem_sphere_zero_iff_norm.1 x.coe_prop, one_zpow]⟩⟩ + +@[simp, norm_cast] +lemma coe_zpow_unit_sphere [normed_division_ring 𝕜] (x : sphere (0 : 𝕜) 1) (n : ℤ) : + ↑(x ^ n) = (x ^ n : 𝕜) := rfl + +instance [normed_division_ring 𝕜] : monoid (sphere (0 : 𝕜) 1) := +submonoid_class.to_monoid (submonoid.unit_sphere 𝕜) + +@[simp, norm_cast] +lemma coe_one_unit_sphere [normed_division_ring 𝕜] : ((1 : sphere (0 : 𝕜) 1) : 𝕜) = 1 := rfl + +@[simp, norm_cast] +lemma coe_mul_unit_sphere [normed_division_ring 𝕜] (x y : sphere (0 : 𝕜) 1) : + ↑(x * y) = (x * y : 𝕜) := rfl + +@[simp, norm_cast] +lemma coe_pow_unit_sphere [normed_division_ring 𝕜] (x : sphere (0 : 𝕜) 1) (n : ℕ) : + ↑(x ^ n) = (x ^ n : 𝕜) := rfl + +/-- Monoid homomorphism from the unit sphere to the group of units. -/ +def unit_sphere_to_units (𝕜 : Type*) [normed_division_ring 𝕜] : sphere (0 : 𝕜) 1 →* units 𝕜 := +units.lift_right (submonoid.unit_sphere 𝕜).subtype (λ x, units.mk0 x $ ne_zero_of_mem_unit_sphere _) + (λ x, rfl) + +@[simp] lemma unit_sphere_to_units_apply_coe [normed_division_ring 𝕜] (x : sphere (0 : 𝕜) 1) : + (unit_sphere_to_units 𝕜 x : 𝕜) = x := rfl + +lemma unit_sphere_to_units_injective [normed_division_ring 𝕜] : + function.injective (unit_sphere_to_units 𝕜) := +λ x y h, subtype.eq $ by convert congr_arg units.val h + +instance [normed_division_ring 𝕜] : group (sphere (0 : 𝕜) 1) := +unit_sphere_to_units_injective.group (unit_sphere_to_units 𝕜) (units.ext rfl) + (λ x y, units.ext rfl) (λ x, units.ext rfl) (λ x y, units.ext $ div_eq_mul_inv _ _) + (λ x n, units.ext (units.coe_pow (unit_sphere_to_units 𝕜 x) n).symm) + (λ x n, units.ext (units.coe_zpow (unit_sphere_to_units 𝕜 x) n).symm) + +instance [normed_division_ring 𝕜] : has_distrib_neg (sphere (0 : 𝕜) 1) := +subtype.coe_injective.has_distrib_neg (coe : sphere (0 : 𝕜) 1 → 𝕜) (λ _, rfl) (λ _ _, rfl) + +instance [normed_division_ring 𝕜] : topological_group (sphere (0 : 𝕜) 1) := +{ to_has_continuous_mul := (submonoid.unit_sphere 𝕜).has_continuous_mul, + continuous_inv := (continuous_subtype_coe.inv₀ ne_zero_of_mem_unit_sphere).subtype_mk _ } + +instance [normed_field 𝕜] : comm_group (sphere (0 : 𝕜) 1) := +{ .. metric.sphere.group, + .. submonoid_class.to_comm_monoid (submonoid.unit_sphere 𝕜) } diff --git a/src/analysis/normed/group/SemiNormedGroup.lean b/src/analysis/normed/group/SemiNormedGroup.lean index ed81f24be1cd3..db67750524950 100644 --- a/src/analysis/normed/group/SemiNormedGroup.lean +++ b/src/analysis/normed/group/SemiNormedGroup.lean @@ -6,10 +6,14 @@ Authors: Johan Commelin, Riccardo Brasca import analysis.normed.group.hom import category_theory.limits.shapes.zero_morphisms import category_theory.concrete_category.bundled_hom +import category_theory.elementwise /-! # The category of seminormed groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `SemiNormedGroup`, the category of seminormed groups and normed group homs between them, as well as `SemiNormedGroup₁`, the subcategory of norm non-increasing morphisms. -/ @@ -21,30 +25,32 @@ universes u open category_theory /-- The category of seminormed abelian groups and bounded group homomorphisms. -/ -def SemiNormedGroup : Type (u+1) := bundled semi_normed_group +def SemiNormedGroup : Type (u+1) := bundled seminormed_add_comm_group namespace SemiNormedGroup -instance bundled_hom : bundled_hom @normed_group_hom := -⟨@normed_group_hom.to_fun, @normed_group_hom.id, @normed_group_hom.comp, @normed_group_hom.coe_inj⟩ +instance bundled_hom : bundled_hom @normed_add_group_hom := +⟨@normed_add_group_hom.to_fun, @normed_add_group_hom.id, @normed_add_group_hom.comp, + @normed_add_group_hom.coe_inj⟩ attribute [derive [large_category, concrete_category]] SemiNormedGroup instance : has_coe_to_sort SemiNormedGroup (Type u) := bundled.has_coe_to_sort /-- Construct a bundled `SemiNormedGroup` from the underlying type and typeclass. -/ -def of (M : Type u) [semi_normed_group M] : SemiNormedGroup := bundled.of M +def of (M : Type u) [seminormed_add_comm_group M] : SemiNormedGroup := bundled.of M -instance (M : SemiNormedGroup) : semi_normed_group M := M.str +instance (M : SemiNormedGroup) : seminormed_add_comm_group M := M.str -@[simp] lemma coe_of (V : Type u) [semi_normed_group V] : (SemiNormedGroup.of V : Type u) = V := rfl +@[simp] lemma coe_of (V : Type u) [seminormed_add_comm_group V] : + (SemiNormedGroup.of V : Type u) = V := rfl @[simp] lemma coe_id (V : SemiNormedGroup) : ⇑(𝟙 V) = id := rfl @[simp] lemma coe_comp {M N K : SemiNormedGroup} (f : M ⟶ N) (g : N ⟶ K) : ((f ≫ g) : M → K) = g ∘ f := rfl instance : inhabited SemiNormedGroup := ⟨of punit⟩ -instance of_unique (V : Type u) [semi_normed_group V] [i : unique V] : +instance of_unique (V : Type u) [seminormed_add_comm_group V] [i : unique V] : unique (SemiNormedGroup.of V) := i instance : limits.has_zero_morphisms.{u (u+1)} SemiNormedGroup := {} @@ -55,7 +61,7 @@ lemma is_zero_of_subsingleton (V : SemiNormedGroup) [subsingleton V] : limits.is_zero V := begin refine ⟨λ X, ⟨⟨⟨0⟩, λ f, _⟩⟩, λ X, ⟨⟨⟨0⟩, λ f, _⟩⟩⟩, - { ext, have : x = 0 := subsingleton.elim _ _, simp only [this, normed_group_hom.map_zero], }, + { ext, have : x = 0 := subsingleton.elim _ _, simp only [this, map_zero], }, { ext, apply subsingleton.elim } end @@ -66,11 +72,11 @@ lemma iso_isometry_of_norm_noninc {V W : SemiNormedGroup} (i : V ≅ W) (h1 : i.hom.norm_noninc) (h2 : i.inv.norm_noninc) : isometry i.hom := begin - apply normed_group_hom.isometry_of_norm, + apply add_monoid_hom_class.isometry_of_norm, intro v, apply le_antisymm (h1 v), - calc ∥v∥ = ∥i.inv (i.hom v)∥ : by rw [coe_hom_inv_id] - ... ≤ ∥i.hom v∥ : h2 _, + calc ‖v‖ = ‖i.inv (i.hom v)‖ : by rw [iso.hom_inv_id_apply] + ... ≤ ‖i.hom v‖ : h2 _, end end SemiNormedGroup @@ -79,20 +85,21 @@ end SemiNormedGroup `SemiNormedGroup₁` is a type synonym for `SemiNormedGroup`, which we shall equip with the category structure consisting only of the norm non-increasing maps. -/ -def SemiNormedGroup₁ : Type (u+1) := bundled semi_normed_group +def SemiNormedGroup₁ : Type (u+1) := bundled seminormed_add_comm_group namespace SemiNormedGroup₁ instance : has_coe_to_sort SemiNormedGroup₁ (Type u) := bundled.has_coe_to_sort instance : large_category.{u} SemiNormedGroup₁ := -{ hom := λ X Y, { f : normed_group_hom X Y // f.norm_noninc }, - id := λ X, ⟨normed_group_hom.id X, normed_group_hom.norm_noninc.id⟩, - comp := λ X Y Z f g, ⟨(g : normed_group_hom Y Z).comp (f : normed_group_hom X Y), g.2.comp f.2⟩, } +{ hom := λ X Y, { f : normed_add_group_hom X Y // f.norm_noninc }, + id := λ X, ⟨normed_add_group_hom.id X, normed_add_group_hom.norm_noninc.id⟩, + comp := λ X Y Z f g, + ⟨(g : normed_add_group_hom Y Z).comp (f : normed_add_group_hom X Y), g.2.comp f.2⟩ } @[ext] lemma hom_ext {M N : SemiNormedGroup₁} (f g : M ⟶ N) (w : (f : M → N) = (g : M → N)) : f = g := -subtype.eq (normed_group_hom.ext (congr_fun w)) +subtype.eq (normed_add_group_hom.ext (congr_fun w)) instance : concrete_category.{u} SemiNormedGroup₁ := { forget := @@ -101,9 +108,9 @@ instance : concrete_category.{u} SemiNormedGroup₁ := forget_faithful := {} } /-- Construct a bundled `SemiNormedGroup₁` from the underlying type and typeclass. -/ -def of (M : Type u) [semi_normed_group M] : SemiNormedGroup₁ := bundled.of M +def of (M : Type u) [seminormed_add_comm_group M] : SemiNormedGroup₁ := bundled.of M -instance (M : SemiNormedGroup₁) : semi_normed_group M := M.str +instance (M : SemiNormedGroup₁) : seminormed_add_comm_group M := M.str /-- Promote a morphism in `SemiNormedGroup` to a morphism in `SemiNormedGroup₁`. -/ def mk_hom {M N : SemiNormedGroup} (f : M ⟶ N) (i : f.norm_noninc) : @@ -127,22 +134,22 @@ instance : has_forget₂ SemiNormedGroup₁ SemiNormedGroup := { obj := λ X, X, map := λ X Y f, f.1, }, } -@[simp] lemma coe_of (V : Type u) [semi_normed_group V] : (SemiNormedGroup₁.of V : Type u) = V := -rfl +@[simp] lemma coe_of (V : Type u) [seminormed_add_comm_group V] : + (SemiNormedGroup₁.of V : Type u) = V := rfl @[simp] lemma coe_id (V : SemiNormedGroup₁) : ⇑(𝟙 V) = id := rfl @[simp] lemma coe_comp {M N K : SemiNormedGroup₁} (f : M ⟶ N) (g : N ⟶ K) : ((f ≫ g) : M → K) = g ∘ f := rfl -- If `coe_fn_coe_base` fires before `coe_comp`, `coe_comp'` puts us back in normal form. @[simp] lemma coe_comp' {M N K : SemiNormedGroup₁} (f : M ⟶ N) (g : N ⟶ K) : - ((f ≫ g) : normed_group_hom M K) = (↑g : normed_group_hom N K).comp ↑f := rfl + ((f ≫ g) : normed_add_group_hom M K) = (↑g : normed_add_group_hom N K).comp ↑f := rfl instance : inhabited SemiNormedGroup₁ := ⟨of punit⟩ -instance of_unique (V : Type u) [semi_normed_group V] [i : unique V] : +instance of_unique (V : Type u) [seminormed_add_comm_group V] [i : unique V] : unique (SemiNormedGroup₁.of V) := i instance : limits.has_zero_morphisms.{u (u+1)} SemiNormedGroup₁ := -{ has_zero := λ X Y, { zero := ⟨0, normed_group_hom.norm_noninc.zero⟩, }, +{ has_zero := λ X Y, { zero := ⟨0, normed_add_group_hom.norm_noninc.zero⟩, }, comp_zero' := λ X Y f Z, by { ext, refl, }, zero_comp' := λ X Y Z f, by { ext, simp [coe_fn_coe_base'] } } @@ -152,8 +159,8 @@ lemma is_zero_of_subsingleton (V : SemiNormedGroup₁) [subsingleton V] : limits.is_zero V := begin refine ⟨λ X, ⟨⟨⟨0⟩, λ f, _⟩⟩, λ X, ⟨⟨⟨0⟩, λ f, _⟩⟩⟩, - { ext, have : x = 0 := subsingleton.elim _ _, simp only [this, normed_group_hom.map_zero], - apply f.1.map_zero, }, + { ext, have : x = 0 := subsingleton.elim _ _, simp only [this, map_zero], + exact map_zero f.1 }, { ext, apply subsingleton.elim } end @@ -163,11 +170,12 @@ instance has_zero_object : limits.has_zero_object SemiNormedGroup₁.{u} := lemma iso_isometry {V W : SemiNormedGroup₁} (i : V ≅ W) : isometry i.hom := begin - apply normed_group_hom.isometry_of_norm, + change isometry (i.hom : V →+ W), + refine add_monoid_hom_class.isometry_of_norm i.hom _, intro v, apply le_antisymm (i.hom.2 v), - calc ∥v∥ = ∥i.inv (i.hom v)∥ : by rw [coe_hom_inv_id] - ... ≤ ∥i.hom v∥ : i.inv.2 _, + calc ‖v‖ = ‖i.inv (i.hom v)‖ : by rw [iso.hom_inv_id_apply] + ... ≤ ‖i.hom v‖ : i.inv.2 _, end end SemiNormedGroup₁ diff --git a/src/analysis/normed/group/SemiNormedGroup/completion.lean b/src/analysis/normed/group/SemiNormedGroup/completion.lean index 05582511cc5f9..8ffe9b3cff21e 100644 --- a/src/analysis/normed/group/SemiNormedGroup/completion.lean +++ b/src/analysis/normed/group/SemiNormedGroup/completion.lean @@ -10,6 +10,9 @@ import analysis.normed.group.hom_completion /-! # Completions of normed groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains an API for completions of seminormed groups (basic facts about objects and morphisms). @@ -34,7 +37,7 @@ noncomputable theory universe u -open uniform_space mul_opposite category_theory normed_group_hom +open uniform_space mul_opposite category_theory normed_add_group_hom namespace SemiNormedGroup @@ -56,13 +59,13 @@ def Completion.incl {V : SemiNormedGroup} : V ⟶ Completion.obj V := map_add' := completion.coe_add, bound' := ⟨1, λ v, by simp⟩ } -lemma Completion.norm_incl_eq {V : SemiNormedGroup} {v : V} : ∥Completion.incl v∥ = ∥v∥ := by simp +lemma Completion.norm_incl_eq {V : SemiNormedGroup} {v : V} : ‖Completion.incl v‖ = ‖v‖ := by simp lemma Completion.map_norm_noninc {V W : SemiNormedGroup} {f : V ⟶ W} (hf : f.norm_noninc) : (Completion.map f).norm_noninc := -normed_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2 $ - (normed_group_hom.norm_completion f).le.trans $ - normed_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1 hf +normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2 $ + (normed_add_group_hom.norm_completion f).le.trans $ + normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1 hf /-- Given a normed group hom `V ⟶ W`, this defines the associated morphism from the completion of `V` to the completion of `W`. @@ -79,9 +82,9 @@ add_monoid_hom.mk' (category_theory.functor.map Completion) $ λ f g, instance : preadditive SemiNormedGroup.{u} := { hom_group := λ P Q, infer_instance, add_comp' := by { intros, ext, - simp only [normed_group_hom.add_apply, category_theory.comp_apply, normed_group_hom.map_add] }, + simp only [normed_add_group_hom.add_apply, category_theory.comp_apply, map_add] }, comp_add' := by { intros, ext, - simp only [normed_group_hom.add_apply, category_theory.comp_apply, normed_group_hom.map_add] } } + simp only [normed_add_group_hom.add_apply, category_theory.comp_apply, map_add] } } instance : functor.additive Completion := { map_add' := λ X Y, (Completion.map_hom _ _).map_add } @@ -97,10 +100,10 @@ def Completion.lift {V W : SemiNormedGroup} [complete_space W] [separated_space lemma Completion.lift_comp_incl {V W : SemiNormedGroup} [complete_space W] [separated_space W] (f : V ⟶ W) : Completion.incl ≫ (Completion.lift f) = f := -by { ext, apply normed_group_hom.extension_coe } +by { ext, apply normed_add_group_hom.extension_coe } lemma Completion.lift_unique {V W : SemiNormedGroup} [complete_space W] [separated_space W] (f : V ⟶ W) (g : Completion.obj V ⟶ W) : Completion.incl ≫ g = f → g = Completion.lift f := -λ h, (normed_group_hom.extension_unique _ (λ v, ((ext_iff.1 h) v).symm)).symm +λ h, (normed_add_group_hom.extension_unique _ (λ v, ((ext_iff.1 h) v).symm)).symm end SemiNormedGroup diff --git a/src/analysis/normed/group/SemiNormedGroup/kernels.lean b/src/analysis/normed/group/SemiNormedGroup/kernels.lean index 29102a8b0c423..b1822fbc5011c 100644 --- a/src/analysis/normed/group/SemiNormedGroup/kernels.lean +++ b/src/analysis/normed/group/SemiNormedGroup/kernels.lean @@ -10,6 +10,9 @@ import category_theory.limits.shapes.kernels /-! # Kernels and cokernels in SemiNormedGroup₁ and SemiNormedGroup +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that `SemiNormedGroup₁` has cokernels (for which of course the `cokernel.π f` maps are norm non-increasing), as well as the easier result that `SemiNormedGroup` has cokernels. We also show that @@ -35,13 +38,13 @@ noncomputable theory def cokernel_cocone {X Y : SemiNormedGroup₁.{u}} (f : X ⟶ Y) : cofork f 0 := cofork.of_π (@SemiNormedGroup₁.mk_hom - _ (SemiNormedGroup.of (Y ⧸ (normed_group_hom.range f.1))) + _ (SemiNormedGroup.of (Y ⧸ (normed_add_group_hom.range f.1))) f.1.range.normed_mk - (normed_group_hom.is_quotient_quotient _).norm_le) + (normed_add_group_hom.is_quotient_quotient _).norm_le) begin ext, - simp only [comp_apply, limits.zero_comp, normed_group_hom.zero_apply, - SemiNormedGroup₁.mk_hom_apply, SemiNormedGroup₁.zero_apply, ←normed_group_hom.mem_ker, + simp only [comp_apply, limits.zero_comp, normed_add_group_hom.zero_apply, + SemiNormedGroup₁.mk_hom_apply, SemiNormedGroup₁.zero_apply, ←normed_add_group_hom.mem_ker, f.1.range.ker_normed_mk, f.1.mem_range], use x, refl, @@ -53,12 +56,12 @@ def cokernel_lift {X Y : SemiNormedGroup₁.{u}} (f : X ⟶ Y) (s : cokernel_cof begin fsplit, -- The lift itself: - { apply normed_group_hom.lift _ s.π.1, + { apply normed_add_group_hom.lift _ s.π.1, rintro _ ⟨b, rfl⟩, change (f ≫ s.π) b = 0, simp, }, -- The lift has norm at most one: - exact normed_group_hom.lift_norm_noninc _ _ _ s.π.2, + exact normed_add_group_hom.lift_norm_noninc _ _ _ s.π.2, end instance : has_cokernels SemiNormedGroup₁.{u} := @@ -68,13 +71,13 @@ instance : has_cokernels SemiNormedGroup₁.{u} := (cokernel_lift f) (λ s, begin ext, - apply normed_group_hom.lift_mk f.1.range, + apply normed_add_group_hom.lift_mk f.1.range, rintro _ ⟨b, rfl⟩, change (f ≫ s.π) b = 0, simp, end) (λ s m w, subtype.eq - (normed_group_hom.lift_unique f.1.range _ _ _ (congr_arg subtype.val w : _))), } } + (normed_add_group_hom.lift_unique f.1.range _ _ _ (congr_arg subtype.val w : _))), } } -- Sanity check example : has_cokernels SemiNormedGroup₁ := by apply_instance @@ -87,13 +90,13 @@ section equalizers_and_kernels /-- The equalizer cone for a parallel pair of morphisms of seminormed groups. -/ def fork {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) : fork f g := -@fork.of_ι _ _ _ _ _ _ (of (f - g).ker) (normed_group_hom.incl (f - g).ker) $ +@fork.of_ι _ _ _ _ _ _ (of (f - g).ker) (normed_add_group_hom.incl (f - g).ker) $ begin ext v, have : v.1 ∈ (f - g).ker := v.2, - simpa only [normed_group_hom.incl_apply, pi.zero_apply, coe_comp, normed_group_hom.coe_zero, - subtype.val_eq_coe, normed_group_hom.mem_ker, - normed_group_hom.coe_sub, pi.sub_apply, sub_eq_zero] using this + simpa only [normed_add_group_hom.incl_apply, pi.zero_apply, coe_comp, + normed_add_group_hom.coe_zero, subtype.val_eq_coe, normed_add_group_hom.mem_ker, + normed_add_group_hom.coe_sub, pi.sub_apply, sub_eq_zero] using this end instance has_limit_parallel_pair {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) : @@ -101,10 +104,10 @@ instance has_limit_parallel_pair {V W : SemiNormedGroup.{u}} (f g : V ⟶ W) : { exists_limit := nonempty.intro { cone := fork f g, is_limit := fork.is_limit.mk _ - (λ c, normed_group_hom.ker.lift (fork.ι c) _ $ - show normed_group_hom.comp_hom (f - g) c.ι = 0, + (λ c, normed_add_group_hom.ker.lift (fork.ι c) _ $ + show normed_add_group_hom.comp_hom (f - g) c.ι = 0, by { rw [add_monoid_hom.map_sub, add_monoid_hom.sub_apply, sub_eq_zero], exact c.condition }) - (λ c, normed_group_hom.ker.incl_comp_lift _ _ _) + (λ c, normed_add_group_hom.ker.incl_comp_lift _ _ _) (λ c g h, by { ext x, dsimp, rw ← h, refl }) } } instance : limits.has_equalizers.{u (u+1)} SemiNormedGroup := @@ -121,17 +124,17 @@ section cokernel /-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/ def cokernel_cocone {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : cofork f 0 := @cofork.of_π _ _ _ _ _ _ - (SemiNormedGroup.of (Y ⧸ (normed_group_hom.range f))) + (SemiNormedGroup.of (Y ⧸ (normed_add_group_hom.range f))) f.range.normed_mk begin ext, - simp only [comp_apply, limits.zero_comp, normed_group_hom.zero_apply, - ←normed_group_hom.mem_ker, f.range.ker_normed_mk, f.mem_range, exists_apply_eq_apply], + simp only [comp_apply, limits.zero_comp, normed_add_group_hom.zero_apply, + ←normed_add_group_hom.mem_ker, f.range.ker_normed_mk, f.mem_range, exists_apply_eq_apply], end /-- Auxiliary definition for `has_cokernels SemiNormedGroup`. -/ def cokernel_lift {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) (s : cokernel_cofork f) : - (cokernel_cocone f).X ⟶ s.X := normed_group_hom.lift _ s.π + (cokernel_cocone f).X ⟶ s.X := normed_add_group_hom.lift _ s.π begin rintro _ ⟨b, rfl⟩, change (f ≫ s.π) b = 0, @@ -144,12 +147,12 @@ def is_colimit_cokernel_cocone {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : is_colimit_aux _ (cokernel_lift f) (λ s, begin ext, - apply normed_group_hom.lift_mk f.range, + apply normed_add_group_hom.lift_mk f.range, rintro _ ⟨b, rfl⟩, change (f ≫ s.π) b = 0, simp, end) -(λ s m w, normed_group_hom.lift_unique f.range _ _ _ w) +(λ s m w, normed_add_group_hom.lift_unique f.range _ _ _ w) instance : has_cokernels SemiNormedGroup.{u} := { has_colimit := λ X Y f, has_colimit.mk @@ -252,8 +255,8 @@ begin end lemma is_quotient_explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : -normed_group_hom.is_quotient (explicit_cokernel_π f) := -normed_group_hom.is_quotient_quotient _ +normed_add_group_hom.is_quotient (explicit_cokernel_π f) := +normed_add_group_hom.is_quotient_quotient _ lemma norm_noninc_explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : (explicit_cokernel_π f).norm_noninc := @@ -262,18 +265,18 @@ lemma norm_noninc_explicit_cokernel_π {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) open_locale nnreal lemma explicit_cokernel_desc_norm_le_of_norm_le {X Y Z : SemiNormedGroup.{u}} - {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) (c : ℝ≥0) (h : ∥ g ∥ ≤ c) : - ∥ explicit_cokernel_desc w ∥ ≤ c := -normed_group_hom.lift_norm_le _ _ _ h + {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) (c : ℝ≥0) (h : ‖ g ‖ ≤ c) : + ‖ explicit_cokernel_desc w ‖ ≤ c := +normed_add_group_hom.lift_norm_le _ _ _ h lemma explicit_cokernel_desc_norm_noninc {X Y Z : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z} {cond : f ≫ g = 0} (hg : g.norm_noninc) : (explicit_cokernel_desc cond).norm_noninc := begin - refine normed_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2 _, + refine normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.2 _, rw [← nnreal.coe_one], exact explicit_cokernel_desc_norm_le_of_norm_le cond 1 - (normed_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1 hg) + (normed_add_group_hom.norm_noninc.norm_noninc_iff_norm_le_one.1 hg) end lemma explicit_cokernel_desc_comp_eq_zero {X Y Z W : SemiNormedGroup.{u}} {f : X ⟶ Y} {g : Y ⟶ Z} @@ -285,8 +288,8 @@ begin end lemma explicit_cokernel_desc_norm_le {X Y Z : SemiNormedGroup.{u}} - {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) : ∥ explicit_cokernel_desc w ∥ ≤ ∥ g ∥ := -explicit_cokernel_desc_norm_le_of_norm_le w ∥ g ∥₊ le_rfl + {f : X ⟶ Y} {g : Y ⟶ Z} (w : f ≫ g = 0) : ‖ explicit_cokernel_desc w ‖ ≤ ‖ g ‖ := +explicit_cokernel_desc_norm_le_of_norm_le w ‖ g ‖₊ le_rfl /-- The explicit cokernel is isomorphic to the usual cokernel. -/ def explicit_cokernel_iso {X Y : SemiNormedGroup.{u}} (f : X ⟶ Y) : diff --git a/src/analysis/normed/group/add_circle.lean b/src/analysis/normed/group/add_circle.lean new file mode 100644 index 0000000000000..d62aa04e4c021 --- /dev/null +++ b/src/analysis/normed/group/add_circle.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2022 Oliver Nash. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Oliver Nash +-/ +import analysis.normed.group.quotient +import topology.instances.add_circle + +/-! +# The additive circle as a normed group + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define the normed group structure on `add_circle p`, for `p : ℝ`. For example if `p = 1` then: +`‖(x : add_circle 1)‖ = |x - round x|` for any `x : ℝ` (see `unit_add_circle.norm_eq`). + +## Main definitions: + + * `add_circle.norm_eq`: a characterisation of the norm on `add_circle p` + +## TODO + + * The fact `inner_product_geometry.angle (real.cos θ) (real.sin θ) = ‖(θ : real.angle)‖` + +-/ + +noncomputable theory + +open set int (hiding mem_zmultiples_iff) add_subgroup + +namespace add_circle + +variables (p : ℝ) + +instance : normed_add_comm_group (add_circle p) := add_subgroup.normed_add_comm_group_quotient _ + +@[simp] lemma norm_coe_mul (x : ℝ) (t : ℝ) : + ‖(↑(t * x) : add_circle (t * p))‖ = |t| * ‖(x : add_circle p)‖ := +begin + have aux : ∀ {a b c : ℝ}, a ∈ zmultiples b → c * a ∈ zmultiples (c * b) := λ a b c h, by + { simp only [mem_zmultiples_iff] at ⊢ h, + obtain ⟨n, rfl⟩ := h, + exact ⟨n, (mul_smul_comm n c b).symm⟩, }, + rcases eq_or_ne t 0 with rfl | ht, { simp, }, + have ht' : |t| ≠ 0 := (not_congr abs_eq_zero).mpr ht, + simp only [quotient_norm_eq, real.norm_eq_abs], + conv_rhs { rw [← smul_eq_mul, ← real.Inf_smul_of_nonneg (abs_nonneg t)], }, + simp only [quotient_add_group.mk'_apply, quotient_add_group.eq_iff_sub_mem], + congr' 1, + ext z, + rw mem_smul_set_iff_inv_smul_mem₀ ht', + show (∃ y, y - t * x ∈ zmultiples (t * p) ∧ |y| = z) ↔ ∃w, w - x ∈ zmultiples p ∧ |w| = |t|⁻¹ * z, + split, + { rintros ⟨y, hy, rfl⟩, + refine ⟨t⁻¹ * y, _, by rw [abs_mul, abs_inv]⟩, + rw [← inv_mul_cancel_left₀ ht x, ← inv_mul_cancel_left₀ ht p, ← mul_sub], + exact aux hy, }, + { rintros ⟨w, hw, hw'⟩, + refine ⟨t * w, _, by rw [← (eq_inv_mul_iff_mul_eq₀ ht').mp hw', abs_mul]⟩, + rw ← mul_sub, + exact aux hw, }, +end + +lemma norm_neg_period (x : ℝ) : + ‖(x : add_circle (-p))‖ = ‖(x : add_circle p)‖ := +begin + suffices : ‖(↑(-1 * x) : add_circle (-1 * p))‖ = ‖(x : add_circle p)‖, + { rw [← this, neg_one_mul], simp, }, + simp only [norm_coe_mul, abs_neg, abs_one, one_mul], +end + +@[simp] lemma norm_eq_of_zero {x : ℝ} : ‖(x : add_circle (0 : ℝ))‖ = |x| := +begin + suffices : {y : ℝ | (y : add_circle (0 : ℝ)) = (x : add_circle (0 : ℝ)) } = { x }, + { rw [quotient_norm_eq, this, image_singleton, real.norm_eq_abs, cInf_singleton], }, + ext y, + simp [quotient_add_group.eq_iff_sub_mem, mem_zmultiples_iff, sub_eq_zero], +end + +lemma norm_eq {x : ℝ} : ‖(x : add_circle p)‖ = |x - round (p⁻¹ * x) * p| := +begin + suffices : ∀ (x : ℝ), ‖(x : add_circle (1 : ℝ))‖ = |x - round x|, + { rcases eq_or_ne p 0 with rfl | hp, { simp, }, + intros, + have hx := norm_coe_mul p x p⁻¹, + rw [abs_inv, eq_inv_mul_iff_mul_eq₀ ((not_congr abs_eq_zero).mpr hp)] at hx, + rw [← hx, inv_mul_cancel hp, this, ← abs_mul, mul_sub, mul_inv_cancel_left₀ hp, mul_comm p], }, + clear x p, + intros, + rw [quotient_norm_eq, abs_sub_round_eq_min], + have h₁ : bdd_below (abs '' {m : ℝ | (m : add_circle (1 : ℝ)) = x}) := + ⟨0, by simp [mem_lower_bounds]⟩, + have h₂ : (abs '' {m : ℝ | (m : add_circle (1 : ℝ)) = x}).nonempty := ⟨|x|, ⟨x, rfl, rfl⟩⟩, + apply le_antisymm, + { simp only [le_min_iff, real.norm_eq_abs, cInf_le_iff h₁ h₂], + intros b h, + refine ⟨mem_lower_bounds.1 h _ ⟨fract x, _, abs_fract⟩, + mem_lower_bounds.1 h _ ⟨fract x - 1, _, by rw [abs_sub_comm, abs_one_sub_fract]⟩⟩, + { simp only [mem_set_of_eq, fract, sub_eq_self, quotient_add_group.coe_sub, + quotient_add_group.eq_zero_iff, int_cast_mem_zmultiples_one], }, + { simp only [mem_set_of_eq, fract, sub_eq_self, quotient_add_group.coe_sub, + quotient_add_group.eq_zero_iff, int_cast_mem_zmultiples_one, sub_sub, + (by norm_cast : (⌊x⌋ : ℝ) + 1 = (↑(⌊x⌋ + 1) : ℝ))], }, }, + { simp only [quotient_add_group.mk'_apply, real.norm_eq_abs, le_cInf_iff h₁ h₂], + rintros b' ⟨b, hb, rfl⟩, + simp only [mem_set_of_eq, quotient_add_group.eq_iff_sub_mem, mem_zmultiples_iff, + smul_one_eq_coe] at hb, + obtain ⟨z, hz⟩ := hb, + rw [(by { rw hz, abel, } : x = b - z), fract_sub_int, ← abs_sub_round_eq_min], + convert round_le b 0, + simp, }, +end + +lemma norm_eq' (hp : 0 < p) {x : ℝ} : + ‖(x : add_circle p)‖ = p * |(p⁻¹ * x) - round (p⁻¹ * x)| := +begin + conv_rhs { congr, rw ← abs_eq_self.mpr hp.le, }, + rw [← abs_mul, mul_sub, mul_inv_cancel_left₀ hp.ne.symm, norm_eq, mul_comm p], +end + +lemma norm_le_half_period {x : add_circle p} (hp : p ≠ 0) : ‖x‖ ≤ |p|/2 := +begin + obtain ⟨x⟩ := x, + change ‖(x : add_circle p)‖ ≤ |p|/2, + rw [norm_eq, ← mul_le_mul_left (abs_pos.mpr (inv_ne_zero hp)), ← abs_mul, mul_sub, mul_left_comm, + ← mul_div_assoc, ← abs_mul, inv_mul_cancel hp, mul_one, abs_one], + exact abs_sub_round (p⁻¹ * x), +end + +@[simp] lemma norm_half_period_eq : ‖(↑(p/2) : add_circle p)‖ = |p|/2 := +begin + rcases eq_or_ne p 0 with rfl | hp, { simp, }, + rw [norm_eq, ← mul_div_assoc, inv_mul_cancel hp, one_div, round_two_inv, algebra_map.coe_one, + one_mul, (by linarith : p / 2 - p = -(p / 2)), abs_neg, abs_div, abs_two], +end + +lemma norm_coe_eq_abs_iff {x : ℝ} (hp : p ≠ 0) : ‖(x : add_circle p)‖ = |x| ↔ |x| ≤ |p|/2 := +begin + refine ⟨λ hx, hx ▸ norm_le_half_period p hp, λ hx, _⟩, + suffices : ∀ (p : ℝ), 0 < p → |x| ≤ p/2 → ‖(x : add_circle p)‖ = |x|, + { rcases lt_trichotomy 0 p with hp | rfl | hp, + { rw abs_eq_self.mpr hp.le at hx, + exact this p hp hx, }, + { contradiction, }, + { rw ← norm_neg_period, + rw abs_eq_neg_self.mpr hp.le at hx, + exact this (-p) (neg_pos.mpr hp) hx, }, }, + clear hx, + intros p hp hx, + rcases eq_or_ne x (p/2) with rfl | hx', { simp [abs_div, abs_two], }, + suffices : round (p⁻¹ * x) = 0, { simp [norm_eq, this], }, + rw round_eq_zero_iff, + obtain ⟨hx₁, hx₂⟩ := abs_le.mp hx, + replace hx₂ := ne.lt_of_le hx' hx₂, + split, + { rwa [← mul_le_mul_left hp, ← mul_assoc, mul_inv_cancel hp.ne.symm, one_mul, mul_neg, + ← mul_div_assoc, mul_one], }, + { rwa [← mul_lt_mul_left hp, ← mul_assoc, mul_inv_cancel hp.ne.symm, one_mul, ← mul_div_assoc, + mul_one], }, +end + +open metric + +lemma closed_ball_eq_univ_of_half_period_le + (hp : p ≠ 0) (x : add_circle p) {ε : ℝ} (hε : |p|/2 ≤ ε) : + closed_ball x ε = univ := +eq_univ_iff_forall.mpr $ + λ x, by simpa only [mem_closed_ball, dist_eq_norm] using (norm_le_half_period p hp).trans hε + +@[simp] lemma coe_real_preimage_closed_ball_period_zero (x ε : ℝ) : + coe⁻¹' closed_ball (x : add_circle (0 : ℝ)) ε = closed_ball x ε := +by { ext y; simp [dist_eq_norm, ← quotient_add_group.coe_sub], } + +lemma coe_real_preimage_closed_ball_eq_Union (x ε : ℝ) : + coe⁻¹' closed_ball (x : add_circle p) ε = ⋃ (z : ℤ), closed_ball (x + z • p) ε := +begin + rcases eq_or_ne p 0 with rfl | hp, { simp [Union_const], }, + ext y, + simp only [dist_eq_norm, mem_preimage, mem_closed_ball, zsmul_eq_mul, mem_Union, real.norm_eq_abs, + ← quotient_add_group.coe_sub, norm_eq, ← sub_sub], + refine ⟨λ h, ⟨round (p⁻¹ * (y - x)), h⟩, _⟩, + rintros ⟨n, hn⟩, + rw [← mul_le_mul_left (abs_pos.mpr $ inv_ne_zero hp), ← abs_mul, mul_sub, mul_comm _ p, + inv_mul_cancel_left₀ hp] at hn ⊢, + exact (round_le (p⁻¹ * (y - x)) n).trans hn, +end + +lemma coe_real_preimage_closed_ball_inter_eq + {x ε : ℝ} (s : set ℝ) (hs : s ⊆ closed_ball x (|p|/2)) : + coe⁻¹' closed_ball (x : add_circle p) ε ∩ s = if ε < |p|/2 then (closed_ball x ε) ∩ s else s := +begin + cases le_or_lt (|p|/2) ε with hε hε, + { rcases eq_or_ne p 0 with rfl | hp, + { simp only [abs_zero, zero_div] at hε, + simp only [not_lt.mpr hε, coe_real_preimage_closed_ball_period_zero, abs_zero, zero_div, + if_false, inter_eq_right_iff_subset], + exact hs.trans (closed_ball_subset_closed_ball $ by simp [hε]), }, + simp [closed_ball_eq_univ_of_half_period_le p hp ↑x hε, not_lt.mpr hε], }, + { suffices : ∀ (z : ℤ), closed_ball (x + z • p) ε ∩ s = if z = 0 then closed_ball x ε ∩ s else ∅, + { simp [-zsmul_eq_mul, ← quotient_add_group.coe_zero, coe_real_preimage_closed_ball_eq_Union, + Union_inter, Union_ite, this, hε], }, + intros z, + simp only [real.closed_ball_eq_Icc, zero_sub, zero_add] at ⊢ hs, + rcases eq_or_ne z 0 with rfl | hz, { simp, }, + simp only [hz, zsmul_eq_mul, if_false, eq_empty_iff_forall_not_mem], + rintros y ⟨⟨hy₁, hy₂⟩, hy₀⟩, + obtain ⟨hy₃, hy₄⟩ := hs hy₀, + rcases lt_trichotomy 0 p with hp | rfl | hp, + { cases int.cast_le_neg_one_or_one_le_cast_of_ne_zero ℝ hz with hz' hz', + { have : ↑z * p ≤ - p, nlinarith, + linarith [abs_eq_self.mpr hp.le] }, + { have : p ≤ ↑z * p, nlinarith, + linarith [abs_eq_self.mpr hp.le] } }, + { simp only [mul_zero, add_zero, abs_zero, zero_div] at hy₁ hy₂ hε, + linarith }, + { cases int.cast_le_neg_one_or_one_le_cast_of_ne_zero ℝ hz with hz' hz', + { have : - p ≤ ↑z * p, nlinarith, + linarith [abs_eq_neg_self.mpr hp.le] }, + { have : ↑z * p ≤ p, nlinarith, + linarith [abs_eq_neg_self.mpr hp.le] } } }, +end + +section finite_order_points + +variables {p} [hp : fact (0 < p)] +include hp + +lemma norm_div_nat_cast {m n : ℕ} : + ‖(↑((↑m / ↑n) * p) : add_circle p)‖ = p * (↑(min (m % n) (n - m % n)) / n) := +begin + have : p⁻¹ * (↑m / ↑n * p) = ↑m / ↑n, { rw [mul_comm _ p, inv_mul_cancel_left₀ hp.out.ne.symm], }, + rw [norm_eq' p hp.out, this, abs_sub_round_div_nat_cast_eq], +end + +lemma exists_norm_eq_of_fin_add_order {u : add_circle p} (hu : is_of_fin_add_order u) : + ∃ (k : ℕ), ‖u‖ = p * (k / add_order_of u) := +begin + let n := add_order_of u, + change ∃ (k : ℕ), ‖u‖ = p * (k / n), + obtain ⟨m, -, -, hm⟩ := exists_gcd_eq_one_of_is_of_fin_add_order hu, + refine ⟨min (m % n) (n - m % n), _⟩, + rw [← hm, norm_div_nat_cast], +end + +lemma le_add_order_smul_norm_of_is_of_fin_add_order + {u : add_circle p} (hu : is_of_fin_add_order u) (hu' : u ≠ 0) : + p ≤ add_order_of u • ‖u‖ := +begin + obtain ⟨n, hn⟩ := exists_norm_eq_of_fin_add_order hu, + replace hu : (add_order_of u : ℝ) ≠ 0, { norm_cast, exact (add_order_of_pos_iff.mpr hu).ne.symm }, + conv_lhs { rw ← mul_one p, }, + rw [hn, nsmul_eq_mul, ← mul_assoc, mul_comm _ p, mul_assoc, mul_div_cancel' _ hu, + mul_le_mul_left hp.out, nat.one_le_cast, nat.one_le_iff_ne_zero], + contrapose! hu', + simpa only [hu', algebra_map.coe_zero, zero_div, mul_zero, norm_eq_zero] using hn, +end + +end finite_order_points + +end add_circle + +namespace unit_add_circle + +lemma norm_eq {x : ℝ} : ‖(x : unit_add_circle)‖ = |x - round x| := by simp [add_circle.norm_eq] + +end unit_add_circle diff --git a/src/analysis/normed/group/add_torsor.lean b/src/analysis/normed/group/add_torsor.lean index ddbfb457da4fa..6642720beafb0 100644 --- a/src/analysis/normed/group/add_torsor.lean +++ b/src/analysis/normed/group/add_torsor.lean @@ -4,39 +4,59 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Joseph Myers, Yury Kudryashov -/ import analysis.normed.group.basic +import linear_algebra.affine_space.affine_subspace import linear_algebra.affine_space.midpoint /-! # Torsors of additive normed group actions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines torsors of additive normed group actions, with a metric space structure. The motivating case is Euclidean affine spaces. -/ noncomputable theory -open_locale nnreal topological_space +open_locale nnreal topology open filter /-- A `normed_add_torsor V P` is a torsor of an additive seminormed group -action by a `semi_normed_group V` on points `P`. We bundle the pseudometric space +action by a `seminormed_add_comm_group V` on points `P`. We bundle the pseudometric space structure and require the distance to be the same as results from the norm (which in fact implies the distance yields a pseudometric space, but bundling just the distance and using an instance for the pseudometric space results in type class problems). -/ class normed_add_torsor (V : out_param $ Type*) (P : Type*) - [out_param $ semi_normed_group V] [pseudo_metric_space P] + [out_param $ seminormed_add_comm_group V] [pseudo_metric_space P] extends add_torsor V P := -(dist_eq_norm' : ∀ (x y : P), dist x y = ∥(x -ᵥ y : V)∥) +(dist_eq_norm' : ∀ (x y : P), dist x y = ‖(x -ᵥ y : V)‖) + +/-- Shortcut instance to help typeclass inference out. -/ +@[priority 100] +instance normed_add_torsor.to_add_torsor' {V P : Type*} [normed_add_comm_group V] [metric_space P] + [normed_add_torsor V P] : add_torsor V P := normed_add_torsor.to_add_torsor + +variables {α V P W Q : Type*} [seminormed_add_comm_group V] [pseudo_metric_space P] + [normed_add_torsor V P] [normed_add_comm_group W] [metric_space Q] [normed_add_torsor W Q] -variables {α V P : Type*} [semi_normed_group V] [pseudo_metric_space P] [normed_add_torsor V P] -variables {W Q : Type*} [normed_group W] [metric_space Q] [normed_add_torsor W Q] +@[priority 100] +instance normed_add_torsor.to_has_isometric_vadd : has_isometric_vadd V P := +⟨λ c, isometry.of_dist_eq $ λ x y, by simp [normed_add_torsor.dist_eq_norm']⟩ -/-- A `semi_normed_group` is a `normed_add_torsor` over itself. -/ +/-- A `seminormed_add_comm_group` is a `normed_add_torsor` over itself. -/ @[priority 100] -instance semi_normed_group.to_normed_add_torsor : normed_add_torsor V V := +instance seminormed_add_comm_group.to_normed_add_torsor : normed_add_torsor V V := { dist_eq_norm' := dist_eq_norm } +/-- A nonempty affine subspace of a `normed_add_torsor` is itself a `normed_add_torsor`. -/ +@[nolint fails_quickly] -- Because of the add_torsor.nonempty instance. +instance affine_subspace.to_normed_add_torsor {R : Type*} [ring R] [module R V] + (s : affine_subspace R P) [nonempty s] : normed_add_torsor s.direction s := +{ dist_eq_norm' := λ x y, normed_add_torsor.dist_eq_norm' ↑x ↑y, + ..affine_subspace.to_add_torsor s } + include V section @@ -46,84 +66,80 @@ variables (V W) /-- The distance equals the norm of subtracting two points. In this lemma, it is necessary to have `V` as an explicit argument; otherwise `rw dist_eq_norm_vsub` sometimes doesn't work. -/ -lemma dist_eq_norm_vsub (x y : P) : dist x y = ∥x -ᵥ y∥ := normed_add_torsor.dist_eq_norm' x y +lemma dist_eq_norm_vsub (x y : P) : dist x y = ‖x -ᵥ y‖ := normed_add_torsor.dist_eq_norm' x y + +lemma nndist_eq_nnnorm_vsub (x y : P) : nndist x y = ‖x -ᵥ y‖₊ := +nnreal.eq $ dist_eq_norm_vsub V x y + +/-- The distance equals the norm of subtracting two points. In this +lemma, it is necessary to have `V` as an explicit argument; otherwise +`rw dist_eq_norm_vsub'` sometimes doesn't work. -/ +lemma dist_eq_norm_vsub' (x y : P) : dist x y = ‖y -ᵥ x‖ := +(dist_comm _ _).trans (dist_eq_norm_vsub _ _ _) + +lemma nndist_eq_nnnorm_vsub' (x y : P) : nndist x y = ‖y -ᵥ x‖₊ := +nnreal.eq $ dist_eq_norm_vsub' V x y end -@[simp] lemma dist_vadd_cancel_left (v : V) (x y : P) : +lemma dist_vadd_cancel_left (v : V) (x y : P) : dist (v +ᵥ x) (v +ᵥ y) = dist x y := -by rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, vadd_vsub_vadd_cancel_left] +dist_vadd _ _ _ @[simp] lemma dist_vadd_cancel_right (v₁ v₂ : V) (x : P) : dist (v₁ +ᵥ x) (v₂ +ᵥ x) = dist v₁ v₂ := by rw [dist_eq_norm_vsub V, dist_eq_norm, vadd_vsub_vadd_cancel_right] -@[simp] lemma dist_vadd_left (v : V) (x : P) : dist (v +ᵥ x) x = ∥v∥ := +@[simp] lemma nndist_vadd_cancel_right (v₁ v₂ : V) (x : P) : + nndist (v₁ +ᵥ x) (v₂ +ᵥ x) = nndist v₁ v₂ := +nnreal.eq $ dist_vadd_cancel_right _ _ _ + +@[simp] lemma dist_vadd_left (v : V) (x : P) : dist (v +ᵥ x) x = ‖v‖ := by simp [dist_eq_norm_vsub V _ x] -@[simp] lemma dist_vadd_right (v : V) (x : P) : dist x (v +ᵥ x) = ∥v∥ := +@[simp] lemma nndist_vadd_left (v : V) (x : P) : nndist (v +ᵥ x) x = ‖v‖₊ := +nnreal.eq $ dist_vadd_left _ _ + +@[simp] lemma dist_vadd_right (v : V) (x : P) : dist x (v +ᵥ x) = ‖v‖ := by rw [dist_comm, dist_vadd_left] +@[simp] lemma nndist_vadd_right (v : V) (x : P) : nndist x (v +ᵥ x) = ‖v‖₊ := +nnreal.eq $ dist_vadd_right _ _ + /-- Isometry between the tangent space `V` of a (semi)normed add torsor `P` and `P` given by addition/subtraction of `x : P`. -/ -@[simps] def isometric.vadd_const (x : P) : V ≃ᵢ P := +@[simps] def isometry_equiv.vadd_const (x : P) : V ≃ᵢ P := { to_equiv := equiv.vadd_const x, - isometry_to_fun := isometry_emetric_iff_metric.2 $ λ _ _, dist_vadd_cancel_right _ _ _ } - -section - -variable (P) - -/-- Self-isometry of a (semi)normed add torsor given by addition of a constant vector `x`. -/ -@[simps] def isometric.const_vadd (x : V) : P ≃ᵢ P := -{ to_equiv := equiv.const_vadd P x, - isometry_to_fun := isometry_emetric_iff_metric.2 $ λ _ _, dist_vadd_cancel_left _ _ _ } - -end + isometry_to_fun := isometry.of_dist_eq $ λ _ _, dist_vadd_cancel_right _ _ _ } @[simp] lemma dist_vsub_cancel_left (x y z : P) : dist (x -ᵥ y) (x -ᵥ z) = dist y z := by rw [dist_eq_norm, vsub_sub_vsub_cancel_left, dist_comm, dist_eq_norm_vsub V] /-- Isometry between the tangent space `V` of a (semi)normed add torsor `P` and `P` given by subtraction from `x : P`. -/ -@[simps] def isometric.const_vsub (x : P) : P ≃ᵢ V := +@[simps] def isometry_equiv.const_vsub (x : P) : P ≃ᵢ V := { to_equiv := equiv.const_vsub x, - isometry_to_fun := isometry_emetric_iff_metric.2 $ λ y z, dist_vsub_cancel_left _ _ _ } + isometry_to_fun := isometry.of_dist_eq $ λ y z, dist_vsub_cancel_left _ _ _ } @[simp] lemma dist_vsub_cancel_right (x y z : P) : dist (x -ᵥ z) (y -ᵥ z) = dist x y := -(isometric.vadd_const z).symm.dist_eq x y - -section pointwise - -open_locale pointwise - -@[simp] lemma vadd_ball (x : V) (y : P) (r : ℝ) : - x +ᵥ metric.ball y r = metric.ball (x +ᵥ y) r := -(isometric.const_vadd P x).image_ball y r - -@[simp] lemma vadd_closed_ball (x : V) (y : P) (r : ℝ) : - x +ᵥ metric.closed_ball y r = metric.closed_ball (x +ᵥ y) r := -(isometric.const_vadd P x).image_closed_ball y r +(isometry_equiv.vadd_const z).symm.dist_eq x y -@[simp] lemma vadd_sphere (x : V) (y : P) (r : ℝ) : - x +ᵥ metric.sphere y r = metric.sphere (x +ᵥ y) r := -(isometric.const_vadd P x).image_sphere y r - -end pointwise +@[simp] lemma nndist_vsub_cancel_right (x y z : P) : nndist (x -ᵥ z) (y -ᵥ z) = nndist x y := +nnreal.eq $ dist_vsub_cancel_right _ _ _ lemma dist_vadd_vadd_le (v v' : V) (p p' : P) : dist (v +ᵥ p) (v' +ᵥ p') ≤ dist v v' + dist p p' := by simpa using dist_triangle (v +ᵥ p) (v' +ᵥ p) (v' +ᵥ p') +lemma nndist_vadd_vadd_le (v v' : V) (p p' : P) : + nndist (v +ᵥ p) (v' +ᵥ p') ≤ nndist v v' + nndist p p' := +dist_vadd_vadd_le _ _ _ _ + lemma dist_vsub_vsub_le (p₁ p₂ p₃ p₄ : P) : dist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ dist p₁ p₃ + dist p₂ p₄ := by { rw [dist_eq_norm, vsub_sub_vsub_comm, dist_eq_norm_vsub V, dist_eq_norm_vsub V], exact norm_sub_le _ _ } -lemma nndist_vadd_vadd_le (v v' : V) (p p' : P) : - nndist (v +ᵥ p) (v' +ᵥ p') ≤ nndist v v' + nndist p p' := -by simp only [← nnreal.coe_le_coe, nnreal.coe_add, ← dist_nndist, dist_vadd_vadd_le] - lemma nndist_vsub_vsub_le (p₁ p₂ p₃ p₄ : P) : nndist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ nndist p₁ p₃ + nndist p₂ p₄ := by simp only [← nnreal.coe_le_coe, nnreal.coe_add, ← dist_nndist, dist_vsub_vsub_le] @@ -141,14 +157,14 @@ omit V /-- The pseudodistance defines a pseudometric space structure on the torsor. This is not an instance because it depends on `V` to define a `metric_space P`. -/ -def pseudo_metric_space_of_normed_group_of_add_torsor (V P : Type*) [semi_normed_group V] - [add_torsor V P] : pseudo_metric_space P := -{ dist := λ x y, ∥(x -ᵥ y : V)∥, +def pseudo_metric_space_of_normed_add_comm_group_of_add_torsor (V P : Type*) + [seminormed_add_comm_group V] [add_torsor V P] : pseudo_metric_space P := +{ dist := λ x y, ‖(x -ᵥ y : V)‖, dist_self := λ x, by simp, dist_comm := λ x y, by simp only [←neg_vsub_eq_vsub_rev y x, norm_neg], dist_triangle := begin intros x y z, - change ∥x -ᵥ z∥ ≤ ∥x -ᵥ y∥ + ∥y -ᵥ z∥, + change ‖x -ᵥ z‖ ≤ ‖x -ᵥ y‖ + ‖y -ᵥ z‖, rw ←vsub_add_vsub_cancel, apply norm_add_le end } @@ -156,15 +172,16 @@ def pseudo_metric_space_of_normed_group_of_add_torsor (V P : Type*) [semi_normed /-- The distance defines a metric space structure on the torsor. This is not an instance because it depends on `V` to define a `metric_space P`. -/ -def metric_space_of_normed_group_of_add_torsor (V P : Type*) [normed_group V] [add_torsor V P] : +def metric_space_of_normed_add_comm_group_of_add_torsor (V P : Type*) + [normed_add_comm_group V] [add_torsor V P] : metric_space P := -{ dist := λ x y, ∥(x -ᵥ y : V)∥, +{ dist := λ x y, ‖(x -ᵥ y : V)‖, dist_self := λ x, by simp, eq_of_dist_eq_zero := λ x y h, by simpa using h, dist_comm := λ x y, by simp only [←neg_vsub_eq_vsub_rev y x, norm_neg], dist_triangle := begin intros x y z, - change ∥x -ᵥ z∥ ≤ ∥x -ᵥ y∥ + ∥y -ᵥ z∥, + change ‖x -ᵥ z‖ ≤ ‖x -ᵥ y‖ + ‖y -ᵥ z‖, rw ←vsub_add_vsub_cancel, apply norm_add_le end } diff --git a/src/analysis/normed/group/ball_sphere.lean b/src/analysis/normed/group/ball_sphere.lean new file mode 100644 index 0000000000000..6d90e2110fa4b --- /dev/null +++ b/src/analysis/normed/group/ball_sphere.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Heather Macbeth +-/ +import analysis.normed.group.basic + +/-! +# Negation on spheres and balls + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `has_involutive_neg` instances for spheres, open balls, and closed balls in a +semi normed group. +-/ + +open metric set + +variables {E : Type*} [seminormed_add_comm_group E] {r : ℝ} + +/-- We equip the sphere, in a seminormed group, with a formal operation of negation, namely the +antipodal map. -/ +instance : has_involutive_neg (sphere (0 : E) r) := +{ neg := subtype.map has_neg.neg $ λ w, by simp, + neg_neg := λ x, subtype.ext $ neg_neg x } + +@[simp] lemma coe_neg_sphere {r : ℝ} (v : sphere (0 : E) r) : + ↑(-v) = (-v : E) := +rfl + +instance : has_continuous_neg (sphere (0 : E) r) := ⟨continuous_neg.subtype_map _⟩ + +/-- We equip the ball, in a seminormed group, with a formal operation of negation, namely the +antipodal map. -/ +instance {r : ℝ} : has_involutive_neg (ball (0 : E) r) := +{ neg := subtype.map has_neg.neg $ λ w, by simp, + neg_neg := λ x, subtype.ext $ neg_neg x } + +@[simp] lemma coe_neg_ball {r : ℝ} (v : ball (0 : E) r) : + ↑(-v) = (-v : E) := +rfl + +instance : has_continuous_neg (ball (0 : E) r) := ⟨continuous_neg.subtype_map _⟩ + +/-- We equip the closed ball, in a seminormed group, with a formal operation of negation, namely the +antipodal map. -/ +instance {r : ℝ} : has_involutive_neg (closed_ball (0 : E) r) := +{ neg := subtype.map has_neg.neg $ λ w, by simp, + neg_neg := λ x, subtype.ext $ neg_neg x } + +@[simp] lemma coe_neg_closed_ball {r : ℝ} (v : closed_ball (0 : E) r) : + ↑(-v) = (-v : E) := +rfl + +instance : has_continuous_neg (closed_ball (0 : E) r) := ⟨continuous_neg.subtype_map _⟩ diff --git a/src/analysis/normed/group/basic.lean b/src/analysis/normed/group/basic.lean index 05c587581b6df..6fe45df80f9c3 100644 --- a/src/analysis/normed/group/basic.lean +++ b/src/analysis/normed/group/basic.lean @@ -1,693 +1,1296 @@ /- Copyright (c) 2018 Patrick Massot. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Patrick Massot, Johannes Hölzl +Authors: Patrick Massot, Johannes Hölzl, Yaël Dillies -/ +import analysis.normed.group.seminorm import order.liminf_limsup import topology.algebra.uniform_group +import topology.instances.rat import topology.metric_space.algebra -import topology.metric_space.isometry +import topology.metric_space.isometric_smul import topology.sequences /-! # Normed (semi)groups -In this file we define four classes: +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define 10 classes: * `has_norm`, `has_nnnorm`: auxiliary classes endowing a type `α` with a function `norm : α → ℝ` - (notation: `∥x∥`) and `nnnorm : α → ℝ≥0` (notation: `∥x∥₊`), respectively; -* `semi_normed_group`: a seminormed group is an additive group with a norm and a pseudo metric space - structures that agree with each other: `∀ x y, dist x y = ∥x - y∥`; -* `normed_group`: a normed group is an additive group with a norm and a metric space structures that - agree with each other: `∀ x y, dist x y = ∥x - y∥`. + (notation: `‖x‖`) and `nnnorm : α → ℝ≥0` (notation: `‖x‖₊`), respectively; +* `seminormed_..._group`: A seminormed (additive) (commutative) group is an (additive) (commutative) + group with a norm and a compatible pseudometric space structure: + `∀ x y, dist x y = ‖x / y‖` or `∀ x y, dist x y = ‖x - y‖`, depending on the group operation. +* `normed_..._group`: A normed (additive) (commutative) group is an (additive) (commutative) group + with a norm and a compatible metric space structure. We also prove basic properties of (semi)normed groups and provide some instances. +## Notes + +The current convention `dist x y = ‖x - y‖` means that the distance is invariant under right +addition, but actions in mathlib are usually from the left. This means we might want to change it to +`dist x y = ‖-x + y‖`. + +The normed group hierarchy would lend itself well to a mixin design (that is, having +`seminormed_group` and `seminormed_add_group` not extend `group` and `add_group`), but we choose not +to for performance concerns. + ## Tags normed group -/ -variables {α ι E F G : Type*} +variables {𝓕 𝕜 α ι κ E F G : Type*} -open filter metric -open_locale topological_space big_operators nnreal ennreal uniformity pointwise +open filter function metric +open_locale big_operators ennreal filter nnreal uniformity pointwise topology -/-- Auxiliary class, endowing a type `E` with a function `norm : E → ℝ` with notation `∥x∥`. This +/-- Auxiliary class, endowing a type `E` with a function `norm : E → ℝ` with notation `‖x‖`. This class is designed to be extended in more interesting classes specifying the properties of the norm. -/ -class has_norm (E : Type*) := (norm : E → ℝ) +@[notation_class] class has_norm (E : Type*) := (norm : E → ℝ) + +/-- Auxiliary class, endowing a type `α` with a function `nnnorm : α → ℝ≥0` with notation `‖x‖₊`. -/ +@[notation_class] class has_nnnorm (E : Type*) := (nnnorm : E → ℝ≥0) export has_norm (norm) +export has_nnnorm (nnnorm) + +notation `‖` e `‖` := norm e +notation `‖` e `‖₊` := nnnorm e -notation `∥` e `∥` := norm e +/-- A seminormed group is an additive group endowed with a norm for which `dist x y = ‖x - y‖` +defines a pseudometric space structure. -/ +class seminormed_add_group (E : Type*) extends has_norm E, add_group E, pseudo_metric_space E := +(dist := λ x y, ‖x - y‖) +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) + +/-- A seminormed group is a group endowed with a norm for which `dist x y = ‖x / y‖` defines a +pseudometric space structure. -/ +@[to_additive] +class seminormed_group (E : Type*) extends has_norm E, group E, pseudo_metric_space E := +(dist := λ x y, ‖x / y‖) +(dist_eq : ∀ x y, dist x y = ‖x / y‖ . obviously) + +/-- A normed group is an additive group endowed with a norm for which `dist x y = ‖x - y‖` defines a +metric space structure. -/ +class normed_add_group (E : Type*) extends has_norm E, add_group E, metric_space E := +(dist := λ x y, ‖x - y‖) +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) + +/-- A normed group is a group endowed with a norm for which `dist x y = ‖x / y‖` defines a metric +space structure. -/ +@[to_additive] +class normed_group (E : Type*) extends has_norm E, group E, metric_space E := +(dist := λ x y, ‖x / y‖) +(dist_eq : ∀ x y, dist x y = ‖x / y‖ . obviously) + +/-- A seminormed group is an additive group endowed with a norm for which `dist x y = ‖x - y‖` +defines a pseudometric space structure. -/ +class seminormed_add_comm_group (E : Type*) + extends has_norm E, add_comm_group E, pseudo_metric_space E := +(dist := λ x y, ‖x - y‖) +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) -/-- A seminormed group is an additive group endowed with a norm for which `dist x y = ∥x - y∥` +/-- A seminormed group is a group endowed with a norm for which `dist x y = ‖x / y‖` defines a pseudometric space structure. -/ -class semi_normed_group (E : Type*) extends has_norm E, add_comm_group E, pseudo_metric_space E := -(dist_eq : ∀ x y : E, dist x y = norm (x - y)) - -/-- A normed group is an additive group endowed with a norm for which `dist x y = ∥x - y∥` defines -a metric space structure. -/ -class normed_group (E : Type*) extends has_norm E, add_comm_group E, metric_space E := -(dist_eq : ∀ x y : E, dist x y = norm (x - y)) - -/-- A normed group is a seminormed group. -/ -@[priority 100] -- see Note [lower instance priority] -instance normed_group.to_semi_normed_group [h : normed_group E] : semi_normed_group E := -{ .. h } - -/-- Construct a seminormed group from a translation invariant pseudodistance. -/ -def semi_normed_group.of_add_dist [has_norm E] [add_comm_group E] [pseudo_metric_space E] - (H1 : ∀ x : E, ∥x∥ = dist x 0) - (H2 : ∀ x y z : E, dist x y ≤ dist (x + z) (y + z)) : semi_normed_group E := +@[to_additive] +class seminormed_comm_group (E : Type*) + extends has_norm E, comm_group E, pseudo_metric_space E := +(dist := λ x y, ‖x / y‖) +(dist_eq : ∀ x y, dist x y = ‖x / y‖ . obviously) + +/-- A normed group is an additive group endowed with a norm for which `dist x y = ‖x - y‖` defines a +metric space structure. -/ +class normed_add_comm_group (E : Type*) extends has_norm E, add_comm_group E, metric_space E := +(dist := λ x y, ‖x - y‖) +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) + +/-- A normed group is a group endowed with a norm for which `dist x y = ‖x / y‖` defines a metric +space structure. -/ +@[to_additive] +class normed_comm_group (E : Type*) extends has_norm E, comm_group E, metric_space E := +(dist := λ x y, ‖x / y‖) +(dist_eq : ∀ x y, dist x y = ‖x / y‖ . obviously) + +@[priority 100, to_additive] -- See note [lower instance priority] +instance normed_group.to_seminormed_group [normed_group E] : seminormed_group E := +{ ..‹normed_group E› } + +@[priority 100, to_additive] -- See note [lower instance priority] +instance normed_comm_group.to_seminormed_comm_group [normed_comm_group E] : + seminormed_comm_group E := +{ ..‹normed_comm_group E› } + +@[priority 100, to_additive] -- See note [lower instance priority] +instance seminormed_comm_group.to_seminormed_group [seminormed_comm_group E] : seminormed_group E := +{ ..‹seminormed_comm_group E› } + +@[priority 100, to_additive] -- See note [lower instance priority] +instance normed_comm_group.to_normed_group [normed_comm_group E] : normed_group E := +{ ..‹normed_comm_group E› } + +/-- Construct a `normed_group` from a `seminormed_group` satisfying `∀ x, ‖x‖ = 0 → x = 1`. This +avoids having to go back to the `(pseudo_)metric_space` level when declaring a `normed_group` +instance as a special case of a more general `seminormed_group` instance. -/ +@[to_additive "Construct a `normed_add_group` from a `seminormed_add_group` satisfying +`∀ x, ‖x‖ = 0 → x = 0`. This avoids having to go back to the `(pseudo_)metric_space` level when +declaring a `normed_add_group` instance as a special case of a more general `seminormed_add_group` +instance.", reducible] -- See note [reducible non-instances] +def normed_group.of_separation [seminormed_group E] (h : ∀ x : E, ‖x‖ = 0 → x = 1) : + normed_group E := +{ to_metric_space := + { eq_of_dist_eq_zero := λ x y hxy, div_eq_one.1 $ h _ $ by rwa ←‹seminormed_group E›.dist_eq }, + ..‹seminormed_group E› } + +/-- Construct a `normed_comm_group` from a `seminormed_comm_group` satisfying +`∀ x, ‖x‖ = 0 → x = 1`. This avoids having to go back to the `(pseudo_)metric_space` level when +declaring a `normed_comm_group` instance as a special case of a more general `seminormed_comm_group` +instance. -/ +@[to_additive "Construct a `normed_add_comm_group` from a `seminormed_add_comm_group` satisfying +`∀ x, ‖x‖ = 0 → x = 0`. This avoids having to go back to the `(pseudo_)metric_space` level when +declaring a `normed_add_comm_group` instance as a special case of a more general +`seminormed_add_comm_group` instance.", reducible] -- See note [reducible non-instances] +def normed_comm_group.of_separation [seminormed_comm_group E] (h : ∀ x : E, ‖x‖ = 0 → x = 1) : + normed_comm_group E := +{ ..‹seminormed_comm_group E›, ..normed_group.of_separation h } + +/-- Construct a seminormed group from a multiplication-invariant distance. -/ +@[to_additive "Construct a seminormed group from a translation-invariant distance."] +def seminormed_group.of_mul_dist [has_norm E] [group E] [pseudo_metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist x y ≤ dist (x * z) (y * z)) : + seminormed_group E := { dist_eq := λ x y, begin - rw H1, apply le_antisymm, - { rw [sub_eq_add_neg, ← add_right_neg y], apply H2 }, - { have := H2 (x - y) 0 y, rwa [sub_add_cancel, zero_add] at this } + rw h₁, apply le_antisymm, + { simpa only [div_eq_mul_inv, ← mul_right_inv y] using h₂ _ _ _ }, + { simpa only [div_mul_cancel', one_mul] using h₂ (x/y) 1 y } end } -/-- Construct a seminormed group from a translation invariant pseudodistance -/ -def semi_normed_group.of_add_dist' [has_norm E] [add_comm_group E] [pseudo_metric_space E] - (H1 : ∀ x : E, ∥x∥ = dist x 0) - (H2 : ∀ x y z : E, dist (x + z) (y + z) ≤ dist x y) : semi_normed_group E := +/-- Construct a seminormed group from a multiplication-invariant pseudodistance. -/ +@[to_additive "Construct a seminormed group from a translation-invariant pseudodistance."] +def seminormed_group.of_mul_dist' [has_norm E] [group E] [pseudo_metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist (x * z) (y * z) ≤ dist x y) : + seminormed_group E := { dist_eq := λ x y, begin - rw H1, apply le_antisymm, - { have := H2 (x - y) 0 y, rwa [sub_add_cancel, zero_add] at this }, - { rw [sub_eq_add_neg, ← add_right_neg y], apply H2 } + rw h₁, apply le_antisymm, + { simpa only [div_mul_cancel', one_mul] using h₂ (x/y) 1 y }, + { simpa only [div_eq_mul_inv, ← mul_right_inv y] using h₂ _ _ _ } end } -/-- A seminormed group can be built from a seminorm that satisfies algebraic properties. This is -formalised in this structure. -/ -structure semi_normed_group.core (E : Type*) [add_comm_group E] [has_norm E] : Prop := -(norm_zero : ∥(0 : E)∥ = 0) -(triangle : ∀ x y : E, ∥x + y∥ ≤ ∥x∥ + ∥y∥) -(norm_neg : ∀ x : E, ∥-x∥ = ∥x∥) - -/-- Constructing a seminormed group from core properties of a seminorm, i.e., registering the -pseudodistance and the pseudometric space structure from the seminorm properties. Note that in most -cases this instance creates bad definitional equalities (e.g., it does not take into account -a possibly existing `uniform_space` instance on `E`). -/ -def semi_normed_group.of_core (E : Type*) [add_comm_group E] [has_norm E] - (C : semi_normed_group.core E) : semi_normed_group E := -{ dist := λ x y, ∥x - y∥, - dist_eq := assume x y, by refl, - dist_self := assume x, by simp [C.norm_zero], - dist_triangle := assume x y z, - calc ∥x - z∥ = ∥x - y + (y - z)∥ : by rw sub_add_sub_cancel - ... ≤ ∥x - y∥ + ∥y - z∥ : C.triangle _ _, - dist_comm := assume x y, - calc ∥x - y∥ = ∥ -(y - x)∥ : by simp - ... = ∥y - x∥ : by { rw [C.norm_neg] } } - -instance : normed_group punit := +/-- Construct a seminormed group from a multiplication-invariant pseudodistance. -/ +@[to_additive "Construct a seminormed group from a translation-invariant pseudodistance."] +def seminormed_comm_group.of_mul_dist [has_norm E] [comm_group E] [pseudo_metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist x y ≤ dist (x * z) (y * z)) : + seminormed_comm_group E := +{ ..seminormed_group.of_mul_dist h₁ h₂ } + +/-- Construct a seminormed group from a multiplication-invariant pseudodistance. -/ +@[to_additive "Construct a seminormed group from a translation-invariant pseudodistance."] +def seminormed_comm_group.of_mul_dist' [has_norm E] [comm_group E] [pseudo_metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist (x * z) (y * z) ≤ dist x y) : + seminormed_comm_group E := +{ ..seminormed_group.of_mul_dist' h₁ h₂ } + +/-- Construct a normed group from a multiplication-invariant distance. -/ +@[to_additive "Construct a normed group from a translation-invariant distance."] +def normed_group.of_mul_dist [has_norm E] [group E] [metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist x y ≤ dist (x * z) (y * z)) : + normed_group E := +{ ..seminormed_group.of_mul_dist h₁ h₂ } + +/-- Construct a normed group from a multiplication-invariant pseudodistance. -/ +@[to_additive "Construct a normed group from a translation-invariant pseudodistance."] +def normed_group.of_mul_dist' [has_norm E] [group E] [metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist (x * z) (y * z) ≤ dist x y) : + normed_group E := +{ ..seminormed_group.of_mul_dist' h₁ h₂ } + +/-- Construct a normed group from a multiplication-invariant pseudodistance. -/ +@[to_additive "Construct a normed group from a translation-invariant pseudodistance."] +def normed_comm_group.of_mul_dist [has_norm E] [comm_group E] [metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist x y ≤ dist (x * z) (y * z)) : + normed_comm_group E := +{ ..normed_group.of_mul_dist h₁ h₂ } + +/-- Construct a normed group from a multiplication-invariant pseudodistance. -/ +@[to_additive "Construct a normed group from a translation-invariant pseudodistance."] +def normed_comm_group.of_mul_dist' [has_norm E] [comm_group E] [metric_space E] + (h₁ : ∀ x : E, ‖x‖ = dist x 1) (h₂ : ∀ x y z : E, dist (x * z) (y * z) ≤ dist x y) : + normed_comm_group E := +{ ..normed_group.of_mul_dist' h₁ h₂ } + +set_option old_structure_cmd true + +/-- Construct a seminormed group from a seminorm, i.e., registering the pseudodistance and the +pseudometric space structure from the seminorm properties. Note that in most cases this instance +creates bad definitional equalities (e.g., it does not take into account a possibly existing +`uniform_space` instance on `E`). -/ +@[to_additive "Construct a seminormed group from a seminorm, i.e., registering the pseudodistance* +and the pseudometric space structure from the seminorm properties. Note that in most cases this +instance creates bad definitional equalities (e.g., it does not take into account a possibly +existing `uniform_space` instance on `E`)."] +def group_seminorm.to_seminormed_group [group E] (f : group_seminorm E) : seminormed_group E := +{ dist := λ x y, f (x / y), + norm := f, + dist_eq := λ x y, rfl, + dist_self := λ x, by simp only [div_self', map_one_eq_zero], + dist_triangle := le_map_div_add_map_div f, + dist_comm := map_div_rev f } + +/-- Construct a seminormed group from a seminorm, i.e., registering the pseudodistance and the +pseudometric space structure from the seminorm properties. Note that in most cases this instance +creates bad definitional equalities (e.g., it does not take into account a possibly existing +`uniform_space` instance on `E`). -/ +@[to_additive "Construct a seminormed group from a seminorm, i.e., registering the pseudodistance* +and the pseudometric space structure from the seminorm properties. Note that in most cases this +instance creates bad definitional equalities (e.g., it does not take into account a possibly +existing `uniform_space` instance on `E`)."] +def group_seminorm.to_seminormed_comm_group [comm_group E] (f : group_seminorm E) : + seminormed_comm_group E := +{ ..f.to_seminormed_group } + +/-- Construct a normed group from a norm, i.e., registering the distance and the metric space +structure from the norm properties. Note that in most cases this instance creates bad definitional +equalities (e.g., it does not take into account a possibly existing `uniform_space` instance on +`E`). -/ +@[to_additive "Construct a normed group from a norm, i.e., registering the distance and the metric +space structure from the norm properties. Note that in most cases this instance creates bad +definitional equalities (e.g., it does not take into account a possibly existing `uniform_space` +instance on `E`)."] +def group_norm.to_normed_group [group E] (f : group_norm E) : normed_group E := +{ eq_of_dist_eq_zero := λ x y h, div_eq_one.1 $ eq_one_of_map_eq_zero f h, + ..f.to_group_seminorm.to_seminormed_group } + +/-- Construct a normed group from a norm, i.e., registering the distance and the metric space +structure from the norm properties. Note that in most cases this instance creates bad definitional +equalities (e.g., it does not take into account a possibly existing `uniform_space` instance on +`E`). -/ +@[to_additive "Construct a normed group from a norm, i.e., registering the distance and the metric +space structure from the norm properties. Note that in most cases this instance creates bad +definitional equalities (e.g., it does not take into account a possibly existing `uniform_space` +instance on `E`)."] +def group_norm.to_normed_comm_group [comm_group E] (f : group_norm E) : normed_comm_group E := +{ ..f.to_normed_group } + +instance : normed_add_comm_group punit := { norm := function.const _ 0, dist_eq := λ _ _, rfl, } -@[simp] lemma punit.norm_eq_zero (r : punit) : ∥r∥ = 0 := rfl +@[simp] lemma punit.norm_eq_zero (r : punit) : ‖r‖ = 0 := rfl -noncomputable instance : normed_group ℝ := -{ norm := λ x, |x|, - dist_eq := assume x y, rfl } +section seminormed_group +variables [seminormed_group E] [seminormed_group F] [seminormed_group G] {s : set E} + {a a₁ a₂ b b₁ b₂ : E} {r r₁ r₂ : ℝ} -lemma real.norm_eq_abs (r : ℝ) : ∥r∥ = |r| := rfl +@[to_additive] +lemma dist_eq_norm_div (a b : E) : dist a b = ‖a / b‖ := seminormed_group.dist_eq _ _ -section semi_normed_group -variables [semi_normed_group E] [semi_normed_group F] [semi_normed_group G] +@[to_additive] +lemma dist_eq_norm_div' (a b : E) : dist a b = ‖b / a‖ := by rw [dist_comm, dist_eq_norm_div] -lemma dist_eq_norm (g h : E) : dist g h = ∥g - h∥ := -semi_normed_group.dist_eq _ _ +alias dist_eq_norm_sub ← dist_eq_norm +alias dist_eq_norm_sub' ← dist_eq_norm' -lemma dist_eq_norm' (g h : E) : dist g h = ∥h - g∥ := -by rw [dist_comm, dist_eq_norm] +@[to_additive] instance normed_group.to_has_isometric_smul_right : has_isometric_smul Eᵐᵒᵖ E := +⟨λ a, isometry.of_dist_eq $ λ b c, by simp [dist_eq_norm_div]⟩ -@[simp] lemma dist_zero_right (g : E) : dist g 0 = ∥g∥ := -by rw [dist_eq_norm, sub_zero] +@[simp, to_additive] lemma dist_one_right (a : E) : dist a 1 = ‖a‖ := +by rw [dist_eq_norm_div, div_one] -@[simp] lemma dist_zero_left : dist (0 : E) = norm := -funext $ λ g, by rw [dist_comm, dist_zero_right] +@[simp, to_additive] lemma dist_one_left : dist (1 : E) = norm := +funext $ λ a, by rw [dist_comm, dist_one_right] -lemma tendsto_norm_cocompact_at_top [proper_space E] : - tendsto norm (cocompact E) at_top := -by simpa only [dist_zero_right] using tendsto_dist_right_cocompact_at_top (0 : E) +@[to_additive] +lemma isometry.norm_map_of_map_one {f : E → F} (hi : isometry f) (h₁ : f 1 = 1) (x : E) : + ‖f x‖ = ‖x‖ := +by rw [←dist_one_right, ←h₁, hi.dist_eq, dist_one_right] -lemma norm_sub_rev (g h : E) : ∥g - h∥ = ∥h - g∥ := -by simpa only [dist_eq_norm] using dist_comm g h +@[to_additive tendsto_norm_cocompact_at_top] +lemma tendsto_norm_cocompact_at_top' [proper_space E] : tendsto norm (cocompact E) at_top := +by simpa only [dist_one_right] using tendsto_dist_right_cocompact_at_top (1 : E) -@[simp] lemma norm_neg (g : E) : ∥-g∥ = ∥g∥ := -by simpa using norm_sub_rev 0 g +@[to_additive] lemma norm_div_rev (a b : E) : ‖a / b‖ = ‖b / a‖ := +by simpa only [dist_eq_norm_div] using dist_comm a b -@[simp] lemma dist_add_left (g h₁ h₂ : E) : dist (g + h₁) (g + h₂) = dist h₁ h₂ := -by simp [dist_eq_norm] +@[simp, to_additive norm_neg] +lemma norm_inv' (a : E) : ‖a⁻¹‖ = ‖a‖ := by simpa using norm_div_rev 1 a -@[simp] lemma dist_add_right (g₁ g₂ h : E) : dist (g₁ + h) (g₂ + h) = dist g₁ g₂ := -by simp [dist_eq_norm] +@[simp, to_additive] lemma dist_mul_self_right (a b : E) : dist b (a * b) = ‖a‖ := +by rw [←dist_one_left, ←dist_mul_right 1 a b, one_mul] -lemma dist_neg (x y : E) : dist (-x) y = dist x (-y) := -by simp_rw [dist_eq_norm, ←norm_neg (-x - y), neg_sub, sub_neg_eq_add, add_comm] +@[simp, to_additive] lemma dist_mul_self_left (a b : E) : dist (a * b) b = ‖a‖ := +by rw [dist_comm, dist_mul_self_right] -@[simp] lemma dist_neg_neg (g h : E) : dist (-g) (-h) = dist g h := by rw [dist_neg, neg_neg] +@[simp, to_additive] lemma dist_div_eq_dist_mul_left (a b c : E) : + dist (a / b) c = dist a (c * b) := +by rw [←dist_mul_right _ _ b, div_mul_cancel'] -@[simp] lemma dist_sub_left (g h₁ h₂ : E) : dist (g - h₁) (g - h₂) = dist h₁ h₂ := -by simp only [sub_eq_add_neg, dist_add_left, dist_neg_neg] +@[simp, to_additive] lemma dist_div_eq_dist_mul_right (a b c : E) : + dist a (b / c) = dist (a * c) b := +by rw [←dist_mul_right _ _ c, div_mul_cancel'] -@[simp] lemma dist_sub_right (g₁ g₂ h : E) : dist (g₁ - h) (g₂ - h) = dist g₁ g₂ := -by simpa only [sub_eq_add_neg] using dist_add_right _ _ _ +/-- In a (semi)normed group, inversion `x ↦ x⁻¹` tends to infinity at infinity. TODO: use +`bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`. -/ +@[to_additive "In a (semi)normed group, negation `x ↦ -x` tends to infinity at infinity. TODO: use +`bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`."] +lemma filter.tendsto_inv_cobounded : + tendsto (has_inv.inv : E → E) (comap norm at_top) (comap norm at_top) := +by simpa only [norm_inv', tendsto_comap_iff, (∘)] using tendsto_comap -@[simp] theorem dist_self_add_right (g h : E) : dist g (g + h) = ∥h∥ := -by rw [← dist_zero_left, ← dist_add_left g 0 h, add_zero] +/-- **Triangle inequality** for the norm. -/ +@[to_additive norm_add_le "**Triangle inequality** for the norm."] +lemma norm_mul_le' (a b : E) : ‖a * b‖ ≤ ‖a‖ + ‖b‖ := +by simpa [dist_eq_norm_div] using dist_triangle a 1 b⁻¹ -@[simp] theorem dist_self_add_left (g h : E) : dist (g + h) g = ∥h∥ := -by rw [dist_comm, dist_self_add_right] +@[to_additive] lemma norm_mul_le_of_le (h₁ : ‖a₁‖ ≤ r₁) (h₂ : ‖a₂‖ ≤ r₂) : ‖a₁ * a₂‖ ≤ r₁ + r₂ := +(norm_mul_le' a₁ a₂).trans $ add_le_add h₁ h₂ -@[simp] theorem dist_self_sub_right (g h : E) : dist g (g - h) = ∥h∥ := -by rw [sub_eq_add_neg, dist_self_add_right, norm_neg] +@[to_additive norm_add₃_le] lemma norm_mul₃_le (a b c : E) : ‖a * b * c‖ ≤ ‖a‖ + ‖b‖ + ‖c‖ := +norm_mul_le_of_le (norm_mul_le' _ _) le_rfl -@[simp] theorem dist_self_sub_left (g h : E) : dist (g - h) g = ∥h∥ := -by rw [dist_comm, dist_self_sub_right] +@[simp, to_additive norm_nonneg] lemma norm_nonneg' (a : E) : 0 ≤ ‖a‖ := +by { rw [←dist_one_right], exact dist_nonneg } -/-- In a (semi)normed group, negation `x ↦ -x` tends to infinity at infinity. TODO: use -`bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`. -/ -lemma filter.tendsto_neg_cobounded : - tendsto (has_neg.neg : E → E) (comap norm at_top) (comap norm at_top) := -by simpa only [norm_neg, tendsto_comap_iff, (∘)] using tendsto_comap +section +open tactic tactic.positivity -/-- **Triangle inequality** for the norm. -/ -lemma norm_add_le (g h : E) : ∥g + h∥ ≤ ∥g∥ + ∥h∥ := -by simpa [dist_eq_norm] using dist_triangle g 0 (-h) +/-- Extension for the `positivity` tactic: norms are nonnegative. -/ +@[positivity] +meta def _root_.tactic.positivity_norm : expr → tactic strictness +| `(‖%%a‖) := nonnegative <$> mk_app ``norm_nonneg [a] <|> nonnegative <$> mk_app ``norm_nonneg' [a] +| _ := failed -lemma norm_add_le_of_le {g₁ g₂ : E} {n₁ n₂ : ℝ} (H₁ : ∥g₁∥ ≤ n₁) (H₂ : ∥g₂∥ ≤ n₂) : - ∥g₁ + g₂∥ ≤ n₁ + n₂ := -le_trans (norm_add_le g₁ g₂) (add_le_add H₁ H₂) +end -lemma dist_add_add_le (g₁ g₂ h₁ h₂ : E) : - dist (g₁ + g₂) (h₁ + h₂) ≤ dist g₁ h₁ + dist g₂ h₂ := -by simpa only [dist_add_left, dist_add_right] using dist_triangle (g₁ + g₂) (h₁ + g₂) (h₁ + h₂) +@[simp, to_additive norm_zero] lemma norm_one' : ‖(1 : E)‖ = 0 := by rw [←dist_one_right, dist_self] -lemma dist_add_add_le_of_le {g₁ g₂ h₁ h₂ : E} {d₁ d₂ : ℝ} - (H₁ : dist g₁ h₁ ≤ d₁) (H₂ : dist g₂ h₂ ≤ d₂) : - dist (g₁ + g₂) (h₁ + h₂) ≤ d₁ + d₂ := -le_trans (dist_add_add_le g₁ g₂ h₁ h₂) (add_le_add H₁ H₂) +@[to_additive] lemma ne_one_of_norm_ne_zero : ‖a‖ ≠ 0 → a ≠ 1 := +mt $ by { rintro rfl, exact norm_one' } -lemma dist_sub_sub_le (g₁ g₂ h₁ h₂ : E) : - dist (g₁ - g₂) (h₁ - h₂) ≤ dist g₁ h₁ + dist g₂ h₂ := -by simpa only [sub_eq_add_neg, dist_neg_neg] using dist_add_add_le g₁ (-g₂) h₁ (-h₂) +@[nontriviality, to_additive norm_of_subsingleton] +lemma norm_of_subsingleton' [subsingleton E] (a : E) : ‖a‖ = 0 := +by rw [subsingleton.elim a 1, norm_one'] -lemma dist_sub_sub_le_of_le {g₁ g₂ h₁ h₂ : E} {d₁ d₂ : ℝ} - (H₁ : dist g₁ h₁ ≤ d₁) (H₂ : dist g₂ h₂ ≤ d₂) : - dist (g₁ - g₂) (h₁ - h₂) ≤ d₁ + d₂ := -le_trans (dist_sub_sub_le g₁ g₂ h₁ h₂) (add_le_add H₁ H₂) +attribute [nontriviality] norm_of_subsingleton -lemma abs_dist_sub_le_dist_add_add (g₁ g₂ h₁ h₂ : E) : - |dist g₁ h₁ - dist g₂ h₂| ≤ dist (g₁ + g₂) (h₁ + h₂) := -by simpa only [dist_add_left, dist_add_right, dist_comm h₂] - using abs_dist_sub_le (g₁ + g₂) (h₁ + h₂) (h₁ + g₂) +@[to_additive zero_lt_one_add_norm_sq] +lemma zero_lt_one_add_norm_sq' (x : E) : 0 < 1 + ‖x‖^2 := by positivity -@[simp] lemma norm_nonneg (g : E) : 0 ≤ ∥g∥ := -by { rw[←dist_zero_right], exact dist_nonneg } +@[to_additive] lemma norm_div_le (a b : E) : ‖a / b‖ ≤ ‖a‖ + ‖b‖ := +by simpa [dist_eq_norm_div] using dist_triangle a 1 b -@[simp] lemma norm_zero : ∥(0 : E)∥ = 0 := by rw [← dist_zero_right, dist_self] +@[to_additive] lemma norm_div_le_of_le {r₁ r₂ : ℝ} (H₁ : ‖a₁‖ ≤ r₁) (H₂ : ‖a₂‖ ≤ r₂) : + ‖a₁ / a₂‖ ≤ r₁ + r₂ := +(norm_div_le a₁ a₂).trans $ add_le_add H₁ H₂ -lemma ne_zero_of_norm_ne_zero {g : E} : ∥g∥ ≠ 0 → g ≠ 0 := mt $ by { rintro rfl, exact norm_zero } +@[to_additive dist_le_norm_add_norm] lemma dist_le_norm_add_norm' (a b : E) : + dist a b ≤ ‖a‖ + ‖b‖ := +by { rw dist_eq_norm_div, apply norm_div_le } -@[nontriviality] lemma norm_of_subsingleton [subsingleton E] (x : E) : ∥x∥ = 0 := -by rw [subsingleton.elim x 0, norm_zero] +@[to_additive abs_norm_sub_norm_le] lemma abs_norm_sub_norm_le' (a b : E) : |‖a‖ - ‖b‖| ≤ ‖a / b‖ := +by simpa [dist_eq_norm_div] using abs_dist_sub_le a b 1 -lemma norm_sum_le (s : finset ι) (f : ι → E) : ∥∑ i in s, f i∥ ≤ ∑ i in s, ∥f i∥ := -s.le_sum_of_subadditive norm norm_zero norm_add_le f +@[to_additive norm_sub_norm_le] lemma norm_sub_norm_le' (a b : E) : ‖a‖ - ‖b‖ ≤ ‖a / b‖ := +(le_abs_self _).trans (abs_norm_sub_norm_le' a b) -lemma norm_sum_le_of_le (s : finset ι) {f : ι → E} {n : ι → ℝ} (h : ∀ b ∈ s, ∥f b∥ ≤ n b) : - ∥∑ b in s, f b∥ ≤ ∑ b in s, n b := -le_trans (norm_sum_le s f) (finset.sum_le_sum h) +@[to_additive dist_norm_norm_le] lemma dist_norm_norm_le' (a b : E) : dist ‖a‖ ‖b‖ ≤ ‖a / b‖ := +abs_norm_sub_norm_le' a b -lemma dist_sum_sum_le_of_le (s : finset ι) {f g : ι → E} {d : ι → ℝ} - (h : ∀ b ∈ s, dist (f b) (g b) ≤ d b) : - dist (∑ b in s, f b) (∑ b in s, g b) ≤ ∑ b in s, d b := -begin - simp only [dist_eq_norm, ← finset.sum_sub_distrib] at *, - exact norm_sum_le_of_le s h -end +@[to_additive] lemma norm_le_norm_add_norm_div' (u v : E) : ‖u‖ ≤ ‖v‖ + ‖u / v‖ := +by { rw add_comm, refine (norm_mul_le' _ _).trans_eq' _, rw div_mul_cancel' } -lemma dist_sum_sum_le (s : finset ι) (f g : ι → E) : - dist (∑ b in s, f b) (∑ b in s, g b) ≤ ∑ b in s, dist (f b) (g b) := -dist_sum_sum_le_of_le s (λ _ _, le_rfl) +@[to_additive] lemma norm_le_norm_add_norm_div (u v : E) : ‖v‖ ≤ ‖u‖ + ‖u / v‖ := +by { rw norm_div_rev, exact norm_le_norm_add_norm_div' v u } -lemma norm_sub_le (g h : E) : ∥g - h∥ ≤ ∥g∥ + ∥h∥ := -by simpa [dist_eq_norm] using dist_triangle g 0 h +alias norm_le_norm_add_norm_sub' ← norm_le_insert' +alias norm_le_norm_add_norm_sub ← norm_le_insert -lemma norm_sub_le_of_le {g₁ g₂ : E} {n₁ n₂ : ℝ} (H₁ : ∥g₁∥ ≤ n₁) (H₂ : ∥g₂∥ ≤ n₂) : - ∥g₁ - g₂∥ ≤ n₁ + n₂ := -le_trans (norm_sub_le g₁ g₂) (add_le_add H₁ H₂) +@[to_additive] lemma norm_le_mul_norm_add (u v : E) : ‖u‖ ≤ ‖u * v‖ + ‖v‖ := +calc ‖u‖ = ‖u * v / v‖ : by rw mul_div_cancel'' +... ≤ ‖u * v‖ + ‖v‖ : norm_div_le _ _ -lemma dist_le_norm_add_norm (g h : E) : dist g h ≤ ∥g∥ + ∥h∥ := -by { rw dist_eq_norm, apply norm_sub_le } +@[to_additive ball_eq] lemma ball_eq' (y : E) (ε : ℝ) : ball y ε = {x | ‖x / y‖ < ε} := +set.ext $ λ a, by simp [dist_eq_norm_div] -lemma abs_norm_sub_norm_le (g h : E) : |∥g∥ - ∥h∥| ≤ ∥g - h∥ := -by simpa [dist_eq_norm] using abs_dist_sub_le g h 0 +@[to_additive] lemma ball_one_eq (r : ℝ) : ball (1 : E) r = {x | ‖x‖ < r} := +set.ext $ assume a, by simp -lemma norm_sub_norm_le (g h : E) : ∥g∥ - ∥h∥ ≤ ∥g - h∥ := -le_trans (le_abs_self _) (abs_norm_sub_norm_le g h) +@[to_additive mem_ball_iff_norm] lemma mem_ball_iff_norm'' : b ∈ ball a r ↔ ‖b / a‖ < r := +by rw [mem_ball, dist_eq_norm_div] -lemma dist_norm_norm_le (g h : E) : dist ∥g∥ ∥h∥ ≤ ∥g - h∥ := -abs_norm_sub_norm_le g h +@[to_additive mem_ball_iff_norm'] lemma mem_ball_iff_norm''' : b ∈ ball a r ↔ ‖a / b‖ < r := +by rw [mem_ball', dist_eq_norm_div] -/-- The direct path from `0` to `v` is shorter than the path with `u` inserted in between. -/ -lemma norm_le_insert (u v : E) : ∥v∥ ≤ ∥u∥ + ∥u - v∥ := -calc ∥v∥ = ∥u - (u - v)∥ : by abel -... ≤ ∥u∥ + ∥u - v∥ : norm_sub_le u _ +@[simp, to_additive] lemma mem_ball_one_iff : a ∈ ball (1 : E) r ↔ ‖a‖ < r := +by rw [mem_ball, dist_one_right] -lemma norm_le_insert' (u v : E) : ∥u∥ ≤ ∥v∥ + ∥u - v∥ := -by { rw norm_sub_rev, exact norm_le_insert v u } +@[to_additive mem_closed_ball_iff_norm] +lemma mem_closed_ball_iff_norm'' : b ∈ closed_ball a r ↔ ‖b / a‖ ≤ r := +by rw [mem_closed_ball, dist_eq_norm_div] -lemma norm_le_add_norm_add (u v : E) : - ∥u∥ ≤ ∥u + v∥ + ∥v∥ := -calc ∥u∥ = ∥u + v - v∥ : by rw add_sub_cancel -... ≤ ∥u + v∥ + ∥v∥ : norm_sub_le _ _ +@[simp, to_additive] lemma mem_closed_ball_one_iff : a ∈ closed_ball (1 : E) r ↔ ‖a‖ ≤ r := +by rw [mem_closed_ball, dist_one_right] -lemma ball_eq (y : E) (ε : ℝ) : metric.ball y ε = { x | ∥x - y∥ < ε} := -by { ext, simp [dist_eq_norm], } +@[to_additive mem_closed_ball_iff_norm'] +lemma mem_closed_ball_iff_norm''' : b ∈ closed_ball a r ↔ ‖a / b‖ ≤ r := +by rw [mem_closed_ball', dist_eq_norm_div] -lemma ball_zero_eq (ε : ℝ) : ball (0 : E) ε = {x | ∥x∥ < ε} := -set.ext $ assume a, by simp +@[to_additive norm_le_of_mem_closed_ball] +lemma norm_le_of_mem_closed_ball' (h : b ∈ closed_ball a r) : ‖b‖ ≤ ‖a‖ + r := +(norm_le_norm_add_norm_div' _ _).trans $ add_le_add_left (by rwa ←dist_eq_norm_div) _ -lemma mem_ball_iff_norm {g h : E} {r : ℝ} : - h ∈ ball g r ↔ ∥h - g∥ < r := -by rw [mem_ball, dist_eq_norm] +@[to_additive norm_le_norm_add_const_of_dist_le] +lemma norm_le_norm_add_const_of_dist_le' : dist a b ≤ r → ‖a‖ ≤ ‖b‖ + r := +norm_le_of_mem_closed_ball' -lemma add_mem_ball_iff_norm {g h : E} {r : ℝ} : - g + h ∈ ball g r ↔ ∥h∥ < r := -by rw [mem_ball_iff_norm, add_sub_cancel'] +@[to_additive norm_lt_of_mem_ball] +lemma norm_lt_of_mem_ball' (h : b ∈ ball a r) : ‖b‖ < ‖a‖ + r := +(norm_le_norm_add_norm_div' _ _).trans_lt $ add_lt_add_left (by rwa ←dist_eq_norm_div) _ -lemma mem_ball_iff_norm' {g h : E} {r : ℝ} : - h ∈ ball g r ↔ ∥g - h∥ < r := -by rw [mem_ball', dist_eq_norm] +@[to_additive] +lemma norm_div_sub_norm_div_le_norm_div (u v w : E) : ‖u / w‖ - ‖v / w‖ ≤ ‖u / v‖ := +by simpa only [div_div_div_cancel_right'] using norm_sub_norm_le' (u / w) (v / w) -@[simp] lemma mem_ball_zero_iff {ε : ℝ} {x : E} : x ∈ ball (0 : E) ε ↔ ∥x∥ < ε := -by rw [mem_ball, dist_zero_right] +@[to_additive bounded_iff_forall_norm_le] +lemma bounded_iff_forall_norm_le' : bounded s ↔ ∃ C, ∀ x ∈ s, ‖x‖ ≤ C := +by simpa only [set.subset_def, mem_closed_ball_one_iff] using bounded_iff_subset_ball (1 : E) -lemma mem_closed_ball_iff_norm {g h : E} {r : ℝ} : - h ∈ closed_ball g r ↔ ∥h - g∥ ≤ r := -by rw [mem_closed_ball, dist_eq_norm] +alias bounded_iff_forall_norm_le' ↔ metric.bounded.exists_norm_le' _ +alias bounded_iff_forall_norm_le ↔ metric.bounded.exists_norm_le _ -@[simp] lemma mem_closed_ball_zero_iff {ε : ℝ} {x : E} : x ∈ closed_ball (0 : E) ε ↔ ∥x∥ ≤ ε := -by rw [mem_closed_ball, dist_zero_right] +attribute [to_additive metric.bounded.exists_norm_le] metric.bounded.exists_norm_le' -lemma add_mem_closed_ball_iff_norm {g h : E} {r : ℝ} : - g + h ∈ closed_ball g r ↔ ∥h∥ ≤ r := -by rw [mem_closed_ball_iff_norm, add_sub_cancel'] +@[to_additive metric.bounded.exists_pos_norm_le] +lemma metric.bounded.exists_pos_norm_le' (hs : metric.bounded s) : ∃ R > 0, ∀ x ∈ s, ‖x‖ ≤ R := +let ⟨R₀, hR₀⟩ := hs.exists_norm_le' in + ⟨max R₀ 1, by positivity, λ x hx, (hR₀ x hx).trans $ le_max_left _ _⟩ -lemma mem_closed_ball_iff_norm' {g h : E} {r : ℝ} : - h ∈ closed_ball g r ↔ ∥g - h∥ ≤ r := -by rw [mem_closed_ball', dist_eq_norm] +@[simp, to_additive mem_sphere_iff_norm] +lemma mem_sphere_iff_norm' : b ∈ sphere a r ↔ ‖b / a‖ = r := by simp [dist_eq_norm_div] -lemma norm_le_of_mem_closed_ball {g h : E} {r : ℝ} (H : h ∈ closed_ball g r) : - ∥h∥ ≤ ∥g∥ + r := -calc - ∥h∥ = ∥g + (h - g)∥ : by rw [add_sub_cancel'_right] - ... ≤ ∥g∥ + ∥h - g∥ : norm_add_le _ _ - ... ≤ ∥g∥ + r : by { apply add_le_add_left, rw ← dist_eq_norm, exact H } +@[simp, to_additive] lemma mem_sphere_one_iff_norm : a ∈ sphere (1 : E) r ↔ ‖a‖ = r := +by simp [dist_eq_norm_div] -lemma norm_le_norm_add_const_of_dist_le {a b : E} {c : ℝ} (h : dist a b ≤ c) : - ∥a∥ ≤ ∥b∥ + c := -norm_le_of_mem_closed_ball h +@[simp, to_additive norm_eq_of_mem_sphere] +lemma norm_eq_of_mem_sphere' (x : sphere (1:E) r) : ‖(x : E)‖ = r := mem_sphere_one_iff_norm.mp x.2 -lemma norm_lt_of_mem_ball {g h : E} {r : ℝ} (H : h ∈ ball g r) : - ∥h∥ < ∥g∥ + r := -calc - ∥h∥ = ∥g + (h - g)∥ : by rw [add_sub_cancel'_right] - ... ≤ ∥g∥ + ∥h - g∥ : norm_add_le _ _ - ... < ∥g∥ + r : by { apply add_lt_add_left, rw ← dist_eq_norm, exact H } +@[to_additive] lemma ne_one_of_mem_sphere (hr : r ≠ 0) (x : sphere (1 : E) r) : (x : E) ≠ 1 := +ne_one_of_norm_ne_zero $ by rwa norm_eq_of_mem_sphere' x -lemma norm_lt_norm_add_const_of_dist_lt {a b : E} {c : ℝ} (h : dist a b < c) : - ∥a∥ < ∥b∥ + c := -norm_lt_of_mem_ball h +@[to_additive ne_zero_of_mem_unit_sphere] +lemma ne_one_of_mem_unit_sphere (x : sphere (1 : E) 1) : (x:E) ≠ 1 := +ne_one_of_mem_sphere one_ne_zero _ -lemma bounded_iff_forall_norm_le {s : set E} : bounded s ↔ ∃ C, ∀ x ∈ s, ∥x∥ ≤ C := -by simpa only [set.subset_def, mem_closed_ball_iff_norm, sub_zero] - using bounded_iff_subset_ball (0 : E) +variables (E) -@[simp] lemma preimage_add_ball (x y : E) (r : ℝ) : ((+) y) ⁻¹' (ball x r) = ball (x - y) r := -begin - ext z, - simp only [dist_eq_norm, set.mem_preimage, mem_ball], - abel -end +/-- The norm of a seminormed group as a group seminorm. -/ +@[to_additive "The norm of a seminormed group as an additive group seminorm."] +def norm_group_seminorm : group_seminorm E := ⟨norm, norm_one', norm_mul_le', norm_inv'⟩ -@[simp] lemma preimage_add_closed_ball (x y : E) (r : ℝ) : - ((+) y) ⁻¹' (closed_ball x r) = closed_ball (x - y) r := -begin - ext z, - simp only [dist_eq_norm, set.mem_preimage, mem_closed_ball], - abel -end +@[simp, to_additive] lemma coe_norm_group_seminorm : ⇑(norm_group_seminorm E) = norm := rfl + +variables {E} + +@[to_additive] lemma normed_comm_group.tendsto_nhds_one {f : α → E} {l : filter α} : + tendsto f l (𝓝 1) ↔ ∀ ε > 0, ∀ᶠ x in l, ‖ f x ‖ < ε := +metric.tendsto_nhds.trans $ by simp only [dist_one_right] -@[simp] lemma mem_sphere_iff_norm (v w : E) (r : ℝ) : w ∈ sphere v r ↔ ∥w - v∥ = r := -by simp [dist_eq_norm] +@[to_additive] lemma normed_comm_group.tendsto_nhds_nhds {f : E → F} {x : E} {y : F} : + tendsto f (𝓝 x) (𝓝 y) ↔ ∀ ε > 0, ∃ δ > 0, ∀ x', ‖x' / x‖ < δ → ‖f x' / y‖ < ε := +by simp_rw [metric.tendsto_nhds_nhds, dist_eq_norm_div] -@[simp] lemma mem_sphere_zero_iff_norm {w : E} {r : ℝ} : w ∈ sphere (0:E) r ↔ ∥w∥ = r := -by simp [dist_eq_norm] +@[to_additive] lemma normed_comm_group.cauchy_seq_iff [nonempty α] [semilattice_sup α] {u : α → E} : + cauchy_seq u ↔ ∀ ε > 0, ∃ N, ∀ m, N ≤ m → ∀ n, N ≤ n → ‖u m / u n‖ < ε := +by simp [metric.cauchy_seq_iff, dist_eq_norm_div] + +@[to_additive] lemma normed_comm_group.nhds_basis_norm_lt (x : E) : + (𝓝 x).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {y | ‖y / x‖ < ε}) := +by { simp_rw ← ball_eq', exact metric.nhds_basis_ball } + +@[to_additive] lemma normed_comm_group.nhds_one_basis_norm_lt : + (𝓝 (1 : E)).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {y | ‖y‖ < ε}) := +by { convert normed_comm_group.nhds_basis_norm_lt (1 : E), simp } + +@[to_additive] lemma normed_comm_group.uniformity_basis_dist : + (𝓤 E).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {p : E × E | ‖p.fst / p.snd‖ < ε}) := +by { convert metric.uniformity_basis_dist, simp [dist_eq_norm_div] } + +open finset + +/-- A homomorphism `f` of seminormed groups is Lipschitz, if there exists a constant `C` such that +for all `x`, one has `‖f x‖ ≤ C * ‖x‖`. The analogous condition for a linear map of +(semi)normed spaces is in `normed_space.operator_norm`. -/ +@[to_additive "A homomorphism `f` of seminormed groups is Lipschitz, if there exists a constant `C` +such that for all `x`, one has `‖f x‖ ≤ C * ‖x‖`. The analogous condition for a linear map of +(semi)normed spaces is in `normed_space.operator_norm`."] +lemma monoid_hom_class.lipschitz_of_bound [monoid_hom_class 𝓕 E F] (f : 𝓕) (C : ℝ) + (h : ∀ x, ‖f x‖ ≤ C * ‖x‖) : lipschitz_with (real.to_nnreal C) f := +lipschitz_with.of_dist_le' $ λ x y, by simpa only [dist_eq_norm_div, map_div] using h (x / y) -@[simp] lemma norm_eq_of_mem_sphere {r : ℝ} (x : sphere (0:E) r) : ∥(x:E)∥ = r := -mem_sphere_zero_iff_norm.mp x.2 +@[to_additive] lemma lipschitz_on_with_iff_norm_div_le {f : E → F} {C : ℝ≥0} : + lipschitz_on_with C f s ↔ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → ‖f x / f y‖ ≤ C * ‖x / y‖ := +by simp only [lipschitz_on_with_iff_dist_le_mul, dist_eq_norm_div] -lemma preimage_add_sphere (x y : E) (r : ℝ) : - ((+) y) ⁻¹' (sphere x r) = sphere (x - y) r := +alias lipschitz_on_with_iff_norm_div_le ↔ lipschitz_on_with.norm_div_le _ + +attribute [to_additive] lipschitz_on_with.norm_div_le + +@[to_additive] lemma lipschitz_on_with.norm_div_le_of_le {f : E → F} {C : ℝ≥0} + (h : lipschitz_on_with C f s) (ha : a ∈ s) (hb : b ∈ s) (hr : ‖a / b‖ ≤ r) : + ‖f a / f b‖ ≤ C * r := +(h.norm_div_le ha hb).trans $ mul_le_mul_of_nonneg_left hr C.2 + +@[to_additive] lemma lipschitz_with_iff_norm_div_le {f : E → F} {C : ℝ≥0} : + lipschitz_with C f ↔ ∀ x y, ‖f x / f y‖ ≤ C * ‖x / y‖ := +by simp only [lipschitz_with_iff_dist_le_mul, dist_eq_norm_div] + +alias lipschitz_with_iff_norm_div_le ↔ lipschitz_with.norm_div_le _ + +attribute [to_additive] lipschitz_with.norm_div_le + +@[to_additive] lemma lipschitz_with.norm_div_le_of_le {f : E → F} {C : ℝ≥0} (h : lipschitz_with C f) + (hr : ‖a / b‖ ≤ r) : ‖f a / f b‖ ≤ C * r := +(h.norm_div_le _ _).trans $ mul_le_mul_of_nonneg_left hr C.2 + +/-- A homomorphism `f` of seminormed groups is continuous, if there exists a constant `C` such that +for all `x`, one has `‖f x‖ ≤ C * ‖x‖`. -/ +@[to_additive "A homomorphism `f` of seminormed groups is continuous, if there exists a constant `C` +such that for all `x`, one has `‖f x‖ ≤ C * ‖x‖`"] +lemma monoid_hom_class.continuous_of_bound [monoid_hom_class 𝓕 E F] (f : 𝓕) (C : ℝ) + (h : ∀ x, ‖f x‖ ≤ C * ‖x‖) : continuous f := +(monoid_hom_class.lipschitz_of_bound f C h).continuous + +@[to_additive] lemma monoid_hom_class.uniform_continuous_of_bound [monoid_hom_class 𝓕 E F] + (f : 𝓕) (C : ℝ) (h : ∀x, ‖f x‖ ≤ C * ‖x‖) : uniform_continuous f := +(monoid_hom_class.lipschitz_of_bound f C h).uniform_continuous + +@[to_additive is_compact.exists_bound_of_continuous_on] +lemma is_compact.exists_bound_of_continuous_on' [topological_space α] {s : set α} + (hs : is_compact s) {f : α → E} (hf : continuous_on f s) : + ∃ C, ∀ x ∈ s, ‖f x‖ ≤ C := +(bounded_iff_forall_norm_le'.1 (hs.image_of_continuous_on hf).bounded).imp $ λ C hC x hx, + hC _ $ set.mem_image_of_mem _ hx + +@[to_additive] lemma monoid_hom_class.isometry_iff_norm [monoid_hom_class 𝓕 E F] (f : 𝓕) : + isometry f ↔ ∀ x, ‖f x‖ = ‖x‖ := begin - ext z, - simp only [set.mem_preimage, mem_sphere_iff_norm], - abel + simp only [isometry_iff_dist_eq, dist_eq_norm_div, ←map_div], + refine ⟨λ h x, _, λ h x y, h _⟩, + simpa using h x 1, end -lemma ne_zero_of_mem_sphere {r : ℝ} (hr : r ≠ 0) (x : sphere (0 : E) r) : (x : E) ≠ 0 := -ne_zero_of_norm_ne_zero $ by rwa norm_eq_of_mem_sphere x +alias monoid_hom_class.isometry_iff_norm ↔ _ monoid_hom_class.isometry_of_norm -lemma ne_zero_of_mem_unit_sphere (x : sphere (0:E) 1) : (x:E) ≠ 0 := -ne_zero_of_mem_sphere one_ne_zero _ +attribute [to_additive] monoid_hom_class.isometry_of_norm -/-- We equip the sphere, in a seminormed group, with a formal operation of negation, namely the -antipodal map. -/ -instance {r : ℝ} : has_neg (sphere (0:E) r) := -{ neg := λ w, ⟨-↑w, by simp⟩ } +section nnnorm + +@[priority 100, to_additive] -- See note [lower instance priority] +instance seminormed_group.to_has_nnnorm : has_nnnorm E := ⟨λ a, ⟨‖a‖, norm_nonneg' a⟩⟩ + +@[simp, norm_cast, to_additive coe_nnnorm] lemma coe_nnnorm' (a : E) : (‖a‖₊ : ℝ) = ‖a‖ := rfl + +@[simp, to_additive coe_comp_nnnorm] +lemma coe_comp_nnnorm' : (coe : ℝ≥0 → ℝ) ∘ (nnnorm : E → ℝ≥0) = norm := rfl -@[simp] lemma coe_neg_sphere {r : ℝ} (v : sphere (0:E) r) : - (((-v) : sphere _ _) : E) = - (v:E) := -rfl +@[to_additive norm_to_nnreal] +lemma norm_to_nnreal' : ‖a‖.to_nnreal = ‖a‖₊ := @real.to_nnreal_coe ‖a‖₊ -namespace isometric --- TODO This material is superseded by similar constructions such as --- `affine_isometry_equiv.const_vadd`; deduplicate +@[to_additive] +lemma nndist_eq_nnnorm_div (a b : E) : nndist a b = ‖a / b‖₊ := nnreal.eq $ dist_eq_norm_div _ _ -/-- Addition `y ↦ y + x` as an `isometry`. -/ -protected def add_right (x : E) : E ≃ᵢ E := -{ isometry_to_fun := isometry_emetric_iff_metric.2 $ λ y z, dist_add_right _ _ _, - .. equiv.add_right x } +alias nndist_eq_nnnorm_sub ← nndist_eq_nnnorm -@[simp] lemma add_right_to_equiv (x : E) : - (isometric.add_right x).to_equiv = equiv.add_right x := rfl +@[simp, to_additive nnnorm_zero] lemma nnnorm_one' : ‖(1 : E)‖₊ = 0 := nnreal.eq norm_one' -@[simp] lemma coe_add_right (x : E) : (isometric.add_right x : E → E) = λ y, y + x := rfl +@[to_additive] lemma ne_one_of_nnnorm_ne_zero {a : E} : ‖a‖₊ ≠ 0 → a ≠ 1 := +mt $ by { rintro rfl, exact nnnorm_one' } -lemma add_right_apply (x y : E) : (isometric.add_right x : E → E) y = y + x := rfl +@[to_additive nnnorm_add_le] +lemma nnnorm_mul_le' (a b : E) : ‖a * b‖₊ ≤ ‖a‖₊ + ‖b‖₊ := nnreal.coe_le_coe.1 $ norm_mul_le' a b -@[simp] lemma add_right_symm (x : E) : - (isometric.add_right x).symm = isometric.add_right (-x) := -ext $ λ y, rfl +@[simp, to_additive nnnorm_neg] lemma nnnorm_inv' (a : E) : ‖a⁻¹‖₊ = ‖a‖₊ := nnreal.eq $ norm_inv' a -/-- Addition `y ↦ x + y` as an `isometry`. -/ -protected def add_left (x : E) : E ≃ᵢ E := -{ isometry_to_fun := isometry_emetric_iff_metric.2 $ λ y z, dist_add_left _ _ _, - to_equiv := equiv.add_left x } +@[to_additive] lemma nnnorm_div_le (a b : E) : ‖a / b‖₊ ≤ ‖a‖₊ + ‖b‖₊ := +nnreal.coe_le_coe.1 $ norm_div_le _ _ -@[simp] lemma add_left_to_equiv (x : E) : - (isometric.add_left x).to_equiv = equiv.add_left x := rfl +@[to_additive nndist_nnnorm_nnnorm_le] +lemma nndist_nnnorm_nnnorm_le' (a b : E) : nndist ‖a‖₊ ‖b‖₊ ≤ ‖a / b‖₊ := +nnreal.coe_le_coe.1 $ dist_norm_norm_le' a b -@[simp] lemma coe_add_left (x : E) : ⇑(isometric.add_left x) = (+) x := rfl +@[to_additive] lemma nnnorm_le_nnnorm_add_nnnorm_div (a b : E) : ‖b‖₊ ≤ ‖a‖₊ + ‖a / b‖₊ := +norm_le_norm_add_norm_div _ _ -@[simp] lemma add_left_symm (x : E) : - (isometric.add_left x).symm = isometric.add_left (-x) := -ext $ λ y, rfl +@[to_additive] lemma nnnorm_le_nnnorm_add_nnnorm_div' (a b : E) : ‖a‖₊ ≤ ‖b‖₊ + ‖a / b‖₊ := +norm_le_norm_add_norm_div' _ _ + +alias nnnorm_le_nnnorm_add_nnnorm_sub' ← nnnorm_le_insert' +alias nnnorm_le_nnnorm_add_nnnorm_sub ← nnnorm_le_insert + +@[to_additive] +lemma nnnorm_le_mul_nnnorm_add (a b : E) : ‖a‖₊ ≤ ‖a * b‖₊ + ‖b‖₊ := norm_le_mul_norm_add _ _ + +@[to_additive of_real_norm_eq_coe_nnnorm] +lemma of_real_norm_eq_coe_nnnorm' (a : E) : ennreal.of_real ‖a‖ = ‖a‖₊ := +ennreal.of_real_eq_coe_nnreal _ -variable (E) +@[to_additive] lemma edist_eq_coe_nnnorm_div (a b : E) : edist a b = ‖a / b‖₊ := +by rw [edist_dist, dist_eq_norm_div, of_real_norm_eq_coe_nnnorm'] -/-- Negation `x ↦ -x` as an `isometry`. -/ -protected def neg : E ≃ᵢ E := -{ isometry_to_fun := isometry_emetric_iff_metric.2 $ λ x y, dist_neg_neg _ _, - to_equiv := equiv.neg E } +@[to_additive edist_eq_coe_nnnorm] lemma edist_eq_coe_nnnorm' (x : E) : edist x 1 = (‖x‖₊ : ℝ≥0∞) := +by rw [edist_eq_coe_nnnorm_div, div_one] -variable {E} +@[to_additive] +lemma mem_emetric_ball_one_iff {r : ℝ≥0∞} : a ∈ emetric.ball (1 : E) r ↔ ↑‖a‖₊ < r := +by rw [emetric.mem_ball, edist_eq_coe_nnnorm'] -@[simp] lemma neg_symm : (isometric.neg E).symm = isometric.neg E := rfl +@[to_additive] lemma monoid_hom_class.lipschitz_of_bound_nnnorm [monoid_hom_class 𝓕 E F] (f : 𝓕) + (C : ℝ≥0) (h : ∀ x, ‖f x‖₊ ≤ C * ‖x‖₊) : lipschitz_with C f := +@real.to_nnreal_coe C ▸ monoid_hom_class.lipschitz_of_bound f C h -@[simp] lemma neg_to_equiv : (isometric.neg E).to_equiv = equiv.neg E := rfl +@[to_additive] lemma monoid_hom_class.antilipschitz_of_bound [monoid_hom_class 𝓕 E F] (f : 𝓕) + {K : ℝ≥0} (h : ∀ x, ‖x‖ ≤ K * ‖f x‖) : + antilipschitz_with K f := +antilipschitz_with.of_le_mul_dist $ λ x y, by simpa only [dist_eq_norm_div, map_div] using h (x / y) -@[simp] lemma coe_neg : ⇑(isometric.neg E) = has_neg.neg := rfl +@[to_additive lipschitz_with.norm_le_mul] +lemma lipschitz_with.norm_le_mul' {f : E → F} + {K : ℝ≥0} (h : lipschitz_with K f) (hf : f 1 = 1) (x) : ‖f x‖ ≤ K * ‖x‖ := +by simpa only [dist_one_right, hf] using h.dist_le_mul x 1 -end isometric +@[to_additive lipschitz_with.nnorm_le_mul] +lemma lipschitz_with.nnorm_le_mul' {f : E → F} + {K : ℝ≥0} (h : lipschitz_with K f) (hf : f 1 = 1) (x) : ‖f x‖₊ ≤ K * ‖x‖₊ := +h.norm_le_mul' hf x -theorem normed_group.tendsto_nhds_zero {f : α → E} {l : filter α} : - tendsto f l (𝓝 0) ↔ ∀ ε > 0, ∀ᶠ x in l, ∥ f x ∥ < ε := -metric.tendsto_nhds.trans $ by simp only [dist_zero_right] +@[to_additive antilipschitz_with.le_mul_norm] +lemma antilipschitz_with.le_mul_norm' {f : E → F} + {K : ℝ≥0} (h : antilipschitz_with K f) (hf : f 1 = 1) (x) : ‖x‖ ≤ K * ‖f x‖ := +by simpa only [dist_one_right, hf] using h.le_mul_dist x 1 -lemma normed_group.tendsto_nhds_nhds {f : E → F} {x : E} {y : F} : - tendsto f (𝓝 x) (𝓝 y) ↔ ∀ ε > 0, ∃ δ > 0, ∀ x', ∥x' - x∥ < δ → ∥f x' - y∥ < ε := -by simp_rw [metric.tendsto_nhds_nhds, dist_eq_norm] +@[to_additive antilipschitz_with.le_mul_nnnorm] +lemma antilipschitz_with.le_mul_nnnorm' {f : E → F} + {K : ℝ≥0} (h : antilipschitz_with K f) (hf : f 1 = 1) (x) : ‖x‖₊ ≤ K * ‖f x‖₊ := +h.le_mul_norm' hf x -lemma normed_group.cauchy_seq_iff [nonempty α] [semilattice_sup α] {u : α → E} : - cauchy_seq u ↔ ∀ ε > 0, ∃ N, ∀ m, N ≤ m → ∀ n, N ≤ n → ∥u m - u n∥ < ε := -by simp [metric.cauchy_seq_iff, dist_eq_norm] +@[to_additive] lemma one_hom_class.bound_of_antilipschitz [one_hom_class 𝓕 E F] (f : 𝓕) + {K : ℝ≥0} (h : antilipschitz_with K f) (x) : ‖x‖ ≤ K * ‖f x‖ := +h.le_mul_nnnorm' (map_one f) x -lemma normed_group.nhds_basis_norm_lt (x : E) : - (𝓝 x).has_basis (λ (ε : ℝ), 0 < ε) (λ (ε : ℝ), { y | ∥y - x∥ < ε }) := +end nnnorm + +@[to_additive] lemma tendsto_iff_norm_tendsto_one {f : α → E} {a : filter α} {b : E} : + tendsto f a (𝓝 b) ↔ tendsto (λ e, ‖f e / b‖) a (𝓝 0) := +by { convert tendsto_iff_dist_tendsto_zero, simp [dist_eq_norm_div] } + +@[to_additive] lemma tendsto_one_iff_norm_tendsto_one {f : α → E} {a : filter α} : + tendsto f a (𝓝 1) ↔ tendsto (λ e, ‖f e‖) a (𝓝 0) := +by { rw tendsto_iff_norm_tendsto_one, simp only [div_one] } + +@[to_additive] lemma comap_norm_nhds_one : comap norm (𝓝 0) = 𝓝 (1 : E) := +by simpa only [dist_one_right] using nhds_comap_dist (1 : E) + +/-- Special case of the sandwich theorem: if the norm of `f` is eventually bounded by a real +function `a` which tends to `0`, then `f` tends to `1`. In this pair of lemmas (`squeeze_one_norm'` +and `squeeze_one_norm`), following a convention of similar lemmas in `topology.metric_space.basic` +and `topology.algebra.order`, the `'` version is phrased using "eventually" and the non-`'` version +is phrased absolutely. -/ +@[to_additive "Special case of the sandwich theorem: if the norm of `f` is eventually bounded by a +real function `a` which tends to `0`, then `f` tends to `1`. In this pair of lemmas +(`squeeze_zero_norm'` and `squeeze_zero_norm`), following a convention of similar lemmas in +`topology.metric_space.basic` and `topology.algebra.order`, the `'` version is phrased using +\"eventually\" and the non-`'` version is phrased absolutely."] +lemma squeeze_one_norm' {f : α → E} {a : α → ℝ} {t₀ : filter α} (h : ∀ᶠ n in t₀, ‖f n‖ ≤ a n) + (h' : tendsto a t₀ (𝓝 0)) : tendsto f t₀ (𝓝 1) := +tendsto_one_iff_norm_tendsto_one.2 $ squeeze_zero' (eventually_of_forall $ λ n, norm_nonneg' _) h h' + +/-- Special case of the sandwich theorem: if the norm of `f` is bounded by a real function `a` which +tends to `0`, then `f` tends to `1`. -/ +@[to_additive "Special case of the sandwich theorem: if the norm of `f` is bounded by a real +function `a` which tends to `0`, then `f` tends to `0`."] +lemma squeeze_one_norm {f : α → E} {a : α → ℝ} {t₀ : filter α} (h : ∀ n, ‖f n‖ ≤ a n) : + tendsto a t₀ (𝓝 0) → tendsto f t₀ (𝓝 1) := +squeeze_one_norm' $ eventually_of_forall h + +@[to_additive] lemma tendsto_norm_div_self (x : E) : tendsto (λ a, ‖a / x‖) (𝓝 x) (𝓝 0) := +by simpa [dist_eq_norm_div] using + tendsto_id.dist (tendsto_const_nhds : tendsto (λ a, (x:E)) (𝓝 x) _) + +@[to_additive tendsto_norm]lemma tendsto_norm' {x : E} : tendsto (λ a, ‖a‖) (𝓝 x) (𝓝 ‖x‖) := +by simpa using tendsto_id.dist (tendsto_const_nhds : tendsto (λ a, (1:E)) _ _) + +@[to_additive] lemma tendsto_norm_one : tendsto (λ a : E, ‖a‖) (𝓝 1) (𝓝 0) := +by simpa using tendsto_norm_div_self (1:E) + +@[continuity, to_additive continuous_norm] lemma continuous_norm' : continuous (λ a : E, ‖a‖) := +by simpa using continuous_id.dist (continuous_const : continuous (λ a, (1:E))) + +@[continuity, to_additive continuous_nnnorm] +lemma continuous_nnnorm' : continuous (λ a : E, ‖a‖₊) := continuous_norm'.subtype_mk _ + +@[to_additive lipschitz_with_one_norm] lemma lipschitz_with_one_norm' : + lipschitz_with 1 (norm : E → ℝ) := +by simpa only [dist_one_left] using lipschitz_with.dist_right (1 : E) + +@[to_additive lipschitz_with_one_nnnorm] lemma lipschitz_with_one_nnnorm' : + lipschitz_with 1 (has_nnnorm.nnnorm : E → ℝ≥0) := +lipschitz_with_one_norm' + +@[to_additive uniform_continuous_norm] +lemma uniform_continuous_norm' : uniform_continuous (norm : E → ℝ) := +lipschitz_with_one_norm'.uniform_continuous + +@[to_additive uniform_continuous_nnnorm] +lemma uniform_continuous_nnnorm' : uniform_continuous (λ (a : E), ‖a‖₊) := +uniform_continuous_norm'.subtype_mk _ + +@[to_additive] lemma mem_closure_one_iff_norm {x : E} : x ∈ closure ({1} : set E) ↔ ‖x‖ = 0 := +by rw [←closed_ball_zero', mem_closed_ball_one_iff, (norm_nonneg' x).le_iff_eq] + +@[to_additive] lemma closure_one_eq : closure ({1} : set E) = {x | ‖x‖ = 0} := +set.ext (λ x, mem_closure_one_iff_norm) + +/-- A helper lemma used to prove that the (scalar or usual) product of a function that tends to one +and a bounded function tends to one. This lemma is formulated for any binary operation +`op : E → F → G` with an estimate `‖op x y‖ ≤ A * ‖x‖ * ‖y‖` for some constant A instead of +multiplication so that it can be applied to `(*)`, `flip (*)`, `(•)`, and `flip (•)`. -/ +@[to_additive "A helper lemma used to prove that the (scalar or usual) product of a function that +tends to zero and a bounded function tends to zero. This lemma is formulated for any binary +operation `op : E → F → G` with an estimate `‖op x y‖ ≤ A * ‖x‖ * ‖y‖` for some constant A instead +of multiplication so that it can be applied to `(*)`, `flip (*)`, `(•)`, and `flip (•)`."] +lemma filter.tendsto.op_one_is_bounded_under_le' {f : α → E} {g : α → F} {l : filter α} + (hf : tendsto f l (𝓝 1)) (hg : is_bounded_under (≤) l (norm ∘ g)) (op : E → F → G) + (h_op : ∃ A, ∀ x y, ‖op x y‖ ≤ A * ‖x‖ * ‖y‖) : + tendsto (λ x, op (f x) (g x)) l (𝓝 1) := begin - simp_rw ← ball_eq, - exact metric.nhds_basis_ball, + cases h_op with A h_op, + rcases hg with ⟨C, hC⟩, rw eventually_map at hC, + rw normed_comm_group.tendsto_nhds_one at hf ⊢, + intros ε ε₀, + rcases exists_pos_mul_lt ε₀ (A * C) with ⟨δ, δ₀, hδ⟩, + filter_upwards [hf δ δ₀, hC] with i hf hg, + refine (h_op _ _).trans_lt _, + cases le_total A 0 with hA hA, + { exact (mul_nonpos_of_nonpos_of_nonneg (mul_nonpos_of_nonpos_of_nonneg hA $ norm_nonneg' _) $ + norm_nonneg' _).trans_lt ε₀ }, + calc A * ‖f i‖ * ‖g i‖ ≤ A * δ * C : + mul_le_mul (mul_le_mul_of_nonneg_left hf.le hA) hg (norm_nonneg' _) (mul_nonneg hA δ₀.le) + ... = A * C * δ : mul_right_comm _ _ _ + ... < ε : hδ, end -lemma normed_group.nhds_zero_basis_norm_lt : - (𝓝 (0 : E)).has_basis (λ (ε : ℝ), 0 < ε) (λ (ε : ℝ), { y | ∥y∥ < ε }) := +/-- A helper lemma used to prove that the (scalar or usual) product of a function that tends to one +and a bounded function tends to one. This lemma is formulated for any binary operation +`op : E → F → G` with an estimate `‖op x y‖ ≤ ‖x‖ * ‖y‖` instead of multiplication so that it +can be applied to `(*)`, `flip (*)`, `(•)`, and `flip (•)`. -/ +@[to_additive "A helper lemma used to prove that the (scalar or usual) product of a function that +tends to zero and a bounded function tends to zero. This lemma is formulated for any binary +operation `op : E → F → G` with an estimate `‖op x y‖ ≤ ‖x‖ * ‖y‖` instead of multiplication so that +it can be applied to `(*)`, `flip (*)`, `(•)`, and `flip (•)`."] +lemma filter.tendsto.op_one_is_bounded_under_le {f : α → E} {g : α → F} {l : filter α} + (hf : tendsto f l (𝓝 1)) (hg : is_bounded_under (≤) l (norm ∘ g)) (op : E → F → G) + (h_op : ∀ x y, ‖op x y‖ ≤ ‖x‖ * ‖y‖) : + tendsto (λ x, op (f x) (g x)) l (𝓝 1) := +hf.op_one_is_bounded_under_le' hg op ⟨1, λ x y, (one_mul (‖x‖)).symm ▸ h_op x y⟩ + +section +variables {l : filter α} {f : α → E} + +@[to_additive filter.tendsto.norm] lemma filter.tendsto.norm' (h : tendsto f l (𝓝 a)) : + tendsto (λ x, ‖f x‖) l (𝓝 ‖a‖) := +tendsto_norm'.comp h + +@[to_additive filter.tendsto.nnnorm] lemma filter.tendsto.nnnorm' (h : tendsto f l (𝓝 a)) : + tendsto (λ x, ‖f x‖₊) l (𝓝 (‖a‖₊)) := +tendsto.comp continuous_nnnorm'.continuous_at h + +end + +section +variables [topological_space α] {f : α → E} + +@[to_additive continuous.norm] lemma continuous.norm' : continuous f → continuous (λ x, ‖f x‖) := +continuous_norm'.comp + +@[to_additive continuous.nnnorm] +lemma continuous.nnnorm' : continuous f → continuous (λ x, ‖f x‖₊) := continuous_nnnorm'.comp + +@[to_additive continuous_at.norm] +lemma continuous_at.norm' {a : α} (h : continuous_at f a) : continuous_at (λ x, ‖f x‖) a := h.norm' + +@[to_additive continuous_at.nnnorm] +lemma continuous_at.nnnorm' {a : α} (h : continuous_at f a) : continuous_at (λ x, ‖f x‖₊) a := +h.nnnorm' + +@[to_additive continuous_within_at.norm] +lemma continuous_within_at.norm' {s : set α} {a : α} (h : continuous_within_at f s a) : + continuous_within_at (λ x, ‖f x‖) s a := +h.norm' + +@[to_additive continuous_within_at.nnnorm] +lemma continuous_within_at.nnnorm' {s : set α} {a : α} (h : continuous_within_at f s a) : + continuous_within_at (λ x, ‖f x‖₊) s a := +h.nnnorm' + +@[to_additive continuous_on.norm] +lemma continuous_on.norm' {s : set α} (h : continuous_on f s) : continuous_on (λ x, ‖f x‖) s := +λ x hx, (h x hx).norm' + +@[to_additive continuous_on.nnnorm] +lemma continuous_on.nnnorm' {s : set α} (h : continuous_on f s) : continuous_on (λ x, ‖f x‖₊) s := +λ x hx, (h x hx).nnnorm' + +end + +/-- If `‖y‖ → ∞`, then we can assume `y ≠ x` for any fixed `x`. -/ +@[to_additive eventually_ne_of_tendsto_norm_at_top "If `‖y‖→∞`, then we can assume `y≠x` for any +fixed `x`"] +lemma eventually_ne_of_tendsto_norm_at_top' {l : filter α} {f : α → E} + (h : tendsto (λ y, ‖f y‖) l at_top) (x : E) : + ∀ᶠ y in l, f y ≠ x := +(h.eventually_ne_at_top _).mono $ λ x, ne_of_apply_ne norm + +@[to_additive] lemma seminormed_comm_group.mem_closure_iff : + a ∈ closure s ↔ ∀ ε, 0 < ε → ∃ b ∈ s, ‖a / b‖ < ε := +by simp [metric.mem_closure_iff, dist_eq_norm_div] + +@[to_additive norm_le_zero_iff'] lemma norm_le_zero_iff''' [t0_space E] {a : E} : ‖a‖ ≤ 0 ↔ a = 1 := +begin + letI : normed_group E := + { to_metric_space := metric_space.of_t0_pseudo_metric_space E, ..‹seminormed_group E› }, + rw [←dist_one_right, dist_le_zero], +end + +@[to_additive norm_eq_zero'] lemma norm_eq_zero''' [t0_space E] {a : E} : ‖a‖ = 0 ↔ a = 1 := +(norm_nonneg' a).le_iff_eq.symm.trans norm_le_zero_iff''' + +@[to_additive norm_pos_iff'] lemma norm_pos_iff''' [t0_space E] {a : E} : 0 < ‖a‖ ↔ a ≠ 1 := +by rw [← not_le, norm_le_zero_iff'''] + +@[to_additive] +lemma seminormed_group.tendsto_uniformly_on_one {f : ι → κ → G} {s : set κ} {l : filter ι} : + tendsto_uniformly_on f 1 l s ↔ ∀ ε > 0, ∀ᶠ i in l, ∀ x ∈ s, ‖f i x‖ < ε := +by simp_rw [tendsto_uniformly_on_iff, pi.one_apply, dist_one_left] + +@[to_additive] +lemma seminormed_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_one + {f : ι → κ → G} {l : filter ι} {l' : filter κ} : uniform_cauchy_seq_on_filter f l l' ↔ + tendsto_uniformly_on_filter (λ n : ι × ι, λ z, f n.fst z / f n.snd z) 1 (l ×ᶠ l) l' := begin - convert normed_group.nhds_basis_norm_lt (0 : E), - simp, + refine ⟨λ hf u hu, _, λ hf u hu, _⟩, + { obtain ⟨ε, hε, H⟩ := uniformity_basis_dist.mem_uniformity_iff.mp hu, + refine (hf {p : G × G | dist p.fst p.snd < ε} $ dist_mem_uniformity hε).mono (λ x hx, + H 1 (f x.fst.fst x.snd / f x.fst.snd x.snd) _), + simpa [dist_eq_norm_div, norm_div_rev] using hx }, + { obtain ⟨ε, hε, H⟩ := uniformity_basis_dist.mem_uniformity_iff.mp hu, + refine (hf {p : G × G | dist p.fst p.snd < ε} $ dist_mem_uniformity hε).mono (λ x hx, + H (f x.fst.fst x.snd) (f x.fst.snd x.snd) _), + simpa [dist_eq_norm_div, norm_div_rev] using hx } end -lemma normed_group.uniformity_basis_dist : - (𝓤 E).has_basis (λ (ε : ℝ), 0 < ε) (λ ε, {p : E × E | ∥p.fst - p.snd∥ < ε}) := +@[to_additive] +lemma seminormed_group.uniform_cauchy_seq_on_iff_tendsto_uniformly_on_one + {f : ι → κ → G} {s : set κ} {l : filter ι} : + uniform_cauchy_seq_on f l s ↔ + tendsto_uniformly_on (λ n : ι × ι, λ z, f n.fst z / f n.snd z) 1 (l ×ᶠ l) s := +by rw [tendsto_uniformly_on_iff_tendsto_uniformly_on_filter, + uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter, + seminormed_group.uniform_cauchy_seq_on_filter_iff_tendsto_uniformly_on_filter_one] + +end seminormed_group + +section induced + +variables (E F) + +/-- A group homomorphism from a `group` to a `seminormed_group` induces a `seminormed_group` +structure on the domain. -/ +@[reducible, -- See note [reducible non-instances] +to_additive "A group homomorphism from an `add_group` to a `seminormed_add_group` induces a +`seminormed_add_group` structure on the domain."] +def seminormed_group.induced [group E] [seminormed_group F] [monoid_hom_class 𝓕 E F] (f : 𝓕) : + seminormed_group E := +{ norm := λ x, ‖f x‖, + dist_eq := λ x y, by simpa only [map_div, ←dist_eq_norm_div], + ..pseudo_metric_space.induced f _ } + +/-- A group homomorphism from a `comm_group` to a `seminormed_group` induces a +`seminormed_comm_group` structure on the domain. -/ +@[reducible, -- See note [reducible non-instances] +to_additive "A group homomorphism from an `add_comm_group` to a `seminormed_add_group` induces a +`seminormed_add_comm_group` structure on the domain."] +def seminormed_comm_group.induced [comm_group E] [seminormed_group F] [monoid_hom_class 𝓕 E F] + (f : 𝓕) : seminormed_comm_group E := +{ ..seminormed_group.induced E F f } + +/-- An injective group homomorphism from a `group` to a `normed_group` induces a `normed_group` +structure on the domain. -/ +@[reducible, -- See note [reducible non-instances]. +to_additive "An injective group homomorphism from an `add_group` to a `normed_add_group` induces a +`normed_add_group` structure on the domain."] +def normed_group.induced [group E] [normed_group F] [monoid_hom_class 𝓕 E F] (f : 𝓕) + (h : injective f) : normed_group E := +{ ..seminormed_group.induced E F f, ..metric_space.induced f h _ } + +/-- An injective group homomorphism from an `comm_group` to a `normed_group` induces a +`normed_comm_group` structure on the domain. -/ +@[reducible, -- See note [reducible non-instances]. +to_additive "An injective group homomorphism from an `comm_group` to a `normed_comm_group` induces a +`normed_comm_group` structure on the domain."] +def normed_comm_group.induced [comm_group E] [normed_group F] [monoid_hom_class 𝓕 E F] (f : 𝓕) + (h : injective f) : normed_comm_group E := +{ ..seminormed_group.induced E F f, ..metric_space.induced f h _ } + +end induced + +section seminormed_comm_group +variables [seminormed_comm_group E] [seminormed_comm_group F] {a a₁ a₂ b b₁ b₂ : E} {r r₁ r₂ : ℝ} + +@[to_additive] instance normed_group.to_has_isometric_smul_left : has_isometric_smul E E := +⟨λ a, isometry.of_dist_eq $ λ b c, by simp [dist_eq_norm_div]⟩ + +@[to_additive] lemma dist_inv (x y : E) : dist x⁻¹ y = dist x y⁻¹ := +by simp_rw [dist_eq_norm_div, ←norm_inv' (x⁻¹ / y), inv_div, div_inv_eq_mul, mul_comm] + +@[simp, to_additive] lemma dist_self_mul_right (a b : E) : dist a (a * b) = ‖b‖ := +by rw [←dist_one_left, ←dist_mul_left a 1 b, mul_one] + +@[simp, to_additive] lemma dist_self_mul_left (a b : E) : dist (a * b) a = ‖b‖ := +by rw [dist_comm, dist_self_mul_right] + +@[simp, to_additive] lemma dist_self_div_right (a b : E) : dist a (a / b) = ‖b‖ := +by rw [div_eq_mul_inv, dist_self_mul_right, norm_inv'] + +@[simp, to_additive] lemma dist_self_div_left (a b : E) : dist (a / b) a = ‖b‖ := +by rw [dist_comm, dist_self_div_right] + +@[to_additive] lemma dist_mul_mul_le (a₁ a₂ b₁ b₂ : E) : + dist (a₁ * a₂) (b₁ * b₂) ≤ dist a₁ b₁ + dist a₂ b₂ := +by simpa only [dist_mul_left, dist_mul_right] using dist_triangle (a₁ * a₂) (b₁ * a₂) (b₁ * b₂) + +@[to_additive] lemma dist_mul_mul_le_of_le (h₁ : dist a₁ b₁ ≤ r₁) (h₂ : dist a₂ b₂ ≤ r₂) : + dist (a₁ * a₂) (b₁ * b₂) ≤ r₁ + r₂ := +(dist_mul_mul_le a₁ a₂ b₁ b₂).trans $ add_le_add h₁ h₂ + +@[to_additive] lemma dist_div_div_le (a₁ a₂ b₁ b₂ : E) : + dist (a₁ / a₂) (b₁ / b₂) ≤ dist a₁ b₁ + dist a₂ b₂ := +by simpa only [div_eq_mul_inv, dist_inv_inv] using dist_mul_mul_le a₁ a₂⁻¹ b₁ b₂⁻¹ + +@[to_additive] lemma dist_div_div_le_of_le (h₁ : dist a₁ b₁ ≤ r₁) (h₂ : dist a₂ b₂ ≤ r₂) : + dist (a₁ / a₂) (b₁ / b₂) ≤ r₁ + r₂ := +(dist_div_div_le a₁ a₂ b₁ b₂).trans $ add_le_add h₁ h₂ + +@[to_additive] lemma abs_dist_sub_le_dist_mul_mul (a₁ a₂ b₁ b₂ : E) : + |dist a₁ b₁ - dist a₂ b₂| ≤ dist (a₁ * a₂) (b₁ * b₂) := +by simpa only [dist_mul_left, dist_mul_right, dist_comm b₂] + using abs_dist_sub_le (a₁ * a₂) (b₁ * b₂) (b₁ * a₂) + +lemma norm_multiset_sum_le {E} [seminormed_add_comm_group E] (m : multiset E) : + ‖m.sum‖ ≤ (m.map (λ x, ‖x‖)).sum := +m.le_sum_of_subadditive norm norm_zero norm_add_le + +@[to_additive] +lemma norm_multiset_prod_le (m : multiset E) : ‖m.prod‖ ≤ (m.map $ λ x, ‖x‖).sum := begin - convert metric.uniformity_basis_dist, - simp [dist_eq_norm] + rw [←multiplicative.of_add_le, of_add_multiset_prod, multiset.map_map], + refine multiset.le_prod_of_submultiplicative (multiplicative.of_add ∘ norm) _ (λ x y, _) _, + { simp only [comp_app, norm_one', of_add_zero] }, + { exact norm_mul_le' _ _ } end -open finset +lemma norm_sum_le {E} [seminormed_add_comm_group E] (s : finset ι) (f : ι → E) : + ‖∑ i in s, f i‖ ≤ ∑ i in s, ‖f i‖ := +s.le_sum_of_subadditive norm norm_zero norm_add_le f -/-- A homomorphism `f` of seminormed groups is Lipschitz, if there exists a constant `C` such that -for all `x`, one has `∥f x∥ ≤ C * ∥x∥`. The analogous condition for a linear map of -(semi)normed spaces is in `normed_space.operator_norm`. -/ -lemma add_monoid_hom.lipschitz_of_bound (f : E →+ F) (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - lipschitz_with (real.to_nnreal C) f := -lipschitz_with.of_dist_le' $ λ x y, by simpa only [dist_eq_norm, f.map_sub] using h (x - y) +@[to_additive] lemma norm_prod_le (s : finset ι) (f : ι → E) : ‖∏ i in s, f i‖ ≤ ∑ i in s, ‖f i‖ := +begin + rw [←multiplicative.of_add_le, of_add_sum], + refine finset.le_prod_of_submultiplicative (multiplicative.of_add ∘ norm) _ (λ x y, _) _ _, + { simp only [comp_app, norm_one', of_add_zero] }, + { exact norm_mul_le' _ _ } +end -lemma lipschitz_on_with_iff_norm_sub_le {f : E → F} {C : ℝ≥0} {s : set E} : - lipschitz_on_with C f s ↔ ∀ (x ∈ s) (y ∈ s), ∥f x - f y∥ ≤ C * ∥x - y∥ := -by simp only [lipschitz_on_with_iff_dist_le_mul, dist_eq_norm] +@[to_additive] +lemma norm_prod_le_of_le (s : finset ι) {f : ι → E} {n : ι → ℝ} (h : ∀ b ∈ s, ‖f b‖ ≤ n b) : + ‖∏ b in s, f b‖ ≤ ∑ b in s, n b := +(norm_prod_le s f).trans $ finset.sum_le_sum h -lemma lipschitz_on_with.norm_sub_le {f : E → F} {C : ℝ≥0} {s : set E} (h : lipschitz_on_with C f s) - {x y : E} (x_in : x ∈ s) (y_in : y ∈ s) : ∥f x - f y∥ ≤ C * ∥x - y∥ := -lipschitz_on_with_iff_norm_sub_le.mp h x x_in y y_in +@[to_additive] lemma dist_prod_prod_le_of_le (s : finset ι) {f a : ι → E} {d : ι → ℝ} + (h : ∀ b ∈ s, dist (f b) (a b) ≤ d b) : + dist (∏ b in s, f b) (∏ b in s, a b) ≤ ∑ b in s, d b := +by { simp only [dist_eq_norm_div, ← finset.prod_div_distrib] at *, exact norm_prod_le_of_le s h } -lemma lipschitz_on_with.norm_sub_le_of_le {f : E → F} {C : ℝ≥0} {s : set E} - (h : lipschitz_on_with C f s){x y : E} (x_in : x ∈ s) (y_in : y ∈ s) {d : ℝ} (hd : ∥x - y∥ ≤ d) : - ∥f x - f y∥ ≤ C * d := -(h.norm_sub_le x_in y_in).trans $ mul_le_mul_of_nonneg_left hd C.2 +@[to_additive] lemma dist_prod_prod_le (s : finset ι) (f a : ι → E) : + dist (∏ b in s, f b) (∏ b in s, a b) ≤ ∑ b in s, dist (f b) (a b) := +dist_prod_prod_le_of_le s $ λ _ _, le_rfl -lemma lipschitz_with_iff_norm_sub_le {f : E → F} {C : ℝ≥0} : - lipschitz_with C f ↔ ∀ x y, ∥f x - f y∥ ≤ C * ∥x - y∥ := -by simp only [lipschitz_with_iff_dist_le_mul, dist_eq_norm] +@[to_additive] lemma mul_mem_ball_iff_norm : a * b ∈ ball a r ↔ ‖b‖ < r := +by rw [mem_ball_iff_norm'', mul_div_cancel'''] -alias lipschitz_with_iff_norm_sub_le ↔ lipschitz_with.norm_sub_le _ +@[to_additive] lemma mul_mem_closed_ball_iff_norm : a * b ∈ closed_ball a r ↔ ‖b‖ ≤ r := +by rw [mem_closed_ball_iff_norm'', mul_div_cancel'''] -lemma lipschitz_with.norm_sub_le_of_le {f : E → F} {C : ℝ≥0} (h : lipschitz_with C f) - {x y : E} {d : ℝ} (hd : ∥x - y∥ ≤ d) : - ∥f x - f y∥ ≤ C * d := -(h.norm_sub_le x y).trans $ mul_le_mul_of_nonneg_left hd C.2 +@[simp, to_additive] lemma preimage_mul_ball (a b : E) (r : ℝ) : + ((*) b) ⁻¹' ball a r = ball (a / b) r := +by { ext c, simp only [dist_eq_norm_div, set.mem_preimage, mem_ball, div_div_eq_mul_div, mul_comm] } -/-- A homomorphism `f` of seminormed groups is continuous, if there exists a constant `C` such that -for all `x`, one has `∥f x∥ ≤ C * ∥x∥`. -The analogous condition for a linear map of normed spaces is in `normed_space.operator_norm`. -/ -lemma add_monoid_hom.continuous_of_bound (f : E →+ F) (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - continuous f := -(f.lipschitz_of_bound C h).continuous - -lemma is_compact.exists_bound_of_continuous_on [topological_space α] - {s : set α} (hs : is_compact s) {f : α → E} (hf : continuous_on f s) : - ∃ C, ∀ x ∈ s, ∥f x∥ ≤ C := +@[simp, to_additive] lemma preimage_mul_closed_ball (a b : E) (r : ℝ) : + ((*) b) ⁻¹' (closed_ball a r) = closed_ball (a / b) r := +by { ext c, + simp only [dist_eq_norm_div, set.mem_preimage, mem_closed_ball, div_div_eq_mul_div, mul_comm] } + +@[simp, to_additive] lemma preimage_mul_sphere (a b : E) (r : ℝ) : + ((*) b) ⁻¹' sphere a r = sphere (a / b) r := +by { ext c, simp only [set.mem_preimage, mem_sphere_iff_norm', div_div_eq_mul_div, mul_comm] } + +@[to_additive norm_nsmul_le] lemma norm_pow_le_mul_norm (n : ℕ) (a : E) : ‖a^n‖ ≤ n * ‖a‖ := begin - have : bounded (f '' s) := (hs.image_of_continuous_on hf).bounded, - rcases bounded_iff_forall_norm_le.1 this with ⟨C, hC⟩, - exact ⟨C, λ x hx, hC _ (set.mem_image_of_mem _ hx)⟩, + induction n with n ih, { simp, }, + simpa only [pow_succ', nat.cast_succ, add_mul, one_mul] using norm_mul_le_of_le ih le_rfl, end -lemma add_monoid_hom.isometry_iff_norm (f : E →+ F) : isometry f ↔ ∀ x, ∥f x∥ = ∥x∥ := +@[to_additive nnnorm_nsmul_le] lemma nnnorm_pow_le_mul_norm (n : ℕ) (a : E) : ‖a^n‖₊ ≤ n * ‖a‖₊ := +by simpa only [← nnreal.coe_le_coe, nnreal.coe_mul, nnreal.coe_nat_cast] + using norm_pow_le_mul_norm n a + +@[to_additive] lemma pow_mem_closed_ball {n : ℕ} (h : a ∈ closed_ball b r) : + a^n ∈ closed_ball (b^n) (n • r) := begin - simp only [isometry_emetric_iff_metric, dist_eq_norm, ← f.map_sub], - refine ⟨λ h x, _, λ h x y, h _⟩, - simpa using h x 0 + simp only [mem_closed_ball, dist_eq_norm_div, ← div_pow] at h ⊢, + refine (norm_pow_le_mul_norm n (a / b)).trans _, + simpa only [nsmul_eq_mul] using mul_le_mul_of_nonneg_left h n.cast_nonneg, +end + +@[to_additive] lemma pow_mem_ball {n : ℕ} (hn : 0 < n) (h : a ∈ ball b r) : + a^n ∈ ball (b^n) (n • r) := +begin + simp only [mem_ball, dist_eq_norm_div, ← div_pow] at h ⊢, + refine lt_of_le_of_lt (norm_pow_le_mul_norm n (a / b)) _, + replace hn : 0 < (n : ℝ), { norm_cast, assumption, }, + rw nsmul_eq_mul, + nlinarith, end -lemma add_monoid_hom.isometry_of_norm (f : E →+ F) (hf : ∀ x, ∥f x∥ = ∥x∥) : isometry f := -f.isometry_iff_norm.2 hf +@[simp, to_additive] lemma mul_mem_closed_ball_mul_iff {c : E} : + a * c ∈ closed_ball (b * c) r ↔ a ∈ closed_ball b r := +by simp only [mem_closed_ball, dist_eq_norm_div, mul_div_mul_right_eq_div] -lemma controlled_sum_of_mem_closure {s : add_subgroup E} {g : E} - (hg : g ∈ closure (s : set E)) {b : ℕ → ℝ} (b_pos : ∀ n, 0 < b n) : +@[simp, to_additive] lemma mul_mem_ball_mul_iff {c : E} : + a * c ∈ ball (b * c) r ↔ a ∈ ball b r := +by simp only [mem_ball, dist_eq_norm_div, mul_div_mul_right_eq_div] + +@[to_additive] lemma smul_closed_ball'' : + a • closed_ball b r = closed_ball (a • b) r := +by { ext, simp [mem_closed_ball, set.mem_smul_set, dist_eq_norm_div, div_eq_inv_mul, + ← eq_inv_mul_iff_mul_eq, mul_assoc], } + +@[to_additive] lemma smul_ball'' : + a • ball b r = ball (a • b) r := +by { ext, simp [mem_ball, set.mem_smul_set, dist_eq_norm_div, div_eq_inv_mul, + ← eq_inv_mul_iff_mul_eq, mul_assoc], } + +open finset + +@[to_additive] lemma controlled_prod_of_mem_closure {s : subgroup E} (hg : a ∈ closure (s : set E)) + {b : ℕ → ℝ} (b_pos : ∀ n, 0 < b n) : ∃ v : ℕ → E, - tendsto (λ n, ∑ i in range (n+1), v i) at_top (𝓝 g) ∧ + tendsto (λ n, ∏ i in range (n+1), v i) at_top (𝓝 a) ∧ (∀ n, v n ∈ s) ∧ - ∥v 0 - g∥ < b 0 ∧ - ∀ n > 0, ∥v n∥ < b n := + ‖v 0 / a‖ < b 0 ∧ + ∀ n, 0 < n → ‖v n‖ < b n := begin - obtain ⟨u : ℕ → E, u_in : ∀ n, u n ∈ s, lim_u : tendsto u at_top (𝓝 g)⟩ := + obtain ⟨u : ℕ → E, u_in : ∀ n, u n ∈ s, lim_u : tendsto u at_top (𝓝 a)⟩ := mem_closure_iff_seq_limit.mp hg, - obtain ⟨n₀, hn₀⟩ : ∃ n₀, ∀ n ≥ n₀, ∥u n - g∥ < b 0, - { have : {x | ∥x - g∥ < b 0} ∈ 𝓝 g, - { simp_rw ← dist_eq_norm, + obtain ⟨n₀, hn₀⟩ : ∃ n₀, ∀ n ≥ n₀, ‖u n / a‖ < b 0, + { have : {x | ‖x / a‖ < b 0} ∈ 𝓝 a, + { simp_rw ← dist_eq_norm_div, exact metric.ball_mem_nhds _ (b_pos _) }, exact filter.tendsto_at_top'.mp lim_u _ this }, set z : ℕ → E := λ n, u (n + n₀), - have lim_z : tendsto z at_top (𝓝 g) := lim_u.comp (tendsto_add_at_top_nat n₀), - have mem_𝓤 : ∀ n, {p : E × E | ∥p.1 - p.2∥ < b (n + 1)} ∈ 𝓤 E := - λ n, by simpa [← dist_eq_norm] using metric.dist_mem_uniformity (b_pos $ n+1), + have lim_z : tendsto z at_top (𝓝 a) := lim_u.comp (tendsto_add_at_top_nat n₀), + have mem_𝓤 : ∀ n, {p : E × E | ‖p.1 / p.2‖ < b (n + 1)} ∈ 𝓤 E := + λ n, by simpa [← dist_eq_norm_div] using metric.dist_mem_uniformity (b_pos $ n+1), obtain ⟨φ : ℕ → ℕ, φ_extr : strict_mono φ, - hφ : ∀ n, ∥z (φ $ n + 1) - z (φ n)∥ < b (n + 1)⟩ := + hφ : ∀ n, ‖z (φ $ n + 1) / z (φ n)‖ < b (n + 1)⟩ := lim_z.cauchy_seq.subseq_mem mem_𝓤, set w : ℕ → E := z ∘ φ, - have hw : tendsto w at_top (𝓝 g), + have hw : tendsto w at_top (𝓝 a), from lim_z.comp φ_extr.tendsto_at_top, - set v : ℕ → E := λ i, if i = 0 then w 0 else w i - w (i - 1), - refine ⟨v, tendsto.congr (finset.eq_sum_range_sub' w) hw , _, + set v : ℕ → E := λ i, if i = 0 then w 0 else w i / w (i - 1), + refine ⟨v, tendsto.congr (finset.eq_prod_range_div' w) hw , _, hn₀ _ (n₀.le_add_left _), _⟩, { rintro ⟨⟩, { change w 0 ∈ s, apply u_in }, - { apply s.sub_mem ; apply u_in }, }, + { apply s.div_mem ; apply u_in }, }, { intros l hl, - obtain ⟨k, rfl⟩ : ∃ k, l = k+1, exact nat.exists_eq_succ_of_ne_zero (ne_of_gt hl), - apply hφ }, + obtain ⟨k, rfl⟩ : ∃ k, l = k+1, exact nat.exists_eq_succ_of_ne_zero hl.ne', + apply hφ } end -lemma controlled_sum_of_mem_closure_range {j : E →+ F} {h : F} - (Hh : h ∈ (closure $ (j.range : set F))) {b : ℕ → ℝ} (b_pos : ∀ n, 0 < b n) : - ∃ g : ℕ → E, - tendsto (λ n, ∑ i in range (n+1), j (g i)) at_top (𝓝 h) ∧ - ∥j (g 0) - h∥ < b 0 ∧ - ∀ n > 0, ∥j (g n)∥ < b n := +@[to_additive] lemma controlled_prod_of_mem_closure_range {j : E →* F} {b : F} + (hb : b ∈ closure (j.range : set F)) {f : ℕ → ℝ} (b_pos : ∀ n, 0 < f n) : + ∃ a : ℕ → E, + tendsto (λ n, ∏ i in range (n + 1), j (a i)) at_top (𝓝 b) ∧ + ‖j (a 0) / b‖ < f 0 ∧ + ∀ n, 0 < n → ‖j (a n)‖ < f n := begin - rcases controlled_sum_of_mem_closure Hh b_pos with ⟨v, sum_v, v_in, hv₀, hv_pos⟩, + obtain ⟨v, sum_v, v_in, hv₀, hv_pos⟩ := controlled_prod_of_mem_closure hb b_pos, choose g hg using v_in, - change ∀ (n : ℕ), j (g n) = v n at hg, refine ⟨g, by simpa [← hg] using sum_v, by simpa [hg 0] using hv₀, λ n hn, - by simpa [hg] using hv_pos n hn⟩ + by simpa [hg] using hv_pos n hn⟩, end -section nnnorm +@[to_additive] lemma nndist_mul_mul_le (a₁ a₂ b₁ b₂ : E) : + nndist (a₁ * a₂) (b₁ * b₂) ≤ nndist a₁ b₁ + nndist a₂ b₂ := +nnreal.coe_le_coe.1 $ dist_mul_mul_le a₁ a₂ b₁ b₂ -/-- Auxiliary class, endowing a type `α` with a function `nnnorm : α → ℝ≥0` with notation `∥x∥₊`. -/ -class has_nnnorm (E : Type*) := (nnnorm : E → ℝ≥0) +@[to_additive] +lemma edist_mul_mul_le (a₁ a₂ b₁ b₂ : E) : edist (a₁ * a₂) (b₁ * b₂) ≤ edist a₁ b₁ + edist a₂ b₂ := +by { simp only [edist_nndist], norm_cast, apply nndist_mul_mul_le } -export has_nnnorm (nnnorm) +@[to_additive] +lemma nnnorm_multiset_prod_le (m : multiset E) : ‖m.prod‖₊ ≤ (m.map (λ x, ‖x‖₊)).sum := +nnreal.coe_le_coe.1 $ by { push_cast, rw multiset.map_map, exact norm_multiset_prod_le _ } -notation `∥`e`∥₊` := nnnorm e +@[to_additive] lemma nnnorm_prod_le (s : finset ι) (f : ι → E) : + ‖∏ a in s, f a‖₊ ≤ ∑ a in s, ‖f a‖₊ := +nnreal.coe_le_coe.1 $ by { push_cast, exact norm_prod_le _ _ } -@[priority 100] -- see Note [lower instance priority] -instance semi_normed_group.to_has_nnnorm : has_nnnorm E := ⟨λ a, ⟨norm a, norm_nonneg a⟩⟩ +@[to_additive] +lemma nnnorm_prod_le_of_le (s : finset ι) {f : ι → E} {n : ι → ℝ≥0} (h : ∀ b ∈ s, ‖f b‖₊ ≤ n b) : + ‖∏ b in s, f b‖₊ ≤ ∑ b in s, n b := +(norm_prod_le_of_le s h).trans_eq nnreal.coe_sum.symm -@[simp, norm_cast] lemma coe_nnnorm (a : E) : (∥a∥₊ : ℝ) = norm a := rfl +namespace real -@[simp] lemma coe_comp_nnnorm : (coe : ℝ≥0 → ℝ) ∘ (nnnorm : E → ℝ≥0) = norm := rfl +instance : has_norm ℝ := { norm := λ r, |r| } -lemma norm_to_nnreal {a : E} : ∥a∥.to_nnreal = ∥a∥₊ := -@real.to_nnreal_coe ∥a∥₊ +@[simp] lemma norm_eq_abs (r : ℝ) : ‖r‖ = |r| := rfl -lemma nndist_eq_nnnorm (a b : E) : nndist a b = ∥a - b∥₊ := nnreal.eq $ dist_eq_norm _ _ +instance : normed_add_comm_group ℝ := ⟨λ r y, rfl⟩ -@[simp] lemma nnnorm_zero : ∥(0 : E)∥₊ = 0 := -nnreal.eq norm_zero +lemma norm_of_nonneg (hr : 0 ≤ r) : ‖r‖ = r := abs_of_nonneg hr +lemma norm_of_nonpos (hr : r ≤ 0) : ‖r‖ = -r := abs_of_nonpos hr +lemma le_norm_self (r : ℝ) : r ≤ ‖r‖ := le_abs_self r -lemma ne_zero_of_nnnorm_ne_zero {g : E} : ∥g∥₊ ≠ 0 → g ≠ 0 := -mt $ by { rintro rfl, exact nnnorm_zero } +@[simp] lemma norm_coe_nat (n : ℕ) : ‖(n : ℝ)‖ = n := abs_of_nonneg n.cast_nonneg +@[simp] lemma nnnorm_coe_nat (n : ℕ) : ‖(n : ℝ)‖₊ = n := nnreal.eq $ norm_coe_nat _ -lemma nnnorm_add_le (g h : E) : ∥g + h∥₊ ≤ ∥g∥₊ + ∥h∥₊ := -nnreal.coe_le_coe.1 $ norm_add_le g h +@[simp] lemma norm_two : ‖(2 : ℝ)‖ = 2 := abs_of_pos zero_lt_two -@[simp] lemma nnnorm_neg (g : E) : ∥-g∥₊ = ∥g∥₊ := -nnreal.eq $ norm_neg g +@[simp] lemma nnnorm_two : ‖(2 : ℝ)‖₊ = 2 := nnreal.eq $ by simp -lemma nndist_nnnorm_nnnorm_le (g h : E) : nndist ∥g∥₊ ∥h∥₊ ≤ ∥g - h∥₊ := -nnreal.coe_le_coe.1 $ dist_norm_norm_le g h +lemma nnnorm_of_nonneg (hr : 0 ≤ r) : ‖r‖₊ = ⟨r, hr⟩ := nnreal.eq $ norm_of_nonneg hr -/-- The direct path from `0` to `v` is shorter than the path with `u` inserted in between. -/ -lemma nnnorm_le_insert (u v : E) : ∥v∥₊ ≤ ∥u∥₊ + ∥u - v∥₊ := norm_le_insert u v +@[simp] lemma nnnorm_abs (r : ℝ) : ‖(|r|)‖₊ = ‖r‖₊ := by simp [nnnorm] -lemma nnnorm_le_insert' (u v : E) : ∥u∥₊ ≤ ∥v∥₊ + ∥u - v∥₊ := norm_le_insert' u v +lemma ennnorm_eq_of_real (hr : 0 ≤ r) : (‖r‖₊ : ℝ≥0∞) = ennreal.of_real r := +by { rw [← of_real_norm_eq_coe_nnnorm, norm_of_nonneg hr] } -lemma nnnorm_le_add_nnnorm_add (u v : E) : ∥u∥₊ ≤ ∥u + v∥₊ + ∥v∥₊ := norm_le_add_norm_add u v +lemma ennnorm_eq_of_real_abs (r : ℝ) : (‖r‖₊ : ℝ≥0∞) = ennreal.of_real (|r|) := +by rw [← real.nnnorm_abs r, real.ennnorm_eq_of_real (abs_nonneg _)] -lemma of_real_norm_eq_coe_nnnorm (x : E) : ennreal.of_real ∥x∥ = (∥x∥₊ : ℝ≥0∞) := -ennreal.of_real_eq_coe_nnreal _ +lemma to_nnreal_eq_nnnorm_of_nonneg (hr : 0 ≤ r) : r.to_nnreal = ‖r‖₊ := +begin + rw real.to_nnreal_of_nonneg hr, + congr, + rw [real.norm_eq_abs, abs_of_nonneg hr], +end -lemma edist_eq_coe_nnnorm_sub (x y : E) : edist x y = (∥x - y∥₊ : ℝ≥0∞) := -by rw [edist_dist, dist_eq_norm, of_real_norm_eq_coe_nnnorm] +lemma of_real_le_ennnorm (r : ℝ) : ennreal.of_real r ≤ ‖r‖₊ := +begin + obtain hr | hr := le_total 0 r, + { exact (real.ennnorm_eq_of_real hr).ge }, + { rw [ennreal.of_real_eq_zero.2 hr], + exact bot_le } +end -lemma edist_eq_coe_nnnorm (x : E) : edist x 0 = (∥x∥₊ : ℝ≥0∞) := -by rw [edist_eq_coe_nnnorm_sub, _root_.sub_zero] +end real -lemma mem_emetric_ball_zero_iff {x : E} {r : ℝ≥0∞} : x ∈ emetric.ball (0 : E) r ↔ ↑∥x∥₊ < r := -by rw [emetric.mem_ball, edist_eq_coe_nnnorm] +namespace int -lemma nndist_add_add_le (g₁ g₂ h₁ h₂ : E) : - nndist (g₁ + g₂) (h₁ + h₂) ≤ nndist g₁ h₁ + nndist g₂ h₂ := -nnreal.coe_le_coe.1 $ dist_add_add_le g₁ g₂ h₁ h₂ +instance : normed_add_comm_group ℤ := +{ norm := λ n, ‖(n : ℝ)‖, + dist_eq := λ m n, by simp only [int.dist_eq, norm, int.cast_sub] } -lemma edist_add_add_le (g₁ g₂ h₁ h₂ : E) : - edist (g₁ + g₂) (h₁ + h₂) ≤ edist g₁ h₁ + edist g₂ h₂ := -by { simp only [edist_nndist], norm_cast, apply nndist_add_add_le } +@[norm_cast] lemma norm_cast_real (m : ℤ) : ‖(m : ℝ)‖ = ‖m‖ := rfl -@[simp] lemma edist_add_left (g h₁ h₂ : E) : edist (g + h₁) (g + h₂) = edist h₁ h₂ := -by simp [edist_dist] +lemma norm_eq_abs (n : ℤ) : ‖n‖ = |n| := rfl -@[simp] lemma edist_add_right (g₁ g₂ h : E) : edist (g₁ + h) (g₂ + h) = edist g₁ g₂ := -by simp [edist_dist] +@[simp] lemma norm_coe_nat (n : ℕ) : ‖(n : ℤ)‖ = n := by simp [int.norm_eq_abs] -lemma edist_neg (x y : E) : edist (-x) y = edist x (-y) := by simp_rw [edist_dist, dist_neg] -@[simp] lemma edist_neg_neg (x y : E) : edist (-x) (-y) = edist x y := by rw [edist_neg, neg_neg] +lemma _root_.nnreal.coe_nat_abs (n : ℤ) : (n.nat_abs : ℝ≥0) = ‖n‖₊ := +nnreal.eq $ calc ((n.nat_abs : ℝ≥0) : ℝ) + = (n.nat_abs : ℤ) : by simp only [int.cast_coe_nat, nnreal.coe_nat_cast] + ... = |n| : by simp only [int.coe_nat_abs, int.cast_abs] + ... = ‖n‖ : rfl -@[simp] lemma edist_sub_left (g h₁ h₂ : E) : edist (g - h₁) (g - h₂) = edist h₁ h₂ := -by simp only [sub_eq_add_neg, edist_add_left, edist_neg_neg] +lemma abs_le_floor_nnreal_iff (z : ℤ) (c : ℝ≥0) : |z| ≤ ⌊c⌋₊ ↔ ‖z‖₊ ≤ c := +begin + rw [int.abs_eq_nat_abs, int.coe_nat_le, nat.le_floor_iff (zero_le c)], + congr', + exact nnreal.coe_nat_abs z, +end -@[simp] lemma edist_sub_right (g₁ g₂ h : E) : edist (g₁ - h) (g₂ - h) = edist g₁ g₂ := -by simpa only [sub_eq_add_neg] using edist_add_right _ _ _ +end int -lemma nnnorm_sum_le (s : finset ι) (f : ι → E) : - ∥∑ a in s, f a∥₊ ≤ ∑ a in s, ∥f a∥₊ := -s.le_sum_of_subadditive nnnorm nnnorm_zero nnnorm_add_le f +namespace rat -lemma nnnorm_sum_le_of_le (s : finset ι) {f : ι → E} {n : ι → ℝ≥0} (h : ∀ b ∈ s, ∥f b∥₊ ≤ n b) : - ∥∑ b in s, f b∥₊ ≤ ∑ b in s, n b := -(norm_sum_le_of_le s h).trans_eq nnreal.coe_sum.symm +instance : normed_add_comm_group ℚ := +{ norm := λ r, ‖(r : ℝ)‖, + dist_eq := λ r₁ r₂, by simp only [rat.dist_eq, norm, rat.cast_sub] } -lemma add_monoid_hom.lipschitz_of_bound_nnnorm (f : E →+ F) (C : ℝ≥0) (h : ∀ x, ∥f x∥₊ ≤ C * ∥x∥₊) : - lipschitz_with C f := -@real.to_nnreal_coe C ▸ f.lipschitz_of_bound C h +@[norm_cast, simp] lemma norm_cast_real (r : ℚ) : ‖(r : ℝ)‖ = ‖r‖ := rfl -end nnnorm +@[norm_cast, simp] lemma _root_.int.norm_cast_rat (m : ℤ) : ‖(m : ℚ)‖ = ‖m‖ := +by rw [← rat.norm_cast_real, ← int.norm_cast_real]; congr' 1; norm_cast -namespace lipschitz_with +end rat +-- Now that we've installed the norm on `ℤ`, +-- we can state some lemmas about `zsmul`. +section +variables [seminormed_comm_group α] + +@[to_additive norm_zsmul_le] +lemma norm_zpow_le_mul_norm (n : ℤ) (a : α) : ‖a^n‖ ≤ ‖n‖ * ‖a‖ := +by rcases n.eq_coe_or_neg with ⟨n, rfl | rfl⟩; simpa using norm_pow_le_mul_norm n a + +@[to_additive nnnorm_zsmul_le] +lemma nnnorm_zpow_le_mul_norm (n : ℤ) (a : α) : ‖a^n‖₊ ≤ ‖n‖₊ * ‖a‖₊ := +by simpa only [← nnreal.coe_le_coe, nnreal.coe_mul] using norm_zpow_le_mul_norm n a + +end + +namespace lipschitz_with variables [pseudo_emetric_space α] {K Kf Kg : ℝ≥0} {f g : α → E} -lemma neg (hf : lipschitz_with K f) : lipschitz_with K (λ x, -f x) := -λ x y, (edist_neg_neg _ _).trans_le $ hf x y +@[to_additive] lemma inv (hf : lipschitz_with K f) : lipschitz_with K (λ x, (f x)⁻¹) := +λ x y, (edist_inv_inv _ _).trans_le $ hf x y -lemma add (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : - lipschitz_with (Kf + Kg) (λ x, f x + g x) := -λ x y, -calc edist (f x + g x) (f y + g y) ≤ edist (f x) (f y) + edist (g x) (g y) : - edist_add_add_le _ _ _ _ -... ≤ Kf * edist x y + Kg * edist x y : - add_le_add (hf x y) (hg x y) -... = (Kf + Kg) * edist x y : - (add_mul _ _ _).symm +@[to_additive add] lemma mul' (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : + lipschitz_with (Kf + Kg) (λ x, f x * g x) := +λ x y, calc + edist (f x * g x) (f y * g y) ≤ edist (f x) (f y) + edist (g x) (g y) : edist_mul_mul_le _ _ _ _ +... ≤ Kf * edist x y + Kg * edist x y : add_le_add (hf x y) (hg x y) +... = (Kf + Kg) * edist x y : (add_mul _ _ _).symm -lemma sub (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : - lipschitz_with (Kf + Kg) (λ x, f x - g x) := -by simpa only [sub_eq_add_neg] using hf.add hg.neg +@[to_additive] lemma div (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : + lipschitz_with (Kf + Kg) (λ x, f x / g x) := +by simpa only [div_eq_mul_inv] using hf.mul' hg.inv end lipschitz_with namespace antilipschitz_with - variables [pseudo_emetric_space α] {K Kf Kg : ℝ≥0} {f g : α → E} -lemma add_lipschitz_with (hf : antilipschitz_with Kf f) (hg : lipschitz_with Kg g) - (hK : Kg < Kf⁻¹) : antilipschitz_with (Kf⁻¹ - Kg)⁻¹ (λ x, f x + g x) := +@[to_additive] lemma mul_lipschitz_with (hf : antilipschitz_with Kf f) (hg : lipschitz_with Kg g) + (hK : Kg < Kf⁻¹) : antilipschitz_with (Kf⁻¹ - Kg)⁻¹ (λ x, f x * g x) := begin letI : pseudo_metric_space α := pseudo_emetric_space.to_pseudo_metric_space hf.edist_ne_top, refine antilipschitz_with.of_le_mul_dist (λ x y, _), @@ -696,468 +1299,530 @@ begin rw [mul_comm, nnreal.coe_sub hK.le, sub_mul], calc ↑Kf⁻¹ * dist x y - Kg * dist x y ≤ dist (f x) (f y) - dist (g x) (g y) : sub_le_sub (hf.mul_le_dist x y) (hg.dist_le_mul x y) - ... ≤ _ : le_trans (le_abs_self _) (abs_dist_sub_le_dist_add_add _ _ _ _) + ... ≤ _ : le_trans (le_abs_self _) (abs_dist_sub_le_dist_mul_mul _ _ _ _), end -lemma add_sub_lipschitz_with (hf : antilipschitz_with Kf f) (hg : lipschitz_with Kg (g - f)) - (hK : Kg < Kf⁻¹) : antilipschitz_with (Kf⁻¹ - Kg)⁻¹ g := -by simpa only [pi.sub_apply, add_sub_cancel'_right] using hf.add_lipschitz_with hg hK +@[to_additive] lemma mul_div_lipschitz_with (hf : antilipschitz_with Kf f) + (hg : lipschitz_with Kg (g / f)) (hK : Kg < Kf⁻¹) : antilipschitz_with (Kf⁻¹ - Kg)⁻¹ g := +by simpa only [pi.div_apply, mul_div_cancel'_right] using hf.mul_lipschitz_with hg hK -lemma le_mul_norm_sub {f : E → F} (hf : antilipschitz_with K f) (x y : E) : - ∥x - y∥ ≤ K * ∥f x - f y∥ := -by simp [← dist_eq_norm, hf.le_mul_dist x y] +@[to_additive le_mul_norm_sub] +lemma le_mul_norm_div {f : E → F} (hf : antilipschitz_with K f) (x y : E) : + ‖x / y‖ ≤ K * ‖f x / f y‖ := +by simp [← dist_eq_norm_div, hf.le_mul_dist x y] end antilipschitz_with -/-- A group homomorphism from an `add_comm_group` to a `semi_normed_group` induces a -`semi_normed_group` structure on the domain. +@[priority 100, to_additive] -- See note [lower instance priority] +instance seminormed_comm_group.to_has_lipschitz_mul : has_lipschitz_mul E := +⟨⟨1 + 1, lipschitz_with.prod_fst.mul' lipschitz_with.prod_snd⟩⟩ -See note [reducible non-instances] -/ -@[reducible] -def semi_normed_group.induced {E} [add_comm_group E] (f : E →+ F) : semi_normed_group E := -{ norm := λ x, ∥f x∥, - dist_eq := λ x y, by simpa only [add_monoid_hom.map_sub, ← dist_eq_norm], - .. pseudo_metric_space.induced f semi_normed_group.to_pseudo_metric_space, } +/-- A seminormed group is a uniform group, i.e., multiplication and division are uniformly +continuous. -/ +@[priority 100, to_additive "A seminormed group is a uniform additive group, i.e., addition and +subtraction are uniformly continuous."] -- See note [lower instance priority] +instance seminormed_comm_group.to_uniform_group : uniform_group E := +⟨(lipschitz_with.prod_fst.div lipschitz_with.prod_snd).uniform_continuous⟩ + + -- short-circuit type class inference +@[priority 100, to_additive] -- See note [lower instance priority] +instance seminormed_comm_group.to_topological_group : topological_group E := infer_instance + +@[to_additive] lemma cauchy_seq_prod_of_eventually_eq {u v : ℕ → E} {N : ℕ} + (huv : ∀ n ≥ N, u n = v n) (hv : cauchy_seq (λ n, ∏ k in range (n+1), v k)) : + cauchy_seq (λ n, ∏ k in range (n + 1), u k) := +begin + let d : ℕ → E := λ n, ∏ k in range (n + 1), (u k / v k), + rw show (λ n, ∏ k in range (n + 1), u k) = d * (λ n, ∏ k in range (n + 1), v k), + by { ext n, simp [d] }, + suffices : ∀ n ≥ N, d n = d N, + { exact (tendsto_at_top_of_eventually_const this).cauchy_seq.mul hv }, + intros n hn, + dsimp [d], + rw eventually_constant_prod _ hn, + intros m hm, + simp [huv m hm], +end -/-- A subgroup of a seminormed group is also a seminormed group, -with the restriction of the norm. -/ -instance add_subgroup.semi_normed_group (s : add_subgroup E) : semi_normed_group s := -semi_normed_group.induced s.subtype +end seminormed_comm_group -/-- If `x` is an element of a subgroup `s` of a seminormed group `E`, its norm in `s` is equal to -its norm in `E`. -/ -@[simp] lemma add_subgroup.coe_norm {E : Type*} [semi_normed_group E] - {s : add_subgroup E} (x : s) : - ∥(x : s)∥ = ∥(x:E)∥ := -rfl +section normed_group +variables [normed_group E] [normed_group F] {a b : E} -/-- If `x` is an element of a subgroup `s` of a seminormed group `E`, its norm in `s` is equal to -its norm in `E`. +@[simp, to_additive norm_eq_zero] lemma norm_eq_zero'' : ‖a‖ = 0 ↔ a = 1 := norm_eq_zero''' -This is a reversed version of the `simp` lemma `add_subgroup.coe_norm` for use by `norm_cast`. --/ +@[to_additive norm_ne_zero_iff] lemma norm_ne_zero_iff' : ‖a‖ ≠ 0 ↔ a ≠ 1 := norm_eq_zero''.not -@[norm_cast] lemma add_subgroup.norm_coe {E : Type*} [semi_normed_group E] {s : add_subgroup E} - (x : s) : - ∥(x : E)∥ = ∥(x : s)∥ := -rfl +@[simp, to_additive norm_pos_iff] lemma norm_pos_iff'' : 0 < ‖a‖ ↔ a ≠ 1 := norm_pos_iff''' -/-- A submodule of a seminormed group is also a seminormed group, with the restriction of the norm. +@[simp, to_additive norm_le_zero_iff] +lemma norm_le_zero_iff'' : ‖a‖ ≤ 0 ↔ a = 1 := norm_le_zero_iff''' -See note [implicit instance arguments]. -/ -instance submodule.semi_normed_group {𝕜 : Type*} {_ : ring 𝕜} - {E : Type*} [semi_normed_group E] {_ : module 𝕜 E} (s : submodule 𝕜 E) : semi_normed_group s := -{ norm := λx, norm (x : E), - dist_eq := λx y, dist_eq_norm (x : E) (y : E) } +@[to_additive] +lemma norm_div_eq_zero_iff : ‖a / b‖ = 0 ↔ a = b := by rw [norm_eq_zero'', div_eq_one] -/-- If `x` is an element of a submodule `s` of a normed group `E`, its norm in `s` is equal to its -norm in `E`. +@[to_additive] lemma norm_div_pos_iff : 0 < ‖a / b‖ ↔ a ≠ b := +by { rw [(norm_nonneg' _).lt_iff_ne, ne_comm], exact norm_div_eq_zero_iff.not } -See note [implicit instance arguments]. -/ -@[simp] lemma submodule.coe_norm {𝕜 : Type*} {_ : ring 𝕜} - {E : Type*} [semi_normed_group E] {_ : module 𝕜 E} {s : submodule 𝕜 E} (x : s) : - ∥(x : s)∥ = ∥(x : E)∥ := -rfl +@[to_additive] lemma eq_of_norm_div_le_zero (h : ‖a / b‖ ≤ 0) : a = b := +by rwa [←div_eq_one, ← norm_le_zero_iff''] -/-- If `x` is an element of a submodule `s` of a normed group `E`, its norm in `E` is equal to its -norm in `s`. +alias norm_div_eq_zero_iff ↔ eq_of_norm_div_eq_zero _ -This is a reversed version of the `simp` lemma `submodule.coe_norm` for use by `norm_cast`. +attribute [to_additive] eq_of_norm_div_eq_zero -See note [implicit instance arguments]. -/ -@[norm_cast] lemma submodule.norm_coe {𝕜 : Type*} {_ : ring 𝕜} - {E : Type*} [semi_normed_group E] {_ : module 𝕜 E} {s : submodule 𝕜 E} (x : s) : - ∥(x : E)∥ = ∥(x : s)∥ := -rfl +@[simp, to_additive nnnorm_eq_zero] lemma nnnorm_eq_zero' : ‖a‖₊ = 0 ↔ a = 1 := +by rw [← nnreal.coe_eq_zero, coe_nnnorm', norm_eq_zero''] -/-- seminormed group instance on the product of two seminormed groups, using the sup norm. -/ -noncomputable instance prod.semi_normed_group : semi_normed_group (E × F) := -{ norm := λx, max ∥x.1∥ ∥x.2∥, - dist_eq := assume (x y : E × F), - show max (dist x.1 y.1) (dist x.2 y.2) = (max ∥(x - y).1∥ ∥(x - y).2∥), by simp [dist_eq_norm] } +@[to_additive nnnorm_ne_zero_iff] +lemma nnnorm_ne_zero_iff' : ‖a‖₊ ≠ 0 ↔ a ≠ 1 := nnnorm_eq_zero'.not -lemma prod.norm_def (x : E × F) : ∥x∥ = (max ∥x.1∥ ∥x.2∥) := rfl +@[to_additive] +lemma tendsto_norm_div_self_punctured_nhds (a : E) : tendsto (λ x, ‖x / a‖) (𝓝[≠] a) (𝓝[>] 0) := +(tendsto_norm_div_self a).inf $ tendsto_principal_principal.2 $ λ x hx, norm_pos_iff''.2 $ + div_ne_one.2 hx -lemma prod.nnnorm_def (x : E × F) : ∥x∥₊ = max (∥x.1∥₊) (∥x.2∥₊) := -by { have := x.norm_def, simp only [← coe_nnnorm] at this, exact_mod_cast this } +@[to_additive] lemma tendsto_norm_nhds_within_one : tendsto (norm : E → ℝ) (𝓝[≠] 1) (𝓝[>] 0) := +tendsto_norm_one.inf $ tendsto_principal_principal.2 $ λ x, norm_pos_iff''.2 -lemma norm_fst_le (x : E × F) : ∥x.1∥ ≤ ∥x∥ := -le_max_left _ _ +variables (E) -lemma norm_snd_le (x : E × F) : ∥x.2∥ ≤ ∥x∥ := -le_max_right _ _ +/-- The norm of a normed group as a group norm. -/ +@[to_additive "The norm of a normed group as an additive group norm."] +def norm_group_norm : group_norm E := +{ eq_one_of_map_eq_zero' := λ _, norm_eq_zero''.1, ..norm_group_seminorm _ } -lemma norm_prod_le_iff {x : E × F} {r : ℝ} : - ∥x∥ ≤ r ↔ ∥x.1∥ ≤ r ∧ ∥x.2∥ ≤ r := -max_le_iff +@[simp] lemma coe_norm_group_norm : ⇑(norm_group_norm E) = norm := rfl -/-- seminormed group instance on the product of finitely many seminormed groups, -using the sup norm. -/ -noncomputable instance pi.semi_normed_group {π : ι → Type*} [fintype ι] - [Π i, semi_normed_group (π i)] : semi_normed_group (Π i, π i) := -{ norm := λ f, ↑(finset.univ.sup (λ b, ∥f b∥₊)), - dist_eq := assume x y, - congr_arg (coe : ℝ≥0 → ℝ) $ congr_arg (finset.sup finset.univ) $ funext $ assume a, - show nndist (x a) (y a) = ∥x a - y a∥₊, from nndist_eq_nnnorm _ _ } +end normed_group -lemma pi.norm_def {π : ι → Type*} [fintype ι] [Π i, semi_normed_group (π i)] (f : Π i, π i) : - ∥f∥ = ↑(finset.univ.sup (λ b, ∥f b∥₊)) := rfl +section normed_add_group +variables [normed_add_group E] [topological_space α] {f : α → E} -lemma pi.nnnorm_def {π : ι → Type*} [fintype ι] [Π i, semi_normed_group (π i)] (f : Π i, π i) : - ∥f∥₊ = finset.univ.sup (λ b, ∥f b∥₊) := subtype.eta _ _ +/-! Some relations with `has_compact_support` -/ -/-- The seminorm of an element in a product space is `≤ r` if and only if the norm of each -component is. -/ -lemma pi_norm_le_iff {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] {r : ℝ} - (hr : 0 ≤ r) {x : Πi, π i} : ∥x∥ ≤ r ↔ ∀i, ∥x i∥ ≤ r := -by simp only [← dist_zero_right, dist_pi_le_iff hr, pi.zero_apply] +lemma has_compact_support_norm_iff : has_compact_support (λ x, ‖f x‖) ↔ has_compact_support f := +has_compact_support_comp_left $ λ x, norm_eq_zero -lemma pi_nnnorm_le_iff {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] {r : ℝ≥0} - {x : Πi, π i} : ∥x∥₊ ≤ r ↔ ∀i, ∥x i∥₊ ≤ r := -pi_norm_le_iff r.coe_nonneg +alias has_compact_support_norm_iff ↔ _ has_compact_support.norm -/-- The seminorm of an element in a product space is `< r` if and only if the norm of each -component is. -/ -lemma pi_norm_lt_iff {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] {r : ℝ} - (hr : 0 < r) {x : Πi, π i} : ∥x∥ < r ↔ ∀i, ∥x i∥ < r := -by simp only [← dist_zero_right, dist_pi_lt_iff hr, pi.zero_apply] +lemma continuous.bounded_above_of_compact_support (hf : continuous f) (h : has_compact_support f) : + ∃ C, ∀ x, ‖f x‖ ≤ C := +by simpa [bdd_above_def] using hf.norm.bdd_above_range_of_has_compact_support h.norm -lemma pi_nnnorm_lt_iff {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] {r : ℝ≥0} - (hr : 0 < r) {x : Πi, π i} : ∥x∥₊ < r ↔ ∀i, ∥x i∥₊ < r := -pi_norm_lt_iff hr +end normed_add_group -lemma norm_le_pi_norm {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] (x : Πi, π i) - (i : ι) : ∥x i∥ ≤ ∥x∥ := -(pi_norm_le_iff (norm_nonneg x)).1 le_rfl i +section normed_add_group_source -lemma nnnorm_le_pi_nnnorm {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] (x : Πi, π i) - (i : ι) : ∥x i∥₊ ≤ ∥x∥₊ := -norm_le_pi_norm x i +variables [normed_add_group α] {f : α → E} -@[simp] lemma pi_norm_const [nonempty ι] [fintype ι] (a : E) : ∥(λ i : ι, a)∥ = ∥a∥ := -by simpa only [← dist_zero_right] using dist_pi_const a 0 +@[to_additive] +lemma has_compact_mul_support.exists_pos_le_norm [has_one E] (hf : has_compact_mul_support f) : + ∃ (R : ℝ), (0 < R) ∧ (∀ (x : α), (R ≤ ‖x‖) → (f x = 1)) := +begin + obtain ⟨K, ⟨hK1, hK2⟩⟩ := exists_compact_iff_has_compact_mul_support.mpr hf, + obtain ⟨S, hS, hS'⟩ := hK1.bounded.exists_pos_norm_le, + refine ⟨S + 1, by positivity, λ x hx, hK2 x ((mt $ hS' x) _)⟩, + contrapose! hx, + exact lt_add_of_le_of_pos hx zero_lt_one +end -@[simp] lemma pi_nnnorm_const [nonempty ι] [fintype ι] (a : E) : - ∥(λ i : ι, a)∥₊ = ∥a∥₊ := -nnreal.eq $ pi_norm_const a +end normed_add_group_source -/-- The $L^1$ norm is less than the $L^\infty$ norm scaled by the cardinality. -/ -lemma pi.sum_norm_apply_le_norm {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] - (x : Π i, π i) : - ∑ i, ∥x i∥ ≤ fintype.card ι • ∥x∥ := -calc ∑ i, ∥x i∥ ≤ ∑ i : ι, ∥x∥ : finset.sum_le_sum $ λ i hi, norm_le_pi_norm x i - ... = fintype.card ι • ∥x∥ : finset.sum_const _ +/-! ### `ulift` -/ -/-- The $L^1$ norm is less than the $L^\infty$ norm scaled by the cardinality. -/ -lemma pi.sum_nnnorm_apply_le_nnnorm {π : ι → Type*} [fintype ι] [∀i, semi_normed_group (π i)] - (x : Π i, π i) : - ∑ i, ∥x i∥₊ ≤ fintype.card ι • ∥x∥₊ := -nnreal.coe_sum.trans_le $ pi.sum_norm_apply_le_norm x +namespace ulift +section has_norm +variables [has_norm E] -lemma tendsto_iff_norm_tendsto_zero {f : α → E} {a : filter α} {b : E} : - tendsto f a (𝓝 b) ↔ tendsto (λ e, ∥f e - b∥) a (𝓝 0) := -by { convert tendsto_iff_dist_tendsto_zero, simp [dist_eq_norm] } +instance : has_norm (ulift E) := ⟨λ x, ‖x.down‖⟩ -lemma tendsto_zero_iff_norm_tendsto_zero {f : α → E} {a : filter α} : - tendsto f a (𝓝 0) ↔ tendsto (λ e, ∥f e∥) a (𝓝 0) := -by { rw [tendsto_iff_norm_tendsto_zero], simp only [sub_zero] } +lemma norm_def (x : ulift E) : ‖x‖ = ‖x.down‖ := rfl +@[simp] lemma norm_up (x : E) : ‖ulift.up x‖ = ‖x‖ := rfl +@[simp] lemma norm_down (x : ulift E) : ‖x.down‖ = ‖x‖ := rfl -/-- Special case of the sandwich theorem: if the norm of `f` is eventually bounded by a real -function `g` which tends to `0`, then `f` tends to `0`. -In this pair of lemmas (`squeeze_zero_norm'` and `squeeze_zero_norm`), following a convention of -similar lemmas in `topology.metric_space.basic` and `topology.algebra.order`, the `'` version is -phrased using "eventually" and the non-`'` version is phrased absolutely. -/ -lemma squeeze_zero_norm' {f : α → E} {g : α → ℝ} {t₀ : filter α} - (h : ∀ᶠ n in t₀, ∥f n∥ ≤ g n) - (h' : tendsto g t₀ (𝓝 0)) : tendsto f t₀ (𝓝 0) := -tendsto_zero_iff_norm_tendsto_zero.mpr - (squeeze_zero' (eventually_of_forall (λ n, norm_nonneg _)) h h') - -/-- Special case of the sandwich theorem: if the norm of `f` is bounded by a real function `g` which -tends to `0`, then `f` tends to `0`. -/ -lemma squeeze_zero_norm {f : α → E} {g : α → ℝ} {t₀ : filter α} - (h : ∀ n, ∥f n∥ ≤ g n) (h' : tendsto g t₀ (𝓝 0)) : - tendsto f t₀ (𝓝 0) := -squeeze_zero_norm' (eventually_of_forall h) h' - -lemma tendsto_norm_sub_self (x : E) : tendsto (λ g : E, ∥g - x∥) (𝓝 x) (𝓝 0) := -by simpa [dist_eq_norm] using tendsto_id.dist (tendsto_const_nhds : tendsto (λ g, (x:E)) (𝓝 x) _) - -lemma tendsto_norm {x : E} : tendsto (λg : E, ∥g∥) (𝓝 x) (𝓝 ∥x∥) := -by simpa using tendsto_id.dist (tendsto_const_nhds : tendsto (λ g, (0:E)) _ _) - -lemma tendsto_norm_zero : tendsto (λg : E, ∥g∥) (𝓝 0) (𝓝 0) := -by simpa using tendsto_norm_sub_self (0:E) - -@[continuity] -lemma continuous_norm : continuous (λg:E, ∥g∥) := -by simpa using continuous_id.dist (continuous_const : continuous (λ g, (0:E))) - -@[continuity] -lemma continuous_nnnorm : continuous (λ (a : E), ∥a∥₊) := -continuous_subtype_mk _ continuous_norm - -lemma lipschitz_with_one_norm : lipschitz_with 1 (norm : E → ℝ) := -by simpa only [dist_zero_left] using lipschitz_with.dist_right (0 : E) - -lemma lipschitz_with_one_nnnorm : lipschitz_with 1 (has_nnnorm.nnnorm : E → ℝ≥0) := -lipschitz_with_one_norm - -lemma uniform_continuous_norm : uniform_continuous (norm : E → ℝ) := -lipschitz_with_one_norm.uniform_continuous - -lemma uniform_continuous_nnnorm : uniform_continuous (λ (a : E), ∥a∥₊) := -uniform_continuous_subtype_mk uniform_continuous_norm _ - -/-- A helper lemma used to prove that the (scalar or usual) product of a function that tends to zero -and a bounded function tends to zero. This lemma is formulated for any binary operation -`op : E → F → G` with an estimate `∥op x y∥ ≤ A * ∥x∥ * ∥y∥` for some constant A instead of -multiplication so that it can be applied to `(*)`, `flip (*)`, `(•)`, and `flip (•)`. -/ -lemma filter.tendsto.op_zero_is_bounded_under_le' {f : α → E} {g : α → F} {l : filter α} - (hf : tendsto f l (𝓝 0)) (hg : is_bounded_under (≤) l (norm ∘ g)) (op : E → F → G) - (h_op : ∃ A, ∀ x y, ∥op x y∥ ≤ A * ∥x∥ * ∥y∥) : - tendsto (λ x, op (f x) (g x)) l (𝓝 0) := -begin - cases h_op with A h_op, - rcases hg with ⟨C, hC⟩, rw eventually_map at hC, - rw normed_group.tendsto_nhds_zero at hf ⊢, - intros ε ε₀, - rcases exists_pos_mul_lt ε₀ (A * C) with ⟨δ, δ₀, hδ⟩, - filter_upwards [hf δ δ₀, hC] with i hf hg, - refine (h_op _ _).trans_lt _, - cases le_total A 0 with hA hA, - { exact (mul_nonpos_of_nonpos_of_nonneg (mul_nonpos_of_nonpos_of_nonneg hA (norm_nonneg _)) - (norm_nonneg _)).trans_lt ε₀ }, - calc A * ∥f i∥ * ∥g i∥ ≤ A * δ * C : - mul_le_mul (mul_le_mul_of_nonneg_left hf.le hA) hg (norm_nonneg _) (mul_nonneg hA δ₀.le) - ... = A * C * δ : mul_right_comm _ _ _ - ... < ε : hδ -end +end has_norm -/-- A helper lemma used to prove that the (scalar or usual) product of a function that tends to zero -and a bounded function tends to zero. This lemma is formulated for any binary operation -`op : E → F → G` with an estimate `∥op x y∥ ≤ ∥x∥ * ∥y∥` instead of multiplication so that it -can be applied to `(*)`, `flip (*)`, `(•)`, and `flip (•)`. -/ -lemma filter.tendsto.op_zero_is_bounded_under_le {f : α → E} {g : α → F} {l : filter α} - (hf : tendsto f l (𝓝 0)) (hg : is_bounded_under (≤) l (norm ∘ g)) (op : E → F → G) - (h_op : ∀ x y, ∥op x y∥ ≤ ∥x∥ * ∥y∥) : - tendsto (λ x, op (f x) (g x)) l (𝓝 0) := -hf.op_zero_is_bounded_under_le' hg op ⟨1, λ x y, (one_mul (∥x∥)).symm ▸ h_op x y⟩ +section has_nnnorm +variables [has_nnnorm E] -section +instance : has_nnnorm (ulift E) := ⟨λ x, ‖x.down‖₊⟩ -variables {l : filter α} {f : α → E} {a : E} +lemma nnnorm_def (x : ulift E) : ‖x‖₊ = ‖x.down‖₊ := rfl +@[simp] lemma nnnorm_up (x : E) : ‖ulift.up x‖₊ = ‖x‖₊ := rfl +@[simp] lemma nnnorm_down (x : ulift E) : ‖x.down‖₊ = ‖x‖₊ := rfl -lemma filter.tendsto.norm (h : tendsto f l (𝓝 a)) : tendsto (λ x, ∥f x∥) l (𝓝 ∥a∥) := -tendsto_norm.comp h +end has_nnnorm -lemma filter.tendsto.nnnorm (h : tendsto f l (𝓝 a)) : - tendsto (λ x, ∥f x∥₊) l (𝓝 (∥a∥₊)) := -tendsto.comp continuous_nnnorm.continuous_at h +@[to_additive] instance seminormed_group [seminormed_group E] : seminormed_group (ulift E) := +seminormed_group.induced _ _ (⟨ulift.down, rfl, λ _ _, rfl⟩ : ulift E →* E) -end +@[to_additive] +instance seminormed_comm_group [seminormed_comm_group E] : seminormed_comm_group (ulift E) := +seminormed_comm_group.induced _ _ (⟨ulift.down, rfl, λ _ _, rfl⟩ : ulift E →* E) -section +@[to_additive] instance normed_group [normed_group E] : normed_group (ulift E) := +normed_group.induced _ _ (⟨ulift.down, rfl, λ _ _, rfl⟩ : ulift E →* E) down_injective -variables [topological_space α] {f : α → E} {s : set α} {a : α} {b : E} +@[to_additive] +instance normed_comm_group [normed_comm_group E] : normed_comm_group (ulift E) := +normed_comm_group.induced _ _ (⟨ulift.down, rfl, λ _ _, rfl⟩ : ulift E →* E) down_injective -lemma continuous.norm (h : continuous f) : continuous (λ x, ∥f x∥) := continuous_norm.comp h +end ulift -lemma continuous.nnnorm (h : continuous f) : continuous (λ x, ∥f x∥₊) := -continuous_nnnorm.comp h +/-! ### `additive`, `multiplicative` -/ -lemma continuous_at.norm (h : continuous_at f a) : continuous_at (λ x, ∥f x∥) a := h.norm +section additive_multiplicative -lemma continuous_at.nnnorm (h : continuous_at f a) : continuous_at (λ x, ∥f x∥₊) a := h.nnnorm +open additive multiplicative -lemma continuous_within_at.norm (h : continuous_within_at f s a) : - continuous_within_at (λ x, ∥f x∥) s a := -h.norm +section has_norm +variables [has_norm E] -lemma continuous_within_at.nnnorm (h : continuous_within_at f s a) : - continuous_within_at (λ x, ∥f x∥₊) s a := -h.nnnorm +instance : has_norm (additive E) := ‹has_norm E› +instance : has_norm (multiplicative E) := ‹has_norm E› -lemma continuous_on.norm (h : continuous_on f s) : continuous_on (λ x, ∥f x∥) s := -λ x hx, (h x hx).norm +@[simp] lemma norm_to_mul (x) : ‖(to_mul x : E)‖ = ‖x‖ := rfl +@[simp] lemma norm_of_mul (x : E) : ‖of_mul x‖ = ‖x‖ := rfl +@[simp] lemma norm_to_add (x) : ‖(to_add x : E)‖ = ‖x‖ := rfl +@[simp] lemma norm_of_add (x : E) : ‖of_add x‖ = ‖x‖ := rfl -lemma continuous_on.nnnorm (h : continuous_on f s) : continuous_on (λ x, ∥f x∥₊) s := -λ x hx, (h x hx).nnnorm +end has_norm -end +section has_nnnorm +variables [has_nnnorm E] -/-- If `∥y∥→∞`, then we can assume `y≠x` for any fixed `x`. -/ -lemma eventually_ne_of_tendsto_norm_at_top {l : filter α} {f : α → E} - (h : tendsto (λ y, ∥f y∥) l at_top) (x : E) : - ∀ᶠ y in l, f y ≠ x := -begin - have : ∀ᶠ y in l, 1 + ∥x∥ ≤ ∥f y∥ := h (mem_at_top (1 + ∥x∥)), - refine this.mono (λ y hy hxy, _), - subst x, - exact not_le_of_lt zero_lt_one (add_le_iff_nonpos_left.1 hy) -end +instance : has_nnnorm (additive E) := ‹has_nnnorm E› +instance : has_nnnorm (multiplicative E) := ‹has_nnnorm E› -@[priority 100] -- see Note [lower instance priority] -instance semi_normed_group.has_lipschitz_add : has_lipschitz_add E := -{ lipschitz_add := ⟨2, lipschitz_with.prod_fst.add lipschitz_with.prod_snd⟩ } +@[simp] lemma nnnorm_to_mul (x) : ‖(to_mul x : E)‖₊ = ‖x‖₊ := rfl +@[simp] lemma nnnorm_of_mul (x : E) : ‖of_mul x‖₊ = ‖x‖₊ := rfl +@[simp] lemma nnnorm_to_add (x) : ‖(to_add x : E)‖₊ = ‖x‖₊ := rfl +@[simp] lemma nnnorm_of_add (x : E) : ‖of_add x‖₊ = ‖x‖₊ := rfl -/-- A seminormed group is a uniform additive group, i.e., addition and subtraction are uniformly -continuous. -/ -@[priority 100] -- see Note [lower instance priority] -instance normed_uniform_group : uniform_add_group E := -⟨(lipschitz_with.prod_fst.sub lipschitz_with.prod_snd).uniform_continuous⟩ +end has_nnnorm -@[priority 100] -- see Note [lower instance priority] -instance normed_top_group : topological_add_group E := -by apply_instance -- short-circuit type class inference +instance [seminormed_group E] : seminormed_add_group (additive E) := +{ dist_eq := dist_eq_norm_div } -lemma nat.norm_cast_le [has_one E] : ∀ n : ℕ, ∥(n : E)∥ ≤ n * ∥(1 : E)∥ -| 0 := by simp -| (n + 1) := by { rw [n.cast_succ, n.cast_succ, add_mul, one_mul], - exact norm_add_le_of_le (nat.norm_cast_le n) le_rfl } +instance [seminormed_add_group E] : seminormed_group (multiplicative E) := +{ dist_eq := dist_eq_norm_sub } -lemma semi_normed_group.mem_closure_iff {s : set E} {x : E} : - x ∈ closure s ↔ ∀ ε > 0, ∃ y ∈ s, ∥x - y∥ < ε := -by simp [metric.mem_closure_iff, dist_eq_norm] +instance [seminormed_comm_group E] : seminormed_add_comm_group (additive E) := +{ ..additive.seminormed_add_group } -lemma norm_le_zero_iff' [separated_space E] {g : E} : - ∥g∥ ≤ 0 ↔ g = 0 := -begin - letI : normed_group E := { to_metric_space := of_t2_pseudo_metric_space ‹_›, - .. ‹semi_normed_group E› }, - rw [← dist_zero_right], exact dist_le_zero -end +instance [seminormed_add_comm_group E] : seminormed_comm_group (multiplicative E) := +{ ..multiplicative.seminormed_group } + +instance [normed_group E] : normed_add_group (additive E) := +{ ..additive.seminormed_add_group } + +instance [normed_add_group E] : normed_group (multiplicative E) := +{ ..multiplicative.seminormed_group } + +instance [normed_comm_group E] : normed_add_comm_group (additive E) := +{ ..additive.seminormed_add_group } + +instance [normed_add_comm_group E] : normed_comm_group (multiplicative E) := +{ ..multiplicative.seminormed_group } + +end additive_multiplicative + +/-! ### Order dual -/ + +section order_dual + +open order_dual + +section has_norm +variables [has_norm E] + +instance : has_norm Eᵒᵈ := ‹has_norm E› + +@[simp] lemma norm_to_dual (x : E) : ‖to_dual x‖ = ‖x‖ := rfl +@[simp] lemma norm_of_dual (x : Eᵒᵈ) : ‖of_dual x‖ = ‖x‖ := rfl + +end has_norm + +section has_nnnorm +variables [has_nnnorm E] + +instance : has_nnnorm Eᵒᵈ := ‹has_nnnorm E› + +@[simp] lemma nnnorm_to_dual (x : E) : ‖to_dual x‖₊ = ‖x‖₊ := rfl +@[simp] lemma nnnorm_of_dual (x : Eᵒᵈ) : ‖of_dual x‖₊ = ‖x‖₊ := rfl -lemma norm_eq_zero_iff' [separated_space E] {g : E} : ∥g∥ = 0 ↔ g = 0 := -(norm_nonneg g).le_iff_eq.symm.trans norm_le_zero_iff' +end has_nnnorm -lemma norm_pos_iff' [separated_space E] {g : E} : 0 < ∥g∥ ↔ g ≠ 0 := -by rw [← not_le, norm_le_zero_iff'] +@[priority 100, to_additive] -- See note [lower instance priority] +instance [seminormed_group E] : seminormed_group Eᵒᵈ := ‹seminormed_group E› -lemma cauchy_seq_sum_of_eventually_eq {u v : ℕ → E} {N : ℕ} (huv : ∀ n ≥ N, u n = v n) - (hv : cauchy_seq (λ n, ∑ k in range (n+1), v k)) : cauchy_seq (λ n, ∑ k in range (n + 1), u k) := +@[priority 100, to_additive] -- See note [lower instance priority] +instance [seminormed_comm_group E] : seminormed_comm_group Eᵒᵈ := ‹seminormed_comm_group E› + +@[priority 100, to_additive] -- See note [lower instance priority] +instance [normed_group E] : normed_group Eᵒᵈ := ‹normed_group E› + +@[priority 100, to_additive] -- See note [lower instance priority] +instance [normed_comm_group E] : normed_comm_group Eᵒᵈ := ‹normed_comm_group E› + +end order_dual + +/-! ### Binary product of normed groups -/ + +section has_norm +variables [has_norm E] [has_norm F] {x : E × F} {r : ℝ} + +instance : has_norm (E × F) := ⟨λ x, ‖x.1‖ ⊔ ‖x.2‖⟩ + +lemma prod.norm_def (x : E × F) : ‖x‖ = (max ‖x.1‖ ‖x.2‖) := rfl +lemma norm_fst_le (x : E × F) : ‖x.1‖ ≤ ‖x‖ := le_max_left _ _ +lemma norm_snd_le (x : E × F) : ‖x.2‖ ≤ ‖x‖ := le_max_right _ _ + +lemma norm_prod_le_iff : ‖x‖ ≤ r ↔ ‖x.1‖ ≤ r ∧ ‖x.2‖ ≤ r := max_le_iff + +end has_norm + +section seminormed_group +variables [seminormed_group E] [seminormed_group F] + +/-- Product of seminormed groups, using the sup norm. -/ +@[to_additive "Product of seminormed groups, using the sup norm."] +instance : seminormed_group (E × F) := +⟨λ x y, by simp only [prod.norm_def, prod.dist_eq, dist_eq_norm_div, prod.fst_div, prod.snd_div]⟩ + +@[to_additive prod.nnnorm_def'] +lemma prod.nnorm_def (x : E × F) : ‖x‖₊ = (max ‖x.1‖₊ ‖x.2‖₊) := rfl + +end seminormed_group + +/-- Product of seminormed groups, using the sup norm. -/ +@[to_additive "Product of seminormed groups, using the sup norm."] +instance [seminormed_comm_group E] [seminormed_comm_group F] : seminormed_comm_group (E × F) := +{ ..prod.seminormed_group } + +/-- Product of normed groups, using the sup norm. -/ +@[to_additive "Product of normed groups, using the sup norm."] +instance [normed_group E] [normed_group F] : normed_group (E × F) := { ..prod.seminormed_group } + +/-- Product of normed groups, using the sup norm. -/ +@[to_additive "Product of normed groups, using the sup norm."] +instance [normed_comm_group E] [normed_comm_group F] : normed_comm_group (E × F) := +{ ..prod.seminormed_group } + + +/-! ### Finite product of normed groups -/ + +section pi +variables {π : ι → Type*} [fintype ι] + +section seminormed_group +variables [Π i, seminormed_group (π i)] [seminormed_group E] (f : Π i, π i) {x : Π i, π i} {r : ℝ} + +/-- Finite product of seminormed groups, using the sup norm. -/ +@[to_additive "Finite product of seminormed groups, using the sup norm."] +instance : seminormed_group (Π i, π i) := +{ norm := λ f, ↑(finset.univ.sup (λ b, ‖f b‖₊)), + dist_eq := λ x y, + congr_arg (coe : ℝ≥0 → ℝ) $ congr_arg (finset.sup finset.univ) $ funext $ λ a, + show nndist (x a) (y a) = ‖x a / y a‖₊, from nndist_eq_nnnorm_div (x a) (y a) } + +@[to_additive pi.norm_def] lemma pi.norm_def' : ‖f‖ = ↑(finset.univ.sup (λ b, ‖f b‖₊)) := rfl +@[to_additive pi.nnnorm_def] lemma pi.nnnorm_def' : ‖f‖₊ = finset.univ.sup (λ b, ‖f b‖₊) := +subtype.eta _ _ + +/-- The seminorm of an element in a product space is `≤ r` if and only if the norm of each +component is. -/ +@[to_additive pi_norm_le_iff_of_nonneg "The seminorm of an element in a product space is `≤ r` if +and only if the norm of each component is."] +lemma pi_norm_le_iff_of_nonneg' (hr : 0 ≤ r) : ‖x‖ ≤ r ↔ ∀ i, ‖x i‖ ≤ r := +by simp only [←dist_one_right, dist_pi_le_iff hr, pi.one_apply] + +@[to_additive pi_nnnorm_le_iff] +lemma pi_nnnorm_le_iff' {r : ℝ≥0} : ‖x‖₊ ≤ r ↔ ∀ i, ‖x i‖₊ ≤ r := +pi_norm_le_iff_of_nonneg' r.coe_nonneg + +@[to_additive pi_norm_le_iff_of_nonempty] +lemma pi_norm_le_iff_of_nonempty' [nonempty ι] : ‖f‖ ≤ r ↔ ∀ b, ‖f b‖ ≤ r := begin - let d : ℕ → E := λ n, ∑ k in range (n + 1), (u k - v k), - rw show (λ n, ∑ k in range (n + 1), u k) = d + (λ n, ∑ k in range (n + 1), v k), - by { ext n, simp [d] }, - have : ∀ n ≥ N, d n = d N, - { intros n hn, - dsimp [d], - rw eventually_constant_sum _ hn, - intros m hm, - simp [huv m hm] }, - exact (tendsto_at_top_of_eventually_const this).cauchy_seq.add hv + by_cases hr : 0 ≤ r, + { exact pi_norm_le_iff_of_nonneg' hr }, + { exact iff_of_false (λ h, hr $ (norm_nonneg' _).trans h) + (λ h, hr $ (norm_nonneg' _).trans $ h $ classical.arbitrary _) } end -end semi_normed_group +/-- The seminorm of an element in a product space is `< r` if and only if the norm of each +component is. -/ +@[to_additive pi_norm_lt_iff "The seminorm of an element in a product space is `< r` if and only if +the norm of each component is."] +lemma pi_norm_lt_iff' (hr : 0 < r) : ‖x‖ < r ↔ ∀ i, ‖x i‖ < r := +by simp only [←dist_one_right, dist_pi_lt_iff hr, pi.one_apply] -section normed_group +@[to_additive pi_nnnorm_lt_iff] +lemma pi_nnnorm_lt_iff' {r : ℝ≥0} (hr : 0 < r) : ‖x‖₊ < r ↔ ∀ i, ‖x i‖₊ < r := pi_norm_lt_iff' hr -/-- Construct a normed group from a translation invariant distance -/ -def normed_group.of_add_dist [has_norm E] [add_comm_group E] [metric_space E] - (H1 : ∀ x : E, ∥x∥ = dist x 0) - (H2 : ∀ x y z : E, dist x y ≤ dist (x + z) (y + z)) : normed_group E := -{ dist_eq := λ x y, begin - rw H1, apply le_antisymm, - { rw [sub_eq_add_neg, ← add_right_neg y], apply H2 }, - { have := H2 (x-y) 0 y, rwa [sub_add_cancel, zero_add] at this } - end } +@[to_additive norm_le_pi_norm] +lemma norm_le_pi_norm' (i : ι) : ‖f i‖ ≤ ‖f‖ := +(pi_norm_le_iff_of_nonneg' $ norm_nonneg' _).1 le_rfl i -/-- A normed group can be built from a norm that satisfies algebraic properties. This is -formalised in this structure. -/ -structure normed_group.core (E : Type*) [add_comm_group E] [has_norm E] : Prop := -(norm_eq_zero_iff : ∀ x : E, ∥x∥ = 0 ↔ x = 0) -(triangle : ∀ x y : E, ∥x + y∥ ≤ ∥x∥ + ∥y∥) -(norm_neg : ∀ x : E, ∥-x∥ = ∥x∥) +@[to_additive nnnorm_le_pi_nnnorm] +lemma nnnorm_le_pi_nnnorm' (i : ι) : ‖f i‖₊ ≤ ‖f‖₊ := norm_le_pi_norm' _ i -/-- The `semi_normed_group.core` induced by a `normed_group.core`. -/ -lemma normed_group.core.to_semi_normed_group.core {E : Type*} [add_comm_group E] [has_norm E] - (C : normed_group.core E) : semi_normed_group.core E := -{ norm_zero := (C.norm_eq_zero_iff 0).2 rfl, - triangle := C.triangle, - norm_neg := C.norm_neg } +@[to_additive pi_norm_const_le] +lemma pi_norm_const_le' (a : E) : ‖(λ _ : ι, a)‖ ≤ ‖a‖ := +(pi_norm_le_iff_of_nonneg' $ norm_nonneg' _).2 $ λ _, le_rfl -/-- Constructing a normed group from core properties of a norm, i.e., registering the distance and -the metric space structure from the norm properties. -/ -def normed_group.of_core (E : Type*) [add_comm_group E] [has_norm E] - (C : normed_group.core E) : normed_group E := -{ eq_of_dist_eq_zero := λ x y h, - begin - rw [dist_eq_norm] at h, - exact sub_eq_zero.mp ((C.norm_eq_zero_iff _).1 h) - end - ..semi_normed_group.of_core E (normed_group.core.to_semi_normed_group.core C) } +@[to_additive pi_nnnorm_const_le] +lemma pi_nnnorm_const_le' (a : E) : ‖(λ _ : ι, a)‖₊ ≤ ‖a‖₊ := pi_norm_const_le' _ -variables [normed_group E] [normed_group F] +@[simp, to_additive pi_norm_const] +lemma pi_norm_const' [nonempty ι] (a : E) : ‖(λ i : ι, a)‖ = ‖a‖ := +by simpa only [←dist_one_right] using dist_pi_const a 1 -@[simp] lemma norm_eq_zero {g : E} : ∥g∥ = 0 ↔ g = 0 := norm_eq_zero_iff' +@[simp, to_additive pi_nnnorm_const] +lemma pi_nnnorm_const' [nonempty ι] (a : E) : ‖(λ i : ι, a)‖₊ = ‖a‖₊ := nnreal.eq $ pi_norm_const' a -lemma norm_ne_zero_iff {g : E} : ∥g∥ ≠ 0 ↔ g ≠ 0 := not_congr norm_eq_zero +/-- The $L^1$ norm is less than the $L^\infty$ norm scaled by the cardinality. -/ +@[to_additive pi.sum_norm_apply_le_norm "The $L^1$ norm is less than the $L^\\infty$ norm scaled by +the cardinality."] +lemma pi.sum_norm_apply_le_norm' : ∑ i, ‖f i‖ ≤ fintype.card ι • ‖f‖ := +finset.sum_le_card_nsmul _ _ _ $ λ i hi, norm_le_pi_norm' _ i -@[simp] lemma norm_pos_iff {g : E} : 0 < ∥ g ∥ ↔ g ≠ 0 := norm_pos_iff' +/-- The $L^1$ norm is less than the $L^\infty$ norm scaled by the cardinality. -/ +@[to_additive pi.sum_nnnorm_apply_le_nnnorm "The $L^1$ norm is less than the $L^\\infty$ norm scaled +by the cardinality."] +lemma pi.sum_nnnorm_apply_le_nnnorm' : ∑ i, ‖f i‖₊ ≤ fintype.card ι • ‖f‖₊ := +nnreal.coe_sum.trans_le $ pi.sum_norm_apply_le_norm' _ -@[simp] lemma norm_le_zero_iff {g : E} : ∥g∥ ≤ 0 ↔ g = 0 := norm_le_zero_iff' +end seminormed_group -lemma norm_sub_eq_zero_iff {u v : E} : ∥u - v∥ = 0 ↔ u = v := -by rw [norm_eq_zero, sub_eq_zero] +/-- Finite product of seminormed groups, using the sup norm. -/ +@[to_additive "Finite product of seminormed groups, using the sup norm."] +instance pi.seminormed_comm_group [Π i, seminormed_comm_group (π i)] : + seminormed_comm_group (Π i, π i) := +{ ..pi.seminormed_group } -lemma eq_of_norm_sub_le_zero {g h : E} (a : ∥g - h∥ ≤ 0) : g = h := -by rwa [← sub_eq_zero, ← norm_le_zero_iff] +/-- Finite product of normed groups, using the sup norm. -/ +@[to_additive "Finite product of seminormed groups, using the sup norm."] +instance pi.normed_group [Π i, normed_group (π i)] : normed_group (Π i, π i) := +{ ..pi.seminormed_group } -lemma eq_of_norm_sub_eq_zero {u v : E} (h : ∥u - v∥ = 0) : u = v := -norm_sub_eq_zero_iff.1 h +/-- Finite product of normed groups, using the sup norm. -/ +@[to_additive "Finite product of seminormed groups, using the sup norm."] +instance pi.normed_comm_group [Π i, normed_comm_group (π i)] : normed_comm_group (Π i, π i) := +{ ..pi.seminormed_group } -@[simp] lemma nnnorm_eq_zero {a : E} : ∥a∥₊ = 0 ↔ a = 0 := -by rw [← nnreal.coe_eq_zero, coe_nnnorm, norm_eq_zero] +end pi -lemma nnnorm_ne_zero_iff {g : E} : ∥g∥₊ ≠ 0 ↔ g ≠ 0 := not_congr nnnorm_eq_zero +/-! ### Multiplicative opposite -/ -/-- An injective group homomorphism from an `add_comm_group` to a `normed_group` induces a -`normed_group` structure on the domain. +namespace mul_opposite -See note [reducible non-instances]. -/ -@[reducible] -def normed_group.induced {E} [add_comm_group E] - (f : E →+ F) (h : function.injective f) : normed_group E := -{ .. semi_normed_group.induced f, - .. metric_space.induced f h normed_group.to_metric_space, } +/-- The (additive) norm on the multiplicative opposite is the same as the norm on the original type. -/-- A subgroup of a normed group is also a normed group, with the restriction of the norm. -/ -instance add_subgroup.normed_group (s : add_subgroup E) : normed_group s := -normed_group.induced s.subtype subtype.coe_injective +Note that we do not provide this more generally as `has_norm Eᵐᵒᵖ`, as this is not always a good +choice of norm in the multiplicative `seminormed_group E` case. -/-- A submodule of a normed group is also a normed group, with the restriction of the norm. +We could repeat this instance to provide a `[seminormed_group E] : seminormed_group Eᵃᵒᵖ` instance, +but that case would likely never be used. +-/ +instance [seminormed_add_group E] : seminormed_add_group Eᵐᵒᵖ := +{ norm := λ x, ‖x.unop‖, + dist_eq := λ _ _, dist_eq_norm _ _, + to_pseudo_metric_space := mul_opposite.pseudo_metric_space } -See note [implicit instance arguments]. -/ -instance submodule.normed_group {𝕜 : Type*} {_ : ring 𝕜} - {E : Type*} [normed_group E] {_ : module 𝕜 E} (s : submodule 𝕜 E) : normed_group s := -{ ..submodule.semi_normed_group s } +lemma norm_op [seminormed_add_group E] (a : E) : ‖mul_opposite.op a‖ = ‖a‖ := rfl +lemma norm_unop [seminormed_add_group E] (a : Eᵐᵒᵖ) : ‖mul_opposite.unop a‖ = ‖a‖ := rfl -/-- normed group instance on the product of two normed groups, using the sup norm. -/ -noncomputable instance prod.normed_group : normed_group (E × F) := { ..prod.semi_normed_group } +lemma nnnorm_op [seminormed_add_group E] (a : E) : ‖mul_opposite.op a‖₊ = ‖a‖₊ := rfl +lemma nnnorm_unop [seminormed_add_group E] (a : Eᵐᵒᵖ) : ‖mul_opposite.unop a‖₊ = ‖a‖₊ := rfl -/-- normed group instance on the product of finitely many normed groups, using the sup norm. -/ -noncomputable instance pi.normed_group {π : ι → Type*} [fintype ι] [∀i, normed_group (π i)] : - normed_group (Πi, π i) := { ..pi.semi_normed_group } +instance [normed_add_group E] : normed_add_group Eᵐᵒᵖ := +{ .. mul_opposite.seminormed_add_group } -lemma tendsto_norm_sub_self_punctured_nhds (a : E) : tendsto (λ x, ∥x - a∥) (𝓝[≠] a) (𝓝[>] 0) := -(tendsto_norm_sub_self a).inf $ tendsto_principal_principal.2 $ λ x hx, - norm_pos_iff.2 $ sub_ne_zero.2 hx +instance [seminormed_add_comm_group E] : seminormed_add_comm_group Eᵐᵒᵖ := +{ dist_eq := λ _ _, dist_eq_norm _ _ } -lemma tendsto_norm_nhds_within_zero : tendsto (norm : E → ℝ) (𝓝[≠] 0) (𝓝[>] 0) := -tendsto_norm_zero.inf $ tendsto_principal_principal.2 $ λ x, norm_pos_iff.2 +instance [normed_add_comm_group E] : normed_add_comm_group Eᵐᵒᵖ := +{ .. mul_opposite.seminormed_add_comm_group } -/-! Some relations with `has_compact_support` -/ +end mul_opposite -lemma has_compact_support_norm_iff [topological_space α] {f : α → E} : - has_compact_support (λ x, ∥ f x ∥) ↔ has_compact_support f := -has_compact_support_comp_left $ λ x, norm_eq_zero +/-! ### Subgroups of normed groups -/ -alias has_compact_support_norm_iff ↔ _ has_compact_support.norm +namespace subgroup +section seminormed_group +variables [seminormed_group E] {s : subgroup E} -lemma continuous.bounded_above_of_compact_support [topological_space α] {f : α → E} - (hf : continuous f) (hsupp : has_compact_support f) : ∃ C, ∀ x, ∥f x∥ ≤ C := -by simpa [bdd_above_def] using hf.norm.bdd_above_range_of_has_compact_support hsupp.norm +/-- A subgroup of a seminormed group is also a seminormed group, +with the restriction of the norm. -/ +@[to_additive "A subgroup of a seminormed group is also a seminormed group, +with the restriction of the norm."] +instance seminormed_group : seminormed_group s := seminormed_group.induced _ _ s.subtype +/-- If `x` is an element of a subgroup `s` of a seminormed group `E`, its norm in `s` is equal to +its norm in `E`. -/ +@[simp, to_additive "If `x` is an element of a subgroup `s` of a seminormed group `E`, its norm in +`s` is equal to its norm in `E`."] +lemma coe_norm (x : s) : ‖x‖ = ‖(x : E)‖ := rfl -end normed_group +/-- If `x` is an element of a subgroup `s` of a seminormed group `E`, its norm in `s` is equal to +its norm in `E`. + +This is a reversed version of the `simp` lemma `subgroup.coe_norm` for use by `norm_cast`. -/ +@[norm_cast, to_additive "If `x` is an element of a subgroup `s` of a seminormed group `E`, its norm +in `s` is equal to its norm in `E`. + +This is a reversed version of the `simp` lemma `add_subgroup.coe_norm` for use by `norm_cast`."] +lemma norm_coe {s : subgroup E} (x : s) : ‖(x : E)‖ = ‖x‖ := rfl + +end seminormed_group + +@[to_additive] instance seminormed_comm_group [seminormed_comm_group E] {s : subgroup E} : + seminormed_comm_group s := +seminormed_comm_group.induced _ _ s.subtype + +@[to_additive] instance normed_group [normed_group E] {s : subgroup E} : normed_group s := +normed_group.induced _ _ s.subtype subtype.coe_injective + +@[to_additive] +instance normed_comm_group [normed_comm_group E] {s : subgroup E} : normed_comm_group s := +normed_comm_group.induced _ _ s.subtype subtype.coe_injective + +end subgroup + +/-! ### Submodules of normed groups -/ + +namespace submodule + +/-- A submodule of a seminormed group is also a seminormed group, with the restriction of the norm. +-/ +-- See note [implicit instance arguments] +instance seminormed_add_comm_group {_ : ring 𝕜} [seminormed_add_comm_group E] {_ : module 𝕜 E} + (s : submodule 𝕜 E) : + seminormed_add_comm_group s := +seminormed_add_comm_group.induced _ _ s.subtype.to_add_monoid_hom + +/-- If `x` is an element of a submodule `s` of a normed group `E`, its norm in `s` is equal to its +norm in `E`. -/ +-- See note [implicit instance arguments]. +@[simp] lemma coe_norm {_ : ring 𝕜} [seminormed_add_comm_group E] {_ : module 𝕜 E} + {s : submodule 𝕜 E} (x : s) : + ‖x‖ = ‖(x : E)‖ := rfl + +/-- If `x` is an element of a submodule `s` of a normed group `E`, its norm in `E` is equal to its +norm in `s`. + +This is a reversed version of the `simp` lemma `submodule.coe_norm` for use by `norm_cast`. -/ +-- See note [implicit instance arguments]. +@[norm_cast] lemma norm_coe {_ : ring 𝕜} [seminormed_add_comm_group E] {_ : module 𝕜 E} + {s : submodule 𝕜 E} (x : s) : + ‖(x : E)‖ = ‖x‖ := rfl + +/-- A submodule of a normed group is also a normed group, with the restriction of the norm. -/ +-- See note [implicit instance arguments]. +instance {_ : ring 𝕜} [normed_add_comm_group E] {_ : module 𝕜 E} (s : submodule 𝕜 E) : + normed_add_comm_group s := +{ ..submodule.seminormed_add_comm_group s } + +end submodule diff --git a/src/analysis/normed/group/completion.lean b/src/analysis/normed/group/completion.lean index a5feedcfe3f58..44087d460df0c 100644 --- a/src/analysis/normed/group/completion.lean +++ b/src/analysis/normed/group/completion.lean @@ -10,6 +10,9 @@ import topology.metric_space.completion /-! # Completion of a normed group +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that the completion of a (semi)normed group is a normed group. ## Tags @@ -28,11 +31,11 @@ instance [uniform_space E] [has_norm E] : has_norm (completion E) := { norm := completion.extension has_norm.norm } -@[simp] lemma norm_coe {E} [semi_normed_group E] (x : E) : - ∥(x : completion E)∥ = ∥x∥ := +@[simp] lemma norm_coe {E} [seminormed_add_comm_group E] (x : E) : + ‖(x : completion E)‖ = ‖x‖ := completion.extension_coe uniform_continuous_norm x -instance [semi_normed_group E] : normed_group (completion E) := +instance [seminormed_add_comm_group E] : normed_add_comm_group (completion E) := { dist_eq := begin intros x y, diff --git a/src/analysis/normed/group/controlled_closure.lean b/src/analysis/normed/group/controlled_closure.lean new file mode 100644 index 0000000000000..e43218e83efbb --- /dev/null +++ b/src/analysis/normed/group/controlled_closure.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2021 Patrick Massot. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Patrick Massot +-/ +import analysis.normed.group.hom +import analysis.specific_limits.normed + +/-! # Extending a backward bound on a normed group homomorphism from a dense set + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Possible TODO (from the PR's review, https://github.com/leanprover-community/mathlib/pull/8498 ): +"This feels a lot like the second step in the proof of the Banach open mapping theorem +(`exists_preimage_norm_le`) ... wonder if it would be possible to refactor it using one of [the +lemmas in this file]." +-/ + +open filter finset +open_locale topology big_operators + +variables {G : Type*} [normed_add_comm_group G] [complete_space G] +variables {H : Type*} [normed_add_comm_group H] + +/-- Given `f : normed_add_group_hom G H` for some complete `G` and a subgroup `K` of `H`, if every +element `x` of `K` has a preimage under `f` whose norm is at most `C*‖x‖` then the same holds for +elements of the (topological) closure of `K` with constant `C+ε` instead of `C`, for any +positive `ε`. +-/ +lemma controlled_closure_of_complete {f : normed_add_group_hom G H} {K : add_subgroup H} + {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : f.surjective_on_with K C) : + f.surjective_on_with K.topological_closure (C + ε) := +begin + rintros (h : H) (h_in : h ∈ K.topological_closure), + /- We first get rid of the easy case where `h = 0`.-/ + by_cases hyp_h : h = 0, + { rw hyp_h, + use 0, + simp }, + /- The desired preimage will be constructed as the sum of a series. Convergence of + the series will be guaranteed by completeness of `G`. We first write `h` as the sum + of a sequence `v` of elements of `K` which starts close to `h` and then quickly goes to zero. + The sequence `b` below quantifies this. -/ + set b : ℕ → ℝ := λ i, (1/2)^i*(ε*‖h‖/2)/C, + have b_pos : ∀ i, 0 < b i, + { intro i, + field_simp [b, hC], + exact div_pos (mul_pos hε (norm_pos_iff.mpr hyp_h)) + (mul_pos (by norm_num : (0 : ℝ) < 2^i*2) hC) }, + obtain ⟨v : ℕ → H, lim_v : tendsto (λ (n : ℕ), ∑ k in range (n + 1), v k) at_top (𝓝 h), + v_in : ∀ n, v n ∈ K, hv₀ : ‖v 0 - h‖ < b 0, hv : ∀ n > 0, ‖v n‖ < b n⟩ := + controlled_sum_of_mem_closure h_in b_pos, + /- The controlled surjectivity assumption on `f` allows to build preimages `u n` for all + elements `v n` of the `v` sequence.-/ + have : ∀ n, ∃ m' : G, f m' = v n ∧ ‖m'‖ ≤ C * ‖v n‖ := λ (n : ℕ), hyp (v n) (v_in n), + choose u hu hnorm_u using this, + /- The desired series `s` is then obtained by summing `u`. We then check our choice of + `b` ensures `s` is Cauchy. -/ + set s : ℕ → G := λ n, ∑ k in range (n+1), u k, + have : cauchy_seq s, + { apply normed_add_comm_group.cauchy_series_of_le_geometric'' (by norm_num) one_half_lt_one, + rintro n (hn : n ≥ 1), + calc ‖u n‖ ≤ C*‖v n‖ : hnorm_u n + ... ≤ C * b n : mul_le_mul_of_nonneg_left (hv _ $ nat.succ_le_iff.mp hn).le hC.le + ... = (1/2)^n * (ε * ‖h‖/2) : by simp [b, mul_div_cancel' _ hC.ne.symm] + ... = (ε * ‖h‖/2) * (1/2)^n : mul_comm _ _ }, + /- We now show that the limit `g` of `s` is the desired preimage. -/ + obtain ⟨g : G, hg⟩ := cauchy_seq_tendsto_of_complete this, + refine ⟨g, _, _⟩, + { /- We indeed get a preimage. First note: -/ + have : f ∘ s = λ n, ∑ k in range (n + 1), v k, + { ext n, + simp [map_sum, hu] }, + /- In the above equality, the left-hand-side converges to `f g` by continuity of `f` and + definition of `g` while the right-hand-side converges to `h` by construction of `v` so + `g` is indeed a preimage of `h`. -/ + rw ← this at lim_v, + exact tendsto_nhds_unique ((f.continuous.tendsto g).comp hg) lim_v }, + { /- Then we need to estimate the norm of `g`, using our careful choice of `b`. -/ + suffices : ∀ n, ‖s n‖ ≤ (C + ε) * ‖h‖, + from le_of_tendsto' (continuous_norm.continuous_at.tendsto.comp hg) this, + intros n, + have hnorm₀ : ‖u 0‖ ≤ C*b 0 + C*‖h‖, + { have := calc + ‖v 0‖ ≤ ‖h‖ + ‖v 0 - h‖ : norm_le_insert' _ _ + ... ≤ ‖h‖ + b 0 : by apply add_le_add_left hv₀.le, + calc ‖u 0‖ ≤ C*‖v 0‖ : hnorm_u 0 + ... ≤ C*(‖h‖ + b 0) : mul_le_mul_of_nonneg_left this hC.le + ... = C * b 0 + C * ‖h‖ : by rw [add_comm, mul_add] }, + have : ∑ k in range (n + 1), C * b k ≤ ε * ‖h‖ := calc + ∑ k in range (n + 1), C * b k = (∑ k in range (n + 1), (1 / 2) ^ k) * (ε * ‖h‖ / 2) : + by simp only [b, mul_div_cancel' _ hC.ne.symm, ← sum_mul] + ... ≤ 2 * (ε * ‖h‖ / 2) : mul_le_mul_of_nonneg_right (sum_geometric_two_le _) + (by nlinarith [hε, norm_nonneg h]) + ... = ε * ‖h‖ : mul_div_cancel' _ two_ne_zero, + calc ‖s n‖ ≤ ∑ k in range (n+1), ‖u k‖ : norm_sum_le _ _ + ... = ∑ k in range n, ‖u (k + 1)‖ + ‖u 0‖ : sum_range_succ' _ _ + ... ≤ ∑ k in range n, C*‖v (k + 1)‖ + ‖u 0‖ : add_le_add_right (sum_le_sum (λ _ _, hnorm_u _)) _ + ... ≤ ∑ k in range n, C*b (k+1) + (C*b 0 + C*‖h‖) : + add_le_add (sum_le_sum (λ k _, mul_le_mul_of_nonneg_left (hv _ k.succ_pos).le hC.le)) hnorm₀ + ... = ∑ k in range (n+1), C*b k + C*‖h‖ : by rw [← add_assoc, sum_range_succ'] + ... ≤ (C+ε)*‖h‖ : by { rw [add_comm, add_mul], apply add_le_add_left this } } +end + +/-- Given `f : normed_add_group_hom G H` for some complete `G`, if every element `x` of the image of +an isometric immersion `j : normed_add_group_hom K H` has a preimage under `f` whose norm is at most +`C*‖x‖` then the same holds for elements of the (topological) closure of this image with constant +`C+ε` instead of `C`, for any positive `ε`. +This is useful in particular if `j` is the inclusion of a normed group into its completion +(in this case the closure is the full target group). +-/ +lemma controlled_closure_range_of_complete {f : normed_add_group_hom G H} + {K : Type*} [seminormed_add_comm_group K] {j : normed_add_group_hom K H} (hj : ∀ x, ‖j x‖ = ‖x‖) + {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : ∀ k, ∃ g, f g = j k ∧ ‖g‖ ≤ C*‖k‖) : + f.surjective_on_with j.range.topological_closure (C + ε) := +begin + replace hyp : ∀ h ∈ j.range, ∃ g, f g = h ∧ ‖g‖ ≤ C*‖h‖, + { intros h h_in, + rcases (j.mem_range _).mp h_in with ⟨k, rfl⟩, + rw hj, + exact hyp k }, + exact controlled_closure_of_complete hC hε hyp +end diff --git a/src/analysis/normed/group/hom.lean b/src/analysis/normed/group/hom.lean index cefa5097fd43d..3f6b02c9df52e 100644 --- a/src/analysis/normed/group/hom.lean +++ b/src/analysis/normed/group/hom.lean @@ -3,12 +3,14 @@ Copyright (c) 2021 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ - -import analysis.specific_limits.normed +import analysis.normed.group.basic /-! # Normed groups homomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file gathers definitions and elementary constructions about bounded group homomorphisms between normed (abelian) groups (abbreviated to "normed group homs"). @@ -20,60 +22,64 @@ simple constructions for normed group homs, like kernel, range and equalizer. Some easy other constructions are related to subgroups of normed groups. -Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the -theory of `semi_normed_group_hom` and we specialize to `normed_group_hom` when needed. +Since a lot of elementary properties don't require `‖x‖ = 0 → x = 0` we start setting up the +theory of `seminormed_add_group_hom` and we specialize to `normed_add_group_hom` when needed. -/ noncomputable theory open_locale nnreal big_operators /-- A morphism of seminormed abelian groups is a bounded group homomorphism. -/ -structure normed_group_hom (V W : Type*) [semi_normed_group V] [semi_normed_group W] := +structure normed_add_group_hom (V W : Type*) [seminormed_add_comm_group V] + [seminormed_add_comm_group W] := (to_fun : V → W) (map_add' : ∀ v₁ v₂, to_fun (v₁ + v₂) = to_fun v₁ + to_fun v₂) -(bound' : ∃ C, ∀ v, ∥to_fun v∥ ≤ C * ∥v∥) +(bound' : ∃ C, ∀ v, ‖to_fun v‖ ≤ C * ‖v‖) namespace add_monoid_hom -variables {V W : Type*} [semi_normed_group V] [semi_normed_group W] {f g : normed_group_hom V W} +variables {V W : Type*} [seminormed_add_comm_group V] [seminormed_add_comm_group W] + {f g : normed_add_group_hom V W} /-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition. -See `add_monoid_hom.mk_normed_group_hom'` for a version that uses `ℝ≥0` for the bound. -/ -def mk_normed_group_hom (f : V →+ W) - (C : ℝ) (h : ∀ v, ∥f v∥ ≤ C * ∥v∥) : normed_group_hom V W := +See `add_monoid_hom.mk_normed_add_group_hom'` for a version that uses `ℝ≥0` for the bound. -/ +def mk_normed_add_group_hom (f : V →+ W) + (C : ℝ) (h : ∀ v, ‖f v‖ ≤ C * ‖v‖) : normed_add_group_hom V W := { bound' := ⟨C, h⟩, ..f } /-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition. -See `add_monoid_hom.mk_normed_group_hom` for a version that uses `ℝ` for the bound. -/ -def mk_normed_group_hom' (f : V →+ W) (C : ℝ≥0) (hC : ∀ x, ∥f x∥₊ ≤ C * ∥x∥₊) : - normed_group_hom V W := +See `add_monoid_hom.mk_normed_add_group_hom` for a version that uses `ℝ` for the bound. -/ +def mk_normed_add_group_hom' (f : V →+ W) (C : ℝ≥0) (hC : ∀ x, ‖f x‖₊ ≤ C * ‖x‖₊) : + normed_add_group_hom V W := { bound' := ⟨C, hC⟩ .. f} end add_monoid_hom -lemma exists_pos_bound_of_bound {V W : Type*} [semi_normed_group V] [semi_normed_group W] - {f : V → W} (M : ℝ) (h : ∀x, ∥f x∥ ≤ M * ∥x∥) : - ∃ N, 0 < N ∧ ∀x, ∥f x∥ ≤ N * ∥x∥ := +lemma exists_pos_bound_of_bound {V W : Type*} [seminormed_add_comm_group V] + [seminormed_add_comm_group W] + {f : V → W} (M : ℝ) (h : ∀x, ‖f x‖ ≤ M * ‖x‖) : + ∃ N, 0 < N ∧ ∀x, ‖f x‖ ≤ N * ‖x‖ := ⟨max M 1, lt_of_lt_of_le zero_lt_one (le_max_right _ _), λx, calc - ∥f x∥ ≤ M * ∥x∥ : h x - ... ≤ max M 1 * ∥x∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) ⟩ + ‖f x‖ ≤ M * ‖x‖ : h x + ... ≤ max M 1 * ‖x‖ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) ⟩ -namespace normed_group_hom +namespace normed_add_group_hom -variables {V V₁ V₂ V₃ : Type*} -variables [semi_normed_group V] [semi_normed_group V₁] [semi_normed_group V₂] [semi_normed_group V₃] -variables {f g : normed_group_hom V₁ V₂} +variables {V V₁ V₂ V₃ : Type*} [seminormed_add_comm_group V] [seminormed_add_comm_group V₁] + [seminormed_add_comm_group V₂] [seminormed_add_comm_group V₃] +variables {f g : normed_add_group_hom V₁ V₂} -instance : has_coe_to_fun (normed_group_hom V₁ V₂) (λ _, V₁ → V₂) := ⟨normed_group_hom.to_fun⟩ +instance : has_coe_to_fun (normed_add_group_hom V₁ V₂) (λ _, V₁ → V₂) := +⟨normed_add_group_hom.to_fun⟩ -initialize_simps_projections normed_group_hom (to_fun → apply) +initialize_simps_projections normed_add_group_hom (to_fun → apply) lemma coe_inj (H : (f : V₁ → V₂) = g) : f = g := by cases f; cases g; congr'; exact funext H -lemma coe_injective : @function.injective (normed_group_hom V₁ V₂) (V₁ → V₂) coe_fn := +lemma coe_injective : @function.injective (normed_add_group_hom V₁ V₂) (V₁ → V₂) coe_fn := by apply coe_inj lemma coe_inj_iff : f = g ↔ (f : V₁ → V₂) = g := ⟨congr_arg _, coe_inj⟩ @@ -86,66 +92,60 @@ variables (f g) @[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl -@[simp] lemma coe_mk (f) (h₁) (h₂) (h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : normed_group_hom V₁ V₂) = f := rfl +@[simp] lemma coe_mk (f) (h₁) (h₂) (h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : normed_add_group_hom V₁ V₂) = f := rfl -@[simp] lemma coe_mk_normed_group_hom (f : V₁ →+ V₂) (C) (hC) : - ⇑(f.mk_normed_group_hom C hC) = f := rfl +@[simp] lemma coe_mk_normed_add_group_hom (f : V₁ →+ V₂) (C) (hC) : + ⇑(f.mk_normed_add_group_hom C hC) = f := rfl -@[simp] lemma coe_mk_normed_group_hom' (f : V₁ →+ V₂) (C) (hC) : - ⇑(f.mk_normed_group_hom' C hC) = f := rfl +@[simp] lemma coe_mk_normed_add_group_hom' (f : V₁ →+ V₂) (C) (hC) : + ⇑(f.mk_normed_add_group_hom' C hC) = f := rfl /-- The group homomorphism underlying a bounded group homomorphism. -/ -def to_add_monoid_hom (f : normed_group_hom V₁ V₂) : V₁ →+ V₂ := +def to_add_monoid_hom (f : normed_add_group_hom V₁ V₂) : V₁ →+ V₂ := add_monoid_hom.mk' f f.map_add' @[simp] lemma coe_to_add_monoid_hom : ⇑f.to_add_monoid_hom = f := rfl lemma to_add_monoid_hom_injective : - function.injective (@normed_group_hom.to_add_monoid_hom V₁ V₂ _ _) := + function.injective (@normed_add_group_hom.to_add_monoid_hom V₁ V₂ _ _) := λ f g h, coe_inj $ show ⇑f.to_add_monoid_hom = g, by { rw h, refl } @[simp] lemma mk_to_add_monoid_hom (f) (h₁) (h₂) : - (⟨f, h₁, h₂⟩ : normed_group_hom V₁ V₂).to_add_monoid_hom = add_monoid_hom.mk' f h₁ := rfl - -@[simp] lemma map_zero : f 0 = 0 := f.to_add_monoid_hom.map_zero - -@[simp] lemma map_add (x y) : f (x + y) = f x + f y := f.to_add_monoid_hom.map_add _ _ - -@[simp] lemma map_sum {ι : Type*} (v : ι → V₁) (s : finset ι) : - f (∑ i in s, v i) = ∑ i in s, f (v i) := -f.to_add_monoid_hom.map_sum _ _ - -@[simp] lemma map_sub (x y) : f (x - y) = f x - f y := f.to_add_monoid_hom.map_sub _ _ + (⟨f, h₁, h₂⟩ : normed_add_group_hom V₁ V₂).to_add_monoid_hom = add_monoid_hom.mk' f h₁ := rfl -@[simp] lemma map_neg (x) : f (-x) = -(f x) := f.to_add_monoid_hom.map_neg _ +instance : add_monoid_hom_class (normed_add_group_hom V₁ V₂) V₁ V₂ := +{ coe := coe_fn, + coe_injective' := coe_injective, + map_add := λ f, f.to_add_monoid_hom.map_add, + map_zero := λ f, f.to_add_monoid_hom.map_zero } -lemma bound : ∃ C, 0 < C ∧ ∀ x, ∥f x∥ ≤ C * ∥x∥ := +lemma bound : ∃ C, 0 < C ∧ ∀ x, ‖f x‖ ≤ C * ‖x‖ := let ⟨C, hC⟩ := f.bound' in exists_pos_bound_of_bound _ hC -theorem antilipschitz_of_norm_ge {K : ℝ≥0} (h : ∀ x, ∥x∥ ≤ K * ∥f x∥) : +theorem antilipschitz_of_norm_ge {K : ℝ≥0} (h : ∀ x, ‖x‖ ≤ K * ‖f x‖) : antilipschitz_with K f := antilipschitz_with.of_le_mul_dist $ -λ x y, by simpa only [dist_eq_norm, f.map_sub] using h (x - y) +λ x y, by simpa only [dist_eq_norm, map_sub] using h (x - y) /-- A normed group hom is surjective on the subgroup `K` with constant `C` if every element -`x` of `K` has a preimage whose norm is bounded above by `C*∥x∥`. This is a more +`x` of `K` has a preimage whose norm is bounded above by `C*‖x‖`. This is a more abstract version of `f` having a right inverse defined on `K` with operator norm at most `C`. -/ -def surjective_on_with (f : normed_group_hom V₁ V₂) (K : add_subgroup V₂) (C : ℝ) : Prop := - ∀ h ∈ K, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥ +def surjective_on_with (f : normed_add_group_hom V₁ V₂) (K : add_subgroup V₂) (C : ℝ) : Prop := + ∀ h ∈ K, ∃ g, f g = h ∧ ‖g‖ ≤ C*‖h‖ -lemma surjective_on_with.mono {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C C' : ℝ} +lemma surjective_on_with.mono {f : normed_add_group_hom V₁ V₂} {K : add_subgroup V₂} {C C' : ℝ} (h : f.surjective_on_with K C) (H : C ≤ C') : f.surjective_on_with K C' := begin intros k k_in, rcases h k k_in with ⟨g, rfl, hg⟩, use [g, rfl], - by_cases Hg : ∥f g∥ = 0, + by_cases Hg : ‖f g‖ = 0, { simpa [Hg] using hg }, { exact hg.trans ((mul_le_mul_right $ (ne.symm Hg).le_iff_lt.mp (norm_nonneg _)).mpr H) } end -lemma surjective_on_with.exists_pos {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ} +lemma surjective_on_with.exists_pos {f : normed_add_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ} (h : f.surjective_on_with K C) : ∃ C' > 0, f.surjective_on_with K C' := begin refine ⟨|C| + 1, _, _⟩, @@ -154,111 +154,113 @@ begin linarith [le_abs_self C] } end -lemma surjective_on_with.surj_on {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ} +lemma surjective_on_with.surj_on {f : normed_add_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ} (h : f.surjective_on_with K C) : set.surj_on f set.univ K := λ x hx, (h x hx).imp $ λ a ⟨ha, _⟩, ⟨set.mem_univ _, ha⟩ /-! ### The operator norm -/ /-- The operator norm of a seminormed group homomorphism is the inf of all its bounds. -/ -def op_norm (f : normed_group_hom V₁ V₂) := Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} -instance has_op_norm : has_norm (normed_group_hom V₁ V₂) := ⟨op_norm⟩ +def op_norm (f : normed_add_group_hom V₁ V₂) := Inf {c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖} +instance has_op_norm : has_norm (normed_add_group_hom V₁ V₂) := ⟨op_norm⟩ -lemma norm_def : ∥f∥ = Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} := rfl +lemma norm_def : ‖f‖ = Inf {c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖} := rfl -- So that invocations of `le_cInf` make sense: we show that the set of -- bounds is nonempty and bounded below. -lemma bounds_nonempty {f : normed_group_hom V₁ V₂} : - ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥ } := +lemma bounds_nonempty {f : normed_add_group_hom V₁ V₂} : + ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖ } := let ⟨M, hMp, hMb⟩ := f.bound in ⟨M, le_of_lt hMp, hMb⟩ -lemma bounds_bdd_below {f : normed_group_hom V₁ V₂} : - bdd_below {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} := +lemma bounds_bdd_below {f : normed_add_group_hom V₁ V₂} : + bdd_below {c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖} := ⟨0, λ _ ⟨hn, _⟩, hn⟩ -lemma op_norm_nonneg : 0 ≤ ∥f∥ := +lemma op_norm_nonneg : 0 ≤ ‖f‖ := le_cInf bounds_nonempty (λ _ ⟨hx, _⟩, hx) -/-- The fundamental property of the operator norm: `∥f x∥ ≤ ∥f∥ * ∥x∥`. -/ -theorem le_op_norm (x : V₁) : ∥f x∥ ≤ ∥f∥ * ∥x∥ := +/-- The fundamental property of the operator norm: `‖f x‖ ≤ ‖f‖ * ‖x‖`. -/ +theorem le_op_norm (x : V₁) : ‖f x‖ ≤ ‖f‖ * ‖x‖ := begin obtain ⟨C, Cpos, hC⟩ := f.bound, replace hC := hC x, - by_cases h : ∥x∥ = 0, + by_cases h : ‖x‖ = 0, { rwa [h, mul_zero] at ⊢ hC }, - have hlt : 0 < ∥x∥ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h), + have hlt : 0 < ‖x‖ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h), exact (div_le_iff hlt).mp (le_cInf bounds_nonempty (λ c ⟨_, hc⟩, (div_le_iff hlt).mpr $ by { apply hc })), end -theorem le_op_norm_of_le {c : ℝ} {x} (h : ∥x∥ ≤ c) : ∥f x∥ ≤ ∥f∥ * c := +theorem le_op_norm_of_le {c : ℝ} {x} (h : ‖x‖ ≤ c) : ‖f x‖ ≤ ‖f‖ * c := le_trans (f.le_op_norm x) (mul_le_mul_of_nonneg_left h f.op_norm_nonneg) -theorem le_of_op_norm_le {c : ℝ} (h : ∥f∥ ≤ c) (x : V₁) : ∥f x∥ ≤ c * ∥x∥ := +theorem le_of_op_norm_le {c : ℝ} (h : ‖f‖ ≤ c) (x : V₁) : ‖f x‖ ≤ c * ‖x‖ := (f.le_op_norm x).trans (mul_le_mul_of_nonneg_right h (norm_nonneg x)) /-- continuous linear maps are Lipschitz continuous. -/ -theorem lipschitz : lipschitz_with ⟨∥f∥, op_norm_nonneg f⟩ f := +theorem lipschitz : lipschitz_with ⟨‖f‖, op_norm_nonneg f⟩ f := lipschitz_with.of_dist_le_mul $ λ x y, by { rw [dist_eq_norm, dist_eq_norm, ←map_sub], apply le_op_norm } -protected lemma uniform_continuous (f : normed_group_hom V₁ V₂) : +protected lemma uniform_continuous (f : normed_add_group_hom V₁ V₂) : uniform_continuous f := f.lipschitz.uniform_continuous @[continuity] -protected lemma continuous (f : normed_group_hom V₁ V₂) : continuous f := +protected lemma continuous (f : normed_add_group_hom V₁ V₂) : continuous f := f.uniform_continuous.continuous -lemma ratio_le_op_norm (x : V₁) : ∥f x∥ / ∥x∥ ≤ ∥f∥ := +lemma ratio_le_op_norm (x : V₁) : ‖f x‖ / ‖x‖ ≤ ‖f‖ := div_le_of_nonneg_of_le_mul (norm_nonneg _) f.op_norm_nonneg (le_op_norm _ _) /-- If one controls the norm of every `f x`, then one controls the norm of `f`. -/ -lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ∥f x∥ ≤ M * ∥x∥) : - ∥f∥ ≤ M := +lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ‖f x‖ ≤ M * ‖x‖) : + ‖f‖ ≤ M := cInf_le bounds_bdd_below ⟨hMp, hM⟩ lemma op_norm_eq_of_bounds {M : ℝ} (M_nonneg : 0 ≤ M) - (h_above : ∀ x, ∥f x∥ ≤ M*∥x∥) (h_below : ∀ N ≥ 0, (∀ x, ∥f x∥ ≤ N*∥x∥) → M ≤ N) : - ∥f∥ = M := + (h_above : ∀ x, ‖f x‖ ≤ M*‖x‖) (h_below : ∀ N ≥ 0, (∀ x, ‖f x‖ ≤ N*‖x‖) → M ≤ N) : + ‖f‖ = M := le_antisymm (f.op_norm_le_bound M_nonneg h_above) - ((le_cInf_iff normed_group_hom.bounds_bdd_below ⟨M, M_nonneg, h_above⟩).mpr $ + ((le_cInf_iff normed_add_group_hom.bounds_bdd_below ⟨M, M_nonneg, h_above⟩).mpr $ λ N ⟨N_nonneg, hN⟩, h_below N N_nonneg hN) -theorem op_norm_le_of_lipschitz {f : normed_group_hom V₁ V₂} {K : ℝ≥0} (hf : lipschitz_with K f) : - ∥f∥ ≤ K := -f.op_norm_le_bound K.2 $ λ x, by simpa only [dist_zero_right, f.map_zero] using hf.dist_le_mul x 0 +theorem op_norm_le_of_lipschitz {f : normed_add_group_hom V₁ V₂} {K : ℝ≥0} + (hf : lipschitz_with K f) : + ‖f‖ ≤ K := +f.op_norm_le_bound K.2 $ λ x, by simpa only [dist_zero_right, map_zero] using hf.dist_le_mul x 0 /-- If a bounded group homomorphism map is constructed from a group homomorphism via the constructor -`mk_normed_group_hom`, then its norm is bounded by the bound given to the constructor if it is +`mk_normed_add_group_hom`, then its norm is bounded by the bound given to the constructor if it is nonnegative. -/ -lemma mk_normed_group_hom_norm_le (f : V₁ →+ V₂) {C : ℝ} (hC : 0 ≤ C) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - ∥f.mk_normed_group_hom C h∥ ≤ C := +lemma mk_normed_add_group_hom_norm_le (f : V₁ →+ V₂) {C : ℝ} (hC : 0 ≤ C) + (h : ∀ x, ‖f x‖ ≤ C * ‖x‖) : + ‖f.mk_normed_add_group_hom C h‖ ≤ C := op_norm_le_bound _ hC h /-- If a bounded group homomorphism map is constructed from a group homomorphism -via the constructor `mk_normed_group_hom`, then its norm is bounded by the bound +via the constructor `mk_normed_add_group_hom`, then its norm is bounded by the bound given to the constructor or zero if this bound is negative. -/ -lemma mk_normed_group_hom_norm_le' (f : V₁ →+ V₂) {C : ℝ} (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - ∥f.mk_normed_group_hom C h∥ ≤ max C 0 := +lemma mk_normed_add_group_hom_norm_le' (f : V₁ →+ V₂) {C : ℝ} (h : ∀x, ‖f x‖ ≤ C * ‖x‖) : + ‖f.mk_normed_add_group_hom C h‖ ≤ max C 0 := op_norm_le_bound _ (le_max_right _ _) $ λ x, (h x).trans $ mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg x) -alias mk_normed_group_hom_norm_le ← add_monoid_hom.mk_normed_group_hom_norm_le -alias mk_normed_group_hom_norm_le' ← add_monoid_hom.mk_normed_group_hom_norm_le' +alias mk_normed_add_group_hom_norm_le ← _root_.add_monoid_hom.mk_normed_add_group_hom_norm_le +alias mk_normed_add_group_hom_norm_le' ← _root_.add_monoid_hom.mk_normed_add_group_hom_norm_le' /-! ### Addition of normed group homs -/ /-- Addition of normed group homs. -/ -instance : has_add (normed_group_hom V₁ V₂) := -⟨λ f g, (f.to_add_monoid_hom + g.to_add_monoid_hom).mk_normed_group_hom (∥f∥ + ∥g∥) $ λ v, calc - ∥f v + g v∥ - ≤ ∥f v∥ + ∥g v∥ : norm_add_le _ _ - ... ≤ ∥f∥ * ∥v∥ + ∥g∥ * ∥v∥ : add_le_add (le_op_norm f v) (le_op_norm g v) - ... = (∥f∥ + ∥g∥) * ∥v∥ : by rw add_mul⟩ +instance : has_add (normed_add_group_hom V₁ V₂) := +⟨λ f g, (f.to_add_monoid_hom + g.to_add_monoid_hom).mk_normed_add_group_hom (‖f‖ + ‖g‖) $ λ v, calc + ‖f v + g v‖ + ≤ ‖f v‖ + ‖g v‖ : norm_add_le _ _ + ... ≤ ‖f‖ * ‖v‖ + ‖g‖ * ‖v‖ : add_le_add (le_op_norm f v) (le_op_norm g v) + ... = (‖f‖ + ‖g‖) * ‖v‖ : by rw add_mul⟩ /-- The operator norm satisfies the triangle inequality. -/ -theorem op_norm_add_le : ∥f + g∥ ≤ ∥f∥ + ∥g∥ := -mk_normed_group_hom_norm_le _ (add_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _ +theorem op_norm_add_le : ‖f + g‖ ≤ ‖f‖ + ‖g‖ := +mk_normed_add_group_hom_norm_le _ (add_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _ /-- Terms containing `@has_add.add (has_coe_to_fun.F ...) pi.has_add` @@ -269,35 +271,35 @@ As a workaround, we add a type annotation: `(f + g : V₁ → V₂)` library_note "addition on function coercions" -- see Note [addition on function coercions] -@[simp] lemma coe_add (f g : normed_group_hom V₁ V₂) : ⇑(f + g) = (f + g : V₁ → V₂) := rfl -@[simp] lemma add_apply (f g : normed_group_hom V₁ V₂) (v : V₁) : - (f + g : normed_group_hom V₁ V₂) v = f v + g v := rfl +@[simp] lemma coe_add (f g : normed_add_group_hom V₁ V₂) : ⇑(f + g) = (f + g : V₁ → V₂) := rfl +@[simp] lemma add_apply (f g : normed_add_group_hom V₁ V₂) (v : V₁) : + (f + g : normed_add_group_hom V₁ V₂) v = f v + g v := rfl /-! ### The zero normed group hom -/ -instance : has_zero (normed_group_hom V₁ V₂) := -⟨(0 : V₁ →+ V₂).mk_normed_group_hom 0 (by simp)⟩ +instance : has_zero (normed_add_group_hom V₁ V₂) := +⟨(0 : V₁ →+ V₂).mk_normed_add_group_hom 0 (by simp)⟩ -instance : inhabited (normed_group_hom V₁ V₂) := ⟨0⟩ +instance : inhabited (normed_add_group_hom V₁ V₂) := ⟨0⟩ /-- The norm of the `0` operator is `0`. -/ -theorem op_norm_zero : ∥(0 : normed_group_hom V₁ V₂)∥ = 0 := +theorem op_norm_zero : ‖(0 : normed_add_group_hom V₁ V₂)‖ = 0 := le_antisymm (cInf_le bounds_bdd_below ⟨ge_of_eq rfl, λ _, le_of_eq (by { rw [zero_mul], exact norm_zero })⟩) (op_norm_nonneg _) /-- For normed groups, an operator is zero iff its norm vanishes. -/ -theorem op_norm_zero_iff {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂] - {f : normed_group_hom V₁ V₂} : ∥f∥ = 0 ↔ f = 0 := +theorem op_norm_zero_iff {V₁ V₂ : Type*} [normed_add_comm_group V₁] [normed_add_comm_group V₂] + {f : normed_add_group_hom V₁ V₂} : ‖f‖ = 0 ↔ f = 0 := iff.intro (λ hn, ext (λ x, norm_le_zero_iff.1 - (calc _ ≤ ∥f∥ * ∥x∥ : le_op_norm _ _ + (calc _ ≤ ‖f‖ * ‖x‖ : le_op_norm _ _ ... = _ : by rw [hn, zero_mul]))) (λ hf, by rw [hf, op_norm_zero] ) -- see Note [addition on function coercions] -@[simp] lemma coe_zero : ⇑(0 : normed_group_hom V₁ V₂) = (0 : V₁ → V₂) := rfl -@[simp] lemma zero_apply (v : V₁) : (0 : normed_group_hom V₁ V₂) v = 0 := rfl +@[simp] lemma coe_zero : ⇑(0 : normed_add_group_hom V₁ V₂) = (0 : V₁ → V₂) := rfl +@[simp] lemma zero_apply (v : V₁) : (0 : normed_add_group_hom V₁ V₂) v = 0 := rfl variables {f g} @@ -307,51 +309,51 @@ variable (V) /-- The identity as a continuous normed group hom. -/ @[simps] -def id : normed_group_hom V V := -(add_monoid_hom.id V).mk_normed_group_hom 1 (by simp [le_refl]) +def id : normed_add_group_hom V V := +(add_monoid_hom.id V).mk_normed_add_group_hom 1 (by simp [le_refl]) /-- The norm of the identity is at most `1`. It is in fact `1`, except when the norm of every element vanishes, where it is `0`. (Since we are working with seminorms this can happen even if the space is non-trivial.) It means that one can not do better than an inequality in general. -/ -lemma norm_id_le : ∥(id V : normed_group_hom V V)∥ ≤ 1 := +lemma norm_id_le : ‖(id V : normed_add_group_hom V V)‖ ≤ 1 := op_norm_le_bound _ zero_le_one (λx, by simp) /-- If there is an element with norm different from `0`, then the norm of the identity equals `1`. (Since we are working with seminorms supposing that the space is non-trivial is not enough.) -/ -lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : V), ∥x∥ ≠ 0 ) : - ∥(id V)∥ = 1 := +lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : V), ‖x‖ ≠ 0 ) : + ‖(id V)‖ = 1 := le_antisymm (norm_id_le V) $ let ⟨x, hx⟩ := h in have _ := (id V).ratio_le_op_norm x, by rwa [id_apply, div_self hx] at this /-- If a normed space is non-trivial, then the norm of the identity equals `1`. -/ -lemma norm_id {V : Type*} [normed_group V] [nontrivial V] : ∥(id V)∥ = 1 := +lemma norm_id {V : Type*} [normed_add_comm_group V] [nontrivial V] : ‖(id V)‖ = 1 := begin refine norm_id_of_nontrivial_seminorm V _, obtain ⟨x, hx⟩ := exists_ne (0 : V), exact ⟨x, ne_of_gt (norm_pos_iff.2 hx)⟩, end -lemma coe_id : ((normed_group_hom.id V) : V → V) = (_root_.id : V → V) := rfl +lemma coe_id : ((normed_add_group_hom.id V) : V → V) = (_root_.id : V → V) := rfl /-! ### The negation of a normed group hom -/ /-- Opposite of a normed group hom. -/ -instance : has_neg (normed_group_hom V₁ V₂) := -⟨λ f, (-f.to_add_monoid_hom).mk_normed_group_hom (∥f∥) (λ v, by simp [le_op_norm f v])⟩ +instance : has_neg (normed_add_group_hom V₁ V₂) := +⟨λ f, (-f.to_add_monoid_hom).mk_normed_add_group_hom (‖f‖) (λ v, by simp [le_op_norm f v])⟩ -- see Note [addition on function coercions] -@[simp] lemma coe_neg (f : normed_group_hom V₁ V₂) : ⇑(-f) = (-f : V₁ → V₂) := rfl -@[simp] lemma neg_apply (f : normed_group_hom V₁ V₂) (v : V₁) : - (-f : normed_group_hom V₁ V₂) v = - (f v) := rfl +@[simp] lemma coe_neg (f : normed_add_group_hom V₁ V₂) : ⇑(-f) = (-f : V₁ → V₂) := rfl +@[simp] lemma neg_apply (f : normed_add_group_hom V₁ V₂) (v : V₁) : + (-f : normed_add_group_hom V₁ V₂) v = - (f v) := rfl -lemma op_norm_neg (f : normed_group_hom V₁ V₂) : ∥-f∥ = ∥f∥ := +lemma op_norm_neg (f : normed_add_group_hom V₁ V₂) : ‖-f‖ = ‖f‖ := by simp only [norm_def, coe_neg, norm_neg, pi.neg_apply] /-! ### Subtraction of normed group homs -/ /-- Subtraction of normed group homs. -/ -instance : has_sub (normed_group_hom V₁ V₂) := +instance : has_sub (normed_add_group_hom V₁ V₂) := ⟨λ f g, { bound' := begin @@ -361,48 +363,49 @@ instance : has_sub (normed_group_hom V₁ V₂) := .. (f.to_add_monoid_hom - g.to_add_monoid_hom) }⟩ -- see Note [addition on function coercions] -@[simp] lemma coe_sub (f g : normed_group_hom V₁ V₂) : ⇑(f - g) = (f - g : V₁ → V₂) := rfl -@[simp] lemma sub_apply (f g : normed_group_hom V₁ V₂) (v : V₁) : - (f - g : normed_group_hom V₁ V₂) v = f v - g v := rfl +@[simp] lemma coe_sub (f g : normed_add_group_hom V₁ V₂) : ⇑(f - g) = (f - g : V₁ → V₂) := rfl +@[simp] lemma sub_apply (f g : normed_add_group_hom V₁ V₂) (v : V₁) : + (f - g : normed_add_group_hom V₁ V₂) v = f v - g v := rfl /-! ### Scalar actions on normed group homs -/ -section has_scalar +section has_smul variables {R R' : Type*} [monoid_with_zero R] [distrib_mul_action R V₂] [pseudo_metric_space R] [has_bounded_smul R V₂] [monoid_with_zero R'] [distrib_mul_action R' V₂] [pseudo_metric_space R'] [has_bounded_smul R' V₂] -instance : has_scalar R (normed_group_hom V₁ V₂) := +instance : has_smul R (normed_add_group_hom V₁ V₂) := { smul := λ r f, { to_fun := r • f, map_add' := (r • f.to_add_monoid_hom).map_add', bound' := let ⟨b, hb⟩ := f.bound' in ⟨dist r 0 * b, λ x, begin have := dist_smul_pair r (f x) (f 0), - rw [f.map_zero, smul_zero, dist_zero_right, dist_zero_right] at this, + rw [map_zero, smul_zero, dist_zero_right, dist_zero_right] at this, rw mul_assoc, refine this.trans _, refine mul_le_mul_of_nonneg_left _ dist_nonneg, exact hb x end⟩ } } -@[simp] lemma coe_smul (r : R) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl -@[simp] lemma smul_apply (r : R) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl +@[simp] lemma coe_smul (r : R) (f : normed_add_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl +@[simp] lemma smul_apply (r : R) (f : normed_add_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := +rfl -instance [smul_comm_class R R' V₂] : smul_comm_class R R' (normed_group_hom V₁ V₂) := +instance [smul_comm_class R R' V₂] : smul_comm_class R R' (normed_add_group_hom V₁ V₂) := { smul_comm := λ r r' f, ext $ λ v, smul_comm _ _ _ } -instance [has_scalar R R'] [is_scalar_tower R R' V₂] : - is_scalar_tower R R' (normed_group_hom V₁ V₂) := +instance [has_smul R R'] [is_scalar_tower R R' V₂] : + is_scalar_tower R R' (normed_add_group_hom V₁ V₂) := { smul_assoc := λ r r' f, ext $ λ v, smul_assoc _ _ _ } instance [distrib_mul_action Rᵐᵒᵖ V₂] [is_central_scalar R V₂] : - is_central_scalar R (normed_group_hom V₁ V₂) := + is_central_scalar R (normed_add_group_hom V₁ V₂) := { op_smul_eq_smul := λ r f, ext $ λ v, op_smul_eq_smul _ _ } -end has_scalar +end has_smul -instance has_nat_scalar : has_scalar ℕ (normed_group_hom V₁ V₂) := +instance has_nat_scalar : has_smul ℕ (normed_add_group_hom V₁ V₂) := { smul := λ n f, { to_fun := n • f, map_add' := (n • f.to_add_monoid_hom).map_add', @@ -411,48 +414,61 @@ instance has_nat_scalar : has_scalar ℕ (normed_group_hom V₁ V₂) := exact (norm_nsmul_le _ _).trans (mul_le_mul_of_nonneg_left (hb _) (nat.cast_nonneg _)), end⟩ } } -@[simp] lemma coe_nsmul (r : ℕ) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl -@[simp] lemma nsmul_apply (r : ℕ) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl +@[simp] lemma coe_nsmul (r : ℕ) (f : normed_add_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl +@[simp] lemma nsmul_apply (r : ℕ) (f : normed_add_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := +rfl -instance has_int_scalar : has_scalar ℤ (normed_group_hom V₁ V₂) := +instance has_int_scalar : has_smul ℤ (normed_add_group_hom V₁ V₂) := { smul := λ z f, { to_fun := z • f, map_add' := (z • f.to_add_monoid_hom).map_add', - bound' := let ⟨b, hb⟩ := f.bound' in ⟨∥z∥ • b, λ v, begin + bound' := let ⟨b, hb⟩ := f.bound' in ⟨‖z‖ • b, λ v, begin rw [pi.smul_apply, smul_eq_mul, mul_assoc], exact (norm_zsmul_le _ _).trans (mul_le_mul_of_nonneg_left (hb _) $ norm_nonneg _), end⟩ } } -@[simp] lemma coe_zsmul (r : ℤ) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl -@[simp] lemma zsmul_apply (r : ℤ) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl +@[simp] lemma coe_zsmul (r : ℤ) (f : normed_add_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl +@[simp] lemma zsmul_apply (r : ℤ) (f : normed_add_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := +rfl /-! ### Normed group structure on normed group homs -/ /-- Homs between two given normed groups form a commutative additive group. -/ -instance : add_comm_group (normed_group_hom V₁ V₂) := +instance : add_comm_group (normed_add_group_hom V₁ V₂) := coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) /-- Normed group homomorphisms themselves form a seminormed group with respect to the operator norm. -/ -instance to_semi_normed_group : semi_normed_group (normed_group_hom V₁ V₂) := -semi_normed_group.of_core _ ⟨op_norm_zero, op_norm_add_le, op_norm_neg⟩ +instance to_seminormed_add_comm_group : seminormed_add_comm_group (normed_add_group_hom V₁ V₂) := +add_group_seminorm.to_seminormed_add_comm_group +{ to_fun := op_norm, + map_zero' := op_norm_zero, + neg' := op_norm_neg, + add_le' := op_norm_add_le } /-- Normed group homomorphisms themselves form a normed group with respect to the operator norm. -/ -instance to_normed_group {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂] : - normed_group (normed_group_hom V₁ V₂) := -normed_group.of_core _ ⟨λ f, op_norm_zero_iff, op_norm_add_le, op_norm_neg⟩ - -/-- Coercion of a `normed_group_hom` is an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn` -/ +instance to_normed_add_comm_group {V₁ V₂ : Type*} [normed_add_comm_group V₁] + [normed_add_comm_group V₂] : + normed_add_comm_group (normed_add_group_hom V₁ V₂) := +add_group_norm.to_normed_add_comm_group +{ to_fun := op_norm, + map_zero' := op_norm_zero, + neg' := op_norm_neg, + add_le' := op_norm_add_le, + eq_zero_of_map_eq_zero' := λ f, op_norm_zero_iff.1 } + +/-- Coercion of a `normed_add_group_hom` is an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`. +-/ @[simps] -def coe_fn_add_hom : normed_group_hom V₁ V₂ →+ (V₁ → V₂) := +def coe_fn_add_hom : normed_add_group_hom V₁ V₂ →+ (V₁ → V₂) := { to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add} -@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) : +@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (f : ι → normed_add_group_hom V₁ V₂) : ⇑(∑ i in s, f i) = ∑ i in s, (f i) := (coe_fn_add_hom : _ →+ (V₁ → V₂)).map_sum f s -lemma sum_apply {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) (v : V₁) : +lemma sum_apply {ι : Type*} (s : finset ι) (f : ι → normed_add_group_hom V₁ V₂) (v : V₁) : (∑ i in s, f i) v = ∑ i in s, (f i v) := by simp only [coe_sum, finset.sum_apply] @@ -460,81 +476,84 @@ by simp only [coe_sum, finset.sum_apply] instance {R : Type*} [monoid_with_zero R] [distrib_mul_action R V₂] [pseudo_metric_space R] [has_bounded_smul R V₂] : - distrib_mul_action R (normed_group_hom V₁ V₂) := + distrib_mul_action R (normed_add_group_hom V₁ V₂) := function.injective.distrib_mul_action coe_fn_add_hom coe_injective coe_smul instance {R : Type*} [semiring R] [module R V₂] [pseudo_metric_space R] [has_bounded_smul R V₂] : - module R (normed_group_hom V₁ V₂) := + module R (normed_add_group_hom V₁ V₂) := function.injective.module _ coe_fn_add_hom coe_injective coe_smul /-! ### Composition of normed group homs -/ /-- The composition of continuous normed group homs. -/ @[simps] -protected def comp (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) : - normed_group_hom V₁ V₃ := -(g.to_add_monoid_hom.comp f.to_add_monoid_hom).mk_normed_group_hom (∥g∥ * ∥f∥) $ λ v, calc -∥g (f v)∥ ≤ ∥g∥ * ∥f v∥ : le_op_norm _ _ -... ≤ ∥g∥ * (∥f∥ * ∥v∥) : mul_le_mul_of_nonneg_left (le_op_norm _ _) (op_norm_nonneg _) -... = ∥g∥ * ∥f∥ * ∥v∥ : by rw mul_assoc - -lemma norm_comp_le (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) : - ∥g.comp f∥ ≤ ∥g∥ * ∥f∥ := -mk_normed_group_hom_norm_le _ (mul_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _ - -lemma norm_comp_le_of_le {g : normed_group_hom V₂ V₃} {C₁ C₂ : ℝ} (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) : - ∥g.comp f∥ ≤ C₂ * C₁ := +protected def comp (g : normed_add_group_hom V₂ V₃) (f : normed_add_group_hom V₁ V₂) : + normed_add_group_hom V₁ V₃ := +(g.to_add_monoid_hom.comp f.to_add_monoid_hom).mk_normed_add_group_hom (‖g‖ * ‖f‖) $ λ v, calc +‖g (f v)‖ ≤ ‖g‖ * ‖f v‖ : le_op_norm _ _ +... ≤ ‖g‖ * (‖f‖ * ‖v‖) : mul_le_mul_of_nonneg_left (le_op_norm _ _) (op_norm_nonneg _) +... = ‖g‖ * ‖f‖ * ‖v‖ : by rw mul_assoc + +lemma norm_comp_le (g : normed_add_group_hom V₂ V₃) (f : normed_add_group_hom V₁ V₂) : + ‖g.comp f‖ ≤ ‖g‖ * ‖f‖ := +mk_normed_add_group_hom_norm_le _ (mul_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _ + +lemma norm_comp_le_of_le {g : normed_add_group_hom V₂ V₃} {C₁ C₂ : ℝ} (hg : ‖g‖ ≤ C₂) + (hf : ‖f‖ ≤ C₁) : + ‖g.comp f‖ ≤ C₂ * C₁ := le_trans (norm_comp_le g f) $ mul_le_mul hg hf (norm_nonneg _) (le_trans (norm_nonneg _) hg) -lemma norm_comp_le_of_le' {g : normed_group_hom V₂ V₃} (C₁ C₂ C₃ : ℝ) (h : C₃ = C₂ * C₁) - (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) : ∥g.comp f∥ ≤ C₃ := +lemma norm_comp_le_of_le' {g : normed_add_group_hom V₂ V₃} (C₁ C₂ C₃ : ℝ) (h : C₃ = C₂ * C₁) + (hg : ‖g‖ ≤ C₂) (hf : ‖f‖ ≤ C₁) : ‖g.comp f‖ ≤ C₃ := by { rw h, exact norm_comp_le_of_le hg hf } /-- Composition of normed groups hom as an additive group morphism. -/ -def comp_hom : (normed_group_hom V₂ V₃) →+ (normed_group_hom V₁ V₂) →+ (normed_group_hom V₁ V₃) := +def comp_hom : + normed_add_group_hom V₂ V₃ →+ normed_add_group_hom V₁ V₂ →+ normed_add_group_hom V₁ V₃ := add_monoid_hom.mk' (λ g, add_monoid_hom.mk' (λ f, g.comp f) - (by { intros, ext, exact g.map_add _ _ })) + (by { intros, ext, exact map_add g _ _ })) (by { intros, ext, simp only [comp_apply, pi.add_apply, function.comp_app, add_monoid_hom.add_apply, add_monoid_hom.mk'_apply, coe_add] }) -@[simp] lemma comp_zero (f : normed_group_hom V₂ V₃) : f.comp (0 : normed_group_hom V₁ V₂) = 0 := -by { ext, exact f.map_zero } +@[simp] lemma comp_zero (f : normed_add_group_hom V₂ V₃) : + f.comp (0 : normed_add_group_hom V₁ V₂) = 0 := +by { ext, exact map_zero f } -@[simp] lemma zero_comp (f : normed_group_hom V₁ V₂) : (0 : normed_group_hom V₂ V₃).comp f = 0 := +@[simp] lemma zero_comp (f : normed_add_group_hom V₁ V₂) : + (0 : normed_add_group_hom V₂ V₃).comp f = 0 := by { ext, refl } -lemma comp_assoc {V₄: Type* } [semi_normed_group V₄] (h : normed_group_hom V₃ V₄) - (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) : +lemma comp_assoc {V₄: Type* } [seminormed_add_comm_group V₄] (h : normed_add_group_hom V₃ V₄) + (g : normed_add_group_hom V₂ V₃) (f : normed_add_group_hom V₁ V₂) : (h.comp g).comp f = h.comp (g.comp f) := by { ext, refl } -lemma coe_comp (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃) : +lemma coe_comp (f : normed_add_group_hom V₁ V₂) (g : normed_add_group_hom V₂ V₃) : (g.comp f : V₁ → V₃) = (g : V₂ → V₃) ∘ (f : V₁ → V₂) := rfl -end normed_group_hom +end normed_add_group_hom -namespace normed_group_hom +namespace normed_add_group_hom -variables {V W V₁ V₂ V₃ : Type*} -variables [semi_normed_group V] [semi_normed_group W] [semi_normed_group V₁] [semi_normed_group V₂] -[semi_normed_group V₃] +variables {V W V₁ V₂ V₃ : Type*} [seminormed_add_comm_group V] [seminormed_add_comm_group W] + [seminormed_add_comm_group V₁] [seminormed_add_comm_group V₂] [seminormed_add_comm_group V₃] /-- The inclusion of an `add_subgroup`, as bounded group homomorphism. -/ -@[simps] def incl (s : add_subgroup V) : normed_group_hom s V := +@[simps] def incl (s : add_subgroup V) : normed_add_group_hom s V := { to_fun := (coe : s → V), map_add' := λ v w, add_subgroup.coe_add _ _ _, bound' := ⟨1, λ v, by { rw [one_mul], refl }⟩ } -lemma norm_incl {V' : add_subgroup V} (x : V') : ∥incl _ x∥ = ∥x∥ := +lemma norm_incl {V' : add_subgroup V} (x : V') : ‖incl _ x‖ = ‖x‖ := rfl /-!### Kernel -/ section kernels -variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃) +variables (f : normed_add_group_hom V₁ V₂) (g : normed_add_group_hom V₂ V₃) /-- The kernel of a bounded group homomorphism. Naturally endowed with a -`semi_normed_group` instance. -/ +`seminormed_add_comm_group` instance. -/ def ker : add_subgroup V₁ := f.to_add_monoid_hom.ker lemma mem_ker (v : V₁) : v ∈ f.ker ↔ f v = 0 := @@ -543,7 +562,7 @@ by { erw f.to_add_monoid_hom.mem_ker, refl } /-- Given a normed group hom `f : V₁ → V₂` satisfying `g.comp f = 0` for some `g : V₂ → V₃`, the corestriction of `f` to the kernel of `g`. -/ @[simps] def ker.lift (h : g.comp f = 0) : - normed_group_hom V₁ g.ker := + normed_add_group_hom V₁ g.ker := { to_fun := λ v, ⟨f v, by { erw g.mem_ker, show (g.comp f) v = 0, rw h, refl }⟩, map_add' := λ v w, by { simp only [map_add], refl }, bound' := f.bound' } @@ -553,12 +572,12 @@ by { erw f.to_add_monoid_hom.mem_ker, refl } by { ext, refl } @[simp] -lemma ker_zero : (0 : normed_group_hom V₁ V₂).ker = ⊤ := +lemma ker_zero : (0 : normed_add_group_hom V₁ V₂).ker = ⊤ := by { ext, simp [mem_ker] } lemma coe_ker : (f.ker : set V₁) = (f : V₁ → V₂) ⁻¹' {0} := rfl -lemma is_closed_ker {V₂ : Type*} [normed_group V₂] (f : normed_group_hom V₁ V₂) : +lemma is_closed_ker {V₂ : Type*} [normed_add_comm_group V₂] (f : normed_add_group_hom V₁ V₂) : is_closed (f.ker : set V₁) := f.coe_ker ▸ is_closed.preimage f.continuous (t1_space.t1 0) @@ -567,10 +586,10 @@ end kernels /-! ### Range -/ section range -variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃) +variables (f : normed_add_group_hom V₁ V₂) (g : normed_add_group_hom V₂ V₃) /-- The image of a bounded group homomorphism. Naturally endowed with a -`semi_normed_group` instance. -/ +`seminormed_add_comm_group` instance. -/ def range : add_subgroup V₂ := f.to_add_monoid_hom.range lemma mem_range (v : V₂) : v ∈ f.range ↔ ∃ w, f w = v := @@ -592,15 +611,15 @@ by simpa [comp_range, incl_range, ← add_monoid_hom.range_eq_map] end range -variables {f : normed_group_hom V W} +variables {f : normed_add_group_hom V W} -/-- A `normed_group_hom` is *norm-nonincreasing* if `∥f v∥ ≤ ∥v∥` for all `v`. -/ -def norm_noninc (f : normed_group_hom V W) : Prop := -∀ v, ∥f v∥ ≤ ∥v∥ +/-- A `normed_add_group_hom` is *norm-nonincreasing* if `‖f v‖ ≤ ‖v‖` for all `v`. -/ +def norm_noninc (f : normed_add_group_hom V W) : Prop := +∀ v, ‖f v‖ ≤ ‖v‖ namespace norm_noninc -lemma norm_noninc_iff_norm_le_one : f.norm_noninc ↔ ∥f∥ ≤ 1 := +lemma norm_noninc_iff_norm_le_one : f.norm_noninc ↔ ‖f‖ ≤ 1 := begin refine ⟨λ h, _, λ h, λ v, _⟩, { refine op_norm_le_bound _ (zero_le_one) (λ v, _), @@ -608,40 +627,32 @@ begin { simpa using le_of_op_norm_le f h v } end -lemma zero : (0 : normed_group_hom V₁ V₂).norm_noninc := +lemma zero : (0 : normed_add_group_hom V₁ V₂).norm_noninc := λ v, by simp lemma id : (id V).norm_noninc := λ v, le_rfl -lemma comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂} +lemma comp {g : normed_add_group_hom V₂ V₃} {f : normed_add_group_hom V₁ V₂} (hg : g.norm_noninc) (hf : f.norm_noninc) : (g.comp f).norm_noninc := λ v, (hg (f v)).trans (hf v) -@[simp] lemma neg_iff {f : normed_group_hom V₁ V₂} : (-f).norm_noninc ↔ f.norm_noninc := +@[simp] lemma neg_iff {f : normed_add_group_hom V₁ V₂} : (-f).norm_noninc ↔ f.norm_noninc := ⟨λ h x, by { simpa using h x }, λ h x, (norm_neg (f x)).le.trans (h x)⟩ end norm_noninc section isometry -lemma isometry_iff_norm (f : normed_group_hom V W) : - isometry f ↔ ∀ v, ∥f v∥ = ∥v∥ := -add_monoid_hom.isometry_iff_norm f.to_add_monoid_hom - -lemma isometry_of_norm (f : normed_group_hom V W) (hf : ∀ v, ∥f v∥ = ∥v∥) : - isometry f := -f.isometry_iff_norm.mpr hf - -lemma norm_eq_of_isometry {f : normed_group_hom V W} (hf : isometry f) (v : V) : - ∥f v∥ = ∥v∥ := -f.isometry_iff_norm.mp hf v +lemma norm_eq_of_isometry {f : normed_add_group_hom V W} (hf : isometry f) (v : V) : + ‖f v‖ = ‖v‖ := +(add_monoid_hom_class.isometry_iff_norm f).mp hf v lemma isometry_id : @isometry V V _ _ (id V) := isometry_id -lemma isometry_comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂} +lemma isometry_comp {g : normed_add_group_hom V₂ V₃} {f : normed_add_group_hom V₁ V₂} (hg : isometry g) (hf : isometry f) : isometry (g.comp f) := hg.comp hf @@ -651,59 +662,60 @@ lemma norm_noninc_of_isometry (hf : isometry f) : f.norm_noninc := end isometry -variables {W₁ W₂ W₃ : Type*} [semi_normed_group W₁] [semi_normed_group W₂] [semi_normed_group W₃] -variables (f) (g : normed_group_hom V W) -variables {f₁ g₁ : normed_group_hom V₁ W₁} -variables {f₂ g₂ : normed_group_hom V₂ W₂} -variables {f₃ g₃ : normed_group_hom V₃ W₃} +variables {W₁ W₂ W₃ : Type*} [seminormed_add_comm_group W₁] [seminormed_add_comm_group W₂] + [seminormed_add_comm_group W₃] +variables (f) (g : normed_add_group_hom V W) +variables {f₁ g₁ : normed_add_group_hom V₁ W₁} +variables {f₂ g₂ : normed_add_group_hom V₂ W₂} +variables {f₃ g₃ : normed_add_group_hom V₃ W₃} -/-- The equalizer of two morphisms `f g : normed_group_hom V W`. -/ +/-- The equalizer of two morphisms `f g : normed_add_group_hom V W`. -/ def equalizer := (f - g).ker namespace equalizer -/-- The inclusion of `f.equalizer g` as a `normed_group_hom`. -/ -def ι : normed_group_hom (f.equalizer g) V := incl _ +/-- The inclusion of `f.equalizer g` as a `normed_add_group_hom`. -/ +def ι : normed_add_group_hom (f.equalizer g) V := incl _ lemma comp_ι_eq : f.comp (ι f g) = g.comp (ι f g) := -by { ext, rw [comp_apply, comp_apply, ← sub_eq_zero, ← normed_group_hom.sub_apply], exact x.2 } +by { ext, rw [comp_apply, comp_apply, ← sub_eq_zero, ← normed_add_group_hom.sub_apply], exact x.2 } variables {f g} -/-- If `φ : normed_group_hom V₁ V` is such that `f.comp φ = g.comp φ`, the induced morphism -`normed_group_hom V₁ (f.equalizer g)`. -/ +/-- If `φ : normed_add_group_hom V₁ V` is such that `f.comp φ = g.comp φ`, the induced morphism +`normed_add_group_hom V₁ (f.equalizer g)`. -/ @[simps] -def lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) : - normed_group_hom V₁ (f.equalizer g) := +def lift (φ : normed_add_group_hom V₁ V) (h : f.comp φ = g.comp φ) : + normed_add_group_hom V₁ (f.equalizer g) := { to_fun := λ v, ⟨φ v, show (f - g) (φ v) = 0, - by rw [normed_group_hom.sub_apply, sub_eq_zero, ← comp_apply, h, comp_apply]⟩, + by rw [normed_add_group_hom.sub_apply, sub_eq_zero, ← comp_apply, h, comp_apply]⟩, map_add' := λ v₁ v₂, by { ext, simp only [map_add, add_subgroup.coe_add, subtype.coe_mk] }, bound' := by { obtain ⟨C, C_pos, hC⟩ := φ.bound, exact ⟨C, hC⟩ } } -@[simp] lemma ι_comp_lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) : +@[simp] lemma ι_comp_lift (φ : normed_add_group_hom V₁ V) (h : f.comp φ = g.comp φ) : (ι _ _).comp (lift φ h) = φ := by { ext, refl } /-- The lifting property of the equalizer as an equivalence. -/ @[simps] -def lift_equiv : {φ : normed_group_hom V₁ V // f.comp φ = g.comp φ} ≃ - normed_group_hom V₁ (f.equalizer g) := +def lift_equiv : {φ : normed_add_group_hom V₁ V // f.comp φ = g.comp φ} ≃ + normed_add_group_hom V₁ (f.equalizer g) := { to_fun := λ φ, lift φ φ.prop, inv_fun := λ ψ, ⟨(ι f g).comp ψ, by { rw [← comp_assoc, ← comp_assoc, comp_ι_eq] }⟩, left_inv := λ φ, by simp, right_inv := λ ψ, by { ext, refl } } -/-- Given `φ : normed_group_hom V₁ V₂` and `ψ : normed_group_hom W₁ W₂` such that +/-- Given `φ : normed_add_group_hom V₁ V₂` and `ψ : normed_add_group_hom W₁ W₂` such that `ψ.comp f₁ = f₂.comp φ` and `ψ.comp g₁ = g₂.comp φ`, the induced morphism -`normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂)`. -/ -def map (φ : normed_group_hom V₁ V₂) (ψ : normed_group_hom W₁ W₂) +`normed_add_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂)`. -/ +def map (φ : normed_add_group_hom V₁ V₂) (ψ : normed_add_group_hom W₁ W₂) (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) : - normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂) := + normed_add_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂) := lift (φ.comp $ ι _ _) $ by { simp only [← comp_assoc, ← hf, ← hg], simp only [comp_assoc, comp_ι_eq] } -variables {φ : normed_group_hom V₁ V₂} {ψ : normed_group_hom W₁ W₂} -variables {φ' : normed_group_hom V₂ V₃} {ψ' : normed_group_hom W₂ W₃} +variables {φ : normed_add_group_hom V₁ V₂} {ψ : normed_add_group_hom W₁ W₂} +variables {φ' : normed_add_group_hom V₂ V₃} {ψ' : normed_add_group_hom W₂ W₃} @[simp] lemma ι_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) : (ι f₂ g₂).comp (map φ ψ hf hg) = φ.comp (ι _ _) := @@ -725,129 +737,23 @@ by { ext, refl } lemma ι_norm_noninc : (ι f g).norm_noninc := λ v, le_rfl /-- The lifting of a norm nonincreasing morphism is norm nonincreasing. -/ -lemma lift_norm_noninc (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) (hφ : φ.norm_noninc) : +lemma lift_norm_noninc (φ : normed_add_group_hom V₁ V) (h : f.comp φ = g.comp φ) + (hφ : φ.norm_noninc) : (lift φ h).norm_noninc := hφ -/-- If `φ` satisfies `∥φ∥ ≤ C`, then the same is true for the lifted morphism. -/ -lemma norm_lift_le (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) - (C : ℝ) (hφ : ∥φ∥ ≤ C) : ∥(lift φ h)∥ ≤ C := hφ +/-- If `φ` satisfies `‖φ‖ ≤ C`, then the same is true for the lifted morphism. -/ +lemma norm_lift_le (φ : normed_add_group_hom V₁ V) (h : f.comp φ = g.comp φ) + (C : ℝ) (hφ : ‖φ‖ ≤ C) : ‖(lift φ h)‖ ≤ C := hφ lemma map_norm_noninc (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) (hφ : φ.norm_noninc) : (map φ ψ hf hg).norm_noninc := lift_norm_noninc _ _ $ hφ.comp ι_norm_noninc lemma norm_map_le (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) - (C : ℝ) (hφ : ∥φ.comp (ι f₁ g₁)∥ ≤ C) : ∥map φ ψ hf hg∥ ≤ C := + (C : ℝ) (hφ : ‖φ.comp (ι f₁ g₁)‖ ≤ C) : ‖map φ ψ hf hg‖ ≤ C := norm_lift_le _ _ _ hφ end equalizer -end normed_group_hom - -section controlled_closure -open filter finset -open_locale topological_space -variables {G : Type*} [normed_group G] [complete_space G] -variables {H : Type*} [normed_group H] - -/-- Given `f : normed_group_hom G H` for some complete `G` and a subgroup `K` of `H`, if every -element `x` of `K` has a preimage under `f` whose norm is at most `C*∥x∥` then the same holds for -elements of the (topological) closure of `K` with constant `C+ε` instead of `C`, for any -positive `ε`. --/ -lemma controlled_closure_of_complete {f : normed_group_hom G H} {K : add_subgroup H} - {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : f.surjective_on_with K C) : - f.surjective_on_with K.topological_closure (C + ε) := -begin - rintros (h : H) (h_in : h ∈ K.topological_closure), - /- We first get rid of the easy case where `h = 0`.-/ - by_cases hyp_h : h = 0, - { rw hyp_h, - use 0, - simp }, - /- The desired preimage will be constructed as the sum of a series. Convergence of - the series will be guaranteed by completeness of `G`. We first write `h` as the sum - of a sequence `v` of elements of `K` which starts close to `h` and then quickly goes to zero. - The sequence `b` below quantifies this. -/ - set b : ℕ → ℝ := λ i, (1/2)^i*(ε*∥h∥/2)/C, - have b_pos : ∀ i, 0 < b i, - { intro i, - field_simp [b, hC], - exact div_pos (mul_pos hε (norm_pos_iff.mpr hyp_h)) - (mul_pos (by norm_num : (0 : ℝ) < 2^i*2) hC) }, - obtain ⟨v : ℕ → H, lim_v : tendsto (λ (n : ℕ), ∑ k in range (n + 1), v k) at_top (𝓝 h), - v_in : ∀ n, v n ∈ K, hv₀ : ∥v 0 - h∥ < b 0, hv : ∀ n > 0, ∥v n∥ < b n⟩ := - controlled_sum_of_mem_closure h_in b_pos, - /- The controlled surjectivity assumption on `f` allows to build preimages `u n` for all - elements `v n` of the `v` sequence.-/ - have : ∀ n, ∃ m' : G, f m' = v n ∧ ∥m'∥ ≤ C * ∥v n∥ := λ (n : ℕ), hyp (v n) (v_in n), - choose u hu hnorm_u using this, - /- The desired series `s` is then obtained by summing `u`. We then check our choice of - `b` ensures `s` is Cauchy. -/ - set s : ℕ → G := λ n, ∑ k in range (n+1), u k, - have : cauchy_seq s, - { apply normed_group.cauchy_series_of_le_geometric'' (by norm_num) one_half_lt_one, - rintro n (hn : n ≥ 1), - calc ∥u n∥ ≤ C*∥v n∥ : hnorm_u n - ... ≤ C * b n : mul_le_mul_of_nonneg_left (hv _ $ nat.succ_le_iff.mp hn).le hC.le - ... = (1/2)^n * (ε * ∥h∥/2) : by simp [b, mul_div_cancel' _ hC.ne.symm] - ... = (ε * ∥h∥/2) * (1/2)^n : mul_comm _ _ }, - /- We now show that the limit `g` of `s` is the desired preimage. -/ - obtain ⟨g : G, hg⟩ := cauchy_seq_tendsto_of_complete this, - refine ⟨g, _, _⟩, - { /- We indeed get a preimage. First note: -/ - have : f ∘ s = λ n, ∑ k in range (n + 1), v k, - { ext n, - simp [f.map_sum, hu] }, - /- In the above equality, the left-hand-side converges to `f g` by continuity of `f` and - definition of `g` while the right-hand-side converges to `h` by construction of `v` so - `g` is indeed a preimage of `h`. -/ - rw ← this at lim_v, - exact tendsto_nhds_unique ((f.continuous.tendsto g).comp hg) lim_v }, - { /- Then we need to estimate the norm of `g`, using our careful choice of `b`. -/ - suffices : ∀ n, ∥s n∥ ≤ (C + ε) * ∥h∥, - from le_of_tendsto' (continuous_norm.continuous_at.tendsto.comp hg) this, - intros n, - have hnorm₀ : ∥u 0∥ ≤ C*b 0 + C*∥h∥, - { have := calc - ∥v 0∥ ≤ ∥h∥ + ∥v 0 - h∥ : norm_le_insert' _ _ - ... ≤ ∥h∥ + b 0 : by apply add_le_add_left hv₀.le, - calc ∥u 0∥ ≤ C*∥v 0∥ : hnorm_u 0 - ... ≤ C*(∥h∥ + b 0) : mul_le_mul_of_nonneg_left this hC.le - ... = C * b 0 + C * ∥h∥ : by rw [add_comm, mul_add] }, - have : ∑ k in range (n + 1), C * b k ≤ ε * ∥h∥ := calc - ∑ k in range (n + 1), C * b k = (∑ k in range (n + 1), (1 / 2) ^ k) * (ε * ∥h∥ / 2) : - by simp only [b, mul_div_cancel' _ hC.ne.symm, ← sum_mul] - ... ≤ 2 * (ε * ∥h∥ / 2) : mul_le_mul_of_nonneg_right (sum_geometric_two_le _) - (by nlinarith [hε, norm_nonneg h]) - ... = ε * ∥h∥ : mul_div_cancel' _ two_ne_zero, - calc ∥s n∥ ≤ ∑ k in range (n+1), ∥u k∥ : norm_sum_le _ _ - ... = ∑ k in range n, ∥u (k + 1)∥ + ∥u 0∥ : sum_range_succ' _ _ - ... ≤ ∑ k in range n, C*∥v (k + 1)∥ + ∥u 0∥ : add_le_add_right (sum_le_sum (λ _ _, hnorm_u _)) _ - ... ≤ ∑ k in range n, C*b (k+1) + (C*b 0 + C*∥h∥) : - add_le_add (sum_le_sum (λ k _, mul_le_mul_of_nonneg_left (hv _ k.succ_pos).le hC.le)) hnorm₀ - ... = ∑ k in range (n+1), C*b k + C*∥h∥ : by rw [← add_assoc, sum_range_succ'] - ... ≤ (C+ε)*∥h∥ : by { rw [add_comm, add_mul], apply add_le_add_left this } } -end - -/-- Given `f : normed_group_hom G H` for some complete `G`, if every element `x` of the image of -an isometric immersion `j : normed_group_hom K H` has a preimage under `f` whose norm is at most -`C*∥x∥` then the same holds for elements of the (topological) closure of this image with constant -`C+ε` instead of `C`, for any positive `ε`. -This is useful in particular if `j` is the inclusion of a normed group into its completion -(in this case the closure is the full target group). --/ -lemma controlled_closure_range_of_complete {f : normed_group_hom G H} - {K : Type*} [semi_normed_group K] {j : normed_group_hom K H} (hj : ∀ x, ∥j x∥ = ∥x∥) - {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : ∀ k, ∃ g, f g = j k ∧ ∥g∥ ≤ C*∥k∥) : - f.surjective_on_with j.range.topological_closure (C + ε) := -begin - replace hyp : ∀ h ∈ j.range, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥, - { intros h h_in, - rcases (j.mem_range _).mp h_in with ⟨k, rfl⟩, - rw hj, - exact hyp k }, - exact controlled_closure_of_complete hC hε hyp -end -end controlled_closure +end normed_add_group_hom diff --git a/src/analysis/normed/group/hom_completion.lean b/src/analysis/normed/group/hom_completion.lean index 108b3d12f2a9b..e3333fe0cc972 100644 --- a/src/analysis/normed/group/hom_completion.lean +++ b/src/analysis/normed/group/hom_completion.lean @@ -9,9 +9,12 @@ import analysis.normed.group.completion /-! # Completion of normed group homs -Given two (semi) normed groups `G` and `H` and a normed group hom `f : normed_group_hom G H`, +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given two (semi) normed groups `G` and `H` and a normed group hom `f : normed_add_group_hom G H`, we build and study a normed group hom -`f.completion : normed_group_hom (completion G) (completion H)` such that the diagram +`f.completion : normed_add_group_hom (completion G) (completion H)` such that the diagram ``` f @@ -33,63 +36,64 @@ The vertical maps in the above diagrams are also normed group homs constructed i ## Main definitions and results: -* `normed_group_hom.completion`: see the discussion above. -* `normed_group.to_compl : normed_group_hom G (completion G)`: the canonical map from `G` to its - completion, as a normed group hom -* `normed_group_hom.completion_to_compl`: the above diagram indeed commutes. -* `normed_group_hom.norm_completion`: `∥f.completion∥ = ∥f∥` -* `normed_group_hom.ker_le_ker_completion`: the kernel of `f.completion` contains the image of the - kernel of `f`. -* `normed_group_hom.ker_completion`: the kernel of `f.completion` is the closure of the image of the - kernel of `f` under an assumption that `f` is quantitatively surjective onto its image. -* `normed_group_hom.extension` : if `H` is complete, the extension of `f : normed_group_hom G H` - to a `normed_group_hom (completion G) H`. +* `normed_add_group_hom.completion`: see the discussion above. +* `normed_add_comm_group.to_compl : normed_add_group_hom G (completion G)`: the canonical map from + `G` to its completion, as a normed group hom +* `normed_add_group_hom.completion_to_compl`: the above diagram indeed commutes. +* `normed_add_group_hom.norm_completion`: `‖f.completion‖ = ‖f‖` +* `normed_add_group_hom.ker_le_ker_completion`: the kernel of `f.completion` contains the image of + the kernel of `f`. +* `normed_add_group_hom.ker_completion`: the kernel of `f.completion` is the closure of the image of + the kernel of `f` under an assumption that `f` is quantitatively surjective onto its image. +* `normed_add_group_hom.extension` : if `H` is complete, the extension of + `f : normed_add_group_hom G H` to a `normed_add_group_hom (completion G) H`. -/ noncomputable theory -open set normed_group_hom uniform_space +open set normed_add_group_hom uniform_space section completion -variables {G : Type*} [semi_normed_group G] -variables {H : Type*} [semi_normed_group H] -variables {K : Type*} [semi_normed_group K] +variables {G : Type*} [seminormed_add_comm_group G] +variables {H : Type*} [seminormed_add_comm_group H] +variables {K : Type*} [seminormed_add_comm_group K] /-- The normed group hom induced between completions. -/ -def normed_group_hom.completion (f : normed_group_hom G H) : - normed_group_hom (completion G) (completion H) := +def normed_add_group_hom.completion (f : normed_add_group_hom G H) : + normed_add_group_hom (completion G) (completion H) := { bound' := begin - use ∥f∥, + use ‖f‖, intro y, apply completion.induction_on y, { exact is_closed_le (continuous_norm.comp $ f.to_add_monoid_hom.continuous_completion f.continuous) (continuous_const.mul continuous_norm) }, { intro x, - change ∥f.to_add_monoid_hom.completion _ ↑x∥ ≤ ∥f∥ * ∥↑x∥, + change ‖f.to_add_monoid_hom.completion _ ↑x‖ ≤ ‖f‖ * ‖↑x‖, rw f.to_add_monoid_hom.completion_coe f.continuous, simp only [completion.norm_coe], exact f.le_op_norm x } end, ..f.to_add_monoid_hom.completion f.continuous } -lemma normed_group_hom.completion_def (f : normed_group_hom G H) (x : completion G) : +lemma normed_add_group_hom.completion_def (f : normed_add_group_hom G H) (x : completion G) : f.completion x = completion.map f x := rfl @[simp] -lemma normed_group_hom.completion_coe_to_fun (f : normed_group_hom G H) : +lemma normed_add_group_hom.completion_coe_to_fun (f : normed_add_group_hom G H) : (f.completion : completion G → completion H) = completion.map f := -by { ext x, exact normed_group_hom.completion_def f x } +by { ext x, exact normed_add_group_hom.completion_def f x } @[simp] -lemma normed_group_hom.completion_coe (f : normed_group_hom G H) (g : G) : f.completion g = f g := +lemma normed_add_group_hom.completion_coe (f : normed_add_group_hom G H) (g : G) : + f.completion g = f g := completion.map_coe f.uniform_continuous _ /-- Completion of normed group homs as a normed group hom. -/ -@[simps] def normed_group_hom_completion_hom : - normed_group_hom G H →+ normed_group_hom (completion G) (completion H) := -{ to_fun := normed_group_hom.completion, +@[simps] def normed_add_group_hom_completion_hom : + normed_add_group_hom G H →+ normed_add_group_hom (completion G) (completion H) := +{ to_fun := normed_add_group_hom.completion, map_zero' := begin apply to_add_monoid_hom_injective, exact add_monoid_hom.completion_zero @@ -100,57 +104,58 @@ completion.map_coe f.uniform_continuous _ end } @[simp] -lemma normed_group_hom.completion_id : - (normed_group_hom.id G).completion = normed_group_hom.id (completion G) := +lemma normed_add_group_hom.completion_id : + (normed_add_group_hom.id G).completion = normed_add_group_hom.id (completion G) := begin ext x, - rw [normed_group_hom.completion_def, normed_group_hom.coe_id, completion.map_id], + rw [normed_add_group_hom.completion_def, normed_add_group_hom.coe_id, completion.map_id], refl end -lemma normed_group_hom.completion_comp (f : normed_group_hom G H) (g : normed_group_hom H K) : +lemma normed_add_group_hom.completion_comp (f : normed_add_group_hom G H) + (g : normed_add_group_hom H K) : g.completion.comp f.completion = (g.comp f).completion := begin ext x, - rw [normed_group_hom.coe_comp, normed_group_hom.completion_def, - normed_group_hom.completion_coe_to_fun, normed_group_hom.completion_coe_to_fun, - completion.map_comp (normed_group_hom.uniform_continuous _) - (normed_group_hom.uniform_continuous _)], + rw [normed_add_group_hom.coe_comp, normed_add_group_hom.completion_def, + normed_add_group_hom.completion_coe_to_fun, normed_add_group_hom.completion_coe_to_fun, + completion.map_comp (normed_add_group_hom.uniform_continuous _) + (normed_add_group_hom.uniform_continuous _)], refl end -lemma normed_group_hom.completion_neg (f : normed_group_hom G H) : +lemma normed_add_group_hom.completion_neg (f : normed_add_group_hom G H) : (-f).completion = -f.completion := -normed_group_hom_completion_hom.map_neg f +map_neg (normed_add_group_hom_completion_hom : normed_add_group_hom G H →+ _) f -lemma normed_group_hom.completion_add (f g : normed_group_hom G H) : +lemma normed_add_group_hom.completion_add (f g : normed_add_group_hom G H) : (f + g).completion = f.completion + g.completion := -normed_group_hom_completion_hom.map_add f g +normed_add_group_hom_completion_hom.map_add f g -lemma normed_group_hom.completion_sub (f g : normed_group_hom G H) : +lemma normed_add_group_hom.completion_sub (f g : normed_add_group_hom G H) : (f - g).completion = f.completion - g.completion := -normed_group_hom_completion_hom.map_sub f g +map_sub (normed_add_group_hom_completion_hom : normed_add_group_hom G H →+ _) f g @[simp] -lemma normed_group_hom.zero_completion : (0 : normed_group_hom G H).completion = 0 := -normed_group_hom_completion_hom.map_zero +lemma normed_add_group_hom.zero_completion : (0 : normed_add_group_hom G H).completion = 0 := +normed_add_group_hom_completion_hom.map_zero /-- The map from a normed group to its completion, as a normed group hom. -/ -def normed_group.to_compl : normed_group_hom G (completion G) := +def normed_add_comm_group.to_compl : normed_add_group_hom G (completion G) := { to_fun := coe, map_add' := completion.to_compl.map_add, bound' := ⟨1, by simp [le_refl]⟩ } -open normed_group +open normed_add_comm_group -lemma normed_group.norm_to_compl (x : G) : ∥to_compl x∥ = ∥x∥ := +lemma normed_add_comm_group.norm_to_compl (x : G) : ‖to_compl x‖ = ‖x‖ := completion.norm_coe x -lemma normed_group.dense_range_to_compl : dense_range (to_compl : G → completion G) := +lemma normed_add_comm_group.dense_range_to_compl : dense_range (to_compl : G → completion G) := completion.dense_inducing_coe.dense @[simp] -lemma normed_group_hom.completion_to_compl (f : normed_group_hom G H) : +lemma normed_add_group_hom.completion_to_compl (f : normed_add_group_hom G H) : f.completion.comp to_compl = to_compl.comp f := begin ext x, @@ -158,7 +163,8 @@ begin simpa end -@[simp] lemma normed_group_hom.norm_completion (f : normed_group_hom G H) : ∥f.completion∥ = ∥f∥ := +@[simp] lemma normed_add_group_hom.norm_completion (f : normed_add_group_hom G H) : + ‖f.completion‖ = ‖f‖ := begin apply f.completion.op_norm_eq_of_bounds (norm_nonneg _), { intro x, @@ -173,7 +179,7 @@ begin simpa using hN x }, end -lemma normed_group_hom.ker_le_ker_completion (f : normed_group_hom G H) : +lemma normed_add_group_hom.ker_le_ker_completion (f : normed_add_group_hom G H) : (to_compl.comp $ incl f.ker).range ≤ f.completion.ker := begin intros a h, @@ -181,52 +187,52 @@ begin rcases h with ⟨⟨g, g_in : g ∈ f.ker⟩, rfl⟩, rw f.mem_ker at g_in, change f.completion (g : completion G) = 0, - simp [normed_group_hom.mem_ker, f.completion_coe g, g_in, completion.coe_zero], + simp [normed_add_group_hom.mem_ker, f.completion_coe g, g_in, completion.coe_zero], end -lemma normed_group_hom.ker_completion {f : normed_group_hom G H} {C : ℝ} +lemma normed_add_group_hom.ker_completion {f : normed_add_group_hom G H} {C : ℝ} (h : f.surjective_on_with f.range C) : (f.completion.ker : set $ completion G) = closure (to_compl.comp $ incl f.ker).range := begin rcases h.exists_pos with ⟨C', C'_pos, hC'⟩, apply le_antisymm, { intros hatg hatg_in, - rw semi_normed_group.mem_closure_iff, + rw seminormed_add_comm_group.mem_closure_iff, intros ε ε_pos, - have hCf : 0 ≤ C'*∥f∥ := (zero_le_mul_left C'_pos).mpr (norm_nonneg f), - have ineq : 0 < 1 + C'*∥f∥, by linarith, - set δ := ε/(1 + C'*∥f∥), + have hCf : 0 ≤ C'*‖f‖ := (zero_le_mul_left C'_pos).mpr (norm_nonneg f), + have ineq : 0 < 1 + C'*‖f‖, by linarith, + set δ := ε/(1 + C'*‖f‖), have δ_pos : δ > 0, from div_pos ε_pos ineq, - obtain ⟨_, ⟨g : G, rfl⟩, hg : ∥hatg - g∥ < δ⟩ := - semi_normed_group.mem_closure_iff.mp (completion.dense_inducing_coe.dense hatg) δ δ_pos, - obtain ⟨g' : G, hgg' : f g' = f g, hfg : ∥g'∥ ≤ C' * ∥f g∥⟩ := + obtain ⟨_, ⟨g : G, rfl⟩, hg : ‖hatg - g‖ < δ⟩ := seminormed_add_comm_group.mem_closure_iff.mp + (completion.dense_inducing_coe.dense hatg) δ δ_pos, + obtain ⟨g' : G, hgg' : f g' = f g, hfg : ‖g'‖ ≤ C' * ‖f g‖⟩ := hC' (f g) (mem_range_self g), have mem_ker : g - g' ∈ f.ker, - by rw [f.mem_ker, f.map_sub, sub_eq_zero.mpr hgg'.symm], - have : ∥f g∥ ≤ ∥f∥*∥hatg - g∥, + by rw [f.mem_ker, map_sub, sub_eq_zero.mpr hgg'.symm], + have : ‖f g‖ ≤ ‖f‖*‖hatg - g‖, calc - ∥f g∥ = ∥f.completion g∥ : by rw [f.completion_coe, completion.norm_coe] - ... = ∥f.completion g - 0∥ : by rw [sub_zero _] - ... = ∥f.completion g - (f.completion hatg)∥ : by rw [(f.completion.mem_ker _).mp hatg_in] - ... = ∥f.completion (g - hatg)∥ : by rw [f.completion.map_sub] - ... ≤ ∥f.completion∥ * ∥(g :completion G) - hatg∥ : f.completion.le_op_norm _ - ... = ∥f∥ * ∥hatg - g∥ : by rw [norm_sub_rev, f.norm_completion], - have : ∥(g' : completion G)∥ ≤ C'*∥f∥*∥hatg - g∥, + ‖f g‖ = ‖f.completion g‖ : by rw [f.completion_coe, completion.norm_coe] + ... = ‖f.completion g - 0‖ : by rw [sub_zero _] + ... = ‖f.completion g - (f.completion hatg)‖ : by rw [(f.completion.mem_ker _).mp hatg_in] + ... = ‖f.completion (g - hatg)‖ : by rw [map_sub] + ... ≤ ‖f.completion‖ * ‖(g :completion G) - hatg‖ : f.completion.le_op_norm _ + ... = ‖f‖ * ‖hatg - g‖ : by rw [norm_sub_rev, f.norm_completion], + have : ‖(g' : completion G)‖ ≤ C'*‖f‖*‖hatg - g‖, calc - ∥(g' : completion G)∥ = ∥g'∥ : completion.norm_coe _ - ... ≤ C' * ∥f g∥ : hfg - ... ≤ C' * ∥f∥ * ∥hatg - g∥ : by { rw mul_assoc, + ‖(g' : completion G)‖ = ‖g'‖ : completion.norm_coe _ + ... ≤ C' * ‖f g‖ : hfg + ... ≤ C' * ‖f‖ * ‖hatg - g‖ : by { rw mul_assoc, exact (mul_le_mul_left C'_pos).mpr this }, refine ⟨g - g', _, _⟩, { norm_cast, - rw normed_group_hom.comp_range, + rw normed_add_group_hom.comp_range, apply add_subgroup.mem_map_of_mem, simp only [incl_range, mem_ker] }, - { calc ∥hatg - (g - g')∥ = ∥hatg - g + g'∥ : by abel - ... ≤ ∥hatg - g∥ + ∥(g' : completion G)∥ : norm_add_le _ _ - ... < δ + C'*∥f∥*∥hatg - g∥ : by linarith - ... ≤ δ + C'*∥f∥*δ : add_le_add_left (mul_le_mul_of_nonneg_left hg.le hCf) δ - ... = (1 + C'*∥f∥)*δ : by ring + { calc ‖hatg - (g - g')‖ = ‖hatg - g + g'‖ : by abel + ... ≤ ‖hatg - g‖ + ‖(g' : completion G)‖ : norm_add_le _ _ + ... < δ + C'*‖f‖*‖hatg - g‖ : by linarith + ... ≤ δ + C'*‖f‖*δ : add_le_add_left (mul_le_mul_of_nonneg_left hg.le hCf) δ + ... = (1 + C'*‖f‖)*δ : by ring ... = ε : mul_div_cancel' _ ineq.ne.symm } }, { rw ← f.completion.is_closed_ker.closure_eq, exact closure_mono f.ker_le_ker_completion } @@ -236,14 +242,15 @@ end completion section extension -variables {G : Type*} [semi_normed_group G] -variables {H : Type*} [semi_normed_group H] [separated_space H] [complete_space H] +variables {G : Type*} [seminormed_add_comm_group G] +variables {H : Type*} [seminormed_add_comm_group H] [separated_space H] [complete_space H] -/-- If `H` is complete, the extension of `f : normed_group_hom G H` to a -`normed_group_hom (completion G) H`. -/ -def normed_group_hom.extension (f : normed_group_hom G H) : normed_group_hom (completion G) H := +/-- If `H` is complete, the extension of `f : normed_add_group_hom G H` to a +`normed_add_group_hom (completion G) H`. -/ +def normed_add_group_hom.extension (f : normed_add_group_hom G H) : + normed_add_group_hom (completion G) H := { bound' := begin - refine ⟨∥f∥, λ v, completion.induction_on v (is_closed_le _ _) (λ a, _)⟩, + refine ⟨‖f‖, λ v, completion.induction_on v (is_closed_le _ _) (λ a, _)⟩, { exact continuous.comp continuous_norm completion.continuous_extension }, { exact continuous.mul continuous_const continuous_norm }, { rw [completion.norm_coe, add_monoid_hom.to_fun_eq_coe, add_monoid_hom.extension_coe], @@ -251,20 +258,20 @@ def normed_group_hom.extension (f : normed_group_hom G H) : normed_group_hom (co end, ..f.to_add_monoid_hom.extension f.continuous } -lemma normed_group_hom.extension_def (f : normed_group_hom G H) (v : G) : +lemma normed_add_group_hom.extension_def (f : normed_add_group_hom G H) (v : G) : f.extension v = completion.extension f v := rfl -@[simp] lemma normed_group_hom.extension_coe (f : normed_group_hom G H) (v : G) : +@[simp] lemma normed_add_group_hom.extension_coe (f : normed_add_group_hom G H) (v : G) : f.extension v = f v := add_monoid_hom.extension_coe _ f.continuous _ -lemma normed_group_hom.extension_coe_to_fun (f : normed_group_hom G H) : +lemma normed_add_group_hom.extension_coe_to_fun (f : normed_add_group_hom G H) : (f.extension : (completion G) → H) = completion.extension f := rfl -lemma normed_group_hom.extension_unique (f : normed_group_hom G H) - {g : normed_group_hom (completion G) H} (hg : ∀ v, f v = g v) : f.extension = g := +lemma normed_add_group_hom.extension_unique (f : normed_add_group_hom G H) + {g : normed_add_group_hom (completion G) H} (hg : ∀ v, f v = g v) : f.extension = g := begin ext v, - rw [normed_group_hom.extension_coe_to_fun, completion.extension_unique f.uniform_continuous + rw [normed_add_group_hom.extension_coe_to_fun, completion.extension_unique f.uniform_continuous g.uniform_continuous (λ a, hg a)] end diff --git a/src/analysis/normed/group/infinite_sum.lean b/src/analysis/normed/group/infinite_sum.lean index e6a9535f972f4..84b2afbcb9395 100644 --- a/src/analysis/normed/group/infinite_sum.lean +++ b/src/analysis/normed/group/infinite_sum.lean @@ -3,38 +3,42 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel, Heather Macbeth, Johannes Hölzl, Yury Kudryashov -/ +import algebra.big_operators.intervals import analysis.normed.group.basic import topology.instances.nnreal /-! # Infinite sums in (semi)normed groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In a complete (semi)normed group, - `summable_iff_vanishing_norm`: a series `∑' i, f i` is summable if and only if for any `ε > 0`, there exists a finite set `s` such that the sum `∑ i in t, f i` over any finite set `t` disjoint with `s` has norm less than `ε`; -- `summable_of_norm_bounded`, `summable_of_norm_bounded_eventually`: if `∥f i∥` is bounded above by +- `summable_of_norm_bounded`, `summable_of_norm_bounded_eventually`: if `‖f i‖` is bounded above by a summable series `∑' i, g i`, then `∑' i, f i` is summable as well; the same is true if the inequality hold only off some finite set. -- `tsum_of_norm_bounded`, `has_sum.norm_le_of_bounded`: if `∥f i∥ ≤ g i`, where `∑' i, g i` is a - summable series, then `∥∑' i, f i∥ ≤ ∑' i, g i`. +- `tsum_of_norm_bounded`, `has_sum.norm_le_of_bounded`: if `‖f i‖ ≤ g i`, where `∑' i, g i` is a + summable series, then `‖∑' i, f i‖ ≤ ∑' i, g i`. ## Tags infinite series, absolute convergence, normed group -/ -open_locale classical big_operators topological_space nnreal +open_locale classical big_operators topology nnreal open finset filter metric -variables {ι α E F : Type*} [semi_normed_group E] [semi_normed_group F] +variables {ι α E F : Type*} [seminormed_add_comm_group E] [seminormed_add_comm_group F] lemma cauchy_seq_finset_iff_vanishing_norm {f : ι → E} : cauchy_seq (λ s : finset ι, ∑ i in s, f i) ↔ - ∀ε > (0 : ℝ), ∃s:finset ι, ∀t, disjoint t s → ∥ ∑ i in t, f i ∥ < ε := + ∀ε > (0 : ℝ), ∃s:finset ι, ∀t, disjoint t s → ‖ ∑ i in t, f i ‖ < ε := begin rw [cauchy_seq_finset_iff_vanishing, nhds_basis_ball.forall_iff], { simp only [ball_zero_eq, set.mem_set_of_eq] }, @@ -43,60 +47,60 @@ begin end lemma summable_iff_vanishing_norm [complete_space E] {f : ι → E} : - summable f ↔ ∀ε > (0 : ℝ), ∃s:finset ι, ∀t, disjoint t s → ∥ ∑ i in t, f i ∥ < ε := + summable f ↔ ∀ε > (0 : ℝ), ∃s:finset ι, ∀t, disjoint t s → ‖ ∑ i in t, f i ‖ < ε := by rw [summable_iff_cauchy_seq_finset, cauchy_seq_finset_iff_vanishing_norm] lemma cauchy_seq_finset_of_norm_bounded_eventually {f : ι → E} {g : ι → ℝ} (hg : summable g) - (h : ∀ᶠ i in cofinite, ∥f i∥ ≤ g i) : cauchy_seq (λ s, ∑ i in s, f i) := + (h : ∀ᶠ i in cofinite, ‖f i‖ ≤ g i) : cauchy_seq (λ s, ∑ i in s, f i) := begin refine cauchy_seq_finset_iff_vanishing_norm.2 (λ ε hε, _), rcases summable_iff_vanishing_norm.1 hg ε hε with ⟨s, hs⟩, refine ⟨s ∪ h.to_finset, λ t ht, _⟩, - have : ∀ i ∈ t, ∥f i∥ ≤ g i, + have : ∀ i ∈ t, ‖f i‖ ≤ g i, { intros i hi, simp only [disjoint_left, mem_union, not_or_distrib, h.mem_to_finset, set.mem_compl_iff, not_not] at ht, exact (ht hi).2 }, - calc ∥∑ i in t, f i∥ ≤ ∑ i in t, g i : norm_sum_le_of_le _ this - ... ≤ ∥∑ i in t, g i∥ : le_abs_self _ + calc ‖∑ i in t, f i‖ ≤ ∑ i in t, g i : norm_sum_le_of_le _ this + ... ≤ ‖∑ i in t, g i‖ : le_abs_self _ ... < ε : hs _ (ht.mono_right le_sup_left), end lemma cauchy_seq_finset_of_norm_bounded {f : ι → E} (g : ι → ℝ) (hg : summable g) - (h : ∀i, ∥f i∥ ≤ g i) : cauchy_seq (λ s : finset ι, ∑ i in s, f i) := + (h : ∀i, ‖f i‖ ≤ g i) : cauchy_seq (λ s : finset ι, ∑ i in s, f i) := cauchy_seq_finset_of_norm_bounded_eventually hg $ eventually_of_forall h /-- A version of the **direct comparison test** for conditionally convergent series. See `cauchy_seq_finset_of_norm_bounded` for the same statement about absolutely convergent ones. -/ lemma cauchy_seq_range_of_norm_bounded {f : ℕ → E} (g : ℕ → ℝ) - (hg : cauchy_seq (λ n, ∑ i in range n, g i)) (hf : ∀ i, ∥f i∥ ≤ g i) : + (hg : cauchy_seq (λ n, ∑ i in range n, g i)) (hf : ∀ i, ‖f i‖ ≤ g i) : cauchy_seq (λ n, ∑ i in range n, f i) := begin refine metric.cauchy_seq_iff'.2 (λ ε hε, _), refine (metric.cauchy_seq_iff'.1 hg ε hε).imp (λ N hg n hn, _), specialize hg n hn, rw [dist_eq_norm, ←sum_Ico_eq_sub _ hn] at ⊢ hg, - calc ∥∑ k in Ico N n, f k∥ - ≤ ∑ k in _, ∥f k∥ : norm_sum_le _ _ + calc ‖∑ k in Ico N n, f k‖ + ≤ ∑ k in _, ‖f k‖ : norm_sum_le _ _ ... ≤ ∑ k in _, g k : sum_le_sum (λ x _, hf x) - ... ≤ ∥∑ k in _, g k∥ : le_abs_self _ + ... ≤ ‖∑ k in _, g k‖ : le_abs_self _ ... < ε : hg end -lemma cauchy_seq_finset_of_summable_norm {f : ι → E} (hf : summable (λa, ∥f a∥)) : +lemma cauchy_seq_finset_of_summable_norm {f : ι → E} (hf : summable (λa, ‖f a‖)) : cauchy_seq (λ s : finset ι, ∑ a in s, f a) := cauchy_seq_finset_of_norm_bounded _ hf (assume i, le_rfl) /-- If a function `f` is summable in norm, and along some sequence of finsets exhausting the space its sum is converging to a limit `a`, then this holds along all finsets, i.e., `f` is summable with sum `a`. -/ -lemma has_sum_of_subseq_of_summable {f : ι → E} (hf : summable (λa, ∥f a∥)) +lemma has_sum_of_subseq_of_summable {f : ι → E} (hf : summable (λa, ‖f a‖)) {s : α → finset ι} {p : filter α} [ne_bot p] (hs : tendsto s p at_top) {a : E} (ha : tendsto (λ b, ∑ i in s b, f i) p (𝓝 a)) : has_sum f a := tendsto_nhds_of_cauchy_seq_of_subseq (cauchy_seq_finset_of_summable_norm hf) hs ha -lemma has_sum_iff_tendsto_nat_of_summable_norm {f : ℕ → E} {a : E} (hf : summable (λi, ∥f i∥)) : +lemma has_sum_iff_tendsto_nat_of_summable_norm {f : ℕ → E} {a : E} (hf : summable (λi, ‖f i‖)) : has_sum f a ↔ tendsto (λn:ℕ, ∑ i in range n, f i) at_top (𝓝 a) := ⟨λ h, h.tendsto_sum_nat, λ h, has_sum_of_subseq_of_summable hf tendsto_finset_range h⟩ @@ -104,21 +108,21 @@ lemma has_sum_iff_tendsto_nat_of_summable_norm {f : ℕ → E} {a : E} (hf : sum /-- The direct comparison test for series: if the norm of `f` is bounded by a real function `g` which is summable, then `f` is summable. -/ lemma summable_of_norm_bounded - [complete_space E] {f : ι → E} (g : ι → ℝ) (hg : summable g) (h : ∀i, ∥f i∥ ≤ g i) : + [complete_space E] {f : ι → E} (g : ι → ℝ) (hg : summable g) (h : ∀i, ‖f i‖ ≤ g i) : summable f := by { rw summable_iff_cauchy_seq_finset, exact cauchy_seq_finset_of_norm_bounded g hg h } lemma has_sum.norm_le_of_bounded {f : ι → E} {g : ι → ℝ} {a : E} {b : ℝ} - (hf : has_sum f a) (hg : has_sum g b) (h : ∀ i, ∥f i∥ ≤ g i) : - ∥a∥ ≤ b := + (hf : has_sum f a) (hg : has_sum g b) (h : ∀ i, ‖f i‖ ≤ g i) : + ‖a‖ ≤ b := le_of_tendsto_of_tendsto' hf.norm hg $ λ s, norm_sum_le_of_le _ $ λ i hi, h i /-- Quantitative result associated to the direct comparison test for series: If `∑' i, g i` is -summable, and for all `i`, `∥f i∥ ≤ g i`, then `∥∑' i, f i∥ ≤ ∑' i, g i`. Note that we do not +summable, and for all `i`, `‖f i‖ ≤ g i`, then `‖∑' i, f i‖ ≤ ∑' i, g i`. Note that we do not assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete space. -/ lemma tsum_of_norm_bounded {f : ι → E} {g : ι → ℝ} {a : ℝ} (hg : has_sum g a) - (h : ∀ i, ∥f i∥ ≤ g i) : - ∥∑' i : ι, f i∥ ≤ a := + (h : ∀ i, ‖f i‖ ≤ g i) : + ‖∑' i : ι, f i‖ ≤ a := begin by_cases hf : summable f, { exact hf.has_sum.norm_le_of_bounded hg h }, @@ -126,29 +130,29 @@ begin exact ge_of_tendsto' hg (λ s, sum_nonneg $ λ i hi, (norm_nonneg _).trans (h i)) } end -/-- If `∑' i, ∥f i∥` is summable, then `∥∑' i, f i∥ ≤ (∑' i, ∥f i∥)`. Note that we do not assume +/-- If `∑' i, ‖f i‖` is summable, then `‖∑' i, f i‖ ≤ (∑' i, ‖f i‖)`. Note that we do not assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete space. -/ -lemma norm_tsum_le_tsum_norm {f : ι → E} (hf : summable (λi, ∥f i∥)) : - ∥∑' i, f i∥ ≤ ∑' i, ∥f i∥ := +lemma norm_tsum_le_tsum_norm {f : ι → E} (hf : summable (λi, ‖f i‖)) : + ‖∑' i, f i‖ ≤ ∑' i, ‖f i‖ := tsum_of_norm_bounded hf.has_sum $ λ i, le_rfl /-- Quantitative result associated to the direct comparison test for series: If `∑' i, g i` is -summable, and for all `i`, `∥f i∥₊ ≤ g i`, then `∥∑' i, f i∥₊ ≤ ∑' i, g i`. Note that we +summable, and for all `i`, `‖f i‖₊ ≤ g i`, then `‖∑' i, f i‖₊ ≤ ∑' i, g i`. Note that we do not assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete space. -/ lemma tsum_of_nnnorm_bounded {f : ι → E} {g : ι → ℝ≥0} {a : ℝ≥0} (hg : has_sum g a) - (h : ∀ i, ∥f i∥₊ ≤ g i) : - ∥∑' i : ι, f i∥₊ ≤ a := + (h : ∀ i, ‖f i‖₊ ≤ g i) : + ‖∑' i : ι, f i‖₊ ≤ a := begin simp only [← nnreal.coe_le_coe, ← nnreal.has_sum_coe, coe_nnnorm] at *, exact tsum_of_norm_bounded hg h end -/-- If `∑' i, ∥f i∥₊` is summable, then `∥∑' i, f i∥₊ ≤ ∑' i, ∥f i∥₊`. Note that +/-- If `∑' i, ‖f i‖₊` is summable, then `‖∑' i, f i‖₊ ≤ ∑' i, ‖f i‖₊`. Note that we do not assume that `∑' i, f i` is summable, and it might not be the case if `α` is not a complete space. -/ -lemma nnnorm_tsum_le {f : ι → E} (hf : summable (λi, ∥f i∥₊)) : - ∥∑' i, f i∥₊ ≤ ∑' i, ∥f i∥₊ := +lemma nnnorm_tsum_le {f : ι → E} (hf : summable (λi, ‖f i‖₊)) : + ‖∑' i, f i‖₊ ≤ ∑' i, ‖f i‖₊ := tsum_of_nnnorm_bounded hf.has_sum (λ i, le_rfl) variable [complete_space E] @@ -156,15 +160,15 @@ variable [complete_space E] /-- Variant of the direct comparison test for series: if the norm of `f` is eventually bounded by a real function `g` which is summable, then `f` is summable. -/ lemma summable_of_norm_bounded_eventually {f : ι → E} (g : ι → ℝ) (hg : summable g) - (h : ∀ᶠ i in cofinite, ∥f i∥ ≤ g i) : summable f := + (h : ∀ᶠ i in cofinite, ‖f i‖ ≤ g i) : summable f := summable_iff_cauchy_seq_finset.2 $ cauchy_seq_finset_of_norm_bounded_eventually hg h lemma summable_of_nnnorm_bounded {f : ι → E} (g : ι → ℝ≥0) (hg : summable g) - (h : ∀i, ∥f i∥₊ ≤ g i) : summable f := + (h : ∀i, ‖f i‖₊ ≤ g i) : summable f := summable_of_norm_bounded (λ i, (g i : ℝ)) (nnreal.summable_coe.2 hg) (λ i, by exact_mod_cast h i) -lemma summable_of_summable_norm {f : ι → E} (hf : summable (λa, ∥f a∥)) : summable f := +lemma summable_of_summable_norm {f : ι → E} (hf : summable (λa, ‖f a‖)) : summable f := summable_of_norm_bounded _ hf (assume i, le_rfl) -lemma summable_of_summable_nnnorm {f : ι → E} (hf : summable (λ a, ∥f a∥₊)) : summable f := +lemma summable_of_summable_nnnorm {f : ι → E} (hf : summable (λ a, ‖f a‖₊)) : summable f := summable_of_nnnorm_bounded _ hf (assume i, le_rfl) diff --git a/src/analysis/normed/group/pointwise.lean b/src/analysis/normed/group/pointwise.lean index d355e95c1835c..340dc562045b2 100644 --- a/src/analysis/normed/group/pointwise.lean +++ b/src/analysis/normed/group/pointwise.lean @@ -1,173 +1,224 @@ /- Copyright (c) 2021 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sébastien Gouëzel +Authors: Sébastien Gouëzel, Yaël Dillies -/ -import analysis.normed.group.add_torsor +import analysis.normed.group.basic import topology.metric_space.hausdorff_distance +import topology.metric_space.isometric_smul /-! # Properties of pointwise addition of sets in normed groups +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We explore the relationships between pointwise addition of sets in normed groups, and the norm. Notably, we show that the sum of bounded sets remain bounded. -/ open metric set -open_locale pointwise topological_space - -section semi_normed_group - -variables {E : Type*} [semi_normed_group E] {ε δ : ℝ} {s t : set E} {x y : E} +open_locale pointwise topology -lemma bounded_iff_exists_norm_le : bounded s ↔ ∃ R, ∀ x ∈ s, ∥x∥ ≤ R := -by simp [subset_def, bounded_iff_subset_ball (0 : E)] +variables {E : Type*} -alias bounded_iff_exists_norm_le ↔ metric.bounded.exists_norm_le _ +section seminormed_group +variables [seminormed_group E] {ε δ : ℝ} {s t : set E} {x y : E} -lemma metric.bounded.exists_pos_norm_le (hs : metric.bounded s) : ∃ R > 0, ∀ x ∈ s, ∥x∥ ≤ R := +-- note: we can't use `lipschitz_on_with.bounded_image2` here without adding `[isometric_smul E E]` +@[to_additive] lemma metric.bounded.mul (hs : bounded s) (ht : bounded t) : bounded (s * t) := begin - obtain ⟨R₀, hR₀⟩ := hs.exists_norm_le, - refine ⟨max R₀ 1, _, _⟩, - { exact (by norm_num : (0:ℝ) < 1).trans_le (le_max_right R₀ 1) }, - intros x hx, - exact (hR₀ x hx).trans (le_max_left _ _), + obtain ⟨Rs, hRs⟩ : ∃ R, ∀ x ∈ s, ‖x‖ ≤ R := hs.exists_norm_le', + obtain ⟨Rt, hRt⟩ : ∃ R, ∀ x ∈ t, ‖x‖ ≤ R := ht.exists_norm_le', + refine bounded_iff_forall_norm_le'.2 ⟨Rs + Rt, _⟩, + rintro z ⟨x, y, hx, hy, rfl⟩, + exact norm_mul_le_of_le (hRs x hx) (hRt y hy), end -lemma metric.bounded.add (hs : bounded s) (ht : bounded t) : bounded (s + t) := -begin - obtain ⟨Rs, hRs⟩ : ∃ (R : ℝ), ∀ x ∈ s, ∥x∥ ≤ R := hs.exists_norm_le, - obtain ⟨Rt, hRt⟩ : ∃ (R : ℝ), ∀ x ∈ t, ∥x∥ ≤ R := ht.exists_norm_le, - refine (bounded_iff_exists_norm_le).2 ⟨Rs + Rt, _⟩, - rintros z ⟨x, y, hx, hy, rfl⟩, - calc ∥x + y∥ ≤ ∥x∥ + ∥y∥ : norm_add_le _ _ - ... ≤ Rs + Rt : add_le_add (hRs x hx) (hRt y hy) -end +@[to_additive] lemma metric.bounded.of_mul (hst : bounded (s * t)) : + bounded s ∨ bounded t := +antilipschitz_with.bounded_of_image2_left _ (λ x, (isometry_mul_right x).antilipschitz) hst + +@[to_additive] lemma metric.bounded.inv : bounded s → bounded s⁻¹ := +by { simp_rw [bounded_iff_forall_norm_le', ←image_inv, ball_image_iff, norm_inv'], exact id } -lemma metric.bounded.neg : bounded s → bounded (-s) := -by { simp_rw [bounded_iff_exists_norm_le, ←image_neg, ball_image_iff, norm_neg], exact id } +@[to_additive] lemma metric.bounded.div (hs : bounded s) (ht : bounded t) : bounded (s / t) := +(div_eq_mul_inv _ _).symm.subst $ hs.mul ht.inv -lemma metric.bounded.sub (hs : bounded s) (ht : bounded t) : bounded (s - t) := -(sub_eq_add_neg _ _).symm.subst $ hs.add ht.neg +end seminormed_group + +section seminormed_comm_group +variables [seminormed_comm_group E] {ε δ : ℝ} {s t : set E} {x y : E} section emetric open emetric -lemma inf_edist_neg (x : E) (s : set E) : inf_edist (-x) s = inf_edist x (-s) := -eq_of_forall_le_iff $ λ r, by simp_rw [le_inf_edist, ←image_neg, ball_image_iff, edist_neg] +@[to_additive] +lemma inf_edist_inv (x : E) (s : set E) : inf_edist x⁻¹ s = inf_edist x s⁻¹ := +eq_of_forall_le_iff $ λ r, by simp_rw [le_inf_edist, ←image_inv, ball_image_iff, edist_inv] + +@[simp, to_additive] +lemma inf_edist_inv_inv (x : E) (s : set E) : inf_edist x⁻¹ s⁻¹ = inf_edist x s := +by rw [inf_edist_inv, inv_inv] -@[simp] lemma inf_edist_neg_neg (x : E) (s : set E) : inf_edist (-x) (-s) = inf_edist x s := -by rw [inf_edist_neg, neg_neg] +@[to_additive] lemma ediam_mul_le (x y : set E) : + emetric.diam (x * y) ≤ emetric.diam x + emetric.diam y := +(lipschitz_on_with.ediam_image2_le (*) _ _ + (λ _ _, (isometry_mul_right _).lipschitz.lipschitz_on_with _) + (λ _ _, (isometry_mul_left _).lipschitz.lipschitz_on_with _)).trans_eq $ + by simp only [ennreal.coe_one, one_mul] end emetric variables (ε δ s t x y) -@[simp] lemma neg_thickening : -thickening δ s = thickening δ (-s) := -by { unfold thickening, simp_rw ←inf_edist_neg, refl } +@[simp, to_additive] lemma inv_thickening : (thickening δ s)⁻¹ = thickening δ s⁻¹ := +by { simp_rw [thickening, ←inf_edist_inv], refl } + +@[simp, to_additive] lemma inv_cthickening : (cthickening δ s)⁻¹ = cthickening δ s⁻¹ := +by { simp_rw [cthickening, ←inf_edist_inv], refl } + +@[simp, to_additive] lemma inv_ball : (ball x δ)⁻¹ = ball x⁻¹ δ := +by { simp_rw [ball, ←dist_inv], refl } + +@[simp, to_additive] lemma inv_closed_ball : (closed_ball x δ)⁻¹ = closed_ball x⁻¹ δ := +by { simp_rw [closed_ball, ←dist_inv], refl } -@[simp] lemma neg_cthickening : -cthickening δ s = cthickening δ (-s) := -by { unfold cthickening, simp_rw ←inf_edist_neg, refl } +@[to_additive] lemma singleton_mul_ball : {x} * ball y δ = ball (x * y) δ := +by simp only [preimage_mul_ball, image_mul_left, singleton_mul, div_inv_eq_mul, mul_comm y x] -@[simp] lemma neg_ball : -ball x δ = ball (-x) δ := -by { unfold metric.ball, simp_rw ←dist_neg, refl } +@[to_additive] lemma singleton_div_ball : {x} / ball y δ = ball (x / y) δ := +by simp_rw [div_eq_mul_inv, inv_ball, singleton_mul_ball] -@[simp] lemma neg_closed_ball : -closed_ball x δ = closed_ball (-x) δ := -by { unfold metric.closed_ball, simp_rw ←dist_neg, refl } +@[to_additive] lemma ball_mul_singleton : ball x δ * {y} = ball (x * y) δ := +by rw [mul_comm, singleton_mul_ball, mul_comm y] -lemma singleton_add_ball : {x} + ball y δ = ball (x + y) δ := -by simp only [preimage_add_ball, image_add_left, singleton_add, sub_neg_eq_add, add_comm y x] +@[to_additive] lemma ball_div_singleton : ball x δ / {y} = ball (x / y) δ := +by simp_rw [div_eq_mul_inv, inv_singleton, ball_mul_singleton] -lemma singleton_sub_ball : {x} - ball y δ = ball (x - y) δ := -by simp_rw [sub_eq_add_neg, neg_ball, singleton_add_ball] +@[to_additive] lemma singleton_mul_ball_one : {x} * ball 1 δ = ball x δ := by simp -lemma ball_add_singleton : ball x δ + {y} = ball (x + y) δ := -by rw [add_comm, singleton_add_ball, add_comm y] +@[to_additive] lemma singleton_div_ball_one : {x} / ball 1 δ = ball x δ := +by simp [singleton_div_ball] -lemma ball_sub_singleton : ball x δ - {y} = ball (x - y) δ := -by simp_rw [sub_eq_add_neg, neg_singleton, ball_add_singleton] +@[to_additive] lemma ball_one_mul_singleton : ball 1 δ * {x} = ball x δ := +by simp [ball_mul_singleton] -lemma singleton_add_ball_zero : {x} + ball 0 δ = ball x δ := by simp -lemma singleton_sub_ball_zero : {x} - ball 0 δ = ball x δ := by simp [singleton_sub_ball] -lemma ball_zero_add_singleton : ball 0 δ + {x} = ball x δ := by simp [ball_add_singleton] -lemma ball_zero_sub_singleton : ball 0 δ - {x} = ball (-x) δ := by simp [ball_sub_singleton] -lemma vadd_ball_zero : x +ᵥ ball 0 δ = ball x δ := by simp +@[to_additive] lemma ball_one_div_singleton : ball 1 δ / {x} = ball x⁻¹ δ := +by simp [ball_div_singleton] -@[simp] lemma singleton_add_closed_ball : {x} + closed_ball y δ = closed_ball (x + y) δ := -by simp only [add_comm y x, preimage_add_closed_ball, image_add_left, singleton_add, sub_neg_eq_add] +@[to_additive] lemma smul_ball_one : x • ball 1 δ = ball x δ := +by { ext, simp [mem_smul_set_iff_inv_smul_mem, inv_mul_eq_div, dist_eq_norm_div] } -@[simp] lemma singleton_sub_closed_ball : {x} - closed_ball y δ = closed_ball (x - y) δ := -by simp_rw [sub_eq_add_neg, neg_closed_ball, singleton_add_closed_ball] +@[simp, to_additive] +lemma singleton_mul_closed_ball : {x} * closed_ball y δ = closed_ball (x * y) δ := +by simp only [mul_comm y x, preimage_mul_closed_ball, image_mul_left, singleton_mul, div_inv_eq_mul] -@[simp] lemma closed_ball_add_singleton : closed_ball x δ + {y} = closed_ball (x + y) δ := -by simp [add_comm _ {y}, add_comm y] +@[simp, to_additive] +lemma singleton_div_closed_ball : {x} / closed_ball y δ = closed_ball (x / y) δ := +by simp_rw [div_eq_mul_inv, inv_closed_ball, singleton_mul_closed_ball] -@[simp] lemma closed_ball_sub_singleton : closed_ball x δ - {y} = closed_ball (x - y) δ := -by simp [sub_eq_add_neg] +@[simp, to_additive] +lemma closed_ball_mul_singleton : closed_ball x δ * {y} = closed_ball (x * y) δ := +by simp [mul_comm _ {y}, mul_comm y] -lemma singleton_add_closed_ball_zero : {x} + closed_ball 0 δ = closed_ball x δ := by simp -lemma singleton_sub_closed_ball_zero : {x} - closed_ball 0 δ = closed_ball x δ := by simp -lemma closed_ball_zero_add_singleton : closed_ball 0 δ + {x} = closed_ball x δ := by simp -lemma closed_ball_zero_sub_singleton : closed_ball 0 δ - {x} = closed_ball (-x) δ := by simp -@[simp] lemma vadd_closed_ball_zero : x +ᵥ closed_ball 0 δ = closed_ball x δ := by simp +@[simp, to_additive] +lemma closed_ball_div_singleton : closed_ball x δ / {y} = closed_ball (x / y) δ := +by simp [div_eq_mul_inv] -lemma add_ball_zero : s + ball 0 δ = thickening δ s := +@[to_additive] +lemma singleton_mul_closed_ball_one : {x} * closed_ball 1 δ = closed_ball x δ := by simp + +@[to_additive] +lemma singleton_div_closed_ball_one : {x} / closed_ball 1 δ = closed_ball x δ := by simp + +@[to_additive] +lemma closed_ball_one_mul_singleton : closed_ball 1 δ * {x} = closed_ball x δ := by simp + +@[to_additive] +lemma closed_ball_one_div_singleton : closed_ball 1 δ / {x} = closed_ball x⁻¹ δ := by simp + +-- This is the `to_additive` version of the below, but it will later follow as a special case of +-- `vadd_closed_ball` for `normed_add_torsor`s, so we give it higher simp priority. +-- (There is no `normed_mul_torsor`, hence the asymmetry between additive and multiplicative +-- versions.) +@[simp, priority 1100] lemma vadd_closed_ball_zero {E : Type*} [seminormed_add_comm_group E] (δ : ℝ) + (x : E) : + x +ᵥ metric.closed_ball 0 δ = metric.closed_ball x δ := +by { ext, simp [mem_vadd_set_iff_neg_vadd_mem, neg_add_eq_sub, dist_eq_norm_sub] } + +@[simp] lemma smul_closed_ball_one : x • closed_ball 1 δ = closed_ball x δ := +by { ext, simp [mem_smul_set_iff_inv_smul_mem, inv_mul_eq_div, dist_eq_norm_div] } + +attribute [to_additive] smul_closed_ball_one + +@[to_additive] lemma mul_ball_one : s * ball 1 δ = thickening δ s := begin rw thickening_eq_bUnion_ball, - convert Union₂_add (λ x (_ : x ∈ s), {x}) (ball (0 : E) δ), + convert Union₂_mul (λ x (_ : x ∈ s), {x}) (ball (1 : E) δ), exact s.bUnion_of_singleton.symm, ext x y, - simp_rw [singleton_add_ball, add_zero], + simp_rw [singleton_mul_ball, mul_one], end -lemma sub_ball_zero : s - ball 0 δ = thickening δ s := by simp [sub_eq_add_neg, add_ball_zero] -lemma ball_add_zero : ball 0 δ + s = thickening δ s := by rw [add_comm, add_ball_zero] -lemma ball_sub_zero : ball 0 δ - s = thickening δ (-s) := by simp [sub_eq_add_neg, ball_add_zero] +@[to_additive] +lemma div_ball_one : s / ball 1 δ = thickening δ s := by simp [div_eq_mul_inv, mul_ball_one] + +@[to_additive] +lemma ball_mul_one : ball 1 δ * s = thickening δ s := by rw [mul_comm, mul_ball_one] + +@[to_additive] +lemma ball_div_one : ball 1 δ / s = thickening δ s⁻¹ := by simp [div_eq_mul_inv, ball_mul_one] + +@[simp, to_additive] lemma mul_ball : s * ball x δ = x • thickening δ s := +by rw [←smul_ball_one, mul_smul_comm, mul_ball_one] + +@[simp, to_additive] lemma div_ball : s / ball x δ = x⁻¹ • thickening δ s := +by simp [div_eq_mul_inv] -@[simp] lemma add_ball : s + ball x δ = x +ᵥ thickening δ s := -by rw [←vadd_ball_zero, add_vadd_comm, add_ball_zero] +@[simp, to_additive] lemma ball_mul : ball x δ * s = x • thickening δ s := +by rw [mul_comm, mul_ball] -@[simp] lemma sub_ball : s - ball x δ = -x +ᵥ thickening δ s := by simp [sub_eq_add_neg] -@[simp] lemma ball_add : ball x δ + s = x +ᵥ thickening δ s := by rw [add_comm, add_ball] -@[simp] lemma ball_sub : ball x δ - s = x +ᵥ thickening δ (-s) := by simp [sub_eq_add_neg] +@[simp, to_additive] lemma ball_div : ball x δ / s = x • thickening δ s⁻¹ := +by simp [div_eq_mul_inv] variables {ε δ s t x y} -lemma is_compact.add_closed_ball_zero (hs : is_compact s) (hδ : 0 ≤ δ) : - s + closed_ball 0 δ = cthickening δ s := +@[to_additive] lemma is_compact.mul_closed_ball_one (hs : is_compact s) (hδ : 0 ≤ δ) : + s * closed_ball 1 δ = cthickening δ s := begin rw hs.cthickening_eq_bUnion_closed_ball hδ, ext x, - simp only [mem_add, dist_eq_norm, exists_prop, mem_Union, mem_closed_ball, - exists_and_distrib_left, mem_closed_ball_zero_iff, ← eq_sub_iff_add_eq', exists_eq_right], + simp only [mem_mul, dist_eq_norm_div, exists_prop, mem_Union, mem_closed_ball, + exists_and_distrib_left, mem_closed_ball_one_iff, ← eq_div_iff_mul_eq'', exists_eq_right], end -lemma is_compact.sub_closed_ball_zero (hs : is_compact s) (hδ : 0 ≤ δ) : - s - closed_ball 0 δ = cthickening δ s := -by simp [sub_eq_add_neg, hs.add_closed_ball_zero hδ] +@[to_additive] lemma is_compact.div_closed_ball_one (hs : is_compact s) (hδ : 0 ≤ δ) : + s / closed_ball 1 δ = cthickening δ s := +by simp [div_eq_mul_inv, hs.mul_closed_ball_one hδ] -lemma is_compact.closed_ball_zero_add (hs : is_compact s) (hδ : 0 ≤ δ) : - closed_ball 0 δ + s = cthickening δ s := -by rw [add_comm, hs.add_closed_ball_zero hδ] +@[to_additive] lemma is_compact.closed_ball_one_mul (hs : is_compact s) (hδ : 0 ≤ δ) : + closed_ball 1 δ * s = cthickening δ s := +by rw [mul_comm, hs.mul_closed_ball_one hδ] -lemma is_compact.closed_ball_zero_sub (hs : is_compact s) (hδ : 0 ≤ δ) : - closed_ball 0 δ - s = cthickening δ (-s) := -by simp [sub_eq_add_neg, add_comm, hs.neg.add_closed_ball_zero hδ] +@[to_additive] lemma is_compact.closed_ball_one_div (hs : is_compact s) (hδ : 0 ≤ δ) : + closed_ball 1 δ / s = cthickening δ s⁻¹ := +by simp [div_eq_mul_inv, mul_comm, hs.inv.mul_closed_ball_one hδ] -lemma is_compact.add_closed_ball (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : - s + closed_ball x δ = x +ᵥ cthickening δ s := -by rw [←vadd_closed_ball_zero, add_vadd_comm, hs.add_closed_ball_zero hδ] +@[to_additive] lemma is_compact.mul_closed_ball (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : + s * closed_ball x δ = x • cthickening δ s := +by rw [←smul_closed_ball_one, mul_smul_comm, hs.mul_closed_ball_one hδ] -lemma is_compact.sub_closed_ball (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : - s - closed_ball x δ = -x +ᵥ cthickening δ s := -by simp [sub_eq_add_neg, add_comm, hs.add_closed_ball hδ] +@[to_additive] lemma is_compact.div_closed_ball (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : + s / closed_ball x δ = x⁻¹ • cthickening δ s := +by simp [div_eq_mul_inv, mul_comm, hs.mul_closed_ball hδ] -lemma is_compact.closed_ball_add (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : - closed_ball x δ + s = x +ᵥ cthickening δ s := -by rw [add_comm, hs.add_closed_ball hδ] +@[to_additive] lemma is_compact.closed_ball_mul (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : + closed_ball x δ * s = x • cthickening δ s := +by rw [mul_comm, hs.mul_closed_ball hδ] -lemma is_compact.closed_ball_sub (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : - closed_ball x δ + s = x +ᵥ cthickening δ s := -by simp [sub_eq_add_neg, add_comm, hs.closed_ball_add hδ] +@[to_additive] lemma is_compact.closed_ball_div (hs : is_compact s) (hδ : 0 ≤ δ) (x : E) : + closed_ball x δ * s = x • cthickening δ s := +by simp [div_eq_mul_inv, mul_comm, hs.closed_ball_mul hδ] -end semi_normed_group +end seminormed_comm_group diff --git a/src/analysis/normed/group/quotient.lean b/src/analysis/normed/group/quotient.lean index a8f5f4110438c..310046e0dd45d 100644 --- a/src/analysis/normed/group/quotient.lean +++ b/src/analysis/normed/group/quotient.lean @@ -3,14 +3,19 @@ Copyright (c) 2021 Patrick Massot. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Massot, Riccardo Brasca -/ +import analysis.normed_space.basic import analysis.normed.group.hom +import ring_theory.ideal.quotient_operations /-! # Quotients of seminormed groups -For any `semi_normed_group M` and any `S : add_subgroup M`, we provide a `semi_normed_group` -the group quotient `M ⧸ S`. -If `S` is closed, we provide `normed_group (M ⧸ S)` (regardless of whether `M` itself is +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For any `seminormed_add_comm_group M` and any `S : add_subgroup M`, we provide a +`seminormed_add_comm_group`, the group quotient `M ⧸ S`. +If `S` is closed, we provide `normed_add_comm_group (M ⧸ S)` (regardless of whether `M` itself is separated). The two main properties of these structures are the underlying topology is the quotient topology and the projection is a normed group homomorphism which is norm non-increasing (better, it has operator norm exactly one unless `S` is dense in `M`). The corresponding @@ -20,6 +25,13 @@ to a normed group hom defined on `M ⧸ S`. This file also introduces a predicate `is_quotient` characterizing normed group homs that are isomorphic to the canonical projection onto a normed group quotient. +In addition, this file also provides normed structures for quotients of modules by submodules, and +of (commutative) rings by ideals. The `seminormed_add_comm_group` and `normed_add_comm_group` +instances described above are transferred directly, but we also define instances of `normed_space`, +`semi_normed_comm_ring`, `normed_comm_ring` and `normed_algebra` under appropriate type class +assumptions on the original space. Moreover, while `quotient_add_group.complete_space` works +out-of-the-box for quotients of `normed_add_comm_group`s by `add_subgroup`s, we need to transfer +this instance in `submodule.quotient.complete_space` so that it applies to these other quotients. ## Main definitions @@ -28,19 +40,19 @@ We use `M` and `N` to denote seminormed groups and `S : add_subgroup M`. All the following definitions are in the `add_subgroup` namespace. Hence we can access `add_subgroup.normed_mk S` as `S.normed_mk`. -* `semi_normed_group_quotient` : The seminormed group structure on the quotient by +* `seminormed_add_comm_group_quotient` : The seminormed group structure on the quotient by an additive subgroup. This is an instance so there is no need to explictly use it. -* `normed_group_quotient` : The normed group structure on the quotient by +* `normed_add_comm_group_quotient` : The normed group structure on the quotient by a closed additive subgroup. This is an instance so there is no need to explictly use it. * `normed_mk S` : the normed group hom from `M` to `M ⧸ S`. * `lift S f hf`: implements the universal property of `M ⧸ S`. Here - `(f : normed_group_hom M N)`, `(hf : ∀ s ∈ S, f s = 0)` and - `lift S f hf : normed_group_hom (M ⧸ S) N`. + `(f : normed_add_group_hom M N)`, `(hf : ∀ s ∈ S, f s = 0)` and + `lift S f hf : normed_add_group_hom (M ⧸ S) N`. -* `is_quotient`: given `f : normed_group_hom M N`, `is_quotient f` means `N` is isomorphic +* `is_quotient`: given `f : normed_add_group_hom M N`, `is_quotient f` means `N` is isomorphic to a quotient of `M` by a subgroup, with projection `f`. Technically it asserts `f` is surjective and the norm of `f x` is the infimum of the norms of `x + m` for `m` in `f.ker`. @@ -49,28 +61,28 @@ All the following definitions are in the `add_subgroup` namespace. Hence we can * `norm_normed_mk` : the operator norm of the projection is `1` if the subspace is not dense. * `is_quotient.norm_lift`: Provided `f : normed_hom M N` satisfies `is_quotient f`, for every - `n : N` and positive `ε`, there exists `m` such that `f m = n ∧ ∥m∥ < ∥n∥ + ε`. + `n : N` and positive `ε`, there exists `m` such that `f m = n ∧ ‖m‖ < ‖n‖ + ε`. ## Implementation details -For any `semi_normed_group M` and any `S : add_subgroup M` we define a norm on `M ⧸ S` by -`∥x∥ = Inf (norm '' {m | mk' S m = x})`. This formula is really an implementation detail, it +For any `seminormed_add_comm_group M` and any `S : add_subgroup M` we define a norm on `M ⧸ S` by +`‖x‖ = Inf (norm '' {m | mk' S m = x})`. This formula is really an implementation detail, it shouldn't be needed outside of this file setting up the theory. Since `M ⧸ S` is automatically a topological space (as any quotient of a topological space), -one needs to be careful while defining the `semi_normed_group` instance to avoid having two +one needs to be careful while defining the `seminormed_add_comm_group` instance to avoid having two different topologies on this quotient. This is not purely a technological issue. Mathematically there is something to prove. The main point is proved in the auxiliary lemma `quotient_nhd_basis` that has no use beyond this verification and states that zero in the quotient -admits as basis of neighborhoods in the quotient topology the sets `{x | ∥x∥ < ε}` for positive `ε`. +admits as basis of neighborhoods in the quotient topology the sets `{x | ‖x‖ < ε}` for positive `ε`. Once this mathematical point it settled, we have two topologies that are propositionaly equal. This is not good enough for the type class system. As usual we ensure *definitional* equality using forgetful inheritance, see Note [forgetful inheritance]. A (semi)-normed group structure includes a uniform space structure which includes a topological space structure, together with propositional fields asserting compatibility conditions. -The usual way to define a `semi_normed_group` is to let Lean build a uniform space structure +The usual way to define a `seminormed_add_comm_group` is to let Lean build a uniform space structure using the provided norm, and then trivially build a proof that the norm and uniform structure are compatible. Here the uniform structure is provided using `topological_add_group.to_uniform_space` which uses the topological structure and the group structure to build the uniform structure. This @@ -84,15 +96,19 @@ noncomputable theory open quotient_add_group metric set -open_locale topological_space nnreal +open_locale topology nnreal -variables {M N : Type*} [semi_normed_group M] [semi_normed_group N] +variables {M N : Type*} [seminormed_add_comm_group M] [seminormed_add_comm_group N] /-- The definition of the norm on the quotient by an additive subgroup. -/ noncomputable instance norm_on_quotient (S : add_subgroup M) : has_norm (M ⧸ S) := { norm := λ x, Inf (norm '' {m | mk' S m = x}) } +lemma add_subgroup.quotient_norm_eq {S : add_subgroup M} (x : M ⧸ S) : + ‖x‖ = Inf (norm '' {m : M | (m : M ⧸ S) = x}) := +rfl + lemma image_norm_nonempty {S : add_subgroup M} : ∀ x : M ⧸ S, (norm '' {m | mk' S m = x}).nonempty := begin @@ -110,8 +126,8 @@ begin apply norm_nonneg end -/-- The norm on the quotient satisfies `∥-x∥ = ∥x∥`. -/ -lemma quotient_norm_neg {S : add_subgroup M} (x : M ⧸ S) : ∥-x∥ = ∥x∥ := +/-- The norm on the quotient satisfies `‖-x‖ = ‖x‖`. -/ +lemma quotient_norm_neg {S : add_subgroup M} (x : M ⧸ S) : ‖-x‖ = ‖x‖ := begin suffices : norm '' {m | mk' S m = x} = norm '' {m | mk' S m = -x}, by simp only [this, norm], @@ -121,15 +137,15 @@ begin rw ← norm_neg, exact ⟨-m, by simp only [(mk' S).map_neg, set.mem_set_of_eq], rfl⟩ }, { rintros ⟨m, hm : mk' S m = -x, rfl⟩, - exact ⟨-m, by simpa [eq_comm] using eq_neg_iff_eq_neg.mp ((mk'_apply _ _).symm.trans hm)⟩ } + exact ⟨-m, by simpa using neg_eq_iff_eq_neg.mpr ((mk'_apply _ _).symm.trans hm)⟩ } end -lemma quotient_norm_sub_rev {S : add_subgroup M} (x y : M ⧸ S) : ∥x - y∥ = ∥y - x∥ := +lemma quotient_norm_sub_rev {S : add_subgroup M} (x y : M ⧸ S) : ‖x - y‖ = ‖y - x‖ := by rw [show x - y = -(y - x), by abel, quotient_norm_neg] /-- The norm of the projection is smaller or equal to the norm of the original element. -/ lemma quotient_norm_mk_le (S : add_subgroup M) (m : M) : - ∥mk' S m∥ ≤ ∥m∥ := + ‖mk' S m‖ ≤ ‖m‖ := begin apply cInf_le, use 0, @@ -141,11 +157,11 @@ end /-- The norm of the projection is smaller or equal to the norm of the original element. -/ lemma quotient_norm_mk_le' (S : add_subgroup M) (m : M) : - ∥(m : M ⧸ S)∥ ≤ ∥m∥ := quotient_norm_mk_le S m + ‖(m : M ⧸ S)‖ ≤ ‖m‖ := quotient_norm_mk_le S m /-- The norm of the image under the natural morphism to the quotient. -/ lemma quotient_norm_mk_eq (S : add_subgroup M) (m : M) : - ∥mk' S m∥ = Inf ((λ x, ∥m + x∥) '' S) := + ‖mk' S m‖ = Inf ((λ x, ‖m + x‖) '' S) := begin change Inf _ = _, congr' 1, @@ -161,30 +177,30 @@ begin end /-- The quotient norm is nonnegative. -/ -lemma quotient_norm_nonneg (S : add_subgroup M) : ∀ x : M ⧸ S, 0 ≤ ∥x∥ := +lemma quotient_norm_nonneg (S : add_subgroup M) : ∀ x : M ⧸ S, 0 ≤ ‖x‖ := begin rintros ⟨m⟩, - change 0 ≤ ∥mk' S m∥, + change 0 ≤ ‖mk' S m‖, apply le_cInf (image_norm_nonempty _), rintros _ ⟨n, h, rfl⟩, apply norm_nonneg end /-- The quotient norm is nonnegative. -/ -lemma norm_mk_nonneg (S : add_subgroup M) (m : M) : 0 ≤ ∥mk' S m∥ := +lemma norm_mk_nonneg (S : add_subgroup M) (m : M) : 0 ≤ ‖mk' S m‖ := quotient_norm_nonneg S _ /-- The norm of the image of `m : M` in the quotient by `S` is zero if and only if `m` belongs to the closure of `S`. -/ lemma quotient_norm_eq_zero_iff (S : add_subgroup M) (m : M) : - ∥mk' S m∥ = 0 ↔ m ∈ closure (S : set M) := + ‖mk' S m‖ = 0 ↔ m ∈ closure (S : set M) := begin - have : 0 ≤ ∥mk' S m∥ := norm_mk_nonneg S m, + have : 0 ≤ ‖mk' S m‖ := norm_mk_nonneg S m, rw [← this.le_iff_eq, quotient_norm_mk_eq, real.Inf_le_iff], simp_rw [zero_add], - { calc (∀ ε > (0 : ℝ), ∃ r ∈ (λ x, ∥m + x∥) '' (S : set M), r < ε) ↔ - (∀ ε > 0, (∃ x ∈ S, ∥m + x∥ < ε)) : by simp [set.bex_image_iff] - ... ↔ ∀ ε > 0, (∃ x ∈ S, ∥m + -x∥ < ε) : _ + { calc (∀ ε > (0 : ℝ), ∃ r ∈ (λ x, ‖m + x‖) '' (S : set M), r < ε) ↔ + (∀ ε > 0, (∃ x ∈ S, ‖m + x‖ < ε)) : by simp [set.bex_image_iff] + ... ↔ ∀ ε > 0, (∃ x ∈ S, ‖m + -x‖ < ε) : _ ... ↔ ∀ ε > 0, (∃ x ∈ S, x ∈ metric.ball m ε) : by simp [dist_eq_norm, ← sub_eq_add_neg, norm_sub_rev] ... ↔ m ∈ closure ↑S : by simp [metric.mem_closure_iff, dist_comm], @@ -199,21 +215,21 @@ begin end /-- For any `x : M ⧸ S` and any `0 < ε`, there is `m : M` such that `mk' S m = x` -and `∥m∥ < ∥x∥ + ε`. -/ +and `‖m‖ < ‖x‖ + ε`. -/ lemma norm_mk_lt {S : add_subgroup M} (x : M ⧸ S) {ε : ℝ} (hε : 0 < ε) : - ∃ (m : M), mk' S m = x ∧ ∥m∥ < ∥x∥ + ε := + ∃ (m : M), mk' S m = x ∧ ‖m‖ < ‖x‖ + ε := begin - obtain ⟨_, ⟨m : M, H : mk' S m = x, rfl⟩, hnorm : ∥m∥ < ∥x∥ + ε⟩ := + obtain ⟨_, ⟨m : M, H : mk' S m = x, rfl⟩, hnorm : ‖m‖ < ‖x‖ + ε⟩ := real.lt_Inf_add_pos (image_norm_nonempty x) hε, subst H, exact ⟨m, rfl, hnorm⟩, end -/-- For any `m : M` and any `0 < ε`, there is `s ∈ S` such that `∥m + s∥ < ∥mk' S m∥ + ε`. -/ +/-- For any `m : M` and any `0 < ε`, there is `s ∈ S` such that `‖m + s‖ < ‖mk' S m‖ + ε`. -/ lemma norm_mk_lt' (S : add_subgroup M) (m : M) {ε : ℝ} (hε : 0 < ε) : - ∃ s ∈ S, ∥m + s∥ < ∥mk' S m∥ + ε := + ∃ s ∈ S, ‖m + s‖ < ‖mk' S m‖ + ε := begin - obtain ⟨n : M, hn : mk' S n = mk' S m, hn' : ∥n∥ < ∥mk' S m∥ + ε⟩ := + obtain ⟨n : M, hn : mk' S n = mk' S m, hn' : ‖n‖ < ‖mk' S m‖ + ε⟩ := norm_mk_lt (quotient_add_group.mk' S m) hε, erw [eq_comm, quotient_add_group.eq] at hn, use [- m + n, hn], @@ -221,20 +237,20 @@ begin end /-- The quotient norm satisfies the triangle inequality. -/ -lemma quotient_norm_add_le (S : add_subgroup M) (x y : M ⧸ S) : ∥x + y∥ ≤ ∥x∥ + ∥y∥ := +lemma quotient_norm_add_le (S : add_subgroup M) (x y : M ⧸ S) : ‖x + y‖ ≤ ‖x‖ + ‖y‖ := begin refine le_of_forall_pos_le_add (λ ε hε, _), replace hε := half_pos hε, - obtain ⟨m, rfl, hm : ∥m∥ < ∥mk' S m∥ + ε / 2⟩ := norm_mk_lt x hε, - obtain ⟨n, rfl, hn : ∥n∥ < ∥mk' S n∥ + ε / 2⟩ := norm_mk_lt y hε, - calc ∥mk' S m + mk' S n∥ = ∥mk' S (m + n)∥ : by rw (mk' S).map_add - ... ≤ ∥m + n∥ : quotient_norm_mk_le S (m + n) - ... ≤ ∥m∥ + ∥n∥ : norm_add_le _ _ - ... ≤ ∥mk' S m∥ + ∥mk' S n∥ + ε : by linarith + obtain ⟨m, rfl, hm : ‖m‖ < ‖mk' S m‖ + ε / 2⟩ := norm_mk_lt x hε, + obtain ⟨n, rfl, hn : ‖n‖ < ‖mk' S n‖ + ε / 2⟩ := norm_mk_lt y hε, + calc ‖mk' S m + mk' S n‖ = ‖mk' S (m + n)‖ : by rw (mk' S).map_add + ... ≤ ‖m + n‖ : quotient_norm_mk_le S (m + n) + ... ≤ ‖m‖ + ‖n‖ : norm_add_le _ _ + ... ≤ ‖mk' S m‖ + ‖mk' S n‖ + ε : by linarith end /-- The quotient norm of `0` is `0`. -/ -lemma norm_mk_zero (S : add_subgroup M) : ∥(0 : M ⧸ S)∥ = 0 := +lemma norm_mk_zero (S : add_subgroup M) : ‖(0 : M ⧸ S)‖ = 0 := begin erw quotient_norm_eq_zero_iff, exact subset_closure S.zero_mem @@ -243,11 +259,11 @@ end /-- If `(m : M)` has norm equal to `0` in `M ⧸ S` for a closed subgroup `S` of `M`, then `m ∈ S`. -/ lemma norm_zero_eq_zero (S : add_subgroup M) (hS : is_closed (S : set M)) (m : M) - (h : ∥mk' S m∥ = 0) : m ∈ S := + (h : ‖mk' S m‖ = 0) : m ∈ S := by rwa [quotient_norm_eq_zero_iff, hS.closure_eq] at h lemma quotient_nhd_basis (S : add_subgroup M) : - (𝓝 (0 : M ⧸ S)).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {x | ∥x∥ < ε}) := + (𝓝 (0 : M ⧸ S)).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {x | ‖x‖ < ε}) := ⟨begin intros U, split, @@ -264,8 +280,8 @@ lemma quotient_nhd_basis (S : add_subgroup M) : dsimp, linarith }, { rintros ⟨ε, ε_pos, h⟩, - have : (mk' S) '' (ball (0 : M) ε) ⊆ {x | ∥x∥ < ε}, - { rintros - ⟨x, x_in, rfl⟩, + have : (mk' S) '' (ball (0 : M) ε) ⊆ {x | ‖x‖ < ε}, + { rintros _ ⟨x, x_in, rfl⟩, rw mem_ball_zero_iff at x_in, exact lt_of_le_of_lt (quotient_norm_mk_le S x) x_in }, apply filter.mem_of_superset _ (set.subset.trans this h), @@ -281,9 +297,9 @@ end⟩ /-- The seminormed group structure on the quotient by an additive subgroup. -/ noncomputable -instance add_subgroup.semi_normed_group_quotient (S : add_subgroup M) : - semi_normed_group (M ⧸ S) := -{ dist := λ x y, ∥x - y∥, +instance add_subgroup.seminormed_add_comm_group_quotient (S : add_subgroup M) : + seminormed_add_comm_group (M ⧸ S) := +{ dist := λ x y, ‖x - y‖, dist_self := λ x, by simp only [norm_mk_zero, sub_self], dist_comm := quotient_norm_sub_rev, dist_triangle := λ x y z, @@ -300,8 +316,8 @@ instance add_subgroup.semi_normed_group_quotient (S : add_subgroup M) : rw uniformity_eq_comap_nhds_zero', have := (quotient_nhd_basis S).comap (λ (p : (M ⧸ S) × M ⧸ S), p.2 - p.1), apply this.eq_of_same_basis, - have : ∀ ε : ℝ, (λ (p : (M ⧸ S) × M ⧸ S), p.snd - p.fst) ⁻¹' {x | ∥x∥ < ε} = - {p : (M ⧸ S) × M ⧸ S | ∥p.fst - p.snd∥ < ε}, + have : ∀ ε : ℝ, (λ (p : (M ⧸ S) × M ⧸ S), p.snd - p.fst) ⁻¹' {x | ‖x‖ < ε} = + {p : (M ⧸ S) × M ⧸ S | ‖p.fst - p.snd‖ < ε}, { intro ε, ext x, dsimp, @@ -310,7 +326,7 @@ instance add_subgroup.semi_normed_group_quotient (S : add_subgroup M) : refine filter.has_basis_binfi_principal _ set.nonempty_Ioi, rintros ε (ε_pos : 0 < ε) η (η_pos : 0 < η), refine ⟨min ε η, lt_min ε_pos η_pos, _, _⟩, - { suffices : ∀ (a b : M ⧸ S), ∥a - b∥ < ε → ∥a - b∥ < η → ∥a - b∥ < ε, by simpa, + { suffices : ∀ (a b : M ⧸ S), ‖a - b‖ < ε → ‖a - b‖ < η → ‖a - b‖ < ε, by simpa, exact λ a b h h', h }, { simp } end } @@ -318,35 +334,35 @@ instance add_subgroup.semi_normed_group_quotient (S : add_subgroup M) : -- This is a sanity check left here on purpose to ensure that potential refactors won't destroy -- this important property. example (S : add_subgroup M) : (quotient.topological_space : topological_space $ M ⧸ S) = -S.semi_normed_group_quotient.to_uniform_space.to_topological_space := +S.seminormed_add_comm_group_quotient.to_uniform_space.to_topological_space := rfl /-- The quotient in the category of normed groups. -/ noncomputable -instance add_subgroup.normed_group_quotient (S : add_subgroup M) [hS : is_closed (S : set M)] : - normed_group (M ⧸ S) := +instance add_subgroup.normed_add_comm_group_quotient (S : add_subgroup M) [is_closed (S : set M)] : + normed_add_comm_group (M ⧸ S) := { eq_of_dist_eq_zero := begin - rintros ⟨m⟩ ⟨m'⟩ (h : ∥mk' S m - mk' S m'∥ = 0), - erw [← (mk' S).map_sub, quotient_norm_eq_zero_iff, hS.closure_eq, + rintros ⟨m⟩ ⟨m'⟩ (h : ‖mk' S m - mk' S m'‖ = 0), + erw [← (mk' S).map_sub, quotient_norm_eq_zero_iff, ‹is_closed _›.closure_eq, ← quotient_add_group.eq_iff_sub_mem] at h, exact h end, - .. add_subgroup.semi_normed_group_quotient S } + .. add_subgroup.seminormed_add_comm_group_quotient S } -- This is a sanity check left here on purpose to ensure that potential refactors won't destroy -- this important property. example (S : add_subgroup M) [is_closed (S : set M)] : - S.semi_normed_group_quotient = normed_group.to_semi_normed_group := rfl + S.seminormed_add_comm_group_quotient = normed_add_comm_group.to_seminormed_add_comm_group := rfl namespace add_subgroup -open normed_group_hom +open normed_add_group_hom /-- The morphism from a seminormed group to the quotient by a subgroup. -/ noncomputable -def normed_mk (S : add_subgroup M) : normed_group_hom M (M ⧸ S) := +def normed_mk (S : add_subgroup M) : normed_add_group_hom M (M ⧸ S) := { bound' := ⟨1, λ m, by simpa [one_mul] using quotient_norm_mk_le _ m⟩, .. quotient_add_group.mk' S } @@ -364,29 +380,29 @@ lemma ker_normed_mk (S : add_subgroup M) : S.normed_mk.ker = S := quotient_add_group.ker_mk _ /-- The operator norm of the projection is at most `1`. -/ -lemma norm_normed_mk_le (S : add_subgroup M) : ∥S.normed_mk∥ ≤ 1 := -normed_group_hom.op_norm_le_bound _ zero_le_one (λ m, by simp [quotient_norm_mk_le']) +lemma norm_normed_mk_le (S : add_subgroup M) : ‖S.normed_mk‖ ≤ 1 := +normed_add_group_hom.op_norm_le_bound _ zero_le_one (λ m, by simp [quotient_norm_mk_le']) /-- The operator norm of the projection is `1` if the subspace is not dense. -/ lemma norm_normed_mk (S : add_subgroup M) (h : (S.topological_closure : set M) ≠ univ) : - ∥S.normed_mk∥ = 1 := + ‖S.normed_mk‖ = 1 := begin obtain ⟨x, hx⟩ := set.nonempty_compl.2 h, let y := S.normed_mk x, - have hy : ∥y∥ ≠ 0, + have hy : ‖y‖ ≠ 0, { intro h0, exact set.not_mem_of_mem_compl hx ((quotient_norm_eq_zero_iff S x).1 h0) }, refine le_antisymm (norm_normed_mk_le S) (le_of_forall_pos_le_add (λ ε hε, _)), - suffices : 1 ≤ ∥S.normed_mk∥ + min ε ((1 : ℝ)/2), + suffices : 1 ≤ ‖S.normed_mk‖ + min ε ((1 : ℝ)/2), { exact le_add_of_le_add_left this (min_le_left ε ((1 : ℝ)/2)) }, have hδ := sub_pos.mpr (lt_of_le_of_lt (min_le_right ε ((1 : ℝ)/2)) one_half_lt_one), have hδpos : 0 < min ε ((1 : ℝ)/2) := lt_min hε one_half_pos, have hδnorm := mul_pos (div_pos hδpos hδ) (lt_of_le_of_ne (norm_nonneg y) hy.symm), obtain ⟨m, hm, hlt⟩ := norm_mk_lt y hδnorm, - have hrw : ∥y∥ + min ε (1 / 2) / (1 - min ε (1 / 2)) * ∥y∥ = - ∥y∥ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) := by ring, + have hrw : ‖y‖ + min ε (1 / 2) / (1 - min ε (1 / 2)) * ‖y‖ = + ‖y‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) := by ring, rw [hrw] at hlt, - have hm0 : ∥m∥ ≠ 0, + have hm0 : ‖m‖ ≠ 0, { intro h0, have hnorm := quotient_norm_mk_le S m, rw [h0, hm] at hnorm, @@ -394,21 +410,21 @@ begin simpa [hnorm] using hy }, replace hlt := (div_lt_div_right (lt_of_le_of_ne (norm_nonneg m) hm0.symm)).2 hlt, simp only [hm0, div_self, ne.def, not_false_iff] at hlt, - have hrw₁ : ∥y∥ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) / ∥m∥ = - (∥y∥ / ∥m∥) * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) := by ring, + have hrw₁ : ‖y‖ * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) / ‖m‖ = + (‖y‖ / ‖m‖) * (1 + min ε (1 / 2) / (1 - min ε (1 / 2))) := by ring, rw [hrw₁] at hlt, replace hlt := (inv_pos_lt_iff_one_lt_mul (lt_trans (div_pos hδpos hδ) (lt_one_add _))).2 hlt, - suffices : ∥S.normed_mk∥ ≥ 1 - min ε (1 / 2), + suffices : ‖S.normed_mk‖ ≥ 1 - min ε (1 / 2), { exact sub_le_iff_le_add.mp this }, - calc ∥S.normed_mk∥ ≥ ∥(S.normed_mk) m∥ / ∥m∥ : ratio_le_op_norm S.normed_mk m - ... = ∥y∥ / ∥m∥ : by rw [normed_mk.apply, hm] + calc ‖S.normed_mk‖ ≥ ‖(S.normed_mk) m‖ / ‖m‖ : ratio_le_op_norm S.normed_mk m + ... = ‖y‖ / ‖m‖ : by rw [normed_mk.apply, hm] ... ≥ (1 + min ε (1 / 2) / (1 - min ε (1 / 2)))⁻¹ : le_of_lt hlt ... = 1 - min ε (1 / 2) : by field_simp [(ne_of_lt hδ).symm] end /-- The operator norm of the projection is `0` if the subspace is dense. -/ lemma norm_trivial_quotient_mk (S : add_subgroup M) - (h : (S.topological_closure : set M) = set.univ) : ∥S.normed_mk∥ = 0 := + (h : (S.topological_closure : set M) = set.univ) : ‖S.normed_mk‖ = 0 := begin refine le_antisymm (op_norm_le_bound _ le_rfl (λ x, _)) (norm_nonneg _), have hker : x ∈ (S.normed_mk).ker.topological_closure, @@ -420,39 +436,39 @@ end end add_subgroup -namespace normed_group_hom +namespace normed_add_group_hom /-- `is_quotient f`, for `f : M ⟶ N` means that `N` is isomorphic to the quotient of `M` by the kernel of `f`. -/ -structure is_quotient (f : normed_group_hom M N) : Prop := +structure is_quotient (f : normed_add_group_hom M N) : Prop := (surjective : function.surjective f) -(norm : ∀ x, ∥f x∥ = Inf ((λ m, ∥x + m∥) '' f.ker)) +(norm : ∀ x, ‖f x‖ = Inf ((λ m, ‖x + m‖) '' f.ker)) -/-- Given `f : normed_group_hom M N` such that `f s = 0` for all `s ∈ S`, where, -`S : add_subgroup M` is closed, the induced morphism `normed_group_hom (M ⧸ S) N`. -/ +/-- Given `f : normed_add_group_hom M N` such that `f s = 0` for all `s ∈ S`, where, +`S : add_subgroup M` is closed, the induced morphism `normed_add_group_hom (M ⧸ S) N`. -/ noncomputable -def lift {N : Type*} [semi_normed_group N] (S : add_subgroup M) - (f : normed_group_hom M N) (hf : ∀ s ∈ S, f s = 0) : - normed_group_hom (M ⧸ S) N := +def lift {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M) + (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) : + normed_add_group_hom (M ⧸ S) N := { bound' := begin - obtain ⟨c : ℝ, hcpos : (0 : ℝ) < c, hc : ∀ x, ∥f x∥ ≤ c * ∥x∥⟩ := f.bound, + obtain ⟨c : ℝ, hcpos : (0 : ℝ) < c, hc : ∀ x, ‖f x‖ ≤ c * ‖x‖⟩ := f.bound, refine ⟨c, λ mbar, le_of_forall_pos_le_add (λ ε hε, _)⟩, - obtain ⟨m : M, rfl : mk' S m = mbar, hmnorm : ∥m∥ < ∥mk' S m∥ + ε/c⟩ := + obtain ⟨m : M, rfl : mk' S m = mbar, hmnorm : ‖m‖ < ‖mk' S m‖ + ε/c⟩ := norm_mk_lt mbar (div_pos hε hcpos), - calc ∥f m∥ ≤ c * ∥m∥ : hc m - ... ≤ c*(∥mk' S m∥ + ε/c) : ((mul_lt_mul_left hcpos).mpr hmnorm).le - ... = c * ∥mk' S m∥ + ε : by rw [mul_add, mul_div_cancel' _ hcpos.ne.symm] + calc ‖f m‖ ≤ c * ‖m‖ : hc m + ... ≤ c*(‖mk' S m‖ + ε/c) : ((mul_lt_mul_left hcpos).mpr hmnorm).le + ... = c * ‖mk' S m‖ + ε : by rw [mul_add, mul_div_cancel' _ hcpos.ne.symm] end, .. quotient_add_group.lift S f.to_add_monoid_hom hf } -lemma lift_mk {N : Type*} [semi_normed_group N] (S : add_subgroup M) - (f : normed_group_hom M N) (hf : ∀ s ∈ S, f s = 0) (m : M) : +lemma lift_mk {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M) + (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) (m : M) : lift S f hf (S.normed_mk m) = f m := rfl -lemma lift_unique {N : Type*} [semi_normed_group N] (S : add_subgroup M) - (f : normed_group_hom M N) (hf : ∀ s ∈ S, f s = 0) - (g : normed_group_hom (M ⧸ S) N) : +lemma lift_unique {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M) + (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) + (g : normed_add_group_hom (M ⧸ S) N) : g.comp (S.normed_mk) = f → g = lift S f hf := begin intro h, @@ -466,21 +482,21 @@ end lemma is_quotient_quotient (S : add_subgroup M) : is_quotient (S.normed_mk) := ⟨S.surjective_normed_mk, λ m, by simpa [S.ker_normed_mk] using quotient_norm_mk_eq _ m⟩ -lemma is_quotient.norm_lift {f : normed_group_hom M N} (hquot : is_quotient f) {ε : ℝ} (hε : 0 < ε) - (n : N) : ∃ (m : M), f m = n ∧ ∥m∥ < ∥n∥ + ε := +lemma is_quotient.norm_lift {f : normed_add_group_hom M N} (hquot : is_quotient f) {ε : ℝ} + (hε : 0 < ε) (n : N) : ∃ (m : M), f m = n ∧ ‖m‖ < ‖n‖ + ε := begin obtain ⟨m, rfl⟩ := hquot.surjective n, - have nonemp : ((λ m', ∥m + m'∥) '' f.ker).nonempty, + have nonemp : ((λ m', ‖m + m'‖) '' f.ker).nonempty, { rw set.nonempty_image_iff, exact ⟨0, f.ker.zero_mem⟩ }, rcases real.lt_Inf_add_pos nonemp hε with - ⟨_, ⟨⟨x, hx, rfl⟩, H : ∥m + x∥ < Inf ((λ (m' : M), ∥m + m'∥) '' f.ker) + ε⟩⟩, - exact ⟨m+x, by rw [f.map_add,(normed_group_hom.mem_ker f x).mp hx, add_zero], + ⟨_, ⟨⟨x, hx, rfl⟩, H : ‖m + x‖ < Inf ((λ (m' : M), ‖m + m'‖) '' f.ker) + ε⟩⟩, + exact ⟨m+x, by rw [map_add,(normed_add_group_hom.mem_ker f x).mp hx, add_zero], by rwa hquot.norm⟩, end -lemma is_quotient.norm_le {f : normed_group_hom M N} (hquot : is_quotient f) (m : M) : - ∥f m∥ ≤ ∥m∥ := +lemma is_quotient.norm_le {f : normed_add_group_hom M N} (hquot : is_quotient f) (m : M) : + ‖f m‖ ≤ ‖m‖ := begin rw hquot.norm, apply cInf_le, @@ -490,41 +506,141 @@ begin { exact ⟨0, f.ker.zero_mem, by simp⟩ } end -lemma lift_norm_le {N : Type*} [semi_normed_group N] (S : add_subgroup M) - (f : normed_group_hom M N) (hf : ∀ s ∈ S, f s = 0) - {c : ℝ≥0} (fb : ∥f∥ ≤ c) : - ∥lift S f hf∥ ≤ c := +lemma lift_norm_le {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M) + (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) + {c : ℝ≥0} (fb : ‖f‖ ≤ c) : + ‖lift S f hf‖ ≤ c := begin apply op_norm_le_bound _ c.coe_nonneg, intros x, by_cases hc : c = 0, { simp only [hc, nnreal.coe_zero, zero_mul] at fb ⊢, obtain ⟨x, rfl⟩ := surjective_quot_mk _ x, - show ∥f x∥ ≤ 0, - calc ∥f x∥ ≤ 0 * ∥x∥ : f.le_of_op_norm_le fb x + show ‖f x‖ ≤ 0, + calc ‖f x‖ ≤ 0 * ‖x‖ : f.le_of_op_norm_le fb x ... = 0 : zero_mul _ }, { replace hc : 0 < c := pos_iff_ne_zero.mpr hc, apply le_of_forall_pos_le_add, intros ε hε, have aux : 0 < (ε / c) := div_pos hε hc, - obtain ⟨x, rfl, Hx⟩ : ∃ x', S.normed_mk x' = x ∧ ∥x'∥ < ∥x∥ + (ε / c) := + obtain ⟨x, rfl, Hx⟩ : ∃ x', S.normed_mk x' = x ∧ ‖x'‖ < ‖x‖ + (ε / c) := (is_quotient_quotient _).norm_lift aux _, rw lift_mk, - calc ∥f x∥ ≤ c * ∥x∥ : f.le_of_op_norm_le fb x - ... ≤ c * (∥S.normed_mk x∥ + ε / c) : (mul_le_mul_left _).mpr Hx.le + calc ‖f x‖ ≤ c * ‖x‖ : f.le_of_op_norm_le fb x + ... ≤ c * (‖S.normed_mk x‖ + ε / c) : (mul_le_mul_left _).mpr Hx.le ... = c * _ + ε : _, { exact_mod_cast hc }, { rw [mul_add, mul_div_cancel'], exact_mod_cast hc.ne' } }, end -lemma lift_norm_noninc {N : Type*} [semi_normed_group N] (S : add_subgroup M) - (f : normed_group_hom M N) (hf : ∀ s ∈ S, f s = 0) +lemma lift_norm_noninc {N : Type*} [seminormed_add_comm_group N] (S : add_subgroup M) + (f : normed_add_group_hom M N) (hf : ∀ s ∈ S, f s = 0) (fb : f.norm_noninc) : (lift S f hf).norm_noninc := λ x, begin - have fb' : ∥f∥ ≤ (1 : ℝ≥0) := norm_noninc.norm_noninc_iff_norm_le_one.mp fb, + have fb' : ‖f‖ ≤ (1 : ℝ≥0) := norm_noninc.norm_noninc_iff_norm_le_one.mp fb, simpa using le_of_op_norm_le _ (f.lift_norm_le _ _ fb') _, end -end normed_group_hom +end normed_add_group_hom + +/-! +### Submodules and ideals + +In what follows, the norm structures created above for quotients of (semi)`normed_add_comm_group`s +by `add_subgroup`s are transferred via definitional equality to quotients of modules by submodules, +and of rings by ideals, thereby preserving the definitional equality for the topological group and +uniform structures worked for above. Completeness is also transferred via this definitional +equality. + +In addition, instances are constructed for `normed_space`, `semi_normed_comm_ring`, +`normed_comm_ring` and `normed_algebra` under the appropriate hypotheses. Currently, we do not +have quotients of rings by two-sided ideals, hence the commutativity hypotheses are required. + -/ + +section submodule + +variables {R : Type*} [ring R] [module R M] (S : submodule R M) + +instance submodule.quotient.seminormed_add_comm_group : + seminormed_add_comm_group (M ⧸ S) := +add_subgroup.seminormed_add_comm_group_quotient S.to_add_subgroup + +instance submodule.quotient.normed_add_comm_group [hS : is_closed (S : set M)] : + normed_add_comm_group (M ⧸ S) := +@add_subgroup.normed_add_comm_group_quotient _ _ S.to_add_subgroup hS + +instance submodule.quotient.complete_space [complete_space M] : complete_space (M ⧸ S) := +quotient_add_group.complete_space M S.to_add_subgroup + +/-- For any `x : M ⧸ S` and any `0 < ε`, there is `m : M` such that `submodule.quotient.mk m = x` +and `‖m‖ < ‖x‖ + ε`. -/ +lemma submodule.quotient.norm_mk_lt {S : submodule R M} (x : M ⧸ S) {ε : ℝ} (hε : 0 < ε) : + ∃ m : M, submodule.quotient.mk m = x ∧ ‖m‖ < ‖x‖ + ε := +norm_mk_lt x hε + +lemma submodule.quotient.norm_mk_le (m : M) : + ‖(submodule.quotient.mk m : M ⧸ S)‖ ≤ ‖m‖ := +quotient_norm_mk_le S.to_add_subgroup m + +instance submodule.quotient.normed_space (𝕜 : Type*) [normed_field 𝕜] [normed_space 𝕜 M] + [has_smul 𝕜 R] [is_scalar_tower 𝕜 R M] : normed_space 𝕜 (M ⧸ S) := +{ norm_smul_le := λ k x, le_of_forall_pos_le_add $ λ ε hε, + begin + have := (nhds_basis_ball.tendsto_iff nhds_basis_ball).mp + ((@real.uniform_continuous_const_mul (‖k‖)).continuous.tendsto (‖x‖)) ε hε, + simp only [mem_ball, exists_prop, dist, abs_sub_lt_iff] at this, + rcases this with ⟨δ, hδ, h⟩, + obtain ⟨a, rfl, ha⟩ := submodule.quotient.norm_mk_lt x hδ, + specialize h (‖a‖) (⟨by linarith, by linarith [submodule.quotient.norm_mk_le S a]⟩), + calc _ ≤ ‖k‖ * ‖a‖ : (quotient_norm_mk_le S.to_add_subgroup (k • a)).trans_eq (norm_smul k a) + ... ≤ _ : (sub_lt_iff_lt_add'.mp h.1).le + end, + .. submodule.quotient.module' S, } + +end submodule + +section ideal + +variables {R : Type*} [semi_normed_comm_ring R] (I : ideal R) + +lemma ideal.quotient.norm_mk_lt {I : ideal R} (x : R ⧸ I) {ε : ℝ} (hε : 0 < ε) : + ∃ r : R, ideal.quotient.mk I r = x ∧ ‖r‖ < ‖x‖ + ε := +norm_mk_lt x hε + +lemma ideal.quotient.norm_mk_le (r : R) : + ‖ideal.quotient.mk I r‖ ≤ ‖r‖ := +quotient_norm_mk_le I.to_add_subgroup r + +instance ideal.quotient.semi_normed_comm_ring : semi_normed_comm_ring (R ⧸ I) := +{ mul_comm := mul_comm, + norm_mul := λ x y, le_of_forall_pos_le_add $ λ ε hε, + begin + have := ((nhds_basis_ball.prod_nhds nhds_basis_ball).tendsto_iff nhds_basis_ball).mp + (real.continuous_mul.tendsto (‖x‖, ‖y‖)) ε hε, + simp only [set.mem_prod, mem_ball, and_imp, prod.forall, exists_prop, prod.exists] at this, + rcases this with ⟨ε₁, ε₂, ⟨h₁, h₂⟩, h⟩, + obtain ⟨⟨a, rfl, ha⟩, ⟨b, rfl, hb⟩⟩ := + ⟨ideal.quotient.norm_mk_lt x h₁, ideal.quotient.norm_mk_lt y h₂⟩, + simp only [dist, abs_sub_lt_iff] at h, + specialize h (‖a‖) (‖b‖) (⟨by linarith, by linarith [ideal.quotient.norm_mk_le I a]⟩) + (⟨by linarith, by linarith [ideal.quotient.norm_mk_le I b]⟩), + calc _ ≤ ‖a‖ * ‖b‖ : (ideal.quotient.norm_mk_le I (a * b)).trans (norm_mul_le a b) + ... ≤ _ : (sub_lt_iff_lt_add'.mp h.1).le + end, + .. submodule.quotient.seminormed_add_comm_group I } + +instance ideal.quotient.normed_comm_ring [is_closed (I : set R)] : + normed_comm_ring (R ⧸ I) := +{ .. ideal.quotient.semi_normed_comm_ring I, + .. submodule.quotient.normed_add_comm_group I } + +variables (𝕜 : Type*) [normed_field 𝕜] + +instance ideal.quotient.normed_algebra [normed_algebra 𝕜 R] : + normed_algebra 𝕜 (R ⧸ I) := +{ .. submodule.quotient.normed_space I 𝕜, + .. ideal.quotient.algebra 𝕜 } + +end ideal diff --git a/src/analysis/normed/group/seminorm.lean b/src/analysis/normed/group/seminorm.lean new file mode 100644 index 0000000000000..2386f19137eb2 --- /dev/null +++ b/src/analysis/normed/group/seminorm.lean @@ -0,0 +1,655 @@ +/- +Copyright (c) 2022 María Inés de Frutos-Fernández, Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: María Inés de Frutos-Fernández, Yaël Dillies +-/ +import tactic.positivity +import data.real.nnreal + +/-! +# Group seminorms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines norms and seminorms in a group. A group seminorm is a function to the reals which +is positive-semidefinite and subadditive. A norm further only maps zero to zero. + +## Main declarations + +* `add_group_seminorm`: A function `f` from an additive group `G` to the reals that preserves zero, + takes nonnegative values, is subadditive and such that `f (-x) = f x` for all `x`. +* `nonarch_add_group_seminorm`: A function `f` from an additive group `G` to the reals that + preserves zero, takes nonnegative values, is nonarchimedean and such that `f (-x) = f x` + for all `x`. +* `group_seminorm`: A function `f` from a group `G` to the reals that sends one to zero, takes + nonnegative values, is submultiplicative and such that `f x⁻¹ = f x` for all `x`. +* `add_group_norm`: A seminorm `f` such that `f x = 0 → x = 0` for all `x`. +* `nonarch_add_group_norm`: A nonarchimedean seminorm `f` such that `f x = 0 → x = 0` for all `x`. +* `group_norm`: A seminorm `f` such that `f x = 0 → x = 1` for all `x`. + +## Notes + +The corresponding hom classes are defined in `analysis.order.hom.basic` to be used by absolute +values. + +We do not define `nonarch_add_group_seminorm` as an extension of `add_group_seminorm` to avoid +having a superfluous `add_le'` field in the resulting structure. The same applies to +`nonarch_add_group_norm`. + +## References + +* [H. H. Schaefer, *Topological Vector Spaces*][schaefer1966] + +## Tags + +norm, seminorm +-/ + +set_option old_structure_cmd true + +open set +open_locale nnreal + +variables {ι R R' E F G : Type*} + +/-- A seminorm on an additive group `G` is a function `f : G → ℝ` that preserves zero, is +subadditive and such that `f (-x) = f x` for all `x`. -/ +@[protect_proj] +structure add_group_seminorm (G : Type*) [add_group G] extends zero_hom G ℝ := +(add_le' : ∀ r s, to_fun (r + s) ≤ to_fun r + to_fun s) +(neg' : ∀ r, to_fun (-r) = to_fun r) + +/-- A seminorm on a group `G` is a function `f : G → ℝ` that sends one to zero, is submultiplicative +and such that `f x⁻¹ = f x` for all `x`. -/ +@[to_additive, protect_proj] +structure group_seminorm (G : Type*) [group G] := +(to_fun : G → ℝ) +(map_one' : to_fun 1 = 0) +(mul_le' : ∀ x y, to_fun (x * y) ≤ to_fun x + to_fun y) +(inv' : ∀ x, to_fun x⁻¹ = to_fun x) + +/-- A nonarchimedean seminorm on an additive group `G` is a function `f : G → ℝ` that preserves +zero, is nonarchimedean and such that `f (-x) = f x` for all `x`. -/ +@[protect_proj] +structure nonarch_add_group_seminorm (G : Type*) [add_group G] extends zero_hom G ℝ := +(add_le_max' : ∀ r s, to_fun (r + s) ≤ max (to_fun r) (to_fun s)) +(neg' : ∀ r, to_fun (-r) = to_fun r) + +/-! NOTE: We do not define `nonarch_add_group_seminorm` as an extension of `add_group_seminorm` + to avoid having a superfluous `add_le'` field in the resulting structure. The same applies to + `nonarch_add_group_norm` below. -/ + +/-- A norm on an additive group `G` is a function `f : G → ℝ` that preserves zero, is subadditive +and such that `f (-x) = f x` and `f x = 0 → x = 0` for all `x`. -/ +@[protect_proj] +structure add_group_norm (G : Type*) [add_group G] extends add_group_seminorm G := +(eq_zero_of_map_eq_zero' : ∀ x, to_fun x = 0 → x = 0) + +/-- A seminorm on a group `G` is a function `f : G → ℝ` that sends one to zero, is submultiplicative +and such that `f x⁻¹ = f x` and `f x = 0 → x = 1` for all `x`. -/ +@[protect_proj, to_additive] +structure group_norm (G : Type*) [group G] extends group_seminorm G := +(eq_one_of_map_eq_zero' : ∀ x, to_fun x = 0 → x = 1) + +/-- A nonarchimedean norm on an additive group `G` is a function `f : G → ℝ` that preserves zero, is +nonarchimedean and such that `f (-x) = f x` and `f x = 0 → x = 0` for all `x`. -/ +@[protect_proj] +structure nonarch_add_group_norm (G : Type*) [add_group G] extends nonarch_add_group_seminorm G := +(eq_zero_of_map_eq_zero' : ∀ x, to_fun x = 0 → x = 0) + +attribute [nolint doc_blame] add_group_seminorm.to_zero_hom add_group_norm.to_add_group_seminorm + group_norm.to_group_seminorm nonarch_add_group_seminorm.to_zero_hom + nonarch_add_group_norm.to_nonarch_add_group_seminorm + +attribute [to_additive] group_norm.to_group_seminorm + +/-- `nonarch_add_group_seminorm_class F α` states that `F` is a type of nonarchimedean seminorms on +the additive group `α`. + +You should extend this class when you extend `nonarch_add_group_seminorm`. -/ +@[protect_proj] +class nonarch_add_group_seminorm_class (F : Type*) (α : out_param $ Type*) [add_group α] + extends nonarchimedean_hom_class F α ℝ := +(map_zero (f : F) : f 0 = 0) +(map_neg_eq_map' (f : F) (a : α) : f (-a) = f a) + +/-- `nonarch_add_group_norm_class F α` states that `F` is a type of nonarchimedean norms on the +additive group `α`. + +You should extend this class when you extend `nonarch_add_group_norm`. -/ +@[protect_proj] +class nonarch_add_group_norm_class (F : Type*) (α : out_param $ Type*) [add_group α] + extends nonarch_add_group_seminorm_class F α := +(eq_zero_of_map_eq_zero (f : F) {a : α} : f a = 0 → a = 0) + +section nonarch_add_group_seminorm_class +variables [add_group E] [nonarch_add_group_seminorm_class F E] (f : F) (x y : E) +include E + +lemma map_sub_le_max : f (x - y) ≤ max (f x) (f y) := +by { rw [sub_eq_add_neg, ← nonarch_add_group_seminorm_class.map_neg_eq_map' f y], + exact map_add_le_max _ _ _ } + +end nonarch_add_group_seminorm_class + +@[priority 100] -- See note [lower instance priority] +instance nonarch_add_group_seminorm_class.to_add_group_seminorm_class [add_group E] + [nonarch_add_group_seminorm_class F E] : + add_group_seminorm_class F E ℝ := +{ map_add_le_add := λ f x y, begin + have h_nonneg : ∀ a, 0 ≤ f a, + { intro a, + rw [← nonarch_add_group_seminorm_class.map_zero f, ← sub_self a], + exact le_trans (map_sub_le_max _ _ _) (by rw max_self (f a)) }, + exact le_trans (map_add_le_max _ _ _) + (max_le (le_add_of_nonneg_right (h_nonneg _)) (le_add_of_nonneg_left (h_nonneg _))), + end, + map_neg_eq_map := nonarch_add_group_seminorm_class.map_neg_eq_map', + ..‹nonarch_add_group_seminorm_class F E› } + +@[priority 100] -- See note [lower instance priority] +instance nonarch_add_group_norm_class.to_add_group_norm_class [add_group E] + [nonarch_add_group_norm_class F E] : + add_group_norm_class F E ℝ := +{ map_add_le_add := map_add_le_add, + map_neg_eq_map := nonarch_add_group_seminorm_class.map_neg_eq_map', + ..‹nonarch_add_group_norm_class F E› } + +/-! ### Seminorms -/ + +namespace group_seminorm +section group +variables [group E] [group F] [group G] {p q : group_seminorm E} + +@[to_additive] instance group_seminorm_class : group_seminorm_class (group_seminorm E) E ℝ := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_one_eq_zero := λ f, f.map_one', + map_mul_le_add := λ f, f.mul_le', + map_inv_eq_map := λ f, f.inv' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +@[to_additive "Helper instance for when there's too many metavariables to apply +`fun_like.has_coe_to_fun`. "] +instance : has_coe_to_fun (group_seminorm E) (λ _, E → ℝ) := ⟨group_seminorm.to_fun⟩ + +@[simp, to_additive] lemma to_fun_eq_coe : p.to_fun = p := rfl + +@[ext, to_additive] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q + +@[to_additive] instance : partial_order (group_seminorm E) := +partial_order.lift _ fun_like.coe_injective + +@[to_additive] lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl +@[to_additive] lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl + +@[simp, to_additive, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl +@[simp, to_additive, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl + +variables (p q) (f : F →* E) + +@[to_additive] instance : has_zero (group_seminorm E) := +⟨{ to_fun := 0, + map_one' := pi.zero_apply _, + mul_le' := λ _ _, (zero_add _).ge, + inv' := λ x, rfl}⟩ + +@[simp, to_additive, norm_cast] lemma coe_zero : ⇑(0 : group_seminorm E) = 0 := rfl +@[simp, to_additive] lemma zero_apply (x : E) : (0 : group_seminorm E) x = 0 := rfl + +@[to_additive] instance : inhabited (group_seminorm E) := ⟨0⟩ + +@[to_additive] instance : has_add (group_seminorm E) := +⟨λ p q, + { to_fun := λ x, p x + q x, + map_one' := by rw [map_one_eq_zero p, map_one_eq_zero q, zero_add], + mul_le' := λ _ _, (add_le_add (map_mul_le_add p _ _) $ map_mul_le_add q _ _).trans_eq $ + add_add_add_comm _ _ _ _, + inv' := λ x, by rw [map_inv_eq_map p, map_inv_eq_map q] }⟩ + +@[simp, to_additive] lemma coe_add : ⇑(p + q) = p + q := rfl +@[simp, to_additive] lemma add_apply (x : E) : (p + q) x = p x + q x := rfl + +-- TODO: define `has_Sup` too, from the skeleton at +-- https://github.com/leanprover-community/mathlib/pull/11329#issuecomment-1008915345 +@[to_additive] instance : has_sup (group_seminorm E) := +⟨λ p q, + { to_fun := p ⊔ q, + map_one' := + by rw [pi.sup_apply, ←map_one_eq_zero p, sup_eq_left, map_one_eq_zero p, map_one_eq_zero q], + mul_le' := λ x y, sup_le + ((map_mul_le_add p x y).trans $ add_le_add le_sup_left le_sup_left) + ((map_mul_le_add q x y).trans $ add_le_add le_sup_right le_sup_right), + inv' := λ x, by rw [pi.sup_apply, pi.sup_apply, map_inv_eq_map p, map_inv_eq_map q] }⟩ + +@[simp, to_additive, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl +@[simp, to_additive] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl + +@[to_additive] instance : semilattice_sup (group_seminorm E) := +fun_like.coe_injective.semilattice_sup _ coe_sup + +/-- Composition of a group seminorm with a monoid homomorphism as a group seminorm. -/ +@[to_additive "Composition of an additive group seminorm with an additive monoid homomorphism as an +additive group seminorm."] +def comp (p : group_seminorm E) (f : F →* E) : group_seminorm F := +{ to_fun := λ x, p (f x), + map_one' := by rw [f.map_one, map_one_eq_zero p], + mul_le' := λ _ _, (congr_arg p $ f.map_mul _ _).trans_le $ map_mul_le_add p _ _, + inv' := λ x, by rw [map_inv, map_inv_eq_map p] } + +@[simp, to_additive] lemma coe_comp : ⇑(p.comp f) = p ∘ f := rfl +@[simp, to_additive] lemma comp_apply (x : F) : (p.comp f) x = p (f x) := rfl +@[simp, to_additive] lemma comp_id : p.comp (monoid_hom.id _) = p := ext $ λ _, rfl +@[simp, to_additive] lemma comp_zero : p.comp (1 : F →* E) = 0 := ext $ λ _, map_one_eq_zero p +@[simp, to_additive] lemma zero_comp : (0 : group_seminorm E).comp f = 0 := ext $ λ _, rfl + +@[to_additive] lemma comp_assoc (g : F →* E) (f : G →* F) : p.comp (g.comp f) = (p.comp g).comp f := +ext $ λ _, rfl + +@[to_additive] lemma add_comp (f : F →* E) : (p + q).comp f = p.comp f + q.comp f := ext $ λ _, rfl + +variables {p q} + +@[to_additive] lemma comp_mono (hp : p ≤ q) : p.comp f ≤ q.comp f := λ _, hp _ + +end group + +section comm_group +variables [comm_group E] [comm_group F] (p q : group_seminorm E) (x y : E) + +@[to_additive] lemma comp_mul_le (f g : F →* E) : p.comp (f * g) ≤ p.comp f + p.comp g := +λ _, map_mul_le_add p _ _ + +@[to_additive] lemma mul_bdd_below_range_add {p q : group_seminorm E} {x : E} : + bdd_below (range $ λ y, p y + q (x / y)) := +⟨0, by { rintro _ ⟨x, rfl⟩, dsimp, positivity }⟩ + +@[to_additive] noncomputable instance : has_inf (group_seminorm E) := +⟨λ p q, + { to_fun := λ x, ⨅ y, p y + q (x / y), + map_one' := cinfi_eq_of_forall_ge_of_forall_gt_exists_lt (λ x, by positivity) + (λ r hr, ⟨1, by rwa [div_one, map_one_eq_zero p, map_one_eq_zero q, add_zero]⟩), + mul_le' := λ x y, le_cinfi_add_cinfi $ λ u v, begin + refine cinfi_le_of_le mul_bdd_below_range_add (u * v) _, + rw [mul_div_mul_comm, add_add_add_comm], + exact add_le_add (map_mul_le_add p _ _) (map_mul_le_add q _ _), + end, + inv' := λ x, (inv_surjective.infi_comp _).symm.trans $ + by simp_rw [map_inv_eq_map p, ←inv_div', map_inv_eq_map q] }⟩ + +@[simp, to_additive] lemma inf_apply : (p ⊓ q) x = ⨅ y, p y + q (x / y) := rfl + +@[to_additive] noncomputable instance : lattice (group_seminorm E) := +{ inf := (⊓), + inf_le_left := λ p q x, cinfi_le_of_le mul_bdd_below_range_add x $ + by rw [div_self', map_one_eq_zero q, add_zero], + inf_le_right := λ p q x, cinfi_le_of_le mul_bdd_below_range_add (1 : E) $ + by simp only [div_one, map_one_eq_zero p, zero_add], + le_inf := λ a b c hb hc x, le_cinfi $ λ u, (le_map_add_map_div a _ _).trans $ + add_le_add (hb _) (hc _), + ..group_seminorm.semilattice_sup } + +end comm_group +end group_seminorm + +/- TODO: All the following ought to be automated using `to_additive`. The problem is that it doesn't +see that `has_smul R ℝ` should be fixed because `ℝ` is fixed. -/ + +namespace add_group_seminorm +variables [add_group E] [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] + (p : add_group_seminorm E) + +instance [decidable_eq E] : has_one (add_group_seminorm E) := +⟨{ to_fun := λ x, if x = 0 then 0 else 1, + map_zero' := if_pos rfl, + add_le' := λ x y, begin + by_cases hx : x = 0, + { rw [if_pos hx, hx, zero_add, zero_add] }, + { rw if_neg hx, + refine le_add_of_le_of_nonneg _ _; split_ifs; norm_num } + end, + neg' := λ x, by simp_rw neg_eq_zero }⟩ + +@[simp] lemma apply_one [decidable_eq E] (x : E) : + (1 : add_group_seminorm E) x = if x = 0 then 0 else 1 := rfl + +/-- Any action on `ℝ` which factors through `ℝ≥0` applies to an `add_group_seminorm`. -/ +instance : has_smul R (add_group_seminorm E) := +⟨λ r p, + { to_fun := λ x, r • p x, + map_zero' := by simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul, + map_zero, mul_zero], + add_le' := λ _ _, begin + simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul], + exact (mul_le_mul_of_nonneg_left (map_add_le_add _ _ _) $ nnreal.coe_nonneg _).trans_eq + (mul_add _ _ _), + end, + neg' := λ x, by rw map_neg_eq_map }⟩ + +@[simp, norm_cast] lemma coe_smul (r : R) (p : add_group_seminorm E) : ⇑(r • p) = r • p := rfl +@[simp] lemma smul_apply (r : R) (p : add_group_seminorm E) (x : E) : (r • p) x = r • p x := rfl + +instance [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] + [has_smul R R'] [is_scalar_tower R R' ℝ] : + is_scalar_tower R R' (add_group_seminorm E) := +⟨λ r a p, ext $ λ x, smul_assoc r a (p x)⟩ + +lemma smul_sup (r : R) (p q : add_group_seminorm E) : r • (p ⊔ q) = r • p ⊔ r • q := +have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y), +from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)] + using mul_max_of_nonneg x y (r • 1 : ℝ≥0).coe_nonneg, +ext $ λ x, real.smul_max _ _ + +end add_group_seminorm + +namespace nonarch_add_group_seminorm +section add_group +variables [add_group E] [add_group F] [add_group G] {p q : nonarch_add_group_seminorm E} + +instance nonarch_add_group_seminorm_class : + nonarch_add_group_seminorm_class (nonarch_add_group_seminorm E) E := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_add_le_max := λ f, f.add_le_max', + map_zero := λ f, f.map_zero', + map_neg_eq_map' := λ f, f.neg', } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +instance : has_coe_to_fun (nonarch_add_group_seminorm E) (λ _, E → ℝ) := +⟨nonarch_add_group_seminorm.to_fun⟩ + +@[simp] lemma to_fun_eq_coe : p.to_fun = p := rfl + +@[ext] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q + +noncomputable instance : partial_order (nonarch_add_group_seminorm E) := +partial_order.lift _ fun_like.coe_injective + +lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl +lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl + +@[simp, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl +@[simp, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl + +variables (p q) (f : F →+ E) + +instance : has_zero (nonarch_add_group_seminorm E) := +⟨{ to_fun := 0, + map_zero' := pi.zero_apply _, + add_le_max' := λ r s, by simp only [pi.zero_apply, max_eq_right], + neg' := λ x, rfl}⟩ + +@[simp, norm_cast] lemma coe_zero : ⇑(0 : nonarch_add_group_seminorm E) = 0 := rfl +@[simp] lemma zero_apply (x : E) : (0 : nonarch_add_group_seminorm E) x = 0 := rfl + +instance : inhabited (nonarch_add_group_seminorm E) := ⟨0⟩ + +-- TODO: define `has_Sup` too, from the skeleton at +-- https://github.com/leanprover-community/mathlib/pull/11329#issuecomment-1008915345 +instance : has_sup (nonarch_add_group_seminorm E) := +⟨λ p q, + { to_fun := p ⊔ q, + map_zero' := by rw [pi.sup_apply, ←map_zero p, sup_eq_left, map_zero p, map_zero q], + add_le_max' := λ x y, sup_le + ((map_add_le_max p x y).trans $ max_le_max le_sup_left le_sup_left) + ((map_add_le_max q x y).trans $ max_le_max le_sup_right le_sup_right), + neg' := λ x, by rw [pi.sup_apply, pi.sup_apply, map_neg_eq_map p, map_neg_eq_map q] }⟩ + +@[simp, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl +@[simp] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl + +noncomputable instance : semilattice_sup (nonarch_add_group_seminorm E) := +fun_like.coe_injective.semilattice_sup _ coe_sup + +end add_group + +section add_comm_group +variables [add_comm_group E] [add_comm_group F] (p q : nonarch_add_group_seminorm E) (x y : E) + +lemma add_bdd_below_range_add {p q : nonarch_add_group_seminorm E} {x : E} : + bdd_below (range $ λ y, p y + q (x - y)) := +⟨0, by { rintro _ ⟨x, rfl⟩, dsimp, positivity }⟩ + +end add_comm_group +end nonarch_add_group_seminorm + +namespace group_seminorm +variables [group E] [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] + +@[to_additive add_group_seminorm.has_one] +instance [decidable_eq E] : has_one (group_seminorm E) := +⟨{ to_fun := λ x, if x = 1 then 0 else 1, + map_one' := if_pos rfl, + mul_le' := λ x y, begin + by_cases hx : x = 1, + { rw [if_pos hx, hx, one_mul, zero_add] }, + { rw if_neg hx, + refine le_add_of_le_of_nonneg _ _; split_ifs; norm_num } + end, + inv' := λ x, by simp_rw inv_eq_one }⟩ + +@[simp, to_additive add_group_seminorm.apply_one] lemma apply_one [decidable_eq E] (x : E) : + (1 : group_seminorm E) x = if x = 1 then 0 else 1 := rfl + +/-- Any action on `ℝ` which factors through `ℝ≥0` applies to an `add_group_seminorm`. -/ +@[to_additive add_group_seminorm.has_smul] instance : has_smul R (group_seminorm E) := +⟨λ r p, + { to_fun := λ x, r • p x, + map_one' := by simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul, + map_one_eq_zero p, mul_zero], + mul_le' := λ _ _, begin + simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul], + exact (mul_le_mul_of_nonneg_left (map_mul_le_add p _ _) $ nnreal.coe_nonneg _).trans_eq + (mul_add _ _ _), + end, + inv' := λ x, by rw map_inv_eq_map p }⟩ + +@[to_additive add_group_seminorm.is_scalar_tower] +instance [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] [has_smul R R'] + [is_scalar_tower R R' ℝ] : is_scalar_tower R R' (group_seminorm E) := +⟨λ r a p, ext $ λ x, smul_assoc r a $ p x⟩ + +@[simp, to_additive add_group_seminorm.coe_smul, norm_cast] +lemma coe_smul (r : R) (p : group_seminorm E) : ⇑(r • p) = r • p := rfl + +@[simp, to_additive add_group_seminorm.smul_apply] +lemma smul_apply (r : R) (p : group_seminorm E) (x : E) : (r • p) x = r • p x := rfl + +@[to_additive add_group_seminorm.smul_sup] +lemma smul_sup (r : R) (p q : group_seminorm E) : r • (p ⊔ q) = r • p ⊔ r • q := +have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y), +from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)] + using mul_max_of_nonneg x y (r • 1 : ℝ≥0).coe_nonneg, +ext $ λ x, real.smul_max _ _ + +end group_seminorm + +namespace nonarch_add_group_seminorm +variables [add_group E] [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] + +instance [decidable_eq E] : has_one (nonarch_add_group_seminorm E) := +⟨{ to_fun := λ x, if x = 0 then 0 else 1, + map_zero' := if_pos rfl, + add_le_max' := λ x y, begin + by_cases hx : x = 0, + { rw [if_pos hx, hx, zero_add], exact le_max_of_le_right (le_refl _) }, + { rw if_neg hx, split_ifs; norm_num } + end, + neg' := λ x, by simp_rw neg_eq_zero }⟩ + +@[simp] lemma apply_one [decidable_eq E] (x : E) : + (1 : nonarch_add_group_seminorm E) x = if x = 0 then 0 else 1 := rfl + +/-- Any action on `ℝ` which factors through `ℝ≥0` applies to a `nonarch_add_group_seminorm`. -/ +instance : has_smul R (nonarch_add_group_seminorm E) := +⟨λ r p, + { to_fun := λ x, r • p x, + map_zero' := by simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul, + map_zero p, mul_zero], + add_le_max' := λ x y, begin + simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul, + ← mul_max_of_nonneg _ _ nnreal.zero_le_coe], + exact mul_le_mul_of_nonneg_left (map_add_le_max p _ _) nnreal.zero_le_coe, + end, + neg' := λ x, by rw map_neg_eq_map p }⟩ + +instance [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] [has_smul R R'] + [is_scalar_tower R R' ℝ] : is_scalar_tower R R' (nonarch_add_group_seminorm E) := +⟨λ r a p, ext $ λ x, smul_assoc r a $ p x⟩ + +@[simp, norm_cast] lemma coe_smul (r : R) (p : nonarch_add_group_seminorm E) : ⇑(r • p) = r • p := +rfl + +@[simp] +lemma smul_apply (r : R) (p : nonarch_add_group_seminorm E) (x : E) : (r • p) x = r • p x := rfl + +lemma smul_sup (r : R) (p q : nonarch_add_group_seminorm E) : r • (p ⊔ q) = r • p ⊔ r • q := +have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y), +from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)] + using mul_max_of_nonneg x y (r • 1 : ℝ≥0).coe_nonneg, +ext $ λ x, real.smul_max _ _ + +end nonarch_add_group_seminorm + +/-! ### Norms -/ + +namespace group_norm +section group +variables [group E] [group F] [group G] {p q : group_norm E} + +@[to_additive] instance group_norm_class : group_norm_class (group_norm E) E ℝ := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_one_eq_zero := λ f, f.map_one', + map_mul_le_add := λ f, f.mul_le', + map_inv_eq_map := λ f, f.inv', + eq_one_of_map_eq_zero := λ f, f.eq_one_of_map_eq_zero' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +@[to_additive "Helper instance for when there's too many metavariables to apply +`fun_like.has_coe_to_fun` directly. "] +instance : has_coe_to_fun (group_norm E) (λ _, E → ℝ) := fun_like.has_coe_to_fun + +@[simp, to_additive] lemma to_fun_eq_coe : p.to_fun = p := rfl + +@[ext, to_additive] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q + +@[to_additive] instance : partial_order (group_norm E) := +partial_order.lift _ fun_like.coe_injective + +@[to_additive] lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl +@[to_additive] lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl + +@[simp, to_additive, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl +@[simp, to_additive, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl + +variables (p q) (f : F →* E) + +@[to_additive] instance : has_add (group_norm E) := +⟨λ p q, { eq_one_of_map_eq_zero' := λ x hx, of_not_not $ λ h, + hx.not_gt $ add_pos (map_pos_of_ne_one p h) (map_pos_of_ne_one q h), + ..p.to_group_seminorm + q.to_group_seminorm }⟩ + +@[simp, to_additive] lemma coe_add : ⇑(p + q) = p + q := rfl +@[simp, to_additive] lemma add_apply (x : E) : (p + q) x = p x + q x := rfl + +-- TODO: define `has_Sup` +@[to_additive] instance : has_sup (group_norm E) := +⟨λ p q, + { eq_one_of_map_eq_zero' := λ x hx, of_not_not $ λ h, hx.not_gt $ + lt_sup_iff.2 $ or.inl $ map_pos_of_ne_one p h, + ..p.to_group_seminorm ⊔ q.to_group_seminorm }⟩ + +@[simp, to_additive, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl +@[simp, to_additive] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl + +@[to_additive] instance : semilattice_sup (group_norm E) := +fun_like.coe_injective.semilattice_sup _ coe_sup + +end group +end group_norm + +namespace add_group_norm +variables [add_group E] [decidable_eq E] + +instance : has_one (add_group_norm E) := +⟨{ eq_zero_of_map_eq_zero' := λ x, zero_ne_one.ite_eq_left_iff.1, + ..(1 : add_group_seminorm E) }⟩ + +@[simp] lemma apply_one (x : E) : (1 : add_group_norm E) x = if x = 0 then 0 else 1 := rfl + +instance : inhabited (add_group_norm E) := ⟨1⟩ + +end add_group_norm + +namespace group_norm +variables [group E] [decidable_eq E] + +@[to_additive add_group_norm.has_one] instance : has_one (group_norm E) := +⟨{ eq_one_of_map_eq_zero' := λ x, zero_ne_one.ite_eq_left_iff.1, + ..(1 : group_seminorm E) }⟩ + +@[simp, to_additive add_group_norm.apply_one] +lemma apply_one (x : E) : (1 : group_norm E) x = if x = 1 then 0 else 1 := rfl + +@[to_additive] instance : inhabited (group_norm E) := ⟨1⟩ + +end group_norm + +namespace nonarch_add_group_norm +section add_group +variables [add_group E] [add_group F] {p q : nonarch_add_group_norm E} + +instance nonarch_add_group_norm_class : + nonarch_add_group_norm_class (nonarch_add_group_norm E) E := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_add_le_max := λ f, f.add_le_max', + map_zero := λ f, f.map_zero', + map_neg_eq_map' := λ f, f.neg', + eq_zero_of_map_eq_zero := λ f, f.eq_zero_of_map_eq_zero' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +noncomputable instance : has_coe_to_fun (nonarch_add_group_norm E) (λ _, E → ℝ) := +fun_like.has_coe_to_fun + +@[simp] lemma to_fun_eq_coe : p.to_fun = p := rfl + +@[ext] lemma ext : (∀ x, p x = q x) → p = q := fun_like.ext p q + +noncomputable instance : partial_order (nonarch_add_group_norm E) := +partial_order.lift _ fun_like.coe_injective + +lemma le_def : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl +lemma lt_def : p < q ↔ (p : E → ℝ) < q := iff.rfl + +@[simp, norm_cast] lemma coe_le_coe : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl +@[simp, norm_cast] lemma coe_lt_coe : (p : E → ℝ) < q ↔ p < q := iff.rfl + +variables (p q) (f : F →+ E) + +instance : has_sup (nonarch_add_group_norm E) := +⟨λ p q, + { eq_zero_of_map_eq_zero' := λ x hx, of_not_not $ λ h, hx.not_gt $ + lt_sup_iff.2 $ or.inl $ map_pos_of_ne_zero p h, + ..p.to_nonarch_add_group_seminorm ⊔ q.to_nonarch_add_group_seminorm }⟩ + +@[simp, norm_cast] lemma coe_sup : ⇑(p ⊔ q) = p ⊔ q := rfl +@[simp] lemma sup_apply (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl + +noncomputable instance : semilattice_sup (nonarch_add_group_norm E) := +fun_like.coe_injective.semilattice_sup _ coe_sup + +instance [decidable_eq E] : has_one (nonarch_add_group_norm E) := +⟨{ eq_zero_of_map_eq_zero' := λ x, zero_ne_one.ite_eq_left_iff.1, + ..(1 : nonarch_add_group_seminorm E) }⟩ + +@[simp] lemma apply_one [decidable_eq E] (x : E) : + (1 : nonarch_add_group_norm E) x = if x = 0 then 0 else 1 := rfl + +instance [decidable_eq E] : inhabited (nonarch_add_group_norm E) := ⟨1⟩ + +end add_group +end nonarch_add_group_norm diff --git a/src/analysis/normed/mul_action.lean b/src/analysis/normed/mul_action.lean new file mode 100644 index 0000000000000..9765c4e68b77f --- /dev/null +++ b/src/analysis/normed/mul_action.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import topology.metric_space.algebra +import analysis.normed.field.basic + +/-! +# Lemmas for `has_bounded_smul` over normed additive groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Lemmas which hold only in `normed_space α β` are provided in another file. + +Notably we prove that `non_unital_semi_normed_ring`s have bounded actions by left- and right- +multiplication. This allows downstream files to write general results about `bounded_smul`, and then +deduce `const_mul` and `mul_const` results as an immediate corollary. +-/ + +variables {α β : Type*} + +section seminormed_add_group +variables [seminormed_add_group α] [seminormed_add_group β] [smul_zero_class α β] +variables [has_bounded_smul α β] + +lemma norm_smul_le (r : α) (x : β) : ‖r • x‖ ≤ ‖r‖ * ‖x‖ := +by simpa [smul_zero] using dist_smul_pair r 0 x + +lemma nnnorm_smul_le (r : α) (x : β) : ‖r • x‖₊ ≤ ‖r‖₊ * ‖x‖₊ := +norm_smul_le _ _ + +lemma dist_smul_le (s : α) (x y : β) : dist (s • x) (s • y) ≤ ‖s‖ * dist x y := +by simpa only [dist_eq_norm, sub_zero] using dist_smul_pair s x y + +lemma nndist_smul_le (s : α) (x y : β) : nndist (s • x) (s • y) ≤ ‖s‖₊ * nndist x y := +dist_smul_le s x y + +lemma edist_smul_le (s : α) (x y : β) : edist (s • x) (s • y) ≤ ‖s‖₊ • edist x y := +by simpa only [edist_nndist, ennreal.coe_mul] using ennreal.coe_le_coe.mpr (nndist_smul_le s x y) + +lemma lipschitz_with_smul (s : α) : lipschitz_with ‖s‖₊ ((•) s : β → β) := +lipschitz_with_iff_dist_le_mul.2 $ dist_smul_le _ + +end seminormed_add_group + +/-- Left multiplication is bounded. -/ +instance non_unital_semi_normed_ring.to_has_bounded_smul [non_unital_semi_normed_ring α] : + has_bounded_smul α α := +{ dist_smul_pair' := λ x y₁ y₂, by simpa [mul_sub, dist_eq_norm] using norm_mul_le x (y₁ - y₂), + dist_pair_smul' := λ x₁ x₂ y, by simpa [sub_mul, dist_eq_norm] using norm_mul_le (x₁ - x₂) y, } + +/-- Right multiplication is bounded. -/ +instance non_unital_semi_normed_ring.to_has_bounded_op_smul [non_unital_semi_normed_ring α] : + has_bounded_smul αᵐᵒᵖ α := +{ dist_smul_pair' := λ x y₁ y₂, + by simpa [sub_mul, dist_eq_norm, mul_comm] using norm_mul_le (y₁ - y₂) x.unop, + dist_pair_smul' := λ x₁ x₂ y, + by simpa [mul_sub, dist_eq_norm, mul_comm] using norm_mul_le y (x₁ - x₂).unop, } + +section semi_normed_ring +variables [semi_normed_ring α] [seminormed_add_comm_group β] [module α β] + +lemma has_bounded_smul.of_norm_smul_le (h : ∀ (r : α) (x : β), ‖r • x‖ ≤ ‖r‖ * ‖x‖) : + has_bounded_smul α β := +{ dist_smul_pair' := λ a b₁ b₂, by simpa [smul_sub, dist_eq_norm] using h a (b₁ - b₂), + dist_pair_smul' := λ a₁ a₂ b, by simpa [sub_smul, dist_eq_norm] using h (a₁ - a₂) b } + +end semi_normed_ring + +section normed_division_ring +variables [normed_division_ring α] [seminormed_add_group β] +variables [mul_action_with_zero α β] [has_bounded_smul α β] + +lemma norm_smul (r : α) (x : β) : ‖r • x‖ = ‖r‖ * ‖x‖ := +begin + by_cases h : r = 0, + { simp [h, zero_smul α x] }, + { refine le_antisymm (norm_smul_le r x) _, + calc ‖r‖ * ‖x‖ = ‖r‖ * ‖r⁻¹ • r • x‖ : by rw [inv_smul_smul₀ h] + ... ≤ ‖r‖ * (‖r⁻¹‖ * ‖r • x‖) : + mul_le_mul_of_nonneg_left (norm_smul_le _ _) (norm_nonneg _) + ... = ‖r • x‖ : + by rw [norm_inv, ← mul_assoc, mul_inv_cancel (mt norm_eq_zero.1 h), one_mul] } +end + +lemma nnnorm_smul (r : α) (x : β) : ‖r • x‖₊ = ‖r‖₊ * ‖x‖₊ := +nnreal.eq $ norm_smul r x + +end normed_division_ring + +section normed_division_ring_module +variables [normed_division_ring α] [seminormed_add_comm_group β] +variables [module α β] [has_bounded_smul α β] + +lemma dist_smul₀ (s : α) (x y : β) : dist (s • x) (s • y) = ‖s‖ * dist x y := +by simp_rw [dist_eq_norm, (norm_smul _ _).symm, smul_sub] + +lemma nndist_smul₀ (s : α) (x y : β) : nndist (s • x) (s • y) = ‖s‖₊ * nndist x y := +nnreal.eq $ dist_smul₀ s x y + +lemma edist_smul₀ (s : α) (x y : β) : edist (s • x) (s • y) = ‖s‖₊ • edist x y := +by simp only [edist_nndist, nndist_smul₀, ennreal.coe_mul, ennreal.smul_def, smul_eq_mul] + +end normed_division_ring_module diff --git a/src/analysis/normed/normed_field.lean b/src/analysis/normed/normed_field.lean deleted file mode 100644 index ba363db236272..0000000000000 --- a/src/analysis/normed/normed_field.lean +++ /dev/null @@ -1,830 +0,0 @@ -/- -Copyright (c) 2018 Patrick Massot. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Patrick Massot, Johannes Hölzl --/ -import analysis.normed.group.infinite_sum -import topology.algebra.module.basic -import topology.instances.ennreal -import topology.instances.rat - -/-! -# Normed fields - -In this file we define (semi)normed rings and fields. We also prove some theorems about these -definitions. --/ - -variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*} - -noncomputable theory -open filter metric -open_locale topological_space big_operators nnreal ennreal uniformity pointwise - -/-- A non-unital seminormed ring is a not-necessarily-unital ring -endowed with a seminorm which satisfies the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/ -class non_unital_semi_normed_ring (α : Type*) - extends has_norm α, non_unital_ring α, pseudo_metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) - -/-- A seminormed ring is a ring endowed with a seminorm which satisfies the inequality -`∥x y∥ ≤ ∥x∥ ∥y∥`. -/ -class semi_normed_ring (α : Type*) extends has_norm α, ring α, pseudo_metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) - -/-- A seminormed ring is a non-unital seminormed ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance semi_normed_ring.to_non_unital_semi_normed_ring [β : semi_normed_ring α] : - non_unital_semi_normed_ring α := -{ ..β } - -/-- A non-unital normed ring is a not-necessarily-unital ring -endowed with a norm which satisfies the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/ -class non_unital_normed_ring (α : Type*) extends has_norm α, non_unital_ring α, metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) - -/-- A non-unital normed ring is a non-unital seminormed ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance non_unital_normed_ring.to_non_unital_semi_normed_ring [β : non_unital_normed_ring α] : - non_unital_semi_normed_ring α := -{ ..β } - -/-- A normed ring is a ring endowed with a norm which satisfies the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/ -class normed_ring (α : Type*) extends has_norm α, ring α, metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul : ∀ a b, norm (a * b) ≤ norm a * norm b) - -/-- A normed division ring is a division ring endowed with a seminorm which satisfies the equality -`∥x y∥ = ∥x∥ ∥y∥`. -/ -class normed_division_ring (α : Type*) extends has_norm α, division_ring α, metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b) - -/-- A normed division ring is a normed ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance normed_division_ring.to_normed_ring [β : normed_division_ring α] : normed_ring α := -{ norm_mul := λ a b, (normed_division_ring.norm_mul' a b).le, - ..β } - -/-- A normed ring is a seminormed ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance normed_ring.to_semi_normed_ring [β : normed_ring α] : semi_normed_ring α := -{ ..β } - -/-- A normed ring is a non-unital normed ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance normed_ring.to_non_unital_normed_ring [β : normed_ring α] : non_unital_normed_ring α := -{ ..β } - -/-- A seminormed commutative ring is a commutative ring endowed with a seminorm which satisfies -the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/ -class semi_normed_comm_ring (α : Type*) extends semi_normed_ring α := -(mul_comm : ∀ x y : α, x * y = y * x) - -/-- A normed commutative ring is a commutative ring endowed with a norm which satisfies -the inequality `∥x y∥ ≤ ∥x∥ ∥y∥`. -/ -class normed_comm_ring (α : Type*) extends normed_ring α := -(mul_comm : ∀ x y : α, x * y = y * x) - -/-- A normed commutative ring is a seminormed commutative ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance normed_comm_ring.to_semi_normed_comm_ring [β : normed_comm_ring α] : - semi_normed_comm_ring α := { ..β } - -instance : normed_comm_ring punit := -{ norm_mul := λ _ _, by simp, - ..punit.normed_group, - ..punit.comm_ring, } - -/-- A mixin class with the axiom `∥1∥ = 1`. Many `normed_ring`s and all `normed_field`s satisfy this -axiom. -/ -class norm_one_class (α : Type*) [has_norm α] [has_one α] : Prop := -(norm_one : ∥(1:α)∥ = 1) - -export norm_one_class (norm_one) - -attribute [simp] norm_one - -@[simp] lemma nnnorm_one [semi_normed_group α] [has_one α] [norm_one_class α] : ∥(1 : α)∥₊ = 1 := -nnreal.eq norm_one - -lemma norm_one_class.nontrivial (α : Type*) [semi_normed_group α] [has_one α] [norm_one_class α] : - nontrivial α := -nontrivial_of_ne 0 1 $ ne_of_apply_ne norm $ by simp - -@[priority 100] -- see Note [lower instance priority] -instance semi_normed_comm_ring.to_comm_ring [β : semi_normed_comm_ring α] : comm_ring α := { ..β } - -@[priority 100] -- see Note [lower instance priority] -instance non_unital_normed_ring.to_normed_group [β : non_unital_normed_ring α] : normed_group α := -{ ..β } - -@[priority 100] -- see Note [lower instance priority] -instance non_unital_semi_normed_ring.to_semi_normed_group [β : non_unital_semi_normed_ring α] : - semi_normed_group α := { ..β } - -instance prod.norm_one_class [semi_normed_group α] [has_one α] [norm_one_class α] - [semi_normed_group β] [has_one β] [norm_one_class β] : - norm_one_class (α × β) := -⟨by simp [prod.norm_def]⟩ - -instance pi.norm_one_class {ι : Type*} {α : ι → Type*} [nonempty ι] [fintype ι] - [Π i, semi_normed_group (α i)] [Π i, has_one (α i)] [∀ i, norm_one_class (α i)] : - norm_one_class (Π i, α i) := -⟨by simp [pi.norm_def, finset.sup_const finset.univ_nonempty]⟩ - -section non_unital_semi_normed_ring -variables [non_unital_semi_normed_ring α] - -lemma norm_mul_le (a b : α) : (∥a*b∥) ≤ (∥a∥) * (∥b∥) := -non_unital_semi_normed_ring.norm_mul _ _ - -lemma nnnorm_mul_le (a b : α) : ∥a * b∥₊ ≤ ∥a∥₊ * ∥b∥₊ := -by simpa only [←norm_to_nnreal, ←real.to_nnreal_mul (norm_nonneg _)] - using real.to_nnreal_mono (norm_mul_le _ _) - -lemma one_le_norm_one (β) [normed_ring β] [nontrivial β] : 1 ≤ ∥(1 : β)∥ := -(le_mul_iff_one_le_left $ norm_pos_iff.mpr (one_ne_zero : (1 : β) ≠ 0)).mp - (by simpa only [mul_one] using norm_mul_le (1 : β) 1) - -lemma one_le_nnnorm_one (β) [normed_ring β] [nontrivial β] : 1 ≤ ∥(1 : β)∥₊ := -one_le_norm_one β - -lemma filter.tendsto.zero_mul_is_bounded_under_le {f g : ι → α} {l : filter ι} - (hf : tendsto f l (𝓝 0)) (hg : is_bounded_under (≤) l (norm ∘ g)) : - tendsto (λ x, f x * g x) l (𝓝 0) := -hf.op_zero_is_bounded_under_le hg (*) norm_mul_le - -lemma filter.is_bounded_under_le.mul_tendsto_zero {f g : ι → α} {l : filter ι} - (hf : is_bounded_under (≤) l (norm ∘ f)) (hg : tendsto g l (𝓝 0)) : - tendsto (λ x, f x * g x) l (𝓝 0) := -hg.op_zero_is_bounded_under_le hf (flip (*)) (λ x y, ((norm_mul_le y x).trans_eq (mul_comm _ _))) - -/-- In a seminormed ring, the left-multiplication `add_monoid_hom` is bounded. -/ -lemma mul_left_bound (x : α) : - ∀ (y:α), ∥add_monoid_hom.mul_left x y∥ ≤ ∥x∥ * ∥y∥ := -norm_mul_le x - -/-- In a seminormed ring, the right-multiplication `add_monoid_hom` is bounded. -/ -lemma mul_right_bound (x : α) : - ∀ (y:α), ∥add_monoid_hom.mul_right x y∥ ≤ ∥x∥ * ∥y∥ := -λ y, by {rw mul_comm, convert norm_mul_le y x} - -/-- Non-unital seminormed ring structure on the product of two non-unital seminormed rings, - using the sup norm. -/ -instance prod.non_unital_semi_normed_ring [non_unital_semi_normed_ring β] : - non_unital_semi_normed_ring (α × β) := -{ norm_mul := assume x y, - calc - ∥x * y∥ = ∥(x.1*y.1, x.2*y.2)∥ : rfl - ... = (max ∥x.1*y.1∥ ∥x.2*y.2∥) : rfl - ... ≤ (max (∥x.1∥*∥y.1∥) (∥x.2∥*∥y.2∥)) : - max_le_max (norm_mul_le (x.1) (y.1)) (norm_mul_le (x.2) (y.2)) - ... = (max (∥x.1∥*∥y.1∥) (∥y.2∥*∥x.2∥)) : by simp[mul_comm] - ... ≤ (max (∥x.1∥) (∥x.2∥)) * (max (∥y.2∥) (∥y.1∥)) : - by apply max_mul_mul_le_max_mul_max; simp [norm_nonneg] - ... = (max (∥x.1∥) (∥x.2∥)) * (max (∥y.1∥) (∥y.2∥)) : by simp [max_comm] - ... = (∥x∥*∥y∥) : rfl, - ..prod.semi_normed_group } - -/-- Non-unital seminormed ring structure on the product of finitely many non-unital seminormed -rings, using the sup norm. -/ -instance pi.non_unital_semi_normed_ring {π : ι → Type*} [fintype ι] - [Π i, non_unital_semi_normed_ring (π i)] : - non_unital_semi_normed_ring (Π i, π i) := -{ norm_mul := λ x y, nnreal.coe_mono $ - calc finset.univ.sup (λ i, ∥x i * y i∥₊) - ≤ finset.univ.sup ((λ i, ∥x i∥₊) * (λ i, ∥y i∥₊)) : - finset.sup_mono_fun $ λ b hb, norm_mul_le _ _ - ... ≤ finset.univ.sup (λ i, ∥x i∥₊) * finset.univ.sup (λ i, ∥y i∥₊) : - finset.sup_mul_le_mul_sup_of_nonneg _ (λ i _, zero_le _) (λ i _, zero_le _), - ..pi.semi_normed_group } - -end non_unital_semi_normed_ring - -section semi_normed_ring - -variables [semi_normed_ring α] - -/-- A subalgebra of a seminormed ring is also a seminormed ring, with the restriction of the norm. - -See note [implicit instance arguments]. -/ -instance subalgebra.semi_normed_ring {𝕜 : Type*} {_ : comm_ring 𝕜} - {E : Type*} [semi_normed_ring E] {_ : algebra 𝕜 E} (s : subalgebra 𝕜 E) : semi_normed_ring s := -{ norm_mul := λ a b, norm_mul_le a.1 b.1, - ..s.to_submodule.semi_normed_group } - -/-- A subalgebra of a normed ring is also a normed ring, with the restriction of the norm. - -See note [implicit instance arguments]. -/ -instance subalgebra.normed_ring {𝕜 : Type*} {_ : comm_ring 𝕜} - {E : Type*} [normed_ring E] {_ : algebra 𝕜 E} (s : subalgebra 𝕜 E) : normed_ring s := -{ ..s.semi_normed_ring } - -lemma list.norm_prod_le' : ∀ {l : list α}, l ≠ [] → ∥l.prod∥ ≤ (l.map norm).prod -| [] h := (h rfl).elim -| [a] _ := by simp -| (a :: b :: l) _ := - begin - rw [list.map_cons, list.prod_cons, @list.prod_cons _ _ _ ∥a∥], - refine le_trans (norm_mul_le _ _) (mul_le_mul_of_nonneg_left _ (norm_nonneg _)), - exact list.norm_prod_le' (list.cons_ne_nil b l) - end - -lemma list.nnnorm_prod_le' {l : list α} (hl : l ≠ []) : ∥l.prod∥₊ ≤ (l.map nnnorm).prod := -(list.norm_prod_le' hl).trans_eq $ by simp [nnreal.coe_list_prod, list.map_map] - -lemma list.norm_prod_le [norm_one_class α] : ∀ l : list α, ∥l.prod∥ ≤ (l.map norm).prod -| [] := by simp -| (a::l) := list.norm_prod_le' (list.cons_ne_nil a l) - -lemma list.nnnorm_prod_le [norm_one_class α] (l : list α) : ∥l.prod∥₊ ≤ (l.map nnnorm).prod := -l.norm_prod_le.trans_eq $ by simp [nnreal.coe_list_prod, list.map_map] - -lemma finset.norm_prod_le' {α : Type*} [normed_comm_ring α] (s : finset ι) (hs : s.nonempty) - (f : ι → α) : - ∥∏ i in s, f i∥ ≤ ∏ i in s, ∥f i∥ := -begin - rcases s with ⟨⟨l⟩, hl⟩, - have : l.map f ≠ [], by simpa using hs, - simpa using list.norm_prod_le' this -end - -lemma finset.nnnorm_prod_le' {α : Type*} [normed_comm_ring α] (s : finset ι) (hs : s.nonempty) - (f : ι → α) : - ∥∏ i in s, f i∥₊ ≤ ∏ i in s, ∥f i∥₊ := -(s.norm_prod_le' hs f).trans_eq $ by simp [nnreal.coe_prod] - -lemma finset.norm_prod_le {α : Type*} [normed_comm_ring α] [norm_one_class α] (s : finset ι) - (f : ι → α) : - ∥∏ i in s, f i∥ ≤ ∏ i in s, ∥f i∥ := -begin - rcases s with ⟨⟨l⟩, hl⟩, - simpa using (l.map f).norm_prod_le -end - -lemma finset.nnnorm_prod_le {α : Type*} [normed_comm_ring α] [norm_one_class α] (s : finset ι) - (f : ι → α) : - ∥∏ i in s, f i∥₊ ≤ ∏ i in s, ∥f i∥₊ := -(s.norm_prod_le f).trans_eq $ by simp [nnreal.coe_prod] - -/-- If `α` is a seminormed ring, then `∥a ^ n∥₊ ≤ ∥a∥₊ ^ n` for `n > 0`. -See also `nnnorm_pow_le`. -/ -lemma nnnorm_pow_le' (a : α) : ∀ {n : ℕ}, 0 < n → ∥a ^ n∥₊ ≤ ∥a∥₊ ^ n -| 1 h := by simp only [pow_one] -| (n + 2) h := by simpa only [pow_succ _ (n + 1)] using - le_trans (nnnorm_mul_le _ _) (mul_le_mul_left' (nnnorm_pow_le' n.succ_pos) _) - -/-- If `α` is a seminormed ring with `∥1∥₊ = 1`, then `∥a ^ n∥₊ ≤ ∥a∥₊ ^ n`. -See also `nnnorm_pow_le'`.-/ -lemma nnnorm_pow_le [norm_one_class α] (a : α) (n : ℕ) : ∥a ^ n∥₊ ≤ ∥a∥₊ ^ n := -nat.rec_on n (by simp only [pow_zero, nnnorm_one]) (λ k hk, nnnorm_pow_le' a k.succ_pos) - -/-- If `α` is a seminormed ring, then `∥a ^ n∥ ≤ ∥a∥ ^ n` for `n > 0`. See also `norm_pow_le`. -/ -lemma norm_pow_le' (a : α) {n : ℕ} (h : 0 < n) : ∥a ^ n∥ ≤ ∥a∥ ^ n := -by simpa only [nnreal.coe_pow, coe_nnnorm] using nnreal.coe_mono (nnnorm_pow_le' a h) - -/-- If `α` is a seminormed ring with `∥1∥ = 1`, then `∥a ^ n∥ ≤ ∥a∥ ^ n`. See also `norm_pow_le'`.-/ -lemma norm_pow_le [norm_one_class α] (a : α) (n : ℕ) : ∥a ^ n∥ ≤ ∥a∥ ^ n := -nat.rec_on n (by simp only [pow_zero, norm_one]) (λ n hn, norm_pow_le' a n.succ_pos) - -lemma eventually_norm_pow_le (a : α) : ∀ᶠ (n:ℕ) in at_top, ∥a ^ n∥ ≤ ∥a∥ ^ n := -eventually_at_top.mpr ⟨1, λ b h, norm_pow_le' a (nat.succ_le_iff.mp h)⟩ - -/-- Seminormed ring structure on the product of two seminormed rings, - using the sup norm. -/ -instance prod.semi_normed_ring [semi_normed_ring β] : - semi_normed_ring (α × β) := -{ ..prod.non_unital_semi_normed_ring, - ..prod.semi_normed_group, } - -/-- Seminormed ring structure on the product of finitely many seminormed rings, - using the sup norm. -/ -instance pi.semi_normed_ring {π : ι → Type*} [fintype ι] [Π i, semi_normed_ring (π i)] : - semi_normed_ring (Π i, π i) := -{ ..pi.non_unital_semi_normed_ring, - ..pi.semi_normed_group, } - -end semi_normed_ring - -section non_unital_normed_ring -variables [non_unital_normed_ring α] - -/-- Non-unital normed ring structure on the product of two non-unital normed rings, -using the sup norm. -/ -instance prod.non_unital_normed_ring [non_unital_normed_ring β] : non_unital_normed_ring (α × β) := -{ norm_mul := norm_mul_le, - ..prod.semi_normed_group } - -/-- Normed ring structure on the product of finitely many non-unital normed rings, using the sup -norm. -/ -instance pi.non_unital_normed_ring {π : ι → Type*} [fintype ι] [Π i, non_unital_normed_ring (π i)] : - non_unital_normed_ring (Π i, π i) := -{ norm_mul := norm_mul_le, - ..pi.normed_group } - -end non_unital_normed_ring - -section normed_ring - -variables [normed_ring α] - -lemma units.norm_pos [nontrivial α] (x : αˣ) : 0 < ∥(x:α)∥ := -norm_pos_iff.mpr (units.ne_zero x) - -lemma units.nnnorm_pos [nontrivial α] (x : αˣ) : 0 < ∥(x:α)∥₊ := -x.norm_pos - -/-- Normed ring structure on the product of two normed rings, using the sup norm. -/ -instance prod.normed_ring [normed_ring β] : normed_ring (α × β) := -{ norm_mul := norm_mul_le, - ..prod.semi_normed_group } - -/-- Normed ring structure on the product of finitely many normed rings, using the sup norm. -/ -instance pi.normed_ring {π : ι → Type*} [fintype ι] [Π i, normed_ring (π i)] : - normed_ring (Π i, π i) := -{ norm_mul := norm_mul_le, - ..pi.semi_normed_group } - -end normed_ring - -@[priority 100] -- see Note [lower instance priority] -instance semi_normed_ring_top_monoid [non_unital_semi_normed_ring α] : has_continuous_mul α := -⟨ continuous_iff_continuous_at.2 $ λ x, tendsto_iff_norm_tendsto_zero.2 $ - begin - have : ∀ e : α × α, ∥e.1 * e.2 - x.1 * x.2∥ ≤ ∥e.1∥ * ∥e.2 - x.2∥ + ∥e.1 - x.1∥ * ∥x.2∥, - { intro e, - calc ∥e.1 * e.2 - x.1 * x.2∥ ≤ ∥e.1 * (e.2 - x.2) + (e.1 - x.1) * x.2∥ : - by rw [mul_sub, sub_mul, sub_add_sub_cancel] - ... ≤ ∥e.1∥ * ∥e.2 - x.2∥ + ∥e.1 - x.1∥ * ∥x.2∥ : - norm_add_le_of_le (norm_mul_le _ _) (norm_mul_le _ _) }, - refine squeeze_zero (λ e, norm_nonneg _) this _, - convert ((continuous_fst.tendsto x).norm.mul ((continuous_snd.tendsto x).sub - tendsto_const_nhds).norm).add - (((continuous_fst.tendsto x).sub tendsto_const_nhds).norm.mul _), - show tendsto _ _ _, from tendsto_const_nhds, - simp - end ⟩ - -/-- A seminormed ring is a topological ring. -/ -@[priority 100] -- see Note [lower instance priority] -instance semi_normed_top_ring [non_unital_semi_normed_ring α] : topological_ring α := { } - -section normed_division_ring - -variables [normed_division_ring α] - -@[simp] lemma norm_mul (a b : α) : ∥a * b∥ = ∥a∥ * ∥b∥ := -normed_division_ring.norm_mul' a b - -@[priority 900] -instance normed_division_ring.to_norm_one_class : norm_one_class α := -⟨mul_left_cancel₀ (mt norm_eq_zero.1 (@one_ne_zero α _ _)) $ - by rw [← norm_mul, mul_one, mul_one]⟩ - -@[simp] lemma nnnorm_mul (a b : α) : ∥a * b∥₊ = ∥a∥₊ * ∥b∥₊ := -nnreal.eq $ norm_mul a b - -/-- `norm` as a `monoid_with_zero_hom`. -/ -@[simps] def norm_hom : α →*₀ ℝ := ⟨norm, norm_zero, norm_one, norm_mul⟩ - -/-- `nnnorm` as a `monoid_with_zero_hom`. -/ -@[simps] def nnnorm_hom : α →*₀ ℝ≥0 := ⟨nnnorm, nnnorm_zero, nnnorm_one, nnnorm_mul⟩ - -@[simp] lemma norm_pow (a : α) : ∀ (n : ℕ), ∥a ^ n∥ = ∥a∥ ^ n := -(norm_hom.to_monoid_hom : α →* ℝ).map_pow a - -@[simp] lemma nnnorm_pow (a : α) (n : ℕ) : ∥a ^ n∥₊ = ∥a∥₊ ^ n := -(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_pow a n - -protected lemma list.norm_prod (l : list α) : ∥l.prod∥ = (l.map norm).prod := -(norm_hom.to_monoid_hom : α →* ℝ).map_list_prod _ - -protected lemma list.nnnorm_prod (l : list α) : ∥l.prod∥₊ = (l.map nnnorm).prod := -(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_list_prod _ - -@[simp] lemma norm_div (a b : α) : ∥a / b∥ = ∥a∥ / ∥b∥ := (norm_hom : α →*₀ ℝ).map_div a b - -@[simp] lemma nnnorm_div (a b : α) : ∥a / b∥₊ = ∥a∥₊ / ∥b∥₊ := (nnnorm_hom : α →*₀ ℝ≥0).map_div a b - -@[simp] lemma norm_inv (a : α) : ∥a⁻¹∥ = ∥a∥⁻¹ := (norm_hom : α →*₀ ℝ).map_inv a - -@[simp] lemma nnnorm_inv (a : α) : ∥a⁻¹∥₊ = ∥a∥₊⁻¹ := -nnreal.eq $ by simp - -@[simp] lemma norm_zpow : ∀ (a : α) (n : ℤ), ∥a^n∥ = ∥a∥^n := (norm_hom : α →*₀ ℝ).map_zpow - -@[simp] lemma nnnorm_zpow : ∀ (a : α) (n : ℤ), ∥a ^ n∥₊ = ∥a∥₊ ^ n := -(nnnorm_hom : α →*₀ ℝ≥0).map_zpow - -/-- Multiplication on the left by a nonzero element of a normed division ring tends to infinity at -infinity. TODO: use `bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`. -/ -lemma filter.tendsto_mul_left_cobounded {a : α} (ha : a ≠ 0) : - tendsto ((*) a) (comap norm at_top) (comap norm at_top) := -by simpa only [tendsto_comap_iff, (∘), norm_mul] - using tendsto_const_nhds.mul_at_top (norm_pos_iff.2 ha) tendsto_comap - -/-- Multiplication on the right by a nonzero element of a normed division ring tends to infinity at -infinity. TODO: use `bornology.cobounded` instead of `filter.comap has_norm.norm filter.at_top`. -/ -lemma filter.tendsto_mul_right_cobounded {a : α} (ha : a ≠ 0) : - tendsto (λ x, x * a) (comap norm at_top) (comap norm at_top) := -by simpa only [tendsto_comap_iff, (∘), norm_mul] - using tendsto_comap.at_top_mul (norm_pos_iff.2 ha) tendsto_const_nhds - -@[priority 100] -- see Note [lower instance priority] -instance normed_division_ring.to_has_continuous_inv₀ : has_continuous_inv₀ α := -begin - refine ⟨λ r r0, tendsto_iff_norm_tendsto_zero.2 _⟩, - have r0' : 0 < ∥r∥ := norm_pos_iff.2 r0, - rcases exists_between r0' with ⟨ε, ε0, εr⟩, - have : ∀ᶠ e in 𝓝 r, ∥e⁻¹ - r⁻¹∥ ≤ ∥r - e∥ / ∥r∥ / ε, - { filter_upwards [(is_open_lt continuous_const continuous_norm).eventually_mem εr] with e he, - have e0 : e ≠ 0 := norm_pos_iff.1 (ε0.trans he), - calc ∥e⁻¹ - r⁻¹∥ = ∥r∥⁻¹ * ∥r - e∥ * ∥e∥⁻¹ : by - { rw [←norm_inv, ←norm_inv, ←norm_mul, ←norm_mul, mul_sub, sub_mul, mul_assoc _ e, - inv_mul_cancel r0, mul_inv_cancel e0, one_mul, mul_one] } - ... = ∥r - e∥ / ∥r∥ / ∥e∥ : by field_simp [mul_comm] - ... ≤ ∥r - e∥ / ∥r∥ / ε : - div_le_div_of_le_left (div_nonneg (norm_nonneg _) (norm_nonneg _)) ε0 he.le }, - refine squeeze_zero' (eventually_of_forall $ λ _, norm_nonneg _) this _, - refine (continuous_const.sub continuous_id).norm.div_const.div_const.tendsto' _ _ _, - simp, -end - -end normed_division_ring - -/-- A normed field is a field with a norm satisfying ∥x y∥ = ∥x∥ ∥y∥. -/ -class normed_field (α : Type*) extends has_norm α, field α, metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b) - -/-- A nondiscrete normed field is a normed field in which there is an element of norm different from -`0` and `1`. This makes it possible to bring any element arbitrarily close to `0` by multiplication -by the powers of any element, and thus to relate algebra and topology. -/ -class nondiscrete_normed_field (α : Type*) extends normed_field α := -(non_trivial : ∃ x : α, 1 < ∥x∥) - -section normed_field - -variables [normed_field α] - -@[priority 100] -- see Note [lower instance priority] -instance normed_field.to_normed_division_ring : normed_division_ring α := -{ ..‹normed_field α› } - -@[priority 100] -- see Note [lower instance priority] -instance normed_field.to_normed_comm_ring : normed_comm_ring α := -{ norm_mul := λ a b, (norm_mul a b).le, ..‹normed_field α› } - -@[simp] lemma norm_prod (s : finset β) (f : β → α) : - ∥∏ b in s, f b∥ = ∏ b in s, ∥f b∥ := -(norm_hom.to_monoid_hom : α →* ℝ).map_prod f s - -@[simp] lemma nnnorm_prod (s : finset β) (f : β → α) : - ∥∏ b in s, f b∥₊ = ∏ b in s, ∥f b∥₊ := -(nnnorm_hom.to_monoid_hom : α →* ℝ≥0).map_prod f s - -end normed_field - -namespace normed_field - -variables (α) [nondiscrete_normed_field α] - -lemma exists_one_lt_norm : ∃x : α, 1 < ∥x∥ := ‹nondiscrete_normed_field α›.non_trivial - -lemma exists_norm_lt_one : ∃x : α, 0 < ∥x∥ ∧ ∥x∥ < 1 := -begin - rcases exists_one_lt_norm α with ⟨y, hy⟩, - refine ⟨y⁻¹, _, _⟩, - { simp only [inv_eq_zero, ne.def, norm_pos_iff], - rintro rfl, - rw norm_zero at hy, - exact lt_asymm zero_lt_one hy }, - { simp [inv_lt_one hy] } -end - -lemma exists_lt_norm (r : ℝ) : ∃ x : α, r < ∥x∥ := -let ⟨w, hw⟩ := exists_one_lt_norm α in -let ⟨n, hn⟩ := pow_unbounded_of_one_lt r hw in -⟨w^n, by rwa norm_pow⟩ - -lemma exists_norm_lt {r : ℝ} (hr : 0 < r) : ∃ x : α, 0 < ∥x∥ ∧ ∥x∥ < r := -let ⟨w, hw⟩ := exists_one_lt_norm α in -let ⟨n, hle, hlt⟩ := exists_mem_Ioc_zpow hr hw in -⟨w^n, by { rw norm_zpow; exact zpow_pos_of_pos (lt_trans zero_lt_one hw) _}, -by rwa norm_zpow⟩ - -variable {α} - -@[instance] -lemma punctured_nhds_ne_bot (x : α) : ne_bot (𝓝[≠] x) := -begin - rw [← mem_closure_iff_nhds_within_ne_bot, metric.mem_closure_iff], - rintros ε ε0, - rcases exists_norm_lt α ε0 with ⟨b, hb0, hbε⟩, - refine ⟨x + b, mt (set.mem_singleton_iff.trans add_right_eq_self).1 $ norm_pos_iff.1 hb0, _⟩, - rwa [dist_comm, dist_eq_norm, add_sub_cancel'], -end - -@[instance] -lemma nhds_within_is_unit_ne_bot : ne_bot (𝓝[{x : α | is_unit x}] 0) := -by simpa only [is_unit_iff_ne_zero] using punctured_nhds_ne_bot (0:α) - -end normed_field - -instance : normed_field ℝ := -{ norm_mul' := abs_mul, - .. real.normed_group } - -instance : nondiscrete_normed_field ℝ := -{ non_trivial := ⟨2, by { unfold norm, rw abs_of_nonneg; norm_num }⟩ } - -namespace real - -lemma norm_of_nonneg {x : ℝ} (hx : 0 ≤ x) : ∥x∥ = x := -abs_of_nonneg hx - -lemma norm_of_nonpos {x : ℝ} (hx : x ≤ 0) : ∥x∥ = -x := -abs_of_nonpos hx - -@[simp] lemma norm_coe_nat (n : ℕ) : ∥(n : ℝ)∥ = n := abs_of_nonneg n.cast_nonneg - -@[simp] lemma nnnorm_coe_nat (n : ℕ) : ∥(n : ℝ)∥₊ = n := nnreal.eq $ by simp - -@[simp] lemma norm_two : ∥(2 : ℝ)∥ = 2 := abs_of_pos (@zero_lt_two ℝ _ _) - -@[simp] lemma nnnorm_two : ∥(2 : ℝ)∥₊ = 2 := nnreal.eq $ by simp - -lemma nnnorm_of_nonneg {x : ℝ} (hx : 0 ≤ x) : ∥x∥₊ = ⟨x, hx⟩ := -nnreal.eq $ norm_of_nonneg hx - -lemma ennnorm_eq_of_real {x : ℝ} (hx : 0 ≤ x) : (∥x∥₊ : ℝ≥0∞) = ennreal.of_real x := -by { rw [← of_real_norm_eq_coe_nnnorm, norm_of_nonneg hx] } - -lemma of_real_le_ennnorm (x : ℝ) : ennreal.of_real x ≤ ∥x∥₊ := -begin - by_cases hx : 0 ≤ x, - { rw real.ennnorm_eq_of_real hx, refl' }, - { rw [ennreal.of_real_eq_zero.2 (le_of_lt (not_le.1 hx))], - exact bot_le } -end - -/-- If `E` is a nontrivial topological module over `ℝ`, then `E` has no isolated points. -This is a particular case of `module.punctured_nhds_ne_bot`. -/ -instance punctured_nhds_module_ne_bot - {E : Type*} [add_comm_group E] [topological_space E] [has_continuous_add E] [nontrivial E] - [module ℝ E] [has_continuous_smul ℝ E] (x : E) : - ne_bot (𝓝[≠] x) := -module.punctured_nhds_ne_bot ℝ E x - -end real - -namespace nnreal - -open_locale nnreal - -@[simp] lemma norm_eq (x : ℝ≥0) : ∥(x : ℝ)∥ = x := -by rw [real.norm_eq_abs, x.abs_eq] - -@[simp] lemma nnnorm_eq (x : ℝ≥0) : ∥(x : ℝ)∥₊ = x := -nnreal.eq $ real.norm_of_nonneg x.2 - -end nnreal - -@[simp] lemma norm_norm [semi_normed_group α] (x : α) : ∥∥x∥∥ = ∥x∥ := -real.norm_of_nonneg (norm_nonneg _) - -@[simp] lemma nnnorm_norm [semi_normed_group α] (a : α) : ∥∥a∥∥₊ = ∥a∥₊ := -by simpa [real.nnnorm_of_nonneg (norm_nonneg a)] - -/-- A restatement of `metric_space.tendsto_at_top` in terms of the norm. -/ -lemma normed_group.tendsto_at_top [nonempty α] [semilattice_sup α] {β : Type*} [semi_normed_group β] - {f : α → β} {b : β} : - tendsto f at_top (𝓝 b) ↔ ∀ ε, 0 < ε → ∃ N, ∀ n, N ≤ n → ∥f n - b∥ < ε := -(at_top_basis.tendsto_iff metric.nhds_basis_ball).trans (by simp [dist_eq_norm]) - -/-- -A variant of `normed_group.tendsto_at_top` that -uses `∃ N, ∀ n > N, ...` rather than `∃ N, ∀ n ≥ N, ...` --/ -lemma normed_group.tendsto_at_top' [nonempty α] [semilattice_sup α] [no_max_order α] - {β : Type*} [semi_normed_group β] - {f : α → β} {b : β} : - tendsto f at_top (𝓝 b) ↔ ∀ ε, 0 < ε → ∃ N, ∀ n, N < n → ∥f n - b∥ < ε := -(at_top_basis_Ioi.tendsto_iff metric.nhds_basis_ball).trans (by simp [dist_eq_norm]) - -instance : normed_comm_ring ℤ := -{ norm := λ n, ∥(n : ℝ)∥, - norm_mul := λ m n, le_of_eq $ by simp only [norm, int.cast_mul, abs_mul], - dist_eq := λ m n, by simp only [int.dist_eq, norm, int.cast_sub], - mul_comm := mul_comm } - -@[norm_cast] lemma int.norm_cast_real (m : ℤ) : ∥(m : ℝ)∥ = ∥m∥ := rfl - -lemma int.norm_eq_abs (n : ℤ) : ∥n∥ = |n| := rfl - -lemma nnreal.coe_nat_abs (n : ℤ) : (n.nat_abs : ℝ≥0) = ∥n∥₊ := -nnreal.eq $ calc ((n.nat_abs : ℝ≥0) : ℝ) - = (n.nat_abs : ℤ) : by simp only [int.cast_coe_nat, nnreal.coe_nat_cast] - ... = |n| : by simp only [← int.abs_eq_nat_abs, int.cast_abs] - ... = ∥n∥ : rfl - -lemma int.abs_le_floor_nnreal_iff (z : ℤ) (c : ℝ≥0) : |z| ≤ ⌊c⌋₊ ↔ ∥z∥₊ ≤ c := -begin - rw [int.abs_eq_nat_abs, int.coe_nat_le, nat.le_floor_iff (zero_le c)], - congr', - exact nnreal.coe_nat_abs z, -end - -instance : norm_one_class ℤ := -⟨by simp [← int.norm_cast_real]⟩ - -instance : normed_field ℚ := -{ norm := λ r, ∥(r : ℝ)∥, - norm_mul' := λ r₁ r₂, by simp only [norm, rat.cast_mul, abs_mul], - dist_eq := λ r₁ r₂, by simp only [rat.dist_eq, norm, rat.cast_sub] } - -instance : nondiscrete_normed_field ℚ := -{ non_trivial := ⟨2, by { unfold norm, rw abs_of_nonneg; norm_num }⟩ } - -@[norm_cast, simp] lemma rat.norm_cast_real (r : ℚ) : ∥(r : ℝ)∥ = ∥r∥ := rfl - -@[norm_cast, simp] lemma int.norm_cast_rat (m : ℤ) : ∥(m : ℚ)∥ = ∥m∥ := -by rw [← rat.norm_cast_real, ← int.norm_cast_real]; congr' 1; norm_cast - --- Now that we've installed the norm on `ℤ`, --- we can state some lemmas about `nsmul` and `zsmul`. -section -variables [semi_normed_group α] - -lemma norm_nsmul_le (n : ℕ) (a : α) : ∥n • a∥ ≤ n * ∥a∥ := -begin - induction n with n ih, - { simp only [norm_zero, nat.cast_zero, zero_mul, zero_smul] }, - simp only [nat.succ_eq_add_one, add_smul, add_mul, one_mul, nat.cast_add, - nat.cast_one, one_nsmul], - exact norm_add_le_of_le ih le_rfl -end - -lemma norm_zsmul_le (n : ℤ) (a : α) : ∥n • a∥ ≤ ∥n∥ * ∥a∥ := -begin - induction n with n n, - { simp only [int.of_nat_eq_coe, coe_nat_zsmul], - convert norm_nsmul_le n a, - exact nat.abs_cast n }, - { simp only [int.neg_succ_of_nat_coe, neg_smul, norm_neg, coe_nat_zsmul], - convert norm_nsmul_le n.succ a, - exact nat.abs_cast n.succ, } -end - -lemma nnnorm_nsmul_le (n : ℕ) (a : α) : ∥n • a∥₊ ≤ n * ∥a∥₊ := -by simpa only [←nnreal.coe_le_coe, nnreal.coe_mul, nnreal.coe_nat_cast] - using norm_nsmul_le n a - -lemma nnnorm_zsmul_le (n : ℤ) (a : α) : ∥n • a∥₊ ≤ ∥n∥₊ * ∥a∥₊ := -by simpa only [←nnreal.coe_le_coe, nnreal.coe_mul] using norm_zsmul_le n a - -end - -section cauchy_product - -/-! ## Multiplying two infinite sums in a normed ring - -In this section, we prove various results about `(∑' x : ι, f x) * (∑' y : ι', g y)` in a normed -ring. There are similar results proven in `topology/algebra/infinite_sum` (e.g `tsum_mul_tsum`), -but in a normed ring we get summability results which aren't true in general. - -We first establish results about arbitrary index types, `β` and `γ`, and then we specialize to -`β = γ = ℕ` to prove the Cauchy product formula -(see `tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`). - -### Arbitrary index types --/ - -variables {ι' : Type*} [normed_ring α] - -open finset -open_locale classical - -lemma summable.mul_of_nonneg {f : ι → ℝ} {g : ι' → ℝ} - (hf : summable f) (hg : summable g) (hf' : 0 ≤ f) (hg' : 0 ≤ g) : - summable (λ (x : ι × ι'), f x.1 * g x.2) := -let ⟨s, hf⟩ := hf in -let ⟨t, hg⟩ := hg in -suffices this : ∀ u : finset (ι × ι'), ∑ x in u, f x.1 * g x.2 ≤ s*t, - from summable_of_sum_le (λ x, mul_nonneg (hf' _) (hg' _)) this, -assume u, -calc ∑ x in u, f x.1 * g x.2 - ≤ ∑ x in (u.image prod.fst).product (u.image prod.snd), f x.1 * g x.2 : - sum_mono_set_of_nonneg (λ x, mul_nonneg (hf' _) (hg' _)) subset_product -... = ∑ x in u.image prod.fst, ∑ y in u.image prod.snd, f x * g y : sum_product -... = ∑ x in u.image prod.fst, f x * ∑ y in u.image prod.snd, g y : - sum_congr rfl (λ x _, mul_sum.symm) -... ≤ ∑ x in u.image prod.fst, f x * t : - sum_le_sum - (λ x _, mul_le_mul_of_nonneg_left (sum_le_has_sum _ (λ _ _, hg' _) hg) (hf' _)) -... = (∑ x in u.image prod.fst, f x) * t : sum_mul.symm -... ≤ s * t : - mul_le_mul_of_nonneg_right (sum_le_has_sum _ (λ _ _, hf' _) hf) (hg.nonneg $ λ _, hg' _) - -lemma summable.mul_norm {f : ι → α} {g : ι' → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - summable (λ (x : ι × ι'), ∥f x.1 * g x.2∥) := -summable_of_nonneg_of_le (λ x, norm_nonneg (f x.1 * g x.2)) (λ x, norm_mul_le (f x.1) (g x.2)) - (hf.mul_of_nonneg hg (λ x, norm_nonneg $ f x) (λ x, norm_nonneg $ g x) : _) - -lemma summable_mul_of_summable_norm [complete_space α] {f : ι → α} {g : ι' → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - summable (λ (x : ι × ι'), f x.1 * g x.2) := -summable_of_summable_norm (hf.mul_norm hg) - -/-- Product of two infinites sums indexed by arbitrary types. - See also `tsum_mul_tsum` if `f` and `g` are *not* absolutely summable. -/ -lemma tsum_mul_tsum_of_summable_norm [complete_space α] {f : ι → α} {g : ι' → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - (∑' x, f x) * (∑' y, g y) = (∑' z : ι × ι', f z.1 * g z.2) := -tsum_mul_tsum (summable_of_summable_norm hf) (summable_of_summable_norm hg) - (summable_mul_of_summable_norm hf hg) - -/-! ### `ℕ`-indexed families (Cauchy product) - -We prove two versions of the Cauchy product formula. The first one is -`tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm`, where the `n`-th term is a sum over -`finset.range (n+1)` involving `nat` substraction. -In order to avoid `nat` substraction, we also provide -`tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`, -where the `n`-th term is a sum over all pairs `(k, l)` such that `k+l=n`, which corresponds to the -`finset` `finset.nat.antidiagonal n`. -/ - -section nat - -open finset.nat - -lemma summable_norm_sum_mul_antidiagonal_of_summable_norm {f g : ℕ → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - summable (λ n, ∥∑ kl in antidiagonal n, f kl.1 * g kl.2∥) := -begin - have := summable_sum_mul_antidiagonal_of_summable_mul - (summable.mul_of_nonneg hf hg (λ _, norm_nonneg _) (λ _, norm_nonneg _)), - refine summable_of_nonneg_of_le (λ _, norm_nonneg _) _ this, - intros n, - calc ∥∑ kl in antidiagonal n, f kl.1 * g kl.2∥ - ≤ ∑ kl in antidiagonal n, ∥f kl.1 * g kl.2∥ : norm_sum_le _ _ - ... ≤ ∑ kl in antidiagonal n, ∥f kl.1∥ * ∥g kl.2∥ : sum_le_sum (λ i _, norm_mul_le _ _) -end - -/-- The Cauchy product formula for the product of two infinite sums indexed by `ℕ`, - expressed by summing on `finset.nat.antidiagonal`. - See also `tsum_mul_tsum_eq_tsum_sum_antidiagonal` if `f` and `g` are - *not* absolutely summable. -/ -lemma tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm [complete_space α] {f g : ℕ → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ kl in antidiagonal n, f kl.1 * g kl.2 := -tsum_mul_tsum_eq_tsum_sum_antidiagonal (summable_of_summable_norm hf) (summable_of_summable_norm hg) - (summable_mul_of_summable_norm hf hg) - -lemma summable_norm_sum_mul_range_of_summable_norm {f g : ℕ → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - summable (λ n, ∥∑ k in range (n+1), f k * g (n - k)∥) := -begin - simp_rw ← sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l), - exact summable_norm_sum_mul_antidiagonal_of_summable_norm hf hg -end - -/-- The Cauchy product formula for the product of two infinite sums indexed by `ℕ`, - expressed by summing on `finset.range`. - See also `tsum_mul_tsum_eq_tsum_sum_range` if `f` and `g` are - *not* absolutely summable. -/ -lemma tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm [complete_space α] {f g : ℕ → α} - (hf : summable (λ x, ∥f x∥)) (hg : summable (λ x, ∥g x∥)) : - (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ k in range (n+1), f k * g (n - k) := -begin - simp_rw ← sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l), - exact tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm hf hg -end - -end nat - -end cauchy_product - -section ring_hom_isometric - -variables {R₁ : Type*} {R₂ : Type*} {R₃ : Type*} - -/-- This class states that a ring homomorphism is isometric. This is a sufficient assumption -for a continuous semilinear map to be bounded and this is the main use for this typeclass. -/ -class ring_hom_isometric [semiring R₁] [semiring R₂] [has_norm R₁] [has_norm R₂] - (σ : R₁ →+* R₂) : Prop := -(is_iso : ∀ {x : R₁}, ∥σ x∥ = ∥x∥) - -attribute [simp] ring_hom_isometric.is_iso - -variables [semi_normed_ring R₁] [semi_normed_ring R₂] [semi_normed_ring R₃] - -instance ring_hom_isometric.ids : ring_hom_isometric (ring_hom.id R₁) := -⟨λ x, rfl⟩ - -end ring_hom_isometric diff --git a/src/analysis/normed/order/basic.lean b/src/analysis/normed/order/basic.lean new file mode 100644 index 0000000000000..79e3daec9d62a --- /dev/null +++ b/src/analysis/normed/order/basic.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2020 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anatole Dedecker, Yaël Dillies +-/ +import algebra.order.group.type_tags +import analysis.normed_space.basic + +/-! +# Ordered normed spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we define classes for fields and groups that are both normed and ordered. +These are mostly useful to avoid diamonds during type class inference. +-/ + +open filter set +open_locale topology + +variables {α : Type*} + +/-- A `normed_ordered_add_group` is an additive group that is both a `normed_add_comm_group` and an +`ordered_add_comm_group`. This class is necessary to avoid diamonds caused by both classes +carrying their own group structure. -/ +class normed_ordered_add_group (α : Type*) + extends ordered_add_comm_group α, has_norm α, metric_space α := +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) + +/-- A `normed_ordered_group` is a group that is both a `normed_comm_group` and an +`ordered_comm_group`. This class is necessary to avoid diamonds caused by both classes +carrying their own group structure. -/ +@[to_additive] +class normed_ordered_group (α : Type*) extends ordered_comm_group α, has_norm α, metric_space α := +(dist_eq : ∀ x y, dist x y = ‖x / y‖ . obviously) + +/-- A `normed_linear_ordered_add_group` is an additive group that is both a `normed_add_comm_group` +and a `linear_ordered_add_comm_group`. This class is necessary to avoid diamonds caused by both +classes carrying their own group structure. -/ +class normed_linear_ordered_add_group (α : Type*) + extends linear_ordered_add_comm_group α, has_norm α, metric_space α := +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) + +/-- A `normed_linear_ordered_group` is a group that is both a `normed_comm_group` and a +`linear_ordered_comm_group`. This class is necessary to avoid diamonds caused by both classes +carrying their own group structure. -/ +@[to_additive] +class normed_linear_ordered_group (α : Type*) + extends linear_ordered_comm_group α, has_norm α, metric_space α := +(dist_eq : ∀ x y, dist x y = ‖x / y‖ . obviously) + +/-- A `normed_linear_ordered_field` is a field that is both a `normed_field` and a + `linear_ordered_field`. This class is necessary to avoid diamonds. -/ +class normed_linear_ordered_field (α : Type*) +extends linear_ordered_field α, has_norm α, metric_space α := +(dist_eq : ∀ x y, dist x y = ‖x - y‖ . obviously) +(norm_mul' : ∀ x y : α, ‖x * y‖ = ‖x‖ * ‖y‖) + +@[to_additive, priority 100] +instance normed_ordered_group.to_normed_comm_group [normed_ordered_group α] : normed_comm_group α := +⟨normed_ordered_group.dist_eq⟩ + +@[to_additive, priority 100] +instance normed_linear_ordered_group.to_normed_ordered_group [normed_linear_ordered_group α] : + normed_ordered_group α := +⟨normed_linear_ordered_group.dist_eq⟩ + +@[priority 100] instance normed_linear_ordered_field.to_normed_field (α : Type*) + [normed_linear_ordered_field α] : normed_field α := +{ dist_eq := normed_linear_ordered_field.dist_eq, + norm_mul' := normed_linear_ordered_field.norm_mul' } + +instance : normed_linear_ordered_field ℚ := +⟨dist_eq_norm, norm_mul⟩ + +noncomputable +instance : normed_linear_ordered_field ℝ := +⟨dist_eq_norm, norm_mul⟩ + +@[to_additive] instance [normed_ordered_group α] : normed_ordered_group αᵒᵈ := +{ ..normed_ordered_group.to_normed_comm_group, ..order_dual.ordered_comm_group } + +@[to_additive] instance [normed_linear_ordered_group α] : normed_linear_ordered_group αᵒᵈ := +{ ..order_dual.normed_ordered_group, ..order_dual.linear_order _ } + +instance [normed_ordered_group α] : normed_ordered_add_group (additive α) := +{ ..additive.normed_add_comm_group } + +instance [normed_ordered_add_group α] : normed_ordered_group (multiplicative α) := +{ ..multiplicative.normed_comm_group } + +instance [normed_linear_ordered_group α] : normed_linear_ordered_add_group (additive α) := +{ ..additive.normed_add_comm_group } + +instance [normed_linear_ordered_add_group α] : normed_linear_ordered_group (multiplicative α) := +{ ..multiplicative.normed_comm_group } diff --git a/src/analysis/normed/order/lattice.lean b/src/analysis/normed/order/lattice.lean new file mode 100644 index 0000000000000..4370935d7c666 --- /dev/null +++ b/src/analysis/normed/order/lattice.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2021 Christopher Hoskin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Hoskin +-/ +import topology.order.lattice +import analysis.normed.group.basic +import algebra.order.lattice_group + +/-! +# Normed lattice ordered groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Motivated by the theory of Banach Lattices, we then define `normed_lattice_add_comm_group` as a +lattice with a covariant normed group addition satisfying the solid axiom. + +## Main statements + +We show that a normed lattice ordered group is a topological lattice with respect to the norm +topology. + +## References + +* [Meyer-Nieberg, Banach lattices][MeyerNieberg1991] + +## Tags + +normed, lattice, ordered, group +-/ + +/-! +### Normed lattice ordered groups + +Motivated by the theory of Banach Lattices, this section introduces normed lattice ordered groups. +-/ + +local notation (name := abs) `|`a`|` := abs a + +section solid_norm + +/-- Let `α` be an `add_comm_group` with a `lattice` structure. A norm on `α` is *solid* if, for `a` +and `b` in `α`, with absolute values `|a|` and `|b|` respectively, `|a| ≤ |b|` implies `‖a‖ ≤ ‖b‖`. +-/ +class has_solid_norm (α : Type*) [normed_add_comm_group α] [lattice α] : Prop := +(solid : ∀ ⦃x y : α⦄, |x| ≤ |y| → ‖x‖ ≤ ‖y‖) + +variables {α : Type*} [normed_add_comm_group α] [lattice α] [has_solid_norm α] + +lemma norm_le_norm_of_abs_le_abs {a b : α} (h : |a| ≤ |b|) : ‖a‖ ≤ ‖b‖ := has_solid_norm.solid h + +/-- If `α` has a solid norm, then the balls centered at the origin of `α` are solid sets. -/ +lemma lattice_ordered_add_comm_group.is_solid_ball (r : ℝ) : + lattice_ordered_add_comm_group.is_solid (metric.ball (0 : α) r) := +λ _ hx _ hxy, mem_ball_zero_iff.mpr ((has_solid_norm.solid hxy).trans_lt (mem_ball_zero_iff.mp hx)) + +instance : has_solid_norm ℝ := ⟨λ _ _, id⟩ + +instance : has_solid_norm ℚ := ⟨λ _ _ _, by simpa only [norm, ← rat.cast_abs, rat.cast_le]⟩ + +end solid_norm + +/-- +Let `α` be a normed commutative group equipped with a partial order covariant with addition, with +respect which `α` forms a lattice. Suppose that `α` is *solid*, that is to say, for `a` and `b` in +`α`, with absolute values `|a|` and `|b|` respectively, `|a| ≤ |b|` implies `‖a‖ ≤ ‖b‖`. Then `α` is +said to be a normed lattice ordered group. +-/ +class normed_lattice_add_comm_group (α : Type*) + extends normed_add_comm_group α, lattice α, has_solid_norm α := +(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) + +instance : normed_lattice_add_comm_group ℝ := +{ add_le_add_left := λ _ _ h _, add_le_add le_rfl h,} + +/-- +A normed lattice ordered group is an ordered additive commutative group +-/ +@[priority 100] -- see Note [lower instance priority] +instance normed_lattice_add_comm_group_to_ordered_add_comm_group {α : Type*} + [h : normed_lattice_add_comm_group α] : ordered_add_comm_group α := { ..h } + +variables {α : Type*} [normed_lattice_add_comm_group α] +open lattice_ordered_comm_group has_solid_norm + +lemma dual_solid (a b : α) (h: b⊓-b ≤ a⊓-a) : ‖a‖ ≤ ‖b‖ := +begin + apply solid, + rw abs_eq_sup_neg, + nth_rewrite 0 ← neg_neg a, + rw ← neg_inf_eq_sup_neg, + rw abs_eq_sup_neg, + nth_rewrite 0 ← neg_neg b, + rwa [← neg_inf_eq_sup_neg, neg_le_neg_iff, @inf_comm _ _ _ b, @inf_comm _ _ _ a], +end + +/-- +Let `α` be a normed lattice ordered group, then the order dual is also a +normed lattice ordered group. +-/ +@[priority 100] -- see Note [lower instance priority] +instance : normed_lattice_add_comm_group αᵒᵈ := +{ solid := dual_solid, + ..order_dual.ordered_add_comm_group, ..order_dual.normed_add_comm_group } + +lemma norm_abs_eq_norm (a : α) : ‖|a|‖ = ‖a‖ := +(solid (abs_abs a).le).antisymm (solid (abs_abs a).symm.le) + +lemma norm_inf_sub_inf_le_add_norm (a b c d : α) : ‖a ⊓ b - c ⊓ d‖ ≤ ‖a - c‖ + ‖b - d‖ := +begin + rw [← norm_abs_eq_norm (a - c), ← norm_abs_eq_norm (b - d)], + refine le_trans (solid _) (norm_add_le (|a - c|) (|b - d|)), + rw abs_of_nonneg (|a - c| + |b - d|) (add_nonneg (abs_nonneg (a - c)) (abs_nonneg (b - d))), + calc |a ⊓ b - c ⊓ d| = + |a ⊓ b - c ⊓ b + (c ⊓ b - c ⊓ d)| : by rw sub_add_sub_cancel + ... ≤ |a ⊓ b - c ⊓ b| + |c ⊓ b - c ⊓ d| : abs_add_le _ _ + ... ≤ |a -c| + |b - d| : by + { apply add_le_add, + { exact abs_inf_sub_inf_le_abs _ _ _, }, + { rw [@inf_comm _ _ c, @inf_comm _ _ c], + exact abs_inf_sub_inf_le_abs _ _ _, } }, +end + +lemma norm_sup_sub_sup_le_add_norm (a b c d : α) : ‖a ⊔ b - (c ⊔ d)‖ ≤ ‖a - c‖ + ‖b - d‖ := +begin + rw [← norm_abs_eq_norm (a - c), ← norm_abs_eq_norm (b - d)], + refine le_trans (solid _) (norm_add_le (|a - c|) (|b - d|)), + rw abs_of_nonneg (|a - c| + |b - d|) (add_nonneg (abs_nonneg (a - c)) (abs_nonneg (b - d))), + calc |a ⊔ b - (c ⊔ d)| = + |a ⊔ b - (c ⊔ b) + (c ⊔ b - (c ⊔ d))| : by rw sub_add_sub_cancel + ... ≤ |a ⊔ b - (c ⊔ b)| + |c ⊔ b - (c ⊔ d)| : abs_add_le _ _ + ... ≤ |a -c| + |b - d| : by + { apply add_le_add, + { exact abs_sup_sub_sup_le_abs _ _ _, }, + { rw [@sup_comm _ _ c, @sup_comm _ _ c], + exact abs_sup_sub_sup_le_abs _ _ _, } }, +end + +lemma norm_inf_le_add (x y : α) : ‖x ⊓ y‖ ≤ ‖x‖ + ‖y‖ := +begin + have h : ‖x ⊓ y - 0 ⊓ 0‖ ≤ ‖x - 0‖ + ‖y - 0‖ := norm_inf_sub_inf_le_add_norm x y 0 0, + simpa only [inf_idem, sub_zero] using h, +end + +lemma norm_sup_le_add (x y : α) : ‖x ⊔ y‖ ≤ ‖x‖ + ‖y‖ := +begin + have h : ‖x ⊔ y - 0 ⊔ 0‖ ≤ ‖x - 0‖ + ‖y - 0‖ := norm_sup_sub_sup_le_add_norm x y 0 0, + simpa only [sup_idem, sub_zero] using h, +end + +/-- +Let `α` be a normed lattice ordered group. Then the infimum is jointly continuous. +-/ +@[priority 100] -- see Note [lower instance priority] +instance normed_lattice_add_comm_group_has_continuous_inf : has_continuous_inf α := +begin + refine ⟨continuous_iff_continuous_at.2 $ λ q, tendsto_iff_norm_tendsto_zero.2 $ _⟩, + have : ∀ p : α × α, ‖p.1 ⊓ p.2 - q.1 ⊓ q.2‖ ≤ ‖p.1 - q.1‖ + ‖p.2 - q.2‖, + from λ _, norm_inf_sub_inf_le_add_norm _ _ _ _, + refine squeeze_zero (λ e, norm_nonneg _) this _, + convert (((continuous_fst.tendsto q).sub tendsto_const_nhds).norm).add + (((continuous_snd.tendsto q).sub tendsto_const_nhds).norm), + simp, +end + +@[priority 100] -- see Note [lower instance priority] +instance normed_lattice_add_comm_group_has_continuous_sup {α : Type*} + [normed_lattice_add_comm_group α] : + has_continuous_sup α := +order_dual.has_continuous_sup αᵒᵈ + +/-- +Let `α` be a normed lattice ordered group. Then `α` is a topological lattice in the norm topology. +-/ +@[priority 100] -- see Note [lower instance priority] +instance normed_lattice_add_comm_group_topological_lattice : topological_lattice α := +topological_lattice.mk + +lemma norm_abs_sub_abs (a b : α) : + ‖ |a| - |b| ‖ ≤ ‖a-b‖ := +solid (lattice_ordered_comm_group.abs_abs_sub_abs_le _ _) + +lemma norm_sup_sub_sup_le_norm (x y z : α) : ‖x ⊔ z - (y ⊔ z)‖ ≤ ‖x - y‖ := +solid (abs_sup_sub_sup_le_abs x y z) + +lemma norm_inf_sub_inf_le_norm (x y z : α) : ‖x ⊓ z - (y ⊓ z)‖ ≤ ‖x - y‖ := +solid (abs_inf_sub_inf_le_abs x y z) + +lemma lipschitz_with_sup_right (z : α) : lipschitz_with 1 (λ x, x ⊔ z) := +lipschitz_with.of_dist_le_mul $ λ x y, by +{ rw [nonneg.coe_one, one_mul, dist_eq_norm, dist_eq_norm], exact norm_sup_sub_sup_le_norm x y z, } + +lemma lipschitz_with_pos : lipschitz_with 1 (has_pos_part.pos : α → α) := +lipschitz_with_sup_right 0 + +lemma continuous_pos : continuous (has_pos_part.pos : α → α) := +lipschitz_with.continuous lipschitz_with_pos + +lemma continuous_neg' : continuous (has_neg_part.neg : α → α) := +continuous_pos.comp continuous_neg + +lemma is_closed_nonneg {E} [normed_lattice_add_comm_group E] : is_closed {x : E | 0 ≤ x} := +begin + suffices : {x : E | 0 ≤ x} = has_neg_part.neg ⁻¹' {(0 : E)}, + by { rw this, exact is_closed.preimage continuous_neg' is_closed_singleton, }, + ext1 x, + simp only [set.mem_preimage, set.mem_singleton_iff, set.mem_set_of_eq, neg_eq_zero_iff], +end + +lemma is_closed_le_of_is_closed_nonneg {G} [ordered_add_comm_group G] [topological_space G] + [has_continuous_sub G] (h : is_closed {x : G | 0 ≤ x}) : + is_closed {p : G × G | p.fst ≤ p.snd} := +begin + have : {p : G × G | p.fst ≤ p.snd} = (λ p : G × G, p.snd - p.fst) ⁻¹' {x : G | 0 ≤ x}, + by { ext1 p, simp only [sub_nonneg, set.preimage_set_of_eq], }, + rw this, + exact is_closed.preimage (continuous_snd.sub continuous_fst) h, +end + +@[priority 100] -- See note [lower instance priority] +instance normed_lattice_add_comm_group.order_closed_topology {E} [normed_lattice_add_comm_group E] : + order_closed_topology E := +⟨is_closed_le_of_is_closed_nonneg is_closed_nonneg⟩ diff --git a/src/analysis/normed/order/upper_lower.lean b/src/analysis/normed/order/upper_lower.lean new file mode 100644 index 0000000000000..a081b70aa9623 --- /dev/null +++ b/src/analysis/normed/order/upper_lower.lean @@ -0,0 +1,295 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import algebra.order.field.pi +import analysis.normed.group.pointwise +import analysis.normed.order.basic +import topology.algebra.order.upper_lower + +/-! +# Upper/lower/order-connected sets in normed groups + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The topological closure and interior of an upper/lower/order-connected set is an +upper/lower/order-connected set (with the notable exception of the closure of an order-connected +set). + +We also prove lemmas specific to `ℝⁿ`. Those are helpful to prove that order-connected sets in `ℝⁿ` +are measurable. +-/ + +open function metric set +open_locale pointwise + +variables {α ι : Type*} + +section normed_ordered_group +variables [normed_ordered_group α] {s : set α} + +@[to_additive is_upper_set.thickening] +protected lemma is_upper_set.thickening' (hs : is_upper_set s) (ε : ℝ) : + is_upper_set (thickening ε s) := +by { rw ←ball_mul_one, exact hs.mul_left } + +@[to_additive is_lower_set.thickening] +protected lemma is_lower_set.thickening' (hs : is_lower_set s) (ε : ℝ) : + is_lower_set (thickening ε s) := +by { rw ←ball_mul_one, exact hs.mul_left } + +@[to_additive is_upper_set.cthickening] +protected lemma is_upper_set.cthickening' (hs : is_upper_set s) (ε : ℝ) : + is_upper_set (cthickening ε s) := +by { rw cthickening_eq_Inter_thickening'', exact is_upper_set_Inter₂ (λ δ hδ, hs.thickening' _) } + +@[to_additive is_lower_set.cthickening] +protected lemma is_lower_set.cthickening' (hs : is_lower_set s) (ε : ℝ) : + is_lower_set (cthickening ε s) := +by { rw cthickening_eq_Inter_thickening'', exact is_lower_set_Inter₂ (λ δ hδ, hs.thickening' _) } + +@[to_additive upper_closure_interior_subset] +lemma upper_closure_interior_subset' (s : set α) : + (upper_closure (interior s) : set α) ⊆ interior (upper_closure s) := +upper_closure_min (interior_mono subset_upper_closure) (upper_closure s).upper.interior + +@[to_additive lower_closure_interior_subset] +lemma lower_closure_interior_subset' (s : set α) : + (upper_closure (interior s) : set α) ⊆ interior (upper_closure s) := +upper_closure_min (interior_mono subset_upper_closure) (upper_closure s).upper.interior + +end normed_ordered_group + +/-! ### `ℝⁿ` -/ + +section finite +variables [finite ι] {s : set (ι → ℝ)} {x y : ι → ℝ} + +lemma is_upper_set.mem_interior_of_forall_lt (hs : is_upper_set s) (hx : x ∈ closure s) + (h : ∀ i, x i < y i) : + y ∈ interior s := +begin + casesI nonempty_fintype ι, + obtain ⟨ε, hε, hxy⟩ := pi.exists_forall_pos_add_lt h, + obtain ⟨z, hz, hxz⟩ := metric.mem_closure_iff.1 hx _ hε, + rw dist_pi_lt_iff hε at hxz, + have hyz : ∀ i, z i < y i, + { refine λ i, (hxy _).trans_le' (sub_le_iff_le_add'.1 $ (le_abs_self _).trans _), + rw [←real.norm_eq_abs, ←dist_eq_norm'], + exact (hxz _).le }, + obtain ⟨δ, hδ, hyz⟩ := pi.exists_forall_pos_add_lt hyz, + refine mem_interior.2 ⟨ball y δ, _, is_open_ball, mem_ball_self hδ⟩, + rintro w hw, + refine hs (λ i, _) hz, + simp_rw [ball_pi _ hδ, real.ball_eq_Ioo] at hw, + exact ((lt_sub_iff_add_lt.2 $ hyz _).trans (hw _ $ mem_univ _).1).le, +end + +lemma is_lower_set.mem_interior_of_forall_lt (hs : is_lower_set s) (hx : x ∈ closure s) + (h : ∀ i, y i < x i) : + y ∈ interior s := +begin + casesI nonempty_fintype ι, + obtain ⟨ε, hε, hxy⟩ := pi.exists_forall_pos_add_lt h, + obtain ⟨z, hz, hxz⟩ := metric.mem_closure_iff.1 hx _ hε, + rw dist_pi_lt_iff hε at hxz, + have hyz : ∀ i, y i < z i, + { refine λ i, (lt_sub_iff_add_lt.2 $ hxy _).trans_le (sub_le_comm.1 $ (le_abs_self _).trans _), + rw [←real.norm_eq_abs, ←dist_eq_norm], + exact (hxz _).le }, + obtain ⟨δ, hδ, hyz⟩ := pi.exists_forall_pos_add_lt hyz, + refine mem_interior.2 ⟨ball y δ, _, is_open_ball, mem_ball_self hδ⟩, + rintro w hw, + refine hs (λ i, _) hz, + simp_rw [ball_pi _ hδ, real.ball_eq_Ioo] at hw, + exact ((hw _ $ mem_univ _).2.trans $ hyz _).le, +end + +end finite + +section fintype +variables [fintype ι] {s t : set (ι → ℝ)} {a₁ a₂ b₁ b₂ x y : ι → ℝ} {δ : ℝ} + +-- TODO: Generalise those lemmas so that they also apply to `ℝ` and `euclidean_space ι ℝ` +lemma dist_inf_sup (x y : ι → ℝ) : dist (x ⊓ y) (x ⊔ y) = dist x y := +begin + refine congr_arg coe (finset.sup_congr rfl $ λ i _, _), + simp only [real.nndist_eq', sup_eq_max, inf_eq_min, max_sub_min_eq_abs, pi.inf_apply, + pi.sup_apply, real.nnabs_of_nonneg, abs_nonneg, real.to_nnreal_abs], +end + +lemma dist_mono_left : monotone_on (λ x, dist x y) (Ici y) := +begin + refine λ y₁ hy₁ y₂ hy₂ hy, nnreal.coe_le_coe.2 (finset.sup_mono_fun $ λ i _, _), + rw [real.nndist_eq, real.nnabs_of_nonneg (sub_nonneg_of_le (‹y ≤ _› i : y i ≤ y₁ i)), + real.nndist_eq, real.nnabs_of_nonneg (sub_nonneg_of_le (‹y ≤ _› i : y i ≤ y₂ i))], + exact real.to_nnreal_mono (sub_le_sub_right (hy _) _), +end + +lemma dist_mono_right : monotone_on (dist x) (Ici x) := +by simpa only [dist_comm] using dist_mono_left + +lemma dist_anti_left : antitone_on (λ x, dist x y) (Iic y) := +begin + refine λ y₁ hy₁ y₂ hy₂ hy, nnreal.coe_le_coe.2 (finset.sup_mono_fun $ λ i _, _), + rw [real.nndist_eq', real.nnabs_of_nonneg (sub_nonneg_of_le (‹_ ≤ y› i : y₂ i ≤ y i)), + real.nndist_eq', real.nnabs_of_nonneg (sub_nonneg_of_le (‹_ ≤ y› i : y₁ i ≤ y i))], + exact real.to_nnreal_mono (sub_le_sub_left (hy _) _), +end + +lemma dist_anti_right : antitone_on (dist x) (Iic x) := +by simpa only [dist_comm] using dist_anti_left + +lemma dist_le_dist_of_le (ha : a₂ ≤ a₁) (h₁ : a₁ ≤ b₁) (hb : b₁ ≤ b₂) : dist a₁ b₁ ≤ dist a₂ b₂ := +(dist_mono_right h₁ (h₁.trans hb) hb).trans $ + dist_anti_left (ha.trans $ h₁.trans hb) (h₁.trans hb) ha + +protected lemma metric.bounded.bdd_below : bounded s → bdd_below s := +begin + rintro ⟨r, hr⟩, + obtain rfl | ⟨x, hx⟩ := s.eq_empty_or_nonempty, + { exact bdd_below_empty }, + { exact ⟨x - const _ r, λ y hy i, sub_le_comm.1 + (abs_sub_le_iff.1 $ (dist_le_pi_dist _ _ _).trans $ hr _ hx _ hy).1⟩ } +end + +protected lemma metric.bounded.bdd_above : bounded s → bdd_above s := +begin + rintro ⟨r, hr⟩, + obtain rfl | ⟨x, hx⟩ := s.eq_empty_or_nonempty, + { exact bdd_above_empty }, + { exact ⟨x + const _ r, λ y hy i, sub_le_iff_le_add'.1 $ + (abs_sub_le_iff.1 $ (dist_le_pi_dist _ _ _).trans $ hr _ hx _ hy).2⟩ } +end + +protected lemma bdd_below.bounded : bdd_below s → bdd_above s → bounded s := +begin + rintro ⟨a, ha⟩ ⟨b, hb⟩, + refine ⟨dist a b, λ x hx y hy, _⟩, + rw ←dist_inf_sup, + exact dist_le_dist_of_le (le_inf (ha hx) $ ha hy) inf_le_sup (sup_le (hb hx) $ hb hy), +end + +protected lemma bdd_above.bounded : bdd_above s → bdd_below s → bounded s := flip bdd_below.bounded + +lemma bounded_iff_bdd_below_bdd_above : bounded s ↔ bdd_below s ∧ bdd_above s := +⟨λ h, ⟨h.bdd_below, h.bdd_above⟩, λ h, h.1.bounded h.2⟩ + +lemma bdd_below.bounded_inter (hs : bdd_below s) (ht : bdd_above t) : bounded (s ∩ t) := +(hs.mono $ inter_subset_left _ _).bounded $ ht.mono $ inter_subset_right _ _ + +lemma bdd_above.bounded_inter (hs : bdd_above s) (ht : bdd_below t) : bounded (s ∩ t) := +(hs.mono $ inter_subset_left _ _).bounded $ ht.mono $ inter_subset_right _ _ + +lemma is_upper_set.exists_subset_ball (hs : is_upper_set s) (hx : x ∈ closure s) (hδ : 0 < δ) : + ∃ y, closed_ball y (δ/4) ⊆ closed_ball x δ ∧ closed_ball y (δ/4) ⊆ interior s := +begin + refine ⟨x + const _ (3/4*δ), closed_ball_subset_closed_ball' _, _⟩, + { rw dist_self_add_left, + refine (add_le_add_left (pi_norm_const_le $ 3 / 4 * δ) _).trans_eq _, + simp [real.norm_of_nonneg, hδ.le, zero_le_three], + ring_nf }, + obtain ⟨y, hy, hxy⟩ := metric.mem_closure_iff.1 hx _ (div_pos hδ zero_lt_four), + refine λ z hz, hs.mem_interior_of_forall_lt (subset_closure hy) (λ i, _), + rw [mem_closed_ball, dist_eq_norm'] at hz, + rw dist_eq_norm at hxy, + replace hxy := (norm_le_pi_norm _ i).trans hxy.le, + replace hz := (norm_le_pi_norm _ i).trans hz, + dsimp at hxy hz, + rw abs_sub_le_iff at hxy hz, + linarith, +end + +lemma is_lower_set.exists_subset_ball (hs : is_lower_set s) (hx : x ∈ closure s) (hδ : 0 < δ) : + ∃ y, closed_ball y (δ/4) ⊆ closed_ball x δ ∧ closed_ball y (δ/4) ⊆ interior s := +begin + refine ⟨x - const _ (3/4*δ), closed_ball_subset_closed_ball' _, _⟩, + { rw dist_self_sub_left, + refine (add_le_add_left (pi_norm_const_le $ 3 / 4 * δ) _).trans_eq _, + simp [real.norm_of_nonneg, hδ.le, zero_le_three], + ring_nf }, + obtain ⟨y, hy, hxy⟩ := metric.mem_closure_iff.1 hx _ (div_pos hδ zero_lt_four), + refine λ z hz, hs.mem_interior_of_forall_lt (subset_closure hy) (λ i, _), + rw [mem_closed_ball, dist_eq_norm'] at hz, + rw dist_eq_norm at hxy, + replace hxy := (norm_le_pi_norm _ i).trans hxy.le, + replace hz := (norm_le_pi_norm _ i).trans hz, + dsimp at hxy hz, + rw abs_sub_le_iff at hxy hz, + linarith, +end + +end fintype + +section finite +variables [finite ι] {s t : set (ι → ℝ)} {a₁ a₂ b₁ b₂ x y : ι → ℝ} {δ : ℝ} + +lemma is_antichain.interior_eq_empty [nonempty ι] (hs : is_antichain (≤) s) : interior s = ∅ := +begin + casesI nonempty_fintype ι, + refine eq_empty_of_forall_not_mem (λ x hx, _), + have hx' := interior_subset hx, + rw [mem_interior_iff_mem_nhds, metric.mem_nhds_iff] at hx, + obtain ⟨ε, hε, hx⟩ := hx, + refine hs.not_lt hx' (hx _) (lt_add_of_pos_right _ (by positivity : 0 < const ι (ε / 2))), + simpa [const, @pi_norm_const ι ℝ _ _ _ (ε / 2), abs_of_nonneg hε.lt.le], +end + +/-! +#### Note + +The closure and frontier of an antichain might not be antichains. Take for example the union +of the open segments from `(0, 2)` to `(1, 1)` and from `(2, 1)` to `(3, 0)`. `(1, 1)` and `(2, 1)` +are comparable and both in the closure/frontier. +-/ + +protected lemma is_closed.upper_closure (hs : is_closed s) (hs' : bdd_below s) : + is_closed (upper_closure s : set (ι → ℝ)) := +begin + casesI nonempty_fintype ι, + refine is_seq_closed.is_closed (λ f x hf hx, _), + choose g hg hgf using hf, + obtain ⟨a, ha⟩ := hx.bdd_above_range, + obtain ⟨b, hb, φ, hφ, hbf⟩ := tendsto_subseq_of_bounded (hs'.bounded_inter + bdd_above_Iic) (λ n, ⟨hg n, (hgf _).trans $ ha $ mem_range_self _⟩), + exact ⟨b, closure_minimal (inter_subset_left _ _) hs hb, + le_of_tendsto_of_tendsto' hbf (hx.comp hφ.tendsto_at_top) $ λ _, hgf _⟩, +end + +protected lemma is_closed.lower_closure (hs : is_closed s) (hs' : bdd_above s) : + is_closed (lower_closure s : set (ι → ℝ)) := +begin + casesI nonempty_fintype ι, + refine is_seq_closed.is_closed (λ f x hf hx, _), + choose g hg hfg using hf, + haveI : bounded_ge_nhds_class ℝ := by apply_instance, + obtain ⟨a, ha⟩ := hx.bdd_below_range, + obtain ⟨b, hb, φ, hφ, hbf⟩ := tendsto_subseq_of_bounded (hs'.bounded_inter + bdd_below_Ici) (λ n, ⟨hg n, (ha $ mem_range_self _).trans $ hfg _⟩), + exact ⟨b, closure_minimal (inter_subset_left _ _) hs hb, + le_of_tendsto_of_tendsto' (hx.comp hφ.tendsto_at_top) hbf $ λ _, hfg _⟩, +end + +protected lemma is_clopen.upper_closure (hs : is_clopen s) (hs' : bdd_below s) : + is_clopen (upper_closure s : set (ι → ℝ)) := +⟨hs.1.upper_closure, hs.2.upper_closure hs'⟩ + +protected lemma is_clopen.lower_closure (hs : is_clopen s) (hs' : bdd_above s) : + is_clopen (lower_closure s : set (ι → ℝ)) := +⟨hs.1.lower_closure, hs.2.lower_closure hs'⟩ + +lemma closure_upper_closure_comm (hs : bdd_below s) : + closure (upper_closure s : set (ι → ℝ)) = upper_closure (closure s) := +(closure_minimal (upper_closure_anti subset_closure) $ + is_closed_closure.upper_closure hs.closure).antisymm $ + upper_closure_min (closure_mono subset_upper_closure) (upper_closure s).upper.closure + +lemma closure_lower_closure_comm (hs : bdd_above s) : + closure (lower_closure s : set (ι → ℝ)) = lower_closure (closure s) := +(closure_minimal (lower_closure_mono subset_closure) $ + is_closed_closure.lower_closure hs.closure).antisymm $ + lower_closure_min (closure_mono subset_lower_closure) (lower_closure s).lower.closure + +end finite diff --git a/src/analysis/normed/ring/seminorm.lean b/src/analysis/normed/ring/seminorm.lean new file mode 100644 index 0000000000000..21c6fbd9261b7 --- /dev/null +++ b/src/analysis/normed/ring/seminorm.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: María Inés de Frutos-Fernández, Yaël Dillies +-/ +import analysis.normed.field.basic + +/-! +# Seminorms and norms on rings + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines seminorms and norms on rings. These definitions are useful when one needs to +consider multiple (semi)norms on a given ring. + +## Main declarations + +For a ring `R`: +* `ring_seminorm`: A seminorm on a ring `R` is a function `f : R → ℝ` that preserves zero, takes + nonnegative values, is subadditive and submultiplicative and such that `f (-x) = f x` for all + `x ∈ R`. +* `ring_norm`: A seminorm `f` is a norm if `f x = 0` if and only if `x = 0`. +* `mul_ring_seminorm`: A multiplicative seminorm on a ring `R` is a ring seminorm that preserves + multiplication. +* `mul_ring_norm`: A multiplicative norm on a ring `R` is a ring norm that preserves multiplication. + +## Notes + +The corresponding hom classes are defined in `analysis.order.hom.basic` to be used by absolute +values. + +## References + +* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert] + +## Tags +ring_seminorm, ring_norm +-/ + +set_option old_structure_cmd true + +open_locale nnreal + +variables {F R S : Type*} (x y : R) (r : ℝ) + +/-- A seminorm on a ring `R` is a function `f : R → ℝ` that preserves zero, takes nonnegative + values, is subadditive and submultiplicative and such that `f (-x) = f x` for all `x ∈ R`. -/ +structure ring_seminorm (R : Type*) [non_unital_non_assoc_ring R] + extends add_group_seminorm R := +(mul_le' : ∀ x y : R, to_fun (x * y) ≤ to_fun x * to_fun y) + +/-- A function `f : R → ℝ` is a norm on a (nonunital) ring if it is a seminorm and `f x = 0` + implies `x = 0`. -/ +structure ring_norm (R : Type*) [non_unital_non_assoc_ring R] + extends ring_seminorm R, add_group_norm R + +/-- A multiplicative seminorm on a ring `R` is a function `f : R → ℝ` that preserves zero and +multiplication, takes nonnegative values, is subadditive and such that `f (-x) = f x` for all `x`. +-/ +structure mul_ring_seminorm (R : Type*) [non_assoc_ring R] + extends add_group_seminorm R, monoid_with_zero_hom R ℝ + +/-- A multiplicative norm on a ring `R` is a multiplicative ring seminorm such that `f x = 0` +implies `x = 0`. -/ +structure mul_ring_norm (R : Type*) [non_assoc_ring R] extends mul_ring_seminorm R, add_group_norm R + +attribute [nolint doc_blame] ring_seminorm.to_add_group_seminorm ring_norm.to_add_group_norm + ring_norm.to_ring_seminorm mul_ring_seminorm.to_add_group_seminorm + mul_ring_seminorm.to_monoid_with_zero_hom mul_ring_norm.to_add_group_norm + mul_ring_norm.to_mul_ring_seminorm + +namespace ring_seminorm + +section non_unital_ring + +variables [non_unital_ring R] + +instance ring_seminorm_class : ring_seminorm_class (ring_seminorm R) R ℝ := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_zero := λ f, f.map_zero', + map_add_le_add := λ f, f.add_le', + map_mul_le_mul := λ f, f.mul_le', + map_neg_eq_map := λ f, f.neg' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +instance : has_coe_to_fun (ring_seminorm R) (λ _, R → ℝ) := fun_like.has_coe_to_fun + +@[simp] lemma to_fun_eq_coe (p : ring_seminorm R) : p.to_fun = p := rfl + +@[ext] lemma ext {p q : ring_seminorm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q + +instance : has_zero (ring_seminorm R) := +⟨{ mul_le' := λ _ _, (zero_mul _).ge, + ..add_group_seminorm.has_zero.zero }⟩ + +lemma eq_zero_iff {p : ring_seminorm R} : p = 0 ↔ ∀ x, p x = 0 := fun_like.ext_iff +lemma ne_zero_iff {p : ring_seminorm R} : p ≠ 0 ↔ ∃ x, p x ≠ 0 := by simp [eq_zero_iff] + +instance : inhabited (ring_seminorm R) := ⟨0⟩ + +/-- The trivial seminorm on a ring `R` is the `ring_seminorm` taking value `0` at `0` and `1` at +every other element. -/ +instance [decidable_eq R] : has_one (ring_seminorm R) := +⟨{ mul_le' := λ x y, begin + by_cases h : x * y = 0, + { refine (if_pos h).trans_le (mul_nonneg _ _); + { change _ ≤ ite _ _ _, + split_ifs, + exacts [le_rfl, zero_le_one] } }, + { change ite _ _ _ ≤ ite _ _ _ * ite _ _ _, + simp only [if_false, h, left_ne_zero_of_mul h, right_ne_zero_of_mul h, mul_one] } + end, + ..(1 : add_group_seminorm R) }⟩ + +@[simp] lemma apply_one [decidable_eq R] (x : R) : + (1 : ring_seminorm R) x = if x = 0 then 0 else 1 := rfl + +end non_unital_ring + +section ring + +variables [ring R] (p : ring_seminorm R) + +lemma seminorm_one_eq_one_iff_ne_zero (hp : p 1 ≤ 1) : + p 1 = 1 ↔ p ≠ 0 := +begin + refine ⟨λ h, ne_zero_iff.mpr ⟨1, by {rw h, exact one_ne_zero}⟩, λ h, _⟩, + obtain hp0 | hp0 := (map_nonneg p (1 : R)).eq_or_gt, + { cases h (ext $ λ x, (map_nonneg _ _).antisymm' _), + simpa only [hp0, mul_one, mul_zero] using map_mul_le_mul p x 1}, + { refine hp.antisymm ((le_mul_iff_one_le_left hp0).1 _), + simpa only [one_mul] using map_mul_le_mul p (1 : R) _ } +end + +end ring + +end ring_seminorm + +/-- The norm of a `non_unital_semi_normed_ring` as a `ring_seminorm`. -/ +def norm_ring_seminorm (R : Type*) [non_unital_semi_normed_ring R] : + ring_seminorm R := +{ to_fun := norm, + mul_le' := norm_mul_le, + ..(norm_add_group_seminorm R) } + +namespace ring_norm + +variable [non_unital_ring R] + +instance ring_norm_class : ring_norm_class (ring_norm R) R ℝ := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_zero := λ f, f.map_zero', + map_add_le_add := λ f, f.add_le', + map_mul_le_mul := λ f, f.mul_le', + map_neg_eq_map := λ f, f.neg', + eq_zero_of_map_eq_zero := λ f, f.eq_zero_of_map_eq_zero' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +instance : has_coe_to_fun (ring_norm R) (λ _, R → ℝ) := ⟨λ p, p.to_fun⟩ + +@[simp] lemma to_fun_eq_coe (p : ring_norm R) : p.to_fun = p := rfl + +@[ext] lemma ext {p q : ring_norm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q + +variable (R) + +/-- The trivial norm on a ring `R` is the `ring_norm` taking value `0` at `0` and `1` at every + other element. -/ +instance [decidable_eq R] : has_one (ring_norm R) := +⟨{ ..(1 : ring_seminorm R), ..(1 : add_group_norm R) }⟩ + +@[simp] lemma apply_one [decidable_eq R] (x : R) : (1 : ring_norm R) x = if x = 0 then 0 else 1 := +rfl + +instance [decidable_eq R] : inhabited (ring_norm R) := ⟨1⟩ + +end ring_norm + +namespace mul_ring_seminorm +variables [non_assoc_ring R] + +instance mul_ring_seminorm_class : mul_ring_seminorm_class (mul_ring_seminorm R) R ℝ := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_zero := λ f, f.map_zero', + map_one := λ f, f.map_one', + map_add_le_add := λ f, f.add_le', + map_mul := λ f, f.map_mul', + map_neg_eq_map := λ f, f.neg' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +instance : has_coe_to_fun (mul_ring_seminorm R) (λ _, R → ℝ) := fun_like.has_coe_to_fun + +@[simp] lemma to_fun_eq_coe (p : mul_ring_seminorm R) : p.to_fun = p := rfl + +@[ext] lemma ext {p q : mul_ring_seminorm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q + +variables [decidable_eq R] [no_zero_divisors R] [nontrivial R] + +/-- The trivial seminorm on a ring `R` is the `mul_ring_seminorm` taking value `0` at `0` and `1` at +every other element. -/ +instance : has_one (mul_ring_seminorm R) := +⟨{ map_one' := if_neg one_ne_zero, + map_mul' := λ x y, begin + obtain rfl | hx := eq_or_ne x 0, + { simp }, + obtain rfl | hy := eq_or_ne y 0, + { simp }, + { simp [hx, hy] } + end, + ..(1 : add_group_seminorm R) }⟩ + +@[simp] lemma apply_one (x : R) : (1 : mul_ring_seminorm R) x = if x = 0 then 0 else 1 := rfl + +instance : inhabited (mul_ring_seminorm R) := ⟨1⟩ + +end mul_ring_seminorm + +namespace mul_ring_norm +variable [non_assoc_ring R] + +instance mul_ring_norm_class : mul_ring_norm_class (mul_ring_norm R) R ℝ := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_zero := λ f, f.map_zero', + map_one := λ f, f.map_one', + map_add_le_add := λ f, f.add_le', + map_mul := λ f, f.map_mul', + map_neg_eq_map := λ f, f.neg', + eq_zero_of_map_eq_zero := λ f, f.eq_zero_of_map_eq_zero' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +instance : has_coe_to_fun (mul_ring_norm R) (λ _, R → ℝ) := ⟨λ p, p.to_fun⟩ + +@[simp] lemma to_fun_eq_coe (p : mul_ring_norm R) : p.to_fun = p := rfl + +@[ext] lemma ext {p q : mul_ring_norm R} : (∀ x, p x = q x) → p = q := fun_like.ext p q + +variables (R) [decidable_eq R] [no_zero_divisors R] [nontrivial R] + +/-- The trivial norm on a ring `R` is the `mul_ring_norm` taking value `0` at `0` and `1` at every +other element. -/ +instance : has_one (mul_ring_norm R) := +⟨{ ..(1 : mul_ring_seminorm R), ..(1 : add_group_norm R) }⟩ + +@[simp] lemma apply_one (x : R) : (1 : mul_ring_norm R) x = if x = 0 then 0 else 1 := rfl + +instance : inhabited (mul_ring_norm R) := ⟨1⟩ + +end mul_ring_norm + +/-- A nonzero ring seminorm on a field `K` is a ring norm. -/ +def ring_seminorm.to_ring_norm {K : Type*} [field K] (f : ring_seminorm K) (hnt : f ≠ 0) : + ring_norm K := +{ eq_zero_of_map_eq_zero' := λ x hx, + begin + obtain ⟨c, hc⟩ := ring_seminorm.ne_zero_iff.mp hnt, + by_contradiction hn0, + have hc0 : f c = 0, + { rw [← mul_one c, ← mul_inv_cancel hn0, ← mul_assoc, mul_comm c, mul_assoc], + exact le_antisymm (le_trans (map_mul_le_mul f _ _) + (by rw [← ring_seminorm.to_fun_eq_coe, hx, zero_mul])) (map_nonneg f _) }, + exact hc hc0, + end, + ..f } + +/-- The norm of a normed_ring as a ring_norm. -/ +@[simps] def norm_ring_norm (R : Type*) [non_unital_normed_ring R] : ring_norm R := +{ ..norm_add_group_norm R, ..norm_ring_seminorm R } diff --git a/src/analysis/normed_space/M_structure.lean b/src/analysis/normed_space/M_structure.lean new file mode 100644 index 0000000000000..82bcc2458dad4 --- /dev/null +++ b/src/analysis/normed_space/M_structure.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2022 Christopher Hoskin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christopher Hoskin +-/ +import algebra.ring.idempotents +import tactic.noncomm_ring +import analysis.normed.group.basic + +/-! +# M-structure + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A projection P on a normed space X is said to be an L-projection (`is_Lprojection`) if, for all `x` +in `X`, +$\|x\| = \|P x\| + \|(1 - P) x\|$. + +A projection P on a normed space X is said to be an M-projection if, for all `x` in `X`, +$\|x\| = max(\|P x\|,\|(1 - P) x\|)$. + +The L-projections on `X` form a Boolean algebra (`is_Lprojection.subtype.boolean_algebra`). + +## TODO (Motivational background) + +The M-projections on a normed space form a Boolean algebra. + +The range of an L-projection on a normed space `X` is said to be an L-summand of `X`. The range of +an M-projection is said to be an M-summand of `X`. + +When `X` is a Banach space, the Boolean algebra of L-projections is complete. Let `X` be a normed +space with dual `X^*`. A closed subspace `M` of `X` is said to be an M-ideal if the topological +annihilator `M^∘` is an L-summand of `X^*`. + +M-ideal, M-summands and L-summands were introduced by Alfsen and Effros in [alfseneffros1972] to +study the structure of general Banach spaces. When `A` is a JB*-triple, the M-ideals of `A` are +exactly the norm-closed ideals of `A`. When `A` is a JBW*-triple with predual `X`, the M-summands of +`A` are exactly the weak*-closed ideals, and their pre-duals can be identified with the L-summands +of `X`. In the special case when `A` is a C*-algebra, the M-ideals are exactly the norm-closed +two-sided ideals of `A`, when `A` is also a W*-algebra the M-summands are exactly the weak*-closed +two-sided ideals of `A`. + +## Implementation notes + +The approach to showing that the L-projections form a Boolean algebra is inspired by +`measure_theory.measurable_space`. + +Instead of using `P : X →L[𝕜] X` to represent projections, we use an arbitrary ring `M` with a +faithful action on `X`. `continuous_linear_map.apply_module` can be used to recover the `X →L[𝕜] X` +special case. + +## References + +* [Behrends, M-structure and the Banach-Stone Theorem][behrends1979] +* [Harmand, Werner, Werner, M-ideals in Banach spaces and Banach algebras][harmandwernerwerner1993] + +## Tags + +M-summand, M-projection, L-summand, L-projection, M-ideal, M-structure + +-/ + +variables (X : Type*) [normed_add_comm_group X] +variables {M : Type*} [ring M] [module M X] +/-- +A projection on a normed space `X` is said to be an L-projection if, for all `x` in `X`, +$\|x\| = \|P x\| + \|(1 - P) x\|$. + +Note that we write `P • x` instead of `P x` for reasons described in the module docstring. +-/ +structure is_Lprojection (P : M) : Prop := +(proj : is_idempotent_elem P) +(Lnorm : ∀ (x : X), ‖x‖ = ‖P • x‖ + ‖(1 - P) • x‖) + +/-- +A projection on a normed space `X` is said to be an M-projection if, for all `x` in `X`, +$\|x\| = max(\|P x\|,\|(1 - P) x\|)$. + +Note that we write `P • x` instead of `P x` for reasons described in the module docstring. +-/ +structure is_Mprojection (P : M) : Prop := +(proj : is_idempotent_elem P) +(Mnorm : ∀ (x : X), ‖x‖ = (max ‖P • x‖ ‖(1 - P) • x‖)) + +variables {X} + +namespace is_Lprojection + +lemma Lcomplement {P : M} (h: is_Lprojection X P) : is_Lprojection X (1 - P) := +⟨h.proj.one_sub, λ x, by { rw [add_comm, sub_sub_cancel], exact h.Lnorm x }⟩ + +lemma Lcomplement_iff (P : M) : is_Lprojection X P ↔ is_Lprojection X (1 - P) := +⟨Lcomplement, λ h, sub_sub_cancel 1 P ▸ h.Lcomplement⟩ + +lemma commute [has_faithful_smul M X] {P Q : M} (h₁ : is_Lprojection X P) + (h₂ : is_Lprojection X Q) : commute P Q := +begin + have PR_eq_RPR : ∀ R : M, is_Lprojection X R → P * R = R * P * R := λ R h₃, + begin + refine @eq_of_smul_eq_smul _ X _ _ _ _ (λ x, _), + rw ← norm_sub_eq_zero_iff, + have e1 : ‖R • x‖ ≥ ‖R • x‖ + 2 • ‖ (P * R) • x - (R * P * R) • x‖ := + calc ‖R • x‖ = ‖R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖ + + (‖(R * R) • x - R • (P • (R • x))‖ + ‖(1 - R) • ((1 - P) • (R • x))‖) : + by rw [h₁.Lnorm, h₃.Lnorm, h₃.Lnorm ((1 - P) • (R • x)), sub_smul 1 P, + one_smul, smul_sub, mul_smul] + ... = ‖R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖ + (‖R • x - R • (P • (R • x))‖ + + ‖((1 - R) * R) • x - (1 - R) • (P • (R • x))‖) : by rw [h₃.proj.eq, + sub_smul 1 P, one_smul, smul_sub, mul_smul] + ... = ‖R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖ + + (‖R • x - R • (P • (R • x))‖ + ‖(1 - R) • (P • (R • x))‖) : + by rw [sub_mul, h₃.proj.eq, one_mul, sub_self, zero_smul, zero_sub, + norm_neg] + ... = ‖R • (P • (R • x))‖ + ‖R • x - R • (P • (R • x))‖ + 2•‖(1 - R) • (P • (R • x))‖ : by abel + ... ≥ ‖R • x‖ + 2 • ‖ (P * R) • x - (R * P * R) • x‖ : by + { rw ge, + have := add_le_add_right + (norm_le_insert' (R • x) (R • (P • (R • x)))) (2•‖(1 - R) • (P • (R • x))‖), + simpa only [mul_smul, sub_smul, one_smul] using this }, + rw ge at e1, + nth_rewrite_rhs 0 ← add_zero (‖R • x‖) at e1, + rw [add_le_add_iff_left, two_smul, ← two_mul] at e1, + rw le_antisymm_iff, + refine ⟨_, norm_nonneg _⟩, + rwa [←mul_zero (2 : ℝ), mul_le_mul_left (show (0 : ℝ) < 2, by norm_num)] at e1 + end, + have QP_eq_QPQ : Q * P = Q * P * Q, + { have e1 : P * (1 - Q) = P * (1 - Q) - (Q * P - Q * P * Q) := + calc P * (1 - Q) = (1 - Q) * P * (1 - Q) : by rw PR_eq_RPR (1 - Q) h₂.Lcomplement + ... = P * (1 - Q) - (Q * P - Q * P * Q) : by noncomm_ring, + rwa [eq_sub_iff_add_eq, add_right_eq_self, sub_eq_zero] at e1 }, + show P * Q = Q * P, by rw [QP_eq_QPQ, PR_eq_RPR Q h₂] +end + +lemma mul [has_faithful_smul M X] {P Q : M} (h₁ : is_Lprojection X P) (h₂ : is_Lprojection X Q) : + is_Lprojection X (P * Q) := +begin + refine ⟨is_idempotent_elem.mul_of_commute (h₁.commute h₂) h₁.proj h₂.proj, _⟩, + intro x, + refine le_antisymm _ _, + { calc ‖ x ‖ = ‖(P * Q) • x + (x - (P * Q) • x)‖ : by rw add_sub_cancel'_right ((P * Q) • x) x + ... ≤ ‖(P * Q) • x‖ + ‖ x - (P * Q) • x ‖ : by apply norm_add_le + ... = ‖(P * Q) • x‖ + ‖(1 - P * Q) • x‖ : by rw [sub_smul, + one_smul] }, + { calc ‖x‖ = ‖P • (Q • x)‖ + (‖Q • x - P • (Q • x)‖ + ‖x - Q • x‖) : by + rw [h₂.Lnorm x, h₁.Lnorm (Q • x), + sub_smul, one_smul, + sub_smul, one_smul, add_assoc] + ... ≥ ‖P • (Q • x)‖ + ‖(Q • x - P • (Q • x)) + (x - Q • x)‖ : + (add_le_add_iff_left (‖P • (Q • x)‖)).mpr (norm_add_le (Q • x - P • (Q • x)) (x - Q • x)) + ... = ‖(P * Q) • x‖ + ‖(1 - P * Q) • x‖ : by rw [sub_add_sub_cancel', + sub_smul, one_smul, + mul_smul] } +end + +lemma join [has_faithful_smul M X] {P Q : M} (h₁ : is_Lprojection X P) (h₂ : is_Lprojection X Q) : + is_Lprojection X (P + Q - P * Q) := +begin + convert (Lcomplement_iff _).mp (h₁.Lcomplement.mul h₂.Lcomplement) using 1, + noncomm_ring, +end + +instance : has_compl { f : M // is_Lprojection X f } := +⟨λ P, ⟨1 - P, P.prop.Lcomplement⟩⟩ + +@[simp] lemma coe_compl (P : {P : M // is_Lprojection X P}) : + ↑(Pᶜ) = (1 : M) - ↑P := rfl + +instance [has_faithful_smul M X] : has_inf {P : M // is_Lprojection X P} := +⟨λ P Q, ⟨P * Q, P.prop.mul Q.prop⟩ ⟩ + +@[simp] lemma coe_inf [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) : + ↑(P ⊓ Q) = ((↑P : (M)) * ↑Q) := rfl + +instance [has_faithful_smul M X] : has_sup {P : M // is_Lprojection X P} := +⟨λ P Q, ⟨P + Q - P * Q, P.prop.join Q.prop⟩ ⟩ + +@[simp] lemma coe_sup [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) : + ↑(P ⊔ Q) = ((↑P : M) + ↑Q - ↑P * ↑Q) := rfl + +instance [has_faithful_smul M X] : has_sdiff {P : M // is_Lprojection X P} := +⟨λ P Q, ⟨P * (1 - Q), by exact P.prop.mul Q.prop.Lcomplement ⟩⟩ + +@[simp] lemma coe_sdiff [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) : + ↑(P \ Q) = (↑P : M) * (1 - ↑Q) := rfl + +instance [has_faithful_smul M X] : partial_order {P : M // is_Lprojection X P} := +{ le := λ P Q, (↑P : M) = ↑(P ⊓ Q), + le_refl := λ P, by simpa only [coe_inf, ←sq] using (P.prop.proj.eq).symm, + le_trans := λ P Q R h₁ h₂, by { simp only [coe_inf] at ⊢ h₁ h₂, rw [h₁, mul_assoc, ←h₂] }, + le_antisymm := λ P Q h₁ h₂, subtype.eq (by convert (P.prop.commute Q.prop).eq) } + +lemma le_def [has_faithful_smul M X] (P Q : {P : M // is_Lprojection X P}) : + P ≤ Q ↔ (P : M) = ↑(P ⊓ Q) := +iff.rfl + +instance : has_zero {P : M // is_Lprojection X P} := +⟨⟨0, ⟨by rw [is_idempotent_elem, zero_mul], + λ x, by simp only [zero_smul, norm_zero, sub_zero, + one_smul, zero_add]⟩⟩⟩ + +@[simp] lemma coe_zero : ↑(0 : {P : M // is_Lprojection X P}) = (0 : M) := +rfl + +instance : has_one {P : M // is_Lprojection X P} := +⟨⟨1, sub_zero (1 : M) ▸ (0 : {P : M // is_Lprojection X P}).prop.Lcomplement⟩⟩ + +@[simp] lemma coe_one : ↑(1 : {P : M // is_Lprojection X P}) = (1 : M) := +rfl + +instance [has_faithful_smul M X] : bounded_order {P : M // is_Lprojection X P} := +{ top := 1, + le_top := λ P, (mul_one (P : M)).symm, + bot := 0, + bot_le := λ P, (zero_mul (P : M)).symm, } + +@[simp] lemma coe_bot [has_faithful_smul M X] : + ↑(bounded_order.bot : {P : M // is_Lprojection X P}) = (0 : M) := rfl + +@[simp] lemma coe_top [has_faithful_smul M X] : + ↑(bounded_order.top : {P : M // is_Lprojection X P}) = (1 : M) := rfl + +lemma compl_mul {P : {P : M // is_Lprojection X P}} {Q : M} : + ↑Pᶜ * Q = Q - ↑P * Q := by rw [coe_compl, sub_mul, one_mul] + +lemma mul_compl_self {P : {P : M // is_Lprojection X P}} : + (↑P : M) * (↑Pᶜ) = 0 := +by rw [coe_compl, mul_sub, mul_one, P.prop.proj.eq, sub_self] + +lemma distrib_lattice_lemma [has_faithful_smul M X] {P Q R : {P : M // is_Lprojection X P}} : + ((↑P : M) + ↑Pᶜ * R) * (↑P + ↑Q * ↑R * ↑Pᶜ) = (↑P + ↑Q * ↑R * ↑Pᶜ) := +by rw [add_mul, mul_add, mul_add, mul_assoc ↑Pᶜ ↑R (↑Q * ↑R * ↑Pᶜ), ← mul_assoc ↑R (↑Q * ↑R) ↑Pᶜ, + ← coe_inf Q, (Pᶜ.prop.commute R.prop).eq, ((Q ⊓ R).prop.commute Pᶜ.prop).eq, + (R.prop.commute (Q ⊓ R).prop).eq, coe_inf Q, mul_assoc ↑Q, ← mul_assoc, mul_assoc ↑R, + (Pᶜ.prop.commute P.prop).eq, mul_compl_self, zero_mul, mul_zero, zero_add, add_zero, + ← mul_assoc, + P.prop.proj.eq, R.prop.proj.eq, ← coe_inf Q, mul_assoc, ((Q ⊓ R).prop.commute Pᶜ.prop).eq, + ← mul_assoc, Pᶜ.prop.proj.eq] + +instance [has_faithful_smul M X] : distrib_lattice {P : M // is_Lprojection X P} := +{ le_sup_left := λ P Q, by rw [le_def, coe_inf, coe_sup, ← add_sub, mul_add, mul_sub, ← mul_assoc, + P.prop.proj.eq, sub_self, add_zero], + le_sup_right := λ P Q, + begin + rw [le_def, coe_inf, coe_sup, ← add_sub, mul_add, mul_sub, commute.eq (commute P.prop Q.prop), + ← mul_assoc, Q.prop.proj.eq, add_sub_cancel'_right], + end, + sup_le := λ P Q R, + begin + rw [le_def, le_def, le_def, coe_inf, coe_inf, coe_sup, coe_inf, coe_sup, ← add_sub, add_mul, + sub_mul, mul_assoc], + intros h₁ h₂, + rw [← h₂, ← h₁], + end, + inf_le_left := λ P Q, by rw [le_def, coe_inf, coe_inf, coe_inf, mul_assoc, + (Q.prop.commute P.prop).eq, ← mul_assoc, P.prop.proj.eq], + inf_le_right := λ P Q, by rw [le_def, coe_inf, coe_inf, coe_inf, mul_assoc, Q.prop.proj.eq], + le_inf := λ P Q R, + begin + rw [le_def, le_def, le_def, coe_inf, coe_inf, coe_inf, coe_inf, ← mul_assoc], + intros h₁ h₂, + rw [← h₁, ← h₂], + end, + le_sup_inf := λ P Q R, + begin + have e₁: ↑((P ⊔ Q) ⊓ (P ⊔ R)) = ↑P + ↑Q * ↑R * ↑Pᶜ := + by rw [coe_inf, coe_sup, coe_sup, + ← add_sub, ← add_sub, ←compl_mul, ←compl_mul, add_mul, mul_add, + (Pᶜ.prop.commute Q.prop).eq, mul_add, ← mul_assoc, mul_assoc ↑Q, (Pᶜ.prop.commute P.prop).eq, + mul_compl_self, zero_mul, mul_zero, zero_add, add_zero, ← mul_assoc, mul_assoc ↑Q, + P.prop.proj.eq, Pᶜ.prop.proj.eq, mul_assoc, (Pᶜ.prop.commute R.prop).eq, ← mul_assoc], + have e₂ : ↑((P ⊔ Q) ⊓ (P ⊔ R)) * ↑(P ⊔ Q ⊓ R) = ↑P + ↑Q * ↑R * ↑Pᶜ := by rw [coe_inf, coe_sup, + coe_sup, coe_sup, ← add_sub, ← add_sub, ← add_sub, ←compl_mul, ←compl_mul, + ←compl_mul, (Pᶜ.prop.commute (Q⊓R).prop).eq, coe_inf, mul_assoc, distrib_lattice_lemma, + (Q.prop.commute R.prop).eq, distrib_lattice_lemma], + rw [le_def, e₁, coe_inf, e₂], + end, + .. is_Lprojection.subtype.has_inf, + .. is_Lprojection.subtype.has_sup, + .. is_Lprojection.subtype.partial_order } + +instance [has_faithful_smul M X] : boolean_algebra {P : M // is_Lprojection X P} := +{ inf_compl_le_bot := λ P, + (subtype.ext (by rw [coe_inf, coe_compl, coe_bot, ← coe_compl, mul_compl_self])).le, + top_le_sup_compl := λ P, (subtype.ext(by rw [coe_top, coe_sup, coe_compl, + add_sub_cancel'_right, ← coe_compl, mul_compl_self, sub_zero])).le, + sdiff_eq := λ P Q, subtype.ext $ by rw [coe_sdiff, ← coe_compl, coe_inf], + .. is_Lprojection.subtype.has_compl, + .. is_Lprojection.subtype.has_sdiff, + .. is_Lprojection.subtype.bounded_order, + .. is_Lprojection.subtype.distrib_lattice } + +end is_Lprojection diff --git a/src/analysis/normed_space/add_torsor.lean b/src/analysis/normed_space/add_torsor.lean index 340c15bbe84f4..21887171303ef 100644 --- a/src/analysis/normed_space/add_torsor.lean +++ b/src/analysis/normed_space/add_torsor.lean @@ -5,22 +5,25 @@ Authors: Joseph Myers, Yury Kudryashov -/ import analysis.normed_space.basic import analysis.normed.group.add_torsor -import linear_algebra.affine_space.midpoint +import linear_algebra.affine_space.midpoint_zero import linear_algebra.affine_space.affine_subspace import topology.instances.real_vector_space /-! # Torsors of normed space actions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas about normed additive torsors over normed spaces. -/ noncomputable theory -open_locale nnreal topological_space +open_locale nnreal topology open filter -variables {α V P : Type*} [semi_normed_group V] [pseudo_metric_space P] [normed_add_torsor V P] -variables {W Q : Type*} [normed_group W] [metric_space Q] [normed_add_torsor W Q] +variables {α V P W Q : Type*} [seminormed_add_comm_group V] [pseudo_metric_space P] + [normed_add_torsor V P] [normed_add_comm_group W] [metric_space Q] [normed_add_torsor W Q] section normed_space @@ -32,7 +35,7 @@ lemma affine_subspace.is_closed_direction_iff (s : affine_subspace 𝕜 Q) : is_closed (s.direction : set W) ↔ is_closed (s : set Q) := begin rcases s.eq_bot_or_nonempty with rfl|⟨x, hx⟩, { simp [is_closed_singleton] }, - rw [← (isometric.vadd_const x).to_homeomorph.symm.is_closed_image, + rw [← (isometry_equiv.vadd_const x).to_homeomorph.symm.is_closed_image, affine_subspace.coe_direction_eq_vsub_set_right hx], refl end @@ -40,13 +43,21 @@ end include V @[simp] lemma dist_center_homothety (p₁ p₂ : P) (c : 𝕜) : - dist p₁ (homothety p₁ c p₂) = ∥c∥ * dist p₁ p₂ := + dist p₁ (homothety p₁ c p₂) = ‖c‖ * dist p₁ p₂ := by simp [homothety_def, norm_smul, ← dist_eq_norm_vsub, dist_comm] +@[simp] lemma nndist_center_homothety (p₁ p₂ : P) (c : 𝕜) : + nndist p₁ (homothety p₁ c p₂) = ‖c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_center_homothety _ _ _ + @[simp] lemma dist_homothety_center (p₁ p₂ : P) (c : 𝕜) : - dist (homothety p₁ c p₂) p₁ = ∥c∥ * dist p₁ p₂ := + dist (homothety p₁ c p₂) p₁ = ‖c‖ * dist p₁ p₂ := by rw [dist_comm, dist_center_homothety] +@[simp] lemma nndist_homothety_center (p₁ p₂ : P) (c : 𝕜) : + nndist (homothety p₁ c p₂) p₁ = ‖c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_homothety_center _ _ _ + @[simp] lemma dist_line_map_line_map (p₁ p₂ : P) (c₁ c₂ : 𝕜) : dist (line_map p₁ p₂ c₁) (line_map p₁ p₂ c₂) = dist c₁ c₂ * dist p₁ p₂ := begin @@ -55,57 +66,101 @@ begin vsub_eq_sub], end +@[simp] lemma nndist_line_map_line_map (p₁ p₂ : P) (c₁ c₂ : 𝕜) : + nndist (line_map p₁ p₂ c₁) (line_map p₁ p₂ c₂) = nndist c₁ c₂ * nndist p₁ p₂ := +nnreal.eq $ dist_line_map_line_map _ _ _ _ + lemma lipschitz_with_line_map (p₁ p₂ : P) : lipschitz_with (nndist p₁ p₂) (line_map p₁ p₂ : 𝕜 → P) := lipschitz_with.of_dist_le_mul $ λ c₁ c₂, ((dist_line_map_line_map p₁ p₂ c₁ c₂).trans (mul_comm _ _)).le @[simp] lemma dist_line_map_left (p₁ p₂ : P) (c : 𝕜) : - dist (line_map p₁ p₂ c) p₁ = ∥c∥ * dist p₁ p₂ := + dist (line_map p₁ p₂ c) p₁ = ‖c‖ * dist p₁ p₂ := by simpa only [line_map_apply_zero, dist_zero_right] using dist_line_map_line_map p₁ p₂ c 0 +@[simp] lemma nndist_line_map_left (p₁ p₂ : P) (c : 𝕜) : + nndist (line_map p₁ p₂ c) p₁ = ‖c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_line_map_left _ _ _ + @[simp] lemma dist_left_line_map (p₁ p₂ : P) (c : 𝕜) : - dist p₁ (line_map p₁ p₂ c) = ∥c∥ * dist p₁ p₂ := + dist p₁ (line_map p₁ p₂ c) = ‖c‖ * dist p₁ p₂ := (dist_comm _ _).trans (dist_line_map_left _ _ _) +@[simp] lemma nndist_left_line_map (p₁ p₂ : P) (c : 𝕜) : + nndist p₁ (line_map p₁ p₂ c) = ‖c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_left_line_map _ _ _ + @[simp] lemma dist_line_map_right (p₁ p₂ : P) (c : 𝕜) : - dist (line_map p₁ p₂ c) p₂ = ∥1 - c∥ * dist p₁ p₂ := + dist (line_map p₁ p₂ c) p₂ = ‖1 - c‖ * dist p₁ p₂ := by simpa only [line_map_apply_one, dist_eq_norm'] using dist_line_map_line_map p₁ p₂ c 1 +@[simp] lemma nndist_line_map_right (p₁ p₂ : P) (c : 𝕜) : + nndist (line_map p₁ p₂ c) p₂ = ‖1 - c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_line_map_right _ _ _ + @[simp] lemma dist_right_line_map (p₁ p₂ : P) (c : 𝕜) : - dist p₂ (line_map p₁ p₂ c) = ∥1 - c∥ * dist p₁ p₂ := + dist p₂ (line_map p₁ p₂ c) = ‖1 - c‖ * dist p₁ p₂ := (dist_comm _ _).trans (dist_line_map_right _ _ _) +@[simp] lemma nndist_right_line_map (p₁ p₂ : P) (c : 𝕜) : + nndist p₂ (line_map p₁ p₂ c) = ‖1 - c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_right_line_map _ _ _ + @[simp] lemma dist_homothety_self (p₁ p₂ : P) (c : 𝕜) : - dist (homothety p₁ c p₂) p₂ = ∥1 - c∥ * dist p₁ p₂ := + dist (homothety p₁ c p₂) p₂ = ‖1 - c‖ * dist p₁ p₂ := by rw [homothety_eq_line_map, dist_line_map_right] +@[simp] lemma nndist_homothety_self (p₁ p₂ : P) (c : 𝕜) : + nndist (homothety p₁ c p₂) p₂ = ‖1 - c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_homothety_self _ _ _ + @[simp] lemma dist_self_homothety (p₁ p₂ : P) (c : 𝕜) : - dist p₂ (homothety p₁ c p₂) = ∥1 - c∥ * dist p₁ p₂ := + dist p₂ (homothety p₁ c p₂) = ‖1 - c‖ * dist p₁ p₂ := by rw [dist_comm, dist_homothety_self] +@[simp] lemma nndist_self_homothety (p₁ p₂ : P) (c : 𝕜) : + nndist p₂ (homothety p₁ c p₂) = ‖1 - c‖₊ * nndist p₁ p₂ := +nnreal.eq $ dist_self_homothety _ _ _ + section invertible_two variables [invertible (2:𝕜)] @[simp] lemma dist_left_midpoint (p₁ p₂ : P) : - dist p₁ (midpoint 𝕜 p₁ p₂) = ∥(2:𝕜)∥⁻¹ * dist p₁ p₂ := + dist p₁ (midpoint 𝕜 p₁ p₂) = ‖(2:𝕜)‖⁻¹ * dist p₁ p₂ := by rw [midpoint, dist_comm, dist_line_map_left, inv_of_eq_inv, ← norm_inv] +@[simp] lemma nndist_left_midpoint (p₁ p₂ : P) : + nndist p₁ (midpoint 𝕜 p₁ p₂) = ‖(2:𝕜)‖₊⁻¹ * nndist p₁ p₂ := +nnreal.eq $ dist_left_midpoint _ _ + @[simp] lemma dist_midpoint_left (p₁ p₂ : P) : - dist (midpoint 𝕜 p₁ p₂) p₁ = ∥(2:𝕜)∥⁻¹ * dist p₁ p₂ := + dist (midpoint 𝕜 p₁ p₂) p₁ = ‖(2:𝕜)‖⁻¹ * dist p₁ p₂ := by rw [dist_comm, dist_left_midpoint] +@[simp] lemma nndist_midpoint_left (p₁ p₂ : P) : + nndist (midpoint 𝕜 p₁ p₂) p₁ = ‖(2:𝕜)‖₊⁻¹ * nndist p₁ p₂ := +nnreal.eq $ dist_midpoint_left _ _ + @[simp] lemma dist_midpoint_right (p₁ p₂ : P) : - dist (midpoint 𝕜 p₁ p₂) p₂ = ∥(2:𝕜)∥⁻¹ * dist p₁ p₂ := + dist (midpoint 𝕜 p₁ p₂) p₂ = ‖(2:𝕜)‖⁻¹ * dist p₁ p₂ := by rw [midpoint_comm, dist_midpoint_left, dist_comm] +@[simp] lemma nndist_midpoint_right (p₁ p₂ : P) : + nndist (midpoint 𝕜 p₁ p₂) p₂ = ‖(2:𝕜)‖₊⁻¹ * nndist p₁ p₂ := +nnreal.eq $ dist_midpoint_right _ _ + @[simp] lemma dist_right_midpoint (p₁ p₂ : P) : - dist p₂ (midpoint 𝕜 p₁ p₂) = ∥(2:𝕜)∥⁻¹ * dist p₁ p₂ := + dist p₂ (midpoint 𝕜 p₁ p₂) = ‖(2:𝕜)‖⁻¹ * dist p₁ p₂ := by rw [dist_comm, dist_midpoint_right] +@[simp] lemma nndist_right_midpoint (p₁ p₂ : P) : + nndist p₂ (midpoint 𝕜 p₁ p₂) = ‖(2:𝕜)‖₊⁻¹ * nndist p₁ p₂ := +nnreal.eq $ dist_right_midpoint _ _ + lemma dist_midpoint_midpoint_le' (p₁ p₂ p₃ p₄ : P) : - dist (midpoint 𝕜 p₁ p₂) (midpoint 𝕜 p₃ p₄) ≤ (dist p₁ p₃ + dist p₂ p₄) / ∥(2 : 𝕜)∥ := + dist (midpoint 𝕜 p₁ p₂) (midpoint 𝕜 p₃ p₄) ≤ (dist p₁ p₃ + dist p₂ p₄) / ‖(2 : 𝕜)‖ := begin rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, midpoint_vsub_midpoint]; try { apply_instance }, @@ -113,6 +168,10 @@ begin exact div_le_div_of_le_of_nonneg (norm_add_le _ _) (norm_nonneg _), end +lemma nndist_midpoint_midpoint_le' (p₁ p₂ p₃ p₄ : P) : + nndist (midpoint 𝕜 p₁ p₂) (midpoint 𝕜 p₃ p₄) ≤ (nndist p₁ p₃ + nndist p₂ p₄) / ‖(2 : 𝕜)‖₊ := +dist_midpoint_midpoint_le' _ _ _ _ + end invertible_two omit V @@ -128,12 +187,12 @@ variables (𝕜) lemma eventually_homothety_mem_of_mem_interior (x : Q) {s : set Q} {y : Q} (hy : y ∈ interior s) : ∀ᶠ δ in 𝓝 (1 : 𝕜), homothety x δ y ∈ s := begin - rw (normed_group.nhds_basis_norm_lt (1 : 𝕜)).eventually_iff, + rw (normed_add_comm_group.nhds_basis_norm_lt (1 : 𝕜)).eventually_iff, cases eq_or_ne y x with h h, { use 1, simp [h.symm, interior_subset hy], }, - have hxy : 0 < ∥y -ᵥ x∥, { rwa [norm_pos_iff, vsub_ne_zero], }, + have hxy : 0 < ‖y -ᵥ x‖, { rwa [norm_pos_iff, vsub_ne_zero], }, obtain ⟨u, hu₁, hu₂, hu₃⟩ := mem_interior.mp hy, obtain ⟨ε, hε, hyε⟩ := metric.is_open_iff.mp hu₂ y hu₃, - refine ⟨ε / ∥y -ᵥ x∥, div_pos hε hxy, λ δ (hδ : ∥δ - 1∥ < ε / ∥y -ᵥ x∥), hu₁ (hyε _)⟩, + refine ⟨ε / ‖y -ᵥ x‖, div_pos hε hxy, λ δ (hδ : ‖δ - 1‖ < ε / ‖y -ᵥ x‖), hu₁ (hyε _)⟩, rw [lt_div_iff hxy, ← norm_smul, sub_smul, one_smul] at hδ, rwa [homothety_apply, metric.mem_ball, dist_eq_norm_vsub W, vadd_vsub_eq_sub_vsub], end @@ -157,6 +216,10 @@ lemma dist_midpoint_midpoint_le (p₁ p₂ p₃ p₄ : V) : dist (midpoint ℝ p₁ p₂) (midpoint ℝ p₃ p₄) ≤ (dist p₁ p₃ + dist p₂ p₄) / 2 := by simpa using dist_midpoint_midpoint_le' p₁ p₂ p₃ p₄ +lemma nndist_midpoint_midpoint_le (p₁ p₂ p₃ p₄ : V) : + nndist (midpoint ℝ p₁ p₂) (midpoint ℝ p₃ p₄) ≤ (nndist p₁ p₃ + nndist p₂ p₄) / 2 := +dist_midpoint_midpoint_le _ _ _ _ + include V W /-- A continuous map between two normed affine spaces is an affine map provided that diff --git a/src/analysis/normed_space/add_torsor_bases.lean b/src/analysis/normed_space/add_torsor_bases.lean index c8a8e98bf05aa..5e162d8f02c82 100644 --- a/src/analysis/normed_space/add_torsor_bases.lean +++ b/src/analysis/normed_space/add_torsor_bases.lean @@ -3,44 +3,47 @@ Copyright (c) 2021 Oliver Nash. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Oliver Nash -/ -import analysis.normed_space.banach import analysis.normed_space.finite_dimension import analysis.calculus.affine_map import analysis.convex.combination -import linear_algebra.affine_space.basis import linear_algebra.affine_space.finite_dimensional /-! # Bases in normed affine spaces. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains results about bases in normed affine spaces. ## Main definitions: * `continuous_barycentric_coord` * `is_open_map_barycentric_coord` - * `interior_convex_hull_aff_basis` + * `affine_basis.interior_convex_hull` * `exists_subset_affine_independent_span_eq_top_of_open` - * `interior_convex_hull_nonempty_iff_aff_span_eq_top` + * `interior_convex_hull_nonempty_iff_affine_span_eq_top` -/ section barycentric -variables {ι 𝕜 E P : Type*} [nondiscrete_normed_field 𝕜] [complete_space 𝕜] -variables [normed_group E] [normed_space 𝕜 E] [finite_dimensional 𝕜 E] +variables {ι 𝕜 E P : Type*} [nontrivially_normed_field 𝕜] [complete_space 𝕜] +variables [normed_add_comm_group E] [normed_space 𝕜 E] variables [metric_space P] [normed_add_torsor E P] -variables (b : affine_basis ι 𝕜 P) + +include E + +lemma is_open_map_barycentric_coord [nontrivial ι] (b : affine_basis ι 𝕜 P) (i : ι) : + is_open_map (b.coord i) := +affine_map.is_open_map_linear_iff.mp $ (b.coord i).linear.is_open_map_of_finite_dimensional $ + (b.coord i).linear_surjective_iff.mpr (b.surjective_coord i) + +variables [finite_dimensional 𝕜 E] (b : affine_basis ι 𝕜 P) @[continuity] lemma continuous_barycentric_coord (i : ι) : continuous (b.coord i) := (b.coord i).continuous_of_finite_dimensional -local attribute [instance] finite_dimensional.complete - -lemma is_open_map_barycentric_coord [nontrivial ι] (i : ι) : - is_open_map (b.coord i) := -(b.coord i).is_open_map (continuous_barycentric_coord b i) (b.surjective_coord i) - lemma smooth_barycentric_coord (b : affine_basis ι 𝕜 E) (i : ι) : cont_diff 𝕜 ⊤ (b.coord i) := (⟨b.coord i, continuous_barycentric_coord b i⟩ : E →A[𝕜] 𝕜).cont_diff @@ -54,108 +57,104 @@ to this basis. TODO Restate this result for affine spaces (instead of vector spaces) once the definition of convexity is generalised to this setting. -/ -lemma interior_convex_hull_aff_basis {ι E : Type*} [fintype ι] [normed_group E] [normed_space ℝ E] - (b : affine_basis ι ℝ E) : - interior (convex_hull ℝ (range b.points)) = { x | ∀ i, 0 < b.coord i x } := +lemma affine_basis.interior_convex_hull {ι E : Type*} [finite ι] [normed_add_comm_group E] + [normed_space ℝ E] (b : affine_basis ι ℝ E) : + interior (convex_hull ℝ (range b)) = {x | ∀ i, 0 < b.coord i x} := begin - cases subsingleton_or_nontrivial ι with h h, + casesI subsingleton_or_nontrivial ι, { -- The zero-dimensional case. - haveI := h, - suffices : range (b.points) = univ, { simp [this], }, - refine affine_subspace.eq_univ_of_subsingleton_span_eq_top _ b.tot, - rw ← image_univ, - exact subsingleton.image subsingleton_of_subsingleton b.points, }, + have : range b = univ, + from affine_subspace.eq_univ_of_subsingleton_span_eq_top (subsingleton_range _) b.tot, + simp [this] }, { -- The positive-dimensional case. - haveI : finite_dimensional ℝ E, - { classical, - obtain ⟨i⟩ := (infer_instance : nonempty ι), - exact finite_dimensional.of_fintype_basis (b.basis_of i), }, - have : convex_hull ℝ (range b.points) = ⋂ i, (b.coord i)⁻¹' Ici 0, - { rw convex_hull_affine_basis_eq_nonneg_barycentric b, ext, simp, }, + haveI : finite_dimensional ℝ E := b.finite_dimensional, + have : convex_hull ℝ (range b) = ⋂ i, (b.coord i)⁻¹' Ici 0, + { rw [b.convex_hull_eq_nonneg_coord, set_of_forall], refl }, ext, - simp only [this, interior_Inter_of_fintype, ← is_open_map.preimage_interior_eq_interior_preimage + simp only [this, interior_Inter, ← is_open_map.preimage_interior_eq_interior_preimage (is_open_map_barycentric_coord b _) (continuous_barycentric_coord b _), interior_Ici, mem_Inter, mem_set_of_eq, mem_Ioi, mem_preimage], }, end -variables {V P : Type*} [normed_group V] [normed_space ℝ V] [metric_space P] [normed_add_torsor V P] +variables {V P : Type*} [normed_add_comm_group V] [normed_space ℝ V] [metric_space P] + [normed_add_torsor V P] include V open affine_map /-- Given a set `s` of affine-independent points belonging to an open set `u`, we may extend `s` to an affine basis, all of whose elements belong to `u`. -/ -lemma exists_subset_affine_independent_span_eq_top_of_open {s u : set P} (hu : is_open u) +lemma is_open.exists_between_affine_independent_span_eq_top {s u : set P} (hu : is_open u) (hsu : s ⊆ u) (hne : s.nonempty) (h : affine_independent ℝ (coe : s → P)) : ∃ t : set P, s ⊆ t ∧ t ⊆ u ∧ affine_independent ℝ (coe : t → P) ∧ affine_span ℝ t = ⊤ := begin obtain ⟨q, hq⟩ := hne, - obtain ⟨ε, hε, hεu⟩ := metric.is_open_iff.mp hu q (hsu hq), + obtain ⟨ε, ε0, hεu⟩ := metric.nhds_basis_closed_ball.mem_iff.1 (hu.mem_nhds $ hsu hq), obtain ⟨t, ht₁, ht₂, ht₃⟩ := exists_subset_affine_independent_affine_span_eq_top h, - let f : P → P := λ y, line_map q y (ε / 2 / (dist y q)), + let f : P → P := λ y, line_map q y (ε / dist y q), have hf : ∀ y, f y ∈ u, - { intros y, - apply hεu, - simp only [metric.mem_ball, f, line_map_apply, dist_vadd_left, norm_smul, real.norm_eq_abs, - dist_eq_norm_vsub V y q], - cases eq_or_ne (∥y -ᵥ q∥) 0 with hyq hyq, { rwa [hyq, mul_zero], }, - rw [← norm_pos_iff, norm_norm] at hyq, - calc abs (ε / 2 / ∥y -ᵥ q∥) * ∥y -ᵥ q∥ - = ε / 2 / ∥y -ᵥ q∥ * ∥y -ᵥ q∥ : by rw [abs_div, abs_of_pos (half_pos hε), abs_of_pos hyq] - ... = ε / 2 : div_mul_cancel _ (ne_of_gt hyq) - ... < ε : half_lt_self hε, }, - have hεyq : ∀ (y ∉ s), ε / 2 / dist y q ≠ 0, - { simp only [ne.def, div_eq_zero_iff, or_false, dist_eq_zero, bit0_eq_zero, one_ne_zero, - not_or_distrib, ne_of_gt hε, true_and, not_false_iff], - exact λ y h1 h2, h1 (h2.symm ▸ hq) }, + { refine λ y, hεu _, + simp only [f], + rw [metric.mem_closed_ball, line_map_apply, dist_vadd_left, norm_smul, real.norm_eq_abs, + dist_eq_norm_vsub V y q, abs_div, abs_of_pos ε0, abs_of_nonneg (norm_nonneg _), div_mul_comm], + exact mul_le_of_le_one_left ε0.le (div_self_le_one _) }, + have hεyq : ∀ y ∉ s, ε / dist y q ≠ 0, + from λ y hy, div_ne_zero ε0.ne' (dist_ne_zero.2 (ne_of_mem_of_not_mem hq hy).symm), classical, let w : t → ℝˣ := λ p, if hp : (p : P) ∈ s then 1 else units.mk0 _ (hεyq ↑p hp), refine ⟨set.range (λ (p : t), line_map q p (w p : ℝ)), _, _, _, _⟩, { intros p hp, use ⟨p, ht₁ hp⟩, simp [w, hp], }, - { intros y hy, - simp only [set.mem_range, set_coe.exists, subtype.coe_mk] at hy, - obtain ⟨p, hp, hyq⟩ := hy, - by_cases hps : p ∈ s; - simp only [w, hps, line_map_apply_one, units.coe_mk0, dif_neg, dif_pos, not_false_iff, - units.coe_one, subtype.coe_mk] at hyq; - rw ← hyq; - [exact hsu hps, exact hf p], }, + { rintros y ⟨⟨p, hp⟩, rfl⟩, + by_cases hps : p ∈ s; simp only [w, hps, line_map_apply_one, units.coe_mk0, dif_neg, dif_pos, + not_false_iff, units.coe_one, subtype.coe_mk]; + [exact hsu hps, exact hf p], }, { exact (ht₂.units_line_map ⟨q, ht₁ hq⟩ w).range, }, { rw [affine_span_eq_affine_span_line_map_units (ht₁ hq) w, ht₃], }, end -lemma interior_convex_hull_nonempty_iff_aff_span_eq_top [finite_dimensional ℝ V] {s : set V} : +lemma is_open.exists_subset_affine_independent_span_eq_top {u : set P} (hu : is_open u) + (hne : u.nonempty) : + ∃ s ⊆ u, affine_independent ℝ (coe : s → P) ∧ affine_span ℝ s = ⊤ := +begin + rcases hne with ⟨x, hx⟩, + rcases hu.exists_between_affine_independent_span_eq_top (singleton_subset_iff.mpr hx) + (singleton_nonempty _) (affine_independent_of_subsingleton _ _) with ⟨s, -, hsu, hs⟩, + exact ⟨s, hsu, hs⟩ +end + +/-- The affine span of a nonempty open set is `⊤`. -/ +lemma is_open.affine_span_eq_top {u : set P} (hu : is_open u) (hne : u.nonempty) : + affine_span ℝ u = ⊤ := +let ⟨s, hsu, hs, hs'⟩ := hu.exists_subset_affine_independent_span_eq_top hne +in top_unique $ hs' ▸ affine_span_mono _ hsu + +lemma affine_span_eq_top_of_nonempty_interior {s : set V} + (hs : (interior $ convex_hull ℝ s).nonempty) : + affine_span ℝ s = ⊤ := +top_unique $ is_open_interior.affine_span_eq_top hs ▸ + (affine_span_mono _ interior_subset).trans_eq (affine_span_convex_hull _) + +lemma affine_basis.centroid_mem_interior_convex_hull {ι} [fintype ι] (b : affine_basis ι ℝ V) : + finset.univ.centroid ℝ b ∈ interior (convex_hull ℝ (range b)) := +begin + haveI := b.nonempty, + simp only [b.interior_convex_hull, mem_set_of_eq, b.coord_apply_centroid (finset.mem_univ _), + inv_pos, nat.cast_pos, finset.card_pos, finset.univ_nonempty, forall_true_iff] +end + +lemma interior_convex_hull_nonempty_iff_affine_span_eq_top [finite_dimensional ℝ V] {s : set V} : (interior (convex_hull ℝ s)).nonempty ↔ affine_span ℝ s = ⊤ := begin - split, - { rintros ⟨x, hx⟩, - obtain ⟨u, hu₁, hu₂, hu₃⟩ := mem_interior.mp hx, - let t : set V := {x}, - obtain ⟨b, hb₁, hb₂, hb₃, hb₄⟩ := exists_subset_affine_independent_span_eq_top_of_open hu₂ - (singleton_subset_iff.mpr hu₃) (singleton_nonempty x) - (affine_independent_of_subsingleton ℝ (coe : t → V)), - rw [eq_top_iff, ← hb₄, ← affine_span_convex_hull s], - mono, - exact hb₂.trans hu₁, }, - { intros h, - obtain ⟨t, hts, h_tot, h_ind⟩ := exists_affine_independent ℝ V s, - suffices : (interior (convex_hull ℝ (range (coe : t → V)))).nonempty, - { rw [subtype.range_coe_subtype, set_of_mem_eq] at this, - apply nonempty.mono _ this, - mono* }, - haveI : fintype t := fintype_of_fin_dim_affine_independent ℝ h_ind, - use finset.centroid ℝ (finset.univ : finset t) (coe : t → V), - rw [h, ← @set_of_mem_eq V t, ← subtype.range_coe_subtype] at h_tot, - let b : affine_basis t ℝ V := ⟨coe, h_ind, h_tot⟩, - rw interior_convex_hull_aff_basis b, - have htne : (finset.univ : finset t).nonempty, - { simpa [finset.univ_nonempty_iff] using - affine_subspace.nonempty_of_affine_span_eq_top ℝ V V h_tot, }, - simp [finset.centroid_def, b.coord_apply_combination_of_mem (finset.mem_univ _) - (finset.sum_centroid_weights_eq_one_of_nonempty ℝ (finset.univ : finset t) htne), - finset.centroid_weights_apply, nat.cast_pos, inv_pos, finset.card_pos.mpr htne], }, + refine ⟨affine_span_eq_top_of_nonempty_interior, λ h, _⟩, + obtain ⟨t, hts, b, hb⟩ := affine_basis.exists_affine_subbasis h, + suffices : (interior (convex_hull ℝ (range b))).nonempty, + { rw [hb, subtype.range_coe_subtype, set_of_mem_eq] at this, + refine this.mono _, + mono* }, + lift t to finset V using b.finite_set, + exact ⟨_, b.centroid_mem_interior_convex_hull⟩ end lemma convex.interior_nonempty_iff_affine_span_eq_top [finite_dimensional ℝ V] {s : set V} (hs : convex ℝ s) : (interior s).nonempty ↔ affine_span ℝ s = ⊤ := -by rw [← interior_convex_hull_nonempty_iff_aff_span_eq_top, hs.convex_hull_eq] +by rw [← interior_convex_hull_nonempty_iff_affine_span_eq_top, hs.convex_hull_eq] diff --git a/src/analysis/normed_space/affine_isometry.lean b/src/analysis/normed_space/affine_isometry.lean index 859a7d258b3b7..5e6869ea196f4 100644 --- a/src/analysis/normed_space/affine_isometry.lean +++ b/src/analysis/normed_space/affine_isometry.lean @@ -3,12 +3,18 @@ Copyright (c) 2021 Heather Macbeth. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Heather Macbeth -/ -import analysis.normed_space.add_torsor import analysis.normed_space.linear_isometry +import analysis.normed.group.add_torsor +import analysis.normed_space.basic +import linear_algebra.affine_space.restrict +import algebra.char_p.invertible /-! # Affine isometries +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `affine_isometry 𝕜 P P₂` to be an affine isometric embedding of normed add-torsors `P` into `P₂` over normed `𝕜`-spaces and `affine_isometry_equiv` to be an affine isometric equivalence between `P` and `P₂`. @@ -16,8 +22,8 @@ isometric equivalence between `P` and `P₂`. We also prove basic lemmas and provide convenience constructors. The choice of these lemmas and constructors is closely modelled on those for the `linear_isometry` and `affine_map` theories. -Since many elementary properties don't require `∥x∥ = 0 → x = 0` we initially set up the theory for -`semi_normed_group` and specialize to `normed_group` only when needed. +Since many elementary properties don't require `‖x‖ = 0 → x = 0` we initially set up the theory for +`seminormed_add_comm_group` and specialize to `normed_add_comm_group` only when needed. ## Notation @@ -31,9 +37,9 @@ algebra-homomorphisms.) open function set variables (𝕜 : Type*) {V V₁ V₂ V₃ V₄ : Type*} {P₁ : Type*} (P P₂ : Type*) {P₃ P₄ : Type*} - [normed_field 𝕜] - [semi_normed_group V] [semi_normed_group V₁] [semi_normed_group V₂] [semi_normed_group V₃] - [semi_normed_group V₄] + [normed_field 𝕜] [seminormed_add_comm_group V] [seminormed_add_comm_group V₁] + [seminormed_add_comm_group V₂] [seminormed_add_comm_group V₃] + [seminormed_add_comm_group V₄] [normed_space 𝕜 V] [normed_space 𝕜 V₁] [normed_space 𝕜 V₂] [normed_space 𝕜 V₃] [normed_space 𝕜 V₄] [pseudo_metric_space P] [metric_space P₁] [pseudo_metric_space P₂] [pseudo_metric_space P₃] @@ -46,7 +52,7 @@ include V V₂ /-- An `𝕜`-affine isometric embedding of one normed add-torsor over a normed `𝕜`-space into another. -/ structure affine_isometry extends P →ᵃ[𝕜] P₂ := -(norm_map : ∀ x : V, ∥linear x∥ = ∥x∥) +(norm_map : ∀ x : V, ‖linear x‖ = ‖x‖) omit V V₂ variables {𝕜 P P₂} @@ -197,16 +203,38 @@ instance : monoid (P →ᵃⁱ[𝕜] P) := end affine_isometry --- remark: by analogy with the `linear_isometry` file from which this is adapted, there should --- follow here a section defining an "inclusion" affine isometry from `p : affine_subspace 𝕜 P` --- into `P`; we omit this for now +namespace affine_subspace + +include V + +/-- `affine_subspace.subtype` as an `affine_isometry`. -/ +def subtypeₐᵢ (s : affine_subspace 𝕜 P) [nonempty s] : s →ᵃⁱ[𝕜] P := +{ norm_map := s.direction.subtypeₗᵢ.norm_map, + .. s.subtype } + +lemma subtypeₐᵢ_linear (s : affine_subspace 𝕜 P) [nonempty s] : + s.subtypeₐᵢ.linear = s.direction.subtype := +rfl + +@[simp] lemma subtypeₐᵢ_linear_isometry (s : affine_subspace 𝕜 P) [nonempty s] : + s.subtypeₐᵢ.linear_isometry = s.direction.subtypeₗᵢ := +rfl + +@[simp] lemma coe_subtypeₐᵢ (s : affine_subspace 𝕜 P) [nonempty s] : ⇑s.subtypeₐᵢ = s.subtype := +rfl + +@[simp] lemma subtypeₐᵢ_to_affine_map (s : affine_subspace 𝕜 P) [nonempty s] : + s.subtypeₐᵢ.to_affine_map = s.subtype := +rfl + +end affine_subspace variables (𝕜 P P₂) include V V₂ /-- A affine isometric equivalence between two normed vector spaces. -/ structure affine_isometry_equiv extends P ≃ᵃ[𝕜] P₂ := -(norm_map : ∀ x, ∥linear x∥ = ∥x∥) +(norm_map : ∀ x, ‖linear x‖ = ‖x‖) variables {𝕜 P P₂} omit V V₂ @@ -229,7 +257,7 @@ by { ext, refl } include V V₂ instance : has_coe_to_fun (P ≃ᵃⁱ[𝕜] P₂) (λ _, P → P₂) := ⟨λ f, f.to_fun⟩ -@[simp] lemma coe_mk (e : P ≃ᵃ[𝕜] P₂) (he : ∀ x, ∥e.linear x∥ = ∥x∥) : +@[simp] lemma coe_mk (e : P ≃ᵃ[𝕜] P₂) (he : ∀ x, ‖e.linear x‖ = ‖x‖) : ⇑(mk e he) = e := rfl @@ -293,18 +321,18 @@ variables (e : P ≃ᵃⁱ[𝕜] P₂) protected lemma isometry : isometry e := e.to_affine_isometry.isometry -/-- Reinterpret a `affine_isometry_equiv` as an `isometric`. -/ -def to_isometric : P ≃ᵢ P₂ := ⟨e.to_affine_equiv.to_equiv, e.isometry⟩ +/-- Reinterpret a `affine_isometry_equiv` as an `isometry_equiv`. -/ +def to_isometry_equiv : P ≃ᵢ P₂ := ⟨e.to_affine_equiv.to_equiv, e.isometry⟩ -@[simp] lemma coe_to_isometric : ⇑e.to_isometric = e := rfl +@[simp] lemma coe_to_isometry_equiv : ⇑e.to_isometry_equiv = e := rfl include V V₂ lemma range_eq_univ (e : P ≃ᵃⁱ[𝕜] P₂) : set.range e = set.univ := -by { rw ← coe_to_isometric, exact isometric.range_eq_univ _, } +by { rw ← coe_to_isometry_equiv, exact isometry_equiv.range_eq_univ _, } omit V V₂ /-- Reinterpret a `affine_isometry_equiv` as an `homeomorph`. -/ -def to_homeomorph : P ≃ₜ P₂ := e.to_isometric.to_homeomorph +def to_homeomorph : P ≃ₜ P₂ := e.to_isometry_equiv.to_homeomorph @[simp] lemma coe_to_homeomorph : ⇑e.to_homeomorph = e := rfl @@ -327,7 +355,7 @@ instance : inhabited (P ≃ᵃⁱ[𝕜] P) := ⟨refl 𝕜 P⟩ @[simp] lemma coe_refl : ⇑(refl 𝕜 P) = id := rfl @[simp] lemma to_affine_equiv_refl : (refl 𝕜 P).to_affine_equiv = affine_equiv.refl 𝕜 P := rfl -@[simp] lemma to_isometric_refl : (refl 𝕜 P).to_isometric = isometric.refl P := rfl +@[simp] lemma to_isometry_equiv_refl : (refl 𝕜 P).to_isometry_equiv = isometry_equiv.refl P := rfl @[simp] lemma to_homeomorph_refl : (refl 𝕜 P).to_homeomorph = homeomorph.refl P := rfl omit V @@ -341,7 +369,7 @@ def symm : P₂ ≃ᵃⁱ[𝕜] P := @[simp] lemma symm_symm : e.symm.symm = e := ext $ λ x, rfl @[simp] lemma to_affine_equiv_symm : e.to_affine_equiv.symm = e.symm.to_affine_equiv := rfl -@[simp] lemma to_isometric_symm : e.to_isometric.symm = e.symm.to_isometric := rfl +@[simp] lemma to_isometry_equiv_symm : e.to_isometry_equiv.symm = e.symm.to_isometry_equiv := rfl @[simp] lemma to_homeomorph_symm : e.to_homeomorph.symm = e.symm.to_homeomorph := rfl include V₃ @@ -508,11 +536,11 @@ to_affine_equiv_injective $ affine_equiv.point_reflection_symm 𝕜 x by rw [← (point_reflection 𝕜 x).dist_map y x, point_reflection_self] lemma dist_point_reflection_self' (x y : P) : - dist (point_reflection 𝕜 x y) y = ∥bit0 (x -ᵥ y)∥ := + dist (point_reflection 𝕜 x y) y = ‖bit0 (x -ᵥ y)‖ := by rw [point_reflection_apply, dist_eq_norm_vsub V, vadd_vsub_assoc, bit0] lemma dist_point_reflection_self (x y : P) : - dist (point_reflection 𝕜 x y) y = ∥(2:𝕜)∥ * dist x y := + dist (point_reflection 𝕜 x y) y = ‖(2:𝕜)‖ * dist x y := by rw [dist_point_reflection_self', ← two_smul' 𝕜 (x -ᵥ y), norm_smul, ← dist_eq_norm_vsub V] lemma point_reflection_fixed_iff [invertible (2:𝕜)] {x y : P} : @@ -564,3 +592,54 @@ begin rw this, simp only [homeomorph.comp_is_open_map_iff, homeomorph.comp_is_open_map_iff'], end + +local attribute [instance, nolint fails_quickly] affine_subspace.nonempty_map + +include V₁ +omit V + +namespace affine_subspace + +/-- +An affine subspace is isomorphic to its image under an injective affine map. +This is the affine version of `submodule.equiv_map_of_injective`. +-/ +@[simps] +noncomputable def equiv_map_of_injective (E: affine_subspace 𝕜 P₁) [nonempty E] + (φ : P₁ →ᵃ[𝕜] P₂) (hφ : function.injective φ) : E ≃ᵃ[𝕜] E.map φ := +{ linear := + (E.direction.equiv_map_of_injective φ.linear (φ.linear_injective_iff.mpr hφ)).trans + (linear_equiv.of_eq _ _ (affine_subspace.map_direction _ _).symm), + map_vadd' := λ p v, subtype.ext $ φ.map_vadd p v, + .. equiv.set.image _ (E : set P₁) hφ } + +/-- +Restricts an affine isometry to an affine isometry equivalence between a nonempty affine +subspace `E` and its image. + +This is an isometry version of `affine_subspace.equiv_map`, having a stronger premise and a stronger +conclusion. +-/ +noncomputable def isometry_equiv_map + (φ : P₁ →ᵃⁱ[𝕜] P₂) (E : affine_subspace 𝕜 P₁) [nonempty E] : E ≃ᵃⁱ[𝕜] E.map φ.to_affine_map := +⟨E.equiv_map_of_injective φ.to_affine_map φ.injective, (λ _, φ.norm_map _)⟩ + +@[simp] +lemma isometry_equiv_map.apply_symm_apply + {E : affine_subspace 𝕜 P₁} [nonempty E] + {φ : P₁ →ᵃⁱ[𝕜] P₂} (x : E.map φ.to_affine_map) : + φ ((E.isometry_equiv_map φ).symm x) = x := +congr_arg coe $ (E.isometry_equiv_map φ).apply_symm_apply _ + +@[simp] +lemma isometry_equiv_map.coe_apply + (φ : P₁ →ᵃⁱ[𝕜] P₂) (E : affine_subspace 𝕜 P₁) [nonempty E] (g: E) : + ↑(E.isometry_equiv_map φ g) = φ g := rfl + +@[simp] +lemma isometry_equiv_map.to_affine_map_eq + (φ : P₁ →ᵃⁱ[𝕜] P₂) (E : affine_subspace 𝕜 P₁) [nonempty E] : + (E.isometry_equiv_map φ).to_affine_map = E.equiv_map_of_injective φ.to_affine_map φ.injective := +rfl + +end affine_subspace diff --git a/src/analysis/normed_space/algebra.lean b/src/analysis/normed_space/algebra.lean new file mode 100644 index 0000000000000..b3ae7a3ec2ba8 --- /dev/null +++ b/src/analysis/normed_space/algebra.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2022 Frédéric Dupuis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Frédéric Dupuis +-/ + +import topology.algebra.module.character_space +import analysis.normed_space.weak_dual +import analysis.normed_space.spectrum + +/-! +# Normed algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains basic facts about normed algebras. + +## Main results + +* We show that the character space of a normed algebra is compact using the Banach-Alaoglu theorem. + +## TODO + +* Show compactness for topological vector spaces; this requires the TVS version of Banach-Alaoglu. + +## Tags + +normed algebra, character space, continuous functional calculus + +-/ + +variables {𝕜 : Type*} {A : Type*} + +namespace weak_dual +namespace character_space + +variables [nontrivially_normed_field 𝕜] [normed_ring A] + [normed_algebra 𝕜 A] [complete_space A] + +lemma norm_le_norm_one (φ : character_space 𝕜 A) : + ‖to_normed_dual (φ : weak_dual 𝕜 A)‖ ≤ ‖(1 : A)‖ := +continuous_linear_map.op_norm_le_bound _ (norm_nonneg (1 : A)) $ + λ a, mul_comm (‖a‖) (‖(1 : A)‖) ▸ spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum φ a) + +instance [proper_space 𝕜] : compact_space (character_space 𝕜 A) := +begin + rw [←is_compact_iff_compact_space], + have h : character_space 𝕜 A ⊆ to_normed_dual ⁻¹' metric.closed_ball 0 (‖(1 : A)‖), + { intros φ hφ, + rw [set.mem_preimage, mem_closed_ball_zero_iff], + exact (norm_le_norm_one ⟨φ, ⟨hφ.1, hφ.2⟩⟩ : _), }, + exact is_compact_of_is_closed_subset (is_compact_closed_ball 𝕜 0 _) character_space.is_closed h, +end + +end character_space +end weak_dual diff --git a/src/analysis/normed_space/ball_action.lean b/src/analysis/normed_space/ball_action.lean new file mode 100644 index 0000000000000..99295ec561d81 --- /dev/null +++ b/src/analysis/normed_space/ball_action.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Heather Macbeth +-/ +import analysis.normed.field.unit_ball +import analysis.normed_space.basic + +/-! +# Multiplicative actions of/on balls and spheres + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `E` be a normed vector space over a normed field `𝕜`. In this file we define the following +multiplicative actions. + +- The closed unit ball in `𝕜` acts on open balls and closed balls centered at `0` in `E`. +- The unit sphere in `𝕜` acts on open balls, closed balls, and spheres centered at `0` in `E`. +-/ +open metric set +variables {𝕜 𝕜' E : Type*} [normed_field 𝕜] [normed_field 𝕜'] + [seminormed_add_comm_group E] [normed_space 𝕜 E] [normed_space 𝕜' E] {r : ℝ} + +section closed_ball + +instance mul_action_closed_ball_ball : mul_action (closed_ball (0 : 𝕜) 1) (ball (0 : E) r) := +{ smul := λ c x, ⟨(c : 𝕜) • x, mem_ball_zero_iff.2 $ + by simpa only [norm_smul, one_mul] + using mul_lt_mul' (mem_closed_ball_zero_iff.1 c.2) (mem_ball_zero_iff.1 x.2) + (norm_nonneg _) one_pos⟩, + one_smul := λ x, subtype.ext $ one_smul 𝕜 _, + mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ } + +instance has_continuous_smul_closed_ball_ball : + has_continuous_smul (closed_ball (0 : 𝕜) 1) (ball (0 : E) r) := +⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩ + +instance mul_action_closed_ball_closed_ball : + mul_action (closed_ball (0 : 𝕜) 1) (closed_ball (0 : E) r) := +{ smul := λ c x, ⟨(c : 𝕜) • x, mem_closed_ball_zero_iff.2 $ + by simpa only [norm_smul, one_mul] + using mul_le_mul (mem_closed_ball_zero_iff.1 c.2) (mem_closed_ball_zero_iff.1 x.2) + (norm_nonneg _) zero_le_one⟩, + one_smul := λ x, subtype.ext $ one_smul 𝕜 _, + mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ } + +instance has_continuous_smul_closed_ball_closed_ball : + has_continuous_smul (closed_ball (0 : 𝕜) 1) (closed_ball (0 : E) r) := +⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩ + +end closed_ball + +section sphere + +instance mul_action_sphere_ball : mul_action (sphere (0 : 𝕜) 1) (ball (0 : E) r) := +{ smul := λ c x, inclusion sphere_subset_closed_ball c • x, + one_smul := λ x, subtype.ext $ one_smul _ _, + mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ } + +instance has_continuous_smul_sphere_ball : + has_continuous_smul (sphere (0 : 𝕜) 1) (ball (0 : E) r) := +⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩ + +instance mul_action_sphere_closed_ball : mul_action (sphere (0 : 𝕜) 1) (closed_ball (0 : E) r) := +{ smul := λ c x, inclusion sphere_subset_closed_ball c • x, + one_smul := λ x, subtype.ext $ one_smul _ _, + mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ } + +instance has_continuous_smul_sphere_closed_ball : + has_continuous_smul (sphere (0 : 𝕜) 1) (closed_ball (0 : E) r) := +⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩ + +instance mul_action_sphere_sphere : mul_action (sphere (0 : 𝕜) 1) (sphere (0 : E) r) := +{ smul := λ c x, ⟨(c : 𝕜) • x, mem_sphere_zero_iff_norm.2 $ + by rw [norm_smul, mem_sphere_zero_iff_norm.1 c.coe_prop, mem_sphere_zero_iff_norm.1 x.coe_prop, + one_mul]⟩, + one_smul := λ x, subtype.ext $ one_smul _ _, + mul_smul := λ c₁ c₂ x, subtype.ext $ mul_smul _ _ _ } + +instance has_continuous_smul_sphere_sphere : + has_continuous_smul (sphere (0 : 𝕜) 1) (sphere (0 : E) r) := +⟨(continuous_subtype_val.fst'.smul continuous_subtype_val.snd').subtype_mk _⟩ + +end sphere + +section is_scalar_tower + +variables [normed_algebra 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' E] + +instance is_scalar_tower_closed_ball_closed_ball_closed_ball : + is_scalar_tower (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_closed_ball_closed_ball_ball : + is_scalar_tower (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_sphere_closed_ball_closed_ball : + is_scalar_tower (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_sphere_closed_ball_ball : + is_scalar_tower (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_sphere_sphere_closed_ball : + is_scalar_tower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (closed_ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_sphere_sphere_ball : + is_scalar_tower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_sphere_sphere_sphere : + is_scalar_tower (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (sphere (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance is_scalar_tower_sphere_ball_ball : + is_scalar_tower (sphere (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩ + +instance is_scalar_tower_closed_ball_ball_ball : + is_scalar_tower (closed_ball (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) := +⟨λ a b c, subtype.ext $ smul_assoc (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩ + +end is_scalar_tower + +section smul_comm_class + +variables [smul_comm_class 𝕜 𝕜' E] + +instance smul_comm_class_closed_ball_closed_ball_closed_ball : + smul_comm_class (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance smul_comm_class_closed_ball_closed_ball_ball : + smul_comm_class (closed_ball (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance smul_comm_class_sphere_closed_ball_closed_ball : + smul_comm_class (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (closed_ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance smul_comm_class_sphere_closed_ball_ball : + smul_comm_class (sphere (0 : 𝕜) 1) (closed_ball (0 : 𝕜') 1) (ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance smul_comm_class_sphere_ball_ball [normed_algebra 𝕜 𝕜'] : + smul_comm_class (sphere (0 : 𝕜) 1) (ball (0 : 𝕜') 1) (ball (0 : 𝕜') 1) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : 𝕜')⟩ + +instance smul_comm_class_sphere_sphere_closed_ball : + smul_comm_class (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (closed_ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance smul_comm_class_sphere_sphere_ball : + smul_comm_class (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (ball (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +instance smul_comm_class_sphere_sphere_sphere : + smul_comm_class (sphere (0 : 𝕜) 1) (sphere (0 : 𝕜') 1) (sphere (0 : E) r) := +⟨λ a b c, subtype.ext $ smul_comm (a : 𝕜) (b : 𝕜') (c : E)⟩ + +end smul_comm_class + +variables (𝕜) [char_zero 𝕜] + +lemma ne_neg_of_mem_sphere {r : ℝ} (hr : r ≠ 0) (x : sphere (0:E) r) : x ≠ - x := +λ h, ne_zero_of_mem_sphere hr x ((self_eq_neg 𝕜 _).mp (by { conv_lhs {rw h}, simp })) + +lemma ne_neg_of_mem_unit_sphere (x : sphere (0:E) 1) : x ≠ - x := +ne_neg_of_mem_sphere 𝕜 one_ne_zero x diff --git a/src/analysis/normed_space/banach.lean b/src/analysis/normed_space/banach.lean index 8a1592f87469c..e3aa13499386f 100644 --- a/src/analysis/normed_space/banach.lean +++ b/src/analysis/normed_space/banach.lean @@ -10,29 +10,32 @@ import analysis.normed_space.affine_isometry /-! # Banach open mapping theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the Banach open mapping theorem, i.e., the fact that a bijective bounded linear map between Banach spaces has a bounded inverse. -/ -open function metric set filter finset -open_locale classical topological_space big_operators nnreal +open function metric set filter finset linear_map (range ker) +open_locale classical topology big_operators nnreal -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -{E : Type*} [normed_group E] [normed_space 𝕜 E] -{F : Type*} [normed_group F] [normed_space 𝕜 F] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] (f : E →L[𝕜] F) include 𝕜 namespace continuous_linear_map /-- A (possibly nonlinear) right inverse to a continuous linear map, which doesn't have to be -linear itself but which satisfies a bound `∥inverse x∥ ≤ C * ∥x∥`. A surjective continuous linear +linear itself but which satisfies a bound `‖inverse x‖ ≤ C * ‖x‖`. A surjective continuous linear map doesn't always have a continuous linear right inverse, but it always has a nonlinear inverse in this sense, by Banach's open mapping theorem. -/ structure nonlinear_right_inverse := (to_fun : F → E) (nnnorm : ℝ≥0) -(bound' : ∀ y, ∥to_fun y∥ ≤ nnnorm * ∥y∥) +(bound' : ∀ y, ‖to_fun y‖ ≤ nnnorm * ‖y‖) (right_inv' : ∀ y, f (to_fun y) = y) instance : has_coe_to_fun (nonlinear_right_inverse f) (λ _, F → E) := ⟨λ fsymm, fsymm.to_fun⟩ @@ -42,7 +45,7 @@ instance : has_coe_to_fun (nonlinear_right_inverse f) (λ _, F → E) := ⟨λ f fsymm.right_inv' y lemma nonlinear_right_inverse.bound {f : E →L[𝕜] F} (fsymm : nonlinear_right_inverse f) (y : F) : - ∥fsymm y∥ ≤ fsymm.nnnorm * ∥y∥ := + ‖fsymm y‖ ≤ fsymm.nnnorm * ‖y‖ := fsymm.bound' y end continuous_linear_map @@ -52,7 +55,7 @@ end continuous_linear_map noncomputable def continuous_linear_equiv.to_nonlinear_right_inverse (f : E ≃L[𝕜] F) : continuous_linear_map.nonlinear_right_inverse (f : E →L[𝕜] F) := { to_fun := f.inv_fun, - nnnorm := ∥(f.symm : F →L[𝕜] E)∥₊, + nnnorm := ‖(f.symm : F →L[𝕜] E)‖₊, bound' := λ y, continuous_linear_map.le_op_norm (f.symm : F →L[𝕜] E) _, right_inv' := f.apply_symm_apply } @@ -69,16 +72,16 @@ namespace continuous_linear_map First step of the proof of the Banach open mapping theorem (using completeness of `F`): by Baire's theorem, there exists a ball in `E` whose image closure has nonempty interior. Rescaling everything, it follows that any `y ∈ F` is arbitrarily well approached by -images of elements of norm at most `C * ∥y∥`. +images of elements of norm at most `C * ‖y‖`. For further use, we will only need such an element whose image -is within distance `∥y∥/2` of `y`, to apply an iterative process. -/ +is within distance `‖y‖/2` of `y`, to apply an iterative process. -/ lemma exists_approx_preimage_norm_le (surj : surjective f) : - ∃C ≥ 0, ∀y, ∃x, dist (f x) y ≤ 1/2 * ∥y∥ ∧ ∥x∥ ≤ C * ∥y∥ := + ∃C ≥ 0, ∀y, ∃x, dist (f x) y ≤ 1/2 * ‖y‖ ∧ ‖x‖ ≤ C * ‖y‖ := begin have A : (⋃n:ℕ, closure (f '' (ball 0 n))) = univ, { refine subset.antisymm (subset_univ _) (λy hy, _), rcases surj y with ⟨x, hx⟩, - rcases exists_nat_gt (∥x∥) with ⟨n, hn⟩, + rcases exists_nat_gt (‖x‖) with ⟨n, hn⟩, refine mem_Union.2 ⟨n, subset_closure _⟩, refine (mem_image _ _ _).2 ⟨x, ⟨_, hx⟩⟩, rwa [mem_ball, dist_eq_norm, sub_zero] }, @@ -87,13 +90,13 @@ begin simp only [mem_interior_iff_mem_nhds, metric.mem_nhds_iff] at this, rcases this with ⟨n, a, ε, ⟨εpos, H⟩⟩, rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, - refine ⟨(ε/2)⁻¹ * ∥c∥ * 2 * n, _, λy, _⟩, + refine ⟨(ε/2)⁻¹ * ‖c‖ * 2 * n, _, λy, _⟩, { refine mul_nonneg (mul_nonneg (mul_nonneg _ (norm_nonneg _)) (by norm_num)) _, exacts [inv_nonneg.2 (div_nonneg (le_of_lt εpos) (by norm_num)), n.cast_nonneg] }, { by_cases hy : y = 0, { use 0, simp [hy] }, { rcases rescale_to_shell hc (half_pos εpos) hy with ⟨d, hd, ydlt, leyd, dinv⟩, - let δ := ∥d∥ * ∥y∥/4, + let δ := ‖d‖ * ‖y‖/4, have δpos : 0 < δ := div_pos (mul_pos (norm_pos_iff.2 hd) (norm_pos_iff.2 hy)) (by norm_num), have : a + d • y ∈ ball a ε, @@ -108,10 +111,10 @@ begin rw ← xz₂ at h₂, rw [mem_ball, dist_eq_norm, sub_zero] at hx₂, let x := x₁ - x₂, - have I : ∥f x - d • y∥ ≤ 2 * δ := calc - ∥f x - d • y∥ = ∥f x₁ - (a + d • y) - (f x₂ - a)∥ : + have I : ‖f x - d • y‖ ≤ 2 * δ := calc + ‖f x - d • y‖ = ‖f x₁ - (a + d • y) - (f x₂ - a)‖ : by { congr' 1, simp only [x, f.map_sub], abel } - ... ≤ ∥f x₁ - (a + d • y)∥ + ∥f x₂ - a∥ : + ... ≤ ‖f x₁ - (a + d • y)‖ + ‖f x₂ - a‖ : norm_sub_le _ _ ... ≤ δ + δ : begin apply add_le_add, @@ -119,29 +122,29 @@ begin { rw [← dist_eq_norm, dist_comm], exact le_of_lt h₂ } end ... = 2 * δ : (two_mul _).symm, - have J : ∥f (d⁻¹ • x) - y∥ ≤ 1/2 * ∥y∥ := calc - ∥f (d⁻¹ • x) - y∥ = ∥d⁻¹ • f x - (d⁻¹ * d) • y∥ : + have J : ‖f (d⁻¹ • x) - y‖ ≤ 1/2 * ‖y‖ := calc + ‖f (d⁻¹ • x) - y‖ = ‖d⁻¹ • f x - (d⁻¹ * d) • y‖ : by rwa [f.map_smul _, inv_mul_cancel, one_smul] - ... = ∥d⁻¹ • (f x - d • y)∥ : by rw [mul_smul, smul_sub] - ... = ∥d∥⁻¹ * ∥f x - d • y∥ : by rw [norm_smul, norm_inv] - ... ≤ ∥d∥⁻¹ * (2 * δ) : begin + ... = ‖d⁻¹ • (f x - d • y)‖ : by rw [mul_smul, smul_sub] + ... = ‖d‖⁻¹ * ‖f x - d • y‖ : by rw [norm_smul, norm_inv] + ... ≤ ‖d‖⁻¹ * (2 * δ) : begin apply mul_le_mul_of_nonneg_left I, rw inv_nonneg, exact norm_nonneg _ end - ... = (∥d∥⁻¹ * ∥d∥) * ∥y∥ /2 : by { simp only [δ], ring } - ... = ∥y∥/2 : by { rw [inv_mul_cancel, one_mul], simp [norm_eq_zero, hd] } - ... = (1/2) * ∥y∥ : by ring, + ... = (‖d‖⁻¹ * ‖d‖) * ‖y‖ /2 : by { simp only [δ], ring } + ... = ‖y‖/2 : by { rw [inv_mul_cancel, one_mul], simp [norm_eq_zero, hd] } + ... = (1/2) * ‖y‖ : by ring, rw ← dist_eq_norm at J, - have K : ∥d⁻¹ • x∥ ≤ (ε / 2)⁻¹ * ∥c∥ * 2 * ↑n * ∥y∥ := calc - ∥d⁻¹ • x∥ = ∥d∥⁻¹ * ∥x₁ - x₂∥ : by rw [norm_smul, norm_inv] - ... ≤ ((ε / 2)⁻¹ * ∥c∥ * ∥y∥) * (n + n) : begin + have K : ‖d⁻¹ • x‖ ≤ (ε / 2)⁻¹ * ‖c‖ * 2 * ↑n * ‖y‖ := calc + ‖d⁻¹ • x‖ = ‖d‖⁻¹ * ‖x₁ - x₂‖ : by rw [norm_smul, norm_inv] + ... ≤ ((ε / 2)⁻¹ * ‖c‖ * ‖y‖) * (n + n) : begin refine mul_le_mul dinv _ (norm_nonneg _) _, { exact le_trans (norm_sub_le _ _) (add_le_add (le_of_lt hx₁) (le_of_lt hx₂)) }, { apply mul_nonneg (mul_nonneg _ (norm_nonneg _)) (norm_nonneg _), exact inv_nonneg.2 (le_of_lt (half_pos εpos)) } end - ... = (ε / 2)⁻¹ * ∥c∥ * 2 * ↑n * ∥y∥ : by ring, + ... = (ε / 2)⁻¹ * ‖c‖ * 2 * ↑n * ‖y‖ : by ring, exact ⟨d⁻¹ • x, J, K⟩ } }, end @@ -150,7 +153,7 @@ variable [complete_space E] /-- The Banach open mapping theorem: if a bounded linear map between Banach spaces is onto, then any point has a preimage with controlled norm. -/ theorem exists_preimage_norm_le (surj : surjective f) : - ∃C > 0, ∀y, ∃x, f x = y ∧ ∥x∥ ≤ C * ∥y∥ := + ∃C > 0, ∀y, ∃x, f x = y ∧ ‖x‖ ≤ C * ‖y‖ := begin obtain ⟨C, C0, hC⟩ := exists_approx_preimage_norm_le f surj, /- Second step of the proof: starting from `y`, we want an exact preimage of `y`. Let `g y` be @@ -161,12 +164,12 @@ begin preimage of `y`. This uses completeness of `E`. -/ choose g hg using hC, let h := λy, y - f (g y), - have hle : ∀y, ∥h y∥ ≤ (1/2) * ∥y∥, + have hle : ∀y, ‖h y‖ ≤ (1/2) * ‖y‖, { assume y, rw [← dist_eq_norm, dist_comm], exact (hg y).1 }, refine ⟨2 * C + 1, by linarith, λy, _⟩, - have hnle : ∀n:ℕ, ∥(h^[n]) y∥ ≤ (1/2)^n * ∥y∥, + have hnle : ∀n:ℕ, ‖(h^[n]) y‖ ≤ (1/2)^n * ‖y‖, { assume n, induction n with n IH, { simp only [one_div, nat.nat_zero_eq_zero, one_mul, iterate_zero_apply, @@ -177,24 +180,24 @@ begin apply mul_le_mul_of_nonneg_left IH, norm_num } }, let u := λn, g((h^[n]) y), - have ule : ∀n, ∥u n∥ ≤ (1/2)^n * (C * ∥y∥), + have ule : ∀n, ‖u n‖ ≤ (1/2)^n * (C * ‖y‖), { assume n, apply le_trans (hg _).2 _, - calc C * ∥(h^[n]) y∥ ≤ C * ((1/2)^n * ∥y∥) : mul_le_mul_of_nonneg_left (hnle n) C0 - ... = (1 / 2) ^ n * (C * ∥y∥) : by ring }, - have sNu : summable (λn, ∥u n∥), + calc C * ‖(h^[n]) y‖ ≤ C * ((1/2)^n * ‖y‖) : mul_le_mul_of_nonneg_left (hnle n) C0 + ... = (1 / 2) ^ n * (C * ‖y‖) : by ring }, + have sNu : summable (λn, ‖u n‖), { refine summable_of_nonneg_of_le (λn, norm_nonneg _) ule _, exact summable.mul_right _ (summable_geometric_of_lt_1 (by norm_num) (by norm_num)) }, have su : summable u := summable_of_summable_norm sNu, let x := tsum u, - have x_ineq : ∥x∥ ≤ (2 * C + 1) * ∥y∥ := calc - ∥x∥ ≤ ∑'n, ∥u n∥ : norm_tsum_le_tsum_norm sNu - ... ≤ ∑'n, (1/2)^n * (C * ∥y∥) : + have x_ineq : ‖x‖ ≤ (2 * C + 1) * ‖y‖ := calc + ‖x‖ ≤ ∑'n, ‖u n‖ : norm_tsum_le_tsum_norm sNu + ... ≤ ∑'n, (1/2)^n * (C * ‖y‖) : tsum_le_tsum ule sNu (summable.mul_right _ summable_geometric_two) - ... = (∑'n, (1/2)^n) * (C * ∥y∥) : tsum_mul_right - ... = 2 * C * ∥y∥ : by rw [tsum_geometric_two, mul_assoc] - ... ≤ 2 * C * ∥y∥ + ∥y∥ : le_add_of_nonneg_right (norm_nonneg y) - ... = (2 * C + 1) * ∥y∥ : by ring, + ... = (∑'n, (1/2)^n) * (C * ‖y‖) : tsum_mul_right + ... = 2 * C * ‖y‖ : by rw [tsum_geometric_two, mul_assoc] + ... ≤ 2 * C * ‖y‖ + ‖y‖ : le_add_of_nonneg_right (norm_nonneg y) + ... = (2 * C + 1) * ‖y‖ : by ring, have fsumeq : ∀n:ℕ, f (∑ i in finset.range n, u i) = y - (h^[n]) y, { assume n, induction n with n IH, @@ -210,7 +213,7 @@ begin rw tendsto_iff_norm_tendsto_zero, simp only [sub_zero], refine squeeze_zero (λ_, norm_nonneg _) hnle _, - rw [← zero_mul ∥y∥], + rw [← zero_mul ‖y‖], refine (tendsto_pow_at_top_nhds_0_of_lt_1 _ _).mul tendsto_const_nhds; norm_num }, have feq : f x = y - 0 := tendsto_nhds_unique L₁ L₂, rw sub_zero at feq, @@ -231,8 +234,8 @@ begin have : f (x + w) = z, by { rw [f.map_add, wim, fxy, add_sub_cancel'_right] }, rw ← this, have : x + w ∈ ball x ε := calc - dist (x+w) x = ∥w∥ : by { rw dist_eq_norm, simp } - ... ≤ C * ∥z - y∥ : wnorm + dist (x+w) x = ‖w‖ : by { rw dist_eq_norm, simp } + ... ≤ C * ‖z - y‖ : wnorm ... < C * (ε/C) : begin apply mul_lt_mul_of_pos_left _ Cpos, rwa [mem_ball, dist_eq_norm] at hz, @@ -250,7 +253,7 @@ lemma _root_.affine_map.is_open_map {P Q : Type*} is_open_map f := affine_map.is_open_map_linear_iff.mp $ continuous_linear_map.is_open_map { cont := affine_map.continuous_linear_iff.mpr hf, .. f.linear } - (f.surjective_iff_linear_surjective.mpr surj) + (f.linear_surjective_iff.mpr surj) /-! ### Applications of the Banach open mapping theorem -/ @@ -266,8 +269,8 @@ lemma frontier_preimage (hsurj : surjective f) (s : set F) : frontier (f ⁻¹' s) = f ⁻¹' (frontier s) := ((f.is_open_map hsurj).preimage_frontier_eq_frontier_preimage f.continuous s).symm -lemma exists_nonlinear_right_inverse_of_surjective (f : E →L[𝕜] F) (hsurj : f.range = ⊤) : - ∃ (fsymm : nonlinear_right_inverse f), 0 < fsymm.nnnorm := +lemma exists_nonlinear_right_inverse_of_surjective (f : E →L[𝕜] F) + (hsurj : linear_map.range f = ⊤) : ∃ (fsymm : nonlinear_right_inverse f), 0 < fsymm.nnnorm := begin choose C hC fsymm h using exists_preimage_norm_le _ (linear_map.range_eq_top.mp hsurj), use { to_fun := fsymm, @@ -282,11 +285,11 @@ controlled right inverse. In general, it is not possible to ensure that such a r is linear (take for instance the map from `E` to `E/F` where `F` is a closed subspace of `E` without a closed complement. Then it doesn't have a continuous linear right inverse.) -/ @[irreducible] noncomputable def nonlinear_right_inverse_of_surjective - (f : E →L[𝕜] F) (hsurj : f.range = ⊤) : nonlinear_right_inverse f := + (f : E →L[𝕜] F) (hsurj : linear_map.range f = ⊤) : nonlinear_right_inverse f := classical.some (exists_nonlinear_right_inverse_of_surjective f hsurj) -lemma nonlinear_right_inverse_of_surjective_nnnorm_pos (f : E →L[𝕜] F) (hsurj : f.range = ⊤) : - 0 < (nonlinear_right_inverse_of_surjective f hsurj).nnnorm := +lemma nonlinear_right_inverse_of_surjective_nnnorm_pos (f : E →L[𝕜] F) + (hsurj : linear_map.range f = ⊤) : 0 < (nonlinear_right_inverse_of_surjective f hsurj).nnnorm := begin rw nonlinear_right_inverse_of_surjective, exact classical.some_spec (exists_nonlinear_right_inverse_of_surjective f hsurj) @@ -334,24 +337,24 @@ variables [complete_space E] /-- Convert a bijective continuous linear map `f : E →L[𝕜] F` from a Banach space to a normed space to a continuous linear equivalence. -/ -noncomputable def of_bijective (f : E →L[𝕜] F) (hinj : f.ker = ⊥) (hsurj : f.range = ⊤) : - E ≃L[𝕜] F := -(linear_equiv.of_bijective ↑f (linear_map.ker_eq_bot.mp hinj) (linear_map.range_eq_top.mp hsurj)) +noncomputable def of_bijective (f : E →L[𝕜] F) (hinj : ker f = ⊥) + (hsurj : linear_map.range f = ⊤) : E ≃L[𝕜] F := +(linear_equiv.of_bijective ↑f ⟨linear_map.ker_eq_bot.mp hinj, linear_map.range_eq_top.mp hsurj⟩) .to_continuous_linear_equiv_of_continuous f.continuous -@[simp] lemma coe_fn_of_bijective (f : E →L[𝕜] F) (hinj : f.ker = ⊥) (hsurj : f.range = ⊤) : - ⇑(of_bijective f hinj hsurj) = f := rfl +@[simp] lemma coe_fn_of_bijective (f : E →L[𝕜] F) (hinj : ker f = ⊥) + (hsurj : linear_map.range f = ⊤) : ⇑(of_bijective f hinj hsurj) = f := rfl -lemma coe_of_bijective (f : E →L[𝕜] F) (hinj : f.ker = ⊥) (hsurj : f.range = ⊤) : +lemma coe_of_bijective (f : E →L[𝕜] F) (hinj : ker f = ⊥) (hsurj : linear_map.range f = ⊤) : ↑(of_bijective f hinj hsurj) = f := by { ext, refl } -@[simp] lemma of_bijective_symm_apply_apply (f : E →L[𝕜] F) (hinj : f.ker = ⊥) - (hsurj : f.range = ⊤) (x : E) : +@[simp] lemma of_bijective_symm_apply_apply (f : E →L[𝕜] F) (hinj : ker f = ⊥) + (hsurj : linear_map.range f = ⊤) (x : E) : (of_bijective f hinj hsurj).symm (f x) = x := (of_bijective f hinj hsurj).symm_apply_apply x -@[simp] lemma of_bijective_apply_symm_apply (f : E →L[𝕜] F) (hinj : f.ker = ⊥) - (hsurj : f.range = ⊤) (y : F) : +@[simp] lemma of_bijective_apply_symm_apply (f : E →L[𝕜] F) (hinj : ker f = ⊥) + (hsurj : linear_map.range f = ⊤) (y : F) : f ((of_bijective f hinj hsurj).symm y) = y := (of_bijective f hinj hsurj).apply_symm_apply y @@ -367,7 +370,7 @@ variables [complete_space E] This is `f.coprod G.subtypeL` as an `continuous_linear_equiv`. -/ noncomputable def coprod_subtypeL_equiv_of_is_compl (f : E →L[𝕜] F) {G : submodule 𝕜 F} - (h : is_compl f.range G) [complete_space G] (hker : f.ker = ⊥) : (E × G) ≃L[𝕜] F := + (h : is_compl (linear_map.range f) G) [complete_space G] (hker : ker f = ⊥) : (E × G) ≃L[𝕜] F := continuous_linear_equiv.of_bijective (f.coprod G.subtypeL) (begin rw ker_coprod_of_disjoint_range, @@ -379,18 +382,20 @@ continuous_linear_equiv.of_bijective (f.coprod G.subtypeL) lemma range_eq_map_coprod_subtypeL_equiv_of_is_compl (f : E →L[𝕜] F) {G : submodule 𝕜 F} - (h : is_compl f.range G) [complete_space G] (hker : f.ker = ⊥) : - f.range = ((⊤ : submodule 𝕜 E).prod (⊥ : submodule 𝕜 G)).map + (h : is_compl (linear_map.range f) G) [complete_space G] (hker : ker f = ⊥) : + linear_map.range f = ((⊤ : submodule 𝕜 E).prod (⊥ : submodule 𝕜 G)).map (f.coprod_subtypeL_equiv_of_is_compl h hker : E × G →ₗ[𝕜] F) := -by rw [coprod_subtypeL_equiv_of_is_compl, _root_.coe_coe, continuous_linear_equiv.coe_of_bijective, - coe_coprod, linear_map.coprod_map_prod, submodule.map_bot, sup_bot_eq, submodule.map_top, - range] +begin + rw [coprod_subtypeL_equiv_of_is_compl, _root_.coe_coe, continuous_linear_equiv.coe_of_bijective, + coe_coprod, linear_map.coprod_map_prod, submodule.map_bot, sup_bot_eq, submodule.map_top], + refl +end /- TODO: remove the assumption `f.ker = ⊥` in the next lemma, by using the map induced by `f` on `E / f.ker`, once we have quotient normed spaces. -/ lemma closed_complemented_range_of_is_compl_of_ker_eq_bot (f : E →L[𝕜] F) (G : submodule 𝕜 F) - (h : is_compl f.range G) (hG : is_closed (G : set F)) (hker : f.ker = ⊥) : - is_closed (f.range : set F) := + (h : is_compl (linear_map.range f) G) (hG : is_closed (G : set F)) (hker : ker f = ⊥) : + is_closed (linear_map.range f : set F) := begin haveI : complete_space G := hG.complete_space_coe, let g := coprod_subtypeL_equiv_of_is_compl f h hker, @@ -400,3 +405,76 @@ begin end end continuous_linear_map + +section closed_graph_thm + +variables [complete_space E] (g : E →ₗ[𝕜] F) + +/-- The **closed graph theorem** : a linear map between two Banach spaces whose graph is closed +is continuous. -/ +theorem linear_map.continuous_of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) : + continuous g := +begin + letI : complete_space g.graph := complete_space_coe_iff_is_complete.mpr hg.is_complete, + let φ₀ : E →ₗ[𝕜] E × F := linear_map.id.prod g, + have : function.left_inverse prod.fst φ₀ := λ x, rfl, + let φ : E ≃ₗ[𝕜] g.graph := + (linear_equiv.of_left_inverse this).trans + (linear_equiv.of_eq _ _ g.graph_eq_range_prod.symm), + let ψ : g.graph ≃L[𝕜] E := φ.symm.to_continuous_linear_equiv_of_continuous + continuous_subtype_coe.fst, + exact (continuous_subtype_coe.comp ψ.symm.continuous).snd +end + +/-- A useful form of the **closed graph theorem** : let `f` be a linear map between two Banach +spaces. To show that `f` is continuous, it suffices to show that for any convergent sequence +`uₙ ⟶ x`, if `f(uₙ) ⟶ y` then `y = f(x)`. -/ +theorem linear_map.continuous_of_seq_closed_graph + (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) : + continuous g := +begin + refine g.continuous_of_is_closed_graph (is_seq_closed.is_closed _), + rintros φ ⟨x, y⟩ hφg hφ, + refine hg (prod.fst ∘ φ) x y ((continuous_fst.tendsto _).comp hφ) _, + have : g ∘ prod.fst ∘ φ = prod.snd ∘ φ, + { ext n, + exact (hφg n).symm }, + rw this, + exact (continuous_snd.tendsto _).comp hφ +end + +variable {g} + +namespace continuous_linear_map + +/-- Upgrade a `linear_map` to a `continuous_linear_map` using the **closed graph theorem**. -/ +def of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) : + E →L[𝕜] F := +{ to_linear_map := g, + cont := g.continuous_of_is_closed_graph hg } + +@[simp] lemma coe_fn_of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) : + ⇑(continuous_linear_map.of_is_closed_graph hg) = g := rfl + +lemma coe_of_is_closed_graph (hg : is_closed (g.graph : set $ E × F)) : + ↑(continuous_linear_map.of_is_closed_graph hg) = g := by { ext, refl } + +/-- Upgrade a `linear_map` to a `continuous_linear_map` using a variation on the +**closed graph theorem**. -/ +def of_seq_closed_graph + (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) : + E →L[𝕜] F := +{ to_linear_map := g, + cont := g.continuous_of_seq_closed_graph hg } + +@[simp] lemma coe_fn_of_seq_closed_graph + (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) : + ⇑(continuous_linear_map.of_seq_closed_graph hg) = g := rfl + +lemma coe_of_seq_closed_graph + (hg : ∀ (u : ℕ → E) x y, tendsto u at_top (𝓝 x) → tendsto (g ∘ u) at_top (𝓝 y) → y = g x) : + ↑(continuous_linear_map.of_seq_closed_graph hg) = g := by { ext, refl } + +end continuous_linear_map + +end closed_graph_thm diff --git a/src/analysis/normed_space/banach_steinhaus.lean b/src/analysis/normed_space/banach_steinhaus.lean index 560c7f692aca9..c8d8c11946514 100644 --- a/src/analysis/normed_space/banach_steinhaus.lean +++ b/src/analysis/normed_space/banach_steinhaus.lean @@ -9,6 +9,9 @@ import topology.algebra.module.basic /-! # The Banach-Steinhaus theorem: Uniform Boundedness Principle +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Herein we prove the Banach-Steinhaus theorem: any collection of bounded linear maps from a Banach space into a normed space which is pointwise bounded is uniformly bounded. @@ -23,8 +26,8 @@ open set variables {E F 𝕜 𝕜₂ : Type*} -[semi_normed_group E] [semi_normed_group F] -[nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂] +[seminormed_add_comm_group E] [seminormed_add_comm_group F] +[nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] [normed_space 𝕜 E] [normed_space 𝕜₂ F] {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] @@ -33,11 +36,11 @@ variables If a family of continuous linear maps from a Banach space into a normed space is pointwise bounded, then the norms of these linear maps are uniformly bounded. -/ theorem banach_steinhaus {ι : Type*} [complete_space E] {g : ι → E →SL[σ₁₂] F} - (h : ∀ x, ∃ C, ∀ i, ∥g i x∥ ≤ C) : - ∃ C', ∀ i, ∥g i∥ ≤ C' := + (h : ∀ x, ∃ C, ∀ i, ‖g i x‖ ≤ C) : + ∃ C', ∀ i, ‖g i‖ ≤ C' := begin - /- sequence of subsets consisting of those `x : E` with norms `∥g i x∥` bounded by `n` -/ - let e : ℕ → set E := λ n, (⋂ i : ι, { x : E | ∥g i x∥ ≤ n }), + /- sequence of subsets consisting of those `x : E` with norms `‖g i x‖` bounded by `n` -/ + let e : ℕ → set E := λ n, (⋂ i : ι, { x : E | ‖g i x‖ ≤ n }), /- each of these sets is closed -/ have hc : ∀ n : ℕ, is_closed (e n), from λ i, is_closed_Inter (λ i, is_closed_le (continuous.norm (g i).cont) continuous_const), @@ -52,41 +55,41 @@ begin rcases metric.is_open_iff.mp is_open_interior x hx with ⟨ε, ε_pos, hε⟩, obtain ⟨k, hk⟩ := normed_field.exists_one_lt_norm 𝕜, /- show all elements in the ball have norm bounded by `m` after applying any `g i` -/ - have real_norm_le : ∀ z : E, z ∈ metric.ball x ε → ∀ i : ι, ∥g i z∥ ≤ m, + have real_norm_le : ∀ z : E, z ∈ metric.ball x ε → ∀ i : ι, ‖g i z‖ ≤ m, { intros z hz i, replace hz := mem_Inter.mp (interior_Inter_subset _ (hε hz)) i, apply interior_subset hz }, - have εk_pos : 0 < ε / ∥k∥ := div_pos ε_pos (zero_lt_one.trans hk), - refine ⟨(m + m : ℕ) / (ε / ∥k∥), λ i, continuous_linear_map.op_norm_le_of_shell ε_pos _ hk _⟩, + have εk_pos : 0 < ε / ‖k‖ := div_pos ε_pos (zero_lt_one.trans hk), + refine ⟨(m + m : ℕ) / (ε / ‖k‖), λ i, continuous_linear_map.op_norm_le_of_shell ε_pos _ hk _⟩, { exact div_nonneg (nat.cast_nonneg _) εk_pos.le }, intros y le_y y_lt, - calc ∥g i y∥ - = ∥g i (y + x) - g i x∥ : by rw [continuous_linear_map.map_add, add_sub_cancel] - ... ≤ ∥g i (y + x)∥ + ∥g i x∥ : norm_sub_le _ _ + calc ‖g i y‖ + = ‖g i (y + x) - g i x‖ : by rw [continuous_linear_map.map_add, add_sub_cancel] + ... ≤ ‖g i (y + x)‖ + ‖g i x‖ : norm_sub_le _ _ ... ≤ m + m : add_le_add (real_norm_le (y + x) (by rwa [add_comm, add_mem_ball_iff_norm]) i) (real_norm_le x (metric.mem_ball_self ε_pos) i) ... = (m + m : ℕ) : (m.cast_add m).symm - ... ≤ (m + m : ℕ) * (∥y∥ / (ε / ∥k∥)) + ... ≤ (m + m : ℕ) * (‖y‖ / (ε / ‖k‖)) : le_mul_of_one_le_right (nat.cast_nonneg _) ((one_le_div $ div_pos ε_pos (zero_lt_one.trans hk)).2 le_y) - ... = (m + m : ℕ) / (ε / ∥k∥) * ∥y∥ : (mul_comm_div' _ _ _).symm, + ... = (m + m : ℕ) / (ε / ‖k‖) * ‖y‖ : (mul_comm_div _ _ _).symm, end open_locale ennreal open ennreal -/-- This version of Banach-Steinhaus is stated in terms of suprema of `↑∥⬝∥₊ : ℝ≥0∞` +/-- This version of Banach-Steinhaus is stated in terms of suprema of `↑‖⬝‖₊ : ℝ≥0∞` for convenience. -/ theorem banach_steinhaus_supr_nnnorm {ι : Type*} [complete_space E] {g : ι → E →SL[σ₁₂] F} - (h : ∀ x, (⨆ i, ↑∥g i x∥₊) < ∞) : - (⨆ i, ↑∥g i∥₊) < ∞ := + (h : ∀ x, (⨆ i, ↑‖g i x‖₊) < ∞) : + (⨆ i, ↑‖g i‖₊) < ∞ := begin - have h' : ∀ x : E, ∃ C : ℝ, ∀ i : ι, ∥g i x∥ ≤ C, + have h' : ∀ x : E, ∃ C : ℝ, ∀ i : ι, ‖g i x‖ ≤ C, { intro x, rcases lt_iff_exists_coe.mp (h x) with ⟨p, hp₁, _⟩, refine ⟨p, (λ i, _)⟩, exact_mod_cast - calc (∥g i x∥₊ : ℝ≥0∞) ≤ ⨆ j, ∥g j x∥₊ : le_supr _ i + calc (‖g i x‖₊ : ℝ≥0∞) ≤ ⨆ j, ‖g j x‖₊ : le_supr _ i ... = p : hp₁ }, cases banach_steinhaus h' with C' hC', refine (supr_le $ λ i, _).trans_lt (@coe_lt_top C'.to_nnreal), @@ -94,7 +97,7 @@ begin exact coe_mono (real.to_nnreal_le_to_nnreal $ hC' i), end -open_locale topological_space +open_locale topology open filter /-- Given a *sequence* of continuous linear maps which converges pointwise and for which the @@ -109,21 +112,21 @@ def continuous_linear_map_of_tendsto [complete_space E] [t2_space F] cont := begin /- show that the maps are pointwise bounded and apply `banach_steinhaus`-/ - have h_point_bdd : ∀ x : E, ∃ C : ℝ, ∀ n : ℕ, ∥g n x∥ ≤ C, + have h_point_bdd : ∀ x : E, ∃ C : ℝ, ∀ n : ℕ, ‖g n x‖ ≤ C, { intro x, rcases cauchy_seq_bdd (tendsto_pi_nhds.mp h x).cauchy_seq with ⟨C, C_pos, hC⟩, - refine ⟨C + ∥g 0 x∥, (λ n, _)⟩, + refine ⟨C + ‖g 0 x‖, (λ n, _)⟩, simp_rw dist_eq_norm at hC, - calc ∥g n x∥ ≤ ∥g 0 x∥ + ∥g n x - g 0 x∥ : norm_le_insert' _ _ - ... ≤ C + ∥g 0 x∥ : by linarith [hC n 0] }, + calc ‖g n x‖ ≤ ‖g 0 x‖ + ‖g n x - g 0 x‖ : norm_le_insert' _ _ + ... ≤ C + ‖g 0 x‖ : by linarith [hC n 0] }, cases banach_steinhaus h_point_bdd with C' hC', /- show the uniform bound from `banach_steinhaus` is a norm bound of the limit map by allowing "an `ε` of room." -/ - refine linear_map.continuous_of_bound (linear_map_of_tendsto _ _ h) C' + refine add_monoid_hom_class.continuous_of_bound (linear_map_of_tendsto _ _ h) C' (λ x, le_of_forall_pos_lt_add (λ ε ε_pos, _)), cases metric.tendsto_at_top.mp (tendsto_pi_nhds.mp h x) ε ε_pos with n hn, - have lt_ε : ∥g n x - f x∥ < ε, by {rw ←dist_eq_norm, exact hn n (le_refl n)}, - calc ∥f x∥ ≤ ∥g n x∥ + ∥g n x - f x∥ : norm_le_insert _ _ - ... < ∥g n∥ * ∥x∥ + ε : by linarith [lt_ε, (g n).le_op_norm x] - ... ≤ C' * ∥x∥ + ε : by nlinarith [hC' n, norm_nonneg x], + have lt_ε : ‖g n x - f x‖ < ε, by {rw ←dist_eq_norm, exact hn n (le_refl n)}, + calc ‖f x‖ ≤ ‖g n x‖ + ‖g n x - f x‖ : norm_le_insert _ _ + ... < ‖g n‖ * ‖x‖ + ε : by linarith [lt_ε, (g n).le_op_norm x] + ... ≤ C' * ‖x‖ + ε : by nlinarith [hC' n, norm_nonneg x], end } diff --git a/src/analysis/normed_space/basic.lean b/src/analysis/normed_space/basic.lean index 89306fcaeb9f4..6b5da2ca732c5 100644 --- a/src/analysis/normed_space/basic.lean +++ b/src/analysis/normed_space/basic.lean @@ -3,25 +3,29 @@ Copyright (c) 2018 Patrick Massot. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Massot, Johannes Hölzl -/ -import analysis.normed.normed_field -import analysis.normed.group.infinite_sum -import data.matrix.basic -import topology.sequences +import algebra.algebra.pi +import algebra.algebra.restrict_scalars +import analysis.normed.field.basic +import analysis.normed.mul_action +import data.real.sqrt +import topology.algebra.module.basic /-! # Normed spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define (semi)normed spaces and algebras. We also prove some theorems about these definitions. -/ variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*} -noncomputable theory -open filter metric -open_locale topological_space big_operators nnreal ennreal uniformity pointwise +open filter metric function set +open_locale topology big_operators nnreal ennreal uniformity -section semi_normed_group +section seminormed_add_comm_group section prio set_option extends_priority 920 @@ -29,92 +33,77 @@ set_option extends_priority 920 -- to take precedence over `semiring.to_module` as this leads to instance paths with better -- unification properties. /-- A normed space over a normed field is a vector space endowed with a norm which satisfies the -equality `∥c • x∥ = ∥c∥ ∥x∥`. We require only `∥c • x∥ ≤ ∥c∥ ∥x∥` in the definition, then prove -`∥c • x∥ = ∥c∥ ∥x∥` in `norm_smul`. +equality `‖c • x‖ = ‖c‖ ‖x‖`. We require only `‖c • x‖ ≤ ‖c‖ ‖x‖` in the definition, then prove +`‖c • x‖ = ‖c‖ ‖x‖` in `norm_smul`. -Note that since this requires `semi_normed_group` and not `normed_group`, this typeclass can be -used for "semi normed spaces" too, just as `module` can be used for "semi modules". -/ -class normed_space (α : Type*) (β : Type*) [normed_field α] [semi_normed_group β] +Note that since this requires `seminormed_add_comm_group` and not `normed_add_comm_group`, this +typeclass can be used for "semi normed spaces" too, just as `module` can be used for +"semi modules". -/ +class normed_space (α : Type*) (β : Type*) [normed_field α] [seminormed_add_comm_group β] extends module α β := -(norm_smul_le : ∀ (a:α) (b:β), ∥a • b∥ ≤ ∥a∥ * ∥b∥) +(norm_smul_le : ∀ (a:α) (b:β), ‖a • b‖ ≤ ‖a‖ * ‖b‖) end prio -variables [normed_field α] [semi_normed_group β] +variables [normed_field α] [seminormed_add_comm_group β] @[priority 100] -- see Note [lower instance priority] instance normed_space.has_bounded_smul [normed_space α β] : has_bounded_smul α β := -{ dist_smul_pair' := λ x y₁ y₂, - by simpa [dist_eq_norm, smul_sub] using normed_space.norm_smul_le x (y₁ - y₂), - dist_pair_smul' := λ x₁ x₂ y, - by simpa [dist_eq_norm, sub_smul] using normed_space.norm_smul_le (x₁ - x₂) y } +has_bounded_smul.of_norm_smul_le normed_space.norm_smul_le + +-- Shortcut instance, as otherwise this will be found by `normed_space.to_module` and be +-- noncomputable. +instance : module ℝ ℝ := by apply_instance instance normed_field.to_normed_space : normed_space α α := -{ norm_smul_le := λ a b, le_of_eq (norm_mul a b) } +{ norm_smul_le := λ a b, norm_mul_le a b } -lemma norm_smul [normed_space α β] (s : α) (x : β) : ∥s • x∥ = ∥s∥ * ∥x∥ := -begin - by_cases h : s = 0, - { simp [h] }, - { refine le_antisymm (normed_space.norm_smul_le s x) _, - calc ∥s∥ * ∥x∥ = ∥s∥ * ∥s⁻¹ • s • x∥ : by rw [inv_smul_smul₀ h] - ... ≤ ∥s∥ * (∥s⁻¹∥ * ∥s • x∥) : - mul_le_mul_of_nonneg_left (normed_space.norm_smul_le _ _) (norm_nonneg _) - ... = ∥s • x∥ : - by rw [norm_inv, ← mul_assoc, mul_inv_cancel (mt norm_eq_zero.1 h), one_mul] } -end +-- shortcut instance +instance normed_field.to_has_bounded_smul : has_bounded_smul α α := +normed_space.has_bounded_smul -@[simp] lemma abs_norm_eq_norm (z : β) : |∥z∥| = ∥z∥ := - (abs_eq (norm_nonneg z)).mpr (or.inl rfl) +lemma norm_zsmul (α) [normed_field α] [normed_space α β] (n : ℤ) (x : β) : + ‖n • x‖ = ‖(n : α)‖ * ‖x‖ := +by rw [← norm_smul, ← int.smul_one_eq_coe, smul_assoc, one_smul] + +@[simp] lemma abs_norm (z : β) : |‖z‖| = ‖z‖ := +abs_of_nonneg $ norm_nonneg z lemma inv_norm_smul_mem_closed_unit_ball [normed_space ℝ β] (x : β) : - ∥x∥⁻¹ • x ∈ closed_ball (0 : β) 1 := + ‖x‖⁻¹ • x ∈ closed_ball (0 : β) 1 := by simp only [mem_closed_ball_zero_iff, norm_smul, norm_inv, norm_norm, ← div_eq_inv_mul, div_self_le_one] -lemma dist_smul [normed_space α β] (s : α) (x y : β) : dist (s • x) (s • y) = ∥s∥ * dist x y := -by simp only [dist_eq_norm, (norm_smul _ _).symm, smul_sub] - -lemma nnnorm_smul [normed_space α β] (s : α) (x : β) : ∥s • x∥₊ = ∥s∥₊ * ∥x∥₊ := -nnreal.eq $ norm_smul s x - -lemma nndist_smul [normed_space α β] (s : α) (x y : β) : - nndist (s • x) (s • y) = ∥s∥₊ * nndist x y := -nnreal.eq $ dist_smul s x y - -lemma lipschitz_with_smul [normed_space α β] (s : α) : lipschitz_with ∥s∥₊ ((•) s : β → β) := -lipschitz_with_iff_dist_le_mul.2 $ λ x y, by rw [dist_smul, coe_nnnorm] - lemma norm_smul_of_nonneg [normed_space ℝ β] {t : ℝ} (ht : 0 ≤ t) (x : β) : - ∥t • x∥ = t * ∥x∥ := by rw [norm_smul, real.norm_eq_abs, abs_of_nonneg ht] + ‖t • x‖ = t * ‖x‖ := by rw [norm_smul, real.norm_eq_abs, abs_of_nonneg ht] -variables {E : Type*} [semi_normed_group E] [normed_space α E] -variables {F : Type*} [semi_normed_group F] [normed_space α F] +variables {E : Type*} [seminormed_add_comm_group E] [normed_space α E] +variables {F : Type*} [seminormed_add_comm_group F] [normed_space α F] theorem eventually_nhds_norm_smul_sub_lt (c : α) (x : E) {ε : ℝ} (h : 0 < ε) : - ∀ᶠ y in 𝓝 x, ∥c • (y - x)∥ < ε := -have tendsto (λ y, ∥c • (y - x)∥) (𝓝 x) (𝓝 0), + ∀ᶠ y in 𝓝 x, ‖c • (y - x)‖ < ε := +have tendsto (λ y, ‖c • (y - x)‖) (𝓝 x) (𝓝 0), from ((continuous_id.sub continuous_const).const_smul _).norm.tendsto' _ _ (by simp), this.eventually (gt_mem_nhds h) lemma filter.tendsto.zero_smul_is_bounded_under_le {f : ι → α} {g : ι → E} {l : filter ι} (hf : tendsto f l (𝓝 0)) (hg : is_bounded_under (≤) l (norm ∘ g)) : tendsto (λ x, f x • g x) l (𝓝 0) := -hf.op_zero_is_bounded_under_le hg (•) (λ x y, (norm_smul x y).le) +hf.op_zero_is_bounded_under_le hg (•) norm_smul_le lemma filter.is_bounded_under.smul_tendsto_zero {f : ι → α} {g : ι → E} {l : filter ι} (hf : is_bounded_under (≤) l (norm ∘ f)) (hg : tendsto g l (𝓝 0)) : tendsto (λ x, f x • g x) l (𝓝 0) := -hg.op_zero_is_bounded_under_le hf (flip (•)) (λ x y, ((norm_smul y x).trans (mul_comm _ _)).le) +hg.op_zero_is_bounded_under_le hf (flip (•)) (λ x y, (norm_smul_le y x).trans_eq (mul_comm _ _)) theorem closure_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) : closure (ball x r) = closed_ball x r := begin - refine set.subset.antisymm closure_ball_subset_closed_ball (λ y hy, _), - have : continuous_within_at (λ c : ℝ, c • (y - x) + x) (set.Ico 0 1) 1 := + refine subset.antisymm closure_ball_subset_closed_ball (λ y hy, _), + have : continuous_within_at (λ c : ℝ, c • (y - x) + x) (Ico 0 1) 1 := ((continuous_id.smul continuous_const).add continuous_const).continuous_within_at, convert this.mem_closure _ _, { rw [one_smul, sub_add_cancel] }, - { simp [closure_Ico (@zero_ne_one ℝ _ _), zero_le_one] }, + { simp [closure_Ico zero_ne_one, zero_le_one] }, { rintros c ⟨hc0, hc1⟩, rw [mem_ball, dist_eq_norm, add_sub_cancel, norm_smul, real.norm_eq_abs, abs_of_nonneg hc0, mul_comm, ← mul_one r], @@ -135,19 +124,19 @@ theorem interior_closed_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ begin cases hr.lt_or_lt with hr hr, { rw [closed_ball_eq_empty.2 hr, ball_eq_empty.2 hr.le, interior_empty] }, - refine set.subset.antisymm _ ball_subset_interior_closed_ball, + refine subset.antisymm _ ball_subset_interior_closed_ball, intros y hy, rcases (mem_closed_ball.1 $ interior_subset hy).lt_or_eq with hr|rfl, { exact hr }, set f : ℝ → E := λ c : ℝ, c • (y - x) + x, - suffices : f ⁻¹' closed_ball x (dist y x) ⊆ set.Icc (-1) 1, + suffices : f ⁻¹' closed_ball x (dist y x) ⊆ Icc (-1) 1, { have hfc : continuous f := (continuous_id.smul continuous_const).add continuous_const, have hf1 : (1:ℝ) ∈ f ⁻¹' (interior (closed_ball x $ dist y x)), by simpa [f], - have h1 : (1:ℝ) ∈ interior (set.Icc (-1:ℝ) 1) := + have h1 : (1:ℝ) ∈ interior (Icc (-1:ℝ) 1) := interior_mono this (preimage_interior_subset_interior_preimage hfc hf1), contrapose h1, simp }, intros c hc, - rw [set.mem_Icc, ← abs_le, ← real.norm_eq_abs, ← mul_le_mul_right hr], + rw [mem_Icc, ← abs_le, ← real.norm_eq_abs, ← mul_le_mul_right hr], simpa [f, dist_eq_norm, norm_smul] using hc end @@ -156,115 +145,172 @@ theorem frontier_closed_ball [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ by rw [frontier, closure_closed_ball, interior_closed_ball x hr, closed_ball_diff_ball] +theorem interior_sphere [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) : + interior (sphere x r) = ∅ := +by rw [←frontier_closed_ball x hr, interior_frontier is_closed_ball] + +theorem frontier_sphere [normed_space ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) : + frontier (sphere x r) = sphere x r := +by rw [is_closed_sphere.frontier_eq, interior_sphere x hr, diff_empty] + +instance {E : Type*} [normed_add_comm_group E] [normed_space ℚ E] (e : E) : + discrete_topology $ add_subgroup.zmultiples e := +begin + rcases eq_or_ne e 0 with rfl | he, + { rw [add_subgroup.zmultiples_zero_eq_bot], apply_instance, }, + { rw [discrete_topology_iff_open_singleton_zero, is_open_induced_iff], + refine ⟨metric.ball 0 (‖e‖), metric.is_open_ball, _⟩, + ext ⟨x, hx⟩, + obtain ⟨k, rfl⟩ := add_subgroup.mem_zmultiples_iff.mp hx, + rw [mem_preimage, mem_ball_zero_iff, add_subgroup.coe_mk, mem_singleton_iff, + subtype.ext_iff, add_subgroup.coe_mk, add_subgroup.coe_zero, norm_zsmul ℚ k e, + int.norm_cast_rat, int.norm_eq_abs, ← int.cast_abs, mul_lt_iff_lt_one_left + (norm_pos_iff.mpr he), ← @int.cast_one ℝ _, int.cast_lt, int.abs_lt_one_iff, smul_eq_zero, + or_iff_left he], }, +end + /-- A (semi) normed real vector space is homeomorphic to the unit ball in the same space. -This homeomorphism sends `x : E` to `(1 + ∥x∥)⁻¹ • x`. +This homeomorphism sends `x : E` to `(1 + ‖x‖²)^(- ½) • x`. In many cases the actual implementation is not important, so we don't mark the projection lemmas -`homeomorph_unit_ball_apply_coe` and `homeomorph_unit_ball_symm_apply` as `@[simp]`. -/ +`homeomorph_unit_ball_apply_coe` and `homeomorph_unit_ball_symm_apply` as `@[simp]`. + +See also `cont_diff_homeomorph_unit_ball` and `cont_diff_on_homeomorph_unit_ball_symm` for +smoothness properties that hold when `E` is an inner-product space. -/ @[simps { attrs := [] }] -def homeomorph_unit_ball {E : Type*} [semi_normed_group E] [normed_space ℝ E] : +noncomputable def homeomorph_unit_ball [normed_space ℝ E] : E ≃ₜ ball (0 : E) 1 := -{ to_fun := λ x, ⟨(1 + ∥x∥)⁻¹ • x, begin - have : ∥x∥ < |1 + ∥x∥| := (lt_one_add _).trans_le (le_abs_self _), - rwa [mem_ball_zero_iff, norm_smul, real.norm_eq_abs, abs_inv, ← div_eq_inv_mul, - div_lt_one ((norm_nonneg x).trans_lt this)], +{ to_fun := λ x, ⟨(1 + ‖x‖^2).sqrt⁻¹ • x, begin + have : 0 < 1 + ‖x‖ ^ 2, by positivity, + rw [mem_ball_zero_iff, norm_smul, real.norm_eq_abs, abs_inv, ← div_eq_inv_mul, + div_lt_one (abs_pos.mpr $ real.sqrt_ne_zero'.mpr this), ← abs_norm x, ← sq_lt_sq, + abs_norm, real.sq_sqrt this.le], + exact lt_one_add _, end⟩, - inv_fun := λ x, (1 - ∥(x : E)∥)⁻¹ • (x : E), + inv_fun := λ y, (1 - ‖(y : E)‖^2).sqrt⁻¹ • (y : E), left_inv := λ x, - begin - have : 0 < 1 + ∥x∥ := (norm_nonneg x).trans_lt (lt_one_add _), - field_simp [this.ne', abs_of_pos this, norm_smul, smul_smul, real.norm_eq_abs, abs_div] - end, - right_inv := λ x, subtype.ext - begin - have : 0 < 1 - ∥(x : E)∥ := sub_pos.2 (mem_ball_zero_iff.1 x.2), - field_simp [norm_smul, smul_smul, real.norm_eq_abs, abs_div, abs_of_pos this, this.ne'] - end, - continuous_to_fun := continuous_subtype_mk _ $ - ((continuous_const.add continuous_norm).inv₀ - (λ x, ((norm_nonneg x).trans_lt (lt_one_add _)).ne')).smul continuous_id, - continuous_inv_fun := continuous.smul - ((continuous_const.sub continuous_subtype_coe.norm).inv₀ $ - λ x, (sub_pos.2 $ mem_ball_zero_iff.1 x.2).ne') continuous_subtype_coe } - -variables (α) - -lemma ne_neg_of_mem_sphere [char_zero α] {r : ℝ} (hr : r ≠ 0) (x : sphere (0:E) r) : x ≠ - x := -λ h, ne_zero_of_mem_sphere hr x ((self_eq_neg α _).mp (by { conv_lhs {rw h}, simp })) - -lemma ne_neg_of_mem_unit_sphere [char_zero α] (x : sphere (0:E) 1) : x ≠ - x := -ne_neg_of_mem_sphere α one_ne_zero x - -variables {α} + by field_simp [norm_smul, smul_smul, (zero_lt_one_add_norm_sq x).ne', + real.sq_sqrt (zero_lt_one_add_norm_sq x).le, ← real.sqrt_div (zero_lt_one_add_norm_sq x).le], + right_inv := λ y, + begin + have : 0 < 1 - ‖(y : E)‖ ^ 2 := + by nlinarith [norm_nonneg (y : E), (mem_ball_zero_iff.1 y.2 : ‖(y : E)‖ < 1)], + field_simp [norm_smul, smul_smul, this.ne', real.sq_sqrt this.le, ← real.sqrt_div this.le], + end, + continuous_to_fun := + begin + suffices : continuous (λ x, (1 + ‖x‖^2).sqrt⁻¹), from (this.smul continuous_id).subtype_mk _, + refine continuous.inv₀ _ (λ x, real.sqrt_ne_zero'.mpr (by positivity)), + continuity, + end, + continuous_inv_fun := + begin + suffices : ∀ (y : ball (0 : E) 1), (1 - ‖(y : E)‖ ^ 2).sqrt ≠ 0, { continuity, }, + intros y, + rw real.sqrt_ne_zero', + nlinarith [norm_nonneg (y : E), (mem_ball_zero_iff.1 y.2 : ‖(y : E)‖ < 1)], + end } + +@[simp] lemma coe_homeomorph_unit_ball_apply_zero [normed_space ℝ E] : + (homeomorph_unit_ball (0 : E) : E) = 0 := +by simp [homeomorph_unit_ball] open normed_field +instance : normed_space α (ulift E) := +{ norm_smul_le := λ s x, (norm_smul_le s x.down : _), + ..ulift.normed_add_comm_group, + ..ulift.module' } + /-- The product of two normed spaces is a normed space, with the sup norm. -/ instance prod.normed_space : normed_space α (E × F) := -{ norm_smul_le := λ s x, le_of_eq $ by simp [prod.norm_def, norm_smul, mul_max_of_nonneg], - ..prod.normed_group, +{ norm_smul_le := λ s x, by simp [prod.norm_def, norm_smul_le, mul_max_of_nonneg], + ..prod.normed_add_comm_group, ..prod.module } /-- The product of finitely many normed spaces is a normed space, with the sup norm. -/ -instance pi.normed_space {E : ι → Type*} [fintype ι] [∀i, semi_normed_group (E i)] +instance pi.normed_space {E : ι → Type*} [fintype ι] [∀i, seminormed_add_comm_group (E i)] [∀i, normed_space α (E i)] : normed_space α (Πi, E i) := -{ norm_smul_le := λ a f, le_of_eq $ - show (↑(finset.sup finset.univ (λ (b : ι), ∥a • f b∥₊)) : ℝ) = - ∥a∥₊ * ↑(finset.sup finset.univ (λ (b : ι), ∥f b∥₊)), - by simp only [(nnreal.coe_mul _ _).symm, nnreal.mul_finset_sup, nnnorm_smul] } +{ norm_smul_le := λ a f, begin + simp_rw [←coe_nnnorm, ←nnreal.coe_mul, nnreal.coe_le_coe, pi.nnnorm_def, nnreal.mul_finset_sup], + exact finset.sup_mono_fun (λ _ _, norm_smul_le _ _), + end } + +instance mul_opposite.normed_space : normed_space α Eᵐᵒᵖ := +{ norm_smul_le := λ s x, (norm_smul_le s x.unop : _), + ..mul_opposite.normed_add_comm_group, + ..mul_opposite.module _ } /-- A subspace of a normed space is also a normed space, with the restriction of the norm. -/ -instance submodule.normed_space {𝕜 R : Type*} [has_scalar 𝕜 R] [normed_field 𝕜] [ring R] - {E : Type*} [semi_normed_group E] [normed_space 𝕜 E] [module R E] +instance submodule.normed_space {𝕜 R : Type*} [has_smul 𝕜 R] [normed_field 𝕜] [ring R] + {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E] [module R E] [is_scalar_tower 𝕜 R E] (s : submodule R E) : normed_space 𝕜 s := -{ norm_smul_le := λc x, le_of_eq $ norm_smul c (x : E) } +{ norm_smul_le := λc x, (norm_smul_le c (x : E) : _) } -/-- If there is a scalar `c` with `∥c∥>1`, then any element with nonzero norm can be -moved by scalar multiplication to any shell of width `∥c∥`. Also recap information on the norm of +/-- If there is a scalar `c` with `‖c‖>1`, then any element with nonzero norm can be +moved by scalar multiplication to any shell of width `‖c‖`. Also recap information on the norm of the rescaling element that shows up in applications. -/ -lemma rescale_to_shell_semi_normed {c : α} (hc : 1 < ∥c∥) {ε : ℝ} (εpos : 0 < ε) {x : E} - (hx : ∥x∥ ≠ 0) : ∃d:α, d ≠ 0 ∧ ∥d • x∥ < ε ∧ (ε/∥c∥ ≤ ∥d • x∥) ∧ (∥d∥⁻¹ ≤ ε⁻¹ * ∥c∥ * ∥x∥) := +lemma rescale_to_shell_semi_normed_zpow {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} + (hx : ‖x‖ ≠ 0) : + ∃ n : ℤ, c ^ n ≠ 0 ∧ ‖c ^ n • x‖ < ε ∧ (ε / ‖c‖ ≤ ‖c ^ n • x‖) ∧ (‖c ^ n‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) := begin - have xεpos : 0 < ∥x∥/ε := div_pos ((ne.symm hx).le_iff_lt.1 (norm_nonneg x)) εpos, + have xεpos : 0 < ‖x‖/ε := div_pos ((ne.symm hx).le_iff_lt.1 (norm_nonneg x)) εpos, rcases exists_mem_Ico_zpow xεpos hc with ⟨n, hn⟩, - have cpos : 0 < ∥c∥ := lt_trans (zero_lt_one : (0 :ℝ) < 1) hc, - have cnpos : 0 < ∥c^(n+1)∥ := by { rw norm_zpow, exact lt_trans xεpos hn.2 }, - refine ⟨(c^(n+1))⁻¹, _, _, _, _⟩, - show (c ^ (n + 1))⁻¹ ≠ 0, - by rwa [ne.def, inv_eq_zero, ← ne.def, ← norm_pos_iff], - show ∥(c ^ (n + 1))⁻¹ • x∥ < ε, - { rw [norm_smul, norm_inv, ← div_eq_inv_mul, div_lt_iff cnpos, mul_comm, norm_zpow], + have cpos : 0 < ‖c‖ := lt_trans (zero_lt_one : (0 :ℝ) < 1) hc, + have cnpos : 0 < ‖c^(n+1)‖ := by { rw norm_zpow, exact lt_trans xεpos hn.2 }, + refine ⟨-(n+1), _, _, _, _⟩, + show c ^ (-(n + 1)) ≠ 0, from zpow_ne_zero _ (norm_pos_iff.1 cpos), + show ‖c ^ (-(n + 1)) • x‖ < ε, + { rw [norm_smul, zpow_neg, norm_inv, ← div_eq_inv_mul, div_lt_iff cnpos, mul_comm, norm_zpow], exact (div_lt_iff εpos).1 (hn.2) }, - show ε / ∥c∥ ≤ ∥(c ^ (n + 1))⁻¹ • x∥, - { rw [div_le_iff cpos, norm_smul, norm_inv, norm_zpow, zpow_add₀ (ne_of_gt cpos), - zpow_one, mul_inv_rev₀, mul_comm, ← mul_assoc, ← mul_assoc, mul_inv_cancel (ne_of_gt cpos), + show ε / ‖c‖ ≤ ‖c ^ (-(n + 1)) • x‖, + { rw [zpow_neg, div_le_iff cpos, norm_smul, norm_inv, norm_zpow, zpow_add₀ (ne_of_gt cpos), + zpow_one, mul_inv_rev, mul_comm, ← mul_assoc, ← mul_assoc, mul_inv_cancel (ne_of_gt cpos), one_mul, ← div_eq_inv_mul, le_div_iff (zpow_pos_of_pos cpos _), mul_comm], exact (le_div_iff εpos).1 hn.1 }, - show ∥(c ^ (n + 1))⁻¹∥⁻¹ ≤ ε⁻¹ * ∥c∥ * ∥x∥, - { have : ε⁻¹ * ∥c∥ * ∥x∥ = ε⁻¹ * ∥x∥ * ∥c∥, by ring, - rw [norm_inv, inv_inv, norm_zpow, zpow_add₀ (ne_of_gt cpos), zpow_one, this, ← div_eq_inv_mul], + show ‖c ^ (-(n + 1))‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖, + { rw [zpow_neg, norm_inv, inv_inv, norm_zpow, zpow_add₀ cpos.ne', zpow_one, mul_right_comm, + ← div_eq_inv_mul], exact mul_le_mul_of_nonneg_right hn.1 (norm_nonneg _) } end -end semi_normed_group +/-- If there is a scalar `c` with `‖c‖>1`, then any element with nonzero norm can be +moved by scalar multiplication to any shell of width `‖c‖`. Also recap information on the norm of +the rescaling element that shows up in applications. -/ +lemma rescale_to_shell_semi_normed {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} + (hx : ‖x‖ ≠ 0) : ∃d:α, d ≠ 0 ∧ ‖d • x‖ < ε ∧ (ε/‖c‖ ≤ ‖d • x‖) ∧ (‖d‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) := +let ⟨n, hn⟩ := rescale_to_shell_semi_normed_zpow hc εpos hx in ⟨_, hn⟩ + +end seminormed_add_comm_group + +/-- A linear map from a `module` to a `normed_space` induces a `normed_space` structure on the +domain, using the `seminormed_add_comm_group.induced` norm. -section normed_group +See note [reducible non-instances] -/ +@[reducible] +def normed_space.induced {F : Type*} (α β γ : Type*) [normed_field α] [add_comm_group β] + [module α β] [seminormed_add_comm_group γ] [normed_space α γ] [linear_map_class F α β γ] + (f : F) : @normed_space α β _ (seminormed_add_comm_group.induced β γ f) := +{ norm_smul_le := λ a b, by {unfold norm, exact (map_smul f a b).symm ▸ norm_smul_le a (f b) } } + +section normed_add_comm_group variables [normed_field α] -variables {E : Type*} [normed_group E] [normed_space α E] -variables {F : Type*} [normed_group F] [normed_space α F] +variables {E : Type*} [normed_add_comm_group E] [normed_space α E] +variables {F : Type*} [normed_add_comm_group F] [normed_space α F] open normed_field /-- While this may appear identical to `normed_space.to_module`, it contains an implicit argument -involving `normed_group.to_semi_normed_group` that typeclass inference has trouble inferring. +involving `normed_add_comm_group.to_seminormed_add_comm_group` that typeclass inference has trouble +inferring. Specifically, the following instance cannot be found without this `normed_space.to_module'`: ```lean example (𝕜 ι : Type*) (E : ι → Type*) - [normed_field 𝕜] [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] : + [normed_field 𝕜] [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] : Π i, module 𝕜 (E i) := by apply_instance ``` @@ -273,6 +319,37 @@ gives some more context. -/ @[priority 100] instance normed_space.to_module' : module α F := normed_space.to_module +section surj + +variables (E) [normed_space ℝ E] [nontrivial E] + +lemma exists_norm_eq {c : ℝ} (hc : 0 ≤ c) : ∃ x : E, ‖x‖ = c := +begin + rcases exists_ne (0 : E) with ⟨x, hx⟩, + rw ← norm_ne_zero_iff at hx, + use c • ‖x‖⁻¹ • x, + simp [norm_smul, real.norm_of_nonneg hc, hx] +end + +@[simp] lemma range_norm : range (norm : E → ℝ) = Ici 0 := +subset.antisymm (range_subset_iff.2 norm_nonneg) (λ _, exists_norm_eq E) + +lemma nnnorm_surjective : surjective (nnnorm : E → ℝ≥0) := +λ c, (exists_norm_eq E c.coe_nonneg).imp $ λ x h, nnreal.eq h + +@[simp] lemma range_nnnorm : range (nnnorm : E → ℝ≥0) = univ := +(nnnorm_surjective E).range_eq + +end surj + +/-- If `E` is a nontrivial topological module over `ℝ`, then `E` has no isolated points. +This is a particular case of `module.punctured_nhds_ne_bot`. -/ +instance real.punctured_nhds_module_ne_bot + {E : Type*} [add_comm_group E] [topological_space E] [has_continuous_add E] [nontrivial E] + [module ℝ E] [has_continuous_smul ℝ E] (x : E) : + ne_bot (𝓝[≠] x) := +module.punctured_nhds_ne_bot ℝ E x + theorem interior_closed_ball' [normed_space ℝ E] [nontrivial E] (x : E) (r : ℝ) : interior (closed_ball x r) = ball x r := begin @@ -285,47 +362,59 @@ theorem frontier_closed_ball' [normed_space ℝ E] [nontrivial E] (x : E) (r : frontier (closed_ball x r) = sphere x r := by rw [frontier, closure_closed_ball, interior_closed_ball' x r, closed_ball_diff_ball] +@[simp] theorem interior_sphere' [normed_space ℝ E] [nontrivial E] (x : E) (r : ℝ) : + interior (sphere x r) = ∅ := +by rw [←frontier_closed_ball' x, interior_frontier is_closed_ball] + +@[simp] theorem frontier_sphere' [normed_space ℝ E] [nontrivial E] (x : E) (r : ℝ) : + frontier (sphere x r) = sphere x r := +by rw [is_closed_sphere.frontier_eq, interior_sphere' x, diff_empty] + variables {α} -/-- If there is a scalar `c` with `∥c∥>1`, then any element can be moved by scalar multiplication to -any shell of width `∥c∥`. Also recap information on the norm of the rescaling element that shows +lemma rescale_to_shell_zpow {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) : + ∃ n : ℤ, c ^ n ≠ 0 ∧ ‖c ^ n • x‖ < ε ∧ (ε / ‖c‖ ≤ ‖c ^ n • x‖) ∧ (‖c ^ n‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) := +rescale_to_shell_semi_normed_zpow hc εpos (mt norm_eq_zero.1 hx) + +/-- If there is a scalar `c` with `‖c‖>1`, then any element can be moved by scalar multiplication to +any shell of width `‖c‖`. Also recap information on the norm of the rescaling element that shows up in applications. -/ -lemma rescale_to_shell {c : α} (hc : 1 < ∥c∥) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) : - ∃d:α, d ≠ 0 ∧ ∥d • x∥ < ε ∧ (ε/∥c∥ ≤ ∥d • x∥) ∧ (∥d∥⁻¹ ≤ ε⁻¹ * ∥c∥ * ∥x∥) := -rescale_to_shell_semi_normed hc εpos (ne_of_lt (norm_pos_iff.2 hx)).symm +lemma rescale_to_shell {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) : + ∃d:α, d ≠ 0 ∧ ‖d • x‖ < ε ∧ (ε/‖c‖ ≤ ‖d • x‖) ∧ (‖d‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖) := +rescale_to_shell_semi_normed hc εpos (mt norm_eq_zero.1 hx) -end normed_group +end normed_add_comm_group -section normed_space_nondiscrete +section nontrivially_normed_space -variables (𝕜 E : Type*) [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] +variables (𝕜 E : Type*) [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] [nontrivial E] include 𝕜 -/-- If `E` is a nontrivial normed space over a nondiscrete normed field `𝕜`, then `E` is unbounded: +/-- If `E` is a nontrivial normed space over a nontrivially normed field `𝕜`, then `E` is unbounded: for any `c : ℝ`, there exists a vector `x : E` with norm strictly greater than `c`. -/ -lemma normed_space.exists_lt_norm (c : ℝ) : ∃ x : E, c < ∥x∥ := +lemma normed_space.exists_lt_norm (c : ℝ) : ∃ x : E, c < ‖x‖ := begin rcases exists_ne (0 : E) with ⟨x, hx⟩, - rcases normed_field.exists_lt_norm 𝕜 (c / ∥x∥) with ⟨r, hr⟩, + rcases normed_field.exists_lt_norm 𝕜 (c / ‖x‖) with ⟨r, hr⟩, use r • x, rwa [norm_smul, ← div_lt_iff], rwa norm_pos_iff end -protected lemma normed_space.unbounded_univ : ¬bounded (set.univ : set E) := +protected lemma normed_space.unbounded_univ : ¬bounded (univ : set E) := λ h, let ⟨R, hR⟩ := bounded_iff_forall_norm_le.1 h, ⟨x, hx⟩ := normed_space.exists_lt_norm 𝕜 E R in hx.not_le (hR x trivial) -/-- A normed vector space over a nondiscrete normed field is a noncompact space. This cannot be +/-- A normed vector space over a nontrivially normed field is a noncompact space. This cannot be an instance because in order to apply it, Lean would have to search for `normed_space 𝕜 E` with unknown `𝕜`. We register this as an instance in two cases: `𝕜 = E` and `𝕜 = ℝ`. -/ protected lemma normed_space.noncompact_space : noncompact_space E := ⟨λ h, normed_space.unbounded_univ 𝕜 _ h.bounded⟩ @[priority 100] -instance nondiscrete_normed_field.noncompact_space : noncompact_space 𝕜 := +instance nontrivially_normed_field.noncompact_space : noncompact_space 𝕜 := normed_space.noncompact_space 𝕜 𝕜 omit 𝕜 @@ -334,7 +423,7 @@ omit 𝕜 instance real_normed_space.noncompact_space [normed_space ℝ E] : noncompact_space E := normed_space.noncompact_space ℝ E -end normed_space_nondiscrete +end nontrivially_normed_space section normed_algebra @@ -349,7 +438,7 @@ variables [normed_module 𝕜 𝕜'] [smul_comm_class 𝕜 𝕜' 𝕜'] [is_scal -/ class normed_algebra (𝕜 : Type*) (𝕜' : Type*) [normed_field 𝕜] [semi_normed_ring 𝕜'] extends algebra 𝕜 𝕜' := -(norm_smul_le : ∀ (r : 𝕜) (x : 𝕜'), ∥r • x∥ ≤ ∥r∥ * ∥x∥) +(norm_smul_le : ∀ (r : 𝕜) (x : 𝕜'), ‖r • x‖ ≤ ‖r‖ * ‖x‖) variables {𝕜 : Type*} (𝕜' : Type*) [normed_field 𝕜] [semi_normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] @@ -373,49 +462,42 @@ See `normed_space.to_module'` for a similar situation. -/ instance normed_algebra.to_normed_space' {𝕜'} [normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] : normed_space 𝕜 𝕜' := by apply_instance -lemma norm_algebra_map (x : 𝕜) : ∥algebra_map 𝕜 𝕜' x∥ = ∥x∥ * ∥(1 : 𝕜')∥ := +lemma norm_algebra_map (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖ = ‖x‖ * ‖(1 : 𝕜')‖ := begin rw algebra.algebra_map_eq_smul_one, exact norm_smul _ _, end -lemma nnnorm_algebra_map (x : 𝕜) : ∥algebra_map 𝕜 𝕜' x∥₊ = ∥x∥₊ * ∥(1 : 𝕜')∥₊ := +lemma nnnorm_algebra_map (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖₊ = ‖x‖₊ * ‖(1 : 𝕜')‖₊ := subtype.ext $ norm_algebra_map 𝕜' x -@[simp] lemma norm_algebra_map' [norm_one_class 𝕜'] (x : 𝕜) : ∥algebra_map 𝕜 𝕜' x∥ = ∥x∥ := +@[simp] lemma norm_algebra_map' [norm_one_class 𝕜'] (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖ = ‖x‖ := by rw [norm_algebra_map, norm_one, mul_one] -@[simp] lemma nnnorm_algebra_map' [norm_one_class 𝕜'] (x : 𝕜) : ∥algebra_map 𝕜 𝕜' x∥₊ = ∥x∥₊ := +@[simp] lemma nnnorm_algebra_map' [norm_one_class 𝕜'] (x : 𝕜) : ‖algebra_map 𝕜 𝕜' x‖₊ = ‖x‖₊ := subtype.ext $ norm_algebra_map' _ _ +section nnreal + +variables [norm_one_class 𝕜'] [normed_algebra ℝ 𝕜'] + +@[simp] lemma norm_algebra_map_nnreal (x : ℝ≥0) : ‖algebra_map ℝ≥0 𝕜' x‖ = x := +(norm_algebra_map' 𝕜' (x : ℝ)).symm ▸ real.norm_of_nonneg x.prop + +@[simp] lemma nnnorm_algebra_map_nnreal (x : ℝ≥0) : ‖algebra_map ℝ≥0 𝕜' x‖₊ = x := +subtype.ext $ norm_algebra_map_nnreal 𝕜' x + +end nnreal + variables (𝕜 𝕜') /-- In a normed algebra, the inclusion of the base field in the extended field is an isometry. -/ lemma algebra_map_isometry [norm_one_class 𝕜'] : isometry (algebra_map 𝕜 𝕜') := begin - refine isometry_emetric_iff_metric.2 (λx y, _), + refine isometry.of_dist_eq (λx y, _), rw [dist_eq_norm, dist_eq_norm, ← ring_hom.map_sub, norm_algebra_map'], end -/-- The inclusion of the base field in a normed algebra as a continuous linear map. -/ -@[simps] -def algebra_map_clm : 𝕜 →L[𝕜] 𝕜' := -{ to_fun := algebra_map 𝕜 𝕜', - map_add' := (algebra_map 𝕜 𝕜').map_add, - map_smul' := λ r x, by rw [algebra.id.smul_eq_mul, map_mul, ring_hom.id_apply, algebra.smul_def], - cont := - have lipschitz_with ∥(1 : 𝕜')∥₊ (algebra_map 𝕜 𝕜') := λ x y, begin - rw [edist_eq_coe_nnnorm_sub, edist_eq_coe_nnnorm_sub, ←map_sub, ←ennreal.coe_mul, - ennreal.coe_le_coe, mul_comm], - exact (nnnorm_algebra_map _ _).le, - end, this.continuous } - -lemma algebra_map_clm_coe : - (algebra_map_clm 𝕜 𝕜' : 𝕜 → 𝕜') = (algebra_map 𝕜 𝕜' : 𝕜 → 𝕜') := rfl - -lemma algebra_map_clm_to_linear_map : - (algebra_map_clm 𝕜 𝕜').to_linear_map = algebra.linear_map 𝕜 𝕜' := rfl - instance normed_algebra.id : normed_algebra 𝕜 𝕜 := { .. normed_field.to_normed_space, .. algebra.id 𝕜} @@ -433,6 +515,9 @@ instance normed_algebra_rat {𝕜} [normed_division_ring 𝕜] [char_zero 𝕜] instance punit.normed_algebra : normed_algebra 𝕜 punit := { norm_smul_le := λ q x, by simp only [punit.norm_eq_zero, mul_zero] } +instance : normed_algebra 𝕜 (ulift 𝕜') := +{ ..ulift.normed_space } + /-- The product of two normed algebras is a normed algebra, with the sup norm. -/ instance prod.normed_algebra {E F : Type*} [semi_normed_ring E] [semi_normed_ring F] [normed_algebra 𝕜 E] [normed_algebra 𝕜 F] : @@ -446,36 +531,43 @@ instance pi.normed_algebra {E : ι → Type*} [fintype ι] { .. pi.normed_space, .. pi.algebra _ E } +instance mul_opposite.normed_algebra {E : Type*} [semi_normed_ring E] [normed_algebra 𝕜 E] : + normed_algebra 𝕜 Eᵐᵒᵖ := +{ ..mul_opposite.normed_space } + end normed_algebra -section restrict_scalars +/-- A non-unital algebra homomorphism from an `algebra` to a `normed_algebra` induces a +`normed_algebra` structure on the domain, using the `semi_normed_ring.induced` norm. -variables (𝕜 : Type*) (𝕜' : Type*) [normed_field 𝕜] [normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] -(E : Type*) [semi_normed_group E] [normed_space 𝕜' E] +See note [reducible non-instances] -/ +@[reducible] +def normed_algebra.induced {F : Type*} (α β γ : Type*) [normed_field α] [ring β] + [algebra α β] [semi_normed_ring γ] [normed_algebra α γ] [non_unital_alg_hom_class F α β γ] + (f : F) : @normed_algebra α β _ (semi_normed_ring.induced β γ f) := +{ norm_smul_le := λ a b, by {unfold norm, exact (map_smul f a b).symm ▸ norm_smul_le a (f b) } } -/-- Warning: This declaration should be used judiciously. -Please consider using `is_scalar_tower` instead. +instance subalgebra.to_normed_algebra {𝕜 A : Type*} [semi_normed_ring A] [normed_field 𝕜] + [normed_algebra 𝕜 A] (S : subalgebra 𝕜 A) : normed_algebra 𝕜 S := +@normed_algebra.induced _ 𝕜 S A _ (subring_class.to_ring S) S.algebra _ _ _ S.val -`𝕜`-normed space structure induced by a `𝕜'`-normed space structure when `𝕜'` is a -normed algebra over `𝕜`. Not registered as an instance as `𝕜'` can not be inferred. +section restrict_scalars -The type synonym `restrict_scalars 𝕜 𝕜' E` will be endowed with this instance by default. --/ -def normed_space.restrict_scalars : normed_space 𝕜 E := -{ norm_smul_le := λc x, le_of_eq $ begin - change ∥(algebra_map 𝕜 𝕜' c) • x∥ = ∥c∥ * ∥x∥, - simp [norm_smul] - end, - ..restrict_scalars.module 𝕜 𝕜' E } +variables (𝕜 : Type*) (𝕜' : Type*) [normed_field 𝕜] [normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] +(E : Type*) [seminormed_add_comm_group E] [normed_space 𝕜' E] -instance {𝕜 : Type*} {𝕜' : Type*} {E : Type*} [I : semi_normed_group E] : - semi_normed_group (restrict_scalars 𝕜 𝕜' E) := I +instance {𝕜 : Type*} {𝕜' : Type*} {E : Type*} [I : seminormed_add_comm_group E] : + seminormed_add_comm_group (restrict_scalars 𝕜 𝕜' E) := I -instance {𝕜 : Type*} {𝕜' : Type*} {E : Type*} [I : normed_group E] : - normed_group (restrict_scalars 𝕜 𝕜' E) := I +instance {𝕜 : Type*} {𝕜' : Type*} {E : Type*} [I : normed_add_comm_group E] : + normed_add_comm_group (restrict_scalars 𝕜 𝕜' E) := I +/-- If `E` is a normed space over `𝕜'` and `𝕜` is a normed algebra over `𝕜'`, then +`restrict_scalars.module` is additionally a `normed_space`. -/ instance : normed_space 𝕜 (restrict_scalars 𝕜 𝕜' E) := -(normed_space.restrict_scalars 𝕜 𝕜' E : normed_space 𝕜 E) +{ norm_smul_le := λ c x, (norm_smul_le (algebra_map 𝕜 𝕜' c) (_ : E)).trans_eq $ + by rw norm_algebra_map', + ..restrict_scalars.module 𝕜 𝕜' E } /-- The action of the original normed_field on `restrict_scalars 𝕜 𝕜' E`. @@ -484,7 +576,17 @@ This is not an instance as it would be contrary to the purpose of `restrict_scal -- If you think you need this, consider instead reproducing `restrict_scalars.lsmul` -- appropriately modified here. def module.restrict_scalars.normed_space_orig {𝕜 : Type*} {𝕜' : Type*} {E : Type*} - [normed_field 𝕜'] [semi_normed_group E] [I : normed_space 𝕜' E] : + [normed_field 𝕜'] [seminormed_add_comm_group E] [I : normed_space 𝕜' E] : normed_space 𝕜' (restrict_scalars 𝕜 𝕜' E) := I +/-- Warning: This declaration should be used judiciously. +Please consider using `is_scalar_tower` and/or `restrict_scalars 𝕜 𝕜' E` instead. + +This definition allows the `restrict_scalars.normed_space` instance to be put directly on `E` +rather on `restrict_scalars 𝕜 𝕜' E`. This would be a very bad instance; both because `𝕜'` cannot be +inferred, and because it is likely to create instance diamonds. +-/ +def normed_space.restrict_scalars : normed_space 𝕜 E := +restrict_scalars.normed_space _ 𝕜' _ + end restrict_scalars diff --git a/src/analysis/normed_space/bounded_linear_maps.lean b/src/analysis/normed_space/bounded_linear_maps.lean index 663d70c2e8b10..5f3aeef6d4354 100644 --- a/src/analysis/normed_space/bounded_linear_maps.lean +++ b/src/analysis/normed_space/bounded_linear_maps.lean @@ -10,19 +10,22 @@ import analysis.asymptotics.asymptotics /-! # Bounded linear maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a class stating that a map between normed vector spaces is (bi)linear and continuous. Instead of asking for continuity, the definition takes the equivalent condition (because the space -is normed) that `∥f x∥` is bounded by a multiple of `∥x∥`. Hence the "bounded" in the name refers to -`∥f x∥/∥x∥` rather than `∥f x∥` itself. +is normed) that `‖f x‖` is bounded by a multiple of `‖x‖`. Hence the "bounded" in the name refers to +`‖f x‖/‖x‖` rather than `‖f x‖` itself. ## Main definitions -* `is_bounded_linear_map`: Class stating that a map `f : E → F` is linear and has `∥f x∥` bounded - by a multiple of `∥x∥`. +* `is_bounded_linear_map`: Class stating that a map `f : E → F` is linear and has `‖f x‖` bounded + by a multiple of `‖x‖`. * `is_bounded_bilinear_map`: Class stating that a map `f : E × F → G` is bilinear and continuous, - but through the simpler to provide statement that `∥f (x, y)∥` is bounded by a multiple of - `∥x∥ * ∥y∥` + but through the simpler to provide statement that `‖f (x, y)‖` is bounded by a multiple of + `‖x‖ * ‖y‖` * `is_bounded_bilinear_map.linear_deriv`: Derivative of a continuous bilinear map as a linear map. * `is_bounded_bilinear_map.deriv`: Derivative of a continuous bilinear map as a continuous linear map. The proof that it is indeed the derivative is `is_bounded_bilinear_map.has_fderiv_at` in @@ -49,25 +52,25 @@ artifact, really. -/ noncomputable theory -open_locale classical big_operators topological_space +open_locale big_operators topology open filter (tendsto) metric continuous_linear_map -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] - {E : Type*} [normed_group E] [normed_space 𝕜 E] - {F : Type*} [normed_group F] [normed_space 𝕜 F] - {G : Type*} [normed_group G] [normed_space 𝕜 G] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] + {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] + {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G] /-- A function `f` satisfies `is_bounded_linear_map 𝕜 f` if it is linear and satisfies the -inequality `∥f x∥ ≤ M * ∥x∥` for some positive constant `M`. -/ +inequality `‖f x‖ ≤ M * ‖x‖` for some positive constant `M`. -/ structure is_bounded_linear_map (𝕜 : Type*) [normed_field 𝕜] - {E : Type*} [normed_group E] [normed_space 𝕜 E] - {F : Type*} [normed_group F] [normed_space 𝕜 F] (f : E → F) + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] + {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] (f : E → F) extends is_linear_map 𝕜 f : Prop := -(bound : ∃ M, 0 < M ∧ ∀ x : E, ∥f x∥ ≤ M * ∥x∥) +(bound : ∃ M, 0 < M ∧ ∀ x : E, ‖f x‖ ≤ M * ‖x‖) lemma is_linear_map.with_bound - {f : E → F} (hf : is_linear_map 𝕜 f) (M : ℝ) (h : ∀ x : E, ∥f x∥ ≤ M * ∥x∥) : + {f : E → F} (hf : is_linear_map 𝕜 f) (M : ℝ) (h : ∀ x : E, ‖f x‖ ≤ M * ‖x‖) : is_bounded_linear_map 𝕜 f := ⟨ hf, classical.by_cases (assume : M ≤ 0, ⟨1, zero_lt_one, λ x, @@ -87,7 +90,8 @@ def to_linear_map (f : E → F) (h : is_bounded_linear_map 𝕜 f) : E →ₗ[ /-- Construct a continuous linear map from is_bounded_linear_map -/ def to_continuous_linear_map {f : E → F} (hf : is_bounded_linear_map 𝕜 f) : E →L[𝕜] F := -{ cont := let ⟨C, Cpos, hC⟩ := hf.bound in (to_linear_map f hf).continuous_of_bound C hC, +{ cont := let ⟨C, Cpos, hC⟩ := + hf.bound in add_monoid_hom_class.continuous_of_bound (to_linear_map f hf) C hC, ..to_linear_map f hf} lemma zero : is_bounded_linear_map 𝕜 (λ (x:E), (0:F)) := @@ -115,10 +119,10 @@ variables {f g : E → F} lemma smul (c : 𝕜) (hf : is_bounded_linear_map 𝕜 f) : is_bounded_linear_map 𝕜 (c • f) := let ⟨hlf, M, hMp, hM⟩ := hf in -(c • hlf.mk' f).is_linear.with_bound (∥c∥ * M) $ λ x, - calc ∥c • f x∥ = ∥c∥ * ∥f x∥ : norm_smul c (f x) - ... ≤ ∥c∥ * (M * ∥x∥) : mul_le_mul_of_nonneg_left (hM _) (norm_nonneg _) - ... = (∥c∥ * M) * ∥x∥ : (mul_assoc _ _ _).symm +(c • hlf.mk' f).is_linear.with_bound (‖c‖ * M) $ λ x, + calc ‖c • f x‖ = ‖c‖ * ‖f x‖ : norm_smul c (f x) + ... ≤ ‖c‖ * (M * ‖x‖) : mul_le_mul_of_nonneg_left (hM _) (norm_nonneg _) + ... = (‖c‖ * M) * ‖x‖ : (mul_assoc _ _ _).symm lemma neg (hf : is_bounded_linear_map 𝕜 f) : is_bounded_linear_map 𝕜 (λ e, -f e) := @@ -132,8 +136,8 @@ lemma add (hf : is_bounded_linear_map 𝕜 f) (hg : is_bounded_linear_map 𝕜 g let ⟨hlf, Mf, hMfp, hMf⟩ := hf in let ⟨hlg, Mg, hMgp, hMg⟩ := hg in (hlf.mk' _ + hlg.mk' _).is_linear.with_bound (Mf + Mg) $ λ x, - calc ∥f x + g x∥ ≤ Mf * ∥x∥ + Mg * ∥x∥ : norm_add_le_of_le (hMf x) (hMg x) - ... ≤ (Mf + Mg) * ∥x∥ : by rw add_mul + calc ‖f x + g x‖ ≤ Mf * ‖x‖ + Mg * ‖x‖ : norm_add_le_of_le (hMf x) (hMg x) + ... ≤ (Mf + Mg) * ‖x‖ : by rw add_mul lemma sub (hf : is_bounded_linear_map 𝕜 f) (hg : is_bounded_linear_map 𝕜 g) : is_bounded_linear_map 𝕜 (λ e, f e - g e) := @@ -150,9 +154,9 @@ let ⟨hf, M, hMp, hM⟩ := hf in tendsto_iff_norm_tendsto_zero.2 $ squeeze_zero (λ e, norm_nonneg _) (λ e, - calc ∥f e - f x∥ = ∥hf.mk' f (e - x)∥ : by rw (hf.mk' _).map_sub e x; refl - ... ≤ M * ∥e - x∥ : hM (e - x)) - (suffices tendsto (λ (e : E), M * ∥e - x∥) (𝓝 x) (𝓝 (M * 0)), by simpa, + calc ‖f e - f x‖ = ‖hf.mk' f (e - x)‖ : by rw (hf.mk' _).map_sub e x; refl + ... ≤ M * ‖e - x‖ : hM (e - x)) + (suffices tendsto (λ (e : E), M * ‖e - x‖) (𝓝 x) (𝓝 (M * 0)), by simpa, tendsto_const_nhds.mul (tendsto_norm_sub_self _)) lemma continuous (hf : is_bounded_linear_map 𝕜 f) : continuous f := @@ -166,15 +170,15 @@ section open asymptotics filter theorem is_O_id {f : E → F} (h : is_bounded_linear_map 𝕜 f) (l : filter E) : - is_O f (λ x, x) l := + f =O[l] (λ x, x) := let ⟨M, hMp, hM⟩ := h.bound in is_O.of_bound _ (mem_of_superset univ_mem (λ x _, hM x)) theorem is_O_comp {E : Type*} {g : F → G} (hg : is_bounded_linear_map 𝕜 g) - {f : E → F} (l : filter E) : is_O (λ x', g (f x')) f l := + {f : E → F} (l : filter E) : (λ x', g (f x')) =O[l] f := (hg.is_O_id ⊤).comp_tendsto le_top theorem is_O_sub {f : E → F} (h : is_bounded_linear_map 𝕜 f) - (l : filter E) (x : E) : is_O (λ x', f (x' - x)) (λ x', x' - x) l := + (l : filter E) (x : E) : (λ x', f (x' - x)) =O[l] (λ x', x' - x) := is_O_comp h l end @@ -182,12 +186,12 @@ end end is_bounded_linear_map section -variables {ι : Type*} [decidable_eq ι] [fintype ι] +variables {ι : Type*} [fintype ι] /-- Taking the cartesian product of two continuous multilinear maps is a bounded linear operation. -/ lemma is_bounded_linear_map_prod_multilinear - {E : ι → Type*} [∀ i, normed_group (E i)] [∀ i, normed_space 𝕜 (E i)] : + {E : ι → Type*} [∀ i, normed_add_comm_group (E i)] [∀ i, normed_space 𝕜 (E i)] : is_bounded_linear_map 𝕜 (λ p : (continuous_multilinear_map 𝕜 E F) × (continuous_multilinear_map 𝕜 E G), p.1.prod p.2) := { map_add := λ p₁ p₂, by { ext1 m, refl }, @@ -210,16 +214,16 @@ lemma is_bounded_linear_map_continuous_multilinear_map_comp_linear (g : G →L[ f.comp_continuous_linear_map (λ _, g)) := begin refine is_linear_map.with_bound ⟨λ f₁ f₂, by { ext m, refl }, λ c f, by { ext m, refl }⟩ - (∥g∥ ^ (fintype.card ι)) (λ f, _), + (‖g‖ ^ (fintype.card ι)) (λ f, _), apply continuous_multilinear_map.op_norm_le_bound _ _ (λ m, _), { apply_rules [mul_nonneg, pow_nonneg, norm_nonneg] }, - calc ∥f (g ∘ m)∥ ≤ - ∥f∥ * ∏ i, ∥g (m i)∥ : f.le_op_norm _ - ... ≤ ∥f∥ * ∏ i, (∥g∥ * ∥m i∥) : begin + calc ‖f (g ∘ m)‖ ≤ + ‖f‖ * ∏ i, ‖g (m i)‖ : f.le_op_norm _ + ... ≤ ‖f‖ * ∏ i, (‖g‖ * ‖m i‖) : begin apply mul_le_mul_of_nonneg_left _ (norm_nonneg _), exact finset.prod_le_prod (λ i hi, norm_nonneg _) (λ i hi, g.le_op_norm _) end - ... = ∥g∥ ^ fintype.card ι * ∥f∥ * ∏ i, ∥m i∥ : + ... = ‖g‖ ^ fintype.card ι * ‖f‖ * ∏ i, ‖m i‖ : by { simp [finset.prod_mul_distrib, finset.card_univ], ring } end @@ -233,16 +237,16 @@ namespace continuous_linear_map If `f` is a continuuous bilinear map, to use the corresponding rules for the second argument, use `(f _).map_add` and similar. - We have to assume that `F` and `G` are normed spaces in this section, to use - `continuous_linear_map.to_normed_group`, but we don't need to assume this for the first argument - of `f`. +We have to assume that `F` and `G` are normed spaces in this section, to use +`continuous_linear_map.to_normed_add_comm_group`, but we don't need to assume this for the first +argument of `f`. -/ variables {R : Type*} -variables {𝕜₂ 𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [nondiscrete_normed_field 𝕜₂] +variables {𝕜₂ 𝕜' : Type*} [nontrivially_normed_field 𝕜'] [nontrivially_normed_field 𝕜₂] variables {M : Type*} [topological_space M] -variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] -variables {G' : Type*} [normed_group G'] [normed_space 𝕜₂ G'] [normed_space 𝕜' G'] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} +variables {G' : Type*} [normed_add_comm_group G'] [normed_space 𝕜₂ G'] [normed_space 𝕜' G'] variables [smul_comm_class 𝕜₂ 𝕜' G'] section semiring @@ -287,7 +291,7 @@ structure is_bounded_bilinear_map (f : E × F → G) : Prop := (smul_left : ∀ (c : 𝕜) (x : E) (y : F), f (c • x, y) = c • f (x, y)) (add_right : ∀ (x : E) (y₁ y₂ : F), f (x, y₁ + y₂) = f (x, y₁) + f (x, y₂)) (smul_right : ∀ (c : 𝕜) (x : E) (y : F), f (x, c • y) = c • f (x,y)) -(bound : ∃ C > 0, ∀ (x : E) (y : F), ∥f (x, y)∥ ≤ C * ∥x∥ * ∥y∥) +(bound : ∃ C > 0, ∀ (x : E) (y : F), ‖f (x, y)‖ ≤ C * ‖x‖ * ‖y‖) variable {𝕜} variable {f : E × F → G} @@ -298,23 +302,24 @@ lemma continuous_linear_map.is_bounded_bilinear_map (f : E →L[𝕜] F →L[ smul_left := f.map_smul₂, add_right := λ x, (f x).map_add, smul_right := λ c x, (f x).map_smul c, - bound := ⟨max ∥f∥ 1, zero_lt_one.trans_le (le_max_right _ _), + bound := ⟨max ‖f‖ 1, zero_lt_one.trans_le (le_max_right _ _), λ x y, (f.le_op_norm₂ x y).trans $ by apply_rules [mul_le_mul_of_nonneg_right, norm_nonneg, le_max_left]⟩ } protected lemma is_bounded_bilinear_map.is_O (h : is_bounded_bilinear_map 𝕜 f) : - asymptotics.is_O f (λ p : E × F, ∥p.1∥ * ∥p.2∥) ⊤ := + f =O[⊤] (λ p : E × F, ‖p.1‖ * ‖p.2‖) := let ⟨C, Cpos, hC⟩ := h.bound in asymptotics.is_O.of_bound _ $ filter.eventually_of_forall $ λ ⟨x, y⟩, by simpa [mul_assoc] using hC x y lemma is_bounded_bilinear_map.is_O_comp {α : Type*} (H : is_bounded_bilinear_map 𝕜 f) {g : α → E} {h : α → F} {l : filter α} : - asymptotics.is_O (λ x, f (g x, h x)) (λ x, ∥g x∥ * ∥h x∥) l := + (λ x, f (g x, h x)) =O[l] (λ x, ‖g x‖ * ‖h x‖) := H.is_O.comp_tendsto le_top protected lemma is_bounded_bilinear_map.is_O' (h : is_bounded_bilinear_map 𝕜 f) : - asymptotics.is_O f (λ p : E × F, ∥p∥ * ∥p∥) ⊤ := -h.is_O.trans (asymptotics.is_O_fst_prod'.norm_norm.mul asymptotics.is_O_snd_prod'.norm_norm) + f =O[⊤] (λ p : E × F, ‖p‖ * ‖p‖) := +h.is_O.trans $ (@asymptotics.is_O_fst_prod' _ E F _ _ _ _).norm_norm.mul + (@asymptotics.is_O_snd_prod' _ E F _ _ _ _).norm_norm lemma is_bounded_bilinear_map.map_sub_left (h : is_bounded_bilinear_map 𝕜 f) {x y : E} {z : F} : f (x - y, z) = f (x, z) - f(y, z) := @@ -336,16 +341,16 @@ begin obtain ⟨C, (Cpos : 0 < C), hC⟩ := h.bound, rw continuous_iff_continuous_at, intros x, - have H : ∀ (a:E) (b:F), ∥f (a, b)∥ ≤ C * ∥∥a∥ * ∥b∥∥, + have H : ∀ (a:E) (b:F), ‖f (a, b)‖ ≤ C * ‖‖a‖ * ‖b‖‖, { intros a b, simpa [mul_assoc] using hC a b }, - have h₁ : asymptotics.is_o (λ e : E × F, f (e.1 - x.1, e.2)) (λ e, (1:ℝ)) (𝓝 x), + have h₁ : (λ e : E × F, f (e.1 - x.1, e.2)) =o[𝓝 x] (λ e, (1:ℝ)), { refine (asymptotics.is_O_of_le' (𝓝 x) (λ e, H (e.1 - x.1) e.2)).trans_is_o _, rw asymptotics.is_o_const_iff one_ne, convert ((continuous_fst.sub continuous_const).norm.mul continuous_snd.norm).continuous_at, { simp }, apply_instance }, - have h₂ : asymptotics.is_o (λ e : E × F, f (x.1, e.2 - x.2)) (λ e, (1:ℝ)) (𝓝 x), + have h₂ : (λ e : E × F, f (x.1, e.2 - x.2)) =o[𝓝 x] (λ e, (1:ℝ)), { refine (asymptotics.is_O_of_le' (𝓝 x) (λ e, H x.1 (e.2 - x.2))).trans_is_o _, rw asymptotics.is_o_const_iff one_ne, convert (continuous_const.mul (continuous_snd.sub continuous_const).norm).continuous_at, @@ -379,12 +384,12 @@ lemma is_bounded_bilinear_map.is_bounded_linear_map_left (h : is_bounded_bilinea map_smul := λ c x, h.smul_left _ _ _, bound := begin rcases h.bound with ⟨C, C_pos, hC⟩, - refine ⟨C * (∥y∥ + 1), mul_pos C_pos (lt_of_lt_of_le (zero_lt_one) (by simp)), λ x, _⟩, - have : ∥y∥ ≤ ∥y∥ + 1, by simp [zero_le_one], - calc ∥f (x, y)∥ ≤ C * ∥x∥ * ∥y∥ : hC x y - ... ≤ C * ∥x∥ * (∥y∥ + 1) : + refine ⟨C * (‖y‖ + 1), mul_pos C_pos (lt_of_lt_of_le (zero_lt_one) (by simp)), λ x, _⟩, + have : ‖y‖ ≤ ‖y‖ + 1, by simp [zero_le_one], + calc ‖f (x, y)‖ ≤ C * ‖x‖ * ‖y‖ : hC x y + ... ≤ C * ‖x‖ * (‖y‖ + 1) : by apply_rules [norm_nonneg, mul_le_mul_of_nonneg_left, le_of_lt C_pos, mul_nonneg] - ... = C * (∥y∥ + 1) * ∥x∥ : by ring + ... = C * (‖y‖ + 1) * ‖x‖ : by ring end } lemma is_bounded_bilinear_map.is_bounded_linear_map_right @@ -394,62 +399,39 @@ lemma is_bounded_bilinear_map.is_bounded_linear_map_right map_smul := λ c y, h.smul_right _ _ _, bound := begin rcases h.bound with ⟨C, C_pos, hC⟩, - refine ⟨C * (∥x∥ + 1), mul_pos C_pos (lt_of_lt_of_le (zero_lt_one) (by simp)), λ y, _⟩, - have : ∥x∥ ≤ ∥x∥ + 1, by simp [zero_le_one], - calc ∥f (x, y)∥ ≤ C * ∥x∥ * ∥y∥ : hC x y - ... ≤ C * (∥x∥ + 1) * ∥y∥ : + refine ⟨C * (‖x‖ + 1), mul_pos C_pos (lt_of_lt_of_le (zero_lt_one) (by simp)), λ y, _⟩, + have : ‖x‖ ≤ ‖x‖ + 1, by simp [zero_le_one], + calc ‖f (x, y)‖ ≤ C * ‖x‖ * ‖y‖ : hC x y + ... ≤ C * (‖x‖ + 1) * ‖y‖ : by apply_rules [mul_le_mul_of_nonneg_right, norm_nonneg, mul_le_mul_of_nonneg_left, le_of_lt C_pos] end } lemma is_bounded_bilinear_map_smul {𝕜' : Type*} [normed_field 𝕜'] - [normed_algebra 𝕜 𝕜'] {E : Type*} [normed_group E] [normed_space 𝕜 E] [normed_space 𝕜' E] + [normed_algebra 𝕜 𝕜'] {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [normed_space 𝕜' E] [is_scalar_tower 𝕜 𝕜' E] : is_bounded_bilinear_map 𝕜 (λ (p : 𝕜' × E), p.1 • p.2) := -{ add_left := add_smul, - smul_left := λ c x y, by simp [smul_assoc], - add_right := smul_add, - smul_right := λ c x y, by simp [smul_assoc, smul_algebra_smul_comm], - bound := ⟨1, zero_lt_one, λ x y, by simp [norm_smul] ⟩ } +(lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] E →L[𝕜] E).is_bounded_bilinear_map lemma is_bounded_bilinear_map_mul : is_bounded_bilinear_map 𝕜 (λ (p : 𝕜 × 𝕜), p.1 * p.2) := by simp_rw ← smul_eq_mul; exact is_bounded_bilinear_map_smul lemma is_bounded_bilinear_map_comp : - is_bounded_bilinear_map 𝕜 (λ (p : (E →L[𝕜] F) × (F →L[𝕜] G)), p.2.comp p.1) := -{ add_left := λ x₁ x₂ y, begin - ext z, - change y (x₁ z + x₂ z) = y (x₁ z) + y (x₂ z), - rw y.map_add - end, - smul_left := λ c x y, begin - ext z, - change y (c • (x z)) = c • y (x z), - rw continuous_linear_map.map_smul - end, - add_right := λ x y₁ y₂, rfl, - smul_right := λ c x y, rfl, - bound := ⟨1, zero_lt_one, λ x y, calc - ∥continuous_linear_map.comp ((x, y).snd) ((x, y).fst)∥ - ≤ ∥y∥ * ∥x∥ : continuous_linear_map.op_norm_comp_le _ _ - ... = 1 * ∥x∥ * ∥ y∥ : by ring ⟩ } + is_bounded_bilinear_map 𝕜 (λ (p : (F →L[𝕜] G) × (E →L[𝕜] F)), p.1.comp p.2) := +(compL 𝕜 E F G).is_bounded_bilinear_map lemma continuous_linear_map.is_bounded_linear_map_comp_left (g : F →L[𝕜] G) : is_bounded_linear_map 𝕜 (λ (f : E →L[𝕜] F), continuous_linear_map.comp g f) := -is_bounded_bilinear_map_comp.is_bounded_linear_map_left _ +is_bounded_bilinear_map_comp.is_bounded_linear_map_right _ lemma continuous_linear_map.is_bounded_linear_map_comp_right (f : E →L[𝕜] F) : is_bounded_linear_map 𝕜 (λ (g : F →L[𝕜] G), continuous_linear_map.comp g f) := -is_bounded_bilinear_map_comp.is_bounded_linear_map_right _ +is_bounded_bilinear_map_comp.is_bounded_linear_map_left _ lemma is_bounded_bilinear_map_apply : is_bounded_bilinear_map 𝕜 (λ p : (E →L[𝕜] F) × E, p.1 p.2) := -{ add_left := by simp, - smul_left := by simp, - add_right := by simp, - smul_right := by simp, - bound := ⟨1, zero_lt_one, by simp [continuous_linear_map.le_op_norm]⟩ } +(continuous_linear_map.flip (apply 𝕜 F : E →L[𝕜] (E →L[𝕜] F) →L[𝕜] F)).is_bounded_bilinear_map /-- The function `continuous_linear_map.smul_right`, associating to a continuous linear map `f : E → 𝕜` and a scalar `c : F` the tensor product `f ⊗ c` as a continuous linear map from `E` to @@ -457,30 +439,15 @@ lemma is_bounded_bilinear_map_apply : lemma is_bounded_bilinear_map_smul_right : is_bounded_bilinear_map 𝕜 (λ p, (continuous_linear_map.smul_right : (E →L[𝕜] 𝕜) → F → (E →L[𝕜] F)) p.1 p.2) := -{ add_left := λ m₁ m₂ f, by { ext z, simp [add_smul] }, - smul_left := λ c m f, by { ext z, simp [mul_smul] }, - add_right := λ m f₁ f₂, by { ext z, simp [smul_add] }, - smul_right := λ c m f, by { ext z, simp [smul_smul, mul_comm] }, - bound := ⟨1, zero_lt_one, λ m f, by simp⟩ } +(smul_rightL 𝕜 E F).is_bounded_bilinear_map /-- The composition of a continuous linear map with a continuous multilinear map is a bounded bilinear operation. -/ lemma is_bounded_bilinear_map_comp_multilinear {ι : Type*} {E : ι → Type*} -[decidable_eq ι] [fintype ι] [∀ i, normed_group (E i)] [∀ i, normed_space 𝕜 (E i)] : + [fintype ι] [∀ i, normed_add_comm_group (E i)] [∀ i, normed_space 𝕜 (E i)] : is_bounded_bilinear_map 𝕜 (λ p : (F →L[𝕜] G) × (continuous_multilinear_map 𝕜 E F), p.1.comp_continuous_multilinear_map p.2) := -{ add_left := λ g₁ g₂ f, by { ext m, refl }, - smul_left := λ c g f, by { ext m, refl }, - add_right := λ g f₁ f₂, by { ext m, simp }, - smul_right := λ c g f, by { ext m, simp }, - bound := ⟨1, zero_lt_one, λ g f, begin - apply continuous_multilinear_map.op_norm_le_bound _ _ (λ m, _), - { apply_rules [mul_nonneg, zero_le_one, norm_nonneg] }, - calc ∥g (f m)∥ ≤ ∥g∥ * ∥f m∥ : g.le_op_norm _ - ... ≤ ∥g∥ * (∥f∥ * ∏ i, ∥m i∥) : - mul_le_mul_of_nonneg_left (f.le_op_norm _) (norm_nonneg _) - ... = 1 * ∥g∥ * ∥f∥ * ∏ i, ∥m i∥ : by ring - end⟩ } +(comp_continuous_multilinear_mapL 𝕜 E F G).is_bounded_bilinear_map /-- Definition of the derivative of a bilinear map `f`, given at a point `p` by `q ↦ f(p.1, q.2) + f(q.1, p.2)` as in the standard formula for the derivative of a product. @@ -506,17 +473,17 @@ from `E × F` to `G`. The statement that this is indeed the derivative of `f` is def is_bounded_bilinear_map.deriv (h : is_bounded_bilinear_map 𝕜 f) (p : E × F) : E × F →L[𝕜] G := (h.linear_deriv p).mk_continuous_of_exists_bound $ begin rcases h.bound with ⟨C, Cpos, hC⟩, - refine ⟨C * ∥p.1∥ + C * ∥p.2∥, λ q, _⟩, - calc ∥f (p.1, q.2) + f (q.1, p.2)∥ - ≤ C * ∥p.1∥ * ∥q.2∥ + C * ∥q.1∥ * ∥p.2∥ : norm_add_le_of_le (hC _ _) (hC _ _) - ... ≤ C * ∥p.1∥ * ∥q∥ + C * ∥q∥ * ∥p.2∥ : begin + refine ⟨C * ‖p.1‖ + C * ‖p.2‖, λ q, _⟩, + calc ‖f (p.1, q.2) + f (q.1, p.2)‖ + ≤ C * ‖p.1‖ * ‖q.2‖ + C * ‖q.1‖ * ‖p.2‖ : norm_add_le_of_le (hC _ _) (hC _ _) + ... ≤ C * ‖p.1‖ * ‖q‖ + C * ‖q‖ * ‖p.2‖ : begin apply add_le_add, exact mul_le_mul_of_nonneg_left (le_max_right _ _) (mul_nonneg (le_of_lt Cpos) (norm_nonneg _)), apply mul_le_mul_of_nonneg_right _ (norm_nonneg _), exact mul_le_mul_of_nonneg_left (le_max_left _ _) (le_of_lt Cpos), end - ... = (C * ∥p.1∥ + C * ∥p.2∥) * ∥q∥ : by ring + ... = (C * ‖p.1‖ + C * ‖p.2‖) * ‖q‖ : by ring end @[simp] lemma is_bounded_bilinear_map_deriv_coe (h : is_bounded_bilinear_map 𝕜 f) (p q : E × F) : @@ -524,11 +491,12 @@ end variables (𝕜) -/-- The function `lmul_left_right : 𝕜' × 𝕜' → (𝕜' →L[𝕜] 𝕜')` is a bounded bilinear map. -/ -lemma continuous_linear_map.lmul_left_right_is_bounded_bilinear +/-- The function `continuous_linear_map.mul_left_right : 𝕜' × 𝕜' → (𝕜' →L[𝕜] 𝕜')` is a bounded +bilinear map. -/ +lemma continuous_linear_map.mul_left_right_is_bounded_bilinear (𝕜' : Type*) [normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] : - is_bounded_bilinear_map 𝕜 (λ p : 𝕜' × 𝕜', continuous_linear_map.lmul_left_right 𝕜 𝕜' p.1 p.2) := -(continuous_linear_map.lmul_left_right 𝕜 𝕜').is_bounded_bilinear_map + is_bounded_bilinear_map 𝕜 (λ p : 𝕜' × 𝕜', continuous_linear_map.mul_left_right 𝕜 𝕜' p.1 p.2) := +(continuous_linear_map.mul_left_right 𝕜 𝕜').is_bounded_bilinear_map variables {𝕜} @@ -539,19 +507,31 @@ lemma is_bounded_bilinear_map.is_bounded_linear_map_deriv (h : is_bounded_biline begin rcases h.bound with ⟨C, Cpos : 0 < C, hC⟩, refine is_linear_map.with_bound ⟨λ p₁ p₂, _, λ c p, _⟩ (C + C) (λ p, _), - { ext; simp [h.add_left, h.add_right]; abel }, - { ext; simp [h.smul_left, h.smul_right, smul_add] }, + { ext; simp only [h.add_left, h.add_right, coe_comp', function.comp_app, inl_apply, + is_bounded_bilinear_map_deriv_coe, prod.fst_add, prod.snd_add, add_apply]; abel }, + { ext; simp only [h.smul_left, h.smul_right, smul_add, coe_comp', function.comp_app, + is_bounded_bilinear_map_deriv_coe, prod.smul_fst, prod.smul_snd, coe_smul', pi.smul_apply] }, { refine continuous_linear_map.op_norm_le_bound _ (mul_nonneg (add_nonneg Cpos.le Cpos.le) (norm_nonneg _)) (λ q, _), - calc ∥f (p.1, q.2) + f (q.1, p.2)∥ - ≤ C * ∥p.1∥ * ∥q.2∥ + C * ∥q.1∥ * ∥p.2∥ : norm_add_le_of_le (hC _ _) (hC _ _) - ... ≤ C * ∥p∥ * ∥q∥ + C * ∥q∥ * ∥p∥ : by apply_rules [add_le_add, mul_le_mul, norm_nonneg, + calc ‖f (p.1, q.2) + f (q.1, p.2)‖ + ≤ C * ‖p.1‖ * ‖q.2‖ + C * ‖q.1‖ * ‖p.2‖ : norm_add_le_of_le (hC _ _) (hC _ _) + ... ≤ C * ‖p‖ * ‖q‖ + C * ‖q‖ * ‖p‖ : by apply_rules [add_le_add, mul_le_mul, norm_nonneg, Cpos.le, le_refl, le_max_left, le_max_right, mul_nonneg] - ... = (C + C) * ∥p∥ * ∥q∥ : by ring }, + ... = (C + C) * ‖p‖ * ‖q‖ : by ring }, end end bilinear_map +lemma continuous.clm_comp {X} [topological_space X] {g : X → F →L[𝕜] G} {f : X → E →L[𝕜] F} + (hg : continuous g) (hf : continuous f) : + continuous (λ x, (g x).comp (f x)) := +(compL 𝕜 E F G).continuous₂.comp₂ hg hf + +lemma continuous_on.clm_comp {X} [topological_space X] {g : X → F →L[𝕜] G} {f : X → E →L[𝕜] F} + {s : set X} (hg : continuous_on g s) (hf : continuous_on f s) : + continuous_on (λ x, (g x).comp (f x)) s := +(compL 𝕜 E F G).continuous₂.comp_continuous_on (hg.prod hf) + namespace continuous_linear_equiv open set @@ -568,8 +548,8 @@ begin rw [is_open_iff_mem_nhds, forall_range_iff], refine λ e, is_open.mem_nhds _ (mem_range_self _), let O : (E →L[𝕜] F) → (E →L[𝕜] E) := λ f, (e.symm : F →L[𝕜] E).comp f, - have h_O : continuous O := is_bounded_bilinear_map_comp.continuous_left, - convert units.is_open.preimage h_O using 1, + have h_O : continuous O := is_bounded_bilinear_map_comp.continuous_right, + convert show is_open (O ⁻¹' {x | is_unit x}), from units.is_open.preimage h_O using 1, ext f', split, { rintros ⟨e', rfl⟩, diff --git a/src/analysis/normed_space/compact_operator.lean b/src/analysis/normed_space/compact_operator.lean new file mode 100644 index 0000000000000..3561553dd0bce --- /dev/null +++ b/src/analysis/normed_space/compact_operator.lean @@ -0,0 +1,429 @@ +/- +Copyright (c) 2022 Anatole Dedecker. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anatole Dedecker +-/ +import analysis.locally_convex.bounded +import topology.algebra.module.strong_topology + +/-! +# Compact operators + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define compact linear operators between two topological vector spaces (TVS). + +## Main definitions + +* `is_compact_operator` : predicate for compact operators + +## Main statements + +* `is_compact_operator_iff_is_compact_closure_image_closed_ball` : the usual characterization of + compact operators from a normed space to a T2 TVS. +* `is_compact_operator.comp_clm` : precomposing a compact operator by a continuous linear map gives + a compact operator +* `is_compact_operator.clm_comp` : postcomposing a compact operator by a continuous linear map + gives a compact operator +* `is_compact_operator.continuous` : compact operators are automatically continuous +* `is_closed_set_of_is_compact_operator` : the set of compact operators is closed for the operator + norm + +## Implementation details + +We define `is_compact_operator` as a predicate, because the space of compact operators inherits all +of its structure from the space of continuous linear maps (e.g we want to have the usual operator +norm on compact operators). + +The two natural options then would be to make it a predicate over linear maps or continuous linear +maps. Instead we define it as a predicate over bare functions, although it really only makes sense +for linear functions, because Lean is really good at finding coercions to bare functions (whereas +coercing from continuous linear maps to linear maps often needs type ascriptions). + +## References + +* Bourbaki, *Spectral Theory*, chapters 3 to 5, to be published (2022) + +## Tags + +Compact operator +-/ + +open function set filter bornology metric + +open_locale pointwise big_operators topology + +/-- A compact operator between two topological vector spaces. This definition is usually +given as "there exists a neighborhood of zero whose image is contained in a compact set", +but we choose a definition which involves fewer existential quantifiers and replaces images +with preimages. + +We prove the equivalence in `is_compact_operator_iff_exists_mem_nhds_image_subset_compact`. -/ +def is_compact_operator {M₁ M₂ : Type*} [has_zero M₁] [topological_space M₁] + [topological_space M₂] (f : M₁ → M₂) : Prop := +∃ K, is_compact K ∧ f ⁻¹' K ∈ (𝓝 0 : filter M₁) + +lemma is_compact_operator_zero {M₁ M₂ : Type*} [has_zero M₁] [topological_space M₁] + [topological_space M₂] [has_zero M₂] : is_compact_operator (0 : M₁ → M₂) := +⟨{0}, is_compact_singleton, mem_of_superset univ_mem (λ x _, rfl)⟩ + +section characterizations + +section + +variables {R₁ R₂ : Type*} [semiring R₁] [semiring R₂] {σ₁₂ : R₁ →+* R₂} {M₁ M₂ : Type*} + [topological_space M₁] [add_comm_monoid M₁] [topological_space M₂] + +lemma is_compact_operator_iff_exists_mem_nhds_image_subset_compact (f : M₁ → M₂) : + is_compact_operator f ↔ ∃ V ∈ (𝓝 0 : filter M₁), ∃ (K : set M₂), is_compact K ∧ f '' V ⊆ K := +⟨λ ⟨K, hK, hKf⟩, ⟨f ⁻¹' K, hKf, K, hK, image_preimage_subset _ _⟩, + λ ⟨V, hV, K, hK, hVK⟩, ⟨K, hK, mem_of_superset hV (image_subset_iff.mp hVK)⟩⟩ + +lemma is_compact_operator_iff_exists_mem_nhds_is_compact_closure_image [t2_space M₂] + (f : M₁ → M₂) : + is_compact_operator f ↔ ∃ V ∈ (𝓝 0 : filter M₁), is_compact (closure $ f '' V) := +begin + rw is_compact_operator_iff_exists_mem_nhds_image_subset_compact, + exact ⟨λ ⟨V, hV, K, hK, hKV⟩, ⟨V, hV, is_compact_closure_of_subset_compact hK hKV⟩, + λ ⟨V, hV, hVc⟩, ⟨V, hV, closure (f '' V), hVc, subset_closure⟩⟩, +end + +end + +section bounded + +variables {𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] [semi_normed_ring 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} + {M₁ M₂ : Type*} [topological_space M₁] [add_comm_monoid M₁] [topological_space M₂] + [add_comm_monoid M₂] [module 𝕜₁ M₁] [module 𝕜₂ M₂] [has_continuous_const_smul 𝕜₂ M₂] + +lemma is_compact_operator.image_subset_compact_of_vonN_bounded {f : M₁ →ₛₗ[σ₁₂] M₂} + (hf : is_compact_operator f) {S : set M₁} (hS : is_vonN_bounded 𝕜₁ S) : + ∃ (K : set M₂), is_compact K ∧ f '' S ⊆ K := +let ⟨K, hK, hKf⟩ := hf, + ⟨r, hr, hrS⟩ := hS hKf, + ⟨c, hc⟩ := normed_field.exists_lt_norm 𝕜₁ r, + this := ne_zero_of_norm_ne_zero (hr.trans hc).ne.symm in +⟨σ₁₂ c • K, hK.image $ continuous_id.const_smul (σ₁₂ c), + by rw [image_subset_iff, preimage_smul_setₛₗ _ _ _ f this.is_unit]; exact hrS c hc.le⟩ + +lemma is_compact_operator.is_compact_closure_image_of_vonN_bounded [t2_space M₂] + {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) {S : set M₁} + (hS : is_vonN_bounded 𝕜₁ S) : is_compact (closure $ f '' S) := +let ⟨K, hK, hKf⟩ := hf.image_subset_compact_of_vonN_bounded hS in +is_compact_closure_of_subset_compact hK hKf + +end bounded + +section normed_space + +variables {𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] [semi_normed_ring 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} + {M₁ M₂ M₃ : Type*} [seminormed_add_comm_group M₁] [topological_space M₂] + [add_comm_monoid M₂] [normed_space 𝕜₁ M₁] [module 𝕜₂ M₂] + +lemma is_compact_operator.image_subset_compact_of_bounded [has_continuous_const_smul 𝕜₂ M₂] + {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) {S : set M₁} (hS : metric.bounded S) : + ∃ (K : set M₂), is_compact K ∧ f '' S ⊆ K := +hf.image_subset_compact_of_vonN_bounded +(by rwa [normed_space.is_vonN_bounded_iff, ← metric.bounded_iff_is_bounded]) + +lemma is_compact_operator.is_compact_closure_image_of_bounded [has_continuous_const_smul 𝕜₂ M₂] + [t2_space M₂] {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) {S : set M₁} + (hS : metric.bounded S) : is_compact (closure $ f '' S) := +hf.is_compact_closure_image_of_vonN_bounded +(by rwa [normed_space.is_vonN_bounded_iff, ← metric.bounded_iff_is_bounded]) + +lemma is_compact_operator.image_ball_subset_compact [has_continuous_const_smul 𝕜₂ M₂] + {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) (r : ℝ) : + ∃ (K : set M₂), is_compact K ∧ f '' metric.ball 0 r ⊆ K := +hf.image_subset_compact_of_vonN_bounded (normed_space.is_vonN_bounded_ball 𝕜₁ M₁ r) + +lemma is_compact_operator.image_closed_ball_subset_compact [has_continuous_const_smul 𝕜₂ M₂] + {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) (r : ℝ) : + ∃ (K : set M₂), is_compact K ∧ f '' metric.closed_ball 0 r ⊆ K := +hf.image_subset_compact_of_vonN_bounded (normed_space.is_vonN_bounded_closed_ball 𝕜₁ M₁ r) + +lemma is_compact_operator.is_compact_closure_image_ball [has_continuous_const_smul 𝕜₂ M₂] + [t2_space M₂] {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) (r : ℝ) : + is_compact (closure $ f '' metric.ball 0 r) := +hf.is_compact_closure_image_of_vonN_bounded (normed_space.is_vonN_bounded_ball 𝕜₁ M₁ r) + +lemma is_compact_operator.is_compact_closure_image_closed_ball [has_continuous_const_smul 𝕜₂ M₂] + [t2_space M₂] {f : M₁ →ₛₗ[σ₁₂] M₂} (hf : is_compact_operator f) (r : ℝ) : + is_compact (closure $ f '' metric.closed_ball 0 r) := +hf.is_compact_closure_image_of_vonN_bounded (normed_space.is_vonN_bounded_closed_ball 𝕜₁ M₁ r) + +lemma is_compact_operator_iff_image_ball_subset_compact [has_continuous_const_smul 𝕜₂ M₂] + (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) : + is_compact_operator f ↔ ∃ (K : set M₂), is_compact K ∧ f '' metric.ball 0 r ⊆ K := +⟨λ hf, hf.image_ball_subset_compact r, + λ ⟨K, hK, hKr⟩, (is_compact_operator_iff_exists_mem_nhds_image_subset_compact f).mpr + ⟨metric.ball 0 r, ball_mem_nhds _ hr, K, hK, hKr⟩⟩ + +lemma is_compact_operator_iff_image_closed_ball_subset_compact [has_continuous_const_smul 𝕜₂ M₂] + (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) : + is_compact_operator f ↔ ∃ (K : set M₂), is_compact K ∧ f '' metric.closed_ball 0 r ⊆ K := +⟨λ hf, hf.image_closed_ball_subset_compact r, + λ ⟨K, hK, hKr⟩, (is_compact_operator_iff_exists_mem_nhds_image_subset_compact f).mpr + ⟨metric.closed_ball 0 r, closed_ball_mem_nhds _ hr, K, hK, hKr⟩⟩ + +lemma is_compact_operator_iff_is_compact_closure_image_ball [has_continuous_const_smul 𝕜₂ M₂] + [t2_space M₂] (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) : + is_compact_operator f ↔ is_compact (closure $ f '' metric.ball 0 r) := +⟨λ hf, hf.is_compact_closure_image_ball r, + λ hf, (is_compact_operator_iff_exists_mem_nhds_is_compact_closure_image f).mpr + ⟨metric.ball 0 r, ball_mem_nhds _ hr, hf⟩⟩ + +lemma is_compact_operator_iff_is_compact_closure_image_closed_ball + [has_continuous_const_smul 𝕜₂ M₂] [t2_space M₂] (f : M₁ →ₛₗ[σ₁₂] M₂) {r : ℝ} (hr : 0 < r) : + is_compact_operator f ↔ is_compact (closure $ f '' metric.closed_ball 0 r) := +⟨λ hf, hf.is_compact_closure_image_closed_ball r, + λ hf, (is_compact_operator_iff_exists_mem_nhds_is_compact_closure_image f).mpr + ⟨metric.closed_ball 0 r, closed_ball_mem_nhds _ hr, hf⟩⟩ + +end normed_space + +end characterizations + +section operations + +variables {R₁ R₂ R₃ R₄ : Type*} [semiring R₁] [semiring R₂] [comm_semiring R₃] [comm_semiring R₄] + {σ₁₂ : R₁ →+* R₂} {σ₁₄ : R₁ →+* R₄} {σ₃₄ : R₃ →+* R₄} {M₁ M₂ M₃ M₄ : Type*} + [topological_space M₁] [add_comm_monoid M₁] [topological_space M₂] [add_comm_monoid M₂] + [topological_space M₃] [add_comm_group M₃] [topological_space M₄] [add_comm_group M₄] + +lemma is_compact_operator.smul {S : Type*} [monoid S] [distrib_mul_action S M₂] + [has_continuous_const_smul S M₂] {f : M₁ → M₂} + (hf : is_compact_operator f) (c : S) : + is_compact_operator (c • f) := +let ⟨K, hK, hKf⟩ := hf in ⟨c • K, hK.image $ continuous_id.const_smul c, + mem_of_superset hKf (λ x hx, smul_mem_smul_set hx)⟩ + +lemma is_compact_operator.add [has_continuous_add M₂] {f g : M₁ → M₂} + (hf : is_compact_operator f) (hg : is_compact_operator g) : + is_compact_operator (f + g) := +let ⟨A, hA, hAf⟩ := hf, ⟨B, hB, hBg⟩ := hg in +⟨A + B, hA.add hB, mem_of_superset (inter_mem hAf hBg) (λ x ⟨hxA, hxB⟩, set.add_mem_add hxA hxB)⟩ + +lemma is_compact_operator.neg [has_continuous_neg M₄] {f : M₁ → M₄} + (hf : is_compact_operator f) : is_compact_operator (-f) := +let ⟨K, hK, hKf⟩ := hf in +⟨-K, hK.neg, mem_of_superset hKf $ λ x (hx : f x ∈ K), set.neg_mem_neg.mpr hx⟩ + +lemma is_compact_operator.sub [topological_add_group M₄] {f g : M₁ → M₄} + (hf : is_compact_operator f) (hg : is_compact_operator g) : is_compact_operator (f - g) := +by rw sub_eq_add_neg; exact hf.add hg.neg + +variables (σ₁₄ M₁ M₄) + +/-- The submodule of compact continuous linear maps. -/ +def compact_operator [module R₁ M₁] [module R₄ M₄] [has_continuous_const_smul R₄ M₄] + [topological_add_group M₄] : + submodule R₄ (M₁ →SL[σ₁₄] M₄) := +{ carrier := {f | is_compact_operator f}, + add_mem' := λ f g hf hg, hf.add hg, + zero_mem' := is_compact_operator_zero, + smul_mem' := λ c f hf, hf.smul c } + +end operations + +section comp + +variables {R₁ R₂ R₃ : Type*} [semiring R₁] [semiring R₂] [semiring R₃] {σ₁₂ : R₁ →+* R₂} + {σ₂₃ : R₂ →+* R₃} {M₁ M₂ M₃ : Type*} [topological_space M₁] [topological_space M₂] + [topological_space M₃] [add_comm_monoid M₁] [module R₁ M₁] + +lemma is_compact_operator.comp_clm [add_comm_monoid M₂] [module R₂ M₂] {f : M₂ → M₃} + (hf : is_compact_operator f) (g : M₁ →SL[σ₁₂] M₂) : + is_compact_operator (f ∘ g) := +begin + have := g.continuous.tendsto 0, + rw map_zero at this, + rcases hf with ⟨K, hK, hKf⟩, + exact ⟨K, hK, this hKf⟩ +end + +lemma is_compact_operator.continuous_comp {f : M₁ → M₂} (hf : is_compact_operator f) {g : M₂ → M₃} + (hg : continuous g) : + is_compact_operator (g ∘ f) := +begin + rcases hf with ⟨K, hK, hKf⟩, + refine ⟨g '' K, hK.image hg, mem_of_superset hKf _⟩, + nth_rewrite 1 preimage_comp, + exact preimage_mono (subset_preimage_image _ _) +end + +lemma is_compact_operator.clm_comp [add_comm_monoid M₂] [module R₂ M₂] [add_comm_monoid M₃] + [module R₃ M₃] {f : M₁ → M₂} (hf : is_compact_operator f) (g : M₂ →SL[σ₂₃] M₃) : + is_compact_operator (g ∘ f) := +hf.continuous_comp g.continuous + +end comp + +section cod_restrict + +variables {R₁ R₂ : Type*} [semiring R₁] [semiring R₂] {σ₁₂ : R₁ →+* R₂} + {M₁ M₂ : Type*} [topological_space M₁] [topological_space M₂] + [add_comm_monoid M₁] [add_comm_monoid M₂] [module R₁ M₁] [module R₂ M₂] + +lemma is_compact_operator.cod_restrict {f : M₁ → M₂} (hf : is_compact_operator f) + {V : submodule R₂ M₂} (hV : ∀ x, f x ∈ V) (h_closed : is_closed (V : set M₂)): + is_compact_operator (set.cod_restrict f V hV) := +let ⟨K, hK, hKf⟩ := hf in +⟨coe ⁻¹' K, (closed_embedding_subtype_coe h_closed).is_compact_preimage hK, hKf⟩ + +end cod_restrict + +section restrict + +variables {R₁ R₂ R₃ : Type*} [semiring R₁] [semiring R₂] [semiring R₃] {σ₁₂ : R₁ →+* R₂} + {σ₂₃ : R₂ →+* R₃} {M₁ M₂ M₃ : Type*} [topological_space M₁] [uniform_space M₂] + [topological_space M₃] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃] + [module R₁ M₁] [module R₂ M₂] [module R₃ M₃] + +/-- If a compact operator preserves a closed submodule, its restriction to that submodule is +compact. + +Note that, following mathlib's convention in linear algebra, `restrict` designates the restriction +of an endomorphism `f : E →ₗ E` to an endomorphism `f' : ↥V →ₗ ↥V`. To prove that the restriction +`f' : ↥U →ₛₗ ↥V` of a compact operator `f : E →ₛₗ F` is compact, apply +`is_compact_operator.cod_restrict` to `f ∘ U.subtypeL`, which is compact by +`is_compact_operator.comp_clm`. -/ +lemma is_compact_operator.restrict {f : M₁ →ₗ[R₁] M₁} (hf : is_compact_operator f) + {V : submodule R₁ M₁} (hV : ∀ v ∈ V, f v ∈ V) (h_closed : is_closed (V : set M₁)): + is_compact_operator (f.restrict hV) := +(hf.comp_clm V.subtypeL).cod_restrict (set_like.forall.2 hV) h_closed + +/-- If a compact operator preserves a complete submodule, its restriction to that submodule is +compact. + +Note that, following mathlib's convention in linear algebra, `restrict` designates the restriction +of an endomorphism `f : E →ₗ E` to an endomorphism `f' : ↥V →ₗ ↥V`. To prove that the restriction +`f' : ↥U →ₛₗ ↥V` of a compact operator `f : E →ₛₗ F` is compact, apply +`is_compact_operator.cod_restrict` to `f ∘ U.subtypeL`, which is compact by +`is_compact_operator.comp_clm`. -/ +lemma is_compact_operator.restrict' [separated_space M₂] {f : M₂ →ₗ[R₂] M₂} + (hf : is_compact_operator f) {V : submodule R₂ M₂} (hV : ∀ v ∈ V, f v ∈ V) + [hcomplete : complete_space V] : is_compact_operator (f.restrict hV) := +hf.restrict hV (complete_space_coe_iff_is_complete.mp hcomplete).is_closed + +end restrict + +section continuous + +variables {𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜₁ →+* 𝕜₂} [ring_hom_isometric σ₁₂] {M₁ M₂ : Type*} [topological_space M₁] + [add_comm_group M₁] [topological_space M₂] [add_comm_group M₂] [module 𝕜₁ M₁] [module 𝕜₂ M₂] + [topological_add_group M₁] [has_continuous_const_smul 𝕜₁ M₁] + [topological_add_group M₂] [has_continuous_smul 𝕜₂ M₂] + +@[continuity] lemma is_compact_operator.continuous {f : M₁ →ₛₗ[σ₁₂] M₂} + (hf : is_compact_operator f) : continuous f := +begin + letI : uniform_space M₂ := topological_add_group.to_uniform_space _, + haveI : uniform_add_group M₂ := topological_add_comm_group_is_uniform, + -- Since `f` is linear, we only need to show that it is continuous at zero. + -- Let `U` be a neighborhood of `0` in `M₂`. + refine continuous_of_continuous_at_zero f (λ U hU, _), + rw map_zero at hU, + -- The compactness of `f` gives us a compact set `K : set M₂` such that `f ⁻¹' K` is a + -- neighborhood of `0` in `M₁`. + rcases hf with ⟨K, hK, hKf⟩, + -- But any compact set is totally bounded, hence Von-Neumann bounded. Thus, `K` absorbs `U`. + -- This gives `r > 0` such that `∀ a : 𝕜₂, r ≤ ‖a‖ → K ⊆ a • U`. + rcases hK.totally_bounded.is_vonN_bounded 𝕜₂ hU with ⟨r, hr, hrU⟩, + -- Choose `c : 𝕜₂` with `r < ‖c‖`. + rcases normed_field.exists_lt_norm 𝕜₁ r with ⟨c, hc⟩, + have hcnz : c ≠ 0 := ne_zero_of_norm_ne_zero (hr.trans hc).ne.symm, + -- We have `f ⁻¹' ((σ₁₂ c⁻¹) • K) = c⁻¹ • f ⁻¹' K ∈ 𝓝 0`. Thus, showing that + -- `(σ₁₂ c⁻¹) • K ⊆ U` is enough to deduce that `f ⁻¹' U ∈ 𝓝 0`. + suffices : (σ₁₂ $ c⁻¹) • K ⊆ U, + { refine mem_of_superset _ this, + have : is_unit c⁻¹ := hcnz.is_unit.inv, + rwa [mem_map, preimage_smul_setₛₗ _ _ _ f this, set_smul_mem_nhds_zero_iff (inv_ne_zero hcnz)], + apply_instance }, + -- Since `σ₁₂ c⁻¹` = `(σ₁₂ c)⁻¹`, we have to prove that `K ⊆ σ₁₂ c • U`. + rw [map_inv₀, ← subset_set_smul_iff₀ ((map_ne_zero σ₁₂).mpr hcnz)], + -- But `σ₁₂` is isometric, so `‖σ₁₂ c‖ = ‖c‖ > r`, which concludes the argument since + -- `∀ a : 𝕜₂, r ≤ ‖a‖ → K ⊆ a • U`. + refine hrU (σ₁₂ c) _, + rw ring_hom_isometric.is_iso, + exact hc.le +end + +/-- Upgrade a compact `linear_map` to a `continuous_linear_map`. -/ +def continuous_linear_map.mk_of_is_compact_operator {f : M₁ →ₛₗ[σ₁₂] M₂} + (hf : is_compact_operator f) : M₁ →SL[σ₁₂] M₂ := +⟨f, hf.continuous⟩ + +@[simp] lemma continuous_linear_map.mk_of_is_compact_operator_to_linear_map {f : M₁ →ₛₗ[σ₁₂] M₂} + (hf : is_compact_operator f) : + (continuous_linear_map.mk_of_is_compact_operator hf : M₁ →ₛₗ[σ₁₂] M₂) = f := +rfl + +@[simp] lemma continuous_linear_map.coe_mk_of_is_compact_operator {f : M₁ →ₛₗ[σ₁₂] M₂} + (hf : is_compact_operator f) : + (continuous_linear_map.mk_of_is_compact_operator hf : M₁ → M₂) = f := +rfl + +lemma continuous_linear_map.mk_of_is_compact_operator_mem_compact_operator {f : M₁ →ₛₗ[σ₁₂] M₂} + (hf : is_compact_operator f) : + continuous_linear_map.mk_of_is_compact_operator hf ∈ compact_operator σ₁₂ M₁ M₂ := +hf + +end continuous + +/-- The set of compact operators from a normed space to a complete topological vector space is +closed. -/ +lemma is_closed_set_of_is_compact_operator {𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] + [normed_field 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} {M₁ M₂ : Type*} [seminormed_add_comm_group M₁] + [add_comm_group M₂] [normed_space 𝕜₁ M₁] [module 𝕜₂ M₂] [uniform_space M₂] [uniform_add_group M₂] + [has_continuous_const_smul 𝕜₂ M₂] [t2_space M₂] [complete_space M₂] : + is_closed {f : M₁ →SL[σ₁₂] M₂ | is_compact_operator f} := +begin + refine is_closed_of_closure_subset _, + rintros u hu, + rw [mem_closure_iff_nhds_zero] at hu, + suffices : totally_bounded (u '' metric.closed_ball 0 1), + { change is_compact_operator (u : M₁ →ₛₗ[σ₁₂] M₂), + rw is_compact_operator_iff_is_compact_closure_image_closed_ball (u : M₁ →ₛₗ[σ₁₂] M₂) + zero_lt_one, + exact is_compact_of_totally_bounded_is_closed this.closure is_closed_closure }, + rw totally_bounded_iff_subset_finite_Union_nhds_zero, + intros U hU, + rcases exists_nhds_zero_half hU with ⟨V, hV, hVU⟩, + let SV : set M₁ × set M₂ := ⟨closed_ball 0 1, -V⟩, + rcases hu {f | ∀ x ∈ SV.1, f x ∈ SV.2} (continuous_linear_map.has_basis_nhds_zero.mem_of_mem + ⟨normed_space.is_vonN_bounded_closed_ball _ _ _, neg_mem_nhds_zero M₂ hV⟩) with ⟨v, hv, huv⟩, + rcases totally_bounded_iff_subset_finite_Union_nhds_zero.mp + (hv.is_compact_closure_image_closed_ball 1).totally_bounded V hV with ⟨T, hT, hTv⟩, + have hTv : v '' closed_ball 0 1 ⊆ _ := subset_closure.trans hTv, + refine ⟨T, hT, _⟩, + rw [image_subset_iff, preimage_Union₂] at ⊢ hTv, + intros x hx, + specialize hTv hx, + rw [mem_Union₂] at ⊢ hTv, + rcases hTv with ⟨t, ht, htx⟩, + refine ⟨t, ht, _⟩, + rw [mem_preimage, mem_vadd_set_iff_neg_vadd_mem, vadd_eq_add, neg_add_eq_sub] at ⊢ htx, + convert hVU _ htx _ (huv x hx) using 1, + rw [continuous_linear_map.sub_apply], + abel +end + +lemma compact_operator_topological_closure {𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] + [normed_field 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} {M₁ M₂ : Type*} + [seminormed_add_comm_group M₁] [add_comm_group M₂] [normed_space 𝕜₁ M₁] [module 𝕜₂ M₂] + [uniform_space M₂] [uniform_add_group M₂] [has_continuous_const_smul 𝕜₂ M₂] [t2_space M₂] + [complete_space M₂] [has_continuous_smul 𝕜₂ (M₁ →SL[σ₁₂] M₂)] : + (compact_operator σ₁₂ M₁ M₂).topological_closure = compact_operator σ₁₂ M₁ M₂ := +set_like.ext' (is_closed_set_of_is_compact_operator.closure_eq) + +lemma is_compact_operator_of_tendsto {ι 𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] + [normed_field 𝕜₂] {σ₁₂ : 𝕜₁ →+* 𝕜₂} {M₁ M₂ : Type*} + [seminormed_add_comm_group M₁] [add_comm_group M₂] [normed_space 𝕜₁ M₁] [module 𝕜₂ M₂] + [uniform_space M₂] [uniform_add_group M₂] [has_continuous_const_smul 𝕜₂ M₂] [t2_space M₂] + [complete_space M₂] {l : filter ι} [l.ne_bot] {F : ι → M₁ →SL[σ₁₂] M₂} {f : M₁ →SL[σ₁₂] M₂} + (hf : tendsto F l (𝓝 f)) (hF : ∀ᶠ i in l, is_compact_operator (F i)) : + is_compact_operator f := +is_closed_set_of_is_compact_operator.mem_of_tendsto hf hF diff --git a/src/analysis/normed_space/complemented.lean b/src/analysis/normed_space/complemented.lean index 331fcda1459c8..7c71577bec79b 100644 --- a/src/analysis/normed_space/complemented.lean +++ b/src/analysis/normed_space/complemented.lean @@ -9,6 +9,9 @@ import analysis.normed_space.finite_dimension /-! # Complemented subspaces of normed vector spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A submodule `p` of a topological module `E` over `R` is called *complemented* if there exists a continuous linear projection `f : E →ₗ[R] p`, `∀ x : p, f x = x`. We prove that for a closed subspace of a normed space this condition is equivalent to existence of a closed @@ -20,11 +23,14 @@ is always a complemented subspace. complemented subspace, normed vector space -/ -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] - {F : Type*} [normed_group F] [normed_space 𝕜 F] {G : Type*} [normed_group G] [normed_space 𝕜 G] +variables {𝕜 E F G : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E] + [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F] [normed_add_comm_group G] + [normed_space 𝕜 G] noncomputable theory +open linear_map (ker range) + namespace continuous_linear_map section @@ -32,10 +38,10 @@ section variables [complete_space 𝕜] lemma ker_closed_complemented_of_finite_dimensional_range (f : E →L[𝕜] F) - [finite_dimensional 𝕜 f.range] : - f.ker.closed_complemented := + [finite_dimensional 𝕜 (range f)] : + (ker f).closed_complemented := begin - set f' : E →L[𝕜] f.range := f.cod_restrict _ (f : E →ₗ[𝕜] F).mem_range_self, + set f' : E →L[𝕜] (range f) := f.cod_restrict _ (f : E →ₗ[𝕜] F).mem_range_self, rcases f'.exists_right_inverse_of_surjective (f : E →ₗ[𝕜] F).range_range_restrict with ⟨g, hg⟩, simpa only [ker_cod_restrict] using f'.closed_complemented_ker_of_right_inverse g (ext_iff.1 hg) end @@ -47,25 +53,25 @@ variables [complete_space E] [complete_space (F × G)] /-- If `f : E →L[R] F` and `g : E →L[R] G` are two surjective linear maps and their kernels are complement of each other, then `x ↦ (f x, g x)` defines a linear equivalence `E ≃L[R] F × G`. -/ -def equiv_prod_of_surjective_of_is_compl (f : E →L[𝕜] F) (g : E →L[𝕜] G) (hf : f.range = ⊤) - (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) : +def equiv_prod_of_surjective_of_is_compl (f : E →L[𝕜] F) (g : E →L[𝕜] G) (hf : range f = ⊤) + (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) : E ≃L[𝕜] F × G := ((f : E →ₗ[𝕜] F).equiv_prod_of_surjective_of_is_compl ↑g hf hg hfg).to_continuous_linear_equiv_of_continuous (f.continuous.prod_mk g.continuous) @[simp] lemma coe_equiv_prod_of_surjective_of_is_compl {f : E →L[𝕜] F} {g : E →L[𝕜] G} - (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) : + (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) : (equiv_prod_of_surjective_of_is_compl f g hf hg hfg : E →ₗ[𝕜] F × G) = f.prod g := rfl @[simp] lemma equiv_prod_of_surjective_of_is_compl_to_linear_equiv {f : E →L[𝕜] F} {g : E →L[𝕜] G} - (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) : + (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) : (equiv_prod_of_surjective_of_is_compl f g hf hg hfg).to_linear_equiv = linear_map.equiv_prod_of_surjective_of_is_compl f g hf hg hfg := rfl @[simp] lemma equiv_prod_of_surjective_of_is_compl_apply {f : E →L[𝕜] F} {g : E →L[𝕜] G} - (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) (x : E): + (hf : range f = ⊤) (hg : range g = ⊤) (hfg : is_compl (ker f) (ker g)) (x : E) : equiv_prod_of_surjective_of_is_compl f g hf hg hfg x = (f x, g x) := rfl @@ -75,8 +81,6 @@ namespace subspace variables [complete_space E] (p q : subspace 𝕜 E) -open continuous_linear_map (subtype_val) - /-- If `q` is a closed complement of a closed subspace `p`, then `p × q` is continuously isomorphic to `E`. -/ def prod_equiv_of_closed_compl (h : is_compl p q) (hp : is_closed (p : set E)) @@ -84,7 +88,7 @@ def prod_equiv_of_closed_compl (h : is_compl p q) (hp : is_closed (p : set E)) begin haveI := hp.complete_space_coe, haveI := hq.complete_space_coe, refine (p.prod_equiv_of_is_compl q h).to_continuous_linear_equiv_of_continuous _, - exact ((subtype_val p).coprod (subtype_val q)).continuous + exact (p.subtypeL.coprod q.subtypeL).continuous end /-- Projection to a closed submodule along a closed complement. -/ diff --git a/src/analysis/normed_space/completion.lean b/src/analysis/normed_space/completion.lean index ce76de757b24e..d575ce664cc02 100644 --- a/src/analysis/normed_space/completion.lean +++ b/src/analysis/normed_space/completion.lean @@ -5,14 +5,21 @@ Authors: Yury G. Kudryashov -/ import analysis.normed.group.completion import analysis.normed_space.operator_norm -import topology.algebra.uniform_mul_action +import topology.algebra.uniform_ring /-! # Normed space structure on the completion of a normed space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `E` is a normed space over `𝕜`, then so is `uniform_space.completion E`. In this file we provide necessary instances and define `uniform_space.completion.to_complₗᵢ` - coercion `E → uniform_space.completion E` as a bundled linear isometry. + +We also show that if `A` is a normed algebra over `𝕜`, then so is `uniform_space.completion A`. + +TODO: Generalise the results here from the concrete `completion` to any `abstract_completion`. -/ noncomputable theory @@ -20,7 +27,7 @@ noncomputable theory namespace uniform_space namespace completion -variables (𝕜 E : Type*) [normed_field 𝕜] [normed_group E] [normed_space 𝕜 E] +variables (𝕜 E : Type*) [normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] @[priority 100] instance normed_space.to_has_uniform_continuous_const_smul : @@ -32,7 +39,7 @@ instance : normed_space 𝕜 (completion E) := norm_smul_le := λ c x, induction_on x (is_closed_le (continuous_const_smul _).norm (continuous_const.mul continuous_norm)) $ λ y, by simp only [← coe_smul, norm_coe, norm_smul], - .. completion.module 𝕜 E } + .. completion.module } variables {𝕜 E} @@ -51,9 +58,47 @@ to_complₗᵢ.to_continuous_linear_map @[simp] lemma coe_to_complL : ⇑(to_complL : E →L[𝕜] completion E) = coe := rfl -@[simp] lemma norm_to_complL {𝕜 E : Type*} [nondiscrete_normed_field 𝕜] - [normed_group E] [normed_space 𝕜 E] [nontrivial E] : ∥(to_complL : E →L[𝕜] completion E)∥ = 1 := +@[simp] lemma norm_to_complL {𝕜 E : Type*} [nontrivially_normed_field 𝕜] [normed_add_comm_group E] + [normed_space 𝕜 E] [nontrivial E] : ‖(to_complL : E →L[𝕜] completion E)‖ = 1 := (to_complₗᵢ : E →ₗᵢ[𝕜] completion E).norm_to_continuous_linear_map +section algebra + +variables (𝕜) (A : Type*) + +instance [semi_normed_ring A] : normed_ring (completion A) := +{ dist_eq := λ x y, + begin + apply completion.induction_on₂ x y; clear x y, + { refine is_closed_eq (completion.uniform_continuous_extension₂ _).continuous _, + exact continuous.comp completion.continuous_extension continuous_sub }, + { intros x y, + rw [← completion.coe_sub, norm_coe, completion.dist_eq, dist_eq_norm] } + end, + norm_mul := λ x y, + begin + apply completion.induction_on₂ x y; clear x y, + { exact is_closed_le (continuous.comp (continuous_norm) continuous_mul) (continuous.comp + real.continuous_mul (continuous.prod_map continuous_norm continuous_norm)) }, + { intros x y, + simp only [← coe_mul, norm_coe], exact norm_mul_le x y, } + end, + ..completion.ring, + ..completion.metric_space } + +instance [semi_normed_comm_ring A] [normed_algebra 𝕜 A] [has_uniform_continuous_const_smul 𝕜 A] : + normed_algebra 𝕜 (completion A) := +{ norm_smul_le := λ r x, + begin + apply completion.induction_on x; clear x, + { exact is_closed_le (continuous.comp (continuous_norm) (continuous_const_smul r)) + (continuous.comp (continuous_mul_left _) continuous_norm), }, + { intros x, + simp only [← coe_smul, norm_coe], exact norm_smul_le r x } + end, + ..completion.algebra A 𝕜} + +end algebra + end completion end uniform_space diff --git a/src/analysis/normed_space/conformal_linear_map.lean b/src/analysis/normed_space/conformal_linear_map.lean index bb6ca05abae67..a711a152372cb 100644 --- a/src/analysis/normed_space/conformal_linear_map.lean +++ b/src/analysis/normed_space/conformal_linear_map.lean @@ -9,6 +9,9 @@ import analysis.normed_space.linear_isometry /-! # Conformal Linear Maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A continuous linear map between `R`-normed spaces `X` and `Y` `is_conformal_map` if it is a nonzero multiple of a linear isometry. @@ -45,14 +48,14 @@ open function linear_isometry continuous_linear_map /-- A continuous linear map `f'` is said to be conformal if it's a nonzero multiple of a linear isometry. -/ def is_conformal_map {R : Type*} {X Y : Type*} [normed_field R] - [semi_normed_group X] [semi_normed_group Y] [normed_space R X] [normed_space R Y] + [seminormed_add_comm_group X] [seminormed_add_comm_group Y] [normed_space R X] [normed_space R Y] (f' : X →L[R] Y) := ∃ (c : R) (hc : c ≠ 0) (li : X →ₗᵢ[R] Y), f' = c • li.to_continuous_linear_map variables {R M N G M' : Type*} [normed_field R] - [semi_normed_group M] [semi_normed_group N] [semi_normed_group G] + [seminormed_add_comm_group M] [seminormed_add_comm_group N] [seminormed_add_comm_group G] [normed_space R M] [normed_space R N] [normed_space R G] - [normed_group M'] [normed_space R M'] + [normed_add_comm_group M'] [normed_space R M'] {f : M →L[R] N} {g : N →L[R] G} {c : R} lemma is_conformal_map_id : is_conformal_map (id R M) := diff --git a/src/analysis/normed_space/continuous_affine_map.lean b/src/analysis/normed_space/continuous_affine_map.lean index 1ef5420663c8a..ab2ff1080e777 100644 --- a/src/analysis/normed_space/continuous_affine_map.lean +++ b/src/analysis/normed_space/continuous_affine_map.lean @@ -4,19 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Oliver Nash -/ import topology.algebra.continuous_affine_map -import analysis.normed_space.add_torsor import analysis.normed_space.affine_isometry import analysis.normed_space.operator_norm /-! # Continuous affine maps between normed spaces. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file develops the theory of continuous affine maps between affine spaces modelled on normed spaces. In the particular case that the affine spaces are just normed vector spaces `V`, `W`, we define a norm on the space of continuous affine maps by defining the norm of `f : V →A[𝕜] W` to be -`∥f∥ = max ∥f 0∥ ∥f.cont_linear∥`. This is chosen so that we have a linear isometry: +`‖f‖ = max ‖f 0‖ ‖f.cont_linear‖`. This is chosen so that we have a linear isometry: `(V →A[𝕜] W) ≃ₗᵢ[𝕜] W × (V →L[𝕜] W)`. The abstract picture is that for an affine space `P` modelled on a vector space `V`, together with @@ -28,7 +30,7 @@ take `P = V`, using `0 : V` as the base point provides a splitting, and we prove isometric decomposition. On the other hand, choosing a base point breaks the affine invariance so the norm fails to be -submultiplicative: for a composition of maps, we have only `∥f.comp g∥ ≤ ∥f∥ * ∥g∥ + ∥f 0∥`. +submultiplicative: for a composition of maps, we have only `‖f.comp g‖ ≤ ‖f‖ * ‖g‖ + ‖f 0‖`. ## Main definitions: @@ -42,11 +44,11 @@ submultiplicative: for a composition of maps, we have only `∥f.comp g∥ ≤ namespace continuous_affine_map variables {𝕜 R V W W₂ P Q Q₂ : Type*} -variables [normed_group V] [metric_space P] [normed_add_torsor V P] -variables [normed_group W] [metric_space Q] [normed_add_torsor W Q] -variables [normed_group W₂] [metric_space Q₂] [normed_add_torsor W₂ Q₂] +variables [normed_add_comm_group V] [metric_space P] [normed_add_torsor V P] +variables [normed_add_comm_group W] [metric_space Q] [normed_add_torsor W Q] +variables [normed_add_comm_group W₂] [metric_space Q₂] [normed_add_torsor W₂ Q₂] variables [normed_field R] [normed_space R V] [normed_space R W] [normed_space R W₂] -variables [nondiscrete_normed_field 𝕜] [normed_space 𝕜 V] [normed_space 𝕜 W] [normed_space 𝕜 W₂] +variables [nontrivially_normed_field 𝕜] [normed_space 𝕜 V] [normed_space 𝕜 W] [normed_space 𝕜 W₂] include V W @@ -144,26 +146,31 @@ section normed_space_structure variables (f : V →A[𝕜] W) /-- Note that unlike the operator norm for linear maps, this norm is _not_ submultiplicative: -we do _not_ necessarily have `∥f.comp g∥ ≤ ∥f∥ * ∥g∥`. See `norm_comp_le` for what we can say. -/ -noncomputable instance has_norm : has_norm (V →A[𝕜] W) := ⟨λ f, max ∥f 0∥ ∥f.cont_linear∥⟩ +we do _not_ necessarily have `‖f.comp g‖ ≤ ‖f‖ * ‖g‖`. See `norm_comp_le` for what we can say. -/ +noncomputable instance has_norm : has_norm (V →A[𝕜] W) := ⟨λ f, max ‖f 0‖ ‖f.cont_linear‖⟩ -lemma norm_def : ∥f∥ = (max ∥f 0∥ ∥f.cont_linear∥) := rfl +lemma norm_def : ‖f‖ = (max ‖f 0‖ ‖f.cont_linear‖) := rfl -lemma norm_cont_linear_le : ∥f.cont_linear∥ ≤ ∥f∥ := le_max_right _ _ +lemma norm_cont_linear_le : ‖f.cont_linear‖ ≤ ‖f‖ := le_max_right _ _ -lemma norm_image_zero_le : ∥f 0∥ ≤ ∥f∥ := le_max_left _ _ +lemma norm_image_zero_le : ‖f 0‖ ≤ ‖f‖ := le_max_left _ _ -@[simp] lemma norm_eq (h : f 0 = 0) : ∥f∥ = ∥f.cont_linear∥ := -calc ∥f∥ = (max ∥f 0∥ ∥f.cont_linear∥) : by rw norm_def - ... = (max 0 ∥f.cont_linear∥) : by rw [h, norm_zero] - ... = ∥f.cont_linear∥ : max_eq_right (norm_nonneg _) +@[simp] lemma norm_eq (h : f 0 = 0) : ‖f‖ = ‖f.cont_linear‖ := +calc ‖f‖ = (max ‖f 0‖ ‖f.cont_linear‖) : by rw norm_def + ... = (max 0 ‖f.cont_linear‖) : by rw [h, norm_zero] + ... = ‖f.cont_linear‖ : max_eq_right (norm_nonneg _) -noncomputable instance : normed_group (V →A[𝕜] W) := -normed_group.of_core _ -{ norm_eq_zero_iff := λ f, - begin - rw norm_def, - refine ⟨λ h₀, _, by { rintros rfl, simp, }⟩, +noncomputable instance : normed_add_comm_group (V →A[𝕜] W) := +add_group_norm.to_normed_add_comm_group +{ to_fun := λ f, max ‖f 0‖ ‖f.cont_linear‖, + map_zero' := by simp, + neg' := λ f, by simp, + add_le' := λ f g, begin + simp only [pi.add_apply, add_cont_linear, coe_add, max_le_iff], + exact ⟨(norm_add_le _ _).trans (add_le_add (le_max_left _ _) (le_max_left _ _)), + (norm_add_le _ _).trans (add_le_add (le_max_right _ _) (le_max_right _ _))⟩, + end, + eq_zero_of_map_eq_zero' := λ f h₀, begin rcases max_eq_iff.mp h₀ with ⟨h₁, h₂⟩ | ⟨h₁, h₂⟩; rw h₁ at h₂, { rw [norm_le_zero_iff, cont_linear_eq_zero_iff_exists_const] at h₂, @@ -171,42 +178,35 @@ normed_group.of_core _ simp only [function.const_apply, coe_const, norm_eq_zero] at h₁, rw h₁, refl, }, - { rw [norm_eq_zero_iff', cont_linear_eq_zero_iff_exists_const] at h₁, + { rw [norm_eq_zero', cont_linear_eq_zero_iff_exists_const] at h₁, obtain ⟨q, rfl⟩ := h₁, simp only [function.const_apply, coe_const, norm_le_zero_iff] at h₂, rw h₂, refl, }, - end, - triangle := λ f g, - begin - simp only [norm_def, pi.add_apply, add_cont_linear, coe_add, max_le_iff], - exact ⟨(norm_add_le _ _).trans (add_le_add (le_max_left _ _) (le_max_left _ _)), - (norm_add_le _ _).trans (add_le_add (le_max_right _ _) (le_max_right _ _))⟩, - end, - norm_neg := λ f, by simp [norm_def], } + end } instance : normed_space 𝕜 (V →A[𝕜] W) := { norm_smul_le := λ t f, by simp only [norm_def, smul_cont_linear, coe_smul, pi.smul_apply, norm_smul, ← mul_max_of_nonneg _ _ (norm_nonneg t)], } lemma norm_comp_le (g : W₂ →A[𝕜] V) : - ∥f.comp g∥ ≤ ∥f∥ * ∥g∥ + ∥f 0∥ := + ‖f.comp g‖ ≤ ‖f‖ * ‖g‖ + ‖f 0‖ := begin rw [norm_def, max_le_iff], split, - { calc ∥f.comp g 0∥ = ∥f (g 0)∥ : by simp - ... = ∥f.cont_linear (g 0) + f 0∥ : by { rw f.decomp, simp, } - ... ≤ ∥f.cont_linear∥ * ∥g 0∥ + ∥f 0∥ : + { calc ‖f.comp g 0‖ = ‖f (g 0)‖ : by simp + ... = ‖f.cont_linear (g 0) + f 0‖ : by { rw f.decomp, simp, } + ... ≤ ‖f.cont_linear‖ * ‖g 0‖ + ‖f 0‖ : (norm_add_le _ _).trans (add_le_add_right (f.cont_linear.le_op_norm _) _) - ... ≤ ∥f∥ * ∥g∥ + ∥f 0∥ : + ... ≤ ‖f‖ * ‖g‖ + ‖f 0‖ : add_le_add_right (mul_le_mul f.norm_cont_linear_le g.norm_image_zero_le (norm_nonneg _) (norm_nonneg _)) _, }, - { calc ∥(f.comp g).cont_linear∥ ≤ ∥f.cont_linear∥ * ∥g.cont_linear∥ : + { calc ‖(f.comp g).cont_linear‖ ≤ ‖f.cont_linear‖ * ‖g.cont_linear‖ : (g.comp_cont_linear f).symm ▸ f.cont_linear.op_norm_comp_le _ - ... ≤ ∥f∥ * ∥g∥ : + ... ≤ ‖f‖ * ‖g‖ : mul_le_mul f.norm_cont_linear_le g.norm_cont_linear_le (norm_nonneg _) (norm_nonneg _) - ... ≤ ∥f∥ * ∥g∥ + ∥f 0∥ : + ... ≤ ‖f‖ * ‖g‖ + ‖f 0‖ : by { rw le_add_iff_nonneg_right, apply norm_nonneg, }, }, end @@ -220,9 +220,9 @@ def to_const_prod_continuous_linear_map : (V →A[𝕜] W) ≃ₗᵢ[𝕜] W × inv_fun := λ p, p.2.to_continuous_affine_map + const 𝕜 V p.1, left_inv := λ f, by { ext, rw f.decomp, simp, }, right_inv := by { rintros ⟨v, f⟩, ext; simp, }, - map_add' := by simp, - map_smul' := by simp, - norm_map' := λ f, by simp [prod.norm_def, norm_def], } + map_add' := λ _ _, rfl, + map_smul' := λ _ _, rfl, + norm_map' := λ f, rfl } @[simp] lemma to_const_prod_continuous_linear_map_fst (f : V →A[𝕜] W) : (to_const_prod_continuous_linear_map 𝕜 V W f).fst = f 0 := diff --git a/src/analysis/normed_space/continuous_linear_map.lean b/src/analysis/normed_space/continuous_linear_map.lean new file mode 100644 index 0000000000000..1ca9737ceac0a --- /dev/null +++ b/src/analysis/normed_space/continuous_linear_map.lean @@ -0,0 +1,252 @@ +/- +Copyright (c) 2019 Jan-David Salchow. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jan-David Salchow, Sébastien Gouëzel, Jean Lo +-/ +import analysis.normed_space.basic + +/-! # Constructions of continuous linear maps between (semi-)normed spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A fundamental fact about (semi-)linear maps between normed spaces over sensible fields is that +continuity and boundedness are equivalent conditions. That is, for normed spaces `E`, `F`, a +`linear_map` `f : E →ₛₗ[σ] F` is the coercion of some `continuous_linear_map` `f' : E →SL[σ] F`, if +and only if there exists a bound `C` such that for all `x`, `‖f x‖ ≤ C * ‖x‖`. + +We prove one direction in this file: `linear_map.mk_continuous`, boundedness implies continuity. The +other direction, `continuous_linear_map.bound`, is deferred to a later file, where the +strong operator topology on `E →SL[σ] F` is available, because it is natural to use +`continuous_linear_map.bound` to define a norm `⨆ x, ‖f x‖ / ‖x‖` on `E →SL[σ] F` and to show that +this is compatible with the strong operator topology. + +This file also contains several corollaries of `linear_map.mk_continuous`: other "easy" +constructions of continuous linear maps between normed spaces. + +This file is meant to be lightweight (it is imported by much of the analysis library); think twice +before adding imports! +-/ + +open metric continuous_linear_map +open set real + +open_locale nnreal + +variables {𝕜 𝕜₂ E F G : Type*} + + +/-! # General constructions -/ + +section seminormed_add_comm_group + +variables [ring 𝕜] [ring 𝕜₂] +variables [seminormed_add_comm_group E] [seminormed_add_comm_group F] [seminormed_add_comm_group G] +variables [module 𝕜 E] [module 𝕜₂ F] [module 𝕜 G] +variables {σ : 𝕜 →+* 𝕜₂} (f : E →ₛₗ[σ] F) + +/-- Construct a continuous linear map from a linear map and a bound on this linear map. +The fact that the norm of the continuous linear map is then controlled is given in +`linear_map.mk_continuous_norm_le`. -/ +def linear_map.mk_continuous (C : ℝ) (h : ∀x, ‖f x‖ ≤ C * ‖x‖) : E →SL[σ] F := +⟨f, add_monoid_hom_class.continuous_of_bound f C h⟩ + +/-- Construct a continuous linear map from a linear map and the existence of a bound on this linear +map. If you have an explicit bound, use `linear_map.mk_continuous` instead, as a norm estimate will +follow automatically in `linear_map.mk_continuous_norm_le`. -/ +def linear_map.mk_continuous_of_exists_bound (h : ∃C, ∀x, ‖f x‖ ≤ C * ‖x‖) : E →SL[σ] F := +⟨f, let ⟨C, hC⟩ := h in add_monoid_hom_class.continuous_of_bound f C hC⟩ + +lemma continuous_of_linear_of_boundₛₗ {f : E → F} (h_add : ∀ x y, f (x + y) = f x + f y) + (h_smul : ∀ (c : 𝕜) x, f (c • x) = (σ c) • f x) {C : ℝ} (h_bound : ∀ x, ‖f x‖ ≤ C*‖x‖) : + continuous f := +let φ : E →ₛₗ[σ] F := { to_fun := f, map_add' := h_add, map_smul' := h_smul } in +add_monoid_hom_class.continuous_of_bound φ C h_bound + +lemma continuous_of_linear_of_bound {f : E → G} (h_add : ∀ x y, f (x + y) = f x + f y) + (h_smul : ∀ (c : 𝕜) x, f (c • x) = c • f x) {C : ℝ} (h_bound : ∀ x, ‖f x‖ ≤ C*‖x‖) : + continuous f := +let φ : E →ₗ[𝕜] G := { to_fun := f, map_add' := h_add, map_smul' := h_smul } in +add_monoid_hom_class.continuous_of_bound φ C h_bound + +@[simp, norm_cast] lemma linear_map.mk_continuous_coe (C : ℝ) (h : ∀x, ‖f x‖ ≤ C * ‖x‖) : + ((f.mk_continuous C h) : E →ₛₗ[σ] F) = f := rfl + +@[simp] lemma linear_map.mk_continuous_apply (C : ℝ) (h : ∀x, ‖f x‖ ≤ C * ‖x‖) (x : E) : + f.mk_continuous C h x = f x := rfl + +@[simp, norm_cast] lemma linear_map.mk_continuous_of_exists_bound_coe + (h : ∃C, ∀x, ‖f x‖ ≤ C * ‖x‖) : + ((f.mk_continuous_of_exists_bound h) : E →ₛₗ[σ] F) = f := rfl + +@[simp] lemma linear_map.mk_continuous_of_exists_bound_apply (h : ∃C, ∀x, ‖f x‖ ≤ C * ‖x‖) (x : E) : + f.mk_continuous_of_exists_bound h x = f x := rfl + +namespace continuous_linear_map + +theorem antilipschitz_of_bound (f : E →SL[σ] F) {K : ℝ≥0} (h : ∀ x, ‖x‖ ≤ K * ‖f x‖) : + antilipschitz_with K f := +add_monoid_hom_class.antilipschitz_of_bound _ h + +lemma bound_of_antilipschitz (f : E →SL[σ] F) {K : ℝ≥0} (h : antilipschitz_with K f) (x) : + ‖x‖ ≤ K * ‖f x‖ := +zero_hom_class.bound_of_antilipschitz _ h x + +end continuous_linear_map + +section + +variables {σ₂₁ : 𝕜₂ →+* 𝕜} [ring_hom_inv_pair σ σ₂₁] [ring_hom_inv_pair σ₂₁ σ] + +include σ₂₁ + +/-- Construct a continuous linear equivalence from a linear equivalence together with +bounds in both directions. -/ +def linear_equiv.to_continuous_linear_equiv_of_bounds (e : E ≃ₛₗ[σ] F) (C_to C_inv : ℝ) + (h_to : ∀ x, ‖e x‖ ≤ C_to * ‖x‖) (h_inv : ∀ x : F, ‖e.symm x‖ ≤ C_inv * ‖x‖) : E ≃SL[σ] F := +{ to_linear_equiv := e, + continuous_to_fun := add_monoid_hom_class.continuous_of_bound e C_to h_to, + continuous_inv_fun := add_monoid_hom_class.continuous_of_bound e.symm C_inv h_inv } + +end + +end seminormed_add_comm_group + +section seminormed_bounded + +variables [semi_normed_ring 𝕜] [ring 𝕜₂] [seminormed_add_comm_group E] +variables [module 𝕜 E] [has_bounded_smul 𝕜 E] + +/-- Reinterpret a linear map `𝕜 →ₗ[𝕜] E` as a continuous linear map. This construction +is generalized to the case of any finite dimensional domain +in `linear_map.to_continuous_linear_map`. -/ +def linear_map.to_continuous_linear_map₁ (f : 𝕜 →ₗ[𝕜] E) : 𝕜 →L[𝕜] E := +f.mk_continuous (‖f 1‖) $ λ x, +by { conv_lhs { rw ← mul_one x }, rw [← smul_eq_mul, f.map_smul, mul_comm],exact norm_smul_le _ _ } + +@[simp] lemma linear_map.to_continuous_linear_map₁_coe (f : 𝕜 →ₗ[𝕜] E) : + (f.to_continuous_linear_map₁ : 𝕜 →ₗ[𝕜] E) = f := +rfl + +@[simp] lemma linear_map.to_continuous_linear_map₁_apply (f : 𝕜 →ₗ[𝕜] E) (x) : + f.to_continuous_linear_map₁ x = f x := +rfl + +end seminormed_bounded + +section normed + +variables [ring 𝕜] [ring 𝕜₂] +variables [normed_add_comm_group E] [normed_add_comm_group F] [module 𝕜 E] [module 𝕜₂ F] +variables {σ : 𝕜 →+* 𝕜₂} (f g : E →SL[σ] F) (x y z : E) + +theorem continuous_linear_map.uniform_embedding_of_bound {K : ℝ≥0} (hf : ∀ x, ‖x‖ ≤ K * ‖f x‖) : + uniform_embedding f := +(add_monoid_hom_class.antilipschitz_of_bound f hf).uniform_embedding f.uniform_continuous + +end normed + +/-! ## Homotheties -/ + +section seminormed + +variables [ring 𝕜] [ring 𝕜₂] +variables [seminormed_add_comm_group E] [seminormed_add_comm_group F] +variables [module 𝕜 E] [module 𝕜₂ F] +variables {σ : 𝕜 →+* 𝕜₂} (f : E →ₛₗ[σ] F) + +/-- A (semi-)linear map which is a homothety is a continuous linear map. + Since the field `𝕜` need not have `ℝ` as a subfield, this theorem is not directly deducible from + the corresponding theorem about isometries plus a theorem about scalar multiplication. Likewise + for the other theorems about homotheties in this file. + -/ +def continuous_linear_map.of_homothety (f : E →ₛₗ[σ] F) (a : ℝ) (hf : ∀x, ‖f x‖ = a * ‖x‖) : + E →SL[σ] F := +f.mk_continuous a (λ x, le_of_eq (hf x)) + +variables {σ₂₁ : 𝕜₂ →+* 𝕜} [ring_hom_inv_pair σ σ₂₁] [ring_hom_inv_pair σ₂₁ σ] + +include σ₂₁ + +lemma continuous_linear_equiv.homothety_inverse (a : ℝ) (ha : 0 < a) (f : E ≃ₛₗ[σ] F) : + (∀ (x : E), ‖f x‖ = a * ‖x‖) → (∀ (y : F), ‖f.symm y‖ = a⁻¹ * ‖y‖) := +begin + intros hf y, + calc ‖(f.symm) y‖ = a⁻¹ * (a * ‖ (f.symm) y‖) : _ + ... = a⁻¹ * ‖f ((f.symm) y)‖ : by rw hf + ... = a⁻¹ * ‖y‖ : by simp, + rw [← mul_assoc, inv_mul_cancel (ne_of_lt ha).symm, one_mul], +end + +/-- A linear equivalence which is a homothety is a continuous linear equivalence. -/ +noncomputable def continuous_linear_equiv.of_homothety (f : E ≃ₛₗ[σ] F) (a : ℝ) (ha : 0 < a) + (hf : ∀x, ‖f x‖ = a * ‖x‖) : + E ≃SL[σ] F := +linear_equiv.to_continuous_linear_equiv_of_bounds f a a⁻¹ + (λ x, (hf x).le) (λ x, (continuous_linear_equiv.homothety_inverse a ha f hf x).le) + +end seminormed + +/-! ## The span of a single vector -/ + +namespace continuous_linear_map +variables (𝕜) + +section seminormed +variables [normed_division_ring 𝕜] [seminormed_add_comm_group E] [module 𝕜 E] [has_bounded_smul 𝕜 E] + +lemma to_span_singleton_homothety (x : E) (c : 𝕜) : + ‖linear_map.to_span_singleton 𝕜 E x c‖ = ‖x‖ * ‖c‖ := +by {rw mul_comm, exact norm_smul _ _} + +end seminormed + +end continuous_linear_map + +namespace continuous_linear_equiv +variable (𝕜) + +section seminormed +variables [normed_division_ring 𝕜] [seminormed_add_comm_group E] [module 𝕜 E] [has_bounded_smul 𝕜 E] + +lemma to_span_nonzero_singleton_homothety (x : E) (h : x ≠ 0) (c : 𝕜) : + ‖linear_equiv.to_span_nonzero_singleton 𝕜 E x h c‖ = ‖x‖ * ‖c‖ := +continuous_linear_map.to_span_singleton_homothety _ _ _ + +end seminormed + +section normed +variables [normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] + +/-- Given a nonzero element `x` of a normed space `E₁` over a field `𝕜`, the natural + continuous linear equivalence from `E₁` to the span of `x`.-/ +noncomputable def to_span_nonzero_singleton (x : E) (h : x ≠ 0) : 𝕜 ≃L[𝕜] (𝕜 ∙ x) := +of_homothety + (linear_equiv.to_span_nonzero_singleton 𝕜 E x h) + ‖x‖ + (norm_pos_iff.mpr h) + (to_span_nonzero_singleton_homothety 𝕜 x h) + +/-- Given a nonzero element `x` of a normed space `E₁` over a field `𝕜`, the natural continuous + linear map from the span of `x` to `𝕜`.-/ +noncomputable def coord (x : E) (h : x ≠ 0) : (𝕜 ∙ x) →L[𝕜] 𝕜 := + (to_span_nonzero_singleton 𝕜 x h).symm + +@[simp] lemma coe_to_span_nonzero_singleton_symm {x : E} (h : x ≠ 0) : + ⇑(to_span_nonzero_singleton 𝕜 x h).symm = coord 𝕜 x h := rfl + +@[simp] lemma coord_to_span_nonzero_singleton {x : E} (h : x ≠ 0) (c : 𝕜) : + coord 𝕜 x h (to_span_nonzero_singleton 𝕜 x h c) = c := +(to_span_nonzero_singleton 𝕜 x h).symm_apply_apply c + +@[simp] lemma to_span_nonzero_singleton_coord {x : E} (h : x ≠ 0) (y : 𝕜 ∙ x) : + to_span_nonzero_singleton 𝕜 x h (coord 𝕜 x h y) = y := +(to_span_nonzero_singleton 𝕜 x h).apply_symm_apply y + +@[simp] lemma coord_self (x : E) (h : x ≠ 0) : + (coord 𝕜 x h) (⟨x, submodule.mem_span_singleton_self x⟩ : 𝕜 ∙ x) = 1 := +linear_equiv.coord_self 𝕜 E x h + +end normed + +end continuous_linear_equiv diff --git a/src/analysis/normed_space/dual.lean b/src/analysis/normed_space/dual.lean index 7127fe14ad1ce..ab0cb02b407cc 100644 --- a/src/analysis/normed_space/dual.lean +++ b/src/analysis/normed_space/dual.lean @@ -3,13 +3,16 @@ Copyright (c) 2020 Heather Macbeth. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Heather Macbeth -/ -import analysis.normed_space.hahn_banach +import analysis.normed_space.hahn_banach.extension import analysis.normed_space.is_R_or_C import analysis.locally_convex.polar /-! # The topological dual of a normed space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define the topological dual `normed_space.dual` of a normed space, and the continuous linear map `normed_space.inclusion_in_double_dual` from a normed space into its double dual. @@ -19,14 +22,14 @@ version `normed_space.inclusion_in_double_dual_li` of the map which is of type a isometric embedding, `E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E))`. Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the -theory for `semi_normed_group` and we specialize to `normed_group` when needed. +theory for `seminormed_add_comm_group` and we specialize to `normed_add_comm_group` when needed. ## Main definitions * `inclusion_in_double_dual` and `inclusion_in_double_dual_li` are the inclusion of a normed space in its double dual, considered as a bounded linear map and as a linear isometry, respectively. * `polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals `x'` for which - `∥x' z∥ ≤ 1` for every `z ∈ s`. + `‖x' z‖ ≤ 1` for every `z ∈ s`. ## Tags @@ -34,24 +37,25 @@ dual -/ noncomputable theory -open_locale classical topological_space +open_locale classical topology universes u v namespace normed_space section general -variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜] -variables (E : Type*) [semi_normed_group E] [normed_space 𝕜 E] -variables (F : Type*) [normed_group F] [normed_space 𝕜 F] +variables (𝕜 : Type*) [nontrivially_normed_field 𝕜] +variables (E : Type*) [seminormed_add_comm_group E] [normed_space 𝕜 E] +variables (F : Type*) [normed_add_comm_group F] [normed_space 𝕜 F] /-- The topological dual of a seminormed space `E`. -/ -@[derive [inhabited, semi_normed_group, normed_space 𝕜]] def dual := E →L[𝕜] 𝕜 +@[derive [inhabited, seminormed_add_comm_group, normed_space 𝕜]] def dual := E →L[𝕜] 𝕜 -instance : add_monoid_hom_class (dual 𝕜 E) E 𝕜 := continuous_linear_map.add_monoid_hom_class +instance : continuous_linear_map_class (dual 𝕜 E) 𝕜 E 𝕜 := +continuous_linear_map.continuous_semilinear_map_class instance : has_coe_to_fun (dual 𝕜 E) (λ _, E → 𝕜) := continuous_linear_map.to_fun -instance : normed_group (dual 𝕜 F) := continuous_linear_map.to_normed_group +instance : normed_add_comm_group (dual 𝕜 F) := continuous_linear_map.to_normed_add_comm_group instance [finite_dimensional 𝕜 E] : finite_dimensional 𝕜 (dual 𝕜 E) := continuous_linear_map.finite_dimensional @@ -64,13 +68,13 @@ continuous_linear_map.apply 𝕜 𝕜 @[simp] lemma dual_def (x : E) (f : dual 𝕜 E) : inclusion_in_double_dual 𝕜 E x f = f x := rfl lemma inclusion_in_double_dual_norm_eq : - ∥inclusion_in_double_dual 𝕜 E∥ = ∥(continuous_linear_map.id 𝕜 (dual 𝕜 E))∥ := + ‖inclusion_in_double_dual 𝕜 E‖ = ‖(continuous_linear_map.id 𝕜 (dual 𝕜 E))‖ := continuous_linear_map.op_norm_flip _ -lemma inclusion_in_double_dual_norm_le : ∥inclusion_in_double_dual 𝕜 E∥ ≤ 1 := +lemma inclusion_in_double_dual_norm_le : ‖inclusion_in_double_dual 𝕜 E‖ ≤ 1 := by { rw inclusion_in_double_dual_norm_eq, exact continuous_linear_map.norm_id_le } -lemma double_dual_bound (x : E) : ∥(inclusion_in_double_dual 𝕜 E) x∥ ≤ ∥x∥ := +lemma double_dual_bound (x : E) : ‖(inclusion_in_double_dual 𝕜 E) x‖ ≤ ‖x‖ := by simpa using continuous_linear_map.le_of_op_norm_le _ (inclusion_in_double_dual_norm_le 𝕜 E) x /-- The dual pairing as a bilinear form. -/ @@ -89,20 +93,20 @@ end general section bidual_isometry variables (𝕜 : Type v) [is_R_or_C 𝕜] - {E : Type u} [normed_group E] [normed_space 𝕜 E] + {E : Type u} [normed_add_comm_group E] [normed_space 𝕜 E] /-- If one controls the norm of every `f x`, then one controls the norm of `x`. Compare `continuous_linear_map.op_norm_le_bound`. -/ -lemma norm_le_dual_bound (x : E) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ (f : dual 𝕜 E), ∥f x∥ ≤ M * ∥f∥) : - ∥x∥ ≤ M := +lemma norm_le_dual_bound (x : E) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ (f : dual 𝕜 E), ‖f x‖ ≤ M * ‖f‖) : + ‖x‖ ≤ M := begin classical, by_cases h : x = 0, { simp only [h, hMp, norm_zero] }, - { obtain ⟨f, hf₁, hfx⟩ : ∃ f : E →L[𝕜] 𝕜, ∥f∥ = 1 ∧ f x = ∥x∥ := exists_dual_vector 𝕜 x h, - calc ∥x∥ = ∥(∥x∥ : 𝕜)∥ : is_R_or_C.norm_coe_norm.symm - ... = ∥f x∥ : by rw hfx - ... ≤ M * ∥f∥ : hM f + { obtain ⟨f, hf₁, hfx⟩ : ∃ f : E →L[𝕜] 𝕜, ‖f‖ = 1 ∧ f x = ‖x‖ := exists_dual_vector 𝕜 x h, + calc ‖x‖ = ‖(‖x‖ : 𝕜)‖ : is_R_or_C.norm_coe_norm.symm + ... = ‖f x‖ : by rw hfx + ... ≤ M * ‖f‖ : hM f ... = M : by rw [hf₁, mul_one] } end @@ -112,6 +116,7 @@ norm_le_zero_iff.mp (norm_le_dual_bound 𝕜 x le_rfl (λ f, by simp [h f])) lemma eq_zero_iff_forall_dual_eq_zero (x : E) : x = 0 ↔ ∀ g : dual 𝕜 E, g x = 0 := ⟨λ hx, by simp [hx], λ h, eq_zero_of_forall_dual_eq_zero 𝕜 h⟩ +/-- See also `geometric_hahn_banach_point_point`. -/ lemma eq_iff_forall_dual_eq {x y : E} : x = y ↔ ∀ g : dual 𝕜 E, g x = g y := begin @@ -141,14 +146,14 @@ open metric set normed_space /-- Given a subset `s` in a normed space `E` (over a field `𝕜`), the polar `polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals which evaluate to something of norm at most one at all points `z ∈ s`. -/ -def polar (𝕜 : Type*) [nondiscrete_normed_field 𝕜] - {E : Type*} [semi_normed_group E] [normed_space 𝕜 E] : set E → set (dual 𝕜 E) := +def polar (𝕜 : Type*) [nontrivially_normed_field 𝕜] + {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E] : set E → set (dual 𝕜 E) := (dual_pairing 𝕜 E).flip.polar -variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜] -variables {E : Type*} [semi_normed_group E] [normed_space 𝕜 E] +variables (𝕜 : Type*) [nontrivially_normed_field 𝕜] +variables {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E] -lemma mem_polar_iff {x' : dual 𝕜 E} (s : set E) : x' ∈ polar 𝕜 s ↔ ∀ z ∈ s, ∥x' z∥ ≤ 1 := iff.rfl +lemma mem_polar_iff {x' : dual 𝕜 E} (s : set E) : x' ∈ polar 𝕜 s ↔ ∀ z ∈ s, ‖x' z‖ ≤ 1 := iff.rfl @[simp] lemma polar_univ : polar 𝕜 (univ : set E) = {(0 : dual 𝕜 E)} := (dual_pairing 𝕜 E).flip.polar_univ @@ -166,38 +171,39 @@ end ((dual_pairing 𝕜 E).flip.polar_antitone subset_closure).antisymm $ (dual_pairing 𝕜 E).flip.polar_gc.l_le $ closure_minimal ((dual_pairing 𝕜 E).flip.polar_gc.le_u_l s) $ - (is_closed_polar _ _).preimage (inclusion_in_double_dual 𝕜 E).continuous + by simpa [linear_map.flip_flip] + using (is_closed_polar _ _).preimage (inclusion_in_double_dual 𝕜 E).continuous variables {𝕜} -/-- If `x'` is a dual element such that the norms `∥x' z∥` are bounded for `z ∈ s`, then a +/-- If `x'` is a dual element such that the norms `‖x' z‖` are bounded for `z ∈ s`, then a small scalar multiple of `x'` is in `polar 𝕜 s`. -/ lemma smul_mem_polar {s : set E} {x' : dual 𝕜 E} {c : 𝕜} - (hc : ∀ z, z ∈ s → ∥ x' z ∥ ≤ ∥c∥) : c⁻¹ • x' ∈ polar 𝕜 s := + (hc : ∀ z, z ∈ s → ‖ x' z ‖ ≤ ‖c‖) : c⁻¹ • x' ∈ polar 𝕜 s := begin by_cases c_zero : c = 0, { simp only [c_zero, inv_zero, zero_smul], exact (dual_pairing 𝕜 E).flip.zero_mem_polar _ }, - have eq : ∀ z, ∥ c⁻¹ • (x' z) ∥ = ∥ c⁻¹ ∥ * ∥ x' z ∥ := λ z, norm_smul c⁻¹ _, - have le : ∀ z, z ∈ s → ∥ c⁻¹ • (x' z) ∥ ≤ ∥ c⁻¹ ∥ * ∥ c ∥, + have eq : ∀ z, ‖ c⁻¹ • (x' z) ‖ = ‖ c⁻¹ ‖ * ‖ x' z ‖ := λ z, norm_smul c⁻¹ _, + have le : ∀ z, z ∈ s → ‖ c⁻¹ • (x' z) ‖ ≤ ‖ c⁻¹ ‖ * ‖ c ‖, { intros z hzs, rw eq z, apply mul_le_mul (le_of_eq rfl) (hc z hzs) (norm_nonneg _) (norm_nonneg _), }, - have cancel : ∥ c⁻¹ ∥ * ∥ c ∥ = 1, + have cancel : ‖ c⁻¹ ‖ * ‖ c ‖ = 1, by simp only [c_zero, norm_eq_zero, ne.def, not_false_iff, inv_mul_cancel, norm_inv], rwa cancel at le, end -lemma polar_ball_subset_closed_ball_div {c : 𝕜} (hc : 1 < ∥c∥) {r : ℝ} (hr : 0 < r) : - polar 𝕜 (ball (0 : E) r) ⊆ closed_ball (0 : dual 𝕜 E) (∥c∥ / r) := +lemma polar_ball_subset_closed_ball_div {c : 𝕜} (hc : 1 < ‖c‖) {r : ℝ} (hr : 0 < r) : + polar 𝕜 (ball (0 : E) r) ⊆ closed_ball (0 : dual 𝕜 E) (‖c‖ / r) := begin intros x' hx', rw mem_polar_iff at hx', simp only [polar, mem_set_of_eq, mem_closed_ball_zero_iff, mem_ball_zero_iff] at *, - have hcr : 0 < ∥c∥ / r, from div_pos (zero_lt_one.trans hc) hr, + have hcr : 0 < ‖c‖ / r, from div_pos (zero_lt_one.trans hc) hr, refine continuous_linear_map.op_norm_le_of_shell hr hcr.le hc (λ x h₁ h₂, _), - calc ∥x' x∥ ≤ 1 : hx' _ h₂ - ... ≤ (∥c∥ / r) * ∥x∥ : (inv_pos_le_iff_one_le_mul' hcr).1 (by rwa inv_div) + calc ‖x' x‖ ≤ 1 : hx' _ h₂ + ... ≤ (‖c‖ / r) * ‖x‖ : (inv_pos_le_iff_one_le_mul' hcr).1 (by rwa inv_div) end variables (𝕜) @@ -205,17 +211,17 @@ variables (𝕜) lemma closed_ball_inv_subset_polar_closed_ball {r : ℝ} : closed_ball (0 : dual 𝕜 E) r⁻¹ ⊆ polar 𝕜 (closed_ball (0 : E) r) := λ x' hx' x hx, -calc ∥x' x∥ ≤ ∥x'∥ * ∥x∥ : x'.le_op_norm x +calc ‖x' x‖ ≤ ‖x'‖ * ‖x‖ : x'.le_op_norm x ... ≤ r⁻¹ * r : mul_le_mul (mem_closed_ball_zero_iff.1 hx') (mem_closed_ball_zero_iff.1 hx) (norm_nonneg _) (dist_nonneg.trans hx') -... = r / r : div_eq_inv_mul.symm +... = r / r : inv_mul_eq_div _ _ ... ≤ 1 : div_self_le_one r /-- The `polar` of closed ball in a normed space `E` is the closed ball of the dual with inverse radius. -/ -lemma polar_closed_ball - {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] {r : ℝ} (hr : 0 < r) : +lemma polar_closed_ball {𝕜 E : Type*} [is_R_or_C 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] + {r : ℝ} (hr : 0 < r) : polar 𝕜 (closed_ball (0 : E) r) = closed_ball (0 : dual 𝕜 E) r⁻¹ := begin refine subset.antisymm _ (closed_ball_inv_subset_polar_closed_ball _), @@ -230,7 +236,7 @@ of all elements of the polar `polar 𝕜 s` are bounded by a constant. -/ lemma bounded_polar_of_mem_nhds_zero {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) : bounded (polar 𝕜 s) := begin - obtain ⟨a, ha⟩ : ∃ a : 𝕜, 1 < ∥a∥ := normed_field.exists_one_lt_norm 𝕜, + obtain ⟨a, ha⟩ : ∃ a : 𝕜, 1 < ‖a‖ := normed_field.exists_one_lt_norm 𝕜, obtain ⟨r, r_pos, r_ball⟩ : ∃ (r : ℝ) (hr : 0 < r), ball 0 r ⊆ s := metric.mem_nhds_iff.1 s_nhd, exact bounded_closed_ball.mono (((dual_pairing 𝕜 E).flip.polar_antitone r_ball).trans $ diff --git a/src/analysis/normed_space/dual_number.lean b/src/analysis/normed_space/dual_number.lean new file mode 100644 index 0000000000000..d0ffa285df06f --- /dev/null +++ b/src/analysis/normed_space/dual_number.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.dual_number +import analysis.normed_space.triv_sq_zero_ext + +/-! +# Results on `dual_number R` related to the norm + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +These are just restatements of similar statements about `triv_sq_zero_ext R M`. + +## Main results + +* `exp_eps` + +-/ + +namespace dual_number +open triv_sq_zero_ext + +variables (𝕜 : Type*) {R : Type*} + +variables [is_R_or_C 𝕜] [normed_comm_ring R] [normed_algebra 𝕜 R] +variables [topological_ring R] [complete_space R] [t2_space R] + +@[simp] lemma exp_eps : exp 𝕜 (eps : dual_number R) = 1 + eps := +exp_inr _ _ + +@[simp] lemma exp_smul_eps (r : R) : exp 𝕜 (r • eps : dual_number R) = 1 + r • eps := +by rw [eps, ←inr_smul, exp_inr] + +end dual_number diff --git a/src/analysis/normed_space/enorm.lean b/src/analysis/normed_space/enorm.lean index 54c986e82aed4..c5aeb25999aff 100644 --- a/src/analysis/normed_space/enorm.lean +++ b/src/analysis/normed_space/enorm.lean @@ -8,6 +8,9 @@ import analysis.normed_space.basic /-! # Extended norm +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define a structure `enorm 𝕜 V` representing an extended norm (i.e., a norm that can take the value `∞`) on a vector space `V` over a normed field `𝕜`. We do not use `class` for an `enorm` because the same space can have more than one extended norm. For example, the space of @@ -35,12 +38,12 @@ local attribute [instance, priority 1001] classical.prop_decidable open_locale ennreal /-- Extended norm on a vector space. As in the case of normed spaces, we require only -`∥c • x∥ ≤ ∥c∥ * ∥x∥` in the definition, then prove an equality in `map_smul`. -/ +`‖c • x‖ ≤ ‖c‖ * ‖x‖` in the definition, then prove an equality in `map_smul`. -/ structure enorm (𝕜 : Type*) (V : Type*) [normed_field 𝕜] [add_comm_group V] [module 𝕜 V] := (to_fun : V → ℝ≥0∞) (eq_zero' : ∀ x, to_fun x = 0 → x = 0) (map_add_le' : ∀ x y : V, to_fun (x + y) ≤ to_fun x + to_fun y) -(map_smul_le' : ∀ (c : 𝕜) (x : V), to_fun (c • x) ≤ ∥c∥₊ * to_fun x) +(map_smul_le' : ∀ (c : 𝕜) (x : V), to_fun (c • x) ≤ ‖c‖₊ * to_fun x) namespace enorm @@ -61,14 +64,14 @@ lemma ext_iff {e₁ e₂ : enorm 𝕜 V} : e₁ = e₂ ↔ ∀ x, e₁ x = e₂ @[simp, norm_cast] lemma coe_inj {e₁ e₂ : enorm 𝕜 V} : (e₁ : V → ℝ≥0∞) = e₂ ↔ e₁ = e₂ := coe_fn_injective.eq_iff -@[simp] lemma map_smul (c : 𝕜) (x : V) : e (c • x) = ∥c∥₊ * e x := +@[simp] lemma map_smul (c : 𝕜) (x : V) : e (c • x) = ‖c‖₊ * e x := le_antisymm (e.map_smul_le' c x) $ begin by_cases hc : c = 0, { simp [hc] }, - calc (∥c∥₊ : ℝ≥0∞) * e x = ∥c∥₊ * e (c⁻¹ • c • x) : by rw [inv_smul_smul₀ hc] - ... ≤ ∥c∥₊ * (∥c⁻¹∥₊ * e (c • x)) : _ + calc (‖c‖₊ : ℝ≥0∞) * e x = ‖c‖₊ * e (c⁻¹ • c • x) : by rw [inv_smul_smul₀ hc] + ... ≤ ‖c‖₊ * (‖c⁻¹‖₊ * e (c • x)) : _ ... = e (c • x) : _, - { exact ennreal.mul_le_mul le_rfl (e.map_smul_le' _ _) }, + { exact mul_le_mul_left' (e.map_smul_le' _ _) _ }, { rw [← mul_assoc, nnnorm_inv, ennreal.coe_inv, ennreal.mul_inv_cancel _ ennreal.coe_ne_top, one_mul]; simp [hc] } end @@ -80,7 +83,7 @@ by { rw [← zero_smul 𝕜 (0:V), e.map_smul], norm_num } ⟨e.eq_zero' x, λ h, h.symm ▸ e.map_zero⟩ @[simp] lemma map_neg (x : V) : e (-x) = e x := -calc e (-x) = ∥(-1 : 𝕜)∥₊ * e x : by rw [← map_smul, neg_one_smul] +calc e (-x) = ‖(-1 : 𝕜)‖₊ * e x : by rw [← map_smul, neg_one_smul] ... = e x : by simp lemma map_sub_rev (x y : V) : e (x - y) = e (y - x) := @@ -147,7 +150,7 @@ noncomputable instance : semilattice_sup (enorm 𝕜 V) := lemma max_map (e₁ e₂ : enorm 𝕜 V) (x : V) : (e₁ ⊔ e₂) x = max (e₁ x) (e₂ x) := rfl /-- Structure of an `emetric_space` defined by an extended norm. -/ -def emetric_space : emetric_space V := +@[reducible] def emetric_space : emetric_space V := { edist := λ x y, e (x - y), edist_self := λ x, by simp, eq_of_edist_eq_zero := λ x y, by simp [sub_eq_zero], @@ -162,15 +165,15 @@ def finite_subspace : subspace 𝕜 V := zero_mem' := by simp, add_mem' := λ x y hx hy, lt_of_le_of_lt (e.map_add_le x y) (ennreal.add_lt_top.2 ⟨hx, hy⟩), smul_mem' := λ c x (hx : _ < _), - calc e (c • x) = ∥c∥₊ * e x : e.map_smul c x + calc e (c • x) = ‖c‖₊ * e x : e.map_smul c x ... < ⊤ : ennreal.mul_lt_top ennreal.coe_ne_top hx.ne } -/-- Metric space structure on `e.finite_subspace`. We use `emetric_space.to_metric_space_of_dist` +/-- Metric space structure on `e.finite_subspace`. We use `emetric_space.to_metric_space` to ensure that this definition agrees with `e.emetric_space`. -/ instance : metric_space e.finite_subspace := begin letI := e.emetric_space, - refine emetric_space.to_metric_space_of_dist _ (λ x y, _) (λ x y, rfl), + refine emetric_space.to_metric_space (λ x y, _), change e (x - y) ≠ ⊤, exact ne_top_of_le_ne_top (ennreal.add_lt_top.2 ⟨x.2, y.2⟩).ne (e.map_sub_le x y) end @@ -180,11 +183,12 @@ lemma finite_dist_eq (x y : e.finite_subspace) : dist x y = (e (x - y)).to_real lemma finite_edist_eq (x y : e.finite_subspace) : edist x y = e (x - y) := rfl /-- Normed group instance on `e.finite_subspace`. -/ -instance : normed_group e.finite_subspace := +instance : normed_add_comm_group e.finite_subspace := { norm := λ x, (e x).to_real, - dist_eq := λ x y, rfl } + dist_eq := λ x y, rfl, + .. finite_subspace.metric_space e, .. submodule.add_comm_group _ } -lemma finite_norm_eq (x : e.finite_subspace) : ∥x∥ = (e x).to_real := rfl +lemma finite_norm_eq (x : e.finite_subspace) : ‖x‖ = (e x).to_real := rfl /-- Normed space instance on `e.finite_subspace`. -/ instance : normed_space 𝕜 e.finite_subspace := diff --git a/src/analysis/normed_space/exponential.lean b/src/analysis/normed_space/exponential.lean index 8a7469e49c324..350ad883d21e0 100644 --- a/src/analysis/normed_space/exponential.lean +++ b/src/analysis/normed_space/exponential.lean @@ -3,17 +3,21 @@ Copyright (c) 2021 Anatole Dedecker. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Anatole Dedecker, Eric Wieser -/ -import analysis.specific_limits.basic import analysis.analytic.basic import analysis.complex.basic +import analysis.normed.field.infinite_sum import data.nat.choose.cast import data.finset.noncomm_prod +import topology.algebra.algebra /-! # Exponential in a Banach algebra -In this file, we define `exp : 𝔸 → 𝔸`, the exponential map in a topological algebra `𝔸` over a -field `𝕂`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we define `exp : 𝔸 → 𝔸`, the exponential map in a topological algebra `𝔸` over the +field `ℚ`. While for most interesting results we need `𝔸` to be normed algebra, we do not require this in the definition in order to make `exp` independent of a particular choice of norm. The definition also @@ -61,7 +65,7 @@ We prove most result for an arbitrary field `𝕂`, and then specialize to `𝕂 -/ open filter is_R_or_C continuous_multilinear_map normed_field asymptotics -open_locale nat topological_space big_operators ennreal +open_locale nat topology big_operators ennreal section topological_algebra @@ -105,24 +109,37 @@ by rw [exp_series_apply_eq, exp_series_apply_eq, inv_nat_cast_smul_eq 𝕂 ℚ] lemma exp_eq_tsum [algebra ℚ 𝔸] : exp = (λ x : 𝔸, ∑' (n : ℕ), (n!⁻¹ : ℚ) • x^n) := funext exp_series_sum_eq -@[simp] lemma exp_zero [algebra ℚ 𝔸] [t2_space 𝔸] : exp (0 : 𝔸) = 1 := +lemma exp_series_apply_zero (n : ℕ) : exp_series 𝕂 𝔸 n (λ _, (0 : 𝔸)) = pi.single 0 1 n := begin - suffices : (λ x : 𝔸, ∑' (n : ℕ), (n!⁻¹ : ℚ) • x^n) 0 = ∑' (n : ℕ), if n = 0 then 1 else 0, - { have key : ∀ n ∉ ({0} : finset ℕ), (if n = 0 then (1 : 𝔸) else 0) = 0, - from λ n hn, if_neg (finset.not_mem_singleton.mp hn), - rw [exp_eq_tsum, this, tsum_eq_sum key, finset.sum_singleton], - simp }, - refine tsum_congr (λ n, _), - split_ifs with h h; - simp [h] + rw exp_series_apply_eq, + cases n, + { rw [pow_zero, nat.factorial_zero, nat.cast_one, inv_one, one_smul, pi.single_eq_same], }, + { rw [zero_pow (nat.succ_pos _), smul_zero, pi.single_eq_of_ne (n.succ_ne_zero)], }, end + +@[simp] lemma exp_zero [algebra ℚ 𝔸] [t2_space 𝔸] : exp (0 : 𝔸) = 1 := +by simp_rw [exp_eq_tsum, ←exp_series_apply_eq, exp_series_apply_zero, tsum_pi_single] + +@[simp] lemma exp_op [algebra ℚ 𝔸] [t2_space 𝔸] (x : 𝔸) : + exp (mul_opposite.op x) = mul_opposite.op (exp x) := +by simp_rw [exp, exp_series_sum_eq, ←mul_opposite.op_pow, ←mul_opposite.op_smul, tsum_op] + +@[simp] lemma exp_unop [algebra ℚ 𝔸] [t2_space 𝔸] (x : 𝔸ᵐᵒᵖ) : + exp (mul_opposite.unop x) = mul_opposite.unop (exp x) := +by simp_rw [exp, exp_series_sum_eq, ←mul_opposite.unop_pow, ←mul_opposite.unop_smul, tsum_unop] + lemma star_exp [algebra ℚ 𝔸] [t2_space 𝔸] [star_ring 𝔸] [has_continuous_star 𝔸] (x : 𝔸) : star (exp x) = exp (star x) := by simp_rw [exp_eq_tsum, ←star_pow, ←star_inv_nat_cast_smul, ←tsum_star] variables (𝕂) +lemma is_self_adjoint.exp [algebra ℚ 𝔸] [t2_space 𝔸] [star_ring 𝔸] [has_continuous_star 𝔸] {x : 𝔸} + (h : is_self_adjoint x) : + is_self_adjoint (exp x) := +(star_exp x).trans $ h.symm ▸ rfl + lemma commute.exp_right [algebra ℚ 𝔸] [t2_space 𝔸] {x y : 𝔸} (h : commute x y) : commute x (exp y) := begin @@ -163,21 +180,22 @@ section normed section any_field_any_algebra -variables {𝕂 𝔸 𝔹 : Type*} [nondiscrete_normed_field 𝕂] -variables [algebra ℚ 𝔸] [normed_ring 𝔸] [normed_ring 𝔹] [normed_algebra 𝕂 𝔸] [normed_algebra 𝕂 𝔹] +variables {𝕂 𝔸 𝔹 : Type*} [nontrivially_normed_field 𝕂] +variables [normed_ring 𝔸] [normed_ring 𝔹] [normed_algebra 𝕂 𝔸] [normed_algebra 𝕂 𝔹] lemma norm_exp_series_summable_of_mem_ball (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : - summable (λ n, ∥exp_series ℚ 𝔸 n (λ _, x)∥) := + summable (λ n, ‖exp_series 𝕂 𝔸 n (λ _, x)‖) := (exp_series 𝕂 𝔸).summable_norm_apply hx lemma norm_exp_series_summable_of_mem_ball' [algebra ℚ 𝔸] (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : - summable (λ n, ∥(n!⁻¹ : ℚ) • x^n∥) := + summable (λ n, ‖(n!⁻¹ : ℚ) • x^n‖) := begin change summable (norm ∘ _), rw ← exp_series_apply_eq', - exact norm_exp_series_summable_of_mem_ball x hx + convert norm_exp_series_summable_of_mem_ball x hx, + simp_rw [exp_series_eq_exp_series_rat] end section complete_algebra @@ -189,9 +207,9 @@ lemma exp_series_summable_of_mem_ball (x : 𝔸) summable (λ n, exp_series 𝕂 𝔸 n (λ _, x)) := summable_of_summable_norm (norm_exp_series_summable_of_mem_ball x hx) -lemma exp_series_summable_of_mem_ball' (x : 𝔸) +lemma exp_series_summable_of_mem_ball' [algebra ℚ 𝔸] (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : - summable (λ n, (n!⁻¹ : 𝕂) • x^n) := + summable (λ n, (n!⁻¹ : ℚ) • x^n) := summable_of_summable_norm (norm_exp_series_summable_of_mem_ball' x hx) lemma exp_series_has_sum_exp_of_mem_ball [algebra ℚ 𝔸] (x : 𝔸) @@ -219,7 +237,10 @@ by simpa only [exp, exp_series_sum_eq_rat] lemma continuous_on_exp [algebra ℚ 𝔸] : continuous_on (exp : 𝔸 → 𝔸) (emetric.ball 0 (exp_series 𝕂 𝔸).radius) := -by simpa only [exp, exp_series_sum_eq_rat] using formal_multilinear_series.continuous_on +begin + have := @formal_multilinear_series.continuous_on _ _ _ _ _ _ _ _ (exp_series 𝕂 𝔸), + simpa only [exp, exp_series_sum_eq_rat] using this +end lemma analytic_at_exp_of_mem_ball [algebra ℚ 𝔸] (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : @@ -231,6 +252,7 @@ begin exact (has_fpower_series_on_ball_exp_of_radius_pos h).analytic_at_of_mem hx } end +variable (𝕂) /-- In a Banach-algebra `𝔸` over a normed field `𝕂` of characteristic zero, if `x` and `y` are in the disk of convergence and commute, then `exp (x + y) = (exp x) * (exp y)`. -/ lemma exp_add_of_commute_of_mem_ball [algebra ℚ 𝔸] @@ -243,10 +265,10 @@ begin dsimp only, conv_lhs {congr, funext, rw [hxy.add_pow' _, finset.smul_sum]}, refine tsum_congr (λ n, finset.sum_congr rfl $ λ kl hkl, _), - rw [nsmul_eq_smul_cast 𝕂, smul_smul, smul_mul_smul, ← (finset.nat.mem_antidiagonal.mp hkl), + rw [nsmul_eq_smul_cast ℚ, smul_smul, smul_mul_smul, ← (finset.nat.mem_antidiagonal.mp hkl), nat.cast_add_choose, (finset.nat.mem_antidiagonal.mp hkl)], congr' 1, - have : (n! : 𝕂) ≠ 0 := nat.cast_ne_zero.mpr n.factorial_ne_zero, + have : (n! : ℚ) ≠ 0 := nat.cast_ne_zero.mpr n.factorial_ne_zero, field_simp [this] end @@ -258,25 +280,25 @@ noncomputable def invertible_exp_of_mem_ball [algebra ℚ 𝔸] {x : 𝔸} have hnx : -x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius, { rw [emetric.mem_ball, ←neg_zero, edist_neg_neg], exact hx }, - rw [←exp_add_of_commute_of_mem_ball (commute.neg_left $ commute.refl x) hnx hx, neg_add_self, + rw [←exp_add_of_commute_of_mem_ball _ (commute.neg_left $ commute.refl x) hnx hx, neg_add_self, exp_zero], end, mul_inv_of_self := begin have hnx : -x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius, { rw [emetric.mem_ball, ←neg_zero, edist_neg_neg], exact hx }, - rw [←exp_add_of_commute_of_mem_ball (commute.neg_right $ commute.refl x) hx hnx, add_neg_self, + rw [←exp_add_of_commute_of_mem_ball _ (commute.neg_right $ commute.refl x) hx hnx, add_neg_self, exp_zero], end } lemma is_unit_exp_of_mem_ball [algebra ℚ 𝔸] {x : 𝔸} (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : is_unit (exp x) := -@is_unit_of_invertible _ _ _ (invertible_exp_of_mem_ball hx) +@is_unit_of_invertible _ _ _ (invertible_exp_of_mem_ball _ hx) lemma inv_of_exp_of_mem_ball [algebra ℚ 𝔸] {x : 𝔸} (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) [invertible (exp x)] : ⅟(exp x) = exp (-x) := -by { letI := invertible_exp_of_mem_ball hx, convert (rfl : ⅟(exp x) = _) } +by { letI := invertible_exp_of_mem_ball _ hx, convert (rfl : ⅟(exp x) = _) } /-- Any continuous ring homomorphism commutes with `exp`. -/ lemma map_exp_of_mem_ball [algebra ℚ 𝔸] [algebra ℚ 𝔹] {F} [ring_hom_class F 𝔸 𝔹] (f : F) (hf : continuous f) (x : 𝔸) @@ -286,7 +308,7 @@ begin rw [exp_eq_tsum, exp_eq_tsum], refine ((exp_series_summable_of_mem_ball' _ hx).has_sum.map f hf).tsum_eq.symm.trans _, dsimp only [function.comp], - simp_rw [one_div, map_inv_nat_cast_smul f 𝕂 𝕂, map_pow], + simp_rw [one_div, map_inv_nat_cast_smul f ℚ ℚ, map_pow], end end complete_algebra @@ -294,41 +316,19 @@ end complete_algebra lemma algebra_map_exp_comm_of_mem_ball [algebra ℚ 𝔸] [char_zero 𝕂] [complete_space 𝕂] (x : 𝕂) (hx : x ∈ emetric.ball (0 : 𝕂) (exp_series 𝕂 𝕂).radius) : algebra_map 𝕂 𝔸 (exp x) = exp (algebra_map 𝕂 𝔸 x) := -map_exp_of_mem_ball _ (algebra_map_clm _ _).continuous _ hx +map_exp_of_mem_ball _ _ (algebra_map_clm _ _).continuous _ hx end any_field_any_algebra section any_field_division_algebra -variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_division_ring 𝔸] [normed_algebra 𝕂 𝔸] +variables {𝕂 𝔸 : Type*} [nontrivially_normed_field 𝕂] [normed_division_ring 𝔸] [normed_algebra 𝕂 𝔸] variables (𝕂) lemma norm_exp_series_div_summable_of_mem_ball (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : - summable (λ n, ∥x^n / n!∥) := -begin - change summable (norm ∘ _), - rw ← exp_series_apply_eq_div' x, - exact norm_exp_series_summable_of_mem_ball x hx -end - -lemma exp_series_div_summable_of_mem_ball [complete_space 𝔸] (x : 𝔸) - (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : summable (λ n, x^n / n!) := -summable_of_summable_norm (norm_exp_series_div_summable_of_mem_ball 𝕂 x hx) - -lemma exp_series_div_has_sum_exp_of_mem_ball [complete_space 𝔸] (x : 𝔸) - (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : has_sum (λ n, x^n / n!) (exp 𝕂 x) := -begin - rw ← exp_series_apply_eq_div' x, - exact exp_series_has_sum_exp_of_mem_ball x hx -end - -variables {𝕂} - -lemma exp_neg_of_mem_ball [char_zero 𝕂] [complete_space 𝔸] {x : 𝔸} - (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : - summable (λ n, ∥x^n / n!∥) := + summable (λ n, ‖x^n / n!‖) := begin change summable (norm ∘ _), rw ← exp_series_apply_eq_div' x, @@ -339,20 +339,20 @@ lemma exp_series_div_summable_of_mem_ball [complete_space 𝔸] (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : summable (λ n, x^n / n!) := summable_of_summable_norm (norm_exp_series_div_summable_of_mem_ball 𝕂 x hx) -lemma exp_series_div_has_sum_exp_of_mem_ball [complete_space 𝔸] (x : 𝔸) +lemma exp_series_div_has_sum_exp_of_mem_ball [algebra ℚ 𝔸] [complete_space 𝔸] (x : 𝔸) (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : has_sum (λ n, x^n / n!) (exp x) := begin rw ← exp_series_apply_eq_div' x, exact exp_series_has_sum_exp_of_mem_ball x hx end -variables {𝕂} +variables (𝕂) lemma exp_neg_of_mem_ball [algebra ℚ 𝔸] [complete_space 𝔸] {x : 𝔸} (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : exp (-x) = (exp x)⁻¹ := begin - letI := invertible_exp_of_mem_ball hx, + letI := invertible_exp_of_mem_ball _ hx, exact inv_of_eq_inv (exp x), end @@ -361,16 +361,18 @@ end any_field_division_algebra section any_field_comm_algebra -variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸] +variables {𝕂 𝔸 : Type*} [nontrivially_normed_field 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸] [complete_space 𝔸] +variable (𝕂) + /-- In a commutative Banach-algebra `𝔸` over a normed field `𝕂` of characteristic zero, `exp (x+y) = (exp x) * (exp y)` for all `x`, `y` in the disk of convergence. -/ lemma exp_add_of_mem_ball [algebra ℚ 𝔸] {x y : 𝔸} (hx : x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) (hy : y ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : exp (x + y) = (exp x) * (exp y) := -exp_add_of_commute_of_mem_ball (commute.all x y) hx hy +exp_add_of_commute_of_mem_ball 𝕂 (commute.all x y) hx hy end any_field_comm_algebra @@ -389,8 +391,8 @@ begin refine summable_of_norm_bounded_eventually _ (real.summable_pow_div_factorial r) _, filter_upwards [eventually_cofinite_ne 0] with n hn, rw [norm_mul, norm_norm (exp_series 𝕂 𝔸 n), exp_series, norm_smul, norm_inv, norm_pow, - nnreal.norm_eq, norm_eq_abs, abs_cast_nat, mul_comm, ←mul_assoc, ←div_eq_mul_inv], - have : ∥continuous_multilinear_map.mk_pi_algebra_fin 𝕂 n 𝔸∥ ≤ 1 := + nnreal.norm_eq, norm_nat_cast, mul_comm, ←mul_assoc, ←div_eq_mul_inv], + have : ‖continuous_multilinear_map.mk_pi_algebra_fin 𝕂 n 𝔸‖ ≤ 1 := norm_mk_pi_algebra_fin_le_of_pos (nat.pos_of_ne_zero hn), exact mul_le_of_le_one_right (div_nonneg (pow_nonneg r.coe_nonneg n) n!.cast_nonneg) this end @@ -403,11 +405,17 @@ end variables {𝕂 𝔸 𝔹} -lemma norm_exp_series_summable (x : 𝔸) : summable (λ n, ∥exp_series 𝕂 𝔸 n (λ _, x)∥) := +lemma norm_exp_series_summable (x : 𝔸) : summable (λ n, ‖exp_series 𝕂 𝔸 n (λ _, x)‖) := norm_exp_series_summable_of_mem_ball x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) -lemma norm_exp_series_summable' (x : 𝔸) : summable (λ n, ∥(n!⁻¹ : 𝕂) • x^n∥) := -norm_exp_series_summable_of_mem_ball' x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) +variable (𝕂) + +lemma norm_exp_series_summable' [algebra ℚ 𝔸] (x : 𝔸) : summable (λ n, ‖(n!⁻¹ : ℚ) • x^n‖) := +norm_exp_series_summable_of_mem_ball' x ( + show x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius, + from (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) + +variable {𝕂} section complete_algebra @@ -416,10 +424,10 @@ variables [complete_space 𝔸] lemma exp_series_summable (x : 𝔸) : summable (λ n, exp_series 𝕂 𝔸 n (λ _, x)) := summable_of_summable_norm (norm_exp_series_summable x) -lemma exp_series_summable' (x : 𝔸) : summable (λ n, (n!⁻¹ : 𝕂) • x^n) := -summable_of_summable_norm (norm_exp_series_summable' x) +lemma exp_series_summable' [algebra ℚ 𝔸] (x : 𝔸) : summable (λ n, (n!⁻¹ : ℚ) • x^n) := +summable_of_summable_norm (norm_exp_series_summable' 𝕂 x) -variables [algebra ℚ 𝔸] +variables [algebra ℚ 𝔸] [algebra ℚ 𝔹] lemma exp_series_has_sum_exp (x : 𝔸) : has_sum (λ n, exp_series 𝕂 𝔸 n (λ _, x)) (exp x) := @@ -440,7 +448,7 @@ exp_has_fpower_series_on_ball.has_fpower_series_at section include 𝕂 -lemma exp_continuous : continuous (exp : 𝔸 → 𝔸) := +@[continuity] lemma exp_continuous : continuous (exp : 𝔸 → 𝔸) := begin rw [continuous_iff_continuous_on_univ, ← metric.eball_top_eq_univ (0 : 𝔸), ← exp_series_radius_eq_top 𝕂 𝔸], @@ -452,12 +460,14 @@ lemma exp_analytic (x : 𝔸) : analytic_at 𝕂 (exp) x := analytic_at_exp_of_mem_ball x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) +variable (𝕂) /-- In a Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`, if `x` and `y` commute, then `exp (x+y) = (exp x) * (exp y)`. -/ lemma exp_add_of_commute {x y : 𝔸} (hxy : commute x y) : exp (x + y) = (exp x) * (exp y) := -exp_add_of_commute_of_mem_ball hxy ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) +exp_add_of_commute_of_mem_ball 𝕂 hxy + ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) section @@ -465,46 +475,58 @@ variables (𝕂) /-- `exp x` has explicit two-sided inverse `exp (-x)`. -/ noncomputable def invertible_exp (x : 𝔸) : invertible (exp x) := -invertible_exp_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ +invertible_exp_of_mem_ball 𝕂 $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ lemma is_unit_exp (x : 𝔸) : is_unit (exp x) := -is_unit_exp_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ +is_unit_exp_of_mem_ball 𝕂 $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ lemma inv_of_exp (x : 𝔸) [invertible (exp x)] : ⅟(exp x) = exp (-x) := -inv_of_exp_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ +inv_of_exp_of_mem_ball 𝕂 $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ lemma ring.inverse_exp (x : 𝔸) : ring.inverse (exp x) = exp (-x) := +have Type _ := 𝕂, begin - letI := invertible_exp x, + letI := invertible_exp 𝕂 x, exact ring.inverse_invertible _, end +lemma exp_mem_unitary_of_mem_skew_adjoint [star_ring 𝔸] [has_continuous_star 𝔸] {x : 𝔸} + (h : x ∈ skew_adjoint 𝔸) : + exp x ∈ unitary 𝔸 := +let 𝕂 := 𝕂 in +by rw [unitary.mem_iff, star_exp, skew_adjoint.mem_iff.mp h, + ←exp_add_of_commute 𝕂 (commute.refl x).neg_left, ←exp_add_of_commute 𝕂 (commute.refl x).neg_right, + add_left_neg, add_right_neg, exp_zero, and_self] + end /-- In a Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`, if a family of elements `f i` mutually commute then `exp (∑ i, f i) = ∏ i, exp (f i)`. -/ lemma exp_sum_of_commute {ι} (s : finset ι) (f : ι → 𝔸) - (h : ∀ (i ∈ s) (j ∈ s), commute (f i) (f j)) : + (h : (s : set ι).pairwise $ λ i j, commute (f i) (f j)) : exp (∑ i in s, f i) = s.noncomm_prod (λ i, exp (f i)) - (λ i hi j hj, (h i hi j hj).exp) := + (λ i hi j hj _, (h.of_refl hi hj).exp) := +let 𝕂 := 𝕂 in begin classical, induction s using finset.induction_on with a s ha ih, { simp }, rw [finset.noncomm_prod_insert_of_not_mem _ _ _ _ ha, finset.sum_insert ha, - exp_add_of_commute, ih], - refine commute.sum_right _ _ _ _, - intros i hi, - exact h _ (finset.mem_insert_self _ _) _ (finset.mem_insert_of_mem hi), + exp_add_of_commute 𝕂, ih (h.mono $ finset.subset_insert _ _)], + refine commute.sum_right _ _ _ (λ i hi, _), + exact h.of_refl (finset.mem_insert_self _ _) (finset.mem_insert_of_mem hi), + apply_instance, + apply_instance, end lemma exp_nsmul (n : ℕ) (x : 𝔸) : exp (n • x) = exp x ^ n := +let 𝕂 := 𝕂 in begin induction n with n ih, { rw [zero_smul, pow_zero, exp_zero], }, - { rw [succ_nsmul, pow_succ, exp_add_of_commute ((commute.refl x).smul_right n), ih] } + { rw [succ_nsmul, pow_succ, exp_add_of_commute 𝕂 ((commute.refl x).smul_right n), ih] } end variables (𝕂) @@ -512,56 +534,61 @@ variables (𝕂) /-- Any continuous ring homomorphism commutes with `exp`. -/ lemma map_exp {F} [ring_hom_class F 𝔸 𝔹] (f : F) (hf : continuous f) (x : 𝔸) : f (exp x) = exp (f x) := -map_exp_of_mem_ball f hf x $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ +map_exp_of_mem_ball 𝕂 f hf x $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ lemma exp_smul {G} [monoid G] [mul_semiring_action G 𝔸] [has_continuous_const_smul G 𝔸] (g : G) (x : 𝔸) : exp (g • x) = g • exp x := -(map_exp (mul_semiring_action.to_ring_hom G 𝔸 g) (continuous_const_smul _) x).symm +(map_exp 𝕂 (mul_semiring_action.to_ring_hom G 𝔸 g) (continuous_const_smul _) x).symm lemma exp_units_conj (y : 𝔸ˣ) (x : 𝔸) : exp (y * x * ↑(y⁻¹) : 𝔸) = y * exp x * ↑(y⁻¹) := -exp_smul _ (conj_act.to_conj_act y) x +exp_smul 𝕂 (conj_act.to_conj_act y) x lemma exp_units_conj' (y : 𝔸ˣ) (x : 𝔸) : exp (↑(y⁻¹) * x * y) = ↑(y⁻¹) * exp x * y := -exp_units_conj _ _ _ +exp_units_conj 𝕂 _ _ @[simp] lemma prod.fst_exp [complete_space 𝔹] (x : 𝔸 × 𝔹) : (exp x).fst = exp x.fst := -map_exp _ (ring_hom.fst 𝔸 𝔹) continuous_fst x +map_exp 𝕂 (ring_hom.fst 𝔸 𝔹) continuous_fst x @[simp] lemma prod.snd_exp [complete_space 𝔹] (x : 𝔸 × 𝔹) : (exp x).snd = exp x.snd := -map_exp _ (ring_hom.snd 𝔸 𝔹) continuous_snd x +map_exp 𝕂 (ring_hom.snd 𝔸 𝔹) continuous_snd x @[simp] lemma pi.exp_apply {ι : Type*} {𝔸 : ι → Type*} [fintype ι] - [Π i, normed_ring (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)] + [Π i, normed_ring (𝔸 i)] [Π i, algebra ℚ (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)] (x : Π i, 𝔸 i) (i : ι) : + by haveI : algebra ℚ (Π i, 𝔸 i) := pi.algebra _ _; exact exp x i = exp (x i) := begin -- Lean struggles to infer this instance due to it wanting `[Π i, semi_normed_ring (𝔸 i)]` letI : normed_algebra 𝕂 (Π i, 𝔸 i) := pi.normed_algebra _, - exact map_exp _ (pi.eval_ring_hom 𝔸 i) (continuous_apply _) x + letI : algebra ℚ (Π i, 𝔸 i) := pi.algebra _ _, + exact map_exp 𝕂 (pi.eval_ring_hom 𝔸 i) (continuous_apply _) x end lemma pi.exp_def {ι : Type*} {𝔸 : ι → Type*} [fintype ι] - [Π i, normed_ring (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)] + [Π i, normed_ring (𝔸 i)] [Π i, algebra ℚ (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)] (x : Π i, 𝔸 i) : + by haveI : algebra ℚ (Π i, 𝔸 i) := pi.algebra _ _; exact exp x = λ i, exp (x i) := funext $ pi.exp_apply 𝕂 x lemma function.update_exp {ι : Type*} {𝔸 : ι → Type*} [fintype ι] [decidable_eq ι] - [Π i, normed_ring (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)] + [Π i, normed_ring (𝔸 i)] [Π i, algebra ℚ (𝔸 i)] [Π i, normed_algebra 𝕂 (𝔸 i)] [Π i, complete_space (𝔸 i)] (x : Π i, 𝔸 i) (j : ι) (xj : 𝔸 j) : + by haveI : algebra ℚ (Π i, 𝔸 i) := pi.algebra _ _; exact function.update (exp x) j (exp xj) = exp (function.update x j xj) := begin + letI : algebra ℚ (Π i, 𝔸 i) := pi.algebra _ _, ext i, - simp_rw [pi.exp_def], + simp_rw [pi.exp_def 𝕂], exact (function.apply_update (λ i, exp) x j xj i).symm, end end complete_algebra -lemma algebra_map_exp_comm (x : 𝕂) : +lemma algebra_map_exp_comm [algebra ℚ 𝔸] (x : 𝕂) : algebra_map 𝕂 𝔸 (exp x) = exp (algebra_map 𝕂 𝔸 x) := algebra_map_exp_comm_of_mem_ball x $ (exp_series_radius_eq_top 𝕂 𝕂).symm ▸ edist_lt_top _ _ @@ -574,11 +601,11 @@ variables {𝕂 𝔸 : Type*} [is_R_or_C 𝕂] [normed_division_ring 𝔸] [norm variables (𝕂) -lemma norm_exp_series_div_summable (x : 𝔸) : summable (λ n, ∥x^n / n!∥) := +lemma norm_exp_series_div_summable (x : 𝔸) : summable (λ n, ‖x^n / n!‖) := norm_exp_series_div_summable_of_mem_ball 𝕂 x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) -variables [complete_space 𝔸] +variables [complete_space 𝔸] [algebra ℚ 𝔸] lemma exp_series_div_summable (x : 𝔸) : summable (λ n, x^n / n!) := summable_of_summable_norm (norm_exp_series_div_summable 𝕂 x) @@ -587,25 +614,26 @@ lemma exp_series_div_has_sum_exp (x : 𝔸) : has_sum (λ n, x^n / n!) (exp x):= exp_series_div_has_sum_exp_of_mem_ball 𝕂 x ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) -variables {𝕂} [algebra ℚ 𝔸] +variables (𝕂) [algebra ℚ 𝔸] lemma exp_neg (x : 𝔸) : exp (-x) = (exp x)⁻¹ := -exp_neg_of_mem_ball $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ +exp_neg_of_mem_ball 𝕂 $ (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ lemma exp_zsmul (z : ℤ) (x : 𝔸) : exp (z • x) = (exp x) ^ z := +let 𝕂 := 𝕂 in begin obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg, - { rw [zpow_coe_nat, coe_nat_zsmul, exp_nsmul] }, - { rw [zpow_neg₀, zpow_coe_nat, neg_smul, exp_neg, coe_nat_zsmul, exp_nsmul] }, + { rw [zpow_coe_nat, coe_nat_zsmul, exp_nsmul 𝕂]; apply_instance }, + { rw [zpow_neg, zpow_coe_nat, neg_smul, exp_neg 𝕂, coe_nat_zsmul, exp_nsmul 𝕂]; apply_instance }, end lemma exp_conj (y : 𝔸) (x : 𝔸) (hy : y ≠ 0) : exp (y * x * y⁻¹) = y * exp x * y⁻¹ := -exp_units_conj _ (units.mk0 y hy) x +exp_units_conj 𝕂 (units.mk0 y hy) x lemma exp_conj' (y : 𝔸) (x : 𝔸) (hy : y ≠ 0) : exp (y⁻¹ * x * y) = y⁻¹ * exp x * y := -exp_units_conj' _ (units.mk0 y hy) x +exp_units_conj' 𝕂 (units.mk0 y hy) x end division_algebra @@ -618,15 +646,18 @@ variables [algebra ℚ 𝔸] /-- In a commutative Banach-algebra `𝔸` over `𝕂 = ℝ` or `𝕂 = ℂ`, `exp (x+y) = (exp x) * (exp y)`. -/ lemma exp_add {x y : 𝔸} : exp (x + y) = (exp x) * (exp y) := -exp_add_of_mem_ball ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) +exp_add_of_mem_ball 𝕂 + ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) ((exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _) /-- A version of `exp_sum_of_commute` for a commutative Banach-algebra. -/ lemma exp_sum {ι} (s : finset ι) (f : ι → 𝔸) : exp (∑ i in s, f i) = ∏ i in s, exp (f i) := +let 𝕂 := 𝕂 in begin - rw [exp_sum_of_commute, finset.noncomm_prod_eq_prod], - exact λ i hi j hj, commute.all _ _, + rw [exp_sum_of_commute 𝕂, finset.noncomm_prod_eq_prod], + exact λ i hi j hj _, commute.all _ _, + all_goals {apply_instance} end end comm_algebra diff --git a/src/analysis/normed_space/extend.lean b/src/analysis/normed_space/extend.lean index fd9f11ecc7330..1b12d11cc1e0c 100644 --- a/src/analysis/normed_space/extend.lean +++ b/src/analysis/normed_space/extend.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Ruben Van de Velde -/ +import analysis.normed_space.operator_norm import algebra.algebra.restrict_scalars -import data.complex.is_R_or_C +import data.is_R_or_C.basic /-! # Extending a continuous `ℝ`-linear map to a continuous `𝕜`-linear map +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we provide a way to extend a continuous `ℝ`-linear map to a continuous `𝕜`-linear map in a way that bounds the norm by the norm of the original map, when `𝕜` is either `ℝ` (the extension is trivial) or `ℂ`. We formulate the extension uniformly, by assuming `is_R_or_C 𝕜`. @@ -31,14 +35,17 @@ Alternate forms which operate on `[is_scalar_tower ℝ 𝕜 F]` instead are prov -/ open is_R_or_C +open_locale complex_conjugate + +variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [seminormed_add_comm_group F] [normed_space 𝕜 F] + +namespace linear_map -variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [normed_space 𝕜 F] -local notation `abs𝕜` := @is_R_or_C.abs 𝕜 _ +variables [module ℝ F] [is_scalar_tower ℝ 𝕜 F] /-- Extend `fr : F →ₗ[ℝ] ℝ` to `F →ₗ[𝕜] 𝕜` in a way that will also be continuous and have its norm -bounded by `∥fr∥` if `fr` is continuous. -/ -noncomputable def linear_map.extend_to_𝕜' - [module ℝ F] [is_scalar_tower ℝ 𝕜 F] (fr : F →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 := +bounded by `‖fr‖` if `fr` is continuous. -/ +noncomputable def extend_to_𝕜' (fr : F →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 := begin let fc : F → 𝕜 := λ x, (fr x : 𝕜) - (I : 𝕜) * (fr ((I : 𝕜) • x)), have add : ∀ x y : F, fc (x + y) = fc x + fc y, @@ -72,61 +79,57 @@ begin exact { to_fun := fc, map_add' := add, map_smul' := smul_𝕜 } end -lemma linear_map.extend_to_𝕜'_apply [module ℝ F] [is_scalar_tower ℝ 𝕜 F] - (fr : F →ₗ[ℝ] ℝ) (x : F) : +lemma extend_to_𝕜'_apply (fr : F →ₗ[ℝ] ℝ) (x : F) : fr.extend_to_𝕜' x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl -/-- The norm of the extension is bounded by `∥fr∥`. -/ -lemma norm_bound [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F] (fr : F →L[ℝ] ℝ) (x : F) : - ∥(fr.to_linear_map.extend_to_𝕜' x : 𝕜)∥ ≤ ∥fr∥ * ∥x∥ := +@[simp] lemma extend_to_𝕜'_apply_re (fr : F →ₗ[ℝ] ℝ) (x : F) : re (fr.extend_to_𝕜' x : 𝕜) = fr x := +by simp only [extend_to_𝕜'_apply, map_sub, zero_mul, mul_zero, sub_zero] with is_R_or_C_simps + +lemma norm_extend_to_𝕜'_apply_sq (f : F →ₗ[ℝ] ℝ) (x : F) : + ‖(f.extend_to_𝕜' x : 𝕜)‖ ^ 2 = f (conj (f.extend_to_𝕜' x : 𝕜) • x) := +calc ‖(f.extend_to_𝕜' x : 𝕜)‖ ^ 2 = re (conj (f.extend_to_𝕜' x) * f.extend_to_𝕜' x : 𝕜) : + by rw [is_R_or_C.conj_mul, norm_sq_eq_def', of_real_re] +... = f (conj (f.extend_to_𝕜' x : 𝕜) • x) : + by rw [← smul_eq_mul, ← map_smul, extend_to_𝕜'_apply_re] + +end linear_map + +namespace continuous_linear_map + +variables [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F] + +/-- The norm of the extension is bounded by `‖fr‖`. -/ +lemma norm_extend_to_𝕜'_bound (fr : F →L[ℝ] ℝ) (x : F) : + ‖(fr.to_linear_map.extend_to_𝕜' x : 𝕜)‖ ≤ ‖fr‖ * ‖x‖ := begin - let lm : F →ₗ[𝕜] 𝕜 := fr.to_linear_map.extend_to_𝕜', - -- We aim to find a `t : 𝕜` such that - -- * `lm (t • x) = fr (t • x)` (so `lm (t • x) = t * lm x ∈ ℝ`) - -- * `∥lm x∥ = ∥lm (t • x)∥` (so `t.abs` must be 1) - -- If `lm x ≠ 0`, `(lm x)⁻¹` satisfies the first requirement, and after normalizing, it - -- satisfies the second. - -- (If `lm x = 0`, the goal is trivial.) + set lm : F →ₗ[𝕜] 𝕜 := fr.to_linear_map.extend_to_𝕜', classical, by_cases h : lm x = 0, { rw [h, norm_zero], apply mul_nonneg; exact norm_nonneg _ }, - let fx := (lm x)⁻¹, - let t := fx / (abs𝕜 fx : 𝕜), - have ht : abs𝕜 t = 1, by field_simp [abs_of_real, of_real_inv, is_R_or_C.abs_inv, - is_R_or_C.abs_div, is_R_or_C.abs_abs, h], - have h1 : (fr (t • x) : 𝕜) = lm (t • x), - { apply ext, - { simp only [lm, of_real_re, linear_map.extend_to_𝕜'_apply, mul_re, I_re, of_real_im, zero_mul, - add_monoid_hom.map_sub, sub_zero, mul_zero], - refl }, - { symmetry, - calc im (lm (t • x)) - = im (t * lm x) : by rw [lm.map_smul, smul_eq_mul] - ... = im ((lm x)⁻¹ / (abs𝕜 (lm x)⁻¹) * lm x) : rfl - ... = im (1 / (abs𝕜 (lm x)⁻¹ : 𝕜)) : by rw [div_mul_eq_mul_div, inv_mul_cancel h] - ... = 0 : by rw [← of_real_one, ← of_real_div, of_real_im] - ... = im (fr (t • x) : 𝕜) : by rw [of_real_im] } }, - calc ∥lm x∥ = abs𝕜 t * ∥lm x∥ : by rw [ht, one_mul] - ... = ∥t * lm x∥ : by rw [← norm_eq_abs, norm_mul] - ... = ∥lm (t • x)∥ : by rw [←smul_eq_mul, lm.map_smul] - ... = ∥(fr (t • x) : 𝕜)∥ : by rw h1 - ... = ∥fr (t • x)∥ : by rw [norm_eq_abs, abs_of_real, norm_eq_abs, abs_to_real] - ... ≤ ∥fr∥ * ∥t • x∥ : continuous_linear_map.le_op_norm _ _ - ... = ∥fr∥ * (∥t∥ * ∥x∥) : by rw norm_smul - ... ≤ ∥fr∥ * ∥x∥ : by rw [norm_eq_abs, ht, one_mul] + rw [← mul_le_mul_left (norm_pos_iff.2 h), ← sq], + calc ‖lm x‖ ^ 2 = fr (conj (lm x : 𝕜) • x) : fr.to_linear_map.norm_extend_to_𝕜'_apply_sq x + ... ≤ ‖fr (conj (lm x : 𝕜) • x)‖ : le_abs_self _ + ... ≤ ‖fr‖ * ‖conj (lm x : 𝕜) • x‖ : le_op_norm _ _ + ... = ‖(lm x : 𝕜)‖ * (‖fr‖ * ‖x‖) : by rw [norm_smul, norm_conj, mul_left_comm] end /-- Extend `fr : F →L[ℝ] ℝ` to `F →L[𝕜] 𝕜`. -/ -noncomputable def continuous_linear_map.extend_to_𝕜' [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F] - (fr : F →L[ℝ] ℝ) : - F →L[𝕜] 𝕜 := -linear_map.mk_continuous _ (∥fr∥) (norm_bound _) +noncomputable def extend_to_𝕜' (fr : F →L[ℝ] ℝ) : F →L[𝕜] 𝕜 := +linear_map.mk_continuous _ (‖fr‖) fr.norm_extend_to_𝕜'_bound -lemma continuous_linear_map.extend_to_𝕜'_apply [normed_space ℝ F] [is_scalar_tower ℝ 𝕜 F] - (fr : F →L[ℝ] ℝ) (x : F) : +lemma extend_to_𝕜'_apply (fr : F →L[ℝ] ℝ) (x : F) : fr.extend_to_𝕜' x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x) := rfl +@[simp] lemma norm_extend_to_𝕜' (fr : F →L[ℝ] ℝ) : ‖(fr.extend_to_𝕜' : F →L[𝕜] 𝕜)‖ = ‖fr‖ := +le_antisymm (linear_map.mk_continuous_norm_le _ (norm_nonneg _) _) $ + op_norm_le_bound _ (norm_nonneg _) $ λ x, + calc ‖fr x‖ = ‖re (fr.extend_to_𝕜' x : 𝕜)‖ : congr_arg norm (fr.extend_to_𝕜'_apply_re x).symm + ... ≤ ‖(fr.extend_to_𝕜' x : 𝕜)‖ : abs_re_le_norm _ + ... ≤ ‖(fr.extend_to_𝕜' : F →L[𝕜] 𝕜)‖ * ‖x‖ : le_op_norm _ _ + +end continuous_linear_map + /-- Extend `fr : restrict_scalars ℝ 𝕜 F →ₗ[ℝ] ℝ` to `F →ₗ[𝕜] 𝕜`. -/ noncomputable def linear_map.extend_to_𝕜 (fr : (restrict_scalars ℝ 𝕜 F) →ₗ[ℝ] ℝ) : F →ₗ[𝕜] 𝕜 := fr.extend_to_𝕜' @@ -141,3 +144,7 @@ fr.extend_to_𝕜' lemma continuous_linear_map.extend_to_𝕜_apply (fr : (restrict_scalars ℝ 𝕜 F) →L[ℝ] ℝ) (x : F) : fr.extend_to_𝕜 x = (fr x : 𝕜) - (I : 𝕜) * fr ((I : 𝕜) • x : _) := rfl + +@[simp] lemma continuous_linear_map.norm_extend_to_𝕜 (fr : (restrict_scalars ℝ 𝕜 F) →L[ℝ] ℝ) : + ‖fr.extend_to_𝕜‖ = ‖fr‖ := +fr.norm_extend_to_𝕜' diff --git a/src/analysis/normed_space/extr.lean b/src/analysis/normed_space/extr.lean new file mode 100644 index 0000000000000..29b2bc70da3a9 --- /dev/null +++ b/src/analysis/normed_space/extr.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.normed_space.ray +import topology.local_extr + +/-! +# (Local) maximums in a normed space + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove the following lemma, see `is_max_filter.norm_add_same_ray`. If `f : α → E` is +a function such that `norm ∘ f` has a maximum along a filter `l` at a point `c` and `y` is a vector +on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a maximul along `l` at `c`. + +Then we specialize it to the case `y = f c` and to different special cases of `is_max_filter`: +`is_max_on`, `is_local_max_on`, and `is_local_max`. + +## Tags + +local maximum, normed space +-/ + +variables {α X E : Type*} [seminormed_add_comm_group E] [normed_space ℝ E] [topological_space X] + +section + +variables {f : α → E} {l : filter α} {s : set α} {c : α} {y : E} + +/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum along a filter `l` at a point +`c` and `y` is a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a maximul +along `l` at `c`. -/ +lemma is_max_filter.norm_add_same_ray (h : is_max_filter (norm ∘ f) l c) (hy : same_ray ℝ (f c) y) : + is_max_filter (λ x, ‖f x + y‖) l c := +h.mono $ λ x hx, +calc ‖f x + y‖ ≤ ‖f x‖ + ‖y‖ : norm_add_le _ _ + ... ≤ ‖f c‖ + ‖y‖ : add_le_add_right hx _ + ... = ‖f c + y‖ : hy.norm_add.symm + +/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum along a filter `l` at a point +`c`, then the function `λ x, ‖f x + f c‖` has a maximul along `l` at `c`. -/ +lemma is_max_filter.norm_add_self (h : is_max_filter (norm ∘ f) l c) : + is_max_filter (λ x, ‖f x + f c‖) l c := +h.norm_add_same_ray same_ray.rfl + +/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum on a set `s` at a point `c` and +`y` is a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a maximul on `s` at +`c`. -/ +lemma is_max_on.norm_add_same_ray (h : is_max_on (norm ∘ f) s c) (hy : same_ray ℝ (f c) y) : + is_max_on (λ x, ‖f x + y‖) s c := +h.norm_add_same_ray hy + +/-- If `f : α → E` is a function such that `norm ∘ f` has a maximum on a set `s` at a point `c`, +then the function `λ x, ‖f x + f c‖` has a maximul on `s` at `c`. -/ +lemma is_max_on.norm_add_self (h : is_max_on (norm ∘ f) s c) : is_max_on (λ x, ‖f x + f c‖) s c := +h.norm_add_self + +end + +variables {f : X → E} {s : set X} {c : X} {y : E} + +/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum on a set `s` at a point +`c` and `y` is a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a local +maximul on `s` at `c`. -/ +lemma is_local_max_on.norm_add_same_ray (h : is_local_max_on (norm ∘ f) s c) + (hy : same_ray ℝ (f c) y) : is_local_max_on (λ x, ‖f x + y‖) s c := +h.norm_add_same_ray hy + +/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum on a set `s` at a point +`c`, then the function `λ x, ‖f x + f c‖` has a local maximul on `s` at `c`. -/ +lemma is_local_max_on.norm_add_self (h : is_local_max_on (norm ∘ f) s c) : + is_local_max_on (λ x, ‖f x + f c‖) s c := +h.norm_add_self + +/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum at a point `c` and `y` is +a vector on the same ray as `f c`, then the function `λ x, ‖f x + y‖` has a local maximul at `c`. -/ +lemma is_local_max.norm_add_same_ray (h : is_local_max (norm ∘ f) c) + (hy : same_ray ℝ (f c) y) : is_local_max (λ x, ‖f x + y‖) c := +h.norm_add_same_ray hy + +/-- If `f : α → E` is a function such that `norm ∘ f` has a local maximum at a point `c`, then the +function `λ x, ‖f x + f c‖` has a local maximul at `c`. -/ +lemma is_local_max.norm_add_self (h : is_local_max (norm ∘ f) c) : + is_local_max (λ x, ‖f x + f c‖) c := +h.norm_add_self diff --git a/src/analysis/normed_space/finite_dimension.lean b/src/analysis/normed_space/finite_dimension.lean index cfdde83cd0715..9739b24088220 100644 --- a/src/analysis/normed_space/finite_dimension.lean +++ b/src/analysis/normed_space/finite_dimension.lean @@ -4,22 +4,25 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel -/ import analysis.asymptotics.asymptotic_equivalent +import analysis.normed_space.add_torsor import analysis.normed_space.affine_isometry import analysis.normed_space.operator_norm import analysis.normed_space.riesz_lemma -import linear_algebra.matrix.to_lin +import topology.algebra.module.finite_dimension +import topology.algebra.infinite_sum.module import topology.instances.matrix /-! # Finite dimensional normed spaces over complete fields -Over a complete nondiscrete field, in finite dimension, all norms are equivalent and all linear maps -are continuous. Moreover, a finite-dimensional subspace is always complete and closed. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Over a complete nontrivially normed field, in finite dimension, all norms are equivalent and all +linear maps are continuous. Moreover, a finite-dimensional subspace is always complete and closed. ## Main results: -* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional space over a - complete field is continuous. * `finite_dimensional.complete` : a finite-dimensional space over a complete field is complete. This is not registered as an instance, as the field would be an unknown metavariable in typeclass resolution. @@ -47,7 +50,7 @@ universes u v w x noncomputable theory open set finite_dimensional topological_space filter asymptotics -open_locale classical big_operators filter topological_space asymptotics nnreal +open_locale classical big_operators filter topology asymptotics nnreal namespace linear_isometry @@ -55,8 +58,8 @@ open linear_map variables {R : Type*} [semiring R] -variables {F E₁ : Type*} [semi_normed_group F] - [normed_group E₁] [module R E₁] +variables {F E₁ : Type*} [seminormed_add_comm_group F] + [normed_add_comm_group E₁] [module R E₁] variables {R₁ : Type*} [field R₁] [module R₁ E₁] [module R₁ F] [finite_dimensional R₁ E₁] [finite_dimensional R₁ F] @@ -85,7 +88,7 @@ open affine_map variables {𝕜 : Type*} {V₁ V₂ : Type*} {P₁ P₂ : Type*} [normed_field 𝕜] - [normed_group V₁] [semi_normed_group V₂] + [normed_add_comm_group V₁] [seminormed_add_comm_group V₂] [normed_space 𝕜 V₁] [normed_space 𝕜 V₂] [metric_space P₁] [pseudo_metric_space P₂] [normed_add_torsor V₁ P₁] [normed_add_torsor V₂ P₂] @@ -109,132 +112,15 @@ affine_isometry_equiv.mk' li (li.linear_isometry.to_linear_isometry_equiv h) (ar end affine_isometry -/-- A linear map on `ι → 𝕜` (where `ι` is a fintype) is continuous -/ -lemma linear_map.continuous_on_pi {ι : Type w} [fintype ι] {𝕜 : Type u} [normed_field 𝕜] - {E : Type v} [add_comm_group E] [module 𝕜 E] [topological_space E] - [topological_add_group E] [has_continuous_smul 𝕜 E] (f : (ι → 𝕜) →ₗ[𝕜] E) : continuous f := -begin - -- for the proof, write `f` in the standard basis, and use that each coordinate is a continuous - -- function. - have : (f : (ι → 𝕜) → E) = - (λx, ∑ i : ι, x i • (f (λj, if i = j then 1 else 0))), - by { ext x, exact f.pi_apply_eq_sum_univ x }, - rw this, - refine continuous_finset_sum _ (λi hi, _), - exact (continuous_apply i).smul continuous_const -end - -/-- The space of continuous linear maps between finite-dimensional spaces is finite-dimensional. -/ -instance {𝕜 E F : Type*} [field 𝕜] [topological_space 𝕜] - [topological_space E] [add_comm_group E] [module 𝕜 E] [finite_dimensional 𝕜 E] - [topological_space F] [add_comm_group F] [module 𝕜 F] [topological_add_group F] - [has_continuous_smul 𝕜 F] [finite_dimensional 𝕜 F] : - finite_dimensional 𝕜 (E →L[𝕜] F) := -finite_dimensional.of_injective - (continuous_linear_map.coe_lm 𝕜 : (E →L[𝕜] F) →ₗ[𝕜] (E →ₗ[𝕜] F)) - continuous_linear_map.coe_injective - section complete_field -variables {𝕜 : Type u} [nondiscrete_normed_field 𝕜] -{E : Type v} [normed_group E] [normed_space 𝕜 E] -{F : Type w} [normed_group F] [normed_space 𝕜 F] +variables {𝕜 : Type u} [nontrivially_normed_field 𝕜] +{E : Type v} [normed_add_comm_group E] [normed_space 𝕜 E] +{F : Type w} [normed_add_comm_group F] [normed_space 𝕜 F] {F' : Type x} [add_comm_group F'] [module 𝕜 F'] [topological_space F'] [topological_add_group F'] [has_continuous_smul 𝕜 F'] [complete_space 𝕜] -/-- In finite dimension over a complete field, the canonical identification (in terms of a basis) -with `𝕜^n` together with its sup norm is continuous. This is the nontrivial part in the fact that -all norms are equivalent in finite dimension. - -This statement is superceded by the fact that every linear map on a finite-dimensional space is -continuous, in `linear_map.continuous_of_finite_dimensional`. -/ -lemma continuous_equiv_fun_basis {ι : Type v} [fintype ι] (ξ : basis ι 𝕜 E) : - continuous ξ.equiv_fun := -begin - unfreezingI { induction hn : fintype.card ι with n IH generalizing ι E }, - { apply ξ.equiv_fun.to_linear_map.continuous_of_bound 0 (λx, _), - have : ξ.equiv_fun x = 0, - by { ext i, exact (fintype.card_eq_zero_iff.1 hn).elim i }, - change ∥ξ.equiv_fun x∥ ≤ 0 * ∥x∥, - rw this, - simp [norm_nonneg] }, - { haveI : finite_dimensional 𝕜 E := of_fintype_basis ξ, - -- first step: thanks to the inductive assumption, any n-dimensional subspace is equivalent - -- to a standard space of dimension n, hence it is complete and therefore closed. - have H₁ : ∀s : submodule 𝕜 E, finrank 𝕜 s = n → is_closed (s : set E), - { assume s s_dim, - let b := basis.of_vector_space 𝕜 s, - have U : uniform_embedding b.equiv_fun.symm.to_equiv, - { have : fintype.card (basis.of_vector_space_index 𝕜 s) = n, - by { rw ← s_dim, exact (finrank_eq_card_basis b).symm }, - have : continuous b.equiv_fun := IH b this, - exact b.equiv_fun.symm.uniform_embedding b.equiv_fun.symm.to_linear_map.continuous_on_pi - this }, - have : is_complete (s : set E), - from complete_space_coe_iff_is_complete.1 ((complete_space_congr U).1 (by apply_instance)), - exact this.is_closed }, - -- second step: any linear form is continuous, as its kernel is closed by the first step - have H₂ : ∀f : E →ₗ[𝕜] 𝕜, continuous f, - { assume f, - have : finrank 𝕜 f.ker = n ∨ finrank 𝕜 f.ker = n.succ, - { have Z := f.finrank_range_add_finrank_ker, - rw [finrank_eq_card_basis ξ, hn] at Z, - by_cases H : finrank 𝕜 f.range = 0, - { right, - rw H at Z, - simpa using Z }, - { left, - have : finrank 𝕜 f.range = 1, - { refine le_antisymm _ (zero_lt_iff.mpr H), - simpa [finrank_self] using f.range.finrank_le }, - rw [this, add_comm, nat.add_one] at Z, - exact nat.succ.inj Z } }, - have : is_closed (f.ker : set E), - { cases this, - { exact H₁ _ this }, - { have : f.ker = ⊤, - by { apply eq_top_of_finrank_eq, rw [finrank_eq_card_basis ξ, hn, this] }, - simp [this] } }, - exact linear_map.continuous_iff_is_closed_ker.2 this }, - -- third step: applying the continuity to the linear form corresponding to a coefficient in the - -- basis decomposition, deduce that all such coefficients are controlled in terms of the norm - have : ∀i:ι, ∃C, 0 ≤ C ∧ ∀(x:E), ∥ξ.equiv_fun x i∥ ≤ C * ∥x∥, - { assume i, - let f : E →ₗ[𝕜] 𝕜 := (linear_map.proj i) ∘ₗ ↑ξ.equiv_fun, - let f' : E →L[𝕜] 𝕜 := { cont := H₂ f, ..f }, - exact ⟨∥f'∥, norm_nonneg _, λx, continuous_linear_map.le_op_norm f' x⟩ }, - -- fourth step: combine the bound on each coefficient to get a global bound and the continuity - choose C0 hC0 using this, - let C := ∑ i, C0 i, - have C_nonneg : 0 ≤ C := finset.sum_nonneg (λi hi, (hC0 i).1), - have C0_le : ∀i, C0 i ≤ C := - λi, finset.single_le_sum (λj hj, (hC0 j).1) (finset.mem_univ _), - apply ξ.equiv_fun.to_linear_map.continuous_of_bound C (λx, _), - rw pi_norm_le_iff, - { exact λi, le_trans ((hC0 i).2 x) (mul_le_mul_of_nonneg_right (C0_le i) (norm_nonneg _)) }, - { exact mul_nonneg C_nonneg (norm_nonneg _) } } -end - -/-- Any linear map on a finite dimensional space over a complete field is continuous. -/ -theorem linear_map.continuous_of_finite_dimensional [finite_dimensional 𝕜 E] (f : E →ₗ[𝕜] F') : - continuous f := -begin - -- for the proof, go to a model vector space `b → 𝕜` thanks to `continuous_equiv_fun_basis`, and - -- argue that all linear maps there are continuous. - let b := basis.of_vector_space 𝕜 E, - have A : continuous b.equiv_fun := - continuous_equiv_fun_basis b, - have B : continuous (f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E)) := - linear_map.continuous_on_pi _, - have : continuous ((f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E)) - ∘ b.equiv_fun) := B.comp A, - convert this, - ext x, - dsimp, - rw [basis.equiv_fun_symm_apply, basis.sum_repr] -end - section affine variables {PE PF : Type*} [metric_space PE] [normed_add_torsor E PE] [metric_space PF] @@ -272,7 +158,7 @@ begin change continuous (λ (f : E →L[𝕜] E), (f : E →ₗ[𝕜] E).det), by_cases h : ∃ (s : finset E), nonempty (basis ↥s 𝕜 E), { rcases h with ⟨s, ⟨b⟩⟩, - haveI : finite_dimensional 𝕜 E := finite_dimensional.of_finset_basis b, + haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis b, simp_rw linear_map.det_eq_det_to_matrix_of_finset b, refine continuous.matrix_det _, exact ((linear_map.to_matrix b b).to_linear_map.comp @@ -281,98 +167,17 @@ begin simpa only [h, monoid_hom.one_apply, dif_neg, not_false_iff] using continuous_const } end -namespace linear_map - -variables [finite_dimensional 𝕜 E] - -/-- The continuous linear map induced by a linear map on a finite dimensional space -/ -def to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F' := -{ to_fun := λ f, ⟨f, f.continuous_of_finite_dimensional⟩, - inv_fun := coe, - map_add' := λ f g, rfl, - map_smul' := λ c f, rfl, - left_inv := λ f, rfl, - right_inv := λ f, continuous_linear_map.coe_injective rfl } - -@[simp] lemma coe_to_continuous_linear_map' (f : E →ₗ[𝕜] F') : - ⇑f.to_continuous_linear_map = f := rfl - -@[simp] lemma coe_to_continuous_linear_map (f : E →ₗ[𝕜] F') : - (f.to_continuous_linear_map : E →ₗ[𝕜] F') = f := rfl - -@[simp] lemma coe_to_continuous_linear_map_symm : - ⇑(to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F').symm = coe := rfl - -end linear_map - -namespace linear_equiv - -variables [finite_dimensional 𝕜 E] - -/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional -space. -/ -def to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) : E ≃L[𝕜] F := -{ continuous_to_fun := e.to_linear_map.continuous_of_finite_dimensional, - continuous_inv_fun := begin - haveI : finite_dimensional 𝕜 F := e.finite_dimensional, - exact e.symm.to_linear_map.continuous_of_finite_dimensional - end, - ..e } - -@[simp] lemma coe_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) : - (e.to_continuous_linear_equiv : E →ₗ[𝕜] F) = e := rfl - -@[simp] lemma coe_to_continuous_linear_equiv' (e : E ≃ₗ[𝕜] F) : - (e.to_continuous_linear_equiv : E → F) = e := rfl - -@[simp] lemma coe_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) : - (e.to_continuous_linear_equiv.symm : F →ₗ[𝕜] E) = e.symm := rfl - -@[simp] lemma coe_to_continuous_linear_equiv_symm' (e : E ≃ₗ[𝕜] F) : - (e.to_continuous_linear_equiv.symm : F → E) = e.symm := rfl - -@[simp] lemma to_linear_equiv_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) : - e.to_continuous_linear_equiv.to_linear_equiv = e := -by { ext x, refl } - -@[simp] lemma to_linear_equiv_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) : - e.to_continuous_linear_equiv.symm.to_linear_equiv = e.symm := -by { ext x, refl } - -end linear_equiv - -namespace continuous_linear_map - -variable [finite_dimensional 𝕜 E] - -/-- Builds a continuous linear equivalence from a continuous linear map on a finite-dimensional -vector space whose determinant is nonzero. -/ -def to_continuous_linear_equiv_of_det_ne_zero - (f : E →L[𝕜] E) (hf : f.det ≠ 0) : E ≃L[𝕜] E := -((f : E →ₗ[𝕜] E).equiv_of_det_ne_zero hf).to_continuous_linear_equiv - -@[simp] lemma coe_to_continuous_linear_equiv_of_det_ne_zero (f : E →L[𝕜] E) (hf : f.det ≠ 0) : - (f.to_continuous_linear_equiv_of_det_ne_zero hf : E →L[𝕜] E) = f := -by { ext x, refl } - -@[simp] lemma to_continuous_linear_equiv_of_det_ne_zero_apply - (f : E →L[𝕜] E) (hf : f.det ≠ 0) (x : E) : - f.to_continuous_linear_equiv_of_det_ne_zero hf x = f x := -rfl - -end continuous_linear_map - /-- Any `K`-Lipschitz map from a subset `s` of a metric space `α` to a finite-dimensional real vector space `E'` can be extended to a Lipschitz map on the whole space `α`, with a slightly worse constant `C * K` where `C` only depends on `E'`. We record a working value for this constant `C` as `lipschitz_extension_constant E'`. -/ @[irreducible] def lipschitz_extension_constant - (E' : Type*) [normed_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] : ℝ≥0 := + (E' : Type*) [normed_add_comm_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] : ℝ≥0 := let A := (basis.of_vector_space ℝ E').equiv_fun.to_continuous_linear_equiv in - max (∥A.symm.to_continuous_linear_map∥₊ * ∥A.to_continuous_linear_map∥₊) 1 + max (‖A.symm.to_continuous_linear_map‖₊ * ‖A.to_continuous_linear_map‖₊) 1 lemma lipschitz_extension_constant_pos - (E' : Type*) [normed_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] : + (E' : Type*) [normed_add_comm_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] : 0 < lipschitz_extension_constant E' := by { rw lipschitz_extension_constant, exact zero_lt_one.trans_le (le_max_right _ _) } @@ -381,7 +186,7 @@ vector space `E'` can be extended to a Lipschitz map on the whole space `α`, wi constant `lipschitz_extension_constant E' * K`. -/ theorem lipschitz_on_with.extend_finite_dimension {α : Type*} [pseudo_metric_space α] - {E' : Type*} [normed_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] + {E' : Type*} [normed_add_comm_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] {s : set α} {f : α → E'} {K : ℝ≥0} (hf : lipschitz_on_with K f s) : ∃ (g : α → E'), lipschitz_with (lipschitz_extension_constant E' * K) g ∧ eq_on f g s := begin @@ -389,13 +194,13 @@ begin `E'` and such a space to transfer the result to `E'`. -/ let ι : Type* := basis.of_vector_space_index ℝ E', let A := (basis.of_vector_space ℝ E').equiv_fun.to_continuous_linear_equiv, - have LA : lipschitz_with (∥A.to_continuous_linear_map∥₊) A, by apply A.lipschitz, - have L : lipschitz_on_with (∥A.to_continuous_linear_map∥₊ * K) (A ∘ f) s := + have LA : lipschitz_with (‖A.to_continuous_linear_map‖₊) A, by apply A.lipschitz, + have L : lipschitz_on_with (‖A.to_continuous_linear_map‖₊ * K) (A ∘ f) s := LA.comp_lipschitz_on_with hf, - obtain ⟨g, hg, gs⟩ : ∃ g : α → (ι → ℝ), lipschitz_with (∥A.to_continuous_linear_map∥₊ * K) g ∧ + obtain ⟨g, hg, gs⟩ : ∃ g : α → (ι → ℝ), lipschitz_with (‖A.to_continuous_linear_map‖₊ * K) g ∧ eq_on (A ∘ f) g s := L.extend_pi, refine ⟨A.symm ∘ g, _, _⟩, - { have LAsymm : lipschitz_with (∥A.symm.to_continuous_linear_map∥₊) A.symm, + { have LAsymm : lipschitz_with (‖A.symm.to_continuous_linear_map‖₊) A.symm, by apply A.symm.lipschitz, apply (LAsymm.comp hg).weaken, rw [lipschitz_extension_constant, ← mul_assoc], @@ -408,24 +213,25 @@ end lemma linear_map.exists_antilipschitz_with [finite_dimensional 𝕜 E] (f : E →ₗ[𝕜] F) (hf : f.ker = ⊥) : ∃ K > 0, antilipschitz_with K f := begin - cases subsingleton_or_nontrivial E; resetI, + casesI subsingleton_or_nontrivial E, { exact ⟨1, zero_lt_one, antilipschitz_with.of_subsingleton⟩ }, { rw linear_map.ker_eq_bot at hf, let e : E ≃L[𝕜] f.range := (linear_equiv.of_injective f hf).to_continuous_linear_equiv, exact ⟨_, e.nnnorm_symm_pos, e.antilipschitz⟩ } end -protected lemma linear_independent.eventually {ι} [fintype ι] {f : ι → E} +protected lemma linear_independent.eventually {ι} [finite ι] {f : ι → E} (hf : linear_independent 𝕜 f) : ∀ᶠ g in 𝓝 f, linear_independent 𝕜 g := begin + casesI nonempty_fintype ι, simp only [fintype.linear_independent_iff'] at hf ⊢, rcases linear_map.exists_antilipschitz_with _ hf with ⟨K, K0, hK⟩, - have : tendsto (λ g : ι → E, ∑ i, ∥g i - f i∥) (𝓝 f) (𝓝 $ ∑ i, ∥f i - f i∥), + have : tendsto (λ g : ι → E, ∑ i, ‖g i - f i‖) (𝓝 f) (𝓝 $ ∑ i, ‖f i - f i‖), from tendsto_finset_sum _ (λ i hi, tendsto.norm $ ((continuous_apply i).tendsto _).sub tendsto_const_nhds), simp only [sub_self, norm_zero, finset.sum_const_zero] at this, refine (this.eventually (gt_mem_nhds $ inv_pos.2 K0)).mono (λ g hg, _), - replace hg : ∑ i, ∥g i - f i∥₊ < K⁻¹, by { rw ← nnreal.coe_lt_coe, push_cast, exact hg }, + replace hg : ∑ i, ‖g i - f i‖₊ < K⁻¹, by { rw ← nnreal.coe_lt_coe, push_cast, exact hg }, rw linear_map.ker_eq_bot, refine (hK.add_sub_lipschitz_with (lipschitz_with.of_dist_le_mul $ λ v u, _) hg).injective, simp only [dist_eq_norm, linear_map.lsum_apply, pi.sub_apply, linear_map.sum_apply, @@ -436,109 +242,56 @@ begin exact mul_le_mul_of_nonneg_left (norm_le_pi_norm (v - u) i) (norm_nonneg _) end -lemma is_open_set_of_linear_independent {ι : Type*} [fintype ι] : +lemma is_open_set_of_linear_independent {ι : Type*} [finite ι] : is_open {f : ι → E | linear_independent 𝕜 f} := is_open_iff_mem_nhds.2 $ λ f, linear_independent.eventually -lemma is_open_set_of_nat_le_rank (n : ℕ) : is_open {f : E →L[𝕜] F | ↑n ≤ rank (f : E →ₗ[𝕜] F)} := +lemma is_open_set_of_nat_le_rank (n : ℕ) : is_open {f : E →L[𝕜] F | ↑n ≤ (f : E →ₗ[𝕜] F).rank } := begin - simp only [le_rank_iff_exists_linear_independent_finset, set_of_exists, ← exists_prop], + simp only [linear_map.le_rank_iff_exists_linear_independent_finset, set_of_exists, ← exists_prop], refine is_open_bUnion (λ t ht, _), have : continuous (λ f : E →L[𝕜] F, (λ x : (t : set E), f x)), from continuous_pi (λ x, (continuous_linear_map.apply 𝕜 F (x : E)).continuous), exact is_open_set_of_linear_independent.preimage this end -/-- Two finite-dimensional normed spaces are continuously linearly equivalent if they have the same -(finite) dimension. -/ -theorem finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq - [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] (cond : finrank 𝕜 E = finrank 𝕜 F) : - nonempty (E ≃L[𝕜] F) := -(nonempty_linear_equiv_of_finrank_eq cond).map linear_equiv.to_continuous_linear_equiv - -/-- Two finite-dimensional normed spaces are continuously linearly equivalent if and only if they -have the same (finite) dimension. -/ -theorem finite_dimensional.nonempty_continuous_linear_equiv_iff_finrank_eq - [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] : - nonempty (E ≃L[𝕜] F) ↔ finrank 𝕜 E = finrank 𝕜 F := -⟨ λ ⟨h⟩, h.to_linear_equiv.finrank_eq, - λ h, finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq h ⟩ - -/-- A continuous linear equivalence between two finite-dimensional normed spaces of the same -(finite) dimension. -/ -def continuous_linear_equiv.of_finrank_eq [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] - (cond : finrank 𝕜 E = finrank 𝕜 F) : - E ≃L[𝕜] F := -(linear_equiv.of_finrank_eq E F cond).to_continuous_linear_equiv - -variables {ι : Type*} [fintype ι] - -/-- Construct a continuous linear map given the value at a finite basis. -/ -def basis.constrL (v : basis ι 𝕜 E) (f : ι → F) : - E →L[𝕜] F := -by haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis v; - exact (v.constr 𝕜 f).to_continuous_linear_map - -@[simp, norm_cast] lemma basis.coe_constrL (v : basis ι 𝕜 E) (f : ι → F) : - (v.constrL f : E →ₗ[𝕜] F) = v.constr 𝕜 f := rfl - -/-- The continuous linear equivalence between a vector space over `𝕜` with a finite basis and -functions from its basis indexing type to `𝕜`. -/ -def basis.equiv_funL (v : basis ι 𝕜 E) : E ≃L[𝕜] (ι → 𝕜) := -{ continuous_to_fun := begin - haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis v, - exact v.equiv_fun.to_linear_map.continuous_of_finite_dimensional, - end, - continuous_inv_fun := begin - change continuous v.equiv_fun.symm.to_fun, - exact v.equiv_fun.symm.to_linear_map.continuous_of_finite_dimensional, - end, - ..v.equiv_fun } - -@[simp] lemma basis.constrL_apply (v : basis ι 𝕜 E) (f : ι → F) (e : E) : - (v.constrL f) e = ∑ i, (v.equiv_fun e i) • f i := -v.constr_apply_fintype 𝕜 _ _ - -@[simp] lemma basis.constrL_basis (v : basis ι 𝕜 E) (f : ι → F) (i : ι) : - (v.constrL f) (v i) = f i := -v.constr_basis 𝕜 _ _ - lemma basis.op_nnnorm_le {ι : Type*} [fintype ι] (v : basis ι 𝕜 E) {u : E →L[𝕜] F} (M : ℝ≥0) - (hu : ∀ i, ∥u (v i)∥₊ ≤ M) : - ∥u∥₊ ≤ fintype.card ι • ∥v.equiv_funL.to_continuous_linear_map∥₊ * M := + (hu : ∀ i, ‖u (v i)‖₊ ≤ M) : + ‖u‖₊ ≤ fintype.card ι • ‖v.equiv_funL.to_continuous_linear_map‖₊ * M := u.op_nnnorm_le_bound _ $ λ e, begin set φ := v.equiv_funL.to_continuous_linear_map, calc - ∥u e∥₊ = ∥u (∑ i, v.equiv_fun e i • v i)∥₊ : by rw [v.sum_equiv_fun] - ... = ∥∑ i, (v.equiv_fun e i) • (u $ v i)∥₊ : by simp [u.map_sum, linear_map.map_smul] - ... ≤ ∑ i, ∥(v.equiv_fun e i) • (u $ v i)∥₊ : nnnorm_sum_le _ _ - ... = ∑ i, ∥v.equiv_fun e i∥₊ * ∥u (v i)∥₊ : by simp only [nnnorm_smul] - ... ≤ ∑ i, ∥v.equiv_fun e i∥₊ * M : finset.sum_le_sum (λ i hi, + ‖u e‖₊ = ‖u (∑ i, v.equiv_fun e i • v i)‖₊ : by rw [v.sum_equiv_fun] + ... = ‖∑ i, (v.equiv_fun e i) • (u $ v i)‖₊ : by simp [u.map_sum, linear_map.map_smul] + ... ≤ ∑ i, ‖(v.equiv_fun e i) • (u $ v i)‖₊ : nnnorm_sum_le _ _ + ... = ∑ i, ‖v.equiv_fun e i‖₊ * ‖u (v i)‖₊ : by simp only [nnnorm_smul] + ... ≤ ∑ i, ‖v.equiv_fun e i‖₊ * M : finset.sum_le_sum (λ i hi, mul_le_mul_of_nonneg_left (hu i) (zero_le _)) - ... = (∑ i, ∥v.equiv_fun e i∥₊) * M : finset.sum_mul.symm - ... ≤ fintype.card ι • (∥φ∥₊ * ∥e∥₊) * M : + ... = (∑ i, ‖v.equiv_fun e i‖₊) * M : finset.sum_mul.symm + ... ≤ fintype.card ι • (‖φ‖₊ * ‖e‖₊) * M : (suffices _, from mul_le_mul_of_nonneg_right this (zero_le M), - calc ∑ i, ∥v.equiv_fun e i∥₊ - ≤ fintype.card ι • ∥φ e∥₊ : pi.sum_nnnorm_apply_le_nnnorm _ - ... ≤ fintype.card ι • (∥φ∥₊ * ∥e∥₊) : nsmul_le_nsmul_of_le_right (φ.le_op_nnnorm e) _) - ... = fintype.card ι • ∥φ∥₊ * M * ∥e∥₊ : by simp only [smul_mul_assoc, mul_right_comm], + calc ∑ i, ‖v.equiv_fun e i‖₊ + ≤ fintype.card ι • ‖φ e‖₊ : pi.sum_nnnorm_apply_le_nnnorm _ + ... ≤ fintype.card ι • (‖φ‖₊ * ‖e‖₊) : nsmul_le_nsmul_of_le_right (φ.le_op_nnnorm e) _) + ... = fintype.card ι • ‖φ‖₊ * M * ‖e‖₊ : by simp only [smul_mul_assoc, mul_right_comm], end lemma basis.op_norm_le {ι : Type*} [fintype ι] (v : basis ι 𝕜 E) {u : E →L[𝕜] F} {M : ℝ} - (hM : 0 ≤ M) (hu : ∀ i, ∥u (v i)∥ ≤ M) : - ∥u∥ ≤ fintype.card ι • ∥v.equiv_funL.to_continuous_linear_map∥ * M := + (hM : 0 ≤ M) (hu : ∀ i, ‖u (v i)‖ ≤ M) : + ‖u‖ ≤ fintype.card ι • ‖v.equiv_funL.to_continuous_linear_map‖ * M := by simpa using nnreal.coe_le_coe.mpr (v.op_nnnorm_le ⟨M, hM⟩ hu) /-- A weaker version of `basis.op_nnnorm_le` that abstracts away the value of `C`. -/ -lemma basis.exists_op_nnnorm_le {ι : Type*} [fintype ι] (v : basis ι 𝕜 E) : - ∃ C > (0 : ℝ≥0), ∀ {u : E →L[𝕜] F} (M : ℝ≥0), (∀ i, ∥u (v i)∥₊ ≤ M) → ∥u∥₊ ≤ C*M := -⟨ max (fintype.card ι • ∥v.equiv_funL.to_continuous_linear_map∥₊) 1, +lemma basis.exists_op_nnnorm_le {ι : Type*} [finite ι] (v : basis ι 𝕜 E) : + ∃ C > (0 : ℝ≥0), ∀ {u : E →L[𝕜] F} (M : ℝ≥0), (∀ i, ‖u (v i)‖₊ ≤ M) → ‖u‖₊ ≤ C*M := +by casesI nonempty_fintype ι; exact + ⟨max (fintype.card ι • ‖v.equiv_funL.to_continuous_linear_map‖₊) 1, zero_lt_one.trans_le (le_max_right _ _), λ u M hu, (v.op_nnnorm_le M hu).trans $ mul_le_mul_of_nonneg_right (le_max_left _ _) (zero_le M)⟩ /-- A weaker version of `basis.op_norm_le` that abstracts away the value of `C`. -/ -lemma basis.exists_op_norm_le {ι : Type*} [fintype ι] (v : basis ι 𝕜 E) : - ∃ C > (0 : ℝ), ∀ {u : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ∥u (v i)∥ ≤ M) → ∥u∥ ≤ C*M := +lemma basis.exists_op_norm_le {ι : Type*} [finite ι] (v : basis ι 𝕜 E) : + ∃ C > (0 : ℝ), ∀ {u : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ‖u (v i)‖ ≤ M) → ‖u‖ ≤ C*M := let ⟨C, hC, h⟩ := v.exists_op_nnnorm_le in ⟨C, hC, λ u, subtype.forall'.mpr h⟩ instance [finite_dimensional 𝕜 E] [second_countable_topology F] : @@ -553,24 +306,24 @@ begin obtain ⟨u : ℕ → F, hu : dense_range u⟩ := exists_dense_seq F, let v := finite_dimensional.fin_basis 𝕜 E, obtain ⟨C : ℝ, C_pos : 0 < C, - hC : ∀ {φ : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ∥φ (v i)∥ ≤ M) → ∥φ∥ ≤ C * M⟩ := + hC : ∀ {φ : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ‖φ (v i)‖ ≤ M) → ‖φ‖ ≤ C * M⟩ := v.exists_op_norm_le, have h_2C : 0 < 2*C := mul_pos zero_lt_two C_pos, have hε2C : 0 < ε/(2*C) := div_pos ε_pos h_2C, - have : ∀ φ : E →L[𝕜] F, ∃ n : fin d → ℕ, ∥φ - (v.constrL $ u ∘ n)∥ ≤ ε/2, + have : ∀ φ : E →L[𝕜] F, ∃ n : fin d → ℕ, ‖φ - (v.constrL $ u ∘ n)‖ ≤ ε/2, { intros φ, - have : ∀ i, ∃ n, ∥φ (v i) - u n∥ ≤ ε/(2*C), + have : ∀ i, ∃ n, ‖φ (v i) - u n‖ ≤ ε/(2*C), { simp only [norm_sub_rev], intro i, have : φ (v i) ∈ closure (range u) := hu _, - obtain ⟨n, hn⟩ : ∃ n, ∥u n - φ (v i)∥ < ε / (2 * C), + obtain ⟨n, hn⟩ : ∃ n, ‖u n - φ (v i)‖ < ε / (2 * C), { rw mem_closure_iff_nhds_basis metric.nhds_basis_ball at this, specialize this (ε/(2*C)) hε2C, simpa [dist_eq_norm] }, exact ⟨n, le_of_lt hn⟩ }, choose n hn using this, use n, - replace hn : ∀ i : fin d, ∥(φ - (v.constrL $ u ∘ n)) (v i)∥ ≤ ε / (2 * C), by simp [hn], + replace hn : ∀ i : fin d, ‖(φ - (v.constrL $ u ∘ n)) (v i)‖ ≤ ε / (2 * C), by simp [hn], have : C * (ε / (2 * C)) = ε/2, { rw [eq_div_iff (two_ne_zero : (2 : ℝ) ≠ 0), mul_comm, ← mul_assoc, mul_div_cancel' _ (ne_of_gt h_2C)] }, @@ -593,7 +346,7 @@ explicitly when needed. -/ variables (𝕜 E) lemma finite_dimensional.complete [finite_dimensional 𝕜 E] : complete_space E := begin - set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ (finrank 𝕜 E)).symm, + set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ _ (finrank 𝕜 E)).symm, have : uniform_embedding e.to_linear_equiv.to_equiv.symm := e.symm.uniform_embedding, exact (complete_space_congr this).1 (by apply_instance) end @@ -618,9 +371,9 @@ section riesz /-- In an infinite dimensional space, given a finite number of points, one may find a point with norm at most `R` which is at distance at least `1` of all these points. -/ -theorem exists_norm_le_le_norm_sub_of_finset {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R) +theorem exists_norm_le_le_norm_sub_of_finset {c : 𝕜} (hc : 1 < ‖c‖) {R : ℝ} (hR : ‖c‖ < R) (h : ¬ (finite_dimensional 𝕜 E)) (s : finset E) : - ∃ (x : E), ∥x∥ ≤ R ∧ ∀ y ∈ s, 1 ≤ ∥y - x∥ := + ∃ (x : E), ‖x‖ ≤ R ∧ ∀ y ∈ s, 1 ≤ ‖y - x‖ := begin let F := submodule.span 𝕜 (s : set E), haveI : finite_dimensional 𝕜 F := module.finite_def.2 @@ -631,9 +384,9 @@ begin have : (⊤ : submodule 𝕜 E) = F, by { ext x, simp [h] }, have : finite_dimensional 𝕜 (⊤ : submodule 𝕜 E), by rwa this, refine module.finite_def.2 ((submodule.fg_top _).1 (module.finite_def.1 this)) }, - obtain ⟨x, xR, hx⟩ : ∃ (x : E), ∥x∥ ≤ R ∧ ∀ (y : E), y ∈ F → 1 ≤ ∥x - y∥ := + obtain ⟨x, xR, hx⟩ : ∃ (x : E), ‖x‖ ≤ R ∧ ∀ (y : E), y ∈ F → 1 ≤ ‖x - y‖ := riesz_lemma_of_norm_lt hc hR Fclosed this, - have hx' : ∀ (y : E), y ∈ F → 1 ≤ ∥y - x∥, + have hx' : ∀ (y : E), y ∈ F → 1 ≤ ‖y - x‖, { assume y hy, rw ← norm_neg, simpa using hx y hy }, exact ⟨x, xR, λ y hy, hx' _ (submodule.subset_span hy)⟩, end @@ -641,27 +394,27 @@ end /-- In an infinite-dimensional normed space, there exists a sequence of points which are all bounded by `R` and at distance at least `1`. For a version not assuming `c` and `R`, see `exists_seq_norm_le_one_le_norm_sub`. -/ -theorem exists_seq_norm_le_one_le_norm_sub' {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R) +theorem exists_seq_norm_le_one_le_norm_sub' {c : 𝕜} (hc : 1 < ‖c‖) {R : ℝ} (hR : ‖c‖ < R) (h : ¬ (finite_dimensional 𝕜 E)) : - ∃ f : ℕ → E, (∀ n, ∥f n∥ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ∥f m - f n∥) := + ∃ f : ℕ → E, (∀ n, ‖f n‖ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ‖f m - f n‖) := begin - haveI : is_symm E (λ (x y : E), 1 ≤ ∥x - y∥), + haveI : is_symm E (λ (x y : E), 1 ≤ ‖x - y‖), { constructor, assume x y hxy, rw ← norm_neg, simpa }, - apply exists_seq_of_forall_finset_exists' (λ (x : E), ∥x∥ ≤ R) (λ (x : E) (y : E), 1 ≤ ∥x - y∥), + apply exists_seq_of_forall_finset_exists' (λ (x : E), ‖x‖ ≤ R) (λ (x : E) (y : E), 1 ≤ ‖x - y‖), assume s hs, exact exists_norm_le_le_norm_sub_of_finset hc hR h s, end theorem exists_seq_norm_le_one_le_norm_sub (h : ¬ (finite_dimensional 𝕜 E)) : - ∃ (R : ℝ) (f : ℕ → E), (1 < R) ∧ (∀ n, ∥f n∥ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ∥f m - f n∥) := + ∃ (R : ℝ) (f : ℕ → E), (1 < R) ∧ (∀ n, ‖f n‖ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ‖f m - f n‖) := begin - obtain ⟨c, hc⟩ : ∃ (c : 𝕜), 1 < ∥c∥ := normed_field.exists_one_lt_norm 𝕜, - have A : ∥c∥ < ∥c∥ + 1, by linarith, + obtain ⟨c, hc⟩ : ∃ (c : 𝕜), 1 < ‖c‖ := normed_field.exists_one_lt_norm 𝕜, + have A : ‖c‖ < ‖c‖ + 1, by linarith, rcases exists_seq_norm_le_one_le_norm_sub' hc A h with ⟨f, hf⟩, - exact ⟨∥c∥ + 1, f, hc.trans A, hf.1, hf.2⟩ + exact ⟨‖c‖ + 1, f, hc.trans A, hf.1, hf.2⟩ end variable (𝕜) @@ -673,29 +426,29 @@ theorem finite_dimensional_of_is_compact_closed_ball₀ {r : ℝ} (rpos : 0 < r) begin by_contra hfin, obtain ⟨R, f, Rgt, fle, lef⟩ : - ∃ (R : ℝ) (f : ℕ → E), (1 < R) ∧ (∀ n, ∥f n∥ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ∥f m - f n∥) := + ∃ (R : ℝ) (f : ℕ → E), (1 < R) ∧ (∀ n, ‖f n‖ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ‖f m - f n‖) := exists_seq_norm_le_one_le_norm_sub hfin, have rRpos : 0 < r / R := div_pos rpos (zero_lt_one.trans Rgt), - obtain ⟨c, hc⟩ : ∃ (c : 𝕜), 0 < ∥c∥ ∧ ∥c∥ < (r / R) := normed_field.exists_norm_lt _ rRpos, + obtain ⟨c, hc⟩ : ∃ (c : 𝕜), 0 < ‖c‖ ∧ ‖c‖ < (r / R) := normed_field.exists_norm_lt _ rRpos, let g := λ (n : ℕ), c • f n, have A : ∀ n, g n ∈ metric.closed_ball (0 : E) r, { assume n, simp only [norm_smul, dist_zero_right, metric.mem_closed_ball], - calc ∥c∥ * ∥f n∥ ≤ (r / R) * R : mul_le_mul hc.2.le (fle n) (norm_nonneg _) rRpos.le + calc ‖c‖ * ‖f n‖ ≤ (r / R) * R : mul_le_mul hc.2.le (fle n) (norm_nonneg _) rRpos.le ... = r : by field_simp [(zero_lt_one.trans Rgt).ne'] }, obtain ⟨x, hx, φ, φmono, φlim⟩ : ∃ (x : E) (H : x ∈ metric.closed_ball (0 : E) r) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (g ∘ φ) at_top (𝓝 x) := h.tendsto_subseq A, have B : cauchy_seq (g ∘ φ) := φlim.cauchy_seq, - obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (n : ℕ), N ≤ n → dist ((g ∘ φ) n) ((g ∘ φ) N) < ∥c∥ := - metric.cauchy_seq_iff'.1 B (∥c∥) hc.1, - apply lt_irrefl (∥c∥), - calc ∥c∥ ≤ dist (g (φ (N+1))) (g (φ N)) : begin - conv_lhs { rw [← mul_one (∥c∥)] }, + obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (n : ℕ), N ≤ n → dist ((g ∘ φ) n) ((g ∘ φ) N) < ‖c‖ := + metric.cauchy_seq_iff'.1 B (‖c‖) hc.1, + apply lt_irrefl (‖c‖), + calc ‖c‖ ≤ dist (g (φ (N+1))) (g (φ N)) : begin + conv_lhs { rw [← mul_one (‖c‖)] }, simp only [g, dist_eq_norm, ←smul_sub, norm_smul, -mul_one], apply mul_le_mul_of_nonneg_left (lef _ _ (ne_of_gt _)) (norm_nonneg _), exact φmono (nat.lt_succ_self N) end - ... < ∥c∥ : hN (N+1) (nat.le_succ N) + ... < ‖c‖ : hN (N+1) (nat.le_succ N) end /-- **Riesz's theorem**: if a closed ball of positive radius is compact in a vector space, then the @@ -708,6 +461,27 @@ begin simpa using h.image this, end +/-- If a function has compact multiplicative support, then either the function is trivial or the +space if finite-dimensional. -/ +@[to_additive "If a function has compact support, then either the function is trivial or the +space if finite-dimensional."] +lemma has_compact_mul_support.eq_one_or_finite_dimensional {X : Type*} + [topological_space X] [has_one X] [t2_space X] + {f : E → X} (hf : has_compact_mul_support f) (h'f : continuous f) : + f = 1 ∨ finite_dimensional 𝕜 E := +begin + by_cases h : ∀ x, f x = 1, { apply or.inl, ext x, exact h x }, + apply or.inr, + push_neg at h, + obtain ⟨x, hx⟩ : ∃ x, f x ≠ 1, from h, + have : function.mul_support f ∈ 𝓝 x, from h'f.is_open_mul_support.mem_nhds hx, + obtain ⟨r, rpos, hr⟩ : ∃ (r : ℝ) (hi : 0 < r), metric.closed_ball x r ⊆ function.mul_support f, + from metric.nhds_basis_closed_ball.mem_iff.1 this, + have : is_compact (metric.closed_ball x r), + from is_compact_of_is_closed_subset hf metric.is_closed_ball (hr.trans (subset_mul_tsupport _)), + exact finite_dimensional_of_is_compact_closed_ball 𝕜 rpos this, +end + end riesz /-- An injective linear map with finite-dimensional domain is a closed embedding. -/ @@ -722,7 +496,7 @@ let g := linear_equiv.of_injective f (linear_map.ker_eq_bot.mp hf) in .. embedding_subtype_coe.comp g.to_continuous_linear_equiv.to_homeomorph.embedding } lemma continuous_linear_map.exists_right_inverse_of_surjective [finite_dimensional 𝕜 F] - (f : E →L[𝕜] F) (hf : f.range = ⊤) : + (f : E →L[𝕜] F) (hf : linear_map.range f = ⊤) : ∃ g : F →L[𝕜] E, f.comp g = continuous_linear_map.id 𝕜 F := let ⟨g, hg⟩ := (f : E →ₗ[𝕜] F).exists_right_inverse_of_surjective hf in ⟨g.to_continuous_linear_map, continuous_linear_map.ext $ linear_map.ext_iff.1 hg⟩ @@ -739,6 +513,7 @@ begin end open continuous_linear_map + /-- Continuous linear equivalence between continuous linear functions `𝕜ⁿ → E` and `Eⁿ`. The spaces `𝕜ⁿ` and `Eⁿ` are represented as `ι → 𝕜` and `ι → E`, respectively, where `ι` is a finite type. -/ @@ -752,7 +527,9 @@ def continuous_linear_equiv.pi_ring (ι : Type*) [fintype ι] [decidable_eq ι] continuous_inv_fun := begin simp_rw [linear_equiv.inv_fun_eq_symm, linear_equiv.trans_symm, linear_equiv.symm_symm], - apply linear_map.continuous_of_bound _ (fintype.card ι : ℝ) (λ g, _), + change continuous (linear_map.to_continuous_linear_map.to_linear_map.comp + (linear_equiv.pi_ring 𝕜 E ι 𝕜).symm.to_linear_map), + apply add_monoid_hom_class.continuous_of_bound _ (fintype.card ι : ℝ) (λ g, _), rw ← nsmul_eq_mul, apply op_norm_le_bound _ (nsmul_nonneg (norm_nonneg g) (fintype.card ι)) (λ t, _), simp_rw [linear_map.coe_comp, linear_equiv.coe_to_linear_map, function.comp_app, @@ -788,8 +565,8 @@ by simp_rw [continuous_iff_continuous_on_univ, continuous_on_clm_apply] end complete_field section proper_field -variables (𝕜 : Type u) [nondiscrete_normed_field 𝕜] -(E : Type v) [normed_group E] [normed_space 𝕜 E] [proper_space 𝕜] +variables (𝕜 : Type u) [nontrivially_normed_field 𝕜] +(E : Type v) [normed_add_comm_group E] [normed_space 𝕜 E] [proper_space 𝕜] /-- Any finite-dimensional vector space over a proper field is proper. We do not register this as an instance to avoid an instance loop when trying to prove the @@ -797,7 +574,7 @@ properness of `𝕜`, and the search for `𝕜` as an unknown metavariable. Decl explicitly when needed. -/ lemma finite_dimensional.proper [finite_dimensional 𝕜 E] : proper_space E := begin - set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ (finrank 𝕜 E)).symm, + set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ _ (finrank 𝕜 E)).symm, exact e.symm.antilipschitz.proper_space e.symm.continuous e.symm.surjective end @@ -806,15 +583,15 @@ end proper_field /- Over the real numbers, we can register the previous statement as an instance as it will not cause problems in instance resolution since the properness of `ℝ` is already known. -/ @[priority 900] -instance finite_dimensional.proper_real - (E : Type u) [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] : proper_space E := +instance finite_dimensional.proper_real (E : Type u) [normed_add_comm_group E] [normed_space ℝ E] + [finite_dimensional ℝ E] : proper_space E := finite_dimensional.proper ℝ E /-- If `E` is a finite dimensional normed real vector space, `x : E`, and `s` is a neighborhood of `x` that is not equal to the whole space, then there exists a point `y ∈ frontier s` at distance `metric.inf_dist x sᶜ` from `x`. See also `is_compact.exists_mem_frontier_inf_dist_compl_eq_dist`. -/ -lemma exists_mem_frontier_inf_dist_compl_eq_dist {E : Type*} [normed_group E] +lemma exists_mem_frontier_inf_dist_compl_eq_dist {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {x : E} {s : set E} (hx : x ∈ s) (hs : s ≠ univ) : ∃ y ∈ frontier s, metric.inf_dist x sᶜ = dist x y := begin @@ -828,7 +605,7 @@ end /-- If `K` is a compact set in a nontrivial real normed space and `x ∈ K`, then there exists a point `y` of the boundary of `K` at distance `metric.inf_dist x Kᶜ` from `x`. See also `exists_mem_frontier_inf_dist_compl_eq_dist`. -/ -lemma is_compact.exists_mem_frontier_inf_dist_compl_eq_dist {E : Type*} [normed_group E] +lemma is_compact.exists_mem_frontier_inf_dist_compl_eq_dist {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [nontrivial E] {x : E} {K : set E} (hK : is_compact K) (hx : x ∈ K) : ∃ y ∈ frontier K, metric.inf_dist x Kᶜ = dist x y := begin @@ -838,65 +615,65 @@ begin rcases hx' with ⟨r, hr₀, hrK⟩, haveI : finite_dimensional ℝ E, from finite_dimensional_of_is_compact_closed_ball ℝ hr₀ - (compact_of_is_closed_subset hK metric.is_closed_ball hrK), + (is_compact_of_is_closed_subset hK metric.is_closed_ball hrK), exact exists_mem_frontier_inf_dist_compl_eq_dist hx hK.ne_univ }, { refine ⟨x, hx', _⟩, rw frontier_eq_closure_inter_closure at hx', rw [metric.inf_dist_zero_of_mem_closure hx'.2, dist_self] }, end -/-- In a finite dimensional vector space over `ℝ`, the series `∑ x, ∥f x∥` is unconditionally +/-- In a finite dimensional vector space over `ℝ`, the series `∑ x, ‖f x‖` is unconditionally summable if and only if the series `∑ x, f x` is unconditionally summable. One implication holds in any complete normed space, while the other holds only in finite dimensional spaces. -/ -lemma summable_norm_iff {α E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] - {f : α → E} : summable (λ x, ∥f x∥) ↔ summable f := +lemma summable_norm_iff {α E : Type*} [normed_add_comm_group E] [normed_space ℝ E] + [finite_dimensional ℝ E] {f : α → E} : summable (λ x, ‖f x‖) ↔ summable f := begin refine ⟨summable_of_summable_norm, λ hf, _⟩, -- First we use a finite basis to reduce the problem to the case `E = fin N → ℝ` - suffices : ∀ {N : ℕ} {g : α → fin N → ℝ}, summable g → summable (λ x, ∥g x∥), + suffices : ∀ {N : ℕ} {g : α → fin N → ℝ}, summable g → summable (λ x, ‖g x‖), { obtain v := fin_basis ℝ E, set e := v.equiv_funL, - have : summable (λ x, ∥e (f x)∥) := this (e.summable.2 hf), + have : summable (λ x, ‖e (f x)‖) := this (e.summable.2 hf), refine summable_of_norm_bounded _ (this.mul_left - ↑(∥(e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E)∥₊)) (λ i, _), + ↑(‖(e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E)‖₊)) (λ i, _), simpa using (e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E).le_op_norm (e $ f i) }, unfreezingI { clear_dependent E }, -- Now we deal with `g : α → fin N → ℝ` intros N g hg, - have : ∀ i, summable (λ x, ∥g x i∥) := λ i, (pi.summable.1 hg i).abs, + have : ∀ i, summable (λ x, ‖g x i‖) := λ i, (pi.summable.1 hg i).abs, refine summable_of_norm_bounded _ (summable_sum (λ i (hi : i ∈ finset.univ), this i)) (λ x, _), - rw [norm_norm, pi_norm_le_iff], + rw [norm_norm, pi_norm_le_iff_of_nonneg], { refine λ i, finset.single_le_sum (λ i hi, _) (finset.mem_univ i), exact norm_nonneg (g x i) }, { exact finset.sum_nonneg (λ _ _, norm_nonneg _) } end -lemma summable_of_is_O' {ι E F : Type*} [normed_group E] [complete_space E] [normed_group F] - [normed_space ℝ F] [finite_dimensional ℝ F] {f : ι → E} {g : ι → F} - (hg : summable g) (h : is_O f g cofinite) : summable f := +lemma summable_of_is_O' {ι E F : Type*} [normed_add_comm_group E] [complete_space E] + [normed_add_comm_group F] [normed_space ℝ F] [finite_dimensional ℝ F] {f : ι → E} {g : ι → F} + (hg : summable g) (h : f =O[cofinite] g) : summable f := summable_of_is_O (summable_norm_iff.mpr hg) h.norm_right -lemma summable_of_is_O_nat' {E F : Type*} [normed_group E] [complete_space E] [normed_group F] - [normed_space ℝ F] [finite_dimensional ℝ F] {f : ℕ → E} {g : ℕ → F} - (hg : summable g) (h : is_O f g at_top) : summable f := +lemma summable_of_is_O_nat' {E F : Type*} [normed_add_comm_group E] [complete_space E] + [normed_add_comm_group F] [normed_space ℝ F] [finite_dimensional ℝ F] {f : ℕ → E} {g : ℕ → F} + (hg : summable g) (h : f =O[at_top] g) : summable f := summable_of_is_O_nat (summable_norm_iff.mpr hg) h.norm_right -lemma summable_of_is_equivalent {ι E : Type*} [normed_group E] [normed_space ℝ E] +lemma summable_of_is_equivalent {ι E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {f : ι → E} {g : ι → E} (hg : summable g) (h : f ~[cofinite] g) : summable f := hg.trans_sub (summable_of_is_O' hg h.is_o.is_O) -lemma summable_of_is_equivalent_nat {E : Type*} [normed_group E] [normed_space ℝ E] +lemma summable_of_is_equivalent_nat {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {f : ℕ → E} {g : ℕ → E} (hg : summable g) (h : f ~[at_top] g) : summable f := hg.trans_sub (summable_of_is_O_nat' hg h.is_o.is_O) -lemma is_equivalent.summable_iff {ι E : Type*} [normed_group E] [normed_space ℝ E] +lemma is_equivalent.summable_iff {ι E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {f : ι → E} {g : ι → E} (h : f ~[cofinite] g) : summable f ↔ summable g := ⟨λ hf, summable_of_is_equivalent hf h.symm, λ hg, summable_of_is_equivalent hg h⟩ -lemma is_equivalent.summable_iff_nat {E : Type*} [normed_group E] [normed_space ℝ E] +lemma is_equivalent.summable_iff_nat {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E] {f : ℕ → E} {g : ℕ → E} (h : f ~[at_top] g) : summable f ↔ summable g := ⟨λ hf, summable_of_is_equivalent_nat hf h.symm, λ hg, summable_of_is_equivalent_nat hg h⟩ diff --git a/src/analysis/normed_space/hahn_banach.lean b/src/analysis/normed_space/hahn_banach.lean deleted file mode 100644 index 2a49649ee1276..0000000000000 --- a/src/analysis/normed_space/hahn_banach.lean +++ /dev/null @@ -1,149 +0,0 @@ -/- -Copyright (c) 2020 Yury Kudryashov All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yury Kudryashov, Heather Macbeth --/ -import analysis.convex.cone -import analysis.normed_space.is_R_or_C -import analysis.normed_space.extend - -/-! -# Hahn-Banach theorem - -In this file we prove a version of Hahn-Banach theorem for continuous linear -functions on normed spaces over `ℝ` and `ℂ`. - -In order to state and prove its corollaries uniformly, we prove the statements for a field `𝕜` -satisfying `is_R_or_C 𝕜`. - -In this setting, `exists_dual_vector` states that, for any nonzero `x`, there exists a continuous -linear form `g` of norm `1` with `g x = ∥x∥` (where the norm has to be interpreted as an element -of `𝕜`). - --/ - -universes u v - -namespace real -variables {E : Type*} [semi_normed_group E] [normed_space ℝ E] - -/-- Hahn-Banach theorem for continuous linear functions over `ℝ`. -/ -theorem exists_extension_norm_eq (p : subspace ℝ E) (f : p →L[ℝ] ℝ) : - ∃ g : E →L[ℝ] ℝ, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ := -begin - rcases exists_extension_of_le_sublinear ⟨p, f⟩ (λ x, ∥f∥ * ∥x∥) - (λ c hc x, by simp only [norm_smul c x, real.norm_eq_abs, abs_of_pos hc, mul_left_comm]) - (λ x y, _) (λ x, le_trans (le_abs_self _) (f.le_op_norm _)) - with ⟨g, g_eq, g_le⟩, - set g' := g.mk_continuous (∥f∥) - (λ x, abs_le.2 ⟨neg_le.1 $ g.map_neg x ▸ norm_neg x ▸ g_le (-x), g_le x⟩), - { refine ⟨g', g_eq, _⟩, - { apply le_antisymm (g.mk_continuous_norm_le (norm_nonneg f) _), - refine f.op_norm_le_bound (norm_nonneg _) (λ x, _), - dsimp at g_eq, - rw ← g_eq, - apply g'.le_op_norm } }, - { simp only [← mul_add], - exact mul_le_mul_of_nonneg_left (norm_add_le x y) (norm_nonneg f) } -end - -end real - -section is_R_or_C -open is_R_or_C - -variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [normed_space 𝕜 F] - -/-- Hahn-Banach theorem for continuous linear functions over `𝕜` satisyfing `is_R_or_C 𝕜`. -/ -theorem exists_extension_norm_eq (p : subspace 𝕜 F) (f : p →L[𝕜] 𝕜) : - ∃ g : F →L[𝕜] 𝕜, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ := -begin - letI : module ℝ F := restrict_scalars.module ℝ 𝕜 F, - letI : is_scalar_tower ℝ 𝕜 F := restrict_scalars.is_scalar_tower _ _ _, - letI : normed_space ℝ F := normed_space.restrict_scalars _ 𝕜 _, - -- Let `fr: p →L[ℝ] ℝ` be the real part of `f`. - let fr := re_clm.comp (f.restrict_scalars ℝ), - have fr_apply : ∀ x, fr x = re (f x), by { assume x, refl }, - -- Use the real version to get a norm-preserving extension of `fr`, which - -- we'll call `g : F →L[ℝ] ℝ`. - rcases real.exists_extension_norm_eq (p.restrict_scalars ℝ) fr with ⟨g, ⟨hextends, hnormeq⟩⟩, - -- Now `g` can be extended to the `F →L[𝕜] 𝕜` we need. - refine ⟨g.extend_to_𝕜, _⟩, - -- It is an extension of `f`. - have h : ∀ x : p, g.extend_to_𝕜 x = f x, - { assume x, - rw [continuous_linear_map.extend_to_𝕜_apply, ←submodule.coe_smul, hextends, hextends], - have : (fr x : 𝕜) - I * ↑(fr (I • x)) = (re (f x) : 𝕜) - (I : 𝕜) * (re (f ((I : 𝕜) • x))), - by refl, - rw this, - apply ext, - { simp only [add_zero, algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, - zero_sub, I_im', zero_mul, of_real_re, eq_self_iff_true, sub_zero, mul_neg, - of_real_neg, mul_re, mul_zero, sub_neg_eq_add, continuous_linear_map.map_smul] }, - { simp only [algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, zero_sub, I_im', - zero_mul, of_real_re, mul_neg, mul_im, zero_add, of_real_neg, mul_re, - sub_neg_eq_add, continuous_linear_map.map_smul] } }, - -- And we derive the equality of the norms by bounding on both sides. - refine ⟨h, le_antisymm _ _⟩, - { calc ∥g.extend_to_𝕜∥ - ≤ ∥g∥ : g.extend_to_𝕜.op_norm_le_bound g.op_norm_nonneg (norm_bound _) - ... = ∥fr∥ : hnormeq - ... ≤ ∥re_clm∥ * ∥f∥ : continuous_linear_map.op_norm_comp_le _ _ - ... = ∥f∥ : by rw [re_clm_norm, one_mul] }, - { exact f.op_norm_le_bound g.extend_to_𝕜.op_norm_nonneg (λ x, h x ▸ g.extend_to_𝕜.le_op_norm x) } -end - -end is_R_or_C - -section dual_vector -variables (𝕜 : Type v) [is_R_or_C 𝕜] -variables {E : Type u} [normed_group E] [normed_space 𝕜 E] - -open continuous_linear_equiv submodule -open_locale classical - -lemma coord_norm' {x : E} (h : x ≠ 0) : ∥(∥x∥ : 𝕜) • coord 𝕜 x h∥ = 1 := -by rw [norm_smul, is_R_or_C.norm_coe_norm, coord_norm, mul_inv_cancel (mt norm_eq_zero.mp h)] - -/-- Corollary of Hahn-Banach. Given a nonzero element `x` of a normed space, there exists an - element of the dual space, of norm `1`, whose value on `x` is `∥x∥`. -/ -theorem exists_dual_vector (x : E) (h : x ≠ 0) : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = ∥x∥ := -begin - let p : submodule 𝕜 E := 𝕜 ∙ x, - let f := (∥x∥ : 𝕜) • coord 𝕜 x h, - obtain ⟨g, hg⟩ := exists_extension_norm_eq p f, - refine ⟨g, _, _⟩, - { rw [hg.2, coord_norm'] }, - { calc g x = g (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw coe_mk - ... = ((∥x∥ : 𝕜) • coord 𝕜 x h) (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw ← hg.1 - ... = ∥x∥ : by simp } -end - -/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, and choosing - the dual element arbitrarily when `x = 0`. -/ -theorem exists_dual_vector' [nontrivial E] (x : E) : - ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = ∥x∥ := -begin - by_cases hx : x = 0, - { obtain ⟨y, hy⟩ := exists_ne (0 : E), - obtain ⟨g, hg⟩ : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g y = ∥y∥ := exists_dual_vector 𝕜 y hy, - refine ⟨g, hg.left, _⟩, - simp [hx] }, - { exact exists_dual_vector 𝕜 x hx } -end - -/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, but only ensuring that - the dual element has norm at most `1` (this can not be improved for the trivial - vector space). -/ -theorem exists_dual_vector'' (x : E) : - ∃ g : E →L[𝕜] 𝕜, ∥g∥ ≤ 1 ∧ g x = ∥x∥ := -begin - by_cases hx : x = 0, - { refine ⟨0, by simp, _⟩, - symmetry, - simp [hx], }, - { rcases exists_dual_vector 𝕜 x hx with ⟨g, g_norm, g_eq⟩, - exact ⟨g, g_norm.le, g_eq⟩ } -end - -end dual_vector diff --git a/src/analysis/normed_space/hahn_banach/extension.lean b/src/analysis/normed_space/hahn_banach/extension.lean new file mode 100644 index 0000000000000..30d4c9802a94c --- /dev/null +++ b/src/analysis/normed_space/hahn_banach/extension.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2020 Yury Kudryashov All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov, Heather Macbeth +-/ +import analysis.convex.cone.basic +import analysis.normed_space.is_R_or_C +import analysis.normed_space.extend +import data.is_R_or_C.lemmas + +/-! +# Extension Hahn-Banach theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove the analytic Hahn-Banach theorem. For any continuous linear function on a +subspace, we can extend it to a function on the entire space without changing its norm. + +We prove +* `real.exists_extension_norm_eq`: Hahn-Banach theorem for continuous linear functions on normed + spaces over `ℝ`. +* `exists_extension_norm_eq`: Hahn-Banach theorem for continuous linear functions on normed spaces + over `ℝ` or `ℂ`. + +In order to state and prove the corollaries uniformly, we prove the statements for a field `𝕜` +satisfying `is_R_or_C 𝕜`. + +In this setting, `exists_dual_vector` states that, for any nonzero `x`, there exists a continuous +linear form `g` of norm `1` with `g x = ‖x‖` (where the norm has to be interpreted as an element +of `𝕜`). + +-/ + +universes u v + +namespace real +variables {E : Type*} [seminormed_add_comm_group E] [normed_space ℝ E] + +/-- Hahn-Banach theorem for continuous linear functions over `ℝ`. -/ +theorem exists_extension_norm_eq (p : subspace ℝ E) (f : p →L[ℝ] ℝ) : + ∃ g : E →L[ℝ] ℝ, (∀ x : p, g x = f x) ∧ ‖g‖ = ‖f‖ := +begin + rcases exists_extension_of_le_sublinear ⟨p, f⟩ (λ x, ‖f‖ * ‖x‖) + (λ c hc x, by simp only [norm_smul c x, real.norm_eq_abs, abs_of_pos hc, mul_left_comm]) + (λ x y, _) (λ x, le_trans (le_abs_self _) (f.le_op_norm _)) + with ⟨g, g_eq, g_le⟩, + set g' := g.mk_continuous (‖f‖) + (λ x, abs_le.2 ⟨neg_le.1 $ g.map_neg x ▸ norm_neg x ▸ g_le (-x), g_le x⟩), + { refine ⟨g', g_eq, _⟩, + { apply le_antisymm (g.mk_continuous_norm_le (norm_nonneg f) _), + refine f.op_norm_le_bound (norm_nonneg _) (λ x, _), + dsimp at g_eq, + rw ← g_eq, + apply g'.le_op_norm } }, + { simp only [← mul_add], + exact mul_le_mul_of_nonneg_left (norm_add_le x y) (norm_nonneg f) } +end + +end real + +section is_R_or_C +open is_R_or_C + +variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [seminormed_add_comm_group F] [normed_space 𝕜 F] + +/-- Hahn-Banach theorem for continuous linear functions over `𝕜` satisyfing `is_R_or_C 𝕜`. -/ +theorem exists_extension_norm_eq (p : subspace 𝕜 F) (f : p →L[𝕜] 𝕜) : + ∃ g : F →L[𝕜] 𝕜, (∀ x : p, g x = f x) ∧ ‖g‖ = ‖f‖ := +begin + letI : module ℝ F := restrict_scalars.module ℝ 𝕜 F, + letI : is_scalar_tower ℝ 𝕜 F := restrict_scalars.is_scalar_tower _ _ _, + letI : normed_space ℝ F := normed_space.restrict_scalars _ 𝕜 _, + -- Let `fr: p →L[ℝ] ℝ` be the real part of `f`. + let fr := re_clm.comp (f.restrict_scalars ℝ), + have fr_apply : ∀ x, fr x = re (f x), by { assume x, refl }, + -- Use the real version to get a norm-preserving extension of `fr`, which + -- we'll call `g : F →L[ℝ] ℝ`. + rcases real.exists_extension_norm_eq (p.restrict_scalars ℝ) fr with ⟨g, ⟨hextends, hnormeq⟩⟩, + -- Now `g` can be extended to the `F →L[𝕜] 𝕜` we need. + refine ⟨g.extend_to_𝕜, _⟩, + -- It is an extension of `f`. + have h : ∀ x : p, g.extend_to_𝕜 x = f x, + { assume x, + rw [continuous_linear_map.extend_to_𝕜_apply, ←submodule.coe_smul, hextends, hextends], + have : (fr x : 𝕜) - I * ↑(fr (I • x)) = (re (f x) : 𝕜) - (I : 𝕜) * (re (f ((I : 𝕜) • x))), + by refl, + rw this, + apply ext, + { simp only [add_zero, algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, + zero_sub, I_im', zero_mul, of_real_re, eq_self_iff_true, sub_zero, mul_neg, + of_real_neg, mul_re, mul_zero, sub_neg_eq_add, continuous_linear_map.map_smul] }, + { simp only [algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, zero_sub, I_im', + zero_mul, of_real_re, mul_neg, mul_im, zero_add, of_real_neg, mul_re, + sub_neg_eq_add, continuous_linear_map.map_smul] } }, + -- And we derive the equality of the norms by bounding on both sides. + refine ⟨h, le_antisymm _ _⟩, + { calc ‖g.extend_to_𝕜‖ + = ‖g‖ : g.norm_extend_to_𝕜 + ... = ‖fr‖ : hnormeq + ... ≤ ‖re_clm‖ * ‖f‖ : continuous_linear_map.op_norm_comp_le _ _ + ... = ‖f‖ : by rw [re_clm_norm, one_mul] }, + { exact f.op_norm_le_bound g.extend_to_𝕜.op_norm_nonneg (λ x, h x ▸ g.extend_to_𝕜.le_op_norm x) } +end + +end is_R_or_C + +section dual_vector +variables (𝕜 : Type v) [is_R_or_C 𝕜] +variables {E : Type u} [normed_add_comm_group E] [normed_space 𝕜 E] + +open continuous_linear_equiv submodule +open_locale classical + +lemma coord_norm' {x : E} (h : x ≠ 0) : ‖(‖x‖ : 𝕜) • coord 𝕜 x h‖ = 1 := +by rw [norm_smul, is_R_or_C.norm_coe_norm, coord_norm, mul_inv_cancel (mt norm_eq_zero.mp h)] + +/-- Corollary of Hahn-Banach. Given a nonzero element `x` of a normed space, there exists an + element of the dual space, of norm `1`, whose value on `x` is `‖x‖`. -/ +theorem exists_dual_vector (x : E) (h : x ≠ 0) : ∃ g : E →L[𝕜] 𝕜, ‖g‖ = 1 ∧ g x = ‖x‖ := +begin + let p : submodule 𝕜 E := 𝕜 ∙ x, + let f := (‖x‖ : 𝕜) • coord 𝕜 x h, + obtain ⟨g, hg⟩ := exists_extension_norm_eq p f, + refine ⟨g, _, _⟩, + { rw [hg.2, coord_norm'] }, + { calc g x = g (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw coe_mk + ... = ((‖x‖ : 𝕜) • coord 𝕜 x h) (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw ← hg.1 + ... = ‖x‖ : by simp } +end + +/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, and choosing + the dual element arbitrarily when `x = 0`. -/ +theorem exists_dual_vector' [nontrivial E] (x : E) : + ∃ g : E →L[𝕜] 𝕜, ‖g‖ = 1 ∧ g x = ‖x‖ := +begin + by_cases hx : x = 0, + { obtain ⟨y, hy⟩ := exists_ne (0 : E), + obtain ⟨g, hg⟩ : ∃ g : E →L[𝕜] 𝕜, ‖g‖ = 1 ∧ g y = ‖y‖ := exists_dual_vector 𝕜 y hy, + refine ⟨g, hg.left, _⟩, + simp [hx] }, + { exact exists_dual_vector 𝕜 x hx } +end + +/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, but only ensuring that + the dual element has norm at most `1` (this can not be improved for the trivial + vector space). -/ +theorem exists_dual_vector'' (x : E) : + ∃ g : E →L[𝕜] 𝕜, ‖g‖ ≤ 1 ∧ g x = ‖x‖ := +begin + by_cases hx : x = 0, + { refine ⟨0, by simp, _⟩, + symmetry, + simp [hx], }, + { rcases exists_dual_vector 𝕜 x hx with ⟨g, g_norm, g_eq⟩, + exact ⟨g, g_norm.le, g_eq⟩ } +end + +end dual_vector diff --git a/src/analysis/normed_space/hahn_banach/separation.lean b/src/analysis/normed_space/hahn_banach/separation.lean new file mode 100644 index 0000000000000..42850fe414803 --- /dev/null +++ b/src/analysis/normed_space/hahn_banach/separation.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2022 Bhavik Mehta All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bhavik Mehta, Yaël Dillies +-/ +import analysis.convex.cone.basic +import analysis.convex.gauge +import topology.algebra.module.finite_dimension +import topology.algebra.module.locally_convex + +/-! +# Separation Hahn-Banach theorem + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove the geometric Hahn-Banach theorem. For any two disjoint convex sets, there +exists a continuous linear functional separating them, geometrically meaning that we can intercalate +a plane between them. + +We provide many variations to stricten the result under more assumptions on the convex sets: +* `geometric_hahn_banach_open`: One set is open. Weak separation. +* `geometric_hahn_banach_open_point`, `geometric_hahn_banach_point_open`: One set is open, the + other is a singleton. Weak separation. +* `geometric_hahn_banach_open_open`: Both sets are open. Semistrict separation. +* `geometric_hahn_banach_compact_closed`, `geometric_hahn_banach_closed_compact`: One set is closed, + the other one is compact. Strict separation. +* `geometric_hahn_banach_point_closed`, `geometric_hahn_banach_closed_point`: One set is closed, the + other one is a singleton. Strict separation. +* `geometric_hahn_banach_point_point`: Both sets are singletons. Strict separation. + +## TODO + +* Eidelheit's theorem +* `convex ℝ s → interior (closure s) ⊆ s` +-/ + +open set +open_locale pointwise + +variables {𝕜 E : Type*} + +/-- Given a set `s` which is a convex neighbourhood of `0` and a point `x₀` outside of it, there is +a continuous linear functional `f` separating `x₀` and `s`, in the sense that it sends `x₀` to 1 and +all of `s` to values strictly below `1`. -/ +lemma separate_convex_open_set [topological_space E] [add_comm_group E] [topological_add_group E] + [module ℝ E] [has_continuous_smul ℝ E] {s : set E} + (hs₀ : (0 : E) ∈ s) (hs₁ : convex ℝ s) (hs₂ : is_open s) {x₀ : E} (hx₀ : x₀ ∉ s) : + ∃ f : E →L[ℝ] ℝ, f x₀ = 1 ∧ ∀ x ∈ s, f x < 1 := +begin + let f : E →ₗ.[ℝ] ℝ := + linear_pmap.mk_span_singleton x₀ 1 (ne_of_mem_of_not_mem hs₀ hx₀).symm, + obtain ⟨φ, hφ₁, hφ₂⟩ := exists_extension_of_le_sublinear f (gauge s) + (λ c hc, gauge_smul_of_nonneg hc.le) + (gauge_add_le hs₁ $ absorbent_nhds_zero $ hs₂.mem_nhds hs₀) _, + have hφ₃ : φ x₀ = 1, + { rw [←submodule.coe_mk x₀ (submodule.mem_span_singleton_self _), hφ₁, + linear_pmap.mk_span_singleton'_apply_self] }, + have hφ₄ : ∀ x ∈ s, φ x < 1, + { exact λ x hx, (hφ₂ x).trans_lt (gauge_lt_one_of_mem_of_open hs₁ hs₀ hs₂ hx) }, + { refine ⟨⟨φ, _⟩, hφ₃, hφ₄⟩, + refine φ.continuous_of_nonzero_on_open _ (hs₂.vadd (-x₀)) (nonempty.vadd_set ⟨0, hs₀⟩) + (vadd_set_subset_iff.mpr $ λ x hx, _), + change φ (-x₀ + x) ≠ 0, + rw [map_add, map_neg], + specialize hφ₄ x hx, + linarith }, + rintro ⟨x, hx⟩, + obtain ⟨y, rfl⟩ := submodule.mem_span_singleton.1 hx, + rw linear_pmap.mk_span_singleton'_apply, + simp only [mul_one, algebra.id.smul_eq_mul, submodule.coe_mk], + obtain h | h := le_or_lt y 0, + { exact h.trans (gauge_nonneg _) }, + { rw [gauge_smul_of_nonneg h.le, smul_eq_mul, le_mul_iff_one_le_right h], + exact one_le_gauge_of_not_mem (hs₁.star_convex hs₀) + (absorbent_nhds_zero $ hs₂.mem_nhds hs₀).absorbs hx₀, + apply_instance } +end + +variables [topological_space E] [add_comm_group E] [topological_add_group E] [module ℝ E] + [has_continuous_smul ℝ E] {s t : set E} {x y : E} + +/-- A version of the **Hahn-Banach theorem**: given disjoint convex sets `s`, `t` where `s` is open, +there is a continuous linear functional which separates them. -/ +theorem geometric_hahn_banach_open (hs₁ : convex ℝ s) (hs₂ : is_open s) (ht : convex ℝ t) + (disj : disjoint s t) : + ∃ (f : E →L[ℝ] ℝ) (u : ℝ), (∀ a ∈ s, f a < u) ∧ ∀ b ∈ t, u ≤ f b := +begin + obtain rfl | ⟨a₀, ha₀⟩ := s.eq_empty_or_nonempty, + { exact ⟨0, 0, by simp, λ b hb, le_rfl⟩ }, + obtain rfl | ⟨b₀, hb₀⟩ := t.eq_empty_or_nonempty, + { exact ⟨0, 1, λ a ha, zero_lt_one, by simp⟩ }, + let x₀ := b₀ - a₀, + let C := x₀ +ᵥ (s - t), + have : (0:E) ∈ C := ⟨a₀ - b₀, sub_mem_sub ha₀ hb₀, + by rw [vadd_eq_add, sub_add_sub_cancel', sub_self]⟩, + have : convex ℝ C := (hs₁.sub ht).vadd _, + have : x₀ ∉ C, + { intro hx₀, + rw ←add_zero x₀ at hx₀, + exact disj.zero_not_mem_sub_set (vadd_mem_vadd_set_iff.1 hx₀) }, + obtain ⟨f, hf₁, hf₂⟩ := separate_convex_open_set ‹0 ∈ C› ‹_› (hs₂.sub_right.vadd _) ‹x₀ ∉ C›, + have : f b₀ = f a₀ + 1 := by simp [←hf₁], + have forall_le : ∀ (a ∈ s) (b ∈ t), f a ≤ f b, + { intros a ha b hb, + have := hf₂ (x₀ + (a - b)) (vadd_mem_vadd_set $ sub_mem_sub ha hb), + simp only [f.map_add, f.map_sub, hf₁] at this, + linarith }, + refine ⟨f, Inf (f '' t), image_subset_iff.1 (_ : f '' s ⊆ Iio (Inf (f '' t))), λ b hb, _⟩, + { rw ←interior_Iic, + refine interior_maximal (image_subset_iff.2 $ λ a ha, _) (f.is_open_map_of_ne_zero _ _ hs₂), + { exact le_cInf (nonempty.image _ ⟨_, hb₀⟩) (ball_image_of_ball $ forall_le _ ha) }, + { rintro rfl, + simpa using hf₁ } }, + { exact cInf_le ⟨f a₀, ball_image_of_ball $ forall_le _ ha₀⟩ (mem_image_of_mem _ hb) } +end + +theorem geometric_hahn_banach_open_point (hs₁ : convex ℝ s) (hs₂ : is_open s) (disj : x ∉ s) : + ∃ f : E →L[ℝ] ℝ, ∀ a ∈ s, f a < f x := +let ⟨f, s, hs, hx⟩ := geometric_hahn_banach_open hs₁ hs₂ (convex_singleton x) + (disjoint_singleton_right.2 disj) + in ⟨f, λ a ha, lt_of_lt_of_le (hs a ha) (hx x (mem_singleton _))⟩ + +theorem geometric_hahn_banach_point_open (ht₁ : convex ℝ t) (ht₂ : is_open t) (disj : x ∉ t) : + ∃ f : E →L[ℝ] ℝ, ∀ b ∈ t, f x < f b := +let ⟨f, hf⟩ := geometric_hahn_banach_open_point ht₁ ht₂ disj in ⟨-f, by simpa⟩ + +theorem geometric_hahn_banach_open_open (hs₁ : convex ℝ s) (hs₂ : is_open s) (ht₁ : convex ℝ t) + (ht₃ : is_open t) (disj : disjoint s t) : + ∃ (f : E →L[ℝ] ℝ) (u : ℝ), (∀ a ∈ s, f a < u) ∧ ∀ b ∈ t, u < f b := +begin + obtain (rfl | ⟨a₀, ha₀⟩) := s.eq_empty_or_nonempty, + { exact ⟨0, -1, by simp, λ b hb, by norm_num⟩ }, + obtain (rfl | ⟨b₀, hb₀⟩) := t.eq_empty_or_nonempty, + { exact ⟨0, 1, λ a ha, by norm_num, by simp⟩ }, + obtain ⟨f, s, hf₁, hf₂⟩ := geometric_hahn_banach_open hs₁ hs₂ ht₁ disj, + have hf : is_open_map f, + { refine f.is_open_map_of_ne_zero _, + rintro rfl, + exact (hf₁ _ ha₀).not_le (hf₂ _ hb₀) }, + refine ⟨f, s, hf₁, image_subset_iff.1 (_ : f '' t ⊆ Ioi s)⟩, + rw ←interior_Ici, + refine interior_maximal (image_subset_iff.2 hf₂) (f.is_open_map_of_ne_zero _ _ ht₃), + rintro rfl, + exact (hf₁ _ ha₀).not_le (hf₂ _ hb₀), +end + +variables [locally_convex_space ℝ E] + +/-- A version of the **Hahn-Banach theorem**: given disjoint convex sets `s`, `t` where `s` is +compact and `t` is closed, there is a continuous linear functional which strongly separates them. -/ +theorem geometric_hahn_banach_compact_closed (hs₁ : convex ℝ s) (hs₂ : is_compact s) + (ht₁ : convex ℝ t) (ht₂ : is_closed t) (disj : disjoint s t) : + ∃ (f : E →L[ℝ] ℝ) (u v : ℝ), (∀ a ∈ s, f a < u) ∧ u < v ∧ ∀ b ∈ t, v < f b := +begin + obtain rfl | hs := s.eq_empty_or_nonempty, + { exact ⟨0, -2, -1, by simp, by norm_num, λ b hb, by norm_num⟩ }, + unfreezingI { obtain rfl | ht := t.eq_empty_or_nonempty }, + { exact ⟨0, 1, 2, λ a ha, by norm_num, by norm_num, by simp⟩ }, + obtain ⟨U, V, hU, hV, hU₁, hV₁, sU, tV, disj'⟩ := disj.exists_open_convexes hs₁ hs₂ ht₁ ht₂, + obtain ⟨f, u, hf₁, hf₂⟩ := geometric_hahn_banach_open_open hU₁ hU hV₁ hV disj', + obtain ⟨x, hx₁, hx₂⟩ := hs₂.exists_forall_ge hs f.continuous.continuous_on, + have : f x < u := hf₁ x (sU hx₁), + exact ⟨f, (f x + u)/2, u, λ a ha, by linarith [hx₂ a ha], by linarith, λ b hb, hf₂ b (tV hb)⟩, +end + +/-- A version of the **Hahn-Banach theorem**: given disjoint convex sets `s`, `t` where `s` is +closed, and `t` is compact, there is a continuous linear functional which strongly separates them. +-/ +theorem geometric_hahn_banach_closed_compact (hs₁ : convex ℝ s) (hs₂ : is_closed s) + (ht₁ : convex ℝ t) (ht₂ : is_compact t) (disj : disjoint s t) : + ∃ (f : E →L[ℝ] ℝ) (u v : ℝ), (∀ a ∈ s, f a < u) ∧ u < v ∧ ∀ b ∈ t, v < f b := +let ⟨f, s, t, hs, st, ht⟩ := geometric_hahn_banach_compact_closed ht₁ ht₂ hs₁ hs₂ disj.symm in +⟨-f, -t, -s, by simpa using ht, by simpa using st, by simpa using hs⟩ + +theorem geometric_hahn_banach_point_closed (ht₁ : convex ℝ t) (ht₂ : is_closed t) (disj : x ∉ t) : + ∃ (f : E →L[ℝ] ℝ) (u : ℝ), f x < u ∧ ∀ b ∈ t, u < f b := +let ⟨f, u, v, ha, hst, hb⟩ := geometric_hahn_banach_compact_closed (convex_singleton x) + is_compact_singleton ht₁ ht₂ (disjoint_singleton_left.2 disj) + in ⟨f, v, hst.trans' $ ha x $ mem_singleton _, hb⟩ + +theorem geometric_hahn_banach_closed_point (hs₁ : convex ℝ s) (hs₂ : is_closed s) (disj : x ∉ s) : + ∃ (f : E →L[ℝ] ℝ) (u : ℝ), (∀ a ∈ s, f a < u) ∧ u < f x := +let ⟨f, s, t, ha, hst, hb⟩ := geometric_hahn_banach_closed_compact hs₁ hs₂ (convex_singleton x) + is_compact_singleton (disjoint_singleton_right.2 disj) + in ⟨f, s, ha, hst.trans $ hb x $ mem_singleton _⟩ + +/-- See also `normed_space.eq_iff_forall_dual_eq`. -/ +theorem geometric_hahn_banach_point_point [t1_space E] (hxy : x ≠ y) : + ∃ (f : E →L[ℝ] ℝ), f x < f y := +begin + obtain ⟨f, s, t, hs, st, ht⟩ := + geometric_hahn_banach_compact_closed (convex_singleton x) is_compact_singleton + (convex_singleton y) is_closed_singleton (disjoint_singleton.2 hxy), + exact ⟨f, by linarith [hs x rfl, ht y rfl]⟩, +end + +/-- A closed convex set is the intersection of the halfspaces containing it. -/ +lemma Inter_halfspaces_eq (hs₁ : convex ℝ s) (hs₂ : is_closed s) : + (⋂ (l : E →L[ℝ] ℝ), {x | ∃ y ∈ s, l x ≤ l y}) = s := +begin + rw set.Inter_set_of, + refine set.subset.antisymm (λ x hx, _) (λ x hx l, ⟨x, hx, le_rfl⟩), + by_contra, + obtain ⟨l, s, hlA, hl⟩ := geometric_hahn_banach_closed_point hs₁ hs₂ h, + obtain ⟨y, hy, hxy⟩ := hx l, + exact ((hxy.trans_lt (hlA y hy)).trans hl).not_le le_rfl, +end diff --git a/src/analysis/normed_space/indicator_function.lean b/src/analysis/normed_space/indicator_function.lean index 71019a37d71c5..f30351b556fb7 100644 --- a/src/analysis/normed_space/indicator_function.lean +++ b/src/analysis/normed_space/indicator_function.lean @@ -9,33 +9,36 @@ import algebra.indicator_function /-! # Indicator function and norm +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains a few simple lemmas about `set.indicator` and `norm`. ## Tags indicator, norm -/ -variables {α E : Type*} [semi_normed_group E] {s t : set α} (f : α → E) (a : α) +variables {α E : Type*} [seminormed_add_comm_group E] {s t : set α} (f : α → E) (a : α) open set lemma norm_indicator_eq_indicator_norm : - ∥indicator s f a∥ = indicator s (λa, ∥f a∥) a := + ‖indicator s f a‖ = indicator s (λa, ‖f a‖) a := flip congr_fun a (indicator_comp_of_zero norm_zero).symm lemma nnnorm_indicator_eq_indicator_nnnorm : - ∥indicator s f a∥₊ = indicator s (λa, ∥f a∥₊) a := + ‖indicator s f a‖₊ = indicator s (λa, ‖f a‖₊) a := flip congr_fun a (indicator_comp_of_zero nnnorm_zero).symm lemma norm_indicator_le_of_subset (h : s ⊆ t) (f : α → E) (a : α) : - ∥indicator s f a∥ ≤ ∥indicator t f a∥ := + ‖indicator s f a‖ ≤ ‖indicator t f a‖ := begin simp only [norm_indicator_eq_indicator_norm], exact indicator_le_indicator_of_subset ‹_› (λ _, norm_nonneg _) _ end -lemma indicator_norm_le_norm_self : indicator s (λa, ∥f a∥) a ≤ ∥f a∥ := +lemma indicator_norm_le_norm_self : indicator s (λa, ‖f a‖) a ≤ ‖f a‖ := indicator_le_self' (λ _ _, norm_nonneg _) a -lemma norm_indicator_le_norm_self : ∥indicator s f a∥ ≤ ∥f a∥ := +lemma norm_indicator_le_norm_self : ‖indicator s f a‖ ≤ ‖f a‖ := by { rw norm_indicator_eq_indicator_norm, apply indicator_norm_le_norm_self } diff --git a/src/analysis/normed_space/int.lean b/src/analysis/normed_space/int.lean index 1a7f943e95ab5..51b44ac060cd4 100644 --- a/src/analysis/normed_space/int.lean +++ b/src/analysis/normed_space/int.lean @@ -3,40 +3,41 @@ Copyright (c) 2021 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ -import analysis.normed_space.basic +import analysis.normed.field.basic /-! # The integers as normed ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains basic facts about the integers as normed ring. -Recall that `∥n∥` denotes the norm of `n` as real number. +Recall that `‖n‖` denotes the norm of `n` as real number. This norm is always nonnegative, so we can bundle the norm together with this fact, to obtain a term of type `nnreal` (the nonnegative real numbers). -The resulting nonnegative real number is denoted by `∥n∥₊`. +The resulting nonnegative real number is denoted by `‖n‖₊`. -/ open_locale big_operators namespace int -lemma nnnorm_coe_units (e : ℤˣ) : ∥(e : ℤ)∥₊ = 1 := +lemma nnnorm_coe_units (e : ℤˣ) : ‖(e : ℤ)‖₊ = 1 := begin obtain (rfl|rfl) := int.units_eq_one_or e; simp only [units.coe_neg_one, units.coe_one, nnnorm_neg, nnnorm_one], end -lemma norm_coe_units (e : ℤˣ) : ∥(e : ℤ)∥ = 1 := +lemma norm_coe_units (e : ℤˣ) : ‖(e : ℤ)‖ = 1 := by rw [← coe_nnnorm, int.nnnorm_coe_units, nnreal.coe_one] -@[simp] lemma nnnorm_coe_nat (n : ℕ) : ∥(n : ℤ)∥₊ = n := real.nnnorm_coe_nat _ - -@[simp] lemma norm_coe_nat (n : ℕ) : ∥(n : ℤ)∥ = n := real.norm_coe_nat _ +@[simp] lemma nnnorm_coe_nat (n : ℕ) : ‖(n : ℤ)‖₊ = n := real.nnnorm_coe_nat _ -@[simp] lemma to_nat_add_to_nat_neg_eq_nnnorm (n : ℤ) : ↑(n.to_nat) + ↑((-n).to_nat) = ∥n∥₊ := +@[simp] lemma to_nat_add_to_nat_neg_eq_nnnorm (n : ℤ) : ↑(n.to_nat) + ↑((-n).to_nat) = ‖n‖₊ := by rw [← nat.cast_add, to_nat_add_to_nat_neg_eq_nat_abs, nnreal.coe_nat_abs] -@[simp] lemma to_nat_add_to_nat_neg_eq_norm (n : ℤ) : ↑(n.to_nat) + ↑((-n).to_nat) = ∥n∥ := +@[simp] lemma to_nat_add_to_nat_neg_eq_norm (n : ℤ) : ↑(n.to_nat) + ↑((-n).to_nat) = ‖n‖ := by simpa only [nnreal.coe_nat_cast, nnreal.coe_add] using congr_arg (coe : _ → ℝ) (to_nat_add_to_nat_neg_eq_nnnorm n) diff --git a/src/analysis/normed_space/is_R_or_C.lean b/src/analysis/normed_space/is_R_or_C.lean index d0d42de322ac4..403f56e8030ab 100644 --- a/src/analysis/normed_space/is_R_or_C.lean +++ b/src/analysis/normed_space/is_R_or_C.lean @@ -3,13 +3,16 @@ Copyright (c) 2021 Kalle Kytölä. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kalle Kytölä -/ -import data.complex.is_R_or_C +import data.is_R_or_C.basic import analysis.normed_space.operator_norm import analysis.normed_space.pointwise /-! # Normed spaces over R or C +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file is about results on normed spaces over the fields `ℝ` and `ℂ`. ## Main definitions @@ -28,40 +31,40 @@ This file exists mainly to avoid importing `is_R_or_C` in the main normed space open metric -@[simp, is_R_or_C_simps] lemma is_R_or_C.norm_coe_norm {𝕜 : Type*} [is_R_or_C 𝕜] - {E : Type*} [normed_group E] {z : E} : ∥(∥z∥ : 𝕜)∥ = ∥z∥ := -by { unfold_coes, simp only [norm_algebra_map', ring_hom.to_fun_eq_coe, norm_norm], } +variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_add_comm_group E] + +lemma is_R_or_C.norm_coe_norm {z : E} : ‖(‖z‖ : 𝕜)‖ = ‖z‖ := by simp -variables {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] +variables [normed_space 𝕜 E] /-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to unit length. -/ -@[simp] lemma norm_smul_inv_norm {x : E} (hx : x ≠ 0) : ∥(∥x∥⁻¹ : 𝕜) • x∥ = 1 := +@[simp] lemma norm_smul_inv_norm {x : E} (hx : x ≠ 0) : ‖(‖x‖⁻¹ : 𝕜) • x‖ = 1 := begin - have : ∥x∥ ≠ 0 := by simp [hx], + have : ‖x‖ ≠ 0 := by simp [hx], field_simp [norm_smul] end /-- Lemma to normalize a vector in a normed space `E` over either `ℂ` or `ℝ` to length `r`. -/ lemma norm_smul_inv_norm' {r : ℝ} (r_nonneg : 0 ≤ r) {x : E} (hx : x ≠ 0) : - ∥(r * ∥x∥⁻¹ : 𝕜) • x∥ = r := + ‖(r * ‖x‖⁻¹ : 𝕜) • x‖ = r := begin - have : ∥x∥ ≠ 0 := by simp [hx], - field_simp [norm_smul, is_R_or_C.norm_eq_abs, r_nonneg] with is_R_or_C_simps + have : ‖x‖ ≠ 0 := by simp [hx], + field_simp [norm_smul, r_nonneg] with is_R_or_C_simps end lemma linear_map.bound_of_sphere_bound - {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜) (h : ∀ z ∈ sphere (0 : E) r, ∥f z∥ ≤ c) (z : E) : - ∥f z∥ ≤ c / r * ∥z∥ := + {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜) (h : ∀ z ∈ sphere (0 : E) r, ‖f z‖ ≤ c) (z : E) : + ‖f z‖ ≤ c / r * ‖z‖ := begin by_cases z_zero : z = 0, { rw z_zero, simp only [linear_map.map_zero, norm_zero, mul_zero], }, - set z₁ := (r * ∥z∥⁻¹ : 𝕜) • z with hz₁, - have norm_f_z₁ : ∥f z₁∥ ≤ c, + set z₁ := (r * ‖z‖⁻¹ : 𝕜) • z with hz₁, + have norm_f_z₁ : ‖f z₁‖ ≤ c, { apply h, rw mem_sphere_zero_iff_norm, exact norm_smul_inv_norm' r_pos.le z_zero }, - have r_ne_zero : (r : 𝕜) ≠ 0 := (algebra_map ℝ 𝕜).map_ne_zero.mpr r_pos.ne.symm, - have eq : f z = ∥z∥ / r * (f z₁), + have r_ne_zero : (r : 𝕜) ≠ 0 := is_R_or_C.of_real_ne_zero.mpr r_pos.ne', + have eq : f z = ‖z‖ / r * (f z₁), { rw [hz₁, linear_map.map_smul, smul_eq_mul], rw [← mul_assoc, ← mul_assoc, div_mul_cancel _ r_ne_zero, mul_inv_cancel, one_mul], simp only [z_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero, ne.def, not_false_iff], }, @@ -73,16 +76,16 @@ begin end /-- -`linear_map.bound_of_ball_bound` is a version of this over arbitrary nondiscrete normed fields. +`linear_map.bound_of_ball_bound` is a version of this over arbitrary nontrivially normed fields. It produces a less precise bound so we keep both versions. -/ lemma linear_map.bound_of_ball_bound' {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜) - (h : ∀ z ∈ closed_ball (0 : E) r, ∥f z∥ ≤ c) (z : E) : - ∥f z∥ ≤ c / r * ∥z∥ := + (h : ∀ z ∈ closed_ball (0 : E) r, ‖f z‖ ≤ c) (z : E) : + ‖f z‖ ≤ c / r * ‖z‖ := f.bound_of_sphere_bound r_pos c (λ z hz, h z hz.le) z lemma continuous_linear_map.op_norm_bound_of_ball_bound - {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →L[𝕜] 𝕜) (h : ∀ z ∈ closed_ball (0 : E) r, ∥f z∥ ≤ c) : - ∥f∥ ≤ c / r := + {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →L[𝕜] 𝕜) (h : ∀ z ∈ closed_ball (0 : E) r, ‖f z‖ ≤ c) : + ‖f‖ ≤ c / r := begin apply continuous_linear_map.op_norm_le_bound, { apply div_nonneg _ r_pos.le, @@ -98,5 +101,5 @@ lemma normed_space.sphere_nonempty_is_R_or_C [nontrivial E] {r : ℝ} (hr : 0 nonempty (sphere (0:E) r) := begin letI : normed_space ℝ E := normed_space.restrict_scalars ℝ 𝕜 E, - exact (sphere (0:E) r).nonempty_coe_sort.mpr (normed_space.sphere_nonempty.mpr hr), + exact (normed_space.sphere_nonempty.mpr hr).coe_sort, end diff --git a/src/analysis/normed_space/lattice_ordered_group.lean b/src/analysis/normed_space/lattice_ordered_group.lean deleted file mode 100644 index 447bccf3bda2c..0000000000000 --- a/src/analysis/normed_space/lattice_ordered_group.lean +++ /dev/null @@ -1,206 +0,0 @@ -/- -Copyright (c) 2021 Christopher Hoskin. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Christopher Hoskin --/ -import topology.order.lattice -import analysis.normed.group.basic -import algebra.order.lattice_group - -/-! -# Normed lattice ordered groups - -Motivated by the theory of Banach Lattices, we then define `normed_lattice_add_comm_group` as a -lattice with a covariant normed group addition satisfying the solid axiom. - -## Main statements - -We show that a normed lattice ordered group is a topological lattice with respect to the norm -topology. - -## References - -* [Meyer-Nieberg, Banach lattices][MeyerNieberg1991] - -## Tags - -normed, lattice, ordered, group --/ - -/-! -### Normed lattice orderd groups - -Motivated by the theory of Banach Lattices, this section introduces normed lattice ordered groups. --/ - -local notation `|`a`|` := abs a - -/-- -Let `α` be a normed commutative group equipped with a partial order covariant with addition, with -respect which `α` forms a lattice. Suppose that `α` is *solid*, that is to say, for `a` and `b` in -`α`, with absolute values `|a|` and `|b|` respectively, `|a| ≤ |b|` implies `∥a∥ ≤ ∥b∥`. Then `α` is -said to be a normed lattice ordered group. --/ -class normed_lattice_add_comm_group (α : Type*) - extends normed_group α, lattice α := -(add_le_add_left : ∀ a b : α, a ≤ b → ∀ c : α, c + a ≤ c + b) -(solid : ∀ a b : α, |a| ≤ |b| → ∥a∥ ≤ ∥b∥) - -lemma solid {α : Type*} [normed_lattice_add_comm_group α] {a b : α} (h : |a| ≤ |b|) : ∥a∥ ≤ ∥b∥ := -normed_lattice_add_comm_group.solid a b h - -noncomputable instance : normed_lattice_add_comm_group ℝ := -{ add_le_add_left := λ _ _ h _, add_le_add le_rfl h, - solid := λ _ _, id, } -/-- -A normed lattice ordered group is an ordered additive commutative group --/ -@[priority 100] -- see Note [lower instance priority] -instance normed_lattice_add_comm_group_to_ordered_add_comm_group {α : Type*} - [h : normed_lattice_add_comm_group α] : ordered_add_comm_group α := { ..h } - -/-- -Let `α` be a normed group with a partial order. Then the order dual is also a normed group. --/ -@[priority 100] -- see Note [lower instance priority] -instance {α : Type*} : Π [normed_group α], normed_group αᵒᵈ := id - -variables {α : Type*} [normed_lattice_add_comm_group α] -open lattice_ordered_comm_group - -lemma dual_solid (a b : α) (h: b⊓-b ≤ a⊓-a) : ∥a∥ ≤ ∥b∥ := -begin - apply solid, - rw abs_eq_sup_neg, - nth_rewrite 0 ← neg_neg a, - rw ← neg_inf_eq_sup_neg, - rw abs_eq_sup_neg, - nth_rewrite 0 ← neg_neg b, - rwa [← neg_inf_eq_sup_neg, neg_le_neg_iff, @inf_comm _ _ _ b, @inf_comm _ _ _ a], -end - -/-- -Let `α` be a normed lattice ordered group, then the order dual is also a -normed lattice ordered group. --/ -@[priority 100] -- see Note [lower instance priority] -instance : normed_lattice_add_comm_group αᵒᵈ := -{ add_le_add_left := begin - intros a b h₁ c, - rw ← order_dual.dual_le, - rw ← order_dual.dual_le at h₁, - exact add_le_add_left h₁ _, - end, - solid := begin - intros a b h₂, - apply dual_solid, - rw ← order_dual.dual_le at h₂, - exact h₂, - end, } - -lemma norm_abs_eq_norm (a : α) : ∥|a|∥ = ∥a∥ := -(solid (abs_abs a).le).antisymm (solid (abs_abs a).symm.le) - -lemma norm_inf_sub_inf_le_add_norm (a b c d : α) : ∥a ⊓ b - c ⊓ d∥ ≤ ∥a - c∥ + ∥b - d∥ := -begin - rw [← norm_abs_eq_norm (a - c), ← norm_abs_eq_norm (b - d)], - refine le_trans (solid _) (norm_add_le (|a - c|) (|b - d|)), - rw abs_of_nonneg (|a - c| + |b - d|) (add_nonneg (abs_nonneg (a - c)) (abs_nonneg (b - d))), - calc |a ⊓ b - c ⊓ d| = - |a ⊓ b - c ⊓ b + (c ⊓ b - c ⊓ d)| : by rw sub_add_sub_cancel - ... ≤ |a ⊓ b - c ⊓ b| + |c ⊓ b - c ⊓ d| : abs_add_le _ _ - ... ≤ |a -c| + |b - d| : by - { apply add_le_add, - { exact abs_inf_sub_inf_le_abs _ _ _, }, - { rw [@inf_comm _ _ c, @inf_comm _ _ c], - exact abs_inf_sub_inf_le_abs _ _ _, } }, -end - -lemma norm_sup_sub_sup_le_add_norm (a b c d : α) : ∥a ⊔ b - (c ⊔ d)∥ ≤ ∥a - c∥ + ∥b - d∥ := -begin - rw [← norm_abs_eq_norm (a - c), ← norm_abs_eq_norm (b - d)], - refine le_trans (solid _) (norm_add_le (|a - c|) (|b - d|)), - rw abs_of_nonneg (|a - c| + |b - d|) (add_nonneg (abs_nonneg (a - c)) (abs_nonneg (b - d))), - calc |a ⊔ b - (c ⊔ d)| = - |a ⊔ b - (c ⊔ b) + (c ⊔ b - (c ⊔ d))| : by rw sub_add_sub_cancel - ... ≤ |a ⊔ b - (c ⊔ b)| + |c ⊔ b - (c ⊔ d)| : abs_add_le _ _ - ... ≤ |a -c| + |b - d| : by - { apply add_le_add, - { exact abs_sup_sub_sup_le_abs _ _ _, }, - { rw [@sup_comm _ _ c, @sup_comm _ _ c], - exact abs_sup_sub_sup_le_abs _ _ _, } }, -end - -/-- -Let `α` be a normed lattice ordered group. Then the infimum is jointly continuous. --/ -@[priority 100] -- see Note [lower instance priority] -instance normed_lattice_add_comm_group_has_continuous_inf : has_continuous_inf α := -begin - refine ⟨continuous_iff_continuous_at.2 $ λ q, tendsto_iff_norm_tendsto_zero.2 $ _⟩, - have : ∀ p : α × α, ∥p.1 ⊓ p.2 - q.1 ⊓ q.2∥ ≤ ∥p.1 - q.1∥ + ∥p.2 - q.2∥, - from λ _, norm_inf_sub_inf_le_add_norm _ _ _ _, - refine squeeze_zero (λ e, norm_nonneg _) this _, - convert (((continuous_fst.tendsto q).sub tendsto_const_nhds).norm).add - (((continuous_snd.tendsto q).sub tendsto_const_nhds).norm), - simp, -end - -@[priority 100] -- see Note [lower instance priority] -instance normed_lattice_add_comm_group_has_continuous_sup {α : Type*} - [normed_lattice_add_comm_group α] : - has_continuous_sup α := -order_dual.has_continuous_sup αᵒᵈ - -/-- -Let `α` be a normed lattice ordered group. Then `α` is a topological lattice in the norm topology. --/ -@[priority 100] -- see Note [lower instance priority] -instance normed_lattice_add_comm_group_topological_lattice : topological_lattice α := -topological_lattice.mk - -lemma norm_abs_sub_abs (a b : α) : - ∥ |a| - |b| ∥ ≤ ∥a-b∥ := -solid (lattice_ordered_comm_group.abs_abs_sub_abs_le _ _) - -lemma norm_sup_sub_sup_le_norm (x y z : α) : ∥x ⊔ z - (y ⊔ z)∥ ≤ ∥x - y∥ := -solid (abs_sup_sub_sup_le_abs x y z) - -lemma norm_inf_sub_inf_le_norm (x y z : α) : ∥x ⊓ z - (y ⊓ z)∥ ≤ ∥x - y∥ := -solid (abs_inf_sub_inf_le_abs x y z) - -lemma lipschitz_with_sup_right (z : α) : lipschitz_with 1 (λ x, x ⊔ z) := -lipschitz_with.of_dist_le_mul $ λ x y, by -{ rw [nonneg.coe_one, one_mul, dist_eq_norm, dist_eq_norm], exact norm_sup_sub_sup_le_norm x y z, } - -lemma lipschitz_with_pos : lipschitz_with 1 (has_pos_part.pos : α → α) := -lipschitz_with_sup_right 0 - -lemma continuous_pos : continuous (has_pos_part.pos : α → α) := -lipschitz_with.continuous lipschitz_with_pos - -lemma continuous_neg' : continuous (has_neg_part.neg : α → α) := -continuous_pos.comp continuous_neg - -lemma is_closed_nonneg {E} [normed_lattice_add_comm_group E] : is_closed {x : E | 0 ≤ x} := -begin - suffices : {x : E | 0 ≤ x} = has_neg_part.neg ⁻¹' {(0 : E)}, - by { rw this, exact is_closed.preimage continuous_neg' is_closed_singleton, }, - ext1 x, - simp only [set.mem_preimage, set.mem_singleton_iff, set.mem_set_of_eq, neg_eq_zero_iff], -end - -lemma is_closed_le_of_is_closed_nonneg {G} [ordered_add_comm_group G] [topological_space G] - [has_continuous_sub G] (h : is_closed {x : G | 0 ≤ x}) : - is_closed {p : G × G | p.fst ≤ p.snd} := -begin - have : {p : G × G | p.fst ≤ p.snd} = (λ p : G × G, p.snd - p.fst) ⁻¹' {x : G | 0 ≤ x}, - by { ext1 p, simp only [sub_nonneg, set.preimage_set_of_eq], }, - rw this, - exact is_closed.preimage (continuous_snd.sub continuous_fst) h, -end - -@[priority 100] -- See note [lower instance priority] -instance normed_lattice_add_comm_group.order_closed_topology {E} [normed_lattice_add_comm_group E] : - order_closed_topology E := -⟨is_closed_le_of_is_closed_nonneg is_closed_nonneg⟩ diff --git a/src/analysis/normed_space/linear_isometry.lean b/src/analysis/normed_space/linear_isometry.lean index 38d372c854af0..7e87a92a9ae37 100644 --- a/src/analysis/normed_space/linear_isometry.lean +++ b/src/analysis/normed_space/linear_isometry.lean @@ -10,6 +10,9 @@ import linear_algebra.basis /-! # (Semi-)linear isometries +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `linear_isometry σ₁₂ E E₂` (notation: `E →ₛₗᵢ[σ₁₂] E₂`) to be a semilinear isometric embedding of `E` into `E₂` and `linear_isometry_equiv` (notation: `E ≃ₛₗᵢ[σ₁₂] E₂`) to be a semilinear isometric equivalence between `E` and `E₂`. The notation for the associated purely @@ -18,12 +21,12 @@ the star-linear versions. We also prove some trivial lemmas and provide convenience constructors. -Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the -theory for `semi_normed_group` and we specialize to `normed_group` when needed. +Since a lot of elementary properties don't require `‖x‖ = 0 → x = 0` we start setting up the +theory for `seminormed_add_comm_group` and we specialize to `normed_add_comm_group` when needed. -/ open function set -variables {R R₂ R₃ R₄ E E₂ E₃ E₄ F : Type*} [semiring R] [semiring R₂] [semiring R₃] [semiring R₄] +variables {R R₂ R₃ R₄ E E₂ E₃ E₄ F 𝓕 : Type*} [semiring R] [semiring R₂] [semiring R₃] [semiring R₄] {σ₁₂ : R →+* R₂} {σ₂₁ : R₂ →+* R} {σ₁₃ : R →+* R₃} {σ₃₁ : R₃ →+* R} {σ₁₄ : R →+* R₄} {σ₄₁ : R₄ →+* R} {σ₂₃ : R₂ →+* R₃} {σ₃₂ : R₃ →+* R₂} {σ₂₄ : R₂ →+* R₄} {σ₄₂ : R₄ →+* R₂} {σ₃₄ : R₃ →+* R₄} {σ₄₃ : R₄ →+* R₃} @@ -37,19 +40,89 @@ variables {R R₂ R₃ R₄ E E₂ E₃ E₄ F : Type*} [semiring R] [semiring R [ring_hom_comp_triple σ₂₃ σ₃₄ σ₂₄] [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄] [ring_hom_comp_triple σ₃₂ σ₂₁ σ₃₁] [ring_hom_comp_triple σ₄₂ σ₂₁ σ₄₁] [ring_hom_comp_triple σ₄₃ σ₃₂ σ₄₂] [ring_hom_comp_triple σ₄₃ σ₃₁ σ₄₁] - [semi_normed_group E] [semi_normed_group E₂] [semi_normed_group E₃] [semi_normed_group E₄] - [module R E] [module R₂ E₂] [module R₃ E₃] [module R₄ E₄] - [normed_group F] [module R F] + [seminormed_add_comm_group E] [seminormed_add_comm_group E₂] [seminormed_add_comm_group E₃] + [seminormed_add_comm_group E₄] [module R E] [module R₂ E₂] [module R₃ E₃] [module R₄ E₄] + [normed_add_comm_group F] [module R F] /-- A `σ₁₂`-semilinear isometric embedding of a normed `R`-module into an `R₂`-module. -/ -structure linear_isometry (σ₁₂ : R →+* R₂) (E E₂ : Type*) [semi_normed_group E] - [semi_normed_group E₂] [module R E] [module R₂ E₂] extends E →ₛₗ[σ₁₂] E₂ := -(norm_map' : ∀ x, ∥to_linear_map x∥ = ∥x∥) +structure linear_isometry (σ₁₂ : R →+* R₂) (E E₂ : Type*) [seminormed_add_comm_group E] + [seminormed_add_comm_group E₂] [module R E] [module R₂ E₂] extends E →ₛₗ[σ₁₂] E₂ := +(norm_map' : ∀ x, ‖to_linear_map x‖ = ‖x‖) notation E ` →ₛₗᵢ[`:25 σ₁₂:25 `] `:0 E₂:0 := linear_isometry σ₁₂ E E₂ notation E ` →ₗᵢ[`:25 R:25 `] `:0 E₂:0 := linear_isometry (ring_hom.id R) E E₂ notation E ` →ₗᵢ⋆[`:25 R:25 `] `:0 E₂:0 := linear_isometry (star_ring_end R) E E₂ +set_option old_structure_cmd true +/-- `semilinear_isometry_class F σ E E₂` asserts `F` is a type of bundled `σ`-semilinear isometries +`E → E₂`. + +See also `linear_isometry_class F R E E₂` for the case where `σ` is the identity map on `R`. + +A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S` +is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and +`f (c • x) = (σ c) • f x`. -/ +class semilinear_isometry_class (𝓕 : Type*) {R R₂ : out_param Type*} [semiring R] [semiring R₂] + (σ₁₂ : out_param $ R →+* R₂) (E E₂ : out_param Type*) [seminormed_add_comm_group E] + [seminormed_add_comm_group E₂] [module R E] [module R₂ E₂] + extends semilinear_map_class 𝓕 σ₁₂ E E₂ := +(norm_map : ∀ (f : 𝓕) (x : E), ‖f x‖ = ‖x‖) + +/-- `linear_isometry_class F R E E₂` asserts `F` is a type of bundled `R`-linear isometries +`M → M₂`. + +This is an abbreviation for `semilinear_isometry_class F (ring_hom.id R) E E₂`. +-/ +abbreviation linear_isometry_class (𝓕 : Type*) (R E E₂ : out_param Type*) [semiring R] + [seminormed_add_comm_group E] [seminormed_add_comm_group E₂] [module R E] [module R E₂] := +semilinear_isometry_class 𝓕 (ring_hom.id R) E E₂ + +set_option old_structure_cmd false + +namespace semilinear_isometry_class + +protected lemma isometry [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) : isometry f := +add_monoid_hom_class.isometry_of_norm _ (norm_map _) + +@[continuity] protected lemma continuous [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) : + continuous f := +(semilinear_isometry_class.isometry f).continuous + +@[simp] lemma nnnorm_map [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) (x : E) : + ‖f x‖₊ = ‖x‖₊ := +nnreal.eq $ norm_map f x + +protected lemma lipschitz [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) : + lipschitz_with 1 f := +(semilinear_isometry_class.isometry f).lipschitz + +protected lemma antilipschitz [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) : + antilipschitz_with 1 f := +(semilinear_isometry_class.isometry f).antilipschitz + +lemma ediam_image [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) (s : set E) : + emetric.diam (f '' s) = emetric.diam s := +(semilinear_isometry_class.isometry f).ediam_image s + +lemma ediam_range [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) : + emetric.diam (range f) = emetric.diam (univ : set E) := +(semilinear_isometry_class.isometry f).ediam_range + +lemma diam_image [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) (s : set E) : + metric.diam (f '' s) = metric.diam s := +(semilinear_isometry_class.isometry f).diam_image s + +lemma diam_range [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) : + metric.diam (range f) = metric.diam (univ : set E) := +(semilinear_isometry_class.isometry f).diam_range + +@[priority 100] +instance [s : semilinear_isometry_class 𝓕 σ₁₂ E E₂] : continuous_semilinear_map_class 𝓕 σ₁₂ E E₂ := +{ map_continuous := semilinear_isometry_class.continuous, + ..s } + +end semilinear_isometry_class + namespace linear_isometry /-- We use `f₁` when we need the domain to be a `normed_space`. -/ @@ -61,11 +134,12 @@ lemma to_linear_map_injective : injective (to_linear_map : (E →ₛₗᵢ[σ₁ @[simp] lemma to_linear_map_inj {f g : E →ₛₗᵢ[σ₁₂] E₂} : f.to_linear_map = g.to_linear_map ↔ f = g := to_linear_map_injective.eq_iff -instance : add_monoid_hom_class (E →ₛₗᵢ[σ₁₂] E₂) E E₂ := -{ coe := λ e, e.to_fun, +instance : semilinear_isometry_class (E →ₛₗᵢ[σ₁₂] E₂) σ₁₂ E E₂ := +{ coe := λ f, f.to_fun, coe_injective' := λ f g h, to_linear_map_injective (fun_like.coe_injective h), map_add := λ f, map_add f.to_linear_map, - map_zero := λ f, map_zero f.to_linear_map } + map_smulₛₗ := λ f, map_smulₛₗ f.to_linear_map, + norm_map := λ f, f.norm_map' } /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` directly. @@ -79,49 +153,68 @@ instance : has_coe_to_fun (E →ₛₗᵢ[σ₁₂] E₂) (λ _, E → E₂) := lemma coe_injective : @injective (E →ₛₗᵢ[σ₁₂] E₂) (E → E₂) coe_fn := fun_like.coe_injective +/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case, + because it is a composition of multiple projections. -/ +def simps.apply (σ₁₂ : R →+* R₂) (E E₂ : Type*) [seminormed_add_comm_group E] + [seminormed_add_comm_group E₂] [module R E] [module R₂ E₂] (h : E →ₛₗᵢ[σ₁₂] E₂) : E → E₂ := h + +initialize_simps_projections linear_isometry (to_linear_map_to_fun → apply) + @[ext] lemma ext {f g : E →ₛₗᵢ[σ₁₂] E₂} (h : ∀ x, f x = g x) : f = g := coe_injective $ funext h -protected lemma congr_arg {f : E →ₛₗᵢ[σ₁₂] E₂} : Π {x x' : E}, x = x' → f x = f x' +protected lemma congr_arg [semilinear_isometry_class 𝓕 σ₁₂ E E₂] {f : 𝓕} : + Π {x x' : E}, x = x' → f x = f x' | _ _ rfl := rfl -protected lemma congr_fun {f g : E →ₛₗᵢ[σ₁₂] E₂} (h : f = g) (x : E) : f x = g x := h ▸ rfl +protected lemma congr_fun [semilinear_isometry_class 𝓕 σ₁₂ E E₂] {f g : 𝓕} (h : f = g) (x : E) : + f x = g x := h ▸ rfl -@[simp] lemma map_zero : f 0 = 0 := f.to_linear_map.map_zero +@[simp] protected lemma map_zero : f 0 = 0 := f.to_linear_map.map_zero -@[simp] lemma map_add (x y : E) : f (x + y) = f x + f y := f.to_linear_map.map_add x y +@[simp] protected lemma map_add (x y : E) : f (x + y) = f x + f y := f.to_linear_map.map_add x y -@[simp] lemma map_neg (x : E) : f (- x) = - f x := f.to_linear_map.map_neg x +@[simp] protected lemma map_neg (x : E) : f (- x) = - f x := f.to_linear_map.map_neg x -@[simp] lemma map_sub (x y : E) : f (x - y) = f x - f y := f.to_linear_map.map_sub x y +@[simp] protected lemma map_sub (x y : E) : f (x - y) = f x - f y := f.to_linear_map.map_sub x y -@[simp] lemma map_smulₛₗ (c : R) (x : E) : f (c • x) = σ₁₂ c • f x := f.to_linear_map.map_smulₛₗ c x +@[simp] protected lemma map_smulₛₗ (c : R) (x : E) : f (c • x) = σ₁₂ c • f x := +f.to_linear_map.map_smulₛₗ c x -@[simp] lemma map_smul [module R E₂] (f : E →ₗᵢ[R] E₂) (c : R) (x : E) : f (c • x) = c • f x := +@[simp] protected lemma map_smul [module R E₂] (f : E →ₗᵢ[R] E₂) (c : R) (x : E) : + f (c • x) = c • f x := f.to_linear_map.map_smul c x -@[simp] lemma norm_map (x : E) : ∥f x∥ = ∥x∥ := f.norm_map' x +@[simp] lemma norm_map (x : E) : ‖f x‖ = ‖x‖ := semilinear_isometry_class.norm_map f x -@[simp] lemma nnnorm_map (x : E) : ∥f x∥₊ = ∥x∥₊ := nnreal.eq $ f.norm_map x +@[simp] lemma nnnorm_map (x : E) : ‖f x‖₊ = ‖x‖₊ := nnreal.eq $ norm_map f x -protected lemma isometry : isometry f := -f.to_linear_map.to_add_monoid_hom.isometry_of_norm f.norm_map +protected lemma isometry : isometry f := add_monoid_hom_class.isometry_of_norm _ (norm_map _) -@[simp] lemma is_complete_image_iff {s : set E} : is_complete (f '' s) ↔ is_complete s := -is_complete_image_iff f.isometry.uniform_inducing +@[simp] lemma is_complete_image_iff [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) {s : set E} : + is_complete (f '' s) ↔ is_complete s := +is_complete_image_iff (semilinear_isometry_class.isometry f).uniform_inducing lemma is_complete_map_iff [ring_hom_surjective σ₁₂] {p : submodule R E} : is_complete (p.map f.to_linear_map : set E₂) ↔ is_complete (p : set E) := f.is_complete_image_iff -instance complete_space_map [ring_hom_surjective σ₁₂] (p : submodule R E) [complete_space p] : +lemma is_complete_map_iff' [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) [ring_hom_surjective σ₁₂] + {p : submodule R E} : is_complete (p.map f : set E₂) ↔ is_complete (p : set E) := +is_complete_image_iff f + +instance complete_space_map [semilinear_isometry_class 𝓕 σ₁₂ E E₂] (f : 𝓕) [ring_hom_surjective σ₁₂] + (p : submodule R E) [complete_space p] : complete_space (p.map f) := +((is_complete_map_iff' f).2 $ complete_space_coe_iff_is_complete.1 ‹_›).complete_space_coe + +instance complete_space_map' [ring_hom_surjective σ₁₂] (p : submodule R E) [complete_space p] : complete_space (p.map f.to_linear_map) := (f.is_complete_map_iff.2 $ complete_space_coe_iff_is_complete.1 ‹_›).complete_space_coe @[simp] lemma dist_map (x y : E) : dist (f x) (f y) = dist x y := f.isometry.dist_eq x y @[simp] lemma edist_map (x y : E) : edist (f x) (f y) = edist x y := f.isometry.edist_eq x y -protected lemma injective : injective f₁ := f₁.isometry.injective +protected lemma injective : injective f₁ := isometry.injective (linear_isometry.isometry f₁) @[simp] lemma map_eq_iff {x y : F} : f₁ x = f₁ y ↔ x = y := f₁.injective.eq_iff @@ -133,6 +226,18 @@ protected lemma antilipschitz : antilipschitz_with 1 f := f.isometry.antilipschi @[continuity] protected lemma continuous : continuous f := f.isometry.continuous +@[simp] lemma preimage_ball (x : E) (r : ℝ) : + f ⁻¹' (metric.ball (f x) r) = metric.ball x r := +f.isometry.preimage_ball x r + +@[simp] lemma preimage_sphere (x : E) (r : ℝ) : + f ⁻¹' (metric.sphere (f x) r) = metric.sphere x r := +f.isometry.preimage_sphere x r + +@[simp] lemma preimage_closed_ball (x : E) (r : ℝ) : + f ⁻¹' (metric.closed_ball (f x) r) = metric.closed_ball x r := +f.isometry.preimage_closed_ball x r + lemma ediam_image (s : set E) : emetric.diam (f '' s) = emetric.diam s := f.isometry.ediam_image s @@ -140,10 +245,10 @@ lemma ediam_range : emetric.diam (range f) = emetric.diam (univ : set E) := f.isometry.ediam_range lemma diam_image (s : set E) : metric.diam (f '' s) = metric.diam s := -f.isometry.diam_image s +isometry.diam_image (linear_isometry.isometry f) s lemma diam_range : metric.diam (range f) = metric.diam (univ : set E) := -f.isometry.diam_range +isometry.diam_range (linear_isometry.isometry f) /-- Interpret a linear isometry as a continuous linear map. -/ def to_continuous_linear_map : E →SL[σ₁₂] E₂ := ⟨f.to_linear_map, f.continuous⟩ @@ -178,7 +283,7 @@ instance : inhabited (E →ₗᵢ[R] E) := ⟨id⟩ /-- Composition of linear isometries. -/ def comp (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (f : E →ₛₗᵢ[σ₁₂] E₂) : E →ₛₗᵢ[σ₁₃] E₃ := -⟨g.to_linear_map.comp f.to_linear_map, λ x, (g.norm_map _).trans (f.norm_map _)⟩ +⟨g.to_linear_map.comp f.to_linear_map, λ x, (norm_map g _).trans (norm_map f _)⟩ include σ₁₃ @[simp] lemma coe_comp (g : E₂ →ₛₗᵢ[σ₂₃] E₃) (f : E →ₛₗᵢ[σ₁₂] E₂) : @@ -227,32 +332,64 @@ def subtypeₗᵢ : p →ₗᵢ[R'] E := ⟨p.subtype, λ x, rfl⟩ @[simp] lemma subtypeₗᵢ_to_linear_map : p.subtypeₗᵢ.to_linear_map = p.subtype := rfl -/-- `submodule.subtype` as a `continuous_linear_map`. -/ -def subtypeL : p →L[R'] E := p.subtypeₗᵢ.to_continuous_linear_map - -@[simp] lemma coe_subtypeL : (p.subtypeL : p →ₗ[R'] E) = p.subtype := rfl - -@[simp] lemma coe_subtypeL' : ⇑p.subtypeL = p.subtype := rfl - -@[simp] lemma range_subtypeL : p.subtypeL.range = p := -range_subtype _ - -@[simp] lemma ker_subtypeL : p.subtypeL.ker = ⊥ := -ker_subtype _ +@[simp] lemma subtypeₗᵢ_to_continuous_linear_map : + p.subtypeₗᵢ.to_continuous_linear_map = p.subtypeL := rfl end submodule /-- A semilinear isometric equivalence between two normed vector spaces. -/ structure linear_isometry_equiv (σ₁₂ : R →+* R₂) {σ₂₁ : R₂ →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁] - [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : Type*) [semi_normed_group E] [semi_normed_group E₂] - [module R E] [module R₂ E₂] extends E ≃ₛₗ[σ₁₂] E₂ := -(norm_map' : ∀ x, ∥to_linear_equiv x∥ = ∥x∥) + [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : Type*) [seminormed_add_comm_group E] + [seminormed_add_comm_group E₂] [module R E] [module R₂ E₂] extends E ≃ₛₗ[σ₁₂] E₂ := +(norm_map' : ∀ x, ‖to_linear_equiv x‖ = ‖x‖) notation E ` ≃ₛₗᵢ[`:25 σ₁₂:25 `] `:0 E₂:0 := linear_isometry_equiv σ₁₂ E E₂ notation E ` ≃ₗᵢ[`:25 R:25 `] `:0 E₂:0 := linear_isometry_equiv (ring_hom.id R) E E₂ notation E ` ≃ₗᵢ⋆[`:25 R:25 `] `:0 E₂:0 := linear_isometry_equiv (star_ring_end R) E E₂ +set_option old_structure_cmd true +/-- `semilinear_isometry_equiv_class F σ E E₂` asserts `F` is a type of bundled `σ`-semilinear +isometric equivs `E → E₂`. + +See also `linear_isometry_equiv_class F R E E₂` for the case where `σ` is the identity map on `R`. + +A map `f` between an `R`-module and an `S`-module over a ring homomorphism `σ : R →+* S` +is semilinear if it satisfies the two properties `f (x + y) = f x + f y` and +`f (c • x) = (σ c) • f x`. -/ +class semilinear_isometry_equiv_class (𝓕 : Type*) {R R₂ : out_param Type*} + [semiring R] [semiring R₂] (σ₁₂ : out_param $ R →+* R₂) {σ₂₁ : out_param $ R₂ →+* R} + [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : out_param Type*) + [seminormed_add_comm_group E] [seminormed_add_comm_group E₂] [module R E] [module R₂ E₂] + extends semilinear_equiv_class 𝓕 σ₁₂ E E₂ := +(norm_map : ∀ (f : 𝓕) (x : E), ‖f x‖ = ‖x‖) + +/-- `linear_isometry_equiv_class F R E E₂` asserts `F` is a type of bundled `R`-linear isometries +`M → M₂`. + +This is an abbreviation for `semilinear_isometry_equiv_class F (ring_hom.id R) E E₂`. +-/ +abbreviation linear_isometry_equiv_class (𝓕 : Type*) (R E E₂ : out_param Type*) [semiring R] + [seminormed_add_comm_group E] [seminormed_add_comm_group E₂] [module R E] [module R E₂] := +semilinear_isometry_equiv_class 𝓕 (ring_hom.id R) E E₂ + +set_option old_structure_cmd false + +namespace semilinear_isometry_equiv_class +variables (𝓕) + +include σ₂₁ +-- `σ₂₁` becomes a metavariable, but it's OK since it's an outparam +@[priority 100, nolint dangerous_instance] +instance [s : semilinear_isometry_equiv_class 𝓕 σ₁₂ E E₂] : semilinear_isometry_class 𝓕 σ₁₂ E E₂ := +{ coe := (coe : 𝓕 → E → E₂), + coe_injective' := @fun_like.coe_injective 𝓕 _ _ _, + ..s } +omit σ₂₁ + +end semilinear_isometry_equiv_class + + namespace linear_isometry_equiv variables (e : E ≃ₛₗᵢ[σ₁₂] E₂) @@ -266,11 +403,16 @@ lemma to_linear_equiv_injective : injective (to_linear_equiv : (E ≃ₛₗᵢ[ f.to_linear_equiv = g.to_linear_equiv ↔ f = g := to_linear_equiv_injective.eq_iff -instance : add_monoid_hom_class (E ≃ₛₗᵢ[σ₁₂] E₂) E E₂ := +instance : semilinear_isometry_equiv_class (E ≃ₛₗᵢ[σ₁₂] E₂) σ₁₂ E E₂ := { coe := λ e, e.to_fun, - coe_injective' := λ f g h, to_linear_equiv_injective (fun_like.coe_injective h), + inv := λ e, e.inv_fun, + coe_injective' := λ f g h₁ h₂, + by { cases f with f' _, cases g with g' _, cases f', cases g', congr', }, + left_inv := λ e, e.left_inv, + right_inv := λ e, e.right_inv, map_add := λ f, map_add f.to_linear_equiv, - map_zero := λ f, map_zero f.to_linear_equiv } + map_smulₛₗ := λ e, map_smulₛₗ e.to_linear_equiv, + norm_map := λ e, e.norm_map' } /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun` directly. @@ -280,7 +422,7 @@ instance : has_coe_to_fun (E ≃ₛₗᵢ[σ₁₂] E₂) (λ _, E → E₂) := lemma coe_injective : @function.injective (E ≃ₛₗᵢ[σ₁₂] E₂) (E → E₂) coe_fn := fun_like.coe_injective -@[simp] lemma coe_mk (e : E ≃ₛₗ[σ₁₂] E₂) (he : ∀ x, ∥e x∥ = ∥x∥) : +@[simp] lemma coe_mk (e : E ≃ₛₗ[σ₁₂] E₂) (he : ∀ x, ‖e x‖ = ‖x‖) : ⇑(mk e he) = e := rfl @@ -295,12 +437,12 @@ protected lemma congr_arg {f : E ≃ₛₗᵢ[σ₁₂] E₂} : Π {x x' : E}, x protected lemma congr_fun {f g : E ≃ₛₗᵢ[σ₁₂] E₂} (h : f = g) (x : E) : f x = g x := h ▸ rfl /-- Construct a `linear_isometry_equiv` from a `linear_equiv` and two inequalities: -`∀ x, ∥e x∥ ≤ ∥x∥` and `∀ y, ∥e.symm y∥ ≤ ∥y∥`. -/ -def of_bounds (e : E ≃ₛₗ[σ₁₂] E₂) (h₁ : ∀ x, ∥e x∥ ≤ ∥x∥) (h₂ : ∀ y, ∥e.symm y∥ ≤ ∥y∥) : +`∀ x, ‖e x‖ ≤ ‖x‖` and `∀ y, ‖e.symm y‖ ≤ ‖y‖`. -/ +def of_bounds (e : E ≃ₛₗ[σ₁₂] E₂) (h₁ : ∀ x, ‖e x‖ ≤ ‖x‖) (h₂ : ∀ y, ‖e.symm y‖ ≤ ‖y‖) : E ≃ₛₗᵢ[σ₁₂] E₂ := ⟨e, λ x, le_antisymm (h₁ x) $ by simpa only [e.symm_apply_apply] using h₂ (e x)⟩ -@[simp] lemma norm_map (x : E) : ∥e x∥ = ∥x∥ := e.norm_map' x +@[simp] lemma norm_map (x : E) : ‖e x‖ = ‖x‖ := e.norm_map' x /-- Reinterpret a `linear_isometry_equiv` as a `linear_isometry`. -/ def to_linear_isometry : E →ₛₗᵢ[σ₁₂] E₂ := ⟨e.1, e.2⟩ @@ -317,24 +459,24 @@ to_linear_isometry_injective.eq_iff protected lemma isometry : isometry e := e.to_linear_isometry.isometry -/-- Reinterpret a `linear_isometry_equiv` as an `isometric`. -/ -def to_isometric : E ≃ᵢ E₂ := ⟨e.to_linear_equiv.to_equiv, e.isometry⟩ +/-- Reinterpret a `linear_isometry_equiv` as an `isometry_equiv`. -/ +def to_isometry_equiv : E ≃ᵢ E₂ := ⟨e.to_linear_equiv.to_equiv, e.isometry⟩ -lemma to_isometric_injective : - function.injective (to_isometric : (E ≃ₛₗᵢ[σ₁₂] E₂) → E ≃ᵢ E₂) := -λ x y h, coe_injective (congr_arg _ h : ⇑x.to_isometric = _) +lemma to_isometry_equiv_injective : + function.injective (to_isometry_equiv : (E ≃ₛₗᵢ[σ₁₂] E₂) → E ≃ᵢ E₂) := +λ x y h, coe_injective (congr_arg _ h : ⇑x.to_isometry_equiv = _) -@[simp] lemma to_isometric_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} : - f.to_isometric = g.to_isometric ↔ f = g := -to_isometric_injective.eq_iff +@[simp] lemma to_isometry_equiv_inj {f g : E ≃ₛₗᵢ[σ₁₂] E₂} : + f.to_isometry_equiv = g.to_isometry_equiv ↔ f = g := +to_isometry_equiv_injective.eq_iff -@[simp] lemma coe_to_isometric : ⇑e.to_isometric = e := rfl +@[simp] lemma coe_to_isometry_equiv : ⇑e.to_isometry_equiv = e := rfl lemma range_eq_univ (e : E ≃ₛₗᵢ[σ₁₂] E₂) : set.range e = set.univ := -by { rw ← coe_to_isometric, exact isometric.range_eq_univ _, } +by { rw ← coe_to_isometry_equiv, exact isometry_equiv.range_eq_univ _, } /-- Reinterpret a `linear_isometry_equiv` as an `homeomorph`. -/ -def to_homeomorph : E ≃ₜ E₂ := e.to_isometric.to_homeomorph +def to_homeomorph : E ≃ₜ E₂ := e.to_isometry_equiv.to_homeomorph lemma to_homeomorph_injective : function.injective (to_homeomorph : (E ≃ₛₗᵢ[σ₁₂] E₂) → E ≃ₜ E₂) := @@ -375,6 +517,11 @@ variables (R E) /-- Identity map as a `linear_isometry_equiv`. -/ def refl : E ≃ₗᵢ[R] E := ⟨linear_equiv.refl R E, λ x, rfl⟩ +/-- Linear isometry equiv between a space and its lift to another universe. -/ +def ulift : ulift E ≃ₗᵢ[R] E := +{ norm_map' := λ x, rfl, + .. continuous_linear_equiv.ulift } + variables {R E} instance : inhabited (E ≃ₗᵢ[R] E) := ⟨refl R E⟩ @@ -392,9 +539,24 @@ def symm : E₂ ≃ₛₗᵢ[σ₂₁] E := @[simp] lemma symm_symm : e.symm.symm = e := ext $ λ x, rfl @[simp] lemma to_linear_equiv_symm : e.to_linear_equiv.symm = e.symm.to_linear_equiv := rfl -@[simp] lemma to_isometric_symm : e.to_isometric.symm = e.symm.to_isometric := rfl +@[simp] lemma to_isometry_equiv_symm : e.to_isometry_equiv.symm = e.symm.to_isometry_equiv := rfl @[simp] lemma to_homeomorph_symm : e.to_homeomorph.symm = e.symm.to_homeomorph := rfl +/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case, + because it is a composition of multiple projections. -/ +def simps.apply (σ₁₂ : R →+* R₂) {σ₂₁ : R₂ →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁] + [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : Type*) [seminormed_add_comm_group E] + [seminormed_add_comm_group E₂] [module R E] [module R₂ E₂] (h : E ≃ₛₗᵢ[σ₁₂] E₂) : E → E₂ := h + +/-- See Note [custom simps projection] -/ +def simps.symm_apply (σ₁₂ : R →+* R₂) {σ₂₁ : R₂ →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁] + [ring_hom_inv_pair σ₂₁ σ₁₂] (E E₂ : Type*) [seminormed_add_comm_group E] + [seminormed_add_comm_group E₂] + [module R E] [module R₂ E₂] (h : E ≃ₛₗᵢ[σ₁₂] E₂) : E₂ → E := h.symm + +initialize_simps_projections linear_isometry_equiv + (to_linear_equiv_to_fun → apply, to_linear_equiv_inv_fun → symm_apply) + include σ₃₁ σ₃₂ /-- Composition of `linear_isometry_equiv`s as a `linear_isometry_equiv`. -/ def trans (e' : E₂ ≃ₛₗᵢ[σ₂₃] E₃) : E ≃ₛₗᵢ[σ₁₃] E₃ := @@ -470,7 +632,7 @@ include σ₂₁ /-- Reinterpret a `linear_isometry_equiv` as a `continuous_linear_equiv`. -/ instance : has_coe_t (E ≃ₛₗᵢ[σ₁₂] E₂) (E ≃SL[σ₁₂] E₂) := -⟨λ e, ⟨e.to_linear_equiv, e.continuous, e.to_isometric.symm.continuous⟩⟩ +⟨λ e, ⟨e.to_linear_equiv, e.continuous, e.to_isometry_equiv.symm.continuous⟩⟩ instance : has_coe_t (E ≃ₛₗᵢ[σ₁₂] E₂) (E →SL[σ₁₂] E₂) := ⟨λ e, ↑(e : E ≃SL[σ₁₂] E₂)⟩ @@ -493,7 +655,7 @@ omit σ₂₁ @[simp] lemma map_smul [module R E₂] {e : E ≃ₗᵢ[R] E₂} (c : R) (x : E) : e (c • x) = c • e x := e.1.map_smul c x -@[simp] lemma nnnorm_map (x : E) : ∥e x∥₊ = ∥x∥₊ := e.to_linear_isometry.nnnorm_map x +@[simp] lemma nnnorm_map (x : E) : ‖e x‖₊ = ‖x‖₊ := semilinear_isometry_class.nnnorm_map e x @[simp] lemma dist_map (x y : E) : dist (e x) (e y) = dist x y := e.to_linear_isometry.dist_map x y @@ -513,12 +675,39 @@ protected lemma lipschitz : lipschitz_with 1 e := e.isometry.lipschitz protected lemma antilipschitz : antilipschitz_with 1 e := e.isometry.antilipschitz +lemma image_eq_preimage (s : set E) : e '' s = e.symm ⁻¹' s := +e.to_linear_equiv.image_eq_preimage s + @[simp] lemma ediam_image (s : set E) : emetric.diam (e '' s) = emetric.diam s := e.isometry.ediam_image s @[simp] lemma diam_image (s : set E) : metric.diam (e '' s) = metric.diam s := e.isometry.diam_image s +@[simp] lemma preimage_ball (x : E₂) (r : ℝ) : + e ⁻¹' (metric.ball x r) = metric.ball (e.symm x) r := +e.to_isometry_equiv.preimage_ball x r + +@[simp] lemma preimage_sphere (x : E₂) (r : ℝ) : + e ⁻¹' (metric.sphere x r) = metric.sphere (e.symm x) r := +e.to_isometry_equiv.preimage_sphere x r + +@[simp] lemma preimage_closed_ball (x : E₂) (r : ℝ) : + e ⁻¹' (metric.closed_ball x r) = metric.closed_ball (e.symm x) r := +e.to_isometry_equiv.preimage_closed_ball x r + +@[simp] lemma image_ball (x : E) (r : ℝ) : + e '' (metric.ball x r) = metric.ball (e x) r := +e.to_isometry_equiv.image_ball x r + +@[simp] lemma image_sphere (x : E) (r : ℝ) : + e '' (metric.sphere x r) = metric.sphere (e x) r := +e.to_isometry_equiv.image_sphere x r + +@[simp] lemma image_closed_ball (x : E) (r : ℝ) : + e '' (metric.closed_ball x r) = metric.closed_ball (e x) r := +e.to_isometry_equiv.image_closed_ball x r + variables {α : Type*} [topological_space α] @[simp] lemma comp_continuous_on_iff {f : α → E} {s : set α} : @@ -531,7 +720,7 @@ e.isometry.comp_continuous_iff instance complete_space_map (p : submodule R E) [complete_space p] : complete_space (p.map (e.to_linear_equiv : E →ₛₗ[σ₁₂] E₂)) := -e.to_linear_isometry.complete_space_map p +e.to_linear_isometry.complete_space_map' p include σ₂₁ /-- Construct a linear isometry equiv from a surjective linear isometry. -/ @@ -539,12 +728,30 @@ noncomputable def of_surjective (f : F →ₛₗᵢ[σ₁₂] E₂) (hfr : function.surjective f) : F ≃ₛₗᵢ[σ₁₂] E₂ := { norm_map' := f.norm_map, - .. linear_equiv.of_bijective f.to_linear_map f.injective hfr } + .. linear_equiv.of_bijective f.to_linear_map ⟨f.injective, hfr⟩ } @[simp] lemma coe_of_surjective (f : F →ₛₗᵢ[σ₁₂] E₂) (hfr : function.surjective f) : ⇑(linear_isometry_equiv.of_surjective f hfr) = f := by { ext, refl } +/-- If a linear isometry has an inverse, it is a linear isometric equivalence. -/ +def of_linear_isometry (f : E →ₛₗᵢ[σ₁₂] E₂) (g : E₂ →ₛₗ[σ₂₁] E) + (h₁ : f.to_linear_map.comp g = linear_map.id) (h₂ : g.comp f.to_linear_map = linear_map.id) : + E ≃ₛₗᵢ[σ₁₂] E₂ := +{ norm_map' := λ x, f.norm_map x, + .. linear_equiv.of_linear f.to_linear_map g h₁ h₂ } + +@[simp] lemma coe_of_linear_isometry (f : E →ₛₗᵢ[σ₁₂] E₂) (g : E₂ →ₛₗ[σ₂₁] E) + (h₁ : f.to_linear_map.comp g = linear_map.id) (h₂ : g.comp f.to_linear_map = linear_map.id) : + (of_linear_isometry f g h₁ h₂ : E → E₂) = (f : E → E₂) := +rfl + +@[simp] lemma coe_of_linear_isometry_symm (f : E →ₛₗᵢ[σ₁₂] E₂) + (g : E₂ →ₛₗ[σ₂₁] E) (h₁ : f.to_linear_map.comp g = linear_map.id) + (h₂ : g.comp f.to_linear_map = linear_map.id) : + ((of_linear_isometry f g h₁ h₂).symm : E₂ → E) = (g : E₂ → E) := +rfl + omit σ₂₁ variables (R) @@ -581,6 +788,27 @@ rfl ((prod_assoc R E E₂ E₃).symm : E × E₂ × E₃ → (E × E₂) × E₃) = (equiv.prod_assoc E E₂ E₃).symm := rfl +/-- If `p` is a submodule that is equal to `⊤`, then `linear_isometry_equiv.of_top p hp` is the +"identity" equivalence between `p` and `E`. -/ +@[simps to_linear_equiv apply symm_apply_coe] +def of_top {R : Type*} [ring R] [module R E] (p : submodule R E) (hp : p = ⊤) : + p ≃ₗᵢ[R] E := +{ to_linear_equiv := linear_equiv.of_top p hp, .. p.subtypeₗᵢ } + +variables {R E E₂ E₃} {R' : Type*} [ring R'] [module R' E] (p q : submodule R' E) + +/-- `linear_equiv.of_eq` as a `linear_isometry_equiv`. -/ +def of_eq (hpq : p = q) : + p ≃ₗᵢ[R'] q := +{ norm_map' := λ x, rfl, + ..linear_equiv.of_eq p q hpq } + +variables {p q} + +@[simp] lemma coe_of_eq_apply (h : p = q) (x : p) : (of_eq p q h x : E) = x := rfl +@[simp] lemma of_eq_symm (h : p = q) : (of_eq p q h).symm = of_eq q p h.symm := rfl +@[simp] lemma of_eq_rfl : of_eq p p rfl = linear_isometry_equiv.refl R' p := by ext; refl + end linear_isometry_equiv /-- Two linear isometries are equal if they are equal on basis vectors. -/ @@ -596,3 +824,11 @@ lemma basis.ext_linear_isometry_equiv {ι : Type*} (b : basis ι R E) {f₁ f₂ linear_isometry_equiv.to_linear_equiv_injective $ b.ext' h omit σ₂₁ + +/-- Reinterpret a `linear_isometry` as a `linear_isometry_equiv` to the range. -/ +@[simps to_linear_equiv apply_coe] +noncomputable def linear_isometry.equiv_range {R S : Type*} [semiring R] [ring S] [module S E] + [module R F] {σ₁₂ : R →+* S} {σ₂₁ : S →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁] + [ring_hom_inv_pair σ₂₁ σ₁₂] (f : F →ₛₗᵢ[σ₁₂] E) : + F ≃ₛₗᵢ[σ₁₂] f.to_linear_map.range := +{ to_linear_equiv := linear_equiv.of_injective f.to_linear_map f.injective, .. f } diff --git a/src/analysis/normed_space/lp_equiv.lean b/src/analysis/normed_space/lp_equiv.lean new file mode 100644 index 0000000000000..9555744026e36 --- /dev/null +++ b/src/analysis/normed_space/lp_equiv.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2022 Jireh Loreaux. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jireh Loreaux +-/ +import analysis.normed_space.lp_space +import analysis.normed_space.pi_Lp +import topology.continuous_function.bounded + +/-! +# Equivalences among $L^p$ spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we collect a variety of equivalences among various $L^p$ spaces. In particular, +when `α` is a `fintype`, given `E : α → Type u` and `p : ℝ≥0∞`, there is a natural linear isometric +equivalence `lp_pi_Lpₗᵢ : lp E p ≃ₗᵢ pi_Lp p E`. In addition, when `α` is a discrete topological +space, the bounded continuous functions `α →ᵇ β` correspond exactly to `lp (λ _, β) ∞`. Here there +can be more structure, including ring and algebra structures, and we implement these equivalences +accordingly as well. + +We keep this as a separate file so that the various $L^p$ space files don't import the others. + +Recall that `pi_Lp` is just a type synonym for `Π i, E i` but given a different metric and norm +structure, although the topological, uniform and bornological structures coincide definitionally. +These structures are only defined on `pi_Lp` for `fintype α`, so there are no issues of convergence +to consider. + +While `pre_lp` is also a type synonym for `Π i, E i`, it allows for infinite index types. On this +type there is a predicate `mem_ℓp` which says that the relevant `p`-norm is finite and `lp E p` is +the subtype of `pre_lp` satisfying `mem_ℓp`. + +## TODO + +* Equivalence between `lp` and `measure_theory.Lp`, for `f : α → E` (i.e., functions rather than + pi-types) and the counting measure on `α` + +-/ + +open_locale ennreal + +section lp_pi_Lp + +variables {α : Type*} {E : α → Type*} [Π i, normed_add_comm_group (E i)] {p : ℝ≥0∞} + +/-- When `α` is `finite`, every `f : pre_lp E p` satisfies `mem_ℓp f p`. -/ +lemma mem_ℓp.all [finite α] (f : Π i, E i) : mem_ℓp f p := +begin + rcases p.trichotomy with (rfl | rfl | h), + { exact mem_ℓp_zero_iff.mpr {i : α | f i ≠ 0}.to_finite, }, + { exact mem_ℓp_infty_iff.mpr (set.finite.bdd_above (set.range (λ (i : α), ‖f i‖)).to_finite) }, + { casesI nonempty_fintype α, exact mem_ℓp_gen ⟨finset.univ.sum _, has_sum_fintype _⟩ } +end + +variables [fintype α] + +/-- The canonical `equiv` between `lp E p ≃ pi_Lp p E` when `E : α → Type u` with `[fintype α]`. -/ +def equiv.lp_pi_Lp : lp E p ≃ pi_Lp p E := +{ to_fun := λ f, f, + inv_fun := λ f, ⟨f, mem_ℓp.all f⟩, + left_inv := λ f, lp.ext $ funext $ λ x, rfl, + right_inv := λ f, funext $ λ x, rfl } + +lemma coe_equiv_lp_pi_Lp (f : lp E p) : equiv.lp_pi_Lp f = f := rfl +lemma coe_equiv_lp_pi_Lp_symm (f : pi_Lp p E) : (equiv.lp_pi_Lp.symm f : Π i, E i) = f := rfl + +lemma equiv_lp_pi_Lp_norm (f : lp E p) : ‖equiv.lp_pi_Lp f‖ = ‖f‖ := +begin + unfreezingI { rcases p.trichotomy with (rfl | rfl | h) }, + { rw [pi_Lp.norm_eq_card, lp.norm_eq_card_dsupport], refl }, + { rw [pi_Lp.norm_eq_csupr, lp.norm_eq_csupr], refl }, + { rw [pi_Lp.norm_eq_sum h, lp.norm_eq_tsum_rpow h, tsum_fintype], refl }, +end + +/-- The canonical `add_equiv` between `lp E p` and `pi_Lp p E` when `E : α → Type u` with +`[fintype α]` and `[fact (1 ≤ p)]`. -/ +def add_equiv.lp_pi_Lp [fact (1 ≤ p)] : lp E p ≃+ pi_Lp p E := +{ map_add' := λ f g, rfl, + .. equiv.lp_pi_Lp } + +lemma coe_add_equiv_lp_pi_Lp [fact (1 ≤ p)] (f : lp E p) : + add_equiv.lp_pi_Lp f = f := rfl +lemma coe_add_equiv_lp_pi_Lp_symm [fact (1 ≤ p)] (f : pi_Lp p E) : + (add_equiv.lp_pi_Lp.symm f : Π i, E i) = f := rfl + +section equivₗᵢ +variables (𝕜 : Type*) [nontrivially_normed_field 𝕜] [Π i, normed_space 𝕜 (E i)] + +/-- The canonical `linear_isometry_equiv` between `lp E p` and `pi_Lp p E` when `E : α → Type u` +with `[fintype α]` and `[fact (1 ≤ p)]`. -/ +noncomputable def lp_pi_Lpₗᵢ [fact (1 ≤ p)] : lp E p ≃ₗᵢ[𝕜] pi_Lp p E := +{ map_smul' := λ k f, rfl, + norm_map' := equiv_lp_pi_Lp_norm, + .. add_equiv.lp_pi_Lp } + +variables {𝕜} + +lemma coe_lp_pi_Lpₗᵢ [fact (1 ≤ p)] (f : lp E p) : + lp_pi_Lpₗᵢ 𝕜 f = f := rfl +lemma coe_lp_pi_Lpₗᵢ_symm [fact (1 ≤ p)] (f : pi_Lp p E) : + ((lp_pi_Lpₗᵢ 𝕜).symm f : Π i, E i) = f := rfl + +end equivₗᵢ + +end lp_pi_Lp + +section lp_bcf + +open_locale bounded_continuous_function +open bounded_continuous_function + +-- note: `R` and `A` are explicit because otherwise Lean has elaboration problems +variables {α E : Type*} (R A 𝕜 : Type*) [topological_space α] [discrete_topology α] +variables [normed_ring A] [norm_one_class A] [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 A] +variables [normed_add_comm_group E] [normed_space 𝕜 E] [non_unital_normed_ring R] + + +section normed_add_comm_group + +/-- The canonical map between `lp (λ (_ : α), E) ∞` and `α →ᵇ E` as an `add_equiv`. -/ +noncomputable def add_equiv.lp_bcf : + lp (λ (_ : α), E) ∞ ≃+ (α →ᵇ E) := +{ to_fun := λ f, of_normed_add_comm_group_discrete f (‖f‖) $ le_csupr (mem_ℓp_infty_iff.mp f.prop), + inv_fun := λ f, ⟨f, f.bdd_above_range_norm_comp⟩, + left_inv := λ f, lp.ext rfl, + right_inv := λ f, ext $ λ x, rfl, + map_add' := λ f g, ext $ λ x, rfl } + +lemma coe_add_equiv_lp_bcf (f : lp (λ (_ : α), E) ∞) : + (add_equiv.lp_bcf f : α → E) = f := rfl +lemma coe_add_equiv_lp_bcf_symm (f : α →ᵇ E) : (add_equiv.lp_bcf.symm f : α → E) = f := rfl + +/-- The canonical map between `lp (λ (_ : α), E) ∞` and `α →ᵇ E` as a `linear_isometry_equiv`. -/ +noncomputable def lp_bcfₗᵢ : lp (λ (_ : α), E) ∞ ≃ₗᵢ[𝕜] (α →ᵇ E) := +{ map_smul' := λ k f, rfl, + norm_map' := λ f, by { simp only [norm_eq_supr_norm, lp.norm_eq_csupr], refl }, + .. add_equiv.lp_bcf } + +variables {𝕜} + +lemma coe_lp_bcfₗᵢ (f : lp (λ (_ : α), E) ∞) : (lp_bcfₗᵢ 𝕜 f : α → E) = f := rfl +lemma coe_lp_bcfₗᵢ_symm (f : α →ᵇ E) : ((lp_bcfₗᵢ 𝕜).symm f : α → E) = f := rfl + +end normed_add_comm_group + +section ring_algebra + +/-- The canonical map between `lp (λ (_ : α), R) ∞` and `α →ᵇ R` as a `ring_equiv`. -/ +noncomputable def ring_equiv.lp_bcf : lp (λ (_ : α), R) ∞ ≃+* (α →ᵇ R) := +{ map_mul' := λ f g, ext $ λ x, rfl, .. @add_equiv.lp_bcf _ R _ _ _ } + +variables {R} +lemma coe_ring_equiv_lp_bcf (f : lp (λ (_ : α), R) ∞) : + (ring_equiv.lp_bcf R f : α → R) = f := rfl +lemma coe_ring_equiv_lp_bcf_symm (f : α →ᵇ R) : + ((ring_equiv.lp_bcf R).symm f : α → R) = f := rfl + +variables (α) -- even `α` needs to be explicit here for elaboration + +-- the `norm_one_class A` shouldn't really be necessary, but currently it is for +-- `one_mem_ℓp_infty` to get the `ring` instance on `lp`. +/-- The canonical map between `lp (λ (_ : α), A) ∞` and `α →ᵇ A` as an `alg_equiv`. -/ +noncomputable def alg_equiv.lp_bcf : lp (λ (_ : α), A) ∞ ≃ₐ[𝕜] (α →ᵇ A) := +{ commutes' := λ k, rfl, .. ring_equiv.lp_bcf A } + +variables {α A 𝕜} +lemma coe_alg_equiv_lp_bcf (f : lp (λ (_ : α), A) ∞) : + (alg_equiv.lp_bcf α A 𝕜 f : α → A) = f := rfl +lemma coe_alg_equiv_lp_bcf_symm (f : α →ᵇ A) : + ((alg_equiv.lp_bcf α A 𝕜).symm f : α → A) = f := rfl + +end ring_algebra + +end lp_bcf diff --git a/src/analysis/normed_space/lp_space.lean b/src/analysis/normed_space/lp_space.lean index 5b3b2302621fd..519890f3f49d6 100644 --- a/src/analysis/normed_space/lp_space.lean +++ b/src/analysis/normed_space/lp_space.lean @@ -5,18 +5,21 @@ Authors: Heather Macbeth -/ import analysis.mean_inequalities import analysis.mean_inequalities_pow -import analysis.normed.group.pointwise +import analysis.special_functions.pow.continuity import topology.algebra.order.liminf_limsup /-! # ℓp space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file describes properties of elements `f` of a pi-type `Π i, E i` with finite "norm", -defined for `p:ℝ≥0∞` as the size of the support of `f` if `p=0`, `(∑' a, ∥f a∥^p) ^ (1/p)` for -`0 < p < ∞` and `⨆ a, ∥f a∥` for `p=∞`. +defined for `p:ℝ≥0∞` as the size of the support of `f` if `p=0`, `(∑' a, ‖f a‖^p) ^ (1/p)` for +`0 < p < ∞` and `⨆ a, ‖f a‖` for `p=∞`. The Prop-valued `mem_ℓp f p` states that a function `f : Π i, E i` has finite norm according -to the above definition; that is, `f` has finite support if `p = 0`, `summable (λ a, ∥f a∥^p)` if +to the above definition; that is, `f` has finite support if `p = 0`, `summable (λ a, ‖f a‖^p)` if `0 < p < ∞`, and `bdd_above (norm '' (set.range f))` if `p = ∞`. The space `lp E p` is the subtype of elements of `Π i : α, E i` which satisfy `mem_ℓp f p`. For @@ -25,11 +28,13 @@ The space `lp E p` is the subtype of elements of `Π i : α, E i` which satisfy ## Main definitions * `mem_ℓp f p` : property that the function `f` satisfies, as appropriate, `f` finitely supported - if `p = 0`, `summable (λ a, ∥f a∥^p)` if `0 < p < ∞`, and `bdd_above (norm '' (set.range f))` if - `p = ∞` + if `p = 0`, `summable (λ a, ‖f a‖^p)` if `0 < p < ∞`, and `bdd_above (norm '' (set.range f))` if + `p = ∞`. * `lp E p` : elements of `Π i : α, E i` such that `mem_ℓp f p`. Defined as an `add_subgroup` of - a type synonym `pre_lp` for `Π i : α, E i`, and equipped with a `normed_group` structure; also - equipped with `normed_space 𝕜` and `complete_space` instances under appropriate conditions + a type synonym `pre_lp` for `Π i : α, E i`, and equipped with a `normed_add_comm_group` structure. + Under appropriate conditions, this is also equipped with the instances `lp.normed_space`, + `lp.complete_space`. For `p=∞`, there is also `lp.infty_normed_ring`, + `lp.infty_normed_algebra`, `lp.infty_star_ring` and `lp.infty_cstar_ring`. ## Main results @@ -42,25 +47,20 @@ The space `lp E p` is the subtype of elements of `Π i : α, E i` which satisfy ## Implementation Since `lp` is defined as an `add_subgroup`, dot notation does not work. Use `lp.norm_neg f` to -say that `∥-f∥ = ∥f∥`, instead of the non-working `f.norm_neg`. +say that `‖-f‖ = ‖f‖`, instead of the non-working `f.norm_neg`. ## TODO * More versions of Hölder's inequality (for example: the case `p = 1`, `q = ∞`; a version for normed - rings which has `∥∑' i, f i * g i∥` rather than `∑' i, ∥f i∥ * g i∥` on the RHS; a version for + rings which has `‖∑' i, f i * g i‖` rather than `∑' i, ‖f i‖ * g i‖` on the RHS; a version for three exponents satisfying `1 / r = 1 / p + 1 / q`) -* Equivalence with `pi_Lp`, for `α` finite -* Equivalence with `measure_theory.Lp`, for `f : α → E` (i.e., functions rather than pi-types) and - the counting measure on `α` -* Equivalence with `bounded_continuous_function`, for `f : α → E` (i.e., functions rather than - pi-types) and `p = ∞`, and the discrete topology on `α` -/ noncomputable theory open_locale nnreal ennreal big_operators -variables {α : Type*} {E : α → Type*} {p q : ℝ≥0∞} [Π i, normed_group (E i)] +variables {α : Type*} {E : α → Type*} {p q : ℝ≥0∞} [Π i, normed_add_comm_group (E i)] /-! ### `mem_ℓp` predicate @@ -69,11 +69,11 @@ variables {α : Type*} {E : α → Type*} {p q : ℝ≥0∞} [Π i, normed_group /-- The property that `f : Π i : α, E i` * is finitely supported, if `p = 0`, or -* admits an upper bound for `set.range (λ i, ∥f i∥)`, if `p = ∞`, or -* has the series `∑' i, ∥f i∥ ^ p` be summable, if `0 < p < ∞`. -/ +* admits an upper bound for `set.range (λ i, ‖f i‖)`, if `p = ∞`, or +* has the series `∑' i, ‖f i‖ ^ p` be summable, if `0 < p < ∞`. -/ def mem_ℓp (f : Π i, E i) (p : ℝ≥0∞) : Prop := if p = 0 then (set.finite {i | f i ≠ 0}) else - (if p = ∞ then bdd_above (set.range (λ i, ∥f i∥)) else summable (λ i, ∥f i∥ ^ p.to_real)) + (if p = ∞ then bdd_above (set.range (λ i, ‖f i‖)) else summable (λ i, ‖f i‖ ^ p.to_real)) lemma mem_ℓp_zero_iff {f : Π i, E i} : mem_ℓp f 0 ↔ set.finite {i | f i ≠ 0} := by dsimp [mem_ℓp]; rw [if_pos rfl] @@ -81,21 +81,21 @@ by dsimp [mem_ℓp]; rw [if_pos rfl] lemma mem_ℓp_zero {f : Π i, E i} (hf : set.finite {i | f i ≠ 0}) : mem_ℓp f 0 := mem_ℓp_zero_iff.2 hf -lemma mem_ℓp_infty_iff {f : Π i, E i} : mem_ℓp f ∞ ↔ bdd_above (set.range (λ i, ∥f i∥)) := +lemma mem_ℓp_infty_iff {f : Π i, E i} : mem_ℓp f ∞ ↔ bdd_above (set.range (λ i, ‖f i‖)) := by dsimp [mem_ℓp]; rw [if_neg ennreal.top_ne_zero, if_pos rfl] -lemma mem_ℓp_infty {f : Π i, E i} (hf : bdd_above (set.range (λ i, ∥f i∥))) : mem_ℓp f ∞ := +lemma mem_ℓp_infty {f : Π i, E i} (hf : bdd_above (set.range (λ i, ‖f i‖))) : mem_ℓp f ∞ := mem_ℓp_infty_iff.2 hf lemma mem_ℓp_gen_iff (hp : 0 < p.to_real) {f : Π i, E i} : - mem_ℓp f p ↔ summable (λ i, ∥f i∥ ^ p.to_real) := + mem_ℓp f p ↔ summable (λ i, ‖f i‖ ^ p.to_real) := begin rw ennreal.to_real_pos_iff at hp, dsimp [mem_ℓp], rw [if_neg hp.1.ne', if_neg hp.2.ne], end -lemma mem_ℓp_gen {f : Π i, E i} (hf : summable (λ i, ∥f i∥ ^ p.to_real)) : +lemma mem_ℓp_gen {f : Π i, E i} (hf : summable (λ i, ‖f i‖ ^ p.to_real)) : mem_ℓp f p := begin rcases p.trichotomy with rfl | rfl | hp, @@ -104,15 +104,15 @@ begin exact (finite_of_summable_const (by norm_num) H).subset (set.subset_univ _) }, { apply mem_ℓp_infty, have H : summable (λ i : α, (1:ℝ)) := by simpa using hf, - simpa using ((finite_of_summable_const (by norm_num) H).image (λ i, ∥f i∥)).bdd_above }, + simpa using ((finite_of_summable_const (by norm_num) H).image (λ i, ‖f i‖)).bdd_above }, exact (mem_ℓp_gen_iff hp).2 hf end -lemma mem_ℓp_gen' {C : ℝ} {f : Π i, E i} (hf : ∀ s : finset α, ∑ i in s, ∥f i∥ ^ p.to_real ≤ C) : +lemma mem_ℓp_gen' {C : ℝ} {f : Π i, E i} (hf : ∀ s : finset α, ∑ i in s, ‖f i‖ ^ p.to_real ≤ C) : mem_ℓp f p := begin apply mem_ℓp_gen, - use ⨆ s : finset α, ∑ i in s, ∥f i∥ ^ p.to_real, + use ⨆ s : finset α, ∑ i in s, ‖f i‖ ^ p.to_real, apply has_sum_of_is_lub_of_nonneg, { intros b, exact real.rpow_nonneg_of_nonneg (norm_nonneg _) _ }, @@ -141,11 +141,11 @@ namespace mem_ℓp lemma finite_dsupport {f : Π i, E i} (hf : mem_ℓp f 0) : set.finite {i | f i ≠ 0} := mem_ℓp_zero_iff.1 hf -lemma bdd_above {f : Π i, E i} (hf : mem_ℓp f ∞) : bdd_above (set.range (λ i, ∥f i∥)) := +lemma bdd_above {f : Π i, E i} (hf : mem_ℓp f ∞) : bdd_above (set.range (λ i, ‖f i‖)) := mem_ℓp_infty_iff.1 hf lemma summable (hp : 0 < p.to_real) {f : Π i, E i} (hf : mem_ℓp f p) : - summable (λ i, ∥f i∥ ^ p.to_real) := + summable (λ i, ‖f i‖ ^ p.to_real) := (mem_ℓp_gen_iff hp).1 hf lemma neg {f : Π i, E i} (hf : mem_ℓp f p) : mem_ℓp (-f) p := @@ -170,14 +170,14 @@ begin | ⟨hq, hp, hpq'⟩, { exact hfq }, { apply mem_ℓp_infty, - obtain ⟨C, hC⟩ := (hfq.finite_dsupport.image (λ i, ∥f i∥)).bdd_above, + obtain ⟨C, hC⟩ := (hfq.finite_dsupport.image (λ i, ‖f i‖)).bdd_above, use max 0 C, rintros x ⟨i, rfl⟩, by_cases hi : f i = 0, { simp [hi] }, { exact (hC ⟨i, hi, rfl⟩).trans (le_max_right _ _) } }, { apply mem_ℓp_gen, - have : ∀ i ∉ hfq.finite_dsupport.to_finset, ∥f i∥ ^ p.to_real = 0, + have : ∀ i ∉ hfq.finite_dsupport.to_finset, ‖f i‖ ^ p.to_real = 0, { intros i hi, have : f i = 0 := by simpa using hi, simp [this, real.zero_rpow hp.ne'] }, @@ -187,19 +187,19 @@ begin obtain ⟨A, hA⟩ := (hfq.summable hq).tendsto_cofinite_zero.bdd_above_range_of_cofinite, use A ^ (q.to_real⁻¹), rintros x ⟨i, rfl⟩, - have : 0 ≤ ∥f i∥ ^ q.to_real := real.rpow_nonneg_of_nonneg (norm_nonneg _) _, + have : 0 ≤ ‖f i‖ ^ q.to_real := real.rpow_nonneg_of_nonneg (norm_nonneg _) _, simpa [← real.rpow_mul, mul_inv_cancel hq.ne'] using real.rpow_le_rpow this (hA ⟨i, rfl⟩) (inv_nonneg.mpr hq.le) }, { apply mem_ℓp_gen, have hf' := hfq.summable hq, - refine summable_of_norm_bounded_eventually _ hf' (@set.finite.subset _ {i | 1 ≤ ∥f i∥} _ _ _), - { have H : {x : α | 1 ≤ ∥f x∥ ^ q.to_real}.finite, + refine summable_of_norm_bounded_eventually _ hf' (@set.finite.subset _ {i | 1 ≤ ‖f i‖} _ _ _), + { have H : {x : α | 1 ≤ ‖f x‖ ^ q.to_real}.finite, { simpa using eventually_lt_of_tendsto_lt (by norm_num : (0:ℝ) < 1) hf'.tendsto_cofinite_zero }, exact H.subset (λ i hi, real.one_le_rpow hi hq.le) }, - { show ∀ i, ¬ (|∥f i∥ ^ p.to_real| ≤ ∥f i∥ ^ q.to_real) → 1 ≤ ∥f i∥, + { show ∀ i, ¬ (|‖f i‖ ^ p.to_real| ≤ ‖f i‖ ^ q.to_real) → 1 ≤ ‖f i‖, intros i hi, - have : 0 ≤ ∥f i∥ ^ p.to_real := real.rpow_nonneg_of_nonneg (norm_nonneg _) p.to_real, + have : 0 ≤ ‖f i‖ ^ p.to_real := real.rpow_nonneg_of_nonneg (norm_nonneg _) p.to_real, simp only [abs_of_nonneg, this] at hi, contrapose! hi, exact real.rpow_le_rpow_of_exponent_ge' (norm_nonneg _) hi.le hq.le hpq' } } @@ -210,7 +210,7 @@ begin rcases p.trichotomy with rfl | rfl | hp, { apply mem_ℓp_zero, refine (hf.finite_dsupport.union hg.finite_dsupport).subset (λ i, _), - simp only [pi.add_apply, ne.def, set.mem_union_eq, set.mem_set_of_eq], + simp only [pi.add_apply, ne.def, set.mem_union, set.mem_set_of_eq], contrapose!, rintros ⟨hf', hg'⟩, simp [hf', hg'] }, @@ -227,8 +227,8 @@ begin { refine (real.rpow_le_rpow (norm_nonneg _) (norm_add_le _ _) hp.le).trans _, dsimp [C], split_ifs with h h, - { simpa using nnreal.coe_le_coe.2 (nnreal.rpow_add_le_add_rpow (∥f i∥₊) (∥g i∥₊) hp h.le) }, - { let F : fin 2 → ℝ≥0 := ![∥f i∥₊, ∥g i∥₊], + { simpa using nnreal.coe_le_coe.2 (nnreal.rpow_add_le_add_rpow (‖f i‖₊) (‖g i‖₊) hp.le h.le) }, + { let F : fin 2 → ℝ≥0 := ![‖f i‖₊, ‖g i‖₊], have : ∀ i, (0:ℝ) ≤ F i := λ i, (F i).coe_nonneg, simp only [not_lt] at h, simpa [F, fin.sum_univ_succ] using @@ -251,9 +251,9 @@ begin exact (hf i (s.mem_insert_self i)).add (ih (λ j hj, hf j (finset.mem_insert_of_mem hj))), }, end -section normed_space +section has_bounded_smul -variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)] +variables {𝕜 : Type*} [normed_ring 𝕜] [Π i, module 𝕜 (E i)] [∀ i, has_bounded_smul 𝕜 (E i)] lemma const_smul {f : Π i, E i} (hf : mem_ℓp f p) (c : 𝕜) : mem_ℓp (c • f) p := begin @@ -262,19 +262,23 @@ begin refine hf.finite_dsupport.subset (λ i, (_ : ¬c • f i = 0 → ¬f i = 0)), exact not_imp_not.mpr (λ hf', hf'.symm ▸ (smul_zero c)) }, { obtain ⟨A, hA⟩ := hf.bdd_above, - refine mem_ℓp_infty ⟨∥c∥ * A, _⟩, + refine mem_ℓp_infty ⟨‖c‖ * A, _⟩, rintros a ⟨i, rfl⟩, - simpa [norm_smul] using mul_le_mul_of_nonneg_left (hA ⟨i, rfl⟩) (norm_nonneg c) }, + refine (norm_smul_le _ _).trans _, + exact mul_le_mul_of_nonneg_left (hA ⟨i, rfl⟩) (norm_nonneg c) }, { apply mem_ℓp_gen, - convert (hf.summable hp).mul_left (∥c∥ ^ p.to_real), - ext i, - simp [norm_smul, real.mul_rpow (norm_nonneg c) (norm_nonneg (f i))] }, + have := (hf.summable hp).mul_left (↑(‖c‖₊ ^ p.to_real) : ℝ), + simp_rw [← coe_nnnorm, ←nnreal.coe_rpow, ←nnreal.coe_mul, nnreal.summable_coe, + ←nnreal.mul_rpow] at this ⊢, + refine nnreal.summable_of_le _ this, + intro i, + exact nnreal.rpow_le_rpow (nnnorm_smul_le _ _) (ennreal.to_real_nonneg), }, end lemma const_mul {f : α → 𝕜} (hf : mem_ℓp f p) (c : 𝕜) : mem_ℓp (λ x, c * f x) p := -@mem_ℓp.const_smul α (λ i, 𝕜) _ _ 𝕜 _ _ _ hf c +@mem_ℓp.const_smul α (λ i, 𝕜) _ _ 𝕜 _ _ (λ i, by apply_instance) _ hf c -end normed_space +end has_bounded_smul end mem_ℓp @@ -292,12 +296,12 @@ We choose to deal with this issue by making a type synonym for `Π i, E i` rathe subgroup itself, because this allows all the spaces `lp E p` (for varying `p`) to be subgroups of the same ambient group, which permits lemma statements like `lp.monotone` (below). -/ @[derive add_comm_group, nolint unused_arguments] -def pre_lp (E : α → Type*) [Π i, normed_group (E i)] : Type* := Π i, E i +def pre_lp (E : α → Type*) [Π i, normed_add_comm_group (E i)] : Type* := Π i, E i instance pre_lp.unique [is_empty α] : unique (pre_lp E) := pi.unique_of_is_empty E /-- lp space -/ -def lp (E : α → Type*) [Π i, normed_group (E i)] +def lp (E : α → Type*) [Π i, normed_add_comm_group (E i)] (p : ℝ≥0∞) : add_subgroup (pre_lp E) := { carrier := {f | mem_ℓp f p}, zero_mem' := zero_mem_ℓp, @@ -344,25 +348,25 @@ end instance : has_norm (lp E p) := { norm := λ f, if hp : p = 0 then by subst hp; exact (lp.mem_ℓp f).finite_dsupport.to_finset.card - else (if p = ∞ then ⨆ i, ∥f i∥ else (∑' i, ∥f i∥ ^ p.to_real) ^ (1/p.to_real)) } + else (if p = ∞ then ⨆ i, ‖f i‖ else (∑' i, ‖f i‖ ^ p.to_real) ^ (1/p.to_real)) } -lemma norm_eq_card_dsupport (f : lp E 0) : ∥f∥ = (lp.mem_ℓp f).finite_dsupport.to_finset.card := +lemma norm_eq_card_dsupport (f : lp E 0) : ‖f‖ = (lp.mem_ℓp f).finite_dsupport.to_finset.card := dif_pos rfl -lemma norm_eq_csupr (f : lp E ∞) : ∥f∥ = ⨆ i, ∥f i∥ := +lemma norm_eq_csupr (f : lp E ∞) : ‖f‖ = ⨆ i, ‖f i‖ := begin dsimp [norm], rw [dif_neg ennreal.top_ne_zero, if_pos rfl] end -lemma is_lub_norm [nonempty α] (f : lp E ∞) : is_lub (set.range (λ i, ∥f i∥)) ∥f∥ := +lemma is_lub_norm [nonempty α] (f : lp E ∞) : is_lub (set.range (λ i, ‖f i‖)) ‖f‖ := begin rw lp.norm_eq_csupr, exact is_lub_csupr (lp.mem_ℓp f) end lemma norm_eq_tsum_rpow (hp : 0 < p.to_real) (f : lp E p) : - ∥f∥ = (∑' i, ∥f i∥ ^ p.to_real) ^ (1/p.to_real) := + ‖f‖ = (∑' i, ‖f i‖ ^ p.to_real) ^ (1/p.to_real) := begin dsimp [norm], rw ennreal.to_real_pos_iff at hp, @@ -370,7 +374,7 @@ begin end lemma norm_rpow_eq_tsum (hp : 0 < p.to_real) (f : lp E p) : - ∥f∥ ^ p.to_real = ∑' i, ∥f i∥ ^ p.to_real := + ‖f‖ ^ p.to_real = ∑' i, ‖f i‖ ^ p.to_real := begin rw [norm_eq_tsum_rpow hp, ← real.rpow_mul], { field_simp [hp.ne'] }, @@ -381,13 +385,13 @@ begin end lemma has_sum_norm (hp : 0 < p.to_real) (f : lp E p) : - has_sum (λ i, ∥f i∥ ^ p.to_real) (∥f∥ ^ p.to_real) := + has_sum (λ i, ‖f i‖ ^ p.to_real) (‖f‖ ^ p.to_real) := begin rw norm_rpow_eq_tsum hp, exact ((lp.mem_ℓp f).summable hp).has_sum end -lemma norm_nonneg' (f : lp E p) : 0 ≤ ∥f∥ := +lemma norm_nonneg' (f : lp E p) : 0 ≤ ‖f‖ := begin rcases p.trichotomy with rfl | rfl | hp, { simp [lp.norm_eq_card_dsupport f] }, @@ -401,7 +405,7 @@ begin exact λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _ }, end -@[simp] lemma norm_zero : ∥(0 : lp E p)∥ = 0 := +@[simp] lemma norm_zero : ‖(0 : lp E p)‖ = 0 := begin rcases p.trichotomy with rfl | rfl | hp, { simp [lp.norm_eq_card_dsupport] }, @@ -411,7 +415,7 @@ begin simpa [real.zero_rpow hp.ne'] using real.zero_rpow hp' } end -lemma norm_eq_zero_iff ⦃f : lp E p⦄ : ∥f∥ = 0 ↔ f = 0 := +lemma norm_eq_zero_iff {f : lp E p} : ‖f‖ = 0 ↔ f = 0 := begin classical, refine ⟨λ h, _, by { rintros rfl, exact norm_zero }⟩, @@ -422,15 +426,15 @@ begin tauto }, { cases is_empty_or_nonempty α with _i _i; resetI, { simp }, - have H : is_lub (set.range (λ i, ∥f i∥)) 0, + have H : is_lub (set.range (λ i, ‖f i‖)) 0, { simpa [h] using lp.is_lub_norm f }, ext i, - have : ∥f i∥ = 0 := le_antisymm (H.1 ⟨i, rfl⟩) (norm_nonneg _), + have : ‖f i‖ = 0 := le_antisymm (H.1 ⟨i, rfl⟩) (norm_nonneg _), simpa using this }, - { have hf : has_sum (λ (i : α), ∥f i∥ ^ p.to_real) 0, + { have hf : has_sum (λ (i : α), ‖f i‖ ^ p.to_real) 0, { have := lp.has_sum_norm hp f, rwa [h, real.zero_rpow hp.ne'] at this }, - have : ∀ i, 0 ≤ ∥f i∥ ^ p.to_real := λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _, + have : ∀ i, 0 ≤ ‖f i‖ ^ p.to_real := λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _, rw has_sum_zero_iff_of_nonneg this at hf, ext i, have : f i = 0 ∧ p.to_real ≠ 0, @@ -441,7 +445,7 @@ end lemma eq_zero_iff_coe_fn_eq_zero {f : lp E p} : f = 0 ↔ ⇑f = 0 := by rw [lp.ext_iff, coe_fn_zero] -@[simp] lemma norm_neg ⦃f : lp E p⦄ : ∥-f∥ = ∥f∥ := +@[simp] lemma norm_neg ⦃f : lp E p⦄ : ‖-f‖ = ‖f‖ := begin rcases p.trichotomy with rfl | rfl | hp, { simp [lp.norm_eq_card_dsupport] }, @@ -449,18 +453,20 @@ begin { simp [lp.eq_zero' f], }, apply (lp.is_lub_norm (-f)).unique, simpa using lp.is_lub_norm f }, - { suffices : ∥-f∥ ^ p.to_real = ∥f∥ ^ p.to_real, + { suffices : ‖-f‖ ^ p.to_real = ‖f‖ ^ p.to_real, { exact real.rpow_left_inj_on hp.ne' (norm_nonneg' _) (norm_nonneg' _) this }, apply (lp.has_sum_norm hp (-f)).unique, simpa using lp.has_sum_norm hp f } end -instance [hp : fact (1 ≤ p)] : normed_group (lp E p) := -normed_group.of_core _ -{ norm_eq_zero_iff := norm_eq_zero_iff, - triangle := λ f g, begin +instance [hp : fact (1 ≤ p)] : normed_add_comm_group (lp E p) := +add_group_norm.to_normed_add_comm_group +{ to_fun := norm, + map_zero' := norm_zero, + neg' := norm_neg, + add_le' := λ f g, begin unfreezingI { rcases p.dichotomy with rfl | hp' }, - { cases is_empty_or_nonempty α; resetI, + { casesI is_empty_or_nonempty α, { simp [lp.eq_zero' f] }, refine (lp.is_lub_norm (f + g)).2 _, rintros x ⟨i, rfl⟩, @@ -468,8 +474,8 @@ normed_group.of_core _ ⟨_, _, ⟨i, rfl⟩, ⟨i, rfl⟩, rfl⟩), exact norm_add_le (f i) (g i) }, { have hp'' : 0 < p.to_real := zero_lt_one.trans_le hp', - have hf₁ : ∀ i, 0 ≤ ∥f i∥ := λ i, norm_nonneg _, - have hg₁ : ∀ i, 0 ≤ ∥g i∥ := λ i, norm_nonneg _, + have hf₁ : ∀ i, 0 ≤ ‖f i‖ := λ i, norm_nonneg _, + have hg₁ : ∀ i, 0 ≤ ‖g i‖ := λ i, norm_nonneg _, have hf₂ := lp.has_sum_norm hp'' f, have hg₂ := lp.has_sum_norm hp'' g, -- apply Minkowski's inequality @@ -481,17 +487,17 @@ normed_group.of_core _ intros i, exact real.rpow_le_rpow (norm_nonneg _) (norm_add_le _ _) hp''.le }, end, - norm_neg := norm_neg } + eq_zero_of_map_eq_zero' := λ f, norm_eq_zero_iff.1 } -- TODO: define an `ennreal` version of `is_conjugate_exponent`, and then express this inequality -- in a better version which also covers the case `p = 1, q = ∞`. /-- Hölder inequality -/ protected lemma tsum_mul_le_mul_norm {p q : ℝ≥0∞} (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p) (g : lp E q) : - summable (λ i, ∥f i∥ * ∥g i∥) ∧ ∑' i, ∥f i∥ * ∥g i∥ ≤ ∥f∥ * ∥g∥ := + summable (λ i, ‖f i‖ * ‖g i‖) ∧ ∑' i, ‖f i‖ * ‖g i‖ ≤ ‖f‖ * ‖g‖ := begin - have hf₁ : ∀ i, 0 ≤ ∥f i∥ := λ i, norm_nonneg _, - have hg₁ : ∀ i, 0 ≤ ∥g i∥ := λ i, norm_nonneg _, + have hf₁ : ∀ i, 0 ≤ ‖f i‖ := λ i, norm_nonneg _, + have hg₁ : ∀ i, 0 ≤ ‖g i‖ := λ i, norm_nonneg _, have hf₂ := lp.has_sum_norm hpq.pos f, have hg₂ := lp.has_sum_norm hpq.symm.pos g, obtain ⟨C, -, hC', hC⟩ := @@ -502,46 +508,46 @@ end protected lemma summable_mul {p q : ℝ≥0∞} (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p) (g : lp E q) : - summable (λ i, ∥f i∥ * ∥g i∥) := + summable (λ i, ‖f i‖ * ‖g i‖) := (lp.tsum_mul_le_mul_norm hpq f g).1 protected lemma tsum_mul_le_mul_norm' {p q : ℝ≥0∞} (hpq : p.to_real.is_conjugate_exponent q.to_real) (f : lp E p) (g : lp E q) : - ∑' i, ∥f i∥ * ∥g i∥ ≤ ∥f∥ * ∥g∥ := + ∑' i, ‖f i‖ * ‖g i‖ ≤ ‖f‖ * ‖g‖ := (lp.tsum_mul_le_mul_norm hpq f g).2 section compare_pointwise -lemma norm_apply_le_norm (hp : p ≠ 0) (f : lp E p) (i : α) : ∥f i∥ ≤ ∥f∥ := +lemma norm_apply_le_norm (hp : p ≠ 0) (f : lp E p) (i : α) : ‖f i‖ ≤ ‖f‖ := begin rcases eq_or_ne p ∞ with rfl | hp', { haveI : nonempty α := ⟨i⟩, exact (is_lub_norm f).1 ⟨i, rfl⟩ }, have hp'' : 0 < p.to_real := ennreal.to_real_pos hp hp', - have : ∀ i, 0 ≤ ∥f i∥ ^ p.to_real, + have : ∀ i, 0 ≤ ‖f i‖ ^ p.to_real, { exact λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _ }, rw ← real.rpow_le_rpow_iff (norm_nonneg _) (norm_nonneg' _) hp'', convert le_has_sum (has_sum_norm hp'' f) i (λ i hi, this i), end lemma sum_rpow_le_norm_rpow (hp : 0 < p.to_real) (f : lp E p) (s : finset α) : - ∑ i in s, ∥f i∥ ^ p.to_real ≤ ∥f∥ ^ p.to_real := + ∑ i in s, ‖f i‖ ^ p.to_real ≤ ‖f‖ ^ p.to_real := begin rw lp.norm_rpow_eq_tsum hp f, - have : ∀ i, 0 ≤ ∥f i∥ ^ p.to_real, + have : ∀ i, 0 ≤ ‖f i‖ ^ p.to_real, { exact λ i, real.rpow_nonneg_of_nonneg (norm_nonneg _) _ }, refine sum_le_tsum _ (λ i hi, this i) _, exact (lp.mem_ℓp f).summable hp end -lemma norm_le_of_forall_le' [nonempty α] {f : lp E ∞} (C : ℝ) (hCf : ∀ i, ∥f i∥ ≤ C) : ∥f∥ ≤ C := +lemma norm_le_of_forall_le' [nonempty α] {f : lp E ∞} (C : ℝ) (hCf : ∀ i, ‖f i‖ ≤ C) : ‖f‖ ≤ C := begin refine (is_lub_norm f).2 _, rintros - ⟨i, rfl⟩, exact hCf i, end -lemma norm_le_of_forall_le {f : lp E ∞} {C : ℝ} (hC : 0 ≤ C) (hCf : ∀ i, ∥f i∥ ≤ C) : ∥f∥ ≤ C := +lemma norm_le_of_forall_le {f : lp E ∞} {C : ℝ} (hC : 0 ≤ C) (hCf : ∀ i, ‖f i‖ ≤ C) : ‖f‖ ≤ C := begin casesI is_empty_or_nonempty α, { simpa [eq_zero' f] using hC, }, @@ -549,26 +555,39 @@ begin end lemma norm_le_of_tsum_le (hp : 0 < p.to_real) {C : ℝ} (hC : 0 ≤ C) {f : lp E p} - (hf : ∑' i, ∥f i∥ ^ p.to_real ≤ C ^ p.to_real) : - ∥f∥ ≤ C := + (hf : ∑' i, ‖f i‖ ^ p.to_real ≤ C ^ p.to_real) : + ‖f‖ ≤ C := begin rw [← real.rpow_le_rpow_iff (norm_nonneg' _) hC hp, norm_rpow_eq_tsum hp], exact hf, end lemma norm_le_of_forall_sum_le (hp : 0 < p.to_real) {C : ℝ} (hC : 0 ≤ C) {f : lp E p} - (hf : ∀ s : finset α, ∑ i in s, ∥f i∥ ^ p.to_real ≤ C ^ p.to_real) : - ∥f∥ ≤ C := + (hf : ∀ s : finset α, ∑ i in s, ‖f i‖ ^ p.to_real ≤ C ^ p.to_real) : + ‖f‖ ≤ C := norm_le_of_tsum_le hp hC (tsum_le_of_sum_le ((lp.mem_ℓp f).summable hp) hf) end compare_pointwise -section normed_space - -variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)] +section has_bounded_smul +variables {𝕜 : Type*} {𝕜' : Type*} +variables [normed_ring 𝕜] [normed_ring 𝕜'] +variables [Π i, module 𝕜 (E i)] [Π i, module 𝕜' (E i)] instance : module 𝕜 (pre_lp E) := pi.module α E 𝕜 +instance [Π i, smul_comm_class 𝕜' 𝕜 (E i)] : smul_comm_class 𝕜' 𝕜 (pre_lp E) := +pi.smul_comm_class + +instance [has_smul 𝕜' 𝕜] [Π i, is_scalar_tower 𝕜' 𝕜 (E i)] : is_scalar_tower 𝕜' 𝕜 (pre_lp E) := +pi.is_scalar_tower + +instance [Π i, module 𝕜ᵐᵒᵖ (E i)] [Π i, is_central_scalar 𝕜 (E i)] : + is_central_scalar 𝕜 (pre_lp E) := +pi.is_central_scalar + +variables [∀ i, has_bounded_smul 𝕜 (E i)] [∀ i, has_bounded_smul 𝕜' (E i)] + lemma mem_lp_const_smul (c : 𝕜) (f : lp E p) : c • (f : pre_lp E) ∈ lp E p := (lp.mem_ℓp f).const_smul c @@ -576,7 +595,7 @@ variables (E p 𝕜) /-- The `𝕜`-submodule of elements of `Π i : α, E i` whose `lp` norm is finite. This is `lp E p`, with extra structure. -/ -def lp_submodule : submodule 𝕜 (pre_lp E) := +def _root_.lp_submodule : submodule 𝕜 (pre_lp E) := { smul_mem' := λ c f hf, by simpa using mem_lp_const_smul c ⟨f, hf⟩, .. lp E p } @@ -589,47 +608,299 @@ instance : module 𝕜 (lp E p) := @[simp] lemma coe_fn_smul (c : 𝕜) (f : lp E p) : ⇑(c • f) = c • f := rfl -lemma norm_const_smul (hp : p ≠ 0) {c : 𝕜} (f : lp E p) : ∥c • f∥ = ∥c∥ * ∥f∥ := +instance [Π i, smul_comm_class 𝕜' 𝕜 (E i)] : smul_comm_class 𝕜' 𝕜 (lp E p) := +⟨λ r c f, subtype.ext $ smul_comm _ _ _⟩ + +instance [has_smul 𝕜' 𝕜] [Π i, is_scalar_tower 𝕜' 𝕜 (E i)] : is_scalar_tower 𝕜' 𝕜 (lp E p) := +⟨λ r c f, subtype.ext $ smul_assoc _ _ _⟩ + +instance [Π i, module 𝕜ᵐᵒᵖ (E i)] [Π i, is_central_scalar 𝕜 (E i)] : + is_central_scalar 𝕜 (lp E p) := +⟨λ r f, subtype.ext $ op_smul_eq_smul _ _⟩ + +lemma norm_const_smul_le (hp : p ≠ 0) (c : 𝕜) (f : lp E p) : ‖c • f‖ ≤ ‖c‖ * ‖f‖ := begin rcases p.trichotomy with rfl | rfl | hp, { exact absurd rfl hp }, { cases is_empty_or_nonempty α; resetI, { simp [lp.eq_zero' f], }, - apply (lp.is_lub_norm (c • f)).unique, - convert (lp.is_lub_norm f).mul_left (norm_nonneg c), - ext a, - simp [coe_fn_smul, norm_smul] }, - { suffices : ∥c • f∥ ^ p.to_real = (∥c∥ * ∥f∥) ^ p.to_real, - { refine real.rpow_left_inj_on hp.ne' _ _ this, - { exact norm_nonneg' _ }, - { exact mul_nonneg (norm_nonneg _) (norm_nonneg' _) } }, - apply (lp.has_sum_norm hp (c • f)).unique, - convert (lp.has_sum_norm hp f).mul_left (∥c∥ ^ p.to_real), - { simp [coe_fn_smul, norm_smul, real.mul_rpow (norm_nonneg c) (norm_nonneg _)] }, - have hf : 0 ≤ ∥f∥ := lp.norm_nonneg' f, - simp [coe_fn_smul, norm_smul, real.mul_rpow (norm_nonneg c) hf] } + have hcf := lp.is_lub_norm (c • f), + have hfc := (lp.is_lub_norm f).mul_left (norm_nonneg c), + simp_rw [←set.range_comp, function.comp] at hfc, + -- TODO: some `is_lub` API should make it a one-liner from here. + refine hcf.right _, + have := hfc.left, + simp_rw [mem_upper_bounds, set.mem_range, forall_exists_index, + forall_apply_eq_imp_iff'] at this ⊢, + intro a, + exact (norm_smul_le _ _).trans (this a) }, + { letI inst : has_nnnorm (lp E p) := ⟨λ f, ⟨‖f‖, norm_nonneg' _⟩⟩, + have coe_nnnorm : ∀ f : lp E p, ↑‖f‖₊ = ‖f‖ := λ _, rfl, + suffices : ‖c • f‖₊ ^ p.to_real ≤ (‖c‖₊ * ‖f‖₊) ^ p.to_real, + { rwa nnreal.rpow_le_rpow_iff hp at this }, + unfreezingI { clear_value inst }, + rw [nnreal.mul_rpow], + have hLHS := (lp.has_sum_norm hp (c • f)), + have hRHS := (lp.has_sum_norm hp f).mul_left (‖c‖ ^ p.to_real), + simp_rw [←coe_nnnorm, ←_root_.coe_nnnorm, ←nnreal.coe_rpow, ←nnreal.coe_mul, + nnreal.has_sum_coe] at hRHS hLHS, + refine has_sum_mono hLHS hRHS (λ i, _), + dsimp only, + rw [←nnreal.mul_rpow], + exact nnreal.rpow_le_rpow (nnnorm_smul_le _ _) ennreal.to_real_nonneg } end +instance [fact (1 ≤ p)] : has_bounded_smul 𝕜 (lp E p) := +has_bounded_smul.of_norm_smul_le $ norm_const_smul_le (zero_lt_one.trans_le $ fact.out (1 ≤ p)).ne' + +end has_bounded_smul + +section division_ring +variables {𝕜 : Type*} +variables [normed_division_ring 𝕜] [Π i, module 𝕜 (E i)] [∀ i, has_bounded_smul 𝕜 (E i)] + +lemma norm_const_smul (hp : p ≠ 0) {c : 𝕜} (f : lp E p) : ‖c • f‖ = ‖c‖ * ‖f‖ := +begin + obtain rfl | hc := eq_or_ne c 0, + { simp }, + refine le_antisymm (norm_const_smul_le hp c f) _, + have := mul_le_mul_of_nonneg_left (norm_const_smul_le hp c⁻¹ (c • f)) (norm_nonneg c), + rwa [inv_smul_smul₀ hc, norm_inv, mul_inv_cancel_left₀ (norm_ne_zero_iff.mpr hc)] at this, +end + +end division_ring + +section normed_space +variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)] + instance [fact (1 ≤ p)] : normed_space 𝕜 (lp E p) := -{ norm_smul_le := λ c f, begin - have hp : 0 < p := ennreal.zero_lt_one.trans_le (fact.out _), - simp [norm_const_smul hp.ne'] +{ norm_smul_le := λ c f, norm_smul_le _ _} + +end normed_space + +section normed_star_group + +variables [Π i, star_add_monoid (E i)] [Π i, normed_star_group (E i)] + +lemma _root_.mem_ℓp.star_mem {f : Π i, E i} + (hf : mem_ℓp f p) : mem_ℓp (star f) p := +begin + rcases p.trichotomy with rfl | rfl | hp, + { apply mem_ℓp_zero, + simp [hf.finite_dsupport] }, + { apply mem_ℓp_infty, + simpa using hf.bdd_above }, + { apply mem_ℓp_gen, + simpa using hf.summable hp }, +end + +@[simp] lemma _root_.mem_ℓp.star_iff {f : Π i, E i} : mem_ℓp (star f) p ↔ mem_ℓp f p := +⟨λ h, star_star f ▸ mem_ℓp.star_mem h ,mem_ℓp.star_mem⟩ + +instance : has_star (lp E p) := +{ star := λ f, ⟨(star f : Π i, E i), f.property.star_mem⟩} + +@[simp] lemma coe_fn_star (f : lp E p) : ⇑(star f) = star f := rfl +@[simp] protected theorem star_apply (f : lp E p) (i : α) : star f i = star (f i) := rfl + +instance : has_involutive_star (lp E p) := { star_involutive := λ x, by {ext, simp} } + +instance : star_add_monoid (lp E p) := { star_add := λ f g, ext $ star_add _ _ } + +instance [hp : fact (1 ≤ p)] : normed_star_group (lp E p) := +{ norm_star := λ f, + begin + unfreezingI { rcases p.trichotomy with rfl | rfl | h }, + { exfalso, + have := ennreal.to_real_mono ennreal.zero_ne_top hp.elim, + norm_num at this,}, + { simp only [lp.norm_eq_csupr, lp.star_apply, norm_star] }, + { simp only [lp.norm_eq_tsum_rpow h, lp.star_apply, norm_star] } end } -variables {𝕜' : Type*} [normed_field 𝕜'] +variables {𝕜 : Type*} [has_star 𝕜] [normed_ring 𝕜] +variables [Π i, module 𝕜 (E i)] [∀ i, has_bounded_smul 𝕜 (E i)] [Π i, star_module 𝕜 (E i)] -instance [Π i, normed_space 𝕜' (E i)] [has_scalar 𝕜' 𝕜] [Π i, is_scalar_tower 𝕜' 𝕜 (E i)] : - is_scalar_tower 𝕜' 𝕜 (lp E p) := +instance : star_module 𝕜 (lp E p) := { star_smul := λ r f, ext $ star_smul _ _ } + +end normed_star_group + +section non_unital_normed_ring + +variables {I : Type*} {B : I → Type*} [Π i, non_unital_normed_ring (B i)] + +lemma _root_.mem_ℓp.infty_mul {f g : Π i, B i} (hf : mem_ℓp f ∞) (hg : mem_ℓp g ∞) : + mem_ℓp (f * g) ∞ := begin - refine ⟨λ r c f, _⟩, - ext1, - exact (lp.coe_fn_smul _ _).trans (smul_assoc _ _ _) + rw mem_ℓp_infty_iff, + obtain ⟨⟨Cf, hCf⟩, ⟨Cg, hCg⟩⟩ := ⟨hf.bdd_above, hg.bdd_above⟩, + refine ⟨Cf * Cg, _⟩, + rintros _ ⟨i, rfl⟩, + calc ‖(f * g) i‖ ≤ ‖f i‖ * ‖g i‖ : norm_mul_le (f i) (g i) + ... ≤ Cf * Cg : mul_le_mul (hCf ⟨i, rfl⟩) (hCg ⟨i, rfl⟩) (norm_nonneg _) + ((norm_nonneg _).trans (hCf ⟨i, rfl⟩)) end -end normed_space +instance : has_mul (lp B ∞) := +{ mul := λ f g, ⟨(f * g : Π i, B i) , f.property.infty_mul g.property⟩} + +@[simp] lemma infty_coe_fn_mul (f g : lp B ∞) : ⇑(f * g) = f * g := rfl + +instance : non_unital_ring (lp B ∞) := +function.injective.non_unital_ring lp.has_coe_to_fun.coe (subtype.coe_injective) + (lp.coe_fn_zero B ∞) lp.coe_fn_add infty_coe_fn_mul lp.coe_fn_neg lp.coe_fn_sub + (λ _ _, rfl) (λ _ _,rfl) + +instance : non_unital_normed_ring (lp B ∞) := +{ norm_mul := λ f g, lp.norm_le_of_forall_le (mul_nonneg (norm_nonneg f) (norm_nonneg g)) + (λ i, calc ‖(f * g) i‖ ≤ ‖f i‖ * ‖g i‖ : norm_mul_le _ _ + ... ≤ ‖f‖ * ‖g‖ + : mul_le_mul (lp.norm_apply_le_norm ennreal.top_ne_zero f i) + (lp.norm_apply_le_norm ennreal.top_ne_zero g i) (norm_nonneg _) (norm_nonneg _)), + .. lp.normed_add_comm_group } + +-- we also want a `non_unital_normed_comm_ring` instance, but this has to wait for #13719 + +instance infty_is_scalar_tower + {𝕜} [normed_ring 𝕜] [Π i, module 𝕜 (B i)] [∀ i, has_bounded_smul 𝕜 (B i)] + [Π i, is_scalar_tower 𝕜 (B i) (B i)] : + is_scalar_tower 𝕜 (lp B ∞) (lp B ∞) := +⟨λ r f g, lp.ext $ smul_assoc r ⇑f ⇑g⟩ + +instance infty_smul_comm_class + {𝕜} [normed_ring 𝕜] [Π i, module 𝕜 (B i)] [∀ i, has_bounded_smul 𝕜 (B i)] + [Π i, smul_comm_class 𝕜 (B i) (B i)] : + smul_comm_class 𝕜 (lp B ∞) (lp B ∞) := +⟨λ r f g, lp.ext $ smul_comm r ⇑f ⇑g⟩ + +section star_ring + +variables [Π i, star_ring (B i)] [Π i, normed_star_group (B i)] + +instance infty_star_ring : star_ring (lp B ∞) := +{ star_mul := λ f g, ext $ star_mul (_ : Π i, B i) _, + .. (show star_add_monoid (lp B ∞), + by { letI : Π i, star_add_monoid (B i) := λ i, infer_instance, apply_instance }) } + +instance infty_cstar_ring [∀ i, cstar_ring (B i)] : cstar_ring (lp B ∞) := +{ norm_star_mul_self := λ f, + begin + apply le_antisymm, + { rw ←sq, + refine lp.norm_le_of_forall_le (sq_nonneg ‖ f ‖) (λ i, _), + simp only [lp.star_apply, cstar_ring.norm_star_mul_self, ←sq, infty_coe_fn_mul, pi.mul_apply], + refine sq_le_sq' _ (lp.norm_apply_le_norm ennreal.top_ne_zero _ _), + linarith [norm_nonneg (f i), norm_nonneg f] }, + { rw [←sq, ←real.le_sqrt (norm_nonneg _) (norm_nonneg _)], + refine lp.norm_le_of_forall_le (‖star f * f‖.sqrt_nonneg) (λ i, _), + rw [real.le_sqrt (norm_nonneg _) (norm_nonneg _), sq, ←cstar_ring.norm_star_mul_self], + exact lp.norm_apply_le_norm ennreal.top_ne_zero (star f * f) i, } + end } + +end star_ring + +end non_unital_normed_ring + +section normed_ring + +variables {I : Type*} {B : I → Type*} [Π i, normed_ring (B i)] + +instance _root_.pre_lp.ring : ring (pre_lp B) := pi.ring + +variables [Π i, norm_one_class (B i)] + +lemma _root_.one_mem_ℓp_infty : mem_ℓp (1 : Π i, B i) ∞ := +⟨1, by { rintros i ⟨i, rfl⟩, exact norm_one.le,}⟩ + +variables (B) + +/-- The `𝕜`-subring of elements of `Π i : α, B i` whose `lp` norm is finite. This is `lp E ∞`, +with extra structure. -/ +def _root_.lp_infty_subring : subring (pre_lp B) := +{ carrier := {f | mem_ℓp f ∞}, + one_mem' := one_mem_ℓp_infty, + mul_mem' := λ f g hf hg, hf.infty_mul hg, + .. lp B ∞ } + +variables {B} + +instance infty_ring : ring (lp B ∞) := (lp_infty_subring B).to_ring + +lemma _root_.mem_ℓp.infty_pow {f : Π i, B i} (hf : mem_ℓp f ∞) (n : ℕ) : mem_ℓp (f ^ n) ∞ := +(lp_infty_subring B).pow_mem hf n + +lemma _root_.nat_cast_mem_ℓp_infty (n : ℕ) : mem_ℓp (n : Π i, B i) ∞ := +nat_cast_mem (lp_infty_subring B) n + +lemma _root_.int_cast_mem_ℓp_infty (z : ℤ) : mem_ℓp (z : Π i, B i) ∞ := +coe_int_mem (lp_infty_subring B) z + +@[simp] lemma infty_coe_fn_one : ⇑(1 : lp B ∞) = 1 := rfl + +@[simp] lemma infty_coe_fn_pow (f : lp B ∞) (n : ℕ) : ⇑(f ^ n) = f ^ n := rfl + +@[simp] lemma infty_coe_fn_nat_cast (n : ℕ) : ⇑(n : lp B ∞) = n := rfl + +@[simp] lemma infty_coe_fn_int_cast (z : ℤ) : ⇑(z : lp B ∞) = z := rfl + +instance [nonempty I] : norm_one_class (lp B ∞) := +{ norm_one := by simp_rw [lp.norm_eq_csupr, infty_coe_fn_one, pi.one_apply, norm_one, csupr_const]} + +instance infty_normed_ring : normed_ring (lp B ∞) := +{ .. lp.infty_ring, .. lp.non_unital_normed_ring } + +end normed_ring + +section normed_comm_ring + +variables {I : Type*} {B : I → Type*} [Π i, normed_comm_ring (B i)] [∀ i, norm_one_class (B i)] + +instance infty_comm_ring : comm_ring (lp B ∞) := +{ mul_comm := λ f g, by { ext, simp only [lp.infty_coe_fn_mul, pi.mul_apply, mul_comm] }, + .. lp.infty_ring } + +instance infty_normed_comm_ring : normed_comm_ring (lp B ∞) := +{ .. lp.infty_comm_ring, .. lp.infty_normed_ring } + +end normed_comm_ring + +section algebra +variables {I : Type*} {𝕜 : Type*} {B : I → Type*} +variables [normed_field 𝕜] [Π i, normed_ring (B i)] [Π i, normed_algebra 𝕜 (B i)] + +/-- A variant of `pi.algebra` that lean can't find otherwise. -/ +instance _root_.pi.algebra_of_normed_algebra : algebra 𝕜 (Π i, B i) := +@pi.algebra I 𝕜 B _ _ $ λ i, normed_algebra.to_algebra + +instance _root_.pre_lp.algebra : algebra 𝕜 (pre_lp B) := _root_.pi.algebra_of_normed_algebra + +variables [∀ i, norm_one_class (B i)] + +lemma _root_.algebra_map_mem_ℓp_infty (k : 𝕜) : mem_ℓp (algebra_map 𝕜 (Π i, B i) k) ∞ := +begin + rw algebra.algebra_map_eq_smul_one, + exact (one_mem_ℓp_infty.const_smul k : mem_ℓp (k • 1 : Π i, B i) ∞) +end + +variables (𝕜 B) + +/-- The `𝕜`-subalgebra of elements of `Π i : α, B i` whose `lp` norm is finite. This is `lp E ∞`, +with extra structure. -/ +def _root_.lp_infty_subalgebra : subalgebra 𝕜 (pre_lp B) := +{ carrier := {f | mem_ℓp f ∞}, + algebra_map_mem' := algebra_map_mem_ℓp_infty, + .. lp_infty_subring B } + +variables {𝕜 B} + +instance infty_normed_algebra : normed_algebra 𝕜 (lp B ∞) := +{ ..(lp_infty_subalgebra 𝕜 B).algebra, + ..(lp.normed_space : normed_space 𝕜 (lp B ∞)) } + +end algebra section single -variables {𝕜 : Type*} [normed_field 𝕜] [Π i, normed_space 𝕜 (E i)] +variables {𝕜 : Type*} [normed_ring 𝕜] [Π i, module 𝕜 (E i)] [∀ i, has_bounded_smul 𝕜 (E i)] variables [decidable_eq α] /-- The element of `lp E p` which is `a : E i` at the index `i`, and zero elsewhere. -/ @@ -678,45 +949,48 @@ begin end protected lemma norm_sum_single (hp : 0 < p.to_real) (f : Π i, E i) (s : finset α) : - ∥∑ i in s, lp.single p i (f i)∥ ^ p.to_real = ∑ i in s, ∥f i∥ ^ p.to_real := + ‖∑ i in s, lp.single p i (f i)‖ ^ p.to_real = ∑ i in s, ‖f i‖ ^ p.to_real := begin refine (has_sum_norm hp (∑ i in s, lp.single p i (f i))).unique _, simp only [lp.single_apply, coe_fn_sum, finset.sum_apply, finset.sum_dite_eq], - have h : ∀ i ∉ s, ∥ite (i ∈ s) (f i) 0∥ ^ p.to_real = 0, + have h : ∀ i ∉ s, ‖ite (i ∈ s) (f i) 0‖ ^ p.to_real = 0, { intros i hi, simp [if_neg hi, real.zero_rpow hp.ne'], }, - have h' : ∀ i ∈ s, ∥f i∥ ^ p.to_real = ∥ite (i ∈ s) (f i) 0∥ ^ p.to_real, + have h' : ∀ i ∈ s, ‖f i‖ ^ p.to_real = ‖ite (i ∈ s) (f i) 0‖ ^ p.to_real, { intros i hi, rw if_pos hi }, simpa [finset.sum_congr rfl h'] using has_sum_sum_of_ne_finset_zero h, end protected lemma norm_single (hp : 0 < p.to_real) (f : Π i, E i) (i : α) : - ∥lp.single p i (f i)∥ = ∥f i∥ := + ‖lp.single p i (f i)‖ = ‖f i‖ := begin refine real.rpow_left_inj_on hp.ne' (norm_nonneg' _) (norm_nonneg _) _, simpa using lp.norm_sum_single hp f {i}, end protected lemma norm_sub_norm_compl_sub_single (hp : 0 < p.to_real) (f : lp E p) (s : finset α) : - ∥f∥ ^ p.to_real - ∥f - ∑ i in s, lp.single p i (f i)∥ ^ p.to_real = ∑ i in s, ∥f i∥ ^ p.to_real := + ‖f‖ ^ p.to_real - ‖f - ∑ i in s, lp.single p i (f i)‖ ^ p.to_real = ∑ i in s, ‖f i‖ ^ p.to_real := begin refine ((has_sum_norm hp f).sub (has_sum_norm hp (f - ∑ i in s, lp.single p i (f i)))).unique _, - let F : α → ℝ := λ i, ∥f i∥ ^ p.to_real - ∥(f - ∑ i in s, lp.single p i (f i)) i∥ ^ p.to_real, + let F : α → ℝ := λ i, ‖f i‖ ^ p.to_real - ‖(f - ∑ i in s, lp.single p i (f i)) i‖ ^ p.to_real, have hF : ∀ i ∉ s, F i = 0, { intros i hi, - suffices : ∥f i∥ ^ p.to_real - ∥f i - ite (i ∈ s) (f i) 0∥ ^ p.to_real = 0, - { simpa [F, coe_fn_sum, lp.single_apply] using this, }, - simp [if_neg hi] }, - have hF' : ∀ i ∈ s, F i = ∥f i∥ ^ p.to_real, + suffices : ‖f i‖ ^ p.to_real - ‖f i - ite (i ∈ s) (f i) 0‖ ^ p.to_real = 0, + { simpa only [F, coe_fn_sum, lp.single_apply, coe_fn_sub, pi.sub_apply, finset.sum_apply, + finset.sum_dite_eq] using this, }, + simp only [if_neg hi, sub_zero, sub_self] }, + have hF' : ∀ i ∈ s, F i = ‖f i‖ ^ p.to_real, { intros i hi, - simp [F, coe_fn_sum, lp.single_apply, if_pos hi, real.zero_rpow hp.ne'] }, + simp only [F, coe_fn_sum, lp.single_apply, if_pos hi, sub_self, eq_self_iff_true, + coe_fn_sub, pi.sub_apply, finset.sum_apply, finset.sum_dite_eq, sub_eq_self], + simp [real.zero_rpow hp.ne'], }, have : has_sum F (∑ i in s, F i) := has_sum_sum_of_ne_finset_zero hF, rwa [finset.sum_congr rfl hF'] at this, end protected lemma norm_compl_sum_single (hp : 0 < p.to_real) (f : lp E p) (s : finset α) : - ∥f - ∑ i in s, lp.single p i (f i)∥ ^ p.to_real = ∥f∥ ^ p.to_real - ∑ i in s, ∥f i∥ ^ p.to_real := + ‖f - ∑ i in s, lp.single p i (f i)‖ ^ p.to_real = ‖f‖ ^ p.to_real - ∑ i in s, ‖f i‖ ^ p.to_real := by linarith [lp.norm_sub_norm_compl_sub_single hp f s] /-- The canonical finitely-supported approximations to an element `f` of `lp` converge to it, in the @@ -724,24 +998,24 @@ by linarith [lp.norm_sub_norm_compl_sub_single hp f s] protected lemma has_sum_single [fact (1 ≤ p)] (hp : p ≠ ⊤) (f : lp E p) : has_sum (λ i : α, lp.single p i (f i : E i)) f := begin - have hp₀ : 0 < p := ennreal.zero_lt_one.trans_le (fact.out _), + have hp₀ : 0 < p := zero_lt_one.trans_le (fact.out _), have hp' : 0 < p.to_real := ennreal.to_real_pos hp₀.ne' hp, have := lp.has_sum_norm hp' f, - dsimp [has_sum] at this ⊢, - rw metric.tendsto_nhds at this ⊢, + rw [has_sum, metric.tendsto_nhds] at this ⊢, intros ε hε, refine (this _ (real.rpow_pos_of_pos hε p.to_real)).mono _, intros s hs, rw ← real.rpow_lt_rpow_iff dist_nonneg (le_of_lt hε) hp', rw dist_comm at hs, simp only [dist_eq_norm, real.norm_eq_abs] at hs ⊢, - have H : ∥∑ i in s, lp.single p i (f i : E i) - f∥ ^ p.to_real - = ∥f∥ ^ p.to_real - ∑ i in s, ∥f i∥ ^ p.to_real, - { simpa using lp.norm_compl_sum_single hp' (-f) s }, + have H : ‖∑ i in s, lp.single p i (f i : E i) - f‖ ^ p.to_real + = ‖f‖ ^ p.to_real - ∑ i in s, ‖f i‖ ^ p.to_real, + { simpa only [coe_fn_neg, pi.neg_apply, lp.single_neg, finset.sum_neg_distrib, + neg_sub_neg, norm_neg, _root_.norm_neg] using lp.norm_compl_sum_single hp' (-f) s }, rw ← H at hs, - have : |∥∑ i in s, lp.single p i (f i : E i) - f∥ ^ p.to_real| - = ∥∑ i in s, lp.single p i (f i : E i) - f∥ ^ p.to_real, - { simp [real.abs_rpow_of_nonneg (norm_nonneg _)] }, + have : |‖∑ i in s, lp.single p i (f i : E i) - f‖ ^ p.to_real| + = ‖∑ i in s, lp.single p i (f i : E i) - f‖ ^ p.to_real, + { simp only [real.abs_rpow_of_nonneg (norm_nonneg _), abs_norm] }, linarith end @@ -750,29 +1024,30 @@ end single section topology open filter -open_locale topological_space uniformity +open_locale topology uniformity /-- The coercion from `lp E p` to `Π i, E i` is uniformly continuous. -/ lemma uniform_continuous_coe [_i : fact (1 ≤ p)] : uniform_continuous (coe : lp E p → Π i, E i) := begin - have hp : p ≠ 0 := (ennreal.zero_lt_one.trans_le _i.elim).ne', + have hp : p ≠ 0 := (zero_lt_one.trans_le _i.elim).ne', rw uniform_continuous_pi, intros i, - rw normed_group.uniformity_basis_dist.uniform_continuous_iff normed_group.uniformity_basis_dist, + rw normed_add_comm_group.uniformity_basis_dist.uniform_continuous_iff + normed_add_comm_group.uniformity_basis_dist, intros ε hε, refine ⟨ε, hε, _⟩, - rintros f g (hfg : ∥f - g∥ < ε), - have : ∥f i - g i∥ ≤ ∥f - g∥ := norm_apply_le_norm hp (f - g) i, + rintros f g (hfg : ‖f - g‖ < ε), + have : ‖f i - g i‖ ≤ ‖f - g‖ := norm_apply_le_norm hp (f - g) i, exact this.trans_lt hfg, end variables {ι : Type*} {l : filter ι} [filter.ne_bot l] -lemma norm_apply_le_of_tendsto {C : ℝ} {F : ι → lp E ∞} (hCF : ∀ᶠ k in l, ∥F k∥ ≤ C) +lemma norm_apply_le_of_tendsto {C : ℝ} {F : ι → lp E ∞} (hCF : ∀ᶠ k in l, ‖F k‖ ≤ C) {f : Π a, E a} (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) (a : α) : - ∥f a∥ ≤ C := + ‖f a‖ ≤ C := begin - have : tendsto (λ k, ∥F k a∥) l (𝓝 ∥f a∥) := + have : tendsto (λ k, ‖F k a‖) l (𝓝 ‖f a‖) := (tendsto.comp (continuous_apply a).continuous_at hf).norm, refine le_of_tendsto this (hCF.mono _), intros k hCFk, @@ -783,13 +1058,13 @@ variables [_i : fact (1 ≤ p)] include _i -lemma sum_rpow_le_of_tendsto (hp : p ≠ ∞) {C : ℝ} {F : ι → lp E p} (hCF : ∀ᶠ k in l, ∥F k∥ ≤ C) +lemma sum_rpow_le_of_tendsto (hp : p ≠ ∞) {C : ℝ} {F : ι → lp E p} (hCF : ∀ᶠ k in l, ‖F k‖ ≤ C) {f : Π a, E a} (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) (s : finset α) : - ∑ (i : α) in s, ∥f i∥ ^ p.to_real ≤ C ^ p.to_real := + ∑ (i : α) in s, ‖f i‖ ^ p.to_real ≤ C ^ p.to_real := begin - have hp' : p ≠ 0 := (ennreal.zero_lt_one.trans_le _i.elim).ne', + have hp' : p ≠ 0 := (zero_lt_one.trans_le _i.elim).ne', have hp'' : 0 < p.to_real := ennreal.to_real_pos hp' hp, - let G : (Π a, E a) → ℝ := λ f, ∑ a in s, ∥f a∥ ^ p.to_real, + let G : (Π a, E a) → ℝ := λ f, ∑ a in s, ‖f a‖ ^ p.to_real, have hG : continuous G, { refine continuous_finset_sum s _, intros a ha, @@ -804,16 +1079,16 @@ end /-- "Semicontinuity of the `lp` norm": If all sufficiently large elements of a sequence in `lp E p` have `lp` norm `≤ C`, then the pointwise limit, if it exists, also has `lp` norm `≤ C`. -/ -lemma norm_le_of_tendsto {C : ℝ} {F : ι → lp E p} (hCF : ∀ᶠ k in l, ∥F k∥ ≤ C) {f : lp E p} +lemma norm_le_of_tendsto {C : ℝ} {F : ι → lp E p} (hCF : ∀ᶠ k in l, ‖F k‖ ≤ C) {f : lp E p} (hf : tendsto (id (λ i, F i) : ι → Π a, E a) l (𝓝 f)) : - ∥f∥ ≤ C := + ‖f‖ ≤ C := begin obtain ⟨i, hi⟩ := hCF.exists, have hC : 0 ≤ C := (norm_nonneg _).trans hi, unfreezingI { rcases eq_top_or_lt_top p with rfl | hp }, { apply norm_le_of_forall_le hC, exact norm_apply_le_of_tendsto hCF hf, }, - { have : 0 < p := ennreal.zero_lt_one.trans_le _i.elim, + { have : 0 < p := zero_lt_one.trans_le _i.elim, have hp' : 0 < p.to_real := ennreal.to_real_pos this.ne' hp.ne, apply norm_le_of_forall_sum_le hp' hC, exact sum_rpow_le_of_tendsto hp.ne hCF hf, } @@ -825,7 +1100,7 @@ lemma mem_ℓp_of_tendsto {F : ι → lp E p} (hF : metric.bounded (set.range F) mem_ℓp f p := begin obtain ⟨C, hC, hCF'⟩ := hF.exists_pos_norm_le, - have hCF : ∀ k, ∥F k∥ ≤ C := λ k, hCF' _ ⟨k, rfl⟩, + have hCF : ∀ k, ‖F k‖ ≤ C := λ k, hCF' _ ⟨k, rfl⟩, unfreezingI { rcases eq_top_or_lt_top p with rfl | hp }, { apply mem_ℓp_infty, use C, @@ -843,10 +1118,10 @@ lemma tendsto_lp_of_tendsto_pi {F : ℕ → lp E p} (hF : cauchy_seq F) {f : lp begin rw metric.nhds_basis_closed_ball.tendsto_right_iff, intros ε hε, - have hε' : {p : (lp E p) × (lp E p) | ∥p.1 - p.2∥ < ε} ∈ 𝓤 (lp E p), - { exact normed_group.uniformity_basis_dist.mem_of_mem hε }, + have hε' : {p : (lp E p) × (lp E p) | ‖p.1 - p.2‖ < ε} ∈ 𝓤 (lp E p), + { exact normed_add_comm_group.uniformity_basis_dist.mem_of_mem hε }, refine (hF.eventually_eventually hε').mono _, - rintros n (hn : ∀ᶠ l in at_top, ∥(λ f, F n - f) (F l)∥ < ε), + rintros n (hn : ∀ᶠ l in at_top, ‖(λ f, F n - f) (F l)‖ < ε), refine norm_le_of_tendsto (hn.mono (λ k hk, hk.le)) _, rw tendsto_pi_nhds, intros a, diff --git a/src/analysis/normed_space/matrix_exponential.lean b/src/analysis/normed_space/matrix_exponential.lean index 9426abbcf0608..678d4710a310b 100644 --- a/src/analysis/normed_space/matrix_exponential.lean +++ b/src/analysis/normed_space/matrix_exponential.lean @@ -7,11 +7,16 @@ Authors: Eric Wieser import analysis.normed_space.exponential import analysis.matrix import linear_algebra.matrix.zpow +import linear_algebra.matrix.hermitian +import linear_algebra.matrix.symmetric import topology.uniform_space.matrix /-! # Lemmas about the matrix exponential +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we provide results about `exp` on `matrix`s over a topological or normed algebra. Note that generic results over all topological spaces such as `exp_zero` can be used on matrices without issue, so are not repeated here. The topological results specific to matrices are: @@ -23,10 +28,11 @@ without issue, so are not repeated here. The topological results specific to mat * `matrix.exp_block_diagonal'` Lemmas like `exp_add_of_commute` require a canonical norm on the type; while there are multiple -sensible choices for the norm of a `matrix` (`matrix.normed_group`, `matrix.frobenius_normed_group`, -`matrix.linfty_op_normed_group`), none of them are canonical. In an application where a particular -norm is chosen using `local attribute [instance]`, then the usual lemmas about `exp` are fine. When -choosing a norm is undesirable, the results in this file can be used. +sensible choices for the norm of a `matrix` (`matrix.normed_add_comm_group`, +`matrix.frobenius_normed_add_comm_group`, `matrix.linfty_op_normed_add_comm_group`), none of them +are canonical. In an application where a particular norm is chosen using +`local attribute [instance]`, then the usual lemmas about `exp` are fine. When choosing a norm is +undesirable, the results in this file can be used. In this file, we copy across the lemmas about `exp`, but hide the requirement for a norm inside the proof. @@ -117,6 +123,10 @@ lemma exp_conj_transpose [star_ring 𝔸] [has_continuous_star 𝔸] (A : matrix exp 𝕂 Aᴴ = (exp 𝕂 A)ᴴ := (star_exp A).symm +lemma is_hermitian.exp [star_ring 𝔸] [has_continuous_star 𝔸] {A : matrix m m 𝔸} + (h : A.is_hermitian) : (exp 𝕂 A).is_hermitian := +(exp_conj_transpose _ _).symm.trans $ congr_arg _ h + end ring section comm_ring @@ -126,6 +136,9 @@ variables [fintype m] [decidable_eq m] [field 𝕂] lemma exp_transpose (A : matrix m m 𝔸) : exp 𝕂 Aᵀ = (exp 𝕂 A)ᵀ := by simp_rw [exp_eq_tsum, transpose_tsum, transpose_smul, transpose_pow] +lemma is_symm.exp {A : matrix m m 𝔸} (h : A.is_symm) : (exp 𝕂 A).is_symm := +(exp_transpose _ _).symm.trans $ congr_arg _ h + end comm_ring end topological @@ -148,9 +161,9 @@ begin end lemma exp_sum_of_commute {ι} (s : finset ι) (f : ι → matrix m m 𝔸) - (h : ∀ (i ∈ s) (j ∈ s), commute (f i) (f j)) : + (h : (s : set ι).pairwise $ λ i j, commute (f i) (f j)) : exp 𝕂 (∑ i in s, f i) = s.noncomm_prod (λ i, exp 𝕂 (f i)) - (λ i hi j hj, (h i hi j hj).exp 𝕂) := + (λ i hi j hj _, (h.of_refl hi hj).exp 𝕂) := begin letI : semi_normed_ring (matrix m m 𝔸) := matrix.linfty_op_semi_normed_ring, letI : normed_ring (matrix m m 𝔸) := matrix.linfty_op_normed_ring, diff --git a/src/analysis/normed_space/mazur_ulam.lean b/src/analysis/normed_space/mazur_ulam.lean index 862b9eb614518..4a0ac2d03bf05 100644 --- a/src/analysis/normed_space/mazur_ulam.lean +++ b/src/analysis/normed_space/mazur_ulam.lean @@ -5,20 +5,22 @@ Authors: Yury Kudryashov -/ import topology.instances.real_vector_space import analysis.normed_space.affine_isometry -import linear_algebra.affine_space.midpoint /-! # Mazur-Ulam Theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Mazur-Ulam theorem states that an isometric bijection between two normed affine spaces over `ℝ` is affine. We formalize it in three definitions: -* `isometric.to_real_linear_isometry_equiv_of_map_zero` : given `E ≃ᵢ F` sending `0` to `0`, +* `isometry_equiv.to_real_linear_isometry_equiv_of_map_zero` : given `E ≃ᵢ F` sending `0` to `0`, returns `E ≃ₗᵢ[ℝ] F` with the same `to_fun` and `inv_fun`; -* `isometric.to_real_linear_isometry_equiv` : given `f : E ≃ᵢ F`, returns a linear isometry +* `isometry_equiv.to_real_linear_isometry_equiv` : given `f : E ≃ᵢ F`, returns a linear isometry equivalence `g : E ≃ₗᵢ[ℝ] F` with `g x = f x - f 0`. -* `isometric.to_real_affine_isometry_equiv` : given `f : PE ≃ᵢ PF`, returns an affine isometry - equivalence `g : PE ≃ᵃⁱ[ℝ] PF` whose underlying `isometric` is `f` +* `isometry_equiv.to_real_affine_isometry_equiv` : given `f : PE ≃ᵢ PF`, returns an affine isometry + equivalence `g : PE ≃ᵃⁱ[ℝ] PF` whose underlying `isometry_equiv` is `f` The formalization is based on [Jussi Väisälä, *A Proof of the Mazur-Ulam Theorem*][Vaisala_2003]. @@ -27,15 +29,15 @@ The formalization is based on [Jussi Väisälä, *A Proof of the Mazur-Ulam Theo isometry, affine map, linear map -/ -variables - {E PE : Type*} [normed_group E] [normed_space ℝ E] [metric_space PE] [normed_add_torsor E PE] - {F PF : Type*} [normed_group F] [normed_space ℝ F] [metric_space PF] [normed_add_torsor F PF] +variables {E PE F PF : Type*} [normed_add_comm_group E] [normed_space ℝ E] [metric_space PE] + [normed_add_torsor E PE] [normed_add_comm_group F] [normed_space ℝ F] [metric_space PF] + [normed_add_torsor F PF] open set affine_map affine_isometry_equiv noncomputable theory -namespace isometric +namespace isometry_equiv include E @@ -48,7 +50,7 @@ begin set z := midpoint ℝ x y, -- Consider the set of `e : E ≃ᵢ E` such that `e x = x` and `e y = y` set s := { e : PE ≃ᵢ PE | e x = x ∧ e y = y }, - haveI : nonempty s := ⟨⟨isometric.refl PE, rfl, rfl⟩⟩, + haveI : nonempty s := ⟨⟨isometry_equiv.refl PE, rfl, rfl⟩⟩, -- On the one hand, `e` cannot send the midpoint `z` of `[x, y]` too far have h_bdd : bdd_above (range $ λ e : s, dist (e z) z), { refine ⟨dist x z + dist x z, forall_range_iff.2 $ subtype.forall.2 _⟩, @@ -59,7 +61,7 @@ begin -- On the other hand, consider the map `f : (E ≃ᵢ E) → (E ≃ᵢ E)` -- sending each `e` to `R ∘ e⁻¹ ∘ R ∘ e`, where `R` is the point reflection in the -- midpoint `z` of `[x, y]`. - set R : PE ≃ᵢ PE := (point_reflection ℝ z).to_isometric, + set R : PE ≃ᵢ PE := (point_reflection ℝ z).to_isometry_equiv, set f : (PE ≃ᵢ PE) → (PE ≃ᵢ PE) := λ e, ((e.trans R).trans e.symm).trans R, -- Note that `f` doubles the value of ``dist (e z) z` have hf_dist : ∀ e, dist (f e z) z = 2 * dist (e z) z, @@ -76,7 +78,7 @@ begin have : c ≤ c / 2, { apply csupr_le, rintros ⟨e, he⟩, - simp only [subtype.coe_mk, le_div_iff' (@zero_lt_two ℝ _ _), ← hf_dist], + simp only [subtype.coe_mk, le_div_iff' (zero_lt_two' ℝ), ← hf_dist], exact le_csupr h_bdd ⟨f e, hf_maps_to he⟩ }, replace : c ≤ 0, { linarith }, refine λ e hx hy, dist_le_zero.1 (le_trans _ this), @@ -89,14 +91,14 @@ include F lemma map_midpoint (f : PE ≃ᵢ PF) (x y : PE) : f (midpoint ℝ x y) = midpoint ℝ (f x) (f y) := begin set e : PE ≃ᵢ PE := - ((f.trans $ (point_reflection ℝ $ midpoint ℝ (f x) (f y)).to_isometric).trans f.symm).trans - (point_reflection ℝ $ midpoint ℝ x y).to_isometric, + ((f.trans $ (point_reflection ℝ $ midpoint ℝ (f x) (f y)).to_isometry_equiv).trans f.symm).trans + (point_reflection ℝ $ midpoint ℝ x y).to_isometry_equiv, have hx : e x = x, by simp, have hy : e y = y, by simp, have hm := e.midpoint_fixed hx hy, simp only [e, trans_apply] at hm, - rwa [← eq_symm_apply, to_isometric_symm, point_reflection_symm, coe_to_isometric, - coe_to_isometric, point_reflection_self, symm_apply_eq, point_reflection_fixed_iff] at hm + rwa [← eq_symm_apply, to_isometry_equiv_symm, point_reflection_symm, coe_to_isometry_equiv, + coe_to_isometry_equiv, point_reflection_self, symm_apply_eq, point_reflection_fixed_iff] at hm end /-! @@ -108,7 +110,7 @@ We define a conversion to a `continuous_linear_equiv` first, then a conversion t over `ℝ` and `f 0 = 0`, then `f` is a linear isometry equivalence. -/ def to_real_linear_isometry_equiv_of_map_zero (f : E ≃ᵢ F) (h0 : f 0 = 0) : E ≃ₗᵢ[ℝ] F := -{ norm_map' := λ x, show ∥f x∥ = ∥x∥, by simp only [← dist_zero_right, ← h0, f.dist_eq], +{ norm_map' := λ x, show ‖f x‖ = ‖x‖, by simp only [← dist_zero_right, ← h0, f.dist_eq], .. ((add_monoid_hom.of_map_midpoint ℝ ℝ f h0 f.map_midpoint).to_real_linear_map f.continuous), .. f } @@ -121,7 +123,7 @@ def to_real_linear_isometry_equiv_of_map_zero (f : E ≃ᵢ F) (h0 : f 0 = 0) : /-- **Mazur-Ulam Theorem**: if `f` is an isometric bijection between two normed vector spaces over `ℝ`, then `x ↦ f x - f 0` is a linear isometry equivalence. -/ def to_real_linear_isometry_equiv (f : E ≃ᵢ F) : E ≃ₗᵢ[ℝ] F := -(f.trans (isometric.add_right (f 0)).symm).to_real_linear_isometry_equiv_of_map_zero +(f.trans (isometry_equiv.add_right (f 0)).symm).to_real_linear_isometry_equiv_of_map_zero (by simpa only [sub_eq_add_neg] using sub_self (f 0)) @[simp] lemma to_real_linear_equiv_apply (f : E ≃ᵢ F) (x : E) : @@ -144,7 +146,7 @@ affine_isometry_equiv.mk' f rfl @[simp] lemma coe_to_real_affine_isometry_equiv (f : PE ≃ᵢ PF) : - f.to_real_affine_isometry_equiv.to_isometric = f := + f.to_real_affine_isometry_equiv.to_isometry_equiv = f := by { ext, refl } -end isometric +end isometry_equiv diff --git a/src/analysis/normed_space/multilinear.lean b/src/analysis/normed_space/multilinear.lean index 366cdbac80655..e2db42edbc5b3 100644 --- a/src/analysis/normed_space/multilinear.lean +++ b/src/analysis/normed_space/multilinear.lean @@ -9,8 +9,11 @@ import topology.algebra.module.multilinear /-! # Operator norm on the space of continuous multilinear maps -When `f` is a continuous multilinear map in finitely many variables, we define its norm `∥f∥` as the -smallest number such that `∥f m∥ ≤ ∥f∥ * ∏ i, ∥m i∥` for all `m`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +When `f` is a continuous multilinear map in finitely many variables, we define its norm `‖f‖` as the +smallest number such that `‖f m‖ ≤ ‖f‖ * ∏ i, ‖m i‖` for all `m`. We show that it is indeed a norm, and prove its basic properties. @@ -18,16 +21,16 @@ We show that it is indeed a norm, and prove its basic properties. Let `f` be a multilinear map in finitely many variables. * `exists_bound_of_continuous` asserts that, if `f` is continuous, then there exists `C > 0` - with `∥f m∥ ≤ C * ∏ i, ∥m i∥` for all `m`. + with `‖f m‖ ≤ C * ∏ i, ‖m i‖` for all `m`. * `continuous_of_bound`, conversely, asserts that this bound implies continuity. * `mk_continuous` constructs the associated continuous multilinear map. Let `f` be a continuous multilinear map in finitely many variables. -* `∥f∥` is its norm, i.e., the smallest number such that `∥f m∥ ≤ ∥f∥ * ∏ i, ∥m i∥` for +* `‖f‖` is its norm, i.e., the smallest number such that `‖f m‖ ≤ ‖f‖ * ∏ i, ‖m i‖` for all `m`. -* `le_op_norm f m` asserts the fundamental inequality `∥f m∥ ≤ ∥f∥ * ∏ i, ∥m i∥`. +* `le_op_norm f m` asserts the fundamental inequality `‖f m‖ ≤ ‖f‖ * ∏ i, ‖m i‖`. * `norm_image_sub_le f m₁ m₂` gives a control of the difference `f m₁ - f m₂` in terms of - `∥f∥` and `∥m₁ - m₂∥`. + `‖f‖` and `‖m₁ - m₂‖`. We also register isomorphisms corresponding to currying or uncurrying variables, transforming a continuous multilinear function `f` in `n+1` variables into a continuous linear function taking @@ -54,21 +57,18 @@ approach, it turns out that direct proofs are easier and more efficient. -/ noncomputable theory -open_locale classical big_operators nnreal +open_locale big_operators nnreal open finset metric local attribute [instance, priority 1001] -add_comm_group.to_add_comm_monoid normed_group.to_add_comm_group normed_space.to_module' - --- hack to speed up simp when dealing with complicated types -local attribute [-instance] unique.subsingleton pi.subsingleton +add_comm_group.to_add_comm_monoid normed_add_comm_group.to_add_comm_group normed_space.to_module' /-! ### Type variables We use the following type variables in this file: -* `𝕜` : a `nondiscrete_normed_field`; +* `𝕜` : a `nontrivially_normed_field`; * `ι`, `ι'` : finite index types with decidable equality; * `E`, `E₁` : families of normed vector spaces over `𝕜` indexed by `i : ι`; * `E'` : a family of normed vector spaces over `𝕜` indexed by `i' : ι'`; @@ -80,77 +80,77 @@ universes u v v' wE wE₁ wE' wEi wG wG' variables {𝕜 : Type u} {ι : Type v} {ι' : Type v'} {n : ℕ} {E : ι → Type wE} {E₁ : ι → Type wE₁} {E' : ι' → Type wE'} {Ei : fin n.succ → Type wEi} {G : Type wG} {G' : Type wG'} - [decidable_eq ι] [fintype ι] [decidable_eq ι'] [fintype ι'] [nondiscrete_normed_field 𝕜] - [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)] - [Π i, normed_group (E₁ i)] [Π i, normed_space 𝕜 (E₁ i)] - [Π i, normed_group (E' i)] [Π i, normed_space 𝕜 (E' i)] - [Π i, normed_group (Ei i)] [Π i, normed_space 𝕜 (Ei i)] - [normed_group G] [normed_space 𝕜 G] [normed_group G'] [normed_space 𝕜 G'] + [fintype ι] [fintype ι'] [nontrivially_normed_field 𝕜] + [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] + [Π i, normed_add_comm_group (E₁ i)] [Π i, normed_space 𝕜 (E₁ i)] + [Π i, normed_add_comm_group (E' i)] [Π i, normed_space 𝕜 (E' i)] + [Π i, normed_add_comm_group (Ei i)] [Π i, normed_space 𝕜 (Ei i)] + [normed_add_comm_group G] [normed_space 𝕜 G] [normed_add_comm_group G'] [normed_space 𝕜 G'] /-! ### Continuity properties of multilinear maps -We relate continuity of multilinear maps to the inequality `∥f m∥ ≤ C * ∏ i, ∥m i∥`, in -both directions. Along the way, we prove useful bounds on the difference `∥f m₁ - f m₂∥`. +We relate continuity of multilinear maps to the inequality `‖f m‖ ≤ C * ∏ i, ‖m i‖`, in +both directions. Along the way, we prove useful bounds on the difference `‖f m₁ - f m₂‖`. -/ namespace multilinear_map variable (f : multilinear_map 𝕜 E G) /-- If a multilinear map in finitely many variables on normed spaces satisfies the inequality -`∥f m∥ ≤ C * ∏ i, ∥m i∥` on a shell `ε i / ∥c i∥ < ∥m i∥ < ε i` for some positive numbers `ε i` -and elements `c i : 𝕜`, `1 < ∥c i∥`, then it satisfies this inequality for all `m`. -/ -lemma bound_of_shell {ε : ι → ℝ} {C : ℝ} (hε : ∀ i, 0 < ε i) {c : ι → 𝕜} (hc : ∀ i, 1 < ∥c i∥) - (hf : ∀ m : Π i, E i, (∀ i, ε i / ∥c i∥ ≤ ∥m i∥) → (∀ i, ∥m i∥ < ε i) → ∥f m∥ ≤ C * ∏ i, ∥m i∥) - (m : Π i, E i) : ∥f m∥ ≤ C * ∏ i, ∥m i∥ := +`‖f m‖ ≤ C * ∏ i, ‖m i‖` on a shell `ε i / ‖c i‖ < ‖m i‖ < ε i` for some positive numbers `ε i` +and elements `c i : 𝕜`, `1 < ‖c i‖`, then it satisfies this inequality for all `m`. -/ +lemma bound_of_shell {ε : ι → ℝ} {C : ℝ} (hε : ∀ i, 0 < ε i) {c : ι → 𝕜} (hc : ∀ i, 1 < ‖c i‖) + (hf : ∀ m : Π i, E i, (∀ i, ε i / ‖c i‖ ≤ ‖m i‖) → (∀ i, ‖m i‖ < ε i) → ‖f m‖ ≤ C * ∏ i, ‖m i‖) + (m : Π i, E i) : ‖f m‖ ≤ C * ∏ i, ‖m i‖ := begin rcases em (∃ i, m i = 0) with ⟨i, hi⟩|hm; [skip, push_neg at hm], { simp [f.map_coord_zero i hi, prod_eq_zero (mem_univ i), hi] }, choose δ hδ0 hδm_lt hle_δm hδinv using λ i, rescale_to_shell (hc i) (hε i) (hm i), - have hδ0 : 0 < ∏ i, ∥δ i∥, from prod_pos (λ i _, norm_pos_iff.2 (hδ0 i)), + have hδ0 : 0 < ∏ i, ‖δ i‖, from prod_pos (λ i _, norm_pos_iff.2 (hδ0 i)), simpa [map_smul_univ, norm_smul, prod_mul_distrib, mul_left_comm C, mul_le_mul_left hδ0] using hf (λ i, δ i • m i) hle_δm hδm_lt, end /-- If a multilinear map in finitely many variables on normed spaces is continuous, then it -satisfies the inequality `∥f m∥ ≤ C * ∏ i, ∥m i∥`, for some `C` which can be chosen to be +satisfies the inequality `‖f m‖ ≤ C * ∏ i, ‖m i‖`, for some `C` which can be chosen to be positive. -/ theorem exists_bound_of_continuous (hf : continuous f) : - ∃ (C : ℝ), 0 < C ∧ (∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) := + ∃ (C : ℝ), 0 < C ∧ (∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) := begin casesI is_empty_or_nonempty ι, - { refine ⟨∥f 0∥ + 1, add_pos_of_nonneg_of_pos (norm_nonneg _) zero_lt_one, λ m, _⟩, + { refine ⟨‖f 0‖ + 1, add_pos_of_nonneg_of_pos (norm_nonneg _) zero_lt_one, λ m, _⟩, obtain rfl : m = 0, from funext (is_empty.elim ‹_›), simp [univ_eq_empty, zero_le_one] }, - obtain ⟨ε : ℝ, ε0 : 0 < ε, hε : ∀ m : Π i, E i, ∥m - 0∥ < ε → ∥f m - f 0∥ < 1⟩ := - normed_group.tendsto_nhds_nhds.1 (hf.tendsto 0) 1 zero_lt_one, + obtain ⟨ε : ℝ, ε0 : 0 < ε, hε : ∀ m : Π i, E i, ‖m - 0‖ < ε → ‖f m - f 0‖ < 1⟩ := + normed_add_comm_group.tendsto_nhds_nhds.1 (hf.tendsto 0) 1 zero_lt_one, simp only [sub_zero, f.map_zero] at hε, rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, - have : 0 < (∥c∥ / ε) ^ fintype.card ι, from pow_pos (div_pos (zero_lt_one.trans hc) ε0) _, + have : 0 < (‖c‖ / ε) ^ fintype.card ι, from pow_pos (div_pos (zero_lt_one.trans hc) ε0) _, refine ⟨_, this, _⟩, refine f.bound_of_shell (λ _, ε0) (λ _, hc) (λ m hcm hm, _), refine (hε m ((pi_norm_lt_iff ε0).2 hm)).le.trans _, - rw [← div_le_iff' this, one_div, ← inv_pow₀, inv_div, fintype.card, ← prod_const], + rw [← div_le_iff' this, one_div, ← inv_pow, inv_div, fintype.card, ← prod_const], exact prod_le_prod (λ _ _, div_nonneg ε0.le (norm_nonneg _)) (λ i _, hcm i) end /-- If `f` satisfies a boundedness property around `0`, one can deduce a bound on `f m₁ - f m₂` using the multilinearity. Here, we give a precise but hard to use version. See `norm_image_sub_le_of_bound` for a less precise but more usable version. The bound reads -`∥f m - f m'∥ ≤ - C * ∥m 1 - m' 1∥ * max ∥m 2∥ ∥m' 2∥ * max ∥m 3∥ ∥m' 3∥ * ... * max ∥m n∥ ∥m' n∥ + ...`, +`‖f m - f m'‖ ≤ + C * ‖m 1 - m' 1‖ * max ‖m 2‖ ‖m' 2‖ * max ‖m 3‖ ‖m' 3‖ * ... * max ‖m n‖ ‖m' n‖ + ...`, where the other terms in the sum are the same products where `1` is replaced by any `i`. -/ -lemma norm_image_sub_le_of_bound' {C : ℝ} (hC : 0 ≤ C) - (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) (m₁ m₂ : Πi, E i) : - ∥f m₁ - f m₂∥ ≤ - C * ∑ i, ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥ := +lemma norm_image_sub_le_of_bound' [decidable_eq ι] {C : ℝ} (hC : 0 ≤ C) + (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) (m₁ m₂ : Πi, E i) : + ‖f m₁ - f m₂‖ ≤ + C * ∑ i, ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖ := begin - have A : ∀(s : finset ι), ∥f m₁ - f (s.piecewise m₂ m₁)∥ - ≤ C * ∑ i in s, ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥, + have A : ∀(s : finset ι), ‖f m₁ - f (s.piecewise m₂ m₁)‖ + ≤ C * ∑ i in s, ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖, { refine finset.induction (by simp) _, assume i s his Hrec, - have I : ∥f (s.piecewise m₂ m₁) - f ((insert i s).piecewise m₂ m₁)∥ - ≤ C * ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥, + have I : ‖f (s.piecewise m₂ m₁) - f ((insert i s).piecewise m₂ m₁)‖ + ≤ C * ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖, { have A : ((insert i s).piecewise m₂ m₁) = function.update (s.piecewise m₂ m₁) i (m₂ i) := s.piecewise_insert _ _ _, have B : s.piecewise m₂ m₁ = function.update (s.piecewise m₂ m₁) i (m₁ i), @@ -165,13 +165,13 @@ begin { rw h, simp }, { by_cases h' : j ∈ s; simp [h', h, le_refl] } }, - calc ∥f m₁ - f ((insert i s).piecewise m₂ m₁)∥ ≤ - ∥f m₁ - f (s.piecewise m₂ m₁)∥ + ∥f (s.piecewise m₂ m₁) - f ((insert i s).piecewise m₂ m₁)∥ : + calc ‖f m₁ - f ((insert i s).piecewise m₂ m₁)‖ ≤ + ‖f m₁ - f (s.piecewise m₂ m₁)‖ + ‖f (s.piecewise m₂ m₁) - f ((insert i s).piecewise m₂ m₁)‖ : by { rw [← dist_eq_norm, ← dist_eq_norm, ← dist_eq_norm], exact dist_triangle _ _ _ } - ... ≤ (C * ∑ i in s, ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥) - + C * ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥ : + ... ≤ (C * ∑ i in s, ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖) + + C * ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖ : add_le_add Hrec I - ... = C * ∑ i in insert i s, ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥ : + ... = C * ∑ i in insert i s, ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖ : by simp [his, add_comm, left_distrib] }, convert A univ, simp @@ -180,16 +180,17 @@ end /-- If `f` satisfies a boundedness property around `0`, one can deduce a bound on `f m₁ - f m₂` using the multilinearity. Here, we give a usable but not very precise version. See `norm_image_sub_le_of_bound'` for a more precise but less usable version. The bound is -`∥f m - f m'∥ ≤ C * card ι * ∥m - m'∥ * (max ∥m∥ ∥m'∥) ^ (card ι - 1)`. -/ +`‖f m - f m'‖ ≤ C * card ι * ‖m - m'‖ * (max ‖m‖ ‖m'‖) ^ (card ι - 1)`. -/ lemma norm_image_sub_le_of_bound {C : ℝ} (hC : 0 ≤ C) - (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) (m₁ m₂ : Πi, E i) : - ∥f m₁ - f m₂∥ ≤ C * (fintype.card ι) * (max ∥m₁∥ ∥m₂∥) ^ (fintype.card ι - 1) * ∥m₁ - m₂∥ := + (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) (m₁ m₂ : Πi, E i) : + ‖f m₁ - f m₂‖ ≤ C * (fintype.card ι) * (max ‖m₁‖ ‖m₂‖) ^ (fintype.card ι - 1) * ‖m₁ - m₂‖ := begin - have A : ∀ (i : ι), ∏ j, (if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥) - ≤ ∥m₁ - m₂∥ * (max ∥m₁∥ ∥m₂∥) ^ (fintype.card ι - 1), + letI := classical.dec_eq ι, + have A : ∀ (i : ι), ∏ j, (if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖) + ≤ ‖m₁ - m₂‖ * (max ‖m₁‖ ‖m₂‖) ^ (fintype.card ι - 1), { assume i, - calc ∏ j, (if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥) - ≤ ∏ j : ι, function.update (λ j, max ∥m₁∥ ∥m₂∥) i (∥m₁ - m₂∥) j : + calc ∏ j, (if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖) + ≤ ∏ j : ι, function.update (λ j, max ‖m₁‖ ‖m₂‖) i (‖m₁ - m₂‖) j : begin apply prod_le_prod, { assume j hj, by_cases h : j = i; simp [h, norm_nonneg] }, @@ -198,68 +199,68 @@ begin { rw h, simp, exact norm_le_pi_norm (m₁ - m₂) i }, { simp [h, max_le_max, norm_le_pi_norm (_ : Π i, E i)] } } end - ... = ∥m₁ - m₂∥ * (max ∥m₁∥ ∥m₂∥) ^ (fintype.card ι - 1) : + ... = ‖m₁ - m₂‖ * (max ‖m₁‖ ‖m₂‖) ^ (fintype.card ι - 1) : by { rw prod_update_of_mem (finset.mem_univ _), simp [card_univ_diff] } }, calc - ∥f m₁ - f m₂∥ - ≤ C * ∑ i, ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥ : + ‖f m₁ - f m₂‖ + ≤ C * ∑ i, ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖ : f.norm_image_sub_le_of_bound' hC H m₁ m₂ - ... ≤ C * ∑ i, ∥m₁ - m₂∥ * (max ∥m₁∥ ∥m₂∥) ^ (fintype.card ι - 1) : + ... ≤ C * ∑ i, ‖m₁ - m₂‖ * (max ‖m₁‖ ‖m₂‖) ^ (fintype.card ι - 1) : mul_le_mul_of_nonneg_left (sum_le_sum (λi hi, A i)) hC - ... = C * (fintype.card ι) * (max ∥m₁∥ ∥m₂∥) ^ (fintype.card ι - 1) * ∥m₁ - m₂∥ : + ... = C * (fintype.card ι) * (max ‖m₁‖ ‖m₂‖) ^ (fintype.card ι - 1) * ‖m₁ - m₂‖ : by { rw [sum_const, card_univ, nsmul_eq_mul], ring } end -/-- If a multilinear map satisfies an inequality `∥f m∥ ≤ C * ∏ i, ∥m i∥`, then it is +/-- If a multilinear map satisfies an inequality `‖f m‖ ≤ C * ∏ i, ‖m i‖`, then it is continuous. -/ -theorem continuous_of_bound (C : ℝ) (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) : +theorem continuous_of_bound (C : ℝ) (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) : continuous f := begin let D := max C 1, have D_pos : 0 ≤ D := le_trans zero_le_one (le_max_right _ _), - replace H : ∀ m, ∥f m∥ ≤ D * ∏ i, ∥m i∥, + replace H : ∀ m, ‖f m‖ ≤ D * ∏ i, ‖m i‖, { assume m, apply le_trans (H m) (mul_le_mul_of_nonneg_right (le_max_left _ _) _), exact prod_nonneg (λ(i : ι) hi, norm_nonneg (m i)) }, refine continuous_iff_continuous_at.2 (λm, _), refine continuous_at_of_locally_lipschitz zero_lt_one - (D * (fintype.card ι) * (∥m∥ + 1) ^ (fintype.card ι - 1)) (λm' h', _), + (D * (fintype.card ι) * (‖m‖ + 1) ^ (fintype.card ι - 1)) (λm' h', _), rw [dist_eq_norm, dist_eq_norm], - have : 0 ≤ (max ∥m'∥ ∥m∥), by simp, - have : (max ∥m'∥ ∥m∥) ≤ ∥m∥ + 1, + have : 0 ≤ (max ‖m'‖ ‖m‖), by simp, + have : (max ‖m'‖ ‖m‖) ≤ ‖m‖ + 1, by simp [zero_le_one, norm_le_of_mem_closed_ball (le_of_lt h'), -add_comm], calc - ∥f m' - f m∥ - ≤ D * (fintype.card ι) * (max ∥m'∥ ∥m∥) ^ (fintype.card ι - 1) * ∥m' - m∥ : + ‖f m' - f m‖ + ≤ D * (fintype.card ι) * (max ‖m'‖ ‖m‖) ^ (fintype.card ι - 1) * ‖m' - m‖ : f.norm_image_sub_le_of_bound D_pos H m' m - ... ≤ D * (fintype.card ι) * (∥m∥ + 1) ^ (fintype.card ι - 1) * ∥m' - m∥ : + ... ≤ D * (fintype.card ι) * (‖m‖ + 1) ^ (fintype.card ι - 1) * ‖m' - m‖ : by apply_rules [mul_le_mul_of_nonneg_right, mul_le_mul_of_nonneg_left, mul_nonneg, norm_nonneg, nat.cast_nonneg, pow_le_pow_of_le_left] end /-- Constructing a continuous multilinear map from a multilinear map satisfying a boundedness condition. -/ -def mk_continuous (C : ℝ) (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) : +def mk_continuous (C : ℝ) (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) : continuous_multilinear_map 𝕜 E G := { cont := f.continuous_of_bound C H, ..f } -@[simp] lemma coe_mk_continuous (C : ℝ) (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) : +@[simp] lemma coe_mk_continuous (C : ℝ) (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) : ⇑(f.mk_continuous C H) = f := rfl /-- Given a multilinear map in `n` variables, if one restricts it to `k` variables putting `z` on the other coordinates, then the resulting restricted function satisfies an inequality -`∥f.restr v∥ ≤ C * ∥z∥^(n-k) * Π ∥v i∥` if the original function satisfies `∥f v∥ ≤ C * Π ∥v i∥`. -/ +`‖f.restr v‖ ≤ C * ‖z‖^(n-k) * Π ‖v i‖` if the original function satisfies `‖f v‖ ≤ C * Π ‖v i‖`. -/ lemma restr_norm_le {k n : ℕ} (f : (multilinear_map 𝕜 (λ i : fin n, G) G' : _)) (s : finset (fin n)) (hk : s.card = k) (z : G) {C : ℝ} - (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) (v : fin k → G) : - ∥f.restr s hk z v∥ ≤ C * ∥z∥ ^ (n - k) * ∏ i, ∥v i∥ := + (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) (v : fin k → G) : + ‖f.restr s hk z v‖ ≤ C * ‖z‖ ^ (n - k) * ∏ i, ‖v i‖ := begin rw [mul_right_comm, mul_assoc], convert H _ using 2, - simp only [apply_dite norm, fintype.prod_dite, prod_const (∥z∥), finset.card_univ, + simp only [apply_dite norm, fintype.prod_dite, prod_const (‖z‖), finset.card_univ, fintype.card_of_subtype sᶜ (λ x, mem_compl), card_compl, fintype.card_fin, hk, mk_coe, - ← (s.order_iso_of_fin hk).symm.bijective.prod_comp (λ x, ∥v x∥)], + ← (s.order_iso_of_fin hk).symm.bijective.prod_comp (λ x, ‖v x‖)], refl end @@ -268,21 +269,21 @@ end multilinear_map /-! ### Continuous multilinear maps -We define the norm `∥f∥` of a continuous multilinear map `f` in finitely many variables as the -smallest number such that `∥f m∥ ≤ ∥f∥ * ∏ i, ∥m i∥` for all `m`. We show that this +We define the norm `‖f‖` of a continuous multilinear map `f` in finitely many variables as the +smallest number such that `‖f m‖ ≤ ‖f‖ * ∏ i, ‖m i‖` for all `m`. We show that this defines a normed space structure on `continuous_multilinear_map 𝕜 E G`. -/ namespace continuous_multilinear_map variables (c : 𝕜) (f g : continuous_multilinear_map 𝕜 E G) (m : Πi, E i) -theorem bound : ∃ (C : ℝ), 0 < C ∧ (∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) := +theorem bound : ∃ (C : ℝ), 0 < C ∧ (∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) := f.to_multilinear_map.exists_bound_of_continuous f.2 open real /-- The operator norm of a continuous multilinear map is the inf of all its bounds. -/ -def op_norm := Inf {c | 0 ≤ (c : ℝ) ∧ ∀ m, ∥f m∥ ≤ c * ∏ i, ∥m i∥} +def op_norm := Inf {c | 0 ≤ (c : ℝ) ∧ ∀ m, ‖f m‖ ≤ c * ∏ i, ‖m i‖} instance has_op_norm : has_norm (continuous_multilinear_map 𝕜 E G) := ⟨op_norm⟩ /-- An alias of `continuous_multilinear_map.has_op_norm` with non-dependent types to help typeclass @@ -290,26 +291,26 @@ search. -/ instance has_op_norm' : has_norm (continuous_multilinear_map 𝕜 (λ (i : ι), G) G') := continuous_multilinear_map.has_op_norm -lemma norm_def : ∥f∥ = Inf {c | 0 ≤ (c : ℝ) ∧ ∀ m, ∥f m∥ ≤ c * ∏ i, ∥m i∥} := rfl +lemma norm_def : ‖f‖ = Inf {c | 0 ≤ (c : ℝ) ∧ ∀ m, ‖f m‖ ≤ c * ∏ i, ‖m i‖} := rfl -- So that invocations of `le_cInf` make sense: we show that the set of -- bounds is nonempty and bounded below. lemma bounds_nonempty {f : continuous_multilinear_map 𝕜 E G} : - ∃ c, c ∈ {c | 0 ≤ c ∧ ∀ m, ∥f m∥ ≤ c * ∏ i, ∥m i∥} := + ∃ c, c ∈ {c | 0 ≤ c ∧ ∀ m, ‖f m‖ ≤ c * ∏ i, ‖m i‖} := let ⟨M, hMp, hMb⟩ := f.bound in ⟨M, le_of_lt hMp, hMb⟩ lemma bounds_bdd_below {f : continuous_multilinear_map 𝕜 E G} : - bdd_below {c | 0 ≤ c ∧ ∀ m, ∥f m∥ ≤ c * ∏ i, ∥m i∥} := + bdd_below {c | 0 ≤ c ∧ ∀ m, ‖f m‖ ≤ c * ∏ i, ‖m i‖} := ⟨0, λ _ ⟨hn, _⟩, hn⟩ -lemma op_norm_nonneg : 0 ≤ ∥f∥ := +lemma op_norm_nonneg : 0 ≤ ‖f‖ := le_cInf bounds_nonempty (λ _ ⟨hx, _⟩, hx) /-- The fundamental property of the operator norm of a continuous multilinear map: -`∥f m∥` is bounded by `∥f∥` times the product of the `∥m i∥`. -/ -theorem le_op_norm : ∥f m∥ ≤ ∥f∥ * ∏ i, ∥m i∥ := +`‖f m‖` is bounded by `‖f‖` times the product of the `‖m i‖`. -/ +theorem le_op_norm : ‖f m‖ ≤ ‖f‖ * ∏ i, ‖m i‖ := begin - have A : 0 ≤ ∏ i, ∥m i∥ := prod_nonneg (λj hj, norm_nonneg _), + have A : 0 ≤ ∏ i, ‖m i‖ := prod_nonneg (λj hj, norm_nonneg _), cases A.eq_or_lt with h hlt, { rcases prod_eq_zero_iff.1 h.symm with ⟨i, _, hi⟩, rw norm_eq_zero at hi, @@ -321,48 +322,43 @@ begin rintro c ⟨_, hc⟩, rw [div_le_iff hlt], apply hc } end -theorem le_of_op_norm_le {C : ℝ} (h : ∥f∥ ≤ C) : ∥f m∥ ≤ C * ∏ i, ∥m i∥ := +theorem le_of_op_norm_le {C : ℝ} (h : ‖f‖ ≤ C) : ‖f m‖ ≤ C * ∏ i, ‖m i‖ := (f.le_op_norm m).trans $ mul_le_mul_of_nonneg_right h (prod_nonneg $ λ i _, norm_nonneg (m i)) -lemma ratio_le_op_norm : ∥f m∥ / ∏ i, ∥m i∥ ≤ ∥f∥ := +lemma ratio_le_op_norm : ‖f m‖ / ∏ i, ‖m i‖ ≤ ‖f‖ := div_le_of_nonneg_of_le_mul (prod_nonneg $ λ i _, norm_nonneg _) (op_norm_nonneg _) (f.le_op_norm m) /-- The image of the unit ball under a continuous multilinear map is bounded. -/ -lemma unit_le_op_norm (h : ∥m∥ ≤ 1) : ∥f m∥ ≤ ∥f∥ := +lemma unit_le_op_norm (h : ‖m‖ ≤ 1) : ‖f m‖ ≤ ‖f‖ := calc - ∥f m∥ ≤ ∥f∥ * ∏ i, ∥m i∥ : f.le_op_norm m - ... ≤ ∥f∥ * ∏ i : ι, 1 : + ‖f m‖ ≤ ‖f‖ * ∏ i, ‖m i‖ : f.le_op_norm m + ... ≤ ‖f‖ * ∏ i : ι, 1 : mul_le_mul_of_nonneg_left (prod_le_prod (λi hi, norm_nonneg _) (λi hi, le_trans (norm_le_pi_norm (_ : Π i, E i) _) h)) (op_norm_nonneg f) - ... = ∥f∥ : by simp + ... = ‖f‖ : by simp /-- If one controls the norm of every `f x`, then one controls the norm of `f`. -/ -lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ m, ∥f m∥ ≤ M * ∏ i, ∥m i∥) : - ∥f∥ ≤ M := +lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ m, ‖f m‖ ≤ M * ∏ i, ‖m i‖) : + ‖f‖ ≤ M := cInf_le bounds_bdd_below ⟨hMp, hM⟩ /-- The operator norm satisfies the triangle inequality. -/ -theorem op_norm_add_le : ∥f + g∥ ≤ ∥f∥ + ∥g∥ := +theorem op_norm_add_le : ‖f + g‖ ≤ ‖f‖ + ‖g‖ := cInf_le bounds_bdd_below ⟨add_nonneg (op_norm_nonneg _) (op_norm_nonneg _), λ x, by { rw add_mul, exact norm_add_le_of_le (le_op_norm _ _) (le_op_norm _ _) }⟩ +lemma op_norm_zero : ‖(0 : continuous_multilinear_map 𝕜 E G)‖ = 0 := +(op_norm_nonneg _).antisymm' $ op_norm_le_bound 0 le_rfl $ λ m, by simp + /-- A continuous linear map is zero iff its norm vanishes. -/ -theorem op_norm_zero_iff : ∥f∥ = 0 ↔ f = 0 := -begin - split, - { assume h, - ext m, - simpa [h] using f.le_op_norm m }, - { rintro rfl, - apply le_antisymm (op_norm_le_bound 0 le_rfl (λm, _)) (op_norm_nonneg _), - simp } -end +theorem op_norm_zero_iff : ‖f‖ = 0 ↔ f = 0 := +⟨λ h, by { ext m, simpa [h] using f.le_op_norm m }, by { rintro rfl, exact op_norm_zero }⟩ section variables {𝕜' : Type*} [normed_field 𝕜'] [normed_space 𝕜' G] [smul_comm_class 𝕜 𝕜' G] -lemma op_norm_smul_le (c : 𝕜') : ∥c • f∥ ≤ ∥c∥ * ∥f∥ := +lemma op_norm_smul_le (c : 𝕜') : ‖c • f‖ ≤ ‖c‖ * ‖f‖ := (c • f).op_norm_le_bound (mul_nonneg (norm_nonneg _) (op_norm_nonneg _)) begin @@ -371,17 +367,23 @@ lemma op_norm_smul_le (c : 𝕜') : ∥c • f∥ ≤ ∥c∥ * ∥f∥ := exact mul_le_mul_of_nonneg_left (le_op_norm _ _) (norm_nonneg _) end -lemma op_norm_neg : ∥-f∥ = ∥f∥ := by { rw norm_def, apply congr_arg, ext, simp } +lemma op_norm_neg : ‖-f‖ = ‖f‖ := by { rw norm_def, apply congr_arg, ext, simp } /-- Continuous multilinear maps themselves form a normed space with respect to the operator norm. -/ -instance normed_group : normed_group (continuous_multilinear_map 𝕜 E G) := -normed_group.of_core _ ⟨op_norm_zero_iff, op_norm_add_le, op_norm_neg⟩ - -/-- An alias of `continuous_multilinear_map.normed_group` with non-dependent types to help typeclass -search. -/ -instance normed_group' : normed_group (continuous_multilinear_map 𝕜 (λ i : ι, G) G') := -continuous_multilinear_map.normed_group +instance normed_add_comm_group : normed_add_comm_group (continuous_multilinear_map 𝕜 E G) := +add_group_norm.to_normed_add_comm_group +{ to_fun := norm, + map_zero' := op_norm_zero, + neg' := op_norm_neg, + add_le' := op_norm_add_le, + eq_zero_of_map_eq_zero' := λ f, f.op_norm_zero_iff.1 } + +/-- An alias of `continuous_multilinear_map.normed_add_comm_group` with non-dependent types to help +typeclass search. -/ +instance normed_add_comm_group' : + normed_add_comm_group (continuous_multilinear_map 𝕜 (λ i : ι, G) G') := +continuous_multilinear_map.normed_add_comm_group instance normed_space : normed_space 𝕜' (continuous_multilinear_map 𝕜 E G) := ⟨λ c f, f.op_norm_smul_le c⟩ @@ -391,56 +393,95 @@ search. -/ instance normed_space' : normed_space 𝕜' (continuous_multilinear_map 𝕜 (λ i : ι, G') G) := continuous_multilinear_map.normed_space -theorem le_op_norm_mul_prod_of_le {b : ι → ℝ} (hm : ∀ i, ∥m i∥ ≤ b i) : ∥f m∥ ≤ ∥f∥ * ∏ i, b i := +theorem le_op_norm_mul_prod_of_le {b : ι → ℝ} (hm : ∀ i, ‖m i‖ ≤ b i) : ‖f m‖ ≤ ‖f‖ * ∏ i, b i := (f.le_op_norm m).trans $ mul_le_mul_of_nonneg_left (prod_le_prod (λ _ _, norm_nonneg _) (λ i _, hm i)) (norm_nonneg f) -theorem le_op_norm_mul_pow_card_of_le {b : ℝ} (hm : ∀ i, ∥m i∥ ≤ b) : - ∥f m∥ ≤ ∥f∥ * b ^ fintype.card ι := +theorem le_op_norm_mul_pow_card_of_le {b : ℝ} (hm : ∀ i, ‖m i‖ ≤ b) : + ‖f m‖ ≤ ‖f‖ * b ^ fintype.card ι := by simpa only [prod_const] using f.le_op_norm_mul_prod_of_le m hm -theorem le_op_norm_mul_pow_of_le {Ei : fin n → Type*} [Π i, normed_group (Ei i)] +theorem le_op_norm_mul_pow_of_le {Ei : fin n → Type*} [Π i, normed_add_comm_group (Ei i)] [Π i, normed_space 𝕜 (Ei i)] (f : continuous_multilinear_map 𝕜 Ei G) (m : Π i, Ei i) - {b : ℝ} (hm : ∥m∥ ≤ b) : - ∥f m∥ ≤ ∥f∥ * b ^ n := + {b : ℝ} (hm : ‖m‖ ≤ b) : + ‖f m‖ ≤ ‖f‖ * b ^ n := by simpa only [fintype.card_fin] using f.le_op_norm_mul_pow_card_of_le m (λ i, (norm_le_pi_norm m i).trans hm) /-- The fundamental property of the operator norm of a continuous multilinear map: -`∥f m∥` is bounded by `∥f∥` times the product of the `∥m i∥`, `nnnorm` version. -/ -theorem le_op_nnnorm : ∥f m∥₊ ≤ ∥f∥₊ * ∏ i, ∥m i∥₊ := +`‖f m‖` is bounded by `‖f‖` times the product of the `‖m i‖`, `nnnorm` version. -/ +theorem le_op_nnnorm : ‖f m‖₊ ≤ ‖f‖₊ * ∏ i, ‖m i‖₊ := nnreal.coe_le_coe.1 $ by { push_cast, exact f.le_op_norm m } -theorem le_of_op_nnnorm_le {C : ℝ≥0} (h : ∥f∥₊ ≤ C) : ∥f m∥₊ ≤ C * ∏ i, ∥m i∥₊ := +theorem le_of_op_nnnorm_le {C : ℝ≥0} (h : ‖f‖₊ ≤ C) : ‖f m‖₊ ≤ C * ∏ i, ‖m i‖₊ := (f.le_op_nnnorm m).trans $ mul_le_mul' h le_rfl lemma op_norm_prod (f : continuous_multilinear_map 𝕜 E G) (g : continuous_multilinear_map 𝕜 E G') : - ∥f.prod g∥ = max (∥f∥) (∥g∥) := + ‖f.prod g‖ = max (‖f‖) (‖g‖) := le_antisymm (op_norm_le_bound _ (norm_nonneg (f, g)) (λ m, - have H : 0 ≤ ∏ i, ∥m i∥, from prod_nonneg $ λ _ _, norm_nonneg _, + have H : 0 ≤ ∏ i, ‖m i‖, from prod_nonneg $ λ _ _, norm_nonneg _, by simpa only [prod_apply, prod.norm_def, max_mul_of_nonneg, H] using max_le_max (f.le_op_norm m) (g.le_op_norm m))) $ max_le (f.op_norm_le_bound (norm_nonneg _) $ λ m, (le_max_left _ _).trans ((f.prod g).le_op_norm _)) (g.op_norm_le_bound (norm_nonneg _) $ λ m, (le_max_right _ _).trans ((f.prod g).le_op_norm _)) -lemma norm_pi {ι' : Type v'} [fintype ι'] {E' : ι' → Type wE'} [Π i', normed_group (E' i')] +lemma norm_pi {ι' : Type v'} [fintype ι'] {E' : ι' → Type wE'} [Π i', normed_add_comm_group (E' i')] [Π i', normed_space 𝕜 (E' i')] (f : Π i', continuous_multilinear_map 𝕜 E (E' i')) : - ∥pi f∥ = ∥f∥ := + ‖pi f‖ = ‖f‖ := begin apply le_antisymm, { refine (op_norm_le_bound _ (norm_nonneg f) (λ m, _)), dsimp, - rw pi_norm_le_iff, + rw pi_norm_le_iff_of_nonneg, exacts [λ i, (f i).le_of_op_norm_le m (norm_le_pi_norm f i), mul_nonneg (norm_nonneg f) (prod_nonneg $ λ _ _, norm_nonneg _)] }, - { refine (pi_norm_le_iff (norm_nonneg _)).2 (λ i, _), + { refine (pi_norm_le_iff_of_nonneg (norm_nonneg _)).2 (λ i, _), refine (op_norm_le_bound _ (norm_nonneg _) (λ m, _)), refine le_trans _ ((pi f).le_op_norm m), convert norm_le_pi_norm (λ j, f j m) i } end +section +variables (𝕜 G) + +lemma norm_of_subsingleton_le [subsingleton ι] (i' : ι) : ‖of_subsingleton 𝕜 G i'‖ ≤ 1 := +op_norm_le_bound _ zero_le_one $ λ m, + by rw [fintype.prod_subsingleton _ i', one_mul, of_subsingleton_apply] + +@[simp] lemma norm_of_subsingleton [subsingleton ι] [nontrivial G] (i' : ι) : + ‖of_subsingleton 𝕜 G i'‖ = 1 := +begin + apply le_antisymm (norm_of_subsingleton_le 𝕜 G i'), + obtain ⟨g, hg⟩ := exists_ne (0 : G), + rw ←norm_ne_zero_iff at hg, + have := (of_subsingleton 𝕜 G i').ratio_le_op_norm (λ _, g), + rwa [fintype.prod_subsingleton _ i', of_subsingleton_apply, div_self hg] at this, +end + +lemma nnnorm_of_subsingleton_le [subsingleton ι] (i' : ι) : ‖of_subsingleton 𝕜 G i'‖₊ ≤ 1 := +norm_of_subsingleton_le _ _ _ + +@[simp] lemma nnnorm_of_subsingleton [subsingleton ι] [nontrivial G] (i' : ι) : + ‖of_subsingleton 𝕜 G i'‖₊ = 1 := +nnreal.eq $ norm_of_subsingleton _ _ _ + +variables {G} (E) + +@[simp] lemma norm_const_of_is_empty [is_empty ι] (x : G) : ‖const_of_is_empty 𝕜 E x‖ = ‖x‖ := +begin + apply le_antisymm, + { refine op_norm_le_bound _ (norm_nonneg _) (λ x, _), + rw [fintype.prod_empty, mul_one, const_of_is_empty_apply], }, + { simpa using (const_of_is_empty 𝕜 E x).le_op_norm 0 } +end + +@[simp] lemma nnnorm_const_of_is_empty [is_empty ι] (x : G) : ‖const_of_is_empty 𝕜 E x‖₊ = ‖x‖₊ := +nnreal.eq $ norm_const_of_is_empty _ _ _ + +end + section variables (𝕜 E E' G G') @@ -459,7 +500,7 @@ def prodL : norm_map' := λ f, op_norm_prod f.1 f.2 } /-- `continuous_multilinear_map.pi` as a `linear_isometry_equiv`. -/ -def piₗᵢ {ι' : Type v'} [fintype ι'] {E' : ι' → Type wE'} [Π i', normed_group (E' i')] +def piₗᵢ {ι' : Type v'} [fintype ι'] {E' : ι' → Type wE'} [Π i', normed_add_comm_group (E' i')] [Π i', normed_space 𝕜 (E' i')] : @linear_isometry_equiv 𝕜 𝕜 _ _ (ring_hom.id 𝕜) _ _ _ (Π i', continuous_multilinear_map 𝕜 E (E' i')) (continuous_multilinear_map 𝕜 E (Π i, E' i)) _ _ @@ -478,22 +519,26 @@ end section restrict_scalars -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜' 𝕜] +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜' 𝕜] variables [normed_space 𝕜' G] [is_scalar_tower 𝕜' 𝕜 G] variables [Π i, normed_space 𝕜' (E i)] [∀ i, is_scalar_tower 𝕜' 𝕜 (E i)] -@[simp] lemma norm_restrict_scalars : ∥f.restrict_scalars 𝕜'∥ = ∥f∥ := -by simp only [norm_def, coe_restrict_scalars] +@[simp] lemma norm_restrict_scalars : ‖f.restrict_scalars 𝕜'‖ = ‖f‖ := rfl variable (𝕜') -/-- `continuous_multilinear_map.restrict_scalars` as a `continuous_multilinear_map`. -/ -def restrict_scalars_linear : - continuous_multilinear_map 𝕜 E G →L[𝕜'] continuous_multilinear_map 𝕜' E G := -linear_map.mk_continuous +/-- `continuous_multilinear_map.restrict_scalars` as a `linear_isometry`. -/ +def restrict_scalarsₗᵢ : + continuous_multilinear_map 𝕜 E G →ₗᵢ[𝕜'] continuous_multilinear_map 𝕜' E G := { to_fun := restrict_scalars 𝕜', map_add' := λ m₁ m₂, rfl, - map_smul' := λ c m, rfl } 1 $ λ f, by simp + map_smul' := λ c m, rfl, + norm_map' := λ f, rfl } + +/-- `continuous_multilinear_map.restrict_scalars` as a `continuous_linear_map`. -/ +def restrict_scalars_linear : + continuous_multilinear_map 𝕜 E G →L[𝕜'] continuous_multilinear_map 𝕜' E G := +(restrict_scalarsₗᵢ 𝕜').to_continuous_linear_map variable {𝕜'} @@ -504,21 +549,21 @@ lemma continuous_restrict_scalars : end restrict_scalars -/-- The difference `f m₁ - f m₂` is controlled in terms of `∥f∥` and `∥m₁ - m₂∥`, precise version. +/-- The difference `f m₁ - f m₂` is controlled in terms of `‖f‖` and `‖m₁ - m₂‖`, precise version. For a less precise but more usable version, see `norm_image_sub_le`. The bound reads -`∥f m - f m'∥ ≤ - ∥f∥ * ∥m 1 - m' 1∥ * max ∥m 2∥ ∥m' 2∥ * max ∥m 3∥ ∥m' 3∥ * ... * max ∥m n∥ ∥m' n∥ + ...`, +`‖f m - f m'‖ ≤ + ‖f‖ * ‖m 1 - m' 1‖ * max ‖m 2‖ ‖m' 2‖ * max ‖m 3‖ ‖m' 3‖ * ... * max ‖m n‖ ‖m' n‖ + ...`, where the other terms in the sum are the same products where `1` is replaced by any `i`.-/ -lemma norm_image_sub_le' (m₁ m₂ : Πi, E i) : - ∥f m₁ - f m₂∥ ≤ - ∥f∥ * ∑ i, ∏ j, if j = i then ∥m₁ i - m₂ i∥ else max ∥m₁ j∥ ∥m₂ j∥ := +lemma norm_image_sub_le' [decidable_eq ι] (m₁ m₂ : Πi, E i) : + ‖f m₁ - f m₂‖ ≤ + ‖f‖ * ∑ i, ∏ j, if j = i then ‖m₁ i - m₂ i‖ else max ‖m₁ j‖ ‖m₂ j‖ := f.to_multilinear_map.norm_image_sub_le_of_bound' (norm_nonneg _) f.le_op_norm _ _ -/-- The difference `f m₁ - f m₂` is controlled in terms of `∥f∥` and `∥m₁ - m₂∥`, less precise +/-- The difference `f m₁ - f m₂` is controlled in terms of `‖f‖` and `‖m₁ - m₂‖`, less precise version. For a more precise but less usable version, see `norm_image_sub_le'`. -The bound is `∥f m - f m'∥ ≤ ∥f∥ * card ι * ∥m - m'∥ * (max ∥m∥ ∥m'∥) ^ (card ι - 1)`.-/ +The bound is `‖f m - f m'‖ ≤ ‖f‖ * card ι * ‖m - m'‖ * (max ‖m‖ ‖m'‖) ^ (card ι - 1)`.-/ lemma norm_image_sub_le (m₁ m₂ : Πi, E i) : - ∥f m₁ - f m₂∥ ≤ ∥f∥ * (fintype.card ι) * (max ∥m₁∥ ∥m₂∥) ^ (fintype.card ι - 1) * ∥m₁ - m₂∥ := + ‖f m₁ - f m₂‖ ≤ ‖f‖ * (fintype.card ι) * (max ‖m₁‖ ‖m₂‖) ^ (fintype.card ι - 1) * ‖m₁ - m₂‖ := f.to_multilinear_map.norm_image_sub_le_of_bound (norm_nonneg _) f.le_op_norm _ _ /-- Applying a multilinear map to a vector is continuous in both coordinates. -/ @@ -527,27 +572,27 @@ lemma continuous_eval : begin apply continuous_iff_continuous_at.2 (λp, _), apply continuous_at_of_locally_lipschitz zero_lt_one - ((∥p∥ + 1) * (fintype.card ι) * (∥p∥ + 1) ^ (fintype.card ι - 1) + ∏ i, ∥p.2 i∥) + ((‖p‖ + 1) * (fintype.card ι) * (‖p‖ + 1) ^ (fintype.card ι - 1) + ∏ i, ‖p.2 i‖) (λq hq, _), - have : 0 ≤ (max ∥q.2∥ ∥p.2∥), by simp, - have : 0 ≤ ∥p∥ + 1, by simp [le_trans zero_le_one], - have A : ∥q∥ ≤ ∥p∥ + 1 := norm_le_of_mem_closed_ball (le_of_lt hq), - have : (max ∥q.2∥ ∥p.2∥) ≤ ∥p∥ + 1 := - le_trans (max_le_max (norm_snd_le q) (norm_snd_le p)) (by simp [A, -add_comm, zero_le_one]), - have : ∀ (i : ι), i ∈ univ → 0 ≤ ∥p.2 i∥ := λ i hi, norm_nonneg _, + have : 0 ≤ (max ‖q.2‖ ‖p.2‖), by simp, + have : 0 ≤ ‖p‖ + 1 := zero_le_one.trans ((le_add_iff_nonneg_left 1).2 $ norm_nonneg p), + have A : ‖q‖ ≤ ‖p‖ + 1 := norm_le_of_mem_closed_ball hq.le, + have : (max ‖q.2‖ ‖p.2‖) ≤ ‖p‖ + 1 := + (max_le_max (norm_snd_le q) (norm_snd_le p)).trans (by simp [A, -add_comm, zero_le_one]), + have : ∀ (i : ι), i ∈ univ → 0 ≤ ‖p.2 i‖ := λ i hi, norm_nonneg _, calc dist (q.1 q.2) (p.1 p.2) ≤ dist (q.1 q.2) (q.1 p.2) + dist (q.1 p.2) (p.1 p.2) : dist_triangle _ _ _ - ... = ∥q.1 q.2 - q.1 p.2∥ + ∥q.1 p.2 - p.1 p.2∥ : by rw [dist_eq_norm, dist_eq_norm] - ... ≤ ∥q.1∥ * (fintype.card ι) * (max ∥q.2∥ ∥p.2∥) ^ (fintype.card ι - 1) * ∥q.2 - p.2∥ - + ∥q.1 - p.1∥ * ∏ i, ∥p.2 i∥ : + ... = ‖q.1 q.2 - q.1 p.2‖ + ‖q.1 p.2 - p.1 p.2‖ : by rw [dist_eq_norm, dist_eq_norm] + ... ≤ ‖q.1‖ * (fintype.card ι) * (max ‖q.2‖ ‖p.2‖) ^ (fintype.card ι - 1) * ‖q.2 - p.2‖ + + ‖q.1 - p.1‖ * ∏ i, ‖p.2 i‖ : add_le_add (norm_image_sub_le _ _ _) ((q.1 - p.1).le_op_norm p.2) - ... ≤ (∥p∥ + 1) * (fintype.card ι) * (∥p∥ + 1) ^ (fintype.card ι - 1) * ∥q - p∥ - + ∥q - p∥ * ∏ i, ∥p.2 i∥ : + ... ≤ (‖p‖ + 1) * (fintype.card ι) * (‖p‖ + 1) ^ (fintype.card ι - 1) * ‖q - p‖ + + ‖q - p‖ * ∏ i, ‖p.2 i‖ : by apply_rules [add_le_add, mul_le_mul, le_refl, le_trans (norm_fst_le q) A, nat.cast_nonneg, mul_nonneg, pow_le_pow_of_le_left, pow_nonneg, norm_snd_le (q - p), norm_nonneg, norm_fst_le (q - p), prod_nonneg] - ... = ((∥p∥ + 1) * (fintype.card ι) * (∥p∥ + 1) ^ (fintype.card ι - 1) - + (∏ i, ∥p.2 i∥)) * dist q p : by { rw dist_eq_norm, ring } + ... = ((‖p‖ + 1) * (fintype.card ι) * (‖p‖ + 1) ^ (fintype.card ι - 1) + + (∏ i, ‖p.2 i‖)) * dist q p : by { rw dist_eq_norm, ring } end lemma continuous_eval_left (m : Π i, E i) : @@ -568,7 +613,7 @@ lemma tsum_eval {α : Type*} {p : α → continuous_multilinear_map 𝕜 E G} (h (m : Π i, E i) : (∑' a, p a) m = ∑' a, p a m := (has_sum_eval hp.has_sum m).tsum_eq.symm -open_locale topological_space +open_locale topology open filter /-- If the target space is complete, the space of continuous multilinear maps with its norm is also @@ -578,7 +623,7 @@ case from the multilinear case via a currying isomorphism. However, this would m and it is more satisfactory to have the simplest case as a standalone proof. -/ instance [complete_space G] : complete_space (continuous_multilinear_map 𝕜 E G) := begin - have nonneg : ∀ (v : Π i, E i), 0 ≤ ∏ i, ∥v i∥ := + have nonneg : ∀ (v : Π i, E i), 0 ≤ ∏ i, ‖v i‖ := λ v, finset.prod_nonneg (λ i hi, norm_nonneg _), -- We show that every Cauchy sequence converges. refine metric.complete_of_cauchy_seq_tendsto (λ f hf, _), @@ -587,7 +632,7 @@ begin -- and establish that the evaluation at any point `v : Π i, E i` is Cauchy. have cau : ∀ v, cauchy_seq (λ n, f n v), { assume v, - apply cauchy_seq_iff_le_tendsto_0.2 ⟨λ n, b n * ∏ i, ∥v i∥, λ n, _, _, _⟩, + apply cauchy_seq_iff_le_tendsto_0.2 ⟨λ n, b n * ∏ i, ‖v i‖, λ n, _, _, _⟩, { exact mul_nonneg (b0 n) (nonneg v) }, { assume n m N hn hm, rw dist_eq_norm, @@ -601,28 +646,30 @@ begin -- Next, we show that this `F` is multilinear, let Fmult : multilinear_map 𝕜 E G := { to_fun := F, - map_add' := λ v i x y, begin + map_add' := λ _ v i x y, begin + resetI, have A := hF (function.update v i (x + y)), have B := (hF (function.update v i x)).add (hF (function.update v i y)), simp at A B, exact tendsto_nhds_unique A B end, - map_smul' := λ v i c x, begin + map_smul' := λ _ v i c x, begin + resetI, have A := hF (function.update v i (c • x)), have B := filter.tendsto.smul (@tendsto_const_nhds _ ℕ _ c _) (hF (function.update v i x)), simp at A B, exact tendsto_nhds_unique A B end }, - -- and that `F` has norm at most `(b 0 + ∥f 0∥)`. - have Fnorm : ∀ v, ∥F v∥ ≤ (b 0 + ∥f 0∥) * ∏ i, ∥v i∥, + -- and that `F` has norm at most `(b 0 + ‖f 0‖)`. + have Fnorm : ∀ v, ‖F v‖ ≤ (b 0 + ‖f 0‖) * ∏ i, ‖v i‖, { assume v, - have A : ∀ n, ∥f n v∥ ≤ (b 0 + ∥f 0∥) * ∏ i, ∥v i∥, + have A : ∀ n, ‖f n v‖ ≤ (b 0 + ‖f 0‖) * ∏ i, ‖v i‖, { assume n, apply le_trans ((f n).le_op_norm _) _, apply mul_le_mul_of_nonneg_right _ (nonneg v), - calc ∥f n∥ = ∥(f n - f 0) + f 0∥ : by { congr' 1, abel } - ... ≤ ∥f n - f 0∥ + ∥f 0∥ : norm_add_le _ _ - ... ≤ b 0 + ∥f 0∥ : begin + calc ‖f n‖ = ‖(f n - f 0) + f 0‖ : by { congr' 1, abel } + ... ≤ ‖f n - f 0‖ + ‖f 0‖ : norm_add_le _ _ + ... ≤ b 0 + ‖f 0‖ : begin apply add_le_add_right, simpa [dist_eq_norm] using b_bound n 0 0 (zero_le _) (zero_le _) end }, @@ -631,14 +678,14 @@ begin let Fcont := Fmult.mk_continuous _ Fnorm, use Fcont, -- Our last task is to establish convergence to `F` in norm. - have : ∀ n, ∥f n - Fcont∥ ≤ b n, + have : ∀ n, ‖f n - Fcont‖ ≤ b n, { assume n, apply op_norm_le_bound _ (b0 n) (λ v, _), - have A : ∀ᶠ m in at_top, ∥(f n - f m) v∥ ≤ b n * ∏ i, ∥v i∥, + have A : ∀ᶠ m in at_top, ‖(f n - f m) v‖ ≤ b n * ∏ i, ‖v i‖, { refine eventually_at_top.2 ⟨n, λ m hm, _⟩, apply le_trans ((f n - f m).le_op_norm _) _, exact mul_le_mul_of_nonneg_right (b_bound n m n le_rfl hm) (nonneg v) }, - have B : tendsto (λ m, ∥(f n - f m) v∥) at_top (𝓝 (∥(f n - Fcont) v∥)) := + have B : tendsto (λ m, ‖(f n - f m) v‖) at_top (𝓝 (‖(f n - Fcont) v‖)) := tendsto.norm (tendsto_const_nhds.sub (hF v)), exact le_of_tendsto B A }, erw tendsto_iff_norm_tendsto_zero, @@ -651,14 +698,14 @@ end continuous_multilinear_map `mk_continuous`, then its norm is bounded by the bound given to the constructor if it is nonnegative. -/ lemma multilinear_map.mk_continuous_norm_le (f : multilinear_map 𝕜 E G) {C : ℝ} (hC : 0 ≤ C) - (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) : ∥f.mk_continuous C H∥ ≤ C := + (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) : ‖f.mk_continuous C H‖ ≤ C := continuous_multilinear_map.op_norm_le_bound _ hC (λm, H m) /-- If a continuous multilinear map is constructed from a multilinear map via the constructor `mk_continuous`, then its norm is bounded by the bound given to the constructor if it is nonnegative. -/ lemma multilinear_map.mk_continuous_norm_le' (f : multilinear_map 𝕜 E G) {C : ℝ} - (H : ∀ m, ∥f m∥ ≤ C * ∏ i, ∥m i∥) : ∥f.mk_continuous C H∥ ≤ max C 0 := + (H : ∀ m, ‖f m‖ ≤ C * ∏ i, ‖m i‖) : ‖f.mk_continuous C H‖ ≤ max C 0 := continuous_multilinear_map.op_norm_le_bound _ (le_max_right _ _) $ λ m, (H m).trans $ mul_le_mul_of_nonneg_right (le_max_left _ _) (prod_nonneg $ λ _ _, norm_nonneg _) @@ -673,10 +720,10 @@ identification between `fin k` and `s` that we use is the canonical (increasing) def restr {k n : ℕ} (f : (G [×n]→L[𝕜] G' : _)) (s : finset (fin n)) (hk : s.card = k) (z : G) : G [×k]→L[𝕜] G' := (f.to_multilinear_map.restr s hk z).mk_continuous -(∥f∥ * ∥z∥^(n-k)) $ λ v, multilinear_map.restr_norm_le _ _ _ _ f.le_op_norm _ +(‖f‖ * ‖z‖^(n-k)) $ λ v, multilinear_map.restr_norm_le _ _ _ _ f.le_op_norm _ lemma norm_restr {k n : ℕ} (f : G [×n]→L[𝕜] G') (s : finset (fin n)) (hk : s.card = k) (z : G) : - ∥f.restr s hk z∥ ≤ ∥f∥ * ∥z∥ ^ (n - k) := + ‖f.restr s hk z‖ ≤ ‖f‖ * ‖z‖ ^ (n - k) := begin apply multilinear_map.mk_continuous_norm_le, exact mul_nonneg (norm_nonneg _) (pow_nonneg (norm_nonneg _) _) @@ -688,9 +735,9 @@ variables {𝕜 ι} {A : Type*} [normed_comm_ring A] [normed_algebra 𝕜 A] @[simp] lemma norm_mk_pi_algebra_le [nonempty ι] : - ∥continuous_multilinear_map.mk_pi_algebra 𝕜 ι A∥ ≤ 1 := + ‖continuous_multilinear_map.mk_pi_algebra 𝕜 ι A‖ ≤ 1 := begin - have := λ f, @op_norm_le_bound 𝕜 ι (λ i, A) A _ _ _ _ _ _ _ f _ zero_le_one, + have := λ f, @op_norm_le_bound 𝕜 ι (λ i, A) A _ _ _ _ _ _ f _ zero_le_one, refine this _ _, intros m, simp only [continuous_multilinear_map.mk_pi_algebra_apply, one_mul], @@ -698,10 +745,10 @@ begin end lemma norm_mk_pi_algebra_of_empty [is_empty ι] : - ∥continuous_multilinear_map.mk_pi_algebra 𝕜 ι A∥ = ∥(1 : A)∥ := + ‖continuous_multilinear_map.mk_pi_algebra 𝕜 ι A‖ = ‖(1 : A)‖ := begin apply le_antisymm, - { have := λ f, @op_norm_le_bound 𝕜 ι (λ i, A) A _ _ _ _ _ _ _ f _ (norm_nonneg (1 : A)), + { have := λ f, @op_norm_le_bound 𝕜 ι (λ i, A) A _ _ _ _ _ _ f _ (norm_nonneg (1 : A)), refine this _ _, simp, }, { convert ratio_le_op_norm _ (λ _, (1 : A)), @@ -709,7 +756,7 @@ begin end @[simp] lemma norm_mk_pi_algebra [norm_one_class A] : - ∥continuous_multilinear_map.mk_pi_algebra 𝕜 ι A∥ = 1 := + ‖continuous_multilinear_map.mk_pi_algebra 𝕜 ι A‖ = 1 := begin casesI is_empty_or_nonempty ι, { simp [norm_mk_pi_algebra_of_empty] }, @@ -725,13 +772,13 @@ section variables {𝕜 n} {A : Type*} [normed_ring A] [normed_algebra 𝕜 A] lemma norm_mk_pi_algebra_fin_succ_le : - ∥continuous_multilinear_map.mk_pi_algebra_fin 𝕜 n.succ A∥ ≤ 1 := + ‖continuous_multilinear_map.mk_pi_algebra_fin 𝕜 n.succ A‖ ≤ 1 := begin - have := λ f, @op_norm_le_bound 𝕜 (fin n.succ) (λ i, A) A _ _ _ _ _ _ _ f _ zero_le_one, + have := λ f, @op_norm_le_bound 𝕜 (fin n.succ) (λ i, A) A _ _ _ _ _ _ f _ zero_le_one, refine this _ _, intros m, simp only [continuous_multilinear_map.mk_pi_algebra_fin_apply, one_mul, list.of_fn_eq_map, - fin.univ_def, finset.fin_range, finset.prod, multiset.coe_map, multiset.coe_prod], + fin.prod_univ_def, multiset.coe_map, multiset.coe_prod], refine (list.norm_prod_le' _).trans_eq _, { rw [ne.def, list.map_eq_nil, list.fin_range_eq_nil], exact nat.succ_ne_zero _, }, @@ -739,17 +786,17 @@ begin end lemma norm_mk_pi_algebra_fin_le_of_pos (hn : 0 < n) : - ∥continuous_multilinear_map.mk_pi_algebra_fin 𝕜 n A∥ ≤ 1 := + ‖continuous_multilinear_map.mk_pi_algebra_fin 𝕜 n A‖ ≤ 1 := begin obtain ⟨n, rfl⟩ := nat.exists_eq_succ_of_ne_zero hn.ne', exact norm_mk_pi_algebra_fin_succ_le end lemma norm_mk_pi_algebra_fin_zero : - ∥continuous_multilinear_map.mk_pi_algebra_fin 𝕜 0 A∥ = ∥(1 : A)∥ := + ‖continuous_multilinear_map.mk_pi_algebra_fin 𝕜 0 A‖ = ‖(1 : A)‖ := begin refine le_antisymm _ _, - { have := λ f, @op_norm_le_bound 𝕜 (fin 0) (λ i, A) A _ _ _ _ _ _ _ f _ (norm_nonneg (1 : A)), + { have := λ f, @op_norm_le_bound 𝕜 (fin 0) (λ i, A) A _ _ _ _ _ _ f _ (norm_nonneg (1 : A)), refine this _ _, simp, }, { convert ratio_le_op_norm _ (λ _, (1 : A)), @@ -757,7 +804,7 @@ begin end @[simp] lemma norm_mk_pi_algebra_fin [norm_one_class A] : - ∥continuous_multilinear_map.mk_pi_algebra_fin 𝕜 n A∥ = 1 := + ‖continuous_multilinear_map.mk_pi_algebra_fin 𝕜 n A‖ = 1 := begin cases n, { simp [norm_mk_pi_algebra_fin_zero] }, @@ -774,7 +821,7 @@ variables (𝕜 ι) `m i` (multiplied by a fixed reference element `z` in the target module) -/ protected def mk_pi_field (z : G) : continuous_multilinear_map 𝕜 (λ(i : ι), 𝕜) G := multilinear_map.mk_continuous - (multilinear_map.mk_pi_ring 𝕜 ι z) (∥z∥) + (multilinear_map.mk_pi_ring 𝕜 ι z) (‖z‖) (λ m, by simp only [multilinear_map.mk_pi_ring_apply, norm_smul, norm_prod, mul_comm]) @@ -785,12 +832,28 @@ variables {𝕜 ι} lemma mk_pi_field_apply_one_eq_self (f : continuous_multilinear_map 𝕜 (λ(i : ι), 𝕜) G) : continuous_multilinear_map.mk_pi_field 𝕜 ι (f (λi, 1)) = f := -to_multilinear_map_inj f.to_multilinear_map.mk_pi_ring_apply_one_eq_self +to_multilinear_map_injective f.to_multilinear_map.mk_pi_ring_apply_one_eq_self -@[simp] lemma norm_mk_pi_field (z : G) : ∥continuous_multilinear_map.mk_pi_field 𝕜 ι z∥ = ∥z∥ := +@[simp] lemma norm_mk_pi_field (z : G) : ‖continuous_multilinear_map.mk_pi_field 𝕜 ι z‖ = ‖z‖ := (multilinear_map.mk_continuous_norm_le _ (norm_nonneg z) _).antisymm $ by simpa using (continuous_multilinear_map.mk_pi_field 𝕜 ι z).le_op_norm (λ _, 1) +lemma mk_pi_field_eq_iff {z₁ z₂ : G} : + continuous_multilinear_map.mk_pi_field 𝕜 ι z₁ = continuous_multilinear_map.mk_pi_field 𝕜 ι z₂ ↔ + z₁ = z₂ := +begin + rw [← to_multilinear_map_injective.eq_iff], + exact multilinear_map.mk_pi_ring_eq_iff +end + +lemma mk_pi_field_zero : + continuous_multilinear_map.mk_pi_field 𝕜 ι (0 : G) = 0 := +by ext; rw [mk_pi_field_apply, smul_zero, continuous_multilinear_map.zero_apply] + +lemma mk_pi_field_eq_zero_iff (z : G) : + continuous_multilinear_map.mk_pi_field 𝕜 ι z = 0 ↔ z = 0 := +by rw [← mk_pi_field_zero, mk_pi_field_eq_iff] + variables (𝕜 ι G) /-- Continuous multilinear maps on `𝕜^n` with values in `G` are in bijection with `G`, as such a @@ -812,11 +875,12 @@ namespace continuous_linear_map lemma norm_comp_continuous_multilinear_map_le (g : G →L[𝕜] G') (f : continuous_multilinear_map 𝕜 E G) : - ∥g.comp_continuous_multilinear_map f∥ ≤ ∥g∥ * ∥f∥ := + ‖g.comp_continuous_multilinear_map f‖ ≤ ‖g‖ * ‖f‖ := continuous_multilinear_map.op_norm_le_bound _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) $ λ m, -calc ∥g (f m)∥ ≤ ∥g∥ * (∥f∥ * ∏ i, ∥m i∥) : g.le_op_norm_of_le $ f.le_op_norm _ +calc ‖g (f m)‖ ≤ ‖g‖ * (‖f‖ * ∏ i, ‖m i‖) : g.le_op_norm_of_le $ f.le_op_norm _ ... = _ : (mul_assoc _ _ _).symm +variables (𝕜 E G G') /-- `continuous_linear_map.comp_continuous_multilinear_map` as a bundled continuous bilinear map. -/ def comp_continuous_multilinear_mapL : (G →L[𝕜] G') →L[𝕜] continuous_multilinear_map 𝕜 E G →L[𝕜] continuous_multilinear_map 𝕜 E G' := @@ -825,8 +889,49 @@ linear_map.mk_continuous₂ (λ f g₁ g₂, by { ext1, apply f.map_add }) (λ c f g, by { ext1, simp })) 1 $ λ f g, by { rw one_mul, exact f.norm_comp_continuous_multilinear_map_le g } +variables {𝕜 G G'} + +/-- `continuous_linear_map.comp_continuous_multilinear_map` as a bundled +continuous linear equiv. -/ +def _root_.continuous_linear_equiv.comp_continuous_multilinear_mapL (g : G ≃L[𝕜] G') : + continuous_multilinear_map 𝕜 E G ≃L[𝕜] continuous_multilinear_map 𝕜 E G' := +{ inv_fun := comp_continuous_multilinear_mapL 𝕜 _ _ _ g.symm.to_continuous_linear_map, + left_inv := begin + assume f, + ext1 m, + simp only [comp_continuous_multilinear_mapL, continuous_linear_equiv.coe_def_rev, + to_linear_map_eq_coe, linear_map.to_fun_eq_coe, coe_coe, linear_map.mk_continuous₂_apply, + linear_map.mk₂_apply, comp_continuous_multilinear_map_coe, continuous_linear_equiv.coe_coe, + function.comp_app, continuous_linear_equiv.symm_apply_apply], + end, + right_inv := begin + assume f, + ext1 m, + simp only [comp_continuous_multilinear_mapL, continuous_linear_equiv.coe_def_rev, + to_linear_map_eq_coe, linear_map.mk_continuous₂_apply, linear_map.mk₂_apply, + linear_map.to_fun_eq_coe, coe_coe, comp_continuous_multilinear_map_coe, + continuous_linear_equiv.coe_coe, function.comp_app, continuous_linear_equiv.apply_symm_apply], + end, + continuous_to_fun := + (comp_continuous_multilinear_mapL 𝕜 _ _ _ g.to_continuous_linear_map).continuous, + continuous_inv_fun := + (comp_continuous_multilinear_mapL 𝕜 _ _ _ g.symm.to_continuous_linear_map).continuous, + .. comp_continuous_multilinear_mapL 𝕜 _ _ _ g.to_continuous_linear_map } + +@[simp] lemma _root_.continuous_linear_equiv.comp_continuous_multilinear_mapL_symm + (g : G ≃L[𝕜] G') : + (g.comp_continuous_multilinear_mapL E).symm = g.symm.comp_continuous_multilinear_mapL E := rfl + +variables {E} + +@[simp] lemma _root_.continuous_linear_equiv.comp_continuous_multilinear_mapL_apply + (g : G ≃L[𝕜] G') (f : continuous_multilinear_map 𝕜 E G) : + g.comp_continuous_multilinear_mapL E f = (g : G →L[𝕜] G').comp_continuous_multilinear_map f := +rfl + /-- Flip arguments in `f : G →L[𝕜] continuous_multilinear_map 𝕜 E G'` to get `continuous_multilinear_map 𝕜 E (G →L[𝕜] G')` -/ +@[simps apply_apply] def flip_multilinear (f : G →L[𝕜] continuous_multilinear_map 𝕜 E G') : continuous_multilinear_map 𝕜 E (G →L[𝕜] G') := multilinear_map.mk_continuous @@ -835,25 +940,33 @@ multilinear_map.mk_continuous map_add' := λ x y, by simp only [map_add, continuous_multilinear_map.add_apply], map_smul' := λ c x, by simp only [continuous_multilinear_map.smul_apply, map_smul, ring_hom.id_apply] } - (∥f∥ * ∏ i, ∥m i∥) $ λ x, + (‖f‖ * ∏ i, ‖m i‖) $ λ x, by { rw mul_right_comm, exact (f x).le_of_op_norm_le _ (f.le_op_norm x) }, - map_add' := λ m i x y, + map_add' := λ _ m i x y, by { ext1, simp only [add_apply, continuous_multilinear_map.map_add, linear_map.coe_mk, linear_map.mk_continuous_apply]}, - map_smul' := λ m i c x, + map_smul' := λ _ m i c x, by { ext1, simp only [coe_smul', continuous_multilinear_map.map_smul, linear_map.coe_mk, linear_map.mk_continuous_apply, pi.smul_apply]} } - ∥f∥ $ λ m, + ‖f‖ $ λ m, linear_map.mk_continuous_norm_le _ (mul_nonneg (norm_nonneg f) (prod_nonneg $ λ i hi, norm_nonneg (m i))) _ end continuous_linear_map + +lemma linear_isometry.norm_comp_continuous_multilinear_map + (g : G →ₗᵢ[𝕜] G') (f : continuous_multilinear_map 𝕜 E G) : + ‖g.to_continuous_linear_map.comp_continuous_multilinear_map f‖ = ‖f‖ := +by simp only [continuous_linear_map.comp_continuous_multilinear_map_coe, + linear_isometry.coe_to_continuous_linear_map, linear_isometry.norm_map, + continuous_multilinear_map.norm_def] + open continuous_multilinear_map namespace multilinear_map /-- Given a map `f : G →ₗ[𝕜] multilinear_map 𝕜 E G'` and an estimate -`H : ∀ x m, ∥f x m∥ ≤ C * ∥x∥ * ∏ i, ∥m i∥`, construct a continuous linear +`H : ∀ x m, ‖f x m‖ ≤ C * ‖x‖ * ∏ i, ‖m i‖`, construct a continuous linear map from `G` to `continuous_multilinear_map 𝕜 E G'`. In order to lift, e.g., a map `f : (multilinear_map 𝕜 E G) →ₗ[𝕜] multilinear_map 𝕜 E' G'` @@ -861,57 +974,57 @@ to a map `(continuous_multilinear_map 𝕜 E G) →L[𝕜] continuous_multilinea one can apply this construction to `f.comp continuous_multilinear_map.to_multilinear_map_linear` which is a linear map from `continuous_multilinear_map 𝕜 E G` to `multilinear_map 𝕜 E' G'`. -/ def mk_continuous_linear (f : G →ₗ[𝕜] multilinear_map 𝕜 E G') (C : ℝ) - (H : ∀ x m, ∥f x m∥ ≤ C * ∥x∥ * ∏ i, ∥m i∥) : + (H : ∀ x m, ‖f x m‖ ≤ C * ‖x‖ * ∏ i, ‖m i‖) : G →L[𝕜] continuous_multilinear_map 𝕜 E G' := linear_map.mk_continuous - { to_fun := λ x, (f x).mk_continuous (C * ∥x∥) $ H x, - map_add' := λ x y, by { ext1, simp }, - map_smul' := λ c x, by { ext1, simp } } + { to_fun := λ x, (f x).mk_continuous (C * ‖x‖) $ H x, + map_add' := λ x y, by { ext1, simp only [_root_.map_add], refl }, + map_smul' := λ c x, by { ext1, simp only [smul_hom_class.map_smul], refl } } (max C 0) $ λ x, ((f x).mk_continuous_norm_le' _).trans_eq $ by rw [max_mul_of_nonneg _ _ (norm_nonneg x), zero_mul] lemma mk_continuous_linear_norm_le' (f : G →ₗ[𝕜] multilinear_map 𝕜 E G') (C : ℝ) - (H : ∀ x m, ∥f x m∥ ≤ C * ∥x∥ * ∏ i, ∥m i∥) : - ∥mk_continuous_linear f C H∥ ≤ max C 0 := + (H : ∀ x m, ‖f x m‖ ≤ C * ‖x‖ * ∏ i, ‖m i‖) : + ‖mk_continuous_linear f C H‖ ≤ max C 0 := begin dunfold mk_continuous_linear, exact linear_map.mk_continuous_norm_le _ (le_max_right _ _) _ end lemma mk_continuous_linear_norm_le (f : G →ₗ[𝕜] multilinear_map 𝕜 E G') {C : ℝ} (hC : 0 ≤ C) - (H : ∀ x m, ∥f x m∥ ≤ C * ∥x∥ * ∏ i, ∥m i∥) : - ∥mk_continuous_linear f C H∥ ≤ C := + (H : ∀ x m, ‖f x m‖ ≤ C * ‖x‖ * ∏ i, ‖m i‖) : + ‖mk_continuous_linear f C H‖ ≤ C := (mk_continuous_linear_norm_le' f C H).trans_eq (max_eq_left hC) /-- Given a map `f : multilinear_map 𝕜 E (multilinear_map 𝕜 E' G)` and an estimate -`H : ∀ m m', ∥f m m'∥ ≤ C * ∏ i, ∥m i∥ * ∏ i, ∥m' i∥`, upgrade all `multilinear_map`s in the type to +`H : ∀ m m', ‖f m m'‖ ≤ C * ∏ i, ‖m i‖ * ∏ i, ‖m' i‖`, upgrade all `multilinear_map`s in the type to `continuous_multilinear_map`s. -/ def mk_continuous_multilinear (f : multilinear_map 𝕜 E (multilinear_map 𝕜 E' G)) (C : ℝ) - (H : ∀ m₁ m₂, ∥f m₁ m₂∥ ≤ C * (∏ i, ∥m₁ i∥) * ∏ i, ∥m₂ i∥) : + (H : ∀ m₁ m₂, ‖f m₁ m₂‖ ≤ C * (∏ i, ‖m₁ i‖) * ∏ i, ‖m₂ i‖) : continuous_multilinear_map 𝕜 E (continuous_multilinear_map 𝕜 E' G) := mk_continuous - { to_fun := λ m, mk_continuous (f m) (C * ∏ i, ∥m i∥) $ H m, - map_add' := λ m i x y, by { ext1, simp }, - map_smul' := λ m i c x, by { ext1, simp } } + { to_fun := λ m, mk_continuous (f m) (C * ∏ i, ‖m i‖) $ H m, + map_add' := λ _ m i x y, by { ext1, simp }, + map_smul' := λ _ m i c x, by { ext1, simp } } (max C 0) $ λ m, ((f m).mk_continuous_norm_le' _).trans_eq $ by { rw [max_mul_of_nonneg, zero_mul], exact prod_nonneg (λ _ _, norm_nonneg _) } @[simp] lemma mk_continuous_multilinear_apply (f : multilinear_map 𝕜 E (multilinear_map 𝕜 E' G)) - {C : ℝ} (H : ∀ m₁ m₂, ∥f m₁ m₂∥ ≤ C * (∏ i, ∥m₁ i∥) * ∏ i, ∥m₂ i∥) (m : Π i, E i) : + {C : ℝ} (H : ∀ m₁ m₂, ‖f m₁ m₂‖ ≤ C * (∏ i, ‖m₁ i‖) * ∏ i, ‖m₂ i‖) (m : Π i, E i) : ⇑(mk_continuous_multilinear f C H m) = f m := rfl lemma mk_continuous_multilinear_norm_le' (f : multilinear_map 𝕜 E (multilinear_map 𝕜 E' G)) (C : ℝ) - (H : ∀ m₁ m₂, ∥f m₁ m₂∥ ≤ C * (∏ i, ∥m₁ i∥) * ∏ i, ∥m₂ i∥) : - ∥mk_continuous_multilinear f C H∥ ≤ max C 0 := + (H : ∀ m₁ m₂, ‖f m₁ m₂‖ ≤ C * (∏ i, ‖m₁ i‖) * ∏ i, ‖m₂ i‖) : + ‖mk_continuous_multilinear f C H‖ ≤ max C 0 := begin dunfold mk_continuous_multilinear, exact mk_continuous_norm_le _ (le_max_right _ _) _ end lemma mk_continuous_multilinear_norm_le (f : multilinear_map 𝕜 E (multilinear_map 𝕜 E' G)) {C : ℝ} - (hC : 0 ≤ C) (H : ∀ m₁ m₂, ∥f m₁ m₂∥ ≤ C * (∏ i, ∥m₁ i∥) * ∏ i, ∥m₂ i∥) : - ∥mk_continuous_multilinear f C H∥ ≤ C := + (hC : 0 ≤ C) (H : ∀ m₁ m₂, ‖f m₁ m₂‖ ≤ C * (∏ i, ‖m₁ i‖) * ∏ i, ‖m₂ i‖) : + ‖mk_continuous_multilinear f C H‖ ≤ C := (mk_continuous_multilinear_norm_le' f C H).trans_eq (max_eq_left hC) end multilinear_map @@ -920,13 +1033,38 @@ namespace continuous_multilinear_map lemma norm_comp_continuous_linear_le (g : continuous_multilinear_map 𝕜 E₁ G) (f : Π i, E i →L[𝕜] E₁ i) : - ∥g.comp_continuous_linear_map f∥ ≤ ∥g∥ * ∏ i, ∥f i∥ := + ‖g.comp_continuous_linear_map f‖ ≤ ‖g‖ * ∏ i, ‖f i‖ := op_norm_le_bound _ (mul_nonneg (norm_nonneg _) $ prod_nonneg $ λ i hi, norm_nonneg _) $ λ m, -calc ∥g (λ i, f i (m i))∥ ≤ ∥g∥ * ∏ i, ∥f i (m i)∥ : g.le_op_norm _ -... ≤ ∥g∥ * ∏ i, (∥f i∥ * ∥m i∥) : +calc ‖g (λ i, f i (m i))‖ ≤ ‖g‖ * ∏ i, ‖f i (m i)‖ : g.le_op_norm _ +... ≤ ‖g‖ * ∏ i, (‖f i‖ * ‖m i‖) : mul_le_mul_of_nonneg_left (prod_le_prod (λ _ _, norm_nonneg _) (λ i hi, (f i).le_op_norm (m i))) (norm_nonneg g) -... = (∥g∥ * ∏ i, ∥f i∥) * ∏ i, ∥m i∥ : by rw [prod_mul_distrib, mul_assoc] +... = (‖g‖ * ∏ i, ‖f i‖) * ∏ i, ‖m i‖ : by rw [prod_mul_distrib, mul_assoc] + +lemma norm_comp_continuous_linear_isometry_le (g : continuous_multilinear_map 𝕜 E₁ G) + (f : Π i, E i →ₗᵢ[𝕜] E₁ i) : + ‖g.comp_continuous_linear_map (λ i, (f i).to_continuous_linear_map)‖ ≤ ‖g‖ := +begin + apply op_norm_le_bound _ (norm_nonneg _) (λ m, _), + apply (g.le_op_norm _).trans _, + simp only [continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe, + linear_isometry.coe_to_continuous_linear_map, linear_isometry.norm_map] +end + +lemma norm_comp_continuous_linear_isometry_equiv (g : continuous_multilinear_map 𝕜 E₁ G) + (f : Π i, E i ≃ₗᵢ[𝕜] E₁ i) : + ‖g.comp_continuous_linear_map (λ i, (f i : E i →L[𝕜] E₁ i))‖ = ‖g‖ := +begin + apply le_antisymm (g.norm_comp_continuous_linear_isometry_le (λ i, (f i).to_linear_isometry)), + have : g = (g.comp_continuous_linear_map (λ i, (f i : E i →L[𝕜] E₁ i))) + .comp_continuous_linear_map (λ i, ((f i).symm : E₁ i →L[𝕜] E i)), + { ext1 m, + simp only [comp_continuous_linear_map_apply, linear_isometry_equiv.coe_coe'', + linear_isometry_equiv.apply_symm_apply] }, + conv_lhs { rw this }, + apply (g.comp_continuous_linear_map (λ i, (f i : E i →L[𝕜] E₁ i))) + .norm_comp_continuous_linear_isometry_le (λ i, (f i).symm.to_linear_isometry), +end /-- `continuous_multilinear_map.comp_continuous_linear_map` as a bundled continuous linear map. This implementation fixes `f : Π i, E i →L[𝕜] E₁ i`. @@ -939,19 +1077,69 @@ linear_map.mk_continuous { to_fun := λ g, g.comp_continuous_linear_map f, map_add' := λ g₁ g₂, rfl, map_smul' := λ c g, rfl } - (∏ i, ∥f i∥) $ λ g, (norm_comp_continuous_linear_le _ _).trans_eq (mul_comm _ _) + (∏ i, ‖f i‖) $ λ g, (norm_comp_continuous_linear_le _ _).trans_eq (mul_comm _ _) -@[simp] lemma comp_continuous_linear_mapL_apply (g : continuous_multilinear_map 𝕜 E₁ G) - (f : Π i, E i →L[𝕜] E₁ i) : +@[simp] lemma comp_continuous_linear_mapL_apply + (g : continuous_multilinear_map 𝕜 E₁ G) (f : Π i, E i →L[𝕜] E₁ i) : comp_continuous_linear_mapL f g = g.comp_continuous_linear_map f := rfl lemma norm_comp_continuous_linear_mapL_le (f : Π i, E i →L[𝕜] E₁ i) : - ∥@comp_continuous_linear_mapL 𝕜 ι E E₁ G _ _ _ _ _ _ _ _ _ f∥ ≤ (∏ i, ∥f i∥) := + ‖@comp_continuous_linear_mapL 𝕜 ι E E₁ G _ _ _ _ _ _ _ _ f‖ ≤ (∏ i, ‖f i‖) := linear_map.mk_continuous_norm_le _ (prod_nonneg $ λ i _, norm_nonneg _) _ +variable (G) + +/-- `continuous_multilinear_map.comp_continuous_linear_map` as a bundled continuous linear equiv, +given `f : Π i, E i ≃L[𝕜] E₁ i`. -/ +def comp_continuous_linear_map_equivL (f : Π i, E i ≃L[𝕜] E₁ i) : + continuous_multilinear_map 𝕜 E₁ G ≃L[𝕜] continuous_multilinear_map 𝕜 E G := +{ inv_fun := comp_continuous_linear_mapL (λ i, ((f i).symm : E₁ i →L[𝕜] E i)), + continuous_to_fun := (comp_continuous_linear_mapL (λ i, (f i : E i →L[𝕜] E₁ i))).continuous, + continuous_inv_fun := + (comp_continuous_linear_mapL (λ i, ((f i).symm : E₁ i →L[𝕜] E i))).continuous, + left_inv := begin + assume g, + ext1 m, + simp only [continuous_linear_map.to_linear_map_eq_coe, linear_map.to_fun_eq_coe, + continuous_linear_map.coe_coe, comp_continuous_linear_mapL_apply, + comp_continuous_linear_map_apply, continuous_linear_equiv.coe_coe, + continuous_linear_equiv.apply_symm_apply], + end, + right_inv := begin + assume g, + ext1 m, + simp only [continuous_linear_map.to_linear_map_eq_coe, comp_continuous_linear_mapL_apply, + linear_map.to_fun_eq_coe, continuous_linear_map.coe_coe, comp_continuous_linear_map_apply, + continuous_linear_equiv.coe_coe, continuous_linear_equiv.symm_apply_apply], + end, + .. comp_continuous_linear_mapL (λ i, (f i : E i →L[𝕜] E₁ i)) } + +@[simp] lemma comp_continuous_linear_map_equivL_symm (f : Π i, E i ≃L[𝕜] E₁ i) : + (comp_continuous_linear_map_equivL G f).symm = + comp_continuous_linear_map_equivL G (λ (i : ι), (f i).symm) := +rfl + +variable {G} + +@[simp] lemma comp_continuous_linear_map_equivL_apply + (g : continuous_multilinear_map 𝕜 E₁ G) (f : Π i, E i ≃L[𝕜] E₁ i) : + comp_continuous_linear_map_equivL G f g = + g.comp_continuous_linear_map (λ i, (f i : E i →L[𝕜] E₁ i)) := rfl + end continuous_multilinear_map +section smul + +variables {R : Type*} [semiring R] [module R G] [smul_comm_class 𝕜 R G] + [has_continuous_const_smul R G] + +instance : has_continuous_const_smul R (continuous_multilinear_map 𝕜 E G) := +⟨λ c, (continuous_linear_map.comp_continuous_multilinear_mapL 𝕜 _ G G + (c • continuous_linear_map.id 𝕜 G)).2⟩ + +end smul + section currying /-! ### Currying @@ -969,38 +1157,38 @@ open fin function lemma continuous_linear_map.norm_map_tail_le (f : Ei 0 →L[𝕜] (continuous_multilinear_map 𝕜 (λ(i : fin n), Ei i.succ) G)) (m : Πi, Ei i) : - ∥f (m 0) (tail m)∥ ≤ ∥f∥ * ∏ i, ∥m i∥ := + ‖f (m 0) (tail m)‖ ≤ ‖f‖ * ∏ i, ‖m i‖ := calc - ∥f (m 0) (tail m)∥ ≤ ∥f (m 0)∥ * ∏ i, ∥(tail m) i∥ : (f (m 0)).le_op_norm _ - ... ≤ (∥f∥ * ∥m 0∥) * ∏ i, ∥(tail m) i∥ : + ‖f (m 0) (tail m)‖ ≤ ‖f (m 0)‖ * ∏ i, ‖(tail m) i‖ : (f (m 0)).le_op_norm _ + ... ≤ (‖f‖ * ‖m 0‖) * ∏ i, ‖(tail m) i‖ : mul_le_mul_of_nonneg_right (f.le_op_norm _) (prod_nonneg (λi hi, norm_nonneg _)) - ... = ∥f∥ * (∥m 0∥ * ∏ i, ∥(tail m) i∥) : by ring - ... = ∥f∥ * ∏ i, ∥m i∥ : by { rw prod_univ_succ, refl } + ... = ‖f‖ * (‖m 0‖ * ∏ i, ‖(tail m) i‖) : by ring + ... = ‖f‖ * ∏ i, ‖m i‖ : by { rw prod_univ_succ, refl } lemma continuous_multilinear_map.norm_map_init_le (f : continuous_multilinear_map 𝕜 (λ(i : fin n), Ei i.cast_succ) (Ei (last n) →L[𝕜] G)) (m : Πi, Ei i) : - ∥f (init m) (m (last n))∥ ≤ ∥f∥ * ∏ i, ∥m i∥ := + ‖f (init m) (m (last n))‖ ≤ ‖f‖ * ∏ i, ‖m i‖ := calc - ∥f (init m) (m (last n))∥ ≤ ∥f (init m)∥ * ∥m (last n)∥ : (f (init m)).le_op_norm _ - ... ≤ (∥f∥ * (∏ i, ∥(init m) i∥)) * ∥m (last n)∥ : + ‖f (init m) (m (last n))‖ ≤ ‖f (init m)‖ * ‖m (last n)‖ : (f (init m)).le_op_norm _ + ... ≤ (‖f‖ * (∏ i, ‖(init m) i‖)) * ‖m (last n)‖ : mul_le_mul_of_nonneg_right (f.le_op_norm _) (norm_nonneg _) - ... = ∥f∥ * ((∏ i, ∥(init m) i∥) * ∥m (last n)∥) : mul_assoc _ _ _ - ... = ∥f∥ * ∏ i, ∥m i∥ : by { rw prod_univ_cast_succ, refl } + ... = ‖f‖ * ((∏ i, ‖(init m) i‖) * ‖m (last n)‖) : mul_assoc _ _ _ + ... = ‖f‖ * ∏ i, ‖m i‖ : by { rw prod_univ_cast_succ, refl } lemma continuous_multilinear_map.norm_map_cons_le (f : continuous_multilinear_map 𝕜 Ei G) (x : Ei 0) (m : Π(i : fin n), Ei i.succ) : - ∥f (cons x m)∥ ≤ ∥f∥ * ∥x∥ * ∏ i, ∥m i∥ := + ‖f (cons x m)‖ ≤ ‖f‖ * ‖x‖ * ∏ i, ‖m i‖ := calc - ∥f (cons x m)∥ ≤ ∥f∥ * ∏ i, ∥cons x m i∥ : f.le_op_norm _ - ... = (∥f∥ * ∥x∥) * ∏ i, ∥m i∥ : by { rw prod_univ_succ, simp [mul_assoc] } + ‖f (cons x m)‖ ≤ ‖f‖ * ∏ i, ‖cons x m i‖ : f.le_op_norm _ + ... = (‖f‖ * ‖x‖) * ∏ i, ‖m i‖ : by { rw prod_univ_succ, simp [mul_assoc] } lemma continuous_multilinear_map.norm_map_snoc_le (f : continuous_multilinear_map 𝕜 Ei G) (m : Π(i : fin n), Ei i.cast_succ) (x : Ei (last n)) : - ∥f (snoc m x)∥ ≤ ∥f∥ * (∏ i, ∥m i∥) * ∥x∥ := + ‖f (snoc m x)‖ ≤ ‖f‖ * (∏ i, ‖m i‖) * ‖x‖ := calc - ∥f (snoc m x)∥ ≤ ∥f∥ * ∏ i, ∥snoc m x i∥ : f.le_op_norm _ - ... = ∥f∥ * (∏ i, ∥m i∥) * ∥x∥ : by { rw prod_univ_cast_succ, simp [mul_assoc] } + ‖f (snoc m x)‖ ≤ ‖f‖ * ∏ i, ‖snoc m x i‖ : f.le_op_norm _ + ... = ‖f‖ * (∏ i, ‖m i‖) * ‖x‖ : by { rw prod_univ_cast_succ, simp [mul_assoc] } /-! #### Left currying -/ @@ -1012,7 +1200,7 @@ def continuous_linear_map.uncurry_left continuous_multilinear_map 𝕜 Ei G := (@linear_map.uncurry_left 𝕜 n Ei G _ _ _ _ _ (continuous_multilinear_map.to_multilinear_map_linear.comp f.to_linear_map)).mk_continuous - (∥f∥) (λm, continuous_linear_map.norm_map_tail_le f m) + (‖f‖) (λm, continuous_linear_map.norm_map_tail_le f m) @[simp] lemma continuous_linear_map.uncurry_left_apply (f : Ei 0 →L[𝕜] (continuous_multilinear_map 𝕜 (λ(i : fin n), Ei i.succ) G)) (m : Πi, Ei i) : @@ -1028,11 +1216,11 @@ linear_map.mk_continuous { -- define a linear map into `n` continuous multilinear maps from an `n+1` continuous multilinear -- map to_fun := λx, (f.to_multilinear_map.curry_left x).mk_continuous - (∥f∥ * ∥x∥) (f.norm_map_cons_le x), + (‖f‖ * ‖x‖) (f.norm_map_cons_le x), map_add' := λx y, by { ext m, exact f.cons_add m x y }, map_smul' := λc x, by { ext m, exact f.cons_smul m c x } } -- then register its continuity thanks to its boundedness properties. -(∥f∥) (λx, multilinear_map.mk_continuous_norm_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _) +(‖f‖) (λx, multilinear_map.mk_continuous_norm_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _) @[simp] lemma continuous_multilinear_map.curry_left_apply (f : continuous_multilinear_map 𝕜 Ei G) (x : Ei 0) (m : Π(i : fin n), Ei i.succ) : @@ -1050,7 +1238,7 @@ end @[simp] lemma continuous_multilinear_map.uncurry_curry_left (f : continuous_multilinear_map 𝕜 Ei G) : f.curry_left.uncurry_left = f := -continuous_multilinear_map.to_multilinear_map_inj $ f.to_multilinear_map.uncurry_curry_left +continuous_multilinear_map.to_multilinear_map_injective $ f.to_multilinear_map.uncurry_curry_left variables (𝕜 Ei G) @@ -1086,12 +1274,12 @@ variables {𝕜 Ei G} (continuous_multilinear_curry_left_equiv 𝕜 Ei G).symm f x v = f (cons x v) := rfl @[simp] lemma continuous_multilinear_map.curry_left_norm - (f : continuous_multilinear_map 𝕜 Ei G) : ∥f.curry_left∥ = ∥f∥ := + (f : continuous_multilinear_map 𝕜 Ei G) : ‖f.curry_left‖ = ‖f‖ := (continuous_multilinear_curry_left_equiv 𝕜 Ei G).symm.norm_map f @[simp] lemma continuous_linear_map.uncurry_left_norm (f : Ei 0 →L[𝕜] (continuous_multilinear_map 𝕜 (λ(i : fin n), Ei i.succ) G)) : - ∥f.uncurry_left∥ = ∥f∥ := + ‖f.uncurry_left‖ = ‖f‖ := (continuous_multilinear_curry_left_equiv 𝕜 Ei G).norm_map f /-! #### Right currying -/ @@ -1104,10 +1292,10 @@ def continuous_multilinear_map.uncurry_right continuous_multilinear_map 𝕜 Ei G := let f' : multilinear_map 𝕜 (λ(i : fin n), Ei i.cast_succ) (Ei (last n) →ₗ[𝕜] G) := { to_fun := λ m, (f m).to_linear_map, - map_add' := λ m i x y, by simp, - map_smul' := λ m i c x, by simp } in + map_add' := λ _ m i x y, by simp, + map_smul' := λ _ m i c x, by simp } in (@multilinear_map.uncurry_right 𝕜 n Ei G _ _ _ _ _ f').mk_continuous - (∥f∥) (λm, f.norm_map_init_le m) + (‖f‖) (λm, f.norm_map_init_le m) @[simp] lemma continuous_multilinear_map.uncurry_right_apply (f : continuous_multilinear_map 𝕜 (λ(i : fin n), Ei i.cast_succ) (Ei (last n) →L[𝕜] G)) @@ -1122,10 +1310,10 @@ def continuous_multilinear_map.curry_right continuous_multilinear_map 𝕜 (λ i : fin n, Ei i.cast_succ) (Ei (last n) →L[𝕜] G) := let f' : multilinear_map 𝕜 (λ(i : fin n), Ei i.cast_succ) (Ei (last n) →L[𝕜] G) := { to_fun := λm, (f.to_multilinear_map.curry_right m).mk_continuous - (∥f∥ * ∏ i, ∥m i∥) $ λx, f.norm_map_snoc_le m x, - map_add' := λ m i x y, by { simp, refl }, - map_smul' := λ m i c x, by { simp, refl } } in -f'.mk_continuous (∥f∥) (λm, linear_map.mk_continuous_norm_le _ + (‖f‖ * ∏ i, ‖m i‖) $ λx, f.norm_map_snoc_le m x, + map_add' := λ _ m i x y, by { simp, refl }, + map_smul' := λ _ m i c x, by { simp, refl } } in +f'.mk_continuous (‖f‖) (λm, linear_map.mk_continuous_norm_le _ (mul_nonneg (norm_nonneg _) (prod_nonneg (λj hj, norm_nonneg _))) _) @[simp] lemma continuous_multilinear_map.curry_right_apply @@ -1207,12 +1395,12 @@ variables {n 𝕜 G Ei G'} (continuous_multilinear_curry_right_equiv' 𝕜 n G G').symm f v x = f (snoc v x) := rfl @[simp] lemma continuous_multilinear_map.curry_right_norm - (f : continuous_multilinear_map 𝕜 Ei G) : ∥f.curry_right∥ = ∥f∥ := + (f : continuous_multilinear_map 𝕜 Ei G) : ‖f.curry_right‖ = ‖f‖ := (continuous_multilinear_curry_right_equiv 𝕜 Ei G).symm.norm_map f @[simp] lemma continuous_multilinear_map.uncurry_right_norm (f : continuous_multilinear_map 𝕜 (λ i : fin n, Ei i.cast_succ) (Ei (last n) →L[𝕜] G)) : - ∥f.uncurry_right∥ = ∥f∥ := + ‖f.uncurry_right‖ = ‖f‖ := (continuous_multilinear_curry_right_equiv 𝕜 Ei G).norm_map f /-! @@ -1225,7 +1413,6 @@ isomorphic (and even isometric) to `E₂`. As this is the zeroth step in the con derivatives, we register this isomorphism. -/ section -local attribute [instance] unique.subsingleton variables {𝕜 G G'} @@ -1237,10 +1424,7 @@ variables (𝕜 G) /-- Associating to an element `x` of a vector space `E₂` the continuous multilinear map in `0` variables taking the (unique) value `x` -/ def continuous_multilinear_map.curry0 (x : G') : G [×0]→L[𝕜] G' := -{ to_fun := λm, x, - map_add' := λ m i, fin.elim0 i, - map_smul' := λ m i, fin.elim0 i, - cont := continuous_const } +continuous_multilinear_map.const_of_is_empty 𝕜 _ x variable {G} @[simp] lemma continuous_multilinear_map.curry0_apply (x : G') (m : (fin 0) → G) : @@ -1263,26 +1447,22 @@ variables (𝕜 G) (continuous_multilinear_map.curry0 𝕜 G x).uncurry0 = x := rfl @[simp] lemma continuous_multilinear_map.curry0_norm (x : G') : - ∥continuous_multilinear_map.curry0 𝕜 G x∥ = ∥x∥ := -begin - apply le_antisymm, - { exact continuous_multilinear_map.op_norm_le_bound _ (norm_nonneg _) (λm, by simp) }, - { simpa using (continuous_multilinear_map.curry0 𝕜 G x).le_op_norm 0 } -end + ‖continuous_multilinear_map.curry0 𝕜 G x‖ = ‖x‖ := +norm_const_of_is_empty _ _ _ variables {𝕜 G} @[simp] lemma continuous_multilinear_map.fin0_apply_norm (f : G [×0]→L[𝕜] G') {x : fin 0 → G} : - ∥f x∥ = ∥f∥ := + ‖f x‖ = ‖f‖ := begin obtain rfl : x = 0 := subsingleton.elim _ _, refine le_antisymm (by simpa using f.le_op_norm 0) _, - have : ∥continuous_multilinear_map.curry0 𝕜 G (f.uncurry0)∥ ≤ ∥f.uncurry0∥ := + have : ‖continuous_multilinear_map.curry0 𝕜 G (f.uncurry0)‖ ≤ ‖f.uncurry0‖ := continuous_multilinear_map.op_norm_le_bound _ (norm_nonneg _) (λm, by simp [-continuous_multilinear_map.apply_zero_curry0]), simpa end -lemma continuous_multilinear_map.uncurry0_norm (f : G [×0]→L[𝕜] G') : ∥f.uncurry0∥ = ∥f∥ := +lemma continuous_multilinear_map.uncurry0_norm (f : G [×0]→L[𝕜] G') : ‖f.uncurry0‖ = ‖f‖ := by simp variables (𝕜 G G') @@ -1333,35 +1513,32 @@ namespace continuous_multilinear_map variables (𝕜 G G') +-- fails to unify without `@`; TODO: try again in Lean 4 +@[simp] theorem norm_dom_dom_congr (σ : ι ≃ ι') (f : continuous_multilinear_map 𝕜 (λ _ : ι, G) G') : + ‖@dom_dom_congr 𝕜 ι G G' _ _ _ _ _ _ _ ι' σ f‖ = ‖f‖ := +by simp only [norm_def, linear_equiv.coe_mk, ← σ.prod_comp, + (σ.arrow_congr (equiv.refl G)).surjective.forall, dom_dom_congr_apply, equiv.arrow_congr_apply, + equiv.coe_refl, comp.left_id, comp_app, equiv.symm_apply_apply, id] + /-- An equivalence of the index set defines a linear isometric equivalence between the spaces of multilinear maps. -/ -def dom_dom_congr (σ : ι ≃ ι') : +def dom_dom_congrₗᵢ (σ : ι ≃ ι') : continuous_multilinear_map 𝕜 (λ _ : ι, G) G' ≃ₗᵢ[𝕜] continuous_multilinear_map 𝕜 (λ _ : ι', G) G' := -linear_isometry_equiv.of_bounds - { to_fun := λ f, (multilinear_map.dom_dom_congr σ f.to_multilinear_map).mk_continuous ∥f∥ $ - λ m, (f.le_op_norm (λ i, m (σ i))).trans_eq $ by rw [← σ.prod_comp], - inv_fun := λ f, (multilinear_map.dom_dom_congr σ.symm f.to_multilinear_map).mk_continuous ∥f∥ $ - λ m, (f.le_op_norm (λ i, m (σ.symm i))).trans_eq $ by rw [← σ.symm.prod_comp], - left_inv := λ f, ext $ λ m, congr_arg f $ by simp only [σ.symm_apply_apply], - right_inv := λ f, ext $ λ m, congr_arg f $ by simp only [σ.apply_symm_apply], - map_add' := λ f g, rfl, - map_smul' := λ c f, rfl } - (λ f, multilinear_map.mk_continuous_norm_le _ (norm_nonneg f) _) - (λ f, multilinear_map.mk_continuous_norm_le _ (norm_nonneg f) _) - + { map_add' := λ _ _, rfl, + map_smul' := λ _ _, rfl, + norm_map' := norm_dom_dom_congr 𝕜 G G' σ, + .. dom_dom_congr_equiv σ } variables {𝕜 G G'} section -variable [decidable_eq (ι ⊕ ι')] - /-- A continuous multilinear map with variables indexed by `ι ⊕ ι'` defines a continuous multilinear map with variables indexed by `ι` taking values in the space of continuous multilinear maps with variables indexed by `ι'`. -/ def curry_sum (f : continuous_multilinear_map 𝕜 (λ x : ι ⊕ ι', G) G') : continuous_multilinear_map 𝕜 (λ x : ι, G) (continuous_multilinear_map 𝕜 (λ x : ι', G) G') := -multilinear_map.mk_continuous_multilinear (multilinear_map.curry_sum f.to_multilinear_map) (∥f∥) $ +multilinear_map.mk_continuous_multilinear (multilinear_map.curry_sum f.to_multilinear_map) (‖f‖) $ λ m m', by simpa [fintype.prod_sum_type, mul_assoc] using f.le_op_norm (sum.elim m m') @[simp] lemma curry_sum_apply (f : continuous_multilinear_map 𝕜 (λ x : ι ⊕ ι', G) G') @@ -1376,7 +1553,7 @@ def uncurry_sum (f : continuous_multilinear_map 𝕜 (λ x : ι, G) (continuous_multilinear_map 𝕜 (λ x : ι', G) G')) : continuous_multilinear_map 𝕜 (λ x : ι ⊕ ι', G) G' := multilinear_map.mk_continuous - (to_multilinear_map_linear.comp_multilinear_map f.to_multilinear_map).uncurry_sum (∥f∥) $ λ m, + (to_multilinear_map_linear.comp_multilinear_map f.to_multilinear_map).uncurry_sum (‖f‖) $ λ m, by simpa [fintype.prod_sum_type, mul_assoc] using (f (m ∘ sum.inl)).le_of_op_norm_le (m ∘ sum.inr) (f.le_op_norm _) @@ -1421,7 +1598,7 @@ values in the space of continuous multilinear maps of `l` variables. -/ def curry_fin_finset {k l n : ℕ} {s : finset (fin n)} (hk : s.card = k) (hl : sᶜ.card = l) : (G [×n]→L[𝕜] G') ≃ₗᵢ[𝕜] (G [×k]→L[𝕜] G [×l]→L[𝕜] G') := -(dom_dom_congr 𝕜 G G' (fin_sum_equiv_of_finset hk hl).symm).trans +(dom_dom_congrₗᵢ 𝕜 G G' (fin_sum_equiv_of_finset hk hl).symm).trans (curry_sum_equiv 𝕜 (fin k) (fin l) G G') variables {𝕜 G G'} diff --git a/src/analysis/normed_space/operator_norm.lean b/src/analysis/normed_space/operator_norm.lean index 487928749e3cc..6b39d840c5f70 100644 --- a/src/analysis/normed_space/operator_norm.lean +++ b/src/analysis/normed_space/operator_norm.lean @@ -5,17 +5,21 @@ Authors: Jan-David Salchow, Sébastien Gouëzel, Jean Lo -/ import algebra.algebra.tower import analysis.asymptotics.asymptotics +import analysis.normed_space.continuous_linear_map import analysis.normed_space.linear_isometry -import analysis.normed_space.riesz_lemma +import topology.algebra.module.strong_topology /-! # Operator norm on the space of continuous linear maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define the operator norm on the space of continuous (semi)linear maps between normed spaces, and prove its basic properties. In particular, show that this space is itself a normed space. -Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the -theory for `semi_normed_group` and we specialize to `normed_group` at the end. +Since a lot of elementary properties don't require `‖x‖ = 0 → x = 0` we start setting up the +theory for `seminormed_add_comm_group` and we specialize to `normed_add_comm_group` at the end. Note that most of statements that apply to semilinear maps only hold when the ring homomorphism is isometric, as expressed by the typeclass `[ring_hom_isometric σ]`. @@ -23,123 +27,34 @@ is isometric, as expressed by the typeclass `[ring_hom_isometric σ]`. -/ noncomputable theory -open_locale classical nnreal topological_space +open_locale classical nnreal topology -- the `ₗ` subscript variables are for special cases about linear (as opposed to semilinear) maps -variables {𝕜 𝕜₂ 𝕜₃ E Eₗ F Fₗ G Gₗ : Type*} +variables {𝕜 𝕜₂ 𝕜₃ E Eₗ F Fₗ G Gₗ 𝓕 : Type*} section semi_normed -variables [semi_normed_group E] [semi_normed_group Eₗ] [semi_normed_group F] [semi_normed_group Fₗ] -variables [semi_normed_group G] [semi_normed_group Gₗ] - open metric continuous_linear_map -section normed_field -/-! Most statements in this file require the field to be non-discrete, -as this is necessary to deduce an inequality `∥f x∥ ≤ C ∥x∥` from the continuity of f. -However, the other direction always holds. -In this section, we just assume that `𝕜` is a normed field. -In the remainder of the file, it will be non-discrete. -/ - -variables [normed_field 𝕜] [normed_field 𝕜₂] [normed_space 𝕜 E] [normed_space 𝕜₂ F] -variables [normed_space 𝕜 G] {σ : 𝕜 →+* 𝕜₂} (f : E →ₛₗ[σ] F) - -lemma linear_map.lipschitz_of_bound (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - lipschitz_with (real.to_nnreal C) f := -f.to_add_monoid_hom.lipschitz_of_bound C h - -lemma linear_map.lipschitz_of_bound_nnnorm (C : ℝ≥0) (h : ∀ x, ∥f x∥₊ ≤ C * ∥x∥₊) : - lipschitz_with C f := -f.to_add_monoid_hom.lipschitz_of_bound_nnnorm C h - -theorem linear_map.antilipschitz_of_bound {K : ℝ≥0} (h : ∀ x, ∥x∥ ≤ K * ∥f x∥) : - antilipschitz_with K f := -antilipschitz_with.of_le_mul_dist $ -λ x y, by simpa only [dist_eq_norm, f.map_sub] using h (x - y) - -lemma linear_map.bound_of_antilipschitz {K : ℝ≥0} (h : antilipschitz_with K f) (x) : - ∥x∥ ≤ K * ∥f x∥ := -by simpa only [dist_zero_right, f.map_zero] using h.le_mul_dist x 0 - -lemma linear_map.uniform_continuous_of_bound (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - uniform_continuous f := -(f.lipschitz_of_bound C h).uniform_continuous - -lemma linear_map.continuous_of_bound (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - continuous f := -(f.lipschitz_of_bound C h).continuous - -/-- Construct a continuous linear map from a linear map and a bound on this linear map. -The fact that the norm of the continuous linear map is then controlled is given in -`linear_map.mk_continuous_norm_le`. -/ -def linear_map.mk_continuous (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : E →SL[σ] F := -⟨f, linear_map.continuous_of_bound f C h⟩ - -/-- Reinterpret a linear map `𝕜 →ₗ[𝕜] E` as a continuous linear map. This construction -is generalized to the case of any finite dimensional domain -in `linear_map.to_continuous_linear_map`. -/ -def linear_map.to_continuous_linear_map₁ (f : 𝕜 →ₗ[𝕜] E) : 𝕜 →L[𝕜] E := -f.mk_continuous (∥f 1∥) $ λ x, le_of_eq $ -by { conv_lhs { rw ← mul_one x }, rw [← smul_eq_mul, f.map_smul, norm_smul, mul_comm] } - -/-- Construct a continuous linear map from a linear map and the existence of a bound on this linear -map. If you have an explicit bound, use `linear_map.mk_continuous` instead, as a norm estimate will -follow automatically in `linear_map.mk_continuous_norm_le`. -/ -def linear_map.mk_continuous_of_exists_bound (h : ∃C, ∀x, ∥f x∥ ≤ C * ∥x∥) : E →SL[σ] F := -⟨f, let ⟨C, hC⟩ := h in linear_map.continuous_of_bound f C hC⟩ - -lemma continuous_of_linear_of_boundₛₗ {f : E → F} (h_add : ∀ x y, f (x + y) = f x + f y) - (h_smul : ∀ (c : 𝕜) x, f (c • x) = (σ c) • f x) {C : ℝ} (h_bound : ∀ x, ∥f x∥ ≤ C*∥x∥) : - continuous f := -let φ : E →ₛₗ[σ] F := { to_fun := f, map_add' := h_add, map_smul' := h_smul } in -φ.continuous_of_bound C h_bound - -lemma continuous_of_linear_of_bound {f : E → G} (h_add : ∀ x y, f (x + y) = f x + f y) - (h_smul : ∀ (c : 𝕜) x, f (c • x) = c • f x) {C : ℝ} (h_bound : ∀ x, ∥f x∥ ≤ C*∥x∥) : - continuous f := -let φ : E →ₗ[𝕜] G := { to_fun := f, map_add' := h_add, map_smul' := h_smul } in -φ.continuous_of_bound C h_bound - -@[simp, norm_cast] lemma linear_map.mk_continuous_coe (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - ((f.mk_continuous C h) : E →ₛₗ[σ] F) = f := rfl - -@[simp] lemma linear_map.mk_continuous_apply (C : ℝ) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) (x : E) : - f.mk_continuous C h x = f x := rfl - -@[simp, norm_cast] lemma linear_map.mk_continuous_of_exists_bound_coe - (h : ∃C, ∀x, ∥f x∥ ≤ C * ∥x∥) : - ((f.mk_continuous_of_exists_bound h) : E →ₛₗ[σ] F) = f := rfl - -@[simp] lemma linear_map.mk_continuous_of_exists_bound_apply (h : ∃C, ∀x, ∥f x∥ ≤ C * ∥x∥) (x : E) : - f.mk_continuous_of_exists_bound h x = f x := rfl - -@[simp] lemma linear_map.to_continuous_linear_map₁_coe (f : 𝕜 →ₗ[𝕜] E) : - (f.to_continuous_linear_map₁ : 𝕜 →ₗ[𝕜] E) = f := -rfl - -@[simp] lemma linear_map.to_continuous_linear_map₁_apply (f : 𝕜 →ₗ[𝕜] E) (x) : - f.to_continuous_linear_map₁ x = f x := -rfl - -end normed_field +variables [seminormed_add_comm_group E] [seminormed_add_comm_group Eₗ] [seminormed_add_comm_group F] + [seminormed_add_comm_group Fₗ] [seminormed_add_comm_group G] [seminormed_add_comm_group Gₗ] -variables [nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂] [nondiscrete_normed_field 𝕜₃] - [normed_space 𝕜 E] [normed_space 𝕜 Eₗ] [normed_space 𝕜₂ F] [normed_space 𝕜 Fₗ] - [normed_space 𝕜₃ G] [normed_space 𝕜 Gₗ] +variables [nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + [nontrivially_normed_field 𝕜₃] [normed_space 𝕜 E] [normed_space 𝕜 Eₗ] [normed_space 𝕜₂ F] + [normed_space 𝕜 Fₗ] [normed_space 𝕜₃ G] [normed_space 𝕜 Gₗ] {σ₁₂ : 𝕜 →+* 𝕜₂} {σ₂₃ : 𝕜₂ →+* 𝕜₃} {σ₁₃ : 𝕜 →+* 𝕜₃} [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] -/-- If `∥x∥ = 0` and `f` is continuous then `∥f x∥ = 0`. -/ -lemma norm_image_of_norm_zero {f : E →ₛₗ[σ₁₂] F} (hf : continuous f) {x : E} (hx : ∥x∥ = 0) : - ∥f x∥ = 0 := +/-- If `‖x‖ = 0` and `f` is continuous then `‖f x‖ = 0`. -/ +lemma norm_image_of_norm_zero [semilinear_map_class 𝓕 σ₁₂ E F] (f : 𝓕) + (hf : continuous f) {x : E} (hx : ‖x‖ = 0) : ‖f x‖ = 0 := begin refine le_antisymm (le_of_forall_pos_le_add (λ ε hε, _)) (norm_nonneg (f x)), - rcases normed_group.tendsto_nhds_nhds.1 (hf.tendsto 0) ε hε with ⟨δ, δ_pos, hδ⟩, + rcases normed_add_comm_group.tendsto_nhds_nhds.1 (hf.tendsto 0) ε hε with ⟨δ, δ_pos, hδ⟩, replace hδ := hδ x, rw [sub_zero, hx] at hδ, replace hδ := le_of_lt (hδ δ_pos), - rw [linear_map.map_zero, sub_zero] at hδ, + rw [map_zero, sub_zero] at hδ, rwa [zero_add] end @@ -147,32 +62,33 @@ section variables [ring_hom_isometric σ₁₂] [ring_hom_isometric σ₂₃] -lemma linear_map.bound_of_shell_semi_normed (f : E →ₛₗ[σ₁₂] F) {ε C : ℝ} (ε_pos : 0 < ε) {c : 𝕜} - (hc : 1 < ∥c∥) (hf : ∀ x, ε / ∥c∥ ≤ ∥x∥ → ∥x∥ < ε → ∥f x∥ ≤ C * ∥x∥) {x : E} (hx : ∥x∥ ≠ 0) : - ∥f x∥ ≤ C * ∥x∥ := +lemma semilinear_map_class.bound_of_shell_semi_normed [semilinear_map_class 𝓕 σ₁₂ E F] + (f : 𝓕) {ε C : ℝ} (ε_pos : 0 < ε) {c : 𝕜} (hc : 1 < ‖c‖) + (hf : ∀ x, ε / ‖c‖ ≤ ‖x‖ → ‖x‖ < ε → ‖f x‖ ≤ C * ‖x‖) {x : E} (hx : ‖x‖ ≠ 0) : + ‖f x‖ ≤ C * ‖x‖ := begin rcases rescale_to_shell_semi_normed hc ε_pos hx with ⟨δ, hδ, δxle, leδx, δinv⟩, have := hf (δ • x) leδx δxle, - simpa only [f.map_smulₛₗ, norm_smul, mul_left_comm C, mul_le_mul_left (norm_pos_iff.2 hδ), + simpa only [map_smulₛₗ, norm_smul, mul_left_comm C, mul_le_mul_left (norm_pos_iff.2 hδ), ring_hom_isometric.is_iso] using hf (δ • x) leδx δxle end -/-- A continuous linear map between seminormed spaces is bounded when the field is nondiscrete. The -continuity ensures boundedness on a ball of some radius `ε`. The nondiscreteness is then used to -rescale any element into an element of norm in `[ε/C, ε]`, whose image has a controlled norm. The -norm control for the original element follows by rescaling. -/ -lemma linear_map.bound_of_continuous (f : E →ₛₗ[σ₁₂] F) (hf : continuous f) : - ∃ C, 0 < C ∧ (∀ x : E, ∥f x∥ ≤ C * ∥x∥) := +/-- A continuous linear map between seminormed spaces is bounded when the field is nontrivially +normed. The continuity ensures boundedness on a ball of some radius `ε`. The nontriviality of the +norm is then used to rescale any element into an element of norm in `[ε/C, ε]`, whose image has a +controlled norm. The norm control for the original element follows by rescaling. -/ +lemma semilinear_map_class.bound_of_continuous [semilinear_map_class 𝓕 σ₁₂ E F] (f : 𝓕) + (hf : continuous f) : ∃ C, 0 < C ∧ (∀ x : E, ‖f x‖ ≤ C * ‖x‖) := begin - rcases normed_group.tendsto_nhds_nhds.1 (hf.tendsto 0) 1 zero_lt_one with ⟨ε, ε_pos, hε⟩, - simp only [sub_zero, f.map_zero] at hε, + rcases normed_add_comm_group.tendsto_nhds_nhds.1 (hf.tendsto 0) 1 zero_lt_one with ⟨ε, ε_pos, hε⟩, + simp only [sub_zero, map_zero] at hε, rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, - have : 0 < ∥c∥ / ε, from div_pos (zero_lt_one.trans hc) ε_pos, - refine ⟨∥c∥ / ε, this, λ x, _⟩, - by_cases hx : ∥x∥ = 0, + have : 0 < ‖c‖ / ε, from div_pos (zero_lt_one.trans hc) ε_pos, + refine ⟨‖c‖ / ε, this, λ x, _⟩, + by_cases hx : ‖x‖ = 0, { rw [hx, mul_zero], - exact le_of_eq (norm_image_of_norm_zero hf hx) }, - refine f.bound_of_shell_semi_normed ε_pos hc (λ x hle hlt, _) hx, + exact le_of_eq (norm_image_of_norm_zero f hf hx) }, + refine semilinear_map_class.bound_of_shell_semi_normed f ε_pos hc (λ x hle hlt, _) hx, refine (hε _ hlt).le.trans _, rwa [← div_le_iff' this, one_div_div] end @@ -182,60 +98,25 @@ end namespace continuous_linear_map theorem bound [ring_hom_isometric σ₁₂] (f : E →SL[σ₁₂] F) : - ∃ C, 0 < C ∧ (∀ x : E, ∥f x∥ ≤ C * ∥x∥) := -f.to_linear_map.bound_of_continuous f.2 + ∃ C, 0 < C ∧ (∀ x : E, ‖f x‖ ≤ C * ‖x‖) := +semilinear_map_class.bound_of_continuous f f.2 section open filter -/-- A linear map which is a homothety is a continuous linear map. - Since the field `𝕜` need not have `ℝ` as a subfield, this theorem is not directly deducible from - the corresponding theorem about isometries plus a theorem about scalar multiplication. Likewise - for the other theorems about homotheties in this file. - -/ -def of_homothety (f : E →ₛₗ[σ₁₂] F) (a : ℝ) (hf : ∀x, ∥f x∥ = a * ∥x∥) : E →SL[σ₁₂] F := -f.mk_continuous a (λ x, le_of_eq (hf x)) - -variable (𝕜) - -lemma to_span_singleton_homothety (x : E) (c : 𝕜) : - ∥linear_map.to_span_singleton 𝕜 E x c∥ = ∥x∥ * ∥c∥ := -by {rw mul_comm, exact norm_smul _ _} - -/-- Given an element `x` of a normed space `E` over a field `𝕜`, the natural continuous - linear map from `𝕜` to `E` by taking multiples of `x`.-/ -def to_span_singleton (x : E) : 𝕜 →L[𝕜] E := -of_homothety (linear_map.to_span_singleton 𝕜 E x) ∥x∥ (to_span_singleton_homothety 𝕜 x) - -lemma to_span_singleton_apply (x : E) (r : 𝕜) : to_span_singleton 𝕜 x r = r • x := -by simp [to_span_singleton, of_homothety, linear_map.to_span_singleton] - -lemma to_span_singleton_add (x y : E) : - to_span_singleton 𝕜 (x + y) = to_span_singleton 𝕜 x + to_span_singleton 𝕜 y := -by { ext1, simp [to_span_singleton_apply], } - -lemma to_span_singleton_smul' (𝕜') [normed_field 𝕜'] [normed_space 𝕜' E] - [smul_comm_class 𝕜 𝕜' E] (c : 𝕜') (x : E) : - to_span_singleton 𝕜 (c • x) = c • to_span_singleton 𝕜 x := -by { ext1, rw [to_span_singleton_apply, smul_apply, to_span_singleton_apply, smul_comm], } - -lemma to_span_singleton_smul (c : 𝕜) (x : E) : - to_span_singleton 𝕜 (c • x) = c • to_span_singleton 𝕜 x := -to_span_singleton_smul' 𝕜 𝕜 c x - variables (𝕜 E) /-- Given a unit-length element `x` of a normed space `E` over a field `𝕜`, the natural linear isometry map from `𝕜` to `E` by taking multiples of `x`.-/ -def _root_.linear_isometry.to_span_singleton {v : E} (hv : ∥v∥ = 1) : 𝕜 →ₗᵢ[𝕜] E := +def _root_.linear_isometry.to_span_singleton {v : E} (hv : ‖v‖ = 1) : 𝕜 →ₗᵢ[𝕜] E := { norm_map' := λ x, by simp [norm_smul, hv], .. linear_map.to_span_singleton 𝕜 E v } variables {𝕜 E} -@[simp] lemma _root_.linear_isometry.to_span_singleton_apply {v : E} (hv : ∥v∥ = 1) (a : 𝕜) : +@[simp] lemma _root_.linear_isometry.to_span_singleton_apply {v : E} (hv : ‖v‖ = 1) (a : 𝕜) : linear_isometry.to_span_singleton 𝕜 E hv a = a • v := rfl -@[simp] lemma _root_.linear_isometry.coe_to_span_singleton {v : E} (hv : ∥v∥ = 1) : +@[simp] lemma _root_.linear_isometry.coe_to_span_singleton {v : E} (hv : ‖v‖ = 1) : (linear_isometry.to_span_singleton 𝕜 E hv).to_linear_map = linear_map.to_span_singleton 𝕜 E v := rfl @@ -245,96 +126,89 @@ section op_norm open set real /-- The operator norm of a continuous linear map is the inf of all its bounds. -/ -def op_norm (f : E →SL[σ₁₂] F) := Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} +def op_norm (f : E →SL[σ₁₂] F) := Inf {c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖} instance has_op_norm : has_norm (E →SL[σ₁₂] F) := ⟨op_norm⟩ -lemma norm_def (f : E →SL[σ₁₂] F) : ∥f∥ = Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} := rfl +lemma norm_def (f : E →SL[σ₁₂] F) : ‖f‖ = Inf {c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖} := rfl -- So that invocations of `le_cInf` make sense: we show that the set of -- bounds is nonempty and bounded below. lemma bounds_nonempty [ring_hom_isometric σ₁₂] {f : E →SL[σ₁₂] F} : - ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥ } := + ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖ } := let ⟨M, hMp, hMb⟩ := f.bound in ⟨M, le_of_lt hMp, hMb⟩ lemma bounds_bdd_below {f : E →SL[σ₁₂] F} : - bdd_below { c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥ } := + bdd_below { c | 0 ≤ c ∧ ∀ x, ‖f x‖ ≤ c * ‖x‖ } := ⟨0, λ _ ⟨hn, _⟩, hn⟩ /-- If one controls the norm of every `A x`, then one controls the norm of `A`. -/ -lemma op_norm_le_bound (f : E →SL[σ₁₂] F) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ∥f x∥ ≤ M * ∥x∥) : - ∥f∥ ≤ M := +lemma op_norm_le_bound (f : E →SL[σ₁₂] F) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ‖f x‖ ≤ M * ‖x‖) : + ‖f‖ ≤ M := cInf_le bounds_bdd_below ⟨hMp, hM⟩ +/-- If one controls the norm of every `A x`, `‖x‖ ≠ 0`, then one controls the norm of `A`. -/ +lemma op_norm_le_bound' (f : E →SL[σ₁₂] F) {M : ℝ} (hMp: 0 ≤ M) + (hM : ∀ x, ‖x‖ ≠ 0 → ‖f x‖ ≤ M * ‖x‖) : + ‖f‖ ≤ M := +op_norm_le_bound f hMp $ λ x, (ne_or_eq (‖x‖) 0).elim (hM x) $ + λ h, by simp only [h, mul_zero, norm_image_of_norm_zero f f.2 h] + theorem op_norm_le_of_lipschitz {f : E →SL[σ₁₂] F} {K : ℝ≥0} (hf : lipschitz_with K f) : - ∥f∥ ≤ K := + ‖f‖ ≤ K := f.op_norm_le_bound K.2 $ λ x, by simpa only [dist_zero_right, f.map_zero] using hf.dist_le_mul x 0 lemma op_norm_eq_of_bounds {φ : E →SL[σ₁₂] F} {M : ℝ} (M_nonneg : 0 ≤ M) - (h_above : ∀ x, ∥φ x∥ ≤ M*∥x∥) (h_below : ∀ N ≥ 0, (∀ x, ∥φ x∥ ≤ N*∥x∥) → M ≤ N) : - ∥φ∥ = M := + (h_above : ∀ x, ‖φ x‖ ≤ M*‖x‖) (h_below : ∀ N ≥ 0, (∀ x, ‖φ x‖ ≤ N*‖x‖) → M ≤ N) : + ‖φ‖ = M := le_antisymm (φ.op_norm_le_bound M_nonneg h_above) ((le_cInf_iff continuous_linear_map.bounds_bdd_below ⟨M, M_nonneg, h_above⟩).mpr $ λ N ⟨N_nonneg, hN⟩, h_below N N_nonneg hN) -lemma op_norm_neg (f : E →SL[σ₁₂] F) : ∥-f∥ = ∥f∥ := by simp only [norm_def, neg_apply, norm_neg] - -theorem antilipschitz_of_bound (f : E →SL[σ₁₂] F) {K : ℝ≥0} (h : ∀ x, ∥x∥ ≤ K * ∥f x∥) : - antilipschitz_with K f := -linear_map.antilipschitz_of_bound _ h - -lemma bound_of_antilipschitz (f : E →SL[σ₁₂] F) {K : ℝ≥0} (h : antilipschitz_with K f) (x) : - ∥x∥ ≤ K * ∥f x∥ := -linear_map.bound_of_antilipschitz _ h x +lemma op_norm_neg (f : E →SL[σ₁₂] F) : ‖-f‖ = ‖f‖ := by simp only [norm_def, neg_apply, norm_neg] section variables [ring_hom_isometric σ₁₂] [ring_hom_isometric σ₂₃] (f g : E →SL[σ₁₂] F) (h : F →SL[σ₂₃] G) (x : E) -lemma op_norm_nonneg : 0 ≤ ∥f∥ := +lemma op_norm_nonneg : 0 ≤ ‖f‖ := le_cInf bounds_nonempty (λ _ ⟨hx, _⟩, hx) -/-- The fundamental property of the operator norm: `∥f x∥ ≤ ∥f∥ * ∥x∥`. -/ -theorem le_op_norm : ∥f x∥ ≤ ∥f∥ * ∥x∥ := +/-- The fundamental property of the operator norm: `‖f x‖ ≤ ‖f‖ * ‖x‖`. -/ +theorem le_op_norm : ‖f x‖ ≤ ‖f‖ * ‖x‖ := begin obtain ⟨C, Cpos, hC⟩ := f.bound, replace hC := hC x, - by_cases h : ∥x∥ = 0, + by_cases h : ‖x‖ = 0, { rwa [h, mul_zero] at ⊢ hC }, - have hlt : 0 < ∥x∥ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h), + have hlt : 0 < ‖x‖ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h), exact (div_le_iff hlt).mp (le_cInf bounds_nonempty (λ c ⟨_, hc⟩, (div_le_iff hlt).mpr $ by { apply hc })), end -theorem dist_le_op_norm (x y : E) : dist (f x) (f y) ≤ ∥f∥ * dist x y := +theorem dist_le_op_norm (x y : E) : dist (f x) (f y) ≤ ‖f‖ * dist x y := by simp_rw [dist_eq_norm, ← map_sub, f.le_op_norm] -theorem le_op_norm_of_le {c : ℝ} {x} (h : ∥x∥ ≤ c) : ∥f x∥ ≤ ∥f∥ * c := +theorem le_op_norm_of_le {c : ℝ} {x} (h : ‖x‖ ≤ c) : ‖f x‖ ≤ ‖f‖ * c := le_trans (f.le_op_norm x) (mul_le_mul_of_nonneg_left h f.op_norm_nonneg) -theorem le_of_op_norm_le {c : ℝ} (h : ∥f∥ ≤ c) (x : E) : ∥f x∥ ≤ c * ∥x∥ := +theorem le_of_op_norm_le {c : ℝ} (h : ‖f‖ ≤ c) (x : E) : ‖f x‖ ≤ c * ‖x‖ := (f.le_op_norm x).trans (mul_le_mul_of_nonneg_right h (norm_nonneg x)) -lemma ratio_le_op_norm : ∥f x∥ / ∥x∥ ≤ ∥f∥ := +lemma ratio_le_op_norm : ‖f x‖ / ‖x‖ ≤ ‖f‖ := div_le_of_nonneg_of_le_mul (norm_nonneg _) f.op_norm_nonneg (le_op_norm _ _) /-- The image of the unit ball under a continuous linear map is bounded. -/ -lemma unit_le_op_norm : ∥x∥ ≤ 1 → ∥f x∥ ≤ ∥f∥ := -mul_one ∥f∥ ▸ f.le_op_norm_of_le +lemma unit_le_op_norm : ‖x‖ ≤ 1 → ‖f x‖ ≤ ‖f‖ := +mul_one ‖f‖ ▸ f.le_op_norm_of_le lemma op_norm_le_of_shell {f : E →SL[σ₁₂] F} {ε C : ℝ} (ε_pos : 0 < ε) (hC : 0 ≤ C) - {c : 𝕜} (hc : 1 < ∥c∥) (hf : ∀ x, ε / ∥c∥ ≤ ∥x∥ → ∥x∥ < ε → ∥f x∥ ≤ C * ∥x∥) : - ∥f∥ ≤ C := -begin - refine f.op_norm_le_bound hC (λ x, _), - by_cases hx : ∥x∥ = 0, - { rw [hx, mul_zero], - exact le_of_eq (norm_image_of_norm_zero f.2 hx) }, - exact linear_map.bound_of_shell_semi_normed f ε_pos hc hf hx -end + {c : 𝕜} (hc : 1 < ‖c‖) (hf : ∀ x, ε / ‖c‖ ≤ ‖x‖ → ‖x‖ < ε → ‖f x‖ ≤ C * ‖x‖) : + ‖f‖ ≤ C := +f.op_norm_le_bound' hC $ λ x hx, semilinear_map_class.bound_of_shell_semi_normed f ε_pos hc hf hx lemma op_norm_le_of_ball {f : E →SL[σ₁₂] F} {ε : ℝ} {C : ℝ} (ε_pos : 0 < ε) (hC : 0 ≤ C) - (hf : ∀ x ∈ ball (0 : E) ε, ∥f x∥ ≤ C * ∥x∥) : ∥f∥ ≤ C := + (hf : ∀ x ∈ ball (0 : E) ε, ‖f x‖ ≤ C * ‖x‖) : ‖f‖ ≤ C := begin rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, refine op_norm_le_of_shell ε_pos hC hc (λ x _ hx, hf x _), @@ -342,12 +216,12 @@ begin end lemma op_norm_le_of_nhds_zero {f : E →SL[σ₁₂] F} {C : ℝ} (hC : 0 ≤ C) - (hf : ∀ᶠ x in 𝓝 (0 : E), ∥f x∥ ≤ C * ∥x∥) : ∥f∥ ≤ C := + (hf : ∀ᶠ x in 𝓝 (0 : E), ‖f x‖ ≤ C * ‖x‖) : ‖f‖ ≤ C := let ⟨ε, ε0, hε⟩ := metric.eventually_nhds_iff_ball.1 hf in op_norm_le_of_ball ε0 hC hε lemma op_norm_le_of_shell' {f : E →SL[σ₁₂] F} {ε C : ℝ} (ε_pos : 0 < ε) (hC : 0 ≤ C) - {c : 𝕜} (hc : ∥c∥ < 1) (hf : ∀ x, ε * ∥c∥ ≤ ∥x∥ → ∥x∥ < ε → ∥f x∥ ≤ C * ∥x∥) : - ∥f∥ ≤ C := + {c : 𝕜} (hc : ‖c‖ < 1) (hf : ∀ x, ε * ‖c‖ ≤ ‖x‖ → ‖x‖ < ε → ‖f x‖ ≤ C * ‖x‖) : + ‖f‖ ≤ C := begin by_cases h0 : c = 0, { refine op_norm_le_of_ball ε_pos hC (λ x hx, hf x _ _), @@ -359,31 +233,43 @@ begin rwa [norm_inv, div_eq_mul_inv, inv_inv] } end +/-- For a continuous real linear map `f`, if one controls the norm of every `f x`, `‖x‖ = 1`, then +one controls the norm of `f`. -/ +lemma op_norm_le_of_unit_norm [normed_space ℝ E] [normed_space ℝ F] {f : E →L[ℝ] F} {C : ℝ} + (hC : 0 ≤ C) (hf : ∀ x, ‖x‖ = 1 → ‖f x‖ ≤ C) : ‖f‖ ≤ C := +begin + refine op_norm_le_bound' f hC (λ x hx, _), + have H₁ : ‖(‖x‖⁻¹ • x)‖ = 1, by rw [norm_smul, norm_inv, norm_norm, inv_mul_cancel hx], + have H₂ := hf _ H₁, + rwa [map_smul, norm_smul, norm_inv, norm_norm, ← div_eq_inv_mul, div_le_iff] at H₂, + exact (norm_nonneg x).lt_of_ne' hx +end + /-- The operator norm satisfies the triangle inequality. -/ -theorem op_norm_add_le : ∥f + g∥ ≤ ∥f∥ + ∥g∥ := +theorem op_norm_add_le : ‖f + g‖ ≤ ‖f‖ + ‖g‖ := (f + g).op_norm_le_bound (add_nonneg f.op_norm_nonneg g.op_norm_nonneg) $ λ x, (norm_add_le_of_le (f.le_op_norm x) (g.le_op_norm x)).trans_eq (add_mul _ _ _).symm /-- The norm of the `0` operator is `0`. -/ -theorem op_norm_zero : ∥(0 : E →SL[σ₁₂] F)∥ = 0 := +theorem op_norm_zero : ‖(0 : E →SL[σ₁₂] F)‖ = 0 := le_antisymm (cInf_le bounds_bdd_below ⟨le_rfl, λ _, le_of_eq (by { rw [zero_mul], exact norm_zero })⟩) (op_norm_nonneg _) /-- The norm of the identity is at most `1`. It is in fact `1`, except when the space is trivial where it is `0`. It means that one can not do better than an inequality in general. -/ -lemma norm_id_le : ∥id 𝕜 E∥ ≤ 1 := +lemma norm_id_le : ‖id 𝕜 E‖ ≤ 1 := op_norm_le_bound _ zero_le_one (λx, by simp) /-- If there is an element with norm different from `0`, then the norm of the identity equals `1`. (Since we are working with seminorms supposing that the space is non-trivial is not enough.) -/ -lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : E), ∥x∥ ≠ 0) : ∥id 𝕜 E∥ = 1 := +lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : E), ‖x‖ ≠ 0) : ‖id 𝕜 E‖ = 1 := le_antisymm norm_id_le $ let ⟨x, hx⟩ := h in have _ := (id 𝕜 E).ratio_le_op_norm x, by rwa [id_apply, div_self hx] at this lemma op_norm_smul_le {𝕜' : Type*} [normed_field 𝕜'] [normed_space 𝕜' F] - [smul_comm_class 𝕜₂ 𝕜' F] (c : 𝕜') (f : E →SL[σ₁₂] F) : ∥c • f∥ ≤ ∥c∥ * ∥f∥ := + [smul_comm_class 𝕜₂ 𝕜' F] (c : 𝕜') (f : E →SL[σ₁₂] F) : ‖c • f‖ ≤ ‖c‖ * ‖f‖ := ((c • f).op_norm_le_bound (mul_nonneg (norm_nonneg _) (op_norm_nonneg _)) (λ _, begin @@ -391,12 +277,101 @@ lemma op_norm_smul_le {𝕜' : Type*} [normed_field 𝕜'] [normed_space 𝕜' F exact mul_le_mul_of_nonneg_left (le_op_norm _ _) (norm_nonneg _) end)) +/-- Continuous linear maps themselves form a seminormed space with respect to +the operator norm. This is only a temporary definition because we want to replace the topology +with `continuous_linear_map.topological_space` to avoid diamond issues. +See Note [forgetful inheritance] -/ +protected def tmp_seminormed_add_comm_group : seminormed_add_comm_group (E →SL[σ₁₂] F) := +add_group_seminorm.to_seminormed_add_comm_group +{ to_fun := norm, + map_zero' := op_norm_zero, + add_le' := op_norm_add_le, + neg' := op_norm_neg } + +/-- The `pseudo_metric_space` structure on `E →SL[σ₁₂] F` coming from +`continuous_linear_map.tmp_seminormed_add_comm_group`. +See Note [forgetful inheritance] -/ +protected def tmp_pseudo_metric_space : pseudo_metric_space (E →SL[σ₁₂] F) := +continuous_linear_map.tmp_seminormed_add_comm_group.to_pseudo_metric_space + +/-- The `uniform_space` structure on `E →SL[σ₁₂] F` coming from +`continuous_linear_map.tmp_seminormed_add_comm_group`. +See Note [forgetful inheritance] -/ +protected def tmp_uniform_space : uniform_space (E →SL[σ₁₂] F) := +continuous_linear_map.tmp_pseudo_metric_space.to_uniform_space + +/-- The `topological_space` structure on `E →SL[σ₁₂] F` coming from +`continuous_linear_map.tmp_seminormed_add_comm_group`. +See Note [forgetful inheritance] -/ +protected def tmp_topological_space : topological_space (E →SL[σ₁₂] F) := +continuous_linear_map.tmp_uniform_space.to_topological_space + +section tmp + +local attribute [-instance] continuous_linear_map.topological_space +local attribute [-instance] continuous_linear_map.uniform_space +local attribute [instance] continuous_linear_map.tmp_seminormed_add_comm_group + +protected lemma tmp_topological_add_group : topological_add_group (E →SL[σ₁₂] F) := +infer_instance + +protected lemma tmp_closed_ball_div_subset {a b : ℝ} (ha : 0 < a) (hb : 0 < b) : + closed_ball (0 : E →SL[σ₁₂] F) (a / b) ⊆ + {f | ∀ x ∈ closed_ball (0 : E) b, f x ∈ closed_ball (0 : F) a} := +begin + intros f hf x hx, + rw mem_closed_ball_zero_iff at ⊢ hf hx, + calc ‖f x‖ + ≤ ‖f‖ * ‖x‖ : le_op_norm _ _ + ... ≤ (a/b) * b : mul_le_mul hf hx (norm_nonneg _) (div_pos ha hb).le + ... = a : div_mul_cancel a hb.ne.symm +end + +end tmp + +protected theorem tmp_topology_eq : + (continuous_linear_map.tmp_topological_space : topological_space (E →SL[σ₁₂] F)) = + continuous_linear_map.topological_space := +begin + refine continuous_linear_map.tmp_topological_add_group.ext infer_instance + ((@metric.nhds_basis_closed_ball _ continuous_linear_map.tmp_pseudo_metric_space 0).ext + (continuous_linear_map.has_basis_nhds_zero_of_basis metric.nhds_basis_closed_ball) _ _), + { rcases normed_field.exists_norm_lt_one 𝕜 with ⟨c, hc₀, hc₁⟩, + refine λ ε hε, ⟨⟨closed_ball 0 (1 / ‖c‖), ε⟩, + ⟨normed_space.is_vonN_bounded_closed_ball _ _ _, hε⟩, λ f hf, _⟩, + change ∀ x, _ at hf, + simp_rw mem_closed_ball_zero_iff at hf, + rw @mem_closed_ball_zero_iff _ seminormed_add_comm_group.to_seminormed_add_group, + refine op_norm_le_of_shell' (div_pos one_pos hc₀) hε.le hc₁ (λ x hx₁ hxc, _), + rw div_mul_cancel 1 hc₀.ne.symm at hx₁, + exact (hf x hxc.le).trans (le_mul_of_one_le_right hε.le hx₁) }, + { rintros ⟨S, ε⟩ ⟨hS, hε⟩, + rw [normed_space.is_vonN_bounded_iff, ← bounded_iff_is_bounded] at hS, + rcases hS.subset_ball_lt 0 0 with ⟨δ, hδ, hSδ⟩, + exact ⟨ε/δ, div_pos hε hδ, (continuous_linear_map.tmp_closed_ball_div_subset hε hδ).trans $ + λ f hf x hx, hf x $ hSδ hx⟩ } +end + +protected theorem tmp_uniform_space_eq : + (continuous_linear_map.tmp_uniform_space : uniform_space (E →SL[σ₁₂] F)) = + continuous_linear_map.uniform_space := +begin + rw [← @uniform_add_group.to_uniform_space_eq _ continuous_linear_map.tmp_uniform_space, + ← @uniform_add_group.to_uniform_space_eq _ continuous_linear_map.uniform_space], + congr' 1, + exact continuous_linear_map.tmp_topology_eq +end + +instance to_pseudo_metric_space : pseudo_metric_space (E →SL[σ₁₂] F) := +continuous_linear_map.tmp_pseudo_metric_space.replace_uniformity + (congr_arg _ continuous_linear_map.tmp_uniform_space_eq.symm) + /-- Continuous linear maps themselves form a seminormed space with respect to the operator norm. -/ -instance to_semi_normed_group : semi_normed_group (E →SL[σ₁₂] F) := -semi_normed_group.of_core _ ⟨op_norm_zero, λ x y, op_norm_add_le x y, op_norm_neg⟩ +instance to_seminormed_add_comm_group : seminormed_add_comm_group (E →SL[σ₁₂] F) := +{ dist_eq := continuous_linear_map.tmp_seminormed_add_comm_group.dist_eq } -lemma nnnorm_def (f : E →SL[σ₁₂] F) : ∥f∥₊ = Inf {c | ∀ x, ∥f x∥₊ ≤ c * ∥x∥₊} := +lemma nnnorm_def (f : E →SL[σ₁₂] F) : ‖f‖₊ = Inf {c | ∀ x, ‖f x‖₊ ≤ c * ‖x‖₊} := begin ext, rw [nnreal.coe_Inf, coe_nnnorm, norm_def, nnreal.coe_image], @@ -405,17 +380,28 @@ begin end /-- If one controls the norm of every `A x`, then one controls the norm of `A`. -/ -lemma op_nnnorm_le_bound (f : E →SL[σ₁₂] F) (M : ℝ≥0) (hM : ∀ x, ∥f x∥₊ ≤ M * ∥x∥₊) : - ∥f∥₊ ≤ M := +lemma op_nnnorm_le_bound (f : E →SL[σ₁₂] F) (M : ℝ≥0) (hM : ∀ x, ‖f x‖₊ ≤ M * ‖x‖₊) : + ‖f‖₊ ≤ M := op_norm_le_bound f (zero_le M) hM +/-- If one controls the norm of every `A x`, `‖x‖₊ ≠ 0`, then one controls the norm of `A`. -/ +lemma op_nnnorm_le_bound' (f : E →SL[σ₁₂] F) (M : ℝ≥0) (hM : ∀ x, ‖x‖₊ ≠ 0 → ‖f x‖₊ ≤ M * ‖x‖₊) : + ‖f‖₊ ≤ M := +op_norm_le_bound' f (zero_le M) $ λ x hx, hM x $ by rwa [← nnreal.coe_ne_zero] + +/-- For a continuous real linear map `f`, if one controls the norm of every `f x`, `‖x‖₊ = 1`, then +one controls the norm of `f`. -/ +lemma op_nnnorm_le_of_unit_nnnorm [normed_space ℝ E] [normed_space ℝ F] {f : E →L[ℝ] F} {C : ℝ≥0} + (hf : ∀ x, ‖x‖₊ = 1 → ‖f x‖₊ ≤ C) : ‖f‖₊ ≤ C := +op_norm_le_of_unit_norm C.coe_nonneg $ λ x hx, hf x $ by rwa [← nnreal.coe_eq_one] + theorem op_nnnorm_le_of_lipschitz {f : E →SL[σ₁₂] F} {K : ℝ≥0} (hf : lipschitz_with K f) : - ∥f∥₊ ≤ K := + ‖f‖₊ ≤ K := op_norm_le_of_lipschitz hf lemma op_nnnorm_eq_of_bounds {φ : E →SL[σ₁₂] F} (M : ℝ≥0) - (h_above : ∀ x, ∥φ x∥ ≤ M*∥x∥) (h_below : ∀ N, (∀ x, ∥φ x∥₊ ≤ N*∥x∥₊) → M ≤ N) : - ∥φ∥₊ = M := + (h_above : ∀ x, ‖φ x‖ ≤ M*‖x‖) (h_below : ∀ N, (∀ x, ‖φ x‖₊ ≤ N*‖x‖₊) → M ≤ N) : + ‖φ‖₊ = M := subtype.ext $ op_norm_eq_of_bounds (zero_le M) h_above $ subtype.forall'.mpr h_below instance to_normed_space {𝕜' : Type*} [normed_field 𝕜'] [normed_space 𝕜' F] @@ -424,19 +410,19 @@ instance to_normed_space {𝕜' : Type*} [normed_field 𝕜'] [normed_space 𝕜 include σ₁₃ /-- The operator norm is submultiplicative. -/ -lemma op_norm_comp_le (f : E →SL[σ₁₂] F) : ∥h.comp f∥ ≤ ∥h∥ * ∥f∥ := +lemma op_norm_comp_le (f : E →SL[σ₁₂] F) : ‖h.comp f‖ ≤ ‖h‖ * ‖f‖ := (cInf_le bounds_bdd_below ⟨mul_nonneg (op_norm_nonneg _) (op_norm_nonneg _), λ x, by { rw mul_assoc, exact h.le_op_norm_of_le (f.le_op_norm x) } ⟩) -lemma op_nnnorm_comp_le [ring_hom_isometric σ₁₃] (f : E →SL[σ₁₂] F) : ∥h.comp f∥₊ ≤ ∥h∥₊ * ∥f∥₊ := +lemma op_nnnorm_comp_le [ring_hom_isometric σ₁₃] (f : E →SL[σ₁₂] F) : ‖h.comp f‖₊ ≤ ‖h‖₊ * ‖f‖₊ := op_norm_comp_le h f omit σ₁₃ /-- Continuous linear maps form a seminormed ring with respect to the operator norm. -/ instance to_semi_normed_ring : semi_normed_ring (E →L[𝕜] E) := { norm_mul := λ f g, op_norm_comp_le f g, - .. continuous_linear_map.to_semi_normed_group } + .. continuous_linear_map.to_seminormed_add_comm_group, .. continuous_linear_map.ring } /-- For a normed space `E`, continuous linear endomorphisms form a normed algebra with respect to the operator norm. -/ @@ -444,43 +430,125 @@ instance to_normed_algebra : normed_algebra 𝕜 (E →L[𝕜] E) := { .. continuous_linear_map.to_normed_space, .. continuous_linear_map.algebra } -theorem le_op_nnnorm : ∥f x∥₊ ≤ ∥f∥₊ * ∥x∥₊ := f.le_op_norm x +theorem le_op_nnnorm : ‖f x‖₊ ≤ ‖f‖₊ * ‖x‖₊ := f.le_op_norm x -theorem nndist_le_op_nnnorm (x y : E) : nndist (f x) (f y) ≤ ∥f∥₊ * nndist x y := +theorem nndist_le_op_nnnorm (x y : E) : nndist (f x) (f y) ≤ ‖f‖₊ * nndist x y := dist_le_op_norm f x y /-- continuous linear maps are Lipschitz continuous. -/ -theorem lipschitz : lipschitz_with ∥f∥₊ f := -(f : E →ₛₗ[σ₁₂] F).lipschitz_of_bound_nnnorm _ f.le_op_nnnorm +theorem lipschitz : lipschitz_with ‖f‖₊ f := +add_monoid_hom_class.lipschitz_of_bound_nnnorm f _ f.le_op_nnnorm /-- Evaluation of a continuous linear map `f` at a point is Lipschitz continuous in `f`. -/ -theorem lipschitz_apply (x : E) : lipschitz_with ∥x∥₊ (λ f : E →SL[σ₁₂] F, f x) := +theorem lipschitz_apply (x : E) : lipschitz_with ‖x‖₊ (λ f : E →SL[σ₁₂] F, f x) := lipschitz_with_iff_norm_sub_le.2 $ λ f g, ((f - g).le_op_norm x).trans_eq (mul_comm _ _) end +section Sup + +variables [ring_hom_isometric σ₁₂] + +lemma exists_mul_lt_apply_of_lt_op_nnnorm (f : E →SL[σ₁₂] F) {r : ℝ≥0} (hr : r < ‖f‖₊) : + ∃ x, r * ‖x‖₊ < ‖f x‖₊ := +by simpa only [not_forall, not_le, set.mem_set_of] using not_mem_of_lt_cInf + (nnnorm_def f ▸ hr : r < Inf {c : ℝ≥0 | ∀ x, ‖f x‖₊ ≤ c * ‖x‖₊}) (order_bot.bdd_below _) + +lemma exists_mul_lt_of_lt_op_norm (f : E →SL[σ₁₂] F) {r : ℝ} (hr₀ : 0 ≤ r) (hr : r < ‖f‖) : + ∃ x, r * ‖x‖ < ‖f x‖ := +by { lift r to ℝ≥0 using hr₀, exact f.exists_mul_lt_apply_of_lt_op_nnnorm hr } + +lemma exists_lt_apply_of_lt_op_nnnorm {𝕜 𝕜₂ E F : Type*} [normed_add_comm_group E] + [seminormed_add_comm_group F] [densely_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜 →+* 𝕜₂} [normed_space 𝕜 E] [normed_space 𝕜₂ F] [ring_hom_isometric σ₁₂] + (f : E →SL[σ₁₂] F) {r : ℝ≥0} (hr : r < ‖f‖₊) : ∃ x : E, ‖x‖₊ < 1 ∧ r < ‖f x‖₊ := +begin + obtain ⟨y, hy⟩ := f.exists_mul_lt_apply_of_lt_op_nnnorm hr, + have hy' : ‖y‖₊ ≠ 0 := nnnorm_ne_zero_iff.2 + (λ heq, by simpa only [heq, nnnorm_zero, map_zero, not_lt_zero'] using hy), + have hfy : ‖f y‖₊ ≠ 0 := (zero_le'.trans_lt hy).ne', + rw [←inv_inv (‖f y‖₊), nnreal.lt_inv_iff_mul_lt (inv_ne_zero hfy), mul_assoc, mul_comm (‖y‖₊), + ←mul_assoc, ←nnreal.lt_inv_iff_mul_lt hy'] at hy, + obtain ⟨k, hk₁, hk₂⟩ := normed_field.exists_lt_nnnorm_lt 𝕜 hy, + refine ⟨k • y, (nnnorm_smul k y).symm ▸ (nnreal.lt_inv_iff_mul_lt hy').1 hk₂, _⟩, + have : ‖σ₁₂ k‖₊ = ‖k‖₊ := subtype.ext ring_hom_isometric.is_iso, + rwa [map_smulₛₗ f, nnnorm_smul, ←nnreal.div_lt_iff hfy, div_eq_mul_inv, this], +end + +lemma exists_lt_apply_of_lt_op_norm {𝕜 𝕜₂ E F : Type*} [normed_add_comm_group E] + [seminormed_add_comm_group F] [densely_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜 →+* 𝕜₂} [normed_space 𝕜 E] [normed_space 𝕜₂ F] [ring_hom_isometric σ₁₂] + (f : E →SL[σ₁₂] F) {r : ℝ} (hr : r < ‖f‖) : ∃ x : E, ‖x‖ < 1 ∧ r < ‖f x‖ := +begin + by_cases hr₀ : r < 0, + { exact ⟨0, by simpa using hr₀⟩, }, + { lift r to ℝ≥0 using not_lt.1 hr₀, + exact f.exists_lt_apply_of_lt_op_nnnorm hr, } +end + +lemma Sup_unit_ball_eq_nnnorm {𝕜 𝕜₂ E F : Type*} [normed_add_comm_group E] + [seminormed_add_comm_group F] [densely_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜 →+* 𝕜₂} [normed_space 𝕜 E] [normed_space 𝕜₂ F] [ring_hom_isometric σ₁₂] + (f : E →SL[σ₁₂] F) : Sup ((λ x, ‖f x‖₊) '' ball 0 1) = ‖f‖₊ := +begin + refine cSup_eq_of_forall_le_of_forall_lt_exists_gt ((nonempty_ball.mpr zero_lt_one).image _) + _ (λ ub hub, _), + { rintro - ⟨x, hx, rfl⟩, + simpa only [mul_one] using f.le_op_norm_of_le (mem_ball_zero_iff.1 hx).le }, + { obtain ⟨x, hx, hxf⟩ := f.exists_lt_apply_of_lt_op_nnnorm hub, + exact ⟨_, ⟨x, mem_ball_zero_iff.2 hx, rfl⟩, hxf⟩ }, +end + +lemma Sup_unit_ball_eq_norm {𝕜 𝕜₂ E F : Type*} [normed_add_comm_group E] + [seminormed_add_comm_group F] [densely_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜 →+* 𝕜₂} [normed_space 𝕜 E] [normed_space 𝕜₂ F] [ring_hom_isometric σ₁₂] + (f : E →SL[σ₁₂] F) : Sup ((λ x, ‖f x‖) '' ball 0 1) = ‖f‖ := +by simpa only [nnreal.coe_Sup, set.image_image] using nnreal.coe_eq.2 f.Sup_unit_ball_eq_nnnorm + +lemma Sup_closed_unit_ball_eq_nnnorm {𝕜 𝕜₂ E F : Type*} [normed_add_comm_group E] + [seminormed_add_comm_group F] [densely_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜 →+* 𝕜₂} [normed_space 𝕜 E] [normed_space 𝕜₂ F] [ring_hom_isometric σ₁₂] + (f : E →SL[σ₁₂] F) : Sup ((λ x, ‖f x‖₊) '' closed_ball 0 1) = ‖f‖₊ := +begin + have hbdd : ∀ y ∈ (λ x, ‖f x‖₊) '' closed_ball 0 1, y ≤ ‖f‖₊, + { rintro - ⟨x, hx, rfl⟩, exact f.unit_le_op_norm x (mem_closed_ball_zero_iff.1 hx) }, + refine le_antisymm (cSup_le ((nonempty_closed_ball.mpr zero_le_one).image _) hbdd) _, + rw ←Sup_unit_ball_eq_nnnorm, + exact cSup_le_cSup ⟨‖f‖₊, hbdd⟩ ((nonempty_ball.2 zero_lt_one).image _) + (set.image_subset _ ball_subset_closed_ball), +end + +lemma Sup_closed_unit_ball_eq_norm {𝕜 𝕜₂ E F : Type*} [normed_add_comm_group E] + [seminormed_add_comm_group F] [densely_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + {σ₁₂ : 𝕜 →+* 𝕜₂} [normed_space 𝕜 E] [normed_space 𝕜₂ F] [ring_hom_isometric σ₁₂] + (f : E →SL[σ₁₂] F) : Sup ((λ x, ‖f x‖) '' closed_ball 0 1) = ‖f‖ := +by simpa only [nnreal.coe_Sup, set.image_image] using nnreal.coe_eq.2 + f.Sup_closed_unit_ball_eq_nnnorm + +end Sup + section lemma op_norm_ext [ring_hom_isometric σ₁₃] (f : E →SL[σ₁₂] F) (g : E →SL[σ₁₃] G) - (h : ∀ x, ∥f x∥ = ∥g x∥) : ∥f∥ = ∥g∥ := + (h : ∀ x, ‖f x‖ = ‖g x‖) : ‖f‖ = ‖g‖ := op_norm_eq_of_bounds (norm_nonneg _) (λ x, by { rw h x, exact le_op_norm _ _ }) (λ c hc h₂, op_norm_le_bound _ hc (λ z, by { rw ←h z, exact h₂ z })) variables [ring_hom_isometric σ₂₃] theorem op_norm_le_bound₂ (f : E →SL[σ₁₃] F →SL[σ₂₃] G) {C : ℝ} (h0 : 0 ≤ C) - (hC : ∀ x y, ∥f x y∥ ≤ C * ∥x∥ * ∥y∥) : - ∥f∥ ≤ C := + (hC : ∀ x y, ‖f x y‖ ≤ C * ‖x‖ * ‖y‖) : + ‖f‖ ≤ C := f.op_norm_le_bound h0 $ λ x, (f x).op_norm_le_bound (mul_nonneg h0 (norm_nonneg _)) $ hC x theorem le_op_norm₂ [ring_hom_isometric σ₁₃] (f : E →SL[σ₁₃] F →SL[σ₂₃] G) (x : E) (y : F) : - ∥f x y∥ ≤ ∥f∥ * ∥x∥ * ∥y∥ := + ‖f x y‖ ≤ ‖f‖ * ‖x‖ * ‖y‖ := (f x).le_of_op_norm_le (f.le_op_norm x) y end -@[simp] lemma op_norm_prod (f : E →L[𝕜] Fₗ) (g : E →L[𝕜] Gₗ) : ∥f.prod g∥ = ∥(f, g)∥ := +@[simp] lemma op_norm_prod (f : E →L[𝕜] Fₗ) (g : E →L[𝕜] Gₗ) : ‖f.prod g‖ = ‖(f, g)‖ := le_antisymm (op_norm_le_bound _ (norm_nonneg _) $ λ x, by simpa only [prod_apply, prod.norm_def, max_mul_of_nonneg, norm_nonneg] @@ -489,7 +557,7 @@ le_antisymm (op_norm_le_bound _ (norm_nonneg _) $ λ x, (le_max_left _ _).trans ((f.prod g).le_op_norm x)) (op_norm_le_bound _ (norm_nonneg _) $ λ x, (le_max_right _ _).trans ((f.prod g).le_op_norm x)) -@[simp] lemma op_nnnorm_prod (f : E →L[𝕜] Fₗ) (g : E →L[𝕜] Gₗ) : ∥f.prod g∥₊ = ∥(f, g)∥₊ := +@[simp] lemma op_nnnorm_prod (f : E →L[𝕜] Fₗ) (g : E →L[𝕜] Gₗ) : ‖f.prod g‖₊ = ‖(f, g)‖₊ := subtype.ext $ op_norm_prod f g /-- `continuous_linear_map.prod` as a `linear_isometry_equiv`. -/ @@ -499,15 +567,9 @@ def prodₗᵢ (R : Type*) [semiring R] [module R Fₗ] [module R Gₗ] (E →L[𝕜] Fₗ) × (E →L[𝕜] Gₗ) ≃ₗᵢ[R] (E →L[𝕜] Fₗ × Gₗ) := ⟨prodₗ R, λ ⟨f, g⟩, op_norm_prod f g⟩ -/-- A continuous linear map is an isometry if and only if it preserves the norm. -(Note: Do you really want to use this lemma? Try using the bundled structure `linear_isometry` -instead.) -/ -lemma isometry_iff_norm (f : E →SL[σ₁₂] F) : isometry f ↔ ∀x, ∥f x∥ = ∥x∥ := -f.to_linear_map.to_add_monoid_hom.isometry_iff_norm - variables [ring_hom_isometric σ₁₂] (f : E →SL[σ₁₂] F) -@[simp, nontriviality] lemma op_norm_subsingleton [subsingleton E] : ∥f∥ = 0 := +@[simp, nontriviality] lemma op_norm_subsingleton [subsingleton E] : ‖f‖ = 0 := begin refine le_antisymm _ (norm_nonneg _), apply op_norm_le_bound _ rfl.ge, @@ -524,28 +586,28 @@ variables [ring_hom_isometric σ₁₂] open asymptotics -theorem is_O_with_id (l : filter E) : is_O_with ∥f∥ f (λ x, x) l := +theorem is_O_with_id (l : filter E) : is_O_with ‖f‖ l f (λ x, x) := is_O_with_of_le' _ f.le_op_norm -theorem is_O_id (l : filter E) : is_O f (λ x, x) l := +theorem is_O_id (l : filter E) : f =O[l] (λ x, x) := (f.is_O_with_id l).is_O theorem is_O_with_comp [ring_hom_isometric σ₂₃] {α : Type*} (g : F →SL[σ₂₃] G) (f : α → F) (l : filter α) : - is_O_with ∥g∥ (λ x', g (f x')) f l := + is_O_with ‖g‖ l (λ x', g (f x')) f := (g.is_O_with_id ⊤).comp_tendsto le_top theorem is_O_comp [ring_hom_isometric σ₂₃] {α : Type*} (g : F →SL[σ₂₃] G) (f : α → F) (l : filter α) : - is_O (λ x', g (f x')) f l := + (λ x', g (f x')) =O[l] f := (g.is_O_with_comp f l).is_O theorem is_O_with_sub (f : E →SL[σ₁₂] F) (l : filter E) (x : E) : - is_O_with ∥f∥ (λ x', f (x' - x)) (λ x', x' - x) l := + is_O_with ‖f‖ l (λ x', f (x' - x)) (λ x', x' - x) := f.is_O_with_comp _ l theorem is_O_sub (f : E →SL[σ₁₂] F) (l : filter E) (x : E) : - is_O (λ x', f (x' - x)) (λ x', x' - x) l := + (λ x', f (x' - x)) =O[l] (λ x', x' - x) := f.is_O_comp _ l end is_O @@ -555,7 +617,7 @@ end continuous_linear_map namespace linear_isometry lemma norm_to_continuous_linear_map_le (f : E →ₛₗᵢ[σ₁₂] F) : - ∥f.to_continuous_linear_map∥ ≤ 1 := + ‖f.to_continuous_linear_map‖ ≤ 1 := f.to_continuous_linear_map.op_norm_le_bound zero_le_one $ λ x, by simp end linear_isometry @@ -564,14 +626,14 @@ namespace linear_map /-- If a continuous linear map is constructed from a linear map via the constructor `mk_continuous`, then its norm is bounded by the bound given to the constructor if it is nonnegative. -/ -lemma mk_continuous_norm_le (f : E →ₛₗ[σ₁₂] F) {C : ℝ} (hC : 0 ≤ C) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - ∥f.mk_continuous C h∥ ≤ C := +lemma mk_continuous_norm_le (f : E →ₛₗ[σ₁₂] F) {C : ℝ} (hC : 0 ≤ C) (h : ∀x, ‖f x‖ ≤ C * ‖x‖) : + ‖f.mk_continuous C h‖ ≤ C := continuous_linear_map.op_norm_le_bound _ hC h /-- If a continuous linear map is constructed from a linear map via the constructor `mk_continuous`, then its norm is bounded by the bound or zero if bound is negative. -/ -lemma mk_continuous_norm_le' (f : E →ₛₗ[σ₁₂] F) {C : ℝ} (h : ∀x, ∥f x∥ ≤ C * ∥x∥) : - ∥f.mk_continuous C h∥ ≤ max C 0 := +lemma mk_continuous_norm_le' (f : E →ₛₗ[σ₁₂] F) {C : ℝ} (h : ∀x, ‖f x‖ ≤ C * ‖x‖) : + ‖f.mk_continuous C h‖ ≤ max C 0 := continuous_linear_map.op_norm_le_bound _ (le_max_right _ _) $ λ x, (h x).trans $ mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg x) @@ -581,28 +643,38 @@ variables [ring_hom_isometric σ₂₃] map and a bound on the norm of the image. The linear map can be constructed using `linear_map.mk₂`. -/ def mk_continuous₂ (f : E →ₛₗ[σ₁₃] F →ₛₗ[σ₂₃] G) (C : ℝ) - (hC : ∀ x y, ∥f x y∥ ≤ C * ∥x∥ * ∥y∥) : + (hC : ∀ x y, ‖f x y‖ ≤ C * ‖x‖ * ‖y‖) : E →SL[σ₁₃] F →SL[σ₂₃] G := linear_map.mk_continuous - { to_fun := λ x, (f x).mk_continuous (C * ∥x∥) (hC x), - map_add' := λ x y, by { ext z, simp }, - map_smul' := λ c x, by { ext z, simp } } + { to_fun := λ x, (f x).mk_continuous (C * ‖x‖) (hC x), + map_add' := λ x y, + begin + ext z, + rw [continuous_linear_map.add_apply, mk_continuous_apply, mk_continuous_apply, + mk_continuous_apply, map_add, add_apply] + end, + map_smul' := λ c x, + begin + ext z, + rw [continuous_linear_map.smul_apply, mk_continuous_apply, mk_continuous_apply, map_smulₛₗ, + smul_apply] + end, } (max C 0) $ λ x, (mk_continuous_norm_le' _ _).trans_eq $ by rw [max_mul_of_nonneg _ _ (norm_nonneg x), zero_mul] @[simp] lemma mk_continuous₂_apply (f : E →ₛₗ[σ₁₃] F →ₛₗ[σ₂₃] G) {C : ℝ} - (hC : ∀ x y, ∥f x y∥ ≤ C * ∥x∥ * ∥y∥) (x : E) (y : F) : + (hC : ∀ x y, ‖f x y‖ ≤ C * ‖x‖ * ‖y‖) (x : E) (y : F) : f.mk_continuous₂ C hC x y = f x y := rfl lemma mk_continuous₂_norm_le' (f : E →ₛₗ[σ₁₃] F →ₛₗ[σ₂₃] G) {C : ℝ} - (hC : ∀ x y, ∥f x y∥ ≤ C * ∥x∥ * ∥y∥) : - ∥f.mk_continuous₂ C hC∥ ≤ max C 0 := + (hC : ∀ x y, ‖f x y‖ ≤ C * ‖x‖ * ‖y‖) : + ‖f.mk_continuous₂ C hC‖ ≤ max C 0 := mk_continuous_norm_le _ (le_max_iff.2 $ or.inr le_rfl) _ lemma mk_continuous₂_norm_le (f : E →ₛₗ[σ₁₃] F →ₛₗ[σ₂₃] G) {C : ℝ} (h0 : 0 ≤ C) - (hC : ∀ x y, ∥f x y∥ ≤ C * ∥x∥ * ∥y∥) : - ∥f.mk_continuous₂ C hC∥ ≤ C := + (hC : ∀ x y, ‖f x y‖ ≤ C * ‖x‖ * ‖y‖) : + ‖f.mk_continuous₂ C hC‖ ≤ C := (f.mk_continuous₂_norm_le' hC).trans_eq $ max_eq_left h0 end linear_map @@ -620,11 +692,11 @@ linear_map.mk_continuous₂ (λ x y z, (f z).map_add x y) (λ c y x, (f x).map_smulₛₗ c y) (λ z x y, by rw [f.map_add, add_apply]) - (λ c y x, by rw [map_smulₛₗ, smul_apply])) - ∥f∥ + (λ c y x, by rw [f.map_smulₛₗ, smul_apply])) + ‖f‖ (λ y x, (f.le_op_norm₂ x y).trans_eq $ by rw mul_right_comm) -private lemma le_norm_flip (f : E →SL[σ₁₃] F →SL[σ₂₃] G) : ∥f∥ ≤ ∥flip f∥ := +private lemma le_norm_flip (f : E →SL[σ₁₃] F →SL[σ₂₃] G) : ‖f‖ ≤ ‖flip f‖ := f.op_norm_le_bound₂ (norm_nonneg _) $ λ x y, by { rw mul_right_comm, exact (flip f).le_op_norm₂ y x } @@ -635,7 +707,7 @@ f.op_norm_le_bound₂ (norm_nonneg _) $ λ x y, by { ext, refl } @[simp] lemma op_norm_flip (f : E →SL[σ₁₃] F →SL[σ₂₃] G) : - ∥f.flip∥ = ∥f∥ := + ‖f.flip‖ = ‖f‖ := le_antisymm (by simpa only [flip_flip] using le_norm_flip f.flip) (le_norm_flip f) @[simp] lemma flip_add (f g : E →SL[σ₁₃] F →SL[σ₂₃] G) : @@ -716,23 +788,39 @@ variables (σ₁₂ σ₂₃ E F G) def compSL : (F →SL[σ₂₃] G) →L[𝕜₃] (E →SL[σ₁₂] F) →SL[σ₂₃] (E →SL[σ₁₃] G) := linear_map.mk_continuous₂ (linear_map.mk₂'ₛₗ (ring_hom.id 𝕜₃) σ₂₃ comp add_comp smul_comp comp_add - (λ c f g, by { ext, simp only [map_smulₛₗ, coe_smul', coe_comp', + (λ c f g, by { ext, simp only [continuous_linear_map.map_smulₛₗ, coe_smul', coe_comp', function.comp_app, pi.smul_apply] })) 1 $ λ f g, by simpa only [one_mul] using op_norm_comp_le f g -variables {𝕜 E F G} - include σ₁₃ +lemma norm_compSL_le : ‖compSL E F G σ₁₂ σ₂₃‖ ≤ 1 := +linear_map.mk_continuous₂_norm_le _ zero_le_one _ + +variables {𝕜 σ₁₂ σ₂₃ E F G} + @[simp] lemma compSL_apply (f : F →SL[σ₂₃] G) (g : E →SL[σ₁₂] F) : compSL E F G σ₁₂ σ₂₃ f g = f.comp g := rfl +lemma _root_.continuous.const_clm_comp {X} [topological_space X] {f : X → E →SL[σ₁₂] F} + (hf : continuous f) (g : F →SL[σ₂₃] G) : continuous (λ x, g.comp (f x) : X → E →SL[σ₁₃] G) := +(compSL E F G σ₁₂ σ₂₃ g).continuous.comp hf + +-- Giving the implicit argument speeds up elaboration significantly +lemma _root_.continuous.clm_comp_const {X} [topological_space X] {g : X → F →SL[σ₂₃] G} + (hg : continuous g) (f : E →SL[σ₁₂] F) : continuous (λ x, (g x).comp f : X → E →SL[σ₁₃] G) := +(@continuous_linear_map.flip _ _ _ _ _ (E →SL[σ₁₃] G) _ _ _ _ _ _ _ _ _ _ _ _ _ + (compSL E F G σ₁₂ σ₂₃) f).continuous.comp hg + omit σ₁₃ -variables (𝕜 E Fₗ Gₗ) +variables (𝕜 σ₁₂ σ₂₃ E Fₗ Gₗ) /-- Composition of continuous linear maps as a continuous bilinear map. -/ def compL : (Fₗ →L[𝕜] Gₗ) →L[𝕜] (E →L[𝕜] Fₗ) →L[𝕜] (E →L[𝕜] Gₗ) := - compSL E Fₗ Gₗ (ring_hom.id 𝕜) (ring_hom.id 𝕜) +compSL E Fₗ Gₗ (ring_hom.id 𝕜) (ring_hom.id 𝕜) + +lemma norm_compL_le : ‖compL 𝕜 E Fₗ Gₗ‖ ≤ 1 := +norm_compSL_le _ _ _ _ _ @[simp] lemma compL_apply (f : Fₗ →L[𝕜] Gₗ) (g : E →L[𝕜] Fₗ) : compL 𝕜 E Fₗ Gₗ f g = f.comp g := rfl @@ -746,13 +834,21 @@ def precompR (L : E →L[𝕜] Fₗ →L[𝕜] Gₗ) : E →L[𝕜] (Eₗ →L[ def precompL (L : E →L[𝕜] Fₗ →L[𝕜] Gₗ) : (Eₗ →L[𝕜] E) →L[𝕜] Fₗ →L[𝕜] (Eₗ →L[𝕜] Gₗ) := (precompR Eₗ (flip L)).flip +lemma norm_precompR_le (L : E →L[𝕜] Fₗ →L[𝕜] Gₗ) : ‖precompR Eₗ L‖ ≤ ‖L‖ := calc +‖precompR Eₗ L‖ ≤ ‖compL 𝕜 Eₗ Fₗ Gₗ‖ * ‖L‖ : op_norm_comp_le _ _ +... ≤ 1 * ‖L‖ : mul_le_mul_of_nonneg_right (norm_compL_le _ _ _ _) (norm_nonneg _) +... = ‖L‖ : by rw one_mul + +lemma norm_precompL_le (L : E →L[𝕜] Fₗ →L[𝕜] Gₗ) : ‖precompL Eₗ L‖ ≤ ‖L‖ := +by { rw [precompL, op_norm_flip, ← op_norm_flip L], exact norm_precompR_le _ L.flip } + section prod universes u₁ u₂ u₃ u₄ -variables (M₁ : Type u₁) [semi_normed_group M₁] [normed_space 𝕜 M₁] - (M₂ : Type u₂) [semi_normed_group M₂] [normed_space 𝕜 M₂] - (M₃ : Type u₃) [semi_normed_group M₃] [normed_space 𝕜 M₃] - (M₄ : Type u₄) [semi_normed_group M₄] [normed_space 𝕜 M₄] +variables (M₁ : Type u₁) [seminormed_add_comm_group M₁] [normed_space 𝕜 M₁] + (M₂ : Type u₂) [seminormed_add_comm_group M₂] [normed_space 𝕜 M₂] + (M₃ : Type u₃) [seminormed_add_comm_group M₃] [normed_space 𝕜 M₃] + (M₄ : Type u₄) [seminormed_add_comm_group M₄] [normed_space 𝕜 M₄] variables {Eₗ} (𝕜) /-- `continuous_linear_map.prod_map` as a continuous linear map. -/ @@ -815,74 +911,66 @@ end prod variables {𝕜 E Fₗ Gₗ} section multiplication_linear -variables (𝕜) (𝕜' : Type*) [normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] -/-- Left multiplication in a normed algebra as a continuous bilinear map. -/ -def lmul : 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' := -(algebra.lmul 𝕜 𝕜').to_linear_map.mk_continuous₂ 1 $ +section non_unital +variables (𝕜) (𝕜' : Type*) [non_unital_semi_normed_ring 𝕜'] [normed_space 𝕜 𝕜'] + [is_scalar_tower 𝕜 𝕜' 𝕜'] [smul_comm_class 𝕜 𝕜' 𝕜'] + +/-- Multiplication in a non-unital normed algebra as a continuous bilinear map. -/ +def mul : 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' := (linear_map.mul 𝕜 𝕜').mk_continuous₂ 1 $ λ x y, by simpa using norm_mul_le x y -@[simp] lemma lmul_apply (x y : 𝕜') : lmul 𝕜 𝕜' x y = x * y := rfl +@[simp] lemma mul_apply' (x y : 𝕜') : mul 𝕜 𝕜' x y = x * y := rfl -@[simp] lemma op_norm_lmul_apply_le (x : 𝕜') : ∥lmul 𝕜 𝕜' x∥ ≤ ∥x∥ := +@[simp] lemma op_norm_mul_apply_le (x : 𝕜') : ‖mul 𝕜 𝕜' x‖ ≤ ‖x‖ := (op_norm_le_bound _ (norm_nonneg x) (norm_mul_le x)) -/-- Left multiplication in a normed algebra as a linear isometry to the space of -continuous linear maps. -/ -def lmulₗᵢ [norm_one_class 𝕜'] : 𝕜' →ₗᵢ[𝕜] 𝕜' →L[𝕜] 𝕜' := -{ to_linear_map := lmul 𝕜 𝕜', - norm_map' := λ x, le_antisymm (op_norm_lmul_apply_le _ _ _) - (by { convert ratio_le_op_norm _ (1 : 𝕜'), simp [norm_one], - apply_instance }) } - -@[simp] lemma coe_lmulₗᵢ [norm_one_class 𝕜'] : ⇑(lmulₗᵢ 𝕜 𝕜') = lmul 𝕜 𝕜' := rfl +lemma op_norm_mul_le : ‖mul 𝕜 𝕜'‖ ≤ 1 := +linear_map.mk_continuous₂_norm_le _ zero_le_one _ -@[simp] lemma op_norm_lmul_apply [norm_one_class 𝕜'] (x : 𝕜') : ∥lmul 𝕜 𝕜' x∥ = ∥x∥ := -(lmulₗᵢ 𝕜 𝕜').norm_map x +/-- Simultaneous left- and right-multiplication in a non-unital normed algebra, considered as a +continuous trilinear map. This is akin to its non-continuous version `linear_map.mul_left_right`, +but there is a minor difference: `linear_map.mul_left_right` is uncurried. -/ +def mul_left_right : 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' := +((compL 𝕜 𝕜' 𝕜' 𝕜').comp (mul 𝕜 𝕜').flip).flip.comp (mul 𝕜 𝕜') -/-- Right-multiplication in a normed algebra, considered as a continuous linear map. -/ -def lmul_right : 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' := (lmul 𝕜 𝕜').flip +@[simp] lemma mul_left_right_apply (x y z : 𝕜') : + mul_left_right 𝕜 𝕜' x y z = x * z * y := rfl -@[simp] lemma lmul_right_apply (x y : 𝕜') : lmul_right 𝕜 𝕜' x y = y * x := rfl +lemma op_norm_mul_left_right_apply_apply_le (x y : 𝕜') : + ‖mul_left_right 𝕜 𝕜' x y‖ ≤ ‖x‖ * ‖y‖ := +(op_norm_comp_le _ _).trans $ (mul_comm _ _).trans_le $ + mul_le_mul (op_norm_mul_apply_le _ _ _) + (op_norm_le_bound _ (norm_nonneg _) (λ _, (norm_mul_le _ _).trans_eq (mul_comm _ _))) + (norm_nonneg _) (norm_nonneg _) -@[simp] lemma op_norm_lmul_right_apply_le (x : 𝕜') : ∥lmul_right 𝕜 𝕜' x∥ ≤ ∥x∥ := -op_norm_le_bound _ (norm_nonneg x) (λ y, (norm_mul_le y x).trans_eq (mul_comm _ _)) +lemma op_norm_mul_left_right_apply_le (x : 𝕜') : + ‖mul_left_right 𝕜 𝕜' x‖ ≤ ‖x‖ := +op_norm_le_bound _ (norm_nonneg x) (op_norm_mul_left_right_apply_apply_le 𝕜 𝕜' x) -@[simp] lemma op_norm_lmul_right_apply [norm_one_class 𝕜'] (x : 𝕜') : ∥lmul_right 𝕜 𝕜' x∥ = ∥x∥ := -le_antisymm - (op_norm_lmul_right_apply_le _ _ _) - (by { convert ratio_le_op_norm _ (1 : 𝕜'), simp [norm_one], - apply_instance }) - -/-- Right-multiplication in a normed algebra, considered as a linear isometry to the space of -continuous linear maps. -/ -def lmul_rightₗᵢ [norm_one_class 𝕜'] : 𝕜' →ₗᵢ[𝕜] 𝕜' →L[𝕜] 𝕜' := -{ to_linear_map := lmul_right 𝕜 𝕜', - norm_map' := op_norm_lmul_right_apply 𝕜 𝕜' } +lemma op_norm_mul_left_right_le : + ‖mul_left_right 𝕜 𝕜'‖ ≤ 1 := +op_norm_le_bound _ zero_le_one (λ x, (one_mul ‖x‖).symm ▸ op_norm_mul_left_right_apply_le 𝕜 𝕜' x) -@[simp] lemma coe_lmul_rightₗᵢ [norm_one_class 𝕜'] : ⇑(lmul_rightₗᵢ 𝕜 𝕜') = lmul_right 𝕜 𝕜' := rfl +end non_unital -/-- Simultaneous left- and right-multiplication in a normed algebra, considered as a continuous -trilinear map. -/ -def lmul_left_right : 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' →L[𝕜] 𝕜' := -((compL 𝕜 𝕜' 𝕜' 𝕜').comp (lmul_right 𝕜 𝕜')).flip.comp (lmul 𝕜 𝕜') +section unital +variables (𝕜) (𝕜' : Type*) [semi_normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] [norm_one_class 𝕜'] -@[simp] lemma lmul_left_right_apply (x y z : 𝕜') : - lmul_left_right 𝕜 𝕜' x y z = x * z * y := rfl +/-- Multiplication in a normed algebra as a linear isometry to the space of +continuous linear maps. -/ +def mulₗᵢ : 𝕜' →ₗᵢ[𝕜] 𝕜' →L[𝕜] 𝕜' := +{ to_linear_map := mul 𝕜 𝕜', + norm_map' := λ x, le_antisymm (op_norm_mul_apply_le _ _ _) + (by { convert ratio_le_op_norm _ (1 : 𝕜'), simp [norm_one], + apply_instance }) } -lemma op_norm_lmul_left_right_apply_apply_le (x y : 𝕜') : - ∥lmul_left_right 𝕜 𝕜' x y∥ ≤ ∥x∥ * ∥y∥ := -(op_norm_comp_le _ _).trans $ (mul_comm _ _).trans_le $ - mul_le_mul (op_norm_lmul_apply_le _ _ _) (op_norm_lmul_right_apply_le _ _ _) - (norm_nonneg _) (norm_nonneg _) +@[simp] lemma coe_mulₗᵢ : ⇑(mulₗᵢ 𝕜 𝕜') = mul 𝕜 𝕜' := rfl -lemma op_norm_lmul_left_right_apply_le (x : 𝕜') : - ∥lmul_left_right 𝕜 𝕜' x∥ ≤ ∥x∥ := -op_norm_le_bound _ (norm_nonneg x) (op_norm_lmul_left_right_apply_apply_le 𝕜 𝕜' x) +@[simp] lemma op_norm_mul_apply (x : 𝕜') : ‖mul 𝕜 𝕜' x‖ = ‖x‖ := +(mulₗᵢ 𝕜 𝕜').norm_map x -lemma op_norm_lmul_left_right_le : - ∥lmul_left_right 𝕜 𝕜'∥ ≤ 1 := -op_norm_le_bound _ zero_le_one (λ x, (one_mul ∥x∥).symm ▸ op_norm_lmul_left_right_apply_le 𝕜 𝕜' x) +end unital end multiplication_linear @@ -894,13 +982,13 @@ variables (𝕜) (𝕜' : Type*) [normed_field 𝕜'] [normed_algebra 𝕜 𝕜' /-- Scalar multiplication as a continuous bilinear map. -/ def lsmul : 𝕜' →L[𝕜] E →L[𝕜] E := ((algebra.lsmul 𝕜 E).to_linear_map : 𝕜' →ₗ[𝕜] E →ₗ[𝕜] E).mk_continuous₂ 1 $ - λ c x, by simpa only [one_mul] using (norm_smul c x).le + λ c x, by simpa only [one_mul] using norm_smul_le c x @[simp] lemma lsmul_apply (c : 𝕜') (x : E) : lsmul 𝕜 𝕜' c x = c • x := rfl variables {𝕜'} -lemma norm_to_span_singleton (x : E) : ∥to_span_singleton 𝕜 x∥ = ∥x∥ := +lemma norm_to_span_singleton (x : E) : ‖to_span_singleton 𝕜 x‖ = ‖x‖ := begin refine op_norm_eq_of_bounds (norm_nonneg _) (λ x, _) (λ N hN_nonneg h, _), { rw [to_span_singleton_apply, norm_smul, mul_comm], }, @@ -911,11 +999,11 @@ end variables {𝕜} -lemma op_norm_lsmul_apply_le (x : 𝕜') : ∥(lsmul 𝕜 𝕜' x : E →L[𝕜] E)∥ ≤ ∥x∥ := -continuous_linear_map.op_norm_le_bound _ (norm_nonneg x) $ λ y, (norm_smul x y).le +lemma op_norm_lsmul_apply_le (x : 𝕜') : ‖(lsmul 𝕜 𝕜' x : E →L[𝕜] E)‖ ≤ ‖x‖ := +continuous_linear_map.op_norm_le_bound _ (norm_nonneg x) $ λ y, norm_smul_le x y /-- The norm of `lsmul` is at most 1 in any semi-normed group. -/ -lemma op_norm_lsmul_le : ∥(lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] E →L[𝕜] E)∥ ≤ 1 := +lemma op_norm_lsmul_le : ‖(lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] E →L[𝕜] E)‖ ≤ 1 := begin refine continuous_linear_map.op_norm_le_bound _ zero_le_one (λ x, _), simp_rw [one_mul], @@ -926,11 +1014,11 @@ end smul_linear section restrict_scalars -variables {𝕜' : Type*} [nondiscrete_normed_field 𝕜'] [normed_algebra 𝕜' 𝕜] +variables {𝕜' : Type*} [nontrivially_normed_field 𝕜'] [normed_algebra 𝕜' 𝕜] variables [normed_space 𝕜' E] [is_scalar_tower 𝕜' 𝕜 E] variables [normed_space 𝕜' Fₗ] [is_scalar_tower 𝕜' 𝕜 Fₗ] -@[simp] lemma norm_restrict_scalars (f : E →L[𝕜] Fₗ) : ∥f.restrict_scalars 𝕜'∥ = ∥f∥ := +@[simp] lemma norm_restrict_scalars (f : E →L[𝕜] Fₗ) : ‖f.restrict_scalars 𝕜'‖ = ‖f‖ := le_antisymm (op_norm_le_bound _ (norm_nonneg _) $ λ x, f.le_op_norm x) (op_norm_le_bound _ (norm_nonneg _) $ λ x, f.le_op_norm x) @@ -974,68 +1062,11 @@ end continuous_linear_map namespace submodule -lemma norm_subtypeL_le (K : submodule 𝕜 E) : ∥K.subtypeL∥ ≤ 1 := +lemma norm_subtypeL_le (K : submodule 𝕜 E) : ‖K.subtypeL‖ ≤ 1 := K.subtypeₗᵢ.norm_to_continuous_linear_map_le end submodule -section has_sum - --- Results in this section hold for continuous additive monoid homomorphisms or equivalences but we --- don't have bundled continuous additive homomorphisms. - -variables {ι R R₂ M M₂ : Type*} [semiring R] [semiring R₂] [add_comm_monoid M] [module R M] - [add_comm_monoid M₂] [module R₂ M₂] [topological_space M] [topological_space M₂] - {σ : R →+* R₂} {σ' : R₂ →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ] - -/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/ -protected lemma continuous_linear_map.has_sum {f : ι → M} (φ : M →SL[σ] M₂) {x : M} - (hf : has_sum f x) : - has_sum (λ (b:ι), φ (f b)) (φ x) := -by simpa only using hf.map φ.to_linear_map.to_add_monoid_hom φ.continuous - -alias continuous_linear_map.has_sum ← has_sum.mapL - -protected lemma continuous_linear_map.summable {f : ι → M} (φ : M →SL[σ] M₂) (hf : summable f) : - summable (λ b:ι, φ (f b)) := -(hf.has_sum.mapL φ).summable - -alias continuous_linear_map.summable ← summable.mapL - -protected lemma continuous_linear_map.map_tsum [t2_space M₂] {f : ι → M} - (φ : M →SL[σ] M₂) (hf : summable f) : φ (∑' z, f z) = ∑' z, φ (f z) := -(hf.has_sum.mapL φ).tsum_eq.symm - -include σ' -/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/ -protected lemma continuous_linear_equiv.has_sum {f : ι → M} (e : M ≃SL[σ] M₂) {y : M₂} : - has_sum (λ (b:ι), e (f b)) y ↔ has_sum f (e.symm y) := -⟨λ h, by simpa only [e.symm.coe_coe, e.symm_apply_apply] using h.mapL (e.symm : M₂ →SL[σ'] M), - λ h, by simpa only [e.coe_coe, e.apply_symm_apply] using (e : M →SL[σ] M₂).has_sum h⟩ - - -protected lemma continuous_linear_equiv.summable {f : ι → M} (e : M ≃SL[σ] M₂) : - summable (λ b:ι, e (f b)) ↔ summable f := -⟨λ hf, (e.has_sum.1 hf.has_sum).summable, (e : M →SL[σ] M₂).summable⟩ - - -lemma continuous_linear_equiv.tsum_eq_iff [t2_space M] [t2_space M₂] {f : ι → M} - (e : M ≃SL[σ] M₂) {y : M₂} : ∑' z, e (f z) = y ↔ ∑' z, f z = e.symm y := -begin - by_cases hf : summable f, - { exact ⟨λ h, (e.has_sum.mp ((e.summable.mpr hf).has_sum_iff.mpr h)).tsum_eq, - λ h, (e.has_sum.mpr (hf.has_sum_iff.mpr h)).tsum_eq⟩ }, - { have hf' : ¬summable (λ z, e (f z)) := λ h, hf (e.summable.mp h), - rw [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable hf'], - exact ⟨by { rintro rfl, simp }, λ H, by simpa using (congr_arg (λ z, e z) H)⟩ } -end - -protected lemma continuous_linear_equiv.map_tsum [t2_space M] [t2_space M₂] {f : ι → M} - (e : M ≃SL[σ] M₂) : e (∑' z, f z) = ∑' z, e (f z) := -by { refine symm (e.tsum_eq_iff.mpr _), rw e.symm_apply_apply _ } - -end has_sum - namespace continuous_linear_equiv section @@ -1045,78 +1076,37 @@ variables {σ₂₁ : 𝕜₂ →+* 𝕜} [ring_hom_inv_pair σ₁₂ σ₂₁] variables (e : E ≃SL[σ₁₂] F) include σ₂₁ -protected lemma lipschitz : lipschitz_with (∥(e : E →SL[σ₁₂] F)∥₊) e := +protected lemma lipschitz : lipschitz_with (‖(e : E →SL[σ₁₂] F)‖₊) e := (e : E →SL[σ₁₂] F).lipschitz -theorem is_O_comp {α : Type*} (f : α → E) (l : filter α) : - asymptotics.is_O (λ x', e (f x')) f l := +theorem is_O_comp {α : Type*} (f : α → E) (l : filter α) : (λ x', e (f x')) =O[l] f := (e : E →SL[σ₁₂] F).is_O_comp f l -theorem is_O_sub (l : filter E) (x : E) : - asymptotics.is_O (λ x', e (x' - x)) (λ x', x' - x) l := +theorem is_O_sub (l : filter E) (x : E) : (λ x', e (x' - x)) =O[l] (λ x', x' - x) := (e : E →SL[σ₁₂] F).is_O_sub l x end variables {σ₂₁ : 𝕜₂ →+* 𝕜} [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂] +variables [ring_hom_isometric σ₂₁] (e : E ≃SL[σ₁₂] F) include σ₂₁ -lemma homothety_inverse (a : ℝ) (ha : 0 < a) (f : E ≃ₛₗ[σ₁₂] F) : - (∀ (x : E), ∥f x∥ = a * ∥x∥) → (∀ (y : F), ∥f.symm y∥ = a⁻¹ * ∥y∥) := -begin - intros hf y, - calc ∥(f.symm) y∥ = a⁻¹ * (a * ∥ (f.symm) y∥) : _ - ... = a⁻¹ * ∥f ((f.symm) y)∥ : by rw hf - ... = a⁻¹ * ∥y∥ : by simp, - rw [← mul_assoc, inv_mul_cancel (ne_of_lt ha).symm, one_mul], -end - -/-- A linear equivalence which is a homothety is a continuous linear equivalence. -/ -def of_homothety (f : E ≃ₛₗ[σ₁₂] F) (a : ℝ) (ha : 0 < a) (hf : ∀x, ∥f x∥ = a * ∥x∥) : - E ≃SL[σ₁₂] F := -{ to_linear_equiv := f, - continuous_to_fun := f.to_linear_map.continuous_of_bound a (λ x, le_of_eq (hf x)), - continuous_inv_fun := f.symm.to_linear_map.continuous_of_bound a⁻¹ - (λ x, le_of_eq (homothety_inverse a ha f hf x)) } - -variables [ring_hom_isometric σ₂₁] (e : E ≃SL[σ₁₂] F) -theorem is_O_comp_rev {α : Type*} (f : α → E) (l : filter α) : - asymptotics.is_O f (λ x', e (f x')) l := +theorem is_O_comp_rev {α : Type*} (f : α → E) (l : filter α) : f =O[l] (λ x', e (f x')) := (e.symm.is_O_comp _ l).congr_left $ λ _, e.symm_apply_apply _ -theorem is_O_sub_rev (l : filter E) (x : E) : - asymptotics.is_O (λ x', x' - x) (λ x', e (x' - x)) l := +theorem is_O_sub_rev (l : filter E) (x : E) : (λ x', x' - x) =O[l] (λ x', e (x' - x)) := e.is_O_comp_rev _ _ -omit σ₂₁ - -variable (𝕜) - -lemma to_span_nonzero_singleton_homothety (x : E) (h : x ≠ 0) (c : 𝕜) : - ∥linear_equiv.to_span_nonzero_singleton 𝕜 E x h c∥ = ∥x∥ * ∥c∥ := -continuous_linear_map.to_span_singleton_homothety _ _ _ - end continuous_linear_equiv variables {σ₂₁ : 𝕜₂ →+* 𝕜} [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂] -include σ₂₁ - -/-- Construct a continuous linear equivalence from a linear equivalence together with -bounds in both directions. -/ -def linear_equiv.to_continuous_linear_equiv_of_bounds (e : E ≃ₛₗ[σ₁₂] F) (C_to C_inv : ℝ) - (h_to : ∀ x, ∥e x∥ ≤ C_to * ∥x∥) (h_inv : ∀ x : F, ∥e.symm x∥ ≤ C_inv * ∥x∥) : E ≃SL[σ₁₂] F := -{ to_linear_equiv := e, - continuous_to_fun := e.to_linear_map.continuous_of_bound C_to h_to, - continuous_inv_fun := e.symm.to_linear_map.continuous_of_bound C_inv h_inv } - -omit σ₂₁ namespace continuous_linear_map -variables {E' F' : Type*} [semi_normed_group E'] [semi_normed_group F'] +variables {E' F' : Type*} [seminormed_add_comm_group E'] [seminormed_add_comm_group F'] -variables {𝕜₁' : Type*} {𝕜₂' : Type*} [nondiscrete_normed_field 𝕜₁'] [nondiscrete_normed_field 𝕜₂'] - [normed_space 𝕜₁' E'] [normed_space 𝕜₂' F'] +variables {𝕜₁' : Type*} {𝕜₂' : Type*} [nontrivially_normed_field 𝕜₁'] + [nontrivially_normed_field 𝕜₂'] [normed_space 𝕜₁' E'] [normed_space 𝕜₂' F'] {σ₁' : 𝕜₁' →+* 𝕜} {σ₁₃' : 𝕜₁' →+* 𝕜₃} {σ₂' : 𝕜₂' →+* 𝕜₂} {σ₂₃' : 𝕜₂' →+* 𝕜₃} [ring_hom_comp_triple σ₁' σ₁₃ σ₁₃'] [ring_hom_comp_triple σ₂' σ₂₃ σ₂₃'] [ring_hom_isometric σ₂₃] [ring_hom_isometric σ₁₃'] [ring_hom_isometric σ₂₃'] @@ -1155,122 +1145,91 @@ end semi_normed section normed -variables [normed_group E] [normed_group F] [normed_group G] [normed_group Fₗ] +variables [normed_add_comm_group E] [normed_add_comm_group F] [normed_add_comm_group G] + [normed_add_comm_group Fₗ] open metric continuous_linear_map -section normed_field - -variables [normed_field 𝕜] [normed_space 𝕜 E] [normed_space 𝕜 F] (f : E →ₗ[𝕜] F) - -lemma linear_map.continuous_iff_is_closed_ker {f : E →ₗ[𝕜] 𝕜} : - continuous f ↔ is_closed (f.ker : set E) := -begin - -- the continuity of f obviously implies that its kernel is closed - refine ⟨λh, (t1_space.t1 (0 : 𝕜)).preimage h, λh, _⟩, - -- for the other direction, we assume that the kernel is closed - by_cases hf : ∀x, x ∈ f.ker, - { -- if `f = 0`, its continuity is obvious - have : (f : E → 𝕜) = (λx, 0), by { ext x, simpa using hf x }, - rw this, - exact continuous_const }, - { /- if `f` is not zero, we use an element `x₀ ∉ ker f` such that `∥x₀∥ ≤ 2 ∥x₀ - y∥` for all - `y ∈ ker f`, given by Riesz's lemma, and prove that `2 ∥f x₀∥ / ∥x₀∥` gives a bound on the - operator norm of `f`. For this, start from an arbitrary `x` and note that - `y = x₀ - (f x₀ / f x) x` belongs to the kernel of `f`. Applying the above inequality to `x₀` - and `y` readily gives the conclusion. -/ - push_neg at hf, - let r : ℝ := (2 : ℝ)⁻¹, - have : 0 ≤ r, by norm_num [r], - have : r < 1, by norm_num [r], - obtain ⟨x₀, x₀ker, h₀⟩ : ∃ (x₀ : E), x₀ ∉ f.ker ∧ ∀ y ∈ linear_map.ker f, - r * ∥x₀∥ ≤ ∥x₀ - y∥, from riesz_lemma h hf this, - have : x₀ ≠ 0, - { assume h, - have : x₀ ∈ f.ker, by { rw h, exact (linear_map.ker f).zero_mem }, - exact x₀ker this }, - have rx₀_ne_zero : r * ∥x₀∥ ≠ 0, by { simp [norm_eq_zero, this], }, - have : ∀x, ∥f x∥ ≤ (((r * ∥x₀∥)⁻¹) * ∥f x₀∥) * ∥x∥, - { assume x, - by_cases hx : f x = 0, - { rw [hx, norm_zero], - apply_rules [mul_nonneg, norm_nonneg, inv_nonneg.2] }, - { let y := x₀ - (f x₀ * (f x)⁻¹ ) • x, - have fy_zero : f y = 0, by calc - f y = f x₀ - (f x₀ * (f x)⁻¹ ) * f x : by simp [y] - ... = 0 : - by { rw [mul_assoc, inv_mul_cancel hx, mul_one, sub_eq_zero_of_eq], refl }, - have A : r * ∥x₀∥ ≤ ∥f x₀∥ * ∥f x∥⁻¹ * ∥x∥, from calc - r * ∥x₀∥ ≤ ∥x₀ - y∥ : h₀ _ (linear_map.mem_ker.2 fy_zero) - ... = ∥(f x₀ * (f x)⁻¹ ) • x∥ : by { dsimp [y], congr, abel } - ... = ∥f x₀∥ * ∥f x∥⁻¹ * ∥x∥ : - by rw [norm_smul, norm_mul, norm_inv], - calc - ∥f x∥ = (r * ∥x₀∥)⁻¹ * (r * ∥x₀∥) * ∥f x∥ : by rwa [inv_mul_cancel, one_mul] - ... ≤ (r * ∥x₀∥)⁻¹ * (∥f x₀∥ * ∥f x∥⁻¹ * ∥x∥) * ∥f x∥ : begin - apply mul_le_mul_of_nonneg_right (mul_le_mul_of_nonneg_left A _) (norm_nonneg _), - exact inv_nonneg.2 (mul_nonneg (by norm_num) (norm_nonneg _)) - end - ... = (∥f x∥ ⁻¹ * ∥f x∥) * (((r * ∥x₀∥)⁻¹) * ∥f x₀∥) * ∥x∥ : by ring - ... = (((r * ∥x₀∥)⁻¹) * ∥f x₀∥) * ∥x∥ : - by { rw [inv_mul_cancel, one_mul], simp [norm_eq_zero, hx] } } }, - exact linear_map.continuous_of_bound f _ this } -end - -end normed_field - section -variables [nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂] [nondiscrete_normed_field 𝕜₃] - [normed_space 𝕜 E] [normed_space 𝕜₂ F] [normed_space 𝕜₃ G] [normed_space 𝕜 Fₗ] (c : 𝕜) +variables [nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + [nontrivially_normed_field 𝕜₃] [normed_space 𝕜 E] [normed_space 𝕜₂ F] [normed_space 𝕜₃ G] + [normed_space 𝕜 Fₗ] (c : 𝕜) {σ₁₂ : 𝕜 →+* 𝕜₂} {σ₂₃ : 𝕜₂ →+* 𝕜₃} (f g : E →SL[σ₁₂] F) (x y z : E) -lemma linear_map.bound_of_shell [ring_hom_isometric σ₁₂] (f : E →ₛₗ[σ₁₂] F) {ε C : ℝ} - (ε_pos : 0 < ε) {c : 𝕜} (hc : 1 < ∥c∥) - (hf : ∀ x, ε / ∥c∥ ≤ ∥x∥ → ∥x∥ < ε → ∥f x∥ ≤ C * ∥x∥) (x : E) : - ∥f x∥ ≤ C * ∥x∥ := +namespace linear_map + +lemma bound_of_shell [ring_hom_isometric σ₁₂] (f : E →ₛₗ[σ₁₂] F) {ε C : ℝ} (ε_pos : 0 < ε) {c : 𝕜} + (hc : 1 < ‖c‖) (hf : ∀ x, ε / ‖c‖ ≤ ‖x‖ → ‖x‖ < ε → ‖f x‖ ≤ C * ‖x‖) (x : E) : + ‖f x‖ ≤ C * ‖x‖ := begin by_cases hx : x = 0, { simp [hx] }, - exact linear_map.bound_of_shell_semi_normed f ε_pos hc hf (ne_of_lt (norm_pos_iff.2 hx)).symm + exact semilinear_map_class.bound_of_shell_semi_normed f ε_pos hc hf + (ne_of_lt (norm_pos_iff.2 hx)).symm end /-- `linear_map.bound_of_ball_bound'` is a version of this lemma over a field satisfying `is_R_or_C` that produces a concrete bound. -/ -lemma linear_map.bound_of_ball_bound {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] Fₗ) - (h : ∀ z ∈ metric.ball (0 : E) r, ∥f z∥ ≤ c) : - ∃ C, ∀ (z : E), ∥f z∥ ≤ C * ∥z∥ := +lemma bound_of_ball_bound {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] Fₗ) + (h : ∀ z ∈ metric.ball (0 : E) r, ‖f z‖ ≤ c) : + ∃ C, ∀ (z : E), ‖f z‖ ≤ C * ‖z‖ := begin - cases @nondiscrete_normed_field.non_trivial 𝕜 _ with k hk, - use c * (∥k∥ / r), + cases @nontrivially_normed_field.non_trivial 𝕜 _ with k hk, + use c * (‖k‖ / r), intro z, - refine linear_map.bound_of_shell _ r_pos hk (λ x hko hxo, _) _, - calc ∥f x∥ ≤ c : h _ (mem_ball_zero_iff.mpr hxo) - ... ≤ c * ((∥x∥ * ∥k∥) / r) : le_mul_of_one_le_right _ _ + refine bound_of_shell _ r_pos hk (λ x hko hxo, _) _, + calc ‖f x‖ ≤ c : h _ (mem_ball_zero_iff.mpr hxo) + ... ≤ c * ((‖x‖ * ‖k‖) / r) : le_mul_of_one_le_right _ _ ... = _ : by ring, { exact le_trans (norm_nonneg _) (h 0 (by simp [r_pos])) }, { rw [div_le_iff (zero_lt_one.trans hk)] at hko, exact (one_le_div r_pos).mpr hko } end +lemma antilipschitz_of_comap_nhds_le [h : ring_hom_isometric σ₁₂] (f : E →ₛₗ[σ₁₂] F) + (hf : (𝓝 0).comap f ≤ 𝓝 0) : ∃ K, antilipschitz_with K f := +begin + rcases ((nhds_basis_ball.comap _).le_basis_iff nhds_basis_ball).1 hf 1 one_pos + with ⟨ε, ε0, hε⟩, + simp only [set.subset_def, set.mem_preimage, mem_ball_zero_iff] at hε, + lift ε to ℝ≥0 using ε0.le, + rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, + refine ⟨ε⁻¹ * ‖c‖₊, add_monoid_hom_class.antilipschitz_of_bound f $ λ x, _⟩, + by_cases hx : f x = 0, + { rw [← hx] at hf, + obtain rfl : x = 0 := specializes.eq (specializes_iff_pure.2 $ + ((filter.tendsto_pure_pure _ _).mono_right (pure_le_nhds _)).le_comap.trans hf), + exact norm_zero.trans_le (mul_nonneg (nnreal.coe_nonneg _) (norm_nonneg _)) }, + have hc₀ : c ≠ 0 := norm_pos_iff.1 (one_pos.trans hc), + rw [← h.1] at hc, + rcases rescale_to_shell_zpow hc ε0 hx with ⟨n, -, hlt, -, hle⟩, + simp only [← map_zpow₀, h.1, ← map_smulₛₗ] at hlt hle, + calc ‖x‖ = ‖c ^ n‖⁻¹ * ‖c ^ n • x‖ : + by rwa [← norm_inv, ← norm_smul, inv_smul_smul₀ (zpow_ne_zero _ _)] + ... ≤ ‖c ^ n‖⁻¹ * 1 : + mul_le_mul_of_nonneg_left (hε _ hlt).le (inv_nonneg.2 (norm_nonneg _)) + ... ≤ ε⁻¹ * ‖c‖ * ‖f x‖ : by rwa [mul_one] +end + +end linear_map + namespace continuous_linear_map section op_norm open set real /-- An operator is zero iff its norm vanishes. -/ -theorem op_norm_zero_iff [ring_hom_isometric σ₁₂] : ∥f∥ = 0 ↔ f = 0 := +theorem op_norm_zero_iff [ring_hom_isometric σ₁₂] : ‖f‖ = 0 ↔ f = 0 := iff.intro (λ hn, continuous_linear_map.ext (λ x, norm_le_zero_iff.1 - (calc _ ≤ ∥f∥ * ∥x∥ : le_op_norm _ _ + (calc _ ≤ ‖f‖ * ‖x‖ : le_op_norm _ _ ... = _ : by rw [hn, zero_mul]))) - (λ hf, le_antisymm (cInf_le bounds_bdd_below - ⟨le_rfl, λ _, le_of_eq (by { rw [zero_mul, hf], exact norm_zero })⟩) - (op_norm_nonneg _)) + (by { rintro rfl, exact op_norm_zero }) /-- If a normed space is non-trivial, then the norm of the identity equals `1`. -/ -@[simp] lemma norm_id [nontrivial E] : ∥id 𝕜 E∥ = 1 := +@[simp] lemma norm_id [nontrivial E] : ‖id 𝕜 E‖ = 1 := begin refine norm_id_of_nontrivial_seminorm _, obtain ⟨x, hx⟩ := exists_ne (0 : E), @@ -1281,19 +1240,18 @@ instance norm_one_class [nontrivial E] : norm_one_class (E →L[𝕜] E) := ⟨n /-- Continuous linear maps themselves form a normed space with respect to the operator norm. -/ -instance to_normed_group [ring_hom_isometric σ₁₂] : normed_group (E →SL[σ₁₂] F) := -normed_group.of_core _ ⟨λ f, op_norm_zero_iff f, op_norm_add_le, op_norm_neg⟩ +instance to_normed_add_comm_group [ring_hom_isometric σ₁₂] : normed_add_comm_group (E →SL[σ₁₂] F) := +normed_add_comm_group.of_separation (λ f, (op_norm_zero_iff f).mp) /-- Continuous linear maps form a normed ring with respect to the operator norm. -/ instance to_normed_ring : normed_ring (E →L[𝕜] E) := -{ norm_mul := op_norm_comp_le, - .. continuous_linear_map.to_normed_group } +{ .. continuous_linear_map.to_normed_add_comm_group, .. continuous_linear_map.to_semi_normed_ring } variable {f} lemma homothety_norm [ring_hom_isometric σ₁₂] [nontrivial E] (f : E →SL[σ₁₂] F) {a : ℝ} - (hf : ∀x, ∥f x∥ = a * ∥x∥) : - ∥f∥ = a := + (hf : ∀x, ‖f x‖ = a * ‖x‖) : + ‖f‖ = a := begin obtain ⟨x, hx⟩ : ∃ (x : E), x ≠ 0 := exists_ne 0, rw ← norm_pos_iff at hx, @@ -1302,55 +1260,20 @@ begin simpa only [hf, hx, mul_le_mul_right] using f.le_op_norm x, end -lemma to_span_singleton_norm (x : E) : ∥to_span_singleton 𝕜 x∥ = ∥x∥ := -homothety_norm _ (to_span_singleton_homothety 𝕜 x) - variable (f) -theorem uniform_embedding_of_bound {K : ℝ≥0} (hf : ∀ x, ∥x∥ ≤ K * ∥f x∥) : - uniform_embedding f := -(f.to_linear_map.antilipschitz_of_bound hf).uniform_embedding f.uniform_continuous - -/-- If a continuous linear map is a uniform embedding, then it is expands the distances +/-- If a continuous linear map is a topology embedding, then it is expands the distances by a positive factor.-/ -theorem antilipschitz_of_uniform_embedding (f : E →L[𝕜] Fₗ) (hf : uniform_embedding f) : +theorem antilipschitz_of_embedding (f : E →L[𝕜] Fₗ) (hf : embedding f) : ∃ K, antilipschitz_with K f := -begin - obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ) (H : ε > 0), ∀ {x y : E}, dist (f x) (f y) < ε → dist x y < 1, - from (uniform_embedding_iff.1 hf).2.2 1 zero_lt_one, - let δ := ε/2, - have δ_pos : δ > 0 := half_pos εpos, - have H : ∀{x}, ∥f x∥ ≤ δ → ∥x∥ ≤ 1, - { assume x hx, - have : dist x 0 ≤ 1, - { refine (hε _).le, - rw [f.map_zero, dist_zero_right], - exact hx.trans_lt (half_lt_self εpos) }, - simpa using this }, - rcases normed_field.exists_one_lt_norm 𝕜 with ⟨c, hc⟩, - refine ⟨⟨δ⁻¹, _⟩ * ∥c∥₊, f.to_linear_map.antilipschitz_of_bound $ λx, _⟩, - exact inv_nonneg.2 (le_of_lt δ_pos), - by_cases hx : f x = 0, - { have : f x = f 0, by { simp [hx] }, - have : x = 0 := (uniform_embedding_iff.1 hf).1 this, - simp [this] }, - { rcases rescale_to_shell hc δ_pos hx with ⟨d, hd, dxlt, ledx, dinv⟩, - rw [← f.map_smul d] at dxlt, - have : ∥d • x∥ ≤ 1 := H dxlt.le, - calc ∥x∥ = ∥d∥⁻¹ * ∥d • x∥ : - by rwa [← norm_inv, ← norm_smul, ← mul_smul, inv_mul_cancel, one_smul] - ... ≤ ∥d∥⁻¹ * 1 : - mul_le_mul_of_nonneg_left this (inv_nonneg.2 (norm_nonneg _)) - ... ≤ δ⁻¹ * ∥c∥ * ∥f x∥ : - by rwa [mul_one] } -end +f.to_linear_map.antilipschitz_of_comap_nhds_le $ map_zero f ▸ (hf.nhds_eq_comap 0).ge section completeness -open_locale topological_space +open_locale topology open filter -variables {E' : Type*} [semi_normed_group E'] [normed_space 𝕜 E'] [ring_hom_isometric σ₁₂] +variables {E' : Type*} [seminormed_add_comm_group E'] [normed_space 𝕜 E'] [ring_hom_isometric σ₁₂] /-- Construct a bundled continuous (semi)linear map from a map `f : E → F` and a proof of the fact that it belongs to the closure of the image of a bounded set `s : set (E →SL[σ₁₂] F)` under coercion @@ -1363,10 +1286,10 @@ begin -- `f` is a linear map due to `linear_map_of_mem_closure_range_coe` refine (linear_map_of_mem_closure_range_coe f _).mk_continuous_of_exists_bound _, { refine closure_mono (image_subset_iff.2 $ λ g hg, _) hf, exact ⟨g, rfl⟩ }, - { -- We need to show that `f` has bounded norm. Choose `C` such that `∥g∥ ≤ C` for all `g ∈ s`. + { -- We need to show that `f` has bounded norm. Choose `C` such that `‖g‖ ≤ C` for all `g ∈ s`. rcases bounded_iff_forall_norm_le.1 hs with ⟨C, hC⟩, - -- Then `∥g x∥ ≤ C * ∥x∥` for all `g ∈ s`, `x : E`, hence `∥f x∥ ≤ C * ∥x∥` for all `x`. - have : ∀ x, is_closed {g : E' → F | ∥g x∥ ≤ C * ∥x∥}, + -- Then `‖g x‖ ≤ C * ‖x‖` for all `g ∈ s`, `x : E`, hence `‖f x‖ ≤ C * ‖x‖` for all `x`. + have : ∀ x, is_closed {g : E' → F | ‖g x‖ ≤ C * ‖x‖}, from λ x, is_closed_Iic.preimage (@continuous_apply E' (λ _, F) _ x).norm, refine ⟨C, λ x, (this x).closure_subset_iff.2 (image_subset_iff.2 $ λ g hg, _) hf⟩, exact g.le_of_op_norm_le (hC _ hg) _ } @@ -1389,20 +1312,20 @@ lemma tendsto_of_tendsto_pointwise_of_cauchy_seq {f : ℕ → E' →SL[σ₁₂] (hg : tendsto (λ n x, f n x) at_top (𝓝 g)) (hf : cauchy_seq f) : tendsto f at_top (𝓝 g) := begin - /- Since `f` is a Cauchy sequence, there exists `b → 0` such that `∥f n - f m∥ ≤ b N` for any + /- Since `f` is a Cauchy sequence, there exists `b → 0` such that `‖f n - f m‖ ≤ b N` for any `m, n ≥ N`. -/ rcases cauchy_seq_iff_le_tendsto_0.1 hf with ⟨b, hb₀, hfb, hb_lim⟩, - -- Since `b → 0`, it suffices to show that `∥f n x - g x∥ ≤ b n * ∥x∥` for all `n` and `x`. - suffices : ∀ n x, ∥f n x - g x∥ ≤ b n * ∥x∥, + -- Since `b → 0`, it suffices to show that `‖f n x - g x‖ ≤ b n * ‖x‖` for all `n` and `x`. + suffices : ∀ n x, ‖f n x - g x‖ ≤ b n * ‖x‖, from tendsto_iff_norm_tendsto_zero.2 (squeeze_zero (λ n, norm_nonneg _) (λ n, op_norm_le_bound _ (hb₀ n) (this n)) hb_lim), intros n x, - -- Note that `f m x → g x`, hence `∥f n x - f m x∥ → ∥f n x - g x∥` as `m → ∞` - have : tendsto (λ m, ∥f n x - f m x∥) at_top (𝓝 (∥f n x - g x∥)), + -- Note that `f m x → g x`, hence `‖f n x - f m x‖ → ‖f n x - g x‖` as `m → ∞` + have : tendsto (λ m, ‖f n x - f m x‖) at_top (𝓝 (‖f n x - g x‖)), from (tendsto_const_nhds.sub $ tendsto_pi_nhds.1 hg _).norm, - -- Thus it suffices to verify `∥f n x - f m x∥ ≤ b n * ∥x∥` for `m ≥ n`. + -- Thus it suffices to verify `‖f n x - f m x‖ ≤ b n * ‖x‖` for `m ≥ n`. refine le_of_tendsto this (eventually_at_top.2 ⟨n, λ m hm, _⟩), - -- This inequality follows from `∥f n - f m∥ ≤ b n`. + -- This inequality follows from `‖f n - f m‖ ≤ b n`. exact (f n - f m).le_of_op_norm_le (hfb _ _ _ le_rfl hm) _ end @@ -1436,7 +1359,7 @@ lemma is_compact_closure_image_coe_of_bounded [proper_space F] {s : set (E' →S is_compact (closure ((coe_fn : (E' →SL[σ₁₂] F) → E' → F) '' s)) := have ∀ x, is_compact (closure (apply' F σ₁₂ x '' s)), from λ x, ((apply' F σ₁₂ x).lipschitz.bounded_image hb).is_compact_closure, -compact_closure_of_subset_compact (is_compact_pi_infinite this) +is_compact_closure_of_subset_compact (is_compact_pi_infinite this) (image_subset_iff.2 $ λ g hg x, subset_closure $ mem_image_of_mem _ hg) /-- Let `s` be a bounded set in the space of continuous (semi)linear maps `E →SL[σ] F` taking values @@ -1480,7 +1403,7 @@ begin have hr : 0 ≤ r, from nonempty_closed_ball.1 (nonempty_image_iff.1 (closure_nonempty_iff.1 ⟨_, hf⟩)), refine mem_closed_ball_iff_norm.2 (op_norm_le_bound _ hr $ λ x, _), - have : is_closed {g : E' → F | ∥g x - f₀ x∥ ≤ r * ∥x∥}, + have : is_closed {g : E' → F | ‖g x - f₀ x‖ ≤ r * ‖x‖}, from is_closed_Iic.preimage ((@continuous_apply E' (λ _, F) _ x).sub continuous_const).norm, refine this.closure_subset_iff.2 (image_subset_iff.2 $ λ g hg, _) hf, exact (g - f₀).le_of_op_norm_le (mem_closed_ball_iff_norm.1 hg) _ @@ -1531,10 +1454,13 @@ have eq : _ := uniformly_extend_of_ind h_e h_dense f.uniform_continuous, refine (λ b, h_dense.induction_on b _ _), { exact is_closed_eq (cont.comp (continuous_const_smul _)) ((continuous_const_smul _).comp cont) }, - { assume x, rw ← map_smul, simp only [eq], exact map_smulₛₗ _ _ _ }, + { assume x, rw ← map_smul, simp only [eq], exact continuous_linear_map.map_smulₛₗ _ _ _ }, end, cont := cont } +@[simp] lemma extend_eq (x : E) : extend f e h_dense h_e (e x) = f x := +dense_inducing.extend_eq _ f.cont _ + lemma extend_unique (g : Fₗ →SL[σ₁₂] F) (H : g.comp e = f) : extend f e h_dense h_e = g := continuous_linear_map.coe_fn_injective $ uniformly_extend_unique h_e h_dense (continuous_linear_map.ext_iff.1 H) g.continuous @@ -1545,13 +1471,13 @@ extend_unique _ _ _ _ _ (zero_comp _) end section -variables {N : ℝ≥0} (h_e : ∀x, ∥x∥ ≤ N * ∥e x∥) [ring_hom_isometric σ₁₂] +variables {N : ℝ≥0} (h_e : ∀x, ‖x‖ ≤ N * ‖e x‖) [ring_hom_isometric σ₁₂] local notation `ψ` := f.extend e h_dense (uniform_embedding_of_bound _ h_e).to_uniform_inducing /-- If a dense embedding `e : E →L[𝕜] G` expands the norm by a constant factor `N⁻¹`, then the -norm of the extension of `f` along `e` is bounded by `N * ∥f∥`. -/ -lemma op_norm_extend_le : ∥ψ∥ ≤ N * ∥f∥ := +norm of the extension of `f` along `e` is bounded by `N * ‖f‖`. -/ +lemma op_norm_extend_le : ‖ψ‖ ≤ N * ‖f‖ := begin have uni : uniform_inducing e := (uniform_embedding_of_bound _ h_e).to_uniform_inducing, have eq : ∀x, ψ (e x) = f x := uniformly_extend_of_ind uni h_dense f.uniform_continuous, @@ -1562,9 +1488,9 @@ begin { exact continuous_const.mul continuous_norm }, { assume x, rw eq, - calc ∥f x∥ ≤ ∥f∥ * ∥x∥ : le_op_norm _ _ - ... ≤ ∥f∥ * (N * ∥e x∥) : mul_le_mul_of_nonneg_left (h_e x) (norm_nonneg _) - ... ≤ N * ∥f∥ * ∥e x∥ : by rw [mul_comm ↑N ∥f∥, mul_assoc] } }, + calc ‖f x‖ ≤ ‖f‖ * ‖x‖ : le_op_norm _ _ + ... ≤ ‖f‖ * (N * ‖e x‖) : mul_le_mul_of_nonneg_left (h_e x) (norm_nonneg _) + ... ≤ N * ‖f‖ * ‖e x‖ : by rw [mul_comm ↑N ‖f‖, mul_assoc] } }, { have he : ∀ x : E, x = 0, { assume x, have N0 : N ≤ 0 := le_of_lt (lt_of_not_ge N0), @@ -1587,7 +1513,7 @@ namespace linear_isometry @[simp] lemma norm_to_continuous_linear_map [nontrivial E] [ring_hom_isometric σ₁₂] (f : E →ₛₗᵢ[σ₁₂] F) : - ∥f.to_continuous_linear_map∥ = 1 := + ‖f.to_continuous_linear_map‖ = 1 := f.to_continuous_linear_map.homothety_norm $ by simp variables {σ₁₃ : 𝕜 →+* 𝕜₃} [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] @@ -1597,7 +1523,7 @@ include σ₁₃ the operator norm. -/ lemma norm_to_continuous_linear_map_comp [ring_hom_isometric σ₁₂] (f : F →ₛₗᵢ[σ₂₃] G) {g : E →SL[σ₁₂] F} : - ∥f.to_continuous_linear_map.comp g∥ = ∥g∥ := + ‖f.to_continuous_linear_map.comp g‖ = ‖g‖ := op_norm_ext (f.to_continuous_linear_map.comp g) g (λ x, by simp only [norm_map, coe_to_continuous_linear_map, coe_comp']) omit σ₁₃ @@ -1608,11 +1534,12 @@ end namespace continuous_linear_map -variables [nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂] [nondiscrete_normed_field 𝕜₃] - [normed_space 𝕜 E] [normed_space 𝕜₂ F] [normed_space 𝕜₃ G] [normed_space 𝕜 Fₗ] (c : 𝕜) +variables [nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + [nontrivially_normed_field 𝕜₃] [normed_space 𝕜 E] [normed_space 𝕜₂ F] [normed_space 𝕜₃ G] + [normed_space 𝕜 Fₗ] (c : 𝕜) {σ₁₂ : 𝕜 →+* 𝕜₂} {σ₂₃ : 𝕜₂ →+* 𝕜₃} -variables {𝕜₂' : Type*} [nondiscrete_normed_field 𝕜₂'] {F' : Type*} [normed_group F'] +variables {𝕜₂' : Type*} [nontrivially_normed_field 𝕜₂'] {F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜₂' F'] {σ₂' : 𝕜₂' →+* 𝕜₂} {σ₂'' : 𝕜₂ →+* 𝕜₂'} {σ₂₃' : 𝕜₂' →+* 𝕜₃} [ring_hom_inv_pair σ₂' σ₂''] [ring_hom_inv_pair σ₂'' σ₂'] @@ -1623,7 +1550,7 @@ variables {𝕜₂' : Type*} [nondiscrete_normed_field 𝕜₂'] {F' : Type*} [n include σ₂'' σ₂₃' /-- Precomposition with a linear isometry preserves the operator norm. -/ lemma op_norm_comp_linear_isometry_equiv (f : F →SL[σ₂₃] G) (g : F' ≃ₛₗᵢ[σ₂'] F) : - ∥f.comp g.to_linear_isometry.to_continuous_linear_map∥ = ∥f∥ := + ‖f.comp g.to_linear_isometry.to_continuous_linear_map‖ = ‖f‖ := begin casesI subsingleton_or_nontrivial F', { haveI := g.symm.to_linear_equiv.to_equiv.subsingleton, @@ -1643,30 +1570,30 @@ omit σ₂'' σ₂₃' /-- The norm of the tensor product of a scalar linear map and of an element of a normed space is the product of the norms. -/ @[simp] lemma norm_smul_right_apply (c : E →L[𝕜] 𝕜) (f : Fₗ) : - ∥smul_right c f∥ = ∥c∥ * ∥f∥ := + ‖smul_right c f‖ = ‖c‖ * ‖f‖ := begin refine le_antisymm _ _, { apply op_norm_le_bound _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) (λx, _), calc - ∥(c x) • f∥ = ∥c x∥ * ∥f∥ : norm_smul _ _ - ... ≤ (∥c∥ * ∥x∥) * ∥f∥ : + ‖(c x) • f‖ = ‖c x‖ * ‖f‖ : norm_smul _ _ + ... ≤ (‖c‖ * ‖x‖) * ‖f‖ : mul_le_mul_of_nonneg_right (le_op_norm _ _) (norm_nonneg _) - ... = ∥c∥ * ∥f∥ * ∥x∥ : by ring }, + ... = ‖c‖ * ‖f‖ * ‖x‖ : by ring }, { by_cases h : f = 0, { simp [h] }, - { have : 0 < ∥f∥ := norm_pos_iff.2 h, + { have : 0 < ‖f‖ := norm_pos_iff.2 h, rw ← le_div_iff this, apply op_norm_le_bound _ (div_nonneg (norm_nonneg _) (norm_nonneg f)) (λx, _), rw [div_mul_eq_mul_div, le_div_iff this], - calc ∥c x∥ * ∥f∥ = ∥c x • f∥ : (norm_smul _ _).symm - ... = ∥smul_right c f x∥ : rfl - ... ≤ ∥smul_right c f∥ * ∥x∥ : le_op_norm _ _ } }, + calc ‖c x‖ * ‖f‖ = ‖c x • f‖ : (norm_smul _ _).symm + ... = ‖smul_right c f x‖ : rfl + ... ≤ ‖smul_right c f‖ * ‖x‖ : le_op_norm _ _ } }, end /-- The non-negative norm of the tensor product of a scalar linear map and of an element of a normed space is the product of the non-negative norms. -/ @[simp] lemma nnnorm_smul_right_apply (c : E →L[𝕜] 𝕜) (f : Fₗ) : - ∥smul_right c f∥₊ = ∥c∥₊ * ∥f∥₊ := + ‖smul_right c f‖₊ = ‖c‖₊ * ‖f‖₊ := nnreal.eq $ c.norm_smul_right_apply f variables (𝕜 E Fₗ) @@ -1686,11 +1613,11 @@ linear_map.mk_continuous₂ variables {𝕜 E Fₗ} @[simp] lemma norm_smul_rightL_apply (c : E →L[𝕜] 𝕜) (f : Fₗ) : - ∥smul_rightL 𝕜 E Fₗ c f∥ = ∥c∥ * ∥f∥ := + ‖smul_rightL 𝕜 E Fₗ c f‖ = ‖c‖ * ‖f‖ := norm_smul_right_apply c f @[simp] lemma norm_smul_rightL (c : E →L[𝕜] 𝕜) [nontrivial Fₗ] : - ∥smul_rightL 𝕜 E Fₗ c∥ = ∥c∥ := + ‖smul_rightL 𝕜 E Fₗ c‖ = ‖c‖ := continuous_linear_map.homothety_norm _ c.norm_smul_right_apply variables (𝕜) (𝕜' : Type*) @@ -1698,11 +1625,9 @@ variables (𝕜) (𝕜' : Type*) section variables [normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] -@[simp] lemma op_norm_lmul [norm_one_class 𝕜'] : ∥lmul 𝕜 𝕜'∥ = 1 := -by haveI := norm_one_class.nontrivial 𝕜'; exact (lmulₗᵢ 𝕜 𝕜').norm_to_continuous_linear_map +@[simp] lemma op_norm_mul [norm_one_class 𝕜'] : ‖mul 𝕜 𝕜'‖ = 1 := +by haveI := norm_one_class.nontrivial 𝕜'; exact (mulₗᵢ 𝕜 𝕜').norm_to_continuous_linear_map -@[simp] lemma op_norm_lmul_right [norm_one_class 𝕜'] : ∥lmul_right 𝕜 𝕜'∥ = 1 := -(op_norm_flip (@lmul 𝕜 _ 𝕜' _ _)).trans (op_norm_lmul _ _) end /-- The norm of `lsmul` equals 1 in any nontrivial normed group. @@ -1710,7 +1635,7 @@ end This is `continuous_linear_map.op_norm_lsmul_le` as an equality. -/ @[simp] lemma op_norm_lsmul [normed_field 𝕜'] [normed_algebra 𝕜 𝕜'] [normed_space 𝕜' E] [is_scalar_tower 𝕜 𝕜' E] [nontrivial E] : - ∥(lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] E →L[𝕜] E)∥ = 1 := + ‖(lsmul 𝕜 𝕜' : 𝕜' →L[𝕜] E →L[𝕜] E)‖ = 1 := begin refine continuous_linear_map.op_norm_eq_of_bounds zero_le_one (λ x, _) (λ N hN h, _), { rw one_mul, @@ -1725,28 +1650,29 @@ end end continuous_linear_map namespace submodule -variables [nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂] [nondiscrete_normed_field 𝕜₃] - [normed_space 𝕜 E] [normed_space 𝕜₂ F] {σ₁₂ : 𝕜 →+* 𝕜₂} +variables [nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + [nontrivially_normed_field 𝕜₃] [normed_space 𝕜 E] [normed_space 𝕜₂ F] {σ₁₂ : 𝕜 →+* 𝕜₂} -lemma norm_subtypeL (K : submodule 𝕜 E) [nontrivial K] : ∥K.subtypeL∥ = 1 := +lemma norm_subtypeL (K : submodule 𝕜 E) [nontrivial K] : ‖K.subtypeL‖ = 1 := K.subtypeₗᵢ.norm_to_continuous_linear_map end submodule namespace continuous_linear_equiv -variables [nondiscrete_normed_field 𝕜] [nondiscrete_normed_field 𝕜₂] [nondiscrete_normed_field 𝕜₃] - [normed_space 𝕜 E] [normed_space 𝕜₂ F] {σ₁₂ : 𝕜 →+* 𝕜₂} {σ₂₁ : 𝕜₂ →+* 𝕜} +variables [nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] + [nontrivially_normed_field 𝕜₃] [normed_space 𝕜 E] [normed_space 𝕜₂ F] + {σ₁₂ : 𝕜 →+* 𝕜₂} {σ₂₁ : 𝕜₂ →+* 𝕜} [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂] section variables [ring_hom_isometric σ₂₁] protected lemma antilipschitz (e : E ≃SL[σ₁₂] F) : - antilipschitz_with ∥(e.symm : F →SL[σ₂₁] E)∥₊ e := + antilipschitz_with ‖(e.symm : F →SL[σ₂₁] E)‖₊ e := e.symm.lipschitz.to_right_inverse e.left_inv lemma one_le_norm_mul_norm_symm [ring_hom_isometric σ₁₂] [nontrivial E] (e : E ≃SL[σ₁₂] F) : - 1 ≤ ∥(e : E →SL[σ₁₂] F)∥ * ∥(e.symm : F →SL[σ₂₁] E)∥ := + 1 ≤ ‖(e : E →SL[σ₁₂] F)‖ * ‖(e.symm : F →SL[σ₂₁] E)‖ := begin rw [mul_comm], convert (e.symm : F →SL[σ₂₁] E).op_norm_comp_le (e : E →SL[σ₁₂] F), @@ -1755,20 +1681,20 @@ end include σ₂₁ lemma norm_pos [ring_hom_isometric σ₁₂] [nontrivial E] (e : E ≃SL[σ₁₂] F) : - 0 < ∥(e : E →SL[σ₁₂] F)∥ := -pos_of_mul_pos_right (lt_of_lt_of_le zero_lt_one e.one_le_norm_mul_norm_symm) (norm_nonneg _) + 0 < ‖(e : E →SL[σ₁₂] F)‖ := +pos_of_mul_pos_left (lt_of_lt_of_le zero_lt_one e.one_le_norm_mul_norm_symm) (norm_nonneg _) omit σ₂₁ lemma norm_symm_pos [ring_hom_isometric σ₁₂] [nontrivial E] (e : E ≃SL[σ₁₂] F) : - 0 < ∥(e.symm : F →SL[σ₂₁] E)∥ := -pos_of_mul_pos_left (lt_of_lt_of_le zero_lt_one e.one_le_norm_mul_norm_symm) (norm_nonneg _) + 0 < ‖(e.symm : F →SL[σ₂₁] E)‖ := +pos_of_mul_pos_right (zero_lt_one.trans_le e.one_le_norm_mul_norm_symm) (norm_nonneg _) lemma nnnorm_symm_pos [ring_hom_isometric σ₁₂] [nontrivial E] (e : E ≃SL[σ₁₂] F) : - 0 < ∥(e.symm : F →SL[σ₂₁] E)∥₊ := + 0 < ‖(e.symm : F →SL[σ₂₁] E)‖₊ := e.norm_symm_pos lemma subsingleton_or_norm_symm_pos [ring_hom_isometric σ₁₂] (e : E ≃SL[σ₁₂] F) : - subsingleton E ∨ 0 < ∥(e.symm : F →SL[σ₂₁] E)∥ := + subsingleton E ∨ 0 < ‖(e.symm : F →SL[σ₂₁] E)‖ := begin rcases subsingleton_or_nontrivial E with _i|_i; resetI, { left, apply_instance }, @@ -1776,85 +1702,19 @@ begin end lemma subsingleton_or_nnnorm_symm_pos [ring_hom_isometric σ₁₂] (e : E ≃SL[σ₁₂] F) : - subsingleton E ∨ 0 < ∥(e.symm : F →SL[σ₂₁] E)∥₊ := + subsingleton E ∨ 0 < ‖(e.symm : F →SL[σ₂₁] E)‖₊ := subsingleton_or_norm_symm_pos e variable (𝕜) -/-- Given a nonzero element `x` of a normed space `E₁` over a field `𝕜`, the natural - continuous linear equivalence from `E₁` to the span of `x`.-/ -def to_span_nonzero_singleton (x : E) (h : x ≠ 0) : 𝕜 ≃L[𝕜] (𝕜 ∙ x) := -of_homothety - (linear_equiv.to_span_nonzero_singleton 𝕜 E x h) - ∥x∥ - (norm_pos_iff.mpr h) - (to_span_nonzero_singleton_homothety 𝕜 x h) - -/-- Given a nonzero element `x` of a normed space `E₁` over a field `𝕜`, the natural continuous - linear map from the span of `x` to `𝕜`.-/ -def coord (x : E) (h : x ≠ 0) : (𝕜 ∙ x) →L[𝕜] 𝕜 := (to_span_nonzero_singleton 𝕜 x h).symm - -@[simp] lemma coe_to_span_nonzero_singleton_symm {x : E} (h : x ≠ 0) : - ⇑(to_span_nonzero_singleton 𝕜 x h).symm = coord 𝕜 x h := rfl - -@[simp] lemma coord_to_span_nonzero_singleton {x : E} (h : x ≠ 0) (c : 𝕜) : - coord 𝕜 x h (to_span_nonzero_singleton 𝕜 x h c) = c := -(to_span_nonzero_singleton 𝕜 x h).symm_apply_apply c - -@[simp] lemma to_span_nonzero_singleton_coord {x : E} (h : x ≠ 0) (y : 𝕜 ∙ x) : - to_span_nonzero_singleton 𝕜 x h (coord 𝕜 x h y) = y := -(to_span_nonzero_singleton 𝕜 x h).apply_symm_apply y - -@[simp] lemma coord_norm (x : E) (h : x ≠ 0) : ∥coord 𝕜 x h∥ = ∥x∥⁻¹ := +@[simp] lemma coord_norm (x : E) (h : x ≠ 0) : ‖coord 𝕜 x h‖ = ‖x‖⁻¹ := begin - have hx : 0 < ∥x∥ := (norm_pos_iff.mpr h), + have hx : 0 < ‖x‖ := (norm_pos_iff.mpr h), haveI : nontrivial (𝕜 ∙ x) := submodule.nontrivial_span_singleton h, exact continuous_linear_map.homothety_norm _ (λ y, homothety_inverse _ hx _ (to_span_nonzero_singleton_homothety 𝕜 x h) _) end -@[simp] lemma coord_self (x : E) (h : x ≠ 0) : - (coord 𝕜 x h) (⟨x, submodule.mem_span_singleton_self x⟩ : 𝕜 ∙ x) = 1 := -linear_equiv.coord_self 𝕜 E x h - -variables {𝕜} {𝕜₄ : Type*} [nondiscrete_normed_field 𝕜₄] -variables {H : Type*} [normed_group H] [normed_space 𝕜₄ H] [normed_space 𝕜₃ G] -variables {σ₂₃ : 𝕜₂ →+* 𝕜₃} {σ₁₃ : 𝕜 →+* 𝕜₃} -variables {σ₃₄ : 𝕜₃ →+* 𝕜₄} {σ₄₃ : 𝕜₄ →+* 𝕜₃} -variables {σ₂₄ : 𝕜₂ →+* 𝕜₄} {σ₁₄ : 𝕜 →+* 𝕜₄} -variables [ring_hom_inv_pair σ₃₄ σ₄₃] [ring_hom_inv_pair σ₄₃ σ₃₄] -variables [ring_hom_comp_triple σ₂₁ σ₁₄ σ₂₄] [ring_hom_comp_triple σ₂₄ σ₄₃ σ₂₃] -variables [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄] -variables [ring_hom_isometric σ₁₄] [ring_hom_isometric σ₂₃] -variables [ring_hom_isometric σ₄₃] [ring_hom_isometric σ₂₄] -variables [ring_hom_isometric σ₁₃] [ring_hom_isometric σ₁₂] -variables [ring_hom_isometric σ₃₄] - -include σ₂₁ σ₃₄ σ₁₃ σ₂₄ -/-- A pair of continuous (semi)linear equivalences generates an continuous (semi)linear equivalence -between the spaces of continuous (semi)linear maps. -/ -def arrow_congrSL (e₁₂ : E ≃SL[σ₁₂] F) (e₄₃ : H ≃SL[σ₄₃] G) : - (E →SL[σ₁₄] H) ≃SL[σ₄₃] (F →SL[σ₂₃] G) := -{ map_add' := λ f g, by simp only [equiv.to_fun_as_coe, add_comp, comp_add, - continuous_linear_equiv.arrow_congr_equiv_apply], - map_smul' := λ t f, by simp only [equiv.to_fun_as_coe, smul_comp, comp_smulₛₗ, - continuous_linear_equiv.arrow_congr_equiv_apply], - continuous_to_fun := (compSL F H G σ₂₄ σ₄₃ e₄₃).continuous.comp - (continuous_linear_map.flip (compSL F E H σ₂₁ σ₁₄) e₁₂.symm).continuous, - continuous_inv_fun := (compSL E G H σ₁₃ σ₃₄ e₄₃.symm).continuous.comp - (continuous_linear_map.flip (compSL E F G σ₁₂ σ₂₃) e₁₂).continuous, - .. e₁₂.arrow_congr_equiv e₄₃, } - -omit σ₂₁ σ₃₄ σ₁₃ σ₂₄ - -/-- A pair of continuous linear equivalences generates an continuous linear equivalence between -the spaces of continuous linear maps. -/ -def arrow_congr {F H : Type*} [normed_group F] [normed_group H] - [normed_space 𝕜 F] [normed_space 𝕜 G] [normed_space 𝕜 H] - (e₁ : E ≃L[𝕜] F) (e₂ : H ≃L[𝕜] G) : - (E →L[𝕜] H) ≃L[𝕜] (F →L[𝕜] G) := -arrow_congrSL e₁ e₂ - end end continuous_linear_equiv @@ -1863,9 +1723,9 @@ end normed /-- A bounded bilinear form `B` in a real normed space is *coercive* -if there is some positive constant C such that `C * ∥u∥ * ∥u∥ ≤ B u u`. +if there is some positive constant C such that `C * ‖u‖ * ‖u‖ ≤ B u u`. -/ def is_coercive - [normed_group E] [normed_space ℝ E] + [normed_add_comm_group E] [normed_space ℝ E] (B : E →L[ℝ] E →L[ℝ] ℝ) : Prop := -∃ C, (0 < C) ∧ ∀ u, C * ∥u∥ * ∥u∥ ≤ B u u +∃ C, (0 < C) ∧ ∀ u, C * ‖u‖ * ‖u‖ ≤ B u u diff --git a/src/analysis/normed_space/ordered.lean b/src/analysis/normed_space/ordered.lean deleted file mode 100644 index 92612591ab467..0000000000000 --- a/src/analysis/normed_space/ordered.lean +++ /dev/null @@ -1,50 +0,0 @@ -/- -Copyright (c) 2020 Anatole Dedecker. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Anatole Dedecker --/ -import analysis.normed_space.basic - -/-! -# Ordered normed spaces - -In this file, we define classes for fields and groups that are both normed and ordered. -These are mostly useful to avoid diamonds during type class inference. --/ - -open filter set -open_locale topological_space - -/-- A `normed_linear_ordered_group` is an additive group that is both a `normed_group` and - a `linear_ordered_add_comm_group`. This class is necessary to avoid diamonds. -/ -class normed_linear_ordered_group (α : Type*) -extends linear_ordered_add_comm_group α, has_norm α, metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) - -@[priority 100] instance normed_linear_ordered_group.to_normed_group (α : Type*) - [normed_linear_ordered_group α] : normed_group α := -⟨normed_linear_ordered_group.dist_eq⟩ - -/-- A `normed_linear_ordered_field` is a field that is both a `normed_field` and a - `linear_ordered_field`. This class is necessary to avoid diamonds. -/ -class normed_linear_ordered_field (α : Type*) -extends linear_ordered_field α, has_norm α, metric_space α := -(dist_eq : ∀ x y, dist x y = norm (x - y)) -(norm_mul' : ∀ a b, norm (a * b) = norm a * norm b) - -@[priority 100] instance normed_linear_ordered_field.to_normed_field (α : Type*) - [normed_linear_ordered_field α] : normed_field α := -{ dist_eq := normed_linear_ordered_field.dist_eq, - norm_mul' := normed_linear_ordered_field.norm_mul' } - -@[priority 100] instance normed_linear_ordered_field.to_normed_linear_ordered_group (α : Type*) -[normed_linear_ordered_field α] : normed_linear_ordered_group α := -⟨normed_linear_ordered_field.dist_eq⟩ - -noncomputable -instance : normed_linear_ordered_field ℚ := -⟨dist_eq_norm, norm_mul⟩ - -noncomputable -instance : normed_linear_ordered_field ℝ := -⟨dist_eq_norm, norm_mul⟩ diff --git a/src/analysis/normed_space/pi_Lp.lean b/src/analysis/normed_space/pi_Lp.lean index 888405d93df83..11056f463a979 100644 --- a/src/analysis/normed_space/pi_Lp.lean +++ b/src/analysis/normed_space/pi_Lp.lean @@ -1,28 +1,37 @@ /- Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sébastien Gouëzel +Authors: Sébastien Gouëzel, Jireh Loreaux -/ import analysis.mean_inequalities +import data.fintype.order +import linear_algebra.matrix.basis /-! # `L^p` distance on finite products of metric spaces + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given finitely many metric spaces, one can put the max distance on their product, but there is also -a whole family of natural distances, indexed by a real parameter `p ∈ [1, ∞)`, that also induce -the product topology. We define them in this file. The distance on `Π i, α i` is given by +a whole family of natural distances, indexed by a parameter `p : ℝ≥0∞`, that also induce +the product topology. We define them in this file. For `0 < p < ∞`, the distance on `Π i, α i` +is given by $$ d(x, y) = \left(\sum d(x_i, y_i)^p\right)^{1/p}. -$$ +$$, +whereas for `p = 0` it is the cardinality of the set ${ i | x_i ≠ y_i}$. For `p = ∞` the distance +is the supremum of the distances. We give instances of this construction for emetric spaces, metric spaces, normed groups and normed spaces. -To avoid conflicting instances, all these are defined on a copy of the original Pi type, named +To avoid conflicting instances, all these are defined on a copy of the original Π-type, named `pi_Lp p α`. The assumpion `[fact (1 ≤ p)]` is required for the metric and normed space instances. -We ensure that the topology and uniform structure on `pi_Lp p α` are (defeq to) the product -topology and product uniformity, to be able to use freely continuity statements for the coordinate -functions, for instance. +We ensure that the topology, bornology and uniform structure on `pi_Lp p α` are (defeq to) the +product topology, product bornology and product uniformity, to be able to use freely continuity +statements for the coordinate functions, for instance. ## Implementation notes @@ -30,7 +39,7 @@ We only deal with the `L^p` distance on a product of finitely many metric spaces distinct. A closely related construction is `lp`, the `L^p` norm on a product of (possibly infinitely many) normed spaces, where the norm is $$ -\left(\sum ∥f (x)∥^p \right)^{1/p}. +\left(\sum ‖f (x)‖^p \right)^{1/p}. $$ However, the topology induced by this construction is not the product topology, and some functions have infinite `L^p` norm. These subtleties are not present in the case of finitely many metric @@ -39,7 +48,7 @@ spaces, hence it is worth devoting a file to this specific case which is particu Another related construction is `measure_theory.Lp`, the `L^p` norm on the space of functions from a measure space to a normed space, where the norm is $$ -\left(\int ∥f (x)∥^p dμ\right)^{1/p}. +\left(\int ‖f (x)‖^p dμ\right)^{1/p}. $$ This has all the same subtleties as `lp`, and the further subtlety that this only defines a seminorm (as almost everywhere zero functions have zero `L^p` norm). @@ -54,39 +63,159 @@ are equivalent on `ℝ^n` for abstract (norm equivalence) reasons. Instead, we g We also set up the theory for `pseudo_emetric_space` and `pseudo_metric_space`. -/ -open real set filter is_R_or_C -open_locale big_operators uniformity topological_space nnreal ennreal +open real set filter is_R_or_C bornology +open_locale big_operators uniformity topology nnreal ennreal noncomputable theory -variables {ι : Type*} - /-- A copy of a Pi type, on which we will put the `L^p` distance. Since the Pi type itself is already endowed with the `L^∞` distance, we need the type synonym to avoid confusing typeclass resolution. Also, we let it depend on `p`, to get a whole family of type on which we can put different distances. -/ @[nolint unused_arguments] -def pi_Lp {ι : Type*} (p : ℝ) (α : ι → Type*) : Type* := Π (i : ι), α i +def pi_Lp (p : ℝ≥0∞) {ι : Type*} (α : ι → Type*) : Type* := Π (i : ι), α i -instance {ι : Type*} (p : ℝ) (α : ι → Type*) [∀ i, inhabited (α i)] : inhabited (pi_Lp p α) := +instance (p : ℝ≥0∞) {ι : Type*} (α : ι → Type*) [Π i, inhabited (α i)] : inhabited (pi_Lp p α) := ⟨λ i, default⟩ -instance fact_one_le_one_real : fact ((1:ℝ) ≤ 1) := ⟨rfl.le⟩ -instance fact_one_le_two_real : fact ((1:ℝ) ≤ 2) := ⟨one_le_two⟩ - namespace pi_Lp -variables (p : ℝ) [fact_one_le_p : fact (1 ≤ p)] (α : ι → Type*) (β : ι → Type*) +variables (p : ℝ≥0∞) (𝕜 𝕜' : Type*) {ι : Type*} (α : ι → Type*) (β : ι → Type*) /-- Canonical bijection between `pi_Lp p α` and the original Pi type. We introduce it to be able to compare the `L^p` and `L^∞` distances through it. -/ protected def equiv : pi_Lp p α ≃ Π (i : ι), α i := equiv.refl _ +/-! Note that the unapplied versions of these lemmas are deliberately omitted, as they break +the use of the type synonym. -/ + @[simp] lemma equiv_apply (x : pi_Lp p α) (i : ι) : pi_Lp.equiv p α x i = x i := rfl @[simp] lemma equiv_symm_apply (x : Π i, α i) (i : ι) : (pi_Lp.equiv p α).symm x i = x i := rfl -section +section dist_norm +variables [fintype ι] + +/-! +### Definition of `edist`, `dist` and `norm` on `pi_Lp` + +In this section we define the `edist`, `dist` and `norm` functions on `pi_Lp p α` without assuming +`[fact (1 ≤ p)]` or metric properties of the spaces `α i`. This allows us to provide the rewrite +lemmas for each of three cases `p = 0`, `p = ∞` and `0 < p.to_real`. +-/ + +section edist + +variables [Π i, has_edist (β i)] +/-- Endowing the space `pi_Lp p β` with the `L^p` edistance. We register this instance +separate from `pi_Lp.pseudo_emetric` since the latter requires the type class hypothesis +`[fact (1 ≤ p)]` in order to prove the triangle inequality. + +Registering this separately allows for a future emetric-like structure on `pi_Lp p β` for `p < 1` +satisfying a relaxed triangle inequality. The terminology for this varies throughout the +literature, but it is sometimes called a *quasi-metric* or *semi-metric*. -/ +instance : has_edist (pi_Lp p β) := +{ edist := λ f g, if hp : p = 0 then {i | f i ≠ g i}.to_finite.to_finset.card + else (if p = ∞ then ⨆ i, edist (f i) (g i) + else (∑ i, (edist (f i) (g i) ^ p.to_real)) ^ (1/p.to_real)) } + +variable {β} +lemma edist_eq_card (f g : pi_Lp 0 β) : edist f g = {i | f i ≠ g i}.to_finite.to_finset.card := +if_pos rfl + +lemma edist_eq_sum {p : ℝ≥0∞} (hp : 0 < p.to_real) (f g : pi_Lp p β) : + edist f g = (∑ i, edist (f i) (g i) ^ p.to_real) ^ (1/p.to_real) := +let hp' := ennreal.to_real_pos_iff.mp hp in (if_neg hp'.1.ne').trans (if_neg hp'.2.ne) + +lemma edist_eq_supr (f g : pi_Lp ∞ β) : edist f g = ⨆ i, edist (f i) (g i) := +by { dsimp [edist], exact if_neg ennreal.top_ne_zero } + +end edist + +section edist_prop + +variables {β} [Π i, pseudo_emetric_space (β i)] + +/-- This holds independent of `p` and does not require `[fact (1 ≤ p)]`. We keep it separate +from `pi_Lp.pseudo_emetric_space` so it can be used also for `p < 1`. -/ +protected lemma edist_self (f : pi_Lp p β) : edist f f = 0 := +begin + rcases p.trichotomy with (rfl | rfl | h), + { simp [edist_eq_card], }, + { simp [edist_eq_supr], }, + { simp [edist_eq_sum h, ennreal.zero_rpow_of_pos h, ennreal.zero_rpow_of_pos (inv_pos.2 $ h)]} +end + +/-- This holds independent of `p` and does not require `[fact (1 ≤ p)]`. We keep it separate +from `pi_Lp.pseudo_emetric_space` so it can be used also for `p < 1`. -/ +protected lemma edist_comm (f g : pi_Lp p β) : edist f g = edist g f := +begin + rcases p.trichotomy with (rfl | rfl | h), + { simp only [edist_eq_card, eq_comm, ne.def] }, + { simp only [edist_eq_supr, edist_comm] }, + { simp only [edist_eq_sum h, edist_comm] } +end + +end edist_prop + +section dist + +variables [Π i, has_dist (α i)] +/-- Endowing the space `pi_Lp p β` with the `L^p` distance. We register this instance +separate from `pi_Lp.pseudo_metric` since the latter requires the type class hypothesis +`[fact (1 ≤ p)]` in order to prove the triangle inequality. + +Registering this separately allows for a future metric-like structure on `pi_Lp p β` for `p < 1` +satisfying a relaxed triangle inequality. The terminology for this varies throughout the +literature, but it is sometimes called a *quasi-metric* or *semi-metric*. -/ +instance : has_dist (pi_Lp p α) := +{ dist := λ f g, if hp : p = 0 then {i | f i ≠ g i}.to_finite.to_finset.card + else (if p = ∞ then ⨆ i, dist (f i) (g i) + else (∑ i, (dist (f i) (g i) ^ p.to_real)) ^ (1/p.to_real)) } + +variable {α} +lemma dist_eq_card (f g : pi_Lp 0 α) : dist f g = {i | f i ≠ g i}.to_finite.to_finset.card := +if_pos rfl + +lemma dist_eq_sum {p : ℝ≥0∞} (hp : 0 < p.to_real) (f g : pi_Lp p α) : + dist f g = (∑ i, dist (f i) (g i) ^ p.to_real) ^ (1/p.to_real) := +let hp' := ennreal.to_real_pos_iff.mp hp in (if_neg hp'.1.ne').trans (if_neg hp'.2.ne) + +lemma dist_eq_csupr (f g : pi_Lp ∞ α) : dist f g = ⨆ i, dist (f i) (g i) := +by { dsimp [dist], exact if_neg ennreal.top_ne_zero } + +end dist + +section norm + +variables [Π i, has_norm (β i)] [Π i, has_zero (β i)] + +/-- Endowing the space `pi_Lp p β` with the `L^p` norm. We register this instance +separate from `pi_Lp.seminormed_add_comm_group` since the latter requires the type class hypothesis +`[fact (1 ≤ p)]` in order to prove the triangle inequality. + +Registering this separately allows for a future norm-like structure on `pi_Lp p β` for `p < 1` +satisfying a relaxed triangle inequality. These are called *quasi-norms*. -/ +instance has_norm : has_norm (pi_Lp p β) := +{ norm := λ f, if hp : p = 0 then {i | f i ≠ 0}.to_finite.to_finset.card + else (if p = ∞ then ⨆ i, ‖f i‖ else (∑ i, ‖f i‖ ^ p.to_real) ^ (1 / p.to_real)) } + +variables {p β} +lemma norm_eq_card (f : pi_Lp 0 β) : ‖f‖ = {i | f i ≠ 0}.to_finite.to_finset.card := +if_pos rfl + +lemma norm_eq_csupr (f : pi_Lp ∞ β) : ‖f‖ = ⨆ i, ‖f i‖ := +by { dsimp [norm], exact if_neg ennreal.top_ne_zero } + +lemma norm_eq_sum (hp : 0 < p.to_real) (f : pi_Lp p β) : + ‖f‖ = (∑ i, ‖f i‖ ^ p.to_real) ^ (1 / p.to_real) := +let hp' := ennreal.to_real_pos_iff.mp hp in (if_neg hp'.1.ne').trans (if_neg hp'.2.ne) + +end norm + +end dist_norm + +section aux /-! ### The uniformity on finite `L^p` products is the product uniformity @@ -101,223 +230,345 @@ from the edistance (which is equal to it, but not defeq). See Note [forgetful in explaining why having definitionally the right uniformity is often important. -/ -variables [∀ i, emetric_space (α i)] [∀ i, pseudo_emetric_space (β i)] [fintype ι] -include fact_one_le_p +variables [fact (1 ≤ p)] [Π i, pseudo_metric_space (α i)] [Π i, pseudo_emetric_space (β i)] +variables [fintype ι] -/-- Endowing the space `pi_Lp p β` with the `L^p` pseudoedistance. This definition is not +/-- Endowing the space `pi_Lp p β` with the `L^p` pseudoemetric structure. This definition is not satisfactory, as it does not register the fact that the topology and the uniform structure coincide with the product one. Therefore, we do not register it as an instance. Using this as a temporary pseudoemetric space instance, we will show that the uniform structure is equal (but not defeq) to the product one, and then register an instance in which we replace the uniform structure by the product one using this pseudoemetric space and `pseudo_emetric_space.replace_uniformity`. -/ def pseudo_emetric_aux : pseudo_emetric_space (pi_Lp p β) := -have pos : 0 < p := lt_of_lt_of_le zero_lt_one fact_one_le_p.out, -{ edist := λ f g, (∑ (i : ι), (edist (f i) (g i)) ^ p) ^ (1/p), - edist_self := λ f, by simp [edist, ennreal.zero_rpow_of_pos pos, - ennreal.zero_rpow_of_pos (inv_pos.2 pos)], - edist_comm := λ f g, by simp [edist, edist_comm], - edist_triangle := λ f g h, calc - (∑ (i : ι), edist (f i) (h i) ^ p) ^ (1 / p) ≤ - (∑ (i : ι), (edist (f i) (g i) + edist (g i) (h i)) ^ p) ^ (1 / p) : - begin - apply ennreal.rpow_le_rpow _ (one_div_nonneg.2 $ le_of_lt pos), - refine finset.sum_le_sum (λ i hi, _), - exact ennreal.rpow_le_rpow (edist_triangle _ _ _) (le_trans zero_le_one fact_one_le_p.out) - end - ... ≤ - (∑ (i : ι), edist (f i) (g i) ^ p) ^ (1 / p) + (∑ (i : ι), edist (g i) (h i) ^ p) ^ (1 / p) : - ennreal.Lp_add_le _ _ _ fact_one_le_p.out } - -/-- Endowing the space `pi_Lp p α` with the `L^p` edistance. This definition is not satisfactory, -as it does not register the fact that the topology and the uniform structure coincide with the -product one. Therefore, we do not register it as an instance. Using this as a temporary emetric -space instance, we will show that the uniform structure is equal (but not defeq) to the product -one, and then register an instance in which we replace the uniform structure by the product one -using this emetric space and `emetric_space.replace_uniformity`. -/ -def emetric_aux : emetric_space (pi_Lp p α) := -{ eq_of_edist_eq_zero := λ f g hfg, +{ edist_self := pi_Lp.edist_self p, + edist_comm := pi_Lp.edist_comm p, + edist_triangle := λ f g h, begin - have pos : 0 < p := lt_of_lt_of_le zero_lt_one fact_one_le_p.out, - letI h := pseudo_emetric_aux p α, - have h : edist f g = (∑ (i : ι), (edist (f i) (g i)) ^ p) ^ (1/p) := rfl, - simp [h, ennreal.rpow_eq_zero_iff, pos, asymm pos, finset.sum_eq_zero_iff_of_nonneg] at hfg, - exact funext hfg - end, - ..pseudo_emetric_aux p α } - -local attribute [instance] pi_Lp.emetric_aux pi_Lp.pseudo_emetric_aux - -lemma lipschitz_with_equiv : lipschitz_with 1 (pi_Lp.equiv p β) := + unfreezingI { rcases p.dichotomy with (rfl | hp) }, + { simp only [edist_eq_supr], + casesI is_empty_or_nonempty ι, + { simp only [csupr_of_empty, ennreal.bot_eq_zero, add_zero, nonpos_iff_eq_zero] }, + exact supr_le (λ i, (edist_triangle _ (g i) _).trans $ + add_le_add (le_supr _ i) (le_supr _ i))}, + { simp only [edist_eq_sum (zero_lt_one.trans_le hp)], + calc (∑ i, edist (f i) (h i) ^ p.to_real) ^ (1 / p.to_real) ≤ + (∑ i, (edist (f i) (g i) + edist (g i) (h i)) ^ p.to_real) ^ (1 / p.to_real) : + begin + apply ennreal.rpow_le_rpow _ (one_div_nonneg.2 $ zero_le_one.trans hp), + refine finset.sum_le_sum (λ i hi, _), + exact ennreal.rpow_le_rpow (edist_triangle _ _ _) (zero_le_one.trans hp), + end + ... ≤ (∑ i, edist (f i) (g i) ^ p.to_real) ^ (1 / p.to_real) + + (∑ i, edist (g i) (h i) ^ p.to_real) ^ (1 / p.to_real) : ennreal.Lp_add_le _ _ _ hp }, + end } + +local attribute [instance] pi_Lp.pseudo_emetric_aux + +/-- An auxiliary lemma used twice in the proof of `pi_Lp.pseudo_metric_aux` below. Not intended for +use outside this file. -/ +lemma supr_edist_ne_top_aux {ι : Type*} [finite ι] {α : ι → Type*} [Π i, pseudo_metric_space (α i)] + (f g : pi_Lp ∞ α) : (⨆ i, edist (f i) (g i)) ≠ ⊤ := begin - have pos : 0 < p := lt_of_lt_of_le zero_lt_one fact_one_le_p.out, - have cancel : p * (1/p) = 1 := mul_div_cancel' 1 (ne_of_gt pos), - assume x y, - simp only [edist, forall_prop_of_true, one_mul, finset.mem_univ, finset.sup_le_iff, - ennreal.coe_one], - assume i, - calc - edist (x i) (y i) = (edist (x i) (y i) ^ p) ^ (1/p) : - by simp [← ennreal.rpow_mul, cancel, -one_div] - ... ≤ (∑ (i : ι), edist (x i) (y i) ^ p) ^ (1 / p) : - begin - apply ennreal.rpow_le_rpow _ (one_div_nonneg.2 $ le_of_lt pos), - exact finset.single_le_sum (λ i hi, (bot_le : (0 : ℝ≥0∞) ≤ _)) (finset.mem_univ i) - end + casesI nonempty_fintype ι, + obtain ⟨M, hM⟩ := fintype.exists_le (λ i, (⟨dist (f i) (g i), dist_nonneg⟩ : ℝ≥0)), + refine ne_of_lt ((supr_le $ λ i, _).trans_lt (@ennreal.coe_lt_top M)), + simp only [edist, pseudo_metric_space.edist_dist, ennreal.of_real_eq_coe_nnreal dist_nonneg], + exact_mod_cast hM i, end -lemma antilipschitz_with_equiv : - antilipschitz_with ((fintype.card ι : ℝ≥0) ^ (1/p)) (pi_Lp.equiv p β) := -begin - have pos : 0 < p := lt_of_lt_of_le zero_lt_one fact_one_le_p.out, - have nonneg : 0 ≤ 1 / p := one_div_nonneg.2 (le_of_lt pos), - have cancel : p * (1/p) = 1 := mul_div_cancel' 1 (ne_of_gt pos), - assume x y, - simp [edist, -one_div], - calc (∑ (i : ι), edist (x i) (y i) ^ p) ^ (1 / p) ≤ - (∑ (i : ι), edist (pi_Lp.equiv p β x) (pi_Lp.equiv p β y) ^ p) ^ (1 / p) : +/-- Endowing the space `pi_Lp p α` with the `L^p` pseudometric structure. This definition is not +satisfactory, as it does not register the fact that the topology, the uniform structure, and the +bornology coincide with the product ones. Therefore, we do not register it as an instance. Using +this as a temporary pseudoemetric space instance, we will show that the uniform structure is equal +(but not defeq) to the product one, and then register an instance in which we replace the uniform +structure and the bornology by the product ones using this pseudometric space, +`pseudo_metric_space.replace_uniformity`, and `pseudo_metric_space.replace_bornology`. + +See note [reducible non-instances] -/ +@[reducible] def pseudo_metric_aux : pseudo_metric_space (pi_Lp p α) := +pseudo_emetric_space.to_pseudo_metric_space_of_dist dist + (λ f g, begin - apply ennreal.rpow_le_rpow _ nonneg, - apply finset.sum_le_sum (λ i hi, _), - apply ennreal.rpow_le_rpow _ (le_of_lt pos), - exact finset.le_sup (finset.mem_univ i) - end - ... = (((fintype.card ι : ℝ≥0)) ^ (1/p) : ℝ≥0) * - edist (pi_Lp.equiv p β x) (pi_Lp.equiv p β y) : + unfreezingI { rcases p.dichotomy with (rfl | h) }, + { exact supr_edist_ne_top_aux f g }, + { rw edist_eq_sum (zero_lt_one.trans_le h), + exact ennreal.rpow_ne_top_of_nonneg (one_div_nonneg.2 (zero_le_one.trans h)) (ne_of_lt $ + (ennreal.sum_lt_top $ λ i hi, ennreal.rpow_ne_top_of_nonneg (zero_le_one.trans h) + (edist_ne_top _ _)))} + end) + (λ f g, begin - simp only [nsmul_eq_mul, finset.card_univ, ennreal.rpow_one, finset.sum_const, - ennreal.mul_rpow_of_nonneg _ _ nonneg, ←ennreal.rpow_mul, cancel], - have : (fintype.card ι : ℝ≥0∞) = (fintype.card ι : ℝ≥0) := - (ennreal.coe_nat (fintype.card ι)).symm, - rw [this, ennreal.coe_rpow_of_nonneg _ nonneg] - end + unfreezingI { rcases p.dichotomy with (rfl | h) }, + { rw [edist_eq_supr, dist_eq_csupr], + { casesI is_empty_or_nonempty ι, + { simp only [real.csupr_empty, csupr_of_empty, ennreal.bot_eq_zero, ennreal.zero_to_real] }, + { refine le_antisymm (csupr_le $ λ i, _) _, + { rw [←ennreal.of_real_le_iff_le_to_real (supr_edist_ne_top_aux f g), + ←pseudo_metric_space.edist_dist], + exact le_supr _ i, }, + { refine ennreal.to_real_le_of_le_of_real (real.Sup_nonneg _ _) (supr_le $ λ i, _), + { rintro - ⟨i, rfl⟩, + exact dist_nonneg, }, + { unfold edist, rw pseudo_metric_space.edist_dist, + exact ennreal.of_real_le_of_real (le_csupr (fintype.bdd_above_range _) i), } } } } }, + { have A : ∀ i, edist (f i) (g i) ^ p.to_real ≠ ⊤, + from λ i, ennreal.rpow_ne_top_of_nonneg (zero_le_one.trans h) (edist_ne_top _ _), + simp only [edist_eq_sum (zero_lt_one.trans_le h), dist_edist, ennreal.to_real_rpow, + dist_eq_sum (zero_lt_one.trans_le h), ← ennreal.to_real_sum (λ i _, A i)] } + end) + +local attribute [instance] pi_Lp.pseudo_metric_aux + +lemma lipschitz_with_equiv_aux : lipschitz_with 1 (pi_Lp.equiv p β) := +begin + intros x y, + unfreezingI { rcases p.dichotomy with (rfl | h) }, + { simpa only [ennreal.coe_one, one_mul, edist_eq_supr, edist, finset.sup_le_iff, + finset.mem_univ, forall_true_left] using le_supr (λ i, edist (x i) (y i)), }, + { have cancel : p.to_real * (1/p.to_real) = 1 := mul_div_cancel' 1 (zero_lt_one.trans_le h).ne', + rw edist_eq_sum (zero_lt_one.trans_le h), + simp only [edist, forall_prop_of_true, one_mul, finset.mem_univ, finset.sup_le_iff, + ennreal.coe_one], + assume i, + calc + edist (x i) (y i) = (edist (x i) (y i) ^ p.to_real) ^ (1/p.to_real) : + by simp [← ennreal.rpow_mul, cancel, -one_div] + ... ≤ (∑ i, edist (x i) (y i) ^ p.to_real) ^ (1 / p.to_real) : + begin + apply ennreal.rpow_le_rpow _ (one_div_nonneg.2 $ (zero_le_one.trans h)), + exact finset.single_le_sum (λ i hi, (bot_le : (0 : ℝ≥0∞) ≤ _)) (finset.mem_univ i) + end } +end + +lemma antilipschitz_with_equiv_aux : + antilipschitz_with ((fintype.card ι : ℝ≥0) ^ (1 / p).to_real) (pi_Lp.equiv p β) := +begin + intros x y, + unfreezingI { rcases p.dichotomy with (rfl | h) }, + { simp only [edist_eq_supr, ennreal.div_top, ennreal.zero_to_real, nnreal.rpow_zero, + ennreal.coe_one, one_mul, supr_le_iff], + exact λ i, finset.le_sup (finset.mem_univ i), }, + { have pos : 0 < p.to_real := zero_lt_one.trans_le h, + have nonneg : 0 ≤ 1 / p.to_real := one_div_nonneg.2 (le_of_lt pos), + have cancel : p.to_real * (1/p.to_real) = 1 := mul_div_cancel' 1 (ne_of_gt pos), + rw [edist_eq_sum pos, ennreal.to_real_div 1 p], + simp only [edist, ←one_div, ennreal.one_to_real], + calc (∑ i, edist (x i) (y i) ^ p.to_real) ^ (1 / p.to_real) ≤ + (∑ i, edist (pi_Lp.equiv p β x) (pi_Lp.equiv p β y) ^ p.to_real) ^ (1 / p.to_real) : + begin + apply ennreal.rpow_le_rpow _ nonneg, + apply finset.sum_le_sum (λ i hi, _), + apply ennreal.rpow_le_rpow _ (le_of_lt pos), + exact finset.le_sup (finset.mem_univ i) + end + ... = (((fintype.card ι : ℝ≥0)) ^ (1 / p.to_real) : ℝ≥0) * + edist (pi_Lp.equiv p β x) (pi_Lp.equiv p β y) : + begin + simp only [nsmul_eq_mul, finset.card_univ, ennreal.rpow_one, finset.sum_const, + ennreal.mul_rpow_of_nonneg _ _ nonneg, ←ennreal.rpow_mul, cancel], + have : (fintype.card ι : ℝ≥0∞) = (fintype.card ι : ℝ≥0) := + (ennreal.coe_nat (fintype.card ι)).symm, + rw [this, ennreal.coe_rpow_of_nonneg _ nonneg] + end } end lemma aux_uniformity_eq : - 𝓤 (pi_Lp p β) = @uniformity _ (Pi.uniform_space _) := + 𝓤 (pi_Lp p β) = 𝓤[Pi.uniform_space _] := begin have A : uniform_inducing (pi_Lp.equiv p β) := - (antilipschitz_with_equiv p β).uniform_inducing - (lipschitz_with_equiv p β).uniform_continuous, + (antilipschitz_with_equiv_aux p β).uniform_inducing + (lipschitz_with_equiv_aux p β).uniform_continuous, have : (λ (x : pi_Lp p β × pi_Lp p β), ((pi_Lp.equiv p β) x.fst, (pi_Lp.equiv p β) x.snd)) = id, by ext i; refl, rw [← A.comap_uniformity, this, comap_id] end -end +lemma aux_cobounded_eq : + cobounded (pi_Lp p α) = @cobounded _ pi.bornology := +calc cobounded (pi_Lp p α) = comap (pi_Lp.equiv p α) (cobounded _) : + le_antisymm (antilipschitz_with_equiv_aux p α).tendsto_cobounded.le_comap + (lipschitz_with_equiv_aux p α).comap_cobounded_le +... = _ : comap_id + +end aux /-! ### Instances on finite `L^p` products -/ -instance uniform_space [∀ i, uniform_space (β i)] : uniform_space (pi_Lp p β) := +instance uniform_space [Π i, uniform_space (β i)] : uniform_space (pi_Lp p β) := Pi.uniform_space _ +lemma uniform_continuous_equiv [Π i, uniform_space (β i)] : + uniform_continuous (pi_Lp.equiv p β) := +uniform_continuous_id + +lemma uniform_continuous_equiv_symm [Π i, uniform_space (β i)] : + uniform_continuous (pi_Lp.equiv p β).symm := +uniform_continuous_id + +@[continuity] +lemma continuous_equiv [Π i, uniform_space (β i)] : continuous (pi_Lp.equiv p β) := +continuous_id + +@[continuity] +lemma continuous_equiv_symm [Π i, uniform_space (β i)] : continuous (pi_Lp.equiv p β).symm := +continuous_id + variable [fintype ι] -include fact_one_le_p + +instance bornology [Π i, bornology (β i)] : bornology (pi_Lp p β) := pi.bornology + +-- throughout the rest of the file, we assume `1 ≤ p` +variables [fact (1 ≤ p)] /-- pseudoemetric space instance on the product of finitely many pseudoemetric spaces, using the `L^p` pseudoedistance, and having as uniformity the product uniformity. -/ -instance [∀ i, pseudo_emetric_space (β i)] : pseudo_emetric_space (pi_Lp p β) := +instance [Π i, pseudo_emetric_space (β i)] : pseudo_emetric_space (pi_Lp p β) := (pseudo_emetric_aux p β).replace_uniformity (aux_uniformity_eq p β).symm /-- emetric space instance on the product of finitely many emetric spaces, using the `L^p` edistance, and having as uniformity the product uniformity. -/ -instance [∀ i, emetric_space (α i)] : emetric_space (pi_Lp p α) := -(emetric_aux p α).replace_uniformity (aux_uniformity_eq p α).symm - -omit fact_one_le_p -protected lemma edist {p : ℝ} [fact (1 ≤ p)] {β : ι → Type*} - [∀ i, pseudo_emetric_space (β i)] (x y : pi_Lp p β) : - edist x y = (∑ (i : ι), (edist (x i) (y i)) ^ p) ^ (1/p) := rfl -include fact_one_le_p +instance [Π i, emetric_space (α i)] : emetric_space (pi_Lp p α) := +@emetric_space.of_t0_pseudo_emetric_space (pi_Lp p α) _ pi.t0_space /-- pseudometric space instance on the product of finitely many psuedometric spaces, using the `L^p` distance, and having as uniformity the product uniformity. -/ -instance [∀ i, pseudo_metric_space (β i)] : pseudo_metric_space (pi_Lp p β) := -begin - /- we construct the instance from the pseudo emetric space instance to avoid checking again that - the uniformity is the same as the product uniformity, but we register nevertheless a nice formula - for the distance -/ - have pos : 0 < p := lt_of_lt_of_le zero_lt_one fact_one_le_p.out, - refine pseudo_emetric_space.to_pseudo_metric_space_of_dist - (λf g, (∑ (i : ι), (dist (f i) (g i)) ^ p) ^ (1/p)) (λ f g, _) (λ f g, _), - { simp [pi_Lp.edist, ennreal.rpow_eq_top_iff, asymm pos, pos, - ennreal.sum_eq_top_iff, edist_ne_top] }, - { have A : ∀ (i : ι), i ∈ (finset.univ : finset ι) → edist (f i) (g i) ^ p ≠ ⊤ := - λ i hi, by simp [lt_top_iff_ne_top, edist_ne_top, le_of_lt pos], - simp [dist, -one_div, pi_Lp.edist, ← ennreal.to_real_rpow, - ennreal.to_real_sum A, dist_edist] } -end +instance [Π i, pseudo_metric_space (β i)] : pseudo_metric_space (pi_Lp p β) := +((pseudo_metric_aux p β).replace_uniformity (aux_uniformity_eq p β).symm).replace_bornology $ + λ s, filter.ext_iff.1 (aux_cobounded_eq p β).symm sᶜ /-- metric space instance on the product of finitely many metric spaces, using the `L^p` distance, and having as uniformity the product uniformity. -/ -instance [∀ i, metric_space (α i)] : metric_space (pi_Lp p α) := -begin - /- we construct the instance from the emetric space instance to avoid checking again that the - uniformity is the same as the product uniformity, but we register nevertheless a nice formula - for the distance -/ - have pos : 0 < p := lt_of_lt_of_le zero_lt_one fact_one_le_p.out, - refine emetric_space.to_metric_space_of_dist - (λf g, (∑ (i : ι), (dist (f i) (g i)) ^ p) ^ (1/p)) (λ f g, _) (λ f g, _), - { simp [pi_Lp.edist, ennreal.rpow_eq_top_iff, asymm pos, pos, - ennreal.sum_eq_top_iff, edist_ne_top] }, - { have A : ∀ (i : ι), i ∈ (finset.univ : finset ι) → edist (f i) (g i) ^ p ≠ ⊤ := - λ i hi, by simp [edist_ne_top, pos.le], - simp [dist, -one_div, pi_Lp.edist, ← ennreal.to_real_rpow, - ennreal.to_real_sum A, dist_edist] } -end +instance [Π i, metric_space (α i)] : metric_space (pi_Lp p α) := +metric_space.of_t0_pseudo_metric_space _ + +lemma nndist_eq_sum {p : ℝ≥0∞} [fact (1 ≤ p)] {β : ι → Type*} + [Π i, pseudo_metric_space (β i)] (hp : p ≠ ∞) (x y : pi_Lp p β) : + nndist x y = (∑ i : ι, nndist (x i) (y i) ^ p.to_real) ^ (1 / p.to_real) := +subtype.ext $ by { push_cast, exact dist_eq_sum (p.to_real_pos_iff_ne_top.mpr hp) _ _ } + +lemma nndist_eq_supr {β : ι → Type*} [Π i, pseudo_metric_space (β i)] (x y : pi_Lp ∞ β) : + nndist x y = ⨆ i, nndist (x i) (y i) := +subtype.ext $ by { push_cast, exact dist_eq_csupr _ _ } -omit fact_one_le_p -protected lemma dist {p : ℝ} [fact (1 ≤ p)] {β : ι → Type*} - [∀ i, pseudo_metric_space (β i)] (x y : pi_Lp p β) : - dist x y = (∑ (i : ι), (dist (x i) (y i)) ^ p) ^ (1/p) := rfl -include fact_one_le_p +lemma lipschitz_with_equiv [Π i, pseudo_emetric_space (β i)] : + lipschitz_with 1 (pi_Lp.equiv p β) := +lipschitz_with_equiv_aux p β +lemma antilipschitz_with_equiv [Π i, pseudo_emetric_space (β i)] : + antilipschitz_with ((fintype.card ι : ℝ≥0) ^ (1 / p).to_real) (pi_Lp.equiv p β) := +antilipschitz_with_equiv_aux p β + +lemma infty_equiv_isometry [Π i, pseudo_emetric_space (β i)] : + isometry (pi_Lp.equiv ∞ β) := +λ x y, le_antisymm (by simpa only [ennreal.coe_one, one_mul] using lipschitz_with_equiv ∞ β x y) + (by simpa only [ennreal.div_top, ennreal.zero_to_real, nnreal.rpow_zero, ennreal.coe_one, one_mul] + using antilipschitz_with_equiv ∞ β x y) + +variables (p β) /-- seminormed group instance on the product of finitely many normed groups, using the `L^p` norm. -/ -instance semi_normed_group [∀i, semi_normed_group (β i)] : semi_normed_group (pi_Lp p β) := -{ norm := λf, (∑ (i : ι), norm (f i) ^ p) ^ (1/p), - dist_eq := λ x y, by { simp [pi_Lp.dist, dist_eq_norm, sub_eq_add_neg] }, - .. pi.add_comm_group } +instance seminormed_add_comm_group [Π i, seminormed_add_comm_group (β i)] : + seminormed_add_comm_group (pi_Lp p β) := +{ dist_eq := λ x y, + begin + unfreezingI { rcases p.dichotomy with (rfl | h) }, + { simpa only [dist_eq_csupr, norm_eq_csupr, dist_eq_norm] }, + { have : p ≠ ∞, { intros hp, rw [hp, ennreal.top_to_real] at h, linarith,} , + simpa only [dist_eq_sum (zero_lt_one.trans_le h), norm_eq_sum (zero_lt_one.trans_le h), + dist_eq_norm], } + end, + .. pi.add_comm_group, } /-- normed group instance on the product of finitely many normed groups, using the `L^p` norm. -/ -instance normed_group [∀i, normed_group (α i)] : normed_group (pi_Lp p α) := -{ ..pi_Lp.semi_normed_group p α } +instance normed_add_comm_group [Π i, normed_add_comm_group (α i)] : + normed_add_comm_group (pi_Lp p α) := +{ ..pi_Lp.seminormed_add_comm_group p α } + +lemma nnnorm_eq_sum {p : ℝ≥0∞} [fact (1 ≤ p)] {β : ι → Type*} (hp : p ≠ ∞) + [Π i, seminormed_add_comm_group (β i)] (f : pi_Lp p β) : + ‖f‖₊ = (∑ i, ‖f i‖₊ ^ p.to_real) ^ (1 / p.to_real) := +by { ext, simp [nnreal.coe_sum, norm_eq_sum (p.to_real_pos_iff_ne_top.mpr hp)] } + +lemma nnnorm_eq_csupr {β : ι → Type*} [Π i, seminormed_add_comm_group (β i)] (f : pi_Lp ∞ β) : + ‖f‖₊ = ⨆ i, ‖f i‖₊ := +by { ext, simp [nnreal.coe_supr, norm_eq_csupr] } + +lemma norm_eq_of_nat {p : ℝ≥0∞} [fact (1 ≤ p)] {β : ι → Type*} + [Π i, seminormed_add_comm_group (β i)] (n : ℕ) (h : p = n) (f : pi_Lp p β) : + ‖f‖ = (∑ i, ‖f i‖ ^ n) ^ (1/(n : ℝ)) := +begin + have := p.to_real_pos_iff_ne_top.mpr (ne_of_eq_of_ne h $ ennreal.nat_ne_top n), + simp only [one_div, h, real.rpow_nat_cast, ennreal.to_real_nat, eq_self_iff_true, + finset.sum_congr, norm_eq_sum this], +end -omit fact_one_le_p -lemma norm_eq {p : ℝ} [fact (1 ≤ p)] {β : ι → Type*} - [∀i, semi_normed_group (β i)] (f : pi_Lp p β) : - ∥f∥ = (∑ (i : ι), ∥f i∥ ^ p) ^ (1/p) := rfl +lemma norm_eq_of_L2 {β : ι → Type*} [Π i, seminormed_add_comm_group (β i)] (x : pi_Lp 2 β) : + ‖x‖ = sqrt (∑ (i : ι), ‖x i‖ ^ 2) := +by { convert norm_eq_of_nat 2 (by norm_cast) _, rw sqrt_eq_rpow, norm_cast } -lemma nnnorm_eq {p : ℝ} [fact (1 ≤ p)] {β : ι → Type*} - [∀i, semi_normed_group (β i)] (f : pi_Lp p β) : - ∥f∥₊ = (∑ (i : ι), ∥f i∥₊ ^ p) ^ (1/p) := -by { ext, simp [nnreal.coe_sum, norm_eq] } +lemma nnnorm_eq_of_L2 {β : ι → Type*} [Π i, seminormed_add_comm_group (β i)] (x : pi_Lp 2 β) : + ‖x‖₊ = nnreal.sqrt (∑ (i : ι), ‖x i‖₊ ^ 2) := +subtype.ext $ by { push_cast, exact norm_eq_of_L2 x } -lemma norm_eq_of_nat {p : ℝ} [fact (1 ≤ p)] {β : ι → Type*} - [∀i, semi_normed_group (β i)] (n : ℕ) (h : p = n) (f : pi_Lp p β) : - ∥f∥ = (∑ (i : ι), ∥f i∥ ^ n) ^ (1/(n : ℝ)) := -by simp [norm_eq, h, real.sqrt_eq_rpow, ←real.rpow_nat_cast] -include fact_one_le_p +lemma norm_sq_eq_of_L2 (β : ι → Type*) [Π i, seminormed_add_comm_group (β i)] (x : pi_Lp 2 β) : + ‖x‖ ^ 2 = ∑ (i : ι), ‖x i‖ ^ 2 := +begin + suffices : ‖x‖₊ ^ 2 = ∑ (i : ι), ‖x i‖₊ ^ 2, + { simpa only [nnreal.coe_sum] using congr_arg (coe : ℝ≥0 → ℝ) this }, + rw [nnnorm_eq_of_L2, nnreal.sq_sqrt], +end + +lemma dist_eq_of_L2 {β : ι → Type*} [Π i, seminormed_add_comm_group (β i)] (x y : pi_Lp 2 β) : + dist x y = (∑ i, dist (x i) (y i) ^ 2).sqrt := +by simp_rw [dist_eq_norm, norm_eq_of_L2, pi.sub_apply] + +lemma nndist_eq_of_L2 {β : ι → Type*} [Π i, seminormed_add_comm_group (β i)] (x y : pi_Lp 2 β) : + nndist x y = (∑ i, nndist (x i) (y i) ^ 2).sqrt := +subtype.ext $ by { push_cast, exact dist_eq_of_L2 _ _ } -variables (𝕜 : Type*) [normed_field 𝕜] +lemma edist_eq_of_L2 {β : ι → Type*} [Π i, seminormed_add_comm_group (β i)] (x y : pi_Lp 2 β) : + edist x y = (∑ i, edist (x i) (y i) ^ 2) ^ (1 / 2 : ℝ) := +by simp [pi_Lp.edist_eq_sum] + +variables [normed_field 𝕜] [normed_field 𝕜'] /-- The product of finitely many normed spaces is a normed space, with the `L^p` norm. -/ -instance normed_space [∀i, semi_normed_group (β i)] [∀i, normed_space 𝕜 (β i)] : - normed_space 𝕜 (pi_Lp p β) := -{ norm_smul_le := +instance normed_space [Π i, seminormed_add_comm_group (β i)] + [Π i, normed_space 𝕜 (β i)] : normed_space 𝕜 (pi_Lp p β) := +{ norm_smul_le := λ c f, begin - assume c f, - have : p * (1 / p) = 1 := mul_div_cancel' 1 (lt_of_lt_of_le zero_lt_one fact_one_le_p.out).ne', - simp only [pi_Lp.norm_eq, norm_smul, mul_rpow, norm_nonneg, ←finset.mul_sum, pi.smul_apply], - rw [mul_rpow (rpow_nonneg_of_nonneg (norm_nonneg _) _), ← rpow_mul (norm_nonneg _), + unfreezingI { rcases p.dichotomy with (rfl | hp) }, + { letI : module 𝕜 (pi_Lp ∞ β) := pi.module ι β 𝕜, + suffices : ‖c • f‖₊ = ‖c‖₊ * ‖f‖₊, { exact_mod_cast nnreal.coe_mono this.le }, + simpa only [nnnorm_eq_csupr, nnreal.mul_supr, ←nnnorm_smul] }, + { have : p.to_real * (1 / p.to_real) = 1 := mul_div_cancel' 1 (zero_lt_one.trans_le hp).ne', + simp only [norm_eq_sum (zero_lt_one.trans_le hp), norm_smul, mul_rpow, norm_nonneg, + ←finset.mul_sum, pi.smul_apply], + rw [mul_rpow (rpow_nonneg_of_nonneg (norm_nonneg _) _), ← rpow_mul (norm_nonneg _), this, rpow_one], - exact finset.sum_nonneg (λ i hi, rpow_nonneg_of_nonneg (norm_nonneg _) _) + exact finset.sum_nonneg (λ i hi, rpow_nonneg_of_nonneg (norm_nonneg _) _) }, end, - .. pi.module ι β 𝕜 } + .. (pi.module ι β 𝕜) } + +instance is_scalar_tower [Π i, seminormed_add_comm_group (β i)] + [has_smul 𝕜 𝕜'] [Π i, normed_space 𝕜 (β i)] [Π i, normed_space 𝕜' (β i)] + [Π i, is_scalar_tower 𝕜 𝕜' (β i)] : is_scalar_tower 𝕜 𝕜' (pi_Lp p β) := +pi.is_scalar_tower + +instance smul_comm_class [Π i, seminormed_add_comm_group (β i)] + [Π i, normed_space 𝕜 (β i)] [Π i, normed_space 𝕜' (β i)] + [Π i, smul_comm_class 𝕜 𝕜' (β i)] : smul_comm_class 𝕜 𝕜' (pi_Lp p β) := +pi.smul_comm_class + +instance finite_dimensional [Π i, seminormed_add_comm_group (β i)] + [Π i, normed_space 𝕜 (β i)] [I : ∀ i, finite_dimensional 𝕜 (β i)] : + finite_dimensional 𝕜 (pi_Lp p β) := +finite_dimensional.finite_dimensional_pi' _ _ /- Register simplification lemmas for the applications of `pi_Lp` elements, as the usual lemmas for Pi types will not trigger. -/ -variables {𝕜 p α} [Π i, semi_normed_group (β i)] [Π i, normed_space 𝕜 (β i)] (c : 𝕜) +variables {𝕜 𝕜' p α} [Π i, seminormed_add_comm_group (β i)] [Π i, normed_space 𝕜 (β i)] (c : 𝕜) variables (x y : pi_Lp p β) (x' y' : Π i, β i) (i : ι) @[simp] lemma zero_apply : (0 : pi_Lp p β) i = 0 := rfl @@ -326,6 +577,66 @@ variables (x y : pi_Lp p β) (x' y' : Π i, β i) (i : ι) @[simp] lemma smul_apply : (c • x) i = c • x i := rfl @[simp] lemma neg_apply : (-x) i = - (x i) := rfl +/-- The canonical map `pi_Lp.equiv` between `pi_Lp ∞ β` and `Π i, β i` as a linear isometric +equivalence. -/ +def equivₗᵢ : pi_Lp ∞ β ≃ₗᵢ[𝕜] Π i, β i := +{ map_add' := λ f g, rfl, + map_smul' := λ c f, rfl, + norm_map' := λ f, + begin + suffices : finset.univ.sup (λ i, ‖f i‖₊) = ⨆ i, ‖f i‖₊, + { simpa only [nnreal.coe_supr] using congr_arg (coe : ℝ≥0 → ℝ) this }, + refine antisymm (finset.sup_le (λ i _, le_csupr (fintype.bdd_above_range (λ i, ‖f i‖₊)) _)) _, + casesI is_empty_or_nonempty ι, + { simp only [csupr_of_empty, finset.univ_eq_empty, finset.sup_empty], }, + { exact csupr_le (λ i, finset.le_sup (finset.mem_univ i)) }, + end, + .. pi_Lp.equiv ∞ β } + +variables {ι' : Type*} +variables [fintype ι'] + +variables (p 𝕜) (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] + +/-- An equivalence of finite domains induces a linearly isometric equivalence of finitely supported +functions-/ +def _root_.linear_isometry_equiv.pi_Lp_congr_left (e : ι ≃ ι') : + pi_Lp p (λ i : ι, E) ≃ₗᵢ[𝕜] pi_Lp p (λ i : ι', E) := +{ to_linear_equiv := linear_equiv.Pi_congr_left' 𝕜 (λ i : ι, E) e, + norm_map' := λ x, + begin + unfreezingI { rcases p.dichotomy with (rfl | h) }, + { simp_rw [norm_eq_csupr, linear_equiv.Pi_congr_left'_apply 𝕜 (λ i : ι, E) e x _], + exact e.symm.supr_congr (λ i, rfl) }, + { simp only [norm_eq_sum (zero_lt_one.trans_le h)], + simp_rw linear_equiv.Pi_congr_left'_apply 𝕜 (λ i : ι, E) e x _, + congr, + exact (fintype.sum_equiv (e.symm) _ _ (λ i, rfl)) } + end, } + +variables {p 𝕜 E} + +@[simp] lemma _root_.linear_isometry_equiv.pi_Lp_congr_left_apply + (e : ι ≃ ι') (v : pi_Lp p (λ i : ι, E)) : + linear_isometry_equiv.pi_Lp_congr_left p 𝕜 E e v = equiv.Pi_congr_left' (λ i : ι, E) e v := +rfl + +@[simp] lemma _root_.linear_isometry_equiv.pi_Lp_congr_left_symm (e : ι ≃ ι') : + (linear_isometry_equiv.pi_Lp_congr_left p 𝕜 E e).symm + = (linear_isometry_equiv.pi_Lp_congr_left p 𝕜 E e.symm) := +linear_isometry_equiv.ext $ λ x, rfl + +@[simp] lemma _root_.linear_isometry_equiv.pi_Lp_congr_left_single + [decidable_eq ι] [decidable_eq ι'] (e : ι ≃ ι') (i : ι) (v : E) : + linear_isometry_equiv.pi_Lp_congr_left p 𝕜 E e ( + (pi_Lp.equiv p (λ _, E)).symm $ pi.single i v) = + (pi_Lp.equiv p (λ _, E)).symm (pi.single (e i) v) := +begin + funext x, + simp [linear_isometry_equiv.pi_Lp_congr_left, linear_equiv.Pi_congr_left', equiv.Pi_congr_left', + pi.single, function.update, equiv.symm_apply_eq], +end + @[simp] lemma equiv_zero : pi_Lp.equiv p β 0 = 0 := rfl @[simp] lemma equiv_symm_zero : (pi_Lp.equiv p β).symm 0 = 0 := rfl @@ -345,25 +656,172 @@ variables (x y : pi_Lp p β) (x' y' : Π i, β i) (i : ι) @[simp] lemma equiv_symm_smul : (pi_Lp.equiv p β).symm (c • x') = c • (pi_Lp.equiv p β).symm x' := rfl -lemma nnnorm_equiv_symm_const {β} [semi_normed_group β] (b : β) : - ∥(pi_Lp.equiv p (λ _ : ι, β)).symm (function.const _ b)∥₊ = fintype.card ι ^ (1 / p) * ∥b∥₊ := +section single + +variables (p) +variables [decidable_eq ι] + +@[simp] +lemma nnnorm_equiv_symm_single (i : ι) (b : β i) : + ‖(pi_Lp.equiv p β).symm (pi.single i b)‖₊ = ‖b‖₊ := begin - have : p ≠ 0 := (zero_lt_one.trans_le (fact.out $ 1 ≤ p)).ne', - simp_rw [pi_Lp.nnnorm_eq, equiv_symm_apply, function.const_apply, finset.sum_const, - finset.card_univ, nsmul_eq_mul, nnreal.mul_rpow, ←nnreal.rpow_mul, mul_one_div_cancel this, - nnreal.rpow_one], + haveI : nonempty ι := ⟨i⟩, + unfreezingI { induction p using with_top.rec_top_coe }, + { simp_rw [nnnorm_eq_csupr, equiv_symm_apply], + refine csupr_eq_of_forall_le_of_forall_lt_exists_gt (λ j, _) (λ n hn, ⟨i, hn.trans_eq _⟩), + { obtain rfl | hij := decidable.eq_or_ne i j, + { rw pi.single_eq_same }, + { rw [pi.single_eq_of_ne' hij, nnnorm_zero], + exact zero_le _ } }, + { rw pi.single_eq_same } }, + { have hp0 : (p : ℝ) ≠ 0, + { exact_mod_cast (zero_lt_one.trans_le $ fact.out (1 ≤ (p : ℝ≥0∞))).ne' }, + rw [nnnorm_eq_sum ennreal.coe_ne_top, ennreal.coe_to_real, fintype.sum_eq_single i, + equiv_symm_apply, pi.single_eq_same, ←nnreal.rpow_mul, one_div, mul_inv_cancel hp0, + nnreal.rpow_one], + intros j hij, + rw [equiv_symm_apply, pi.single_eq_of_ne hij, nnnorm_zero, nnreal.zero_rpow hp0] }, end -lemma norm_equiv_symm_const {β} [semi_normed_group β] (b : β) : - ∥(pi_Lp.equiv p (λ _ : ι, β)).symm (function.const _ b)∥ = fintype.card ι ^ (1 / p) * ∥b∥ := -(congr_arg coe $ nnnorm_equiv_symm_const b).trans $ by simp +@[simp] +lemma norm_equiv_symm_single (i : ι) (b : β i) : + ‖(pi_Lp.equiv p β).symm (pi.single i b)‖ = ‖b‖ := +congr_arg coe $ nnnorm_equiv_symm_single p β i b + +@[simp] +lemma nndist_equiv_symm_single_same (i : ι) (b₁ b₂ : β i) : + nndist ((pi_Lp.equiv p β).symm (pi.single i b₁)) ((pi_Lp.equiv p β).symm (pi.single i b₂)) = + nndist b₁ b₂ := +by rw [nndist_eq_nnnorm, nndist_eq_nnnorm, ←equiv_symm_sub, ←pi.single_sub, + nnnorm_equiv_symm_single] + +@[simp] +lemma dist_equiv_symm_single_same (i : ι) (b₁ b₂ : β i) : + dist ((pi_Lp.equiv p β).symm (pi.single i b₁)) ((pi_Lp.equiv p β).symm (pi.single i b₂)) = + dist b₁ b₂ := +congr_arg coe $ nndist_equiv_symm_single_same p β i b₁ b₂ + +@[simp] +lemma edist_equiv_symm_single_same (i : ι) (b₁ b₂ : β i) : + edist ((pi_Lp.equiv p β).symm (pi.single i b₁)) ((pi_Lp.equiv p β).symm (pi.single i b₂)) = + edist b₁ b₂ := +by simpa only [edist_nndist] using congr_arg coe (nndist_equiv_symm_single_same p β i b₁ b₂) + +end single + +/-- When `p = ∞`, this lemma does not hold without the additional assumption `nonempty ι` because +the left-hand side simplifies to `0`, while the right-hand side simplifies to `‖b‖₊`. See +`pi_Lp.nnnorm_equiv_symm_const'` for a version which exchanges the hypothesis `p ≠ ∞` for +`nonempty ι`. -/ +lemma nnnorm_equiv_symm_const {β} [seminormed_add_comm_group β] (hp : p ≠ ∞) (b : β) : + ‖(pi_Lp.equiv p (λ _ : ι, β)).symm (function.const _ b)‖₊= + fintype.card ι ^ (1 / p).to_real * ‖b‖₊ := +begin + rcases p.dichotomy with (h | h), + { exact false.elim (hp h) }, + { have ne_zero : p.to_real ≠ 0 := (zero_lt_one.trans_le h).ne', + simp_rw [nnnorm_eq_sum hp, equiv_symm_apply, function.const_apply, finset.sum_const, + finset.card_univ, nsmul_eq_mul, nnreal.mul_rpow, ←nnreal.rpow_mul, mul_one_div_cancel ne_zero, + nnreal.rpow_one, ennreal.to_real_div, ennreal.one_to_real], }, +end + +/-- When `is_empty ι`, this lemma does not hold without the additional assumption `p ≠ ∞` because +the left-hand side simplifies to `0`, while the right-hand side simplifies to `‖b‖₊`. See +`pi_Lp.nnnorm_equiv_symm_const` for a version which exchanges the hypothesis `nonempty ι`. +for `p ≠ ∞`. -/ +lemma nnnorm_equiv_symm_const' {β} [seminormed_add_comm_group β] [nonempty ι] (b : β) : + ‖(pi_Lp.equiv p (λ _ : ι, β)).symm (function.const _ b)‖₊= + fintype.card ι ^ (1 / p).to_real * ‖b‖₊ := +begin + unfreezingI { rcases (em $ p = ∞) with (rfl | hp) }, + { simp only [equiv_symm_apply, ennreal.div_top, ennreal.zero_to_real, nnreal.rpow_zero, one_mul, + nnnorm_eq_csupr, function.const_apply, csupr_const], }, + { exact nnnorm_equiv_symm_const hp b, }, +end -lemma nnnorm_equiv_symm_one {β} [semi_normed_group β] [has_one β] : - ∥(pi_Lp.equiv p (λ _ : ι, β)).symm 1∥₊ = fintype.card ι ^ (1 / p) * ∥(1 : β)∥₊ := -(nnnorm_equiv_symm_const (1 : β)).trans rfl +/-- When `p = ∞`, this lemma does not hold without the additional assumption `nonempty ι` because +the left-hand side simplifies to `0`, while the right-hand side simplifies to `‖b‖₊`. See +`pi_Lp.norm_equiv_symm_const'` for a version which exchanges the hypothesis `p ≠ ∞` for +`nonempty ι`. -/ +lemma norm_equiv_symm_const {β} [seminormed_add_comm_group β] (hp : p ≠ ∞) (b : β) : + ‖(pi_Lp.equiv p (λ _ : ι, β)).symm (function.const _ b)‖ = + fintype.card ι ^ (1 / p).to_real * ‖b‖ := +(congr_arg coe $ nnnorm_equiv_symm_const hp b).trans $ by simp + +/-- When `is_empty ι`, this lemma does not hold without the additional assumption `p ≠ ∞` because +the left-hand side simplifies to `0`, while the right-hand side simplifies to `‖b‖₊`. See +`pi_Lp.norm_equiv_symm_const` for a version which exchanges the hypothesis `nonempty ι`. +for `p ≠ ∞`. -/ +lemma norm_equiv_symm_const' {β} [seminormed_add_comm_group β] [nonempty ι] (b : β) : + ‖(pi_Lp.equiv p (λ _ : ι, β)).symm (function.const _ b)‖ = + fintype.card ι ^ (1 / p).to_real * ‖b‖ := +(congr_arg coe $ nnnorm_equiv_symm_const' b).trans $ by simp + +lemma nnnorm_equiv_symm_one {β} [seminormed_add_comm_group β] (hp : p ≠ ∞) [has_one β] : + ‖(pi_Lp.equiv p (λ _ : ι, β)).symm 1‖₊ = fintype.card ι ^ (1 / p).to_real * ‖(1 : β)‖₊ := +(nnnorm_equiv_symm_const hp (1 : β)).trans rfl + +lemma norm_equiv_symm_one {β} [seminormed_add_comm_group β] (hp : p ≠ ∞) [has_one β] : + ‖(pi_Lp.equiv p (λ _ : ι, β)).symm 1‖ = fintype.card ι ^ (1 / p).to_real * ‖(1 : β)‖ := +(norm_equiv_symm_const hp (1 : β)).trans rfl + +variables (𝕜 p) + +/-- `pi_Lp.equiv` as a linear equivalence. -/ +@[simps {fully_applied := ff}] +protected def linear_equiv : pi_Lp p β ≃ₗ[𝕜] Π i, β i := +{ to_fun := pi_Lp.equiv _ _, + inv_fun := (pi_Lp.equiv _ _).symm, + ..linear_equiv.refl _ _} + +/-- `pi_Lp.equiv` as a continuous linear equivalence. -/ +@[simps {fully_applied := ff}] +protected def continuous_linear_equiv : pi_Lp p β ≃L[𝕜] Π i, β i := +{ to_linear_equiv := pi_Lp.linear_equiv _ _ _, + continuous_to_fun := continuous_equiv _ _, + continuous_inv_fun := continuous_equiv_symm _ _ } + +section basis + +variables (ι) + +/-- A version of `pi.basis_fun` for `pi_Lp`. -/ +def basis_fun : basis ι 𝕜 (pi_Lp p (λ _, 𝕜)) := +basis.of_equiv_fun (pi_Lp.linear_equiv p 𝕜 (λ _ : ι, 𝕜)) + +@[simp] lemma basis_fun_apply [decidable_eq ι] (i) : + basis_fun p 𝕜 ι i = (pi_Lp.equiv p _).symm (pi.single i 1) := +by simp_rw [basis_fun, basis.coe_of_equiv_fun, pi_Lp.linear_equiv_symm_apply, pi.single] + +@[simp] lemma basis_fun_repr (x : pi_Lp p (λ i : ι, 𝕜)) (i : ι) : + (basis_fun p 𝕜 ι).repr x i = x i := +rfl + +@[simp] lemma basis_fun_equiv_fun : + (basis_fun p 𝕜 ι).equiv_fun = pi_Lp.linear_equiv p 𝕜 (λ _ : ι, 𝕜) := +basis.equiv_fun_of_equiv_fun _ + +lemma basis_fun_eq_pi_basis_fun : + basis_fun p 𝕜 ι = (pi.basis_fun 𝕜 ι).map (pi_Lp.linear_equiv p 𝕜 (λ _ : ι, 𝕜)).symm := +rfl + +@[simp] lemma basis_fun_map : + (basis_fun p 𝕜 ι).map (pi_Lp.linear_equiv p 𝕜 (λ _ : ι, 𝕜)) = pi.basis_fun 𝕜 ι := +rfl + +open_locale matrix + +lemma basis_to_matrix_basis_fun_mul (b : basis ι 𝕜 (pi_Lp p (λ i : ι, 𝕜))) (A : matrix ι ι 𝕜) : + b.to_matrix (pi_Lp.basis_fun _ _ _) ⬝ A = + matrix.of (λ i j, b.repr ((pi_Lp.equiv _ _).symm (Aᵀ j)) i) := +begin + have := basis_to_matrix_basis_fun_mul (b.map (pi_Lp.linear_equiv _ 𝕜 _)) A, + simp_rw [←pi_Lp.basis_fun_map p, basis.map_repr, linear_equiv.trans_apply, + pi_Lp.linear_equiv_symm_apply, basis.to_matrix_map, function.comp, basis.map_apply, + linear_equiv.symm_apply_apply] at this, + exact this, +end -lemma norm_equiv_symm_one {β} [semi_normed_group β] [has_one β] : - ∥(pi_Lp.equiv p (λ _ : ι, β)).symm 1∥ = fintype.card ι ^ (1 / p) * ∥(1 : β)∥ := -(norm_equiv_symm_const (1 : β)).trans rfl +end basis end pi_Lp diff --git a/src/analysis/normed_space/pointwise.lean b/src/analysis/normed_space/pointwise.lean index 7d755191a43de..adb409acbb151 100644 --- a/src/analysis/normed_space/pointwise.lean +++ b/src/analysis/normed_space/pointwise.lean @@ -3,60 +3,115 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sébastien Gouëzel, Yaël Dillies -/ +import analysis.normed.group.add_torsor import analysis.normed.group.pointwise import analysis.normed_space.basic /-! # Properties of pointwise scalar multiplication of sets in normed spaces. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We explore the relationships between scalar multiplication of sets in vector spaces, and the norm. Notably, we express arbitrary balls as rescaling of other balls, and we show that the multiplication of bounded sets remain bounded. -/ open metric set -open_locale pointwise topological_space +open_locale pointwise topology + +variables {𝕜 E : Type*} + +section smul_zero_class +variables [seminormed_add_comm_group 𝕜] [seminormed_add_comm_group E] +variables [smul_zero_class 𝕜 E] [has_bounded_smul 𝕜 E] + +lemma ediam_smul_le (c : 𝕜) (s : set E) : + emetric.diam (c • s) ≤ ‖c‖₊ • emetric.diam s := +(lipschitz_with_smul c).ediam_image_le s + +end smul_zero_class + +section division_ring +variables [normed_division_ring 𝕜] [seminormed_add_comm_group E] +variables [module 𝕜 E] [has_bounded_smul 𝕜 E] + +lemma ediam_smul₀ (c : 𝕜) (s : set E) : + emetric.diam (c • s) = ‖c‖₊ • emetric.diam s := +begin + refine le_antisymm (ediam_smul_le c s) _, + obtain rfl | hc := eq_or_ne c 0, + { obtain rfl | hs := s.eq_empty_or_nonempty, + { simp }, + simp [zero_smul_set hs, ←set.singleton_zero], }, + { have := (lipschitz_with_smul c⁻¹).ediam_image_le (c • s), + rwa [← smul_eq_mul, ←ennreal.smul_def, set.image_smul, inv_smul_smul₀ hc s, nnnorm_inv, + ennreal.le_inv_smul_iff (nnnorm_ne_zero_iff.mpr hc)] at this } +end + +lemma diam_smul₀ (c : 𝕜) (x : set E) : diam (c • x) = ‖c‖ * diam x := +by simp_rw [diam, ediam_smul₀, ennreal.to_real_smul, nnreal.smul_def, coe_nnnorm, smul_eq_mul] + +lemma inf_edist_smul₀ {c : 𝕜} (hc : c ≠ 0) (s : set E) (x : E) : + emetric.inf_edist (c • x) (c • s) = ‖c‖₊ • emetric.inf_edist x s := +begin + simp_rw [emetric.inf_edist], + have : function.surjective ((•) c : E → E) := + function.right_inverse.surjective (smul_inv_smul₀ hc), + transitivity ⨅ y (H : y ∈ s), ‖c‖₊ • edist x y, + { refine (this.infi_congr _ $ λ y, _).symm, + simp_rw [smul_mem_smul_set_iff₀ hc, edist_smul₀] }, + { have : (‖c‖₊ : ennreal) ≠ 0 := by simp [hc], + simp_rw [ennreal.smul_def, smul_eq_mul, ennreal.mul_infi_of_ne this ennreal.coe_ne_top] }, +end + +lemma inf_dist_smul₀ {c : 𝕜} (hc : c ≠ 0) (s : set E) (x : E) : + metric.inf_dist (c • x) (c • s) = ‖c‖ * metric.inf_dist x s := +by simp_rw [metric.inf_dist, inf_edist_smul₀ hc, ennreal.to_real_smul, nnreal.smul_def, coe_nnnorm, + smul_eq_mul] + +end division_ring -variables {𝕜 E : Type*} [normed_field 𝕜] +variables [normed_field 𝕜] -section semi_normed_group -variables [semi_normed_group E] [normed_space 𝕜 E] +section seminormed_add_comm_group +variables [seminormed_add_comm_group E] [normed_space 𝕜 E] theorem smul_ball {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) : - c • ball x r = ball (c • x) (∥c∥ * r) := + c • ball x r = ball (c • x) (‖c‖ * r) := begin ext y, rw mem_smul_set_iff_inv_smul_mem₀ hc, conv_lhs { rw ←inv_smul_smul₀ hc x }, - simp [← div_eq_inv_mul, div_lt_iff (norm_pos_iff.2 hc), mul_comm _ r, dist_smul], + simp [← div_eq_inv_mul, div_lt_iff (norm_pos_iff.2 hc), mul_comm _ r, dist_smul₀], end -lemma smul_unit_ball {c : 𝕜} (hc : c ≠ 0) : c • ball (0 : E) (1 : ℝ) = ball (0 : E) (∥c∥) := +lemma smul_unit_ball {c : 𝕜} (hc : c ≠ 0) : c • ball (0 : E) (1 : ℝ) = ball (0 : E) (‖c‖) := by rw [smul_ball hc, smul_zero, mul_one] theorem smul_sphere' {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) : - c • sphere x r = sphere (c • x) (∥c∥ * r) := + c • sphere x r = sphere (c • x) (‖c‖ * r) := begin ext y, rw mem_smul_set_iff_inv_smul_mem₀ hc, conv_lhs { rw ←inv_smul_smul₀ hc x }, - simp only [mem_sphere, dist_smul, norm_inv, ← div_eq_inv_mul, + simp only [mem_sphere, dist_smul₀, norm_inv, ← div_eq_inv_mul, div_eq_iff (norm_pos_iff.2 hc).ne', mul_comm r], end theorem smul_closed_ball' {c : 𝕜} (hc : c ≠ 0) (x : E) (r : ℝ) : - c • closed_ball x r = closed_ball (c • x) (∥c∥ * r) := + c • closed_ball x r = closed_ball (c • x) (‖c‖ * r) := by simp only [← ball_union_sphere, set.smul_set_union, smul_ball hc, smul_sphere' hc] lemma metric.bounded.smul {s : set E} (hs : bounded s) (c : 𝕜) : bounded (c • s) := begin - obtain ⟨R, hR⟩ : ∃ (R : ℝ), ∀ x ∈ s, ∥x∥ ≤ R := hs.exists_norm_le, - refine (bounded_iff_exists_norm_le).2 ⟨∥c∥ * R, _⟩, - assume z hz, + obtain ⟨R, hR⟩ : ∃ (R : ℝ), ∀ x ∈ s, ‖x‖ ≤ R := hs.exists_norm_le, + refine bounded_iff_forall_norm_le.2 ⟨‖c‖ * R, λ z hz, _⟩, obtain ⟨y, ys, rfl⟩ : ∃ (y : E), y ∈ s ∧ c • y = z := mem_smul_set.1 hz, - calc ∥c • y∥ = ∥c∥ * ∥y∥ : norm_smul _ _ - ... ≤ ∥c∥ * R : mul_le_mul_of_nonneg_left (hR y ys) (norm_nonneg _) + calc ‖c • y‖ = ‖c‖ * ‖y‖ : norm_smul _ _ + ... ≤ ‖c‖ * R : mul_le_mul_of_nonneg_left (hR y ys) (norm_nonneg _) end /-- If `s` is a bounded set, then for small enough `r`, the set `{x} + r • s` is contained in any @@ -74,8 +129,8 @@ begin simp only [image_add_left, singleton_add], assume y hy, obtain ⟨z, zs, hz⟩ : ∃ (z : E), z ∈ s ∧ r • z = -x + y, by simpa [mem_smul_set] using hy, - have I : ∥r • z∥ ≤ ε := calc - ∥r • z∥ = ∥r∥ * ∥z∥ : norm_smul _ _ + have I : ‖r • z‖ ≤ ε := calc + ‖r • z‖ = ‖r‖ * ‖z‖ : norm_smul _ _ ... ≤ (ε / R) * R : mul_le_mul (mem_closed_ball_zero_iff.1 hr) (mem_closed_ball_zero_iff.1 (hR zs)) (norm_nonneg _) (div_pos εpos Rpos).le @@ -110,7 +165,7 @@ begin have hεδ := add_pos_of_pos_of_nonneg hε' hδ, refine (exists_dist_eq x z (div_nonneg hε $ add_nonneg hε hδ) (div_nonneg hδ $ add_nonneg hε hδ) $ by rw [←add_div, div_self hεδ.ne']).imp (λ y hy, _), - rw [hy.1, hy.2, div_mul_comm', div_mul_comm' ε], + rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε], rw ←div_le_one hεδ at h, exact ⟨mul_le_of_le_one_left hδ h, mul_le_of_le_one_left hε h⟩, end @@ -121,7 +176,7 @@ lemma exists_dist_le_lt (hδ : 0 ≤ δ) (hε : 0 < ε) (h : dist x z < ε + δ) begin refine (exists_dist_eq x z (div_nonneg hε.le $ add_nonneg hε.le hδ) (div_nonneg hδ $ add_nonneg hε.le hδ) $ by rw [←add_div, div_self (add_pos_of_pos_of_nonneg hε hδ).ne']).imp (λ y hy, _), - rw [hy.1, hy.2, div_mul_comm', div_mul_comm' ε], + rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε], rw ←div_lt_one (add_pos_of_pos_of_nonneg hε hδ) at h, exact ⟨mul_le_of_le_one_left hδ h.le, mul_lt_of_lt_one_left hε h⟩, end @@ -141,7 +196,7 @@ lemma exists_dist_lt_lt (hδ : 0 < δ) (hε : 0 < ε) (h : dist x z < ε + δ) : begin refine (exists_dist_eq x z (div_nonneg hε.le $ add_nonneg hε.le hδ.le) (div_nonneg hδ.le $ add_nonneg hε.le hδ.le) $ by rw [←add_div, div_self (add_pos hε hδ).ne']).imp (λ y hy, _), - rw [hy.1, hy.2, div_mul_comm', div_mul_comm' ε], + rw [hy.1, hy.2, div_mul_comm, div_mul_comm ε], rw ←div_lt_one (add_pos hε hδ) at h, exact ⟨mul_lt_of_lt_one_left hδ h, mul_lt_of_lt_one_left hε h⟩, end @@ -154,7 +209,7 @@ begin rw add_comm at hxy, obtain ⟨z, hxz, hzy⟩ := exists_dist_lt_lt hδ hε hxy, rw dist_comm at hxz, - exact h ⟨hxz, hzy⟩, + exact h.le_bot ⟨hxz, hzy⟩, end -- This is also true for `ℚ`-normed spaces @@ -165,7 +220,7 @@ begin rw add_comm at hxy, obtain ⟨z, hxz, hzy⟩ := exists_dist_lt_le hδ hε hxy, rw dist_comm at hxz, - exact h ⟨hxz, hzy⟩, + exact h.le_bot ⟨hxz, hzy⟩, end -- This is also true for `ℚ`-normed spaces @@ -180,7 +235,7 @@ begin rw add_comm at hxy, obtain ⟨z, hxz, hzy⟩ := exists_dist_le_le hδ hε hxy, rw dist_comm at hxz, - exact h ⟨hxz, hzy⟩, + exact h.le_bot ⟨hxz, hzy⟩, end open emetric ennreal @@ -275,7 +330,7 @@ by rw [←cthickening_singleton _ hδ, cthickening_cthickening hε hδ, lemma ball_add_ball (hε : 0 < ε) (hδ : 0 < δ) (a b : E) : ball a ε + ball b δ = ball (a + b) (ε + δ) := -by rw [ball_add, thickening_ball hε hδ, vadd_ball, vadd_eq_add]; apply_instance +by rw [ball_add, thickening_ball hε hδ b, metric.vadd_ball, vadd_eq_add] lemma ball_sub_ball (hε : 0 < ε) (hδ : 0 < δ) (a b : E) : ball a ε - ball b δ = ball (a - b) (ε + δ) := @@ -283,7 +338,7 @@ by simp_rw [sub_eq_add_neg, neg_ball, ball_add_ball hε hδ] lemma ball_add_closed_ball (hε : 0 < ε) (hδ : 0 ≤ δ) (a b : E) : ball a ε + closed_ball b δ = ball (a + b) (ε + δ) := -by rw [ball_add, thickening_closed_ball hε hδ, vadd_ball, vadd_eq_add]; apply_instance +by rw [ball_add, thickening_closed_ball hε hδ b, metric.vadd_ball, vadd_eq_add] lemma ball_sub_closed_ball (hε : 0 < ε) (hδ : 0 ≤ δ) (a b : E) : ball a ε - closed_ball b δ = ball (a - b) (ε + δ) := @@ -291,7 +346,7 @@ by simp_rw [sub_eq_add_neg, neg_closed_ball, ball_add_closed_ball hε hδ] lemma closed_ball_add_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (a b : E) : closed_ball a ε + ball b δ = ball (a + b) (ε + δ) := -by rw [add_comm, ball_add_closed_ball hδ hε, add_comm, add_comm δ]; apply_instance +by rw [add_comm, ball_add_closed_ball hδ hε b, add_comm, add_comm δ] lemma closed_ball_sub_ball (hε : 0 ≤ ε) (hδ : 0 < δ) (a b : E) : closed_ball a ε - ball b δ = ball (a - b) (ε + δ) := @@ -299,27 +354,27 @@ by simp_rw [sub_eq_add_neg, neg_ball, closed_ball_add_ball hε hδ] lemma closed_ball_add_closed_ball [proper_space E] (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (a b : E) : closed_ball a ε + closed_ball b δ = closed_ball (a + b) (ε + δ) := -by rw [(is_compact_closed_ball _ _).add_closed_ball hδ, cthickening_closed_ball hδ hε, - vadd_closed_ball, vadd_eq_add, add_comm, add_comm δ]; apply_instance +by rw [(is_compact_closed_ball _ _).add_closed_ball hδ b, cthickening_closed_ball hδ hε a, + metric.vadd_closed_ball, vadd_eq_add, add_comm, add_comm δ] lemma closed_ball_sub_closed_ball [proper_space E] (hε : 0 ≤ ε) (hδ : 0 ≤ δ) (a b : E) : closed_ball a ε - closed_ball b δ = closed_ball (a - b) (ε + δ) := by simp_rw [sub_eq_add_neg, neg_closed_ball, closed_ball_add_closed_ball hε hδ] -end semi_normed_group +end seminormed_add_comm_group -section normed_group -variables [normed_group E] [normed_space 𝕜 E] +section normed_add_comm_group +variables [normed_add_comm_group E] [normed_space 𝕜 E] theorem smul_closed_ball (c : 𝕜) (x : E) {r : ℝ} (hr : 0 ≤ r) : - c • closed_ball x r = closed_ball (c • x) (∥c∥ * r) := + c • closed_ball x r = closed_ball (c • x) (‖c‖ * r) := begin rcases eq_or_ne c 0 with rfl|hc, { simp [hr, zero_smul_set, set.singleton_zero, ← nonempty_closed_ball] }, { exact smul_closed_ball' hc x r } end -lemma smul_closed_unit_ball (c : 𝕜) : c • closed_ball (0 : E) (1 : ℝ) = closed_ball (0 : E) (∥c∥) := +lemma smul_closed_unit_ball (c : 𝕜) : c • closed_ball (0 : E) (1 : ℝ) = closed_ball (0 : E) (‖c‖) := by rw [smul_closed_ball _ _ zero_le_one, smul_zero, mul_one] variables [normed_space ℝ E] @@ -337,13 +392,13 @@ nonnegative. -/ begin obtain ⟨y, hy⟩ := exists_ne x, refine ⟨λ h, nonempty_closed_ball.1 (h.mono sphere_subset_closed_ball), λ hr, - ⟨r • ∥y - x∥⁻¹ • (y - x) + x, _⟩⟩, - have : ∥y - x∥ ≠ 0, by simpa [sub_eq_zero], + ⟨r • ‖y - x‖⁻¹ • (y - x) + x, _⟩⟩, + have : ‖y - x‖ ≠ 0, by simpa [sub_eq_zero], simp [norm_smul, this, real.norm_of_nonneg hr], end lemma smul_sphere [nontrivial E] (c : 𝕜) (x : E) {r : ℝ} (hr : 0 ≤ r) : - c • sphere x r = sphere (c • x) (∥c∥ * r) := + c • sphere x r = sphere (c • x) (‖c‖ * r) := begin rcases eq_or_ne c 0 with rfl|hc, { simp [zero_smul_set, set.singleton_zero, hr] }, @@ -360,4 +415,4 @@ lemma affinity_unit_closed_ball {r : ℝ} (hr : 0 ≤ r) (x : E) : x +ᵥ r • closed_ball 0 1 = closed_ball x r := by rw [smul_closed_unit_ball, real.norm_of_nonneg hr, vadd_closed_ball_zero] -end normed_group +end normed_add_comm_group diff --git a/src/analysis/normed_space/quaternion_exponential.lean b/src/analysis/normed_space/quaternion_exponential.lean new file mode 100644 index 0000000000000..a92e0d96e7dd7 --- /dev/null +++ b/src/analysis/normed_space/quaternion_exponential.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import analysis.quaternion +import analysis.normed_space.exponential +import analysis.special_functions.trigonometric.series + +/-! +# Lemmas about `exp` on `quaternion`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains results about `exp` on `quaternion ℝ`. + +## Main results + +* `quaternion.exp_eq`: the general expansion of the quaternion exponential in terms of `real.cos` + and `real.sin`. +* `quaternion.exp_of_re_eq_zero`: the special case when the quaternion has a zero real part. +* `quaternion.norm_exp`: the norm of the quaternion exponential is the norm of the exponential of + the real part. + +-/ + +open_locale quaternion nat + +namespace quaternion + +@[simp, norm_cast] lemma exp_coe (r : ℝ) : exp ℝ (r : ℍ[ℝ]) = ↑(exp ℝ r) := +(map_exp ℝ (algebra_map ℝ ℍ[ℝ]) (continuous_algebra_map _ _) _).symm + +/-- Auxiliary result; if the power series corresponding to `real.cos` and `real.sin` evaluated +at `‖q‖` tend to `c` and `s`, then the exponential series tends to `c + (s / ‖q‖)`. -/ +lemma has_sum_exp_series_of_imaginary + {q : quaternion ℝ} (hq : q.re = 0) {c s : ℝ} + (hc : has_sum (λ n, (-1)^n * ‖q‖^(2 * n) / (2 * n)!) c) + (hs : has_sum (λ n, (-1)^n * ‖q‖^(2 * n + 1) / (2 * n + 1)!) s) : + has_sum (λ n, exp_series ℝ _ n (λ _, q)) (↑c + (s / ‖q‖) • q) := +begin + replace hc := has_sum_coe.mpr hc, + replace hs := (hs.div_const ‖q‖).smul_const q, + obtain rfl | hq0 := eq_or_ne q 0, + { simp_rw [exp_series_apply_zero, norm_zero, div_zero, zero_smul, add_zero], + simp_rw [norm_zero] at hc, + convert hc, + ext (_ | n) : 1, + { rw [pow_zero, mul_zero, pow_zero, nat.factorial_zero, nat.cast_one, div_one, one_mul, + pi.single_eq_same, coe_one], }, + { rw [zero_pow (mul_pos two_pos (nat.succ_pos _)), mul_zero, zero_div, + pi.single_eq_of_ne (n.succ_ne_zero), coe_zero], } }, + simp_rw exp_series_apply_eq, + have hq2 : q^2 = -norm_sq q := sq_eq_neg_norm_sq.mpr hq, + have hqn := norm_ne_zero_iff.mpr hq0, + refine has_sum.even_add_odd _ _, + { convert hc using 1, + ext n : 1, + let k : ℝ := ↑(2 * n)!, + calc k⁻¹ • q ^ (2 * n) + = k⁻¹ • ((-norm_sq q) ^ n) : by rw [pow_mul, hq2] + ... = k⁻¹ • ↑((-1) ^ n * ‖q‖ ^ (2 * n)) : _ + ... = ↑((-1) ^ n * ‖q‖ ^ (2 * n) / k) : _, + { congr' 1, + rw [neg_pow, norm_sq_eq_norm_sq, pow_mul, sq], + push_cast }, + { rw [←coe_mul_eq_smul, div_eq_mul_inv], + norm_cast, + ring_nf } }, + { convert hs using 1, + ext n : 1, + let k : ℝ := ↑(2 * n + 1)!, + calc k⁻¹ • q ^ (2 * n + 1) + = k⁻¹ • ((-norm_sq q) ^ n * q) : by rw [pow_succ', pow_mul, hq2] + ... = k⁻¹ • ((-1) ^ n * ‖q‖ ^ (2 * n)) • q : _ + ... = ((-1) ^ n * ‖q‖ ^ (2 * n + 1) / k / ‖q‖) • q : _, + { congr' 1, + rw [neg_pow, norm_sq_eq_norm_sq, pow_mul, sq, ←coe_mul_eq_smul], + push_cast }, + { rw smul_smul, + congr' 1, + simp_rw [pow_succ', mul_div_assoc, div_div_cancel_left' hqn], + ring } }, +end + +/-- The closed form for the quaternion exponential on imaginary quaternions. -/ +lemma exp_of_re_eq_zero (q : quaternion ℝ) (hq : q.re = 0) : + exp ℝ q = ↑(real.cos ‖q‖) + (real.sin ‖q‖ / ‖q‖) • q := +begin + rw [exp_eq_tsum], + refine has_sum.tsum_eq _, + simp_rw ← exp_series_apply_eq, + exact has_sum_exp_series_of_imaginary hq (real.has_sum_cos _) (real.has_sum_sin _), +end + +/-- The closed form for the quaternion exponential on arbitrary quaternions. -/ +lemma exp_eq (q : quaternion ℝ) : + exp ℝ q = exp ℝ q.re • (↑(real.cos ‖q.im‖) + (real.sin ‖q.im‖ / ‖q.im‖) • q.im) := +begin + rw [←exp_of_re_eq_zero q.im q.im_re, ←coe_mul_eq_smul, ←exp_coe, ←exp_add_of_commute, re_add_im], + exact algebra.commutes q.re (_ : ℍ[ℝ]), +end + +lemma re_exp (q : ℍ[ℝ]) : (exp ℝ q).re = exp ℝ q.re * (real.cos ‖q - q.re‖) := +by simp [exp_eq] + +lemma im_exp (q : ℍ[ℝ]) : (exp ℝ q).im = (exp ℝ q.re * (real.sin ‖q.im‖ / ‖q.im‖)) • q.im := +by simp [exp_eq, smul_smul] + +lemma norm_sq_exp (q : ℍ[ℝ]) : norm_sq (exp ℝ q) = (exp ℝ q.re)^2 := +calc norm_sq (exp ℝ q) + = norm_sq (exp ℝ q.re • (↑(real.cos ‖q.im‖) + (real.sin ‖q.im‖ / ‖q.im‖) • q.im)) + : by rw exp_eq +... = (exp ℝ q.re)^2 * norm_sq ((↑(real.cos ‖q.im‖) + (real.sin ‖q.im‖ / ‖q.im‖) • q.im)) + : by rw [norm_sq_smul] +... = (exp ℝ q.re)^2 * ((real.cos ‖q.im‖) ^ 2 + (real.sin ‖q.im‖)^2) + : begin + congr' 1, + obtain hv | hv := eq_or_ne (‖q.im‖) 0, + { simp [hv] }, + rw [norm_sq_add, norm_sq_smul, star_smul, coe_mul_eq_smul, smul_re, smul_re, star_re, im_re, + smul_zero, smul_zero, mul_zero, add_zero, div_pow, norm_sq_coe, norm_sq_eq_norm_sq, ←sq, + div_mul_cancel _ (pow_ne_zero _ hv)], + end +... = (exp ℝ q.re)^2 : by rw [real.cos_sq_add_sin_sq, mul_one] + +/-- Note that this implies that exponentials of pure imaginary quaternions are unit quaternions +since in that case the RHS is `1` via `exp_zero` and `norm_one`. -/ +@[simp] lemma norm_exp (q : ℍ[ℝ]) : ‖exp ℝ q‖ = ‖exp ℝ q.re‖ := +by rw [norm_eq_sqrt_real_inner (exp ℝ q), inner_self, norm_sq_exp, real.sqrt_sq_eq_abs, + real.norm_eq_abs] + +end quaternion diff --git a/src/analysis/normed_space/ray.lean b/src/analysis/normed_space/ray.lean index a813093626bbe..d6724816a61b4 100644 --- a/src/analysis/normed_space/ray.lean +++ b/src/analysis/normed_space/ray.lean @@ -9,15 +9,18 @@ import analysis.normed_space.basic /-! # Rays in a real normed vector space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove some lemmas about the `same_ray` predicate in case of a real normed space. In this case, for two vectors `x y` in the same ray, the norm of their sum is equal to the sum of their -norms and `∥y∥ • x = ∥x∥ • y`. +norms and `‖y‖ • x = ‖x‖ • y`. -/ open real -variables {E : Type*} [semi_normed_group E] [normed_space ℝ E] - {F : Type*} [normed_group F] [normed_space ℝ F] +variables {E : Type*} [seminormed_add_comm_group E] [normed_space ℝ E] + {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] namespace same_ray @@ -26,28 +29,28 @@ variables {x y : E} /-- If `x` and `y` are on the same ray, then the triangle inequality becomes the equality: the norm of `x + y` is the sum of the norms of `x` and `y`. The converse is true for a strictly convex space. -/ -lemma norm_add (h : same_ray ℝ x y) : ∥x + y∥ = ∥x∥ + ∥y∥ := +lemma norm_add (h : same_ray ℝ x y) : ‖x + y‖ = ‖x‖ + ‖y‖ := begin rcases h.exists_eq_smul with ⟨u, a, b, ha, hb, -, rfl, rfl⟩, rw [← add_smul, norm_smul_of_nonneg (add_nonneg ha hb), norm_smul_of_nonneg ha, norm_smul_of_nonneg hb, add_mul] end -lemma norm_sub (h : same_ray ℝ x y) : ∥x - y∥ = |∥x∥ - ∥y∥| := +lemma norm_sub (h : same_ray ℝ x y) : ‖x - y‖ = |‖x‖ - ‖y‖| := begin rcases h.exists_eq_smul with ⟨u, a, b, ha, hb, -, rfl, rfl⟩, - wlog hab : b ≤ a := le_total b a using [a b, b a] tactic.skip, - { rw ← sub_nonneg at hab, - rw [← sub_smul, norm_smul_of_nonneg hab, norm_smul_of_nonneg ha, - norm_smul_of_nonneg hb, ← sub_mul, abs_of_nonneg (mul_nonneg hab (norm_nonneg _))] }, - { intros ha hb hab, - rw [norm_sub_rev, this hb ha hab.symm, abs_sub_comm] } + wlog hab : b ≤ a, + { rw same_ray_comm at h, rw [norm_sub_rev, abs_sub_comm], + exact this u b a hb ha h (le_of_not_le hab), }, + rw ← sub_nonneg at hab, + rw [← sub_smul, norm_smul_of_nonneg hab, norm_smul_of_nonneg ha, + norm_smul_of_nonneg hb, ← sub_mul, abs_of_nonneg (mul_nonneg hab (norm_nonneg _))] end -lemma norm_smul_eq (h : same_ray ℝ x y) : ∥x∥ • y = ∥y∥ • x := +lemma norm_smul_eq (h : same_ray ℝ x y) : ‖x‖ • y = ‖y‖ • x := begin rcases h.exists_eq_smul with ⟨u, a, b, ha, hb, -, rfl, rfl⟩, - simp only [norm_smul_of_nonneg, *, mul_smul, smul_comm (∥u∥)], + simp only [norm_smul_of_nonneg, *, mul_smul, smul_comm (‖u‖)], apply smul_comm end @@ -68,29 +71,30 @@ end lemma norm_inj_on_ray_right (hy : y ≠ 0) : {x | same_ray ℝ x y}.inj_on norm := by simpa only [same_ray_comm] using norm_inj_on_ray_left hy -lemma same_ray_iff_norm_smul_eq : same_ray ℝ x y ↔ ∥x∥ • y = ∥y∥ • x := +lemma same_ray_iff_norm_smul_eq : same_ray ℝ x y ↔ ‖x‖ • y = ‖y‖ • x := ⟨same_ray.norm_smul_eq, λ h, or_iff_not_imp_left.2 $ λ hx, or_iff_not_imp_left.2 $ λ hy, - ⟨∥y∥, ∥x∥, norm_pos_iff.2 hy, norm_pos_iff.2 hx, h.symm⟩⟩ + ⟨‖y‖, ‖x‖, norm_pos_iff.2 hy, norm_pos_iff.2 hx, h.symm⟩⟩ /-- Two nonzero vectors `x y` in a real normed space are on the same ray if and only if the unit -vectors `∥x∥⁻¹ • x` and `∥y∥⁻¹ • y` are equal. -/ +vectors `‖x‖⁻¹ • x` and `‖y‖⁻¹ • y` are equal. -/ lemma same_ray_iff_inv_norm_smul_eq_of_ne (hx : x ≠ 0) (hy : y ≠ 0) : - same_ray ℝ x y ↔ ∥x∥⁻¹ • x = ∥y∥⁻¹ • y := + same_ray ℝ x y ↔ ‖x‖⁻¹ • x = ‖y‖⁻¹ • y := by rw [inv_smul_eq_iff₀, smul_comm, eq_comm, inv_smul_eq_iff₀, same_ray_iff_norm_smul_eq]; rwa norm_ne_zero_iff alias same_ray_iff_inv_norm_smul_eq_of_ne ↔ same_ray.inv_norm_smul_eq _ /-- Two vectors `x y` in a real normed space are on the ray if and only if one of them is zero or -the unit vectors `∥x∥⁻¹ • x` and `∥y∥⁻¹ • y` are equal. -/ -lemma same_ray_iff_inv_norm_smul_eq : same_ray ℝ x y ↔ x = 0 ∨ y = 0 ∨ ∥x∥⁻¹ • x = ∥y∥⁻¹ • y := +the unit vectors `‖x‖⁻¹ • x` and `‖y‖⁻¹ • y` are equal. -/ +lemma same_ray_iff_inv_norm_smul_eq : same_ray ℝ x y ↔ x = 0 ∨ y = 0 ∨ ‖x‖⁻¹ • x = ‖y‖⁻¹ • y := begin rcases eq_or_ne x 0 with rfl|hx, { simp [same_ray.zero_left] }, rcases eq_or_ne y 0 with rfl|hy, { simp [same_ray.zero_right] }, simp only [same_ray_iff_inv_norm_smul_eq_of_ne hx hy, *, false_or] end -lemma same_ray_iff_of_norm_eq (h : ∥x∥ = ∥y∥) : same_ray ℝ x y ↔ x = y := +/-- Two vectors of the same norm are on the same ray if and only if they are equal. -/ +lemma same_ray_iff_of_norm_eq (h : ‖x‖ = ‖y‖) : same_ray ℝ x y ↔ x = y := begin obtain rfl | hy := eq_or_ne y 0, { rw [norm_zero, norm_eq_zero] at h, @@ -98,5 +102,13 @@ begin { exact ⟨λ hxy, norm_inj_on_ray_right hy hxy same_ray.rfl h, λ hxy, hxy ▸ same_ray.rfl⟩ } end -lemma not_same_ray_iff_of_norm_eq (h : ∥x∥ = ∥y∥) : ¬ same_ray ℝ x y ↔ x ≠ y := +lemma not_same_ray_iff_of_norm_eq (h : ‖x‖ = ‖y‖) : ¬ same_ray ℝ x y ↔ x ≠ y := (same_ray_iff_of_norm_eq h).not + +/-- If two points on the same ray have the same norm, then they are equal. -/ +lemma same_ray.eq_of_norm_eq (h : same_ray ℝ x y) (hn : ‖x‖ = ‖y‖) : x = y := +(same_ray_iff_of_norm_eq hn).mp h + +/-- The norms of two vectors on the same ray are equal if and only if they are equal. -/ +lemma same_ray.norm_eq_iff (h : same_ray ℝ x y) : ‖x‖ = ‖y‖ ↔ x = y := +⟨h.eq_of_norm_eq, λ h, h ▸ rfl⟩ diff --git a/src/analysis/normed_space/riesz_lemma.lean b/src/analysis/normed_space/riesz_lemma.lean index 6dbb26860e0da..0e14a11353071 100644 --- a/src/analysis/normed_space/riesz_lemma.lean +++ b/src/analysis/normed_space/riesz_lemma.lean @@ -9,23 +9,26 @@ import topology.metric_space.hausdorff_distance /-! # Applications of the Hausdorff distance in normed spaces +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Riesz's lemma, stated for a normed space over a normed field: for any -closed proper subspace `F` of `E`, there is a nonzero `x` such that `∥x - F∥` -is at least `r * ∥x∥` for any `r < 1`. This is `riesz_lemma`. +closed proper subspace `F` of `E`, there is a nonzero `x` such that `‖x - F‖` +is at least `r * ‖x‖` for any `r < 1`. This is `riesz_lemma`. -In a nondiscrete normed field (with an element `c` of norm `> 1`) and any `R > ∥c∥`, one can -guarantee `∥x∥ ≤ R` and `∥x - y∥ ≥ 1` for any `y` in `F`. This is `riesz_lemma_of_norm_lt`. +In a nontrivially normed field (with an element `c` of norm `> 1`) and any `R > ‖c‖`, one can +guarantee `‖x‖ ≤ R` and `‖x - y‖ ≥ 1` for any `y` in `F`. This is `riesz_lemma_of_norm_lt`. A further lemma, `metric.closed_ball_inf_dist_compl_subset_closure`, finds a *closed* ball within the closure of a set `s` of optimal distance from a point in `x` to the frontier of `s`. -/ open set metric -open_locale topological_space +open_locale topology variables {𝕜 : Type*} [normed_field 𝕜] -variables {E : Type*} [normed_group E] [normed_space 𝕜 E] -variables {F : Type*} [semi_normed_group F] [normed_space ℝ F] +variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] +variables {F : Type*} [seminormed_add_comm_group F] [normed_space ℝ F] /-- Riesz's lemma, which usually states that it is possible to find a vector with norm 1 whose distance to a closed proper subspace is @@ -35,7 +38,7 @@ is not guaranteed. For a variant giving an element with norm in `[1, R]`, see `riesz_lemma_of_norm_lt`. -/ lemma riesz_lemma {F : subspace 𝕜 E} (hFc : is_closed (F : set E)) (hF : ∃ x : E, x ∉ F) {r : ℝ} (hr : r < 1) : - ∃ x₀ : E, x₀ ∉ F ∧ ∀ y ∈ F, r * ∥x₀∥ ≤ ∥x₀ - y∥ := + ∃ x₀ : E, x₀ ∉ F ∧ ∀ y ∈ F, r * ‖x₀‖ ≤ ‖x₀ - y‖ := begin classical, obtain ⟨x, hx⟩ : ∃ x : E, x ∉ F := hF, @@ -57,10 +60,10 @@ begin refine ⟨x - y₀, x_ne_y₀, λy hy, le_of_lt _⟩, have hy₀y : y₀ + y ∈ F, from F.add_mem hy₀F hy, calc - r * ∥x - y₀∥ ≤ r' * ∥x - y₀∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) + r * ‖x - y₀‖ ≤ r' * ‖x - y₀‖ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) ... < d : by { rw ←dist_eq_norm, exact (lt_div_iff' hlt).1 hxy₀ } ... ≤ dist x (y₀ + y) : metric.inf_dist_le_dist_of_mem hy₀y - ... = ∥x - y₀ - y∥ : by { rw [sub_sub, dist_eq_norm] } + ... = ‖x - y₀ - y‖ : by { rw [sub_sub, dist_eq_norm] } end /-- @@ -69,33 +72,33 @@ which is at distance at least `1` of every element of `F`. Here, `R` is any giv strictly larger than the norm of an element of norm `> 1`. For a version without an `R`, see `riesz_lemma`. -Since we are considering a general nondiscrete normed field, there may be a gap in possible norms +Since we are considering a general nontrivially normed field, there may be a gap in possible norms (for instance no element of norm in `(1,2)`). Hence, we can not allow `R` arbitrarily close to `1`, -and require `R > ∥c∥` for some `c : 𝕜` with norm `> 1`. +and require `R > ‖c‖` for some `c : 𝕜` with norm `> 1`. -/ lemma riesz_lemma_of_norm_lt - {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R) + {c : 𝕜} (hc : 1 < ‖c‖) {R : ℝ} (hR : ‖c‖ < R) {F : subspace 𝕜 E} (hFc : is_closed (F : set E)) (hF : ∃ x : E, x ∉ F) : - ∃ x₀ : E, ∥x₀∥ ≤ R ∧ ∀ y ∈ F, 1 ≤ ∥x₀ - y∥ := + ∃ x₀ : E, ‖x₀‖ ≤ R ∧ ∀ y ∈ F, 1 ≤ ‖x₀ - y‖ := begin have Rpos : 0 < R := (norm_nonneg _).trans_lt hR, - have : ∥c∥ / R < 1, by { rw div_lt_iff Rpos, simpa using hR }, + have : ‖c‖ / R < 1, by { rw div_lt_iff Rpos, simpa using hR }, rcases riesz_lemma hFc hF this with ⟨x, xF, hx⟩, have x0 : x ≠ 0 := λ H, by simpa [H] using xF, obtain ⟨d, d0, dxlt, ledx, -⟩ : - ∃ (d : 𝕜), d ≠ 0 ∧ ∥d • x∥ < R ∧ R / ∥c∥ ≤ ∥d • x∥ ∧ ∥d∥⁻¹ ≤ R⁻¹ * ∥c∥ * ∥x∥ := + ∃ (d : 𝕜), d ≠ 0 ∧ ‖d • x‖ < R ∧ R / ‖c‖ ≤ ‖d • x‖ ∧ ‖d‖⁻¹ ≤ R⁻¹ * ‖c‖ * ‖x‖ := rescale_to_shell hc Rpos x0, refine ⟨d • x, dxlt.le, λ y hy, _⟩, set y' := d⁻¹ • y with hy', have y'F : y' ∈ F, by simp [hy', submodule.smul_mem _ _ hy], have yy' : y = d • y', by simp [hy', smul_smul, mul_inv_cancel d0], - calc 1 = (∥c∥/R) * (R/∥c∥) : by field_simp [Rpos.ne', (zero_lt_one.trans hc).ne'] - ... ≤ (∥c∥/R) * (∥d • x∥) : + calc 1 = (‖c‖/R) * (R/‖c‖) : by field_simp [Rpos.ne', (zero_lt_one.trans hc).ne'] + ... ≤ (‖c‖/R) * (‖d • x‖) : mul_le_mul_of_nonneg_left ledx (div_nonneg (norm_nonneg _) Rpos.le) - ... = ∥d∥ * (∥c∥/R * ∥x∥) : by { simp [norm_smul], ring } - ... ≤ ∥d∥ * ∥x - y'∥ : + ... = ‖d‖ * (‖c‖/R * ‖x‖) : by { simp [norm_smul], ring } + ... ≤ ‖d‖ * ‖x - y'‖ : mul_le_mul_of_nonneg_left (hx y' (by simp [hy', submodule.smul_mem _ _ hy])) (norm_nonneg _) - ... = ∥d • x - y∥ : by simp [yy', ← smul_sub, norm_smul], + ... = ‖d • x - y‖ : by simp [yy', ← smul_sub, norm_smul], end lemma metric.closed_ball_inf_dist_compl_subset_closure {x : F} {s : set F} (hx : x ∈ s) : @@ -105,7 +108,5 @@ begin { rw [h₀, closed_ball_zero'], exact closure_mono (singleton_subset_iff.2 hx) }, { rw ← closure_ball x h₀, - apply closure_mono, - calc ball x (inf_dist x sᶜ) ⊆ sᶜᶜ : disjoint_iff_subset_compl_right.1 disjoint_ball_inf_dist - ... = s : compl_compl s }, + exact closure_mono ball_inf_dist_compl_subset } end diff --git a/src/analysis/normed_space/spectrum.lean b/src/analysis/normed_space/spectrum.lean index 10154a20b4e36..d222373613d9b 100644 --- a/src/analysis/normed_space/spectrum.lean +++ b/src/analysis/normed_space/spectrum.lean @@ -3,19 +3,26 @@ Copyright (c) 2021 Jireh Loreaux. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jireh Loreaux -/ -import algebra.algebra.spectrum -import analysis.special_functions.pow -import analysis.special_functions.exponential +import field_theory.is_alg_closed.spectrum import analysis.complex.liouville +import analysis.complex.polynomial import analysis.analytic.radius_liminf +import topology.algebra.module.character_space +import analysis.normed_space.exponential /-! # The spectrum of elements in a complete normed algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the basic theory for the resolvent and spectrum of a Banach algebra. ## Main definitions -* `spectral_radius : ℝ≥0∞`: supremum of `∥k∥₊` for all `k ∈ spectrum 𝕜 a` +* `spectral_radius : ℝ≥0∞`: supremum of `‖k‖₊` for all `k ∈ spectrum 𝕜 a` +* `normed_ring.alg_equiv_complex_of_complete`: **Gelfand-Mazur theorem** For a complex + Banach division algebra, the natural `algebra_map ℂ A` is an algebra isomorphism whose inverse + is given by selecting the (unique) element of `spectrum ℂ a` ## Main statements @@ -29,9 +36,6 @@ This file contains the basic theory for the resolvent and spectrum of a Banach a * `spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius`: Gelfand's formula for the spectral radius in Banach algebras over `ℂ`. * `spectrum.nonempty`: the spectrum of any element in a complex Banach algebra is nonempty. -* `normed_division_ring.alg_equiv_complex_of_complete`: **Gelfand-Mazur theorem** For a complex - Banach division algebra, the natural `algebra_map ℂ A` is an algebra isomorphism whose inverse - is given by selecting the (unique) element of `spectrum ℂ a` ## TODO @@ -40,16 +44,16 @@ This file contains the basic theory for the resolvent and spectrum of a Banach a -/ -open_locale ennreal +open_locale ennreal nnreal -/-- The *spectral radius* is the supremum of the `nnnorm` (`∥⬝∥₊`) of elements in the spectrum, +/-- The *spectral radius* is the supremum of the `nnnorm` (`‖⬝‖₊`) of elements in the spectrum, coerced into an element of `ℝ≥0∞`. Note that it is possible for `spectrum 𝕜 a = ∅`. In this case, `spectral_radius a = 0`. It is also possible that `spectrum 𝕜 a` be unbounded (though not for Banach algebras, see `spectrum.is_bounded`, below). In this case, `spectral_radius a = ∞`. -/ noncomputable def spectral_radius (𝕜 : Type*) {A : Type*} [normed_field 𝕜] [ring A] [algebra 𝕜 A] (a : A) : ℝ≥0∞ := -⨆ k ∈ spectrum 𝕜 a, ∥k∥₊ +⨆ k ∈ spectrum 𝕜 a, ‖k‖₊ variables {𝕜 : Type*} {A : Type*} @@ -57,57 +61,96 @@ namespace spectrum section spectrum_compact +open filter + variables [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] local notation `σ` := spectrum 𝕜 local notation `ρ` := resolvent_set 𝕜 local notation `↑ₐ` := algebra_map 𝕜 A -lemma mem_resolvent_set_of_spectral_radius_lt {a : A} {k : 𝕜} (h : spectral_radius 𝕜 a < ∥k∥₊) : +@[simp] lemma spectral_radius.of_subsingleton [subsingleton A] (a : A) : + spectral_radius 𝕜 a = 0 := +by simp [spectral_radius] + +@[simp] lemma spectral_radius_zero : spectral_radius 𝕜 (0 : A) = 0 := +by { nontriviality A, simp [spectral_radius] } + +lemma mem_resolvent_set_of_spectral_radius_lt {a : A} {k : 𝕜} (h : spectral_radius 𝕜 a < ‖k‖₊) : k ∈ ρ a := not_not.mp $ λ hn, h.not_le $ le_supr₂ k hn variable [complete_space A] lemma is_open_resolvent_set (a : A) : is_open (ρ a) := -units.is_open.preimage ((algebra_map_clm 𝕜 A).continuous.sub continuous_const) +units.is_open.preimage ((continuous_algebra_map 𝕜 A).sub continuous_const) -lemma is_closed (a : A) : is_closed (σ a) := +protected lemma is_closed (a : A) : is_closed (σ a) := (is_open_resolvent_set a).is_closed_compl -lemma mem_resolvent_of_norm_lt [norm_one_class A] {a : A} {k : 𝕜} (h : ∥a∥ < ∥k∥) : +lemma mem_resolvent_set_of_norm_lt_mul {a : A} {k : 𝕜} (h : ‖a‖ * ‖(1 : A)‖ < ‖k‖) : k ∈ ρ a := begin rw [resolvent_set, set.mem_set_of_eq, algebra.algebra_map_eq_smul_one], - have hk : k ≠ 0 := ne_zero_of_norm_ne_zero (by linarith [norm_nonneg a]), + nontriviality A, + have hk : k ≠ 0, + from ne_zero_of_norm_ne_zero ((mul_nonneg (norm_nonneg _) (norm_nonneg _)).trans_lt h).ne', let ku := units.map (↑ₐ).to_monoid_hom (units.mk0 k hk), - have hku : ∥-a∥ < ∥(↑ku⁻¹:A)∥⁻¹ := by simpa [ku, algebra_map_isometry] using h, + rw [←inv_inv (‖(1 : A)‖), mul_inv_lt_iff (inv_pos.2 $ norm_pos_iff.2 (one_ne_zero : (1 : A) ≠ 0))] + at h, + have hku : ‖-a‖ < ‖(↑ku⁻¹:A)‖⁻¹ := by simpa [ku, norm_algebra_map] using h, simpa [ku, sub_eq_add_neg, algebra.algebra_map_eq_smul_one] using (ku.add (-a) hku).is_unit, end +lemma mem_resolvent_set_of_norm_lt [norm_one_class A] {a : A} {k : 𝕜} (h : ‖a‖ < ‖k‖) : + k ∈ ρ a := +mem_resolvent_set_of_norm_lt_mul (by rwa [norm_one, mul_one]) + +lemma norm_le_norm_mul_of_mem {a : A} {k : 𝕜} (hk : k ∈ σ a) : + ‖k‖ ≤ ‖a‖ * ‖(1 : A)‖ := +le_of_not_lt $ mt mem_resolvent_set_of_norm_lt_mul hk + lemma norm_le_norm_of_mem [norm_one_class A] {a : A} {k : 𝕜} (hk : k ∈ σ a) : - ∥k∥ ≤ ∥a∥ := -le_of_not_lt $ mt mem_resolvent_of_norm_lt hk + ‖k‖ ≤ ‖a‖ := +le_of_not_lt $ mt mem_resolvent_set_of_norm_lt hk + +lemma subset_closed_ball_norm_mul (a : A) : + σ a ⊆ metric.closed_ball (0 : 𝕜) (‖a‖ * ‖(1 : A)‖) := +λ k hk, by simp [norm_le_norm_mul_of_mem hk] lemma subset_closed_ball_norm [norm_one_class A] (a : A) : - σ a ⊆ metric.closed_ball (0 : 𝕜) (∥a∥) := + σ a ⊆ metric.closed_ball (0 : 𝕜) (‖a‖) := λ k hk, by simp [norm_le_norm_of_mem hk] -lemma is_bounded [norm_one_class A] (a : A) : metric.bounded (σ a) := -(metric.bounded_iff_subset_ball 0).mpr ⟨∥a∥, subset_closed_ball_norm a⟩ +lemma is_bounded (a : A) : metric.bounded (σ a) := +(metric.bounded_iff_subset_ball 0).mpr ⟨‖a‖ * ‖(1 : A)‖, subset_closed_ball_norm_mul a⟩ -theorem is_compact [norm_one_class A] [proper_space 𝕜] (a : A) : is_compact (σ a) := -metric.is_compact_of_is_closed_bounded (is_closed a) (is_bounded a) +protected theorem is_compact [proper_space 𝕜] (a : A) : is_compact (σ a) := +metric.is_compact_of_is_closed_bounded (spectrum.is_closed a) (is_bounded a) theorem spectral_radius_le_nnnorm [norm_one_class A] (a : A) : - spectral_radius 𝕜 a ≤ ∥a∥₊ := + spectral_radius 𝕜 a ≤ ‖a‖₊ := by { refine supr₂_le (λ k hk, _), exact_mod_cast norm_le_norm_of_mem hk } +lemma exists_nnnorm_eq_spectral_radius_of_nonempty [proper_space 𝕜] {a : A} (ha : (σ a).nonempty) : + ∃ k ∈ σ a, (‖k‖₊ : ℝ≥0∞) = spectral_radius 𝕜 a := +begin + obtain ⟨k, hk, h⟩ := (spectrum.is_compact a).exists_forall_ge ha continuous_nnnorm.continuous_on, + exact ⟨k, hk, le_antisymm (le_supr₂ k hk) (supr₂_le $ by exact_mod_cast h)⟩, +end + +lemma spectral_radius_lt_of_forall_lt_of_nonempty [proper_space 𝕜] {a : A} + (ha : (σ a).nonempty) {r : ℝ≥0} (hr : ∀ k ∈ σ a, ‖k‖₊ < r) : + spectral_radius 𝕜 a < r := +Sup_image.symm.trans_lt $ ((spectrum.is_compact a).Sup_lt_iff_of_continuous ha + (ennreal.continuous_coe.comp continuous_nnnorm).continuous_on (r : ℝ≥0∞)).mpr + (by exact_mod_cast hr) + open ennreal polynomial variable (𝕜) -theorem spectral_radius_le_pow_nnnorm_pow_one_div [norm_one_class A] (a : A) (n : ℕ) : - spectral_radius 𝕜 a ≤ ∥a ^ (n + 1)∥₊ ^ (1 / (n + 1) : ℝ) := +theorem spectral_radius_le_pow_nnnorm_pow_one_div (a : A) (n : ℕ) : + spectral_radius 𝕜 a ≤ (‖a ^ (n + 1)‖₊) ^ (1 / (n + 1) : ℝ) * (‖(1 : A)‖₊) ^ (1 / (n + 1) : ℝ) := begin refine supr₂_le (λ k hk, _), /- apply easy direction of the spectral mapping theorem for polynomials -/ @@ -115,13 +158,35 @@ begin by simpa only [one_mul, algebra.algebra_map_eq_smul_one, one_smul, aeval_monomial, one_mul, eval_monomial] using subset_polynomial_aeval a (monomial (n + 1) (1 : 𝕜)) ⟨k, hk, rfl⟩, /- power of the norm is bounded by norm of the power -/ - have nnnorm_pow_le : (↑(∥k∥₊ ^ (n + 1)) : ℝ≥0∞) ≤ ↑∥a ^ (n + 1)∥₊, - by simpa only [norm_to_nnreal, nnnorm_pow k (n+1)] - using coe_mono (real.to_nnreal_mono (norm_le_norm_of_mem pow_mem)), + have nnnorm_pow_le : (↑(‖k‖₊ ^ (n + 1)) : ℝ≥0∞) ≤ ‖a ^ (n + 1)‖₊ * ‖(1 : A)‖₊, + { simpa only [real.to_nnreal_mul (norm_nonneg _), norm_to_nnreal, nnnorm_pow k (n + 1), + ennreal.coe_mul] using coe_mono (real.to_nnreal_mono (norm_le_norm_mul_of_mem pow_mem)) }, /- take (n + 1)ᵗʰ roots and clean up the left-hand side -/ - have hn : 0 < ((n + 1) : ℝ), by exact_mod_cast nat.succ_pos', + have hn : 0 < ((n + 1 : ℕ) : ℝ), by exact_mod_cast nat.succ_pos', convert monotone_rpow_of_nonneg (one_div_pos.mpr hn).le nnnorm_pow_le, erw [coe_pow, ←rpow_nat_cast, ←rpow_mul, mul_one_div_cancel hn.ne', rpow_one], + rw [nat.cast_succ, ennreal.coe_mul_rpow], +end + +theorem spectral_radius_le_liminf_pow_nnnorm_pow_one_div (a : A) : + spectral_radius 𝕜 a ≤ at_top.liminf (λ n : ℕ, (‖a ^ n‖₊ : ℝ≥0∞) ^ (1 / n : ℝ)) := +begin + refine ennreal.le_of_forall_lt_one_mul_le (λ ε hε, _), + by_cases ε = 0, + { simp only [h, zero_mul, zero_le'] }, + have hε' : ε⁻¹ ≠ ∞, + from λ h', h (by simpa only [inv_inv, inv_top] using congr_arg (λ (x : ℝ≥0∞), x⁻¹) h'), + simp only [ennreal.mul_le_iff_le_inv h (hε.trans_le le_top).ne, mul_comm ε⁻¹, + liminf_eq_supr_infi_of_nat', ennreal.supr_mul, ennreal.infi_mul hε'], + rw [←ennreal.inv_lt_inv, inv_one] at hε, + obtain ⟨N, hN⟩ := eventually_at_top.mp + (ennreal.eventually_pow_one_div_le (ennreal.coe_ne_top : ↑‖(1 : A)‖₊ ≠ ∞) hε), + refine (le_trans _ (le_supr _ (N + 1))), + refine le_infi (λ n, _), + simp only [←add_assoc], + refine (spectral_radius_le_pow_nnnorm_pow_one_div 𝕜 a (n + N)).trans _, + norm_cast, + exact mul_le_mul_left' (hN (n + N + 1) (by linarith)) _, end end spectrum_compact @@ -130,7 +195,7 @@ section resolvent open filter asymptotics -variables [nondiscrete_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A] +variables [nontrivially_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A] local notation `ρ` := resolvent_set 𝕜 local notation `↑ₐ` := algebra_map 𝕜 A @@ -146,32 +211,32 @@ end /- TODO: Once there is sufficient API for bornology, we should get a nice filter / asymptotics version of this, for example: `tendsto (resolvent a) (cobounded 𝕜) (𝓝 0)` or more specifically -`is_O (resolvent a) (λ z, z⁻¹) (cobounded 𝕜)`. -/ +`(resolvent a) =O[cobounded 𝕜] (λ z, z⁻¹)`. -/ lemma norm_resolvent_le_forall (a : A) : - ∀ ε > 0, ∃ R > 0, ∀ z : 𝕜, R ≤ ∥z∥ → ∥resolvent a z∥ ≤ ε := + ∀ ε > 0, ∃ R > 0, ∀ z : 𝕜, R ≤ ‖z‖ → ‖resolvent a z‖ ≤ ε := begin obtain ⟨c, c_pos, hc⟩ := (@normed_ring.inverse_one_sub_norm A _ _).exists_pos, rw [is_O_with_iff, eventually_iff, metric.mem_nhds_iff] at hc, rcases hc with ⟨δ, δ_pos, hδ⟩, simp only [cstar_ring.norm_one, mul_one] at hδ, intros ε hε, - have ha₁ : 0 < ∥a∥ + 1 := lt_of_le_of_lt (norm_nonneg a) (lt_add_one _), - have min_pos : 0 < min (δ * (∥a∥ + 1)⁻¹) (ε * c⁻¹), + have ha₁ : 0 < ‖a‖ + 1 := lt_of_le_of_lt (norm_nonneg a) (lt_add_one _), + have min_pos : 0 < min (δ * (‖a‖ + 1)⁻¹) (ε * c⁻¹), from lt_min (mul_pos δ_pos (inv_pos.mpr ha₁)) (mul_pos hε (inv_pos.mpr c_pos)), - refine ⟨(min (δ * (∥a∥ + 1)⁻¹) (ε * c⁻¹))⁻¹, inv_pos.mpr min_pos, (λ z hz, _)⟩, + refine ⟨(min (δ * (‖a‖ + 1)⁻¹) (ε * c⁻¹))⁻¹, inv_pos.mpr min_pos, (λ z hz, _)⟩, have hnz : z ≠ 0 := norm_pos_iff.mp (lt_of_lt_of_le (inv_pos.mpr min_pos) hz), replace hz := inv_le_of_inv_le min_pos hz, rcases (⟨units.mk0 z hnz, units.coe_mk0 hnz⟩ : is_unit z) with ⟨z, rfl⟩, - have lt_δ : ∥z⁻¹ • a∥ < δ, - { rw [units.smul_def, norm_smul, units.coe_inv', norm_inv], - calc ∥(z : 𝕜)∥⁻¹ * ∥a∥ ≤ δ * (∥a∥ + 1)⁻¹ * ∥a∥ + have lt_δ : ‖z⁻¹ • a‖ < δ, + { rw [units.smul_def, norm_smul, units.coe_inv, norm_inv], + calc ‖(z : 𝕜)‖⁻¹ * ‖a‖ ≤ δ * (‖a‖ + 1)⁻¹ * ‖a‖ : mul_le_mul_of_nonneg_right (hz.trans (min_le_left _ _)) (norm_nonneg _) ... < δ : by { conv { rw mul_assoc, to_rhs, rw (mul_one δ).symm }, exact mul_lt_mul_of_pos_left - ((inv_mul_lt_iff ha₁).mpr ((mul_one (∥a∥ + 1)).symm ▸ (lt_add_one _))) δ_pos } }, + ((inv_mul_lt_iff ha₁).mpr ((mul_one (‖a‖ + 1)).symm ▸ (lt_add_one _))) δ_pos } }, rw [←inv_smul_smul z (resolvent a (z : 𝕜)), units_smul_resolvent_self, resolvent, - algebra.algebra_map_eq_smul_one, one_smul, units.smul_def, norm_smul, units.coe_inv', norm_inv], + algebra.algebra_map_eq_smul_one, one_smul, units.smul_def, norm_smul, units.coe_inv, norm_inv], calc _ ≤ ε * c⁻¹ * c : mul_le_mul (hz.trans (min_le_right _ _)) (hδ (mem_ball_zero_iff.mpr lt_δ)) (norm_nonneg _) (mul_pos hε (inv_pos.mpr c_pos)).le ... = _ : inv_mul_cancel_right₀ c_pos.ne.symm ε, @@ -185,24 +250,24 @@ open continuous_multilinear_map ennreal formal_multilinear_series open_locale nnreal ennreal variables -[nondiscrete_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] +[nontrivially_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] variable (𝕜) -/-- In a Banach algebra `A` over a nondiscrete normed field `𝕜`, for any `a : A` the +/-- In a Banach algebra `A` over a nontrivially normed field `𝕜`, for any `a : A` the power series with coefficients `a ^ n` represents the function `(1 - z • a)⁻¹` in a disk of -radius `∥a∥₊⁻¹`. -/ +radius `‖a‖₊⁻¹`. -/ lemma has_fpower_series_on_ball_inverse_one_sub_smul [complete_space A] (a : A) : has_fpower_series_on_ball (λ z : 𝕜, ring.inverse (1 - z • a)) - (λ n, continuous_multilinear_map.mk_pi_field 𝕜 (fin n) (a ^ n)) 0 (∥a∥₊)⁻¹ := + (λ n, continuous_multilinear_map.mk_pi_field 𝕜 (fin n) (a ^ n)) 0 (‖a‖₊)⁻¹ := { r_le := begin - refine le_of_forall_nnreal_lt (λ r hr, le_radius_of_bound_nnreal _ (max 1 ∥(1 : A)∥₊) (λ n, _)), + refine le_of_forall_nnreal_lt (λ r hr, le_radius_of_bound_nnreal _ (max 1 ‖(1 : A)‖₊) (λ n, _)), rw [←norm_to_nnreal, norm_mk_pi_field, norm_to_nnreal], cases n, { simp only [le_refl, mul_one, or_true, le_max_iff, pow_zero] }, { refine le_trans (le_trans (mul_le_mul_right' (nnnorm_pow_le' a n.succ_pos) (r ^ n.succ)) _) (le_max_left _ _), - { by_cases ∥a∥₊ = 0, + { by_cases ‖a‖₊ = 0, { simp only [h, zero_mul, zero_le', pow_succ], }, { rw [←coe_inv h, coe_lt_coe, nnreal.lt_inv_iff_mul_lt h] at hr, simpa only [←mul_pow, mul_comm] using pow_le_one' hr.le n.succ } } } @@ -210,10 +275,10 @@ lemma has_fpower_series_on_ball_inverse_one_sub_smul [complete_space A] (a : A) r_pos := ennreal.inv_pos.mpr coe_ne_top, has_sum := λ y hy, begin - have norm_lt : ∥y • a∥ < 1, - { by_cases h : ∥a∥₊ = 0, + have norm_lt : ‖y • a‖ < 1, + { by_cases h : ‖a‖₊ = 0, { simp only [nnnorm_eq_zero.mp h, norm_zero, zero_lt_one, smul_zero] }, - { have nnnorm_lt : ∥y∥₊ < ∥a∥₊⁻¹, + { have nnnorm_lt : ‖y‖₊ < ‖a‖₊⁻¹, by simpa only [←coe_inv h, mem_ball_zero_iff, metric.emetric_ball_nnreal] using hy, rwa [←coe_nnnorm, ←real.lt_to_nnreal_iff_coe_lt, real.to_nnreal_one, nnnorm_smul, ←nnreal.lt_inv_iff_mul_lt h] } }, @@ -222,7 +287,7 @@ lemma has_fpower_series_on_ball_inverse_one_sub_smul [complete_space A] (a : A) end } variable {𝕜} -lemma is_unit_one_sub_smul_of_lt_inv_radius {a : A} {z : 𝕜} (h : ↑∥z∥₊ < (spectral_radius 𝕜 a)⁻¹) : +lemma is_unit_one_sub_smul_of_lt_inv_radius {a : A} {z : 𝕜} (h : ↑‖z‖₊ < (spectral_radius 𝕜 a)⁻¹) : is_unit (1 - z • a) := begin by_cases hz : z = 0, @@ -232,7 +297,7 @@ begin { rwa [is_unit.smul_sub_iff_sub_inv_smul, inv_inv u] at hu }, { rw [units.smul_def, ←algebra.algebra_map_eq_smul_one, ←mem_resolvent_set_iff], refine mem_resolvent_set_of_spectral_radius_lt _, - rwa [units.coe_inv', nnnorm_inv, coe_inv (nnnorm_ne_zero_iff.mpr + rwa [units.coe_inv, nnnorm_inv, coe_inv (nnnorm_ne_zero_iff.mpr (units.coe_mk0 hz ▸ hz : (u : 𝕜) ≠ 0)), lt_inv_iff_lt_inv] } } end @@ -249,7 +314,7 @@ begin simpa only [norm_to_nnreal, real.to_nnreal_coe] using real.to_nnreal_mono (mem_closed_ball_zero_iff.mp z_mem) }, have H₁ : differentiable 𝕜 (λ w : 𝕜, 1 - w • a) := (differentiable_id.smul_const a).const_sub 1, - exact differentiable_at.comp z (differentiable_at_inverse hu.unit) (H₁.differentiable_at), + exact differentiable_at.comp z (differentiable_at_inverse hu) (H₁.differentiable_at), end end one_sub_smul @@ -257,14 +322,14 @@ end one_sub_smul section gelfand_formula open filter ennreal continuous_multilinear_map -open_locale topological_space +open_locale topology variables [normed_ring A] [normed_algebra ℂ A] [complete_space A] /-- The `limsup` relationship for the spectral radius used to prove `spectrum.gelfand_formula`. -/ lemma limsup_pow_nnnorm_pow_one_div_le_spectral_radius (a : A) : - limsup at_top (λ n : ℕ, ↑∥a ^ n∥₊ ^ (1 / n : ℝ)) ≤ spectral_radius ℂ a := + limsup (λ n : ℕ, ↑‖a ^ n‖₊ ^ (1 / n : ℝ)) at_top ≤ spectral_radius ℂ a := begin refine ennreal.inv_le_inv.mp (le_of_forall_pos_nnreal_lt (λ r r_pos r_lt, _)), simp_rw [inv_limsup, ←one_div], @@ -273,31 +338,27 @@ begin suffices h : (r : ℝ≥0∞) ≤ p.radius, { convert h, simp only [p.radius_eq_liminf, ←norm_to_nnreal, norm_mk_pi_field], - refine congr_arg _ (funext (λ n, congr_arg _ _)), - rw [norm_to_nnreal, ennreal.coe_rpow_def (∥a ^ n∥₊) (1 / n : ℝ), if_neg], + congr, + ext n, + rw [norm_to_nnreal, ennreal.coe_rpow_def (‖a ^ n‖₊) (1 / n : ℝ), if_neg], exact λ ha, by linarith [ha.2, (one_div_nonneg.mpr n.cast_nonneg : 0 ≤ (1 / n : ℝ))], }, { have H₁ := (differentiable_on_inverse_one_sub_smul r_lt).has_fpower_series_on_ball r_pos, exact ((has_fpower_series_on_ball_inverse_one_sub_smul ℂ a).exchange_radius H₁).r_le, } end /-- **Gelfand's formula**: Given an element `a : A` of a complex Banach algebra, the -`spectral_radius` of `a` is the limit of the sequence `∥a ^ n∥₊ ^ (1 / n)` -/ -theorem pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius [norm_one_class A] (a : A) : - tendsto (λ n : ℕ, ((∥a ^ n∥₊ ^ (1 / n : ℝ)) : ℝ≥0∞)) at_top (𝓝 (spectral_radius ℂ a)) := -begin - refine tendsto_of_le_liminf_of_limsup_le _ _ (by apply_auto_param) (by apply_auto_param), - { rw [←liminf_nat_add _ 1, liminf_eq_supr_infi_of_nat], - refine le_trans _ (le_supr _ 0), - exact le_infi₂ (λ i hi, spectral_radius_le_pow_nnnorm_pow_one_div ℂ a i) }, - { exact limsup_pow_nnnorm_pow_one_div_le_spectral_radius a }, -end +`spectral_radius` of `a` is the limit of the sequence `‖a ^ n‖₊ ^ (1 / n)` -/ +theorem pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius (a : A) : + tendsto (λ n : ℕ, ((‖a ^ n‖₊ ^ (1 / n : ℝ)) : ℝ≥0∞)) at_top (𝓝 (spectral_radius ℂ a)) := +tendsto_of_le_liminf_of_limsup_le (spectral_radius_le_liminf_pow_nnnorm_pow_one_div ℂ a) + (limsup_pow_nnnorm_pow_one_div_le_spectral_radius a) /- This is the same as `pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius` but for `norm` instead of `nnnorm`. -/ /-- **Gelfand's formula**: Given an element `a : A` of a complex Banach algebra, the -`spectral_radius` of `a` is the limit of the sequence `∥a ^ n∥₊ ^ (1 / n)` -/ -theorem pow_norm_pow_one_div_tendsto_nhds_spectral_radius [norm_one_class A] (a : A) : - tendsto (λ n : ℕ, ennreal.of_real (∥a ^ n∥ ^ (1 / n : ℝ))) at_top (𝓝 (spectral_radius ℂ a)) := +`spectral_radius` of `a` is the limit of the sequence `‖a ^ n‖₊ ^ (1 / n)` -/ +theorem pow_norm_pow_one_div_tendsto_nhds_spectral_radius (a : A) : + tendsto (λ n : ℕ, ennreal.of_real (‖a ^ n‖ ^ (1 / n : ℝ))) at_top (𝓝 (spectral_radius ℂ a)) := begin convert pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius a, ext1, @@ -307,14 +368,16 @@ end end gelfand_formula +section nonempty_spectrum + +variables [normed_ring A] [normed_algebra ℂ A] [complete_space A] [nontrivial A] (a : A) + /-- In a (nontrivial) complex Banach algebra, every element has nonempty spectrum. -/ -theorem nonempty {A : Type*} [normed_ring A] [normed_algebra ℂ A] [complete_space A] - [nontrivial A] - (a : A) : (spectrum ℂ a).nonempty := +protected theorem nonempty : (spectrum ℂ a).nonempty := begin /- Suppose `σ a = ∅`, then resolvent set is `ℂ`, any `(z • 1 - a)` is a unit, and `resolvent` is differentiable on `ℂ`. -/ - rw ←set.ne_empty_iff_nonempty, + rw set.nonempty_iff_ne_empty, by_contra h, have H₀ : resolvent_set ℂ a = set.univ, by rwa [spectrum, set.compl_empty_iff] at h, have H₁ : differentiable ℂ (λ z : ℂ, resolvent a z), from λ z, @@ -324,13 +387,13 @@ begin By Liouville's theorem `λ z, resolvent a z` is constant -/ have H₂ := norm_resolvent_le_forall a, have H₃ : ∀ z : ℂ, resolvent a z = resolvent a (0 : ℂ), - { refine λ z, H₁.apply_eq_apply_of_bounded (bounded_iff_exists_norm_le.mpr _) z 0, + { refine λ z, H₁.apply_eq_apply_of_bounded (bounded_iff_forall_norm_le.mpr _) z 0, rcases H₂ 1 zero_lt_one with ⟨R, R_pos, hR⟩, rcases (proper_space.is_compact_closed_ball (0 : ℂ) R).exists_bound_of_continuous_on H₁.continuous.continuous_on with ⟨C, hC⟩, use max C 1, rintros _ ⟨w, rfl⟩, - refine or.elim (em (∥w∥ ≤ R)) (λ hw, _) (λ hw, _), + refine or.elim (em (‖w‖ ≤ R)) (λ hw, _) (λ hw, _), { exact (hC w (mem_closed_ball_zero_iff.mpr hw)).trans (le_max_left _ _) }, { exact (hR w (not_le.mp hw).le).trans (le_max_right _ _), }, }, /- `resolvent a 0 = 0`, which is a contradition because it isn't a unit. -/ @@ -344,25 +407,60 @@ begin (mem_resolvent_set_iff.mp (H₀.symm ▸ set.mem_univ 0)))), end +/-- In a complex Banach algebra, the spectral radius is always attained by some element of the +spectrum. -/ +lemma exists_nnnorm_eq_spectral_radius : ∃ z ∈ spectrum ℂ a, (‖z‖₊ : ℝ≥0∞) = spectral_radius ℂ a := +exists_nnnorm_eq_spectral_radius_of_nonempty (spectrum.nonempty a) + +/-- In a complex Banach algebra, if every element of the spectrum has norm strictly less than +`r : ℝ≥0`, then the spectral radius is also strictly less than `r`. -/ +lemma spectral_radius_lt_of_forall_lt {r : ℝ≥0} (hr : ∀ z ∈ spectrum ℂ a, ‖z‖₊ < r) : + spectral_radius ℂ a < r := +spectral_radius_lt_of_forall_lt_of_nonempty (spectrum.nonempty a) hr + +open_locale polynomial +open polynomial + +/-- The **spectral mapping theorem** for polynomials in a Banach algebra over `ℂ`. -/ +lemma map_polynomial_aeval (p : ℂ[X]) : + spectrum ℂ (aeval a p) = (λ k, eval k p) '' (spectrum ℂ a) := +map_polynomial_aeval_of_nonempty a p (spectrum.nonempty a) + +/-- A specialization of the spectral mapping theorem for polynomials in a Banach algebra over `ℂ` +to monic monomials. -/ +protected lemma map_pow (n : ℕ) : spectrum ℂ (a ^ n) = (λ x, x ^ n) '' (spectrum ℂ a) := +by simpa only [aeval_X_pow, eval_pow, eval_X] using map_polynomial_aeval a (X ^ n) + +end nonempty_spectrum + section gelfand_mazur_isomorphism -variables [normed_division_ring A] [normed_algebra ℂ A] +variables [normed_ring A] [normed_algebra ℂ A] (hA : ∀ {a : A}, is_unit a ↔ a ≠ 0) +include hA local notation `σ` := spectrum ℂ lemma algebra_map_eq_of_mem {a : A} {z : ℂ} (h : z ∈ σ a) : algebra_map ℂ A z = a := -by rwa [mem_iff, is_unit_iff_ne_zero, not_not, sub_eq_zero] at h +by rwa [mem_iff, hA, not_not, sub_eq_zero] at h /-- **Gelfand-Mazur theorem**: For a complex Banach division algebra, the natural `algebra_map ℂ A` is an algebra isomorphism whose inverse is given by selecting the (unique) element of -`spectrum ℂ a`. In addition, `algebra_map_isometry` guarantees this map is an isometry. -/ +`spectrum ℂ a`. In addition, `algebra_map_isometry` guarantees this map is an isometry. + +Note: because `normed_division_ring` requires the field `norm_mul' : ∀ a b, ‖a * b‖ = ‖a‖ * ‖b‖`, we +don't use this type class and instead opt for a `normed_ring` in which the nonzero elements are +precisely the units. This allows for the application of this isomorphism in broader contexts, e.g., +to the quotient of a complex Banach algebra by a maximal ideal. In the case when `A` is actually a +`normed_division_ring`, one may fill in the argument `hA` with the lemma `is_unit_iff_ne_zero`. -/ @[simps] -noncomputable def _root_.normed_division_ring.alg_equiv_complex_of_complete +noncomputable def _root_.normed_ring.alg_equiv_complex_of_complete [complete_space A] : ℂ ≃ₐ[ℂ] A := +let nt : nontrivial A := ⟨⟨1, 0, hA.mp ⟨⟨1, 1, mul_one _, mul_one _⟩, rfl⟩⟩⟩ in { to_fun := algebra_map ℂ A, - inv_fun := λ a, (spectrum.nonempty a).some, - left_inv := λ z, by simpa only [scalar_eq] using (spectrum.nonempty $ algebra_map ℂ A z).some_mem, - right_inv := λ a, algebra_map_eq_of_mem (spectrum.nonempty a).some_mem, + inv_fun := λ a, (@spectrum.nonempty _ _ _ _ nt a).some, + left_inv := λ z, by simpa only [@scalar_eq _ _ _ _ _ nt _] using + (@spectrum.nonempty _ _ _ _ nt $ algebra_map ℂ A z).some_mem, + right_inv := λ a, algebra_map_eq_of_mem @hA (@spectrum.nonempty _ _ _ _ nt a).some_mem, ..algebra.of_id ℂ A } end gelfand_mazur_isomorphism @@ -380,10 +478,9 @@ begin sub_add_cancel] }, let b := ∑' n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐz) ^ n, have hb : summable (λ n : ℕ, ((n + 1).factorial⁻¹ : 𝕜) • (a - ↑ₐz) ^ n), - { refine summable_of_norm_bounded_eventually _ (real.summable_pow_div_factorial ∥a - ↑ₐz∥) _, + { refine summable_of_norm_bounded_eventually _ (real.summable_pow_div_factorial ‖a - ↑ₐz‖) _, filter_upwards [filter.eventually_cofinite_ne 0] with n hn, - rw [norm_smul, mul_comm, norm_inv, is_R_or_C.norm_eq_abs, is_R_or_C.abs_cast_nat, - ←div_eq_mul_inv], + rw [norm_smul, mul_comm, norm_inv, is_R_or_C.norm_nat_cast, ← div_eq_mul_inv], exact div_le_div (pow_nonneg (norm_nonneg _) n) (norm_pow_le' (a - ↑ₐz) (zero_lt_iff.mpr hn)) (by exact_mod_cast nat.factorial_pos n) (by exact_mod_cast nat.factorial_le (lt_add_one n).le) }, @@ -409,30 +506,68 @@ end spectrum namespace alg_hom section normed_field -variables [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A] +variables {F : Type*} [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A] local notation `↑ₐ` := algebra_map 𝕜 A +/-- An algebra homomorphism into the base field, as a continuous linear map (since it is +automatically bounded). See note [lower instance priority] -/ +@[priority 100] +instance [alg_hom_class F 𝕜 A 𝕜] : continuous_linear_map_class F 𝕜 A 𝕜 := +{ map_continuous := λ φ, add_monoid_hom_class.continuous_of_bound φ ‖(1 : A)‖ $ + λ a, (mul_comm ‖a‖ ‖(1 : A)‖) ▸ spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum φ _), + .. alg_hom_class.linear_map_class } + /-- An algebra homomorphism into the base field, as a continuous linear map (since it is automatically bounded). -/ -@[simps] def to_continuous_linear_map [norm_one_class A] (φ : A →ₐ[𝕜] 𝕜) : A →L[𝕜] 𝕜 := -φ.to_linear_map.mk_continuous_of_exists_bound $ - ⟨1, λ a, (one_mul ∥a∥).symm ▸ spectrum.norm_le_norm_of_mem (φ.apply_mem_spectrum _)⟩ +def to_continuous_linear_map (φ : A →ₐ[𝕜] 𝕜) : A →L[𝕜] 𝕜 := +{ cont := map_continuous φ, .. φ.to_linear_map } -lemma continuous [norm_one_class A] (φ : A →ₐ[𝕜] 𝕜) : continuous φ := -φ.to_continuous_linear_map.continuous +@[simp] lemma coe_to_continuous_linear_map (φ : A →ₐ[𝕜] 𝕜) : + ⇑φ.to_continuous_linear_map = φ := rfl + +lemma norm_apply_le_self_mul_norm_one [alg_hom_class F 𝕜 A 𝕜] (f : F) (a : A) : + ‖f a‖ ≤ ‖a‖ * ‖(1 : A)‖ := +spectrum.norm_le_norm_mul_of_mem (apply_mem_spectrum f _) + +lemma norm_apply_le_self [norm_one_class A] [alg_hom_class F 𝕜 A 𝕜] (f : F) (a : A) : ‖f a‖ ≤ ‖a‖ := +spectrum.norm_le_norm_of_mem (apply_mem_spectrum f _) end normed_field -section nondiscrete_normed_field -variables [nondiscrete_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A] +section nontrivially_normed_field +variables [nontrivially_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A] local notation `↑ₐ` := algebra_map 𝕜 A @[simp] lemma to_continuous_linear_map_norm [norm_one_class A] (φ : A →ₐ[𝕜] 𝕜) : - ∥φ.to_continuous_linear_map∥ = 1 := + ‖φ.to_continuous_linear_map‖ = 1 := continuous_linear_map.op_norm_eq_of_bounds zero_le_one - (λ a, (one_mul ∥a∥).symm ▸ spectrum.norm_le_norm_of_mem (φ.apply_mem_spectrum _)) - (λ _ _ h, by simpa only [to_continuous_linear_map_apply, mul_one, map_one, norm_one] using h 1) + (λ a, (one_mul ‖a‖).symm ▸ spectrum.norm_le_norm_of_mem (apply_mem_spectrum φ _)) + (λ _ _ h, by simpa only [coe_to_continuous_linear_map, map_one, norm_one, mul_one] using h 1) -end nondiscrete_normed_field +end nontrivially_normed_field end alg_hom + +namespace weak_dual + +namespace character_space + +variables [nontrivially_normed_field 𝕜] [normed_ring A] [complete_space A] +variables [normed_algebra 𝕜 A] + +/-- The equivalence between characters and algebra homomorphisms into the base field. -/ +def equiv_alg_hom : (character_space 𝕜 A) ≃ (A →ₐ[𝕜] 𝕜) := +{ to_fun := to_alg_hom, + inv_fun := λ f, + { val := f.to_continuous_linear_map, + property := by { rw eq_set_map_one_map_mul, exact ⟨map_one f, map_mul f⟩ } }, + left_inv := λ f, subtype.ext $ continuous_linear_map.ext $ λ x, rfl, + right_inv := λ f, alg_hom.ext $ λ x, rfl } + +@[simp] lemma equiv_alg_hom_coe (f : character_space 𝕜 A) : ⇑(equiv_alg_hom f) = f := rfl + +@[simp] lemma equiv_alg_hom_symm_coe (f : A →ₐ[𝕜] 𝕜) : ⇑(equiv_alg_hom.symm f) = f := rfl + +end character_space + +end weak_dual diff --git a/src/analysis/normed_space/star/basic.lean b/src/analysis/normed_space/star/basic.lean index 864193d1e9b1d..722dd00fc35c3 100644 --- a/src/analysis/normed_space/star/basic.lean +++ b/src/analysis/normed_space/star/basic.lean @@ -9,14 +9,19 @@ import analysis.normed_space.basic import analysis.normed_space.linear_isometry import algebra.star.self_adjoint import algebra.star.unitary +import topology.algebra.star_subalgebra +import topology.algebra.module.star /-! # Normed star rings and algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A normed star group is a normed group with a compatible `star` which is isometric. A C⋆-ring is a normed star group that is also a ring and that verifies the stronger -condition `∥x⋆ * x∥ = ∥x∥^2` for all `x`. If a C⋆-ring is also a star algebra, then it is a +condition `‖x⋆ * x‖ = ‖x‖^2` for all `x`. If a C⋆-ring is also a star algebra, then it is a C⋆-algebra. To get a C⋆-algebra `E` over field `𝕜`, use @@ -25,18 +30,18 @@ To get a C⋆-algebra `E` over field `𝕜`, use ## TODO -- Show that `∥x⋆ * x∥ = ∥x∥^2` is equivalent to `∥x⋆ * x∥ = ∥x⋆∥ * ∥x∥`, which is used as the +- Show that `‖x⋆ * x‖ = ‖x‖^2` is equivalent to `‖x⋆ * x‖ = ‖x⋆‖ * ‖x‖`, which is used as the definition of C*-algebras in some sources (e.g. Wikipedia). -/ -open_locale topological_space +open_locale topology local postfix `⋆`:std.prec.max_plus := star /-- A normed star group is a normed group with a compatible `star` which is isometric. -/ -class normed_star_group (E : Type*) [semi_normed_group E] [star_add_monoid E] : Prop := -(norm_star : ∀ x : E, ∥x⋆∥ = ∥x∥) +class normed_star_group (E : Type*) [seminormed_add_comm_group E] [star_add_monoid E] : Prop := +(norm_star : ∀ x : E, ‖x⋆‖ = ‖x‖) export normed_star_group (norm_star) attribute [simp] norm_star @@ -44,18 +49,20 @@ attribute [simp] norm_star variables {𝕜 E α : Type*} section normed_star_group -variables [semi_normed_group E] [star_add_monoid E] [normed_star_group E] +variables [seminormed_add_comm_group E] [star_add_monoid E] [normed_star_group E] -@[simp] lemma nnnorm_star (x : E) : ∥star x∥₊ = ∥x∥₊ := subtype.ext $ norm_star _ +@[simp] lemma nnnorm_star (x : E) : ‖star x‖₊ = ‖x‖₊ := subtype.ext $ norm_star _ /-- The `star` map in a normed star group is a normed group homomorphism. -/ -def star_normed_group_hom : normed_group_hom E E := +def star_normed_add_group_hom : normed_add_group_hom E E := { bound' := ⟨1, λ v, le_trans (norm_star _).le (one_mul _).symm.le⟩, .. star_add_equiv } /-- The `star` map in a normed star group is an isometry -/ lemma star_isometry : isometry (star : E → E) := -star_add_equiv.to_add_monoid_hom.isometry_of_norm norm_star +show isometry star_add_equiv, +by exact add_monoid_hom_class.isometry_of_norm star_add_equiv + (show ∀ x, ‖x⋆‖ = ‖x‖, from norm_star) @[priority 100] instance normed_star_group.to_has_continuous_star : has_continuous_star E := @@ -67,10 +74,10 @@ instance ring_hom_isometric.star_ring_end [normed_comm_ring E] [star_ring E] [normed_star_group E] : ring_hom_isometric (star_ring_end E) := ⟨norm_star⟩ -/-- A C*-ring is a normed star ring that satifies the stronger condition `∥x⋆ * x∥ = ∥x∥^2` +/-- A C*-ring is a normed star ring that satifies the stronger condition `‖x⋆ * x‖ = ‖x‖^2` for every `x`. -/ class cstar_ring (E : Type*) [non_unital_normed_ring E] [star_ring E] : Prop := -(norm_star_mul_self : ∀ {x : E}, ∥x⋆ * x∥ = ∥x∥ * ∥x∥) +(norm_star_mul_self : ∀ {x : E}, ‖x⋆ * x‖ = ‖x‖ * ‖x‖) instance : cstar_ring ℝ := { norm_star_mul_self := λ x, by simp only [star, id.def, norm_mul] } @@ -87,81 +94,139 @@ instance to_normed_star_group : normed_star_group E := intro x, by_cases htriv : x = 0, { simp only [htriv, star_zero] }, - { have hnt : 0 < ∥x∥ := norm_pos_iff.mpr htriv, - have hnt_star : 0 < ∥x⋆∥ := + { have hnt : 0 < ‖x‖ := norm_pos_iff.mpr htriv, + have hnt_star : 0 < ‖x⋆‖ := norm_pos_iff.mpr ((add_equiv.map_ne_zero_iff star_add_equiv).mpr htriv), have h₁ := calc - ∥x∥ * ∥x∥ = ∥x⋆ * x∥ : norm_star_mul_self.symm - ... ≤ ∥x⋆∥ * ∥x∥ : norm_mul_le _ _, + ‖x‖ * ‖x‖ = ‖x⋆ * x‖ : norm_star_mul_self.symm + ... ≤ ‖x⋆‖ * ‖x‖ : norm_mul_le _ _, have h₂ := calc - ∥x⋆∥ * ∥x⋆∥ = ∥x * x⋆∥ : by rw [←norm_star_mul_self, star_star] - ... ≤ ∥x∥ * ∥x⋆∥ : norm_mul_le _ _, + ‖x⋆‖ * ‖x⋆‖ = ‖x * x⋆‖ : by rw [←norm_star_mul_self, star_star] + ... ≤ ‖x‖ * ‖x⋆‖ : norm_mul_le _ _, exact le_antisymm (le_of_mul_le_mul_right h₂ hnt_star) (le_of_mul_le_mul_right h₁ hnt) }, end⟩ -lemma norm_self_mul_star {x : E} : ∥x * x⋆∥ = ∥x∥ * ∥x∥ := +lemma norm_self_mul_star {x : E} : ‖x * x⋆‖ = ‖x‖ * ‖x‖ := by { nth_rewrite 0 [←star_star x], simp only [norm_star_mul_self, norm_star] } -lemma norm_star_mul_self' {x : E} : ∥x⋆ * x∥ = ∥x⋆∥ * ∥x∥ := +lemma norm_star_mul_self' {x : E} : ‖x⋆ * x‖ = ‖x⋆‖ * ‖x‖ := by rw [norm_star_mul_self, norm_star] -lemma nnnorm_star_mul_self {x : E} : ∥x⋆ * x∥₊ = ∥x∥₊ * ∥x∥₊ := +lemma nnnorm_self_mul_star {x : E} : ‖x * star x‖₊ = ‖x‖₊ * ‖x‖₊ := +subtype.ext norm_self_mul_star + +lemma nnnorm_star_mul_self {x : E} : ‖x⋆ * x‖₊ = ‖x‖₊ * ‖x‖₊ := subtype.ext norm_star_mul_self +@[simp] +lemma star_mul_self_eq_zero_iff (x : E) : star x * x = 0 ↔ x = 0 := +by { rw [←norm_eq_zero, norm_star_mul_self], exact mul_self_eq_zero.trans norm_eq_zero } + +lemma star_mul_self_ne_zero_iff (x : E) : star x * x ≠ 0 ↔ x ≠ 0 := +by simp only [ne.def, star_mul_self_eq_zero_iff] + +@[simp] +lemma mul_star_self_eq_zero_iff (x : E) : x * star x = 0 ↔ x = 0 := +by simpa only [star_eq_zero, star_star] using @star_mul_self_eq_zero_iff _ _ _ _ (star x) + +lemma mul_star_self_ne_zero_iff (x : E) : x * star x ≠ 0 ↔ x ≠ 0 := +by simp only [ne.def, mul_star_self_eq_zero_iff] + end non_unital +section prod_pi + +variables {ι R₁ R₂ : Type*} {R : ι → Type*} +variables [non_unital_normed_ring R₁] [star_ring R₁] [cstar_ring R₁] +variables [non_unital_normed_ring R₂] [star_ring R₂] [cstar_ring R₂] +variables [Π i, non_unital_normed_ring (R i)] [Π i, star_ring (R i)] + +/-- This instance exists to short circuit type class resolution because of problems with +inference involving Π-types. -/ +instance _root_.pi.star_ring' : star_ring (Π i, R i) := infer_instance + +variables [fintype ι] [Π i, cstar_ring (R i)] + +instance _root_.prod.cstar_ring : cstar_ring (R₁ × R₂) := +{ norm_star_mul_self := λ x, + begin + unfold norm, + simp only [prod.fst_mul, prod.fst_star, prod.snd_mul, prod.snd_star, norm_star_mul_self, ←sq], + refine le_antisymm _ _, + { refine max_le _ _; + rw [sq_le_sq, abs_of_nonneg (norm_nonneg _)], + exact (le_max_left _ _).trans (le_abs_self _), + exact (le_max_right _ _).trans (le_abs_self _) }, + { rw le_sup_iff, + rcases le_total (‖x.fst‖) (‖x.snd‖) with (h | h); + simp [h] } + end } + +instance _root_.pi.cstar_ring : cstar_ring (Π i, R i) := +{ norm_star_mul_self := λ x, + begin + simp only [norm, pi.mul_apply, pi.star_apply, nnnorm_star_mul_self, ←sq], + norm_cast, + exact (finset.comp_sup_eq_sup_comp_of_is_total (λ x : nnreal, x ^ 2) + (λ x y h, by simpa only [sq] using mul_le_mul' h h) (by simp)).symm, + end } + +instance _root_.pi.cstar_ring' : cstar_ring (ι → R₁) := pi.cstar_ring + +end prod_pi + section unital variables [normed_ring E] [star_ring E] [cstar_ring E] -@[simp] lemma norm_one [nontrivial E] : ∥(1 : E)∥ = 1 := +@[simp] lemma norm_one [nontrivial E] : ‖(1 : E)‖ = 1 := begin - have : 0 < ∥(1 : E)∥ := norm_pos_iff.mpr one_ne_zero, + have : 0 < ‖(1 : E)‖ := norm_pos_iff.mpr one_ne_zero, rw [←mul_left_inj' this.ne', ←norm_star_mul_self, mul_one, star_one, one_mul], end @[priority 100] -- see Note [lower instance priority] instance [nontrivial E] : norm_one_class E := ⟨norm_one⟩ -lemma norm_coe_unitary [nontrivial E] (U : unitary E) : ∥(U : E)∥ = 1 := +lemma norm_coe_unitary [nontrivial E] (U : unitary E) : ‖(U : E)‖ = 1 := begin rw [←sq_eq_sq (norm_nonneg _) zero_le_one, one_pow 2, sq, ←cstar_ring.norm_star_mul_self, unitary.coe_star_mul_self, cstar_ring.norm_one], end -@[simp] lemma norm_of_mem_unitary [nontrivial E] {U : E} (hU : U ∈ unitary E) : ∥U∥ = 1 := +@[simp] lemma norm_of_mem_unitary [nontrivial E] {U : E} (hU : U ∈ unitary E) : ‖U‖ = 1 := norm_coe_unitary ⟨U, hU⟩ -@[simp] lemma norm_coe_unitary_mul (U : unitary E) (A : E) : ∥(U : E) * A∥ = ∥A∥ := +@[simp] lemma norm_coe_unitary_mul (U : unitary E) (A : E) : ‖(U : E) * A‖ = ‖A‖ := begin nontriviality E, refine le_antisymm _ _, - { calc _ ≤ ∥(U : E)∥ * ∥A∥ : norm_mul_le _ _ - ... = ∥A∥ : by rw [norm_coe_unitary, one_mul] }, - { calc _ = ∥(U : E)⋆ * U * A∥ : by rw [unitary.coe_star_mul_self U, one_mul] - ... ≤ ∥(U : E)⋆∥ * ∥(U : E) * A∥ : by { rw [mul_assoc], exact norm_mul_le _ _ } - ... = ∥(U : E) * A∥ : by rw [norm_star, norm_coe_unitary, one_mul] }, + { calc _ ≤ ‖(U : E)‖ * ‖A‖ : norm_mul_le _ _ + ... = ‖A‖ : by rw [norm_coe_unitary, one_mul] }, + { calc _ = ‖(U : E)⋆ * U * A‖ : by rw [unitary.coe_star_mul_self U, one_mul] + ... ≤ ‖(U : E)⋆‖ * ‖(U : E) * A‖ : by { rw [mul_assoc], exact norm_mul_le _ _ } + ... = ‖(U : E) * A‖ : by rw [norm_star, norm_coe_unitary, one_mul] }, end -@[simp] lemma norm_unitary_smul (U : unitary E) (A : E) : ∥U • A∥ = ∥A∥ := +@[simp] lemma norm_unitary_smul (U : unitary E) (A : E) : ‖U • A‖ = ‖A‖ := norm_coe_unitary_mul U A -lemma norm_mem_unitary_mul {U : E} (A : E) (hU : U ∈ unitary E) : ∥U * A∥ = ∥A∥ := +lemma norm_mem_unitary_mul {U : E} (A : E) (hU : U ∈ unitary E) : ‖U * A‖ = ‖A‖ := norm_coe_unitary_mul ⟨U, hU⟩ A -@[simp] lemma norm_mul_coe_unitary (A : E) (U : unitary E) : ∥A * U∥ = ∥A∥ := -calc _ = ∥((U : E)⋆ * A⋆)⋆∥ : by simp only [star_star, star_mul] - ... = ∥(U : E)⋆ * A⋆∥ : by rw [norm_star] - ... = ∥A⋆∥ : norm_mem_unitary_mul (star A) (unitary.star_mem U.prop) - ... = ∥A∥ : norm_star _ +@[simp] lemma norm_mul_coe_unitary (A : E) (U : unitary E) : ‖A * U‖ = ‖A‖ := +calc _ = ‖((U : E)⋆ * A⋆)⋆‖ : by simp only [star_star, star_mul] + ... = ‖(U : E)⋆ * A⋆‖ : by rw [norm_star] + ... = ‖A⋆‖ : norm_mem_unitary_mul (star A) (unitary.star_mem U.prop) + ... = ‖A‖ : norm_star _ -lemma norm_mul_mem_unitary (A : E) {U : E} (hU : U ∈ unitary E) : ∥A * U∥ = ∥A∥ := +lemma norm_mul_mem_unitary (A : E) {U : E} (hU : U ∈ unitary E) : ‖A * U‖ = ‖A‖ := norm_mul_coe_unitary A ⟨U, hU⟩ end unital end cstar_ring -lemma nnnorm_pow_two_pow_of_self_adjoint [normed_ring E] [star_ring E] [cstar_ring E] - {x : E} (hx : x ∈ self_adjoint E) (n : ℕ) : ∥x ^ 2 ^ n∥₊ = ∥x∥₊ ^ (2 ^ n) := +lemma is_self_adjoint.nnnorm_pow_two_pow [normed_ring E] [star_ring E] + [cstar_ring E] {x : E} (hx : is_self_adjoint x) (n : ℕ) : ‖x ^ 2 ^ n‖₊ = ‖x‖₊ ^ (2 ^ n) := begin induction n with k hk, { simp only [pow_zero, pow_one] }, @@ -171,12 +236,13 @@ begin end lemma self_adjoint.nnnorm_pow_two_pow [normed_ring E] [star_ring E] [cstar_ring E] - (x : self_adjoint E) (n : ℕ) : ∥x ^ 2 ^ n∥₊ = ∥x∥₊ ^ (2 ^ n) := -nnnorm_pow_two_pow_of_self_adjoint x.property _ + (x : self_adjoint E) (n : ℕ) : ‖x ^ 2 ^ n‖₊ = ‖x‖₊ ^ (2 ^ n) := +x.prop.nnnorm_pow_two_pow _ section starₗᵢ -variables [comm_semiring 𝕜] [star_ring 𝕜] [normed_ring E] [star_ring E] [normed_star_group E] +variables [comm_semiring 𝕜] [star_ring 𝕜] +variables [seminormed_add_comm_group E] [star_add_monoid E] [normed_star_group E] variables [module 𝕜 E] [star_module 𝕜 E] variables (𝕜) @@ -192,4 +258,22 @@ variables {𝕜} lemma starₗᵢ_apply {x : E} : starₗᵢ 𝕜 x = star x := rfl +@[simp] lemma starₗᵢ_to_continuous_linear_equiv : + (starₗᵢ 𝕜 : E ≃ₗᵢ⋆[𝕜] E).to_continuous_linear_equiv = (starL 𝕜 : E ≃L⋆[𝕜] E) := +continuous_linear_equiv.ext rfl + end starₗᵢ + +namespace star_subalgebra + +instance to_normed_algebra {𝕜 A : Type*} [normed_field 𝕜] [star_ring 𝕜] + [semi_normed_ring A] [star_ring A] [normed_algebra 𝕜 A] [star_module 𝕜 A] + (S : star_subalgebra 𝕜 A) : normed_algebra 𝕜 S := +@normed_algebra.induced _ 𝕜 S A _ (subring_class.to_ring S) S.algebra _ _ _ S.subtype + +instance to_cstar_ring {R A} [comm_ring R] [star_ring R] [normed_ring A] + [star_ring A] [cstar_ring A] [algebra R A] [star_module R A] (S : star_subalgebra R A) : + cstar_ring S := +{ norm_star_mul_self := λ x, @cstar_ring.norm_star_mul_self A _ _ _ x } + +end star_subalgebra diff --git a/src/analysis/normed_space/star/complex.lean b/src/analysis/normed_space/star/complex.lean deleted file mode 100644 index 512dd0d99440f..0000000000000 --- a/src/analysis/normed_space/star/complex.lean +++ /dev/null @@ -1,59 +0,0 @@ -/- -Copyright (c) 2022 Frédéric Dupuis. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Frédéric Dupuis --/ - -import analysis.normed_space.star.basic -import algebra.star.module -import analysis.complex.basic - -/-! -# Complex normed star modules and algebras - -Facts about star modules and star algebras over the complex numbers. - -## Main definitions - -* `star_module.mul_neg_I_lin`: multiplication by -I as a real-linear equivalence between the - skew-adjoint and self-adjoint elements of a star module. -* `star_module.im`: the imaginary part of an element of a star module, defined via - `skew_adjoint_part`. - --/ - -variables {E : Type*} - -namespace star_module -open_locale complex_conjugate -open complex - -variables [add_comm_group E] [star_add_monoid E] [module ℂ E] [star_module ℂ E] - -/-- Multiplication by -I as a real-linear equivalence between the skew-adjoint and self-adjoint -elements of a star module. -/ -@[simps] def mul_neg_I_lin : skew_adjoint E ≃ₗ[ℝ] self_adjoint E := -{ to_fun := λ x, ⟨-I • x, by simp [self_adjoint.mem_iff]⟩, - inv_fun := λ x, ⟨I • x, by simp [skew_adjoint.mem_iff]⟩, - map_add' := λ x y, by { ext, simp only [add_subgroup.coe_add, smul_add, add_subgroup.coe_mk] }, - map_smul' := λ r x, by { ext, simp only [neg_smul, neg_inj, skew_adjoint.coe_smul, - add_subgroup.coe_mk, ring_hom.id_apply, self_adjoint.coe_smul, smul_neg, smul_comm I], }, - left_inv := λ x, by simp only [neg_smul, add_subgroup.coe_mk, smul_neg, ←mul_smul, I_mul_I, - neg_neg, one_smul, set_like.eta], - right_inv := λ x, by simp only [←mul_smul, I_mul_I, add_subgroup.coe_mk, neg_mul, neg_neg, - one_smul, set_like.eta] } - -/-- The imaginary part of an element of a star module, as a real-linear map. -/ -@[simps] noncomputable def im : E →ₗ[ℝ] self_adjoint E := - mul_neg_I_lin.to_linear_map.comp (skew_adjoint_part ℝ) - -/-- The real part of an element of a star module, as a real-linear map. This is simply an -abbreviation for `self_adjoint_part ℝ`. -/ -@[simps] noncomputable abbreviation re : E →ₗ[ℝ] self_adjoint E := self_adjoint_part ℝ - -/-- An element of a complex star module can be decomposed into self-adjoint "real" and -"imaginary" parts -/ -lemma re_add_im (x : E) : (re x : E) + I • im x = x := -by simp [←mul_smul, I_mul_I, ←smul_add, ←two_smul ℝ] - -end star_module diff --git a/src/analysis/normed_space/star/continuous_functional_calculus.lean b/src/analysis/normed_space/star/continuous_functional_calculus.lean new file mode 100644 index 0000000000000..98f628a932ced --- /dev/null +++ b/src/analysis/normed_space/star/continuous_functional_calculus.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2022 Jireh Loreaux. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jireh Loreaux +-/ + +import analysis.normed_space.star.gelfand_duality +import topology.algebra.star_subalgebra + +/-! # Continuous functional calculus + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we construct the `continuous_functional_calculus` for a normal element `a` of a +(unital) C⋆-algebra over `ℂ`. This is a star algebra equivalence +`C(spectrum ℂ a, ℂ) ≃⋆ₐ[ℂ] elemental_star_algebra ℂ a` which sends the (restriction of) the +identity map `continuous_map.id ℂ` to the (unique) preimage of `a` under the coercion of +`elemental_star_algebra ℂ a` to `A`. + +Being a star algebra equivalence between C⋆-algebras, this map is continuous (even an isometry), +and by the Stone-Weierstrass theorem it is the unique star algebra equivalence which extends the +polynomial functional calculus (i.e., `polynomial.aeval`). + +For any continuous function `f : spectrum ℂ a → ℂ`, this makes it possible to define an element +`f a` (not valid notation) in the original algebra, which heuristically has the same eigenspaces as +`a` and acts on eigenvector of `a` for an eigenvalue `λ` as multiplication by `f λ`. This +description is perfectly accurate in finite dimension, but only heuristic in infinite dimension as +there might be no genuine eigenvector. In particular, when `f` is a polynomial `∑ cᵢ Xⁱ`, then +`f a` is `∑ cᵢ aⁱ`. Also, `id a = a`. + +This file also includes a proof of the **spectral permanence** theorem for (unital) C⋆-algebras +(see `star_subalgebra.spectrum_eq`) + +## Main definitions + +* `continuous_functional_calculus : C(spectrum ℂ a, ℂ) ≃⋆ₐ[ℂ] elemental_star_algebra ℂ a`: this + is the composition of the inverse of the `gelfand_star_transform` with the natural isomorphism + induced by the homeomorphism `elemental_star_algebra.character_space_homeo`. +* `elemental_star_algebra.character_space_homeo : + `character_space ℂ (elemental_star_algebra ℂ a) ≃ₜ spectrum ℂ a`: this homeomorphism is defined + by evaluating a character `φ` at `a`, and noting that `φ a ∈ spectrum ℂ a` since `φ` is an + algebra homomorphism. Moreover, this map is continuous and bijective and since the spaces involved + are compact Hausdorff, it is a homeomorphism. + +## Main statements + +* `star_subalgebra.coe_is_unit`: for `x : S` in a C⋆-subalgebra `S` of `A`, then `↑x : A` is a unit + if and only if `x` is a unit. +* `star_subalgebra.spectrum_eq`: **spectral_permanence** for `x : S`, where `S` is a C⋆-subalgebra + of `A`, `spectrum ℂ x = spectrum ℂ (x : A)`. + +## Notes + +The result we have established here is the strongest possible, but it is likely not the version +which will be most useful in practice. Future work will include developing an appropriate API for +the continuous functional calculus (including one for real-valued functions with real argument that +applies to self-adjoint elements of the algebra). -/ + +open_locale pointwise ennreal nnreal complex_order + +open weak_dual weak_dual.character_space elemental_star_algebra + +variables {A : Type*} [normed_ring A] [normed_algebra ℂ A] +variables [star_ring A] [cstar_ring A] [star_module ℂ A] + +instance {R A : Type*} [comm_ring R] [star_ring R] [normed_ring A] [algebra R A] [star_ring A] + [has_continuous_star A] [star_module R A] (a : A) [is_star_normal a] : + normed_comm_ring (elemental_star_algebra R a) := +{ mul_comm := mul_comm, .. subring_class.to_normed_ring (elemental_star_algebra R a) } + +instance {R A : Type*} [normed_field R] [star_ring R] [normed_ring A] [normed_algebra R A] + [star_ring A] [has_continuous_star A] [star_module R A] (a : A) : + normed_algebra R (elemental_star_algebra R a) := +star_subalgebra.to_normed_algebra (elemental_star_algebra R a) + +instance {R A : Type*} [normed_field R] [star_ring R] [normed_ring A] [normed_algebra R A] + [star_ring A] [has_continuous_star A] [star_module R A] (a : A) : + normed_space R (elemental_star_algebra R a) := +normed_algebra.to_normed_space _ + +-- without this instance type class search causes timeouts +noncomputable instance elemental_star_algebra.complex.normed_algebra (a : A) : + normed_algebra ℂ (elemental_star_algebra ℂ a) := +infer_instance + +variables [complete_space A] (a : A) [is_star_normal a] (S : star_subalgebra ℂ A) + +/-- This lemma is used in the proof of `star_subalgebra.is_unit_of_is_unit_of_is_star_normal`, +which in turn is the key to spectral permanence `star_subalgebra.spectrum_eq`, which is itself +necessary for the continuous functional calculus. Using the continuous functional calculus, this +lemma can be superseded by one that omits the `is_star_normal` hypothesis. -/ +lemma spectrum_star_mul_self_of_is_star_normal : + spectrum ℂ (star a * a) ⊆ set.Icc (0 : ℂ) (‖star a * a‖) := +begin + -- this instance should be found automatically, but without providing it Lean goes on a wild + -- goose chase when trying to apply `spectrum.gelfand_transform_eq`. + letI := elemental_star_algebra.complex.normed_algebra a, + unfreezingI { rcases subsingleton_or_nontrivial A }, + { simp only [spectrum.of_subsingleton, set.empty_subset] }, + { set a' : elemental_star_algebra ℂ a := ⟨a, self_mem ℂ a⟩, + refine (spectrum.subset_star_subalgebra (star a' * a')).trans _, + rw [←spectrum.gelfand_transform_eq (star a' * a'), continuous_map.spectrum_eq_range], + rintro - ⟨φ, rfl⟩, + rw [gelfand_transform_apply_apply ℂ _ (star a' * a') φ, map_mul φ, map_star φ], + rw [complex.eq_coe_norm_of_nonneg (star_mul_self_nonneg _), ←map_star, ←map_mul], + exact ⟨complex.zero_le_real.2 (norm_nonneg _), + complex.real_le_real.2 (alg_hom.norm_apply_le_self φ (star a' * a'))⟩, } +end + +variables {a} + +/-- This is the key lemma on the way to establishing spectral permanence for C⋆-algebras, which is +established in `star_subalgebra.spectrum_eq`. This lemma is superseded by +`star_subalgebra.coe_is_unit`, which does not require an `is_star_normal` hypothesis and holds for +any closed star subalgebra. -/ +lemma elemental_star_algebra.is_unit_of_is_unit_of_is_star_normal (h : is_unit a) : + is_unit (⟨a, self_mem ℂ a⟩ : elemental_star_algebra ℂ a) := +begin + /- Sketch of proof: Because `a` is normal, it suffices to prove that `star a * a` is invertible + in `elemental_star_algebra ℂ a`. For this it suffices to prove that it is sufficiently close to a + unit, namely `algebra_map ℂ _ ‖star a * a‖`, and in this case the required distance is + `‖star a * a‖`. So one must show `‖star a * a - algebra_map ℂ _ ‖star a * a‖‖ < ‖star a * a‖`. + Since `star a * a - algebra_map ℂ _ ‖star a * a‖` is selfadjoint, by a corollary of Gelfand's + formula for the spectral radius (`is_self_adjoint.spectral_radius_eq_nnnorm`) its norm is the + supremum of the norms of elements in its spectrum (we may use the spectrum in `A` here because + the norm in `A` and the norm in the subalgebra coincide). + + By `spectrum_star_mul_self_of_is_star_normal`, the spectrum (in the algebra `A`) of `star a * a` + is contained in the interval `[0, ‖star a * a‖]`, and since `a` (and hence `star a * a`) is + invertible in `A`, we may omit `0` from this interval. Therefore, by basic spectral mapping + properties, the spectrum (in the algebra `A`) of `star a * a - algebra_map ℂ _ ‖star a * a‖` is + contained in `[0, ‖star a * a‖)`. The supremum of the (norms of) elements of the spectrum must be + *strictly* less that `‖star a * a‖` because the spectrum is compact, which completes the proof. -/ + + /- We may assume `A` is nontrivial. It suffices to show that `star a * a` is invertible in the + commutative (because `a` is normal) ring `elemental_star_algebra ℂ a`. Indeed, by commutativity, + if `star a * a` is invertible, then so is `a`. -/ + nontriviality A, + set a' : elemental_star_algebra ℂ a := ⟨a, self_mem ℂ a⟩, + suffices : is_unit (star a' * a'), from (is_unit.mul_iff.1 this).2, + replace h := (show commute (star a) a, from star_comm_self' a).is_unit_mul_iff.2 ⟨h.star, h⟩, + /- Since `a` is invertible, `‖star a * a‖ ≠ 0`, so `‖star a * a‖ • 1` is invertible in + `elemental_star_algebra ℂ a`, and so it suffices to show that the distance between this unit and + `star a * a` is less than `‖star a * a‖`. -/ + have h₁ : (‖star a * a‖ : ℂ) ≠ 0 := complex.of_real_ne_zero.mpr (norm_ne_zero_iff.mpr h.ne_zero), + set u : units (elemental_star_algebra ℂ a) := + units.map (algebra_map ℂ (elemental_star_algebra ℂ a)).to_monoid_hom (units.mk0 _ h₁), + refine ⟨u.unit_of_nearby _ _, rfl⟩, + simp only [complex.abs_of_real, map_inv₀, units.coe_map, units.coe_inv, ring_hom.coe_monoid_hom, + ring_hom.to_monoid_hom_eq_coe, units.coe_mk0, units.coe_map_inv, norm_algebra_map', + inv_inv, complex.norm_eq_abs, abs_norm, subtype.val_eq_coe, coe_coe], + /- Since `a` is invertible, by `spectrum_star_mul_self_of_is_star_normal`, the spectrum (in `A`) + of `star a * a` is contained in the half-open interval `(0, ‖star a * a‖]`. Therefore, by basic + spectral mapping properties, the spectrum of `‖star a * a‖ • 1 - star a * a` is contained in + `[0, ‖star a * a‖)`. -/ + have h₂ : ∀ z ∈ spectrum ℂ (algebra_map ℂ A (‖star a * a‖) - star a * a), ‖z‖₊ < ‖star a * a‖₊, + { intros z hz, + rw [←spectrum.singleton_sub_eq, set.singleton_sub] at hz, + have h₃ : z ∈ set.Icc (0 : ℂ) (‖star a * a‖), + { replace hz := set.image_subset _ (spectrum_star_mul_self_of_is_star_normal a) hz, + rwa [set.image_const_sub_Icc, sub_self, sub_zero] at hz }, + refine lt_of_le_of_ne (complex.real_le_real.1 $ complex.eq_coe_norm_of_nonneg h₃.1 ▸ h₃.2) _, + { intros hz', + replace hz' := congr_arg (λ (x : ℝ≥0), ((x : ℝ) : ℂ)) hz', + simp only [coe_nnnorm] at hz', + rw ←complex.eq_coe_norm_of_nonneg h₃.1 at hz', + obtain ⟨w, hw₁, hw₂⟩ := hz, + refine (spectrum.zero_not_mem_iff ℂ).mpr h _, + rw [hz', sub_eq_self] at hw₂, + rwa hw₂ at hw₁ } }, + /- The norm of `‖star a * a‖ • 1 - star a * a` in the subalgebra and in `A` coincide. In `A`, + because this element is selfadjoint, by `is_self_adjoint.spectral_radius_eq_nnnorm`, its norm is + the supremum of the norms of the elements of the spectrum, which is strictly less than + `‖star a * a‖` by `h₂` and because the spectrum is compact. -/ + exact ennreal.coe_lt_coe.1 + (calc (‖star a' * a' - algebra_map ℂ _ (‖star a * a‖)‖₊ : ℝ≥0∞) + = ‖algebra_map ℂ A (‖star a * a‖) - star a * a‖₊ : by { rw [←nnnorm_neg, neg_sub], refl } + ... = spectral_radius ℂ (algebra_map ℂ A (‖star a * a‖) - star a * a) + : begin + refine (is_self_adjoint.spectral_radius_eq_nnnorm _).symm, + rw [is_self_adjoint, star_sub, star_mul, star_star, ←algebra_map_star_comm, + is_R_or_C.star_def, is_R_or_C.conj_of_real], + end + ... < ‖star a * a‖₊ : spectrum.spectral_radius_lt_of_forall_lt _ h₂ ), +end + +/-- For `x : A` which is invertible in `A`, the inverse lies in any unital C⋆-subalgebra `S` +containing `x`. -/ +lemma star_subalgebra.is_unit_coe_inv_mem {S : star_subalgebra ℂ A} (hS : is_closed (S : set A)) + {x : A} (h : is_unit x) (hxS : x ∈ S) : ↑h.unit⁻¹ ∈ S := +begin + have hx := h.star.mul h, + suffices this : (↑hx.unit⁻¹ : A) ∈ S, + { rw [←one_mul (↑h.unit⁻¹ : A), ←hx.unit.inv_mul, mul_assoc, is_unit.unit_spec, mul_assoc, + h.mul_coe_inv, mul_one], + exact mul_mem this (star_mem hxS) }, + refine le_of_is_closed_of_mem ℂ hS (mul_mem (star_mem hxS) hxS) _, + haveI := (is_self_adjoint.star_mul_self x).is_star_normal, + have hx' := elemental_star_algebra.is_unit_of_is_unit_of_is_star_normal hx, + convert (↑hx'.unit⁻¹ : elemental_star_algebra ℂ (star x * x)).prop using 1, + exact left_inv_eq_right_inv hx.unit.inv_mul (congr_arg coe hx'.unit.mul_inv), +end + +/-- For a unital C⋆-subalgebra `S` of `A` and `x : S`, if `↑x : A` is invertible in `A`, then +`x` is invertible in `S`. -/ +lemma star_subalgebra.coe_is_unit {S : star_subalgebra ℂ A} (hS : is_closed (S : set A)) {x : S} : + is_unit (x : A) ↔ is_unit x := +begin + refine ⟨λ hx, ⟨⟨x, ⟨(↑hx.unit⁻¹ : A), star_subalgebra.is_unit_coe_inv_mem hS hx x.prop⟩, _, _⟩, + rfl⟩, λ hx, hx.map S.subtype⟩, + exacts [subtype.coe_injective hx.mul_coe_inv, subtype.coe_injective hx.coe_inv_mul], +end + +lemma star_subalgebra.mem_spectrum_iff {S : star_subalgebra ℂ A} (hS : is_closed (S : set A)) + {x : S} {z : ℂ} : z ∈ spectrum ℂ x ↔ z ∈ spectrum ℂ (x : A) := +not_iff_not.2 (star_subalgebra.coe_is_unit hS).symm + +/-- **Spectral permanence.** The spectrum of an element is invariant of the (closed) +`star_subalgebra` in which it is contained. -/ +lemma star_subalgebra.spectrum_eq {S : star_subalgebra ℂ A} (hS : is_closed (S : set A)) (x : S) : + spectrum ℂ x = spectrum ℂ (x : A) := +set.ext $ λ z, star_subalgebra.mem_spectrum_iff hS + +variables (a) + +/-- The natural map from `character_space ℂ (elemental_star_algebra ℂ x)` to `spectrum ℂ x` given +by evaluating `φ` at `x`. This is essentially just evaluation of the `gelfand_transform` of `x`, +but because we want something in `spectrum ℂ x`, as opposed to +`spectrum ℂ ⟨x, elemental_star_algebra.self_mem ℂ x⟩` there is slightly more work to do. -/ +@[simps] +noncomputable def elemental_star_algebra.character_space_to_spectrum (x : A) + (φ : character_space ℂ (elemental_star_algebra ℂ x)) : spectrum ℂ x := +{ val := φ ⟨x, self_mem ℂ x⟩, + property := by simpa only [star_subalgebra.spectrum_eq (elemental_star_algebra.is_closed ℂ x) + ⟨x, self_mem ℂ x⟩] using alg_hom.apply_mem_spectrum φ (⟨x, self_mem ℂ x⟩) } + +lemma elemental_star_algebra.continuous_character_space_to_spectrum (x : A) : + continuous (elemental_star_algebra.character_space_to_spectrum x) := +continuous_induced_rng.2 + (map_continuous $ gelfand_transform ℂ (elemental_star_algebra ℂ x) ⟨x, self_mem ℂ x⟩) + +lemma elemental_star_algebra.bijective_character_space_to_spectrum : + function.bijective (elemental_star_algebra.character_space_to_spectrum a) := +begin + refine ⟨λ φ ψ h, star_alg_hom_class_ext ℂ (map_continuous φ) (map_continuous ψ) + (by simpa only [elemental_star_algebra.character_space_to_spectrum, subtype.mk_eq_mk, + continuous_map.coe_mk] using h), _⟩, + rintros ⟨z, hz⟩, + have hz' := (star_subalgebra.spectrum_eq (elemental_star_algebra.is_closed ℂ a) + ⟨a, self_mem ℂ a⟩).symm.subst hz, + rw character_space.mem_spectrum_iff_exists at hz', + obtain ⟨φ, rfl⟩ := hz', + exact ⟨φ, rfl⟩, +end + +/-- The homeomorphism between the character space of the unital C⋆-subalgebra generated by a +single normal element `a : A` and `spectrum ℂ a`. -/ +noncomputable def elemental_star_algebra.character_space_homeo : + character_space ℂ (elemental_star_algebra ℂ a) ≃ₜ spectrum ℂ a := +@continuous.homeo_of_equiv_compact_to_t2 _ _ _ _ _ _ + (equiv.of_bijective (elemental_star_algebra.character_space_to_spectrum a) + (elemental_star_algebra.bijective_character_space_to_spectrum a)) + (elemental_star_algebra.continuous_character_space_to_spectrum a) + +/-- **Continuous functional calculus.** Given a normal element `a : A` of a unital C⋆-algebra, +the continuous functional calculus is a `star_alg_equiv` from the complex-valued continuous +functions on the spectrum of `a` to the unital C⋆-subalgebra generated by `a`. Moreover, this +equivalence identifies `(continuous_map.id ℂ).restrict (spectrum ℂ a))` with `a`; see +`continuous_functional_calculus_map_id`. As such it extends the polynomial functional calculus. -/ +noncomputable def continuous_functional_calculus : + C(spectrum ℂ a, ℂ) ≃⋆ₐ[ℂ] elemental_star_algebra ℂ a := +((elemental_star_algebra.character_space_homeo a).comp_star_alg_equiv' ℂ ℂ).trans + (gelfand_star_transform (elemental_star_algebra ℂ a)).symm + +lemma continuous_functional_calculus_map_id : + continuous_functional_calculus a ((continuous_map.id ℂ).restrict (spectrum ℂ a)) = + ⟨a, self_mem ℂ a⟩ := +star_alg_equiv.symm_apply_apply _ _ diff --git a/src/analysis/normed_space/star/exponential.lean b/src/analysis/normed_space/star/exponential.lean index f7a147543e781..1c07409b88ab5 100644 --- a/src/analysis/normed_space/star/exponential.lean +++ b/src/analysis/normed_space/star/exponential.lean @@ -3,11 +3,12 @@ Copyright (c) 2022 Jireh Loreaux. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jireh Loreaux -/ -import analysis.normed_space.star.basic -import algebra.star.module -import analysis.special_functions.exponential +import analysis.normed_space.exponential /-! # The exponential map from selfadjoint to unitary + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. In this file, we establish various propreties related to the map `λ a, exp ℂ A (I • a)` between the subtypes `self_adjoint A` and `unitary A`. @@ -28,21 +29,11 @@ variables {A : Type*} open complex -lemma self_adjoint.exp_i_smul_unitary {a : A} (ha : a ∈ self_adjoint A) : - exp ℂ (I • a) ∈ unitary A := -begin - rw [unitary.mem_iff, star_exp], - simp only [star_smul, is_R_or_C.star_def, self_adjoint.mem_iff.mp ha, conj_I, neg_smul], - rw ←@exp_add_of_commute ℂ A _ _ _ _ _ _ ((commute.refl (I • a)).neg_left), - rw ←@exp_add_of_commute ℂ A _ _ _ _ _ _ ((commute.refl (I • a)).neg_right), - simpa only [add_right_neg, add_left_neg, and_self] using (exp_zero : exp ℂ (0 : A) = 1), -end - /-- The map from the selfadjoint real subspace to the unitary group. This map only makes sense over ℂ. -/ @[simps] noncomputable def self_adjoint.exp_unitary (a : self_adjoint A) : unitary A := -⟨exp ℂ (I • a), self_adjoint.exp_i_smul_unitary (a.property)⟩ +⟨exp ℂ (I • a), exp_mem_unitary_of_mem_skew_adjoint _ (a.prop.smul_mem_skew_adjoint conj_I)⟩ open self_adjoint diff --git a/src/analysis/normed_space/star/gelfand_duality.lean b/src/analysis/normed_space/star/gelfand_duality.lean new file mode 100644 index 0000000000000..58777a5d3fd29 --- /dev/null +++ b/src/analysis/normed_space/star/gelfand_duality.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2022 Jireh Loreaux. All rights reserved. +Reeased under Apache 2.0 license as described in the file LICENSE. +Authors: Jireh Loreaux +-/ +import analysis.normed_space.star.spectrum +import analysis.normed.group.quotient +import analysis.normed_space.algebra +import topology.continuous_function.units +import topology.continuous_function.compact +import topology.algebra.algebra +import topology.continuous_function.stone_weierstrass + +/-! +# Gelfand Duality + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The `gelfand_transform` is an algebra homomorphism from a topological `𝕜`-algebra `A` to +`C(character_space 𝕜 A, 𝕜)`. In the case where `A` is a commutative complex Banach algebra, then +the Gelfand transform is actually spectrum-preserving (`spectrum.gelfand_transform_eq`). Moreover, +when `A` is a commutative C⋆-algebra over `ℂ`, then the Gelfand transform is a surjective isometry, +and even an equivalence between C⋆-algebras. + +## Main definitions + +* `ideal.to_character_space` : constructs an element of the character space from a maximal ideal in + a commutative complex Banach algebra +* `weak_dual.character_space.comp_continuous_map`: The functorial map taking `ψ : A →⋆ₐ[ℂ] B` to a + continuous function `character_space ℂ B → character_space ℂ A` given by pre-composition with `ψ`. + +## Main statements + +* `spectrum.gelfand_transform_eq` : the Gelfand transform is spectrum-preserving when the algebra is + a commutative complex Banach algebra. +* `gelfand_transform_isometry` : the Gelfand transform is an isometry when the algebra is a + commutative (unital) C⋆-algebra over `ℂ`. +* `gelfand_transform_bijective` : the Gelfand transform is bijective when the algebra is a + commutative (unital) C⋆-algebra over `ℂ`. + +## TODO + +* After `star_alg_equiv` is defined, realize `gelfand_transform` as a `star_alg_equiv`. +* Prove that if `A` is the unital C⋆-algebra over `ℂ` generated by a fixed normal element `x` in + a larger C⋆-algebra `B`, then `character_space ℂ A` is homeomorphic to `spectrum ℂ x`. +* From the previous result, construct the **continuous functional calculus**. +* Show that if `X` is a compact Hausdorff space, then `X` is (canonically) homeomorphic to + `character_space ℂ C(X, ℂ)`. +* Conclude using the previous fact that the functors `C(⬝, ℂ)` and `character_space ℂ ⬝` along with + the canonical homeomorphisms described above constitute a natural contravariant equivalence of + the categories of compact Hausdorff spaces (with continuous maps) and commutative unital + C⋆-algebras (with unital ⋆-algebra homomoprhisms); this is known as **Gelfand duality**. + +## Tags + +Gelfand transform, character space, C⋆-algebra +-/ + +open weak_dual +open_locale nnreal + +section complex_banach_algebra +open ideal + +variables {A : Type*} [normed_comm_ring A] [normed_algebra ℂ A] [complete_space A] + (I : ideal A) [ideal.is_maximal I] + +/-- Every maximal ideal in a commutative complex Banach algebra gives rise to a character on that +algebra. In particular, the character, which may be identified as an algebra homomorphism due to +`weak_dual.character_space.equiv_alg_hom`, is given by the composition of the quotient map and +the Gelfand-Mazur isomorphism `normed_ring.alg_equiv_complex_of_complete`. -/ +noncomputable def ideal.to_character_space : character_space ℂ A := +character_space.equiv_alg_hom.symm $ ((@normed_ring.alg_equiv_complex_of_complete (A ⧸ I) _ _ + (by { letI := quotient.field I, exact @is_unit_iff_ne_zero (A ⧸ I) _ }) _).symm : + A ⧸ I →ₐ[ℂ] ℂ).comp + (quotient.mkₐ ℂ I) + +lemma ideal.to_character_space_apply_eq_zero_of_mem {a : A} (ha : a ∈ I) : + I.to_character_space a = 0 := +begin + unfold ideal.to_character_space, + simpa only [character_space.equiv_alg_hom_symm_coe, alg_hom.coe_comp, + alg_equiv.coe_alg_hom, quotient.mkₐ_eq_mk, function.comp_app, quotient.eq_zero_iff_mem.mpr ha, + spectrum.zero_eq, normed_ring.alg_equiv_complex_of_complete_symm_apply] + using set.eq_of_mem_singleton (set.singleton_nonempty (0 : ℂ)).some_mem, +end + +/-- If `a : A` is not a unit, then some character takes the value zero at `a`. This is equivlaent +to `gelfand_transform ℂ A a` takes the value zero at some character. -/ +lemma weak_dual.character_space.exists_apply_eq_zero {a : A} (ha : ¬ is_unit a) : + ∃ f : character_space ℂ A, f a = 0 := +begin + unfreezingI { obtain ⟨M, hM, haM⟩ := (span {a}).exists_le_maximal (span_singleton_ne_top ha) }, + exact ⟨M.to_character_space, M.to_character_space_apply_eq_zero_of_mem + (haM (mem_span_singleton.mpr ⟨1, (mul_one a).symm⟩))⟩, +end + +lemma weak_dual.character_space.mem_spectrum_iff_exists {a : A} {z : ℂ} : + z ∈ spectrum ℂ a ↔ ∃ f : character_space ℂ A, f a = z := +begin + refine ⟨λ hz, _, _⟩, + { obtain ⟨f, hf⟩ := weak_dual.character_space.exists_apply_eq_zero hz, + simp only [map_sub, sub_eq_zero, alg_hom_class.commutes, algebra.id.map_eq_id, + ring_hom.id_apply] at hf, + exact (continuous_map.spectrum_eq_range (gelfand_transform ℂ A a)).symm ▸ ⟨f, hf.symm⟩ }, + { rintro ⟨f, rfl⟩, + exact alg_hom.apply_mem_spectrum f a, } +end + +/-- The Gelfand transform is spectrum-preserving. -/ +lemma spectrum.gelfand_transform_eq (a : A) : spectrum ℂ (gelfand_transform ℂ A a) = spectrum ℂ a := +begin + ext z, + rw [continuous_map.spectrum_eq_range, weak_dual.character_space.mem_spectrum_iff_exists], + exact iff.rfl, +end + +instance [nontrivial A] : nonempty (character_space ℂ A) := +⟨classical.some $ weak_dual.character_space.exists_apply_eq_zero $ zero_mem_nonunits.2 zero_ne_one⟩ + +end complex_banach_algebra + +section complex_cstar_algebra + +variables {A : Type*} [normed_comm_ring A] [normed_algebra ℂ A] [complete_space A] +variables [star_ring A] [cstar_ring A] [star_module ℂ A] + +lemma gelfand_transform_map_star (a : A) : + gelfand_transform ℂ A (star a) = star (gelfand_transform ℂ A a) := +continuous_map.ext $ λ φ, map_star φ a + +variable (A) + +/-- The Gelfand transform is an isometry when the algebra is a C⋆-algebra over `ℂ`. -/ +lemma gelfand_transform_isometry : isometry (gelfand_transform ℂ A) := +begin + nontriviality A, + refine add_monoid_hom_class.isometry_of_norm (gelfand_transform ℂ A) (λ a, _), + /- By `spectrum.gelfand_transform_eq`, the spectra of `star a * a` and its + `gelfand_transform` coincide. Therefore, so do their spectral radii, and since they are + self-adjoint, so also do their norms. Applying the C⋆-property of the norm and taking square + roots shows that the norm is preserved. -/ + have : spectral_radius ℂ (gelfand_transform ℂ A (star a * a)) = spectral_radius ℂ (star a * a), + { unfold spectral_radius, rw spectrum.gelfand_transform_eq, }, + simp only [map_mul, (is_self_adjoint.star_mul_self _).spectral_radius_eq_nnnorm, + gelfand_transform_map_star a, ennreal.coe_eq_coe, cstar_ring.nnnorm_star_mul_self, ←sq] at this, + simpa only [function.comp_app, nnreal.sqrt_sq] + using congr_arg ((coe : ℝ≥0 → ℝ) ∘ ⇑nnreal.sqrt) this, +end + +/-- The Gelfand transform is bijective when the algebra is a C⋆-algebra over `ℂ`. -/ +lemma gelfand_transform_bijective : function.bijective (gelfand_transform ℂ A) := +begin + refine ⟨(gelfand_transform_isometry A).injective, _⟩, + suffices : (gelfand_transform ℂ A).range = ⊤, + { exact λ x, this.symm ▸ (gelfand_transform ℂ A).mem_range.mp (this.symm ▸ algebra.mem_top) }, + /- Because the `gelfand_transform ℂ A` is an isometry, it has closed range, and so by the + Stone-Weierstrass theorem, it suffices to show that the image of the Gelfand transform separates + points in `C(character_space ℂ A, ℂ)` and is closed under `star`. -/ + have h : (gelfand_transform ℂ A).range.topological_closure = (gelfand_transform ℂ A).range, + from le_antisymm (subalgebra.topological_closure_minimal _ le_rfl + (gelfand_transform_isometry A).closed_embedding.closed_range) + (subalgebra.le_topological_closure _), + refine h ▸ continuous_map.subalgebra_is_R_or_C_topological_closure_eq_top_of_separates_points + _ (λ _ _, _) (λ f hf, _), + /- Separating points just means that elements of the `character_space` which agree at all points + of `A` are the same functional, which is just extensionality. -/ + { contrapose!, + exact λ h, subtype.ext (continuous_linear_map.ext $ + λ a, h (gelfand_transform ℂ A a) ⟨gelfand_transform ℂ A a, ⟨a, rfl⟩, rfl⟩), }, + /- If `f = gelfand_transform ℂ A a`, then `star f` is also in the range of `gelfand_transform ℂ A` + using the argument `star a`. The key lemma below may be hard to spot; it's `map_star` coming from + `weak_dual.star_hom_class`, which is a nontrivial result. -/ + { obtain ⟨f, ⟨a, rfl⟩, rfl⟩ := subalgebra.mem_map.mp hf, + refine ⟨star a, continuous_map.ext $ λ ψ, _⟩, + simpa only [gelfand_transform_map_star a, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom] } +end + +/-- The Gelfand transform as a `star_alg_equiv` between a commutative unital C⋆-algebra over `ℂ` +and the continuous functions on its `character_space`. -/ +@[simps] +noncomputable def gelfand_star_transform : A ≃⋆ₐ[ℂ] C(character_space ℂ A, ℂ) := +star_alg_equiv.of_bijective + (show A →⋆ₐ[ℂ] C(character_space ℂ A, ℂ), + from { map_star' := λ x, gelfand_transform_map_star x, .. gelfand_transform ℂ A }) + (gelfand_transform_bijective A) + +end complex_cstar_algebra + +section functoriality + +namespace weak_dual + +namespace character_space + +variables {A B C : Type*} +variables [normed_ring A] [normed_algebra ℂ A] [complete_space A] [star_ring A] +variables [normed_ring B] [normed_algebra ℂ B] [complete_space B] [star_ring B] +variables [normed_ring C] [normed_algebra ℂ C] [complete_space C] [star_ring C] + +/-- The functorial map taking `ψ : A →⋆ₐ[ℂ] B` to a continuous function +`character_space ℂ B → character_space ℂ A` obtained by pre-composition with `ψ`. -/ +@[simps] +noncomputable def comp_continuous_map (ψ : A →⋆ₐ[ℂ] B) : + C(character_space ℂ B, character_space ℂ A) := +{ to_fun := λ φ, equiv_alg_hom.symm ((equiv_alg_hom φ).comp (ψ.to_alg_hom)), + continuous_to_fun := continuous.subtype_mk (continuous_of_continuous_eval $ + λ a, map_continuous $ gelfand_transform ℂ B (ψ a)) _ } + +variables (A) + +/-- `weak_dual.character_space.comp_continuous_map` sends the identity to the identity. -/ +@[simp] lemma comp_continuous_map_id : + comp_continuous_map (star_alg_hom.id ℂ A) = continuous_map.id (character_space ℂ A) := +continuous_map.ext $ λ a, ext $ λ x, rfl + +variables {A} + +/-- `weak_dual.character_space.comp_continuous_map` is functorial. -/ +@[simp] lemma comp_continuous_map_comp (ψ₂ : B →⋆ₐ[ℂ] C) (ψ₁ : A →⋆ₐ[ℂ] B) : + comp_continuous_map (ψ₂.comp ψ₁) = (comp_continuous_map ψ₁).comp (comp_continuous_map ψ₂) := +continuous_map.ext $ λ a, ext $ λ x, rfl + +end character_space + +end weak_dual + +end functoriality diff --git a/src/analysis/normed_space/star/matrix.lean b/src/analysis/normed_space/star/matrix.lean index 356d1b43b9431..0de74bb3ddbeb 100644 --- a/src/analysis/normed_space/star/matrix.lean +++ b/src/analysis/normed_space/star/matrix.lean @@ -5,12 +5,15 @@ Authors: Hans Parshall -/ import analysis.matrix import analysis.normed_space.basic -import data.complex.is_R_or_C +import data.is_R_or_C.basic import linear_algebra.unitary_group /-! # Unitary matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file collects facts about the unitary matrices over `𝕜` (either `ℝ` or `ℂ`). -/ @@ -22,10 +25,10 @@ section entrywise_sup_norm variables [is_R_or_C 𝕜] [fintype n] [decidable_eq n] lemma entry_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) (i j : n): - ∥U i j∥ ≤ 1 := + ‖U i j‖ ≤ 1 := begin -- The norm squared of an entry is at most the L2 norm of its row. - have norm_sum : ∥ U i j ∥^2 ≤ (∑ x, ∥ U i x ∥^2), + have norm_sum : ‖ U i j ‖^2 ≤ (∑ x, ‖ U i x ‖^2), { apply multiset.single_le_sum, { intros x h_x, rw multiset.mem_map at h_x, @@ -36,11 +39,11 @@ begin use j, simp only [eq_self_iff_true, finset.mem_univ_val, and_self, sq_eq_sq] } }, -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ - have diag_eq_norm_sum : (U ⬝ Uᴴ) i i = ∑ (x : n), ∥ U i x ∥^2, + have diag_eq_norm_sum : (U ⬝ Uᴴ) i i = ∑ (x : n), ‖ U i x ‖^2, { simp only [matrix.mul_apply, matrix.conj_transpose_apply, ←star_ring_end_apply, is_R_or_C.mul_conj, is_R_or_C.norm_sq_eq_def', is_R_or_C.of_real_pow] }, -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ, real part - have re_diag_eq_norm_sum : is_R_or_C.re ((U ⬝ Uᴴ) i i) = ∑ (x : n), ∥ U i x ∥^2, + have re_diag_eq_norm_sum : is_R_or_C.re ((U ⬝ Uᴴ) i i) = ∑ (x : n), ‖ U i x ‖^2, { rw is_R_or_C.ext_iff at diag_eq_norm_sum, rw diag_eq_norm_sum.1, norm_cast }, @@ -53,13 +56,13 @@ begin exact norm_sum, end -local attribute [instance] matrix.normed_group +local attribute [instance] matrix.normed_add_comm_group /-- The entrywise sup norm of a unitary matrix is at most 1. -/ lemma entrywise_sup_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) : - ∥ U ∥ ≤ 1 := + ‖ U ‖ ≤ 1 := begin - simp_rw pi_norm_le_iff zero_le_one, + simp_rw pi_norm_le_iff_of_nonneg zero_le_one, intros i j, exact entry_norm_bound_of_unitary hU _ _ end diff --git a/src/analysis/normed_space/star/mul.lean b/src/analysis/normed_space/star/mul.lean new file mode 100644 index 0000000000000..bdf88d0d85bee --- /dev/null +++ b/src/analysis/normed_space/star/mul.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2022 Jireh Loreaux. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jireh Loreaux +-/ +import analysis.normed_space.star.basic +import analysis.normed_space.operator_norm + +/-! # The left-regular representation is an isometry for C⋆-algebras + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +open continuous_linear_map + +local postfix `⋆`:std.prec.max_plus := star + +variables (𝕜 : Type*) {E : Type*} +variables [densely_normed_field 𝕜] [non_unital_normed_ring E] [star_ring E] [cstar_ring E] +variables [normed_space 𝕜 E] [is_scalar_tower 𝕜 E E] [smul_comm_class 𝕜 E E] (a : E) + +/-- In a C⋆-algebra `E`, either unital or non-unital, multiplication on the left by `a : E` has +norm equal to the norm of `a`. -/ +@[simp] lemma op_nnnorm_mul : ‖mul 𝕜 E a‖₊ = ‖a‖₊ := +begin + rw ←Sup_closed_unit_ball_eq_nnnorm, + refine cSup_eq_of_forall_le_of_forall_lt_exists_gt _ _ (λ r hr, _), + { exact (metric.nonempty_closed_ball.mpr zero_le_one).image _ }, + { rintro - ⟨x, hx, rfl⟩, + exact ((mul 𝕜 E a).unit_le_op_norm x $ mem_closed_ball_zero_iff.mp hx).trans + (op_norm_mul_apply_le 𝕜 E a) }, + { have ha : 0 < ‖a‖₊ := zero_le'.trans_lt hr, + rw [←inv_inv (‖a‖₊), nnreal.lt_inv_iff_mul_lt (inv_ne_zero ha.ne')] at hr, + obtain ⟨k, hk₁, hk₂⟩ := normed_field.exists_lt_nnnorm_lt 𝕜 (mul_lt_mul_of_pos_right hr $ + inv_pos.2 ha), + refine ⟨_, ⟨k • star a, _, rfl⟩, _⟩, + { simpa only [mem_closed_ball_zero_iff, norm_smul, one_mul, norm_star] using + (nnreal.le_inv_iff_mul_le ha.ne').1 (one_mul ‖a‖₊⁻¹ ▸ hk₂.le : ‖k‖₊ ≤ ‖a‖₊⁻¹) }, + { simp only [map_smul, nnnorm_smul, mul_apply', mul_smul_comm, cstar_ring.nnnorm_self_mul_star], + rwa [←nnreal.div_lt_iff (mul_pos ha ha).ne', div_eq_mul_inv, mul_inv, ←mul_assoc] } }, +end + +/-- In a C⋆-algebra `E`, either unital or non-unital, multiplication on the right by `a : E` has +norm eqaul to the norm of `a`. -/ +@[simp] lemma op_nnnorm_mul_flip : ‖(mul 𝕜 E).flip a‖₊ = ‖a‖₊ := +begin + rw [←Sup_unit_ball_eq_nnnorm, ←nnnorm_star, ←@op_nnnorm_mul 𝕜 E, ←Sup_unit_ball_eq_nnnorm], + congr' 1, + simp only [mul_apply', flip_apply], + refine set.subset.antisymm _ _; + rintro - ⟨b, hb, rfl⟩; + refine ⟨star b, by simpa only [norm_star, mem_ball_zero_iff] using hb, _⟩, + { simp only [←star_mul, nnnorm_star] }, + { simpa using (nnnorm_star (star b * a)).symm } +end + +variables (E) + +/-- In a C⋆-algebra `E`, either unital or non-unital, the left regular representation is an +isometry. -/ +lemma mul_isometry : isometry (mul 𝕜 E) := +add_monoid_hom_class.isometry_of_norm _ (λ a, congr_arg coe $ op_nnnorm_mul 𝕜 a) + +/-- In a C⋆-algebra `E`, either unital or non-unital, the right regular anti-representation is an +isometry. -/ +lemma mul_flip_isometry : isometry (mul 𝕜 E).flip := +add_monoid_hom_class.isometry_of_norm _ (λ a, congr_arg coe $ op_nnnorm_mul_flip 𝕜 a) diff --git a/src/analysis/normed_space/star/multiplier.lean b/src/analysis/normed_space/star/multiplier.lean new file mode 100644 index 0000000000000..5c3efde31d567 --- /dev/null +++ b/src/analysis/normed_space/star/multiplier.lean @@ -0,0 +1,515 @@ +/- +Copyright (c) 2022 Jireh Loreaux. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jireh Loreaux, Jon Bannon +-/ + +import algebra.star.star_alg_hom +import analysis.normed_space.star.basic +import analysis.normed_space.operator_norm +import analysis.special_functions.pow.nnreal +import analysis.normed_space.star.mul + +/-! +# Multiplier Algebra of a C⋆-algebra + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Define the multiplier algebra of a C⋆-algebra as the algebra (over `𝕜`) of double centralizers, +for which we provide the localized notation `𝓜(𝕜, A)`. A double centralizer is a pair of +continuous linear maps `L R : A →L[𝕜] A` satisfying the intertwining condition `R x * y = x * L y`. + +There is a natural embedding `A → 𝓜(𝕜, A)` which sends `a : A` to the continuous linear maps +`L R : A →L[𝕜] A` given by left and right multiplication by `a`, and we provide this map as a +coercion. + +The multiplier algebra corresponds to a non-commutative Stone–Čech compactification in the sense +that when the algebra `A` is commutative, it can be identified with `C₀(X, ℂ)` for some locally +compact Hausdorff space `X`, and in that case `𝓜(𝕜, A)` can be identified with `C(β X, ℂ)`. + +## Implementation notes + +We make the hypotheses on `𝕜` as weak as possible so that, in particular, this construction works +for both `𝕜 = ℝ` and `𝕜 = ℂ`. + +The reader familiar with C⋆-algebra theory may recognize that one +only needs `L` and `R` to be functions instead of continuous linear maps, at least when `A` is a +C⋆-algebra. Our intention is simply to eventually provide a constructor for this situation. + +We pull back the `normed_algebra` structure (and everything contained therein) through the +ring (even algebra) homomorphism +`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` which +sends `a : 𝓜(𝕜, A)` to `(a.fst, mul_opposite.op a.snd)`. The star structure is provided +separately. + +## References + +* https://en.wikipedia.org/wiki/Multiplier_algebra + +## TODO + ++ Define a type synonym for `𝓜(𝕜, A)` which is equipped with the strict uniform space structure + and show it is complete ++ Show that the image of `A` in `𝓜(𝕜, A)` is an essential ideal ++ Prove the universal property of `𝓜(𝕜, A)` ++ Construct a double centralizer from a pair of maps (not necessarily linear or continuous) + `L : A → A`, `R : A → A` satisfying the centrality condition `∀ x y, R x * y = x * L y`. ++ Show that if `A` is unital, then `A ≃⋆ₐ[𝕜] 𝓜(𝕜, A)`. +-/ + +open_locale nnreal ennreal +open nnreal continuous_linear_map mul_opposite + +universes u v + +/-- The type of *double centralizers*, also known as the *multiplier algebra* and denoted by +`𝓜(𝕜, A)`, of a non-unital normed algebra. + +If `x : 𝓜(𝕜, A)`, then `x.fst` and `x.snd` are what is usually referred to as $L$ and $R$. -/ +@[ext] +structure double_centralizer (𝕜 : Type u) (A : Type v) [nontrivially_normed_field 𝕜] + [non_unital_normed_ring A] [normed_space 𝕜 A] [smul_comm_class 𝕜 A A] [is_scalar_tower 𝕜 A A] + extends (A →L[𝕜] A) × (A →L[𝕜] A) := +(central : ∀ x y : A, snd x * y = x * fst y) + +localized "notation `𝓜(` 𝕜 `, ` A `)` := double_centralizer 𝕜 A" in multiplier_algebra + +namespace double_centralizer + +section nontrivially_normed + +variables (𝕜 A : Type*) [nontrivially_normed_field 𝕜] [non_unital_normed_ring A] +variables [normed_space 𝕜 A] [smul_comm_class 𝕜 A A] [is_scalar_tower 𝕜 A A] + +/-! +### Algebraic structure + +Because the multiplier algebra is defined as the algebra of double centralizers, there is a natural +injection `double_centralizer.to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` +defined by `λ a, (a.fst, mul_opposite.op a.snd)`. We use this map to pull back the ring, module and +algebra structure from `(A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` to `𝓜(𝕜, A)`. -/ + +variables {𝕜 A} + +lemma range_to_prod : set.range to_prod = {lr : (A →L[𝕜] A) × _ | ∀ x y, lr.2 x * y = x * lr.1 y} := +set.ext $ λ x, ⟨by {rintro ⟨a, rfl⟩, exact a.central}, λ hx, ⟨⟨x, hx⟩, rfl⟩⟩ + +instance : has_add 𝓜(𝕜, A) := +{ add := λ a b, + { to_prod := a.to_prod + b.to_prod, + central := λ x y, show (a.snd + b.snd) x * y = x * (a.fst + b.fst) y, + by simp only [continuous_linear_map.add_apply, mul_add, add_mul, central] } } + +instance : has_zero 𝓜(𝕜, A) := +{ zero := + { to_prod := 0, + central := λ x y, (zero_mul y).trans (mul_zero x).symm } } + +instance : has_neg 𝓜(𝕜, A) := +{ neg := λ a, + { to_prod := -a.to_prod, + central := λ x y, show -a.snd x * y = x * -a.fst y, + by simp only [continuous_linear_map.neg_apply, neg_mul, mul_neg, central] } } + +instance : has_sub 𝓜(𝕜, A) := +{ sub := λ a b, + { to_prod := a.to_prod - b.to_prod, + central := λ x y, show (a.snd - b.snd) x * y = x * (a.fst - b.fst) y, + by simp only [continuous_linear_map.sub_apply, sub_mul, mul_sub, central] } } + +section scalars + +variables {S : Type*} [monoid S] [distrib_mul_action S A] [smul_comm_class 𝕜 S A] + [has_continuous_const_smul S A] [is_scalar_tower S A A] [smul_comm_class S A A] + +instance : has_smul S 𝓜(𝕜, A) := +{ smul := λ s a, + { to_prod := s • a.to_prod, + central := λ x y, show (s • a.snd) x * y = x * (s • a.fst) y, + by simp only [continuous_linear_map.smul_apply, mul_smul_comm, smul_mul_assoc, central] } } + +@[simp] lemma smul_to_prod (s : S) (a : 𝓜(𝕜, A)) : (s • a).to_prod = s • a.to_prod := rfl +lemma smul_fst (s : S) (a : 𝓜(𝕜, A)) : (s • a).fst = s • a.fst := rfl +lemma smul_snd (s : S) (a : 𝓜(𝕜, A)) : (s • a).snd = s • a.snd := rfl + +variables {T : Type*} [monoid T] [distrib_mul_action T A] [smul_comm_class 𝕜 T A] + [has_continuous_const_smul T A] [is_scalar_tower T A A] [smul_comm_class T A A] + +instance [has_smul S T] [is_scalar_tower S T A] : is_scalar_tower S T 𝓜(𝕜, A) := +{ smul_assoc := λ _ _ a, ext _ _ $ smul_assoc _ _ a.to_prod } + +instance [smul_comm_class S T A] : smul_comm_class S T 𝓜(𝕜, A) := +{ smul_comm := λ _ _ a, ext _ _ $ smul_comm _ _ a.to_prod } + +instance {R : Type*} [semiring R] [module R A] [smul_comm_class 𝕜 R A] + [has_continuous_const_smul R A] [is_scalar_tower R A A] [smul_comm_class R A A] + [module Rᵐᵒᵖ A] [is_central_scalar R A] : is_central_scalar R 𝓜(𝕜, A) := +{ op_smul_eq_smul := λ _ a, ext _ _ $ op_smul_eq_smul _ a.to_prod } + +end scalars + +instance : has_one 𝓜(𝕜, A) := ⟨⟨1, λ x y, rfl⟩⟩ + +instance : has_mul 𝓜(𝕜, A) := +{ mul := λ a b, + { to_prod := (a.fst.comp b.fst, b.snd.comp a.snd), + central := λ x y, show b.snd (a.snd x) * y = x * a.fst (b.fst y), + by simp only [central] } } + +instance : has_nat_cast 𝓜(𝕜, A) := +{ nat_cast := λ n, ⟨n, λ x y, + begin + rw [prod.snd_nat_cast, prod.fst_nat_cast], + simp only [←nat.smul_one_eq_coe, smul_apply, one_apply, mul_smul_comm, smul_mul_assoc], + end⟩ } + +instance : has_int_cast 𝓜(𝕜, A) := +{ int_cast := λ n, ⟨n, λ x y, + begin + rw [prod.snd_int_cast, prod.fst_int_cast], + simp only [←int.smul_one_eq_coe, smul_apply, one_apply, mul_smul_comm, smul_mul_assoc], + end⟩ } + +instance : has_pow 𝓜(𝕜, A) ℕ := +{ pow := λ a n, ⟨a.to_prod ^ n, λ x y, + begin + induction n with k hk generalizing x y, + { refl }, + { rw [prod.pow_snd, prod.pow_fst] at hk ⊢, + rw [pow_succ a.snd, mul_apply, a.central, hk, pow_succ' a.fst, mul_apply] }, + end⟩ } + +instance : inhabited 𝓜(𝕜, A) := ⟨0⟩ + +@[simp] lemma add_to_prod (a b : 𝓜(𝕜, A)) : (a + b).to_prod = a.to_prod + b.to_prod := rfl +@[simp] lemma zero_to_prod : (0 : 𝓜(𝕜, A)).to_prod = 0 := rfl +@[simp] lemma neg_to_prod (a : 𝓜(𝕜, A)) : (-a).to_prod = -a.to_prod := rfl +@[simp] lemma sub_to_prod (a b : 𝓜(𝕜, A)) : (a - b).to_prod = a.to_prod - b.to_prod := rfl +@[simp] lemma one_to_prod : (1 : 𝓜(𝕜, A)).to_prod = 1 := rfl +@[simp] lemma nat_cast_to_prod (n : ℕ) : (n : 𝓜(𝕜 , A)).to_prod = n := rfl +@[simp] lemma int_cast_to_prod (n : ℤ) : (n : 𝓜(𝕜 , A)).to_prod = n := rfl +@[simp] lemma pow_to_prod (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).to_prod = a.to_prod ^ n := rfl + +lemma add_fst (a b : 𝓜(𝕜, A)) : (a + b).fst = a.fst + b.fst := rfl +lemma add_snd (a b : 𝓜(𝕜, A)) : (a + b).snd = a.snd + b.snd := rfl +lemma zero_fst : (0 : 𝓜(𝕜, A)).fst = 0 := rfl +lemma zero_snd : (0 : 𝓜(𝕜, A)).snd = 0 := rfl +lemma neg_fst (a : 𝓜(𝕜, A)) : (-a).fst = -a.fst := rfl +lemma neg_snd (a : 𝓜(𝕜, A)) : (-a).snd = -a.snd := rfl +lemma sub_fst (a b : 𝓜(𝕜, A)) : (a - b).fst = a.fst - b.fst := rfl +lemma sub_snd (a b : 𝓜(𝕜, A)) : (a - b).snd = a.snd - b.snd := rfl +lemma one_fst : (1 : 𝓜(𝕜, A)).fst = 1 := rfl +lemma one_snd : (1 : 𝓜(𝕜, A)).snd = 1 := rfl +@[simp] lemma mul_fst (a b : 𝓜(𝕜, A)) : (a * b).fst = a.fst * b.fst := rfl +@[simp] lemma mul_snd (a b : 𝓜(𝕜, A)) : (a * b).snd = b.snd * a.snd := rfl +lemma nat_cast_fst (n : ℕ) : (n : 𝓜(𝕜 , A)).fst = n := rfl +lemma nat_cast_snd (n : ℕ) : (n : 𝓜(𝕜 , A)).snd = n := rfl +lemma int_cast_fst (n : ℤ) : (n : 𝓜(𝕜 , A)).fst = n := rfl +lemma int_cast_snd (n : ℤ) : (n : 𝓜(𝕜 , A)).snd = n := rfl +lemma pow_fst (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).fst = a.fst ^ n := rfl +lemma pow_snd (n : ℕ) (a : 𝓜(𝕜, A)) : (a ^ n).snd = a.snd ^ n := rfl + +/-- The natural injection from `double_centralizer.to_prod` except the second coordinate inherits +`mul_opposite.op`. The ring structure on `𝓜(𝕜, A)` is the pullback under this map. -/ +def to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ := +λ a, (a.fst, mul_opposite.op a.snd) + +lemma to_prod_mul_opposite_injective : + function.injective (to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ) := +λ a b h, let h' := prod.ext_iff.mp h in ext _ _ $ prod.ext h'.1 $ mul_opposite.op_injective h'.2 + +lemma range_to_prod_mul_opposite : + set.range to_prod_mul_opposite = {lr : (A →L[𝕜] A) × _ | ∀ x y, unop lr.2 x * y = x * lr.1 y} := +set.ext $ λ x, + ⟨by {rintro ⟨a, rfl⟩, exact a.central}, λ hx, ⟨⟨(x.1, unop x.2), hx⟩, prod.ext rfl rfl⟩⟩ + +/-- The ring structure is inherited as the pullback under the injective map +`double_centralizer.to_prod_mul_opposite : 𝓜(𝕜, A) → (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ` -/ +instance : ring 𝓜(𝕜, A) := +to_prod_mul_opposite_injective.ring _ + rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) + (λ x n, prod.ext rfl $ mul_opposite.op_smul _ _) + (λ x n, prod.ext rfl $ mul_opposite.op_smul _ _) + (λ x n, prod.ext rfl $ mul_opposite.op_pow _ _) + (λ _, rfl) (λ _, rfl) + +/-- The canonical map `double_centralizer.to_prod` as an additive group homomorphism. -/ +@[simps] +def to_prod_hom : 𝓜(𝕜, A) →+ (A →L[𝕜] A) × (A →L[𝕜] A) := +{ to_fun := to_prod, + map_zero' := rfl, + map_add' := λ x y, rfl } + +/-- The canonical map `double_centralizer.to_prod_mul_opposite` as a ring homomorphism. -/ +@[simps] +def to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ := +{ to_fun := to_prod_mul_opposite, + map_zero' := rfl, + map_one' := rfl, + map_add' := λ x y, rfl, + map_mul' := λ x y, rfl } + +/-- The module structure is inherited as the pullback under the additive group monomorphism +`double_centralizer.to_prod : 𝓜(𝕜, A) →+ (A →L[𝕜] A) × (A →L[𝕜] A)` -/ +instance {S : Type*} [semiring S] [module S A] [smul_comm_class 𝕜 S A] + [has_continuous_const_smul S A] [is_scalar_tower S A A] [smul_comm_class S A A] : + module S 𝓜(𝕜, A) := +function.injective.module S to_prod_hom ext (λ x y, rfl) + +-- TODO: generalize to `algebra S 𝓜(𝕜, A)` once `continuous_linear_map.algebra` is generalized. +instance : algebra 𝕜 𝓜(𝕜, A) := +{ to_fun := λ k, + { to_prod := algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)) k, + central := λ x y, by simp_rw [prod.algebra_map_apply, algebra.algebra_map_eq_smul_one, + smul_apply, one_apply, mul_smul_comm, smul_mul_assoc] }, + map_one' := ext _ _ $ map_one $ algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)), + map_mul' := λ k₁ k₂, ext _ _ $ prod.ext (map_mul (algebra_map 𝕜 (A →L[𝕜] A)) _ _) + ((map_mul (algebra_map 𝕜 (A →L[𝕜] A)) _ _).trans (algebra.commutes _ _)), + map_zero' := ext _ _ $ map_zero $ algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A)), + map_add' := λ _ _, ext _ _ $ map_add (algebra_map 𝕜 ((A →L[𝕜] A) × (A →L[𝕜] A))) _ _, + commutes' := λ _ _, ext _ _ $ prod.ext (algebra.commutes _ _) (algebra.commutes _ _).symm, + smul_def' := λ _ _, ext _ _ $ prod.ext (algebra.smul_def _ _) + ((algebra.smul_def _ _).trans $ algebra.commutes _ _) } + +@[simp] lemma algebra_map_to_prod (k : 𝕜) : + (algebra_map 𝕜 𝓜(𝕜, A) k).to_prod = algebra_map 𝕜 _ k := rfl +lemma algebra_map_fst (k : 𝕜) : (algebra_map 𝕜 𝓜(𝕜, A) k).fst = algebra_map 𝕜 _ k := rfl +lemma algebra_map_snd (k : 𝕜) : (algebra_map 𝕜 𝓜(𝕜, A) k).snd = algebra_map 𝕜 _ k := rfl + +/-! +### Star structure +-/ + +section star + +variables [star_ring 𝕜] [star_ring A] [star_module 𝕜 A] [normed_star_group A] + +/-- The star operation on `a : 𝓜(𝕜, A)` is given by +`(star a).to_prod = (star ∘ a.snd ∘ star, star ∘ a.fst ∘ star)`. -/ +instance : has_star 𝓜(𝕜, A) := +{ star := λ a, + { fst := (((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A).comp a.snd).comp + ((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A), + snd := (((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A).comp a.fst).comp + ((starₗᵢ 𝕜 : A ≃ₗᵢ⋆[𝕜] A) : A →L⋆[𝕜] A), + central := λ x y, by simpa only [star_mul, star_star] + using (congr_arg star (a.central (star y) (star x))).symm } } + +@[simp] lemma star_fst (a : 𝓜(𝕜, A)) (b : A) : (star a).fst b = star (a.snd (star b)) := rfl +@[simp] lemma star_snd (a : 𝓜(𝕜, A)) (b : A) : (star a).snd b = star (a.fst (star b)) := rfl + +instance : star_add_monoid 𝓜(𝕜, A) := +{ star_involutive := λ x, by {ext; simp only [star_fst, star_snd, star_star]}, + star_add := λ x y, by {ext; simp only [star_fst, star_snd, add_fst, add_snd, + continuous_linear_map.add_apply, star_add]}, + .. double_centralizer.has_star } + +instance : star_ring 𝓜(𝕜, A) := +{ star_mul := λ a b, by {ext; simp only [star_fst, star_snd, mul_fst, mul_snd, star_star, + continuous_linear_map.coe_mul, function.comp_app]}, + .. double_centralizer.star_add_monoid } + +instance : star_module 𝕜 𝓜(𝕜, A) := +{ star_smul := λ k a, by {ext; exact star_smul _ _}, + .. double_centralizer.star_add_monoid } + +end star + +/-! +### Coercion from an algebra into its multiplier algebra +-/ + +/-- The natural coercion of `A` into `𝓜(𝕜, A)` given by sending `a : A` to the pair of linear +maps `Lₐ Rₐ : A →L[𝕜] A` given by left- and right-multiplication by `a`, respectively. + +Warning: if `A = 𝕜`, then this is a coercion which is not definitionally equal to the +`algebra_map 𝕜 𝓜(𝕜, 𝕜)` coercion, but these are propositionally equal. See +`double_centralizer.coe_eq_algebra_map` below. -/ +noncomputable instance : has_coe_t A 𝓜(𝕜, A) := +{ coe := λ a, + { fst := continuous_linear_map.mul 𝕜 A a, + snd := (continuous_linear_map.mul 𝕜 A).flip a, + central := λ x y, mul_assoc _ _ _ } } + +@[simp, norm_cast] +lemma coe_fst (a : A) : (a : 𝓜(𝕜, A)).fst = continuous_linear_map.mul 𝕜 A a := rfl +@[simp, norm_cast] +lemma coe_snd (a : A) : (a : 𝓜(𝕜, A)).snd = (continuous_linear_map.mul 𝕜 A).flip a := rfl + +lemma coe_eq_algebra_map : (coe : 𝕜 → 𝓜(𝕜, 𝕜)) = algebra_map 𝕜 𝓜(𝕜, 𝕜) := +begin + ext; + simp only [coe_fst, mul_apply', mul_one, algebra_map_to_prod, prod.algebra_map_apply, coe_snd, + flip_apply, one_mul]; + simp only [algebra.algebra_map_eq_smul_one, smul_apply, one_apply, smul_eq_mul, mul_one], +end + +/-- The coercion of an algebra into its multiplier algebra as a non-unital star algebra +homomorphism. -/ +@[simps] +noncomputable def coe_hom [star_ring 𝕜] [star_ring A] [star_module 𝕜 A] [normed_star_group A] : + A →⋆ₙₐ[𝕜] 𝓜(𝕜, A) := +{ to_fun := λ a, a, + map_smul' := λ k a, by ext; simp only [coe_fst, coe_snd, continuous_linear_map.map_smul, + smul_fst, smul_snd], + map_zero' := by ext; simp only [coe_fst, coe_snd, map_zero, zero_fst, zero_snd], + map_add' := λ a b, by ext; simp only [coe_fst, coe_snd, map_add, add_fst, add_snd], + map_mul' := λ a b, by ext; simp only [coe_fst, coe_snd, mul_apply', flip_apply, mul_fst, mul_snd, + continuous_linear_map.coe_mul, function.comp_app, mul_assoc], + map_star' := λ a, by ext; simp only [coe_fst, coe_snd, mul_apply', star_fst, star_snd, + flip_apply, star_mul, star_star] } + +/-! +### Norm structures +We define the norm structure on `𝓜(𝕜, A)` as the pullback under +`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`, which +provides a definitional isometric embedding. Consequently, completeness of `𝓜(𝕜, A)` is obtained +by proving that the range of this map is closed. + +In addition, we prove that `𝓜(𝕜, A)` is a normed algebra, and, when `A` is a C⋆-algebra, we show +that `𝓜(𝕜, A)` is also a C⋆-algebra. Moreover, in this case, for `a : 𝓜(𝕜, A)`, +`‖a‖ = ‖a.fst‖ = ‖a.snd‖`. -/ + +/-- The normed group structure is inherited as the pullback under the ring monomoprhism +`double_centralizer.to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ`. -/ +noncomputable instance : normed_ring 𝓜(𝕜, A) := +normed_ring.induced _ _ (to_prod_mul_opposite_hom : 𝓜(𝕜, A) →+* (A →L[𝕜] A) × (A →L[𝕜] A)ᵐᵒᵖ) + to_prod_mul_opposite_injective + +-- even though the definition is actually in terms of `double_centralizer.to_prod_mul_opposite`, we +-- choose to see through that here to avoid `mul_opposite.op` appearing. +lemma norm_def (a : 𝓜(𝕜, A)) : ‖a‖ = ‖a.to_prod_hom‖ := rfl +lemma nnnorm_def (a : 𝓜(𝕜, A)) : ‖a‖₊ = ‖a.to_prod_hom‖₊ := rfl + +lemma norm_def' (a : 𝓜(𝕜, A)) : ‖a‖ = ‖a.to_prod_mul_opposite_hom‖ := rfl +lemma nnnorm_def' (a : 𝓜(𝕜, A)) : ‖a‖₊ = ‖a.to_prod_mul_opposite_hom‖₊ := rfl + +instance : normed_space 𝕜 𝓜(𝕜, A) := +{ norm_smul_le := λ k a, (norm_smul_le k a.to_prod_mul_opposite : _), + .. double_centralizer.module } + +instance : normed_algebra 𝕜 𝓜(𝕜, A) := +{ ..double_centralizer.algebra, ..double_centralizer.normed_space } + +lemma uniform_embedding_to_prod_mul_opposite : + uniform_embedding (@to_prod_mul_opposite 𝕜 A _ _ _ _ _) := +uniform_embedding_comap to_prod_mul_opposite_injective + +instance [complete_space A] : complete_space 𝓜(𝕜, A) := +begin + rw complete_space_iff_is_complete_range + uniform_embedding_to_prod_mul_opposite.to_uniform_inducing, + apply is_closed.is_complete, + simp only [range_to_prod_mul_opposite, set.set_of_forall], + refine is_closed_Inter (λ x, is_closed_Inter $ λ y, is_closed_eq _ _), + exact ((continuous_linear_map.apply 𝕜 A _).continuous.comp $ + continuous_unop.comp continuous_snd).mul continuous_const, + exact continuous_const.mul ((continuous_linear_map.apply 𝕜 A _).continuous.comp continuous_fst), +end + +variables [star_ring A] [cstar_ring A] + +/-- For `a : 𝓜(𝕜, A)`, the norms of `a.fst` and `a.snd` coincide, and hence these +also coincide with `‖a‖` which is `max (‖a.fst‖) (‖a.snd‖)`. -/ +lemma norm_fst_eq_snd (a : 𝓜(𝕜, A)) : ‖a.fst‖ = ‖a.snd‖ := +begin + -- a handy lemma for this proof + have h0 : ∀ f : A →L[𝕜] A, ∀ C : ℝ≥0, (∀ b : A, ‖f b‖₊ ^ 2 ≤ C * ‖f b‖₊ * ‖b‖₊) → ‖f‖₊ ≤ C, + { intros f C h, + have h1 : ∀ b, C * ‖f b‖₊ * ‖b‖₊ ≤ C * ‖f‖₊ * ‖b‖₊ ^ 2, + { intros b, + convert mul_le_mul_right' (mul_le_mul_left' (f.le_op_nnnorm b) C) (‖b‖₊) using 1, + ring, }, + have := div_le_of_le_mul (f.op_nnnorm_le_bound _ (by simpa only [sqrt_sq, sqrt_mul] + using (λ b, sqrt_le_sqrt_iff.mpr ((h b).trans (h1 b))))), + convert rpow_le_rpow this two_pos.le, + { simp only [rpow_two, div_pow, sq_sqrt], simp only [sq, mul_self_div_self] }, + { simp only [rpow_two, sq_sqrt] } }, + have h1 : ∀ b, ‖a.fst b‖₊ ^ 2 ≤ ‖a.snd‖₊ * ‖a.fst b‖₊ * ‖b‖₊, + { intros b, + calc ‖a.fst b‖₊ ^ 2 + = ‖star (a.fst b) * (a.fst b)‖₊ + : by simpa only [←sq] using (cstar_ring.nnnorm_star_mul_self).symm + ... ≤ ‖a.snd (star (a.fst b))‖₊ * ‖b‖₊ : a.central (star (a.fst b)) b ▸ nnnorm_mul_le _ _ + ... ≤ ‖a.snd‖₊ * ‖a.fst b‖₊ * ‖b‖₊ + : nnnorm_star (a.fst b) ▸ mul_le_mul_right' (a.snd.le_op_nnnorm _) _}, + have h2 : ∀ b, ‖a.snd b‖₊ ^ 2 ≤ ‖a.fst‖₊ * ‖a.snd b‖₊ * ‖b‖₊, + { intros b, + calc ‖a.snd b‖₊ ^ 2 + = ‖a.snd b * star (a.snd b)‖₊ + : by simpa only [←sq] using (cstar_ring.nnnorm_self_mul_star).symm + ... ≤ ‖b‖₊ * ‖a.fst (star (a.snd b))‖₊ + : (a.central b (star (a.snd b))).symm ▸ nnnorm_mul_le _ _ + ... = ‖a.fst (star (a.snd b))‖₊ * ‖b‖₊ : mul_comm _ _ + ... ≤ ‖a.fst‖₊ * ‖a.snd b‖₊ * ‖b‖₊ + : nnnorm_star (a.snd b) ▸ mul_le_mul_right' (a.fst.le_op_nnnorm _) _ }, + exact le_antisymm (h0 _ _ h1) (h0 _ _ h2), +end + +lemma nnnorm_fst_eq_snd (a : 𝓜(𝕜, A)) : ‖a.fst‖₊ = ‖a.snd‖₊ := subtype.ext $ norm_fst_eq_snd a +@[simp] lemma norm_fst (a : 𝓜(𝕜, A)) : ‖a.fst‖ = ‖a‖ := + by simp only [norm_def, to_prod_hom_apply, prod.norm_def, norm_fst_eq_snd, max_eq_right, + eq_self_iff_true] +@[simp] lemma norm_snd (a : 𝓜(𝕜, A)) : ‖a.snd‖ = ‖a‖ := by rw [←norm_fst, norm_fst_eq_snd] +@[simp] lemma nnnorm_fst (a : 𝓜(𝕜, A)) : ‖a.fst‖₊ = ‖a‖₊ := subtype.ext (norm_fst a) +@[simp] lemma nnnorm_snd (a : 𝓜(𝕜, A)) : ‖a.snd‖₊ = ‖a‖₊ := subtype.ext (norm_snd a) + +end nontrivially_normed + +section densely_normed + +variables {𝕜 A : Type*} [densely_normed_field 𝕜] [star_ring 𝕜] +variables [non_unital_normed_ring A] [star_ring A] [cstar_ring A] +variables [normed_space 𝕜 A] [smul_comm_class 𝕜 A A] [is_scalar_tower 𝕜 A A] [star_module 𝕜 A] + +instance : cstar_ring 𝓜(𝕜, A) := +{ norm_star_mul_self := λ a, congr_arg (coe : ℝ≥0 → ℝ) $ show ‖star a * a‖₊ = ‖a‖₊ * ‖a‖₊, from + begin + /- The essence of the argument is this: let `a = (L,R)` and recall `‖a‖ = ‖L‖`. + `star a = (star ∘ R ∘ star, star ∘ L ∘ star)`. Then for any `x y : A`, we have + `‖star a * a‖ = ‖(star a * a).snd‖ = ‖R (star (L (star x))) * y‖ = ‖star (L (star x)) * L y‖` + Now, on the one hand, + `‖star (L (star x)) * L y‖ ≤ ‖star (L (star x))‖ * ‖L y‖ = ‖L (star x)‖ * ‖L y‖ ≤ ‖L‖ ^ 2` + whenever `‖x‖, ‖y‖ ≤ 1`, so the supremum over all such `x, y` is at most `‖L‖ ^ 2`. + On the other hand, for any `‖z‖ ≤ 1`, we may choose `x := star z` and `y := z` to get: + `‖star (L (star x)) * L y‖ = ‖star (L z) * (L z)‖ = ‖L z‖ ^ 2`, and taking the supremum over + all such `z` yields that the supremum is at least `‖L‖ ^ 2`. It is the latter part of the + argument where `densely_normed_field 𝕜` is required (for `Sup_closed_unit_ball_eq_nnnorm`). -/ + have hball : (metric.closed_ball (0 : A) 1).nonempty := + metric.nonempty_closed_ball.2 (zero_le_one), + have key : ∀ x y, ‖x‖₊ ≤ 1 → ‖y‖₊ ≤ 1 → ‖a.snd (star (a.fst (star x))) * y‖₊ ≤ ‖a‖₊ * ‖a‖₊, + { intros x y hx hy, + rw [a.central], + calc ‖star (a.fst (star x)) * a.fst y‖₊ ≤ ‖a.fst (star x)‖₊ * ‖a.fst y‖₊ + : nnnorm_star (a.fst (star x)) ▸ nnnorm_mul_le _ _ + ... ≤ (‖a.fst‖₊ * 1) * (‖a.fst‖₊ * 1) + : mul_le_mul' (a.fst.le_op_norm_of_le ((nnnorm_star x).trans_le hx)) + (a.fst.le_op_norm_of_le hy) + ... ≤ ‖a‖₊ * ‖a‖₊ : by simp only [mul_one, nnnorm_fst] }, + rw ←nnnorm_snd, + simp only [mul_snd, ←Sup_closed_unit_ball_eq_nnnorm, star_snd, mul_apply], + simp only [←@op_nnnorm_mul 𝕜 A], + simp only [←Sup_closed_unit_ball_eq_nnnorm, mul_apply'], + refine cSup_eq_of_forall_le_of_forall_lt_exists_gt (hball.image _) _ (λ r hr, _), + { rintro - ⟨x, hx, rfl⟩, + refine cSup_le (hball.image _) _, + rintro - ⟨y, hy, rfl⟩, + exact key x y (mem_closed_ball_zero_iff.1 hx) (mem_closed_ball_zero_iff.1 hy) }, + { simp only [set.mem_image, set.mem_set_of_eq, exists_prop, exists_exists_and_eq_and], + have hr' : r.sqrt < ‖a‖₊ := (‖a‖₊).sqrt_mul_self ▸ nnreal.sqrt_lt_sqrt_iff.2 hr, + simp_rw [←nnnorm_fst, ←Sup_closed_unit_ball_eq_nnnorm] at hr', + obtain ⟨_, ⟨x, hx, rfl⟩, hxr⟩ := exists_lt_of_lt_cSup (hball.image _) hr', + have hx' : ‖x‖₊ ≤ 1 := mem_closed_ball_zero_iff.1 hx, + refine ⟨star x, mem_closed_ball_zero_iff.2 ((nnnorm_star x).trans_le hx'), _⟩, + refine lt_cSup_of_lt _ ⟨x, hx, rfl⟩ _, + { refine ⟨‖a‖₊ * ‖a‖₊, _⟩, + rintros - ⟨y, hy, rfl⟩, + exact key (star x) y ((nnnorm_star x).trans_le hx') (mem_closed_ball_zero_iff.1 hy) }, + { simpa only [a.central, star_star, cstar_ring.nnnorm_star_mul_self, nnreal.sq_sqrt, ←sq] + using pow_lt_pow_of_lt_left hxr zero_le' two_pos } } + end } + +end densely_normed + +end double_centralizer diff --git a/src/analysis/normed_space/star/spectrum.lean b/src/analysis/normed_space/star/spectrum.lean index 4575aad083a64..2680b98fdefa0 100644 --- a/src/analysis/normed_space/star/spectrum.lean +++ b/src/analysis/normed_space/star/spectrum.lean @@ -5,16 +5,21 @@ Authors: Jireh Loreaux -/ import analysis.normed_space.star.basic import analysis.normed_space.spectrum -import algebra.star.module -import analysis.normed_space.star.exponential +import analysis.special_functions.exponential +import algebra.star.star_alg_hom /-! # Spectral properties in C⋆-algebras -In this file, we establish various propreties related to the spectrum of elements in C⋆-algebras. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +In this file, we establish various properties related to the spectrum of elements in C⋆-algebras. -/ local postfix `⋆`:std.prec.max_plus := star -open_locale topological_space ennreal +section + +open_locale topology ennreal open filter ennreal spectrum cstar_ring section unitary_spectrum @@ -22,17 +27,18 @@ section unitary_spectrum variables {𝕜 : Type*} [normed_field 𝕜] {E : Type*} [normed_ring E] [star_ring E] [cstar_ring E] -[normed_algebra 𝕜 E] [complete_space E] [nontrivial E] +[normed_algebra 𝕜 E] [complete_space E] lemma unitary.spectrum_subset_circle (u : unitary E) : spectrum 𝕜 (u : E) ⊆ metric.sphere 0 1 := begin + nontriviality E, refine λ k hk, mem_sphere_zero_iff_norm.mpr (le_antisymm _ _), { simpa only [cstar_ring.norm_coe_unitary u] using norm_le_norm_of_mem hk }, { rw ←unitary.coe_to_units_apply u at hk, have hnk := ne_zero_of_mem_of_unit hk, rw [←inv_inv (unitary.to_units u), ←spectrum.map_inv, set.mem_inv] at hk, - have : ∥k∥⁻¹ ≤ ∥↑((unitary.to_units u)⁻¹)∥, simpa only [norm_inv] using norm_le_norm_of_mem hk, + have : ‖k‖⁻¹ ≤ ‖↑((unitary.to_units u)⁻¹)‖, simpa only [norm_inv] using norm_le_norm_of_mem hk, simpa using inv_le_of_inv_le (norm_pos_iff.mpr hnk) this } end @@ -51,28 +57,26 @@ variables {A : Type*} local notation `↑ₐ` := algebra_map ℂ A -lemma spectral_radius_eq_nnnorm_of_self_adjoint [norm_one_class A] {a : A} - (ha : a ∈ self_adjoint A) : - spectral_radius ℂ a = ∥a∥₊ := +lemma is_self_adjoint.spectral_radius_eq_nnnorm {a : A} + (ha : is_self_adjoint a) : + spectral_radius ℂ a = ‖a‖₊ := begin - have hconst : tendsto (λ n : ℕ, (∥a∥₊ : ℝ≥0∞)) at_top _ := tendsto_const_nhds, + have hconst : tendsto (λ n : ℕ, (‖a‖₊ : ℝ≥0∞)) at_top _ := tendsto_const_nhds, refine tendsto_nhds_unique _ hconst, convert (spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius (a : A)).comp - (nat.tendsto_pow_at_top_at_top_of_one_lt (by linarith : 1 < 2)), + (nat.tendsto_pow_at_top_at_top_of_one_lt one_lt_two), refine funext (λ n, _), - rw [function.comp_app, nnnorm_pow_two_pow_of_self_adjoint ha, ennreal.coe_pow, ←rpow_nat_cast, + rw [function.comp_app, ha.nnnorm_pow_two_pow, ennreal.coe_pow, ←rpow_nat_cast, ←rpow_mul], simp, end -lemma spectral_radius_eq_nnnorm_of_star_normal [norm_one_class A] (a : A) [is_star_normal a] : - spectral_radius ℂ a = ∥a∥₊ := +lemma is_star_normal.spectral_radius_eq_nnnorm (a : A) [is_star_normal a] : + spectral_radius ℂ a = ‖a‖₊ := begin refine (ennreal.pow_strict_mono two_ne_zero).injective _, - have ha : a⋆ * a ∈ self_adjoint A, - from self_adjoint.mem_iff.mpr (by simpa only [star_star] using (star_mul a⋆ a)), - have heq : (λ n : ℕ, ((∥(a⋆ * a) ^ n∥₊ ^ (1 / n : ℝ)) : ℝ≥0∞)) - = (λ x, x ^ 2) ∘ (λ n : ℕ, ((∥a ^ n∥₊ ^ (1 / n : ℝ)) : ℝ≥0∞)), + have heq : (λ n : ℕ, ((‖(a⋆ * a) ^ n‖₊ ^ (1 / n : ℝ)) : ℝ≥0∞)) + = (λ x, x ^ 2) ∘ (λ n : ℕ, ((‖a ^ n‖₊ ^ (1 / n : ℝ)) : ℝ≥0∞)), { funext, rw [function.comp_apply, ←rpow_nat_cast, ←rpow_mul, mul_comm, rpow_mul, rpow_nat_cast, ←coe_pow, sq, ←nnnorm_star_mul_self, commute.mul_pow (star_comm_self' a), star_pow], }, @@ -80,13 +84,15 @@ begin (spectrum.pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius a), rw ←heq at h₂, convert tendsto_nhds_unique h₂ (pow_nnnorm_pow_one_div_tendsto_nhds_spectral_radius (a⋆ * a)), - rw [spectral_radius_eq_nnnorm_of_self_adjoint ha, sq, nnnorm_star_mul_self, coe_mul], + rw [(is_self_adjoint.star_mul_self a).spectral_radius_eq_nnnorm, sq, nnnorm_star_mul_self, + coe_mul], end /-- Any element of the spectrum of a selfadjoint is real. -/ -theorem self_adjoint.mem_spectrum_eq_re [star_module ℂ A] [nontrivial A] {a : A} - (ha : a ∈ self_adjoint A) {z : ℂ} (hz : z ∈ spectrum ℂ a) : z = z.re := +theorem is_self_adjoint.mem_spectrum_eq_re [star_module ℂ A] {a : A} + (ha : is_self_adjoint a) {z : ℂ} (hz : z ∈ spectrum ℂ a) : z = z.re := begin + have hu := exp_mem_unitary_of_mem_skew_adjoint ℂ (ha.smul_mem_skew_adjoint conj_I), let Iu := units.mk0 I I_ne_zero, have : exp ℂ (I • z) ∈ spectrum ℂ (exp ℂ (I • a)), by simpa only [units.smul_def, units.coe_mk0] @@ -94,24 +100,107 @@ begin exact complex.ext (of_real_re _) (by simpa only [←complex.exp_eq_exp_ℂ, mem_sphere_zero_iff_norm, norm_eq_abs, abs_exp, real.exp_eq_one_iff, smul_eq_mul, I_mul, neg_eq_zero] - using spectrum.subset_circle_of_unitary (self_adjoint.exp_i_smul_unitary ha) this), + using spectrum.subset_circle_of_unitary hu this), end /-- Any element of the spectrum of a selfadjoint is real. -/ -theorem self_adjoint.mem_spectrum_eq_re' [star_module ℂ A] [nontrivial A] +theorem self_adjoint.mem_spectrum_eq_re [star_module ℂ A] (a : self_adjoint A) {z : ℂ} (hz : z ∈ spectrum ℂ (a : A)) : z = z.re := -self_adjoint.mem_spectrum_eq_re a.property hz +a.prop.mem_spectrum_eq_re hz /-- The spectrum of a selfadjoint is real -/ -theorem self_adjoint.coe_re_map_spectrum [star_module ℂ A] [nontrivial A] {a : A} - (ha : a ∈ self_adjoint A) : spectrum ℂ a = (coe ∘ re '' (spectrum ℂ a) : set ℂ) := -le_antisymm (λ z hz, ⟨z, hz, (self_adjoint.mem_spectrum_eq_re ha hz).symm⟩) (λ z, by +theorem is_self_adjoint.coe_re_map_spectrum [star_module ℂ A] {a : A} + (ha : is_self_adjoint a) : spectrum ℂ a = (coe ∘ re '' (spectrum ℂ a) : set ℂ) := +le_antisymm (λ z hz, ⟨z, hz, (ha.mem_spectrum_eq_re hz).symm⟩) (λ z, by { rintros ⟨z, hz, rfl⟩, - simpa only [(self_adjoint.mem_spectrum_eq_re ha hz).symm, function.comp_app] using hz }) + simpa only [(ha.mem_spectrum_eq_re hz).symm, function.comp_app] using hz }) /-- The spectrum of a selfadjoint is real -/ -theorem self_adjoint.coe_re_map_spectrum' [star_module ℂ A] [nontrivial A] (a : self_adjoint A) : +theorem self_adjoint.coe_re_map_spectrum [star_module ℂ A] (a : self_adjoint A) : spectrum ℂ (a : A) = (coe ∘ re '' (spectrum ℂ (a : A)) : set ℂ) := -self_adjoint.coe_re_map_spectrum a.property +a.property.coe_re_map_spectrum end complex_scalars + +namespace star_alg_hom + +variables {F A B : Type*} +[normed_ring A] [normed_algebra ℂ A] [complete_space A] [star_ring A] [cstar_ring A] +[normed_ring B] [normed_algebra ℂ B] [complete_space B] [star_ring B] [cstar_ring B] +[hF : star_alg_hom_class F ℂ A B] (φ : F) +include hF + +/-- A star algebra homomorphism of complex C⋆-algebras is norm contractive. -/ +lemma nnnorm_apply_le (a : A) : ‖(φ a : B)‖₊ ≤ ‖a‖₊ := +begin + suffices : ∀ s : A, is_self_adjoint s → ‖φ s‖₊ ≤ ‖s‖₊, + { exact nonneg_le_nonneg_of_sq_le_sq zero_le' + (by simpa only [nnnorm_star_mul_self, map_star, map_mul] + using this _ (is_self_adjoint.star_mul_self a)) }, + { intros s hs, + simpa only [hs.spectral_radius_eq_nnnorm, (hs.star_hom_apply φ).spectral_radius_eq_nnnorm, + coe_le_coe] using (show spectral_radius ℂ (φ s) ≤ spectral_radius ℂ s, + from supr_le_supr_of_subset (alg_hom.spectrum_apply_subset φ s)) } +end + +/-- A star algebra homomorphism of complex C⋆-algebras is norm contractive. -/ +lemma norm_apply_le (a : A) : ‖(φ a : B)‖ ≤ ‖a‖ := nnnorm_apply_le φ a + +/-- Star algebra homomorphisms between C⋆-algebras are continuous linear maps. +See note [lower instance priority] -/ +@[priority 100] +noncomputable instance : continuous_linear_map_class F ℂ A B := +{ map_continuous := λ φ, add_monoid_hom_class.continuous_of_bound φ 1 + (by simpa only [one_mul] using nnnorm_apply_le φ), + .. alg_hom_class.linear_map_class } + +end star_alg_hom + +end + +namespace weak_dual + +open continuous_map complex +open_locale complex_star_module + +variables {F A : Type*} [normed_ring A] [normed_algebra ℂ A] [complete_space A] + [star_ring A] [cstar_ring A] [star_module ℂ A] [hF : alg_hom_class F ℂ A ℂ] + +include hF + +/-- This instance is provided instead of `star_alg_hom_class` to avoid type class inference loops. +See note [lower instance priority] -/ +@[priority 100] +noncomputable instance : star_hom_class F A ℂ := +{ coe := λ φ, φ, + coe_injective' := fun_like.coe_injective', + map_star := λ φ a, + begin + suffices hsa : ∀ s : self_adjoint A, (φ s)⋆ = φ s, + { rw ←real_part_add_I_smul_imaginary_part a, + simp only [map_add, map_smul, star_add, star_smul, hsa, self_adjoint.star_coe_eq] }, + { intros s, + have := alg_hom.apply_mem_spectrum φ (s : A), + rw self_adjoint.coe_re_map_spectrum s at this, + rcases this with ⟨⟨_, _⟩, _, heq⟩, + rw [←heq, is_R_or_C.star_def, is_R_or_C.conj_of_real] } + end } + +/-- This is not an instance to avoid type class inference loops. See +`weak_dual.complex.star_hom_class`. -/ +noncomputable def _root_.alg_hom_class.star_alg_hom_class : star_alg_hom_class F ℂ A ℂ := +{ coe := λ f, f, + .. weak_dual.complex.star_hom_class, + .. hF } + +omit hF + +namespace character_space + +noncomputable instance : star_alg_hom_class (character_space ℂ A) ℂ A ℂ := +{ coe := λ f, f, + .. alg_hom_class.star_alg_hom_class } + +end character_space + +end weak_dual diff --git a/src/analysis/normed_space/triv_sq_zero_ext.lean b/src/analysis/normed_space/triv_sq_zero_ext.lean new file mode 100644 index 0000000000000..4f10169ef1883 --- /dev/null +++ b/src/analysis/normed_space/triv_sq_zero_ext.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import analysis.normed_space.basic +import analysis.normed_space.exponential +import topology.instances.triv_sq_zero_ext + +/-! +# Results on `triv_sq_zero_ext R M` related to the norm + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For now, this file contains results about `exp` for this type. + +## Main results + +* `triv_sq_zero_ext.fst_exp` +* `triv_sq_zero_ext.snd_exp` +* `triv_sq_zero_ext.exp_inl` +* `triv_sq_zero_ext.exp_inr` + +## TODO + +* Actually define a sensible norm on `triv_sq_zero_ext R M`, so that we have access to lemmas + like `exp_add`. +* Generalize more of these results to non-commutative `R`. In principle, under sufficient conditions + we should expect + `(exp 𝕜 x).snd = ∫ t in 0..1, exp 𝕜 (t • x.fst) • op (exp 𝕜 ((1 - t) • x.fst)) • x.snd` + ([Physics.SE](https://physics.stackexchange.com/a/41671/185147), and + https://link.springer.com/chapter/10.1007/978-3-540-44953-9_2). + +-/ + +variables (𝕜 : Type*) {R M : Type*} + +local notation `tsze` := triv_sq_zero_ext + +namespace triv_sq_zero_ext + +section topology +variables [topological_space R] [topological_space M] + +/-- If `exp R x.fst` converges to `e` then `(exp R x).fst` converges to `e`. -/ +lemma has_sum_fst_exp_series [field 𝕜] [ring R] + [add_comm_group M] [algebra 𝕜 R] + [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] + [module 𝕜 M] [is_scalar_tower 𝕜 R M] [is_scalar_tower 𝕜 Rᵐᵒᵖ M] + [topological_ring R] [topological_add_group M] + [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] + (x : tsze R M) + {e : R} (h : has_sum (λ n, exp_series 𝕜 R n (λ _, x.fst)) e) : + has_sum (λ n, fst (exp_series 𝕜 (tsze R M) n (λ _, x))) e := +by simpa [exp_series_apply_eq] using h + +/-- If `exp R x.fst` converges to `e` then `(exp R x).snd` converges to `e • x.snd`. -/ +lemma has_sum_snd_exp_series_of_smul_comm [field 𝕜] [char_zero 𝕜] [ring R] + [add_comm_group M] [algebra 𝕜 R] + [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] + [module 𝕜 M] [is_scalar_tower 𝕜 R M] [is_scalar_tower 𝕜 Rᵐᵒᵖ M] + [topological_ring R] [topological_add_group M] + [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] + (x : tsze R M) (hx : mul_opposite.op x.fst • x.snd = x.fst • x.snd) + {e : R} (h : has_sum (λ n, exp_series 𝕜 R n (λ _, x.fst)) e) : + has_sum (λ n, snd (exp_series 𝕜 (tsze R M) n (λ _, x))) (e • x.snd) := +begin + simp_rw [exp_series_apply_eq] at *, + conv + { congr, + funext, + rw [snd_smul, snd_pow_of_smul_comm _ _ hx, nsmul_eq_smul_cast 𝕜 n, smul_smul, inv_mul_eq_div, + ←inv_div, ←smul_assoc], }, + apply has_sum.smul_const, + rw [←has_sum_nat_add_iff' 1], swap, apply_instance, + rw [finset.range_one, finset.sum_singleton, nat.cast_zero, div_zero, inv_zero, zero_smul, + sub_zero], + simp_rw [←nat.succ_eq_add_one, nat.pred_succ, nat.factorial_succ, nat.cast_mul, + ←nat.succ_eq_add_one, + mul_div_cancel_left _ ((@nat.cast_ne_zero 𝕜 _ _ _).mpr $ nat.succ_ne_zero _)], + exact h, +end + +/-- If `exp R x.fst` converges to `e` then `exp R x` converges to `inl e + inr (e • x.snd)`. -/ +lemma has_sum_exp_series_of_smul_comm [field 𝕜] [char_zero 𝕜] [ring R] + [add_comm_group M] [algebra 𝕜 R] + [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] + [module 𝕜 M] [is_scalar_tower 𝕜 R M] [is_scalar_tower 𝕜 Rᵐᵒᵖ M] + [topological_ring R] [topological_add_group M] + [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] + (x : tsze R M) (hx : mul_opposite.op x.fst • x.snd = x.fst • x.snd) + {e : R} (h : has_sum (λ n, exp_series 𝕜 R n (λ _, x.fst)) e) : + has_sum (λ n, exp_series 𝕜 (tsze R M) n (λ _, x)) (inl e + inr (e • x.snd)) := +by simpa only [inl_fst_add_inr_snd_eq] using + (has_sum_inl _ $ has_sum_fst_exp_series 𝕜 x h).add + (has_sum_inr _ $ has_sum_snd_exp_series_of_smul_comm 𝕜 x hx h) + +end topology + +section normed_ring +variables [is_R_or_C 𝕜] [normed_ring R] [add_comm_group M] +variables [normed_algebra 𝕜 R] [module R M] [module Rᵐᵒᵖ M] [smul_comm_class R Rᵐᵒᵖ M] +variables [module 𝕜 M] [is_scalar_tower 𝕜 R M] [is_scalar_tower 𝕜 Rᵐᵒᵖ M] +variables [topological_space M] [topological_ring R] +variables [topological_add_group M] [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] +variables [complete_space R] [t2_space R] [t2_space M] + +lemma exp_def_of_smul_comm (x : tsze R M) (hx : mul_opposite.op x.fst • x.snd = x.fst • x.snd) : + exp 𝕜 x = inl (exp 𝕜 x.fst) + inr (exp 𝕜 x.fst • x.snd) := +begin + simp_rw [exp, formal_multilinear_series.sum], + refine (has_sum_exp_series_of_smul_comm 𝕜 x hx _).tsum_eq, + exact exp_series_has_sum_exp _, +end + +@[simp] lemma exp_inl (x : R) : exp 𝕜 (inl x : tsze R M) = inl (exp 𝕜 x) := +begin + rw [exp_def_of_smul_comm, snd_inl, fst_inl, smul_zero, inr_zero, add_zero], + { rw [snd_inl, fst_inl, smul_zero, smul_zero] } +end + +@[simp] lemma exp_inr (m : M) : exp 𝕜 (inr m : tsze R M) = 1 + inr m := +begin + rw [exp_def_of_smul_comm, snd_inr, fst_inr, exp_zero, one_smul, inl_one], + { rw [snd_inr, fst_inr, mul_opposite.op_zero, zero_smul, zero_smul] } +end + +end normed_ring + +section normed_comm_ring +variables [is_R_or_C 𝕜] [normed_comm_ring R] [add_comm_group M] +variables [normed_algebra 𝕜 R] [module R M] [module Rᵐᵒᵖ M] [is_central_scalar R M] +variables [module 𝕜 M] [is_scalar_tower 𝕜 R M] +variables [topological_space M] [topological_ring R] +variables [topological_add_group M] [has_continuous_smul R M] +variables [complete_space R] [t2_space R] [t2_space M] + +lemma exp_def (x : tsze R M) : exp 𝕜 x = inl (exp 𝕜 x.fst) + inr (exp 𝕜 x.fst • x.snd) := +exp_def_of_smul_comm 𝕜 x (op_smul_eq_smul _ _) + +@[simp] lemma fst_exp (x : tsze R M) : fst (exp 𝕜 x) = exp 𝕜 x.fst := +by rw [exp_def, fst_add, fst_inl, fst_inr, add_zero] + +@[simp] lemma snd_exp (x : tsze R M) : snd (exp 𝕜 x) = exp 𝕜 x.fst • x.snd := +by rw [exp_def, snd_add, snd_inl, snd_inr, zero_add] + +/-- Polar form of trivial-square-zero extension. -/ +lemma eq_smul_exp_of_invertible (x : tsze R M) [invertible x.fst] : + x = x.fst • exp 𝕜 (⅟x.fst • inr x.snd) := +by rw [←inr_smul, exp_inr, smul_add, ←inl_one, ←inl_smul, ←inr_smul, smul_eq_mul, mul_one, + smul_smul, mul_inv_of_self, one_smul, inl_fst_add_inr_snd_eq] + +end normed_comm_ring + +section normed_field +variables [is_R_or_C 𝕜] [normed_field R] [add_comm_group M] +variables [normed_algebra 𝕜 R] [module R M] [module Rᵐᵒᵖ M] [is_central_scalar R M] +variables [module 𝕜 M] [is_scalar_tower 𝕜 R M] +variables [topological_space M] [topological_ring R] +variables [topological_add_group M] [has_continuous_smul R M] +variables [complete_space R] [t2_space R] [t2_space M] + +/-- More convenient version of `triv_sq_zero_ext.eq_smul_exp_of_invertible` for when `R` is a +field. -/ +lemma eq_smul_exp_of_ne_zero (x : tsze R M) (hx : x.fst ≠ 0) : + x = x.fst • exp 𝕜 (x.fst⁻¹ • inr x.snd) := +begin + letI : invertible x.fst := invertible_of_nonzero hx, + exact eq_smul_exp_of_invertible _ _ +end + +end normed_field + +end triv_sq_zero_ext diff --git a/src/analysis/normed_space/units.lean b/src/analysis/normed_space/units.lean index 2115426c1fa3c..c42e8fcb34961 100644 --- a/src/analysis/normed_space/units.lean +++ b/src/analysis/normed_space/units.lean @@ -3,11 +3,15 @@ Copyright (c) 2020 Heather Macbeth. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Heather Macbeth -/ +import topology.algebra.ring.ideal import analysis.specific_limits.normed /-! # The group of units of a complete normed ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the basic theory for the group of units (invertible elements) of a complete normed ring (Banach algebras being a notable special case). @@ -28,7 +32,7 @@ a unit and 0 if not. The other major results of this file (notably `inverse_add -/ noncomputable theory -open_locale topological_space +open_locale topology variables {R : Type*} [normed_ring R] [complete_space R] namespace units @@ -36,32 +40,32 @@ namespace units /-- In a complete normed ring, a perturbation of `1` by an element `t` of distance less than `1` from `1` is a unit. Here we construct its `units` structure. -/ @[simps coe] -def one_sub (t : R) (h : ∥t∥ < 1) : Rˣ := +def one_sub (t : R) (h : ‖t‖ < 1) : Rˣ := { val := 1 - t, inv := ∑' n : ℕ, t ^ n, val_inv := mul_neg_geom_series t h, inv_val := geom_series_mul_neg t h } /-- In a complete normed ring, a perturbation of a unit `x` by an element `t` of distance less than -`∥x⁻¹∥⁻¹` from `x` is a unit. Here we construct its `units` structure. -/ +`‖x⁻¹‖⁻¹` from `x` is a unit. Here we construct its `units` structure. -/ @[simps coe] -def add (x : Rˣ) (t : R) (h : ∥t∥ < ∥(↑x⁻¹ : R)∥⁻¹) : Rˣ := +def add (x : Rˣ) (t : R) (h : ‖t‖ < ‖(↑x⁻¹ : R)‖⁻¹) : Rˣ := units.copy -- to make `coe_add` true definitionally, for convenience (x * (units.one_sub (-(↑x⁻¹ * t)) begin nontriviality R using [zero_lt_one], - have hpos : 0 < ∥(↑x⁻¹ : R)∥ := units.norm_pos x⁻¹, - calc ∥-(↑x⁻¹ * t)∥ - = ∥↑x⁻¹ * t∥ : by { rw norm_neg } - ... ≤ ∥(↑x⁻¹ : R)∥ * ∥t∥ : norm_mul_le ↑x⁻¹ _ - ... < ∥(↑x⁻¹ : R)∥ * ∥(↑x⁻¹ : R)∥⁻¹ : by nlinarith only [h, hpos] + have hpos : 0 < ‖(↑x⁻¹ : R)‖ := units.norm_pos x⁻¹, + calc ‖-(↑x⁻¹ * t)‖ + = ‖↑x⁻¹ * t‖ : by { rw norm_neg } + ... ≤ ‖(↑x⁻¹ : R)‖ * ‖t‖ : norm_mul_le ↑x⁻¹ _ + ... < ‖(↑x⁻¹ : R)‖ * ‖(↑x⁻¹ : R)‖⁻¹ : by nlinarith only [h, hpos] ... = 1 : mul_inv_cancel (ne_of_gt hpos) end)) (x + t) (by simp [mul_add]) _ rfl -/-- In a complete normed ring, an element `y` of distance less than `∥x⁻¹∥⁻¹` from `x` is a unit. +/-- In a complete normed ring, an element `y` of distance less than `‖x⁻¹‖⁻¹` from `x` is a unit. Here we construct its `units` structure. -/ @[simps coe] -def unit_of_nearby (x : Rˣ) (y : R) (h : ∥y - x∥ < ∥(↑x⁻¹ : R)∥⁻¹) : Rˣ := +def unit_of_nearby (x : Rˣ) (y : R) (h : ‖y - x‖ < ‖(↑x⁻¹ : R)‖⁻¹) : Rˣ := units.copy (x.add (y - x : R) h) y (by simp) _ rfl /-- The group of units of a complete normed ring is an open subset of the ring. -/ @@ -70,7 +74,7 @@ begin nontriviality R, apply metric.is_open_iff.mpr, rintros x' ⟨x, rfl⟩, - refine ⟨∥(↑x⁻¹ : R)∥⁻¹, _root_.inv_pos.mpr (units.norm_pos x⁻¹), _⟩, + refine ⟨‖(↑x⁻¹ : R)‖⁻¹, _root_.inv_pos.mpr (units.norm_pos x⁻¹), _⟩, intros y hy, rw [metric.mem_ball, dist_eq_norm] at hy, exact (x.unit_of_nearby y hy).is_unit @@ -81,11 +85,24 @@ is_open.mem_nhds units.is_open x.is_unit end units +namespace nonunits + +/-- The `nonunits` in a complete normed ring are contained in the complement of the ball of radius +`1` centered at `1 : R`. -/ +lemma subset_compl_ball : nonunits R ⊆ (metric.ball (1 : R) 1)ᶜ := +set.subset_compl_comm.mp $ λ x hx, by simpa [sub_sub_self, units.coe_one_sub] using + (units.one_sub (1 - x) (by rwa [metric.mem_ball, dist_eq_norm, norm_sub_rev] at hx)).is_unit + +/- The `nonunits` in a complete normed ring are a closed set -/ +protected lemma is_closed : is_closed (nonunits R) := units.is_open.is_closed_compl + +end nonunits + namespace normed_ring open_locale classical big_operators open asymptotics filter metric finset ring -lemma inverse_one_sub (t : R) (h : ∥t∥ < 1) : inverse (1 - t) = ↑(units.one_sub t h)⁻¹ := +lemma inverse_one_sub (t : R) (h : ‖t‖ < 1) : inverse (1 - t) = ↑(units.one_sub t h)⁻¹ := by rw [← inverse_unit (units.one_sub t h), units.coe_one_sub] /-- The formula `inverse (x + t) = inverse (1 + x⁻¹ * t) * x⁻¹` holds for `t` sufficiently small. -/ @@ -94,11 +111,11 @@ lemma inverse_add (x : Rˣ) : begin nontriviality R, rw [eventually_iff, metric.mem_nhds_iff], - have hinv : 0 < ∥(↑x⁻¹ : R)∥⁻¹, by cancel_denoms, - use [∥(↑x⁻¹ : R)∥⁻¹, hinv], + have hinv : 0 < ‖(↑x⁻¹ : R)‖⁻¹, by cancel_denoms, + use [‖(↑x⁻¹ : R)‖⁻¹, hinv], intros t ht, simp only [mem_ball, dist_zero_right] at ht, - have ht' : ∥-↑x⁻¹ * t∥ < 1, + have ht' : ‖-↑x⁻¹ * t‖ < 1, { refine lt_of_le_of_lt (norm_mul_le _ _) _, rw norm_neg, refine lt_of_lt_of_le (mul_lt_mul_of_pos_left ht x⁻¹.norm_pos) _, @@ -120,14 +137,14 @@ begin simp only [inverse_one_sub t ht, set.mem_set_of_eq], have h : 1 = ((range n).sum (λ i, t ^ i)) * (units.one_sub t ht) + t ^ n, { simp only [units.coe_one_sub], - rw [← geom_sum, geom_sum_mul_neg], + rw [geom_sum_mul_neg], simp }, rw [← one_mul ↑(units.one_sub t ht)⁻¹, h, add_mul], congr, { rw [mul_assoc, (units.one_sub t ht).mul_inv], simp }, { simp only [units.coe_one_sub], - rw [← add_mul, ← geom_sum, geom_sum_mul_neg], + rw [← add_mul, geom_sum_mul_neg], simp } end @@ -152,19 +169,19 @@ begin simp [h2.symm] end -lemma inverse_one_sub_norm : is_O (λ t, inverse ((1:R) - t)) (λ t, (1:ℝ)) (𝓝 (0:R)) := +lemma inverse_one_sub_norm : (λ t : R, inverse (1 - t)) =O[𝓝 0] (λ t, 1 : R → ℝ) := begin simp only [is_O, is_O_with, eventually_iff, metric.mem_nhds_iff], - refine ⟨∥(1:R)∥ + 1, (2:ℝ)⁻¹, by norm_num, _⟩, + refine ⟨‖(1:R)‖ + 1, (2:ℝ)⁻¹, by norm_num, _⟩, intros t ht, simp only [ball, dist_zero_right, set.mem_set_of_eq] at ht, - have ht' : ∥t∥ < 1, + have ht' : ‖t‖ < 1, { have : (2:ℝ)⁻¹ < 1 := by cancel_denoms, linarith }, simp only [inverse_one_sub t ht', norm_one, mul_one, set.mem_set_of_eq], - change ∥∑' n : ℕ, t ^ n∥ ≤ _, + change ‖∑' n : ℕ, t ^ n‖ ≤ _, have := normed_ring.tsum_geometric_of_norm_lt_1 t ht', - have : (1 - ∥t∥)⁻¹ ≤ 2, + have : (1 - ‖t‖)⁻¹ ≤ 2, { rw ← inv_inv (2:ℝ), refine inv_le_inv_of_le (by norm_num) _, have : (2:ℝ)⁻¹ + (2:ℝ)⁻¹ = 1 := by ring, @@ -173,11 +190,11 @@ begin end /-- The function `λ t, inverse (x + t)` is O(1) as `t → 0`. -/ -lemma inverse_add_norm (x : Rˣ) : is_O (λ t, inverse (↑x + t)) (λ t, (1:ℝ)) (𝓝 (0:R)) := +lemma inverse_add_norm (x : Rˣ) : (λ t : R, inverse (↑x + t)) =O[𝓝 0] (λ t, (1:ℝ)) := begin simp only [is_O_iff, norm_one, mul_one], cases is_O_iff.mp (@inverse_one_sub_norm R _ _) with C hC, - use C * ∥((x⁻¹:Rˣ):R)∥, + use C * ‖((x⁻¹:Rˣ):R)‖, have hzero : tendsto (λ t, - (↑x⁻¹ : R) * t) (𝓝 0) (𝓝 0), { convert ((mul_left_continuous (-↑x⁻¹ : R)).tendsto 0).comp tendsto_id, simp }, @@ -193,15 +210,15 @@ end `λ t, inverse (x + t) - (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹` is `O(t ^ n)` as `t → 0`. -/ lemma inverse_add_norm_diff_nth_order (x : Rˣ) (n : ℕ) : - is_O (λ (t : R), inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹) - (λ t, ∥t∥ ^ n) (𝓝 (0:R)) := + (λ t : R, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹) =O[𝓝 (0:R)] + (λ t, ‖t‖ ^ n) := begin by_cases h : n = 0, { simpa [h] using inverse_add_norm x }, have hn : 0 < n := nat.pos_of_ne_zero h, simp [is_O_iff], cases (is_O_iff.mp (inverse_add_norm x)) with C hC, - use C * ∥(1:ℝ)∥ * ∥(↑x⁻¹ : R)∥ ^ n, + use C * ‖(1:ℝ)‖ * ‖(↑x⁻¹ : R)‖ ^ n, have h : eventually_eq (𝓝 (0:R)) (λ t, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹) (λ t, ((- ↑x⁻¹ * t) ^ n) * inverse (x + t)), @@ -214,13 +231,13 @@ begin simp only [neg_mul] at hLHS, rw hLHS, refine le_trans (norm_mul_le _ _ ) _, - have h' : ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n, - { calc ∥(-(↑x⁻¹ * t)) ^ n∥ ≤ ∥(-(↑x⁻¹ * t))∥ ^ n : norm_pow_le' _ hn - ... = ∥↑x⁻¹ * t∥ ^ n : by rw norm_neg - ... ≤ (∥(↑x⁻¹ : R)∥ * ∥t∥) ^ n : _ - ... = ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n : mul_pow _ _ n, + have h' : ‖(-(↑x⁻¹ * t)) ^ n‖ ≤ ‖(↑x⁻¹ : R)‖ ^ n * ‖t‖ ^ n, + { calc ‖(-(↑x⁻¹ * t)) ^ n‖ ≤ ‖(-(↑x⁻¹ * t))‖ ^ n : norm_pow_le' _ hn + ... = ‖↑x⁻¹ * t‖ ^ n : by rw norm_neg + ... ≤ (‖(↑x⁻¹ : R)‖ * ‖t‖) ^ n : _ + ... = ‖(↑x⁻¹ : R)‖ ^ n * ‖t‖ ^ n : mul_pow _ _ n, exact pow_le_pow_of_le_left (norm_nonneg _) (norm_mul_le ↑x⁻¹ t) n }, - have h'' : 0 ≤ ∥(↑x⁻¹ : R)∥ ^ n * ∥t∥ ^ n, + have h'' : 0 ≤ ‖(↑x⁻¹ : R)‖ ^ n * ‖t‖ ^ n, { refine mul_nonneg _ _; exact pow_nonneg (norm_nonneg _) n }, nlinarith [norm_nonneg (inverse (↑x + t))], @@ -228,14 +245,14 @@ end /-- The function `λ t, inverse (x + t) - x⁻¹` is `O(t)` as `t → 0`. -/ lemma inverse_add_norm_diff_first_order (x : Rˣ) : - is_O (λ t, inverse (↑x + t) - ↑x⁻¹) (λ t, ∥t∥) (𝓝 (0:R)) := + (λ t : R, inverse (↑x + t) - ↑x⁻¹) =O[𝓝 0] (λ t, ‖t‖) := by simpa using inverse_add_norm_diff_nth_order x 1 /-- The function `λ t, inverse (x + t) - x⁻¹ + x⁻¹ * t * x⁻¹` is `O(t ^ 2)` as `t → 0`. -/ lemma inverse_add_norm_diff_second_order (x : Rˣ) : - is_O (λ t, inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) (λ t, ∥t∥ ^ 2) (𝓝 (0:R)) := + (λ t : R, inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) =O[𝓝 0] (λ t, ‖t‖ ^ 2) := begin convert inverse_add_norm_diff_nth_order x 2, ext t, @@ -247,7 +264,7 @@ end /-- The function `inverse` is continuous at each unit of `R`. -/ lemma inverse_continuous_at (x : Rˣ) : continuous_at inverse (x : R) := begin - have h_is_o : is_o (λ (t : R), inverse (↑x + t) - ↑x⁻¹) (λ _, 1 : R → ℝ) (𝓝 0) := + have h_is_o : (λ t : R, inverse (↑x + t) - ↑x⁻¹) =o[𝓝 0] (λ _, 1 : R → ℝ) := (inverse_add_norm_diff_first_order x).trans_is_o (is_o.norm_left $ is_o_id_const one_ne_zero), have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0), { refine tendsto_zero_iff_norm_tendsto_zero.mpr _, @@ -288,3 +305,25 @@ lemma open_embedding_coe : open_embedding (coe : Rˣ → R) := open_embedding_of_continuous_injective_open continuous_coe ext is_open_map_coe end units + +namespace ideal + +/-- An ideal which contains an element within `1` of `1 : R` is the unit ideal. -/ +lemma eq_top_of_norm_lt_one (I : ideal R) {x : R} (hxI : x ∈ I) (hx : ‖1 - x‖ < 1) : I = ⊤ := +let u := units.one_sub (1 - x) hx in (I.eq_top_iff_one.mpr $ + by simpa only [show u.inv * x = 1, by simp] using I.mul_mem_left u.inv hxI) + +/-- The `ideal.closure` of a proper ideal in a complete normed ring is proper. -/ +lemma closure_ne_top (I : ideal R) (hI : I ≠ ⊤) : I.closure ≠ ⊤ := +have h : _ := closure_minimal (coe_subset_nonunits hI) nonunits.is_closed, + by simpa only [I.closure.eq_top_iff_one, ne.def] using mt (@h 1) one_not_mem_nonunits + +/-- The `ideal.closure` of a maximal ideal in a complete normed ring is the ideal itself. -/ +lemma is_maximal.closure_eq {I : ideal R} (hI : I.is_maximal) : I.closure = I := +(hI.eq_of_le (I.closure_ne_top hI.ne_top) subset_closure).symm + +/-- Maximal ideals in complete normed rings are closed. -/ +instance is_maximal.is_closed {I : ideal R} [hI : I.is_maximal] : is_closed (I : set R) := +is_closed_of_closure_subset $ eq.subset $ congr_arg (coe : ideal R → set R) hI.closure_eq + +end ideal diff --git a/src/analysis/normed_space/weak_dual.lean b/src/analysis/normed_space/weak_dual.lean index 472fd416adc9c..2ead0b9970dee 100644 --- a/src/analysis/normed_space/weak_dual.lean +++ b/src/analysis/normed_space/weak_dual.lean @@ -10,6 +10,9 @@ import analysis.normed_space.operator_norm /-! # Weak dual of normed space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `E` be a normed space over a field `𝕜`. This file is concerned with properties of the weak-* topology on the dual of `E`. By the dual, we mean either of the type synonyms `normed_space.dual 𝕜 E` or `weak_dual 𝕜 E`, depending on whether it is viewed as equipped with its @@ -41,7 +44,7 @@ weak-* topology on (its type synonym) `weak_dual 𝕜 E`: coarser (not necessarily strictly) than the operator norm topology. * `weak_dual.is_compact_polar` (a version of the Banach-Alaoglu theorem): The polar set of a neighborhood of the origin in a normed space `E` over `𝕜` is compact in `weak_dual _ E`, if the - nondiscrete normed field `𝕜` is proper as a topological space. + nontrivially normed field `𝕜` is proper as a topological space. * `weak_dual.is_compact_closed_ball` (the most common special case of the Banach-Alaoglu theorem): Closed balls in the dual of a normed space `E` over `ℝ` or `ℂ` are compact in the weak-star topology. @@ -87,7 +90,7 @@ weak-star, weak dual noncomputable theory open filter function metric set -open_locale topological_space filter +open_locale topology filter /-! ### Weak star topology on duals of normed spaces @@ -98,8 +101,8 @@ i.e., that the weak-* topology is coarser (not necessarily strictly) than the to by the dual-norm (i.e. the operator-norm). -/ -variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] -variables {E : Type*} [semi_normed_group E] [normed_space 𝕜 E] +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] +variables {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E] namespace normed_space @@ -142,6 +145,8 @@ mapping). It is a linear equivalence. Here it is implemented as the inverse of t equivalence `normed_space.dual.to_weak_dual` in the other direction. -/ def to_normed_dual : weak_dual 𝕜 E ≃ₗ[𝕜] dual 𝕜 E := normed_space.dual.to_weak_dual.symm +lemma to_normed_dual_apply (x : weak_dual 𝕜 E) (y : E) : (to_normed_dual x) y = x y := rfl + @[simp] lemma coe_to_normed_dual (x' : weak_dual 𝕜 E) : ⇑(x'.to_normed_dual) = x' := rfl @[simp] lemma to_normed_dual_eq_iff (x' y' : weak_dual 𝕜 E) : @@ -162,7 +167,7 @@ variables (𝕜) weak-star topology is `weak_dual.polar 𝕜 s`. -/ def polar (s : set E) : set (weak_dual 𝕜 E) := to_normed_dual ⁻¹' polar 𝕜 s -lemma polar_def (s : set E) : polar 𝕜 s = {f : weak_dual 𝕜 E | ∀ x ∈ s, ∥f x∥ ≤ 1} := rfl +lemma polar_def (s : set E) : polar 𝕜 s = {f : weak_dual 𝕜 E | ∀ x ∈ s, ‖f x‖ ≤ 1} := rfl /-- The polar `polar 𝕜 s` of a set `s : E` is a closed subset when the weak star topology is used. -/ diff --git a/src/analysis/p_series.lean b/src/analysis/p_series.lean index 28bd743d1a821..20ecaa558a71a 100644 --- a/src/analysis/p_series.lean +++ b/src/analysis/p_series.lean @@ -3,11 +3,14 @@ Copyright (c) 2020 Yury G. Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury G. Kudryashov -/ -import analysis.special_functions.pow +import analysis.special_functions.pow.nnreal /-! # Convergence of `p`-series +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that the series `∑' k in ℕ, 1 / k ^ p` converges if and only if `p > 1`. The proof is based on the [Cauchy condensation test](https://en.wikipedia.org/wiki/Cauchy_condensation_test): `∑ k, f k` @@ -26,7 +29,7 @@ p-series, Cauchy condensation test -/ open filter -open_locale big_operators ennreal nnreal topological_space +open_locale big_operators ennreal nnreal topology /-! ### Cauchy condensation test @@ -122,7 +125,7 @@ begin split; intro h, { replace hf : ∀ m n, 1 < m → m ≤ n → (f n : ℝ≥0∞) ≤ f m := λ m n hm hmn, ennreal.coe_le_coe.2 (hf (zero_lt_one.trans hm) hmn), - simpa [h, ennreal.add_eq_top] using (ennreal.tsum_condensed_le hf) }, + simpa [h, ennreal.add_eq_top, ennreal.mul_eq_top] using ennreal.tsum_condensed_le hf }, { replace hf : ∀ m n, 0 < m → m ≤ n → (f n : ℝ≥0∞) ≤ f m := λ m n hm hmn, ennreal.coe_le_coe.2 (hf hm hmn), simpa [h, ennreal.add_eq_top] using (ennreal.le_tsum_condensed hf) } @@ -160,7 +163,7 @@ begin cases `0 ≤ p` and `p < 0` separately. -/ { rw ← summable_condensed_iff_of_nonneg, { simp_rw [nat.cast_pow, nat.cast_two, ← rpow_nat_cast, ← rpow_mul zero_lt_two.le, mul_comm _ p, - rpow_mul zero_lt_two.le, rpow_nat_cast, ← inv_pow₀, ← mul_pow, + rpow_mul zero_lt_two.le, rpow_nat_cast, ← inv_pow, ← mul_pow, summable_geometric_iff_norm_lt_1], nth_rewrite 0 [← rpow_one 2], rw [← division_def, ← rpow_sub zero_lt_two, norm_eq_abs, @@ -203,6 +206,26 @@ if and only if `1 < p`. -/ lemma real.summable_one_div_nat_pow {p : ℕ} : summable (λ n, 1 / n ^ p : ℕ → ℝ) ↔ 1 < p := by simp +/-- Summability of the `p`-series over `ℤ`. -/ +lemma real.summable_one_div_int_pow {p : ℕ} : summable (λ n:ℤ, 1 / (n : ℝ) ^ p) ↔ 1 < p := +begin + refine ⟨λ h, real.summable_one_div_nat_pow.mp (h.comp_injective nat.cast_injective), + λ h, summable_int_of_summable_nat (real.summable_one_div_nat_pow.mpr h) + (((real.summable_one_div_nat_pow.mpr h).mul_left $ 1 / (-1) ^ p).congr $ λ n, _)⟩, + conv_rhs { rw [int.cast_neg, neg_eq_neg_one_mul, mul_pow, ←div_div] }, + conv_lhs { rw [mul_div, mul_one], }, + refl, +end + +lemma real.summable_abs_int_rpow {b : ℝ} (hb : 1 < b) : summable (λ n : ℤ, |(n : ℝ)| ^ (-b)) := +begin + refine summable_int_of_summable_nat (_ : summable (λ n : ℕ, |(n : ℝ)| ^ _)) + (_ : summable (λ n : ℕ, |((-n : ℤ) : ℝ)| ^ _)), + work_on_goal 2 { simp_rw [int.cast_neg, int.cast_coe_nat, abs_neg] }, + all_goals { simp_rw (λ n : ℕ, abs_of_nonneg (n.cast_nonneg : 0 ≤ (n : ℝ))), + rwa [real.summable_nat_rpow, neg_lt_neg_iff] }, +end + /-- Harmonic series is not unconditionally summable. -/ lemma real.not_summable_nat_cast_inv : ¬summable (λ n, n⁻¹ : ℕ → ℝ) := have ¬summable (λ n, (n^1)⁻¹ : ℕ → ℝ), from mt real.summable_nat_pow_inv.1 (lt_irrefl 1), diff --git a/src/analysis/quaternion.lean b/src/analysis/quaternion.lean index 2b77f49fb5427..4fa0224f1e472 100644 --- a/src/analysis/quaternion.lean +++ b/src/analysis/quaternion.lean @@ -1,20 +1,27 @@ /- Copyright (c) 2020 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yury Kudryashov +Authors: Yury Kudryashov, Eric Wieser -/ import algebra.quaternion import analysis.inner_product_space.basic +import analysis.inner_product_space.pi_L2 +import topology.algebra.algebra /-! # Quaternions as a normed algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define the following structures on the space `ℍ := ℍ[ℝ]` of quaternions: * inner product space; * normed ring; * normed space over `ℝ`. +We show that the norm on `ℍ[ℝ]` agrees with the euclidean norm of its components. + ## Notation The following notation is available with `open_locale quaternion`: @@ -26,48 +33,58 @@ The following notation is available with `open_locale quaternion`: quaternion, normed ring, normed space, normed algebra -/ -localized "notation `ℍ` := quaternion ℝ" in quaternion +localized "notation (name := quaternion.real) `ℍ` := quaternion ℝ" in quaternion open_locale real_inner_product_space -noncomputable theory - namespace quaternion -instance : has_inner ℝ ℍ := ⟨λ a b, (a * b.conj).re⟩ +instance : has_inner ℝ ℍ := ⟨λ a b, (a * star b).re⟩ lemma inner_self (a : ℍ) : ⟪a, a⟫ = norm_sq a := rfl -lemma inner_def (a b : ℍ) : ⟪a, b⟫ = (a * b.conj).re := rfl +lemma inner_def (a b : ℍ) : ⟪a, b⟫ = (a * star b).re := rfl -instance : inner_product_space ℝ ℍ := -inner_product_space.of_core -{ inner := has_inner.inner, - conj_sym := λ x y, by simp [inner_def, mul_comm], +noncomputable instance : normed_add_comm_group ℍ := +@inner_product_space.core.to_normed_add_comm_group ℝ ℍ _ _ _ +{ to_has_inner := infer_instance, + conj_symm := λ x y, by simp [inner_def, mul_comm], nonneg_re := λ x, norm_sq_nonneg, definite := λ x, norm_sq_eq_zero.1, add_left := λ x y z, by simp only [inner_def, add_mul, add_re], smul_left := λ x y r, by simp [inner_def] } -lemma norm_sq_eq_norm_sq (a : ℍ) : norm_sq a = ∥a∥ * ∥a∥ := +noncomputable instance : inner_product_space ℝ ℍ := +inner_product_space.of_core _ + +lemma norm_sq_eq_norm_sq (a : ℍ) : norm_sq a = ‖a‖ * ‖a‖ := by rw [← inner_self, real_inner_self_eq_norm_mul_norm] instance : norm_one_class ℍ := ⟨by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_one, real.sqrt_one]⟩ -@[simp, norm_cast] lemma norm_coe (a : ℝ) : ∥(a : ℍ)∥ = ∥a∥ := +@[simp, norm_cast] lemma norm_coe (a : ℝ) : ‖(a : ℍ)‖ = ‖a‖ := by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_coe, real.sqrt_sq_eq_abs, real.norm_eq_abs] -@[simp, norm_cast] lemma nnnorm_coe (a : ℝ) : ∥(a : ℍ)∥₊ = ∥a∥₊ := +@[simp, norm_cast] lemma nnnorm_coe (a : ℝ) : ‖(a : ℍ)‖₊ = ‖a‖₊ := subtype.ext $ norm_coe a +@[simp] lemma norm_star (a : ℍ) : ‖star a‖ = ‖a‖ := +by simp_rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_star] + +@[simp] lemma nnnorm_star (a : ℍ) : ‖star a‖₊ = ‖a‖₊ := +subtype.ext $ norm_star a + noncomputable instance : normed_division_ring ℍ := { dist_eq := λ _ _, rfl, norm_mul' := λ a b, by { simp only [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_mul], exact real.sqrt_mul norm_sq_nonneg _ } } -noncomputable instance : normed_algebra ℝ ℍ := -{ norm_smul_le := λ a x, (norm_smul a x).le, - to_algebra := quaternion.algebra } +instance : normed_algebra ℝ ℍ := +{ norm_smul_le := norm_smul_le, + to_algebra := (quaternion.algebra : algebra ℝ ℍ) } + +instance : cstar_ring ℍ := +{ norm_star_mul_self := λ x, (norm_mul _ _).trans $ congr_arg (* ‖x‖) (norm_star x) } instance : has_coe ℂ ℍ := ⟨λ z, ⟨z.re, z.im, 0, 0⟩⟩ @@ -95,4 +112,77 @@ def of_complex : ℂ →ₐ[ℝ] ℍ := @[simp] lemma coe_of_complex : ⇑of_complex = coe := rfl +/-- The norm of the components as a euclidean vector equals the norm of the quaternion. -/ +lemma norm_pi_Lp_equiv_symm_equiv_tuple (x : ℍ) : + ‖(pi_Lp.equiv 2 (λ _ : fin 4, _)).symm (equiv_tuple ℝ x)‖ = ‖x‖ := +begin + rw [norm_eq_sqrt_real_inner, norm_eq_sqrt_real_inner, inner_self, norm_sq_def', pi_Lp.inner_apply, + fin.sum_univ_four], + simp_rw [is_R_or_C.inner_apply, star_ring_end_apply, star_trivial, ←sq], + refl, +end + +/-- `quaternion_algebra.linear_equiv_tuple` as a `linear_isometry_equiv`. -/ +@[simps apply symm_apply] +noncomputable def linear_isometry_equiv_tuple : ℍ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin 4) := +{ to_fun := λ a, (pi_Lp.equiv _ (λ _ : fin 4, _)).symm ![a.1, a.2, a.3, a.4], + inv_fun := λ a, ⟨a 0, a 1, a 2, a 3⟩, + norm_map' := norm_pi_Lp_equiv_symm_equiv_tuple, + ..(quaternion_algebra.linear_equiv_tuple (-1 : ℝ) (-1 : ℝ)).trans + (pi_Lp.linear_equiv 2 ℝ (λ _ : fin 4, ℝ)).symm } + +@[continuity] lemma continuous_coe : continuous (coe : ℝ → ℍ) := +continuous_algebra_map ℝ ℍ + +@[continuity] lemma continuous_norm_sq : continuous (norm_sq : ℍ → ℝ) := +by simpa [←norm_sq_eq_norm_sq] + using (continuous_norm.mul continuous_norm : continuous (λ q : ℍ, ‖q‖ * ‖q‖)) + +@[continuity] lemma continuous_re : continuous (λ q : ℍ, q.re) := +(continuous_apply 0).comp linear_isometry_equiv_tuple.continuous + +@[continuity] lemma continuous_im_i : continuous (λ q : ℍ, q.im_i) := +(continuous_apply 1).comp linear_isometry_equiv_tuple.continuous + +@[continuity] lemma continuous_im_j : continuous (λ q : ℍ, q.im_j) := +(continuous_apply 2).comp linear_isometry_equiv_tuple.continuous + +@[continuity] lemma continuous_im_k : continuous (λ q : ℍ, q.im_k) := +(continuous_apply 3).comp linear_isometry_equiv_tuple.continuous + +@[continuity] lemma continuous_im : continuous (λ q : ℍ, q.im) := +by simpa only [←sub_self_re] using continuous_id.sub (continuous_coe.comp continuous_re) + +instance : complete_space ℍ := +begin + have : uniform_embedding linear_isometry_equiv_tuple.to_linear_equiv.to_equiv.symm := + linear_isometry_equiv_tuple.to_continuous_linear_equiv.symm.uniform_embedding, + exact (complete_space_congr this).1 (by apply_instance) +end + +section infinite_sum +variables {α : Type*} + +@[simp, norm_cast] lemma has_sum_coe {f : α → ℝ} {r : ℝ} : + has_sum (λ a, (f a : ℍ)) (↑r : ℍ) ↔ has_sum f r := +⟨λ h, by simpa only using + h.map (show ℍ →ₗ[ℝ] ℝ, from quaternion_algebra.re_lm _ _) continuous_re, + λ h, by simpa only using h.map (algebra_map ℝ ℍ) (continuous_algebra_map _ _)⟩ + +@[simp, norm_cast] +lemma summable_coe {f : α → ℝ} : summable (λ a, (f a : ℍ)) ↔ summable f := +by simpa only using summable.map_iff_of_left_inverse (algebra_map ℝ ℍ) + (show ℍ →ₗ[ℝ] ℝ, from quaternion_algebra.re_lm _ _) + (continuous_algebra_map _ _) continuous_re coe_re + +@[norm_cast] lemma tsum_coe (f : α → ℝ) : ∑' a, (f a : ℍ) = ↑(∑' a, f a) := +begin + by_cases hf : summable f, + { exact (has_sum_coe.mpr hf.has_sum).tsum_eq, }, + { simp [tsum_eq_zero_of_not_summable hf, + tsum_eq_zero_of_not_summable (summable_coe.not.mpr hf)] }, +end + +end infinite_sum + end quaternion diff --git a/src/analysis/schwartz_space.lean b/src/analysis/schwartz_space.lean new file mode 100644 index 0000000000000..86c4d8105c34e --- /dev/null +++ b/src/analysis/schwartz_space.lean @@ -0,0 +1,915 @@ +/- +Copyright (c) 2022 Moritz Doll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll +-/ + +import analysis.calculus.cont_diff +import analysis.calculus.iterated_deriv +import analysis.locally_convex.with_seminorms +import topology.algebra.uniform_filter_basis +import topology.continuous_function.bounded +import tactic.positivity +import analysis.special_functions.pow.real + +/-! +# Schwartz space + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the Schwartz space. Usually, the Schwartz space is defined as the set of smooth +functions $f : ℝ^n → ℂ$ such that there exists $C_{αβ} > 0$ with $$|x^α ∂^β f(x)| < C_{αβ}$$ for +all $x ∈ ℝ^n$ and for all multiindices $α, β$. +In mathlib, we use a slightly different approach and define define the Schwartz space as all +smooth functions `f : E → F`, where `E` and `F` are real normed vector spaces such that for all +natural numbers `k` and `n` we have uniform bounds `‖x‖^k * ‖iterated_fderiv ℝ n f x‖ < C`. +This approach completely avoids using partial derivatives as well as polynomials. +We construct the topology on the Schwartz space by a family of seminorms, which are the best +constants in the above estimates. The abstract theory of topological vector spaces developed in +`seminorm_family.module_filter_basis` and `with_seminorms.to_locally_convex_space` turns the +Schwartz space into a locally convex topological vector space. + +## Main definitions + +* `schwartz_map`: The Schwartz space is the space of smooth functions such that all derivatives +decay faster than any power of `‖x‖`. +* `schwartz_map.seminorm`: The family of seminorms as described above +* `schwartz_map.fderiv_clm`: The differential as a continuous linear map +`𝓢(E, F) →L[𝕜] 𝓢(E, E →L[ℝ] F)` +* `schwartz_map.deriv_clm`: The one-dimensional derivative as a continuous linear map +`𝓢(ℝ, F) →L[𝕜] 𝓢(ℝ, F)` + +## Main statements + +* `schwartz_map.uniform_add_group` and `schwartz_map.locally_convex`: The Schwartz space is a +locally convex topological vector space. +* `schwartz_map.one_add_le_sup_seminorm_apply`: For a Schwartz function `f` there is a uniform bound +on `(1 + ‖x‖) ^ k * ‖iterated_fderiv ℝ n f x‖`. + +## Implementation details + +The implementation of the seminorms is taken almost literally from `continuous_linear_map.op_norm`. + +## Notation + +* `𝓢(E, F)`: The Schwartz space `schwartz_map E F` localized in `schwartz_space` + +## Tags + +Schwartz space, tempered distributions +-/ + +noncomputable theory + +open_locale big_operators nat + +variables {𝕜 𝕜' D E F G : Type*} + +variables [normed_add_comm_group E] [normed_space ℝ E] +variables [normed_add_comm_group F] [normed_space ℝ F] + +variables (E F) + +/-- A function is a Schwartz function if it is smooth and all derivatives decay faster than + any power of `‖x‖`. -/ +structure schwartz_map := + (to_fun : E → F) + (smooth' : cont_diff ℝ ⊤ to_fun) + (decay' : ∀ (k n : ℕ), ∃ (C : ℝ), ∀ x, ‖x‖^k * ‖iterated_fderiv ℝ n to_fun x‖ ≤ C) + +localized "notation `𝓢(` E `, ` F `)` := schwartz_map E F" in schwartz_space + +variables {E F} + +namespace schwartz_map + +instance : has_coe 𝓢(E, F) (E → F) := ⟨to_fun⟩ + +instance fun_like : fun_like 𝓢(E, F) E (λ _, F) := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr' } + +/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ +instance : has_coe_to_fun 𝓢(E, F) (λ _, E → F) := ⟨λ p, p.to_fun⟩ + +/-- All derivatives of a Schwartz function are rapidly decaying. -/ +lemma decay (f : 𝓢(E, F)) (k n : ℕ) : ∃ (C : ℝ) (hC : 0 < C), + ∀ x, ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ ≤ C := +begin + rcases f.decay' k n with ⟨C, hC⟩, + exact ⟨max C 1, by positivity, λ x, (hC x).trans (le_max_left _ _)⟩, +end + +/-- Every Schwartz function is smooth. -/ +lemma smooth (f : 𝓢(E, F)) (n : ℕ∞) : cont_diff ℝ n f := f.smooth'.of_le le_top + +/-- Every Schwartz function is continuous. -/ +@[continuity, protected] lemma continuous (f : 𝓢(E, F)) : continuous f := (f.smooth 0).continuous + +/-- Every Schwartz function is differentiable. -/ +@[protected] lemma differentiable (f : 𝓢(E, F)) : differentiable ℝ f := +(f.smooth 1).differentiable rfl.le + +/-- Every Schwartz function is differentiable at any point. -/ +@[protected] lemma differentiable_at (f : 𝓢(E, F)) {x : E} : differentiable_at ℝ f x := +f.differentiable.differentiable_at + +@[ext] lemma ext {f g : 𝓢(E, F)} (h : ∀ x, (f : E → F) x = g x) : f = g := fun_like.ext f g h + +section is_O + +variables (f : 𝓢(E, F)) + +/-- Auxiliary lemma, used in proving the more general result `is_O_cocompact_zpow`. -/ +lemma is_O_cocompact_zpow_neg_nat (k : ℕ) : + asymptotics.is_O (filter.cocompact E) f (λ x, ‖x‖ ^ (-k : ℤ)) := +begin + obtain ⟨d, hd, hd'⟩ := f.decay k 0, + simp_rw norm_iterated_fderiv_zero at hd', + simp_rw [asymptotics.is_O, asymptotics.is_O_with], + refine ⟨d, filter.eventually.filter_mono filter.cocompact_le_cofinite _⟩, + refine (filter.eventually_cofinite_ne 0).mp (filter.eventually_of_forall (λ x hx, _)), + rwa [real.norm_of_nonneg (zpow_nonneg (norm_nonneg _) _), zpow_neg, ←div_eq_mul_inv, le_div_iff'], + exacts [hd' x, zpow_pos_of_pos (norm_pos_iff.mpr hx) _], +end + +lemma is_O_cocompact_rpow [proper_space E] (s : ℝ) : + asymptotics.is_O (filter.cocompact E) f (λ x, ‖x‖ ^ s) := +begin + let k := ⌈-s⌉₊, + have hk : -(k : ℝ) ≤ s, from neg_le.mp (nat.le_ceil (-s)), + refine (is_O_cocompact_zpow_neg_nat f k).trans _, + refine (_ : asymptotics.is_O filter.at_top + (λ x:ℝ, x ^ (-k : ℤ)) (λ x:ℝ, x ^ s)).comp_tendsto tendsto_norm_cocompact_at_top, + simp_rw [asymptotics.is_O, asymptotics.is_O_with], + refine ⟨1, filter.eventually_of_mem (filter.eventually_ge_at_top 1) (λ x hx, _)⟩, + rw [one_mul, real.norm_of_nonneg (real.rpow_nonneg_of_nonneg (zero_le_one.trans hx) _), + real.norm_of_nonneg (zpow_nonneg (zero_le_one.trans hx) _), ←real.rpow_int_cast, int.cast_neg, + int.cast_coe_nat], + exact real.rpow_le_rpow_of_exponent_le hx hk, +end + +lemma is_O_cocompact_zpow [proper_space E] (k : ℤ) : + asymptotics.is_O (filter.cocompact E) f (λ x, ‖x‖ ^ k) := +by simpa only [real.rpow_int_cast] using is_O_cocompact_rpow f k + +end is_O + +section aux + +lemma bounds_nonempty (k n : ℕ) (f : 𝓢(E, F)) : + ∃ (c : ℝ), c ∈ {c : ℝ | 0 ≤ c ∧ ∀ (x : E), ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ ≤ c} := +let ⟨M, hMp, hMb⟩ := f.decay k n in ⟨M, le_of_lt hMp, hMb⟩ + +lemma bounds_bdd_below (k n : ℕ) (f : 𝓢(E, F)) : + bdd_below {c | 0 ≤ c ∧ ∀ x, ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ ≤ c} := +⟨0, λ _ ⟨hn, _⟩, hn⟩ + +lemma decay_add_le_aux (k n : ℕ) (f g : 𝓢(E, F)) (x : E) : + ‖x‖^k * ‖iterated_fderiv ℝ n (f+g) x‖ ≤ + ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ + + ‖x‖^k * ‖iterated_fderiv ℝ n g x‖ := +begin + rw ←mul_add, + refine mul_le_mul_of_nonneg_left _ (by positivity), + convert norm_add_le _ _, + exact iterated_fderiv_add_apply (f.smooth _) (g.smooth _), +end + +lemma decay_neg_aux (k n : ℕ) (f : 𝓢(E, F)) (x : E) : + ‖x‖ ^ k * ‖iterated_fderiv ℝ n (-f) x‖ = ‖x‖ ^ k * ‖iterated_fderiv ℝ n f x‖ := +begin + nth_rewrite 3 ←norm_neg, + congr, + exact iterated_fderiv_neg_apply, +end + +variables [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] + +lemma decay_smul_aux (k n : ℕ) (f : 𝓢(E, F)) (c : 𝕜) (x : E) : + ‖x‖ ^ k * ‖iterated_fderiv ℝ n (c • f) x‖ = + ‖c‖ * ‖x‖ ^ k * ‖iterated_fderiv ℝ n f x‖ := +by rw [mul_comm (‖c‖), mul_assoc, iterated_fderiv_const_smul_apply (f.smooth _), norm_smul] + +end aux + +section seminorm_aux + +/-- Helper definition for the seminorms of the Schwartz space. -/ +@[protected] +def seminorm_aux (k n : ℕ) (f : 𝓢(E, F)) : ℝ := +Inf {c | 0 ≤ c ∧ ∀ x, ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ ≤ c} + +lemma seminorm_aux_nonneg (k n : ℕ) (f : 𝓢(E, F)) : 0 ≤ f.seminorm_aux k n := +le_cInf (bounds_nonempty k n f) (λ _ ⟨hx, _⟩, hx) + +lemma le_seminorm_aux (k n : ℕ) (f : 𝓢(E, F)) (x : E) : + ‖x‖ ^ k * ‖iterated_fderiv ℝ n ⇑f x‖ ≤ f.seminorm_aux k n := +le_cInf (bounds_nonempty k n f) (λ y ⟨_, h⟩, h x) + +/-- If one controls the norm of every `A x`, then one controls the norm of `A`. -/ +lemma seminorm_aux_le_bound (k n : ℕ) (f : 𝓢(E, F)) {M : ℝ} (hMp: 0 ≤ M) + (hM : ∀ x, ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ ≤ M) : + f.seminorm_aux k n ≤ M := +cInf_le (bounds_bdd_below k n f) ⟨hMp, hM⟩ + +end seminorm_aux + +/-! ### Algebraic properties -/ + +section smul + +variables [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] + [normed_field 𝕜'] [normed_space 𝕜' F] [smul_comm_class ℝ 𝕜' F] + +instance : has_smul 𝕜 𝓢(E, F) := +⟨λ c f, { to_fun := c • f, + smooth' := (f.smooth _).const_smul c, + decay' := λ k n, begin + refine ⟨f.seminorm_aux k n * (‖c‖+1), λ x, _⟩, + have hc : 0 ≤ ‖c‖ := by positivity, + refine le_trans _ ((mul_le_mul_of_nonneg_right (f.le_seminorm_aux k n x) hc).trans _), + { apply eq.le, + rw [mul_comm _ (‖c‖), ← mul_assoc], + exact decay_smul_aux k n f c x }, + { apply mul_le_mul_of_nonneg_left _ (f.seminorm_aux_nonneg k n), + linarith } + end}⟩ + +@[simp] lemma smul_apply {f : 𝓢(E, F)} {c : 𝕜} {x : E} : (c • f) x = c • (f x) := rfl + +instance +[has_smul 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' F] : is_scalar_tower 𝕜 𝕜' 𝓢(E, F) := +⟨λ a b f, ext $ λ x, smul_assoc a b (f x)⟩ + +instance [smul_comm_class 𝕜 𝕜' F] : smul_comm_class 𝕜 𝕜' 𝓢(E, F) := +⟨λ a b f, ext $ λ x, smul_comm a b (f x)⟩ + +lemma seminorm_aux_smul_le (k n : ℕ) (c : 𝕜) (f : 𝓢(E, F)) : + (c • f).seminorm_aux k n ≤ ‖c‖ * f.seminorm_aux k n := +begin + refine (c • f).seminorm_aux_le_bound k n (mul_nonneg (norm_nonneg _) (seminorm_aux_nonneg _ _ _)) + (λ x, (decay_smul_aux k n f c x).le.trans _), + rw mul_assoc, + exact mul_le_mul_of_nonneg_left (f.le_seminorm_aux k n x) (norm_nonneg _), +end + +instance has_nsmul : has_smul ℕ 𝓢(E, F) := +⟨λ c f, { to_fun := c • f, + smooth' := (f.smooth _).const_smul c, + decay' := begin + have : c • (f : E → F) = (c : ℝ) • f, + { ext x, simp only [pi.smul_apply, ← nsmul_eq_smul_cast] }, + simp only [this], + exact ((c : ℝ) • f).decay', + end}⟩ + +instance has_zsmul : has_smul ℤ 𝓢(E, F) := +⟨λ c f, { to_fun := c • f, + smooth' := (f.smooth _).const_smul c, + decay' := begin + have : c • (f : E → F) = (c : ℝ) • f, + { ext x, simp only [pi.smul_apply, ← zsmul_eq_smul_cast] }, + simp only [this], + exact ((c : ℝ) • f).decay', + end}⟩ + +end smul + +section zero + +instance : has_zero 𝓢(E, F) := +⟨{ to_fun := λ _, 0, + smooth' := cont_diff_const, + decay' := λ _ _, ⟨1, λ _, by simp⟩ }⟩ + +instance : inhabited 𝓢(E, F) := ⟨0⟩ + +lemma coe_zero : ↑(0 : 𝓢(E, F)) = (0 : E → F) := rfl + +@[simp] lemma coe_fn_zero : coe_fn (0 : 𝓢(E, F)) = (0 : E → F) := rfl + +@[simp] lemma zero_apply {x : E} : (0 : 𝓢(E, F)) x = 0 := rfl + +lemma seminorm_aux_zero (k n : ℕ) : + (0 : 𝓢(E, F)).seminorm_aux k n = 0 := +le_antisymm (seminorm_aux_le_bound k n _ rfl.le (λ _, by simp [pi.zero_def])) + (seminorm_aux_nonneg _ _ _) + +end zero + +section neg + +instance : has_neg 𝓢(E, F) := +⟨λ f, ⟨-f, (f.smooth _).neg, λ k n, + ⟨f.seminorm_aux k n, λ x, (decay_neg_aux k n f x).le.trans (f.le_seminorm_aux k n x)⟩⟩⟩ + +end neg + +section add + +instance : has_add 𝓢(E, F) := +⟨λ f g, ⟨f + g, (f.smooth _).add (g.smooth _), λ k n, + ⟨f.seminorm_aux k n + g.seminorm_aux k n, λ x, (decay_add_le_aux k n f g x).trans + (add_le_add (f.le_seminorm_aux k n x) (g.le_seminorm_aux k n x))⟩⟩⟩ + +@[simp] lemma add_apply {f g : 𝓢(E, F)} {x : E} : (f + g) x = f x + g x := rfl + +lemma seminorm_aux_add_le (k n : ℕ) (f g : 𝓢(E, F)) : + (f + g).seminorm_aux k n ≤ f.seminorm_aux k n + g.seminorm_aux k n := +(f + g).seminorm_aux_le_bound k n + (add_nonneg (seminorm_aux_nonneg _ _ _) (seminorm_aux_nonneg _ _ _)) $ + λ x, (decay_add_le_aux k n f g x).trans $ + add_le_add (f.le_seminorm_aux k n x) (g.le_seminorm_aux k n x) + +end add + +section sub + +instance : has_sub 𝓢(E, F) := +⟨λ f g, ⟨f - g, (f.smooth _).sub (g.smooth _), + begin + intros k n, + refine ⟨f.seminorm_aux k n + g.seminorm_aux k n, λ x, _⟩, + refine le_trans _ (add_le_add (f.le_seminorm_aux k n x) (g.le_seminorm_aux k n x)), + rw sub_eq_add_neg, + rw ←decay_neg_aux k n g x, + convert decay_add_le_aux k n f (-g) x, + -- exact fails with deterministic timeout + end⟩ ⟩ + +@[simp] lemma sub_apply {f g : 𝓢(E, F)} {x : E} : (f - g) x = f x - g x := rfl + +end sub + +section add_comm_group + +instance : add_comm_group 𝓢(E, F) := +fun_like.coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) + (λ _ _, rfl) + +variables (E F) + +/-- Coercion as an additive homomorphism. -/ +def coe_hom : 𝓢(E, F) →+ (E → F) := +{ to_fun := λ f, f, map_zero' := coe_zero, map_add' := λ _ _, rfl } + +variables {E F} + +lemma coe_coe_hom : (coe_hom E F : 𝓢(E, F) → (E → F)) = coe_fn := rfl + +lemma coe_hom_injective : function.injective (coe_hom E F) := +by { rw coe_coe_hom, exact fun_like.coe_injective } + +end add_comm_group + +section module + +variables [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] + +instance : module 𝕜 𝓢(E, F) := +coe_hom_injective.module 𝕜 (coe_hom E F) (λ _ _, rfl) + +end module + +section seminorms + +/-! ### Seminorms on Schwartz space-/ + +variables [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] +variable (𝕜) + +/-- The seminorms of the Schwartz space given by the best constants in the definition of +`𝓢(E, F)`. -/ +@[protected] +def seminorm (k n : ℕ) : seminorm 𝕜 𝓢(E, F) := seminorm.of_smul_le (seminorm_aux k n) + (seminorm_aux_zero k n) (seminorm_aux_add_le k n) (seminorm_aux_smul_le k n) + +/-- If one controls the seminorm for every `x`, then one controls the seminorm. -/ +lemma seminorm_le_bound (k n : ℕ) (f : 𝓢(E, F)) {M : ℝ} (hMp: 0 ≤ M) + (hM : ∀ x, ‖x‖^k * ‖iterated_fderiv ℝ n f x‖ ≤ M) : seminorm 𝕜 k n f ≤ M := +f.seminorm_aux_le_bound k n hMp hM + +/-- If one controls the seminorm for every `x`, then one controls the seminorm. + +Variant for functions `𝓢(ℝ, F)`. -/ +lemma seminorm_le_bound' (k n : ℕ) (f : 𝓢(ℝ, F)) {M : ℝ} (hMp: 0 ≤ M) + (hM : ∀ x, |x|^k * ‖iterated_deriv n f x‖ ≤ M) : seminorm 𝕜 k n f ≤ M := +begin + refine seminorm_le_bound 𝕜 k n f hMp _, + simpa only [real.norm_eq_abs, norm_iterated_fderiv_eq_norm_iterated_deriv], +end + +/-- The seminorm controls the Schwartz estimate for any fixed `x`. -/ +lemma le_seminorm (k n : ℕ) (f : 𝓢(E, F)) (x : E) : + ‖x‖ ^ k * ‖iterated_fderiv ℝ n f x‖ ≤ seminorm 𝕜 k n f := +f.le_seminorm_aux k n x + +/-- The seminorm controls the Schwartz estimate for any fixed `x`. + +Variant for functions `𝓢(ℝ, F)`. -/ +lemma le_seminorm' (k n : ℕ) (f : 𝓢(ℝ, F)) (x : ℝ) : + |x| ^ k * ‖iterated_deriv n f x‖ ≤ seminorm 𝕜 k n f := +begin + have := le_seminorm 𝕜 k n f x, + rwa [← real.norm_eq_abs, ← norm_iterated_fderiv_eq_norm_iterated_deriv], +end + +lemma norm_iterated_fderiv_le_seminorm (f : 𝓢(E, F)) (n : ℕ) (x₀ : E) : + ‖iterated_fderiv ℝ n f x₀‖ ≤ (schwartz_map.seminorm 𝕜 0 n) f := +begin + have := schwartz_map.le_seminorm 𝕜 0 n f x₀, + rwa [pow_zero, one_mul] at this, +end + +lemma norm_pow_mul_le_seminorm (f : 𝓢(E, F)) (k : ℕ) (x₀ : E) : + ‖x₀‖^k * ‖f x₀‖ ≤ (schwartz_map.seminorm 𝕜 k 0) f := +begin + have := schwartz_map.le_seminorm 𝕜 k 0 f x₀, + rwa norm_iterated_fderiv_zero at this, +end + +lemma norm_le_seminorm (f : 𝓢(E, F)) (x₀ : E) : + ‖f x₀‖ ≤ (schwartz_map.seminorm 𝕜 0 0) f := +begin + have := norm_pow_mul_le_seminorm 𝕜 f 0 x₀, + rwa [pow_zero, one_mul] at this, +end + +variables (𝕜 E F) + +/-- The family of Schwartz seminorms. -/ +def _root_.schwartz_seminorm_family : seminorm_family 𝕜 𝓢(E, F) (ℕ × ℕ) := +λ m, seminorm 𝕜 m.1 m.2 + +@[simp] lemma schwartz_seminorm_family_apply (n k : ℕ) : + schwartz_seminorm_family 𝕜 E F (n,k) = schwartz_map.seminorm 𝕜 n k := rfl + +@[simp] lemma schwartz_seminorm_family_apply_zero : + schwartz_seminorm_family 𝕜 E F 0 = schwartz_map.seminorm 𝕜 0 0 := rfl + +variables {𝕜 E F} + +/-- A more convenient version of `le_sup_seminorm_apply`. + +The set `finset.Iic m` is the set of all pairs `(k', n')` with `k' ≤ m.1` and `n' ≤ m.2`. +Note that the constant is far from optimal. -/ +lemma one_add_le_sup_seminorm_apply {m : ℕ × ℕ} {k n : ℕ} (hk : k ≤ m.1) (hn : n ≤ m.2) + (f : 𝓢(E, F)) (x : E) : + (1 + ‖x‖) ^ k * ‖iterated_fderiv ℝ n f x‖ + ≤ 2^m.1 * (finset.Iic m).sup (λ m, seminorm 𝕜 m.1 m.2) f := +begin + rw [add_comm, add_pow], + simp only [one_pow, mul_one, finset.sum_congr, finset.sum_mul], + norm_cast, + rw ← nat.sum_range_choose m.1, + push_cast, + rw [finset.sum_mul], + have hk' : finset.range (k + 1) ⊆ finset.range (m.1 + 1) := + by rwa [finset.range_subset, add_le_add_iff_right], + refine le_trans (finset.sum_le_sum_of_subset_of_nonneg hk' (λ _ _ _, by positivity)) _, + refine finset.sum_le_sum (λ i hi, _), + rw [mul_comm (‖x‖^i), mul_assoc], + refine mul_le_mul _ _ (by positivity) (by positivity), + { norm_cast, + exact i.choose_le_choose hk }, + exact (le_seminorm 𝕜 i n f x).trans (seminorm.le_def.1 (finset.le_sup_of_le + (finset.mem_Iic.2 $ prod.mk_le_mk.2 ⟨finset.mem_range_succ_iff.mp hi, hn⟩) le_rfl) _), +end + +end seminorms + +section topology + +/-! ### The topology on the Schwartz space-/ + +variables [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] +variables (𝕜 E F) + +instance : topological_space 𝓢(E, F) := +(schwartz_seminorm_family ℝ E F).module_filter_basis.topology' + +lemma _root_.schwartz_with_seminorms : with_seminorms (schwartz_seminorm_family 𝕜 E F) := +begin + have A : with_seminorms (schwartz_seminorm_family ℝ E F) := ⟨rfl⟩, + rw seminorm_family.with_seminorms_iff_nhds_eq_infi at ⊢ A, + rw A, + refl +end + +variables {𝕜 E F} + +instance : has_continuous_smul 𝕜 𝓢(E, F) := +begin + rw (schwartz_with_seminorms 𝕜 E F).with_seminorms_eq, + exact (schwartz_seminorm_family 𝕜 E F).module_filter_basis.has_continuous_smul, +end + +instance : topological_add_group 𝓢(E, F) := +(schwartz_seminorm_family ℝ E F).add_group_filter_basis.is_topological_add_group + +instance : uniform_space 𝓢(E, F) := +(schwartz_seminorm_family ℝ E F).add_group_filter_basis.uniform_space + +instance : uniform_add_group 𝓢(E, F) := +(schwartz_seminorm_family ℝ E F).add_group_filter_basis.uniform_add_group + +instance : locally_convex_space ℝ 𝓢(E, F) := +(schwartz_with_seminorms ℝ E F).to_locally_convex_space + +instance : topological_space.first_countable_topology (𝓢(E, F)) := +(schwartz_with_seminorms ℝ E F).first_countable + +end topology + +section temperate_growth + +/-! ### Functions of temperate growth -/ + +/-- A function is called of temperate growth if it is smooth and all iterated derivatives are +polynomially bounded. -/ +def _root_.function.has_temperate_growth (f : E → F) : Prop := + cont_diff ℝ ⊤ f ∧ ∀ n : ℕ, ∃ (k : ℕ) (C : ℝ), ∀ x, ‖iterated_fderiv ℝ n f x‖ ≤ C * (1 + ‖x‖)^k + +lemma _root_.function.has_temperate_growth.norm_iterated_fderiv_le_uniform_aux {f : E → F} + (hf_temperate : f.has_temperate_growth) (n : ℕ) : + ∃ (k : ℕ) (C : ℝ) (hC : 0 ≤ C), ∀ (N : ℕ) (hN : N ≤ n) (x : E), + ‖iterated_fderiv ℝ N f x‖ ≤ C * (1 + ‖x‖)^k := +begin + choose k C f using hf_temperate.2, + use (finset.range (n+1)).sup k, + let C' := max (0 : ℝ) ((finset.range (n+1)).sup' (by simp) C), + have hC' : 0 ≤ C' := by simp only [le_refl, finset.le_sup'_iff, true_or, le_max_iff], + use [C', hC'], + intros N hN x, + rw ← finset.mem_range_succ_iff at hN, + refine le_trans (f N x) (mul_le_mul _ _ (by positivity) hC'), + { simp only [finset.le_sup'_iff, le_max_iff], + right, + exact ⟨N, hN, rfl.le⟩ }, + refine pow_le_pow (by simp only [le_add_iff_nonneg_right, norm_nonneg]) _, + exact finset.le_sup hN, +end + +end temperate_growth + +section clm + +/-! ### Construction of continuous linear maps between Schwartz spaces -/ + +variables [normed_field 𝕜] [normed_field 𝕜'] +variables [normed_add_comm_group D] [normed_space ℝ D] +variables [normed_space 𝕜 E] [smul_comm_class ℝ 𝕜 E] +variables [normed_add_comm_group G] [normed_space ℝ G] [normed_space 𝕜' G] [smul_comm_class ℝ 𝕜' G] +variables {σ : 𝕜 →+* 𝕜'} + +/-- Create a semilinear map between Schwartz spaces. + +Note: This is a helper definition for `mk_clm`. -/ +def mk_lm (A : (D → E) → (F → G)) + (hadd : ∀ (f g : 𝓢(D, E)) x, A (f + g) x = A f x + A g x) + (hsmul : ∀ (a : 𝕜) (f : 𝓢(D, E)) x, A (a • f) x = σ a • A f x) + (hsmooth : ∀ (f : 𝓢(D, E)), cont_diff ℝ ⊤ (A f)) + (hbound : ∀ (n : ℕ × ℕ), ∃ (s : finset (ℕ × ℕ)) (C : ℝ) (hC : 0 ≤ C), ∀ (f : 𝓢(D, E)) (x : F), + ‖x‖ ^ n.fst * ‖iterated_fderiv ℝ n.snd (A f) x‖ ≤ C * s.sup (schwartz_seminorm_family 𝕜 D E) f) : + 𝓢(D, E) →ₛₗ[σ] 𝓢(F, G) := +{ to_fun := λ f, + { to_fun := A f, + smooth' := hsmooth f, + decay' := + begin + intros k n, + rcases hbound ⟨k, n⟩ with ⟨s, C, hC, h⟩, + exact ⟨C * (s.sup (schwartz_seminorm_family 𝕜 D E)) f, h f⟩, + end, }, + map_add' := λ f g, ext (hadd f g), + map_smul' := λ a f, ext (hsmul a f), } + +/-- Create a continuous semilinear map between Schwartz spaces. + +For an example of using this definition, see `fderiv_clm`. -/ +def mk_clm [ring_hom_isometric σ] (A : (D → E) → (F → G)) + (hadd : ∀ (f g : 𝓢(D, E)) x, A (f + g) x = A f x + A g x) + (hsmul : ∀ (a : 𝕜) (f : 𝓢(D, E)) x, A (a • f) x = σ a • A f x) + (hsmooth : ∀ (f : 𝓢(D, E)), cont_diff ℝ ⊤ (A f)) + (hbound : ∀ (n : ℕ × ℕ), ∃ (s : finset (ℕ × ℕ)) (C : ℝ) (hC : 0 ≤ C), ∀ (f : 𝓢(D, E)) (x : F), + ‖x‖ ^ n.fst * ‖iterated_fderiv ℝ n.snd (A f) x‖ ≤ C * s.sup (schwartz_seminorm_family 𝕜 D E) f) : + 𝓢(D, E) →SL[σ] 𝓢(F, G) := +{ cont := + begin + change continuous (mk_lm A hadd hsmul hsmooth hbound : 𝓢(D, E) →ₛₗ[σ] 𝓢(F, G)), + refine seminorm.continuous_from_bounded (schwartz_with_seminorms 𝕜 D E) + (schwartz_with_seminorms 𝕜' F G) _ (λ n, _), + rcases hbound n with ⟨s, C, hC, h⟩, + refine ⟨s, ⟨C, hC⟩, (λ f, _)⟩, + simp only [seminorm.comp_apply, seminorm.smul_apply, nnreal.smul_def, algebra.id.smul_eq_mul, + subtype.coe_mk], + exact (mk_lm A hadd hsmul hsmooth hbound f).seminorm_le_bound 𝕜' n.1 n.2 (by positivity) (h f), + end, + to_linear_map := mk_lm A hadd hsmul hsmooth hbound } + +end clm + +section eval_clm + +variables [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] + +/-- The map applying a vector to Hom-valued Schwartz function as a continuous linear map. -/ +@[protected] def eval_clm (m : E) : 𝓢(E, E →L[ℝ] F) →L[𝕜] 𝓢(E, F) := +mk_clm (λ f x, f x m) + (λ _ _ _, rfl) (λ _ _ _, rfl) (λ f, cont_diff.clm_apply f.2 cont_diff_const) + (begin + rintro ⟨k, n⟩, + use [{(k, n)}, ‖m‖, norm_nonneg _], + intros f x, + refine le_trans (mul_le_mul_of_nonneg_left (norm_iterated_fderiv_clm_apply_const f.2 le_top) + (by positivity)) _, + rw [← mul_assoc, ← mul_comm (‖m‖), mul_assoc], + refine mul_le_mul_of_nonneg_left _ (norm_nonneg _), + simp only [finset.sup_singleton, schwartz_seminorm_family_apply, le_seminorm], + end) + +end eval_clm + +section multiplication + +variables [normed_add_comm_group D] [normed_space ℝ D] +variables [normed_add_comm_group G] [normed_space ℝ G] + +/-- The map `f ↦ (x ↦ B (f x) (g x))` as a continuous `𝕜`-linear map on Schwartz space, +where `B` is a continuous `𝕜`-linear map and `g` is a function of temperate growth. -/ +def bilin_left_clm (B : E →L[ℝ] F →L[ℝ] G) {g : D → F} (hg : g.has_temperate_growth) : + 𝓢(D, E) →L[ℝ] 𝓢(D, G) := + -- Todo (after port): generalize to `B : E →L[𝕜] F →L[𝕜] G` and `𝕜`-linear +mk_clm (λ f x, B (f x) (g x)) + (λ _ _ _, by simp only [map_add, add_left_inj, pi.add_apply, eq_self_iff_true, + continuous_linear_map.add_apply]) + (λ _ _ _, by simp only [pi.smul_apply, continuous_linear_map.coe_smul', + continuous_linear_map.map_smul, ring_hom.id_apply]) + (λ f, (B.is_bounded_bilinear_map.cont_diff.restrict_scalars ℝ).comp (f.smooth'.prod hg.1)) + (begin + -- Porting note: rewrite this proof with `rel_congr` + rintro ⟨k, n⟩, + rcases hg.norm_iterated_fderiv_le_uniform_aux n with ⟨l, C, hC, hgrowth⟩, + use [finset.Iic (l+k,n), ‖B‖ * (n + 1) * n.choose (n / 2) * (C * 2^(l + k)), by positivity], + intros f x, + have hxk : 0 ≤ ‖x‖^k := by positivity, + have hnorm_mul := + continuous_linear_map.norm_iterated_fderiv_le_of_bilinear B f.smooth' hg.1 x le_top, + refine le_trans (mul_le_mul_of_nonneg_left hnorm_mul hxk) _, + rw [← mul_assoc (‖x‖^k), mul_comm (‖x‖^k)], + simp_rw [mul_assoc (‖B‖)], + refine mul_le_mul_of_nonneg_left _ (by positivity), + rw [finset.mul_sum], + have : ∑ (x_1 : ℕ) in finset.range (n + 1), (1 : ℝ) = n + 1 := by simp, + repeat { rw [mul_assoc ((n : ℝ) + 1)] }, + rw [← this, finset.sum_mul], + refine finset.sum_le_sum (λ i hi, _), + simp only [one_mul], + rw [← mul_assoc, mul_comm (‖x‖^k), mul_assoc, mul_assoc, mul_assoc], + refine mul_le_mul _ _ (by positivity) (by positivity), + { norm_cast, + exact i.choose_le_middle n }, + specialize hgrowth (n - i) (by simp only [tsub_le_self]) x, + rw [← mul_assoc], + refine le_trans (mul_le_mul_of_nonneg_left hgrowth (by positivity)) _, + rw [mul_comm _ (C * _), mul_assoc, mul_assoc C], + refine mul_le_mul_of_nonneg_left _ hC, + nth_rewrite 1 mul_comm, + rw [← mul_assoc], + rw finset.mem_range_succ_iff at hi, + change i ≤ (l + k, n).snd at hi, + refine le_trans _ (one_add_le_sup_seminorm_apply le_rfl hi f x ), + refine mul_le_mul_of_nonneg_right _ (norm_nonneg _), + rw [pow_add], + refine mul_le_mul_of_nonneg_left _ (by positivity), + refine pow_le_pow_of_le_left (norm_nonneg _) _ _, + simp only [zero_le_one, le_add_iff_nonneg_left], + end) + +end multiplication + +section comp + +variables (𝕜) +variables [is_R_or_C 𝕜] +variables [normed_add_comm_group D] [normed_space ℝ D] +variables [normed_add_comm_group G] [normed_space ℝ G] +variables [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] +variables [normed_space 𝕜 G] [smul_comm_class ℝ 𝕜 G] + +/-- Composition with a function on the right is a continuous linear map on Schwartz space +provided that the function is temperate and growths polynomially near infinity. -/ +def comp_clm {g : D → E} (hg : g.has_temperate_growth) + (hg_upper : ∃ (k : ℕ) (C : ℝ), ∀ x, ‖x‖ ≤ C * (1 + ‖g x‖)^k ) : + 𝓢(E, F) →L[𝕜] 𝓢(D, F) := +mk_clm (λ f x, (f (g x))) + (λ _ _ _, by simp only [add_left_inj, pi.add_apply, eq_self_iff_true]) + (λ _ _ _, rfl) + (λ f, f.smooth'.comp hg.1) + (begin + rintros ⟨k, n⟩, + rcases hg.norm_iterated_fderiv_le_uniform_aux n with ⟨l, C, hC, hgrowth⟩, + rcases hg_upper with ⟨kg, Cg, hg_upper'⟩, + have hCg : 1 ≤ 1 + Cg := + begin + refine le_add_of_nonneg_right _, + specialize hg_upper' 0, + rw [norm_zero] at hg_upper', + refine nonneg_of_mul_nonneg_left hg_upper' (by positivity), + end, + let k' := kg * (k + l * n), + use [finset.Iic (k',n), (1 + Cg) ^ (k + l * n) * ((C + 1) ^ n * n! * 2 ^ k'), by positivity], + intros f x, + let seminorm_f := ((finset.Iic (k',n)).sup (schwartz_seminorm_family 𝕜 _ _)) f, + have hg_upper'' : (1 + ‖x‖)^(k + l * n) ≤ (1 + Cg)^(k + l*n) * (1 + ‖g x‖)^k' := + begin + rw [pow_mul, ← mul_pow], + refine pow_le_pow_of_le_left (by positivity) _ _, + rw [add_mul], + refine add_le_add _ (hg_upper' x), + nth_rewrite 0 ← one_mul (1 : ℝ), + refine mul_le_mul (le_refl _) (one_le_pow_of_one_le _ _) zero_le_one zero_le_one, + simp only [le_add_iff_nonneg_right, norm_nonneg], + end, + have hbound : ∀ i, i ≤ n → ‖iterated_fderiv ℝ i f (g x)‖ ≤ + 2 ^ k' * seminorm_f / ((1 + ‖g x‖) ^ k'):= + begin + intros i hi, + have hpos : 0 < (1 + ‖g x‖) ^ k' := by positivity, + rw le_div_iff' hpos, + change i ≤ (k', n).snd at hi, + exact one_add_le_sup_seminorm_apply le_rfl hi _ _, + end, + have hgrowth' : ∀ (N : ℕ) (hN₁ : 1 ≤ N) (hN₂ : N ≤ n), + ‖iterated_fderiv ℝ N g x‖ ≤ ((C + 1) * (1 + ‖x‖)^l)^N := + begin + intros N hN₁ hN₂, + refine (hgrowth N hN₂ x).trans _, + rw [mul_pow], + have hN₁' := (lt_of_lt_of_le zero_lt_one hN₁).ne.symm, + refine mul_le_mul _ _ (by positivity) (by positivity), + { exact le_trans (by simp [hC]) (le_self_pow (by simp [hC]) hN₁'), }, + { refine le_self_pow (one_le_pow_of_one_le _ l) hN₁', + simp only [le_add_iff_nonneg_right, norm_nonneg] }, + end, + have := norm_iterated_fderiv_comp_le f.smooth' hg.1 le_top x hbound hgrowth', + have hxk : ‖x‖^k ≤ (1 + ‖x‖)^k := + pow_le_pow_of_le_left (norm_nonneg _) (by simp only [zero_le_one, le_add_iff_nonneg_left]) _, + refine le_trans (mul_le_mul hxk this (by positivity) (by positivity)) _, + have rearrange : + (1 + ‖x‖) ^ k * (n! * (2 ^ k' * seminorm_f / (1 + ‖g x‖) ^ k') * + ((C + 1) * (1 + ‖x‖) ^ l) ^ n) = + ((1 + ‖x‖)^(k + l * n) / (1 + ‖g x‖) ^ k') * ((C + 1)^n * n! * 2^k' * seminorm_f) := + begin + rw [mul_pow, pow_add, ← pow_mul], + ring, + end, + rw rearrange, + have hgxk' : 0 < (1 + ‖g x‖) ^ k' := by positivity, + rw ← div_le_iff hgxk' at hg_upper'', + have hpos : 0 ≤ (C + 1) ^ n * n! * 2 ^ k' * seminorm_f := + begin + have : 0 ≤ seminorm_f := map_nonneg _ _, + positivity, + end, + refine le_trans (mul_le_mul_of_nonneg_right hg_upper'' hpos) _, + rw [← mul_assoc], + end) + +end comp + +section derivatives + +/-! ### Derivatives of Schwartz functions -/ + +variables (𝕜) +variables [is_R_or_C 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] + +/-- The Fréchet derivative on Schwartz space as a continuous `𝕜`-linear map. -/ +def fderiv_clm : 𝓢(E, F) →L[𝕜] 𝓢(E, E →L[ℝ] F) := +mk_clm (fderiv ℝ) + (λ f g _, fderiv_add f.differentiable_at g.differentiable_at) + (λ a f _, fderiv_const_smul f.differentiable_at a) + (λ f, (cont_diff_top_iff_fderiv.mp f.smooth').2) + (λ ⟨k, n⟩, ⟨{⟨k, n+1⟩}, 1, zero_le_one, λ f x, by simpa only [schwartz_seminorm_family_apply, + seminorm.comp_apply, finset.sup_singleton, one_smul, norm_iterated_fderiv_fderiv, one_mul] + using f.le_seminorm 𝕜 k (n+1) x⟩) + +@[simp] lemma fderiv_clm_apply (f : 𝓢(E, F)) (x : E) : fderiv_clm 𝕜 f x = fderiv ℝ f x := +rfl + +/-- The 1-dimensional derivative on Schwartz space as a continuous `𝕜`-linear map. -/ +def deriv_clm : 𝓢(ℝ, F) →L[𝕜] 𝓢(ℝ, F) := +mk_clm (λ f, deriv f) + (λ f g _, deriv_add f.differentiable_at g.differentiable_at) + (λ a f _, deriv_const_smul a f.differentiable_at) + (λ f, (cont_diff_top_iff_deriv.mp f.smooth').2) + (λ ⟨k, n⟩, ⟨{⟨k, n+1⟩}, 1, zero_le_one, λ f x, by simpa only [real.norm_eq_abs, + finset.sup_singleton, schwartz_seminorm_family_apply, one_mul, + norm_iterated_fderiv_eq_norm_iterated_deriv, ← iterated_deriv_succ'] + using f.le_seminorm' 𝕜 k (n + 1) x⟩) + +@[simp] lemma deriv_clm_apply (f : 𝓢(ℝ, F)) (x : ℝ) : deriv_clm 𝕜 f x = deriv f x := rfl + +/-- The partial derivative (or directional derivative) in the direction `m : E` as a +continuous linear map on Schwartz space. -/ +def pderiv_clm (m : E) : 𝓢(E, F) →L[𝕜] 𝓢(E, F) := (eval_clm m).comp (fderiv_clm 𝕜) + +@[simp] +lemma pderiv_clm_apply (m : E) (f : 𝓢(E, F)) (x : E) : pderiv_clm 𝕜 m f x = fderiv ℝ f x m := rfl + +/-- The iterated partial derivative (or directional derivative) as a continuous linear map on +Schwartz space. -/ +def iterated_pderiv {n : ℕ} : (fin n → E) → 𝓢(E, F) →L[𝕜] 𝓢(E, F) := +nat.rec_on n + (λ x, continuous_linear_map.id 𝕜 _) + (λ n rec x, (pderiv_clm 𝕜 (x 0)).comp (rec (fin.tail x))) + +@[simp] lemma iterated_pderiv_zero (m : fin 0 → E) (f : 𝓢(E, F)): + iterated_pderiv 𝕜 m f = f := rfl + +@[simp] lemma iterated_pderiv_one (m : fin 1 → E) (f : 𝓢(E, F)) : + iterated_pderiv 𝕜 m f = pderiv_clm 𝕜 (m 0) f := rfl + +lemma iterated_pderiv_succ_left {n : ℕ} (m : fin (n + 1) → E) (f : 𝓢(E, F)) : + iterated_pderiv 𝕜 m f = pderiv_clm 𝕜 (m 0) (iterated_pderiv 𝕜 (fin.tail m) f) := rfl + +lemma iterated_pderiv_succ_right {n : ℕ} (m : fin (n + 1) → E) (f : 𝓢(E, F)) : + iterated_pderiv 𝕜 m f = + iterated_pderiv 𝕜 (fin.init m) (pderiv_clm 𝕜 (m (fin.last n)) f) := +begin + induction n with n IH, + { rw [iterated_pderiv_zero, iterated_pderiv_one], + refl }, + -- The proof is `∂^{n + 2} = ∂ ∂^{n + 1} = ∂ ∂^n ∂ = ∂^{n+1} ∂` + have hmzero : fin.init m 0 = m 0 := by simp only [fin.init_def, fin.cast_succ_zero], + have hmtail : fin.tail m (fin.last n) = m (fin.last n.succ) := + by simp only [fin.tail_def, fin.succ_last], + simp only [iterated_pderiv_succ_left, IH (fin.tail m), hmzero, hmtail, fin.tail_init_eq_init_tail] +end + +-- Todo: `iterated_pderiv 𝕜 m f x = iterated_fderiv ℝ f x m` + +end derivatives + +section bounded_continuous_function + +/-! ### Inclusion into the space of bounded continuous functions -/ + +open_locale bounded_continuous_function + +/-- Schwartz functions as bounded continuous functions -/ +def to_bounded_continuous_function (f : 𝓢(E, F)) : E →ᵇ F := +bounded_continuous_function.of_normed_add_comm_group f (schwartz_map.continuous f) + (schwartz_map.seminorm ℝ 0 0 f) (norm_le_seminorm ℝ f) + +@[simp] lemma to_bounded_continuous_function_apply (f : 𝓢(E, F)) (x : E) : + f.to_bounded_continuous_function x = f x := rfl + +/-- Schwartz functions as continuous functions -/ +def to_continuous_map (f : 𝓢(E, F)) : C(E, F) := +f.to_bounded_continuous_function.to_continuous_map + +variables (𝕜 E F) +variables [is_R_or_C 𝕜] [normed_space 𝕜 F] [smul_comm_class ℝ 𝕜 F] + +/-- The inclusion map from Schwartz functions to bounded continuous functions as a linear map. -/ +def to_bounded_continuous_function_lm : 𝓢(E, F) →ₗ[𝕜] E →ᵇ F := +{ to_fun := λ f, f.to_bounded_continuous_function, + map_add' := λ f g, by { ext, exact add_apply }, + map_smul' := λ a f, by { ext, exact smul_apply } } + +@[simp] lemma to_bounded_continuous_function_lm_apply (f : 𝓢(E, F)) (x : E) : + to_bounded_continuous_function_lm 𝕜 E F f x = f x := rfl + +/-- The inclusion map from Schwartz functions to bounded continuous functions as a continuous linear +map. -/ +def to_bounded_continuous_function_clm : 𝓢(E, F) →L[𝕜] E →ᵇ F := +{ cont := + begin + change continuous (to_bounded_continuous_function_lm 𝕜 E F), + refine seminorm.continuous_from_bounded (schwartz_with_seminorms 𝕜 E F) + (norm_with_seminorms 𝕜 (E →ᵇ F)) _ (λ i, ⟨{0}, 1, λ f, _⟩), + rw [finset.sup_singleton, one_smul , seminorm.comp_apply, coe_norm_seminorm, + schwartz_seminorm_family_apply_zero, bounded_continuous_function.norm_le (map_nonneg _ _)], + intros x, + exact norm_le_seminorm 𝕜 _ _, + end, + .. to_bounded_continuous_function_lm 𝕜 E F} + +@[simp] lemma to_bounded_continuous_function_clm_apply (f : 𝓢(E, F)) (x : E) : + to_bounded_continuous_function_clm 𝕜 E F f x = f x := rfl + +variables {E} + +/-- The Dirac delta distribution -/ +def delta (x : E) : 𝓢(E, F) →L[𝕜] F := +(bounded_continuous_function.eval_clm 𝕜 x).comp (to_bounded_continuous_function_clm 𝕜 E F) + +@[simp] lemma delta_apply (x₀ : E) (f : 𝓢(E, F)) : delta 𝕜 F x₀ f = f x₀ := rfl + +end bounded_continuous_function + +end schwartz_map diff --git a/src/analysis/seminorm.lean b/src/analysis/seminorm.lean index 6d3d784dff027..b55e5f5b27a5a 100644 --- a/src/analysis/seminorm.lean +++ b/src/analysis/seminorm.lean @@ -3,15 +3,17 @@ Copyright (c) 2019 Jean Lo. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jean Lo, Yaël Dillies, Moritz Doll -/ -import analysis.locally_convex.basic import data.real.pointwise -import data.real.sqrt -import topology.algebra.filter_basis -import topology.algebra.module.locally_convex +import analysis.convex.function +import analysis.locally_convex.basic +import analysis.normed.group.add_torsor /-! # Seminorms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines seminorms. A seminorm is a function to the reals which is positive-semidefinite, absolutely homogeneous, and @@ -34,41 +36,93 @@ For a module over a normed ring: seminorm, locally convex, LCTVS -/ +set_option old_structure_cmd true + open normed_field set -open_locale big_operators nnreal pointwise topological_space +open_locale big_operators nnreal pointwise topology -variables {R R' 𝕜 E F G ι : Type*} +variables {R R' 𝕜 𝕜₂ 𝕜₃ 𝕝 E E₂ E₃ F G ι : Type*} /-- A seminorm on a module over a normed ring is a function to the reals that is positive semidefinite, positive homogeneous, and subadditive. -/ -structure seminorm (𝕜 : Type*) (E : Type*) [semi_normed_ring 𝕜] [add_monoid E] [has_scalar 𝕜 E] := -(to_fun : E → ℝ) -(smul' : ∀ (a : 𝕜) (x : E), to_fun (a • x) = ∥a∥ * to_fun x) -(triangle' : ∀ x y : E, to_fun (x + y) ≤ to_fun x + to_fun y) +structure seminorm (𝕜 : Type*) (E : Type*) [semi_normed_ring 𝕜] [add_group E] [has_smul 𝕜 E] + extends add_group_seminorm E := +(smul' : ∀ (a : 𝕜) (x : E), to_fun (a • x) = ‖a‖ * to_fun x) + +attribute [nolint doc_blame] seminorm.to_add_group_seminorm + +/-- `seminorm_class F 𝕜 E` states that `F` is a type of seminorms on the `𝕜`-module E. + +You should extend this class when you extend `seminorm`. -/ +class seminorm_class (F : Type*) (𝕜 E : out_param $ Type*) [semi_normed_ring 𝕜] [add_group E] + [has_smul 𝕜 E] extends add_group_seminorm_class F E ℝ := +(map_smul_eq_mul (f : F) (a : 𝕜) (x : E) : f (a • x) = ‖a‖ * f x) + +export seminorm_class (map_smul_eq_mul) + +-- `𝕜` is an `out_param`, so this is a false positive. +attribute [nolint dangerous_instance] seminorm_class.to_add_group_seminorm_class + +section of + +/-- Alternative constructor for a `seminorm` on an `add_comm_group E` that is a module over a +`semi_norm_ring 𝕜`. -/ +def seminorm.of [semi_normed_ring 𝕜] [add_comm_group E] [module 𝕜 E] (f : E → ℝ) + (add_le : ∀ (x y : E), f (x + y) ≤ f x + f y) + (smul : ∀ (a : 𝕜) (x : E), f (a • x) = ‖a‖ * f x) : seminorm 𝕜 E := +{ to_fun := f, + map_zero' := by rw [←zero_smul 𝕜 (0 : E), smul, norm_zero, zero_mul], + add_le' := add_le, + smul' := smul, + neg' := λ x, by rw [←neg_one_smul 𝕜, smul, norm_neg, ← smul, one_smul] } + +/-- Alternative constructor for a `seminorm` over a normed field `𝕜` that only assumes `f 0 = 0` +and an inequality for the scalar multiplication. -/ +def seminorm.of_smul_le [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] (f : E → ℝ) + (map_zero : f 0 = 0) (add_le : ∀ x y, f (x + y) ≤ f x + f y) + (smul_le : ∀ (r : 𝕜) x, f (r • x) ≤ ‖r‖ * f x) : seminorm 𝕜 E := +seminorm.of f add_le + (λ r x, begin + refine le_antisymm (smul_le r x) _, + by_cases r = 0, + { simp [h, map_zero] }, + rw ←mul_le_mul_left (inv_pos.mpr (norm_pos_iff.mpr h)), + rw inv_mul_cancel_left₀ (norm_ne_zero_iff.mpr h), + specialize smul_le r⁻¹ (r • x), + rw norm_inv at smul_le, + convert smul_le, + simp [h], + end) + +end of namespace seminorm section semi_normed_ring variables [semi_normed_ring 𝕜] -section add_monoid -variables [add_monoid E] +section add_group +variables [add_group E] -section has_scalar -variables [has_scalar 𝕜 E] +section has_smul +variables [has_smul 𝕜 E] -instance fun_like : fun_like (seminorm 𝕜 E) E (λ _, ℝ) := -{ coe := seminorm.to_fun, coe_injective' := λ f g h, by cases f; cases g; congr' } +instance seminorm_class : seminorm_class (seminorm 𝕜 E) 𝕜 E := +{ coe := λ f, f.to_fun, + coe_injective' := λ f g h, by cases f; cases g; congr', + map_zero := λ f, f.map_zero', + map_add_le_add := λ f, f.add_le', + map_neg_eq_map := λ f, f.neg', + map_smul_eq_mul := λ f, f.smul' } /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`. -/ -instance : has_coe_to_fun (seminorm 𝕜 E) (λ _, E → ℝ) := ⟨λ p, p.to_fun⟩ +instance : has_coe_to_fun (seminorm 𝕜 E) (λ _, E → ℝ) := fun_like.has_coe_to_fun @[ext] lemma ext {p q : seminorm 𝕜 E} (h : ∀ x, (p : E → ℝ) x = q x) : p = q := fun_like.ext p q h instance : has_zero (seminorm 𝕜 E) := -⟨{ to_fun := 0, - smul' := λ _ _, (mul_zero _).symm, - triangle' := λ _ _, eq.ge (zero_add _) }⟩ +⟨{ smul' := λ _ _, (mul_zero _).symm, + ..add_group_seminorm.has_zero.zero }⟩ @[simp] lemma coe_zero : ⇑(0 : seminorm 𝕜 E) = 0 := rfl @@ -78,42 +132,34 @@ instance : inhabited (seminorm 𝕜 E) := ⟨0⟩ variables (p : seminorm 𝕜 E) (c : 𝕜) (x y : E) (r : ℝ) -protected lemma smul : p (c • x) = ∥c∥ * p x := p.smul' _ _ -protected lemma triangle : p (x + y) ≤ p x + p y := p.triangle' _ _ - /-- Any action on `ℝ` which factors through `ℝ≥0` applies to a seminorm. -/ -instance [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : - has_scalar R (seminorm 𝕜 E) := +instance [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : + has_smul R (seminorm 𝕜 E) := { smul := λ r p, - { to_fun := λ x, r • p x, + { to_fun := λ x, r • p x, smul' := λ _ _, begin simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul], - rw [p.smul, mul_left_comm], + rw [map_smul_eq_mul, mul_left_comm], end, - triangle' := λ _ _, begin - simp only [←smul_one_smul ℝ≥0 r (_ : ℝ), nnreal.smul_def, smul_eq_mul], - exact (mul_le_mul_of_nonneg_left (p.triangle _ _) (nnreal.coe_nonneg _)).trans_eq - (mul_add _ _ _), - end } } + ..(r • p.to_add_group_seminorm) }} -instance [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] - [has_scalar R' ℝ] [has_scalar R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] - [has_scalar R R'] [is_scalar_tower R R' ℝ] : +instance [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] + [has_smul R' ℝ] [has_smul R' ℝ≥0] [is_scalar_tower R' ℝ≥0 ℝ] + [has_smul R R'] [is_scalar_tower R R' ℝ] : is_scalar_tower R R' (seminorm 𝕜 E) := { smul_assoc := λ r a p, ext $ λ x, smul_assoc r a (p x) } -lemma coe_smul [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] +lemma coe_smul [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] (r : R) (p : seminorm 𝕜 E) : ⇑(r • p) = r • p := rfl -@[simp] lemma smul_apply [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] +@[simp] lemma smul_apply [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] (r : R) (p : seminorm 𝕜 E) (x : E) : (r • p) x = r • p x := rfl instance : has_add (seminorm 𝕜 E) := { add := λ p q, - { to_fun := λ x, p x + q x, - smul' := λ a x, by rw [p.smul, q.smul, mul_add], - triangle' := λ _ _, has_le.le.trans_eq (add_le_add (p.triangle _ _) (q.triangle _ _)) - (add_add_add_comm _ _ _ _) } } + { to_fun := λ x, p x + q x, + smul' := λ a x, by simp only [map_smul_eq_mul, map_smul_eq_mul, mul_add], + ..(p.to_add_group_seminorm + q.to_add_group_seminorm) }} lemma coe_add (p q : seminorm 𝕜 E) : ⇑(p + q) = p + q := rfl @@ -125,7 +171,7 @@ fun_like.coe_injective.add_monoid _ rfl coe_add (λ p n, coe_smul n p) instance : ordered_cancel_add_comm_monoid (seminorm 𝕜 E) := fun_like.coe_injective.ordered_cancel_add_comm_monoid _ rfl coe_add (λ p n, coe_smul n p) -instance [monoid R] [mul_action R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : +instance [monoid R] [mul_action R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : mul_action R (seminorm 𝕜 E) := fun_like.coe_injective.mul_action _ coe_smul @@ -141,135 +187,102 @@ show @function.injective (seminorm 𝕜 E) (E → ℝ) coe_fn, from fun_like.coe variables {𝕜 E} -instance [monoid R] [distrib_mul_action R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : +instance [monoid R] [distrib_mul_action R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : distrib_mul_action R (seminorm 𝕜 E) := (coe_fn_add_monoid_hom_injective 𝕜 E).distrib_mul_action _ coe_smul -instance [semiring R] [module R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : +instance [semiring R] [module R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] : module R (seminorm 𝕜 E) := (coe_fn_add_monoid_hom_injective 𝕜 E).module R _ coe_smul --- TODO: define `has_Sup` too, from the skeleton at --- https://github.com/leanprover-community/mathlib/pull/11329#issuecomment-1008915345 -noncomputable instance : has_sup (seminorm 𝕜 E) := +instance : has_sup (seminorm 𝕜 E) := { sup := λ p q, - { to_fun := p ⊔ q, - triangle' := λ x y, sup_le - ((p.triangle x y).trans $ add_le_add le_sup_left le_sup_left) - ((q.triangle x y).trans $ add_le_add le_sup_right le_sup_right), - smul' := λ x v, (congr_arg2 max (p.smul x v) (q.smul x v)).trans $ - (mul_max_of_nonneg _ _ $ norm_nonneg x).symm } } + { to_fun := p ⊔ q, + smul' := λ x v, (congr_arg2 max (map_smul_eq_mul p x v) (map_smul_eq_mul q x v)).trans $ + (mul_max_of_nonneg _ _ $ norm_nonneg x).symm, + ..(p.to_add_group_seminorm ⊔ q.to_add_group_seminorm) } } @[simp] lemma coe_sup (p q : seminorm 𝕜 E) : ⇑(p ⊔ q) = p ⊔ q := rfl lemma sup_apply (p q : seminorm 𝕜 E) (x : E) : (p ⊔ q) x = p x ⊔ q x := rfl -lemma smul_sup [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] +lemma smul_sup [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] (r : R) (p q : seminorm 𝕜 E) : r • (p ⊔ q) = r • p ⊔ r • q := have real.smul_max : ∀ x y : ℝ, r • max x y = max (r • x) (r • y), from λ x y, by simpa only [←smul_eq_mul, ←nnreal.smul_def, smul_one_smul ℝ≥0 r (_ : ℝ)] - using mul_max_of_nonneg x y (r • 1 : ℝ≥0).prop, + using mul_max_of_nonneg x y (r • 1 : ℝ≥0).coe_nonneg, ext $ λ x, real.smul_max _ _ instance : partial_order (seminorm 𝕜 E) := partial_order.lift _ fun_like.coe_injective -lemma le_def (p q : seminorm 𝕜 E) : p ≤ q ↔ (p : E → ℝ) ≤ q := iff.rfl -lemma lt_def (p q : seminorm 𝕜 E) : p < q ↔ (p : E → ℝ) < q := iff.rfl - -noncomputable instance : semilattice_sup (seminorm 𝕜 E) := -function.injective.semilattice_sup _ fun_like.coe_injective coe_sup +@[simp, norm_cast] lemma coe_le_coe {p q : seminorm 𝕜 E} : (p : E → ℝ) ≤ q ↔ p ≤ q := iff.rfl +@[simp, norm_cast] lemma coe_lt_coe {p q : seminorm 𝕜 E} : (p : E → ℝ) < q ↔ p < q := iff.rfl -end has_scalar +lemma le_def {p q : seminorm 𝕜 E} : p ≤ q ↔ ∀ x, p x ≤ q x := iff.rfl +lemma lt_def {p q : seminorm 𝕜 E} : p < q ↔ p ≤ q ∧ ∃ x, p x < q x := pi.lt_def -section smul_with_zero -variables [smul_with_zero 𝕜 E] (p : seminorm 𝕜 E) +instance : semilattice_sup (seminorm 𝕜 E) := +function.injective.semilattice_sup _ fun_like.coe_injective coe_sup -@[simp] -protected lemma zero : p 0 = 0 := -calc p 0 = p ((0 : 𝕜) • 0) : by rw zero_smul -... = 0 : by rw [p.smul, norm_zero, zero_mul] +end has_smul -end smul_with_zero -end add_monoid +end add_group section module -variables [add_comm_group E] [add_comm_group F] [add_comm_group G] -variables [module 𝕜 E] [module 𝕜 F] [module 𝕜 G] -variables [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] +variables [semi_normed_ring 𝕜₂] [semi_normed_ring 𝕜₃] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] +variables {σ₂₃ : 𝕜₂ →+* 𝕜₃} [ring_hom_isometric σ₂₃] +variables {σ₁₃ : 𝕜 →+* 𝕜₃} [ring_hom_isometric σ₁₃] +variables [add_comm_group E] [add_comm_group E₂] [add_comm_group E₃] +variables [add_comm_group F] [add_comm_group G] +variables [module 𝕜 E] [module 𝕜₂ E₂] [module 𝕜₃ E₃] [module 𝕜 F] [module 𝕜 G] +variables [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] /-- Composition of a seminorm with a linear map is a seminorm. -/ -def comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : seminorm 𝕜 E := -{ to_fun := λ x, p(f x), - smul' := λ _ _, (congr_arg p (f.map_smul _ _)).trans (p.smul _ _), - triangle' := λ _ _, eq.trans_le (congr_arg p (f.map_add _ _)) (p.triangle _ _) } +def comp (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) : seminorm 𝕜 E := +{ to_fun := λ x, p (f x), + smul' := λ _ _, by rw [map_smulₛₗ, map_smul_eq_mul, ring_hom_isometric.is_iso], + ..(p.to_add_group_seminorm.comp f.to_add_monoid_hom) } -lemma coe_comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : ⇑(p.comp f) = p ∘ f := rfl +lemma coe_comp (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) : ⇑(p.comp f) = p ∘ f := rfl -@[simp] lemma comp_apply (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (x : E) : (p.comp f) x = p (f x) := rfl +@[simp] lemma comp_apply (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) (x : E) : + (p.comp f) x = p (f x) := rfl @[simp] lemma comp_id (p : seminorm 𝕜 E) : p.comp linear_map.id = p := ext $ λ _, rfl -@[simp] lemma comp_zero (p : seminorm 𝕜 F) : p.comp (0 : E →ₗ[𝕜] F) = 0 := -ext $ λ _, seminorm.zero _ +@[simp] lemma comp_zero (p : seminorm 𝕜₂ E₂) : p.comp (0 : E →ₛₗ[σ₁₂] E₂) = 0 := +ext $ λ _, map_zero p -@[simp] lemma zero_comp (f : E →ₗ[𝕜] F) : (0 : seminorm 𝕜 F).comp f = 0 := +@[simp] lemma zero_comp (f : E →ₛₗ[σ₁₂] E₂) : (0 : seminorm 𝕜₂ E₂).comp f = 0 := ext $ λ _, rfl -lemma comp_comp (p : seminorm 𝕜 G) (g : F →ₗ[𝕜] G) (f : E →ₗ[𝕜] F) : +lemma comp_comp [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] (p : seminorm 𝕜₃ E₃) + (g : E₂ →ₛₗ[σ₂₃] E₃) (f : E →ₛₗ[σ₁₂] E₂) : p.comp (g.comp f) = (p.comp g).comp f := ext $ λ _, rfl -lemma add_comp (p q : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) : (p + q).comp f = p.comp f + q.comp f := +lemma add_comp (p q : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) : (p + q).comp f = p.comp f + q.comp f := ext $ λ _, rfl -lemma comp_triangle (p : seminorm 𝕜 F) (f g : E →ₗ[𝕜] F) : p.comp (f + g) ≤ p.comp f + p.comp g := -λ _, p.triangle _ _ +lemma comp_add_le (p : seminorm 𝕜₂ E₂) (f g : E →ₛₗ[σ₁₂] E₂) : + p.comp (f + g) ≤ p.comp f + p.comp g := +λ _, map_add_le_add p _ _ -lemma smul_comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (c : R) : (c • p).comp f = c • (p.comp f) := +lemma smul_comp (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) (c : R) : + (c • p).comp f = c • (p.comp f) := ext $ λ _, rfl -lemma comp_mono {p : seminorm 𝕜 F} {q : seminorm 𝕜 F} (f : E →ₗ[𝕜] F) (hp : p ≤ q) : +lemma comp_mono {p q : seminorm 𝕜₂ E₂} (f : E →ₛₗ[σ₁₂] E₂) (hp : p ≤ q) : p.comp f ≤ q.comp f := λ _, hp _ /-- The composition as an `add_monoid_hom`. -/ -@[simps] def pullback (f : E →ₗ[𝕜] F) : add_monoid_hom (seminorm 𝕜 F) (seminorm 𝕜 E) := +@[simps] def pullback (f : E →ₛₗ[σ₁₂] E₂) : seminorm 𝕜₂ E₂ →+ seminorm 𝕜 E := ⟨λ p, p.comp f, zero_comp f, λ p q, add_comp p q f⟩ -section norm_one_class -variables [norm_one_class 𝕜] (p : seminorm 𝕜 E) (x y : E) (r : ℝ) - -@[simp] -protected lemma neg : p (-x) = p x := -calc p (-x) = p ((-1 : 𝕜) • x) : by rw neg_one_smul -... = p x : by rw [p.smul, norm_neg, norm_one, one_mul] - -protected lemma sub_le : p (x - y) ≤ p x + p y := -calc - p (x - y) - = p (x + -y) : by rw sub_eq_add_neg - ... ≤ p x + p (-y) : p.triangle x (-y) - ... = p x + p y : by rw p.neg - -lemma nonneg : 0 ≤ p x := -have h: 0 ≤ 2 * p x, from -calc 0 = p (x + (- x)) : by rw [add_neg_self, p.zero] -... ≤ p x + p (-x) : p.triangle _ _ -... = 2 * p x : by rw [p.neg, two_mul], -nonneg_of_mul_nonneg_left h zero_lt_two - -lemma sub_rev : p (x - y) = p (y - x) := by rw [←neg_sub, p.neg] - -/-- The direct path from 0 to y is shorter than the path with x "inserted" in between. -/ -lemma le_insert : p y ≤ p x + p (x - y) := -calc p y = p (x - (x - y)) : by rw sub_sub_cancel -... ≤ p x + p (x - y) : p.sub_le _ _ - -/-- The direct path from 0 to x is shorter than the path with y "inserted" in between. -/ -lemma le_insert' : p x ≤ p y + p (x - y) := by { rw sub_rev, exact le_insert _ _ _ } - -instance : order_bot (seminorm 𝕜 E) := ⟨0, nonneg⟩ +instance : order_bot (seminorm 𝕜 E) := ⟨0, map_nonneg⟩ @[simp] lemma coe_bot : ⇑(⊥ : seminorm 𝕜 E) = 0 := rfl @@ -278,14 +291,14 @@ lemma bot_eq_zero : (⊥ : seminorm 𝕜 E) = 0 := rfl lemma smul_le_smul {p q : seminorm 𝕜 E} {a b : ℝ≥0} (hpq : p ≤ q) (hab : a ≤ b) : a • p ≤ b • q := begin - simp_rw [le_def, pi.le_def, coe_smul], + simp_rw [le_def, coe_smul], intros x, simp_rw [pi.smul_apply, nnreal.smul_def, smul_eq_mul], - exact mul_le_mul hab (hpq x) (nonneg p x) (nnreal.coe_nonneg b), + exact mul_le_mul hab (hpq x) (map_nonneg p x) (nnreal.coe_nonneg b), end lemma finset_sup_apply (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) : - s.sup p x = ↑(s.sup (λ i, ⟨p i x, nonneg (p i) x⟩) : ℝ≥0) := + s.sup p x = ↑(s.sup (λ i, ⟨p i x, map_nonneg (p i) x⟩) : ℝ≥0) := begin induction s using finset.cons_induction_on with a s ha ih, { rw [finset.sup_empty, finset.sup_empty, coe_bot, _root_.bot_eq_zero, pi.zero_apply, @@ -320,69 +333,65 @@ begin { exact nnreal.coe_pos.mpr ha }, end -end norm_one_class +lemma norm_sub_map_le_sub (p : seminorm 𝕜 E) (x y : E) : ‖p x - p y‖ ≤ p (x - y) := +abs_sub_map_le_sub p x y + end module end semi_normed_ring section semi_normed_comm_ring -variables [semi_normed_comm_ring 𝕜] [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] +variables [semi_normed_ring 𝕜] [semi_normed_comm_ring 𝕜₂] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] +variables [add_comm_group E] [add_comm_group E₂] [module 𝕜 E] [module 𝕜₂ E₂] -lemma comp_smul (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (c : 𝕜) : - p.comp (c • f) = ∥c∥₊ • p.comp f := -ext $ λ _, by rw [comp_apply, smul_apply, linear_map.smul_apply, p.smul, nnreal.smul_def, +lemma comp_smul (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) (c : 𝕜₂) : + p.comp (c • f) = ‖c‖₊ • p.comp f := +ext $ λ _, by rw [comp_apply, smul_apply, linear_map.smul_apply, map_smul_eq_mul, nnreal.smul_def, coe_nnnorm, smul_eq_mul, comp_apply] -lemma comp_smul_apply (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (c : 𝕜) (x : E) : - p.comp (c • f) x = ∥c∥ * p (f x) := p.smul _ _ +lemma comp_smul_apply (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) (c : 𝕜₂) (x : E) : + p.comp (c • f) x = ‖c‖ * p (f x) := map_smul_eq_mul p _ _ end semi_normed_comm_ring section normed_field -variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] +variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] {p q : seminorm 𝕜 E} {x : E} -private lemma bdd_below_range_add (x : E) (p q : seminorm 𝕜 E) : - bdd_below (range (λ (u : E), p u + q (x - u))) := -by { use 0, rintro _ ⟨x, rfl⟩, exact add_nonneg (p.nonneg _) (q.nonneg _) } +/-- Auxiliary lemma to show that the infimum of seminorms is well-defined. -/ +lemma bdd_below_range_add : bdd_below (range $ λ u, p u + q (x - u)) := +⟨0, by { rintro _ ⟨x, rfl⟩, dsimp, positivity }⟩ noncomputable instance : has_inf (seminorm 𝕜 E) := { inf := λ p q, - { to_fun := λ x, ⨅ u : E, p u + q (x-u), - triangle' := λ x y, begin - refine le_cinfi_add_cinfi (λ u v, _), - apply cinfi_le_of_le (bdd_below_range_add _ _ _) (v+u), dsimp only, - convert add_le_add (p.triangle v u) (q.triangle (y-v) (x-u)) using 1, - { rw show x + y - (v + u) = y - v + (x - u), by abel }, - { abel }, - end, - smul' := λ a x, begin + { to_fun := λ x, ⨅ u : E, p u + q (x-u), + smul' := + begin + intros a x, obtain rfl | ha := eq_or_ne a 0, - { simp_rw [norm_zero, zero_mul, zero_smul, zero_sub, seminorm.neg], - refine cinfi_eq_of_forall_ge_of_forall_gt_exists_lt - (λ i, add_nonneg (p.nonneg _) (q.nonneg _)) - (λ x hx, ⟨0, by rwa [p.zero, q.zero, add_zero]⟩) }, - simp_rw [real.mul_infi_of_nonneg (norm_nonneg a), mul_add, ←p.smul, ←q.smul, smul_sub], + { rw [norm_zero, zero_mul, zero_smul], + refine cinfi_eq_of_forall_ge_of_forall_gt_exists_lt (λ i, by positivity) + (λ x hx, ⟨0, by rwa [map_zero, sub_zero, map_zero, add_zero]⟩) }, + simp_rw [real.mul_infi_of_nonneg (norm_nonneg a), mul_add, ←map_smul_eq_mul p, + ←map_smul_eq_mul q, smul_sub], refine function.surjective.infi_congr ((•) a⁻¹ : E → E) (λ u, ⟨a • u, inv_smul_smul₀ ha u⟩) (λ u, _), - rw smul_inv_smul₀ ha, - end } } + rw smul_inv_smul₀ ha + end, + ..(p.to_add_group_seminorm ⊓ q.to_add_group_seminorm) }} @[simp] lemma inf_apply (p q : seminorm 𝕜 E) (x : E) : (p ⊓ q) x = ⨅ u : E, p u + q (x-u) := rfl noncomputable instance : lattice (seminorm 𝕜 E) := { inf := (⊓), - inf_le_left := λ p q x, begin - apply cinfi_le_of_le (bdd_below_range_add _ _ _) x, - simp only [sub_self, seminorm.zero, add_zero], - end, - inf_le_right := λ p q x, begin - apply cinfi_le_of_le (bdd_below_range_add _ _ _) (0:E), - simp only [sub_self, seminorm.zero, zero_add, sub_zero], - end, + inf_le_left := λ p q x, cinfi_le_of_le bdd_below_range_add x $ + by simp only [sub_self, map_zero, add_zero], + inf_le_right := λ p q x, cinfi_le_of_le bdd_below_range_add 0 $ + by simp only [sub_self, map_zero, zero_add, sub_zero], le_inf := λ a b c hab hac x, - le_cinfi $ λ u, le_trans (a.le_insert' _ _) (add_le_add (hab _) (hac _)), + le_cinfi $ λ u, (le_map_add_map_sub a _ _).trans $ add_le_add (hab _) (hac _), ..seminorm.semilattice_sup } -lemma smul_inf [has_scalar R ℝ] [has_scalar R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] +lemma smul_inf [has_smul R ℝ] [has_smul R ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ] (r : R) (p q : seminorm 𝕜 E) : r • (p ⊓ q) = r • p ⊓ r • q := begin @@ -391,6 +400,107 @@ begin smul_eq_mul, real.mul_infi_of_nonneg (subtype.prop _), mul_add], end +section classical + +open_locale classical + +/-- We define the supremum of an arbitrary subset of `seminorm 𝕜 E` as follows: +* if `s` is `bdd_above` *as a set of functions `E → ℝ`* (that is, if `s` is pointwise bounded +above), we take the pointwise supremum of all elements of `s`, and we prove that it is indeed a +seminorm. +* otherwise, we take the zero seminorm `⊥`. + +There are two things worth mentionning here: +* First, it is not trivial at first that `s` being bounded above *by a function* implies +being bounded above *as a seminorm*. We show this in `seminorm.bdd_above_iff` by using +that the `Sup s` as defined here is then a bounding seminorm for `s`. So it is important to make +the case disjunction on `bdd_above (coe_fn '' s : set (E → ℝ))` and not `bdd_above s`. +* Since the pointwise `Sup` already gives `0` at points where a family of functions is +not bounded above, one could hope that just using the pointwise `Sup` would work here, without the +need for an additional case disjunction. As discussed on Zulip, this doesn't work because this can +give a function which does *not* satisfy the seminorm axioms (typically sub-additivity). +-/ +noncomputable instance : has_Sup (seminorm 𝕜 E) := +{ Sup := λ s, if h : bdd_above (coe_fn '' s : set (E → ℝ)) then + { to_fun := ⨆ p : s, ((p : seminorm 𝕜 E) : E → ℝ), + map_zero' := + begin + rw [supr_apply, ← @real.csupr_const_zero s], + congrm ⨆ i, _, + exact map_zero i.1 + end, + add_le' := λ x y, + begin + rcases h with ⟨q, hq⟩, + obtain rfl | h := s.eq_empty_or_nonempty, + { simp [real.csupr_empty] }, + haveI : nonempty ↥s := h.coe_sort, + simp only [supr_apply], + refine csupr_le (λ i, ((i : seminorm 𝕜 E).add_le' x y).trans $ + add_le_add (le_csupr ⟨q x, _⟩ i) (le_csupr ⟨q y, _⟩ i)); + rw [mem_upper_bounds, forall_range_iff]; + exact λ j, hq (mem_image_of_mem _ j.2) _, + end, + neg' := λ x, + begin + simp only [supr_apply], + congrm ⨆ i, _, + exact i.1.neg' _ + end, + smul' := λ a x, + begin + simp only [supr_apply], + rw [← smul_eq_mul, real.smul_supr_of_nonneg (norm_nonneg a) (λ i : s, (i : seminorm 𝕜 E) x)], + congrm ⨆ i, _, + exact i.1.smul' a x + end } + else ⊥ } + +protected lemma coe_Sup_eq' {s : set $ seminorm 𝕜 E} (hs : bdd_above (coe_fn '' s : set (E → ℝ))) : + coe_fn (Sup s) = ⨆ p : s, p := +congr_arg _ (dif_pos hs) + +protected lemma bdd_above_iff {s : set $ seminorm 𝕜 E} : + bdd_above s ↔ bdd_above (coe_fn '' s : set (E → ℝ)) := +⟨λ ⟨q, hq⟩, ⟨q, ball_image_of_ball $ λ p hp, hq hp⟩, + λ H, ⟨Sup s, λ p hp x, + begin + rw [seminorm.coe_Sup_eq' H, supr_apply], + rcases H with ⟨q, hq⟩, + exact le_csupr ⟨q x, forall_range_iff.mpr $ λ i : s, hq (mem_image_of_mem _ i.2) x⟩ ⟨p, hp⟩ + end ⟩⟩ + +protected lemma coe_Sup_eq {s : set $ seminorm 𝕜 E} (hs : bdd_above s) : + coe_fn (Sup s) = ⨆ p : s, p := +seminorm.coe_Sup_eq' (seminorm.bdd_above_iff.mp hs) + +protected lemma coe_supr_eq {ι : Type*} {p : ι → seminorm 𝕜 E} (hp : bdd_above (range p)) : + coe_fn (⨆ i, p i) = ⨆ i, p i := +by rw [← Sup_range, seminorm.coe_Sup_eq hp]; exact supr_range' (coe_fn : seminorm 𝕜 E → E → ℝ) p + +private lemma seminorm.is_lub_Sup (s : set (seminorm 𝕜 E)) (hs₁ : bdd_above s) (hs₂ : s.nonempty) : + is_lub s (Sup s) := +begin + refine ⟨λ p hp x, _, λ p hp x, _⟩; + haveI : nonempty ↥s := hs₂.coe_sort; + rw [seminorm.coe_Sup_eq hs₁, supr_apply], + { rcases hs₁ with ⟨q, hq⟩, + exact le_csupr ⟨q x, forall_range_iff.mpr $ λ i : s, hq i.2 x⟩ ⟨p, hp⟩ }, + { exact csupr_le (λ q, hp q.2 x) } +end + +/-- `seminorm 𝕜 E` is a conditionally complete lattice. + +Note that, while `inf`, `sup` and `Sup` have good definitional properties (corresponding to +`seminorm.has_inf`, `seminorm.has_sup` and `seminorm.has_Sup` respectively), `Inf s` is just +defined as the supremum of the lower bounds of `s`, which is not really useful in practice. If you +need to use `Inf` on seminorms, then you should probably provide a more workable definition first, +but this is unlikely to happen so we keep the "bad" definition for now. -/ +noncomputable instance : conditionally_complete_lattice (seminorm 𝕜 E) := +conditionally_complete_lattice_of_lattice_of_Sup (seminorm 𝕜 E) seminorm.is_lub_Sup + +end classical + end normed_field /-! ### Seminorm ball -/ @@ -401,20 +511,36 @@ variables [semi_normed_ring 𝕜] section add_comm_group variables [add_comm_group E] -section has_scalar -variables [has_scalar 𝕜 E] (p : seminorm 𝕜 E) +section has_smul +variables [has_smul 𝕜 E] (p : seminorm 𝕜 E) /-- The ball of radius `r` at `x` with respect to seminorm `p` is the set of elements `y` with -`p (y - x) < `r`. -/ +`p (y - x) < r`. -/ def ball (x : E) (r : ℝ) := { y : E | p (y - x) < r } +/-- The closed ball of radius `r` at `x` with respect to seminorm `p` is the set of elements `y` +with `p (y - x) ≤ r`. -/ +def closed_ball (x : E) (r : ℝ) := { y : E | p (y - x) ≤ r } + variables {x y : E} {r : ℝ} @[simp] lemma mem_ball : y ∈ ball p x r ↔ p (y - x) < r := iff.rfl +@[simp] lemma mem_closed_ball : y ∈ closed_ball p x r ↔ p (y - x) ≤ r := iff.rfl + +lemma mem_ball_self (hr : 0 < r) : x ∈ ball p x r := by simp [hr] +lemma mem_closed_ball_self (hr : 0 ≤ r) : x ∈ closed_ball p x r := by simp [hr] lemma mem_ball_zero : y ∈ ball p 0 r ↔ p y < r := by rw [mem_ball, sub_zero] +lemma mem_closed_ball_zero : y ∈ closed_ball p 0 r ↔ p y ≤ r := by rw [mem_closed_ball, sub_zero] lemma ball_zero_eq : ball p 0 r = { y : E | p y < r } := set.ext $ λ x, p.mem_ball_zero +lemma closed_ball_zero_eq : closed_ball p 0 r = { y : E | p y ≤ r } := +set.ext $ λ x, p.mem_closed_ball_zero + +lemma ball_subset_closed_ball (x r) : ball p x r ⊆ closed_ball p x r := λ y (hy : _ < _), hy.le + +lemma closed_ball_eq_bInter_ball (x r) : closed_ball p x r = ⋂ ρ > r, ball p x ρ := +by ext y; simp_rw [mem_closed_ball, mem_Inter₂, mem_ball, ← forall_lt_iff_le'] @[simp] lemma ball_zero' (x : E) (hr : 0 < r) : ball (0 : seminorm 𝕜 E) x r = set.univ := begin @@ -422,15 +548,28 @@ begin simp [hr], end +@[simp] lemma closed_ball_zero' (x : E) (hr : 0 < r) : + closed_ball (0 : seminorm 𝕜 E) x r = set.univ := +eq_univ_of_subset (ball_subset_closed_ball _ _ _) (ball_zero' x hr) + lemma ball_smul (p : seminorm 𝕜 E) {c : nnreal} (hc : 0 < c) (r : ℝ) (x : E) : (c • p).ball x r = p.ball x (r / c) := by { ext, rw [mem_ball, mem_ball, smul_apply, nnreal.smul_def, smul_eq_mul, mul_comm, lt_div_iff (nnreal.coe_pos.mpr hc)] } +lemma closed_ball_smul (p : seminorm 𝕜 E) {c : nnreal} (hc : 0 < c) (r : ℝ) (x : E) : + (c • p).closed_ball x r = p.closed_ball x (r / c) := +by { ext, rw [mem_closed_ball, mem_closed_ball, smul_apply, nnreal.smul_def, smul_eq_mul, mul_comm, + le_div_iff (nnreal.coe_pos.mpr hc)] } + lemma ball_sup (p : seminorm 𝕜 E) (q : seminorm 𝕜 E) (e : E) (r : ℝ) : ball (p ⊔ q) e r = ball p e r ∩ ball q e r := by simp_rw [ball, ←set.set_of_and, coe_sup, pi.sup_apply, sup_lt_iff] +lemma closed_ball_sup (p : seminorm 𝕜 E) (q : seminorm 𝕜 E) (e : E) (r : ℝ) : + closed_ball (p ⊔ q) e r = closed_ball p e r ∩ closed_ball q e r := +by simp_rw [closed_ball, ←set.set_of_and, coe_sup, pi.sup_apply, sup_le_iff] + lemma ball_finset_sup' (p : ι → seminorm 𝕜 E) (s : finset ι) (H : s.nonempty) (e : E) (r : ℝ) : ball (s.sup' H p) e r = s.inf' H (λ i, ball (p i) e r) := begin @@ -439,56 +578,137 @@ begin { rw [finset.sup'_cons hs, finset.inf'_cons hs, ball_sup, inf_eq_inter, ih] }, end +lemma closed_ball_finset_sup' (p : ι → seminorm 𝕜 E) (s : finset ι) (H : s.nonempty) (e : E) + (r : ℝ) : closed_ball (s.sup' H p) e r = s.inf' H (λ i, closed_ball (p i) e r) := +begin + induction H using finset.nonempty.cons_induction with a a s ha hs ih, + { classical, simp }, + { rw [finset.sup'_cons hs, finset.inf'_cons hs, closed_ball_sup, inf_eq_inter, ih] }, +end + lemma ball_mono {p : seminorm 𝕜 E} {r₁ r₂ : ℝ} (h : r₁ ≤ r₂) : p.ball x r₁ ⊆ p.ball x r₂ := λ _ (hx : _ < _), hx.trans_le h +lemma closed_ball_mono {p : seminorm 𝕜 E} {r₁ r₂ : ℝ} (h : r₁ ≤ r₂) : + p.closed_ball x r₁ ⊆ p.closed_ball x r₂ := +λ _ (hx : _ ≤ _), hx.trans h + lemma ball_antitone {p q : seminorm 𝕜 E} (h : q ≤ p) : p.ball x r ⊆ q.ball x r := λ _, (h _).trans_lt +lemma closed_ball_antitone {p q : seminorm 𝕜 E} (h : q ≤ p) : + p.closed_ball x r ⊆ q.closed_ball x r := +λ _, (h _).trans + lemma ball_add_ball_subset (p : seminorm 𝕜 E) (r₁ r₂ : ℝ) (x₁ x₂ : E): p.ball (x₁ : E) r₁ + p.ball (x₂ : E) r₂ ⊆ p.ball (x₁ + x₂) (r₁ + r₂) := begin rintros x ⟨y₁, y₂, hy₁, hy₂, rfl⟩, - rw [mem_ball, add_sub_comm], - exact (p.triangle _ _).trans_lt (add_lt_add hy₁ hy₂), + rw [mem_ball, add_sub_add_comm], + exact (map_add_le_add p _ _).trans_lt (add_lt_add hy₁ hy₂), +end + +lemma closed_ball_add_closed_ball_subset (p : seminorm 𝕜 E) (r₁ r₂ : ℝ) (x₁ x₂ : E) : + p.closed_ball (x₁ : E) r₁ + p.closed_ball (x₂ : E) r₂ ⊆ p.closed_ball (x₁ + x₂) (r₁ + r₂) := +begin + rintros x ⟨y₁, y₂, hy₁, hy₂, rfl⟩, + rw [mem_closed_ball, add_sub_add_comm], + exact (map_add_le_add p _ _).trans (add_le_add hy₁ hy₂) +end + +lemma sub_mem_ball (p : seminorm 𝕜 E) (x₁ x₂ y : E) (r : ℝ) : + x₁ - x₂ ∈ p.ball y r ↔ x₁ ∈ p.ball (x₂ + y) r := +by simp_rw [mem_ball, sub_sub] + +/-- The image of a ball under addition with a singleton is another ball. -/ +lemma vadd_ball (p : seminorm 𝕜 E) : + x +ᵥ p.ball y r = p.ball (x +ᵥ y) r := +begin + letI := add_group_seminorm.to_seminormed_add_comm_group p.to_add_group_seminorm, + exact metric.vadd_ball x y r, end -end has_scalar +/-- The image of a closed ball under addition with a singleton is another closed ball. -/ +lemma vadd_closed_ball (p : seminorm 𝕜 E) : + x +ᵥ p.closed_ball y r = p.closed_ball (x +ᵥ y) r := +begin + letI := add_group_seminorm.to_seminormed_add_comm_group p.to_add_group_seminorm, + exact metric.vadd_closed_ball x y r, +end + +end has_smul section module variables [module 𝕜 E] -variables [add_comm_group F] [module 𝕜 F] +variables [semi_normed_ring 𝕜₂] [add_comm_group E₂] [module 𝕜₂ E₂] +variables {σ₁₂ : 𝕜 →+* 𝕜₂} [ring_hom_isometric σ₁₂] -lemma ball_comp (p : seminorm 𝕜 F) (f : E →ₗ[𝕜] F) (x : E) (r : ℝ) : +lemma ball_comp (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) (x : E) (r : ℝ) : (p.comp f).ball x r = f ⁻¹' (p.ball (f x) r) := begin ext, simp_rw [ball, mem_preimage, comp_apply, set.mem_set_of_eq, map_sub], end -section norm_one_class -variables [norm_one_class 𝕜] (p : seminorm 𝕜 E) +lemma closed_ball_comp (p : seminorm 𝕜₂ E₂) (f : E →ₛₗ[σ₁₂] E₂) (x : E) (r : ℝ) : + (p.comp f).closed_ball x r = f ⁻¹' (p.closed_ball (f x) r) := +begin + ext, + simp_rw [closed_ball, mem_preimage, comp_apply, set.mem_set_of_eq, map_sub], +end -lemma ball_zero_eq_preimage_ball {r : ℝ} : - p.ball 0 r = p ⁻¹' (metric.ball 0 r) := +variables (p : seminorm 𝕜 E) + +lemma preimage_metric_ball {r : ℝ} : + p ⁻¹' (metric.ball 0 r) = {x | p x < r} := +begin + ext x, + simp only [mem_set_of, mem_preimage, mem_ball_zero_iff, real.norm_of_nonneg (map_nonneg p _)] +end + +lemma preimage_metric_closed_ball {r : ℝ} : + p ⁻¹' (metric.closed_ball 0 r) = {x | p x ≤ r} := begin ext x, - simp only [mem_ball, sub_zero, mem_preimage, mem_ball_zero_iff, real.norm_of_nonneg (p.nonneg x)], + simp only [mem_set_of, mem_preimage, mem_closed_ball_zero_iff, + real.norm_of_nonneg (map_nonneg p _)] end -@[simp] lemma ball_bot {r : ℝ} (x : E) (hr : 0 < r) : ball (⊥ : seminorm 𝕜 E) x r = set.univ := +lemma ball_zero_eq_preimage_ball {r : ℝ} : + p.ball 0 r = p ⁻¹' (metric.ball 0 r) := +by rw [ball_zero_eq, preimage_metric_ball] + +lemma closed_ball_zero_eq_preimage_closed_ball {r : ℝ} : + p.closed_ball 0 r = p ⁻¹' (metric.closed_ball 0 r) := +by rw [closed_ball_zero_eq, preimage_metric_closed_ball] + +@[simp] lemma ball_bot {r : ℝ} (x : E) (hr : 0 < r) : + ball (⊥ : seminorm 𝕜 E) x r = set.univ := ball_zero' x hr +@[simp] lemma closed_ball_bot {r : ℝ} (x : E) (hr : 0 < r) : + closed_ball (⊥ : seminorm 𝕜 E) x r = set.univ := +closed_ball_zero' x hr + /-- Seminorm-balls at the origin are balanced. -/ lemma balanced_ball_zero (r : ℝ) : balanced 𝕜 (ball p 0 r) := begin rintro a ha x ⟨y, hy, hx⟩, - rw [mem_ball_zero, ←hx, p.smul], - calc _ ≤ p y : mul_le_of_le_one_left (p.nonneg _) ha + rw [mem_ball_zero, ←hx, map_smul_eq_mul], + calc _ ≤ p y : mul_le_of_le_one_left (map_nonneg p _) ha ... < r : by rwa mem_ball_zero at hy, end +/-- Closed seminorm-balls at the origin are balanced. -/ +lemma balanced_closed_ball_zero (r : ℝ) : balanced 𝕜 (closed_ball p 0 r) := +begin + rintro a ha x ⟨y, hy, hx⟩, + rw [mem_closed_ball_zero, ←hx, map_smul_eq_mul], + calc _ ≤ p y : mul_le_of_le_one_left (map_nonneg p _) ha + ... ≤ r : by rwa mem_closed_ball_zero at hy +end + lemma ball_finset_sup_eq_Inter (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ} (hr : 0 < r) : ball (s.sup p) x r = ⋂ (i ∈ s), ball (p i) x r := begin @@ -497,13 +717,28 @@ begin finset.sup_lt_iff (show ⊥ < r, from hr), ←nnreal.coe_lt_coe, subtype.coe_mk], end -lemma ball_finset_sup (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ} - (hr : 0 < r) : ball (s.sup p) x r = s.inf (λ i, ball (p i) x r) := +lemma closed_ball_finset_sup_eq_Inter (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ} + (hr : 0 ≤ r) : closed_ball (s.sup p) x r = ⋂ (i ∈ s), closed_ball (p i) x r := +begin + lift r to nnreal using hr, + simp_rw [closed_ball, Inter_set_of, finset_sup_apply, nnreal.coe_le_coe, + finset.sup_le_iff, ←nnreal.coe_le_coe, subtype.coe_mk] +end + +lemma ball_finset_sup (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ} (hr : 0 < r) : + ball (s.sup p) x r = s.inf (λ i, ball (p i) x r) := begin rw finset.inf_eq_infi, exact ball_finset_sup_eq_Inter _ _ _ hr, end +lemma closed_ball_finset_sup (p : ι → seminorm 𝕜 E) (s : finset ι) (x : E) {r : ℝ} (hr : 0 ≤ r) : + closed_ball (s.sup p) x r = s.inf (λ i, closed_ball (p i) x r) := +begin + rw finset.inf_eq_infi, + exact closed_ball_finset_sup_eq_Inter _ _ _ hr, +end + lemma ball_smul_ball (p : seminorm 𝕜 E) (r₁ r₂ : ℝ) : metric.ball (0 : 𝕜) r₁ • p.ball 0 r₂ ⊆ p.ball 0 (r₁ * r₂) := begin @@ -511,18 +746,38 @@ begin intros x hx, rw set.mem_smul at hx, rcases hx with ⟨a, y, ha, hy, hx⟩, - rw [←hx, mem_ball_zero, seminorm.smul], - exact mul_lt_mul'' (mem_ball_zero_iff.mp ha) (p.mem_ball_zero.mp hy) (norm_nonneg a) (p.nonneg y), + rw [←hx, mem_ball_zero, map_smul_eq_mul], + exact mul_lt_mul'' (mem_ball_zero_iff.mp ha) (p.mem_ball_zero.mp hy) (norm_nonneg a) + (map_nonneg p y), +end + +lemma closed_ball_smul_closed_ball (p : seminorm 𝕜 E) (r₁ r₂ : ℝ) : + metric.closed_ball (0 : 𝕜) r₁ • p.closed_ball 0 r₂ ⊆ p.closed_ball 0 (r₁ * r₂) := +begin + rw set.subset_def, + intros x hx, + rw set.mem_smul at hx, + rcases hx with ⟨a, y, ha, hy, hx⟩, + rw [←hx, mem_closed_ball_zero, map_smul_eq_mul], + rw mem_closed_ball_zero_iff at ha, + exact mul_le_mul ha (p.mem_closed_ball_zero.mp hy) (map_nonneg _ y) ((norm_nonneg a).trans ha) end @[simp] lemma ball_eq_emptyset (p : seminorm 𝕜 E) {x : E} {r : ℝ} (hr : r ≤ 0) : p.ball x r = ∅ := begin ext, - rw [seminorm.mem_ball, set.mem_empty_eq, iff_false, not_lt], - exact hr.trans (p.nonneg _), + rw [seminorm.mem_ball, set.mem_empty_iff_false, iff_false, not_lt], + exact hr.trans (map_nonneg p _), +end + +@[simp] lemma closed_ball_eq_emptyset (p : seminorm 𝕜 E) {x : E} {r : ℝ} (hr : r < 0) : + p.closed_ball x r = ∅ := +begin + ext, + rw [seminorm.mem_closed_ball, set.mem_empty_iff_false, iff_false, not_le], + exact hr.trans_le (map_nonneg _ _), end -end norm_one_class end module end add_comm_group end semi_normed_ring @@ -531,58 +786,83 @@ section normed_field variables [normed_field 𝕜] [add_comm_group E] [module 𝕜 E] (p : seminorm 𝕜 E) {A B : set E} {a : 𝕜} {r : ℝ} {x : E} -lemma smul_ball_zero {p : seminorm 𝕜 E} {k : 𝕜} {r : ℝ} (hk : 0 < ∥k∥) : - k • p.ball 0 r = p.ball 0 (∥k∥ * r) := +lemma ball_norm_mul_subset {p : seminorm 𝕜 E} {k : 𝕜} {r : ℝ} : + p.ball 0 (‖k‖ * r) ⊆ k • p.ball 0 r := +begin + rcases eq_or_ne k 0 with (rfl | hk), + { rw [norm_zero, zero_mul, ball_eq_emptyset _ le_rfl], + exact empty_subset _ }, + { intro x, + rw [set.mem_smul_set, seminorm.mem_ball_zero], + refine λ hx, ⟨k⁻¹ • x, _, _⟩, + { rwa [seminorm.mem_ball_zero, map_smul_eq_mul, norm_inv, + ←(mul_lt_mul_left $ norm_pos_iff.mpr hk), ←mul_assoc, ←(div_eq_mul_inv ‖k‖ ‖k‖), + div_self (ne_of_gt $ norm_pos_iff.mpr hk), one_mul] }, + rw [←smul_assoc, smul_eq_mul, ←div_eq_mul_inv, div_self hk, one_smul] } +end + +lemma smul_ball_zero {p : seminorm 𝕜 E} {k : 𝕜} {r : ℝ} (hk : k ≠ 0) : + k • p.ball 0 r = p.ball 0 (‖k‖ * r) := begin ext, - rw [set.mem_smul_set, seminorm.mem_ball_zero], - split; intro h, - { rcases h with ⟨y, hy, h⟩, - rw [←h, seminorm.smul], - rw seminorm.mem_ball_zero at hy, - exact (mul_lt_mul_left hk).mpr hy }, - refine ⟨k⁻¹ • x, _, _⟩, - { rw [seminorm.mem_ball_zero, seminorm.smul, norm_inv, ←(mul_lt_mul_left hk), - ←mul_assoc, ←(div_eq_mul_inv ∥k∥ ∥k∥), div_self (ne_of_gt hk), one_mul], - exact h}, + rw [mem_smul_set_iff_inv_smul_mem₀ hk, p.mem_ball_zero, p.mem_ball_zero, map_smul_eq_mul, + norm_inv, ← div_eq_inv_mul, div_lt_iff (norm_pos_iff.2 hk), mul_comm] +end + +lemma smul_closed_ball_subset {p : seminorm 𝕜 E} {k : 𝕜} {r : ℝ} : + k • p.closed_ball 0 r ⊆ p.closed_ball 0 (‖k‖ * r) := +begin + rintros x ⟨y, hy, h⟩, + rw [seminorm.mem_closed_ball_zero, ←h, map_smul_eq_mul], + rw seminorm.mem_closed_ball_zero at hy, + exact mul_le_mul_of_nonneg_left hy (norm_nonneg _) +end + +lemma smul_closed_ball_zero {p : seminorm 𝕜 E} {k : 𝕜} {r : ℝ} (hk : 0 < ‖k‖) : + k • p.closed_ball 0 r = p.closed_ball 0 (‖k‖ * r) := +begin + refine subset_antisymm smul_closed_ball_subset _, + intro x, + rw [set.mem_smul_set, seminorm.mem_closed_ball_zero], + refine λ hx, ⟨k⁻¹ • x, _, _⟩, + { rwa [seminorm.mem_closed_ball_zero, map_smul_eq_mul, norm_inv, ←(mul_le_mul_left hk), + ←mul_assoc, ←(div_eq_mul_inv ‖k‖ ‖k‖), div_self (ne_of_gt hk), one_mul] }, rw [←smul_assoc, smul_eq_mul, ←div_eq_mul_inv, div_self (norm_pos_iff.mp hk), one_smul], end lemma ball_zero_absorbs_ball_zero (p : seminorm 𝕜 E) {r₁ r₂ : ℝ} (hr₁ : 0 < r₁) : absorbs 𝕜 (p.ball 0 r₁) (p.ball 0 r₂) := begin - by_cases hr₂ : r₂ ≤ 0, - { rw ball_eq_emptyset p hr₂, exact absorbs_empty }, - rw [not_le] at hr₂, - rcases exists_between hr₁ with ⟨r, hr, hr'⟩, - refine ⟨r₂/r, div_pos hr₂ hr, _⟩, - simp_rw set.subset_def, - intros a ha x hx, - have ha' : 0 < ∥a∥ := lt_of_lt_of_le (div_pos hr₂ hr) ha, - rw [smul_ball_zero ha', p.mem_ball_zero], + rcases exists_pos_lt_mul hr₁ r₂ with ⟨r, hr₀, hr⟩, + refine ⟨r, hr₀, λ a ha x hx, _⟩, + rw [smul_ball_zero (norm_pos_iff.1 $ hr₀.trans_le ha), p.mem_ball_zero], rw p.mem_ball_zero at hx, - rw div_le_iff hr at ha, - exact hx.trans (lt_of_le_of_lt ha ((mul_lt_mul_left ha').mpr hr')), + exact hx.trans (hr.trans_le $ mul_le_mul_of_nonneg_right ha hr₁.le) end /-- Seminorm-balls at the origin are absorbent. -/ protected lemma absorbent_ball_zero (hr : 0 < r) : absorbent 𝕜 (ball p (0 : E) r) := -begin - rw absorbent_iff_nonneg_lt, - rintro x, - have hxr : 0 ≤ p x/r := div_nonneg (p.nonneg _) hr.le, - refine ⟨p x/r, hxr, λ a ha, _⟩, - have ha₀ : 0 < ∥a∥ := hxr.trans_lt ha, - refine ⟨a⁻¹ • x, _, smul_inv_smul₀ (norm_pos_iff.1 ha₀) x⟩, - rwa [mem_ball_zero, p.smul, norm_inv, inv_mul_lt_iff ha₀, ←div_lt_iff hr], -end +absorbent_iff_forall_absorbs_singleton.2 $ λ x, (p.ball_zero_absorbs_ball_zero hr).mono_right $ + singleton_subset_iff.2 $ p.mem_ball_zero.2 $ lt_add_one _ + +/-- Closed seminorm-balls at the origin are absorbent. -/ +protected lemma absorbent_closed_ball_zero (hr : 0 < r) : absorbent 𝕜 (closed_ball p (0 : E) r) := +(p.absorbent_ball_zero hr).subset (p.ball_subset_closed_ball _ _) /-- Seminorm-balls containing the origin are absorbent. -/ protected lemma absorbent_ball (hpr : p x < r) : absorbent 𝕜 (ball p x r) := begin refine (p.absorbent_ball_zero $ sub_pos.2 hpr).subset (λ y hy, _), rw p.mem_ball_zero at hy, - exact p.mem_ball.2 ((p.sub_le _ _).trans_lt $ add_lt_of_lt_sub_right hy), + exact p.mem_ball.2 ((map_sub_le_add p _ _).trans_lt $ add_lt_of_lt_sub_right hy), +end + +/-- Seminorm-balls containing the origin are absorbent. -/ +protected lemma absorbent_closed_ball (hpr : p x < r) : absorbent 𝕜 (closed_ball p x r) := +begin + refine (p.absorbent_closed_ball_zero $ sub_pos.2 hpr).subset (λ y hy, _), + rw p.mem_closed_ball_zero at hy, + exact p.mem_closed_ball.2 ((map_sub_le_add p _ _).trans $ add_le_of_le_sub_right hy), end lemma symmetric_ball_zero (r : ℝ) (hx : x ∈ ball p 0 r) : -x ∈ ball p 0 r := @@ -591,35 +871,35 @@ balanced_ball_zero p r (-1) (by rw [norm_neg, norm_one]) ⟨x, hx, by rw [neg_sm @[simp] lemma neg_ball (p : seminorm 𝕜 E) (r : ℝ) (x : E) : -ball p x r = ball p (-x) r := -by { ext, rw [mem_neg, mem_ball, mem_ball, ←neg_add', sub_neg_eq_add, p.neg], } +by { ext, rw [mem_neg, mem_ball, mem_ball, ←neg_add', sub_neg_eq_add, map_neg_eq_map] } @[simp] lemma smul_ball_preimage (p : seminorm 𝕜 E) (y : E) (r : ℝ) (a : 𝕜) (ha : a ≠ 0) : - ((•) a) ⁻¹' p.ball y r = p.ball (a⁻¹ • y) (r / ∥a∥) := + ((•) a) ⁻¹' p.ball y r = p.ball (a⁻¹ • y) (r / ‖a‖) := set.ext $ λ _, by rw [mem_preimage, mem_ball, mem_ball, - lt_div_iff (norm_pos_iff.mpr ha), mul_comm, ←p.smul, smul_sub, smul_inv_smul₀ ha] + lt_div_iff (norm_pos_iff.mpr ha), mul_comm, ←map_smul_eq_mul p, smul_sub, smul_inv_smul₀ ha] end normed_field section convex variables [normed_field 𝕜] [add_comm_group E] [normed_space ℝ 𝕜] [module 𝕜 E] -section has_scalar -variables [has_scalar ℝ E] [is_scalar_tower ℝ 𝕜 E] (p : seminorm 𝕜 E) +section has_smul +variables [has_smul ℝ E] [is_scalar_tower ℝ 𝕜 E] (p : seminorm 𝕜 E) /-- A seminorm is convex. Also see `convex_on_norm`. -/ protected lemma convex_on : convex_on ℝ univ p := begin - refine ⟨convex_univ, λ x y _ _ a b ha hb hab, _⟩, - calc p (a • x + b • y) ≤ p (a • x) + p (b • y) : p.triangle _ _ - ... = ∥a • (1 : 𝕜)∥ * p x + ∥b • (1 : 𝕜)∥ * p y - : by rw [←p.smul, ←p.smul, smul_one_smul, smul_one_smul] + refine ⟨convex_univ, λ x _ y _ a b ha hb hab, _⟩, + calc p (a • x + b • y) ≤ p (a • x) + p (b • y) : map_add_le_add p _ _ + ... = ‖a • (1 : 𝕜)‖ * p x + ‖b • (1 : 𝕜)‖ * p y + : by rw [←map_smul_eq_mul p, ←map_smul_eq_mul p, smul_one_smul, smul_one_smul] ... = a * p x + b * p y : by rw [norm_smul, norm_smul, norm_one, mul_one, mul_one, real.norm_of_nonneg ha, real.norm_of_nonneg hb], end -end has_scalar +end has_smul section module variables [module ℝ E] [is_scalar_tower ℝ 𝕜 E] (p : seminorm 𝕜 E) (x : E) (r : ℝ) @@ -633,17 +913,134 @@ begin refl, end +/-- Closed seminorm-balls are convex. -/ +lemma convex_closed_ball : convex ℝ (closed_ball p x r) := +begin + rw closed_ball_eq_bInter_ball, + exact convex_Inter₂ (λ _ _, convex_ball _ _ _) +end + end module end convex + +section restrict_scalars + +variables (𝕜) {𝕜' : Type*} [normed_field 𝕜] [semi_normed_ring 𝕜'] [normed_algebra 𝕜 𝕜'] + [norm_one_class 𝕜'] [add_comm_group E] [module 𝕜' E] [has_smul 𝕜 E] [is_scalar_tower 𝕜 𝕜' E] + +/-- Reinterpret a seminorm over a field `𝕜'` as a seminorm over a smaller field `𝕜`. This will +typically be used with `is_R_or_C 𝕜'` and `𝕜 = ℝ`. -/ +protected def restrict_scalars (p : seminorm 𝕜' E) : + seminorm 𝕜 E := +{ smul' := λ a x, by rw [← smul_one_smul 𝕜' a x, p.smul', norm_smul, norm_one, mul_one], + ..p } + +@[simp] lemma coe_restrict_scalars (p : seminorm 𝕜' E) : + (p.restrict_scalars 𝕜 : E → ℝ) = p := +rfl + +@[simp] lemma restrict_scalars_ball (p : seminorm 𝕜' E) : + (p.restrict_scalars 𝕜).ball = p.ball := +rfl + +@[simp] lemma restrict_scalars_closed_ball (p : seminorm 𝕜' E) : + (p.restrict_scalars 𝕜).closed_ball = p.closed_ball := +rfl + +end restrict_scalars + +/-! ### Continuity criterions for seminorms -/ + +section continuity + +variables [nontrivially_normed_field 𝕜] [semi_normed_ring 𝕝] [add_comm_group E] [module 𝕜 E] +variables [module 𝕝 E] + +lemma continuous_at_zero' [topological_space E] [has_continuous_const_smul 𝕜 E] {p : seminorm 𝕜 E} + {r : ℝ} (hr : 0 < r) (hp : p.closed_ball 0 r ∈ (𝓝 0 : filter E)) : + continuous_at p 0 := +begin + refine metric.nhds_basis_closed_ball.tendsto_right_iff.mpr _, + intros ε hε, + rw map_zero, + suffices : p.closed_ball 0 ε ∈ (𝓝 0 : filter E), + { rwa seminorm.closed_ball_zero_eq_preimage_closed_ball at this }, + rcases exists_norm_lt 𝕜 (div_pos hε hr) with ⟨k, hk0, hkε⟩, + have hk0' := norm_pos_iff.mp hk0, + have := (set_smul_mem_nhds_zero_iff hk0').mpr hp, + refine filter.mem_of_superset this (smul_set_subset_iff.mpr $ λ x hx, _), + rw [mem_closed_ball_zero, map_smul_eq_mul, ← div_mul_cancel ε hr.ne.symm], + exact mul_le_mul hkε.le (p.mem_closed_ball_zero.mp hx) (map_nonneg _ _) (div_nonneg hε.le hr.le) +end + +lemma continuous_at_zero [topological_space E] [has_continuous_const_smul 𝕜 E] {p : seminorm 𝕜 E} + {r : ℝ} (hr : 0 < r) (hp : p.ball 0 r ∈ (𝓝 0 : filter E)) : + continuous_at p 0 := +continuous_at_zero' hr (filter.mem_of_superset hp $ p.ball_subset_closed_ball _ _) + +protected lemma uniform_continuous_of_continuous_at_zero [uniform_space E] [uniform_add_group E] + {p : seminorm 𝕝 E} (hp : continuous_at p 0) : + uniform_continuous p := +begin + have hp : filter.tendsto p (𝓝 0) (𝓝 0) := map_zero p ▸ hp, + rw [uniform_continuous, uniformity_eq_comap_nhds_zero_swapped, + metric.uniformity_eq_comap_nhds_zero, filter.tendsto_comap_iff], + exact tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds + (hp.comp filter.tendsto_comap) (λ xy, dist_nonneg) (λ xy, p.norm_sub_map_le_sub _ _) +end + +protected lemma continuous_of_continuous_at_zero [topological_space E] [topological_add_group E] + {p : seminorm 𝕝 E} (hp : continuous_at p 0) : + continuous p := +begin + letI := topological_add_group.to_uniform_space E, + haveI : uniform_add_group E := topological_add_comm_group_is_uniform, + exact (seminorm.uniform_continuous_of_continuous_at_zero hp).continuous +end + +protected lemma uniform_continuous [uniform_space E] [uniform_add_group E] + [has_continuous_const_smul 𝕜 E] {p : seminorm 𝕜 E} {r : ℝ} (hr : 0 < r) + (hp : p.ball 0 r ∈ (𝓝 0 : filter E)) : uniform_continuous p := +seminorm.uniform_continuous_of_continuous_at_zero (continuous_at_zero hr hp) + +protected lemma uniform_continuous' [uniform_space E] [uniform_add_group E] + [has_continuous_const_smul 𝕜 E] {p : seminorm 𝕜 E} {r : ℝ} (hr : 0 < r) + (hp : p.closed_ball 0 r ∈ (𝓝 0 : filter E)) : uniform_continuous p := +seminorm.uniform_continuous_of_continuous_at_zero (continuous_at_zero' hr hp) + +protected lemma continuous [topological_space E] [topological_add_group E] + [has_continuous_const_smul 𝕜 E] {p : seminorm 𝕜 E} {r : ℝ} (hr : 0 < r) + (hp : p.ball 0 r ∈ (𝓝 0 : filter E)) : continuous p := +seminorm.continuous_of_continuous_at_zero (continuous_at_zero hr hp) + +protected lemma continuous' [topological_space E] [topological_add_group E] + [has_continuous_const_smul 𝕜 E] {p : seminorm 𝕜 E} {r : ℝ} (hr : 0 < r) + (hp : p.closed_ball 0 r ∈ (𝓝 0 : filter E)) : continuous p := +seminorm.continuous_of_continuous_at_zero (continuous_at_zero' hr hp) + +lemma continuous_of_le [topological_space E] [topological_add_group E] + [has_continuous_const_smul 𝕜 E] {p q : seminorm 𝕜 E} (hq : continuous q) (hpq : p ≤ q) : + continuous p := +begin + refine seminorm.continuous one_pos (filter.mem_of_superset + (is_open.mem_nhds _ $ q.mem_ball_self zero_lt_one) (ball_antitone hpq)), + rw ball_zero_eq, + exact is_open_lt hq continuous_const +end + +end continuity + end seminorm /-! ### The norm as a seminorm -/ section norm_seminorm -variables (𝕜 E) [normed_field 𝕜] [semi_normed_group E] [normed_space 𝕜 E] {r : ℝ} +variables (𝕜) (E) [normed_field 𝕜] [seminormed_add_comm_group E] [normed_space 𝕜 E] {r : ℝ} /-- The norm of a seminormed group as a seminorm. -/ -def norm_seminorm : seminorm 𝕜 E := ⟨norm, norm_smul, norm_add_le⟩ +def norm_seminorm : seminorm 𝕜 E := +{ smul' := norm_smul, + ..(norm_add_group_seminorm E)} @[simp] lemma coe_norm_seminorm : ⇑(norm_seminorm 𝕜 E) = norm := rfl @@ -657,11 +1054,14 @@ lemma absorbent_ball_zero (hr : 0 < r) : absorbent 𝕜 (metric.ball (0 : E) r) by { rw ←ball_norm_seminorm 𝕜, exact (norm_seminorm _ _).absorbent_ball_zero hr } /-- Balls containing the origin are absorbent. -/ -lemma absorbent_ball (hx : ∥x∥ < r) : absorbent 𝕜 (metric.ball x r) := +lemma absorbent_ball (hx : ‖x‖ < r) : absorbent 𝕜 (metric.ball x r) := by { rw ←ball_norm_seminorm 𝕜, exact (norm_seminorm _ _).absorbent_ball hx } /-- Balls at the origin are balanced. -/ -lemma balanced_ball_zero [norm_one_class 𝕜] : balanced 𝕜 (metric.ball (0 : E) r) := +lemma balanced_ball_zero : balanced 𝕜 (metric.ball (0 : E) r) := by { rw ←ball_norm_seminorm 𝕜, exact (norm_seminorm _ _).balanced_ball_zero r } end norm_seminorm + +-- Guard against import creep. +assert_not_exists balanced_core diff --git a/src/analysis/special_functions/arsinh.lean b/src/analysis/special_functions/arsinh.lean index de33a1a039dc7..9611925d171fd 100644 --- a/src/analysis/special_functions/arsinh.lean +++ b/src/analysis/special_functions/arsinh.lean @@ -9,15 +9,29 @@ import analysis.special_functions.log.basic /-! # Inverse of the sinh function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that sinh is bijective and hence has an inverse, arsinh. +## Main definitions + +- `real.arsinh`: The inverse function of `real.sinh`. + +- `real.sinh_equiv`, `real.sinh_order_iso`, `real.sinh_homeomorph`: `real.sinh` as an `equiv`, + `order_iso`, and `homeomorph`, respectively. + ## Main Results -- `sinh_injective`: The proof that `sinh` is injective -- `sinh_surjective`: The proof that `sinh` is surjective -- `sinh_bijective`: The proof `sinh` is bijective -- `arsinh`: The inverse function of `sinh` +- `real.sinh_surjective`, `real.sinh_bijective`: `real.sinh` is surjective and bijective; + +- `real.arsinh_injective`, `real.arsinh_surjective`, `real.arsinh_bijective`: `real.arsinh` is + injective, surjective, and bijective; + +- `real.continuous_arsinh`, `real.differentiable_arsinh`, `real.cont_diff_arsinh`: `real.arsinh` is + continuous, differentiable, and continuously differentiable; we also provide dot notation + convenience lemmas like `filter.tendsto.arsinh` and `cont_diff_at.arsinh`. ## Tags @@ -25,57 +39,198 @@ arsinh, arcsinh, argsinh, asinh, sinh injective, sinh bijective, sinh surjective -/ noncomputable theory +open function filter set +open_locale topology + namespace real +variables {x y : ℝ} + /-- `arsinh` is defined using a logarithm, `arsinh x = log (x + sqrt(1 + x^2))`. -/ @[pp_nodot] def arsinh (x : ℝ) := log (x + sqrt (1 + x^2)) -/-- `sinh` is injective, `∀ a b, sinh a = sinh b → a = b`. -/ -lemma sinh_injective : function.injective sinh := sinh_strict_mono.injective - -private lemma aux_lemma (x : ℝ) : 1 / (x + sqrt (1 + x ^ 2)) = -x + sqrt (1 + x ^ 2) := +lemma exp_arsinh (x : ℝ) : exp (arsinh x) = x + sqrt (1 + x^2) := begin - refine (eq_one_div_of_mul_eq_one _).symm, - have : 0 ≤ 1 + x ^ 2 := add_nonneg zero_le_one (sq_nonneg x), - rw [add_comm, ← sub_eq_neg_add, ← mul_self_sub_mul_self, - mul_self_sqrt this, sq, add_sub_cancel] + apply exp_log, + rw [← neg_lt_iff_pos_add'], + calc -x ≤ sqrt (x ^ 2) : le_sqrt_of_sq_le (neg_pow_bit0 _ _).le + ... < sqrt (1 + x ^ 2) : sqrt_lt_sqrt (sq_nonneg _) (lt_one_add _) end -private lemma b_lt_sqrt_b_one_add_sq (b : ℝ) : b < sqrt (1 + b ^ 2) := -calc b - ≤ sqrt (b ^ 2) : le_sqrt_of_sq_le le_rfl -... < sqrt (1 + b ^ 2) : sqrt_lt_sqrt (sq_nonneg _) (lt_one_add _) +@[simp] lemma arsinh_zero : arsinh 0 = 0 := by simp [arsinh] -private lemma add_sqrt_one_add_sq_pos (b : ℝ) : 0 < b + sqrt (1 + b ^ 2) := -by { rw [← neg_neg b, ← sub_eq_neg_add, sub_pos, sq, neg_mul_neg, ← sq], - exact b_lt_sqrt_b_one_add_sq (-b) } +@[simp] lemma arsinh_neg (x : ℝ) : arsinh (-x) = -arsinh x := +begin + rw [← exp_eq_exp, exp_arsinh, exp_neg, exp_arsinh], + apply eq_inv_of_mul_eq_one_left, + rw [neg_sq, neg_add_eq_sub, add_comm x, mul_comm, ← sq_sub_sq, sq_sqrt, add_sub_cancel], + exact add_nonneg zero_le_one (sq_nonneg _) +end /-- `arsinh` is the right inverse of `sinh`. -/ -lemma sinh_arsinh (x : ℝ) : sinh (arsinh x) = x := -by rw [sinh_eq, arsinh, ← log_inv, exp_log (add_sqrt_one_add_sq_pos x), - exp_log (inv_pos.2 (add_sqrt_one_add_sq_pos x)), - inv_eq_one_div, aux_lemma x, sub_eq_add_neg, neg_add, neg_neg, ← sub_eq_add_neg, - add_add_sub_cancel, add_self_div_two] +@[simp] lemma sinh_arsinh (x : ℝ) : sinh (arsinh x) = x := +by { rw [sinh_eq, ← arsinh_neg, exp_arsinh, exp_arsinh, neg_sq], field_simp } + +@[simp] lemma cosh_arsinh (x : ℝ) : cosh (arsinh x) = sqrt (1 + x^2) := +by rw [← sqrt_sq (cosh_pos _).le, cosh_sq', sinh_arsinh] /-- `sinh` is surjective, `∀ b, ∃ a, sinh a = b`. In this case, we use `a = arsinh b`. -/ -lemma sinh_surjective : function.surjective sinh := function.left_inverse.surjective sinh_arsinh +lemma sinh_surjective : surjective sinh := left_inverse.surjective sinh_arsinh /-- `sinh` is bijective, both injective and surjective. -/ -lemma sinh_bijective : function.bijective sinh := -⟨sinh_injective, sinh_surjective⟩ +lemma sinh_bijective : bijective sinh := ⟨sinh_injective, sinh_surjective⟩ + +/-- `arsinh` is the left inverse of `sinh`. -/ +@[simp] lemma arsinh_sinh (x : ℝ) : arsinh (sinh x) = x := +right_inverse_of_injective_of_left_inverse sinh_injective sinh_arsinh x + +/-- `real.sinh` as an `equiv`. -/ +@[simps] def sinh_equiv : ℝ ≃ ℝ := +{ to_fun := sinh, + inv_fun := arsinh, + left_inv := arsinh_sinh, + right_inv := sinh_arsinh } -/-- A rearrangement and `sqrt` of `real.cosh_sq_sub_sinh_sq`. -/ -lemma sqrt_one_add_sinh_sq (x : ℝ): sqrt (1 + sinh x ^ 2) = cosh x := +/-- `real.sinh` as an `order_iso`. -/ +@[simps { fully_applied := ff }] def sinh_order_iso : ℝ ≃o ℝ := +{ to_equiv := sinh_equiv, + map_rel_iff' := @sinh_le_sinh } + +/-- `real.sinh` as a `homeomorph`. -/ +@[simps { fully_applied := ff }] def sinh_homeomorph : ℝ ≃ₜ ℝ := sinh_order_iso.to_homeomorph + +lemma arsinh_bijective : bijective arsinh := sinh_equiv.symm.bijective +lemma arsinh_injective : injective arsinh := sinh_equiv.symm.injective +lemma arsinh_surjective : surjective arsinh := sinh_equiv.symm.surjective + +lemma arsinh_strict_mono : strict_mono arsinh := sinh_order_iso.symm.strict_mono + +@[simp] lemma arsinh_inj : arsinh x = arsinh y ↔ x = y := arsinh_injective.eq_iff +@[simp] lemma arsinh_le_arsinh : arsinh x ≤ arsinh y ↔ x ≤ y := sinh_order_iso.symm.le_iff_le +@[simp] lemma arsinh_lt_arsinh : arsinh x < arsinh y ↔ x < y := sinh_order_iso.symm.lt_iff_lt + +@[simp] lemma arsinh_eq_zero_iff : arsinh x = 0 ↔ x = 0 := +arsinh_injective.eq_iff' arsinh_zero + +@[simp] lemma arsinh_nonneg_iff : 0 ≤ arsinh x ↔ 0 ≤ x := +by rw [← sinh_le_sinh, sinh_zero, sinh_arsinh] + +@[simp] lemma arsinh_nonpos_iff : arsinh x ≤ 0 ↔ x ≤ 0 := +by rw [← sinh_le_sinh, sinh_zero, sinh_arsinh] + +@[simp] lemma arsinh_pos_iff : 0 < arsinh x ↔ 0 < x := +lt_iff_lt_of_le_iff_le arsinh_nonpos_iff + +@[simp] lemma arsinh_neg_iff : arsinh x < 0 ↔ x < 0 := +lt_iff_lt_of_le_iff_le arsinh_nonneg_iff + +lemma has_strict_deriv_at_arsinh (x : ℝ) : has_strict_deriv_at arsinh (sqrt (1 + x ^ 2))⁻¹ x := begin - have H := real.cosh_sq_sub_sinh_sq x, - have G : cosh x ^ 2 - sinh x ^ 2 + sinh x ^ 2 = 1 + sinh x ^ 2 := by rw H, - rw sub_add_cancel at G, - rw [←G, sqrt_sq], - exact le_of_lt (cosh_pos x), + convert sinh_homeomorph.to_local_homeomorph.has_strict_deriv_at_symm (mem_univ x) + (cosh_pos _).ne' (has_strict_deriv_at_sinh _), + exact (cosh_arsinh _).symm end -/-- `arsinh` is the left inverse of `sinh`. -/ -lemma arsinh_sinh (x : ℝ) : arsinh (sinh x) = x := -function.right_inverse_of_injective_of_left_inverse sinh_injective sinh_arsinh x +lemma has_deriv_at_arsinh (x : ℝ) : has_deriv_at arsinh (sqrt (1 + x ^ 2))⁻¹ x := +(has_strict_deriv_at_arsinh x).has_deriv_at + +lemma differentiable_arsinh : differentiable ℝ arsinh := +λ x, (has_deriv_at_arsinh x).differentiable_at + +lemma cont_diff_arsinh {n : ℕ∞} : cont_diff ℝ n arsinh := +sinh_homeomorph.cont_diff_symm_deriv (λ x, (cosh_pos x).ne') has_deriv_at_sinh cont_diff_sinh + +@[continuity] lemma continuous_arsinh : continuous arsinh := sinh_homeomorph.symm.continuous end real + +open real + +lemma filter.tendsto.arsinh {α : Type*} {l : filter α} {f : α → ℝ} {a : ℝ} + (h : tendsto f l (𝓝 a)) : tendsto (λ x, arsinh (f x)) l (𝓝 (arsinh a)) := +(continuous_arsinh.tendsto _).comp h + +section continuous + +variables {X : Type*} [topological_space X] {f : X → ℝ} {s : set X} {a : X} + +lemma continuous_at.arsinh (h : continuous_at f a) : continuous_at (λ x, arsinh (f x)) a := h.arsinh + +lemma continuous_within_at.arsinh (h : continuous_within_at f s a) : + continuous_within_at (λ x, arsinh (f x)) s a := +h.arsinh + +lemma continuous_on.arsinh (h : continuous_on f s) : continuous_on (λ x, arsinh (f x)) s := +λ x hx, (h x hx).arsinh + +lemma continuous.arsinh (h : continuous f) : continuous (λ x, arsinh (f x)) := +continuous_arsinh.comp h + +end continuous + +section fderiv + +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {s : set E} {a : E} + {f' : E →L[ℝ] ℝ} {n : ℕ∞} + +lemma has_strict_fderiv_at.arsinh (hf : has_strict_fderiv_at f f' a) : + has_strict_fderiv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a := +(has_strict_deriv_at_arsinh _).comp_has_strict_fderiv_at a hf + +lemma has_fderiv_at.arsinh (hf : has_fderiv_at f f' a) : + has_fderiv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a := +(has_deriv_at_arsinh _).comp_has_fderiv_at a hf + +lemma has_fderiv_within_at.arsinh (hf : has_fderiv_within_at f f' s a) : + has_fderiv_within_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') s a := +(has_deriv_at_arsinh _).comp_has_fderiv_within_at a hf + +lemma differentiable_at.arsinh (h : differentiable_at ℝ f a) : + differentiable_at ℝ (λ x, arsinh (f x)) a := +(differentiable_arsinh _).comp a h + +lemma differentiable_within_at.arsinh (h : differentiable_within_at ℝ f s a) : + differentiable_within_at ℝ (λ x, arsinh (f x)) s a := +(differentiable_arsinh _).comp_differentiable_within_at a h + +lemma differentiable_on.arsinh (h : differentiable_on ℝ f s) : + differentiable_on ℝ (λ x, arsinh (f x)) s := +λ x hx, (h x hx).arsinh + +lemma differentiable.arsinh (h : differentiable ℝ f) : + differentiable ℝ (λ x, arsinh (f x)) := +differentiable_arsinh.comp h + +lemma cont_diff_at.arsinh (h : cont_diff_at ℝ n f a) : + cont_diff_at ℝ n (λ x, arsinh (f x)) a := +cont_diff_arsinh.cont_diff_at.comp a h + +lemma cont_diff_within_at.arsinh (h : cont_diff_within_at ℝ n f s a) : + cont_diff_within_at ℝ n (λ x, arsinh (f x)) s a := +cont_diff_arsinh.cont_diff_at.comp_cont_diff_within_at a h + +lemma cont_diff.arsinh (h : cont_diff ℝ n f) : cont_diff ℝ n (λ x, arsinh (f x)) := +cont_diff_arsinh.comp h + +lemma cont_diff_on.arsinh (h : cont_diff_on ℝ n f s) : cont_diff_on ℝ n (λ x, arsinh (f x)) s := +λ x hx, (h x hx).arsinh + +end fderiv + +section deriv + +variables {f : ℝ → ℝ} {s : set ℝ} {a f' : ℝ} + +lemma has_strict_deriv_at.arsinh (hf : has_strict_deriv_at f f' a) : + has_strict_deriv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a := +(has_strict_deriv_at_arsinh _).comp a hf + +lemma has_deriv_at.arsinh (hf : has_deriv_at f f' a) : + has_deriv_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') a := +(has_deriv_at_arsinh _).comp a hf + +lemma has_deriv_within_at.arsinh (hf : has_deriv_within_at f f' s a) : + has_deriv_within_at (λ x, arsinh (f x)) ((sqrt (1 + (f a) ^ 2))⁻¹ • f') s a := +(has_deriv_at_arsinh _).comp_has_deriv_within_at a hf + +end deriv diff --git a/src/analysis/special_functions/bernstein.lean b/src/analysis/special_functions/bernstein.lean index c14cf3638041c..22e78e0f6d775 100644 --- a/src/analysis/special_functions/bernstein.lean +++ b/src/analysis/special_functions/bernstein.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ +import analysis.specific_limits.basic import ring_theory.polynomial.bernstein import topology.continuous_function.polynomial +import topology.continuous_function.compact /-! # Bernstein approximations and Weierstrass' theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove that the Bernstein approximations ``` ∑ k : fin (n+1), f (k/n : ℝ) * n.choose k * x^k * (1-x)^(n-k) @@ -162,6 +167,8 @@ The modulus of (uniform) continuity for `f`, chosen so `|f x - f y| < ε/2` when -/ def δ (f : C(I, ℝ)) (ε : ℝ) (h : 0 < ε) : ℝ := f.modulus (ε/2) (half_pos h) +lemma δ_pos {f : C(I, ℝ)} {ε : ℝ} {h : 0 < ε} : 0 < δ f ε h := f.modulus_pos + /-- The set of points `k` so `k/n` is within `δ` of `x`. -/ @@ -188,12 +195,9 @@ lemma le_of_mem_S_compl (1 : ℝ) ≤ (δ f ε h)^(-2 : ℤ) * (x - k/ₙ) ^ 2 := begin simp only [finset.mem_compl, not_lt, set.mem_to_finset, set.mem_set_of_eq, S] at m, - field_simp, - erw [le_div_iff (pow_pos f.modulus_pos 2), one_mul], - apply sq_le_sq, - rw abs_eq_self.mpr (le_of_lt f.modulus_pos), - rw [dist_comm] at m, - exact m, + rw [zpow_neg, ← div_eq_inv_mul, zpow_two, ←pow_two, one_le_div (pow_pos δ_pos 2), sq_le_sq, + abs_of_pos δ_pos], + rwa [dist_comm] at m end end bernstein_approximation @@ -202,7 +206,7 @@ open bernstein_approximation open bounded_continuous_function open filter -open_locale topological_space +open_locale topology /-- The Bernstein approximations @@ -220,13 +224,13 @@ begin simp only [metric.nhds_basis_ball.tendsto_right_iff, metric.mem_ball, dist_eq_norm], intros ε h, let δ := δ f ε h, - have nhds_zero := tendsto_const_div_at_top_nhds_0_nat (2 * ∥f∥ * δ ^ (-2 : ℤ)), + have nhds_zero := tendsto_const_div_at_top_nhds_0_nat (2 * ‖f‖ * δ ^ (-2 : ℤ)), filter_upwards [nhds_zero.eventually (gt_mem_nhds (half_pos h)), eventually_gt_at_top 0] with n nh npos', have npos : 0 < (n:ℝ) := by exact_mod_cast npos', -- Two easy inequalities we'll need later: - have w₁ : 0 ≤ 2 * ∥f∥ := mul_nonneg (by norm_num) (norm_nonneg f), - have w₂ : 0 ≤ 2 * ∥f∥ * δ^(-2 : ℤ) := mul_nonneg w₁ pow_minus_two_nonneg, + have w₁ : 0 ≤ 2 * ‖f‖ := mul_nonneg (by norm_num) (norm_nonneg f), + have w₂ : 0 ≤ 2 * ‖f‖ * δ^(-2 : ℤ) := mul_nonneg w₁ (zpow_neg_two_nonneg _), -- As `[0,1]` is compact, it suffices to check the inequality pointwise. rw (continuous_map.norm_lt_iff _ h), intro x, @@ -269,17 +273,17 @@ begin (finset.sum_le_univ_sum_of_nonneg (λ k, bernstein_nonneg)) (le_of_lt (half_pos h)) ... = ε/2 : by rw [bernstein.probability, mul_one] }, - { -- We now turn to working on `Sᶜ`: we control the difference term just using `∥f∥`, + { -- We now turn to working on `Sᶜ`: we control the difference term just using `‖f‖`, -- and then insert a `δ^(-2) * (x - k/n)^2` factor -- (which is at least one because we are not in `S`). calc ∑ k in Sᶜ, |f k/ₙ - f x| * bernstein n k x - ≤ ∑ k in Sᶜ, (2 * ∥f∥) * bernstein n k x + ≤ ∑ k in Sᶜ, (2 * ‖f‖) * bernstein n k x : finset.sum_le_sum (λ k m, mul_le_mul_of_nonneg_right (f.dist_le_two_norm _ _) bernstein_nonneg) - ... = (2 * ∥f∥) * ∑ k in Sᶜ, bernstein n k x + ... = (2 * ‖f‖) * ∑ k in Sᶜ, bernstein n k x : by rw finset.mul_sum - ... ≤ (2 * ∥f∥) * ∑ k in Sᶜ, δ^(-2 : ℤ) * (x - k/ₙ)^2 * bernstein n k x + ... ≤ (2 * ‖f‖) * ∑ k in Sᶜ, δ^(-2 : ℤ) * (x - k/ₙ)^2 * bernstein n k x : mul_le_mul_of_nonneg_left (finset.sum_le_sum (λ k m, begin conv_lhs { rw ←one_mul (bernstein _ _ _), }, @@ -287,24 +291,20 @@ begin (le_of_mem_S_compl m) bernstein_nonneg, end)) w₁ -- Again enlarging the sum from `Sᶜ` to all of `fin (n+1)` - ... ≤ (2 * ∥f∥) * ∑ k : fin (n+1), δ^(-2 : ℤ) * (x - k/ₙ)^2 * bernstein n k x + ... ≤ (2 * ‖f‖) * ∑ k : fin (n+1), δ^(-2 : ℤ) * (x - k/ₙ)^2 * bernstein n k x : mul_le_mul_of_nonneg_left (finset.sum_le_univ_sum_of_nonneg (λ k, mul_nonneg - (mul_nonneg pow_minus_two_nonneg (sq_nonneg _)) + (mul_nonneg (zpow_neg_two_nonneg _) (sq_nonneg _)) bernstein_nonneg)) w₁ - ... = (2 * ∥f∥) * δ^(-2 : ℤ) * ∑ k : fin (n+1), (x - k/ₙ)^2 * bernstein n k x + ... = (2 * ‖f‖) * δ^(-2 : ℤ) * ∑ k : fin (n+1), (x - k/ₙ)^2 * bernstein n k x : by conv_rhs { rw [mul_assoc, finset.mul_sum], simp only [←mul_assoc], } -- `bernstein.variance` and `x ∈ [0,1]` gives the uniform bound - ... = (2 * ∥f∥) * δ^(-2 : ℤ) * x * (1-x) / n + ... = (2 * ‖f‖) * δ^(-2 : ℤ) * x * (1-x) / n : by { rw variance npos, ring, } - ... ≤ (2 * ∥f∥) * δ^(-2 : ℤ) / n - : (div_le_div_right npos).mpr - begin - apply mul_nonneg_le_one_le w₂, - apply mul_nonneg_le_one_le w₂ le_rfl, - all_goals { unit_interval, }, - end + ... ≤ (2 * ‖f‖) * δ^(-2 : ℤ) / n + : (div_le_div_right npos).mpr $ + by refine mul_le_of_le_of_le_one' (mul_le_of_le_one_right w₂ _) _ _ w₂; unit_interval ... < ε/2 : nh, } end diff --git a/src/analysis/special_functions/compare_exp.lean b/src/analysis/special_functions/compare_exp.lean new file mode 100644 index 0000000000000..c48a5ca404fbd --- /dev/null +++ b/src/analysis/special_functions/compare_exp.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import analysis.special_functions.pow.asymptotics +import analysis.asymptotics.asymptotic_equivalent +import analysis.asymptotics.specific_asymptotics + +/-! +# Growth estimates on `x ^ y` for complex `x`, `y` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `l` be a filter on `ℂ` such that `complex.re` tends to infinity along `l` and `complex.im z` +grows at a subexponential rate compared to `complex.re z`. Then + +- `complex.is_o_log_abs_re_of_subexponential_im_re`: `real.log ∘ complex.abs` is `o`-small of + `complex.re` along `l`; + +- `complex.is_o_cpow_mul_exp`: $z^{a_1}e^{b_1 * z} = o\left(z^{a_1}e^{b_1 * z}\right)$ along `l` + for any complex `a₁`, `a₂` and real `b₁ < b₂`. + +We use these assumptions on `l` for two reasons. First, these are the assumptions that naturally +appear in the proof. Second, in some applications (e.g., in Ilyashenko's proof of the individual +finiteness theorem for limit cycles of polynomial ODEs with hyperbolic singularities only) natural +stronger assumptions (e.g., `im z` is bounded from below and from above) are not available. + +-/ + +open asymptotics filter function +open_locale topology + +namespace complex + +/-- We say that `l : filter ℂ` is an *exponential comparison filter* if the real part tends to +infinity along `l` and the imaginary part grows subexponentially compared to the real part. These +properties guarantee that `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))` for any +complex `a₁`, `a₂` and real `b₁ < b₂`. + +In particular, the second property is automatically satisfied if the imaginary part is bounded along +`l`. -/ +structure is_exp_cmp_filter (l : filter ℂ) : Prop := +(tendsto_re : tendsto re l at_top) +(is_O_im_pow_re : ∀ n : ℕ, (λ z : ℂ, z.im ^ n) =O[l] (λ z, real.exp z.re)) + +namespace is_exp_cmp_filter + +variables {l : filter ℂ} + +/-! +### Alternative constructors +-/ + +lemma of_is_O_im_re_rpow (hre : tendsto re l at_top) (r : ℝ) (hr : im =O[l] (λ z, z.re ^ r)) : + is_exp_cmp_filter l := +⟨hre, λ n, is_o.is_O $ + calc (λ z : ℂ, z.im ^ n) =O[l] (λ z, (z.re ^ r) ^ n) : hr.pow n + ... =ᶠ[l] (λ z, z.re ^ (r * n)) : (hre.eventually_ge_at_top 0).mono $ + λ z hz, by simp only [real.rpow_mul hz r n, real.rpow_nat_cast] + ... =o[l] (λ z, real.exp z.re) : (is_o_rpow_exp_at_top _).comp_tendsto hre⟩ + +lemma of_is_O_im_re_pow (hre : tendsto re l at_top) (n : ℕ) (hr : im =O[l] (λ z, z.re ^ n)) : + is_exp_cmp_filter l := +of_is_O_im_re_rpow hre n $ by simpa only [real.rpow_nat_cast] + +lemma of_bounded_under_abs_im (hre : tendsto re l at_top) + (him : is_bounded_under (≤) l (λ z, |z.im|)) : + is_exp_cmp_filter l := +of_is_O_im_re_pow hre 0 $ + by simpa only [pow_zero] using @is_bounded_under.is_O_const ℂ ℝ ℝ _ _ _ l him 1 one_ne_zero + +lemma of_bounded_under_im (hre : tendsto re l at_top) (him_le : is_bounded_under (≤) l im) + (him_ge : is_bounded_under (≥) l im) : + is_exp_cmp_filter l := +of_bounded_under_abs_im hre $ is_bounded_under_le_abs.2 ⟨him_le, him_ge⟩ + +/-! +### Preliminary lemmas +-/ + +lemma eventually_ne (hl : is_exp_cmp_filter l) : ∀ᶠ w : ℂ in l, w ≠ 0 := +hl.tendsto_re.eventually_ne_at_top' _ + +lemma tendsto_abs_re (hl : is_exp_cmp_filter l) : tendsto (λ z : ℂ, |z.re|) l at_top := +tendsto_abs_at_top_at_top.comp hl.tendsto_re + +lemma tendsto_abs (hl : is_exp_cmp_filter l) : tendsto abs l at_top := +tendsto_at_top_mono abs_re_le_abs hl.tendsto_abs_re + +lemma is_o_log_re_re (hl : is_exp_cmp_filter l) : (λ z, real.log z.re) =o[l] re := +real.is_o_log_id_at_top.comp_tendsto hl.tendsto_re + +lemma is_o_im_pow_exp_re (hl : is_exp_cmp_filter l) (n : ℕ) : + (λ z : ℂ, z.im ^ n) =o[l] (λ z, real.exp z.re) := +flip is_o.of_pow two_ne_zero $ + calc (λ z : ℂ, (z.im ^ n) ^ 2) = (λ z, z.im ^ (2 * n)) : by simp only [pow_mul'] + ... =O[l] (λ z, real.exp z.re) : hl.is_O_im_pow_re _ + ... = (λ z, (real.exp z.re) ^ 1) : by simp only [pow_one] + ... =o[l] (λ z, (real.exp z.re) ^ 2) : (is_o_pow_pow_at_top_of_lt one_lt_two).comp_tendsto $ + real.tendsto_exp_at_top.comp hl.tendsto_re + +lemma abs_im_pow_eventually_le_exp_re (hl : is_exp_cmp_filter l) (n : ℕ) : + (λ z : ℂ, |z.im| ^ n) ≤ᶠ[l] (λ z, real.exp z.re) := +by simpa using (hl.is_o_im_pow_exp_re n).bound zero_lt_one + +/-- If `l : filter ℂ` is an "exponential comparison filter", then $\log |z| =o(ℜ z)$ along `l`. +This is the main lemma in the proof of `complex.is_exp_cmp_filter.is_o_cpow_exp` below. +-/ +lemma is_o_log_abs_re (hl : is_exp_cmp_filter l) : (λ z, real.log (abs z)) =o[l] re := +calc (λ z, real.log (abs z)) =O[l] (λ z, real.log (real.sqrt 2) + real.log (max z.re (|z.im|))) : + is_O.of_bound 1 $ (hl.tendsto_re.eventually_ge_at_top 1).mono $ λ z hz, + begin + have h2 : 0 < real.sqrt 2, by simp, + have hz' : 1 ≤ abs z, from hz.trans (re_le_abs z), + have hz₀ : 0 < abs z, from one_pos.trans_le hz', + have hm₀ : 0 < max z.re (|z.im|), from lt_max_iff.2 (or.inl $ one_pos.trans_le hz), + rw [one_mul, real.norm_eq_abs, _root_.abs_of_nonneg (real.log_nonneg hz')], + refine le_trans _ (le_abs_self _), + rw [← real.log_mul, real.log_le_log, ← _root_.abs_of_nonneg (le_trans zero_le_one hz)], + exacts [abs_le_sqrt_two_mul_max z, one_pos.trans_le hz', (mul_pos h2 hm₀), h2.ne', hm₀.ne'] + end +... =o[l] re : is_o.add (is_o_const_left.2 $ or.inr $ hl.tendsto_abs_re) $ is_o_iff_nat_mul_le.2 $ + λ n, begin + filter_upwards [is_o_iff_nat_mul_le.1 hl.is_o_log_re_re n, hl.abs_im_pow_eventually_le_exp_re n, + hl.tendsto_re.eventually_gt_at_top 1] with z hre him h₁, + cases le_total (|z.im|) z.re with hle hle, + { rwa [max_eq_left hle] }, + { have H : 1 < |z.im|, from h₁.trans_le hle, + rwa [max_eq_right hle, real.norm_eq_abs, real.norm_eq_abs, abs_of_pos (real.log_pos H), + ← real.log_pow, real.log_le_iff_le_exp (pow_pos (one_pos.trans H) _), + abs_of_pos (one_pos.trans h₁)] } + end + +/-! +### Main results +-/ + +/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a` and any +positive real `b`, we have `(λ z, z ^ a) =o[l] (λ z, exp (b * z))`. -/ +lemma is_o_cpow_exp (hl : is_exp_cmp_filter l) (a : ℂ) {b : ℝ} (hb : 0 < b) : + (λ z, z ^ a) =o[l] (λ z, exp (b * z)) := +calc (λ z, z ^ a) =Θ[l] λ z, abs z ^ re a : is_Theta_cpow_const_rpow $ λ _ _, hl.eventually_ne +... =ᶠ[l] λ z, real.exp (re a * real.log (abs z)) : hl.eventually_ne.mono $ + λ z hz, by simp only [real.rpow_def_of_pos, abs.pos hz, mul_comm] +... =o[l] λ z, exp (b * z) : is_o.of_norm_right $ + begin + simp only [norm_eq_abs, abs_exp, of_real_mul_re, real.is_o_exp_comp_exp_comp], + refine (is_equivalent.refl.sub_is_o _).symm.tendsto_at_top (hl.tendsto_re.const_mul_at_top hb), + exact (hl.is_o_log_abs_re.const_mul_left _).const_mul_right hb.ne' + end + +/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a₁`, `a₂` and any +real `b₁ < b₂`, we have `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))`. -/ +lemma is_o_cpow_mul_exp {b₁ b₂ : ℝ} (hl : is_exp_cmp_filter l) (hb : b₁ < b₂) (a₁ a₂ : ℂ) : + (λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z)) := +calc (λ z, z ^ a₁ * exp (b₁ * z)) =ᶠ[l] (λ z, z ^ a₂ * exp (b₁ * z) * z ^ (a₁ - a₂)) : + hl.eventually_ne.mono $ λ z hz, + by { simp only, rw [mul_right_comm, ← cpow_add _ _ hz, add_sub_cancel'_right] } +... =o[l] λ z, z ^ a₂ * exp (b₁ * z) * exp (↑(b₂ - b₁) * z) : + (is_O_refl (λ z, z ^ a₂ * exp (b₁ * z)) l).mul_is_o $ hl.is_o_cpow_exp _ (sub_pos.2 hb) +... =ᶠ[l] λ z, z ^ a₂ * exp (b₂ * z) : + by simp only [of_real_sub, sub_mul, mul_assoc, ← exp_add, add_sub_cancel'_right] + +/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a` and any +negative real `b`, we have `(λ z, exp (b * z)) =o[l] (λ z, z ^ a)`. -/ +lemma is_o_exp_cpow (hl : is_exp_cmp_filter l) (a : ℂ) {b : ℝ} (hb : b < 0) : + (λ z, exp (b * z)) =o[l] (λ z, z ^ a) := +by simpa using hl.is_o_cpow_mul_exp hb 0 a + +/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a₁`, `a₂` and any +natural `b₁ < b₂`, we have `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))`. -/ +lemma is_o_pow_mul_exp {b₁ b₂ : ℝ} (hl : is_exp_cmp_filter l) (hb : b₁ < b₂) (m n : ℕ) : + (λ z, z ^ m * exp (b₁ * z)) =o[l] (λ z, z ^ n * exp (b₂ * z)) := +by simpa only [cpow_nat_cast] using hl.is_o_cpow_mul_exp hb m n + +/-- If `l : filter ℂ` is an "exponential comparison filter", then for any complex `a₁`, `a₂` and any +integer `b₁ < b₂`, we have `(λ z, z ^ a₁ * exp (b₁ * z)) =o[l] (λ z, z ^ a₂ * exp (b₂ * z))`. -/ +lemma is_o_zpow_mul_exp {b₁ b₂ : ℝ} (hl : is_exp_cmp_filter l) (hb : b₁ < b₂) (m n : ℤ) : + (λ z, z ^ m * exp (b₁ * z)) =o[l] (λ z, z ^ n * exp (b₂ * z)) := +by simpa only [cpow_int_cast] using hl.is_o_cpow_mul_exp hb m n + +end is_exp_cmp_filter + +end complex diff --git a/src/analysis/special_functions/complex/arg.lean b/src/analysis/special_functions/complex/arg.lean index 6c1e42e0fa2aa..e9c916006e5c4 100644 --- a/src/analysis/special_functions/complex/arg.lean +++ b/src/analysis/special_functions/complex/arg.lean @@ -9,6 +9,9 @@ import analysis.special_functions.trigonometric.inverse /-! # The argument of a complex number. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `arg : ℂ → ℝ`, returing a real number in the range (-π, π], such that for `x ≠ 0`, `sin (arg x) = x.im / x.abs` and `cos (arg x) = x.re / x.abs`, while `arg 0` defaults to `0` @@ -18,7 +21,7 @@ noncomputable theory namespace complex -open_locale complex_conjugate real topological_space +open_locale complex_conjugate real topology open filter set /-- `arg` returns values in the range (-π, π], such that for `x ≠ 0`, @@ -39,29 +42,26 @@ by unfold arg; split_ifs; lemma cos_arg {x : ℂ} (hx : x ≠ 0) : real.cos (arg x) = x.re / x.abs := begin - have habs : 0 < abs x := abs_pos.2 hx, + have habs : 0 < abs x := abs.pos hx, have him : |im x / abs x| ≤ 1, - { rw [_root_.abs_div, abs_abs], exact div_le_one_of_le x.abs_im_le_abs x.abs_nonneg }, + { rw [_root_.abs_div, abs_abs], + exact div_le_one_of_le x.abs_im_le_abs (abs.nonneg x) }, rw abs_le at him, rw arg, split_ifs with h₁ h₂ h₂, - { rw [real.cos_arcsin]; field_simp [real.sqrt_sq, habs.le, *] }, + { rw [real.cos_arcsin], field_simp [real.sqrt_sq, habs.le, *] }, { rw [real.cos_add_pi, real.cos_arcsin], - { field_simp [real.sqrt_div (sq_nonneg _), real.sqrt_sq_eq_abs, - _root_.abs_of_neg (not_le.1 h₁), *] }, - { simpa [neg_div] using him.2 }, - { simpa [neg_div, neg_le] using him.1 } }, + field_simp [real.sqrt_div (sq_nonneg _), real.sqrt_sq_eq_abs, + _root_.abs_of_neg (not_le.1 h₁), *] }, { rw [real.cos_sub_pi, real.cos_arcsin], - { field_simp [real.sqrt_div (sq_nonneg _), real.sqrt_sq_eq_abs, - _root_.abs_of_neg (not_le.1 h₁), *] }, - { simpa [neg_div] using him.2 }, - { simpa [neg_div, neg_le] using him.1 } } + field_simp [real.sqrt_div (sq_nonneg _), real.sqrt_sq_eq_abs, + _root_.abs_of_neg (not_le.1 h₁), *] } end @[simp] lemma abs_mul_exp_arg_mul_I (x : ℂ) : ↑(abs x) * exp (arg x * I) = x := begin rcases eq_or_ne x 0 with (rfl|hx), { simp }, - { have : abs x ≠ 0 := abs_ne_zero.2 hx, + { have : abs x ≠ 0 := abs.ne_zero hx, ext; field_simp [sin_arg, cos_arg hx, this, mul_comm (abs x)] } end @@ -69,21 +69,22 @@ end (abs x * (cos (arg x) + sin (arg x) * I) : ℂ) = x := by rw [← exp_mul_I, abs_mul_exp_arg_mul_I] -@[simp] lemma range_exp_mul_I : range (λ x : ℝ, exp (x * I)) = metric.sphere 0 1 := +lemma abs_eq_one_iff (z : ℂ) : abs z = 1 ↔ ∃ θ : ℝ, exp (θ * I) = z := begin - simp only [metric.sphere, dist_eq, sub_zero], - refine (range_subset_iff.2 $ λ x, _).antisymm (λ z (hz : abs z = 1), _), - { exact abs_exp_of_real_mul_I _ }, - { refine ⟨arg z, _⟩, - calc exp (arg z * I) = abs z * exp (arg z * I) : by rw [hz, of_real_one, one_mul] - ... = z : abs_mul_exp_arg_mul_I z } + refine ⟨λ hz, ⟨arg z, _⟩, _⟩, + { calc exp (arg z * I) = abs z * exp (arg z * I) : by rw [hz, of_real_one, one_mul] + ... = z : abs_mul_exp_arg_mul_I z }, + { rintro ⟨θ, rfl⟩, + exact complex.abs_exp_of_real_mul_I θ }, end +@[simp] lemma range_exp_mul_I : range (λ x : ℝ, exp (x * I)) = metric.sphere 0 1 := +by { ext x, simp only [mem_sphere_zero_iff_norm, norm_eq_abs, abs_eq_one_iff, mem_range] } + lemma arg_mul_cos_add_sin_mul_I {r : ℝ} (hr : 0 < r) {θ : ℝ} (hθ : θ ∈ Ioc (-π) π) : arg (r * (cos θ + sin θ * I)) = θ := begin - have hπ := real.pi_pos, - simp only [arg, abs_mul, abs_cos_add_sin_mul_I, abs_of_nonneg hr.le, mul_one], + simp only [arg, map_mul, abs_cos_add_sin_mul_I, abs_of_nonneg hr.le, mul_one], simp only [of_real_mul_re, of_real_mul_im, neg_im, ← of_real_cos, ← of_real_sin, ← mk_eq_add_mul_I, neg_div, mul_div_cancel_left _ hr.ne', mul_nonneg_iff_right_nonneg_of_pos hr], @@ -124,7 +125,7 @@ begin rw [← abs_mul_cos_add_sin_mul_I z, ← cos_add_int_mul_two_pi _ N, ← sin_add_int_mul_two_pi _ N], simp only [← of_real_one, ← of_real_bit0, ← of_real_mul, ← of_real_add, ← of_real_int_cast], - rwa [arg_mul_cos_add_sin_mul_I (abs_pos.2 hz) hN] + rwa [arg_mul_cos_add_sin_mul_I (abs.pos hz) hN] end @[simp] lemma range_arg : range arg = Ioc (-π) π := @@ -136,13 +137,15 @@ lemma arg_le_pi (x : ℂ) : arg x ≤ π := lemma neg_pi_lt_arg (x : ℂ) : -π < arg x := (arg_mem_Ioc x).1 +lemma abs_arg_le_pi (z : ℂ) : |arg z| ≤ π := abs_le.2 ⟨(neg_pi_lt_arg z).le, arg_le_pi z⟩ + @[simp] lemma arg_nonneg_iff {z : ℂ} : 0 ≤ arg z ↔ 0 ≤ z.im := begin rcases eq_or_ne z 0 with (rfl|h₀), { simp }, calc 0 ≤ arg z ↔ 0 ≤ real.sin (arg z) : ⟨λ h, real.sin_nonneg_of_mem_Icc ⟨h, arg_le_pi z⟩, by { contrapose!, intro h, exact real.sin_neg_of_neg_of_neg_pi_lt h (neg_pi_lt_arg _) }⟩ - ... ↔ _ : by rw [sin_arg, le_div_iff (abs_pos.2 h₀), zero_mul] + ... ↔ _ : by rw [sin_arg, le_div_iff (abs.pos h₀), zero_mul] end @[simp] lemma arg_neg_iff {z : ℂ} : arg z < 0 ↔ z.im < 0 := @@ -152,23 +155,23 @@ lemma arg_real_mul (x : ℂ) {r : ℝ} (hr : 0 < r) : arg (r * x) = arg x := begin rcases eq_or_ne x 0 with (rfl|hx), { rw mul_zero }, conv_lhs { rw [← abs_mul_cos_add_sin_mul_I x, ← mul_assoc, ← of_real_mul, - arg_mul_cos_add_sin_mul_I (mul_pos hr (abs_pos.2 hx)) x.arg_mem_Ioc] } + arg_mul_cos_add_sin_mul_I (mul_pos hr (abs.pos hx)) x.arg_mem_Ioc] } end lemma arg_eq_arg_iff {x y : ℂ} (hx : x ≠ 0) (hy : y ≠ 0) : arg x = arg y ↔ (abs y / abs x : ℂ) * x = y := begin - simp only [ext_abs_arg_iff, abs_mul, abs_div, abs_of_real, abs_abs, - div_mul_cancel _ (abs_ne_zero.2 hx), eq_self_iff_true, true_and], + simp only [ext_abs_arg_iff, map_mul, map_div₀, abs_of_real, abs_abs, + div_mul_cancel _ (abs.ne_zero hx), eq_self_iff_true, true_and], rw [← of_real_div, arg_real_mul], - exact div_pos (abs_pos.2 hy) (abs_pos.2 hx) + exact div_pos (abs.pos hy) (abs.pos hx) end @[simp] lemma arg_one : arg 1 = 0 := by simp [arg, zero_le_one] @[simp] lemma arg_neg_one : arg (-1) = π := -by simp [arg, le_refl, not_le.2 (@zero_lt_one ℝ _ _)] +by simp [arg, le_refl, not_le.2 (zero_lt_one' ℝ)] @[simp] lemma arg_I : arg I = π / 2 := by simp [arg, le_refl] @@ -181,7 +184,7 @@ begin by_cases h : x = 0, { simp only [h, zero_div, complex.zero_im, complex.arg_zero, real.tan_zero, complex.zero_re] }, rw [real.tan_eq_sin_div_cos, sin_arg, cos_arg h, - div_div_div_cancel_right _ (abs_ne_zero.2 h)] + div_div_div_cancel_right _ (abs.ne_zero h)] end lemma arg_of_real_of_nonneg {x : ℝ} (hx : 0 ≤ x) : arg x = 0 := @@ -191,7 +194,7 @@ lemma arg_eq_zero_iff {z : ℂ} : arg z = 0 ↔ 0 ≤ z.re ∧ z.im = 0 := begin refine ⟨λ h, _, _⟩, { rw [←abs_mul_cos_add_sin_mul_I z, h], - simp [abs_nonneg] }, + simp [abs.nonneg] }, { cases z with x y, rintro ⟨h, rfl : y = 0⟩, exact arg_of_real_of_nonneg h } @@ -206,6 +209,9 @@ begin rw [← arg_neg_one, ← arg_real_mul (-1) (neg_pos.2 h)], simp [← of_real_def] } end +lemma arg_lt_pi_iff {z : ℂ} : arg z < π ↔ 0 ≤ z.re ∨ z.im ≠ 0 := +by rw [(arg_le_pi z).lt_iff_ne, not_iff_comm, not_or_distrib, not_le, not_not, arg_eq_pi_iff] + lemma arg_of_real_of_neg {x : ℝ} (hx : x < 0) : arg x = π := arg_eq_pi_iff.2 ⟨hx, rfl⟩ @@ -288,7 +294,7 @@ begin rw [iff_false, not_le, arg_of_re_neg_of_im_nonneg hre him, ← sub_lt_iff_lt_add, half_sub, real.neg_pi_div_two_lt_arcsin, neg_im, neg_div, neg_lt_neg_iff, div_lt_one, ← _root_.abs_of_nonneg him, abs_im_lt_abs], - exacts [hre.ne, abs_pos.2 $ ne_of_apply_ne re hre.ne] }, + exacts [hre.ne, abs.pos $ ne_of_apply_ne re hre.ne] }, { simp only [him], rw [iff_true, arg_of_re_neg_of_im_neg hre him], exact (sub_le_self _ real.pi_pos.le).trans (real.arcsin_le_pi_div_two _) } @@ -306,7 +312,7 @@ begin { simp only [him.not_le], rw [iff_false, not_le, arg_of_re_neg_of_im_neg hre him, sub_lt_iff_lt_add', ← sub_eq_add_neg, sub_half, real.arcsin_lt_pi_div_two, div_lt_one, neg_im, ← abs_of_neg him, abs_im_lt_abs], - exacts [hre.ne, abs_pos.2 $ ne_of_apply_ne re hre.ne] } + exacts [hre.ne, abs.pos $ ne_of_apply_ne re hre.ne] } end @[simp] lemma abs_arg_le_pi_div_two_iff {z : ℂ} : |arg z| ≤ π / 2 ↔ 0 ≤ re z := @@ -384,34 +390,26 @@ begin real.angle.sub_coe_pi_eq_add_coe_pi] } end -lemma arg_mul_cos_add_sin_mul_I_eq_mul_fract {r : ℝ} (hr : 0 < r) (θ : ℝ) : - arg (r * (cos θ + sin θ * I)) = π - 2 * π * int.fract ((π - θ) / (2 * π)) := +lemma arg_mul_cos_add_sin_mul_I_eq_to_Ioc_mod {r : ℝ} (hr : 0 < r) (θ : ℝ) : + arg (r * (cos θ + sin θ * I)) = to_Ioc_mod real.two_pi_pos (-π) θ := begin - have hi : π - 2 * π * int.fract ((π - θ) / (2 * π)) ∈ Ioc (-π) π, - { rw [←mem_preimage, preimage_const_sub_Ioc, ←mem_preimage, - preimage_const_mul_Ico _ _ real.two_pi_pos, sub_self, zero_div, sub_neg_eq_add, - ←two_mul, div_self real.two_pi_pos.ne.symm], - refine set.mem_of_mem_of_subset (set.mem_range_self _) _, - rw [←image_univ, int.image_fract], - simp }, - have hs : π - 2 * π * int.fract ((π - θ) / (2 * π)) = 2 * π * ⌊(π - θ) / (2 * π)⌋ + θ, - { rw [int.fract, mul_sub, mul_div_cancel' _ real.two_pi_pos.ne.symm], - abel }, + have hi : to_Ioc_mod real.two_pi_pos (-π) θ ∈ Ioc (-π) π, + { convert to_Ioc_mod_mem_Ioc _ _ _, + ring }, convert arg_mul_cos_add_sin_mul_I hr hi using 3, - simp_rw [hs, mul_comm (2 * π), add_comm _ θ, ←of_real_cos, ←of_real_sin, - real.cos_add_int_mul_two_pi, real.sin_add_int_mul_two_pi] + simp [to_Ioc_mod, cos_sub_int_mul_two_pi, sin_sub_int_mul_two_pi] end -lemma arg_cos_add_sin_mul_I_eq_mul_fract (θ : ℝ) : - arg (cos θ + sin θ * I) = π - 2 * π * int.fract ((π - θ) / (2 * π)) := -by rw [←one_mul (_ + _), ←of_real_one, arg_mul_cos_add_sin_mul_I_eq_mul_fract zero_lt_one] +lemma arg_cos_add_sin_mul_I_eq_to_Ioc_mod (θ : ℝ) : + arg (cos θ + sin θ * I) = to_Ioc_mod real.two_pi_pos (-π) θ := +by rw [←one_mul (_ + _), ←of_real_one, arg_mul_cos_add_sin_mul_I_eq_to_Ioc_mod zero_lt_one] lemma arg_mul_cos_add_sin_mul_I_sub {r : ℝ} (hr : 0 < r) (θ : ℝ) : arg (r * (cos θ + sin θ * I)) - θ = 2 * π * ⌊(π - θ) / (2 * π)⌋ := begin - rw [arg_mul_cos_add_sin_mul_I_eq_mul_fract hr, int.fract, mul_sub, - mul_div_cancel' _ real.two_pi_pos.ne.symm], - abel + rw [arg_mul_cos_add_sin_mul_I_eq_to_Ioc_mod hr, to_Ioc_mod_sub_self, to_Ioc_div_eq_neg_floor, + zsmul_eq_mul], + ring_nf end lemma arg_cos_add_sin_mul_I_sub (θ : ℝ) : @@ -434,7 +432,7 @@ by rw [←one_mul (_ + _), ←of_real_one, arg_mul_cos_add_sin_mul_I_coe_angle z lemma arg_mul_coe_angle {x y : ℂ} (hx : x ≠ 0) (hy : y ≠ 0) : (arg (x * y) : real.angle) = arg x + arg y := begin - convert arg_mul_cos_add_sin_mul_I_coe_angle (mul_pos (abs_pos.2 hx) (abs_pos.2 hy)) + convert arg_mul_cos_add_sin_mul_I_coe_angle (mul_pos (abs.pos hx) (abs.pos hy)) (arg x + arg y : real.angle) using 3, simp_rw [←real.angle.coe_add, real.angle.sin_coe, real.angle.cos_coe, of_real_cos, of_real_sin, cos_add_sin_I, of_real_add, add_mul, exp_add, of_real_mul], @@ -446,28 +444,19 @@ lemma arg_div_coe_angle {x y : ℂ} (hx : x ≠ 0) (hy : y ≠ 0) : (arg (x / y) : real.angle) = arg x - arg y := by rw [div_eq_mul_inv, arg_mul_coe_angle hx (inv_ne_zero hy), arg_inv_coe_angle, sub_eq_add_neg] -@[simp] lemma arg_coe_angle_eq_iff {x y : ℂ} : (arg x : real.angle) = arg y ↔ arg x = arg y := +@[simp] lemma arg_coe_angle_to_real_eq_arg (z : ℂ) : (arg z : real.angle).to_real = arg z := begin - split, - { intro h, - rw real.angle.angle_eq_iff_two_pi_dvd_sub at h, - rcases h with ⟨k, hk⟩, - rw ←sub_eq_zero, - have ha : -(2 * π) < arg x - arg y, - { linarith only [neg_pi_lt_arg x, arg_le_pi y] }, - have hb : arg x - arg y < 2 * π, - { linarith only [arg_le_pi x, neg_pi_lt_arg y] }, - rw [hk, neg_lt, neg_mul_eq_mul_neg, mul_lt_iff_lt_one_right real.two_pi_pos, neg_lt, - ←int.cast_one, ←int.cast_neg, int.cast_lt] at ha, - rw [hk, mul_lt_iff_lt_one_right real.two_pi_pos, ←int.cast_one, int.cast_lt] at hb, - have hk' : k = 0, - { linarith only [ha, hb] }, - rw hk' at hk, - simpa using hk }, - { intro h, - rw h } + rw real.angle.to_real_coe_eq_self_iff_mem_Ioc, + exact arg_mem_Ioc _ end +lemma arg_coe_angle_eq_iff_eq_to_real {z : ℂ} {θ : real.angle} : + (arg z : real.angle) = θ ↔ arg z = θ.to_real := +by rw [←real.angle.to_real_inj, arg_coe_angle_to_real_eq_arg] + +@[simp] lemma arg_coe_angle_eq_iff {x y : ℂ} : (arg x : real.angle) = arg y ↔ arg x = arg y := +by simp_rw [←real.angle.to_real_inj, arg_coe_angle_to_real_eq_arg] + section continuity variables {x z : ℂ} @@ -505,7 +494,7 @@ lemma arg_eq_nhds_of_im_neg (hz : im z < 0) : lemma continuous_at_arg (h : 0 < x.re ∨ x.im ≠ 0) : continuous_at arg x := begin - have h₀ : abs x ≠ 0, { rw abs_ne_zero, rintro rfl, simpa using h }, + have h₀ : abs x ≠ 0, { rw abs.ne_zero_iff, rintro rfl, simpa using h }, rw [← lt_or_lt_iff_ne] at h, rcases h with (hx_re|hx_im|hx_im), exacts [(real.continuous_at_arcsin.comp (continuous_im.continuous_at.div @@ -555,6 +544,28 @@ lemma tendsto_arg_nhds_within_im_nonneg_of_re_neg_of_im_zero by simpa only [arg_eq_pi_iff.2 ⟨hre, him⟩] using (continuous_within_at_arg_of_re_neg_of_im_zero hre him).tendsto +lemma continuous_at_arg_coe_angle (h : x ≠ 0) : continuous_at (coe ∘ arg : ℂ → real.angle) x := +begin + by_cases hs : 0 < x.re ∨ x.im ≠ 0, + { exact real.angle.continuous_coe.continuous_at.comp (continuous_at_arg hs) }, + { rw [←function.comp.right_id (coe ∘ arg), + (function.funext_iff.2 (λ _, (neg_neg _).symm) : + (id : ℂ → ℂ) = has_neg.neg ∘ has_neg.neg), ←function.comp.assoc], + refine continuous_at.comp _ continuous_neg.continuous_at, + suffices : continuous_at (function.update ((coe ∘ arg) ∘ has_neg.neg : ℂ → real.angle) 0 π) + (-x), by rwa continuous_at_update_of_ne (neg_ne_zero.2 h) at this, + have ha : function.update ((coe ∘ arg) ∘ has_neg.neg : ℂ → real.angle) 0 π = + λ z, (arg z : real.angle) + π, + { rw function.update_eq_iff, + exact ⟨by simp, λ z hz, arg_neg_coe_angle hz⟩ }, + rw ha, + push_neg at hs, + refine (real.angle.continuous_coe.continuous_at.comp (continuous_at_arg (or.inl _))).add + continuous_at_const, + rw [neg_re, neg_pos], + exact hs.1.lt_of_ne (λ h0, h (ext_iff.2 ⟨h0, hs.2⟩)) } +end + end continuity end complex diff --git a/src/analysis/special_functions/complex/circle.lean b/src/analysis/special_functions/complex/circle.lean index 51ca090e57ab1..9da2facb23e57 100644 --- a/src/analysis/special_functions/complex/circle.lean +++ b/src/analysis/special_functions/complex/circle.lean @@ -9,6 +9,9 @@ import analysis.special_functions.complex.log /-! # Maps on the unit circle +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove some basic lemmas about `exp_map_circle` and the restriction of `complex.arg` to the unit circle. These two maps define a local equivalence between `circle` and `ℝ`, see `circle.arg_local_equiv` and `circle.arg_equiv`, that sends the whole circle to `(-π, π]`. @@ -95,6 +98,12 @@ periodic_exp_map_circle.lift θ real.angle.exp_map_circle x = exp_map_circle x := rfl +lemma real.angle.coe_exp_map_circle (θ : real.angle) : (θ.exp_map_circle : ℂ) = θ.cos + θ.sin * I := +begin + induction θ using real.angle.induction_on, + simp [complex.exp_mul_I], +end + @[simp] lemma real.angle.exp_map_circle_zero : real.angle.exp_map_circle 0 = 1 := by rw [←real.angle.coe_zero, real.angle.exp_map_circle_coe, exp_map_circle_zero] diff --git a/src/analysis/special_functions/complex/log.lean b/src/analysis/special_functions/complex/log.lean index ca30aaa89c548..7965cd052fc0a 100644 --- a/src/analysis/special_functions/complex/log.lean +++ b/src/analysis/special_functions/complex/log.lean @@ -9,6 +9,9 @@ import analysis.special_functions.log.basic /-! # The complex `log` function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Basic properties, relationship with `exp`. -/ @@ -18,7 +21,7 @@ namespace complex open set filter -open_locale real topological_space +open_locale real topology complex_conjugate /-- Inverse of the `exp` function. Returns values such that `(log x).im > - π` and `(log x).im ≤ π`. `log 0 = 0`-/ @@ -33,9 +36,9 @@ lemma log_im_le_pi (x : ℂ) : (log x).im ≤ π := by simp only [log_im, arg_le lemma exp_log {x : ℂ} (hx : x ≠ 0) : exp (log x) = x := by rw [log, exp_add_mul_I, ← of_real_sin, sin_arg, ← of_real_cos, cos_arg hx, - ← of_real_exp, real.exp_log (abs_pos.2 hx), mul_add, of_real_div, of_real_div, - mul_div_cancel' _ (of_real_ne_zero.2 (mt abs_eq_zero.1 hx)), ← mul_assoc, - mul_div_cancel' _ (of_real_ne_zero.2 (mt abs_eq_zero.1 hx)), re_add_im] + ← of_real_exp, real.exp_log (abs.pos hx), mul_add, of_real_div, of_real_div, + mul_div_cancel' _ (of_real_ne_zero.2 $ abs.ne_zero hx), ← mul_assoc, + mul_div_cancel' _ (of_real_ne_zero.2 $ abs.ne_zero hx), re_add_im] @[simp] lemma range_exp : range exp = {0}ᶜ := set.ext $ λ x, ⟨by { rintro ⟨x, rfl⟩, exact exp_ne_zero x }, λ hx, ⟨log x, exp_log hx⟩⟩ @@ -55,6 +58,18 @@ complex.ext lemma log_of_real_re (x : ℝ) : (log (x : ℂ)).re = real.log x := by simp [log_re] +lemma log_of_real_mul {r : ℝ} (hr : 0 < r) {x : ℂ} (hx : x ≠ 0) : + log (r * x) = real.log r + log x := +begin + replace hx := complex.abs.ne_zero_iff.mpr hx, + simp_rw [log, map_mul, abs_of_real, arg_real_mul _ hr, abs_of_pos hr, real.log_mul hr.ne' hx, + of_real_add, add_assoc], +end + +lemma log_mul_of_real (r : ℝ) (hr : 0 < r) (x : ℂ) (hx : x ≠ 0) : + log (x * r) = real.log r + log x := +by rw [mul_comm, log_of_real_mul hr hx, add_comm] + @[simp] lemma log_zero : log 0 = 0 := by simp [log] @[simp] lemma log_one : log 1 = 0 := by simp [log] @@ -65,6 +80,35 @@ lemma log_I : log I = π / 2 * I := by simp [log] lemma log_neg_I : log (-I) = -(π / 2) * I := by simp [log] +lemma log_conj_eq_ite (x : ℂ) : + log (conj x) = if x.arg = π then log x else conj (log x) := +begin + simp_rw [log, abs_conj, arg_conj, map_add, map_mul, conj_of_real], + split_ifs with hx, + { rw hx }, + simp_rw [of_real_neg, conj_I, mul_neg, neg_mul] +end + +lemma log_conj (x : ℂ) (h : x.arg ≠ π) : log (conj x) = conj (log x) := +by rw [log_conj_eq_ite, if_neg h] + +lemma log_inv_eq_ite (x : ℂ) : log (x⁻¹) = if x.arg = π then -conj (log x) else -log x := +begin + by_cases hx : x = 0, + { simp [hx] }, + rw [inv_def, log_mul_of_real, real.log_inv, of_real_neg, ←sub_eq_neg_add, log_conj_eq_ite], + { simp_rw [log, map_add, map_mul, conj_of_real, conj_I, norm_sq_eq_abs, real.log_pow, + nat.cast_two, of_real_mul, of_real_bit0, of_real_one, neg_add, mul_neg, two_mul, neg_neg], + split_ifs, + { rw [add_sub_right_comm, sub_add_cancel'] }, + { rw [add_sub_right_comm, sub_add_cancel'] } }, + { rwa [inv_pos, complex.norm_sq_pos] }, + { rwa map_ne_zero }, +end + +lemma log_inv (x : ℂ) (hx : x.arg ≠ π) : log (x⁻¹) = -log x := +by rw [log_inv_eq_ite, if_neg hx] + lemma two_pi_I_ne_zero : (2 * π * I : ℂ) ≠ 0 := by norm_num [real.pi_ne_zero, I_ne_zero] @@ -86,7 +130,7 @@ by rw [exp_sub, div_eq_one_iff_eq (exp_ne_zero _)] lemma exp_eq_exp_iff_exists_int {x y : ℂ} : exp x = exp y ↔ ∃ n : ℤ, x = y + n * ((2 * π) * I) := by simp only [exp_eq_exp_iff_exp_sub_eq_one, exp_eq_one_iff, sub_eq_iff_eq_add'] -@[simp] lemma countable_preimage_exp {s : set ℂ} : countable (exp ⁻¹' s) ↔ countable s := +@[simp] lemma countable_preimage_exp {s : set ℂ} : (exp ⁻¹' s).countable ↔ s.countable := begin refine ⟨λ hs, _, λ hs, _⟩, { refine ((hs.image exp).insert 0).mono _, @@ -100,7 +144,7 @@ begin { push_neg at hne, simp [preimage, hne] } } end -alias countable_preimage_exp ↔ _ set.countable.preimage_cexp +alias countable_preimage_exp ↔ _ _root_.set.countable.preimage_cexp lemma tendsto_log_nhds_within_im_neg_of_re_neg_of_im_zero {z : ℂ} (hre : z.re < 0) (him : z.im = 0) : @@ -133,12 +177,21 @@ lemma tendsto_log_nhds_within_im_nonneg_of_re_neg_of_im_zero by simpa only [log, arg_eq_pi_iff.2 ⟨hre, him⟩] using (continuous_within_at_log_of_re_neg_of_im_zero hre him).tendsto +@[simp] lemma map_exp_comap_re_at_bot : map exp (comap re at_bot) = 𝓝[≠] 0 := +by rw [← comap_exp_nhds_zero, map_comap, range_exp, nhds_within] + +@[simp] lemma map_exp_comap_re_at_top : map exp (comap re at_top) = comap abs at_top := +begin + rw [← comap_exp_comap_abs_at_top, map_comap, range_exp, inf_eq_left, le_principal_iff], + exact eventually_ne_of_tendsto_norm_at_top tendsto_comap 0 +end + end complex section log_deriv open complex filter -open_locale topological_space +open_locale topology variables {α : Type*} @@ -148,7 +201,7 @@ begin refine continuous_at.add _ _, { refine continuous_of_real.continuous_at.comp _, refine (real.continuous_at_log _).comp complex.continuous_abs.continuous_at, - rw abs_ne_zero, + rw complex.abs.ne_zero_iff, rintro rfl, simpa using h }, { have h_cont_mul : continuous (λ x : ℂ, x * I), from continuous_id'.mul continuous_const, diff --git a/src/analysis/special_functions/complex/log_deriv.lean b/src/analysis/special_functions/complex/log_deriv.lean index 75d63fafccf35..ce07999d4f09f 100644 --- a/src/analysis/special_functions/complex/log_deriv.lean +++ b/src/analysis/special_functions/complex/log_deriv.lean @@ -3,12 +3,16 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson -/ +import analysis.calculus.inverse import analysis.special_functions.complex.log import analysis.special_functions.exp_deriv /-! # Differentiability of the complex `log` function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + -/ noncomputable theory @@ -17,7 +21,10 @@ namespace complex open set filter -open_locale real topological_space +open_locale real topology + +lemma is_open_map_exp : is_open_map exp := +open_map_of_strict_deriv has_strict_deriv_at_exp exp_ne_zero /-- `complex.exp` as a `local_homeomorph` with `source = {z | -π < im z < π}` and `target = {z | 0 < re z} ∪ {z | im z ≠ 0}`. This definition is used to prove that `complex.log` @@ -56,7 +63,7 @@ lemma has_strict_fderiv_at_log_real {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) : has_strict_fderiv_at log (x⁻¹ • (1 : ℂ →L[ℝ] ℂ)) x := (has_strict_deriv_at_log h).complex_to_real_fderiv -lemma cont_diff_at_log {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) {n : with_top ℕ} : +lemma cont_diff_at_log {x : ℂ} (h : 0 < x.re ∨ x.im ≠ 0) {n : ℕ∞} : cont_diff_at ℂ n log x := exp_local_homeomorph.cont_diff_at_symm_deriv (exp_ne_zero $ log x) h (has_deriv_at_exp _) cont_diff_exp.cont_diff_at @@ -66,9 +73,9 @@ end complex section log_deriv open complex filter -open_locale topological_space +open_locale topology -variables {α : Type*} [topological_space α] {E : Type*} [normed_group E] [normed_space ℂ E] +variables {α : Type*} [topological_space α] {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] lemma has_strict_fderiv_at.clog {f : E → ℂ} {f' : E →L[ℂ] ℂ} {x : E} (h₁ : has_strict_fderiv_at f f' x) (h₂ : 0 < (f x).re ∨ (f x).im ≠ 0) : diff --git a/src/analysis/special_functions/exp.lean b/src/analysis/special_functions/exp.lean index 1cf7c8cf4394e..24a73fee4cb2a 100644 --- a/src/analysis/special_functions/exp.lean +++ b/src/analysis/special_functions/exp.lean @@ -3,12 +3,16 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne -/ +import analysis.asymptotics.theta import analysis.complex.basic -import data.complex.exponential +import analysis.specific_limits.normed /-! # Complex and real exponential +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove continuity of `complex.exp` and `real.exp`. We also prove a few facts about limits of `real.exp` at infinity. @@ -20,42 +24,42 @@ exp noncomputable theory open finset filter metric asymptotics set function -open_locale classical topological_space +open_locale classical topology namespace complex variables {z y x : ℝ} -lemma exp_bound_sq (x z : ℂ) (hz : ∥z∥ ≤ 1) : - ∥exp (x + z) - exp x - z • exp x∥ ≤ ∥exp x∥ * ∥z∥ ^ 2 := -calc ∥exp (x + z) - exp x - z * exp x∥ - = ∥exp x * (exp z - 1 - z)∥ : by { congr, rw [exp_add], ring } -... = ∥exp x∥ * ∥exp z - 1 - z∥ : norm_mul _ _ -... ≤ ∥exp x∥ * ∥z∥^2 : mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le hz) (norm_nonneg _) +lemma exp_bound_sq (x z : ℂ) (hz : ‖z‖ ≤ 1) : + ‖exp (x + z) - exp x - z • exp x‖ ≤ ‖exp x‖ * ‖z‖ ^ 2 := +calc ‖exp (x + z) - exp x - z * exp x‖ + = ‖exp x * (exp z - 1 - z)‖ : by { congr, rw [exp_add], ring } +... = ‖exp x‖ * ‖exp z - 1 - z‖ : norm_mul _ _ +... ≤ ‖exp x‖ * ‖z‖^2 : mul_le_mul_of_nonneg_left (abs_exp_sub_one_sub_id_le hz) (norm_nonneg _) lemma locally_lipschitz_exp {r : ℝ} (hr_nonneg : 0 ≤ r) (hr_le : r ≤ 1) (x y : ℂ) - (hyx : ∥y - x∥ < r) : - ∥exp y - exp x∥ ≤ (1 + r) * ∥exp x∥ * ∥y - x∥ := + (hyx : ‖y - x‖ < r) : + ‖exp y - exp x‖ ≤ (1 + r) * ‖exp x‖ * ‖y - x‖ := begin have hy_eq : y = x + (y - x), by abel, - have hyx_sq_le : ∥y - x∥ ^ 2 ≤ r * ∥y - x∥, + have hyx_sq_le : ‖y - x‖ ^ 2 ≤ r * ‖y - x‖, { rw pow_two, exact mul_le_mul hyx.le le_rfl (norm_nonneg _) hr_nonneg, }, - have h_sq : ∀ z, ∥z∥ ≤ 1 → ∥exp (x + z) - exp x∥ ≤ ∥z∥ * ∥exp x∥ + ∥exp x∥ * ∥z∥ ^ 2, + have h_sq : ∀ z, ‖z‖ ≤ 1 → ‖exp (x + z) - exp x‖ ≤ ‖z‖ * ‖exp x‖ + ‖exp x‖ * ‖z‖ ^ 2, { intros z hz, - have : ∥exp (x + z) - exp x - z • exp x∥ ≤ ∥exp x∥ * ∥z∥ ^ 2, from exp_bound_sq x z hz, - rw [← sub_le_iff_le_add', ← norm_smul z], - exact (norm_sub_norm_le _ _).trans this, }, - calc ∥exp y - exp x∥ = ∥exp (x + (y - x)) - exp x∥ : by nth_rewrite 0 hy_eq - ... ≤ ∥y - x∥ * ∥exp x∥ + ∥exp x∥ * ∥y - x∥ ^ 2 : h_sq (y - x) (hyx.le.trans hr_le) - ... ≤ ∥y - x∥ * ∥exp x∥ + ∥exp x∥ * (r * ∥y - x∥) : + have : ‖exp (x + z) - exp x - z • exp x‖ ≤ ‖exp x‖ * ‖z‖ ^ 2, from exp_bound_sq x z hz, + rw [← sub_le_iff_le_add', ← norm_smul z (_ : ℂ)], + exact (norm_sub_norm_le _ _).trans this }, + calc ‖exp y - exp x‖ = ‖exp (x + (y - x)) - exp x‖ : by nth_rewrite 0 hy_eq + ... ≤ ‖y - x‖ * ‖exp x‖ + ‖exp x‖ * ‖y - x‖ ^ 2 : h_sq (y - x) (hyx.le.trans hr_le) + ... ≤ ‖y - x‖ * ‖exp x‖ + ‖exp x‖ * (r * ‖y - x‖) : add_le_add_left (mul_le_mul le_rfl hyx_sq_le (sq_nonneg _) (norm_nonneg _)) _ - ... = (1 + r) * ∥exp x∥ * ∥y - x∥ : by ring, + ... = (1 + r) * ‖exp x‖ * ‖y - x‖ : by ring, end @[continuity] lemma continuous_exp : continuous exp := continuous_iff_continuous_at.mpr $ - λ x, continuous_at_of_locally_lipschitz zero_lt_one (2 * ∥exp x∥) + λ x, continuous_at_of_locally_lipschitz zero_lt_one (2 * ‖exp x‖) (locally_lipschitz_exp zero_le_one le_rfl x) lemma continuous_on_exp {s : set ℂ} : continuous_on exp s := @@ -129,7 +133,10 @@ end real_continuous_exp_comp namespace real -variables {x y z : ℝ} +variables {α : Type*} {x y z : ℝ} {l : filter α} + +lemma exp_half (x : ℝ) : exp (x / 2) = sqrt (exp x) := +by rw [eq_comm, sqrt_eq_iff_sq_eq, sq, ← exp_add, add_halves]; exact (exp_pos _).le /-- The real exponential function tends to `+∞` at `+∞`. -/ lemma tendsto_exp_at_top : tendsto exp at_top at_top := @@ -157,6 +164,14 @@ lemma tendsto_exp_at_bot : tendsto exp at_bot (𝓝 0) := lemma tendsto_exp_at_bot_nhds_within : tendsto exp at_bot (𝓝[>] 0) := tendsto_inf.2 ⟨tendsto_exp_at_bot, tendsto_principal.2 $ eventually_of_forall exp_pos⟩ +@[simp] lemma is_bounded_under_ge_exp_comp (l : filter α) (f : α → ℝ) : + is_bounded_under (≥) l (λ x, exp (f x)) := +is_bounded_under_of ⟨0, λ x, (exp_pos _).le⟩ + +@[simp] lemma is_bounded_under_le_exp_comp {f : α → ℝ} : + is_bounded_under (≤) l (λ x, exp (f x)) ↔ is_bounded_under (≤) l f := +exp_monotone.is_bounded_under_le_comp tendsto_exp_at_top + /-- The function `exp(x)/x^n` tends to `+∞` at `+∞`, for any natural number `n` -/ lemma tendsto_exp_div_pow_at_top (n : ℕ) : tendsto (λx, exp x / x^n) at_top at_top := begin @@ -187,15 +202,12 @@ lemma tendsto_pow_mul_exp_neg_at_top_nhds_0 (n : ℕ) : tendsto (λx, x^n * exp lemma tendsto_mul_exp_add_div_pow_at_top (b c : ℝ) (n : ℕ) (hb : 0 < b) : tendsto (λ x, (b * exp x + c) / x ^ n) at_top at_top := begin - rcases n.eq_zero_or_pos with rfl | hn, + rcases eq_or_ne n 0 with rfl | hn, { simp only [pow_zero, div_one], exact (tendsto_exp_at_top.const_mul_at_top hb).at_top_add tendsto_const_nhds }, - refine tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top 0) _) - (((tendsto_exp_div_pow_at_top n).const_mul_at_top hb).at_top_add - ((tendsto_pow_neg_at_top hn).mul (@tendsto_const_nhds _ _ _ c _))), - intros x hx, - simp only [zpow_neg₀ x n], - ring, + simp only [add_div, mul_div_assoc], + exact ((tendsto_exp_div_pow_at_top n).const_mul_at_top hb).at_top_add + (tendsto_const_nhds.div_at_top (tendsto_pow_at_top hn)) end /-- The function `(x ^ n) / (b * exp x + c)` tends to `0` at `+∞`, for any natural number @@ -207,7 +219,7 @@ begin { intros b' c' h, convert (tendsto_mul_exp_add_div_pow_at_top b' c' n h).inv_tendsto_at_top , ext x, - simpa only [pi.inv_apply] using inv_div.symm }, + simpa only [pi.inv_apply] using (inv_div _ _).symm }, cases lt_or_gt_of_ne hb, { exact H b c h }, { convert (H (-b) (-c) (neg_pos.mpr h)).neg, @@ -220,7 +232,7 @@ end /-- `real.exp` as an order isomorphism between `ℝ` and `(0, +∞)`. -/ def exp_order_iso : ℝ ≃o Ioi (0 : ℝ) := strict_mono.order_iso_of_surjective _ (exp_strict_mono.cod_restrict exp_pos) $ - (continuous_subtype_mk _ continuous_exp).surjective + (continuous_exp.subtype_mk _).surjective (by simp only [tendsto_Ioi_at_top, subtype.coe_mk, tendsto_exp_at_top]) (by simp [tendsto_exp_at_bot_nhds_within]) @@ -237,43 +249,103 @@ by rw [← coe_comp_exp_order_iso, ← filter.map_map, order_iso.map_at_top, map @[simp] lemma comap_exp_at_top : comap exp at_top = at_top := by rw [← map_exp_at_top, comap_map exp_injective, map_exp_at_top] -@[simp] lemma tendsto_exp_comp_at_top {α : Type*} {l : filter α} {f : α → ℝ} : +@[simp] lemma tendsto_exp_comp_at_top {f : α → ℝ} : tendsto (λ x, exp (f x)) l at_top ↔ tendsto f l at_top := by rw [← tendsto_comap_iff, comap_exp_at_top] -lemma tendsto_comp_exp_at_top {α : Type*} {l : filter α} {f : ℝ → α} : +lemma tendsto_comp_exp_at_top {f : ℝ → α} : tendsto (λ x, f (exp x)) at_top l ↔ tendsto f at_top l := by rw [← tendsto_map'_iff, map_exp_at_top] @[simp] lemma map_exp_at_bot : map exp at_bot = 𝓝[>] 0 := by rw [← coe_comp_exp_order_iso, ← filter.map_map, exp_order_iso.map_at_bot, ← map_coe_Ioi_at_bot] -lemma comap_exp_nhds_within_Ioi_zero : comap exp (𝓝[>] 0) = at_bot := +@[simp] lemma comap_exp_nhds_within_Ioi_zero : comap exp (𝓝[>] 0) = at_bot := by rw [← map_exp_at_bot, comap_map exp_injective] -lemma tendsto_comp_exp_at_bot {α : Type*} {l : filter α} {f : ℝ → α} : +lemma tendsto_comp_exp_at_bot {f : ℝ → α} : tendsto (λ x, f (exp x)) at_bot l ↔ tendsto f (𝓝[>] 0) l := by rw [← map_exp_at_bot, tendsto_map'_iff] -lemma is_o_pow_exp_at_top {n : ℕ} : is_o (λ x, x^n) real.exp at_top := +@[simp] lemma comap_exp_nhds_zero : comap exp (𝓝 0) = at_bot := +(comap_nhds_within_range exp 0).symm.trans $ by simp + +@[simp] lemma tendsto_exp_comp_nhds_zero {f : α → ℝ} : + tendsto (λ x, exp (f x)) l (𝓝 0) ↔ tendsto f l at_bot := +by rw [← tendsto_comap_iff, comap_exp_nhds_zero] + +lemma is_o_pow_exp_at_top {n : ℕ} : (λ x, x^n) =o[at_top] real.exp := by simpa [is_o_iff_tendsto (λ x hx, ((exp_pos x).ne' hx).elim)] using tendsto_div_pow_mul_exp_add_at_top 1 0 n zero_ne_one +@[simp] lemma is_O_exp_comp_exp_comp {f g : α → ℝ} : + (λ x, exp (f x)) =O[l] (λ x, exp (g x)) ↔ is_bounded_under (≤) l (f - g) := +iff.trans (is_O_iff_is_bounded_under_le_div $ eventually_of_forall $ λ x, exp_ne_zero _) $ + by simp only [norm_eq_abs, abs_exp, ← exp_sub, is_bounded_under_le_exp_comp, pi.sub_def] + +@[simp] lemma is_Theta_exp_comp_exp_comp {f g : α → ℝ} : + (λ x, exp (f x)) =Θ[l] (λ x, exp (g x)) ↔ is_bounded_under (≤) l (λ x, |f x - g x|) := +by simp only [is_bounded_under_le_abs, ← is_bounded_under_le_neg, neg_sub, is_Theta, + is_O_exp_comp_exp_comp, pi.sub_def] + +@[simp] lemma is_o_exp_comp_exp_comp {f g : α → ℝ} : + (λ x, exp (f x)) =o[l] (λ x, exp (g x)) ↔ tendsto (λ x, g x - f x) l at_top := +by simp only [is_o_iff_tendsto, exp_ne_zero, ← exp_sub, ← tendsto_neg_at_top_iff, false_implies_iff, + implies_true_iff, tendsto_exp_comp_nhds_zero, neg_sub] + +@[simp] lemma is_o_one_exp_comp {f : α → ℝ} : + (λ x, 1 : α → ℝ) =o[l] (λ x, exp (f x)) ↔ tendsto f l at_top := +by simp only [← exp_zero, is_o_exp_comp_exp_comp, sub_zero] + +/-- `real.exp (f x)` is bounded away from zero along a filter if and only if this filter is bounded +from below under `f`. -/ +@[simp] lemma is_O_one_exp_comp {f : α → ℝ} : + (λ x, 1 : α → ℝ) =O[l] (λ x, exp (f x)) ↔ is_bounded_under (≥) l f := +by simp only [← exp_zero, is_O_exp_comp_exp_comp, pi.sub_def, zero_sub, is_bounded_under_le_neg] + +/-- `real.exp (f x)` is bounded away from zero along a filter if and only if this filter is bounded +from below under `f`. -/ +lemma is_O_exp_comp_one {f : α → ℝ} : + (λ x, exp (f x)) =O[l] (λ x, 1 : α → ℝ) ↔ is_bounded_under (≤) l f := +by simp only [is_O_one_iff, norm_eq_abs, abs_exp, is_bounded_under_le_exp_comp] + +/-- `real.exp (f x)` is bounded away from zero and infinity along a filter `l` if and only if +`|f x|` is bounded from above along this filter. -/ +@[simp] lemma is_Theta_exp_comp_one {f : α → ℝ} : + (λ x, exp (f x)) =Θ[l] (λ x, 1 : α → ℝ) ↔ is_bounded_under (≤) l (λ x, |f x|) := +by simp only [← exp_zero, is_Theta_exp_comp_exp_comp, sub_zero] + end real namespace complex +lemma comap_exp_comap_abs_at_top : comap exp (comap abs at_top) = comap re at_top := +calc comap exp (comap abs at_top) = comap re (comap real.exp at_top) : + by simp only [comap_comap, (∘), abs_exp] +... = comap re at_top : by rw [real.comap_exp_at_top] + +lemma comap_exp_nhds_zero : comap exp (𝓝 0) = comap re at_bot := +calc comap exp (𝓝 0) = comap re (comap real.exp (𝓝 0)) : + by simp only [comap_comap, ← comap_abs_nhds_zero, (∘), abs_exp] +... = comap re at_bot : by rw [real.comap_exp_nhds_zero] + +lemma comap_exp_nhds_within_zero : comap exp (𝓝[≠] 0) = comap re at_bot := +have exp ⁻¹' {0}ᶜ = univ, from eq_univ_of_forall exp_ne_zero, +by simp [nhds_within, comap_exp_nhds_zero, this] + +lemma tendsto_exp_nhds_zero_iff {α : Type*} {l : filter α} {f : α → ℂ} : + tendsto (λ x, exp (f x)) l (𝓝 0) ↔ tendsto (λ x, re (f x)) l at_bot := +by rw [← tendsto_comap_iff, comap_exp_nhds_zero, tendsto_comap_iff] + /-- `complex.abs (complex.exp z) → ∞` as `complex.re z → ∞`. TODO: use `bornology.cobounded`. -/ lemma tendsto_exp_comap_re_at_top : tendsto exp (comap re at_top) (comap abs at_top) := -by simpa only [tendsto_comap_iff, (∘), abs_exp] using real.tendsto_exp_at_top.comp tendsto_comap +comap_exp_comap_abs_at_top ▸ tendsto_comap /-- `complex.exp z → 0` as `complex.re z → -∞`.-/ lemma tendsto_exp_comap_re_at_bot : tendsto exp (comap re at_bot) (𝓝 0) := -tendsto_zero_iff_norm_tendsto_zero.2 $ - by simpa only [norm_eq_abs, abs_exp] using real.tendsto_exp_at_bot.comp tendsto_comap +comap_exp_nhds_zero ▸ tendsto_comap lemma tendsto_exp_comap_re_at_bot_nhds_within : tendsto exp (comap re at_bot) (𝓝[≠] 0) := -tendsto_inf.2 ⟨tendsto_exp_comap_re_at_bot, - tendsto_principal.2 $ eventually_of_forall $ exp_ne_zero⟩ +comap_exp_nhds_within_zero ▸ tendsto_comap end complex diff --git a/src/analysis/special_functions/exp_deriv.lean b/src/analysis/special_functions/exp_deriv.lean index eccbb6494a222..828a3c2d14373 100644 --- a/src/analysis/special_functions/exp_deriv.lean +++ b/src/analysis/special_functions/exp_deriv.lean @@ -3,13 +3,14 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne -/ -import analysis.calculus.inverse import analysis.complex.real_deriv -import analysis.special_functions.exp /-! # Complex and real exponential +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that `complex.exp` and `real.exp` are infinitely smooth functions. ## Tags @@ -20,25 +21,26 @@ exp, derivative noncomputable theory open filter asymptotics set function -open_locale classical topological_space +open_locale classical topology namespace complex +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 ℂ] /-- The complex exponential is everywhere differentiable, with the derivative `exp x`. -/ lemma has_deriv_at_exp (x : ℂ) : has_deriv_at exp (exp x) x := begin rw has_deriv_at_iff_is_o_nhds_zero, have : (1 : ℕ) < 2 := by norm_num, - refine (is_O.of_bound (∥exp x∥) _).trans_is_o (is_o_pow_id this), + refine (is_O.of_bound (‖exp x‖) _).trans_is_o (is_o_pow_id this), filter_upwards [metric.ball_mem_nhds (0 : ℂ) zero_lt_one], simp only [metric.mem_ball, dist_zero_right, norm_pow], exact λ z hz, exp_bound_sq x z hz.le, end -lemma differentiable_exp : differentiable ℂ exp := -λx, (has_deriv_at_exp x).differentiable_at +lemma differentiable_exp : differentiable 𝕜 exp := +λ x, (has_deriv_at_exp x).differentiable_at.restrict_scalars 𝕜 -lemma differentiable_at_exp {x : ℂ} : differentiable_at ℂ exp x := +lemma differentiable_at_exp {x : ℂ} : differentiable_at 𝕜 exp x := differentiable_exp x @[simp] lemma deriv_exp : deriv exp = exp := @@ -48,14 +50,16 @@ funext $ λ x, (has_deriv_at_exp x).deriv | 0 := rfl | (n+1) := by rw [iterate_succ_apply, deriv_exp, iter_deriv_exp n] -lemma cont_diff_exp : ∀ {n}, cont_diff ℂ n exp := +lemma cont_diff_exp : ∀ {n}, cont_diff 𝕜 n exp := begin refine cont_diff_all_iff_nat.2 (λ n, _), - induction n with n ihn, - { exact cont_diff_zero.2 continuous_exp }, - { rw cont_diff_succ_iff_deriv, - use differentiable_exp, - rwa deriv_exp } + have : cont_diff ℂ ↑n exp, + { induction n with n ihn, + { exact cont_diff_zero.2 continuous_exp }, + { rw cont_diff_succ_iff_deriv, + use differentiable_exp, + rwa deriv_exp }, }, + exact this.restrict_scalars 𝕜 end lemma has_strict_deriv_at_exp (x : ℂ) : has_strict_deriv_at exp (exp x) x := @@ -65,13 +69,11 @@ lemma has_strict_fderiv_at_exp_real (x : ℂ) : has_strict_fderiv_at exp (exp x • (1 : ℂ →L[ℝ] ℂ)) x := (has_strict_deriv_at_exp x).complex_to_real_fderiv -lemma is_open_map_exp : is_open_map exp := -open_map_of_strict_deriv has_strict_deriv_at_exp exp_ne_zero - end complex section -variables {f : ℂ → ℂ} {f' x : ℂ} {s : set ℂ} +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 ℂ] + {f : 𝕜 → ℂ} {f' : ℂ} {x : 𝕜} {s : set 𝕜} lemma has_strict_deriv_at.cexp (hf : has_strict_deriv_at f f' x) : has_strict_deriv_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') x := @@ -85,39 +87,20 @@ lemma has_deriv_within_at.cexp (hf : has_deriv_within_at f f' s x) : has_deriv_within_at (λ x, complex.exp (f x)) (complex.exp (f x) * f') s x := (complex.has_deriv_at_exp (f x)).comp_has_deriv_within_at x hf -lemma deriv_within_cexp (hf : differentiable_within_at ℂ f s x) - (hxs : unique_diff_within_at ℂ s x) : - deriv_within (λx, complex.exp (f x)) s x = complex.exp (f x) * (deriv_within f s x) := +lemma deriv_within_cexp (hf : differentiable_within_at 𝕜 f s x) + (hxs : unique_diff_within_at 𝕜 s x) : + deriv_within (λ x, complex.exp (f x)) s x = complex.exp (f x) * deriv_within f s x := hf.has_deriv_within_at.cexp.deriv_within hxs -@[simp] lemma deriv_cexp (hc : differentiable_at ℂ f x) : - deriv (λx, complex.exp (f x)) x = complex.exp (f x) * (deriv f x) := +@[simp] lemma deriv_cexp (hc : differentiable_at 𝕜 f x) : + deriv (λ x, complex.exp (f x)) x = complex.exp (f x) * deriv f x := hc.has_deriv_at.cexp.deriv end section -variables {f : ℝ → ℂ} {f' : ℂ} {x : ℝ} {s : set ℝ} - -open complex - -lemma has_strict_deriv_at.cexp_real (h : has_strict_deriv_at f f' x) : - has_strict_deriv_at (λ x, exp (f x)) (exp (f x) * f') x := -(has_strict_fderiv_at_exp_real (f x)).comp_has_strict_deriv_at x h - -lemma has_deriv_at.cexp_real (h : has_deriv_at f f' x) : - has_deriv_at (λ x, exp (f x)) (exp (f x) * f') x := -(has_strict_fderiv_at_exp_real (f x)).has_fderiv_at.comp_has_deriv_at x h - -lemma has_deriv_within_at.cexp_real (h : has_deriv_within_at f f' s x) : - has_deriv_within_at (λ x, exp (f x)) (exp (f x) * f') s x := -(has_strict_fderiv_at_exp_real (f x)).has_fderiv_at.comp_has_deriv_within_at x h - -end - -section - -variables {E : Type*} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {f' : E →L[ℂ] ℂ} +variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 ℂ] + {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {f : E → ℂ} {f' : E →L[𝕜] ℂ} {x : E} {s : set E} lemma has_strict_fderiv_at.cexp (hf : has_strict_fderiv_at f f' x) : @@ -132,36 +115,36 @@ lemma has_fderiv_at.cexp (hf : has_fderiv_at f f' x) : has_fderiv_at (λ x, complex.exp (f x)) (complex.exp (f x) • f') x := has_fderiv_within_at_univ.1 $ hf.has_fderiv_within_at.cexp -lemma differentiable_within_at.cexp (hf : differentiable_within_at ℂ f s x) : - differentiable_within_at ℂ (λ x, complex.exp (f x)) s x := +lemma differentiable_within_at.cexp (hf : differentiable_within_at 𝕜 f s x) : + differentiable_within_at 𝕜 (λ x, complex.exp (f x)) s x := hf.has_fderiv_within_at.cexp.differentiable_within_at -@[simp] lemma differentiable_at.cexp (hc : differentiable_at ℂ f x) : - differentiable_at ℂ (λx, complex.exp (f x)) x := +@[simp] lemma differentiable_at.cexp (hc : differentiable_at 𝕜 f x) : + differentiable_at 𝕜 (λ x, complex.exp (f x)) x := hc.has_fderiv_at.cexp.differentiable_at -lemma differentiable_on.cexp (hc : differentiable_on ℂ f s) : - differentiable_on ℂ (λx, complex.exp (f x)) s := -λx h, (hc x h).cexp +lemma differentiable_on.cexp (hc : differentiable_on 𝕜 f s) : + differentiable_on 𝕜 (λ x, complex.exp (f x)) s := +λ x h, (hc x h).cexp -@[simp] lemma differentiable.cexp (hc : differentiable ℂ f) : - differentiable ℂ (λx, complex.exp (f x)) := -λx, (hc x).cexp +@[simp] lemma differentiable.cexp (hc : differentiable 𝕜 f) : + differentiable 𝕜 (λ x, complex.exp (f x)) := +λ x, (hc x).cexp -lemma cont_diff.cexp {n} (h : cont_diff ℂ n f) : - cont_diff ℂ n (λ x, complex.exp (f x)) := +lemma cont_diff.cexp {n} (h : cont_diff 𝕜 n f) : + cont_diff 𝕜 n (λ x, complex.exp (f x)) := complex.cont_diff_exp.comp h -lemma cont_diff_at.cexp {n} (hf : cont_diff_at ℂ n f x) : - cont_diff_at ℂ n (λ x, complex.exp (f x)) x := +lemma cont_diff_at.cexp {n} (hf : cont_diff_at 𝕜 n f x) : + cont_diff_at 𝕜 n (λ x, complex.exp (f x)) x := complex.cont_diff_exp.cont_diff_at.comp x hf -lemma cont_diff_on.cexp {n} (hf : cont_diff_on ℂ n f s) : - cont_diff_on ℂ n (λ x, complex.exp (f x)) s := -complex.cont_diff_exp.comp_cont_diff_on hf +lemma cont_diff_on.cexp {n} (hf : cont_diff_on 𝕜 n f s) : + cont_diff_on 𝕜 n (λ x, complex.exp (f x)) s := +complex.cont_diff_exp.comp_cont_diff_on hf -lemma cont_diff_within_at.cexp {n} (hf : cont_diff_within_at ℂ n f s x) : - cont_diff_within_at ℂ n (λ x, complex.exp (f x)) s x := +lemma cont_diff_within_at.cexp {n} (hf : cont_diff_within_at 𝕜 n f s x) : + cont_diff_within_at 𝕜 n (λ x, complex.exp (f x)) s x := complex.cont_diff_exp.cont_diff_at.comp_cont_diff_within_at x hf end @@ -228,7 +211,7 @@ section /-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable function, for standalone use and use with `simp`. -/ -variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} {x : E} {s : set E} lemma cont_diff.exp {n} (hf : cont_diff ℝ n f) : diff --git a/src/analysis/special_functions/exponential.lean b/src/analysis/special_functions/exponential.lean index 7d4ffb38ec4fd..f928d78a10f14 100644 --- a/src/analysis/special_functions/exponential.lean +++ b/src/analysis/special_functions/exponential.lean @@ -1,16 +1,18 @@ /- Copyright (c) 2021 Anatole Dedecker. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Anatole Dedecker +Authors: Anatole Dedecker, Eric Wieser -/ import analysis.normed_space.exponential import analysis.calculus.fderiv_analytic -import data.complex.exponential import topology.metric_space.cau_seq_filter /-! # Calculus results on exponential in a Banach algebra +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove basic properties about the derivative of the exponential map `exp 𝕂` in a Banach algebra `𝔸` over a field `𝕂`. We keep them separate from the main file `analysis/normed_space/exponential` in order to minimize dependencies. @@ -25,17 +27,24 @@ We prove most result for an arbitrary field `𝕂`, and then specialize to `𝕂 `1 : 𝔸 →L[𝕂] 𝔸` at zero, as long as it converges on a neighborhood of zero (see also `has_strict_deriv_at_exp_zero_of_radius_pos` for the case `𝔸 = 𝕂`) - `has_strict_fderiv_at_exp_of_lt_radius` : if `𝕂` has characteristic zero and `𝔸` is commutative, - then given a point `x` in the disk of convergence, `exp 𝕂` as strict Fréchet-derivative + then given a point `x` in the disk of convergence, `exp 𝕂` has strict Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at x (see also `has_strict_deriv_at_exp_of_lt_radius` for the case `𝔸 = 𝕂`) +- `has_strict_fderiv_at_exp_smul_const_of_mem_ball`: even when `𝔸` is non-commutative, if we have + an intermediate algebra `𝕊` which is commutative, then the function `(u : 𝕊) ↦ exp 𝕂 (u • x)`, + still has strict Fréchet-derivative `exp 𝕂 (t • x) • (1 : 𝕊 →L[𝕂] 𝕊).smul_right x` at `t` if + `t • x` is in the radius of convergence. ### `𝕂 = ℝ` or `𝕂 = ℂ` - `has_strict_fderiv_at_exp_zero` : `exp 𝕂` has strict Fréchet-derivative `1 : 𝔸 →L[𝕂] 𝔸` at zero (see also `has_strict_deriv_at_exp_zero` for the case `𝔸 = 𝕂`) -- `has_strict_fderiv_at_exp` : if `𝔸` is commutative, then given any point `x`, `exp 𝕂` as strict +- `has_strict_fderiv_at_exp` : if `𝔸` is commutative, then given any point `x`, `exp 𝕂` has strict Fréchet-derivative `exp 𝕂 x • 1 : 𝔸 →L[𝕂] 𝔸` at x (see also `has_strict_deriv_at_exp` for the case `𝔸 = 𝕂`) +- `has_strict_fderiv_at_exp_smul_const`: even when `𝔸` is non-commutative, if we have + an intermediate algebra `𝕊` which is commutative, then the function `(u : 𝕊) ↦ exp 𝕂 (u • x)` + still has strict Fréchet-derivative `exp 𝕂 (t • x) • (1 : 𝔸 →L[𝕂] 𝔸).smul_right x` at `t`. ### Compatibilty with `real.exp` and `complex.exp` @@ -45,11 +54,11 @@ We prove most result for an arbitrary field `𝕂`, and then specialize to `𝕂 -/ open filter is_R_or_C continuous_multilinear_map normed_field asymptotics -open_locale nat topological_space big_operators ennreal +open_locale nat topology big_operators ennreal section any_field_any_algebra -variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_ring 𝔸] [normed_algebra 𝕂 𝔸] +variables {𝕂 𝔸 : Type*} [nontrivially_normed_field 𝕂] [normed_ring 𝔸] [normed_algebra 𝕂 𝔸] [complete_space 𝔸] /-- The exponential in a Banach-algebra `𝔸` over a normed field `𝕂` has strict Fréchet-derivative @@ -73,7 +82,7 @@ end any_field_any_algebra section any_field_comm_algebra -variables {𝕂 𝔸 : Type*} [nondiscrete_normed_field 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸] +variables {𝕂 𝔸 : Type*} [nontrivially_normed_field 𝕂] [normed_comm_ring 𝔸] [normed_algebra 𝕂 𝔸] [complete_space 𝔸] /-- The exponential map in a commutative Banach-algebra `𝔸` over a normed field `𝕂` of @@ -110,7 +119,7 @@ end any_field_comm_algebra section deriv -variables {𝕂 : Type*} [nondiscrete_normed_field 𝕂] [complete_space 𝕂] +variables {𝕂 : Type*} [nontrivially_normed_field 𝕂] [complete_space 𝕂] /-- The exponential map in a complete normed field `𝕂` of characteristic zero has strict derivative `exp 𝕂 x` at any point `x` in the disk of convergence. -/ @@ -202,8 +211,6 @@ has_strict_deriv_at_exp_zero.has_deriv_at end deriv_R_or_C -section complex - lemma complex.exp_eq_exp_ℂ : complex.exp = exp ℂ := begin refine funext (λ x, _), @@ -212,18 +219,194 @@ begin (exp_series_div_summable ℝ x).has_sum.tendsto_sum_nat end -end complex +lemma real.exp_eq_exp_ℝ : real.exp = exp ℝ := +by { ext x, exact_mod_cast congr_fun complex.exp_eq_exp_ℂ x } + +/-! ### Derivative of $\exp (ux)$ by $u$ -section real +Note that since for `x : 𝔸` we have `normed_ring 𝔸` not `normed_comm_ring 𝔸`, we cannot deduce +these results from `has_fderiv_at_exp_of_mem_ball` applied to the algebra `𝔸`. -lemma real.exp_eq_exp_ℝ : real.exp = exp ℝ := +One possible solution for that would be to apply `has_fderiv_at_exp_of_mem_ball` to the +commutative algebra `algebra.elemental_algebra 𝕊 x`. Unfortunately we don't have all the required +API, so we leave that to a future refactor (see leanprover-community/mathlib#19062 for discussion). + +We could also go the other way around and deduce `has_fderiv_at_exp_of_mem_ball` from +`has_fderiv_at_exp_smul_const_of_mem_ball` applied to `𝕊 := 𝔸`, `x := (1 : 𝔸)`, and `t := x`. +However, doing so would make the aformentioned `elemental_algebra` refactor harder, so for now we +just prove these two lemmas independently. + +A last strategy would be to deduce everything from the more general non-commutative case, +$$\frac{d}{dt}e^{x(t)} = \int_0^1 e^{sx(t)} \left(\frac{d}{dt}e^{x(t)}\right) e^{(1-s)x(t)} ds$$ +but this is harder to prove, and typically is shown by going via these results first. + +TODO: prove this result too! +-/ + +section exp_smul +variables {𝕂 𝕊 𝔸 : Type*} +variables (𝕂) + +open_locale topology +open asymptotics filter + +section mem_ball +variables [nontrivially_normed_field 𝕂] [char_zero 𝕂] +variables [normed_comm_ring 𝕊] [normed_ring 𝔸] +variables [normed_space 𝕂 𝕊] [normed_algebra 𝕂 𝔸] [algebra 𝕊 𝔸] [has_continuous_smul 𝕊 𝔸] +variables [is_scalar_tower 𝕂 𝕊 𝔸] +variables [complete_space 𝔸] + +lemma has_fderiv_at_exp_smul_const_of_mem_ball + (x : 𝔸) (t : 𝕊) (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (exp 𝕂 (t • x) • (1 : 𝕊 →L[𝕂] 𝕊).smul_right x) t := begin - refine funext (λ x, _), - rw [real.exp, complex.exp_eq_exp_ℂ, ← exp_ℝ_ℂ_eq_exp_ℂ_ℂ, exp_eq_tsum, exp_eq_tsum_div, - ← re_to_complex, ← re_clm_apply, re_clm.map_tsum (exp_series_summable' (x : ℂ))], - refine tsum_congr (λ n, _), - rw [re_clm.map_smul, ← complex.of_real_pow, re_clm_apply, re_to_complex, complex.of_real_re, - smul_eq_mul, div_eq_inv_mul] + -- TODO: prove this via `has_fderiv_at_exp_of_mem_ball` using the commutative ring + -- `algebra.elemental_algebra 𝕊 x`. See leanprover-community/mathlib#19062 for discussion. + have hpos : 0 < (exp_series 𝕂 𝔸).radius := (zero_le _).trans_lt htx, + rw has_fderiv_at_iff_is_o_nhds_zero, + suffices : + (λ h, exp 𝕂 (t • x) * (exp 𝕂 ((0 + h) • x) - exp 𝕂 ((0 : 𝕊) • x) + - ((1 : 𝕊 →L[𝕂] 𝕊).smul_right x) h)) + =ᶠ[𝓝 0] (λ h, exp 𝕂 ((t + h) • x) - exp 𝕂 (t • x) + - (exp 𝕂 (t • x) • (1 : 𝕊 →L[𝕂] 𝕊).smul_right x) h), + { refine (is_o.const_mul_left _ _).congr' this (eventually_eq.refl _ _), + rw ← @has_fderiv_at_iff_is_o_nhds_zero _ _ _ _ _ _ _ _ + (λ u, exp 𝕂 (u • x)) ((1 : 𝕊 →L[𝕂] 𝕊).smul_right x) 0, + have : has_fderiv_at (exp 𝕂) (1 : 𝔸 →L[𝕂] 𝔸) ((1 : 𝕊 →L[𝕂] 𝕊).smul_right x 0), + { rw [continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply, zero_smul], + exact has_fderiv_at_exp_zero_of_radius_pos hpos }, + exact this.comp 0 ((1 : 𝕊 →L[𝕂] 𝕊).smul_right x).has_fderiv_at }, + have : tendsto (λ h : 𝕊, h • x) (𝓝 0) (𝓝 0), + { rw ← zero_smul 𝕊 x, + exact tendsto_id.smul_const x }, + have : ∀ᶠ h in 𝓝 (0 : 𝕊), h • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius := + this.eventually (emetric.ball_mem_nhds _ hpos), + filter_upwards [this], + intros h hh, + have : commute (t • x) (h • x) := ((commute.refl x).smul_left t).smul_right h, + rw [add_smul t h, exp_add_of_commute_of_mem_ball this htx hh, zero_add, zero_smul, exp_zero, + continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply, + continuous_linear_map.smul_apply, continuous_linear_map.smul_right_apply, + continuous_linear_map.one_apply, smul_eq_mul, mul_sub_left_distrib, mul_sub_left_distrib, + mul_one], +end + +lemma has_fderiv_at_exp_smul_const_of_mem_ball' + (x : 𝔸) (t : 𝕊) (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (((1 : 𝕊 →L[𝕂] 𝕊).smul_right x).smul_right (exp 𝕂 (t • x))) t := +begin + convert has_fderiv_at_exp_smul_const_of_mem_ball 𝕂 _ _ htx using 1, + ext t', + show commute (t' • x) (exp 𝕂 (t • x)), + exact (((commute.refl x).smul_left t').smul_right t).exp_right 𝕂, +end + +lemma has_strict_fderiv_at_exp_smul_const_of_mem_ball (x : 𝔸) (t : 𝕊) + (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_strict_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (exp 𝕂 (t • x) • (1 : 𝕊 →L[𝕂] 𝕊).smul_right x) t := +let ⟨p, hp⟩ := analytic_at_exp_of_mem_ball (t • x) htx in +have deriv₁ : has_strict_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) _ t, + from hp.has_strict_fderiv_at.comp t + ((continuous_linear_map.id 𝕂 𝕊).smul_right x).has_strict_fderiv_at, +have deriv₂ : has_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) _ t, + from has_fderiv_at_exp_smul_const_of_mem_ball 𝕂 x t htx, +(deriv₁.has_fderiv_at.unique deriv₂) ▸ deriv₁ + +lemma has_strict_fderiv_at_exp_smul_const_of_mem_ball' (x : 𝔸) (t : 𝕊) + (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_strict_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (((1 : 𝕊 →L[𝕂] 𝕊).smul_right x).smul_right (exp 𝕂 (t • x))) t := +let ⟨p, hp⟩ := analytic_at_exp_of_mem_ball (t • x) htx in +begin + convert has_strict_fderiv_at_exp_smul_const_of_mem_ball 𝕂 _ _ htx using 1, + ext t', + show commute (t' • x) (exp 𝕂 (t • x)), + exact (((commute.refl x).smul_left t').smul_right t).exp_right 𝕂, end -end real +variables {𝕂} + +lemma has_strict_deriv_at_exp_smul_const_of_mem_ball (x : 𝔸) (t : 𝕂) + (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_strict_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (exp 𝕂 (t • x) * x) t := +by simpa using (has_strict_fderiv_at_exp_smul_const_of_mem_ball 𝕂 x t htx).has_strict_deriv_at + +lemma has_strict_deriv_at_exp_smul_const_of_mem_ball' (x : 𝔸) (t : 𝕂) + (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_strict_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (x * exp 𝕂 (t • x)) t := +by simpa using (has_strict_fderiv_at_exp_smul_const_of_mem_ball' 𝕂 x t htx).has_strict_deriv_at + +lemma has_deriv_at_exp_smul_const_of_mem_ball (x : 𝔸) (t : 𝕂) + (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (exp 𝕂 (t • x) * x) t := +(has_strict_deriv_at_exp_smul_const_of_mem_ball x t htx).has_deriv_at + +lemma has_deriv_at_exp_smul_const_of_mem_ball' (x : 𝔸) (t : 𝕂) + (htx : t • x ∈ emetric.ball (0 : 𝔸) (exp_series 𝕂 𝔸).radius) : + has_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (x * exp 𝕂 (t • x)) t := +(has_strict_deriv_at_exp_smul_const_of_mem_ball' x t htx).has_deriv_at + +end mem_ball + +section is_R_or_C +variables [is_R_or_C 𝕂] +variables [normed_comm_ring 𝕊] [normed_ring 𝔸] +variables [normed_algebra 𝕂 𝕊] [normed_algebra 𝕂 𝔸] [algebra 𝕊 𝔸] [has_continuous_smul 𝕊 𝔸] +variables [is_scalar_tower 𝕂 𝕊 𝔸] +variables [complete_space 𝔸] + +variables (𝕂) + +lemma has_fderiv_at_exp_smul_const (x : 𝔸) (t : 𝕊) : + has_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (exp 𝕂 (t • x) • (1 : 𝕊 →L[𝕂] 𝕊).smul_right x) t := +has_fderiv_at_exp_smul_const_of_mem_ball 𝕂 _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +lemma has_fderiv_at_exp_smul_const' (x : 𝔸) (t : 𝕊) : + has_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (((1 : 𝕊 →L[𝕂] 𝕊).smul_right x).smul_right (exp 𝕂 (t • x))) t := +has_fderiv_at_exp_smul_const_of_mem_ball' 𝕂 _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +lemma has_strict_fderiv_at_exp_smul_const (x : 𝔸) (t : 𝕊) : + has_strict_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (exp 𝕂 (t • x) • (1 : 𝕊 →L[𝕂] 𝕊).smul_right x) t := +has_strict_fderiv_at_exp_smul_const_of_mem_ball 𝕂 _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +lemma has_strict_fderiv_at_exp_smul_const' (x : 𝔸) (t : 𝕊) : + has_strict_fderiv_at (λ u : 𝕊, exp 𝕂 (u • x)) + (((1 : 𝕊 →L[𝕂] 𝕊).smul_right x).smul_right (exp 𝕂 (t • x))) t := +has_strict_fderiv_at_exp_smul_const_of_mem_ball' 𝕂 _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +variables {𝕂} + +lemma has_strict_deriv_at_exp_smul_const (x : 𝔸) (t : 𝕂) : + has_strict_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (exp 𝕂 (t • x) * x) t := +has_strict_deriv_at_exp_smul_const_of_mem_ball _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +lemma has_strict_deriv_at_exp_smul_const' (x : 𝔸) (t : 𝕂) : + has_strict_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (x * exp 𝕂 (t • x)) t := +has_strict_deriv_at_exp_smul_const_of_mem_ball' _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +lemma has_deriv_at_exp_smul_const (x : 𝔸) (t : 𝕂) : + has_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (exp 𝕂 (t • x) * x) t := +has_deriv_at_exp_smul_const_of_mem_ball _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +lemma has_deriv_at_exp_smul_const' (x : 𝔸) (t : 𝕂) : + has_deriv_at (λ u : 𝕂, exp 𝕂 (u • x)) (x * exp 𝕂 (t • x)) t := +has_deriv_at_exp_smul_const_of_mem_ball' _ _ $ + (exp_series_radius_eq_top 𝕂 𝔸).symm ▸ edist_lt_top _ _ + +end is_R_or_C + +end exp_smul diff --git a/src/analysis/special_functions/gamma.lean b/src/analysis/special_functions/gamma.lean deleted file mode 100644 index 9ed8844250991..0000000000000 --- a/src/analysis/special_functions/gamma.lean +++ /dev/null @@ -1,517 +0,0 @@ -/- -Copyright (c) 2022 David Loeffler. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: David Loeffler --/ -import measure_theory.integral.exp_decay -import analysis.calculus.parametric_integral - -/-! -# The Gamma function - -This file defines the `Γ` function (of a real or complex variable `s`). We define this by Euler's -integral `Γ(s) = ∫ x in Ioi 0, exp (-x) * x ^ (s - 1)` in a range where we can prove this is -convergent: presently `1 ≤ s` in the real case, and `1 ≤ re s` in the complex case (which is -non-optimal, but the optimal bound of `0 < s`, resp `0 < re s`, is harder to prove using the -methods in the library). - -We show that this integral satisfies `Γ(1) = 1` and `Γ(s + 1) = s * Γ(s)`; hence we can define -`Γ(s)` for all `s` as the unique function satisfying this recurrence and agreeing with Euler's -integral in the convergence range. - -## Tags - -Gamma --/ - -noncomputable theory -open filter interval_integral set real measure_theory asymptotics -open_locale topological_space - -lemma integral_exp_neg_Ioi : ∫ (x : ℝ) in Ioi 0, exp (-x) = 1 := -begin - refine tendsto_nhds_unique (interval_integral_tendsto_integral_Ioi _ _ tendsto_id) _, - { simpa only [neg_mul, one_mul] using exp_neg_integrable_on_Ioi 0 zero_lt_one, }, - { simpa using tendsto_exp_neg_at_top_nhds_0.const_sub 1, }, -end - -namespace real - -/-- Asymptotic bound for the `Γ` function integrand. -/ -lemma Gamma_integrand_is_O (s : ℝ) : is_O (λ x:ℝ, exp (-x) * x ^ s) - (λ x:ℝ, exp (-(1/2) * x)) at_top := -begin - refine is_o.is_O (is_o_of_tendsto _ _), - { intros x hx, exfalso, exact (exp_pos (-(1 / 2) * x)).ne' hx }, - have : (λ (x:ℝ), exp (-x) * x ^ s / exp (-(1 / 2) * x)) = (λ (x:ℝ), exp ((1 / 2) * x) / x ^ s )⁻¹, - { ext1 x, - field_simp [exp_ne_zero, exp_neg, ← real.exp_add], - left, - ring }, - rw this, - exact (tendsto_exp_mul_div_rpow_at_top s (1 / 2) one_half_pos).inv_tendsto_at_top, -end - -/-- Euler's integral for the `Γ` function (of a real variable `s`), defined as -`∫ x in Ioi 0, exp (-x) * x ^ (s - 1)`. - -See `Gamma_integral_convergent` for a proof of the convergence of the integral for `1 ≤ s`. -/ -def Gamma_integral (s : ℝ) : ℝ := ∫ x in Ioi (0:ℝ), exp (-x) * x ^ (s - 1) - -/-- The integral defining the `Γ` function converges for real `s` with `1 ≤ s`. - -This is not optimal, but the optimal bound (convergence for `0 < s`) is hard to establish with the -results currently in the library. -/ -lemma Gamma_integral_convergent {s : ℝ} (h : 1 ≤ s) : - integrable_on (λ x:ℝ, exp (-x) * x ^ (s - 1)) (Ioi 0) := -begin - refine integrable_of_is_O_exp_neg one_half_pos _ (Gamma_integrand_is_O _ ), - refine continuous_on_id.neg.exp.mul (continuous_on_id.rpow_const _), - intros x hx, right, simpa only [sub_nonneg] using h, -end - -lemma Gamma_integral_one : Gamma_integral 1 = 1 := -by simpa only [Gamma_integral, sub_self, rpow_zero, mul_one] using integral_exp_neg_Ioi - -end real - -namespace complex -/- Technical note: In defining the Gamma integrand exp (-x) * x ^ (s - 1) for s complex, we have to -make a choice between ↑(real.exp (-x)), complex.exp (↑(-x)), and complex.exp (-↑x), all of which are -equal but not definitionally so. We use the first of these throughout. -/ - - -/-- The integral defining the `Γ` function converges for complex `s` with `1 ≤ re s`. - -This is proved by reduction to the real case. The bound is not optimal, but the optimal bound -(convergence for `0 < re s`) is hard to establish with the results currently in the library. -/ -lemma Gamma_integral_convergent {s : ℂ} (hs : 1 ≤ s.re) : - integrable_on (λ x, (-x).exp * x ^ (s - 1) : ℝ → ℂ) (Ioi 0) := -begin - -- This is slightly subtle if `s` is non-real but `s.re = 1`, as the integrand is not continuous - -- at the lower endpoint. However, it is continuous on the interior, and its norm is continuous - -- at the endpoint, which is good enough. - split, - { refine continuous_on.ae_strongly_measurable _ measurable_set_Ioi, - apply (continuous_of_real.comp continuous_neg.exp).continuous_on.mul, - apply continuous_at.continuous_on, - intros x hx, - have : continuous_at (λ x:ℂ, x ^ (s - 1)) ↑x, - { apply continuous_at_cpow_const, rw of_real_re, exact or.inl hx, }, - exact continuous_at.comp this continuous_of_real.continuous_at }, - { rw ←has_finite_integral_norm_iff, - refine has_finite_integral.congr (real.Gamma_integral_convergent hs).2 _, - refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (λ x hx, _)), - dsimp only, - rw [norm_eq_abs, abs_mul, abs_of_nonneg $ le_of_lt $ exp_pos $ -x, - abs_cpow_eq_rpow_re_of_pos hx _], - simp } -end - -/-- Euler's integral for the `Γ` function (of a complex variable `s`), defined as -`∫ x in Ioi 0, exp (-x) * x ^ (s - 1)`. - -See `complex.Gamma_integral_convergent` for a proof of the convergence of the integral for -`1 ≤ re s`. -/ -def Gamma_integral (s : ℂ) : ℂ := ∫ x in Ioi (0:ℝ), ↑(-x).exp * ↑x ^ (s - 1) - -lemma Gamma_integral_of_real (s : ℝ) : - Gamma_integral ↑s = ↑(s.Gamma_integral) := -begin - rw [real.Gamma_integral, ←integral_of_real], - refine set_integral_congr measurable_set_Ioi _, - intros x hx, dsimp only, - rw [of_real_mul, of_real_cpow (mem_Ioi.mp hx).le], - simp, -end - -lemma Gamma_integral_one : Gamma_integral 1 = 1 := -begin - rw [←of_real_one, Gamma_integral_of_real, of_real_inj], - exact real.Gamma_integral_one, -end - -end complex - -/-! Now we establish the recurrence relation `Γ(s + 1) = s * Γ(s)` using integration by parts. -/ - -namespace complex - -section Gamma_recurrence - -/-- The indefinite version of the `Γ` function, `Γ(s, X) = ∫ x ∈ 0..X, exp(-x) x ^ (s - 1)`. -/ -def partial_Gamma (s : ℂ) (X : ℝ) : ℂ := ∫ x in 0..X, (-x).exp * x ^ (s - 1) - -lemma tendsto_partial_Gamma {s : ℂ} (hs: 1 ≤ s.re) : - tendsto (λ X:ℝ, partial_Gamma s X) at_top (𝓝 $ Gamma_integral s) := -interval_integral_tendsto_integral_Ioi 0 (Gamma_integral_convergent hs) tendsto_id - -private lemma Gamma_integrand_interval_integrable (s : ℂ) {X : ℝ} (hs : 1 ≤ s.re) (hX : 0 ≤ X): - interval_integrable (λ x, (-x).exp * x ^ (s - 1) : ℝ → ℂ) volume 0 X := -begin - rw interval_integrable_iff_integrable_Ioc_of_le hX, - exact integrable_on.mono_set (Gamma_integral_convergent hs) Ioc_subset_Ioi_self -end - -private lemma Gamma_integrand_deriv_integrable_A {s : ℂ} (hs: 1 ≤ s.re) {X : ℝ} (hX : 0 ≤ X): - interval_integrable (λ x, -((-x).exp * x ^ s) : ℝ → ℂ) volume 0 X := -begin - have t := (Gamma_integrand_interval_integrable (s+1) _ hX).neg, - { simpa using t }, - { simp only [add_re, one_re], linarith,}, -end - -private lemma Gamma_integrand_deriv_integrable_B {s : ℂ} (hs: 1 ≤ s.re) {Y : ℝ} (hY : 0 ≤ Y) : - interval_integrable (λ (x : ℝ), (-x).exp * (s * x ^ (s - 1)) : ℝ → ℂ) volume 0 Y := -begin - have: (λ x, (-x).exp * (s * x ^ (s - 1)) : ℝ → ℂ) = - (λ x, s * ((-x).exp * x ^ (s - 1)) : ℝ → ℂ) := by { ext1, ring, }, - rw [this, interval_integrable_iff_integrable_Ioc_of_le hY], - split, - { refine (continuous_on_const.mul _).ae_strongly_measurable measurable_set_Ioc, - apply (continuous_of_real.comp continuous_neg.exp).continuous_on.mul, - apply continuous_at.continuous_on, - intros x hx, - refine (_ : continuous_at (λ x:ℂ, x ^ (s - 1)) _).comp continuous_of_real.continuous_at, - apply continuous_at_cpow_const, rw of_real_re, exact or.inl hx.1, }, - apply has_finite_integral_of_bounded, swap, exact s.abs * Y ^ (s.re - 1), - refine (ae_restrict_iff' measurable_set_Ioc).mpr (ae_of_all _ (λ x hx, _)), - rw [norm_eq_abs, abs_mul,abs_mul, abs_of_nonneg (exp_pos(-x)).le], - refine mul_le_mul_of_nonneg_left _ (abs_nonneg s), - have i1: (-x).exp ≤ 1 := by { simpa using hx.1.le, }, - have i2: abs (↑x ^ (s - 1)) ≤ Y ^ (s.re - 1), - { rw [abs_cpow_eq_rpow_re_of_pos hx.1 _, sub_re, one_re], - apply rpow_le_rpow hx.1.le hx.2, linarith, }, - simpa using mul_le_mul i1 i2 (abs_nonneg (↑x ^ (s - 1))) zero_le_one, -end - -/-- The recurrence relation for the indefinite version of the `Γ` function. -/ -lemma partial_Gamma_add_one {s : ℂ} (hs: 1 ≤ s.re) {X : ℝ} (hX : 0 ≤ X) : - partial_Gamma (s + 1) X = s * partial_Gamma s X - (-X).exp * X ^ s := -begin - rw [partial_Gamma, partial_Gamma, add_sub_cancel], - have F_der_I: (∀ (x:ℝ), (x ∈ Ioo 0 X) → has_deriv_at (λ x, (-x).exp * x ^ s : ℝ → ℂ) - ( -((-x).exp * x ^ s) + (-x).exp * (s * x ^ (s - 1))) x), - { intros x hx, - have d1 : has_deriv_at (λ (y: ℝ), (-y).exp) (-(-x).exp) x, - { simpa using (has_deriv_at_neg x).exp }, - have d1b : has_deriv_at (λ y, ↑(-y).exp : ℝ → ℂ) (↑-(-x).exp) x, - { convert has_deriv_at.scomp x of_real_clm.has_deriv_at d1, simp, }, - have d2: has_deriv_at (λ (y : ℝ), ↑y ^ s) (s * x ^ (s - 1)) x, - { have t := @has_deriv_at.cpow_const _ _ _ s (has_deriv_at_id ↑x), - simp only [id.def, of_real_re, of_real_im, - ne.def, eq_self_iff_true, not_true, or_false, mul_one] at t, - simpa using has_deriv_at.comp x (t hx.left) of_real_clm.has_deriv_at, }, - simpa only [of_real_neg, neg_mul] using d1b.mul d2 }, - have cont := (continuous_of_real.comp continuous_neg.exp).mul - (continuous_of_real_cpow_const $ lt_of_lt_of_le zero_lt_one hs), - have der_ible := (Gamma_integrand_deriv_integrable_A hs hX).add - (Gamma_integrand_deriv_integrable_B hs hX), - have int_eval := integral_eq_sub_of_has_deriv_at_of_le hX cont.continuous_on F_der_I der_ible, - -- We are basically done here but manipulating the output into the right form is fiddly. - apply_fun (λ x:ℂ, -x) at int_eval, - rw [interval_integral.integral_add (Gamma_integrand_deriv_integrable_A hs hX) - (Gamma_integrand_deriv_integrable_B hs hX), interval_integral.integral_neg, neg_add, neg_neg] - at int_eval, - replace int_eval := eq_sub_of_add_eq int_eval, - rw [int_eval, sub_neg_eq_add, neg_sub, add_comm, add_sub], - simp only [sub_left_inj, add_left_inj], - have : (λ x, (-x).exp * (s * x ^ (s - 1)) : ℝ → ℂ) = (λ x, s * (-x).exp * x ^ (s - 1) : ℝ → ℂ), - { ext1, ring,}, - rw this, - have t := @integral_const_mul (0:ℝ) X volume _ _ s (λ x:ℝ, (-x).exp * x ^ (s - 1)), - dsimp at t, rw [←t, of_real_zero, zero_cpow], - { rw [mul_zero, add_zero], congr', ext1, ring }, - { contrapose! hs, rw [hs, zero_re], exact zero_lt_one,} -end - -/-- The recurrence relation for the `Γ` integral. -/ -theorem Gamma_integral_add_one {s : ℂ} (hs: 1 ≤ s.re) : - Gamma_integral (s + 1) = s * Gamma_integral s := -begin - suffices : tendsto (s+1).partial_Gamma at_top (𝓝 $ s * Gamma_integral s), - { refine tendsto_nhds_unique _ this, - apply tendsto_partial_Gamma, rw [add_re, one_re], linarith, }, - have : (λ X:ℝ, s * partial_Gamma s X - X ^ s * (-X).exp) =ᶠ[at_top] (s+1).partial_Gamma, - { apply eventually_eq_of_mem (Ici_mem_at_top (0:ℝ)), - intros X hX, - rw partial_Gamma_add_one hs (mem_Ici.mp hX), - ring_nf, }, - refine tendsto.congr' this _, - suffices : tendsto (λ X, -X ^ s * (-X).exp : ℝ → ℂ) at_top (𝓝 0), - { simpa using tendsto.add (tendsto.const_mul s (tendsto_partial_Gamma hs)) this }, - rw tendsto_zero_iff_norm_tendsto_zero, - have : (λ (e : ℝ), ∥-(e:ℂ) ^ s * (-e).exp∥ ) =ᶠ[at_top] (λ (e : ℝ), e ^ s.re * (-1 * e).exp ), - { refine eventually_eq_of_mem (Ioi_mem_at_top 0) _, - intros x hx, dsimp only, - rw [norm_eq_abs, abs_mul, abs_neg, abs_cpow_eq_rpow_re_of_pos hx, - abs_of_nonneg (exp_pos(-x)).le, neg_mul, one_mul],}, - exact (tendsto_congr' this).mpr (tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 _ _ zero_lt_one), -end - -end Gamma_recurrence - -/-! Now we define `Γ(s)` on the whole complex plane, by recursion. -/ - -section Gamma_def - -/-- Th `n`th function in this family is `Γ(s)` if `1-n ≤ s.re`, and junk otherwise. -/ -noncomputable def Gamma_aux : ℕ → (ℂ → ℂ) -| 0 := Gamma_integral -| (n+1) := λ s:ℂ, (Gamma_aux n (s+1)) / s - -lemma Gamma_aux_recurrence1 (s : ℂ) (n : ℕ) (h1 : 1 - s.re ≤ ↑n) : - Gamma_aux n s = Gamma_aux n (s+1) / s := -begin - induction n with n hn generalizing s, - { simp only [nat.cast_zero, sub_nonpos] at h1, - dsimp only [Gamma_aux], rw Gamma_integral_add_one h1, - rw [mul_comm, mul_div_cancel], contrapose! h1, rw h1, - simp }, - { dsimp only [Gamma_aux], - have hh1 : 1 - (s+1).re ≤ n, - { rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one] at h1, - rw [add_re, one_re], linarith, }, - rw ←(hn (s+1) hh1) } -end - -lemma Gamma_aux_recurrence2 (s : ℂ) (n : ℕ) (h1 : 1 - s.re ≤ ↑n) : - Gamma_aux n s = Gamma_aux (n+1) s := -begin - cases n, - { simp only [nat.cast_zero, sub_nonpos] at h1, - dsimp only [Gamma_aux], rw Gamma_integral_add_one h1, - have : s ≠ 0 := by { contrapose! h1, rw h1, simp, }, - field_simp, ring }, - { dsimp only [Gamma_aux], - have : (Gamma_aux n (s + 1 + 1)) / (s+1) = Gamma_aux n (s + 1), - { have hh1 : 1 - (s+1).re ≤ n, - { rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one] at h1, - rw [add_re, one_re], linarith, }, - rw Gamma_aux_recurrence1 (s+1) n hh1, }, - rw this }, -end - -/-- The `Γ` function (of a complex variable `s`). -/ -def Gamma (s : ℂ) : ℂ := Gamma_aux ⌈ 1 - s.re ⌉₊ s - -lemma Gamma_eq_Gamma_aux (s : ℂ) (n : ℕ) (h1 : 1 - s.re ≤ ↑n) : Gamma s = Gamma_aux n s := -begin - have u : ∀ (k : ℕ), Gamma_aux (⌈ 1 - s.re ⌉₊ + k) s = Gamma s, - { intro k, induction k with k hk, - { simp [Gamma],}, - { rw [←hk, nat.succ_eq_add_one, ←add_assoc], - refine (Gamma_aux_recurrence2 s (⌈ 1 - s.re ⌉₊ + k) _).symm, - rw nat.cast_add, - have i1 := nat.le_ceil (1 - s.re), - refine le_add_of_le_of_nonneg i1 _, - rw [←nat.cast_zero, nat.cast_le], exact nat.zero_le k, } }, - rw [←nat.add_sub_of_le (nat.ceil_le.mpr h1), u (n - ⌈ 1 - s.re ⌉₊)], -end - -/-- The recurrence relation for the `Γ` function. -/ -theorem Gamma_add_one (s : ℂ) (h2 : s ≠ 0) : Gamma (s+1) = s * Gamma s := -begin - let n := ⌈ 1 - s.re ⌉₊, - have t1 : 1 - s.re ≤ n := nat.le_ceil (1 - s.re), - have t2 : 1 - (s+1).re ≤ n := by { rw [add_re, one_re], linarith, }, - rw [Gamma_eq_Gamma_aux s n t1, Gamma_eq_Gamma_aux (s+1) n t2, Gamma_aux_recurrence1 s n t1], - field_simp, ring -end - -theorem Gamma_eq_integral (s : ℂ) (hs : 1 ≤ s.re) : Gamma s = Gamma_integral s := -begin - refine Gamma_eq_Gamma_aux s 0 (_ : _ ≤ 0), linarith -end - -theorem Gamma_nat_eq_factorial (n : ℕ) : Gamma (n+1) = nat.factorial n := -begin - induction n with n hn, - { rw [nat.cast_zero, zero_add], rw Gamma_eq_integral, - simpa using Gamma_integral_one, simp,}, - rw (Gamma_add_one n.succ $ nat.cast_ne_zero.mpr $ nat.succ_ne_zero n), - { simp only [nat.cast_succ, nat.factorial_succ, nat.cast_mul], congr, exact hn }, -end - -end Gamma_def - -end complex - -/-! Now check that the `Γ` function is differentiable, wherever this makes sense. -/ - -section Gamma_has_deriv - -/-- Integrand for the derivative of the `Γ` function -/ -def dGamma_integrand (s : ℂ) (x : ℝ) : ℂ := exp (-x) * log x * x ^ (s - 1) - -/-- Integrand for the absolute value of the derivative of the `Γ` function -/ -def dGamma_integrand_real (s x : ℝ) : ℝ := |exp (-x) * log x * x ^ (s - 1)| - -lemma dGamma_integrand_is_O_at_top (s : ℝ) : is_O (λ x:ℝ, exp (-x) * log x * x ^ (s - 1)) - (λ x:ℝ, exp (-(1/2) * x)) at_top := -begin - refine is_o.is_O (is_o_of_tendsto _ _), - { intros x hx, exfalso, exact (-(1/2) * x).exp_pos.ne' hx, }, - have : eventually_eq at_top (λ (x : ℝ), exp (-x) * log x * x ^ (s - 1) / exp (-(1 / 2) * x)) - (λ (x : ℝ), (λ z:ℝ, exp (1 / 2 * z) / z ^ s) x * (λ z:ℝ, z / log z) x)⁻¹, - { refine eventually_of_mem (Ioi_mem_at_top 1) _, - intros x hx, dsimp, - replace hx := lt_trans zero_lt_one (mem_Ioi.mp hx), - rw [real.exp_neg, neg_mul, real.exp_neg, rpow_sub hx], - have : exp x = exp(x/2) * exp(x/2) := by { rw ←real.exp_add, simp, }, rw this, - field_simp [hx.ne', exp_ne_zero (x/2)], ring, }, - refine tendsto.congr' this.symm (tendsto.inv_tendsto_at_top _), - apply tendsto.at_top_mul_at_top (tendsto_exp_mul_div_rpow_at_top s (1/2) one_half_pos), - refine tendsto.congr' _ ((tendsto_exp_div_pow_at_top 1).comp tendsto_log_at_top), - apply eventually_eq_of_mem (Ioi_mem_at_top (0:ℝ)), - intros x hx, simp [exp_log hx], -end - -/-- Absolute convergence of the integral which will give the derivative of the `Γ` function on -`1 < re s`. -/ -lemma dGamma_integral_abs_convergent (s : ℝ) (hs : 1 < s) : - integrable_on (λ x:ℝ, ∥exp (-x) * log x * x ^ (s-1)∥) (Ioi 0) := -begin - have : Ioi (0:ℝ) = Ioc 0 1 ∪ Ioi 1 := by simp, - rw [this, integrable_on_union], - refine ⟨⟨_, _⟩, _⟩, - { refine continuous_on.ae_strongly_measurable (continuous_on.mul _ _).norm measurable_set_Ioc, - { refine (continuous_exp.comp continuous_neg).continuous_on.mul (continuous_on_log.mono _), - simp, }, - { apply continuous_on_id.rpow_const, intros x hx, right, linarith }, }, - { apply has_finite_integral_of_bounded, - swap, { exact 1 / (s - 1), }, - refine (ae_restrict_iff' measurable_set_Ioc).mpr (ae_of_all _ (λ x hx, _)), - rw [norm_norm, norm_eq_abs, mul_assoc, abs_mul], - have : 1/(s-1) = 1 * (1 / (s-1)) := by ring, rw this, - refine mul_le_mul _ _ (by apply abs_nonneg) zero_le_one, - { rw [abs_of_pos (exp_pos(-x)), exp_le_one_iff, neg_le, neg_zero], exact hx.1.le }, - { apply le_of_lt, refine abs_log_mul_self_rpow_lt x (s-1) hx.1 hx.2 (by linarith), }, }, - { have := is_O.norm_left (dGamma_integrand_is_O_at_top s), - refine integrable_of_is_O_exp_neg one_half_pos (continuous_on.mul _ _).norm this, - { refine (continuous_exp.comp continuous_neg).continuous_on.mul (continuous_on_log.mono _), - simp, }, - { apply continuous_at.continuous_on (λ x hx, _), - apply continuous_at_id.rpow continuous_at_const, - dsimp, right, linarith, }, } -end - -/-- A uniform bound for the `s`-derivative of the `Γ` integrand for `s` in vertical strips. -/ -lemma loc_unif_bound_dGamma_integrand {t : ℂ} {s1 s2 x : ℝ} (ht1 : s1 ≤ t.re) - (ht2: t.re ≤ s2) (hx : 0 < x) : - ∥dGamma_integrand t x∥ ≤ dGamma_integrand_real s1 x + dGamma_integrand_real s2 x := -begin - rcases le_or_lt 1 x with h|h, - { suffices: ∥dGamma_integrand t x∥ ≤ dGamma_integrand_real s2 x, -- case 1 ≤ x - { have: 0 ≤ dGamma_integrand_real s1 x := by apply abs_nonneg, linarith, }, - rw [dGamma_integrand, dGamma_integrand_real, complex.norm_eq_abs, complex.abs_mul, abs_mul, - ←complex.of_real_mul, complex.abs_of_real], - refine mul_le_mul_of_nonneg_left _ (abs_nonneg _), - rw complex.abs_cpow_eq_rpow_re_of_pos hx, - refine le_trans _ (le_abs_self _), - apply rpow_le_rpow_of_exponent_le h, - rw [complex.sub_re, complex.one_re], linarith, }, - { suffices: ∥dGamma_integrand t x∥ ≤ dGamma_integrand_real s1 x, - { have : 0 ≤ dGamma_integrand_real s2 x := by apply abs_nonneg, linarith, }, - rw [dGamma_integrand, dGamma_integrand_real, complex.norm_eq_abs, complex.abs_mul, abs_mul, - ←complex.of_real_mul, complex.abs_of_real], - refine mul_le_mul_of_nonneg_left _ (abs_nonneg _), - rw complex.abs_cpow_eq_rpow_re_of_pos hx, - refine le_trans _ (le_abs_self _), - apply rpow_le_rpow_of_exponent_ge hx h.le, - rw [complex.sub_re, complex.one_re], linarith, }, -end - -namespace complex - -/-- The derivative of the `Γ` integral, at any `s ∈ ℂ` with `1 < re s`, is given by the integral -of `exp (-x) * log x * x ^ (s - 1)` over `[0, ∞)`. -/ -theorem has_deriv_at_Gamma_integral {s : ℂ} (hs : 1 < s.re) : - (integrable_on (λ x, real.exp (-x) * real.log x * x ^ (s - 1) : ℝ → ℂ) (Ioi 0) volume) ∧ - (has_deriv_at Gamma_integral (∫ x:ℝ in Ioi 0, real.exp (-x) * real.log x * x ^ (s - 1)) s) := -begin - let ε := (s.re - 1) / 2, - let μ := volume.restrict (Ioi (0:ℝ)), - let bound := (λ x:ℝ, dGamma_integrand_real (s.re - ε) x + dGamma_integrand_real (s.re + ε) x), - have cont : ∀ (t : ℂ), continuous_on (λ x, real.exp (-x) * x ^ (t - 1) : ℝ → ℂ) (Ioi 0), - { intro t, apply (continuous_of_real.comp continuous_neg.exp).continuous_on.mul, - apply continuous_at.continuous_on, intros x hx, - refine (continuous_at_cpow_const _).comp continuous_of_real.continuous_at, - exact or.inl hx, }, - have eps_pos: 0 < ε := by { refine div_pos _ zero_lt_two, linarith }, - have hF_meas : ∀ᶠ (t : ℂ) in 𝓝 s, - ae_strongly_measurable (λ x, real.exp(-x) * x ^ (t - 1) : ℝ → ℂ) μ, - { apply eventually_of_forall, intro t, - exact (cont t).ae_strongly_measurable measurable_set_Ioi, }, - have hF'_meas : ae_strongly_measurable (dGamma_integrand s) μ, - { refine continuous_on.ae_strongly_measurable _ measurable_set_Ioi, - have : dGamma_integrand s = (λ x, real.exp (-x) * x ^ (s - 1) * real.log x : ℝ → ℂ), - { ext1, simp only [dGamma_integrand], ring }, - rw this, - refine continuous_on.mul (cont s) (continuous_at.continuous_on _), - exact λ x hx, continuous_of_real.continuous_at.comp (continuous_at_log (mem_Ioi.mp hx).ne'), }, - have h_bound : ∀ᵐ (x : ℝ) ∂μ, ∀ (t : ℂ), t ∈ metric.ball s ε → ∥ dGamma_integrand t x ∥ ≤ bound x, - { refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (λ x hx, _)), - intros t ht, - rw [metric.mem_ball, complex.dist_eq] at ht, - replace ht := lt_of_le_of_lt (complex.abs_re_le_abs $ t - s ) ht, - rw [complex.sub_re, @abs_sub_lt_iff ℝ _ t.re s.re ((s.re - 1) / 2) ] at ht, - refine loc_unif_bound_dGamma_integrand _ _ hx, - all_goals { simp only [ε], linarith } }, - have bound_integrable : integrable bound μ, - { apply integrable.add, - { refine dGamma_integral_abs_convergent (s.re - ε) _, - field_simp, rw one_lt_div, - { linarith }, { exact zero_lt_two }, }, - { refine dGamma_integral_abs_convergent (s.re + ε) _, linarith, }, }, - have h_diff : ∀ᵐ (x : ℝ) ∂μ, ∀ (t : ℂ), t ∈ metric.ball s ε - → has_deriv_at (λ u, real.exp (-x) * x ^ (u - 1) : ℂ → ℂ) (dGamma_integrand t x) t, - { refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (λ x hx, _)), - intros t ht, rw mem_Ioi at hx, - simp only [dGamma_integrand], - rw mul_assoc, - apply has_deriv_at.const_mul, - rw [of_real_log hx.le, mul_comm], - have := ((has_deriv_at_id t).sub_const 1).const_cpow (or.inl (of_real_ne_zero.mpr hx.ne')), - rwa mul_one at this }, - exact (has_deriv_at_integral_of_dominated_loc_of_deriv_le eps_pos hF_meas - (Gamma_integral_convergent hs.le) hF'_meas h_bound bound_integrable h_diff), -end - -lemma differentiable_at_Gamma_aux (s : ℂ) (n : ℕ) (h1 : (1 - s.re) < n ) (h2 : ∀ m:ℕ, s + m ≠ 0) : - differentiable_at ℂ (Gamma_aux n) s := -begin - induction n with n hn generalizing s, - { refine (has_deriv_at_Gamma_integral _).2.differentiable_at, - rw nat.cast_zero at h1, linarith }, - { dsimp only [Gamma_aux], - specialize hn (s + 1), - have a : 1 - (s + 1).re < ↑n, - { rw nat.cast_succ at h1, rw [complex.add_re, complex.one_re], linarith }, - have b : ∀ m:ℕ, s + 1 + m ≠ 0, - { intro m, have := h2 (1 + m), rwa [nat.cast_add, nat.cast_one, ←add_assoc] at this }, - refine differentiable_at.div (differentiable_at.comp _ (hn a b) _) _ _, - simp, simp, simpa using h2 0 } -end - -theorem differentiable_at_Gamma (s : ℂ) (hs : ∀ m:ℕ, s + m ≠ 0) : differentiable_at ℂ Gamma s := -begin - let n := ⌊1 - s.re⌋₊ + 1, - have hn : 1 - s.re < n := nat.lt_floor_add_one (1 - s.re), - apply (differentiable_at_Gamma_aux s n hn hs).congr_of_eventually_eq, - let S := { t : ℂ | 1 - t.re < n }, - have : S ∈ 𝓝 s, - { rw mem_nhds_iff, use S, - refine ⟨by refl, _, hn⟩, - have: S = re⁻¹' Ioi (1 - n : ℝ), - { ext, rw [preimage,Ioi, mem_set_of_eq, mem_set_of_eq, mem_set_of_eq], exact sub_lt }, - rw this, - refine continuous.is_open_preimage continuous_re _ is_open_Ioi, }, - apply eventually_eq_of_mem this, - intros t ht, rw mem_set_of_eq at ht, - apply Gamma_eq_Gamma_aux, exact ht.le, -end - -end complex - -end Gamma_has_deriv diff --git a/src/analysis/special_functions/gamma/basic.lean b/src/analysis/special_functions/gamma/basic.lean new file mode 100644 index 0000000000000..e8cdf1d2b63ba --- /dev/null +++ b/src/analysis/special_functions/gamma/basic.lean @@ -0,0 +1,574 @@ +/- +Copyright (c) 2022 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ +import measure_theory.integral.exp_decay +import analysis.special_functions.improper_integrals +import analysis.mellin_transform + +/-! +# The Gamma function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the `Γ` function (of a real or complex variable `s`). We define this by Euler's +integral `Γ(s) = ∫ x in Ioi 0, exp (-x) * x ^ (s - 1)` in the range where this integral converges +(i.e., for `0 < s` in the real case, and `0 < re s` in the complex case). + +We show that this integral satisfies `Γ(1) = 1` and `Γ(s + 1) = s * Γ(s)`; hence we can define +`Γ(s)` for all `s` as the unique function satisfying this recurrence and agreeing with Euler's +integral in the convergence range. (If `s = -n` for `n ∈ ℕ`, then the function is undefined, and we +set it to be `0` by convention.) + +## Gamma function: main statements (complex case) + +* `complex.Gamma`: the `Γ` function (of a complex variable). +* `complex.Gamma_eq_integral`: for `0 < re s`, `Γ(s)` agrees with Euler's integral. +* `complex.Gamma_add_one`: for all `s : ℂ` with `s ≠ 0`, we have `Γ (s + 1) = s Γ(s)`. +* `complex.Gamma_nat_eq_factorial`: for all `n : ℕ` we have `Γ (n + 1) = n!`. +* `complex.differentiable_at_Gamma`: `Γ` is complex-differentiable at all `s : ℂ` with + `s ∉ {-n : n ∈ ℕ}`. + +## Gamma function: main statements (real case) + +* `real.Gamma`: the `Γ` function (of a real variable). +* Real counterparts of all the properties of the complex Gamma function listed above: + `real.Gamma_eq_integral`, `real.Gamma_add_one`, `real.Gamma_nat_eq_factorial`, + `real.differentiable_at_Gamma`. + +## Tags + +Gamma +-/ + +noncomputable theory +open filter interval_integral set real measure_theory asymptotics +open_locale nat topology complex_conjugate + +namespace real + +/-- Asymptotic bound for the `Γ` function integrand. -/ +lemma Gamma_integrand_is_o (s : ℝ) : + (λ x:ℝ, exp (-x) * x ^ s) =o[at_top] (λ x:ℝ, exp (-(1/2) * x)) := +begin + refine is_o_of_tendsto (λ x hx, _) _, + { exfalso, exact (exp_pos (-(1 / 2) * x)).ne' hx }, + have : (λ (x:ℝ), exp (-x) * x ^ s / exp (-(1 / 2) * x)) = (λ (x:ℝ), exp ((1 / 2) * x) / x ^ s )⁻¹, + { ext1 x, + field_simp [exp_ne_zero, exp_neg, ← real.exp_add], + left, + ring }, + rw this, + exact (tendsto_exp_mul_div_rpow_at_top s (1 / 2) one_half_pos).inv_tendsto_at_top, +end + +/-- The Euler integral for the `Γ` function converges for positive real `s`. -/ +lemma Gamma_integral_convergent {s : ℝ} (h : 0 < s) : + integrable_on (λ x:ℝ, exp (-x) * x ^ (s - 1)) (Ioi 0) := +begin + rw [←Ioc_union_Ioi_eq_Ioi (@zero_le_one ℝ _ _ _ _), integrable_on_union], + split, + { rw ←integrable_on_Icc_iff_integrable_on_Ioc, + refine integrable_on.continuous_on_mul continuous_on_id.neg.exp _ is_compact_Icc, + refine (interval_integrable_iff_integrable_Icc_of_le zero_le_one).mp _, + exact interval_integrable_rpow' (by linarith), }, + { refine integrable_of_is_O_exp_neg one_half_pos _ (Gamma_integrand_is_o _ ).is_O, + refine continuous_on_id.neg.exp.mul (continuous_on_id.rpow_const _), + intros x hx, + exact or.inl ((zero_lt_one : (0 : ℝ) < 1).trans_le hx).ne' } +end + +end real + +namespace complex +/- Technical note: In defining the Gamma integrand exp (-x) * x ^ (s - 1) for s complex, we have to +make a choice between ↑(real.exp (-x)), complex.exp (↑(-x)), and complex.exp (-↑x), all of which are +equal but not definitionally so. We use the first of these throughout. -/ + + +/-- The integral defining the `Γ` function converges for complex `s` with `0 < re s`. + +This is proved by reduction to the real case. -/ +lemma Gamma_integral_convergent {s : ℂ} (hs : 0 < s.re) : + integrable_on (λ x, (-x).exp * x ^ (s - 1) : ℝ → ℂ) (Ioi 0) := +begin + split, + { refine continuous_on.ae_strongly_measurable _ measurable_set_Ioi, + apply (continuous_of_real.comp continuous_neg.exp).continuous_on.mul, + apply continuous_at.continuous_on, + intros x hx, + have : continuous_at (λ x:ℂ, x ^ (s - 1)) ↑x, + { apply continuous_at_cpow_const, rw of_real_re, exact or.inl hx, }, + exact continuous_at.comp this continuous_of_real.continuous_at }, + { rw ←has_finite_integral_norm_iff, + refine has_finite_integral.congr (real.Gamma_integral_convergent hs).2 _, + refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (λ x hx, _)), + dsimp only, + rw [norm_eq_abs, map_mul, abs_of_nonneg $ le_of_lt $ exp_pos $ -x, + abs_cpow_eq_rpow_re_of_pos hx _], + simp } +end + +/-- Euler's integral for the `Γ` function (of a complex variable `s`), defined as +`∫ x in Ioi 0, exp (-x) * x ^ (s - 1)`. + +See `complex.Gamma_integral_convergent` for a proof of the convergence of the integral for +`0 < re s`. -/ +def Gamma_integral (s : ℂ) : ℂ := ∫ x in Ioi (0:ℝ), ↑(-x).exp * ↑x ^ (s - 1) + +lemma Gamma_integral_conj (s : ℂ) : Gamma_integral (conj s) = conj (Gamma_integral s) := +begin + rw [Gamma_integral, Gamma_integral, ←integral_conj], + refine set_integral_congr measurable_set_Ioi (λ x hx, _), + dsimp only, + rw [ring_hom.map_mul, conj_of_real, cpow_def_of_ne_zero (of_real_ne_zero.mpr (ne_of_gt hx)), + cpow_def_of_ne_zero (of_real_ne_zero.mpr (ne_of_gt hx)), ←exp_conj, ring_hom.map_mul, + ←of_real_log (le_of_lt hx), conj_of_real, ring_hom.map_sub, ring_hom.map_one], +end + +lemma Gamma_integral_of_real (s : ℝ) : + Gamma_integral ↑s = ↑(∫ x:ℝ in Ioi 0, real.exp (-x) * x ^ (s - 1)) := +begin + rw [Gamma_integral, ←_root_.integral_of_real], + refine set_integral_congr measurable_set_Ioi _, + intros x hx, dsimp only, + rw [of_real_mul, of_real_cpow (mem_Ioi.mp hx).le], + simp, +end + +lemma Gamma_integral_one : Gamma_integral 1 = 1 := +by simpa only [←of_real_one, Gamma_integral_of_real, of_real_inj, sub_self, + rpow_zero, mul_one] using integral_exp_neg_Ioi_zero + +end complex + +/-! Now we establish the recurrence relation `Γ(s + 1) = s * Γ(s)` using integration by parts. -/ + +namespace complex + +section Gamma_recurrence + +/-- The indefinite version of the `Γ` function, `Γ(s, X) = ∫ x ∈ 0..X, exp(-x) x ^ (s - 1)`. -/ +def partial_Gamma (s : ℂ) (X : ℝ) : ℂ := ∫ x in 0..X, (-x).exp * x ^ (s - 1) + +lemma tendsto_partial_Gamma {s : ℂ} (hs: 0 < s.re) : + tendsto (λ X:ℝ, partial_Gamma s X) at_top (𝓝 $ Gamma_integral s) := +interval_integral_tendsto_integral_Ioi 0 (Gamma_integral_convergent hs) tendsto_id + +private lemma Gamma_integrand_interval_integrable (s : ℂ) {X : ℝ} (hs : 0 < s.re) (hX : 0 ≤ X): + interval_integrable (λ x, (-x).exp * x ^ (s - 1) : ℝ → ℂ) volume 0 X := +begin + rw interval_integrable_iff_integrable_Ioc_of_le hX, + exact integrable_on.mono_set (Gamma_integral_convergent hs) Ioc_subset_Ioi_self +end + +private lemma Gamma_integrand_deriv_integrable_A {s : ℂ} (hs : 0 < s.re) {X : ℝ} (hX : 0 ≤ X): + interval_integrable (λ x, -((-x).exp * x ^ s) : ℝ → ℂ) volume 0 X := +begin + convert (Gamma_integrand_interval_integrable (s+1) _ hX).neg, + { ext1, simp only [add_sub_cancel, pi.neg_apply] }, + { simp only [add_re, one_re], linarith,}, +end + +private lemma Gamma_integrand_deriv_integrable_B {s : ℂ} (hs : 0 < s.re) {Y : ℝ} (hY : 0 ≤ Y) : + interval_integrable (λ (x : ℝ), (-x).exp * (s * x ^ (s - 1)) : ℝ → ℂ) volume 0 Y := +begin + have : (λ x, (-x).exp * (s * x ^ (s - 1)) : ℝ → ℂ) = + (λ x, s * ((-x).exp * x ^ (s - 1)) : ℝ → ℂ), + { ext1, ring, }, + rw [this, interval_integrable_iff_integrable_Ioc_of_le hY], + split, + { refine (continuous_on_const.mul _).ae_strongly_measurable measurable_set_Ioc, + apply (continuous_of_real.comp continuous_neg.exp).continuous_on.mul, + apply continuous_at.continuous_on, + intros x hx, + refine (_ : continuous_at (λ x:ℂ, x ^ (s - 1)) _).comp continuous_of_real.continuous_at, + apply continuous_at_cpow_const, rw of_real_re, exact or.inl hx.1, }, + rw ←has_finite_integral_norm_iff, + simp_rw [norm_eq_abs, map_mul], + refine (((real.Gamma_integral_convergent hs).mono_set + Ioc_subset_Ioi_self).has_finite_integral.congr _).const_mul _, + rw [eventually_eq, ae_restrict_iff'], + { apply ae_of_all, intros x hx, + rw [abs_of_nonneg (exp_pos _).le,abs_cpow_eq_rpow_re_of_pos hx.1], + simp }, + { exact measurable_set_Ioc}, +end + +/-- The recurrence relation for the indefinite version of the `Γ` function. -/ +lemma partial_Gamma_add_one {s : ℂ} (hs: 0 < s.re) {X : ℝ} (hX : 0 ≤ X) : + partial_Gamma (s + 1) X = s * partial_Gamma s X - (-X).exp * X ^ s := +begin + rw [partial_Gamma, partial_Gamma, add_sub_cancel], + have F_der_I: (∀ (x:ℝ), (x ∈ Ioo 0 X) → has_deriv_at (λ x, (-x).exp * x ^ s : ℝ → ℂ) + ( -((-x).exp * x ^ s) + (-x).exp * (s * x ^ (s - 1))) x), + { intros x hx, + have d1 : has_deriv_at (λ (y: ℝ), (-y).exp) (-(-x).exp) x, + { simpa using (has_deriv_at_neg x).exp }, + have d2 : has_deriv_at (λ (y : ℝ), ↑y ^ s) (s * x ^ (s - 1)) x, + { have t := @has_deriv_at.cpow_const _ _ _ s (has_deriv_at_id ↑x) _, + simpa only [mul_one] using t.comp_of_real, + simpa only [id.def, of_real_re, of_real_im, + ne.def, eq_self_iff_true, not_true, or_false, mul_one] using hx.1, }, + simpa only [of_real_neg, neg_mul] using d1.of_real_comp.mul d2 }, + have cont := (continuous_of_real.comp continuous_neg.exp).mul + (continuous_of_real_cpow_const hs), + have der_ible := (Gamma_integrand_deriv_integrable_A hs hX).add + (Gamma_integrand_deriv_integrable_B hs hX), + have int_eval := integral_eq_sub_of_has_deriv_at_of_le hX cont.continuous_on F_der_I der_ible, + -- We are basically done here but manipulating the output into the right form is fiddly. + apply_fun (λ x:ℂ, -x) at int_eval, + rw [interval_integral.integral_add (Gamma_integrand_deriv_integrable_A hs hX) + (Gamma_integrand_deriv_integrable_B hs hX), interval_integral.integral_neg, neg_add, neg_neg] + at int_eval, + rw [eq_sub_of_add_eq int_eval, sub_neg_eq_add, neg_sub, add_comm, add_sub], + simp only [sub_left_inj, add_left_inj], + have : (λ x, (-x).exp * (s * x ^ (s - 1)) : ℝ → ℂ) = (λ x, s * (-x).exp * x ^ (s - 1) : ℝ → ℂ), + { ext1, ring,}, + rw this, + have t := @integral_const_mul 0 X volume _ _ s (λ x:ℝ, (-x).exp * x ^ (s - 1)), + dsimp at t, rw [←t, of_real_zero, zero_cpow], + { rw [mul_zero, add_zero], congr', ext1, ring }, + { contrapose! hs, rw [hs, zero_re] } +end + +/-- The recurrence relation for the `Γ` integral. -/ +theorem Gamma_integral_add_one {s : ℂ} (hs: 0 < s.re) : + Gamma_integral (s + 1) = s * Gamma_integral s := +begin + suffices : tendsto (s+1).partial_Gamma at_top (𝓝 $ s * Gamma_integral s), + { refine tendsto_nhds_unique _ this, + apply tendsto_partial_Gamma, rw [add_re, one_re], linarith, }, + have : (λ X:ℝ, s * partial_Gamma s X - X ^ s * (-X).exp) =ᶠ[at_top] (s+1).partial_Gamma, + { apply eventually_eq_of_mem (Ici_mem_at_top (0:ℝ)), + intros X hX, + rw partial_Gamma_add_one hs (mem_Ici.mp hX), + ring_nf, }, + refine tendsto.congr' this _, + suffices : tendsto (λ X, -X ^ s * (-X).exp : ℝ → ℂ) at_top (𝓝 0), + { simpa using tendsto.add (tendsto.const_mul s (tendsto_partial_Gamma hs)) this }, + rw tendsto_zero_iff_norm_tendsto_zero, + have : (λ (e : ℝ), ‖-(e:ℂ) ^ s * (-e).exp‖ ) =ᶠ[at_top] (λ (e : ℝ), e ^ s.re * (-1 * e).exp ), + { refine eventually_eq_of_mem (Ioi_mem_at_top 0) _, + intros x hx, dsimp only, + rw [norm_eq_abs, map_mul, abs.map_neg, abs_cpow_eq_rpow_re_of_pos hx, + abs_of_nonneg (exp_pos(-x)).le, neg_mul, one_mul],}, + exact (tendsto_congr' this).mpr (tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 _ _ zero_lt_one), +end + +end Gamma_recurrence + +/-! Now we define `Γ(s)` on the whole complex plane, by recursion. -/ + +section Gamma_def + +/-- The `n`th function in this family is `Γ(s)` if `-n < s.re`, and junk otherwise. -/ +noncomputable def Gamma_aux : ℕ → (ℂ → ℂ) +| 0 := Gamma_integral +| (n+1) := λ s:ℂ, (Gamma_aux n (s+1)) / s + +lemma Gamma_aux_recurrence1 (s : ℂ) (n : ℕ) (h1 : -s.re < ↑n) : + Gamma_aux n s = Gamma_aux n (s+1) / s := +begin + induction n with n hn generalizing s, + { simp only [nat.cast_zero, neg_lt_zero] at h1, + dsimp only [Gamma_aux], rw Gamma_integral_add_one h1, + rw [mul_comm, mul_div_cancel], contrapose! h1, rw h1, + simp }, + { dsimp only [Gamma_aux], + have hh1 : -(s+1).re < n, + { rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one] at h1, + rw [add_re, one_re], linarith, }, + rw ←(hn (s+1) hh1) } +end + +lemma Gamma_aux_recurrence2 (s : ℂ) (n : ℕ) (h1 : -s.re < ↑n) : + Gamma_aux n s = Gamma_aux (n+1) s := +begin + cases n, + { simp only [nat.cast_zero, neg_lt_zero] at h1, + dsimp only [Gamma_aux], + rw [Gamma_integral_add_one h1, mul_div_cancel_left], + rintro rfl, + rw [zero_re] at h1, + exact h1.false }, + { dsimp only [Gamma_aux], + have : (Gamma_aux n (s + 1 + 1)) / (s+1) = Gamma_aux n (s + 1), + { have hh1 : -(s+1).re < n, + { rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one] at h1, + rw [add_re, one_re], linarith, }, + rw Gamma_aux_recurrence1 (s+1) n hh1, }, + rw this }, +end + +/-- The `Γ` function (of a complex variable `s`). -/ +@[pp_nodot] def Gamma (s : ℂ) : ℂ := Gamma_aux ⌊1 - s.re⌋₊ s + +lemma Gamma_eq_Gamma_aux (s : ℂ) (n : ℕ) (h1 : -s.re < ↑n) : Gamma s = Gamma_aux n s := +begin + have u : ∀ (k : ℕ), Gamma_aux (⌊1 - s.re⌋₊ + k) s = Gamma s, + { intro k, induction k with k hk, + { simp [Gamma],}, + { rw [←hk, nat.succ_eq_add_one, ←add_assoc], + refine (Gamma_aux_recurrence2 s (⌊1 - s.re⌋₊ + k) _).symm, + rw nat.cast_add, + have i0 := nat.sub_one_lt_floor (1 - s.re), + simp only [sub_sub_cancel_left] at i0, + refine lt_add_of_lt_of_nonneg i0 _, + rw [←nat.cast_zero, nat.cast_le], exact nat.zero_le k, } }, + convert (u $ n - ⌊1 - s.re⌋₊).symm, rw nat.add_sub_of_le, + by_cases (0 ≤ 1 - s.re), + { apply nat.le_of_lt_succ, + exact_mod_cast lt_of_le_of_lt (nat.floor_le h) (by linarith : 1 - s.re < n + 1) }, + { rw nat.floor_of_nonpos, linarith, linarith }, +end + +/-- The recurrence relation for the `Γ` function. -/ +theorem Gamma_add_one (s : ℂ) (h2 : s ≠ 0) : Gamma (s+1) = s * Gamma s := +begin + let n := ⌊1 - s.re⌋₊, + have t1 : -s.re < n, + { simpa only [sub_sub_cancel_left] using nat.sub_one_lt_floor (1 - s.re) }, + have t2 : -(s+1).re < n, + { rw [add_re, one_re], linarith, }, + rw [Gamma_eq_Gamma_aux s n t1, Gamma_eq_Gamma_aux (s+1) n t2, Gamma_aux_recurrence1 s n t1], + field_simp, ring, +end + +theorem Gamma_eq_integral {s : ℂ} (hs : 0 < s.re) : Gamma s = Gamma_integral s := +Gamma_eq_Gamma_aux s 0 (by { norm_cast, linarith }) + +lemma Gamma_one : Gamma 1 = 1 := +by { rw Gamma_eq_integral, simpa using Gamma_integral_one, simp } + +theorem Gamma_nat_eq_factorial (n : ℕ) : Gamma (n+1) = n! := +begin + induction n with n hn, + { simpa using Gamma_one }, + { rw (Gamma_add_one n.succ $ nat.cast_ne_zero.mpr $ nat.succ_ne_zero n), + simp only [nat.cast_succ, nat.factorial_succ, nat.cast_mul], congr, exact hn }, +end + +/-- At `0` the Gamma function is undefined; by convention we assign it the value `0`. -/ +lemma Gamma_zero : Gamma 0 = 0 := +by simp_rw [Gamma, zero_re, sub_zero, nat.floor_one, Gamma_aux, div_zero] + +/-- At `-n` for `n ∈ ℕ`, the Gamma function is undefined; by convention we assign it the value 0. -/ +lemma Gamma_neg_nat_eq_zero (n : ℕ) : Gamma (-n) = 0 := +begin + induction n with n IH, + { rw [nat.cast_zero, neg_zero, Gamma_zero] }, + { have A : -(n.succ : ℂ) ≠ 0, + { rw [neg_ne_zero, nat.cast_ne_zero], + apply nat.succ_ne_zero }, + have : -(n:ℂ) = -↑n.succ + 1, by simp, + rw [this, Gamma_add_one _ A] at IH, + contrapose! IH, + exact mul_ne_zero A IH } +end + +lemma Gamma_conj (s : ℂ) : Gamma (conj s) = conj (Gamma s) := +begin + suffices : ∀ (n:ℕ) (s:ℂ) , Gamma_aux n (conj s) = conj (Gamma_aux n s), from this _ _, + intro n, + induction n with n IH, + { rw Gamma_aux, exact Gamma_integral_conj, }, + { intro s, + rw Gamma_aux, + dsimp only, + rw [div_eq_mul_inv _ s, ring_hom.map_mul, conj_inv, ←div_eq_mul_inv], + suffices : conj s + 1 = conj (s + 1), by rw [this, IH], + rw [ring_hom.map_add, ring_hom.map_one] } +end + +end Gamma_def + +/-! Now check that the `Γ` function is differentiable, wherever this makes sense. -/ + +section Gamma_has_deriv + +/-- Rewrite the Gamma integral as an example of a Mellin transform. -/ +lemma Gamma_integral_eq_mellin : Gamma_integral = mellin (λ x, real.exp (-x)) := +funext (λ s, by simp only [mellin, Gamma_integral, smul_eq_mul, mul_comm]) + +/-- The derivative of the `Γ` integral, at any `s ∈ ℂ` with `1 < re s`, is given by the Melllin +transform of `log t * exp (-t)`. -/ +theorem has_deriv_at_Gamma_integral {s : ℂ} (hs : 0 < s.re) : + has_deriv_at Gamma_integral (∫ (t : ℝ) in Ioi 0, t ^ (s - 1) * (real.log t * real.exp (-t))) s := +begin + rw Gamma_integral_eq_mellin, + convert (mellin_has_deriv_of_is_O_rpow _ _ (lt_add_one _) _ hs).2, + { refine (continuous.continuous_on _).locally_integrable_on measurable_set_Ioi, + exact continuous_of_real.comp (real.continuous_exp.comp continuous_neg), }, + { rw [←is_O_norm_left], + simp_rw [complex.norm_eq_abs, abs_of_real, ←real.norm_eq_abs, is_O_norm_left], + simpa only [neg_one_mul] using (is_o_exp_neg_mul_rpow_at_top zero_lt_one _).is_O }, + { simp_rw [neg_zero, rpow_zero], + refine is_O_const_of_tendsto (_ : tendsto _ _ (𝓝 1)) one_ne_zero, + rw (by simp : (1 : ℂ) = real.exp (-0)), + exact (continuous_of_real.comp (real.continuous_exp.comp continuous_neg)).continuous_within_at } +end + +lemma differentiable_at_Gamma_aux (s : ℂ) (n : ℕ) (h1 : (1 - s.re) < n ) (h2 : ∀ m : ℕ, s ≠ -m) : + differentiable_at ℂ (Gamma_aux n) s := +begin + induction n with n hn generalizing s, + { refine (has_deriv_at_Gamma_integral _).differentiable_at, + rw nat.cast_zero at h1, linarith }, + { dsimp only [Gamma_aux], + specialize hn (s + 1), + have a : 1 - (s + 1).re < ↑n, + { rw nat.cast_succ at h1, rw [complex.add_re, complex.one_re], linarith }, + have b : ∀ m : ℕ, s + 1 ≠ -m, + { intro m, have := h2 (1 + m), + contrapose! this, + rw ←eq_sub_iff_add_eq at this, + simpa using this }, + refine differentiable_at.div (differentiable_at.comp _ (hn a b) _) _ _, + simp, simp, simpa using h2 0 } +end + +theorem differentiable_at_Gamma (s : ℂ) (hs : ∀ m : ℕ, s ≠ -m) : differentiable_at ℂ Gamma s := +begin + let n := ⌊1 - s.re⌋₊ + 1, + have hn : 1 - s.re < n := by exact_mod_cast nat.lt_floor_add_one (1 - s.re), + apply (differentiable_at_Gamma_aux s n hn hs).congr_of_eventually_eq, + let S := { t : ℂ | 1 - t.re < n }, + have : S ∈ 𝓝 s, + { rw mem_nhds_iff, use S, + refine ⟨subset.rfl, _, hn⟩, + have : S = re⁻¹' Ioi (1 - n : ℝ), + { ext, rw [preimage,Ioi, mem_set_of_eq, mem_set_of_eq, mem_set_of_eq], exact sub_lt_comm }, + rw this, + refine continuous.is_open_preimage continuous_re _ is_open_Ioi, }, + apply eventually_eq_of_mem this, + intros t ht, rw mem_set_of_eq at ht, + apply Gamma_eq_Gamma_aux, linarith, +end + +end Gamma_has_deriv + +/-- At `s = 0`, the Gamma function has a simple pole with residue 1. -/ +lemma tendsto_self_mul_Gamma_nhds_zero : tendsto (λ z : ℂ, z * Gamma z) (𝓝[≠] 0) (𝓝 1) := +begin + rw (show 𝓝 (1 : ℂ) = 𝓝 (Gamma (0 + 1)), by simp only [zero_add, complex.Gamma_one]), + convert (tendsto.mono_left _ nhds_within_le_nhds).congr' + (eventually_eq_of_mem self_mem_nhds_within complex.Gamma_add_one), + refine continuous_at.comp _ (continuous_id.add continuous_const).continuous_at, + refine (complex.differentiable_at_Gamma _ (λ m, _)).continuous_at, + rw [zero_add, ←of_real_nat_cast, ←of_real_neg, ←of_real_one, ne.def, of_real_inj], + refine (lt_of_le_of_lt _ zero_lt_one).ne', + exact neg_nonpos.mpr (nat.cast_nonneg _), +end + +end complex + +namespace real + +/-- The `Γ` function (of a real variable `s`). -/ +@[pp_nodot] def Gamma (s : ℝ) : ℝ := (complex.Gamma s).re + +lemma Gamma_eq_integral {s : ℝ} (hs : 0 < s) : Gamma s = ∫ x in Ioi 0, exp (-x) * x ^ (s - 1) := +begin + rw [Gamma, complex.Gamma_eq_integral (by rwa complex.of_real_re : 0 < complex.re s)], + dsimp only [complex.Gamma_integral], + simp_rw [←complex.of_real_one, ←complex.of_real_sub], + suffices : ∫ (x : ℝ) in Ioi 0, ↑(exp (-x)) * (x : ℂ) ^ ((s - 1 : ℝ) : ℂ) = + ∫ (x : ℝ) in Ioi 0, ((exp (-x) * x ^ (s - 1) : ℝ) : ℂ), + { rw [this, _root_.integral_of_real, complex.of_real_re], }, + refine set_integral_congr measurable_set_Ioi (λ x hx, _), + push_cast, + rw complex.of_real_cpow (le_of_lt hx), + push_cast, +end + +lemma Gamma_add_one {s : ℝ} (hs : s ≠ 0) : Gamma (s + 1) = s * Gamma s := +begin + simp_rw Gamma, + rw [complex.of_real_add, complex.of_real_one, complex.Gamma_add_one, complex.of_real_mul_re], + rwa complex.of_real_ne_zero, +end + +lemma Gamma_one : Gamma 1 = 1 := +by rw [Gamma, complex.of_real_one, complex.Gamma_one, complex.one_re] + +lemma _root_.complex.Gamma_of_real (s : ℝ) : complex.Gamma (s : ℂ) = Gamma s := +by rw [Gamma, eq_comm, ←complex.conj_eq_iff_re, ←complex.Gamma_conj, complex.conj_of_real] + +theorem Gamma_nat_eq_factorial (n : ℕ) : Gamma (n + 1) = n! := +by rw [Gamma, complex.of_real_add, complex.of_real_nat_cast, complex.of_real_one, + complex.Gamma_nat_eq_factorial, ←complex.of_real_nat_cast, complex.of_real_re] + +/-- At `0` the Gamma function is undefined; by convention we assign it the value `0`. -/ +lemma Gamma_zero : Gamma 0 = 0 := +by simpa only [←complex.of_real_zero, complex.Gamma_of_real, complex.of_real_inj] + using complex.Gamma_zero + +/-- At `-n` for `n ∈ ℕ`, the Gamma function is undefined; by convention we assign it the value `0`. +-/ +lemma Gamma_neg_nat_eq_zero (n : ℕ) : Gamma (-n) = 0 := +begin + simpa only [←complex.of_real_nat_cast, ←complex.of_real_neg, complex.Gamma_of_real, + complex.of_real_eq_zero] using complex.Gamma_neg_nat_eq_zero n, +end + +lemma Gamma_pos_of_pos {s : ℝ} (hs : 0 < s) : 0 < Gamma s := +begin + rw Gamma_eq_integral hs, + have : function.support (λ (x : ℝ), exp (-x) * x ^ (s - 1)) ∩ Ioi 0 = Ioi 0, + { rw inter_eq_right_iff_subset, + intros x hx, + rw function.mem_support, + exact mul_ne_zero (exp_pos _).ne' (rpow_pos_of_pos hx _).ne' }, + rw set_integral_pos_iff_support_of_nonneg_ae, + { rw [this, volume_Ioi, ←ennreal.of_real_zero], + exact ennreal.of_real_lt_top }, + { refine eventually_of_mem (self_mem_ae_restrict measurable_set_Ioi) _, + exact λ x hx, (mul_pos (exp_pos _) (rpow_pos_of_pos hx _)).le }, + { exact Gamma_integral_convergent hs }, +end + +/-- The Gamma function does not vanish on `ℝ` (except at non-positive integers, where the function +is mathematically undefined and we set it to `0` by convention). -/ +lemma Gamma_ne_zero {s : ℝ} (hs : ∀ m : ℕ, s ≠ -m) : Gamma s ≠ 0 := +begin + suffices : ∀ {n : ℕ}, (-(n:ℝ) < s) → Gamma s ≠ 0, + { apply this, + swap, use (⌊-s⌋₊ + 1), + rw [neg_lt, nat.cast_add, nat.cast_one], + exact nat.lt_floor_add_one _ }, + intro n, + induction n generalizing s, + { intro hs, + refine (Gamma_pos_of_pos _).ne', + rwa [nat.cast_zero, neg_zero] at hs }, + { intro hs', + have : Gamma (s + 1) ≠ 0, + { apply n_ih, + { intro m, + specialize hs (1 + m), + contrapose! hs, + rw ←eq_sub_iff_add_eq at hs, + rw hs, + push_cast, + ring }, + { rw [nat.succ_eq_add_one, nat.cast_add, nat.cast_one, neg_add] at hs', + linarith } }, + rw [Gamma_add_one, mul_ne_zero_iff] at this, + { exact this.2 }, + { simpa using hs 0 } }, +end + +lemma Gamma_eq_zero_iff (s : ℝ) : Gamma s = 0 ↔ ∃ m : ℕ, s = -m := +⟨by { contrapose!, exact Gamma_ne_zero }, by { rintro ⟨m, rfl⟩, exact Gamma_neg_nat_eq_zero m }⟩ + +lemma differentiable_at_Gamma {s : ℝ} (hs : ∀ m : ℕ, s ≠ -m) : differentiable_at ℝ Gamma s := +begin + refine ((complex.differentiable_at_Gamma _ _).has_deriv_at).real_of_complex.differentiable_at, + simp_rw [←complex.of_real_nat_cast, ←complex.of_real_neg, ne.def, complex.of_real_inj], + exact hs, +end + +end real diff --git a/src/analysis/special_functions/gamma/beta.lean b/src/analysis/special_functions/gamma/beta.lean new file mode 100644 index 0000000000000..9a115267c346a --- /dev/null +++ b/src/analysis/special_functions/gamma/beta.lean @@ -0,0 +1,629 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ +import analysis.convolution +import analysis.special_functions.trigonometric.euler_sine_prod +import analysis.special_functions.gamma.bohr_mollerup +import analysis.analytic.isolated_zeros + +/-! +# The Beta function, and further properties of the Gamma function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define the Beta integral, relate Beta and Gamma functions, and prove some +refined properties of the Gamma function using these relations. + +## Results on the Beta function + +* `complex.beta_integral`: the Beta function `Β(u, v)`, where `u`, `v` are complex with positive + real part. +* `complex.Gamma_mul_Gamma_eq_beta_integral`: the formula + `Gamma u * Gamma v = Gamma (u + v) * beta_integral u v`. + +## Results on the Gamma function + +* `complex.Gamma_ne_zero`: for all `s : ℂ` with `s ∉ {-n : n ∈ ℕ}` we have `Γ s ≠ 0`. +* `complex.Gamma_seq_tendsto_Gamma`: for all `s`, the limit as `n → ∞` of the sequence + `n ↦ n ^ s * n! / (s * (s + 1) * ... * (s + n))` is `Γ(s)`. +* `complex.Gamma_mul_Gamma_one_sub`: Euler's reflection formula + `Gamma s * Gamma (1 - s) = π / sin π s`. +* `complex.differentiable_one_div_Gamma`: the function `1 / Γ(s)` is differentiable everywhere. +* `complex.Gamma_mul_Gamma_add_half`: Legendre's duplication formula + `Gamma s * Gamma (s + 1 / 2) = Gamma (2 * s) * 2 ^ (1 - 2 * s) * sqrt π`. +* `real.Gamma_ne_zero`, `real.Gamma_seq_tendsto_Gamma`, + `real.Gamma_mul_Gamma_one_sub`, `real.Gamma_mul_Gamma_add_half`: real versions of the above. +-/ + +noncomputable theory +open filter interval_integral set real measure_theory +open_locale nat topology big_operators real + +section beta_integral + +/-! ## The Beta function -/ + +namespace complex + +notation `cexp` := complex.exp + +/-- The Beta function `Β (u, v)`, defined as `∫ x:ℝ in 0..1, x ^ (u - 1) * (1 - x) ^ (v - 1)`. -/ +noncomputable def beta_integral (u v : ℂ) : ℂ := +∫ (x:ℝ) in 0..1, x ^ (u - 1) * (1 - x) ^ (v - 1) + +/-- Auxiliary lemma for `beta_integral_convergent`, showing convergence at the left endpoint. -/ +lemma beta_integral_convergent_left {u : ℂ} (hu : 0 < re u) (v : ℂ) : + interval_integrable (λ x, x ^ (u - 1) * (1 - x) ^ (v - 1) : ℝ → ℂ) volume 0 (1 / 2) := +begin + apply interval_integrable.mul_continuous_on, + { refine interval_integral.interval_integrable_cpow' _, + rwa [sub_re, one_re, ←zero_sub, sub_lt_sub_iff_right] }, + { apply continuous_at.continuous_on, + intros x hx, + rw uIcc_of_le (by positivity: (0:ℝ) ≤ 1/2) at hx, + apply continuous_at.cpow, + { exact (continuous_const.sub continuous_of_real).continuous_at }, + { exact continuous_at_const }, + { rw [sub_re, one_re, of_real_re, sub_pos], + exact or.inl (hx.2.trans_lt (by norm_num : (1/2:ℝ) < 1)) } } +end + +/-- The Beta integral is convergent for all `u, v` of positive real part. -/ +lemma beta_integral_convergent {u v : ℂ} (hu : 0 < re u) (hv : 0 < re v) : + interval_integrable (λ x, x ^ (u - 1) * (1 - x) ^ (v - 1) : ℝ → ℂ) volume 0 1 := +begin + refine (beta_integral_convergent_left hu v).trans _, + rw interval_integrable.iff_comp_neg, + convert ((beta_integral_convergent_left hv u).comp_add_right 1).symm, + { ext1 x, + conv_lhs { rw mul_comm }, + congr' 2; + { push_cast, ring } }, + { norm_num }, + { norm_num } +end + +lemma beta_integral_symm (u v : ℂ) : + beta_integral v u = beta_integral u v := +begin + rw [beta_integral, beta_integral], + have := interval_integral.integral_comp_mul_add + (λ x:ℝ, (x:ℂ) ^ (u - 1) * (1 - ↑x) ^ (v - 1)) (neg_one_lt_zero.ne) 1, + rw [inv_neg, inv_one, neg_one_smul, ←interval_integral.integral_symm] at this, + convert this, + { ext1 x, rw mul_comm, congr; + { push_cast, ring } }, + { ring }, { ring } +end + +lemma beta_integral_eval_one_right {u : ℂ} (hu : 0 < re u) : + beta_integral u 1 = 1 / u := +begin + simp_rw [beta_integral, sub_self, cpow_zero, mul_one], + rw integral_cpow (or.inl _), + { rw [of_real_zero, of_real_one, one_cpow, zero_cpow, + sub_zero, sub_add_cancel], + rw sub_add_cancel, + contrapose! hu, rw [hu, zero_re] }, + { rwa [sub_re, one_re, ←sub_pos, sub_neg_eq_add, sub_add_cancel] }, +end + +lemma beta_integral_scaled (s t : ℂ) {a : ℝ} (ha : 0 < a) : + ∫ x in 0..a, (x:ℂ) ^ (s - 1) * (a - x) ^ (t - 1) = a ^ (s + t - 1) * beta_integral s t := +begin + have ha' : (a:ℂ) ≠ 0, from of_real_ne_zero.mpr ha.ne', + rw beta_integral, + have A : (a:ℂ) ^ (s + t - 1) = a * (a ^ (s - 1) * a ^ (t - 1)), + { rw [(by abel : s + t - 1 = 1 + (s - 1) + (t - 1)), + cpow_add _ _ ha', cpow_add 1 _ ha', cpow_one, mul_assoc] }, + rw [A, mul_assoc, ←interval_integral.integral_const_mul ((↑a) ^ _ * _), + ←real_smul, ←(zero_div a), ←div_self ha.ne', + ←interval_integral.integral_comp_div _ ha.ne', zero_div], + simp_rw interval_integral.integral_of_le ha.le, + refine set_integral_congr measurable_set_Ioc (λ x hx, _), + dsimp only, + rw mul_mul_mul_comm, + congr' 1, + { rw [←mul_cpow_of_real_nonneg ha.le (div_pos hx.1 ha).le, of_real_div, mul_div_cancel' _ ha'] }, + { rw [(by push_cast : (1:ℂ) - ↑(x / a) = ↑(1 - x / a)), + ←mul_cpow_of_real_nonneg ha.le (sub_nonneg.mpr $ (div_le_one ha).mpr hx.2)], + push_cast, + rw [mul_sub, mul_one, mul_div_cancel' _ ha'] } +end + +/-- Relation between Beta integral and Gamma function. -/ +lemma Gamma_mul_Gamma_eq_beta_integral {s t : ℂ} (hs : 0 < re s) (ht : 0 < re t) : + Gamma s * Gamma t = Gamma (s + t) * beta_integral s t := +begin + -- Note that we haven't proved (yet) that the Gamma function has no zeroes, so we can't formulate + -- this as a formula for the Beta function. + have conv_int := integral_pos_convolution (Gamma_integral_convergent hs) + (Gamma_integral_convergent ht) (continuous_linear_map.mul ℝ ℂ), + simp_rw continuous_linear_map.mul_apply' at conv_int, + have hst : 0 < re (s + t), + { rw add_re, exact add_pos hs ht }, + rw [Gamma_eq_integral hs, Gamma_eq_integral ht, Gamma_eq_integral hst, Gamma_integral, + Gamma_integral, Gamma_integral, ←conv_int, ←integral_mul_right (beta_integral _ _)], + refine set_integral_congr measurable_set_Ioi (λ x hx, _), + dsimp only, + rw [mul_assoc, ←beta_integral_scaled s t hx, ←interval_integral.integral_const_mul], + congr' 1 with y:1, + push_cast, + suffices : cexp (-x) = cexp (-y) * cexp (-(x - y)), + { rw this, ring }, + { rw ←complex.exp_add, congr' 1, abel }, +end + +/-- Recurrence formula for the Beta function. -/ +lemma beta_integral_recurrence {u v : ℂ} (hu : 0 < re u) (hv : 0 < re v) : + u * beta_integral u (v + 1) = v * beta_integral (u + 1) v := +begin + -- NB: If we knew `Gamma (u + v + 1) ≠ 0` this would be an easy consequence of + -- `Gamma_mul_Gamma_eq_beta_integral`; but we don't know that yet. We will prove it later, but + -- this lemma is needed in the proof. So we give a (somewhat laborious) direct argument. + let F : ℝ → ℂ := λ x, x ^ u * (1 - x) ^ v, + have hu' : 0 < re (u + 1), by { rw [add_re, one_re], positivity }, + have hv' : 0 < re (v + 1), by { rw [add_re, one_re], positivity }, + have hc : continuous_on F (Icc 0 1), + { refine (continuous_at.continuous_on (λ x hx, _)).mul (continuous_at.continuous_on (λ x hx, _)), + { refine (continuous_at_cpow_const_of_re_pos (or.inl _) hu).comp + continuous_of_real.continuous_at, + rw of_real_re, exact hx.1 }, + { refine (continuous_at_cpow_const_of_re_pos (or.inl _) hv).comp + (continuous_const.sub continuous_of_real).continuous_at, + rw [sub_re, one_re, of_real_re, sub_nonneg], + exact hx.2 } }, + have hder : ∀ (x : ℝ), x ∈ Ioo (0:ℝ) 1 → has_deriv_at F + (u * (↑x ^ (u - 1) * (1 - ↑x) ^ v) - v * (↑x ^ u * (1 - ↑x) ^ (v - 1))) x, + { intros x hx, + have U : has_deriv_at (λ y:ℂ, y ^ u) (u * ↑x ^ (u - 1)) ↑x, + { have := has_deriv_at.cpow_const (has_deriv_at_id ↑x) (or.inl _), + { rw mul_one at this, exact this }, + { rw [id.def, of_real_re], exact hx.1 } }, + have V : has_deriv_at (λ y:ℂ, (1 - y) ^ v) (-v * (1 - ↑x) ^ (v - 1)) ↑x, + { have A := has_deriv_at.cpow_const (has_deriv_at_id (1 - ↑x)) (or.inl _), + rotate, { exact v }, + { rw [id.def, sub_re, one_re, of_real_re, sub_pos], exact hx.2 }, + simp_rw [id.def] at A, + have B : has_deriv_at (λ y:ℂ, 1 - y) (-1) ↑x, + { apply has_deriv_at.const_sub, apply has_deriv_at_id }, + convert has_deriv_at.comp ↑x A B using 1, + ring }, + convert (U.mul V).comp_of_real, + ring }, + have h_int := ((beta_integral_convergent hu hv').const_mul u).sub + ((beta_integral_convergent hu' hv).const_mul v), + dsimp only at h_int, + rw [add_sub_cancel, add_sub_cancel] at h_int, + have int_ev := interval_integral.integral_eq_sub_of_has_deriv_at_of_le zero_le_one hc hder h_int, + have hF0 : F 0 = 0, + { simp only [mul_eq_zero, of_real_zero, cpow_eq_zero_iff, eq_self_iff_true, + ne.def, true_and, sub_zero, one_cpow, one_ne_zero, or_false], + contrapose! hu, rw [hu, zero_re] }, + have hF1 : F 1 = 0, + { simp only [mul_eq_zero, of_real_one, one_cpow, one_ne_zero, sub_self, + cpow_eq_zero_iff, eq_self_iff_true, ne.def, true_and, false_or], + contrapose! hv, rw [hv, zero_re] }, + rw [hF0, hF1, sub_zero, interval_integral.integral_sub, + interval_integral.integral_const_mul, interval_integral.integral_const_mul] at int_ev, + { rw [beta_integral, beta_integral, ←sub_eq_zero], + convert int_ev; + { ext1 x, congr, abel } }, + { apply interval_integrable.const_mul, + convert beta_integral_convergent hu hv', + ext1 x, rw add_sub_cancel }, + { apply interval_integrable.const_mul, + convert beta_integral_convergent hu' hv, + ext1 x, rw add_sub_cancel }, +end + +/-- Explicit formula for the Beta function when second argument is a positive integer. -/ +lemma beta_integral_eval_nat_add_one_right {u : ℂ} (hu : 0 < re u) (n : ℕ) : + beta_integral u (n + 1) = n! / ∏ (j:ℕ) in finset.range (n + 1), (u + j) := +begin + induction n with n IH generalizing u, + { rw [nat.cast_zero, zero_add, beta_integral_eval_one_right hu, + nat.factorial_zero, nat.cast_one, zero_add, finset.prod_range_one, nat.cast_zero, add_zero] }, + { have := beta_integral_recurrence hu (_ : 0 < re n.succ), + swap, { rw [←of_real_nat_cast, of_real_re], positivity }, + rw [mul_comm u _, ←eq_div_iff] at this, + swap, { contrapose! hu, rw [hu, zero_re] }, + rw [this, finset.prod_range_succ', nat.cast_succ, IH], + swap, { rw [add_re, one_re], positivity }, + rw [nat.factorial_succ, nat.cast_mul, nat.cast_add, nat.cast_one, nat.cast_zero, add_zero, + ←mul_div_assoc, ←div_div], + congr' 3 with j:1, + push_cast, abel } +end + +end complex + +end beta_integral + +section limit_formula + +/-! ## The Euler limit formula -/ + +namespace complex + +/-- The sequence with `n`-th term `n ^ s * n! / (s * (s + 1) * ... * (s + n))`, for complex `s`. +We will show that this tends to `Γ(s)` as `n → ∞`. -/ +noncomputable def Gamma_seq (s : ℂ) (n : ℕ) := +(n:ℂ) ^ s * n! / ∏ (j:ℕ) in finset.range (n + 1), (s + j) + +lemma Gamma_seq_eq_beta_integral_of_re_pos {s : ℂ} (hs : 0 < re s) (n : ℕ) : + Gamma_seq s n = n ^ s * beta_integral s (n + 1) := +by rw [Gamma_seq, beta_integral_eval_nat_add_one_right hs n, ←mul_div_assoc] + +lemma Gamma_seq_add_one_left (s : ℂ) {n : ℕ} (hn : n ≠ 0) : + (Gamma_seq (s + 1) n) / s = n / (n + 1 + s) * Gamma_seq s n := +begin + conv_lhs { rw [Gamma_seq, finset.prod_range_succ, div_div] }, + conv_rhs { rw [Gamma_seq, finset.prod_range_succ', nat.cast_zero, add_zero, div_mul_div_comm, + ←mul_assoc, ←mul_assoc, mul_comm _ (finset.prod _ _)] }, + congr' 3, + { rw [cpow_add _ _ (nat.cast_ne_zero.mpr hn), cpow_one, mul_comm] }, + { refine finset.prod_congr (by refl) (λ x hx, _), + push_cast, ring }, + { abel } +end + +lemma Gamma_seq_eq_approx_Gamma_integral {s : ℂ} (hs : 0 < re s) {n : ℕ} (hn : n ≠ 0) : + Gamma_seq s n = ∫ x:ℝ in 0..n, ↑((1 - x / n) ^ n) * (x:ℂ) ^ (s - 1) := +begin + have : ∀ (x : ℝ), x = x / n * n, by { intro x, rw div_mul_cancel, exact nat.cast_ne_zero.mpr hn }, + conv in (↑_ ^ _) { congr, rw this x }, + rw Gamma_seq_eq_beta_integral_of_re_pos hs, + rw [beta_integral, @interval_integral.integral_comp_div _ _ _ _ 0 n _ + (λ x, ↑((1 - x) ^ n) * ↑(x * ↑n) ^ (s - 1) : ℝ → ℂ) (nat.cast_ne_zero.mpr hn), + real_smul, zero_div, div_self, add_sub_cancel, ←interval_integral.integral_const_mul, + ←interval_integral.integral_const_mul], + swap, { exact nat.cast_ne_zero.mpr hn }, + simp_rw interval_integral.integral_of_le zero_le_one, + refine set_integral_congr measurable_set_Ioc (λ x hx, _), + push_cast, + have hn' : (n : ℂ) ≠ 0, from nat.cast_ne_zero.mpr hn, + have A : (n : ℂ) ^ s = (n : ℂ) ^ (s - 1) * n, + { conv_lhs { rw [(by ring : s = (s - 1) + 1), cpow_add _ _ hn'] }, + simp }, + have B : ((x : ℂ) * ↑n) ^ (s - 1) = (x : ℂ) ^ (s - 1) * ↑n ^ (s - 1), + { rw [←of_real_nat_cast, + mul_cpow_of_real_nonneg hx.1.le (nat.cast_pos.mpr (nat.pos_of_ne_zero hn)).le] }, + rw [A, B, cpow_nat_cast], ring, +end + +/-- The main techical lemma for `Gamma_seq_tendsto_Gamma`, expressing the integral defining the +Gamma function for `0 < re s` as the limit of a sequence of integrals over finite intervals. -/ +lemma approx_Gamma_integral_tendsto_Gamma_integral {s : ℂ} (hs : 0 < re s) : + tendsto (λ n:ℕ, ∫ x:ℝ in 0..n, ↑((1 - x / n) ^ n) * (x:ℂ) ^ (s - 1)) at_top (𝓝 $ Gamma s) := +begin + rw [Gamma_eq_integral hs], + -- We apply dominated convergence to the following function, which we will show is uniformly + -- bounded above by the Gamma integrand `exp (-x) * x ^ (re s - 1)`. + let f : ℕ → ℝ → ℂ := λ n, indicator (Ioc 0 (n:ℝ)) + (λ x:ℝ, ↑((1 - x / n) ^ n) * (x:ℂ) ^ (s - 1)), + -- integrability of f + have f_ible : ∀ (n:ℕ), integrable (f n) (volume.restrict (Ioi 0)), + { intro n, + rw [integrable_indicator_iff (measurable_set_Ioc : measurable_set (Ioc (_:ℝ) _)), + integrable_on, measure.restrict_restrict_of_subset Ioc_subset_Ioi_self, ←integrable_on, + ←interval_integrable_iff_integrable_Ioc_of_le (by positivity : (0:ℝ) ≤ n)], + apply interval_integrable.continuous_on_mul, + { refine interval_integral.interval_integrable_cpow' _, + rwa [sub_re, one_re, ←zero_sub, sub_lt_sub_iff_right] }, + { apply continuous.continuous_on, continuity } }, + -- pointwise limit of f + have f_tends : ∀ x:ℝ, x ∈ Ioi (0:ℝ) → + tendsto (λ n:ℕ, f n x) at_top (𝓝 $ ↑(real.exp (-x)) * (x:ℂ) ^ (s - 1)), + { intros x hx, + apply tendsto.congr', + show ∀ᶠ n:ℕ in at_top, ↑((1 - x / n) ^ n) * (x:ℂ) ^ (s - 1) = f n x, + { refine eventually.mp (eventually_ge_at_top ⌈x⌉₊) (eventually_of_forall (λ n hn, _)), + rw nat.ceil_le at hn, + dsimp only [f], + rw indicator_of_mem, + exact ⟨hx, hn⟩ }, + { simp_rw mul_comm _ (↑x ^ _), + refine (tendsto.comp (continuous_of_real.tendsto _) _).const_mul _, + convert tendsto_one_plus_div_pow_exp (-x), + ext1 n, + rw [neg_div, ←sub_eq_add_neg] } }, + -- let `convert` identify the remaining goals + convert tendsto_integral_of_dominated_convergence _ (λ n, (f_ible n).1) + (real.Gamma_integral_convergent hs) _ + ((ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ f_tends)), + -- limit of f is the integrand we want + { ext1 n, + rw [integral_indicator (measurable_set_Ioc : measurable_set (Ioc (_:ℝ) _)), + interval_integral.integral_of_le (by positivity: 0 ≤ (n:ℝ)), + measure.restrict_restrict_of_subset Ioc_subset_Ioi_self] }, + -- f is uniformly bounded by the Gamma integrand + { intro n, + refine (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (λ x hx, _)), + dsimp only [f], + rcases lt_or_le (n:ℝ) x with hxn | hxn, + { rw [indicator_of_not_mem (not_mem_Ioc_of_gt hxn), norm_zero, + mul_nonneg_iff_right_nonneg_of_pos (exp_pos _)], + exact rpow_nonneg_of_nonneg (le_of_lt hx) _ }, + { rw [indicator_of_mem (mem_Ioc.mpr ⟨hx, hxn⟩), norm_mul, complex.norm_eq_abs, + complex.abs_of_nonneg + (pow_nonneg (sub_nonneg.mpr $ div_le_one_of_le hxn $ by positivity) _), + complex.norm_eq_abs, abs_cpow_eq_rpow_re_of_pos hx, sub_re, one_re, + mul_le_mul_right (rpow_pos_of_pos hx _ )], + exact one_sub_div_pow_le_exp_neg hxn } } +end + +/-- Euler's limit formula for the complex Gamma function. -/ +lemma Gamma_seq_tendsto_Gamma (s : ℂ) : + tendsto (Gamma_seq s) at_top (𝓝 $ Gamma s) := +begin + suffices : ∀ m : ℕ, (-↑m < re s) → tendsto (Gamma_seq s) at_top (𝓝 $ Gamma_aux m s), + { rw Gamma, + apply this, + rw neg_lt, + rcases lt_or_le 0 (re s) with hs | hs, + { exact (neg_neg_of_pos hs).trans_le (nat.cast_nonneg _), }, + { refine (nat.lt_floor_add_one _).trans_le _, + rw [sub_eq_neg_add, nat.floor_add_one (neg_nonneg.mpr hs), nat.cast_add_one] } }, + intro m, + induction m with m IH generalizing s, + { -- Base case: `0 < re s`, so Gamma is given by the integral formula + intro hs, + rw [nat.cast_zero, neg_zero] at hs, + rw [←Gamma_eq_Gamma_aux], + { refine tendsto.congr' _ (approx_Gamma_integral_tendsto_Gamma_integral hs), + refine (eventually_ne_at_top 0).mp (eventually_of_forall (λ n hn, _)), + exact (Gamma_seq_eq_approx_Gamma_integral hs hn).symm }, + { rwa [nat.cast_zero, neg_lt_zero] } }, + { -- Induction step: use recurrence formulae in `s` for Gamma and Gamma_seq + intro hs, + rw [nat.cast_succ, neg_add, ←sub_eq_add_neg, sub_lt_iff_lt_add, ←one_re, ←add_re] at hs, + rw Gamma_aux, + have := tendsto.congr' ((eventually_ne_at_top 0).mp (eventually_of_forall (λ n hn, _))) + ((IH _ hs).div_const s), + swap 3, { exact Gamma_seq_add_one_left s hn }, -- doesn't work if inlined? + conv at this in (_ / _ * _) { rw mul_comm }, + rwa [←mul_one (Gamma_aux m (s + 1) / s), tendsto_mul_iff_of_ne_zero _ (one_ne_zero' ℂ)] at this, + simp_rw add_assoc, + exact tendsto_coe_nat_div_add_at_top (1 + s) } +end + +end complex + +end limit_formula + +section gamma_reflection +/-! ## The reflection formula -/ + +namespace complex + +lemma Gamma_seq_mul (z : ℂ) {n : ℕ} (hn : n ≠ 0) : + Gamma_seq z n * Gamma_seq (1 - z) n = + n / (n + 1 - z) * (1 / (z * ∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2))) := +begin + -- also true for n = 0 but we don't need it + have aux : ∀ (a b c d : ℂ), a * b * (c * d) = a * c * (b * d), by { intros, ring }, + rw [Gamma_seq, Gamma_seq, div_mul_div_comm, aux, ←pow_two], + have : (n : ℂ) ^ z * n ^ (1 - z) = n, + { rw [←cpow_add _ _ (nat.cast_ne_zero.mpr hn), add_sub_cancel'_right, cpow_one] }, + rw [this, finset.prod_range_succ', finset.prod_range_succ, aux, ←finset.prod_mul_distrib, + nat.cast_zero, add_zero, add_comm (1 - z) n, ←add_sub_assoc], + have : ∀ (j : ℕ), (z + ↑(j + 1)) * (1 - z + ↑j) = ↑((j + 1) ^ 2) * (1 - z ^ 2 / (↑j + 1) ^ 2), + { intro j, + push_cast, + have : (j:ℂ) + 1 ≠ 0, by { rw [←nat.cast_succ, nat.cast_ne_zero], exact nat.succ_ne_zero j }, + field_simp, ring }, + simp_rw this, + rw [finset.prod_mul_distrib, ←nat.cast_prod, finset.prod_pow, + finset.prod_range_add_one_eq_factorial, nat.cast_pow, + (by {intros, ring} : ∀ (a b c d : ℂ), a * b * (c * d) = a * (d * (b * c))), + ←div_div, mul_div_cancel, ←div_div, mul_comm z _, mul_one_div], + exact pow_ne_zero 2 (nat.cast_ne_zero.mpr $ nat.factorial_ne_zero n), +end + +/-- Euler's reflection formula for the complex Gamma function. -/ +theorem Gamma_mul_Gamma_one_sub (z : ℂ) : Gamma z * Gamma (1 - z) = π / sin (π * z) := +begin + have pi_ne : (π : ℂ) ≠ 0, from complex.of_real_ne_zero.mpr pi_ne_zero, + by_cases hs : sin (↑π * z) = 0, + { -- first deal with silly case z = integer + rw [hs, div_zero], + rw [←neg_eq_zero, ←complex.sin_neg, ←mul_neg, complex.sin_eq_zero_iff, mul_comm] at hs, + obtain ⟨k, hk⟩ := hs, + rw [mul_eq_mul_right_iff, eq_false_intro (of_real_ne_zero.mpr pi_pos.ne'), or_false, + neg_eq_iff_eq_neg] at hk, + rw hk, + cases k, + { rw [int.cast_of_nat, complex.Gamma_neg_nat_eq_zero, zero_mul] }, + { rw [int.cast_neg_succ_of_nat, neg_neg, nat.cast_add, nat.cast_one, add_comm, sub_add_cancel', + complex.Gamma_neg_nat_eq_zero, mul_zero] } }, + refine tendsto_nhds_unique ((Gamma_seq_tendsto_Gamma z).mul (Gamma_seq_tendsto_Gamma $ 1 - z)) _, + have : ↑π / sin (↑π * z) = 1 * (π / sin (π * z)), by rw one_mul, rw this, + refine tendsto.congr' ((eventually_ne_at_top 0).mp + (eventually_of_forall (λ n hn, (Gamma_seq_mul z hn).symm))) (tendsto.mul _ _), + { convert tendsto_coe_nat_div_add_at_top (1 - z), ext1 n, rw add_sub_assoc }, + { have : ↑π / sin (↑π * z) = 1 / (sin (π * z) / π), by field_simp, rw this, + refine tendsto_const_nhds.div _ (div_ne_zero hs pi_ne), + rw [←tendsto_mul_iff_of_ne_zero tendsto_const_nhds pi_ne, div_mul_cancel _ pi_ne], + convert tendsto_euler_sin_prod z, + ext1 n, rw [mul_comm, ←mul_assoc] }, +end + +/-- The Gamma function does not vanish on `ℂ` (except at non-positive integers, where the function +is mathematically undefined and we set it to `0` by convention). -/ +theorem Gamma_ne_zero {s : ℂ} (hs : ∀ m : ℕ, s ≠ -m) : Gamma s ≠ 0 := +begin + by_cases h_im : s.im = 0, + { have : s = ↑s.re, + { conv_lhs { rw ←complex.re_add_im s }, rw [h_im, of_real_zero, zero_mul, add_zero] }, + rw [this, Gamma_of_real, of_real_ne_zero], + refine real.Gamma_ne_zero (λ n, _), + specialize hs n, + contrapose! hs, + rwa [this, ←of_real_nat_cast, ←of_real_neg, of_real_inj] }, + { have : sin (↑π * s) ≠ 0, + { rw complex.sin_ne_zero_iff, + intro k, + apply_fun im, + rw [of_real_mul_im, ←of_real_int_cast, ←of_real_mul, of_real_im], + exact mul_ne_zero real.pi_pos.ne' h_im }, + have A := div_ne_zero (of_real_ne_zero.mpr real.pi_pos.ne') this, + rw [←complex.Gamma_mul_Gamma_one_sub s, mul_ne_zero_iff] at A, + exact A.1 } +end + +lemma Gamma_eq_zero_iff (s : ℂ) : Gamma s = 0 ↔ ∃ m : ℕ, s = -m := +begin + split, + { contrapose!, exact Gamma_ne_zero }, + { rintro ⟨m, rfl⟩, exact Gamma_neg_nat_eq_zero m }, +end + +/-- A weaker, but easier-to-apply, version of `complex.Gamma_ne_zero`. -/ +lemma Gamma_ne_zero_of_re_pos {s : ℂ} (hs : 0 < re s) : Gamma s ≠ 0 := +begin + refine Gamma_ne_zero (λ m, _), + contrapose! hs, + simpa only [hs, neg_re, ←of_real_nat_cast, of_real_re, neg_nonpos] using nat.cast_nonneg _, +end + +end complex + +namespace real + +/-- The sequence with `n`-th term `n ^ s * n! / (s * (s + 1) * ... * (s + n))`, for real `s`. We +will show that this tends to `Γ(s)` as `n → ∞`. -/ +noncomputable def Gamma_seq (s : ℝ) (n : ℕ) := +(n : ℝ) ^ s * n! / ∏ (j : ℕ) in finset.range (n + 1), (s + j) + +/-- Euler's limit formula for the real Gamma function. -/ +lemma Gamma_seq_tendsto_Gamma (s : ℝ) : tendsto (Gamma_seq s) at_top (𝓝 $ Gamma s) := +begin + suffices : tendsto (coe ∘ Gamma_seq s : ℕ → ℂ) at_top (𝓝 $ complex.Gamma s), + from (complex.continuous_re.tendsto (complex.Gamma ↑s)).comp this, + convert complex.Gamma_seq_tendsto_Gamma s, + ext1 n, + dsimp only [Gamma_seq, function.comp_app, complex.Gamma_seq], + push_cast, + rw [complex.of_real_cpow n.cast_nonneg, complex.of_real_nat_cast] +end + +/-- Euler's reflection formula for the real Gamma function. -/ +lemma Gamma_mul_Gamma_one_sub (s : ℝ) : Gamma s * Gamma (1 - s) = π / sin (π * s) := +begin + simp_rw [←complex.of_real_inj, complex.of_real_div, complex.of_real_sin, + complex.of_real_mul, ←complex.Gamma_of_real, complex.of_real_sub, complex.of_real_one], + exact complex.Gamma_mul_Gamma_one_sub s +end + +end real + +end gamma_reflection + +section inv_gamma +open_locale real + +namespace complex +/-! ## The reciprocal Gamma function + +We show that the reciprocal Gamma function `1 / Γ(s)` is entire. These lemmas show that (in this +case at least) mathlib's conventions for division by zero do actually give a mathematically useful +answer! (These results are useful in the theory of zeta and L-functions.) -/ + +/-- A reformulation of the Gamma recurrence relation which is true for `s = 0` as well. -/ +lemma one_div_Gamma_eq_self_mul_one_div_Gamma_add_one (s : ℂ) : + (Gamma s)⁻¹ = s * (Gamma (s + 1))⁻¹ := +begin + rcases ne_or_eq s 0 with h | rfl, + { rw [Gamma_add_one s h, mul_inv, mul_inv_cancel_left₀ h] }, + { rw [zero_add, Gamma_zero, inv_zero, zero_mul] } +end + +/-- The reciprocal of the Gamma function is differentiable everywhere (including the points where +Gamma itself is not). -/ +lemma differentiable_one_div_Gamma : differentiable ℂ (λ s : ℂ, (Gamma s)⁻¹) := +begin + suffices : ∀ (n : ℕ), ∀ (s : ℂ) (hs : -s.re < n), differentiable_at ℂ (λ u : ℂ, (Gamma u)⁻¹) s, + from λ s, let ⟨n, h⟩ := exists_nat_gt (-s.re) in this n s h, + intro n, + induction n with m hm, + { intros s hs, + rw [nat.cast_zero, neg_lt_zero] at hs, + suffices : ∀ (m : ℕ), s ≠ -↑m, from (differentiable_at_Gamma _ this).inv (Gamma_ne_zero this), + contrapose! hs, + rcases hs with ⟨m, rfl⟩, + simpa only [neg_re, ←of_real_nat_cast, of_real_re, neg_nonpos] using nat.cast_nonneg m }, + { intros s hs, + rw funext one_div_Gamma_eq_self_mul_one_div_Gamma_add_one, + specialize hm (s + 1) (by rwa [add_re, one_re, neg_add', sub_lt_iff_lt_add, ←nat.cast_succ]), + refine differentiable_at_id.mul (hm.comp s _), + exact differentiable_at_id.add (differentiable_at_const _) } +end + +end complex + +end inv_gamma + +section doubling +/-! +## The doubling formula for Gamma + +We prove the doubling formula for arbitrary real or complex arguments, by analytic continuation from +the positive real case. (Knowing that `Γ⁻¹` is analytic everywhere makes this much simpler, since we +do not have to do any special-case handling for the poles of `Γ`.) +-/ + +namespace complex + +theorem Gamma_mul_Gamma_add_half (s : ℂ) : + Gamma s * Gamma (s + 1 / 2) = Gamma (2 * s) * 2 ^ (1 - 2 * s) * ↑(real.sqrt π) := +begin + suffices : (λ z, (Gamma z)⁻¹ * (Gamma (z + 1 / 2))⁻¹) = + (λ z, (Gamma (2 * z))⁻¹ * 2 ^ (2 * z - 1) / ↑(real.sqrt π)), + { convert congr_arg has_inv.inv (congr_fun this s) using 1, + { rw [mul_inv, inv_inv, inv_inv] }, + { rw [div_eq_mul_inv, mul_inv, mul_inv, inv_inv, inv_inv, ←cpow_neg, neg_sub] } }, + have h1 : analytic_on ℂ (λ z : ℂ, (Gamma z)⁻¹ * (Gamma (z + 1 / 2))⁻¹) univ, + { refine differentiable_on.analytic_on _ is_open_univ, + refine (differentiable_one_div_Gamma.mul _).differentiable_on, + exact differentiable_one_div_Gamma.comp (differentiable_id.add (differentiable_const _)) }, + have h2 : analytic_on ℂ (λ z, (Gamma (2 * z))⁻¹ * 2 ^ (2 * z - 1) / ↑(real.sqrt π)) univ, + { refine differentiable_on.analytic_on _ is_open_univ, + refine (differentiable.mul _ (differentiable_const _)).differentiable_on, + apply differentiable.mul, + { exact differentiable_one_div_Gamma.comp (differentiable_id'.const_mul _) }, + { refine λ t, differentiable_at.const_cpow _ (or.inl two_ne_zero), + refine differentiable_at.sub_const (differentiable_at_id.const_mul _) _ } }, + have h3 : tendsto (coe : ℝ → ℂ) (𝓝[≠] 1) (𝓝[≠] 1), + { rw tendsto_nhds_within_iff, split, + { exact tendsto_nhds_within_of_tendsto_nhds continuous_of_real.continuous_at }, + { exact eventually_nhds_within_iff.mpr (eventually_of_forall $ λ t ht, of_real_ne_one.mpr ht)}}, + refine analytic_on.eq_of_frequently_eq h1 h2 (h3.frequently _), + refine ((eventually.filter_mono nhds_within_le_nhds) _).frequently, + refine (eventually_gt_nhds zero_lt_one).mp (eventually_of_forall $ λ t ht, _), + rw [←mul_inv, Gamma_of_real, (by push_cast : (t : ℂ) + 1 / 2 = ↑(t + 1 / 2)), Gamma_of_real, + ←of_real_mul, Gamma_mul_Gamma_add_half_of_pos ht, of_real_mul, of_real_mul, ←Gamma_of_real, + mul_inv, mul_inv, (by push_cast : 2 * (t : ℂ) = ↑(2 * t)), Gamma_of_real, + of_real_cpow zero_le_two, of_real_bit0, of_real_one, ←cpow_neg, of_real_sub, of_real_one, + neg_sub, ←div_eq_mul_inv] +end + +end complex + +namespace real +open complex + +lemma Gamma_mul_Gamma_add_half (s : ℝ) : + Gamma s * Gamma (s + 1 / 2) = Gamma (2 * s) * 2 ^ (1 - 2 * s) * sqrt π := +begin + rw [←of_real_inj], + simpa only [←Gamma_of_real, of_real_cpow zero_le_two, of_real_mul, of_real_add, of_real_div, + of_real_bit0, of_real_one, of_real_sub] using complex.Gamma_mul_Gamma_add_half ↑s +end + +end real + +end doubling diff --git a/src/analysis/special_functions/gamma/bohr_mollerup.lean b/src/analysis/special_functions/gamma/bohr_mollerup.lean new file mode 100644 index 0000000000000..3a6b66bd0659d --- /dev/null +++ b/src/analysis/special_functions/gamma/bohr_mollerup.lean @@ -0,0 +1,518 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ +import analysis.special_functions.gamma.basic +import analysis.special_functions.gaussian + +/-! # Convexity properties of the Gamma function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we prove that `Gamma` and `log ∘ Gamma` are convex functions on the positive real +line. We then prove the Bohr-Mollerup theorem, which characterises `Gamma` as the *unique* +positive-real-valued, log-convex function on the positive reals satisfying `f (x + 1) = x f x` and +`f 1 = 1`. + +The proof of the Bohr-Mollerup theorem is bound up with the proof of (a weak form of) the Euler +limit formula, `real.bohr_mollerup.tendsto_log_gamma_seq`, stating that for positive +real `x` the sequence `x * log n + log n! - ∑ (m : ℕ) in finset.range (n + 1), log (x + m)` +tends to `log Γ(x)` as `n → ∞`. We prove that any function satisfying the hypotheses of the +Bohr-Mollerup theorem must agree with the limit in the Euler limit formula, so there is at most one +such function; then we show that `Γ` satisfies these conditions. + +Since most of the auxiliary lemmas for the Bohr-Mollerup theorem are of no relevance outside the +context of this proof, we place them in a separate namespace `real.bohr_mollerup` to avoid clutter. +(This includes the logarithmic form of the Euler limit formula, since later we will prove a more +general form of the Euler limit formula valid for any real or complex `x`; see +`real.Gamma_seq_tendsto_Gamma` and `complex.Gamma_seq_tendsto_Gamma` in the file +`analysis.special_functions.gamma.beta`.) + +As an application of the Bohr-Mollerup theorem we prove the Legendre doubling formula for the +Gamma function for real positive `s` (which will be upgraded to a proof for all complex `s` in a +later file). + +TODO: This argument can be extended to prove the general `k`-multiplication formula (at least up +to a constant, and it should be possible to deduce the value of this constant using Stirling's +formula). +-/ + +noncomputable theory +open filter set measure_theory +open_locale nat ennreal topology big_operators real + +section convexity + +-- Porting note: move the following lemmas to `Analysis.Convex.Function` +variables {𝕜 E β : Type*} {s : set E} {f g : E → β} + [ordered_semiring 𝕜] [has_smul 𝕜 E] [add_comm_monoid E] [ordered_add_comm_monoid β] + +lemma convex_on.congr [has_smul 𝕜 β] (hf : convex_on 𝕜 s f) (hfg : eq_on f g s) : + convex_on 𝕜 s g := +⟨hf.1, λ x hx y hy a b ha hb hab, + by simpa only [←hfg hx, ←hfg hy, ←hfg (hf.1 hx hy ha hb hab)] using hf.2 hx hy ha hb hab⟩ + +lemma concave_on.congr [has_smul 𝕜 β](hf : concave_on 𝕜 s f) (hfg : eq_on f g s) : + concave_on 𝕜 s g := +⟨hf.1, λ x hx y hy a b ha hb hab, + by simpa only [←hfg hx, ←hfg hy, ←hfg (hf.1 hx hy ha hb hab)] using hf.2 hx hy ha hb hab⟩ + +lemma strict_convex_on.congr [has_smul 𝕜 β] (hf : strict_convex_on 𝕜 s f) (hfg : eq_on f g s) : + strict_convex_on 𝕜 s g := +⟨hf.1, λ x hx y hy hxy a b ha hb hab, by simpa only + [←hfg hx, ←hfg hy, ←hfg (hf.1 hx hy ha.le hb.le hab)] using hf.2 hx hy hxy ha hb hab⟩ + +lemma strict_concave_on.congr [has_smul 𝕜 β] (hf : strict_concave_on 𝕜 s f) (hfg : eq_on f g s) : + strict_concave_on 𝕜 s g := +⟨hf.1, λ x hx y hy hxy a b ha hb hab, by simpa only + [←hfg hx, ←hfg hy, ←hfg (hf.1 hx hy ha.le hb.le hab)] using hf.2 hx hy hxy ha hb hab⟩ + +lemma convex_on.add_const [module 𝕜 β] (hf : convex_on 𝕜 s f) (b : β) : + convex_on 𝕜 s (f + (λ _, b)) := +hf.add (convex_on_const _ hf.1) + +lemma concave_on.add_const [module 𝕜 β] (hf : concave_on 𝕜 s f) (b : β) : + concave_on 𝕜 s (f + (λ _, b)) := +hf.add (concave_on_const _ hf.1) + +lemma strict_convex_on.add_const {γ : Type*} {f : E → γ} + [ordered_cancel_add_comm_monoid γ] [module 𝕜 γ] (hf : strict_convex_on 𝕜 s f) (b : γ) : + strict_convex_on 𝕜 s (f + (λ _, b)) := +hf.add_convex_on (convex_on_const _ hf.1) + +lemma strict_concave_on.add_const {γ : Type*} {f : E → γ} + [ordered_cancel_add_comm_monoid γ] [module 𝕜 γ] (hf : strict_concave_on 𝕜 s f) (b : γ) : + strict_concave_on 𝕜 s (f + (λ _, b)) := +hf.add_concave_on (concave_on_const _ hf.1) + +end convexity + +namespace real + +section convexity + +/-- Log-convexity of the Gamma function on the positive reals (stated in multiplicative form), +proved using the Hölder inequality applied to Euler's integral. -/ +lemma Gamma_mul_add_mul_le_rpow_Gamma_mul_rpow_Gamma {s t a b : ℝ} + (hs : 0 < s) (ht : 0 < t) (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) : + Gamma (a * s + b * t) ≤ Gamma s ^ a * Gamma t ^ b := +begin + -- We will apply Hölder's inequality, for the conjugate exponents `p = 1 / a` + -- and `q = 1 / b`, to the functions `f a s` and `f b t`, where `f` is as follows: + let f : ℝ → ℝ → ℝ → ℝ := λ c u x, exp (-c * x) * x ^ (c * (u - 1)), + have e : is_conjugate_exponent (1 / a) (1 / b) := real.is_conjugate_exponent_one_div ha hb hab, + have hab' : b = 1 - a := by linarith, + have hst : 0 < a * s + b * t := add_pos (mul_pos ha hs) (mul_pos hb ht), + -- some properties of f: + have posf : ∀ (c u x : ℝ), x ∈ Ioi (0:ℝ) → 0 ≤ f c u x := + λ c u x hx, mul_nonneg (exp_pos _).le (rpow_pos_of_pos hx _).le, + have posf' : ∀ (c u : ℝ), ∀ᵐ (x : ℝ) ∂volume.restrict (Ioi 0), 0 ≤ f c u x := + λ c u, (ae_restrict_iff' measurable_set_Ioi).mpr (ae_of_all _ (posf c u)), + have fpow : ∀ {c x : ℝ} (hc : 0 < c) (u : ℝ) (hx : 0 < x), + exp (-x) * x ^ (u - 1) = f c u x ^ (1 / c), + { intros c x hc u hx, + dsimp only [f], + rw [mul_rpow (exp_pos _).le ((rpow_nonneg_of_nonneg hx.le) _), ←exp_mul, ←rpow_mul hx.le], + congr' 2; + { field_simp [hc.ne'], ring } }, + -- show `f c u` is in `ℒp` for `p = 1/c`: + have f_mem_Lp : ∀ {c u : ℝ} (hc : 0 < c) (hu : 0 < u), + mem_ℒp (f c u) (ennreal.of_real (1 / c)) (volume.restrict (Ioi 0)), + { intros c u hc hu, + have A : ennreal.of_real (1 / c) ≠ 0, + by rwa [ne.def, ennreal.of_real_eq_zero, not_le, one_div_pos], + have B : ennreal.of_real (1 / c) ≠ ∞, from ennreal.of_real_ne_top, + rw [←mem_ℒp_norm_rpow_iff _ A B, ennreal.to_real_of_real (one_div_nonneg.mpr hc.le), + ennreal.div_self A B, mem_ℒp_one_iff_integrable], + { apply integrable.congr (Gamma_integral_convergent hu), + refine eventually_eq_of_mem (self_mem_ae_restrict measurable_set_Ioi) (λ x hx, _), + dsimp only, + rw fpow hc u hx, + congr' 1, + exact (norm_of_nonneg (posf _ _ x hx)).symm }, + { refine continuous_on.ae_strongly_measurable _ measurable_set_Ioi, + refine (continuous.continuous_on _).mul (continuous_at.continuous_on (λ x hx, _)), + { exact continuous_exp.comp (continuous_const.mul continuous_id'), }, + { exact continuous_at_rpow_const _ _ (or.inl (ne_of_lt hx).symm), } } }, + -- now apply Hölder: + rw [Gamma_eq_integral hs, Gamma_eq_integral ht, Gamma_eq_integral hst], + convert measure_theory.integral_mul_le_Lp_mul_Lq_of_nonneg e (posf' a s) (posf' b t) + (f_mem_Lp ha hs) (f_mem_Lp hb ht) using 1, + { refine set_integral_congr measurable_set_Ioi (λ x hx, _), + dsimp only [f], + have A : exp (-x) = exp (-a * x) * exp (-b * x), + { rw [←exp_add, ←add_mul, ←neg_add, hab, neg_one_mul] }, + have B : x ^ (a * s + b * t - 1) = (x ^ (a * (s - 1))) * (x ^ (b * (t - 1))), + { rw [←rpow_add hx, hab'], congr' 1, ring }, + rw [A, B], + ring }, + { rw [one_div_one_div, one_div_one_div], + congr' 2; + exact set_integral_congr measurable_set_Ioi (λ x hx, fpow (by assumption) _ hx) }, +end + +lemma convex_on_log_Gamma : convex_on ℝ (Ioi 0) (log ∘ Gamma) := +begin + refine convex_on_iff_forall_pos.mpr ⟨convex_Ioi _, λ x hx y hy a b ha hb hab, _⟩, + have : b = 1 - a := by linarith, subst this, + simp_rw [function.comp_app, smul_eq_mul], + rw [←log_rpow (Gamma_pos_of_pos hy), ←log_rpow (Gamma_pos_of_pos hx), + ←log_mul + ((rpow_pos_of_pos (Gamma_pos_of_pos hx) _).ne') (rpow_pos_of_pos (Gamma_pos_of_pos hy) _).ne', + log_le_log + (Gamma_pos_of_pos (add_pos (mul_pos ha hx) (mul_pos hb hy))) + (mul_pos + (rpow_pos_of_pos (Gamma_pos_of_pos hx) _) (rpow_pos_of_pos (Gamma_pos_of_pos hy) _))], + exact Gamma_mul_add_mul_le_rpow_Gamma_mul_rpow_Gamma hx hy ha hb hab, +end + +lemma convex_on_Gamma : convex_on ℝ (Ioi 0) Gamma := +begin + refine ((convex_on_exp.subset (subset_univ _) _).comp convex_on_log_Gamma + (exp_monotone.monotone_on _)).congr (λ x hx, exp_log (Gamma_pos_of_pos hx)), + rw convex_iff_is_preconnected, + refine is_preconnected_Ioi.image _ (λ x hx, continuous_at.continuous_within_at _), + refine (differentiable_at_Gamma (λ m, _)).continuous_at.log (Gamma_pos_of_pos hx).ne', + exact (neg_lt_iff_pos_add.mpr (add_pos_of_pos_of_nonneg hx (nat.cast_nonneg m))).ne', +end + +end convexity + +section bohr_mollerup + +namespace bohr_mollerup + +/-- The function `n ↦ x log n + log n! - (log x + ... + log (x + n))`, which we will show tends to +`log (Gamma x)` as `n → ∞`. -/ +def log_gamma_seq (x : ℝ) (n : ℕ) : ℝ := +x * log n + log n! - ∑ (m : ℕ) in finset.range (n + 1), log (x + m) + +variables {f : ℝ → ℝ} {x : ℝ} {n : ℕ} + +lemma f_nat_eq (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) (hn : n ≠ 0) : + f n = f 1 + log (n - 1)! := +begin + refine nat.le_induction (by simp) (λ m hm IH, _) n (nat.one_le_iff_ne_zero.2 hn), + have A : 0 < (m : ℝ), from nat.cast_pos.2 hm, + simp only [hf_feq A, nat.cast_add, algebra_map.coe_one, nat.add_succ_sub_one, add_zero], + rw [IH, add_assoc, ← log_mul (nat.cast_ne_zero.mpr (nat.factorial_ne_zero _)) A.ne', + ← nat.cast_mul], + conv_rhs { rw [← nat.succ_pred_eq_of_pos hm, nat.factorial_succ, mul_comm] }, + congr, + exact (nat.succ_pred_eq_of_pos hm).symm +end + +lemma f_add_nat_eq (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) (hx : 0 < x) (n : ℕ) : + f (x + n) = f x + ∑ (m : ℕ) in finset.range n, log (x + m) := +begin + induction n with n hn, + { simp }, + { have : x + n.succ = (x + n) + 1, + { push_cast, ring }, + rw [this, hf_feq, hn], + rw [finset.range_succ, finset.sum_insert (finset.not_mem_range_self)], + abel, + linarith [(nat.cast_nonneg n : 0 ≤ (n:ℝ))] }, +end + +/-- Linear upper bound for `f (x + n)` on unit interval -/ +lemma f_add_nat_le + (hf_conv : convex_on ℝ (Ioi 0) f) (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) + (hn : n ≠ 0) (hx : 0 < x) (hx' : x ≤ 1) : + f (n + x) ≤ f n + x * log n := +begin + have hn': 0 < (n:ℝ) := nat.cast_pos.mpr (nat.pos_of_ne_zero hn), + have : f n + x * log n = (1 - x) * f n + x * f (n + 1), + { rw [hf_feq hn'], ring, }, + rw [this, (by ring : (n:ℝ) + x = (1 - x) * n + x * (n + 1))], + simpa only [smul_eq_mul] using hf_conv.2 hn' (by linarith : 0 < (n + 1 : ℝ)) + (by linarith : 0 ≤ 1 - x) hx.le (by linarith), +end + +/-- Linear lower bound for `f (x + n)` on unit interval -/ +lemma f_add_nat_ge + (hf_conv : convex_on ℝ (Ioi 0) f) (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) + (hn : 2 ≤ n) (hx : 0 < x) : + f n + x * log (n - 1) ≤ f (n + x) := +begin + have npos : 0 < (n:ℝ) - 1, + { rw [←nat.cast_one, sub_pos, nat.cast_lt], linarith, }, + have c := (convex_on_iff_slope_mono_adjacent.mp $ hf_conv).2 + npos (by linarith : 0 < (n:ℝ) + x) (by linarith : (n:ℝ) - 1 < (n:ℝ)) (by linarith), + rw [add_sub_cancel', sub_sub_cancel, div_one] at c, + have : f (↑n - 1) = f n - log (↑n - 1), + { nth_rewrite_rhs 0 (by ring : (n:ℝ) = (↑n - 1) + 1), + rw [hf_feq npos, add_sub_cancel] }, + rwa [this, le_div_iff hx, sub_sub_cancel, le_sub_iff_add_le, mul_comm _ x, add_comm] at c, +end + +lemma log_gamma_seq_add_one (x : ℝ) (n : ℕ) : + log_gamma_seq (x + 1) n = log_gamma_seq x (n + 1) + log x - (x + 1) * (log (n + 1) - log n) := +begin + dsimp only [nat.factorial_succ, log_gamma_seq], + conv_rhs { rw [finset.sum_range_succ', nat.cast_zero, add_zero], }, + rw [nat.cast_mul, log_mul], rotate, + { rw nat.cast_ne_zero, exact nat.succ_ne_zero n }, + { rw nat.cast_ne_zero, exact nat.factorial_ne_zero n, }, + have : ∑ (m : ℕ) in finset.range (n + 1), log (x + 1 + ↑m) = + ∑ (k : ℕ) in finset.range (n + 1), log (x + ↑(k + 1)), + { refine finset.sum_congr (by refl) (λ m hm, _), + congr' 1, + push_cast, + abel }, + rw [←this, nat.cast_add_one n], + ring, +end + +lemma le_log_gamma_seq + (hf_conv : convex_on ℝ (Ioi 0) f) (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) + (hx : 0 < x) (hx' : x ≤ 1) (n : ℕ) : + f x ≤ f 1 + x * log (n + 1) - x * log n + log_gamma_seq x n := +begin + rw [log_gamma_seq, ←add_sub_assoc, le_sub_iff_add_le, ←f_add_nat_eq @hf_feq hx, add_comm x], + refine (f_add_nat_le hf_conv @hf_feq (nat.add_one_ne_zero n) hx hx').trans (le_of_eq _), + rw [f_nat_eq @hf_feq (by linarith : n + 1 ≠ 0), nat.add_sub_cancel, nat.cast_add_one], + ring, +end + +lemma ge_log_gamma_seq + (hf_conv : convex_on ℝ (Ioi 0) f) (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) + (hx : 0 < x) (hn : n ≠ 0) : + f 1 + log_gamma_seq x n ≤ f x := +begin + dsimp [log_gamma_seq], + rw [←add_sub_assoc, sub_le_iff_le_add, ←f_add_nat_eq @hf_feq hx, add_comm x _], + refine le_trans (le_of_eq _) (f_add_nat_ge hf_conv @hf_feq _ hx), + { rw [f_nat_eq @hf_feq, nat.add_sub_cancel, nat.cast_add_one, add_sub_cancel], + { ring }, + { exact nat.succ_ne_zero _} }, + { apply nat.succ_le_succ, + linarith [nat.pos_of_ne_zero hn] }, +end + +lemma tendsto_log_gamma_seq_of_le_one + (hf_conv : convex_on ℝ (Ioi 0) f) (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) + (hx : 0 < x) (hx' : x ≤ 1) : + tendsto (log_gamma_seq x) at_top (𝓝 $ f x - f 1) := +begin + refine tendsto_of_tendsto_of_tendsto_of_le_of_le' _ tendsto_const_nhds _ _, + show ∀ᶠ (n : ℕ) in at_top, log_gamma_seq x n ≤ f x - f 1, + { refine eventually.mp (eventually_ne_at_top 0) (eventually_of_forall (λ n hn, _)), + exact le_sub_iff_add_le'.mpr (ge_log_gamma_seq hf_conv @hf_feq hx hn) }, + show ∀ᶠ (n : ℕ) in at_top, f x - f 1 - x * (log (n + 1) - log n) ≤ log_gamma_seq x n, + { refine eventually_of_forall (λ n, _), + rw [sub_le_iff_le_add', sub_le_iff_le_add'], + convert le_log_gamma_seq hf_conv @hf_feq hx hx' n using 1, + ring }, + { have : f x - f 1 = (f x - f 1) - x * 0 := by ring, + nth_rewrite 0 this, + exact tendsto.sub tendsto_const_nhds (tendsto_log_nat_add_one_sub_log.const_mul _), } +end + +lemma tendsto_log_gamma_seq + (hf_conv : convex_on ℝ (Ioi 0) f) (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = f y + log y) + (hx : 0 < x) : + tendsto (log_gamma_seq x) at_top (𝓝 $ f x - f 1) := +begin + suffices : ∀ (m : ℕ), ↑m < x → x ≤ m + 1 → + tendsto (log_gamma_seq x) at_top (𝓝 $ f x - f 1), + { refine this (⌈x - 1⌉₊) _ _, + { rcases lt_or_le x 1, + { rwa [nat.ceil_eq_zero.mpr (by linarith : x - 1 ≤ 0), nat.cast_zero] }, + { convert nat.ceil_lt_add_one (by linarith : 0 ≤ x - 1), + abel } }, + { rw ←sub_le_iff_le_add, exact nat.le_ceil _}, }, + intro m, + induction m with m hm generalizing x, + { rw [nat.cast_zero, zero_add], + exact λ _ hx', tendsto_log_gamma_seq_of_le_one hf_conv @hf_feq hx hx' }, + { intros hy hy', + rw [nat.cast_succ, ←sub_le_iff_le_add] at hy', + rw [nat.cast_succ, ←lt_sub_iff_add_lt] at hy, + specialize hm ((nat.cast_nonneg _).trans_lt hy) hy hy', + -- now massage gauss_product n (x - 1) into gauss_product (n - 1) x + have : ∀ᶠ (n:ℕ) in at_top, log_gamma_seq (x - 1) n = log_gamma_seq x (n - 1) + + x * (log (↑(n - 1) + 1) - log ↑(n - 1)) - log (x - 1), + { refine eventually.mp (eventually_ge_at_top 1) (eventually_of_forall (λ n hn, _)), + have := log_gamma_seq_add_one (x - 1) (n - 1), + rw [sub_add_cancel, nat.sub_add_cancel hn] at this, + rw this, + ring }, + replace hm := ((tendsto.congr' this hm).add + (tendsto_const_nhds : tendsto (λ _, log (x - 1)) _ _)).comp (tendsto_add_at_top_nat 1), + have : + (λ (x_1 : ℕ), (λ (n : ℕ), log_gamma_seq x (n - 1) + + x * (log (↑(n - 1) + 1) - log ↑(n - 1)) - log (x - 1)) x_1 + + (λ (b : ℕ), log (x - 1)) x_1) ∘ (λ (a : ℕ), a + 1) = + λ n, log_gamma_seq x n + x * (log (↑n + 1) - log ↑n), + { ext1 n, + dsimp only [function.comp_app], + rw [sub_add_cancel, nat.add_sub_cancel] }, + rw this at hm, + convert hm.sub (tendsto_log_nat_add_one_sub_log.const_mul x) using 2, + { ext1 n, ring }, + { have := hf_feq ((nat.cast_nonneg m).trans_lt hy), + rw sub_add_cancel at this, + rw this, + ring } }, +end + +lemma tendsto_log_Gamma {x : ℝ} (hx : 0 < x) : + tendsto (log_gamma_seq x) at_top (𝓝 $ log (Gamma x)) := +begin + have : log (Gamma x) = (log ∘ Gamma) x - (log ∘ Gamma) 1, + { simp_rw [function.comp_app, Gamma_one, log_one, sub_zero] }, + rw this, + refine bohr_mollerup.tendsto_log_gamma_seq convex_on_log_Gamma (λ y hy, _) hx, + rw [function.comp_app, Gamma_add_one hy.ne', log_mul hy.ne' (Gamma_pos_of_pos hy).ne', add_comm], +end + +end bohr_mollerup -- (namespace) + +/-- The **Bohr-Mollerup theorem**: the Gamma function is the *unique* log-convex, positive-valued +function on the positive reals which satisfies `f 1 = 1` and `f (x + 1) = x * f x` for all `x`. -/ +lemma eq_Gamma_of_log_convex {f : ℝ → ℝ} + (hf_conv : convex_on ℝ (Ioi 0) (log ∘ f)) + (hf_feq : ∀ {y:ℝ}, 0 < y → f (y + 1) = y * f y) + (hf_pos : ∀ {y:ℝ}, 0 < y → 0 < f y) + (hf_one : f 1 = 1) : + eq_on f Gamma (Ioi (0:ℝ)) := +begin + suffices : eq_on (log ∘ f) (log ∘ Gamma) (Ioi (0:ℝ)), + from λ x hx, log_inj_on_pos (hf_pos hx) (Gamma_pos_of_pos hx) (this hx), + intros x hx, + have e1 := bohr_mollerup.tendsto_log_gamma_seq hf_conv _ hx, + { rw [function.comp_app log f 1, hf_one, log_one, sub_zero] at e1, + exact tendsto_nhds_unique e1 (bohr_mollerup.tendsto_log_Gamma hx) }, + { intros y hy, + rw [function.comp_app, hf_feq hy, log_mul hy.ne' (hf_pos hy).ne'], + ring } +end + +end bohr_mollerup -- (section) + +section strict_mono + +lemma Gamma_two : Gamma 2 = 1 := by simpa using Gamma_nat_eq_factorial 1 + +lemma Gamma_three_div_two_lt_one : Gamma (3 / 2) < 1 := +begin + -- This can also be proved using the closed-form evaluation of `Gamma (1 / 2)` in + -- `analysis.special_functions.gaussian`, but we give a self-contained proof using log-convexity + -- to avoid unnecessary imports. + have A : (0:ℝ) < 3/2, by norm_num, + have := bohr_mollerup.f_add_nat_le convex_on_log_Gamma (λ y hy, _) two_ne_zero one_half_pos + (by norm_num : 1/2 ≤ (1:ℝ)), + swap, { rw [function.comp_app, Gamma_add_one hy.ne', log_mul hy.ne' (Gamma_pos_of_pos hy).ne', + add_comm] }, + rw [function.comp_app, function.comp_app, nat.cast_two, Gamma_two, log_one, zero_add, + (by norm_num : (2:ℝ) + 1/2 = 3/2 + 1), Gamma_add_one A.ne', + log_mul A.ne' (Gamma_pos_of_pos A).ne', ←le_sub_iff_add_le', + log_le_iff_le_exp (Gamma_pos_of_pos A)] at this, + refine this.trans_lt (exp_lt_one_iff.mpr _), + rw [mul_comm, ←mul_div_assoc, div_sub' _ _ (2:ℝ) two_ne_zero], + refine div_neg_of_neg_of_pos _ two_pos, + rw [sub_neg, mul_one, ←nat.cast_two, ←log_pow, ←exp_lt_exp, nat.cast_two, exp_log two_pos, + exp_log]; + norm_num, +end + +lemma Gamma_strict_mono_on_Ici : strict_mono_on Gamma (Ici 2) := +begin + convert convex_on_Gamma.strict_mono_of_lt (by norm_num : (0:ℝ) < 3/2) + (by norm_num : (3/2 : ℝ) < 2) (Gamma_two.symm ▸ Gamma_three_div_two_lt_one), + symmetry, + rw inter_eq_right_iff_subset, + exact λ x hx, two_pos.trans_le hx, +end + +end strict_mono + +section doubling + +/-! +## The Gamma doubling formula + +As a fun application of the Bohr-Mollerup theorem, we prove the Gamma-function doubling formula +(for positive real `s`). The idea is that `2 ^ s * Gamma (s / 2) * Gamma (s / 2 + 1 / 2)` is +log-convex and satisfies the Gamma functional equation, so it must actually be a constant +multiple of `Gamma`, and we can compute the constant by specialising at `s = 1`. -/ + +/-- Auxiliary definition for the doubling formula (we'll show this is equal to `Gamma s`) -/ +def doubling_Gamma (s : ℝ) : ℝ := Gamma (s / 2) * Gamma (s / 2 + 1 / 2) * 2 ^ (s - 1) / sqrt π + +lemma doubling_Gamma_add_one (s : ℝ) (hs : s ≠ 0) : + doubling_Gamma (s + 1) = s * doubling_Gamma s := +begin + rw [doubling_Gamma, doubling_Gamma, (by abel : s + 1 - 1 = s - 1 + 1), add_div, add_assoc, + add_halves (1 : ℝ), Gamma_add_one (div_ne_zero hs two_ne_zero), rpow_add two_pos, rpow_one], + ring, +end + +lemma doubling_Gamma_one : doubling_Gamma 1 = 1 := +by simp_rw [doubling_Gamma, Gamma_one_half_eq, add_halves (1 : ℝ), sub_self, Gamma_one, mul_one, + rpow_zero, mul_one, div_self (sqrt_ne_zero'.mpr pi_pos)] + +lemma log_doubling_Gamma_eq : + eq_on (log ∘ doubling_Gamma) (λ s, log (Gamma (s / 2)) + log (Gamma (s / 2 + 1 / 2)) + + s * log 2 - log (2 * sqrt π)) (Ioi 0) := +begin + intros s hs, + have h1 : sqrt π ≠ 0, from sqrt_ne_zero'.mpr pi_pos, + have h2 : Gamma (s / 2) ≠ 0, from (Gamma_pos_of_pos $ div_pos hs two_pos).ne', + have h3 : Gamma (s / 2 + 1 / 2) ≠ 0, + from (Gamma_pos_of_pos $ add_pos (div_pos hs two_pos) one_half_pos).ne', + have h4 : (2 : ℝ) ^ (s - 1) ≠ 0, from (rpow_pos_of_pos two_pos _).ne', + rw [function.comp_app, doubling_Gamma, log_div (mul_ne_zero (mul_ne_zero h2 h3) h4) h1, + log_mul (mul_ne_zero h2 h3) h4, log_mul h2 h3, log_rpow two_pos, log_mul two_ne_zero h1], + ring_nf, +end + +lemma doubling_Gamma_log_convex_Ioi : convex_on ℝ (Ioi (0:ℝ)) (log ∘ doubling_Gamma) := +begin + refine (((convex_on.add _ _).add _).add_const _).congr log_doubling_Gamma_eq.symm, + { convert convex_on_log_Gamma.comp_affine_map + (distrib_mul_action.to_linear_map ℝ ℝ (1 / 2 : ℝ)).to_affine_map, + { simpa only [zero_div] using (preimage_const_mul_Ioi (0 : ℝ) one_half_pos).symm, }, + { ext1 x, + change log (Gamma (x / 2)) = log (Gamma ((1 / 2 : ℝ) • x)), + rw [smul_eq_mul, mul_comm, mul_one_div] } }, + { refine convex_on.subset _ (Ioi_subset_Ioi $ neg_one_lt_zero.le) (convex_Ioi _), + convert convex_on_log_Gamma.comp_affine_map ((distrib_mul_action.to_linear_map ℝ ℝ + (1 / 2 : ℝ)).to_affine_map + affine_map.const _ _ (1 / 2 : ℝ)), + { change Ioi (-1 : ℝ) = ((λ x : ℝ, x + 1 / 2) ∘ (λ x : ℝ, (1 / 2 : ℝ) * x)) ⁻¹' (Ioi 0), + rw [preimage_comp, preimage_add_const_Ioi, zero_sub, preimage_const_mul_Ioi (_ : ℝ) + one_half_pos, neg_div, div_self (@one_half_pos ℝ _).ne'] }, + { ext1 x, + change log (Gamma (x / 2 + 1 / 2)) = log (Gamma ((1 / 2 : ℝ) • x + 1 / 2)), + rw [smul_eq_mul, mul_comm, mul_one_div] } }, + { simpa only [mul_comm _ (log _)] + using (convex_on_id (convex_Ioi (0 : ℝ))).smul (log_pos one_lt_two).le } +end + +lemma doubling_Gamma_eq_Gamma {s : ℝ} (hs : 0 < s) : doubling_Gamma s = Gamma s := +begin + refine eq_Gamma_of_log_convex doubling_Gamma_log_convex_Ioi + (λ y hy, doubling_Gamma_add_one y hy.ne') (λ y hy, _) doubling_Gamma_one hs, + apply_rules [mul_pos, Gamma_pos_of_pos, add_pos, inv_pos_of_pos, + rpow_pos_of_pos, two_pos, one_pos, sqrt_pos_of_pos pi_pos] +end + +/-- Legendre's doubling formula for the Gamma function, for positive real arguments. Note that +we shall later prove this for all `s` as `real.Gamma_mul_Gamma_add_half` (superseding this result) +but this result is needed as an intermediate step. -/ +lemma Gamma_mul_Gamma_add_half_of_pos {s : ℝ} (hs : 0 < s) : + Gamma s * Gamma (s + 1 / 2) = Gamma (2 * s) * 2 ^ (1 - 2 * s) * sqrt π := +begin + rw [←(doubling_Gamma_eq_Gamma (mul_pos two_pos hs)), + doubling_Gamma, mul_div_cancel_left _ (two_ne_zero' ℝ), + (by abel : 1 - 2 * s = -(2 * s - 1)), rpow_neg zero_le_two], + field_simp [(sqrt_pos_of_pos pi_pos).ne', (rpow_pos_of_pos two_pos (2 * s - 1)).ne'], + ring, +end + +end doubling + +end real diff --git a/src/analysis/special_functions/gaussian.lean b/src/analysis/special_functions/gaussian.lean new file mode 100644 index 0000000000000..7705bdc538282 --- /dev/null +++ b/src/analysis/special_functions/gaussian.lean @@ -0,0 +1,607 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ + +import analysis.special_functions.gamma.basic +import analysis.special_functions.polar_coord +import analysis.convex.complex +import analysis.complex.cauchy_integral +import analysis.fourier.poisson_summation + +/-! +# Gaussian integral + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We prove various versions of the formula for the Gaussian integral: +* `integral_gaussian`: for real `b` we have `∫ x:ℝ, exp (-b * x^2) = sqrt (π / b)`. +* `integral_gaussian_complex`: for complex `b` with `0 < re b` we have + `∫ x:ℝ, exp (-b * x^2) = (π / b) ^ (1 / 2)`. +* `integral_gaussian_Ioi` and `integral_gaussian_complex_Ioi`: variants for integrals over `Ioi 0`. +* `complex.Gamma_one_half_eq`: the formula `Γ (1 / 2) = √π`. + +We also prove, more generally, that the Fourier transform of the Gaussian is another Gaussian: + +* `integral_cexp_neg_mul_sq_add_const`: for all complex `b` and `c` with `0 < re b` we have + `∫ (x : ℝ), exp (-b * (x + c) ^ 2) = (π / b) ^ (1 / 2)`. +* `fourier_transform_gaussian`: for all complex `b` and `t` with `0 < re b`, we have + `∫ x:ℝ, exp (I * t * x) * exp (-b * x^2) = (π / b) ^ (1 / 2) * exp (-t ^ 2 / (4 * b))`. +* `fourier_transform_gaussian_pi`: a variant with `b` and `t` scaled to give a more symmetric + statement, and formulated in terms of the Fourier transform operator `𝓕`. + +As an application, in `real.tsum_exp_neg_mul_int_sq` and `complex.tsum_exp_neg_mul_int_sq`, we use +Poisson summation to prove the identity +`∑' (n : ℤ), exp (-π * a * n ^ 2) = 1 / a ^ (1 / 2) * ∑' (n : ℤ), exp (-π / a * n ^ 2)` +for positive real `a`, or complex `a` with positive real part. (See also +`number_theory.modular_forms.jacobi_theta`.) +-/ + +noncomputable theory + +open real set measure_theory filter asymptotics +open_locale real topology fourier_transform + +open complex (hiding exp continuous_exp abs_of_nonneg sq_abs) + +notation `cexp` := complex.exp +notation `rexp` := real.exp + +lemma exp_neg_mul_sq_is_o_exp_neg {b : ℝ} (hb : 0 < b) : + (λ x:ℝ, exp (-b * x^2)) =o[at_top] (λ x:ℝ, exp (-x)) := +begin + have A : (λ (x : ℝ), -x - -b * x ^ 2) = (λ x, x * (b * x + (- 1))), by { ext x, ring }, + rw [is_o_exp_comp_exp_comp, A], + apply tendsto.at_top_mul_at_top tendsto_id, + apply tendsto_at_top_add_const_right at_top (-1 : ℝ), + exact tendsto.const_mul_at_top hb tendsto_id, +end + +lemma rpow_mul_exp_neg_mul_sq_is_o_exp_neg {b : ℝ} (hb : 0 < b) (s : ℝ) : + (λ x:ℝ, x ^ s * exp (-b * x^2)) =o[at_top] (λ x:ℝ, exp (-(1/2) * x)) := +begin + apply ((is_O_refl (λ x:ℝ, x ^ s) at_top).mul_is_o (exp_neg_mul_sq_is_o_exp_neg hb)).trans, + convert Gamma_integrand_is_o s, + simp_rw [mul_comm], +end + +lemma integrable_on_rpow_mul_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) {s : ℝ} (hs : -1 < s) : + integrable_on (λ x:ℝ, x ^ s * exp (-b * x^2)) (Ioi 0) := +begin + rw [← Ioc_union_Ioi_eq_Ioi (zero_le_one : (0 : ℝ) ≤ 1), integrable_on_union], + split, + { rw [←integrable_on_Icc_iff_integrable_on_Ioc], + refine integrable_on.mul_continuous_on _ _ is_compact_Icc, + { refine (interval_integrable_iff_integrable_Icc_of_le zero_le_one).mp _, + exact interval_integral.interval_integrable_rpow' hs }, + { exact (continuous_exp.comp (continuous_const.mul (continuous_pow 2))).continuous_on } }, + { have B : (0 : ℝ) < 1/2, by norm_num, + apply integrable_of_is_O_exp_neg B _ (is_o.is_O (rpow_mul_exp_neg_mul_sq_is_o_exp_neg hb _)), + assume x hx, + have N : x ≠ 0, { refine (zero_lt_one.trans_le _).ne', exact hx }, + apply ((continuous_at_rpow_const _ _ (or.inl N)).mul _).continuous_within_at, + exact (continuous_exp.comp (continuous_const.mul (continuous_pow 2))).continuous_at }, +end + +lemma integrable_rpow_mul_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) {s : ℝ} (hs : -1 < s) : + integrable (λ x:ℝ, x ^ s * exp (-b * x^2)) := +begin + rw [← integrable_on_univ, ← @Iio_union_Ici _ _ (0 : ℝ), integrable_on_union, + integrable_on_Ici_iff_integrable_on_Ioi], + refine ⟨_, integrable_on_rpow_mul_exp_neg_mul_sq hb hs⟩, + rw ← (measure.measure_preserving_neg (volume : measure ℝ)).integrable_on_comp_preimage + ((homeomorph.neg ℝ).to_measurable_equiv.measurable_embedding), + simp only [function.comp, neg_sq, neg_preimage, preimage_neg_Iio, neg_neg, neg_zero], + apply integrable.mono' (integrable_on_rpow_mul_exp_neg_mul_sq hb hs), + { apply measurable.ae_strongly_measurable, + exact (measurable_id'.neg.pow measurable_const).mul + ((measurable_id'.pow measurable_const).const_mul (-b)).exp }, + { have : measurable_set (Ioi (0 : ℝ)) := measurable_set_Ioi, + filter_upwards [ae_restrict_mem this] with x hx, + have h'x : 0 ≤ x := le_of_lt hx, + rw [real.norm_eq_abs, abs_mul, abs_of_nonneg (exp_pos _).le], + apply mul_le_mul_of_nonneg_right _ (exp_pos _).le, + simpa [abs_of_nonneg h'x] using abs_rpow_le_abs_rpow (-x) s } +end + +lemma integrable_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) : + integrable (λ x:ℝ, exp (-b * x^2)) := +by simpa using integrable_rpow_mul_exp_neg_mul_sq hb (by norm_num : (-1 : ℝ) < 0) + +lemma integrable_on_Ioi_exp_neg_mul_sq_iff {b : ℝ} : + integrable_on (λ x:ℝ, exp (-b * x^2)) (Ioi 0) ↔ 0 < b := +begin + refine ⟨λ h, _, λ h, (integrable_exp_neg_mul_sq h).integrable_on⟩, + by_contra' hb, + have : ∫⁻ x:ℝ in Ioi 0, 1 ≤ ∫⁻ x:ℝ in Ioi 0, ‖exp (-b * x^2)‖₊, + { apply lintegral_mono (λ x, _), + simp only [neg_mul, ennreal.one_le_coe_iff, ← to_nnreal_one, to_nnreal_le_iff_le_coe, + real.norm_of_nonneg (exp_pos _).le, coe_nnnorm, one_le_exp_iff, right.nonneg_neg_iff], + exact mul_nonpos_of_nonpos_of_nonneg hb (sq_nonneg _) }, + simpa using this.trans_lt h.2, +end + +lemma integrable_exp_neg_mul_sq_iff {b : ℝ} : integrable (λ x:ℝ, exp (-b * x^2)) ↔ 0 < b := +⟨λ h, integrable_on_Ioi_exp_neg_mul_sq_iff.mp h.integrable_on, integrable_exp_neg_mul_sq⟩ + +lemma integrable_mul_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) : integrable (λ x:ℝ, x * exp (-b * x^2)) := +by simpa using integrable_rpow_mul_exp_neg_mul_sq hb (by norm_num : (-1 : ℝ) < 1) + +lemma norm_cexp_neg_mul_sq (b : ℂ) (x : ℝ) : ‖complex.exp (-b * x^2)‖ = exp (-b.re * x^2) := +by rw [complex.norm_eq_abs, complex.abs_exp, ←of_real_pow, mul_comm (-b) _, of_real_mul_re, + neg_re, mul_comm] + +lemma integrable_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) : integrable (λ x:ℝ, cexp (-b * x^2)) := +begin + refine ⟨(complex.continuous_exp.comp + (continuous_const.mul (continuous_of_real.pow 2))).ae_strongly_measurable, _⟩, + rw ←has_finite_integral_norm_iff, + simp_rw norm_cexp_neg_mul_sq, + exact (integrable_exp_neg_mul_sq hb).2, +end + +lemma integrable_mul_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) : + integrable (λ x:ℝ, ↑x * cexp (-b * x^2)) := +begin + refine ⟨(continuous_of_real.mul (complex.continuous_exp.comp _)).ae_strongly_measurable, _⟩, + { exact continuous_const.mul (continuous_of_real.pow 2) }, + have := (integrable_mul_exp_neg_mul_sq hb).has_finite_integral, + rw ←has_finite_integral_norm_iff at this ⊢, + convert this, + ext1 x, + rw [norm_mul, norm_mul, norm_cexp_neg_mul_sq b, complex.norm_eq_abs, abs_of_real, + real.norm_eq_abs, norm_of_nonneg (exp_pos _).le], +end + +lemma integral_mul_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) : + ∫ r:ℝ in Ioi 0, (r : ℂ) * cexp (-b * r ^ 2) = (2 * b)⁻¹ := +begin + have hb' : b ≠ 0 := by { contrapose! hb, rw [hb, zero_re], }, + have A : ∀ x:ℂ, has_deriv_at (λ x, - (2 * b)⁻¹ * cexp (-b * x^2)) (x * cexp (- b * x^2)) x, + { intro x, + convert (((has_deriv_at_pow 2 x)).const_mul (-b)).cexp.const_mul (- (2 * b)⁻¹) using 1, + field_simp [hb'], + ring }, + have B : tendsto (λ (y : ℝ), -(2 * b)⁻¹ * cexp (-b * ↑y ^ 2)) at_top (𝓝 (-(2 * b)⁻¹ * 0)), + { refine (tendsto.const_mul _ (tendsto_zero_iff_norm_tendsto_zero.mpr _)), + simp_rw norm_cexp_neg_mul_sq b, + exact tendsto_exp_at_bot.comp + (tendsto.neg_const_mul_at_top (neg_lt_zero.2 hb) (tendsto_pow_at_top two_ne_zero)) }, + convert integral_Ioi_of_has_deriv_at_of_tendsto' (λ x hx, (A ↑x).comp_of_real) + (integrable_mul_cexp_neg_mul_sq hb).integrable_on B, + simp only [mul_zero, of_real_zero, zero_pow', ne.def, bit0_eq_zero, nat.one_ne_zero, + not_false_iff, complex.exp_zero, mul_one, sub_neg_eq_add, zero_add], +end + +/-- The *square* of the Gaussian integral `∫ x:ℝ, exp (-b * x^2)` is equal to `π / b`. -/ +lemma integral_gaussian_sq_complex {b : ℂ} (hb : 0 < b.re) : + (∫ x:ℝ, cexp (-b * x^2)) ^ 2 = π / b := +begin + /- We compute `(∫ exp (-b x^2))^2` as an integral over `ℝ^2`, and then make a polar change + of coordinates. We are left with `∫ r * exp (-b r^2)`, which has been computed in + `integral_mul_cexp_neg_mul_sq` using the fact that this function has an obvious primitive. -/ + calc + (∫ x:ℝ, cexp (-b * (x:ℂ)^2)) ^ 2 + = ∫ p : ℝ × ℝ, cexp (-b * ((p.1) : ℂ) ^ 2) * cexp (-b * ((p.2) : ℂ) ^ 2) : + by { rw [pow_two, ← integral_prod_mul], refl } + ... = ∫ p : ℝ × ℝ, cexp (- b * (p.1 ^ 2 + p.2 ^ 2)) : + by { congr, ext1 p, rw [← complex.exp_add, mul_add], } + ... = ∫ p in polar_coord.target, (p.1) • cexp (- b * ((p.1 * cos p.2) ^ 2 + (p.1 * sin p.2)^2)) : + begin + rw ← integral_comp_polar_coord_symm, + simp only [polar_coord_symm_apply, of_real_mul, of_real_cos, of_real_sin], + end + ... = (∫ r in Ioi (0 : ℝ), r * cexp (-b * r^2)) * (∫ θ in Ioo (-π) π, 1) : + begin + rw ← set_integral_prod_mul, + congr' with p : 1, + rw mul_one, + congr, + conv_rhs { rw [← one_mul ((p.1 : ℂ)^2), ← sin_sq_add_cos_sq (p.2 : ℂ)], }, + ring_exp, + end + ... = ↑π / b : + begin + have : 0 ≤ π + π, by linarith [real.pi_pos], + simp only [integral_const, measure.restrict_apply', measurable_set_Ioo, univ_inter, + volume_Ioo, sub_neg_eq_add, ennreal.to_real_of_real, this], + rw [←two_mul, real_smul, mul_one, of_real_mul, of_real_bit0, of_real_one, + integral_mul_cexp_neg_mul_sq hb], + field_simp [(by { contrapose! hb, rw [hb, zero_re] } : b ≠ 0)], + ring, + end +end + +theorem integral_gaussian (b : ℝ) : ∫ x, exp (-b * x^2) = sqrt (π / b) := +begin + /- First we deal with the crazy case where `b ≤ 0`: then both sides vanish. -/ + rcases le_or_lt b 0 with hb|hb, + { rw [integral_undef, sqrt_eq_zero_of_nonpos], + { exact div_nonpos_of_nonneg_of_nonpos pi_pos.le hb }, + { simpa only [not_lt, integrable_exp_neg_mul_sq_iff] using hb } }, + /- Assume now `b > 0`. Then both sides are non-negative and their squares agree. -/ + refine (sq_eq_sq _ (sqrt_nonneg _)).1 _, + { exact integral_nonneg (λ x, (exp_pos _).le) }, + rw [←of_real_inj, of_real_pow, ←integral_of_real, sq_sqrt (div_pos pi_pos hb).le, of_real_div], + convert integral_gaussian_sq_complex (by rwa of_real_re : 0 < (b:ℂ).re), + ext1 x, + rw [of_real_exp, of_real_mul, of_real_pow, of_real_neg], +end + +lemma continuous_at_gaussian_integral (b : ℂ) (hb : 0 < re b) : + continuous_at (λ c:ℂ, ∫ x:ℝ, cexp (-c * x^2)) b := +begin + let f : ℂ → ℝ → ℂ := λ (c : ℂ) (x : ℝ), cexp (-c * x ^ 2), + obtain ⟨d, hd, hd'⟩ := exists_between hb, + have f_meas : ∀ (c:ℂ), ae_strongly_measurable (f c) volume := λ c, by + { apply continuous.ae_strongly_measurable, + exact complex.continuous_exp.comp (continuous_const.mul (continuous_of_real.pow 2)) }, + have f_int : integrable (f b) volume, + { simp_rw [←integrable_norm_iff (f_meas b), norm_cexp_neg_mul_sq b], + exact integrable_exp_neg_mul_sq hb, }, + have f_cts : ∀ (x : ℝ), continuous_at (λ c, f c x) b := + λ x, (complex.continuous_exp.comp (continuous_id'.neg.mul continuous_const)).continuous_at, + have f_le_bd : ∀ᶠ (c : ℂ) in 𝓝 b, ∀ᵐ (x : ℝ), ‖f c x‖ ≤ exp (-d * x ^ 2), + { refine eventually_of_mem ((continuous_re.is_open_preimage _ is_open_Ioi).mem_nhds hd') _, + refine λ c hc, ae_of_all _ (λ x, _), + rw [norm_cexp_neg_mul_sq, exp_le_exp], + exact mul_le_mul_of_nonneg_right (neg_le_neg (le_of_lt hc)) (sq_nonneg _) }, + exact continuous_at_of_dominated (eventually_of_forall f_meas) f_le_bd + (integrable_exp_neg_mul_sq hd) (ae_of_all _ f_cts), +end + +theorem integral_gaussian_complex {b : ℂ} (hb : 0 < re b) : + ∫ x:ℝ, cexp (-b * x^2) = (π / b) ^ (1 / 2 : ℂ) := +begin + have nv : ∀ {b : ℂ}, (0 < re b) → (b ≠ 0), + { intros b hb, contrapose! hb, rw hb, simp }, + refine (convex_halfspace_re_gt 0).is_preconnected.eq_of_sq_eq + _ _ (λ c hc, _) (λ c hc, _) (by simp : 0 < re (1 : ℂ)) _ hb, + { -- integral is continuous + exact continuous_at.continuous_on continuous_at_gaussian_integral, }, + { -- `(π / b) ^ (1 / 2 : ℂ)` is continuous + refine continuous_at.continuous_on (λ b hb, (continuous_at_cpow_const (or.inl _)).comp + (continuous_at_const.div continuous_at_id (nv hb))), + rw [div_re, of_real_im, of_real_re, zero_mul, zero_div, add_zero], + exact div_pos (mul_pos pi_pos hb) (norm_sq_pos.mpr (nv hb)), }, + { -- squares of both sides agree + dsimp only [pi.pow_apply], + rw [integral_gaussian_sq_complex hc, sq], + conv_lhs { rw ←cpow_one (↑π / c)}, + rw ← cpow_add _ _ (div_ne_zero (of_real_ne_zero.mpr pi_ne_zero) (nv hc)), + norm_num }, + { -- RHS doesn't vanish + rw [ne.def, cpow_eq_zero_iff, not_and_distrib], + exact or.inl (div_ne_zero (of_real_ne_zero.mpr pi_ne_zero) (nv hc)) }, + { -- equality at 1 + have : ∀ (x : ℝ), cexp (-1 * x ^ 2) = exp (-1 * x ^ 2), + { intro x, + simp only [of_real_exp, neg_mul, one_mul, of_real_neg, of_real_pow] }, + simp_rw [this, integral_of_real], + conv_rhs { congr, rw [←of_real_one, ←of_real_div], skip, + rw [←of_real_one, ←of_real_bit0, ←of_real_div] }, + rw [←of_real_cpow, of_real_inj], + convert integral_gaussian (1 : ℝ), + { rwa [sqrt_eq_rpow] }, + { rw [div_one], exact pi_pos.le } }, +end + +/- The Gaussian integral on the half-line, `∫ x in Ioi 0, exp (-b * x^2)`, for complex `b`. -/ +lemma integral_gaussian_complex_Ioi {b : ℂ} (hb : 0 < re b) : + ∫ x:ℝ in Ioi 0, cexp (-b * x^2) = (π / b) ^ (1 / 2 : ℂ) / 2 := +begin + have full_integral := integral_gaussian_complex hb, + have : measurable_set (Ioi (0:ℝ)) := measurable_set_Ioi, + rw [←integral_add_compl this (integrable_cexp_neg_mul_sq hb), compl_Ioi] at full_integral, + suffices : ∫ x:ℝ in Iic 0, cexp (-b * x^2) = ∫ x:ℝ in Ioi 0, cexp (-b * x^2), + { rw [this, ←mul_two] at full_integral, + rwa eq_div_iff, exact two_ne_zero }, + have : ∀ (c : ℝ), ∫ x in 0 .. c, cexp (-b * x^2) = ∫ x in -c .. 0, cexp (-b * x^2), + { intro c, + have := @interval_integral.integral_comp_sub_left _ _ _ _ 0 c (λ x, cexp (-b * x^2)) 0, + simpa [zero_sub, neg_sq, neg_zero] using this }, + have t1 := interval_integral_tendsto_integral_Ioi _ + ((integrable_cexp_neg_mul_sq hb).integrable_on) tendsto_id, + have t2 : tendsto (λ c:ℝ, ∫ x:ℝ in 0..c, + cexp (-b * x^2)) at_top (𝓝 ∫ x:ℝ in Iic 0, cexp (-b * x^2)), + { simp_rw this, + refine interval_integral_tendsto_integral_Iic _ _ tendsto_neg_at_top_at_bot, + apply (integrable_cexp_neg_mul_sq hb).integrable_on }, + exact tendsto_nhds_unique t2 t1, +end + +/- The Gaussian integral on the half-line, `∫ x in Ioi 0, exp (-b * x^2)`, for real `b`. -/ +lemma integral_gaussian_Ioi (b : ℝ) : ∫ x in Ioi 0, exp (-b * x^2) = sqrt (π / b) / 2 := +begin + rcases le_or_lt b 0 with hb|hb, + { rw [integral_undef, sqrt_eq_zero_of_nonpos, zero_div], + exact div_nonpos_of_nonneg_of_nonpos pi_pos.le hb, + rwa [←integrable_on, integrable_on_Ioi_exp_neg_mul_sq_iff, not_lt] }, + rw [←of_real_inj, ←integral_of_real], + convert integral_gaussian_complex_Ioi (by rwa of_real_re : 0 < (b:ℂ).re), + { ext1 x, simp, }, + { rw [sqrt_eq_rpow, ←of_real_div, of_real_div, of_real_cpow], + norm_num, + exact (div_pos pi_pos hb).le, } +end + +/-- The special-value formula `Γ(1/2) = √π`, which is equivalent to the Gaussian integral. -/ +lemma real.Gamma_one_half_eq : real.Gamma (1 / 2) = sqrt π := +begin + rw [Gamma_eq_integral one_half_pos, ←integral_comp_rpow_Ioi_of_pos zero_lt_two], + convert congr_arg (λ x:ℝ, 2 * x) (integral_gaussian_Ioi 1), + { rw ←integral_mul_left, + refine set_integral_congr measurable_set_Ioi (λ x hx, _), + dsimp only, + have : (x ^ (2:ℝ)) ^ (1 / (2:ℝ) - 1) = x⁻¹, + { rw ←rpow_mul (le_of_lt hx), + norm_num, + rw [rpow_neg (le_of_lt hx), rpow_one] }, + rw [smul_eq_mul, this], + field_simp [(ne_of_lt hx).symm], + norm_num, ring }, + { rw [div_one, ←mul_div_assoc, mul_comm, mul_div_cancel _ (two_ne_zero' ℝ)], } +end + +/-- The special-value formula `Γ(1/2) = √π`, which is equivalent to the Gaussian integral. -/ +lemma complex.Gamma_one_half_eq : complex.Gamma (1 / 2) = π ^ (1 / 2 : ℂ) := +begin + convert congr_arg coe real.Gamma_one_half_eq, + { simpa only [one_div, of_real_inv, of_real_bit0] using Gamma_of_real (1 / 2)}, + { rw [sqrt_eq_rpow, of_real_cpow pi_pos.le, of_real_div, of_real_bit0, of_real_one] } +end + +namespace gaussian_fourier +/-! ## Fourier transform of the Gaussian integral +-/ +open interval_integral +open_locale real + +variables {b : ℂ} + +/-- The integral of the Gaussian function over the vertical edges of a rectangle +with vertices at `(±T, 0)` and `(±T, c)`. -/ +def vertical_integral (b : ℂ) (c T : ℝ) : ℂ := +∫ (y : ℝ) in 0..c, I * (cexp (-b * (T + y * I) ^ 2) - cexp (-b * (T - y * I) ^ 2)) + +/-- Explicit formula for the norm of the Gaussian function along the vertical +edges. -/ +lemma norm_cexp_neg_mul_sq_add_mul_I (b : ℂ) (c T : ℝ) : + ‖cexp (-b * (T + c * I) ^ 2)‖ = exp (-(b.re * T ^ 2 - 2 * b.im * c * T - b.re * c ^ 2)) := +begin + rw [complex.norm_eq_abs, complex.abs_exp, neg_mul, neg_re, ←re_add_im b], + simp only [sq, re_add_im, mul_re, mul_im, add_re, add_im, of_real_re, of_real_im, I_re, I_im], + ring_nf, +end + +lemma norm_cexp_neg_mul_sq_add_mul_I' (hb : b.re ≠ 0) (c T : ℝ) : + ‖cexp (-b * (T + c * I) ^ 2)‖ = + exp (-(b.re * (T - b.im * c / b.re) ^ 2 - c ^ 2 * (b.im ^ 2 / b.re + b.re))) := +begin + have : (b.re * T ^ 2 - 2 * b.im * c * T - b.re * c ^ 2) = + b.re * (T - b.im * c / b.re) ^ 2 - c ^ 2 * (b.im ^ 2 / b.re + b.re), + { field_simp, ring }, + rw [norm_cexp_neg_mul_sq_add_mul_I, this], +end + +lemma vertical_integral_norm_le (hb : 0 < b.re) (c : ℝ) {T : ℝ} (hT : 0 ≤ T) : + ‖vertical_integral b c T‖ + ≤ 2 * |c| * exp (-(b.re * T ^ 2 - 2 * |b.im| * |c| * T - b.re * c ^ 2)) := +begin + -- first get uniform bound for integrand + have vert_norm_bound : ∀ {T : ℝ}, 0 ≤ T → ∀ {c y : ℝ}, |y| ≤ |c| → + ‖cexp (-b * (T + y * I) ^ 2)‖ ≤ exp (-(b.re * T ^ 2 - 2 * |b.im| * |c| * T - b.re * c ^ 2)), + { intros T hT c y hy, + rw [norm_cexp_neg_mul_sq_add_mul_I b, exp_le_exp, neg_le_neg_iff], + refine sub_le_sub (sub_le_sub (le_refl _) (mul_le_mul_of_nonneg_right _ hT)) _, + { conv_lhs {rw mul_assoc}, conv_rhs {rw mul_assoc}, + refine mul_le_mul_of_nonneg_left ((le_abs_self _).trans _) zero_le_two, + rw abs_mul, + exact mul_le_mul_of_nonneg_left hy (abs_nonneg _), }, + { refine mul_le_mul_of_nonneg_left _ hb.le, + rwa sq_le_sq, } }, + -- now main proof + refine (interval_integral.norm_integral_le_of_norm_le_const _).trans _, + swap 3, + { rw sub_zero, + conv_lhs { rw mul_comm }, + conv_rhs { conv { congr, rw mul_comm }, rw mul_assoc } }, + { intros y hy, + have absy : |y| ≤ |c|, + { rcases le_or_lt 0 c, + { rw uIoc_of_le h at hy, + rw [abs_of_nonneg h, abs_of_pos hy.1], + exact hy.2, }, + { rw uIoc_of_lt h at hy, + rw [abs_of_neg h, abs_of_nonpos hy.2, neg_le_neg_iff], + exact hy.1.le } }, + rw [norm_mul, complex.norm_eq_abs, abs_I, one_mul, two_mul], + refine (norm_sub_le _ _).trans (add_le_add (vert_norm_bound hT absy) _), + rw ←abs_neg y at absy, + simpa only [neg_mul, of_real_neg] using vert_norm_bound hT absy }, +end + +lemma tendsto_vertical_integral (hb : 0 < b.re) (c : ℝ) : + tendsto (vertical_integral b c) at_top (𝓝 0) := +begin + -- complete proof using squeeze theorem: + rw tendsto_zero_iff_norm_tendsto_zero, + refine tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds _ + (eventually_of_forall (λ _, norm_nonneg _)) + ((eventually_ge_at_top (0:ℝ)).mp (eventually_of_forall + (λ T hT, vertical_integral_norm_le hb c hT))), + rw (by ring : 0 = 2 * |c| * 0), + refine (tendsto_exp_at_bot.comp (tendsto_neg_at_top_at_bot.comp _)).const_mul _ , + apply tendsto_at_top_add_const_right, + simp_rw [sq, ←mul_assoc, ←sub_mul], + refine tendsto.at_top_mul_at_top (tendsto_at_top_add_const_right _ _ _) tendsto_id, + exact (tendsto_const_mul_at_top_of_pos hb).mpr tendsto_id, +end + +lemma integrable_cexp_neg_mul_sq_add_real_mul_I (hb : 0 < b.re) (c : ℝ) : + integrable (λ (x : ℝ), cexp (-b * (x + c * I) ^ 2)) := +begin + refine ⟨(complex.continuous_exp.comp (continuous_const.mul ((continuous_of_real.add + continuous_const).pow 2))).ae_strongly_measurable, _⟩, + rw ←has_finite_integral_norm_iff, + simp_rw [norm_cexp_neg_mul_sq_add_mul_I' hb.ne', neg_sub _ (c ^ 2 * _), + sub_eq_add_neg _ (b.re * _), real.exp_add], + suffices : integrable (λ (x : ℝ), exp (-(b.re * x ^ 2))), + { exact (integrable.comp_sub_right this (b.im * c / b.re)).has_finite_integral.const_mul _, }, + simp_rw ←neg_mul, + apply integrable_exp_neg_mul_sq hb, +end + +lemma integral_cexp_neg_mul_sq_add_real_mul_I (hb : 0 < b.re) (c : ℝ) : + ∫ (x : ℝ), cexp (-b * (x + c * I) ^ 2) = (π / b) ^ (1 / 2 : ℂ) := +begin + refine tendsto_nhds_unique (interval_integral_tendsto_integral + (integrable_cexp_neg_mul_sq_add_real_mul_I hb c) tendsto_neg_at_top_at_bot tendsto_id) _, + set I₁ := (λ T, ∫ (x : ℝ) in -T..T, cexp (-b * (x + c * I) ^ 2)) with HI₁, + let I₂ := λ (T : ℝ), ∫ (x : ℝ) in -T..T, cexp (-b * x ^ 2), + let I₄ := λ (T : ℝ), ∫ (y : ℝ) in 0..c, cexp (-b * (T + y * I) ^ 2), + let I₅ := λ (T : ℝ), ∫ (y : ℝ) in 0..c, cexp (-b * (-T + y * I) ^ 2), + have C : ∀ (T : ℝ), I₂ T - I₁ T + I * I₄ T - I * I₅ T = 0, + { assume T, + have := integral_boundary_rect_eq_zero_of_differentiable_on + (λ z, cexp (-b * z ^ 2)) (-T) (T + c * I) + (by { refine differentiable.differentiable_on (differentiable.const_mul _ _).cexp, + exact differentiable_pow 2, }), + simpa only [neg_im, of_real_im, neg_zero, of_real_zero, zero_mul, add_zero, neg_re, of_real_re, + add_re, mul_re, I_re, mul_zero, I_im, tsub_zero, add_im, mul_im, mul_one, zero_add, + algebra.id.smul_eq_mul, of_real_neg] using this }, + simp_rw [id.def, ←HI₁], + have : I₁ = λ (T : ℝ), I₂ T + vertical_integral b c T, + { ext1 T, + specialize C T, + rw sub_eq_zero at C, + unfold vertical_integral, + rw [integral_const_mul, interval_integral.integral_sub], + { simp_rw (λ a b, by { rw sq, ring_nf } : ∀ (a b : ℂ), (a - b * I)^2 = (- a + b * I)^2), + change I₁ T = I₂ T + I * (I₄ T - I₅ T), + rw [mul_sub, ←C], + abel }, + all_goals { apply continuous.interval_integrable, continuity }, }, + rw [this, ←add_zero ((π / b : ℂ) ^ (1 / 2 : ℂ)), ←integral_gaussian_complex hb], + refine tendsto.add _ (tendsto_vertical_integral hb c), + exact interval_integral_tendsto_integral (integrable_cexp_neg_mul_sq hb) + tendsto_neg_at_top_at_bot tendsto_id, +end + +lemma _root_.integral_cexp_neg_mul_sq_add_const (hb : 0 < b.re) (c : ℂ) : + ∫ (x : ℝ), cexp (-b * (x + c) ^ 2) = (π / b) ^ (1 / 2 : ℂ) := +begin + rw ←re_add_im c, + simp_rw [←add_assoc, ←of_real_add], + rw integral_add_right_eq_self (λ(x : ℝ), cexp (-b * (↑x + ↑(c.im) * I) ^ 2)), + { apply integral_cexp_neg_mul_sq_add_real_mul_I hb }, + { apply_instance }, +end + +lemma _root_.fourier_transform_gaussian (hb : 0 < b.re) (t : ℂ) : + ∫ (x : ℝ), cexp (I * t * x) * cexp (-b * x ^ 2) = cexp (-t^2 / (4 * b)) * (π / b) ^ (1 / 2 : ℂ) := +begin + have : b ≠ 0, + { contrapose! hb, rw [hb, zero_re] }, + simp_rw [←complex.exp_add], + have : ∀ (x : ℂ), I * t * x + (-b * x ^ 2) = -t ^ 2 / (4 * b) + -b * (x + (-I * t / 2 / b)) ^ 2, + { intro x, + ring_nf SOP, + rw I_sq, + field_simp, ring }, + simp_rw [this, complex.exp_add, integral_mul_left, integral_cexp_neg_mul_sq_add_const hb] +end + +lemma _root_.fourier_transform_gaussian_pi (hb : 0 < b.re) : + 𝓕 (λ x : ℝ, cexp (-π * b * x ^ 2)) = λ t : ℝ, 1 / b ^ (1 / 2 : ℂ) * cexp (-π / b * t ^ 2) := +begin + ext1 t, + simp_rw [fourier_integral_eq_integral_exp_smul, smul_eq_mul], + have h1 : 0 < re (π * b) := by { rw of_real_mul_re, exact mul_pos pi_pos hb }, + have h2 : b ≠ 0 := by { contrapose! hb, rw [hb, zero_re], }, + convert _root_.fourier_transform_gaussian h1 (-2 * π * t) using 1, + { congr' 1 with x:1, + congr' 2, + all_goals { push_cast, ring } }, + { conv_lhs { rw mul_comm }, + congr' 2, + { field_simp [of_real_ne_zero.mpr pi_ne_zero], ring, }, + { rw [←div_div, div_self (of_real_ne_zero.mpr pi_ne_zero), one_div, one_div b, inv_cpow], + rw [ne.def, arg_eq_pi_iff, not_and_distrib, not_lt], + exact or.inl hb.le } }, +end + +end gaussian_fourier + +section gaussian_poisson +/-! ## Poisson summation applied to the Gaussian -/ + +variables {E : Type*} [normed_add_comm_group E] + +lemma tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact {a : ℝ} (ha : 0 < a) (s : ℝ) : + tendsto (λ x : ℝ, |x| ^ s * rexp (-a * x ^ 2)) (cocompact ℝ) (𝓝 0) := +begin + conv in (rexp _) { rw ←sq_abs }, + rw [cocompact_eq, ←comap_abs_at_top, + @tendsto_comap'_iff _ _ _ (λ y, y ^ s * rexp (-a * y ^ 2)) _ _ _ + (mem_at_top_sets.mpr ⟨0, λ b hb, ⟨b, abs_of_nonneg hb⟩⟩)], + exact (rpow_mul_exp_neg_mul_sq_is_o_exp_neg ha s).tendsto_zero_of_tendsto + (tendsto_exp_at_bot.comp $ tendsto_id.neg_const_mul_at_top (neg_lt_zero.mpr one_half_pos)), +end + +lemma is_o_exp_neg_mul_sq_cocompact {a : ℂ} (ha : 0 < a.re) (s : ℝ) : + (λ x : ℝ, complex.exp (-a * x ^ 2)) =o[cocompact ℝ] (λ x : ℝ, |x| ^ s) := +begin + rw ←is_o_norm_left, + simp_rw norm_cexp_neg_mul_sq, + apply is_o_of_tendsto', + { refine eventually.filter_mono cocompact_le_cofinite _, + refine (eventually_cofinite_ne 0).mp (eventually_of_forall (λ x hx h, _)), + exact ((rpow_pos_of_pos (abs_pos.mpr hx) _).ne' h).elim }, + { refine tendsto.congr' (eventually.filter_mono cocompact_le_cofinite _) + (tendsto_zero_iff_norm_tendsto_zero.mp $ + tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact ha (-s)), + refine (eventually_cofinite_ne 0).mp (eventually_of_forall (λ x hx, _)), + rw [norm_mul, norm_of_nonneg (rpow_nonneg_of_nonneg (abs_nonneg _) _), mul_comm, + rpow_neg (abs_nonneg x), div_eq_mul_inv, norm_of_nonneg (exp_pos _).le] }, +end + +lemma complex.tsum_exp_neg_mul_int_sq {a : ℂ} (ha : 0 < a.re) : + ∑' (n : ℤ), cexp (-π * a * n ^ 2) = 1 / a ^ (1 / 2 : ℂ) * ∑' (n : ℤ), cexp (-π / a * n ^ 2) := +begin + let f := λ x : ℝ, cexp (-π * a * x ^ 2), + have h1 : 0 < (↑π * a).re, + { rw [of_real_mul_re], + exact mul_pos pi_pos ha }, + have h2 : 0 < (↑π / a).re, + { rw [div_eq_mul_inv, of_real_mul_re, inv_re], + refine mul_pos pi_pos (div_pos ha $ norm_sq_pos.mpr _), + contrapose! ha, + rw [ha, zero_re] }, + have f_bd : f =O[cocompact ℝ] (λ x, |x| ^ (-2 : ℝ)), + { convert (is_o_exp_neg_mul_sq_cocompact h1 _).is_O, + ext1 x, + dsimp only [f], + congr' 1, + ring }, + have Ff_bd : 𝓕 f =O[cocompact ℝ] (λ x, |x| ^ (-2 : ℝ)), + { rw fourier_transform_gaussian_pi ha, + convert (is_o_exp_neg_mul_sq_cocompact h2 _).is_O.const_mul_left _, + ext1 x, + congr' 1, + ring_nf }, + simpa only [fourier_transform_gaussian_pi ha, tsum_mul_left] using + real.tsum_eq_tsum_fourier_integral_of_rpow_decay + (complex.continuous_exp.comp (continuous_const.mul (continuous_of_real.pow 2)) : continuous f) + one_lt_two f_bd Ff_bd +end + +lemma real.tsum_exp_neg_mul_int_sq {a : ℝ} (ha : 0 < a) : + ∑' (n : ℤ), exp (-π * a * n ^ 2) = 1 / a ^ (1 / 2 : ℝ) * ∑' (n : ℤ), exp (-π / a * n ^ 2) := +by simpa only [←of_real_inj, of_real_mul, of_real_tsum, of_real_exp, of_real_div, of_real_pow, + of_real_int_cast, of_real_neg, of_real_cpow ha.le, of_real_bit0, of_real_one] using + complex.tsum_exp_neg_mul_int_sq (by rwa [of_real_re] : 0 < (a : ℂ).re) + +end gaussian_poisson diff --git a/src/analysis/special_functions/improper_integrals.lean b/src/analysis/special_functions/improper_integrals.lean new file mode 100644 index 0000000000000..89aa5354e61ab --- /dev/null +++ b/src/analysis/special_functions/improper_integrals.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ +import analysis.special_functions.integrals +import measure_theory.group.integration +import measure_theory.integral.exp_decay +import measure_theory.integral.integral_eq_improper +import measure_theory.measure.lebesgue.integral + +/-! +# Evaluation of specific improper integrals + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains some integrability results, and evaluations of integrals, over `ℝ` or over +half-infinite intervals in `ℝ`. + +## See also + +- `analysis.special_functions.integrals` -- integrals over finite intervals +- `analysis.special_functions.gaussian` -- integral of `exp (-x ^ 2)` +- `analysis.special_functions.japanese_bracket`-- integrability of `(1+‖x‖)^(-r)`. +-/ + +open real set filter measure_theory interval_integral +open_locale topology + +lemma integrable_on_exp_Iic (c : ℝ) : integrable_on exp (Iic c) := +begin + refine integrable_on_Iic_of_interval_integral_norm_bounded (exp c) c (λ y, + interval_integrable_exp.1) tendsto_id (eventually_of_mem (Iic_mem_at_bot 0) (λ y hy, _)), + simp_rw [(norm_of_nonneg (exp_pos _).le), integral_exp, sub_le_self_iff], + exact (exp_pos _).le, +end + +lemma integral_exp_Iic (c : ℝ) : ∫ (x : ℝ) in Iic c, exp x = exp c := +begin + refine tendsto_nhds_unique (interval_integral_tendsto_integral_Iic _ (integrable_on_exp_Iic _) + tendsto_id) _, + simp_rw [integral_exp, (show 𝓝 (exp c) = 𝓝 (exp c - 0), by rw sub_zero)], + exact tendsto_exp_at_bot.const_sub _, +end + +lemma integral_exp_Iic_zero : ∫ (x : ℝ) in Iic 0, exp x = 1 := exp_zero ▸ integral_exp_Iic 0 + +lemma integral_exp_neg_Ioi (c : ℝ) : ∫ (x : ℝ) in Ioi c, exp (-x) = exp (-c) := +by simpa only [integral_comp_neg_Ioi] using integral_exp_Iic (-c) + +lemma integral_exp_neg_Ioi_zero : ∫ (x : ℝ) in Ioi 0, exp (-x) = 1 := +by simpa only [neg_zero, exp_zero] using integral_exp_neg_Ioi 0 + +/-- If `0 < c`, then `(λ t : ℝ, t ^ a)` is integrable on `(c, ∞)` for all `a < -1`. -/ +lemma integrable_on_Ioi_rpow_of_lt {a : ℝ} (ha : a < -1) {c : ℝ} (hc : 0 < c) : + integrable_on (λ t : ℝ, t ^ a) (Ioi c) := +begin + have hd : ∀ (x : ℝ) (hx : x ∈ Ici c), has_deriv_at (λ t, t ^ (a + 1) / (a + 1)) (x ^ a) x, + { intros x hx, + convert (has_deriv_at_rpow_const (or.inl (hc.trans_le hx).ne')).div_const _, + field_simp [show a + 1 ≠ 0, from ne_of_lt (by linarith), mul_comm] }, + have ht : tendsto (λ t, t ^ (a + 1) / (a + 1)) at_top (𝓝 (0/(a+1))), + { apply tendsto.div_const, + simpa only [neg_neg] using tendsto_rpow_neg_at_top (by linarith : 0 < -(a + 1)) }, + exact integrable_on_Ioi_deriv_of_nonneg' hd (λ t ht, rpow_nonneg_of_nonneg (hc.trans ht).le a) ht +end + +lemma integral_Ioi_rpow_of_lt {a : ℝ} (ha : a < -1) {c : ℝ} (hc : 0 < c) : + ∫ (t : ℝ) in Ioi c, t ^ a = -c ^ (a + 1) / (a + 1) := +begin + have hd : ∀ (x : ℝ) (hx : x ∈ Ici c), has_deriv_at (λ t, t ^ (a + 1) / (a + 1)) (x ^ a) x, + { intros x hx, + convert (has_deriv_at_rpow_const (or.inl (hc.trans_le hx).ne')).div_const _, + field_simp [show a + 1 ≠ 0, from ne_of_lt (by linarith), mul_comm] }, + have ht : tendsto (λ t, t ^ (a + 1) / (a + 1)) at_top (𝓝 (0/(a+1))), + { apply tendsto.div_const, + simpa only [neg_neg] using tendsto_rpow_neg_at_top (by linarith : 0 < -(a + 1)) }, + convert integral_Ioi_of_has_deriv_at_of_tendsto' hd (integrable_on_Ioi_rpow_of_lt ha hc) ht, + simp only [neg_div, zero_div, zero_sub], +end + +lemma integrable_on_Ioi_cpow_of_lt {a : ℂ} (ha : a.re < -1) {c : ℝ} (hc : 0 < c) : + integrable_on (λ t : ℝ, (t : ℂ) ^ a) (Ioi c) := +begin + rw [integrable_on, ←integrable_norm_iff, ←integrable_on], + refine (integrable_on_Ioi_rpow_of_lt ha hc).congr_fun (λ x hx, _) measurable_set_Ioi, + { dsimp only, + rw [complex.norm_eq_abs, complex.abs_cpow_eq_rpow_re_of_pos (hc.trans hx)] }, + { refine continuous_on.ae_strongly_measurable (λ t ht, _) measurable_set_Ioi, + exact (complex.continuous_at_of_real_cpow_const _ _ + (or.inr (hc.trans ht).ne')).continuous_within_at } +end + +lemma integral_Ioi_cpow_of_lt {a : ℂ} (ha : a.re < -1) {c : ℝ} (hc : 0 < c) : + ∫ (t : ℝ) in Ioi c, (t : ℂ) ^ a = -(c : ℂ) ^ (a + 1) / (a + 1) := +begin + refine tendsto_nhds_unique (interval_integral_tendsto_integral_Ioi c + (integrable_on_Ioi_cpow_of_lt ha hc) tendsto_id) _, + suffices : tendsto (λ (x : ℝ), ((x : ℂ) ^ (a + 1) - (c : ℂ) ^ (a + 1)) / (a + 1)) at_top + (𝓝 $ -c ^ (a + 1) / (a + 1)), + { refine this.congr' ((eventually_gt_at_top 0).mp (eventually_of_forall $ λ x hx, _)), + rw [integral_cpow, id.def], + refine or.inr ⟨_, not_mem_uIcc_of_lt hc hx⟩, + apply_fun complex.re, + rw [complex.neg_re, complex.one_re], + exact ha.ne }, + simp_rw [←zero_sub, sub_div], + refine (tendsto.div_const _ _).sub_const _, + rw tendsto_zero_iff_norm_tendsto_zero, + refine (tendsto_rpow_neg_at_top (by linarith : 0 < -(a.re + 1))).congr' + ((eventually_gt_at_top 0).mp (eventually_of_forall $ λ x hx, _)), + simp_rw [neg_neg, complex.norm_eq_abs, complex.abs_cpow_eq_rpow_re_of_pos hx, + complex.add_re, complex.one_re], +end diff --git a/src/analysis/special_functions/integrals.lean b/src/analysis/special_functions/integrals.lean index d588831d4ecd4..22b8ec9e9bff1 100644 --- a/src/analysis/special_functions/integrals.lean +++ b/src/analysis/special_functions/integrals.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Benjamin Davidson. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Benjamin Davidson -/ -import measure_theory.integral.interval_integral +import measure_theory.integral.fund_thm_calculus import analysis.special_functions.trigonometric.arctan_deriv /-! # Integration of specific interval integrals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains proofs of the integrals of various specific functions. This includes: * Integrals of simple functions, such as `id`, `pow`, `inv`, `exp`, `log` * Integrals of some trigonometric functions, such as `sin`, `cos`, `1 / (1 + x^2)` @@ -48,10 +51,127 @@ lemma interval_integrable_zpow {n : ℤ} (h : 0 ≤ n ∨ (0 : ℝ) ∉ [a, b]) interval_integrable (λ x, x ^ n) μ a b := (continuous_on_id.zpow₀ n $ λ x hx, h.symm.imp (ne_of_mem_of_not_mem hx) id).interval_integrable +/-- See `interval_integrable_rpow'` for a version with a weaker hypothesis on `r`, but assuming the +measure is volume. -/ lemma interval_integrable_rpow {r : ℝ} (h : 0 ≤ r ∨ (0 : ℝ) ∉ [a, b]) : interval_integrable (λ x, x ^ r) μ a b := (continuous_on_id.rpow_const $ λ x hx, h.symm.imp (ne_of_mem_of_not_mem hx) id).interval_integrable +/-- See `interval_integrable_rpow` for a version applying to any locally finite measure, but with a +stronger hypothesis on `r`. -/ +lemma interval_integrable_rpow' {r : ℝ} (h : -1 < r) : + interval_integrable (λ x, x ^ r) volume a b := +begin + suffices : ∀ (c : ℝ), interval_integrable (λ x, x ^ r) volume 0 c, + { exact interval_integrable.trans (this a).symm (this b) }, + have : ∀ (c : ℝ), (0 ≤ c) → interval_integrable (λ x, x ^ r) volume 0 c, + { intros c hc, + rw [interval_integrable_iff, uIoc_of_le hc], + have hderiv : ∀ x ∈ Ioo 0 c, has_deriv_at (λ x : ℝ, x ^ (r + 1) / (r + 1)) (x ^ r) x, + { intros x hx, convert (real.has_deriv_at_rpow_const (or.inl hx.1.ne')).div_const (r + 1), + field_simp [(by linarith : r + 1 ≠ 0)], ring, }, + apply integrable_on_deriv_of_nonneg _ hderiv, + { intros x hx, apply rpow_nonneg_of_nonneg hx.1.le, }, + { refine (continuous_on_id.rpow_const _).div_const _, intros x hx, right, linarith } }, + intro c, rcases le_total 0 c with hc|hc, + { exact this c hc }, + { rw [interval_integrable.iff_comp_neg, neg_zero], + have m := (this (-c) (by linarith)).smul (cos (r * π)), + rw interval_integrable_iff at m ⊢, + refine m.congr_fun _ measurable_set_Ioc, intros x hx, + rw uIoc_of_le (by linarith : 0 ≤ -c) at hx, + simp only [pi.smul_apply, algebra.id.smul_eq_mul, log_neg_eq_log, mul_comm, + rpow_def_of_pos hx.1, rpow_def_of_neg (by linarith [hx.1] : -x < 0)], } +end + +/-- See `interval_integrable_cpow'` for a version with a weaker hypothesis on `r`, but assuming the +measure is volume. -/ +lemma interval_integrable_cpow {r : ℂ} (h : 0 ≤ r.re ∨ (0 : ℝ) ∉ [a, b]) : + interval_integrable (λ x : ℝ, (x : ℂ) ^ r) μ a b := +begin + by_cases h2 : (0:ℝ) ∉ [a,b], + { -- Easy case #1: 0 ∉ [a, b] -- use continuity. + refine (continuous_at.continuous_on (λ x hx, _)).interval_integrable, + exact complex.continuous_at_of_real_cpow_const _ _ (or.inr $ ne_of_mem_of_not_mem hx h2) }, + rw [eq_false_intro h2, or_false] at h, + rcases lt_or_eq_of_le h with h'|h', + { -- Easy case #2: 0 < re r -- again use continuity + exact (complex.continuous_of_real_cpow_const h').interval_integrable _ _ }, + -- Now the hard case: re r = 0 and 0 is in the interval. + refine (interval_integrable.interval_integrable_norm_iff _).mp _, + { refine (measurable_of_continuous_on_compl_singleton (0:ℝ) _).ae_strongly_measurable, + exact continuous_at.continuous_on + (λ x hx, complex.continuous_at_of_real_cpow_const x r (or.inr hx)) }, + -- reduce to case of integral over `[0, c]` + suffices : ∀ (c : ℝ), interval_integrable (λ x : ℝ, ‖↑x ^ r‖) μ 0 c, + from (this a).symm.trans (this b), + intro c, + rcases le_or_lt 0 c with hc | hc, + { -- case `0 ≤ c`: integrand is identically 1 + have : interval_integrable (λ x, 1 : ℝ → ℝ) μ 0 c, + from interval_integrable_const, + rw interval_integrable_iff_integrable_Ioc_of_le hc at this ⊢, + refine integrable_on.congr_fun this (λ x hx, _) measurable_set_Ioc, + dsimp only, + rw [complex.norm_eq_abs, complex.abs_cpow_eq_rpow_re_of_pos hx.1, ←h', rpow_zero], }, + { -- case `c < 0`: integrand is identically constant, *except* at `x = 0` if `r ≠ 0`. + apply interval_integrable.symm, + rw [interval_integrable_iff_integrable_Ioc_of_le hc.le], + have : Ioc c 0 = Ioo c 0 ∪ {(0:ℝ)}, + { rw [←Ioo_union_Icc_eq_Ioc hc (le_refl 0), ←Icc_def], + simp_rw [←le_antisymm_iff, set_of_eq_eq_singleton'] }, + rw [this, integrable_on_union, and.comm], split, + { refine integrable_on_singleton_iff.mpr (or.inr _), + exact is_finite_measure_on_compacts_of_is_locally_finite_measure.lt_top_of_is_compact + is_compact_singleton }, + { have : ∀ (x : ℝ), x ∈ Ioo c 0 → ‖complex.exp (↑π * complex.I * r)‖ = ‖(x:ℂ) ^ r‖, + { intros x hx, + rw [complex.of_real_cpow_of_nonpos hx.2.le, norm_mul, ←complex.of_real_neg, + complex.norm_eq_abs (_ ^ _), complex.abs_cpow_eq_rpow_re_of_pos (neg_pos.mpr hx.2), + ←h', rpow_zero, one_mul] }, + refine integrable_on.congr_fun _ this measurable_set_Ioo, + rw integrable_on_const, + refine or.inr ((measure_mono set.Ioo_subset_Icc_self).trans_lt _), + exact is_finite_measure_on_compacts_of_is_locally_finite_measure.lt_top_of_is_compact + is_compact_Icc } }, +end + +/-- See `interval_integrable_cpow` for a version applying to any locally finite measure, but with a +stronger hypothesis on `r`. -/ +lemma interval_integrable_cpow' {r : ℂ} (h : -1 < r.re) : + interval_integrable (λ x:ℝ, (x:ℂ) ^ r) volume a b := +begin + suffices : ∀ (c : ℝ), interval_integrable (λ x, (x : ℂ) ^ r) volume 0 c, + { exact interval_integrable.trans (this a).symm (this b) }, + have : ∀ (c : ℝ), (0 ≤ c) → interval_integrable (λ x, (x : ℂ) ^ r) volume 0 c, + { intros c hc, + rw ←interval_integrable.interval_integrable_norm_iff, + { rw interval_integrable_iff, + apply integrable_on.congr_fun, + { rw ←interval_integrable_iff, exact (interval_integral.interval_integrable_rpow' h) }, + { intros x hx, + rw uIoc_of_le hc at hx, + dsimp only, + rw [complex.norm_eq_abs, complex.abs_cpow_eq_rpow_re_of_pos hx.1] }, + { exact measurable_set_uIoc } }, + { refine continuous_on.ae_strongly_measurable _ measurable_set_uIoc, + refine continuous_at.continuous_on (λ x hx, _), + rw uIoc_of_le hc at hx, + refine (continuous_at_cpow_const (or.inl _)).comp complex.continuous_of_real.continuous_at, + rw complex.of_real_re, + exact hx.1 } }, + intro c, rcases le_total 0 c with hc | hc, + { exact this c hc }, + { rw [interval_integrable.iff_comp_neg, neg_zero], + have m := (this (-c) (by linarith)).const_mul (complex.exp (π * complex.I * r)), + rw [interval_integrable_iff, uIoc_of_le (by linarith : 0 ≤ -c)] at m ⊢, + refine m.congr_fun (λ x hx, _) measurable_set_Ioc, + dsimp only, + have : -x ≤ 0, by linarith [hx.1], + rw [complex.of_real_cpow_of_nonpos this, mul_comm], + simp } +end + @[simp] lemma interval_integrable_id : interval_integrable (λ x, x) μ a b := continuous_id.interval_integrable a b @@ -60,21 +180,6 @@ continuous_id.interval_integrable a b lemma interval_integrable_const : interval_integrable (λ x, c) μ a b := continuous_const.interval_integrable a b -@[simp] -lemma interval_integrable.const_mul (h : interval_integrable f ν a b) : - interval_integrable (λ x, c * f x) ν a b := -by convert h.smul c - -@[simp] -lemma interval_integrable.mul_const (h : interval_integrable f ν a b) : - interval_integrable (λ x, f x * c) ν a b := -by simp only [mul_comm, interval_integrable.const_mul c h] - -@[simp] -lemma interval_integrable.div (h : interval_integrable f ν a b) : - interval_integrable (λ x, f x / c) ν a b := -interval_integrable.mul_const c⁻¹ h - lemma interval_integrable_one_div (h : ∀ x : ℝ, x ∈ [a, b] → f x ≠ 0) (hf : continuous_on f [a, b]) : interval_integrable (λ x, 1 / f x) μ a b := @@ -91,7 +196,7 @@ lemma interval_integrable_exp : interval_integrable exp μ a b := continuous_exp.interval_integrable a b @[simp] -lemma interval_integrable.log +lemma _root_.interval_integrable.log (hf : continuous_on f [a, b]) (h : ∀ x : ℝ, x ∈ [a, b] → f x ≠ 0) : interval_integrable (λ x, log (f x)) μ a b := (continuous_on.log hf h).interval_integrable @@ -172,56 +277,91 @@ open interval_integral /-! ### Integrals of simple functions -/ -lemma integral_rpow {r : ℝ} (h : 0 ≤ r ∨ r ≠ -1 ∧ (0 : ℝ) ∉ [a, b]) : +lemma integral_cpow {r : ℂ} (h : -1 < r.re ∨ (r ≠ -1 ∧ (0 : ℝ) ∉ [a, b])) : + ∫ (x : ℝ) in a..b, (x : ℂ) ^ r = (b ^ (r + 1) - a ^ (r + 1)) / (r + 1) := +begin + rw sub_div, + have hr : r + 1 ≠ 0, + { cases h, + { apply_fun complex.re, + rw [complex.add_re, complex.one_re, complex.zero_re, ne.def, add_eq_zero_iff_eq_neg], + exact h.ne' }, + { rw [ne.def, ←add_eq_zero_iff_eq_neg] at h, exact h.1 } }, + by_cases hab : (0:ℝ) ∉ [a, b], + { refine integral_eq_sub_of_has_deriv_at (λ x hx, _) (interval_integrable_cpow $ or.inr hab), + refine has_deriv_at_of_real_cpow (ne_of_mem_of_not_mem hx hab) _, + contrapose! hr, rwa add_eq_zero_iff_eq_neg }, + replace h : -1 < r.re, by tauto, + suffices : ∀ (c : ℝ), ∫ (x : ℝ) in 0..c, (x : ℂ) ^ r = + c ^ (r + 1) / (r + 1) - 0 ^ (r + 1) / (r + 1), + { rw [←integral_add_adjacent_intervals (@interval_integrable_cpow' a 0 r h) + (@interval_integrable_cpow' 0 b r h), integral_symm, this a, this b, complex.zero_cpow hr], + ring }, + intro c, + apply integral_eq_sub_of_has_deriv_right, + { refine ((complex.continuous_of_real_cpow_const _).div_const _).continuous_on, + rwa [complex.add_re, complex.one_re, ←neg_lt_iff_pos_add] }, + { refine λ x hx, (has_deriv_at_of_real_cpow _ _).has_deriv_within_at, + { rcases le_total c 0 with hc | hc, + { rw max_eq_left hc at hx, exact hx.2.ne }, { rw min_eq_left hc at hx, exact hx.1.ne' } }, + { contrapose! hr, rw hr, ring } }, + { exact interval_integrable_cpow' h } +end + +lemma integral_rpow {r : ℝ} (h : -1 < r ∨ (r ≠ -1 ∧ (0 : ℝ) ∉ [a, b])) : ∫ x in a..b, x ^ r = (b ^ (r + 1) - a ^ (r + 1)) / (r + 1) := begin - suffices : ∀ x ∈ [a, b], has_deriv_at (λ x : ℝ, x ^ (r + 1) / (r + 1)) (x ^ r) x, - { rw sub_div, - exact integral_eq_sub_of_has_deriv_at this (interval_integrable_rpow (h.imp_right and.right)) }, - intros x hx, - have hx' : x ≠ 0 ∨ 1 ≤ r + 1, - from h.symm.imp (λ h, ne_of_mem_of_not_mem hx h.2) (le_add_iff_nonneg_left _).2, - convert (real.has_deriv_at_rpow_const hx').div_const (r + 1), - rw [add_sub_cancel, mul_div_cancel_left], - rw [ne.def, ← eq_neg_iff_add_eq_zero], - rintro rfl, - apply (@zero_lt_one ℝ _ _).not_le, - simpa using h + have h' : -1 < (r:ℂ).re ∨ (r:ℂ) ≠ -1 ∧ (0:ℝ) ∉ [a, b], + { cases h, + { left, rwa complex.of_real_re }, + { right, rwa [←complex.of_real_one, ←complex.of_real_neg, ne.def, complex.of_real_inj] } }, + have : ∫ x in a..b, (x:ℂ) ^ (r :ℂ) = ((b:ℂ) ^ (r + 1 : ℂ) - (a:ℂ) ^ (r + 1 : ℂ)) / (r + 1), + from integral_cpow h', + apply_fun complex.re at this, convert this, + { simp_rw [interval_integral_eq_integral_uIoc, complex.real_smul, complex.of_real_mul_re], + { change complex.re with is_R_or_C.re, + rw ←integral_re, refl, + refine interval_integrable_iff.mp _, + cases h', + { exact interval_integrable_cpow' h' }, { exact interval_integrable_cpow (or.inr h'.2) } } }, + { rw (by push_cast : ((r:ℂ) + 1) = ((r + 1 : ℝ) : ℂ)), + simp_rw [div_eq_inv_mul, ←complex.of_real_inv, complex.of_real_mul_re, complex.sub_re], + refl } end lemma integral_zpow {n : ℤ} (h : 0 ≤ n ∨ n ≠ -1 ∧ (0 : ℝ) ∉ [a, b]) : ∫ x in a..b, x ^ n = (b ^ (n + 1) - a ^ (n + 1)) / (n + 1) := begin - replace h : 0 ≤ (n : ℝ) ∨ (n : ℝ) ≠ -1 ∧ (0 : ℝ) ∉ [a, b], by exact_mod_cast h, - exact_mod_cast integral_rpow h + replace h : -1 < (n : ℝ) ∨ (n : ℝ) ≠ -1 ∧ (0 : ℝ) ∉ [a, b], by exact_mod_cast h, + exact_mod_cast integral_rpow h, end @[simp] lemma integral_pow : ∫ x in a..b, x ^ n = (b ^ (n + 1) - a ^ (n + 1)) / (n + 1) := -by simpa using integral_zpow (or.inl (int.coe_nat_nonneg n)) +by simpa only [←int.coe_nat_succ, zpow_coe_nat] using integral_zpow (or.inl (int.coe_nat_nonneg n)) /-- Integral of `|x - a| ^ n` over `Ι a b`. This integral appears in the proof of the Picard-Lindelöf/Cauchy-Lipschitz theorem. -/ -lemma integral_pow_abs_sub_interval_oc : +lemma integral_pow_abs_sub_uIoc : ∫ x in Ι a b, |x - a| ^ n = |b - a| ^ (n + 1) / (n + 1) := begin cases le_or_lt a b with hab hab, { calc ∫ x in Ι a b, |x - a| ^ n = ∫ x in a..b, |x - a| ^ n : - by rw [interval_oc_of_le hab, ← integral_of_le hab] + by rw [uIoc_of_le hab, ← integral_of_le hab] ... = ∫ x in 0..(b - a), x ^ n : begin simp only [integral_comp_sub_right (λ x, |x| ^ n), sub_self], refine integral_congr (λ x hx, congr_arg2 has_pow.pow (abs_of_nonneg $ _) rfl), - rw interval_of_le (sub_nonneg.2 hab) at hx, + rw uIcc_of_le (sub_nonneg.2 hab) at hx, exact hx.1 end ... = |b - a| ^ (n + 1) / (n + 1) : by simp [abs_of_nonneg (sub_nonneg.2 hab)] }, { calc ∫ x in Ι a b, |x - a| ^ n = ∫ x in b..a, |x - a| ^ n : - by rw [interval_oc_of_lt hab, ← integral_of_le hab.le] + by rw [uIoc_of_lt hab, ← integral_of_le hab.le] ... = ∫ x in b - a..0, (-x) ^ n : begin simp only [integral_comp_sub_right (λ x, |x| ^ n), sub_self], refine integral_congr (λ x hx, congr_arg2 has_pow.pow (abs_of_nonpos $ _) rfl), - rw interval_of_le (sub_nonpos.2 hab.le) at hx, + rw uIcc_of_le (sub_nonpos.2 hab.le) at hx, exact hx.2 end ... = |b - a| ^ (n + 1) / (n + 1) : @@ -236,22 +376,25 @@ by simpa using integral_pow 1 lemma integral_one : ∫ x in a..b, (1 : ℝ) = b - a := by simp only [mul_one, smul_eq_mul, integral_const] +lemma integral_const_on_unit_interval : ∫ x in a..(a + 1), b = b := +by simp + @[simp] lemma integral_inv (h : (0:ℝ) ∉ [a, b]) : ∫ x in a..b, x⁻¹ = log (b / a) := begin have h' := λ x hx, ne_of_mem_of_not_mem hx h, rw [integral_deriv_eq_sub' _ deriv_log' (λ x hx, differentiable_at_log (h' x hx)) (continuous_on_inv₀.mono $ subset_compl_singleton_iff.mpr h), - log_div (h' b right_mem_interval) (h' a left_mem_interval)], + log_div (h' b right_mem_uIcc) (h' a left_mem_uIcc)], end @[simp] lemma integral_inv_of_pos (ha : 0 < a) (hb : 0 < b) : ∫ x in a..b, x⁻¹ = log (b / a) := -integral_inv $ not_mem_interval_of_lt ha hb +integral_inv $ not_mem_uIcc_of_lt ha hb @[simp] lemma integral_inv_of_neg (ha : a < 0) (hb : b < 0) : ∫ x in a..b, x⁻¹ = log (b / a) := -integral_inv $ not_mem_interval_of_gt ha hb +integral_inv $ not_mem_uIcc_of_gt ha hb lemma integral_one_div (h : (0:ℝ) ∉ [a, b]) : ∫ x : ℝ in a..b, 1/x = log (b / a) := by simp only [one_div, integral_inv h] @@ -266,6 +409,19 @@ by simp only [one_div, integral_inv_of_neg ha hb] lemma integral_exp : ∫ x in a..b, exp x = exp b - exp a := by rw integral_deriv_eq_sub'; norm_num [continuous_on_exp] +lemma integral_exp_mul_complex {c : ℂ} (hc : c ≠ 0) : + ∫ x in a..b, complex.exp (c * x) = (complex.exp (c * b) - complex.exp (c * a)) / c := +begin + have D : ∀ (x : ℝ), has_deriv_at (λ (y : ℝ), complex.exp (c * y) / c) (complex.exp (c * x)) x, + { intro x, + conv { congr, skip, rw ←mul_div_cancel (complex.exp (c * x)) hc, }, + convert ((complex.has_deriv_at_exp _).comp x _).div_const c using 1, + simpa only [mul_one] using ((has_deriv_at_id (x:ℂ)).const_mul _).comp_of_real, }, + rw integral_deriv_eq_sub' _ (funext (λ x, (D x).deriv)) (λ x hx, (D x).differentiable_at), + { ring_nf }, + { apply continuous.continuous_on, continuity,} +end + @[simp] lemma integral_log (h : (0:ℝ) ∉ [a, b]) : ∫ x in a..b, log x = b * log b - a * log a - b + a := @@ -281,12 +437,12 @@ end @[simp] lemma integral_log_of_pos (ha : 0 < a) (hb : 0 < b) : ∫ x in a..b, log x = b * log b - a * log a - b + a := -integral_log $ not_mem_interval_of_lt ha hb +integral_log $ not_mem_uIcc_of_lt ha hb @[simp] lemma integral_log_of_neg (ha : a < 0) (hb : b < 0) : ∫ x in a..b, log x = b * log b - a * log a - b + a := -integral_log $ not_mem_interval_of_gt ha hb +integral_log $ not_mem_uIcc_of_gt ha hb @[simp] lemma integral_sin : ∫ x in a..b, sin x = cos a - cos b := @@ -296,6 +452,22 @@ by rw integral_deriv_eq_sub' (λ x, -cos x); norm_num [continuous_on_sin] lemma integral_cos : ∫ x in a..b, cos x = sin b - sin a := by rw integral_deriv_eq_sub'; norm_num [continuous_on_cos] +lemma integral_cos_mul_complex {z : ℂ} (hz : z ≠ 0) (a b : ℝ) : + ∫ x in a..b, complex.cos (z * x) = complex.sin (z * b) / z - complex.sin (z * a) / z := +begin + apply integral_eq_sub_of_has_deriv_at, + swap, + { apply continuous.interval_integrable, + exact complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real) }, + intros x hx, + have a := complex.has_deriv_at_sin (↑x * z), + have b : has_deriv_at (λ y, y * z : ℂ → ℂ) z ↑x := has_deriv_at_mul_const _, + have c : has_deriv_at (λ (y : ℂ), complex.sin (y * z)) _ ↑x := has_deriv_at.comp x a b, + convert has_deriv_at.comp_of_real (c.div_const z), + { simp_rw mul_comm }, + { rw [mul_div_cancel _ hz, mul_comm] }, +end + lemma integral_cos_sq_sub_sin_sq : ∫ x in a..b, cos x ^ 2 - sin x ^ 2 = sin b * cos b - sin a * cos a := by simpa only [sq, sub_eq_add_neg, neg_mul_eq_mul_neg] using integral_deriv_mul_eq_sub @@ -316,6 +488,60 @@ end lemma integral_one_div_one_add_sq : ∫ x : ℝ in a..b, 1 / (1 + x^2) = arctan b - arctan a := by simp only [one_div, integral_inv_one_add_sq] +section rpow_cpow +open complex + +lemma integral_mul_cpow_one_add_sq {t : ℂ} (ht : t ≠ -1) : + ∫ x : ℝ in a..b, (x:ℂ) * (1 + x ^ 2) ^ t = + (1 + b ^ 2) ^ (t + 1) / (2 * (t + 1)) - (1 + a ^ 2) ^ (t + 1) / (2 * (t + 1)) := +begin + have : t + 1 ≠ 0 := by { contrapose! ht, rwa add_eq_zero_iff_eq_neg at ht }, + apply integral_eq_sub_of_has_deriv_at, + { intros x hx, + have f : has_deriv_at (λ y:ℂ, 1 + y ^ 2) (2 * x) x, + { convert (has_deriv_at_pow 2 (x:ℂ)).const_add 1, { norm_cast }, { simp } }, + have g : ∀ {z : ℂ}, (0 < z.re) → has_deriv_at (λ z, z ^ (t + 1) / (2 * (t + 1))) (z ^ t / 2) z, + { intros z hz, + have : z ≠ 0 := by { contrapose! hz, rw [hz, zero_re], }, + convert (has_deriv_at.cpow_const (has_deriv_at_id _) (or.inl hz)).div_const + (2 * (t + 1)) using 1, + field_simp, + ring }, + convert (has_deriv_at.comp ↑x (g _) f).comp_of_real using 1, + { field_simp, ring }, + { rw [add_re, one_re, ←of_real_pow, of_real_re], + exact (add_pos_of_pos_of_nonneg zero_lt_one (sq_nonneg x)) } }, + { apply continuous.interval_integrable, + refine continuous_of_real.mul _, + apply continuous.cpow, + { exact continuous_const.add (continuous_of_real.pow 2)}, + { exact continuous_const }, + { intro a, + rw [add_re, one_re, ←of_real_pow, of_real_re], + exact or.inl (add_pos_of_pos_of_nonneg zero_lt_one (sq_nonneg a)) } } +end + +lemma integral_mul_rpow_one_add_sq {t : ℝ} (ht : t ≠ -1) : + ∫ x : ℝ in a..b, x * (1 + x ^ 2) ^ t = + (1 + b ^ 2) ^ (t + 1) / (2 * (t + 1)) - (1 + a ^ 2) ^ (t + 1) / (2 * (t + 1)) := +begin + have : ∀ (x s : ℝ), (((1 + x ^ 2) ^ s : ℝ) : ℂ) = (1 + (x : ℂ) ^ 2) ^ ↑s, + { intros x s, + rw [of_real_cpow, of_real_add, of_real_pow, of_real_one], + exact add_nonneg zero_le_one (sq_nonneg x), }, + rw ←of_real_inj, + convert integral_mul_cpow_one_add_sq (_ : (t:ℂ) ≠ -1), + { rw ←interval_integral.integral_of_real, + congr' with x:1, + rw [of_real_mul, this x t] }, + { simp_rw [of_real_sub, of_real_div, this a (t + 1), this b (t + 1)], + push_cast }, + { rw [←of_real_one, ←of_real_neg, ne.def, of_real_inj], + exact ht }, +end + +end rpow_cpow + /-! ### Integral of `sin x ^ n` -/ lemma integral_sin_pow_aux : @@ -323,9 +549,9 @@ lemma integral_sin_pow_aux : + (n + 1) * (∫ x in a..b, sin x ^ n) - (n + 1) * ∫ x in a..b, sin x ^ (n + 2) := begin let C := sin a ^ (n + 1) * cos a - sin b ^ (n + 1) * cos b, - have h : ∀ α β γ : ℝ, α * (β * α * γ) = β * (α * α * γ) := λ α β γ, by ring, - have hu : ∀ x ∈ _, has_deriv_at (λ y, sin y ^ (n + 1)) ((n + 1) * cos x * sin x ^ n) x := - λ x hx, by simpa only [mul_right_comm] using (has_deriv_at_sin x).pow, + have h : ∀ α β γ : ℝ, (β * α * γ) * α = β * (α * α * γ) := λ α β γ, by ring, + have hu : ∀ x ∈ _, has_deriv_at (λ y, sin y ^ (n + 1)) ((n + 1 : ℕ) * cos x * sin x ^ n) x := + λ x hx, by simpa only [mul_right_comm] using (has_deriv_at_sin x).pow (n+1), have hv : ∀ x ∈ [a, b], has_deriv_at (-cos) (sin x) x := λ x hx, by simpa only [neg_neg] using (has_deriv_at_cos x).neg, have H := integral_mul_deriv_eq_deriv_mul hu hv _ _, @@ -395,10 +621,10 @@ lemma integral_cos_pow_aux : + (n + 1) * (∫ x in a..b, cos x ^ n) - (n + 1) * ∫ x in a..b, cos x ^ (n + 2) := begin let C := cos b ^ (n + 1) * sin b - cos a ^ (n + 1) * sin a, - have h : ∀ α β γ : ℝ, α * (β * α * γ) = β * (α * α * γ) := λ α β γ, by ring, - have hu : ∀ x ∈ _, has_deriv_at (λ y, cos y ^ (n + 1)) (-(n + 1) * sin x * cos x ^ n) x := + have h : ∀ α β γ : ℝ, (β * α * γ) * α = β * (α * α * γ) := λ α β γ, by ring, + have hu : ∀ x ∈ _, has_deriv_at (λ y, cos y ^ (n + 1)) (-(n + 1 : ℕ) * sin x * cos x ^ n) x := λ x hx, by simpa only [mul_right_comm, neg_mul, mul_neg] - using (has_deriv_at_cos x).pow, + using (has_deriv_at_cos x).pow (n+1), have hv : ∀ x ∈ [a, b], has_deriv_at sin (cos x) x := λ x hx, has_deriv_at_sin x, have H := integral_mul_deriv_eq_deriv_mul hu hv _ _, calc ∫ x in a..b, cos x ^ (n + 2) diff --git a/src/analysis/special_functions/japanese_bracket.lean b/src/analysis/special_functions/japanese_bracket.lean new file mode 100644 index 0000000000000..6108b5d232139 --- /dev/null +++ b/src/analysis/special_functions/japanese_bracket.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2022 Moritz Doll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Doll +-/ +import measure_theory.measure.lebesgue.eq_haar +import measure_theory.integral.layercake + +/-! +# Japanese Bracket + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we show that Japanese bracket $(1 + \|x\|^2)^{1/2}$ can be estimated from above +and below by $1 + \|x\|$. +The functions $(1 + \|x\|^2)^{-r/2}$ and $(1 + |x|)^{-r}$ are integrable provided that `r` is larger +than the dimension. + +## Main statements + +* `integrable_one_add_norm`: the function $(1 + |x|)^{-r}$ is integrable +* `integrable_jap` the Japanese bracket is integrable + +-/ + + +noncomputable theory + +open_locale big_operators nnreal filter topology ennreal + +open asymptotics filter set real measure_theory finite_dimensional + +variables {E : Type*} [normed_add_comm_group E] + +lemma sqrt_one_add_norm_sq_le (x : E) : real.sqrt (1 + ‖x‖^2) ≤ 1 + ‖x‖ := +begin + refine le_of_pow_le_pow 2 (by positivity) two_pos _, + simp [sq_sqrt (zero_lt_one_add_norm_sq x).le, add_pow_two], +end + +lemma one_add_norm_le_sqrt_two_mul_sqrt (x : E) : 1 + ‖x‖ ≤ (real.sqrt 2) * sqrt (1 + ‖x‖^2) := +begin + suffices : (sqrt 2 * sqrt (1 + ‖x‖ ^ 2)) ^ 2 - (1 + ‖x‖) ^ 2 = (1 - ‖x‖) ^2, + { refine le_of_pow_le_pow 2 (by positivity) (by norm_num) _, + rw [←sub_nonneg, this], + positivity, }, + rw [mul_pow, sq_sqrt (zero_lt_one_add_norm_sq x).le, add_pow_two, sub_pow_two], + norm_num, + ring, +end + +lemma rpow_neg_one_add_norm_sq_le {r : ℝ} (x : E) (hr : 0 < r) : + (1 + ‖x‖^2)^(-r/2) ≤ 2^(r/2) * (1 + ‖x‖)^(-r) := +begin + have h1 : 0 ≤ (2 : ℝ) := by positivity, + have h3 : 0 < sqrt 2 := by positivity, + have h4 : 0 < 1 + ‖x‖ := by positivity, + have h5 : 0 < sqrt (1 + ‖x‖ ^ 2) := by positivity, + have h6 : 0 < sqrt 2 * sqrt (1 + ‖x‖^2) := mul_pos h3 h5, + rw [rpow_div_two_eq_sqrt _ h1, rpow_div_two_eq_sqrt _ (zero_lt_one_add_norm_sq x).le, + ←inv_mul_le_iff (rpow_pos_of_pos h3 _), rpow_neg h4.le, rpow_neg (sqrt_nonneg _), ←mul_inv, + ←mul_rpow h3.le h5.le, inv_le_inv (rpow_pos_of_pos h6 _) (rpow_pos_of_pos h4 _), + rpow_le_rpow_iff h4.le h6.le hr], + exact one_add_norm_le_sqrt_two_mul_sqrt _, +end + +lemma le_rpow_one_add_norm_iff_norm_le {r t : ℝ} (hr : 0 < r) (ht : 0 < t) (x : E) : + t ≤ (1 + ‖x‖) ^ -r ↔ ‖x‖ ≤ t ^ -r⁻¹ - 1 := +begin + rw [le_sub_iff_add_le', neg_inv], + exact (real.le_rpow_inv_iff_of_neg (by positivity) ht (neg_lt_zero.mpr hr)).symm, +end + +variables (E) + +lemma closed_ball_rpow_sub_one_eq_empty_aux {r t : ℝ} (hr : 0 < r) (ht : 1 < t) : + metric.closed_ball (0 : E) (t^(-r⁻¹) - 1) = ∅ := +begin + rw [metric.closed_ball_eq_empty, sub_neg], + exact real.rpow_lt_one_of_one_lt_of_neg ht (by simp only [hr, right.neg_neg_iff, inv_pos]), +end + +variables [normed_space ℝ E] [finite_dimensional ℝ E] + +variables {E} + +lemma finite_integral_rpow_sub_one_pow_aux {r : ℝ} (n : ℕ) (hnr : (n : ℝ) < r) : + ∫⁻ (x : ℝ) in Ioc 0 1, ennreal.of_real ((x ^ -r⁻¹ - 1) ^ n) < ∞ := +begin + have hr : 0 < r := lt_of_le_of_lt n.cast_nonneg hnr, + have h_int : ∀ (x : ℝ) (hx : x ∈ Ioc (0 : ℝ) 1), + ennreal.of_real ((x ^ -r⁻¹ - 1) ^ n) ≤ ennreal.of_real (x ^ -(r⁻¹ * n)) := + begin + intros x hx, + have hxr : 0 ≤ x^ -r⁻¹ := rpow_nonneg_of_nonneg hx.1.le _, + apply ennreal.of_real_le_of_real, + rw [←neg_mul, rpow_mul hx.1.le, rpow_nat_cast], + refine pow_le_pow_of_le_left _ (by simp only [sub_le_self_iff, zero_le_one]) n, + rw [le_sub_iff_add_le', add_zero], + refine real.one_le_rpow_of_pos_of_le_one_of_nonpos hx.1 hx.2 _, + rw [right.neg_nonpos_iff, inv_nonneg], + exact hr.le, + end, + refine lt_of_le_of_lt (set_lintegral_mono (by measurability) (by measurability) h_int) _, + refine integrable_on.set_lintegral_lt_top _, + rw ←interval_integrable_iff_integrable_Ioc_of_le zero_le_one, + apply interval_integral.interval_integrable_rpow', + rwa [neg_lt_neg_iff, inv_mul_lt_iff' hr, one_mul], +end + +lemma finite_integral_one_add_norm [measure_space E] [borel_space E] + [(@volume E _).is_add_haar_measure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) : + ∫⁻ (x : E), ennreal.of_real ((1 + ‖x‖) ^ -r) < ∞ := +begin + have hr : 0 < r := lt_of_le_of_lt (finrank ℝ E).cast_nonneg hnr, + + -- We start by applying the layer cake formula + have h_meas : measurable (λ (ω : E), (1 + ‖ω‖) ^ -r) := by measurability, + have h_pos : ∀ x : E, 0 ≤ (1 + ‖x‖) ^ -r := + by { intros x, positivity }, + rw lintegral_eq_lintegral_meas_le volume h_pos h_meas, + + -- We use the first transformation of the integrant to show that we only have to integrate from + -- 0 to 1 and from 1 to ∞ + have h_int : ∀ (t : ℝ) (ht : t ∈ Ioi (0 : ℝ)), + (volume {a : E | t ≤ (1 + ‖a‖) ^ -r} : ennreal) = + volume (metric.closed_ball (0 : E) (t^(-r⁻¹) - 1)) := + begin + intros t ht, + congr' 1, + ext x, + simp only [mem_set_of_eq, mem_closed_ball_zero_iff], + exact le_rpow_one_add_norm_iff_norm_le hr (mem_Ioi.mp ht) x, + end, + rw set_lintegral_congr_fun measurable_set_Ioi (ae_of_all volume $ h_int), + have hIoi_eq : Ioi (0 : ℝ) = Ioc (0 : ℝ) 1 ∪ Ioi 1 := (set.Ioc_union_Ioi_eq_Ioi zero_le_one).symm, + have hdisjoint : disjoint (Ioc (0 : ℝ) 1) (Ioi 1) := by simp [disjoint_iff], + rw [hIoi_eq, lintegral_union measurable_set_Ioi hdisjoint, ennreal.add_lt_top], + + have h_int' : ∀ (t : ℝ) (ht : t ∈ Ioc (0 : ℝ) 1), + (volume (metric.closed_ball (0 : E) (t^(-r⁻¹) - 1)) : ennreal) = + ennreal.of_real ((t^(-r⁻¹) - 1) ^ finite_dimensional.finrank ℝ E) + * volume (metric.ball (0:E) 1) := + begin + intros t ht, + refine volume.add_haar_closed_ball (0 : E) _, + rw [le_sub_iff_add_le', add_zero], + exact real.one_le_rpow_of_pos_of_le_one_of_nonpos ht.1 ht.2 (by simp [hr.le]), + end, + have h_meas' : measurable (λ (a : ℝ), ennreal.of_real ((a ^ -r⁻¹ - 1) ^ finrank ℝ E)) := + by measurability, + split, + -- The integral from 0 to 1: + { rw [set_lintegral_congr_fun measurable_set_Ioc (ae_of_all volume $ h_int'), + lintegral_mul_const _ h_meas', ennreal.mul_lt_top_iff], + left, + -- We calculate the integral + exact ⟨finite_integral_rpow_sub_one_pow_aux (finrank ℝ E) hnr, measure_ball_lt_top⟩ }, + + -- The integral from 1 to ∞ is zero: + have h_int'' : ∀ (t : ℝ) (ht : t ∈ Ioi (1 : ℝ)), + (volume (metric.closed_ball (0 : E) (t^(-r⁻¹) - 1)) : ennreal) = 0 := + λ t ht, by rw [closed_ball_rpow_sub_one_eq_empty_aux E hr ht, measure_empty], + + -- The integral over the constant zero function is finite: + rw [set_lintegral_congr_fun measurable_set_Ioi (ae_of_all volume $ h_int''), lintegral_const 0, + zero_mul], + exact with_top.zero_lt_top, +end + +lemma integrable_one_add_norm [measure_space E] [borel_space E] [(@volume E _).is_add_haar_measure] + {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) : + integrable (λ (x : E), (1 + ‖x‖) ^ -r) := +begin + refine ⟨by measurability, _⟩, + -- Lower Lebesgue integral + have : ∫⁻ (a : E), ‖(1 + ‖a‖) ^ -r‖₊ = ∫⁻ (a : E), ennreal.of_real ((1 + ‖a‖) ^ -r) := + lintegral_nnnorm_eq_of_nonneg (λ _, rpow_nonneg_of_nonneg (by positivity) _), + rw [has_finite_integral, this], + exact finite_integral_one_add_norm hnr, +end + +lemma integrable_rpow_neg_one_add_norm_sq [measure_space E] [borel_space E] + [(@volume E _).is_add_haar_measure] {r : ℝ} (hnr : (finrank ℝ E : ℝ) < r) : + integrable (λ (x : E), (1 + ‖x‖^2) ^ (-r/2)) := +begin + have hr : 0 < r := lt_of_le_of_lt (finrank ℝ E).cast_nonneg hnr, + refine ((integrable_one_add_norm hnr).const_mul $ 2 ^ (r / 2)).mono (by measurability) + (eventually_of_forall $ λ x, _), + have h1 : 0 ≤ (1 + ‖x‖ ^ 2) ^ (-r/2) := by positivity, + have h2 : 0 ≤ (1 + ‖x‖) ^ -r := by positivity, + have h3 : 0 ≤ (2 : ℝ)^(r/2) := by positivity, + simp_rw [norm_mul, norm_eq_abs, abs_of_nonneg h1, abs_of_nonneg h2, abs_of_nonneg h3], + exact rpow_neg_one_add_norm_sq_le _ hr, +end diff --git a/src/analysis/special_functions/log/base.lean b/src/analysis/special_functions/log/base.lean index 498abcd8cd450..b7a3e10678ea8 100644 --- a/src/analysis/special_functions/log/base.lean +++ b/src/analysis/special_functions/log/base.lean @@ -3,18 +3,21 @@ Copyright (c) 2022 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bolton Bailey, Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne -/ -import analysis.special_functions.log.basic -import analysis.special_functions.pow +import analysis.special_functions.pow.real +import data.int.log /-! # Real logarithm base `b` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `real.logb` to be the logarithm of a real number in a given base `b`. We define this as the division of the natural logarithms of the argument and the base, so that we have a globally defined function with `logb b 0 = 0`, `logb b (-x) = logb b x` `logb 0 x = 0` and `logb (-b) x = logb b x`. -We prove some basic properties of this function and it's relation to `rpow`. +We prove some basic properties of this function and its relation to `rpow`. ## Tags @@ -22,7 +25,7 @@ logarithm, continuity -/ open set filter function -open_locale topological_space +open_locale topology noncomputable theory namespace real @@ -52,6 +55,39 @@ by simp_rw [logb, log_div hx hy, sub_div] @[simp] lemma logb_inv (x : ℝ) : logb b (x⁻¹) = -logb b x := by simp [logb, neg_div] +lemma inv_logb (a b : ℝ) : (logb a b)⁻¹ = logb b a := by simp_rw [logb, inv_div] + +theorem inv_logb_mul_base {a b : ℝ} (h₁ : a ≠ 0) (h₂ : b ≠ 0) (c : ℝ) : + (logb (a * b) c)⁻¹ = (logb a c)⁻¹ + (logb b c)⁻¹ := +by simp_rw inv_logb; exact logb_mul h₁ h₂ + +theorem inv_logb_div_base {a b : ℝ} (h₁ : a ≠ 0) (h₂ : b ≠ 0) (c : ℝ) : + (logb (a / b) c)⁻¹ = (logb a c)⁻¹ - (logb b c)⁻¹ := +by simp_rw inv_logb; exact logb_div h₁ h₂ + +theorem logb_mul_base {a b : ℝ} (h₁ : a ≠ 0) (h₂ : b ≠ 0) (c : ℝ) : + logb (a * b) c = ((logb a c)⁻¹ + (logb b c)⁻¹)⁻¹ := +by rw [←inv_logb_mul_base h₁ h₂ c, inv_inv] + +theorem logb_div_base {a b : ℝ} (h₁ : a ≠ 0) (h₂ : b ≠ 0) (c : ℝ) : + logb (a / b) c = ((logb a c)⁻¹ - (logb b c)⁻¹)⁻¹ := +by rw [←inv_logb_div_base h₁ h₂ c, inv_inv] + +theorem mul_logb {a b c : ℝ} (h₁ : b ≠ 0) (h₂ : b ≠ 1) (h₃ : b ≠ -1) : + logb a b * logb b c = logb a c := +begin + unfold logb, + rw [mul_comm, div_mul_div_cancel _ (log_ne_zero.mpr ⟨h₁, h₂, h₃⟩)], +end + +theorem div_logb {a b c : ℝ} (h₁ : c ≠ 0) (h₂ : c ≠ 1) (h₃ : c ≠ -1) : + logb a c / logb b c = logb a b := +begin + unfold logb, + -- TODO: div_div_div_cancel_left is missing for `group_with_zero`, + rw [div_div_div_eq, mul_comm, mul_div_mul_right _ _ (log_ne_zero.mpr ⟨h₁, h₂, h₃⟩)], +end + section b_pos_and_ne_one variable (b_pos : 0 < b) @@ -291,6 +327,32 @@ end end b_pos_and_b_lt_one +lemma floor_logb_nat_cast {b : ℕ} {r : ℝ} (hb : 1 < b) (hr : 0 ≤ r) : ⌊logb b r⌋ = int.log b r := +begin + obtain rfl | hr := hr.eq_or_lt, + { rw [logb_zero, int.log_zero_right, int.floor_zero] }, + have hb1' : 1 < (b : ℝ) := nat.one_lt_cast.mpr hb, + apply le_antisymm, + { rw [←int.zpow_le_iff_le_log hb hr, ←rpow_int_cast b], + refine le_of_le_of_eq _ (rpow_logb (zero_lt_one.trans hb1') hb1'.ne' hr), + exact rpow_le_rpow_of_exponent_le hb1'.le (int.floor_le _) }, + { rw [int.le_floor, le_logb_iff_rpow_le hb1' hr, rpow_int_cast], + exact int.zpow_log_le_self hb hr } +end + +lemma ceil_logb_nat_cast {b : ℕ} {r : ℝ} (hb : 1 < b) (hr : 0 ≤ r) : ⌈logb b r⌉ = int.clog b r := +begin + obtain rfl | hr := hr.eq_or_lt, + { rw [logb_zero, int.clog_zero_right, int.ceil_zero] }, + have hb1' : 1 < (b : ℝ) := nat.one_lt_cast.mpr hb, + apply le_antisymm, + { rw [int.ceil_le, logb_le_iff_le_rpow hb1' hr, rpow_int_cast], + refine int.self_le_zpow_clog hb r }, + { rw [←int.le_zpow_iff_clog_le hb hr, ←rpow_int_cast b], + refine (rpow_logb (zero_lt_one.trans hb1') hb1'.ne' hr).symm.trans_le _, + exact rpow_le_rpow_of_exponent_le hb1'.le (int.le_ceil _) }, +end + @[simp] lemma logb_eq_zero : logb b x = 0 ↔ b = 0 ∨ b = 1 ∨ b = -1 ∨ x = 0 ∨ x = 1 ∨ x = -1 := begin diff --git a/src/analysis/special_functions/log/basic.lean b/src/analysis/special_functions/log/basic.lean index 9dd6c92a4169e..da7392ce78e95 100644 --- a/src/analysis/special_functions/log/basic.lean +++ b/src/analysis/special_functions/log/basic.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne -/ import analysis.special_functions.exp +import data.nat.factorization.basic /-! # Real logarithm +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `real.log` to be the logarithm of a real number. As usual, we extend it from its domain `(0, +∞)` to a globally defined function. We choose to do it so that `log 0 = 0` and `log (-x) = log x`. @@ -20,7 +24,7 @@ logarithm, continuity -/ open set filter function -open_locale topological_space +open_locale topology noncomputable theory namespace real @@ -48,6 +52,12 @@ by { rw exp_log_eq_abs hx.ne', exact abs_of_pos hx } lemma exp_log_of_neg (hx : x < 0) : exp (log x) = -x := by { rw exp_log_eq_abs (ne_of_lt hx), exact abs_of_neg hx } +lemma le_exp_log (x : ℝ) : x ≤ exp (log x) := +begin + by_cases h_zero : x = 0, + { rw [h_zero, log, dif_pos rfl, exp_zero], exact zero_le_one, }, + { rw exp_log_eq_abs h_zero, exact le_abs_self _, }, +end @[simp] lemma log_exp (x : ℝ) : log (exp x) = x := exp_injective $ exp_log (exp_pos x) @@ -75,6 +85,12 @@ end @[simp] lemma log_neg_eq_log (x : ℝ) : log (-x) = log x := by rw [← log_abs x, ← log_abs (-x), abs_neg] +lemma sinh_log {x : ℝ} (hx : 0 < x) : sinh (log x) = (x - x⁻¹) / 2 := +by rw [sinh_eq, exp_neg, exp_log hx] + +lemma cosh_log {x : ℝ} (hx : 0 < x) : cosh (log x) = (x + x⁻¹) / 2 := +by rw [cosh_eq, exp_neg, exp_log hx] + lemma surj_on_log' : surj_on log (Iio 0) univ := λ x _, ⟨-exp x, neg_lt_zero.2 $ exp_pos x, by rw [log_neg_eq_log, log_exp]⟩ @@ -153,6 +169,14 @@ end lemma log_inj_on_pos : set.inj_on log (set.Ioi 0) := strict_mono_on_log.inj_on +lemma log_lt_sub_one_of_pos (hx1 : 0 < x) (hx2 : x ≠ 1) : log x < x - 1 := +begin + have h : log x ≠ 0, + { rw [← log_one, log_inj_on_pos.ne_iff hx1 zero_lt_one], + exact hx2 }, + linarith [add_one_lt_exp_of_nonzero h, exp_log hx1], +end + lemma eq_one_of_pos_of_log_eq_zero {x : ℝ} (h₁ : 0 < x) (h₂ : log x = 0) : x = 1 := log_inj_on_pos (set.mem_Ioi.2 h₁) (set.mem_Ioi.2 zero_lt_one) (h₂.trans real.log_one.symm) @@ -164,14 +188,17 @@ begin split, { intros h, rcases lt_trichotomy x 0 with x_lt_zero | rfl | x_gt_zero, - { refine or.inr (or.inr (eq_neg_iff_eq_neg.mp _)), + { refine or.inr (or.inr (neg_eq_iff_eq_neg.mp _)), rw [←log_neg_eq_log x] at h, - exact (eq_one_of_pos_of_log_eq_zero (neg_pos.mpr x_lt_zero) h).symm, }, + exact eq_one_of_pos_of_log_eq_zero (neg_pos.mpr x_lt_zero) h, }, { exact or.inl rfl }, { exact or.inr (or.inl (eq_one_of_pos_of_log_eq_zero x_gt_zero h)), }, }, { rintro (rfl|rfl|rfl); simp only [log_one, log_zero, log_neg_eq_log], } end +lemma log_ne_zero {x : ℝ} : log x ≠ 0 ↔ x ≠ 0 ∧ x ≠ 1 ∧ x ≠ -1 := +by simpa only [not_or_distrib] using log_eq_zero.not + @[simp] lemma log_pow (x : ℝ) (n : ℕ) : log (x ^ n) = n * log x := begin induction n with n ih, @@ -189,6 +216,9 @@ begin neg_mul_eq_neg_mul], end +lemma log_sqrt {x : ℝ} (hx : 0 ≤ x) : log (sqrt x) = log x / 2 := +by { rw [eq_div_iff, mul_comm, ← nat.cast_two, ← log_pow, sq_sqrt hx], exact two_ne_zero } + lemma log_le_sub_one_of_pos {x : ℝ} (hx : 0 < x) : log x ≤ x - 1 := begin rw le_sub_iff_add_le, @@ -224,7 +254,7 @@ lemma continuous_on_log : continuous_on log {0}ᶜ := begin rw [continuous_on_iff_continuous_restrict, restrict], conv in (log _) { rw [log_of_ne_zero (show (x : ℝ) ≠ 0, from x.2)] }, - exact exp_order_iso.symm.continuous.comp (continuous_subtype_mk _ continuous_subtype_coe.norm) + exact exp_order_iso.symm.continuous.comp (continuous_subtype_coe.norm.subtype_mk _) end @[continuity] lemma continuous_log : continuous (λ x : {x : ℝ // x ≠ 0}, log x) := @@ -249,11 +279,21 @@ open_locale big_operators lemma log_prod {α : Type*} (s : finset α) (f : α → ℝ) (hf : ∀ x ∈ s, f x ≠ 0): log (∏ i in s, f i) = ∑ i in s, log (f i) := begin - classical, - induction s using finset.induction_on with a s ha ih, + induction s using finset.cons_induction_on with a s ha ih, { simp }, - simp only [finset.mem_insert, forall_eq_or_imp] at hf, - simp [ha, ih hf.2, log_mul hf.1 (finset.prod_ne_zero_iff.2 hf.2)], + { rw [finset.forall_mem_cons] at hf, + simp [ih hf.2, log_mul hf.1 (finset.prod_ne_zero_iff.2 hf.2)] } +end + +lemma log_nat_eq_sum_factorization (n : ℕ) : log n = n.factorization.sum (λ p t, t * log p) := +begin + rcases eq_or_ne n 0 with rfl | hn, + { simp }, + nth_rewrite 0 [←nat.factorization_prod_pow_eq_self hn], + rw [finsupp.prod, nat.cast_prod, log_prod _ _ (λ p hp, _), finsupp.sum], + { simp_rw [nat.cast_pow, log_pow] }, + { norm_cast, + exact pow_ne_zero _ (nat.prime_of_mem_factorization hp).ne_zero }, end lemma tendsto_pow_log_div_mul_add_at_top (a b : ℝ) (n : ℕ) (ha : a ≠ 0) : @@ -261,14 +301,15 @@ lemma tendsto_pow_log_div_mul_add_at_top (a b : ℝ) (n : ℕ) (ha : a ≠ 0) : ((tendsto_div_pow_mul_exp_add_at_top a b n ha.symm).comp tendsto_log_at_top).congr' (by filter_upwards [eventually_gt_at_top (0 : ℝ)] with x hx using by simp [exp_log hx]) -lemma is_o_pow_log_id_at_top {n : ℕ} : - asymptotics.is_o (λ x, log x ^ n) id at_top := +lemma is_o_pow_log_id_at_top {n : ℕ} : (λ x, log x ^ n) =o[at_top] id := begin rw asymptotics.is_o_iff_tendsto', { simpa using tendsto_pow_log_div_mul_add_at_top 1 0 n one_ne_zero }, filter_upwards [eventually_ne_at_top (0 : ℝ)] with x h₁ h₂ using (h₁ h₂).elim, end +lemma is_o_log_id_at_top : log =o[at_top] id := is_o_pow_log_id_at_top.congr_left (λ x, pow_one _) + end real section continuity @@ -298,3 +339,30 @@ lemma continuous_on.log (hf : continuous_on f s) (h₀ : ∀ x ∈ s, f x ≠ 0) λ x hx, (hf x hx).log (h₀ x hx) end continuity + + +section tendsto_comp_add_sub + +open filter +namespace real + +lemma tendsto_log_comp_add_sub_log (y : ℝ) : + tendsto (λ x:ℝ, log (x + y) - log x) at_top (𝓝 0) := +begin + refine tendsto.congr' (_ : ∀ᶠ (x : ℝ) in at_top, log (1 + y / x) = _) _, + { refine eventually.mp ((eventually_ne_at_top 0).and (eventually_gt_at_top (-y))) + (eventually_of_forall (λ x hx, _)), + rw ← log_div _ hx.1, + { congr' 1, + field_simp [hx.1] }, + { linarith [hx.2] } }, + { suffices : tendsto (λ (x : ℝ), log (1 + y / x)) at_top (𝓝 (log (1 + 0))), by simpa, + refine tendsto.log _ (by simp), + exact tendsto_const_nhds.add (tendsto_const_nhds.div_at_top tendsto_id) }, +end + +lemma tendsto_log_nat_add_one_sub_log : tendsto (λ (k : ℕ), log (k + 1) - log k) at_top (𝓝 0) := +(tendsto_log_comp_add_sub_log 1).comp tendsto_coe_nat_at_top_at_top + +end real +end tendsto_comp_add_sub diff --git a/src/analysis/special_functions/log/deriv.lean b/src/analysis/special_functions/log/deriv.lean index af95ec6e16085..6f006ca1234f3 100644 --- a/src/analysis/special_functions/log/deriv.lean +++ b/src/analysis/special_functions/log/deriv.lean @@ -3,23 +3,28 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne -/ +import analysis.calculus.deriv.pow +import analysis.calculus.deriv.inv import analysis.special_functions.log.basic import analysis.special_functions.exp_deriv /-! # Derivative and series expansion of real logarithm +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that `real.log` is infinitely smooth at all nonzero `x : ℝ`. We also prove that the series `∑' n : ℕ, x ^ (n + 1) / (n + 1)` converges to `(-real.log (1 - x))` for all `x : ℝ`, `|x| < 1`. ## Tags -logarighm, derivative +logarithm, derivative -/ open filter finset set -open_locale topological_space big_operators +open_locale topology big_operators namespace real @@ -60,14 +65,14 @@ else (has_deriv_at_log hx).deriv @[simp] lemma deriv_log' : deriv log = has_inv.inv := funext deriv_log -lemma cont_diff_on_log {n : with_top ℕ} : cont_diff_on ℝ n log {0}ᶜ := +lemma cont_diff_on_log {n : ℕ∞} : cont_diff_on ℝ n log {0}ᶜ := begin suffices : cont_diff_on ℝ ⊤ log {0}ᶜ, from this.of_le le_top, refine (cont_diff_on_top_iff_deriv_of_open is_open_compl_singleton).2 _, simp [differentiable_on_log, cont_diff_on_inv] end -lemma cont_diff_at_log {n : with_top ℕ} : cont_diff_at ℝ n log x ↔ x ≠ 0 := +lemma cont_diff_at_log {n : ℕ∞} : cont_diff_at ℝ n log x ↔ x ≠ 0 := ⟨λ h, continuous_at_log_iff.1 h.continuous_at, λ hx, (cont_diff_on_log x hx).cont_diff_at $ is_open.mem_nhds is_open_compl_singleton hx⟩ @@ -115,8 +120,8 @@ end deriv section fderiv -variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {f' : E →L[ℝ] ℝ} - {s : set E} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} + {f' : E →L[ℝ] ℝ} {s : set E} lemma has_fderiv_within_at.log (hf : has_fderiv_within_at f f' s x) (hx : f x ≠ 0) : has_fderiv_within_at (λ x, log (f x)) ((f x)⁻¹ • f') s x := @@ -207,7 +212,7 @@ begin have : (∑ i in range n, (↑i + 1) * y ^ i / (↑i + 1)) = (∑ i in range n, y ^ i), { congr' with i, exact mul_div_cancel_left _ (nat.cast_add_one_pos i).ne' }, - field_simp [F, this, ← geom_sum_def, geom_sum_eq (ne_of_lt hy.2), + field_simp [F, this, geom_sum_eq (ne_of_lt hy.2), sub_ne_zero_of_ne (ne_of_gt hy.2), sub_ne_zero_of_ne (ne_of_lt hy.2)], ring }, -- second step: show that the derivative of `F` is small @@ -224,13 +229,13 @@ begin apply_rules [div_le_div, pow_nonneg, abs_nonneg, pow_le_pow_of_le_left] end }, -- third step: apply the mean value inequality - have C : ∥F x - F 0∥ ≤ (|x|^n / (1 - |x|)) * ∥x - 0∥, + have C : ‖F x - F 0‖ ≤ (|x|^n / (1 - |x|)) * ‖x - 0‖, { have : ∀ y ∈ Icc (- |x|) (|x|), differentiable_at ℝ F y, { assume y hy, have : 1 - y ≠ 0 := sub_ne_zero_of_ne (ne_of_gt (lt_of_le_of_lt hy.2 h)), simp [F, this] }, apply convex.norm_image_sub_le_of_norm_deriv_le this B (convex_Icc _ _) _ _, - { simpa using abs_nonneg x }, + { simp }, { simp [le_abs_self x, neg_le.mp (neg_le_abs_self x)] } }, -- fourth step: conclude by massaging the inequality of the third step simpa [F, norm_eq_abs, div_mul_eq_mul_div, pow_succ'] using C @@ -248,17 +253,17 @@ begin suffices : tendsto (λ (t : ℕ), |x| ^ (t + 1) / (1 - |x|)) at_top (𝓝 (|x| * 0 / (1 - |x|))), by simpa, simp only [pow_succ], - refine (tendsto_const_nhds.mul _).div_const, + refine (tendsto_const_nhds.mul _).div_const _, exact tendsto_pow_at_top_nhds_0_of_lt_1 (abs_nonneg _) h }, show summable (λ (n : ℕ), x ^ (n + 1) / (n + 1)), { refine summable_of_norm_bounded _ (summable_geometric_of_lt_1 (abs_nonneg _) h) (λ i, _), - calc ∥x ^ (i + 1) / (i + 1)∥ - = |x| ^ (i+1) / (i+1) : + calc ‖x ^ (i + 1) / (i + 1)‖ + = |x| ^ (i + 1) / (i + 1) : begin have : (0 : ℝ) ≤ i + 1 := le_of_lt (nat.cast_add_one_pos i), rw [norm_eq_abs, abs_div, ← pow_abs, abs_of_nonneg this], end - ... ≤ |x| ^ (i+1) / (0 + 1) : + ... ≤ |x| ^ (i + 1) / (0 + 1) : begin apply_rules [div_le_div_of_le_left, pow_nonneg, abs_nonneg, add_le_add_right, i.cast_nonneg], @@ -268,4 +273,47 @@ begin by simpa [pow_succ'] using mul_le_of_le_one_right (pow_nonneg (abs_nonneg x) i) (le_of_lt h) } end +/-- Power series expansion of `log(1 + x) - log(1 - x)` for `|x| < 1`. -/ +lemma has_sum_log_sub_log_of_abs_lt_1 {x : ℝ} (h : |x| < 1) : + has_sum (λ k : ℕ, (2 : ℝ) * (1 / (2 * k + 1)) * x ^ (2 * k + 1)) (log (1 + x) - log(1 - x)) := +begin + let term := λ n : ℕ, (-1) * ((-x) ^ (n + 1) / ((n : ℝ) + 1)) + x ^ (n + 1) / (n + 1), + have h_term_eq_goal : term ∘ (*) 2 = λ k : ℕ, 2 * (1 / (2 * k + 1)) * x ^ (2 * k + 1), + { ext n, + dsimp [term], + rw [odd.neg_pow (⟨n, rfl⟩ : odd (2 * n + 1)) x], + push_cast, + ring_nf, }, + rw [← h_term_eq_goal, (mul_right_injective₀ (two_ne_zero' ℕ)).has_sum_iff], + { have h₁ := (has_sum_pow_div_log_of_abs_lt_1 (eq.trans_lt (abs_neg x) h)).mul_left (-1), + convert h₁.add (has_sum_pow_div_log_of_abs_lt_1 h), + ring_nf }, + { intros m hm, + rw [range_two_mul, set.mem_set_of_eq, ← nat.even_add_one] at hm, + dsimp [term], + rw [even.neg_pow hm, neg_one_mul, neg_add_self] }, +end + +/-- Expansion of `log (1 + a⁻¹)` as a series in powers of `1 / (2 * a + 1)`. -/ +theorem has_sum_log_one_add_inv {a : ℝ} (h : 0 < a) : + has_sum (λ k : ℕ, (2 : ℝ) * (1 / (2 * k + 1)) * (1 / (2 * a + 1)) ^ (2 * k + 1)) + (log (1 + a⁻¹)) := +begin + have h₁ : |1 / (2 * a + 1)| < 1, + { rw [abs_of_pos, div_lt_one], + { linarith, }, + { linarith, }, + { exact div_pos one_pos (by linarith), }, }, + convert has_sum_log_sub_log_of_abs_lt_1 h₁, + have h₂ : (2 : ℝ) * a + 1 ≠ 0 := by linarith, + have h₃ := h.ne', + rw ← log_div, + { congr, + field_simp, + linarith, }, + { field_simp, + linarith } , + { field_simp }, +end + end real diff --git a/src/analysis/special_functions/log/monotone.lean b/src/analysis/special_functions/log/monotone.lean index 665632df01b50..8e248092cccd1 100644 --- a/src/analysis/special_functions/log/monotone.lean +++ b/src/analysis/special_functions/log/monotone.lean @@ -3,12 +3,14 @@ Copyright (c) 2021 Bolton Bailey. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bolton Bailey -/ -import analysis.special_functions.log.basic -import analysis.special_functions.pow +import analysis.special_functions.pow.real /-! # Logarithm Tonality +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we describe the tonality of the logarithm function when multiplied by functions of the form `x ^ a`. @@ -18,7 +20,7 @@ logarithm, tonality -/ open set filter function -open_locale topological_space +open_locale topology noncomputable theory namespace real diff --git a/src/analysis/special_functions/non_integrable.lean b/src/analysis/special_functions/non_integrable.lean index bdc86f7af1229..d193676c5f1ae 100644 --- a/src/analysis/special_functions/non_integrable.lean +++ b/src/analysis/special_functions/non_integrable.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import analysis.special_functions.integrals -import analysis.calculus.fderiv_measurable +import analysis.special_functions.log.deriv +import measure_theory.integral.fund_thm_calculus /-! # Non integrable functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that the derivative of a function that tends to infinity is not interval integrable, see `interval_integral.not_integrable_has_deriv_at_of_tendsto_norm_at_top_filter` and `interval_integral.not_integrable_has_deriv_at_of_tendsto_norm_at_top_punctured`. Then we apply the @@ -36,11 +39,11 @@ latter lemma to prove that the function `λ x, x⁻¹` is integrable on `a..b` i integrable function -/ -open_locale measure_theory topological_space interval nnreal ennreal +open_locale measure_theory topology interval nnreal ennreal open measure_theory topological_space set filter asymptotics interval_integral -variables {E F : Type*} [normed_group E] [normed_space ℝ E] [second_countable_topology E] -[complete_space E] [normed_group F] +variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E] [second_countable_topology E] +[complete_space E] [normed_add_comm_group F] /-- If `f` is eventually differentiable along a nontrivial filter `l : filter ℝ` that is generated by convex sets, the norm of `f` tends to infinity along `l`, and `f' = O(g)` along `l`, where `f'` @@ -48,58 +51,58 @@ is the derivative of `f`, then `g` is not integrable on any interval `a..b` such `[a, b] ∈ l`. -/ lemma not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_filter {f : ℝ → E} {g : ℝ → F} {a b : ℝ} (l : filter ℝ) [ne_bot l] [tendsto_Ixx_class Icc l l] (hl : [a, b] ∈ l) - (hd : ∀ᶠ x in l, differentiable_at ℝ f x) (hf : tendsto (λ x, ∥f x∥) l at_top) - (hfg : is_O (deriv f) g l) : + (hd : ∀ᶠ x in l, differentiable_at ℝ f x) (hf : tendsto (λ x, ‖f x‖) l at_top) + (hfg : deriv f =O[l] g) : ¬interval_integrable g volume a b := begin intro hgi, obtain ⟨C, hC₀, s, hsl, hsub, hfd, hg⟩ : ∃ (C : ℝ) (hC₀ : 0 ≤ C) (s ∈ l), (∀ (x ∈ s) (y ∈ s), [x, y] ⊆ [a, b]) ∧ (∀ (x ∈ s) (y ∈ s) (z ∈ [x, y]), differentiable_at ℝ f z) ∧ - (∀ (x ∈ s) (y ∈ s) (z ∈ [x, y]), ∥deriv f z∥ ≤ C * ∥g z∥), + (∀ (x ∈ s) (y ∈ s) (z ∈ [x, y]), ‖deriv f z‖ ≤ C * ‖g z‖), { rcases hfg.exists_nonneg with ⟨C, C₀, hC⟩, have h : ∀ᶠ x : ℝ × ℝ in l.prod l, ∀ y ∈ [x.1, x.2], (differentiable_at ℝ f y ∧ - ∥deriv f y∥ ≤ C * ∥g y∥) ∧ y ∈ [a, b], - from (tendsto_fst.interval tendsto_snd).eventually ((hd.and hC.bound).and hl).small_sets, + ‖deriv f y‖ ≤ C * ‖g y‖) ∧ y ∈ [a, b], + from (tendsto_fst.uIcc tendsto_snd).eventually ((hd.and hC.bound).and hl).small_sets, rcases mem_prod_self_iff.1 h with ⟨s, hsl, hs⟩, simp only [prod_subset_iff, mem_set_of_eq] at hs, exact ⟨C, C₀, s, hsl, λ x hx y hy z hz, (hs x hx y hy z hz).2, λ x hx y hy z hz, (hs x hx y hy z hz).1.1, λ x hx y hy z hz, (hs x hx y hy z hz).1.2⟩ }, - replace hgi : interval_integrable (λ x, C * ∥g x∥) volume a b, by convert hgi.norm.smul C, - obtain ⟨c, hc, d, hd, hlt⟩ : ∃ (c ∈ s) (d ∈ s), ∥f c∥ + ∫ y in Ι a b, C * ∥g y∥ < ∥f d∥, + replace hgi : interval_integrable (λ x, C * ‖g x‖) volume a b, by convert hgi.norm.smul C, + obtain ⟨c, hc, d, hd, hlt⟩ : ∃ (c ∈ s) (d ∈ s), ‖f c‖ + ∫ y in Ι a b, C * ‖g y‖ < ‖f d‖, { rcases filter.nonempty_of_mem hsl with ⟨c, hc⟩, - have : ∀ᶠ x in l, ∥f c∥ + ∫ y in Ι a b, C * ∥g y∥ < ∥f x∥, + have : ∀ᶠ x in l, ‖f c‖ + ∫ y in Ι a b, C * ‖g y‖ < ‖f x‖, from hf.eventually (eventually_gt_at_top _), exact ⟨c, hc, (this.and hsl).exists.imp (λ d hd, ⟨hd.2, hd.1⟩)⟩ }, specialize hsub c hc d hd, specialize hfd c hc d hd, - replace hg : ∀ x ∈ Ι c d, ∥deriv f x∥ ≤ C * ∥g x∥, from λ z hz, hg c hc d hd z ⟨hz.1.le, hz.2⟩, - have hg_ae : ∀ᵐ x ∂(volume.restrict (Ι c d)), ∥deriv f x∥ ≤ C * ∥g x∥, - from (ae_restrict_mem measurable_set_interval_oc).mono hg, + replace hg : ∀ x ∈ Ι c d, ‖deriv f x‖ ≤ C * ‖g x‖, from λ z hz, hg c hc d hd z ⟨hz.1.le, hz.2⟩, + have hg_ae : ∀ᵐ x ∂(volume.restrict (Ι c d)), ‖deriv f x‖ ≤ C * ‖g x‖, + from (ae_restrict_mem measurable_set_uIoc).mono hg, have hsub' : Ι c d ⊆ Ι a b, - from interval_oc_subset_interval_oc_of_interval_subset_interval hsub, + from uIoc_subset_uIoc_of_uIcc_subset_uIcc hsub, have hfi : interval_integrable (deriv f) volume c d, from (hgi.mono_set hsub).mono_fun' (ae_strongly_measurable_deriv _ _) hg_ae, refine hlt.not_le (sub_le_iff_le_add'.1 _), - calc ∥f d∥ - ∥f c∥ ≤ ∥f d - f c∥ : norm_sub_norm_le _ _ - ... = ∥∫ x in c..d, deriv f x∥ : congr_arg _ (integral_deriv_eq_sub hfd hfi).symm - ... = ∥∫ x in Ι c d, deriv f x∥ : norm_integral_eq_norm_integral_Ioc _ - ... ≤ ∫ x in Ι c d, ∥deriv f x∥ : norm_integral_le_integral_norm _ - ... ≤ ∫ x in Ι c d, C * ∥g x∥ : - set_integral_mono_on hfi.norm.def (hgi.def.mono_set hsub') measurable_set_interval_oc hg - ... ≤ ∫ x in Ι a b, C * ∥g x∥ : + calc ‖f d‖ - ‖f c‖ ≤ ‖f d - f c‖ : norm_sub_norm_le _ _ + ... = ‖∫ x in c..d, deriv f x‖ : congr_arg _ (integral_deriv_eq_sub hfd hfi).symm + ... = ‖∫ x in Ι c d, deriv f x‖ : norm_integral_eq_norm_integral_Ioc _ + ... ≤ ∫ x in Ι c d, ‖deriv f x‖ : norm_integral_le_integral_norm _ + ... ≤ ∫ x in Ι c d, C * ‖g x‖ : + set_integral_mono_on hfi.norm.def (hgi.def.mono_set hsub') measurable_set_uIoc hg + ... ≤ ∫ x in Ι a b, C * ‖g x‖ : set_integral_mono_set hgi.def (ae_of_all _ $ λ x, mul_nonneg hC₀ (norm_nonneg _)) hsub'.eventually_le end /-- If `a ≠ b`, `c ∈ [a, b]`, `f` is differentiable in the neighborhood of `c` within -`[a, b] \ {c}`, `∥f x∥ → ∞` as `x → c` within `[a, b] \ {c}`, and `f' = O(g)` along +`[a, b] \ {c}`, `‖f x‖ → ∞` as `x → c` within `[a, b] \ {c}`, and `f' = O(g)` along `𝓝[[a, b] \ {c}] c`, where `f'` is the derivative of `f`, then `g` is not interval integrable on `a..b`. -/ lemma not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_within_diff_singleton {f : ℝ → E} {g : ℝ → F} {a b c : ℝ} (hne : a ≠ b) (hc : c ∈ [a, b]) (h_deriv : ∀ᶠ x in 𝓝[[a, b] \ {c}] c, differentiable_at ℝ f x) - (h_infty : tendsto (λ x, ∥f x∥) (𝓝[[a, b] \ {c}] c) at_top) - (hg : is_O (deriv f) g (𝓝[[a, b] \ {c}] c)) : + (h_infty : tendsto (λ x, ‖f x‖) (𝓝[[a, b] \ {c}] c) at_top) + (hg : deriv f =O[𝓝[[a, b] \ {c}] c] g) : ¬interval_integrable g volume a b := begin obtain ⟨l, hl, hl', hle, hmem⟩ : ∃ l : filter ℝ, tendsto_Ixx_class Icc l l ∧ l.ne_bot ∧ @@ -118,13 +121,13 @@ begin (h_deriv.filter_mono this) (h_infty.mono_left this) (hg.mono this), end -/-- If `f` is differentiable in a punctured neighborhood of `c`, `∥f x∥ → ∞` as `x → c` (more +/-- If `f` is differentiable in a punctured neighborhood of `c`, `‖f x‖ → ∞` as `x → c` (more formally, along the filter `𝓝[≠] c`), and `f' = O(g)` along `𝓝[≠] c`, where `f'` is the derivative of `f`, then `g` is not interval integrable on any nontrivial interval `a..b` such that `c ∈ [a, b]`. -/ lemma not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_punctured {f : ℝ → E} {g : ℝ → F} {a b c : ℝ} (h_deriv : ∀ᶠ x in 𝓝[≠] c, differentiable_at ℝ f x) - (h_infty : tendsto (λ x, ∥f x∥) (𝓝[≠] c) at_top) (hg : is_O (deriv f) g (𝓝[≠] c)) + (h_infty : tendsto (λ x, ‖f x‖) (𝓝[≠] c) at_top) (hg : deriv f =O[𝓝[≠] c] g) (hne : a ≠ b) (hc : c ∈ [a, b]) : ¬interval_integrable g volume a b := have 𝓝[[a, b] \ {c}] c ≤ 𝓝[≠] c, from nhds_within_mono _ (inter_subset_right _ _), @@ -134,13 +137,13 @@ not_interval_integrable_of_tendsto_norm_at_top_of_deriv_is_O_within_diff_singlet /-- If `f` grows in the punctured neighborhood of `c : ℝ` at least as fast as `1 / (x - c)`, then it is not interval integrable on any nontrivial interval `a..b`, `c ∈ [a, b]`. -/ lemma not_interval_integrable_of_sub_inv_is_O_punctured {f : ℝ → F} {a b c : ℝ} - (hf : is_O (λ x, (x - c)⁻¹) f (𝓝[≠] c)) (hne : a ≠ b) (hc : c ∈ [a, b]) : + (hf : (λ x, (x - c)⁻¹) =O[𝓝[≠] c] f) (hne : a ≠ b) (hc : c ∈ [a, b]) : ¬interval_integrable f volume a b := begin have A : ∀ᶠ x in 𝓝[≠] c, has_deriv_at (λ x, real.log (x - c)) (x - c)⁻¹ x, { filter_upwards [self_mem_nhds_within] with x hx, simpa using ((has_deriv_at_id x).sub_const c).log (sub_ne_zero.2 hx) }, - have B : tendsto (λ x, ∥real.log (x - c)∥) (𝓝[≠] c) at_top, + have B : tendsto (λ x, ‖real.log (x - c)‖) (𝓝[≠] c) at_top, { refine tendsto_abs_at_bot_at_top.comp (real.tendsto_log_nhds_within_zero.comp _), rw ← sub_self c, exact ((has_deriv_at_id c).sub_const c).tendsto_punctured_nhds one_ne_zero }, @@ -157,9 +160,9 @@ begin { refine λ h, or_iff_not_imp_left.2 (λ hne hc, _), exact not_interval_integrable_of_sub_inv_is_O_punctured (is_O_refl _ _) hne hc h }, { rintro (rfl|h₀), - exacts [interval_integrable.refl, - interval_integrable_inv (λ x hx, sub_ne_zero.2 $ ne_of_mem_of_not_mem hx h₀) - (continuous_on_id.sub continuous_on_const)] } + { exact interval_integrable.refl }, + refine ((continuous_sub_right c).continuous_on.inv₀ _).interval_integrable, + exact λ x hx, sub_ne_zero.2 $ ne_of_mem_of_not_mem hx h₀ } end /-- The function `λ x, x⁻¹` is integrable on `a..b` if and only if `a = b` or `0 ∉ [a, b]`. -/ diff --git a/src/analysis/special_functions/polar_coord.lean b/src/analysis/special_functions/polar_coord.lean new file mode 100644 index 0000000000000..93ff2a25343ea --- /dev/null +++ b/src/analysis/special_functions/polar_coord.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ +import analysis.special_functions.trigonometric.deriv +import measure_theory.function.jacobian + +/-! +# Polar coordinates + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define polar coordinates, as a local homeomorphism in `ℝ^2` between `ℝ^2 - (-∞, 0]` and +`(0, +∞) × (-π, π)`. Its inverse is given by `(r, θ) ↦ (r cos θ, r sin θ)`. + +It satisfies the following change of variables formula (see `integral_comp_polar_coord_symm`): +`∫ p in polar_coord.target, p.1 • f (polar_coord.symm p) = ∫ p, f p` + +-/ + +noncomputable theory + +open real set measure_theory +open_locale real topology + +/-- The polar coordinates local homeomorphism in `ℝ^2`, mapping `(r cos θ, r sin θ)` to `(r, θ)`. +It is a homeomorphism between `ℝ^2 - (-∞, 0]` and `(0, +∞) × (-π, π)`. -/ +@[simps] def polar_coord : local_homeomorph (ℝ × ℝ) (ℝ × ℝ) := +{ to_fun := λ q, (real.sqrt (q.1^2 + q.2^2), complex.arg (complex.equiv_real_prod.symm q)), + inv_fun := λ p, (p.1 * cos p.2, p.1 * sin p.2), + source := {q | 0 < q.1} ∪ {q | q.2 ≠ 0}, + target := Ioi (0 : ℝ) ×ˢ Ioo (-π) π, + map_target' := + begin + rintros ⟨r, θ⟩ ⟨hr, hθ⟩, + dsimp at hr hθ, + rcases eq_or_ne θ 0 with rfl|h'θ, + { simpa using hr }, + { right, + simpa only [ne_of_gt hr, ne.def, mem_set_of_eq, mul_eq_zero, false_or, + sin_eq_zero_iff_of_lt_of_lt hθ.1 hθ.2] using h'θ } + end, + map_source' := + begin + rintros ⟨x, y⟩ hxy, + simp only [prod_mk_mem_set_prod_eq, mem_Ioi, sqrt_pos, mem_Ioo, complex.neg_pi_lt_arg, + true_and, complex.arg_lt_pi_iff], + split, + { cases hxy, + { dsimp at hxy, linarith [sq_pos_of_ne_zero _ (hxy.ne'), sq_nonneg y] }, + { linarith [sq_nonneg x, sq_pos_of_ne_zero _ hxy] } }, + { cases hxy, + { exact or.inl (le_of_lt hxy) }, + { exact or.inr hxy } } + end, + right_inv' := + begin + rintros ⟨r, θ⟩ ⟨hr, hθ⟩, + dsimp at hr hθ, + simp only [prod.mk.inj_iff], + split, + { conv_rhs { rw [← sqrt_sq (le_of_lt hr), ← one_mul (r^2), ← sin_sq_add_cos_sq θ], }, + congr' 1, + ring_exp }, + { convert complex.arg_mul_cos_add_sin_mul_I hr ⟨hθ.1, hθ.2.le⟩, + simp only [complex.equiv_real_prod_symm_apply, complex.of_real_mul, complex.of_real_cos, + complex.of_real_sin], + ring } + end, + left_inv' := + begin + rintros ⟨x, y⟩ hxy, + have A : sqrt (x ^ 2 + y ^ 2) = complex.abs (x + y * complex.I), + by simp only [complex.abs_def, complex.norm_sq, pow_two, monoid_with_zero_hom.coe_mk, + complex.add_re, complex.of_real_re, complex.mul_re, complex.I_re, mul_zero, + complex.of_real_im, complex.I_im, sub_self, add_zero, complex.add_im, + complex.mul_im, mul_one, zero_add], + have Z := complex.abs_mul_cos_add_sin_mul_I (x + y * complex.I), + simp only [← complex.of_real_cos, ← complex.of_real_sin, mul_add, ← complex.of_real_mul, + ← mul_assoc] at Z, + simpa [A, -complex.of_real_cos, -complex.of_real_sin] using complex.ext_iff.1 Z, + end, + open_target := is_open_Ioi.prod is_open_Ioo, + open_source := (is_open_lt continuous_const continuous_fst).union + (is_open_ne_fun continuous_snd continuous_const), + continuous_inv_fun := ((continuous_fst.mul (continuous_cos.comp continuous_snd)).prod_mk + (continuous_fst.mul (continuous_sin.comp continuous_snd))).continuous_on, + continuous_to_fun := + begin + apply ((continuous_fst.pow 2).add (continuous_snd.pow 2)).sqrt.continuous_on.prod, + have A : maps_to complex.equiv_real_prod.symm + ({q : ℝ × ℝ | 0 < q.1} ∪ {q : ℝ × ℝ | q.2 ≠ 0}) {z | 0 < z.re ∨ z.im ≠ 0}, + { rintros ⟨x, y⟩ hxy, simpa only using hxy }, + apply continuous_on.comp (λ z hz, _) _ A, + { exact (complex.continuous_at_arg hz).continuous_within_at }, + { exact complex.equiv_real_prod_clm.symm.continuous.continuous_on } + end } + +lemma has_fderiv_at_polar_coord_symm (p : ℝ × ℝ) : + has_fderiv_at polar_coord.symm + (matrix.to_lin (basis.fin_two_prod ℝ) (basis.fin_two_prod ℝ) + (!![cos p.2, -p.1 * sin p.2; sin p.2, p.1 * cos p.2])).to_continuous_linear_map p := +begin + rw matrix.to_lin_fin_two_prod_to_continuous_linear_map, + convert has_fderiv_at.prod + (has_fderiv_at_fst.mul ((has_deriv_at_cos p.2).comp_has_fderiv_at p has_fderiv_at_snd)) + (has_fderiv_at_fst.mul ((has_deriv_at_sin p.2).comp_has_fderiv_at p has_fderiv_at_snd)) using 2; + simp only [smul_smul, add_comm, neg_mul, neg_smul, smul_neg], +end + +lemma polar_coord_source_ae_eq_univ : + polar_coord.source =ᵐ[volume] univ := +begin + have A : polar_coord.sourceᶜ ⊆ (linear_map.snd ℝ ℝ ℝ).ker, + { assume x hx, + simp only [polar_coord_source, compl_union, mem_inter_iff, mem_compl_iff, mem_set_of_eq, not_lt, + not_not] at hx, + exact hx.2 }, + have B : volume ((linear_map.snd ℝ ℝ ℝ).ker : set (ℝ × ℝ)) = 0, + { apply measure.add_haar_submodule, + rw [ne.def, linear_map.ker_eq_top], + assume h, + have : (linear_map.snd ℝ ℝ ℝ) (0, 1) = (0 : (ℝ × ℝ →ₗ[ℝ] ℝ)) (0, 1), by rw h, + simpa using this }, + simp only [ae_eq_univ], + exact le_antisymm ((measure_mono A).trans (le_of_eq B)) bot_le, +end + +theorem integral_comp_polar_coord_symm + {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] (f : ℝ × ℝ → E) : + ∫ p in polar_coord.target, p.1 • f (polar_coord.symm p) = ∫ p, f p := +begin + set B : (ℝ × ℝ) → ((ℝ × ℝ) →L[ℝ] (ℝ × ℝ)) := λ p, + (matrix.to_lin (basis.fin_two_prod ℝ) (basis.fin_two_prod ℝ) + !![cos p.2, -p.1 * sin p.2; sin p.2, p.1 * cos p.2]).to_continuous_linear_map with hB, + have A : ∀ p ∈ polar_coord.symm.source, has_fderiv_at polar_coord.symm (B p) p := + λ p hp, has_fderiv_at_polar_coord_symm p, + have B_det : ∀ p, (B p).det = p.1, + { assume p, + conv_rhs {rw [← one_mul p.1, ← cos_sq_add_sin_sq p.2] }, + simp only [neg_mul, linear_map.det_to_continuous_linear_map, linear_map.det_to_lin, + matrix.det_fin_two_of, sub_neg_eq_add], + ring_exp }, + symmetry, + calc + ∫ p, f p + = ∫ p in polar_coord.source, f p : + begin + rw ← integral_univ, + apply set_integral_congr_set_ae, + exact polar_coord_source_ae_eq_univ.symm + end + ... = ∫ p in polar_coord.target, abs ((B p).det) • f (polar_coord.symm p) : + by apply integral_target_eq_integral_abs_det_fderiv_smul volume A + ... = ∫ p in polar_coord.target, p.1 • f (polar_coord.symm p) : + begin + apply set_integral_congr (polar_coord.open_target.measurable_set) (λ x hx, _), + rw [B_det, abs_of_pos], + exact hx.1, + end +end diff --git a/src/analysis/special_functions/polynomials.lean b/src/analysis/special_functions/polynomials.lean index 59e8caf7be6ad..779b88c4163d8 100644 --- a/src/analysis/special_functions/polynomials.lean +++ b/src/analysis/special_functions/polynomials.lean @@ -10,6 +10,9 @@ import data.polynomial.ring_division /-! # Limits related to polynomial and rational functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic facts about limits of polynomial and rationals functions. The main result is `eval_is_equivalent_at_top_eval_lead`, which states that for any polynomial `P` of degree `n` with leading coefficient `a`, the corresponding @@ -21,18 +24,14 @@ polynomials. -/ open filter finset asymptotics -open_locale asymptotics polynomial topological_space +open_locale asymptotics polynomial topology namespace polynomial variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜] (P Q : 𝕜[X]) -lemma eventually_no_roots (hP : P ≠ 0) : ∀ᶠ x in filter.at_top, ¬ P.is_root x := -begin - obtain ⟨x₀, hx₀⟩ := exists_max_root P hP, - refine filter.eventually_at_top.mpr (⟨x₀ + 1, λ x hx h, _⟩), - exact absurd (hx₀ x h) (not_le.mpr (lt_of_lt_of_le (lt_add_one x₀) hx)), -end +lemma eventually_no_roots (hP : P ≠ 0) : ∀ᶠ x in at_top, ¬ P.is_root x := +at_top_le_cofinite $ (finite_set_of_is_root hP).compl_mem_cofinite variables [order_topology 𝕜] @@ -43,55 +42,43 @@ lemma is_equivalent_at_top_lead : begin by_cases h : P = 0, { simp [h] }, - { conv_rhs - { funext, - rw [polynomial.eval_eq_sum_range, sum_range_succ] }, - exact is_equivalent.refl.add_is_o (is_o.sum $ λ i hi, is_o.const_mul_left + { simp only [polynomial.eval_eq_sum_range, sum_range_succ], + exact is_o.add_is_equivalent (is_o.sum $ λ i hi, is_o.const_mul_left (is_o.const_mul_right (λ hz, h $ leading_coeff_eq_zero.mp hz) $ - is_o_pow_pow_at_top_of_lt (mem_range.mp hi)) _) } + is_o_pow_pow_at_top_of_lt (mem_range.mp hi)) _) is_equivalent.refl } end -lemma tendsto_at_top_of_leading_coeff_nonneg (hdeg : 1 ≤ P.degree) (hnng : 0 ≤ P.leading_coeff) : +lemma tendsto_at_top_of_leading_coeff_nonneg (hdeg : 0 < P.degree) (hnng : 0 ≤ P.leading_coeff) : tendsto (λ x, eval x P) at_top at_top := -P.is_equivalent_at_top_lead.symm.tendsto_at_top - (tendsto_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg) - (lt_of_le_of_ne hnng $ ne.symm $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg)) +P.is_equivalent_at_top_lead.symm.tendsto_at_top $ + tendsto_const_mul_pow_at_top (nat_degree_pos_iff_degree_pos.2 hdeg).ne' $ + hnng.lt_of_ne' $ leading_coeff_ne_zero.mpr $ ne_zero_of_degree_gt hdeg lemma tendsto_at_top_iff_leading_coeff_nonneg : - tendsto (λ x, eval x P) at_top at_top ↔ 1 ≤ P.degree ∧ 0 ≤ P.leading_coeff := + tendsto (λ x, eval x P) at_top at_top ↔ 0 < P.degree ∧ 0 ≤ P.leading_coeff := begin refine ⟨λ h, _, λ h, tendsto_at_top_of_leading_coeff_nonneg P h.1 h.2⟩, have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_top := - is_equivalent.tendsto_at_top (is_equivalent_at_top_lead P) h, - rw tendsto_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this, - rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2).symm), ← nat.cast_one], - refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩, + (is_equivalent_at_top_lead P).tendsto_at_top h, + rw [tendsto_const_mul_pow_at_top_iff, ← pos_iff_ne_zero, nat_degree_pos_iff_degree_pos] at this, + exact ⟨this.1, this.2.le⟩ end -lemma tendsto_at_bot_of_leading_coeff_nonpos (hdeg : 1 ≤ P.degree) (hnps : P.leading_coeff ≤ 0) : - tendsto (λ x, eval x P) at_top at_bot := -P.is_equivalent_at_top_lead.symm.tendsto_at_bot - (tendsto_neg_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg) - (lt_of_le_of_ne hnps $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg)) - lemma tendsto_at_bot_iff_leading_coeff_nonpos : - tendsto (λ x, eval x P) at_top at_bot ↔ 1 ≤ P.degree ∧ P.leading_coeff ≤ 0 := -begin - refine ⟨λ h, _, λ h, tendsto_at_bot_of_leading_coeff_nonpos P h.1 h.2⟩, - have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_bot := - (is_equivalent.tendsto_at_bot (is_equivalent_at_top_lead P) h), - rw tendsto_neg_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this, - rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2)), ← nat.cast_one], - refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩, -end + tendsto (λ x, eval x P) at_top at_bot ↔ 0 < P.degree ∧ P.leading_coeff ≤ 0 := +by simp only [← tendsto_neg_at_top_iff, ← eval_neg, tendsto_at_top_iff_leading_coeff_nonneg, + degree_neg, leading_coeff_neg, neg_nonneg] + +lemma tendsto_at_bot_of_leading_coeff_nonpos (hdeg : 0 < P.degree) (hnps : P.leading_coeff ≤ 0) : + tendsto (λ x, eval x P) at_top at_bot := +P.tendsto_at_bot_iff_leading_coeff_nonpos.2 ⟨hdeg, hnps⟩ -lemma abs_tendsto_at_top (hdeg : 1 ≤ P.degree) : +lemma abs_tendsto_at_top (hdeg : 0 < P.degree) : tendsto (λ x, abs $ eval x P) at_top at_top := begin - by_cases hP : 0 ≤ P.leading_coeff, - { exact tendsto_abs_at_top_at_top.comp (P.tendsto_at_top_of_leading_coeff_nonneg hdeg hP)}, - { push_neg at hP, - exact tendsto_abs_at_bot_at_top.comp (P.tendsto_at_bot_of_leading_coeff_nonpos hdeg hP.le)} + cases le_total 0 P.leading_coeff with hP hP, + { exact tendsto_abs_at_top_at_top.comp (P.tendsto_at_top_of_leading_coeff_nonneg hdeg hP) }, + { exact tendsto_abs_at_bot_at_top.comp (P.tendsto_at_bot_of_leading_coeff_nonpos hdeg hP) } end lemma abs_is_bounded_under_iff : @@ -101,14 +88,13 @@ begin (forall_imp (λ _, le_of_eq) (λ x, congr_arg abs $ trans (congr_arg (eval x) (eq_C_of_degree_le_zero h)) (eval_C))))⟩⟩, contrapose! h, - exact not_is_bounded_under_of_tendsto_at_top - (abs_tendsto_at_top P (nat.with_bot.one_le_iff_zero_lt.2 h)) + exact not_is_bounded_under_of_tendsto_at_top (abs_tendsto_at_top P h) end lemma abs_tendsto_at_top_iff : - tendsto (λ x, abs $ eval x P) at_top at_top ↔ 1 ≤ P.degree := -⟨λ h, nat.with_bot.one_le_iff_zero_lt.2 (not_le.mp ((mt (abs_is_bounded_under_iff P).mpr) - (not_is_bounded_under_of_tendsto_at_top h))), abs_tendsto_at_top P⟩ + tendsto (λ x, abs $ eval x P) at_top at_top ↔ 0 < P.degree := +⟨λ h, not_le.mp (mt (abs_is_bounded_under_iff P).mpr (not_is_bounded_under_of_tendsto_at_top h)), + abs_tendsto_at_top P⟩ lemma tendsto_nhds_iff {c : 𝕜} : tendsto (λ x, eval x P) at_top (𝓝 c) ↔ P.leading_coeff = c ∧ P.degree ≤ 0 := @@ -141,7 +127,7 @@ begin refine (P.is_equivalent_at_top_lead.symm.div Q.is_equivalent_at_top_lead.symm).symm.trans (eventually_eq.is_equivalent ((eventually_gt_at_top 0).mono $ λ x hx, _)), - simp [← div_mul_div_comm₀, hP, hQ, zpow_sub₀ hx.ne.symm] + simp [← div_mul_div_comm, hP, hQ, zpow_sub₀ hx.ne.symm] end lemma div_tendsto_zero_of_degree_lt (hdeg : P.degree < Q.degree) : @@ -167,7 +153,7 @@ begin exact bot_lt_iff_ne_bot.2 (λ hQ', hQ (degree_eq_bot.1 hQ')) }, { exact absurd (leading_coeff_eq_zero.1 hQ0) hQ } }, { have := (is_equivalent_at_top_div P Q).tendsto_nhds h, - rw tendsto_const_mul_zpow_at_top_zero_iff hPQ at this, + rw tendsto_const_mul_zpow_at_top_nhds_iff hPQ at this, cases this with h h, { exact absurd h.2 hPQ }, { rw [sub_lt_iff_lt_add, zero_add, int.coe_nat_lt] at h, @@ -237,10 +223,10 @@ end end polynomial_div_at_top theorem is_O_of_degree_le (h : P.degree ≤ Q.degree) : - is_O (λ x, eval x P) (λ x, eval x Q) filter.at_top := + (λ x, eval x P) =O[at_top] (λ x, eval x Q) := begin by_cases hp : P = 0, - { simpa [hp] using is_O_zero (λ x, eval x Q) filter.at_top }, + { simpa [hp] using is_O_zero (λ x, eval x Q) at_top }, { have hq : Q ≠ 0 := ne_zero_of_degree_ge_degree h hp, have hPQ : ∀ᶠ (x : 𝕜) in at_top, eval x Q = 0 → eval x P = 0 := filter.mem_of_superset (polynomial.eventually_no_roots Q hq) (λ x h h', absurd h' h), diff --git a/src/analysis/special_functions/pow.lean b/src/analysis/special_functions/pow.lean deleted file mode 100644 index 9823375649641..0000000000000 --- a/src/analysis/special_functions/pow.lean +++ /dev/null @@ -1,1924 +0,0 @@ -/- -Copyright (c) 2018 Chris Hughes. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, - Rémy Degenne, David Loeffler --/ -import analysis.special_functions.complex.log - -/-! -# Power function on `ℂ`, `ℝ`, `ℝ≥0`, and `ℝ≥0∞` - -We construct the power functions `x ^ y` where -* `x` and `y` are complex numbers, -* or `x` and `y` are real numbers, -* or `x` is a nonnegative real number and `y` is a real number; -* or `x` is a number from `[0, +∞]` (a.k.a. `ℝ≥0∞`) and `y` is a real number. - -We also prove basic properties of these functions. --/ - -noncomputable theory - -open_locale classical real topological_space nnreal ennreal filter big_operators -open filter finset set - -namespace complex - -/-- The complex power function `x^y`, given by `x^y = exp(y log x)` (where `log` is the principal -determination of the logarithm), unless `x = 0` where one sets `0^0 = 1` and `0^y = 0` for -`y ≠ 0`. -/ -noncomputable def cpow (x y : ℂ) : ℂ := -if x = 0 - then if y = 0 - then 1 - else 0 - else exp (log x * y) - -noncomputable instance : has_pow ℂ ℂ := ⟨cpow⟩ - -@[simp] lemma cpow_eq_pow (x y : ℂ) : cpow x y = x ^ y := rfl - -lemma cpow_def (x y : ℂ) : x ^ y = - if x = 0 - then if y = 0 - then 1 - else 0 - else exp (log x * y) := rfl - -lemma cpow_def_of_ne_zero {x : ℂ} (hx : x ≠ 0) (y : ℂ) : x ^ y = exp (log x * y) := if_neg hx - -@[simp] lemma cpow_zero (x : ℂ) : x ^ (0 : ℂ) = 1 := by simp [cpow_def] - -@[simp] lemma cpow_eq_zero_iff (x y : ℂ) : x ^ y = 0 ↔ x = 0 ∧ y ≠ 0 := -by { simp only [cpow_def], split_ifs; simp [*, exp_ne_zero] } - -@[simp] lemma zero_cpow {x : ℂ} (h : x ≠ 0) : (0 : ℂ) ^ x = 0 := -by simp [cpow_def, *] - -lemma zero_cpow_eq_iff {x : ℂ} {a : ℂ} : 0 ^ x = a ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := -begin - split, - { intros hyp, - simp [cpow_def] at hyp, - by_cases x = 0, - { subst h, simp only [if_true, eq_self_iff_true] at hyp, right, exact ⟨rfl, hyp.symm⟩}, - { rw if_neg h at hyp, left, exact ⟨h, hyp.symm⟩, }, }, - { rintro (⟨h, rfl⟩|⟨rfl,rfl⟩), - { exact zero_cpow h, }, - { exact cpow_zero _, }, }, -end - -lemma eq_zero_cpow_iff {x : ℂ} {a : ℂ} : a = 0 ^ x ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := -by rw [←zero_cpow_eq_iff, eq_comm] - -@[simp] lemma cpow_one (x : ℂ) : x ^ (1 : ℂ) = x := -if hx : x = 0 then by simp [hx, cpow_def] -else by rw [cpow_def, if_neg (one_ne_zero : (1 : ℂ) ≠ 0), if_neg hx, mul_one, exp_log hx] - -@[simp] lemma one_cpow (x : ℂ) : (1 : ℂ) ^ x = 1 := -by rw cpow_def; split_ifs; simp [one_ne_zero, *] at * - -lemma cpow_add {x : ℂ} (y z : ℂ) (hx : x ≠ 0) : x ^ (y + z) = x ^ y * x ^ z := -by simp [cpow_def]; simp [*, exp_add, mul_add] at * - -lemma cpow_mul {x y : ℂ} (z : ℂ) (h₁ : -π < (log x * y).im) (h₂ : (log x * y).im ≤ π) : - x ^ (y * z) = (x ^ y) ^ z := -begin - simp only [cpow_def], - split_ifs; - simp [*, exp_ne_zero, log_exp h₁ h₂, mul_assoc] at * -end - -lemma cpow_neg (x y : ℂ) : x ^ -y = (x ^ y)⁻¹ := -by simp [cpow_def]; split_ifs; simp [exp_neg] - -lemma cpow_sub {x : ℂ} (y z : ℂ) (hx : x ≠ 0) : x ^ (y - z) = x ^ y / x ^ z := -by rw [sub_eq_add_neg, cpow_add _ _ hx, cpow_neg, div_eq_mul_inv] - -lemma cpow_neg_one (x : ℂ) : x ^ (-1 : ℂ) = x⁻¹ := -by simpa using cpow_neg x 1 - -@[simp, norm_cast] lemma cpow_nat_cast (x : ℂ) : ∀ (n : ℕ), x ^ (n : ℂ) = x ^ n -| 0 := by simp -| (n + 1) := if hx : x = 0 then by simp only [hx, pow_succ, - complex.zero_cpow (nat.cast_ne_zero.2 (nat.succ_ne_zero _)), zero_mul] - else by simp [cpow_add, hx, pow_add, cpow_nat_cast n] - -@[simp] lemma cpow_two (x : ℂ) : x ^ (2 : ℂ) = x ^ 2 := -by { rw ← cpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } - -@[simp, norm_cast] lemma cpow_int_cast (x : ℂ) : ∀ (n : ℤ), x ^ (n : ℂ) = x ^ n -| (n : ℕ) := by simp; refl -| -[1+ n] := by rw zpow_neg_succ_of_nat; - simp only [int.neg_succ_of_nat_coe, int.cast_neg, complex.cpow_neg, inv_eq_one_div, - int.cast_coe_nat, cpow_nat_cast] - -lemma cpow_nat_inv_pow (x : ℂ) {n : ℕ} (hn : 0 < n) : (x ^ (n⁻¹ : ℂ)) ^ n = x := -begin - suffices : im (log x * n⁻¹) ∈ Ioc (-π) π, - { rw [← cpow_nat_cast, ← cpow_mul _ this.1 this.2, inv_mul_cancel, cpow_one], - exact_mod_cast hn.ne' }, - rw [mul_comm, ← of_real_nat_cast, ← of_real_inv, of_real_mul_im, ← div_eq_inv_mul], - have hn' : 0 < (n : ℝ), by assumption_mod_cast, - have hn1 : 1 ≤ (n : ℝ), by exact_mod_cast (nat.succ_le_iff.2 hn), - split, - { rw lt_div_iff hn', - calc -π * n ≤ -π * 1 : mul_le_mul_of_nonpos_left hn1 (neg_nonpos.2 real.pi_pos.le) - ... = -π : mul_one _ - ... < im (log x) : neg_pi_lt_log_im _ }, - { rw div_le_iff hn', - calc im (log x) ≤ π : log_im_le_pi _ - ... = π * 1 : (mul_one π).symm - ... ≤ π * n : mul_le_mul_of_nonneg_left hn1 real.pi_pos.le } -end - -end complex - -section lim - -open complex - -variables {α : Type*} - -lemma zero_cpow_eq_nhds {b : ℂ} (hb : b ≠ 0) : - (0 : ℂ).cpow =ᶠ[𝓝 b] 0 := -begin - suffices : ∀ᶠ (x : ℂ) in (𝓝 b), x ≠ 0, - from this.mono (λ x hx, by rw [cpow_eq_pow, zero_cpow hx, pi.zero_apply]), - exact is_open.eventually_mem is_open_ne hb, -end - -lemma cpow_eq_nhds {a b : ℂ} (ha : a ≠ 0) : - (λ x, x.cpow b) =ᶠ[𝓝 a] λ x, exp (log x * b) := -begin - suffices : ∀ᶠ (x : ℂ) in (𝓝 a), x ≠ 0, - from this.mono (λ x hx, by { dsimp only, rw [cpow_eq_pow, cpow_def_of_ne_zero hx], }), - exact is_open.eventually_mem is_open_ne ha, -end - -lemma cpow_eq_nhds' {p : ℂ × ℂ} (hp_fst : p.fst ≠ 0) : - (λ x, x.1 ^ x.2) =ᶠ[𝓝 p] λ x, exp (log x.1 * x.2) := -begin - suffices : ∀ᶠ (x : ℂ × ℂ) in (𝓝 p), x.1 ≠ 0, - from this.mono (λ x hx, by { dsimp only, rw cpow_def_of_ne_zero hx, }), - refine is_open.eventually_mem _ hp_fst, - change is_open {x : ℂ × ℂ | x.1 = 0}ᶜ, - rw is_open_compl_iff, - exact is_closed_eq continuous_fst continuous_const, -end - -lemma continuous_at_const_cpow {a b : ℂ} (ha : a ≠ 0) : continuous_at (cpow a) b := -begin - have cpow_eq : cpow a = λ b, exp (log a * b), - by { ext1 b, rw [cpow_eq_pow, cpow_def_of_ne_zero ha], }, - rw cpow_eq, - exact continuous_exp.continuous_at.comp (continuous_at.mul continuous_at_const continuous_at_id), -end - -lemma continuous_at_const_cpow' {a b : ℂ} (h : b ≠ 0) : continuous_at (cpow a) b := -begin - by_cases ha : a = 0, - { rw [ha, continuous_at_congr (zero_cpow_eq_nhds h)], exact continuous_at_const, }, - { exact continuous_at_const_cpow ha, }, -end - -/-- The function `z ^ w` is continuous in `(z, w)` provided that `z` does not belong to the interval -`(-∞, 0]` on the real line. See also `complex.continuous_at_cpow_zero_of_re_pos` for a version that -works for `z = 0` but assumes `0 < re w`. -/ -lemma continuous_at_cpow {p : ℂ × ℂ} (hp_fst : 0 < p.fst.re ∨ p.fst.im ≠ 0) : - continuous_at (λ x : ℂ × ℂ, x.1 ^ x.2) p := -begin - have hp_fst_ne_zero : p.fst ≠ 0, - by { intro h, cases hp_fst; { rw h at hp_fst, simpa using hp_fst, }, }, - rw continuous_at_congr (cpow_eq_nhds' hp_fst_ne_zero), - refine continuous_exp.continuous_at.comp _, - refine continuous_at.mul (continuous_at.comp _ continuous_fst.continuous_at) - continuous_snd.continuous_at, - exact continuous_at_clog hp_fst, -end - -lemma continuous_at_cpow_const {a b : ℂ} (ha : 0 < a.re ∨ a.im ≠ 0) : - continuous_at (λ x, cpow x b) a := -tendsto.comp (@continuous_at_cpow (a, b) ha) (continuous_at_id.prod continuous_at_const) - -lemma filter.tendsto.cpow {l : filter α} {f g : α → ℂ} {a b : ℂ} (hf : tendsto f l (𝓝 a)) - (hg : tendsto g l (𝓝 b)) (ha : 0 < a.re ∨ a.im ≠ 0) : - tendsto (λ x, f x ^ g x) l (𝓝 (a ^ b)) := -(@continuous_at_cpow (a,b) ha).tendsto.comp (hf.prod_mk_nhds hg) - -lemma filter.tendsto.const_cpow {l : filter α} {f : α → ℂ} {a b : ℂ} (hf : tendsto f l (𝓝 b)) - (h : a ≠ 0 ∨ b ≠ 0) : - tendsto (λ x, a ^ f x) l (𝓝 (a ^ b)) := -begin - cases h, - { exact (continuous_at_const_cpow h).tendsto.comp hf, }, - { exact (continuous_at_const_cpow' h).tendsto.comp hf, }, -end - -variables [topological_space α] {f g : α → ℂ} {s : set α} {a : α} - -lemma continuous_within_at.cpow (hf : continuous_within_at f s a) (hg : continuous_within_at g s a) - (h0 : 0 < (f a).re ∨ (f a).im ≠ 0) : - continuous_within_at (λ x, f x ^ g x) s a := -hf.cpow hg h0 - -lemma continuous_within_at.const_cpow {b : ℂ} (hf : continuous_within_at f s a) - (h : b ≠ 0 ∨ f a ≠ 0) : - continuous_within_at (λ x, b ^ f x) s a := -hf.const_cpow h - -lemma continuous_at.cpow (hf : continuous_at f a) (hg : continuous_at g a) - (h0 : 0 < (f a).re ∨ (f a).im ≠ 0) : - continuous_at (λ x, f x ^ g x) a := -hf.cpow hg h0 - -lemma continuous_at.const_cpow {b : ℂ} (hf : continuous_at f a) (h : b ≠ 0 ∨ f a ≠ 0) : - continuous_at (λ x, b ^ f x) a := -hf.const_cpow h - -lemma continuous_on.cpow (hf : continuous_on f s) (hg : continuous_on g s) - (h0 : ∀ a ∈ s, 0 < (f a).re ∨ (f a).im ≠ 0) : - continuous_on (λ x, f x ^ g x) s := -λ a ha, (hf a ha).cpow (hg a ha) (h0 a ha) - -lemma continuous_on.const_cpow {b : ℂ} (hf : continuous_on f s) (h : b ≠ 0 ∨ ∀ a ∈ s, f a ≠ 0) : - continuous_on (λ x, b ^ f x) s := -λ a ha, (hf a ha).const_cpow (h.imp id $ λ h, h a ha) - -lemma continuous.cpow (hf : continuous f) (hg : continuous g) - (h0 : ∀ a, 0 < (f a).re ∨ (f a).im ≠ 0) : - continuous (λ x, f x ^ g x) := -continuous_iff_continuous_at.2 $ λ a, (hf.continuous_at.cpow hg.continuous_at (h0 a)) - -lemma continuous.const_cpow {b : ℂ} (hf : continuous f) (h : b ≠ 0 ∨ ∀ a, f a ≠ 0) : - continuous (λ x, b ^ f x) := -continuous_iff_continuous_at.2 $ λ a, (hf.continuous_at.const_cpow $ h.imp id $ λ h, h a) - -end lim - -namespace real - -/-- The real power function `x^y`, defined as the real part of the complex power function. -For `x > 0`, it is equal to `exp(y log x)`. For `x = 0`, one sets `0^0=1` and `0^y=0` for `y ≠ 0`. -For `x < 0`, the definition is somewhat arbitary as it depends on the choice of a complex -determination of the logarithm. With our conventions, it is equal to `exp (y log x) cos (πy)`. -/ -noncomputable def rpow (x y : ℝ) := ((x : ℂ) ^ (y : ℂ)).re - -noncomputable instance : has_pow ℝ ℝ := ⟨rpow⟩ - -@[simp] lemma rpow_eq_pow (x y : ℝ) : rpow x y = x ^ y := rfl - -lemma rpow_def (x y : ℝ) : x ^ y = ((x : ℂ) ^ (y : ℂ)).re := rfl - -lemma rpow_def_of_nonneg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : x ^ y = - if x = 0 - then if y = 0 - then 1 - else 0 - else exp (log x * y) := -by simp only [rpow_def, complex.cpow_def]; - split_ifs; - simp [*, (complex.of_real_log hx).symm, -complex.of_real_mul, -is_R_or_C.of_real_mul, - (complex.of_real_mul _ _).symm, complex.exp_of_real_re] at * - -lemma rpow_def_of_pos {x : ℝ} (hx : 0 < x) (y : ℝ) : x ^ y = exp (log x * y) := -by rw [rpow_def_of_nonneg (le_of_lt hx), if_neg (ne_of_gt hx)] - -lemma exp_mul (x y : ℝ) : exp (x * y) = (exp x) ^ y := -by rw [rpow_def_of_pos (exp_pos _), log_exp] - -lemma rpow_eq_zero_iff_of_nonneg {x y : ℝ} (hx : 0 ≤ x) : x ^ y = 0 ↔ x = 0 ∧ y ≠ 0 := -by { simp only [rpow_def_of_nonneg hx], split_ifs; simp [*, exp_ne_zero] } - -open_locale real - -lemma rpow_def_of_neg {x : ℝ} (hx : x < 0) (y : ℝ) : x ^ y = exp (log x * y) * cos (y * π) := -begin - rw [rpow_def, complex.cpow_def, if_neg], - have : complex.log x * y = ↑(log(-x) * y) + ↑(y * π) * complex.I, - { simp only [complex.log, abs_of_neg hx, complex.arg_of_real_of_neg hx, - complex.abs_of_real, complex.of_real_mul], ring }, - { rw [this, complex.exp_add_mul_I, ← complex.of_real_exp, ← complex.of_real_cos, - ← complex.of_real_sin, mul_add, ← complex.of_real_mul, ← mul_assoc, ← complex.of_real_mul, - complex.add_re, complex.of_real_re, complex.mul_re, complex.I_re, complex.of_real_im, - real.log_neg_eq_log], - ring }, - { rw complex.of_real_eq_zero, exact ne_of_lt hx } -end - -lemma rpow_def_of_nonpos {x : ℝ} (hx : x ≤ 0) (y : ℝ) : x ^ y = - if x = 0 - then if y = 0 - then 1 - else 0 - else exp (log x * y) * cos (y * π) := -by split_ifs; simp [rpow_def, *]; exact rpow_def_of_neg (lt_of_le_of_ne hx h) _ - -lemma rpow_pos_of_pos {x : ℝ} (hx : 0 < x) (y : ℝ) : 0 < x ^ y := -by rw rpow_def_of_pos hx; apply exp_pos - -@[simp] lemma rpow_zero (x : ℝ) : x ^ (0 : ℝ) = 1 := by simp [rpow_def] - -@[simp] lemma zero_rpow {x : ℝ} (h : x ≠ 0) : (0 : ℝ) ^ x = 0 := -by simp [rpow_def, *] - -lemma zero_rpow_eq_iff {x : ℝ} {a : ℝ} : 0 ^ x = a ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := -begin - split, - { intros hyp, - simp [rpow_def] at hyp, - by_cases x = 0, - { subst h, - simp only [complex.one_re, complex.of_real_zero, complex.cpow_zero] at hyp, - exact or.inr ⟨rfl, hyp.symm⟩}, - { rw complex.zero_cpow (complex.of_real_ne_zero.mpr h) at hyp, - exact or.inl ⟨h, hyp.symm⟩, }, }, - { rintro (⟨h,rfl⟩|⟨rfl,rfl⟩), - { exact zero_rpow h, }, - { exact rpow_zero _, }, }, -end - -lemma eq_zero_rpow_iff {x : ℝ} {a : ℝ} : a = 0 ^ x ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := -by rw [←zero_rpow_eq_iff, eq_comm] - -@[simp] lemma rpow_one (x : ℝ) : x ^ (1 : ℝ) = x := by simp [rpow_def] - -@[simp] lemma one_rpow (x : ℝ) : (1 : ℝ) ^ x = 1 := by simp [rpow_def] - -lemma zero_rpow_le_one (x : ℝ) : (0 : ℝ) ^ x ≤ 1 := -by { by_cases h : x = 0; simp [h, zero_le_one] } - -lemma zero_rpow_nonneg (x : ℝ) : 0 ≤ (0 : ℝ) ^ x := -by { by_cases h : x = 0; simp [h, zero_le_one] } - -lemma rpow_nonneg_of_nonneg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : 0 ≤ x ^ y := -by rw [rpow_def_of_nonneg hx]; - split_ifs; simp only [zero_le_one, le_refl, le_of_lt (exp_pos _)] - -lemma abs_rpow_le_abs_rpow (x y : ℝ) : |x ^ y| ≤ |x| ^ y := -begin - rcases lt_trichotomy 0 x with (hx|rfl|hx), - { rw [abs_of_pos hx, abs_of_pos (rpow_pos_of_pos hx _)] }, - { rw [abs_zero, abs_of_nonneg (rpow_nonneg_of_nonneg le_rfl _)] }, - { rw [abs_of_neg hx, rpow_def_of_neg hx, rpow_def_of_pos (neg_pos.2 hx), log_neg_eq_log, - abs_mul, abs_of_pos (exp_pos _)], - exact mul_le_of_le_one_right (exp_pos _).le (abs_cos_le_one _) } -end - -lemma abs_rpow_le_exp_log_mul (x y : ℝ) : |x ^ y| ≤ exp (log x * y) := -begin - refine (abs_rpow_le_abs_rpow x y).trans _, - by_cases hx : x = 0, - { by_cases hy : y = 0; simp [hx, hy, zero_le_one] }, - { rw [rpow_def_of_pos (abs_pos.2 hx), log_abs] } -end - -lemma abs_rpow_of_nonneg {x y : ℝ} (hx_nonneg : 0 ≤ x) : |x ^ y| = |x| ^ y := -begin - have h_rpow_nonneg : 0 ≤ x ^ y, from real.rpow_nonneg_of_nonneg hx_nonneg _, - rw [abs_eq_self.mpr hx_nonneg, abs_eq_self.mpr h_rpow_nonneg], -end - -lemma norm_rpow_of_nonneg {x y : ℝ} (hx_nonneg : 0 ≤ x) : ∥x ^ y∥ = ∥x∥ ^ y := -by { simp_rw real.norm_eq_abs, exact abs_rpow_of_nonneg hx_nonneg, } - -end real - -namespace complex - -lemma of_real_cpow {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : ((x ^ y : ℝ) : ℂ) = (x : ℂ) ^ (y : ℂ) := -by simp [real.rpow_def_of_nonneg hx, complex.cpow_def]; split_ifs; simp [complex.of_real_log hx] - -lemma of_real_cpow_of_nonpos {x : ℝ} (hx : x ≤ 0) (y : ℂ) : - (x : ℂ) ^ y = ((-x) : ℂ) ^ y * exp (π * I * y) := -begin - rcases hx.eq_or_lt with rfl|hlt, - { rcases eq_or_ne y 0 with rfl|hy; simp * }, - have hne : (x : ℂ) ≠ 0, from of_real_ne_zero.mpr hlt.ne, - rw [cpow_def_of_ne_zero hne, cpow_def_of_ne_zero (neg_ne_zero.2 hne), ← exp_add, ← add_mul, - log, log, abs_neg, arg_of_real_of_neg hlt, ← of_real_neg, - arg_of_real_of_nonneg (neg_nonneg.2 hx), of_real_zero, zero_mul, add_zero] -end - -lemma abs_cpow_of_ne_zero {z : ℂ} (hz : z ≠ 0) (w : ℂ) : - abs (z ^ w) = abs z ^ w.re / real.exp (arg z * im w) := -by rw [cpow_def_of_ne_zero hz, abs_exp, mul_re, log_re, log_im, real.exp_sub, - real.rpow_def_of_pos (abs_pos.2 hz)] - -lemma abs_cpow_le (z w : ℂ) : abs (z ^ w) ≤ abs z ^ w.re / real.exp (arg z * im w) := -begin - rcases ne_or_eq z 0 with hz|rfl; [exact (abs_cpow_of_ne_zero hz w).le, rw abs_zero], - rcases eq_or_ne w 0 with rfl|hw, { simp }, - rw [zero_cpow hw, abs_zero], - exact div_nonneg (real.rpow_nonneg_of_nonneg le_rfl _) (real.exp_pos _).le -end - -@[simp] lemma abs_cpow_real (x : ℂ) (y : ℝ) : abs (x ^ (y : ℂ)) = x.abs ^ y := -by rcases eq_or_ne x 0 with rfl|hx; [rcases eq_or_ne y 0 with rfl|hy, skip]; - simp [*, abs_cpow_of_ne_zero] - -@[simp] lemma abs_cpow_inv_nat (x : ℂ) (n : ℕ) : abs (x ^ (n⁻¹ : ℂ)) = x.abs ^ (n⁻¹ : ℝ) := -by rw ← abs_cpow_real; simp [-abs_cpow_real] - -lemma abs_cpow_eq_rpow_re_of_pos {x : ℝ} (hx : 0 < x) (y : ℂ) : abs (x ^ y) = x ^ y.re := -by rw [abs_cpow_of_ne_zero (of_real_ne_zero.mpr hx.ne'), arg_of_real_of_nonneg hx.le, zero_mul, - real.exp_zero, div_one, abs_of_nonneg hx.le] - -lemma abs_cpow_eq_rpow_re_of_nonneg {x : ℝ} (hx : 0 ≤ x) {y : ℂ} (hy : re y ≠ 0) : - abs (x ^ y) = x ^ re y := -begin - rcases hx.eq_or_lt with rfl|hlt, - { rw [of_real_zero, zero_cpow, abs_zero, real.zero_rpow hy], - exact ne_of_apply_ne re hy }, - { exact abs_cpow_eq_rpow_re_of_pos hlt y } -end - -end complex - -namespace real - -variables {x y z : ℝ} - -lemma rpow_add (hx : 0 < x) (y z : ℝ) : x ^ (y + z) = x ^ y * x ^ z := -by simp only [rpow_def_of_pos hx, mul_add, exp_add] - -lemma rpow_add' (hx : 0 ≤ x) (h : y + z ≠ 0) : x ^ (y + z) = x ^ y * x ^ z := -begin - rcases hx.eq_or_lt with rfl|pos, - { rw [zero_rpow h, zero_eq_mul], - have : y ≠ 0 ∨ z ≠ 0, from not_and_distrib.1 (λ ⟨hy, hz⟩, h $ hy.symm ▸ hz.symm ▸ zero_add 0), - exact this.imp zero_rpow zero_rpow }, - { exact rpow_add pos _ _ } -end - -lemma rpow_add_of_nonneg (hx : 0 ≤ x) (hy : 0 ≤ y) (hz : 0 ≤ z) : - x ^ (y + z) = x ^ y * x ^ z := -begin - rcases hy.eq_or_lt with rfl|hy, - { rw [zero_add, rpow_zero, one_mul] }, - exact rpow_add' hx (ne_of_gt $ add_pos_of_pos_of_nonneg hy hz) -end - -/-- For `0 ≤ x`, the only problematic case in the equality `x ^ y * x ^ z = x ^ (y + z)` is for -`x = 0` and `y + z = 0`, where the right hand side is `1` while the left hand side can vanish. -The inequality is always true, though, and given in this lemma. -/ -lemma le_rpow_add {x : ℝ} (hx : 0 ≤ x) (y z : ℝ) : x ^ y * x ^ z ≤ x ^ (y + z) := -begin - rcases le_iff_eq_or_lt.1 hx with H|pos, - { by_cases h : y + z = 0, - { simp only [H.symm, h, rpow_zero], - calc (0 : ℝ) ^ y * 0 ^ z ≤ 1 * 1 : - mul_le_mul (zero_rpow_le_one y) (zero_rpow_le_one z) (zero_rpow_nonneg z) zero_le_one - ... = 1 : by simp }, - { simp [rpow_add', ← H, h] } }, - { simp [rpow_add pos] } -end - -lemma rpow_sum_of_pos {ι : Type*} {a : ℝ} (ha : 0 < a) (f : ι → ℝ) (s : finset ι) : - a ^ (∑ x in s, f x) = ∏ x in s, a ^ f x := -@add_monoid_hom.map_sum ℝ ι (additive ℝ) _ _ ⟨λ x : ℝ, (a ^ x : ℝ), rpow_zero a, rpow_add ha⟩ f s - -lemma rpow_sum_of_nonneg {ι : Type*} {a : ℝ} (ha : 0 ≤ a) {s : finset ι} {f : ι → ℝ} - (h : ∀ x ∈ s, 0 ≤ f x) : - a ^ (∑ x in s, f x) = ∏ x in s, a ^ f x := -begin - induction s using finset.cons_induction with i s hi ihs, - { rw [sum_empty, finset.prod_empty, rpow_zero] }, - { rw forall_mem_cons at h, - rw [sum_cons, prod_cons, ← ihs h.2, rpow_add_of_nonneg ha h.1 (sum_nonneg h.2)] } -end - -lemma rpow_mul {x : ℝ} (hx : 0 ≤ x) (y z : ℝ) : x ^ (y * z) = (x ^ y) ^ z := -by rw [← complex.of_real_inj, complex.of_real_cpow (rpow_nonneg_of_nonneg hx _), - complex.of_real_cpow hx, complex.of_real_mul, complex.cpow_mul, complex.of_real_cpow hx]; - simp only [(complex.of_real_mul _ _).symm, (complex.of_real_log hx).symm, - complex.of_real_im, neg_lt_zero, pi_pos, le_of_lt pi_pos] - -lemma rpow_neg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : x ^ -y = (x ^ y)⁻¹ := -by simp only [rpow_def_of_nonneg hx]; split_ifs; simp [*, exp_neg] at * - -lemma rpow_sub {x : ℝ} (hx : 0 < x) (y z : ℝ) : x ^ (y - z) = x ^ y / x ^ z := -by simp only [sub_eq_add_neg, rpow_add hx, rpow_neg (le_of_lt hx), div_eq_mul_inv] - -lemma rpow_sub' {x : ℝ} (hx : 0 ≤ x) {y z : ℝ} (h : y - z ≠ 0) : - x ^ (y - z) = x ^ y / x ^ z := -by { simp only [sub_eq_add_neg] at h ⊢, simp only [rpow_add' hx h, rpow_neg hx, div_eq_mul_inv] } - -lemma rpow_add_int {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℤ) : x ^ (y + n) = x ^ y * x ^ n := -by rw [rpow_def, complex.of_real_add, complex.cpow_add _ _ (complex.of_real_ne_zero.mpr hx), - complex.of_real_int_cast, complex.cpow_int_cast, ← complex.of_real_zpow, mul_comm, - complex.of_real_mul_re, ← rpow_def, mul_comm] - -lemma rpow_add_nat {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℕ) : x ^ (y + n) = x ^ y * x ^ n := -rpow_add_int hx y n - -lemma rpow_sub_int {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℤ) : x ^ (y - n) = x ^ y / x ^ n := -by simpa using rpow_add_int hx y (-n) - -lemma rpow_sub_nat {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℕ) : x ^ (y - n) = x ^ y / x ^ n := -rpow_sub_int hx y n - -lemma rpow_add_one {x : ℝ} (hx : x ≠ 0) (y : ℝ) : x ^ (y + 1) = x ^ y * x := -by simpa using rpow_add_nat hx y 1 - -lemma rpow_sub_one {x : ℝ} (hx : x ≠ 0) (y : ℝ) : x ^ (y - 1) = x ^ y / x := -by simpa using rpow_sub_nat hx y 1 - -@[simp, norm_cast] lemma rpow_int_cast (x : ℝ) (n : ℤ) : x ^ (n : ℝ) = x ^ n := -by simp only [rpow_def, ← complex.of_real_zpow, complex.cpow_int_cast, - complex.of_real_int_cast, complex.of_real_re] - -@[simp, norm_cast] lemma rpow_nat_cast (x : ℝ) (n : ℕ) : x ^ (n : ℝ) = x ^ n := -rpow_int_cast x n - -@[simp] lemma rpow_two (x : ℝ) : x ^ (2 : ℝ) = x ^ 2 := -by { rw ← rpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } - -lemma rpow_neg_one (x : ℝ) : x ^ (-1 : ℝ) = x⁻¹ := -begin - suffices H : x ^ ((-1 : ℤ) : ℝ) = x⁻¹, by exact_mod_cast H, - simp only [rpow_int_cast, zpow_one, zpow_neg₀], -end - -lemma mul_rpow {x y z : ℝ} (h : 0 ≤ x) (h₁ : 0 ≤ y) : (x*y)^z = x^z * y^z := -begin - iterate 3 { rw real.rpow_def_of_nonneg }, split_ifs; simp * at *, - { have hx : 0 < x, - { cases lt_or_eq_of_le h with h₂ h₂, { exact h₂ }, - exfalso, apply h_2, exact eq.symm h₂ }, - have hy : 0 < y, - { cases lt_or_eq_of_le h₁ with h₂ h₂, { exact h₂ }, - exfalso, apply h_3, exact eq.symm h₂ }, - rw [log_mul (ne_of_gt hx) (ne_of_gt hy), add_mul, exp_add]}, - { exact h₁ }, - { exact h }, - { exact mul_nonneg h h₁ }, -end - -lemma inv_rpow (hx : 0 ≤ x) (y : ℝ) : (x⁻¹)^y = (x^y)⁻¹ := -by simp only [← rpow_neg_one, ← rpow_mul hx, mul_comm] - -lemma div_rpow (hx : 0 ≤ x) (hy : 0 ≤ y) (z : ℝ) : (x / y) ^ z = x^z / y^z := -by simp only [div_eq_mul_inv, mul_rpow hx (inv_nonneg.2 hy), inv_rpow hy] - -lemma log_rpow {x : ℝ} (hx : 0 < x) (y : ℝ) : log (x^y) = y * (log x) := -begin - apply exp_injective, - rw [exp_log (rpow_pos_of_pos hx y), ← exp_log hx, mul_comm, rpow_def_of_pos (exp_pos (log x)) y], -end - -lemma rpow_lt_rpow (hx : 0 ≤ x) (hxy : x < y) (hz : 0 < z) : x^z < y^z := -begin - rw le_iff_eq_or_lt at hx, cases hx, - { rw [← hx, zero_rpow (ne_of_gt hz)], exact rpow_pos_of_pos (by rwa ← hx at hxy) _ }, - rw [rpow_def_of_pos hx, rpow_def_of_pos (lt_trans hx hxy), exp_lt_exp], - exact mul_lt_mul_of_pos_right (log_lt_log hx hxy) hz -end - -lemma rpow_le_rpow {x y z: ℝ} (h : 0 ≤ x) (h₁ : x ≤ y) (h₂ : 0 ≤ z) : x^z ≤ y^z := -begin - rcases eq_or_lt_of_le h₁ with rfl|h₁', { refl }, - rcases eq_or_lt_of_le h₂ with rfl|h₂', { simp }, - exact le_of_lt (rpow_lt_rpow h h₁' h₂') -end - -lemma rpow_lt_rpow_iff (hx : 0 ≤ x) (hy : 0 ≤ y) (hz : 0 < z) : x ^ z < y ^ z ↔ x < y := -⟨lt_imp_lt_of_le_imp_le $ λ h, rpow_le_rpow hy h (le_of_lt hz), λ h, rpow_lt_rpow hx h hz⟩ - -lemma rpow_le_rpow_iff (hx : 0 ≤ x) (hy : 0 ≤ y) (hz : 0 < z) : x ^ z ≤ y ^ z ↔ x ≤ y := -le_iff_le_iff_lt_iff_lt.2 $ rpow_lt_rpow_iff hy hx hz - -lemma rpow_lt_rpow_of_exponent_lt (hx : 1 < x) (hyz : y < z) : x^y < x^z := -begin - repeat {rw [rpow_def_of_pos (lt_trans zero_lt_one hx)]}, - rw exp_lt_exp, exact mul_lt_mul_of_pos_left hyz (log_pos hx), -end - -lemma rpow_le_rpow_of_exponent_le (hx : 1 ≤ x) (hyz : y ≤ z) : x^y ≤ x^z := -begin - repeat {rw [rpow_def_of_pos (lt_of_lt_of_le zero_lt_one hx)]}, - rw exp_le_exp, exact mul_le_mul_of_nonneg_left hyz (log_nonneg hx), -end - -@[simp] lemma rpow_le_rpow_left_iff (hx : 1 < x) : x ^ y ≤ x ^ z ↔ y ≤ z := -begin - have x_pos : 0 < x := lt_trans zero_lt_one hx, - rw [←log_le_log (rpow_pos_of_pos x_pos y) (rpow_pos_of_pos x_pos z), - log_rpow x_pos, log_rpow x_pos, mul_le_mul_right (log_pos hx)], -end - -@[simp] lemma rpow_lt_rpow_left_iff (hx : 1 < x) : x ^ y < x ^ z ↔ y < z := -by rw [lt_iff_not_le, rpow_le_rpow_left_iff hx, lt_iff_not_le] - -lemma rpow_lt_rpow_of_exponent_gt (hx0 : 0 < x) (hx1 : x < 1) (hyz : z < y) : - x^y < x^z := -begin - repeat {rw [rpow_def_of_pos hx0]}, - rw exp_lt_exp, exact mul_lt_mul_of_neg_left hyz (log_neg hx0 hx1), -end - -lemma rpow_le_rpow_of_exponent_ge (hx0 : 0 < x) (hx1 : x ≤ 1) (hyz : z ≤ y) : - x^y ≤ x^z := -begin - repeat {rw [rpow_def_of_pos hx0]}, - rw exp_le_exp, exact mul_le_mul_of_nonpos_left hyz (log_nonpos (le_of_lt hx0) hx1), -end - -@[simp] lemma rpow_le_rpow_left_iff_of_base_lt_one (hx0 : 0 < x) (hx1 : x < 1) : - x ^ y ≤ x ^ z ↔ z ≤ y := -begin - rw [←log_le_log (rpow_pos_of_pos hx0 y) (rpow_pos_of_pos hx0 z), - log_rpow hx0, log_rpow hx0, mul_le_mul_right_of_neg (log_neg hx0 hx1)], -end - -@[simp] lemma rpow_lt_rpow_left_iff_of_base_lt_one (hx0 : 0 < x) (hx1 : x < 1) : - x ^ y < x ^ z ↔ z < y := -by rw [lt_iff_not_le, rpow_le_rpow_left_iff_of_base_lt_one hx0 hx1, lt_iff_not_le] - -lemma rpow_lt_one {x z : ℝ} (hx1 : 0 ≤ x) (hx2 : x < 1) (hz : 0 < z) : x^z < 1 := -by { rw ← one_rpow z, exact rpow_lt_rpow hx1 hx2 hz } - -lemma rpow_le_one {x z : ℝ} (hx1 : 0 ≤ x) (hx2 : x ≤ 1) (hz : 0 ≤ z) : x^z ≤ 1 := -by { rw ← one_rpow z, exact rpow_le_rpow hx1 hx2 hz } - -lemma rpow_lt_one_of_one_lt_of_neg {x z : ℝ} (hx : 1 < x) (hz : z < 0) : x^z < 1 := -by { convert rpow_lt_rpow_of_exponent_lt hx hz, exact (rpow_zero x).symm } - -lemma rpow_le_one_of_one_le_of_nonpos {x z : ℝ} (hx : 1 ≤ x) (hz : z ≤ 0) : x^z ≤ 1 := -by { convert rpow_le_rpow_of_exponent_le hx hz, exact (rpow_zero x).symm } - -lemma one_lt_rpow {x z : ℝ} (hx : 1 < x) (hz : 0 < z) : 1 < x^z := -by { rw ← one_rpow z, exact rpow_lt_rpow zero_le_one hx hz } - -lemma one_le_rpow {x z : ℝ} (hx : 1 ≤ x) (hz : 0 ≤ z) : 1 ≤ x^z := -by { rw ← one_rpow z, exact rpow_le_rpow zero_le_one hx hz } - -lemma one_lt_rpow_of_pos_of_lt_one_of_neg (hx1 : 0 < x) (hx2 : x < 1) (hz : z < 0) : - 1 < x^z := -by { convert rpow_lt_rpow_of_exponent_gt hx1 hx2 hz, exact (rpow_zero x).symm } - -lemma one_le_rpow_of_pos_of_le_one_of_nonpos (hx1 : 0 < x) (hx2 : x ≤ 1) (hz : z ≤ 0) : - 1 ≤ x^z := -by { convert rpow_le_rpow_of_exponent_ge hx1 hx2 hz, exact (rpow_zero x).symm } - -lemma rpow_lt_one_iff_of_pos (hx : 0 < x) : x ^ y < 1 ↔ 1 < x ∧ y < 0 ∨ x < 1 ∧ 0 < y := -by rw [rpow_def_of_pos hx, exp_lt_one_iff, mul_neg_iff, log_pos_iff hx, log_neg_iff hx] - -lemma rpow_lt_one_iff (hx : 0 ≤ x) : x ^ y < 1 ↔ x = 0 ∧ y ≠ 0 ∨ 1 < x ∧ y < 0 ∨ x < 1 ∧ 0 < y := -begin - rcases hx.eq_or_lt with (rfl|hx), - { rcases em (y = 0) with (rfl|hy); simp [*, lt_irrefl, zero_lt_one] }, - { simp [rpow_lt_one_iff_of_pos hx, hx.ne.symm] } -end - -lemma one_lt_rpow_iff_of_pos (hx : 0 < x) : 1 < x ^ y ↔ 1 < x ∧ 0 < y ∨ x < 1 ∧ y < 0 := -by rw [rpow_def_of_pos hx, one_lt_exp_iff, mul_pos_iff, log_pos_iff hx, log_neg_iff hx] - -lemma one_lt_rpow_iff (hx : 0 ≤ x) : 1 < x ^ y ↔ 1 < x ∧ 0 < y ∨ 0 < x ∧ x < 1 ∧ y < 0 := -begin - rcases hx.eq_or_lt with (rfl|hx), - { rcases em (y = 0) with (rfl|hy); simp [*, lt_irrefl, (@zero_lt_one ℝ _ _).not_lt] }, - { simp [one_lt_rpow_iff_of_pos hx, hx] } -end - -lemma rpow_le_rpow_of_exponent_ge' (hx0 : 0 ≤ x) (hx1 : x ≤ 1) (hz : 0 ≤ z) (hyz : z ≤ y) : - x^y ≤ x^z := -begin - rcases eq_or_lt_of_le hx0 with rfl | hx0', - { rcases eq_or_lt_of_le hz with rfl | hz', - { exact (rpow_zero 0).symm ▸ (rpow_le_one hx0 hx1 hyz), }, - rw [zero_rpow, zero_rpow]; linarith, }, - { exact rpow_le_rpow_of_exponent_ge hx0' hx1 hyz, }, -end - -lemma rpow_left_inj_on {x : ℝ} (hx : x ≠ 0) : - inj_on (λ y : ℝ, y^x) {y : ℝ | 0 ≤ y} := -begin - rintros y hy z hz (hyz : y ^ x = z ^ x), - rw [←rpow_one y, ←rpow_one z, ←_root_.mul_inv_cancel hx, rpow_mul hy, rpow_mul hz, hyz] -end - -lemma le_rpow_iff_log_le (hx : 0 < x) (hy : 0 < y) : - x ≤ y^z ↔ real.log x ≤ z * real.log y := -by rw [←real.log_le_log hx (real.rpow_pos_of_pos hy z), real.log_rpow hy] - -lemma le_rpow_of_log_le (hx : 0 ≤ x) (hy : 0 < y) (h : real.log x ≤ z * real.log y) : - x ≤ y^z := -begin - obtain hx | rfl := hx.lt_or_eq, - { exact (le_rpow_iff_log_le hx hy).2 h }, - exact (real.rpow_pos_of_pos hy z).le, -end - -lemma lt_rpow_iff_log_lt (hx : 0 < x) (hy : 0 < y) : - x < y^z ↔ real.log x < z * real.log y := -by rw [←real.log_lt_log_iff hx (real.rpow_pos_of_pos hy z), real.log_rpow hy] - -lemma lt_rpow_of_log_lt (hx : 0 ≤ x) (hy : 0 < y) (h : real.log x < z * real.log y) : - x < y^z := -begin - obtain hx | rfl := hx.lt_or_eq, - { exact (lt_rpow_iff_log_lt hx hy).2 h }, - exact real.rpow_pos_of_pos hy z, -end - -lemma rpow_le_one_iff_of_pos (hx : 0 < x) : x ^ y ≤ 1 ↔ 1 ≤ x ∧ y ≤ 0 ∨ x ≤ 1 ∧ 0 ≤ y := -by rw [rpow_def_of_pos hx, exp_le_one_iff, mul_nonpos_iff, log_nonneg_iff hx, log_nonpos_iff hx] - -/-- Bound for `|log x * x ^ t|` in the interval `(0, 1]`, for positive real `t`. -/ -lemma abs_log_mul_self_rpow_lt (x t : ℝ) (h1 : 0 < x) (h2 : x ≤ 1) (ht : 0 < t) : - |log x * x ^ t| < 1 / t := -begin - rw lt_div_iff ht, - have := abs_log_mul_self_lt (x ^ t) (rpow_pos_of_pos h1 t) (rpow_le_one h1.le h2 ht.le), - rwa [log_rpow h1, mul_assoc, abs_mul, abs_of_pos ht, mul_comm] at this -end - -lemma pow_nat_rpow_nat_inv {x : ℝ} (hx : 0 ≤ x) {n : ℕ} (hn : 0 < n) : - (x ^ n) ^ (n⁻¹ : ℝ) = x := -have hn0 : (n : ℝ) ≠ 0, by simpa [pos_iff_ne_zero] using hn, -by rw [← rpow_nat_cast, ← rpow_mul hx, mul_inv_cancel hn0, rpow_one] - -lemma rpow_nat_inv_pow_nat {x : ℝ} (hx : 0 ≤ x) {n : ℕ} (hn : 0 < n) : - (x ^ (n⁻¹ : ℝ)) ^ n = x := -have hn0 : (n : ℝ) ≠ 0, by simpa [pos_iff_ne_zero] using hn, -by rw [← rpow_nat_cast, ← rpow_mul hx, inv_mul_cancel hn0, rpow_one] - -lemma continuous_at_const_rpow {a b : ℝ} (h : a ≠ 0) : continuous_at (rpow a) b := -begin - have : rpow a = λ x : ℝ, ((a : ℂ) ^ (x : ℂ)).re, by { ext1 x, rw [rpow_eq_pow, rpow_def], }, - rw this, - refine complex.continuous_re.continuous_at.comp _, - refine (continuous_at_const_cpow _).comp complex.continuous_of_real.continuous_at, - norm_cast, - exact h, -end - -lemma continuous_at_const_rpow' {a b : ℝ} (h : b ≠ 0) : continuous_at (rpow a) b := -begin - have : rpow a = λ x : ℝ, ((a : ℂ) ^ (x : ℂ)).re, by { ext1 x, rw [rpow_eq_pow, rpow_def], }, - rw this, - refine complex.continuous_re.continuous_at.comp _, - refine (continuous_at_const_cpow' _).comp complex.continuous_of_real.continuous_at, - norm_cast, - exact h, -end - -lemma rpow_eq_nhds_of_neg {p : ℝ × ℝ} (hp_fst : p.fst < 0) : - (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] λ x, exp (log x.1 * x.2) * cos (x.2 * π) := -begin - suffices : ∀ᶠ (x : ℝ × ℝ) in (𝓝 p), x.1 < 0, - from this.mono (λ x hx, by { dsimp only, rw rpow_def_of_neg hx, }), - exact is_open.eventually_mem (is_open_lt continuous_fst continuous_const) hp_fst, -end - -lemma rpow_eq_nhds_of_pos {p : ℝ × ℝ} (hp_fst : 0 < p.fst) : - (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] λ x, exp (log x.1 * x.2) := -begin - suffices : ∀ᶠ (x : ℝ × ℝ) in (𝓝 p), 0 < x.1, - from this.mono (λ x hx, by { dsimp only, rw rpow_def_of_pos hx, }), - exact is_open.eventually_mem (is_open_lt continuous_const continuous_fst) hp_fst, -end - -lemma continuous_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) : - continuous_at (λ p : ℝ × ℝ, p.1 ^ p.2) p := -begin - rw ne_iff_lt_or_gt at hp, - cases hp, - { rw continuous_at_congr (rpow_eq_nhds_of_neg hp), - refine continuous_at.mul _ (continuous_cos.continuous_at.comp _), - { refine continuous_exp.continuous_at.comp (continuous_at.mul _ continuous_snd.continuous_at), - refine (continuous_at_log _).comp continuous_fst.continuous_at, - exact hp.ne, }, - { exact continuous_snd.continuous_at.mul continuous_at_const, }, }, - { rw continuous_at_congr (rpow_eq_nhds_of_pos hp), - refine continuous_exp.continuous_at.comp (continuous_at.mul _ continuous_snd.continuous_at), - refine (continuous_at_log _).comp continuous_fst.continuous_at, - exact hp.lt.ne.symm, }, -end - -lemma continuous_at_rpow_of_pos (p : ℝ × ℝ) (hp : 0 < p.2) : - continuous_at (λ p : ℝ × ℝ, p.1 ^ p.2) p := -begin - cases p with x y, - obtain hx|rfl := ne_or_eq x 0, - { exact continuous_at_rpow_of_ne (x, y) hx }, - have A : tendsto (λ p : ℝ × ℝ, exp (log p.1 * p.2)) (𝓝[≠] 0 ×ᶠ 𝓝 y) (𝓝 0) := - tendsto_exp_at_bot.comp - ((tendsto_log_nhds_within_zero.comp tendsto_fst).at_bot_mul hp tendsto_snd), - have B : tendsto (λ p : ℝ × ℝ, p.1 ^ p.2) (𝓝[≠] 0 ×ᶠ 𝓝 y) (𝓝 0) := - squeeze_zero_norm (λ p, abs_rpow_le_exp_log_mul p.1 p.2) A, - have C : tendsto (λ p : ℝ × ℝ, p.1 ^ p.2) (𝓝[{0}] 0 ×ᶠ 𝓝 y) (pure 0), - { rw [nhds_within_singleton, tendsto_pure, pure_prod, eventually_map], - exact (lt_mem_nhds hp).mono (λ y hy, zero_rpow hy.ne') }, - simpa only [← sup_prod, ← nhds_within_union, compl_union_self, nhds_within_univ, nhds_prod_eq, - continuous_at, zero_rpow hp.ne'] using B.sup (C.mono_right (pure_le_nhds _)) -end - -lemma continuous_at_rpow (p : ℝ × ℝ) (h : p.1 ≠ 0 ∨ 0 < p.2) : - continuous_at (λ p : ℝ × ℝ, p.1 ^ p.2) p := -h.elim (λ h, continuous_at_rpow_of_ne p h) (λ h, continuous_at_rpow_of_pos p h) - -end real - -section - -variable {α : Type*} - -lemma filter.tendsto.rpow {l : filter α} {f g : α → ℝ} {x y : ℝ} - (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) (h : x ≠ 0 ∨ 0 < y) : - tendsto (λ t, f t ^ g t) l (𝓝 (x ^ y)) := -(real.continuous_at_rpow (x, y) h).tendsto.comp (hf.prod_mk_nhds hg) - -lemma filter.tendsto.rpow_const {l : filter α} {f : α → ℝ} {x p : ℝ} - (hf : tendsto f l (𝓝 x)) (h : x ≠ 0 ∨ 0 ≤ p) : - tendsto (λ a, f a ^ p) l (𝓝 (x ^ p)) := -if h0 : 0 = p then h0 ▸ by simp [tendsto_const_nhds] -else hf.rpow tendsto_const_nhds (h.imp id $ λ h', h'.lt_of_ne h0) - -variables [topological_space α] {f g : α → ℝ} {s : set α} {x : α} {p : ℝ} - -lemma continuous_at.rpow (hf : continuous_at f x) (hg : continuous_at g x) (h : f x ≠ 0 ∨ 0 < g x) : - continuous_at (λ t, f t ^ g t) x := -hf.rpow hg h - -lemma continuous_within_at.rpow (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) - (h : f x ≠ 0 ∨ 0 < g x) : - continuous_within_at (λ t, f t ^ g t) s x := -hf.rpow hg h - -lemma continuous_on.rpow (hf : continuous_on f s) (hg : continuous_on g s) - (h : ∀ x ∈ s, f x ≠ 0 ∨ 0 < g x) : - continuous_on (λ t, f t ^ g t) s := -λ t ht, (hf t ht).rpow (hg t ht) (h t ht) - -lemma continuous.rpow (hf : continuous f) (hg : continuous g) (h : ∀ x, f x ≠ 0 ∨ 0 < g x) : - continuous (λ x, f x ^ g x) := -continuous_iff_continuous_at.2 $ λ x, (hf.continuous_at.rpow hg.continuous_at (h x)) - -lemma continuous_within_at.rpow_const (hf : continuous_within_at f s x) (h : f x ≠ 0 ∨ 0 ≤ p) : - continuous_within_at (λ x, f x ^ p) s x := -hf.rpow_const h - -lemma continuous_at.rpow_const (hf : continuous_at f x) (h : f x ≠ 0 ∨ 0 ≤ p) : - continuous_at (λ x, f x ^ p) x := -hf.rpow_const h - -lemma continuous_on.rpow_const (hf : continuous_on f s) (h : ∀ x ∈ s, f x ≠ 0 ∨ 0 ≤ p) : - continuous_on (λ x, f x ^ p) s := -λ x hx, (hf x hx).rpow_const (h x hx) - -lemma continuous.rpow_const (hf : continuous f) (h : ∀ x, f x ≠ 0 ∨ 0 ≤ p) : - continuous (λ x, f x ^ p) := -continuous_iff_continuous_at.2 $ λ x, hf.continuous_at.rpow_const (h x) - -end - -namespace real - -variables {z x y : ℝ} - -section sqrt - -lemma sqrt_eq_rpow (x : ℝ) : sqrt x = x ^ (1/(2:ℝ)) := -begin - obtain h | h := le_or_lt 0 x, - { rw [← mul_self_inj_of_nonneg (sqrt_nonneg _) (rpow_nonneg_of_nonneg h _), mul_self_sqrt h, - ← sq, ← rpow_nat_cast, ← rpow_mul h], - norm_num }, - { have : 1 / (2:ℝ) * π = π / (2:ℝ), ring, - rw [sqrt_eq_zero_of_nonpos h.le, rpow_def_of_neg h, this, cos_pi_div_two, mul_zero] } -end - -end sqrt - -end real - -section limits -open real filter - -/-- The function `x ^ y` tends to `+∞` at `+∞` for any positive real `y`. -/ -lemma tendsto_rpow_at_top {y : ℝ} (hy : 0 < y) : tendsto (λ x : ℝ, x ^ y) at_top at_top := -begin - rw tendsto_at_top_at_top, - intro b, - use (max b 0) ^ (1/y), - intros x hx, - exact le_of_max_le_left - (by { convert rpow_le_rpow (rpow_nonneg_of_nonneg (le_max_right b 0) (1/y)) hx (le_of_lt hy), - rw [← rpow_mul (le_max_right b 0), (eq_div_iff (ne_of_gt hy)).mp rfl, rpow_one] }), -end - -/-- The function `x ^ (-y)` tends to `0` at `+∞` for any positive real `y`. -/ -lemma tendsto_rpow_neg_at_top {y : ℝ} (hy : 0 < y) : tendsto (λ x : ℝ, x ^ (-y)) at_top (𝓝 0) := -tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top 0) (λ x hx, (rpow_neg (le_of_lt hx) y).symm)) - (tendsto_rpow_at_top hy).inv_tendsto_at_top - -/-- The function `x ^ (a / (b * x + c))` tends to `1` at `+∞`, for any real numbers `a`, `b`, and -`c` such that `b` is nonzero. -/ -lemma tendsto_rpow_div_mul_add (a b c : ℝ) (hb : 0 ≠ b) : - tendsto (λ x, x ^ (a / (b*x+c))) at_top (𝓝 1) := -begin - refine tendsto.congr' _ ((tendsto_exp_nhds_0_nhds_1.comp - (by simpa only [mul_zero, pow_one] using ((@tendsto_const_nhds _ _ _ a _).mul - (tendsto_div_pow_mul_exp_add_at_top b c 1 hb)))).comp tendsto_log_at_top), - apply eventually_eq_of_mem (Ioi_mem_at_top (0:ℝ)), - intros x hx, - simp only [set.mem_Ioi, function.comp_app] at hx ⊢, - rw [exp_log hx, ← exp_log (rpow_pos_of_pos hx (a / (b * x + c))), log_rpow hx (a / (b * x + c))], - field_simp, -end - -/-- The function `x ^ (1 / x)` tends to `1` at `+∞`. -/ -lemma tendsto_rpow_div : tendsto (λ x, x ^ ((1:ℝ) / x)) at_top (𝓝 1) := -by { convert tendsto_rpow_div_mul_add (1:ℝ) _ (0:ℝ) zero_ne_one, funext, congr' 2, ring } - -/-- The function `x ^ (-1 / x)` tends to `1` at `+∞`. -/ -lemma tendsto_rpow_neg_div : tendsto (λ x, x ^ (-(1:ℝ) / x)) at_top (𝓝 1) := -by { convert tendsto_rpow_div_mul_add (-(1:ℝ)) _ (0:ℝ) zero_ne_one, funext, congr' 2, ring } - -/-- The function `exp(x) / x ^ s` tends to `+∞` at `+∞`, for any real number `s`. -/ -lemma tendsto_exp_div_rpow_at_top (s : ℝ) : tendsto (λ x : ℝ, exp x / x ^ s) at_top at_top := -begin - cases archimedean_iff_nat_lt.1 (real.archimedean) s with n hn, - refine tendsto_at_top_mono' _ _ (tendsto_exp_div_pow_at_top n), - filter_upwards [eventually_gt_at_top (0 : ℝ), eventually_ge_at_top (1 : ℝ)] with x hx₀ hx₁, - rw [div_le_div_left (exp_pos _) (pow_pos hx₀ _) (rpow_pos_of_pos hx₀ _), ←rpow_nat_cast], - exact rpow_le_rpow_of_exponent_le hx₁ hn.le, -end - -/-- The function `exp (b * x) / x ^ s` tends to `+∞` at `+∞`, for any real `s` and `b > 0`. -/ -lemma tendsto_exp_mul_div_rpow_at_top (s : ℝ) (b : ℝ) (hb : 0 < b) : - tendsto (λ x : ℝ, exp (b * x) / x ^ s) at_top at_top := -begin - refine ((tendsto_rpow_at_top hb).comp (tendsto_exp_div_rpow_at_top (s / b))).congr' _, - filter_upwards [eventually_ge_at_top (0 : ℝ)] with x hx₀, - simp [div_rpow, (exp_pos x).le, rpow_nonneg_of_nonneg, ←rpow_mul, ←exp_mul, mul_comm x, hb.ne', *] -end - -/-- The function `x ^ s * exp (-b * x)` tends to `0` at `+∞`, for any real `s` and `b > 0`. -/ -lemma tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 (s : ℝ) (b : ℝ) (hb : 0 < b): - tendsto (λ x : ℝ, x ^ s * exp (-b * x)) at_top (𝓝 0) := -begin - refine (tendsto_exp_mul_div_rpow_at_top s b hb).inv_tendsto_at_top.congr' _, - filter_upwards with x using by simp [exp_neg, inv_div, div_eq_mul_inv _ (exp _)] -end - -open asymptotics - -/-- `x ^ s = o(exp(b * x))` as `x → ∞` for any real `s` and positive `b`. -/ -lemma is_o_rpow_exp_pos_mul_at_top (s : ℝ) {b : ℝ} (hb : 0 < b) : - is_o (λ x : ℝ, x ^ s) (λ x, exp (b * x)) at_top := -iff.mpr (is_o_iff_tendsto $ λ x h, absurd h (exp_pos _).ne') $ - by simpa only [div_eq_mul_inv, exp_neg, neg_mul] - using tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 s b hb - -/-- `x ^ k = o(exp(b * x))` as `x → ∞` for any integer `k` and positive `b`. -/ -lemma is_o_zpow_exp_pos_mul_at_top (k : ℤ) {b : ℝ} (hb : 0 < b) : - is_o (λ x : ℝ, x ^ k) (λ x, exp (b * x)) at_top := -by simpa only [rpow_int_cast] using is_o_rpow_exp_pos_mul_at_top k hb - -/-- `x ^ k = o(exp(b * x))` as `x → ∞` for any natural `k` and positive `b`. -/ -lemma is_o_pow_exp_pos_mul_at_top (k : ℕ) {b : ℝ} (hb : 0 < b) : - is_o (λ x : ℝ, x ^ k) (λ x, exp (b * x)) at_top := -is_o_zpow_exp_pos_mul_at_top k hb - -/-- `x ^ s = o(exp x)` as `x → ∞` for any real `s`. -/ -lemma is_o_rpow_exp_at_top (s : ℝ) : is_o (λ x : ℝ, x ^ s) exp at_top := -by simpa only [one_mul] using is_o_rpow_exp_pos_mul_at_top s one_pos - -end limits - -namespace complex - -/-- See also `complex.continuous_at_cpow` and `complex.continuous_at_cpow_of_re_pos`. -/ -lemma continuous_at_cpow_zero_of_re_pos {z : ℂ} (hz : 0 < z.re) : - continuous_at (λ x : ℂ × ℂ, x.1 ^ x.2) (0, z) := -begin - have hz₀ : z ≠ 0, from ne_of_apply_ne re hz.ne', - rw [continuous_at, zero_cpow hz₀, tendsto_zero_iff_norm_tendsto_zero], - refine squeeze_zero (λ _, norm_nonneg _) (λ _, abs_cpow_le _ _) _, - simp only [div_eq_mul_inv, ← real.exp_neg], - refine tendsto.zero_mul_is_bounded_under_le _ _, - { convert (continuous_fst.norm.tendsto _).rpow ((continuous_re.comp continuous_snd).tendsto _) _; - simp [hz, real.zero_rpow hz.ne'] }, - { simp only [(∘), real.norm_eq_abs, abs_of_pos (real.exp_pos _)], - rcases exists_gt (|im z|) with ⟨C, hC⟩, - refine ⟨real.exp (π * C), eventually_map.2 _⟩, - refine (((continuous_im.comp continuous_snd).abs.tendsto (_, z)).eventually - (gt_mem_nhds hC)).mono (λ z hz, real.exp_le_exp.2 $ (neg_le_abs_self _).trans _), - rw _root_.abs_mul, - exact mul_le_mul (abs_le.2 ⟨(neg_pi_lt_arg _).le, arg_le_pi _⟩) hz.le - (_root_.abs_nonneg _) real.pi_pos.le } -end - -/-- See also `complex.continuous_at_cpow` for a version that assumes `p.1 ≠ 0` but makes no -assumptions about `p.2`. -/ -lemma continuous_at_cpow_of_re_pos {p : ℂ × ℂ} (h₁ : 0 ≤ p.1.re ∨ p.1.im ≠ 0) (h₂ : 0 < p.2.re) : - continuous_at (λ x : ℂ × ℂ, x.1 ^ x.2) p := -begin - cases p with z w, - rw [← not_lt_zero_iff, lt_iff_le_and_ne, not_and_distrib, ne.def, not_not, not_le_zero_iff] at h₁, - rcases h₁ with h₁|(rfl : z = 0), - exacts [continuous_at_cpow h₁, continuous_at_cpow_zero_of_re_pos h₂] -end - -/-- See also `complex.continuous_at_cpow_const` for a version that assumes `z ≠ 0` but makes no -assumptions about `w`. -/ -lemma continuous_at_cpow_const_of_re_pos {z w : ℂ} (hz : 0 ≤ re z ∨ im z ≠ 0) (hw : 0 < re w) : - continuous_at (λ x, x ^ w) z := -tendsto.comp (@continuous_at_cpow_of_re_pos (z, w) hz hw) - (continuous_at_id.prod continuous_at_const) - -lemma continuous_of_real_cpow_const {y : ℂ} (hs : 0 < y.re) : continuous (λ x, x ^ y : ℝ → ℂ) := -begin - rw continuous_iff_continuous_at, intro x, - cases le_or_lt 0 x with hx hx, - { refine (continuous_at_cpow_const_of_re_pos _ hs).comp continuous_of_real.continuous_at, - exact or.inl hx }, - { suffices : continuous_on (λ x, x ^ y : ℝ → ℂ) (set.Iio 0), - from continuous_on.continuous_at this (Iio_mem_nhds hx), - have : eq_on (λ x, x ^ y : ℝ → ℂ) (λ x, ((-x) : ℂ) ^ y * exp (π * I * y)) (set.Iio 0), - from λ y hy, of_real_cpow_of_nonpos (le_of_lt hy) _, - refine (continuous_on.mul (λ y hy, _) continuous_on_const).congr this, - refine continuous_of_real.continuous_within_at.neg.cpow continuous_within_at_const _, - left, simpa using hy } -end - -end complex - -namespace nnreal - -/-- The nonnegative real power function `x^y`, defined for `x : ℝ≥0` and `y : ℝ ` as the -restriction of the real power function. For `x > 0`, it is equal to `exp (y log x)`. For `x = 0`, -one sets `0 ^ 0 = 1` and `0 ^ y = 0` for `y ≠ 0`. -/ -noncomputable def rpow (x : ℝ≥0) (y : ℝ) : ℝ≥0 := -⟨(x : ℝ) ^ y, real.rpow_nonneg_of_nonneg x.2 y⟩ - -noncomputable instance : has_pow ℝ≥0 ℝ := ⟨rpow⟩ - -@[simp] lemma rpow_eq_pow (x : ℝ≥0) (y : ℝ) : rpow x y = x ^ y := rfl - -@[simp, norm_cast] lemma coe_rpow (x : ℝ≥0) (y : ℝ) : ((x ^ y : ℝ≥0) : ℝ) = (x : ℝ) ^ y := rfl - -@[simp] lemma rpow_zero (x : ℝ≥0) : x ^ (0 : ℝ) = 1 := -nnreal.eq $ real.rpow_zero _ - -@[simp] lemma rpow_eq_zero_iff {x : ℝ≥0} {y : ℝ} : x ^ y = 0 ↔ x = 0 ∧ y ≠ 0 := -begin - rw [← nnreal.coe_eq, coe_rpow, ← nnreal.coe_eq_zero], - exact real.rpow_eq_zero_iff_of_nonneg x.2 -end - -@[simp] lemma zero_rpow {x : ℝ} (h : x ≠ 0) : (0 : ℝ≥0) ^ x = 0 := -nnreal.eq $ real.zero_rpow h - -@[simp] lemma rpow_one (x : ℝ≥0) : x ^ (1 : ℝ) = x := -nnreal.eq $ real.rpow_one _ - -@[simp] lemma one_rpow (x : ℝ) : (1 : ℝ≥0) ^ x = 1 := -nnreal.eq $ real.one_rpow _ - -lemma rpow_add {x : ℝ≥0} (hx : x ≠ 0) (y z : ℝ) : x ^ (y + z) = x ^ y * x ^ z := -nnreal.eq $ real.rpow_add (pos_iff_ne_zero.2 hx) _ _ - -lemma rpow_add' (x : ℝ≥0) {y z : ℝ} (h : y + z ≠ 0) : x ^ (y + z) = x ^ y * x ^ z := -nnreal.eq $ real.rpow_add' x.2 h - -lemma rpow_mul (x : ℝ≥0) (y z : ℝ) : x ^ (y * z) = (x ^ y) ^ z := -nnreal.eq $ real.rpow_mul x.2 y z - -lemma rpow_neg (x : ℝ≥0) (y : ℝ) : x ^ -y = (x ^ y)⁻¹ := -nnreal.eq $ real.rpow_neg x.2 _ - -lemma rpow_neg_one (x : ℝ≥0) : x ^ (-1 : ℝ) = x ⁻¹ := -by simp [rpow_neg] - -lemma rpow_sub {x : ℝ≥0} (hx : x ≠ 0) (y z : ℝ) : x ^ (y - z) = x ^ y / x ^ z := -nnreal.eq $ real.rpow_sub (pos_iff_ne_zero.2 hx) y z - -lemma rpow_sub' (x : ℝ≥0) {y z : ℝ} (h : y - z ≠ 0) : - x ^ (y - z) = x ^ y / x ^ z := -nnreal.eq $ real.rpow_sub' x.2 h - -lemma rpow_inv_rpow_self {y : ℝ} (hy : y ≠ 0) (x : ℝ≥0) : (x ^ y) ^ (1 / y) = x := -by field_simp [← rpow_mul] - -lemma rpow_self_rpow_inv {y : ℝ} (hy : y ≠ 0) (x : ℝ≥0) : (x ^ (1 / y)) ^ y = x := -by field_simp [← rpow_mul] - -lemma inv_rpow (x : ℝ≥0) (y : ℝ) : (x⁻¹) ^ y = (x ^ y)⁻¹ := -nnreal.eq $ real.inv_rpow x.2 y - -lemma div_rpow (x y : ℝ≥0) (z : ℝ) : (x / y) ^ z = x ^ z / y ^ z := -nnreal.eq $ real.div_rpow x.2 y.2 z - -lemma sqrt_eq_rpow (x : ℝ≥0) : sqrt x = x ^ (1/(2:ℝ)) := -begin - refine nnreal.eq _, - push_cast, - exact real.sqrt_eq_rpow x.1, -end - -@[simp, norm_cast] lemma rpow_nat_cast (x : ℝ≥0) (n : ℕ) : x ^ (n : ℝ) = x ^ n := -nnreal.eq $ by simpa only [coe_rpow, coe_pow] using real.rpow_nat_cast x n - -@[simp] lemma rpow_two (x : ℝ≥0) : x ^ (2 : ℝ) = x ^ 2 := -by { rw ← rpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } - -lemma mul_rpow {x y : ℝ≥0} {z : ℝ} : (x*y)^z = x^z * y^z := -nnreal.eq $ real.mul_rpow x.2 y.2 - -lemma rpow_le_rpow {x y : ℝ≥0} {z: ℝ} (h₁ : x ≤ y) (h₂ : 0 ≤ z) : x^z ≤ y^z := -real.rpow_le_rpow x.2 h₁ h₂ - -lemma rpow_lt_rpow {x y : ℝ≥0} {z: ℝ} (h₁ : x < y) (h₂ : 0 < z) : x^z < y^z := -real.rpow_lt_rpow x.2 h₁ h₂ - -lemma rpow_lt_rpow_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ^ z < y ^ z ↔ x < y := -real.rpow_lt_rpow_iff x.2 y.2 hz - -lemma rpow_le_rpow_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ^ z ≤ y ^ z ↔ x ≤ y := -real.rpow_le_rpow_iff x.2 y.2 hz - -lemma le_rpow_one_div_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ≤ y ^ (1 / z) ↔ x ^ z ≤ y := -by rw [← rpow_le_rpow_iff hz, rpow_self_rpow_inv hz.ne'] - -lemma rpow_one_div_le_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ^ (1 / z) ≤ y ↔ x ≤ y ^ z := -by rw [← rpow_le_rpow_iff hz, rpow_self_rpow_inv hz.ne'] - -lemma rpow_lt_rpow_of_exponent_lt {x : ℝ≥0} {y z : ℝ} (hx : 1 < x) (hyz : y < z) : x^y < x^z := -real.rpow_lt_rpow_of_exponent_lt hx hyz - -lemma rpow_le_rpow_of_exponent_le {x : ℝ≥0} {y z : ℝ} (hx : 1 ≤ x) (hyz : y ≤ z) : x^y ≤ x^z := -real.rpow_le_rpow_of_exponent_le hx hyz - -lemma rpow_lt_rpow_of_exponent_gt {x : ℝ≥0} {y z : ℝ} (hx0 : 0 < x) (hx1 : x < 1) (hyz : z < y) : - x^y < x^z := -real.rpow_lt_rpow_of_exponent_gt hx0 hx1 hyz - -lemma rpow_le_rpow_of_exponent_ge {x : ℝ≥0} {y z : ℝ} (hx0 : 0 < x) (hx1 : x ≤ 1) (hyz : z ≤ y) : - x^y ≤ x^z := -real.rpow_le_rpow_of_exponent_ge hx0 hx1 hyz - -lemma rpow_pos {p : ℝ} {x : ℝ≥0} (hx_pos : 0 < x) : 0 < x^p := -begin - have rpow_pos_of_nonneg : ∀ {p : ℝ}, 0 < p → 0 < x^p, - { intros p hp_pos, - rw ←zero_rpow hp_pos.ne', - exact rpow_lt_rpow hx_pos hp_pos }, - rcases lt_trichotomy 0 p with hp_pos|rfl|hp_neg, - { exact rpow_pos_of_nonneg hp_pos }, - { simp only [zero_lt_one, rpow_zero] }, - { rw [←neg_neg p, rpow_neg, inv_pos], - exact rpow_pos_of_nonneg (neg_pos.mpr hp_neg) }, -end - -lemma rpow_lt_one {x : ℝ≥0} {z : ℝ} (hx1 : x < 1) (hz : 0 < z) : x^z < 1 := -real.rpow_lt_one (coe_nonneg x) hx1 hz - -lemma rpow_le_one {x : ℝ≥0} {z : ℝ} (hx2 : x ≤ 1) (hz : 0 ≤ z) : x^z ≤ 1 := -real.rpow_le_one x.2 hx2 hz - -lemma rpow_lt_one_of_one_lt_of_neg {x : ℝ≥0} {z : ℝ} (hx : 1 < x) (hz : z < 0) : x^z < 1 := -real.rpow_lt_one_of_one_lt_of_neg hx hz - -lemma rpow_le_one_of_one_le_of_nonpos {x : ℝ≥0} {z : ℝ} (hx : 1 ≤ x) (hz : z ≤ 0) : x^z ≤ 1 := -real.rpow_le_one_of_one_le_of_nonpos hx hz - -lemma one_lt_rpow {x : ℝ≥0} {z : ℝ} (hx : 1 < x) (hz : 0 < z) : 1 < x^z := -real.one_lt_rpow hx hz - -lemma one_le_rpow {x : ℝ≥0} {z : ℝ} (h : 1 ≤ x) (h₁ : 0 ≤ z) : 1 ≤ x^z := -real.one_le_rpow h h₁ - -lemma one_lt_rpow_of_pos_of_lt_one_of_neg {x : ℝ≥0} {z : ℝ} (hx1 : 0 < x) (hx2 : x < 1) - (hz : z < 0) : 1 < x^z := -real.one_lt_rpow_of_pos_of_lt_one_of_neg hx1 hx2 hz - -lemma one_le_rpow_of_pos_of_le_one_of_nonpos {x : ℝ≥0} {z : ℝ} (hx1 : 0 < x) (hx2 : x ≤ 1) - (hz : z ≤ 0) : 1 ≤ x^z := -real.one_le_rpow_of_pos_of_le_one_of_nonpos hx1 hx2 hz - -lemma rpow_le_self_of_le_one {x : ℝ≥0} {z : ℝ} (hx : x ≤ 1) (h_one_le : 1 ≤ z) : x ^ z ≤ x := -begin - rcases eq_bot_or_bot_lt x with rfl | (h : 0 < x), - { have : z ≠ 0 := by linarith, - simp [this] }, - nth_rewrite 1 ←nnreal.rpow_one x, - exact nnreal.rpow_le_rpow_of_exponent_ge h hx h_one_le, -end - -lemma rpow_left_injective {x : ℝ} (hx : x ≠ 0) : function.injective (λ y : ℝ≥0, y^x) := -λ y z hyz, by simpa only [rpow_inv_rpow_self hx] using congr_arg (λ y, y ^ (1 / x)) hyz - -lemma rpow_eq_rpow_iff {x y : ℝ≥0} {z : ℝ} (hz : z ≠ 0) : x ^ z = y ^ z ↔ x = y := -(rpow_left_injective hz).eq_iff - -lemma rpow_left_surjective {x : ℝ} (hx : x ≠ 0) : function.surjective (λ y : ℝ≥0, y^x) := -λ y, ⟨y ^ x⁻¹, by simp_rw [←rpow_mul, _root_.inv_mul_cancel hx, rpow_one]⟩ - -lemma rpow_left_bijective {x : ℝ} (hx : x ≠ 0) : function.bijective (λ y : ℝ≥0, y^x) := -⟨rpow_left_injective hx, rpow_left_surjective hx⟩ - -lemma eq_rpow_one_div_iff {x y : ℝ≥0} {z : ℝ} (hz : z ≠ 0) : x = y ^ (1 / z) ↔ x ^ z = y := -by rw [← rpow_eq_rpow_iff hz, rpow_self_rpow_inv hz] - -lemma rpow_one_div_eq_iff {x y : ℝ≥0} {z : ℝ} (hz : z ≠ 0) : x ^ (1 / z) = y ↔ x = y ^ z := -by rw [← rpow_eq_rpow_iff hz, rpow_self_rpow_inv hz] - -lemma pow_nat_rpow_nat_inv (x : ℝ≥0) {n : ℕ} (hn : 0 < n) : - (x ^ n) ^ (n⁻¹ : ℝ) = x := -by { rw [← nnreal.coe_eq, coe_rpow, nnreal.coe_pow], exact real.pow_nat_rpow_nat_inv x.2 hn } - -lemma rpow_nat_inv_pow_nat (x : ℝ≥0) {n : ℕ} (hn : 0 < n) : - (x ^ (n⁻¹ : ℝ)) ^ n = x := -by { rw [← nnreal.coe_eq, nnreal.coe_pow, coe_rpow], exact real.rpow_nat_inv_pow_nat x.2 hn } - -lemma continuous_at_rpow {x : ℝ≥0} {y : ℝ} (h : x ≠ 0 ∨ 0 < y) : - continuous_at (λp:ℝ≥0×ℝ, p.1^p.2) (x, y) := -begin - have : (λp:ℝ≥0×ℝ, p.1^p.2) = real.to_nnreal ∘ (λp:ℝ×ℝ, p.1^p.2) ∘ (λp:ℝ≥0 × ℝ, (p.1.1, p.2)), - { ext p, - rw [coe_rpow, real.coe_to_nnreal _ (real.rpow_nonneg_of_nonneg p.1.2 _)], - refl }, - rw this, - refine continuous_real_to_nnreal.continuous_at.comp (continuous_at.comp _ _), - { apply real.continuous_at_rpow, - simp at h, - rw ← (nnreal.coe_eq_zero x) at h, - exact h }, - { exact ((continuous_subtype_val.comp continuous_fst).prod_mk continuous_snd).continuous_at } -end - -lemma _root_.real.to_nnreal_rpow_of_nonneg {x y : ℝ} (hx : 0 ≤ x) : - real.to_nnreal (x ^ y) = (real.to_nnreal x) ^ y := -begin - nth_rewrite 0 ← real.coe_to_nnreal x hx, - rw [←nnreal.coe_rpow, real.to_nnreal_coe], -end - -end nnreal - -open filter - -lemma filter.tendsto.nnrpow {α : Type*} {f : filter α} {u : α → ℝ≥0} {v : α → ℝ} {x : ℝ≥0} {y : ℝ} - (hx : tendsto u f (𝓝 x)) (hy : tendsto v f (𝓝 y)) (h : x ≠ 0 ∨ 0 < y) : - tendsto (λ a, (u a) ^ (v a)) f (𝓝 (x ^ y)) := -tendsto.comp (nnreal.continuous_at_rpow h) (hx.prod_mk_nhds hy) - -namespace nnreal - -lemma continuous_at_rpow_const {x : ℝ≥0} {y : ℝ} (h : x ≠ 0 ∨ 0 ≤ y) : - continuous_at (λ z, z^y) x := -h.elim (λ h, tendsto_id.nnrpow tendsto_const_nhds (or.inl h)) $ - λ h, h.eq_or_lt.elim - (λ h, h ▸ by simp only [rpow_zero, continuous_at_const]) - (λ h, tendsto_id.nnrpow tendsto_const_nhds (or.inr h)) - -lemma continuous_rpow_const {y : ℝ} (h : 0 ≤ y) : - continuous (λ x : ℝ≥0, x^y) := -continuous_iff_continuous_at.2 $ λ x, continuous_at_rpow_const (or.inr h) - -theorem tendsto_rpow_at_top {y : ℝ} (hy : 0 < y) : - tendsto (λ (x : ℝ≥0), x ^ y) at_top at_top := -begin - rw filter.tendsto_at_top_at_top, - intros b, - obtain ⟨c, hc⟩ := tendsto_at_top_at_top.mp (tendsto_rpow_at_top hy) b, - use c.to_nnreal, - intros a ha, - exact_mod_cast hc a (real.to_nnreal_le_iff_le_coe.mp ha), -end - -end nnreal - -namespace ennreal - -/-- The real power function `x^y` on extended nonnegative reals, defined for `x : ℝ≥0∞` and -`y : ℝ` as the restriction of the real power function if `0 < x < ⊤`, and with the natural values -for `0` and `⊤` (i.e., `0 ^ x = 0` for `x > 0`, `1` for `x = 0` and `⊤` for `x < 0`, and -`⊤ ^ x = 1 / 0 ^ x`). -/ -noncomputable def rpow : ℝ≥0∞ → ℝ → ℝ≥0∞ -| (some x) y := if x = 0 ∧ y < 0 then ⊤ else (x ^ y : ℝ≥0) -| none y := if 0 < y then ⊤ else if y = 0 then 1 else 0 - -noncomputable instance : has_pow ℝ≥0∞ ℝ := ⟨rpow⟩ - -@[simp] lemma rpow_eq_pow (x : ℝ≥0∞) (y : ℝ) : rpow x y = x ^ y := rfl - -@[simp] lemma rpow_zero {x : ℝ≥0∞} : x ^ (0 : ℝ) = 1 := -by cases x; { dsimp only [(^), rpow], simp [lt_irrefl] } - -lemma top_rpow_def (y : ℝ) : (⊤ : ℝ≥0∞) ^ y = if 0 < y then ⊤ else if y = 0 then 1 else 0 := -rfl - -@[simp] lemma top_rpow_of_pos {y : ℝ} (h : 0 < y) : (⊤ : ℝ≥0∞) ^ y = ⊤ := -by simp [top_rpow_def, h] - -@[simp] lemma top_rpow_of_neg {y : ℝ} (h : y < 0) : (⊤ : ℝ≥0∞) ^ y = 0 := -by simp [top_rpow_def, asymm h, ne_of_lt h] - -@[simp] lemma zero_rpow_of_pos {y : ℝ} (h : 0 < y) : (0 : ℝ≥0∞) ^ y = 0 := -begin - rw [← ennreal.coe_zero, ← ennreal.some_eq_coe], - dsimp only [(^), rpow], - simp [h, asymm h, ne_of_gt h], -end - -@[simp] lemma zero_rpow_of_neg {y : ℝ} (h : y < 0) : (0 : ℝ≥0∞) ^ y = ⊤ := -begin - rw [← ennreal.coe_zero, ← ennreal.some_eq_coe], - dsimp only [(^), rpow], - simp [h, ne_of_gt h], -end - -lemma zero_rpow_def (y : ℝ) : (0 : ℝ≥0∞) ^ y = if 0 < y then 0 else if y = 0 then 1 else ⊤ := -begin - rcases lt_trichotomy 0 y with H|rfl|H, - { simp [H, ne_of_gt, zero_rpow_of_pos, lt_irrefl] }, - { simp [lt_irrefl] }, - { simp [H, asymm H, ne_of_lt, zero_rpow_of_neg] } -end - -@[simp] lemma zero_rpow_mul_self (y : ℝ) : (0 : ℝ≥0∞) ^ y * 0 ^ y = 0 ^ y := -by { rw zero_rpow_def, split_ifs, exacts [zero_mul _, one_mul _, top_mul_top] } - -@[norm_cast] lemma coe_rpow_of_ne_zero {x : ℝ≥0} (h : x ≠ 0) (y : ℝ) : - (x : ℝ≥0∞) ^ y = (x ^ y : ℝ≥0) := -begin - rw [← ennreal.some_eq_coe], - dsimp only [(^), rpow], - simp [h] -end - -@[norm_cast] lemma coe_rpow_of_nonneg (x : ℝ≥0) {y : ℝ} (h : 0 ≤ y) : - (x : ℝ≥0∞) ^ y = (x ^ y : ℝ≥0) := -begin - by_cases hx : x = 0, - { rcases le_iff_eq_or_lt.1 h with H|H, - { simp [hx, H.symm] }, - { simp [hx, zero_rpow_of_pos H, nnreal.zero_rpow (ne_of_gt H)] } }, - { exact coe_rpow_of_ne_zero hx _ } -end - -lemma coe_rpow_def (x : ℝ≥0) (y : ℝ) : - (x : ℝ≥0∞) ^ y = if x = 0 ∧ y < 0 then ⊤ else (x ^ y : ℝ≥0) := rfl - -@[simp] lemma rpow_one (x : ℝ≥0∞) : x ^ (1 : ℝ) = x := -by cases x; dsimp only [(^), rpow]; simp [zero_lt_one, not_lt_of_le zero_le_one] - -@[simp] lemma one_rpow (x : ℝ) : (1 : ℝ≥0∞) ^ x = 1 := -by { rw [← coe_one, coe_rpow_of_ne_zero one_ne_zero], simp } - -@[simp] lemma rpow_eq_zero_iff {x : ℝ≥0∞} {y : ℝ} : - x ^ y = 0 ↔ (x = 0 ∧ 0 < y) ∨ (x = ⊤ ∧ y < 0) := -begin - cases x, - { rcases lt_trichotomy y 0 with H|H|H; - simp [H, top_rpow_of_neg, top_rpow_of_pos, le_of_lt] }, - { by_cases h : x = 0, - { rcases lt_trichotomy y 0 with H|H|H; - simp [h, H, zero_rpow_of_neg, zero_rpow_of_pos, le_of_lt] }, - { simp [coe_rpow_of_ne_zero h, h] } } -end - -@[simp] lemma rpow_eq_top_iff {x : ℝ≥0∞} {y : ℝ} : - x ^ y = ⊤ ↔ (x = 0 ∧ y < 0) ∨ (x = ⊤ ∧ 0 < y) := -begin - cases x, - { rcases lt_trichotomy y 0 with H|H|H; - simp [H, top_rpow_of_neg, top_rpow_of_pos, le_of_lt] }, - { by_cases h : x = 0, - { rcases lt_trichotomy y 0 with H|H|H; - simp [h, H, zero_rpow_of_neg, zero_rpow_of_pos, le_of_lt] }, - { simp [coe_rpow_of_ne_zero h, h] } } -end - -lemma rpow_eq_top_iff_of_pos {x : ℝ≥0∞} {y : ℝ} (hy : 0 < y) : x ^ y = ⊤ ↔ x = ⊤ := -by simp [rpow_eq_top_iff, hy, asymm hy] - -lemma rpow_eq_top_of_nonneg (x : ℝ≥0∞) {y : ℝ} (hy0 : 0 ≤ y) : x ^ y = ⊤ → x = ⊤ := -begin - rw ennreal.rpow_eq_top_iff, - intro h, - cases h, - { exfalso, rw lt_iff_not_ge at h, exact h.right hy0, }, - { exact h.left, }, -end - -lemma rpow_ne_top_of_nonneg {x : ℝ≥0∞} {y : ℝ} (hy0 : 0 ≤ y) (h : x ≠ ⊤) : x ^ y ≠ ⊤ := -mt (ennreal.rpow_eq_top_of_nonneg x hy0) h - -lemma rpow_lt_top_of_nonneg {x : ℝ≥0∞} {y : ℝ} (hy0 : 0 ≤ y) (h : x ≠ ⊤) : x ^ y < ⊤ := -lt_top_iff_ne_top.mpr (ennreal.rpow_ne_top_of_nonneg hy0 h) - -lemma rpow_add {x : ℝ≥0∞} (y z : ℝ) (hx : x ≠ 0) (h'x : x ≠ ⊤) : x ^ (y + z) = x ^ y * x ^ z := -begin - cases x, { exact (h'x rfl).elim }, - have : x ≠ 0 := λ h, by simpa [h] using hx, - simp [coe_rpow_of_ne_zero this, nnreal.rpow_add this] -end - -lemma rpow_neg (x : ℝ≥0∞) (y : ℝ) : x ^ -y = (x ^ y)⁻¹ := -begin - cases x, - { rcases lt_trichotomy y 0 with H|H|H; - simp [top_rpow_of_pos, top_rpow_of_neg, H, neg_pos.mpr] }, - { by_cases h : x = 0, - { rcases lt_trichotomy y 0 with H|H|H; - simp [h, zero_rpow_of_pos, zero_rpow_of_neg, H, neg_pos.mpr] }, - { have A : x ^ y ≠ 0, by simp [h], - simp [coe_rpow_of_ne_zero h, ← coe_inv A, nnreal.rpow_neg] } } -end - -lemma rpow_sub {x : ℝ≥0∞} (y z : ℝ) (hx : x ≠ 0) (h'x : x ≠ ⊤) : x ^ (y - z) = x ^ y / x ^ z := -by rw [sub_eq_add_neg, rpow_add _ _ hx h'x, rpow_neg, div_eq_mul_inv] - -lemma rpow_neg_one (x : ℝ≥0∞) : x ^ (-1 : ℝ) = x ⁻¹ := -by simp [rpow_neg] - -lemma rpow_mul (x : ℝ≥0∞) (y z : ℝ) : x ^ (y * z) = (x ^ y) ^ z := -begin - cases x, - { rcases lt_trichotomy y 0 with Hy|Hy|Hy; - rcases lt_trichotomy z 0 with Hz|Hz|Hz; - simp [Hy, Hz, zero_rpow_of_neg, zero_rpow_of_pos, top_rpow_of_neg, top_rpow_of_pos, - mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, mul_neg_of_pos_of_neg] }, - { by_cases h : x = 0, - { rcases lt_trichotomy y 0 with Hy|Hy|Hy; - rcases lt_trichotomy z 0 with Hz|Hz|Hz; - simp [h, Hy, Hz, zero_rpow_of_neg, zero_rpow_of_pos, top_rpow_of_neg, top_rpow_of_pos, - mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, mul_neg_of_pos_of_neg] }, - { have : x ^ y ≠ 0, by simp [h], - simp [coe_rpow_of_ne_zero h, coe_rpow_of_ne_zero this, nnreal.rpow_mul] } } -end - -@[simp, norm_cast] lemma rpow_nat_cast (x : ℝ≥0∞) (n : ℕ) : x ^ (n : ℝ) = x ^ n := -begin - cases x, - { cases n; - simp [top_rpow_of_pos (nat.cast_add_one_pos _), top_pow (nat.succ_pos _)] }, - { simp [coe_rpow_of_nonneg _ (nat.cast_nonneg n)] } -end - -@[simp] lemma rpow_two (x : ℝ≥0∞) : x ^ (2 : ℝ) = x ^ 2 := -by { rw ← rpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } - -lemma mul_rpow_eq_ite (x y : ℝ≥0∞) (z : ℝ) : - (x * y) ^ z = if (x = 0 ∧ y = ⊤ ∨ x = ⊤ ∧ y = 0) ∧ z < 0 then ⊤ else x ^ z * y ^ z := -begin - rcases eq_or_ne z 0 with rfl|hz, { simp }, - replace hz := hz.lt_or_lt, - wlog hxy : x ≤ y := le_total x y using [x y, y x] tactic.skip, - { rcases eq_or_ne x 0 with rfl|hx0, - { induction y using with_top.rec_top_coe; cases hz with hz hz; simp [*, hz.not_lt] }, - rcases eq_or_ne y 0 with rfl|hy0, { exact (hx0 (bot_unique hxy)).elim }, - induction x using with_top.rec_top_coe, { cases hz with hz hz; simp [hz, top_unique hxy] }, - induction y using with_top.rec_top_coe, { cases hz with hz hz; simp * }, - simp only [*, false_and, and_false, false_or, if_false], - norm_cast at *, - rw [coe_rpow_of_ne_zero (mul_ne_zero hx0 hy0), nnreal.mul_rpow] }, - { convert this using 2; simp only [mul_comm, and_comm, or_comm] } -end - -lemma mul_rpow_of_ne_top {x y : ℝ≥0∞} (hx : x ≠ ⊤) (hy : y ≠ ⊤) (z : ℝ) : - (x * y) ^ z = x^z * y^z := -by simp [*, mul_rpow_eq_ite] - -@[norm_cast] lemma coe_mul_rpow (x y : ℝ≥0) (z : ℝ) : - ((x : ℝ≥0∞) * y) ^ z = x^z * y^z := -mul_rpow_of_ne_top coe_ne_top coe_ne_top z - -lemma mul_rpow_of_ne_zero {x y : ℝ≥0∞} (hx : x ≠ 0) (hy : y ≠ 0) (z : ℝ) : - (x * y) ^ z = x ^ z * y ^ z := -by simp [*, mul_rpow_eq_ite] - -lemma mul_rpow_of_nonneg (x y : ℝ≥0∞) {z : ℝ} (hz : 0 ≤ z) : - (x * y) ^ z = x ^ z * y ^ z := -by simp [hz.not_lt, mul_rpow_eq_ite] - -lemma inv_rpow (x : ℝ≥0∞) (y : ℝ) : (x⁻¹) ^ y = (x ^ y)⁻¹ := -begin - rcases eq_or_ne y 0 with rfl|hy, { simp only [rpow_zero, inv_one] }, - replace hy := hy.lt_or_lt, - rcases eq_or_ne x 0 with rfl|h0, { cases hy; simp * }, - rcases eq_or_ne x ⊤ with rfl|h_top, { cases hy; simp * }, - apply eq_inv_of_mul_eq_one, - rw [← mul_rpow_of_ne_zero (inv_ne_zero.2 h_top) h0, inv_mul_cancel h0 h_top, one_rpow] -end - -lemma div_rpow_of_nonneg (x y : ℝ≥0∞) {z : ℝ} (hz : 0 ≤ z) : - (x / y) ^ z = x ^ z / y ^ z := -by rw [div_eq_mul_inv, mul_rpow_of_nonneg _ _ hz, inv_rpow, div_eq_mul_inv] - -lemma strict_mono_rpow_of_pos {z : ℝ} (h : 0 < z) : strict_mono (λ x : ℝ≥0∞, x ^ z) := -begin - intros x y hxy, - lift x to ℝ≥0 using ne_top_of_lt hxy, - rcases eq_or_ne y ∞ with rfl|hy, - { simp only [top_rpow_of_pos h, coe_rpow_of_nonneg _ h.le, coe_lt_top] }, - { lift y to ℝ≥0 using hy, - simp only [coe_rpow_of_nonneg _ h.le, nnreal.rpow_lt_rpow (coe_lt_coe.1 hxy) h, coe_lt_coe] } -end - -lemma monotone_rpow_of_nonneg {z : ℝ} (h : 0 ≤ z) : monotone (λ x : ℝ≥0∞, x ^ z) := -h.eq_or_lt.elim (λ h0, h0 ▸ by simp only [rpow_zero, monotone_const]) - (λ h0, (strict_mono_rpow_of_pos h0).monotone) - -/-- Bundles `λ x : ℝ≥0∞, x ^ y` into an order isomorphism when `y : ℝ` is positive, -where the inverse is `λ x : ℝ≥0∞, x ^ (1 / y)`. -/ -@[simps apply] def order_iso_rpow (y : ℝ) (hy : 0 < y) : ℝ≥0∞ ≃o ℝ≥0∞ := -(strict_mono_rpow_of_pos hy).order_iso_of_right_inverse (λ x, x ^ y) (λ x, x ^ (1 / y)) - (λ x, by { dsimp, rw [←rpow_mul, one_div_mul_cancel hy.ne.symm, rpow_one] }) - -lemma order_iso_rpow_symm_apply (y : ℝ) (hy : 0 < y) : - (order_iso_rpow y hy).symm = order_iso_rpow (1 / y) (one_div_pos.2 hy) := -by { simp only [order_iso_rpow, one_div_one_div], refl } - -lemma rpow_le_rpow {x y : ℝ≥0∞} {z : ℝ} (h₁ : x ≤ y) (h₂ : 0 ≤ z) : x^z ≤ y^z := -monotone_rpow_of_nonneg h₂ h₁ - -lemma rpow_lt_rpow {x y : ℝ≥0∞} {z : ℝ} (h₁ : x < y) (h₂ : 0 < z) : x^z < y^z := -strict_mono_rpow_of_pos h₂ h₁ - -lemma rpow_le_rpow_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ^ z ≤ y ^ z ↔ x ≤ y := -(strict_mono_rpow_of_pos hz).le_iff_le - -lemma rpow_lt_rpow_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ^ z < y ^ z ↔ x < y := -(strict_mono_rpow_of_pos hz).lt_iff_lt - -lemma le_rpow_one_div_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ≤ y ^ (1 / z) ↔ x ^ z ≤ y := -begin - nth_rewrite 0 ←rpow_one x, - nth_rewrite 0 ←@_root_.mul_inv_cancel _ _ z hz.ne', - rw [rpow_mul, ←one_div, @rpow_le_rpow_iff _ _ (1/z) (by simp [hz])], -end - -lemma lt_rpow_one_div_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x < y ^ (1 / z) ↔ x ^ z < y := -begin - nth_rewrite 0 ←rpow_one x, - nth_rewrite 0 ←@_root_.mul_inv_cancel _ _ z (ne_of_lt hz).symm, - rw [rpow_mul, ←one_div, @rpow_lt_rpow_iff _ _ (1/z) (by simp [hz])], -end - -lemma rpow_one_div_le_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ^ (1 / z) ≤ y ↔ x ≤ y ^ z := -begin - nth_rewrite 0 ← ennreal.rpow_one y, - nth_rewrite 1 ← @_root_.mul_inv_cancel _ _ z hz.ne.symm, - rw [ennreal.rpow_mul, ← one_div, ennreal.rpow_le_rpow_iff (one_div_pos.2 hz)], -end - -lemma rpow_lt_rpow_of_exponent_lt {x : ℝ≥0∞} {y z : ℝ} (hx : 1 < x) (hx' : x ≠ ⊤) (hyz : y < z) : - x^y < x^z := -begin - lift x to ℝ≥0 using hx', - rw [one_lt_coe_iff] at hx, - simp [coe_rpow_of_ne_zero (ne_of_gt (lt_trans zero_lt_one hx)), - nnreal.rpow_lt_rpow_of_exponent_lt hx hyz] -end - -lemma rpow_le_rpow_of_exponent_le {x : ℝ≥0∞} {y z : ℝ} (hx : 1 ≤ x) (hyz : y ≤ z) : x^y ≤ x^z := -begin - cases x, - { rcases lt_trichotomy y 0 with Hy|Hy|Hy; - rcases lt_trichotomy z 0 with Hz|Hz|Hz; - simp [Hy, Hz, top_rpow_of_neg, top_rpow_of_pos, le_refl]; - linarith }, - { simp only [one_le_coe_iff, some_eq_coe] at hx, - simp [coe_rpow_of_ne_zero (ne_of_gt (lt_of_lt_of_le zero_lt_one hx)), - nnreal.rpow_le_rpow_of_exponent_le hx hyz] } -end - -lemma rpow_lt_rpow_of_exponent_gt {x : ℝ≥0∞} {y z : ℝ} (hx0 : 0 < x) (hx1 : x < 1) (hyz : z < y) : - x^y < x^z := -begin - lift x to ℝ≥0 using ne_of_lt (lt_of_lt_of_le hx1 le_top), - simp at hx0 hx1, - simp [coe_rpow_of_ne_zero (ne_of_gt hx0), nnreal.rpow_lt_rpow_of_exponent_gt hx0 hx1 hyz] -end - -lemma rpow_le_rpow_of_exponent_ge {x : ℝ≥0∞} {y z : ℝ} (hx1 : x ≤ 1) (hyz : z ≤ y) : - x^y ≤ x^z := -begin - lift x to ℝ≥0 using ne_of_lt (lt_of_le_of_lt hx1 coe_lt_top), - by_cases h : x = 0, - { rcases lt_trichotomy y 0 with Hy|Hy|Hy; - rcases lt_trichotomy z 0 with Hz|Hz|Hz; - simp [Hy, Hz, h, zero_rpow_of_neg, zero_rpow_of_pos, le_refl]; - linarith }, - { simp at hx1, - simp [coe_rpow_of_ne_zero h, - nnreal.rpow_le_rpow_of_exponent_ge (bot_lt_iff_ne_bot.mpr h) hx1 hyz] } -end - -lemma rpow_le_self_of_le_one {x : ℝ≥0∞} {z : ℝ} (hx : x ≤ 1) (h_one_le : 1 ≤ z) : x ^ z ≤ x := -begin - nth_rewrite 1 ←ennreal.rpow_one x, - exact ennreal.rpow_le_rpow_of_exponent_ge hx h_one_le, -end - -lemma le_rpow_self_of_one_le {x : ℝ≥0∞} {z : ℝ} (hx : 1 ≤ x) (h_one_le : 1 ≤ z) : x ≤ x ^ z := -begin - nth_rewrite 0 ←ennreal.rpow_one x, - exact ennreal.rpow_le_rpow_of_exponent_le hx h_one_le, -end - -lemma rpow_pos_of_nonneg {p : ℝ} {x : ℝ≥0∞} (hx_pos : 0 < x) (hp_nonneg : 0 ≤ p) : 0 < x^p := -begin - by_cases hp_zero : p = 0, - { simp [hp_zero, ennreal.zero_lt_one], }, - { rw ←ne.def at hp_zero, - have hp_pos := lt_of_le_of_ne hp_nonneg hp_zero.symm, - rw ←zero_rpow_of_pos hp_pos, exact rpow_lt_rpow hx_pos hp_pos, }, -end - -lemma rpow_pos {p : ℝ} {x : ℝ≥0∞} (hx_pos : 0 < x) (hx_ne_top : x ≠ ⊤) : 0 < x^p := -begin - cases lt_or_le 0 p with hp_pos hp_nonpos, - { exact rpow_pos_of_nonneg hx_pos (le_of_lt hp_pos), }, - { rw [←neg_neg p, rpow_neg, inv_pos], - exact rpow_ne_top_of_nonneg (by simp [hp_nonpos]) hx_ne_top, }, -end - -lemma rpow_lt_one {x : ℝ≥0∞} {z : ℝ} (hx : x < 1) (hz : 0 < z) : x^z < 1 := -begin - lift x to ℝ≥0 using ne_of_lt (lt_of_lt_of_le hx le_top), - simp only [coe_lt_one_iff] at hx, - simp [coe_rpow_of_nonneg _ (le_of_lt hz), nnreal.rpow_lt_one hx hz], -end - -lemma rpow_le_one {x : ℝ≥0∞} {z : ℝ} (hx : x ≤ 1) (hz : 0 ≤ z) : x^z ≤ 1 := -begin - lift x to ℝ≥0 using ne_of_lt (lt_of_le_of_lt hx coe_lt_top), - simp only [coe_le_one_iff] at hx, - simp [coe_rpow_of_nonneg _ hz, nnreal.rpow_le_one hx hz], -end - -lemma rpow_lt_one_of_one_lt_of_neg {x : ℝ≥0∞} {z : ℝ} (hx : 1 < x) (hz : z < 0) : x^z < 1 := -begin - cases x, - { simp [top_rpow_of_neg hz, ennreal.zero_lt_one] }, - { simp only [some_eq_coe, one_lt_coe_iff] at hx, - simp [coe_rpow_of_ne_zero (ne_of_gt (lt_trans zero_lt_one hx)), - nnreal.rpow_lt_one_of_one_lt_of_neg hx hz] }, -end - -lemma rpow_le_one_of_one_le_of_neg {x : ℝ≥0∞} {z : ℝ} (hx : 1 ≤ x) (hz : z < 0) : x^z ≤ 1 := -begin - cases x, - { simp [top_rpow_of_neg hz, ennreal.zero_lt_one] }, - { simp only [one_le_coe_iff, some_eq_coe] at hx, - simp [coe_rpow_of_ne_zero (ne_of_gt (lt_of_lt_of_le zero_lt_one hx)), - nnreal.rpow_le_one_of_one_le_of_nonpos hx (le_of_lt hz)] }, -end - -lemma one_lt_rpow {x : ℝ≥0∞} {z : ℝ} (hx : 1 < x) (hz : 0 < z) : 1 < x^z := -begin - cases x, - { simp [top_rpow_of_pos hz] }, - { simp only [some_eq_coe, one_lt_coe_iff] at hx, - simp [coe_rpow_of_nonneg _ (le_of_lt hz), nnreal.one_lt_rpow hx hz] } -end - -lemma one_le_rpow {x : ℝ≥0∞} {z : ℝ} (hx : 1 ≤ x) (hz : 0 < z) : 1 ≤ x^z := -begin - cases x, - { simp [top_rpow_of_pos hz] }, - { simp only [one_le_coe_iff, some_eq_coe] at hx, - simp [coe_rpow_of_nonneg _ (le_of_lt hz), nnreal.one_le_rpow hx (le_of_lt hz)] }, -end - -lemma one_lt_rpow_of_pos_of_lt_one_of_neg {x : ℝ≥0∞} {z : ℝ} (hx1 : 0 < x) (hx2 : x < 1) - (hz : z < 0) : 1 < x^z := -begin - lift x to ℝ≥0 using ne_of_lt (lt_of_lt_of_le hx2 le_top), - simp only [coe_lt_one_iff, coe_pos] at ⊢ hx1 hx2, - simp [coe_rpow_of_ne_zero (ne_of_gt hx1), nnreal.one_lt_rpow_of_pos_of_lt_one_of_neg hx1 hx2 hz], -end - -lemma one_le_rpow_of_pos_of_le_one_of_neg {x : ℝ≥0∞} {z : ℝ} (hx1 : 0 < x) (hx2 : x ≤ 1) - (hz : z < 0) : 1 ≤ x^z := -begin - lift x to ℝ≥0 using ne_of_lt (lt_of_le_of_lt hx2 coe_lt_top), - simp only [coe_le_one_iff, coe_pos] at ⊢ hx1 hx2, - simp [coe_rpow_of_ne_zero (ne_of_gt hx1), - nnreal.one_le_rpow_of_pos_of_le_one_of_nonpos hx1 hx2 (le_of_lt hz)], -end - -lemma to_nnreal_rpow (x : ℝ≥0∞) (z : ℝ) : (x.to_nnreal) ^ z = (x ^ z).to_nnreal := -begin - rcases lt_trichotomy z 0 with H|H|H, - { cases x, { simp [H, ne_of_lt] }, - by_cases hx : x = 0, - { simp [hx, H, ne_of_lt] }, - { simp [coe_rpow_of_ne_zero hx] } }, - { simp [H] }, - { cases x, { simp [H, ne_of_gt] }, - simp [coe_rpow_of_nonneg _ (le_of_lt H)] } -end - -lemma to_real_rpow (x : ℝ≥0∞) (z : ℝ) : (x.to_real) ^ z = (x ^ z).to_real := -by rw [ennreal.to_real, ennreal.to_real, ←nnreal.coe_rpow, ennreal.to_nnreal_rpow] - -lemma of_real_rpow_of_pos {x p : ℝ} (hx_pos : 0 < x) : - ennreal.of_real x ^ p = ennreal.of_real (x ^ p) := -begin - simp_rw ennreal.of_real, - rw [coe_rpow_of_ne_zero, coe_eq_coe, real.to_nnreal_rpow_of_nonneg hx_pos.le], - simp [hx_pos], -end - -lemma of_real_rpow_of_nonneg {x p : ℝ} (hx_nonneg : 0 ≤ x) (hp_nonneg : 0 ≤ p) : - ennreal.of_real x ^ p = ennreal.of_real (x ^ p) := -begin - by_cases hp0 : p = 0, - { simp [hp0], }, - by_cases hx0 : x = 0, - { rw ← ne.def at hp0, - have hp_pos : 0 < p := lt_of_le_of_ne hp_nonneg hp0.symm, - simp [hx0, hp_pos, hp_pos.ne.symm], }, - rw ← ne.def at hx0, - exact of_real_rpow_of_pos (hx_nonneg.lt_of_ne hx0.symm), -end - -lemma rpow_left_injective {x : ℝ} (hx : x ≠ 0) : - function.injective (λ y : ℝ≥0∞, y^x) := -begin - intros y z hyz, - dsimp only at hyz, - rw [←rpow_one y, ←rpow_one z, ←_root_.mul_inv_cancel hx, rpow_mul, rpow_mul, hyz], -end - -lemma rpow_left_surjective {x : ℝ} (hx : x ≠ 0) : - function.surjective (λ y : ℝ≥0∞, y^x) := -λ y, ⟨y ^ x⁻¹, by simp_rw [←rpow_mul, _root_.inv_mul_cancel hx, rpow_one]⟩ - -lemma rpow_left_bijective {x : ℝ} (hx : x ≠ 0) : - function.bijective (λ y : ℝ≥0∞, y^x) := -⟨rpow_left_injective hx, rpow_left_surjective hx⟩ - -theorem tendsto_rpow_at_top {y : ℝ} (hy : 0 < y) : - tendsto (λ (x : ℝ≥0∞), x ^ y) (𝓝 ⊤) (𝓝 ⊤) := -begin - rw tendsto_nhds_top_iff_nnreal, - intros x, - obtain ⟨c, _, hc⟩ := - (at_top_basis_Ioi.tendsto_iff at_top_basis_Ioi).mp (nnreal.tendsto_rpow_at_top hy) x trivial, - have hc' : set.Ioi (↑c) ∈ 𝓝 (⊤ : ℝ≥0∞) := Ioi_mem_nhds coe_lt_top, - refine eventually_of_mem hc' _, - intros a ha, - by_cases ha' : a = ⊤, - { simp [ha', hy] }, - lift a to ℝ≥0 using ha', - change ↑c < ↑a at ha, - rw coe_rpow_of_nonneg _ hy.le, - exact_mod_cast hc a (by exact_mod_cast ha), -end - -private lemma continuous_at_rpow_const_of_pos {x : ℝ≥0∞} {y : ℝ} (h : 0 < y) : - continuous_at (λ a : ℝ≥0∞, a ^ y) x := -begin - by_cases hx : x = ⊤, - { rw [hx, continuous_at], - convert tendsto_rpow_at_top h, - simp [h] }, - lift x to ℝ≥0 using hx, - rw continuous_at_coe_iff, - convert continuous_coe.continuous_at.comp - (nnreal.continuous_at_rpow_const (or.inr h.le)) using 1, - ext1 x, - simp [coe_rpow_of_nonneg _ h.le] -end - -@[continuity] -lemma continuous_rpow_const {y : ℝ} : continuous (λ a : ℝ≥0∞, a ^ y) := -begin - apply continuous_iff_continuous_at.2 (λ x, _), - rcases lt_trichotomy 0 y with hy|rfl|hy, - { exact continuous_at_rpow_const_of_pos hy }, - { simp, exact continuous_at_const }, - { obtain ⟨z, hz⟩ : ∃ z, y = -z := ⟨-y, (neg_neg _).symm⟩, - have z_pos : 0 < z, by simpa [hz] using hy, - simp_rw [hz, rpow_neg], - exact continuous_inv.continuous_at.comp (continuous_at_rpow_const_of_pos z_pos) } -end - -lemma tendsto_const_mul_rpow_nhds_zero_of_pos {c : ℝ≥0∞} (hc : c ≠ ∞) {y : ℝ} (hy : 0 < y) : - tendsto (λ x : ℝ≥0∞, c * x ^ y) (𝓝 0) (𝓝 0) := -begin - convert ennreal.tendsto.const_mul (ennreal.continuous_rpow_const.tendsto 0) _, - { simp [hy] }, - { exact or.inr hc } -end - -end ennreal - -lemma filter.tendsto.ennrpow_const {α : Type*} {f : filter α} {m : α → ℝ≥0∞} {a : ℝ≥0∞} (r : ℝ) - (hm : tendsto m f (𝓝 a)) : - tendsto (λ x, (m x) ^ r) f (𝓝 (a ^ r)) := -(ennreal.continuous_rpow_const.tendsto a).comp hm - -namespace norm_num -open tactic - -theorem rpow_pos (a b : ℝ) (b' : ℕ) (c : ℝ) (hb : b = b') (h : a ^ b' = c) : a ^ b = c := -by rw [← h, hb, real.rpow_nat_cast] -theorem rpow_neg (a b : ℝ) (b' : ℕ) (c c' : ℝ) - (a0 : 0 ≤ a) (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := -by rw [← hc, ← h, hb, real.rpow_neg a0, real.rpow_nat_cast] - -/-- Evaluate `real.rpow a b` where `a` is a rational numeral and `b` is an integer. -(This cannot go via the generalized version `prove_rpow'` because `rpow_pos` has a side condition; -we do not attempt to evaluate `a ^ b` where `a` and `b` are both negative because it comes -out to some garbage.) -/ -meta def prove_rpow (a b : expr) : tactic (expr × expr) := do - na ← a.to_rat, - ic ← mk_instance_cache `(ℝ), - match match_sign b with - | sum.inl b := do - (ic, a0) ← guard (na ≥ 0) >> prove_nonneg ic a, - nc ← mk_instance_cache `(ℕ), - (ic, nc, b', hb) ← prove_nat_uncast ic nc b, - (ic, c, h) ← prove_pow a na ic b', - cr ← c.to_rat, - (ic, c', hc) ← prove_inv ic c cr, - pure (c', (expr.const ``rpow_neg []).mk_app [a, b, b', c, c', a0, hb, h, hc]) - | sum.inr ff := pure (`(1:ℝ), expr.const ``real.rpow_zero [] a) - | sum.inr tt := do - nc ← mk_instance_cache `(ℕ), - (ic, nc, b', hb) ← prove_nat_uncast ic nc b, - (ic, c, h) ← prove_pow a na ic b', - pure (c, (expr.const ``rpow_pos []).mk_app [a, b, b', c, hb, h]) - end - -/-- Generalized version of `prove_cpow`, `prove_nnrpow`, `prove_ennrpow`. -/ -meta def prove_rpow' (pos neg zero : name) (α β one a b : expr) : tactic (expr × expr) := do - na ← a.to_rat, - icα ← mk_instance_cache α, - icβ ← mk_instance_cache β, - match match_sign b with - | sum.inl b := do - nc ← mk_instance_cache `(ℕ), - (icβ, nc, b', hb) ← prove_nat_uncast icβ nc b, - (icα, c, h) ← prove_pow a na icα b', - cr ← c.to_rat, - (icα, c', hc) ← prove_inv icα c cr, - pure (c', (expr.const neg []).mk_app [a, b, b', c, c', hb, h, hc]) - | sum.inr ff := pure (one, expr.const zero [] a) - | sum.inr tt := do - nc ← mk_instance_cache `(ℕ), - (icβ, nc, b', hb) ← prove_nat_uncast icβ nc b, - (icα, c, h) ← prove_pow a na icα b', - pure (c, (expr.const pos []).mk_app [a, b, b', c, hb, h]) - end - -open_locale nnreal ennreal - -theorem cpow_pos (a b : ℂ) (b' : ℕ) (c : ℂ) (hb : b = b') (h : a ^ b' = c) : a ^ b = c := -by rw [← h, hb, complex.cpow_nat_cast] -theorem cpow_neg (a b : ℂ) (b' : ℕ) (c c' : ℂ) - (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := -by rw [← hc, ← h, hb, complex.cpow_neg, complex.cpow_nat_cast] - -theorem nnrpow_pos (a : ℝ≥0) (b : ℝ) (b' : ℕ) (c : ℝ≥0) - (hb : b = b') (h : a ^ b' = c) : a ^ b = c := -by rw [← h, hb, nnreal.rpow_nat_cast] -theorem nnrpow_neg (a : ℝ≥0) (b : ℝ) (b' : ℕ) (c c' : ℝ≥0) - (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := -by rw [← hc, ← h, hb, nnreal.rpow_neg, nnreal.rpow_nat_cast] - -theorem ennrpow_pos (a : ℝ≥0∞) (b : ℝ) (b' : ℕ) (c : ℝ≥0∞) - (hb : b = b') (h : a ^ b' = c) : a ^ b = c := -by rw [← h, hb, ennreal.rpow_nat_cast] -theorem ennrpow_neg (a : ℝ≥0∞) (b : ℝ) (b' : ℕ) (c c' : ℝ≥0∞) - (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := -by rw [← hc, ← h, hb, ennreal.rpow_neg, ennreal.rpow_nat_cast] - -/-- Evaluate `complex.cpow a b` where `a` is a rational numeral and `b` is an integer. -/ -meta def prove_cpow : expr → expr → tactic (expr × expr) := -prove_rpow' ``cpow_pos ``cpow_neg ``complex.cpow_zero `(ℂ) `(ℂ) `(1:ℂ) - -/-- Evaluate `nnreal.rpow a b` where `a` is a rational numeral and `b` is an integer. -/ -meta def prove_nnrpow : expr → expr → tactic (expr × expr) := -prove_rpow' ``nnrpow_pos ``nnrpow_neg ``nnreal.rpow_zero `(ℝ≥0) `(ℝ) `(1:ℝ≥0) - -/-- Evaluate `ennreal.rpow a b` where `a` is a rational numeral and `b` is an integer. -/ -meta def prove_ennrpow : expr → expr → tactic (expr × expr) := -prove_rpow' ``ennrpow_pos ``ennrpow_neg ``ennreal.rpow_zero `(ℝ≥0∞) `(ℝ) `(1:ℝ≥0∞) - -/-- Evaluates expressions of the form `rpow a b`, `cpow a b` and `a ^ b` in the special case where -`b` is an integer and `a` is a positive rational (so it's really just a rational power). -/ -@[norm_num] meta def eval_rpow_cpow : expr → tactic (expr × expr) -| `(@has_pow.pow _ _ real.has_pow %%a %%b) := b.to_int >> prove_rpow a b -| `(real.rpow %%a %%b) := b.to_int >> prove_rpow a b -| `(@has_pow.pow _ _ complex.has_pow %%a %%b) := b.to_int >> prove_cpow a b -| `(complex.cpow %%a %%b) := b.to_int >> prove_cpow a b -| `(@has_pow.pow _ _ nnreal.real.has_pow %%a %%b) := b.to_int >> prove_nnrpow a b -| `(nnreal.rpow %%a %%b) := b.to_int >> prove_nnrpow a b -| `(@has_pow.pow _ _ ennreal.real.has_pow %%a %%b) := b.to_int >> prove_ennrpow a b -| `(ennreal.rpow %%a %%b) := b.to_int >> prove_ennrpow a b -| _ := tactic.failed - -end norm_num diff --git a/src/analysis/special_functions/pow/asymptotics.lean b/src/analysis/special_functions/pow/asymptotics.lean new file mode 100644 index 0000000000000..e6efb51740b87 --- /dev/null +++ b/src/analysis/special_functions/pow/asymptotics.lean @@ -0,0 +1,285 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, + Rémy Degenne, David Loeffler +-/ +import analysis.special_functions.pow.nnreal + +/-! +# Limits and asymptotics of power functions at `+∞` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains results about the limiting behaviour of power functions at `+∞`. For convenience +some results on asymptotics as `x → 0` (those which are not just continuity statements) are also +located here. +-/ + +noncomputable theory + +open_locale classical real topology nnreal ennreal filter big_operators complex_conjugate +open filter finset set + +/-! +## Limits at `+∞` +-/ + +section limits + +open real filter + +/-- The function `x ^ y` tends to `+∞` at `+∞` for any positive real `y`. -/ +lemma tendsto_rpow_at_top {y : ℝ} (hy : 0 < y) : tendsto (λ x : ℝ, x ^ y) at_top at_top := +begin + rw tendsto_at_top_at_top, + intro b, + use (max b 0) ^ (1/y), + intros x hx, + exact le_of_max_le_left + (by { convert rpow_le_rpow (rpow_nonneg_of_nonneg (le_max_right b 0) (1/y)) hx (le_of_lt hy), + rw [← rpow_mul (le_max_right b 0), (eq_div_iff (ne_of_gt hy)).mp rfl, rpow_one] }), +end + +/-- The function `x ^ (-y)` tends to `0` at `+∞` for any positive real `y`. -/ +lemma tendsto_rpow_neg_at_top {y : ℝ} (hy : 0 < y) : tendsto (λ x : ℝ, x ^ (-y)) at_top (𝓝 0) := +tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top 0) (λ x hx, (rpow_neg (le_of_lt hx) y).symm)) + (tendsto_rpow_at_top hy).inv_tendsto_at_top + +/-- The function `x ^ (a / (b * x + c))` tends to `1` at `+∞`, for any real numbers `a`, `b`, and +`c` such that `b` is nonzero. -/ +lemma tendsto_rpow_div_mul_add (a b c : ℝ) (hb : 0 ≠ b) : + tendsto (λ x, x ^ (a / (b*x+c))) at_top (𝓝 1) := +begin + refine tendsto.congr' _ ((tendsto_exp_nhds_0_nhds_1.comp + (by simpa only [mul_zero, pow_one] using ((@tendsto_const_nhds _ _ _ a _).mul + (tendsto_div_pow_mul_exp_add_at_top b c 1 hb)))).comp tendsto_log_at_top), + apply eventually_eq_of_mem (Ioi_mem_at_top (0:ℝ)), + intros x hx, + simp only [set.mem_Ioi, function.comp_app] at hx ⊢, + rw [exp_log hx, ← exp_log (rpow_pos_of_pos hx (a / (b * x + c))), log_rpow hx (a / (b * x + c))], + field_simp, +end + +/-- The function `x ^ (1 / x)` tends to `1` at `+∞`. -/ +lemma tendsto_rpow_div : tendsto (λ x, x ^ ((1:ℝ) / x)) at_top (𝓝 1) := +by { convert tendsto_rpow_div_mul_add (1:ℝ) _ (0:ℝ) zero_ne_one, funext, congr' 2, ring } + +/-- The function `x ^ (-1 / x)` tends to `1` at `+∞`. -/ +lemma tendsto_rpow_neg_div : tendsto (λ x, x ^ (-(1:ℝ) / x)) at_top (𝓝 1) := +by { convert tendsto_rpow_div_mul_add (-(1:ℝ)) _ (0:ℝ) zero_ne_one, funext, congr' 2, ring } + +/-- The function `exp(x) / x ^ s` tends to `+∞` at `+∞`, for any real number `s`. -/ +lemma tendsto_exp_div_rpow_at_top (s : ℝ) : tendsto (λ x : ℝ, exp x / x ^ s) at_top at_top := +begin + cases archimedean_iff_nat_lt.1 (real.archimedean) s with n hn, + refine tendsto_at_top_mono' _ _ (tendsto_exp_div_pow_at_top n), + filter_upwards [eventually_gt_at_top (0 : ℝ), eventually_ge_at_top (1 : ℝ)] with x hx₀ hx₁, + rw [div_le_div_left (exp_pos _) (pow_pos hx₀ _) (rpow_pos_of_pos hx₀ _), ←rpow_nat_cast], + exact rpow_le_rpow_of_exponent_le hx₁ hn.le, +end + +/-- The function `exp (b * x) / x ^ s` tends to `+∞` at `+∞`, for any real `s` and `b > 0`. -/ +lemma tendsto_exp_mul_div_rpow_at_top (s : ℝ) (b : ℝ) (hb : 0 < b) : + tendsto (λ x : ℝ, exp (b * x) / x ^ s) at_top at_top := +begin + refine ((tendsto_rpow_at_top hb).comp (tendsto_exp_div_rpow_at_top (s / b))).congr' _, + filter_upwards [eventually_ge_at_top (0 : ℝ)] with x hx₀, + simp [div_rpow, (exp_pos x).le, rpow_nonneg_of_nonneg, ←rpow_mul, ←exp_mul, mul_comm x, hb.ne', *] +end + +/-- The function `x ^ s * exp (-b * x)` tends to `0` at `+∞`, for any real `s` and `b > 0`. -/ +lemma tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 (s : ℝ) (b : ℝ) (hb : 0 < b): + tendsto (λ x : ℝ, x ^ s * exp (-b * x)) at_top (𝓝 0) := +begin + refine (tendsto_exp_mul_div_rpow_at_top s b hb).inv_tendsto_at_top.congr' _, + filter_upwards with x using by simp [exp_neg, inv_div, div_eq_mul_inv _ (exp _)] +end + +theorem nnreal.tendsto_rpow_at_top {y : ℝ} (hy : 0 < y) : + tendsto (λ (x : ℝ≥0), x ^ y) at_top at_top := +begin + rw filter.tendsto_at_top_at_top, + intros b, + obtain ⟨c, hc⟩ := tendsto_at_top_at_top.mp (tendsto_rpow_at_top hy) b, + use c.to_nnreal, + intros a ha, + exact_mod_cast hc a (real.to_nnreal_le_iff_le_coe.mp ha), +end + +theorem ennreal.tendsto_rpow_at_top {y : ℝ} (hy : 0 < y) : + tendsto (λ (x : ℝ≥0∞), x ^ y) (𝓝 ⊤) (𝓝 ⊤) := +begin + rw ennreal.tendsto_nhds_top_iff_nnreal, + intros x, + obtain ⟨c, _, hc⟩ := + (at_top_basis_Ioi.tendsto_iff at_top_basis_Ioi).mp (nnreal.tendsto_rpow_at_top hy) x trivial, + have hc' : set.Ioi (↑c) ∈ 𝓝 (⊤ : ℝ≥0∞) := Ioi_mem_nhds ennreal.coe_lt_top, + refine eventually_of_mem hc' _, + intros a ha, + by_cases ha' : a = ⊤, + { simp [ha', hy] }, + lift a to ℝ≥0 using ha', + change ↑c < ↑a at ha, + rw ennreal.coe_rpow_of_nonneg _ hy.le, + exact_mod_cast hc a (by exact_mod_cast ha), +end + +end limits + +/-! +## Asymptotic results: `is_O`, `is_o` and `is_Theta` +-/ +namespace complex +section + +variables {α : Type*} {l : filter α} {f g : α → ℂ} + +open asymptotics + +lemma is_Theta_exp_arg_mul_im (hl : is_bounded_under (≤) l (λ x, |(g x).im|)) : + (λ x, real.exp (arg (f x) * im (g x))) =Θ[l] (λ x, (1 : ℝ)) := +begin + rcases hl with ⟨b, hb⟩, + refine real.is_Theta_exp_comp_one.2 ⟨π * b, _⟩, + rw eventually_map at hb ⊢, + refine hb.mono (λ x hx, _), + erw [abs_mul], + exact mul_le_mul (abs_arg_le_pi _) hx (abs_nonneg _) real.pi_pos.le +end + +lemma is_O_cpow_rpow (hl : is_bounded_under (≤) l (λ x, |(g x).im|)) : + (λ x, f x ^ g x) =O[l] (λ x, abs (f x) ^ (g x).re) := +calc (λ x, f x ^ g x) =O[l] (λ x, abs (f x) ^ (g x).re / real.exp (arg (f x) * im (g x))) : + is_O_of_le _ $ λ x, (abs_cpow_le _ _).trans (le_abs_self _) +... =Θ[l] (λ x, abs (f x) ^ (g x).re / (1 : ℝ)) : + (is_Theta_refl _ _).div (is_Theta_exp_arg_mul_im hl) +... =ᶠ[l] (λ x, abs (f x) ^ (g x).re) : by simp only [of_real_one, div_one] + +lemma is_Theta_cpow_rpow (hl_im : is_bounded_under (≤) l (λ x, |(g x).im|)) + (hl : ∀ᶠ x in l, f x = 0 → re (g x) = 0 → g x = 0): + (λ x, f x ^ g x) =Θ[l] (λ x, abs (f x) ^ (g x).re) := +calc (λ x, f x ^ g x) =Θ[l] (λ x, abs (f x) ^ (g x).re / real.exp (arg (f x) * im (g x))) : + is_Theta_of_norm_eventually_eq' $ hl.mono $ λ x, abs_cpow_of_imp +... =Θ[l] (λ x, abs (f x) ^ (g x).re / (1 : ℝ)) : + (is_Theta_refl _ _).div (is_Theta_exp_arg_mul_im hl_im) +... =ᶠ[l] (λ x, abs (f x) ^ (g x).re) : by simp only [of_real_one, div_one] + +lemma is_Theta_cpow_const_rpow {b : ℂ} (hl : b.re = 0 → b ≠ 0 → ∀ᶠ x in l, f x ≠ 0) : + (λ x, f x ^ b) =Θ[l] (λ x, abs (f x) ^ b.re) := +is_Theta_cpow_rpow is_bounded_under_const $ by simpa only [eventually_imp_distrib_right, ne.def, + ← not_frequently, not_imp_not, imp.swap] using hl + +end + +end complex + +open real + +namespace asymptotics + +variables {α : Type*} {r c : ℝ} {l : filter α} {f g : α → ℝ} + +lemma is_O_with.rpow (h : is_O_with c l f g) (hc : 0 ≤ c) (hr : 0 ≤ r) (hg : 0 ≤ᶠ[l] g) : + is_O_with (c ^ r) l (λ x, f x ^ r) (λ x, g x ^ r) := +begin + apply is_O_with.of_bound, + filter_upwards [hg, h.bound] with x hgx hx, + calc |f x ^ r| ≤ |f x| ^ r : abs_rpow_le_abs_rpow _ _ + ... ≤ (c * |g x|) ^ r : rpow_le_rpow (abs_nonneg _) hx hr + ... = c ^ r * |g x ^ r| : by rw [mul_rpow hc (abs_nonneg _), abs_rpow_of_nonneg hgx] +end + +lemma is_O.rpow (hr : 0 ≤ r) (hg : 0 ≤ᶠ[l] g) (h : f =O[l] g) : + (λ x, f x ^ r) =O[l] (λ x, g x ^ r) := +let ⟨c, hc, h'⟩ := h.exists_nonneg in (h'.rpow hc hr hg).is_O + +lemma is_o.rpow (hr : 0 < r) (hg : 0 ≤ᶠ[l] g) (h : f =o[l] g) : + (λ x, f x ^ r) =o[l] (λ x, g x ^ r) := +is_o.of_is_O_with $ λ c hc, ((h.forall_is_O_with (rpow_pos_of_pos hc r⁻¹)).rpow + (rpow_nonneg_of_nonneg hc.le _) hr.le hg).congr_const + (by rw [←rpow_mul hc.le, inv_mul_cancel hr.ne', rpow_one]) + +end asymptotics + +open asymptotics + +/-- `x ^ s = o(exp(b * x))` as `x → ∞` for any real `s` and positive `b`. -/ +lemma is_o_rpow_exp_pos_mul_at_top (s : ℝ) {b : ℝ} (hb : 0 < b) : + (λ x : ℝ, x ^ s) =o[at_top] (λ x, exp (b * x)) := +iff.mpr (is_o_iff_tendsto $ λ x h, absurd h (exp_pos _).ne') $ + by simpa only [div_eq_mul_inv, exp_neg, neg_mul] + using tendsto_rpow_mul_exp_neg_mul_at_top_nhds_0 s b hb + +/-- `x ^ k = o(exp(b * x))` as `x → ∞` for any integer `k` and positive `b`. -/ +lemma is_o_zpow_exp_pos_mul_at_top (k : ℤ) {b : ℝ} (hb : 0 < b) : + (λ x : ℝ, x ^ k) =o[at_top] (λ x, exp (b * x)) := +by simpa only [rpow_int_cast] using is_o_rpow_exp_pos_mul_at_top k hb + +/-- `x ^ k = o(exp(b * x))` as `x → ∞` for any natural `k` and positive `b`. -/ +lemma is_o_pow_exp_pos_mul_at_top (k : ℕ) {b : ℝ} (hb : 0 < b) : + (λ x : ℝ, x ^ k) =o[at_top] (λ x, exp (b * x)) := +by simpa using is_o_zpow_exp_pos_mul_at_top k hb + +/-- `x ^ s = o(exp x)` as `x → ∞` for any real `s`. -/ +lemma is_o_rpow_exp_at_top (s : ℝ) : (λ x : ℝ, x ^ s) =o[at_top] exp := +by simpa only [one_mul] using is_o_rpow_exp_pos_mul_at_top s one_pos + +/-- `exp (-a * x) = o(x ^ s)` as `x → ∞`, for any positive `a` and real `s`. -/ +lemma is_o_exp_neg_mul_rpow_at_top {a : ℝ} (ha : 0 < a) (b : ℝ) : + is_o at_top (λ x : ℝ, exp (-a * x)) (λ x : ℝ, x ^ b) := +begin + apply is_o_of_tendsto', + { refine (eventually_gt_at_top 0).mp (eventually_of_forall $ λ t ht h, _), + rw rpow_eq_zero_iff_of_nonneg ht.le at h, + exact (ht.ne' h.1).elim }, + { refine (tendsto_exp_mul_div_rpow_at_top (-b) a ha).inv_tendsto_at_top.congr' _, + refine (eventually_ge_at_top 0).mp (eventually_of_forall $ λ t ht, _), + dsimp only, + rw [pi.inv_apply, inv_div, ←inv_div_inv, neg_mul, real.exp_neg, rpow_neg ht, inv_inv] } +end + +lemma is_o_log_rpow_at_top {r : ℝ} (hr : 0 < r) : log =o[at_top] (λ x, x ^ r) := +calc log =O[at_top] (λ x, r * log x) : is_O_self_const_mul _ hr.ne' _ _ + ... =ᶠ[at_top] (λ x, log (x ^ r)) : + (eventually_gt_at_top 0).mono $ λ x hx, (log_rpow hx _).symm + ... =o[at_top] (λ x, x ^ r) : is_o_log_id_at_top.comp_tendsto (tendsto_rpow_at_top hr) + +lemma is_o_log_rpow_rpow_at_top {s : ℝ} (r : ℝ) (hs : 0 < s) : + (λ x, log x ^ r) =o[at_top] (λ x, x ^ s) := +let r' := max r 1 in +have hr : 0 < r', from lt_max_iff.2 $ or.inr one_pos, +have H : 0 < s / r', from div_pos hs hr, +calc (λ x, log x ^ r) =O[at_top] (λ x, log x ^ r') : + is_O.of_bound 1 $ (tendsto_log_at_top.eventually_ge_at_top 1).mono $ λ x hx, + have hx₀ : 0 ≤ log x, from zero_le_one.trans hx, + by simp [norm_eq_abs, abs_rpow_of_nonneg, abs_rpow_of_nonneg hx₀, + rpow_le_rpow_of_exponent_le (hx.trans (le_abs_self _))] + ... =o[at_top] (λ x, (x ^ (s / r')) ^ r') : + (is_o_log_rpow_at_top H).rpow hr $ (tendsto_rpow_at_top H).eventually $ eventually_ge_at_top 0 + ... =ᶠ[at_top] (λ x, x ^ s) : + (eventually_ge_at_top 0).mono $ λ x hx, by simp only [← rpow_mul hx, div_mul_cancel _ hr.ne'] + +lemma is_o_abs_log_rpow_rpow_nhds_zero {s : ℝ} (r : ℝ) (hs : s < 0) : + (λ x, |log x| ^ r) =o[𝓝[>] 0] (λ x, x ^ s) := +((is_o_log_rpow_rpow_at_top r (neg_pos.2 hs)).comp_tendsto tendsto_inv_zero_at_top).congr' + (mem_of_superset (Icc_mem_nhds_within_Ioi $ set.left_mem_Ico.2 one_pos) $ + λ x hx, by simp [abs_of_nonpos, log_nonpos hx.1 hx.2]) + (eventually_mem_nhds_within.mono $ λ x hx, + by rw [function.comp_app, inv_rpow hx.out.le, rpow_neg hx.out.le, inv_inv]) + +lemma is_o_log_rpow_nhds_zero {r : ℝ} (hr : r < 0) : log =o[𝓝[>] 0] (λ x, x ^ r) := +(is_o_abs_log_rpow_rpow_nhds_zero 1 hr).neg_left.congr' + (mem_of_superset (Icc_mem_nhds_within_Ioi $ set.left_mem_Ico.2 one_pos) $ + λ x hx, by simp [abs_of_nonpos (log_nonpos hx.1 hx.2)]) + eventually_eq.rfl + +lemma tendsto_log_div_rpow_nhds_zero {r : ℝ} (hr : r < 0) : + tendsto (λ x, log x / x ^ r) (𝓝[>] 0) (𝓝 0) := +(is_o_log_rpow_nhds_zero hr).tendsto_div_nhds_zero + +lemma tendsto_log_mul_rpow_nhds_zero {r : ℝ} (hr : 0 < r) : + tendsto (λ x, log x * x ^ r) (𝓝[>] 0) (𝓝 0) := +(tendsto_log_div_rpow_nhds_zero $ neg_lt_zero.2 hr).congr' $ + eventually_mem_nhds_within.mono $ λ x hx, by rw [rpow_neg hx.out.le, div_inv_eq_mul] diff --git a/src/analysis/special_functions/pow/complex.lean b/src/analysis/special_functions/pow/complex.lean new file mode 100644 index 0000000000000..9a4fc47cb086b --- /dev/null +++ b/src/analysis/special_functions/pow/complex.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, + Rémy Degenne, David Loeffler +-/ +import analysis.special_functions.complex.log + +/-! # Power function on `ℂ` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct the power functions `x ^ y`, where `x` and `y` are complex numbers. +-/ + +open_locale classical real topology filter complex_conjugate +open filter finset set + +namespace complex + +/-- The complex power function `x ^ y`, given by `x ^ y = exp(y log x)` (where `log` is the +principal determination of the logarithm), unless `x = 0` where one sets `0 ^ 0 = 1` and +`0 ^ y = 0` for `y ≠ 0`. -/ +noncomputable def cpow (x y : ℂ) : ℂ := +if x = 0 + then if y = 0 + then 1 + else 0 + else exp (log x * y) + +noncomputable instance : has_pow ℂ ℂ := ⟨cpow⟩ + +@[simp] lemma cpow_eq_pow (x y : ℂ) : cpow x y = x ^ y := rfl + +lemma cpow_def (x y : ℂ) : x ^ y = + if x = 0 + then if y = 0 + then 1 + else 0 + else exp (log x * y) := rfl + +lemma cpow_def_of_ne_zero {x : ℂ} (hx : x ≠ 0) (y : ℂ) : x ^ y = exp (log x * y) := if_neg hx + +@[simp] lemma cpow_zero (x : ℂ) : x ^ (0 : ℂ) = 1 := by simp [cpow_def] + +@[simp] lemma cpow_eq_zero_iff (x y : ℂ) : x ^ y = 0 ↔ x = 0 ∧ y ≠ 0 := +by { simp only [cpow_def], split_ifs; simp [*, exp_ne_zero] } + +@[simp] lemma zero_cpow {x : ℂ} (h : x ≠ 0) : (0 : ℂ) ^ x = 0 := +by simp [cpow_def, *] + +lemma zero_cpow_eq_iff {x : ℂ} {a : ℂ} : 0 ^ x = a ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := +begin + split, + { intros hyp, + simp only [cpow_def, eq_self_iff_true, if_true] at hyp, + by_cases x = 0, + { subst h, simp only [if_true, eq_self_iff_true] at hyp, right, exact ⟨rfl, hyp.symm⟩}, + { rw if_neg h at hyp, left, exact ⟨h, hyp.symm⟩, }, }, + { rintro (⟨h, rfl⟩|⟨rfl,rfl⟩), + { exact zero_cpow h, }, + { exact cpow_zero _, }, }, +end + +lemma eq_zero_cpow_iff {x : ℂ} {a : ℂ} : a = 0 ^ x ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := +by rw [←zero_cpow_eq_iff, eq_comm] + +@[simp] lemma cpow_one (x : ℂ) : x ^ (1 : ℂ) = x := +if hx : x = 0 then by simp [hx, cpow_def] +else by rw [cpow_def, if_neg (one_ne_zero : (1 : ℂ) ≠ 0), if_neg hx, mul_one, exp_log hx] + +@[simp] lemma one_cpow (x : ℂ) : (1 : ℂ) ^ x = 1 := +by rw cpow_def; split_ifs; simp [one_ne_zero, *] at * + +lemma cpow_add {x : ℂ} (y z : ℂ) (hx : x ≠ 0) : x ^ (y + z) = x ^ y * x ^ z := +by simp only [cpow_def, ite_mul, boole_mul, mul_ite, mul_boole]; simp [*, exp_add, mul_add] at * + +lemma cpow_mul {x y : ℂ} (z : ℂ) (h₁ : -π < (log x * y).im) (h₂ : (log x * y).im ≤ π) : + x ^ (y * z) = (x ^ y) ^ z := +begin + simp only [cpow_def], + split_ifs; + simp [*, exp_ne_zero, log_exp h₁ h₂, mul_assoc] at * +end + +lemma cpow_neg (x y : ℂ) : x ^ -y = (x ^ y)⁻¹ := +by simp only [cpow_def, neg_eq_zero, mul_neg]; split_ifs; simp [exp_neg] + +lemma cpow_sub {x : ℂ} (y z : ℂ) (hx : x ≠ 0) : x ^ (y - z) = x ^ y / x ^ z := +by rw [sub_eq_add_neg, cpow_add _ _ hx, cpow_neg, div_eq_mul_inv] + +lemma cpow_neg_one (x : ℂ) : x ^ (-1 : ℂ) = x⁻¹ := +by simpa using cpow_neg x 1 + +@[simp, norm_cast] lemma cpow_nat_cast (x : ℂ) : ∀ (n : ℕ), x ^ (n : ℂ) = x ^ n +| 0 := by simp +| (n + 1) := if hx : x = 0 then by simp only [hx, pow_succ, + complex.zero_cpow (nat.cast_ne_zero.2 (nat.succ_ne_zero _)), zero_mul] + else by simp [cpow_add, hx, pow_add, cpow_nat_cast n] + +@[simp] lemma cpow_two (x : ℂ) : x ^ (2 : ℂ) = x ^ 2 := +by { rw ← cpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } + +@[simp, norm_cast] lemma cpow_int_cast (x : ℂ) : ∀ (n : ℤ), x ^ (n : ℂ) = x ^ n +| (n : ℕ) := by simp +| -[1+ n] := by rw zpow_neg_succ_of_nat; + simp only [int.neg_succ_of_nat_coe, int.cast_neg, complex.cpow_neg, inv_eq_one_div, + int.cast_coe_nat, cpow_nat_cast] + +lemma cpow_nat_inv_pow (x : ℂ) {n : ℕ} (hn : n ≠ 0) : (x ^ (n⁻¹ : ℂ)) ^ n = x := +begin + suffices : im (log x * n⁻¹) ∈ Ioc (-π) π, + { rw [← cpow_nat_cast, ← cpow_mul _ this.1 this.2, inv_mul_cancel, cpow_one], + exact_mod_cast hn }, + rw [mul_comm, ← of_real_nat_cast, ← of_real_inv, of_real_mul_im, ← div_eq_inv_mul], + rw [← pos_iff_ne_zero] at hn, + have hn' : 0 < (n : ℝ), by assumption_mod_cast, + have hn1 : 1 ≤ (n : ℝ), by exact_mod_cast (nat.succ_le_iff.2 hn), + split, + { rw lt_div_iff hn', + calc -π * n ≤ -π * 1 : mul_le_mul_of_nonpos_left hn1 (neg_nonpos.2 real.pi_pos.le) + ... = -π : mul_one _ + ... < im (log x) : neg_pi_lt_log_im _ }, + { rw div_le_iff hn', + calc im (log x) ≤ π : log_im_le_pi _ + ... = π * 1 : (mul_one π).symm + ... ≤ π * n : mul_le_mul_of_nonneg_left hn1 real.pi_pos.le } +end + +lemma mul_cpow_of_real_nonneg {a b : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (r : ℂ) : + ((a : ℂ) * (b : ℂ)) ^ r = (a : ℂ) ^ r * (b : ℂ) ^ r := +begin + rcases eq_or_ne r 0 with rfl | hr, + { simp only [cpow_zero, mul_one] }, + rcases eq_or_lt_of_le ha with rfl | ha', + { rw [of_real_zero, zero_mul, zero_cpow hr, zero_mul] }, + rcases eq_or_lt_of_le hb with rfl | hb', + { rw [of_real_zero, mul_zero, zero_cpow hr, mul_zero] }, + have ha'' : (a : ℂ) ≠ 0 := of_real_ne_zero.mpr ha'.ne', + have hb'' : (b : ℂ) ≠ 0 := of_real_ne_zero.mpr hb'.ne', + rw [cpow_def_of_ne_zero (mul_ne_zero ha'' hb''), log_of_real_mul ha' hb'', of_real_log ha, + add_mul, exp_add, ←cpow_def_of_ne_zero ha'', ←cpow_def_of_ne_zero hb''] +end + +lemma inv_cpow_eq_ite (x : ℂ) (n : ℂ) : + x⁻¹ ^ n = if x.arg = π then conj (x ^ conj n)⁻¹ else (x ^ n)⁻¹ := +begin + simp_rw [complex.cpow_def, log_inv_eq_ite, inv_eq_zero, map_eq_zero, ite_mul, neg_mul, + is_R_or_C.conj_inv, apply_ite conj, apply_ite exp, apply_ite has_inv.inv, map_zero, map_one, + exp_neg, inv_one, inv_zero, ←exp_conj, map_mul, conj_conj], + split_ifs with hx hn ha ha; refl, +end + +lemma inv_cpow (x : ℂ) (n : ℂ) (hx : x.arg ≠ π) : x⁻¹ ^ n = (x ^ n)⁻¹ := +by rw [inv_cpow_eq_ite, if_neg hx] + +/-- `complex.inv_cpow_eq_ite` with the `ite` on the other side. -/ +lemma inv_cpow_eq_ite' (x : ℂ) (n : ℂ) : + (x ^ n)⁻¹ = if x.arg = π then conj (x⁻¹ ^ conj n) else x⁻¹ ^ n := +begin + rw [inv_cpow_eq_ite, apply_ite conj, conj_conj, conj_conj], + split_ifs, + { refl }, + { rw inv_cpow _ _ h } +end + +lemma conj_cpow_eq_ite (x : ℂ) (n : ℂ) : + conj x ^ n = if x.arg = π then x ^ n else conj (x ^ conj n) := +begin + simp_rw [cpow_def, map_eq_zero, apply_ite conj, map_one, map_zero, ←exp_conj, map_mul, + conj_conj, log_conj_eq_ite], + split_ifs with hcx hn hx; refl +end + +lemma conj_cpow (x : ℂ) (n : ℂ) (hx : x.arg ≠ π) : conj x ^ n = conj (x ^ conj n) := +by rw [conj_cpow_eq_ite, if_neg hx] + +lemma cpow_conj (x : ℂ) (n : ℂ) (hx : x.arg ≠ π) : x ^ conj n = conj (conj x ^ n) := +by rw [conj_cpow _ _ hx, conj_conj] + +end complex + +section tactics +/-! +## Tactic extensions for complex powers +-/ + +namespace norm_num + +theorem cpow_pos (a b : ℂ) (b' : ℕ) (c : ℂ) (hb : b = b') (h : a ^ b' = c) : a ^ b = c := +by rw [← h, hb, complex.cpow_nat_cast] + +theorem cpow_neg (a b : ℂ) (b' : ℕ) (c c' : ℂ) + (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := +by rw [← hc, ← h, hb, complex.cpow_neg, complex.cpow_nat_cast] + +open tactic + +/-- Generalized version of `prove_cpow`, `prove_nnrpow`, `prove_ennrpow`. -/ +meta def prove_rpow' (pos neg zero : name) (α β one a b : expr) : tactic (expr × expr) := do + na ← a.to_rat, + icα ← mk_instance_cache α, + icβ ← mk_instance_cache β, + match match_sign b with + | sum.inl b := do + nc ← mk_instance_cache `(ℕ), + (icβ, nc, b', hb) ← prove_nat_uncast icβ nc b, + (icα, c, h) ← prove_pow a na icα b', + cr ← c.to_rat, + (icα, c', hc) ← prove_inv icα c cr, + pure (c', (expr.const neg []).mk_app [a, b, b', c, c', hb, h, hc]) + | sum.inr ff := pure (one, expr.const zero [] a) + | sum.inr tt := do + nc ← mk_instance_cache `(ℕ), + (icβ, nc, b', hb) ← prove_nat_uncast icβ nc b, + (icα, c, h) ← prove_pow a na icα b', + pure (c, (expr.const pos []).mk_app [a, b, b', c, hb, h]) + end + +/-- Evaluate `complex.cpow a b` where `a` is a rational numeral and `b` is an integer. -/ +meta def prove_cpow : expr → expr → tactic (expr × expr) := +prove_rpow' ``cpow_pos ``cpow_neg ``complex.cpow_zero `(ℂ) `(ℂ) `(1:ℂ) + +/-- Evaluates expressions of the form `cpow a b` and `a ^ b` in the special case where +`b` is an integer and `a` is a positive rational (so it's really just a rational power). -/ +@[norm_num] meta def eval_cpow : expr → tactic (expr × expr) +| `(@has_pow.pow _ _ complex.has_pow %%a %%b) := b.to_int >> prove_cpow a b +| `(complex.cpow %%a %%b) := b.to_int >> prove_cpow a b +| _ := tactic.failed + +end norm_num + +end tactics diff --git a/src/analysis/special_functions/pow/continuity.lean b/src/analysis/special_functions/pow/continuity.lean new file mode 100644 index 0000000000000..b59cb77b44b81 --- /dev/null +++ b/src/analysis/special_functions/pow/continuity.lean @@ -0,0 +1,503 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, + Rémy Degenne, David Loeffler +-/ +import analysis.special_functions.pow.asymptotics + +/-! +# Continuity of power functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains lemmas about continuity of the power functions on `ℂ`, `ℝ`, `ℝ≥0`, and `ℝ≥0∞`. +-/ + +noncomputable theory + +open_locale classical real topology nnreal ennreal filter big_operators complex_conjugate +open filter finset set + +section cpow_limits + +/-! +## Continuity for complex powers +-/ + +open complex + +variables {α : Type*} + +lemma zero_cpow_eq_nhds {b : ℂ} (hb : b ≠ 0) : + (λ (x : ℂ), (0 : ℂ) ^ x) =ᶠ[𝓝 b] 0 := +begin + suffices : ∀ᶠ (x : ℂ) in (𝓝 b), x ≠ 0, + from this.mono (λ x hx, by { dsimp only, rw [zero_cpow hx, pi.zero_apply]} ), + exact is_open.eventually_mem is_open_ne hb, +end + +lemma cpow_eq_nhds {a b : ℂ} (ha : a ≠ 0) : + (λ x, x ^ b) =ᶠ[𝓝 a] λ x, exp (log x * b) := +begin + suffices : ∀ᶠ (x : ℂ) in (𝓝 a), x ≠ 0, + from this.mono (λ x hx, by { dsimp only, rw [cpow_def_of_ne_zero hx], }), + exact is_open.eventually_mem is_open_ne ha, +end + +lemma cpow_eq_nhds' {p : ℂ × ℂ} (hp_fst : p.fst ≠ 0) : + (λ x, x.1 ^ x.2) =ᶠ[𝓝 p] λ x, exp (log x.1 * x.2) := +begin + suffices : ∀ᶠ (x : ℂ × ℂ) in (𝓝 p), x.1 ≠ 0, + from this.mono (λ x hx, by { dsimp only, rw cpow_def_of_ne_zero hx, }), + refine is_open.eventually_mem _ hp_fst, + change is_open {x : ℂ × ℂ | x.1 = 0}ᶜ, + rw is_open_compl_iff, + exact is_closed_eq continuous_fst continuous_const, +end + +/- Continuity of `λ x, a ^ x`: union of these two lemmas is optimal. -/ + +lemma continuous_at_const_cpow {a b : ℂ} (ha : a ≠ 0) : continuous_at (λ x, a ^ x) b := +begin + have cpow_eq : (λ x:ℂ, a ^ x) = λ x, exp (log a * x), + by { ext1 b, rw [cpow_def_of_ne_zero ha], }, + rw cpow_eq, + exact continuous_exp.continuous_at.comp (continuous_at.mul continuous_at_const continuous_at_id), +end + +lemma continuous_at_const_cpow' {a b : ℂ} (h : b ≠ 0) : continuous_at (λ x, a ^ x) b := +begin + by_cases ha : a = 0, + { rw [ha, continuous_at_congr (zero_cpow_eq_nhds h)], exact continuous_at_const, }, + { exact continuous_at_const_cpow ha, }, +end + +/-- The function `z ^ w` is continuous in `(z, w)` provided that `z` does not belong to the interval +`(-∞, 0]` on the real line. See also `complex.continuous_at_cpow_zero_of_re_pos` for a version that +works for `z = 0` but assumes `0 < re w`. -/ +lemma continuous_at_cpow {p : ℂ × ℂ} (hp_fst : 0 < p.fst.re ∨ p.fst.im ≠ 0) : + continuous_at (λ x : ℂ × ℂ, x.1 ^ x.2) p := +begin + have hp_fst_ne_zero : p.fst ≠ 0, + by { intro h, cases hp_fst; { rw h at hp_fst, simpa using hp_fst, }, }, + rw continuous_at_congr (cpow_eq_nhds' hp_fst_ne_zero), + refine continuous_exp.continuous_at.comp _, + refine continuous_at.mul (continuous_at.comp _ continuous_fst.continuous_at) + continuous_snd.continuous_at, + exact continuous_at_clog hp_fst, +end + +lemma continuous_at_cpow_const {a b : ℂ} (ha : 0 < a.re ∨ a.im ≠ 0) : + continuous_at (λ x, cpow x b) a := +tendsto.comp (@continuous_at_cpow (a, b) ha) (continuous_at_id.prod continuous_at_const) + +lemma filter.tendsto.cpow {l : filter α} {f g : α → ℂ} {a b : ℂ} (hf : tendsto f l (𝓝 a)) + (hg : tendsto g l (𝓝 b)) (ha : 0 < a.re ∨ a.im ≠ 0) : + tendsto (λ x, f x ^ g x) l (𝓝 (a ^ b)) := +(@continuous_at_cpow (a,b) ha).tendsto.comp (hf.prod_mk_nhds hg) + +lemma filter.tendsto.const_cpow {l : filter α} {f : α → ℂ} {a b : ℂ} (hf : tendsto f l (𝓝 b)) + (h : a ≠ 0 ∨ b ≠ 0) : + tendsto (λ x, a ^ f x) l (𝓝 (a ^ b)) := +begin + cases h, + { exact (continuous_at_const_cpow h).tendsto.comp hf, }, + { exact (continuous_at_const_cpow' h).tendsto.comp hf, }, +end + +variables [topological_space α] {f g : α → ℂ} {s : set α} {a : α} + +lemma continuous_within_at.cpow (hf : continuous_within_at f s a) (hg : continuous_within_at g s a) + (h0 : 0 < (f a).re ∨ (f a).im ≠ 0) : + continuous_within_at (λ x, f x ^ g x) s a := +hf.cpow hg h0 + +lemma continuous_within_at.const_cpow {b : ℂ} (hf : continuous_within_at f s a) + (h : b ≠ 0 ∨ f a ≠ 0) : + continuous_within_at (λ x, b ^ f x) s a := +hf.const_cpow h + +lemma continuous_at.cpow (hf : continuous_at f a) (hg : continuous_at g a) + (h0 : 0 < (f a).re ∨ (f a).im ≠ 0) : + continuous_at (λ x, f x ^ g x) a := +hf.cpow hg h0 + +lemma continuous_at.const_cpow {b : ℂ} (hf : continuous_at f a) (h : b ≠ 0 ∨ f a ≠ 0) : + continuous_at (λ x, b ^ f x) a := +hf.const_cpow h + +lemma continuous_on.cpow (hf : continuous_on f s) (hg : continuous_on g s) + (h0 : ∀ a ∈ s, 0 < (f a).re ∨ (f a).im ≠ 0) : + continuous_on (λ x, f x ^ g x) s := +λ a ha, (hf a ha).cpow (hg a ha) (h0 a ha) + +lemma continuous_on.const_cpow {b : ℂ} (hf : continuous_on f s) (h : b ≠ 0 ∨ ∀ a ∈ s, f a ≠ 0) : + continuous_on (λ x, b ^ f x) s := +λ a ha, (hf a ha).const_cpow (h.imp id $ λ h, h a ha) + +lemma continuous.cpow (hf : continuous f) (hg : continuous g) + (h0 : ∀ a, 0 < (f a).re ∨ (f a).im ≠ 0) : + continuous (λ x, f x ^ g x) := +continuous_iff_continuous_at.2 $ λ a, (hf.continuous_at.cpow hg.continuous_at (h0 a)) + +lemma continuous.const_cpow {b : ℂ} (hf : continuous f) (h : b ≠ 0 ∨ ∀ a, f a ≠ 0) : + continuous (λ x, b ^ f x) := +continuous_iff_continuous_at.2 $ λ a, (hf.continuous_at.const_cpow $ h.imp id $ λ h, h a) + +lemma continuous_on.cpow_const {b : ℂ} (hf : continuous_on f s) + (h : ∀ (a : α), a ∈ s → 0 < (f a).re ∨ (f a).im ≠ 0) : + continuous_on (λ x, (f x) ^ b) s := +hf.cpow continuous_on_const h + +end cpow_limits + +section rpow_limits + +/-! +## Continuity for real powers +-/ + +namespace real + +lemma continuous_at_const_rpow {a b : ℝ} (h : a ≠ 0) : continuous_at (rpow a) b := +begin + have : rpow a = λ x : ℝ, ((a : ℂ) ^ (x : ℂ)).re, by { ext1 x, rw [rpow_eq_pow, rpow_def], }, + rw this, + refine complex.continuous_re.continuous_at.comp _, + refine (continuous_at_const_cpow _).comp complex.continuous_of_real.continuous_at, + norm_cast, + exact h, +end + +lemma continuous_at_const_rpow' {a b : ℝ} (h : b ≠ 0) : continuous_at (rpow a) b := +begin + have : rpow a = λ x : ℝ, ((a : ℂ) ^ (x : ℂ)).re, by { ext1 x, rw [rpow_eq_pow, rpow_def], }, + rw this, + refine complex.continuous_re.continuous_at.comp _, + refine (continuous_at_const_cpow' _).comp complex.continuous_of_real.continuous_at, + norm_cast, + exact h, +end + +lemma rpow_eq_nhds_of_neg {p : ℝ × ℝ} (hp_fst : p.fst < 0) : + (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] λ x, exp (log x.1 * x.2) * cos (x.2 * π) := +begin + suffices : ∀ᶠ (x : ℝ × ℝ) in (𝓝 p), x.1 < 0, + from this.mono (λ x hx, by { dsimp only, rw rpow_def_of_neg hx, }), + exact is_open.eventually_mem (is_open_lt continuous_fst continuous_const) hp_fst, +end + +lemma rpow_eq_nhds_of_pos {p : ℝ × ℝ} (hp_fst : 0 < p.fst) : + (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] λ x, exp (log x.1 * x.2) := +begin + suffices : ∀ᶠ (x : ℝ × ℝ) in (𝓝 p), 0 < x.1, + from this.mono (λ x hx, by { dsimp only, rw rpow_def_of_pos hx, }), + exact is_open.eventually_mem (is_open_lt continuous_const continuous_fst) hp_fst, +end + +lemma continuous_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) : + continuous_at (λ p : ℝ × ℝ, p.1 ^ p.2) p := +begin + rw ne_iff_lt_or_gt at hp, + cases hp, + { rw continuous_at_congr (rpow_eq_nhds_of_neg hp), + refine continuous_at.mul _ (continuous_cos.continuous_at.comp _), + { refine continuous_exp.continuous_at.comp (continuous_at.mul _ continuous_snd.continuous_at), + refine (continuous_at_log _).comp continuous_fst.continuous_at, + exact hp.ne, }, + { exact continuous_snd.continuous_at.mul continuous_at_const, }, }, + { rw continuous_at_congr (rpow_eq_nhds_of_pos hp), + refine continuous_exp.continuous_at.comp (continuous_at.mul _ continuous_snd.continuous_at), + refine (continuous_at_log _).comp continuous_fst.continuous_at, + exact hp.lt.ne.symm, }, +end + +lemma continuous_at_rpow_of_pos (p : ℝ × ℝ) (hp : 0 < p.2) : + continuous_at (λ p : ℝ × ℝ, p.1 ^ p.2) p := +begin + cases p with x y, + obtain hx|rfl := ne_or_eq x 0, + { exact continuous_at_rpow_of_ne (x, y) hx }, + have A : tendsto (λ p : ℝ × ℝ, exp (log p.1 * p.2)) (𝓝[≠] 0 ×ᶠ 𝓝 y) (𝓝 0) := + tendsto_exp_at_bot.comp + ((tendsto_log_nhds_within_zero.comp tendsto_fst).at_bot_mul hp tendsto_snd), + have B : tendsto (λ p : ℝ × ℝ, p.1 ^ p.2) (𝓝[≠] 0 ×ᶠ 𝓝 y) (𝓝 0) := + squeeze_zero_norm (λ p, abs_rpow_le_exp_log_mul p.1 p.2) A, + have C : tendsto (λ p : ℝ × ℝ, p.1 ^ p.2) (𝓝[{0}] 0 ×ᶠ 𝓝 y) (pure 0), + { rw [nhds_within_singleton, tendsto_pure, pure_prod, eventually_map], + exact (lt_mem_nhds hp).mono (λ y hy, zero_rpow hy.ne') }, + simpa only [← sup_prod, ← nhds_within_union, compl_union_self, nhds_within_univ, nhds_prod_eq, + continuous_at, zero_rpow hp.ne'] using B.sup (C.mono_right (pure_le_nhds _)) +end + +lemma continuous_at_rpow (p : ℝ × ℝ) (h : p.1 ≠ 0 ∨ 0 < p.2) : + continuous_at (λ p : ℝ × ℝ, p.1 ^ p.2) p := +h.elim (λ h, continuous_at_rpow_of_ne p h) (λ h, continuous_at_rpow_of_pos p h) + +lemma continuous_at_rpow_const (x : ℝ) (q : ℝ) (h : x ≠ 0 ∨ 0 < q) : + continuous_at (λ (x : ℝ), x ^ q) x := +begin + change continuous_at ((λ p : ℝ × ℝ, p.1 ^ p.2) ∘ (λ y : ℝ, (y, q))) x, + apply continuous_at.comp, + { exact continuous_at_rpow (x, q) h }, + { exact (continuous_id'.prod_mk continuous_const).continuous_at } +end + +end real + +section + +variable {α : Type*} + +lemma filter.tendsto.rpow {l : filter α} {f g : α → ℝ} {x y : ℝ} + (hf : tendsto f l (𝓝 x)) (hg : tendsto g l (𝓝 y)) (h : x ≠ 0 ∨ 0 < y) : + tendsto (λ t, f t ^ g t) l (𝓝 (x ^ y)) := +(real.continuous_at_rpow (x, y) h).tendsto.comp (hf.prod_mk_nhds hg) + +lemma filter.tendsto.rpow_const {l : filter α} {f : α → ℝ} {x p : ℝ} + (hf : tendsto f l (𝓝 x)) (h : x ≠ 0 ∨ 0 ≤ p) : + tendsto (λ a, f a ^ p) l (𝓝 (x ^ p)) := +if h0 : 0 = p then h0 ▸ by simp [tendsto_const_nhds] +else hf.rpow tendsto_const_nhds (h.imp id $ λ h', h'.lt_of_ne h0) + +variables [topological_space α] {f g : α → ℝ} {s : set α} {x : α} {p : ℝ} + +lemma continuous_at.rpow (hf : continuous_at f x) (hg : continuous_at g x) (h : f x ≠ 0 ∨ 0 < g x) : + continuous_at (λ t, f t ^ g t) x := +hf.rpow hg h + +lemma continuous_within_at.rpow (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) + (h : f x ≠ 0 ∨ 0 < g x) : + continuous_within_at (λ t, f t ^ g t) s x := +hf.rpow hg h + +lemma continuous_on.rpow (hf : continuous_on f s) (hg : continuous_on g s) + (h : ∀ x ∈ s, f x ≠ 0 ∨ 0 < g x) : + continuous_on (λ t, f t ^ g t) s := +λ t ht, (hf t ht).rpow (hg t ht) (h t ht) + +lemma continuous.rpow (hf : continuous f) (hg : continuous g) (h : ∀ x, f x ≠ 0 ∨ 0 < g x) : + continuous (λ x, f x ^ g x) := +continuous_iff_continuous_at.2 $ λ x, (hf.continuous_at.rpow hg.continuous_at (h x)) + +lemma continuous_within_at.rpow_const (hf : continuous_within_at f s x) (h : f x ≠ 0 ∨ 0 ≤ p) : + continuous_within_at (λ x, f x ^ p) s x := +hf.rpow_const h + +lemma continuous_at.rpow_const (hf : continuous_at f x) (h : f x ≠ 0 ∨ 0 ≤ p) : + continuous_at (λ x, f x ^ p) x := +hf.rpow_const h + +lemma continuous_on.rpow_const (hf : continuous_on f s) (h : ∀ x ∈ s, f x ≠ 0 ∨ 0 ≤ p) : + continuous_on (λ x, f x ^ p) s := +λ x hx, (hf x hx).rpow_const (h x hx) + +lemma continuous.rpow_const (hf : continuous f) (h : ∀ x, f x ≠ 0 ∨ 0 ≤ p) : + continuous (λ x, f x ^ p) := +continuous_iff_continuous_at.2 $ λ x, hf.continuous_at.rpow_const (h x) + +end + +end rpow_limits + +/-! ## Continuity results for `cpow`, part II + +These results involve relating real and complex powers, so cannot be done higher up. +-/ +section cpow_limits2 + +namespace complex + +/-- See also `continuous_at_cpow` and `complex.continuous_at_cpow_of_re_pos`. -/ +lemma continuous_at_cpow_zero_of_re_pos {z : ℂ} (hz : 0 < z.re) : + continuous_at (λ x : ℂ × ℂ, x.1 ^ x.2) (0, z) := +begin + have hz₀ : z ≠ 0, from ne_of_apply_ne re hz.ne', + rw [continuous_at, zero_cpow hz₀, tendsto_zero_iff_norm_tendsto_zero], + refine squeeze_zero (λ _, norm_nonneg _) (λ _, abs_cpow_le _ _) _, + simp only [div_eq_mul_inv, ← real.exp_neg], + refine tendsto.zero_mul_is_bounded_under_le _ _, + { convert (continuous_fst.norm.tendsto _).rpow ((continuous_re.comp continuous_snd).tendsto _) _; + simp [hz, real.zero_rpow hz.ne'] }, + { simp only [(∘), real.norm_eq_abs, abs_of_pos (real.exp_pos _)], + rcases exists_gt (|im z|) with ⟨C, hC⟩, + refine ⟨real.exp (π * C), eventually_map.2 _⟩, + refine (((continuous_im.comp continuous_snd).abs.tendsto (_, z)).eventually + (gt_mem_nhds hC)).mono (λ z hz, real.exp_le_exp.2 $ (neg_le_abs_self _).trans _), + rw _root_.abs_mul, + exact mul_le_mul (abs_le.2 ⟨(neg_pi_lt_arg _).le, arg_le_pi _⟩) hz.le + (_root_.abs_nonneg _) real.pi_pos.le } +end + +/-- See also `continuous_at_cpow` for a version that assumes `p.1 ≠ 0` but makes no +assumptions about `p.2`. -/ +lemma continuous_at_cpow_of_re_pos {p : ℂ × ℂ} (h₁ : 0 ≤ p.1.re ∨ p.1.im ≠ 0) (h₂ : 0 < p.2.re) : + continuous_at (λ x : ℂ × ℂ, x.1 ^ x.2) p := +begin + cases p with z w, + rw [← not_lt_zero_iff, lt_iff_le_and_ne, not_and_distrib, ne.def, not_not, not_le_zero_iff] at h₁, + rcases h₁ with h₁|(rfl : z = 0), + exacts [continuous_at_cpow h₁, continuous_at_cpow_zero_of_re_pos h₂] +end + +/-- See also `continuous_at_cpow_const` for a version that assumes `z ≠ 0` but makes no +assumptions about `w`. -/ +lemma continuous_at_cpow_const_of_re_pos {z w : ℂ} (hz : 0 ≤ re z ∨ im z ≠ 0) (hw : 0 < re w) : + continuous_at (λ x, x ^ w) z := +tendsto.comp (@continuous_at_cpow_of_re_pos (z, w) hz hw) + (continuous_at_id.prod continuous_at_const) + +/-- Continuity of `(x, y) ↦ x ^ y` as a function on `ℝ × ℂ`. -/ +lemma continuous_at_of_real_cpow (x : ℝ) (y : ℂ) (h : 0 < y.re ∨ x ≠ 0) : + continuous_at (λ p, ↑p.1 ^ p.2 : ℝ × ℂ → ℂ) (x, y) := +begin + rcases lt_trichotomy 0 x with hx | rfl | hx, + { -- x > 0 : easy case + have : continuous_at (λ p, ⟨↑p.1, p.2⟩ : ℝ × ℂ → ℂ × ℂ) (x, y), + from continuous_of_real.continuous_at.prod_map continuous_at_id, + refine (continuous_at_cpow (or.inl _)).comp this, + rwa of_real_re }, + { -- x = 0 : reduce to continuous_at_cpow_zero_of_re_pos + have A : continuous_at (λ p, p.1 ^ p.2 : ℂ × ℂ → ℂ) ⟨↑(0:ℝ), y⟩, + { rw of_real_zero, + apply continuous_at_cpow_zero_of_re_pos, + tauto }, + have B : continuous_at (λ p, ⟨↑p.1, p.2⟩ : ℝ × ℂ → ℂ × ℂ) ⟨0, y⟩, + from continuous_of_real.continuous_at.prod_map continuous_at_id, + exact @continuous_at.comp (ℝ × ℂ) (ℂ × ℂ) ℂ _ _ _ _ (λ p, ⟨↑p.1, p.2⟩) ⟨0, y⟩ A B }, + { -- x < 0 : difficult case + suffices : continuous_at (λ p, (-↑p.1) ^ p.2 * exp (π * I * p.2) : ℝ × ℂ → ℂ) (x, y), + { refine this.congr (eventually_of_mem (prod_mem_nhds (Iio_mem_nhds hx) univ_mem) _), + exact λ p hp, (of_real_cpow_of_nonpos (le_of_lt hp.1) p.2).symm }, + have A : continuous_at (λ p, ⟨-↑p.1, p.2⟩ : ℝ × ℂ → ℂ × ℂ) (x, y), + from continuous_at.prod_map (continuous_of_real.continuous_at.neg) continuous_at_id, + apply continuous_at.mul, + { refine (continuous_at_cpow (or.inl _)).comp A, + rwa [neg_re, of_real_re, neg_pos] }, + { exact (continuous_exp.comp (continuous_const.mul continuous_snd)).continuous_at } }, +end + +lemma continuous_at_of_real_cpow_const (x : ℝ) (y : ℂ) (h : 0 < y.re ∨ x ≠ 0) : + continuous_at (λ a, a ^ y : ℝ → ℂ) x := +@continuous_at.comp _ _ _ _ _ _ _ _ x (continuous_at_of_real_cpow x y h) + (continuous_id.prod_mk continuous_const).continuous_at + +lemma continuous_of_real_cpow_const {y : ℂ} (hs : 0 < y.re) : continuous (λ x, x ^ y : ℝ → ℂ) := +continuous_iff_continuous_at.mpr (λ x, continuous_at_of_real_cpow_const x y (or.inl hs)) + +end complex + +end cpow_limits2 + +/-! ## Limits and continuity for `ℝ≥0` powers -/ +namespace nnreal + +lemma continuous_at_rpow {x : ℝ≥0} {y : ℝ} (h : x ≠ 0 ∨ 0 < y) : + continuous_at (λp:ℝ≥0×ℝ, p.1^p.2) (x, y) := +begin + have : (λp:ℝ≥0×ℝ, p.1^p.2) = real.to_nnreal ∘ (λp:ℝ×ℝ, p.1^p.2) ∘ (λp:ℝ≥0 × ℝ, (p.1.1, p.2)), + { ext p, + rw [coe_rpow, real.coe_to_nnreal _ (real.rpow_nonneg_of_nonneg p.1.2 _)], + refl }, + rw this, + refine continuous_real_to_nnreal.continuous_at.comp (continuous_at.comp _ _), + { apply real.continuous_at_rpow, + simp only [ne.def] at h, + rw ← (nnreal.coe_eq_zero x) at h, + exact h }, + { exact ((continuous_subtype_val.comp continuous_fst).prod_mk continuous_snd).continuous_at } +end + +lemma eventually_pow_one_div_le (x : ℝ≥0) {y : ℝ≥0} (hy : 1 < y) : + ∀ᶠ (n : ℕ) in at_top, x ^ (1 / n : ℝ) ≤ y := +begin + obtain ⟨m, hm⟩ := add_one_pow_unbounded_of_pos x (tsub_pos_of_lt hy), + rw [tsub_add_cancel_of_le hy.le] at hm, + refine eventually_at_top.2 ⟨m + 1, λ n hn, _⟩, + simpa only [nnreal.rpow_one_div_le_iff (nat.cast_pos.2 $ m.succ_pos.trans_le hn), + nnreal.rpow_nat_cast] using hm.le.trans (pow_le_pow hy.le (m.le_succ.trans hn)), +end + +end nnreal + +open filter + +lemma filter.tendsto.nnrpow {α : Type*} {f : filter α} {u : α → ℝ≥0} {v : α → ℝ} {x : ℝ≥0} {y : ℝ} + (hx : tendsto u f (𝓝 x)) (hy : tendsto v f (𝓝 y)) (h : x ≠ 0 ∨ 0 < y) : + tendsto (λ a, (u a) ^ (v a)) f (𝓝 (x ^ y)) := +tendsto.comp (nnreal.continuous_at_rpow h) (hx.prod_mk_nhds hy) + +namespace nnreal + +lemma continuous_at_rpow_const {x : ℝ≥0} {y : ℝ} (h : x ≠ 0 ∨ 0 ≤ y) : + continuous_at (λ z, z^y) x := +h.elim (λ h, tendsto_id.nnrpow tendsto_const_nhds (or.inl h)) $ + λ h, h.eq_or_lt.elim + (λ h, h ▸ by simp only [rpow_zero, continuous_at_const]) + (λ h, tendsto_id.nnrpow tendsto_const_nhds (or.inr h)) + +lemma continuous_rpow_const {y : ℝ} (h : 0 ≤ y) : + continuous (λ x : ℝ≥0, x^y) := +continuous_iff_continuous_at.2 $ λ x, continuous_at_rpow_const (or.inr h) + +end nnreal + +/-! ## Continuity for `ℝ≥0∞` powers -/ +namespace ennreal + +lemma eventually_pow_one_div_le {x : ℝ≥0∞} (hx : x ≠ ∞) {y : ℝ≥0∞} (hy : 1 < y) : + ∀ᶠ (n : ℕ) in at_top, x ^ (1 / n : ℝ) ≤ y := +begin + lift x to ℝ≥0 using hx, + by_cases y = ∞, + { exact eventually_of_forall (λ n, h.symm ▸ le_top) }, + { lift y to ℝ≥0 using h, + have := nnreal.eventually_pow_one_div_le x (by exact_mod_cast hy : 1 < y), + refine this.congr (eventually_of_forall $ λ n, _), + rw [coe_rpow_of_nonneg x (by positivity : 0 ≤ (1 / n : ℝ)), coe_le_coe] }, +end + +private lemma continuous_at_rpow_const_of_pos {x : ℝ≥0∞} {y : ℝ} (h : 0 < y) : + continuous_at (λ a : ℝ≥0∞, a ^ y) x := +begin + by_cases hx : x = ⊤, + { rw [hx, continuous_at], + convert tendsto_rpow_at_top h, + simp [h] }, + lift x to ℝ≥0 using hx, + rw continuous_at_coe_iff, + convert continuous_coe.continuous_at.comp + (nnreal.continuous_at_rpow_const (or.inr h.le)) using 1, + ext1 x, + simp [coe_rpow_of_nonneg _ h.le] +end + +@[continuity] +lemma continuous_rpow_const {y : ℝ} : continuous (λ a : ℝ≥0∞, a ^ y) := +begin + apply continuous_iff_continuous_at.2 (λ x, _), + rcases lt_trichotomy 0 y with hy|rfl|hy, + { exact continuous_at_rpow_const_of_pos hy }, + { simp only [rpow_zero], exact continuous_at_const }, + { obtain ⟨z, hz⟩ : ∃ z, y = -z := ⟨-y, (neg_neg _).symm⟩, + have z_pos : 0 < z, by simpa [hz] using hy, + simp_rw [hz, rpow_neg], + exact continuous_inv.continuous_at.comp (continuous_at_rpow_const_of_pos z_pos) } +end + +lemma tendsto_const_mul_rpow_nhds_zero_of_pos {c : ℝ≥0∞} (hc : c ≠ ∞) {y : ℝ} (hy : 0 < y) : + tendsto (λ x : ℝ≥0∞, c * x ^ y) (𝓝 0) (𝓝 0) := +begin + convert ennreal.tendsto.const_mul (ennreal.continuous_rpow_const.tendsto 0) _, + { simp [hy] }, + { exact or.inr hc } +end + +end ennreal + +lemma filter.tendsto.ennrpow_const {α : Type*} {f : filter α} {m : α → ℝ≥0∞} {a : ℝ≥0∞} (r : ℝ) + (hm : tendsto m f (𝓝 a)) : + tendsto (λ x, (m x) ^ r) f (𝓝 (a ^ r)) := +(ennreal.continuous_rpow_const.tendsto a).comp hm diff --git a/src/analysis/special_functions/pow/deriv.lean b/src/analysis/special_functions/pow/deriv.lean new file mode 100644 index 0000000000000..a65165d8bd4ef --- /dev/null +++ b/src/analysis/special_functions/pow/deriv.lean @@ -0,0 +1,591 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, + Rémy Degenne +-/ +import analysis.special_functions.pow.continuity +import analysis.special_functions.complex.log_deriv +import analysis.calculus.extend_deriv +import analysis.calculus.deriv.prod +import analysis.special_functions.log.deriv +import analysis.special_functions.trigonometric.deriv + +/-! +# Derivatives of power function on `ℂ`, `ℝ`, `ℝ≥0`, and `ℝ≥0∞` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We also prove differentiability and provide derivatives for the power functions `x ^ y`. +-/ + +noncomputable theory + +open_locale classical real topology nnreal ennreal filter +open filter + +namespace complex + +lemma has_strict_fderiv_at_cpow {p : ℂ × ℂ} (hp : 0 < p.1.re ∨ p.1.im ≠ 0) : + has_strict_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2) + ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℂ ℂ ℂ + + (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℂ ℂ ℂ) p := +begin + have A : p.1 ≠ 0, by { intro h, simpa [h, lt_irrefl] using hp }, + have : (λ x : ℂ × ℂ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2)), + from ((is_open_ne.preimage continuous_fst).eventually_mem A).mono + (λ p hp, cpow_def_of_ne_zero hp _), + rw [cpow_sub _ _ A, cpow_one, mul_div_left_comm, mul_smul, mul_smul, ← smul_add], + refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm, + simpa only [cpow_def_of_ne_zero A, div_eq_mul_inv, mul_smul, add_comm] + using ((has_strict_fderiv_at_fst.clog hp).mul has_strict_fderiv_at_snd).cexp +end + +lemma has_strict_fderiv_at_cpow' {x y : ℂ} (hp : 0 < x.re ∨ x.im ≠ 0) : + has_strict_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2) + ((y * x ^ (y - 1)) • continuous_linear_map.fst ℂ ℂ ℂ + + (x ^ y * log x) • continuous_linear_map.snd ℂ ℂ ℂ) (x, y) := +@has_strict_fderiv_at_cpow (x, y) hp + +lemma has_strict_deriv_at_const_cpow {x y : ℂ} (h : x ≠ 0 ∨ y ≠ 0) : + has_strict_deriv_at (λ y, x ^ y) (x ^ y * log x) y := +begin + rcases em (x = 0) with rfl|hx, + { replace h := h.neg_resolve_left rfl, + rw [log_zero, mul_zero], + refine (has_strict_deriv_at_const _ 0).congr_of_eventually_eq _, + exact (is_open_ne.eventually_mem h).mono (λ y hy, (zero_cpow hy).symm) }, + { simpa only [cpow_def_of_ne_zero hx, mul_one] + using ((has_strict_deriv_at_id y).const_mul (log x)).cexp } +end + +lemma has_fderiv_at_cpow {p : ℂ × ℂ} (hp : 0 < p.1.re ∨ p.1.im ≠ 0) : + has_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2) + ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℂ ℂ ℂ + + (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℂ ℂ ℂ) p := +(has_strict_fderiv_at_cpow hp).has_fderiv_at + +end complex + +section fderiv + +open complex + +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {f g : E → ℂ} {f' g' : E →L[ℂ] ℂ} + {x : E} {s : set E} {c : ℂ} + +lemma has_strict_fderiv_at.cpow (hf : has_strict_fderiv_at f f' x) + (hg : has_strict_fderiv_at g g' x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_strict_fderiv_at (λ x, f x ^ g x) + ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := +by convert (@has_strict_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp x (hf.prod hg) + +lemma has_strict_fderiv_at.const_cpow (hf : has_strict_fderiv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) : + has_strict_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := +(has_strict_deriv_at_const_cpow h0).comp_has_strict_fderiv_at x hf + +lemma has_fderiv_at.cpow (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) + (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_fderiv_at (λ x, f x ^ g x) + ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := +by convert (@complex.has_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp x (hf.prod hg) + +lemma has_fderiv_at.const_cpow (hf : has_fderiv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) : + has_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := +(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_fderiv_at x hf + +lemma has_fderiv_within_at.cpow (hf : has_fderiv_within_at f f' s x) + (hg : has_fderiv_within_at g g' s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_fderiv_within_at (λ x, f x ^ g x) + ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') s x := +by convert (@complex.has_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp_has_fderiv_within_at x + (hf.prod hg) + +lemma has_fderiv_within_at.const_cpow (hf : has_fderiv_within_at f f' s x) (h0 : c ≠ 0 ∨ f x ≠ 0) : + has_fderiv_within_at (λ x, c ^ f x) ((c ^ f x * log c) • f') s x := +(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_fderiv_within_at x hf + +lemma differentiable_at.cpow (hf : differentiable_at ℂ f x) (hg : differentiable_at ℂ g x) + (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + differentiable_at ℂ (λ x, f x ^ g x) x := +(hf.has_fderiv_at.cpow hg.has_fderiv_at h0).differentiable_at + +lemma differentiable_at.const_cpow (hf : differentiable_at ℂ f x) (h0 : c ≠ 0 ∨ f x ≠ 0) : + differentiable_at ℂ (λ x, c ^ f x) x := +(hf.has_fderiv_at.const_cpow h0).differentiable_at + +lemma differentiable_within_at.cpow (hf : differentiable_within_at ℂ f s x) + (hg : differentiable_within_at ℂ g s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + differentiable_within_at ℂ (λ x, f x ^ g x) s x := +(hf.has_fderiv_within_at.cpow hg.has_fderiv_within_at h0).differentiable_within_at + +lemma differentiable_within_at.const_cpow (hf : differentiable_within_at ℂ f s x) + (h0 : c ≠ 0 ∨ f x ≠ 0) : + differentiable_within_at ℂ (λ x, c ^ f x) s x := +(hf.has_fderiv_within_at.const_cpow h0).differentiable_within_at + +end fderiv + +section deriv + +open complex + +variables {f g : ℂ → ℂ} {s : set ℂ} {f' g' x c : ℂ} + +/-- A private lemma that rewrites the output of lemmas like `has_fderiv_at.cpow` to the form +expected by lemmas like `has_deriv_at.cpow`. -/ +private lemma aux : + ((g x * f x ^ (g x - 1)) • (1 : ℂ →L[ℂ] ℂ).smul_right f' + + (f x ^ g x * log (f x)) • (1 : ℂ →L[ℂ] ℂ).smul_right g') 1 = + g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g' := +by simp only [algebra.id.smul_eq_mul, one_mul, continuous_linear_map.one_apply, + continuous_linear_map.smul_right_apply, continuous_linear_map.add_apply, pi.smul_apply, + continuous_linear_map.coe_smul'] + +lemma has_strict_deriv_at.cpow (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x) + (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_strict_deriv_at (λ x, f x ^ g x) + (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') x := +by simpa only [aux] using (hf.cpow hg h0).has_strict_deriv_at + +lemma has_strict_deriv_at.const_cpow (hf : has_strict_deriv_at f f' x) (h : c ≠ 0 ∨ f x ≠ 0) : + has_strict_deriv_at (λ x, c ^ f x) (c ^ f x * log c * f') x := +(has_strict_deriv_at_const_cpow h).comp x hf + +lemma complex.has_strict_deriv_at_cpow_const (h : 0 < x.re ∨ x.im ≠ 0) : + has_strict_deriv_at (λ z : ℂ, z ^ c) (c * x ^ (c - 1)) x := +by simpa only [mul_zero, add_zero, mul_one] + using (has_strict_deriv_at_id x).cpow (has_strict_deriv_at_const x c) h + +lemma has_strict_deriv_at.cpow_const (hf : has_strict_deriv_at f f' x) + (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_strict_deriv_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') x := +(complex.has_strict_deriv_at_cpow_const h0).comp x hf + +lemma has_deriv_at.cpow (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) + (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_deriv_at (λ x, f x ^ g x) (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') x := +by simpa only [aux] using (hf.has_fderiv_at.cpow hg h0).has_deriv_at + +lemma has_deriv_at.const_cpow (hf : has_deriv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) : + has_deriv_at (λ x, c ^ f x) (c ^ f x * log c * f') x := +(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp x hf + +lemma has_deriv_at.cpow_const (hf : has_deriv_at f f' x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_deriv_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') x := +(complex.has_strict_deriv_at_cpow_const h0).has_deriv_at.comp x hf + +lemma has_deriv_within_at.cpow (hf : has_deriv_within_at f f' s x) + (hg : has_deriv_within_at g g' s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_deriv_within_at (λ x, f x ^ g x) + (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') s x := +by simpa only [aux] using (hf.has_fderiv_within_at.cpow hg h0).has_deriv_within_at + +lemma has_deriv_within_at.const_cpow (hf : has_deriv_within_at f f' s x) (h0 : c ≠ 0 ∨ f x ≠ 0) : + has_deriv_within_at (λ x, c ^ f x) (c ^ f x * log c * f') s x := +(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_deriv_within_at x hf + +lemma has_deriv_within_at.cpow_const (hf : has_deriv_within_at f f' s x) + (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : + has_deriv_within_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') s x := +(complex.has_strict_deriv_at_cpow_const h0).has_deriv_at.comp_has_deriv_within_at x hf + +/-- Although `λ x, x ^ r` for fixed `r` is *not* complex-differentiable along the negative real +line, it is still real-differentiable, and the derivative is what one would formally expect. -/ +lemma has_deriv_at_of_real_cpow {x : ℝ} (hx : x ≠ 0) {r : ℂ} (hr : r ≠ -1) : + has_deriv_at (λ y:ℝ, (y:ℂ) ^ (r + 1) / (r + 1)) (x ^ r) x := +begin + rw [ne.def, ←add_eq_zero_iff_eq_neg, ←ne.def] at hr, + rcases lt_or_gt_of_ne hx.symm with hx | hx, + { -- easy case : `0 < x` + convert (((has_deriv_at_id (x:ℂ)).cpow_const _).div_const (r + 1)).comp_of_real, + { rw [add_sub_cancel, id.def, mul_one, mul_comm, mul_div_cancel _ hr] }, + { rw [id.def, of_real_re], exact or.inl hx } }, + { -- harder case : `x < 0` + have : ∀ᶠ (y:ℝ) in nhds x, (y:ℂ) ^ (r + 1) / (r + 1) = + (-y:ℂ) ^ (r + 1) * exp (π * I * (r + 1)) / (r + 1), + { refine filter.eventually_of_mem (Iio_mem_nhds hx) (λ y hy, _), + rw of_real_cpow_of_nonpos (le_of_lt hy) }, + refine has_deriv_at.congr_of_eventually_eq _ this, + rw of_real_cpow_of_nonpos (le_of_lt hx), + suffices : has_deriv_at (λ (y : ℝ), (-↑y) ^ (r + 1) * exp (↑π * I * (r + 1))) + ((r + 1) * (-↑x) ^ r * exp (↑π * I * r)) x, + { convert this.div_const (r + 1) using 1, + conv_rhs { rw [mul_assoc, mul_comm, mul_div_cancel _ hr] } }, + rw [mul_add ((π:ℂ) * _), mul_one, exp_add, exp_pi_mul_I, + mul_comm (_ : ℂ) (-1 : ℂ), neg_one_mul], + simp_rw [mul_neg, ←neg_mul, ←of_real_neg], + suffices : has_deriv_at (λ (y : ℝ), (↑-y) ^ (r + 1)) (-(r + 1) * (↑-x) ^ r) x, + { convert this.neg.mul_const _, ring }, + suffices : has_deriv_at (λ (y : ℝ), (↑y) ^ (r + 1)) ((r + 1) * (↑-x) ^ r) (-x), + { convert @has_deriv_at.scomp ℝ _ ℂ _ _ x ℝ _ _ _ _ _ _ _ _ this (has_deriv_at_neg x) using 1, + rw [real_smul, of_real_neg 1, of_real_one], ring }, + suffices : has_deriv_at (λ (y : ℂ), y ^ (r + 1)) ((r + 1) * (↑-x) ^ r) (↑-x), + { exact this.comp_of_real }, + conv in ((↑_) ^ _) { rw (by ring : r = (r + 1) - 1) }, + convert (has_deriv_at_id ((-x : ℝ) : ℂ)).cpow_const _ using 1, + { simp }, + { left, rwa [id.def, of_real_re, neg_pos] } }, +end + +end deriv + +namespace real + +variables {x y z : ℝ} + +/-- `(x, y) ↦ x ^ y` is strictly differentiable at `p : ℝ × ℝ` such that `0 < p.fst`. -/ +lemma has_strict_fderiv_at_rpow_of_pos (p : ℝ × ℝ) (hp : 0 < p.1) : + has_strict_fderiv_at (λ x : ℝ × ℝ, x.1 ^ x.2) + ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℝ ℝ ℝ + + (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℝ ℝ ℝ) p := +begin + have : (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2)), + from (continuous_at_fst.eventually (lt_mem_nhds hp)).mono (λ p hp, rpow_def_of_pos hp _), + refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm, + convert ((has_strict_fderiv_at_fst.log hp.ne').mul has_strict_fderiv_at_snd).exp, + rw [rpow_sub_one hp.ne', ← rpow_def_of_pos hp, smul_add, smul_smul, mul_div_left_comm, + div_eq_mul_inv, smul_smul, smul_smul, mul_assoc, add_comm] +end + +/-- `(x, y) ↦ x ^ y` is strictly differentiable at `p : ℝ × ℝ` such that `p.fst < 0`. -/ +lemma has_strict_fderiv_at_rpow_of_neg (p : ℝ × ℝ) (hp : p.1 < 0) : + has_strict_fderiv_at (λ x : ℝ × ℝ, x.1 ^ x.2) + ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℝ ℝ ℝ + + (p.1 ^ p.2 * log p.1 - exp (log p.1 * p.2) * sin (p.2 * π) * π) • + continuous_linear_map.snd ℝ ℝ ℝ) p := +begin + have : (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2) * cos (x.2 * π)), + from (continuous_at_fst.eventually (gt_mem_nhds hp)).mono (λ p hp, rpow_def_of_neg hp _), + refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm, + convert ((has_strict_fderiv_at_fst.log hp.ne).mul has_strict_fderiv_at_snd).exp.mul + (has_strict_fderiv_at_snd.mul_const _).cos using 1, + simp_rw [rpow_sub_one hp.ne, smul_add, ← add_assoc, smul_smul, ← add_smul, ← mul_assoc, + mul_comm (cos _), ← rpow_def_of_neg hp], + rw [div_eq_mul_inv, add_comm], congr' 2; ring +end + +/-- The function `λ (x, y), x ^ y` is infinitely smooth at `(x, y)` unless `x = 0`. -/ +lemma cont_diff_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) {n : ℕ∞} : + cont_diff_at ℝ n (λ p : ℝ × ℝ, p.1 ^ p.2) p := +begin + cases hp.lt_or_lt with hneg hpos, + exacts [(((cont_diff_at_fst.log hneg.ne).mul cont_diff_at_snd).exp.mul + (cont_diff_at_snd.mul cont_diff_at_const).cos).congr_of_eventually_eq + ((continuous_at_fst.eventually (gt_mem_nhds hneg)).mono (λ p hp, rpow_def_of_neg hp _)), + ((cont_diff_at_fst.log hpos.ne').mul cont_diff_at_snd).exp.congr_of_eventually_eq + ((continuous_at_fst.eventually (lt_mem_nhds hpos)).mono (λ p hp, rpow_def_of_pos hp _))] +end + +lemma differentiable_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) : + differentiable_at ℝ (λ p : ℝ × ℝ, p.1 ^ p.2) p := +(cont_diff_at_rpow_of_ne p hp).differentiable_at le_rfl + +lemma _root_.has_strict_deriv_at.rpow {f g : ℝ → ℝ} {f' g' : ℝ} (hf : has_strict_deriv_at f f' x) + (hg : has_strict_deriv_at g g' x) (h : 0 < f x) : + has_strict_deriv_at (λ x, f x ^ g x) + (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) x := +begin + convert (has_strict_fderiv_at_rpow_of_pos ((λ x, (f x, g x)) x) h).comp_has_strict_deriv_at _ + (hf.prod hg) using 1, + simp [mul_assoc, mul_comm, mul_left_comm] +end + +lemma has_strict_deriv_at_rpow_const_of_ne {x : ℝ} (hx : x ≠ 0) (p : ℝ) : + has_strict_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x := +begin + cases hx.lt_or_lt with hx hx, + { have := (has_strict_fderiv_at_rpow_of_neg (x, p) hx).comp_has_strict_deriv_at x + ((has_strict_deriv_at_id x).prod (has_strict_deriv_at_const _ _)), + convert this, simp }, + { simpa using (has_strict_deriv_at_id x).rpow (has_strict_deriv_at_const x p) hx } +end + +lemma has_strict_deriv_at_const_rpow {a : ℝ} (ha : 0 < a) (x : ℝ) : + has_strict_deriv_at (λ x, a ^ x) (a ^ x * log a) x := +by simpa using (has_strict_deriv_at_const _ _).rpow (has_strict_deriv_at_id x) ha + +/-- This lemma says that `λ x, a ^ x` is strictly differentiable for `a < 0`. Note that these +values of `a` are outside of the "official" domain of `a ^ x`, and we may redefine `a ^ x` +for negative `a` if some other definition will be more convenient. -/ +lemma has_strict_deriv_at_const_rpow_of_neg {a x : ℝ} (ha : a < 0) : + has_strict_deriv_at (λ x, a ^ x) (a ^ x * log a - exp (log a * x) * sin (x * π) * π) x := +by simpa using (has_strict_fderiv_at_rpow_of_neg (a, x) ha).comp_has_strict_deriv_at x + ((has_strict_deriv_at_const _ _).prod (has_strict_deriv_at_id _)) + +end real + +namespace real + +variables {z x y : ℝ} + +lemma has_deriv_at_rpow_const {x p : ℝ} (h : x ≠ 0 ∨ 1 ≤ p) : + has_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x := +begin + rcases ne_or_eq x 0 with hx | rfl, + { exact (has_strict_deriv_at_rpow_const_of_ne hx _).has_deriv_at }, + replace h : 1 ≤ p := h.neg_resolve_left rfl, + apply has_deriv_at_of_has_deriv_at_of_ne + (λ x hx, (has_strict_deriv_at_rpow_const_of_ne hx p).has_deriv_at), + exacts [continuous_at_id.rpow_const (or.inr (zero_le_one.trans h)), + continuous_at_const.mul (continuous_at_id.rpow_const (or.inr (sub_nonneg.2 h)))] +end + +lemma differentiable_rpow_const {p : ℝ} (hp : 1 ≤ p) : + differentiable ℝ (λ x : ℝ, x ^ p) := +λ x, (has_deriv_at_rpow_const (or.inr hp)).differentiable_at + +lemma deriv_rpow_const {x p : ℝ} (h : x ≠ 0 ∨ 1 ≤ p) : + deriv (λ x : ℝ, x ^ p) x = p * x ^ (p - 1) := +(has_deriv_at_rpow_const h).deriv + +lemma deriv_rpow_const' {p : ℝ} (h : 1 ≤ p) : + deriv (λ x : ℝ, x ^ p) = λ x, p * x ^ (p - 1) := +funext $ λ x, deriv_rpow_const (or.inr h) + +lemma cont_diff_at_rpow_const_of_ne {x p : ℝ} {n : ℕ∞} (h : x ≠ 0) : + cont_diff_at ℝ n (λ x, x ^ p) x := +(cont_diff_at_rpow_of_ne (x, p) h).comp x + (cont_diff_at_id.prod cont_diff_at_const) + +lemma cont_diff_rpow_const_of_le {p : ℝ} {n : ℕ} (h : ↑n ≤ p) : + cont_diff ℝ n (λ x : ℝ, x ^ p) := +begin + induction n with n ihn generalizing p, + { exact cont_diff_zero.2 (continuous_id.rpow_const (λ x, by exact_mod_cast or.inr h)) }, + { have h1 : 1 ≤ p, from le_trans (by simp) h, + rw [nat.cast_succ, ← le_sub_iff_add_le] at h, + rw [cont_diff_succ_iff_deriv, deriv_rpow_const' h1], + refine ⟨differentiable_rpow_const h1, cont_diff_const.mul (ihn h)⟩ } +end + +lemma cont_diff_at_rpow_const_of_le {x p : ℝ} {n : ℕ} (h : ↑n ≤ p) : + cont_diff_at ℝ n (λ x : ℝ, x ^ p) x := +(cont_diff_rpow_const_of_le h).cont_diff_at + +lemma cont_diff_at_rpow_const {x p : ℝ} {n : ℕ} (h : x ≠ 0 ∨ ↑n ≤ p) : + cont_diff_at ℝ n (λ x : ℝ, x ^ p) x := +h.elim cont_diff_at_rpow_const_of_ne cont_diff_at_rpow_const_of_le + +lemma has_strict_deriv_at_rpow_const {x p : ℝ} (hx : x ≠ 0 ∨ 1 ≤ p) : + has_strict_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x := +cont_diff_at.has_strict_deriv_at' + (cont_diff_at_rpow_const (by rwa nat.cast_one)) + (has_deriv_at_rpow_const hx) le_rfl + +end real + +section differentiability +open real + +section fderiv + +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f g : E → ℝ} {f' g' : E →L[ℝ] ℝ} + {x : E} {s : set E} {c p : ℝ} {n : ℕ∞} + +lemma has_fderiv_within_at.rpow (hf : has_fderiv_within_at f f' s x) + (hg : has_fderiv_within_at g g' s x) (h : 0 < f x) : + has_fderiv_within_at (λ x, f x ^ g x) + ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') s x := +(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).has_fderiv_at.comp_has_fderiv_within_at x + (hf.prod hg) + +lemma has_fderiv_at.rpow (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) (h : 0 < f x) : + has_fderiv_at (λ x, f x ^ g x) ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := +(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).has_fderiv_at.comp x (hf.prod hg) + +lemma has_strict_fderiv_at.rpow (hf : has_strict_fderiv_at f f' x) + (hg : has_strict_fderiv_at g g' x) (h : 0 < f x) : + has_strict_fderiv_at (λ x, f x ^ g x) + ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := +(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).comp x (hf.prod hg) + +lemma differentiable_within_at.rpow (hf : differentiable_within_at ℝ f s x) + (hg : differentiable_within_at ℝ g s x) (h : f x ≠ 0) : + differentiable_within_at ℝ (λ x, f x ^ g x) s x := +(differentiable_at_rpow_of_ne (f x, g x) h).comp_differentiable_within_at x (hf.prod hg) + +lemma differentiable_at.rpow (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) + (h : f x ≠ 0) : + differentiable_at ℝ (λ x, f x ^ g x) x := +(differentiable_at_rpow_of_ne (f x, g x) h).comp x (hf.prod hg) + +lemma differentiable_on.rpow (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s) + (h : ∀ x ∈ s, f x ≠ 0) : + differentiable_on ℝ (λ x, f x ^ g x) s := +λ x hx, (hf x hx).rpow (hg x hx) (h x hx) + +lemma differentiable.rpow (hf : differentiable ℝ f) (hg : differentiable ℝ g) (h : ∀ x, f x ≠ 0) : + differentiable ℝ (λ x, f x ^ g x) := +λ x, (hf x).rpow (hg x) (h x) + +lemma has_fderiv_within_at.rpow_const (hf : has_fderiv_within_at f f' s x) (h : f x ≠ 0 ∨ 1 ≤ p) : + has_fderiv_within_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') s x := +(has_deriv_at_rpow_const h).comp_has_fderiv_within_at x hf + +lemma has_fderiv_at.rpow_const (hf : has_fderiv_at f f' x) (h : f x ≠ 0 ∨ 1 ≤ p) : + has_fderiv_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') x := +(has_deriv_at_rpow_const h).comp_has_fderiv_at x hf + +lemma has_strict_fderiv_at.rpow_const (hf : has_strict_fderiv_at f f' x) (h : f x ≠ 0 ∨ 1 ≤ p) : + has_strict_fderiv_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') x := +(has_strict_deriv_at_rpow_const h).comp_has_strict_fderiv_at x hf + +lemma differentiable_within_at.rpow_const (hf : differentiable_within_at ℝ f s x) + (h : f x ≠ 0 ∨ 1 ≤ p) : + differentiable_within_at ℝ (λ x, f x ^ p) s x := +(hf.has_fderiv_within_at.rpow_const h).differentiable_within_at + +@[simp] lemma differentiable_at.rpow_const (hf : differentiable_at ℝ f x) (h : f x ≠ 0 ∨ 1 ≤ p) : + differentiable_at ℝ (λ x, f x ^ p) x := +(hf.has_fderiv_at.rpow_const h).differentiable_at + +lemma differentiable_on.rpow_const (hf : differentiable_on ℝ f s) (h : ∀ x ∈ s, f x ≠ 0 ∨ 1 ≤ p) : + differentiable_on ℝ (λ x, f x ^ p) s := +λ x hx, (hf x hx).rpow_const (h x hx) + +lemma differentiable.rpow_const (hf : differentiable ℝ f) (h : ∀ x, f x ≠ 0 ∨ 1 ≤ p) : + differentiable ℝ (λ x, f x ^ p) := +λ x, (hf x).rpow_const (h x) + +lemma has_fderiv_within_at.const_rpow (hf : has_fderiv_within_at f f' s x) (hc : 0 < c) : + has_fderiv_within_at (λ x, c ^ f x) ((c ^ f x * log c) • f') s x := +(has_strict_deriv_at_const_rpow hc (f x)).has_deriv_at.comp_has_fderiv_within_at x hf + +lemma has_fderiv_at.const_rpow (hf : has_fderiv_at f f' x) (hc : 0 < c) : + has_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := +(has_strict_deriv_at_const_rpow hc (f x)).has_deriv_at.comp_has_fderiv_at x hf + +lemma has_strict_fderiv_at.const_rpow (hf : has_strict_fderiv_at f f' x) (hc : 0 < c) : + has_strict_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := +(has_strict_deriv_at_const_rpow hc (f x)).comp_has_strict_fderiv_at x hf + +lemma cont_diff_within_at.rpow (hf : cont_diff_within_at ℝ n f s x) + (hg : cont_diff_within_at ℝ n g s x) (h : f x ≠ 0) : + cont_diff_within_at ℝ n (λ x, f x ^ g x) s x := +(cont_diff_at_rpow_of_ne (f x, g x) h).comp_cont_diff_within_at x (hf.prod hg) + +lemma cont_diff_at.rpow (hf : cont_diff_at ℝ n f x) (hg : cont_diff_at ℝ n g x) + (h : f x ≠ 0) : + cont_diff_at ℝ n (λ x, f x ^ g x) x := +(cont_diff_at_rpow_of_ne (f x, g x) h).comp x (hf.prod hg) + +lemma cont_diff_on.rpow (hf : cont_diff_on ℝ n f s) (hg : cont_diff_on ℝ n g s) + (h : ∀ x ∈ s, f x ≠ 0) : + cont_diff_on ℝ n (λ x, f x ^ g x) s := +λ x hx, (hf x hx).rpow (hg x hx) (h x hx) + +lemma cont_diff.rpow (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) + (h : ∀ x, f x ≠ 0) : + cont_diff ℝ n (λ x, f x ^ g x) := +cont_diff_iff_cont_diff_at.mpr $ + λ x, hf.cont_diff_at.rpow hg.cont_diff_at (h x) + +lemma cont_diff_within_at.rpow_const_of_ne (hf : cont_diff_within_at ℝ n f s x) + (h : f x ≠ 0) : + cont_diff_within_at ℝ n (λ x, f x ^ p) s x := +hf.rpow cont_diff_within_at_const h + +lemma cont_diff_at.rpow_const_of_ne (hf : cont_diff_at ℝ n f x) (h : f x ≠ 0) : + cont_diff_at ℝ n (λ x, f x ^ p) x := +hf.rpow cont_diff_at_const h + +lemma cont_diff_on.rpow_const_of_ne (hf : cont_diff_on ℝ n f s) (h : ∀ x ∈ s, f x ≠ 0) : + cont_diff_on ℝ n (λ x, f x ^ p) s := +λ x hx, (hf x hx).rpow_const_of_ne (h x hx) + +lemma cont_diff.rpow_const_of_ne (hf : cont_diff ℝ n f) (h : ∀ x, f x ≠ 0) : + cont_diff ℝ n (λ x, f x ^ p) := +hf.rpow cont_diff_const h + +variable {m : ℕ} + +lemma cont_diff_within_at.rpow_const_of_le (hf : cont_diff_within_at ℝ m f s x) + (h : ↑m ≤ p) : + cont_diff_within_at ℝ m (λ x, f x ^ p) s x := +(cont_diff_at_rpow_const_of_le h).comp_cont_diff_within_at x hf + +lemma cont_diff_at.rpow_const_of_le (hf : cont_diff_at ℝ m f x) (h : ↑m ≤ p) : + cont_diff_at ℝ m (λ x, f x ^ p) x := +by { rw ← cont_diff_within_at_univ at *, exact hf.rpow_const_of_le h } + +lemma cont_diff_on.rpow_const_of_le (hf : cont_diff_on ℝ m f s) (h : ↑m ≤ p) : + cont_diff_on ℝ m (λ x, f x ^ p) s := +λ x hx, (hf x hx).rpow_const_of_le h + +lemma cont_diff.rpow_const_of_le (hf : cont_diff ℝ m f) (h : ↑m ≤ p) : + cont_diff ℝ m (λ x, f x ^ p) := +cont_diff_iff_cont_diff_at.mpr $ λ x, hf.cont_diff_at.rpow_const_of_le h + +end fderiv + +section deriv + +variables {f g : ℝ → ℝ} {f' g' x y p : ℝ} {s : set ℝ} + +lemma has_deriv_within_at.rpow (hf : has_deriv_within_at f f' s x) + (hg : has_deriv_within_at g g' s x) (h : 0 < f x) : + has_deriv_within_at (λ x, f x ^ g x) + (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) s x := +begin + convert (hf.has_fderiv_within_at.rpow hg.has_fderiv_within_at h).has_deriv_within_at using 1, + dsimp, ring +end + +lemma has_deriv_at.rpow (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) (h : 0 < f x) : + has_deriv_at (λ x, f x ^ g x) (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) x := +begin + rw ← has_deriv_within_at_univ at *, + exact hf.rpow hg h +end + +lemma has_deriv_within_at.rpow_const (hf : has_deriv_within_at f f' s x) (hx : f x ≠ 0 ∨ 1 ≤ p) : + has_deriv_within_at (λ y, (f y)^p) (f' * p * (f x) ^ (p - 1)) s x := +begin + convert (has_deriv_at_rpow_const hx).comp_has_deriv_within_at x hf using 1, + ring +end + +lemma has_deriv_at.rpow_const (hf : has_deriv_at f f' x) (hx : f x ≠ 0 ∨ 1 ≤ p) : + has_deriv_at (λ y, (f y)^p) (f' * p * (f x)^(p-1)) x := +begin + rw ← has_deriv_within_at_univ at *, + exact hf.rpow_const hx +end + +lemma deriv_within_rpow_const (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0 ∨ 1 ≤ p) + (hxs : unique_diff_within_at ℝ s x) : + deriv_within (λx, (f x) ^ p) s x = (deriv_within f s x) * p * (f x) ^ (p - 1) := +(hf.has_deriv_within_at.rpow_const hx).deriv_within hxs + +@[simp] lemma deriv_rpow_const (hf : differentiable_at ℝ f x) (hx : f x ≠ 0 ∨ 1 ≤ p) : + deriv (λx, (f x)^p) x = (deriv f x) * p * (f x)^(p-1) := +(hf.has_deriv_at.rpow_const hx).deriv + +end deriv + +end differentiability + +section limits +open real filter + +/-- The function `(1 + t/x) ^ x` tends to `exp t` at `+∞`. -/ +lemma tendsto_one_plus_div_rpow_exp (t : ℝ) : + tendsto (λ (x : ℝ), (1 + t / x) ^ x) at_top (𝓝 (exp t)) := +begin + apply ((real.continuous_exp.tendsto _).comp (tendsto_mul_log_one_plus_div_at_top t)).congr' _, + have h₁ : (1:ℝ)/2 < 1 := by linarith, + have h₂ : tendsto (λ x : ℝ, 1 + t / x) at_top (𝓝 1) := + by simpa using (tendsto_inv_at_top_zero.const_mul t).const_add 1, + refine (eventually_ge_of_tendsto_gt h₁ h₂).mono (λ x hx, _), + have hx' : 0 < 1 + t / x := by linarith, + simp [mul_comm x, exp_mul, exp_log hx'], +end + +/-- The function `(1 + t/x) ^ x` tends to `exp t` at `+∞` for naturals `x`. -/ +lemma tendsto_one_plus_div_pow_exp (t : ℝ) : + tendsto (λ (x : ℕ), (1 + t / (x:ℝ)) ^ x) at_top (𝓝 (real.exp t)) := +((tendsto_one_plus_div_rpow_exp t).comp tendsto_coe_nat_at_top_at_top).congr (by simp) + +end limits diff --git a/src/analysis/special_functions/pow/nnreal.lean b/src/analysis/special_functions/pow/nnreal.lean new file mode 100644 index 0000000000000..680cad3232806 --- /dev/null +++ b/src/analysis/special_functions/pow/nnreal.lean @@ -0,0 +1,785 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, + Rémy Degenne, David Loeffler +-/ +import analysis.special_functions.pow.real + +/-! +# Power function on `ℝ≥0` and `ℝ≥0∞` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct the power functions `x ^ y` where +* `x` is a nonnegative real number and `y` is a real number; +* `x` is a number from `[0, +∞]` (a.k.a. `ℝ≥0∞`) and `y` is a real number. + +We also prove basic properties of these functions. +-/ + +noncomputable theory + +open_locale classical real nnreal ennreal big_operators complex_conjugate +open finset set + +namespace nnreal + +/-- The nonnegative real power function `x^y`, defined for `x : ℝ≥0` and `y : ℝ ` as the +restriction of the real power function. For `x > 0`, it is equal to `exp (y log x)`. For `x = 0`, +one sets `0 ^ 0 = 1` and `0 ^ y = 0` for `y ≠ 0`. -/ +noncomputable def rpow (x : ℝ≥0) (y : ℝ) : ℝ≥0 := +⟨(x : ℝ) ^ y, real.rpow_nonneg_of_nonneg x.2 y⟩ + +noncomputable instance : has_pow ℝ≥0 ℝ := ⟨rpow⟩ + +@[simp] lemma rpow_eq_pow (x : ℝ≥0) (y : ℝ) : rpow x y = x ^ y := rfl + +@[simp, norm_cast] lemma coe_rpow (x : ℝ≥0) (y : ℝ) : ((x ^ y : ℝ≥0) : ℝ) = (x : ℝ) ^ y := rfl + +@[simp] lemma rpow_zero (x : ℝ≥0) : x ^ (0 : ℝ) = 1 := +nnreal.eq $ real.rpow_zero _ + +@[simp] lemma rpow_eq_zero_iff {x : ℝ≥0} {y : ℝ} : x ^ y = 0 ↔ x = 0 ∧ y ≠ 0 := +begin + rw [← nnreal.coe_eq, coe_rpow, ← nnreal.coe_eq_zero], + exact real.rpow_eq_zero_iff_of_nonneg x.2 +end + +@[simp] lemma zero_rpow {x : ℝ} (h : x ≠ 0) : (0 : ℝ≥0) ^ x = 0 := +nnreal.eq $ real.zero_rpow h + +@[simp] lemma rpow_one (x : ℝ≥0) : x ^ (1 : ℝ) = x := +nnreal.eq $ real.rpow_one _ + +@[simp] lemma one_rpow (x : ℝ) : (1 : ℝ≥0) ^ x = 1 := +nnreal.eq $ real.one_rpow _ + +lemma rpow_add {x : ℝ≥0} (hx : x ≠ 0) (y z : ℝ) : x ^ (y + z) = x ^ y * x ^ z := +nnreal.eq $ real.rpow_add (pos_iff_ne_zero.2 hx) _ _ + +lemma rpow_add' (x : ℝ≥0) {y z : ℝ} (h : y + z ≠ 0) : x ^ (y + z) = x ^ y * x ^ z := +nnreal.eq $ real.rpow_add' x.2 h + +lemma rpow_mul (x : ℝ≥0) (y z : ℝ) : x ^ (y * z) = (x ^ y) ^ z := +nnreal.eq $ real.rpow_mul x.2 y z + +lemma rpow_neg (x : ℝ≥0) (y : ℝ) : x ^ -y = (x ^ y)⁻¹ := +nnreal.eq $ real.rpow_neg x.2 _ + +lemma rpow_neg_one (x : ℝ≥0) : x ^ (-1 : ℝ) = x ⁻¹ := +by simp [rpow_neg] + +lemma rpow_sub {x : ℝ≥0} (hx : x ≠ 0) (y z : ℝ) : x ^ (y - z) = x ^ y / x ^ z := +nnreal.eq $ real.rpow_sub (pos_iff_ne_zero.2 hx) y z + +lemma rpow_sub' (x : ℝ≥0) {y z : ℝ} (h : y - z ≠ 0) : + x ^ (y - z) = x ^ y / x ^ z := +nnreal.eq $ real.rpow_sub' x.2 h + +lemma rpow_inv_rpow_self {y : ℝ} (hy : y ≠ 0) (x : ℝ≥0) : (x ^ y) ^ (1 / y) = x := +by field_simp [← rpow_mul] + +lemma rpow_self_rpow_inv {y : ℝ} (hy : y ≠ 0) (x : ℝ≥0) : (x ^ (1 / y)) ^ y = x := +by field_simp [← rpow_mul] + +lemma inv_rpow (x : ℝ≥0) (y : ℝ) : (x⁻¹) ^ y = (x ^ y)⁻¹ := +nnreal.eq $ real.inv_rpow x.2 y + +lemma div_rpow (x y : ℝ≥0) (z : ℝ) : (x / y) ^ z = x ^ z / y ^ z := +nnreal.eq $ real.div_rpow x.2 y.2 z + +lemma sqrt_eq_rpow (x : ℝ≥0) : sqrt x = x ^ (1/(2:ℝ)) := +begin + refine nnreal.eq _, + push_cast, + exact real.sqrt_eq_rpow x.1, +end + +@[simp, norm_cast] lemma rpow_nat_cast (x : ℝ≥0) (n : ℕ) : x ^ (n : ℝ) = x ^ n := +nnreal.eq $ by simpa only [coe_rpow, coe_pow] using real.rpow_nat_cast x n + +@[simp] lemma rpow_two (x : ℝ≥0) : x ^ (2 : ℝ) = x ^ 2 := +by { rw ← rpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } + +lemma mul_rpow {x y : ℝ≥0} {z : ℝ} : (x*y)^z = x^z * y^z := +nnreal.eq $ real.mul_rpow x.2 y.2 + +lemma rpow_le_rpow {x y : ℝ≥0} {z: ℝ} (h₁ : x ≤ y) (h₂ : 0 ≤ z) : x^z ≤ y^z := +real.rpow_le_rpow x.2 h₁ h₂ + +lemma rpow_lt_rpow {x y : ℝ≥0} {z: ℝ} (h₁ : x < y) (h₂ : 0 < z) : x^z < y^z := +real.rpow_lt_rpow x.2 h₁ h₂ + +lemma rpow_lt_rpow_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ^ z < y ^ z ↔ x < y := +real.rpow_lt_rpow_iff x.2 y.2 hz + +lemma rpow_le_rpow_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ^ z ≤ y ^ z ↔ x ≤ y := +real.rpow_le_rpow_iff x.2 y.2 hz + +lemma le_rpow_one_div_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ≤ y ^ (1 / z) ↔ x ^ z ≤ y := +by rw [← rpow_le_rpow_iff hz, rpow_self_rpow_inv hz.ne'] + +lemma rpow_one_div_le_iff {x y : ℝ≥0} {z : ℝ} (hz : 0 < z) : x ^ (1 / z) ≤ y ↔ x ≤ y ^ z := +by rw [← rpow_le_rpow_iff hz, rpow_self_rpow_inv hz.ne'] + +lemma rpow_lt_rpow_of_exponent_lt {x : ℝ≥0} {y z : ℝ} (hx : 1 < x) (hyz : y < z) : x^y < x^z := +real.rpow_lt_rpow_of_exponent_lt hx hyz + +lemma rpow_le_rpow_of_exponent_le {x : ℝ≥0} {y z : ℝ} (hx : 1 ≤ x) (hyz : y ≤ z) : x^y ≤ x^z := +real.rpow_le_rpow_of_exponent_le hx hyz + +lemma rpow_lt_rpow_of_exponent_gt {x : ℝ≥0} {y z : ℝ} (hx0 : 0 < x) (hx1 : x < 1) (hyz : z < y) : + x^y < x^z := +real.rpow_lt_rpow_of_exponent_gt hx0 hx1 hyz + +lemma rpow_le_rpow_of_exponent_ge {x : ℝ≥0} {y z : ℝ} (hx0 : 0 < x) (hx1 : x ≤ 1) (hyz : z ≤ y) : + x^y ≤ x^z := +real.rpow_le_rpow_of_exponent_ge hx0 hx1 hyz + +lemma rpow_pos {p : ℝ} {x : ℝ≥0} (hx_pos : 0 < x) : 0 < x^p := +begin + have rpow_pos_of_nonneg : ∀ {p : ℝ}, 0 < p → 0 < x^p, + { intros p hp_pos, + rw ←zero_rpow hp_pos.ne', + exact rpow_lt_rpow hx_pos hp_pos }, + rcases lt_trichotomy 0 p with hp_pos|rfl|hp_neg, + { exact rpow_pos_of_nonneg hp_pos }, + { simp only [zero_lt_one, rpow_zero] }, + { rw [←neg_neg p, rpow_neg, inv_pos], + exact rpow_pos_of_nonneg (neg_pos.mpr hp_neg) }, +end + +lemma rpow_lt_one {x : ℝ≥0} {z : ℝ} (hx1 : x < 1) (hz : 0 < z) : x^z < 1 := +real.rpow_lt_one (coe_nonneg x) hx1 hz + +lemma rpow_le_one {x : ℝ≥0} {z : ℝ} (hx2 : x ≤ 1) (hz : 0 ≤ z) : x^z ≤ 1 := +real.rpow_le_one x.2 hx2 hz + +lemma rpow_lt_one_of_one_lt_of_neg {x : ℝ≥0} {z : ℝ} (hx : 1 < x) (hz : z < 0) : x^z < 1 := +real.rpow_lt_one_of_one_lt_of_neg hx hz + +lemma rpow_le_one_of_one_le_of_nonpos {x : ℝ≥0} {z : ℝ} (hx : 1 ≤ x) (hz : z ≤ 0) : x^z ≤ 1 := +real.rpow_le_one_of_one_le_of_nonpos hx hz + +lemma one_lt_rpow {x : ℝ≥0} {z : ℝ} (hx : 1 < x) (hz : 0 < z) : 1 < x^z := +real.one_lt_rpow hx hz + +lemma one_le_rpow {x : ℝ≥0} {z : ℝ} (h : 1 ≤ x) (h₁ : 0 ≤ z) : 1 ≤ x^z := +real.one_le_rpow h h₁ + +lemma one_lt_rpow_of_pos_of_lt_one_of_neg {x : ℝ≥0} {z : ℝ} (hx1 : 0 < x) (hx2 : x < 1) + (hz : z < 0) : 1 < x^z := +real.one_lt_rpow_of_pos_of_lt_one_of_neg hx1 hx2 hz + +lemma one_le_rpow_of_pos_of_le_one_of_nonpos {x : ℝ≥0} {z : ℝ} (hx1 : 0 < x) (hx2 : x ≤ 1) + (hz : z ≤ 0) : 1 ≤ x^z := +real.one_le_rpow_of_pos_of_le_one_of_nonpos hx1 hx2 hz + +lemma rpow_le_self_of_le_one {x : ℝ≥0} {z : ℝ} (hx : x ≤ 1) (h_one_le : 1 ≤ z) : x ^ z ≤ x := +begin + rcases eq_bot_or_bot_lt x with rfl | (h : 0 < x), + { have : z ≠ 0 := by linarith, + simp [this] }, + nth_rewrite 1 ←nnreal.rpow_one x, + exact nnreal.rpow_le_rpow_of_exponent_ge h hx h_one_le, +end + +lemma rpow_left_injective {x : ℝ} (hx : x ≠ 0) : function.injective (λ y : ℝ≥0, y^x) := +λ y z hyz, by simpa only [rpow_inv_rpow_self hx] using congr_arg (λ y, y ^ (1 / x)) hyz + +lemma rpow_eq_rpow_iff {x y : ℝ≥0} {z : ℝ} (hz : z ≠ 0) : x ^ z = y ^ z ↔ x = y := +(rpow_left_injective hz).eq_iff + +lemma rpow_left_surjective {x : ℝ} (hx : x ≠ 0) : function.surjective (λ y : ℝ≥0, y^x) := +λ y, ⟨y ^ x⁻¹, by simp_rw [←rpow_mul, _root_.inv_mul_cancel hx, rpow_one]⟩ + +lemma rpow_left_bijective {x : ℝ} (hx : x ≠ 0) : function.bijective (λ y : ℝ≥0, y^x) := +⟨rpow_left_injective hx, rpow_left_surjective hx⟩ + +lemma eq_rpow_one_div_iff {x y : ℝ≥0} {z : ℝ} (hz : z ≠ 0) : x = y ^ (1 / z) ↔ x ^ z = y := +by rw [← rpow_eq_rpow_iff hz, rpow_self_rpow_inv hz] + +lemma rpow_one_div_eq_iff {x y : ℝ≥0} {z : ℝ} (hz : z ≠ 0) : x ^ (1 / z) = y ↔ x = y ^ z := +by rw [← rpow_eq_rpow_iff hz, rpow_self_rpow_inv hz] + +lemma pow_nat_rpow_nat_inv (x : ℝ≥0) {n : ℕ} (hn : n ≠ 0) : + (x ^ n) ^ (n⁻¹ : ℝ) = x := +by { rw [← nnreal.coe_eq, coe_rpow, nnreal.coe_pow], exact real.pow_nat_rpow_nat_inv x.2 hn } + +lemma rpow_nat_inv_pow_nat (x : ℝ≥0) {n : ℕ} (hn : n ≠ 0) : + (x ^ (n⁻¹ : ℝ)) ^ n = x := +by { rw [← nnreal.coe_eq, nnreal.coe_pow, coe_rpow], exact real.rpow_nat_inv_pow_nat x.2 hn } + +lemma _root_.real.to_nnreal_rpow_of_nonneg {x y : ℝ} (hx : 0 ≤ x) : + real.to_nnreal (x ^ y) = (real.to_nnreal x) ^ y := +begin + nth_rewrite 0 ← real.coe_to_nnreal x hx, + rw [←nnreal.coe_rpow, real.to_nnreal_coe], +end + +end nnreal + +namespace ennreal + +/-- The real power function `x^y` on extended nonnegative reals, defined for `x : ℝ≥0∞` and +`y : ℝ` as the restriction of the real power function if `0 < x < ⊤`, and with the natural values +for `0` and `⊤` (i.e., `0 ^ x = 0` for `x > 0`, `1` for `x = 0` and `⊤` for `x < 0`, and +`⊤ ^ x = 1 / 0 ^ x`). -/ +noncomputable def rpow : ℝ≥0∞ → ℝ → ℝ≥0∞ +| (some x) y := if x = 0 ∧ y < 0 then ⊤ else (x ^ y : ℝ≥0) +| none y := if 0 < y then ⊤ else if y = 0 then 1 else 0 + +noncomputable instance : has_pow ℝ≥0∞ ℝ := ⟨rpow⟩ + +@[simp] lemma rpow_eq_pow (x : ℝ≥0∞) (y : ℝ) : rpow x y = x ^ y := rfl + +@[simp] lemma rpow_zero {x : ℝ≥0∞} : x ^ (0 : ℝ) = 1 := +by cases x; { dsimp only [(^), rpow], simp [lt_irrefl] } + +lemma top_rpow_def (y : ℝ) : (⊤ : ℝ≥0∞) ^ y = if 0 < y then ⊤ else if y = 0 then 1 else 0 := +rfl + +@[simp] lemma top_rpow_of_pos {y : ℝ} (h : 0 < y) : (⊤ : ℝ≥0∞) ^ y = ⊤ := +by simp [top_rpow_def, h] + +@[simp] lemma top_rpow_of_neg {y : ℝ} (h : y < 0) : (⊤ : ℝ≥0∞) ^ y = 0 := +by simp [top_rpow_def, asymm h, ne_of_lt h] + +@[simp] lemma zero_rpow_of_pos {y : ℝ} (h : 0 < y) : (0 : ℝ≥0∞) ^ y = 0 := +begin + rw [← ennreal.coe_zero, ← ennreal.some_eq_coe], + dsimp only [(^), rpow], + simp [h, asymm h, ne_of_gt h], +end + +@[simp] lemma zero_rpow_of_neg {y : ℝ} (h : y < 0) : (0 : ℝ≥0∞) ^ y = ⊤ := +begin + rw [← ennreal.coe_zero, ← ennreal.some_eq_coe], + dsimp only [(^), rpow], + simp [h, ne_of_gt h], +end + +lemma zero_rpow_def (y : ℝ) : (0 : ℝ≥0∞) ^ y = if 0 < y then 0 else if y = 0 then 1 else ⊤ := +begin + rcases lt_trichotomy 0 y with H|rfl|H, + { simp [H, ne_of_gt, zero_rpow_of_pos, lt_irrefl] }, + { simp [lt_irrefl] }, + { simp [H, asymm H, ne_of_lt, zero_rpow_of_neg] } +end + +@[simp] lemma zero_rpow_mul_self (y : ℝ) : (0 : ℝ≥0∞) ^ y * 0 ^ y = 0 ^ y := +by { rw zero_rpow_def, split_ifs, exacts [zero_mul _, one_mul _, top_mul_top] } + +@[norm_cast] lemma coe_rpow_of_ne_zero {x : ℝ≥0} (h : x ≠ 0) (y : ℝ) : + (x : ℝ≥0∞) ^ y = (x ^ y : ℝ≥0) := +begin + rw [← ennreal.some_eq_coe], + dsimp only [(^), rpow], + simp [h] +end + +@[norm_cast] lemma coe_rpow_of_nonneg (x : ℝ≥0) {y : ℝ} (h : 0 ≤ y) : + (x : ℝ≥0∞) ^ y = (x ^ y : ℝ≥0) := +begin + by_cases hx : x = 0, + { rcases le_iff_eq_or_lt.1 h with H|H, + { simp [hx, H.symm] }, + { simp [hx, zero_rpow_of_pos H, nnreal.zero_rpow (ne_of_gt H)] } }, + { exact coe_rpow_of_ne_zero hx _ } +end + +lemma coe_rpow_def (x : ℝ≥0) (y : ℝ) : + (x : ℝ≥0∞) ^ y = if x = 0 ∧ y < 0 then ⊤ else (x ^ y : ℝ≥0) := rfl + +@[simp] lemma rpow_one (x : ℝ≥0∞) : x ^ (1 : ℝ) = x := +begin + cases x, + { exact dif_pos zero_lt_one }, + { change ite _ _ _ = _, + simp only [nnreal.rpow_one, some_eq_coe, ite_eq_right_iff, top_ne_coe, and_imp], + exact λ _, zero_le_one.not_lt } +end + +@[simp] lemma one_rpow (x : ℝ) : (1 : ℝ≥0∞) ^ x = 1 := +by { rw [← coe_one, coe_rpow_of_ne_zero one_ne_zero], simp } + +@[simp] lemma rpow_eq_zero_iff {x : ℝ≥0∞} {y : ℝ} : + x ^ y = 0 ↔ (x = 0 ∧ 0 < y) ∨ (x = ⊤ ∧ y < 0) := +begin + cases x, + { rcases lt_trichotomy y 0 with H|H|H; + simp [H, top_rpow_of_neg, top_rpow_of_pos, le_of_lt] }, + { by_cases h : x = 0, + { rcases lt_trichotomy y 0 with H|H|H; + simp [h, H, zero_rpow_of_neg, zero_rpow_of_pos, le_of_lt] }, + { simp [coe_rpow_of_ne_zero h, h] } } +end + +@[simp] lemma rpow_eq_top_iff {x : ℝ≥0∞} {y : ℝ} : + x ^ y = ⊤ ↔ (x = 0 ∧ y < 0) ∨ (x = ⊤ ∧ 0 < y) := +begin + cases x, + { rcases lt_trichotomy y 0 with H|H|H; + simp [H, top_rpow_of_neg, top_rpow_of_pos, le_of_lt] }, + { by_cases h : x = 0, + { rcases lt_trichotomy y 0 with H|H|H; + simp [h, H, zero_rpow_of_neg, zero_rpow_of_pos, le_of_lt] }, + { simp [coe_rpow_of_ne_zero h, h] } } +end + +lemma rpow_eq_top_iff_of_pos {x : ℝ≥0∞} {y : ℝ} (hy : 0 < y) : x ^ y = ⊤ ↔ x = ⊤ := +by simp [rpow_eq_top_iff, hy, asymm hy] + +lemma rpow_eq_top_of_nonneg (x : ℝ≥0∞) {y : ℝ} (hy0 : 0 ≤ y) : x ^ y = ⊤ → x = ⊤ := +begin + rw ennreal.rpow_eq_top_iff, + intro h, + cases h, + { exfalso, rw lt_iff_not_ge at h, exact h.right hy0, }, + { exact h.left, }, +end + +lemma rpow_ne_top_of_nonneg {x : ℝ≥0∞} {y : ℝ} (hy0 : 0 ≤ y) (h : x ≠ ⊤) : x ^ y ≠ ⊤ := +mt (ennreal.rpow_eq_top_of_nonneg x hy0) h + +lemma rpow_lt_top_of_nonneg {x : ℝ≥0∞} {y : ℝ} (hy0 : 0 ≤ y) (h : x ≠ ⊤) : x ^ y < ⊤ := +lt_top_iff_ne_top.mpr (ennreal.rpow_ne_top_of_nonneg hy0 h) + +lemma rpow_add {x : ℝ≥0∞} (y z : ℝ) (hx : x ≠ 0) (h'x : x ≠ ⊤) : x ^ (y + z) = x ^ y * x ^ z := +begin + cases x, { exact (h'x rfl).elim }, + have : x ≠ 0 := λ h, by simpa [h] using hx, + simp [coe_rpow_of_ne_zero this, nnreal.rpow_add this] +end + +lemma rpow_neg (x : ℝ≥0∞) (y : ℝ) : x ^ -y = (x ^ y)⁻¹ := +begin + cases x, + { rcases lt_trichotomy y 0 with H|H|H; + simp [top_rpow_of_pos, top_rpow_of_neg, H, neg_pos.mpr] }, + { by_cases h : x = 0, + { rcases lt_trichotomy y 0 with H|H|H; + simp [h, zero_rpow_of_pos, zero_rpow_of_neg, H, neg_pos.mpr] }, + { have A : x ^ y ≠ 0, by simp [h], + simp [coe_rpow_of_ne_zero h, ← coe_inv A, nnreal.rpow_neg] } } +end + +lemma rpow_sub {x : ℝ≥0∞} (y z : ℝ) (hx : x ≠ 0) (h'x : x ≠ ⊤) : x ^ (y - z) = x ^ y / x ^ z := +by rw [sub_eq_add_neg, rpow_add _ _ hx h'x, rpow_neg, div_eq_mul_inv] + +lemma rpow_neg_one (x : ℝ≥0∞) : x ^ (-1 : ℝ) = x ⁻¹ := +by simp [rpow_neg] + +lemma rpow_mul (x : ℝ≥0∞) (y z : ℝ) : x ^ (y * z) = (x ^ y) ^ z := +begin + cases x, + { rcases lt_trichotomy y 0 with Hy|Hy|Hy; + rcases lt_trichotomy z 0 with Hz|Hz|Hz; + simp [Hy, Hz, zero_rpow_of_neg, zero_rpow_of_pos, top_rpow_of_neg, top_rpow_of_pos, + mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, mul_neg_of_pos_of_neg] }, + { by_cases h : x = 0, + { rcases lt_trichotomy y 0 with Hy|Hy|Hy; + rcases lt_trichotomy z 0 with Hz|Hz|Hz; + simp [h, Hy, Hz, zero_rpow_of_neg, zero_rpow_of_pos, top_rpow_of_neg, top_rpow_of_pos, + mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, mul_neg_of_pos_of_neg] }, + { have : x ^ y ≠ 0, by simp [h], + simp [coe_rpow_of_ne_zero h, coe_rpow_of_ne_zero this, nnreal.rpow_mul] } } +end + +@[simp, norm_cast] lemma rpow_nat_cast (x : ℝ≥0∞) (n : ℕ) : x ^ (n : ℝ) = x ^ n := +begin + cases x, + { cases n; + simp [top_rpow_of_pos (nat.cast_add_one_pos _), top_pow (nat.succ_pos _)] }, + { simp [coe_rpow_of_nonneg _ (nat.cast_nonneg n)] } +end + +@[simp] lemma rpow_two (x : ℝ≥0∞) : x ^ (2 : ℝ) = x ^ 2 := +by { rw ← rpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } + +lemma mul_rpow_eq_ite (x y : ℝ≥0∞) (z : ℝ) : + (x * y) ^ z = if (x = 0 ∧ y = ⊤ ∨ x = ⊤ ∧ y = 0) ∧ z < 0 then ⊤ else x ^ z * y ^ z := +begin + rcases eq_or_ne z 0 with rfl|hz, { simp }, + replace hz := hz.lt_or_lt, + wlog hxy : x ≤ y, + { convert this y x z hz (le_of_not_le hxy) using 2; simp only [mul_comm, and_comm, or_comm], }, + rcases eq_or_ne x 0 with rfl|hx0, + { induction y using with_top.rec_top_coe; cases hz with hz hz; simp [*, hz.not_lt] }, + rcases eq_or_ne y 0 with rfl|hy0, { exact (hx0 (bot_unique hxy)).elim }, + induction x using with_top.rec_top_coe, { cases hz with hz hz; simp [hz, top_unique hxy] }, + induction y using with_top.rec_top_coe, { cases hz with hz hz; simp * }, + simp only [*, false_and, and_false, false_or, if_false], + norm_cast at *, + rw [coe_rpow_of_ne_zero (mul_ne_zero hx0 hy0), nnreal.mul_rpow] +end + +lemma mul_rpow_of_ne_top {x y : ℝ≥0∞} (hx : x ≠ ⊤) (hy : y ≠ ⊤) (z : ℝ) : + (x * y) ^ z = x^z * y^z := +by simp [*, mul_rpow_eq_ite] + +@[norm_cast] lemma coe_mul_rpow (x y : ℝ≥0) (z : ℝ) : + ((x : ℝ≥0∞) * y) ^ z = x^z * y^z := +mul_rpow_of_ne_top coe_ne_top coe_ne_top z + +lemma mul_rpow_of_ne_zero {x y : ℝ≥0∞} (hx : x ≠ 0) (hy : y ≠ 0) (z : ℝ) : + (x * y) ^ z = x ^ z * y ^ z := +by simp [*, mul_rpow_eq_ite] + +lemma mul_rpow_of_nonneg (x y : ℝ≥0∞) {z : ℝ} (hz : 0 ≤ z) : + (x * y) ^ z = x ^ z * y ^ z := +by simp [hz.not_lt, mul_rpow_eq_ite] + +lemma inv_rpow (x : ℝ≥0∞) (y : ℝ) : (x⁻¹) ^ y = (x ^ y)⁻¹ := +begin + rcases eq_or_ne y 0 with rfl|hy, { simp only [rpow_zero, inv_one] }, + replace hy := hy.lt_or_lt, + rcases eq_or_ne x 0 with rfl|h0, { cases hy; simp * }, + rcases eq_or_ne x ⊤ with rfl|h_top, { cases hy; simp * }, + apply ennreal.eq_inv_of_mul_eq_one_left, + rw [← mul_rpow_of_ne_zero (ennreal.inv_ne_zero.2 h_top) h0, ennreal.inv_mul_cancel h0 h_top, + one_rpow] +end + +lemma div_rpow_of_nonneg (x y : ℝ≥0∞) {z : ℝ} (hz : 0 ≤ z) : + (x / y) ^ z = x ^ z / y ^ z := +by rw [div_eq_mul_inv, mul_rpow_of_nonneg _ _ hz, inv_rpow, div_eq_mul_inv] + +lemma strict_mono_rpow_of_pos {z : ℝ} (h : 0 < z) : strict_mono (λ x : ℝ≥0∞, x ^ z) := +begin + intros x y hxy, + lift x to ℝ≥0 using ne_top_of_lt hxy, + rcases eq_or_ne y ∞ with rfl|hy, + { simp only [top_rpow_of_pos h, coe_rpow_of_nonneg _ h.le, coe_lt_top] }, + { lift y to ℝ≥0 using hy, + simp only [coe_rpow_of_nonneg _ h.le, nnreal.rpow_lt_rpow (coe_lt_coe.1 hxy) h, coe_lt_coe] } +end + +lemma monotone_rpow_of_nonneg {z : ℝ} (h : 0 ≤ z) : monotone (λ x : ℝ≥0∞, x ^ z) := +h.eq_or_lt.elim (λ h0, h0 ▸ by simp only [rpow_zero, monotone_const]) + (λ h0, (strict_mono_rpow_of_pos h0).monotone) + +/-- Bundles `λ x : ℝ≥0∞, x ^ y` into an order isomorphism when `y : ℝ` is positive, +where the inverse is `λ x : ℝ≥0∞, x ^ (1 / y)`. -/ +@[simps apply] def order_iso_rpow (y : ℝ) (hy : 0 < y) : ℝ≥0∞ ≃o ℝ≥0∞ := +(strict_mono_rpow_of_pos hy).order_iso_of_right_inverse (λ x, x ^ y) (λ x, x ^ (1 / y)) + (λ x, by { dsimp, rw [←rpow_mul, one_div_mul_cancel hy.ne.symm, rpow_one] }) + +lemma order_iso_rpow_symm_apply (y : ℝ) (hy : 0 < y) : + (order_iso_rpow y hy).symm = order_iso_rpow (1 / y) (one_div_pos.2 hy) := +by { simp only [order_iso_rpow, one_div_one_div], refl } + +lemma rpow_le_rpow {x y : ℝ≥0∞} {z : ℝ} (h₁ : x ≤ y) (h₂ : 0 ≤ z) : x^z ≤ y^z := +monotone_rpow_of_nonneg h₂ h₁ + +lemma rpow_lt_rpow {x y : ℝ≥0∞} {z : ℝ} (h₁ : x < y) (h₂ : 0 < z) : x^z < y^z := +strict_mono_rpow_of_pos h₂ h₁ + +lemma rpow_le_rpow_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ^ z ≤ y ^ z ↔ x ≤ y := +(strict_mono_rpow_of_pos hz).le_iff_le + +lemma rpow_lt_rpow_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ^ z < y ^ z ↔ x < y := +(strict_mono_rpow_of_pos hz).lt_iff_lt + +lemma le_rpow_one_div_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ≤ y ^ (1 / z) ↔ x ^ z ≤ y := +begin + nth_rewrite 0 ←rpow_one x, + nth_rewrite 0 ←@_root_.mul_inv_cancel _ _ z hz.ne', + rw [rpow_mul, ←one_div, @rpow_le_rpow_iff _ _ (1/z) (by simp [hz])], +end + +lemma lt_rpow_one_div_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x < y ^ (1 / z) ↔ x ^ z < y := +begin + nth_rewrite 0 ←rpow_one x, + nth_rewrite 0 ←@_root_.mul_inv_cancel _ _ z (ne_of_lt hz).symm, + rw [rpow_mul, ←one_div, @rpow_lt_rpow_iff _ _ (1/z) (by simp [hz])], +end + +lemma rpow_one_div_le_iff {x y : ℝ≥0∞} {z : ℝ} (hz : 0 < z) : x ^ (1 / z) ≤ y ↔ x ≤ y ^ z := +begin + nth_rewrite 0 ← ennreal.rpow_one y, + nth_rewrite 1 ← @_root_.mul_inv_cancel _ _ z hz.ne.symm, + rw [ennreal.rpow_mul, ← one_div, ennreal.rpow_le_rpow_iff (one_div_pos.2 hz)], +end + +lemma rpow_lt_rpow_of_exponent_lt {x : ℝ≥0∞} {y z : ℝ} (hx : 1 < x) (hx' : x ≠ ⊤) (hyz : y < z) : + x^y < x^z := +begin + lift x to ℝ≥0 using hx', + rw [one_lt_coe_iff] at hx, + simp [coe_rpow_of_ne_zero (ne_of_gt (lt_trans zero_lt_one hx)), + nnreal.rpow_lt_rpow_of_exponent_lt hx hyz] +end + +lemma rpow_le_rpow_of_exponent_le {x : ℝ≥0∞} {y z : ℝ} (hx : 1 ≤ x) (hyz : y ≤ z) : x^y ≤ x^z := +begin + cases x, + { rcases lt_trichotomy y 0 with Hy|Hy|Hy; + rcases lt_trichotomy z 0 with Hz|Hz|Hz; + simp [Hy, Hz, top_rpow_of_neg, top_rpow_of_pos, le_refl]; + linarith }, + { simp only [one_le_coe_iff, some_eq_coe] at hx, + simp [coe_rpow_of_ne_zero (ne_of_gt (lt_of_lt_of_le zero_lt_one hx)), + nnreal.rpow_le_rpow_of_exponent_le hx hyz] } +end + +lemma rpow_lt_rpow_of_exponent_gt {x : ℝ≥0∞} {y z : ℝ} (hx0 : 0 < x) (hx1 : x < 1) (hyz : z < y) : + x^y < x^z := +begin + lift x to ℝ≥0 using ne_of_lt (lt_of_lt_of_le hx1 le_top), + simp only [coe_lt_one_iff, coe_pos] at hx0 hx1, + simp [coe_rpow_of_ne_zero (ne_of_gt hx0), nnreal.rpow_lt_rpow_of_exponent_gt hx0 hx1 hyz] +end + +lemma rpow_le_rpow_of_exponent_ge {x : ℝ≥0∞} {y z : ℝ} (hx1 : x ≤ 1) (hyz : z ≤ y) : + x^y ≤ x^z := +begin + lift x to ℝ≥0 using ne_of_lt (lt_of_le_of_lt hx1 coe_lt_top), + by_cases h : x = 0, + { rcases lt_trichotomy y 0 with Hy|Hy|Hy; + rcases lt_trichotomy z 0 with Hz|Hz|Hz; + simp [Hy, Hz, h, zero_rpow_of_neg, zero_rpow_of_pos, le_refl]; + linarith }, + { rw [coe_le_one_iff] at hx1, + simp [coe_rpow_of_ne_zero h, + nnreal.rpow_le_rpow_of_exponent_ge (bot_lt_iff_ne_bot.mpr h) hx1 hyz] } +end + +lemma rpow_le_self_of_le_one {x : ℝ≥0∞} {z : ℝ} (hx : x ≤ 1) (h_one_le : 1 ≤ z) : x ^ z ≤ x := +begin + nth_rewrite 1 ←ennreal.rpow_one x, + exact ennreal.rpow_le_rpow_of_exponent_ge hx h_one_le, +end + +lemma le_rpow_self_of_one_le {x : ℝ≥0∞} {z : ℝ} (hx : 1 ≤ x) (h_one_le : 1 ≤ z) : x ≤ x ^ z := +begin + nth_rewrite 0 ←ennreal.rpow_one x, + exact ennreal.rpow_le_rpow_of_exponent_le hx h_one_le, +end + +lemma rpow_pos_of_nonneg {p : ℝ} {x : ℝ≥0∞} (hx_pos : 0 < x) (hp_nonneg : 0 ≤ p) : 0 < x^p := +begin + by_cases hp_zero : p = 0, + { simp [hp_zero, zero_lt_one], }, + { rw ←ne.def at hp_zero, + have hp_pos := lt_of_le_of_ne hp_nonneg hp_zero.symm, + rw ←zero_rpow_of_pos hp_pos, exact rpow_lt_rpow hx_pos hp_pos, }, +end + +lemma rpow_pos {p : ℝ} {x : ℝ≥0∞} (hx_pos : 0 < x) (hx_ne_top : x ≠ ⊤) : 0 < x^p := +begin + cases lt_or_le 0 p with hp_pos hp_nonpos, + { exact rpow_pos_of_nonneg hx_pos (le_of_lt hp_pos), }, + { rw [←neg_neg p, rpow_neg, ennreal.inv_pos], + exact rpow_ne_top_of_nonneg (right.nonneg_neg_iff.mpr hp_nonpos) hx_ne_top, }, +end + +lemma rpow_lt_one {x : ℝ≥0∞} {z : ℝ} (hx : x < 1) (hz : 0 < z) : x^z < 1 := +begin + lift x to ℝ≥0 using ne_of_lt (lt_of_lt_of_le hx le_top), + simp only [coe_lt_one_iff] at hx, + simp [coe_rpow_of_nonneg _ (le_of_lt hz), nnreal.rpow_lt_one hx hz], +end + +lemma rpow_le_one {x : ℝ≥0∞} {z : ℝ} (hx : x ≤ 1) (hz : 0 ≤ z) : x^z ≤ 1 := +begin + lift x to ℝ≥0 using ne_of_lt (lt_of_le_of_lt hx coe_lt_top), + simp only [coe_le_one_iff] at hx, + simp [coe_rpow_of_nonneg _ hz, nnreal.rpow_le_one hx hz], +end + +lemma rpow_lt_one_of_one_lt_of_neg {x : ℝ≥0∞} {z : ℝ} (hx : 1 < x) (hz : z < 0) : x^z < 1 := +begin + cases x, + { simp [top_rpow_of_neg hz, zero_lt_one] }, + { simp only [some_eq_coe, one_lt_coe_iff] at hx, + simp [coe_rpow_of_ne_zero (ne_of_gt (lt_trans zero_lt_one hx)), + nnreal.rpow_lt_one_of_one_lt_of_neg hx hz] }, +end + +lemma rpow_le_one_of_one_le_of_neg {x : ℝ≥0∞} {z : ℝ} (hx : 1 ≤ x) (hz : z < 0) : x^z ≤ 1 := +begin + cases x, + { simp [top_rpow_of_neg hz, zero_lt_one] }, + { simp only [one_le_coe_iff, some_eq_coe] at hx, + simp [coe_rpow_of_ne_zero (ne_of_gt (lt_of_lt_of_le zero_lt_one hx)), + nnreal.rpow_le_one_of_one_le_of_nonpos hx (le_of_lt hz)] }, +end + +lemma one_lt_rpow {x : ℝ≥0∞} {z : ℝ} (hx : 1 < x) (hz : 0 < z) : 1 < x^z := +begin + cases x, + { simp [top_rpow_of_pos hz] }, + { simp only [some_eq_coe, one_lt_coe_iff] at hx, + simp [coe_rpow_of_nonneg _ (le_of_lt hz), nnreal.one_lt_rpow hx hz] } +end + +lemma one_le_rpow {x : ℝ≥0∞} {z : ℝ} (hx : 1 ≤ x) (hz : 0 < z) : 1 ≤ x^z := +begin + cases x, + { simp [top_rpow_of_pos hz] }, + { simp only [one_le_coe_iff, some_eq_coe] at hx, + simp [coe_rpow_of_nonneg _ (le_of_lt hz), nnreal.one_le_rpow hx (le_of_lt hz)] }, +end + +lemma one_lt_rpow_of_pos_of_lt_one_of_neg {x : ℝ≥0∞} {z : ℝ} (hx1 : 0 < x) (hx2 : x < 1) + (hz : z < 0) : 1 < x^z := +begin + lift x to ℝ≥0 using ne_of_lt (lt_of_lt_of_le hx2 le_top), + simp only [coe_lt_one_iff, coe_pos] at ⊢ hx1 hx2, + simp [coe_rpow_of_ne_zero (ne_of_gt hx1), nnreal.one_lt_rpow_of_pos_of_lt_one_of_neg hx1 hx2 hz], +end + +lemma one_le_rpow_of_pos_of_le_one_of_neg {x : ℝ≥0∞} {z : ℝ} (hx1 : 0 < x) (hx2 : x ≤ 1) + (hz : z < 0) : 1 ≤ x^z := +begin + lift x to ℝ≥0 using ne_of_lt (lt_of_le_of_lt hx2 coe_lt_top), + simp only [coe_le_one_iff, coe_pos] at ⊢ hx1 hx2, + simp [coe_rpow_of_ne_zero (ne_of_gt hx1), + nnreal.one_le_rpow_of_pos_of_le_one_of_nonpos hx1 hx2 (le_of_lt hz)], +end + +lemma to_nnreal_rpow (x : ℝ≥0∞) (z : ℝ) : (x.to_nnreal) ^ z = (x ^ z).to_nnreal := +begin + rcases lt_trichotomy z 0 with H|H|H, + { cases x, { simp [H, ne_of_lt] }, + by_cases hx : x = 0, + { simp [hx, H, ne_of_lt] }, + { simp [coe_rpow_of_ne_zero hx] } }, + { simp [H] }, + { cases x, { simp [H, ne_of_gt] }, + simp [coe_rpow_of_nonneg _ (le_of_lt H)] } +end + +lemma to_real_rpow (x : ℝ≥0∞) (z : ℝ) : (x.to_real) ^ z = (x ^ z).to_real := +by rw [ennreal.to_real, ennreal.to_real, ←nnreal.coe_rpow, ennreal.to_nnreal_rpow] + +lemma of_real_rpow_of_pos {x p : ℝ} (hx_pos : 0 < x) : + ennreal.of_real x ^ p = ennreal.of_real (x ^ p) := +begin + simp_rw ennreal.of_real, + rw [coe_rpow_of_ne_zero, coe_eq_coe, real.to_nnreal_rpow_of_nonneg hx_pos.le], + simp [hx_pos], +end + +lemma of_real_rpow_of_nonneg {x p : ℝ} (hx_nonneg : 0 ≤ x) (hp_nonneg : 0 ≤ p) : + ennreal.of_real x ^ p = ennreal.of_real (x ^ p) := +begin + by_cases hp0 : p = 0, + { simp [hp0], }, + by_cases hx0 : x = 0, + { rw ← ne.def at hp0, + have hp_pos : 0 < p := lt_of_le_of_ne hp_nonneg hp0.symm, + simp [hx0, hp_pos, hp_pos.ne.symm], }, + rw ← ne.def at hx0, + exact of_real_rpow_of_pos (hx_nonneg.lt_of_ne hx0.symm), +end + +lemma rpow_left_injective {x : ℝ} (hx : x ≠ 0) : + function.injective (λ y : ℝ≥0∞, y^x) := +begin + intros y z hyz, + dsimp only at hyz, + rw [←rpow_one y, ←rpow_one z, ←_root_.mul_inv_cancel hx, rpow_mul, rpow_mul, hyz], +end + +lemma rpow_left_surjective {x : ℝ} (hx : x ≠ 0) : + function.surjective (λ y : ℝ≥0∞, y^x) := +λ y, ⟨y ^ x⁻¹, by simp_rw [←rpow_mul, _root_.inv_mul_cancel hx, rpow_one]⟩ + +lemma rpow_left_bijective {x : ℝ} (hx : x ≠ 0) : + function.bijective (λ y : ℝ≥0∞, y^x) := +⟨rpow_left_injective hx, rpow_left_surjective hx⟩ + +end ennreal + +section tactics +/-! +## Tactic extensions for powers on `ℝ≥0` and `ℝ≥0∞` +-/ + +namespace norm_num + +theorem nnrpow_pos (a : ℝ≥0) (b : ℝ) (b' : ℕ) (c : ℝ≥0) + (hb : b = b') (h : a ^ b' = c) : a ^ b = c := +by rw [← h, hb, nnreal.rpow_nat_cast] + +theorem nnrpow_neg (a : ℝ≥0) (b : ℝ) (b' : ℕ) (c c' : ℝ≥0) + (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := +by rw [← hc, ← h, hb, nnreal.rpow_neg, nnreal.rpow_nat_cast] + +theorem ennrpow_pos (a : ℝ≥0∞) (b : ℝ) (b' : ℕ) (c : ℝ≥0∞) + (hb : b = b') (h : a ^ b' = c) : a ^ b = c := +by rw [← h, hb, ennreal.rpow_nat_cast] + +theorem ennrpow_neg (a : ℝ≥0∞) (b : ℝ) (b' : ℕ) (c c' : ℝ≥0∞) + (hb : b = b') (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := +by rw [← hc, ← h, hb, ennreal.rpow_neg, ennreal.rpow_nat_cast] + +/-- Evaluate `nnreal.rpow a b` where `a` is a rational numeral and `b` is an integer. -/ +meta def prove_nnrpow : expr → expr → tactic (expr × expr) := +prove_rpow' ``nnrpow_pos ``nnrpow_neg ``nnreal.rpow_zero `(ℝ≥0) `(ℝ) `(1:ℝ≥0) + +/-- Evaluate `ennreal.rpow a b` where `a` is a rational numeral and `b` is an integer. -/ +meta def prove_ennrpow : expr → expr → tactic (expr × expr) := +prove_rpow' ``ennrpow_pos ``ennrpow_neg ``ennreal.rpow_zero `(ℝ≥0∞) `(ℝ) `(1:ℝ≥0∞) + +/-- Evaluates expressions of the form `rpow a b` and `a ^ b` in the special case where +`b` is an integer and `a` is a positive rational (so it's really just a rational power). -/ +@[norm_num] meta def eval_nnrpow_ennrpow : expr → tactic (expr × expr) +| `(@has_pow.pow _ _ nnreal.real.has_pow %%a %%b) := b.to_int >> prove_nnrpow a b +| `(nnreal.rpow %%a %%b) := b.to_int >> prove_nnrpow a b +| `(@has_pow.pow _ _ ennreal.real.has_pow %%a %%b) := b.to_int >> prove_ennrpow a b +| `(ennreal.rpow %%a %%b) := b.to_int >> prove_ennrpow a b +| _ := tactic.failed + +end norm_num + +namespace tactic +namespace positivity + +private lemma nnrpow_pos {a : ℝ≥0} (ha : 0 < a) (b : ℝ) : 0 < a ^ b := nnreal.rpow_pos ha + +/-- Auxiliary definition for the `positivity` tactic to handle real powers of nonnegative reals. -/ +meta def prove_nnrpow (a b : expr) : tactic strictness := +do + strictness_a ← core a, + match strictness_a with + | positive p := positive <$> mk_app ``nnrpow_pos [p, b] + | _ := failed -- We already know `0 ≤ x` for all `x : ℝ≥0` + end + +private lemma ennrpow_pos {a : ℝ≥0∞} {b : ℝ} (ha : 0 < a) (hb : 0 < b) : 0 < a ^ b := +ennreal.rpow_pos_of_nonneg ha hb.le + +/-- Auxiliary definition for the `positivity` tactic to handle real powers of extended nonnegative +reals. -/ +meta def prove_ennrpow (a b : expr) : tactic strictness := +do + strictness_a ← core a, + strictness_b ← core b, + match strictness_a, strictness_b with + | positive pa, positive pb := positive <$> mk_app ``ennrpow_pos [pa, pb] + | positive pa, nonnegative pb := positive <$> mk_app ``ennreal.rpow_pos_of_nonneg [pa, pb] + | _, _ := failed -- We already know `0 ≤ x` for all `x : ℝ≥0∞` + end + +end positivity + +open positivity + +/-- Extension for the `positivity` tactic: exponentiation by a real number is nonnegative when the +base is nonnegative and positive when the base is positive. -/ +@[positivity] +meta def positivity_nnrpow_ennrpow : expr → tactic strictness +| `(@has_pow.pow _ _ nnreal.real.has_pow %%a %%b) := prove_nnrpow a b +| `(nnreal.rpow %%a %%b) := prove_nnrpow a b +| `(@has_pow.pow _ _ ennreal.real.has_pow %%a %%b) := prove_ennrpow a b +| `(ennreal.rpow %%a %%b) := prove_ennrpow a b +| _ := failed + +end tactic + +end tactics diff --git a/src/analysis/special_functions/pow/real.lean b/src/analysis/special_functions/pow/real.lean new file mode 100644 index 0000000000000..26582880834d2 --- /dev/null +++ b/src/analysis/special_functions/pow/real.lean @@ -0,0 +1,720 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, + Rémy Degenne, David Loeffler +-/ +import analysis.special_functions.pow.complex + +/-! # Power function on `ℝ` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct the power functions `x ^ y`, where `x` and `y` are real numbers. +-/ + +noncomputable theory + +open_locale classical real big_operators complex_conjugate +open finset set + +/- +## Definitions +-/ + +namespace real + +/-- The real power function `x ^ y`, defined as the real part of the complex power function. +For `x > 0`, it is equal to `exp (y log x)`. For `x = 0`, one sets `0 ^ 0=1` and `0 ^ y=0` for +`y ≠ 0`. For `x < 0`, the definition is somewhat arbitary as it depends on the choice of a complex +determination of the logarithm. With our conventions, it is equal to `exp (y log x) cos (π y)`. -/ +noncomputable def rpow (x y : ℝ) := ((x : ℂ) ^ (y : ℂ)).re + +noncomputable instance : has_pow ℝ ℝ := ⟨rpow⟩ + +@[simp] lemma rpow_eq_pow (x y : ℝ) : rpow x y = x ^ y := rfl + +lemma rpow_def (x y : ℝ) : x ^ y = ((x : ℂ) ^ (y : ℂ)).re := rfl + +lemma rpow_def_of_nonneg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : x ^ y = + if x = 0 + then if y = 0 + then 1 + else 0 + else exp (log x * y) := +by simp only [rpow_def, complex.cpow_def]; + split_ifs; + simp [*, (complex.of_real_log hx).symm, -complex.of_real_mul, -is_R_or_C.of_real_mul, + (complex.of_real_mul _ _).symm, complex.exp_of_real_re] at * + +lemma rpow_def_of_pos {x : ℝ} (hx : 0 < x) (y : ℝ) : x ^ y = exp (log x * y) := +by rw [rpow_def_of_nonneg (le_of_lt hx), if_neg (ne_of_gt hx)] + +lemma exp_mul (x y : ℝ) : exp (x * y) = (exp x) ^ y := +by rw [rpow_def_of_pos (exp_pos _), log_exp] + +@[simp] lemma exp_one_rpow (x : ℝ) : exp 1 ^ x = exp x := by rw [←exp_mul, one_mul] + +lemma rpow_eq_zero_iff_of_nonneg {x y : ℝ} (hx : 0 ≤ x) : x ^ y = 0 ↔ x = 0 ∧ y ≠ 0 := +by { simp only [rpow_def_of_nonneg hx], split_ifs; simp [*, exp_ne_zero] } + +open_locale real + +lemma rpow_def_of_neg {x : ℝ} (hx : x < 0) (y : ℝ) : x ^ y = exp (log x * y) * cos (y * π) := +begin + rw [rpow_def, complex.cpow_def, if_neg], + have : complex.log x * y = ↑(log(-x) * y) + ↑(y * π) * complex.I, + { simp only [complex.log, abs_of_neg hx, complex.arg_of_real_of_neg hx, + complex.abs_of_real, complex.of_real_mul], ring }, + { rw [this, complex.exp_add_mul_I, ← complex.of_real_exp, ← complex.of_real_cos, + ← complex.of_real_sin, mul_add, ← complex.of_real_mul, ← mul_assoc, ← complex.of_real_mul, + complex.add_re, complex.of_real_re, complex.mul_re, complex.I_re, complex.of_real_im, + real.log_neg_eq_log], + ring }, + { rw complex.of_real_eq_zero, exact ne_of_lt hx } +end + +lemma rpow_def_of_nonpos {x : ℝ} (hx : x ≤ 0) (y : ℝ) : x ^ y = + if x = 0 + then if y = 0 + then 1 + else 0 + else exp (log x * y) * cos (y * π) := +by split_ifs; simp [rpow_def, *]; exact rpow_def_of_neg (lt_of_le_of_ne hx h) _ + +lemma rpow_pos_of_pos {x : ℝ} (hx : 0 < x) (y : ℝ) : 0 < x ^ y := +by rw rpow_def_of_pos hx; apply exp_pos + +@[simp] lemma rpow_zero (x : ℝ) : x ^ (0 : ℝ) = 1 := by simp [rpow_def] + +@[simp] lemma zero_rpow {x : ℝ} (h : x ≠ 0) : (0 : ℝ) ^ x = 0 := +by simp [rpow_def, *] + +lemma zero_rpow_eq_iff {x : ℝ} {a : ℝ} : 0 ^ x = a ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := +begin + split, + { intros hyp, + simp only [rpow_def, complex.of_real_zero] at hyp, + by_cases x = 0, + { subst h, + simp only [complex.one_re, complex.of_real_zero, complex.cpow_zero] at hyp, + exact or.inr ⟨rfl, hyp.symm⟩}, + { rw complex.zero_cpow (complex.of_real_ne_zero.mpr h) at hyp, + exact or.inl ⟨h, hyp.symm⟩, }, }, + { rintro (⟨h,rfl⟩|⟨rfl,rfl⟩), + { exact zero_rpow h, }, + { exact rpow_zero _, }, }, +end + +lemma eq_zero_rpow_iff {x : ℝ} {a : ℝ} : a = 0 ^ x ↔ (x ≠ 0 ∧ a = 0) ∨ (x = 0 ∧ a = 1) := +by rw [←zero_rpow_eq_iff, eq_comm] + +@[simp] lemma rpow_one (x : ℝ) : x ^ (1 : ℝ) = x := by simp [rpow_def] + +@[simp] lemma one_rpow (x : ℝ) : (1 : ℝ) ^ x = 1 := by simp [rpow_def] + +lemma zero_rpow_le_one (x : ℝ) : (0 : ℝ) ^ x ≤ 1 := +by { by_cases h : x = 0; simp [h, zero_le_one] } + +lemma zero_rpow_nonneg (x : ℝ) : 0 ≤ (0 : ℝ) ^ x := +by { by_cases h : x = 0; simp [h, zero_le_one] } + +lemma rpow_nonneg_of_nonneg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : 0 ≤ x ^ y := +by rw [rpow_def_of_nonneg hx]; + split_ifs; simp only [zero_le_one, le_refl, le_of_lt (exp_pos _)] + +lemma abs_rpow_of_nonneg {x y : ℝ} (hx_nonneg : 0 ≤ x) : |x ^ y| = |x| ^ y := +begin + have h_rpow_nonneg : 0 ≤ x ^ y, from real.rpow_nonneg_of_nonneg hx_nonneg _, + rw [abs_eq_self.mpr hx_nonneg, abs_eq_self.mpr h_rpow_nonneg], +end + +lemma abs_rpow_le_abs_rpow (x y : ℝ) : |x ^ y| ≤ |x| ^ y := +begin + cases le_or_lt 0 x with hx hx, + { rw [abs_rpow_of_nonneg hx] }, + { rw [abs_of_neg hx, rpow_def_of_neg hx, rpow_def_of_pos (neg_pos.2 hx), log_neg_eq_log, + abs_mul, abs_of_pos (exp_pos _)], + exact mul_le_of_le_one_right (exp_pos _).le (abs_cos_le_one _) } +end + +lemma abs_rpow_le_exp_log_mul (x y : ℝ) : |x ^ y| ≤ exp (log x * y) := +begin + refine (abs_rpow_le_abs_rpow x y).trans _, + by_cases hx : x = 0, + { by_cases hy : y = 0; simp [hx, hy, zero_le_one] }, + { rw [rpow_def_of_pos (abs_pos.2 hx), log_abs] } +end + +lemma norm_rpow_of_nonneg {x y : ℝ} (hx_nonneg : 0 ≤ x) : ‖x ^ y‖ = ‖x‖ ^ y := +by { simp_rw real.norm_eq_abs, exact abs_rpow_of_nonneg hx_nonneg, } + + +variables {x y z : ℝ} + +lemma rpow_add (hx : 0 < x) (y z : ℝ) : x ^ (y + z) = x ^ y * x ^ z := +by simp only [rpow_def_of_pos hx, mul_add, exp_add] + +lemma rpow_add' (hx : 0 ≤ x) (h : y + z ≠ 0) : x ^ (y + z) = x ^ y * x ^ z := +begin + rcases hx.eq_or_lt with rfl|pos, + { rw [zero_rpow h, zero_eq_mul], + have : y ≠ 0 ∨ z ≠ 0, from not_and_distrib.1 (λ ⟨hy, hz⟩, h $ hy.symm ▸ hz.symm ▸ zero_add 0), + exact this.imp zero_rpow zero_rpow }, + { exact rpow_add pos _ _ } +end + +lemma rpow_add_of_nonneg (hx : 0 ≤ x) (hy : 0 ≤ y) (hz : 0 ≤ z) : + x ^ (y + z) = x ^ y * x ^ z := +begin + rcases hy.eq_or_lt with rfl|hy, + { rw [zero_add, rpow_zero, one_mul] }, + exact rpow_add' hx (ne_of_gt $ add_pos_of_pos_of_nonneg hy hz) +end + +/-- For `0 ≤ x`, the only problematic case in the equality `x ^ y * x ^ z = x ^ (y + z)` is for +`x = 0` and `y + z = 0`, where the right hand side is `1` while the left hand side can vanish. +The inequality is always true, though, and given in this lemma. -/ +lemma le_rpow_add {x : ℝ} (hx : 0 ≤ x) (y z : ℝ) : x ^ y * x ^ z ≤ x ^ (y + z) := +begin + rcases le_iff_eq_or_lt.1 hx with H|pos, + { by_cases h : y + z = 0, + { simp only [H.symm, h, rpow_zero], + calc (0 : ℝ) ^ y * 0 ^ z ≤ 1 * 1 : + mul_le_mul (zero_rpow_le_one y) (zero_rpow_le_one z) (zero_rpow_nonneg z) zero_le_one + ... = 1 : by simp }, + { simp [rpow_add', ← H, h] } }, + { simp [rpow_add pos] } +end + +lemma rpow_sum_of_pos {ι : Type*} {a : ℝ} (ha : 0 < a) (f : ι → ℝ) (s : finset ι) : + a ^ (∑ x in s, f x) = ∏ x in s, a ^ f x := +@add_monoid_hom.map_sum ℝ ι (additive ℝ) _ _ ⟨λ x : ℝ, (a ^ x : ℝ), rpow_zero a, rpow_add ha⟩ f s + +lemma rpow_sum_of_nonneg {ι : Type*} {a : ℝ} (ha : 0 ≤ a) {s : finset ι} {f : ι → ℝ} + (h : ∀ x ∈ s, 0 ≤ f x) : + a ^ (∑ x in s, f x) = ∏ x in s, a ^ f x := +begin + induction s using finset.cons_induction with i s hi ihs, + { rw [sum_empty, finset.prod_empty, rpow_zero] }, + { rw forall_mem_cons at h, + rw [sum_cons, prod_cons, ← ihs h.2, rpow_add_of_nonneg ha h.1 (sum_nonneg h.2)] } +end + +lemma rpow_neg {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : x ^ -y = (x ^ y)⁻¹ := +by simp only [rpow_def_of_nonneg hx]; split_ifs; simp [*, exp_neg] at * + +lemma rpow_sub {x : ℝ} (hx : 0 < x) (y z : ℝ) : x ^ (y - z) = x ^ y / x ^ z := +by simp only [sub_eq_add_neg, rpow_add hx, rpow_neg (le_of_lt hx), div_eq_mul_inv] + +lemma rpow_sub' {x : ℝ} (hx : 0 ≤ x) {y z : ℝ} (h : y - z ≠ 0) : + x ^ (y - z) = x ^ y / x ^ z := +by { simp only [sub_eq_add_neg] at h ⊢, simp only [rpow_add' hx h, rpow_neg hx, div_eq_mul_inv] } + +end real + +/-! +## Comparing real and complex powers +-/ + +namespace complex + +lemma of_real_cpow {x : ℝ} (hx : 0 ≤ x) (y : ℝ) : ((x ^ y : ℝ) : ℂ) = (x : ℂ) ^ (y : ℂ) := +by simp only [real.rpow_def_of_nonneg hx, complex.cpow_def, of_real_eq_zero]; split_ifs; + simp [complex.of_real_log hx] + +lemma of_real_cpow_of_nonpos {x : ℝ} (hx : x ≤ 0) (y : ℂ) : + (x : ℂ) ^ y = ((-x) : ℂ) ^ y * exp (π * I * y) := +begin + rcases hx.eq_or_lt with rfl|hlt, + { rcases eq_or_ne y 0 with rfl|hy; simp * }, + have hne : (x : ℂ) ≠ 0, from of_real_ne_zero.mpr hlt.ne, + rw [cpow_def_of_ne_zero hne, cpow_def_of_ne_zero (neg_ne_zero.2 hne), ← exp_add, ← add_mul, + log, log, abs.map_neg, arg_of_real_of_neg hlt, ← of_real_neg, + arg_of_real_of_nonneg (neg_nonneg.2 hx), of_real_zero, zero_mul, add_zero] +end + +lemma abs_cpow_of_ne_zero {z : ℂ} (hz : z ≠ 0) (w : ℂ) : + abs (z ^ w) = abs z ^ w.re / real.exp (arg z * im w) := +by rw [cpow_def_of_ne_zero hz, abs_exp, mul_re, log_re, log_im, real.exp_sub, + real.rpow_def_of_pos (abs.pos hz)] + +lemma abs_cpow_of_imp {z w : ℂ} (h : z = 0 → w.re = 0 → w = 0) : + abs (z ^ w) = abs z ^ w.re / real.exp (arg z * im w) := +begin + rcases ne_or_eq z 0 with hz|rfl; [exact (abs_cpow_of_ne_zero hz w), rw map_zero], + cases eq_or_ne w.re 0 with hw hw, + { simp [hw, h rfl hw] }, + { rw [real.zero_rpow hw, zero_div, zero_cpow, map_zero], + exact ne_of_apply_ne re hw } +end + +lemma abs_cpow_le (z w : ℂ) : abs (z ^ w) ≤ abs z ^ w.re / real.exp (arg z * im w) := +begin + rcases ne_or_eq z 0 with hz|rfl; [exact (abs_cpow_of_ne_zero hz w).le, rw map_zero], + rcases eq_or_ne w 0 with rfl|hw, { simp }, + rw [zero_cpow hw, map_zero], + exact div_nonneg (real.rpow_nonneg_of_nonneg le_rfl _) (real.exp_pos _).le +end + +@[simp] lemma abs_cpow_real (x : ℂ) (y : ℝ) : abs (x ^ (y : ℂ)) = x.abs ^ y := +by rcases eq_or_ne x 0 with rfl|hx; [rcases eq_or_ne y 0 with rfl|hy, skip]; + simp [*, abs_cpow_of_ne_zero] + +@[simp] lemma abs_cpow_inv_nat (x : ℂ) (n : ℕ) : abs (x ^ (n⁻¹ : ℂ)) = x.abs ^ (n⁻¹ : ℝ) := +by rw ← abs_cpow_real; simp [-abs_cpow_real] + +lemma abs_cpow_eq_rpow_re_of_pos {x : ℝ} (hx : 0 < x) (y : ℂ) : abs (x ^ y) = x ^ y.re := +by rw [abs_cpow_of_ne_zero (of_real_ne_zero.mpr hx.ne'), arg_of_real_of_nonneg hx.le, zero_mul, + real.exp_zero, div_one, abs_of_nonneg hx.le] + +lemma abs_cpow_eq_rpow_re_of_nonneg {x : ℝ} (hx : 0 ≤ x) {y : ℂ} (hy : re y ≠ 0) : + abs (x ^ y) = x ^ re y := +begin + rcases hx.eq_or_lt with rfl|hlt, + { rw [of_real_zero, zero_cpow, map_zero, real.zero_rpow hy], + exact ne_of_apply_ne re hy }, + { exact abs_cpow_eq_rpow_re_of_pos hlt y } +end + +end complex + +/-! +## Further algebraic properties of `rpow` +-/ + +namespace real + +variables {x y z : ℝ} + +lemma rpow_mul {x : ℝ} (hx : 0 ≤ x) (y z : ℝ) : x ^ (y * z) = (x ^ y) ^ z := +by rw [← complex.of_real_inj, complex.of_real_cpow (rpow_nonneg_of_nonneg hx _), + complex.of_real_cpow hx, complex.of_real_mul, complex.cpow_mul, complex.of_real_cpow hx]; + simp only [(complex.of_real_mul _ _).symm, (complex.of_real_log hx).symm, + complex.of_real_im, neg_lt_zero, pi_pos, le_of_lt pi_pos] + +lemma rpow_add_int {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℤ) : x ^ (y + n) = x ^ y * x ^ n := +by rw [rpow_def, complex.of_real_add, complex.cpow_add _ _ (complex.of_real_ne_zero.mpr hx), + complex.of_real_int_cast, complex.cpow_int_cast, ← complex.of_real_zpow, mul_comm, + complex.of_real_mul_re, ← rpow_def, mul_comm] + +lemma rpow_add_nat {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℕ) : x ^ (y + n) = x ^ y * x ^ n := +by simpa using rpow_add_int hx y n + +lemma rpow_sub_int {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℤ) : x ^ (y - n) = x ^ y / x ^ n := +by simpa using rpow_add_int hx y (-n) + +lemma rpow_sub_nat {x : ℝ} (hx : x ≠ 0) (y : ℝ) (n : ℕ) : x ^ (y - n) = x ^ y / x ^ n := +by simpa using rpow_sub_int hx y n + +lemma rpow_add_one {x : ℝ} (hx : x ≠ 0) (y : ℝ) : x ^ (y + 1) = x ^ y * x := +by simpa using rpow_add_nat hx y 1 + +lemma rpow_sub_one {x : ℝ} (hx : x ≠ 0) (y : ℝ) : x ^ (y - 1) = x ^ y / x := +by simpa using rpow_sub_nat hx y 1 + +@[simp, norm_cast] lemma rpow_int_cast (x : ℝ) (n : ℤ) : x ^ (n : ℝ) = x ^ n := +by simp only [rpow_def, ← complex.of_real_zpow, complex.cpow_int_cast, + complex.of_real_int_cast, complex.of_real_re] + +@[simp, norm_cast] lemma rpow_nat_cast (x : ℝ) (n : ℕ) : x ^ (n : ℝ) = x ^ n := +by simpa using rpow_int_cast x n + +@[simp] lemma rpow_two (x : ℝ) : x ^ (2 : ℝ) = x ^ 2 := +by { rw ← rpow_nat_cast, simp only [nat.cast_bit0, nat.cast_one] } + +lemma rpow_neg_one (x : ℝ) : x ^ (-1 : ℝ) = x⁻¹ := +begin + suffices H : x ^ ((-1 : ℤ) : ℝ) = x⁻¹, by rwa [int.cast_neg, int.cast_one] at H, + simp only [rpow_int_cast, zpow_one, zpow_neg], +end + +lemma mul_rpow {x y z : ℝ} (h : 0 ≤ x) (h₁ : 0 ≤ y) : (x*y)^z = x^z * y^z := +begin + iterate 3 { rw real.rpow_def_of_nonneg }, split_ifs; simp * at *, + { have hx : 0 < x, + { cases lt_or_eq_of_le h with h₂ h₂, { exact h₂ }, + exfalso, apply h_2, exact eq.symm h₂ }, + have hy : 0 < y, + { cases lt_or_eq_of_le h₁ with h₂ h₂, { exact h₂ }, + exfalso, apply h_3, exact eq.symm h₂ }, + rw [log_mul (ne_of_gt hx) (ne_of_gt hy), add_mul, exp_add]}, + { exact h₁ }, + { exact h }, + { exact mul_nonneg h h₁ }, +end + +lemma inv_rpow (hx : 0 ≤ x) (y : ℝ) : (x⁻¹)^y = (x^y)⁻¹ := +by simp only [← rpow_neg_one, ← rpow_mul hx, mul_comm] + +lemma div_rpow (hx : 0 ≤ x) (hy : 0 ≤ y) (z : ℝ) : (x / y) ^ z = x^z / y^z := +by simp only [div_eq_mul_inv, mul_rpow hx (inv_nonneg.2 hy), inv_rpow hy] + +lemma log_rpow {x : ℝ} (hx : 0 < x) (y : ℝ) : log (x^y) = y * (log x) := +begin + apply exp_injective, + rw [exp_log (rpow_pos_of_pos hx y), ← exp_log hx, mul_comm, rpow_def_of_pos (exp_pos (log x)) y], +end + +/-! +## Order and monotonicity +-/ + +lemma rpow_lt_rpow (hx : 0 ≤ x) (hxy : x < y) (hz : 0 < z) : x^z < y^z := +begin + rw le_iff_eq_or_lt at hx, cases hx, + { rw [← hx, zero_rpow (ne_of_gt hz)], exact rpow_pos_of_pos (by rwa ← hx at hxy) _ }, + rw [rpow_def_of_pos hx, rpow_def_of_pos (lt_trans hx hxy), exp_lt_exp], + exact mul_lt_mul_of_pos_right (log_lt_log hx hxy) hz +end + +lemma rpow_le_rpow {x y z: ℝ} (h : 0 ≤ x) (h₁ : x ≤ y) (h₂ : 0 ≤ z) : x^z ≤ y^z := +begin + rcases eq_or_lt_of_le h₁ with rfl|h₁', { refl }, + rcases eq_or_lt_of_le h₂ with rfl|h₂', { simp }, + exact le_of_lt (rpow_lt_rpow h h₁' h₂') +end + +lemma rpow_lt_rpow_iff (hx : 0 ≤ x) (hy : 0 ≤ y) (hz : 0 < z) : x ^ z < y ^ z ↔ x < y := +⟨lt_imp_lt_of_le_imp_le $ λ h, rpow_le_rpow hy h (le_of_lt hz), λ h, rpow_lt_rpow hx h hz⟩ + +lemma rpow_le_rpow_iff (hx : 0 ≤ x) (hy : 0 ≤ y) (hz : 0 < z) : x ^ z ≤ y ^ z ↔ x ≤ y := +le_iff_le_iff_lt_iff_lt.2 $ rpow_lt_rpow_iff hy hx hz + +lemma le_rpow_inv_iff_of_neg (hx : 0 < x) (hy : 0 < y) (hz : z < 0) : + x ≤ y ^ z⁻¹ ↔ y ≤ x ^ z := +begin + have hz' : 0 < -z := by rwa [lt_neg, neg_zero], + have hxz : 0 < x ^ (-z) := real.rpow_pos_of_pos hx _, + have hyz : 0 < y ^ z⁻¹ := real.rpow_pos_of_pos hy _, + rw [←real.rpow_le_rpow_iff hx.le hyz.le hz', ←real.rpow_mul hy.le], + simp only [ne_of_lt hz, real.rpow_neg_one, mul_neg, inv_mul_cancel, ne.def, not_false_iff], + rw [le_inv hxz hy, ←real.rpow_neg_one, ←real.rpow_mul hx.le], + simp, +end + +lemma lt_rpow_inv_iff_of_neg (hx : 0 < x) (hy : 0 < y) (hz : z < 0) : + x < y ^ z⁻¹ ↔ y < x ^ z := +begin + have hz' : 0 < -z := by rwa [lt_neg, neg_zero], + have hxz : 0 < x ^ (-z) := real.rpow_pos_of_pos hx _, + have hyz : 0 < y ^ z⁻¹ := real.rpow_pos_of_pos hy _, + rw [←real.rpow_lt_rpow_iff hx.le hyz.le hz', ←real.rpow_mul hy.le], + simp only [ne_of_lt hz, real.rpow_neg_one, mul_neg, inv_mul_cancel, ne.def, not_false_iff], + rw [lt_inv hxz hy, ←real.rpow_neg_one, ←real.rpow_mul hx.le], + simp, +end + +lemma rpow_inv_lt_iff_of_neg (hx : 0 < x) (hy : 0 < y) (hz : z < 0) : + x ^ z⁻¹ < y ↔ y ^ z < x := +begin + convert lt_rpow_inv_iff_of_neg (real.rpow_pos_of_pos hx _) (real.rpow_pos_of_pos hy _) hz; + simp [←real.rpow_mul hx.le, ←real.rpow_mul hy.le, ne_of_lt hz], +end + +lemma rpow_inv_le_iff_of_neg (hx : 0 < x) (hy : 0 < y) (hz : z < 0) : + x ^ z⁻¹ ≤ y ↔ y ^ z ≤ x := +begin + convert le_rpow_inv_iff_of_neg (real.rpow_pos_of_pos hx _) (real.rpow_pos_of_pos hy _) hz; + simp [←real.rpow_mul hx.le, ←real.rpow_mul hy.le, ne_of_lt hz], +end + +lemma rpow_lt_rpow_of_exponent_lt (hx : 1 < x) (hyz : y < z) : x^y < x^z := +begin + repeat {rw [rpow_def_of_pos (lt_trans zero_lt_one hx)]}, + rw exp_lt_exp, exact mul_lt_mul_of_pos_left hyz (log_pos hx), +end + +lemma rpow_le_rpow_of_exponent_le (hx : 1 ≤ x) (hyz : y ≤ z) : x^y ≤ x^z := +begin + repeat {rw [rpow_def_of_pos (lt_of_lt_of_le zero_lt_one hx)]}, + rw exp_le_exp, exact mul_le_mul_of_nonneg_left hyz (log_nonneg hx), +end + +@[simp] lemma rpow_le_rpow_left_iff (hx : 1 < x) : x ^ y ≤ x ^ z ↔ y ≤ z := +begin + have x_pos : 0 < x := lt_trans zero_lt_one hx, + rw [←log_le_log (rpow_pos_of_pos x_pos y) (rpow_pos_of_pos x_pos z), + log_rpow x_pos, log_rpow x_pos, mul_le_mul_right (log_pos hx)], +end + +@[simp] lemma rpow_lt_rpow_left_iff (hx : 1 < x) : x ^ y < x ^ z ↔ y < z := +by rw [lt_iff_not_le, rpow_le_rpow_left_iff hx, lt_iff_not_le] + +lemma rpow_lt_rpow_of_exponent_gt (hx0 : 0 < x) (hx1 : x < 1) (hyz : z < y) : + x^y < x^z := +begin + repeat {rw [rpow_def_of_pos hx0]}, + rw exp_lt_exp, exact mul_lt_mul_of_neg_left hyz (log_neg hx0 hx1), +end + +lemma rpow_le_rpow_of_exponent_ge (hx0 : 0 < x) (hx1 : x ≤ 1) (hyz : z ≤ y) : + x^y ≤ x^z := +begin + repeat {rw [rpow_def_of_pos hx0]}, + rw exp_le_exp, exact mul_le_mul_of_nonpos_left hyz (log_nonpos (le_of_lt hx0) hx1), +end + +@[simp] lemma rpow_le_rpow_left_iff_of_base_lt_one (hx0 : 0 < x) (hx1 : x < 1) : + x ^ y ≤ x ^ z ↔ z ≤ y := +begin + rw [←log_le_log (rpow_pos_of_pos hx0 y) (rpow_pos_of_pos hx0 z), + log_rpow hx0, log_rpow hx0, mul_le_mul_right_of_neg (log_neg hx0 hx1)], +end + +@[simp] lemma rpow_lt_rpow_left_iff_of_base_lt_one (hx0 : 0 < x) (hx1 : x < 1) : + x ^ y < x ^ z ↔ z < y := +by rw [lt_iff_not_le, rpow_le_rpow_left_iff_of_base_lt_one hx0 hx1, lt_iff_not_le] + +lemma rpow_lt_one {x z : ℝ} (hx1 : 0 ≤ x) (hx2 : x < 1) (hz : 0 < z) : x^z < 1 := +by { rw ← one_rpow z, exact rpow_lt_rpow hx1 hx2 hz } + +lemma rpow_le_one {x z : ℝ} (hx1 : 0 ≤ x) (hx2 : x ≤ 1) (hz : 0 ≤ z) : x^z ≤ 1 := +by { rw ← one_rpow z, exact rpow_le_rpow hx1 hx2 hz } + +lemma rpow_lt_one_of_one_lt_of_neg {x z : ℝ} (hx : 1 < x) (hz : z < 0) : x^z < 1 := +by { convert rpow_lt_rpow_of_exponent_lt hx hz, exact (rpow_zero x).symm } + +lemma rpow_le_one_of_one_le_of_nonpos {x z : ℝ} (hx : 1 ≤ x) (hz : z ≤ 0) : x^z ≤ 1 := +by { convert rpow_le_rpow_of_exponent_le hx hz, exact (rpow_zero x).symm } + +lemma one_lt_rpow {x z : ℝ} (hx : 1 < x) (hz : 0 < z) : 1 < x^z := +by { rw ← one_rpow z, exact rpow_lt_rpow zero_le_one hx hz } + +lemma one_le_rpow {x z : ℝ} (hx : 1 ≤ x) (hz : 0 ≤ z) : 1 ≤ x^z := +by { rw ← one_rpow z, exact rpow_le_rpow zero_le_one hx hz } + +lemma one_lt_rpow_of_pos_of_lt_one_of_neg (hx1 : 0 < x) (hx2 : x < 1) (hz : z < 0) : + 1 < x^z := +by { convert rpow_lt_rpow_of_exponent_gt hx1 hx2 hz, exact (rpow_zero x).symm } + +lemma one_le_rpow_of_pos_of_le_one_of_nonpos (hx1 : 0 < x) (hx2 : x ≤ 1) (hz : z ≤ 0) : + 1 ≤ x^z := +by { convert rpow_le_rpow_of_exponent_ge hx1 hx2 hz, exact (rpow_zero x).symm } + +lemma rpow_lt_one_iff_of_pos (hx : 0 < x) : x ^ y < 1 ↔ 1 < x ∧ y < 0 ∨ x < 1 ∧ 0 < y := +by rw [rpow_def_of_pos hx, exp_lt_one_iff, mul_neg_iff, log_pos_iff hx, log_neg_iff hx] + +lemma rpow_lt_one_iff (hx : 0 ≤ x) : x ^ y < 1 ↔ x = 0 ∧ y ≠ 0 ∨ 1 < x ∧ y < 0 ∨ x < 1 ∧ 0 < y := +begin + rcases hx.eq_or_lt with (rfl|hx), + { rcases em (y = 0) with (rfl|hy); simp [*, lt_irrefl, zero_lt_one] }, + { simp [rpow_lt_one_iff_of_pos hx, hx.ne.symm] } +end + +lemma one_lt_rpow_iff_of_pos (hx : 0 < x) : 1 < x ^ y ↔ 1 < x ∧ 0 < y ∨ x < 1 ∧ y < 0 := +by rw [rpow_def_of_pos hx, one_lt_exp_iff, mul_pos_iff, log_pos_iff hx, log_neg_iff hx] + +lemma one_lt_rpow_iff (hx : 0 ≤ x) : 1 < x ^ y ↔ 1 < x ∧ 0 < y ∨ 0 < x ∧ x < 1 ∧ y < 0 := +begin + rcases hx.eq_or_lt with (rfl|hx), + { rcases em (y = 0) with (rfl|hy); simp [*, lt_irrefl, (zero_lt_one' ℝ).not_lt] }, + { simp [one_lt_rpow_iff_of_pos hx, hx] } +end + +lemma rpow_le_rpow_of_exponent_ge' (hx0 : 0 ≤ x) (hx1 : x ≤ 1) (hz : 0 ≤ z) (hyz : z ≤ y) : + x^y ≤ x^z := +begin + rcases eq_or_lt_of_le hx0 with rfl | hx0', + { rcases eq_or_lt_of_le hz with rfl | hz', + { exact (rpow_zero 0).symm ▸ (rpow_le_one hx0 hx1 hyz), }, + rw [zero_rpow, zero_rpow]; linarith, }, + { exact rpow_le_rpow_of_exponent_ge hx0' hx1 hyz, }, +end + +lemma rpow_left_inj_on {x : ℝ} (hx : x ≠ 0) : + inj_on (λ y : ℝ, y^x) {y : ℝ | 0 ≤ y} := +begin + rintros y hy z hz (hyz : y ^ x = z ^ x), + rw [←rpow_one y, ←rpow_one z, ←_root_.mul_inv_cancel hx, rpow_mul hy, rpow_mul hz, hyz] +end + +lemma le_rpow_iff_log_le (hx : 0 < x) (hy : 0 < y) : + x ≤ y^z ↔ real.log x ≤ z * real.log y := +by rw [←real.log_le_log hx (real.rpow_pos_of_pos hy z), real.log_rpow hy] + +lemma le_rpow_of_log_le (hx : 0 ≤ x) (hy : 0 < y) (h : real.log x ≤ z * real.log y) : + x ≤ y^z := +begin + obtain hx | rfl := hx.lt_or_eq, + { exact (le_rpow_iff_log_le hx hy).2 h }, + exact (real.rpow_pos_of_pos hy z).le, +end + +lemma lt_rpow_iff_log_lt (hx : 0 < x) (hy : 0 < y) : + x < y^z ↔ real.log x < z * real.log y := +by rw [←real.log_lt_log_iff hx (real.rpow_pos_of_pos hy z), real.log_rpow hy] + +lemma lt_rpow_of_log_lt (hx : 0 ≤ x) (hy : 0 < y) (h : real.log x < z * real.log y) : + x < y^z := +begin + obtain hx | rfl := hx.lt_or_eq, + { exact (lt_rpow_iff_log_lt hx hy).2 h }, + exact real.rpow_pos_of_pos hy z, +end + +lemma rpow_le_one_iff_of_pos (hx : 0 < x) : x ^ y ≤ 1 ↔ 1 ≤ x ∧ y ≤ 0 ∨ x ≤ 1 ∧ 0 ≤ y := +by rw [rpow_def_of_pos hx, exp_le_one_iff, mul_nonpos_iff, log_nonneg_iff hx, log_nonpos_iff hx] + +/-- Bound for `|log x * x ^ t|` in the interval `(0, 1]`, for positive real `t`. -/ +lemma abs_log_mul_self_rpow_lt (x t : ℝ) (h1 : 0 < x) (h2 : x ≤ 1) (ht : 0 < t) : + |log x * x ^ t| < 1 / t := +begin + rw lt_div_iff ht, + have := abs_log_mul_self_lt (x ^ t) (rpow_pos_of_pos h1 t) (rpow_le_one h1.le h2 ht.le), + rwa [log_rpow h1, mul_assoc, abs_mul, abs_of_pos ht, mul_comm] at this +end + +lemma pow_nat_rpow_nat_inv {x : ℝ} (hx : 0 ≤ x) {n : ℕ} (hn : n ≠ 0) : + (x ^ n) ^ (n⁻¹ : ℝ) = x := +have hn0 : (n : ℝ) ≠ 0, from nat.cast_ne_zero.2 hn, +by rw [← rpow_nat_cast, ← rpow_mul hx, mul_inv_cancel hn0, rpow_one] + +lemma rpow_nat_inv_pow_nat {x : ℝ} (hx : 0 ≤ x) {n : ℕ} (hn : n ≠ 0) : + (x ^ (n⁻¹ : ℝ)) ^ n = x := +have hn0 : (n : ℝ) ≠ 0, from nat.cast_ne_zero.2 hn, +by rw [← rpow_nat_cast, ← rpow_mul hx, inv_mul_cancel hn0, rpow_one] + + +end real + +/-! +## Square roots of reals +-/ +namespace real + +variables {z x y : ℝ} + +section sqrt + +lemma sqrt_eq_rpow (x : ℝ) : sqrt x = x ^ (1/(2:ℝ)) := +begin + obtain h | h := le_or_lt 0 x, + { rw [← mul_self_inj_of_nonneg (sqrt_nonneg _) (rpow_nonneg_of_nonneg h _), mul_self_sqrt h, + ← sq, ← rpow_nat_cast, ← rpow_mul h], + norm_num }, + { have : 1 / (2:ℝ) * π = π / (2:ℝ), ring, + rw [sqrt_eq_zero_of_nonpos h.le, rpow_def_of_neg h, this, cos_pi_div_two, mul_zero] } +end + +lemma rpow_div_two_eq_sqrt {x : ℝ} (r : ℝ) (hx : 0 ≤ x) : x ^ (r/2) = (sqrt x) ^ r := +begin + rw [sqrt_eq_rpow, ← rpow_mul hx], + congr, + ring, +end + +end sqrt + +variables {n : ℕ} + +lemma exists_rat_pow_btwn_rat_aux (hn : n ≠ 0) (x y : ℝ) (h : x < y) (hy : 0 < y) : + ∃ q : ℚ, 0 < q ∧ x < q^n ∧ ↑q^n < y := +begin + have hn' : 0 < (n : ℝ) := by exact_mod_cast hn.bot_lt, + obtain ⟨q, hxq, hqy⟩ := exists_rat_btwn (rpow_lt_rpow (le_max_left 0 x) (max_lt hy h) $ + inv_pos.mpr hn'), + have := rpow_nonneg_of_nonneg (le_max_left 0 x) n⁻¹, + have hq := this.trans_lt hxq, + replace hxq := rpow_lt_rpow this hxq hn', + replace hqy := rpow_lt_rpow hq.le hqy hn', + rw [rpow_nat_cast, rpow_nat_cast, rpow_nat_inv_pow_nat _ hn] at hxq hqy, + exact ⟨q, by exact_mod_cast hq, (le_max_right _ _).trans_lt hxq, hqy⟩, + { exact le_max_left _ _ }, + { exact hy.le } +end + +lemma exists_rat_pow_btwn_rat (hn : n ≠ 0) {x y : ℚ} (h : x < y) (hy : 0 < y) : + ∃ q : ℚ, 0 < q ∧ x < q^n ∧ q^n < y := +by apply_mod_cast exists_rat_pow_btwn_rat_aux hn x y; assumption + +/-- There is a rational power between any two positive elements of an archimedean ordered field. -/ +lemma exists_rat_pow_btwn {α : Type*} [linear_ordered_field α] [archimedean α] (hn : n ≠ 0) + {x y : α} (h : x < y) (hy : 0 < y) : ∃ q : ℚ, 0 < q ∧ x < q^n ∧ (q^n : α) < y := +begin + obtain ⟨q₂, hx₂, hy₂⟩ := exists_rat_btwn (max_lt h hy), + obtain ⟨q₁, hx₁, hq₁₂⟩ := exists_rat_btwn hx₂, + have : (0 : α) < q₂ := (le_max_right _ _).trans_lt hx₂, + norm_cast at hq₁₂ this, + obtain ⟨q, hq, hq₁, hq₂⟩ := exists_rat_pow_btwn_rat hn hq₁₂ this, + refine ⟨q, hq, (le_max_left _ _).trans_lt $ hx₁.trans _, hy₂.trans' _⟩; assumption_mod_cast, +end + +end real + +section tactics +/-! +## Tactic extensions for real powers +-/ + +namespace norm_num +open tactic + +theorem rpow_pos (a b : ℝ) (b' : ℕ) (c : ℝ) (hb : (b':ℝ) = b) (h : a ^ b' = c) : a ^ b = c := +by rw [← h, ← hb, real.rpow_nat_cast] + +theorem rpow_neg (a b : ℝ) (b' : ℕ) (c c' : ℝ) + (a0 : 0 ≤ a) (hb : (b':ℝ) = b) (h : a ^ b' = c) (hc : c⁻¹ = c') : a ^ -b = c' := +by rw [← hc, ← h, ← hb, real.rpow_neg a0, real.rpow_nat_cast] + +/-- Evaluate `real.rpow a b` where `a` is a rational numeral and `b` is an integer. +(This cannot go via the generalized version `prove_rpow'` because `rpow_pos` has a side condition; +we do not attempt to evaluate `a ^ b` where `a` and `b` are both negative because it comes +out to some garbage.) -/ +meta def prove_rpow (a b : expr) : tactic (expr × expr) := do + na ← a.to_rat, + ic ← mk_instance_cache `(ℝ), + match match_sign b with + | sum.inl b := do + (ic, a0) ← guard (na ≥ 0) >> prove_nonneg ic a, + nc ← mk_instance_cache `(ℕ), + (ic, nc, b', hb) ← prove_nat_uncast ic nc b, + (ic, c, h) ← prove_pow a na ic b', + cr ← c.to_rat, + (ic, c', hc) ← prove_inv ic c cr, + pure (c', (expr.const ``rpow_neg []).mk_app [a, b, b', c, c', a0, hb, h, hc]) + | sum.inr ff := pure (`(1:ℝ), expr.const ``real.rpow_zero [] a) + | sum.inr tt := do + nc ← mk_instance_cache `(ℕ), + (ic, nc, b', hb) ← prove_nat_uncast ic nc b, + (ic, c, h) ← prove_pow a na ic b', + pure (c, (expr.const ``rpow_pos []).mk_app [a, b, b', c, hb, h]) + end + +/-- Evaluates expressions of the form `rpow a b` and `a ^ b` in the special case where +`b` is an integer and `a` is a positive rational (so it's really just a rational power). -/ +@[norm_num] meta def eval_rpow : expr → tactic (expr × expr) +| `(@has_pow.pow _ _ real.has_pow %%a %%b) := b.to_int >> prove_rpow a b +| `(real.rpow %%a %%b) := b.to_int >> prove_rpow a b +| _ := tactic.failed +end norm_num + +namespace tactic +namespace positivity + +/-- Auxiliary definition for the `positivity` tactic to handle real powers of reals. -/ +meta def prove_rpow (a b : expr) : tactic strictness := +do + strictness_a ← core a, + match strictness_a with + | nonnegative p := nonnegative <$> mk_app ``real.rpow_nonneg_of_nonneg [p, b] + | positive p := positive <$> mk_app ``real.rpow_pos_of_pos [p, b] + | _ := failed + end + +end positivity + +open positivity + +/-- Extension for the `positivity` tactic: exponentiation by a real number is nonnegative when the +base is nonnegative and positive when the base is positive. -/ +@[positivity] +meta def positivity_rpow : expr → tactic strictness +| `(@has_pow.pow _ _ real.has_pow %%a %%b) := prove_rpow a b +| `(real.rpow %%a %%b) := prove_rpow a b +| _ := failed + +end tactic + +end tactics diff --git a/src/analysis/special_functions/pow_deriv.lean b/src/analysis/special_functions/pow_deriv.lean deleted file mode 100644 index f5c538200f18b..0000000000000 --- a/src/analysis/special_functions/pow_deriv.lean +++ /dev/null @@ -1,549 +0,0 @@ -/- -Copyright (c) 2018 Chris Hughes. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Sébastien Gouëzel, - Rémy Degenne --/ -import analysis.special_functions.pow -import analysis.special_functions.complex.log_deriv -import analysis.calculus.extend_deriv -import analysis.special_functions.log.deriv -import analysis.special_functions.trigonometric.deriv - -/-! -# Derivatives of power function on `ℂ`, `ℝ`, `ℝ≥0`, and `ℝ≥0∞` - -We also prove differentiability and provide derivatives for the power functions `x ^ y`. --/ - -noncomputable theory - -open_locale classical real topological_space nnreal ennreal filter -open filter - -namespace complex - -lemma has_strict_fderiv_at_cpow {p : ℂ × ℂ} (hp : 0 < p.1.re ∨ p.1.im ≠ 0) : - has_strict_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2) - ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℂ ℂ ℂ + - (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℂ ℂ ℂ) p := -begin - have A : p.1 ≠ 0, by { intro h, simpa [h, lt_irrefl] using hp }, - have : (λ x : ℂ × ℂ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2)), - from ((is_open_ne.preimage continuous_fst).eventually_mem A).mono - (λ p hp, cpow_def_of_ne_zero hp _), - rw [cpow_sub _ _ A, cpow_one, mul_div_comm, mul_smul, mul_smul, ← smul_add], - refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm, - simpa only [cpow_def_of_ne_zero A, div_eq_mul_inv, mul_smul, add_comm] - using ((has_strict_fderiv_at_fst.clog hp).mul has_strict_fderiv_at_snd).cexp -end - -lemma has_strict_fderiv_at_cpow' {x y : ℂ} (hp : 0 < x.re ∨ x.im ≠ 0) : - has_strict_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2) - ((y * x ^ (y - 1)) • continuous_linear_map.fst ℂ ℂ ℂ + - (x ^ y * log x) • continuous_linear_map.snd ℂ ℂ ℂ) (x, y) := -@has_strict_fderiv_at_cpow (x, y) hp - -lemma has_strict_deriv_at_const_cpow {x y : ℂ} (h : x ≠ 0 ∨ y ≠ 0) : - has_strict_deriv_at (λ y, x ^ y) (x ^ y * log x) y := -begin - rcases em (x = 0) with rfl|hx, - { replace h := h.neg_resolve_left rfl, - rw [log_zero, mul_zero], - refine (has_strict_deriv_at_const _ 0).congr_of_eventually_eq _, - exact (is_open_ne.eventually_mem h).mono (λ y hy, (zero_cpow hy).symm) }, - { simpa only [cpow_def_of_ne_zero hx, mul_one] - using ((has_strict_deriv_at_id y).const_mul (log x)).cexp } -end - -lemma has_fderiv_at_cpow {p : ℂ × ℂ} (hp : 0 < p.1.re ∨ p.1.im ≠ 0) : - has_fderiv_at (λ x : ℂ × ℂ, x.1 ^ x.2) - ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℂ ℂ ℂ + - (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℂ ℂ ℂ) p := -(has_strict_fderiv_at_cpow hp).has_fderiv_at - -end complex - -section fderiv - -open complex - -variables {E : Type*} [normed_group E] [normed_space ℂ E] {f g : E → ℂ} {f' g' : E →L[ℂ] ℂ} - {x : E} {s : set E} {c : ℂ} - -lemma has_strict_fderiv_at.cpow (hf : has_strict_fderiv_at f f' x) - (hg : has_strict_fderiv_at g g' x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_strict_fderiv_at (λ x, f x ^ g x) - ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := -by convert (@has_strict_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp x (hf.prod hg) - -lemma has_strict_fderiv_at.const_cpow (hf : has_strict_fderiv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) : - has_strict_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := -(has_strict_deriv_at_const_cpow h0).comp_has_strict_fderiv_at x hf - -lemma has_fderiv_at.cpow (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) - (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_fderiv_at (λ x, f x ^ g x) - ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := -by convert (@complex.has_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp x (hf.prod hg) - -lemma has_fderiv_at.const_cpow (hf : has_fderiv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) : - has_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := -(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_fderiv_at x hf - -lemma has_fderiv_within_at.cpow (hf : has_fderiv_within_at f f' s x) - (hg : has_fderiv_within_at g g' s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_fderiv_within_at (λ x, f x ^ g x) - ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') s x := -by convert (@complex.has_fderiv_at_cpow ((λ x, (f x, g x)) x) h0).comp_has_fderiv_within_at x - (hf.prod hg) - -lemma has_fderiv_within_at.const_cpow (hf : has_fderiv_within_at f f' s x) (h0 : c ≠ 0 ∨ f x ≠ 0) : - has_fderiv_within_at (λ x, c ^ f x) ((c ^ f x * log c) • f') s x := -(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_fderiv_within_at x hf - -lemma differentiable_at.cpow (hf : differentiable_at ℂ f x) (hg : differentiable_at ℂ g x) - (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - differentiable_at ℂ (λ x, f x ^ g x) x := -(hf.has_fderiv_at.cpow hg.has_fderiv_at h0).differentiable_at - -lemma differentiable_at.const_cpow (hf : differentiable_at ℂ f x) (h0 : c ≠ 0 ∨ f x ≠ 0) : - differentiable_at ℂ (λ x, c ^ f x) x := -(hf.has_fderiv_at.const_cpow h0).differentiable_at - -lemma differentiable_within_at.cpow (hf : differentiable_within_at ℂ f s x) - (hg : differentiable_within_at ℂ g s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - differentiable_within_at ℂ (λ x, f x ^ g x) s x := -(hf.has_fderiv_within_at.cpow hg.has_fderiv_within_at h0).differentiable_within_at - -lemma differentiable_within_at.const_cpow (hf : differentiable_within_at ℂ f s x) - (h0 : c ≠ 0 ∨ f x ≠ 0) : - differentiable_within_at ℂ (λ x, c ^ f x) s x := -(hf.has_fderiv_within_at.const_cpow h0).differentiable_within_at - -end fderiv - -section deriv - -open complex - -variables {f g : ℂ → ℂ} {s : set ℂ} {f' g' x c : ℂ} - -/-- A private lemma that rewrites the output of lemmas like `has_fderiv_at.cpow` to the form -expected by lemmas like `has_deriv_at.cpow`. -/ -private lemma aux : - ((g x * f x ^ (g x - 1)) • (1 : ℂ →L[ℂ] ℂ).smul_right f' + - (f x ^ g x * log (f x)) • (1 : ℂ →L[ℂ] ℂ).smul_right g') 1 = - g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g' := -by simp only [algebra.id.smul_eq_mul, one_mul, continuous_linear_map.one_apply, - continuous_linear_map.smul_right_apply, continuous_linear_map.add_apply, pi.smul_apply, - continuous_linear_map.coe_smul'] - -lemma has_strict_deriv_at.cpow (hf : has_strict_deriv_at f f' x) (hg : has_strict_deriv_at g g' x) - (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_strict_deriv_at (λ x, f x ^ g x) - (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') x := -by simpa only [aux] using (hf.cpow hg h0).has_strict_deriv_at - -lemma has_strict_deriv_at.const_cpow (hf : has_strict_deriv_at f f' x) (h : c ≠ 0 ∨ f x ≠ 0) : - has_strict_deriv_at (λ x, c ^ f x) (c ^ f x * log c * f') x := -(has_strict_deriv_at_const_cpow h).comp x hf - -lemma complex.has_strict_deriv_at_cpow_const (h : 0 < x.re ∨ x.im ≠ 0) : - has_strict_deriv_at (λ z : ℂ, z ^ c) (c * x ^ (c - 1)) x := -by simpa only [mul_zero, add_zero, mul_one] - using (has_strict_deriv_at_id x).cpow (has_strict_deriv_at_const x c) h - -lemma has_strict_deriv_at.cpow_const (hf : has_strict_deriv_at f f' x) - (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_strict_deriv_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') x := -(complex.has_strict_deriv_at_cpow_const h0).comp x hf - -lemma has_deriv_at.cpow (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) - (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_deriv_at (λ x, f x ^ g x) (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') x := -by simpa only [aux] using (hf.has_fderiv_at.cpow hg h0).has_deriv_at - -lemma has_deriv_at.const_cpow (hf : has_deriv_at f f' x) (h0 : c ≠ 0 ∨ f x ≠ 0) : - has_deriv_at (λ x, c ^ f x) (c ^ f x * log c * f') x := -(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp x hf - -lemma has_deriv_at.cpow_const (hf : has_deriv_at f f' x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_deriv_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') x := -(complex.has_strict_deriv_at_cpow_const h0).has_deriv_at.comp x hf - -lemma has_deriv_within_at.cpow (hf : has_deriv_within_at f f' s x) - (hg : has_deriv_within_at g g' s x) (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_deriv_within_at (λ x, f x ^ g x) - (g x * f x ^ (g x - 1) * f' + f x ^ g x * log (f x) * g') s x := -by simpa only [aux] using (hf.has_fderiv_within_at.cpow hg h0).has_deriv_within_at - -lemma has_deriv_within_at.const_cpow (hf : has_deriv_within_at f f' s x) (h0 : c ≠ 0 ∨ f x ≠ 0) : - has_deriv_within_at (λ x, c ^ f x) (c ^ f x * log c * f') s x := -(has_strict_deriv_at_const_cpow h0).has_deriv_at.comp_has_deriv_within_at x hf - -lemma has_deriv_within_at.cpow_const (hf : has_deriv_within_at f f' s x) - (h0 : 0 < (f x).re ∨ (f x).im ≠ 0) : - has_deriv_within_at (λ x, f x ^ c) (c * f x ^ (c - 1) * f') s x := -(complex.has_strict_deriv_at_cpow_const h0).has_deriv_at.comp_has_deriv_within_at x hf - -end deriv - -namespace real - -variables {x y z : ℝ} - -/-- `(x, y) ↦ x ^ y` is strictly differentiable at `p : ℝ × ℝ` such that `0 < p.fst`. -/ -lemma has_strict_fderiv_at_rpow_of_pos (p : ℝ × ℝ) (hp : 0 < p.1) : - has_strict_fderiv_at (λ x : ℝ × ℝ, x.1 ^ x.2) - ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℝ ℝ ℝ + - (p.1 ^ p.2 * log p.1) • continuous_linear_map.snd ℝ ℝ ℝ) p := -begin - have : (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2)), - from (continuous_at_fst.eventually (lt_mem_nhds hp)).mono (λ p hp, rpow_def_of_pos hp _), - refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm, - convert ((has_strict_fderiv_at_fst.log hp.ne').mul has_strict_fderiv_at_snd).exp, - rw [rpow_sub_one hp.ne', ← rpow_def_of_pos hp, smul_add, smul_smul, mul_div_comm, - div_eq_mul_inv, smul_smul, smul_smul, mul_assoc, add_comm] -end - -/-- `(x, y) ↦ x ^ y` is strictly differentiable at `p : ℝ × ℝ` such that `p.fst < 0`. -/ -lemma has_strict_fderiv_at_rpow_of_neg (p : ℝ × ℝ) (hp : p.1 < 0) : - has_strict_fderiv_at (λ x : ℝ × ℝ, x.1 ^ x.2) - ((p.2 * p.1 ^ (p.2 - 1)) • continuous_linear_map.fst ℝ ℝ ℝ + - (p.1 ^ p.2 * log p.1 - exp (log p.1 * p.2) * sin (p.2 * π) * π) • - continuous_linear_map.snd ℝ ℝ ℝ) p := -begin - have : (λ x : ℝ × ℝ, x.1 ^ x.2) =ᶠ[𝓝 p] (λ x, exp (log x.1 * x.2) * cos (x.2 * π)), - from (continuous_at_fst.eventually (gt_mem_nhds hp)).mono (λ p hp, rpow_def_of_neg hp _), - refine has_strict_fderiv_at.congr_of_eventually_eq _ this.symm, - convert ((has_strict_fderiv_at_fst.log hp.ne).mul has_strict_fderiv_at_snd).exp.mul - (has_strict_fderiv_at_snd.mul_const _).cos using 1, - simp_rw [rpow_sub_one hp.ne, smul_add, ← add_assoc, smul_smul, ← add_smul, ← mul_assoc, - mul_comm (cos _), ← rpow_def_of_neg hp], - rw [div_eq_mul_inv, add_comm], congr' 2; ring -end - -/-- The function `λ (x, y), x ^ y` is infinitely smooth at `(x, y)` unless `x = 0`. -/ -lemma cont_diff_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) {n : with_top ℕ} : - cont_diff_at ℝ n (λ p : ℝ × ℝ, p.1 ^ p.2) p := -begin - cases hp.lt_or_lt with hneg hpos, - exacts [(((cont_diff_at_fst.log hneg.ne).mul cont_diff_at_snd).exp.mul - (cont_diff_at_snd.mul cont_diff_at_const).cos).congr_of_eventually_eq - ((continuous_at_fst.eventually (gt_mem_nhds hneg)).mono (λ p hp, rpow_def_of_neg hp _)), - ((cont_diff_at_fst.log hpos.ne').mul cont_diff_at_snd).exp.congr_of_eventually_eq - ((continuous_at_fst.eventually (lt_mem_nhds hpos)).mono (λ p hp, rpow_def_of_pos hp _))] -end - -lemma differentiable_at_rpow_of_ne (p : ℝ × ℝ) (hp : p.1 ≠ 0) : - differentiable_at ℝ (λ p : ℝ × ℝ, p.1 ^ p.2) p := -(cont_diff_at_rpow_of_ne p hp).differentiable_at le_rfl - -lemma _root_.has_strict_deriv_at.rpow {f g : ℝ → ℝ} {f' g' : ℝ} (hf : has_strict_deriv_at f f' x) - (hg : has_strict_deriv_at g g' x) (h : 0 < f x) : - has_strict_deriv_at (λ x, f x ^ g x) - (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) x := -begin - convert (has_strict_fderiv_at_rpow_of_pos ((λ x, (f x, g x)) x) h).comp_has_strict_deriv_at _ - (hf.prod hg) using 1, - simp [mul_assoc, mul_comm, mul_left_comm] -end - -lemma has_strict_deriv_at_rpow_const_of_ne {x : ℝ} (hx : x ≠ 0) (p : ℝ) : - has_strict_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x := -begin - cases hx.lt_or_lt with hx hx, - { have := (has_strict_fderiv_at_rpow_of_neg (x, p) hx).comp_has_strict_deriv_at x - ((has_strict_deriv_at_id x).prod (has_strict_deriv_at_const _ _)), - convert this, simp }, - { simpa using (has_strict_deriv_at_id x).rpow (has_strict_deriv_at_const x p) hx } -end - -lemma has_strict_deriv_at_const_rpow {a : ℝ} (ha : 0 < a) (x : ℝ) : - has_strict_deriv_at (λ x, a ^ x) (a ^ x * log a) x := -by simpa using (has_strict_deriv_at_const _ _).rpow (has_strict_deriv_at_id x) ha - -/-- This lemma says that `λ x, a ^ x` is strictly differentiable for `a < 0`. Note that these -values of `a` are outside of the "official" domain of `a ^ x`, and we may redefine `a ^ x` -for negative `a` if some other definition will be more convenient. -/ -lemma has_strict_deriv_at_const_rpow_of_neg {a x : ℝ} (ha : a < 0) : - has_strict_deriv_at (λ x, a ^ x) (a ^ x * log a - exp (log a * x) * sin (x * π) * π) x := -by simpa using (has_strict_fderiv_at_rpow_of_neg (a, x) ha).comp_has_strict_deriv_at x - ((has_strict_deriv_at_const _ _).prod (has_strict_deriv_at_id _)) - -end real - -namespace real - -variables {z x y : ℝ} - -lemma has_deriv_at_rpow_const {x p : ℝ} (h : x ≠ 0 ∨ 1 ≤ p) : - has_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x := -begin - rcases ne_or_eq x 0 with hx | rfl, - { exact (has_strict_deriv_at_rpow_const_of_ne hx _).has_deriv_at }, - replace h : 1 ≤ p := h.neg_resolve_left rfl, - apply has_deriv_at_of_has_deriv_at_of_ne - (λ x hx, (has_strict_deriv_at_rpow_const_of_ne hx p).has_deriv_at), - exacts [continuous_at_id.rpow_const (or.inr (zero_le_one.trans h)), - continuous_at_const.mul (continuous_at_id.rpow_const (or.inr (sub_nonneg.2 h)))] -end - -lemma differentiable_rpow_const {p : ℝ} (hp : 1 ≤ p) : - differentiable ℝ (λ x : ℝ, x ^ p) := -λ x, (has_deriv_at_rpow_const (or.inr hp)).differentiable_at - -lemma deriv_rpow_const {x p : ℝ} (h : x ≠ 0 ∨ 1 ≤ p) : - deriv (λ x : ℝ, x ^ p) x = p * x ^ (p - 1) := -(has_deriv_at_rpow_const h).deriv - -lemma deriv_rpow_const' {p : ℝ} (h : 1 ≤ p) : - deriv (λ x : ℝ, x ^ p) = λ x, p * x ^ (p - 1) := -funext $ λ x, deriv_rpow_const (or.inr h) - -lemma cont_diff_at_rpow_const_of_ne {x p : ℝ} {n : with_top ℕ} (h : x ≠ 0) : - cont_diff_at ℝ n (λ x, x ^ p) x := -(cont_diff_at_rpow_of_ne (x, p) h).comp x - (cont_diff_at_id.prod cont_diff_at_const) - -lemma cont_diff_rpow_const_of_le {p : ℝ} {n : ℕ} (h : ↑n ≤ p) : - cont_diff ℝ n (λ x : ℝ, x ^ p) := -begin - induction n with n ihn generalizing p, - { exact cont_diff_zero.2 (continuous_id.rpow_const (λ x, or.inr h)) }, - { have h1 : 1 ≤ p, from le_trans (by simp) h, - rw [nat.cast_succ, ← le_sub_iff_add_le] at h, - simpa [cont_diff_succ_iff_deriv, differentiable_rpow_const, h1, deriv_rpow_const'] - using cont_diff_const.mul (ihn h) } -end - -lemma cont_diff_at_rpow_const_of_le {x p : ℝ} {n : ℕ} (h : ↑n ≤ p) : - cont_diff_at ℝ n (λ x : ℝ, x ^ p) x := -(cont_diff_rpow_const_of_le h).cont_diff_at - -lemma cont_diff_at_rpow_const {x p : ℝ} {n : ℕ} (h : x ≠ 0 ∨ ↑n ≤ p) : - cont_diff_at ℝ n (λ x : ℝ, x ^ p) x := -h.elim cont_diff_at_rpow_const_of_ne cont_diff_at_rpow_const_of_le - -lemma has_strict_deriv_at_rpow_const {x p : ℝ} (hx : x ≠ 0 ∨ 1 ≤ p) : - has_strict_deriv_at (λ x, x ^ p) (p * x ^ (p - 1)) x := -cont_diff_at.has_strict_deriv_at' - (cont_diff_at_rpow_const (by rwa nat.cast_one)) - (has_deriv_at_rpow_const hx) le_rfl - -end real - -section differentiability -open real - -section fderiv - -variables {E : Type*} [normed_group E] [normed_space ℝ E] {f g : E → ℝ} {f' g' : E →L[ℝ] ℝ} - {x : E} {s : set E} {c p : ℝ} {n : with_top ℕ} - -lemma has_fderiv_within_at.rpow (hf : has_fderiv_within_at f f' s x) - (hg : has_fderiv_within_at g g' s x) (h : 0 < f x) : - has_fderiv_within_at (λ x, f x ^ g x) - ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') s x := -(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).has_fderiv_at.comp_has_fderiv_within_at x - (hf.prod hg) - -lemma has_fderiv_at.rpow (hf : has_fderiv_at f f' x) (hg : has_fderiv_at g g' x) (h : 0 < f x) : - has_fderiv_at (λ x, f x ^ g x) ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := -(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).has_fderiv_at.comp x (hf.prod hg) - -lemma has_strict_fderiv_at.rpow (hf : has_strict_fderiv_at f f' x) - (hg : has_strict_fderiv_at g g' x) (h : 0 < f x) : - has_strict_fderiv_at (λ x, f x ^ g x) - ((g x * f x ^ (g x - 1)) • f' + (f x ^ g x * log (f x)) • g') x := -(has_strict_fderiv_at_rpow_of_pos (f x, g x) h).comp x (hf.prod hg) - -lemma differentiable_within_at.rpow (hf : differentiable_within_at ℝ f s x) - (hg : differentiable_within_at ℝ g s x) (h : f x ≠ 0) : - differentiable_within_at ℝ (λ x, f x ^ g x) s x := -(differentiable_at_rpow_of_ne (f x, g x) h).comp_differentiable_within_at x (hf.prod hg) - -lemma differentiable_at.rpow (hf : differentiable_at ℝ f x) (hg : differentiable_at ℝ g x) - (h : f x ≠ 0) : - differentiable_at ℝ (λ x, f x ^ g x) x := -(differentiable_at_rpow_of_ne (f x, g x) h).comp x (hf.prod hg) - -lemma differentiable_on.rpow (hf : differentiable_on ℝ f s) (hg : differentiable_on ℝ g s) - (h : ∀ x ∈ s, f x ≠ 0) : - differentiable_on ℝ (λ x, f x ^ g x) s := -λ x hx, (hf x hx).rpow (hg x hx) (h x hx) - -lemma differentiable.rpow (hf : differentiable ℝ f) (hg : differentiable ℝ g) (h : ∀ x, f x ≠ 0) : - differentiable ℝ (λ x, f x ^ g x) := -λ x, (hf x).rpow (hg x) (h x) - -lemma has_fderiv_within_at.rpow_const (hf : has_fderiv_within_at f f' s x) (h : f x ≠ 0 ∨ 1 ≤ p) : - has_fderiv_within_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') s x := -(has_deriv_at_rpow_const h).comp_has_fderiv_within_at x hf - -lemma has_fderiv_at.rpow_const (hf : has_fderiv_at f f' x) (h : f x ≠ 0 ∨ 1 ≤ p) : - has_fderiv_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') x := -(has_deriv_at_rpow_const h).comp_has_fderiv_at x hf - -lemma has_strict_fderiv_at.rpow_const (hf : has_strict_fderiv_at f f' x) (h : f x ≠ 0 ∨ 1 ≤ p) : - has_strict_fderiv_at (λ x, f x ^ p) ((p * f x ^ (p - 1)) • f') x := -(has_strict_deriv_at_rpow_const h).comp_has_strict_fderiv_at x hf - -lemma differentiable_within_at.rpow_const (hf : differentiable_within_at ℝ f s x) - (h : f x ≠ 0 ∨ 1 ≤ p) : - differentiable_within_at ℝ (λ x, f x ^ p) s x := -(hf.has_fderiv_within_at.rpow_const h).differentiable_within_at - -@[simp] lemma differentiable_at.rpow_const (hf : differentiable_at ℝ f x) (h : f x ≠ 0 ∨ 1 ≤ p) : - differentiable_at ℝ (λ x, f x ^ p) x := -(hf.has_fderiv_at.rpow_const h).differentiable_at - -lemma differentiable_on.rpow_const (hf : differentiable_on ℝ f s) (h : ∀ x ∈ s, f x ≠ 0 ∨ 1 ≤ p) : - differentiable_on ℝ (λ x, f x ^ p) s := -λ x hx, (hf x hx).rpow_const (h x hx) - -lemma differentiable.rpow_const (hf : differentiable ℝ f) (h : ∀ x, f x ≠ 0 ∨ 1 ≤ p) : - differentiable ℝ (λ x, f x ^ p) := -λ x, (hf x).rpow_const (h x) - -lemma has_fderiv_within_at.const_rpow (hf : has_fderiv_within_at f f' s x) (hc : 0 < c) : - has_fderiv_within_at (λ x, c ^ f x) ((c ^ f x * log c) • f') s x := -(has_strict_deriv_at_const_rpow hc (f x)).has_deriv_at.comp_has_fderiv_within_at x hf - -lemma has_fderiv_at.const_rpow (hf : has_fderiv_at f f' x) (hc : 0 < c) : - has_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := -(has_strict_deriv_at_const_rpow hc (f x)).has_deriv_at.comp_has_fderiv_at x hf - -lemma has_strict_fderiv_at.const_rpow (hf : has_strict_fderiv_at f f' x) (hc : 0 < c) : - has_strict_fderiv_at (λ x, c ^ f x) ((c ^ f x * log c) • f') x := -(has_strict_deriv_at_const_rpow hc (f x)).comp_has_strict_fderiv_at x hf - -lemma cont_diff_within_at.rpow (hf : cont_diff_within_at ℝ n f s x) - (hg : cont_diff_within_at ℝ n g s x) (h : f x ≠ 0) : - cont_diff_within_at ℝ n (λ x, f x ^ g x) s x := -(cont_diff_at_rpow_of_ne (f x, g x) h).comp_cont_diff_within_at x (hf.prod hg) - -lemma cont_diff_at.rpow (hf : cont_diff_at ℝ n f x) (hg : cont_diff_at ℝ n g x) - (h : f x ≠ 0) : - cont_diff_at ℝ n (λ x, f x ^ g x) x := -(cont_diff_at_rpow_of_ne (f x, g x) h).comp x (hf.prod hg) - -lemma cont_diff_on.rpow (hf : cont_diff_on ℝ n f s) (hg : cont_diff_on ℝ n g s) - (h : ∀ x ∈ s, f x ≠ 0) : - cont_diff_on ℝ n (λ x, f x ^ g x) s := -λ x hx, (hf x hx).rpow (hg x hx) (h x hx) - -lemma cont_diff.rpow (hf : cont_diff ℝ n f) (hg : cont_diff ℝ n g) - (h : ∀ x, f x ≠ 0) : - cont_diff ℝ n (λ x, f x ^ g x) := -cont_diff_iff_cont_diff_at.mpr $ - λ x, hf.cont_diff_at.rpow hg.cont_diff_at (h x) - -lemma cont_diff_within_at.rpow_const_of_ne (hf : cont_diff_within_at ℝ n f s x) - (h : f x ≠ 0) : - cont_diff_within_at ℝ n (λ x, f x ^ p) s x := -hf.rpow cont_diff_within_at_const h - -lemma cont_diff_at.rpow_const_of_ne (hf : cont_diff_at ℝ n f x) (h : f x ≠ 0) : - cont_diff_at ℝ n (λ x, f x ^ p) x := -hf.rpow cont_diff_at_const h - -lemma cont_diff_on.rpow_const_of_ne (hf : cont_diff_on ℝ n f s) (h : ∀ x ∈ s, f x ≠ 0) : - cont_diff_on ℝ n (λ x, f x ^ p) s := -λ x hx, (hf x hx).rpow_const_of_ne (h x hx) - -lemma cont_diff.rpow_const_of_ne (hf : cont_diff ℝ n f) (h : ∀ x, f x ≠ 0) : - cont_diff ℝ n (λ x, f x ^ p) := -hf.rpow cont_diff_const h - -variable {m : ℕ} - -lemma cont_diff_within_at.rpow_const_of_le (hf : cont_diff_within_at ℝ m f s x) - (h : ↑m ≤ p) : - cont_diff_within_at ℝ m (λ x, f x ^ p) s x := -(cont_diff_at_rpow_const_of_le h).comp_cont_diff_within_at x hf - -lemma cont_diff_at.rpow_const_of_le (hf : cont_diff_at ℝ m f x) (h : ↑m ≤ p) : - cont_diff_at ℝ m (λ x, f x ^ p) x := -by { rw ← cont_diff_within_at_univ at *, exact hf.rpow_const_of_le h } - -lemma cont_diff_on.rpow_const_of_le (hf : cont_diff_on ℝ m f s) (h : ↑m ≤ p) : - cont_diff_on ℝ m (λ x, f x ^ p) s := -λ x hx, (hf x hx).rpow_const_of_le h - -lemma cont_diff.rpow_const_of_le (hf : cont_diff ℝ m f) (h : ↑m ≤ p) : - cont_diff ℝ m (λ x, f x ^ p) := -cont_diff_iff_cont_diff_at.mpr $ λ x, hf.cont_diff_at.rpow_const_of_le h - -end fderiv - -section deriv - -variables {f g : ℝ → ℝ} {f' g' x y p : ℝ} {s : set ℝ} - -lemma has_deriv_within_at.rpow (hf : has_deriv_within_at f f' s x) - (hg : has_deriv_within_at g g' s x) (h : 0 < f x) : - has_deriv_within_at (λ x, f x ^ g x) - (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) s x := -begin - convert (hf.has_fderiv_within_at.rpow hg.has_fderiv_within_at h).has_deriv_within_at using 1, - dsimp, ring -end - -lemma has_deriv_at.rpow (hf : has_deriv_at f f' x) (hg : has_deriv_at g g' x) (h : 0 < f x) : - has_deriv_at (λ x, f x ^ g x) (f' * g x * (f x) ^ (g x - 1) + g' * f x ^ g x * log (f x)) x := -begin - rw ← has_deriv_within_at_univ at *, - exact hf.rpow hg h -end - -lemma has_deriv_within_at.rpow_const (hf : has_deriv_within_at f f' s x) (hx : f x ≠ 0 ∨ 1 ≤ p) : - has_deriv_within_at (λ y, (f y)^p) (f' * p * (f x) ^ (p - 1)) s x := -begin - convert (has_deriv_at_rpow_const hx).comp_has_deriv_within_at x hf using 1, - ring -end - -lemma has_deriv_at.rpow_const (hf : has_deriv_at f f' x) (hx : f x ≠ 0 ∨ 1 ≤ p) : - has_deriv_at (λ y, (f y)^p) (f' * p * (f x)^(p-1)) x := -begin - rw ← has_deriv_within_at_univ at *, - exact hf.rpow_const hx -end - -lemma deriv_within_rpow_const (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0 ∨ 1 ≤ p) - (hxs : unique_diff_within_at ℝ s x) : - deriv_within (λx, (f x) ^ p) s x = (deriv_within f s x) * p * (f x) ^ (p - 1) := -(hf.has_deriv_within_at.rpow_const hx).deriv_within hxs - -@[simp] lemma deriv_rpow_const (hf : differentiable_at ℝ f x) (hx : f x ≠ 0 ∨ 1 ≤ p) : - deriv (λx, (f x)^p) x = (deriv f x) * p * (f x)^(p-1) := -(hf.has_deriv_at.rpow_const hx).deriv - -end deriv - -end differentiability - -section limits -open real filter - -/-- The function `(1 + t/x) ^ x` tends to `exp t` at `+∞`. -/ -lemma tendsto_one_plus_div_rpow_exp (t : ℝ) : - tendsto (λ (x : ℝ), (1 + t / x) ^ x) at_top (𝓝 (exp t)) := -begin - apply ((real.continuous_exp.tendsto _).comp (tendsto_mul_log_one_plus_div_at_top t)).congr' _, - have h₁ : (1:ℝ)/2 < 1 := by linarith, - have h₂ : tendsto (λ x : ℝ, 1 + t / x) at_top (𝓝 1) := - by simpa using (tendsto_inv_at_top_zero.const_mul t).const_add 1, - refine (eventually_ge_of_tendsto_gt h₁ h₂).mono (λ x hx, _), - have hx' : 0 < 1 + t / x := by linarith, - simp [mul_comm x, exp_mul, exp_log hx'], -end - -/-- The function `(1 + t/x) ^ x` tends to `exp t` at `+∞` for naturals `x`. -/ -lemma tendsto_one_plus_div_pow_exp (t : ℝ) : - tendsto (λ (x : ℕ), (1 + t / (x:ℝ)) ^ x) at_top (𝓝 (real.exp t)) := -((tendsto_one_plus_div_rpow_exp t).comp tendsto_coe_nat_at_top_at_top).congr (by simp) - -end limits diff --git a/src/analysis/special_functions/sqrt.lean b/src/analysis/special_functions/sqrt.lean index f9aabd7ad5ad8..4d47dc7972a8b 100644 --- a/src/analysis/special_functions/sqrt.lean +++ b/src/analysis/special_functions/sqrt.lean @@ -8,6 +8,9 @@ import analysis.calculus.cont_diff /-! # Smoothness of `real.sqrt` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that `real.sqrt` is infinitely smooth at all points `x ≠ 0` and provide some dot-notation lemmas. @@ -17,7 +20,7 @@ sqrt, differentiable -/ open set -open_locale topological_space +open_locale topology namespace real @@ -57,7 +60,7 @@ lemma has_strict_deriv_at_sqrt {x : ℝ} (hx : x ≠ 0) : has_strict_deriv_at sqrt (1 / (2 * sqrt x)) x := (deriv_sqrt_aux hx).1 -lemma cont_diff_at_sqrt {x : ℝ} {n : with_top ℕ} (hx : x ≠ 0) : +lemma cont_diff_at_sqrt {x : ℝ} {n : ℕ∞} (hx : x ≠ 0) : cont_diff_at ℝ n sqrt x := (deriv_sqrt_aux hx).2 n @@ -98,7 +101,7 @@ end deriv section fderiv -variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {n : with_top ℕ} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {n : ℕ∞} {s : set E} {x : E} {f' : E →L[ℝ] ℝ} lemma has_fderiv_at.sqrt (hf : has_fderiv_at f f' x) (hx : f x ≠ 0) : diff --git a/src/analysis/special_functions/stirling.lean b/src/analysis/special_functions/stirling.lean new file mode 100644 index 0000000000000..488a468a7c81a --- /dev/null +++ b/src/analysis/special_functions/stirling.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2022. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Moritz Firsching, Fabian Kruse, Nikolas Kuhn +-/ +import analysis.p_series +import data.real.pi.wallis + +/-! +# Stirling's formula + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Stirling's formula for the factorial. +It states that $n!$ grows asymptotically like $\sqrt{2\pi n}(\frac{n}{e})^n$. + +## Proof outline + +The proof follows: . + +We proceed in two parts. + +**Part 1**: We consider the sequence $a_n$ of fractions $\frac{n!}{\sqrt{2n}(\frac{n}{e})^n}$ +and prove that this sequence converges to a real, positive number $a$. For this the two main +ingredients are + - taking the logarithm of the sequence and + - using the series expansion of $\log(1 + x)$. + +**Part 2**: We use the fact that the series defined in part 1 converges againt a real number $a$ +and prove that $a = \sqrt{\pi}$. Here the main ingredient is the convergence of Wallis' product +formula for `π`. +-/ + +open_locale topology real big_operators nat +open finset filter nat real + +namespace stirling +/-! + ### Part 1 + https://proofwiki.org/wiki/Stirling%27s_Formula#Part_1 +-/ + +/-- +Define `stirling_seq n` as $\frac{n!}{\sqrt{2n}(\frac{n}{e})^n}$. +Stirling's formula states that this sequence has limit $\sqrt(π)$. +-/ +noncomputable def stirling_seq (n : ℕ) : ℝ := +n! / (sqrt (2 * n) * (n / exp 1) ^ n) + +@[simp] lemma stirling_seq_zero : stirling_seq 0 = 0 := +by rw [stirling_seq, cast_zero, mul_zero, real.sqrt_zero, zero_mul, div_zero] + +@[simp] lemma stirling_seq_one : stirling_seq 1 = exp 1 / sqrt 2 := +by rw [stirling_seq, pow_one, factorial_one, cast_one, mul_one, mul_one_div, one_div_div] + +/-- +We have the expression +`log (stirling_seq (n + 1)) = log(n + 1)! - 1 / 2 * log(2 * n) - n * log ((n + 1) / e)`. +-/ +lemma log_stirling_seq_formula (n : ℕ) : log (stirling_seq n.succ) = + log n.succ!- 1 / 2 * log (2 * n.succ) - n.succ * log (n.succ / exp 1) := +by rw [stirling_seq, log_div, log_mul, sqrt_eq_rpow, log_rpow, real.log_pow, tsub_tsub]; + try { apply ne_of_gt }; positivity -- TODO: Make `positivity` handle `≠ 0` goals + +/-- +The sequence `log (stirling_seq (m + 1)) - log (stirling_seq (m + 2))` has the series expansion + `∑ 1 / (2 * (k + 1) + 1) * (1 / 2 * (m + 1) + 1)^(2 * (k + 1))` +-/ +lemma log_stirling_seq_diff_has_sum (m : ℕ) : + has_sum (λ k : ℕ, (1 : ℝ) / (2 * k.succ + 1) * ((1 / (2 * m.succ + 1)) ^ 2) ^ k.succ) + (log (stirling_seq m.succ) - log (stirling_seq m.succ.succ)) := +begin + change has_sum ((λ b : ℕ, 1 / (2 * (b : ℝ) + 1) * ((1 / (2 * m.succ + 1)) ^ 2) ^ b) ∘ succ) _, + refine (has_sum_nat_add_iff 1).mpr _, + convert (has_sum_log_one_add_inv $ cast_pos.mpr (succ_pos m)).mul_left ((m.succ : ℝ) + 1 / 2), + { ext k, + rw [← pow_mul, pow_add], + push_cast, + have : 2 * (k : ℝ) + 1 ≠ 0, {norm_cast, exact succ_ne_zero (2*k)}, + have : 2 * ((m : ℝ) + 1) + 1 ≠ 0, {norm_cast, exact succ_ne_zero (2*m.succ)}, + field_simp, + ring }, + { have h : ∀ (x : ℝ) (hx : x ≠ 0), 1 + x⁻¹ = (x + 1) / x, + { intros, rw [_root_.add_div, div_self hx, inv_eq_one_div], }, + simp only [log_stirling_seq_formula, log_div, log_mul, log_exp, factorial_succ, cast_mul, + cast_succ, cast_zero, range_one, sum_singleton, h] { discharger := + `[norm_cast, apply_rules [mul_ne_zero, succ_ne_zero, factorial_ne_zero, exp_ne_zero]] }, + ring }, +end + +/-- The sequence `log ∘ stirling_seq ∘ succ` is monotone decreasing -/ +lemma log_stirling_seq'_antitone : antitone (real.log ∘ stirling_seq ∘ succ) := +antitone_nat_of_succ_le $ λ n, sub_nonneg.mp $ (log_stirling_seq_diff_has_sum n).nonneg $ λ m, + by positivity + +/-- +We have a bound for successive elements in the sequence `log (stirling_seq k)`. +-/ +lemma log_stirling_seq_diff_le_geo_sum (n : ℕ) : + log (stirling_seq n.succ) - log (stirling_seq n.succ.succ) ≤ + (1 / (2 * n.succ + 1)) ^ 2 / (1 - (1 / (2 * n.succ + 1)) ^ 2) := +begin + have h_nonneg : 0 ≤ ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) := sq_nonneg _, + have g : has_sum (λ k : ℕ, ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2) ^ k.succ) + ((1 / (2 * n.succ + 1)) ^ 2 / (1 - (1 / (2 * n.succ + 1)) ^ 2)), + { have := (has_sum_geometric_of_lt_1 h_nonneg _).mul_left ((1 / (2 * (n.succ : ℝ) + 1)) ^ 2), + { simp_rw ←pow_succ at this, + exact this, }, + rw [one_div, inv_pow], + exact inv_lt_one (one_lt_pow ((lt_add_iff_pos_left 1).mpr $ by positivity) two_ne_zero) }, + have hab : ∀ (k : ℕ), (1 / (2 * (k.succ : ℝ) + 1)) * ((1 / (2 * n.succ + 1)) ^ 2) ^ k.succ ≤ + ((1 / (2 * n.succ + 1)) ^ 2) ^ k.succ, + { refine λ k, mul_le_of_le_one_left (pow_nonneg h_nonneg k.succ) _, + rw one_div, + exact inv_le_one (le_add_of_nonneg_left $ by positivity) }, + exact has_sum_le hab (log_stirling_seq_diff_has_sum n) g, +end + +/-- +We have the bound `log (stirling_seq n) - log (stirling_seq (n+1))` ≤ 1/(4 n^2) +-/ +lemma log_stirling_seq_sub_log_stirling_seq_succ (n : ℕ) : + log (stirling_seq n.succ) - log (stirling_seq n.succ.succ) ≤ 1 / (4 * n.succ ^ 2) := +begin + have h₁ : 0 < 4 * ((n : ℝ) + 1) ^ 2 := by positivity, + have h₃ : 0 < (2 * ((n : ℝ) + 1) + 1) ^ 2 := by positivity, + have h₂ : 0 < 1 - (1 / (2 * ((n : ℝ) + 1) + 1)) ^ 2, + { rw ← mul_lt_mul_right h₃, + have H : 0 < (2 * ((n : ℝ) + 1) + 1) ^ 2 - 1 := by nlinarith [@cast_nonneg ℝ _ n], + convert H using 1; field_simp [h₃.ne'] }, + refine (log_stirling_seq_diff_le_geo_sum n).trans _, + push_cast, + rw div_le_div_iff h₂ h₁, + field_simp [h₃.ne'], + rw div_le_div_right h₃, + ring_nf, + norm_cast, + linarith, +end + +/-- For any `n`, we have `log_stirling_seq 1 - log_stirling_seq n ≤ 1/4 * ∑' 1/k^2` -/ +lemma log_stirling_seq_bounded_aux : + ∃ (c : ℝ), ∀ (n : ℕ), log (stirling_seq 1) - log (stirling_seq n.succ) ≤ c := +begin + let d := ∑' k : ℕ, (1 : ℝ) / k.succ ^ 2, + use (1 / 4 * d : ℝ), + let log_stirling_seq' : ℕ → ℝ := λ k, log (stirling_seq k.succ), + intro n, + have h₁ : ∀ k, log_stirling_seq' k - log_stirling_seq' (k + 1) ≤ 1 / 4 * (1 / k.succ ^ 2) := + by { intro k, convert log_stirling_seq_sub_log_stirling_seq_succ k using 1, field_simp, }, + have h₂ : ∑ (k : ℕ) in range n, (1 : ℝ) / (k.succ) ^ 2 ≤ d := by + { exact sum_le_tsum (range n) (λ k _, by positivity) + ((summable_nat_add_iff 1).mpr $ real.summable_one_div_nat_pow.mpr one_lt_two) }, + calc + log (stirling_seq 1) - log (stirling_seq n.succ) = log_stirling_seq' 0 - log_stirling_seq' n : rfl + ... = ∑ k in range n, (log_stirling_seq' k - log_stirling_seq' (k + 1)) : by + rw ← sum_range_sub' log_stirling_seq' n + ... ≤ ∑ k in range n, (1/4) * (1 / k.succ^2) : sum_le_sum (λ k _, h₁ k) + ... = 1 / 4 * ∑ k in range n, 1 / k.succ ^ 2 : by rw mul_sum + ... ≤ 1 / 4 * d : mul_le_mul_of_nonneg_left h₂ $ by positivity, +end + +/-- The sequence `log_stirling_seq` is bounded below for `n ≥ 1`. -/ +lemma log_stirling_seq_bounded_by_constant : ∃ c, ∀ (n : ℕ), c ≤ log (stirling_seq n.succ) := +begin + obtain ⟨d, h⟩ := log_stirling_seq_bounded_aux, + exact ⟨log (stirling_seq 1) - d, λ n, sub_le_comm.mp (h n)⟩, +end + +/-- The sequence `stirling_seq` is positive for `n > 0` -/ +lemma stirling_seq'_pos (n : ℕ) : 0 < stirling_seq n.succ := by { unfold stirling_seq, positivity } + +/-- +The sequence `stirling_seq` has a positive lower bound. +-/ +lemma stirling_seq'_bounded_by_pos_constant : ∃ a, 0 < a ∧ ∀ n : ℕ, a ≤ stirling_seq n.succ := +begin + cases log_stirling_seq_bounded_by_constant with c h, + refine ⟨exp c, exp_pos _, λ n, _⟩, + rw ← le_log_iff_exp_le (stirling_seq'_pos n), + exact h n, +end + +/-- The sequence `stirling_seq ∘ succ` is monotone decreasing -/ +lemma stirling_seq'_antitone : antitone (stirling_seq ∘ succ) := +λ n m h, (log_le_log (stirling_seq'_pos m) (stirling_seq'_pos n)).mp (log_stirling_seq'_antitone h) + +/-- The limit `a` of the sequence `stirling_seq` satisfies `0 < a` -/ +lemma stirling_seq_has_pos_limit_a : + ∃ (a : ℝ), 0 < a ∧ tendsto stirling_seq at_top (𝓝 a) := +begin + obtain ⟨x, x_pos, hx⟩ := stirling_seq'_bounded_by_pos_constant, + have hx' : x ∈ lower_bounds (set.range (stirling_seq ∘ succ)) := by simpa [lower_bounds] using hx, + refine ⟨_, lt_of_lt_of_le x_pos (le_cInf (set.range_nonempty _) hx'), _⟩, + rw ←filter.tendsto_add_at_top_iff_nat 1, + exact tendsto_at_top_cinfi stirling_seq'_antitone ⟨x, hx'⟩, +end + +/-! + ### Part 2 + https://proofwiki.org/wiki/Stirling%27s_Formula#Part_2 +-/ + +/-- The sequence `n / (2 * n + 1)` tends to `1/2` -/ +lemma tendsto_self_div_two_mul_self_add_one : + tendsto (λ (n : ℕ), (n : ℝ) / (2 * n + 1)) at_top (𝓝 (1 / 2)) := +begin + conv { congr, skip, skip, rw [one_div, ←add_zero (2 : ℝ)] }, + refine (((tendsto_const_div_at_top_nhds_0_nat 1).const_add (2 : ℝ)).inv₀ + ((add_zero (2 : ℝ)).symm ▸ two_ne_zero)).congr' (eventually_at_top.mpr ⟨1, λ n hn, _⟩), + rw [add_div' (1 : ℝ) 2 n (cast_ne_zero.mpr (one_le_iff_ne_zero.mp hn)), inv_div], +end + +/-- For any `n ≠ 0`, we have the identity +`(stirling_seq n)^4 / (stirling_seq (2*n))^2 * (n / (2 * n + 1)) = W n`, where `W n` is the +`n`-th partial product of Wallis' formula for `π / 2`. -/ +lemma stirling_seq_pow_four_div_stirling_seq_pow_two_eq (n : ℕ) (hn : n ≠ 0) : + ((stirling_seq n) ^ 4 / (stirling_seq (2 * n)) ^ 2) * (n / (2 * n + 1)) = wallis.W n := +begin + rw [bit0_eq_two_mul, stirling_seq, pow_mul, stirling_seq, wallis.W_eq_factorial_ratio], + simp_rw [div_pow, mul_pow], + rw [sq_sqrt, sq_sqrt], + any_goals { positivity }, + have : (n : ℝ) ≠ 0, from cast_ne_zero.mpr hn, + have : (exp 1) ≠ 0, from exp_ne_zero 1, + have : ((2 * n)!: ℝ) ≠ 0, from cast_ne_zero.mpr (factorial_ne_zero (2 * n)), + have : 2 * (n : ℝ) + 1 ≠ 0, by {norm_cast, exact succ_ne_zero (2*n)}, + field_simp, + simp only [mul_pow, mul_comm 2 n, mul_comm 4 n, pow_mul], + ring, +end + +/-- +Suppose the sequence `stirling_seq` (defined above) has the limit `a ≠ 0`. +Then the Wallis sequence `W n` has limit `a^2 / 2`. +-/ +lemma second_wallis_limit (a : ℝ) (hane : a ≠ 0) (ha : tendsto stirling_seq at_top (𝓝 a)) : + tendsto wallis.W at_top (𝓝 (a ^ 2 / 2)):= +begin + refine tendsto.congr' (eventually_at_top.mpr ⟨1, λ n hn, + stirling_seq_pow_four_div_stirling_seq_pow_two_eq n (one_le_iff_ne_zero.mp hn)⟩) _, + have h : a ^ 2 / 2 = (a ^ 4 / a ^ 2) * (1 / 2), + { rw [mul_one_div, ←mul_one_div (a ^ 4) (a ^ 2), one_div, ←pow_sub_of_lt a], + norm_num }, + rw h, + exact ((ha.pow 4).div ((ha.comp (tendsto_id.const_mul_at_top' two_pos)).pow 2) + (pow_ne_zero 2 hane)).mul tendsto_self_div_two_mul_self_add_one, +end + +/-- **Stirling's Formula** -/ +theorem tendsto_stirling_seq_sqrt_pi : tendsto (λ (n : ℕ), stirling_seq n) at_top (𝓝 (sqrt π)) := +begin + obtain ⟨a, hapos, halimit⟩ := stirling_seq_has_pos_limit_a, + have hπ : π / 2 = a ^ 2 / 2 := tendsto_nhds_unique wallis.tendsto_W_nhds_pi_div_two + (second_wallis_limit a hapos.ne' halimit), + rwa [(div_left_inj' (two_ne_zero' ℝ)).mp hπ, sqrt_sq hapos.le], +end + +end stirling diff --git a/src/analysis/special_functions/trigonometric/angle.lean b/src/analysis/special_functions/trigonometric/angle.lean index b98fe6e55476f..ef263b8b5c0ad 100644 --- a/src/analysis/special_functions/trigonometric/angle.lean +++ b/src/analysis/special_functions/trigonometric/angle.lean @@ -4,10 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Calle Sönne -/ import analysis.special_functions.trigonometric.basic +import analysis.normed.group.add_circle +import algebra.char_zero.quotient +import topology.instances.sign /-! # The type of angles +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `real.angle` to be the quotient group `ℝ/2πℤ` and prove a few simple lemmas about trigonometric functions and angles. -/ @@ -19,17 +25,16 @@ noncomputable theory namespace real /-- The type of angles -/ -def angle : Type := -ℝ ⧸ (add_subgroup.zmultiples (2 * π)) +@[derive [normed_add_comm_group, inhabited, has_coe_t ℝ]] +def angle : Type := add_circle (2 * π) namespace angle -instance angle.add_comm_group : add_comm_group angle := -quotient_add_group.add_comm_group _ - -instance : inhabited angle := ⟨0⟩ +instance : circular_order real.angle := +@add_circle.circular_order _ _ _ _ _ ⟨by norm_num [pi_pos]⟩ _ -instance : has_coe ℝ angle := ⟨quotient_add_group.mk' _⟩ +@[continuity] lemma continuous_coe : continuous (coe : ℝ → angle) := +continuous_quotient_mk /-- Coercion `ℝ → angle` as an additive homomorphism. -/ def coe_hom : ℝ →+ angle := quotient_add_group.mk' _ @@ -46,6 +51,8 @@ quotient.induction_on' θ h @[simp] lemma coe_add (x y : ℝ) : ↑(x + y : ℝ) = (↑x + ↑y : angle) := rfl @[simp] lemma coe_neg (x : ℝ) : ↑(-x : ℝ) = -(↑x : angle) := rfl @[simp] lemma coe_sub (x y : ℝ) : ↑(x - y : ℝ) = (↑x - ↑y : angle) := rfl +lemma coe_nsmul (n : ℕ) (x : ℝ) : ↑(n • x : ℝ) = (n • ↑x : angle) := rfl +lemma coe_zsmul (z : ℤ) (x : ℝ) : ↑(z • x : ℝ) = (z • ↑x : angle) := rfl @[simp, norm_cast] lemma coe_nat_mul_eq_nsmul (x : ℝ) (n : ℕ) : ↑((n : ℝ) * x) = n • (↑x : angle) := @@ -69,6 +76,18 @@ begin simp [two_mul, sub_eq_add_neg] end +@[simp] lemma two_nsmul_coe_div_two (θ : ℝ) : (2 : ℕ) • (↑(θ / 2) : angle) = θ := +by rw [←coe_nsmul, two_nsmul, add_halves] + +@[simp] lemma two_zsmul_coe_div_two (θ : ℝ) : (2 : ℤ) • (↑(θ / 2) : angle) = θ := +by rw [←coe_zsmul, two_zsmul, add_halves] + +@[simp] lemma two_nsmul_neg_pi_div_two : (2 : ℕ) • (↑(-π / 2) : angle) = π := +by rw [two_nsmul_coe_div_two, coe_neg, neg_coe_pi] + +@[simp] lemma two_zsmul_neg_pi_div_two : (2 : ℤ) • (↑(-π / 2) : angle) = π := +by rw [two_zsmul, ←two_nsmul, two_nsmul_neg_pi_div_two] + lemma sub_coe_pi_eq_add_coe_pi (θ : angle) : θ - π = θ + π := by rw [sub_eq_add_neg, neg_coe_pi] @@ -81,37 +100,90 @@ by simp [←coe_int_mul_eq_zsmul] @[simp] lemma coe_pi_add_coe_pi : (π : real.angle) + π = 0 := by rw [←two_nsmul, two_nsmul_coe_pi] -theorem cos_eq_iff_eq_or_eq_neg {θ ψ : ℝ} : cos θ = cos ψ ↔ (θ : angle) = ψ ∨ (θ : angle) = -ψ := +lemma zsmul_eq_iff {ψ θ : angle} {z : ℤ} (hz : z ≠ 0) : + z • ψ = z • θ ↔ (∃ k : fin z.nat_abs, ψ = θ + (k : ℕ) • (2 * π / z : ℝ)) := +quotient_add_group.zmultiples_zsmul_eq_zsmul_iff hz + +lemma nsmul_eq_iff {ψ θ : angle} {n : ℕ} (hz : n ≠ 0) : + n • ψ = n • θ ↔ (∃ k : fin n, ψ = θ + (k : ℕ) • (2 * π / n : ℝ)) := +quotient_add_group.zmultiples_nsmul_eq_nsmul_iff hz + +lemma two_zsmul_eq_iff {ψ θ : angle} : (2 : ℤ) • ψ = (2 : ℤ) • θ ↔ (ψ = θ ∨ ψ = θ + π) := +by rw [zsmul_eq_iff two_ne_zero, int.nat_abs_bit0, int.nat_abs_one, + fin.exists_fin_two, fin.coe_zero, fin.coe_one, zero_smul, add_zero, one_smul, + int.cast_two, mul_div_cancel_left (_ : ℝ) two_ne_zero] + +lemma two_nsmul_eq_iff {ψ θ : angle} : (2 : ℕ) • ψ = (2 : ℕ) • θ ↔ (ψ = θ ∨ ψ = θ + π) := +by simp_rw [←coe_nat_zsmul, int.coe_nat_bit0, int.coe_nat_one, two_zsmul_eq_iff] + +lemma two_nsmul_eq_zero_iff {θ : angle} : (2 : ℕ) • θ = 0 ↔ (θ = 0 ∨ θ = π) := +by convert two_nsmul_eq_iff; simp + +lemma two_nsmul_ne_zero_iff {θ : angle} : (2 : ℕ) • θ ≠ 0 ↔ θ ≠ 0 ∧ θ ≠ π := +by rw [←not_or_distrib, ←two_nsmul_eq_zero_iff] + +lemma two_zsmul_eq_zero_iff {θ : angle} : (2 : ℤ) • θ = 0 ↔ (θ = 0 ∨ θ = π) := +by simp_rw [two_zsmul, ←two_nsmul, two_nsmul_eq_zero_iff] + +lemma two_zsmul_ne_zero_iff {θ : angle} : (2 : ℤ) • θ ≠ 0 ↔ θ ≠ 0 ∧ θ ≠ π := +by rw [←not_or_distrib, ←two_zsmul_eq_zero_iff] + +lemma eq_neg_self_iff {θ : angle} : θ = -θ ↔ θ = 0 ∨ θ = π := +by rw [←add_eq_zero_iff_eq_neg, ←two_nsmul, two_nsmul_eq_zero_iff] + +lemma ne_neg_self_iff {θ : angle} : θ ≠ -θ ↔ θ ≠ 0 ∧ θ ≠ π := +by rw [←not_or_distrib, ←eq_neg_self_iff.not] + +lemma neg_eq_self_iff {θ : angle} : -θ = θ ↔ θ = 0 ∨ θ = π := +by rw [eq_comm, eq_neg_self_iff] + +lemma neg_ne_self_iff {θ : angle} : -θ ≠ θ ↔ θ ≠ 0 ∧ θ ≠ π := +by rw [←not_or_distrib, ←neg_eq_self_iff.not] + +lemma two_nsmul_eq_pi_iff {θ : angle} : (2 : ℕ) • θ = π ↔ (θ = (π / 2 : ℝ) ∨ θ = (-π / 2 : ℝ)) := +begin + have h : (π : angle) = (2 : ℕ) • (π / 2 : ℝ), { rw [two_nsmul, ←coe_add, add_halves] }, + nth_rewrite 0 h, + rw [two_nsmul_eq_iff], + congr', + rw [add_comm, ←coe_add, ←sub_eq_zero, ←coe_sub, add_sub_assoc, neg_div, sub_neg_eq_add, + add_halves, ←two_mul, coe_two_pi] +end + +lemma two_zsmul_eq_pi_iff {θ : angle} : (2 : ℤ) • θ = π ↔ (θ = (π / 2 : ℝ) ∨ θ = (-π / 2 : ℝ)) := +by rw [two_zsmul, ←two_nsmul, two_nsmul_eq_pi_iff] + +theorem cos_eq_iff_coe_eq_or_eq_neg {θ ψ : ℝ} : + cos θ = cos ψ ↔ (θ : angle) = ψ ∨ (θ : angle) = -ψ := begin split, { intro Hcos, rw [← sub_eq_zero, cos_sub_cos, mul_eq_zero, mul_eq_zero, neg_eq_zero, - eq_false_intro two_ne_zero, false_or, sin_eq_zero_iff, sin_eq_zero_iff] at Hcos, + eq_false_intro (two_ne_zero' ℝ), false_or, sin_eq_zero_iff, sin_eq_zero_iff] at Hcos, rcases Hcos with ⟨n, hn⟩ | ⟨n, hn⟩, { right, - rw [eq_div_iff_mul_eq (@two_ne_zero ℝ _ _), ← sub_eq_iff_eq_add] at hn, + rw [eq_div_iff_mul_eq (two_ne_zero' ℝ), ← sub_eq_iff_eq_add] at hn, rw [← hn, coe_sub, eq_neg_iff_add_eq_zero, sub_add_cancel, mul_assoc, coe_int_mul_eq_zsmul, mul_comm, coe_two_pi, zsmul_zero] }, { left, - rw [eq_div_iff_mul_eq (@two_ne_zero ℝ _ _), eq_sub_iff_add_eq] at hn, + rw [eq_div_iff_mul_eq (two_ne_zero' ℝ), eq_sub_iff_add_eq] at hn, rw [← hn, coe_add, mul_assoc, - coe_int_mul_eq_zsmul, mul_comm, coe_two_pi, zsmul_zero, zero_add] }, - apply_instance, }, + coe_int_mul_eq_zsmul, mul_comm, coe_two_pi, zsmul_zero, zero_add] }, }, { rw [angle_eq_iff_two_pi_dvd_sub, ← coe_neg, angle_eq_iff_two_pi_dvd_sub], rintro (⟨k, H⟩ | ⟨k, H⟩), rw [← sub_eq_zero, cos_sub_cos, H, mul_assoc 2 π k, - mul_div_cancel_left _ (@two_ne_zero ℝ _ _), mul_comm π _, sin_int_mul_pi, mul_zero], + mul_div_cancel_left _ (two_ne_zero' ℝ), mul_comm π _, sin_int_mul_pi, mul_zero], rw [← sub_eq_zero, cos_sub_cos, ← sub_neg_eq_add, H, mul_assoc 2 π k, - mul_div_cancel_left _ (@two_ne_zero ℝ _ _), mul_comm π _, sin_int_mul_pi, mul_zero, + mul_div_cancel_left _ (two_ne_zero' ℝ), mul_comm π _, sin_int_mul_pi, mul_zero, zero_mul] } end -theorem sin_eq_iff_eq_or_add_eq_pi {θ ψ : ℝ} : +theorem sin_eq_iff_coe_eq_or_add_eq_pi {θ ψ : ℝ} : sin θ = sin ψ ↔ (θ : angle) = ψ ∨ (θ : angle) + ψ = π := begin split, { intro Hsin, rw [← cos_pi_div_two_sub, ← cos_pi_div_two_sub] at Hsin, - cases cos_eq_iff_eq_or_eq_neg.mp Hsin with h h, + cases cos_eq_iff_coe_eq_or_eq_neg.mp Hsin with h h, { left, rw [coe_sub, coe_sub] at h, exact sub_right_inj.1 h }, right, rw [coe_sub, coe_sub, eq_neg_iff_add_eq_zero, add_sub, sub_add_eq_add_sub, ← coe_add, add_halves, sub_sub, sub_eq_zero] at h, @@ -119,21 +191,21 @@ begin { rw [angle_eq_iff_two_pi_dvd_sub, ←eq_sub_iff_add_eq, ←coe_sub, angle_eq_iff_two_pi_dvd_sub], rintro (⟨k, H⟩ | ⟨k, H⟩), rw [← sub_eq_zero, sin_sub_sin, H, mul_assoc 2 π k, - mul_div_cancel_left _ (@two_ne_zero ℝ _ _), mul_comm π _, sin_int_mul_pi, mul_zero, + mul_div_cancel_left _ (two_ne_zero' ℝ), mul_comm π _, sin_int_mul_pi, mul_zero, zero_mul], have H' : θ + ψ = (2 * k) * π + π := by rwa [←sub_add, sub_add_eq_add_sub, sub_eq_iff_eq_add, mul_assoc, mul_comm π _, ←mul_assoc] at H, rw [← sub_eq_zero, sin_sub_sin, H', add_div, mul_assoc 2 _ π, - mul_div_cancel_left _ (@two_ne_zero ℝ _ _), cos_add_pi_div_two, sin_int_mul_pi, neg_zero, + mul_div_cancel_left _ (two_ne_zero' ℝ), cos_add_pi_div_two, sin_int_mul_pi, neg_zero, mul_zero] } end theorem cos_sin_inj {θ ψ : ℝ} (Hcos : cos θ = cos ψ) (Hsin : sin θ = sin ψ) : (θ : angle) = ψ := begin - cases cos_eq_iff_eq_or_eq_neg.mp Hcos with hc hc, { exact hc }, - cases sin_eq_iff_eq_or_add_eq_pi.mp Hsin with hs hs, { exact hs }, + cases cos_eq_iff_coe_eq_or_eq_neg.mp Hcos with hc hc, { exact hc }, + cases sin_eq_iff_coe_eq_or_add_eq_pi.mp Hsin with hs hs, { exact hs }, rw [eq_neg_iff_add_eq_zero, hs] at hc, - cases quotient.exact' hc with n hn, change n • _ = _ at hn, + obtain ⟨n, hn⟩ : ∃ n, n • _ = _ := quotient_add_group.left_rel_apply.mp (quotient.exact' hc), rw [← neg_one_mul, add_zero, ← sub_eq_zero, zsmul_eq_mul, ← mul_assoc, ← sub_mul, mul_eq_zero, eq_false_intro (ne_of_gt pi_pos), or_false, sub_neg_eq_add, ← int.cast_zero, ← int.cast_one, ← int.cast_bit0, ← int.cast_mul, ← int.cast_add, @@ -149,12 +221,695 @@ def sin (θ : angle) : ℝ := sin_periodic.lift θ @[simp] lemma sin_coe (x : ℝ) : sin (x : angle) = real.sin x := rfl +@[continuity] lemma continuous_sin : continuous sin := +real.continuous_sin.quotient_lift_on' _ + /-- The cosine of a `real.angle`. -/ def cos (θ : angle) : ℝ := cos_periodic.lift θ @[simp] lemma cos_coe (x : ℝ) : cos (x : angle) = real.cos x := rfl +@[continuity] lemma continuous_cos : continuous cos := +real.continuous_cos.quotient_lift_on' _ + +lemma cos_eq_real_cos_iff_eq_or_eq_neg {θ : angle} {ψ : ℝ} : cos θ = real.cos ψ ↔ θ = ψ ∨ θ = -ψ := +begin + induction θ using real.angle.induction_on, + exact cos_eq_iff_coe_eq_or_eq_neg +end + +lemma cos_eq_iff_eq_or_eq_neg {θ ψ : angle} : cos θ = cos ψ ↔ θ = ψ ∨ θ = -ψ := +begin + induction ψ using real.angle.induction_on, + exact cos_eq_real_cos_iff_eq_or_eq_neg +end + +lemma sin_eq_real_sin_iff_eq_or_add_eq_pi {θ : angle} {ψ : ℝ} : + sin θ = real.sin ψ ↔ θ = ψ ∨ θ + ψ = π := +begin + induction θ using real.angle.induction_on, + exact sin_eq_iff_coe_eq_or_add_eq_pi +end + +lemma sin_eq_iff_eq_or_add_eq_pi {θ ψ : angle} : sin θ = sin ψ ↔ θ = ψ ∨ θ + ψ = π := +begin + induction ψ using real.angle.induction_on, + exact sin_eq_real_sin_iff_eq_or_add_eq_pi +end + +@[simp] lemma sin_zero : sin (0 : angle) = 0 := +by rw [←coe_zero, sin_coe, real.sin_zero] + +@[simp] lemma sin_coe_pi : sin (π : angle) = 0 := +by rw [sin_coe, real.sin_pi] + +lemma sin_eq_zero_iff {θ : angle} : sin θ = 0 ↔ θ = 0 ∨ θ = π := +begin + nth_rewrite 0 ←sin_zero, + rw sin_eq_iff_eq_or_add_eq_pi, + simp +end + +lemma sin_ne_zero_iff {θ : angle} : sin θ ≠ 0 ↔ θ ≠ 0 ∧ θ ≠ π := +by rw [←not_or_distrib, ←sin_eq_zero_iff] + +@[simp] lemma sin_neg (θ : angle) : sin (-θ) = -sin θ := +begin + induction θ using real.angle.induction_on, + exact real.sin_neg _ +end + +lemma sin_antiperiodic : function.antiperiodic sin (π : angle) := +begin + intro θ, + induction θ using real.angle.induction_on, + exact real.sin_antiperiodic θ +end + +@[simp] lemma sin_add_pi (θ : angle) : sin (θ + π) = -sin θ := +sin_antiperiodic θ + +@[simp] lemma sin_sub_pi (θ : angle) : sin (θ - π) = -sin θ := +sin_antiperiodic.sub_eq θ + +@[simp] lemma cos_zero : cos (0 : angle) = 1 := +by rw [←coe_zero, cos_coe, real.cos_zero] + +@[simp] lemma cos_coe_pi : cos (π : angle) = -1 := +by rw [cos_coe, real.cos_pi] + +@[simp] lemma cos_neg (θ : angle) : cos (-θ) = cos θ := +begin + induction θ using real.angle.induction_on, + exact real.cos_neg _ +end + +lemma cos_antiperiodic : function.antiperiodic cos (π : angle) := +begin + intro θ, + induction θ using real.angle.induction_on, + exact real.cos_antiperiodic θ +end + +@[simp] lemma cos_add_pi (θ : angle) : cos (θ + π) = -cos θ := +cos_antiperiodic θ + +@[simp] lemma cos_sub_pi (θ : angle) : cos (θ - π) = -cos θ := +cos_antiperiodic.sub_eq θ + +lemma cos_eq_zero_iff {θ : angle} : cos θ = 0 ↔ (θ = (π / 2 : ℝ) ∨ θ = (-π / 2 : ℝ)) := +by rw [← cos_pi_div_two, ← cos_coe, cos_eq_iff_eq_or_eq_neg, ← coe_neg, ← neg_div] + +lemma sin_add (θ₁ θ₂ : real.angle) : sin (θ₁ + θ₂) = sin θ₁ * cos θ₂ + cos θ₁ * sin θ₂ := +begin + induction θ₁ using real.angle.induction_on, + induction θ₂ using real.angle.induction_on, + exact real.sin_add θ₁ θ₂ +end + +lemma cos_add (θ₁ θ₂ : real.angle) : cos (θ₁ + θ₂) = cos θ₁ * cos θ₂ - sin θ₁ * sin θ₂ := +begin + induction θ₂ using real.angle.induction_on, + induction θ₁ using real.angle.induction_on, + exact real.cos_add θ₁ θ₂, +end + +@[simp] lemma cos_sq_add_sin_sq (θ : real.angle) : cos θ ^ 2 + sin θ ^ 2 = 1 := +begin + induction θ using real.angle.induction_on, + exact real.cos_sq_add_sin_sq θ, +end + +lemma sin_add_pi_div_two (θ : angle) : sin (θ + ↑(π / 2)) = cos θ := +begin + induction θ using real.angle.induction_on, + exact sin_add_pi_div_two _ +end + +lemma sin_sub_pi_div_two (θ : angle) : sin (θ - ↑(π / 2)) = -cos θ := +begin + induction θ using real.angle.induction_on, + exact sin_sub_pi_div_two _ +end + +lemma sin_pi_div_two_sub (θ : angle) : sin (↑(π / 2) - θ) = cos θ := +begin + induction θ using real.angle.induction_on, + exact sin_pi_div_two_sub _ +end + +lemma cos_add_pi_div_two (θ : angle) : cos (θ + ↑(π / 2)) = -sin θ := +begin + induction θ using real.angle.induction_on, + exact cos_add_pi_div_two _ +end + +lemma cos_sub_pi_div_two (θ : angle) : cos (θ - ↑(π / 2)) = sin θ := +begin + induction θ using real.angle.induction_on, + exact cos_sub_pi_div_two _ +end + +lemma cos_pi_div_two_sub (θ : angle) : cos (↑(π / 2) - θ) = sin θ := +begin + induction θ using real.angle.induction_on, + exact cos_pi_div_two_sub _ +end + +lemma abs_sin_eq_of_two_nsmul_eq {θ ψ : angle} (h : (2 : ℕ) • θ = (2 : ℕ) • ψ) : + |sin θ| = |sin ψ| := +begin + rw two_nsmul_eq_iff at h, + rcases h with rfl | rfl, + { refl }, + { rw [sin_add_pi, abs_neg] } +end + +lemma abs_sin_eq_of_two_zsmul_eq {θ ψ : angle} (h : (2 : ℤ) • θ = (2 : ℤ) • ψ) : + |sin θ| = |sin ψ| := +begin + simp_rw [two_zsmul, ←two_nsmul] at h, + exact abs_sin_eq_of_two_nsmul_eq h +end + +lemma abs_cos_eq_of_two_nsmul_eq {θ ψ : angle} (h : (2 : ℕ) • θ = (2 : ℕ) • ψ) : + |cos θ| = |cos ψ| := +begin + rw two_nsmul_eq_iff at h, + rcases h with rfl | rfl, + { refl }, + { rw [cos_add_pi, abs_neg] } +end + +lemma abs_cos_eq_of_two_zsmul_eq {θ ψ : angle} (h : (2 : ℤ) • θ = (2 : ℤ) • ψ) : + |cos θ| = |cos ψ| := +begin + simp_rw [two_zsmul, ←two_nsmul] at h, + exact abs_cos_eq_of_two_nsmul_eq h +end + +@[simp] lemma coe_to_Ico_mod (θ ψ : ℝ) : ↑(to_Ico_mod two_pi_pos ψ θ) = (θ : angle) := +begin + rw angle_eq_iff_two_pi_dvd_sub, + refine ⟨-to_Ico_div two_pi_pos ψ θ, _⟩, + rw [to_Ico_mod_sub_self, zsmul_eq_mul, mul_comm] +end + +@[simp] lemma coe_to_Ioc_mod (θ ψ : ℝ) : ↑(to_Ioc_mod two_pi_pos ψ θ) = (θ : angle) := +begin + rw angle_eq_iff_two_pi_dvd_sub, + refine ⟨-to_Ioc_div two_pi_pos ψ θ, _⟩, + rw [to_Ioc_mod_sub_self, zsmul_eq_mul, mul_comm] +end + +/-- Convert a `real.angle` to a real number in the interval `Ioc (-π) π`. -/ +def to_real (θ : angle) : ℝ := +(to_Ioc_mod_periodic two_pi_pos (-π)).lift θ + +lemma to_real_coe (θ : ℝ) : (θ : angle).to_real = to_Ioc_mod two_pi_pos (-π) θ := rfl + +lemma to_real_coe_eq_self_iff {θ : ℝ} : (θ : angle).to_real = θ ↔ -π < θ ∧ θ ≤ π := +begin + rw [to_real_coe, to_Ioc_mod_eq_self two_pi_pos], + ring_nf +end + +lemma to_real_coe_eq_self_iff_mem_Ioc {θ : ℝ} : (θ : angle).to_real = θ ↔ θ ∈ set.Ioc (-π) π := +by rw [to_real_coe_eq_self_iff, ←set.mem_Ioc] + +lemma to_real_injective : function.injective to_real := +begin + intros θ ψ h, + induction θ using real.angle.induction_on, + induction ψ using real.angle.induction_on, + simpa [to_real_coe, to_Ioc_mod_eq_to_Ioc_mod, zsmul_eq_mul, mul_comm _ (2 * π), + ←angle_eq_iff_two_pi_dvd_sub, eq_comm] using h, +end + +@[simp] lemma to_real_inj {θ ψ : angle} : θ.to_real = ψ.to_real ↔ θ = ψ := +to_real_injective.eq_iff + +@[simp] lemma coe_to_real (θ : angle): (θ.to_real : angle) = θ := +begin + induction θ using real.angle.induction_on, + exact coe_to_Ioc_mod _ _ +end + +lemma neg_pi_lt_to_real (θ : angle) : -π < θ.to_real := +begin + induction θ using real.angle.induction_on, + exact left_lt_to_Ioc_mod _ _ _ +end + +lemma to_real_le_pi (θ : angle) : θ.to_real ≤ π := +begin + induction θ using real.angle.induction_on, + convert to_Ioc_mod_le_right two_pi_pos _ _, + ring +end + +lemma abs_to_real_le_pi (θ : angle) : |θ.to_real| ≤ π := +abs_le.2 ⟨(neg_pi_lt_to_real _).le, to_real_le_pi _⟩ + +lemma to_real_mem_Ioc (θ : angle) : θ.to_real ∈ set.Ioc (-π) π := +⟨neg_pi_lt_to_real _, to_real_le_pi _⟩ + +@[simp] lemma to_Ioc_mod_to_real (θ : angle): to_Ioc_mod two_pi_pos (-π) θ.to_real = θ.to_real := +begin + induction θ using real.angle.induction_on, + rw to_real_coe, + exact to_Ioc_mod_to_Ioc_mod _ _ _ _ +end + +@[simp] lemma to_real_zero : (0 : angle).to_real = 0 := +begin + rw [←coe_zero, to_real_coe_eq_self_iff], + exact ⟨(left.neg_neg_iff.2 real.pi_pos), real.pi_pos.le⟩ +end + +@[simp] lemma to_real_eq_zero_iff {θ : angle} : θ.to_real = 0 ↔ θ = 0 := +begin + nth_rewrite 0 ←to_real_zero, + exact to_real_inj +end + +@[simp] lemma to_real_pi : (π : angle).to_real = π := +begin + rw [to_real_coe_eq_self_iff], + exact ⟨left.neg_lt_self real.pi_pos, le_refl _⟩ +end + +@[simp] lemma to_real_eq_pi_iff {θ : angle} : θ.to_real = π ↔ θ = π := +by rw [← to_real_inj, to_real_pi] + +lemma pi_ne_zero : (π : angle) ≠ 0 := +begin + rw [←to_real_injective.ne_iff, to_real_pi, to_real_zero], + exact pi_ne_zero +end + +@[simp] lemma to_real_pi_div_two : ((π / 2 : ℝ) : angle).to_real = π / 2 := +to_real_coe_eq_self_iff.2 $ by split; linarith [pi_pos] + +@[simp] lemma to_real_eq_pi_div_two_iff {θ : angle} : θ.to_real = π / 2 ↔ θ = (π / 2 : ℝ) := +by rw [← to_real_inj, to_real_pi_div_two] + +@[simp] lemma to_real_neg_pi_div_two : ((-π / 2 : ℝ) : angle).to_real = -π / 2 := +to_real_coe_eq_self_iff.2 $ by split; linarith [pi_pos] + +@[simp] lemma to_real_eq_neg_pi_div_two_iff {θ : angle} : θ.to_real = -π / 2 ↔ θ = (-π / 2 : ℝ) := +by rw [← to_real_inj, to_real_neg_pi_div_two] + +lemma pi_div_two_ne_zero : ((π / 2 : ℝ) : angle) ≠ 0 := +begin + rw [←to_real_injective.ne_iff, to_real_pi_div_two, to_real_zero], + exact div_ne_zero real.pi_ne_zero two_ne_zero +end + +lemma neg_pi_div_two_ne_zero : ((-π / 2 : ℝ) : angle) ≠ 0 := +begin + rw [←to_real_injective.ne_iff, to_real_neg_pi_div_two, to_real_zero], + exact div_ne_zero (neg_ne_zero.2 real.pi_ne_zero) two_ne_zero +end + +lemma abs_to_real_coe_eq_self_iff {θ : ℝ} : |(θ : angle).to_real| = θ ↔ 0 ≤ θ ∧ θ ≤ π := +⟨λ h, h ▸ ⟨abs_nonneg _, abs_to_real_le_pi _⟩, λ h, + (to_real_coe_eq_self_iff.2 ⟨(left.neg_neg_iff.2 real.pi_pos).trans_le h.1, h.2⟩).symm ▸ + abs_eq_self.2 h.1⟩ + +lemma abs_to_real_neg_coe_eq_self_iff {θ : ℝ} : |(-θ : angle).to_real| = θ ↔ 0 ≤ θ ∧ θ ≤ π := +begin + refine ⟨λ h, h ▸ ⟨abs_nonneg _, abs_to_real_le_pi _⟩, λ h, _⟩, + by_cases hnegpi : θ = π, { simp [hnegpi, real.pi_pos.le] }, + rw [←coe_neg, to_real_coe_eq_self_iff.2 ⟨neg_lt_neg (lt_of_le_of_ne h.2 hnegpi), + (neg_nonpos.2 h.1).trans real.pi_pos.le⟩, abs_neg, + abs_eq_self.2 h.1] +end + +lemma abs_to_real_eq_pi_div_two_iff {θ : angle} : + |θ.to_real| = π / 2 ↔ (θ = (π / 2 : ℝ) ∨ θ = (-π / 2 : ℝ)) := +by rw [abs_eq (div_nonneg real.pi_pos.le two_pos.le), ←neg_div, to_real_eq_pi_div_two_iff, + to_real_eq_neg_pi_div_two_iff] + +lemma nsmul_to_real_eq_mul {n : ℕ} (h : n ≠ 0) {θ : angle} : + (n • θ).to_real = n * θ.to_real ↔ θ.to_real ∈ set.Ioc (-π / n) (π / n) := +begin + nth_rewrite 0 ←coe_to_real θ, + have h' : 0 < (n : ℝ), { exact_mod_cast nat.pos_of_ne_zero h }, + rw [←coe_nsmul, nsmul_eq_mul, to_real_coe_eq_self_iff, set.mem_Ioc, div_lt_iff' h', + le_div_iff' h'] +end + +lemma two_nsmul_to_real_eq_two_mul {θ : angle} : + ((2 : ℕ) • θ).to_real = 2 * θ.to_real ↔ θ.to_real ∈ set.Ioc (-π / 2) (π / 2) := +by exact_mod_cast nsmul_to_real_eq_mul two_ne_zero + +lemma two_zsmul_to_real_eq_two_mul {θ : angle} : + ((2 : ℤ) • θ).to_real = 2 * θ.to_real ↔ θ.to_real ∈ set.Ioc (-π / 2) (π / 2) := +by rw [two_zsmul, ←two_nsmul, two_nsmul_to_real_eq_two_mul] + +lemma to_real_coe_eq_self_sub_two_mul_int_mul_pi_iff {θ : ℝ} {k : ℤ} : + (θ : angle).to_real = θ - 2 * k * π ↔ θ ∈ set.Ioc ((2 * k - 1 : ℝ) * π) ((2 * k + 1) * π) := +begin + rw [←sub_zero (θ : angle), ←zsmul_zero k, ←coe_two_pi, ←coe_zsmul, ←coe_sub, + zsmul_eq_mul, ←mul_assoc, mul_comm (k : ℝ), to_real_coe_eq_self_iff, set.mem_Ioc], + exact ⟨λ h, ⟨by linarith, by linarith⟩, λ h, ⟨by linarith, by linarith⟩⟩ +end + +lemma to_real_coe_eq_self_sub_two_pi_iff {θ : ℝ} : + (θ : angle).to_real = θ - 2 * π ↔ θ ∈ set.Ioc π (3 * π) := +by { convert @to_real_coe_eq_self_sub_two_mul_int_mul_pi_iff θ 1; norm_num } + +lemma to_real_coe_eq_self_add_two_pi_iff {θ : ℝ} : + (θ : angle).to_real = θ + 2 * π ↔ θ ∈ set.Ioc (-3 * π) (-π) := +by { convert @to_real_coe_eq_self_sub_two_mul_int_mul_pi_iff θ (-1); norm_num } + +lemma two_nsmul_to_real_eq_two_mul_sub_two_pi {θ : angle} : + ((2 : ℕ) • θ).to_real = 2 * θ.to_real - 2 * π ↔ π / 2 < θ.to_real := +begin + nth_rewrite 0 ←coe_to_real θ, + rw [←coe_nsmul, two_nsmul, ←two_mul, to_real_coe_eq_self_sub_two_pi_iff, set.mem_Ioc], + exact ⟨λ h, by linarith, + λ h, ⟨(div_lt_iff' (zero_lt_two' ℝ)).1 h, by linarith [pi_pos, to_real_le_pi θ]⟩⟩ +end + +lemma two_zsmul_to_real_eq_two_mul_sub_two_pi {θ : angle} : + ((2 : ℤ) • θ).to_real = 2 * θ.to_real - 2 * π ↔ π / 2 < θ.to_real := +by rw [two_zsmul, ←two_nsmul, two_nsmul_to_real_eq_two_mul_sub_two_pi] + +lemma two_nsmul_to_real_eq_two_mul_add_two_pi {θ : angle} : + ((2 : ℕ) • θ).to_real = 2 * θ.to_real + 2 * π ↔ θ.to_real ≤ -π / 2 := +begin + nth_rewrite 0 ←coe_to_real θ, + rw [←coe_nsmul, two_nsmul, ←two_mul, to_real_coe_eq_self_add_two_pi_iff, set.mem_Ioc], + refine ⟨λ h, by linarith, + λ h, ⟨by linarith [pi_pos, neg_pi_lt_to_real θ], (le_div_iff' (zero_lt_two' ℝ)).1 h⟩⟩ +end + +lemma two_zsmul_to_real_eq_two_mul_add_two_pi {θ : angle} : + ((2 : ℤ) • θ).to_real = 2 * θ.to_real + 2 * π ↔ θ.to_real ≤ -π / 2 := +by rw [two_zsmul, ←two_nsmul, two_nsmul_to_real_eq_two_mul_add_two_pi] + +@[simp] lemma sin_to_real (θ : angle) : real.sin θ.to_real = sin θ := +by conv_rhs { rw [← coe_to_real θ, sin_coe] } + +@[simp] lemma cos_to_real (θ : angle) : real.cos θ.to_real = cos θ := +by conv_rhs { rw [← coe_to_real θ, cos_coe] } + +lemma cos_nonneg_iff_abs_to_real_le_pi_div_two {θ : angle} : 0 ≤ cos θ ↔ |θ.to_real| ≤ π / 2 := +begin + nth_rewrite 0 ←coe_to_real θ, + rw [abs_le, cos_coe], + refine ⟨λ h, _, cos_nonneg_of_mem_Icc⟩, + by_contra hn, + rw [not_and_distrib, not_le, not_le] at hn, + refine (not_lt.2 h) _, + rcases hn with hn | hn, + { rw ←real.cos_neg, + refine cos_neg_of_pi_div_two_lt_of_lt (by linarith) _, + linarith [neg_pi_lt_to_real θ] }, + { refine cos_neg_of_pi_div_two_lt_of_lt hn _, + linarith [to_real_le_pi θ] } +end + +lemma cos_pos_iff_abs_to_real_lt_pi_div_two {θ : angle} : 0 < cos θ ↔ |θ.to_real| < π / 2 := +begin + rw [lt_iff_le_and_ne, lt_iff_le_and_ne, cos_nonneg_iff_abs_to_real_le_pi_div_two, + ←and_congr_right], + rintro -, + rw [ne.def, ne.def, not_iff_not, @eq_comm ℝ 0, abs_to_real_eq_pi_div_two_iff, cos_eq_zero_iff] +end + +lemma cos_neg_iff_pi_div_two_lt_abs_to_real {θ : angle} : cos θ < 0 ↔ π / 2 < |θ.to_real| := +by rw [←not_le, ←not_le, not_iff_not, cos_nonneg_iff_abs_to_real_le_pi_div_two] + +lemma abs_cos_eq_abs_sin_of_two_nsmul_add_two_nsmul_eq_pi {θ ψ : angle} + (h : (2 : ℕ) • θ + (2 : ℕ) • ψ = π) : |cos θ| = |sin ψ| := +begin + rw [←eq_sub_iff_add_eq, ←two_nsmul_coe_div_two, ←nsmul_sub, two_nsmul_eq_iff] at h, + rcases h with rfl | rfl; + simp [cos_pi_div_two_sub] +end + +lemma abs_cos_eq_abs_sin_of_two_zsmul_add_two_zsmul_eq_pi {θ ψ : angle} + (h : (2 : ℤ) • θ + (2 : ℤ) • ψ = π) : |cos θ| = |sin ψ| := +begin + simp_rw [two_zsmul, ←two_nsmul] at h, + exact abs_cos_eq_abs_sin_of_two_nsmul_add_two_nsmul_eq_pi h +end + +/-- The tangent of a `real.angle`. -/ +def tan (θ : angle) : ℝ := sin θ / cos θ + +lemma tan_eq_sin_div_cos (θ : angle) : tan θ = sin θ / cos θ := rfl + +@[simp] lemma tan_coe (x : ℝ) : tan (x : angle) = real.tan x := +by rw [tan, sin_coe, cos_coe, real.tan_eq_sin_div_cos] + +@[simp] lemma tan_zero : tan (0 : angle) = 0 := +by rw [←coe_zero, tan_coe, real.tan_zero] + +@[simp] lemma tan_coe_pi : tan (π : angle) = 0 := +by rw [tan_eq_sin_div_cos, sin_coe_pi, zero_div] + +lemma tan_periodic : function.periodic tan (π : angle) := +begin + intro θ, + induction θ using real.angle.induction_on, + rw [←coe_add, tan_coe, tan_coe], + exact real.tan_periodic θ +end + +@[simp] lemma tan_add_pi (θ : angle) : tan (θ + π) = tan θ := +tan_periodic θ + +@[simp] lemma tan_sub_pi (θ : angle) : tan (θ - π) = tan θ := +tan_periodic.sub_eq θ + +@[simp] lemma tan_to_real (θ : angle) : real.tan θ.to_real = tan θ := +by conv_rhs { rw [←coe_to_real θ, tan_coe] } + +lemma tan_eq_of_two_nsmul_eq {θ ψ : angle} (h : (2 : ℕ) • θ = (2 : ℕ) • ψ) : tan θ = tan ψ := +begin + rw two_nsmul_eq_iff at h, + rcases h with rfl | rfl, + { refl }, + { exact tan_add_pi _ } +end + +lemma tan_eq_of_two_zsmul_eq {θ ψ : angle} (h : (2 : ℤ) • θ = (2 : ℤ) • ψ) : tan θ = tan ψ := +begin + simp_rw [two_zsmul, ←two_nsmul] at h, + exact tan_eq_of_two_nsmul_eq h +end + +lemma tan_eq_inv_of_two_nsmul_add_two_nsmul_eq_pi {θ ψ : angle} + (h : (2 : ℕ) • θ + (2 : ℕ) • ψ = π) : tan ψ = (tan θ)⁻¹ := +begin + induction θ using real.angle.induction_on, + induction ψ using real.angle.induction_on, + rw [←smul_add, ←coe_add, ←coe_nsmul, two_nsmul, ←two_mul, angle_eq_iff_two_pi_dvd_sub] at h, + rcases h with ⟨k, h⟩, + rw [sub_eq_iff_eq_add, ←mul_inv_cancel_left₀ two_ne_zero π, mul_assoc, ←mul_add, + mul_right_inj' (two_ne_zero' ℝ), ←eq_sub_iff_add_eq', + mul_inv_cancel_left₀ two_ne_zero π, inv_mul_eq_div, mul_comm] at h, + rw [tan_coe, tan_coe, ←tan_pi_div_two_sub, h, add_sub_assoc, add_comm], + exact real.tan_periodic.int_mul _ _ +end + +lemma tan_eq_inv_of_two_zsmul_add_two_zsmul_eq_pi {θ ψ : angle} + (h : (2 : ℤ) • θ + (2 : ℤ) • ψ = π) : tan ψ = (tan θ)⁻¹ := +begin + simp_rw [two_zsmul, ←two_nsmul] at h, + exact tan_eq_inv_of_two_nsmul_add_two_nsmul_eq_pi h +end + +/-- The sign of a `real.angle` is `0` if the angle is `0` or `π`, `1` if the angle is strictly +between `0` and `π` and `-1` is the angle is strictly between `-π` and `0`. It is defined as the +sign of the sine of the angle. -/ +def sign (θ : angle) : sign_type := sign (sin θ) + +@[simp] lemma sign_zero : (0 : angle).sign = 0 := +by rw [sign, sin_zero, sign_zero] + +@[simp] lemma sign_coe_pi : (π : angle).sign = 0 := +by rw [sign, sin_coe_pi, _root_.sign_zero] + +@[simp] lemma sign_neg (θ : angle) : (-θ).sign = - θ.sign := +by simp_rw [sign, sin_neg, left.sign_neg] + +lemma sign_antiperiodic : function.antiperiodic sign (π : angle) := +λ θ, by rw [sign, sign, sin_add_pi, left.sign_neg] + +@[simp] lemma sign_add_pi (θ : angle) : (θ + π).sign = -θ.sign := +sign_antiperiodic θ + +@[simp] lemma sign_pi_add (θ : angle) : ((π : angle) + θ).sign = -θ.sign := +by rw [add_comm, sign_add_pi] + +@[simp] lemma sign_sub_pi (θ : angle) : (θ - π).sign = -θ.sign := +sign_antiperiodic.sub_eq θ + +@[simp] lemma sign_pi_sub (θ : angle) : ((π : angle) - θ).sign = θ.sign := +by simp [sign_antiperiodic.sub_eq'] + +lemma sign_eq_zero_iff {θ : angle} : θ.sign = 0 ↔ θ = 0 ∨ θ = π := +by rw [sign, sign_eq_zero_iff, sin_eq_zero_iff] + +lemma sign_ne_zero_iff {θ : angle} : θ.sign ≠ 0 ↔ θ ≠ 0 ∧ θ ≠ π := +by rw [←not_or_distrib, ←sign_eq_zero_iff] + +lemma to_real_neg_iff_sign_neg {θ : angle} : θ.to_real < 0 ↔ θ.sign = -1 := +begin + rw [sign, ←sin_to_real, sign_eq_neg_one_iff], + rcases lt_trichotomy θ.to_real 0 with (h|h|h), + { exact ⟨λ _, real.sin_neg_of_neg_of_neg_pi_lt h (neg_pi_lt_to_real θ), λ _, h⟩ }, + { simp [h] }, + { exact ⟨λ hn, false.elim (h.asymm hn), + λ hn, false.elim (hn.not_le (sin_nonneg_of_nonneg_of_le_pi h.le (to_real_le_pi θ)))⟩ } +end + +lemma to_real_nonneg_iff_sign_nonneg {θ : angle} : 0 ≤ θ.to_real ↔ 0 ≤ θ.sign := +begin + rcases lt_trichotomy θ.to_real 0 with (h|h|h), + { refine ⟨λ hn, false.elim (h.not_le hn), λ hn, _⟩, + rw [to_real_neg_iff_sign_neg.1 h] at hn, + exact false.elim (hn.not_lt dec_trivial) }, + { simp [h, sign, ←sin_to_real] }, + { refine ⟨λ _, _, λ _, h.le⟩, + rw [sign, ←sin_to_real, sign_nonneg_iff], + exact sin_nonneg_of_nonneg_of_le_pi h.le (to_real_le_pi θ) } +end + +@[simp] lemma sign_to_real {θ : angle} (h : θ ≠ π) : _root_.sign θ.to_real = θ.sign := +begin + rcases lt_trichotomy θ.to_real 0 with (ht|ht|ht), + { simp [ht, to_real_neg_iff_sign_neg.1 ht] }, + { simp [sign, ht, ←sin_to_real] }, + { rw [sign, ←sin_to_real, sign_pos ht, + sign_pos (sin_pos_of_pos_of_lt_pi ht + ((to_real_le_pi θ).lt_of_ne (to_real_eq_pi_iff.not.2 h)))] } +end + +lemma coe_abs_to_real_of_sign_nonneg {θ : angle} (h : 0 ≤ θ.sign) : ↑|θ.to_real| = θ := +by rw [abs_eq_self.2 (to_real_nonneg_iff_sign_nonneg.2 h), coe_to_real] + +lemma neg_coe_abs_to_real_of_sign_nonpos {θ : angle} (h : θ.sign ≤ 0) : -↑|θ.to_real| = θ := +begin + rw sign_type.nonpos_iff at h, + rcases h with h|h, + { rw [abs_of_neg (to_real_neg_iff_sign_neg.2 h), coe_neg, neg_neg, coe_to_real] }, + { rw sign_eq_zero_iff at h, + rcases h with rfl|rfl; + simp [abs_of_pos real.pi_pos] } +end + +lemma eq_iff_sign_eq_and_abs_to_real_eq {θ ψ : angle} : + θ = ψ ↔ θ.sign = ψ.sign ∧ |θ.to_real| = |ψ.to_real| := +begin + refine ⟨_, λ h, _⟩, { rintro rfl, exact ⟨rfl, rfl⟩ }, + rcases h with ⟨hs, hr⟩, + rw abs_eq_abs at hr, + rcases hr with (hr|hr), + { exact to_real_injective hr }, + { by_cases h : θ = π, + { rw [h, to_real_pi, ← neg_eq_iff_eq_neg] at hr, + exact false.elim ((neg_pi_lt_to_real ψ).ne hr) }, + { by_cases h' : ψ = π, + { rw [h', to_real_pi] at hr, + exact false.elim ((neg_pi_lt_to_real θ).ne hr.symm) }, + { rw [←sign_to_real h, ←sign_to_real h', hr, left.sign_neg, sign_type.neg_eq_self_iff, + _root_.sign_eq_zero_iff, to_real_eq_zero_iff] at hs, + rw [hs, to_real_zero, neg_zero, to_real_eq_zero_iff] at hr, + rw [hr, hs] } } } +end + +lemma eq_iff_abs_to_real_eq_of_sign_eq {θ ψ : angle} (h : θ.sign = ψ.sign) : + θ = ψ ↔ |θ.to_real| = |ψ.to_real| := +by simpa [h] using @eq_iff_sign_eq_and_abs_to_real_eq θ ψ + +@[simp] lemma sign_coe_pi_div_two : (↑(π / 2) : angle).sign = 1 := +by rw [sign, sin_coe, sin_pi_div_two, sign_one] + +@[simp] lemma sign_coe_neg_pi_div_two : (↑(-π / 2) : angle).sign = -1 := +by rw [sign, sin_coe, neg_div, real.sin_neg, sin_pi_div_two, left.sign_neg, sign_one] + +lemma sign_coe_nonneg_of_nonneg_of_le_pi {θ : ℝ} (h0 : 0 ≤ θ) (hpi : θ ≤ π) : + 0 ≤ (θ : angle).sign := +begin + rw [sign, sign_nonneg_iff], + exact sin_nonneg_of_nonneg_of_le_pi h0 hpi +end + +lemma sign_neg_coe_nonpos_of_nonneg_of_le_pi {θ : ℝ} (h0 : 0 ≤ θ) (hpi : θ ≤ π) : + (-θ : angle).sign ≤ 0 := +begin + rw [sign, sign_nonpos_iff, sin_neg, left.neg_nonpos_iff], + exact sin_nonneg_of_nonneg_of_le_pi h0 hpi +end + +lemma sign_two_nsmul_eq_sign_iff {θ : angle} : + ((2 : ℕ) • θ).sign = θ.sign ↔ (θ = π ∨ |θ.to_real| < π / 2) := +begin + by_cases hpi : θ = π, { simp [hpi] }, + rw or_iff_right hpi, + refine ⟨λ h, _, λ h, _⟩, + { by_contra hle, + rw [not_lt, le_abs, le_neg] at hle, + have hpi' : θ.to_real ≠ π, { simpa using hpi }, + rcases hle with hle | hle; rcases hle.eq_or_lt with heq | hlt, + { rw [←coe_to_real θ, ←heq] at h, simpa using h }, + { rw [←sign_to_real hpi, sign_pos (pi_div_two_pos.trans hlt), + ←sign_to_real, two_nsmul_to_real_eq_two_mul_sub_two_pi.2 hlt, _root_.sign_neg] at h, + { simpa using h }, + { rw ←mul_sub, + exact mul_neg_of_pos_of_neg two_pos (sub_neg.2 ((to_real_le_pi _).lt_of_ne hpi')) }, + { intro he, simpa [he] using h } }, + { rw [←coe_to_real θ, heq] at h, simpa using h }, + { rw [←sign_to_real hpi, + _root_.sign_neg (hlt.trans (left.neg_neg_iff.2 pi_div_two_pos)), + ←sign_to_real] at h, swap, { intro he, simpa [he] using h }, + rw ←neg_div at hlt, + rw [two_nsmul_to_real_eq_two_mul_add_two_pi.2 hlt.le, sign_pos] at h, + { simpa using h }, + { linarith [neg_pi_lt_to_real θ] } } }, + { have hpi' : (2 : ℕ) • θ ≠ π, + { rw [ne.def, two_nsmul_eq_pi_iff, not_or_distrib], + split, + { rintro rfl, simpa [pi_pos, div_pos, abs_of_pos] using h }, + { rintro rfl, + rw [to_real_neg_pi_div_two] at h, + simpa [pi_pos, div_pos, neg_div, abs_of_pos] using h } }, + rw [abs_lt, ←neg_div] at h, + rw [←sign_to_real hpi, ←sign_to_real hpi', two_nsmul_to_real_eq_two_mul.2 ⟨h.1, h.2.le⟩, + sign_mul, sign_pos (zero_lt_two' ℝ), one_mul] } +end + +lemma sign_two_zsmul_eq_sign_iff {θ : angle} : + ((2 : ℤ) • θ).sign = θ.sign ↔ (θ = π ∨ |θ.to_real| < π / 2) := +by rw [two_zsmul, ←two_nsmul, sign_two_nsmul_eq_sign_iff] + +lemma continuous_at_sign {θ : angle} (h0 : θ ≠ 0) (hpi : θ ≠ π) : continuous_at sign θ := +(continuous_at_sign_of_ne_zero (sin_ne_zero_iff.2 ⟨h0, hpi⟩)).comp continuous_sin.continuous_at + +lemma _root_.continuous_on.angle_sign_comp {α : Type*} [topological_space α] {f : α → angle} + {s : set α} (hf : continuous_on f s) (hs : ∀ z ∈ s, f z ≠ 0 ∧ f z ≠ π) : + continuous_on (sign ∘ f) s := +begin + refine (continuous_at.continuous_on (λ θ hθ, _)).comp hf (set.maps_to_image f s), + obtain ⟨z, hz, rfl⟩ := hθ, + exact continuous_at_sign (hs _ hz).1 (hs _ hz).2 +end + +/-- Suppose a function to angles is continuous on a connected set and never takes the values `0` +or `π` on that set. Then the values of the function on that set all have the same sign. -/ +lemma sign_eq_of_continuous_on {α : Type*} [topological_space α] {f : α → angle} {s : set α} + {x y : α} (hc : is_connected s) (hf : continuous_on f s) (hs : ∀ z ∈ s, f z ≠ 0 ∧ f z ≠ π) + (hx : x ∈ s) (hy : y ∈ s) : (f y).sign = (f x).sign := +(hc.image _ (hf.angle_sign_comp hs)).is_preconnected.subsingleton + (set.mem_image_of_mem _ hy) (set.mem_image_of_mem _ hx) + end angle end real diff --git a/src/analysis/special_functions/trigonometric/arctan.lean b/src/analysis/special_functions/trigonometric/arctan.lean index 22208e3e889f5..1b00d5a47d1b4 100644 --- a/src/analysis/special_functions/trigonometric/arctan.lean +++ b/src/analysis/special_functions/trigonometric/arctan.lean @@ -8,6 +8,9 @@ import analysis.special_functions.trigonometric.complex /-! # The `arctan` function. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Inequalities, derivatives, and `real.tan` as a `local_homeomorph` between `(-(π / 2), π / 2)` and the whole line. -/ @@ -17,7 +20,7 @@ noncomputable theory namespace real open set filter -open_locale topological_space real +open_locale topology real lemma tan_add {x y : ℝ} (h : ((∀ k : ℤ, x ≠ (2 * k + 1) * π / 2) ∧ ∀ l : ℤ, y ≠ (2 * l + 1) * π / 2) @@ -106,6 +109,9 @@ tan_order_iso.apply_symm_apply x lemma arctan_mem_Ioo (x : ℝ) : arctan x ∈ Ioo (-(π / 2)) (π / 2) := subtype.coe_prop _ +@[simp] lemma range_arctan : range arctan = Ioo (-(π / 2)) (π / 2) := +((equiv_like.surjective _).range_comp _).trans subtype.range_coe + lemma arctan_tan {x : ℝ} (hx₁ : -(π / 2) < x) (hx₂ : x < π / 2) : arctan (tan x) = x := subtype.ext_iff.1 $ tan_order_iso.symm_apply_apply ⟨x, hx₁, hx₂⟩ @@ -133,7 +139,7 @@ eq.symm $ arcsin_eq_of_sin_eq (sin_arctan x) (mem_Icc_of_Ioo $ arctan_mem_Ioo x) lemma arcsin_eq_arctan {x : ℝ} (h : x ∈ Ioo (-(1:ℝ)) 1) : arcsin x = arctan (x / sqrt (1 - x ^ 2)) := begin - rw [arctan_eq_arcsin, div_pow, sq_sqrt, one_add_div, div_div_eq_div_mul, + rw [arctan_eq_arcsin, div_pow, sq_sqrt, one_add_div, div_div, ← sqrt_mul, mul_div_cancel', sub_add_cancel, sqrt_one, div_one]; nlinarith [h.1, h.2], end @@ -151,6 +157,25 @@ arctan_eq_of_tan_eq tan_pi_div_four $ by split; linarith [pi_pos] @[simp] lemma arctan_neg (x : ℝ) : arctan (-x) = - arctan x := by simp [arctan_eq_arcsin, neg_div] +lemma arctan_eq_arccos {x : ℝ} (h : 0 ≤ x) : arctan x = arccos ((sqrt (1 + x ^ 2))⁻¹) := +begin + rw [arctan_eq_arcsin, arccos_eq_arcsin], swap, { exact inv_nonneg.2 (sqrt_nonneg _) }, + congr' 1, + rw [←sqrt_inv, sq_sqrt, ←one_div, one_sub_div, add_sub_cancel', sqrt_div, sqrt_sq h], + all_goals { positivity } +end + +-- The junk values for `arccos` and `sqrt` make this true even for `1 < x`. +lemma arccos_eq_arctan {x : ℝ} (h : 0 < x) : + arccos x = arctan (sqrt (1 - x ^ 2) / x) := +begin + rw [arccos, eq_comm], + refine arctan_eq_of_tan_eq _ ⟨_, _⟩, + { rw [tan_pi_div_two_sub, tan_arcsin, inv_div] }, + { linarith only [arcsin_le_pi_div_two x, pi_pos] }, + { linarith only [arcsin_pos.2 h] } +end + @[continuity] lemma continuous_arctan : continuous arctan := continuous_subtype_coe.comp tan_order_iso.to_homeomorph.continuous_inv_fun diff --git a/src/analysis/special_functions/trigonometric/arctan_deriv.lean b/src/analysis/special_functions/trigonometric/arctan_deriv.lean index 48990ebb7bde6..b34a13876c806 100644 --- a/src/analysis/special_functions/trigonometric/arctan_deriv.lean +++ b/src/analysis/special_functions/trigonometric/arctan_deriv.lean @@ -9,6 +9,9 @@ import analysis.special_functions.trigonometric.complex_deriv /-! # Derivatives of the `tan` and `arctan` functions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Continuity and derivatives of the tangent and arctangent functions. -/ @@ -17,7 +20,7 @@ noncomputable theory namespace real open set filter -open_locale topological_space real +open_locale topology real lemma has_strict_deriv_at_tan {x : ℝ} (h : cos x ≠ 0) : has_strict_deriv_at tan (1 / (cos x)^2) x := @@ -85,7 +88,7 @@ lemma differentiable_arctan : differentiable ℝ arctan := differentiable_at_arc @[simp] lemma deriv_arctan : deriv arctan = (λ x, 1 / (1 + x^2)) := funext $ λ x, (has_deriv_at_arctan x).deriv -lemma cont_diff_arctan {n : with_top ℕ} : cont_diff ℝ n arctan := +lemma cont_diff_arctan {n : ℕ∞} : cont_diff ℝ n arctan := cont_diff_iff_cont_diff_at.2 $ λ x, have cos (arctan x) ≠ 0 := (cos_arctan_pos x).ne', tan_local_homeomorph.cont_diff_at_symm_deriv (by simpa) trivial (has_deriv_at_tan this) @@ -131,8 +134,8 @@ end deriv section fderiv -variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} {x : E} - {s : set E} {n : with_top ℕ} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} + {x : E} {s : set E} {n : ℕ∞} lemma has_strict_fderiv_at.arctan (hf : has_strict_fderiv_at f f' x) : has_strict_fderiv_at (λ x, arctan (f x)) ((1 / (1 + (f x)^2)) • f') x := diff --git a/src/analysis/special_functions/trigonometric/basic.lean b/src/analysis/special_functions/trigonometric/basic.lean index b968a6676431e..63146c0dedc68 100644 --- a/src/analysis/special_functions/trigonometric/basic.lean +++ b/src/analysis/special_functions/trigonometric/basic.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson -/ import analysis.special_functions.exp -import data.set.intervals.infinite /-! # Trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions This file contains the definition of `π`. @@ -40,7 +42,7 @@ sin, cos, tan, angle -/ noncomputable theory -open_locale classical topological_space filter +open_locale classical topology filter open set filter namespace complex @@ -97,23 +99,23 @@ intermediate_value_Icc' (by norm_num) continuous_on_cos which one can derive all its properties. For explicit bounds on π, see `data.real.pi.bounds`. -/ protected noncomputable def pi : ℝ := 2 * classical.some exists_cos_eq_zero -localized "notation `π` := real.pi" in real +localized "notation (name := real.pi) `π` := real.pi" in real @[simp] lemma cos_pi_div_two : cos (π / 2) = 0 := -by rw [real.pi, mul_div_cancel_left _ (@two_ne_zero' ℝ _ _ _)]; +by rw [real.pi, mul_div_cancel_left _ (two_ne_zero' ℝ)]; exact (classical.some_spec exists_cos_eq_zero).2 lemma one_le_pi_div_two : (1 : ℝ) ≤ π / 2 := -by rw [real.pi, mul_div_cancel_left _ (@two_ne_zero' ℝ _ _ _)]; +by rw [real.pi, mul_div_cancel_left _ (two_ne_zero' ℝ)]; exact (classical.some_spec exists_cos_eq_zero).1.1 lemma pi_div_two_le_two : π / 2 ≤ 2 := -by rw [real.pi, mul_div_cancel_left _ (@two_ne_zero' ℝ _ _ _)]; +by rw [real.pi, mul_div_cancel_left _ (two_ne_zero' ℝ)]; exact (classical.some_spec exists_cos_eq_zero).1.2 lemma two_le_pi : (2 : ℝ) ≤ π := (div_le_div_right (show (0 : ℝ) < 2, by norm_num)).1 - (by rw div_self (@two_ne_zero' ℝ _ _ _); exact one_le_pi_div_two) + (by rw div_self (two_ne_zero' ℝ); exact one_le_pi_div_two) lemma pi_le_four : π ≤ 4 := (div_le_div_right (show (0 : ℝ) < 2, by norm_num)).1 @@ -153,11 +155,11 @@ namespace real open_locale real @[simp] lemma sin_pi : sin π = 0 := -by rw [← mul_div_cancel_left π (@two_ne_zero ℝ _ _), two_mul, add_div, +by rw [← mul_div_cancel_left π (two_ne_zero' ℝ), two_mul, add_div, sin_add, cos_pi_div_two]; simp @[simp] lemma cos_pi : cos π = -1 := -by rw [← mul_div_cancel_left π (@two_ne_zero ℝ _ _), mul_div_assoc, +by rw [← mul_div_cancel_left π (two_ne_zero' ℝ), mul_div_assoc, cos_two_mul, cos_pi_div_two]; simp [bit0, pow_add] @@ -364,9 +366,9 @@ lemma sin_eq_zero_iff_of_lt_of_lt {x : ℝ} (hx₁ : -π < x) (hx₂ : x < π) : λ h, by simp [h]⟩ lemma sin_eq_zero_iff {x : ℝ} : sin x = 0 ↔ ∃ n : ℤ, (n : ℝ) * π = x := -⟨λ h, ⟨⌊x / π⌋, le_antisymm (sub_nonneg.1 (sub_floor_div_mul_nonneg _ pi_pos)) +⟨λ h, ⟨⌊x / π⌋, le_antisymm (sub_nonneg.1 (int.sub_floor_div_mul_nonneg _ pi_pos)) (sub_nonpos.1 $ le_of_not_gt $ λ h₃, - (sin_pos_of_pos_of_lt_pi h₃ (sub_floor_div_mul_lt _ pi_pos)).ne + (sin_pos_of_pos_of_lt_pi h₃ (int.sub_floor_div_mul_lt _ pi_pos)).ne (by simp [sub_eq_add_neg, sin_add, h, sin_int_mul_pi]))⟩, λ ⟨n, hn⟩, hn ▸ sin_int_mul_pi _⟩ @@ -481,10 +483,10 @@ subset.antisymm (range_subset_iff.2 cos_mem_Icc) surj_on_cos.subset_range subset.antisymm (range_subset_iff.2 sin_mem_Icc) surj_on_sin.subset_range lemma range_cos_infinite : (range real.cos).infinite := -by { rw real.range_cos, exact Icc.infinite (by norm_num) } +by { rw real.range_cos, exact Icc_infinite (by norm_num) } lemma range_sin_infinite : (range real.sin).infinite := -by { rw real.range_sin, exact Icc.infinite (by norm_num) } +by { rw real.range_sin, exact Icc_infinite (by norm_num) } section cos_div_sq @@ -761,6 +763,9 @@ tan_periodic.sub_eq x lemma tan_pi_sub (x : ℝ) : tan (π - x) = -tan x := tan_neg x ▸ tan_periodic.sub_eq' +lemma tan_pi_div_two_sub (x : ℝ) : tan (π / 2 - x) = (tan x)⁻¹ := +by rw [tan_eq_sin_div_cos, tan_eq_sin_div_cos, inv_div, sin_pi_div_two_sub, cos_pi_div_two_sub] + lemma tan_nat_mul_pi (n : ℕ) : tan (n * π) = 0 := tan_zero ▸ tan_periodic.nat_mul_eq n @@ -990,6 +995,9 @@ tan_periodic.sub_eq x lemma tan_pi_sub (x : ℂ) : tan (π - x) = -tan x := tan_neg x ▸ tan_periodic.sub_eq' +lemma tan_pi_div_two_sub (x : ℂ) : tan (π / 2 - x) = (tan x)⁻¹ := +by rw [tan_eq_sin_div_cos, tan_eq_sin_div_cos, inv_div, sin_pi_div_two_sub, cos_pi_div_two_sub] + lemma tan_nat_mul_pi (n : ℕ) : tan (n * π) = 0 := tan_zero ▸ tan_periodic.nat_mul_eq n diff --git a/src/analysis/special_functions/trigonometric/bounds.lean b/src/analysis/special_functions/trigonometric/bounds.lean index a781e5dd416f6..936a9e1e98434 100644 --- a/src/analysis/special_functions/trigonometric/bounds.lean +++ b/src/analysis/special_functions/trigonometric/bounds.lean @@ -3,12 +3,14 @@ Copyright (c) 2022 David Loeffler. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: David Loeffler -/ -import analysis.special_functions.trigonometric.basic -import analysis.special_functions.trigonometric.deriv import analysis.special_functions.trigonometric.arctan_deriv + /-! # Polynomial bounds for trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main statements This file contains upper and lower bounds for real trigonometric functions in terms @@ -20,6 +22,9 @@ Here we prove the following: * `sin_lt`: for `x > 0` we have `sin x < x`. * `sin_gt_sub_cube`: For `0 < x ≤ 1` we have `x - x ^ 3 / 4 < sin x`. * `lt_tan`: for `0 < x < π/2` we have `x < tan x`. +* `cos_le_one_div_sqrt_sq_add_one` and `cos_lt_one_div_sqrt_sq_add_one`: for + `-3 * π / 2 ≤ x ≤ 3 * π / 2`, we have `cos x ≤ 1 / sqrt (x ^ 2 + 1)`, with strict inequality if + `x ≠ 0`. (This bound is not quite optimal, but not far off) ## Tags @@ -71,11 +76,11 @@ lemma deriv_tan_sub_id (x : ℝ) (h : cos x ≠ 0) : deriv (λ y : ℝ, tan y - y) x = 1 / cos x ^ 2 - 1 := has_deriv_at.deriv $ by simpa using (has_deriv_at_tan h).add (has_deriv_at_id x).neg -/-- For all `0 ≤ x < π/2` we have `x < tan x`. +/-- For all `0 < x < π/2` we have `x < tan x`. This is proved by checking that the function `tan x - x` vanishes at zero and has non-negative derivative. -/ -theorem lt_tan (x : ℝ) (h1 : 0 < x) (h2 : x < π / 2) : x < tan x := +theorem lt_tan {x : ℝ} (h1 : 0 < x) (h2 : x < π / 2) : x < tan x := begin let U := Ico 0 (π / 2), @@ -121,4 +126,44 @@ begin simpa only [tan_zero, sub_zero, sub_pos] using mono zero_in_U x_in_U h1 end +lemma le_tan {x : ℝ} (h1 : 0 ≤ x) (h2 : x < π / 2) : x ≤ tan x := +begin + rcases eq_or_lt_of_le h1 with rfl | h1', + { rw tan_zero }, + { exact le_of_lt (lt_tan h1' h2) } +end + +lemma cos_lt_one_div_sqrt_sq_add_one {x : ℝ} + (hx1 : -(3 * π / 2) ≤ x) (hx2 : x ≤ 3 * π / 2) (hx3 : x ≠ 0) : + cos x < 1 / sqrt (x ^ 2 + 1) := +begin + suffices : ∀ {y : ℝ} (hy1 : 0 < y) (hy2 : y ≤ 3 * π / 2), cos y < 1 / sqrt (y ^ 2 + 1), + { rcases lt_or_lt_iff_ne.mpr hx3.symm, + { exact this h hx2 }, + { convert this (by linarith : 0 < -x) (by linarith) using 1, + { rw cos_neg }, { rw neg_sq } } }, + intros y hy1 hy2, + have hy3 : 0 < y ^ 2 + 1, by linarith [sq_nonneg y], + rcases lt_or_le y (π / 2) with hy2' | hy1', + { -- Main case : `0 < y < π / 2` + have hy4 : 0 < cos y := cos_pos_of_mem_Ioo ⟨by linarith, hy2'⟩, + rw [←abs_of_nonneg (cos_nonneg_of_mem_Icc ⟨by linarith, hy2'.le⟩), + ←abs_of_nonneg (one_div_nonneg.mpr (sqrt_nonneg _)), ←sq_lt_sq, div_pow, one_pow, + sq_sqrt hy3.le, lt_one_div (pow_pos hy4 _) hy3, ←inv_one_add_tan_sq hy4.ne', one_div, inv_inv, + add_comm, add_lt_add_iff_left, sq_lt_sq, abs_of_pos hy1, + abs_of_nonneg (tan_nonneg_of_nonneg_of_le_pi_div_two hy1.le hy2'.le)], + exact real.lt_tan hy1 hy2' }, + { -- Easy case : `π / 2 ≤ y ≤ 3 * π / 2` + refine lt_of_le_of_lt _ (one_div_pos.mpr $ sqrt_pos_of_pos hy3), + exact cos_nonpos_of_pi_div_two_le_of_le hy1' (by linarith [pi_pos]) } +end + +lemma cos_le_one_div_sqrt_sq_add_one {x : ℝ} (hx1 : -(3 * π / 2) ≤ x) (hx2 : x ≤ 3 * π / 2) : + cos x ≤ 1 / sqrt (x ^ 2 + 1) := +begin + rcases eq_or_ne x 0 with rfl | hx3, + { simp }, + { exact (cos_lt_one_div_sqrt_sq_add_one hx1 hx2 hx3).le } +end + end real diff --git a/src/analysis/special_functions/trigonometric/chebyshev.lean b/src/analysis/special_functions/trigonometric/chebyshev.lean index 69dd2162d0021..f35d08a9a9f50 100644 --- a/src/analysis/special_functions/trigonometric/chebyshev.lean +++ b/src/analysis/special_functions/trigonometric/chebyshev.lean @@ -3,25 +3,56 @@ Copyright (c) 2020 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ -import analysis.complex.basic -import ring_theory.polynomial.chebyshev import data.complex.exponential +import data.complex.module +import data.polynomial.algebra_map +import ring_theory.polynomial.chebyshev /-! # Multiple angle formulas in terms of Chebyshev polynomials -* `polynomial.chebyshev.T_complex_cos`: the `n`-th Chebyshev polynomial evaluates on `complex.cos θ` - to the value `complex.cos (n * θ)`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file gives the trigonometric characterizations of Chebyshev polynomials, for both the real +(`real.cos`) and complex (`complex.cos`) cosine. -/ namespace polynomial.chebyshev +open polynomial + +variables {R A : Type*} [comm_ring R] [comm_ring A] [algebra R A] + +@[simp] lemma aeval_T (x : A) (n : ℕ) : aeval x (T R n) = (T A n).eval x := +by rw [aeval_def, eval₂_eq_eval_map, map_T] + +@[simp] lemma aeval_U (x : A) (n : ℕ) : aeval x (U R n) = (U A n).eval x := +by rw [aeval_def, eval₂_eq_eval_map, map_U] + +@[simp] lemma algebra_map_eval_T (x : R) (n : ℕ) : + algebra_map R A ((T R n).eval x) = (T A n).eval (algebra_map R A x) := +by rw [←aeval_algebra_map_apply_eq_algebra_map_eval, aeval_T] + +@[simp] lemma algebra_map_eval_U (x : R) (n : ℕ) : + algebra_map R A ((U R n).eval x) = (U A n).eval (algebra_map R A x) := +by rw [←aeval_algebra_map_apply_eq_algebra_map_eval, aeval_U] + +@[simp, norm_cast] lemma complex_of_real_eval_T : ∀ x n, ((T ℝ n).eval x : ℂ) = (T ℂ n).eval x := +@algebra_map_eval_T ℝ ℂ _ _ _ + +@[simp, norm_cast] lemma complex_of_real_eval_U : ∀ x n, ((U ℝ n).eval x : ℂ) = (U ℂ n).eval x := +@algebra_map_eval_U ℝ ℂ _ _ _ + +/-! ### Complex versions -/ -open polynomial complex +section complex +open complex + +variable (θ : ℂ) /-- The `n`-th Chebyshev polynomial of the first kind evaluates on `cos θ` to the value `cos (n * θ)`. -/ -lemma T_complex_cos (θ : ℂ) : - ∀ n, (T ℂ n).eval (cos θ) = cos (n * θ) +@[simp] lemma T_complex_cos : ∀ n, (T ℂ n).eval (cos θ) = cos (n * θ) | 0 := by simp only [T_zero, eval_one, nat.cast_zero, zero_mul, cos_zero] | 1 := by simp only [eval_X, one_mul, T_one, nat.cast_one] | (n + 2) := @@ -34,16 +65,9 @@ begin ring, end -/-- `cos (n * θ)` is equal to the `n`-th Chebyshev polynomial of the first kind evaluated -on `cos θ`. -/ -lemma cos_nat_mul (n : ℕ) (θ : ℂ) : - cos (n * θ) = (T ℂ n).eval (cos θ) := -(T_complex_cos θ n).symm - /-- The `n`-th Chebyshev polynomial of the second kind evaluates on `cos θ` to the -value `sin ((n+1) * θ) / sin θ`. -/ -lemma U_complex_cos (θ : ℂ) (n : ℕ) : - (U ℂ n).eval (cos θ) * sin θ = sin ((n+1) * θ) := +value `sin ((n + 1) * θ) / sin θ`. -/ +@[simp] lemma U_complex_cos (n : ℕ) : (U ℂ n).eval (cos θ) * sin θ = sin ((n + 1) * θ) := begin induction n with d hd, { simp only [U_zero, nat.cast_zero, eval_one, mul_one, zero_add, one_mul] }, @@ -54,10 +78,25 @@ begin simp only [add_mul, one_mul] } end -/-- `sin ((n + 1) * θ)` is equal to `sin θ` multiplied with the `n`-th Chebyshev polynomial of the -second kind evaluated on `cos θ`. -/ -lemma sin_nat_succ_mul (n : ℕ) (θ : ℂ) : - sin ((n + 1) * θ) = (U ℂ n).eval (cos θ) * sin θ := -(U_complex_cos θ n).symm +end complex + +/- ### Real versions -/ + +section real +open real + +variables (θ : ℝ) (n : ℕ) + +/-- The `n`-th Chebyshev polynomial of the first kind evaluates on `cos θ` to the +value `cos (n * θ)`. -/ +@[simp] lemma T_real_cos : (T ℝ n).eval (cos θ) = cos (n * θ) := +by exact_mod_cast T_complex_cos θ n + +/-- The `n`-th Chebyshev polynomial of the second kind evaluates on `cos θ` to the +value `sin ((n + 1) * θ) / sin θ`. -/ +@[simp] lemma U_real_cos : (U ℝ n).eval (cos θ) * sin θ = sin ((n + 1) * θ) := +by exact_mod_cast U_complex_cos θ n + +end real end polynomial.chebyshev diff --git a/src/analysis/special_functions/trigonometric/complex.lean b/src/analysis/special_functions/trigonometric/complex.lean index 0f877132d3d2b..ddcc993a29a5f 100644 --- a/src/analysis/special_functions/trigonometric/complex.lean +++ b/src/analysis/special_functions/trigonometric/complex.lean @@ -4,14 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson -/ import algebra.quadratic_discriminant -import analysis.complex.polynomial -import field_theory.is_alg_closed.basic -import analysis.special_functions.trigonometric.basic -import analysis.convex.specific_functions +import analysis.convex.specific_functions.deriv /-! # Complex trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Basic facts and derivatives for the complex trigonometric functions. Several facts about the real trigonometric functions have the proofs deferred here, rather than @@ -30,13 +30,13 @@ open_locale real theorem cos_eq_zero_iff {θ : ℂ} : cos θ = 0 ↔ ∃ k : ℤ, θ = (2 * k + 1) * π / 2 := begin have h : (exp (θ * I) + exp (-θ * I)) / 2 = 0 ↔ exp (2 * θ * I) = -1, - { rw [@div_eq_iff _ _ (exp (θ * I) + exp (-θ * I)) 2 0 two_ne_zero', zero_mul, + { rw [@div_eq_iff _ _ (exp (θ * I) + exp (-θ * I)) 2 0 two_ne_zero, zero_mul, add_eq_zero_iff_eq_neg, neg_eq_neg_one_mul, ← div_eq_iff (exp_ne_zero _), ← exp_sub], field_simp only, congr' 3, ring }, rw [cos, h, ← exp_pi_mul_I, exp_eq_exp_iff_exists_int, mul_right_comm], refine exists_congr (λ x, _), - refine (iff_of_eq $ congr_arg _ _).trans (mul_right_inj' $ mul_ne_zero two_ne_zero' I_ne_zero), - ring, + refine (iff_of_eq $ congr_arg _ _).trans (mul_right_inj' $ mul_ne_zero two_ne_zero I_ne_zero), + field_simp, ring, end theorem cos_ne_zero_iff {θ : ℂ} : cos θ ≠ 0 ↔ ∀ k : ℤ, θ ≠ (2 * k + 1) * π / 2 := @@ -65,7 +65,7 @@ begin have h := (sin_two_mul θ).symm, rw mul_assoc at h, rw [tan, div_eq_zero_iff, ← mul_eq_zero, ← zero_mul ((1/2):ℂ), mul_one_div, - cancel_factors.cancel_factors_eq_div h two_ne_zero', mul_comm], + cancel_factors.cancel_factors_eq_div h two_ne_zero, mul_comm], simpa only [zero_div, zero_mul, ne.def, not_false_iff] with field_simps using sin_eq_zero_iff, end @@ -107,7 +107,7 @@ begin ← div_div_div_cancel_right (sin x * cos y + cos x * sin y) (mul_ne_zero (cos_ne_zero_iff.mpr h1) (cos_ne_zero_iff.mpr h2)), add_div, sub_div], - simp only [←div_mul_div_comm₀, ←tan, mul_one, one_mul, + simp only [←div_mul_div_comm, ←tan, mul_one, one_mul, div_self (cos_ne_zero_iff.mpr h1), div_self (cos_ne_zero_iff.mpr h2)] }, { obtain ⟨t, hx, hy, hxy⟩ := ⟨tan_int_mul_pi_div_two, t (2*k+1), t (2*l+1), t (2*k+1+(2*l+1))⟩, simp only [int.cast_add, int.cast_bit0, int.cast_mul, int.cast_one, hx, hy] at hx hy hxy, @@ -140,7 +140,7 @@ lemma tan_eq {z : ℂ} tan z = (tan z.re + tanh z.im * I) / (1 - tan z.re * tanh z.im * I) := by convert tan_add_mul_I h; exact (re_add_im z).symm -open_locale topological_space +open_locale topology lemma continuous_on_tan : continuous_on tan {x | cos x ≠ 0} := continuous_on_sin.div continuous_on_cos $ λ x, id @@ -162,8 +162,8 @@ lemma cos_surjective : function.surjective cos := begin intro x, obtain ⟨w, w₀, hw⟩ : ∃ w ≠ 0, 1 * w * w + (-2 * x) * w + 1 = 0, - { rcases exists_quadratic_eq_zero (@one_ne_zero ℂ _ _) (is_alg_closed.exists_eq_mul_self _) - with ⟨w, hw⟩, + { rcases exists_quadratic_eq_zero one_ne_zero + ⟨_, ((cpow_nat_inv_pow _ two_ne_zero).symm.trans $ pow_two _)⟩ with ⟨w, hw⟩, refine ⟨w, _, hw⟩, rintro rfl, simpa only [zero_add, one_ne_zero, mul_zero] using hw }, @@ -217,7 +217,7 @@ by simpa [mul_comm x] using strict_concave_on_sin_Icc.concave_on.2 ⟨le_rfl, pi lemma mul_lt_sin {x : ℝ} (hx : 0 < x) (hx' : x < π / 2) : (2 / π) * x < sin x := begin rw [←inv_div], - simpa [-division_monoid.inv_div, pi_div_two_pos.ne'] using @lt_sin_mul ((π / 2)⁻¹ * x) _ _, + simpa [-inv_div, pi_div_two_pos.ne'] using @lt_sin_mul ((π / 2)⁻¹ * x) _ _, { exact mul_pos (inv_pos.2 pi_div_two_pos) hx }, { rwa [←div_eq_inv_mul, div_lt_one pi_div_two_pos] }, end @@ -227,7 +227,7 @@ of Jordan's inequality, the other half is `real.sin_lt` -/ lemma mul_le_sin {x : ℝ} (hx : 0 ≤ x) (hx' : x ≤ π / 2) : (2 / π) * x ≤ sin x := begin rw [←inv_div], - simpa [-division_monoid.inv_div, pi_div_two_pos.ne'] using @le_sin_mul ((π / 2)⁻¹ * x) _ _, + simpa [-inv_div, pi_div_two_pos.ne'] using @le_sin_mul ((π / 2)⁻¹ * x) _ _, { exact mul_nonneg (inv_nonneg.2 pi_div_two_pos.le) hx }, { rwa [←div_eq_inv_mul, div_le_one pi_div_two_pos] }, end diff --git a/src/analysis/special_functions/trigonometric/complex_deriv.lean b/src/analysis/special_functions/trigonometric/complex_deriv.lean index 65bd9c6f5e77b..2ab19256c1269 100644 --- a/src/analysis/special_functions/trigonometric/complex_deriv.lean +++ b/src/analysis/special_functions/trigonometric/complex_deriv.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson -/ import analysis.special_functions.trigonometric.complex -import analysis.special_functions.trigonometric.deriv /-! # Complex trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Basic facts and derivatives for the complex trigonometric functions. -/ @@ -31,7 +33,7 @@ lemma has_deriv_at_tan {x : ℂ} (h : cos x ≠ 0) : has_deriv_at tan (1 / (cos x)^2) x := (has_strict_deriv_at_tan h).has_deriv_at -open_locale topological_space +open_locale topology lemma tendsto_abs_tan_of_cos_eq_zero {x : ℂ} (hx : cos x = 0) : tendsto (λ x, abs (tan x)) (𝓝[≠] x) at_top := @@ -64,7 +66,7 @@ if h : cos x = 0 then by simp [deriv_zero_of_not_differentiable_at this, h, sq] else (has_deriv_at_tan h).deriv -@[simp] lemma cont_diff_at_tan {x : ℂ} {n : with_top ℕ} : +@[simp] lemma cont_diff_at_tan {x : ℂ} {n : ℕ∞} : cont_diff_at ℂ n tan x ↔ cos x ≠ 0 := ⟨λ h, continuous_at_tan.1 h.continuous_at, cont_diff_sin.cont_diff_at.div cont_diff_cos.cont_diff_at⟩ diff --git a/src/analysis/special_functions/trigonometric/deriv.lean b/src/analysis/special_functions/trigonometric/deriv.lean index 51752f4171933..65fdd446450b5 100644 --- a/src/analysis/special_functions/trigonometric/deriv.lean +++ b/src/analysis/special_functions/trigonometric/deriv.lean @@ -3,11 +3,16 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne, Benjamin Davidson -/ +import order.monotone.odd import analysis.special_functions.exp_deriv +import analysis.special_functions.trigonometric.basic /-! # Differentiability of trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main statements The differentiability of the usual trigonometric functions is proved, and their derivatives are @@ -19,7 +24,7 @@ sin, cos, tan, angle -/ noncomputable theory -open_locale classical topological_space filter +open_locale classical topology filter open set filter namespace complex @@ -41,7 +46,7 @@ lemma has_deriv_at_sin (x : ℂ) : has_deriv_at sin (cos x) x := lemma cont_diff_sin {n} : cont_diff ℂ n sin := (((cont_diff_neg.mul cont_diff_const).cexp.sub - (cont_diff_id.mul cont_diff_const).cexp).mul cont_diff_const).div_const + (cont_diff_id.mul cont_diff_const).cexp).mul cont_diff_const).div_const _ lemma differentiable_sin : differentiable ℂ sin := λx, (has_deriv_at_sin x).differentiable_at @@ -69,7 +74,7 @@ lemma has_deriv_at_cos (x : ℂ) : has_deriv_at cos (-sin x) x := lemma cont_diff_cos {n} : cont_diff ℂ n cos := ((cont_diff_id.mul cont_diff_const).cexp.add - (cont_diff_neg.mul cont_diff_const).cexp).div_const + (cont_diff_neg.mul cont_diff_const).cexp).div_const _ lemma differentiable_cos : differentiable ℂ cos := λx, (has_deriv_at_cos x).differentiable_at @@ -98,7 +103,7 @@ lemma has_deriv_at_sinh (x : ℂ) : has_deriv_at sinh (cosh x) x := (has_strict_deriv_at_sinh x).has_deriv_at lemma cont_diff_sinh {n} : cont_diff ℂ n sinh := -(cont_diff_exp.sub cont_diff_neg.cexp).div_const +(cont_diff_exp.sub cont_diff_neg.cexp).div_const _ lemma differentiable_sinh : differentiable ℂ sinh := λx, (has_deriv_at_sinh x).differentiable_at @@ -124,7 +129,7 @@ lemma has_deriv_at_cosh (x : ℂ) : has_deriv_at cosh (sinh x) x := (has_strict_deriv_at_cosh x).has_deriv_at lemma cont_diff_cosh {n} : cont_diff ℂ n cosh := -(cont_diff_exp.add cont_diff_neg.cexp).div_const +(cont_diff_exp.add cont_diff_neg.cexp).div_const _ lemma differentiable_cosh : differentiable ℂ cosh := λx, (has_deriv_at_cosh x).differentiable_at @@ -239,7 +244,7 @@ end section /-! ### Simp lemmas for derivatives of `λ x, complex.cos (f x)` etc., `f : E → ℂ` -/ -variables {E : Type*} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {f' : E →L[ℂ] ℂ} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] {f : E → ℂ} {f' : E →L[ℂ] ℂ} {x : E} {s : set E} /-! #### `complex.cos` -/ @@ -547,6 +552,68 @@ funext $ λ x, (has_deriv_at_cosh x).deriv lemma sinh_strict_mono : strict_mono sinh := strict_mono_of_deriv_pos $ by { rw real.deriv_sinh, exact cosh_pos } +/-- `sinh` is injective, `∀ a b, sinh a = sinh b → a = b`. -/ +lemma sinh_injective : function.injective sinh := sinh_strict_mono.injective + +@[simp] lemma sinh_inj : sinh x = sinh y ↔ x = y := sinh_injective.eq_iff +@[simp] lemma sinh_le_sinh : sinh x ≤ sinh y ↔ x ≤ y := sinh_strict_mono.le_iff_le +@[simp] lemma sinh_lt_sinh : sinh x < sinh y ↔ x < y := sinh_strict_mono.lt_iff_lt + +@[simp] lemma sinh_pos_iff : 0 < sinh x ↔ 0 < x := +by simpa only [sinh_zero] using @sinh_lt_sinh 0 x + +@[simp] lemma sinh_nonpos_iff : sinh x ≤ 0 ↔ x ≤ 0 := +by simpa only [sinh_zero] using @sinh_le_sinh x 0 + +@[simp] lemma sinh_neg_iff : sinh x < 0 ↔ x < 0 := +by simpa only [sinh_zero] using @sinh_lt_sinh x 0 + +@[simp] lemma sinh_nonneg_iff : 0 ≤ sinh x ↔ 0 ≤ x := +by simpa only [sinh_zero] using @sinh_le_sinh 0 x + +lemma abs_sinh (x : ℝ) : |sinh x| = sinh (|x|) := +by cases le_total x 0; simp [abs_of_nonneg, abs_of_nonpos, *] + +lemma cosh_strict_mono_on : strict_mono_on cosh (Ici 0) := +(convex_Ici _).strict_mono_on_of_deriv_pos continuous_cosh.continuous_on $ λ x hx, + by { rw [interior_Ici, mem_Ioi] at hx, rwa [deriv_cosh, sinh_pos_iff] } + +@[simp] lemma cosh_le_cosh : cosh x ≤ cosh y ↔ |x| ≤ |y| := +cosh_abs x ▸ cosh_abs y ▸ cosh_strict_mono_on.le_iff_le (_root_.abs_nonneg x) (_root_.abs_nonneg y) + +@[simp] lemma cosh_lt_cosh : cosh x < cosh y ↔ |x| < |y| := +lt_iff_lt_of_le_iff_le cosh_le_cosh + +@[simp] lemma one_le_cosh (x : ℝ) : 1 ≤ cosh x := +cosh_zero ▸ cosh_le_cosh.2 (by simp only [_root_.abs_zero, _root_.abs_nonneg]) + +@[simp] lemma one_lt_cosh : 1 < cosh x ↔ x ≠ 0 := +cosh_zero ▸ cosh_lt_cosh.trans (by simp only [_root_.abs_zero, abs_pos]) + +lemma sinh_sub_id_strict_mono : strict_mono (λ x, sinh x - x) := +begin + refine strict_mono_of_odd_strict_mono_on_nonneg (λ x, by simp) _, + refine (convex_Ici _).strict_mono_on_of_deriv_pos _ (λ x hx, _), + { exact (continuous_sinh.sub continuous_id).continuous_on }, + { rw [interior_Ici, mem_Ioi] at hx, + rw [deriv_sub, deriv_sinh, deriv_id'', sub_pos, one_lt_cosh], + exacts [hx.ne', differentiable_at_sinh, differentiable_at_id] } +end + +@[simp] lemma self_le_sinh_iff : x ≤ sinh x ↔ 0 ≤ x := +calc x ≤ sinh x ↔ sinh 0 - 0 ≤ sinh x - x : by simp +... ↔ 0 ≤ x : sinh_sub_id_strict_mono.le_iff_le + +@[simp] lemma sinh_le_self_iff : sinh x ≤ x ↔ x ≤ 0 := +calc sinh x ≤ x ↔ sinh x - x ≤ sinh 0 - 0 : by simp +... ↔ x ≤ 0 : sinh_sub_id_strict_mono.le_iff_le + +@[simp] lemma self_lt_sinh_iff : x < sinh x ↔ 0 < x := +lt_iff_lt_of_le_iff_le sinh_le_self_iff + +@[simp] lemma sinh_lt_self_iff : sinh x < x ↔ x < 0 := +lt_iff_lt_of_le_iff_le self_le_sinh_iff + end real section @@ -652,7 +719,7 @@ section /-! ### Simp lemmas for derivatives of `λ x, real.cos (f x)` etc., `f : E → ℝ` -/ -variables {E : Type*} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] {f : E → ℝ} {f' : E →L[ℝ] ℝ} {x : E} {s : set E} /-! #### `real.cos` -/ diff --git a/src/analysis/special_functions/trigonometric/euler_sine_prod.lean b/src/analysis/special_functions/trigonometric/euler_sine_prod.lean new file mode 100644 index 0000000000000..955b1d130e7e2 --- /dev/null +++ b/src/analysis/special_functions/trigonometric/euler_sine_prod.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2023 David Loeffler. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Loeffler +-/ +import analysis.special_functions.integrals +import measure_theory.integral.peak_function + +/-! # Euler's infinite product for the sine function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the infinite product formula + +$$ \sin \pi z = \pi z \prod_{n = 1}^\infty \left(1 - \frac{z ^ 2}{n ^ 2}\right) $$ + +for any real or complex `z`. Our proof closely follows the article +[Salwinski, *Euler's Sine Product Formula: An Elementary Proof*][salwinski2018]: the basic strategy +is to prove a recurrence relation for the integrals `∫ x in 0..π/2, cos 2 z x * cos x ^ (2 * n)`, +generalising the arguments used to prove Wallis' limit formula for `π`. +-/ + +open_locale real topology big_operators +open real set filter interval_integral measure_theory.measure_space + +namespace euler_sine + +section integral_recursion + +/-! ## Recursion formula for the integral of `cos (2 * z * x) * cos x ^ n` + +We evaluate the integral of `cos (2 * z * x) * cos x ^ n`, for any complex `z` and even integers +`n`, via repeated integration by parts. -/ + +variables {z : ℂ} {n : ℕ} + +lemma antideriv_cos_comp_const_mul (hz : z ≠ 0) (x : ℝ) : + has_deriv_at (λ y:ℝ, complex.sin (2 * z * y) / (2 * z)) (complex.cos (2 * z * x)) x := +begin + have a : has_deriv_at _ _ ↑x := has_deriv_at_mul_const _, + have b : has_deriv_at (λ (y : ℂ), complex.sin (y * (2 * z))) _ ↑x := + has_deriv_at.comp x (complex.has_deriv_at_sin (x * (2 * z))) a, + convert (b.comp_of_real).div_const (2 * z), + { ext1 x, rw mul_comm _ (2 * z) }, + { field_simp, rw mul_comm _ (2 * z) }, +end + +lemma antideriv_sin_comp_const_mul (hz : z ≠ 0) (x : ℝ) : + has_deriv_at (λ y:ℝ, -complex.cos (2 * z * y) / (2 * z)) (complex.sin (2 * z * x)) x := +begin + have a : has_deriv_at _ _ ↑x := has_deriv_at_mul_const _, + have b : has_deriv_at (λ (y : ℂ), complex.cos (y * (2 * z))) _ ↑x := + has_deriv_at.comp x (complex.has_deriv_at_cos (x * (2 * z))) a, + convert ((b.comp_of_real).div_const (2 * z)).neg, + { ext1 x, rw mul_comm _ (2 * z), field_simp }, + { field_simp, rw mul_comm _ (2 * z) }, +end + +lemma integral_cos_mul_cos_pow_aux (hn : 2 ≤ n) (hz : z ≠ 0): + (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) = + n / (2 * z) * ∫ x:ℝ in 0..π/2, complex.sin (2 * z * x) * sin x * cos x ^ (n - 1) := +begin + have der1 : ∀ (x : ℝ), (x ∈ uIcc 0 (π/2)) → has_deriv_at (λ y, (↑(cos y)) ^ n : ℝ → ℂ) + (-n * sin x * cos x ^ (n - 1)) x, + { intros x hx, + have b : has_deriv_at (λ y, ↑(cos y) : ℝ → ℂ) (-sin x) x, + by simpa using (has_deriv_at_cos x).of_real_comp, + convert has_deriv_at.comp x (has_deriv_at_pow _ _) b using 1, + ring, }, + convert integral_mul_deriv_eq_deriv_mul der1 (λ x hx, antideriv_cos_comp_const_mul hz x) _ _, + { ext1 x, rw mul_comm }, + { rw [complex.of_real_zero, mul_zero, complex.sin_zero, zero_div, mul_zero, sub_zero, + cos_pi_div_two, complex.of_real_zero, zero_pow (by positivity : 0 < n), zero_mul, zero_sub, + ←integral_neg, ←integral_const_mul], + refine integral_congr (λ x hx, _), + field_simp, ring }, + { apply continuous.interval_integrable, + exact (continuous_const.mul (complex.continuous_of_real.comp continuous_sin)).mul + ((complex.continuous_of_real.comp continuous_cos).pow (n - 1)) }, + { apply continuous.interval_integrable, + exact complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real) } +end + +lemma integral_sin_mul_sin_mul_cos_pow_eq (hn : 2 ≤ n) (hz : z ≠ 0) : + ∫ x:ℝ in 0..π/2, complex.sin (2 * z * x) * sin x * cos x ^ (n - 1) = + n / (2 * z) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) - + (n - 1) / (2 * z) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (n - 2)) := +begin + have der1 : ∀ (x : ℝ), (x ∈ uIcc 0 (π/2)) → + has_deriv_at (λ y, (sin y) * (cos y) ^ (n - 1) : ℝ → ℂ) + (cos x ^ n - (n - 1) * sin x ^ 2 * cos x ^ (n - 2)) x, + { intros x hx, + have c := has_deriv_at.comp (x:ℂ) (has_deriv_at_pow (n - 1) _) (complex.has_deriv_at_cos x), + convert ((complex.has_deriv_at_sin x).mul c).comp_of_real using 1, + { ext1 y, simp only [complex.of_real_sin, complex.of_real_cos] }, + { simp only [complex.of_real_cos, complex.of_real_sin], + rw [mul_neg, mul_neg, ←sub_eq_add_neg, function.comp_app], + congr' 1, + { rw [←pow_succ, nat.sub_add_cancel (by linarith : 1 ≤ n)] }, + { have : ((n - 1 : ℕ) : ℂ) = (n:ℂ) - 1, + { rw [nat.cast_sub (one_le_two.trans hn), nat.cast_one] }, + rw [nat.sub_sub, this], + ring } } }, + convert integral_mul_deriv_eq_deriv_mul der1 (λ x hx, antideriv_sin_comp_const_mul hz x) _ _ + using 1, + { refine integral_congr (λ x hx, _), + ring_nf }, + { -- now a tedious rearrangement of terms + -- gather into a single integral, and deal with continuity subgoals: + rw [sin_zero, cos_pi_div_two, complex.of_real_zero, zero_pow, zero_mul, mul_zero, zero_mul, + zero_mul, sub_zero, zero_sub, ←integral_neg, ←integral_const_mul, ←integral_const_mul, + ←integral_sub], + rotate, + { apply continuous.interval_integrable, + exact continuous_const.mul ((complex.continuous_cos.comp (continuous_const.mul + complex.continuous_of_real)).mul ((complex.continuous_of_real.comp + continuous_cos).pow n)) }, + { apply continuous.interval_integrable, + exact continuous_const.mul + ((complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real)).mul + ((complex.continuous_of_real.comp continuous_cos).pow (n - 2))), }, + { apply nat.sub_pos_of_lt, exact one_lt_two.trans_le hn }, + refine integral_congr (λ x hx, _), + dsimp only, + -- get rid of real trig functions and divions by 2 * z: + rw [complex.of_real_cos, complex.of_real_sin, complex.sin_sq, ←mul_div_right_comm, + ←mul_div_right_comm, ←sub_div, mul_div, ←neg_div], + congr' 1, + have : complex.cos ↑x ^ n = complex.cos ↑x ^ (n - 2) * complex.cos ↑x ^ 2, + { conv_lhs { rw [←nat.sub_add_cancel hn, pow_add] } }, + rw this, + ring }, + { apply continuous.interval_integrable, + exact ((complex.continuous_of_real.comp continuous_cos).pow n).sub + ((continuous_const.mul ((complex.continuous_of_real.comp continuous_sin).pow 2)).mul + ((complex.continuous_of_real.comp continuous_cos).pow (n - 2))) }, + { apply continuous.interval_integrable, + exact complex.continuous_sin.comp (continuous_const.mul complex.continuous_of_real) }, +end + +/-- Note this also holds for `z = 0`, but we do not need this case for `sin_pi_mul_eq`. -/ +lemma integral_cos_mul_cos_pow (hn : 2 ≤ n) (hz : z ≠ 0) : + (1 - 4 * z ^ 2 / n ^ 2) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) = + (n - 1 : ℂ) / n * ∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (n - 2) := +begin + have nne : (n : ℂ) ≠ 0, + { contrapose! hn, rw nat.cast_eq_zero at hn, rw hn, exact zero_lt_two }, + have := integral_cos_mul_cos_pow_aux hn hz, + rw [integral_sin_mul_sin_mul_cos_pow_eq hn hz, sub_eq_neg_add, mul_add, ←sub_eq_iff_eq_add] + at this, + convert congr_arg (λ u:ℂ, -u * (2 * z) ^ 2 / n ^ 2) this using 1; + { field_simp, ring }, +end + +/-- Note this also holds for `z = 0`, but we do not need this case for `sin_pi_mul_eq`. -/ +lemma integral_cos_mul_cos_pow_even (n : ℕ) (hz : z ≠ 0) : + (1 - z ^ 2 / (n + 1) ^ 2) * (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n + 2)) = + (2 * n + 1 : ℂ) / (2 * n + 2) * ∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n) := +begin + convert integral_cos_mul_cos_pow (by linarith : 2 ≤ 2 * n + 2) hz using 3, + { simp only [nat.cast_add, nat.cast_mul, nat.cast_two], + nth_rewrite_rhs 2 ←mul_one (2:ℂ), + rw [←mul_add, mul_pow, ←div_div], + ring }, + { push_cast, ring }, + { push_cast, ring }, +end + +/-- Relate the integral `cos x ^ n` over `[0, π/2]` to the integral of `sin x ^ n` over `[0, π]`, +which is studied in `data.real.pi.wallis` and other places. -/ +lemma integral_cos_pow_eq (n : ℕ) : + (∫ (x:ℝ) in 0..π/2, cos x ^ n) = 1 / 2 * (∫ (x:ℝ) in 0..π, (sin x) ^ n) := +begin + rw [mul_comm (1/2 : ℝ), ←div_eq_iff (one_div_ne_zero (two_ne_zero' ℝ)), ←div_mul, div_one, + mul_two], + have L : interval_integrable _ volume 0 (π / 2) := (continuous_sin.pow n).interval_integrable _ _, + have R : interval_integrable _ volume (π / 2) π := (continuous_sin.pow n).interval_integrable _ _, + rw ←integral_add_adjacent_intervals L R, + congr' 1, + { nth_rewrite 0 (by ring : 0 = π/2 - π/2), + nth_rewrite 2 (by ring : π/2 = π/2 - 0), + rw ←integral_comp_sub_left, + refine integral_congr (λ x _, _), + dsimp only, + rw cos_pi_div_two_sub }, + { nth_rewrite 2 (by ring : π = π/2 + π/2), + nth_rewrite 1 (by ring : π/2 = 0 + π/2), + rw ←integral_comp_add_right, + refine integral_congr (λ x _, _), + dsimp only, + rw sin_add_pi_div_two }, +end + +lemma integral_cos_pow_pos (n : ℕ) : 0 < (∫ (x:ℝ) in 0..π/2, cos x ^ n) := +(integral_cos_pow_eq n).symm ▸ (mul_pos one_half_pos (integral_sin_pow_pos _)) + +/-- Finite form of Euler's sine product, with remainder term expressed as a ratio of cosine +integrals. -/ +lemma sin_pi_mul_eq (z : ℂ) (n : ℕ) : + complex.sin (π * z) = π * z * (∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2)) * + (∫ x in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n)) / ↑∫ x in 0..π/2, cos x ^ (2 * n) := +begin + rcases eq_or_ne z 0 with rfl | hz, + { simp }, + induction n with n hn, + { simp_rw [mul_zero, pow_zero, mul_one, finset.prod_range_zero, mul_one, integral_one, sub_zero], + rw [integral_cos_mul_complex (mul_ne_zero two_ne_zero hz), complex.of_real_zero, mul_zero, + complex.sin_zero, zero_div, sub_zero, + (by { push_cast, field_simp, ring } : 2 * z * ↑(π / 2) = π * z)], + field_simp [complex.of_real_ne_zero.mpr pi_pos.ne'], + ring }, + { rw [hn, finset.prod_range_succ], + set A := ∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2), + set B := ∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ (2 * n), + set C := ∫ x:ℝ in 0..π/2, cos x ^ (2 * n), + have aux' : 2 * n.succ = 2 * n + 2, + { rw [nat.succ_eq_add_one, mul_add, mul_one], }, + have : ∫ x:ℝ in 0..π/2, cos x ^ (2 * n.succ) = (2 * (n:ℝ) + 1) / (2 * n + 2) * C, + { rw integral_cos_pow_eq, + dsimp only [C], + rw [integral_cos_pow_eq, aux', integral_sin_pow, sin_zero, sin_pi, pow_succ, zero_mul, + zero_mul, zero_mul, sub_zero, zero_div, zero_add, ←mul_assoc, ←mul_assoc, + mul_comm (1 / 2 : ℝ) _, nat.cast_mul, nat.cast_bit0, nat.cast_one] }, + rw this, + change ↑π * z * A * B / ↑C = + (↑π * z * (A * (1 - z ^ 2 / (↑n + 1) ^ 2)) * + ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ)) / + ↑((2 * ↑n + 1) / (2 * ↑n + 2) * C), + have : ↑π * z * (A * (1 - z ^ 2 / (↑n + 1) ^ 2)) * + ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ) + = ↑π * z * A * ((1 - z ^ 2 / (↑n.succ) ^ 2) * + ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ)), + { nth_rewrite_rhs 0 nat.succ_eq_add_one, + rw nat.cast_add_one, + ring }, + rw this, + suffices : (1 - z ^ 2 / ↑(n.succ) ^ 2) * + ∫ (x : ℝ) in 0..π / 2, complex.cos (2 * z * ↑x) * ↑(cos x) ^ (2 * n.succ) = + (2 * n + 1) / (2 * n + 2) * B, + { rw [this, complex.of_real_mul, complex.of_real_div], + have : (C:ℂ) ≠ 0 := complex.of_real_ne_zero.mpr (integral_cos_pow_pos _).ne', + have : 2 * (n:ℂ) + 1 ≠ 0, + { convert (nat.cast_add_one_ne_zero (2 * n) : (↑(2 * n) + 1 : ℂ) ≠ 0), + simp }, + have : 2 * (n:ℂ) + 2 ≠ 0, + { convert (nat.cast_add_one_ne_zero (2 * n + 1) : (↑(2 * n + 1) + 1 : ℂ) ≠ 0) using 1, + push_cast, ring }, + field_simp, ring }, + convert integral_cos_mul_cos_pow_even n hz, + rw nat.cast_succ } +end + +end integral_recursion + + +/-! ## Conclusion of the proof + +The main theorem `complex.tendsto_euler_sin_prod`, and its real variant +`real.tendsto_euler_sin_prod`, now follow by combining `sin_pi_mul_eq` with a lemma +stating that the sequence of measures on `[0, π/2]` given by integration against `cos x ^ n` +(suitably normalised) tends to the Dirac measure at 0, as a special case of the general result +`tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`. -/ + +lemma tendsto_integral_cos_pow_mul_div {f : ℝ → ℂ} (hf : continuous_on f (Icc 0 (π/2))) : + tendsto (λ (n : ℕ), (∫ x:ℝ in 0..π/2, ↑(cos x) ^ n * f x) / ↑(∫ x:ℝ in 0..π/2, (cos x) ^ n)) + at_top (𝓝 $ f 0) := +begin + simp_rw [div_eq_inv_mul _ (coe _), ←complex.of_real_inv, integral_of_le (pi_div_two_pos.le), + ←measure_theory.integral_Icc_eq_integral_Ioc, ←complex.of_real_pow, ←complex.real_smul], + have c_lt : ∀ (y : ℝ), y ∈ Icc 0 (π / 2) → y ≠ 0 → cos y < cos 0, from λ y hy hy', + cos_lt_cos_of_nonneg_of_le_pi_div_two (le_refl 0) hy.2 (lt_of_le_of_ne hy.1 hy'.symm), + have c_nonneg : ∀ (x : ℝ), x ∈ Icc 0 (π / 2) → 0 ≤ cos x, from λ x hx, cos_nonneg_of_mem_Icc + ((Icc_subset_Icc_left (neg_nonpos_of_nonneg pi_div_two_pos.le)) hx), + have c_zero_pos : 0 < cos 0, by { rw cos_zero, exact zero_lt_one }, + have zero_mem : (0:ℝ) ∈ closure (interior (Icc 0 (π / 2))), + { rw [interior_Icc, closure_Ioo pi_div_two_pos.ne, left_mem_Icc], + exact pi_div_two_pos.le }, + exact tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on + is_compact_Icc continuous_on_cos c_lt c_nonneg c_zero_pos zero_mem hf +end + +/-- Euler's infinite product formula for the complex sine function. -/ +lemma _root_.complex.tendsto_euler_sin_prod (z : ℂ) : + tendsto (λ n:ℕ, ↑π * z * (∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2))) + at_top (𝓝 $ complex.sin (π * z)) := +begin + have A : tendsto (λ n:ℕ, ↑π * z * (∏ j in finset.range n, (1 - z ^ 2 / (j + 1) ^ 2)) * + (∫ x in 0..π / 2, complex.cos (2 * z * x) * cos x ^ (2 * n)) / + ↑∫ x in 0..π / 2, cos x ^ (2 * n)) + at_top (𝓝 $ _) := tendsto.congr (λ n, (sin_pi_mul_eq z n)) tendsto_const_nhds, + have : 𝓝 (complex.sin (π * z)) = 𝓝 (complex.sin (π * z) * 1) := by rw mul_one, + simp_rw [this, mul_div_assoc] at A, + convert (tendsto_mul_iff_of_ne_zero _ one_ne_zero).mp A, + suffices : tendsto (λ n:ℕ, (∫ x:ℝ in 0..π/2, complex.cos (2 * z * x) * cos x ^ n) + / ↑(∫ x:ℝ in 0..π/2, cos x ^ n)) at_top (𝓝 1), + from this.comp (tendsto_id.const_mul_at_top' zero_lt_two), + have : continuous_on (λ x:ℝ, complex.cos (2 * z * x)) (Icc 0 (π/2)), from + (complex.continuous_cos.comp (continuous_const.mul complex.continuous_of_real)).continuous_on, + convert tendsto_integral_cos_pow_mul_div this, + { ext1 n, congr' 2 with x:1, rw mul_comm }, + { rw [complex.of_real_zero, mul_zero, complex.cos_zero] }, +end + +/-- Euler's infinite product formula for the real sine function. -/ +lemma _root_.real.tendsto_euler_sin_prod (x : ℝ) : + tendsto (λ n:ℕ, π * x * (∏ j in finset.range n, (1 - x ^ 2 / (j + 1) ^ 2))) + at_top (𝓝 $ sin (π * x)) := +begin + convert (complex.continuous_re.tendsto _).comp (complex.tendsto_euler_sin_prod x), + { ext1 n, + rw [function.comp_app, ←complex.of_real_mul, complex.of_real_mul_re], + suffices : ∏ (j : ℕ) in finset.range n, (1 - (x:ℂ) ^ 2 / (↑j + 1) ^ 2) = + ↑∏ (j : ℕ) in finset.range n, (1 - x ^ 2 / (↑j + 1) ^ 2), by rw [this, complex.of_real_re], + rw complex.of_real_prod, + refine finset.prod_congr (by refl) (λ n hn, _), + norm_cast }, + { rw [←complex.of_real_mul, ←complex.of_real_sin, complex.of_real_re] } +end + +end euler_sine diff --git a/src/analysis/special_functions/trigonometric/inverse.lean b/src/analysis/special_functions/trigonometric/inverse.lean index 072612149aa3d..0d6c733ba7551 100644 --- a/src/analysis/special_functions/trigonometric/inverse.lean +++ b/src/analysis/special_functions/trigonometric/inverse.lean @@ -10,6 +10,9 @@ import topology.algebra.order.proj_Icc /-! # Inverse trigonometric functions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + See also `analysis.special_functions.trigonometric.arctan` for the inverse tan function. (This is delayed as it is easier to set up after developing complex trigonometric functions.) @@ -17,7 +20,7 @@ Basic inequalities on trigonometric functions. -/ noncomputable theory -open_locale classical topological_space filter +open_locale classical topology filter open set filter open_locale real @@ -39,7 +42,7 @@ lemma arcsin_le_pi_div_two (x : ℝ) : arcsin x ≤ π / 2 := (arcsin_mem_Icc x) lemma neg_pi_div_two_le_arcsin (x : ℝ) : -(π / 2) ≤ arcsin x := (arcsin_mem_Icc x).1 lemma arcsin_proj_Icc (x : ℝ) : - arcsin (proj_Icc (-1) 1 (neg_le_self $ @zero_le_one ℝ _) x) = arcsin x := + arcsin (proj_Icc (-1) 1 (neg_le_self zero_le_one) x) = arcsin x := by rw [arcsin, function.comp_app, Icc_extend_coe, function.comp_app, Icc_extend] lemma sin_arcsin' {x : ℝ} (hx : x ∈ Icc (-1 : ℝ) 1) : sin (arcsin x) = x := @@ -224,16 +227,36 @@ lemma maps_to_sin_Ioo : maps_to sin (Ioo (-(π / 2)) (π / 2)) (Ioo (-1) 1) := lemma cos_arcsin_nonneg (x : ℝ) : 0 ≤ cos (arcsin x) := cos_nonneg_of_mem_Icc ⟨neg_pi_div_two_le_arcsin _, arcsin_le_pi_div_two _⟩ -lemma cos_arcsin {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : cos (arcsin x) = sqrt (1 - x ^ 2) := -have sin (arcsin x) ^ 2 + cos (arcsin x) ^ 2 = 1 := sin_sq_add_cos_sq (arcsin x), +-- The junk values for `arcsin` and `sqrt` make this true even outside `[-1, 1]`. +lemma cos_arcsin (x : ℝ) : cos (arcsin x) = sqrt (1 - x ^ 2) := begin + by_cases hx₁ : -1 ≤ x, swap, + { rw not_le at hx₁, + rw [arcsin_of_le_neg_one hx₁.le, cos_neg, cos_pi_div_two, sqrt_eq_zero_of_nonpos], + nlinarith }, + by_cases hx₂ : x ≤ 1, swap, + { rw not_le at hx₂, + rw [arcsin_of_one_le hx₂.le, cos_pi_div_two, sqrt_eq_zero_of_nonpos], + nlinarith }, + have : sin (arcsin x) ^ 2 + cos (arcsin x) ^ 2 = 1 := sin_sq_add_cos_sq (arcsin x), rw [← eq_sub_iff_add_eq', ← sqrt_inj (sq_nonneg _) (sub_nonneg.2 (sin_sq_le_one (arcsin x))), sq, sqrt_mul_self (cos_arcsin_nonneg _)] at this, rw [this, sin_arcsin hx₁ hx₂], end +-- The junk values for `arcsin` and `sqrt` make this true even outside `[-1, 1]`. +lemma tan_arcsin (x : ℝ) : tan (arcsin x) = x / sqrt (1 - x ^ 2) := +begin + rw [tan_eq_sin_div_cos, cos_arcsin], + by_cases hx₁ : -1 ≤ x, swap, + { have h : sqrt (1 - x ^ 2) = 0, { exact sqrt_eq_zero_of_nonpos (by nlinarith) }, rw h, simp }, + by_cases hx₂ : x ≤ 1, swap, + { have h : sqrt (1 - x ^ 2) = 0, { exact sqrt_eq_zero_of_nonpos (by nlinarith) }, rw h, simp }, + rw sin_arcsin hx₁ hx₂ +end + /-- Inverse of the `cos` function, returns values in the range `0 ≤ arccos x` and `arccos x ≤ π`. - If the argument is not between `-1` and `1` it defaults to `π / 2` -/ + It defaults to `π` on `(-∞, -1)` and to `0` to `(1, ∞)`. -/ @[pp_nodot] noncomputable def arccos (x : ℝ) : ℝ := π / 2 - arcsin x @@ -248,6 +271,9 @@ by unfold arccos; linarith [neg_pi_div_two_le_arcsin x] lemma arccos_nonneg (x : ℝ) : 0 ≤ arccos x := by unfold arccos; linarith [arcsin_le_pi_div_two x] +@[simp] lemma arccos_pos {x : ℝ} : 0 < arccos x ↔ x < 1 := +by simp [arccos] + lemma cos_arccos {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : cos (arccos x) = x := by rw [arccos, cos_pi_div_two_sub, sin_arcsin hx₁ hx₂] @@ -281,15 +307,54 @@ by rw [arccos, sub_eq_iff_eq_add, ← sub_eq_iff_eq_add', div_two_sub_self, neg_ lemma arccos_neg (x : ℝ) : arccos (-x) = π - arccos x := by rw [← add_halves π, arccos, arcsin_neg, arccos, add_sub_assoc, sub_sub_self, sub_neg_eq_add] -lemma sin_arccos {x : ℝ} (hx₁ : -1 ≤ x) (hx₂ : x ≤ 1) : sin (arccos x) = sqrt (1 - x ^ 2) := -by rw [arccos_eq_pi_div_two_sub_arcsin, sin_pi_div_two_sub, cos_arcsin hx₁ hx₂] +lemma arccos_of_one_le {x : ℝ} (hx : 1 ≤ x) : arccos x = 0 := +by rw [arccos, arcsin_of_one_le hx, sub_self] + +lemma arccos_of_le_neg_one {x : ℝ} (hx : x ≤ -1) : arccos x = π := +by rw [arccos, arcsin_of_le_neg_one hx, sub_neg_eq_add, add_halves'] + +-- The junk values for `arccos` and `sqrt` make this true even outside `[-1, 1]`. +lemma sin_arccos (x : ℝ) : sin (arccos x) = sqrt (1 - x ^ 2) := +begin + by_cases hx₁ : -1 ≤ x, swap, + { rw not_le at hx₁, + rw [arccos_of_le_neg_one hx₁.le, sin_pi, sqrt_eq_zero_of_nonpos], + nlinarith }, + by_cases hx₂ : x ≤ 1, swap, + { rw not_le at hx₂, + rw [arccos_of_one_le hx₂.le, sin_zero, sqrt_eq_zero_of_nonpos], + nlinarith }, + rw [arccos_eq_pi_div_two_sub_arcsin, sin_pi_div_two_sub, cos_arcsin] +end @[simp] lemma arccos_le_pi_div_two {x} : arccos x ≤ π / 2 ↔ 0 ≤ x := by simp [arccos] +@[simp] lemma arccos_lt_pi_div_two {x : ℝ} : arccos x < π / 2 ↔ 0 < x := by simp [arccos] + @[simp] lemma arccos_le_pi_div_four {x} : arccos x ≤ π / 4 ↔ sqrt 2 / 2 ≤ x := by { rw [arccos, ← pi_div_four_le_arcsin], split; { intro, linarith } } @[continuity] lemma continuous_arccos : continuous arccos := continuous_const.sub continuous_arcsin +-- The junk values for `arccos` and `sqrt` make this true even outside `[-1, 1]`. +lemma tan_arccos (x : ℝ) : tan (arccos x) = sqrt (1 - x ^ 2) / x := +by rw [arccos, tan_pi_div_two_sub, tan_arcsin, inv_div] + +-- The junk values for `arccos` and `sqrt` make this true even for `1 < x`. +lemma arccos_eq_arcsin {x : ℝ} (h : 0 ≤ x) : + arccos x = arcsin (sqrt (1 - x ^ 2)) := +(arcsin_eq_of_sin_eq (sin_arccos _) + ⟨(left.neg_nonpos_iff.2 (div_nonneg pi_pos.le (by norm_num))).trans (arccos_nonneg _), + arccos_le_pi_div_two.2 h⟩).symm + +-- The junk values for `arcsin` and `sqrt` make this true even for `1 < x`. +lemma arcsin_eq_arccos {x : ℝ} (h : 0 ≤ x) : + arcsin x = arccos (sqrt (1 - x ^ 2)) := +begin + rw [eq_comm, ← cos_arcsin], + exact arccos_cos (arcsin_nonneg.2 h) + ((arcsin_le_pi_div_two _).trans (div_le_self pi_pos.le one_le_two)) +end + end real diff --git a/src/analysis/special_functions/trigonometric/inverse_deriv.lean b/src/analysis/special_functions/trigonometric/inverse_deriv.lean index 897138e6344f9..ac904bb69220b 100644 --- a/src/analysis/special_functions/trigonometric/inverse_deriv.lean +++ b/src/analysis/special_functions/trigonometric/inverse_deriv.lean @@ -9,11 +9,14 @@ import analysis.special_functions.trigonometric.deriv /-! # derivatives of the inverse trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Derivatives of `arcsin` and `arccos`. -/ noncomputable theory -open_locale classical topological_space filter +open_locale classical topology filter open set filter open_locale real @@ -34,7 +37,7 @@ begin cont_diff_at_const.congr_of_eventually_eq this⟩ }, cases h₂.lt_or_lt with h₂ h₂, { have : 0 < sqrt (1 - x ^ 2) := sqrt_pos.2 (by nlinarith [h₁, h₂]), - simp only [← cos_arcsin h₁.le h₂.le, one_div] at this ⊢, + simp only [← cos_arcsin, one_div] at this ⊢, exact ⟨sin_local_homeomorph.has_strict_deriv_at_symm ⟨h₁, h₂⟩ this.ne' (has_strict_deriv_at_sin _), sin_local_homeomorph.cont_diff_at_symm_deriv this.ne' ⟨h₁, h₂⟩ @@ -54,7 +57,7 @@ lemma has_deriv_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) : has_deriv_at arcsin (1 / sqrt (1 - x ^ 2)) x := (has_strict_deriv_at_arcsin h₁ h₂).has_deriv_at -lemma cont_diff_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : with_top ℕ} : +lemma cont_diff_at_arcsin {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : ℕ∞} : cont_diff_at ℝ n arcsin x := (deriv_arcsin_aux h₁ h₂).2.of_le le_top @@ -82,7 +85,7 @@ begin refine ⟨_, λ h, (has_deriv_within_at_arcsin_Ici h).differentiable_within_at⟩, rintro h rfl, have : sin ∘ arcsin =ᶠ[𝓝[≥] (-1 : ℝ)] id, - { filter_upwards [Icc_mem_nhds_within_Ici ⟨le_rfl, neg_lt_self (@zero_lt_one ℝ _ _)⟩] + { filter_upwards [Icc_mem_nhds_within_Ici ⟨le_rfl, neg_lt_self (zero_lt_one' ℝ)⟩] with x using sin_arcsin', }, have := h.has_deriv_within_at.sin.congr_of_eventually_eq this.symm (by simp), simpa using (unique_diff_on_Ici _ _ left_mem_Ici).eq_deriv _ this (has_deriv_within_at_id _ _) @@ -117,14 +120,14 @@ lemma differentiable_on_arcsin : differentiable_on ℝ arcsin {-1, 1}ᶜ := λ x hx, (differentiable_at_arcsin.2 ⟨λ h, hx (or.inl h), λ h, hx (or.inr h)⟩).differentiable_within_at -lemma cont_diff_on_arcsin {n : with_top ℕ} : +lemma cont_diff_on_arcsin {n : ℕ∞} : cont_diff_on ℝ n arcsin {-1, 1}ᶜ := λ x hx, (cont_diff_at_arcsin (mt or.inl hx) (mt or.inr hx)).cont_diff_within_at -lemma cont_diff_at_arcsin_iff {x : ℝ} {n : with_top ℕ} : +lemma cont_diff_at_arcsin_iff {x : ℝ} {n : ℕ∞} : cont_diff_at ℝ n arcsin x ↔ n = 0 ∨ (x ≠ -1 ∧ x ≠ 1) := ⟨λ h, or_iff_not_imp_left.2 $ λ hn, differentiable_at_arcsin.1 $ h.differentiable_at $ - with_top.one_le_iff_pos.2 (pos_iff_ne_zero.2 hn), + enat.one_le_iff_ne_zero.2 hn, λ h, h.elim (λ hn, hn.symm ▸ (cont_diff_zero.2 continuous_arcsin).cont_diff_at) $ λ hx, cont_diff_at_arcsin hx.1 hx.2⟩ @@ -140,7 +143,7 @@ lemma has_deriv_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) : has_deriv_at arccos (-(1 / sqrt (1 - x ^ 2))) x := (has_deriv_at_arcsin h₁ h₂).const_sub (π / 2) -lemma cont_diff_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : with_top ℕ} : +lemma cont_diff_at_arccos {x : ℝ} (h₁ : x ≠ -1) (h₂ : x ≠ 1) {n : ℕ∞} : cont_diff_at ℝ n arccos x := cont_diff_at_const.sub (cont_diff_at_arcsin h₁ h₂) @@ -170,11 +173,11 @@ funext $ λ x, (deriv_const_sub _).trans $ by simp only [deriv_arcsin] lemma differentiable_on_arccos : differentiable_on ℝ arccos {-1, 1}ᶜ := differentiable_on_arcsin.const_sub _ -lemma cont_diff_on_arccos {n : with_top ℕ} : +lemma cont_diff_on_arccos {n : ℕ∞} : cont_diff_on ℝ n arccos {-1, 1}ᶜ := cont_diff_on_const.sub cont_diff_on_arcsin -lemma cont_diff_at_arccos_iff {x : ℝ} {n : with_top ℕ} : +lemma cont_diff_at_arccos_iff {x : ℝ} {n : ℕ∞} : cont_diff_at ℝ n arccos x ↔ n = 0 ∨ (x ≠ -1 ∧ x ≠ 1) := by refine iff.trans ⟨λ h, _, λ h, _⟩ cont_diff_at_arcsin_iff; simpa [arccos] using (@cont_diff_at_const _ _ _ _ _ _ _ _ _ _ (π / 2)).sub h diff --git a/src/analysis/special_functions/trigonometric/series.lean b/src/analysis/special_functions/trigonometric/series.lean new file mode 100644 index 0000000000000..a3ece09d3d75a --- /dev/null +++ b/src/analysis/special_functions/trigonometric/series.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import analysis.special_functions.exponential +/-! +# Trigonometric functions as sums of infinite series + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we express trigonometric functions in terms of their series expansion. + +## Main results + +* `complex.has_sum_cos`, `complex.tsum_cos`: `complex.cos` as the sum of an infinite series. +* `real.has_sum_cos`, `real.tsum_cos`: `real.cos` as the sum of an infinite series. +* `complex.has_sum_sin`, `complex.tsum_sin`: `complex.sin` as the sum of an infinite series. +* `real.has_sum_sin`, `real.tsum_sin`: `real.sin` as the sum of an infinite series. +-/ + +open_locale nat + +/-! ### `cos` and `sin` for `ℝ` and `ℂ` -/ + +section sin_cos + +lemma complex.has_sum_cos' (z : ℂ) : + has_sum (λ n : ℕ, (z * complex.I) ^ (2 * n) / ↑(2 * n)!) (complex.cos z) := +begin + rw [complex.cos, complex.exp_eq_exp_ℂ], + have := ((exp_series_div_has_sum_exp ℂ (z * complex.I)).add + (exp_series_div_has_sum_exp ℂ (-z * complex.I))).div_const 2, + replace := ((nat.div_mod_equiv 2)).symm.has_sum_iff.mpr this, + dsimp [function.comp] at this, + simp_rw [←mul_comm 2 _] at this, + refine this.prod_fiberwise (λ k, _), + dsimp only, + convert has_sum_fintype (_ : fin 2 → ℂ) using 1, + rw fin.sum_univ_two, + simp_rw [fin.coe_zero, fin.coe_one, add_zero, pow_succ', pow_mul, + mul_pow, neg_sq, ←two_mul, neg_mul, mul_neg, neg_div, add_right_neg, zero_div, add_zero, + mul_div_cancel_left _ (two_ne_zero : (2 : ℂ) ≠ 0)], +end + +lemma complex.has_sum_sin' (z : ℂ) : + has_sum (λ n : ℕ, (z * complex.I) ^ (2 * n + 1) / ↑(2 * n + 1)! / complex.I) (complex.sin z) := +begin + rw [complex.sin, complex.exp_eq_exp_ℂ], + have := (((exp_series_div_has_sum_exp ℂ (-z * complex.I)).sub + (exp_series_div_has_sum_exp ℂ (z * complex.I))).mul_right complex.I).div_const 2, + replace := ((nat.div_mod_equiv 2)).symm.has_sum_iff.mpr this, + dsimp [function.comp] at this, + simp_rw [←mul_comm 2 _] at this, + refine this.prod_fiberwise (λ k, _), + dsimp only, + convert has_sum_fintype (_ : fin 2 → ℂ) using 1, + rw fin.sum_univ_two, + simp_rw [fin.coe_zero, fin.coe_one, add_zero, pow_succ', pow_mul, + mul_pow, neg_sq, sub_self, zero_mul, zero_div, zero_add, + neg_mul, mul_neg, neg_div, ← neg_add', ←two_mul, neg_mul, neg_div, mul_assoc, + mul_div_cancel_left _ (two_ne_zero : (2 : ℂ) ≠ 0), complex.div_I], +end + +/-- The power series expansion of `complex.cos`. -/ +lemma complex.has_sum_cos (z : ℂ) : + has_sum (λ n : ℕ, ((-1) ^ n) * z ^ (2 * n) / ↑(2 * n)!) (complex.cos z) := +begin + convert complex.has_sum_cos' z using 1, + simp_rw [mul_pow, pow_mul, complex.I_sq, mul_comm] +end + +/-- The power series expansion of `complex.sin`. -/ +lemma complex.has_sum_sin (z : ℂ) : + has_sum (λ n : ℕ, ((-1) ^ n) * z ^ (2 * n + 1) / ↑(2 * n + 1)!) (complex.sin z) := +begin + convert complex.has_sum_sin' z using 1, + simp_rw [mul_pow, pow_succ', pow_mul, complex.I_sq, ←mul_assoc, + mul_div_assoc, div_right_comm, div_self complex.I_ne_zero, mul_comm _ ((-1 : ℂ)^_), mul_one_div, + mul_div_assoc, mul_assoc] +end + +lemma complex.cos_eq_tsum' (z : ℂ) : + complex.cos z = ∑' n : ℕ, (z * complex.I) ^ (2 * n) / ↑(2 * n)! := +(complex.has_sum_cos' z).tsum_eq.symm + +lemma complex.sin_eq_tsum' (z : ℂ) : + complex.sin z = ∑' n : ℕ, (z * complex.I) ^ (2 * n + 1) / ↑(2 * n + 1)! / complex.I := +(complex.has_sum_sin' z).tsum_eq.symm + +lemma complex.cos_eq_tsum (z : ℂ) : + complex.cos z = ∑' n : ℕ, ((-1) ^ n) * z ^ (2 * n) / ↑(2 * n)! := +(complex.has_sum_cos z).tsum_eq.symm + +lemma complex.sin_eq_tsum (z : ℂ) : + complex.sin z = ∑' n : ℕ, ((-1) ^ n) * z ^ (2 * n + 1) / ↑(2 * n + 1)! := +(complex.has_sum_sin z).tsum_eq.symm + +/-- The power series expansion of `real.cos`. -/ +lemma real.has_sum_cos (r : ℝ) : + has_sum (λ n : ℕ, ((-1) ^ n) * r ^ (2 * n) / ↑(2 * n)!) (real.cos r) := +by exact_mod_cast complex.has_sum_cos r + +/-- The power series expansion of `real.sin`. -/ +lemma real.has_sum_sin (r : ℝ) : + has_sum (λ n : ℕ, ((-1) ^ n) * r ^ (2 * n + 1) / ↑(2 * n + 1)!) (real.sin r) := +by exact_mod_cast complex.has_sum_sin r + +lemma real.cos_eq_tsum (r : ℝ) : + real.cos r = ∑' n : ℕ, ((-1) ^ n) * r ^ (2 * n) / ↑(2 * n)! := +(real.has_sum_cos r).tsum_eq.symm + +lemma real.sin_eq_tsum (r : ℝ) : + real.sin r = ∑' n : ℕ, ((-1) ^ n) * r ^ (2 * n + 1) / ↑(2 * n + 1)! := +(real.has_sum_sin r).tsum_eq.symm + +end sin_cos diff --git a/src/analysis/specific_limits/basic.lean b/src/analysis/specific_limits/basic.lean index 1753382c4a033..aecf5fd432bf4 100644 --- a/src/analysis/specific_limits/basic.lean +++ b/src/analysis/specific_limits/basic.lean @@ -7,10 +7,14 @@ import algebra.geom_sum import order.filter.archimedean import order.iterate import topology.instances.ennreal +import topology.algebra.algebra /-! # A collection of specific limit computations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file, by design, is independent of `normed_space` in the import hierarchy. It contains important specific limit computations in metric spaces, in ordered rings/fields, and in specific instances of these such as `ℝ`, `ℝ≥0` and `ℝ≥0∞`. @@ -19,7 +23,7 @@ instances of these such as `ℝ`, `ℝ≥0` and `ℝ≥0∞`. noncomputable theory open classical set function filter finset metric -open_locale classical topological_space nat big_operators uniformity nnreal ennreal +open_locale classical topology nat big_operators uniformity nnreal ennreal variables {α : Type*} {β : Type*} {ι : Type*} @@ -30,7 +34,7 @@ lemma tendsto_const_div_at_top_nhds_0_nat (C : ℝ) : tendsto (λ n : ℕ, C / n by simpa only [mul_zero] using tendsto_const_nhds.mul tendsto_inverse_at_top_nhds_0_nat lemma nnreal.tendsto_inverse_at_top_nhds_0_nat : tendsto (λ n : ℕ, (n : ℝ≥0)⁻¹) at_top (𝓝 0) := -by { rw ← nnreal.tendsto_coe, convert tendsto_inverse_at_top_nhds_0_nat, simp } +by { rw ← nnreal.tendsto_coe, exact tendsto_inverse_at_top_nhds_0_nat } lemma nnreal.tendsto_const_div_at_top_nhds_0_nat (C : ℝ≥0) : tendsto (λ n : ℕ, C / n) at_top (𝓝 0) := @@ -41,6 +45,34 @@ lemma tendsto_one_div_add_at_top_nhds_0_nat : suffices tendsto (λ n : ℕ, 1 / (↑(n + 1) : ℝ)) at_top (𝓝 0), by simpa, (tendsto_add_at_top_iff_nat 1).2 (tendsto_const_div_at_top_nhds_0_nat 1) +/-- The limit of `n / (n + x)` is 1, for any constant `x` (valid in `ℝ` or any topological division +algebra over `ℝ`, e.g., `ℂ`). + +TODO: introduce a typeclass saying that `1 / n` tends to 0 at top, making it possible to get this +statement simultaneously on `ℚ`, `ℝ` and `ℂ`. -/ +lemma tendsto_coe_nat_div_add_at_top + {𝕜 : Type*} [division_ring 𝕜] [topological_space 𝕜] [char_zero 𝕜] [algebra ℝ 𝕜] + [has_continuous_smul ℝ 𝕜] [topological_division_ring 𝕜] + (x : 𝕜) : + tendsto (λ n:ℕ, (n:𝕜) / (n + x)) at_top (𝓝 1) := +begin + refine tendsto.congr' ((eventually_ne_at_top 0).mp (eventually_of_forall (λ n hn, _))) _, + { exact λ n:ℕ, 1 / (1 + x / n) }, + { field_simp [nat.cast_ne_zero.mpr hn] }, + { have : 𝓝 (1:𝕜) = 𝓝 (1 / (1 + x * ↑(0:ℝ))), + by rw [algebra_map.coe_zero, mul_zero, add_zero, div_one], + rw this, + refine tendsto_const_nhds.div (tendsto_const_nhds.add _) (by simp), + simp_rw div_eq_mul_inv, + refine (tendsto_const_nhds.mul _), + have : (λ n : ℕ, (n : 𝕜)⁻¹) = (λ n : ℕ, ↑((n : ℝ)⁻¹)), + { ext1 n, + rw [←(map_nat_cast (algebra_map ℝ 𝕜) n), ←map_inv₀ (algebra_map ℝ 𝕜)], + refl, }, + rw this, + exact ((continuous_algebra_map ℝ 𝕜).tendsto _).comp tendsto_inverse_at_top_nhds_0_nat } +end + /-! ### Powers -/ lemma tendsto_add_one_pow_at_top_at_top_of_pos [linear_ordered_semiring α] [archimedean α] {r : α} @@ -138,7 +170,6 @@ lemma has_sum_geometric_of_lt_1 {r : ℝ} (h₁ : 0 ≤ r) (h₂ : r < 1) : have r ≠ 1, from ne_of_lt h₂, have tendsto (λn, (r ^ n - 1) * (r - 1)⁻¹) at_top (𝓝 ((0 - 1) * (r - 1)⁻¹)), from ((tendsto_pow_at_top_nhds_0_of_lt_1 h₁ h₂).sub tendsto_const_nhds).mul tendsto_const_nhds, -have (λ n, (∑ i in range n, r ^ i)) = (λ n, geom_sum r n) := rfl, (has_sum_iff_tendsto_nat_of_nonneg (pow_nonneg h₁) _).mpr $ by simp [neg_inv, geom_sum_eq, div_eq_mul_inv, *] at * @@ -310,7 +341,7 @@ end /-- If `edist (f n) (f (n+1))` is bounded by `C * 2^-n`, then the distance from `f 0` to the limit of `f` is bounded above by `2 * C`. -/ lemma edist_le_of_edist_le_geometric_two_of_tendsto₀: edist (f 0) a ≤ 2 * C := -by simpa only [pow_zero, div_eq_mul_inv, ennreal.inv_one, mul_one] +by simpa only [pow_zero, div_eq_mul_inv, inv_one, mul_one] using edist_le_of_edist_le_geometric_two_of_tendsto C hu ha 0 end edist_le_geometric_two @@ -378,7 +409,7 @@ lemma dist_le_of_le_geometric_two_of_tendsto {a : α} (ha : tendsto f at_top ( dist (f n) a ≤ C / 2^n := begin convert dist_le_tsum_of_dist_le_of_tendsto _ hu₂ (summable_geometric_two' C) ha n, - simp only [add_comm n, pow_add, ← div_div_eq_div_mul], + simp only [add_comm n, pow_add, ← div_div], symmetry, exact ((has_sum_geometric_two' C).div_const _).tsum_eq end @@ -400,7 +431,7 @@ begin exact pow_pos (zero_lt_one.trans hm) _ end -/-! ### Positive sequences with small sums on encodable types -/ +/-! ### Positive sequences with small sums on countable types -/ /-- For any positive `ε`, define on an encodable type a positive sequence with sum less than `ε` -/ def pos_sum_of_encodable {ε : ℝ} (hε : 0 < ε) @@ -440,43 +471,45 @@ end namespace nnreal -theorem exists_pos_sum_of_encodable {ε : ℝ≥0} (hε : ε ≠ 0) (ι) [encodable ι] : +theorem exists_pos_sum_of_countable {ε : ℝ≥0} (hε : ε ≠ 0) (ι) [countable ι] : ∃ ε' : ι → ℝ≥0, (∀ i, 0 < ε' i) ∧ ∃c, has_sum ε' c ∧ c < ε := -let ⟨a, a0, aε⟩ := exists_between (pos_iff_ne_zero.2 hε) in -let ⟨ε', hε', c, hc, hcε⟩ := pos_sum_of_encodable a0 ι in -⟨ λi, ⟨ε' i, le_of_lt $ hε' i⟩, assume i, nnreal.coe_lt_coe.1 $ hε' i, - ⟨c, has_sum_le (assume i, le_of_lt $ hε' i) has_sum_zero hc ⟩, nnreal.has_sum_coe.1 hc, - lt_of_le_of_lt (nnreal.coe_le_coe.1 hcε) aε ⟩ +begin + casesI nonempty_encodable ι, + obtain ⟨a, a0, aε⟩ := exists_between (pos_iff_ne_zero.2 hε), + obtain ⟨ε', hε', c, hc, hcε⟩ := pos_sum_of_encodable a0 ι, + exact ⟨λ i, ⟨ε' i, (hε' i).le⟩, λ i, nnreal.coe_lt_coe.1 $ hε' i, ⟨c, has_sum_le (λ i, (hε' i).le) + has_sum_zero hc⟩, nnreal.has_sum_coe.1 hc, aε.trans_le' $ nnreal.coe_le_coe.1 hcε⟩, +end end nnreal namespace ennreal -theorem exists_pos_sum_of_encodable {ε : ℝ≥0∞} (hε : ε ≠ 0) (ι) [encodable ι] : +theorem exists_pos_sum_of_countable {ε : ℝ≥0∞} (hε : ε ≠ 0) (ι) [countable ι] : ∃ ε' : ι → ℝ≥0, (∀ i, 0 < ε' i) ∧ ∑' i, (ε' i : ℝ≥0∞) < ε := begin rcases exists_between (pos_iff_ne_zero.2 hε) with ⟨r, h0r, hrε⟩, rcases lt_iff_exists_coe.1 hrε with ⟨x, rfl, hx⟩, - rcases nnreal.exists_pos_sum_of_encodable (coe_pos.1 h0r).ne' ι with ⟨ε', hp, c, hc, hcr⟩, + rcases nnreal.exists_pos_sum_of_countable (coe_pos.1 h0r).ne' ι with ⟨ε', hp, c, hc, hcr⟩, exact ⟨ε', hp, (ennreal.tsum_coe_eq hc).symm ▸ lt_trans (coe_lt_coe.2 hcr) hrε⟩ end -theorem exists_pos_sum_of_encodable' {ε : ℝ≥0∞} (hε : ε ≠ 0) (ι) [encodable ι] : +theorem exists_pos_sum_of_countable' {ε : ℝ≥0∞} (hε : ε ≠ 0) (ι) [countable ι] : ∃ ε' : ι → ℝ≥0∞, (∀ i, 0 < ε' i) ∧ (∑' i, ε' i) < ε := -let ⟨δ, δpos, hδ⟩ := exists_pos_sum_of_encodable hε ι in +let ⟨δ, δpos, hδ⟩ := exists_pos_sum_of_countable hε ι in ⟨λ i, δ i, λ i, ennreal.coe_pos.2 (δpos i), hδ⟩ -theorem exists_pos_tsum_mul_lt_of_encodable {ε : ℝ≥0∞} (hε : ε ≠ 0) {ι} [encodable ι] +theorem exists_pos_tsum_mul_lt_of_countable {ε : ℝ≥0∞} (hε : ε ≠ 0) {ι} [countable ι] (w : ι → ℝ≥0∞) (hw : ∀ i, w i ≠ ∞) : ∃ δ : ι → ℝ≥0, (∀ i, 0 < δ i) ∧ ∑' i, (w i * δ i : ℝ≥0∞) < ε := begin lift w to ι → ℝ≥0 using hw, - rcases exists_pos_sum_of_encodable hε ι with ⟨δ', Hpos, Hsum⟩, + rcases exists_pos_sum_of_countable hε ι with ⟨δ', Hpos, Hsum⟩, have : ∀ i, 0 < max 1 (w i), from λ i, zero_lt_one.trans_le (le_max_left _ _), - refine ⟨λ i, δ' i / max 1 (w i), λ i, nnreal.div_pos (Hpos _) (this i), _⟩, + refine ⟨λ i, δ' i / max 1 (w i), λ i, div_pos (Hpos _) (this i), _⟩, refine lt_of_le_of_lt (ennreal.tsum_le_tsum $ λ i, _) Hsum, rw [coe_div (this i).ne'], - refine mul_le_of_le_div' (ennreal.mul_le_mul le_rfl $ ennreal.inv_le_inv.2 _), + refine mul_le_of_le_div' (mul_le_mul_left' (ennreal.inv_le_inv.2 _) _), exact coe_le_coe.2 (le_max_right _ _) end @@ -499,7 +532,7 @@ tendsto_of_tendsto_of_tendsto_of_le_of_le' refine (eventually_gt_at_top 0).mono (λ n hn, _), rcases nat.exists_eq_succ_of_ne_zero hn.ne.symm with ⟨k, rfl⟩, rw [← prod_range_add_one_eq_factorial, pow_eq_prod_const, div_eq_mul_inv, ← inv_eq_one_div, - prod_nat_cast, nat.cast_succ, ← prod_inv_distrib', ← prod_mul_distrib, + prod_nat_cast, nat.cast_succ, ← prod_inv_distrib, ← prod_mul_distrib, finset.prod_range_succ'], simp only [prod_range_succ', one_mul, nat.cast_add, zero_add, nat.cast_one], refine mul_le_of_le_one_left (inv_nonneg.mpr $ by exact_mod_cast hn.le) (prod_le_one _ _); @@ -540,7 +573,7 @@ end lemma tendsto_nat_floor_div_at_top : tendsto (λ x, (⌊x⌋₊ : R) / x) at_top (𝓝 1) := -by simpa using tendsto_nat_floor_mul_div_at_top (@zero_le_one R _) +by simpa using tendsto_nat_floor_mul_div_at_top (zero_le_one' R) lemma tendsto_nat_ceil_mul_div_at_top {a : R} (ha : 0 ≤ a) : tendsto (λ x, (⌈a * x⌉₊ : R) / x) at_top (𝓝 a) := @@ -559,6 +592,6 @@ end lemma tendsto_nat_ceil_div_at_top : tendsto (λ x, (⌈x⌉₊ : R) / x) at_top (𝓝 1) := -by simpa using tendsto_nat_ceil_mul_div_at_top (@zero_le_one R _) +by simpa using tendsto_nat_ceil_mul_div_at_top (zero_le_one' R) end diff --git a/src/analysis/specific_limits/floor_pow.lean b/src/analysis/specific_limits/floor_pow.lean new file mode 100644 index 0000000000000..1c7c1e209188a --- /dev/null +++ b/src/analysis/specific_limits/floor_pow.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2022 Sébastien Gouëzel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Sébastien Gouëzel +-/ + +import analysis.specific_limits.basic +import analysis.special_functions.pow.real + +/-! +# Results on discretized exponentials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We state several auxiliary results pertaining to sequences of the form `⌊c^n⌋₊`. + +* `tendsto_div_of_monotone_of_tendsto_div_floor_pow`: If a monotone sequence `u` is such that + `u ⌊c^n⌋₊ / ⌊c^n⌋₊` converges to a limit `l` for all `c > 1`, then `u n / n` tends to `l`. +* `sum_div_nat_floor_pow_sq_le_div_sq`: The sum of `1/⌊c^i⌋₊^2` above a threshold `j` is comparable + to `1/j^2`, up to a multiplicative constant. +-/ + +open filter finset +open_locale topology big_operators + +/-- If a monotone sequence `u` is such that `u n / n` tends to a limit `l` along subsequences with +exponential growth rate arbitrarily close to `1`, then `u n / n` tends to `l`. -/ +lemma tendsto_div_of_monotone_of_exists_subseq_tendsto_div (u : ℕ → ℝ) (l : ℝ) (hmono : monotone u) + (hlim : ∀ (a : ℝ), 1 < a → ∃ c : ℕ → ℕ, (∀ᶠ n in at_top, (c (n+1) : ℝ) ≤ a * c n) ∧ + tendsto c at_top at_top ∧ tendsto (λ n, u (c n) / (c n)) at_top (𝓝 l)) : + tendsto (λ n, u n / n) at_top (𝓝 l) := +begin + /- To check the result up to some `ε > 0`, we use a sequence `c` for which the ratio + `c (N+1) / c N` is bounded by `1 + ε`. Sandwiching a given `n` between two consecutive values of + `c`, say `c N` and `c (N+1)`, one can then bound `u n / n` from above by `u (c N) / c (N - 1)` + and from below by `u (c (N - 1)) / c N` (using that `u` is monotone), which are both comparable + to the limit `l` up to `1 + ε`. + We give a version of this proof by clearing out denominators first, to avoid discussing the sign + of different quantities. -/ + have lnonneg : 0 ≤ l, + { rcases hlim 2 one_lt_two with ⟨c, cgrowth, ctop, clim⟩, + have : tendsto (λ n, u 0 / (c n)) at_top (𝓝 0) := + tendsto_const_nhds.div_at_top (tendsto_coe_nat_at_top_iff.2 ctop), + apply le_of_tendsto_of_tendsto' this clim (λ n, _), + simp_rw [div_eq_inv_mul], + exact mul_le_mul_of_nonneg_left (hmono (zero_le _)) (inv_nonneg.2 (nat.cast_nonneg _)) }, + have A : ∀ (ε : ℝ), 0 < ε → ∀ᶠ n in at_top, u n - n * l ≤ (ε * (1 + ε + l)) * n, + { assume ε εpos, + rcases hlim (1 + ε) ((lt_add_iff_pos_right _).2 εpos) with ⟨c, cgrowth, ctop, clim⟩, + have L : ∀ᶠ n in at_top, u (c n) - c n * l ≤ ε * c n, + { rw [← tendsto_sub_nhds_zero_iff, ← asymptotics.is_o_one_iff ℝ, + asymptotics.is_o_iff] at clim, + filter_upwards [clim εpos, ctop (Ioi_mem_at_top 0)] with n hn cnpos', + have cnpos : 0 < c n := cnpos', + calc u (c n) - c n * l + = (u (c n) / c n - l) * c n: + by simp only [cnpos.ne', ne.def, nat.cast_eq_zero, not_false_iff] with field_simps + ... ≤ ε * c n : + begin + refine mul_le_mul_of_nonneg_right _ (nat.cast_nonneg _), + simp only [mul_one, real.norm_eq_abs, abs_one] at hn, + exact le_trans (le_abs_self _) hn, + end }, + obtain ⟨a, ha⟩ : ∃ (a : ℕ), ∀ (b : ℕ), a ≤ b → (c (b + 1) : ℝ) ≤ (1 + ε) * c b + ∧ u (c b) - c b * l ≤ ε * c b := eventually_at_top.1 (cgrowth.and L), + let M := ((finset.range (a+1)).image (λ i, c i)).max' (by simp), + filter_upwards [Ici_mem_at_top M] with n hn, + have exN : ∃ N, n < c N, + { rcases (tendsto_at_top.1 ctop (n+1)).exists with ⟨N, hN⟩, + exact ⟨N, by linarith only [hN]⟩ }, + let N := nat.find exN, + have ncN : n < c N := nat.find_spec exN, + have aN : a + 1 ≤ N, + { by_contra' h, + have cNM : c N ≤ M, + { apply le_max', + apply mem_image_of_mem, + exact mem_range.2 h }, + exact lt_irrefl _ ((cNM.trans hn).trans_lt ncN) }, + have Npos : 0 < N := lt_of_lt_of_le (nat.succ_pos') aN, + have cNn : c (N - 1) ≤ n, + { have : N - 1 < N := nat.pred_lt Npos.ne', + simpa only [not_lt] using nat.find_min exN this }, + have IcN : (c N : ℝ) ≤ (1 + ε) * (c (N - 1)), + { have A : a ≤ N - 1, by linarith only [aN, Npos], + have B : N - 1 + 1 = N := nat.succ_pred_eq_of_pos Npos, + have := (ha _ A).1, + rwa B at this }, + calc u n - n * l ≤ u (c N) - c (N - 1) * l : + begin + apply sub_le_sub (hmono ncN.le), + apply mul_le_mul_of_nonneg_right (nat.cast_le.2 cNn) lnonneg, + end + ... = (u (c N) - c N * l) + (c N - c (N - 1)) * l : by ring + ... ≤ ε * c N + (ε * c (N - 1)) * l : + begin + apply add_le_add, + { apply (ha _ _).2, + exact le_trans (by simp only [le_add_iff_nonneg_right, zero_le']) aN }, + { apply mul_le_mul_of_nonneg_right _ lnonneg, + linarith only [IcN] }, + end + ... ≤ ε * ((1 + ε) * c (N-1)) + (ε * c (N - 1)) * l : + add_le_add (mul_le_mul_of_nonneg_left IcN εpos.le) le_rfl + ... = (ε * (1 + ε + l)) * c (N - 1) : by ring + ... ≤ (ε * (1 + ε + l)) * n : + begin + refine mul_le_mul_of_nonneg_left (nat.cast_le.2 cNn) _, + apply mul_nonneg εpos.le, + linarith only [εpos, lnonneg] + end }, + have B : ∀ (ε : ℝ), 0 < ε → ∀ᶠ (n : ℕ) in at_top, (n : ℝ) * l - u n ≤ (ε * (1 + l)) * n, + { assume ε εpos, + rcases hlim (1 + ε) ((lt_add_iff_pos_right _).2 εpos) with ⟨c, cgrowth, ctop, clim⟩, + have L : ∀ᶠ (n : ℕ) in at_top, (c n : ℝ) * l - u (c n) ≤ ε * c n, + { rw [← tendsto_sub_nhds_zero_iff, ← asymptotics.is_o_one_iff ℝ, + asymptotics.is_o_iff] at clim, + filter_upwards [clim εpos, ctop (Ioi_mem_at_top 0)] with n hn cnpos', + have cnpos : 0 < c n := cnpos', + calc (c n : ℝ) * l - u (c n) + = -(u (c n) / c n - l) * c n: + by simp only [cnpos.ne', ne.def, nat.cast_eq_zero, not_false_iff, neg_sub] with field_simps + ... ≤ ε * c n : + begin + refine mul_le_mul_of_nonneg_right _ (nat.cast_nonneg _), + simp only [mul_one, real.norm_eq_abs, abs_one] at hn, + exact le_trans (neg_le_abs_self _) hn, + end }, + obtain ⟨a, ha⟩ : ∃ (a : ℕ), ∀ (b : ℕ), a ≤ b → (c (b + 1) : ℝ) ≤ (1 + ε) * c b + ∧ (c b : ℝ) * l - u (c b) ≤ ε * c b := eventually_at_top.1 (cgrowth.and L), + let M := ((finset.range (a+1)).image (λ i, c i)).max' (by simp), + filter_upwards [Ici_mem_at_top M] with n hn, + have exN : ∃ N, n < c N, + { rcases (tendsto_at_top.1 ctop (n+1)).exists with ⟨N, hN⟩, + exact ⟨N, by linarith only [hN]⟩ }, + let N := nat.find exN, + have ncN : n < c N := nat.find_spec exN, + have aN : a + 1 ≤ N, + { by_contra' h, + have cNM : c N ≤ M, + { apply le_max', + apply mem_image_of_mem, + exact mem_range.2 h }, + exact lt_irrefl _ ((cNM.trans hn).trans_lt ncN) }, + have Npos : 0 < N := lt_of_lt_of_le (nat.succ_pos') aN, + have aN' : a ≤ N - 1 := by linarith only [aN, Npos], + have cNn : c (N - 1) ≤ n, + { have : N - 1 < N := nat.pred_lt Npos.ne', + simpa only [not_lt] using nat.find_min exN this }, + calc (n : ℝ) * l - u n ≤ c N * l - u (c (N - 1)) : + begin + refine add_le_add (mul_le_mul_of_nonneg_right (nat.cast_le.2 ncN.le) lnonneg) _, + exact neg_le_neg (hmono cNn), + end + ... ≤ ((1 + ε) * c (N - 1)) * l - u (c (N - 1)) : + begin + refine add_le_add (mul_le_mul_of_nonneg_right _ lnonneg) le_rfl, + have B : N - 1 + 1 = N := nat.succ_pred_eq_of_pos Npos, + have := (ha _ aN').1, + rwa B at this, + end + ... = (c (N - 1) * l - u (c (N - 1))) + ε * c (N - 1) * l : by ring + ... ≤ ε * c (N - 1) + ε * c (N - 1) * l : + add_le_add (ha _ aN').2 le_rfl + ... = (ε * (1 + l)) * c (N - 1) : by ring + ... ≤ (ε * (1 + l)) * n : + begin + refine mul_le_mul_of_nonneg_left (nat.cast_le.2 cNn) _, + exact mul_nonneg (εpos.le) (add_nonneg zero_le_one lnonneg), + end }, + refine tendsto_order.2 ⟨λ d hd, _, λ d hd, _⟩, + { obtain ⟨ε, hε, εpos⟩ : ∃ (ε : ℝ), d + ε * (1 + l) < l ∧ 0 < ε, + { have L : tendsto (λ ε, d + (ε * (1 + l))) (𝓝[>] 0) (𝓝 (d + 0 * (1 + l))), + { apply tendsto.mono_left _ nhds_within_le_nhds, + exact tendsto_const_nhds.add (tendsto_id.mul tendsto_const_nhds) }, + simp only [zero_mul, add_zero] at L, + exact (((tendsto_order.1 L).2 l hd).and (self_mem_nhds_within)).exists }, + filter_upwards [B ε εpos, Ioi_mem_at_top 0] with n hn npos, + simp_rw [div_eq_inv_mul], + calc d < (n⁻¹ * n) * (l - ε * (1 + l)) : + begin + rw [inv_mul_cancel, one_mul], + { linarith only [hε] }, + { exact nat.cast_ne_zero.2 (ne_of_gt npos) } + end + ... = n⁻¹ * (n * l - ε * (1 + l) * n) : by ring + ... ≤ n⁻¹ * u n : + begin + refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 (nat.cast_nonneg _)), + linarith only [hn], + end }, + { obtain ⟨ε, hε, εpos⟩ : ∃ (ε : ℝ), l + ε * (1 + ε + l) < d ∧ 0 < ε, + { have L : tendsto (λ ε, l + (ε * (1 + ε + l))) (𝓝[>] 0) (𝓝 (l + 0 * (1 + 0 + l))), + { apply tendsto.mono_left _ nhds_within_le_nhds, + exact tendsto_const_nhds.add + (tendsto_id.mul ((tendsto_const_nhds.add tendsto_id).add tendsto_const_nhds)) }, + simp only [zero_mul, add_zero] at L, + exact (((tendsto_order.1 L).2 d hd).and (self_mem_nhds_within)).exists }, + filter_upwards [A ε εpos, Ioi_mem_at_top 0] with n hn npos, + simp_rw [div_eq_inv_mul], + calc (n : ℝ)⁻¹ * u n ≤ (n : ℝ)⁻¹ * (n * l + ε * (1 + ε + l) * n) : + begin + refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 (nat.cast_nonneg _)), + linarith only [hn], + end + ... = ((n : ℝ) ⁻¹ * n) * (l + ε * (1 + ε + l)) : by ring + ... < d : + begin + rwa [inv_mul_cancel, one_mul], + exact nat.cast_ne_zero.2 (ne_of_gt npos), + end } +end + +/-- If a monotone sequence `u` is such that `u ⌊c^n⌋₊ / ⌊c^n⌋₊` converges to a limit `l` for all +`c > 1`, then `u n / n` tends to `l`. It is even enough to have the assumption for a sequence of +`c`s converging to `1`. -/ +lemma tendsto_div_of_monotone_of_tendsto_div_floor_pow + (u : ℕ → ℝ) (l : ℝ) (hmono : monotone u) + (c : ℕ → ℝ) (cone : ∀ k, 1 < c k) (clim : tendsto c at_top (𝓝 1)) + (hc : ∀ k, tendsto (λ (n : ℕ), u (⌊(c k) ^ n⌋₊) / ⌊(c k)^n⌋₊) at_top (𝓝 l)) : + tendsto (λ n, u n / n) at_top (𝓝 l) := +begin + apply tendsto_div_of_monotone_of_exists_subseq_tendsto_div u l hmono, + assume a ha, + obtain ⟨k, hk⟩ : ∃ k, c k < a := ((tendsto_order.1 clim).2 a ha).exists, + refine ⟨λ n, ⌊(c k)^n⌋₊, _, + tendsto_nat_floor_at_top.comp (tendsto_pow_at_top_at_top_of_one_lt (cone k)), hc k⟩, + have H : ∀ (n : ℕ), (0 : ℝ) < ⌊c k ^ n⌋₊, + { assume n, + refine zero_lt_one.trans_le _, + simp only [nat.one_le_cast, nat.one_le_floor_iff, one_le_pow_of_one_le (cone k).le n] }, + have A : tendsto (λ (n : ℕ), ((⌊c k ^ (n+1)⌋₊ : ℝ) / c k ^ (n+1)) * c k / + (⌊c k ^ n⌋₊ / c k ^ n)) at_top (𝓝 (1 * c k / 1)), + { refine tendsto.div (tendsto.mul _ tendsto_const_nhds) _ one_ne_zero, + { refine tendsto_nat_floor_div_at_top.comp _, + exact (tendsto_pow_at_top_at_top_of_one_lt (cone k)).comp (tendsto_add_at_top_nat 1) }, + { refine tendsto_nat_floor_div_at_top.comp _, + exact tendsto_pow_at_top_at_top_of_one_lt (cone k) } }, + have B : tendsto (λ (n : ℕ), (⌊c k ^ (n+1)⌋₊ : ℝ) / ⌊c k ^ n⌋₊) at_top (𝓝 (c k)), + { simp only [one_mul, div_one] at A, + convert A, + ext1 n, + simp only [(zero_lt_one.trans (cone k)).ne', ne.def, not_false_iff, (H n).ne'] + with field_simps {discharger := tactic.field_simp.ne_zero}, + ring_exp }, + filter_upwards [(tendsto_order.1 B).2 a hk] with n hn, + exact (div_le_iff (H n)).1 hn.le +end + +/-- The sum of `1/(c^i)^2` above a threshold `j` is comparable to `1/j^2`, up to a multiplicative +constant. -/ +lemma sum_div_pow_sq_le_div_sq (N : ℕ) {j : ℝ} (hj : 0 < j) {c : ℝ} (hc : 1 < c) : + ∑ i in (range N).filter (λ i, j < c ^ i), 1 / (c ^ i) ^ 2 ≤ (c^3 * (c - 1) ⁻¹) / j ^ 2 := +begin + have cpos : 0 < c := zero_lt_one.trans hc, + have A : 0 < (c⁻¹) ^ 2 := sq_pos_of_pos (inv_pos.2 cpos), + have B : c^2 * (1 - c⁻¹ ^ 2) ⁻¹ ≤ c^3 * (c - 1) ⁻¹, + { rw [← div_eq_mul_inv, ← div_eq_mul_inv, div_le_div_iff _ (sub_pos.2 hc)], swap, + { exact sub_pos.2 (pow_lt_one (inv_nonneg.2 cpos.le) (inv_lt_one hc) two_ne_zero) }, + have : c ^ 3 = c^2 * c, by ring_exp, + simp only [mul_sub, this, mul_one, inv_pow, sub_le_sub_iff_left], + rw [mul_assoc, mul_comm c, ← mul_assoc, mul_inv_cancel (sq_pos_of_pos cpos).ne', one_mul], + simpa using pow_le_pow hc.le one_le_two }, + calc + ∑ i in (range N).filter (λ i, j < c ^ i), 1/ (c ^ i) ^ 2 + ≤ ∑ i in Ico (⌊real.log j / real.log c⌋₊) N, 1 / (c ^ i) ^ 2 : + begin + refine sum_le_sum_of_subset_of_nonneg _ (λ i hi hident, div_nonneg zero_le_one (sq_nonneg _)), + assume i hi, + simp only [mem_filter, mem_range] at hi, + simp only [hi.1, mem_Ico, and_true], + apply nat.floor_le_of_le, + apply le_of_lt, + rw [div_lt_iff (real.log_pos hc), ← real.log_pow], + exact real.log_lt_log hj hi.2 + end + ... = ∑ i in Ico (⌊real.log j / real.log c⌋₊) N, ((c⁻¹) ^ 2) ^ i : + begin + congr' 1 with i, + simp [← pow_mul, mul_comm], + end + ... ≤ ((c⁻¹) ^ 2) ^ (⌊real.log j / real.log c⌋₊) / (1 - (c⁻¹) ^ 2) : + begin + apply geom_sum_Ico_le_of_lt_one (sq_nonneg _), + rw sq_lt_one_iff (inv_nonneg.2 (zero_le_one.trans hc.le)), + exact inv_lt_one hc + end + ... ≤ ((c⁻¹) ^ 2) ^ (real.log j / real.log c - 1) / (1 - (c⁻¹) ^ 2) : + begin + apply div_le_div _ _ _ le_rfl, + { apply real.rpow_nonneg_of_nonneg (sq_nonneg _) }, + { rw ← real.rpow_nat_cast, + apply real.rpow_le_rpow_of_exponent_ge A, + { exact pow_le_one _ (inv_nonneg.2 (zero_le_one.trans hc.le)) (inv_le_one hc.le) }, + { exact (nat.sub_one_lt_floor _).le } }, + { simpa only [inv_pow, sub_pos] using inv_lt_one (one_lt_pow hc two_ne_zero) } + end + ... = (c^2 * (1 - c⁻¹ ^ 2) ⁻¹) / j ^ 2 : + begin + have I : (c ⁻¹ ^ 2) ^ (real.log j / real.log c) = 1 / j ^ 2, + { apply real.log_inj_on_pos (real.rpow_pos_of_pos A _), + { rw [one_div], exact inv_pos.2 (sq_pos_of_pos hj) }, + rw real.log_rpow A, + simp only [one_div, real.log_inv, real.log_pow, nat.cast_bit0, nat.cast_one, mul_neg, + neg_inj], + field_simp [(real.log_pos hc).ne'], + ring }, + rw [real.rpow_sub A, I], + have : c^2 - 1 ≠ 0 := (sub_pos.2 (one_lt_pow hc two_ne_zero)).ne', + field_simp [hj.ne', (zero_lt_one.trans hc).ne'], + ring, + end + ... ≤ (c^3 * (c - 1) ⁻¹) / j ^ 2 : + begin + apply div_le_div _ B (sq_pos_of_pos hj) le_rfl, + exact mul_nonneg (pow_nonneg cpos.le _) (inv_nonneg.2 (sub_pos.2 hc).le), + end +end + +lemma mul_pow_le_nat_floor_pow {c : ℝ} (hc : 1 < c) (i : ℕ) : + (1 - c⁻¹) * c ^ i ≤ ⌊c ^ i⌋₊ := +begin + have cpos : 0 < c := zero_lt_one.trans hc, + rcases nat.eq_zero_or_pos i with rfl|hi, + { simp only [pow_zero, nat.floor_one, nat.cast_one, mul_one, sub_le_self_iff, inv_nonneg, + cpos.le] }, + have hident : 1 ≤ i := hi, + calc (1 - c⁻¹) * c ^ i + = c ^ i - c ^ i * c ⁻¹ : by ring + ... ≤ c ^ i - 1 : + by simpa only [←div_eq_mul_inv, sub_le_sub_iff_left, one_le_div cpos, pow_one] + using pow_le_pow hc.le hident + ... ≤ ⌊c ^ i⌋₊ : (nat.sub_one_lt_floor _).le +end + +/-- The sum of `1/⌊c^i⌋₊^2` above a threshold `j` is comparable to `1/j^2`, up to a multiplicative +constant. -/ +lemma sum_div_nat_floor_pow_sq_le_div_sq (N : ℕ) {j : ℝ} (hj : 0 < j) {c : ℝ} (hc : 1 < c) : + ∑ i in (range N).filter (λ i, j < ⌊c ^ i⌋₊), (1 : ℝ) / ⌊c ^ i⌋₊ ^ 2 + ≤ (c ^ 5 * (c - 1) ⁻¹ ^ 3) / j ^ 2 := +begin + have cpos : 0 < c := zero_lt_one.trans hc, + have A : 0 < 1 - c⁻¹ := sub_pos.2 (inv_lt_one hc), + calc + ∑ i in (range N).filter (λ i, j < ⌊c ^ i⌋₊), (1 : ℝ) / ⌊c ^ i⌋₊ ^ 2 + ≤ ∑ i in (range N).filter (λ i, j < c ^ i), (1 : ℝ) / ⌊c ^ i⌋₊ ^ 2 : + begin + apply sum_le_sum_of_subset_of_nonneg, + { assume i hi, + simp only [mem_filter, mem_range] at hi, + simpa only [hi.1, mem_filter, mem_range, true_and] + using hi.2.trans_le (nat.floor_le (pow_nonneg cpos.le _)) }, + { assume i hi hident, + exact div_nonneg zero_le_one (sq_nonneg _), } + end + ... ≤ ∑ i in (range N).filter (λ i, j < c ^ i), ((1 - c⁻¹) ⁻¹) ^ 2 * (1 / (c ^ i) ^ 2) : + begin + apply sum_le_sum (λ i hi, _), + rw [mul_div_assoc', mul_one, div_le_div_iff], rotate, + { apply sq_pos_of_pos, + refine zero_lt_one.trans_le _, + simp only [nat.le_floor, one_le_pow_of_one_le, hc.le, nat.one_le_cast, nat.cast_one] }, + { exact sq_pos_of_pos (pow_pos cpos _) }, + rw [one_mul, ← mul_pow], + apply pow_le_pow_of_le_left (pow_nonneg cpos.le _), + rw [← div_eq_inv_mul, le_div_iff A, mul_comm], + exact mul_pow_le_nat_floor_pow hc i, + end + ... ≤ ((1 - c⁻¹) ⁻¹) ^ 2 * (c^3 * (c - 1) ⁻¹) / j ^ 2 : + begin + rw [← mul_sum, ← mul_div_assoc'], + refine mul_le_mul_of_nonneg_left _ (sq_nonneg _), + exact sum_div_pow_sq_le_div_sq N hj hc, + end + ... = (c ^ 5 * (c - 1) ⁻¹ ^ 3) / j ^ 2 : + begin + congr' 1, + field_simp [cpos.ne', (sub_pos.2 hc).ne'], + ring, + end +end diff --git a/src/analysis/specific_limits/normed.lean b/src/analysis/specific_limits/normed.lean index d4262585172aa..291940cf21cc3 100644 --- a/src/analysis/specific_limits/normed.lean +++ b/src/analysis/specific_limits/normed.lean @@ -3,12 +3,16 @@ Copyright (c) 2020 Sébastien Gouëzel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Anatole Dedecker, Sébastien Gouëzel, Yury G. Kudryashov, Dylan MacKenzie, Patrick Massot -/ +import algebra.order.field.basic import analysis.asymptotics.asymptotics import analysis.specific_limits.basic /-! # A collection of specific limit computations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains important specific limit computations in (semi-)normed groups/rings/spaces, as as well as such computations in `ℝ` when the natural proof passes through a fact about normed spaces. @@ -18,7 +22,7 @@ spaces. noncomputable theory open classical set function filter finset metric asymptotics -open_locale classical topological_space nat big_operators uniformity nnreal ennreal +open_locale classical topology nat big_operators uniformity nnreal ennreal variables {α : Type*} {β : Type*} {ι : Type*} @@ -36,29 +40,29 @@ lemma summable_of_absolute_convergence_real {f : ℕ → ℝ} : /-! ### Powers -/ -lemma tendsto_norm_zero' {𝕜 : Type*} [normed_group 𝕜] : +lemma tendsto_norm_zero' {𝕜 : Type*} [normed_add_comm_group 𝕜] : tendsto (norm : 𝕜 → ℝ) (𝓝[≠] 0) (𝓝[>] 0) := tendsto_norm_zero.inf $ tendsto_principal_principal.2 $ λ x hx, norm_pos_iff.2 hx namespace normed_field lemma tendsto_norm_inverse_nhds_within_0_at_top {𝕜 : Type*} [normed_field 𝕜] : - tendsto (λ x:𝕜, ∥x⁻¹∥) (𝓝[≠] 0) at_top := + tendsto (λ x:𝕜, ‖x⁻¹‖) (𝓝[≠] 0) at_top := (tendsto_inv_zero_at_top.comp tendsto_norm_zero').congr $ λ x, (norm_inv x).symm lemma tendsto_norm_zpow_nhds_within_0_at_top {𝕜 : Type*} [normed_field 𝕜] {m : ℤ} (hm : m < 0) : - tendsto (λ x : 𝕜, ∥x ^ m∥) (𝓝[≠] 0) at_top := + tendsto (λ x : 𝕜, ‖x ^ m‖) (𝓝[≠] 0) at_top := begin rcases neg_surjective m with ⟨m, rfl⟩, rw neg_lt_zero at hm, lift m to ℕ using hm.le, rw int.coe_nat_pos at hm, - simp only [norm_pow, zpow_neg₀, zpow_coe_nat, ← inv_pow₀], - exact (tendsto_pow_at_top hm).comp normed_field.tendsto_norm_inverse_nhds_within_0_at_top + simp only [norm_pow, zpow_neg, zpow_coe_nat, ← inv_pow], + exact (tendsto_pow_at_top hm.ne').comp normed_field.tendsto_norm_inverse_nhds_within_0_at_top end /-- The (scalar) product of a sequence that tends to zero with a bounded one also tends to zero. -/ lemma tendsto_zero_smul_of_tendsto_zero_of_bounded {ι 𝕜 𝔸 : Type*} [normed_field 𝕜] - [normed_group 𝔸] [normed_space 𝕜 𝔸] {l : filter ι} {ε : ι → 𝕜} {f : ι → 𝔸} + [normed_add_comm_group 𝔸] [normed_space 𝕜 𝔸] {l : filter ι} {ε : ι → 𝕜} {f : ι → 𝔸} (hε : tendsto ε l (𝓝 0)) (hf : filter.is_bounded_under (≤) l (norm ∘ f)) : tendsto (ε • f) l (𝓝 0) := begin @@ -66,7 +70,7 @@ begin simpa using is_o.smul_is_O hε (hf.is_O_const (one_ne_zero : (1 : 𝕜) ≠ 0)) end -@[simp] lemma continuous_at_zpow {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {m : ℤ} {x : 𝕜} : +@[simp] lemma continuous_at_zpow {𝕜 : Type*} [nontrivially_normed_field 𝕜] {m : ℤ} {x : 𝕜} : continuous_at (λ x, x ^ m) x ↔ x ≠ 0 ∨ 0 ≤ m := begin refine ⟨_, continuous_at_zpow₀ _ _⟩, @@ -75,25 +79,25 @@ begin (tendsto_norm_zpow_nhds_within_0_at_top hm) end -@[simp] lemma continuous_at_inv {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {x : 𝕜} : +@[simp] lemma continuous_at_inv {𝕜 : Type*} [nontrivially_normed_field 𝕜] {x : 𝕜} : continuous_at has_inv.inv x ↔ x ≠ 0 := -by simpa [(@zero_lt_one ℤ _ _).not_le] using @continuous_at_zpow _ _ (-1) x +by simpa [(zero_lt_one' ℤ).not_le] using @continuous_at_zpow _ _ (-1) x end normed_field lemma is_o_pow_pow_of_lt_left {r₁ r₂ : ℝ} (h₁ : 0 ≤ r₁) (h₂ : r₁ < r₂) : - is_o (λ n : ℕ, r₁ ^ n) (λ n, r₂ ^ n) at_top := + (λ n : ℕ, r₁ ^ n) =o[at_top] (λ n, r₂ ^ n) := have H : 0 < r₂ := h₁.trans_lt h₂, is_o_of_tendsto (λ n hn, false.elim $ H.ne' $ pow_eq_zero hn) $ (tendsto_pow_at_top_nhds_0_of_lt_1 (div_nonneg h₁ (h₁.trans h₂.le)) ((div_lt_one H).2 h₂)).congr (λ n, div_pow _ _ _) lemma is_O_pow_pow_of_le_left {r₁ r₂ : ℝ} (h₁ : 0 ≤ r₁) (h₂ : r₁ ≤ r₂) : - is_O (λ n : ℕ, r₁ ^ n) (λ n, r₂ ^ n) at_top := + (λ n : ℕ, r₁ ^ n) =O[at_top] (λ n, r₂ ^ n) := h₂.eq_or_lt.elim (λ h, h ▸ is_O_refl _ _) (λ h, (is_o_pow_pow_of_lt_left h₁ h).is_O) lemma is_o_pow_pow_of_abs_lt_left {r₁ r₂ : ℝ} (h : |r₁| < |r₂|) : - is_o (λ n : ℕ, r₁ ^ n) (λ n, r₂ ^ n) at_top := + (λ n : ℕ, r₁ ^ n) =o[at_top] (λ n, r₂ ^ n) := begin refine (is_o.of_norm_left _).of_norm_right, exact (is_o_pow_pow_of_lt_left (abs_nonneg r₁) h).congr (pow_abs r₁) (pow_abs r₂) @@ -114,10 +118,10 @@ end NB: For backwards compatibility, if you add more items to the list, please append them at the end of the list. -/ lemma tfae_exists_lt_is_o_pow (f : ℕ → ℝ) (R : ℝ) : - tfae [∃ a ∈ Ioo (-R) R, is_o f (pow a) at_top, - ∃ a ∈ Ioo 0 R, is_o f (pow a) at_top, - ∃ a ∈ Ioo (-R) R, is_O f (pow a) at_top, - ∃ a ∈ Ioo 0 R, is_O f (pow a) at_top, + tfae [∃ a ∈ Ioo (-R) R, f =o[at_top] pow a, + ∃ a ∈ Ioo 0 R, f =o[at_top] (pow a), + ∃ a ∈ Ioo (-R) R, f =O[at_top] pow a, + ∃ a ∈ Ioo 0 R, f =O[at_top] pow a, ∃ (a < R) C (h₀ : 0 < C ∨ 0 < R), ∀ n, |f n| ≤ C * a ^ n, ∃ (a ∈ Ioo 0 R) (C > 0), ∀ n, |f n| ≤ C * a ^ n, ∃ a < R, ∀ᶠ n in at_top, |f n| ≤ a ^ n, @@ -168,17 +172,17 @@ end /-- For any natural `k` and a real `r > 1` we have `n ^ k = o(r ^ n)` as `n → ∞`. -/ lemma is_o_pow_const_const_pow_of_one_lt {R : Type*} [normed_ring R] (k : ℕ) {r : ℝ} (hr : 1 < r) : - is_o (λ n, n ^ k : ℕ → R) (λ n, r ^ n) at_top := + (λ n, n ^ k : ℕ → R) =o[at_top] (λ n, r ^ n) := begin have : tendsto (λ x : ℝ, x ^ k) (𝓝[>] 1) (𝓝 1), from ((continuous_id.pow k).tendsto' (1 : ℝ) 1 (one_pow _)).mono_left inf_le_left, obtain ⟨r' : ℝ, hr' : r' ^ k < r, h1 : 1 < r'⟩ := ((this.eventually (gt_mem_nhds hr)).and self_mem_nhds_within).exists, have h0 : 0 ≤ r' := zero_le_one.trans h1.le, - suffices : is_O _ (λ n : ℕ, (r' ^ k) ^ n) at_top, + suffices : (λ n, n ^ k : ℕ → R) =O[at_top] (λ n : ℕ, (r' ^ k) ^ n), from this.trans_is_o (is_o_pow_pow_of_lt_left (pow_nonneg h0 _) hr'), conv in ((r' ^ _) ^ _) { rw [← pow_mul, mul_comm, pow_mul] }, - suffices : ∀ n : ℕ, ∥(n : R)∥ ≤ (r' - 1)⁻¹ * ∥(1 : R)∥ * ∥r' ^ n∥, + suffices : ∀ n : ℕ, ‖(n : R)‖ ≤ (r' - 1)⁻¹ * ‖(1 : R)‖ * ‖r' ^ n‖, from (is_O_of_le' _ this).pow _, intro n, rw mul_right_comm, refine n.norm_cast_le.trans (mul_le_mul_of_nonneg_right _ (norm_nonneg _)), @@ -187,21 +191,21 @@ end /-- For a real `r > 1` we have `n = o(r ^ n)` as `n → ∞`. -/ lemma is_o_coe_const_pow_of_one_lt {R : Type*} [normed_ring R] {r : ℝ} (hr : 1 < r) : - is_o (coe : ℕ → R) (λ n, r ^ n) at_top := -by simpa only [pow_one] using is_o_pow_const_const_pow_of_one_lt 1 hr + (coe : ℕ → R) =o[at_top] (λ n, r ^ n) := +by simpa only [pow_one] using @is_o_pow_const_const_pow_of_one_lt R _ 1 _ hr -/-- If `∥r₁∥ < r₂`, then for any naturak `k` we have `n ^ k r₁ ^ n = o (r₂ ^ n)` as `n → ∞`. -/ +/-- If `‖r₁‖ < r₂`, then for any naturak `k` we have `n ^ k r₁ ^ n = o (r₂ ^ n)` as `n → ∞`. -/ lemma is_o_pow_const_mul_const_pow_const_pow_of_norm_lt {R : Type*} [normed_ring R] (k : ℕ) - {r₁ : R} {r₂ : ℝ} (h : ∥r₁∥ < r₂) : - is_o (λ n, n ^ k * r₁ ^ n : ℕ → R) (λ n, r₂ ^ n) at_top := + {r₁ : R} {r₂ : ℝ} (h : ‖r₁‖ < r₂) : + (λ n, n ^ k * r₁ ^ n : ℕ → R) =o[at_top] (λ n, r₂ ^ n) := begin by_cases h0 : r₁ = 0, { refine (is_o_zero _ _).congr' (mem_at_top_sets.2 $ ⟨1, λ n hn, _⟩) eventually_eq.rfl, simp [zero_pow (zero_lt_one.trans_le hn), h0] }, rw [← ne.def, ← norm_pos_iff] at h0, - have A : is_o (λ n, n ^ k : ℕ → R) (λ n, (r₂ / ∥r₁∥) ^ n) at_top, + have A : (λ n, n ^ k : ℕ → R) =o[at_top] (λ n, (r₂ / ‖r₁‖) ^ n), from is_o_pow_const_const_pow_of_one_lt k ((one_lt_div h0).2 h), - suffices : is_O (λ n, r₁ ^ n) (λ n, ∥r₁∥ ^ n) at_top, + suffices : (λ n, r₁ ^ n) =O[at_top] (λ n, ‖r₁‖ ^ n), by simpa [div_mul_cancel _ (pow_pos h0 _).ne'] using A.mul_is_O this, exact is_O.of_bound 1 (by simpa using eventually_norm_pow_le r₁) end @@ -240,9 +244,9 @@ lemma tendsto_self_mul_const_pow_of_lt_one {r : ℝ} (hr : 0 ≤ r) (h'r : r < 1 tendsto (λ n, n * r ^ n : ℕ → ℝ) at_top (𝓝 0) := by simpa only [pow_one] using tendsto_pow_const_mul_const_pow_of_lt_one 1 hr h'r -/-- In a normed ring, the powers of an element x with `∥x∥ < 1` tend to zero. -/ +/-- In a normed ring, the powers of an element x with `‖x‖ < 1` tend to zero. -/ lemma tendsto_pow_at_top_nhds_0_of_norm_lt_1 {R : Type*} [normed_ring R] {x : R} - (h : ∥x∥ < 1) : tendsto (λ (n : ℕ), x ^ n) at_top (𝓝 0) := + (h : ‖x‖ < 1) : tendsto (λ (n : ℕ), x ^ n) at_top (𝓝 0) := begin apply squeeze_zero_norm' (eventually_norm_pow_le x), exact tendsto_pow_at_top_nhds_0_of_lt_1 (norm_nonneg _) h, @@ -257,21 +261,20 @@ section geometric variables {K : Type*} [normed_field K] {ξ : K} -lemma has_sum_geometric_of_norm_lt_1 (h : ∥ξ∥ < 1) : has_sum (λn:ℕ, ξ ^ n) (1 - ξ)⁻¹ := +lemma has_sum_geometric_of_norm_lt_1 (h : ‖ξ‖ < 1) : has_sum (λn:ℕ, ξ ^ n) (1 - ξ)⁻¹ := begin have xi_ne_one : ξ ≠ 1, by { contrapose! h, simp [h] }, have A : tendsto (λn, (ξ ^ n - 1) * (ξ - 1)⁻¹) at_top (𝓝 ((0 - 1) * (ξ - 1)⁻¹)), from ((tendsto_pow_at_top_nhds_0_of_norm_lt_1 h).sub tendsto_const_nhds).mul tendsto_const_nhds, - have B : (λ n, (∑ i in range n, ξ ^ i)) = (λ n, geom_sum ξ n) := rfl, - rw [has_sum_iff_tendsto_nat_of_summable_norm, B], + rw [has_sum_iff_tendsto_nat_of_summable_norm], { simpa [geom_sum_eq, xi_ne_one, neg_inv, div_eq_mul_inv] using A }, { simp [norm_pow, summable_geometric_of_lt_1 (norm_nonneg _) h] } end -lemma summable_geometric_of_norm_lt_1 (h : ∥ξ∥ < 1) : summable (λn:ℕ, ξ ^ n) := +lemma summable_geometric_of_norm_lt_1 (h : ‖ξ‖ < 1) : summable (λn:ℕ, ξ ^ n) := ⟨_, has_sum_geometric_of_norm_lt_1 h⟩ -lemma tsum_geometric_of_norm_lt_1 (h : ∥ξ∥ < 1) : ∑'n:ℕ, ξ ^ n = (1 - ξ)⁻¹ := +lemma tsum_geometric_of_norm_lt_1 (h : ‖ξ‖ < 1) : ∑'n:ℕ, ξ ^ n = (1 - ξ)⁻¹ := (has_sum_geometric_of_norm_lt_1 h).tsum_eq lemma has_sum_geometric_of_abs_lt_1 {r : ℝ} (h : |r| < 1) : has_sum (λn:ℕ, r ^ n) (1 - r)⁻¹ := @@ -285,7 +288,7 @@ tsum_geometric_of_norm_lt_1 h /-- A geometric series in a normed field is summable iff the norm of the common ratio is less than one. -/ -@[simp] lemma summable_geometric_iff_norm_lt_1 : summable (λ n : ℕ, ξ ^ n) ↔ ∥ξ∥ < 1 := +@[simp] lemma summable_geometric_iff_norm_lt_1 : summable (λ n : ℕ, ξ ^ n) ↔ ‖ξ‖ < 1 := begin refine ⟨λ h, _, summable_geometric_of_norm_lt_1⟩, obtain ⟨k : ℕ, hk : dist (ξ ^ k) 0 < 1⟩ := @@ -300,7 +303,7 @@ end geometric section mul_geometric lemma summable_norm_pow_mul_geometric_of_norm_lt_1 {R : Type*} [normed_ring R] - (k : ℕ) {r : R} (hr : ∥r∥ < 1) : summable (λ n : ℕ, ∥(n ^ k * r ^ n : R)∥) := + (k : ℕ) {r : R} (hr : ‖r‖ < 1) : summable (λ n : ℕ, ‖(n ^ k * r ^ n : R)‖) := begin rcases exists_between hr with ⟨r', hrr', h⟩, exact summable_of_is_O_nat (summable_geometric_of_lt_1 ((norm_nonneg _).trans hrr'.le) h) @@ -308,12 +311,12 @@ begin end lemma summable_pow_mul_geometric_of_norm_lt_1 {R : Type*} [normed_ring R] [complete_space R] - (k : ℕ) {r : R} (hr : ∥r∥ < 1) : summable (λ n, n ^ k * r ^ n : ℕ → R) := + (k : ℕ) {r : R} (hr : ‖r‖ < 1) : summable (λ n, n ^ k * r ^ n : ℕ → R) := summable_of_summable_norm $ summable_norm_pow_mul_geometric_of_norm_lt_1 _ hr -/-- If `∥r∥ < 1`, then `∑' n : ℕ, n * r ^ n = r / (1 - r) ^ 2`, `has_sum` version. -/ +/-- If `‖r‖ < 1`, then `∑' n : ℕ, n * r ^ n = r / (1 - r) ^ 2`, `has_sum` version. -/ lemma has_sum_coe_mul_geometric_of_norm_lt_1 {𝕜 : Type*} [normed_field 𝕜] [complete_space 𝕜] - {r : 𝕜} (hr : ∥r∥ < 1) : has_sum (λ n, n * r ^ n : ℕ → 𝕜) (r / (1 - r) ^ 2) := + {r : 𝕜} (hr : ‖r‖ < 1) : has_sum (λ n, n * r ^ n : ℕ → 𝕜) (r / (1 - r) ^ 2) := begin have A : summable (λ n, n * r ^ n : ℕ → 𝕜), by simpa using summable_pow_mul_geometric_of_norm_lt_1 1 hr, @@ -323,18 +326,18 @@ begin set s : 𝕜 := ∑' n : ℕ, n * r ^ n, calc s = (1 - r) * s / (1 - r) : (mul_div_cancel_left _ (sub_ne_zero.2 hr'.symm)).symm ... = (s - r * s) / (1 - r) : by rw [sub_mul, one_mul] - ... = ((0 : ℕ) * r ^ 0 + (∑' n : ℕ, (n + 1) * r ^ (n + 1)) - r * s) / (1 - r) : - by { congr, exact tsum_eq_zero_add A } + ... = ((0 : ℕ) * r ^ 0 + (∑' n : ℕ, (n + 1 : ℕ) * r ^ (n + 1)) - r * s) / (1 - r) : + by rw ← tsum_eq_zero_add A ... = (r * (∑' n : ℕ, (n + 1) * r ^ n) - r * s) / (1 - r) : by simp [pow_succ, mul_left_comm _ r, tsum_mul_left] ... = r / (1 - r) ^ 2 : by simp [add_mul, tsum_add A B.summable, mul_add, B.tsum_eq, ← div_eq_mul_inv, sq, - div_div_eq_div_mul] + div_div] end -/-- If `∥r∥ < 1`, then `∑' n : ℕ, n * r ^ n = r / (1 - r) ^ 2`. -/ +/-- If `‖r‖ < 1`, then `∑' n : ℕ, n * r ^ n = r / (1 - r) ^ 2`. -/ lemma tsum_coe_mul_geometric_of_norm_lt_1 {𝕜 : Type*} [normed_field 𝕜] [complete_space 𝕜] - {r : 𝕜} (hr : ∥r∥ < 1) : + {r : 𝕜} (hr : ‖r‖ < 1) : (∑' n : ℕ, n * r ^ n : 𝕜) = (r / (1 - r) ^ 2) := (has_sum_coe_mul_geometric_of_norm_lt_1 hr).tsum_eq @@ -342,32 +345,32 @@ end mul_geometric section summable_le_geometric -variables [semi_normed_group α] {r C : ℝ} {f : ℕ → α} +variables [seminormed_add_comm_group α] {r C : ℝ} {f : ℕ → α} -lemma semi_normed_group.cauchy_seq_of_le_geometric {C : ℝ} {r : ℝ} (hr : r < 1) - {u : ℕ → α} (h : ∀ n, ∥u n - u (n + 1)∥ ≤ C*r^n) : cauchy_seq u := +lemma seminormed_add_comm_group.cauchy_seq_of_le_geometric {C : ℝ} {r : ℝ} (hr : r < 1) + {u : ℕ → α} (h : ∀ n, ‖u n - u (n + 1)‖ ≤ C*r^n) : cauchy_seq u := cauchy_seq_of_le_geometric r C hr (by simpa [dist_eq_norm] using h) -lemma dist_partial_sum_le_of_le_geometric (hf : ∀n, ∥f n∥ ≤ C * r^n) (n : ℕ) : +lemma dist_partial_sum_le_of_le_geometric (hf : ∀n, ‖f n‖ ≤ C * r^n) (n : ℕ) : dist (∑ i in range n, f i) (∑ i in range (n+1), f i) ≤ C * r ^ n := begin rw [sum_range_succ, dist_eq_norm, ← norm_neg, neg_sub, add_sub_cancel'], exact hf n, end -/-- If `∥f n∥ ≤ C * r ^ n` for all `n : ℕ` and some `r < 1`, then the partial sums of `f` form a +/-- If `‖f n‖ ≤ C * r ^ n` for all `n : ℕ` and some `r < 1`, then the partial sums of `f` form a Cauchy sequence. This lemma does not assume `0 ≤ r` or `0 ≤ C`. -/ -lemma cauchy_seq_finset_of_geometric_bound (hr : r < 1) (hf : ∀n, ∥f n∥ ≤ C * r^n) : +lemma cauchy_seq_finset_of_geometric_bound (hr : r < 1) (hf : ∀n, ‖f n‖ ≤ C * r^n) : cauchy_seq (λ s : finset (ℕ), ∑ x in s, f x) := cauchy_seq_finset_of_norm_bounded _ (aux_has_sum_of_le_geometric hr (dist_partial_sum_le_of_le_geometric hf)).summable hf -/-- If `∥f n∥ ≤ C * r ^ n` for all `n : ℕ` and some `r < 1`, then the partial sums of `f` are within +/-- If `‖f n‖ ≤ C * r ^ n` for all `n : ℕ` and some `r < 1`, then the partial sums of `f` are within distance `C * r ^ n / (1 - r)` of the sum of the series. This lemma does not assume `0 ≤ r` or `0 ≤ C`. -/ -lemma norm_sub_le_of_geometric_bound_of_has_sum (hr : r < 1) (hf : ∀n, ∥f n∥ ≤ C * r^n) +lemma norm_sub_le_of_geometric_bound_of_has_sum (hr : r < 1) (hf : ∀n, ‖f n‖ ≤ C * r^n) {a : α} (ha : has_sum f a) (n : ℕ) : - ∥(∑ x in finset.range n, f x) - a∥ ≤ (C * r ^ n) / (1 - r) := + ‖(∑ x in finset.range n, f x) - a‖ ≤ (C * r ^ n) / (1 - r) := begin rw ← dist_eq_norm, apply dist_le_of_le_geometric_of_tendsto r C hr (dist_partial_sum_le_of_le_geometric hf), @@ -375,24 +378,24 @@ begin end @[simp] lemma dist_partial_sum (u : ℕ → α) (n : ℕ) : - dist (∑ k in range (n + 1), u k) (∑ k in range n, u k) = ∥u n∥ := + dist (∑ k in range (n + 1), u k) (∑ k in range n, u k) = ‖u n‖ := by simp [dist_eq_norm, sum_range_succ] @[simp] lemma dist_partial_sum' (u : ℕ → α) (n : ℕ) : - dist (∑ k in range n, u k) (∑ k in range (n+1), u k) = ∥u n∥ := + dist (∑ k in range n, u k) (∑ k in range (n+1), u k) = ‖u n‖ := by simp [dist_eq_norm', sum_range_succ] lemma cauchy_series_of_le_geometric {C : ℝ} {u : ℕ → α} - {r : ℝ} (hr : r < 1) (h : ∀ n, ∥u n∥ ≤ C*r^n) : cauchy_seq (λ n, ∑ k in range n, u k) := + {r : ℝ} (hr : r < 1) (h : ∀ n, ‖u n‖ ≤ C*r^n) : cauchy_seq (λ n, ∑ k in range n, u k) := cauchy_seq_of_le_geometric r C hr (by simp [h]) -lemma normed_group.cauchy_series_of_le_geometric' {C : ℝ} {u : ℕ → α} {r : ℝ} (hr : r < 1) - (h : ∀ n, ∥u n∥ ≤ C*r^n) : cauchy_seq (λ n, ∑ k in range (n + 1), u k) := +lemma normed_add_comm_group.cauchy_series_of_le_geometric' {C : ℝ} {u : ℕ → α} {r : ℝ} (hr : r < 1) + (h : ∀ n, ‖u n‖ ≤ C*r^n) : cauchy_seq (λ n, ∑ k in range (n + 1), u k) := (cauchy_series_of_le_geometric hr h).comp_tendsto $ tendsto_add_at_top_nat 1 -lemma normed_group.cauchy_series_of_le_geometric'' {C : ℝ} {u : ℕ → α} {N : ℕ} {r : ℝ} +lemma normed_add_comm_group.cauchy_series_of_le_geometric'' {C : ℝ} {u : ℕ → α} {N : ℕ} {r : ℝ} (hr₀ : 0 < r) (hr₁ : r < 1) - (h : ∀ n ≥ N, ∥u n∥ ≤ C*r^n) : cauchy_seq (λ n, ∑ k in range (n + 1), u k) := + (h : ∀ n ≥ N, ‖u n‖ ≤ C*r^n) : cauchy_seq (λ n, ∑ k in range (n + 1), u k) := begin set v : ℕ → α := λ n, if n < N then 0 else u n, have hC : 0 ≤ C, @@ -400,7 +403,8 @@ begin have : ∀ n ≥ N, u n = v n, { intros n hn, simp [v, hn, if_neg (not_lt.mpr hn)] }, - refine cauchy_seq_sum_of_eventually_eq this (normed_group.cauchy_series_of_le_geometric' hr₁ _), + refine cauchy_seq_sum_of_eventually_eq this (normed_add_comm_group.cauchy_series_of_le_geometric' + hr₁ _), { exact C }, intro n, dsimp [v], @@ -421,30 +425,30 @@ open normed_space /-- A geometric series in a complete normed ring is summable. Proved above (same name, different namespace) for not-necessarily-complete normed fields. -/ lemma normed_ring.summable_geometric_of_norm_lt_1 - (x : R) (h : ∥x∥ < 1) : summable (λ (n:ℕ), x ^ n) := + (x : R) (h : ‖x‖ < 1) : summable (λ (n:ℕ), x ^ n) := begin - have h1 : summable (λ (n:ℕ), ∥x∥ ^ n) := summable_geometric_of_lt_1 (norm_nonneg _) h, + have h1 : summable (λ (n:ℕ), ‖x‖ ^ n) := summable_geometric_of_lt_1 (norm_nonneg _) h, refine summable_of_norm_bounded_eventually _ h1 _, rw nat.cofinite_eq_at_top, exact eventually_norm_pow_le x, end /-- Bound for the sum of a geometric series in a normed ring. This formula does not assume that the -normed ring satisfies the axiom `∥1∥ = 1`. -/ +normed ring satisfies the axiom `‖1‖ = 1`. -/ lemma normed_ring.tsum_geometric_of_norm_lt_1 - (x : R) (h : ∥x∥ < 1) : ∥∑' n:ℕ, x ^ n∥ ≤ ∥(1:R)∥ - 1 + (1 - ∥x∥)⁻¹ := + (x : R) (h : ‖x‖ < 1) : ‖∑' n:ℕ, x ^ n‖ ≤ ‖(1:R)‖ - 1 + (1 - ‖x‖)⁻¹ := begin rw tsum_eq_zero_add (normed_ring.summable_geometric_of_norm_lt_1 x h), simp only [pow_zero], refine le_trans (norm_add_le _ _) _, - have : ∥∑' b : ℕ, (λ n, x ^ (n + 1)) b∥ ≤ (1 - ∥x∥)⁻¹ - 1, + have : ‖∑' b : ℕ, (λ n, x ^ (n + 1)) b‖ ≤ (1 - ‖x‖)⁻¹ - 1, { refine tsum_of_norm_bounded _ (λ b, norm_pow_le' _ (nat.succ_pos b)), convert (has_sum_nat_add_iff' 1).mpr (has_sum_geometric_of_lt_1 (norm_nonneg x) h), simp }, linarith end -lemma geom_series_mul_neg (x : R) (h : ∥x∥ < 1) : +lemma geom_series_mul_neg (x : R) (h : ‖x‖ < 1) : (∑' i:ℕ, x ^ i) * (1 - x) = 1 := begin have := ((normed_ring.summable_geometric_of_norm_lt_1 x h).has_sum.mul_right (1 - x)), @@ -453,10 +457,10 @@ begin { simpa using tendsto_const_nhds.sub (tendsto_pow_at_top_nhds_0_of_norm_lt_1 h) }, convert ← this, ext n, - rw [←geom_sum_mul_neg, geom_sum_def, finset.sum_mul], + rw [←geom_sum_mul_neg, finset.sum_mul], end -lemma mul_neg_geom_series (x : R) (h : ∥x∥ < 1) : +lemma mul_neg_geom_series (x : R) (h : ‖x‖ < 1) : (1 - x) * ∑' i:ℕ, x ^ i = 1 := begin have := (normed_ring.summable_geometric_of_norm_lt_1 x h).has_sum.mul_left (1 - x), @@ -466,22 +470,22 @@ begin (tendsto_pow_at_top_nhds_0_of_norm_lt_1 h) }, convert ← this, ext n, - rw [←mul_neg_geom_sum, geom_sum_def, finset.mul_sum] + rw [←mul_neg_geom_sum, finset.mul_sum] end end normed_ring_geometric /-! ### Summability tests based on comparison with geometric series -/ -lemma summable_of_ratio_norm_eventually_le {α : Type*} [semi_normed_group α] [complete_space α] - {f : ℕ → α} {r : ℝ} (hr₁ : r < 1) - (h : ∀ᶠ n in at_top, ∥f (n+1)∥ ≤ r * ∥f n∥) : summable f := +lemma summable_of_ratio_norm_eventually_le {α : Type*} [seminormed_add_comm_group α] + [complete_space α] {f : ℕ → α} {r : ℝ} (hr₁ : r < 1) + (h : ∀ᶠ n in at_top, ‖f (n+1)‖ ≤ r * ‖f n‖) : summable f := begin by_cases hr₀ : 0 ≤ r, { rw eventually_at_top at h, rcases h with ⟨N, hN⟩, rw ← @summable_nat_add_iff α _ _ _ _ N, - refine summable_of_norm_bounded (λ n, ∥f N∥ * r^n) + refine summable_of_norm_bounded (λ n, ‖f N‖ * r^n) (summable.mul_left _ $ summable_geometric_of_lt_1 hr₀ hr₁) (λ n, _), conv_rhs {rw [mul_comm, ← zero_add N]}, refine le_geom hr₀ n (λ i _, _), @@ -495,9 +499,9 @@ begin exact not_lt.mpr (norm_nonneg _) (lt_of_le_of_lt hn $ mul_neg_of_neg_of_pos hr₀ h), }, end -lemma summable_of_ratio_test_tendsto_lt_one {α : Type*} [normed_group α] [complete_space α] +lemma summable_of_ratio_test_tendsto_lt_one {α : Type*} [normed_add_comm_group α] [complete_space α] {f : ℕ → α} {l : ℝ} (hl₁ : l < 1) (hf : ∀ᶠ n in at_top, f n ≠ 0) - (h : tendsto (λ n, ∥f (n+1)∥/∥f n∥) at_top (𝓝 l)) : summable f := + (h : tendsto (λ n, ‖f (n+1)‖/‖f n‖) at_top (𝓝 l)) : summable f := begin rcases exists_between hl₁ with ⟨r, hr₀, hr₁⟩, refine summable_of_ratio_norm_eventually_le hr₁ _, @@ -505,9 +509,9 @@ begin rwa ← div_le_iff (norm_pos_iff.mpr h₁), end -lemma not_summable_of_ratio_norm_eventually_ge {α : Type*} [semi_normed_group α] - {f : ℕ → α} {r : ℝ} (hr : 1 < r) (hf : ∃ᶠ n in at_top, ∥f n∥ ≠ 0) - (h : ∀ᶠ n in at_top, r * ∥f n∥ ≤ ∥f (n+1)∥) : ¬ summable f := +lemma not_summable_of_ratio_norm_eventually_ge {α : Type*} [seminormed_add_comm_group α] + {f : ℕ → α} {r : ℝ} (hr : 1 < r) (hf : ∃ᶠ n in at_top, ‖f n‖ ≠ 0) + (h : ∀ᶠ n in at_top, r * ‖f n‖ ≤ ‖f (n+1)‖) : ¬ summable f := begin rw eventually_at_top at h, rcases h with ⟨N₀, hN₀⟩, @@ -528,11 +532,11 @@ begin ac_refl } end -lemma not_summable_of_ratio_test_tendsto_gt_one {α : Type*} [semi_normed_group α] +lemma not_summable_of_ratio_test_tendsto_gt_one {α : Type*} [seminormed_add_comm_group α] {f : ℕ → α} {l : ℝ} (hl : 1 < l) - (h : tendsto (λ n, ∥f (n+1)∥/∥f n∥) at_top (𝓝 l)) : ¬ summable f := + (h : tendsto (λ n, ‖f (n+1)‖/‖f n‖) at_top (𝓝 l)) : ¬ summable f := begin - have key : ∀ᶠ n in at_top, ∥f n∥ ≠ 0, + have key : ∀ᶠ n in at_top, ‖f n‖ ≠ 0, { filter_upwards [eventually_ge_of_tendsto_gt hl h] with _ hn hc, rw [hc, div_zero] at hn, linarith }, @@ -545,32 +549,30 @@ end section /-! ### Dirichlet and alternating series tests -/ -variables {E : Type*} [normed_group E] [normed_space ℝ E] +variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] variables {b : ℝ} {f : ℕ → ℝ} {z : ℕ → E} /-- **Dirichlet's Test** for monotone sequences. -/ theorem monotone.cauchy_seq_series_mul_of_tendsto_zero_of_bounded - (hfa : monotone f) (hf0 : tendsto f at_top (𝓝 0)) (hgb : ∀ n, ∥∑ i in range n, z i∥ ≤ b) : + (hfa : monotone f) (hf0 : tendsto f at_top (𝓝 0)) (hgb : ∀ n, ‖∑ i in range n, z i‖ ≤ b) : cauchy_seq (λ n, ∑ i in range (n + 1), (f i) • z i) := begin simp_rw [finset.sum_range_by_parts _ _ (nat.succ _), sub_eq_add_neg, nat.succ_sub_succ_eq_sub, tsub_zero], apply (normed_field.tendsto_zero_smul_of_tendsto_zero_of_bounded hf0 ⟨b, eventually_map.mpr $ eventually_of_forall $ λ n, hgb $ n+1⟩).cauchy_seq.add, - apply (cauchy_seq_range_of_norm_bounded _ _ (_ : ∀ n, _ ≤ b * |f(n+1) - f(n)|)).neg, - { exact normed_uniform_group }, + refine (cauchy_seq_range_of_norm_bounded _ _ (λ n, _ : ∀ n, _ ≤ b * |f(n+1) - f(n)|)).neg, { simp_rw [abs_of_nonneg (sub_nonneg_of_le (hfa (nat.le_succ _))), ← mul_sum], - apply real.uniform_continuous_mul_const.comp_cauchy_seq, + apply real.uniform_continuous_const_mul.comp_cauchy_seq, simp_rw [sum_range_sub, sub_eq_add_neg], exact (tendsto.cauchy_seq hf0).add_const }, - { intro n, - rw [norm_smul, mul_comm], + { rw [norm_smul, mul_comm], exact mul_le_mul_of_nonneg_right (hgb _) (abs_nonneg _) }, end /-- **Dirichlet's test** for antitone sequences. -/ theorem antitone.cauchy_seq_series_mul_of_tendsto_zero_of_bounded - (hfa : antitone f) (hf0 : tendsto f at_top (𝓝 0)) (hzb : ∀ n, ∥∑ i in range n, z i∥ ≤ b) : + (hfa : antitone f) (hf0 : tendsto f at_top (𝓝 0)) (hzb : ∀ n, ‖∑ i in range n, z i‖ ≤ b) : cauchy_seq (λ n, ∑ i in range (n+1), (f i) • z i) := begin have hfa': monotone (λ n, -f n) := λ _ _ hab, neg_le_neg $ hfa hab, @@ -580,8 +582,8 @@ begin simp end -lemma norm_sum_neg_one_pow_le (n : ℕ) : ∥∑ i in range n, (-1 : ℝ) ^ i∥ ≤ 1 := -by { rw [←geom_sum_def, neg_one_geom_sum], split_ifs; norm_num } +lemma norm_sum_neg_one_pow_le (n : ℕ) : ‖∑ i in range n, (-1 : ℝ) ^ i‖ ≤ 1 := +by { rw [neg_one_geom_sum], split_ifs; norm_num } /-- The **alternating series test** for monotone sequences. See also `tendsto_alternating_series_of_monotone_tendsto_zero`. -/ @@ -629,18 +631,18 @@ lemma real.summable_pow_div_factorial (x : ℝ) : summable (λ n, x ^ n / n! : ℕ → ℝ) := begin -- We start with trivial extimates - have A : (0 : ℝ) < ⌊∥x∥⌋₊ + 1, from zero_lt_one.trans_le (by simp), - have B : ∥x∥ / (⌊∥x∥⌋₊ + 1) < 1, from (div_lt_one A).2 (nat.lt_floor_add_one _), - -- Then we apply the ratio test. The estimate works for `n ≥ ⌊∥x∥⌋₊`. - suffices : ∀ n ≥ ⌊∥x∥⌋₊, ∥x ^ (n + 1) / (n + 1)!∥ ≤ ∥x∥ / (⌊∥x∥⌋₊ + 1) * ∥x ^ n / ↑n!∥, - from summable_of_ratio_norm_eventually_le B (eventually_at_top.2 ⟨⌊∥x∥⌋₊, this⟩), + have A : (0 : ℝ) < ⌊‖x‖⌋₊ + 1, from zero_lt_one.trans_le (by simp), + have B : ‖x‖ / (⌊‖x‖⌋₊ + 1) < 1, from (div_lt_one A).2 (nat.lt_floor_add_one _), + -- Then we apply the ratio test. The estimate works for `n ≥ ⌊‖x‖⌋₊`. + suffices : ∀ n ≥ ⌊‖x‖⌋₊, ‖x ^ (n + 1) / (n + 1)!‖ ≤ ‖x‖ / (⌊‖x‖⌋₊ + 1) * ‖x ^ n / ↑n!‖, + from summable_of_ratio_norm_eventually_le B (eventually_at_top.2 ⟨⌊‖x‖⌋₊, this⟩), -- Finally, we prove the upper estimate intros n hn, - calc ∥x ^ (n + 1) / (n + 1)!∥ = (∥x∥ / (n + 1)) * ∥x ^ n / n!∥ : - by rw [pow_succ, nat.factorial_succ, nat.cast_mul, ← div_mul_div_comm₀, + calc ‖x ^ (n + 1) / (n + 1)!‖ = (‖x‖ / (n + 1)) * ‖x ^ n / n!‖ : + by rw [pow_succ, nat.factorial_succ, nat.cast_mul, ← div_mul_div_comm, norm_mul, norm_div, real.norm_coe_nat, nat.cast_succ] - ... ≤ (∥x∥ / (⌊∥x∥⌋₊ + 1)) * ∥x ^ n / n!∥ : - by mono* with [0 ≤ ∥x ^ n / n!∥, 0 ≤ ∥x∥]; apply norm_nonneg + ... ≤ (‖x‖ / (⌊‖x‖⌋₊ + 1)) * ‖x ^ n / n!‖ : + by mono* with [0 ≤ ‖x ^ n / n!‖, 0 ≤ ‖x‖]; apply norm_nonneg end lemma real.tendsto_pow_div_factorial_at_top (x : ℝ) : diff --git a/src/analysis/subadditive.lean b/src/analysis/subadditive.lean index 56d0adc2ebdf3..c7e1d6f3311d4 100644 --- a/src/analysis/subadditive.lean +++ b/src/analysis/subadditive.lean @@ -9,6 +9,9 @@ import order.filter.archimedean /-! # Convergence of subadditive sequences +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A subadditive sequence `u : ℕ → ℝ` is a sequence satisfying `u (m + n) ≤ u m + u n` for all `m, n`. We define this notion as `subadditive u`, and prove in `subadditive.tendsto_lim` that, if `u n / n` is bounded below, then it converges to a limit (that we denote by `subadditive.lim` for @@ -17,7 +20,7 @@ convenience). This result is known as Fekete's lemma in the literature. noncomputable theory open set filter -open_locale topological_space +open_locale topology /-- A real-valued sequence is subadditive if it satisfies the inequality `u (m + n) ≤ u m + u n` for all `m, n`. -/ @@ -53,7 +56,7 @@ begin = u (n + (k * n + r)) : by { congr' 1, ring } ... ≤ u n + u (k * n + r) : h _ _ ... ≤ u n + (k * u n + u r) : add_le_add_left IH _ - ... = (k+1) * u n + u r : by ring + ... = (k+1 : ℕ) * u n + u r : by simp; ring end lemma eventually_div_lt_of_div_lt {L : ℝ} {n : ℕ} (hn : n ≠ 0) (hL : u n / n < L) : diff --git a/src/analysis/sum_integral_comparisons.lean b/src/analysis/sum_integral_comparisons.lean new file mode 100644 index 0000000000000..10380facc6359 --- /dev/null +++ b/src/analysis/sum_integral_comparisons.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2022 Kevin H. Wilson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin H. Wilson +-/ +import measure_theory.integral.interval_integral +import data.set.function +import analysis.special_functions.integrals + +/-! +# Comparing sums and integrals + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Summary + +It is often the case that error terms in analysis can be computed by comparing +an infinite sum to the improper integral of an antitone function. This file will eventually enable +that. + +At the moment it contains four lemmas in this direction: `antitone_on.integral_le_sum`, +`antitone_on.sum_le_integral` and versions for monotone functions, which can all be paired +with a `filter.tendsto` to estimate some errors. + +`TODO`: Add more lemmas to the API to directly address limiting issues + +## Main Results + +* `antitone_on.integral_le_sum`: The integral of an antitone function is at most the sum of its + values at integer steps aligning with the left-hand side of the interval +* `antitone_on.sum_le_integral`: The sum of an antitone function along integer steps aligning with + the right-hand side of the interval is at most the integral of the function along that interval +* `monotone_on.integral_le_sum`: The integral of a monotone function is at most the sum of its + values at integer steps aligning with the right-hand side of the interval +* `monotone_on.sum_le_integral`: The sum of a monotone function along integer steps aligning with + the left-hand side of the interval is at most the integral of the function along that interval + +## Tags + +analysis, comparison, asymptotics +-/ + +open set measure_theory.measure_space +open_locale big_operators + +variables {x₀ : ℝ} {a b : ℕ} {f : ℝ → ℝ} + +lemma antitone_on.integral_le_sum (hf : antitone_on f (Icc x₀ (x₀ + a))) : + ∫ x in x₀..(x₀ + a), f x ≤ ∑ i in finset.range a, f (x₀ + i) := +begin + have hint : ∀ (k : ℕ), k < a → interval_integrable f volume (x₀+k) (x₀ + (k + 1 : ℕ)), + { assume k hk, + refine (hf.mono _).interval_integrable, + rw uIcc_of_le, + { apply Icc_subset_Icc, + { simp only [le_add_iff_nonneg_right, nat.cast_nonneg] }, + { simp only [add_le_add_iff_left, nat.cast_le, nat.succ_le_of_lt hk] } }, + { simp only [add_le_add_iff_left, nat.cast_le, nat.le_succ] } }, + calc + ∫ x in x₀..(x₀ + a), f x = ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1 : ℕ)), f x : + begin + convert (interval_integral.sum_integral_adjacent_intervals hint).symm, + simp only [nat.cast_zero, add_zero], + end + ... ≤ ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1 : ℕ)), f (x₀ + i) : + begin + apply finset.sum_le_sum (λ i hi, _), + have ia : i < a := finset.mem_range.1 hi, + refine interval_integral.integral_mono_on (by simp) (hint _ ia) (by simp) (λ x hx, _), + apply hf _ _ hx.1, + { simp only [ia.le, mem_Icc, le_add_iff_nonneg_right, nat.cast_nonneg, add_le_add_iff_left, + nat.cast_le, and_self] }, + { refine mem_Icc.2 ⟨le_trans (by simp) hx.1, le_trans hx.2 _⟩, + simp only [add_le_add_iff_left, nat.cast_le, nat.succ_le_of_lt ia] }, + end + ... = ∑ i in finset.range a, f (x₀ + i) : by simp +end + +lemma antitone_on.integral_le_sum_Ico (hab : a ≤ b) (hf : antitone_on f (set.Icc a b)) : + ∫ x in a..b, f x ≤ ∑ x in finset.Ico a b, f x := +begin + rw [(nat.sub_add_cancel hab).symm, nat.cast_add], + conv { congr, congr, skip, skip, rw add_comm, skip, skip, congr, congr, rw ←zero_add a, }, + rw [← finset.sum_Ico_add, nat.Ico_zero_eq_range], + conv { to_rhs, congr, skip, funext, rw nat.cast_add, }, + apply antitone_on.integral_le_sum, + simp only [hf, hab, nat.cast_sub, add_sub_cancel'_right], +end + +lemma antitone_on.sum_le_integral (hf : antitone_on f (Icc x₀ (x₀ + a))) : + ∑ i in finset.range a, f (x₀ + (i + 1 : ℕ)) ≤ ∫ x in x₀..(x₀ + a), f x := +begin + have hint : ∀ (k : ℕ), k < a → interval_integrable f volume (x₀+k) (x₀ + (k + 1 : ℕ)), + { assume k hk, + refine (hf.mono _).interval_integrable, + rw uIcc_of_le, + { apply Icc_subset_Icc, + { simp only [le_add_iff_nonneg_right, nat.cast_nonneg] }, + { simp only [add_le_add_iff_left, nat.cast_le, nat.succ_le_of_lt hk] } }, + { simp only [add_le_add_iff_left, nat.cast_le, nat.le_succ] } }, + calc ∑ i in finset.range a, f (x₀ + (i + 1 : ℕ)) + = ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1:ℕ)), f (x₀ + (i + 1 : ℕ)) : by simp + ... ≤ ∑ i in finset.range a, ∫ x in (x₀+i)..(x₀+(i+1:ℕ)), f x : + begin + apply finset.sum_le_sum (λ i hi, _), + have ia : i + 1 ≤ a := finset.mem_range.1 hi, + refine interval_integral.integral_mono_on (by simp) (by simp) (hint _ ia) (λ x hx, _), + apply hf _ _ hx.2, + { refine mem_Icc.2 ⟨le_trans ((le_add_iff_nonneg_right _).2 (nat.cast_nonneg _)) hx.1, + le_trans hx.2 _⟩, + simp only [nat.cast_le, add_le_add_iff_left, ia] }, + { refine mem_Icc.2 ⟨(le_add_iff_nonneg_right _).2 (nat.cast_nonneg _), _⟩, + simp only [add_le_add_iff_left, nat.cast_le, ia] }, + end + ... = ∫ x in x₀..(x₀ + a), f x : + begin + convert interval_integral.sum_integral_adjacent_intervals hint, + simp only [nat.cast_zero, add_zero], + end +end + +lemma antitone_on.sum_le_integral_Ico (hab : a ≤ b) (hf : antitone_on f (set.Icc a b)) : + ∑ i in finset.Ico a b, f (i + 1 : ℕ) ≤ ∫ x in a..b, f x := +begin + rw [(nat.sub_add_cancel hab).symm, nat.cast_add], + conv { congr, congr, congr, rw ← zero_add a, skip, skip, skip, rw add_comm, }, + rw [← finset.sum_Ico_add, nat.Ico_zero_eq_range], + conv { to_lhs, congr, congr, skip, funext, rw [add_assoc, nat.cast_add], }, + apply antitone_on.sum_le_integral, + simp only [hf, hab, nat.cast_sub, add_sub_cancel'_right], +end + +lemma monotone_on.sum_le_integral (hf : monotone_on f (Icc x₀ (x₀ + a))) : + ∑ i in finset.range a, f (x₀ + i) ≤ ∫ x in x₀..(x₀ + a), f x := +begin + rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg], + exact hf.neg.integral_le_sum, +end + +lemma monotone_on.sum_le_integral_Ico (hab : a ≤ b) (hf : monotone_on f (set.Icc a b)) : + ∑ x in finset.Ico a b, f x ≤ ∫ x in a..b, f x := +begin + rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg], + exact hf.neg.integral_le_sum_Ico hab, +end + +lemma monotone_on.integral_le_sum (hf : monotone_on f (Icc x₀ (x₀ + a))) : + ∫ x in x₀..(x₀ + a), f x ≤ ∑ i in finset.range a, f (x₀ + (i + 1 : ℕ)) := +begin + rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg], + exact hf.neg.sum_le_integral, +end + +lemma monotone_on.integral_le_sum_Ico (hab : a ≤ b) (hf : monotone_on f (set.Icc a b)) : + ∫ x in a..b, f x ≤ ∑ i in finset.Ico a b, f (i + 1 : ℕ) := +begin + rw [← neg_le_neg_iff, ← finset.sum_neg_distrib, ← interval_integral.integral_neg], + exact hf.neg.sum_le_integral_Ico hab, +end diff --git a/src/analysis/von_neumann_algebra/basic.lean b/src/analysis/von_neumann_algebra/basic.lean index 657402fed8c75..dc3ec7acc5250 100644 --- a/src/analysis/von_neumann_algebra/basic.lean +++ b/src/analysis/von_neumann_algebra/basic.lean @@ -12,6 +12,9 @@ import algebra.star.subalgebra /-! # Von Neumann algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We give the "abstract" and "concrete" definitions of a von Neumann algebra. We still have a major project ahead of us to show the equivalence between these definitions! @@ -43,7 +46,7 @@ and we may be unhappy with the resulting opaqueness of the definition. -/ class wstar_algebra (M : Type u) [normed_ring M] [star_ring M] [cstar_ring M] [module ℂ M] [normed_algebra ℂ M] [star_module ℂ M] := -(exists_predual : ∃ (X : Type u) [normed_group X] [normed_space ℂ X] [complete_space X], +(exists_predual : ∃ (X : Type u) [normed_add_comm_group X] [normed_space ℂ X] [complete_space X], nonempty (normed_space.dual ℂ X ≃ₗᵢ⋆[ℂ] M)) -- TODO: Without this, `von_neumann_algebra` times out. Why? @@ -64,10 +67,12 @@ Thus we can't say that the bounded operators `H →L[ℂ] H` form a `von_neumann (although we will later construct the instance `wstar_algebra (H →L[ℂ] H)`), and instead will use `⊤ : von_neumann_algebra H`. -/ -@[nolint has_inhabited_instance] -structure von_neumann_algebra (H : Type u) [inner_product_space ℂ H] [complete_space H] extends +@[nolint has_nonempty_instance] +structure von_neumann_algebra (H : Type u) + [normed_add_comm_group H] [inner_product_space ℂ H] [complete_space H] extends star_subalgebra ℂ (H →L[ℂ] H) := -(double_commutant : set.centralizer (set.centralizer carrier) = carrier) +(centralizer_centralizer' : + set.centralizer (set.centralizer carrier) = carrier) /-- Consider a von Neumann algebra acting on a Hilbert space `H` as a *-subalgebra of `H →L[ℂ] H`. @@ -77,9 +82,45 @@ or equivalently that it is closed in the weak and strong operator topologies.) add_decl_doc von_neumann_algebra.to_star_subalgebra namespace von_neumann_algebra -variables (H : Type u) [inner_product_space ℂ H] [complete_space H] +variables {H : Type u} [normed_add_comm_group H] [inner_product_space ℂ H] [complete_space H] instance : set_like (von_neumann_algebra H) (H →L[ℂ] H) := -⟨von_neumann_algebra.carrier, λ p q h, by cases p; cases q; congr'⟩ +⟨von_neumann_algebra.carrier, λ S T h, by cases S; cases T; congr'⟩ + +instance : star_mem_class (von_neumann_algebra H) (H →L[ℂ] H) := +{ star_mem := λ s a, s.star_mem' } + +instance : subring_class (von_neumann_algebra H) (H →L[ℂ] H) := +{ add_mem := add_mem', + mul_mem := mul_mem', + one_mem := one_mem', + zero_mem := zero_mem' , + neg_mem := λ s a ha, show -a ∈ s.to_star_subalgebra, from neg_mem ha } + +@[simp] lemma mem_carrier {S : von_neumann_algebra H} {x : H →L[ℂ] H}: + x ∈ S.carrier ↔ x ∈ (S : set (H →L[ℂ] H)) := iff.rfl + +@[ext] theorem ext {S T : von_neumann_algebra H} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T := +set_like.ext h + +@[simp] lemma centralizer_centralizer (S : von_neumann_algebra H) : + set.centralizer (set.centralizer (S : set (H →L[ℂ] H))) = S := S.centralizer_centralizer' + +/-- The centralizer of a `von_neumann_algebra`, as a `von_neumann_algebra`.-/ +def commutant (S : von_neumann_algebra H) : von_neumann_algebra H := +{ carrier := set.centralizer (S : set (H →L[ℂ] H)), + centralizer_centralizer' := by rw S.centralizer_centralizer, + .. star_subalgebra.centralizer ℂ (S : set (H →L[ℂ] H)) (λ a (ha : a ∈ S), (star_mem ha : _)) } + +@[simp] lemma coe_commutant (S : von_neumann_algebra H) : + ↑S.commutant = set.centralizer (S : set (H →L[ℂ] H)) := rfl + +@[simp] lemma mem_commutant_iff {S : von_neumann_algebra H} {z : H →L[ℂ] H} : + z ∈ S.commutant ↔ ∀ g ∈ S, g * z = z * g := +iff.rfl + +@[simp] lemma commutant_commutant (S : von_neumann_algebra H) : + S.commutant.commutant = S := +set_like.coe_injective S.centralizer_centralizer' end von_neumann_algebra diff --git a/src/category_theory/Fintype.lean b/src/category_theory/Fintype.lean index 88859580d7d56..08d43243895d2 100644 --- a/src/category_theory/Fintype.lean +++ b/src/category_theory/Fintype.lean @@ -7,12 +7,15 @@ Authors: Bhavik Mehta, Adam Topaz import category_theory.concrete_category.basic import category_theory.full_subcategory import category_theory.skeletal -import data.fin.basic -import data.fintype.basic +import category_theory.elementwise +import data.fintype.card /-! # The category of finite types. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the category of finite types, denoted `Fintype` as (bundled) types with a `fintype` instance. @@ -43,12 +46,27 @@ instance : category Fintype := induced_category.category bundled.α @[derive [full, faithful], simps] def incl : Fintype ⥤ Type* := induced_functor _ -instance : concrete_category Fintype := ⟨incl⟩ +instance concrete_category_Fintype : concrete_category Fintype := ⟨incl⟩ @[simp] lemma id_apply (X : Fintype) (x : X) : (𝟙 X : X → X) x = x := rfl @[simp] lemma comp_apply {X Y Z : Fintype} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) : (f ≫ g) x = g (f x) := rfl +/-- Equivalences between finite types are the same as isomorphisms in `Fintype`. -/ +-- See `equiv_equiv_iso` in the root namespace for the analogue in `Type`. +@[simps] +def equiv_equiv_iso {A B : Fintype} : (A ≃ B) ≃ (A ≅ B) := +{ to_fun := λ e, + { hom := e, + inv := e.symm, }, + inv_fun := λ i, + { to_fun := i.hom, + inv_fun := i.inv, + left_inv := iso.hom_inv_id_apply i, + right_inv := iso.inv_hom_id_apply i, }, + left_inv := by tidy, + right_inv := by tidy, } + universe u /-- The "standard" skeleton for `Fintype`. This is the full subcategory of `Fintype` spanned by objects diff --git a/src/category_theory/abelian/basic.lean b/src/category_theory/abelian/basic.lean index 053e568b72859..c42493076843b 100644 --- a/src/category_theory/abelian/basic.lean +++ b/src/category_theory/abelian/basic.lean @@ -5,7 +5,7 @@ Authors: Markus Himmel, Johan Commelin, Scott Morrison -/ import category_theory.limits.constructions.pullbacks -import category_theory.limits.shapes.biproducts +import category_theory.preadditive.biproducts import category_theory.limits.shapes.images import category_theory.limits.constructions.limits_of_products_and_equalizers import category_theory.abelian.non_preadditive @@ -13,6 +13,9 @@ import category_theory.abelian.non_preadditive /-! # Abelian categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition and basic properties of abelian categories. There are many definitions of abelian category. Our definition is as follows: @@ -156,7 +159,7 @@ def image_factorisation {X Y : C} (f : X ⟶ Y) [is_iso (abelian.coimage_image_c simp only [image_mono_factorisation_m, is_iso.inv_comp_eq, category.assoc, abelian.coimage_image_comparison], ext, - rw [limits.coequalizer.π_desc_assoc, limits.coequalizer.π_desc_assoc, F.fac, kernel.lift_ι] + simp only [cokernel.π_desc_assoc, mono_factorisation.fac, image.fac], end } } instance [has_zero_object C] {X Y : C} (f : X ⟶ Y) [mono f] @@ -254,10 +257,15 @@ namespace category_theory.abelian variables {C : Type u} [category.{v} C] [abelian C] /-- An abelian category has finite biproducts. -/ -@[priority 100] -instance has_finite_biproducts : has_finite_biproducts C := +-- Porting note: this should be an instance, +-- but triggers https://github.com/leanprover/lean4/issues/2055 +-- We set it as a local instance instead. +-- @[priority 100] instance +theorem has_finite_biproducts : has_finite_biproducts C := limits.has_finite_biproducts.of_has_finite_products +local attribute [instance] has_finite_biproducts + @[priority 100] instance has_binary_biproducts : has_binary_biproducts C := limits.has_binary_biproducts_of_finite_biproducts _ @@ -381,11 +389,41 @@ abbreviation coimage_iso_image' : abelian.coimage f ≅ image f := is_image.iso_ext (coimage_strong_epi_mono_factorisation f).to_mono_is_image (image.is_image f) +lemma coimage_iso_image'_hom : + (coimage_iso_image' f).hom = cokernel.desc _ (factor_thru_image f) + (by simp [←cancel_mono (limits.image.ι f)]) := +begin + ext, + simp only [←cancel_mono (limits.image.ι f), is_image.iso_ext_hom, cokernel.π_desc, category.assoc, + is_image.lift_ι, coimage_strong_epi_mono_factorisation_to_mono_factorisation_m, + limits.image.fac], +end + +lemma factor_thru_image_comp_coimage_iso_image'_inv : + factor_thru_image f ≫ (coimage_iso_image' f).inv = cokernel.π _ := +by simp only [is_image.iso_ext_inv, image.is_image_lift, image.fac_lift, + coimage_strong_epi_mono_factorisation_to_mono_factorisation_e] + /-- There is a canonical isomorphism between the abelian image and the categorical image of a morphism. -/ abbreviation image_iso_image : abelian.image f ≅ image f := is_image.iso_ext (image_strong_epi_mono_factorisation f).to_mono_is_image (image.is_image f) +lemma image_iso_image_hom_comp_image_ι : + (image_iso_image f).hom ≫ limits.image.ι _ = kernel.ι _ := +by simp only [is_image.iso_ext_hom, is_image.lift_ι, + image_strong_epi_mono_factorisation_to_mono_factorisation_m] + +lemma image_iso_image_inv : + (image_iso_image f).inv = kernel.lift _ (limits.image.ι f) + (by simp [←cancel_epi (factor_thru_image f)]) := +begin + ext, + simp only [is_image.iso_ext_inv, image.is_image_lift, limits.image.fac_lift, + image_strong_epi_mono_factorisation_to_mono_factorisation_e, category.assoc, + kernel.lift_ι, limits.image.fac], +end + end images section cokernel_of_kernel @@ -459,11 +497,11 @@ has_pushouts_of_has_binary_coproducts_of_has_coequalizers C @[priority 100] instance has_finite_limits : has_finite_limits C := -limits.finite_limits_from_equalizers_and_finite_products +limits.has_finite_limits_of_has_equalizers_and_finite_products @[priority 100] instance has_finite_colimits : has_finite_colimits C := -limits.finite_colimits_from_coequalizers_and_finite_coproducts +limits.has_finite_colimits_of_has_coequalizers_and_finite_coproducts end diff --git a/src/category_theory/abelian/diagram_lemmas/four.lean b/src/category_theory/abelian/diagram_lemmas/four.lean index 6bb067fc43cb0..5cd6428734fc1 100644 --- a/src/category_theory/abelian/diagram_lemmas/four.lean +++ b/src/category_theory/abelian/diagram_lemmas/four.lean @@ -8,6 +8,9 @@ import category_theory.abelian.pseudoelements /-! # The four and five lemmas +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Consider the following commutative diagram with exact rows in an abelian category: ``` diff --git a/src/category_theory/abelian/exact.lean b/src/category_theory/abelian/exact.lean index 2a66a9c9f379c..596cf13dbbb76 100644 --- a/src/category_theory/abelian/exact.lean +++ b/src/category_theory/abelian/exact.lean @@ -1,11 +1,12 @@ /- Copyright (c) 2020 Markus Himmel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Markus Himmel, Adam Topaz, Johan Commelin +Authors: Markus Himmel, Adam Topaz, Johan Commelin, Jakob von Raumer -/ import category_theory.abelian.opposite import category_theory.limits.preserves.shapes.zero import category_theory.limits.preserves.shapes.kernels +import category_theory.preadditive.left_exact import category_theory.adjunction.limits import algebra.homology.exact import tactic.tfae @@ -13,6 +14,9 @@ import tactic.tfae /-! # Exact sequences in abelian categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In an abelian category, we get several interesting results related to exactness which are not true in more general settings. @@ -27,7 +31,8 @@ true in more general settings. sequences. * `X ⟶ Y ⟶ Z ⟶ 0` is exact if and only if the second map is a cokernel of the first, and `0 ⟶ X ⟶ Y ⟶ Z` is exact if and only if the first map is a kernel of the second. - +* An exact functor preserves exactness, more specifically, `F` preserves finite colimits and + finite limits, if and only if `exact f g` implies `exact (F.map f) (F.map g)`. -/ universes v₁ v₂ u₁ u₂ @@ -78,7 +83,7 @@ begin { ext, simp }, rw this, apply_instance, }, - refine is_limit.of_ι _ _ _ _ _, + refine kernel_fork.is_limit.of_ι _ _ _ _ _, { refine λ W u hu, kernel.lift (cokernel.π f) u _ ≫ (image_iso_image f).hom ≫ (image_subobject_iso _).inv, rw [←kernel.lift_ι g u hu, category.assoc, h.2, has_zero_morphisms.comp_zero] }, @@ -121,13 +126,24 @@ begin is_iso.comp_right_eq_zero _ (cokernel_comparison f F)], end -/-- If `(f, g)` is exact, then `images.image.ι f` is a kernel of `g`. -/ +/-- The dual result is true even in non-abelian categories, see + `category_theory.exact_comp_mono_iff`. -/ +lemma exact_epi_comp_iff {W : C} (h : W ⟶ X) [epi h] : exact (h ≫ f) g ↔ exact f g := +begin + refine ⟨λ hfg, _, λ h, exact_epi_comp h⟩, + let hc := is_cokernel_of_comp _ _ (colimit.is_colimit (parallel_pair (h ≫ f) 0)) + (by rw [← cancel_epi h, ← category.assoc, cokernel_cofork.condition, comp_zero]) rfl, + refine (exact_iff' _ _ (limit.is_limit _) hc).2 ⟨_, ((exact_iff _ _).1 hfg).2⟩, + exact zero_of_epi_comp h (by rw [← hfg.1, category.assoc]) +end + +/-- If `(f, g)` is exact, then `abelian.image.ι f` is a kernel of `g`. -/ def is_limit_image (h : exact f g) : is_limit (kernel_fork.of_ι (abelian.image.ι f) (image_ι_comp_eq_zero h.1) : kernel_fork g) := begin rw exact_iff at h, - refine is_limit.of_ι _ _ _ _ _, + refine kernel_fork.is_limit.of_ι _ _ _ _ _, { refine λ W u hu, kernel.lift (cokernel.π f) u _, rw [←kernel.lift_ι g u hu, category.assoc, h.2, has_zero_morphisms.comp_zero] }, tidy @@ -143,7 +159,7 @@ def is_colimit_coimage (h : exact f g) : is_colimit (cokernel_cofork.of_π (abel (abelian.comp_coimage_π_eq_zero h.1) : cokernel_cofork f) := begin rw exact_iff at h, - refine is_colimit.of_π _ _ _ _ _, + refine cokernel_cofork.is_colimit.of_π _ _ _ _ _, { refine λ W u hu, cokernel.desc (kernel.ι g) u _, rw [←cokernel.π_desc f u hu, ←category.assoc, h.2, has_zero_morphisms.zero_comp] }, tidy @@ -213,6 +229,12 @@ begin rw [← this, category.assoc, cokernel.condition, comp_zero] end +lemma exact_iff_exact_image_ι : exact f g ↔ exact (abelian.image.ι f) g := +by conv_lhs { rw ← abelian.image.fac f }; apply exact_epi_comp_iff + +lemma exact_iff_exact_coimage_π : exact f g ↔ exact f (coimage.π g) := +by conv_lhs { rw ← abelian.coimage.fac g}; apply exact_comp_mono_iff + section variables (Z) @@ -288,11 +310,15 @@ end opposite end abelian namespace functor + +section + variables {D : Type u₂} [category.{v₂} D] [abelian D] +variables (F : C ⥤ D) [preserves_zero_morphisms F] @[priority 100] -instance reflects_exact_sequences_of_preserves_zero_morphisms_of_faithful (F : C ⥤ D) - [preserves_zero_morphisms F] [faithful F] : reflects_exact_sequences F := +instance reflects_exact_sequences_of_preserves_zero_morphisms_of_faithful [faithful F] : + reflects_exact_sequences F := { reflects := λ X Y Z f g hfg, begin rw [abelian.exact_iff, ← F.map_comp, F.map_eq_zero_iff] at hfg, @@ -304,6 +330,148 @@ instance reflects_exact_sequences_of_preserves_zero_morphisms_of_faithful (F : C rw [F.map_comp, ← hk, ← hl, category.assoc, reassoc_of hfg.2, zero_comp, comp_zero] end } +end + +end functor + +namespace functor + +open limits abelian + +variables {A : Type u₁} {B : Type u₂} [category.{v₁} A] [category.{v₂} B] +variables [abelian A] [abelian B] +variables (L : A ⥤ B) + +section + +variables [preserves_finite_limits L] [preserves_finite_colimits L] + +/-- A functor preserving finite limits and finite colimits preserves exactness. The converse +result is also true, see `functor.preserves_finite_limits_of_map_exact` and +`functor.preserves_finite_colimits_of_map_exact`. -/ +lemma map_exact {X Y Z : A} (f : X ⟶ Y) (g : Y ⟶ Z) (e1 : exact f g) : + exact (L.map f) (L.map g) := +begin + let hcoker := is_colimit_of_has_cokernel_of_preserves_colimit L f, + let hker := is_limit_of_has_kernel_of_preserves_limit L g, + refine (exact_iff' _ _ hker hcoker).2 ⟨by simp [← L.map_comp, e1.1], _⟩, + rw [fork.ι_of_ι, cofork.π_of_π, ← L.map_comp, kernel_comp_cokernel _ _ e1, L.map_zero] +end + +end + +section + +variables (h : ∀ ⦃X Y Z : A⦄ {f : X ⟶ Y} {g : Y ⟶ Z}, exact f g → exact (L.map f) (L.map g)) +include h + +open_locale zero_object + +/-- A functor which preserves exactness preserves zero morphisms. -/ +lemma preserves_zero_morphisms_of_map_exact : L.preserves_zero_morphisms := +begin + replace h := (h (exact_of_zero (𝟙 0) (𝟙 0))).w, + rw [L.map_id, category.comp_id] at h, + exact preserves_zero_morphisms_of_map_zero_object (id_zero_equiv_iso_zero _ h), +end + +/-- A functor which preserves exactness preserves monomorphisms. -/ +lemma preserves_monomorphisms_of_map_exact : L.preserves_monomorphisms := +{ preserves := λ X Y f hf, + begin + letI := preserves_zero_morphisms_of_map_exact L h, + apply ((tfae_mono (L.obj 0) (L.map f)).out 2 0).mp, + rw ←L.map_zero, + exact h (((tfae_mono 0 f).out 0 2).mp hf) + end } + +/-- A functor which preserves exactness preserves epimorphisms. -/ +lemma preserves_epimorphisms_of_map_exact : L.preserves_epimorphisms := +{ preserves := λ X Y f hf, + begin + letI := preserves_zero_morphisms_of_map_exact L h, + apply ((tfae_epi (L.obj 0) (L.map f)).out 2 0).mp, + rw ←L.map_zero, + exact h (((tfae_epi 0 f).out 0 2).mp hf) + end } + +/-- A functor which preserves exactness preserves kernels. -/ +def preserves_kernels_of_map_exact (X Y : A) (f : X ⟶ Y) : + preserves_limit (parallel_pair f 0) L := +{ preserves := λ c ic, + begin + letI := preserves_zero_morphisms_of_map_exact L h, + letI := preserves_monomorphisms_of_map_exact L h, + letI := mono_of_is_limit_fork ic, + have hf := (is_limit_map_cone_fork_equiv' L (kernel_fork.condition c)).symm + (is_limit_of_exact_of_mono (L.map (fork.ι c)) (L.map f) + (h (exact_of_is_kernel (fork.ι c) f (kernel_fork.condition c) + (ic.of_iso_limit (iso_of_ι _))))), + exact hf.of_iso_limit ((cones.functoriality _ L).map_iso (iso_of_ι _).symm), + end } + +/-- A functor which preserves exactness preserves zero cokernels. -/ +def preserves_cokernels_of_map_exact (X Y : A) (f : X ⟶ Y) : + preserves_colimit (parallel_pair f 0) L := +{ preserves := λ c ic, + begin + letI := preserves_zero_morphisms_of_map_exact L h, + letI := preserves_epimorphisms_of_map_exact L h, + letI := epi_of_is_colimit_cofork ic, + have hf := (is_colimit_map_cocone_cofork_equiv' L (cokernel_cofork.condition c)).symm + (is_colimit_of_exact_of_epi (L.map f) (L.map (cofork.π c)) + (h (exact_of_is_cokernel f (cofork.π c) (cokernel_cofork.condition c) + (ic.of_iso_colimit (iso_of_π _))))), + exact hf.of_iso_colimit ((cocones.functoriality _ L).map_iso (iso_of_π _).symm), + end } + +/-- A functor which preserves exactness is left exact, i.e. preserves finite limits. +This is part of the inverse implication to `functor.map_exact`. -/ +def preserves_finite_limits_of_map_exact : preserves_finite_limits L := +begin + letI := preserves_zero_morphisms_of_map_exact L h, + letI := preserves_kernels_of_map_exact L h, + apply preserves_finite_limits_of_preserves_kernels, +end + +/-- A functor which preserves exactness is right exact, i.e. preserves finite colimits. +This is part of the inverse implication to `functor.map_exact`. -/ +def preserves_finite_colimits_of_map_exact : preserves_finite_colimits L := +begin + letI := preserves_zero_morphisms_of_map_exact L h, + letI := preserves_cokernels_of_map_exact L h, + apply preserves_finite_colimits_of_preserves_cokernels, +end + +end + +section + +/-- A functor preserving zero morphisms, monos, and cokernels preserves finite limits. -/ +def preserves_finite_limits_of_preserves_monos_and_cokernels + [preserves_zero_morphisms L] [preserves_monomorphisms L] + [∀ {X Y} (f : X ⟶ Y), preserves_colimit (parallel_pair f 0) L] : preserves_finite_limits L := +begin + apply preserves_finite_limits_of_map_exact, + intros X Y Z f g h, + rw [← abelian.coimage.fac g, L.map_comp, exact_comp_mono_iff], + exact exact_of_is_cokernel _ _ _ + (is_colimit_cofork_map_of_is_colimit' L _ (is_colimit_coimage f g h)) +end + +/-- A functor preserving zero morphisms, epis, and kernels preserves finite colimits. -/ +def preserves_finite_colimits_of_preserves_epis_and_kernels + [preserves_zero_morphisms L] [preserves_epimorphisms L] + [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) L] : preserves_finite_colimits L := +begin + apply preserves_finite_colimits_of_map_exact, + intros X Y Z f g h, + rw [← abelian.image.fac f, L.map_comp, exact_epi_comp_iff], + exact exact_of_is_kernel _ _ _ (is_limit_fork_map_of_is_limit' L _ (is_limit_image f g h)) +end + +end + end functor end category_theory diff --git a/src/category_theory/abelian/ext.lean b/src/category_theory/abelian/ext.lean index e3a47ba8fcfcd..c2c6197e87e83 100644 --- a/src/category_theory/abelian/ext.lean +++ b/src/category_theory/abelian/ext.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Adam Topaz -/ -import algebra.category.Group.basic import algebra.category.Module.abelian import category_theory.functor.left_derived import category_theory.linear.yoneda @@ -13,8 +12,11 @@ import category_theory.abelian.projective /-! # Ext +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `Ext R C n : Cᵒᵖ ⥤ C ⥤ Module R` for any `R`-linear abelian category `C` -by deriving in the first argument of the bifunctor `(X, Y) ↦ Module.of R (unop X ⟶ Y)`. +by (left) deriving in the first argument of the bifunctor `(X, Y) ↦ Module.of R (unop X ⟶ Y)`. ## Implementation @@ -22,11 +24,8 @@ It's not actually necessary here to assume `C` is abelian, but the hypotheses, involving both `C` and `Cᵒᵖ`, are quite lengthy, and in practice the abelian case is hopefully enough. -PROJECT we don't yet have injective resolutions and right derived functors -(although this is only a copy-and-paste dualisation) -so we can't even state the alternative definition -in terms of right-deriving in the first argument, -let alone start the harder project of showing they agree. +PROJECT: State the alternative definition in terms of +right deriving in the second argument, and show these agree. -/ noncomputable theory @@ -40,7 +39,7 @@ variables (R : Type*) [ring R] (C : Type*) [category C] [abelian C] [linear R C] `Ext R C n` is defined by deriving in the first argument of `(X, Y) ↦ Module.of R (unop X ⟶ Y)` (which is the second argument of `linear_yoneda`). -/ -@[simps] +@[simps obj map] def Ext (n : ℕ) : Cᵒᵖ ⥤ C ⥤ Module R := functor.flip { obj := λ Y, (((linear_yoneda R C).obj Y).right_op.left_derived n).left_op, diff --git a/src/category_theory/abelian/functor_category.lean b/src/category_theory/abelian/functor_category.lean index c8804931f2963..572d3f420b557 100644 --- a/src/category_theory/abelian/functor_category.lean +++ b/src/category_theory/abelian/functor_category.lean @@ -11,6 +11,9 @@ import category_theory.limits.preserves.shapes.kernels /-! # If `D` is abelian, then the functor category `C ⥤ D` is also abelian. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + -/ noncomputable theory diff --git a/src/category_theory/abelian/generator.lean b/src/category_theory/abelian/generator.lean new file mode 100644 index 0000000000000..0b943135e7aa6 --- /dev/null +++ b/src/category_theory/abelian/generator.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.abelian.subobject +import category_theory.limits.essentially_small +import category_theory.preadditive.injective +import category_theory.preadditive.generator +import category_theory.abelian.opposite + +/-! +# A complete abelian category with enough injectives and a separator has an injective coseparator + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Future work +* Once we know that Grothendieck categories have enough injectives, we can use this to conclude + that Grothendieck categories have an injective coseparator. + +## References +* [Peter J Freyd, *Abelian Categories* (Theorem 3.37)][freyd1964abelian] + +-/ + +open category_theory category_theory.limits opposite + +universes v u + +namespace category_theory.abelian +variables {C : Type u} [category.{v} C] [abelian C] + +theorem has_injective_coseparator [has_limits C] [enough_injectives C] (G : C) + (hG : is_separator G) : ∃ G : C, injective G ∧ is_coseparator G := +begin + haveI : well_powered C := well_powered_of_is_detector G hG.is_detector, + haveI : has_products_of_shape (subobject (op G)) C := has_products_of_shape_of_small _ _, + let T : C := injective.under (pi_obj (λ P : subobject (op G), unop P)), + refine ⟨T, infer_instance, (preadditive.is_coseparator_iff _).2 (λ X Y f hf, _)⟩, + refine (preadditive.is_separator_iff _).1 hG _ (λ h, _), + suffices hh : factor_thru_image (h ≫ f) = 0, + { rw [← limits.image.fac (h ≫ f), hh, zero_comp] }, + let R := subobject.mk (factor_thru_image (h ≫ f)).op, + let q₁ : image (h ≫ f) ⟶ unop R := + (subobject.underlying_iso (factor_thru_image (h ≫ f)).op).unop.hom, + let q₂ : unop (R : Cᵒᵖ) ⟶ pi_obj (λ P : subobject (op G), unop P) := + section_ (pi.π (λ P : subobject (op G), unop P) R), + let q : image (h ≫ f) ⟶ T := q₁ ≫ q₂ ≫ injective.ι _, + exact zero_of_comp_mono q (by rw [← injective.comp_factor_thru q (limits.image.ι (h ≫ f)), + limits.image.fac_assoc, category.assoc, hf, comp_zero]) +end + +theorem has_projective_separator [has_colimits C] [enough_projectives C] (G : C) + (hG : is_coseparator G) : ∃ G : C, projective G ∧ is_separator G := +begin + obtain ⟨T, hT₁, hT₂⟩ := has_injective_coseparator (op G) ((is_separator_op_iff _).2 hG), + exactI ⟨unop T, infer_instance, (is_separator_unop_iff _).2 hT₂⟩ +end + +end category_theory.abelian diff --git a/src/category_theory/abelian/homology.lean b/src/category_theory/abelian/homology.lean index ef09c0ffb79ee..4aea6cb3442c6 100644 --- a/src/category_theory/abelian/homology.lean +++ b/src/category_theory/abelian/homology.lean @@ -1,12 +1,17 @@ /- Copyright (c) 2022 Adam Topaz. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Adam Topaz +Authors: Adam Topaz, Amelia Livingston -/ -import category_theory.abelian.exact +import algebra.homology.additive import category_theory.abelian.pseudoelements +import category_theory.limits.preserves.shapes.kernels +import category_theory.limits.preserves.shapes.images /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The object `homology f g w`, where `w : f ≫ g = 0`, can be identified with either a cokernel or a kernel. The isomorphism with a cokernel is `homology_iso_cokernel_lift`, which @@ -66,9 +71,8 @@ begin kernel.lift_ι, pseudoelement.apply_zero] at ha, simp only [pseudoelement.comp_apply] at ha, obtain ⟨b,hb⟩ : ∃ b, f b = _ := (pseudoelement.pseudo_exact_of_exact (exact_cokernel f)).2 _ ha, - suffices : ∃ c, kernel.lift g f w c = a, - { obtain ⟨c,rfl⟩ := this, - simp [← pseudoelement.comp_apply] }, + rsuffices ⟨c, rfl⟩ : ∃ c, kernel.lift g f w c = a, + { simp [← pseudoelement.comp_apply] }, use b, apply_fun kernel.ι g, swap, { apply pseudoelement.pseudo_injective_of_mono }, @@ -262,5 +266,49 @@ begin end end - end homology + +namespace category_theory.functor + +variables {ι : Type*} {c : complex_shape ι} {B : Type*} [category B] [abelian B] (F : A ⥤ B) + [functor.additive F] [preserves_finite_limits F] [preserves_finite_colimits F] + +/-- When `F` is an exact additive functor, `F(Hᵢ(X)) ≅ Hᵢ(F(X))` for `X` a complex. -/ +noncomputable def homology_iso (C : homological_complex A c) (j : ι) : + F.obj (C.homology j) ≅ ((F.map_homological_complex _).obj C).homology j := +(preserves_cokernel.iso _ _).trans (cokernel.map_iso _ _ ((F.map_iso (image_subobject_iso _)).trans + ((preserves_image.iso _ _).symm.trans (image_subobject_iso _).symm)) + ((F.map_iso (kernel_subobject_iso _)).trans ((preserves_kernel.iso _ _).trans + (kernel_subobject_iso _).symm)) + begin + dsimp, + ext, + simp only [category.assoc, image_to_kernel_arrow], + erw [kernel_subobject_arrow', kernel_comparison_comp_ι, image_subobject_arrow'], + simp [←F.map_comp], + end) + +/-- If `F` is an exact additive functor, then `F` commutes with `Hᵢ` (up to natural isomorphism). -/ +noncomputable def homology_functor_iso (i : ι) : + homology_functor A c i ⋙ F ≅ F.map_homological_complex c ⋙ homology_functor B c i := +nat_iso.of_components (λ X, homology_iso F X i) +begin + intros X Y f, + dsimp, + rw [←iso.inv_comp_eq, ←category.assoc, ←iso.eq_comp_inv], + refine coequalizer.hom_ext _, + dsimp [homology_iso], + simp only [homology.map, ←category.assoc, cokernel.π_desc], + simp only [category.assoc, cokernel_comparison_map_desc, cokernel.π_desc, + π_comp_cokernel_comparison, ←F.map_comp], + erw ←kernel_subobject_iso_comp_kernel_map_assoc, + simp only [homological_complex.hom.sq_from_right, + homological_complex.hom.sq_from_left, F.map_homological_complex_map_f, F.map_comp], + dunfold homological_complex.d_from homological_complex.hom.next, + dsimp, + rw [kernel_map_comp_preserves_kernel_iso_inv_assoc, ←F.map_comp_assoc, + ←kernel_map_comp_kernel_subobject_iso_inv], + any_goals { simp }, +end + +end category_theory.functor diff --git a/src/category_theory/abelian/images.lean b/src/category_theory/abelian/images.lean index 5e2d2a2bf1c46..84368319191fc 100644 --- a/src/category_theory/abelian/images.lean +++ b/src/category_theory/abelian/images.lean @@ -8,6 +8,9 @@ import category_theory.limits.shapes.kernels /-! # The abelian image and coimage. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In an abelian category we usually want the image of a morphism `f` to be defined as `kernel (cokernel.π f)`, and the coimage to be defined as `cokernel (kernel.ι f)`. diff --git a/src/category_theory/abelian/injective.lean b/src/category_theory/abelian/injective.lean new file mode 100644 index 0000000000000..781dbd2ab645b --- /dev/null +++ b/src/category_theory/abelian/injective.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2022 Jakob von Raumer. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jakob von Raumer +-/ + +import category_theory.abelian.exact +import category_theory.preadditive.injective +import category_theory.preadditive.yoneda.limits +import category_theory.preadditive.yoneda.injective + +/-! +# Injective objects in abelian categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +* Objects in an abelian categories are injective if and only if the preadditive Yoneda functor + on them preserves finite colimits. +-/ + +noncomputable theory + +open category_theory +open category_theory.limits +open category_theory.injective +open opposite + +universes v u + +namespace category_theory + +variables {C : Type u} [category.{v} C] [abelian C] + +/-- The preadditive Yoneda functor on `J` preserves colimits if `J` is injective. -/ +def preserves_finite_colimits_preadditive_yoneda_obj_of_injective (J : C) + [hP : injective J] : preserves_finite_colimits (preadditive_yoneda_obj J) := +begin + letI := (injective_iff_preserves_epimorphisms_preadditive_yoneda_obj' J).mp hP, + apply functor.preserves_finite_colimits_of_preserves_epis_and_kernels, +end + +/-- An object is injective if its preadditive Yoneda functor preserves finite colimits. -/ +lemma injective_of_preserves_finite_colimits_preadditive_yoneda_obj (J : C) + [hP : preserves_finite_colimits (preadditive_yoneda_obj J)] : injective J := +begin + rw injective_iff_preserves_epimorphisms_preadditive_yoneda_obj', + apply_instance +end + +end category_theory diff --git a/src/category_theory/abelian/injective_resolution.lean b/src/category_theory/abelian/injective_resolution.lean index 0a7da8778e005..e5fc4068f4dcb 100644 --- a/src/category_theory/abelian/injective_resolution.lean +++ b/src/category_theory/abelian/injective_resolution.lean @@ -3,13 +3,16 @@ Copyright (c) 2022 Jujian Zhang. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jujian Zhang, Scott Morrison -/ +import algebra.homology.quasi_iso import category_theory.preadditive.injective_resolution -import category_theory.abelian.exact import algebra.homology.homotopy_category /-! # Main result +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When the underlying category is abelian: * `category_theory.InjectiveResolution.desc`: Given `I : InjectiveResolution X` and `J : InjectiveResolution Y`, any morphism `X ⟶ Y` admits a descent to a chain map @@ -276,5 +279,22 @@ instance : has_injective_resolutions C := { out := λ _, infer_instance } end InjectiveResolution - end category_theory +namespace homological_complex.hom + +variables {C : Type u} [category.{v} C] [abelian C] + +/-- If `X` is a cochain complex of injective objects and we have a quasi-isomorphism +`f : Y[0] ⟶ X`, then `X` is an injective resolution of `Y.` -/ +def homological_complex.hom.from_single₀_InjectiveResolution (X : cochain_complex C ℕ) (Y : C) + (f : (cochain_complex.single₀ C).obj Y ⟶ X) [quasi_iso f] + (H : ∀ n, injective (X.X n)) : + InjectiveResolution Y := +{ cocomplex := X, + ι := f, + injective := H, + exact₀ := f.from_single₀_exact_f_d_at_zero, + exact := f.from_single₀_exact_at_succ, + mono := f.from_single₀_mono_at_zero } + +end homological_complex.hom diff --git a/src/category_theory/abelian/left_derived.lean b/src/category_theory/abelian/left_derived.lean index 8600b4b02535a..1b4a39141973b 100644 --- a/src/category_theory/abelian/left_derived.lean +++ b/src/category_theory/abelian/left_derived.lean @@ -12,6 +12,9 @@ import category_theory.limits.constructions.epi_mono /-! # Zeroth left derived functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `F : C ⥤ D` is an additive right exact functor between abelian categories, where `C` has enough projectives, we provide the natural isomorphism `F.left_derived 0 ≅ F`. diff --git a/src/category_theory/abelian/non_preadditive.lean b/src/category_theory/abelian/non_preadditive.lean index 3b86071992c8c..13f11f13ec1a9 100644 --- a/src/category_theory/abelian/non_preadditive.lean +++ b/src/category_theory/abelian/non_preadditive.lean @@ -7,11 +7,14 @@ import category_theory.limits.shapes.finite_products import category_theory.limits.shapes.kernels import category_theory.limits.shapes.normal_mono.equalizers import category_theory.abelian.images -import category_theory.preadditive +import category_theory.preadditive.basic /-! # Every non_preadditive_abelian category is preadditive +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In mathlib, we define an abelian category as a preadditive category with a zero object, kernels and cokernels, products and coproducts and in which every monomorphism and epimorphis is normal. diff --git a/src/category_theory/abelian/opposite.lean b/src/category_theory/abelian/opposite.lean index 3dd2cf2967c26..e9639b75b3d69 100644 --- a/src/category_theory/abelian/opposite.lean +++ b/src/category_theory/abelian/opposite.lean @@ -6,10 +6,12 @@ Authors: Scott Morrison import category_theory.abelian.basic import category_theory.preadditive.opposite import category_theory.limits.opposites -import category_theory.limits.constructions.limits_of_products_and_equalizers /-! # The opposite of an abelian category is abelian. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ noncomputable theory @@ -21,9 +23,13 @@ open category_theory.limits variables (C : Type*) [category C] [abelian C] local attribute [instance] - finite_limits_from_equalizers_and_finite_products - finite_colimits_from_coequalizers_and_finite_coproducts - has_finite_limits_opposite has_finite_colimits_opposite has_finite_products_opposite + has_finite_limits_of_has_equalizers_and_finite_products + has_finite_colimits_of_has_coequalizers_and_finite_coproducts + -- Porting note: + -- This should have been a global instance, + -- but triggers https://github.com/leanprover/lean4/issues/2055 + -- when ported to mathlib4. + abelian.has_finite_biproducts instance : abelian Cᵒᵖ := { normal_mono_of_mono := λ X Y f m, by exactI @@ -123,6 +129,46 @@ by simp def cokernel_unop_unop : cokernel g.unop ≅ (kernel g).unop := (cokernel_unop_op g).unop.symm +/-- The opposite of the image of `g.unop` is the image of `g.` -/ +def image_unop_op : opposite.op (image g.unop) ≅ image g := +(abelian.image_iso_image _).op ≪≫ (cokernel_op_op _).symm ≪≫ + cokernel_iso_of_eq (cokernel.π_unop _) ≪≫ (cokernel_epi_comp _ _) + ≪≫ (cokernel_comp_is_iso _ _) ≪≫ (abelian.coimage_iso_image' _) + +/-- The opposite of the image of `f` is the image of `f.op`. -/ +def image_op_op : opposite.op (image f) ≅ image f.op := image_unop_op f.op + +/-- The image of `f.op` is the opposite of the image of `f`. -/ +def image_op_unop : (image f.op).unop ≅ image f := (image_unop_op f.op).unop + +/-- The image of `g` is the opposite of the image of `g.unop.` -/ +def image_unop_unop : (image g).unop ≅ image g.unop := (image_unop_op g).unop + +lemma image_ι_op_comp_image_unop_op_hom : + (image.ι g.unop).op ≫ (image_unop_op g).hom = factor_thru_image g := +begin + dunfold image_unop_op, + simp only [←category.assoc, ←op_comp, iso.trans_hom, iso.symm_hom, iso.op_hom, cokernel_op_op_inv, + cokernel_comp_is_iso_hom, cokernel_epi_comp_hom, cokernel_iso_of_eq_hom_comp_desc_assoc, + abelian.coimage_iso_image'_hom, eq_to_hom_refl, is_iso.inv_id, + category.id_comp (cokernel.π (kernel.ι g))], + simp only [category.assoc, abelian.image_iso_image_hom_comp_image_ι, kernel.lift_ι, + quiver.hom.op_unop, cokernel.π_desc], +end + +lemma image_unop_op_hom_comp_image_ι : + (image_unop_op g).hom ≫ image.ι g = (factor_thru_image g.unop).op := +by simp only [←cancel_epi (image.ι g.unop).op, ←category.assoc, image_ι_op_comp_image_unop_op_hom, + ←op_comp, image.fac, quiver.hom.op_unop] + +lemma factor_thru_image_comp_image_unop_op_inv : + factor_thru_image g ≫ (image_unop_op g).inv = (image.ι g.unop).op := +by rw [iso.comp_inv_eq, image_ι_op_comp_image_unop_op_hom] + +lemma image_unop_op_inv_comp_op_factor_thru_image : + (image_unop_op g).inv ≫ (factor_thru_image g.unop).op = image.ι g := +by rw [iso.inv_comp_eq, image_unop_op_hom_comp_image_ι] + end end category_theory diff --git a/src/category_theory/abelian/projective.lean b/src/category_theory/abelian/projective.lean index 2404efdbfe317..d24b4877fcff4 100644 --- a/src/category_theory/abelian/projective.lean +++ b/src/category_theory/abelian/projective.lean @@ -1,14 +1,19 @@ /- Copyright (c) 2020 Markus Himmel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Markus Himmel, Scott Morrison +Authors: Markus Himmel, Scott Morrison, Jakob von Raumer -/ -import category_theory.abelian.exact +import algebra.homology.quasi_iso import category_theory.preadditive.projective_resolution +import category_theory.preadditive.yoneda.limits +import category_theory.preadditive.yoneda.projective /-! # Abelian categories with enough projectives have projective resolutions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `C` is abelian `projective.d f` and `f` are exact. Hence, starting from an epimorphism `P ⟶ X`, where `P` is projective, we can apply `projective.d` repeatedly to obtain a projective resolution of `X`. @@ -18,25 +23,37 @@ noncomputable theory open category_theory open category_theory.limits +open opposite -universes v u +universes v u v' u' namespace category_theory open category_theory.projective -variables {C : Type u} [category.{v} C] - -section -variables [enough_projectives C] [abelian C] +variables {C : Type u} [category.{v} C] [abelian C] /-- When `C` is abelian, `projective.d f` and `f` are exact. -/ -lemma exact_d_f {X Y : C} (f : X ⟶ Y) : exact (d f) f := +lemma exact_d_f [enough_projectives C] {X Y : C} (f : X ⟶ Y) : exact (d f) f := (abelian.exact_iff _ _).2 $ ⟨by simp, zero_of_epi_comp (π _) $ by rw [←category.assoc, cokernel.condition]⟩ +/-- The preadditive Co-Yoneda functor on `P` preserves colimits if `P` is projective. -/ +def preserves_finite_colimits_preadditive_coyoneda_obj_of_projective (P : C) + [hP : projective P] : preserves_finite_colimits (preadditive_coyoneda_obj (op P)) := +begin + letI := (projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj' P).mp hP, + apply functor.preserves_finite_colimits_of_preserves_epis_and_kernels, +end + +/-- An object is projective if its preadditive Co-Yoneda functor preserves finite colimits. -/ +lemma projective_of_preserves_finite_colimits_preadditive_coyoneda_obj (P : C) + [hP : preserves_finite_colimits (preadditive_coyoneda_obj (op P))] : projective P := +begin + rw projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj', + apply_instance end namespace ProjectiveResolution @@ -49,8 +66,7 @@ After that, we build the `n+1`-st object as `projective.syzygies` applied to the previously constructed morphism, and the map to the `n`-th object as `projective.d`. -/ - -variables [abelian C] [enough_projectives C] +variables [enough_projectives C] /-- Auxiliary definition for `ProjectiveResolution.of`. -/ @[simps] @@ -82,5 +98,22 @@ instance : has_projective_resolutions C := { out := λ Z, by apply_instance } end ProjectiveResolution - end category_theory +namespace homological_complex.hom + +variables {C : Type u} [category.{v} C] [abelian C] + +/-- If `X` is a chain complex of projective objects and we have a quasi-isomorphism `f : X ⟶ Y[0]`, +then `X` is a projective resolution of `Y.` -/ +def to_single₀_ProjectiveResolution {X : chain_complex C ℕ} {Y : C} + (f : X ⟶ (chain_complex.single₀ C).obj Y) [quasi_iso f] + (H : ∀ n, projective (X.X n)) : + ProjectiveResolution Y := +{ complex := X, + π := f, + projective := H, + exact₀ := f.to_single₀_exact_d_f_at_zero, + exact := f.to_single₀_exact_at_succ, + epi := f.to_single₀_epi_at_zero } + +end homological_complex.hom diff --git a/src/category_theory/abelian/pseudoelements.lean b/src/category_theory/abelian/pseudoelements.lean index 00d063cf34615..bdccd6f16fd76 100644 --- a/src/category_theory/abelian/pseudoelements.lean +++ b/src/category_theory/abelian/pseudoelements.lean @@ -5,11 +5,14 @@ Authors: Markus Himmel -/ import category_theory.abelian.exact import category_theory.over -import algebra.category.Module.abelian +import algebra.category.Module.epi_mono /-! # Pseudoelements in abelian categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A *pseudoelement* of an object `X` in an abelian category `C` is an equivalence class of arrows ending in `X`, where two arrows are considered equivalent if we can find two epimorphisms with a common domain making a commutative square with the two arrows. While the construction shows that diff --git a/src/category_theory/abelian/right_derived.lean b/src/category_theory/abelian/right_derived.lean index 40e2d7a4ce326..e3d6b76f63860 100644 --- a/src/category_theory/abelian/right_derived.lean +++ b/src/category_theory/abelian/right_derived.lean @@ -12,6 +12,9 @@ import category_theory.abelian.exact /-! # Right-derived functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the right-derived functors `F.right_derived n : C ⥤ D` for any additive functor `F` out of a category with injective resolutions. @@ -83,7 +86,7 @@ F.right_derived_obj_iso 0 (InjectiveResolution.self X) ≪≫ open_locale zero_object /-- The higher derived functors vanish on injective objects. -/ -@[simps] +@[simps inv] def functor.right_derived_obj_injective_succ (F : C ⥤ D) [F.additive] (n : ℕ) (X : C) [injective X] : (F.right_derived (n+1)).obj X ≅ 0 := diff --git a/src/category_theory/abelian/subobject.lean b/src/category_theory/abelian/subobject.lean new file mode 100644 index 0000000000000..202ac19459a56 --- /dev/null +++ b/src/category_theory/abelian/subobject.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.subobject.limits +import category_theory.abelian.basic + +/-! +# Equivalence between subobjects and quotients in an abelian category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +open category_theory category_theory.limits opposite + +universes v u + +noncomputable theory + +namespace category_theory.abelian +variables {C : Type u} [category.{v} C] + +/-- In an abelian category, the subobjects and quotient objects of an object `X` are + order-isomorphic via taking kernels and cokernels. + Implemented here using subobjects in the opposite category, + since mathlib does not have a notion of quotient objects at the time of writing. -/ +@[simps] +def subobject_iso_subobject_op [abelian C] (X : C) : subobject X ≃o (subobject (op X))ᵒᵈ := +begin + refine order_iso.of_hom_inv (cokernel_order_hom X) (kernel_order_hom X) _ _, + { change (cokernel_order_hom X).comp (kernel_order_hom X) = _, + refine order_hom.ext _ _ (funext (subobject.ind _ _)), + introsI A f hf, + dsimp only [order_hom.comp_coe, function.comp_app, kernel_order_hom_coe, subobject.lift_mk, + cokernel_order_hom_coe, order_hom.id_coe, id.def], + refine subobject.mk_eq_mk_of_comm _ _ ⟨_, _, quiver.hom.unop_inj _, quiver.hom.unop_inj _⟩ _, + { exact (abelian.epi_desc f.unop _ (cokernel.condition (kernel.ι f.unop))).op }, + { exact (cokernel.desc _ _ (kernel.condition f.unop)).op }, + { simp only [← cancel_epi (cokernel.π (kernel.ι f.unop)), unop_comp, quiver.hom.unop_op, + unop_id_op, cokernel.π_desc_assoc, comp_epi_desc, category.comp_id] }, + { simp only [← cancel_epi f.unop, unop_comp, quiver.hom.unop_op, unop_id, comp_epi_desc_assoc, + cokernel.π_desc, category.comp_id] }, + { exact quiver.hom.unop_inj (by simp only [unop_comp, quiver.hom.unop_op, comp_epi_desc]) } }, + { change (kernel_order_hom X).comp (cokernel_order_hom X) = _, + refine order_hom.ext _ _ (funext (subobject.ind _ _)), + introsI A f hf, + dsimp only [order_hom.comp_coe, function.comp_app, cokernel_order_hom_coe, subobject.lift_mk, + kernel_order_hom_coe, order_hom.id_coe, id.def, unop_op, quiver.hom.unop_op], + refine subobject.mk_eq_mk_of_comm _ _ ⟨_, _, _, _⟩ _, + { exact abelian.mono_lift f _ (kernel.condition (cokernel.π f)) }, + { exact kernel.lift _ _ (cokernel.condition f) }, + { simp only [← cancel_mono (kernel.ι (cokernel.π f)), category.assoc, image.fac, mono_lift_comp, + category.id_comp, auto_param_eq] }, + { simp only [← cancel_mono f, category.assoc, mono_lift_comp, image.fac, category.id_comp, + auto_param_eq] }, + { simp only [mono_lift_comp] } } +end + +/-- A well-powered abelian category is also well-copowered. -/ +instance well_powered_opposite [abelian C] [well_powered C] : well_powered Cᵒᵖ := +{ subobject_small := λ X, + (small_congr (subobject_iso_subobject_op (unop X)).to_equiv).1 infer_instance } + +end category_theory.abelian diff --git a/src/category_theory/abelian/transfer.lean b/src/category_theory/abelian/transfer.lean index 80335de073b91..5134e852c5df9 100644 --- a/src/category_theory/abelian/transfer.lean +++ b/src/category_theory/abelian/transfer.lean @@ -3,7 +3,6 @@ Copyright (c) 2022 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import category_theory.preadditive.additive_functor import category_theory.abelian.basic import category_theory.limits.preserves.shapes.kernels import category_theory.adjunction.limits @@ -11,6 +10,9 @@ import category_theory.adjunction.limits /-! # Transferring "abelian-ness" across a functor +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `C` is an additive category, `D` is an abelian category, we have `F : C ⥤ D` `G : D ⥤ C` (both preserving zero morphisms), `G` is left exact (that is, preserves finite limits), @@ -137,10 +139,20 @@ end local attribute [simp] cokernel_iso coimage_iso_image coimage_iso_image_aux -- The account of this proof in the Stacks project omits this calculation. --- Happily it's little effort: our `[ext]` and `[simp]` lemmas only need a little guidance. lemma coimage_iso_image_hom {X Y : C} (f : X ⟶ Y) : (coimage_iso_image F G i adj f).hom = abelian.coimage_image_comparison f := -by { ext, simpa [-functor.map_comp, ←G.map_comp_assoc] using nat_iso.naturality_1 i f, } +begin + ext, + simpa only [←G.map_comp_assoc, coimage_iso_image, nat_iso.inv_inv_app, cokernel_iso, + coimage_iso_image_aux, iso.trans_symm, iso.symm_symm_eq, iso.refl_trans, iso.trans_refl, + iso.trans_hom, iso.symm_hom, cokernel_comp_is_iso_inv, cokernel_epi_comp_inv, as_iso_hom, + functor.map_iso_hom, cokernel_epi_comp_hom, preserves_kernel.iso_hom, kernel_comp_mono_hom, + kernel_is_iso_comp_hom, cokernel_iso_of_eq_hom_comp_desc_assoc, cokernel.π_desc_assoc, + category.assoc, π_comp_cokernel_iso_of_eq_inv_assoc, π_comp_cokernel_comparison_assoc, + kernel.lift_ι, kernel.lift_ι_assoc, kernel_iso_of_eq_hom_comp_ι_assoc, + kernel_comparison_comp_ι_assoc, + abelian.coimage_image_factorisation] using nat_iso.naturality_1 i f +end end abelian_of_adjunction diff --git a/src/category_theory/action.lean b/src/category_theory/action.lean index 794c594e6d982..935da21880345 100644 --- a/src/category_theory/action.lean +++ b/src/category_theory/action.lean @@ -6,12 +6,15 @@ Authors: David Wärn import category_theory.elements import category_theory.is_connected import category_theory.single_obj -import group_theory.group_action.basic +import group_theory.group_action.quotient import group_theory.semidirect_product /-! # Actions as functors and as categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + From a multiplicative action M ↻ X, we can construct a functor from M to the category of types, mapping the single object of M to X and an element `m : M` to map `X → X` given by multiplication by `m`. diff --git a/src/category_theory/additive/basic.lean b/src/category_theory/additive/basic.lean deleted file mode 100644 index c232f535f81d7..0000000000000 --- a/src/category_theory/additive/basic.lean +++ /dev/null @@ -1,37 +0,0 @@ -/- -Copyright (c) 2021 Luke Kershaw. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Luke Kershaw --/ -import category_theory.limits.shapes.biproducts - -/-! -# Additive Categories - -This file contains the definition of additive categories. - -TODO: show that finite biproducts implies enriched over commutative monoids and what is missing -additionally to have additivity is that identities have additive inverses, -see https://ncatlab.org/nlab/show/biproduct#BiproductsImplyEnrichment --/ - -noncomputable theory - -open category_theory -open category_theory.preadditive -open category_theory.limits - -universes v v₀ v₁ v₂ u u₀ u₁ u₂ - -namespace category_theory - -variables (C : Type u) [category C] - - -/-- -A preadditive category `C` is called additive if it has all finite biproducts. -See . --/ -class additive_category extends preadditive C, has_finite_biproducts C - -end category_theory diff --git a/src/category_theory/adhesive.lean b/src/category_theory/adhesive.lean new file mode 100644 index 0000000000000..e253aa0893c9f --- /dev/null +++ b/src/category_theory/adhesive.lean @@ -0,0 +1,275 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.extensive +import category_theory.limits.shapes.kernel_pair + +/-! + +# Adhesive categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions +- `category_theory.is_pushout.is_van_kampen`: A convenience formulation for a pushout being + a van Kampen colimit. +- `category_theory.adhesive`: A category is adhesive if it has pushouts and pullbacks along + monomorphisms, and such pushouts are van Kampen. + +## Main Results +- `category_theory.type.adhesive`: The category of `Type` is adhesive. +- `category_theory.adhesive.is_pullback_of_is_pushout_of_mono_left`: In adhesive categories, + pushouts along monomorphisms are pullbacks. +- `category_theory.adhesive.mono_of_is_pushout_of_mono_left`: In adhesive categories, + monomorphisms are stable under pushouts. +- `category_theory.adhesive.to_regular_mono_category`: Monomorphisms in adhesive categories are + regular (this implies that adhesive categories are balanced). + +## TODO + +Show that the following are adhesive: +- functor categories into adhesive categories +- the categories of sheaves over a site + +## References +- https://ncatlab.org/nlab/show/adhesive+category +- [Stephen Lack and Paweł Sobociński, Adhesive Categories][adhesive2004] + +-/ +namespace category_theory + +open limits + +universes v' u' v u + +variables {J : Type v'} [category.{u'} J] {C : Type u} [category.{v} C] + +variables {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + +/-- A convenience formulation for a pushout being a van Kampen colimit. +See `is_pushout.is_van_kampen_iff` below. -/ +@[nolint unused_arguments] -- This only makes sense when the original diagram is a pushout. +def is_pushout.is_van_kampen (H : is_pushout f g h i) : Prop := +∀ ⦃W' X' Y' Z' : C⦄ (f' : W' ⟶ X') (g' : W' ⟶ Y') (h' : X' ⟶ Z') (i' : Y' ⟶ Z') + (αW : W' ⟶ W) (αX : X' ⟶ X) (αY : Y' ⟶ Y) (αZ : Z' ⟶ Z) + (hf : is_pullback f' αW αX f) (hg : is_pullback g' αW αY g) + (hh : comm_sq h' αX αZ h) (hi : comm_sq i' αY αZ i) + (w : comm_sq f' g' h' i'), + is_pushout f' g' h' i' ↔ is_pullback h' αX αZ h ∧ is_pullback i' αY αZ i + +lemma is_pushout.is_van_kampen.flip {H : is_pushout f g h i} (H' : H.is_van_kampen) : + H.flip.is_van_kampen := +begin + introv W' hf hg hh hi w, + simpa only [is_pushout.flip_iff, is_pullback.flip_iff, and_comm] using + H' g' f' i' h' αW αY αX αZ hg hf hi hh w.flip, +end + +lemma is_pushout.is_van_kampen_iff (H : is_pushout f g h i) : + H.is_van_kampen ↔ is_van_kampen_colimit (pushout_cocone.mk h i H.w) := +begin + split, + { intros H F' c' α fα eα hα, + refine iff.trans _ ((H (F'.map walking_span.hom.fst) (F'.map walking_span.hom.snd) + (c'.ι.app _) (c'.ι.app _) (α.app _) (α.app _) (α.app _) fα + (by convert hα walking_span.hom.fst) (by convert hα walking_span.hom.snd) + _ _ _).trans _), + { have : F'.map walking_span.hom.fst ≫ c'.ι.app walking_span.left = + F'.map walking_span.hom.snd ≫ c'.ι.app walking_span.right := by simp only [cocone.w], + rw (is_colimit.equiv_of_nat_iso_of_iso (diagram_iso_span F') c' + (pushout_cocone.mk _ _ this) _).nonempty_congr, + { exact ⟨λ h, ⟨⟨this⟩, h⟩, λ h, h.2⟩ }, + { refine cocones.ext (iso.refl c'.X) _, rintro (_|_|_); dsimp; + simp only [c'.w, category.assoc, category.id_comp, category.comp_id] } }, + { exact ⟨nat_trans.congr_app eα.symm _⟩ }, + { exact ⟨nat_trans.congr_app eα.symm _⟩ }, + { exact ⟨by simp⟩ }, + split, + { rintros ⟨h₁, h₂⟩ (_|_|_), + { rw ← c'.w walking_span.hom.fst, exact (hα walking_span.hom.fst).paste_horiz h₁ }, + exacts [h₁, h₂] }, + { intro h, exact ⟨h _, h _⟩ } }, + { introv H W' hf hg hh hi w, + refine (iff.trans _ + ((H w.cocone ⟨by { rintros (_|_|_), exacts [αW, αX, αY] }, _⟩ αZ _ _).trans _)), + rotate, + { rintros i _ (_|_|_), + { dsimp, simp only [functor.map_id, category.comp_id, category.id_comp] }, + exacts [hf.w, hg.w] }, + { ext (_|_|_), + { dsimp, rw pushout_cocone.condition_zero, erw [category.assoc, hh.w, hf.w_assoc] }, + exacts [hh.w.symm, hi.w.symm] }, + { rintros i _ (_|_|_), + { dsimp, simp_rw functor.map_id, + exact is_pullback.of_horiz_is_iso ⟨by rw [category.comp_id, category.id_comp]⟩ }, + exacts [hf, hg] }, + { split, + { intro h, exact ⟨h walking_cospan.left, h walking_cospan.right⟩ }, + { rintro ⟨h₁, h₂⟩ (_|_|_), + { dsimp, rw pushout_cocone.condition_zero, exact hf.paste_horiz h₁ }, + exacts [h₁, h₂] } }, + { exact ⟨λ h, h.2, λ h, ⟨_, h⟩⟩ } } +end +. + +lemma is_coprod_iff_is_pushout {X E Y YE : C} (c : binary_cofan X E) + (hc : is_colimit c) {f : X ⟶ Y} {iY : Y ⟶ YE} {fE : c.X ⟶ YE} + (H : comm_sq f c.inl iY fE) : + nonempty (is_colimit (binary_cofan.mk (c.inr ≫ fE) iY)) ↔ is_pushout f c.inl iY fE := +begin + split, + { rintro ⟨h⟩, + refine ⟨H, ⟨limits.pushout_cocone.is_colimit_aux' _ _⟩⟩, + intro s, + dsimp, + refine ⟨h.desc (binary_cofan.mk (c.inr ≫ s.inr) s.inl), h.fac _ ⟨walking_pair.right⟩, _, _⟩, + { apply binary_cofan.is_colimit.hom_ext hc, + { rw ← H.w_assoc, erw h.fac _ ⟨walking_pair.right⟩, exact s.condition }, + { rw ← category.assoc, exact h.fac _ ⟨walking_pair.left⟩ } }, + { intros m e₁ e₂, + apply binary_cofan.is_colimit.hom_ext h, + { dsimp, rw [category.assoc, e₂, eq_comm], exact h.fac _ ⟨walking_pair.left⟩ }, + { refine e₁.trans (eq.symm _), exact h.fac _ _ } } }, + { refine λ H, ⟨_⟩, + fapply limits.binary_cofan.is_colimit_mk, + { exact λ s, H.is_colimit.desc (pushout_cocone.mk s.inr _ $ + (hc.fac (binary_cofan.mk (f ≫ s.inr) s.inl) ⟨walking_pair.left⟩).symm) }, + { intro s, + erw [category.assoc, H.is_colimit.fac _ walking_span.right, hc.fac], refl }, + { intro s, exact H.is_colimit.fac _ walking_span.left }, + { intros s m e₁ e₂, + apply pushout_cocone.is_colimit.hom_ext H.is_colimit, + { symmetry, exact (H.is_colimit.fac _ walking_span.left).trans e₂.symm }, + { erw H.is_colimit.fac _ walking_span.right, + apply binary_cofan.is_colimit.hom_ext hc, + { dsimp, erw [hc.fac, ← H.w_assoc, e₂], refl }, + { refine ((category.assoc _ _ _).symm.trans e₁).trans _, symmetry, exact hc.fac _ _ } } } } +end + +lemma is_pushout.is_van_kampen_inl {W E X Z : C} (c : binary_cofan W E) + [finitary_extensive C] + [has_pullbacks C] + (hc : is_colimit c) (f : W ⟶ X) (h : X ⟶ Z) (i : c.X ⟶ Z) + (H : is_pushout f c.inl h i) : H.is_van_kampen := +begin + obtain ⟨hc₁⟩ := (is_coprod_iff_is_pushout c hc H.1).mpr H, + introv W' hf hg hh hi w, + obtain ⟨hc₂⟩ := ((binary_cofan.is_van_kampen_iff _).mp (finitary_extensive.van_kampen c hc) + (binary_cofan.mk _ pullback.fst) _ _ _ hg.w.symm pullback.condition.symm).mpr + ⟨hg, is_pullback.of_has_pullback αY c.inr⟩, + refine (is_coprod_iff_is_pushout _ hc₂ w).symm.trans _, + refine ((binary_cofan.is_van_kampen_iff _).mp (finitary_extensive.van_kampen _ hc₁) + (binary_cofan.mk _ _) pullback.snd _ _ _ hh.w.symm).trans _, + { dsimp, rw [← pullback.condition_assoc, category.assoc, hi.w] }, + split, + { rintro ⟨hc₃, hc₄⟩, + refine ⟨hc₄, _⟩, + let Y'' := pullback αZ i, + let cmp : Y' ⟶ Y'' := pullback.lift i' αY hi.w, + have e₁ : (g' ≫ cmp) ≫ pullback.snd = αW ≫ c.inl := + by rw [category.assoc, pullback.lift_snd, hg.w], + have e₂ : (pullback.fst ≫ cmp : pullback αY c.inr ⟶ _) ≫ pullback.snd = + pullback.snd ≫ c.inr := + by rw [category.assoc, pullback.lift_snd, pullback.condition], + obtain ⟨hc₄⟩ := ((binary_cofan.is_van_kampen_iff _).mp (finitary_extensive.van_kampen c hc) + (binary_cofan.mk _ _) αW _ _ e₁.symm e₂.symm).mpr ⟨_, _⟩, + { rw [← category.id_comp αZ, ← show cmp ≫ pullback.snd = αY, from pullback.lift_snd _ _ _], + apply is_pullback.paste_vert _ (is_pullback.of_has_pullback αZ i), + have : cmp = (hc₂.cocone_point_unique_up_to_iso hc₄).hom, + { apply binary_cofan.is_colimit.hom_ext hc₂, + exacts [(hc₂.comp_cocone_point_unique_up_to_iso_hom hc₄ ⟨walking_pair.left⟩).symm, + (hc₂.comp_cocone_point_unique_up_to_iso_hom hc₄ ⟨walking_pair.right⟩).symm] }, + rw this, + exact is_pullback.of_vert_is_iso ⟨by rw [← this, category.comp_id, pullback.lift_fst]⟩ }, + { apply is_pullback.of_right _ e₁ (is_pullback.of_has_pullback _ _), + rw [category.assoc, pullback.lift_fst, ← H.w, ← w.w], exact hf.paste_horiz hc₄ }, + { apply is_pullback.of_right _ e₂ (is_pullback.of_has_pullback _ _), + rw [category.assoc, pullback.lift_fst], exact hc₃ } }, + { rintros ⟨hc₃, hc₄⟩, + exact ⟨(is_pullback.of_has_pullback αY c.inr).paste_horiz hc₄, hc₃⟩ } +end + +lemma is_pushout.is_van_kampen.is_pullback_of_mono_left [mono f] + {H : is_pushout f g h i} (H' : H.is_van_kampen) : + is_pullback f g h i := +((H' (𝟙 _) g g (𝟙 Y) (𝟙 _) f (𝟙 _) i + (is_kernel_pair.id_of_mono f) (is_pullback.of_vert_is_iso ⟨by simp⟩) H.1.flip ⟨rfl⟩ + ⟨by simp⟩).mp (is_pushout.of_horiz_is_iso ⟨by simp⟩)).1.flip + +lemma is_pushout.is_van_kampen.is_pullback_of_mono_right [mono g] + {H : is_pushout f g h i} (H' : H.is_van_kampen) : + is_pullback f g h i := +((H' f (𝟙 _) (𝟙 _) f (𝟙 _) (𝟙 _) g h (is_pullback.of_vert_is_iso ⟨by simp⟩) + (is_kernel_pair.id_of_mono g) ⟨rfl⟩ H.1 + ⟨by simp⟩).mp (is_pushout.of_vert_is_iso ⟨by simp⟩)).2 + +lemma is_pushout.is_van_kampen.mono_of_mono_left [mono f] + {H : is_pushout f g h i} (H' : H.is_van_kampen) : + mono i := +is_kernel_pair.mono_of_is_iso_fst + (((H' (𝟙 _) g g (𝟙 Y) (𝟙 _) f (𝟙 _) i + (is_kernel_pair.id_of_mono f) (is_pullback.of_vert_is_iso ⟨by simp⟩) H.1.flip ⟨rfl⟩ + ⟨by simp⟩).mp (is_pushout.of_horiz_is_iso ⟨by simp⟩)).2) + +lemma is_pushout.is_van_kampen.mono_of_mono_right [mono g] + {H : is_pushout f g h i} (H' : H.is_van_kampen) : + mono h := +is_kernel_pair.mono_of_is_iso_fst + ((H' f (𝟙 _) (𝟙 _) f (𝟙 _) (𝟙 _) g h (is_pullback.of_vert_is_iso ⟨by simp⟩) + (is_kernel_pair.id_of_mono g) ⟨rfl⟩ H.1 + ⟨by simp⟩).mp (is_pushout.of_vert_is_iso ⟨by simp⟩)).1 + +/-- A category is adhesive if it has pushouts and pullbacks along monomorphisms, +and such pushouts are van Kampen. -/ +class adhesive (C : Type u) [category.{v} C] : Prop := +[has_pullback_of_mono_left : ∀ {X Y S : C} (f : X ⟶ S) (g : Y ⟶ S) [mono f], has_pullback f g] +[has_pushout_of_mono_left : ∀ {X Y S : C} (f : S ⟶ X) (g : S ⟶ Y) [mono f], has_pushout f g] +(van_kampen : ∀ {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} [mono f] + (H : is_pushout f g h i), H.is_van_kampen) + +attribute [priority 100, instance] + adhesive.has_pullback_of_mono_left adhesive.has_pushout_of_mono_left + +lemma adhesive.van_kampen' [adhesive C] [mono g] (H : is_pushout f g h i) : H.is_van_kampen := +(adhesive.van_kampen H.flip).flip + +lemma adhesive.is_pullback_of_is_pushout_of_mono_left [adhesive C] + (H : is_pushout f g h i) [mono f] : is_pullback f g h i := +(adhesive.van_kampen H).is_pullback_of_mono_left + +lemma adhesive.is_pullback_of_is_pushout_of_mono_right [adhesive C] + (H : is_pushout f g h i) [mono g] : is_pullback f g h i := +(adhesive.van_kampen' H).is_pullback_of_mono_right + +lemma adhesive.mono_of_is_pushout_of_mono_left [adhesive C] + (H : is_pushout f g h i) [mono f] : mono i := +(adhesive.van_kampen H).mono_of_mono_left + +lemma adhesive.mono_of_is_pushout_of_mono_right [adhesive C] + (H : is_pushout f g h i) [mono g] : mono h := +(adhesive.van_kampen' H).mono_of_mono_right + +instance type.adhesive : adhesive (Type u) := +begin + constructor, + intros, + exactI (is_pushout.is_van_kampen_inl _ (types.is_coprod_of_mono f) _ _ _ H.flip).flip +end + +@[priority 100] noncomputable +instance adhesive.to_regular_mono_category [adhesive C] : regular_mono_category C := +⟨λ X Y f hf, by exactI + { Z := pushout f f, + left := pushout.inl, + right := pushout.inr, + w := pushout.condition, + is_limit := (adhesive.is_pullback_of_is_pushout_of_mono_left + (is_pushout.of_has_pushout f f)).is_limit_fork }⟩ + +-- This then implies that adhesive categories are balanced +example [adhesive C] : balanced C := infer_instance + +end category_theory diff --git a/src/category_theory/adjunction/adjoint_functor_theorems.lean b/src/category_theory/adjunction/adjoint_functor_theorems.lean index 370acdc8ad9b7..9b99b59f433ab 100644 --- a/src/category_theory/adjunction/adjoint_functor_theorems.lean +++ b/src/category_theory/adjunction/adjoint_functor_theorems.lean @@ -3,17 +3,18 @@ Copyright (c) 2021 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ -import category_theory.adjunction.basic -import category_theory.adjunction.comma +import category_theory.generator +import category_theory.limits.cone_category import category_theory.limits.constructions.weakly_initial -import category_theory.limits.preserves.basic -import category_theory.limits.creates -import category_theory.limits.comma -import category_theory.punit +import category_theory.limits.functor_category +import category_theory.subobject.comma /-! # Adjoint functor theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves the (general) adjoint functor theorem, in the form: * If `G : D ⥤ C` preserves limits and `D` has limits, and satisfies the solution set condition, then it has a left adjoint: `is_right_adjoint_of_preserves_limits_of_solution_set_condition`. @@ -26,8 +27,16 @@ We define the *solution set condition* for the functor `G : D ⥤ C` to mean, fo `A : C`, there is a set-indexed family ${f_i : A ⟶ G (B_i)}$ such that any morphism `A ⟶ G X` factors through one of the `f_i`. +This file also proves the special adjoint functor theorem, in the form: +* If `G : D ⥤ C` preserves limits and `D` is complete, well-powered and has a small coseparating + set, then `G` has a left adjoint: `is_right_adjoint_of_preserves_limits_of_is_coseparating` + +Finally, we prove the following corollary of the special adjoint functor theorem: +* If `C` is complete, well-powered and has a small coseparating set, then it is cocomplete: + `has_colimits_of_has_limits_of_is_coseparating` + -/ -universes v u +universes v u u' namespace category_theory open limits @@ -48,9 +57,8 @@ def solution_set_condition {D : Type u} [category.{v} D] (G : D ⥤ C) : Prop := ∀ (A : C), ∃ (ι : Type v) (B : ι → D) (f : Π (i : ι), A ⟶ G.obj (B i)), ∀ X (h : A ⟶ G.obj X), ∃ (i : ι) (g : B i ⟶ X), f i ≫ G.map g = h -variables {D : Type u} [category.{v} D] - section general_adjoint_functor_theorem +variables {D : Type u} [category.{v} D] variables (G : D ⥤ C) @@ -88,4 +96,49 @@ end end general_adjoint_functor_theorem +section special_adjoint_functor_theorem +variables {D : Type u'} [category.{v} D] + +/-- +The special adjoint functor theorem: if `G : D ⥤ C` preserves limits and `D` is complete, +well-powered and has a small coseparating set, then `G` has a left adjoint. +-/ +noncomputable def is_right_adjoint_of_preserves_limits_of_is_coseparating [has_limits D] + [well_powered D] {𝒢 : set D} [small.{v} 𝒢] (h𝒢 : is_coseparating 𝒢) (G : D ⥤ C) + [preserves_limits G] : is_right_adjoint G := +have ∀ A, has_initial (structured_arrow A G), + from λ A, has_initial_of_is_coseparating (structured_arrow.is_coseparating_proj_preimage A G h𝒢), +by exactI is_right_adjoint_of_structured_arrow_initials _ + +/-- +The special adjoint functor theorem: if `F : C ⥤ D` preserves colimits and `C` is cocomplete, +well-copowered and has a small separating set, then `F` has a right adjoint. +-/ +noncomputable def is_left_adjoint_of_preserves_colimits_of_is_separatig [has_colimits C] + [well_powered Cᵒᵖ] {𝒢 : set C} [small.{v} 𝒢] (h𝒢 : is_separating 𝒢) (F : C ⥤ D) + [preserves_colimits F] : is_left_adjoint F := +have ∀ A, has_terminal (costructured_arrow F A), + from λ A, has_terminal_of_is_separating (costructured_arrow.is_separating_proj_preimage F A h𝒢), +by exactI is_left_adjoint_of_costructured_arrow_terminals _ + +end special_adjoint_functor_theorem + +namespace limits + +/-- A consequence of the special adjoint functor theorem: if `C` is complete, well-powered and + has a small coseparating set, then it is cocomplete. -/ +lemma has_colimits_of_has_limits_of_is_coseparating [has_limits C] [well_powered C] + {𝒢 : set C} [small.{v} 𝒢] (h𝒢 : is_coseparating 𝒢) : has_colimits C := +{ has_colimits_of_shape := λ J hJ, by exactI has_colimits_of_shape_iff_is_right_adjoint_const.2 + ⟨is_right_adjoint_of_preserves_limits_of_is_coseparating h𝒢 _⟩ } + +/-- A consequence of the special adjoint functor theorem: if `C` is cocomplete, well-copowered and + has a small separating set, then it is complete. -/ +lemma has_limits_of_has_colimits_of_is_separating [has_colimits C] [well_powered Cᵒᵖ] + {𝒢 : set C} [small.{v} 𝒢] (h𝒢 : is_separating 𝒢) : has_limits C := +{ has_limits_of_shape := λ J hJ, by exactI has_limits_of_shape_iff_is_left_adjoint_const.2 + ⟨is_left_adjoint_of_preserves_colimits_of_is_separatig h𝒢 _⟩ } + +end limits + end category_theory diff --git a/src/category_theory/adjunction/basic.lean b/src/category_theory/adjunction/basic.lean index ed35f987c3e54..9000cc8e1b0b5 100644 --- a/src/category_theory/adjunction/basic.lean +++ b/src/category_theory/adjunction/basic.lean @@ -8,6 +8,9 @@ import category_theory.equivalence /-! # Adjunctions between functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `F ⊣ G` represents the data of an adjunction between two functors `F : C ⥤ D` and `G : D ⥤ C`. `F` is the left adjoint and `G` is the right adjoint. @@ -170,7 +173,7 @@ This is an auxiliary data structure useful for constructing adjunctions. See `adjunction.mk_of_hom_equiv`. This structure won't typically be used anywhere else. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure core_hom_equiv (F : C ⥤ D) (G : D ⥤ C) := (hom_equiv : Π (X Y), (F.obj X ⟶ Y) ≃ (X ⟶ G.obj Y)) (hom_equiv_naturality_left_symm' : Π {X' X Y} (f : X' ⟶ X) (g : X ⟶ G.obj Y), @@ -201,7 +204,7 @@ This is an auxiliary data structure useful for constructing adjunctions. See `adjunction.mk_of_unit_counit`. This structure won't typically be used anywhere else. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure core_unit_counit (F : C ⥤ D) (G : D ⥤ C) := (unit : 𝟭 C ⟶ F.comp G) (counit : G.comp F ⟶ 𝟭 D) @@ -326,7 +329,7 @@ def left_adjoint_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [r : is_left_adjoint F adj := of_nat_iso_left r.adj h } section -variables {E : Type u₃} [ℰ : category.{v₃} E] (H : D ⥤ E) (I : E ⥤ D) +variables {E : Type u₃} [ℰ : category.{v₃} E] {H : D ⥤ E} {I : E ⥤ D} /-- Composition of adjunctions. @@ -344,13 +347,13 @@ def comp (adj₁ : F ⊣ G) (adj₂ : H ⊣ I) : F ⋙ H ⊣ I ⋙ G := instance left_adjoint_of_comp {E : Type u₃} [ℰ : category.{v₃} E] (F : C ⥤ D) (G : D ⥤ E) [Fl : is_left_adjoint F] [Gl : is_left_adjoint G] : is_left_adjoint (F ⋙ G) := { right := Gl.right ⋙ Fl.right, - adj := comp _ _ Fl.adj Gl.adj } + adj := Fl.adj.comp Gl.adj } /-- If `F` and `G` are right adjoints then `F ⋙ G` is a right adjoint too. -/ instance right_adjoint_of_comp {E : Type u₃} [ℰ : category.{v₃} E] {F : C ⥤ D} {G : D ⥤ E} [Fr : is_right_adjoint F] [Gr : is_right_adjoint G] : is_right_adjoint (F ⋙ G) := { left := Gr.left ⋙ Fr.left, - adj := comp _ _ Gr.adj Fr.adj } + adj := Gr.adj.comp Fr.adj } end diff --git a/src/category_theory/adjunction/comma.lean b/src/category_theory/adjunction/comma.lean index 866d4189526d3..b4668efc61b2e 100644 --- a/src/category_theory/adjunction/comma.lean +++ b/src/category_theory/adjunction/comma.lean @@ -10,6 +10,9 @@ import category_theory.structured_arrow /-! # Properties of comma categories relating to adjunctions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file shows that for a functor `G : D ⥤ C` the data of an initial object in each `structured_arrow` category on `G` is equivalent to a left adjoint to `G`, as well as the dual. @@ -19,14 +22,14 @@ provided a left adjoint. The duals are also shown. -/ -universes v u₁ u₂ +universes v₁ v₂ u₁ u₂ noncomputable theory namespace category_theory open limits -variables {C : Type u₁} {D : Type u₂} [category.{v} C] [category.{v} D] (G : D ⥤ C) +variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] (G : D ⥤ C) section of_initials variables [∀ A, has_initial (structured_arrow A G)] @@ -46,14 +49,14 @@ def left_adjoint_of_structured_arrow_initials_aux (A : C) (B : D) : structured_arrow.mk ((⊥_ (structured_arrow A G)).hom ≫ G.map g), let g' : ⊥_ (structured_arrow A G) ⟶ B' := structured_arrow.hom_mk g rfl, have : initial.to _ = g', - { apply colimit.hom_ext, rintro ⟨⟩ }, + { apply colimit.hom_ext, rintro ⟨⟨⟩⟩ }, change comma_morphism.right (initial.to B') = _, rw this, refl end, right_inv := λ f, begin - let B' : structured_arrow A G := { right := B, hom := f }, + let B' : structured_arrow A G := structured_arrow.mk f, apply (comma_morphism.w (initial.to B')).symm.trans (category.id_comp _), end } @@ -97,7 +100,7 @@ def right_adjoint_of_costructured_arrow_terminals_aux (B : D) (A : C) : costructured_arrow.mk (G.map g ≫ (⊤_ (costructured_arrow G A)).hom), let g' : B' ⟶ ⊤_ (costructured_arrow G A) := costructured_arrow.hom_mk g rfl, have : terminal.from _ = g', - { apply limit.hom_ext, rintro ⟨⟩ }, + { apply limit.hom_ext, rintro ⟨⟨⟩⟩ }, change comma_morphism.left (terminal.from B') = _, rw this, refl @@ -120,7 +123,7 @@ def adjunction_of_costructured_arrow_terminals : adjunction.adjunction_of_equiv_right _ _ /-- If each costructured arrow category on `G` has an terminal object, `G` is a left adjoint. -/ -def is_right_adjoint_of_costructured_arrow_terminals : is_left_adjoint G := +def is_left_adjoint_of_costructured_arrow_terminals : is_left_adjoint G := { right := right_adjoint_of_costructured_arrow_terminals G, adj := adjunction.adjunction_of_equiv_right _ _ } @@ -129,6 +132,8 @@ end of_terminals section variables {F : C ⥤ D} +local attribute [tidy] tactic.discrete_cases + /-- Given a left adjoint to `G`, we can construct an initial object in each structured arrow category on `G`. -/ def mk_initial_of_left_adjoint (h : F ⊣ G) (A : C) : @@ -157,4 +162,14 @@ def mk_terminal_of_right_adjoint (h : F ⊣ G) (A : D) : end +lemma nonempty_is_right_adjoint_iff_has_initial_structured_arrow {G : D ⥤ C} : + nonempty (is_right_adjoint G) ↔ ∀ A, has_initial (structured_arrow A G) := +⟨λ ⟨h⟩ A, by exactI (mk_initial_of_left_adjoint _ h.adj A).has_initial, + λ h, by exactI ⟨is_right_adjoint_of_structured_arrow_initials _⟩⟩ + +lemma nonempty_is_left_adjoint_iff_has_terminal_costructured_arrow {F : C ⥤ D} : + nonempty (is_left_adjoint F) ↔ ∀ A, has_terminal (costructured_arrow F A) := +⟨λ ⟨h⟩ A, by exactI (mk_terminal_of_right_adjoint _ h.adj A).has_terminal, + λ h, by exactI ⟨is_left_adjoint_of_costructured_arrow_terminals _⟩⟩ + end category_theory diff --git a/src/category_theory/adjunction/default.lean b/src/category_theory/adjunction/default.lean deleted file mode 100644 index d314185bc87f6..0000000000000 --- a/src/category_theory/adjunction/default.lean +++ /dev/null @@ -1,3 +0,0 @@ -import category_theory.adjunction.limits -import category_theory.adjunction.opposites -import category_theory.adjunction.reflective diff --git a/src/category_theory/adjunction/evaluation.lean b/src/category_theory/adjunction/evaluation.lean index 0f5f80e8df6d5..097ee2700263b 100644 --- a/src/category_theory/adjunction/evaluation.lean +++ b/src/category_theory/adjunction/evaluation.lean @@ -5,12 +5,15 @@ Authors: Adam Topaz -/ import category_theory.limits.shapes.products -import category_theory.epi_mono +import category_theory.functor.epi_mono /-! # Adjunctions involving evaluation +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that evaluation of functors have adjoints, given the existence of (co)products. -/ @@ -35,7 +38,7 @@ def evaluation_left_adjoint (c : C) : D ⥤ C ⥤ D := { obj := λ t, ∐ (λ i : c ⟶ t, d), map := λ u v f, sigma.desc $ λ g, sigma.ι (λ _, d) $ g ≫ f, map_id' := begin - intros, ext, simp only [cofan.mk_ι_app, colimit.ι_desc, category.comp_id], + intros, ext ⟨j⟩, simp only [cofan.mk_ι_app, colimit.ι_desc, category.comp_id], congr' 1, rw category.comp_id, end, map_comp' := begin @@ -45,7 +48,7 @@ def evaluation_left_adjoint (c : C) : D ⥤ C ⥤ D := map := λ d₁ d₂ f, { app := λ e, sigma.desc $ λ h, f ≫ sigma.ι (λ _, d₂) h, naturality' := by { intros, ext, dsimp, simp } }, - map_id' := by { intros, ext, dsimp, simp }, + map_id' := by { intros, ext x ⟨j⟩, dsimp, simp }, map_comp' := by { intros, ext, dsimp, simp } } /-- The adjunction showing that evaluation is a right adjoint. -/ @@ -60,7 +63,7 @@ adjunction.mk_of_hom_equiv naturality' := by { intros, ext, dsimp, simp } }, left_inv := begin intros f, - ext x g, + ext x ⟨g⟩, dsimp, simp only [colimit.ι_desc, limits.cofan.mk_ι_app, category.assoc, ← f.naturality, evaluation_left_adjoint_obj_map, colimit.ι_desc_assoc, cofan.mk_ι_app], @@ -75,14 +78,14 @@ instance evaluation_is_right_adjoint (c : C) : is_right_adjoint ((evaluation _ D).obj c) := ⟨_, evaluation_adjunction_right _ _⟩ -lemma nat_trans.mono_iff_app_mono {F G : C ⥤ D} (η : F ⟶ G) : +lemma nat_trans.mono_iff_mono_app {F G : C ⥤ D} (η : F ⟶ G) : mono η ↔ (∀ c, mono (η.app c)) := begin split, - { intros h c, - exact right_adjoint_preserves_mono (evaluation_adjunction_right D c) h }, + { introsI h c, + exact (infer_instance : mono (((evaluation _ _).obj c).map η)) }, { introsI _, - apply nat_trans.mono_app_of_mono } + apply nat_trans.mono_of_mono_app } end end @@ -98,19 +101,19 @@ def evaluation_right_adjoint (c : C) : D ⥤ C ⥤ D := { obj := λ t, ∏ (λ i : t ⟶ c, d), map := λ u v f, pi.lift $ λ g, pi.π _ $ f ≫ g, map_id' := begin - intros, ext, dsimp, + intros, ext ⟨j⟩, dsimp, simp only [limit.lift_π, category.id_comp, fan.mk_π_app], congr, simp, end, map_comp' := begin - intros, ext, dsimp, + intros, ext ⟨j⟩, dsimp, simp only [limit.lift_π, fan.mk_π_app, category.assoc], congr' 1, simp, end }, map := λ d₁ d₂ f, { app := λ t, pi.lift $ λ g, pi.π _ g ≫ f, naturality' := by { intros, ext, dsimp, simp } }, - map_id' := by { intros, ext, dsimp, simp }, + map_id' := by { intros, ext x ⟨j⟩, dsimp, simp }, map_comp' := by { intros, ext, dsimp, simp } } /-- The adjunction showing that evaluation is a left adjoint. -/ @@ -126,7 +129,7 @@ adjunction.mk_of_hom_equiv left_inv := λ f, by { dsimp, simp }, right_inv := begin intros f, - ext x g, + ext x ⟨g⟩, dsimp, simp only [limit.lift_π, evaluation_right_adjoint_obj_map, nat_trans.naturality_assoc, fan.mk_π_app], @@ -140,14 +143,14 @@ instance evaluation_is_left_adjoint (c : C) : is_left_adjoint ((evaluation _ D).obj c) := ⟨_, evaluation_adjunction_left _ _⟩ -lemma nat_trans.epi_iff_app_epi {F G : C ⥤ D} (η : F ⟶ G) : +lemma nat_trans.epi_iff_epi_app {F G : C ⥤ D} (η : F ⟶ G) : epi η ↔ (∀ c, epi (η.app c)) := begin split, - { intros h c, - exact left_adjoint_preserves_epi (evaluation_adjunction_left D c) h }, + { introsI h c, + exact (infer_instance : epi (((evaluation _ _).obj c).map η)) }, { introsI, - apply nat_trans.epi_app_of_epi } + apply nat_trans.epi_of_epi_app } end end diff --git a/src/category_theory/adjunction/fully_faithful.lean b/src/category_theory/adjunction/fully_faithful.lean index ca29238caf89b..863d933a046ee 100644 --- a/src/category_theory/adjunction/fully_faithful.lean +++ b/src/category_theory/adjunction/fully_faithful.lean @@ -10,6 +10,9 @@ import category_theory.yoneda /-! # Adjoints of fully faithful functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A left adjoint is fully faithful, if and only if the unit is an isomorphism (and similarly for right adjoints and the counit). diff --git a/src/category_theory/adjunction/lifting.lean b/src/category_theory/adjunction/lifting.lean index 56580ff1cf95b..d1b70e8462e1a 100644 --- a/src/category_theory/adjunction/lifting.lean +++ b/src/category_theory/adjunction/lifting.lean @@ -11,6 +11,9 @@ import category_theory.monad.coequalizer /-! # Adjoint lifting +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file gives two constructions for building left adjoints: the adjoint triangle theorem and the adjoint lifting theorem. The adjoint triangle theorem says that given a functor `U : B ⥤ C` with a left adjoint `F` such @@ -199,10 +202,9 @@ noncomputable def monadic_adjoint_triangle_lift (U : B ⥤ C) [monadic_right_adj is_right_adjoint R := begin let R' : A ⥤ _ := R ⋙ monad.comparison (adjunction.of_right_adjoint U), - suffices : is_right_adjoint R', + rsufficesI : is_right_adjoint R', { let : is_right_adjoint (R' ⋙ (monad.comparison (adjunction.of_right_adjoint U)).inv), - { resetI, - apply_instance }, + { apply_instance }, { let : R' ⋙ (monad.comparison (adjunction.of_right_adjoint U)).inv ≅ R := (iso_whisker_left R (monad.comparison _).as_equivalence.unit_iso.symm : _) ≪≫ R.right_unitor, diff --git a/src/category_theory/adjunction/limits.lean b/src/category_theory/adjunction/limits.lean index 686648ef0b180..1820e2cc84d66 100644 --- a/src/category_theory/adjunction/limits.lean +++ b/src/category_theory/adjunction/limits.lean @@ -9,6 +9,9 @@ import category_theory.limits.creates /-! # Adjunctions and limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A left adjoint preserves colimits (`category_theory.adjunction.left_adjoint_preserves_colimits`), and a right adjoint preserves limits (`category_theory.adjunction.right_adjoint_preserves_limits`). diff --git a/src/category_theory/adjunction/mates.lean b/src/category_theory/adjunction/mates.lean index 24b4c8c5fbf31..9e261a837a06e 100644 --- a/src/category_theory/adjunction/mates.lean +++ b/src/category_theory/adjunction/mates.lean @@ -9,6 +9,9 @@ import category_theory.conj /-! # Mate of natural transformations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file establishes the bijection between the 2-cells L₁ R₁ @@ -193,6 +196,21 @@ begin adj₂.counit_naturality, adj₂.left_triangle_components_assoc, assoc], end +lemma transfer_nat_trans_self_adjunction_id {L R : C ⥤ C} (adj : L ⊣ R) (f : 𝟭 C ⟶ L) (X : C) : + (transfer_nat_trans_self adj adjunction.id f).app X = f.app (R.obj X) ≫ adj.counit.app X := +begin + dsimp [transfer_nat_trans_self, transfer_nat_trans, adjunction.id], + simp only [comp_id, id_comp], +end + +lemma transfer_nat_trans_self_adjunction_id_symm {L R : C ⥤ C} (adj : L ⊣ R) (g : R ⟶ 𝟭 C) + (X : C) : ((transfer_nat_trans_self adj adjunction.id).symm g).app X = + adj.unit.app X ≫ (g.app (L.obj X)) := +begin + dsimp [transfer_nat_trans_self, transfer_nat_trans, adjunction.id], + simp only [comp_id, id_comp], +end + lemma transfer_nat_trans_self_symm_comp (f g) : (transfer_nat_trans_self adj₂ adj₁).symm f ≫ (transfer_nat_trans_self adj₃ adj₂).symm g = (transfer_nat_trans_self adj₃ adj₁).symm (g ≫ f) := diff --git a/src/category_theory/adjunction/opposites.lean b/src/category_theory/adjunction/opposites.lean index e5c6476be72a8..8a9e9573d4f95 100644 --- a/src/category_theory/adjunction/opposites.lean +++ b/src/category_theory/adjunction/opposites.lean @@ -11,6 +11,9 @@ import category_theory.opposites /-! # Opposite adjunctions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains constructions to relate adjunctions of functors to adjunctions of their opposites. These constructions are used to show uniqueness of adjoints (up to natural isomorphism). @@ -29,7 +32,8 @@ variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D namespace category_theory.adjunction /-- If `G.op` is adjoint to `F.op` then `F` is adjoint to `G`. -/ -@[simps] def adjoint_of_op_adjoint_op (F : C ⥤ D) (G : D ⥤ C) (h : G.op ⊣ F.op) : F ⊣ G := +@[simps unit_app counit_app] def adjoint_of_op_adjoint_op + (F : C ⥤ D) (G : D ⥤ C) (h : G.op ⊣ F.op) : F ⊣ G := adjunction.mk_of_hom_equiv { hom_equiv := λ X Y, ((h.hom_equiv (opposite.op Y) (opposite.op X)).trans (op_equiv _ _)).symm.trans (op_equiv _ _) } @@ -47,7 +51,8 @@ def unop_adjoint_unop_of_adjoint (F : Cᵒᵖ ⥤ Dᵒᵖ) (G : Dᵒᵖ ⥤ Cᵒ adjoint_unop_of_adjoint_op F.unop G (h.of_nat_iso_right F.op_unop_iso.symm) /-- If `G` is adjoint to `F` then `F.op` is adjoint to `G.op`. -/ -@[simps] def op_adjoint_op_of_adjoint (F : C ⥤ D) (G : D ⥤ C) (h : G ⊣ F) : F.op ⊣ G.op := +@[simps unit_app counit_app] def op_adjoint_op_of_adjoint + (F : C ⥤ D) (G : D ⥤ C) (h : G ⊣ F) : F.op ⊣ G.op := adjunction.mk_of_hom_equiv { hom_equiv := λ X Y, (op_equiv _ Y).trans ((h.hom_equiv _ _).symm.trans (op_equiv X (opposite.op _)).symm) } diff --git a/src/category_theory/adjunction/over.lean b/src/category_theory/adjunction/over.lean index 806490206f7c5..d709fed80a217 100644 --- a/src/category_theory/adjunction/over.lean +++ b/src/category_theory/adjunction/over.lean @@ -10,6 +10,9 @@ import category_theory.over /-! # Adjunctions related to the over category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Construct the left adjoint `star X` to `over.forget X : over X ⥤ C`. ## TODO @@ -27,7 +30,7 @@ variables {C : Type u} [category.{v} C] (X : C) /-- The functor from `C` to `over X` which sends `Y : C` to `π₁ : X ⨯ Y ⟶ X`, sometimes denoted `X*`. -/ -@[simps] +@[simps obj_left obj_hom map_left] def star [has_binary_products C] : C ⥤ over X := cofree _ ⋙ coalgebra_to_over X @@ -38,7 +41,7 @@ Note that the binary products assumption is necessary: the existence of a right `over.forget X` is equivalent to the existence of each binary product `X ⨯ -`. -/ def forget_adj_star [has_binary_products C] : over.forget X ⊣ star X := -(coalgebra_equiv_over X).symm.to_adjunction.comp _ _ (adj _) +(coalgebra_equiv_over X).symm.to_adjunction.comp (adj _) /-- Note that the binary products assumption is necessary: the existence of a right adjoint to diff --git a/src/category_theory/adjunction/reflective.lean b/src/category_theory/adjunction/reflective.lean index 67ce6368ea73d..732ccd7a39970 100644 --- a/src/category_theory/adjunction/reflective.lean +++ b/src/category_theory/adjunction/reflective.lean @@ -10,6 +10,9 @@ import category_theory.epi_mono /-! # Reflective functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Basic properties of reflective functors, especially those relating to their essential image. Note properties of reflective functors relating to limits and colimits are included in @@ -89,8 +92,8 @@ lemma mem_ess_image_of_unit_is_iso [is_right_adjoint i] (A : C) ⟨(left_adjoint i).obj A, ⟨(as_iso ((of_right_adjoint i).unit.app A)).symm⟩⟩ /-- If `η_A` is a split monomorphism, then `A` is in the reflective subcategory. -/ -lemma mem_ess_image_of_unit_split_mono [reflective i] {A : C} - [split_mono ((of_right_adjoint i).unit.app A)] : A ∈ i.ess_image := +lemma mem_ess_image_of_unit_is_split_mono [reflective i] {A : C} + [is_split_mono ((of_right_adjoint i).unit.app A)] : A ∈ i.ess_image := begin let η : 𝟭 C ⟶ left_adjoint i ⋙ i := (of_right_adjoint i).unit, haveI : is_iso (η.app (i.obj ((left_adjoint i).obj A))) := (i.obj_mem_ess_image _).unit_is_iso, @@ -99,7 +102,7 @@ begin rw (show retraction _ ≫ η.app A = _, from η.naturality (retraction (η.app A))), apply epi_comp (η.app (i.obj ((left_adjoint i).obj A))) }, resetI, - haveI := is_iso_of_epi_of_split_mono (η.app A), + haveI := is_iso_of_epi_of_is_split_mono (η.app A), exact mem_ess_image_of_unit_is_iso A, end @@ -156,17 +159,19 @@ by rw [←equiv.eq_symm_apply, unit_comp_partial_bijective_symm_natural A h, equ /-- If `i : D ⥤ C` is reflective, the inverse functor of `i ≌ F.ess_image` can be explicitly defined by the reflector. -/ @[simps] -def equiv_ess_image_of_reflective [reflective i] : D ≌ i.ess_image := +def equiv_ess_image_of_reflective [reflective i] : D ≌ i.ess_image_subcategory := { functor := i.to_ess_image, inverse := i.ess_image_inclusion ⋙ (left_adjoint i : _), unit_iso := nat_iso.of_components (λ X, (as_iso $ (of_right_adjoint i).counit.app X).symm) (by { intros X Y f, dsimp, simp only [is_iso.eq_inv_comp, is_iso.comp_inv_eq, category.assoc], exact ((of_right_adjoint i).counit.naturality _).symm }), - counit_iso := nat_iso.of_components - (λ X, by { refine (iso.symm $ as_iso _), exact (of_right_adjoint i).unit.app X, + counit_iso := + nat_iso.of_components + (λ X, by { refine (iso.symm $ as_iso _), exact (of_right_adjoint i).unit.app X.obj, apply_with (is_iso_of_reflects_iso _ i.ess_image_inclusion) { instances := ff }, - exact functor.ess_image.unit_is_iso X.prop }) - (by { intros X Y f, dsimp, simp only [is_iso.eq_inv_comp, is_iso.comp_inv_eq, category.assoc], - exact ((of_right_adjoint i).unit.naturality f).symm }) } + exact functor.ess_image.unit_is_iso X.property }) + (by { intros X Y f, dsimp, rw [is_iso.comp_inv_eq, assoc], + have h := ((of_right_adjoint i).unit.naturality f).symm, + rw [functor.id_map] at h, erw [← h, is_iso.inv_hom_id_assoc, functor.comp_map] }) } end category_theory diff --git a/src/category_theory/adjunction/whiskering.lean b/src/category_theory/adjunction/whiskering.lean index 16dc8b4da632e..5a82ed48a9f7d 100644 --- a/src/category_theory/adjunction/whiskering.lean +++ b/src/category_theory/adjunction/whiskering.lean @@ -3,10 +3,13 @@ Copyright (c) 2021 Adam Topaz. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Adam Topaz -/ -import category_theory.adjunction import category_theory.whiskering +import category_theory.adjunction.basic /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given categories `C D E`, functors `F : D ⥤ E` and `G : E ⥤ D` with an adjunction `F ⊣ G`, we provide the induced adjunction between the functor categories `C ⥤ D` and `C ⥤ E`, diff --git a/src/category_theory/arrow.lean b/src/category_theory/arrow.lean index 97c6eef12cdcc..3df992cb8a5d0 100644 --- a/src/category_theory/arrow.lean +++ b/src/category_theory/arrow.lean @@ -8,6 +8,9 @@ import category_theory.comma /-! # The category of arrows +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The category of arrows, with morphisms commutative squares. We set this up as a specialization of the comma category `comma L R`, where `L` and `R` are both the identity functor. @@ -51,6 +54,9 @@ def mk {X Y : T} (f : X ⟶ Y) : arrow T := right := Y, hom := f } +@[simp] lemma mk_eq (f : arrow T) : arrow.mk f.hom = f := +by { cases f, refl, } + theorem mk_injective (A B : T) : function.injective (arrow.mk : (A ⟶ B) → arrow T) := λ f g h, by { cases h, refl } @@ -97,6 +103,27 @@ and a proof that the square commutes. -/ f ≅ g := comma.iso_mk l r h +/-- A variant of `arrow.iso_mk` that creates an iso between two `arrow.mk`s with a better type +signature. -/ +abbreviation iso_mk' {W X Y Z : T} (f : W ⟶ X) (g : Y ⟶ Z) + (e₁ : W ≅ Y) (e₂ : X ≅ Z) (h : e₁.hom ≫ g = f ≫ e₂.hom) : arrow.mk f ≅ arrow.mk g := +arrow.iso_mk e₁ e₂ h + +lemma hom.congr_left {f g : arrow T} {φ₁ φ₂ : f ⟶ g} (h : φ₁ = φ₂) : + φ₁.left = φ₂.left := by rw h +lemma hom.congr_right {f g : arrow T} {φ₁ φ₂ : f ⟶ g} (h : φ₁ = φ₂) : + φ₁.right = φ₂.right := by rw h + +lemma iso_w {f g : arrow T} (e : f ≅ g) : g.hom = e.inv.left ≫ f.hom ≫ e.hom.right := +begin + have eq := arrow.hom.congr_right e.inv_hom_id, + dsimp at eq, + erw [w_assoc, eq, category.comp_id], +end + +lemma iso_w' {W X Y Z : T} {f : W ⟶ X} {g : Y ⟶ Z} (e : arrow.mk f ≅ arrow.mk g) : + g = e.inv.left ≫ f ≫ e.hom.right := iso_w e + section variables {f g : arrow T} (sq : f ⟶ g) @@ -159,74 +186,6 @@ lemma square_from_iso_invert {X Y : T} (i : X ≅ Y) (p : arrow T) (sq : arrow.m i.inv ≫ sq.left ≫ p.hom = sq.right := by simp only [iso.inv_hom_id_assoc, arrow.w, arrow.mk_hom] -/-- A lift of a commutative square is a diagonal morphism making the two triangles commute. -/ -@[ext] structure lift_struct {f g : arrow T} (sq : f ⟶ g) := -(lift : f.right ⟶ g.left) -(fac_left' : f.hom ≫ lift = sq.left . obviously) -(fac_right' : lift ≫ g.hom = sq.right . obviously) - -restate_axiom lift_struct.fac_left' -restate_axiom lift_struct.fac_right' - -instance lift_struct_inhabited {X : T} : inhabited (lift_struct (𝟙 (arrow.mk (𝟙 X)))) := -⟨⟨𝟙 _, category.id_comp _, category.comp_id _⟩⟩ - -/-- `has_lift sq` says that there is some `lift_struct sq`, i.e., that it is possible to find a - diagonal morphism making the two triangles commute. -/ -class has_lift {f g : arrow T} (sq : f ⟶ g) : Prop := -mk' :: (exists_lift : nonempty (lift_struct sq)) - -lemma has_lift.mk {f g : arrow T} {sq : f ⟶ g} (s : lift_struct sq) : has_lift sq := -⟨nonempty.intro s⟩ - -attribute [simp, reassoc] lift_struct.fac_left lift_struct.fac_right - -/-- Given `has_lift sq`, obtain a lift. -/ -noncomputable def has_lift.struct {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : lift_struct sq := -classical.choice has_lift.exists_lift - -/-- If there is a lift of a commutative square `sq`, we can access it by saying `lift sq`. -/ -noncomputable abbreviation lift {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : f.right ⟶ g.left := -(has_lift.struct sq).lift - -lemma lift.fac_left {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : f.hom ≫ lift sq = sq.left := -by simp - -lemma lift.fac_right {f g : arrow T} (sq : f ⟶ g) [has_lift sq] : lift sq ≫ g.hom = sq.right := -by simp - -@[simp, reassoc] -lemma lift.fac_right_of_to_mk {X Y : T} {f : arrow T} {g : X ⟶ Y} (sq : f ⟶ mk g) [has_lift sq] : - lift sq ≫ g = sq.right := -by simp only [←mk_hom g, lift.fac_right] - -@[simp, reassoc] -lemma lift.fac_left_of_from_mk {X Y : T} {f : X ⟶ Y} {g : arrow T} (sq : mk f ⟶ g) [has_lift sq] : - f ≫ lift sq = sq.left := -by simp only [←mk_hom f, lift.fac_left] - -@[simp, reassoc] -lemma lift_mk'_left {X Y P Q : T} {f : X ⟶ Y} {g : P ⟶ Q} {u : X ⟶ P} {v : Y ⟶ Q} - (h : u ≫ g = f ≫ v) [has_lift $ arrow.hom_mk' h] : f ≫ lift (arrow.hom_mk' h) = u := -by simp only [←arrow.mk_hom f, lift.fac_left, arrow.hom_mk'_left] - -@[simp, reassoc] -lemma lift_mk'_right {X Y P Q : T} {f : X ⟶ Y} {g : P ⟶ Q} {u : X ⟶ P} {v : Y ⟶ Q} - (h : u ≫ g = f ≫ v) [has_lift $ arrow.hom_mk' h] : lift (arrow.hom_mk' h) ≫ g = v := -by simp only [←arrow.mk_hom g, lift.fac_right, arrow.hom_mk'_right] - -section - -instance subsingleton_lift_struct_of_epi {f g : arrow T} (sq : f ⟶ g) [epi f.hom] : - subsingleton (lift_struct sq) := -subsingleton.intro $ λ a b, lift_struct.ext a b $ (cancel_epi f.hom).1 $ by simp - -instance subsingleton_lift_struct_of_mono {f g : arrow T} (sq : f ⟶ g) [mono g.hom] : - subsingleton (lift_struct sq) := -subsingleton.intro $ λ a b, lift_struct.ext a b $ (cancel_mono g.hom).1 $ by simp - -end - variables {C : Type u} [category.{v} C] /-- A helper construction: given a square between `i` and `f ≫ g`, produce a square between `i` and `g`, whose top leg uses `f`: @@ -275,4 +234,11 @@ def map_arrow (F : C ⥤ D) : arrow C ⥤ arrow D := end functor +/-- The images of `f : arrow C` by two isomorphic functors `F : C ⥤ D` are +isomorphic arrows in `D`. -/ +def arrow.iso_of_nat_iso {C D : Type*} [category C] [category D] + {F G : C ⥤ D} (e : F ≅ G) (f : arrow C) : + F.map_arrow.obj f ≅ G.map_arrow.obj f := +arrow.iso_mk (e.app f.left) (e.app f.right) (by simp) + end category_theory diff --git a/src/category_theory/balanced.lean b/src/category_theory/balanced.lean index c1277508f7cef..2053a3ef7ff26 100644 --- a/src/category_theory/balanced.lean +++ b/src/category_theory/balanced.lean @@ -8,6 +8,9 @@ import category_theory.epi_mono /-! # Balanced categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category is called balanced if any morphism that is both monic and epic is an isomorphism. Balanced categories arise frequently. For example, categories in which every monomorphism diff --git a/src/category_theory/bicategory/End.lean b/src/category_theory/bicategory/End.lean index f677e134b87f8..a5c38f929d6eb 100644 --- a/src/category_theory/bicategory/End.lean +++ b/src/category_theory/bicategory/End.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.category /-! # Endomorphisms of an object in a bicategory, as a monoidal category. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace category_theory diff --git a/src/category_theory/bicategory/basic.lean b/src/category_theory/bicategory/basic.lean index ae6620c0000f1..890c3299d03af 100644 --- a/src/category_theory/bicategory/basic.lean +++ b/src/category_theory/bicategory/basic.lean @@ -9,6 +9,9 @@ import tactic.slice /-! # Bicategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define typeclass for bicategories. A bicategory `B` consists of @@ -107,11 +110,16 @@ class bicategory (B : Type u) extends category_struct.{v} B := (α_ f (𝟙 b) g).hom ≫ f ◁ (λ_ g).hom = (ρ_ f).hom ▷ g . obviously) -- The precedence of the whiskerings is higher than that of the composition `≫`. -localized "infixr ` ◁ `:81 := bicategory.whisker_left" in bicategory -localized "infixl ` ▷ `:81 := bicategory.whisker_right" in bicategory -localized "notation `α_` := bicategory.associator" in bicategory -localized "notation `λ_` := bicategory.left_unitor" in bicategory -localized "notation `ρ_` := bicategory.right_unitor" in bicategory +localized "infixr (name := bicategory.whisker_left) ` ◁ `:81 := bicategory.whisker_left" + in bicategory +localized "infixl (name := bicategory.whisker_right) ` ▷ `:81 := bicategory.whisker_right" + in bicategory +localized "notation (name := bicategory.associator) `α_` := bicategory.associator" + in bicategory +localized "notation (name := bicategory.left_unitor) `λ_` := bicategory.left_unitor" + in bicategory +localized "notation (name := bicategory.right_unitor) `ρ_` := bicategory.right_unitor" + in bicategory namespace bicategory diff --git a/src/category_theory/bicategory/coherence.lean b/src/category_theory/bicategory/coherence.lean index c0b364e1e9122..9cf7ea46cddf7 100644 --- a/src/category_theory/bicategory/coherence.lean +++ b/src/category_theory/bicategory/coherence.lean @@ -10,6 +10,9 @@ import category_theory.bicategory.locally_discrete /-! # The coherence theorem for bicategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove the coherence theorem for bicategories, stated in the following form: the free bicategory over any quiver is locally thin. @@ -57,8 +60,7 @@ The discrete category on the paths includes into the category of 1-morphisms in bicategory. -/ def inclusion_path (a b : B) : discrete (path.{v+1} a b) ⥤ hom a b := -{ obj := inclusion_path_aux, - map := λ f g η, eq_to_hom (congr_arg inclusion_path_aux (discrete.eq_of_hom η)) } +discrete.functor inclusion_path_aux /-- The inclusion from the locally discrete bicategory on the path category into the free bicategory @@ -69,13 +71,22 @@ def preinclusion (B : Type u) [quiver.{v+1} B] : prelax_functor (locally_discrete (paths B)) (free_bicategory B) := { obj := id, map := λ a b, (inclusion_path a b).obj, - map₂ := λ a b, (inclusion_path a b).map } + map₂ := λ a b f g η, (inclusion_path a b).map η } @[simp] lemma preinclusion_obj (a : B) : (preinclusion B).obj a = a := rfl +@[simp] +lemma preinclusion_map₂ {a b : B} (f g : discrete (path.{v+1} a b)) (η : f ⟶ g) : + (preinclusion B).map₂ η = eq_to_hom (congr_arg _ (discrete.ext _ _ (discrete.eq_of_hom η))) := +begin + rcases η with ⟨⟨⟩⟩, + cases discrete.ext _ _ η, + exact (inclusion_path a b).map_id _ +end + /-- The normalization of the composition of `p : path a b` and `f : hom b c`. `p` will eventually be taken to be `nil` and we then get the normalization @@ -114,7 +125,7 @@ fully-normalized 1-morphism. -/ @[simp] def normalize_iso {a : B} : ∀ {b c : B} (p : path a b) (f : hom b c), - (preinclusion B).map p ≫ f ≅ (preinclusion B).map (normalize_aux p f) + (preinclusion B).map ⟨p⟩ ≫ f ≅ (preinclusion B).map ⟨normalize_aux p f⟩ | _ _ p (hom.of f) := iso.refl _ | _ _ p (hom.id b) := ρ_ _ | _ _ p (hom.comp f g) := (α_ _ _ _).symm ≪≫ @@ -140,8 +151,9 @@ end /-- The 2-isomorphism `normalize_iso p f` is natural in `f`. -/ lemma normalize_naturality {a b c : B} (p : path a b) {f g : hom b c} (η : f ⟶ g) : - (preinclusion B).map p ◁ η ≫ (normalize_iso p g).hom = - (normalize_iso p f).hom ≫ eq_to_hom (congr_arg _ (normalize_aux_congr p η)) := + (preinclusion B).map ⟨p⟩ ◁ η ≫ (normalize_iso p g).hom = + (normalize_iso p f).hom ≫ + (preinclusion B).map₂ (eq_to_hom (discrete.ext _ _ (normalize_aux_congr p η))) := begin rcases η, induction η, case id : { simp }, @@ -175,10 +187,10 @@ end def normalize (B : Type u) [quiver.{v+1} B] : pseudofunctor (free_bicategory B) (locally_discrete (paths B)) := { obj := id, - map := λ a b, normalize_aux nil, - map₂ := λ a b f g η, eq_to_hom (normalize_aux_congr nil η), - map_id := λ a, iso.refl nil, - map_comp := λ a b c f g, eq_to_iso (normalize_aux_nil_comp f g) } + map := λ a b f, ⟨normalize_aux nil f⟩, + map₂ := λ a b f g η, eq_to_hom $ discrete.ext _ _ $ normalize_aux_congr nil η, + map_id := λ a, eq_to_iso $ discrete.ext _ _ rfl, + map_comp := λ a b c f g, eq_to_iso $ discrete.ext _ _ $ normalize_aux_nil_comp f g } /-- Auxiliary definition for `normalize_equiv`. -/ def normalize_unit_iso (a b : free_bicategory B) : @@ -195,16 +207,16 @@ end def normalize_equiv (a b : B) : hom a b ≌ discrete (path.{v+1} a b) := equivalence.mk ((normalize _).map_functor a b) (inclusion_path a b) (normalize_unit_iso a b) - (discrete.nat_iso (λ f, eq_to_iso (by { induction f; tidy }))) + (discrete.nat_iso (λ f, eq_to_iso (by { induction f; induction f; tidy }))) /-- The coherence theorem for bicategories. -/ -instance locally_thin {a b : free_bicategory B} (f g : a ⟶ b) : subsingleton (f ⟶ g) := -⟨λ η θ, (normalize_equiv a b).functor.map_injective (subsingleton.elim _ _)⟩ +instance locally_thin {a b : free_bicategory B} : quiver.is_thin (a ⟶ b) := +λ _ _, ⟨λ η θ, (normalize_equiv a b).functor.map_injective (subsingleton.elim _ _)⟩ /-- Auxiliary definition for `inclusion`. -/ def inclusion_map_comp_aux {a b : B} : ∀ {c : B} (f : path a b) (g : path b c), - (preinclusion _).map (f ≫ g) ≅ (preinclusion _).map f ≫ (preinclusion _).map g -| _ f nil := (ρ_ ((preinclusion _).map f)).symm + (preinclusion _).map (⟨f⟩ ≫ ⟨g⟩) ≅ (preinclusion _).map ⟨f⟩ ≫ (preinclusion _).map ⟨g⟩ +| _ f nil := (ρ_ ((preinclusion _).map ⟨f⟩)).symm | _ f (cons g₁ g₂) := whisker_right_iso (inclusion_map_comp_aux f g₁) (hom.of g₂) ≪≫ α_ _ _ _ /-- @@ -214,7 +226,7 @@ free bicategory. def inclusion (B : Type u) [quiver.{v+1} B] : pseudofunctor (locally_discrete (paths B)) (free_bicategory B) := { map_id := λ a, iso.refl (𝟙 a), - map_comp := λ a b c f g, inclusion_map_comp_aux f g, + map_comp := λ a b c f g, inclusion_map_comp_aux f.as g.as, -- All the conditions for 2-morphisms are trivial thanks to the coherence theorem! .. preinclusion B } diff --git a/src/category_theory/bicategory/coherence_tactic.lean b/src/category_theory/bicategory/coherence_tactic.lean index 7b65cfecc8849..b71ac18eb4264 100644 --- a/src/category_theory/bicategory/coherence_tactic.lean +++ b/src/category_theory/bicategory/coherence_tactic.lean @@ -8,6 +8,9 @@ import category_theory.bicategory.coherence /-! # A `coherence` tactic for bicategories, and `⊗≫` (composition up to associators) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide a `coherence` tactic, which proves that any two 2-morphisms (with the same source and target) in a bicategory which are built out of associators and unitors @@ -161,8 +164,8 @@ def bicategorical_comp {f g h i : a ⟶ b} [lift_hom g] [lift_hom h] [bicategorical_coherence g h] (η : f ⟶ g) (θ : h ⟶ i) : f ⟶ i := η ≫ bicategorical_coherence.hom g h ≫ θ -localized "infixr ` ⊗≫ `:80 := category_theory.bicategory.bicategorical_comp" - in bicategory -- type as \ot \gg +localized "infixr (name := bicategorical_comp) ` ⊗≫ `:80 := + category_theory.bicategory.bicategorical_comp" in bicategory -- type as \ot \gg /-- Compose two isomorphisms in a bicategorical category, inserting unitors and associators between as necessary. -/ @@ -170,8 +173,8 @@ def bicategorical_iso_comp {f g h i : a ⟶ b} [lift_hom g] [lift_hom h] [bicategorical_coherence g h] (η : f ≅ g) (θ : h ≅ i) : f ≅ i := η ≪≫ as_iso (bicategorical_coherence.hom g h) ≪≫ θ -localized "infixr ` ≪⊗≫ `:80 := category_theory.bicategory.bicategorical_iso_comp" - in bicategory -- type as \ot \gg +localized "infixr (name := bicategorical_iso_comp) ` ≪⊗≫ `:80 := + category_theory.bicategory.bicategorical_iso_comp" in bicategory -- type as \ot \gg example {f' : a ⟶ d} {f : a ⟶ b} {g : b ⟶ c} {h : c ⟶ d} {h' : a ⟶ d} (η : f' ⟶ f ≫ (g ≫ h)) (θ : (f ≫ g) ≫ h ⟶ h') : f' ⟶ h' := η ⊗≫ θ diff --git a/src/category_theory/bicategory/free.lean b/src/category_theory/bicategory/free.lean index 6b78babfdbf1c..a47147dbff248 100644 --- a/src/category_theory/bicategory/free.lean +++ b/src/category_theory/bicategory/free.lean @@ -8,6 +8,9 @@ import category_theory.bicategory.functor /-! # Free bicategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the free bicategory over a quiver. In this bicategory, the 1-morphisms are freely generated by the arrows in the quiver, and the 2-morphisms are freely generated by the formal identities, the formal unitors, and the formal associators modulo the relation derived from the @@ -45,7 +48,7 @@ inductive hom : B → B → Type (max u v) instance (a b : B) [inhabited (a ⟶ b)] : inhabited (hom a b) := ⟨hom.of default⟩ /-- Representatives of 2-morphisms in the free bicategory. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] inductive hom₂ : Π {a b : B}, hom a b → hom a b → Type (max u v) | id {a b} (f : hom a b) : hom₂ f f | vcomp {a b} {f g h : hom a b} (η : hom₂ f g) (θ : hom₂ g h) : hom₂ f h @@ -65,16 +68,16 @@ section variables {B} -- The following notations are only used in the definition of `rel` to simplify the notation. -local infixr ` ≫ ` := hom₂.vcomp -local notation `𝟙` := hom₂.id -local notation f ` ◁ ` η := hom₂.whisker_left f η -local notation η ` ▷ ` h := hom₂.whisker_right h η -local notation `α_` := hom₂.associator -local notation `λ_` := hom₂.left_unitor -local notation `ρ_` := hom₂.right_unitor -local notation `α⁻¹_` := hom₂.associator_inv -local notation `λ⁻¹_` := hom₂.left_unitor_inv -local notation `ρ⁻¹_` := hom₂.right_unitor_inv +local infixr (name := vcomp) ` ≫ ` := hom₂.vcomp +local notation (name := id) `𝟙` := hom₂.id +local notation (name := whisker_left) f ` ◁ ` η := hom₂.whisker_left f η +local notation (name := whisker_right) η ` ▷ ` h := hom₂.whisker_right h η +local notation (name := associator) `α_` := hom₂.associator +local notation (name := left_unitor) `λ_` := hom₂.left_unitor +local notation (name := right_unitor) `ρ_` := hom₂.right_unitor +local notation (name := associator_inv) `α⁻¹_` := hom₂.associator_inv +local notation (name := left_unitor_inv) `λ⁻¹_` := hom₂.left_unitor_inv +local notation (name := right_unitor_inv) `ρ⁻¹_` := hom₂.right_unitor_inv /-- Relations between 2-morphisms in the free bicategory. -/ inductive rel : Π {a b : B} {f g : hom a b}, hom₂ f g → hom₂ f g → Prop diff --git a/src/category_theory/bicategory/functor.lean b/src/category_theory/bicategory/functor.lean index e2697618d3fec..753c00ca9eb49 100644 --- a/src/category_theory/bicategory/functor.lean +++ b/src/category_theory/bicategory/functor.lean @@ -8,6 +8,9 @@ import category_theory.bicategory.basic /-! # Oplax functors and pseudofunctors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An oplax functor `F` between bicategories `B` and `C` consists of * a function between objects `F.obj : B ⟶ C`, * a family of functions between 1-morphisms `F.map : (a ⟶ b) → (F.obj a ⟶ F.obj b)`, @@ -90,7 +93,7 @@ variables (F : prelax_functor B C) @[simp] lemma to_prefunctor_eq_coe : F.to_prefunctor = F := rfl @[simp] lemma to_prefunctor_obj : (F : prefunctor B C).obj = F.obj := rfl -@[simp] lemma to_prefunctor_map : (F : prefunctor B C).map = F.map := rfl +@[simp] lemma to_prefunctor_map : @prefunctor.map B _ C _ F = @map _ _ _ _ _ _ F := rfl /-- The identity prelax functor. -/ @[simps] @@ -153,7 +156,7 @@ structure oplax_functor (B : Type u₁) [bicategory.{w₁ v₁} B] (C : Type u (map₂_comp' : ∀ {a b : B} {f g h : a ⟶ b} (η : f ⟶ g) (θ : g ⟶ h), map₂ (η ≫ θ) = map₂ η ≫ map₂ θ . obviously) (map₂_associator' : ∀ {a b c d : B} (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d), - oplax_functor.map₂_associator_aux obj (λ a b, map) (λ a b f g, map₂) (λ a b c, map_comp) f g h + oplax_functor.map₂_associator_aux obj (λ _ _, map) (λ a b f g, map₂) (λ a b c, map_comp) f g h . obviously) (map₂_left_unitor' : ∀ {a b : B} (f : a ⟶ b), map₂ (λ_ f).hom = map_comp (𝟙 a) f ≫ map_id a ▷ map f ≫ (λ_ (map f)).hom . obviously) @@ -187,8 +190,8 @@ variables (F : oplax_functor B C) @[simp] lemma to_prelax_eq_coe : F.to_prelax_functor = F := rfl @[simp] lemma to_prelax_functor_obj : (F : prelax_functor B C).obj = F.obj := rfl -@[simp] lemma to_prelax_functor_map : (F : prelax_functor B C).map = F.map := rfl -@[simp] lemma to_prelax_functor_map₂ : (F : prelax_functor B C).map₂ = F.map₂ := rfl +@[simp] lemma to_prelax_functor_map : @prelax_functor.map B _ _ C _ _ F = @map _ _ _ _ F := rfl +@[simp] lemma to_prelax_functor_map₂ : @prelax_functor.map₂ B _ _ C _ _ F = @map₂ _ _ _ _ F := rfl /-- Function between 1-morphisms as a functor. -/ @[simps] @@ -240,7 +243,7 @@ def comp (F : oplax_functor B C) (G : oplax_functor C D) : oplax_functor B D := A structure on an oplax functor that promotes an oplax functor to a pseudofunctor. See `pseudofunctor.mk_of_oplax`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure pseudo_core (F : oplax_functor B C) := (map_id_iso (a : B) : F.map (𝟙 a) ≅ 𝟙 (F.obj a)) (map_comp_iso {a b c : B} (f : a ⟶ b) (g : b ⟶ c) : F.map (f ≫ g) ≅ F.map f ≫ F.map g) @@ -334,8 +337,8 @@ variables (F : pseudofunctor B C) @[simp] lemma to_prelax_functor_eq_coe : F.to_prelax_functor = F := rfl @[simp] lemma to_prelax_functor_obj : (F : prelax_functor B C).obj = F.obj := rfl -@[simp] lemma to_prelax_functor_map : (F : prelax_functor B C).map = F.map := rfl -@[simp] lemma to_prelax_functor_map₂ : (F : prelax_functor B C).map₂ = F.map₂ := rfl +@[simp] lemma to_prelax_functor_map : @prelax_functor.map B _ _ C _ _ F = @map _ _ _ _ F := rfl +@[simp] lemma to_prelax_functor_map₂ : @prelax_functor.map₂ B _ _ C _ _ F = @map₂ _ _ _ _ F := rfl /-- The oplax functor associated with a pseudofunctor. -/ def to_oplax : oplax_functor B C := @@ -347,8 +350,8 @@ instance has_coe_to_oplax : has_coe (pseudofunctor B C) (oplax_functor B C) := @[simp] lemma to_oplax_eq_coe : F.to_oplax = F := rfl @[simp] lemma to_oplax_obj : (F : oplax_functor B C).obj = F.obj := rfl -@[simp] lemma to_oplax_map : (F : oplax_functor B C).map = F.map := rfl -@[simp] lemma to_oplax_map₂ : (F : oplax_functor B C).map₂ = F.map₂ := rfl +@[simp] lemma to_oplax_map : @oplax_functor.map B _ C _ F = @map _ _ _ _ F := rfl +@[simp] lemma to_oplax_map₂ : @oplax_functor.map₂ B _ C _ F = @map₂ _ _ _ _ F := rfl @[simp] lemma to_oplax_map_id (a : B) : (F : oplax_functor B C).map_id a = (F.map_id a).hom := rfl @[simp] lemma to_oplax_map_comp {a b c : B} (f : a ⟶ b) (g : b ⟶ c) : (F : oplax_functor B C).map_comp f g = (F.map_comp f g).hom := rfl @@ -381,7 +384,7 @@ Construct a pseudofunctor from an oplax functor whose `map_id` and `map_comp` ar @[simps] def mk_of_oplax (F : oplax_functor B C) (F' : F.pseudo_core) : pseudofunctor B C := { map_id := F'.map_id_iso, - map_comp := F'.map_comp_iso, + map_comp := λ _ _ _, F'.map_comp_iso, map₂_whisker_left' := λ a b c f g h η, by { dsimp, rw [F'.map_comp_iso_hom f g, ←F.map_comp_naturality_right_assoc, diff --git a/src/category_theory/bicategory/functor_bicategory.lean b/src/category_theory/bicategory/functor_bicategory.lean index 0d1cd9f0e4618..a626b310d3ced 100644 --- a/src/category_theory/bicategory/functor_bicategory.lean +++ b/src/category_theory/bicategory/functor_bicategory.lean @@ -8,6 +8,9 @@ import category_theory.bicategory.natural_transformation /-! # The bicategory of oplax functors between two bicategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given bicategories `B` and `C`, we give a bicategory structure on `oplax_functor B C` whose * objects are oplax functors, * 1-morphisms are oplax natural transformations, and diff --git a/src/category_theory/bicategory/locally_discrete.lean b/src/category_theory/bicategory/locally_discrete.lean index f9c0b443bb47e..e7900aab3159b 100644 --- a/src/category_theory/bicategory/locally_discrete.lean +++ b/src/category_theory/bicategory/locally_discrete.lean @@ -10,6 +10,9 @@ import category_theory.bicategory.strict /-! # Locally discrete bicategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category `C` can be promoted to a strict bicategory `locally_discrete C`. The objects and the 1-morphisms in `locally_discrete C` are the same as the objects and the morphisms, respectively, in `C`, and the 2-morphisms in `locally_discrete C` are the equalities between 1-morphisms. In @@ -24,19 +27,22 @@ open_locale bicategory universes w₂ v v₁ v₂ u u₁ u₂ -variables (C : Type u) +variables {C : Type u} /-- -A type alias for promoting any category to a bicategory, -with the only 2-morphisms being equalities. +A type synonym for promoting any type to a category, +with the only morphisms being equalities. -/ -def locally_discrete := C +def locally_discrete (C : Type u) := C namespace locally_discrete instance : Π [inhabited C], inhabited (locally_discrete C) := id -instance : Π [category_struct.{v} C], category_struct (locally_discrete C) := id +instance [category_struct.{v} C] : category_struct (locally_discrete C) := +{ hom := λ (X Y : C), discrete (X ⟶ Y), + id := λ X : C, ⟨𝟙 X⟩, + comp := λ X Y Z f g, ⟨f.as ≫ g.as⟩ } variables {C} [category_struct.{v} C] @@ -44,6 +50,13 @@ variables {C} [category_struct.{v} C] instance hom_small_category (X Y : locally_discrete C) : small_category (X ⟶ Y) := category_theory.discrete_category (X ⟶ Y) +/-- Extract the equation from a 2-morphism in a locally discrete 2-category. -/ +lemma eq_of_hom {X Y : locally_discrete C} {f g : X ⟶ Y} (η : f ⟶ g) : f = g := +begin + have : discrete.mk (f.as) = discrete.mk (g.as) := congr_arg discrete.mk (eq_of_hom η), + simpa using this +end + end locally_discrete variables (C) [category.{v} C] @@ -54,14 +67,17 @@ The locally discrete bicategory on a category is a bicategory in which the objec equalities between 1-morphisms. -/ instance locally_discrete_bicategory : bicategory (locally_discrete C) := -{ whisker_left := λ X Y Z f g h η, eq_to_hom (congr_arg2 (≫) rfl (eq_of_hom η)), - whisker_right := λ X Y Z f g η h, eq_to_hom (congr_arg2 (≫) (eq_of_hom η) rfl), - associator := λ W X Y Z f g h, eq_to_iso (category.assoc f g h), - left_unitor := λ X Y f, eq_to_iso (category.id_comp f), - right_unitor := λ X Y f, eq_to_iso (category.comp_id f) } +{ whisker_left := λ X Y Z f g h η, eq_to_hom (congr_arg2 (≫) rfl (locally_discrete.eq_of_hom η)), + whisker_right := λ X Y Z f g η h, eq_to_hom (congr_arg2 (≫) (locally_discrete.eq_of_hom η) rfl), + associator := λ W X Y Z f g h, eq_to_iso $ by { unfold_projs, simp only [category.assoc] }, + left_unitor := λ X Y f, eq_to_iso $ by { unfold_projs, simp only [category.id_comp, mk_as] }, + right_unitor := λ X Y f, eq_to_iso $ by { unfold_projs, simp only [category.comp_id, mk_as] } } /-- A locally discrete bicategory is strict. -/ -instance locally_discrete_bicategory.strict : strict (locally_discrete C) := { } +instance locally_discrete_bicategory.strict : strict (locally_discrete C) := +{ id_comp' := by { intros, ext1, unfold_projs, apply category.id_comp }, + comp_id' := by { intros, ext1, unfold_projs, apply category.comp_id }, + assoc' := by { intros, ext1, unfold_projs, apply category.assoc } } variables {I : Type u₁} [category.{v₁} I] {B : Type u₂} [bicategory.{w₂ v₂} B] [strict B] @@ -71,9 +87,10 @@ be promoted to an oplax functor from `locally_discrete I` to `B`. -/ @[simps] def functor.to_oplax_functor (F : I ⥤ B) : oplax_functor (locally_discrete I) B := -{ map₂ := λ i j f g η, eq_to_hom (congr_arg _ (eq_of_hom η)), +{ obj := F.obj, + map := λ X Y f, F.map f.as, + map₂ := λ i j f g η, eq_to_hom (congr_arg _ (eq_of_hom η)), map_id := λ i, eq_to_hom (F.map_id i), - map_comp := λ i j k f g, eq_to_hom (F.map_comp f g), - .. F } + map_comp := λ i j k f g, eq_to_hom (F.map_comp f.as g.as) } end category_theory diff --git a/src/category_theory/bicategory/natural_transformation.lean b/src/category_theory/bicategory/natural_transformation.lean index 08f8db6d452fe..79d7e6720944e 100644 --- a/src/category_theory/bicategory/natural_transformation.lean +++ b/src/category_theory/bicategory/natural_transformation.lean @@ -8,6 +8,9 @@ import category_theory.bicategory.functor /-! # Oplax natural transformations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Just as there are natural transformations between functors, there are oplax natural transformations between oplax functors. The equality in the naturality of natural transformations is replaced by a specified 2-morphism `F.map f ≫ app b ⟶ app a ≫ G.map f` in the case of oplax natural diff --git a/src/category_theory/bicategory/single_obj.lean b/src/category_theory/bicategory/single_obj.lean index 47022b6ab0912..8612984699bfb 100644 --- a/src/category_theory/bicategory/single_obj.lean +++ b/src/category_theory/bicategory/single_obj.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import category_theory.bicategory.End -import category_theory.monoidal.functorial +import category_theory.monoidal.functor /-! # Promoting a monoidal category to a single object bicategory. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A monoidal category can be thought of as a bicategory with a single object. The objects of the monoidal category become the 1-morphisms, diff --git a/src/category_theory/bicategory/strict.lean b/src/category_theory/bicategory/strict.lean index 7cd3b4d8c3f89..692dd0374e06c 100644 --- a/src/category_theory/bicategory/strict.lean +++ b/src/category_theory/bicategory/strict.lean @@ -9,6 +9,9 @@ import category_theory.bicategory.basic /-! # Strict bicategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A bicategory is called `strict` if the left unitors, the right unitors, and the associators are isomorphisms given by equalities. diff --git a/src/category_theory/category/Bipointed.lean b/src/category_theory/category/Bipointed.lean index 8b71cc51310e6..12a348f069d99 100644 --- a/src/category_theory/category/Bipointed.lean +++ b/src/category_theory/category/Bipointed.lean @@ -8,6 +8,9 @@ import category_theory.category.Pointed /-! # The category of bipointed types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines `Bipointed`, the category of bipointed types. ## TODO @@ -36,7 +39,7 @@ def of {X : Type*} (to_prod : X × X) : Bipointed := ⟨X, to_prod⟩ @[simp] lemma coe_of {X : Type*} (to_prod : X × X) : ↥(of to_prod) = X := rfl -alias of ← prod.Bipointed +alias of ← _root_.prod.Bipointed instance : inhabited Bipointed := ⟨of ((), ())⟩ diff --git a/src/category_theory/category/Cat.lean b/src/category_theory/category/Cat.lean index 0264f8b2aae6b..b8ff7a982d526 100644 --- a/src/category_theory/category/Cat.lean +++ b/src/category_theory/category/Cat.lean @@ -11,6 +11,9 @@ import category_theory.bicategory.strict /-! # Category of categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of the category `Cat` of all categories. In this category objects are categories and morphisms are functors between these categories. @@ -83,6 +86,9 @@ def objects : Cat.{v u} ⥤ Type u := { obj := λ C, C, map := λ C D F, F.obj } +section +local attribute [simp] eq_to_hom_map + /-- Any isomorphism in `Cat` induces an equivalence of the underlying categories. -/ def equiv_of_iso {C D : Cat} (γ : C ≅ D) : C ≌ D := { functor := γ.hom, @@ -90,6 +96,8 @@ def equiv_of_iso {C D : Cat} (γ : C ≅ D) : C ≌ D := unit_iso := eq_to_iso $ eq.symm γ.hom_inv_id, counit_iso := eq_to_iso γ.inv_hom_id } +end + end Cat /-- @@ -100,19 +108,21 @@ This ought to be modelled as a 2-functor! @[simps] def Type_to_Cat : Type u ⥤ Cat := { obj := λ X, Cat.of (discrete X), - map := λ X Y f, discrete.functor f, + map := λ X Y f, discrete.functor (discrete.mk ∘ f), map_id' := λ X, begin apply functor.ext, tidy, end, map_comp' := λ X Y Z f g, begin apply functor.ext, tidy, end } -instance : faithful Type_to_Cat.{u} := {} +instance : faithful Type_to_Cat.{u} := +{ map_injective' := λ X Y f g h, funext (λ x, congr_arg discrete.as (functor.congr_obj h ⟨x⟩)), } + instance : full Type_to_Cat.{u} := -{ preimage := λ X Y F, F.obj, +{ preimage := λ X Y F, discrete.as ∘ F.obj ∘ discrete.mk, witness' := begin intros X Y F, apply functor.ext, { intros x y f, dsimp, ext, }, - { intros x, refl, } + { rintros ⟨x⟩, ext, refl, } end } end category_theory diff --git a/src/category_theory/category/Cat/limit.lean b/src/category_theory/category/Cat/limit.lean index 7603536ec5cd6..d5ece82aebf5c 100644 --- a/src/category_theory/category/Cat/limit.lean +++ b/src/category_theory/category/Cat/limit.lean @@ -10,6 +10,9 @@ import category_theory.limits.preserves.basic /-! # The category of small categories has all small limits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An object in the limit consists of a family of objects, which are carried to one another by the functors in the diagram. A morphism between two such objects is a family of morphisms between the corresponding objects, @@ -54,21 +57,23 @@ def hom_diagram {F : J ⥤ Cat.{v v}} (X Y : limit (F ⋙ Cat.objects.{v v})) : end, map_comp' := λ X Y Z f g, begin ext h, dsimp, - simp [functor.congr_hom (F.map_comp f g) h], + simp [functor.congr_hom (F.map_comp f g) h, eq_to_hom_map], refl, end, } @[simps] instance (F : J ⥤ Cat.{v v}) : category (limit (F ⋙ Cat.objects)) := { hom := λ X Y, limit (hom_diagram X Y), - id := λ X, types.limit.mk (hom_diagram X X) (λ j, 𝟙 _) (λ j j' f, by simp), - comp := λ X Y Z f g, types.limit.mk (hom_diagram X Z) + id := λ X, types.limit.mk.{v v} (hom_diagram X X) (λ j, 𝟙 _) (λ j j' f, by simp), + comp := λ X Y Z f g, types.limit.mk.{v v} (hom_diagram X Z) (λ j, limit.π (hom_diagram X Y) j f ≫ limit.π (hom_diagram Y Z) j g) (λ j j' h, begin rw [←congr_fun (limit.w (hom_diagram X Y) h) f, ←congr_fun (limit.w (hom_diagram Y Z) h) g], dsimp, simp, - end), } + end), + id_comp' := λ _ _ _, by { ext, simp only [category.id_comp, types.limit.π_mk'] }, + comp_id' := λ _ _ _, by { ext, simp only [types.limit.π_mk', category.comp_id] } } /-- Auxiliary definition: the limit category. -/ @[simps] @@ -97,7 +102,7 @@ def limit_cone_lift (F : J ⥤ Cat.{v v}) (s : cone F) : s.X ⟶ limit_cone_X F naturality' := λ j j' f, (congr_arg functor.obj (s.π.naturality f) : _), } }, map := λ X Y f, begin - fapply types.limit.mk, + fapply types.limit.mk.{v v}, { intro j, refine eq_to_hom _ ≫ (s.π.app j).map f ≫ eq_to_hom _; simp, }, @@ -110,7 +115,9 @@ def limit_cone_lift (F : J ⥤ Cat.{v v}) (s : cone F) : s.X ⟶ limit_cone_X F conv at this { congr, skip, dsimp, simp, }, erw [functor.congr_hom this f], dsimp, simp, }, - end, } + end, + map_id' := λ X, by simp, + map_comp' := λ X Y Z f g, by simp } @[simp] lemma limit_π_hom_diagram_eq_to_hom {F : J ⥤ Cat.{v v}} @@ -129,7 +136,7 @@ def limit_cone_is_limit (F : J ⥤ Cat.{v v}) : is_limit (limit_cone F) := fapply category_theory.functor.ext, { intro X, ext, - dsimp, simp only [types.limit.lift_π_apply, ←w j], + dsimp, simp only [types.limit.lift_π_apply', ←w j], refl, }, { intros X Y f, dsimp, simp [(λ j, functor.congr_hom (w j).symm f)], diff --git a/src/category_theory/category/Groupoid.lean b/src/category_theory/category/Groupoid.lean index 5c4794374cef9..cac379bf9cb22 100644 --- a/src/category_theory/category/Groupoid.lean +++ b/src/category_theory/category/Groupoid.lean @@ -11,6 +11,9 @@ import category_theory.limits.is_limit /-! # Category of groupoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of the category `Groupoid` of all groupoids. In this category objects are groupoids and morphisms are functors between these groupoids. @@ -79,36 +82,33 @@ lemma id_to_functor {C : Groupoid.{v u}} : 𝟭 C = 𝟙 C := rfl section products -/-- The cone for the product of a family of groupoids indexed by J is a limit cone -/ -@[simps] -def pi_limit_cone {J : Type u} (F : discrete J ⥤ Groupoid.{u u}) : - limits.limit_cone F := -{ cone := - { X := @of (Π j : J, F.obj j) _, - π := { app := λ j : J, category_theory.pi.eval _ j, } }, - is_limit := - { lift := λ s, functor.pi' s.π.app, - fac' := by { intros, simp [hom_to_functor], }, - uniq' := - begin - intros s m w, - apply functor.pi_ext, - intro j, specialize w j, - simpa, - end } } - -/-- `pi_limit_cone` reinterpreted as a fan -/ -abbreviation pi_limit_fan {J : Type u} (F : J → Groupoid.{u u}) : limits.fan F := -(pi_limit_cone (discrete.functor F)).cone +local attribute [tidy] tactic.discrete_cases + +/-- Construct the product over an indexed family of groupoids, as a fan. -/ +def pi_limit_fan ⦃J : Type u⦄ (F : J → Groupoid.{u u}) : limits.fan F := +limits.fan.mk (@of (Π j : J, F j) _) (λ j, category_theory.pi.eval _ j) + +/-- The product fan over an indexed family of groupoids, is a limit cone. -/ +def pi_limit_fan_is_limit ⦃J : Type u⦄ (F : J → Groupoid.{u u}) : + limits.is_limit (pi_limit_fan F) := +limits.mk_fan_limit (pi_limit_fan F) +(λ s, functor.pi' (λ j, s.proj j)) +(by { intros, dunfold pi_limit_fan, simp [hom_to_functor], }) +begin + intros s m w, + apply functor.pi_ext, + intro j, specialize w j, + simpa, +end instance has_pi : limits.has_products Groupoid.{u u} := -λ J, { has_limit := λ F, { exists_limit := nonempty.intro (pi_limit_cone F) } } +limits.has_products_of_limit_fans pi_limit_fan pi_limit_fan_is_limit /-- The product of a family of groupoids is isomorphic to the product object in the category of Groupoids -/ noncomputable def pi_iso_pi (J : Type u) (f : J → Groupoid.{u u}) : @of (Π j, f j) _ ≅ ∏ f := limits.is_limit.cone_point_unique_up_to_iso - (pi_limit_cone (discrete.functor f)).is_limit + (pi_limit_fan_is_limit f) (limits.limit.is_limit (discrete.functor f)) @[simp] diff --git a/src/category_theory/category/Kleisli.lean b/src/category_theory/category/Kleisli.lean index 2dd2d7d5c431a..2c5d47ad9e81c 100644 --- a/src/category_theory/category/Kleisli.lean +++ b/src/category_theory/category/Kleisli.lean @@ -8,6 +8,9 @@ import category_theory.category.basic /-! # The Kleisli construction on the Type category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define the Kleisli category for (control) monads. `category_theory/monad/kleisli` defines the general version for a monad on `C`, and demonstrates the equivalence between the two. diff --git a/src/category_theory/category/PartialFun.lean b/src/category_theory/category/PartialFun.lean index d10da5c189802..46ffcb1b33c11 100644 --- a/src/category_theory/category/PartialFun.lean +++ b/src/category_theory/category/PartialFun.lean @@ -9,6 +9,9 @@ import data.pfun /-! # The category of types with partial functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines `PartialFun`, the category of types equipped with partial functions. This category is classically equivalent to the category of pointed types. The reason it doesn't hold @@ -39,7 +42,7 @@ namespace PartialFun instance : has_coe_to_sort PartialFun Type* := ⟨id⟩ /-- Turns a type into a `PartialFun`. -/ -@[nolint has_inhabited_instance] def of : Type* → PartialFun := id +@[nolint has_nonempty_instance] def of : Type* → PartialFun := id @[simp] lemma coe_of (X : Type*) : ↥(of X) = X := rfl @@ -72,7 +75,7 @@ instance : faithful Type_to_PartialFun := ⟨λ X Y, pfun.coe_injective⟩ /-- The functor which deletes the point of a pointed type. In return, this makes the maps partial. This the computable part of the equivalence `PartialFun_equiv_Pointed`. -/ -def Pointed_to_PartialFun : Pointed.{u} ⥤ PartialFun := +@[simps map] def Pointed_to_PartialFun : Pointed.{u} ⥤ PartialFun := { obj := λ X, {x : X // x ≠ X.point}, map := λ X Y f, pfun.to_subtype _ f.to_fun ∘ subtype.val, map_id' := λ X, pfun.ext $ λ a b, @@ -89,10 +92,10 @@ def Pointed_to_PartialFun : Pointed.{u} ⥤ PartialFun := /-- The functor which maps undefined values to a new point. This makes the maps total and creates pointed types. This the noncomputable part of the equivalence `PartialFun_equiv_Pointed`. It can't be computable because `= option.none` is decidable while the domain of a general `part` isn't. -/ -noncomputable def PartialFun_to_Pointed : PartialFun ⥤ Pointed := +@[simps map] noncomputable def PartialFun_to_Pointed : PartialFun ⥤ Pointed := by classical; exact { obj := λ X, ⟨option X, none⟩, - map := λ X Y f, ⟨λ o, o.elim none (λ a, (f a).to_option), rfl⟩, + map := λ X Y f, ⟨option.elim none (λ a, (f a).to_option), rfl⟩, map_id' := λ X, Pointed.hom.ext _ _ $ funext $ λ o, option.rec_on o rfl $ λ a, part.some_to_option _, map_comp' := λ X Y Z f g, Pointed.hom.ext _ _ $ funext $ λ o, option.rec_on o rfl $ λ a, @@ -118,23 +121,24 @@ equivalence.mk PartialFun_to_Pointed Pointed_to_PartialFun dsimp, simp_rw [part.mem_some_iff, subtype.mk_eq_mk, exists_prop, some_inj, exists_eq_right'], refine part.mem_to_option.symm.trans _, - convert eq_comm, - convert rfl, + exact eq_comm, end) (nat_iso.of_components (λ X, Pointed.iso.mk - { to_fun := λ a, a.elim X.point subtype.val, + { to_fun := option.elim X.point subtype.val, inv_fun := λ a, if h : a = X.point then none else some ⟨_, h⟩, left_inv := λ a, option.rec_on a (dif_pos rfl) $ λ a, (dif_neg a.2).trans $ by simp only [option.elim, subtype.val_eq_coe, subtype.coe_eta], right_inv := λ a, begin - change option.elim (dite _ _ _) _ _ = _, + change option.elim _ _ (dite _ _ _) = _, split_ifs, { rw h, refl }, { refl } end } rfl) $ λ X Y f, Pointed.hom.ext _ _ $ funext $ λ a, option.rec_on a f.map_point.symm $ λ a, begin - change option.elim (option.elim _ _ _) _ _ = _, - rw [option.elim, part.elim_to_option], + unfold_projs, + dsimp, + change option.elim _ _ _ = _, + rw part.elim_to_option, split_ifs, { refl }, { exact eq.symm (of_not_not h) } diff --git a/src/category_theory/category/Pointed.lean b/src/category_theory/category/Pointed.lean index c32de1ba3c657..6d90709014f79 100644 --- a/src/category_theory/category/Pointed.lean +++ b/src/category_theory/category/Pointed.lean @@ -8,6 +8,9 @@ import category_theory.concrete_category.basic /-! # The category of pointed types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines `Pointed`, the category of pointed types. ## TODO @@ -37,7 +40,7 @@ def of {X : Type*} (point : X) : Pointed := ⟨X, point⟩ @[simp] lemma coe_of {X : Type*} (point : X) : ↥(of point) = X := rfl -alias of ← prod.Pointed +alias of ← _root_.prod.Pointed instance : inhabited Pointed := ⟨of ((), ())⟩ diff --git a/src/category_theory/category/Quiv.lean b/src/category_theory/category/Quiv.lean index 423cb7d97b5a0..b01b516fd8fcc 100644 --- a/src/category_theory/category/Quiv.lean +++ b/src/category_theory/category/Quiv.lean @@ -10,6 +10,9 @@ import category_theory.path_category /-! # The category of quivers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The category of (bundled) quivers, and the free/forgetful adjunction between `Cat` and `Quiv`. -/ @@ -71,7 +74,7 @@ namespace Quiv /-- Any prefunctor into a category lifts to a functor from the path category. -/ @[simps] -def lift {V : Type u} [quiver.{v+1} V] {C : Type u} [category.{v} C] +def lift {V : Type u} [quiver.{v+1} V] {C : Type*} [category C] (F : prefunctor V C) : paths V ⥤ C := { obj := λ X, F.obj X, map := λ X Y f, compose_path (F.map_path f), } diff --git a/src/category_theory/category/Rel.lean b/src/category_theory/category/Rel.lean index 727ea2a9a1147..bc75375e4b5d1 100644 --- a/src/category_theory/category/Rel.lean +++ b/src/category_theory/category/Rel.lean @@ -6,6 +6,9 @@ Authors: Scott Morrison import category_theory.category.basic /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The category of types with binary relations as morphisms. -/ diff --git a/src/category_theory/category/Twop.lean b/src/category_theory/category/Twop.lean index 249180e4dfe7e..e5563cc371214 100644 --- a/src/category_theory/category/Twop.lean +++ b/src/category_theory/category/Twop.lean @@ -9,6 +9,9 @@ import data.two_pointing /-! # The category of two-pointed types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines `Twop`, the category of two-pointed types. ## References @@ -39,7 +42,7 @@ def of {X : Type*} (to_two_pointing : two_pointing X) : Twop := ⟨X, to_two_poi @[simp] lemma coe_of {X : Type*} (to_two_pointing : two_pointing X) : ↥(of to_two_pointing) = X := rfl -alias of ← two_pointing.Twop +alias of ← _root_.two_pointing.Twop instance : inhabited Twop := ⟨of two_pointing.bool⟩ diff --git a/src/category_theory/category/basic.lean b/src/category_theory/category/basic.lean index dce140c3e53cb..6a119b1d4800e 100644 --- a/src/category_theory/category/basic.lean +++ b/src/category_theory/category/basic.lean @@ -4,18 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl, Reid Barton -/ import combinatorics.quiver.basic -import tactic.basic /-! # Categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines a category, as a type class parametrised by the type of objects. ## Notations Introduces notations -* `X ⟶ Y` for the morphism spaces, -* `f ≫ g` for composition in the 'arrows' convention. +* `X ⟶ Y` for the morphism spaces (type as `\hom`), +* `𝟙 X` for the identity morphism on `X` (type as `\b1`), +* `f ≫ g` for composition in the 'arrows' convention (type as `\gg`). Users may like to add `f ⊚ g` for composition in the standard convention, using ```lean @@ -82,6 +85,8 @@ extends quiver.{v+1} obj : Type (max u (v+1)) := notation `𝟙` := category_struct.id -- type as \b1 infixr ` ≫ `:80 := category_struct.comp -- type as \gg +initialize_simps_projections category_struct (-to_quiver_hom) + /-- The typeclass `category C` describes morphisms associated to objects of type `C`. The universe levels of the objects and morphisms are unconstrained, and will often need to be @@ -119,8 +124,8 @@ abbreviation small_category (C : Type u) : Type (u+1) := category.{u} C section variables {C : Type u} [category.{v} C] {X Y Z : C} -initialize_simps_projections category (to_category_struct_to_quiver_hom → hom, - to_category_struct_comp → comp, to_category_struct_id → id, -to_category_struct) +initialize_simps_projections category + (to_category_struct_comp → comp, to_category_struct_id → id, -to_category_struct) /-- postcompose an equation between morphisms by another morphism -/ lemma eq_whisker {f g : X ⟶ Y} (w : f = g) (h : Y ⟶ Z) : f ≫ h = g ≫ h := @@ -149,6 +154,16 @@ by { convert w (𝟙 X), tidy } lemma id_of_comp_right_id (f : X ⟶ X) (w : ∀ {Y : C} (g : Y ⟶ X), g ≫ f = g) : f = 𝟙 X := by { convert w (𝟙 X), tidy } +lemma comp_ite {P : Prop} [decidable P] + {X Y Z : C} (f : X ⟶ Y) (g g' : (Y ⟶ Z)) : + (f ≫ if P then g else g') = (if P then f ≫ g else f ≫ g') := +by { split_ifs; refl } + +lemma ite_comp {P : Prop} [decidable P] + {X Y Z : C} (f f' : (X ⟶ Y)) (g : Y ⟶ Z) : + (if P then f else f') ≫ g = (if P then f ≫ g else f' ≫ g) := +by { split_ifs; refl } + lemma comp_dite {P : Prop} [decidable P] {X Y Z : C} (f : X ⟶ Y) (g : P → (Y ⟶ Z)) (g' : ¬P → (Y ⟶ Z)) : (f ≫ if h : P then g h else g' h) = (if h : P then f ≫ g h else f ≫ g' h) := diff --git a/src/category_theory/category/galois_connection.lean b/src/category_theory/category/galois_connection.lean new file mode 100644 index 0000000000000..35ab915fc0bfe --- /dev/null +++ b/src/category_theory/category/galois_connection.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2017 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl, Reid Barton +-/ +import category_theory.category.preorder +import category_theory.adjunction.basic +import order.galois_connection + +/-! + +# Galois connections between preorders are adjunctions. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +* `galois_connection.adjunction` is the adjunction associated to a galois connection. + +-/ + +universes u v + +section + +variables {X : Type u} {Y : Type v} [preorder X] [preorder Y] + +/-- +A galois connection between preorders induces an adjunction between the associated categories. +-/ +def galois_connection.adjunction {l : X → Y} {u : Y → X} (gc : galois_connection l u) : + gc.monotone_l.functor ⊣ gc.monotone_u.functor := +category_theory.adjunction.mk_of_hom_equiv +{ hom_equiv := λ X Y, ⟨λ f, (gc.le_u f.le).hom, λ f, (gc.l_le f.le).hom, by tidy, by tidy⟩ } + +end + +namespace category_theory + +variables {X : Type u} {Y : Type v} [preorder X] [preorder Y] + +/-- +An adjunction between preorder categories induces a galois connection. +-/ +lemma adjunction.gc {L : X ⥤ Y} {R : Y ⥤ X} (adj : L ⊣ R) : + galois_connection L.obj R.obj := +λ x y, ⟨λ h, ((adj.hom_equiv x y).to_fun h.hom).le, λ h, ((adj.hom_equiv x y).inv_fun h.hom).le⟩ + +end category_theory diff --git a/src/category_theory/category/pairwise.lean b/src/category_theory/category/pairwise.lean index a4d82a1c13af1..c8e946677df26 100644 --- a/src/category_theory/category/pairwise.lean +++ b/src/category_theory/category/pairwise.lean @@ -3,13 +3,16 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ - +import order.complete_lattice import category_theory.category.preorder import category_theory.limits.is_limit /-! # The category of "pairwise intersections". +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given `ι : Type v`, we build the diagram category `pairwise ι` with objects `single i` and `pair i j`, for `i j : ι`, whose only non-identity morphisms are diff --git a/src/category_theory/category/preorder.lean b/src/category_theory/category/preorder.lean index b5ce286ec3106..46f3bcc89b813 100644 --- a/src/category_theory/category/preorder.lean +++ b/src/category_theory/category/preorder.lean @@ -3,26 +3,27 @@ Copyright (c) 2017 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl, Reid Barton -/ -import category_theory.adjunction.basic -import order.galois_connection +import category_theory.equivalence +import order.hom.basic /-! # Preorders as categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We install a category instance on any preorder. This is not to be confused with the category _of_ preorders, defined in `order/category/Preorder`. We show that monotone functions between preorders correspond to functors of the associated -categories. Furthermore, galois connections correspond to adjoint functors. +categories. ## Main definitions * `hom_of_le` and `le_of_hom` provide translations between inequalities in the preorder, and morphisms in the associated category. * `monotone.functor` is the functor associated to a monotone function. -* `galois_connection.adjunction` is the adjunction associated to a galois connection. -* `Preorder_to_Cat` is the functor embedding the category of preorders into `Cat`. -/ @@ -60,7 +61,7 @@ Express an inequality as a morphism in the corresponding preorder category. -/ def hom_of_le {x y : X} (h : x ≤ y) : x ⟶ y := ulift.up (plift.up h) -alias hom_of_le ← has_le.le.hom +alias hom_of_le ← _root_.has_le.le.hom @[simp] lemma hom_of_le_refl {x : X} : (le_refl x).hom = 𝟙 x := rfl @[simp] lemma hom_of_le_comp {x y z : X} (h : x ≤ y) (k : y ≤ z) : @@ -71,7 +72,7 @@ Extract the underlying inequality from a morphism in a preorder category. -/ lemma le_of_hom {x y : X} (h : x ⟶ y) : x ≤ y := h.down.down -alias le_of_hom ← quiver.hom.le +alias le_of_hom ← _root_.quiver.hom.le @[simp] lemma le_of_hom_hom_of_le {x y : X} (h : x ≤ y) : h.hom.le = h := rfl @[simp] lemma hom_of_le_le_of_hom {x y : X} (h : x ⟶ y) : h.le.hom = h := @@ -100,14 +101,6 @@ def monotone.functor {f : X → Y} (h : monotone f) : X ⥤ Y := @[simp] lemma monotone.functor_obj {f : X → Y} (h : monotone f) : h.functor.obj = f := rfl -/-- -A galois connection between preorders induces an adjunction between the associated categories. --/ -def galois_connection.adjunction {l : X → Y} {u : Y → X} (gc : galois_connection l u) : - gc.monotone_l.functor ⊣ gc.monotone_u.functor := -category_theory.adjunction.mk_of_hom_equiv -{ hom_equiv := λ X Y, ⟨λ f, (gc.le_u f.le).hom, λ f, (gc.l_le f.le).hom, by tidy, by tidy⟩ } - end namespace category_theory @@ -122,13 +115,6 @@ A functor between preorder categories is monotone. @[mono] lemma functor.monotone (f : X ⥤ Y) : monotone f.obj := λ x y hxy, (f.map hxy.hom).le -/-- -An adjunction between preorder categories induces a galois connection. --/ -lemma adjunction.gc {L : X ⥤ Y} {R : Y ⥤ X} (adj : L ⊣ R) : - galois_connection L.obj R.obj := -λ x y, ⟨λ h, ((adj.hom_equiv x y).to_fun h.hom).le, λ h, ((adj.hom_equiv x y).inv_fun h.hom).le⟩ - end preorder section partial_order diff --git a/src/category_theory/category/ulift.lean b/src/category_theory/category/ulift.lean index 6f52ae9f4d5ff..f1ee02a5c9c96 100644 --- a/src/category_theory/category/ulift.lean +++ b/src/category_theory/category/ulift.lean @@ -10,6 +10,9 @@ import category_theory.eq_to_hom /-! # Basic API for ulift +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains a very basic API for working with the categorical instance on `ulift C` where `C` is a type with a category instance. @@ -132,7 +135,7 @@ end ulift_hom def {w v u} as_small (C : Type u) [category.{v} C] := ulift.{max w v} C instance : small_category (as_small.{w₁} C) := -{ hom := λ X Y, ulift.{(max w₁ u₁)} $ X.down ⟶ Y.down, +{ hom := λ X Y, ulift.{max w₁ u₁} $ X.down ⟶ Y.down, id := λ X, ⟨𝟙 _⟩, comp := λ X Y Z f g, ⟨f.down ≫ g.down⟩ } diff --git a/src/category_theory/closed/cartesian.lean b/src/category_theory/closed/cartesian.lean index b3ea9b725fd7c..c561505054da7 100644 --- a/src/category_theory/closed/cartesian.lean +++ b/src/category_theory/closed/cartesian.lean @@ -15,6 +15,9 @@ import category_theory.closed.monoidal /-! # Cartesian closed categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a category with finite products, the cartesian monoidal structure is provided by the local instance `monoidal_of_has_finite_products`. @@ -306,8 +309,8 @@ lemma strict_initial {I : C} (t : is_initial I) (f : A ⟶ I) : is_iso f := begin haveI : mono (limits.prod.lift (𝟙 A) f ≫ (zero_mul t).hom) := mono_comp _ _, rw [zero_mul_hom, prod.lift_snd] at _inst, - haveI: split_epi f := ⟨t.to _, t.hom_ext _ _⟩, - apply is_iso_of_mono_of_split_epi + haveI: is_split_epi f := is_split_epi.mk' ⟨t.to _, t.hom_ext _ _⟩, + apply is_iso_of_mono_of_is_split_epi end instance to_initial_is_iso [has_initial C] (f : A ⟶ ⊥_ C) : is_iso f := diff --git a/src/category_theory/closed/functor.lean b/src/category_theory/closed/functor.lean index e7c11c984949e..ef432168151b0 100644 --- a/src/category_theory/closed/functor.lean +++ b/src/category_theory/closed/functor.lean @@ -11,6 +11,9 @@ import category_theory.adjunction.fully_faithful /-! # Cartesian closed functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define the exponential comparison morphisms for a functor which preserves binary products, and use them to define a cartesian closed functor: one which (naturally) preserves exponentials. @@ -64,7 +67,7 @@ If `F` is full and faithful and has a left adjoint `L` which preserves binary pr Frobenius morphism is an isomorphism. -/ instance frobenius_morphism_iso_of_preserves_binary_products (h : L ⊣ F) (A : C) - [preserves_limits_of_shape (discrete.{v} walking_pair) L] [full F] [faithful F] : + [preserves_limits_of_shape (discrete walking_pair) L] [full F] [faithful F] : is_iso (frobenius_morphism F h A) := begin apply nat_iso.is_iso_of_is_iso_app _, @@ -74,7 +77,7 @@ begin end variables [cartesian_closed C] [cartesian_closed D] -variables [preserves_limits_of_shape (discrete.{v} walking_pair) F] +variables [preserves_limits_of_shape (discrete walking_pair) F] /-- The exponential comparison map. @@ -133,8 +136,8 @@ attribute [instance] cartesian_closed_functor.comparison_iso lemma frobenius_morphism_mate (h : L ⊣ F) (A : C) : transfer_nat_trans_self - (h.comp _ _ (exp.adjunction A)) - ((exp.adjunction (F.obj A)).comp _ _ h) + (h.comp (exp.adjunction A)) + ((exp.adjunction (F.obj A)).comp h) (frobenius_morphism F h A) = exp_comparison F A := begin rw ←equiv.eq_symm_apply, @@ -182,7 +185,7 @@ TODO: Show the converse, that if `F` is cartesian closed and its left adjoint pr products, then it is full and faithful. -/ def cartesian_closed_functor_of_left_adjoint_preserves_binary_products (h : L ⊣ F) - [full F] [faithful F] [preserves_limits_of_shape (discrete.{v} walking_pair) L] : + [full F] [faithful F] [preserves_limits_of_shape (discrete walking_pair) L] : cartesian_closed_functor F := { comparison_iso := λ A, exp_comparison_iso_of_frobenius_morphism_iso F h _ } diff --git a/src/category_theory/closed/functor_category.lean b/src/category_theory/closed/functor_category.lean new file mode 100644 index 0000000000000..029c5c26d1c1d --- /dev/null +++ b/src/category_theory/closed/functor_category.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2022 Antoine Labelle. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Antoine Labelle +-/ +import category_theory.closed.monoidal +import category_theory.monoidal.functor_category + +/-! +# Functors from a groupoid into a monoidal closed category form a monoidal closed category. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +(Using the pointwise monoidal structure on the functor category.) +-/ + +noncomputable theory + +open category_theory +open category_theory.monoidal_category +open category_theory.monoidal_closed + +namespace category_theory.functor + +variables {C D : Type*} [groupoid D] [category C] [monoidal_category C] [monoidal_closed C] + +/-- Auxiliary definition for `category_theory.monoidal_closed.functor_closed`. +The internal hom functor `F ⟶[C] -` -/ +@[simps] def closed_ihom (F : D ⥤ C) : (D ⥤ C) ⥤ (D ⥤ C) := +((whiskering_right₂ D Cᵒᵖ C C).obj internal_hom).obj (groupoid.inv_functor D ⋙ F.op) + +/-- Auxiliary definition for `category_theory.monoidal_closed.functor_closed`. +The unit for the adjunction `(tensor_left F) ⊣ (ihom F)`. -/ +@[simps] +def closed_unit (F : D ⥤ C) : 𝟭 (D ⥤ C) ⟶ (tensor_left F) ⋙ (closed_ihom F) := +{ app := λ G, + { app := λ X, (ihom.coev (F.obj X)).app (G.obj X), + naturality' := begin + intros X Y f, + dsimp, + simp only [ihom.coev_naturality, closed_ihom_obj_map, monoidal.tensor_obj_map], + dsimp, + rw [coev_app_comp_pre_app_assoc, ←functor.map_comp], + simp, + end } } + +/-- Auxiliary definition for `category_theory.monoidal_closed.functor_closed`. +The counit for the adjunction `(tensor_left F) ⊣ (ihom F)`. -/ +@[simps] +def closed_counit (F : D ⥤ C) : (closed_ihom F) ⋙ (tensor_left F) ⟶ 𝟭 (D ⥤ C) := +{ app := λ G, + { app := λ X, (ihom.ev (F.obj X)).app (G.obj X), + naturality' := begin + intros X Y f, + dsimp, + simp only [closed_ihom_obj_map, pre_comm_ihom_map], + rw [←tensor_id_comp_id_tensor, id_tensor_comp], + simp, + end } } + +/-- If `C` is a monoidal closed category and `D` is groupoid, then every functor `F : D ⥤ C` is +closed in the functor category `F : D ⥤ C` with the pointwise monoidal structure. -/ +@[simps] instance closed (F : D ⥤ C) : closed F := +{ is_adj := + { right := closed_ihom F, + adj := adjunction.mk_of_unit_counit + { unit := closed_unit F, + counit := closed_counit F } } } + +/-- If `C` is a monoidal closed category and `D` is groupoid, then the functor category `D ⥤ C`, +with the pointwise monoidal structure, is monoidal closed. -/ +@[simps] instance monoidal_closed : monoidal_closed (D ⥤ C) := +{ closed' := by apply_instance } + +lemma ihom_map (F : D ⥤ C) {G H : D ⥤ C} (f : G ⟶ H) : + (ihom F).map f = (closed_ihom F).map f := rfl + +lemma ihom_ev_app (F G : D ⥤ C) : + (ihom.ev F).app G = (closed_counit F).app G := rfl + +lemma ihom_coev_app (F G : D ⥤ C) : + (ihom.coev F).app G = (closed_unit F).app G := rfl + +end category_theory.functor diff --git a/src/category_theory/closed/ideal.lean b/src/category_theory/closed/ideal.lean index ba8c674c46880..47f10852c5734 100644 --- a/src/category_theory/closed/ideal.lean +++ b/src/category_theory/closed/ideal.lean @@ -14,6 +14,9 @@ import category_theory.subterminal /-! # Exponential ideals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An exponential ideal of a cartesian closed category `C` is a subcategory `D ⊆ C` such that for any `B : D` and `A : C`, the exponential `A ⟹ B` is in `D`: resembling ring theoretic ideals. We define the notion here for inclusion functors `i : D ⥤ C` rather than explicit subcategories to @@ -110,7 +113,7 @@ variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₁} D variables (i : D ⥤ C) lemma reflective_products [has_finite_products C] [reflective i] : has_finite_products D := -⟨λ J 𝒥₁ 𝒥₂, by exactI has_limits_of_shape_of_reflective i⟩ +⟨λ n, has_limits_of_shape_of_reflective i⟩ local attribute [instance, priority 10] reflective_products @@ -124,7 +127,7 @@ This is the converse of `preserves_binary_products_of_exponential_ideal`. -/ @[priority 10] instance exponential_ideal_of_preserves_binary_products - [preserves_limits_of_shape (discrete.{v₁} walking_pair) (left_adjoint i)] : + [preserves_limits_of_shape (discrete walking_pair) (left_adjoint i)] : exponential_ideal i := begin let ir := adjunction.of_right_adjoint i, @@ -143,8 +146,8 @@ begin ir.hom_equiv_apply_eq, assoc, assoc, prod_comparison_natural_assoc, L.map_id, ← prod.map_id_comp_assoc, ir.left_triangle_components, prod.map_id_id, id_comp], apply is_iso.hom_inv_id_assoc }, - haveI : split_mono (η.app (A ⟹ i.obj B)) := ⟨_, this⟩, - apply mem_ess_image_of_unit_split_mono, + haveI : is_split_mono (η.app (A ⟹ i.obj B)) := is_split_mono.mk' ⟨_, this⟩, + apply mem_ess_image_of_unit_is_split_mono, end variables [exponential_ideal i] @@ -164,7 +167,7 @@ def cartesian_closed_of_reflective : cartesian_closed D := apply nat_iso.of_components _ _, { intro X, haveI := - adjunction.right_adjoint_preserves_limits.{v₁ v₁} (adjunction.of_right_adjoint i), + adjunction.right_adjoint_preserves_limits.{0 0} (adjunction.of_right_adjoint i), apply as_iso (prod_comparison i B X) }, { intros X Y f, dsimp, @@ -212,6 +215,7 @@ calc _ ≃ (A ⨯ B ⟶ i.obj X) : begin apply iso.hom_congr _ (iso.refl _), haveI : preserves_limits i := (adjunction.of_right_adjoint i).right_adjoint_preserves_limits, + haveI := preserves_smallest_limits_of_preserves_limits i, exact (preserves_limit_pair.iso _ _ _).symm, end ... ≃ ((left_adjoint i).obj A ⨯ (left_adjoint i).obj B ⟶ X) : @@ -274,11 +278,11 @@ noncomputable def preserves_binary_products_of_exponential_ideal : /-- If a reflective subcategory is an exponential ideal, then the reflector preserves finite products. -/ -noncomputable def preserves_finite_products_of_exponential_ideal (J : Type*) [fintype J] : +noncomputable def preserves_finite_products_of_exponential_ideal (J : Type) [fintype J] : preserves_limits_of_shape (discrete J) (left_adjoint i) := begin letI := preserves_binary_products_of_exponential_ideal i, - letI := left_adjoint_preserves_terminal_of_reflective.{v₁} i, + letI := left_adjoint_preserves_terminal_of_reflective.{0} i, apply preserves_finite_products_of_preserves_binary_and_terminal (left_adjoint i) J, end diff --git a/src/category_theory/closed/monoidal.lean b/src/category_theory/closed/monoidal.lean index e6308ec3b880b..5016a124b2b32 100644 --- a/src/category_theory/closed/monoidal.lean +++ b/src/category_theory/closed/monoidal.lean @@ -3,20 +3,24 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Bhavik Mehta -/ -import category_theory.monoidal.category +import category_theory.monoidal.functor import category_theory.adjunction.limits import category_theory.adjunction.mates +import category_theory.functor.inv_isos /-! # Closed monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define (right) closed objects and (right) closed monoidal categories. ## TODO Some of the theorems proved about cartesian closed categories should be generalised and moved to this file. -/ -universes v u u₂ +universes v u u₂ v₂ namespace category_theory @@ -106,7 +110,7 @@ lemma coev_naturality {X Y : C} (f : X ⟶ Y) : f ≫ (coev A).app Y = (coev A).app X ≫ (ihom A).map ((𝟙 A) ⊗ f) := (coev A).naturality f -notation A ` ⟶[`C`] ` B:10 := (@ihom C _ _ A _).obj B +notation (name := ihom) A ` ⟶[`C`] ` B:10 := (@ihom C _ _ A _).obj B @[simp, reassoc] lemma ev_coev : ((𝟙 A) ⊗ ((coev A).app B)) ≫ (ev A).app (A ⊗ B) = 𝟙 (A ⊗ B) := @@ -205,15 +209,18 @@ variables {A B} [closed B] def pre (f : B ⟶ A) : ihom A ⟶ ihom B := transfer_nat_trans_self (ihom.adjunction _) (ihom.adjunction _) ((tensoring_left C).map f) +@[simp, reassoc] lemma id_tensor_pre_app_comp_ev (f : B ⟶ A) (X : C) : (𝟙 B ⊗ ((pre f).app X)) ≫ (ihom.ev B).app X = (f ⊗ (𝟙 (A ⟶[C] X))) ≫ (ihom.ev A).app X := transfer_nat_trans_self_counit _ _ ((tensoring_left C).map f) X +@[simp] lemma uncurry_pre (f : B ⟶ A) (X : C) : monoidal_closed.uncurry ((pre f).app X) = (f ⊗ 𝟙 _) ≫ (ihom.ev A).app X := by rw [uncurry_eq, id_tensor_pre_app_comp_ev] +@[simp, reassoc] lemma coev_app_comp_pre_app (f : B ⟶ A) : (ihom.coev A).app X ≫ (pre f).app (A ⊗ X) = (ihom.coev B).app X ≫ (ihom B).map (f ⊗ (𝟙 _)) := @@ -229,13 +236,62 @@ lemma pre_map {A₁ A₂ A₃ : C} [closed A₁] [closed A₂] [closed A₃] pre (f ≫ g) = pre g ≫ pre f := by rw [pre, pre, pre, transfer_nat_trans_self_comp, (tensoring_left C).map_comp] +lemma pre_comm_ihom_map {W X Y Z : C} [closed W] [closed X] + (f : W ⟶ X) (g : Y ⟶ Z) : + (pre f).app Y ≫ (ihom W).map g = (ihom X).map g ≫ (pre f).app Z := by simp + end pre /-- The internal hom functor given by the monoidal closed structure. -/ +@[simps] def internal_hom [monoidal_closed C] : Cᵒᵖ ⥤ C ⥤ C := { obj := λ X, ihom X.unop, map := λ X Y f, pre f.unop } +section of_equiv + +variables {D : Type u₂} [category.{v₂} D] [monoidal_category.{v₂} D] + +/-- Transport the property of being monoidal closed across a monoidal equivalence of categories -/ +noncomputable +def of_equiv (F : monoidal_functor C D) [is_equivalence F.to_functor] [h : monoidal_closed D] : + monoidal_closed C := +{ closed' := λ X, + { is_adj := begin + haveI q : closed (F.to_functor.obj X) := infer_instance, + haveI : is_left_adjoint (tensor_left (F.to_functor.obj X)) := q.is_adj, + have i := comp_inv_iso (monoidal_functor.comm_tensor_left F X), + exact adjunction.left_adjoint_of_nat_iso i, + end } } + +/-- Suppose we have a monoidal equivalence `F : C ≌ D`, with `D` monoidal closed. We can pull the +monoidal closed instance back along the equivalence. For `X, Y, Z : C`, this lemma describes the +resulting currying map `Hom(X ⊗ Y, Z) → Hom(Y, (X ⟶[C] Z))`. (`X ⟶[C] Z` is defined to be +`F⁻¹(F(X) ⟶[D] F(Z))`, so currying in `C` is given by essentially conjugating currying in +`D` by `F.`) -/ +lemma of_equiv_curry_def (F : monoidal_functor C D) [is_equivalence F.to_functor] + [h : monoidal_closed D] {X Y Z : C} (f : X ⊗ Y ⟶ Z) : + @monoidal_closed.curry _ _ _ _ _ _ ((monoidal_closed.of_equiv F).1 _) f = + (F.1.1.adjunction.hom_equiv Y ((ihom _).obj _)) (monoidal_closed.curry + (F.1.1.inv.adjunction.hom_equiv (F.1.1.obj X ⊗ F.1.1.obj Y) Z + ((comp_inv_iso (F.comm_tensor_left X)).hom.app Y ≫ f))) := rfl + +/-- Suppose we have a monoidal equivalence `F : C ≌ D`, with `D` monoidal closed. We can pull the +monoidal closed instance back along the equivalence. For `X, Y, Z : C`, this lemma describes the +resulting uncurrying map `Hom(Y, (X ⟶[C] Z)) → Hom(X ⊗ Y ⟶ Z)`. (`X ⟶[C] Z` is +defined to be `F⁻¹(F(X) ⟶[D] F(Z))`, so uncurrying in `C` is given by essentially conjugating +uncurrying in `D` by `F.`) -/ +lemma of_equiv_uncurry_def + (F : monoidal_functor C D) [is_equivalence F.to_functor] [h : monoidal_closed D] {X Y Z : C} + (f : Y ⟶ (@ihom _ _ _ X $ (monoidal_closed.of_equiv F).1 X).obj Z) : + @monoidal_closed.uncurry _ _ _ _ _ _ ((monoidal_closed.of_equiv F).1 _) f = + (comp_inv_iso (F.comm_tensor_left X)).inv.app Y ≫ (F.1.1.inv.adjunction.hom_equiv + (F.1.1.obj X ⊗ F.1.1.obj Y) Z).symm (monoidal_closed.uncurry + ((F.1.1.adjunction.hom_equiv Y ((ihom (F.1.1.obj X)).obj (F.1.1.obj Z))).symm f)) := +rfl + +end of_equiv + end monoidal_closed end category_theory diff --git a/src/category_theory/closed/types.lean b/src/category_theory/closed/types.lean index 680c96c614d43..13cb03e263bf3 100644 --- a/src/category_theory/closed/types.lean +++ b/src/category_theory/closed/types.lean @@ -11,6 +11,9 @@ import category_theory.closed.cartesian /-! # Cartesian closure of Type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Show that `Type u₁` is cartesian closed, and `C ⥤ Type u₁` is cartesian closed for `C` a small category in `Type u₁`. Note this implies that the category of presheaves on a small category `C` is cartesian closed. @@ -35,14 +38,14 @@ instance (X : Type v₁) : is_left_adjoint (types.binary_product_functor.obj X) { unit := { app := λ Z (z : Z) x, ⟨x, z⟩ }, counit := { app := λ Z xf, xf.2 xf.1 } } } -instance : has_finite_products (Type v₁) := has_finite_products_of_has_products _ +instance : has_finite_products (Type v₁) := has_finite_products_of_has_products.{v₁} _ instance : cartesian_closed (Type v₁) := { closed' := λ X, { is_adj := adjunction.left_adjoint_of_nat_iso (types.binary_product_iso_prod.app X) } } instance {C : Type u₁} [category.{v₁} C] : has_finite_products (C ⥤ Type u₁) := -has_finite_products_of_has_products _ +has_finite_products_of_has_products.{u₁} _ instance {C : Type v₁} [small_category C] : cartesian_closed (C ⥤ Type v₁) := { closed' := λ F, diff --git a/src/category_theory/closed/zero.lean b/src/category_theory/closed/zero.lean index 751ad5e9daf12..73fbe508f9cc5 100644 --- a/src/category_theory/closed/zero.lean +++ b/src/category_theory/closed/zero.lean @@ -5,13 +5,16 @@ Authors: Bhavik Mehta -/ import category_theory.closed.cartesian -import category_theory.limits.shapes.zero_morphisms import category_theory.punit import category_theory.conj +import category_theory.limits.shapes.zero_objects /-! # A cartesian closed category with zero object is trivial +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A cartesian closed category with zero object is trivial: it is equivalent to the category with one object and one morphism. diff --git a/src/category_theory/cofiltered_system.lean b/src/category_theory/cofiltered_system.lean new file mode 100644 index 0000000000000..1fa9fddb32a8d --- /dev/null +++ b/src/category_theory/cofiltered_system.lean @@ -0,0 +1,363 @@ +/- +Copyright (c) 2022 Kyle Miller, Adam Topaz, Rémi Bottinelli, Junyan Xu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller, Adam Topaz, Rémi Bottinelli, Junyan Xu +-/ +import category_theory.filtered +import data.set.finite +import topology.category.Top.limits.konig + +/-! +# Cofiltered systems + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file deals with properties of cofiltered (and inverse) systems. + +## Main definitions + +Given a functor `F : J ⥤ Type v`: + +* For `j : J`, `F.eventual_range j` is the intersections of all ranges of morphisms `F.map f` + where `f` has codomain `j`. +* `F.is_mittag_leffler` states that the functor `F` satisfies the Mittag-Leffler + condition: the ranges of morphisms `F.map f` (with `f` having codomain `j`) stabilize. +* If `J` is cofiltered `F.to_eventual_ranges` is the subfunctor of `F` obtained by restriction + to `F.eventual_range`. +* `F.to_preimages` restricts a functor to preimages of a given set in some `F.obj i`. If `J` is + cofiltered, then it is Mittag-Leffler if `F` is, see `is_mittag_leffler.to_preimages`. + +## Main statements + +* `nonempty_sections_of_finite_cofiltered_system` shows that if `J` is cofiltered and each + `F.obj j` is nonempty and finite, `F.sections` is nonempty. +* `nonempty_sections_of_finite_inverse_system` is a specialization of the above to `J` being a + directed set (and `F : Jᵒᵖ ⥤ Type v`). +* `is_mittag_leffler_of_exists_finite_range` shows that if `J` is cofiltered and for all `j`, + there exists some `i` and `f : i ⟶ j` such that the range of `F.map f` is finite, then + `F` is Mittag-Leffler. +* `to_eventual_ranges_surjective` shows that if `F` is Mittag-Leffler, then `F.to_eventual_ranges` + has all morphisms `F.map f` surjective. + +## Todo + +* Prove [Stacks: Lemma 0597](https://stacks.math.columbia.edu/tag/0597) + +## References + +* [Stacks: Mittag-Leffler systems](https://stacks.math.columbia.edu/tag/0594) + +## Tags + +Mittag-Leffler, surjective, eventual range, inverse system, + +-/ + +universes u v w + +open category_theory category_theory.is_cofiltered set category_theory.functor_to_types + +section finite_konig + +/-- This bootstraps `nonempty_sections_of_finite_inverse_system`. In this version, +the `F` functor is between categories of the same universe, and it is an easy +corollary to `Top.nonempty_limit_cone_of_compact_t2_inverse_system`. -/ +lemma nonempty_sections_of_finite_cofiltered_system.init + {J : Type u} [small_category J] [is_cofiltered_or_empty J] (F : J ⥤ Type u) + [hf : ∀ j, finite (F.obj j)] [hne : ∀ j, nonempty (F.obj j)] : + F.sections.nonempty := +begin + let F' : J ⥤ Top := F ⋙ Top.discrete, + haveI : ∀ j, discrete_topology (F'.obj j) := λ _, ⟨rfl⟩, + haveI : ∀ j, finite (F'.obj j) := hf, + haveI : ∀ j, nonempty (F'.obj j) := hne, + obtain ⟨⟨u, hu⟩⟩ := Top.nonempty_limit_cone_of_compact_t2_cofiltered_system F', + exact ⟨u, λ _ _, hu⟩, +end + +/-- The cofiltered limit of nonempty finite types is nonempty. + +See `nonempty_sections_of_finite_inverse_system` for a specialization to inverse limits. -/ +theorem nonempty_sections_of_finite_cofiltered_system + {J : Type u} [category.{w} J] [is_cofiltered_or_empty J] (F : J ⥤ Type v) + [∀ (j : J), finite (F.obj j)] [∀ (j : J), nonempty (F.obj j)] : + F.sections.nonempty := +begin + -- Step 1: lift everything to the `max u v w` universe. + let J' : Type (max w v u) := as_small.{max w v} J, + let down : J' ⥤ J := as_small.down, + let F' : J' ⥤ Type (max u v w) := down ⋙ F ⋙ ulift_functor.{(max u w) v}, + haveI : ∀ i, nonempty (F'.obj i) := λ i, ⟨⟨classical.arbitrary (F.obj (down.obj i))⟩⟩, + haveI : ∀ i, finite (F'.obj i) := λ i, finite.of_equiv (F.obj (down.obj i)) equiv.ulift.symm, + -- Step 2: apply the bootstrap theorem + casesI is_empty_or_nonempty J, + { fsplit; exact is_empty_elim }, + haveI : is_cofiltered J := ⟨⟩, + obtain ⟨u, hu⟩ := nonempty_sections_of_finite_cofiltered_system.init F', + -- Step 3: interpret the results + use λ j, (u ⟨j⟩).down, + intros j j' f, + have h := @hu (⟨j⟩ : J') (⟨j'⟩ : J') (ulift.up f), + simp only [as_small.down, functor.comp_map, ulift_functor_map, functor.op_map] at h, + simp_rw [←h], + refl, +end + +/-- The inverse limit of nonempty finite types is nonempty. + +See `nonempty_sections_of_finite_cofiltered_system` for a generalization to cofiltered limits. +That version applies in almost all cases, and the only difference is that this version +allows `J` to be empty. + +This may be regarded as a generalization of Kőnig's lemma. +To specialize: given a locally finite connected graph, take `Jᵒᵖ` to be `ℕ` and +`F j` to be length-`j` paths that start from an arbitrary fixed vertex. +Elements of `F.sections` can be read off as infinite rays in the graph. -/ +theorem nonempty_sections_of_finite_inverse_system + {J : Type u} [preorder J] [is_directed J (≤)] (F : Jᵒᵖ ⥤ Type v) + [∀ (j : Jᵒᵖ), finite (F.obj j)] [∀ (j : Jᵒᵖ), nonempty (F.obj j)] : + F.sections.nonempty := +begin + casesI is_empty_or_nonempty J, + { haveI : is_empty Jᵒᵖ := ⟨λ j, is_empty_elim j.unop⟩, -- TODO: this should be a global instance + exact ⟨is_empty_elim, is_empty_elim⟩, }, + { exact nonempty_sections_of_finite_cofiltered_system _, }, +end + +end finite_konig + +namespace category_theory +namespace functor + +variables {J : Type u} [category J] (F : J ⥤ Type v) {i j k : J} (s : set (F.obj i)) + +/-- +The eventual range of the functor `F : J ⥤ Type v` at index `j : J` is the intersection +of the ranges of all maps `F.map f` with `i : J` and `f : i ⟶ j`. +-/ +def eventual_range (j : J) := ⋂ i (f : i ⟶ j), range (F.map f) + +lemma mem_eventual_range_iff {x : F.obj j} : + x ∈ F.eventual_range j ↔ ∀ ⦃i⦄ (f : i ⟶ j), x ∈ range (F.map f) := mem_Inter₂ + +/-- +The functor `F : J ⥤ Type v` satisfies the Mittag-Leffler condition if for all `j : J`, +there exists some `i : J` and `f : i ⟶ j` such that for all `k : J` and `g : k ⟶ j`, the range +of `F.map f` is contained in that of `F.map g`; +in other words (see `is_mittag_leffler_iff_eventual_range`), the eventual range at `j` is attained +by some `f : i ⟶ j`. +-/ +def is_mittag_leffler : Prop := +∀ j : J, ∃ i (f : i ⟶ j), ∀ ⦃k⦄ (g : k ⟶ j), range (F.map f) ⊆ range (F.map g) + +lemma is_mittag_leffler_iff_eventual_range : F.is_mittag_leffler ↔ + ∀ j : J, ∃ i (f : i ⟶ j), F.eventual_range j = range (F.map f) := +forall_congr $ λ j, exists₂_congr $ λ i f, + ⟨λ h, (Inter₂_subset _ _).antisymm $ subset_Inter₂ h, λ h, h ▸ Inter₂_subset⟩ + +lemma is_mittag_leffler.subset_image_eventual_range (h : F.is_mittag_leffler) (f : j ⟶ i) : + F.eventual_range i ⊆ F.map f '' (F.eventual_range j) := +begin + obtain ⟨k, g, hg⟩ := F.is_mittag_leffler_iff_eventual_range.1 h j, + rw hg, intros x hx, + obtain ⟨x, rfl⟩ := F.mem_eventual_range_iff.1 hx (g ≫ f), + refine ⟨_, ⟨x, rfl⟩, by simpa only [F.map_comp]⟩, +end + +lemma eventual_range_eq_range_precomp (f : i ⟶ j) (g : j ⟶ k) + (h : F.eventual_range k = range (F.map g)) : + F.eventual_range k = range (F.map $ f ≫ g) := +begin + apply subset_antisymm, + { apply Inter₂_subset, }, + { rw [h, F.map_comp], apply range_comp_subset_range, } +end + +lemma is_mittag_leffler_of_surjective + (h : ∀ ⦃i j : J⦄ (f :i ⟶ j), (F.map f).surjective) : F.is_mittag_leffler := +λ j, ⟨j, 𝟙 j, λ k g, by rw [map_id, types_id, range_id, (h g).range_eq]⟩ + +/-- The subfunctor of `F` obtained by restricting to the preimages of a set `s ∈ F.obj i`. -/ +@[simps] def to_preimages : J ⥤ Type v := +{ obj := λ j, ⋂ f : j ⟶ i, F.map f ⁻¹' s, + map := λ j k g, maps_to.restrict (F.map g) _ _ $ λ x h, begin + rw [mem_Inter] at h ⊢, intro f, + rw [← mem_preimage, preimage_preimage], + convert h (g ≫ f), rw F.map_comp, refl, + end, + map_id' := λ j, by { simp_rw F.map_id, ext, refl }, + map_comp' := λ j k l f g, by { simp_rw F.map_comp, refl } } + +instance to_preimages_finite [∀ j, finite (F.obj j)] : + ∀ j, finite ((F.to_preimages s).obj j) := λ j, subtype.finite + +variable [is_cofiltered_or_empty J] + +lemma eventual_range_maps_to (f : j ⟶ i) : + (F.eventual_range j).maps_to (F.map f) (F.eventual_range i) := +λ x hx, begin + rw mem_eventual_range_iff at hx ⊢, + intros k f', + obtain ⟨l, g, g', he⟩ := cospan f f', + obtain ⟨x, rfl⟩ := hx g, + rw [← map_comp_apply, he, F.map_comp], + exact ⟨_, rfl⟩, +end + +lemma is_mittag_leffler.eq_image_eventual_range (h : F.is_mittag_leffler) (f : j ⟶ i) : + F.eventual_range i = F.map f '' (F.eventual_range j) := +(h.subset_image_eventual_range F f).antisymm $ maps_to'.1 (F.eventual_range_maps_to f) + +lemma eventual_range_eq_iff {f : i ⟶ j} : + F.eventual_range j = range (F.map f) ↔ + ∀ ⦃k⦄ (g : k ⟶ i), range (F.map f) ⊆ range (F.map $ g ≫ f) := +begin + rw [subset_antisymm_iff, eventual_range, and_iff_right (Inter₂_subset _ _), subset_Inter₂_iff], + refine ⟨λ h k g, h _ _, λ h j' f', _⟩, + obtain ⟨k, g, g', he⟩ := cospan f f', + refine (h g).trans _, + rw [he, F.map_comp], + apply range_comp_subset_range, +end + +lemma is_mittag_leffler_iff_subset_range_comp : F.is_mittag_leffler ↔ + ∀ j : J, ∃ i (f : i ⟶ j), ∀ ⦃k⦄ (g : k ⟶ i), range (F.map f) ⊆ range (F.map $ g ≫ f) := +by simp_rw [is_mittag_leffler_iff_eventual_range, eventual_range_eq_iff] + +lemma is_mittag_leffler.to_preimages (h : F.is_mittag_leffler) : + (F.to_preimages s).is_mittag_leffler := +(is_mittag_leffler_iff_subset_range_comp _).2 $ λ j, begin + obtain ⟨j₁, g₁, f₁, -⟩ := cone_objs i j, + obtain ⟨j₂, f₂, h₂⟩ := F.is_mittag_leffler_iff_eventual_range.1 h j₁, + refine ⟨j₂, f₂ ≫ f₁, λ j₃ f₃, _⟩, + rintro _ ⟨⟨x, hx⟩, rfl⟩, + have : F.map f₂ x ∈ F.eventual_range j₁, { rw h₂, exact ⟨_, rfl⟩ }, + obtain ⟨y, hy, h₃⟩ := h.subset_image_eventual_range F (f₃ ≫ f₂) this, + refine ⟨⟨y, mem_Inter.2 $ λ g₂, _⟩, subtype.ext _⟩, + { obtain ⟨j₄, f₄, h₄⟩ := cone_maps g₂ ((f₃ ≫ f₂) ≫ g₁), + obtain ⟨y, rfl⟩ := F.mem_eventual_range_iff.1 hy f₄, + rw ← map_comp_apply at h₃, + rw [mem_preimage, ← map_comp_apply, h₄, ← category.assoc, map_comp_apply, h₃, ← map_comp_apply], + apply mem_Inter.1 hx }, + { simp_rw [to_preimages_map, maps_to.coe_restrict_apply, subtype.coe_mk], + rw [← category.assoc, map_comp_apply, h₃, map_comp_apply] }, +end + +lemma is_mittag_leffler_of_exists_finite_range + (h : ∀ (j : J), ∃ i (f : i ⟶ j), (range $ F.map f).finite) : + F.is_mittag_leffler := +λ j, begin + obtain ⟨i, hi, hf⟩ := h j, + obtain ⟨m, ⟨i, f, hm⟩, hmin⟩ := finset.is_well_founded_lt.wf.has_min + {s : finset (F.obj j) | ∃ i (f : i ⟶ j), ↑s = range (F.map f)} ⟨_, i, hi, hf.coe_to_finset⟩, + refine ⟨i, f, λ k g, + (directed_on_range.mp $ F.ranges_directed j).is_bot_of_is_min ⟨⟨i, f⟩, rfl⟩ _ _ ⟨⟨k, g⟩, rfl⟩⟩, + rintro _ ⟨⟨k', g'⟩, rfl⟩ hl, + refine (eq_of_le_of_not_lt hl _).ge, + have := hmin _ ⟨k', g', (m.finite_to_set.subset $ hm.substr hl).coe_to_finset⟩, + rwa [finset.lt_iff_ssubset, ← finset.coe_ssubset, set.finite.coe_to_finset, hm] at this, +end + +/-- +The subfunctor of `F` obtained by restricting to the eventual range at each index. +-/ +@[simps] def to_eventual_ranges : J ⥤ Type v := +{ obj := λ j, F.eventual_range j, + map := λ i j f, (F.eventual_range_maps_to f).restrict _ _ _, + map_id' := λ i, by { simp_rw F.map_id, ext, refl }, + map_comp' := λ _ _ _ _ _, by { simp_rw F.map_comp, refl } } + +instance to_eventual_ranges_finite [∀ j, finite (F.obj j)] : + ∀ j, finite (F.to_eventual_ranges.obj j) := λ j, subtype.finite + +/-- +The sections of the functor `F : J ⥤ Type v` are in bijection with the sections of +`F.eventual_ranges`. +-/ +def to_eventual_ranges_sections_equiv : F.to_eventual_ranges.sections ≃ F.sections := +{ to_fun := λ s, ⟨_, λ i j f, subtype.coe_inj.2 $ s.prop f⟩, + inv_fun := λ s, ⟨λ j, ⟨_, mem_Inter₂.2 $ λ i f, ⟨_, s.prop f⟩⟩, λ i j f, subtype.ext $ s.prop f⟩, + left_inv := λ _, by { ext, refl }, + right_inv := λ _, by { ext, refl } } + +/-- +If `F` satisfies the Mittag-Leffler condition, its restriction to eventual ranges is a surjective +functor. +-/ +lemma surjective_to_eventual_ranges (h : F.is_mittag_leffler) ⦃i j⦄ (f : i ⟶ j) : + (F.to_eventual_ranges.map f).surjective := +λ ⟨x, hx⟩, by { obtain ⟨y, hy, rfl⟩ := h.subset_image_eventual_range F f hx, exact ⟨⟨y, hy⟩, rfl⟩ } + +/-- If `F` is nonempty at each index and Mittag-Leffler, then so is `F.to_eventual_ranges`. -/ +lemma to_eventual_ranges_nonempty (h : F.is_mittag_leffler) [∀ (j : J), nonempty (F.obj j)] + (j : J) : nonempty (F.to_eventual_ranges.obj j) := +let ⟨i, f, h⟩ := F.is_mittag_leffler_iff_eventual_range.1 h j in +by { rw [to_eventual_ranges_obj, h], apply_instance } + +/-- If `F` has all arrows surjective, then it "factors through a poset". -/ +lemma thin_diagram_of_surjective (Fsur : ∀ ⦃i j : J⦄ (f : i ⟶ j), (F.map f).surjective) + {i j} (f g : i ⟶ j) : F.map f = F.map g := +let ⟨k, φ, hφ⟩ := cone_maps f g in +(Fsur φ).injective_comp_right $ by simp_rw [← types_comp, ← F.map_comp, hφ] + +lemma to_preimages_nonempty_of_surjective [hFn : ∀ (j : J), nonempty (F.obj j)] + (Fsur : ∀ ⦃i j : J⦄ (f : i ⟶ j), (F.map f).surjective) + (hs : s.nonempty) (j) : nonempty ((F.to_preimages s).obj j) := +begin + simp only [to_preimages_obj, nonempty_coe_sort, nonempty_Inter, mem_preimage], + obtain (h|⟨⟨ji⟩⟩) := is_empty_or_nonempty (j ⟶ i), + { exact ⟨(hFn j).some, λ ji, h.elim ji⟩, }, + { obtain ⟨y, ys⟩ := hs, + obtain ⟨x, rfl⟩ := Fsur ji y, + exact ⟨x, λ ji', (F.thin_diagram_of_surjective Fsur ji' ji).symm ▸ ys⟩, }, +end + +lemma eval_section_injective_of_eventually_injective + {j} (Finj : ∀ i (f : i ⟶ j), (F.map f).injective) (i) (f : i ⟶ j) : + (λ s : F.sections, s.val j).injective := +begin + refine λ s₀ s₁ h, subtype.ext $ funext $ λ k, _, + obtain ⟨m, mi, mk, _⟩ := cone_objs i k, + dsimp at h, + rw [←s₀.prop (mi ≫ f), ←s₁.prop (mi ≫ f)] at h, + rw [←s₀.prop mk, ←s₁.prop mk], + refine congr_arg _ (Finj m (mi ≫ f) h), +end + +section finite_cofiltered_system + +variables [∀ (j : J), nonempty (F.obj j)] [∀ (j : J), finite (F.obj j)] + (Fsur : ∀ ⦃i j : J⦄ (f :i ⟶ j), (F.map f).surjective) + +include Fsur +lemma eval_section_surjective_of_surjective (i : J) : + (λ s : F.sections, s.val i).surjective := λ x, +begin + let s : set (F.obj i) := {x}, + haveI := F.to_preimages_nonempty_of_surjective s Fsur (singleton_nonempty x), + obtain ⟨sec, h⟩ := nonempty_sections_of_finite_cofiltered_system (F.to_preimages s), + refine ⟨⟨λ j, (sec j).val, λ j k jk, by simpa [subtype.ext_iff] using h jk⟩, _⟩, + { have := (sec i).prop, + simp only [mem_Inter, mem_preimage, mem_singleton_iff] at this, + replace this := this (𝟙 i), rwa [map_id_apply] at this, }, +end + +lemma eventually_injective [nonempty J] [finite F.sections] : + ∃ j, ∀ i (f : i ⟶ j), (F.map f).injective := +begin + haveI : ∀ j, fintype (F.obj j) := λ j, fintype.of_finite (F.obj j), + haveI : fintype F.sections := fintype.of_finite F.sections, + have card_le : ∀ j, fintype.card (F.obj j) ≤ fintype.card F.sections := + λ j, fintype.card_le_of_surjective _ (F.eval_section_surjective_of_surjective Fsur j), + let fn := λ j, fintype.card F.sections - fintype.card (F.obj j), + refine ⟨fn.argmin nat.well_founded_lt.wf, λ i f, ((fintype.bijective_iff_surjective_and_card _).2 + ⟨Fsur f, le_antisymm _ (fintype.card_le_of_surjective _ $ Fsur f)⟩).1⟩, + rw [← nat.sub_sub_self (card_le i), tsub_le_iff_tsub_le], + apply fn.argmin_le, +end + +end finite_cofiltered_system + +end functor +end category_theory diff --git a/src/category_theory/comm_sq.lean b/src/category_theory/comm_sq.lean new file mode 100644 index 0000000000000..7e9e2ad8bd048 --- /dev/null +++ b/src/category_theory/comm_sq.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Joël Riou +-/ +import category_theory.arrow + +/-! +# Commutative squares + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provide an API for commutative squares in categories. +If `top`, `left`, `right` and `bottom` are four morphisms which are the edges +of a square, `comm_sq top left right bottom` is the predicate that this +square is commutative. + +The structure `comm_sq` is extended in `category_theory/shapes/limits/comm_sq.lean` +as `is_pullback` and `is_pushout` in order to define pullback and pushout squares. + +## Future work + +Refactor `lift_struct` from `arrow.lean` and lifting properties using `comm_sq.lean`. + +-/ + +namespace category_theory + +variables {C : Type*} [category C] + +/-- The proposition that a square +``` + W ---f---> X + | | + g h + | | + v v + Y ---i---> Z + +``` +is a commuting square. +-/ +structure comm_sq {W X Y Z : C} (f : W ⟶ X) (g : W ⟶ Y) (h : X ⟶ Z) (i : Y ⟶ Z) : Prop := +(w : f ≫ h = g ≫ i) + +attribute [reassoc] comm_sq.w + +namespace comm_sq + +variables {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + +lemma flip (p : comm_sq f g h i) : comm_sq g f i h := ⟨p.w.symm⟩ + +lemma of_arrow {f g : arrow C} (h : f ⟶ g) : comm_sq f.hom h.left h.right g.hom := ⟨h.w.symm⟩ + +/-- The commutative square in the opposite category associated to a commutative square. -/ +lemma op (p : comm_sq f g h i) : comm_sq i.op h.op g.op f.op := +⟨by simp only [← op_comp, p.w]⟩ + +/-- The commutative square associated to a commutative square in the opposite category. -/ +lemma unop {W X Y Z : Cᵒᵖ} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + (p : comm_sq f g h i) : comm_sq i.unop h.unop g.unop f.unop := +⟨by simp only [← unop_comp, p.w]⟩ + +end comm_sq + +namespace functor + +variables {D : Type*} [category D] +variables (F : C ⥤ D) {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + +lemma map_comm_sq (s : comm_sq f g h i) : comm_sq (F.map f) (F.map g) (F.map h) (F.map i) := +⟨by simpa using congr_arg (λ k : W ⟶ Z, F.map k) s.w⟩ + +end functor + +alias functor.map_comm_sq ← comm_sq.map + +namespace comm_sq + +variables {A B X Y : C} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y} + +/-- The datum of a lift in a commutative square, i.e. a up-right-diagonal +morphism which makes both triangles commute. -/ +@[ext, nolint has_nonempty_instance] +structure lift_struct (sq : comm_sq f i p g) := +(l : B ⟶ X) (fac_left' : i ≫ l = f) (fac_right' : l ≫ p = g) + +namespace lift_struct + +restate_axiom fac_left' +restate_axiom fac_right' + +/-- A `lift_struct` for a commutative square gives a `lift_struct` for the +corresponding square in the opposite category. -/ +@[simps] +def op {sq : comm_sq f i p g} (l : lift_struct sq) : lift_struct sq.op := +{ l := l.l.op, + fac_left' := by rw [← op_comp, l.fac_right], + fac_right' := by rw [← op_comp, l.fac_left], } + +/-- A `lift_struct` for a commutative square in the opposite category +gives a `lift_struct` for the corresponding square in the original category. -/ +@[simps] +def unop {A B X Y : Cᵒᵖ} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y} {sq : comm_sq f i p g} + (l : lift_struct sq) : lift_struct sq.unop := +{ l := l.l.unop, + fac_left' := by rw [← unop_comp, l.fac_right], + fac_right' := by rw [← unop_comp, l.fac_left], } + +/-- Equivalences of `lift_struct` for a square and the corresponding square +in the opposite category. -/ +@[simps] +def op_equiv (sq : comm_sq f i p g) : lift_struct sq ≃ lift_struct sq.op := +{ to_fun := op, + inv_fun := unop, + left_inv := by tidy, + right_inv := by tidy, } + +/-- Equivalences of `lift_struct` for a square in the oppositive category and +the corresponding square in the original category. -/ +def unop_equiv {A B X Y : Cᵒᵖ} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y} + (sq : comm_sq f i p g) : lift_struct sq ≃ lift_struct sq.unop := +{ to_fun := unop, + inv_fun := op, + left_inv := by tidy, + right_inv := by tidy, } + +end lift_struct + +instance subsingleton_lift_struct_of_epi (sq : comm_sq f i p g) [epi i] : + subsingleton (lift_struct sq) := +⟨λ l₁ l₂, by { ext, simp only [← cancel_epi i, lift_struct.fac_left], }⟩ + +instance subsingleton_lift_struct_of_mono (sq : comm_sq f i p g) [mono p] : + subsingleton (lift_struct sq) := +⟨λ l₁ l₂, by { ext, simp only [← cancel_mono p, lift_struct.fac_right], }⟩ + +variable (sq : comm_sq f i p g) + +/-- The assertion that a square has a `lift_struct`. -/ +class has_lift : Prop := (exists_lift : nonempty sq.lift_struct) + +namespace has_lift + +variable {sq} + +lemma mk' (l : sq.lift_struct) : has_lift sq := ⟨nonempty.intro l⟩ + +variable (sq) + +lemma iff : has_lift sq ↔ nonempty sq.lift_struct := +by { split, exacts [λ h, h.exists_lift, λ h, mk h], } + +lemma iff_op : has_lift sq ↔ has_lift sq.op := +begin + rw [iff, iff], + exact nonempty.congr (lift_struct.op_equiv sq).to_fun (lift_struct.op_equiv sq).inv_fun, +end + +lemma iff_unop {A B X Y : Cᵒᵖ} {f : A ⟶ X} {i : A ⟶ B} {p : X ⟶ Y} {g : B ⟶ Y} + (sq : comm_sq f i p g) : has_lift sq ↔ has_lift sq.unop := +begin + rw [iff, iff], + exact nonempty.congr (lift_struct.unop_equiv sq).to_fun (lift_struct.unop_equiv sq).inv_fun, +end + +end has_lift + +/-- A choice of a diagonal morphism that is part of a `lift_struct` when +the square has a lift. -/ +noncomputable +def lift [hsq : has_lift sq] : B ⟶ X := +hsq.exists_lift.some.l + +@[simp, reassoc] +lemma fac_left [hsq : has_lift sq] : i ≫ sq.lift = f := +hsq.exists_lift.some.fac_left + +@[simp, reassoc] +lemma fac_right [hsq : has_lift sq] : sq.lift ≫ p = g := +hsq.exists_lift.some.fac_right + +end comm_sq + +end category_theory diff --git a/src/category_theory/comma.lean b/src/category_theory/comma.lean index 15215ad7ea483..c78fa975d0b0a 100644 --- a/src/category_theory/comma.lean +++ b/src/category_theory/comma.lean @@ -10,6 +10,9 @@ import category_theory.eq_to_hom /-! # Comma categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A comma category is a construction in category theory, which builds a category out of two functors with a common codomain. Specifically, for functors `L : A ⥤ T` and `R : B ⥤ T`, an object in `comma L R` is a morphism `hom : L.obj left ⟶ R.obj right` for some objects `left : A` and @@ -55,8 +58,8 @@ variables {T : Type u₃} [category.{v₃} T] /-- The objects of the comma category are triples of an object `left : A`, an object `right : B` and a morphism `hom : L.obj left ⟶ R.obj right`. -/ structure comma (L : A ⥤ T) (R : B ⥤ T) : Type (max u₁ u₂ v₃) := -(left : A . obviously) -(right : B . obviously) +(left : A) +(right : B) (hom : L.obj left ⟶ R.obj right) -- Satisfying the inhabited linter @@ -72,8 +75,8 @@ variables {L : A ⥤ T} {R : B ⥤ T} morphisms coming from the two objects using morphisms in the image of the functors `L` and `R`. -/ @[ext] structure comma_morphism (X Y : comma L R) := -(left : X.left ⟶ Y.left . obviously) -(right : X.right ⟶ Y.right . obviously) +(left : X.left ⟶ Y.left) +(right : X.right ⟶ Y.right) (w' : L.map left ≫ Y.hom = X.hom ≫ R.map right . obviously) -- Satisfying the inhabited linter diff --git a/src/category_theory/concrete_category/basic.lean b/src/category_theory/concrete_category/basic.lean index a565d66e9e774..0029fae725175 100644 --- a/src/category_theory/concrete_category/basic.lean +++ b/src/category_theory/concrete_category/basic.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Johannes Hölzl, Reid Barton, Sean Leather, Yury Kudryashov -/ import category_theory.types -import category_theory.epi_mono +import category_theory.functor.epi_mono +import category_theory.limits.constructions.epi_mono /-! # Concrete categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A concrete category is a category `C` with a fixed faithful functor `forget : C ⥤ Type*`. We define concrete categories using `class concrete_category`. In particular, we impose no restrictions on the @@ -34,10 +38,12 @@ See [Ahrens and Lumsdaine, *Displayed Categories*][ahrens2017] for related work. -/ -universes w v v' u +universes w v v' u u' namespace category_theory +open category_theory.limits + /-- A concrete category is a category `C` with a fixed faithful functor `forget : C ⥤ Type`. @@ -54,7 +60,7 @@ class concrete_category (C : Type u) [category.{v} C] := attribute [instance] concrete_category.forget_faithful /-- The forgetful functor from a concrete category to `Type u`. -/ -@[reducible] def forget (C : Type v) [category C] [concrete_category.{u} C] : C ⥤ Type u := +@[reducible] def forget (C : Type u) [category.{v} C] [concrete_category.{w} C] : C ⥤ Type w := concrete_category.forget C instance concrete_category.types : concrete_category (Type u) := @@ -69,14 +75,14 @@ You can use it on particular examples as: instance : has_coe_to_sort X := concrete_category.has_coe_to_sort X ``` -/ -def concrete_category.has_coe_to_sort (C : Type v) [category C] [concrete_category C] : - has_coe_to_sort C (Type u) := +def concrete_category.has_coe_to_sort (C : Type u) [category.{v} C] [concrete_category.{w} C] : + has_coe_to_sort C (Type w) := ⟨(concrete_category.forget C).obj⟩ section local attribute [instance] concrete_category.has_coe_to_sort -variables {C : Type v} [category C] [concrete_category C] +variables {C : Type u} [category.{v} C] [concrete_category.{w} C] @[simp] lemma forget_obj_eq_coe {X : C} : (forget C).obj X = X := rfl @@ -118,13 +124,6 @@ congr_fun ((forget _).map_id X) x (f ≫ g) x = g (f x) := congr_fun ((forget _).map_comp _ _) x -@[simp] lemma coe_hom_inv_id {X Y : C} (f : X ≅ Y) (x : X) : - f.inv (f.hom x) = x := -congr_fun ((forget C).map_iso f).hom_inv_id x -@[simp] lemma coe_inv_hom_id {X Y : C} (f : X ≅ Y) (y : Y) : - f.hom (f.inv y) = y := -congr_fun ((forget C).map_iso f).inv_hom_id y - lemma concrete_category.congr_hom {X Y : C} {f g : X ⟶ Y} (h : f = g) (x : X) : f x = g x := congr_fun (congr_arg (λ f : X ⟶ Y, (f : X → Y)) h) x @@ -134,12 +133,32 @@ congr_arg (f : X → Y) h /-- In any concrete category, injective morphisms are monomorphisms. -/ lemma concrete_category.mono_of_injective {X Y : C} (f : X ⟶ Y) (i : function.injective f) : mono f := -faithful_reflects_mono (forget C) ((mono_iff_injective f).2 i) +(forget C).mono_of_mono_map ((mono_iff_injective f).2 i) + +lemma concrete_category.injective_of_mono_of_preserves_pullback {X Y : C} (f : X ⟶ Y) [mono f] + [preserves_limits_of_shape walking_cospan (forget C)] : function.injective f := +(mono_iff_injective ((forget C).map f)).mp infer_instance + +lemma concrete_category.mono_iff_injective_of_preserves_pullback {X Y : C} (f : X ⟶ Y) + [preserves_limits_of_shape walking_cospan (forget C)] : mono f ↔ function.injective f := +((forget C).mono_map_iff_mono _).symm.trans (mono_iff_injective _) /-- In any concrete category, surjective morphisms are epimorphisms. -/ lemma concrete_category.epi_of_surjective {X Y : C} (f : X ⟶ Y) (s : function.surjective f) : epi f := -faithful_reflects_epi (forget C) ((epi_iff_surjective f).2 s) +(forget C).epi_of_epi_map ((epi_iff_surjective f).2 s) + +lemma concrete_category.surjective_of_epi_of_preserves_pushout {X Y : C} (f : X ⟶ Y) [epi f] + [preserves_colimits_of_shape walking_span (forget C)] : function.surjective f := +(epi_iff_surjective ((forget C).map f)).mp infer_instance + +lemma concrete_category.epi_iff_surjective_of_preserves_pushout {X Y : C} (f : X ⟶ Y) + [preserves_colimits_of_shape walking_span (forget C)] : epi f ↔ function.surjective f := +((forget C).epi_map_iff_epi _).symm.trans (epi_iff_surjective _) + +lemma concrete_category.bijective_of_is_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : + function.bijective ((forget C).map f) := +by { rw ← is_iso_iff_bijective, apply_instance, } @[simp] lemma concrete_category.has_coe_to_fun_Type {X Y : Type u} (f : X ⟶ Y) : coe_fn f = f := @@ -151,38 +170,55 @@ end `has_forget₂ C D`, where `C` and `D` are both concrete categories, provides a functor `forget₂ C D : C ⥤ D` and a proof that `forget₂ ⋙ (forget D) = forget C`. -/ -class has_forget₂ (C : Type v) (D : Type v') [category C] [concrete_category.{u} C] [category D] - [concrete_category.{u} D] := +class has_forget₂ (C : Type u) (D : Type u') [category.{v} C] [concrete_category.{w} C] + [category.{v'} D] [concrete_category.{w} D] := (forget₂ : C ⥤ D) (forget_comp : forget₂ ⋙ (forget D) = forget C . obviously) /-- The forgetful functor `C ⥤ D` between concrete categories for which we have an instance `has_forget₂ C `. -/ -@[reducible] def forget₂ (C : Type v) (D : Type v') [category C] [concrete_category C] [category D] - [concrete_category D] [has_forget₂ C D] : C ⥤ D := +@[reducible] def forget₂ (C : Type u) (D : Type u') [category.{v} C] [concrete_category.{w} C] + [category.{v'} D] [concrete_category.{w} D] [has_forget₂ C D] : C ⥤ D := has_forget₂.forget₂ -instance forget_faithful (C : Type v) (D : Type v') [category C] [concrete_category C] [category D] - [concrete_category D] [has_forget₂ C D] : faithful (forget₂ C D) := +instance forget₂_faithful (C : Type u) (D : Type u') [category.{v} C] [concrete_category.{w} C] + [category.{v'} D] [concrete_category.{w} D] [has_forget₂ C D] : faithful (forget₂ C D) := has_forget₂.forget_comp.faithful_of_comp -instance induced_category.concrete_category {C : Type v} {D : Type v'} [category D] - [concrete_category D] (f : C → D) : - concrete_category (induced_category D f) := +instance forget₂_preserves_monomorphisms (C : Type u) (D : Type u') + [category.{v} C] [concrete_category.{w} C] + [category.{v'} D] [concrete_category.{w} D] [has_forget₂ C D] + [(forget C).preserves_monomorphisms] : (forget₂ C D).preserves_monomorphisms := +have (forget₂ C D ⋙ forget D).preserves_monomorphisms, + by { simp only [has_forget₂.forget_comp], apply_instance }, +by exactI functor.preserves_monomorphisms_of_preserves_of_reflects _ (forget D) + +instance forget₂_preserves_epimorphisms (C : Type u) (D : Type u') + [category.{v} C] [concrete_category.{w} C] + [category.{v'} D] [concrete_category.{w} D] [has_forget₂ C D] + [(forget C).preserves_epimorphisms] : (forget₂ C D).preserves_epimorphisms := +have (forget₂ C D ⋙ forget D).preserves_epimorphisms, + by { simp only [has_forget₂.forget_comp], apply_instance }, +by exactI functor.preserves_epimorphisms_of_preserves_of_reflects _ (forget D) + +instance induced_category.concrete_category {C : Type u} {D : Type u'} [category.{v'} D] + [concrete_category.{w} D] (f : C → D) : + concrete_category.{w} (induced_category D f) := { forget := induced_functor f ⋙ forget D } -instance induced_category.has_forget₂ {C : Type v} {D : Type v'} [category D] [concrete_category D] +instance induced_category.has_forget₂ + {C : Type u} {D : Type u'} [category.{v'} D] [concrete_category.{w} D] (f : C → D) : has_forget₂ (induced_category D f) D := { forget₂ := induced_functor f, forget_comp := rfl } -instance full_subcategory.concrete_category {C : Type v} [category C] [concrete_category C] - (Z : C → Prop) : concrete_category {X : C // Z X} := +instance full_subcategory.concrete_category {C : Type u} [category.{v} C] [concrete_category.{w} C] + (Z : C → Prop) : concrete_category (full_subcategory Z) := { forget := full_subcategory_inclusion Z ⋙ forget C } -instance full_subcategory.has_forget₂ {C : Type v} [category C] [concrete_category C] - (Z : C → Prop) : has_forget₂ {X : C // Z X} C := +instance full_subcategory.has_forget₂ {C : Type u} [category.{v} C] [concrete_category.{w} C] + (Z : C → Prop) : has_forget₂ (full_subcategory Z) C := { forget₂ := full_subcategory_inclusion Z, forget_comp := rfl } @@ -190,16 +226,19 @@ instance full_subcategory.has_forget₂ {C : Type v} [category C] [concrete_cate In order to construct a “partially forgetting” functor, we do not need to verify functor laws; it suffices to ensure that compositions agree with `forget₂ C D ⋙ forget D = forget C`. -/ -def has_forget₂.mk' {C : Type v} {D : Type v'} [category C] [concrete_category C] [category D] - [concrete_category D] (obj : C → D) (h_obj : ∀ X, (forget D).obj (obj X) = (forget C).obj X) +def has_forget₂.mk' {C : Type u} {D : Type u'} [category.{v} C] [concrete_category.{w} C] + [category.{v'} D] [concrete_category.{w} D] (obj : C → D) + (h_obj : ∀ X, (forget D).obj (obj X) = (forget C).obj X) (map : Π {X Y}, (X ⟶ Y) → (obj X ⟶ obj Y)) (h_map : ∀ {X Y} {f : X ⟶ Y}, (forget D).map (map f) == (forget C).map f) : has_forget₂ C D := { forget₂ := faithful.div _ _ _ @h_obj _ @h_map, forget_comp := by apply faithful.div_comp } -instance has_forget_to_Type (C : Type v) [category C] [concrete_category C] : - has_forget₂ C (Type u) := +/-- Every forgetful functor factors through the identity functor. This is not a global instance as + it is prone to creating type class resolution loops. -/ +def has_forget_to_Type (C : Type u) [category.{v} C] [concrete_category.{w} C] : + has_forget₂ C (Type w) := { forget₂ := forget C, forget_comp := functor.comp_id _ } diff --git a/src/category_theory/concrete_category/bundled.lean b/src/category_theory/concrete_category/bundled.lean index 419621b09a5bf..781996dcc4bbb 100644 --- a/src/category_theory/concrete_category/bundled.lean +++ b/src/category_theory/concrete_category/bundled.lean @@ -3,11 +3,14 @@ Copyright (c) 2018 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Johannes Hölzl, Reid Barton, Sean Leather -/ -import tactic.pi_instances +import tactic.lint /-! # Bundled types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `bundled c` provides a uniform structure for bundling a type equipped with a type class. We provide `category` instances for these in `category_theory/unbundled_hom.lean` @@ -22,7 +25,7 @@ variables {c d : Type u → Type v} {α : Type u} /-- `bundled` is a type bundled with a type class instance for that type. Only the type class is exposed as a parameter. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure bundled (c : Type u → Type v) : Type (max (u+1) v) := (α : Type u) (str : c α . tactic.apply_instance) diff --git a/src/category_theory/concrete_category/bundled_hom.lean b/src/category_theory/concrete_category/bundled_hom.lean index 0791c841b0509..7676d31b2ea94 100644 --- a/src/category_theory/concrete_category/bundled_hom.lean +++ b/src/category_theory/concrete_category/bundled_hom.lean @@ -9,6 +9,9 @@ import category_theory.concrete_category.bundled /-! # Category instances for algebraic structures that use bundled homs. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Many algebraic structures in Lean initially used unbundled homs (e.g. a bare function between types, along with an `is_monoid_hom` typeclass), but the general trend is towards using bundled homs. diff --git a/src/category_theory/concrete_category/default.lean b/src/category_theory/concrete_category/default.lean deleted file mode 100644 index 72e4679426489..0000000000000 --- a/src/category_theory/concrete_category/default.lean +++ /dev/null @@ -1 +0,0 @@ -import category_theory.concrete_category.unbundled_hom diff --git a/src/category_theory/concrete_category/elementwise.lean b/src/category_theory/concrete_category/elementwise.lean index e3a3674edf602..e41d647a4eaed 100644 --- a/src/category_theory/concrete_category/elementwise.lean +++ b/src/category_theory/concrete_category/elementwise.lean @@ -6,8 +6,13 @@ Authors: Andrew Yang import tactic.elementwise import category_theory.limits.has_limits import category_theory.limits.shapes.kernels +import category_theory.concrete_category.basic +import tactic.fresh_names /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we provide various simp lemmas in its elementwise form via `tactic.elementwise`. -/ @@ -17,6 +22,3 @@ attribute [elementwise] cone.w limit.lift_π limit.w cocone.w colimit.ι_desc colimit.w kernel.lift_ι cokernel.π_desc kernel.condition cokernel.condition - -- Note that the elementwise forms of `iso.hom_inv_id` and `iso.inv_hom_id` are already - -- provided as `category_theory.coe_hom_inv_id` and `category_theory.coe_inv_hom_id`. - is_iso.hom_inv_id is_iso.inv_hom_id diff --git a/src/category_theory/concrete_category/reflects_isomorphisms.lean b/src/category_theory/concrete_category/reflects_isomorphisms.lean index b87261233dd51..c604560f6369f 100644 --- a/src/category_theory/concrete_category/reflects_isomorphisms.lean +++ b/src/category_theory/concrete_category/reflects_isomorphisms.lean @@ -7,6 +7,9 @@ import category_theory.concrete_category.basic import category_theory.functor.reflects_isomorphisms /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A `forget₂ C D` forgetful functor between concrete categories `C` and `D` whose forgetful functors both reflect isomorphisms, itself reflects isomorphisms. -/ diff --git a/src/category_theory/concrete_category/unbundled_hom.lean b/src/category_theory/concrete_category/unbundled_hom.lean index ba9dab6848131..22237c3b072b5 100644 --- a/src/category_theory/concrete_category/unbundled_hom.lean +++ b/src/category_theory/concrete_category/unbundled_hom.lean @@ -8,6 +8,9 @@ import category_theory.concrete_category.bundled_hom /-! # Category instances for structures that use unbundled homs +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides basic infrastructure to define concrete categories using unbundled homs (see `class unbundled_hom`), and define forgetful functors between them (see diff --git a/src/category_theory/conj.lean b/src/category_theory/conj.lean index ffd088fa0e901..0b16aede4368d 100644 --- a/src/category_theory/conj.lean +++ b/src/category_theory/conj.lean @@ -3,11 +3,15 @@ Copyright (c) 2019 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ +import algebra.hom.equiv.units.basic import category_theory.endomorphism /-! # Conjugate morphisms by isomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An isomorphism `α : X ≅ Y` defines - a monoid isomorphism `conj : End X ≃* End Y` by `α.conj f = α.inv ≫ f ≫ α.hom`; - a group isomorphism `conj_Aut : Aut X ≃* Aut Y` by `α.conj_Aut f = α.symm ≪≫ f ≪≫ α`. diff --git a/src/category_theory/connected_components.lean b/src/category_theory/connected_components.lean index e4f1e2bc3d2f1..a04a891f964cf 100644 --- a/src/category_theory/connected_components.lean +++ b/src/category_theory/connected_components.lean @@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ import data.list.chain -import category_theory.punit import category_theory.is_connected import category_theory.sigma.basic import category_theory.full_subcategory @@ -12,6 +11,9 @@ import category_theory.full_subcategory /-! # Connected components of a category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines a type `connected_components J` indexing the connected components of a category, and the full subcategories giving each connected component: `component j : Type u₁`. We show that each `component j` is in fact connected. @@ -41,7 +43,7 @@ instance [inhabited J] : inhabited (connected_components J) := ⟨quotient.mk' d /-- Given an index for a connected component, produce the actual component as a full subcategory. -/ @[derive category] -def component (j : connected_components J) : Type u₁ := {k : J // quotient.mk' k = j} +def component (j : connected_components J) : Type u₁ := full_subcategory (λ k, quotient.mk' k = j) /-- The inclusion functor from a connected component to the whole category. -/ @[derive [full, faithful], simps {rhs_md := semireducible}] @@ -82,7 +84,7 @@ begin { refine @@list.chain_pmap_of_chain _ _ _ f (λ x y _ _ h, _) hl₁ h₁₂ _, exact zag_of_zag_obj (component.ι _) h }, { erw list.last_pmap _ f (j₁ :: l) (by simpa [h₁₂] using hf) (list.cons_ne_nil _ _), - exact subtype.ext hl₂ }, + exact full_subcategory.ext _ _ hl₂ }, end /-- @@ -135,7 +137,7 @@ instance : full (decomposed_to J) := instance : faithful (decomposed_to J) := { map_injective' := begin - rintro ⟨_, j, rfl⟩ ⟨_, k, hY⟩ ⟨_, _, _, f⟩ ⟨_, _, _, g⟩ e, + rintro ⟨_, j, rfl⟩ ⟨_, k, hY⟩ ⟨f⟩ ⟨g⟩ e, change f = g at e, subst e, end } diff --git a/src/category_theory/core.lean b/src/category_theory/core.lean index 5f583ecb9e1f6..2311c8fe3d085 100644 --- a/src/category_theory/core.lean +++ b/src/category_theory/core.lean @@ -11,6 +11,9 @@ import category_theory.types /-! # The core of a category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The core of a category `C` is the (non-full) subcategory of `C` consisting of all objects, and all isomorphisms. We construct it as a `groupoid`. @@ -26,7 +29,7 @@ universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note /-- The core of a category C is the groupoid whose morphisms are all the isomorphisms of C. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def core (C : Type u₁) := C variables {C : Type u₁} [category.{v₁} C] diff --git a/src/category_theory/differential_object.lean b/src/category_theory/differential_object.lean index 3ea1d59ac7a49..38865e33667c7 100644 --- a/src/category_theory/differential_object.lean +++ b/src/category_theory/differential_object.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import data.int.basic -import category_theory.shift +import category_theory.shift.basic import category_theory.concrete_category.basic /-! # Differential objects in a category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A differential object in a category with zero morphisms and a shift is an object `X` equipped with a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`. @@ -27,7 +30,7 @@ namespace category_theory variables (C : Type u) [category.{v} C] --- TODO: generaize to `has_shift C A` for an arbitrary `[add_monoid A]` `[has_one A]`. +-- TODO: generalize to `has_shift C A` for an arbitrary `[add_monoid A]` `[has_one A]`. variables [has_zero_morphisms C] [has_shift C ℤ] /-- @@ -35,7 +38,7 @@ A differential object in a category with zero morphisms and a shift is an object `X` equipped with a morphism `d : X ⟶ X⟦1⟧`, such that `d^2 = 0`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure differential_object := (X : C) (d : X ⟶ X⟦1⟧) @@ -51,7 +54,7 @@ namespace differential_object /-- A morphism of differential objects is a morphism commuting with the differentials. -/ -@[ext, nolint has_inhabited_instance] +@[ext, nolint has_nonempty_instance] structure hom (X Y : differential_object C) := (f : X.X ⟶ Y.X) (comm' : X.d ≫ f⟦1⟧' = f ≫ Y.d . obviously) @@ -220,38 +223,42 @@ def shift_functor (n : ℤ) : differential_object C ⥤ differential_object C := ←functor.map_comp_assoc, X.d_squared, functor.map_zero, zero_comp] }, map := λ X Y f, { f := f.f⟦n⟧', - comm' := by { dsimp, rw [category.assoc, shift_comm_hom_comp, ← functor.map_comp_assoc, - f.comm, functor.map_comp_assoc], }, }, + comm' := begin + dsimp, + erw [category.assoc, shift_comm_hom_comp, ← functor.map_comp_assoc, f.comm, + functor.map_comp_assoc], + refl, + end, }, map_id' := by { intros X, ext1, dsimp, rw functor.map_id }, map_comp' := by { intros X Y Z f g, ext1, dsimp, rw functor.map_comp } } -local attribute [reducible] discrete.add_monoidal shift_comm - /-- The shift functor on `differential_object C` is additive. -/ @[simps] def shift_functor_add (m n : ℤ) : shift_functor C (m + n) ≅ shift_functor C m ⋙ shift_functor C n := begin refine nat_iso.of_components (λ X, mk_iso (shift_add X.X _ _) _) _, { dsimp, - simp_rw [category.assoc, obj_μ_inv_app, μ_inv_hom_app_assoc, functor.map_comp, obj_μ_app, - category.assoc, μ_naturality_assoc, μ_inv_hom_app_assoc, obj_μ_inv_app, category.assoc, - μ_naturalityₗ_assoc, μ_inv_hom_app_assoc, μ_inv_naturalityᵣ_assoc], - simp [opaque_eq_to_iso] }, + rw [← cancel_epi ((shift_functor_add C m n).inv.app X.X)], + simp only [category.assoc, iso.inv_hom_id_app_assoc], + erw [← nat_trans.naturality_assoc], + dsimp, + simp only [functor.map_comp, category.assoc, + shift_functor_comm_hom_app_comp_shift_shift_functor_add_hom_app 1 m n X.X, + iso.inv_hom_id_app_assoc], }, { intros X Y f, ext, dsimp, exact nat_trans.naturality _ _ } end -local attribute [reducible] endofunctor_monoidal_category - section -local attribute [instance] endofunctor_monoidal_category /-- The shift by zero is naturally isomorphic to the identity. -/ @[simps] -def shift_ε : 𝟭 (differential_object C) ≅ shift_functor C 0 := +def shift_zero : shift_functor C 0 ≅ 𝟭 (differential_object C) := begin - refine nat_iso.of_components (λ X, mk_iso ((shift_monoidal_functor C ℤ).ε_iso.app X.X) _) _, - { dsimp, simp, dsimp, simp }, - { introv, ext, dsimp, simp } + refine nat_iso.of_components (λ X, mk_iso ((shift_functor_zero C ℤ).app X.X) _) _, + { erw [← nat_trans.naturality], + dsimp, + simp only [shift_functor_zero_hom_app_shift, category.assoc], }, + { tidy, }, end end @@ -259,8 +266,24 @@ end instance : has_shift (differential_object C) ℤ := has_shift_mk _ _ { F := shift_functor C, - ε := shift_ε C, - μ := λ m n, (shift_functor_add C m n).symm } + zero := shift_zero C, + add := shift_functor_add C, + assoc_hom_app := λ m₁ m₂ m₃ X, begin + ext1, + convert shift_functor_add_assoc_hom_app m₁ m₂ m₃ X.X, + dsimp [shift_functor_add'], + simpa, + end, + zero_add_hom_app := λ n X, begin + ext1, + convert shift_functor_add_zero_add_hom_app n X.X, + simpa, + end, + add_zero_hom_app := λ n X, begin + ext1, + convert shift_functor_add_add_zero_hom_app n X.X, + simpa, + end, } end differential_object diff --git a/src/category_theory/discrete_category.lean b/src/category_theory/discrete_category.lean index f5278f965861a..fb4f2e90d6442 100644 --- a/src/category_theory/discrete_category.lean +++ b/src/category_theory/discrete_category.lean @@ -9,8 +9,12 @@ import data.ulift /-! # Discrete categories -We define `discrete α := α` for any type `α`, and use this type alias -to provide a `small_category` instance whose only morphisms are the identities. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define `discrete α` as a structure containing a term `a : α` for any type `α`, +and use this type alias to provide a `small_category` instance +whose only morphisms are the identities. There is an annoying technical difficulty that it has turned out to be inconvenient to allow categories with morphisms living in `Prop`, @@ -33,13 +37,30 @@ discrete categories. namespace category_theory -- morphism levels before object levels. See note [category_theory universes]. -universes v₁ v₂ v₃ u₁ u₂ u₃ +universes v₁ v₂ v₃ u₁ u₁' u₂ u₃ /-- -A type synonym for promoting any type to a category, +A wrapper for promoting any type to a category, with the only morphisms being equalities. -/ -def discrete (α : Type u₁) := α +-- This is intentionally a structure rather than a type synonym +-- to enforce using `discrete_equiv` (or `discrete.mk` and `discrete.as`) to move between +-- `discrete α` and `α`. Otherwise there is too much API leakage. +@[ext] structure discrete (α : Type u₁) := +(as : α) + +@[simp] lemma discrete.mk_as {α : Type u₁} (X : discrete α) : discrete.mk X.as = X := +by { ext, refl, } + +/-- `discrete α` is equivalent to the original type `α`.-/ +@[simps] def discrete_equiv {α : Type u₁} : discrete α ≃ α := +{ to_fun := discrete.as, + inv_fun := discrete.mk, + left_inv := by tidy, + right_inv := by tidy, } + +instance {α : Type u₁} [decidable_eq α] : decidable_eq (discrete α) := +discrete_equiv.decidable_eq /-- The "discrete" category on a type, whose morphisms are equalities. @@ -50,24 +71,53 @@ somewhat annoyingly we have to define `X ⟶ Y` as `ulift (plift (X = Y))`. See -/ instance discrete_category (α : Type u₁) : small_category (discrete α) := -{ hom := λ X Y, ulift (plift (X = Y)), +{ hom := λ X Y, ulift (plift (X.as = Y.as)), id := λ X, ulift.up (plift.up rfl), - comp := λ X Y Z g f, by { rcases f with ⟨⟨rfl⟩⟩, exact g } } + comp := λ X Y Z g f, by { cases X, cases Y, cases Z, rcases f with ⟨⟨⟨⟩⟩⟩, exact g } } namespace discrete variables {α : Type u₁} instance [inhabited α] : inhabited (discrete α) := -by { dsimp [discrete], apply_instance } +⟨⟨default⟩⟩ instance [subsingleton α] : subsingleton (discrete α) := -by { dsimp [discrete], apply_instance } +⟨by { intros, ext, apply subsingleton.elim, }⟩ + +/-- A simple tactic to run `cases` on any `discrete α` hypotheses. -/ +meta def _root_.tactic.discrete_cases : tactic unit := +`[cases_matching* [discrete _, (_ : discrete _) ⟶ (_ : discrete _), plift _]] + +run_cmd add_interactive [``tactic.discrete_cases] + +local attribute [tidy] tactic.discrete_cases + +instance [unique α] : unique (discrete α) := +unique.mk' (discrete α) /-- Extract the equation from a morphism in a discrete category. -/ -lemma eq_of_hom {X Y : discrete α} (i : X ⟶ Y) : X = Y := i.down.down +lemma eq_of_hom {X Y : discrete α} (i : X ⟶ Y) : X.as = Y.as := i.down.down + +/-- Promote an equation between the wrapped terms in `X Y : discrete α` to a morphism `X ⟶ Y` +in the discrete category. -/ +abbreviation eq_to_hom {X Y : discrete α} (h : X.as = Y.as) : X ⟶ Y := +eq_to_hom (by { ext, exact h, }) + +/-- Promote an equation between the wrapped terms in `X Y : discrete α` to an isomorphism `X ≅ Y` +in the discrete category. -/ +abbreviation eq_to_iso {X Y : discrete α} (h : X.as = Y.as) : X ≅ Y := +eq_to_iso (by { ext, exact h, }) -@[simp] lemma id_def (X : discrete α) : ulift.up (plift.up (eq.refl X)) = 𝟙 X := rfl +/-- A variant of `eq_to_hom` that lifts terms to the discrete category. -/ +abbreviation eq_to_hom' {a b : α} (h : a = b) : discrete.mk a ⟶ discrete.mk b := +eq_to_hom h + +/-- A variant of `eq_to_iso` that lifts terms to the discrete category. -/ +abbreviation eq_to_iso' {a b : α} (h : a = b) : discrete.mk a ≅ discrete.mk b := +eq_to_iso h + +@[simp] lemma id_def (X : discrete α) : ulift.up (plift.up (eq.refl X.as)) = 𝟙 X := rfl variables {C : Type u₂} [category.{v₂} C] @@ -78,61 +128,58 @@ instance {I : Type u₁} {i j : discrete I} (f : i ⟶ j) : is_iso f := Any function `I → C` gives a functor `discrete I ⥤ C`. -/ def functor {I : Type u₁} (F : I → C) : discrete I ⥤ C := -{ obj := F, - map := λ X Y f, begin cases f, cases f, cases f, exact 𝟙 (F X) end } +{ obj := F ∘ discrete.as, + map := λ X Y f, by { discrete_cases, cases f, exact 𝟙 (F X), } } @[simp] lemma functor_obj {I : Type u₁} (F : I → C) (i : I) : - (discrete.functor F).obj i = F i := rfl + (discrete.functor F).obj (discrete.mk i) = F i := rfl lemma functor_map {I : Type u₁} (F : I → C) {i : discrete I} (f : i ⟶ i) : - (discrete.functor F).map f = 𝟙 (F i) := -by { cases f, cases f, cases f, refl } + (discrete.functor F).map f = 𝟙 (F i.as) := +by tidy + +/-- +The discrete functor induced by a composition of maps can be written as a +composition of two discrete functors. +-/ +@[simps] +def functor_comp {I : Type u₁} {J : Type u₁'} (f : J → C) (g : I → J) : + discrete.functor (f ∘ g) ≅ discrete.functor (discrete.mk ∘ g) ⋙ discrete.functor f := +nat_iso.of_components (λ X, iso.refl _) (by tidy) /-- For functors out of a discrete category, a natural transformation is just a collection of maps, as the naturality squares are trivial. -/ +@[simps] def nat_trans {I : Type u₁} {F G : discrete I ⥤ C} (f : Π i : discrete I, F.obj i ⟶ G.obj i) : F ⟶ G := -{ app := f } - -@[simp] lemma nat_trans_app {I : Type u₁} {F G : discrete I ⥤ C} - (f : Π i : discrete I, F.obj i ⟶ G.obj i) (i) : (discrete.nat_trans f).app i = f i := -rfl +{ app := f, + naturality' := λ X Y g, by { discrete_cases, cases g, simp, } } /-- For functors out of a discrete category, a natural isomorphism is just a collection of isomorphisms, as the naturality squares are trivial. -/ +@[simps] def nat_iso {I : Type u₁} {F G : discrete I ⥤ C} (f : Π i : discrete I, F.obj i ≅ G.obj i) : F ≅ G := -nat_iso.of_components f (by tidy) - -@[simp] -lemma nat_iso_hom_app {I : Type u₁} {F G : discrete I ⥤ C} - (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) : - (discrete.nat_iso f).hom.app i = (f i).hom := -rfl - -@[simp] -lemma nat_iso_inv_app {I : Type u₁} {F G : discrete I ⥤ C} - (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) : - (discrete.nat_iso f).inv.app i = (f i).inv := -rfl +nat_iso.of_components f (λ X Y g, by { discrete_cases, cases g, simp, }) @[simp] lemma nat_iso_app {I : Type u₁} {F G : discrete I ⥤ C} - (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : I) : + (f : Π i : discrete I, F.obj i ≅ G.obj i) (i : discrete I) : (discrete.nat_iso f).app i = f i := by tidy /-- Every functor `F` from a discrete category is naturally isomorphic (actually, equal) to `discrete.functor (F.obj)`. -/ @[simp] -def nat_iso_functor {I : Type u₁} {F : discrete I ⥤ C} : F ≅ discrete.functor (F.obj) := -nat_iso $ λ i, iso.refl _ +def nat_iso_functor {I : Type u₁} {F : discrete I ⥤ C} : + F ≅ discrete.functor (F.obj ∘ discrete.mk) := +nat_iso $ λ i, by { discrete_cases, refl, } /-- Composing `discrete.functor F` with another functor `G` amounts to composing `F` with `G.obj` -/ @[simp] @@ -146,18 +193,18 @@ an equivalence between the corresponding `discrete` categories. -/ @[simps] def equivalence {I : Type u₁} {J : Type u₂} (e : I ≃ J) : discrete I ≌ discrete J := -{ functor := discrete.functor (e : I → J), - inverse := discrete.functor (e.symm : J → I), - unit_iso := discrete.nat_iso (λ i, eq_to_iso (by simp)), - counit_iso := discrete.nat_iso (λ j, eq_to_iso (by simp)), } +{ functor := discrete.functor (discrete.mk ∘ (e : I → J)), + inverse := discrete.functor (discrete.mk ∘ (e.symm : J → I)), + unit_iso := discrete.nat_iso (λ i, eq_to_iso (by { discrete_cases, simp })), + counit_iso := discrete.nat_iso (λ j, eq_to_iso (by { discrete_cases, simp })), } /-- We can convert an equivalence of `discrete` categories to a type-level `equiv`. -/ @[simps] def equiv_of_equivalence {α : Type u₁} {β : Type u₂} (h : discrete α ≌ discrete β) : α ≃ β := -{ to_fun := h.functor.obj, - inv_fun := h.inverse.obj, - left_inv := λ a, eq_of_hom (h.unit_iso.app a).2, - right_inv := λ a, eq_of_hom (h.counit_iso.app a).1 } +{ to_fun := discrete.as ∘ h.functor.obj ∘ discrete.mk, + inv_fun := discrete.as ∘ h.inverse.obj ∘ discrete.mk, + left_inv := λ a, by simpa using eq_of_hom (h.unit_iso.app (discrete.mk a)).2, + right_inv := λ a, by simpa using eq_of_hom (h.counit_iso.app (discrete.mk a)).1, } end discrete @@ -167,11 +214,13 @@ variables {J : Type v₁} open opposite /-- A discrete category is equivalent to its opposite category. -/ +@[simps functor_obj_as inverse_obj] protected def opposite (α : Type u₁) : (discrete α)ᵒᵖ ≌ discrete α := -let F : discrete α ⥤ (discrete α)ᵒᵖ := discrete.functor (λ x, op x) in +let F : discrete α ⥤ (discrete α)ᵒᵖ := discrete.functor (λ x, op (discrete.mk x)) in begin - refine equivalence.mk (functor.left_op F) F _ (discrete.nat_iso $ λ X, by simp [F]), - refine nat_iso.of_components (λ X, by simp [F]) _, + refine equivalence.mk (functor.left_op F) F _ + (discrete.nat_iso $ λ X, by { discrete_cases, simp [F] }), + refine nat_iso.of_components (λ X, by { tactic.op_induction', discrete_cases, simp [F], }) _, tidy end diff --git a/src/category_theory/elements.lean b/src/category_theory/elements.lean index e1176ccd7a8b8..5ffe55cca2dc4 100644 --- a/src/category_theory/elements.lean +++ b/src/category_theory/elements.lean @@ -10,6 +10,9 @@ import category_theory.punit /-! # The category of elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the category of elements, also known as (a special case of) the Grothendieck construction. @@ -40,7 +43,7 @@ variables {C : Type u} [category.{v} C] The type of objects for the category of elements of a functor `F : C ⥤ Type` is a pair `(X : C, x : F.obj X)`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def functor.elements (F : C ⥤ Type w) := (Σ c : C, F.obj c) /-- The category structure on `F.elements`, for `F : C ⥤ Type`. @@ -99,7 +102,7 @@ def to_structured_arrow : F.elements ⥤ structured_arrow punit F := map := λ X Y f, structured_arrow.hom_mk f.val (by tidy) } @[simp] lemma to_structured_arrow_obj (X) : - (to_structured_arrow F).obj X = { left := punit.star, right := X.1, hom := λ _, X.2 } := rfl + (to_structured_arrow F).obj X = { left := ⟨⟨⟩⟩, right := X.1, hom := λ _, X.2 } := rfl @[simp] lemma to_comma_map_right {X Y} (f : X ⟶ Y) : ((to_structured_arrow F).map f).right = f.val := rfl @@ -120,7 +123,7 @@ def structured_arrow_equivalence : F.elements ≌ structured_arrow punit F := equivalence.mk (to_structured_arrow F) (from_structured_arrow F) (nat_iso.of_components (λ X, eq_to_iso (by tidy)) (by tidy)) (nat_iso.of_components - (λ X, { hom := { right := 𝟙 _ }, inv := { right := 𝟙 _ } }) + (λ X, structured_arrow.iso_mk (iso.refl _) (by tidy)) (by tidy)) open opposite @@ -195,8 +198,8 @@ begin simp only [quiver.hom.unop_op, yoneda_obj_map], erw category.comp_id }, intros X Y f, - cases X, cases Y, cases f, cases X_right, cases Y_right, - simp[costructured_arrow.hom_mk], + rcases X with ⟨X_left, ⟨⟨⟩⟩⟩, rcases Y with ⟨Y_left, ⟨⟨⟩⟩⟩, cases f, + simp [costructured_arrow.hom_mk], delta costructured_arrow.mk, congr, { ext x f, diff --git a/src/category_theory/elementwise.lean b/src/category_theory/elementwise.lean new file mode 100644 index 0000000000000..e88f0387888e4 --- /dev/null +++ b/src/category_theory/elementwise.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2021 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import tactic.elementwise +import category_theory.concrete_category.basic + +/-! +# Use the `elementwise` attribute to create applied versions of lemmas. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Usually we would use `@[elementwise]` at the point of definition, +however some early parts of the category theory library are imported by `tactic.elementwise`, +so we need to add the attribute after the fact. +-/ + +/-! We now add some `elementwise` attributes to lemmas that were proved earlier. -/ +open category_theory + +-- This list is incomplete, and it would probably be useful to add more. +attribute [elementwise] iso.hom_inv_id iso.inv_hom_id is_iso.hom_inv_id is_iso.inv_hom_id diff --git a/src/category_theory/endofunctor/algebra.lean b/src/category_theory/endofunctor/algebra.lean index a43e576f52275..42a453ec5d005 100644 --- a/src/category_theory/endofunctor/algebra.lean +++ b/src/category_theory/endofunctor/algebra.lean @@ -3,17 +3,27 @@ Copyright (c) 2022 Joseph Hua. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Bhavik Mehta, Johan Commelin, Reid Barton, Rob Lewis, Joseph Hua -/ -import category_theory.limits.final import category_theory.functor.reflects_isomorphisms +import category_theory.limits.shapes.terminal /-! + # Algebras of endofunctors -This file defines algebras of an endofunctor, -and provides the category instance for them. -This extends to Eilenberg-Moore (co)algebras for a (co)monad. -It also defines the forgetful functor from the category of algebras. -It is shown that the structure map of the initial algebra of an endofunctor -is an isomorphism. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines (co)algebras of an endofunctor, and provides the category instance for them. +It also defines the forgetful functor from the category of (co)algebras. It is shown that the +structure map of the initial algebra of an endofunctor is an isomorphism. Furthermore, it is shown +that for an adjunction `F ⊣ G` the category of algebras over `F` is equivalent to the category of +coalgebras over `G`. + +## TODO + +* Prove the dual result about the structure map of the terminal coalgebra of an endofunctor. +* Prove that if the countable infinite product over the powers of the endofunctor exists, then + algebras over the endofunctor coincide with algebras over the free monad on the endofunctor. -/ universes v u @@ -108,6 +118,14 @@ instance forget_reflects_iso : reflects_isomorphisms (forget F) := instance forget_faithful : faithful (forget F) := {} +/-- An algebra morphism with an underlying epimorphism hom in `C` is an algebra epimorphism. -/ +lemma epi_of_epi {X Y : algebra F} (f : X ⟶ Y) [h : epi f.1] : epi f := +(forget F).epi_of_epi_map h + +/-- An algebra morphism with an underlying monomorphism hom in `C` is an algebra monomorphism. -/ +lemma mono_of_mono {X Y : algebra F} (f : X ⟶ Y) [h : mono f.1] : mono f := +(forget F).mono_of_mono_map h + /-- From a natural transformation `α : G → F` we get a functor from algebras of `F` to algebras of `G`. @@ -194,5 +212,247 @@ lemma str_is_iso (h : limits.is_initial A) : is_iso A.str := end initial end algebra + +/-- A coalgebra of an endofunctor; `str` stands for "structure morphism" -/ +structure coalgebra (F : C ⥤ C) := +(V : C) +(str : V ⟶ F.obj V) + +instance [inhabited C] : inhabited (coalgebra (𝟭 C)) := ⟨⟨ default , 𝟙 _ ⟩⟩ + +namespace coalgebra + +variables {F : C ⥤ C} (V : coalgebra F) {V₀ V₁ V₂ : coalgebra F} + +/- +``` + str + V₀ -----> F V₀ + | | + f | | F f + V V + V₁ -----> F V₁ + str +``` +-/ +/-- A morphism between coalgebras of an endofunctor `F` -/ +@[ext] structure hom (V₀ V₁ : coalgebra F) := +(f : V₀.1 ⟶ V₁.1) +(h' : V₀.str ≫ F.map f = f ≫ V₁.str . obviously) + +restate_axiom hom.h' +attribute [simp, reassoc] hom.h +namespace hom + +/-- The identity morphism of an algebra of endofunctor `F` -/ +def id : hom V V := { f := 𝟙 _ } + +instance : inhabited (hom V V) := ⟨{ f := 𝟙 _ }⟩ + +/-- The composition of morphisms between algebras of endofunctor `F` -/ +def comp (f : hom V₀ V₁) (g : hom V₁ V₂) : hom V₀ V₂ := { f := f.1 ≫ g.1 } + +end hom + +instance (F : C ⥤ C) : category_struct (coalgebra F) := +{ hom := hom, + id := hom.id, + comp := @hom.comp _ _ _ } + +@[simp] lemma id_eq_id : coalgebra.hom.id V = 𝟙 V := rfl + +@[simp] lemma id_f : (𝟙 _ : V ⟶ V).1 = 𝟙 V.1 := rfl + +variables {V₀ V₁ V₂} (f : V₀ ⟶ V₁) (g : V₁ ⟶ V₂) + +@[simp] lemma comp_eq_comp : coalgebra.hom.comp f g = f ≫ g := rfl + +@[simp] lemma comp_f : (f ≫ g).1 = f.1 ≫ g.1 := rfl + +/-- Coalgebras of an endofunctor `F` form a category -/ +instance (F : C ⥤ C) : category (coalgebra F) := {} + +/-- +To construct an isomorphism of coalgebras, it suffices to give an isomorphism of the Vs which +commutes with the structure morphisms. +-/ +@[simps] +def iso_mk (h : V₀.1 ≅ V₁.1) (w : V₀.str ≫ F.map h.hom = h.hom ≫ V₁.str ) : V₀ ≅ V₁ := +{ hom := { f := h.hom }, + inv := + { f := h.inv, + h' := by { rw [h.eq_inv_comp, ← category.assoc, ←w, category.assoc, ← functor.map_comp], + simp only [iso.hom_inv_id, functor.map_id, category.comp_id] } } } + +/-- The forgetful functor from the category of coalgebras, forgetting the coalgebraic structure. -/ +@[simps] def forget (F : C ⥤ C) : coalgebra F ⥤ C := +{ obj := λ A, A.1, + map := λ A B f, f.1 } + +/-- A coalgebra morphism with an underlying isomorphism hom in `C` is a coalgebra isomorphism. -/ +lemma iso_of_iso (f : V₀ ⟶ V₁) [is_iso f.1] : is_iso f := +⟨⟨{ f := inv f.1, + h' := by { rw [is_iso.eq_inv_comp f.1, ← category.assoc, ← f.h, category.assoc], simp } }, + by tidy⟩⟩ + +instance forget_reflects_iso : reflects_isomorphisms (forget F) := +{ reflects := λ A B, iso_of_iso } + +instance forget_faithful : faithful (forget F) := {} + +/-- An algebra morphism with an underlying epimorphism hom in `C` is an algebra epimorphism. -/ +lemma epi_of_epi {X Y : coalgebra F} (f : X ⟶ Y) [h : epi f.1] : epi f := +(forget F).epi_of_epi_map h + +/-- An algebra morphism with an underlying monomorphism hom in `C` is an algebra monomorphism. -/ +lemma mono_of_mono {X Y : coalgebra F} (f : X ⟶ Y) [h : mono f.1] : mono f := +(forget F).mono_of_mono_map h + +/-- +From a natural transformation `α : F → G` we get a functor from +coalgebras of `F` to coalgebras of `G`. +-/ +@[simps] +def functor_of_nat_trans {F G : C ⥤ C} (α : F ⟶ G) : coalgebra F ⥤ coalgebra G := +{ obj := λ V, + { V := V.1, + str := V.str ≫ α.app V.1 }, + map := λ V₀ V₁ f, { f := f.1, + h' := by rw [category.assoc, ← α.naturality, ← category.assoc, f.h, category.assoc] } } + +/-- The identity transformation induces the identity endofunctor on the category of coalgebras. -/ +@[simps {rhs_md := semireducible}] +def functor_of_nat_trans_id : + functor_of_nat_trans (𝟙 F) ≅ 𝟭 _ := +nat_iso.of_components + (λ X, iso_mk (iso.refl _) (by { dsimp, simp, })) + (λ X Y f, by { ext, dsimp, simp }) + +/-- A composition of natural transformations gives the composition of corresponding functors. -/ +@[simps {rhs_md := semireducible}] +def functor_of_nat_trans_comp {F₀ F₁ F₂ : C ⥤ C} (α : F₀ ⟶ F₁) (β : F₁ ⟶ F₂) : + functor_of_nat_trans (α ≫ β) ≅ + functor_of_nat_trans α ⋙ functor_of_nat_trans β := +nat_iso.of_components + (λ X, iso_mk (iso.refl _) (by { dsimp, simp })) + (λ X Y f, by { ext, dsimp, simp }) + +/-- +If `α` and `β` are two equal natural transformations, then the functors of coalgebras induced by +them are isomorphic. +We define it like this as opposed to using `eq_to_iso` so that the components are nicer to prove +lemmas about. +-/ +@[simps {rhs_md := semireducible}] +def functor_of_nat_trans_eq {F G : C ⥤ C} {α β : F ⟶ G} (h : α = β) : + functor_of_nat_trans α ≅ functor_of_nat_trans β := +nat_iso.of_components + (λ X, iso_mk (iso.refl _) (by { dsimp, simp [h] })) + (λ X Y f, by { ext, dsimp, simp }) + +/-- +Naturally isomorphic endofunctors give equivalent categories of coalgebras. +Furthermore, they are equivalent as categories over `C`, that is, +we have `equiv_of_nat_iso h ⋙ forget = forget`. +-/ +@[simps] +def equiv_of_nat_iso {F G : C ⥤ C} (α : F ≅ G) : + coalgebra F ≌ coalgebra G := +{ functor := functor_of_nat_trans α.hom, + inverse := functor_of_nat_trans α.inv, + unit_iso := + functor_of_nat_trans_id.symm ≪≫ + functor_of_nat_trans_eq (by simp) ≪≫ + functor_of_nat_trans_comp _ _, + counit_iso := + (functor_of_nat_trans_comp _ _).symm ≪≫ + functor_of_nat_trans_eq (by simp) ≪≫ + functor_of_nat_trans_id }. + +end coalgebra + +namespace adjunction + +variables {F : C ⥤ C} {G : C ⥤ C} + +lemma algebra.hom_equiv_naturality_str (adj : F ⊣ G) (A₁ A₂ : algebra F) + (f : A₁ ⟶ A₂) : (adj.hom_equiv A₁.A A₁.A) A₁.str ≫ G.map f.f = + f.f ≫ (adj.hom_equiv A₂.A A₂.A) A₂.str := +by { rw [← adjunction.hom_equiv_naturality_right, ← adjunction.hom_equiv_naturality_left, f.h] } + +lemma coalgebra.hom_equiv_naturality_str_symm (adj : F ⊣ G) (V₁ V₂ : coalgebra G) + (f : V₁ ⟶ V₂) : F.map f.f ≫ ((adj.hom_equiv V₂.V V₂.V).symm) V₂.str = + ((adj.hom_equiv V₁.V V₁.V).symm) V₁.str ≫ f.f := +by { rw [← adjunction.hom_equiv_naturality_left_symm, ← adjunction.hom_equiv_naturality_right_symm, + f.h] } + +/-- Given an adjunction `F ⊣ G`, the functor that associates to an algebra over `F` a +coalgebra over `G` defined via adjunction applied to the structure map. -/ +def algebra.to_coalgebra_of (adj : F ⊣ G) : algebra F ⥤ coalgebra G := +{ obj := λ A, { V := A.1, + str := (adj.hom_equiv A.1 A.1).to_fun A.2 }, + map := λ A₁ A₂ f, { f := f.1, + h' := (algebra.hom_equiv_naturality_str adj A₁ A₂ f) } } + +/-- Given an adjunction `F ⊣ G`, the functor that associates to a coalgebra over `G` an algebra over +`F` defined via adjunction applied to the structure map. -/ +def coalgebra.to_algebra_of (adj : F ⊣ G) : coalgebra G ⥤ algebra F := +{ obj := λ V, { A := V.1, + str := (adj.hom_equiv V.1 V.1).inv_fun V.2 }, + map := λ V₁ V₂ f, { f := f.1, + h' := (coalgebra.hom_equiv_naturality_str_symm adj V₁ V₂ f) } } + +/-- Given an adjunction, assigning to an algebra over the left adjoint a coalgebra over its right +adjoint and going back is isomorphic to the identity functor. -/ +def alg_coalg_equiv.unit_iso (adj : F ⊣ G) : + 𝟭 (algebra F) ≅ (algebra.to_coalgebra_of adj) ⋙ (coalgebra.to_algebra_of adj) := +{ hom := + { app := λ A, + { f := (𝟙 A.1), + h' := by { erw [F.map_id, category.id_comp, category.comp_id], + apply (adj.hom_equiv _ _).left_inv A.str } }, + naturality' := λ A₁ A₂ f, by { ext1, dsimp, erw [category.id_comp, category.comp_id], refl } }, + inv := + { app := λ A, + { f := (𝟙 A.1), + h' := by { erw [F.map_id, category.id_comp, category.comp_id], + apply ((adj.hom_equiv _ _).left_inv A.str).symm } }, + naturality' := λ A₁ A₂ f, + by { ext1, dsimp, erw [category.comp_id, category.id_comp], refl } }, + hom_inv_id' := by { ext, exact category.comp_id _ }, + inv_hom_id' := by { ext, exact category.comp_id _ } } + +/-- Given an adjunction, assigning to a coalgebra over the right adjoint an algebra over the left +adjoint and going back is isomorphic to the identity functor. -/ +def alg_coalg_equiv.counit_iso (adj : F ⊣ G) : + (coalgebra.to_algebra_of adj) ⋙ (algebra.to_coalgebra_of adj) ≅ 𝟭 (coalgebra G) := +{ hom := + { app := λ V, + { f := (𝟙 V.1), + h' := by { dsimp, erw [G.map_id, category.id_comp, category.comp_id], + apply (adj.hom_equiv _ _).right_inv V.str } }, + naturality' := λ V₁ V₂ f, + by { ext1, dsimp, erw [category.comp_id, category.id_comp], refl, } }, + inv := + { app := λ V, + { f := (𝟙 V.1), + h' := by { dsimp, rw [G.map_id, category.comp_id, category.id_comp], + apply ((adj.hom_equiv _ _).right_inv V.str).symm } }, + naturality' := λ V₁ V₂ f, + by { ext1, dsimp, erw [category.comp_id, category.id_comp], refl } }, + hom_inv_id' := by { ext, exact category.comp_id _ }, + inv_hom_id' := by { ext, exact category.comp_id _ } } + +/-- If `F` is left adjoint to `G`, then the category of algebras over `F` is equivalent to the +category of coalgebras over `G`. -/ +def algebra_coalgebra_equiv (adj : F ⊣ G) : algebra F ≌ coalgebra G := +{ functor := algebra.to_coalgebra_of adj, + inverse := coalgebra.to_algebra_of adj, + unit_iso := alg_coalg_equiv.unit_iso adj, + counit_iso := alg_coalg_equiv.counit_iso adj, + functor_unit_iso_comp' := λ A, by { ext, exact category.comp_id _ } } + +end adjunction + end endofunctor end category_theory diff --git a/src/category_theory/endomorphism.lean b/src/category_theory/endomorphism.lean index 4bd5d4c486229..47c1aa2b5eff0 100644 --- a/src/category_theory/endomorphism.lean +++ b/src/category_theory/endomorphism.lean @@ -3,7 +3,7 @@ Copyright (c) 2019 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov, Scott Morrison, Simon Hudon -/ -import algebra.hom.equiv +import algebra.hom.equiv.basic import category_theory.groupoid import category_theory.opposites import group_theory.group_action.defs @@ -11,6 +11,9 @@ import group_theory.group_action.defs /-! # Endomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Definition and basic properties of endomorphisms and automorphisms of an object in a category. For each `X : C`, we provide `End X := X ⟶ X` with a monoid structure, @@ -99,8 +102,6 @@ The order of arguments in multiplication agrees with -/ def Aut (X : C) := X ≅ X -attribute [ext Aut] iso.ext - namespace Aut instance inhabited : inhabited (Aut X) := ⟨iso.refl X⟩ @@ -119,6 +120,8 @@ simp [flip, (*), monoid.mul, mul_one_class.mul, mul_one_class.one, has_one.one, lemma Aut_mul_def (f g : Aut X) : f * g = g.trans f := rfl +lemma Aut_inv_def (f : Aut X) : f ⁻¹ = f.symm := rfl + /-- Units in the monoid of endomorphisms of an object are (multiplicatively) equivalent to automorphisms of that object. diff --git a/src/category_theory/enriched/basic.lean b/src/category_theory/enriched/basic.lean index 1627a7ae4dd6a..a7eea5c06bb38 100644 --- a/src/category_theory/enriched/basic.lean +++ b/src/category_theory/enriched/basic.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import category_theory.monoidal.types +import category_theory.monoidal.types.symmetric +import category_theory.monoidal.types.coyoneda import category_theory.monoidal.center +import tactic.apply_fun /-! # Enriched categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We set up the basic theory of `V`-enriched categories, for `V` an arbitrary monoidal category. @@ -55,7 +60,7 @@ class enriched_category (C : Type u₁) := Π W X Y Z, (α_ _ _ _).inv ≫ (comp W X Y ⊗ 𝟙 _) ≫ comp W Y Z = (𝟙 _ ⊗ comp X Y Z) ≫ comp W X Z . obviously) -notation X ` ⟶[`V`] ` Y:10 := (enriched_category.hom X Y : V) +notation (name := enriched_category.hom) X ` ⟶[`V`] ` Y:10 := (enriched_category.hom X Y : V) variables (V) {C : Type u₁} [enriched_category V C] @@ -93,7 +98,7 @@ A type synonym for `C`, which should come equipped with a `V`-enriched category In a moment we will equip this with the `W`-enriched category structure obtained by applying the functor `F : lax_monoidal_functor V W` to each hom object. -/ -@[nolint has_inhabited_instance unused_arguments] +@[nolint has_nonempty_instance unused_arguments] def transport_enrichment (F : lax_monoidal_functor V W) (C : Type u₁) := C instance (F : lax_monoidal_functor V W) : @@ -158,7 +163,7 @@ def enriched_category_Type_equiv_category (C : Type u₁) : { ext X ⟨⟩, refl, }, { ext X Y Z ⟨f, g⟩, refl, } end, - right_inv := λ 𝒞, by { rcases 𝒞 with ⟨⟨⟨⟩⟩⟩, dsimp, congr, }, }. + right_inv := λ 𝒞, by { rcases 𝒞 with @⟨@⟨⟨⟩⟩⟩, dsimp, congr, }, }. section variables {W : Type (v+1)} [category.{v} W] [monoidal_category W] [enriched_category W C] @@ -177,10 +182,10 @@ which always exists, does not necessarily coincide with "the forgetful functor" from `V` to `Type`, if such exists. When `V` is any of `Type`, `Top`, `AddCommGroup`, or `Module R`, `coyoneda_tensor_unit` is just the usual forgetful functor, however. -For `V = Algebra R`, the usual forgetful functor is coyoneda of `polynomial R`, not of `R`. +For `V = Algebra R`, the usual forgetful functor is coyoneda of `R[X]`, not of `R`. (Perhaps we should have a typeclass for this situation: `concrete_monoidal`?) -/ -@[nolint has_inhabited_instance unused_arguments] +@[nolint has_nonempty_instance unused_arguments] def forget_enrichment (W : Type (v+1)) [category.{v} W] [monoidal_category W] (C : Type u₁) [enriched_category W C] := C @@ -354,7 +359,7 @@ coming from the ambient braiding on `V`.) The type of `A`-graded natural transformations between `V`-functors `F` and `G`. This is the type of morphisms in `V` from `A` to the `V`-object of natural transformations. -/ -@[ext, nolint has_inhabited_instance] +@[ext, nolint has_nonempty_instance] structure graded_nat_trans (A : center V) (F G : enriched_functor V C D) := (app : Π (X : C), A.1 ⟶ (F.obj X ⟶[V] G.obj X)) (naturality : diff --git a/src/category_theory/epi_mono.lean b/src/category_theory/epi_mono.lean index 21c763c5e3f33..b23311392e635 100644 --- a/src/category_theory/epi_mono.lean +++ b/src/category_theory/epi_mono.lean @@ -3,13 +3,15 @@ Copyright (c) 2019 Reid Barton. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Reid Barton, Scott Morrison -/ -import category_theory.adjunction.basic import category_theory.opposites import category_theory.groupoid /-! # Facts about epimorphisms and monomorphisms. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The definitions of `epi` and `mono` are in `category_theory.category`, since they are used by some lemmas for `iso`, which is used everywhere. -/ @@ -32,135 +34,147 @@ instance op_mono_of_epi {A B : C} (f : A ⟶ B) [epi f] : mono f.op := instance op_epi_of_mono {A B : C} (f : A ⟶ B) [mono f] : epi f.op := ⟨λ Z g h eq, quiver.hom.unop_inj ((cancel_mono f).1 (quiver.hom.op_inj eq))⟩ -section -variables {D : Type u₂} [category.{v₂} D] - -lemma left_adjoint_preserves_epi {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) - {X Y : C} {f : X ⟶ Y} (hf : epi f) : epi (F.map f) := -begin - constructor, - intros Z g h H, - replace H := congr_arg (adj.hom_equiv X Z) H, - rwa [adj.hom_equiv_naturality_left, adj.hom_equiv_naturality_left, - cancel_epi, equiv.apply_eq_iff_eq] at H -end - -lemma right_adjoint_preserves_mono {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) - {X Y : D} {f : X ⟶ Y} (hf : mono f) : mono (G.map f) := -begin - constructor, - intros Z g h H, - replace H := congr_arg (adj.hom_equiv Z Y).symm H, - rwa [adj.hom_equiv_naturality_right_symm, adj.hom_equiv_naturality_right_symm, - cancel_mono, equiv.apply_eq_iff_eq] at H -end - -instance is_equivalence.epi_map {F : C ⥤ D} [is_left_adjoint F] {X Y : C} {f : X ⟶ Y} - [h : epi f] : epi (F.map f) := -left_adjoint_preserves_epi (adjunction.of_left_adjoint F) h - -instance is_equivalence.mono_map {F : C ⥤ D} [is_right_adjoint F] {X Y : C} {f : X ⟶ Y} - [h : mono f] : mono (F.map f) := -right_adjoint_preserves_mono (adjunction.of_right_adjoint F) h - -lemma faithful_reflects_epi (F : C ⥤ D) [faithful F] {X Y : C} {f : X ⟶ Y} - (hf : epi (F.map f)) : epi f := -⟨λ Z g h H, F.map_injective $ - by rw [←cancel_epi (F.map f), ←F.map_comp, ←F.map_comp, H]⟩ - -lemma faithful_reflects_mono (F : C ⥤ D) [faithful F] {X Y : C} {f : X ⟶ Y} - (hf : mono (F.map f)) : mono f := -⟨λ Z g h H, F.map_injective $ - by rw [←cancel_mono (F.map f), ←F.map_comp, ←F.map_comp, H]⟩ -end - /-- -A split monomorphism is a morphism `f : X ⟶ Y` admitting a retraction `retraction f : Y ⟶ X` +A split monomorphism is a morphism `f : X ⟶ Y` with a given retraction `retraction f : Y ⟶ X` such that `f ≫ retraction f = 𝟙 X`. Every split monomorphism is a monomorphism. -/ -class split_mono {X Y : C} (f : X ⟶ Y) := +@[ext, nolint has_nonempty_instance] +structure split_mono {X Y : C} (f : X ⟶ Y) := (retraction : Y ⟶ X) (id' : f ≫ retraction = 𝟙 X . obviously) +restate_axiom split_mono.id' +attribute [simp, reassoc] split_mono.id + +/-- `is_split_mono f` is the assertion that `f` admits a retraction -/ +class is_split_mono {X Y : C} (f : X ⟶ Y) : Prop := +(exists_split_mono : nonempty (split_mono f)) + +/-- A constructor for `is_split_mono f` taking a `split_mono f` as an argument -/ +lemma is_split_mono.mk' {X Y : C} {f : X ⟶ Y} (sm : split_mono f) : + is_split_mono f := ⟨nonempty.intro sm⟩ + /-- -A split epimorphism is a morphism `f : X ⟶ Y` admitting a section `section_ f : Y ⟶ X` +A split epimorphism is a morphism `f : X ⟶ Y` with a given section `section_ f : Y ⟶ X` such that `section_ f ≫ f = 𝟙 Y`. (Note that `section` is a reserved keyword, so we append an underscore.) Every split epimorphism is an epimorphism. -/ -class split_epi {X Y : C} (f : X ⟶ Y) := +@[ext, nolint has_nonempty_instance] +structure split_epi {X Y : C} (f : X ⟶ Y) := (section_ : Y ⟶ X) (id' : section_ ≫ f = 𝟙 Y . obviously) +restate_axiom split_epi.id' +attribute [simp, reassoc] split_epi.id + +/-- `is_split_epi f` is the assertion that `f` admits a section -/ +class is_split_epi {X Y : C} (f : X ⟶ Y) : Prop := +(exists_split_epi : nonempty (split_epi f)) + +/-- A constructor for `is_split_epi f` taking a `split_epi f` as an argument -/ +lemma is_split_epi.mk' {X Y : C} {f : X ⟶ Y} (se : split_epi f) : + is_split_epi f := ⟨nonempty.intro se⟩ + /-- The chosen retraction of a split monomorphism. -/ -def retraction {X Y : C} (f : X ⟶ Y) [split_mono f] : Y ⟶ X := split_mono.retraction f +noncomputable def retraction {X Y : C} (f : X ⟶ Y) [hf : is_split_mono f] : Y ⟶ X := +hf.exists_split_mono.some.retraction + @[simp, reassoc] -lemma split_mono.id {X Y : C} (f : X ⟶ Y) [split_mono f] : f ≫ retraction f = 𝟙 X := -split_mono.id' +lemma is_split_mono.id {X Y : C} (f : X ⟶ Y) [hf : is_split_mono f] : f ≫ retraction f = 𝟙 X := +hf.exists_split_mono.some.id + +/-- The retraction of a split monomorphism has an obvious section. -/ +def split_mono.split_epi {X Y : C} {f : X ⟶ Y} (sm : split_mono f) : split_epi (sm.retraction) := +{ section_ := f, } + /-- The retraction of a split monomorphism is itself a split epimorphism. -/ -instance retraction_split_epi {X Y : C} (f : X ⟶ Y) [split_mono f] : split_epi (retraction f) := -{ section_ := f } +instance retraction_is_split_epi {X Y : C} (f : X ⟶ Y) [hf : is_split_mono f] : +is_split_epi (retraction f) := +is_split_epi.mk' (split_mono.split_epi _) /-- A split mono which is epi is an iso. -/ -lemma is_iso_of_epi_of_split_mono {X Y : C} (f : X ⟶ Y) [split_mono f] [epi f] : is_iso f := +lemma is_iso_of_epi_of_is_split_mono {X Y : C} (f : X ⟶ Y) [is_split_mono f] [epi f] : is_iso f := ⟨⟨retraction f, ⟨by simp, by simp [← cancel_epi f]⟩⟩⟩ /-- The chosen section of a split epimorphism. (Note that `section` is a reserved keyword, so we append an underscore.) -/ -def section_ {X Y : C} (f : X ⟶ Y) [split_epi f] : Y ⟶ X := split_epi.section_ f +noncomputable def section_ {X Y : C} (f : X ⟶ Y) [hf : is_split_epi f] : Y ⟶ X := +hf.exists_split_epi.some.section_ + @[simp, reassoc] -lemma split_epi.id {X Y : C} (f : X ⟶ Y) [split_epi f] : section_ f ≫ f = 𝟙 Y := -split_epi.id' +lemma is_split_epi.id {X Y : C} (f : X ⟶ Y) [hf : is_split_epi f] : section_ f ≫ f = 𝟙 Y := +hf.exists_split_epi.some.id + +/-- The section of a split epimorphism has an obvious retraction. -/ +def split_epi.split_mono {X Y : C} {f : X ⟶ Y} (se : split_epi f) : split_mono (se.section_) := +{ retraction := f, } + /-- The section of a split epimorphism is itself a split monomorphism. -/ -instance section_split_mono {X Y : C} (f : X ⟶ Y) [split_epi f] : split_mono (section_ f) := -{ retraction := f } +instance section_is_split_mono {X Y : C} (f : X ⟶ Y) [hf : is_split_epi f] : + is_split_mono (section_ f) := +is_split_mono.mk' (split_epi.split_mono _) /-- A split epi which is mono is an iso. -/ -lemma is_iso_of_mono_of_split_epi {X Y : C} (f : X ⟶ Y) [mono f] [split_epi f] : is_iso f := +lemma is_iso_of_mono_of_is_split_epi {X Y : C} (f : X ⟶ Y) [mono f] [is_split_epi f] : is_iso f := ⟨⟨section_ f, ⟨by simp [← cancel_mono f], by simp⟩⟩⟩ /-- Every iso is a split mono. -/ @[priority 100] -noncomputable -instance split_mono.of_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : split_mono f := -{ retraction := inv f } +instance is_split_mono.of_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : is_split_mono f := +is_split_mono.mk' { retraction := inv f } /-- Every iso is a split epi. -/ @[priority 100] -noncomputable -instance split_epi.of_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : split_epi f := -{ section_ := inv f } +instance is_split_epi.of_iso {X Y : C} (f : X ⟶ Y) [is_iso f] : is_split_epi f := +is_split_epi.mk' { section_ := inv f } + +lemma split_mono.mono {X Y : C} {f : X ⟶ Y} (sm : split_mono f) : mono f := +{ right_cancellation := λ Z g h w, begin replace w := w =≫ sm.retraction, simpa using w, end } /-- Every split mono is a mono. -/ @[priority 100] -instance split_mono.mono {X Y : C} (f : X ⟶ Y) [split_mono f] : mono f := -{ right_cancellation := λ Z g h w, begin replace w := w =≫ retraction f, simpa using w, end } +instance is_split_mono.mono {X Y : C} (f : X ⟶ Y) [hf : is_split_mono f] : mono f := +hf.exists_split_mono.some.mono + +lemma split_epi.epi {X Y : C} {f : X ⟶ Y} (se : split_epi f) : epi f := +{ left_cancellation := λ Z g h w, begin replace w := se.section_ ≫= w, simpa using w, end } /-- Every split epi is an epi. -/ @[priority 100] -instance split_epi.epi {X Y : C} (f : X ⟶ Y) [split_epi f] : epi f := -{ left_cancellation := λ Z g h w, begin replace w := section_ f ≫= w, simpa using w, end } +instance is_split_epi.epi {X Y : C} (f : X ⟶ Y) [hf : is_split_epi f] : epi f := +hf.exists_split_epi.some.epi /-- Every split mono whose retraction is mono is an iso. -/ -lemma is_iso.of_mono_retraction {X Y : C} {f : X ⟶ Y} [split_mono f] [mono $ retraction f] - : is_iso f := -⟨⟨retraction f, ⟨by simp, (cancel_mono_id $ retraction f).mp (by simp)⟩⟩⟩ +lemma is_iso.of_mono_retraction' {X Y : C} {f : X ⟶ Y} (hf : split_mono f) + [mono $ hf.retraction] : is_iso f := +⟨⟨hf.retraction, ⟨by simp, (cancel_mono_id $ hf.retraction).mp (by simp)⟩⟩⟩ + +/-- Every split mono whose retraction is mono is an iso. -/ +lemma is_iso.of_mono_retraction {X Y : C} (f : X ⟶ Y) [hf : is_split_mono f] + [hf' : mono $ retraction f] : is_iso f := +@is_iso.of_mono_retraction' _ _ _ _ _ hf.exists_split_mono.some hf' /-- Every split epi whose section is epi is an iso. -/ -lemma is_iso.of_epi_section {X Y : C} {f : X ⟶ Y} [split_epi f] [epi $ section_ f] - : is_iso f := -⟨⟨section_ f, ⟨(cancel_epi_id $ section_ f).mp (by simp), by simp⟩⟩⟩ +lemma is_iso.of_epi_section' {X Y : C} {f : X ⟶ Y} (hf : split_epi f) + [epi $ hf.section_] : is_iso f := +⟨⟨hf.section_, ⟨(cancel_epi_id $ hf.section_).mp (by simp), by simp⟩⟩⟩ + +/-- Every split epi whose section is epi is an iso. -/ +lemma is_iso.of_epi_section {X Y : C} (f : X ⟶ Y) [hf : is_split_epi f] + [hf' : epi $ section_ f] : is_iso f := +@is_iso.of_epi_section' _ _ _ _ _ hf.exists_split_epi.some hf' /-- A category where every morphism has a `trunc` retraction is computably a groupoid. -/ -- FIXME this has unnecessarily become noncomputable! noncomputable def groupoid.of_trunc_split_mono - (all_split_mono : ∀ {X Y : C} (f : X ⟶ Y), trunc (split_mono f)) : + (all_split_mono : ∀ {X Y : C} (f : X ⟶ Y), trunc (is_split_mono f)) : groupoid.{v₁} C := begin apply groupoid.of_is_iso, @@ -175,36 +189,48 @@ variables (C) /-- A split mono category is a category in which every monomorphism is split. -/ class split_mono_category := -(split_mono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [mono f], split_mono f) +(is_split_mono_of_mono : ∀ {X Y : C} (f : X ⟶ Y) [mono f], is_split_mono f) /-- A split epi category is a category in which every epimorphism is split. -/ class split_epi_category := -(split_epi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [epi f], split_epi f) +(is_split_epi_of_epi : ∀ {X Y : C} (f : X ⟶ Y) [epi f], is_split_epi f) end /-- In a category in which every monomorphism is split, every monomorphism splits. This is not an instance because it would create an instance loop. -/ -def split_mono_of_mono [split_mono_category C] {X Y : C} (f : X ⟶ Y) [mono f] : split_mono f := -split_mono_category.split_mono_of_mono _ +lemma is_split_mono_of_mono [split_mono_category C] {X Y : C} (f : X ⟶ Y) [mono f] : + is_split_mono f := +split_mono_category.is_split_mono_of_mono _ /-- In a category in which every epimorphism is split, every epimorphism splits. This is not an instance because it would create an instance loop. -/ -def split_epi_of_epi [split_epi_category C] {X Y : C} (f : X ⟶ Y) [epi f] : split_epi f := -split_epi_category.split_epi_of_epi _ +lemma is_split_epi_of_epi [split_epi_category C] {X Y : C} (f : X ⟶ Y) [epi f] : + is_split_epi f := split_epi_category.is_split_epi_of_epi _ section variables {D : Type u₂} [category.{v₂} D] /-- Split monomorphisms are also absolute monomorphisms. -/ -instance {X Y : C} (f : X ⟶ Y) [split_mono f] (F : C ⥤ D) : split_mono (F.map f) := -{ retraction := F.map (retraction f), +@[simps] +def split_mono.map {X Y : C} {f : X ⟶ Y} (sm : split_mono f) (F : C ⥤ D ) : + split_mono (F.map f) := +{ retraction := F.map (sm.retraction), id' := by { rw [←functor.map_comp, split_mono.id, functor.map_id], } } /-- Split epimorphisms are also absolute epimorphisms. -/ -instance {X Y : C} (f : X ⟶ Y) [split_epi f] (F : C ⥤ D) : split_epi (F.map f) := -{ section_ := F.map (section_ f), +@[simps] +def split_epi.map {X Y : C} {f : X ⟶ Y} (se : split_epi f) (F : C ⥤ D ) : + split_epi (F.map f) := +{ section_ := F.map (se.section_), id' := by { rw [←functor.map_comp, split_epi.id, functor.map_id], } } + +instance {X Y : C} (f : X ⟶ Y) [hf : is_split_mono f] (F : C ⥤ D) : is_split_mono (F.map f) := +is_split_mono.mk' (hf.exists_split_mono.some.map F) + +instance {X Y : C} (f : X ⟶ Y) [hf : is_split_epi f] (F : C ⥤ D) : is_split_epi (F.map f) := +is_split_epi.mk' (hf.exists_split_epi.some.map F) + end end category_theory diff --git a/src/category_theory/eq_to_hom.lean b/src/category_theory/eq_to_hom.lean index 0a7c7aecfbfcc..0ae887d5de674 100644 --- a/src/category_theory/eq_to_hom.lean +++ b/src/category_theory/eq_to_hom.lean @@ -8,6 +8,9 @@ import category_theory.opposites /-! # Morphisms from equations between objects. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When working categorically, sometimes one encounters an equation `h : X = Y` between objects. Your initial aversion to this is natural and appropriate: @@ -45,6 +48,16 @@ def eq_to_hom {X Y : C} (p : X = Y) : X ⟶ Y := by rw p; exact 𝟙 _ eq_to_hom p ≫ eq_to_hom q = eq_to_hom (p.trans q) := by { cases p, cases q, simp, } +lemma comp_eq_to_hom_iff {X Y Y' : C} (p : Y = Y') (f : X ⟶ Y) (g : X ⟶ Y') : + f ≫ eq_to_hom p = g ↔ f = g ≫ eq_to_hom p.symm := +{ mp := λ h, h ▸ by simp, + mpr := λ h, by simp [eq_whisker h (eq_to_hom p)] } + +lemma eq_to_hom_comp_iff {X X' Y : C} (p : X = X') (f : X ⟶ Y) (g : X' ⟶ Y) : + eq_to_hom p ≫ g = f ↔ g = eq_to_hom p.symm ≫ f := +{ mp := λ h, h ▸ by simp, + mpr := λ h, h ▸ by simp [whisker_eq _ h] } + /-- If we (perhaps unintentionally) perform equational rewriting on the source object of a morphism, @@ -120,7 +133,7 @@ begin simpa using h_map X Y f end -/-- Two morphisms are conjugate via eq_to_hom if and only if they are heterogeneously equal. --/ +/-- Two morphisms are conjugate via eq_to_hom if and only if they are heterogeneously equal. -/ lemma conj_eq_to_hom_iff_heq {W X Y Z : C} (f : W ⟶ X) (g : Y ⟶ Z) (h : W = Y) (h' : X = Z) : f = eq_to_hom h ≫ g ≫ eq_to_hom h'.symm ↔ f == g := by { cases h, cases h', simp } @@ -140,6 +153,16 @@ lemma congr_hom {F G : C ⥤ D} (h : F = G) {X Y} (f : X ⟶ Y) : F.map f = eq_to_hom (congr_obj h X) ≫ G.map f ≫ eq_to_hom (congr_obj h Y).symm := by subst h; simp +lemma congr_inv_of_congr_hom (F G : C ⥤ D) {X Y : C} (e : X ≅ Y) + (hX : F.obj X = G.obj X) (hY : F.obj Y = G.obj Y) + (h₂ : F.map e.hom = eq_to_hom (by rw hX) ≫ G.map e.hom ≫ eq_to_hom (by rw hY)) : +F.map e.inv = eq_to_hom (by rw hY) ≫ G.map e.inv ≫ eq_to_hom (by rw hX) := +by simp only [← is_iso.iso.inv_hom e, functor.map_inv, h₂, is_iso.inv_comp, + inv_eq_to_hom, category.assoc] + +lemma congr_map (F : C ⥤ D) {X Y : C} {f g : X ⟶ Y} (h : f = g) : + F.map f = F.map g := by rw h + section heq /- Composition of functors and maps w.r.t. heq -/ @@ -175,11 +198,21 @@ end heq end functor -@[simp] lemma eq_to_hom_map (F : C ⥤ D) {X Y : C} (p : X = Y) : +/-- +This is not always a good idea as a `@[simp]` lemma, +as we lose the ability to use results that interact with `F`, +e.g. the naturality of a natural transformation. + +In some files it may be appropriate to use `local attribute [simp] eq_to_hom_map`, however. +-/ +lemma eq_to_hom_map (F : C ⥤ D) {X Y : C} (p : X = Y) : F.map (eq_to_hom p) = eq_to_hom (congr_arg F.obj p) := by cases p; simp -@[simp] lemma eq_to_iso_map (F : C ⥤ D) {X Y : C} (p : X = Y) : +/-- +See the note on `eq_to_hom_map` regarding using this as a `simp` lemma. +-/ +lemma eq_to_iso_map (F : C ⥤ D) {X Y : C} (p : X = Y) : F.map_iso (eq_to_iso p) = eq_to_iso (congr_arg F.obj p) := by ext; cases p; simp @@ -189,7 +222,7 @@ by subst h; refl lemma nat_trans.congr {F G : C ⥤ D} (α : F ⟶ G) {X Y : C} (h : X = Y) : α.app X = F.map (eq_to_hom h) ≫ α.app Y ≫ G.map (eq_to_hom h.symm) := -by { rw [α.naturality_assoc], simp } +by { rw [α.naturality_assoc], simp [eq_to_hom_map], } lemma eq_conj_eq_to_hom {X Y : C} (f : X ⟶ Y) : f = eq_to_hom rfl ≫ f ≫ eq_to_hom rfl := diff --git a/src/category_theory/equivalence.lean b/src/category_theory/equivalence.lean index fec19f77119b8..f421667168bf9 100644 --- a/src/category_theory/equivalence.lean +++ b/src/category_theory/equivalence.lean @@ -12,6 +12,9 @@ import tactic.slice /-! # Equivalence of categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An equivalence of categories `C` and `D` is a pair of functors `F : C ⥤ D` and `G : D ⥤ C` such that `η : 𝟭 C ≅ F ⋙ G` and `ε : G ⋙ F ≅ 𝟭 D`. In many situations, equivalences are a better notion of "sameness" of categories than the stricter isomorphims of categories. @@ -135,8 +138,9 @@ by { erw [←iso.hom_comp_eq_id (e.functor.map_iso (e.unit_iso.app X)), functor_ @[simp] lemma unit_inverse_comp (e : C ≌ D) (Y : D) : e.unit.app (e.inverse.obj Y) ≫ e.inverse.map (e.counit.app Y) = 𝟙 (e.inverse.obj Y) := begin - rw [←id_comp (e.inverse.map _), ←map_id e.inverse, ←counit_inv_functor_comp, map_comp, - ←iso.hom_inv_id_assoc (e.unit_iso.app _) (e.inverse.map (e.functor.map _)), + rw [←id_comp (e.inverse.map _), ←map_id e.inverse, ←counit_inv_functor_comp, map_comp], + dsimp, + rw [←iso.hom_inv_id_assoc (e.unit_iso.app _) (e.inverse.map (e.functor.map _)), app_hom, app_inv], slice_lhs 2 3 { erw [e.unit.naturality] }, slice_lhs 1 2 { erw [e.unit.naturality] }, diff --git a/src/category_theory/essential_image.lean b/src/category_theory/essential_image.lean index 7a832885783c3..c37336e2295e0 100644 --- a/src/category_theory/essential_image.lean +++ b/src/category_theory/essential_image.lean @@ -5,11 +5,13 @@ Authors: Bhavik Mehta -/ import category_theory.natural_isomorphism import category_theory.full_subcategory -import data.set.basic /-! # Essential image of a functor +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The essential image `ess_image` of a functor consists of the objects in the target category which are isomorphic to an object in the image of the object function. This, for instance, allows us to talk about objects belonging to a subcategory expressed as a @@ -61,16 +63,18 @@ hY.imp (λ X, nonempty.map (λ t, h.symm.app X ≪≫ t)) /-- Isomorphic functors have equal essential images. -/ lemma ess_image_eq_of_nat_iso {F' : C ⥤ D} (h : F ≅ F') : ess_image F = ess_image F' := -set.ext $ λ A, ⟨ess_image.of_nat_iso h, ess_image.of_nat_iso h.symm⟩ +funext (λ _, propext ⟨ess_image.of_nat_iso h, ess_image.of_nat_iso h.symm⟩) /-- An object in the image is in the essential image. -/ lemma obj_mem_ess_image (F : D ⥤ C) (Y : D) : F.obj Y ∈ ess_image F := ⟨Y, ⟨iso.refl _⟩⟩ -instance : category F.ess_image := category_theory.full_subcategory _ +/-- The essential image of a functor, interpreted of a full subcategory of the target category. -/ +@[derive category, nolint has_nonempty_instance] +def ess_image_subcategory (F : C ⥤ D) := full_subcategory F.ess_image /-- The essential image as a subcategory has a fully faithful inclusion into the target category. -/ @[derive [full, faithful], simps] -def ess_image_inclusion (F : C ⥤ D) : F.ess_image ⥤ D := +def ess_image_inclusion (F : C ⥤ D) : F.ess_image_subcategory ⥤ D := full_subcategory_inclusion _ /-- @@ -78,9 +82,8 @@ Given a functor `F : C ⥤ D`, we have an (essentially surjective) functor from image of `F`. -/ @[simps] -def to_ess_image (F : C ⥤ D) : C ⥤ F.ess_image := -{ obj := λ X, ⟨_, obj_mem_ess_image _ X⟩, - map := λ X Y f, (ess_image_inclusion F).preimage (F.map f) } +def to_ess_image (F : C ⥤ D) : C ⥤ F.ess_image_subcategory := +full_subcategory.lift _ F (obj_mem_ess_image _) /-- The functor `F` factorises through its essential image, where the first functor is essentially @@ -89,7 +92,7 @@ surjective and the second is fully faithful. @[simps] def to_ess_image_comp_essential_image_inclusion (F : C ⥤ D) : F.to_ess_image ⋙ F.ess_image_inclusion ≅ F := -nat_iso.of_components (λ X, iso.refl _) (by tidy) +full_subcategory.lift_comp_inclusion _ _ _ end functor diff --git a/src/category_theory/essentially_small.lean b/src/category_theory/essentially_small.lean index 5e27faf4b0f63..cb4fa7f70fd77 100644 --- a/src/category_theory/essentially_small.lean +++ b/src/category_theory/essentially_small.lean @@ -3,12 +3,16 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import logic.small +import logic.small.basic +import category_theory.category.ulift import category_theory.skeletal /-! # Essentially small categories. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category given by `(C : Type u) [category.{v} C]` is `w`-essentially small if there exists a `small_model C : Type w` equipped with `[small_category (small_model C)]`. @@ -39,7 +43,7 @@ lemma essentially_small.mk' {C : Type u} [category.{v} C] {S : Type w} [small_ca /-- An arbitrarily chosen small model for an essentially small category. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def small_model (C : Type u) [category.{v} C] [essentially_small.{w} C] : Type w := classical.some (@essentially_small.equiv_small_category C _ _) @@ -69,6 +73,13 @@ begin exact essentially_small.mk' (e.trans f), }, end +lemma discrete.essentially_small_of_small {α : Type u} [small.{w} α] : + essentially_small.{w} (discrete α) := +⟨⟨discrete (shrink α), ⟨infer_instance, ⟨discrete.equivalence (equiv_shrink _)⟩⟩⟩⟩ + +lemma essentially_small_self : essentially_small.{max w v u} C := +essentially_small.mk' (as_small.equiv : C ≌ as_small.{w} C) + /-- A category is `w`-locally small if every hom set is `w`-small. @@ -111,7 +122,7 @@ instance locally_small_of_essentially_small We define a type alias `shrink_homs C` for `C`. When we have `locally_small.{w} C`, we'll put a `category.{w}` instance on `shrink_homs C`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def shrink_homs (C : Type u) := C namespace shrink_homs @@ -196,14 +207,14 @@ end Any thin category is locally small. -/ @[priority 100] -instance locally_small_of_thin {C : Type u} [category.{v} C] [∀ X Y : C, subsingleton (X ⟶ Y)] : +instance locally_small_of_thin {C : Type u} [category.{v} C] [quiver.is_thin C] : locally_small.{w} C := {} /-- A thin category is essentially small if and only if the underlying type of its skeleton is small. -/ theorem essentially_small_iff_of_thin - {C : Type u} [category.{v} C] [∀ X Y : C, subsingleton (X ⟶ Y)] : + {C : Type u} [category.{v} C] [quiver.is_thin C] : essentially_small.{w} C ↔ small.{w} (skeleton C) := by simp [essentially_small_iff, category_theory.locally_small_of_thin] diff --git a/src/category_theory/extensive.lean b/src/category_theory/extensive.lean new file mode 100644 index 0000000000000..9a7349ba8495f --- /dev/null +++ b/src/category_theory/extensive.lean @@ -0,0 +1,524 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.limits.shapes.comm_sq +import category_theory.limits.shapes.strict_initial +import category_theory.limits.shapes.types +import topology.category.Top.limits.pullbacks +import category_theory.limits.functor_category + +/-! + +# Extensive categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions +- `category_theory.is_van_kampen_colimit`: A (colimit) cocone over a diagram `F : J ⥤ C` is van + Kampen if for every cocone `c'` over the pullback of the diagram `F' : J ⥤ C'`, + `c'` is colimiting iff `c'` is the pullback of `c`. +- `category_theory.finitary_extensive`: A category is (finitary) extensive if it has finite + coproducts, and binary coproducts are van Kampen. + +## Main Results +- `category_theory.has_strict_initial_objects_of_finitary_extensive`: The initial object + in extensive categories is strict. +- `category_theory.finitary_extensive.mono_inr_of_is_colimit`: Coproduct injections are monic in + extensive categories. +- `category_theory.binary_cofan.is_pullback_initial_to_of_is_van_kampen`: In extensive categories, + sums are disjoint, i.e. the pullback of `X ⟶ X ⨿ Y` and `Y ⟶ X ⨿ Y` is the initial object. +- `category_theory.types.finitary_extensive`: The category of types is extensive. + +## TODO + +Show that the following are finitary extensive: +- the categories of sheaves over a site +- `Scheme` +- `AffineScheme` (`CommRingᵒᵖ`) + +## References +- https://ncatlab.org/nlab/show/extensive+category +- [Carboni et al, Introduction to extensive and distributive categories][CARBONI1993145] + +-/ + +open category_theory.limits + +namespace category_theory + +universes v' u' v u + +variables {J : Type v'} [category.{u'} J] {C : Type u} [category.{v} C] + +/-- A natural transformation is equifibered if every commutative square of the following form is +a pullback. +``` +F(X) → F(Y) + ↓ ↓ +G(X) → G(Y) +``` +-/ +def nat_trans.equifibered {F G : J ⥤ C} (α : F ⟶ G) : Prop := +∀ ⦃i j : J⦄ (f : i ⟶ j), is_pullback (F.map f) (α.app i) (α.app j) (G.map f) + +lemma nat_trans.equifibered_of_is_iso {F G : J ⥤ C} (α : F ⟶ G) [is_iso α] : α.equifibered := +λ _ _ f, is_pullback.of_vert_is_iso ⟨nat_trans.naturality _ f⟩ + +lemma nat_trans.equifibered.comp {F G H : J ⥤ C} {α : F ⟶ G} {β : G ⟶ H} + (hα : α.equifibered) (hβ : β.equifibered) : (α ≫ β).equifibered := +λ i j f, (hα f).paste_vert (hβ f) + +/-- A (colimit) cocone over a diagram `F : J ⥤ C` is universal if it is stable under pullbacks. -/ +def is_universal_colimit {F : J ⥤ C} (c : cocone F) : Prop := +∀ ⦃F' : J ⥤ C⦄ (c' : cocone F') (α : F' ⟶ F) (f : c'.X ⟶ c.X) + (h : α ≫ c.ι = c'.ι ≫ (functor.const J).map f) (hα : α.equifibered), + (∀ j : J, is_pullback (c'.ι.app j) (α.app j) f (c.ι.app j)) → nonempty (is_colimit c') + +/-- A (colimit) cocone over a diagram `F : J ⥤ C` is van Kampen if for every cocone `c'` over the +pullback of the diagram `F' : J ⥤ C'`, `c'` is colimiting iff `c'` is the pullback of `c`. + +TODO: Show that this is iff the functor `C ⥤ Catᵒᵖ` sending `x` to `C/x` preserves it. +TODO: Show that this is iff the inclusion functor `C ⥤ Span(C)` preserves it. +-/ +def is_van_kampen_colimit {F : J ⥤ C} (c : cocone F) : Prop := +∀ ⦃F' : J ⥤ C⦄ (c' : cocone F') (α : F' ⟶ F) (f : c'.X ⟶ c.X) + (h : α ≫ c.ι = c'.ι ≫ (functor.const J).map f) (hα : α.equifibered), + nonempty (is_colimit c') ↔ ∀ j : J, is_pullback (c'.ι.app j) (α.app j) f (c.ι.app j) + +lemma is_van_kampen_colimit.is_universal {F : J ⥤ C} {c : cocone F} (H : is_van_kampen_colimit c) : + is_universal_colimit c := +λ _ c' α f h hα, (H c' α f h hα).mpr + +/-- A van Kampen colimit is a colimit. -/ +noncomputable +def is_van_kampen_colimit.is_colimit {F : J ⥤ C} {c : cocone F} (h : is_van_kampen_colimit c) : + is_colimit c := +begin + refine ((h c (𝟙 F) (𝟙 c.X : _) (by rw [functor.map_id, category.comp_id, category.id_comp]) + (nat_trans.equifibered_of_is_iso _)).mpr $ λ j, _).some, + haveI : is_iso (𝟙 c.X) := infer_instance, + exact is_pullback.of_vert_is_iso ⟨by erw [nat_trans.id_app, category.comp_id, category.id_comp]⟩, +end + +lemma is_initial.is_van_kampen_colimit [has_strict_initial_objects C] {X : C} (h : is_initial X) : + is_van_kampen_colimit (as_empty_cocone X) := +begin + intros F' c' α f hf hα, + have : F' = functor.empty C := by apply functor.hext; rintro ⟨⟨⟩⟩, + subst this, + haveI := h.is_iso_to f, + refine ⟨by rintro _ ⟨⟨⟩⟩, λ _, + ⟨is_colimit.of_iso_colimit h (cocones.ext (as_iso f).symm $ by rintro ⟨⟨⟩⟩)⟩⟩ +end + +section extensive + +variables {X Y : C} + +/-- +A category is (finitary) extensive if it has finite coproducts, +and binary coproducts are van Kampen. + +TODO: Show that this is iff all finite coproducts are van Kampen. -/ +class finitary_extensive (C : Type u) [category.{v} C] : Prop := +[has_finite_coproducts : has_finite_coproducts C] +(van_kampen' : ∀ {X Y : C} (c : binary_cofan X Y), is_colimit c → is_van_kampen_colimit c) + +attribute [priority 100, instance] finitary_extensive.has_finite_coproducts + +lemma finitary_extensive.van_kampen [finitary_extensive C] {F : discrete walking_pair ⥤ C} + (c : cocone F) (hc : is_colimit c) : is_van_kampen_colimit c := +begin + let X := F.obj ⟨walking_pair.left⟩, let Y := F.obj ⟨walking_pair.right⟩, + have : F = pair X Y, + { apply functor.hext, { rintros ⟨⟨⟩⟩; refl }, { rintros ⟨⟨⟩⟩ ⟨j⟩ ⟨⟨rfl : _ = j⟩⟩; simpa } }, + clear_value X Y, subst this, + exact finitary_extensive.van_kampen' c hc +end + +lemma map_pair_equifibered {F F' : discrete walking_pair ⥤ C} (α : F ⟶ F') : α.equifibered := +begin + rintros ⟨⟨⟩⟩ ⟨j⟩ ⟨⟨rfl : _ = j⟩⟩, + all_goals { dsimp, simp only [discrete.functor_map_id], + exact is_pullback.of_horiz_is_iso ⟨by simp only [category.comp_id, category.id_comp]⟩ } +end + +lemma binary_cofan.is_van_kampen_iff (c : binary_cofan X Y) : + is_van_kampen_colimit c ↔ + ∀ {X' Y' : C} (c' : binary_cofan X' Y') (αX : X' ⟶ X) (αY : Y' ⟶ Y) + (f : c'.X ⟶ c.X) (hαX : αX ≫ c.inl = c'.inl ≫ f) (hαY : αY ≫ c.inr = c'.inr ≫ f), + nonempty (is_colimit c') ↔ is_pullback c'.inl αX f c.inl ∧ is_pullback c'.inr αY f c.inr := +begin + split, + { introv H hαX hαY, + rw H c' (map_pair αX αY) f (by ext ⟨⟨⟩⟩; dsimp; assumption) (map_pair_equifibered _), + split, { intro H, exact ⟨H _, H _⟩ }, { rintros H ⟨⟨⟩⟩, exacts [H.1, H.2] } }, + { introv H F' hα h, + let X' := F'.obj ⟨walking_pair.left⟩, let Y' := F'.obj ⟨walking_pair.right⟩, + have : F' = pair X' Y', + { apply functor.hext, { rintros ⟨⟨⟩⟩; refl }, { rintros ⟨⟨⟩⟩ ⟨j⟩ ⟨⟨rfl : _ = j⟩⟩; simpa } }, + clear_value X' Y', subst this, change binary_cofan X' Y' at c', + rw H c' _ _ _ (nat_trans.congr_app hα ⟨walking_pair.left⟩) + (nat_trans.congr_app hα ⟨walking_pair.right⟩), + split, { rintros H ⟨⟨⟩⟩, exacts [H.1, H.2] }, { intro H, exact ⟨H _, H _⟩ } } +end + +lemma binary_cofan.is_van_kampen_mk {X Y : C} (c : binary_cofan X Y) + (cofans : ∀ (X Y : C), binary_cofan X Y) (colimits : ∀ X Y, is_colimit (cofans X Y)) + (cones : ∀ {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z), pullback_cone f g) + (limits : ∀ {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z), is_limit (cones f g)) + (h₁ : ∀ {X' Y' : C} (αX : X' ⟶ X) (αY : Y' ⟶ Y) (f : (cofans X' Y').X ⟶ c.X) + (hαX : αX ≫ c.inl = (cofans X' Y').inl ≫ f) (hαY : αY ≫ c.inr = (cofans X' Y').inr ≫ f), + is_pullback (cofans X' Y').inl αX f c.inl ∧ is_pullback (cofans X' Y').inr αY f c.inr) + (h₂ : ∀ {Z : C} (f : Z ⟶ c.X), + is_colimit (binary_cofan.mk (cones f c.inl).fst (cones f c.inr).fst)) : + is_van_kampen_colimit c := +begin + rw binary_cofan.is_van_kampen_iff, + introv hX hY, + split, + { rintros ⟨h⟩, + let e := h.cocone_point_unique_up_to_iso (colimits _ _), + obtain ⟨hl, hr⟩ := h₁ αX αY (e.inv ≫ f) (by simp [hX]) (by simp [hY]), + split, + { rw [← category.id_comp αX, ← iso.hom_inv_id_assoc e f], + have : c'.inl ≫ e.hom = 𝟙 X' ≫ (cofans X' Y').inl := by { dsimp, simp }, + haveI : is_iso (𝟙 X') := infer_instance, + exact (is_pullback.of_vert_is_iso ⟨this⟩).paste_vert hl }, + { rw [← category.id_comp αY, ← iso.hom_inv_id_assoc e f], + have : c'.inr ≫ e.hom = 𝟙 Y' ≫ (cofans X' Y').inr := by { dsimp, simp }, + haveI : is_iso (𝟙 Y') := infer_instance, + exact (is_pullback.of_vert_is_iso ⟨this⟩).paste_vert hr } }, + { rintro ⟨H₁, H₂⟩, + refine ⟨is_colimit.of_iso_colimit _ $ (iso_binary_cofan_mk _).symm⟩, + let e₁ : X' ≅ _ := H₁.is_limit.cone_point_unique_up_to_iso (limits _ _), + let e₂ : Y' ≅ _ := H₂.is_limit.cone_point_unique_up_to_iso (limits _ _), + have he₁ : c'.inl = e₁.hom ≫ (cones f c.inl).fst := by simp, + have he₂ : c'.inr = e₂.hom ≫ (cones f c.inr).fst := by simp, + rw [he₁, he₂], + apply binary_cofan.is_colimit_comp_right_iso (binary_cofan.mk _ _), + apply binary_cofan.is_colimit_comp_left_iso (binary_cofan.mk _ _), + exact h₂ f } +end +. +lemma binary_cofan.mono_inr_of_is_van_kampen [has_initial C] {X Y : C} {c : binary_cofan X Y} + (h : is_van_kampen_colimit c) : mono c.inr := +begin + refine pullback_cone.mono_of_is_limit_mk_id_id _ (is_pullback.is_limit _), + refine (h (binary_cofan.mk (initial.to Y) (𝟙 Y)) + (map_pair (initial.to X) (𝟙 Y)) c.inr _ (map_pair_equifibered _)).mp ⟨_⟩ ⟨walking_pair.right⟩, + { ext ⟨⟨⟩⟩; dsimp; simp }, + { exact ((binary_cofan.is_colimit_iff_is_iso_inr initial_is_initial _).mpr + (by { dsimp, apply_instance })).some } +end + +lemma finitary_extensive.mono_inr_of_is_colimit [finitary_extensive C] + {c : binary_cofan X Y} (hc : is_colimit c) : mono c.inr := +binary_cofan.mono_inr_of_is_van_kampen (finitary_extensive.van_kampen c hc) + +lemma finitary_extensive.mono_inl_of_is_colimit [finitary_extensive C] + {c : binary_cofan X Y} (hc : is_colimit c) : mono c.inl := +finitary_extensive.mono_inr_of_is_colimit (binary_cofan.is_colimit_flip hc) + +instance [finitary_extensive C] (X Y : C) : mono (coprod.inl : X ⟶ X ⨿ Y) := +(finitary_extensive.mono_inl_of_is_colimit (coprod_is_coprod X Y) : _) + +instance [finitary_extensive C] (X Y : C) : mono (coprod.inr : Y ⟶ X ⨿ Y) := +(finitary_extensive.mono_inr_of_is_colimit (coprod_is_coprod X Y) : _) + +lemma binary_cofan.is_pullback_initial_to_of_is_van_kampen [has_initial C] + {c : binary_cofan X Y} + (h : is_van_kampen_colimit c) : is_pullback (initial.to _) (initial.to _) c.inl c.inr := +begin + refine ((h (binary_cofan.mk (initial.to Y) (𝟙 Y)) (map_pair (initial.to X) (𝟙 Y)) c.inr _ + (map_pair_equifibered _)).mp ⟨_⟩ ⟨walking_pair.left⟩).flip, + { ext ⟨⟨⟩⟩; dsimp; simp }, + { exact ((binary_cofan.is_colimit_iff_is_iso_inr initial_is_initial _).mpr + (by { dsimp, apply_instance })).some } +end + +lemma finitary_extensive.is_pullback_initial_to_binary_cofan [finitary_extensive C] + {c : binary_cofan X Y} (hc : is_colimit c) : + is_pullback (initial.to _) (initial.to _) c.inl c.inr := +binary_cofan.is_pullback_initial_to_of_is_van_kampen (finitary_extensive.van_kampen c hc) + +lemma has_strict_initial_of_is_universal [has_initial C] + (H : is_universal_colimit (binary_cofan.mk (𝟙 (⊥_ C)) (𝟙 (⊥_ C)))) : + has_strict_initial_objects C := +has_strict_initial_objects_of_initial_is_strict +begin + intros A f, + suffices : is_colimit (binary_cofan.mk (𝟙 A) (𝟙 A)), + { obtain ⟨l, h₁, h₂⟩ := limits.binary_cofan.is_colimit.desc' this (f ≫ initial.to A) (𝟙 A), + rcases (category.id_comp _).symm.trans h₂ with rfl, + exact ⟨⟨_, ((category.id_comp _).symm.trans h₁).symm, initial_is_initial.hom_ext _ _⟩⟩ }, + refine (H (binary_cofan.mk (𝟙 _) (𝟙 _)) (map_pair f f) f (by ext ⟨⟨⟩⟩; dsimp; simp) + (map_pair_equifibered _) _).some, + rintro ⟨⟨⟩⟩; dsimp; + exact is_pullback.of_horiz_is_iso ⟨(category.id_comp _).trans (category.comp_id _).symm⟩ +end + +@[priority 100] +instance has_strict_initial_objects_of_finitary_extensive [finitary_extensive C] : + has_strict_initial_objects C := +has_strict_initial_of_is_universal (finitary_extensive.van_kampen _ + ((binary_cofan.is_colimit_iff_is_iso_inr initial_is_initial _).mpr + (by { dsimp, apply_instance })).some).is_universal + +lemma finitary_extensive_iff_of_is_terminal (C : Type u) [category.{v} C] [has_finite_coproducts C] + (T : C) (HT : is_terminal T) (c₀ : binary_cofan T T) (hc₀ : is_colimit c₀) : + finitary_extensive C ↔ is_van_kampen_colimit c₀ := +begin + refine ⟨λ H, H.2 c₀ hc₀, λ H, _⟩, + constructor, + simp_rw binary_cofan.is_van_kampen_iff at H ⊢, + intros X Y c hc X' Y' c' αX αY f hX hY, + obtain ⟨d, hd, hd'⟩ := limits.binary_cofan.is_colimit.desc' hc + (HT.from _ ≫ c₀.inl) (HT.from _ ≫ c₀.inr), + rw H c' (αX ≫ HT.from _) (αY ≫ HT.from _) (f ≫ d) + (by rw [← reassoc_of hX, hd, category.assoc]) + (by rw [← reassoc_of hY, hd', category.assoc]), + obtain ⟨hl, hr⟩ := (H c (HT.from _) (HT.from _) d hd.symm hd'.symm).mp ⟨hc⟩, + rw [hl.paste_vert_iff hX.symm, hr.paste_vert_iff hY.symm] +end + +instance types.finitary_extensive : finitary_extensive (Type u) := +begin + rw [finitary_extensive_iff_of_is_terminal (Type u) punit types.is_terminal_punit _ + (types.binary_coproduct_colimit _ _)], + apply binary_cofan.is_van_kampen_mk _ _ (λ X Y, types.binary_coproduct_colimit X Y) _ + (λ X Y Z f g, (limits.types.pullback_limit_cone f g).2), + { intros, + split, + { refine ⟨⟨hαX.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩, + intro s, + have : ∀ x, ∃! y, s.fst x = sum.inl y, + { intro x, + cases h : s.fst x, + { simp_rw sum.inl_injective.eq_iff, exact exists_unique_eq' }, + { apply_fun f at h, + cases ((congr_fun s.condition x).symm.trans h).trans (congr_fun hαY val : _).symm } }, + delta exists_unique at this, + choose l hl hl', + exact ⟨l, (funext hl).symm, types.is_terminal_punit.hom_ext _ _, + λ l' h₁ h₂, funext $ λ x, hl' x (l' x) (congr_fun h₁ x).symm⟩ }, + { refine ⟨⟨hαY.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩, + intro s, dsimp, + have : ∀ x, ∃! y, s.fst x = sum.inr y, + { intro x, + cases h : s.fst x, + { apply_fun f at h, + cases ((congr_fun s.condition x).symm.trans h).trans (congr_fun hαX val : _).symm }, + { simp_rw sum.inr_injective.eq_iff, exact exists_unique_eq' } }, + delta exists_unique at this, + choose l hl hl', + exact ⟨l, (funext hl).symm, types.is_terminal_punit.hom_ext _ _, + λ l' h₁ h₂, funext $ λ x, hl' x (l' x) (congr_fun h₁ x).symm⟩ } }, + { intros Z f, + dsimp [limits.types.binary_coproduct_cocone], + delta types.pullback_obj, + have : ∀ x, f x = sum.inl punit.star ∨ f x = sum.inr punit.star, + { intro x, rcases f x with (⟨⟨⟩⟩|⟨⟨⟩⟩), exacts [or.inl rfl, or.inr rfl] }, + let eX : {p : Z × punit // f p.fst = sum.inl p.snd} ≃ {x : Z // f x = sum.inl punit.star } := + ⟨λ p, ⟨p.1.1, by convert p.2⟩, λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩, + let eY : {p : Z × punit // f p.fst = sum.inr p.snd} ≃ {x : Z // f x = sum.inr punit.star } := + ⟨λ p, ⟨p.1.1, p.2.trans (congr_arg sum.inr $ subsingleton.elim _ _)⟩, + λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩, + fapply binary_cofan.is_colimit_mk, + { exact λ s x, dite _ (λ h, s.inl $ eX.symm ⟨x, h⟩) + (λ h, s.inr $ eY.symm ⟨x, (this x).resolve_left h⟩) }, + { intro s, ext ⟨⟨x, ⟨⟩⟩, _⟩, dsimp, split_ifs; refl }, + { intro s, ext ⟨⟨x, ⟨⟩⟩, hx⟩, dsimp, split_ifs, { cases h.symm.trans hx }, { refl } }, + { intros s m e₁ e₂, ext x, split_ifs, { rw ← e₁, refl }, { rw ← e₂, refl } } } +end + +section Top + +/-- (Implementation) An auxiliary lemma for the proof that `Top` is finitary extensive. -/ +def finitary_extensive_Top_aux (Z : Top.{u}) (f : Z ⟶ Top.of (punit.{u+1} ⊕ punit.{u+1})) : + is_colimit (binary_cofan.mk + (Top.pullback_fst f (Top.binary_cofan (Top.of punit) (Top.of punit)).inl) + (Top.pullback_fst f (Top.binary_cofan (Top.of punit) (Top.of punit)).inr)) := +begin + have : ∀ x, f x = sum.inl punit.star ∨ f x = sum.inr punit.star, + { intro x, rcases f x with (⟨⟨⟩⟩|⟨⟨⟩⟩), exacts [or.inl rfl, or.inr rfl] }, + let eX : {p : Z × punit // f p.fst = sum.inl p.snd} ≃ { x : Z // f x = sum.inl punit.star } := + ⟨λ p, ⟨p.1.1, p.2.trans (congr_arg sum.inl $ subsingleton.elim _ _)⟩, + λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩, + let eY : {p : Z × punit // f p.fst = sum.inr p.snd} ≃ { x : Z // f x = sum.inr punit.star } := + ⟨λ p, ⟨p.1.1, p.2.trans (congr_arg sum.inr $ subsingleton.elim _ _)⟩, + λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩, + fapply binary_cofan.is_colimit_mk, + { refine λ s, ⟨λ x, dite _ (λ h, s.inl $ eX.symm ⟨x, h⟩) + (λ h, s.inr $ eY.symm ⟨x, (this x).resolve_left h⟩), _⟩, + rw continuous_iff_continuous_at, + intro x, + by_cases f x = sum.inl punit.star, + { revert h x, + apply (is_open.continuous_on_iff _).mp, + { rw continuous_on_iff_continuous_restrict, + convert_to continuous (λ x : {x|f x = sum.inl punit.star}, s.inl ⟨(x, punit.star), x.2⟩), + { ext ⟨x, hx⟩, exact dif_pos hx }, + continuity }, + { convert f.2.1 _ (open_embedding_inl).open_range, ext x, exact ⟨λ h, ⟨_, h.symm⟩, + λ ⟨e, h⟩, h.symm.trans (congr_arg sum.inl $ subsingleton.elim _ _)⟩ } }, + { revert h x, + apply (is_open.continuous_on_iff _).mp, + { rw continuous_on_iff_continuous_restrict, + convert_to continuous (λ x : {x|f x ≠ sum.inl punit.star}, + s.inr ⟨(x, punit.star), (this _).resolve_left x.2⟩), + { ext ⟨x, hx⟩, exact dif_neg hx }, + continuity }, + { convert f.2.1 _ (open_embedding_inr).open_range, ext x, + change f x ≠ sum.inl punit.star ↔ f x ∈ set.range sum.inr, + transitivity f x = sum.inr punit.star, + { rcases f x with (⟨⟨⟩⟩|⟨⟨⟩⟩); + simp only [iff_self, eq_self_iff_true, not_true, ne.def, not_false_iff] }, + { exact ⟨λ h, ⟨_, h.symm⟩, λ ⟨e, h⟩, + h.symm.trans (congr_arg sum.inr $ subsingleton.elim _ _)⟩ } } } }, + { intro s, ext ⟨⟨x, ⟨⟩⟩, _⟩, change dite _ _ _ = _, split_ifs; refl }, + { intro s, ext ⟨⟨x, ⟨⟩⟩, hx⟩, change dite _ _ _ = _, + split_ifs, { cases h.symm.trans hx }, { refl } }, + { intros s m e₁ e₂, ext x, change m x = dite _ _ _, + split_ifs, { rw ← e₁, refl }, { rw ← e₂, refl } } +end + +instance : finitary_extensive Top.{u} := +begin + rw [finitary_extensive_iff_of_is_terminal Top.{u} _ Top.is_terminal_punit _ + (Top.binary_cofan_is_colimit _ _)], + apply binary_cofan.is_van_kampen_mk _ _ (λ X Y, Top.binary_cofan_is_colimit X Y) _ + (λ X Y Z f g, Top.pullback_cone_is_limit f g), + { intros, + split, + { refine ⟨⟨hαX.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩, + intro s, + have : ∀ x, ∃! y, s.fst x = sum.inl y, + { intro x, + cases h : s.fst x, + { simp_rw sum.inl_injective.eq_iff, exact exists_unique_eq' }, + { apply_fun f at h, + cases ((concrete_category.congr_hom s.condition x).symm.trans h).trans + (concrete_category.congr_hom hαY val : _).symm } }, + delta exists_unique at this, + choose l hl hl', + refine ⟨⟨l, _⟩, continuous_map.ext (λ a, (hl a).symm), Top.is_terminal_punit.hom_ext _ _, + λ l' h₁ h₂, continuous_map.ext $ λ x, + hl' x (l' x) (concrete_category.congr_hom h₁ x).symm⟩, + apply embedding_inl.to_inducing.continuous_iff.mpr, + convert s.fst.2 using 1, exact (funext hl).symm }, + { refine ⟨⟨hαY.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩, + intro s, dsimp, + have : ∀ x, ∃! y, s.fst x = sum.inr y, + { intro x, + cases h : s.fst x, + { apply_fun f at h, + cases ((concrete_category.congr_hom s.condition x).symm.trans h).trans + (concrete_category.congr_hom hαX val : _).symm }, + { simp_rw sum.inr_injective.eq_iff, exact exists_unique_eq' } }, + delta exists_unique at this, + choose l hl hl', + refine ⟨⟨l, _⟩, continuous_map.ext (λ a, (hl a).symm), Top.is_terminal_punit.hom_ext _ _, + λ l' h₁ h₂, continuous_map.ext $ + λ x, hl' x (l' x) (concrete_category.congr_hom h₁ x).symm⟩, + apply embedding_inr.to_inducing.continuous_iff.mpr, + convert s.fst.2 using 1, exact (funext hl).symm } }, + { intros Z f, exact finitary_extensive_Top_aux Z f } +end + +end Top + +section functor + +universes v'' u'' + +variables {D : Type u''} [category.{v''} D] + +lemma nat_trans.equifibered.whisker_right {F G : J ⥤ C} {α : F ⟶ G} (hα : α.equifibered) + (H : C ⥤ D) [preserves_limits_of_shape walking_cospan H] : (whisker_right α H).equifibered := +λ i j f, (hα f).map H + +lemma is_van_kampen_colimit.of_iso {F : J ⥤ C} {c c' : cocone F} (H : is_van_kampen_colimit c) + (e : c ≅ c') : is_van_kampen_colimit c' := +begin + intros F' c'' α f h hα, + have : c'.ι ≫ (functor.const J).map e.inv.hom = c.ι, + { ext j, exact e.inv.2 j }, + rw H c'' α (f ≫ e.inv.1) (by rw [functor.map_comp, ← reassoc_of h, this]) hα, + apply forall_congr, + intro j, + conv_lhs { rw [← category.comp_id (α.app j)] }, + haveI : is_iso e.inv.hom := functor.map_is_iso (cocones.forget _) e.inv, + exact (is_pullback.of_vert_is_iso ⟨by simp⟩).paste_vert_iff (nat_trans.congr_app h j).symm +end + +lemma is_van_kampen_colimit.of_map {D : Type*} [category D] (G : C ⥤ D) {F : J ⥤ C} {c : cocone F} + [preserves_limits_of_shape walking_cospan G] [reflects_limits_of_shape walking_cospan G] + [preserves_colimits_of_shape J G] [reflects_colimits_of_shape J G] + (H : is_van_kampen_colimit (G.map_cocone c)) : is_van_kampen_colimit c := +begin + intros F' c' α f h hα, + refine (iff.trans _ (H (G.map_cocone c') (whisker_right α G) (G.map f) + (by { ext j, simpa using G.congr_map (nat_trans.congr_app h j) }) + (hα.whisker_right G))).trans (forall_congr $ λ j, _), + { exact ⟨λ h, ⟨is_colimit_of_preserves G h.some⟩, λ h, ⟨is_colimit_of_reflects G h.some⟩⟩ }, + { exact is_pullback.map_iff G (nat_trans.congr_app h.symm j) } +end + +lemma is_van_kampen_colimit_of_evaluation [has_pullbacks D] [has_colimits_of_shape J D] + (F : J ⥤ C ⥤ D) (c : cocone F) + (hc : ∀ x : C, is_van_kampen_colimit (((evaluation C D).obj x).map_cocone c)) : + is_van_kampen_colimit c := +begin + intros F' c' α f e hα, + have := λ x, hc x (((evaluation C D).obj x).map_cocone c') (whisker_right α _) + (((evaluation C D).obj x).map f) + (by { ext y, dsimp, exact nat_trans.congr_app (nat_trans.congr_app e y) x }) + (hα.whisker_right _), + split, + { rintros ⟨hc'⟩ j, + refine ⟨⟨(nat_trans.congr_app e j).symm⟩, ⟨evaluation_jointly_reflects_limits _ _⟩⟩, + refine λ x, (is_limit_map_cone_pullback_cone_equiv _ _).symm _, + exact ((this x).mp ⟨preserves_colimit.preserves hc'⟩ _).is_limit }, + { exact λ H, ⟨evaluation_jointly_reflects_colimits _ + (λ x, ((this x).mpr (λ j, (H j).map ((evaluation C D).obj x))).some)⟩ } +end + +instance [has_pullbacks C] [finitary_extensive C] : finitary_extensive (D ⥤ C) := +begin + haveI : has_finite_coproducts (D ⥤ C) := ⟨λ n, limits.functor_category_has_colimits_of_shape⟩, + exact ⟨λ X Y c hc, is_van_kampen_colimit_of_evaluation _ c + (λ x, finitary_extensive.van_kampen _ $ preserves_colimit.preserves hc)⟩ +end + +lemma finitary_extensive_of_preserves_and_reflects (F : C ⥤ D) + [finitary_extensive D] [has_finite_coproducts C] + [preserves_limits_of_shape walking_cospan F] + [reflects_limits_of_shape walking_cospan F] + [preserves_colimits_of_shape (discrete walking_pair) F] + [reflects_colimits_of_shape (discrete walking_pair) F] : + finitary_extensive C := +⟨λ X Y c hc, (finitary_extensive.van_kampen _ (is_colimit_of_preserves F hc)).of_map F⟩ + +lemma finitary_extensive_of_preserves_and_reflects_isomorphism (F : C ⥤ D) + [finitary_extensive D] [has_finite_coproducts C] [has_pullbacks C] + [preserves_limits_of_shape walking_cospan F] + [preserves_colimits_of_shape (discrete walking_pair) F] + [reflects_isomorphisms F] : + finitary_extensive C := +begin + haveI : reflects_limits_of_shape walking_cospan F := + reflects_limits_of_shape_of_reflects_isomorphisms, + haveI : reflects_colimits_of_shape (discrete walking_pair) F := + reflects_colimits_of_shape_of_reflects_isomorphisms, + exact finitary_extensive_of_preserves_and_reflects F, +end + +end functor + +end extensive + +end category_theory diff --git a/src/category_theory/filtered.lean b/src/category_theory/filtered.lean index 72cadd5325b45..f5a59fff52541 100644 --- a/src/category_theory/filtered.lean +++ b/src/category_theory/filtered.lean @@ -8,11 +8,13 @@ import category_theory.limits.cones import category_theory.adjunction.basic import category_theory.category.preorder import category_theory.category.ulift -import order.bounded_order /-! # Filtered categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category is filtered if every finite diagram admits a cocone. We give a simple characterisation of this condition as 1. for every pair of objects there exists another object "to the right", @@ -51,7 +53,8 @@ commute with finite limits. open function -universes v v₁ u u₁ u₂ -- declare the `v`'s first; see `category_theory.category` for an explanation +-- declare the `v`'s first; see `category_theory.category` for an explanation +universes w v v₁ u u₁ u₂ namespace category_theory @@ -97,7 +100,7 @@ instance is_filtered_or_empty_of_directed_le (α : Type u) [preorder α] [is_dir cocone_maps := λ X Y f g, ⟨Y, 𝟙 _, by simp⟩ } @[priority 100] -instance is_filtered_of_directed_le_nonempty (α : Type u) [preorder α] [is_directed α (≤)] +instance is_filtered_of_directed_le_nonempty (α : Type u) [preorder α] [is_directed α (≤)] [nonempty α] : is_filtered α := {} @@ -105,30 +108,42 @@ instance is_filtered_of_directed_le_nonempty (α : Type u) [preorder α] [is_di example (α : Type u) [semilattice_sup α] [order_bot α] : is_filtered α := by apply_instance example (α : Type u) [semilattice_sup α] [order_top α] : is_filtered α := by apply_instance +instance : is_filtered (discrete punit) := +{ cocone_objs := λ X Y, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, ⟨⟨dec_trivial⟩⟩, trivial⟩, + cocone_maps := λ X Y f g, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, dec_trivial⟩, + nonempty := ⟨⟨punit.star⟩⟩ } + namespace is_filtered -variables {C} [is_filtered C] +section allow_empty + +variables {C} [is_filtered_or_empty C] + +lemma cocone_objs : ∀ (X Y : C), ∃ Z (f : X ⟶ Z) (g : Y ⟶ Z), true := +is_filtered_or_empty.cocone_objs +lemma cocone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ Z (h : Y ⟶ Z), f ≫ h = g ≫ h := +is_filtered_or_empty.cocone_maps /-- `max j j'` is an arbitrary choice of object to the right of both `j` and `j'`, whose existence is ensured by `is_filtered`. -/ noncomputable def max (j j' : C) : C := -(is_filtered_or_empty.cocone_objs j j').some +(cocone_objs j j').some /-- -`left_to_max j j'` is an arbitrarily choice of morphism from `j` to `max j j'`, +`left_to_max j j'` is an arbitrary choice of morphism from `j` to `max j j'`, whose existence is ensured by `is_filtered`. -/ noncomputable def left_to_max (j j' : C) : j ⟶ max j j' := -(is_filtered_or_empty.cocone_objs j j').some_spec.some +(cocone_objs j j').some_spec.some /-- -`right_to_max j j'` is an arbitrarily choice of morphism from `j'` to `max j j'`, +`right_to_max j j'` is an arbitrary choice of morphism from `j'` to `max j j'`, whose existence is ensured by `is_filtered`. -/ noncomputable def right_to_max (j j' : C) : j' ⟶ max j j' := -(is_filtered_or_empty.cocone_objs j j').some_spec.some_spec.some +(cocone_objs j j').some_spec.some_spec.some /-- `coeq f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of object @@ -137,7 +152,7 @@ which admits a morphism `coeq_hom f f' : j' ⟶ coeq f f'` such that Its existence is ensured by `is_filtered`. -/ noncomputable def coeq {j j' : C} (f f' : j ⟶ j') : C := -(is_filtered_or_empty.cocone_maps f f').some +(cocone_maps f f').some /-- `coeq_hom f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of morphism @@ -146,7 +161,7 @@ noncomputable def coeq {j j' : C} (f f' : j ⟶ j') : C := Its existence is ensured by `is_filtered`. -/ noncomputable def coeq_hom {j j' : C} (f f' : j ⟶ j') : j' ⟶ coeq f f' := -(is_filtered_or_empty.cocone_maps f f').some_spec.some +(cocone_maps f f').some_spec.some /-- `coeq_condition f f'`, for morphisms `f f' : j ⟶ j'`, is the proof that @@ -154,10 +169,16 @@ noncomputable def coeq_hom {j j' : C} (f f' : j ⟶ j') : j' ⟶ coeq f f' := -/ @[simp, reassoc] lemma coeq_condition {j j' : C} (f f' : j ⟶ j') : f ≫ coeq_hom f f' = f' ≫ coeq_hom f f' := -(is_filtered_or_empty.cocone_maps f f').some_spec.some_spec +(cocone_maps f f').some_spec.some_spec + +end allow_empty + +section nonempty open category_theory.limits +variables {C} [is_filtered C] + /-- Any finite collection of objects in a filtered category has an object "to the right". -/ @@ -286,8 +307,12 @@ of_right_adjoint (adjunction.of_right_adjoint R) lemma of_equivalence (h : C ≌ D) : is_filtered D := of_right_adjoint h.symm.to_adjunction +end nonempty + section special_shapes +variables {C} [is_filtered_or_empty C] + /-- `max₃ j₁ j₂ j₃` is an arbitrary choice of object to the right of `j₁`, `j₂` and `j₃`, whose existence is ensured by `is_filtered`. @@ -295,21 +320,21 @@ whose existence is ensured by `is_filtered`. noncomputable def max₃ (j₁ j₂ j₃ : C) : C := max (max j₁ j₂) j₃ /-- -`first_to_max₃ j₁ j₂ j₃` is an arbitrarily choice of morphism from `j₁` to `max₃ j₁ j₂ j₃`, +`first_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₁` to `max₃ j₁ j₂ j₃`, whose existence is ensured by `is_filtered`. -/ noncomputable def first_to_max₃ (j₁ j₂ j₃ : C) : j₁ ⟶ max₃ j₁ j₂ j₃ := left_to_max j₁ j₂ ≫ left_to_max (max j₁ j₂) j₃ /-- -`second_to_max₃ j₁ j₂ j₃` is an arbitrarily choice of morphism from `j₂` to `max₃ j₁ j₂ j₃`, +`second_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₂` to `max₃ j₁ j₂ j₃`, whose existence is ensured by `is_filtered`. -/ noncomputable def second_to_max₃ (j₁ j₂ j₃ : C) : j₂ ⟶ max₃ j₁ j₂ j₃ := right_to_max j₁ j₂ ≫ left_to_max (max j₁ j₂) j₃ /-- -`third_to_max₃ j₁ j₂ j₃` is an arbitrarily choice of morphism from `j₃` to `max₃ j₁ j₂ j₃`, +`third_to_max₃ j₁ j₂ j₃` is an arbitrary choice of morphism from `j₃` to `max₃ j₁ j₂ j₃`, whose existence is ensured by `is_filtered`. -/ noncomputable def third_to_max₃ (j₁ j₂ j₃ : C) : j₃ ⟶ max₃ j₁ j₂ j₃ := @@ -337,11 +362,7 @@ coeq_hom (coeq_hom f g ≫ left_to_max (coeq f g) (coeq g h)) lemma coeq₃_condition₁ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : f ≫ coeq₃_hom f g h = g ≫ coeq₃_hom f g h := -begin - dsimp [coeq₃_hom], - slice_lhs 1 2 { rw coeq_condition f g }, - simp only [category.assoc], -end +by rw [coeq₃_hom, reassoc_of (coeq_condition f g)] lemma coeq₃_condition₂ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : g ≫ coeq₃_hom f g h = h ≫ coeq₃_hom f g h := @@ -357,6 +378,13 @@ lemma coeq₃_condition₃ {j₁ j₂ : C} (f g h : j₁ ⟶ j₂) : f ≫ coeq₃_hom f g h = h ≫ coeq₃_hom f g h := eq.trans (coeq₃_condition₁ f g h) (coeq₃_condition₂ f g h) +/-- For every span `j ⟵ i ⟶ j'`, there + exists a cocone `j ⟶ k ⟵ j'` such that the square commutes. -/ +lemma span {i j j' : C} (f : i ⟶ j) (f' : i ⟶ j') : + ∃ (k : C) (g : j ⟶ k) (g' : j' ⟶ k), f ≫ g = f' ≫ g' := +let ⟨K, G, G', _⟩ := cocone_objs j j', ⟨k, e, he⟩ := cocone_maps (f ≫ G) (f' ≫ G') in +⟨k, G ≫ e, G' ≫ e, by simpa only [← category.assoc]⟩ + /-- Given a "bowtie" of morphisms ``` @@ -375,24 +403,10 @@ lemma bowtie {j₁ j₂ k₁ k₂ : C} (f₁ : j₁ ⟶ k₁) (g₁ : j₁ ⟶ k₂) (f₂ : j₂ ⟶ k₁) (g₂ : j₂ ⟶ k₂) : ∃ (s : C) (α : k₁ ⟶ s) (β : k₂ ⟶ s), f₁ ≫ α = g₁ ≫ β ∧ f₂ ≫ α = g₂ ≫ β := begin - let sa := max k₁ k₂, - let sb := coeq (f₁ ≫ left_to_max _ _) (g₁ ≫ right_to_max _ _), - let sc := coeq (f₂ ≫ left_to_max _ _) (g₂ ≫ right_to_max _ _), - let sd := max sb sc, - let s := coeq ((coeq_hom _ _ : sa ⟶ sb) ≫ left_to_max _ _) - ((coeq_hom _ _ : sa ⟶ sc) ≫ right_to_max _ _), - use s, - fsplit, - exact left_to_max k₁ k₂ ≫ coeq_hom _ _ ≫ left_to_max sb sc ≫ coeq_hom _ _, - fsplit, - exact right_to_max k₁ k₂ ≫ coeq_hom _ _ ≫ right_to_max sb sc ≫ coeq_hom _ _, - fsplit, - { slice_lhs 1 3 { rw [←category.assoc, coeq_condition], }, - slice_lhs 3 5 { rw [←category.assoc, coeq_condition], }, - simp only [category.assoc], }, - { slice_lhs 3 5 { rw [←category.assoc, coeq_condition], }, - slice_lhs 1 3 { rw [←category.assoc, coeq_condition], }, - simp only [category.assoc], } + obtain ⟨t, k₁t, k₂t, ht⟩ := span f₁ g₁, + obtain ⟨s, ts, hs⟩ := cocone_maps (f₂ ≫ k₁t) (g₂ ≫ k₂t), + simp_rw category.assoc at hs, + exact ⟨s, k₁t ≫ ts, k₂t ≫ ts, by rw reassoc_of ht, hs⟩, end /-- @@ -411,36 +425,17 @@ Given a "tulip" of morphisms l ``` in a filtered category, we can construct an object `s` and three morphisms from `k₁`, `k₂` and `l` -to `s`, making the resulting sqaures commute. +to `s`, making the resulting squares commute. -/ lemma tulip {j₁ j₂ j₃ k₁ k₂ l : C} (f₁ : j₁ ⟶ k₁) (f₂ : j₂ ⟶ k₁) (f₃ : j₂ ⟶ k₂) (f₄ : j₃ ⟶ k₂) (g₁ : j₁ ⟶ l) (g₂ : j₃ ⟶ l) : ∃ (s : C) (α : k₁ ⟶ s) (β : l ⟶ s) (γ : k₂ ⟶ s), f₁ ≫ α = g₁ ≫ β ∧ f₂ ≫ α = f₃ ≫ γ ∧ f₄ ≫ γ = g₂ ≫ β := begin - let sa := max₃ k₁ l k₂, - let sb := coeq (f₁ ≫ first_to_max₃ k₁ l k₂) (g₁ ≫ second_to_max₃ k₁ l k₂), - let sc := coeq (f₂ ≫ first_to_max₃ k₁ l k₂) (f₃ ≫ third_to_max₃ k₁ l k₂), - let sd := coeq (f₄ ≫ third_to_max₃ k₁ l k₂) (g₂ ≫ second_to_max₃ k₁ l k₂), - let se := max₃ sb sc sd, - let sf := coeq₃ (coeq_hom _ _ ≫ first_to_max₃ sb sc sd) - (coeq_hom _ _ ≫ second_to_max₃ sb sc sd) (coeq_hom _ _ ≫ third_to_max₃ sb sc sd), - use sf, - use first_to_max₃ k₁ l k₂ ≫ coeq_hom _ _ ≫ first_to_max₃ sb sc sd ≫ coeq₃_hom _ _ _, - use second_to_max₃ k₁ l k₂ ≫ coeq_hom _ _ ≫ second_to_max₃ sb sc sd ≫ coeq₃_hom _ _ _, - use third_to_max₃ k₁ l k₂ ≫ coeq_hom _ _ ≫ third_to_max₃ sb sc sd ≫ coeq₃_hom _ _ _, - fsplit, - slice_lhs 1 3 { rw [← category.assoc, coeq_condition] }, - slice_lhs 3 6 { rw [← category.assoc, coeq₃_condition₁] }, - simp only [category.assoc], - fsplit, - slice_lhs 3 6 { rw [← category.assoc, coeq₃_condition₁] }, - slice_lhs 1 3 { rw [← category.assoc, coeq_condition] }, - slice_rhs 3 6 { rw [← category.assoc, ← coeq₃_condition₂] }, - simp only [category.assoc], - slice_rhs 3 6 { rw [← category.assoc, coeq₃_condition₂] }, - slice_rhs 1 3 { rw [← category.assoc, ← coeq_condition] }, - simp only [category.assoc], + obtain ⟨l', k₁l, k₂l, hl⟩ := span f₂ f₃, + obtain ⟨s, ls, l's, hs₁, hs₂⟩ := bowtie g₁ (f₁ ≫ k₁l) g₂ (f₄ ≫ k₂l), + refine ⟨s, k₁l ≫ l's, ls, k₂l ≫ l's, _, by rw reassoc_of hl, _⟩; + simp only [hs₁, hs₂, category.assoc], end end special_shapes @@ -454,8 +449,8 @@ A category `is_cofiltered_or_empty` if are equal. -/ class is_cofiltered_or_empty : Prop := -(cocone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true) -(cocone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g) +(cone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true) +(cone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g) /-- A category `is_cofiltered` if @@ -472,8 +467,8 @@ class is_cofiltered extends is_cofiltered_or_empty C : Prop := @[priority 100] instance is_cofiltered_or_empty_of_semilattice_inf (α : Type u) [semilattice_inf α] : is_cofiltered_or_empty α := -{ cocone_objs := λ X Y, ⟨X ⊓ Y, hom_of_le inf_le_left, hom_of_le inf_le_right, trivial⟩, - cocone_maps := λ X Y f g, ⟨X, 𝟙 _, (by ext)⟩, } +{ cone_objs := λ X Y, ⟨X ⊓ Y, hom_of_le inf_le_left, hom_of_le inf_le_right, trivial⟩, + cone_maps := λ X Y f g, ⟨X, 𝟙 _, (by ext)⟩, } @[priority 100] instance is_cofiltered_of_semilattice_inf_nonempty @@ -481,14 +476,14 @@ instance is_cofiltered_of_semilattice_inf_nonempty @[priority 100] instance is_cofiltered_or_empty_of_directed_ge (α : Type u) [preorder α] - [is_directed α (swap (≤))] : + [is_directed α (≥)] : is_cofiltered_or_empty α := -{ cocone_objs := λ X Y, let ⟨Z, hX, hY⟩ := exists_le_le X Y in +{ cone_objs := λ X Y, let ⟨Z, hX, hY⟩ := exists_le_le X Y in ⟨Z, hom_of_le hX, hom_of_le hY, trivial⟩, - cocone_maps := λ X Y f g, ⟨X, 𝟙 _, by simp⟩ } + cone_maps := λ X Y f g, ⟨X, 𝟙 _, by simp⟩ } @[priority 100] -instance is_cofiltered_of_directed_ge_nonempty (α : Type u) [preorder α] [is_directed α (swap (≤))] +instance is_cofiltered_of_directed_ge_nonempty (α : Type u) [preorder α] [is_directed α (≥)] [nonempty α] : is_cofiltered α := {} @@ -496,30 +491,41 @@ instance is_cofiltered_of_directed_ge_nonempty (α : Type u) [preorder α] [is_ example (α : Type u) [semilattice_inf α] [order_bot α] : is_cofiltered α := by apply_instance example (α : Type u) [semilattice_inf α] [order_top α] : is_cofiltered α := by apply_instance +instance : is_cofiltered (discrete punit) := +{ cone_objs := λ X Y, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, ⟨⟨dec_trivial⟩⟩, trivial⟩, + cone_maps := λ X Y f g, ⟨⟨punit.star⟩, ⟨⟨dec_trivial⟩⟩, dec_trivial⟩, + nonempty := ⟨⟨punit.star⟩⟩ } + namespace is_cofiltered -variables {C} [is_cofiltered C] +section allow_empty + +variables {C} [is_cofiltered_or_empty C] + +lemma cone_objs : ∀ (X Y : C), ∃ W (f : W ⟶ X) (g : W ⟶ Y), true := is_cofiltered_or_empty.cone_objs +lemma cone_maps : ∀ ⦃X Y : C⦄ (f g : X ⟶ Y), ∃ W (h : W ⟶ X), h ≫ f = h ≫ g := +is_cofiltered_or_empty.cone_maps /-- `min j j'` is an arbitrary choice of object to the left of both `j` and `j'`, whose existence is ensured by `is_cofiltered`. -/ noncomputable def min (j j' : C) : C := -(is_cofiltered_or_empty.cocone_objs j j').some +(cone_objs j j').some /-- -`min_to_left j j'` is an arbitrarily choice of morphism from `min j j'` to `j`, +`min_to_left j j'` is an arbitrary choice of morphism from `min j j'` to `j`, whose existence is ensured by `is_cofiltered`. -/ noncomputable def min_to_left (j j' : C) : min j j' ⟶ j := -(is_cofiltered_or_empty.cocone_objs j j').some_spec.some +(cone_objs j j').some_spec.some /-- -`min_to_right j j'` is an arbitrarily choice of morphism from `min j j'` to `j'`, +`min_to_right j j'` is an arbitrary choice of morphism from `min j j'` to `j'`, whose existence is ensured by `is_cofiltered`. -/ noncomputable def min_to_right (j j' : C) : min j j' ⟶ j' := -(is_cofiltered_or_empty.cocone_objs j j').some_spec.some_spec.some +(cone_objs j j').some_spec.some_spec.some /-- `eq f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of object @@ -528,7 +534,7 @@ which admits a morphism `eq_hom f f' : eq f f' ⟶ j` such that Its existence is ensured by `is_cofiltered`. -/ noncomputable def eq {j j' : C} (f f' : j ⟶ j') : C := -(is_cofiltered_or_empty.cocone_maps f f').some +(cone_maps f f').some /-- `eq_hom f f'`, for morphisms `f f' : j ⟶ j'`, is an arbitrary choice of morphism @@ -537,7 +543,7 @@ noncomputable def eq {j j' : C} (f f' : j ⟶ j') : C := Its existence is ensured by `is_cofiltered`. -/ noncomputable def eq_hom {j j' : C} (f f' : j ⟶ j') : eq f f' ⟶ j := -(is_cofiltered_or_empty.cocone_maps f f').some_spec.some +(cone_maps f f').some_spec.some /-- `eq_condition f f'`, for morphisms `f f' : j ⟶ j'`, is the proof that @@ -545,10 +551,28 @@ noncomputable def eq_hom {j j' : C} (f f' : j ⟶ j') : eq f f' ⟶ j := -/ @[simp, reassoc] lemma eq_condition {j j' : C} (f f' : j ⟶ j') : eq_hom f f' ≫ f = eq_hom f f' ≫ f' := -(is_cofiltered_or_empty.cocone_maps f f').some_spec.some_spec +(cone_maps f f').some_spec.some_spec + +/-- For every cospan `j ⟶ i ⟵ j'`, + there exists a cone `j ⟵ k ⟶ j'` such that the square commutes. -/ +lemma cospan {i j j' : C} (f : j ⟶ i) (f' : j' ⟶ i) : + ∃ (k : C) (g : k ⟶ j) (g' : k ⟶ j'), g ≫ f = g' ≫ f' := +let ⟨K, G, G', _⟩ := cone_objs j j', ⟨k, e, he⟩ := cone_maps (G ≫ f) (G' ≫ f') in +⟨k, e ≫ G, e ≫ G', by simpa only [category.assoc] using he⟩ + +lemma _root_.category_theory.functor.ranges_directed (F : C ⥤ Type*) (j : C) : + directed (⊇) (λ (f : Σ' i, i ⟶ j), set.range (F.map f.2)) := +λ ⟨i, ij⟩ ⟨k, kj⟩, let ⟨l, li, lk, e⟩ := cospan ij kj in +by refine ⟨⟨l, lk ≫ kj⟩, e ▸ _, _⟩; simp_rw F.map_comp; apply set.range_comp_subset_range + +end allow_empty + +section nonempty open category_theory.limits +variables {C} [is_cofiltered C] + /-- Any finite collection of objects in a cofiltered category has an object "to the left". -/ @@ -626,7 +650,7 @@ lemma inf_to_commutes inf_to O H mX ≫ f = inf_to O H mY := (inf_exists O H).some_spec.some_spec mX mY mf -variables {J : Type v} [small_category J] [fin_category J] +variables {J : Type w} [small_category J] [fin_category J] /-- If we have `is_cofiltered C`, then for any functor `F : J ⥤ C` with `fin_category J`, @@ -664,10 +688,10 @@ If `C` is cofiltered, and we have a functor `L : C ⥤ D` with a right adjoint, then `D` is cofiltered. -/ lemma of_left_adjoint {L : C ⥤ D} {R : D ⥤ C} (h : L ⊣ R) : is_cofiltered D := -{ cocone_objs := λ X Y, +{ cone_objs := λ X Y, ⟨L.obj (min (R.obj X) (R.obj Y)), (h.hom_equiv _ X).symm (min_to_left _ _), (h.hom_equiv _ Y).symm (min_to_right _ _), ⟨⟩⟩, - cocone_maps := λ X Y f g, + cone_maps := λ X Y f g, ⟨L.obj (eq (R.map f) (R.map g)), (h.hom_equiv _ _).symm (eq_hom _ _), by rw [← h.hom_equiv_naturality_right_symm, ← h.hom_equiv_naturality_right_symm, eq_condition]⟩, @@ -681,15 +705,17 @@ of_left_adjoint (adjunction.of_left_adjoint L) lemma of_equivalence (h : C ≌ D) : is_cofiltered D := of_left_adjoint h.to_adjunction +end nonempty + end is_cofiltered section opposite open opposite instance is_cofiltered_op_of_is_filtered [is_filtered C] : is_cofiltered Cᵒᵖ := -{ cocone_objs := λ X Y, ⟨op (is_filtered.max X.unop Y.unop), +{ cone_objs := λ X Y, ⟨op (is_filtered.max X.unop Y.unop), (is_filtered.left_to_max _ _).op, (is_filtered.right_to_max _ _).op, trivial⟩, - cocone_maps := λ X Y f g, ⟨op (is_filtered.coeq f.unop g.unop), + cone_maps := λ X Y f g, ⟨op (is_filtered.coeq f.unop g.unop), (is_filtered.coeq_hom _ _).op, begin rw [(show f = f.unop.op, by simp), (show g = g.unop.op, by simp), ← op_comp, ← op_comp], diff --git a/src/category_theory/fin_category.lean b/src/category_theory/fin_category.lean index da22a25bbb1bd..a9ba4f285edeb 100644 --- a/src/category_theory/fin_category.lean +++ b/src/category_theory/fin_category.lean @@ -3,43 +3,46 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import data.fintype.basic +import data.fintype.card import category_theory.discrete_category import category_theory.opposites +import category_theory.category.ulift /-! # Finite categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category is finite in this sense if it has finitely many objects, and finitely many morphisms. ## Implementation - -We also ask for decidable equality of objects and morphisms, but it may be reasonable to just -go classical in future. +Prior to #14046, `fin_category` required a `decidable_eq` instance on the object and morphism types. +This does not seem to have had any practical payoff (i.e. making some definition constructive) +so we have removed these requirements to avoid +having to supply instances or delay with non-defeq conflicts between instances. -/ -universes v u +universes w v u +open_locale classical +noncomputable theory namespace category_theory instance discrete_fintype {α : Type*} [fintype α] : fintype (discrete α) := -by { dsimp [discrete], apply_instance } +fintype.of_equiv α (discrete_equiv.symm) -instance discrete_hom_fintype {α : Type*} [decidable_eq α] (X Y : discrete α) : fintype (X ⟶ Y) := +instance discrete_hom_fintype {α : Type*} (X Y : discrete α) : fintype (X ⟶ Y) := by { apply ulift.fintype } /-- A category with a `fintype` of objects, and a `fintype` for each morphism space. -/ class fin_category (J : Type v) [small_category J] := -(decidable_eq_obj : decidable_eq J . tactic.apply_instance) (fintype_obj : fintype J . tactic.apply_instance) -(decidable_eq_hom : Π (j j' : J), decidable_eq (j ⟶ j') . tactic.apply_instance) (fintype_hom : Π (j j' : J), fintype (j ⟶ j') . tactic.apply_instance) -attribute [instance] fin_category.decidable_eq_obj fin_category.fintype_obj - fin_category.decidable_eq_hom fin_category.fintype_hom +attribute [instance] fin_category.fintype_obj fin_category.fintype_hom --- We need a `decidable_eq` instance here to construct `fintype` on the morphism spaces. -instance fin_category_discrete_of_decidable_fintype (J : Type v) [decidable_eq J] [fintype J] : +instance fin_category_discrete_of_fintype (J : Type v) [fintype J] : fin_category (discrete J) := { } @@ -57,15 +60,14 @@ noncomputable def obj_as_type_equiv : obj_as_type α ≌ α := /-- A fin_category `α` is equivalent to a fin_category with in `Type`. -/ @[nolint unused_arguments] abbreviation as_type : Type := fin (fintype.card α) -@[simps hom id comp (lemmas_only)] noncomputable +@[simps id comp (lemmas_only)] noncomputable instance category_as_type : small_category (as_type α) := { hom := λ i j, fin (fintype.card (@quiver.hom (obj_as_type α) _ i j)), id := λ i, fintype.equiv_fin _ (𝟙 i), comp := λ i j k f g, fintype.equiv_fin _ ((fintype.equiv_fin _).symm f ≫ (fintype.equiv_fin _).symm g) } -local attribute [simp] category_as_type_hom category_as_type_id - category_as_type_comp +local attribute [simp] category_as_type_id category_as_type_comp /-- The "identity" functor from `as_type α` to `obj_as_type α`. -/ @[simps] noncomputable def as_type_to_obj_as_type : as_type α ⥤ obj_as_type α := @@ -97,9 +99,12 @@ The opposite of a finite category is finite. -/ instance fin_category_opposite {J : Type v} [small_category J] [fin_category J] : fin_category Jᵒᵖ := -{ decidable_eq_obj := equiv.decidable_eq equiv_to_opposite.symm, - fintype_obj := fintype.of_equiv _ equiv_to_opposite, - decidable_eq_hom := λ j j', equiv.decidable_eq (op_equiv j j'), +{ fintype_obj := fintype.of_equiv _ equiv_to_opposite, fintype_hom := λ j j', fintype.of_equiv _ (op_equiv j j').symm, } +/-- Applying `ulift` to morphisms and objects of a category preserves finiteness. -/ +instance fin_category_ulift {J : Type v} [small_category J] [fin_category J] : + fin_category.{(max w v)} (ulift_hom.{w (max w v)} (ulift.{w v} J)) := +{ fintype_obj := ulift.fintype J } + end category_theory diff --git a/src/category_theory/full_subcategory.lean b/src/category_theory/full_subcategory.lean index 8bbbfda80519a..e80c647354ae7 100644 --- a/src/category_theory/full_subcategory.lean +++ b/src/category_theory/full_subcategory.lean @@ -8,6 +8,9 @@ import category_theory.functor.fully_faithful /-! # Induced categories and full subcategories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a category `D` and a function `F : C → D `from a type `C` to the objects of `D`, there is an essentially unique way to give `C` a category structure such that `F` becomes a fully faithful functor, @@ -47,7 +50,7 @@ include F which provides a category structure so that the morphisms `X ⟶ Y` are the morphisms in `D` from `F X` to `F Y`. -/ -@[nolint has_inhabited_instance unused_arguments] +@[nolint has_nonempty_instance unused_arguments] def induced_category : Type u₁ := C variables {D} @@ -81,35 +84,41 @@ variables {C : Type u₁} [category.{v} C] variables (Z : C → Prop) /-- -The category structure on a subtype; morphisms just ignore the property. +A subtype-like structure for full subcategories. Morphisms just ignore the property. We don't use +actual subtypes since the simp-normal form `↑X` of `X.val` does not work well for full +subcategories. See . We do not define 'strictly full' subcategories. -/ -instance full_subcategory : category.{v} {X : C // Z X} := -induced_category.category subtype.val +@[ext, nolint has_nonempty_instance] structure full_subcategory := +(obj : C) +(property : Z obj) + +instance full_subcategory.category : category.{v} (full_subcategory Z) := +induced_category.category full_subcategory.obj /-- The forgetful functor from a full subcategory into the original category ("forgetting" the condition). -/ -def full_subcategory_inclusion : {X : C // Z X} ⥤ C := -induced_functor subtype.val +def full_subcategory_inclusion : full_subcategory Z ⥤ C := +induced_functor full_subcategory.obj @[simp] lemma full_subcategory_inclusion.obj {X} : - (full_subcategory_inclusion Z).obj X = X.val := rfl + (full_subcategory_inclusion Z).obj X = X.obj := rfl @[simp] lemma full_subcategory_inclusion.map {X Y} {f : X ⟶ Y} : (full_subcategory_inclusion Z).map f = f := rfl instance full_subcategory.full : full (full_subcategory_inclusion Z) := -induced_category.full subtype.val +induced_category.full _ instance full_subcategory.faithful : faithful (full_subcategory_inclusion Z) := -induced_category.faithful subtype.val +induced_category.faithful _ variables {Z} {Z' : C → Prop} /-- An implication of predicates `Z → Z'` induces a functor between full subcategories. -/ @[simps] -def full_subcategory.map (h : ∀ ⦃X⦄, Z X → Z' X) : {X // Z X} ⥤ {X // Z' X} := +def full_subcategory.map (h : ∀ ⦃X⦄, Z X → Z' X) : full_subcategory Z ⥤ full_subcategory Z' := { obj := λ X, ⟨X.1, h X.2⟩, map := λ X Y f, f } @@ -128,7 +137,7 @@ variables {D : Type u₂} [category.{v₂} D] (P Q : D → Prop) /-- A functor which maps objects to objects satisfying a certain property induces a lift through the full subcategory of objects satisfying that property. -/ @[simps] -def full_subcategory.lift (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) : C ⥤ {X // P X} := +def full_subcategory.lift (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) : C ⥤ full_subcategory P := { obj := λ X, ⟨F.obj X, hF X⟩, map := λ X Y f, F.map f } diff --git a/src/category_theory/functor/basic.lean b/src/category_theory/functor/basic.lean index 377e00e5936bf..8af552edc4983 100644 --- a/src/category_theory/functor/basic.lean +++ b/src/category_theory/functor/basic.lean @@ -9,6 +9,9 @@ import category_theory.category.basic /-! # Functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines a functor between categories, extending a `prefunctor` between quivers. Introduces notation `C ⥤ D` for the type of all functors from `C` to `D`. @@ -60,6 +63,7 @@ section variables (C : Type u₁) [category.{v₁} C] /-- `𝟭 C` is the identity functor on a category `C`. -/ +-- We don't use `@[simps]` here because we want `C` implicit for the simp lemmas. protected def id : C ⥤ C := { obj := λ X, X, map := λ _ _ f, f } @@ -72,6 +76,7 @@ variable {C} @[simp] lemma id_obj (X : C) : (𝟭 C).obj X = X := rfl @[simp] lemma id_map {X Y : C} (f : X ⟶ Y) : (𝟭 C).map f = f := rfl + end section @@ -82,13 +87,12 @@ variables {C : Type u₁} [category.{v₁} C] /-- `F ⋙ G` is the composition of a functor `F` and a functor `G` (`F` first, then `G`). -/ -def comp (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E := +@[simps obj] def comp (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E := { obj := λ X, G.obj (F.obj X), map := λ _ _ f, G.map (F.map f) } infixr ` ⋙ `:80 := comp -@[simp] lemma comp_obj (F : C ⥤ D) (G : D ⥤ E) (X : C) : (F ⋙ G).obj X = G.obj (F.obj X) := rfl @[simp] lemma comp_map (F : C ⥤ D) (G : D ⥤ E) {X Y : C} (f : X ⟶ Y) : (F ⋙ G).map f = G.map (F.map f) := rfl @@ -103,6 +107,16 @@ protected lemma id_comp (F : C ⥤ D) : (𝟭 C) ⋙ F = F := by cases F; refl F.map (if h : P then f h else g h) = if h : P then F.map (f h) else F.map (g h) := by { split_ifs; refl, } +@[simp] lemma to_prefunctor_obj (F : C ⥤ D) (X : C) : + F.to_prefunctor.obj X = F.obj X := rfl + +@[simp] lemma to_prefunctor_map (F : C ⥤ D) + {X Y : C} (f : X ⟶ Y) : F.to_prefunctor.map f = F.map f := rfl + +@[simp] lemma to_prefunctor_comp (F : C ⥤ D) (G : D ⥤ E) : + F.to_prefunctor.comp G.to_prefunctor = (F ⋙ G).to_prefunctor := rfl + + end end functor diff --git a/src/category_theory/functor/category.lean b/src/category_theory/functor/category.lean index baa5ded9706ee..e3bb5ae20656d 100644 --- a/src/category_theory/functor/category.lean +++ b/src/category_theory/functor/category.lean @@ -9,6 +9,9 @@ import category_theory.isomorphism /-! # The category of functors and natural transformations between two fixed categories. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide the category instance on `C ⥤ D`, with morphisms the natural transformations. ## Universes @@ -57,6 +60,9 @@ lemma congr_app {α β : F ⟶ G} (h : α = β) (X : C) : α.app X = β.app X := @[simp] lemma id_app (F : C ⥤ D) (X : C) : (𝟙 F : F ⟶ F).app X = 𝟙 (F.obj X) := rfl @[simp] lemma comp_app {F G H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) : (α ≫ β).app X = α.app X ≫ β.app X := rfl +lemma comp_app_assoc {F G H : C ⥤ D} (α : F ⟶ G) (β : G ⟶ H) (X : C) {X' : D} + (f : H.obj X ⟶ X') : + (α ≫ β).app X ≫ f = α.app X ≫ β.app X ≫ f := by rw [comp_app, assoc] lemma app_naturality {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (X : C) {Y Z : D} (f : Y ⟶ Z) : ((F.obj X).map f) ≫ ((T.app X).app Z) = ((T.app X).app Y) ≫ ((G.obj X).map f) := @@ -67,15 +73,15 @@ lemma naturality_app {F G : C ⥤ (D ⥤ E)} (T : F ⟶ G) (Z : D) {X Y : C} (f congr_fun (congr_arg app (T.naturality f)) Z /-- A natural transformation is a monomorphism if each component is. -/ -lemma mono_app_of_mono (α : F ⟶ G) [∀ (X : C), mono (α.app X)] : mono α := +lemma mono_of_mono_app (α : F ⟶ G) [∀ (X : C), mono (α.app X)] : mono α := ⟨λ H g h eq, by { ext X, rw [←cancel_mono (α.app X), ←comp_app, eq, comp_app] }⟩ /-- A natural transformation is an epimorphism if each component is. -/ -lemma epi_app_of_epi (α : F ⟶ G) [∀ (X : C), epi (α.app X)] : epi α := +lemma epi_of_epi_app (α : F ⟶ G) [∀ (X : C), epi (α.app X)] : epi α := ⟨λ H g h eq, by { ext X, rw [←cancel_epi (α.app X), ←comp_app, eq, comp_app] }⟩ /-- `hcomp α β` is the horizontal composition of natural transformations. -/ -def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : (F ⋙ H) ⟶ (G ⋙ I) := +@[simps] def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : (F ⋙ H) ⟶ (G ⋙ I) := { app := λ X : C, (β.app (F.obj X)) ≫ (I.map (α.app X)), naturality' := λ X Y f, begin @@ -85,9 +91,6 @@ def hcomp {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) : (F ⋙ H) ⟶ (G ⋙ I infix ` ◫ `:80 := hcomp -@[simp] lemma hcomp_app {H I : D ⥤ E} (α : F ⟶ G) (β : H ⟶ I) (X : C) : - (α ◫ β).app X = (β.app (F.obj X)) ≫ (I.map (α.app X)) := rfl - @[simp] lemma hcomp_id_app {H : D ⥤ E} (α : F ⟶ G) (X : C) : (α ◫ 𝟙 H).app X = H.map (α.app X) := by {dsimp, simp} -- See note [dsimp, simp]. @@ -107,7 +110,7 @@ open nat_trans namespace functor /-- Flip the arguments of a bifunctor. See also `currying.lean`. -/ -protected def flip (F : C ⥤ (D ⥤ E)) : D ⥤ (C ⥤ E) := +@[simps] protected def flip (F : C ⥤ (D ⥤ E)) : D ⥤ (C ⥤ E) := { obj := λ k, { obj := λ j, (F.obj j).obj k, map := λ j j' f, (F.map f).app k, @@ -116,12 +119,6 @@ protected def flip (F : C ⥤ (D ⥤ E)) : D ⥤ (C ⥤ E) := map := λ c c' f, { app := λ j, (F.obj j).map f } }. -@[simp] lemma flip_obj_obj (F : C ⥤ (D ⥤ E)) (c) (d) : (F.flip.obj d).obj c = (F.obj c).obj d := rfl -@[simp] lemma flip_obj_map (F : C ⥤ (D ⥤ E)) {c c' : C} (f : c ⟶ c') (d : D) : - (F.flip.obj d).map f = (F.map f).app d := rfl -@[simp] lemma flip_map_app (F : C ⥤ (D ⥤ E)) {d d' : D} (f : d ⟶ d') (c : C) : - (F.flip.map f).app c = (F.obj c).map f := rfl - end functor @[simp, reassoc] lemma map_hom_inv_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) : diff --git a/src/category_theory/functor/const.lean b/src/category_theory/functor/const.lean index 13211cfe93cca..ae1fc08e30df6 100644 --- a/src/category_theory/functor/const.lean +++ b/src/category_theory/functor/const.lean @@ -8,6 +8,9 @@ import category_theory.opposites /-! # The constant functor +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `const J : C ⥤ (J ⥤ C)` is the functor that sends an object `X : C` to the functor `J ⥤ C` sending every object in `J` to `X`, and every morphism to `𝟙 X`. @@ -29,7 +32,7 @@ variables {C : Type u₂} [category.{v₂} C] /-- The functor sending `X : C` to the constant functor `J ⥤ C` sending everything to `X`. -/ -def const : C ⥤ (J ⥤ C) := +@[simps] def const : C ⥤ (J ⥤ C) := { obj := λ X, { obj := λ j, X, map := λ j j' f, 𝟙 X }, @@ -40,22 +43,15 @@ open opposite variables {J} -@[simp] lemma obj_obj (X : C) (j : J) : ((const J).obj X).obj j = X := rfl -@[simp] lemma obj_map (X : C) {j j' : J} (f : j ⟶ j') : ((const J).obj X).map f = 𝟙 X := rfl -@[simp] lemma map_app {X Y : C} (f : X ⟶ Y) (j : J) : ((const J).map f).app j = f := rfl - /-- The contant functor `Jᵒᵖ ⥤ Cᵒᵖ` sending everything to `op X` is (naturally isomorphic to) the opposite of the constant functor `J ⥤ C` sending everything to `X`. -/ -def op_obj_op (X : C) : +@[simps] def op_obj_op (X : C) : (const Jᵒᵖ).obj (op X) ≅ ((const J).obj X).op := { hom := { app := λ j, 𝟙 _ }, inv := { app := λ j, 𝟙 _ } } -@[simp] lemma op_obj_op_hom_app (X : C) (j : Jᵒᵖ) : (op_obj_op X).hom.app j = 𝟙 _ := rfl -@[simp] lemma op_obj_op_inv_app (X : C) (j : Jᵒᵖ) : (op_obj_op X).inv.app j = 𝟙 _ := rfl - /-- The contant functor `Jᵒᵖ ⥤ C` sending everything to `unop X` is (naturally isomorphic to) the opposite of @@ -74,9 +70,8 @@ rfl @[simp] lemma unop_functor_op_obj_map (X : Cᵒᵖ) {j₁ j₂ : J} (f : j₁ ⟶ j₂) : (unop ((functor.op (const J)).obj X)).map f = 𝟙 (unop X) := rfl -end const - +end const section variables {D : Type u₃} [category.{v₃} D] diff --git a/src/category_theory/functor/currying.lean b/src/category_theory/functor/currying.lean index 6285dff51ee58..a0c3fa5094f04 100644 --- a/src/category_theory/functor/currying.lean +++ b/src/category_theory/functor/currying.lean @@ -8,6 +8,9 @@ import category_theory.products.bifunctor /-! # Curry and uncurry, as functors. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `curry : ((C × D) ⥤ E) ⥤ (C ⥤ (D ⥤ E))` and `uncurry : (C ⥤ (D ⥤ E)) ⥤ ((C × D) ⥤ E)`, and verify that they provide an equivalence of categories `currying : (C ⥤ (D ⥤ E)) ≌ ((C × D) ⥤ E)`. @@ -15,15 +18,17 @@ and verify that they provide an equivalence of categories -/ namespace category_theory -universes v₁ v₂ v₃ u₁ u₂ u₃ +universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄ -variables {C : Type u₁} [category.{v₁} C] - {D : Type u₂} [category.{v₂} D] - {E : Type u₃} [category.{v₃} E] +variables {B : Type u₁} [category.{v₁} B] + {C : Type u₂} [category.{v₂} C] + {D : Type u₃} [category.{v₃} D] + {E : Type u₄} [category.{v₄} E] /-- The uncurrying functor, taking a functor `C ⥤ (D ⥤ E)` and producing a functor `(C × D) ⥤ E`. -/ +@[simps] def uncurry : (C ⥤ (D ⥤ E)) ⥤ ((C × D) ⥤ E) := { obj := λ F, { obj := λ X, (F.obj X.1).obj X.2, @@ -58,6 +63,7 @@ def curry_obj (F : (C × D) ⥤ E) : C ⥤ (D ⥤ E) := /-- The currying functor, taking a functor `(C × D) ⥤ E` and producing a functor `C ⥤ (D ⥤ E)`. -/ +@[simps obj_obj_obj obj_obj_map obj_map_app map_app_app] def curry : ((C × D) ⥤ E) ⥤ (C ⥤ (D ⥤ E)) := { obj := λ F, curry_obj F, map := λ F G T, @@ -74,23 +80,6 @@ def curry : ((C × D) ⥤ E) ⥤ (C ⥤ (D ⥤ E)) := rw nat_trans.naturality, end } }. -@[simp] lemma uncurry.obj_obj {F : C ⥤ (D ⥤ E)} {X : C × D} : - (uncurry.obj F).obj X = (F.obj X.1).obj X.2 := rfl -@[simp] lemma uncurry.obj_map {F : C ⥤ (D ⥤ E)} {X Y : C × D} {f : X ⟶ Y} : - (uncurry.obj F).map f = ((F.map f.1).app X.2) ≫ ((F.obj Y.1).map f.2) := rfl -@[simp] lemma uncurry.map_app {F G : C ⥤ (D ⥤ E)} {α : F ⟶ G} {X : C × D} : - (uncurry.map α).app X = (α.app X.1).app X.2 := rfl -@[simp] lemma curry.obj_obj_obj - {F : (C × D) ⥤ E} {X : C} {Y : D} : - ((curry.obj F).obj X).obj Y = F.obj (X, Y) := rfl -@[simp] lemma curry.obj_obj_map - {F : (C × D) ⥤ E} {X : C} {Y Y' : D} {g : Y ⟶ Y'} : - ((curry.obj F).obj X).map g = F.map (𝟙 X, g) := rfl -@[simp] lemma curry.obj_map_app {F : (C × D) ⥤ E} {X X' : C} {f : X ⟶ X'} {Y} : - ((curry.obj F).map f).app Y = F.map (f, 𝟙 Y) := rfl -@[simp] lemma curry.map_app_app {F G : (C × D) ⥤ E} {α : F ⟶ G} {X} {Y} : - ((curry.map α).app X).app Y = α.app (X, Y) := rfl - /-- The equivalence of functor categories given by currying/uncurrying. -/ @@ -114,4 +103,14 @@ swapping the factors followed by the uncurrying of `F`. -/ def uncurry_obj_flip (F : C ⥤ D ⥤ E) : uncurry.obj F.flip ≅ prod.swap _ _ ⋙ uncurry.obj F := nat_iso.of_components (λ p, iso.refl _) (by tidy) +variables (B C D E) + +/-- +A version of `category_theory.whiskering_right` for bifunctors, obtained by uncurrying, +applying `whiskering_right` and currying back +-/ +@[simps] def whiskering_right₂ : (C ⥤ D ⥤ E) ⥤ ((B ⥤ C) ⥤ (B ⥤ D) ⥤ (B ⥤ E)) := +uncurry ⋙ (whiskering_right _ _ _) ⋙ +((whiskering_left _ _ _).obj (prod_functor_to_functor_prod _ _ _)) ⋙ curry + end category_theory diff --git a/src/category_theory/functor/default.lean b/src/category_theory/functor/default.lean deleted file mode 100644 index 94fa892d0119c..0000000000000 --- a/src/category_theory/functor/default.lean +++ /dev/null @@ -1 +0,0 @@ -import category_theory.functor.basic diff --git a/src/category_theory/functor/epi_mono.lean b/src/category_theory/functor/epi_mono.lean new file mode 100644 index 0000000000000..2a07f378344ee --- /dev/null +++ b/src/category_theory/functor/epi_mono.lean @@ -0,0 +1,302 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.epi_mono +import category_theory.limits.shapes.strong_epi +import category_theory.lifting_properties.adjunction + +/-! +# Preservation and reflection of monomorphisms and epimorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide typeclasses that state that a functor preserves or reflects monomorphisms or +epimorphisms. +-/ + +open category_theory + +universes v₁ v₂ v₃ u₁ u₂ u₃ + +namespace category_theory.functor +variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] + {E : Type u₃} [category.{v₃} E] + +/-- A functor preserves monomorphisms if it maps monomorphisms to monomorphisms. -/ +class preserves_monomorphisms (F : C ⥤ D) : Prop := +(preserves : ∀ {X Y : C} (f : X ⟶ Y) [mono f], mono (F.map f)) + +instance map_mono (F : C ⥤ D) [preserves_monomorphisms F] {X Y : C} (f : X ⟶ Y) [mono f] : + mono (F.map f) := +preserves_monomorphisms.preserves f + +/-- A functor preserves epimorphisms if it maps epimorphisms to epimorphisms. -/ +class preserves_epimorphisms (F : C ⥤ D) : Prop := +(preserves : ∀ {X Y : C} (f : X ⟶ Y) [epi f], epi (F.map f)) + +instance map_epi (F : C ⥤ D) [preserves_epimorphisms F] {X Y : C} (f : X ⟶ Y) [epi f] : + epi (F.map f) := +preserves_epimorphisms.preserves f + +/-- A functor reflects monomorphisms if morphisms that are mapped to monomorphisms are themselves + monomorphisms. -/ +class reflects_monomorphisms (F : C ⥤ D) : Prop := +(reflects : ∀ {X Y : C} (f : X ⟶ Y), mono (F.map f) → mono f) + +lemma mono_of_mono_map (F : C ⥤ D) [reflects_monomorphisms F] {X Y : C} {f : X ⟶ Y} + (h : mono (F.map f)) : mono f := +reflects_monomorphisms.reflects f h + +/-- A functor reflects epimorphisms if morphisms that are mapped to epimorphisms are themselves + epimorphisms. -/ +class reflects_epimorphisms (F : C ⥤ D) : Prop := +(reflects : ∀ {X Y : C} (f : X ⟶ Y), epi (F.map f) → epi f) + +lemma epi_of_epi_map (F : C ⥤ D) [reflects_epimorphisms F] {X Y : C} {f : X ⟶ Y} + (h : epi (F.map f)) : epi f := +reflects_epimorphisms.reflects f h + +instance preserves_monomorphisms_comp (F : C ⥤ D) (G : D ⥤ E) [preserves_monomorphisms F] + [preserves_monomorphisms G] : preserves_monomorphisms (F ⋙ G) := +{ preserves := λ X Y f h, by { rw comp_map, exactI infer_instance } } + +instance preserves_epimorphisms_comp (F : C ⥤ D) (G : D ⥤ E) [preserves_epimorphisms F] + [preserves_epimorphisms G] : preserves_epimorphisms (F ⋙ G) := +{ preserves := λ X Y f h, by { rw comp_map, exactI infer_instance } } + +instance reflects_monomorphisms_comp (F : C ⥤ D) (G : D ⥤ E) [reflects_monomorphisms F] + [reflects_monomorphisms G] : reflects_monomorphisms (F ⋙ G) := +{ reflects := λ X Y f h, (F.mono_of_mono_map (G.mono_of_mono_map h)) } + +instance reflects_epimorphisms_comp (F : C ⥤ D) (G : D ⥤ E) [reflects_epimorphisms F] + [reflects_epimorphisms G] : reflects_epimorphisms (F ⋙ G) := +{ reflects := λ X Y f h, (F.epi_of_epi_map (G.epi_of_epi_map h)) } + +lemma preserves_epimorphisms_of_preserves_of_reflects (F : C ⥤ D) (G : D ⥤ E) + [preserves_epimorphisms (F ⋙ G)] [reflects_epimorphisms G] : preserves_epimorphisms F := +⟨λ X Y f hf, G.epi_of_epi_map $ show epi ((F ⋙ G).map f), by exactI infer_instance⟩ + +lemma preserves_monomorphisms_of_preserves_of_reflects (F : C ⥤ D) (G : D ⥤ E) + [preserves_monomorphisms (F ⋙ G)] [reflects_monomorphisms G] : preserves_monomorphisms F := +⟨λ X Y f hf, G.mono_of_mono_map $ show mono ((F ⋙ G).map f), by exactI infer_instance⟩ + +lemma reflects_epimorphisms_of_preserves_of_reflects (F : C ⥤ D) (G : D ⥤ E) + [preserves_epimorphisms G] [reflects_epimorphisms (F ⋙ G)] : reflects_epimorphisms F := +⟨λ X Y f hf, (F ⋙ G).epi_of_epi_map $ show epi (G.map (F.map f)), by exactI infer_instance⟩ + +lemma reflects_monomorphisms_of_preserves_of_reflects (F : C ⥤ D) (G : D ⥤ E) + [preserves_monomorphisms G] [reflects_monomorphisms (F ⋙ G)] : reflects_monomorphisms F := +⟨λ X Y f hf, (F ⋙ G).mono_of_mono_map $ show mono (G.map (F.map f)), by exactI infer_instance⟩ + +lemma preserves_monomorphisms.of_iso {F G : C ⥤ D} [preserves_monomorphisms F] (α : F ≅ G) : + preserves_monomorphisms G := +{ preserves := λ X Y f h, + begin + haveI : mono (F.map f ≫ (α.app Y).hom) := by exactI mono_comp _ _, + convert (mono_comp _ _ : mono ((α.app X).inv ≫ F.map f ≫ (α.app Y).hom)), + rw [iso.eq_inv_comp, iso.app_hom, iso.app_hom, nat_trans.naturality] + end } + +lemma preserves_monomorphisms.iso_iff {F G : C ⥤ D} (α : F ≅ G) : + preserves_monomorphisms F ↔ preserves_monomorphisms G := +⟨λ h, by exactI preserves_monomorphisms.of_iso α, + λ h, by exactI preserves_monomorphisms.of_iso α.symm⟩ + +lemma preserves_epimorphisms.of_iso {F G : C ⥤ D} [preserves_epimorphisms F] (α : F ≅ G) : + preserves_epimorphisms G := +{ preserves := λ X Y f h, + begin + haveI : epi (F.map f ≫ (α.app Y).hom) := by exactI epi_comp _ _, + convert (epi_comp _ _ : epi ((α.app X).inv ≫ F.map f ≫ (α.app Y).hom)), + rw [iso.eq_inv_comp, iso.app_hom, iso.app_hom, nat_trans.naturality] + end } + +lemma preserves_epimorphisms.iso_iff {F G : C ⥤ D} (α : F ≅ G) : + preserves_epimorphisms F ↔ preserves_epimorphisms G := +⟨λ h, by exactI preserves_epimorphisms.of_iso α, + λ h, by exactI preserves_epimorphisms.of_iso α.symm⟩ + +lemma reflects_monomorphisms.of_iso {F G : C ⥤ D} [reflects_monomorphisms F] (α : F ≅ G) : + reflects_monomorphisms G := +{ reflects := λ X Y f h, + begin + apply F.mono_of_mono_map, + haveI : mono (G.map f ≫ (α.app Y).inv) := by exactI mono_comp _ _, + convert (mono_comp _ _ : mono ((α.app X).hom ≫ G.map f ≫ (α.app Y).inv)), + rw [← category.assoc, iso.eq_comp_inv, iso.app_hom, iso.app_hom, nat_trans.naturality] + end } + +lemma reflects_monomorphisms.iso_iff {F G : C ⥤ D} (α : F ≅ G) : + reflects_monomorphisms F ↔ reflects_monomorphisms G := +⟨λ h, by exactI reflects_monomorphisms.of_iso α, + λ h, by exactI reflects_monomorphisms.of_iso α.symm⟩ + +lemma reflects_epimorphisms.of_iso {F G : C ⥤ D} [reflects_epimorphisms F] (α : F ≅ G) : + reflects_epimorphisms G := +{ reflects := λ X Y f h, + begin + apply F.epi_of_epi_map, + haveI : epi (G.map f ≫ (α.app Y).inv) := by exactI epi_comp _ _, + convert (epi_comp _ _ : epi ((α.app X).hom ≫ G.map f ≫ (α.app Y).inv)), + rw [← category.assoc, iso.eq_comp_inv, iso.app_hom, iso.app_hom, nat_trans.naturality] + end } + +lemma reflects_epimorphisms.iso_iff {F G : C ⥤ D} (α : F ≅ G) : + reflects_epimorphisms F ↔ reflects_epimorphisms G := +⟨λ h, by exactI reflects_epimorphisms.of_iso α, λ h, by exactI reflects_epimorphisms.of_iso α.symm⟩ + +lemma preserves_epimorphsisms_of_adjunction {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) : + preserves_epimorphisms F := +{ preserves := λ X Y f hf, + ⟨begin + introsI Z g h H, + replace H := congr_arg (adj.hom_equiv X Z) H, + rwa [adj.hom_equiv_naturality_left, adj.hom_equiv_naturality_left, cancel_epi, + equiv.apply_eq_iff_eq] at H + end⟩ } + +@[priority 100] +instance preserves_epimorphisms_of_is_left_adjoint (F : C ⥤ D) [is_left_adjoint F] : + preserves_epimorphisms F := +preserves_epimorphsisms_of_adjunction (adjunction.of_left_adjoint F) + +lemma preserves_monomorphisms_of_adjunction {F : C ⥤ D} {G : D ⥤ C} (adj : F ⊣ G) : + preserves_monomorphisms G := +{ preserves := λ X Y f hf, + ⟨begin + introsI Z g h H, + replace H := congr_arg (adj.hom_equiv Z Y).symm H, + rwa [adj.hom_equiv_naturality_right_symm, adj.hom_equiv_naturality_right_symm, + cancel_mono, equiv.apply_eq_iff_eq] at H + end⟩ } + +@[priority 100] +instance preserves_monomorphisms_of_is_right_adjoint (F : C ⥤ D) [is_right_adjoint F] : + preserves_monomorphisms F := +preserves_monomorphisms_of_adjunction (adjunction.of_right_adjoint F) + +@[priority 100] +instance reflects_monomorphisms_of_faithful (F : C ⥤ D) [faithful F] : reflects_monomorphisms F := +{ reflects := λ X Y f hf, ⟨λ Z g h hgh, by exactI F.map_injective ((cancel_mono (F.map f)).1 + (by rw [← F.map_comp, hgh, F.map_comp]))⟩ } + +@[priority 100] +instance reflects_epimorphisms_of_faithful (F : C ⥤ D) [faithful F] : reflects_epimorphisms F := +{ reflects := λ X Y f hf, ⟨λ Z g h hgh, by exactI F.map_injective ((cancel_epi (F.map f)).1 + (by rw [← F.map_comp, hgh, F.map_comp]))⟩ } + +section + +variables (F : C ⥤ D) {X Y : C} (f : X ⟶ Y) + +/-- If `F` is a fully faithful functor, split epimorphisms are preserved and reflected by `F`. -/ +def split_epi_equiv [full F] [faithful F] : split_epi f ≃ split_epi (F.map f) := +{ to_fun := λ f, f.map F, + inv_fun := λ s, begin + refine ⟨F.preimage s.section_, _⟩, + apply F.map_injective, + simp only [map_comp, image_preimage, map_id], + apply split_epi.id, + end, + left_inv := by tidy, + right_inv := by tidy, } + +@[simp] +lemma is_split_epi_iff [full F] [faithful F] : is_split_epi (F.map f) ↔ is_split_epi f := +begin + split, + { intro h, exact is_split_epi.mk' ((split_epi_equiv F f).inv_fun h.exists_split_epi.some), }, + { intro h, exact is_split_epi.mk' ((split_epi_equiv F f).to_fun h.exists_split_epi.some), }, +end + +/-- If `F` is a fully faithful functor, split monomorphisms are preserved and reflected by `F`. -/ +def split_mono_equiv [full F] [faithful F] : split_mono f ≃ split_mono (F.map f) := +{ to_fun := λ f, f.map F, + inv_fun := λ s, begin + refine ⟨F.preimage s.retraction, _⟩, + apply F.map_injective, + simp only [map_comp, image_preimage, map_id], + apply split_mono.id, + end, + left_inv := by tidy, + right_inv := by tidy, } + +@[simp] +lemma is_split_mono_iff [full F] [faithful F] : is_split_mono (F.map f) ↔ is_split_mono f := +begin + split, + { intro h, exact is_split_mono.mk' ((split_mono_equiv F f).inv_fun h.exists_split_mono.some), }, + { intro h, exact is_split_mono.mk' ((split_mono_equiv F f).to_fun h.exists_split_mono.some), }, +end + +@[simp] +lemma epi_map_iff_epi [hF₁ : preserves_epimorphisms F] [hF₂ : reflects_epimorphisms F] : + epi (F.map f) ↔ epi f := +begin + split, + { exact F.epi_of_epi_map, }, + { introI h, + exact F.map_epi f, }, +end + +@[simp] +lemma mono_map_iff_mono [hF₁ : preserves_monomorphisms F] [hF₂ : reflects_monomorphisms F] : + mono (F.map f) ↔ mono f := +begin + split, + { exact F.mono_of_mono_map, }, + { introI h, + exact F.map_mono f, }, +end + +/-- If `F : C ⥤ D` is an equivalence of categories and `C` is a `split_epi_category`, +then `D` also is. -/ +def split_epi_category_imp_of_is_equivalence [is_equivalence F] [split_epi_category C] : + split_epi_category D := +⟨λ X Y f, begin + introI, + rw ← F.inv.is_split_epi_iff f, + apply is_split_epi_of_epi, +end⟩ + +end + +end category_theory.functor + +namespace category_theory.adjunction + +variables {C D : Type*} [category C] [category D] {F : C ⥤ D} {F' : D ⥤ C} {A B : C} + +lemma strong_epi_map_of_strong_epi (adj : F ⊣ F') (f : A ⟶ B) + [h₁ : F'.preserves_monomorphisms] [h₂ : F.preserves_epimorphisms] [strong_epi f] : + strong_epi (F.map f) := +⟨infer_instance, λ X Y Z, by { introI, rw adj.has_lifting_property_iff, apply_instance, }⟩ + +instance strong_epi_map_of_is_equivalence [is_equivalence F] (f : A ⟶ B) [h : strong_epi f] : + strong_epi (F.map f) := +F.as_equivalence.to_adjunction.strong_epi_map_of_strong_epi f + +end category_theory.adjunction + +namespace category_theory.functor + +variables {C D : Type*} [category C] [category D] {F : C ⥤ D} {A B : C} (f : A ⟶ B) + +@[simp] +lemma strong_epi_map_iff_strong_epi_of_is_equivalence [is_equivalence F] : + strong_epi (F.map f) ↔ strong_epi f := +begin + split, + { introI, + have e : arrow.mk f ≅ arrow.mk (F.inv.map (F.map f)) := + arrow.iso_of_nat_iso F.as_equivalence.unit_iso (arrow.mk f), + rw strong_epi.iff_of_arrow_iso e, + apply_instance, }, + { introI, + apply_instance, }, +end + +end category_theory.functor diff --git a/src/category_theory/functor/flat.lean b/src/category_theory/functor/flat.lean index 3a5480f6c5276..c03d26266d8e1 100644 --- a/src/category_theory/functor/flat.lean +++ b/src/category_theory/functor/flat.lean @@ -5,7 +5,6 @@ Authors: Andrew Yang -/ import category_theory.limits.filtered_colimit_commutes_finite_limit import category_theory.limits.preserves.functor_category -import category_theory.limits.preserves.shapes.equalizers import category_theory.limits.bicones import category_theory.limits.comma import category_theory.limits.preserves.finite @@ -14,6 +13,9 @@ import category_theory.limits.shapes.finite_limits /-! # Representably flat functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define representably flat functors as functors such that the category of structured arrows over `X` is cofiltered for each `X`. This concept is also known as flat functors as in [Elephant] Remark C2.3.7, and this name is suggested by Mike Shulman in @@ -40,7 +42,7 @@ This definition is equivalent to left exact functors (functors that preserves fi -/ -universes v₁ v₂ v₃ u₁ u₂ u₃ +universes w v₁ v₂ v₃ u₁ u₂ u₃ open category_theory open category_theory.limits @@ -52,7 +54,7 @@ namespace category_theory namespace structured_arrow_cone open structured_arrow variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₁} D] -variables {J : Type v₁} [small_category J] +variables {J : Type w} [small_category J] variables {K : J ⥤ C} (F : C ⥤ D) (c : cone K) /-- @@ -101,8 +103,8 @@ begin constructor, intro X, haveI : nonempty (structured_arrow X (𝟭 C)) := ⟨structured_arrow.mk (𝟙 _)⟩, - suffices : is_cofiltered_or_empty (structured_arrow X (𝟭 C)), - { resetI, constructor }, + rsufficesI : is_cofiltered_or_empty (structured_arrow X (𝟭 C)), + { constructor }, constructor, { intros Y Z, use structured_arrow.mk (𝟙 _), @@ -124,8 +126,8 @@ begin { have f₁ : structured_arrow X G := nonempty.some infer_instance, have f₂ : structured_arrow f₁.right F := nonempty.some infer_instance, exact ⟨structured_arrow.mk (f₁.hom ≫ G.map f₂.hom)⟩ }, - suffices : is_cofiltered_or_empty (structured_arrow X (F ⋙ G)), - { resetI, constructor }, + rsufficesI : is_cofiltered_or_empty (structured_arrow X (F ⋙ G)), + { constructor }, constructor, { intros Y Z, let W := @is_cofiltered.min (structured_arrow X G) _ _ @@ -167,18 +169,22 @@ end representably_flat section has_limit variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₁} D] -@[priority 100] -instance cofiltered_of_has_finite_limits [has_finite_limits C] : is_cofiltered C := -{ cocone_objs := λ A B, ⟨limits.prod A B, limits.prod.fst, limits.prod.snd, trivial⟩, - cocone_maps := λ A B f g, ⟨equalizer f g, equalizer.ι f g, equalizer.condition f g⟩, +local attribute [instance] has_finite_limits_of_has_finite_limits_of_size + +lemma cofiltered_of_has_finite_limits [has_finite_limits C] : is_cofiltered C := +{ cone_objs := λ A B, ⟨limits.prod A B, limits.prod.fst, limits.prod.snd, trivial⟩, + cone_maps := λ A B f g, ⟨equalizer f g, equalizer.ι f g, equalizer.condition f g⟩, nonempty := ⟨⊤_ C⟩ } lemma flat_of_preserves_finite_limits [has_finite_limits C] (F : C ⥤ D) [preserves_finite_limits F] : representably_flat F := ⟨λ X, begin haveI : has_finite_limits (structured_arrow X F) := - { out := λ J _ _, by { resetI, apply_instance } }, - apply_instance + begin + apply has_finite_limits_of_has_finite_limits_of_size.{v₁} (structured_arrow X F), + intros J sJ fJ, resetI, constructor + end, + exact cofiltered_of_has_finite_limits end⟩ namespace preserves_finite_limits_of_flat @@ -203,6 +209,8 @@ s'.X.hom ≫ (F.map $ hc.lift $ lemma fac (x : J) : lift F hc s ≫ (F.map_cone c).π.app x = s.π.app x := by simpa [lift, ←functor.map_comp] +local attribute [simp] eq_to_hom_map + lemma uniq {K : J ⥤ C} {c : cone K} (hc : is_limit c) (s : cone (K ⋙ F)) (f₁ f₂ : s.X ⟶ F.obj c.X) (h₁ : ∀ (j : J), f₁ ≫ (F.map_cone c).π.app j = s.π.app j) @@ -252,13 +260,19 @@ end preserves_finite_limits_of_flat /-- Representably flat functors preserve finite limits. -/ noncomputable def preserves_finite_limits_of_flat (F : C ⥤ D) [representably_flat F] : - preserves_finite_limits F := ⟨λ J _ _, by exactI ⟨λ K, ⟨λ c hc, -{ lift := preserves_finite_limits_of_flat.lift F hc, - fac' := preserves_finite_limits_of_flat.fac F hc, - uniq' := λ s m h, by - { apply preserves_finite_limits_of_flat.uniq F hc, - exact h, - exact preserves_finite_limits_of_flat.fac F hc s } }⟩⟩⟩ + preserves_finite_limits F := +begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size, + intros J _ _, constructor, + intros K, constructor, + intros c hc, + exactI { lift := preserves_finite_limits_of_flat.lift F hc, + fac' := preserves_finite_limits_of_flat.fac F hc, + uniq' := λ s m h, by + { apply preserves_finite_limits_of_flat.uniq F hc, + exact h, + exact preserves_finite_limits_of_flat.fac F hc s } } +end /-- If `C` is finitely cocomplete, then `F : C ⥤ D` is representably flat iff it preserves @@ -270,7 +284,8 @@ def preserves_finite_limits_iff_flat [has_finite_limits C] (F : C ⥤ D) : { to_fun := λ _, by exactI preserves_finite_limits_of_flat F, inv_fun := λ _, by exactI flat_of_preserves_finite_limits F, left_inv := λ _, proof_irrel _ _, - right_inv := λ x, by { cases x, unfold preserves_finite_limits_of_flat, congr } } + right_inv := λ x, by { cases x, unfold preserves_finite_limits_of_flat, + dunfold preserves_finite_limits_of_preserves_finite_limits_of_size, congr } } end has_limit @@ -295,8 +310,7 @@ begin whiskering_left_obj_map, category.comp_id, Lan_map_app, category.assoc], erw [colimit.ι_pre_assoc (Lan.diagram F H X) (costructured_arrow.map j.hom), category.id_comp, category.comp_id, colimit.ι_map], - cases j, - cases j_right, + rcases j with ⟨j_left, ⟨⟨⟩⟩, j_hom⟩, congr, rw [costructured_arrow.map_mk, category.id_comp, costructured_arrow.mk] end @@ -312,14 +326,15 @@ If `F : C ⥤ D` is a representably flat functor between small categories, then noncomputable instance Lan_preserves_finite_limits_of_flat (F : C ⥤ D) [representably_flat F] : preserves_finite_limits (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ E)) := -⟨λ J _ _, begin - resetI, +begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{u₁}, + intros J _ _, resetI, apply preserves_limits_of_shape_of_evaluation (Lan F.op : (Cᵒᵖ ⥤ E) ⥤ (Dᵒᵖ ⥤ E)) J, intro K, haveI : is_filtered (costructured_arrow F.op K) := is_filtered.of_equivalence (structured_arrow_op_equivalence F (unop K)), - exact preserves_limits_of_shape_of_nat_iso (Lan_evaluation_iso_colim _ _ _).symm -end⟩ + exact preserves_limits_of_shape_of_nat_iso (Lan_evaluation_iso_colim _ _ _).symm, +end instance Lan_flat_of_flat (F : C ⥤ D) [representably_flat F] : representably_flat (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ E)) := flat_of_preserves_finite_limits _ @@ -341,7 +356,10 @@ begin resetI, haveI := preserves_finite_limits_of_flat (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ Type u₁)), haveI : preserves_finite_limits F := - ⟨λ _ _ _, by exactI preserves_limit_of_Lan_presesrves_limit _ _⟩, + begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{u₁}, + intros, resetI, apply preserves_limit_of_Lan_preserves_limit + end, apply flat_of_preserves_finite_limits end⟩ @@ -353,15 +371,24 @@ noncomputable def preserves_finite_limits_iff_Lan_preserves_finite_limits (F : C ⥤ D) : preserves_finite_limits F ≃ preserves_finite_limits (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ Type u₁)) := { to_fun := λ _, by exactI infer_instance, - inv_fun := λ _, ⟨λ _ _ _, by exactI preserves_limit_of_Lan_presesrves_limit _ _⟩, - left_inv := λ x, by { cases x, unfold preserves_finite_limits_of_flat, congr }, + inv_fun := λ _, + begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{u₁}, + intros, resetI, apply preserves_limit_of_Lan_preserves_limit + end, + left_inv := λ x, + begin + cases x, unfold preserves_finite_limits_of_flat, + dunfold preserves_finite_limits_of_preserves_finite_limits_of_size, congr + end, right_inv := λ x, begin cases x, unfold preserves_finite_limits_of_flat, congr, unfold category_theory.Lan_preserves_finite_limits_of_preserves_finite_limits - category_theory.Lan_preserves_finite_limits_of_flat, congr + category_theory.Lan_preserves_finite_limits_of_flat, + dunfold preserves_finite_limits_of_preserves_finite_limits_of_size, congr end } end small_category diff --git a/src/category_theory/functor/fully_faithful.lean b/src/category_theory/functor/fully_faithful.lean index 085ad8da71383..e62ccf3d84f75 100644 --- a/src/category_theory/functor/fully_faithful.lean +++ b/src/category_theory/functor/fully_faithful.lean @@ -4,20 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import category_theory.natural_isomorphism -import logic.equiv.basic +import logic.equiv.defs /-! # Full and faithful functors -We define typeclasses `full` and `faithful`, decorating functors. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -Use `F.map_injective` to retrieve the fact that `F.map` is injective when `[faithful F]`, -and `F.preimage` to obtain preimages of morphisms when `[full F]`. +We define typeclasses `full` and `faithful`, decorating functors. -We prove some basic "cancellation" lemmas for full and/or faithful functors. +## Main definitions and results +* Use `F.map_injective` to retrieve the fact that `F.map` is injective when `[faithful F]`. +* Similarly, `F.map_surjective` states that `F.map` is surjective when `[full F]`. +* Use `F.preimage` to obtain preimages of morphisms when `[full F]`. +* We prove some basic "cancellation" lemmas for full and/or faithful functors, as well as a + construction for "dividing" a functor by a faithful functor, see `faithful.div`. +* `full F` carries data, so definitional properties of the preimage can be used when using + `F.preimage`. To obtain an instance of `full F` non-constructively, you can use `full_of_exists` + and `full_of_surjective`. -See `category_theory.equivalence` for the fact that a functor is an equivalence if and only if -it is fully faithful and essentially surjective. +See `category_theory.equivalence.of_fully_faithful_ess_surj` for the fact that a functor is an +equivalence if and only if it is fully faithful and essentially surjective. -/ @@ -55,8 +63,7 @@ restate_axiom faithful.map_injective' namespace functor variables {X Y : C} -lemma map_injective (F : C ⥤ D) [faithful F] : - function.injective $ @functor.map _ _ _ _ F X Y := +lemma map_injective (F : C ⥤ D) [faithful F] : function.injective $ @functor.map _ _ _ _ F X Y := faithful.map_injective F lemma map_iso_injective (F : C ⥤ D) [faithful F] : @@ -70,6 +77,19 @@ full.preimage.{v₁ v₂} f F.map (preimage F f) = f := by unfold preimage; obviously +lemma map_surjective (F : C ⥤ D) [full F] : function.surjective (@functor.map _ _ _ _ F X Y) := +λ f, ⟨F.preimage f, F.image_preimage f⟩ + +/-- Deduce that `F` is full from the existence of preimages, using choice. -/ +noncomputable def full_of_exists (F : C ⥤ D) + (h : ∀ (X Y : C) (f : F.obj X ⟶ F.obj Y), ∃ p, F.map p = f) : full F := +by { choose p hp using h, exact ⟨p, hp⟩ } + +/-- Deduce that `F` is full from surjectivity of `F.map`, using choice. -/ +noncomputable def full_of_surjective (F : C ⥤ D) + (h : ∀ (X Y : C), function.surjective (@functor.map _ _ _ _ F X Y)) : full F := +full_of_exists _ h + end functor section @@ -154,6 +174,24 @@ lemma nat_iso_of_comp_fully_faithful_inv (i : F ⋙ H ≅ G ⋙ H) : (nat_iso_of_comp_fully_faithful H i).inv = nat_trans_of_comp_fully_faithful H i.inv := by { ext, simp [←preimage_comp], dsimp, simp, } +/-- Horizontal composition with a fully faithful functor induces a bijection on +natural transformations. -/ +@[simps] +def nat_trans.equiv_of_comp_fully_faithful : (F ⟶ G) ≃ (F ⋙ H ⟶ G ⋙ H) := +{ to_fun := λ α, α ◫ 𝟙 H, + inv_fun := nat_trans_of_comp_fully_faithful H, + left_inv := by tidy, + right_inv := by tidy, } + +/-- Horizontal composition with a fully faithful functor induces a bijection on +natural isomorphisms. -/ +@[simps] +def nat_iso.equiv_of_comp_fully_faithful : (F ≅ G) ≃ (F ⋙ H ≅ G ⋙ H) := +{ to_fun := λ e, nat_iso.hcomp e (iso.refl H), + inv_fun := nat_iso_of_comp_fully_faithful H, + left_inv := by tidy, + right_inv := by tidy, } + end end category_theory @@ -194,14 +232,14 @@ variables {F G} lemma faithful.of_comp_iso {H : C ⥤ E} [ℋ : faithful H] (h : F ⋙ G ≅ H) : faithful F := @faithful.of_comp _ _ _ _ _ _ F G (faithful.of_iso h.symm) -alias faithful.of_comp_iso ← category_theory.iso.faithful_of_comp +alias faithful.of_comp_iso ← _root_.category_theory.iso.faithful_of_comp -- We could prove this from `faithful.of_comp_iso` using `eq_to_iso`, -- but that would introduce a cyclic import. lemma faithful.of_comp_eq {H : C ⥤ E} [ℋ : faithful H] (h : F ⋙ G = H) : faithful F := @faithful.of_comp _ _ _ _ _ _ F G (h.symm ▸ ℋ) -alias faithful.of_comp_eq ← eq.faithful_of_comp +alias faithful.of_comp_eq ← _root_.eq.faithful_of_comp variables (F G) diff --git a/src/category_theory/functor/functorial.lean b/src/category_theory/functor/functorial.lean index 60219b26a9086..7df2a37790e87 100644 --- a/src/category_theory/functor/functorial.lean +++ b/src/category_theory/functor/functorial.lean @@ -3,10 +3,13 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import category_theory.functor +import category_theory.functor.basic /-! # Unbundled functors, as a typeclass decorating the object-level function. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace category_theory diff --git a/src/category_theory/functor/hom.lean b/src/category_theory/functor/hom.lean index 05b6f7a0e7047..e5f7512a747a5 100644 --- a/src/category_theory/functor/hom.lean +++ b/src/category_theory/functor/hom.lean @@ -7,6 +7,9 @@ import category_theory.products.basic import category_theory.types /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The hom functor, sending `(X, Y)` to the type `X ⟶ Y`. -/ @@ -21,12 +24,8 @@ variables (C : Type u) [category.{v} C] /-- `functor.hom` is the hom-pairing, sending `(X, Y)` to `X ⟶ Y`, contravariant in `X` and covariant in `Y`. -/ -definition hom : Cᵒᵖ × C ⥤ Type v := +@[simps] def hom : Cᵒᵖ × C ⥤ Type v := { obj := λ p, unop p.1 ⟶ p.2, map := λ X Y f, λ h, f.1.unop ≫ h ≫ f.2 } -@[simp] lemma hom_obj (X : Cᵒᵖ × C) : (hom C).obj X = (unop X.1 ⟶ X.2) := rfl -@[simp] lemma hom_pairing_map {X Y : Cᵒᵖ × C} (f : X ⟶ Y) : - (hom C).map f = λ h, f.1.unop ≫ h ≫ f.2 := rfl - end category_theory.functor diff --git a/src/category_theory/functor/inv_isos.lean b/src/category_theory/functor/inv_isos.lean new file mode 100644 index 0000000000000..0dc3e4d9e6f97 --- /dev/null +++ b/src/category_theory/functor/inv_isos.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2022 Antoine Labelle. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Antoine Labelle +-/ + +import category_theory.eq_to_hom + +/-! +# Natural isomorphisms with composition with inverses + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Definition of useful natural isomorphisms involving inverses of functors. +These definitions cannot go in `category_theory/equivalence` because they require `eq_to_hom`. +-/ + +namespace category_theory + +open category_theory.functor + +universes u₁ u₂ u₃ v₁ v₂ v₃ + +variables {A : Type u₁} [category.{v₁} A] + {B : Type u₂} [category.{v₂} B] + {C : Type u₃} [category.{v₃} C] + +variables {F : A ⥤ C} {G : A ⥤ B} {H : B ⥤ C} + +/-- Construct an isomorphism `F ⋙ H.inv ≅ G` from an isomorphism `F ≅ G ⋙ H`. -/ +@[simps] def comp_inv_iso [h : is_equivalence H] (i : F ≅ G ⋙ H) : F ⋙ H.inv ≅ G := +iso_whisker_right i H.inv ≪≫ (associator G H H.inv) ≪≫ +iso_whisker_left G h.unit_iso.symm ≪≫ eq_to_iso (functor.comp_id G) + +/-- Construct an isomorphism `G ≅ F ⋙ H.inv` from an isomorphism `G ⋙ H ≅ F`. -/ +@[simps] def iso_comp_inv [h : is_equivalence H] (i : G ⋙ H ≅ F) : G ≅ F ⋙ H.inv := +(comp_inv_iso i.symm).symm + +/-- Construct an isomorphism `G.inv ⋙ F ≅ H` from an isomorphism `F ≅ G ⋙ H`. -/ +@[simps] def inv_comp_iso [h : is_equivalence G] (i : F ≅ G ⋙ H) : G.inv ⋙ F ≅ H := +iso_whisker_left G.inv i ≪≫ (associator G.inv G H).symm ≪≫ +iso_whisker_right h.counit_iso H ≪≫ eq_to_iso (functor.id_comp H) + +/-- Construct an isomorphism `H ≅ G.inv ⋙ F` from an isomorphism `G ⋙ H ≅ F`. -/ +@[simps] def iso_inv_comp [h : is_equivalence G] (i : G ⋙ H ≅ F) : H ≅ G.inv ⋙ F := +(inv_comp_iso i.symm).symm + +end category_theory diff --git a/src/category_theory/functor/left_derived.lean b/src/category_theory/functor/left_derived.lean index 26a2216d37c93..8f8f9baf18c76 100644 --- a/src/category_theory/functor/left_derived.lean +++ b/src/category_theory/functor/left_derived.lean @@ -8,6 +8,9 @@ import category_theory.preadditive.projective_resolution /-! # Left-derived functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the left-derived functors `F.left_derived n : C ⥤ D` for any additive functor `F` out of a category with projective resolutions. @@ -52,7 +55,7 @@ variables {C : Type u} [category.{v} C] {D : Type*} [category D] -- `[abelian C] [enough_projectives C] [abelian D]` suffices to acquire all the following: variables [preadditive C] [has_zero_object C] [has_equalizers C] [has_images C] [has_projective_resolutions C] -variables [preadditive D] [has_zero_object D] [has_equalizers D] [has_cokernels D] +variables [preadditive D] [has_equalizers D] [has_cokernels D] [has_images D] [has_image_maps D] /-- The left derived functors of an additive functor. -/ @@ -72,6 +75,9 @@ def functor.left_derived_obj_iso (F : C ⥤ D) [F.additive] (n : ℕ) (F.map_homotopy_equiv (ProjectiveResolution.homotopy_equiv _ P))) ≪≫ (homotopy_category.homology_factors D _ n).app _ +section +variables [has_zero_object D] + /-- The 0-th derived functor of `F` on a projective object `X` is just `F.obj X`. -/ @[simps] def functor.left_derived_obj_projective_zero (F : C ⥤ D) [F.additive] @@ -84,7 +90,7 @@ F.left_derived_obj_iso 0 (ProjectiveResolution.self X) ≪≫ open_locale zero_object /-- The higher derived functors vanish on projective objects. -/ -@[simps] +@[simps inv] def functor.left_derived_obj_projective_succ (F : C ⥤ D) [F.additive] (n : ℕ) (X : C) [projective X] : (F.left_derived (n+1)).obj X ≅ 0 := @@ -93,6 +99,8 @@ F.left_derived_obj_iso (n+1) (ProjectiveResolution.self X) ≪≫ (chain_complex.homology_functor_succ_single₀ D n).app (F.obj X) ≪≫ (functor.zero_obj _).iso_zero +end + /-- We can compute a left derived functor on a morphism using a lift of that morphism to a chain map between chosen projective resolutions. diff --git a/src/category_theory/functor/reflects_isomorphisms.lean b/src/category_theory/functor/reflects_isomorphisms.lean index 381f1b336220a..ce74ef7f9e527 100644 --- a/src/category_theory/functor/reflects_isomorphisms.lean +++ b/src/category_theory/functor/reflects_isomorphisms.lean @@ -3,11 +3,16 @@ Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ +import category_theory.balanced +import category_theory.functor.epi_mono import category_theory.functor.fully_faithful /-! # Functors which reflect isomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A functor `F` reflects isomorphisms if whenever `F.map f` is an isomorphism, `f` was too. It is formalized as a `Prop` valued typeclass `reflects_isomorphisms F`. @@ -15,7 +20,7 @@ It is formalized as a `Prop` valued typeclass `reflects_isomorphisms F`. Any fully faithful functor reflects isomorphisms. -/ -open category_theory +open category_theory category_theory.functor namespace category_theory @@ -51,6 +56,17 @@ instance (F : C ⥤ D) (G : D ⥤ E) [reflects_isomorphisms F] [reflects_isomorp ⟨λ _ _ f (hf : is_iso (G.map _)), by { resetI, haveI := is_iso_of_reflects_iso (F.map f) G, exact is_iso_of_reflects_iso f F }⟩ +@[priority 100] +instance reflects_isomorphisms_of_reflects_monomorphisms_of_reflects_epimorphisms [balanced C] + (F : C ⥤ D) [reflects_monomorphisms F] [reflects_epimorphisms F] : reflects_isomorphisms F := +{ reflects := λ A B f hf, + begin + resetI, + haveI : epi f := epi_of_epi_map F infer_instance, + haveI : mono f := mono_of_mono_map F infer_instance, + exact is_iso_of_mono_of_epi f + end } + end reflects_iso end category_theory diff --git a/src/category_theory/generator.lean b/src/category_theory/generator.lean index 0a2365872680f..5f79ceb63f136 100644 --- a/src/category_theory/generator.lean +++ b/src/category_theory/generator.lean @@ -4,12 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel -/ import category_theory.balanced +import category_theory.limits.essentially_small import category_theory.limits.opposites +import category_theory.limits.shapes.zero_morphisms +import category_theory.subobject.lattice +import category_theory.subobject.well_powered import data.set.opposite /-! # Separating and detecting sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + There are several non-equivalent notions of a generator of a category. Here, we consider two of them: @@ -44,17 +51,15 @@ We * We currently don't have any examples yet. * We will want typeclasses `has_separator C` and similar. -* To state the Special Adjoint Functor Theorem, we will need to be able to talk about *small* - separating sets. -/ -universes v u +universes w v₁ v₂ u₁ u₂ open category_theory.limits opposite namespace category_theory -variables {C : Type u} [category.{v} C] +variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] /-- We say that `𝒢` is a separating set if the functors `C(G, -)` for `G ∈ 𝒢` are collectively faithful, i.e., if `h ≫ f = h ≫ g` for all `h` with domain in `𝒢` implies `f = g`. -/ @@ -144,7 +149,6 @@ lemma is_detecting.is_separating [has_equalizers C] {𝒢 : set C} (h𝒢 : is_d by exactI eq_of_epi_equalizer section -local attribute [instance] has_equalizers_opposite lemma is_codetecting.is_coseparating [has_coequalizers C] {𝒢 : set C} : is_codetecting 𝒢 → is_coseparating 𝒢 := @@ -203,18 +207,16 @@ end mono section empty -lemma thin_of_is_separating_empty (h : is_separating (∅ : set C)) (X Y : C) : - subsingleton (X ⟶ Y) := -⟨λ f g, h _ _ $ λ G, false.elim⟩ +lemma thin_of_is_separating_empty (h : is_separating (∅ : set C)) : quiver.is_thin C := +λ _ _, ⟨λ f g, h _ _ $ λ G, false.elim⟩ -lemma is_separating_empty_of_thin [∀ X Y : C, subsingleton (X ⟶ Y)] : is_separating (∅ : set C) := +lemma is_separating_empty_of_thin [quiver.is_thin C] : is_separating (∅ : set C) := λ X Y f g hfg, subsingleton.elim _ _ -lemma thin_of_is_coseparating_empty (h : is_coseparating (∅ : set C)) (X Y : C) : - subsingleton (X ⟶ Y) := -⟨λ f g, h _ _ $ λ G, false.elim⟩ +lemma thin_of_is_coseparating_empty (h : is_coseparating (∅ : set C)) : quiver.is_thin C := +λ _ _, ⟨λ f g, h _ _ $ λ G, false.elim⟩ -lemma is_coseparating_empty_of_thin [∀ X Y : C, subsingleton (X ⟶ Y)] : +lemma is_coseparating_empty_of_thin [quiver.is_thin C] : is_coseparating (∅ : set C) := λ X Y f g hfg, subsingleton.elim _ _ @@ -236,6 +238,127 @@ lemma is_codetecting_empty_of_groupoid [∀ {X Y : C} (f : X ⟶ Y), is_iso f] : end empty +lemma is_separating_iff_epi (𝒢 : set C) + [Π (A : C), has_coproduct (λ f : Σ G : 𝒢, (G : C) ⟶ A, (f.1 : C))] : + is_separating 𝒢 ↔ ∀ A : C, epi (sigma.desc (@sigma.snd 𝒢 (λ G, (G : C) ⟶ A))) := +begin + refine ⟨λ h A, ⟨λ Z u v huv, h _ _ (λ G hG f, _)⟩, λ h X Y f g hh, _⟩, + { simpa using (sigma.ι (λ f : Σ G : 𝒢, (G : C) ⟶ A, (f.1 : C)) ⟨⟨G, hG⟩, f⟩) ≫= huv }, + { haveI := h X, + refine (cancel_epi (sigma.desc (@sigma.snd 𝒢 (λ G, (G : C) ⟶ X)))).1 (colimit.hom_ext (λ j, _)), + simpa using hh j.as.1.1 j.as.1.2 j.as.2 } +end + +lemma is_coseparating_iff_mono (𝒢 : set C) + [Π (A : C), has_product (λ f : Σ G : 𝒢, A ⟶ (G : C), (f.1 : C))] : + is_coseparating 𝒢 ↔ ∀ A : C, mono (pi.lift (@sigma.snd 𝒢 (λ G, A ⟶ (G : C)))) := +begin + refine ⟨λ h A, ⟨λ Z u v huv, h _ _ (λ G hG f, _)⟩, λ h X Y f g hh, _⟩, + { simpa using huv =≫ (pi.π (λ f : Σ G : 𝒢, A ⟶ (G : C), (f.1 : C)) ⟨⟨G, hG⟩, f⟩) }, + { haveI := h Y, + refine (cancel_mono (pi.lift (@sigma.snd 𝒢 (λ G, Y ⟶ (G : C))))).1 (limit.hom_ext (λ j, _)), + simpa using hh j.as.1.1 j.as.1.2 j.as.2 } +end + +/-- An ingredient of the proof of the Special Adjoint Functor Theorem: a complete well-powered + category with a small coseparating set has an initial object. + + In fact, it follows from the Special Adjoint Functor Theorem that `C` is already cocomplete, + see `has_colimits_of_has_limits_of_is_coseparating`. -/ +lemma has_initial_of_is_coseparating [well_powered C] [has_limits C] {𝒢 : set C} [small.{v₁} 𝒢] + (h𝒢 : is_coseparating 𝒢) : has_initial C := +begin + haveI := has_products_of_shape_of_small C 𝒢, + haveI := λ A, has_products_of_shape_of_small.{v₁} C (Σ G : 𝒢, A ⟶ (G : C)), + letI := complete_lattice_of_complete_semilattice_Inf (subobject (pi_obj (coe : 𝒢 → C))), + suffices : ∀ A : C, unique (((⊥ : subobject (pi_obj (coe : 𝒢 → C))) : C) ⟶ A), + { exactI has_initial_of_unique ((⊥ : subobject (pi_obj (coe : 𝒢 → C))) : C) }, + refine λ A, ⟨⟨_⟩, λ f, _⟩, + { let s := pi.lift (λ f : Σ G : 𝒢, A ⟶ (G : C), id (pi.π (coe : 𝒢 → C)) f.1), + let t := pi.lift (@sigma.snd 𝒢 (λ G, A ⟶ (G : C))), + haveI : mono t := (is_coseparating_iff_mono 𝒢).1 h𝒢 A, + exact subobject.of_le_mk _ (pullback.fst : pullback s t ⟶ _) bot_le ≫ pullback.snd }, + { generalize : default = g, + suffices : is_split_epi (equalizer.ι f g), + { exactI eq_of_epi_equalizer }, + exact is_split_epi.mk' ⟨subobject.of_le_mk _ (equalizer.ι f g ≫ subobject.arrow _) + bot_le, by { ext, simp }⟩ } +end + +/-- An ingredient of the proof of the Special Adjoint Functor Theorem: a cocomplete well-copowered + category with a small separating set has a terminal object. + + In fact, it follows from the Special Adjoint Functor Theorem that `C` is already complete, see + `has_limits_of_has_colimits_of_is_separating`. -/ +lemma has_terminal_of_is_separating [well_powered Cᵒᵖ] [has_colimits C] {𝒢 : set C} [small.{v₁} 𝒢] + (h𝒢 : is_separating 𝒢) : has_terminal C := +begin + haveI : small.{v₁} 𝒢.op := small_of_injective (set.op_equiv_self 𝒢).injective, + haveI : has_initial Cᵒᵖ := has_initial_of_is_coseparating ((is_coseparating_op_iff _).2 h𝒢), + exact has_terminal_of_has_initial_op +end + +section well_powered + +namespace subobject + +lemma eq_of_le_of_is_detecting {𝒢 : set C} (h𝒢 : is_detecting 𝒢) {X : C} (P Q : subobject X) + (h₁ : P ≤ Q) (h₂ : ∀ (G ∈ 𝒢) {f : G ⟶ X}, Q.factors f → P.factors f) : P = Q := +begin + suffices : is_iso (of_le _ _ h₁), + { exactI le_antisymm h₁ (le_of_comm (inv (of_le _ _ h₁)) (by simp)) }, + refine h𝒢 _ (λ G hG f, _), + have : P.factors (f ≫ Q.arrow) := h₂ _ hG ((factors_iff _ _).2 ⟨_, rfl⟩), + refine ⟨factor_thru _ _ this, _, λ g (hg : g ≫ _ = f), _⟩, + { simp only [← cancel_mono Q.arrow, category.assoc, of_le_arrow, factor_thru_arrow] }, + { simp only [← cancel_mono (subobject.of_le _ _ h₁), ← cancel_mono Q.arrow, hg, + category.assoc, of_le_arrow, factor_thru_arrow] } +end + +lemma inf_eq_of_is_detecting [has_pullbacks C] {𝒢 : set C} (h𝒢 : is_detecting 𝒢) {X : C} + (P Q : subobject X) (h : ∀ (G ∈ 𝒢) {f : G ⟶ X}, P.factors f → Q.factors f) : P ⊓ Q = P := +eq_of_le_of_is_detecting h𝒢 _ _ _root_.inf_le_left (λ G hG f hf, (inf_factors _).2 ⟨hf, h _ hG hf⟩) + +lemma eq_of_is_detecting [has_pullbacks C] {𝒢 : set C} (h𝒢 : is_detecting 𝒢) {X : C} + (P Q : subobject X) (h : ∀ (G ∈ 𝒢) {f : G ⟶ X}, P.factors f ↔ Q.factors f) : P = Q := +calc P = P ⊓ Q : eq.symm $ inf_eq_of_is_detecting h𝒢 _ _ $ λ G hG f hf, (h G hG).1 hf + ... = Q ⊓ P : inf_comm + ... = Q : inf_eq_of_is_detecting h𝒢 _ _ $ λ G hG f hf, (h G hG).2 hf + +end subobject + +/-- A category with pullbacks and a small detecting set is well-powered. -/ +lemma well_powered_of_is_detecting [has_pullbacks C] {𝒢 : set C} [small.{v₁} 𝒢] + (h𝒢 : is_detecting 𝒢) : well_powered C := +⟨λ X, @small_of_injective _ _ _ (λ P : subobject X, { f : Σ G : 𝒢, G.1 ⟶ X | P.factors f.2 }) $ + λ P Q h, subobject.eq_of_is_detecting h𝒢 _ _ (by simpa [set.ext_iff] using h)⟩ + +end well_powered + +namespace structured_arrow +variables (S : D) (T : C ⥤ D) + +lemma is_coseparating_proj_preimage {𝒢 : set C} (h𝒢 : is_coseparating 𝒢) : + is_coseparating ((proj S T).obj ⁻¹' 𝒢) := +begin + refine λ X Y f g hfg, ext _ _ (h𝒢 _ _ (λ G hG h, _)), + exact congr_arg comma_morphism.right (hfg (mk (Y.hom ≫ T.map h)) hG (hom_mk h rfl)) +end + +end structured_arrow + +namespace costructured_arrow +variables (S : C ⥤ D) (T : D) + +lemma is_separating_proj_preimage {𝒢 : set C} (h𝒢 : is_separating 𝒢) : + is_separating ((proj S T).obj ⁻¹' 𝒢) := +begin + refine λ X Y f g hfg, ext _ _ (h𝒢 _ _ (λ G hG h, _)), + convert congr_arg comma_morphism.left (hfg (mk (S.map h ≫ X.hom)) hG (hom_mk h rfl)) +end + +end costructured_arrow + /-- We say that `G` is a separator if the functor `C(G, -)` is faithful. -/ def is_separator (G : C) : Prop := is_separating ({G} : set C) @@ -341,6 +464,105 @@ lemma is_coseparator_iff_faithful_yoneda_obj (G : C) : λ h, (is_coseparator_def _).2 $ λ X Y f g hfg, quiver.hom.op_inj $ by exactI (yoneda.obj G).map_injective (funext hfg)⟩ +lemma is_separator_iff_epi (G : C) [Π A : C, has_coproduct (λ (f : G ⟶ A), G)] : + is_separator G ↔ ∀ (A : C), epi (sigma.desc (λ (f : G ⟶ A), f)) := +begin + rw is_separator_def, + refine ⟨λ h A, ⟨λ Z u v huv, h _ _ (λ i, _)⟩, λ h X Y f g hh, _⟩, + { simpa using (sigma.ι _ i) ≫= huv }, + { haveI := h X, + refine (cancel_epi (sigma.desc (λ (f : G ⟶ X), f))).1 (colimit.hom_ext (λ j, _)), + simpa using hh j.as } +end + +lemma is_coseparator_iff_mono (G : C) [Π A : C, has_product (λ (f : A ⟶ G), G)] : + is_coseparator G ↔ ∀ (A : C), mono (pi.lift (λ (f : A ⟶ G), f)) := +begin + rw is_coseparator_def, + refine ⟨λ h A, ⟨λ Z u v huv, h _ _ (λ i, _)⟩, λ h X Y f g hh, _⟩, + { simpa using huv =≫ (pi.π _ i) }, + { haveI := h Y, + refine (cancel_mono (pi.lift (λ (f : Y ⟶ G), f))).1 (limit.hom_ext (λ j, _)), + simpa using hh j.as } +end + +section zero_morphisms +variables [has_zero_morphisms C] + +lemma is_separator_coprod (G H : C) [has_binary_coproduct G H] : + is_separator (G ⨿ H) ↔ is_separating ({G, H} : set C) := +begin + refine ⟨λ h X Y u v huv, _, λ h, (is_separator_def _).2 (λ X Y u v huv, h _ _ (λ Z hZ g, _))⟩, + { refine h.def _ _ (λ g, coprod.hom_ext _ _), + { simpa using huv G (by simp) (coprod.inl ≫ g) }, + { simpa using huv H (by simp) (coprod.inr ≫ g) } }, + { simp only [set.mem_insert_iff, set.mem_singleton_iff] at hZ, + unfreezingI { rcases hZ with rfl|rfl }, + { simpa using coprod.inl ≫= huv (coprod.desc g 0) }, + { simpa using coprod.inr ≫= huv (coprod.desc 0 g) } } +end + +lemma is_separator_coprod_of_is_separator_left (G H : C) [has_binary_coproduct G H] + (hG : is_separator G) : is_separator (G ⨿ H) := +(is_separator_coprod _ _).2 $ is_separating.mono hG $ by simp + +lemma is_separator_coprod_of_is_separator_right (G H : C) [has_binary_coproduct G H] + (hH : is_separator H) : is_separator (G ⨿ H) := +(is_separator_coprod _ _).2 $ is_separating.mono hH $ by simp + +lemma is_separator_sigma {β : Type w} (f : β → C) [has_coproduct f] : + is_separator (∐ f) ↔ is_separating (set.range f) := +begin + refine ⟨λ h X Y u v huv, _, λ h, (is_separator_def _).2 (λ X Y u v huv, h _ _ (λ Z hZ g, _))⟩, + { refine h.def _ _ (λ g, colimit.hom_ext (λ b, _)), + simpa using huv (f b.as) (by simp) (colimit.ι (discrete.functor f) _ ≫ g) }, + { obtain ⟨b, rfl⟩ := set.mem_range.1 hZ, + classical, + simpa using sigma.ι f b ≫= huv (sigma.desc (pi.single b g)) } +end + +lemma is_separator_sigma_of_is_separator {β : Type w} (f : β → C) [has_coproduct f] + (b : β) (hb : is_separator (f b)) : is_separator (∐ f) := +(is_separator_sigma _).2 $ is_separating.mono hb $ by simp + +lemma is_coseparator_prod (G H : C) [has_binary_product G H] : + is_coseparator (G ⨯ H) ↔ is_coseparating ({G, H} : set C) := +begin + refine ⟨λ h X Y u v huv, _, λ h, (is_coseparator_def _).2 (λ X Y u v huv, h _ _ (λ Z hZ g, _))⟩, + { refine h.def _ _ (λ g, prod.hom_ext _ _), + { simpa using huv G (by simp) (g ≫ limits.prod.fst) }, + { simpa using huv H (by simp) (g ≫ limits.prod.snd) } }, + { simp only [set.mem_insert_iff, set.mem_singleton_iff] at hZ, + unfreezingI { rcases hZ with rfl|rfl }, + { simpa using huv (prod.lift g 0) =≫ limits.prod.fst }, + { simpa using huv (prod.lift 0 g) =≫ limits.prod.snd } } +end + +lemma is_coseparator_prod_of_is_coseparator_left (G H : C) [has_binary_product G H] + (hG : is_coseparator G) : is_coseparator (G ⨯ H) := +(is_coseparator_prod _ _).2 $ is_coseparating.mono hG $ by simp + +lemma is_coseparator_prod_of_is_coseparator_right (G H : C) [has_binary_product G H] + (hH : is_coseparator H) : is_coseparator (G ⨯ H) := +(is_coseparator_prod _ _).2 $ is_coseparating.mono hH $ by simp + +lemma is_coseparator_pi {β : Type w} (f : β → C) [has_product f] : + is_coseparator (∏ f) ↔ is_coseparating (set.range f) := +begin + refine ⟨λ h X Y u v huv, _, λ h, (is_coseparator_def _).2 (λ X Y u v huv, h _ _ (λ Z hZ g, _))⟩, + { refine h.def _ _ (λ g, limit.hom_ext (λ b, _)), + simpa using huv (f b.as) (by simp) (g ≫ limit.π (discrete.functor f) _ ) }, + { obtain ⟨b, rfl⟩ := set.mem_range.1 hZ, + classical, + simpa using huv (pi.lift (pi.single b g)) =≫ pi.π f b } +end + +lemma is_coseparator_pi_of_is_coseparator {β : Type w} (f : β → C) [has_product f] + (b : β) (hb : is_coseparator (f b)) : is_coseparator (∏ f) := +(is_coseparator_pi _).2 $ is_coseparating.mono hb $ by simp + +end zero_morphisms + lemma is_detector_iff_reflects_isomorphisms_coyoneda_obj (G : C) : is_detector G ↔ reflects_isomorphisms (coyoneda.obj (op G)) := begin @@ -364,4 +586,8 @@ begin rwa [is_iso_iff_bijective, function.bijective_iff_exists_unique] } end +lemma well_powered_of_is_detector [has_pullbacks C] (G : C) (hG : is_detector G) : + well_powered C := +well_powered_of_is_detecting hG + end category_theory diff --git a/src/category_theory/glue_data.lean b/src/category_theory/glue_data.lean index 422f45d391d19..94b388c7c0448 100644 --- a/src/category_theory/glue_data.lean +++ b/src/category_theory/glue_data.lean @@ -12,6 +12,9 @@ import category_theory.limits.shapes.types /-! # Gluing data +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `glue_data` as a family of data needed to glue topological spaces, schemes, etc. We provide the API to realize it as a multispan diagram, and also states lemmas about its interaction with a functor that preserves certain pullbacks. @@ -42,7 +45,7 @@ such that `t' : V i j ×[U i] V i k ⟶ V j k ×[U j] V j i`. 10. `t' i j k ≫ t' j k i ≫ t' k i j = 𝟙 _`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure glue_data := (J : Type v) (U : J → C) @@ -199,7 +202,7 @@ instance (i j k : D.J) : has_pullback (F.map (D.f i j)) (F.map (D.f i k)) := U := λ i, F.obj (D.U i), V := λ i, F.obj (D.V i), f := λ i j, F.map (D.f i j), - f_mono := λ i j, category_theory.preserves_mono F (D.f i j), + f_mono := λ i j, preserves_mono_of_preserves_limit _ _, f_id := λ i, infer_instance, t := λ i j, F.map (D.t i j), t_id := λ i, by { rw D.t_id i, simp }, diff --git a/src/category_theory/graded_object.lean b/src/category_theory/graded_object.lean index 394d339fe27a8..5bc8805c812c1 100644 --- a/src/category_theory/graded_object.lean +++ b/src/category_theory/graded_object.lean @@ -3,15 +3,17 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import data.int.basic import algebra.group_power.lemmas import category_theory.pi.basic -import category_theory.shift +import category_theory.shift.basic import category_theory.concrete_category.basic /-! # The category of graded objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For any type `β`, a `β`-graded object over some category `C` is just a function `β → C` into the objects of `C`. We put the "pointwise" category structure on these, as the non-dependent specialization of @@ -53,7 +55,7 @@ namespace graded_object variables {C : Type u} [category.{v} C] -instance category_of_graded_objects (β : Type w) : category.{(max w v)} (graded_object β C) := +instance category_of_graded_objects (β : Type w) : category.{max w v} (graded_object β C) := category_theory.pi (λ _, C) /-- The projection of a graded object to its `i`-th component. -/ @@ -107,11 +109,12 @@ instance has_shift {β : Type*} [add_comm_group β] (s : β) : has_shift (graded_object_with_shift s C) ℤ := has_shift_mk _ _ { F := λ n, comap (λ _, C) $ λ (b : β), b + n • s, - ε := (comap_id β (λ _, C)).symm ≪≫ (comap_eq C (by { ext, simp })), - μ := λ m n, comap_comp _ _ _ ≪≫ comap_eq C (by { ext, simp [add_zsmul, add_comm] }), - left_unitality := by { introv, ext, dsimp, simpa }, - right_unitality := by { introv, ext, dsimp, simpa }, - associativity := by { introv, ext, dsimp, simp } } + zero := comap_eq C (by { ext, simp }) ≪≫ comap_id β (λ _, C), + add := λ m n, comap_eq C (by { ext, simp [add_zsmul, add_comm], }) ≪≫ + (comap_comp _ _ _).symm, + assoc_hom_app := λ m₁ m₂ m₃ X, by { ext, dsimp, simp, }, + zero_add_hom_app := λ n X, by { ext, dsimp, simpa, }, + add_zero_hom_app := λ n X, by { ext, dsimp, simpa, }, } @[simp] lemma shift_functor_obj_apply {β : Type*} [add_comm_group β] (s : β) (X : β → C) (t : β) (n : ℤ) : @@ -124,7 +127,7 @@ rfl rfl instance has_zero_morphisms [has_zero_morphisms C] (β : Type w) : - has_zero_morphisms.{(max w v)} (graded_object β C) := + has_zero_morphisms.{max w v} (graded_object β C) := { has_zero := λ X Y, { zero := λ b, 0 } } @@ -136,7 +139,7 @@ section open_locale zero_object instance has_zero_object [has_zero_object C] [has_zero_morphisms C] (β : Type w) : - has_zero_object.{(max w v)} (graded_object β C) := + has_zero_object.{max w v} (graded_object β C) := by { refine ⟨⟨λ b, 0, λ X, ⟨⟨⟨λ b, 0⟩, λ f, _⟩⟩, λ X, ⟨⟨⟨λ b, 0⟩, λ f, _⟩⟩⟩⟩; ext, } end @@ -148,14 +151,19 @@ namespace graded_object -- If you're grading by things in higher universes, have fun! variables (β : Type) variables (C : Type u) [category.{v} C] -variables [has_coproducts C] +variables [has_coproducts.{0} C] + +section +local attribute [tidy] tactic.discrete_cases /-- The total object of a graded object is the coproduct of the graded components. -/ noncomputable def total : graded_object β C ⥤ C := -{ obj := λ X, ∐ (λ i : ulift.{v} β, X i.down), - map := λ X Y f, limits.sigma.map (λ i, f i.down) }. +{ obj := λ X, ∐ (λ i : β, X i), + map := λ X Y f, limits.sigma.map (λ i, f i) }. + +end variables [has_zero_morphisms C] @@ -169,8 +177,9 @@ instance : faithful (total β C) := begin classical, ext i, - replace w := sigma.ι (λ i : ulift.{v} β, X i.down) ⟨i⟩ ≫= w, + replace w := sigma.ι (λ i : β, X i) i ≫= w, erw [colimit.ι_map, colimit.ι_map] at w, + simp at *, exact mono.right_cancellation _ _ w, end } @@ -182,7 +191,7 @@ noncomputable theory variables (β : Type) variables (C : Type (u+1)) [large_category C] [concrete_category C] - [has_coproducts C] [has_zero_morphisms C] + [has_coproducts.{0} C] [has_zero_morphisms C] instance : concrete_category (graded_object β C) := { forget := total β C ⋙ forget C } diff --git a/src/category_theory/grothendieck.lean b/src/category_theory/grothendieck.lean index 077e9d979d4d4..35512dd11a57a 100644 --- a/src/category_theory/grothendieck.lean +++ b/src/category_theory/grothendieck.lean @@ -9,6 +9,9 @@ import category_theory.elements /-! # The Grothendieck construction +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a functor `F : C ⥤ Cat`, the objects of `grothendieck F` consist of dependent pairs `(b, f)`, where `b : C` and `f : F.obj c`, and a morphism `(b, f) ⟶ (b', f')` is a pair `β : b ⟶ b'` in `C`, and @@ -48,7 +51,7 @@ gives a category whose `base : X.base ⟶ Y.base` and `f.fiber : (F.map base).obj X.fiber ⟶ Y.fiber` -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure grothendieck := (base : C) (fiber : F.obj base) @@ -98,6 +101,8 @@ def comp {X Y Z : grothendieck F} (f : hom X Y) (g : hom Y Z) : hom X Z := eq_to_hom (by erw [functor.map_comp, functor.comp_obj]) ≫ (F.map g.base).map f.fiber ≫ g.fiber, } +local attribute [simp] eq_to_hom_map + instance : category (grothendieck F) := { hom := λ X Y, grothendieck.hom X Y, id := λ X, grothendieck.id X, @@ -148,13 +153,13 @@ variables (G : C ⥤ Type w) /-- Auxiliary definition for `grothendieck_Type_to_Cat`, to speed up elaboration. -/ @[simps] def grothendieck_Type_to_Cat_functor : grothendieck (G ⋙ Type_to_Cat) ⥤ G.elements := -{ obj := λ X, ⟨X.1, X.2⟩, +{ obj := λ X, ⟨X.1, X.2.as⟩, map := λ X Y f, ⟨f.1, f.2.1.1⟩ } /-- Auxiliary definition for `grothendieck_Type_to_Cat`, to speed up elaboration. -/ @[simps] def grothendieck_Type_to_Cat_inverse : G.elements ⥤ grothendieck (G ⋙ Type_to_Cat) := -{ obj := λ X, ⟨X.1, X.2⟩, +{ obj := λ X, ⟨X.1, ⟨X.2⟩⟩, map := λ X Y f, ⟨f.1, ⟨⟨f.2⟩⟩⟩ } /-- @@ -166,11 +171,11 @@ is the same as the 'category of elements' construction. def grothendieck_Type_to_Cat : grothendieck (G ⋙ Type_to_Cat) ≌ G.elements := { functor := grothendieck_Type_to_Cat_functor G, inverse := grothendieck_Type_to_Cat_inverse G, - unit_iso := nat_iso.of_components (λ X, by { cases X, exact iso.refl _, }) - (by { rintro ⟨⟩ ⟨⟩ ⟨base, ⟨⟨f⟩⟩⟩, dsimp at *, subst f, ext, simp, }), + unit_iso := nat_iso.of_components (λ X, by { rcases X with ⟨_, ⟨⟩⟩, exact iso.refl _, }) + (by { rintro ⟨_, ⟨⟩⟩ ⟨_, ⟨⟩⟩ ⟨base, ⟨⟨f⟩⟩⟩, dsimp at *, subst f, ext, simp, }), counit_iso := nat_iso.of_components (λ X, by { cases X, exact iso.refl _, }) (by { rintro ⟨⟩ ⟨⟩ ⟨f, e⟩, dsimp at *, subst e, ext, simp }), - functor_unit_iso_comp' := by { rintro ⟨⟩, dsimp, simp, refl, } } + functor_unit_iso_comp' := by { rintro ⟨_, ⟨⟩⟩, dsimp, simp, refl, } } end grothendieck diff --git a/src/category_theory/groupoid.lean b/src/category_theory/groupoid.lean index 73b3692f5381b..4889ac68b3223 100644 --- a/src/category_theory/groupoid.lean +++ b/src/category_theory/groupoid.lean @@ -6,10 +6,15 @@ Authors: Reid Barton, Scott Morrison, David Wärn import category_theory.full_subcategory import category_theory.products.basic import category_theory.pi.basic +import category_theory.category.basic +import combinatorics.quiver.connected_component /-! # Groupoids +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `groupoid` as a typeclass extending `category`, asserting that all morphisms have inverses. @@ -40,7 +45,10 @@ class groupoid (obj : Type u) extends category.{v} obj : Type (max u (v+1)) := restate_axiom groupoid.inv_comp' restate_axiom groupoid.comp_inv' -attribute [simp] groupoid.inv_comp groupoid.comp_inv + +initialize_simps_projections groupoid (-to_category_to_category_struct_to_quiver_hom, + to_category_to_category_struct_comp → comp, to_category_to_category_struct_id → id, + -to_category_to_category_struct, -to_category) /-- A `large_groupoid` is a groupoid @@ -59,7 +67,27 @@ variables {C : Type u} [groupoid.{v} C] {X Y : C} @[priority 100] -- see Note [lower instance priority] instance is_iso.of_groupoid (f : X ⟶ Y) : is_iso f := -⟨⟨groupoid.inv f, by simp⟩⟩ +⟨⟨groupoid.inv f, groupoid.comp_inv f, groupoid.inv_comp f⟩⟩ + +@[simp] lemma groupoid.inv_eq_inv (f : X ⟶ Y) : groupoid.inv f = inv f := +is_iso.eq_inv_of_hom_inv_id $ groupoid.comp_inv f + +/-- `groupoid.inv` is involutive. -/ +@[simps] def groupoid.inv_equiv : (X ⟶ Y) ≃ (Y ⟶ X) := +⟨groupoid.inv, groupoid.inv, λ f, by simp, λ f, by simp⟩ + +@[priority 100] +instance groupoid_has_involutive_reverse : quiver.has_involutive_reverse C := +{ reverse' := λ X Y f, groupoid.inv f, + inv' := λ X Y f, by { dsimp [quiver.reverse], simp, } } + +@[simp] lemma groupoid.reverse_eq_inv (f : X ⟶ Y) : quiver.reverse f = groupoid.inv f := rfl + +instance functor_map_reverse {D : Type*} [groupoid D] (F : C ⥤ D) : + F.to_prefunctor.map_reverse := +{ map_reverse' := λ X Y f, by + simp only [quiver.reverse, quiver.has_reverse.reverse', groupoid.inv_eq_inv, + functor.to_prefunctor_map, functor.map_inv], } variables (X Y) @@ -70,6 +98,13 @@ def groupoid.iso_equiv_hom : (X ≅ Y) ≃ (X ⟶ Y) := left_inv := λ i, iso.ext rfl, right_inv := λ f, rfl } +variables (C) + +/-- The functor from a groupoid `C` to its opposite sending every morphism to its inverse. -/ +@[simps] noncomputable def groupoid.inv_functor : C ⥤ Cᵒᵖ := +{ obj := opposite.op, + map := λ {X Y} f, (inv f).op } + end section diff --git a/src/category_theory/groupoid/basic.lean b/src/category_theory/groupoid/basic.lean new file mode 100644 index 0000000000000..edcd548ec99a5 --- /dev/null +++ b/src/category_theory/groupoid/basic.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2022 Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémi Bottinelli +-/ +import category_theory.groupoid +import combinatorics.quiver.basic + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines a few basic properties of groupoids. +-/ + +namespace category_theory + +namespace groupoid + +variables (C : Type*) [groupoid C] + +section thin + +lemma is_thin_iff : quiver.is_thin C ↔ ∀ c : C, subsingleton (c ⟶ c) := +begin + refine ⟨λ h c, h c c, λ h c d, subsingleton.intro $ λ f g, _⟩, + haveI := h d, + calc f = f ≫ (inv g ≫ g) : by simp only [inv_eq_inv, is_iso.inv_hom_id, category.comp_id] + ... = f ≫ (inv f ≫ g) : by congr + ... = g : by simp only [inv_eq_inv, is_iso.hom_inv_id_assoc], +end + +end thin + +section disconnected + +/-- A subgroupoid is totally disconnected if it only has loops. -/ +def is_totally_disconnected := ∀ (c d : C), (c ⟶ d) → c = d + +end disconnected + +end groupoid + +end category_theory diff --git a/src/category_theory/groupoid/free_groupoid.lean b/src/category_theory/groupoid/free_groupoid.lean new file mode 100644 index 0000000000000..33fb79fc5f491 --- /dev/null +++ b/src/category_theory/groupoid/free_groupoid.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2022 Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémi Bottinelli +-/ +import category_theory.category.basic +import category_theory.functor.basic +import category_theory.groupoid +import tactic.nth_rewrite +import category_theory.path_category +import category_theory.quotient +import combinatorics.quiver.symmetric + +/-! +# Free groupoid on a quiver + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the free groupoid on a quiver, the lifting of a prefunctor to its unique +extension as a functor from the free groupoid, and proves uniqueness of this extension. + +## Main results + +Given the type `V` and a quiver instance on `V`: + +- `free_groupoid V`: a type synonym for `V`. +- `free_groupoid_groupoid`: the `groupoid` instance on `free_groupoid V`. +- `lift`: the lifting of a prefunctor from `V` to `V'` where `V'` is a groupoid, to a functor. + `free_groupoid V ⥤ V'`. +- `lift_spec` and `lift_unique`: the proofs that, respectively, `lift` indeed is a lifting + and is the unique one. + +## Implementation notes + +The free groupoid is first defined by symmetrifying the quiver, taking the induced path category +and finally quotienting by the reducibility relation. + +-/ + +open set classical function +local attribute [instance] prop_decidable + +namespace category_theory +namespace groupoid +namespace free + +universes u v u' v' u'' v'' + +variables {V : Type u} [quiver.{v+1} V] + +/-- Shorthand for the "forward" arrow corresponding to `f` in `paths $ symmetrify V` -/ +abbreviation quiver.hom.to_pos_path {X Y : V} (f : X ⟶ Y) : + ((category_theory.paths.category_paths $ quiver.symmetrify V).hom X Y) := f.to_pos.to_path + +/-- Shorthand for the "forward" arrow corresponding to `f` in `paths $ symmetrify V` -/ +abbreviation quiver.hom.to_neg_path {X Y : V} (f : X ⟶ Y) : + ((category_theory.paths.category_paths $ quiver.symmetrify V).hom Y X) := f.to_neg.to_path + +/-- The "reduction" relation -/ +inductive red_step : hom_rel (paths (quiver.symmetrify V)) +| step (X Z : quiver.symmetrify V) (f : X ⟶ Z) : + red_step (𝟙 X) (f.to_path ≫ (quiver.reverse f).to_path) + +/-- The underlying vertices of the free groupoid -/ +def _root_.category_theory.free_groupoid (V) [Q : quiver V] := quotient (@red_step V Q) + +instance {V} [Q : quiver V] [h : nonempty V] : nonempty (free_groupoid V) := ⟨⟨h.some⟩⟩ + +lemma congr_reverse {X Y : paths $ quiver.symmetrify V} (p q : X ⟶ Y) : + quotient.comp_closure red_step p q → + quotient.comp_closure red_step (p.reverse) (q.reverse) := +begin + rintro ⟨XW, pp, qq, WY, _, Z, f⟩, + have : quotient.comp_closure red_step (WY.reverse ≫ 𝟙 _ ≫ XW.reverse) + (WY.reverse ≫ (f.to_path ≫ (quiver.reverse f).to_path) ≫ XW.reverse), + { apply quotient.comp_closure.intro, + apply red_step.step, }, + simpa only [category_struct.comp, category_struct.id, quiver.path.reverse, quiver.path.nil_comp, + quiver.path.reverse_comp, quiver.reverse_reverse, quiver.path.reverse_to_path, + quiver.path.comp_assoc] using this, +end + +lemma congr_comp_reverse {X Y : paths $ quiver.symmetrify V} (p : X ⟶ Y) : + quot.mk (@quotient.comp_closure _ _ red_step _ _) (p ≫ p.reverse) = + quot.mk (@quotient.comp_closure _ _ red_step _ _) (𝟙 X) := +begin + apply quot.eqv_gen_sound, + induction p with _ _ q f ih, + { apply eqv_gen.refl, }, + { simp only [quiver.path.reverse], + fapply eqv_gen.trans, + { exact q ≫ q.reverse, }, + { apply eqv_gen.symm, apply eqv_gen.rel, + have : quotient.comp_closure + red_step (q ≫ (𝟙 _) ≫ q.reverse) + (q ≫ (f.to_path ≫ (quiver.reverse f).to_path) ≫ q.reverse), by + { apply quotient.comp_closure.intro, apply red_step.step, }, + have that : q.cons f = q.comp f.to_path, by refl, rw that, + simp only [category.assoc, category.id_comp] at this ⊢, + simp only [category_struct.comp, quiver.path.comp_assoc] at this ⊢, + exact this, }, + { exact ih }, }, +end + +lemma congr_reverse_comp {X Y : paths $ quiver.symmetrify V} (p : X ⟶ Y) : + quot.mk (@quotient.comp_closure _ _ red_step _ _) (p.reverse ≫ p) = + quot.mk (@quotient.comp_closure _ _ red_step _ _) (𝟙 Y) := +begin + nth_rewrite 1 ←quiver.path.reverse_reverse p, + apply congr_comp_reverse, +end + +instance : category (free_groupoid V) := quotient.category red_step + +/-- The inverse of an arrow in the free groupoid -/ +def quot_inv {X Y : free_groupoid V} (f : X ⟶ Y) : Y ⟶ X := +quot.lift_on f + (λ pp, quot.mk _ $ pp.reverse) + (λ pp qq con, quot.sound $ congr_reverse pp qq con) + +instance : groupoid (free_groupoid V) := +{ inv := λ X Y f, quot_inv f, + inv_comp' := λ X Y p, quot.induction_on p $ λ pp, congr_reverse_comp pp, + comp_inv' := λ X Y p, quot.induction_on p $ λ pp, congr_comp_reverse pp } + +/-- The inclusion of the quiver on `V` to the underlying quiver on `free_groupoid V`-/ +def of (V) [quiver V] : V ⥤q (free_groupoid V) := +{ obj := λ X, ⟨X⟩, + map := λ X Y f, quot.mk _ f.to_pos_path } + +lemma of_eq : of V = + (quiver.symmetrify.of ⋙q paths.of).comp (quotient.functor $ @red_step V _).to_prefunctor := +begin + apply prefunctor.ext, rotate, + { rintro X, refl, }, + { rintro X Y f, refl, } +end + +section universal_property + +variables {V' : Type u'} [groupoid V'] (φ : V ⥤q V') + +/-- The lift of a prefunctor to a groupoid, to a functor from `free_groupoid V` -/ +def lift (φ : V ⥤q V') : free_groupoid V ⥤ V' := +quotient.lift _ + (paths.lift $ quiver.symmetrify.lift φ) + (by + { rintros _ _ _ _ ⟨X,Y,f⟩, + simp only [quiver.symmetrify.lift_reverse, paths.lift_nil, quiver.path.comp_nil, + paths.lift_cons, paths.lift_to_path], + symmetry, + apply groupoid.comp_inv, }) + +lemma lift_spec (φ : V ⥤q V') : of V ⋙q (lift φ).to_prefunctor = φ := +begin + rw [of_eq, prefunctor.comp_assoc, prefunctor.comp_assoc, functor.to_prefunctor_comp], + dsimp [lift], + rw [quotient.lift_spec, paths.lift_spec, quiver.symmetrify.lift_spec], +end + +lemma lift_unique (φ : V ⥤q V') (Φ : free_groupoid V ⥤ V') + (hΦ : of V ⋙q Φ.to_prefunctor = φ) : Φ = lift φ := +begin + apply quotient.lift_unique, + apply paths.lift_unique, + fapply @quiver.symmetrify.lift_unique _ _ _ _ _ _ _ _ _, + { rw ←functor.to_prefunctor_comp, exact hΦ, }, + { constructor, rintros X Y f, + simp only [←functor.to_prefunctor_comp,prefunctor.comp_map, paths.of_map, inv_eq_inv], + change Φ.map (inv ((quotient.functor red_step).to_prefunctor.map f.to_path)) = + inv (Φ.map ((quotient.functor red_step).to_prefunctor.map f.to_path)), + have := functor.map_inv Φ ((quotient.functor red_step).to_prefunctor.map f.to_path), + convert this; simp only [inv_eq_inv], }, +end + +end universal_property + +section functoriality + +variables {V' : Type u'} [quiver.{v'+1} V'] {V'' : Type u''} [quiver.{v''+1} V''] + +/-- The functor of free groupoid induced by a prefunctor of quivers -/ +def _root_.category_theory.free_groupoid_functor (φ : V ⥤q V') : + free_groupoid V ⥤ free_groupoid V' := lift (φ ⋙q of V') + +lemma free_groupoid_functor_id : + free_groupoid_functor (prefunctor.id V) = functor.id (free_groupoid V) := +begin + dsimp only [free_groupoid_functor], symmetry, + apply lift_unique, refl, +end + +lemma free_groupoid_functor_comp + (φ : V ⥤q V') (φ' : V' ⥤q V'') : + free_groupoid_functor (φ ⋙q φ') = free_groupoid_functor φ ⋙ free_groupoid_functor φ' := +begin + dsimp only [free_groupoid_functor], symmetry, + apply lift_unique, refl, +end + +end functoriality + +end free +end groupoid +end category_theory diff --git a/src/category_theory/groupoid/subgroupoid.lean b/src/category_theory/groupoid/subgroupoid.lean new file mode 100644 index 0000000000000..e605586966081 --- /dev/null +++ b/src/category_theory/groupoid/subgroupoid.lean @@ -0,0 +1,634 @@ +/- +Copyright (c) 2022 Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémi Bottinelli, Junyan Xu +-/ +import category_theory.groupoid.vertex_group +import category_theory.groupoid.basic +import category_theory.groupoid +import algebra.group.defs +import data.set.lattice +import group_theory.subgroup.basic +import order.galois_connection +/-! +# Subgroupoid + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines subgroupoids as `structure`s containing the subsets of arrows and their +stability under composition and inversion. +Also defined are: + +* containment of subgroupoids is a complete lattice; +* images and preimages of subgroupoids under a functor; +* the notion of normality of subgroupoids and its stability under intersection and preimage; +* compatibility of the above with `groupoid.vertex_group`. + + +## Main definitions + +Given a type `C` with associated `groupoid C` instance. + +* `subgroupoid C` is the type of subgroupoids of `C` +* `subgroupoid.is_normal` is the property that the subgroupoid is stable under conjugation + by arbitrary arrows, _and_ that all identity arrows are contained in the subgroupoid. +* `subgroupoid.comap` is the "preimage" map of subgroupoids along a functor. +* `subgroupoid.map` is the "image" map of subgroupoids along a functor _injective on objects_. +* `subgroupoid.vertex_subgroup` is the subgroup of the `vertex group` at a given vertex `v`, + assuming `v` is contained in the `subgroupoid` (meaning, by definition, that the arrow `𝟙 v` + is contained in the subgroupoid). + +## Implementation details + +The structure of this file is copied from/inspired by `group_theory.subgroup.basic` +and `combinatorics.simple_graph.subgraph`. + +## TODO + +* Equivalent inductive characterization of generated (normal) subgroupoids. +* Characterization of normal subgroupoids as kernels. +* Prove that `full` and `disconnect` preserve intersections (and `disconnect` also unions) + +## Tags + +subgroupoid + +-/ + +namespace category_theory + +open set groupoid + +local attribute [protected] category_theory.inv + +universes u v + +variables {C : Type u} [groupoid C] + +/-- +A sugroupoid of `C` consists of a choice of arrows for each pair of vertices, closed +under composition and inverses. +-/ +@[ext] structure subgroupoid (C : Type u) [groupoid C] := +(arrows : ∀ (c d : C), set (c ⟶ d)) +(inv : ∀ {c d} {p : c ⟶ d} (hp : p ∈ arrows c d), + inv p ∈ arrows d c) +(mul : ∀ {c d e} {p} (hp : p ∈ arrows c d) {q} (hq : q ∈ arrows d e), + p ≫ q ∈ arrows c e) + +attribute [protected] subgroupoid.inv subgroupoid.mul + +namespace subgroupoid + +variable (S : subgroupoid C) + +lemma inv_mem_iff {c d : C} (f : c ⟶ d) : inv f ∈ S.arrows d c ↔ f ∈ S.arrows c d := +begin + split, + { rintro h, + suffices : inv (inv f) ∈ S.arrows c d, + { simpa only [inv_eq_inv, is_iso.inv_inv] using this, }, + { apply S.inv h, }, }, + { apply S.inv, }, +end + +lemma mul_mem_cancel_left {c d e : C} {f : c ⟶ d} {g : d ⟶ e} (hf : f ∈ S.arrows c d) : + f ≫ g ∈ S.arrows c e ↔ g ∈ S.arrows d e := +begin + split, + { rintro h, + suffices : (inv f) ≫ f ≫ g ∈ S.arrows d e, + { simpa only [inv_eq_inv, is_iso.inv_hom_id_assoc] using this, }, + { apply S.mul (S.inv hf) h, }, }, + { apply S.mul hf, }, +end + +lemma mul_mem_cancel_right {c d e : C} {f : c ⟶ d} {g : d ⟶ e} (hg : g ∈ S.arrows d e) : + f ≫ g ∈ S.arrows c e ↔ f ∈ S.arrows c d := +begin + split, + { rintro h, + suffices : (f ≫ g) ≫ (inv g) ∈ S.arrows c d, + { simpa only [inv_eq_inv, is_iso.hom_inv_id, category.comp_id, category.assoc] using this, }, + { apply S.mul h (S.inv hg), }, }, + { exact λ hf, S.mul hf hg, }, +end + +/-- The vertices of `C` on which `S` has non-trivial isotropy -/ +def objs : set C := {c : C | (S.arrows c c).nonempty} + +lemma mem_objs_of_src {c d : C} {f : c ⟶ d} (h : f ∈ S.arrows c d) : c ∈ S.objs := +⟨f ≫ inv f, S.mul h (S.inv h)⟩ + +lemma mem_objs_of_tgt {c d : C} {f : c ⟶ d} (h : f ∈ S.arrows c d) : d ∈ S.objs := +⟨(inv f) ≫ f, S.mul (S.inv h) h⟩ + +lemma id_mem_of_nonempty_isotropy (c : C) : + c ∈ objs S → 𝟙 c ∈ S.arrows c c := +begin + rintro ⟨γ,hγ⟩, + convert S.mul hγ (S.inv hγ), + simp only [inv_eq_inv, is_iso.hom_inv_id], +end + +lemma id_mem_of_src {c d : C} {f : c ⟶ d} (h : f ∈ S.arrows c d) : (𝟙 c) ∈ S.arrows c c := +id_mem_of_nonempty_isotropy S c (mem_objs_of_src S h) + +lemma id_mem_of_tgt {c d : C} {f : c ⟶ d} (h : f ∈ S.arrows c d) : (𝟙 d) ∈ S.arrows d d := +id_mem_of_nonempty_isotropy S d (mem_objs_of_tgt S h) + +/-- A subgroupoid seen as a quiver on vertex set `C` -/ +def as_wide_quiver : quiver C := ⟨λ c d, subtype $ S.arrows c d⟩ + +/-- The coercion of a subgroupoid as a groupoid -/ +@[simps to_category_comp_coe, simps inv_coe (lemmas_only)] +instance coe : groupoid S.objs := +{ hom := λ a b, S.arrows a.val b.val, + id := λ a, ⟨𝟙 a.val, id_mem_of_nonempty_isotropy S a.val a.prop⟩, + comp := λ a b c p q, ⟨p.val ≫ q.val, S.mul p.prop q.prop⟩, + id_comp' := λ a b ⟨p,hp⟩, by simp only [category.id_comp], + comp_id' := λ a b ⟨p,hp⟩, by simp only [category.comp_id], + assoc' := λ a b c d ⟨p,hp⟩ ⟨q,hq⟩ ⟨r,hr⟩, by simp only [category.assoc], + inv := λ a b p, ⟨inv p.val, S.inv p.prop⟩, + inv_comp' := λ a b ⟨p,hp⟩, by simp only [inv_comp], + comp_inv' := λ a b ⟨p,hp⟩, by simp only [comp_inv] } + +@[simp] lemma coe_inv_coe' {c d : S.objs} (p : c ⟶ d) : + (category_theory.inv p).val = category_theory.inv p.val := +by { simp only [subtype.val_eq_coe, ←inv_eq_inv, coe_inv_coe], } + +/-- The embedding of the coerced subgroupoid to its parent-/ +def hom : S.objs ⥤ C := +{ obj := λ c, c.val, + map := λ c d f, f.val, + map_id' := λ c, rfl, + map_comp' := λ c d e f g, rfl } + +lemma hom.inj_on_objects : function.injective (hom S).obj := +by { rintros ⟨c,hc⟩ ⟨d,hd⟩ hcd, simp only [subtype.mk_eq_mk], exact hcd } + +lemma hom.faithful : + ∀ c d, function.injective (λ (f : c ⟶ d), (hom S).map f) := +by { rintros ⟨c,hc⟩ ⟨d,hd⟩ ⟨f,hf⟩ ⟨g,hg⟩ hfg, simp only [subtype.mk_eq_mk], exact hfg, } + +/-- The subgroup of the vertex group at `c` given by the subgroupoid -/ +def vertex_subgroup {c : C} (hc : c ∈ S.objs) : subgroup (c ⟶ c) := +{ carrier := S.arrows c c, + mul_mem' := λ f g hf hg, S.mul hf hg, + one_mem' := id_mem_of_nonempty_isotropy _ _ hc, + inv_mem' := λ f hf, S.inv hf } + +instance : set_like (subgroupoid C) (Σ (c d : C), c ⟶ d) := +{ coe := λ S, {F | F.2.2 ∈ S.arrows F.1 F.2.1}, + coe_injective' := λ ⟨S, _, _⟩ ⟨T, _, _⟩ h, by { ext c d f, apply set.ext_iff.1 h ⟨c, d, f⟩ } } + +lemma mem_iff (S : subgroupoid C) (F : Σ c d, c ⟶ d) : + F ∈ S ↔ F.2.2 ∈ S.arrows F.1 F.2.1 := iff.rfl + +lemma le_iff (S T : subgroupoid C) : (S ≤ T) ↔ (∀ {c d}, (S.arrows c d) ⊆ (T.arrows c d)) := +by { rw [set_like.le_def, sigma.forall], exact forall_congr (λ c, sigma.forall) } + +instance : has_top (subgroupoid C) := +⟨ { arrows := (λ _ _, set.univ), + mul := by { rintros, trivial, }, + inv := by { rintros, trivial, } } ⟩ + +lemma mem_top {c d : C} (f : c ⟶ d) : f ∈ (⊤ : subgroupoid C).arrows c d := trivial + +lemma mem_top_objs (c : C) : c ∈ (⊤ : subgroupoid C).objs := +by { dsimp [has_top.top,objs], simp only [univ_nonempty], } + +instance : has_bot (subgroupoid C) := +⟨ { arrows := (λ _ _, ∅), + mul := λ _ _ _ _, false.elim, + inv := λ _ _ _, false.elim } ⟩ + +instance : inhabited (subgroupoid C) := ⟨⊤⟩ + +instance : has_inf (subgroupoid C) := +⟨ λ S T, + { arrows := (λ c d, (S.arrows c d) ∩ (T.arrows c d)), + inv := by { rintros, exact ⟨S.inv hp.1, T.inv hp.2⟩, }, + mul := by { rintros, exact ⟨S.mul hp.1 hq.1, T.mul hp.2 hq.2⟩, } } ⟩ + +instance : has_Inf (subgroupoid C) := +⟨ λ s, + { arrows := λ c d, ⋂ S ∈ s, (subgroupoid.arrows S c d), + inv := by { intros, rw mem_Inter₂ at hp ⊢, exact λ S hS, S.inv (hp S hS) }, + mul := by { intros, rw mem_Inter₂ at hp hq ⊢,exact λ S hS, S.mul (hp S hS) (hq S hS) } } ⟩ + +instance : complete_lattice (subgroupoid C) := +{ bot := (⊥), + bot_le := λ S, empty_subset _, + top := (⊤), + le_top := λ S, subset_univ _, + inf := (⊓), + le_inf := λ R S T RS RT _ pR, ⟨RS pR, RT pR⟩, + inf_le_left := λ R S _, and.left, + inf_le_right := λ R S _, and.right, + .. complete_lattice_of_Inf (subgroupoid C) + begin + refine (λ s, ⟨λ S Ss F, _, λ T Tl F fT, _⟩); + simp only [Inf, mem_iff, mem_Inter], + exacts [λ hp, hp S Ss, λ S Ss, Tl Ss fT], + end } + +lemma le_objs {S T : subgroupoid C} (h : S ≤ T) : S.objs ⊆ T.objs := +λ s ⟨γ, hγ⟩, ⟨γ, @h ⟨s, s, γ⟩ hγ⟩ + +/-- The functor associated to the embedding of subgroupoids -/ +def inclusion {S T : subgroupoid C} (h : S ≤ T) : S.objs ⥤ T.objs := +{ obj := λ s, ⟨s.val, le_objs h s.prop⟩, + map := λ s t f, ⟨f.val, @h ⟨s, t, f.val⟩ f.prop⟩, + map_id' := λ _, rfl, + map_comp' := λ _ _ _ _ _, rfl } + +lemma inclusion_inj_on_objects {S T : subgroupoid C} (h : S ≤ T) : + function.injective (inclusion h).obj := +λ ⟨s,hs⟩ ⟨t,ht⟩, by simpa only [inclusion, subtype.mk_eq_mk] using id + +lemma inclusion_faithful {S T : subgroupoid C} (h : S ≤ T) (s t : S.objs) : + function.injective (λ (f : s ⟶ t), (inclusion h).map f) := +λ ⟨f,hf⟩ ⟨g,hg⟩, by { dsimp only [inclusion], simpa only [subtype.mk_eq_mk] using id } + +lemma inclusion_refl {S : subgroupoid C} : inclusion (le_refl S) = 𝟭 S.objs := +functor.hext (λ ⟨s,hs⟩, rfl) (λ ⟨s,hs⟩ ⟨t,ht⟩ ⟨f,hf⟩, heq_of_eq rfl) + +lemma inclusion_trans {R S T : subgroupoid C} (k : R ≤ S) (h : S ≤ T) : + inclusion (k.trans h) = (inclusion k) ⋙ (inclusion h) := rfl + +lemma inclusion_comp_embedding {S T : subgroupoid C} (h : S ≤ T) : + (inclusion h) ⋙ T.hom = S.hom := rfl + +/-- The family of arrows of the discrete groupoid -/ +inductive discrete.arrows : Π (c d : C), (c ⟶ d) → Prop +| id (c : C) : discrete.arrows c c (𝟙 c) + +/-- The only arrows of the discrete groupoid are the identity arrows. -/ +def discrete : subgroupoid C := +{ arrows := discrete.arrows, + inv := by { rintros _ _ _ ⟨⟩, simp only [inv_eq_inv, is_iso.inv_id], split, }, + mul := by { rintros _ _ _ _ ⟨⟩ _ ⟨⟩, rw category.comp_id, split, } } + +lemma mem_discrete_iff {c d : C} (f : c ⟶ d) : + (f ∈ (discrete).arrows c d) ↔ (∃ (h : c = d), f = eq_to_hom h) := +⟨by { rintro ⟨⟩, exact ⟨rfl, rfl⟩ }, by { rintro ⟨rfl, rfl⟩, split }⟩ + +/-- A subgroupoid is wide if its carrier set is all of `C`-/ +structure is_wide : Prop := +(wide : ∀ c, (𝟙 c) ∈ (S.arrows c c)) + +lemma is_wide_iff_objs_eq_univ : S.is_wide ↔ S.objs = set.univ := +begin + split, + { rintro h, + ext, split; simp only [top_eq_univ, mem_univ, implies_true_iff, forall_true_left], + apply mem_objs_of_src S (h.wide x), }, + { rintro h, + refine ⟨λ c, _⟩, + obtain ⟨γ,γS⟩ := (le_of_eq h.symm : ⊤ ⊆ S.objs) (set.mem_univ c), + exact id_mem_of_src S γS, }, +end + +lemma is_wide.id_mem {S : subgroupoid C} (Sw : S.is_wide) (c : C) : + (𝟙 c) ∈ S.arrows c c := Sw.wide c + +lemma is_wide.eq_to_hom_mem {S : subgroupoid C} (Sw : S.is_wide) {c d : C} (h : c = d) : + (eq_to_hom h) ∈ S.arrows c d := by +{ cases h, simp only [eq_to_hom_refl], apply Sw.id_mem c, } + +/-- A subgroupoid is normal if it is wide and satisfies the expected stability under conjugacy. -/ +structure is_normal extends (is_wide S) : Prop := +(conj : ∀ {c d} (p : c ⟶ d) {γ : c ⟶ c} (hs : γ ∈ S.arrows c c), + ((inv p) ≫ γ ≫ p) ∈ (S.arrows d d)) + +lemma is_normal.conj' {S : subgroupoid C} (Sn : is_normal S) : + ∀ {c d} (p : d ⟶ c) {γ : c ⟶ c} (hs : γ ∈ S.arrows c c), (p ≫ γ ≫ (inv p)) ∈ (S.arrows d d) := +λ c d p γ hs, by { convert Sn.conj (inv p) hs, simp, } + +lemma is_normal.conjugation_bij (Sn : is_normal S) {c d} (p : c ⟶ d) : + set.bij_on (λ γ : c ⟶ c, (inv p) ≫ γ ≫ p) (S.arrows c c) (S.arrows d d) := +begin + refine ⟨λ γ γS, Sn.conj p γS, λ γ₁ γ₁S γ₂ γ₂S h, _, λ δ δS, ⟨p ≫ δ ≫ (inv p), Sn.conj' p δS, _⟩⟩, + { simpa only [inv_eq_inv, category.assoc, is_iso.hom_inv_id, + category.comp_id, is_iso.hom_inv_id_assoc] using p ≫= h =≫ inv p }, + { simp only [inv_eq_inv, category.assoc, is_iso.inv_hom_id, + category.comp_id, is_iso.inv_hom_id_assoc] }, +end + +lemma top_is_normal : is_normal (⊤ : subgroupoid C) := +{ wide := (λ c, trivial), + conj := (λ a b c d e, trivial) } + +lemma Inf_is_normal (s : set $ subgroupoid C) (sn : ∀ S ∈ s, is_normal S) : is_normal (Inf s) := +{ wide := by { simp_rw [Inf, mem_Inter₂], exact λ c S Ss, (sn S Ss).wide c }, + conj := by { simp_rw [Inf, mem_Inter₂], exact λ c d p γ hγ S Ss, (sn S Ss).conj p (hγ S Ss) } } + +lemma discrete_is_normal : (@discrete C _).is_normal := +{ wide := λ c, by { constructor, }, + conj := λ c d f γ hγ, by + { cases hγ, simp only [inv_eq_inv, category.id_comp, is_iso.inv_hom_id], constructor, } } + +lemma is_normal.vertex_subgroup (Sn : is_normal S) (c : C) (cS : c ∈ S.objs) : + (S.vertex_subgroup cS).normal := +{ conj_mem := λ x hx y, by { rw mul_assoc, exact Sn.conj' y hx } } + +section generated_subgroupoid + +-- TODO: proof that generated is just "words in X" and generated_normal is similarly +variable (X : ∀ c d : C, set (c ⟶ d)) + +/-- The subgropoid generated by the set of arrows `X` -/ +def generated : subgroupoid C := +Inf {S : subgroupoid C | ∀ c d, X c d ⊆ S.arrows c d} + +lemma subset_generated (c d : C) : X c d ⊆ (generated X).arrows c d := +begin + dsimp only [generated, Inf], + simp only [subset_Inter₂_iff], + exact λ S hS f fS, hS _ _ fS, +end + +/-- The normal sugroupoid generated by the set of arrows `X` -/ +def generated_normal : subgroupoid C := +Inf {S : subgroupoid C | (∀ c d, X c d ⊆ S.arrows c d) ∧ S.is_normal} + +lemma generated_le_generated_normal : generated X ≤ generated_normal X := +begin + apply @Inf_le_Inf (subgroupoid C) _, + exact λ S ⟨h,_⟩, h, +end + +lemma generated_normal_is_normal : (generated_normal X).is_normal := +Inf_is_normal _ (λ S h, h.right) + +lemma is_normal.generated_normal_le {S : subgroupoid C} (Sn : S.is_normal) : + generated_normal X ≤ S ↔ ∀ c d, X c d ⊆ S.arrows c d := +begin + split, + { rintro h c d, + let h' := generated_le_generated_normal X, + rw le_iff at h h', + exact ((subset_generated X c d).trans (@h' c d)).trans (@h c d), }, + { rintro h, + apply @Inf_le (subgroupoid C) _, + exact ⟨h,Sn⟩, }, +end + +end generated_subgroupoid + +section hom + +variables {D : Type*} [groupoid D] (φ : C ⥤ D) + +/-- +A functor between groupoid defines a map of subgroupoids in the reverse direction +by taking preimages. + -/ +def comap (S : subgroupoid D) : subgroupoid C := +{ arrows := λ c d, {f : c ⟶ d | φ.map f ∈ S.arrows (φ.obj c) (φ.obj d)}, + inv := λ c d p hp, by { rw [mem_set_of, inv_eq_inv, φ.map_inv p, ← inv_eq_inv], exact S.inv hp }, + mul := begin + rintros, + simp only [mem_set_of, functor.map_comp], + apply S.mul; assumption, + end } + +lemma comap_mono (S T : subgroupoid D) : + S ≤ T → comap φ S ≤ comap φ T := λ ST ⟨c,d,p⟩, @ST ⟨_,_,_⟩ + +lemma is_normal_comap {S : subgroupoid D} (Sn : is_normal S) : is_normal (comap φ S) := +{ wide := λ c, by { rw [comap, mem_set_of, functor.map_id], apply Sn.wide, }, + conj := λ c d f γ hγ, by + { simp_rw [inv_eq_inv f, comap, mem_set_of, functor.map_comp, functor.map_inv, ←inv_eq_inv], + exact Sn.conj _ hγ, } } + +@[simp] lemma comap_comp {E : Type*} [groupoid E] (ψ : D ⥤ E) : + comap (φ ⋙ ψ) = (comap φ) ∘ (comap ψ) := rfl + +/-- The kernel of a functor between subgroupoid is the preimage. -/ +def ker : subgroupoid C := comap φ discrete + +lemma mem_ker_iff {c d : C} (f : c ⟶ d) : + f ∈ (ker φ).arrows c d ↔ ∃ (h : φ.obj c = φ.obj d), φ.map f = eq_to_hom h := +mem_discrete_iff (φ.map f) + +lemma ker_is_normal : (ker φ).is_normal := is_normal_comap φ (discrete_is_normal) + +@[simp] +lemma ker_comp {E : Type*} [groupoid E] (ψ : D ⥤ E) : ker (φ ⋙ ψ) = comap φ (ker ψ) := rfl + +/-- The family of arrows of the image of a subgroupoid under a functor injective on objects -/ +inductive map.arrows (hφ : function.injective φ.obj) (S : subgroupoid C) : + Π (c d : D), (c ⟶ d) → Prop +| im {c d : C} (f : c ⟶ d) (hf : f ∈ S.arrows c d) : map.arrows (φ.obj c) (φ.obj d) (φ.map f) + +lemma map.arrows_iff (hφ : function.injective φ.obj) (S : subgroupoid C) {c d : D} (f : c ⟶ d) : + map.arrows φ hφ S c d f ↔ + ∃ (a b : C) (g : a ⟶ b) (ha : φ.obj a = c) (hb : φ.obj b = d) (hg : g ∈ S.arrows a b), + f = (eq_to_hom ha.symm) ≫ φ.map g ≫ (eq_to_hom hb) := +begin + split, + { rintro ⟨g,hg⟩, exact ⟨_,_,g,rfl,rfl,hg, eq_conj_eq_to_hom _⟩ }, + { rintro ⟨a,b,g,rfl,rfl,hg,rfl⟩, rw ← eq_conj_eq_to_hom, split, exact hg }, +end + +/-- The "forward" image of a subgroupoid under a functor injective on objects -/ +def map (hφ : function.injective φ.obj) (S : subgroupoid C) : subgroupoid D := +{ arrows := map.arrows φ hφ S, + inv := begin + rintro _ _ _ ⟨⟩, + rw [inv_eq_inv, ←functor.map_inv, ←inv_eq_inv], + split, apply S.inv, assumption, + end, + mul := begin + rintro _ _ _ _ ⟨f,hf⟩ q hq, + obtain ⟨c₃,c₄,g,he,rfl,hg,gq⟩ := (map.arrows_iff φ hφ S q).mp hq, + cases hφ he, rw [gq, ← eq_conj_eq_to_hom, ← φ.map_comp], + split, exact S.mul hf hg, + end } + +lemma mem_map_iff (hφ : function.injective φ.obj) (S : subgroupoid C) {c d : D} (f : c ⟶ d) : + f ∈ (map φ hφ S).arrows c d ↔ + ∃ (a b : C) (g : a ⟶ b) (ha : φ.obj a = c) (hb : φ.obj b = d) (hg : g ∈ S.arrows a b), + f = (eq_to_hom ha.symm) ≫ φ.map g ≫ (eq_to_hom hb) := map.arrows_iff φ hφ S f + +lemma galois_connection_map_comap (hφ : function.injective φ.obj) : + galois_connection (map φ hφ) (comap φ) := +begin + rintro S T, simp_rw [le_iff], split, + { exact λ h c d f fS, h (map.arrows.im f fS), }, + { rintros h _ _ g ⟨a,gφS⟩, + exact h gφS, }, +end + +lemma map_mono (hφ : function.injective φ.obj) (S T : subgroupoid C) : + S ≤ T → map φ hφ S ≤ map φ hφ T := +λ h, (galois_connection_map_comap φ hφ).monotone_l h + +lemma le_comap_map (hφ : function.injective φ.obj) (S : subgroupoid C) : + S ≤ comap φ (map φ hφ S) := (galois_connection_map_comap φ hφ).le_u_l S + +lemma map_comap_le (hφ : function.injective φ.obj) (T : subgroupoid D) : + map φ hφ (comap φ T) ≤ T := (galois_connection_map_comap φ hφ).l_u_le T + +lemma map_le_iff_le_comap (hφ : function.injective φ.obj) + (S : subgroupoid C) (T : subgroupoid D) : + map φ hφ S ≤ T ↔ S ≤ comap φ T := (galois_connection_map_comap φ hφ).le_iff_le + +lemma mem_map_objs_iff (hφ : function.injective φ.obj) (d : D) : + d ∈ (map φ hφ S).objs ↔ ∃ c ∈ S.objs, φ.obj c = d := +begin + dsimp [objs, map], + split, + { rintro ⟨f,hf⟩, + change map.arrows φ hφ S d d f at hf, rw map.arrows_iff at hf, + obtain ⟨c,d,g,ec,ed,eg,gS,eg⟩ := hf, + exact ⟨c, ⟨mem_objs_of_src S eg, ec⟩⟩, }, + { rintros ⟨c,⟨γ,γS⟩,rfl⟩, + exact ⟨φ.map γ,⟨γ,γS⟩⟩, } +end + +@[simp] +lemma map_objs_eq (hφ : function.injective φ.obj) : (map φ hφ S).objs = φ.obj '' S.objs := +by { ext, convert mem_map_objs_iff S φ hφ x, simp only [mem_image, exists_prop], } + +/-- The image of a functor injective on objects -/ +def im (hφ : function.injective φ.obj) := map φ hφ (⊤) + +lemma mem_im_iff (hφ : function.injective φ.obj) {c d : D} (f : c ⟶ d) : + f ∈ (im φ hφ).arrows c d ↔ + ∃ (a b : C) (g : a ⟶ b) (ha : φ.obj a = c) (hb : φ.obj b = d), + f = (eq_to_hom ha.symm) ≫ φ.map g ≫ (eq_to_hom hb) := +by { convert map.arrows_iff φ hφ ⊤ f, simp only [has_top.top, mem_univ, exists_true_left] } + +lemma mem_im_objs_iff (hφ : function.injective φ.obj) (d : D) : + d ∈ (im φ hφ).objs ↔ ∃ c : C, φ.obj c = d := by +{ simp only [im, mem_map_objs_iff, mem_top_objs, exists_true_left], } + +lemma obj_surjective_of_im_eq_top (hφ : function.injective φ.obj) (hφ' : im φ hφ = ⊤) : + function.surjective φ.obj := +begin + rintro d, + rw [←mem_im_objs_iff, hφ'], + apply mem_top_objs, +end + +lemma is_normal_map (hφ : function.injective φ.obj) (hφ' : im φ hφ = ⊤) (Sn : S.is_normal) : + (map φ hφ S).is_normal := +{ wide := λ d, by + { obtain ⟨c,rfl⟩ := obj_surjective_of_im_eq_top φ hφ hφ' d, + change map.arrows φ hφ S _ _ (𝟙 _), rw ←functor.map_id, + constructor, exact Sn.wide c, }, + conj := λ d d' g δ hδ, by + { rw mem_map_iff at hδ, + obtain ⟨c,c',γ,cd,cd',γS,hγ⟩ := hδ, subst_vars, cases hφ cd', + have : d' ∈ (im φ hφ).objs, by { rw hφ', apply mem_top_objs, }, + rw mem_im_objs_iff at this, + obtain ⟨c',rfl⟩ := this, + have : g ∈ (im φ hφ).arrows (φ.obj c) (φ.obj c'), by + { rw hφ', trivial, }, + rw mem_im_iff at this, + obtain ⟨b,b',f,hb,hb',_,hf⟩ := this, subst_vars, cases hφ hb, cases hφ hb', + change map.arrows φ hφ S (φ.obj c') (φ.obj c') _, + simp only [eq_to_hom_refl, category.comp_id, category.id_comp, inv_eq_inv], + suffices : map.arrows φ hφ S (φ.obj c') (φ.obj c') (φ.map $ inv f ≫ γ ≫ f), + { simp only [inv_eq_inv, functor.map_comp, functor.map_inv] at this, exact this, }, + { constructor, apply Sn.conj f γS, } } } + +end hom + +section thin + +/-- A subgroupoid `is_thin` if it has at most one arrow between any two vertices. -/ +abbreviation is_thin := quiver.is_thin S.objs + +lemma is_thin_iff : S.is_thin ↔ ∀ (c : S.objs), subsingleton (S.arrows c c) := +by apply is_thin_iff + +end thin + +section disconnected + +/-- A subgroupoid `is_totally_disconnected` if it has only isotropy arrows. -/ +abbreviation is_totally_disconnected := is_totally_disconnected S.objs + +lemma is_totally_disconnected_iff : + S.is_totally_disconnected ↔ ∀ c d, (S.arrows c d).nonempty → c = d := +begin + split, + { rintro h c d ⟨f,fS⟩, + rw ←@subtype.mk_eq_mk _ _ c (mem_objs_of_src S fS) d (mem_objs_of_tgt S fS), + exact h ⟨c, mem_objs_of_src S fS⟩ ⟨d, mem_objs_of_tgt S fS⟩ ⟨f, fS⟩, }, + { rintros h ⟨c, hc⟩ ⟨d, hd⟩ ⟨f, fS⟩, + simp only [subtype.mk_eq_mk], + exact h c d ⟨f, fS⟩, }, +end + +/-- The isotropy subgroupoid of `S` -/ +def disconnect : subgroupoid C := +{ arrows := λ c d f, c = d ∧ f ∈ S.arrows c d, + inv := by { rintros _ _ _ ⟨rfl, h⟩, exact ⟨rfl, S.inv h⟩, }, + mul := by { rintros _ _ _ _ ⟨rfl, h⟩ _ ⟨rfl, h'⟩, exact ⟨rfl, S.mul h h'⟩, } } + +lemma disconnect_le : S.disconnect ≤ S := +by { rw le_iff, rintros _ _ _ ⟨⟩, assumption, } + +lemma disconnect_normal (Sn : S.is_normal) : S.disconnect.is_normal := +{ wide := λ c, ⟨rfl, Sn.wide c⟩, + conj := λ c d p γ ⟨_,h'⟩, ⟨rfl, Sn.conj _ h'⟩ } + +@[simp] lemma mem_disconnect_objs_iff {c : C} : c ∈ S.disconnect.objs ↔ c ∈ S.objs := +⟨λ ⟨γ, h, γS⟩, ⟨γ, γS⟩, λ ⟨γ, γS⟩, ⟨γ, rfl, γS⟩⟩ + +lemma disconnect_objs : S.disconnect.objs = S.objs := +by { apply set.ext, apply mem_disconnect_objs_iff, } + +lemma disconnect_is_totally_disconnected : S.disconnect.is_totally_disconnected := +by { rw is_totally_disconnected_iff, exact λ c d ⟨f, h, fS⟩, h } + +end disconnected + +section full + +variable (D : set C) + +/-- The full subgroupoid on a set `D : set C` -/ +def full : subgroupoid C := +{ arrows := λ c d _, c ∈ D ∧ d ∈ D, + inv := by { rintros _ _ _ ⟨⟩, constructor; assumption, }, + mul := by { rintros _ _ _ _ ⟨⟩ _ ⟨⟩, constructor; assumption,} } + +lemma full_objs : (full D).objs = D := +set.ext $ λ _, ⟨λ ⟨f, h, _⟩, h , λ h, ⟨𝟙 _, h, h⟩⟩ + +@[simp] lemma mem_full_iff {c d : C} {f : c ⟶ d} : f ∈ (full D).arrows c d ↔ c ∈ D ∧ d ∈ D := +iff.rfl + +@[simp] lemma mem_full_objs_iff {c : C} : c ∈ (full D).objs ↔ c ∈ D := +by rw full_objs + +@[simp] lemma full_empty : full ∅ = (⊥ : subgroupoid C) := +by { ext, simp only [has_bot.bot, mem_full_iff, mem_empty_iff_false, and_self], } + +@[simp] lemma full_univ : full set.univ = (⊤ : subgroupoid C) := +by { ext, simp only [mem_full_iff, mem_univ, and_self, true_iff], } + +lemma full_mono {D E : set C} (h : D ≤ E) : full D ≤ full E := +begin + rw le_iff, + rintro c d f, + simp only [mem_full_iff], + exact λ ⟨hc, hd⟩, ⟨h hc, h hd⟩, +end + +lemma full_arrow_eq_iff {c d : (full D).objs} {f g : c ⟶ d} : + f = g ↔ (↑f : c.val ⟶ d.val) = ↑g := +by apply subtype.ext_iff + +end full + +end subgroupoid + +end category_theory diff --git a/src/category_theory/groupoid/vertex_group.lean b/src/category_theory/groupoid/vertex_group.lean new file mode 100644 index 0000000000000..d4bbadc7c5615 --- /dev/null +++ b/src/category_theory/groupoid/vertex_group.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2022 Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémi Bottinelli +-/ +import category_theory.groupoid +import category_theory.path_category +import algebra.group.defs +import algebra.hom.group +import algebra.hom.equiv.basic +import combinatorics.quiver.path + +/-! +# Vertex group + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the vertex group (*aka* isotropy group) of a groupoid at a vertex. + +## Implementation notes + +* The instance is defined "manually", instead of relying on `category_theory.Aut.group` or + using `category_theory.inv`. +* The multiplication order therefore matches the categorical one : `x * y = x ≫ y`. +* The inverse is directly defined in terms of the groupoidal inverse : `x ⁻¹ = groupoid.inv x`. + +## Tags + +isotropy, vertex group, groupoid +-/ + +namespace category_theory + +namespace groupoid + +universes u v + +variables {C : Type u} [groupoid C] + +/-- The vertex group at `c`. -/ +@[simps] instance vertex_group (c : C): group (c ⟶ c) := +{ mul := λ (x y : c ⟶ c), x ≫ y, + mul_assoc := category.assoc, + one := 𝟙 c, + one_mul := category.id_comp, + mul_one := category.comp_id, + inv := groupoid.inv, + mul_left_inv := inv_comp } + +/-- The inverse in the group is equal to the inverse given by `category_theory.inv`. -/ +lemma vertex_group.inv_eq_inv (c : C) (γ : c ⟶ c) : + γ ⁻¹ = category_theory.inv γ := groupoid.inv_eq_inv γ + +/-- +An arrow in the groupoid defines, by conjugation, an isomorphism of groups between +its endpoints. +-/ +@[simps] def vertex_group_isom_of_map {c d : C} (f : c ⟶ d) : (c ⟶ c) ≃* (d ⟶ d) := +{ to_fun := λ γ, inv f ≫ γ ≫ f, + inv_fun := λ δ, f ≫ δ ≫ inv f, + left_inv := λ γ, by simp_rw [category.assoc, comp_inv, category.comp_id, + ←category.assoc, comp_inv, category.id_comp], + right_inv := λ δ, by simp_rw [category.assoc, inv_comp, ←category.assoc, + inv_comp, category.id_comp, category.comp_id], + map_mul' := λ γ₁ γ₂, by simp only [vertex_group_mul, inv_eq_inv, + category.assoc, is_iso.hom_inv_id_assoc] } + +/-- +A path in the groupoid defines an isomorphism between its endpoints. +-/ +def vertex_group_isom_of_path {c d : C} (p : quiver.path c d) : (c ⟶ c) ≃* (d ⟶ d) := +vertex_group_isom_of_map (compose_path p) + +/-- A functor defines a morphism of vertex group. -/ +@[simps] def _root_.category_theory.functor.map_vertex_group {D : Type v} [groupoid D] + (φ : C ⥤ D) (c : C) : (c ⟶ c) →* (φ.obj c ⟶ φ.obj c) := +{ to_fun := φ.map, + map_one' := φ.map_id c, + map_mul' := φ.map_comp } + +end groupoid + +end category_theory diff --git a/src/category_theory/idempotents/basic.lean b/src/category_theory/idempotents/basic.lean index a19ef233af3e8..1efc764aa4533 100644 --- a/src/category_theory/idempotents/basic.lean +++ b/src/category_theory/idempotents/basic.lean @@ -9,6 +9,9 @@ import category_theory.abelian.basic /-! # Idempotent complete categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define the notion of idempotent complete categories (also known as Karoubian categories, or pseudoabelian in the case of preadditive categories). diff --git a/src/category_theory/idempotents/biproducts.lean b/src/category_theory/idempotents/biproducts.lean index d7b432b0525ef..88c8757c3259c 100644 --- a/src/category_theory/idempotents/biproducts.lean +++ b/src/category_theory/idempotents/biproducts.lean @@ -5,14 +5,16 @@ Authors: Joël Riou -/ import category_theory.idempotents.karoubi -import category_theory.additive.basic /-! # Biproducts in the idempotent completion of a preadditive category -In this file, we define an instance expressing that if `C` is an additive category, -then `karoubi C` is also an additive category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we define an instance expressing that if `C` is an additive category +(i.e. is preadditive and has finite biproducts), then `karoubi C` is also an additive category. We also obtain that for all `P : karoubi C` where `C` is a preadditive category `C`, there is a canonical isomorphism `P ⊞ P.complement ≅ (to_karoubi C).obj P.X` in the category @@ -42,7 +44,7 @@ namespace biproducts /-- The `bicone` used in order to obtain the existence of the biproduct of a functor `J ⥤ karoubi C` when the category `C` is additive. -/ @[simps] -def bicone [has_finite_biproducts C] {J : Type v} [decidable_eq J] [fintype J] +def bicone [has_finite_biproducts C] {J : Type} [fintype J] (F : J → karoubi C) : bicone F := { X := { X := biproduct (λ j, (F j).X), @@ -63,27 +65,26 @@ def bicone [has_finite_biproducts C] {J : Type v} [decidable_eq J] [fintype J] ι_π := λ j j', begin split_ifs, { subst h, - simp only [biproduct.bicone_ι, biproduct.ι_map, biproduct.bicone_π, - biproduct.ι_π_self_assoc, comp, category.assoc, eq_to_hom_refl, id_eq, - biproduct.map_π, (F j).idem], }, - { simpa only [hom_ext, biproduct.ι_π_ne_assoc _ h, assoc, - biproduct.map_π, biproduct.map_π_assoc, zero_comp, comp], }, + simp only [assoc, idem, biproduct.map_π, biproduct.map_π_assoc, eq_to_hom_refl, + id_eq, hom_ext, comp_f, biproduct.ι_π_self_assoc], }, + { simp only [biproduct.ι_π_ne_assoc _ h, assoc, biproduct.map_π, + biproduct.map_π_assoc, hom_ext, comp_f, zero_comp, quiver.hom.add_comm_group_zero_f], }, end, } end biproducts lemma karoubi_has_finite_biproducts [has_finite_biproducts C] : has_finite_biproducts (karoubi C) := -{ has_biproducts_of_shape := λ J hJ₁ hJ₂, +{ out := λ n, { has_biproduct := λ F, begin - letI := hJ₂, + classical, apply has_biproduct_of_total (biproducts.bicone F), ext1, ext1, simp only [id_eq, comp_id, biproducts.bicone_X_p, biproduct.ι_map], rw [sum_hom, comp_sum, finset.sum_eq_single j], rotate, { intros j' h1 h2, simp only [biproduct.ι_map, biproducts.bicone_ι_f, biproducts.bicone_π_f, - assoc, comp, biproduct.map_π], + assoc, comp_f, biproduct.map_π], slice_lhs 1 2 { rw biproduct.ι_π, }, split_ifs, { exfalso, exact h2 h.symm, }, @@ -91,16 +92,14 @@ lemma karoubi_has_finite_biproducts [has_finite_biproducts C] : { intro h, exfalso, simpa only [finset.mem_univ, not_true] using h, }, - { simp only [biproducts.bicone_π_f, comp, + { simp only [biproducts.bicone_π_f, comp_f, biproduct.ι_map, assoc, biproducts.bicone_ι_f, biproduct.map_π], slice_lhs 1 2 { rw biproduct.ι_π, }, split_ifs, swap, { exfalso, exact h rfl, }, simp only [eq_to_hom_refl, id_comp, (F j).idem], }, end, } } -instance {D : Type*} [category D] [additive_category D] : additive_category (karoubi D) := -{ to_preadditive := infer_instance, - to_has_finite_biproducts := karoubi_has_finite_biproducts } +attribute [instance] karoubi_has_finite_biproducts /-- `P.complement` is the formal direct factor of `P.X` given by the idempotent endomorphism `𝟙 P.X - P.p` -/ @@ -119,12 +118,12 @@ has_binary_biproduct_of_total inr := P.complement.decomp_id_i, inl_fst' := P.decomp_id.symm, inl_snd' := begin - simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp, + simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp_f, hom_ext, quiver.hom.add_comm_group_zero_f, P.idem], erw [comp_id, sub_self], end, inr_fst' := begin - simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp, + simp only [decomp_id_i_f, complement_p, decomp_id_p_f, sub_comp, comp_f, hom_ext, quiver.hom.add_comm_group_zero_f, P.idem], erw [id_comp, sub_self], end, @@ -144,14 +143,14 @@ def decomposition (P : karoubi C) : P ⊞ P.complement ≅ (to_karoubi _).obj P. ← decomp_id, id_comp, add_right_eq_self], convert zero_comp, ext, - simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp, + simp only [decomp_id_i_f, decomp_id_p_f, complement_p, comp_sub, comp_f, quiver.hom.add_comm_group_zero_f, P.idem], erw [comp_id, sub_self], }, { simp only [← assoc, biprod.inr_desc, biprod.lift_eq, comp_add, ← decomp_id, comp_id, id_comp, add_left_eq_self], convert zero_comp, ext, - simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp, + simp only [decomp_id_i_f, decomp_id_p_f, complement_p, sub_comp, comp_f, quiver.hom.add_comm_group_zero_f, P.idem], erw [id_comp, sub_self], } end, diff --git a/src/category_theory/idempotents/functor_categories.lean b/src/category_theory/idempotents/functor_categories.lean index 910bdec18751e..3df7fa5b83120 100644 --- a/src/category_theory/idempotents/functor_categories.lean +++ b/src/category_theory/idempotents/functor_categories.lean @@ -9,6 +9,9 @@ import category_theory.idempotents.karoubi /-! # Idempotent completeness and functor categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define an instance `functor_category_is_idempotent_complete` expressing that a functor category `J ⥤ C` is idempotent complete when the target category `C` is. @@ -27,7 +30,24 @@ namespace category_theory namespace idempotents -variables (J C : Type*) [category J] [category C] +variables {J C : Type*} [category J] [category C] (P Q : karoubi (J ⥤ C)) (f : P ⟶ Q) (X : J) + +@[simp, reassoc] +lemma app_idem : + P.p.app X ≫ P.p.app X = P.p.app X := congr_app P.idem X + +variables {P Q} + +@[simp, reassoc] +lemma app_p_comp : P.p.app X ≫ f.f.app X = f.f.app X := congr_app (p_comp f) X + +@[simp, reassoc] +lemma app_comp_p : f.f.app X ≫ Q.p.app X = f.f.app X := congr_app (comp_p f) X + +@[reassoc] +lemma app_p_comm : P.p.app X ≫ f.f.app X = f.f.app X ≫ Q.p.app X := congr_app (p_comm f) X + +variables (J C) instance functor_category_is_idempotent_complete [is_idempotent_complete C] : is_idempotent_complete (J ⥤ C) := @@ -81,32 +101,12 @@ def obj (P : karoubi (J ⥤ C)) : J ⥤ karoubi C := have h := congr_app P.idem j, rw [nat_trans.comp_app] at h, slice_rhs 1 3 { erw [h, h], }, - end }, - map_id' := λ j, by { ext, simp only [functor.map_id, comp_id, id_eq], }, - map_comp' := λ j j' j'' φ φ', begin - ext, - have h := congr_app P.idem j, - rw [nat_trans.comp_app] at h, - simp only [assoc, nat_trans.naturality_assoc, functor.map_comp, comp], - slice_rhs 1 2 { rw h, }, - rw [assoc], - end } + end }, } /-- Tautological action on maps of the functor `karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C)`. -/ @[simps] def map {P Q : karoubi (J ⥤ C)} (f : P ⟶ Q) : obj P ⟶ obj Q := -{ app := λ j, ⟨f.f.app j, congr_app f.comm j⟩, - naturality' := λ j j' φ, begin - ext, - simp only [comp], - have h := congr_app (comp_p f) j, - have h' := congr_app (p_comp f) j', - dsimp at h h' ⊢, - slice_rhs 1 2 { erw h, }, - rw ← P.p.naturality, - slice_lhs 2 3 { erw h', }, - rw f.f.naturality, - end } +{ app := λ j, ⟨f.f.app j, congr_app f.comm j⟩, } end karoubi_functor_category_embedding @@ -117,20 +117,18 @@ variables (J C) def karoubi_functor_category_embedding : karoubi (J ⥤ C) ⥤ (J ⥤ karoubi C) := { obj := karoubi_functor_category_embedding.obj, - map := λ P Q, karoubi_functor_category_embedding.map, - map_id' := λ P, rfl, - map_comp' := λ P Q R f g, rfl, } + map := λ P Q, karoubi_functor_category_embedding.map, } instance : full (karoubi_functor_category_embedding J C) := { preimage := λ P Q f, { f := { app := λ j, (f.app j).f, naturality' := λ j j' φ, begin - slice_rhs 1 1 { rw ← karoubi.comp_p, }, + rw ← karoubi.comp_p_assoc, have h := hom_ext.mp (f.naturality φ), - simp only [comp] at h, - dsimp [karoubi_functor_category_embedding] at h ⊢, - erw [assoc, ← h, ← P.p.naturality φ, assoc, p_comp (f.app j')], + simp only [comp_f] at h, + dsimp [karoubi_functor_category_embedding] at h, + erw [← h, assoc, ← P.p.naturality_assoc φ, p_comp (f.app j')], end }, comm := by { ext j, exact (f.app j).comm, } }, witness' := λ P Q f, by { ext j, refl, }, } diff --git a/src/category_theory/idempotents/functor_extension.lean b/src/category_theory/idempotents/functor_extension.lean new file mode 100644 index 0000000000000..0307fbd5ed354 --- /dev/null +++ b/src/category_theory/idempotents/functor_extension.lean @@ -0,0 +1,279 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.idempotents.karoubi + +/-! +# Extension of functors to the idempotent completion + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we construct an extension `functor_extension₁` +of functors `C ⥤ karoubi D` to functors `karoubi C ⥤ karoubi D`. This results in an +equivalence `karoubi_universal₁ C D : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. + +We also construct an extension `functor_extension₂` of functors +`(C ⥤ D) ⥤ (karoubi C ⥤ karoubi D)`. Moreover, +when `D` is idempotent complete, we get equivalences +`karoubi_universal₂ C D : C ⥤ D ≌ karoubi C ⥤ karoubi D` +and `karoubi_universal C D : C ⥤ D ≌ karoubi C ⥤ D`. + +We occasionally state and use equalities of functors because it is +sometimes convenient to use rewrites when proving properties of +functors obtained using the constructions in this file. Users are +encouraged to use the corresponding natural isomorphism +whenever possible. + +-/ + +open category_theory.category +open category_theory.idempotents.karoubi + +namespace category_theory + +namespace idempotents + +variables {C D E : Type*} [category C] [category D] [category E] + +/-- A natural transformation between functors `karoubi C ⥤ D` is determined +by its value on objects coming from `C`. -/ +lemma nat_trans_eq {F G : karoubi C ⥤ D} (φ : F ⟶ G) (P : karoubi C) : + φ.app P = F.map (decomp_id_i P) ≫ φ.app P.X ≫ G.map (decomp_id_p P) := +begin + rw [← φ.naturality, ← assoc, ← F.map_comp], + conv { to_lhs, rw [← id_comp (φ.app P), ← F.map_id], }, + congr, + apply decomp_id, +end + +namespace functor_extension₁ + +/-- The canonical extension of a functor `C ⥤ karoubi D` to a functor +`karoubi C ⥤ karoubi D` -/ +@[simps] +def obj (F : C ⥤ karoubi D) : karoubi C ⥤ karoubi D := +{ obj := λ P, ⟨(F.obj P.X).X, (F.map P.p).f, + by simpa only [F.map_comp, hom_ext] using F.congr_map P.idem⟩, + map := λ P Q f, ⟨(F.map f.f).f, + by simpa only [F.map_comp, hom_ext] using F.congr_map f.comm⟩, } + +/-- Extension of a natural transformation `φ` between functors +`C ⥤ karoubi D` to a natural transformation between the +extension of these functors to `karoubi C ⥤ karoubi D` -/ +@[simps] +def map {F G : C ⥤ karoubi D} (φ : F ⟶ G) : obj F ⟶ obj G := +{ app := λ P, + { f := (F.map P.p).f ≫ (φ.app P.X).f, + comm := begin + have h := φ.naturality P.p, + have h' := F.congr_map P.idem, + simp only [hom_ext, karoubi.comp_f, F.map_comp] at h h', + simp only [obj_obj_p, assoc, ← h], + slice_rhs 1 3 { rw [h', h'], }, + end, }, + naturality' := λ P Q f, begin + ext, + dsimp [obj], + have h := φ.naturality f.f, + have h' := F.congr_map (comp_p f), + have h'' := F.congr_map (p_comp f), + simp only [hom_ext, functor.map_comp, comp_f] at ⊢ h h' h'', + slice_rhs 2 3 { rw ← h, }, + slice_lhs 1 2 { rw h', }, + slice_rhs 1 2 { rw h'', }, + end } + +end functor_extension₁ + +variables (C D E) + +/-- The canonical functor `(C ⥤ karoubi D) ⥤ (karoubi C ⥤ karoubi D)` -/ +@[simps] +def functor_extension₁ : (C ⥤ karoubi D) ⥤ (karoubi C ⥤ karoubi D) := +{ obj := functor_extension₁.obj, + map := λ F G, functor_extension₁.map, + map_id' := λ F, by { ext P, exact comp_p (F.map P.p), }, + map_comp' := λ F G H φ φ', begin + ext P, + simp only [comp_f, functor_extension₁.map_app_f, nat_trans.comp_app, assoc], + have h := φ.naturality P.p, + have h' := F.congr_map P.idem, + simp only [hom_ext, comp_f, F.map_comp] at h h', + slice_rhs 2 3 { rw ← h, }, + slice_rhs 1 2 { rw h', }, + simp only [assoc], + end, } + +lemma functor_extension₁_comp_whiskering_left_to_karoubi : + functor_extension₁ C D ⋙ + (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) = 𝟭 _ := +begin + refine functor.ext _ _, + { intro F, + refine functor.ext _ _, + { intro X, + ext, + { dsimp, + rw [id_comp, comp_id, F.map_id, id_eq], }, + { refl, }, }, + { intros X Y f, + ext, + dsimp, + simp only [comp_id, eq_to_hom_f, eq_to_hom_refl, comp_p, functor_extension₁.obj_obj_p, + to_karoubi_obj_p, comp_f], + dsimp, + simp only [functor.map_id, id_eq, p_comp], }, }, + { intros F G φ, + ext X, + dsimp, + simp only [eq_to_hom_app, F.map_id, comp_f, eq_to_hom_f, id_eq, p_comp, + eq_to_hom_refl, comp_id, comp_p, functor_extension₁.obj_obj_p, + to_karoubi_obj_p, F.map_id X], }, +end + +/-- The natural isomorphism expressing that functors `karoubi C ⥤ karoubi D` obtained +using `functor_extension₁` actually extends the original functors `C ⥤ karoubi D`. -/ +@[simps] +def functor_extension₁_comp_whiskering_left_to_karoubi_iso : + functor_extension₁ C D ⋙ + (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ≅ 𝟭 _ := +eq_to_iso (functor_extension₁_comp_whiskering_left_to_karoubi C D) + +/-- The counit isomorphism of the equivalence `(C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. -/ +@[simps] +def karoubi_universal₁.counit_iso : + (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ⋙ + functor_extension₁ C D ≅ 𝟭 _ := +nat_iso.of_components (λ G, + { hom := + { app := λ P, + { f := (G.map (decomp_id_p P)).f, + comm := by simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map + (show P.decomp_id_p = (to_karoubi C).map P.p ≫ P.decomp_id_p ≫ 𝟙 _, by simp), }, + naturality' := λ P Q f, + by simpa only [hom_ext, G.map_comp] using (G.congr_map (decomp_id_p_naturality f)).symm, }, + inv := + { app := λ P, + { f := (G.map (decomp_id_i P)).f, + comm := by simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map + (show P.decomp_id_i = 𝟙 _ ≫ P.decomp_id_i ≫ (to_karoubi C).map P.p, by simp), }, + naturality' := λ P Q f, + by simpa only [hom_ext, G.map_comp] using G.congr_map (decomp_id_i_naturality f), }, + hom_inv_id' := begin + ext P, + simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_p.symm, + end, + inv_hom_id' := begin + ext P, + simpa only [hom_ext, G.map_comp, G.map_id] using G.congr_map P.decomp_id.symm, + end, }) +(λ G₁ G₂ φ, begin + ext P, + dsimp, + simpa only [nat_trans_eq φ P, comp_f, functor_extension₁.map_app_f, + functor.comp_map, whisker_left_app, assoc, P.decomp_p, G₁.map_comp], +end) + +/-- The equivalence of categories `(C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D)`. -/ +@[simps] +def karoubi_universal₁ : (C ⥤ karoubi D) ≌ (karoubi C ⥤ karoubi D) := +{ functor := functor_extension₁ C D, + inverse := (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C), + unit_iso := (functor_extension₁_comp_whiskering_left_to_karoubi_iso C D).symm, + counit_iso := karoubi_universal₁.counit_iso C D, + functor_unit_iso_comp' := λ F, begin + ext P, + dsimp [functor_extension₁.map, karoubi_universal₁.counit_iso], + simpa only [comp_f, eq_to_hom_app, eq_to_hom_f, eq_to_hom_refl, comp_id, + hom_ext, F.map_comp, comp_p] using F.congr_map P.idem, + end, } + +lemma functor_extension₁_comp (F : C ⥤ karoubi D) (G : D ⥤ karoubi E) : + (functor_extension₁ C E).obj (F ⋙ (functor_extension₁ D E).obj G) = + (functor_extension₁ C D).obj F ⋙ (functor_extension₁ D E).obj G := +functor.ext (by tidy) (λ X Y f, by { dsimp, simpa only [id_comp, comp_id], }) + +/-- The canonical functor `(C ⥤ D) ⥤ (karoubi C ⥤ karoubi D)` -/ +@[simps] +def functor_extension₂ : (C ⥤ D) ⥤ (karoubi C ⥤ karoubi D) := +(whiskering_right C D (karoubi D)).obj (to_karoubi D) ⋙ functor_extension₁ C D + +lemma functor_extension₂_comp_whiskering_left_to_karoubi : + functor_extension₂ C D ⋙ (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) = + (whiskering_right C D (karoubi D)).obj (to_karoubi D) := +by simp only [functor_extension₂, functor.assoc, + functor_extension₁_comp_whiskering_left_to_karoubi, functor.comp_id] + +/-- The natural isomorphism expressing that functors `karoubi C ⥤ karoubi D` obtained +using `functor_extension₂` actually extends the original functors `C ⥤ D`. -/ +@[simps] +def functor_extension₂_comp_whiskering_left_to_karoubi_iso : + functor_extension₂ C D ⋙ (whiskering_left C (karoubi C) (karoubi D)).obj (to_karoubi C) ≅ + (whiskering_right C D (karoubi D)).obj (to_karoubi D) := +eq_to_iso (functor_extension₂_comp_whiskering_left_to_karoubi C D) + +section is_idempotent_complete + +variable [is_idempotent_complete D] + +noncomputable instance : is_equivalence (to_karoubi D) := to_karoubi_is_equivalence D + +/-- The equivalence of categories `(C ⥤ D) ≌ (karoubi C ⥤ karoubi D)` when `D` +is idempotent complete. -/ +@[simps] +noncomputable def karoubi_universal₂ : (C ⥤ D) ≌ (karoubi C ⥤ karoubi D) := +(equivalence.congr_right (to_karoubi D).as_equivalence).trans + (karoubi_universal₁ C D) + +lemma karoubi_universal₂_functor_eq : + (karoubi_universal₂ C D).functor = functor_extension₂ C D := rfl + +noncomputable instance : is_equivalence (functor_extension₂ C D) := +by { rw ← karoubi_universal₂_functor_eq, apply_instance, } + +/-- The extension of functors functor `(C ⥤ D) ⥤ (karoubi C ⥤ D)` +when `D` is idempotent compltete. -/ +@[simps] +noncomputable def functor_extension : (C ⥤ D) ⥤ (karoubi C ⥤ D) := +functor_extension₂ C D ⋙ (whiskering_right (karoubi C) (karoubi D) D).obj + (to_karoubi_is_equivalence D).inverse + +/-- The equivalence `(C ⥤ D) ≌ (karoubi C ⥤ D)` when `D` is idempotent complete. -/ +@[simps] +noncomputable def karoubi_universal : (C ⥤ D) ≌ (karoubi C ⥤ D) := +(karoubi_universal₂ C D).trans (equivalence.congr_right (to_karoubi D).as_equivalence.symm) + +lemma karoubi_universal_functor_eq : + (karoubi_universal C D).functor = functor_extension C D := rfl + +noncomputable instance : is_equivalence (functor_extension C D) := +by { rw ← karoubi_universal_functor_eq, apply_instance, } + +noncomputable instance : is_equivalence ((whiskering_left C (karoubi C) D).obj (to_karoubi C)) := +is_equivalence.cancel_comp_right _ ((whiskering_right C _ _).obj (to_karoubi D) ⋙ + (whiskering_right C _ _).obj (to_karoubi D).inv) + (is_equivalence.of_equivalence (@equivalence.congr_right _ _ _ _ C _ + ((to_karoubi D).as_equivalence.trans (to_karoubi D).as_equivalence.symm))) + (by { change is_equivalence (karoubi_universal C D).inverse, apply_instance, }) + +variables {C D} + +lemma whiskering_left_obj_preimage_app {F G : karoubi C ⥤ D} + (τ : to_karoubi _ ⋙ F ⟶ to_karoubi _ ⋙ G) (P : karoubi C) : + (((whiskering_left _ _ _).obj (to_karoubi _)).preimage τ).app P = + F.map P.decomp_id_i ≫ τ.app P.X ≫ G.map P.decomp_id_p := +begin + rw nat_trans_eq, + congr' 2, + exact congr_app (((whiskering_left _ _ _).obj (to_karoubi _)).image_preimage τ) P.X, +end + +end is_idempotent_complete + +end idempotents + +end category_theory diff --git a/src/category_theory/idempotents/homological_complex.lean b/src/category_theory/idempotents/homological_complex.lean new file mode 100644 index 0000000000000..bbfffb7bf85ca --- /dev/null +++ b/src/category_theory/idempotents/homological_complex.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import algebra.homology.additive +import category_theory.idempotents.karoubi + +/-! +# Idempotent completeness and homological complexes + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains simplifications lemmas for categories +`karoubi (homological_complex C c)` and the construction of an equivalence +of categories `karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. + +When the category `C` is idempotent complete, it is shown that +`homological_complex (karoubi C) c` is also idempotent complete. + +-/ + +namespace category_theory + +open category + +variables {C : Type*} [category C] [preadditive C] {ι : Type*} {c : complex_shape ι} + +namespace idempotents + +namespace karoubi + +namespace homological_complex + +variables {P Q : karoubi (homological_complex C c)} (f : P ⟶ Q) (n : ι) + +@[simp, reassoc] +lemma p_comp_d : P.p.f n ≫ f.f.f n = f.f.f n := +homological_complex.congr_hom (p_comp f) n + +@[simp, reassoc] +lemma comp_p_d : f.f.f n ≫ Q.p.f n = f.f.f n := +homological_complex.congr_hom (comp_p f) n + +@[reassoc] +lemma p_comm_f : P.p.f n ≫ f.f.f n = f.f.f n ≫ Q.p.f n := +homological_complex.congr_hom (p_comm f) n + +variable (P) + +@[simp, reassoc] +lemma p_idem : P.p.f n ≫ P.p.f n = P.p.f n := +homological_complex.congr_hom P.idem n + +end homological_complex + +end karoubi + +open karoubi + +namespace karoubi_homological_complex_equivalence + +namespace functor + +/-- The functor `karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c`, +on objects. -/ +@[simps] +def obj (P : karoubi (homological_complex C c)) : homological_complex (karoubi C) c := +{ X := λ n, ⟨P.X.X n, P.p.f n, by simpa only [homological_complex.comp_f] + using homological_complex.congr_hom P.idem n⟩, + d := λ i j, + { f := P.p.f i ≫ P.X.d i j, + comm := by tidy, }, + shape' := λ i j hij, by simp only [hom_eq_zero_iff, + P.X.shape i j hij, limits.comp_zero], } + +/-- The functor `karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c`, +on morphisms. -/ +@[simps] +def map {P Q : karoubi (homological_complex C c)} (f : P ⟶ Q) : obj P ⟶ obj Q := +{ f:= λ n, + { f:= f.f.f n, + comm := by simp, }, } + +end functor + +/-- The functor `karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c`. -/ +@[simps] +def functor : karoubi (homological_complex C c) ⥤ homological_complex (karoubi C) c := +{ obj := functor.obj, + map := λ P Q f, functor.map f, } + +namespace inverse + +/-- The functor `homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c)`, +on objects -/ +@[simps] +def obj (K : homological_complex (karoubi C) c) : karoubi (homological_complex C c) := +{ X := + { X := λ n, (K.X n).X, + d := λ i j, (K.d i j).f, + shape' := λ i j hij, hom_eq_zero_iff.mp (K.shape i j hij), + d_comp_d' := λ i j k hij hjk, by { simpa only [comp_f] + using hom_eq_zero_iff.mp (K.d_comp_d i j k), }, }, + p := + { f := λ n, (K.X n).p, + comm' := by simp, }, + idem := by tidy, } + +/-- The functor `homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c)`, +on morphisms -/ +@[simps] +def map {K L : homological_complex (karoubi C) c} (f : K ⟶ L) : obj K ⟶ obj L := +{ f:= + { f := λ n, (f.f n).f, + comm' := λ i j hij, by simpa only [comp_f] + using hom_ext.mp (f.comm' i j hij), }, + comm := by tidy, } + +end inverse + +/-- The functor `homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c)`. -/ +@[simps] +def inverse : + homological_complex (karoubi C) c ⥤ karoubi (homological_complex C c) := +{ obj := inverse.obj, + map := λ K L f, inverse.map f, } + + +/-- The counit isomorphism of the equivalence +`karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. -/ +@[simps] +def counit_iso : inverse ⋙ functor ≅ 𝟭 (homological_complex (karoubi C) c) := +eq_to_iso (functor.ext (λ P, homological_complex.ext (by tidy) (by tidy)) (by tidy)) + +/-- The unit isomorphism of the equivalence +`karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. -/ +@[simps] +def unit_iso : 𝟭 (karoubi (homological_complex C c)) ≅ functor ⋙ inverse := +{ hom := + { app := λ P, + { f := + { f := λ n, P.p.f n, + comm' := λ i j hij, begin + dsimp, + simp only [homological_complex.hom.comm, homological_complex.hom.comm_assoc, + homological_complex.p_idem], + end }, + comm := by { ext n, dsimp, simp only [homological_complex.p_idem], }, }, + naturality' := λ P Q φ, begin + ext, + dsimp, + simp only [comp_f, homological_complex.comp_f, homological_complex.comp_p_d, + inverse.map_f_f, functor.map_f_f, homological_complex.p_comp_d], + end, }, + inv := + { app := λ P, + { f := + { f := λ n, P.p.f n, + comm' := λ i j hij, begin + dsimp, + simp only [homological_complex.hom.comm, assoc, homological_complex.p_idem], + end }, + comm := by { ext n, dsimp, simp only [homological_complex.p_idem], }, }, + naturality' := λ P Q φ, begin + ext, + dsimp, + simp only [comp_f, homological_complex.comp_f, inverse.map_f_f, functor.map_f_f, + homological_complex.comp_p_d, homological_complex.p_comp_d], + end, }, + hom_inv_id' := begin + ext, + dsimp, + simp only [homological_complex.p_idem, comp_f, homological_complex.comp_f, id_eq], + end, + inv_hom_id' := begin + ext, + dsimp, + simp only [homological_complex.p_idem, comp_f, homological_complex.comp_f, id_eq, + inverse.obj_p_f, functor.obj_X_p], + end, } + +end karoubi_homological_complex_equivalence + +variables (C) (c) + +/-- The equivalence `karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c`. -/ +@[simps] +def karoubi_homological_complex_equivalence : + karoubi (homological_complex C c) ≌ homological_complex (karoubi C) c := +{ functor := karoubi_homological_complex_equivalence.functor, + inverse := karoubi_homological_complex_equivalence.inverse, + unit_iso := karoubi_homological_complex_equivalence.unit_iso, + counit_iso := karoubi_homological_complex_equivalence.counit_iso, } + +variables (α : Type*) [add_right_cancel_semigroup α] [has_one α] + +/-- The equivalence `karoubi (chain_complex C α) ≌ chain_complex (karoubi C) α`. -/ +@[simps] +def karoubi_chain_complex_equivalence : + karoubi (chain_complex C α) ≌ chain_complex (karoubi C) α := +karoubi_homological_complex_equivalence C (complex_shape.down α) + +/-- The equivalence `karoubi (cochain_complex C α) ≌ cochain_complex (karoubi C) α`. -/ +@[simps] +def karoubi_cochain_complex_equivalence : + karoubi (cochain_complex C α) ≌ cochain_complex (karoubi C) α := +karoubi_homological_complex_equivalence C (complex_shape.up α) + +instance [is_idempotent_complete C] : is_idempotent_complete (homological_complex C c) := +begin + rw [is_idempotent_complete_iff_of_equivalence + ((to_karoubi_equivalence C).map_homological_complex c), + ← is_idempotent_complete_iff_of_equivalence (karoubi_homological_complex_equivalence C c)], + apply_instance, +end + +end idempotents + +end category_theory diff --git a/src/category_theory/idempotents/karoubi.lean b/src/category_theory/idempotents/karoubi.lean index 40f9de580a7cc..7913e1a3cc043 100644 --- a/src/category_theory/idempotents/karoubi.lean +++ b/src/category_theory/idempotents/karoubi.lean @@ -11,6 +11,9 @@ import category_theory.equivalence /-! # The Karoubi envelope of a category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define the Karoubi envelope `karoubi C` of a category `C`. ## Main constructions and definitions @@ -41,13 +44,15 @@ obvious idempotent `X ⟶ P ⟶ X` which is the projection onto `P` with kernel one may define a formal direct factor of an object `X : C` : it consists of an idempotent `p : X ⟶ X` which is thought as the "formal image" of `p`. The type `karoubi C` shall be the type of the objects of the karoubi enveloppe of `C`. It makes sense for any category `C`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure karoubi := (X : C) (p : X ⟶ X) (idem : p ≫ p = p) namespace karoubi variables {C} +attribute [simp, reassoc] idem + @[ext] lemma ext {P Q : karoubi C} (h_X : P.X = Q.X) (h_p : P.p ≫ eq_to_hom h_X = eq_to_hom h_X ≫ Q.p) : P = Q := @@ -100,8 +105,8 @@ instance : category (karoubi C) := comp := λ P Q R f g, ⟨f.f ≫ g.f, karoubi.comp_proof g f⟩, } @[simp] -lemma comp {P Q R : karoubi C} (f : P ⟶ Q) (g : Q ⟶ R) : - f ≫ g = ⟨f.f ≫ g.f, comp_proof g f⟩ := by refl +lemma comp_f {P Q R : karoubi C} (f : P ⟶ Q) (g : Q ⟶ R) : + (f ≫ g).f = f.f ≫ g.f := by refl @[simp] lemma id_eq {P : karoubi C} : 𝟙 P = ⟨P.p, by repeat { rw P.idem, }⟩ := by refl @@ -172,11 +177,7 @@ end karoubi /-- The category `karoubi C` is preadditive if `C` is. -/ instance [preadditive C] : preadditive (karoubi C) := -{ hom_group := λ P Q, by apply_instance, - add_comp' := λ P Q R f g h, - by { ext, simp only [add_comp, quiver.hom.add_comm_group_add_f, karoubi.comp], }, - comp_add' := λ P Q R f g h, - by { ext, simp only [comp_add, quiver.hom.add_comm_group_add_f, karoubi.comp], }, } +{ hom_group := λ P Q, by apply_instance, } instance [preadditive C] : functor.additive (to_karoubi C) := { } @@ -189,7 +190,7 @@ begin refine ⟨_⟩, intros P p hp, have hp' := hom_ext.mp hp, - simp only [comp] at hp', + simp only [comp_f] at hp', use ⟨P.X, p.f, hp'⟩, use ⟨p.f, by rw [comp_p p, hp']⟩, use ⟨p.f, by rw [hp', p_comp p]⟩, @@ -211,6 +212,14 @@ def to_karoubi_is_equivalence [is_idempotent_complete C] : is_equivalence (to_karoubi C) := equivalence.of_fully_faithfully_ess_surj (to_karoubi C) +/-- The equivalence `C ≅ karoubi C` when `C` is idempotent complete. -/ +def to_karoubi_equivalence [is_idempotent_complete C] : C ≌ karoubi C := +by { haveI := to_karoubi_is_equivalence C, exact functor.as_equivalence (to_karoubi C), } + +instance to_karoubi_equivalence_functor_additive + [preadditive C] [is_idempotent_complete C] : + (to_karoubi_equivalence C).functor.additive := (infer_instance : (to_karoubi C).additive) + namespace karoubi variables {C} @@ -228,11 +237,11 @@ def decomp_id_p (P : karoubi C) : (P.X : karoubi C) ⟶ P := is actually a direct factor in the category `karoubi C`. -/ lemma decomp_id (P : karoubi C) : 𝟙 P = (decomp_id_i P) ≫ (decomp_id_p P) := -by { ext, simp only [comp, id_eq, P.idem, decomp_id_i, decomp_id_p], } +by { ext, simp only [comp_f, id_eq, P.idem, decomp_id_i, decomp_id_p], } lemma decomp_p (P : karoubi C) : (to_karoubi C).map P.p = (decomp_id_p P) ≫ (decomp_id_i P) := -by { ext, simp only [comp, decomp_id_p_f, decomp_id_i_f, P.idem, to_karoubi_map_f], } +by { ext, simp only [comp_f, decomp_id_p_f, decomp_id_i_f, P.idem, to_karoubi_map_f], } lemma decomp_id_i_to_karoubi (X : C) : decomp_id_i ((to_karoubi C).obj X) = 𝟙 _ := by { ext, refl, } @@ -242,11 +251,16 @@ by { ext, refl, } lemma decomp_id_i_naturality {P Q : karoubi C} (f : P ⟶ Q) : f ≫ decomp_id_i _ = decomp_id_i _ ≫ ⟨f.f, by erw [comp_id, id_comp]⟩ := -by { ext, simp only [comp, decomp_id_i_f, karoubi.comp_p, karoubi.p_comp], } +by { ext, simp only [comp_f, decomp_id_i_f, karoubi.comp_p, karoubi.p_comp], } lemma decomp_id_p_naturality {P Q : karoubi C} (f : P ⟶ Q) : decomp_id_p P ≫ f = (⟨f.f, by erw [comp_id, id_comp]⟩ : (P.X : karoubi C) ⟶ Q.X) ≫ decomp_id_p Q := -by { ext, simp only [comp, decomp_id_p_f, karoubi.comp_p, karoubi.p_comp], } +by { ext, simp only [comp_f, decomp_id_p_f, karoubi.comp_p, karoubi.p_comp], } + +@[simp] +lemma zsmul_hom [preadditive C] {P Q : karoubi C} (n : ℤ) (f : P ⟶ Q) : + (n • f).f = n • f.f := +map_zsmul (inclusion_hom P Q) n f end karoubi diff --git a/src/category_theory/idempotents/karoubi_karoubi.lean b/src/category_theory/idempotents/karoubi_karoubi.lean index 983eb2ac4b9e7..f2afef9d26a62 100644 --- a/src/category_theory/idempotents/karoubi_karoubi.lean +++ b/src/category_theory/idempotents/karoubi_karoubi.lean @@ -9,6 +9,9 @@ import category_theory.idempotents.karoubi /-! # Idempotence of the Karoubi envelope +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we construct the equivalence of categories `karoubi_karoubi.equivalence C : karoubi C ≌ karoubi (karoubi C)` for any category `C`. @@ -35,19 +38,8 @@ instance [preadditive C] : functor.additive (inverse C) := { } /-- The unit isomorphism of the equivalence -/ @[simps] -def unit_iso : 𝟭 (karoubi C) ≅ to_karoubi (karoubi C) ⋙ inverse C := eq_to_iso begin - apply functor.ext, - { intros P Q f, - ext, - simp only [functor.id_map, inverse_map_f, to_karoubi_map_f, eq_to_hom_f, - eq_to_hom_refl, comp_id, p_comp_assoc, functor.comp_map, comp], - dsimp, - simp only [id_eq, comp_p], }, - { intro P, - ext, - { simpa only [eq_to_hom_refl, comp_id, id_comp], }, - { refl, }, } -end +def unit_iso : 𝟭 (karoubi C) ≅ to_karoubi (karoubi C) ⋙ inverse C := +eq_to_iso (functor.ext (by tidy) (by tidy)) /-- The counit isomorphism of the equivalence -/ @[simps] @@ -58,12 +50,12 @@ def counit_iso : inverse C ⋙ to_karoubi (karoubi C) ≅ 𝟭 (karoubi (karoubi { f := P.p.1, comm := begin have h := P.idem, - simp only [hom_ext, comp] at h, + simp only [hom_ext, comp_f] at h, erw [← assoc, h, comp_p], end, }, comm := begin have h := P.idem, - simp only [hom_ext, comp] at h ⊢, + simp only [hom_ext, comp_f] at h ⊢, erw [h, h], end, }, naturality' := λ P Q f, by simpa only [hom_ext] using (p_comm f).symm, }, @@ -73,15 +65,15 @@ def counit_iso : inverse C ⋙ to_karoubi (karoubi C) ≅ 𝟭 (karoubi (karoubi { f := P.p.1, comm := begin have h := P.idem, - simp only [hom_ext, comp] at h, + simp only [hom_ext, comp_f] at h, erw [h, p_comp], end, }, comm := begin have h := P.idem, - simp only [hom_ext, comp] at h ⊢, + simp only [hom_ext, comp_f] at h ⊢, erw [h, h], end, }, - naturality' := λ P Q f, by simpa [hom_ext] using (p_comm f).symm, }, + naturality' := λ P Q f, by simpa only [hom_ext] using (p_comm f).symm, }, hom_inv_id' := by { ext P, simpa only [hom_ext, id_eq] using P.idem, }, inv_hom_id' := by { ext P, simpa only [hom_ext, id_eq] using P.idem, }, } @@ -91,13 +83,7 @@ def equivalence : karoubi C ≌ karoubi (karoubi C) := { functor := to_karoubi (karoubi C), inverse := karoubi_karoubi.inverse C, unit_iso := karoubi_karoubi.unit_iso C, - counit_iso := karoubi_karoubi.counit_iso C, - functor_unit_iso_comp' := λ P, begin - ext, - simp only [eq_to_hom_f, eq_to_hom_refl, comp_id, counit_iso_hom_app_f_f, - to_karoubi_obj_p, id_eq, assoc, comp, unit_iso_hom, eq_to_hom_app, eq_to_hom_map], - erw [P.idem, P.idem], - end, } + counit_iso := karoubi_karoubi.counit_iso C, } instance equivalence.additive_functor [preadditive C] : functor.additive (equivalence C).functor := by { dsimp, apply_instance, } diff --git a/src/category_theory/idempotents/simplicial_object.lean b/src/category_theory/idempotents/simplicial_object.lean index 0432a50a0e2ab..cd18779b827ee 100644 --- a/src/category_theory/idempotents/simplicial_object.lean +++ b/src/category_theory/idempotents/simplicial_object.lean @@ -11,6 +11,9 @@ import category_theory.idempotents.functor_categories # Idempotent completeness of categories of simplicial objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we provide an instance expressing that `simplicial_object C` and `cosimplicial_object C` are idempotent complete categories when the category `C` is. diff --git a/src/category_theory/is_connected.lean b/src/category_theory/is_connected.lean index 72d75ff9dfad0..5c24658d6df57 100644 --- a/src/category_theory/is_connected.lean +++ b/src/category_theory/is_connected.lean @@ -1,15 +1,19 @@ /- Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bhavik Mehta +Authors: Bhavik Mehta, Jakob von Raumer -/ import data.list.chain import category_theory.punit import category_theory.groupoid +import category_theory.category.ulift /-! # Connected category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define a connected category as a _nonempty_ category for which every functor to a discrete category is isomorphic to the constant functor. @@ -91,7 +95,7 @@ The converse is given in `is_connected.of_any_functor_const_on_obj`. lemma any_functor_const_on_obj [is_preconnected J] {α : Type u₁} (F : J ⥤ discrete α) (j j' : J) : F.obj j = F.obj j' := -((iso_constant F j').hom.app j).down.1 +by { ext, exact ((iso_constant F j').hom.app j).down.1 } /-- If any functor to a discrete category is constant on objects, J is connected. @@ -113,7 +117,9 @@ The converse is shown in `is_connected.of_constant_of_preserves_morphisms` lemma constant_of_preserves_morphisms [is_preconnected J] {α : Type u₁} (F : J → α) (h : ∀ (j₁ j₂ : J) (f : j₁ ⟶ j₂), F j₁ = F j₂) (j j' : J) : F j = F j' := -any_functor_const_on_obj { obj := F, map := λ _ _ f, eq_to_hom (h _ _ f) } j j' +by simpa using any_functor_const_on_obj + { obj := discrete.mk ∘ F, + map := λ _ _ f, eq_to_hom (by { ext, exact (h _ _ f), }) } j j' /-- `J` is connected if: given any function `F : J → α` which is constant for any @@ -126,7 +132,8 @@ lemma is_connected.of_constant_of_preserves_morphisms [nonempty J] (h : ∀ {α : Type u₁} (F : J → α), (∀ {j₁ j₂ : J} (f : j₁ ⟶ j₂), F j₁ = F j₂) → (∀ j j' : J, F j = F j')) : is_connected J := -is_connected.of_any_functor_const_on_obj (λ _ F, h F.obj (λ _ _ f, (F.map f).down.1)) +is_connected.of_any_functor_const_on_obj + (λ _ F, h F.obj (λ _ _ f, by { ext, exact discrete.eq_of_hom (F.map f) })) /-- An inductive-like property for the objects of a connected category. @@ -161,6 +168,18 @@ begin rw [w j, w j'], end) +/-- Lifting the universe level of morphisms and objects preserves connectedness. -/ +instance [hc : is_connected J] : is_connected (ulift_hom.{v₂} (ulift.{u₂} J)) := +begin + haveI : nonempty (ulift_hom.{v₂} (ulift.{u₂} J)), { simp [ulift_hom, hc.is_nonempty] }, + apply is_connected.of_induct, + rintros p hj₀ h ⟨j⟩, + let p' : set J := ((λ (j : J), p {down := j}) : set J), + have hj₀' : (classical.choice hc.is_nonempty) ∈ p', { simp only [p'], exact hj₀ }, + apply induct_on_objects (λ (j : J), p {down := j}) hj₀' + (λ _ _ f, h ((ulift_hom_ulift_category.equiv J).functor.map f)) +end + /-- Another induction principle for `is_preconnected J`: given a type family `Z : J → Sort*` and @@ -197,12 +216,11 @@ lemma is_connected_of_equivalent {K : Type u₁} [category.{v₂} K] /-- If `J` is preconnected, then `Jᵒᵖ` is preconnected as well. -/ instance is_preconnected_op [is_preconnected J] : is_preconnected Jᵒᵖ := -{ iso_constant := λ α F X, ⟨ - nat_iso.of_components - (λ Y, (nonempty.some $ is_preconnected.iso_constant - (F.right_op ⋙ (discrete.opposite α).functor) (unop X)).app (unop Y)) - (λ Y Z f, subsingleton.elim _ _) - ⟩ } +{ iso_constant := λ α F X, ⟨nat_iso.of_components + (λ Y, eq_to_iso (discrete.ext _ _ (discrete.eq_of_hom ((nonempty.some + (is_preconnected.iso_constant (F.right_op ⋙ (discrete.opposite α).functor) (unop X))).app + (unop Y)).hom))) + (λ Y Z f, subsingleton.elim _ _)⟩ } /-- If `J` is connected, then `Jᵒᵖ` is connected as well. -/ instance is_connected_op [is_connected J] : is_connected Jᵒᵖ := @@ -315,7 +333,7 @@ end /-- If `discrete α` is connected, then `α` is (type-)equivalent to `punit`. -/ def discrete_is_connected_equiv_punit {α : Type u₁} [is_connected (discrete α)] : α ≃ punit := discrete.equiv_of_equivalence.{u₁ u₁} - { functor := functor.star α, + { functor := functor.star (discrete α), inverse := discrete.functor (λ _, classical.arbitrary _), unit_iso := by { exact (iso_constant _ (classical.arbitrary _)), }, counit_iso := functor.punit_ext _ _ } diff --git a/src/category_theory/isomorphism.lean b/src/category_theory/isomorphism.lean index 8d3cea33103aa..d319cb58c5762 100644 --- a/src/category_theory/isomorphism.lean +++ b/src/category_theory/isomorphism.lean @@ -3,11 +3,14 @@ Copyright (c) 2017 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn -/ -import category_theory.functor +import category_theory.functor.basic /-! # Isomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines isomorphisms between objects of a category. ## Main definitions @@ -89,6 +92,9 @@ by cases α; refl @[simp] lemma symm_eq_iff {X Y : C} {α β : X ≅ Y} : α.symm = β.symm ↔ α = β := ⟨λ h, symm_symm_eq α ▸ symm_symm_eq β ▸ congr_arg symm h, congr_arg symm⟩ +lemma nonempty_iso_symm (X Y : C) : nonempty (X ≅ Y) ↔ nonempty (Y ≅ X) := +⟨λ h, ⟨h.some.symm⟩, λ h, ⟨h.some.symm⟩⟩ + /-- Identity isomorphism. -/ @[refl, simps] def refl (X : C) : X ≅ X := { hom := 𝟙 X, @@ -154,6 +160,12 @@ by rw [←eq_inv_comp, comp_id] lemma comp_hom_eq_id (α : X ≅ Y) {f : Y ⟶ X} : f ≫ α.hom = 𝟙 Y ↔ f = α.inv := by rw [←eq_comp_inv, id_comp] +lemma inv_comp_eq_id (α : X ≅ Y) {f : X ⟶ Y} : α.inv ≫ f = 𝟙 Y ↔ f = α.hom := +hom_comp_eq_id α.symm + +lemma comp_inv_eq_id (α : X ≅ Y) {f : X ⟶ Y} : f ≫ α.inv = 𝟙 X ↔ f = α.hom := +comp_hom_eq_id α.symm + lemma hom_eq_inv (α : X ≅ Y) (β : Y ≅ X) : α.hom = β.inv ↔ β.hom = α.inv := by { erw [inv_eq_inv α.symm β, eq_comm], refl } @@ -301,18 +313,27 @@ lemma hom_comp_eq_id (g : X ⟶ Y) [is_iso g] {f : Y ⟶ X} : g ≫ f = 𝟙 X lemma comp_hom_eq_id (g : X ⟶ Y) [is_iso g] {f : Y ⟶ X} : f ≫ g = 𝟙 Y ↔ f = inv g := (as_iso g).comp_hom_eq_id +lemma inv_comp_eq_id (g : X ⟶ Y) [is_iso g] {f : X ⟶ Y} : inv g ≫ f = 𝟙 Y ↔ f = g := +(as_iso g).inv_comp_eq_id + +lemma comp_inv_eq_id (g : X ⟶ Y) [is_iso g] {f : X ⟶ Y} : f ≫ inv g = 𝟙 X ↔ f = g := +(as_iso g).comp_inv_eq_id + +lemma is_iso_of_hom_comp_eq_id (g : X ⟶ Y) [is_iso g] {f : Y ⟶ X} (h : g ≫ f = 𝟙 X) : is_iso f := +by { rw [(hom_comp_eq_id _).mp h], apply_instance } + +lemma is_iso_of_comp_hom_eq_id (g : X ⟶ Y) [is_iso g] {f : Y ⟶ X} (h : f ≫ g = 𝟙 Y) : is_iso f := +by { rw [(comp_hom_eq_id _).mp h], apply_instance } + namespace iso @[ext] lemma inv_ext {f : X ≅ Y} {g : Y ⟶ X} (hom_inv_id : f.hom ≫ g = 𝟙 X) : f.inv = g := -begin - apply (cancel_epi f.hom).mp, - simp [hom_inv_id], -end +((hom_comp_eq_id f).1 hom_inv_id).symm @[ext] lemma inv_ext' {f : X ≅ Y} {g : Y ⟶ X} (hom_inv_id : f.hom ≫ g = 𝟙 X) : g = f.inv := -by { symmetry, ext, assumption, } +(hom_comp_eq_id f).1 hom_inv_id /-! All these cancellation lemmas can be solved by `simp [cancel_mono]` (or `simp [cancel_epi]`), diff --git a/src/category_theory/isomorphism_classes.lean b/src/category_theory/isomorphism_classes.lean index 144652c36cc4c..d58e5f1035a19 100644 --- a/src/category_theory/isomorphism_classes.lean +++ b/src/category_theory/isomorphism_classes.lean @@ -10,6 +10,9 @@ import category_theory.types /-! # Objects of a category up to an isomorphism +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `is_isomorphic X Y := nonempty (X ≅ Y)` is an equivalence relation on the objects of a category. The quotient with respect to this relation defines a functor from our category to `Type`. -/ diff --git a/src/category_theory/lifting_properties.lean b/src/category_theory/lifting_properties.lean deleted file mode 100644 index 1fc25dd152767..0000000000000 --- a/src/category_theory/lifting_properties.lean +++ /dev/null @@ -1,126 +0,0 @@ -/- -Copyright (c) 2021 Jakob Scholbach. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jakob Scholbach --/ -import category_theory.limits.shapes.terminal -import category_theory.arrow - -/-! -# Lifting properties - -This file defines the lifting property of two arrows in a category and shows basic properties of -this notion. -We also construct the subcategory consisting of those morphisms which have the right lifting -property with respect to arrows in a given diagram. - -## Main results -- `has_lifting_property`: the definition of the lifting property -- `iso_has_right_lifting_property`: any isomorphism satisfies the right lifting property (rlp) -- `id_has_right_lifting_property`: any identity has the rlp -- `right_lifting_property_initial_iff`: spells out the rlp with respect to a map whose source is an - initial object -- `right_lifting_subcat`: given a set of arrows `F : D → arrow C`, we construct the subcategory - of those morphisms `p` in `C` that satisfy the rlp w.r.t. `F i`, for any element `i` of `D`. - -## Tags -lifting property --/ - -open category_theory.limits - -namespace category_theory - -universes v u v₁ -variables {C : Type u} [category.{v} C] -variables {D : Type v₁} - -variables {X Y Z : C} - -/-- The lifting property of a morphism `i` with respect to a morphism `p`. -This can be interpreted as the right lifting property of `i` with respect to `p`, -or the left lifting property of `p` with respect to `i`. -/ -class has_lifting_property (i p : arrow C) : Prop := -(sq_has_lift : ∀ (sq : i ⟶ p), arrow.has_lift sq) - -@[priority 100] -- see Note [lower instance priority] -instance has_lifting_property' {i p : arrow C} [has_lifting_property i p] (sq : i ⟶ p) : - arrow.has_lift sq := -has_lifting_property.sq_has_lift sq - -/-- Any isomorphism has the right lifting property with respect to any map. -A → X -↓i ↓p≅ -B → Y --/ -lemma iso_has_right_lifting_property (i : arrow C) (p : X ≅ Y) : - has_lifting_property i (arrow.mk p.hom) := -⟨λ sq, ⟨⟨{ lift := sq.right ≫ p.inv, }⟩⟩⟩ -- the lift is obtained by p⁻¹ ∘ (B → Y) - -/-- Any identity has the right lifting property with respect to any map. -/ -lemma id_has_right_lifting_property (i : arrow C) : has_lifting_property i (arrow.mk (𝟙 X)) := -iso_has_right_lifting_property i (iso.refl _) - -/-- An equivalent characterization for right lifting with respect to a map `i` whose source is -initial. -∅ → X -↓ ↓ -B → Y has a lifting iff there is a map B → X making the right part commute. --/ -lemma right_lifting_property_initial_iff (i p : arrow C) (h : is_initial i.left) : - has_lifting_property i p ↔ ∀ {e : i.right ⟶ p.right}, ∃ l : i.right ⟶ p.left, l ≫ p.hom = e := -begin - fsplit, - { introsI hlift e, - have comm : (is_initial.to h p.left) ≫ p.hom = i.hom ≫ e := - is_initial.hom_ext h _ _, - use arrow.lift (arrow.hom_mk comm), - simp }, - { refine λ hlift, ⟨λ sq, _⟩, - obtain ⟨l, hl⟩ : ∃ (l : i.right ⟶ p.left), l ≫ p.hom = sq.right := hlift, - exact arrow.has_lift.mk ⟨l, is_initial.hom_ext h _ _⟩, } -end - -/-- The condition of having the rlp with respect to a morphism `i` is stable under composition. -/ -lemma has_right_lifting_property_comp {i : arrow C} {f : X ⟶ Y} {g : Y ⟶ Z} - (hf : has_lifting_property i (arrow.mk f)) - (hg : has_lifting_property i (arrow.mk g)) : - has_lifting_property i (arrow.mk (f ≫ g)) := -{ sq_has_lift := λ sq1, - -- construct a square i ⟶ f - let sq2 : i ⟶ (arrow.mk f) := ⟨sq1.left, arrow.lift (arrow.square_to_snd sq1)⟩ in - -- show that the lift of this square is a lift of i with respect to g ∘ f - ⟨⟨⟨(arrow.lift sq2 : _ ⟶ _), by simp⟩⟩⟩ } - -/-- The objects of the subcategory `right_lifting_subcategory` are the ones in the -underlying category. -/ -def right_lifting_subcat (R : Type u) := R - -instance right_lifting_subcat.inhabited (R : Type u) [inhabited R] : - inhabited (right_lifting_subcat R) := -{ default := (default : R) } - -/-- The objects of the subcategory `right_lifting_subcategory` are the ones in the -underlying category. -/ -def right_lifting_subcat.X {R : Type u} (x : right_lifting_subcat R) : R := x - -lemma id_has_right_lifting_property' {F : D → arrow C} (X : C) : - ∀ i : D, has_lifting_property (F i) (arrow.mk (𝟙 X)) := -λ i, id_has_right_lifting_property (F i) - -lemma has_right_lifting_property_comp' - {F : D → arrow C} {f : X ⟶ Y} (hf : ∀ i : D, has_lifting_property (F i) (arrow.mk f)) - {g : Y ⟶ Z} (hg : ∀ i : D, has_lifting_property (F i) (arrow.mk g)) : - ∀ i : D, has_lifting_property (F i) (arrow.mk (f ≫ g)) := -λ i, has_right_lifting_property_comp (hf i) (hg i) - -/-- Given a set of arrows in C, indexed by `F : D → arrow C`, -we construct the (non-full) subcategory of `C` -spanned by those morphisms that have the right lifting property relative to all maps -of the form `F i`, where `i` is any element in `D`. -/ -def right_lifting_subcategory (F : D → arrow C) : category (right_lifting_subcat C) := -{ hom := λ X Y, { p : X ⟶ Y // ∀ {i : D}, has_lifting_property (F i) (arrow.mk p) }, - id := λ X, ⟨𝟙 X, id_has_right_lifting_property' X⟩, - comp := λ X Y Z f g, ⟨f.val ≫ g.val, has_right_lifting_property_comp' f.property g.property⟩ } - -end category_theory diff --git a/src/category_theory/lifting_properties/adjunction.lean b/src/category_theory/lifting_properties/adjunction.lean new file mode 100644 index 0000000000000..5602abec58826 --- /dev/null +++ b/src/category_theory/lifting_properties/adjunction.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.lifting_properties.basic +import category_theory.adjunction.basic + +/-! + +# Lifting properties and adjunction + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we obtain `adjunction.has_lifting_property_iff`, which states +that when we have an adjunction `adj : G ⊣ F` between two functors `G : C ⥤ D` +and `F : D ⥤ C`, then a morphism of the form `G.map i` has the left lifting +property in `D` with respect to a morphism `p` if and only the morphism `i` +has the left lifting property in `C` with respect to `F.map p`. + +-/ + +namespace category_theory + +open category + +variables {C D : Type*} [category C] [category D] {G : C ⥤ D} {F : D ⥤ C} + +namespace comm_sq + +section +variables {A B : C} {X Y : D} {i : A ⟶ B} {p : X ⟶ Y} {u : G.obj A ⟶ X} {v : G.obj B ⟶ Y} + (sq : comm_sq u (G.map i) p v) (adj : G ⊣ F) + +include sq + +/-- When we have an adjunction `G ⊣ F`, any commutative square where the left +map is of the form `G.map i` and the right map is `p` has an "adjoint" commutative +square whose left map is `i` and whose right map is `F.map p`. -/ +lemma right_adjoint : + comm_sq (adj.hom_equiv _ _ u) i (F.map p) (adj.hom_equiv _ _ v) := +⟨begin + simp only [adjunction.hom_equiv_unit, assoc, ← F.map_comp, sq.w], + rw [F.map_comp, adjunction.unit_naturality_assoc], +end⟩ + +/-- The liftings of a commutative are in bijection with the liftings of its (right) +adjoint square. -/ +def right_adjoint_lift_struct_equiv : + sq.lift_struct ≃ (sq.right_adjoint adj).lift_struct := +{ to_fun := λ l, + { l := adj.hom_equiv _ _ l.l, + fac_left' := by rw [← adj.hom_equiv_naturality_left, l.fac_left], + fac_right' := by rw [← adjunction.hom_equiv_naturality_right, l.fac_right], }, + inv_fun := λ l, + { l := (adj.hom_equiv _ _).symm l.l, + fac_left' := begin + rw [← adjunction.hom_equiv_naturality_left_symm, l.fac_left], + apply (adj.hom_equiv _ _).left_inv, + end, + fac_right' := begin + rw [← adjunction.hom_equiv_naturality_right_symm, l.fac_right], + apply (adj.hom_equiv _ _).left_inv, + end, }, + left_inv := by tidy, + right_inv := by tidy, } + +/-- A square has a lifting if and only if its (right) adjoint square has a lifting. -/ +lemma right_adjoint_has_lift_iff : + has_lift (sq.right_adjoint adj) ↔ has_lift sq := +begin + simp only [has_lift.iff], + exact equiv.nonempty_congr (sq.right_adjoint_lift_struct_equiv adj).symm, +end + +instance [has_lift sq] : has_lift (sq.right_adjoint adj) := +by { rw right_adjoint_has_lift_iff, apply_instance, } + +end + +section +variables {A B : C} {X Y : D} {i : A ⟶ B} {p : X ⟶ Y} {u : A ⟶ F.obj X} {v : B ⟶ F.obj Y} + (sq : comm_sq u i (F.map p) v) (adj : G ⊣ F) + +include sq + +/-- When we have an adjunction `G ⊣ F`, any commutative square where the left +map is of the form `i` and the right map is `F.map p` has an "adjoint" commutative +square whose left map is `G.map i` and whose right map is `p`. -/ +lemma left_adjoint : + comm_sq ((adj.hom_equiv _ _).symm u) (G.map i) p + ((adj.hom_equiv _ _).symm v) := +⟨begin + simp only [adjunction.hom_equiv_counit, assoc, + ← G.map_comp_assoc, ← sq.w], + rw [G.map_comp, assoc, adjunction.counit_naturality], +end⟩ + +/-- The liftings of a commutative are in bijection with the liftings of its (left) +adjoint square. -/ +def left_adjoint_lift_struct_equiv : + sq.lift_struct ≃ (sq.left_adjoint adj).lift_struct := +{ to_fun := λ l, + { l := (adj.hom_equiv _ _).symm l.l, + fac_left' := by rw [← adj.hom_equiv_naturality_left_symm, l.fac_left], + fac_right' := by rw [← adj.hom_equiv_naturality_right_symm, l.fac_right], }, + inv_fun := λ l, + { l := (adj.hom_equiv _ _) l.l, + fac_left' := begin + rw [← adj.hom_equiv_naturality_left, l.fac_left], + apply (adj.hom_equiv _ _).right_inv, + end, + fac_right' := begin + rw [← adj.hom_equiv_naturality_right, l.fac_right], + apply (adj.hom_equiv _ _).right_inv, + end, }, + left_inv := by tidy, + right_inv := by tidy, } + +/-- A (left) adjoint square has a lifting if and only if the original square has a lifting. -/ +lemma left_adjoint_has_lift_iff : + has_lift (sq.left_adjoint adj) ↔ has_lift sq := +begin + simp only [has_lift.iff], + exact equiv.nonempty_congr (sq.left_adjoint_lift_struct_equiv adj).symm, +end + +instance [has_lift sq] : has_lift (sq.left_adjoint adj) := +by { rw left_adjoint_has_lift_iff, apply_instance, } + +end + +end comm_sq + +namespace adjunction + +lemma has_lifting_property_iff (adj : G ⊣ F) {A B : C} {X Y : D} (i : A ⟶ B) (p : X ⟶ Y) : + has_lifting_property (G.map i) p ↔ has_lifting_property i (F.map p) := +begin + split; introI; constructor; intros f g sq, + { rw ← sq.left_adjoint_has_lift_iff adj, + apply_instance, }, + { rw ← sq.right_adjoint_has_lift_iff adj, + apply_instance, }, +end + +end adjunction + +end category_theory diff --git a/src/category_theory/lifting_properties/basic.lean b/src/category_theory/lifting_properties/basic.lean new file mode 100644 index 0000000000000..7c74c6abee157 --- /dev/null +++ b/src/category_theory/lifting_properties/basic.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2021 Jakob Scholbach. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jakob Scholbach, Joël Riou +-/ +import category_theory.comm_sq + +/-! +# Lifting properties + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the lifting property of two morphisms in a category and +shows basic properties of this notion. + +## Main results +- `has_lifting_property`: the definition of the lifting property + +## Tags +lifting property + +@TODO : +1) define llp/rlp with respect to a `morphism_property` +2) retracts, direct/inverse images, (co)products, adjunctions + +-/ + +universe v + +namespace category_theory + +open category + +variables {C : Type*} [category C] {A B B' X Y Y' : C} + (i : A ⟶ B) (i' : B ⟶ B') (p : X ⟶ Y) (p' : Y ⟶ Y') + +/-- `has_lifting_property i p` means that `i` has the left lifting +property with respect to `p`, or equivalently that `p` has +the right lifting property with respect to `i`. -/ +class has_lifting_property : Prop := +(sq_has_lift : ∀ {f : A ⟶ X} {g : B ⟶ Y} (sq : comm_sq f i p g), sq.has_lift) + +@[priority 100] +instance sq_has_lift_of_has_lifting_property {f : A ⟶ X} {g : B ⟶ Y} (sq : comm_sq f i p g) + [hip : has_lifting_property i p] : sq.has_lift := by apply hip.sq_has_lift + +namespace has_lifting_property + +variables {i p} + +lemma op (h : has_lifting_property i p) : has_lifting_property p.op i.op := +⟨λ f g sq, begin + simp only [comm_sq.has_lift.iff_unop, quiver.hom.unop_op], + apply_instance, +end⟩ + +lemma unop {A B X Y : Cᵒᵖ} {i : A ⟶ B} {p : X ⟶ Y} + (h : has_lifting_property i p) : has_lifting_property p.unop i.unop := +⟨λ f g sq, begin + rw comm_sq.has_lift.iff_op, + simp only [quiver.hom.op_unop], + apply_instance, +end⟩ + +lemma iff_op : has_lifting_property i p ↔ has_lifting_property p.op i.op := ⟨op, unop⟩ + +lemma iff_unop {A B X Y : Cᵒᵖ} (i : A ⟶ B) (p : X ⟶ Y) : + has_lifting_property i p ↔ has_lifting_property p.unop i.unop := ⟨unop, op⟩ + +variables (i p) + +@[priority 100] +instance of_left_iso [is_iso i] : has_lifting_property i p := +⟨λ f g sq, comm_sq.has_lift.mk' + { l := inv i ≫ f, + fac_left' := by simp only [is_iso.hom_inv_id_assoc], + fac_right' := by simp only [sq.w, assoc, is_iso.inv_hom_id_assoc], }⟩ + +@[priority 100] +instance of_right_iso [is_iso p] : has_lifting_property i p := +⟨λ f g sq, comm_sq.has_lift.mk' + { l := g ≫ inv p, + fac_left' := by simp only [← sq.w_assoc, is_iso.hom_inv_id, comp_id], + fac_right' := by simp only [assoc, is_iso.inv_hom_id, comp_id], }⟩ + +instance of_comp_left [has_lifting_property i p] [has_lifting_property i' p] : + has_lifting_property (i ≫ i') p := +⟨λ f g sq, begin + have fac := sq.w, + rw assoc at fac, + exact comm_sq.has_lift.mk' + { l := (comm_sq.mk (comm_sq.mk fac).fac_right).lift, + fac_left' := by simp only [assoc, comm_sq.fac_left], + fac_right' := by simp only [comm_sq.fac_right], }, +end⟩ + +instance of_comp_right [has_lifting_property i p] [has_lifting_property i p'] : + has_lifting_property i (p ≫ p') := +⟨λ f g sq, begin + have fac := sq.w, + rw ← assoc at fac, + let sq₂ := (comm_sq.mk ((comm_sq.mk fac).fac_left.symm)).lift, + exact comm_sq.has_lift.mk' + { l := (comm_sq.mk ((comm_sq.mk fac).fac_left.symm)).lift, + fac_left' := by simp only [comm_sq.fac_left], + fac_right' := by simp only [comm_sq.fac_right_assoc, comm_sq.fac_right], }, +end⟩ + +lemma of_arrow_iso_left {A B A' B' X Y : C} {i : A ⟶ B} {i' : A' ⟶ B'} + (e : arrow.mk i ≅ arrow.mk i') (p : X ⟶ Y) + [hip : has_lifting_property i p] : has_lifting_property i' p := +by { rw arrow.iso_w' e, apply_instance, } + +lemma of_arrow_iso_right {A B X Y X' Y' : C} (i : A ⟶ B) {p : X ⟶ Y} {p' : X' ⟶ Y'} + (e : arrow.mk p ≅ arrow.mk p') + [hip : has_lifting_property i p] : has_lifting_property i p' := +by { rw arrow.iso_w' e, apply_instance, } + +lemma iff_of_arrow_iso_left {A B A' B' X Y : C} {i : A ⟶ B} {i' : A' ⟶ B'} + (e : arrow.mk i ≅ arrow.mk i') (p : X ⟶ Y) : + has_lifting_property i p ↔ has_lifting_property i' p := +by { split; introI, exacts [of_arrow_iso_left e p, of_arrow_iso_left e.symm p], } + +lemma iff_of_arrow_iso_right {A B X Y X' Y' : C} (i : A ⟶ B) {p : X ⟶ Y} {p' : X' ⟶ Y'} + (e : arrow.mk p ≅ arrow.mk p') : + has_lifting_property i p ↔ has_lifting_property i p' := +by { split; introI, exacts [of_arrow_iso_right i e, of_arrow_iso_right i e.symm], } + +end has_lifting_property + +end category_theory diff --git a/src/category_theory/limits/bicones.lean b/src/category_theory/limits/bicones.lean index 741c3576f3096..ced55c90ecb55 100644 --- a/src/category_theory/limits/bicones.lean +++ b/src/category_theory/limits/bicones.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ import category_theory.limits.cones -import category_theory.structured_arrow import category_theory.fin_category /-! # Bicones +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a category `J`, a walking `bicone J` is a category whose objects are the objects of `J` and two extra vertices `bicone.left` and `bicone.right`. The morphisms are the morphisms of `J` and `left ⟶ j`, `right ⟶ j` for each `j : J` such that `⬝ ⟶ j` and `⬝ ⟶ k` commutes with each @@ -23,7 +25,10 @@ This is used in `category_theory.flat_functors.preserves_finite_limits_of_flat`. universes v₁ u₁ +noncomputable theory + open category_theory.limits +open_locale classical namespace category_theory section bicone @@ -38,11 +43,11 @@ inductive bicone instance : inhabited (bicone J) := ⟨bicone.left⟩ -instance fin_bicone [fintype J] [decidable_eq J] : fintype (bicone J) := +instance fin_bicone [fintype J] : fintype (bicone J) := { elems := [bicone.left, bicone.right].to_finset ∪ finset.image bicone.diagram (fintype.elems J), complete := λ j, by { cases j; simp, exact fintype.complete j, }, } -variables [category.{v₁} J] [∀ (j k : J), decidable_eq (j ⟶ k)] +variables [category.{v₁} J] /-- The homs for a walking `bicone J`. -/ inductive bicone_hom : bicone J → bicone J → Type (max u₁ v₁) @@ -80,7 +85,7 @@ variables (J : Type v₁) [small_category J] /-- Given a diagram `F : J ⥤ C` and two `cone F`s, we can join them into a diagram `bicone J ⥤ C`. -/ -@[simps] def bicone_mk [∀ (j k : J), decidable_eq (j ⟶ k)] {C : Type u₁} [category.{v₁} C] +@[simps] def bicone_mk {C : Type u₁} [category.{v₁} C] {F : J ⥤ C} (c₁ c₂ : cone F) : bicone J ⥤ C := { obj := λ X, bicone.cases_on X c₁.X c₂.X (λ j, F.obj j), map := λ X Y f, by @@ -113,8 +118,8 @@ begin { cases f, simp only [finset.mem_image], use f_f, simpa using fintype.complete _, } }, end -instance bicone_small_category [∀ (j k : J), decidable_eq (j ⟶ k)] : - small_category (bicone J) := category_theory.bicone_category J +instance bicone_small_category : small_category (bicone J) := +category_theory.bicone_category J instance bicone_fin_category [fin_category J] : fin_category (bicone J) := {} end small_category diff --git a/src/category_theory/limits/colimit_limit.lean b/src/category_theory/limits/colimit_limit.lean index 443a4fdc24ba3..8a2ab702d589f 100644 --- a/src/category_theory/limits/colimit_limit.lean +++ b/src/category_theory/limits/colimit_limit.lean @@ -10,6 +10,9 @@ import category_theory.limits.functor_category /-! # The morphism comparing a colimit of limits with the corresponding limit of colimits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For `F : J × K ⥤ C` there is always a morphism $\colim_k \lim_j F(j,k) → \lim_j \colim_k F(j, k)$. While it is not usually an isomorphism, with additional hypotheses on `J` and `K` it may be, in which case we say that "colimits commute with limits". @@ -22,7 +25,7 @@ is that when `C = Type`, filtered colimits commute with finite limits. * [Stacks: Filtered colimits](https://stacks.math.columbia.edu/tag/002W) -/ -universes v₂ v u +universes v u open category_theory @@ -65,7 +68,7 @@ limit.lift ((curry.obj F) ⋙ colim) begin dsimp, intros k k' f, - simp only [functor.comp_map, curry.obj_map_app, limits.lim_map_π_assoc, swap_map, + simp only [functor.comp_map, curry_obj_map_app, limits.lim_map_π_assoc, swap_map, category.comp_id, map_id_left_eq_curry_map, colimit.w], end }, }, naturality' := @@ -73,7 +76,7 @@ limit.lift ((curry.obj F) ⋙ colim) dsimp, intros j j' f, ext k, - simp only [limits.colimit.ι_map, curry.obj_map_app, limits.colimit.ι_desc_assoc, + simp only [limits.colimit.ι_map, curry_obj_map_app, limits.colimit.ι_desc_assoc, limits.colimit.ι_desc, category.id_comp, category.assoc, map_id_right_eq_curry_swap_map, limit.w_assoc], end } } diff --git a/src/category_theory/limits/comma.lean b/src/category_theory/limits/comma.lean index d0bf930ddc40c..f687492af0777 100644 --- a/src/category_theory/limits/comma.lean +++ b/src/category_theory/limits/comma.lean @@ -3,15 +3,18 @@ Copyright (c) 2021 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ +import category_theory.arrow +import category_theory.limits.constructions.epi_mono import category_theory.limits.creates -import category_theory.limits.punit -import category_theory.limits.preserves.basic +import category_theory.limits.unit import category_theory.structured_arrow -import category_theory.arrow /-! # Limits and colimits in comma categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We build limits in the comma category `comma L R` provided that the two source categories have limits and `R` preserves them. This is used to construct limits in the arrow category, structured arrow category and under @@ -23,9 +26,9 @@ The duals of all the above are also given. namespace category_theory open category limits -universes v u₁ u₂ u₃ +universes w' w v u₁ u₂ u₃ -variables {J : Type v} [small_category J] +variables {J : Type w} [category.{w'} J] variables {A : Type u₁} [category.{v} A] variables {B : Type u₂} [category.{v} B] variables {T : Type u₃} [category.{v} T] @@ -205,6 +208,14 @@ noncomputable instance creates_limits_of_shape [preserves_limits_of_shape J G] : noncomputable instance creates_limits [preserves_limits G] : creates_limits (proj X G : _) := ⟨⟩ +instance mono_right_of_mono [has_pullbacks A] [preserves_limits_of_shape walking_cospan G] + {Y Z : structured_arrow X G} (f : Y ⟶ Z) [mono f] : mono f.right := +show mono ((proj X G).map f), from infer_instance + +lemma mono_iff_mono_right [has_pullbacks A] [preserves_limits_of_shape walking_cospan G] + {Y Z : structured_arrow X G} (f : Y ⟶ Z) : mono f ↔ mono f.right := +⟨λ h, by exactI infer_instance, λ h, by exactI mono_of_mono_right f⟩ + end structured_arrow namespace costructured_arrow @@ -234,6 +245,14 @@ noncomputable instance creates_colimits_of_shape [preserves_colimits_of_shape J noncomputable instance creates_colimits [preserves_colimits G] : creates_colimits (proj G X : _) := ⟨⟩ +instance epi_left_of_epi [has_pushouts A] [preserves_colimits_of_shape walking_span G] + {Y Z : costructured_arrow G X} (f : Y ⟶ Z) [epi f] : epi f.left := +show epi ((proj G X).map f), from infer_instance + +lemma epi_iff_epi_left [has_pushouts A] [preserves_colimits_of_shape walking_span G] + {Y Z : costructured_arrow G X} (f : Y ⟶ Z) : epi f ↔ epi f.left := +⟨λ h, by exactI infer_instance, λ h, by exactI epi_of_epi_left f⟩ + end costructured_arrow end category_theory diff --git a/src/category_theory/limits/concrete_category.lean b/src/category_theory/limits/concrete_category.lean index 6c136a2d60c0f..4349caebfe5ba 100644 --- a/src/category_theory/limits/concrete_category.lean +++ b/src/category_theory/limits/concrete_category.lean @@ -7,10 +7,15 @@ import category_theory.limits.preserves.basic import category_theory.limits.types import category_theory.limits.shapes.wide_pullbacks import category_theory.limits.shapes.multiequalizer -import category_theory.concrete_category.elementwise +import category_theory.concrete_category.basic +import category_theory.limits.shapes.kernels +import tactic.apply_fun /-! # Facts about (co)limits of functors into concrete categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes w v u @@ -23,16 +28,16 @@ local attribute [instance] concrete_category.has_coe_to_fun concrete_category.ha section limits -variables {C : Type u} [category.{v} C] [concrete_category.{v} C] - {J : Type v} [small_category J] (F : J ⥤ C) [preserves_limit F (forget C)] +variables {C : Type u} [category.{v} C] [concrete_category.{(max w v)} C] + {J : Type w} [small_category J] (F : J ⥤ C) [preserves_limit F (forget C)] lemma concrete.to_product_injective_of_is_limit {D : cone F} (hD : is_limit D) : function.injective (λ (x : D.X) (j : J), D.π.app j x) := begin let E := (forget C).map_cone D, let hE : is_limit E := is_limit_of_preserves _ hD, - let G := types.limit_cone (F ⋙ forget C), - let hG := types.limit_cone_is_limit (F ⋙ forget C), + let G := types.limit_cone.{w v} (F ⋙ forget C), + let hG := types.limit_cone_is_limit.{w v} (F ⋙ forget C), let T : E.X ≅ G.X := hE.cone_point_unique_up_to_iso hG, change function.injective (T.hom ≫ (λ x j, G.π.app j x)), have h : function.injective T.hom, @@ -57,7 +62,7 @@ section wide_pullback open wide_pullback open wide_pullback_shape -lemma concrete.wide_pullback_ext {B : C} {ι : Type*} {X : ι → C} (f : Π j : ι, X j ⟶ B) +lemma concrete.wide_pullback_ext {B : C} {ι : Type w} {X : ι → C} (f : Π j : ι, X j ⟶ B) [has_wide_pullback B X f] [preserves_limit (wide_cospan B X f) (forget C)] (x y : wide_pullback B X f) (h₀ : base f x = base f y) (h : ∀ j, π f j x = π f j y) : x = y := @@ -68,8 +73,8 @@ begin { apply h } end -lemma concrete.wide_pullback_ext' {B : C} {ι : Type*} [nonempty ι] - {X : ι → C} (f : Π j : ι, X j ⟶ B) [has_wide_pullback B X f] +lemma concrete.wide_pullback_ext' {B : C} {ι : Type w} [nonempty ι] + {X : ι → C} (f : Π j : ι, X j ⟶ B) [has_wide_pullback.{w} B X f] [preserves_limit (wide_cospan B X f) (forget C)] (x y : wide_pullback B X f) (h : ∀ j, π f j x = π f j y) : x = y := begin @@ -82,7 +87,7 @@ end wide_pullback section multiequalizer -lemma concrete.multiequalizer_ext {I : multicospan_index C} [has_multiequalizer I] +lemma concrete.multiequalizer_ext {I : multicospan_index.{w} C} [has_multiequalizer I] [preserves_limit I.multicospan (forget C)] (x y : multiequalizer I) (h : ∀ (t : I.L), multiequalizer.ι I t x = multiequalizer.ι I t y) : x = y := begin @@ -128,7 +133,7 @@ def concrete.multiequalizer_equiv_aux (I : multicospan_index C) : /-- The equivalence between the noncomputable multiequalizer and and the concrete multiequalizer. -/ noncomputable -def concrete.multiequalizer_equiv (I : multicospan_index C) [has_multiequalizer I] +def concrete.multiequalizer_equiv (I : multicospan_index.{w} C) [has_multiequalizer I] [preserves_limit I.multicospan (forget C)] : (multiequalizer I : C) ≃ { x : Π (i : I.L), I.left i // ∀ (i : I.R), I.fst i (x _) = I.snd i (x _) } := let h1 := (limit.is_limit I.multicospan), @@ -137,7 +142,7 @@ let h1 := (limit.is_limit I.multicospan), equiv.trans E.to_equiv (concrete.multiequalizer_equiv_aux I) @[simp] -lemma concrete.multiequalizer_equiv_apply (I : multicospan_index C) [has_multiequalizer I] +lemma concrete.multiequalizer_equiv_apply (I : multicospan_index.{w} C) [has_multiequalizer I] [preserves_limit I.multicospan (forget C)] (x : multiequalizer I) (i : I.L) : ((concrete.multiequalizer_equiv I) x : Π (i : I.L), I.left i) i = multiequalizer.ι I i x := rfl @@ -168,8 +173,8 @@ begin intro ff, let E := (forget C).map_cocone D, let hE : is_colimit E := is_colimit_of_preserves _ hD, - let G := types.colimit_cocone (F ⋙ forget C), - let hG := types.colimit_cocone_is_colimit (F ⋙ forget C), + let G := types.colimit_cocone.{v v} (F ⋙ forget C), + let hG := types.colimit_cocone_is_colimit.{v v} (F ⋙ forget C), let T : E ≅ G := hE.unique_up_to_iso hG, let TX : E.X ≅ G.X := (cocones.forget _).map_iso T, suffices : function.surjective (TX.hom ∘ ff), @@ -205,8 +210,8 @@ lemma concrete.is_colimit_rep_eq_of_exists {D : cocone F} {i j : J} (hD : is_col begin let E := (forget C).map_cocone D, let hE : is_colimit E := is_colimit_of_preserves _ hD, - let G := types.colimit_cocone (F ⋙ forget C), - let hG := types.colimit_cocone_is_colimit (F ⋙ forget C), + let G := types.colimit_cocone.{v v} (F ⋙ forget C), + let hG := types.colimit_cocone_is_colimit.{v v} (F ⋙ forget C), let T : E ≅ G := hE.unique_up_to_iso hG, let TX : E.X ≅ G.X := (cocones.forget _).map_iso T, apply_fun TX.hom, @@ -236,8 +241,8 @@ lemma concrete.is_colimit_exists_of_rep_eq {D : cocone F} {i j : J} (hD : is_col begin let E := (forget C).map_cocone D, let hE : is_colimit E := is_colimit_of_preserves _ hD, - let G := types.colimit_cocone (F ⋙ forget C), - let hG := types.colimit_cocone_is_colimit (F ⋙ forget C), + let G := types.colimit_cocone.{v v} (F ⋙ forget C), + let hG := types.colimit_cocone_is_colimit.{v v} (F ⋙ forget C), let T : E ≅ G := hE.unique_up_to_iso hG, let TX : E.X ≅ G.X := (cocones.forget _).map_iso T, apply_fun TX.hom at h, @@ -245,7 +250,7 @@ begin erw [T.hom.w, T.hom.w] at h, replace h := quot.exact _ h, suffices : ∀ (a b : Σ j, F.obj j) - (h : eqv_gen (limits.types.quot.rel (F ⋙ forget C)) a b), + (h : eqv_gen (limits.types.quot.rel.{v v} (F ⋙ forget C)) a b), ∃ k (f : a.1 ⟶ k) (g : b.1 ⟶ k), F.map f a.2 = F.map g b.2, { exact this ⟨i,x⟩ ⟨j,y⟩ h }, intros a b h, @@ -295,7 +300,7 @@ open wide_pushout open wide_pushout_shape lemma concrete.wide_pushout_exists_rep {B : C} {α : Type*} {X : α → C} (f : Π j : α, B ⟶ X j) - [has_wide_pushout B X f] [preserves_colimit (wide_span B X f) (forget C)] + [has_wide_pushout.{v} B X f] [preserves_colimit (wide_span B X f) (forget C)] (x : wide_pushout B X f) : (∃ y : B, head f y = x) ∨ (∃ (i : α) (y : X i), ι f i y = x) := begin obtain ⟨_ | j, y, rfl⟩ := concrete.colimit_exists_rep _ x, @@ -305,7 +310,7 @@ begin end lemma concrete.wide_pushout_exists_rep' {B : C} {α : Type*} [nonempty α] {X : α → C} - (f : Π j : α, B ⟶ X j) [has_wide_pushout B X f] + (f : Π j : α, B ⟶ X j) [has_wide_pushout.{v} B X f] [preserves_colimit (wide_span B X f) (forget C)] (x : wide_pushout B X f) : ∃ (i : α) (y : X i), ι f i y = x := begin diff --git a/src/category_theory/limits/cone_category.lean b/src/category_theory/limits/cone_category.lean index f6ff043646828..34ea874977a06 100644 --- a/src/category_theory/limits/cone_category.lean +++ b/src/category_theory/limits/cone_category.lean @@ -3,30 +3,61 @@ Copyright (c) 2021 Andrew Yang. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ - +import category_theory.adjunction.comma import category_theory.limits.preserves.shapes.terminal +import category_theory.structured_arrow +import category_theory.limits.shapes.equivalence /-! - # Limits and the category of (co)cones +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This files contains results that stem from the limit API. For the definition and the category instance of `cone`, please refer to `category_theory/limits/cones.lean`. -A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of -categories of cones preserves limiting properties. We also provide the dual. +## Main results +* The category of cones on `F : J ⥤ C` is equivalent to the category + `costructured_arrow (const J) F`. +* A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of + categories of cones preserves limiting properties. -/ namespace category_theory.limits -open category_theory +open category_theory category_theory.functor universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄ variables {J : Type u₁} [category.{v₁} J] {K : Type u₂} [category.{v₂} K] variables {C : Type u₃} [category.{v₃} C] {D : Type u₄} [category.{v₄} D] +/-- Construct an object of the category `(Δ ↓ F)` from a cone on `F`. This is part of an + equivalence, see `cone.equiv_costructured_arrow`. -/ +@[simps] +def cone.to_costructured_arrow (F : J ⥤ C) : cone F ⥤ costructured_arrow (const J) F := +{ obj := λ c, costructured_arrow.mk c.π, + map := λ c d f, costructured_arrow.hom_mk f.hom $ by { ext, simp } } + +/-- Construct a cone on `F` from an object of the category `(Δ ↓ F)`. This is part of an + equivalence, see `cone.equiv_costructured_arrow`. -/ +@[simps] +def cone.from_costructured_arrow (F : J ⥤ C) : costructured_arrow (const J) F ⥤ cone F := +{ obj := λ c, ⟨c.left, c.hom⟩, + map := λ c d f, + { hom := f.left, + w' := λ j, by { convert (congr_fun (congr_arg nat_trans.app f.w) j), dsimp, simp } } } + +/-- The category of cones on `F` is just the comma category `(Δ ↓ F)`, where `Δ` is the constant + functor. -/ +@[simps] +def cone.equiv_costructured_arrow (F : J ⥤ C) : cone F ≌ costructured_arrow (const J) F := +equivalence.mk (cone.to_costructured_arrow F) (cone.from_costructured_arrow F) + (nat_iso.of_components cones.eta (by tidy)) + (nat_iso.of_components (λ c, (costructured_arrow.eta _).symm) (by tidy)) + /-- A cone is a limit cone iff it is terminal. -/ def cone.is_limit_equiv_is_terminal {F : J ⥤ C} (c : cone F) : is_limit c ≃ is_terminal c := is_limit.iso_unique_cone_morphism.to_equiv.trans @@ -35,6 +66,20 @@ is_limit.iso_unique_cone_morphism.to_equiv.trans left_inv := by tidy, right_inv := by tidy } +lemma has_limit_iff_has_terminal_cone (F : J ⥤ C) : has_limit F ↔ has_terminal (cone F) := +⟨λ h, by exactI (cone.is_limit_equiv_is_terminal _ (limit.is_limit F)).has_terminal, + λ h, ⟨⟨by exactI ⟨⊤_ _, (cone.is_limit_equiv_is_terminal _).symm terminal_is_terminal⟩⟩⟩⟩ + +lemma has_limits_of_shape_iff_is_left_adjoint_const : + has_limits_of_shape J C ↔ nonempty (is_left_adjoint (const J : C ⥤ _)) := +calc has_limits_of_shape J C + ↔ ∀ F : J ⥤ C, has_limit F : ⟨λ h, h.has_limit, λ h, by exactI has_limits_of_shape.mk⟩ + ... ↔ ∀ F : J ⥤ C, has_terminal (cone F) : forall_congr has_limit_iff_has_terminal_cone + ... ↔ ∀ F : J ⥤ C, has_terminal (costructured_arrow (const J) F) : + forall_congr $ λ F, (cone.equiv_costructured_arrow F).has_terminal_iff + ... ↔ nonempty (is_left_adjoint (const J : C ⥤ _)) : + nonempty_is_left_adjoint_iff_has_terminal_costructured_arrow.symm + lemma is_limit.lift_cone_morphism_eq_is_terminal_from {F : J ⥤ C} {c : cone F} (hc : is_limit c) (s : cone F) : hc.lift_cone_morphism s = is_terminal.from (cone.is_limit_equiv_is_terminal _ hc) _ := rfl @@ -46,18 +91,42 @@ by convert (is_limit.lift_cone_morphism_eq_is_terminal_from _ s).symm /-- If `G : cone F ⥤ cone F'` preserves terminal objects, it preserves limit cones. -/ def is_limit.of_preserves_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F') - [preserves_limit (functor.empty.{v₃} _) G] {c : cone F} (hc : is_limit c) : + [preserves_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit c) : is_limit (G.obj c) := (cone.is_limit_equiv_is_terminal _).symm $ (cone.is_limit_equiv_is_terminal _ hc).is_terminal_obj _ _ /-- If `G : cone F ⥤ cone F'` reflects terminal objects, it reflects limit cones. -/ def is_limit.of_reflects_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F') - [reflects_limit (functor.empty.{v₃} _) G] {c : cone F} (hc : is_limit (G.obj c)) : + [reflects_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit (G.obj c)) : is_limit c := (cone.is_limit_equiv_is_terminal _).symm $ (cone.is_limit_equiv_is_terminal _ hc).is_terminal_of_obj _ _ +/-- Construct an object of the category `(F ↓ Δ)` from a cocone on `F`. This is part of an + equivalence, see `cocone.equiv_structured_arrow`. -/ +@[simps] +def cocone.to_structured_arrow (F : J ⥤ C) : cocone F ⥤ structured_arrow F (const J) := +{ obj := λ c, structured_arrow.mk c.ι, + map := λ c d f, structured_arrow.hom_mk f.hom $ by { ext, simp } } + +/-- Construct a cocone on `F` from an object of the category `(F ↓ Δ)`. This is part of an + equivalence, see `cocone.equiv_structured_arrow`. -/ +@[simps] +def cocone.from_structured_arrow (F : J ⥤ C) : structured_arrow F (const J) ⥤ cocone F := +{ obj := λ c, ⟨c.right, c.hom⟩, + map := λ c d f, + { hom := f.right, + w' := λ j, by { convert (congr_fun (congr_arg nat_trans.app f.w) j).symm, dsimp, simp } } } + +/-- The category of cocones on `F` is just the comma category `(F ↓ Δ)`, where `Δ` is the constant + functor. -/ +@[simps] +def cocone.equiv_structured_arrow (F : J ⥤ C) : cocone F ≌ structured_arrow F (const J) := +equivalence.mk (cocone.to_structured_arrow F) (cocone.from_structured_arrow F) + (nat_iso.of_components cocones.eta (by tidy)) + (nat_iso.of_components (λ c, (structured_arrow.eta _).symm) (by tidy)) + /-- A cocone is a colimit cocone iff it is initial. -/ def cocone.is_colimit_equiv_is_initial {F : J ⥤ C} (c : cocone F) : is_colimit c ≃ is_initial c := is_colimit.iso_unique_cocone_morphism.to_equiv.trans @@ -66,6 +135,20 @@ is_colimit.iso_unique_cocone_morphism.to_equiv.trans left_inv := by tidy, right_inv := by tidy } +lemma has_colimit_iff_has_initial_cocone (F : J ⥤ C) : has_colimit F ↔ has_initial (cocone F) := +⟨λ h, by exactI (cocone.is_colimit_equiv_is_initial _ (colimit.is_colimit F)).has_initial, + λ h, ⟨⟨by exactI ⟨⊥_ _, (cocone.is_colimit_equiv_is_initial _).symm initial_is_initial⟩⟩⟩⟩ + +lemma has_colimits_of_shape_iff_is_right_adjoint_const : + has_colimits_of_shape J C ↔ nonempty (is_right_adjoint (const J : C ⥤ _)) := +calc has_colimits_of_shape J C + ↔ ∀ F : J ⥤ C, has_colimit F : ⟨λ h, h.has_colimit, λ h, by exactI has_colimits_of_shape.mk⟩ + ... ↔ ∀ F : J ⥤ C, has_initial (cocone F) : forall_congr has_colimit_iff_has_initial_cocone + ... ↔ ∀ F : J ⥤ C, has_initial (structured_arrow F (const J)) : + forall_congr $ λ F, (cocone.equiv_structured_arrow F).has_initial_iff + ... ↔ nonempty (is_right_adjoint (const J : C ⥤ _)) : + nonempty_is_right_adjoint_iff_has_initial_structured_arrow.symm + lemma is_colimit.desc_cocone_morphism_eq_is_initial_to {F : J ⥤ C} {c : cocone F} (hc : is_colimit c) (s : cocone F) : hc.desc_cocone_morphism s = @@ -78,14 +161,14 @@ by convert (is_colimit.desc_cocone_morphism_eq_is_initial_to _ s).symm /-- If `G : cocone F ⥤ cocone F'` preserves initial objects, it preserves colimit cocones. -/ def is_colimit.of_preserves_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F') - [preserves_colimit (functor.empty.{v₃} _) G] {c : cocone F} (hc : is_colimit c) : + [preserves_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit c) : is_colimit (G.obj c) := (cocone.is_colimit_equiv_is_initial _).symm $ (cocone.is_colimit_equiv_is_initial _ hc).is_initial_obj _ _ /-- If `G : cocone F ⥤ cocone F'` reflects initial objects, it reflects colimit cocones. -/ def is_colimit.of_reflects_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F') - [reflects_colimit (functor.empty.{v₃} _) G] {c : cocone F} (hc : is_colimit (G.obj c)) : + [reflects_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit (G.obj c)) : is_colimit c := (cocone.is_colimit_equiv_is_initial _).symm $ (cocone.is_colimit_equiv_is_initial _ hc).is_initial_of_obj _ _ diff --git a/src/category_theory/limits/cones.lean b/src/category_theory/limits/cones.lean index f1ab170bc7ca7..ee11cb8e8ab06 100644 --- a/src/category_theory/limits/cones.lean +++ b/src/category_theory/limits/cones.lean @@ -8,6 +8,34 @@ import category_theory.discrete_category import category_theory.yoneda import category_theory.functor.reflects_isomorphisms +/-! +# Cones and cocones + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define `cone F`, a cone over a functor `F`, +and `F.cones : Cᵒᵖ ⥤ Type`, the functor associating to `X` the cones over `F` with cone point `X`. + +A cone `c` is defined by specifying its cone point `c.X` and a natural transformation `c.π` +from the constant `c.X` valued functor to `F`. + +We provide `c.w f : c.π.app j ≫ F.map f = c.π.app j'` for any `f : j ⟶ j'` +as a wrapper for `c.π.naturality f` avoiding unneeded identity morphisms. + +We define `c.extend f`, where `c : cone F` and `f : Y ⟶ c.X` for some other `Y`, +which replaces the cone point by `Y` and inserts `f` into each of the components of the cone. +Similarly we have `c.whisker F` producing a `cone (E ⋙ F)` + +We define morphisms of cones, and the category of cones. + +We define `cone.postcompose α : cone F ⥤ cone G` for `α` a natural transformation `F ⟶ G`. + +And, of course, we dualise all this to cocones as well. + +For more results about the category of cones, see `cone_category.lean`. +-/ + -- morphism levels before object levels. See note [category_theory universes]. universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄ open category_theory @@ -68,6 +96,9 @@ end namespace limits +section +local attribute [tidy] tactic.discrete_cases + /-- A `c : cone F` is: * an object `c.X` and @@ -80,8 +111,9 @@ structure cone (F : J ⥤ C) := (π : (const J).obj X ⟶ F) instance inhabited_cone (F : discrete punit ⥤ C) : inhabited (cone F) := -⟨{ X := F.obj punit.star, - π := { app := λ ⟨⟩, 𝟙 _ } }⟩ +⟨{ X := F.obj ⟨⟨⟩⟩, + π := + { app := λ ⟨⟨⟩⟩, 𝟙 _, }, }⟩ @[simp, reassoc] lemma cone.w {F : J ⥤ C} (c : cone F) {j j' : J} (f : j ⟶ j') : c.π.app j ≫ F.map f = c.π.app j' := @@ -99,13 +131,16 @@ structure cocone (F : J ⥤ C) := (ι : F ⟶ (const J).obj X) instance inhabited_cocone (F : discrete punit ⥤ C) : inhabited (cocone F) := -⟨{ X := F.obj punit.star, - ι := { app := λ ⟨⟩, 𝟙 _ } }⟩ +⟨{ X := F.obj ⟨⟨⟩⟩, + ι := + { app := λ ⟨⟨⟩⟩, 𝟙 _, }, }⟩ @[simp, reassoc] lemma cocone.w {F : J ⥤ C} (c : cocone F) {j j' : J} (f : j ⟶ j') : F.map f ≫ c.ι.app j' = c.ι.app j := by { rw c.ι.naturality f, apply comp_id } +end + variables {F : J ⥤ C} namespace cone @@ -190,6 +225,10 @@ namespace cones { hom := { hom := φ.hom }, inv := { hom := φ.inv, w' := λ j, φ.inv_comp_eq.mpr (w j) } } +/-- Eta rule for cones. -/ +@[simps] def eta (c : cone F) : c ≅ ⟨c.X, c.π⟩ := +cones.ext (iso.refl _) (by tidy) + /-- Given a cone morphism whose object part is an isomorphism, produce an isomorphism of cones. @@ -349,6 +388,10 @@ namespace cocones { hom := { hom := φ.hom }, inv := { hom := φ.inv, w' := λ j, φ.comp_inv_eq.mpr (w j).symm } } +/-- Eta rule for cocones. -/ +@[simps] def eta (c : cocone F) : c ≅ ⟨c.X, c.ι⟩ := +cocones.ext (iso.refl _) (by tidy) + /-- Given a cocone morphism whose object part is an isomorphism, produce an isomorphism of cocones. @@ -675,18 +718,20 @@ def cocone_equivalence_op_cone_op : cocone F ≌ (cone F.op)ᵒᵖ := { obj := λ c, op (cocone.op c), map := λ X Y f, quiver.hom.op { hom := f.hom.op, - w' := λ j, by { apply quiver.hom.unop_inj, dsimp, simp, }, } }, + w' := λ j, by { apply quiver.hom.unop_inj, dsimp, apply cocone_morphism.w }, } }, inverse := { obj := λ c, cone.unop (unop c), map := λ X Y f, { hom := f.unop.hom.unop, - w' := λ j, by { apply quiver.hom.op_inj, dsimp, simp, }, } }, - unit_iso := nat_iso.of_components (λ c, cocones.ext (iso.refl _) (by tidy)) (by tidy), + w' := λ j, by { apply quiver.hom.op_inj, dsimp, apply cone_morphism.w }, } }, + unit_iso := nat_iso.of_components (λ c, + cocones.ext (iso.refl _) (by { dsimp, simp })) (λ X Y f, by { ext, simp }), counit_iso := nat_iso.of_components (λ c, by { induction c using opposite.rec, - dsimp, apply iso.op, exact cones.ext (iso.refl _) (by tidy), }) + dsimp, apply iso.op, exact cones.ext (iso.refl _) (by { dsimp, simp }), }) (λ X Y f, quiver.hom.unop_inj (cone_morphism.ext _ _ (by { dsimp, simp }))), - functor_unit_iso_comp' := λ c, begin apply quiver.hom.unop_inj, ext, dsimp, simp, end } + functor_unit_iso_comp' := (λ c, + by { apply quiver.hom.unop_inj, ext, dsimp, apply comp_id })} attribute [simps] cocone_equivalence_op_cone_op diff --git a/src/category_theory/limits/connected.lean b/src/category_theory/limits/connected.lean index c0f3710678c42..f066ce70b7849 100644 --- a/src/category_theory/limits/connected.lean +++ b/src/category_theory/limits/connected.lean @@ -12,6 +12,9 @@ import category_theory.limits.preserves.basic /-! # Connected limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A connected limit is a limit whose shape is a connected category. We give examples of connected categories, and prove that the functor given diff --git a/src/category_theory/limits/constructions/binary_products.lean b/src/category_theory/limits/constructions/binary_products.lean index c9be3227021ad..1320170cf887e 100644 --- a/src/category_theory/limits/constructions/binary_products.lean +++ b/src/category_theory/limits/constructions/binary_products.lean @@ -6,43 +6,59 @@ Authors: Bhavik Mehta, Andrew Yang import category_theory.limits.shapes.terminal import category_theory.limits.shapes.pullbacks import category_theory.limits.shapes.binary_products +import category_theory.limits.preserves.shapes.pullbacks +import category_theory.limits.preserves.shapes.terminal /-! # Constructing binary product from pullbacks and terminal object. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The product is the pullback over the terminal objects. In particular, if a category has pullbacks and a terminal object, then it has binary products. We also provide the dual. -/ -universes v u +universes v v' u u' open category_theory category_theory.category category_theory.limits -variables {C : Type u} [category.{v} C] +variables {C : Type u} [category.{v} C] {D : Type u'} [category.{v'} D] (F : C ⥤ D) + +/-- If a span is the pullback span over the terminal object, then it is a binary product. -/ +def is_binary_product_of_is_terminal_is_pullback (F : discrete walking_pair ⥤ C) (c : cone F) + {X : C} (hX : is_terminal X) + (f : F.obj ⟨walking_pair.left⟩ ⟶ X) (g : F.obj ⟨walking_pair.right⟩ ⟶ X) + (hc : is_limit (pullback_cone.mk (c.π.app ⟨walking_pair.left⟩) (c.π.app ⟨walking_pair.right⟩ : _) + $ hX.hom_ext (_ ≫ f) (_ ≫ g))) : is_limit c := +{ lift := λ s, hc.lift + (pullback_cone.mk (s.π.app ⟨walking_pair.left⟩) (s.π.app ⟨walking_pair.right⟩) + (hX.hom_ext _ _)), + fac' := λ s j, discrete.cases_on j + (λ j, walking_pair.cases_on j (hc.fac _ walking_cospan.left) (hc.fac _ walking_cospan.right)), + uniq' := λ s m J, + begin + let c' := pullback_cone.mk + (m ≫ c.π.app ⟨walking_pair.left⟩) (m ≫ c.π.app ⟨walking_pair.right⟩ : _) + (hX.hom_ext (_ ≫ f) (_ ≫ g)), + rw [←J, ←J], + apply hc.hom_ext, + rintro (_|(_|_)); simp only [pullback_cone.mk_π_app_one, pullback_cone.mk_π_app], + exacts [(category.assoc _ _ _).symm.trans (hc.fac_assoc c' walking_cospan.left f).symm, + (hc.fac c' walking_cospan.left).symm, (hc.fac c' walking_cospan.right).symm] + end } /-- The pullback over the terminal object is the product -/ def is_product_of_is_terminal_is_pullback {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) (k : W ⟶ Y) (H₁ : is_terminal Z) (H₂ : is_limit (pullback_cone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _))) : is_limit (binary_fan.mk h k) := -{ lift := λ c, H₂.lift (pullback_cone.mk - (c.π.app walking_pair.left) (c.π.app walking_pair.right) (H₁.hom_ext _ _)), - fac' := λ c j, - begin - convert H₂.fac (pullback_cone.mk - (c.π.app walking_pair.left) (c.π.app walking_pair.right) (H₁.hom_ext _ _)) (some j) using 1, - cases j; refl - end, - uniq' := λ c m hm, - begin - apply pullback_cone.is_limit.hom_ext H₂, - { exact (hm walking_pair.left).trans (H₂.fac (pullback_cone.mk (c.π.app walking_pair.left) - (c.π.app walking_pair.right) (H₁.hom_ext _ _)) walking_cospan.left).symm }, - { exact (hm walking_pair.right).trans (H₂.fac (pullback_cone.mk (c.π.app walking_pair.left) - (c.π.app walking_pair.right) (H₁.hom_ext _ _)) walking_cospan.right).symm }, - end } +begin + apply is_binary_product_of_is_terminal_is_pullback _ _ H₁, + exact H₂ +end /-- The product is the pullback over the terminal object. -/ def is_pullback_of_is_terminal_is_product {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) @@ -53,103 +69,152 @@ begin apply pullback_cone.is_limit_aux', intro s, use H₂.lift (binary_fan.mk s.fst s.snd), - use H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.left, - use H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.right, + use H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.left⟩, + use H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.right⟩, intros m h₁ h₂, apply H₂.hom_ext, - rintro ⟨⟩, - { exact h₁.trans (H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.left).symm }, - { exact h₂.trans (H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.right).symm } + rintro ⟨⟨⟩⟩, + { exact h₁.trans (H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.left⟩).symm }, + { exact h₂.trans (H₂.fac (binary_fan.mk s.fst s.snd) ⟨walking_pair.right⟩).symm } end +/-- Any category with pullbacks and a terminal object has a limit cone for each walking pair. -/ +noncomputable def limit_cone_of_terminal_and_pullbacks [has_terminal C] [has_pullbacks C] + (F : discrete walking_pair ⥤ C) : limit_cone F := +{ cone := + { X := pullback (terminal.from (F.obj ⟨walking_pair.left⟩)) + (terminal.from (F.obj ⟨walking_pair.right⟩)), + π := discrete.nat_trans (λ x, discrete.cases_on x + (λ x, walking_pair.cases_on x pullback.fst pullback.snd)) }, + is_limit := is_binary_product_of_is_terminal_is_pullback + F _ terminal_is_terminal _ _ (pullback_is_pullback _ _) } + variable (C) /-- Any category with pullbacks and terminal object has binary products. -/ -- This is not an instance, as it is not always how one wants to construct binary products! -lemma has_binary_products_of_terminal_and_pullbacks +lemma has_binary_products_of_has_terminal_and_pullbacks [has_terminal C] [has_pullbacks C] : has_binary_products C := -{ has_limit := λ F, has_limit.mk - { cone := - { X := pullback (terminal.from (F.obj walking_pair.left)) - (terminal.from (F.obj walking_pair.right)), - π := discrete.nat_trans (λ x, walking_pair.cases_on x pullback.fst pullback.snd)}, - is_limit := - { lift := λ c, pullback.lift ((c.π).app walking_pair.left) - ((c.π).app walking_pair.right) - (subsingleton.elim _ _), - fac' := λ s c, walking_pair.cases_on c (limit.lift_π _ _) (limit.lift_π _ _), - uniq' := λ s m J, - begin - rw [←J, ←J], - ext; - rw limit.lift_π; - refl - end } } } +{ has_limit := λ F, has_limit.mk (limit_cone_of_terminal_and_pullbacks F) } variable {C} +/-- A functor that preserves terminal objects and pullbacks preserves binary products. -/ +noncomputable +def preserves_binary_products_of_preserves_terminal_and_pullbacks + [has_terminal C] [has_pullbacks C] + [preserves_limits_of_shape (discrete.{0} pempty) F] + [preserves_limits_of_shape walking_cospan F] : + preserves_limits_of_shape (discrete walking_pair) F := +⟨λ K, preserves_limit_of_preserves_limit_cone (limit_cone_of_terminal_and_pullbacks K).2 +begin + apply is_binary_product_of_is_terminal_is_pullback _ _ + (is_limit_of_has_terminal_of_preserves_limit F), + apply is_limit_of_has_pullback_of_preserves_limit, +end⟩ + +/-- In a category with a terminal object and pullbacks, +a product of objects `X` and `Y` is isomorphic to a pullback. -/ +noncomputable +def prod_iso_pullback [has_terminal C] [has_pullbacks C] (X Y : C) [has_binary_product X Y] : + X ⨯ Y ≅ pullback (terminal.from X) (terminal.from Y) := +limit.iso_limit_cone (limit_cone_of_terminal_and_pullbacks _) + +/-- If a cospan is the pushout cospan under the initial object, then it is a binary coproduct. -/ +def is_binary_coproduct_of_is_initial_is_pushout (F : discrete walking_pair ⥤ C) (c : cocone F) + {X : C} (hX : is_initial X) + (f : X ⟶ F.obj ⟨walking_pair.left⟩) (g : X ⟶ F.obj ⟨walking_pair.right⟩) + (hc : is_colimit (pushout_cocone.mk (c.ι.app ⟨walking_pair.left⟩) + (c.ι.app ⟨walking_pair.right⟩ : _) $ hX.hom_ext (f ≫ _) (g ≫ _))) : is_colimit c := +{ desc := λ s, hc.desc + (pushout_cocone.mk (s.ι.app ⟨walking_pair.left⟩) (s.ι.app ⟨walking_pair.right⟩) + (hX.hom_ext _ _)), + fac' := λ s j, discrete.cases_on j + (λ j, walking_pair.cases_on j (hc.fac _ walking_span.left) (hc.fac _ walking_span.right)), + uniq' := λ s m J, + begin + let c' := pushout_cocone.mk + (c.ι.app ⟨walking_pair.left⟩ ≫ m) (c.ι.app ⟨walking_pair.right⟩ ≫ m) + (hX.hom_ext (f ≫ _) (g ≫ _)), + rw [←J, ←J], + apply hc.hom_ext, + rintro (_|(_|_)); + simp only [pushout_cocone.mk_ι_app_zero, pushout_cocone.mk_ι_app, category.assoc], + congr' 1, + exacts [(hc.fac c' walking_span.left).symm, + (hc.fac c' walking_span.left).symm, (hc.fac c' walking_span.right).symm] + end } + /-- The pushout under the initial object is the coproduct -/ def is_coproduct_of_is_initial_is_pushout {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) (k : W ⟶ Y) (H₁ : is_initial W) (H₂ : is_colimit (pushout_cocone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _))) : is_colimit (binary_cofan.mk f g) := -{ desc := λ c, H₂.desc (pushout_cocone.mk - (c.ι.app walking_pair.left) (c.ι.app walking_pair.right) (H₁.hom_ext _ _)), - fac' := λ c j, - begin - convert H₂.fac (pushout_cocone.mk - (c.ι.app walking_pair.left) (c.ι.app walking_pair.right) (H₁.hom_ext _ _)) (some j) using 1, - cases j; refl - end, - uniq' := λ c m hm, - begin - apply pushout_cocone.is_colimit.hom_ext H₂, - { exact (hm walking_pair.left).trans (H₂.fac (pushout_cocone.mk (c.ι.app walking_pair.left) - (c.ι.app walking_pair.right) (H₁.hom_ext _ _)) walking_cospan.left).symm }, - { exact (hm walking_pair.right).trans (H₂.fac (pushout_cocone.mk (c.ι.app walking_pair.left) - (c.ι.app walking_pair.right) (H₁.hom_ext _ _)) walking_cospan.right).symm }, - end } +begin + apply is_binary_coproduct_of_is_initial_is_pushout _ _ H₁, + exact H₂ +end /-- The coproduct is the pushout under the initial object. -/ def is_pushout_of_is_initial_is_coproduct {W X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) (h : W ⟶ X) - (k : W ⟶ Y) (H₁ : is_terminal Z) - (H₂ : is_limit (binary_fan.mk h k)) : - is_limit (pullback_cone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _)) := + (k : W ⟶ Y) (H₁ : is_initial W) + (H₂ : is_colimit (binary_cofan.mk f g)) : + is_colimit (pushout_cocone.mk _ _ (show h ≫ f = k ≫ g, from H₁.hom_ext _ _)) := begin - apply pullback_cone.is_limit_aux', + apply pushout_cocone.is_colimit_aux', intro s, - use H₂.lift (binary_fan.mk s.fst s.snd), - use H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.left, - use H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.right, + use H₂.desc (binary_cofan.mk s.inl s.inr), + use H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.left⟩, + use H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.right⟩, intros m h₁ h₂, apply H₂.hom_ext, - rintro ⟨⟩, - { exact h₁.trans (H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.left).symm }, - { exact h₂.trans (H₂.fac (binary_fan.mk s.fst s.snd) walking_pair.right).symm } + rintro ⟨⟨⟩⟩, + { exact h₁.trans (H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.left⟩).symm }, + { exact h₂.trans (H₂.fac (binary_cofan.mk s.inl s.inr) ⟨walking_pair.right⟩).symm } end +/-- Any category with pushouts and an initial object has a colimit cocone for each walking pair. -/ +noncomputable def colimit_cocone_of_initial_and_pushouts [has_initial C] [has_pushouts C] + (F : discrete walking_pair ⥤ C) : colimit_cocone F := +{ cocone := + { X := pushout (initial.to (F.obj ⟨walking_pair.left⟩)) + (initial.to (F.obj ⟨walking_pair.right⟩)), + ι := discrete.nat_trans (λ x, discrete.cases_on x + (λ x, walking_pair.cases_on x pushout.inl pushout.inr)) }, + is_colimit := is_binary_coproduct_of_is_initial_is_pushout + F _ initial_is_initial _ _ (pushout_is_pushout _ _) } + + variable (C) /-- Any category with pushouts and initial object has binary coproducts. -/ -- This is not an instance, as it is not always how one wants to construct binary coproducts! -lemma has_binary_coproducts_of_initial_and_pushouts +lemma has_binary_coproducts_of_has_initial_and_pushouts [has_initial C] [has_pushouts C] : has_binary_coproducts C := -{ has_colimit := λ F, has_colimit.mk - { cocone := - { X := pushout (initial.to (F.obj walking_pair.left)) - (initial.to (F.obj walking_pair.right)), - ι := discrete.nat_trans (λ x, walking_pair.cases_on x pushout.inl pushout.inr)}, - is_colimit := - { desc := λ c, pushout.desc (c.ι.app walking_pair.left) - (c.ι.app walking_pair.right) - (subsingleton.elim _ _), - fac' := λ s c, walking_pair.cases_on c (colimit.ι_desc _ _) (colimit.ι_desc _ _), - uniq' := λ s m J, - begin - rw [←J, ←J], - ext; - rw colimit.ι_desc; - refl - end } } } +{ has_colimit := λ F, has_colimit.mk (colimit_cocone_of_initial_and_pushouts F) } + +variable {C} + +/-- A functor that preserves initial objects and pushouts preserves binary coproducts. -/ +noncomputable +def preserves_binary_coproducts_of_preserves_initial_and_pushouts + [has_initial C] [has_pushouts C] + [preserves_colimits_of_shape (discrete.{0} pempty) F] + [preserves_colimits_of_shape walking_span F] : + preserves_colimits_of_shape (discrete walking_pair) F := +⟨λ K, preserves_colimit_of_preserves_colimit_cocone (colimit_cocone_of_initial_and_pushouts K).2 +begin + apply is_binary_coproduct_of_is_initial_is_pushout _ _ + (is_colimit_of_has_initial_of_preserves_colimit F), + apply is_colimit_of_has_pushout_of_preserves_colimit, +end⟩ + + +/-- In a category with an initial object and pushouts, +a coproduct of objects `X` and `Y` is isomorphic to a pushout. -/ +noncomputable +def coprod_iso_pushout [has_initial C] [has_pushouts C] (X Y : C) [has_binary_coproduct X Y] : + X ⨿ Y ≅ pushout (initial.to X) (initial.to Y) := +colimit.iso_colimit_cocone (colimit_cocone_of_initial_and_pushouts _) diff --git a/src/category_theory/limits/constructions/epi_mono.lean b/src/category_theory/limits/constructions/epi_mono.lean index 4461c6edfc975..0dd2408e5adfa 100644 --- a/src/category_theory/limits/constructions/epi_mono.lean +++ b/src/category_theory/limits/constructions/epi_mono.lean @@ -10,6 +10,9 @@ import category_theory.limits.preserves.shapes.pullbacks /-! # Relating monomorphisms and epimorphisms to limits and colimits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `F` preserves (resp. reflects) pullbacks, then it preserves (resp. reflects) monomorphisms. We also provide the dual version for epimorphisms. @@ -25,35 +28,50 @@ variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D variables (F : C ⥤ D) /-- If `F` preserves pullbacks, then it preserves monomorphisms. -/ -instance preserves_mono {X Y : C} (f : X ⟶ Y) [preserves_limit (cospan f f) F] [mono f] : - mono (F.map f) := +lemma preserves_mono_of_preserves_limit {X Y : C} (f : X ⟶ Y) [preserves_limit (cospan f f) F] + [mono f] : mono (F.map f) := begin have := is_limit_pullback_cone_map_of_is_limit F _ (pullback_cone.is_limit_mk_id_id f), simp_rw [F.map_id] at this, apply pullback_cone.mono_of_is_limit_mk_id_id _ this, end +@[priority 100] +instance preserves_monomorphisms_of_preserves_limits_of_shape + [preserves_limits_of_shape walking_cospan F] : F.preserves_monomorphisms := +{ preserves := λ X Y f hf, by exactI preserves_mono_of_preserves_limit F f } + /-- If `F` reflects pullbacks, then it reflects monomorphisms. -/ -lemma reflects_mono {X Y : C} (f : X ⟶ Y) [reflects_limit (cospan f f) F] [mono (F.map f)] : - mono f := +lemma reflects_mono_of_reflects_limit {X Y : C} (f : X ⟶ Y) [reflects_limit (cospan f f) F] + [mono (F.map f)] : mono f := begin have := pullback_cone.is_limit_mk_id_id (F.map f), simp_rw [←F.map_id] at this, apply pullback_cone.mono_of_is_limit_mk_id_id _ (is_limit_of_is_limit_pullback_cone_map F _ this), end +@[priority 100] +instance reflects_monomorphisms_of_reflects_limits_of_shape + [reflects_limits_of_shape walking_cospan F] : F.reflects_monomorphisms := +{ reflects := λ X Y f hf, by exactI reflects_mono_of_reflects_limit F f } + /-- If `F` preserves pushouts, then it preserves epimorphisms. -/ -instance preserves_epi {X Y : C} (f : X ⟶ Y) [preserves_colimit (span f f) F] [epi f] : - epi (F.map f) := +lemma preserves_epi_of_preserves_colimit {X Y : C} (f : X ⟶ Y) [preserves_colimit (span f f) F] + [epi f] : epi (F.map f) := begin have := is_colimit_pushout_cocone_map_of_is_colimit F _ (pushout_cocone.is_colimit_mk_id_id f), simp_rw [F.map_id] at this, apply pushout_cocone.epi_of_is_colimit_mk_id_id _ this, end +@[priority 100] +instance preserves_epimorphisms_of_preserves_colimits_of_shape + [preserves_colimits_of_shape walking_span F] : F.preserves_epimorphisms := +{ preserves := λ X Y f hf, by exactI preserves_epi_of_preserves_colimit F f } + /-- If `F` reflects pushouts, then it reflects epimorphisms. -/ -lemma reflects_epi {X Y : C} (f : X ⟶ Y) [reflects_colimit (span f f) F] [epi (F.map f)] : - epi f := +lemma reflects_epi_of_reflects_colimit {X Y : C} (f : X ⟶ Y) [reflects_colimit (span f f) F] + [epi (F.map f)] : epi f := begin have := pushout_cocone.is_colimit_mk_id_id (F.map f), simp_rw [← F.map_id] at this, @@ -61,4 +79,9 @@ begin (is_colimit_of_is_colimit_pushout_cocone_map F _ this) end +@[priority 100] +instance reflects_epimorphisms_of_reflects_colimits_of_shape + [reflects_colimits_of_shape walking_span F] : F.reflects_epimorphisms := +{ reflects := λ X Y f hf, by exactI reflects_epi_of_reflects_colimit F f } + end category_theory diff --git a/src/category_theory/limits/constructions/equalizers.lean b/src/category_theory/limits/constructions/equalizers.lean index 7cc0d326d6694..e311be168e3fc 100644 --- a/src/category_theory/limits/constructions/equalizers.lean +++ b/src/category_theory/limits/constructions/equalizers.lean @@ -1,32 +1,40 @@ /- Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bhavik Mehta +Authors: Bhavik Mehta, Andrew Yang -/ import category_theory.limits.shapes.equalizers import category_theory.limits.shapes.binary_products import category_theory.limits.shapes.pullbacks +import category_theory.limits.preserves.shapes.pullbacks +import category_theory.limits.preserves.shapes.binary_products /-! # Constructing equalizers from pullbacks and binary products. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If a category has pullbacks and binary products, then it has equalizers. -TODO: provide the dual result. +TODO: generalize universe -/ noncomputable theory -universes v u +universes v v' u u' open category_theory category_theory.category namespace category_theory.limits -variables {C : Type u} [category.{v} C] [has_binary_products C] [has_pullbacks C] +variables {C : Type u} [category.{v} C] +variables {D : Type u'} [category.{v'} D] (G : C ⥤ D) -- We hide the "implementation details" inside a namespace -namespace has_equalizers_of_pullbacks_and_binary_products +namespace has_equalizers_of_has_pullbacks_and_binary_products + +variables [has_binary_products C] [has_pullbacks C] /-- Define the equalizing object -/ @[reducible] @@ -71,15 +79,156 @@ def equalizer_cone_is_limit (F : walking_parallel_pair ⥤ C) : is_limit (equali { erw [limit.lift_π, ← J0, pullback_fst_eq_pullback_snd] } end } -end has_equalizers_of_pullbacks_and_binary_products +end has_equalizers_of_has_pullbacks_and_binary_products -open has_equalizers_of_pullbacks_and_binary_products +open has_equalizers_of_has_pullbacks_and_binary_products /-- Any category with pullbacks and binary products, has equalizers. -/ -- This is not an instance, as it is not always how one wants to construct equalizers! -lemma has_equalizers_of_pullbacks_and_binary_products : +lemma has_equalizers_of_has_pullbacks_and_binary_products + [has_binary_products C] [has_pullbacks C] : has_equalizers C := { has_limit := λ F, has_limit.mk { cone := equalizer_cone F, is_limit := equalizer_cone_is_limit F } } +local attribute[instance] has_pullback_of_preserves_pullback + +/-- A functor that preserves pullbacks and binary products also presrves equalizers. -/ +def preserves_equalizers_of_preserves_pullbacks_and_binary_products + [has_binary_products C] [has_pullbacks C] + [preserves_limits_of_shape (discrete walking_pair) G] + [preserves_limits_of_shape walking_cospan G] : + preserves_limits_of_shape walking_parallel_pair G := +⟨λ K, preserves_limit_of_preserves_limit_cone (equalizer_cone_is_limit K) $ +{ lift := λ c, begin + refine pullback.lift _ _ _ ≫ (@@preserves_pullback.iso _ _ _ _ _ _ _ _).inv, + { exact c.π.app walking_parallel_pair.zero }, + { exact c.π.app walking_parallel_pair.zero }, + apply (map_is_limit_of_preserves_of_is_limit G _ _ (prod_is_prod _ _)).hom_ext, + swap, apply_instance, + rintro (_|_), + { simp only [category.assoc, ← G.map_comp, prod.lift_fst, + binary_fan.π_app_left, binary_fan.mk_fst], }, + { simp only [binary_fan.π_app_right, binary_fan.mk_snd, + category.assoc, ← G.map_comp, prod.lift_snd], + exact (c.π.naturality (walking_parallel_pair_hom.left)).symm.trans + (c.π.naturality (walking_parallel_pair_hom.right)) }, + end, + fac' := λ c j, begin + rcases j with (_|_); + simp only [category.comp_id, preserves_pullback.iso_inv_fst, cone.of_fork_π, G.map_comp, + preserves_pullback.iso_inv_fst_assoc, functor.map_cone_π_app, eq_to_hom_refl, + category.assoc, fork.of_ι_π_app, pullback.lift_fst, pullback.lift_fst_assoc], + exact (c.π.naturality (walking_parallel_pair_hom.left)).symm.trans (category.id_comp _) + end, + uniq' := λ s m h, begin + rw iso.eq_comp_inv, + have := h walking_parallel_pair.zero, + dsimp [equalizer_cone] at this, + ext; simp only [preserves_pullback.iso_hom_snd, + category.assoc, preserves_pullback.iso_hom_fst, pullback.lift_fst, pullback.lift_snd, + category.comp_id, ← pullback_fst_eq_pullback_snd, ← this], + end }⟩ + + +-- We hide the "implementation details" inside a namespace +namespace has_coequalizers_of_has_pushouts_and_binary_coproducts + +variables [has_binary_coproducts C] [has_pushouts C] + +/-- Define the equalizing object -/ +@[reducible] +def construct_coequalizer (F : walking_parallel_pair ⥤ C) : C := +pushout (coprod.desc (𝟙 _) (F.map walking_parallel_pair_hom.left)) + (coprod.desc (𝟙 _) (F.map walking_parallel_pair_hom.right)) + +/-- Define the equalizing morphism -/ +abbreviation pushout_inl (F : walking_parallel_pair ⥤ C) : + F.obj walking_parallel_pair.one ⟶ construct_coequalizer F := +pushout.inl + +lemma pushout_inl_eq_pushout_inr (F : walking_parallel_pair ⥤ C) : + pushout_inl F = pushout.inr := +by convert limits.coprod.inl ≫= pushout.condition; simp + +/-- Define the equalizing cocone -/ +@[reducible] +def coequalizer_cocone (F : walking_parallel_pair ⥤ C) : cocone F := +cocone.of_cofork + (cofork.of_π (pushout_inl F) + (begin + conv_rhs { rw pushout_inl_eq_pushout_inr, }, + convert limits.coprod.inr ≫= pushout.condition using 1; simp + end)) + +/-- Show the equalizing cocone is a colimit -/ +def coequalizer_cocone_is_colimit (F : walking_parallel_pair ⥤ C) : + is_colimit (coequalizer_cocone F) := +{ desc := + begin + intro c, apply pushout.desc (c.ι.app _) (c.ι.app _), + apply colimit.hom_ext, + rintro (_ | _); simp + end, + fac' := by rintros c (_ | _); simp, + uniq' := + begin + intros c _ J, + have J1 : pushout_inl F ≫ m = c.ι.app walking_parallel_pair.one := + by simpa using J walking_parallel_pair.one, + apply pushout.hom_ext, + { rw colimit.ι_desc, exact J1 }, + { rw [colimit.ι_desc, ← pushout_inl_eq_pushout_inr], exact J1 } + end } + +end has_coequalizers_of_has_pushouts_and_binary_coproducts + +open has_coequalizers_of_has_pushouts_and_binary_coproducts +/-- Any category with pullbacks and binary products, has equalizers. -/ +-- This is not an instance, as it is not always how one wants to construct equalizers! +lemma has_coequalizers_of_has_pushouts_and_binary_coproducts + [has_binary_coproducts C] [has_pushouts C] : has_coequalizers C := +{ has_colimit := λ F, has_colimit.mk + { cocone := coequalizer_cocone F, + is_colimit := coequalizer_cocone_is_colimit F } } + +local attribute[instance] has_pushout_of_preserves_pushout + +/-- A functor that preserves pushouts and binary coproducts also presrves coequalizers. -/ +def preserves_coequalizers_of_preserves_pushouts_and_binary_coproducts + [has_binary_coproducts C] [has_pushouts C] + [preserves_colimits_of_shape (discrete walking_pair) G] + [preserves_colimits_of_shape walking_span G] : + preserves_colimits_of_shape walking_parallel_pair G := +⟨λ K, preserves_colimit_of_preserves_colimit_cocone (coequalizer_cocone_is_colimit K) $ +{ desc := λ c, begin + refine (@@preserves_pushout.iso _ _ _ _ _ _ _ _).inv ≫ pushout.desc _ _ _, + { exact c.ι.app walking_parallel_pair.one }, + { exact c.ι.app walking_parallel_pair.one }, + apply (map_is_colimit_of_preserves_of_is_colimit G _ _ (coprod_is_coprod _ _)).hom_ext, + swap, apply_instance, + rintro (_|_), + { simp only [binary_cofan.ι_app_left, binary_cofan.mk_inl, category.assoc, ← G.map_comp_assoc, + coprod.inl_desc] }, + { simp only [binary_cofan.ι_app_right, binary_cofan.mk_inr, category.assoc, ← G.map_comp_assoc, + coprod.inr_desc], + exact (c.ι.naturality walking_parallel_pair_hom.left).trans + (c.ι.naturality walking_parallel_pair_hom.right).symm, }, + end, + fac' := λ c j, begin + rcases j with (_|_); simp only [functor.map_cocone_ι_app, cocone.of_cofork_ι, category.id_comp, + eq_to_hom_refl, category.assoc, functor.map_comp, cofork.of_π_ι_app, pushout.inl_desc, + preserves_pushout.inl_iso_inv_assoc], + exact (c.ι.naturality (walking_parallel_pair_hom.left)).trans (category.comp_id _) + end, + uniq' := λ s m h, begin + rw iso.eq_inv_comp, + have := h walking_parallel_pair.one, + dsimp [coequalizer_cocone] at this, + ext; simp only [preserves_pushout.inl_iso_hom_assoc, category.id_comp, pushout.inl_desc, + pushout.inr_desc, preserves_pushout.inr_iso_hom_assoc, + ← pushout_inl_eq_pushout_inr, ← this], + end }⟩ + + end category_theory.limits diff --git a/src/category_theory/limits/constructions/filtered.lean b/src/category_theory/limits/constructions/filtered.lean new file mode 100644 index 0000000000000..42c8ea4d84801 --- /dev/null +++ b/src/category_theory/limits/constructions/filtered.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.limits.constructions.limits_of_products_and_equalizers +import category_theory.limits.opposites + +/-! +# Constructing colimits from finite colimits and filtered colimits + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct colimits of size `w` from finite colimits and filtered colimits of size `w`. Since +`w`-sized colimits are constructured from coequalizers and `w`-sized coproducts, it suffices to +construct `w`-sized coproducts from finite coproducts and `w`-sized filtered colimits. + +The idea is simple: to construct coproducts of shape `α`, we take the colimit of the filtered +diagram of all coproducts of finite subsets of `α`. + +We also deduce the dual statement by invoking the original statement in `Cᵒᵖ`. +-/ + +universes w v u + +noncomputable theory + +open category_theory + +variables {C : Type u} [category.{v} C] {α : Type w} + +namespace category_theory.limits + +namespace coproducts_from_finite_filtered +local attribute [tidy] tactic.case_bash + +/-- If `C` has finite coproducts, a functor `discrete α ⥤ C` lifts to a functor + `finset (discrete α) ⥤ C` by taking coproducts. -/ +@[simps] +def lift_to_finset [has_finite_coproducts C] (F : discrete α ⥤ C) : finset (discrete α) ⥤ C := +{ obj := λ s, ∐ λ x : s, F.obj x, + map := λ s t h, sigma.desc (λ y, sigma.ι (λ x : t, F.obj x) ⟨y, h.down.down y.2⟩) } + +/-- If `C` has finite coproducts and filtered colimits, we can construct arbitrary coproducts by + taking the colimit of the diagram formed by the coproducts of finite sets over the indexing + type. -/ +@[simps] +def lift_to_finset_colimit_cocone [has_finite_coproducts C] [has_filtered_colimits_of_size.{w w} C] + [decidable_eq α] (F : discrete α ⥤ C) : colimit_cocone F := +{ cocone := + { X := colimit (lift_to_finset F), + ι := discrete.nat_trans $ λ j, + @sigma.ι _ _ _ (λ x : ({j} : finset (discrete α)), F.obj x) _ ⟨j, by simp⟩ ≫ + colimit.ι (lift_to_finset F) {j} }, + is_colimit := + { desc := λ s, colimit.desc (lift_to_finset F) + { X := s.X, + ι := { app := λ t, sigma.desc (λ x, s.ι.app x) } }, + uniq' := λ s m h, + begin + ext t ⟨⟨j, hj⟩⟩, + convert h j using 1, + { simp [← colimit.w (lift_to_finset F) ⟨⟨finset.singleton_subset_iff.2 hj⟩⟩], refl }, + { tidy } + end } } + +end coproducts_from_finite_filtered + +open coproducts_from_finite_filtered + +lemma has_coproducts_of_finite_and_filtered [has_finite_coproducts C] + [has_filtered_colimits_of_size.{w w} C] : has_coproducts.{w} C := +λ α, by { classical, exactI ⟨λ F, has_colimit.mk (lift_to_finset_colimit_cocone F)⟩ } + +lemma has_colimits_of_finite_and_filtered [has_finite_colimits C] + [has_filtered_colimits_of_size.{w w} C] : has_colimits_of_size.{w w} C := +have has_coproducts.{w} C, from has_coproducts_of_finite_and_filtered, +by exactI has_colimits_of_has_coequalizers_and_coproducts + +lemma has_products_of_finite_and_cofiltered [has_finite_products C] + [has_cofiltered_limits_of_size.{w w} C] : has_products.{w} C := +have has_coproducts.{w} Cᵒᵖ, from has_coproducts_of_finite_and_filtered, +by exactI has_products_of_opposite + +lemma has_limits_of_finite_and_cofiltered [has_finite_limits C] + [has_cofiltered_limits_of_size.{w w} C] : has_limits_of_size.{w w} C := +have has_products.{w} C, from has_products_of_finite_and_cofiltered, +by exactI has_limits_of_has_equalizers_and_products + +end category_theory.limits diff --git a/src/category_theory/limits/constructions/finite_products_of_binary_products.lean b/src/category_theory/limits/constructions/finite_products_of_binary_products.lean index d0d2128b0e856..ff8793b35fff6 100644 --- a/src/category_theory/limits/constructions/finite_products_of_binary_products.lean +++ b/src/category_theory/limits/constructions/finite_products_of_binary_products.lean @@ -7,12 +7,14 @@ import category_theory.limits.preserves.shapes.binary_products import category_theory.limits.preserves.shapes.products import category_theory.limits.shapes.binary_products import category_theory.limits.shapes.finite_products -import category_theory.pempty import logic.equiv.fin /-! # Constructing finite products from binary products and terminal. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If a category has binary products and a terminal object then it has finite products. If a functor preserves binary products and the terminal object then it preserves finite products. @@ -22,7 +24,7 @@ Provide the dual results. Show the analogous results for functors which reflect or create (co)limits. -/ -universes v u u' +universes v v' u u' noncomputable theory open category_theory category_theory.category category_theory.limits @@ -30,7 +32,7 @@ namespace category_theory variables {J : Type v} [small_category J] variables {C : Type u} [category.{v} C] -variables {D : Type u'} [category.{v} D] +variables {D : Type u'} [category.{v'} D] /-- Given `n+1` objects of `C`, a fan for the last `n` with point `c₁.X` and a binary fan on `c₁.X` and @@ -40,36 +42,32 @@ In `extend_fan_is_limit` we show that if the two given fans are limits, then thi limit. -/ @[simps {rhs_md := semireducible}] -def extend_fan {n : ℕ} {f : ulift (fin (n+1)) → C} - (c₁ : fan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)) - (c₂ : binary_fan (f ⟨0⟩) c₁.X) : +def extend_fan {n : ℕ} {f : fin (n+1) → C} + (c₁ : fan (λ (i : fin n), f i.succ)) + (c₂ : binary_fan (f 0) c₁.X) : fan f := fan.mk c₂.X begin - rintro ⟨i⟩, - revert i, refine fin.cases _ _, { apply c₂.fst }, - { intro i, - apply c₂.snd ≫ c₁.π.app (ulift.up i) }, + { intro i, apply c₂.snd ≫ c₁.π.app ⟨i⟩ }, end /-- Show that if the two given fans in `extend_fan` are limits, then the constructed fan is also a limit. -/ -def extend_fan_is_limit {n : ℕ} (f : ulift (fin (n+1)) → C) - {c₁ : fan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)} {c₂ : binary_fan (f ⟨0⟩) c₁.X} +def extend_fan_is_limit {n : ℕ} (f : fin (n+1) → C) + {c₁ : fan (λ (i : fin n), f i.succ)} {c₂ : binary_fan (f 0) c₁.X} (t₁ : is_limit c₁) (t₂ : is_limit c₂) : is_limit (extend_fan c₁ c₂) := { lift := λ s, begin apply (binary_fan.is_limit.lift' t₂ (s.π.app ⟨0⟩) _).1, - apply t₁.lift ⟨_, discrete.nat_trans (λ i, s.π.app ⟨i.down.succ⟩)⟩ + apply t₁.lift ⟨_, discrete.nat_trans (λ ⟨i⟩, s.π.app ⟨i.succ⟩)⟩ end, - fac' := λ s, + fac' := λ s ⟨j⟩, begin - rintro ⟨j⟩, apply fin.induction_on j, { apply (binary_fan.is_limit.lift' t₂ _ _).2.1 }, { rintro i -, @@ -86,79 +84,63 @@ def extend_fan_is_limit {n : ℕ} (f : ulift (fin (n+1)) → C) apply t₁.uniq ⟨_, _⟩, rintro ⟨j⟩, rw assoc, - dsimp only [discrete.nat_trans_app], + dsimp only [discrete.nat_trans_app, extend_fan_is_limit._match_1], rw ← w ⟨j.succ⟩, dsimp only [extend_fan_π_app], rw fin.cases_succ } end } section -variables [has_binary_products.{v} C] [has_terminal C] +variables [has_binary_products C] [has_terminal C] /-- If `C` has a terminal object and binary products, then it has a product for objects indexed by -`ulift (fin n)`. +`fin n`. This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general than this. -/ -private lemma has_product_ulift_fin : - Π (n : ℕ) (f : ulift.{v} (fin n) → C), has_product f +private lemma has_product_fin : + Π (n : ℕ) (f : fin n → C), has_product f | 0 := λ f, begin - letI : has_limits_of_shape (discrete (ulift.{v} (fin 0))) C := - has_limits_of_shape_of_equivalence - (discrete.equivalence.{v} (equiv.ulift.trans fin_zero_equiv').symm), + letI : has_limits_of_shape (discrete (fin 0)) C := + has_limits_of_shape_of_equivalence (discrete.equivalence.{0} fin_zero_equiv'.symm), apply_instance, end | (n+1) := λ f, begin - haveI := has_product_ulift_fin n, - apply has_limit.mk ⟨_, extend_fan_is_limit f (limit.is_limit.{v} _) (limit.is_limit _)⟩, + haveI := has_product_fin n, + apply has_limit.mk ⟨_, extend_fan_is_limit f (limit.is_limit _) (limit.is_limit _)⟩, end -/-- -If `C` has a terminal object and binary products, then it has limits of shape -`discrete (ulift (fin n))` for any `n : ℕ`. -This is a helper lemma for `has_finite_products_of_has_binary_and_terminal`, which is more general -than this. --/ -private lemma has_limits_of_shape_ulift_fin (n : ℕ) : - has_limits_of_shape (discrete (ulift.{v} (fin n))) C := -{ has_limit := λ K, -begin - letI := has_product_ulift_fin n K.obj, - let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _), - apply has_limit_of_iso this, -end } - /-- If `C` has a terminal object and binary products, then it has finite products. -/ lemma has_finite_products_of_has_binary_and_terminal : has_finite_products C := -⟨λ J 𝒥₁ 𝒥₂, begin - resetI, - let e := fintype.equiv_fin J, - apply has_limits_of_shape_of_equivalence (discrete.equivalence (e.trans equiv.ulift.symm)).symm, - refine has_limits_of_shape_ulift_fin (fintype.card J), -end⟩ +begin + refine ⟨λ n, ⟨λ K, _⟩⟩, + letI := has_product_fin n (λ n, K.obj ⟨n⟩), + let : discrete.functor (λ n, K.obj ⟨n⟩) ≅ K := discrete.nat_iso (λ ⟨i⟩, iso.refl _), + apply has_limit_of_iso this, +end end section preserves variables (F : C ⥤ D) -variables [preserves_limits_of_shape (discrete.{v} walking_pair) F] -variables [preserves_limits_of_shape (discrete.{v} pempty) F] +variables [preserves_limits_of_shape (discrete walking_pair) F] +variables [preserves_limits_of_shape (discrete.{0} pempty) F] variables [has_finite_products.{v} C] /-- If `F` preserves the terminal object and binary products, then it preserves products indexed by -`ulift (fin n)` for any `n`. +`fin n` for any `n`. -/ noncomputable def preserves_fin_of_preserves_binary_and_terminal : - Π (n : ℕ) (f : ulift.{v} (fin n) → C), preserves_limit (discrete.functor f) F + Π (n : ℕ) (f : fin n → C), preserves_limit (discrete.functor f) F | 0 := λ f, begin - letI : preserves_limits_of_shape (discrete (ulift (fin 0))) F := - preserves_limits_of_shape_of_equiv.{v v} - (discrete.equivalence (equiv.ulift.trans fin_zero_equiv').symm) _, + letI : preserves_limits_of_shape (discrete (fin 0)) F := + preserves_limits_of_shape_of_equiv.{0 0} + (discrete.equivalence fin_zero_equiv'.symm) _, apply_instance, end | (n+1) := @@ -166,7 +148,7 @@ noncomputable def preserves_fin_of_preserves_binary_and_terminal : haveI := preserves_fin_of_preserves_binary_and_terminal n, intro f, refine preserves_limit_of_preserves_limit_cone - (extend_fan_is_limit f (limit.is_limit.{v} _) (limit.is_limit _)) _, + (extend_fan_is_limit f (limit.is_limit _) (limit.is_limit _)) _, apply (is_limit_map_cone_fan_mk_equiv _ _ _).symm _, let := extend_fan_is_limit (λ i, F.obj (f i)) (is_limit_of_has_product_of_preserves_limit F _) @@ -187,27 +169,27 @@ noncomputable def preserves_fin_of_preserves_binary_and_terminal : /-- If `F` preserves the terminal object and binary products, then it preserves limits of shape -`discrete (ulift (fin n))`. +`discrete (fin n)`. -/ -def preserves_ulift_fin_of_preserves_binary_and_terminal (n : ℕ) : - preserves_limits_of_shape (discrete (ulift (fin n))) F := +def preserves_shape_fin_of_preserves_binary_and_terminal (n : ℕ) : + preserves_limits_of_shape (discrete (fin n)) F := { preserves_limit := λ K, begin - let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _), - haveI := preserves_fin_of_preserves_binary_and_terminal F n K.obj, + let : discrete.functor (λ n, K.obj ⟨n⟩) ≅ K := discrete.nat_iso (λ ⟨i⟩, iso.refl _), + haveI := preserves_fin_of_preserves_binary_and_terminal F n (λ n, K.obj ⟨n⟩), apply preserves_limit_of_iso_diagram F this, end } /-- If `F` preserves the terminal object and binary products then it preserves finite products. -/ def preserves_finite_products_of_preserves_binary_and_terminal - (J : Type v) [fintype J] : - preserves_limits_of_shape.{v} (discrete J) F := + (J : Type) [fintype J] : + preserves_limits_of_shape (discrete J) F := begin classical, let e := fintype.equiv_fin J, - haveI := preserves_ulift_fin_of_preserves_binary_and_terminal F (fintype.card J), - apply preserves_limits_of_shape_of_equiv.{v v} - (discrete.equivalence (e.trans equiv.ulift.symm)).symm, + haveI := preserves_shape_fin_of_preserves_binary_and_terminal F (fintype.card J), + apply preserves_limits_of_shape_of_equiv.{0 0} + (discrete.equivalence e).symm, end end preserves @@ -220,32 +202,30 @@ In `extend_cofan_is_colimit` we show that if the two given cofans are colimits, then this cofan is also a colimit. -/ @[simps {rhs_md := semireducible}] -def extend_cofan {n : ℕ} {f : ulift (fin (n+1)) → C} - (c₁ : cofan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)) - (c₂ : binary_cofan (f ⟨0⟩) c₁.X) : +def extend_cofan {n : ℕ} {f : fin (n+1) → C} + (c₁ : cofan (λ (i : fin n), f i.succ)) + (c₂ : binary_cofan (f 0) c₁.X) : cofan f := cofan.mk c₂.X begin - rintro ⟨i⟩, - revert i, refine fin.cases _ _, { apply c₂.inl }, { intro i, - apply c₁.ι.app (ulift.up i) ≫ c₂.inr }, + apply c₁.ι.app ⟨i⟩ ≫ c₂.inr }, end /-- Show that if the two given cofans in `extend_cofan` are colimits, then the constructed cofan is also a colimit. -/ -def extend_cofan_is_colimit {n : ℕ} (f : ulift (fin (n+1)) → C) - {c₁ : cofan (λ (i : ulift (fin n)), f ⟨i.down.succ⟩)} {c₂ : binary_cofan (f ⟨0⟩) c₁.X} +def extend_cofan_is_colimit {n : ℕ} (f : fin (n+1) → C) + {c₁ : cofan (λ (i : fin n), f i.succ)} {c₂ : binary_cofan (f 0) c₁.X} (t₁ : is_colimit c₁) (t₂ : is_colimit c₂) : is_colimit (extend_cofan c₁ c₂) := { desc := λ s, begin apply (binary_cofan.is_colimit.desc' t₂ (s.ι.app ⟨0⟩) _).1, - apply t₁.desc ⟨_, discrete.nat_trans (λ i, s.ι.app ⟨i.down.succ⟩)⟩ + apply t₁.desc ⟨_, discrete.nat_trans (λ i, s.ι.app ⟨i.as.succ⟩)⟩ end, fac' := λ s, begin @@ -272,73 +252,57 @@ def extend_cofan_is_colimit {n : ℕ} (f : ulift (fin (n+1)) → C) end } section -variables [has_binary_coproducts.{v} C] [has_initial C] +variables [has_binary_coproducts C] [has_initial C] /-- If `C` has an initial object and binary coproducts, then it has a coproduct for objects indexed by -`ulift (fin n)`. +`fin n`. This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general than this. -/ -private lemma has_coproduct_ulift_fin : - Π (n : ℕ) (f : ulift.{v} (fin n) → C), has_coproduct f +private lemma has_coproduct_fin : + Π (n : ℕ) (f : fin n → C), has_coproduct f | 0 := λ f, begin - letI : has_colimits_of_shape (discrete (ulift.{v} (fin 0))) C := - has_colimits_of_shape_of_equivalence - (discrete.equivalence.{v} (equiv.ulift.trans fin_zero_equiv').symm), + letI : has_colimits_of_shape (discrete (fin 0)) C := + has_colimits_of_shape_of_equivalence (discrete.equivalence.{0} fin_zero_equiv'.symm), apply_instance, end | (n+1) := λ f, begin - haveI := has_coproduct_ulift_fin n, + haveI := has_coproduct_fin n, apply has_colimit.mk - ⟨_, extend_cofan_is_colimit f (colimit.is_colimit.{v} _) (colimit.is_colimit _)⟩, + ⟨_, extend_cofan_is_colimit f (colimit.is_colimit _) (colimit.is_colimit _)⟩, end -/-- -If `C` has an initial object and binary coproducts, then it has colimits of shape -`discrete (ulift (fin n))` for any `n : ℕ`. -This is a helper lemma for `has_cofinite_products_of_has_binary_and_terminal`, which is more general -than this. --/ -private lemma has_colimits_of_shape_ulift_fin (n : ℕ) : - has_colimits_of_shape (discrete (ulift.{v} (fin n))) C := -{ has_colimit := λ K, +/-- If `C` has an initial object and binary coproducts, then it has finite coproducts. -/ +lemma has_finite_coproducts_of_has_binary_and_initial : has_finite_coproducts C := begin - letI := has_coproduct_ulift_fin n K.obj, - let : K ≅ discrete.functor K.obj := discrete.nat_iso (λ i, iso.refl _), + refine ⟨λ n, ⟨λ K, _⟩⟩, + letI := has_coproduct_fin n (λ n, K.obj ⟨n⟩), + let : K ≅ discrete.functor (λ n, K.obj ⟨n⟩) := discrete.nat_iso (λ ⟨i⟩, iso.refl _), apply has_colimit_of_iso this, -end } - -/-- If `C` has an initial object and binary coproducts, then it has finite coproducts. -/ -lemma has_finite_coproducts_of_has_binary_and_terminal : has_finite_coproducts C := -⟨λ J 𝒥₁ 𝒥₂, begin - resetI, - let e := fintype.equiv_fin J, - apply has_colimits_of_shape_of_equivalence (discrete.equivalence (e.trans equiv.ulift.symm)).symm, - refine has_colimits_of_shape_ulift_fin (fintype.card J), -end⟩ +end end section preserves variables (F : C ⥤ D) -variables [preserves_colimits_of_shape (discrete.{v} walking_pair) F] -variables [preserves_colimits_of_shape (discrete.{v} pempty) F] +variables [preserves_colimits_of_shape (discrete walking_pair) F] +variables [preserves_colimits_of_shape (discrete.{0} pempty) F] variables [has_finite_coproducts.{v} C] /-- If `F` preserves the initial object and binary coproducts, then it preserves products indexed by -`ulift (fin n)` for any `n`. +`fin n` for any `n`. -/ noncomputable def preserves_fin_of_preserves_binary_and_initial : - Π (n : ℕ) (f : ulift.{v} (fin n) → C), preserves_colimit (discrete.functor f) F + Π (n : ℕ) (f : fin n → C), preserves_colimit (discrete.functor f) F | 0 := λ f, begin - letI : preserves_colimits_of_shape (discrete (ulift (fin 0))) F := - preserves_colimits_of_shape_of_equiv.{v v} - (discrete.equivalence (equiv.ulift.trans fin_zero_equiv').symm) _, + letI : preserves_colimits_of_shape (discrete (fin 0)) F := + preserves_colimits_of_shape_of_equiv.{0 0} + (discrete.equivalence fin_zero_equiv'.symm) _, apply_instance, end | (n+1) := @@ -346,7 +310,7 @@ noncomputable def preserves_fin_of_preserves_binary_and_initial : haveI := preserves_fin_of_preserves_binary_and_initial n, intro f, refine preserves_colimit_of_preserves_colimit_cocone - (extend_cofan_is_colimit f (colimit.is_colimit.{v} _) (colimit.is_colimit _)) _, + (extend_cofan_is_colimit f (colimit.is_colimit _) (colimit.is_colimit _)) _, apply (is_colimit_map_cocone_cofan_mk_equiv _ _ _).symm _, let := extend_cofan_is_colimit (λ i, F.obj (f i)) (is_colimit_of_has_coproduct_of_preserves_colimit F _) @@ -366,27 +330,26 @@ noncomputable def preserves_fin_of_preserves_binary_and_initial : /-- If `F` preserves the initial object and binary coproducts, then it preserves colimits of shape -`discrete (ulift (fin n))`. +`discrete (fin n)`. -/ -def preserves_ulift_fin_of_preserves_binary_and_initial (n : ℕ) : - preserves_colimits_of_shape (discrete (ulift (fin n))) F := +def preserves_shape_fin_of_preserves_binary_and_initial (n : ℕ) : + preserves_colimits_of_shape (discrete (fin n)) F := { preserves_colimit := λ K, begin - let : discrete.functor K.obj ≅ K := discrete.nat_iso (λ i, iso.refl _), - haveI := preserves_fin_of_preserves_binary_and_initial F n K.obj, + let : discrete.functor (λ n, K.obj ⟨n⟩) ≅ K := discrete.nat_iso (λ ⟨i⟩, iso.refl _), + haveI := preserves_fin_of_preserves_binary_and_initial F n (λ n, K.obj ⟨n⟩), apply preserves_colimit_of_iso_diagram F this, end } /-- If `F` preserves the initial object and binary coproducts then it preserves finite products. -/ def preserves_finite_coproducts_of_preserves_binary_and_initial - (J : Type v) [fintype J] : - preserves_colimits_of_shape.{v} (discrete J) F := + (J : Type) [fintype J] : + preserves_colimits_of_shape (discrete J) F := begin classical, let e := fintype.equiv_fin J, - haveI := preserves_ulift_fin_of_preserves_binary_and_initial F (fintype.card J), - apply preserves_colimits_of_shape_of_equiv.{v v} - (discrete.equivalence (e.trans equiv.ulift.symm)).symm, + haveI := preserves_shape_fin_of_preserves_binary_and_initial F (fintype.card J), + apply preserves_colimits_of_shape_of_equiv.{0 0} (discrete.equivalence e).symm, end end preserves diff --git a/src/category_theory/limits/constructions/limits_of_products_and_equalizers.lean b/src/category_theory/limits/constructions/limits_of_products_and_equalizers.lean index 910463e7a3a9f..c022171b26cb2 100644 --- a/src/category_theory/limits/constructions/limits_of_products_and_equalizers.lean +++ b/src/category_theory/limits/constructions/limits_of_products_and_equalizers.lean @@ -3,15 +3,23 @@ Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta, Scott Morrison -/ +import data.fintype.prod +import data.fintype.sigma import category_theory.limits.shapes.equalizers import category_theory.limits.shapes.finite_products import category_theory.limits.preserves.shapes.products import category_theory.limits.preserves.shapes.equalizers import category_theory.limits.preserves.finite +import category_theory.limits.constructions.finite_products_of_binary_products +import category_theory.limits.constructions.equalizers +import category_theory.limits.constructions.binary_products /-! # Constructing limits from products and equalizers. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If a category has all products, and all equalizers, then it has all limits. Similarly, if it has all finite products, and all equalizers, then it has all finite limits. @@ -29,10 +37,10 @@ open opposite namespace category_theory.limits -universes v u u₂ +universes w v v₂ u u₂ variables {C : Type u} [category.{v} C] -variables {J : Type v} [small_category J] +variables {J : Type w} [small_category J] -- We hide the "implementation details" inside a namespace namespace has_limit_of_has_products_of_has_equalizers @@ -41,8 +49,8 @@ variables {F : J ⥤ C} {c₁ : fan F.obj} {c₂ : fan (λ f : (Σ p : J × J, p.1 ⟶ p.2), F.obj f.1.2)} (s t : c₁.X ⟶ c₂.X) - (hs : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), s ≫ c₂.π.app f = c₁.π.app f.1.1 ≫ F.map f.2) - (ht : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), t ≫ c₂.π.app f = c₁.π.app f.1.2) + (hs : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), s ≫ c₂.π.app ⟨f⟩ = c₁.π.app ⟨f.1.1⟩ ≫ F.map f.2) + (ht : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), t ≫ c₂.π.app ⟨f⟩ = c₁.π.app ⟨f.1.2⟩) (i : fork s t) include hs ht @@ -54,7 +62,7 @@ limiting if the given cones are also. def build_limit : cone F := { X := i.X, π := - { app := λ j, i.ι ≫ c₁.π.app _, + { app := λ j, i.ι ≫ c₁.π.app ⟨_⟩, naturality' := λ j₁ j₂ f, begin dsimp, rw [category.id_comp, category.assoc, ← hs ⟨⟨_, _⟩, f⟩, i.condition_assoc, ht], @@ -73,9 +81,11 @@ def build_is_limit (t₁ : is_limit c₁) (t₂ : is_limit c₂) (hi : is_limit { refine t₁.lift (fan.mk _ (λ j, _)), apply q.π.app j }, { apply t₂.hom_ext, + intro j, discrete_cases, simp [hs, ht] }, end, - uniq' := λ q m w, hi.hom_ext (i.equalizer_ext (t₁.hom_ext (by simpa using w))) } + uniq' := λ q m w, hi.hom_ext (i.equalizer_ext (t₁.hom_ext + (λ j, by { cases j, simpa using w j }))) } end has_limit_of_has_products_of_has_equalizers @@ -94,8 +104,8 @@ def limit_cone_of_equalizer_and_product (F : J ⥤ C) { cone := _, is_limit := build_is_limit - (pi.lift (λ f, limit.π _ _ ≫ F.map f.2)) - (pi.lift (λ f, limit.π _ f.1.2)) + (pi.lift (λ f, limit.π (discrete.functor F.obj) ⟨_⟩ ≫ F.map f.2)) + (pi.lift (λ f, limit.π (discrete.functor F.obj) ⟨f.1.2⟩)) (by simp) (by simp) (limit.is_limit _) @@ -115,11 +125,11 @@ has_limit.mk (limit_cone_of_equalizer_and_product F) /-- A limit can be realised as a subobject of a product. -/ noncomputable -def limit_subobject_product [has_limits C] (F : J ⥤ C) : +def limit_subobject_product [has_limits_of_size.{w w} C] (F : J ⥤ C) : limit F ⟶ ∏ (λ j, F.obj j) := (limit.iso_limit_cone (limit_cone_of_equalizer_and_product F)).hom ≫ equalizer.ι _ _ -instance limit_subobject_product_mono [has_limits C] (F : J ⥤ C) : +instance limit_subobject_product_mono [has_limits_of_size.{w w} C] (F : J ⥤ C) : mono (limit_subobject_product F) := mono_comp _ _ @@ -128,8 +138,8 @@ Any category with products and equalizers has all limits. See . -/ -lemma limits_from_equalizers_and_products - [has_products C] [has_equalizers C] : has_limits C := +lemma has_limits_of_has_equalizers_and_products + [has_products.{w} C] [has_equalizers C] : has_limits_of_size.{w w} C := { has_limits_of_shape := λ J 𝒥, { has_limit := λ F, by exactI has_limit_of_equalizer_and_product F } } @@ -138,22 +148,22 @@ Any category with finite products and equalizers has all finite limits. See . -/ -lemma finite_limits_from_equalizers_and_finite_products +lemma has_finite_limits_of_has_equalizers_and_finite_products [has_finite_products C] [has_equalizers C] : has_finite_limits C := ⟨λ J _ _, { has_limit := λ F, by exactI has_limit_of_equalizer_and_product F }⟩ -variables {D : Type u₂} [category.{v} D] +variables {D : Type u₂} [category.{v₂} D] noncomputable theory section -variables [has_limits_of_shape (discrete.{v} J) C] - [has_limits_of_shape (discrete.{v} (Σ p : J × J, p.1 ⟶ p.2)) C] +variables [has_limits_of_shape (discrete J) C] + [has_limits_of_shape (discrete (Σ p : J × J, p.1 ⟶ p.2)) C] [has_equalizers C] variables (G : C ⥤ D) - [preserves_limits_of_shape walking_parallel_pair.{v} G] - [preserves_limits_of_shape (discrete.{v} J) G] - [preserves_limits_of_shape (discrete.{v} (Σ p : J × J, p.1 ⟶ p.2)) G] + [preserves_limits_of_shape walking_parallel_pair G] + [preserves_limits_of_shape (discrete.{w} J) G] + [preserves_limits_of_shape (discrete.{w} (Σ p : J × J, p.1 ⟶ p.2)) G] /-- If a functor preserves equalizers and the appropriate products, it preserves limits. -/ def preserves_limit_of_preserves_equalizers_and_product : @@ -162,8 +172,8 @@ def preserves_limit_of_preserves_equalizers_and_product : begin let P := ∏ K.obj, let Q := ∏ (λ (f : (Σ (p : J × J), p.fst ⟶ p.snd)), K.obj f.1.2), - let s : P ⟶ Q := pi.lift (λ f, limit.π _ _ ≫ K.map f.2), - let t : P ⟶ Q := pi.lift (λ f, limit.π _ f.1.2), + let s : P ⟶ Q := pi.lift (λ f, limit.π (discrete.functor K.obj) ⟨_⟩ ≫ K.map f.2), + let t : P ⟶ Q := pi.lift (λ f, limit.π (discrete.functor K.obj) ⟨f.1.2⟩), let I := equalizer s t, let i : I ⟶ P := equalizer.ι s t, apply preserves_limit_of_preserves_limit_cone @@ -198,20 +208,43 @@ end /-- If G preserves equalizers and finite products, it preserves finite limits. -/ def preserves_finite_limits_of_preserves_equalizers_and_finite_products [has_equalizers C] [has_finite_products C] - (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair.{v} G] - [∀ J [fintype J], preserves_limits_of_shape (discrete.{v} J) G] : + (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair G] + [∀ (J : Type) [fintype J], preserves_limits_of_shape (discrete J) G] : preserves_finite_limits G := ⟨λ _ _ _, by exactI preserves_limit_of_preserves_equalizers_and_product G⟩ /-- If G preserves equalizers and products, it preserves all limits. -/ def preserves_limits_of_preserves_equalizers_and_products - [has_equalizers C] [has_products C] - (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair.{v} G] - [∀ J, preserves_limits_of_shape (discrete.{v} J) G] : -preserves_limits G := + [has_equalizers C] [has_products.{w} C] + (G : C ⥤ D) [preserves_limits_of_shape walking_parallel_pair G] + [∀ J, preserves_limits_of_shape (discrete.{w} J) G] : +preserves_limits_of_size.{w w} G := { preserves_limits_of_shape := λ J 𝒥, by exactI preserves_limit_of_preserves_equalizers_and_product G } +lemma has_finite_limits_of_has_terminal_and_pullbacks [has_terminal C] [has_pullbacks C] : + has_finite_limits C := +@@has_finite_limits_of_has_equalizers_and_finite_products _ + (@@has_finite_products_of_has_binary_and_terminal _ + (has_binary_products_of_has_terminal_and_pullbacks C) infer_instance) + (@@has_equalizers_of_has_pullbacks_and_binary_products _ + (has_binary_products_of_has_terminal_and_pullbacks C) infer_instance) + +/-- If G preserves terminal objects and pullbacks, it preserves all finite limits. -/ +def preserves_finite_limits_of_preserves_terminal_and_pullbacks + [has_terminal C] [has_pullbacks C] (G : C ⥤ D) + [preserves_limits_of_shape (discrete.{0} pempty) G] + [preserves_limits_of_shape walking_cospan G] : +preserves_finite_limits G := +begin + haveI : has_finite_limits C := has_finite_limits_of_has_terminal_and_pullbacks, + haveI : preserves_limits_of_shape (discrete walking_pair) G := + preserves_binary_products_of_preserves_terminal_and_pullbacks G, + exact @@preserves_finite_limits_of_preserves_equalizers_and_finite_products _ _ _ _ G + (preserves_equalizers_of_preserves_pullbacks_and_binary_products G) + (preserves_finite_products_of_preserves_binary_and_terminal G), +end + /-! We now dualize the above constructions, resorting to copy-paste. -/ @@ -223,8 +256,8 @@ variables {F : J ⥤ C} {c₁ : cofan (λ f : (Σ p : J × J, p.1 ⟶ p.2), F.obj f.1.1)} {c₂ : cofan F.obj} (s t : c₁.X ⟶ c₂.X) - (hs : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), c₁.ι.app f ≫ s = F.map f.2 ≫ c₂.ι.app f.1.2) - (ht : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), c₁.ι.app f ≫ t = c₂.ι.app f.1.1) + (hs : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), c₁.ι.app ⟨f⟩ ≫ s = F.map f.2 ≫ c₂.ι.app ⟨f.1.2⟩) + (ht : ∀ (f : Σ p : J × J, p.1 ⟶ p.2), c₁.ι.app ⟨f⟩ ≫ t = c₂.ι.app ⟨f.1.1⟩) (i : cofork s t) include hs ht @@ -236,7 +269,7 @@ build the cocone for `F` which is colimiting if the given cocones are also. def build_colimit : cocone F := { X := i.X, ι := - { app := λ j, c₂.ι.app _ ≫ i.π, + { app := λ j, c₂.ι.app ⟨_⟩ ≫ i.π, naturality' := λ j₁ j₂ f, begin dsimp, rw [category.comp_id, ←reassoc_of (hs ⟨⟨_, _⟩, f⟩), i.condition, ←category.assoc, ht], @@ -255,9 +288,11 @@ def build_is_colimit (t₁ : is_colimit c₁) (t₂ : is_colimit c₂) (hi : is_ { refine t₂.desc (cofan.mk _ (λ j, _)), apply q.ι.app j }, { apply t₁.hom_ext, + intro j, discrete_cases, simp [reassoc_of hs, reassoc_of ht] }, end, - uniq' := λ q m w, hi.hom_ext (i.coequalizer_ext (t₂.hom_ext (by simpa using w))) } + uniq' := λ q m w, hi.hom_ext (i.coequalizer_ext (t₂.hom_ext + (λ j, by { cases j, simpa using w j }))) } end has_colimit_of_has_coproducts_of_has_coequalizers @@ -276,8 +311,8 @@ def colimit_cocone_of_coequalizer_and_coproduct (F : J ⥤ C) { cocone := _, is_colimit := build_is_colimit - (sigma.desc (λ f, F.map f.2 ≫ colimit.ι (discrete.functor F.obj) f.1.2)) - (sigma.desc (λ f, colimit.ι (discrete.functor F.obj) f.1.1)) + (sigma.desc (λ f, F.map f.2 ≫ colimit.ι (discrete.functor F.obj) ⟨f.1.2⟩)) + (sigma.desc (λ f, colimit.ι (discrete.functor F.obj) ⟨f.1.1⟩)) (by simp) (by simp) (colimit.is_colimit _) @@ -298,11 +333,11 @@ has_colimit.mk (colimit_cocone_of_coequalizer_and_coproduct F) /-- A colimit can be realised as a quotient of a coproduct. -/ noncomputable -def colimit_quotient_coproduct [has_colimits C] (F : J ⥤ C) : +def colimit_quotient_coproduct [has_colimits_of_size.{w w} C] (F : J ⥤ C) : ∐ (λ j, F.obj j) ⟶ colimit F := coequalizer.π _ _ ≫ (colimit.iso_colimit_cocone (colimit_cocone_of_coequalizer_and_coproduct F)).inv -instance colimit_quotient_coproduct_epi [has_colimits C] (F : J ⥤ C) : +instance colimit_quotient_coproduct_epi [has_colimits_of_size.{w w} C] (F : J ⥤ C) : epi (colimit_quotient_coproduct F) := epi_comp _ _ @@ -311,8 +346,8 @@ Any category with coproducts and coequalizers has all colimits. See . -/ -lemma colimits_from_coequalizers_and_coproducts - [has_coproducts C] [has_coequalizers C] : has_colimits C := +lemma has_colimits_of_has_coequalizers_and_coproducts + [has_coproducts.{w} C] [has_coequalizers C] : has_colimits_of_size.{w w} C := { has_colimits_of_shape := λ J 𝒥, { has_colimit := λ F, by exactI has_colimit_of_coequalizer_and_coproduct F } } @@ -321,7 +356,7 @@ Any category with finite coproducts and coequalizers has all finite colimits. See . -/ -lemma finite_colimits_from_coequalizers_and_finite_coproducts +lemma has_finite_colimits_of_has_coequalizers_and_finite_coproducts [has_finite_coproducts C] [has_coequalizers C] : has_finite_colimits C := ⟨λ J _ _, { has_colimit := λ F, by exactI has_colimit_of_coequalizer_and_coproduct F }⟩ @@ -329,13 +364,13 @@ noncomputable theory section -variables [has_colimits_of_shape (discrete.{v} J) C] - [has_colimits_of_shape (discrete.{v} (Σ p : J × J, p.1 ⟶ p.2)) C] +variables [has_colimits_of_shape (discrete.{w} J) C] + [has_colimits_of_shape (discrete.{w} (Σ p : J × J, p.1 ⟶ p.2)) C] [has_coequalizers C] variables (G : C ⥤ D) - [preserves_colimits_of_shape walking_parallel_pair.{v} G] - [preserves_colimits_of_shape (discrete.{v} J) G] - [preserves_colimits_of_shape (discrete.{v} (Σ p : J × J, p.1 ⟶ p.2)) G] + [preserves_colimits_of_shape walking_parallel_pair G] + [preserves_colimits_of_shape (discrete.{w} J) G] + [preserves_colimits_of_shape (discrete.{w} (Σ p : J × J, p.1 ⟶ p.2)) G] /-- If a functor preserves coequalizers and the appropriate coproducts, it preserves colimits. -/ def preserves_colimit_of_preserves_coequalizers_and_coproduct : @@ -344,8 +379,8 @@ def preserves_colimit_of_preserves_coequalizers_and_coproduct : begin let P := ∐ K.obj, let Q := ∐ (λ (f : (Σ (p : J × J), p.fst ⟶ p.snd)), K.obj f.1.1), - let s : Q ⟶ P := sigma.desc (λ f, K.map f.2 ≫ colimit.ι (discrete.functor K.obj) _), - let t : Q ⟶ P := sigma.desc (λ f, colimit.ι (discrete.functor K.obj) f.1.1), + let s : Q ⟶ P := sigma.desc (λ f, K.map f.2 ≫ colimit.ι (discrete.functor K.obj) ⟨_⟩), + let t : Q ⟶ P := sigma.desc (λ f, colimit.ι (discrete.functor K.obj) ⟨f.1.1⟩), let I := coequalizer s t, let i : P ⟶ I := coequalizer.π s t, apply preserves_colimit_of_preserves_colimit_cocone @@ -380,18 +415,41 @@ end /-- If G preserves coequalizers and finite coproducts, it preserves finite colimits. -/ def preserves_finite_colimits_of_preserves_coequalizers_and_finite_coproducts [has_coequalizers C] [has_finite_coproducts C] - (G : C ⥤ D) [preserves_colimits_of_shape walking_parallel_pair.{v} G] - [∀ J [fintype J], preserves_colimits_of_shape (discrete.{v} J) G] : + (G : C ⥤ D) [preserves_colimits_of_shape walking_parallel_pair G] + [∀ J [fintype J], preserves_colimits_of_shape (discrete.{0} J) G] : preserves_finite_colimits G := ⟨λ _ _ _, by exactI preserves_colimit_of_preserves_coequalizers_and_coproduct G⟩ /-- If G preserves coequalizers and coproducts, it preserves all colimits. -/ def preserves_colimits_of_preserves_coequalizers_and_coproducts - [has_coequalizers C] [has_coproducts C] - (G : C ⥤ D) [preserves_colimits_of_shape walking_parallel_pair.{v} G] - [∀ J, preserves_colimits_of_shape (discrete.{v} J) G] : -preserves_colimits G := + [has_coequalizers C] [has_coproducts.{w} C] + (G : C ⥤ D) [preserves_colimits_of_shape walking_parallel_pair G] + [∀ J, preserves_colimits_of_shape (discrete.{w} J) G] : +preserves_colimits_of_size.{w} G := { preserves_colimits_of_shape := λ J 𝒥, by exactI preserves_colimit_of_preserves_coequalizers_and_coproduct G } +lemma has_finite_colimits_of_has_initial_and_pushouts [has_initial C] [has_pushouts C] : + has_finite_colimits C := +@@has_finite_colimits_of_has_coequalizers_and_finite_coproducts _ + (@@has_finite_coproducts_of_has_binary_and_initial _ + (has_binary_coproducts_of_has_initial_and_pushouts C) infer_instance) + (@@has_coequalizers_of_has_pushouts_and_binary_coproducts _ + (has_binary_coproducts_of_has_initial_and_pushouts C) infer_instance) + +/-- If G preserves initial objects and pushouts, it preserves all finite colimits. -/ +def preserves_finite_colimits_of_preserves_initial_and_pushouts + [has_initial C] [has_pushouts C] (G : C ⥤ D) + [preserves_colimits_of_shape (discrete.{0} pempty) G] + [preserves_colimits_of_shape walking_span G] : +preserves_finite_colimits G := +begin + haveI : has_finite_colimits C := has_finite_colimits_of_has_initial_and_pushouts, + haveI : preserves_colimits_of_shape (discrete walking_pair) G := + preserves_binary_coproducts_of_preserves_initial_and_pushouts G, + exact @@preserves_finite_colimits_of_preserves_coequalizers_and_finite_coproducts _ _ _ _ G + (preserves_coequalizers_of_preserves_pushouts_and_binary_coproducts G) + (preserves_finite_coproducts_of_preserves_binary_and_initial G), +end + end category_theory.limits diff --git a/src/category_theory/limits/constructions/over/basic.lean b/src/category_theory/limits/constructions/over/basic.lean new file mode 100644 index 0000000000000..9e71f7f3ed156 --- /dev/null +++ b/src/category_theory/limits/constructions/over/basic.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2018 Johan Commelin. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johan Commelin, Reid Barton, Bhavik Mehta +-/ +import category_theory.limits.connected +import category_theory.limits.constructions.over.products +import category_theory.limits.constructions.over.connected +import category_theory.limits.constructions.limits_of_products_and_equalizers +import category_theory.limits.constructions.equalizers + +/-! +# Limits in the over category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Declare instances for limits in the over category: If `C` has finite wide pullbacks, `over B` has +finite limits, and if `C` has arbitrary wide pullbacks then `over B` has limits. +-/ +universes w v u -- morphism levels before object levels. See note [category_theory universes]. + +open category_theory category_theory.limits + +variables {C : Type u} [category.{v} C] +variable {X : C} + +namespace category_theory.over + +/-- Make sure we can derive pullbacks in `over B`. -/ +instance {B : C} [has_pullbacks C] : has_pullbacks (over B) := +begin + letI : has_limits_of_shape (ulift_hom.{v} (ulift.{v} walking_cospan)) C := + has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{v} _), + letI : category (ulift_hom.{v} (ulift.{v} walking_cospan)) := infer_instance, + exact has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{v v} _).symm, +end + +/-- Make sure we can derive equalizers in `over B`. -/ +instance {B : C} [has_equalizers C] : has_equalizers (over B) := +begin + letI : has_limits_of_shape (ulift_hom.{v} (ulift.{v} walking_parallel_pair)) C := + has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{v} _), + letI : category (ulift_hom.{v} (ulift.{v} walking_parallel_pair)) := infer_instance, + exact has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{v v} _).symm, +end + +instance has_finite_limits {B : C} [has_finite_wide_pullbacks C] : has_finite_limits (over B) := +begin + apply @has_finite_limits_of_has_equalizers_and_finite_products _ _ _ _, + { exact construct_products.over_finite_products_of_finite_wide_pullbacks, }, + { apply @has_equalizers_of_has_pullbacks_and_binary_products _ _ _ _, + { haveI : has_pullbacks C := ⟨by apply_instance⟩, + exact construct_products.over_binary_product_of_pullback }, + { apply_instance, } } +end + +instance has_limits {B : C} [has_wide_pullbacks.{w} C] : has_limits_of_size.{w} (over B) := +begin + apply @has_limits_of_has_equalizers_and_products _ _ _ _, + { exact construct_products.over_products_of_wide_pullbacks }, + { apply @has_equalizers_of_has_pullbacks_and_binary_products _ _ _ _, + { haveI : has_pullbacks C := ⟨infer_instance⟩, + exact construct_products.over_binary_product_of_pullback }, + { apply_instance, } } +end + +end category_theory.over diff --git a/src/category_theory/limits/constructions/over/connected.lean b/src/category_theory/limits/constructions/over/connected.lean index 8852f4b275d68..c09beeb8112d4 100644 --- a/src/category_theory/limits/constructions/over/connected.lean +++ b/src/category_theory/limits/constructions/over/connected.lean @@ -10,6 +10,9 @@ import category_theory.is_connected /-! # Connected limits in the over category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Shows that the forgetful functor `over B ⥤ C` creates connected limits, in particular `over B` has any connected limit which `C` has. -/ diff --git a/src/category_theory/limits/constructions/over/default.lean b/src/category_theory/limits/constructions/over/default.lean deleted file mode 100644 index f3e8c43281086..0000000000000 --- a/src/category_theory/limits/constructions/over/default.lean +++ /dev/null @@ -1,54 +0,0 @@ -/- -Copyright (c) 2018 Johan Commelin. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johan Commelin, Reid Barton, Bhavik Mehta --/ -import category_theory.limits.connected -import category_theory.limits.constructions.over.products -import category_theory.limits.constructions.over.connected -import category_theory.limits.constructions.limits_of_products_and_equalizers -import category_theory.limits.constructions.equalizers - -/-! -# Limits in the over category - -Declare instances for limits in the over category: If `C` has finite wide pullbacks, `over B` has -finite limits, and if `C` has arbitrary wide pullbacks then `over B` has limits. --/ -universes v u -- morphism levels before object levels. See note [category_theory universes]. - -open category_theory category_theory.limits - -variables {J : Type v} [small_category J] -variables {C : Type u} [category.{v} C] -variable {X : C} - -namespace category_theory.over - -/-- Make sure we can derive pullbacks in `over B`. -/ -example {B : C} [has_pullbacks C] : has_pullbacks (over B) := by apply_instance - -/-- Make sure we can derive equalizers in `over B`. -/ -example {B : C} [has_equalizers C] : has_equalizers (over B) := by apply_instance - -instance has_finite_limits {B : C} [has_finite_wide_pullbacks C] : has_finite_limits (over B) := -begin - apply @finite_limits_from_equalizers_and_finite_products _ _ _ _, - { exact construct_products.over_finite_products_of_finite_wide_pullbacks, }, - { apply @has_equalizers_of_pullbacks_and_binary_products _ _ _ _, - { haveI : has_pullbacks C := ⟨by apply_instance⟩, - exact construct_products.over_binary_product_of_pullback }, - { apply_instance, } } -end - -instance has_limits {B : C} [has_wide_pullbacks C] : has_limits (over B) := -begin - apply @limits_from_equalizers_and_products _ _ _ _, - { exact construct_products.over_products_of_wide_pullbacks }, - { apply @has_equalizers_of_pullbacks_and_binary_products _ _ _ _, - { haveI : has_pullbacks C := ⟨by apply_instance⟩, - exact construct_products.over_binary_product_of_pullback }, - { apply_instance, } } -end - -end category_theory.over diff --git a/src/category_theory/limits/constructions/over/products.lean b/src/category_theory/limits/constructions/over/products.lean index 75544c3ad3c87..d6f9073a3ab12 100644 --- a/src/category_theory/limits/constructions/over/products.lean +++ b/src/category_theory/limits/constructions/over/products.lean @@ -11,15 +11,18 @@ import category_theory.limits.shapes.finite_products /-! # Products in the over category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Shows that products in the over category can be derived from wide pullbacks in the base category. The main result is `over_product_of_wide_pullback`, which says that if `C` has `J`-indexed wide pullbacks, then `over B` has `J`-indexed products. -/ -universes v u -- morphism levels before object levels. See note [category_theory universes]. +universes w v u -- morphism levels before object levels. See note [category_theory universes]. open category_theory category_theory.limits -variables {J : Type v} +variables {J : Type w} variables {C : Type u} [category.{v} C] variable {X : C} @@ -33,17 +36,17 @@ Given a product diagram in `C/B`, construct the corresponding wide pullback diag in `C`. -/ @[reducible] -def wide_pullback_diagram_of_diagram_over (B : C) {J : Type v} (F : discrete J ⥤ over B) : +def wide_pullback_diagram_of_diagram_over (B : C) {J : Type w} (F : discrete J ⥤ over B) : wide_pullback_shape J ⥤ C := -wide_pullback_shape.wide_cospan B (λ j, (F.obj j).left) (λ j, (F.obj j).hom) +wide_pullback_shape.wide_cospan B (λ j, (F.obj ⟨j⟩).left) (λ j, (F.obj ⟨j⟩).hom) /-- (Impl) A preliminary definition to avoid timeouts. -/ @[simps] -def cones_equiv_inverse_obj (B : C) {J : Type v} (F : discrete J ⥤ over B) (c : cone F) : +def cones_equiv_inverse_obj (B : C) {J : Type w} (F : discrete J ⥤ over B) (c : cone F) : cone (wide_pullback_diagram_of_diagram_over B F) := { X := c.X.left, π := - { app := λ X, option.cases_on X c.X.hom (λ (j : J), (c.π.app j).left), + { app := λ X, option.cases_on X c.X.hom (λ (j : J), (c.π.app ⟨j⟩).left), -- `tidy` can do this using `case_bash`, but let's try to be a good `-T50000` citizen: naturality' := λ X Y f, begin @@ -55,7 +58,7 @@ def cones_equiv_inverse_obj (B : C) {J : Type v} (F : discrete J ⥤ over B) (c /-- (Impl) A preliminary definition to avoid timeouts. -/ @[simps] -def cones_equiv_inverse (B : C) {J : Type v} (F : discrete J ⥤ over B) : +def cones_equiv_inverse (B : C) {J : Type w} (F : discrete J ⥤ over B) : cone F ⥤ cone (wide_pullback_diagram_of_diagram_over B F) := { obj := cones_equiv_inverse_obj B F, map := λ c₁ c₂ f, @@ -65,18 +68,20 @@ def cones_equiv_inverse (B : C) {J : Type v} (F : discrete J ⥤ over B) : cases j, { simp }, { dsimp, - rw ← f.w j, + rw ← f.w ⟨j⟩, refl } end } } +local attribute [tidy] tactic.discrete_cases + /-- (Impl) A preliminary definition to avoid timeouts. -/ @[simps] -def cones_equiv_functor (B : C) {J : Type v} (F : discrete J ⥤ over B) : +def cones_equiv_functor (B : C) {J : Type w} (F : discrete J ⥤ over B) : cone (wide_pullback_diagram_of_diagram_over B F) ⥤ cone F := { obj := λ c, { X := over.mk (c.π.app none), π := - { app := λ j, over.hom_mk (c.π.app (some j)) + { app := λ ⟨j⟩, over.hom_mk (c.π.app (some j)) (by apply c.w (wide_pullback_shape.hom.term j)) } }, map := λ c₁ c₂ f, { hom := over.hom_mk f.hom } } @@ -130,17 +135,19 @@ lemma over_binary_product_of_pullback [has_pullbacks C] {B : C} : over_product_of_wide_pullback /-- Given all wide pullbacks in `C`, construct products in `C/B`. -/ -lemma over_products_of_wide_pullbacks [has_wide_pullbacks C] {B : C} : - has_products (over B) := +lemma over_products_of_wide_pullbacks [has_wide_pullbacks.{w} C] {B : C} : + has_products.{w} (over B) := λ J, over_product_of_wide_pullback /-- Given all finite wide pullbacks in `C`, construct finite products in `C/B`. -/ lemma over_finite_products_of_finite_wide_pullbacks [has_finite_wide_pullbacks C] {B : C} : has_finite_products (over B) := -⟨λ J 𝒥₁ 𝒥₂, by exactI over_product_of_wide_pullback⟩ +⟨λ n, over_product_of_wide_pullback⟩ end construct_products +local attribute [tidy] tactic.discrete_cases + /-- Construct terminal object in the over category. This isn't an instance as it's not typically the way we want to define terminal objects. @@ -151,10 +158,10 @@ lemma over_has_terminal (B : C) : has_terminal (over B) := { has_limit := λ F, has_limit.mk { cone := { X := over.mk (𝟙 _), - π := { app := λ p, pempty.elim p } }, + π := { app := λ p, p.as.elim } }, is_limit := { lift := λ s, over.hom_mk _, - fac' := λ _ j, j.elim, + fac' := λ _ j, j.as.elim, uniq' := λ s m _, begin ext, diff --git a/src/category_theory/limits/constructions/pullbacks.lean b/src/category_theory/limits/constructions/pullbacks.lean index ab1562ce95345..48895df94d5df 100644 --- a/src/category_theory/limits/constructions/pullbacks.lean +++ b/src/category_theory/limits/constructions/pullbacks.lean @@ -10,6 +10,9 @@ import category_theory.limits.shapes.pullbacks /-! # Constructing pullbacks from binary products and equalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If a category as binary products and equalizers, then it has pullbacks. Also, if a category has binary coproducts and coequalizers, then it has pushouts -/ diff --git a/src/category_theory/limits/constructions/weakly_initial.lean b/src/category_theory/limits/constructions/weakly_initial.lean index 0457a350e2dd3..54e737517a14c 100644 --- a/src/category_theory/limits/constructions/weakly_initial.lean +++ b/src/category_theory/limits/constructions/weakly_initial.lean @@ -10,6 +10,9 @@ import category_theory.limits.shapes.terminal /-! # Constructions related to weakly initial objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file gives constructions related to weakly initial objects, namely: * If a category has small products and a small weakly initial set of objects, then it has a weakly initial object. @@ -28,7 +31,7 @@ variables {C : Type u} [category.{v} C] If `C` has (small) products and a small weakly initial set of objects, then it has a weakly initial object. -/ -lemma has_weakly_initial_of_weakly_initial_set_and_has_products [has_products C] +lemma has_weakly_initial_of_weakly_initial_set_and_has_products [has_products.{v} C] {ι : Type v} {B : ι → C} (hB : ∀ (A : C), ∃ i, nonempty (B i ⟶ A)) : ∃ (T : C), ∀ X, nonempty (T ⟶ X) := ⟨∏ B, λ X, ⟨pi.π _ _ ≫ (hB X).some_spec.some⟩⟩ @@ -39,7 +42,7 @@ If `C` has (small) wide equalizers and a weakly initial object, then it has an i The initial object is constructed as the wide equalizer of all endomorphisms on the given weakly initial object. -/ -lemma has_initial_of_weakly_initial_and_has_wide_equalizers [has_wide_equalizers C] +lemma has_initial_of_weakly_initial_and_has_wide_equalizers [has_wide_equalizers.{v} C] {T : C} (hT : ∀ X, nonempty (T ⟶ X)) : has_initial C := begin @@ -56,7 +59,7 @@ begin { rw [category.assoc, category.assoc], apply wide_equalizer.condition (id : endos → endos) (h ≫ e ≫ i) }, rw [category.comp_id, cancel_mono_id i] at this, - haveI : split_epi e := ⟨i ≫ h, this⟩, + haveI : is_split_epi e := is_split_epi.mk' ⟨i ≫ h, this⟩, rw ←cancel_epi e, apply equalizer.condition }, exactI has_initial_of_unique (wide_equalizer (id : endos → endos)), diff --git a/src/category_theory/limits/constructions/zero_objects.lean b/src/category_theory/limits/constructions/zero_objects.lean new file mode 100644 index 0000000000000..a4d2f763aba75 --- /dev/null +++ b/src/category_theory/limits/constructions/zero_objects.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import category_theory.limits.shapes.pullbacks +import category_theory.limits.shapes.zero_morphisms +import category_theory.limits.constructions.binary_products + +/-! +# Limits involving zero objects + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Binary products and coproducts with a zero object always exist, +and pullbacks/pushouts over a zero object are products/coproducts. +-/ + +noncomputable theory + +open category_theory + +variables {C : Type*} [category C] + +namespace category_theory.limits + +variables [has_zero_object C] [has_zero_morphisms C] +open_locale zero_object + +/-- The limit cone for the product with a zero object. -/ +def binary_fan_zero_left (X : C) : binary_fan (0 : C) X := +binary_fan.mk 0 (𝟙 X) + +/-- The limit cone for the product with a zero object is limiting. -/ +def binary_fan_zero_left_is_limit (X : C) : is_limit (binary_fan_zero_left X) := +binary_fan.is_limit_mk (λ s, binary_fan.snd s) (by tidy) (by tidy) (by tidy) + +instance has_binary_product_zero_left (X : C) : has_binary_product (0 : C) X := +has_limit.mk ⟨_, binary_fan_zero_left_is_limit X⟩ + +/-- A zero object is a left unit for categorical product. -/ +def zero_prod_iso (X : C) : (0 : C) ⨯ X ≅ X := +limit.iso_limit_cone ⟨_, binary_fan_zero_left_is_limit X⟩ + +@[simp] lemma zero_prod_iso_hom (X : C) : (zero_prod_iso X).hom = prod.snd := +rfl +@[simp] lemma zero_prod_iso_inv_snd (X : C) : (zero_prod_iso X).inv ≫ prod.snd = 𝟙 X := +by { dsimp [zero_prod_iso, binary_fan_zero_left], simp, } + +/-- The limit cone for the product with a zero object. -/ +def binary_fan_zero_right (X : C) : binary_fan X (0 : C) := +binary_fan.mk (𝟙 X) 0 + +/-- The limit cone for the product with a zero object is limiting. -/ +def binary_fan_zero_right_is_limit (X : C) : is_limit (binary_fan_zero_right X) := +binary_fan.is_limit_mk (λ s, binary_fan.fst s) (by tidy) (by tidy) (by tidy) + +instance has_binary_product_zero_right (X : C) : has_binary_product X (0 : C) := +has_limit.mk ⟨_, binary_fan_zero_right_is_limit X⟩ + +/-- A zero object is a right unit for categorical product. -/ +def prod_zero_iso (X : C) : X ⨯ (0 : C) ≅ X := +limit.iso_limit_cone ⟨_, binary_fan_zero_right_is_limit X⟩ + +@[simp] lemma prod_zero_iso_hom (X : C) : (prod_zero_iso X).hom = prod.fst := +rfl +@[simp] lemma prod_zero_iso_iso_inv_snd (X : C) : (prod_zero_iso X).inv ≫ prod.fst = 𝟙 X := +by { dsimp [prod_zero_iso, binary_fan_zero_right], simp, } + +/-- The colimit cocone for the coproduct with a zero object. -/ +def binary_cofan_zero_left (X : C) : binary_cofan (0 : C) X := +binary_cofan.mk 0 (𝟙 X) + +/-- The colimit cocone for the coproduct with a zero object is colimiting. -/ +def binary_cofan_zero_left_is_colimit (X : C) : is_colimit (binary_cofan_zero_left X) := +binary_cofan.is_colimit_mk (λ s, binary_cofan.inr s) (by tidy) (by tidy) (by tidy) + +instance has_binary_coproduct_zero_left (X : C) : has_binary_coproduct (0 : C) X := +has_colimit.mk ⟨_, binary_cofan_zero_left_is_colimit X⟩ + +/-- A zero object is a left unit for categorical coproduct. -/ +def zero_coprod_iso (X : C) : (0 : C) ⨿ X ≅ X := +colimit.iso_colimit_cocone ⟨_, binary_cofan_zero_left_is_colimit X⟩ + +@[simp] lemma inr_zero_coprod_iso_hom (X : C) : coprod.inr ≫ (zero_coprod_iso X).hom = 𝟙 X := +by { dsimp [zero_coprod_iso, binary_cofan_zero_left], simp, } +@[simp] lemma zero_coprod_iso_inv (X : C) : (zero_coprod_iso X).inv = coprod.inr := +rfl + +/-- The colimit cocone for the coproduct with a zero object. -/ +def binary_cofan_zero_right (X : C) : binary_cofan X (0 : C) := +binary_cofan.mk (𝟙 X) 0 + +/-- The colimit cocone for the coproduct with a zero object is colimiting. -/ +def binary_cofan_zero_right_is_colimit (X : C) : is_colimit (binary_cofan_zero_right X) := +binary_cofan.is_colimit_mk (λ s, binary_cofan.inl s) (by tidy) (by tidy) (by tidy) + +instance has_binary_coproduct_zero_right (X : C) : has_binary_coproduct X (0 : C) := +has_colimit.mk ⟨_, binary_cofan_zero_right_is_colimit X⟩ + +/-- A zero object is a right unit for categorical coproduct. -/ +def coprod_zero_iso (X : C) : X ⨿ (0 : C) ≅ X := +colimit.iso_colimit_cocone ⟨_, binary_cofan_zero_right_is_colimit X⟩ + +@[simp] lemma inr_coprod_zeroiso_hom (X : C) : coprod.inl ≫ (coprod_zero_iso X).hom = 𝟙 X := +by { dsimp [coprod_zero_iso, binary_cofan_zero_right], simp, } +@[simp] lemma coprod_zero_iso_inv (X : C) : (coprod_zero_iso X).inv = coprod.inl := +rfl + +instance has_pullback_over_zero + (X Y : C) [has_binary_product X Y] : has_pullback (0 : X ⟶ 0) (0 : Y ⟶ 0) := +has_limit.mk ⟨_, is_pullback_of_is_terminal_is_product _ _ _ _ + has_zero_object.zero_is_terminal (prod_is_prod X Y)⟩ + +/-- The pullback over the zeron object is the product. -/ +def pullback_zero_zero_iso (X Y : C) [has_binary_product X Y] : + pullback (0 : X ⟶ 0) (0 : Y ⟶ 0) ≅ X ⨯ Y := +limit.iso_limit_cone ⟨_, is_pullback_of_is_terminal_is_product _ _ _ _ + has_zero_object.zero_is_terminal (prod_is_prod X Y)⟩ + +@[simp] lemma pullback_zero_zero_iso_inv_fst (X Y : C) [has_binary_product X Y] : + (pullback_zero_zero_iso X Y).inv ≫ pullback.fst = prod.fst := +by { dsimp [pullback_zero_zero_iso], simp, } +@[simp] lemma pullback_zero_zero_iso_inv_snd (X Y : C) [has_binary_product X Y] : + (pullback_zero_zero_iso X Y).inv ≫ pullback.snd = prod.snd := +by { dsimp [pullback_zero_zero_iso], simp, } +@[simp] lemma pullback_zero_zero_iso_hom_fst (X Y : C) [has_binary_product X Y] : + (pullback_zero_zero_iso X Y).hom ≫ prod.fst = pullback.fst := +by { simp [←iso.eq_inv_comp], } +@[simp] lemma pullback_zero_zero_iso_hom_snd (X Y : C) [has_binary_product X Y] : + (pullback_zero_zero_iso X Y).hom ≫ prod.snd = pullback.snd := +by { simp [←iso.eq_inv_comp], } + +instance has_pushout_over_zero + (X Y : C) [has_binary_coproduct X Y] : has_pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) := +has_colimit.mk ⟨_, is_pushout_of_is_initial_is_coproduct _ _ _ _ + has_zero_object.zero_is_initial (coprod_is_coprod X Y)⟩ + +/-- The pushout over the zero object is the coproduct. -/ +def pushout_zero_zero_iso + (X Y : C) [has_binary_coproduct X Y] : pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) ≅ X ⨿ Y := +colimit.iso_colimit_cocone ⟨_, is_pushout_of_is_initial_is_coproduct _ _ _ _ + has_zero_object.zero_is_initial (coprod_is_coprod X Y)⟩ + +@[simp] lemma inl_pushout_zero_zero_iso_hom (X Y : C) [has_binary_coproduct X Y] : + pushout.inl ≫ (pushout_zero_zero_iso X Y).hom = coprod.inl := +by { dsimp [pushout_zero_zero_iso], simp, } +@[simp] lemma inr_pushout_zero_zero_iso_hom (X Y : C) [has_binary_coproduct X Y] : + pushout.inr ≫ (pushout_zero_zero_iso X Y).hom = coprod.inr := +by { dsimp [pushout_zero_zero_iso], simp, } +@[simp] lemma inl_pushout_zero_zero_iso_inv (X Y : C) [has_binary_coproduct X Y] : + coprod.inl ≫ (pushout_zero_zero_iso X Y).inv = pushout.inl := +by { simp [iso.comp_inv_eq], } +@[simp] lemma inr_pushout_zero_zero_iso_inv (X Y : C) [has_binary_coproduct X Y] : + coprod.inr ≫ (pushout_zero_zero_iso X Y).inv = pushout.inr := +by { simp [iso.comp_inv_eq], } + +end category_theory.limits diff --git a/src/category_theory/limits/creates.lean b/src/category_theory/limits/creates.lean index f2a49827b2e43..90a1acfea4603 100644 --- a/src/category_theory/limits/creates.lean +++ b/src/category_theory/limits/creates.lean @@ -5,6 +5,17 @@ Authors: Bhavik Mehta -/ import category_theory.limits.preserves.basic +/-! +# Creating (co)limits + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We say that `F` creates limits of `K` if, given any limit cone `c` for `K ⋙ F` +(i.e. below) we can lift it to a cone "above", and further that `F` reflects +limits for `K`. +-/ + open category_theory category_theory.limits noncomputable theory @@ -236,6 +247,21 @@ def creates_limit_of_reflects_iso {K : J ⥤ C} {F : C ⥤ D} [reflects_isomorph exact is_limit.of_iso_limit hd' (as_iso f).symm, end } } +/-- +When `F` is fully faithful, to show that `F` creates the limit for `K` it suffices to exhibit a lift +of a limit cone for `K ⋙ F`. +-/ +-- Notice however that even if the isomorphism is `iso.refl _`, +-- this construction will insert additional identity morphisms in the cone maps, +-- so the constructed limits may not be ideal, definitionally. +def creates_limit_of_fully_faithful_of_lift' {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] + {l : cone (K ⋙ F)} (hl : is_limit l) (c : cone K) (i : F.map_cone c ≅ l) : creates_limit K F := +creates_limit_of_reflects_iso (λ c' t, +{ lifted_cone := c, + valid_lift := i ≪≫ is_limit.unique_up_to_iso hl t, + makes_limit := is_limit.of_faithful F (is_limit.of_iso_limit hl i.symm) _ + (λ s, F.image_preimage _) }) + /-- When `F` is fully faithful, and `has_limit (K ⋙ F)`, to show that `F` creates the limit for `K` it suffices to exhibit a lift of the chosen limit cone for `K ⋙ F`. @@ -246,11 +272,23 @@ it suffices to exhibit a lift of the chosen limit cone for `K ⋙ F`. def creates_limit_of_fully_faithful_of_lift {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] [has_limit (K ⋙ F)] (c : cone K) (i : F.map_cone c ≅ limit.cone (K ⋙ F)) : creates_limit K F := -creates_limit_of_reflects_iso (λ c' t, -{ lifted_cone := c, - valid_lift := i.trans (is_limit.unique_up_to_iso (limit.is_limit _) t), - makes_limit := is_limit.of_faithful F (is_limit.of_iso_limit (limit.is_limit _) i.symm) - (λ s, F.preimage _) (λ s, F.image_preimage _) }) +creates_limit_of_fully_faithful_of_lift' (limit.is_limit _) c i + +/-- +When `F` is fully faithful, to show that `F` creates the limit for `K` it suffices to show that a +limit point is in the essential image of `F`. +-/ +-- Notice however that even if the isomorphism is `iso.refl _`, +-- this construction will insert additional identity morphisms in the cone maps, +-- so the constructed limits may not be ideal, definitionally. +def creates_limit_of_fully_faithful_of_iso' {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] + {l : cone (K ⋙ F)} (hl : is_limit l) (X : C) (i : F.obj X ≅ l.X) : creates_limit K F := +creates_limit_of_fully_faithful_of_lift' hl +({ X := X, + π := + { app := λ j, F.preimage (i.hom ≫ l.π.app j), + naturality' := λ Y Z f, F.map_injective $ by { dsimp, simpa using (l.w f).symm } } }) +(cones.ext i (λ j, by simp only [functor.image_preimage, functor.map_cone_π_app])) /-- When `F` is fully faithful, and `has_limit (K ⋙ F)`, to show that `F` creates the limit for `K` @@ -262,12 +300,7 @@ it suffices to show that the chosen limit point is in the essential image of `F` def creates_limit_of_fully_faithful_of_iso {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] [has_limit (K ⋙ F)] (X : C) (i : F.obj X ≅ limit (K ⋙ F)) : creates_limit K F := -creates_limit_of_fully_faithful_of_lift -({ X := X, - π := - { app := λ j, F.preimage (i.hom ≫ limit.π (K ⋙ F) j), - naturality' := λ Y Z f, F.map_injective (by { dsimp, simp, erw limit.w (K ⋙ F), }) }} : cone K) -(by { fapply cones.ext, exact i, tidy, }) +creates_limit_of_fully_faithful_of_iso' (limit.is_limit _) X i /-- `F` preserves the limit of `K` if it creates the limit and `K ⋙ F` has the limit. -/ @[priority 100] -- see Note [lower instance priority] @@ -316,6 +349,22 @@ def creates_colimit_of_reflects_iso {K : J ⥤ C} {F : C ⥤ D} [reflects_isomor exact is_colimit.of_iso_colimit hd' (as_iso f), end } } +/-- +When `F` is fully faithful, to show that `F` creates the colimit for `K` it suffices to exhibit a +lift of a colimit cocone for `K ⋙ F`. +-/ +-- Notice however that even if the isomorphism is `iso.refl _`, +-- this construction will insert additional identity morphisms in the cocone maps, +-- so the constructed colimits may not be ideal, definitionally. +def creates_colimit_of_fully_faithful_of_lift' {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] + {l : cocone (K ⋙ F)} (hl : is_colimit l) (c : cocone K) (i : F.map_cocone c ≅ l) : + creates_colimit K F := +creates_colimit_of_reflects_iso (λ c' t, +{ lifted_cocone := c, + valid_lift := i ≪≫ is_colimit.unique_up_to_iso hl t, + makes_colimit := is_colimit.of_faithful F (is_colimit.of_iso_colimit hl i.symm) _ + (λ s, F.image_preimage _) }) + /-- When `F` is fully faithful, and `has_colimit (K ⋙ F)`, to show that `F` creates the colimit for `K` it suffices to exhibit a lift of the chosen colimit cocone for `K ⋙ F`. @@ -326,12 +375,24 @@ it suffices to exhibit a lift of the chosen colimit cocone for `K ⋙ F`. def creates_colimit_of_fully_faithful_of_lift {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] [has_colimit (K ⋙ F)] (c : cocone K) (i : F.map_cocone c ≅ colimit.cocone (K ⋙ F)) : creates_colimit K F := -creates_colimit_of_reflects_iso (λ c' t, -{ lifted_cocone := c, - valid_lift := i.trans (is_colimit.unique_up_to_iso (colimit.is_colimit _) t), - makes_colimit := is_colimit.of_faithful F - (is_colimit.of_iso_colimit (colimit.is_colimit _) i.symm) - (λ s, F.preimage _) (λ s, F.image_preimage _) }) +creates_colimit_of_fully_faithful_of_lift' (colimit.is_colimit _) c i + +/-- +When `F` is fully faithful, to show that `F` creates the colimit for `K` it suffices to show that +a colimit point is in the essential image of `F`. +-/ +-- Notice however that even if the isomorphism is `iso.refl _`, +-- this construction will insert additional identity morphisms in the cocone maps, +-- so the constructed colimits may not be ideal, definitionally. +def creates_colimit_of_fully_faithful_of_iso' {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] + {l : cocone (K ⋙ F)} (hl : is_colimit l) (X : C) (i : F.obj X ≅ l.X) : creates_colimit K F := +creates_colimit_of_fully_faithful_of_lift' hl +({ X := X, + ι := + { app := λ j, F.preimage (l.ι.app j ≫ i.inv), + naturality' := λ Y Z f, F.map_injective $ + by { dsimp, simpa [← cancel_mono i.hom] using (l.w f) } } }) +(cocones.ext i (λ j, by simp)) /-- When `F` is fully faithful, and `has_colimit (K ⋙ F)`, to show that `F` creates the colimit for `K` @@ -343,14 +404,7 @@ it suffices to show that the chosen colimit point is in the essential image of ` def creates_colimit_of_fully_faithful_of_iso {K : J ⥤ C} {F : C ⥤ D} [full F] [faithful F] [has_colimit (K ⋙ F)] (X : C) (i : F.obj X ≅ colimit (K ⋙ F)) : creates_colimit K F := -creates_colimit_of_fully_faithful_of_lift -({ X := X, - ι := - { app := λ j, F.preimage (colimit.ι (K ⋙ F) j ≫ i.inv : _), - naturality' := λ Y Z f, F.map_injective - (by { erw category.comp_id, simp only [functor.map_comp, functor.image_preimage], - erw colimit.w_assoc (K ⋙ F) }) }} : cocone K) -(by { fapply cocones.ext, exact i, tidy, }) +creates_colimit_of_fully_faithful_of_iso' (colimit.is_colimit _) X i /-- `F` preserves the colimit of `K` if it creates the colimit and `K ⋙ F` has the colimit. -/ diff --git a/src/category_theory/limits/essentially_small.lean b/src/category_theory/limits/essentially_small.lean new file mode 100644 index 0000000000000..99b2104c7cefd --- /dev/null +++ b/src/category_theory/limits/essentially_small.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.limits.shapes.products +import category_theory.essentially_small + +/-! +# Limits over essentially small indexing categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +If `C` has limits of size `w` and `J` is `w`-essentially small, then `C` has limits of shape `J`. + +-/ + +universes w₁ w₂ v₁ v₂ u₁ u₂ + +noncomputable theory + +open category_theory + +namespace category_theory.limits +variables (J : Type u₂) [category.{v₂} J] (C : Type u₁) [category.{v₁} C] + +lemma has_limits_of_shape_of_essentially_small [essentially_small.{w₁} J] + [has_limits_of_size.{w₁ w₁} C] : has_limits_of_shape J C := +has_limits_of_shape_of_equivalence $ equivalence.symm $ equiv_small_model.{w₁} J + +lemma has_colimits_of_shape_of_essentially_small [essentially_small.{w₁} J] + [has_colimits_of_size.{w₁ w₁} C] : has_colimits_of_shape J C := +has_colimits_of_shape_of_equivalence $ equivalence.symm $ equiv_small_model.{w₁} J + +lemma has_products_of_shape_of_small (β : Type w₂) [small.{w₁} β] [has_products.{w₁} C] : + has_products_of_shape β C := +has_limits_of_shape_of_equivalence $ discrete.equivalence $ equiv.symm $ equiv_shrink β + +lemma has_coproducts_of_shape_of_small (β : Type w₂) [small.{w₁} β] [has_coproducts.{w₁} C] : + has_coproducts_of_shape β C := +has_colimits_of_shape_of_equivalence $ discrete.equivalence $ equiv.symm $ equiv_shrink β + +end category_theory.limits diff --git a/src/category_theory/limits/exact_functor.lean b/src/category_theory/limits/exact_functor.lean new file mode 100644 index 0000000000000..3446a771c886d --- /dev/null +++ b/src/category_theory/limits/exact_functor.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.limits.preserves.finite + +/-! +# Bundled exact functors + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We say that a functor `F` is left exact if it preserves finite limits, it is right exact if it +preserves finite colimits, and it is exact if it is both left exact and right exact. + +In this file, we define the categories of bundled left exact, right exact and exact functors. + +-/ + +universes v₁ v₂ u₁ u₂ + +open category_theory.limits + +namespace category_theory +variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] + +section +variables (C) (D) + +/-- Bundled left-exact functors. -/ +@[derive category, nolint has_nonempty_instance] +def LeftExactFunctor := +full_subcategory (λ F : C ⥤ D, nonempty (preserves_finite_limits F)) + +infixr ` ⥤ₗ `:26 := LeftExactFunctor + +/-- A left exact functor is in particular a functor. -/ +@[derive full, derive faithful] +def LeftExactFunctor.forget : (C ⥤ₗ D) ⥤ (C ⥤ D) := +full_subcategory_inclusion _ + +/-- Bundled right-exact functors. -/ +@[derive category, nolint has_nonempty_instance] +def RightExactFunctor := +full_subcategory (λ F : C ⥤ D, nonempty (preserves_finite_colimits F)) + +infixr ` ⥤ᵣ `:26 := RightExactFunctor + +/-- A right exact functor is in particular a functor. -/ +@[derive full, derive faithful] +def RightExactFunctor.forget : (C ⥤ᵣ D) ⥤ (C ⥤ D) := +full_subcategory_inclusion _ + +/-- Bundled exact functors. -/ +@[derive category, nolint has_nonempty_instance] +def ExactFunctor := full_subcategory + (λ F : C ⥤ D, nonempty (preserves_finite_limits F) ∧ nonempty (preserves_finite_colimits F)) + +infixr ` ⥤ₑ `:26 := ExactFunctor + +/-- An exact functor is in particular a functor. -/ +@[derive full, derive faithful] +def ExactFunctor.forget : (C ⥤ₑ D) ⥤ (C ⥤ D) := +full_subcategory_inclusion _ + +/-- Turn an exact functor into a left exact functor. -/ +@[derive full, derive faithful] +def LeftExactFunctor.of_exact : (C ⥤ₑ D) ⥤ (C ⥤ₗ D) := +full_subcategory.map (λ X, and.left) + +/-- Turn an exact functor into a left exact functor. -/ +@[derive full, derive faithful] +def RightExactFunctor.of_exact : (C ⥤ₑ D) ⥤ (C ⥤ᵣ D) := +full_subcategory.map (λ X, and.right) + +variables {C D} + +@[simp] lemma LeftExactFunctor.of_exact_obj (F : C ⥤ₑ D) : + (LeftExactFunctor.of_exact C D).obj F = ⟨F.1, F.2.1⟩ := rfl +@[simp] lemma RightExactFunctor.of_exact_obj (F : C ⥤ₑ D) : + (RightExactFunctor.of_exact C D).obj F = ⟨F.1, F.2.2⟩ := rfl + +@[simp] lemma LeftExactFunctor.of_exact_map {F G : C ⥤ₑ D} (α : F ⟶ G) : + (LeftExactFunctor.of_exact C D).map α = α := rfl +@[simp] lemma RightExactFunctor.of_exact_map {F G : C ⥤ₑ D} (α : F ⟶ G) : + (RightExactFunctor.of_exact C D).map α = α := rfl + +@[simp] lemma LeftExactFunctor.forget_obj (F : C ⥤ₗ D) : + (LeftExactFunctor.forget C D).obj F = F.1 := rfl +@[simp] lemma RightExactFunctor.forget_obj (F : C ⥤ᵣ D) : + (RightExactFunctor.forget C D).obj F = F.1 := rfl +@[simp] lemma ExactFunctor.forget_obj (F : C ⥤ₑ D) : + (ExactFunctor.forget C D).obj F = F.1 := rfl + +@[simp] lemma LeftExactFunctor.forget_map {F G : C ⥤ₗ D} (α : F ⟶ G) : + (LeftExactFunctor.forget C D).map α = α := rfl +@[simp] lemma RightExactFunctor.forget_map {F G : C ⥤ᵣ D} (α : F ⟶ G) : + (RightExactFunctor.forget C D).map α = α := rfl +@[simp] lemma ExactFunctor.forget_map {F G : C ⥤ₑ D} (α : F ⟶ G) : + (ExactFunctor.forget C D).map α = α := rfl + +/-- Turn a left exact functor into an object of the category `LeftExactFunctor C D`. -/ +def LeftExactFunctor.of (F : C ⥤ D) [preserves_finite_limits F] : C ⥤ₗ D := ⟨F, ⟨infer_instance⟩⟩ +/-- Turn a right exact functor into an object of the category `RightExactFunctor C D`. -/ +def RightExactFunctor.of (F : C ⥤ D) [preserves_finite_colimits F] : C ⥤ᵣ D := +⟨F, ⟨infer_instance⟩⟩ +/-- Turn an exact functor into an object of the category `ExactFunctor C D`. -/ +def ExactFunctor.of (F : C ⥤ D) [preserves_finite_limits F] [preserves_finite_colimits F] : + C ⥤ₑ D := ⟨F, ⟨⟨infer_instance⟩, ⟨infer_instance⟩⟩⟩ + +@[simp] lemma LeftExactFunctor.of_fst (F : C ⥤ D) [preserves_finite_limits F] : + (LeftExactFunctor.of F).obj = F := rfl +@[simp] lemma RightExactFunctor.of_fst (F : C ⥤ D) [preserves_finite_colimits F] : + (RightExactFunctor.of F).obj = F := rfl +@[simp] lemma ExactFunctor.of_fst (F : C ⥤ D) [preserves_finite_limits F] + [preserves_finite_colimits F] : (ExactFunctor.of F).obj = F := rfl + +lemma LeftExactFunctor.forget_obj_of (F : C ⥤ D) [preserves_finite_limits F] : + (LeftExactFunctor.forget C D).obj (LeftExactFunctor.of F) = F := rfl +lemma RightExactFunctor.forget_obj_of (F : C ⥤ D) [preserves_finite_colimits F] : + (RightExactFunctor.forget C D).obj (RightExactFunctor.of F) = F := rfl +lemma ExactFunctor.forget_obj_of (F : C ⥤ D) [preserves_finite_limits F] + [preserves_finite_colimits F] : (ExactFunctor.forget C D).obj (ExactFunctor.of F) = F := rfl + +noncomputable instance (F : C ⥤ₗ D) : preserves_finite_limits F.obj := F.property.some +noncomputable instance (F : C ⥤ᵣ D) : preserves_finite_colimits F.obj := F.property.some +noncomputable instance (F : C ⥤ₑ D) : preserves_finite_limits F.obj := F.property.1.some +noncomputable instance (F : C ⥤ₑ D) : preserves_finite_colimits F.obj := F.property.2.some + +end + +end category_theory diff --git a/src/category_theory/limits/filtered.lean b/src/category_theory/limits/filtered.lean new file mode 100644 index 0000000000000..2ac24e16f159b --- /dev/null +++ b/src/category_theory/limits/filtered.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.filtered +import category_theory.limits.has_limits + +/-! +# Possession of filtered colimits + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes w' w v u + +noncomputable theory + +open category_theory + +variables {C : Type u} [category.{v} C] + +namespace category_theory.limits + +section +variables (C) + +/-- Class for having all cofiltered limits of a given size. -/ +class has_cofiltered_limits_of_size : Prop := +(has_limits_of_shape : Π (I : Type w) [category.{w'} I] [is_cofiltered I], has_limits_of_shape I C) + +/-- Class for having all filtered colimits of a given size. -/ +class has_filtered_colimits_of_size : Prop := +(has_colimits_of_shape : Π (I : Type w) [category.{w'} I] [is_filtered I], + has_colimits_of_shape I C) + +end + +@[priority 100] +instance has_limits_of_shape_of_has_cofiltered_limits [has_cofiltered_limits_of_size.{w' w} C] + (I : Type w) [category.{w'} I] [is_cofiltered I] : has_limits_of_shape I C := +has_cofiltered_limits_of_size.has_limits_of_shape _ + +@[priority 100] +instance has_colimits_of_shape_of_has_filtered_colimits [has_filtered_colimits_of_size.{w' w} C] + (I : Type w) [category.{w'} I] [is_filtered I] : has_colimits_of_shape I C := +has_filtered_colimits_of_size.has_colimits_of_shape _ + +end category_theory.limits diff --git a/src/category_theory/limits/filtered_colimit_commutes_finite_limit.lean b/src/category_theory/limits/filtered_colimit_commutes_finite_limit.lean index e38d5c1d26f94..d320a23a66c89 100644 --- a/src/category_theory/limits/filtered_colimit_commutes_finite_limit.lean +++ b/src/category_theory/limits/filtered_colimit_commutes_finite_limit.lean @@ -13,6 +13,9 @@ import category_theory.concrete_category.basic /-! # Filtered colimits commute with finite limits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that for a functor `F : J × K ⥤ Type v`, when `J` is finite and `K` is filtered, the universal morphism `colimit_limit_to_limit_colimit F` comparing the colimit (over `K`) of the limits (over `J`) with the limit of the colimits is an isomorphism. @@ -45,7 +48,7 @@ section Injectivity doesn't need that we have finitely many morphisms in `J`, only that there are finitely many objects. -/ -variables [fintype J] +variables [finite J] /-- This follows this proof from @@ -55,13 +58,13 @@ lemma colimit_limit_to_limit_colimit_injective : function.injective (colimit_limit_to_limit_colimit F) := begin classical, - + casesI nonempty_fintype J, -- Suppose we have two terms `x y` in the colimit (over `K`) of the limits (over `J`), -- and that these have the same image under `colimit_limit_to_limit_colimit F`. intros x y h, -- These elements of the colimit have representatives somewhere: - obtain ⟨kx, x, rfl⟩ := jointly_surjective' x, - obtain ⟨ky, y, rfl⟩ := jointly_surjective' y, + obtain ⟨kx, x, rfl⟩ := jointly_surjective'.{v v} x, + obtain ⟨ky, y, rfl⟩ := jointly_surjective'.{v v} y, dsimp at x y, -- Since the images of `x` and `y` are equal in a limit, they are equal componentwise @@ -69,7 +72,7 @@ begin replace h := λ j, congr_arg (limit.π ((curry.obj F) ⋙ colim) j) h, -- and they are equations in a filtered colimit, -- so for each `j` we have some place `k j` to the right of both `kx` and `ky` - simp [colimit_eq_iff] at h, + simp [colimit_eq_iff.{v v}] at h, let k := λ j, (h j).some, let f : Π j, kx ⟶ k j := λ j, (h j).some_spec.some, let g : Π j, ky ⟶ k j := λ j, (h j).some_spec.some_spec.some, @@ -81,7 +84,7 @@ begin -- We now use that `K` is filtered, picking some point to the right of all these -- morphisms `f j` and `g j`. - let O : finset K := (finset.univ).image k ∪ {kx, ky}, + let O : finset K := finset.univ.image k ∪ {kx, ky}, have kxO : kx ∈ O := finset.mem_union.mpr (or.inr (by simp)), have kyO : ky ∈ O := finset.mem_union.mpr (or.inr (by simp)), have kjO : ∀ j, k j ∈ O := λ j, finset.mem_union.mpr (or.inl (by simp)), @@ -118,13 +121,13 @@ begin -- Our goal is now an equation between equivalence classes of representatives of a colimit, -- and so it suffices to show those representative become equal somewhere, in particular at `S`. - apply colimit_sound' (T kxO) (T kyO), + apply colimit_sound'.{v v} (T kxO) (T kyO), -- We can check if two elements of a limit (in `Type`) are equal by comparing them componentwise. ext, -- Now it's just a calculation using `W` and `w`. - simp only [functor.comp_map, limit.map_π_apply, curry.obj_map_app, swap_map], + simp only [functor.comp_map, limit.map_π_apply, curry_obj_map_app, swap_map], rw ←W _ _ (fH j), rw ←W _ _ (gH j), simp [w], @@ -147,7 +150,7 @@ begin intro x, -- This consists of some coherent family of elements in the various colimits, -- and so our first task is to pick representatives of these elements. - have z := λ j, jointly_surjective' (limit.π (curry.obj F ⋙ limits.colim) j x), + have z := λ j, jointly_surjective'.{v v} (limit.π (curry.obj F ⋙ limits.colim) j x), -- `k : J ⟶ K` records where the representative of the element in the `j`-th element of `x` lives let k : J → K := λ j, (z j).some, -- `y j : F.obj (j, k j)` is the representative @@ -177,14 +180,14 @@ begin { intros j j' f, have t : (f, g j) = (((f, 𝟙 (k j)) : (j, k j) ⟶ (j', k j)) ≫ (𝟙 j', g j) : (j, k j) ⟶ (j', k')), { simp only [id_comp, comp_id, prod_comp], }, - erw [colimit.w_apply, t, functor_to_types.map_comp_apply, colimit.w_apply, e, - ←limit.w_apply f, ←e], + erw [colimit.w_apply', t, functor_to_types.map_comp_apply, colimit.w_apply', e, + ←limit.w_apply' f, ←e], simp, }, -- Because `K` is filtered, we can restate this as saying that -- for each such `f`, there is some place to the right of `k'` -- where these images of `y j` and `y j'` become equal. - simp_rw colimit_eq_iff at w, + simp_rw colimit_eq_iff.{v v} at w, -- We take a moment to restate `w` more conveniently. let kf : Π {j j'} (f : j ⟶ j'), K := λ _ _ f, (w f).some, @@ -265,11 +268,12 @@ begin -- This representative is meant to be an element of a limit, -- so we need to construct a family of elements in `F.obj (j, k'')` for varying `j`, -- then show that are coherent with respect to morphisms in the `j` direction. - ext, swap, + apply limit.mk.{v v}, swap, { -- We construct the elements as the images of the `y j`. exact λ j, F.map (⟨𝟙 j, g j ≫ gf (𝟙 j) ≫ i (𝟙 j)⟩ : (j, k j) ⟶ (j, k'')) (y j), }, { -- After which it's just a calculation, using `s` and `wf`, to see they are coherent. dsimp, + intros j j' f, simp only [←functor_to_types.map_comp_apply, prod_comp, id_comp, comp_id], calc F.map ((f, g j ≫ gf (𝟙 j) ≫ i (𝟙 j)) : (j, k j) ⟶ (j', k'')) (y j) = F.map ((f, g j ≫ hf f ≫ i f) : (j, k j) ⟶ (j', k'')) (y j) @@ -287,12 +291,12 @@ begin -- Finally we check that this maps to `x`. { -- We can do this componentwise: - apply limit_ext, + apply limit_ext', intro j, -- and as each component is an equation in a colimit, we can verify it by -- pointing out the morphism which carries one representative to the other: - simp only [←e, colimit_eq_iff, curry.obj_obj_map, limit.π_mk, + simp only [←e, colimit_eq_iff.{v v}, curry_obj_obj_map, limit.π_mk', bifunctor.map_id_comp, id.def, types_comp_apply, limits.ι_colimit_limit_to_limit_colimit_π_apply], refine ⟨k'', 𝟙 k'', g j ≫ gf (𝟙 j) ≫ i (𝟙 j), _⟩, @@ -312,16 +316,18 @@ begin apply cones.cone_iso_of_hom_iso, end -noncomputable -instance filtered_colim_preserves_finite_limits_of_types : - preserves_finite_limits (colim : (K ⥤ Type v) ⥤ _) := ⟨λ J _ _, by exactI ⟨λ F, ⟨λ c hc, +noncomputable instance filtered_colim_preserves_finite_limits_of_types : + preserves_finite_limits (colim : (K ⥤ Type v) ⥤ _) := begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{v}, + intros J _ _, resetI, constructor, + intro F, constructor, + intros c hc, apply is_limit.of_iso_limit (limit.is_limit _), - symmetry, - transitivity (colim.map_cone (limit.cone F)), + symmetry, transitivity (colim.map_cone (limit.cone F)), exact functor.map_iso _ (hc.unique_up_to_iso (limit.is_limit F)), - exact as_iso (colimit_limit_to_limit_colimit_cone F), -end ⟩⟩⟩ + exact as_iso (colimit_limit_to_limit_colimit_cone.{v (v + 1)} F), +end variables {C : Type u} [category.{v} C] [concrete_category.{v} C] section @@ -345,7 +351,10 @@ noncomputable instance [preserves_finite_limits (forget C)] [preserves_filtered_colimits (forget C)] [has_finite_limits C] [has_colimits_of_shape K C] [reflects_isomorphisms (forget C)] : preserves_finite_limits (colim : (K ⥤ C) ⥤ _) := -⟨λ _ _ _, by exactI category_theory.limits.filtered_colim_preserves_finite_limits⟩ +begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{v}, + intros J _ _, resetI, apply_instance +end section @@ -372,7 +381,7 @@ begin congr' 1, simp only [← category.assoc, iso.comp_inv_eq, limits.colimit_obj_iso_colimit_comp_evaluation_ι_app_hom, - limits.has_colimit.iso_of_nat_iso_ι_hom, nat_iso.of_components.hom_app], + limits.has_colimit.iso_of_nat_iso_ι_hom, nat_iso.of_components_hom_app], dsimp, simp, end diff --git a/src/category_theory/limits/final.lean b/src/category_theory/limits/final.lean index 62b3e46f33669..f85798fef3d3f 100644 --- a/src/category_theory/limits/final.lean +++ b/src/category_theory/limits/final.lean @@ -12,6 +12,9 @@ import category_theory.limits.types /-! # Final and initial functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A functor `F : C ⥤ D` is final if for every `d : D`, the comma category of morphisms `d ⟶ F.obj c` is connected. @@ -57,7 +60,7 @@ Dualise condition 3 above and the implications 2 ⇒ 3 and 3 ⇒ 1 to initial fu noncomputable theory -universes v u +universes v v₁ v₂ v₃ u₁ u₂ u₃ namespace category_theory @@ -66,8 +69,10 @@ namespace functor open opposite open category_theory.limits -variables {C : Type v} [small_category C] -variables {D : Type v} [small_category D] +section arbitrary_universe + +variables {C : Type u₁} [category.{v₁} C] +variables {D : Type u₂} [category.{v₂} D] /-- A functor `F : C ⥤ D` is final if for every `d : D`, the comma category of morphisms `d ⟶ F.obj c` @@ -137,7 +142,7 @@ variables (F : C ⥤ D) [final F] instance (d : D) : nonempty (structured_arrow d F) := is_connected.is_nonempty -variables {E : Type u} [category.{v} E] (G : D ⥤ E) +variables {E : Type u₃} [category.{v₃} E] (G : D ⥤ E) /-- When `F : C ⥤ D` is cofinal, we denote by `lift F d` an arbitrary choice of object in `C` such that @@ -171,7 +176,7 @@ def induction {d : D} (Z : Π (X : C) (k : d ⟶ F.obj X), Sort*) begin apply nonempty.some, apply @is_preconnected_induction _ _ _ - (λ (Y : structured_arrow d F), Z Y.right Y.hom) _ _ { right := X₀, hom := k₀, } z, + (λ (Y : structured_arrow d F), Z Y.right Y.hom) _ _ (structured_arrow.mk k₀) z, { intros j₁ j₂ f a, fapply h₁ _ _ _ _ f.right _ a, convert f.w.symm, dsimp, simp, }, { intros j₁ j₂ f a, fapply h₂ _ _ _ _ f.right _ a, convert f.w.symm, dsimp, simp, }, end @@ -266,7 +271,7 @@ begin dsimp [is_colimit_whisker_equiv], apply P.hom_ext, intro j, - dsimp, simp, dsimp, simp, -- See library note [dsimp, simp]. + dsimp, simp, end instance colimit_pre_is_iso [has_colimit G] : @@ -320,9 +325,15 @@ https://stacks.math.columbia.edu/tag/04E7 -/ def colimit_iso' [has_colimit (F ⋙ G)] : colimit (F ⋙ G) ≅ colimit G := as_iso (colimit.pre G F) - end +end final +end arbitrary_universe + +namespace final + +variables {C : Type v} [category.{v} C] {D : Type v} [category.{v} D] (F : C ⥤ D) [final F] + /-- If the universal morphism `colimit (F ⋙ coyoneda.obj (op d)) ⟶ colimit (coyoneda.obj (op d))` is an isomorphism (as it always is when `F` is cofinal), @@ -334,7 +345,7 @@ def colimit_comp_coyoneda_iso (d : D) [is_iso (colimit.pre (coyoneda.obj (op d)) as_iso (colimit.pre (coyoneda.obj (op d)) F) ≪≫ coyoneda.colimit_coyoneda_iso (op d) lemma zigzag_of_eqv_gen_quot_rel {F : C ⥤ D} {d : D} {f₁ f₂ : Σ X, d ⟶ F.obj X} - (t : eqv_gen (types.quot.rel (F ⋙ coyoneda.obj (op d))) f₁ f₂) : + (t : eqv_gen (types.quot.rel.{v v} (F ⋙ coyoneda.obj (op d))) f₁ f₂) : zigzag (structured_arrow.mk f₁.2) (structured_arrow.mk f₂.2) := begin induction t, @@ -343,7 +354,7 @@ begin fconstructor, swap 2, fconstructor, left, fsplit, - exact { right := f, } }, + exact structured_arrow.hom_mk f (by tidy), }, case eqv_gen.refl { fconstructor, }, case eqv_gen.symm : x y h ih @@ -362,16 +373,16 @@ lemma cofinal_of_colimit_comp_coyoneda_iso_punit ⟨λ d, begin haveI : nonempty (structured_arrow d F), { have := (I d).inv punit.star, - obtain ⟨j, y, rfl⟩ := limits.types.jointly_surjective' this, + obtain ⟨j, y, rfl⟩ := limits.types.jointly_surjective'.{v v} this, exact ⟨structured_arrow.mk y⟩, }, apply zigzag_is_connected, - rintros ⟨⟨⟩,X₁,f₁⟩ ⟨⟨⟩,X₂,f₂⟩, + rintros ⟨⟨⟨⟩⟩,X₁,f₁⟩ ⟨⟨⟨⟩⟩,X₂,f₂⟩, dsimp at *, let y₁ := colimit.ι (F ⋙ coyoneda.obj (op d)) X₁ f₁, let y₂ := colimit.ι (F ⋙ coyoneda.obj (op d)) X₂ f₂, have e : y₁ = y₂, { apply (I d).to_equiv.injective, ext, }, - have t := types.colimit_eq e, + have t := types.colimit_eq.{v v} e, clear e y₁ y₂, exact zigzag_of_eqv_gen_quot_rel t, end⟩ @@ -381,11 +392,11 @@ end final namespace initial -variables (F : C ⥤ D) [initial F] +variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] (F : C ⥤ D) [initial F] instance (d : D) : nonempty (costructured_arrow F d) := is_connected.is_nonempty -variables {E : Type u} [category.{v} E] (G : D ⥤ E) +variables {E : Type u₃} [category.{v₃} E] (G : D ⥤ E) /-- When `F : C ⥤ D` is initial, we denote by `lift F d` an arbitrary choice of object in `C` such that @@ -418,7 +429,7 @@ def induction {d : D} (Z : Π (X : C) (k : F.obj X ⟶ d), Sort*) begin apply nonempty.some, apply @is_preconnected_induction _ _ _ - (λ Y : costructured_arrow F d, Z Y.left Y.hom) _ _ { left := X₀, hom := k₀ } z, + (λ Y : costructured_arrow F d, Z Y.left Y.hom) _ _ (costructured_arrow.mk k₀) z, { intros j₁ j₂ f a, fapply h₁ _ _ _ _ f.left _ a, convert f.w, dsimp, simp, }, { intros j₁ j₂ f a, fapply h₂ _ _ _ _ f.left _ a, convert f.w, dsimp, simp, }, end diff --git a/src/category_theory/limits/fubini.lean b/src/category_theory/limits/fubini.lean index b66f019afc4c2..5c6ca492bcde5 100644 --- a/src/category_theory/limits/fubini.lean +++ b/src/category_theory/limits/fubini.lean @@ -10,6 +10,9 @@ import category_theory.functor.currying /-! # A Fubini theorem for categorical limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove that $lim_{J × K} G = lim_J (lim_K G(j, -))$ for a functor `G : J × K ⥤ C`, when all the appropriate limits exist. @@ -127,7 +130,7 @@ def cone_of_cone_uncurry_is_limit dsimp, slice_rhs 3 4 { rw ←nat_trans.naturality, }, slice_rhs 2 3 { rw ←(D.obj j).π.naturality, }, - simp only [functor.const.obj_map, category.id_comp, category.assoc], + simp only [functor.const_obj_map, category.id_comp, category.assoc], have w := (D.map fj).w k', dsimp at w, rw ←w, diff --git a/src/category_theory/limits/full_subcategory.lean b/src/category_theory/limits/full_subcategory.lean new file mode 100644 index 0000000000000..60b93294742e0 --- /dev/null +++ b/src/category_theory/limits/full_subcategory.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.limits.creates + +/-! +# Limits in full subcategories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We introduce the notion of a property closed under taking limits and show that if `P` is closed +under taking limits, then limits in `full_subcategory P` can be constructed from limits in `C`. +More precisely, the inclusion creates such limits. + +-/ + +noncomputable theory + +universes w' w v u + +open category_theory + +namespace category_theory.limits + +/-- We say that a property is closed under limits of shape `J` if whenever all objects in a + `J`-shaped diagram have the property, any limit of this diagram also has the property. -/ +def closed_under_limits_of_shape {C : Type u} [category.{v} C] (J : Type w) [category.{w'} J] + (P : C → Prop) : Prop := +∀ ⦃F : J ⥤ C⦄ ⦃c : cone F⦄ (hc : is_limit c), (∀ j, P (F.obj j)) → P c.X + +/-- We say that a property is closed under colimits of shape `J` if whenever all objects in a + `J`-shaped diagram have the property, any colimit of this diagram also has the property. -/ +def closed_under_colimits_of_shape {C : Type u} [category.{v} C] (J : Type w) [category.{w'} J] + (P : C → Prop) : Prop := +∀ ⦃F : J ⥤ C⦄ ⦃c : cocone F⦄ (hc : is_colimit c), (∀ j, P (F.obj j)) → P c.X + +section +variables {C : Type u} [category.{v} C] {J : Type w} [category.{w'} J] {P : C → Prop} + +lemma closed_under_limits_of_shape.limit (h : closed_under_limits_of_shape J P) {F : J ⥤ C} + [has_limit F] : (∀ j, P (F.obj j)) → P (limit F) := +h (limit.is_limit _) + +lemma closed_under_colimits_of_shape.colimit (h : closed_under_colimits_of_shape J P) {F : J ⥤ C} + [has_colimit F] : (∀ j, P (F.obj j)) → P (colimit F) := +h (colimit.is_colimit _) + +end + +section +variables {J : Type w} [category.{w'} J] {C : Type u} [category.{v} C] {P : C → Prop} + +/-- If a `J`-shaped diagram in `full_subcategory P` has a limit cone in `C` whose cone point lives + in the full subcategory, then this defines a limit in the full subcategory. -/ +def creates_limit_full_subcategory_inclusion' (F : J ⥤ full_subcategory P) + {c : cone (F ⋙ full_subcategory_inclusion P)} (hc : is_limit c) (h : P c.X) : + creates_limit F (full_subcategory_inclusion P) := +creates_limit_of_fully_faithful_of_iso' hc ⟨_, h⟩ (iso.refl _) + +/-- If a `J`-shaped diagram in `full_subcategory P` has a limit in `C` whose cone point lives in the + full subcategory, then this defines a limit in the full subcategory. -/ +def creates_limit_full_subcategory_inclusion (F : J ⥤ full_subcategory P) + [has_limit (F ⋙ full_subcategory_inclusion P)] + (h : P (limit (F ⋙ full_subcategory_inclusion P))) : + creates_limit F (full_subcategory_inclusion P) := +creates_limit_full_subcategory_inclusion' F (limit.is_limit _) h + +/-- If a `J`-shaped diagram in `full_subcategory P` has a colimit cocone in `C` whose cocone point + lives in the full subcategory, then this defines a colimit in the full subcategory. -/ +def creates_colimit_full_subcategory_inclusion' (F : J ⥤ full_subcategory P) + {c : cocone (F ⋙ full_subcategory_inclusion P)} (hc : is_colimit c) (h : P c.X) : + creates_colimit F (full_subcategory_inclusion P) := +creates_colimit_of_fully_faithful_of_iso' hc ⟨_, h⟩ (iso.refl _) + +/-- If a `J`-shaped diagram in `full_subcategory P` has a colimit in `C` whose cocone point lives in + the full subcategory, then this defines a colimit in the full subcategory. -/ +def creates_colimit_full_subcategory_inclusion (F : J ⥤ full_subcategory P) + [has_colimit (F ⋙ full_subcategory_inclusion P)] + (h : P (colimit (F ⋙ full_subcategory_inclusion P))) : + creates_colimit F (full_subcategory_inclusion P) := +creates_colimit_full_subcategory_inclusion' F (colimit.is_colimit _) h + +/-- If `P` is closed under limits of shape `J`, then the inclusion creates such limits. -/ +def creates_limit_full_subcategory_inclusion_of_closed (h : closed_under_limits_of_shape J P) + (F : J ⥤ full_subcategory P) [has_limit (F ⋙ full_subcategory_inclusion P)] : + creates_limit F (full_subcategory_inclusion P) := +creates_limit_full_subcategory_inclusion F (h.limit (λ j, (F.obj j).property)) + +/-- If `P` is closed under limits of shape `J`, then the inclusion creates such limits. -/ +def creates_limits_of_shape_full_subcategory_inclusion (h : closed_under_limits_of_shape J P) + [has_limits_of_shape J C] : creates_limits_of_shape J (full_subcategory_inclusion P) := +{ creates_limit := λ F, creates_limit_full_subcategory_inclusion_of_closed h F } + +lemma has_limit_of_closed_under_limits (h : closed_under_limits_of_shape J P) + (F : J ⥤ full_subcategory P) [has_limit (F ⋙ full_subcategory_inclusion P)] : has_limit F := +have creates_limit F (full_subcategory_inclusion P), + from creates_limit_full_subcategory_inclusion_of_closed h F, +by exactI has_limit_of_created F (full_subcategory_inclusion P) + +lemma has_limits_of_shape_of_closed_under_limits (h : closed_under_limits_of_shape J P) + [has_limits_of_shape J C] : has_limits_of_shape J (full_subcategory P) := +{ has_limit := λ F, has_limit_of_closed_under_limits h F } + +/-- If `P` is closed under colimits of shape `J`, then the inclusion creates such colimits. -/ +def creates_colimit_full_subcategory_inclusion_of_closed (h : closed_under_colimits_of_shape J P) + (F : J ⥤ full_subcategory P) [has_colimit (F ⋙ full_subcategory_inclusion P)] : + creates_colimit F (full_subcategory_inclusion P) := +creates_colimit_full_subcategory_inclusion F (h.colimit (λ j, (F.obj j).property)) + +/-- If `P` is closed under colimits of shape `J`, then the inclusion creates such colimits. -/ +def creates_colimits_of_shape_full_subcategory_inclusion + (h : closed_under_colimits_of_shape J P) [has_colimits_of_shape J C] : + creates_colimits_of_shape J (full_subcategory_inclusion P) := +{ creates_colimit := λ F, creates_colimit_full_subcategory_inclusion_of_closed h F } + +lemma has_colimit_of_closed_under_colimits (h : closed_under_colimits_of_shape J P) + (F : J ⥤ full_subcategory P) [has_colimit (F ⋙ full_subcategory_inclusion P)] : has_colimit F := +have creates_colimit F (full_subcategory_inclusion P), + from creates_colimit_full_subcategory_inclusion_of_closed h F, +by exactI has_colimit_of_created F (full_subcategory_inclusion P) + +lemma has_colimits_of_shape_of_closed_under_colimits (h : closed_under_colimits_of_shape J P) + [has_colimits_of_shape J C] : has_colimits_of_shape J (full_subcategory P) := +{ has_colimit := λ F, has_colimit_of_closed_under_colimits h F } + +end + +end category_theory.limits diff --git a/src/category_theory/limits/functor_category.lean b/src/category_theory/limits/functor_category.lean index b0d8ece00f57b..c867cc0cd9ef5 100644 --- a/src/category_theory/limits/functor_category.lean +++ b/src/category_theory/limits/functor_category.lean @@ -8,6 +8,9 @@ import category_theory.limits.preserves.limits /-! # (Co)limits in functor categories. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that if `D` has limits, then the functor category `C ⥤ D` also has limits (`category_theory.limits.functor_category_has_limits`), and the evaluation functors preserve limits @@ -19,10 +22,10 @@ We also show that `F : D ⥤ K ⥤ C` preserves (co)limits if it does so for eac `category_theory.limits.preserves_colimits_of_evaluation`). -/ -open category_theory category_theory.category +open category_theory category_theory.category category_theory.functor -- morphism levels before object levels. See note [category_theory universes]. -universes v₁ v₂ u₁ u₂ v v' u u' +universes w' w v₁ v₂ u₁ u₂ v v' u u' namespace category_theory.limits @@ -308,12 +311,17 @@ def preserves_limits_of_shape_of_evaluation (F : D ⥤ K ⥤ C) (J : Type*) [cat ⟨λ G, preserves_limit_of_evaluation F G (λ k, preserves_limits_of_shape.preserves_limit)⟩ /-- `F : D ⥤ K ⥤ C` preserves all limits if it does for each `k : K`. -/ -def {w' w} preserves_limits_of_evaluation (F : D ⥤ K ⥤ C) +def preserves_limits_of_evaluation (F : D ⥤ K ⥤ C) (H : Π (k : K), preserves_limits_of_size.{w' w} (F ⋙ (evaluation K C).obj k)) : preserves_limits_of_size.{w' w} F := ⟨λ L hL, by exactI preserves_limits_of_shape_of_evaluation F L (λ k, preserves_limits_of_size.preserves_limits_of_shape)⟩ +/-- The constant functor `C ⥤ (D ⥤ C)` preserves limits. -/ +instance preserves_limits_const : preserves_limits_of_size.{w' w} (const D : C ⥤ _) := +preserves_limits_of_evaluation _ $ λ X, preserves_limits_of_nat_iso $ iso.symm $ + const_comp_evaluation_obj _ _ + instance evaluation_preserves_colimits [has_colimits C] (k : K) : preserves_colimits ((evaluation K C).obj k) := { preserves_colimits_of_shape := λ J 𝒥, by resetI; apply_instance } @@ -336,11 +344,17 @@ def preserves_colimits_of_shape_of_evaluation (F : D ⥤ K ⥤ C) (J : Type*) [c ⟨λ G, preserves_colimit_of_evaluation F G (λ k, preserves_colimits_of_shape.preserves_colimit)⟩ /-- `F : D ⥤ K ⥤ C` preserves all colimits if it does for each `k : K`. -/ -def {w' w} preserves_colimits_of_evaluation (F : D ⥤ K ⥤ C) +def preserves_colimits_of_evaluation (F : D ⥤ K ⥤ C) (H : Π (k : K), preserves_colimits_of_size.{w' w} (F ⋙ (evaluation K C).obj k)) : preserves_colimits_of_size.{w' w} F := ⟨λ L hL, by exactI preserves_colimits_of_shape_of_evaluation F L (λ k, preserves_colimits_of_size.preserves_colimits_of_shape)⟩ + +/-- The constant functor `C ⥤ (D ⥤ C)` preserves colimits. -/ +instance preserves_colimits_const : preserves_colimits_of_size.{w' w} (const D : C ⥤ _) := +preserves_colimits_of_evaluation _ $ λ X, preserves_colimits_of_nat_iso $ iso.symm $ + const_comp_evaluation_obj _ _ + open category_theory.prod /-- The limit of a diagram `F : J ⥤ K ⥤ C` is isomorphic to the functor given by diff --git a/src/category_theory/limits/has_limits.lean b/src/category_theory/limits/has_limits.lean index 4ffdb7fb33952..00a7c55546d82 100644 --- a/src/category_theory/limits/has_limits.lean +++ b/src/category_theory/limits/has_limits.lean @@ -9,6 +9,9 @@ import category_theory.category.ulift /-! # Existence of limits and colimits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In `category_theory.limits.is_limit` we defined `is_limit c`, the data showing that a cone `c` is a limit cone. @@ -69,7 +72,7 @@ variables {F : J ⥤ C} section limit /-- `limit_cone F` contains a cone over `F` together with the information that it is a limit. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure limit_cone (F : J ⥤ C) := (cone : cone F) (is_limit : is_limit cone) @@ -488,8 +491,32 @@ def lim_yoneda : lim ⋙ yoneda ⋙ (whiskering_right _ _ _).obj ulift_functor.{ nat_iso.of_components (λ F, nat_iso.of_components (λ W, limit.hom_iso F (unop W)) (by tidy)) (by tidy) +/--The constant functor and limit functor are adjoint to each other-/ +def const_lim_adj : (const J : C ⥤ (J ⥤ C)) ⊣ lim := +{ hom_equiv := λ c g, + { to_fun := λ f, limit.lift _ ⟨c, f⟩, + inv_fun := λ f, { app := λ j, f ≫ limit.π _ _ , naturality' := by tidy }, + left_inv := λ _, nat_trans.ext _ _ $ funext $ λ j, limit.lift_π _ _, + right_inv := λ α, limit.hom_ext $ λ j, limit.lift_π _ _ }, + unit := { app := λ c, limit.lift _ ⟨_, 𝟙 _⟩, naturality' := λ _ _ _, by tidy }, + counit := + { app := λ g, { app := limit.π _, naturality' := by tidy }, + naturality' := λ _ _ _, by tidy }, + hom_equiv_unit' := λ c g f, limit.hom_ext $ λ j, by simp, + hom_equiv_counit' := λ c g f, nat_trans.ext _ _ $ funext $ λ j, rfl } + +instance : is_right_adjoint (lim : (J ⥤ C) ⥤ C) := ⟨_, const_lim_adj⟩ + end lim_functor +instance lim_map_mono' {F G : J ⥤ C} [has_limits_of_shape J C] (α : F ⟶ G) + [mono α] : mono (lim_map α) := +(lim : (J ⥤ C) ⥤ C).map_mono α + +instance lim_map_mono {F G : J ⥤ C} [has_limit F] [has_limit G] (α : F ⟶ G) + [∀ j, mono (α.app j)] : mono (lim_map α) := +⟨λ Z u v h, limit.hom_ext $ λ j, (cancel_mono (α.app j)).1 $ by simpa using h =≫ limit.π _ j⟩ + /-- We can transport limits of shape `J` along an equivalence `J ≌ J'`. -/ @@ -508,7 +535,8 @@ lemma has_limits_of_size_shrink [has_limits_of_size.{(max v₁ v₂) (max u₁ u ⟨λ J hJ, by exactI has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{v₂ u₂} J).symm⟩ -lemma has_smallest_limits_of_has_limits [has_limits C] : +@[priority 100] +instance has_smallest_limits_of_has_limits [has_limits C] : has_limits_of_size.{0 0} C := has_limits_of_size_shrink.{0 0} C end limit @@ -518,7 +546,7 @@ section colimit /-- `colimit_cocone F` contains a cocone over `F` together with the information that it is a colimit. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure colimit_cocone (F : J ⥤ C) := (cocone : cocone F) (is_colimit : is_colimit cocone) @@ -971,8 +999,31 @@ def colim_coyoneda : colim.op ⋙ coyoneda ⋙ (whiskering_right _ _ _).obj ulif nat_iso.of_components (λ F, nat_iso.of_components (colimit.hom_iso (unop F)) (by tidy)) (by tidy) +/-- +The colimit functor and constant functor are adjoint to each other +-/ +def colim_const_adj : (colim : (J ⥤ C) ⥤ C) ⊣ const J := +{ hom_equiv := λ f c, + { to_fun := λ g, { app := λ _, colimit.ι _ _ ≫ g, naturality' := by tidy }, + inv_fun := λ g, colimit.desc _ ⟨_, g⟩, + left_inv := λ _, colimit.hom_ext $ λ j, colimit.ι_desc _ _, + right_inv := λ _, nat_trans.ext _ _ $ funext $ λ j, colimit.ι_desc _ _ }, + unit := { app := λ g, { app := colimit.ι _, naturality' := by tidy }, naturality' := by tidy }, + counit := { app := λ c, colimit.desc _ ⟨_, 𝟙 _⟩, naturality' := by tidy }, + hom_equiv_unit' := λ _ _ _, nat_trans.ext _ _ $ funext $ λ _ , rfl, + hom_equiv_counit' := λ _ _ _, colimit.hom_ext $ λ _, by simp } + +instance : is_left_adjoint (colim : (J ⥤ C) ⥤ C) := ⟨_, colim_const_adj⟩ + end colim_functor +instance colim_map_epi' {F G : J ⥤ C} [has_colimits_of_shape J C] (α : F ⟶ G) [epi α] : + epi (colim_map α) := (colim : (J ⥤ C) ⥤ C).map_epi α + +instance colim_map_epi {F G : J ⥤ C} [has_colimit F] [has_colimit G] (α : F ⟶ G) + [∀ j, epi (α.app j)] : epi (colim_map α) := +⟨λ Z u v h, colimit.hom_ext $ λ j, (cancel_epi (α.app j)).1 $ by simpa using colimit.ι _ j ≫= h⟩ + /-- We can transport colimits of shape `J` along an equivalence `J ≌ J'`. -/ @@ -991,7 +1042,8 @@ lemma has_colimits_of_size_shrink [has_colimits_of_size.{(max v₁ v₂) (max u ⟨λ J hJ, by exactI has_colimits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{v₂ u₂} J).symm⟩ -lemma has_smallest_colimits_of_has_colimits [has_colimits C] : +@[priority 100] +instance has_smallest_colimits_of_has_colimits [has_colimits C] : has_colimits_of_size.{0 0} C := has_colimits_of_size_shrink.{0 0} C end colimit diff --git a/src/category_theory/limits/is_limit.lean b/src/category_theory/limits/is_limit.lean index 9b220c75b965f..ddf48549dac02 100644 --- a/src/category_theory/limits/is_limit.lean +++ b/src/category_theory/limits/is_limit.lean @@ -9,6 +9,9 @@ import category_theory.limits.cones /-! # Limits and colimits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We set up the general theory of limits and colimits in a category. In this introduction we only describe the setup for limits; it is repeated, with slightly different names, for colimits. @@ -50,7 +53,7 @@ cone morphism to `t`. See . -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure is_limit (t : cone F) := (lift : Π (s : cone F), s.X ⟶ t.X) (fac' : ∀ (s : cone F) (j : J), lift s ≫ t.π.app j = s.π.app j . obviously) @@ -504,7 +507,7 @@ cocone morphism from `t`. See . -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure is_colimit (t : cocone F) := (desc : Π (s : cocone F), t.X ⟶ s.X) (fac' : ∀ (s : cocone F) (j : J), t.ι.app j ≫ desc s = s.ι.app j . obviously) diff --git a/src/category_theory/limits/kan_extension.lean b/src/category_theory/limits/kan_extension.lean index 6d28e660d6a53..083ca5a6096ea 100644 --- a/src/category_theory/limits/kan_extension.lean +++ b/src/category_theory/limits/kan_extension.lean @@ -11,6 +11,9 @@ import category_theory.structured_arrow # Kan extensions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the right and left Kan extensions of a functor. They exist under the assumption that the target category has enough limits resp. colimits. @@ -120,7 +123,7 @@ def equiv (F : S ⥤ D) [∀ x, has_limit (diagram ι F x)] (G : L ⥤ D) : simp only [nat_trans.naturality_assoc, loc_map], erw limit.pre_π, congr, - cases j, + rcases j with ⟨⟨⟩, _, _⟩, tidy, end, right_inv := by tidy } @@ -253,7 +256,7 @@ def equiv (F : S ⥤ D) [I : ∀ x, has_colimit (diagram ι F x)] (G : L ⥤ D) change colimit.ι _ _ ≫ colimit.pre (diagram ι F k) (costructured_arrow.map _) = _, rw colimit.ι_pre, congr, - cases j, + rcases j with ⟨_, ⟨⟩, _⟩, tidy, end, right_inv := by tidy } diff --git a/src/category_theory/limits/lattice.lean b/src/category_theory/limits/lattice.lean index eed3fafc02a18..fce7bead9d70f 100644 --- a/src/category_theory/limits/lattice.lean +++ b/src/category_theory/limits/lattice.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Justus Springer -/ import order.complete_lattice +import data.fintype.lattice import category_theory.limits.shapes.pullbacks import category_theory.category.preorder import category_theory.limits.shapes.products @@ -11,9 +12,12 @@ import category_theory.limits.shapes.finite_limits /-! # Limits in lattice categories are given by infimums and supremums. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ -universes u +universes w u open category_theory open category_theory.limits @@ -24,7 +28,7 @@ section semilattice variables {α : Type u} -variables {J : Type u} [small_category J] [fin_category J] +variables {J : Type w} [small_category J] [fin_category J] /-- The limit cone over any functor from a finite diagram into a `semilattice_inf` with `order_top`. @@ -75,19 +79,39 @@ lemma finite_colimit_eq_finset_univ_sup [semilattice_sup α] [order_bot α] (F : /-- A finite product in the category of a `semilattice_inf` with `order_top` is the same as the infimum. -/ -lemma finite_product_eq_finset_inf [semilattice_inf α] [order_top α] {ι : Type u} [decidable_eq ι] +lemma finite_product_eq_finset_inf [semilattice_inf α] [order_top α] {ι : Type u} [fintype ι] (f : ι → α) : (∏ f) = (fintype.elems ι).inf f := -(is_limit.cone_point_unique_up_to_iso (limit.is_limit _) - (finite_limit_cone (discrete.functor f)).is_limit).to_eq +begin + transitivity, + exact (is_limit.cone_point_unique_up_to_iso (limit.is_limit _) + (finite_limit_cone (discrete.functor f)).is_limit).to_eq, + change finset.univ.inf (f ∘ discrete_equiv.to_embedding) = (fintype.elems ι).inf f, + simp only [←finset.inf_map, finset.univ_map_equiv_to_embedding], + refl, +end /-- A finite coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the supremum. -/ -lemma finite_coproduct_eq_finset_sup [semilattice_sup α] [order_bot α] {ι : Type u} [decidable_eq ι] +lemma finite_coproduct_eq_finset_sup [semilattice_sup α] [order_bot α] {ι : Type u} [fintype ι] (f : ι → α) : (∐ f) = (fintype.elems ι).sup f := -(is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) - (finite_colimit_cocone (discrete.functor f)).is_colimit).to_eq +begin + transitivity, + exact (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) + (finite_colimit_cocone (discrete.functor f)).is_colimit).to_eq, + change finset.univ.sup (f ∘ discrete_equiv.to_embedding) = (fintype.elems ι).sup f, + simp only [←finset.sup_map, finset.univ_map_equiv_to_embedding], + refl, +end + +@[priority 100] -- see Note [lower instance priority] +instance [semilattice_inf α] [order_top α] : has_binary_products α := +begin + haveI : ∀ (x y : α), has_limit (pair x y), + { letI := has_finite_limits_of_has_finite_limits_of_size.{u} α, apply_instance }, + apply has_binary_products_of_has_limit_pair +end /-- The binary product in the category of a `semilattice_inf` with `order_top` is the same as the @@ -96,10 +120,18 @@ infimum. @[simp] lemma prod_eq_inf [semilattice_inf α] [order_top α] (x y : α) : limits.prod x y = x ⊓ y := calc limits.prod x y = limit (pair x y) : rfl -... = finset.univ.inf (pair x y).obj : by rw finite_limit_eq_finset_univ_inf (pair x y) +... = finset.univ.inf (pair x y).obj : by rw finite_limit_eq_finset_univ_inf (pair.{u} x y) ... = x ⊓ (y ⊓ ⊤) : rfl -- Note: finset.inf is realized as a fold, hence the definitional equality ... = x ⊓ y : by rw inf_top_eq +@[priority 100] -- see Note [lower instance priority] +instance [semilattice_sup α] [order_bot α] : has_binary_coproducts α := +begin + haveI : ∀ (x y : α), has_colimit (pair x y), + { letI := has_finite_colimits_of_has_finite_colimits_of_size.{u} α, apply_instance }, + apply has_binary_coproducts_of_has_colimit_pair +end + /-- The binary coproduct in the category of a `semilattice_sup` with `order_bot` is the same as the supremum. diff --git a/src/category_theory/limits/mono_coprod.lean b/src/category_theory/limits/mono_coprod.lean new file mode 100644 index 0000000000000..76dd0b27804a1 --- /dev/null +++ b/src/category_theory/limits/mono_coprod.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.limits.shapes.regular_mono +import category_theory.limits.shapes.zero_morphisms + +/-! + +# Categories where inclusions into coproducts are monomorphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +If `C` is a category, the class `mono_coprod C` expresses that left +inclusions `A ⟶ A ⨿ B` are monomorphisms when `has_coproduct A B` +is satisfied. If it is so, it is shown that right inclusions are +also monomorphisms. + +TODO @joelriou: show that if `X : I → C` and `ι : J → I` is an injective map, +then the canonical morphism `∐ (X ∘ ι) ⟶ ∐ X` is a monomorphism. + +TODO: define distributive categories, and show that they satisfy `mono_coprod`, see + + +-/ + +noncomputable theory + +open category_theory category_theory.category category_theory.limits + +universe u + +namespace category_theory + +namespace limits + +variables (C : Type*) [category C] + +/-- This condition expresses that inclusion morphisms into coproducts are monomorphisms. -/ +class mono_coprod : Prop := +(binary_cofan_inl : ∀ ⦃A B : C⦄ (c : binary_cofan A B) (hc : is_colimit c), mono c.inl) + +variable {C} + +@[priority 100] +instance mono_coprod_of_has_zero_morphisms + [has_zero_morphisms C] : mono_coprod C := +⟨λ A B c hc, begin + haveI : is_split_mono c.inl := is_split_mono.mk' + (split_mono.mk (hc.desc (binary_cofan.mk (𝟙 A) 0)) (is_colimit.fac _ _ _)), + apply_instance, +end⟩ + +namespace mono_coprod + +lemma binary_cofan_inr {A B : C}[mono_coprod C] (c : binary_cofan A B) (hc : is_colimit c) : + mono c.inr := +begin + have hc' : is_colimit (binary_cofan.mk c.inr c.inl) := + binary_cofan.is_colimit_mk (λ s, hc.desc (binary_cofan.mk s.inr s.inl)) (by tidy) (by tidy) + (λ s m h₁ h₂, binary_cofan.is_colimit.hom_ext hc + (by simp only [h₂, is_colimit.fac, binary_cofan.ι_app_left, binary_cofan.mk_inl]) + (by simp only [h₁, is_colimit.fac, binary_cofan.ι_app_right, binary_cofan.mk_inr])), + exact binary_cofan_inl _ hc', +end + +instance {A B : C} [mono_coprod C] [has_binary_coproduct A B] : + mono (coprod.inl : A ⟶ A ⨿ B) := +binary_cofan_inl _ (colimit.is_colimit _) + +instance {A B : C} [mono_coprod C] [has_binary_coproduct A B] : + mono (coprod.inr : B ⟶ A ⨿ B) := +binary_cofan_inr _ (colimit.is_colimit _) + +lemma mono_inl_iff {A B : C} {c₁ c₂ : binary_cofan A B} (hc₁ : is_colimit c₁) + (hc₂ : is_colimit c₂) : mono c₁.inl ↔ mono c₂.inl := +begin + suffices : ∀ (c₁ c₂ : binary_cofan A B) (hc₁ : is_colimit c₁) (hc₂ : is_colimit c₂) + (h : mono c₁.inl), mono c₂.inl, + { exact ⟨λ h₁, this _ _ hc₁ hc₂ h₁, λ h₂, this _ _ hc₂ hc₁ h₂⟩, }, + intros c₁ c₂ hc₁ hc₂, + introI, + simpa only [is_colimit.comp_cocone_point_unique_up_to_iso_hom] + using mono_comp c₁.inl (hc₁.cocone_point_unique_up_to_iso hc₂).hom, +end + +lemma mk' (h : ∀ (A B : C), ∃ (c : binary_cofan A B) (hc : is_colimit c), mono c.inl) : + mono_coprod C := +⟨λ A B c' hc', begin + obtain ⟨c, hc₁, hc₂⟩ := h A B, + simpa only [mono_inl_iff hc' hc₁] using hc₂, +end⟩ + +instance mono_coprod_type : mono_coprod (Type u) := +mono_coprod.mk' (λ A B, begin + refine ⟨binary_cofan.mk (sum.inl : A ⟶ A ⊕ B) sum.inr, _, _⟩, + { refine binary_cofan.is_colimit.mk _ (λ Y f₁ f₂ x, by { cases x, exacts [f₁ x, f₂ x], }) + (λ Y f₁ f₂, rfl) (λ Y f₁ f₂, rfl) _, + intros Y f₁ f₂ m h₁ h₂, + ext x, + cases x, + { dsimp, exact congr_fun h₁ x, }, + { dsimp, exact congr_fun h₂ x, }, }, + { rw mono_iff_injective, + intros a₁ a₂ h, + simp only [binary_cofan.mk_inl] at h, + dsimp at h, + simpa only using h, }, +end) + +end mono_coprod + +end limits + +end category_theory diff --git a/src/category_theory/limits/opposites.lean b/src/category_theory/limits/opposites.lean index e36b935129dfa..00f7ca6069333 100644 --- a/src/category_theory/limits/opposites.lean +++ b/src/category_theory/limits/opposites.lean @@ -3,12 +3,17 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Floris van Doorn -/ +import category_theory.limits.filtered import category_theory.limits.shapes.finite_products import category_theory.discrete_category +import tactic.equiv_rw /-! # Limits in `C` give colimits in `Cᵒᵖ`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We also give special cases for (co)products, (co)equalizers, and pullbacks / pushouts. @@ -215,6 +220,11 @@ has_limit.mk { cone := cone_of_cocone_left_op (colimit.cocone F.left_op), is_limit := is_limit_cone_of_cocone_left_op _ (colimit.is_colimit _) } +lemma has_limit_of_has_colimit_op (F : J ⥤ C) [has_colimit F.op] : has_limit F := +has_limit.mk +{ cone := (colimit.cocone F.op).unop, + is_limit := is_limit_cocone_unop _ (colimit.is_colimit _) } + /-- If `C` has colimits of shape `Jᵒᵖ`, we can construct limits in `Cᵒᵖ` of shape `J`. -/ @@ -222,13 +232,27 @@ lemma has_limits_of_shape_op_of_has_colimits_of_shape [has_colimits_of_shape J has_limits_of_shape J Cᵒᵖ := { has_limit := λ F, has_limit_of_has_colimit_left_op F } +lemma has_limits_of_shape_of_has_colimits_of_shape_op [has_colimits_of_shape Jᵒᵖ Cᵒᵖ] : + has_limits_of_shape J C := +{ has_limit := λ F, has_limit_of_has_colimit_op F } + local attribute [instance] has_limits_of_shape_op_of_has_colimits_of_shape /-- If `C` has colimits, we can construct limits for `Cᵒᵖ`. -/ -lemma has_limits_op_of_has_colimits [has_colimits C] : has_limits Cᵒᵖ := ⟨infer_instance⟩ +instance has_limits_op_of_has_colimits [has_colimits C] : has_limits Cᵒᵖ := ⟨infer_instance⟩ + +lemma has_limits_of_has_colimits_op [has_colimits Cᵒᵖ] : has_limits C := +{ has_limits_of_shape := λ J hJ, by exactI has_limits_of_shape_of_has_colimits_of_shape_op } +instance has_cofiltered_limits_op_of_has_filtered_colimits + [has_filtered_colimits_of_size.{v₂ u₂} C] : has_cofiltered_limits_of_size.{v₂ u₂} Cᵒᵖ := +{ has_limits_of_shape := λ I hI₁ hI₂, by exactI has_limits_of_shape_op_of_has_colimits_of_shape } + +lemma has_cofiltered_limits_of_has_filtered_colimits_op + [has_filtered_colimits_of_size.{v₂ u₂} Cᵒᵖ] : has_cofiltered_limits_of_size.{v₂ u₂} C := +{ has_limits_of_shape := λ I hI₂ hI₂, by exactI has_limits_of_shape_of_has_colimits_of_shape_op } /-- If `F.left_op : Jᵒᵖ ⥤ C` has a limit, we can construct a colimit for `F : J ⥤ Cᵒᵖ`. @@ -238,25 +262,43 @@ has_colimit.mk { cocone := cocone_of_cone_left_op (limit.cone F.left_op), is_colimit := is_colimit_cocone_of_cone_left_op _ (limit.is_limit _) } +lemma has_colimit_of_has_limit_op (F : J ⥤ C) [has_limit F.op] : has_colimit F := +has_colimit.mk +{ cocone := (limit.cone F.op).unop, + is_colimit := is_colimit_cone_unop _ (limit.is_limit _) } + /-- If `C` has colimits of shape `Jᵒᵖ`, we can construct limits in `Cᵒᵖ` of shape `J`. -/ -lemma has_colimits_of_shape_op_of_has_limits_of_shape [has_limits_of_shape Jᵒᵖ C] : +instance has_colimits_of_shape_op_of_has_limits_of_shape [has_limits_of_shape Jᵒᵖ C] : has_colimits_of_shape J Cᵒᵖ := { has_colimit := λ F, has_colimit_of_has_limit_left_op F } -local attribute [instance] has_colimits_of_shape_op_of_has_limits_of_shape +lemma has_colimits_of_shape_of_has_limits_of_shape_op [has_limits_of_shape Jᵒᵖ Cᵒᵖ] : + has_colimits_of_shape J C := +{ has_colimit := λ F, has_colimit_of_has_limit_op F } /-- If `C` has limits, we can construct colimits for `Cᵒᵖ`. -/ -lemma has_colimits_op_of_has_limits [has_limits C] : has_colimits Cᵒᵖ := ⟨infer_instance⟩ +instance has_colimits_op_of_has_limits [has_limits C] : has_colimits Cᵒᵖ := ⟨infer_instance⟩ + +lemma has_colimits_of_has_limits_op [has_limits Cᵒᵖ] : has_colimits C := +{ has_colimits_of_shape := λ J hJ, by exactI has_colimits_of_shape_of_has_limits_of_shape_op } -variables (X : Type v₁) +instance has_filtered_colimits_op_of_has_cofiltered_limits + [has_cofiltered_limits_of_size.{v₂ u₂} C] : has_filtered_colimits_of_size.{v₂ u₂} Cᵒᵖ := +{ has_colimits_of_shape := λ I hI₁ hI₂, by exactI infer_instance } + +lemma has_filtered_colimits_of_has_cofiltered_limits_op + [has_cofiltered_limits_of_size.{v₂ u₂} Cᵒᵖ] : has_filtered_colimits_of_size.{v₂ u₂} C := +{ has_colimits_of_shape := λ I hI₁ hI₂, by exactI has_colimits_of_shape_of_has_limits_of_shape_op } + +variables (X : Type v₂) /-- If `C` has products indexed by `X`, then `Cᵒᵖ` has coproducts indexed by `X`. -/ -lemma has_coproducts_opposite [has_products_of_shape X C] : +instance has_coproducts_of_shape_opposite [has_products_of_shape X C] : has_coproducts_of_shape X Cᵒᵖ := begin haveI : has_limits_of_shape (discrete X)ᵒᵖ C := @@ -264,10 +306,18 @@ begin apply_instance end +lemma has_coproducts_of_shape_of_opposite [has_products_of_shape X Cᵒᵖ] : + has_coproducts_of_shape X C := +begin + haveI : has_limits_of_shape (discrete X)ᵒᵖ Cᵒᵖ := + has_limits_of_shape_of_equivalence (discrete.opposite X).symm, + exact has_colimits_of_shape_of_has_limits_of_shape_op +end + /-- If `C` has coproducts indexed by `X`, then `Cᵒᵖ` has products indexed by `X`. -/ -lemma has_products_opposite [has_coproducts_of_shape X C] : +instance has_products_of_shape_opposite [has_coproducts_of_shape X C] : has_products_of_shape X Cᵒᵖ := begin haveI : has_colimits_of_shape (discrete X)ᵒᵖ C := @@ -275,58 +325,360 @@ begin apply_instance end -lemma has_finite_coproducts_opposite [has_finite_products C] : - has_finite_coproducts Cᵒᵖ := -{ out := λ J 𝒟 𝒥, begin - resetI, - haveI : has_limits_of_shape (discrete J)ᵒᵖ C := - has_limits_of_shape_of_equivalence (discrete.opposite J).symm, - apply_instance, - end } +lemma has_products_of_shape_of_opposite [has_coproducts_of_shape X Cᵒᵖ] : + has_products_of_shape X C := +begin + haveI : has_colimits_of_shape (discrete X)ᵒᵖ Cᵒᵖ := + has_colimits_of_shape_of_equivalence (discrete.opposite X).symm, + exact has_limits_of_shape_of_has_colimits_of_shape_op +end -lemma has_finite_products_opposite [has_finite_coproducts C] : - has_finite_products Cᵒᵖ := -{ out := λ J 𝒟 𝒥, begin - resetI, - haveI : has_colimits_of_shape (discrete J)ᵒᵖ C := - has_colimits_of_shape_of_equivalence (discrete.opposite J).symm, - apply_instance, - end } +instance has_products_opposite [has_coproducts.{v₂} C] : has_products.{v₂} Cᵒᵖ := +λ X, infer_instance + +lemma has_products_of_opposite [has_coproducts.{v₂} Cᵒᵖ] : has_products.{v₂} C := +λ X, has_products_of_shape_of_opposite X + +instance has_coproducts_opposite [has_products.{v₂} C] : has_coproducts.{v₂} Cᵒᵖ := +λ X, infer_instance + +lemma has_coproducts_of_opposite [has_products.{v₂} Cᵒᵖ] : has_coproducts.{v₂} C := +λ X, has_coproducts_of_shape_of_opposite X + +instance has_finite_coproducts_opposite [has_finite_products C] : has_finite_coproducts Cᵒᵖ := +{ out := λ n, limits.has_coproducts_of_shape_opposite _ } + +lemma has_finite_coproducts_of_opposite [has_finite_products Cᵒᵖ] : has_finite_coproducts C := +{ out := λ n, has_coproducts_of_shape_of_opposite _ } + +instance has_finite_products_opposite [has_finite_coproducts C] : has_finite_products Cᵒᵖ := +{ out := λ n, infer_instance } + +lemma has_finite_products_of_opposite [has_finite_coproducts Cᵒᵖ] : has_finite_products C := +{ out := λ n, has_products_of_shape_of_opposite _ } -lemma has_equalizers_opposite [has_coequalizers C] : has_equalizers Cᵒᵖ := +instance has_equalizers_opposite [has_coequalizers C] : has_equalizers Cᵒᵖ := begin - haveI : has_colimits_of_shape walking_parallel_pair.{v₁}ᵒᵖ C := - has_colimits_of_shape_of_equivalence walking_parallel_pair_op_equiv.{v₁}, + haveI : has_colimits_of_shape walking_parallel_pairᵒᵖ C := + has_colimits_of_shape_of_equivalence walking_parallel_pair_op_equiv, apply_instance end -lemma has_coequalizers_opposite [has_equalizers C] : has_coequalizers Cᵒᵖ := +instance has_coequalizers_opposite [has_equalizers C] : has_coequalizers Cᵒᵖ := begin - haveI : has_limits_of_shape walking_parallel_pair.{v₁}ᵒᵖ C := - has_limits_of_shape_of_equivalence walking_parallel_pair_op_equiv.{v₁}, + haveI : has_limits_of_shape walking_parallel_pairᵒᵖ C := + has_limits_of_shape_of_equivalence walking_parallel_pair_op_equiv, apply_instance end -lemma has_finite_colimits_opposite [has_finite_limits C] : +instance has_finite_colimits_opposite [has_finite_limits C] : has_finite_colimits Cᵒᵖ := { out := λ J 𝒟 𝒥, by { resetI, apply_instance, }, } -lemma has_finite_limits_opposite [has_finite_colimits C] : +instance has_finite_limits_opposite [has_finite_colimits C] : has_finite_limits Cᵒᵖ := { out := λ J 𝒟 𝒥, by { resetI, apply_instance, }, } -lemma has_pullbacks_opposite [has_pushouts C] : has_pullbacks Cᵒᵖ := +instance has_pullbacks_opposite [has_pushouts C] : has_pullbacks Cᵒᵖ := begin - haveI : has_colimits_of_shape walking_cospan.{v₁}ᵒᵖ C := + haveI : has_colimits_of_shape walking_cospanᵒᵖ C := has_colimits_of_shape_of_equivalence walking_cospan_op_equiv.symm, apply has_limits_of_shape_op_of_has_colimits_of_shape, end -lemma has_pushouts_opposite [has_pullbacks C] : has_pushouts Cᵒᵖ := +instance has_pushouts_opposite [has_pullbacks C] : has_pushouts Cᵒᵖ := begin - haveI : has_limits_of_shape walking_span.{v₁}ᵒᵖ C := + haveI : has_limits_of_shape walking_spanᵒᵖ C := has_limits_of_shape_of_equivalence walking_span_op_equiv.symm, - apply has_colimits_of_shape_op_of_has_limits_of_shape, + apply_instance +end + +/-- The canonical isomorphism relating `span f.op g.op` and `(cospan f g).op` -/ +@[simps] +def span_op {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : + span f.op g.op ≅ walking_cospan_op_equiv.inverse ⋙ (cospan f g).op := +nat_iso.of_components (by { rintro (_|_|_); refl, }) + (by { rintros (_|_|_) (_|_|_) f; cases f; tidy, }) + +/-- The canonical isomorphism relating `(cospan f g).op` and `span f.op g.op` -/ +@[simps] +def op_cospan {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : + (cospan f g).op ≅ walking_cospan_op_equiv.functor ⋙ span f.op g.op := +calc (cospan f g).op ≅ 𝟭 _ ⋙ (cospan f g).op : by refl +... ≅ (walking_cospan_op_equiv.functor ⋙ walking_cospan_op_equiv.inverse) ⋙ (cospan f g).op : + iso_whisker_right walking_cospan_op_equiv.unit_iso _ +... ≅ walking_cospan_op_equiv.functor ⋙ (walking_cospan_op_equiv.inverse ⋙ (cospan f g).op) : + functor.associator _ _ _ +... ≅ walking_cospan_op_equiv.functor ⋙ span f.op g.op : iso_whisker_left _ (span_op f g).symm + +/-- The canonical isomorphism relating `cospan f.op g.op` and `(span f g).op` -/ +@[simps] +def cospan_op {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : + cospan f.op g.op ≅ walking_span_op_equiv.inverse ⋙ (span f g).op := +nat_iso.of_components (by { rintro (_|_|_); refl, }) + (by { rintros (_|_|_) (_|_|_) f; cases f; tidy, }) + +/-- The canonical isomorphism relating `(span f g).op` and `cospan f.op g.op` -/ +@[simps] +def op_span {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) : + (span f g).op ≅ walking_span_op_equiv.functor ⋙ cospan f.op g.op := +calc (span f g).op ≅ 𝟭 _ ⋙ (span f g).op : by refl +... ≅ (walking_span_op_equiv.functor ⋙ walking_span_op_equiv.inverse) ⋙ (span f g).op : + iso_whisker_right walking_span_op_equiv.unit_iso _ +... ≅ walking_span_op_equiv.functor ⋙ (walking_span_op_equiv.inverse ⋙ (span f g).op) : + functor.associator _ _ _ +... ≅ walking_span_op_equiv.functor ⋙ cospan f.op g.op : + iso_whisker_left _ (cospan_op f g).symm + +namespace pushout_cocone + +/-- The obvious map `pushout_cocone f g → pullback_cone f.unop g.unop` -/ +@[simps (lemmas_only)] +def unop {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + pullback_cone f.unop g.unop := +cocone.unop ((cocones.precompose (op_cospan f.unop g.unop).hom).obj + (cocone.whisker walking_cospan_op_equiv.functor c)) + +@[simp] +lemma unop_fst {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + c.unop.fst = c.inl.unop := +by { change (_ : limits.cone _).π.app _ = _, + simp only [pushout_cocone.ι_app_left, pushout_cocone.unop_π_app], tidy } + +@[simp] +lemma unop_snd {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + c.unop.snd = c.inr.unop := +by { change (_ : limits.cone _).π.app _ = _, + simp only [pushout_cocone.unop_π_app, pushout_cocone.ι_app_right], tidy, } + +/-- The obvious map `pushout_cocone f.op g.op → pullback_cone f g` -/ +@[simps (lemmas_only)] +def op {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + pullback_cone f.op g.op := +(cones.postcompose ((cospan_op f g).symm).hom).obj + (cone.whisker walking_span_op_equiv.inverse (cocone.op c)) + +@[simp] +lemma op_fst {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + c.op.fst = c.inl.op := +by { change (_ : limits.cone _).π.app _ = _, apply category.comp_id, } + +@[simp] +lemma op_snd {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + c.op.snd = c.inr.op := +by { change (_ : limits.cone _).π.app _ = _, apply category.comp_id, } + +end pushout_cocone + +namespace pullback_cone + +/-- The obvious map `pullback_cone f g → pushout_cocone f.unop g.unop` -/ +@[simps (lemmas_only)] +def unop {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : + pushout_cocone f.unop g.unop := +cone.unop ((cones.postcompose (op_span f.unop g.unop).symm.hom).obj + (cone.whisker walking_span_op_equiv.functor c)) + +@[simp] +lemma unop_inl {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : + c.unop.inl = c.fst.unop := +begin + change ((_ : limits.cocone _).ι.app _) = _, + dsimp only [unop, op_span], + simp, dsimp, simp, dsimp, simp +end + +@[simp] +lemma unop_inr {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : + c.unop.inr = c.snd.unop := +begin + change ((_ : limits.cocone _).ι.app _) = _, + apply quiver.hom.op_inj, + simp [unop_ι_app], dsimp, simp, + apply category.comp_id, +end + +/-- The obvious map `pullback_cone f g → pushout_cocone f.op g.op` -/ +@[simps (lemmas_only)] +def op {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : + pushout_cocone f.op g.op := +(cocones.precompose (span_op f g).hom).obj + (cocone.whisker walking_cospan_op_equiv.inverse (cone.op c)) + +@[simp] lemma op_inl {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : + c.op.inl = c.fst.op := +by { change (_ : limits.cocone _).ι.app _ = _, apply category.id_comp, } + +@[simp] lemma op_inr {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : + c.op.inr = c.snd.op := +by { change (_ : limits.cocone _).ι.app _ = _, apply category.id_comp, } + +/-- If `c` is a pullback cone, then `c.op.unop` is isomorphic to `c`. -/ +def op_unop {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : c.op.unop ≅ c := +pullback_cone.ext (iso.refl _) (by simp) (by simp) + +/-- If `c` is a pullback cone in `Cᵒᵖ`, then `c.unop.op` is isomorphic to `c`. -/ +def unop_op {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} (c : pullback_cone f g) : c.unop.op ≅ c := +pullback_cone.ext (iso.refl _) (by simp) (by simp) + +end pullback_cone + +namespace pushout_cocone + +/-- If `c` is a pushout cocone, then `c.op.unop` is isomorphic to `c`. -/ +def op_unop {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : c.op.unop ≅ c := +pushout_cocone.ext (iso.refl _) (by simp) (by simp) + +/-- If `c` is a pushout cocone in `Cᵒᵖ`, then `c.unop.op` is isomorphic to `c`. -/ +def unop_op {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : c.unop.op ≅ c := +pushout_cocone.ext (iso.refl _) (by simp) (by simp) + +/-- A pushout cone is a colimit cocone if and only if the corresponding pullback cone +in the opposite category is a limit cone. -/ +def is_colimit_equiv_is_limit_op {X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} (c : pushout_cocone f g) : + is_colimit c ≃ is_limit c.op := +begin + apply equiv_of_subsingleton_of_subsingleton, + { intro h, + equiv_rw is_limit.postcompose_hom_equiv _ _, + equiv_rw (is_limit.whisker_equivalence_equiv walking_span_op_equiv.symm).symm, + exact is_limit_cocone_op _ h, }, + { intro h, + equiv_rw is_colimit.equiv_iso_colimit c.op_unop.symm, + apply is_colimit_cone_unop, + equiv_rw is_limit.postcompose_hom_equiv _ _, + equiv_rw (is_limit.whisker_equivalence_equiv _).symm, + exact h, } +end + +/-- A pushout cone is a colimit cocone in `Cᵒᵖ` if and only if the corresponding pullback cone +in `C` is a limit cone. -/ +def is_colimit_equiv_is_limit_unop {X Y Z : Cᵒᵖ} {f : X ⟶ Y} {g : X ⟶ Z} + (c : pushout_cocone f g) : is_colimit c ≃ is_limit c.unop := +begin + apply equiv_of_subsingleton_of_subsingleton, + { intro h, + apply is_limit_cocone_unop, + equiv_rw is_colimit.precompose_hom_equiv _ _, + equiv_rw (is_colimit.whisker_equivalence_equiv _).symm, + exact h, }, + { intro h, + equiv_rw is_colimit.equiv_iso_colimit c.unop_op.symm, + equiv_rw is_colimit.precompose_hom_equiv _ _, + equiv_rw (is_colimit.whisker_equivalence_equiv walking_cospan_op_equiv.symm).symm, + exact is_colimit_cone_op _ h, }, end +end pushout_cocone + +namespace pullback_cone + +/-- A pullback cone is a limit cone if and only if the corresponding pushout cocone +in the opposite category is a colimit cocone. -/ +def is_limit_equiv_is_colimit_op {X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} + (c : pullback_cone f g) : is_limit c ≃ is_colimit c.op := +(is_limit.equiv_iso_limit c.op_unop).symm.trans c.op.is_colimit_equiv_is_limit_unop.symm + +/-- A pullback cone is a limit cone in `Cᵒᵖ` if and only if the corresponding pushout cocone +in `C` is a colimit cocone. -/ +def is_limit_equiv_is_colimit_unop {X Y Z : Cᵒᵖ} {f : X ⟶ Z} {g : Y ⟶ Z} + (c : pullback_cone f g) : is_limit c ≃ is_colimit c.unop := +(is_limit.equiv_iso_limit c.unop_op).symm.trans c.unop.is_colimit_equiv_is_limit_op.symm + +end pullback_cone + +section pullback + +open opposite + +/-- The pullback of `f` and `g` in `C` is isomorphic to the pushout of +`f.op` and `g.op` in `Cᵒᵖ`. -/ +noncomputable +def pullback_iso_unop_pushout {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) + [has_pullback f g] [has_pushout f.op g.op] : pullback f g ≅ unop (pushout f.op g.op) := +is_limit.cone_point_unique_up_to_iso (limit.is_limit _) + ((pushout_cocone.is_colimit_equiv_is_limit_unop _) (colimit.is_colimit (span f.op g.op))) + +@[simp, reassoc] +lemma pullback_iso_unop_pushout_inv_fst {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) + [has_pullback f g] [has_pushout f.op g.op] : + (pullback_iso_unop_pushout f g).inv ≫ pullback.fst = + (pushout.inl : _ ⟶ pushout f.op g.op).unop := +(is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _).trans (by simp) + +@[simp, reassoc] +lemma pullback_iso_unop_pushout_inv_snd {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) [has_pullback f g] [has_pushout f.op g.op] : + (pullback_iso_unop_pushout f g).inv ≫ pullback.snd = + (pushout.inr : _ ⟶ pushout f.op g.op).unop := +(is_limit.cone_point_unique_up_to_iso_inv_comp _ _ _).trans (by simp) + +@[simp, reassoc] +lemma pullback_iso_unop_pushout_hom_inl {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) [has_pullback f g] [has_pushout f.op g.op] : + pushout.inl ≫ (pullback_iso_unop_pushout f g).hom.op = pullback.fst.op := +begin + apply quiver.hom.unop_inj, + dsimp, + rw [← pullback_iso_unop_pushout_inv_fst, iso.hom_inv_id_assoc], +end + +@[simp, reassoc] +lemma pullback_iso_unop_pushout_hom_inr {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) [has_pullback f g] [has_pushout f.op g.op] : + pushout.inr ≫ (pullback_iso_unop_pushout f g).hom.op = pullback.snd.op := +begin + apply quiver.hom.unop_inj, + dsimp, + rw [← pullback_iso_unop_pushout_inv_snd, iso.hom_inv_id_assoc], +end + +end pullback + +section pushout + +/-- The pushout of `f` and `g` in `C` is isomorphic to the pullback of + `f.op` and `g.op` in `Cᵒᵖ`. -/ +noncomputable +def pushout_iso_unop_pullback {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) + [has_pushout f g] [has_pullback f.op g.op] : pushout f g ≅ unop (pullback f.op g.op) := +is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) + ((pullback_cone.is_limit_equiv_is_colimit_unop _) (limit.is_limit (cospan f.op g.op))) +. +@[simp, reassoc] +lemma pushout_iso_unop_pullback_inl_hom {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) + [has_pushout f g] [has_pullback f.op g.op] : + pushout.inl ≫ (pushout_iso_unop_pullback f g).hom = + (pullback.fst : pullback f.op g.op ⟶ _).unop := +(is_colimit.comp_cocone_point_unique_up_to_iso_hom _ _ _).trans (by simp) + +@[simp, reassoc] +lemma pushout_iso_unop_pullback_inr_hom {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) + [has_pushout f g] [has_pullback f.op g.op] : + pushout.inr ≫ (pushout_iso_unop_pullback f g).hom = + (pullback.snd : pullback f.op g.op ⟶ _).unop := +(is_colimit.comp_cocone_point_unique_up_to_iso_hom _ _ _).trans (by simp) + +@[simp] +lemma pushout_iso_unop_pullback_inv_fst {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) + [has_pushout f g] [has_pullback f.op g.op] : + (pushout_iso_unop_pullback f g).inv.op ≫ pullback.fst = pushout.inl.op := +begin + apply quiver.hom.unop_inj, + dsimp, + rw [← pushout_iso_unop_pullback_inl_hom, category.assoc, iso.hom_inv_id, category.comp_id], +end + +@[simp] +lemma pushout_iso_unop_pullback_inv_snd {X Y Z : C} (f : X ⟶ Z) (g : X ⟶ Y) + [has_pushout f g] [has_pullback f.op g.op] : + (pushout_iso_unop_pullback f g).inv.op ≫ pullback.snd = pushout.inr.op := +begin + apply quiver.hom.unop_inj, + dsimp, + rw [← pushout_iso_unop_pullback_inr_hom, category.assoc, iso.hom_inv_id, category.comp_id], +end + +end pushout + end category_theory.limits diff --git a/src/category_theory/limits/over.lean b/src/category_theory/limits/over.lean index 19ca81696d51d..ca2272a529949 100644 --- a/src/category_theory/limits/over.lean +++ b/src/category_theory/limits/over.lean @@ -13,6 +13,9 @@ import category_theory.limits.comma /-! # Limits and colimits in the over and under categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Show that the forgetful functor `forget X : over X ⥤ C` creates colimits, and hence `over X` has any colimits that `C` has (as well as the dual that `forget X : under X ⟶ C` creates limits). @@ -47,6 +50,12 @@ instance creates_colimits : creates_colimits (forget X) := costructured_arrow.cr example [has_colimits C] : preserves_colimits (forget X) := infer_instance example : reflects_colimits (forget X) := infer_instance +lemma epi_left_of_epi [has_pushouts C] {f g : over X} (h : f ⟶ g) [epi h] : epi h.left := +costructured_arrow.epi_left_of_epi _ + +lemma epi_iff_epi_left [has_pushouts C] {f g : over X} (h : f ⟶ g) : epi h ↔ epi h.left := +costructured_arrow.epi_iff_epi_left _ + section variables [has_pullbacks C] @@ -95,7 +104,7 @@ def pullback_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : pullback (f ≫ g) ≅ pullback g ⋙ pullback f := adjunction.right_adjoint_uniq (map_pullback_adj _) - (((map_pullback_adj _).comp _ _ (map_pullback_adj _)).of_nat_iso_left + (((map_pullback_adj _).comp (map_pullback_adj _)).of_nat_iso_left (over.map_comp _ _).symm) instance pullback_is_right_adjoint {A B : C} (f : A ⟶ B) : @@ -115,6 +124,12 @@ instance has_limit_of_has_limit_comp_forget instance [has_limits_of_shape J C] : has_limits_of_shape J (under X) := {} instance [has_limits C] : has_limits (under X) := ⟨infer_instance⟩ +lemma mono_right_of_mono [has_pullbacks C] {f g : under X} (h : f ⟶ g) [mono h] : mono h.right := +structured_arrow.mono_right_of_mono _ + +lemma mono_iff_mono_right [has_pullbacks C] {f g : under X} (h : f ⟶ g) : mono h ↔ mono h.right := +structured_arrow.mono_iff_mono_right _ + instance creates_limits : creates_limits (forget X) := structured_arrow.creates_limits -- We can automatically infer that the forgetful functor preserves and reflects limits. diff --git a/src/category_theory/limits/pi.lean b/src/category_theory/limits/pi.lean index 870d341575665..f332f4f13ec6e 100644 --- a/src/category_theory/limits/pi.lean +++ b/src/category_theory/limits/pi.lean @@ -9,6 +9,9 @@ import category_theory.limits.has_limits /-! # Limits in the category of indexed families of objects. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a functor `F : J ⥤ Π i, C i` into a category of indexed families, 1. we can assemble a collection of cones over `F ⋙ pi.eval C i` into a cone over `F` 2. if all those cones are limit cones, the assembled cone is a limit cone, and diff --git a/src/category_theory/limits/preserves/basic.lean b/src/category_theory/limits/preserves/basic.lean index 8ffba8813beca..47b7218dec758 100644 --- a/src/category_theory/limits/preserves/basic.lean +++ b/src/category_theory/limits/preserves/basic.lean @@ -1,13 +1,16 @@ /- Copyright (c) 2018 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Reid Barton, Bhavik Mehta +Authors: Scott Morrison, Reid Barton, Bhavik Mehta, Jakob von Raumer -/ import category_theory.limits.has_limits /-! # Preservation and reflection of (co)limits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + There are various distinct notions of "preserving limits". The one we aim to capture here is: A functor F : C → D "preserves limits" if it sends every limit cone in C to a limit cone in D. Informally, F @@ -232,6 +235,20 @@ def preserves_limits_of_shape_of_equiv {J' : Type w₂} [category.{w₂'} J'] (e { dsimp, simp [←functor.map_comp] }, -- See library note [dsimp, simp]. end } } +/-- +`preserves_limits_of_size_shrink.{w w'} F` tries to obtain `preserves_limits_of_size.{w w'} F` +from some other `preserves_limits_of_size F`. +-/ +def preserves_limits_of_size_shrink (F : C ⥤ D) + [preserves_limits_of_size.{(max w w₂) (max w' w₂')} F] : preserves_limits_of_size.{w w'} F := +⟨λ J hJ, by exactI preserves_limits_of_shape_of_equiv + (ulift_hom_ulift_category.equiv.{w₂ w₂'} J).symm F⟩ + +/-- Preserving limits at any universe level implies preserving limits in universe `0`. -/ +def preserves_smallest_limits_of_preserves_limits + (F : C ⥤ D) [preserves_limits_of_size.{v₃ u₃} F] : preserves_limits_of_size.{0 0} F := +preserves_limits_of_size_shrink F + /-- If F preserves one colimit cocone for the diagram K, then it preserves any colimit cocone for K. -/ def preserves_colimit_of_preserves_colimit_cocone {F : C ⥤ D} {t : cocone K} @@ -278,6 +295,20 @@ def preserves_colimits_of_shape_of_equiv {J' : Type w₂} [category.{w₂'} J'] { dsimp, simp [←functor.map_comp] }, -- See library note [dsimp, simp]. end } } +/-- +`preserves_colimits_of_size_shrink.{w w'} F` tries to obtain `preserves_colimits_of_size.{w w'} F` +from some other `preserves_colimits_of_size F`. +-/ +def preserves_colimits_of_size_shrink (F : C ⥤ D) + [preserves_colimits_of_size.{(max w w₂) (max w' w₂')} F] : preserves_colimits_of_size.{w w'} F := +⟨λ J hJ, by exactI preserves_colimits_of_shape_of_equiv + (ulift_hom_ulift_category.equiv.{w₂ w₂'} J).symm F⟩ + +/-- Preserving colimits at any universe implies preserving colimits at universe `0`. -/ +def preserves_smallest_colimits_of_preserves_colimits + (F : C ⥤ D) [preserves_colimits_of_size.{v₃ u₃} F] : preserves_colimits_of_size.{0 0} F := +preserves_colimits_of_size_shrink F + /-- A functor `F : C ⥤ D` reflects limits for `K : J ⥤ C` if whenever the image of a cone over `K` under `F` is a limit cone in `D`, @@ -501,6 +532,33 @@ def reflects_limits_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [reflects_limits_of reflects_limits_of_size.{w' w} G := { reflects_limits_of_shape := λ J 𝒥₁, by exactI reflects_limits_of_shape_of_nat_iso h } +/-- Transfer reflection of limits along a equivalence in the shape. -/ +def reflects_limits_of_shape_of_equiv {J' : Type w₂} [category.{w₂'} J'] (e : J ≌ J') + (F : C ⥤ D) [reflects_limits_of_shape J F] : + reflects_limits_of_shape J' F := +{ reflects_limit := λ K, + { reflects := λ c t, + begin + apply is_limit.of_whisker_equivalence e, + apply is_limit_of_reflects F, + apply is_limit.of_iso_limit _ (functor.map_cone_whisker _).symm, + exact is_limit.whisker_equivalence t _, + end } } + +/-- +`reflects_limits_of_size_shrink.{w w'} F` tries to obtain `reflects_limits_of_size.{w w'} F` +from some other `reflects_limits_of_size F`. +-/ +def reflects_limits_of_size_shrink (F : C ⥤ D) + [reflects_limits_of_size.{(max w w₂) (max w' w₂')} F] : reflects_limits_of_size.{w w'} F := +⟨λ J hJ, by exactI reflects_limits_of_shape_of_equiv + (ulift_hom_ulift_category.equiv.{w₂ w₂'} J).symm F⟩ + +/-- Reflecting limits at any universe implies reflecting limits at universe `0`. -/ +def reflects_smallest_limits_of_reflects_limits + (F : C ⥤ D) [reflects_limits_of_size.{v₃ u₃} F] : reflects_limits_of_size.{0 0} F := +reflects_limits_of_size_shrink F + /-- If the limit of `F` exists and `G` preserves it, then if `G` reflects isomorphisms then it reflects the limit of `F`. @@ -585,6 +643,33 @@ def reflects_colimits_of_nat_iso {F G : C ⥤ D} (h : F ≅ G) [reflects_colimit reflects_colimits_of_size.{w w'} G := { reflects_colimits_of_shape := λ J 𝒥₁, by exactI reflects_colimits_of_shape_of_nat_iso h } +/-- Transfer reflection of colimits along a equivalence in the shape. -/ +def reflects_colimits_of_shape_of_equiv {J' : Type w₂} [category.{w₂'} J'] (e : J ≌ J') + (F : C ⥤ D) [reflects_colimits_of_shape J F] : + reflects_colimits_of_shape J' F := +{ reflects_colimit := λ K, + { reflects := λ c t, + begin + apply is_colimit.of_whisker_equivalence e, + apply is_colimit_of_reflects F, + apply is_colimit.of_iso_colimit _ (functor.map_cocone_whisker _).symm, + exact is_colimit.whisker_equivalence t _, + end } } + +/-- +`reflects_colimits_of_size_shrink.{w w'} F` tries to obtain `reflects_colimits_of_size.{w w'} F` +from some other `reflects_colimits_of_size F`. +-/ +def reflects_colimits_of_size_shrink (F : C ⥤ D) + [reflects_colimits_of_size.{(max w w₂) (max w' w₂')} F] : reflects_colimits_of_size.{w w'} F := +⟨λ J hJ, by exactI reflects_colimits_of_shape_of_equiv + (ulift_hom_ulift_category.equiv.{w₂ w₂'} J).symm F⟩ + +/-- Reflecting colimits at any universe implies reflecting colimits at universe `0`. -/ +def reflects_smallest_colimits_of_reflects_colimits + (F : C ⥤ D) [reflects_colimits_of_size.{v₃ u₃} F] : reflects_colimits_of_size.{0 0} F := +reflects_colimits_of_size_shrink F + /-- If the colimit of `F` exists and `G` preserves it, then if `G` reflects isomorphisms then it reflects the colimit of `F`. diff --git a/src/category_theory/limits/preserves/filtered.lean b/src/category_theory/limits/preserves/filtered.lean index 173ea53be9670..aab016a35621e 100644 --- a/src/category_theory/limits/preserves/filtered.lean +++ b/src/category_theory/limits/preserves/filtered.lean @@ -8,8 +8,14 @@ import category_theory.filtered /-! # Preservation of filtered colimits and cofiltered limits. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Typically forgetful functors from algebraic categories preserve filtered colimits (although not general colimits). See e.g. `algebra/category/Mon/filtered_colimits`. + +## Future work +This could be generalised to allow diagrams in lower universes. -/ open category_theory diff --git a/src/category_theory/limits/preserves/finite.lean b/src/category_theory/limits/preserves/finite.lean index 8619fd213fff2..2512c091e6de6 100644 --- a/src/category_theory/limits/preserves/finite.lean +++ b/src/category_theory/limits/preserves/finite.lean @@ -9,6 +9,9 @@ import category_theory.fin_category /-! # Preservation of finite (co)limits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + These functors are also known as left exact (flat) or right exact functors when the categories involved are abelian, or more generally, finitely (co)complete. @@ -25,53 +28,133 @@ open category_theory namespace category_theory.limits -universes v u₁ u₂ u₃ -- declare the `v`'s first; see `category_theory.category` for an explanation +-- declare the `v`'s first; see `category_theory.category` for an explanation +universes w w₂ v₁ v₂ v₃ u₁ u₂ u₃ -variables {C : Type u₁} [category.{v} C] -variables {D : Type u₂} [category.{v} D] -variables {E : Type u₃} [category.{v} E] +variables {C : Type u₁} [category.{v₁} C] +variables {D : Type u₂} [category.{v₂} D] +variables {E : Type u₃} [category.{v₃} E] -variables {J : Type v} [small_category J] {K : J ⥤ C} +variables {J : Type w} [small_category J] {K : J ⥤ C} /-- -A functor is said to preserve finite limits, if it preserves all limits of shape `J`, where -`J` is a finite category. +A functor is said to preserve finite limits, if it preserves all limits of shape `J`, +where `J : Type` is a finite category. -/ class preserves_finite_limits (F : C ⥤ D) := -(preserves_finite_limits : Π (J : Type v) [small_category J] [fin_category J], +(preserves_finite_limits : Π (J : Type) [small_category J] [fin_category J], preserves_limits_of_shape J F . tactic.apply_instance) attribute [instance] preserves_finite_limits.preserves_finite_limits +/-- Preserving finite limits also implies preserving limits over finite shapes in higher universes, +though through a noncomputable instance. -/ @[priority 100] -instance preserves_limits.preserves_finite_limits (F : C ⥤ D) [preserves_limits F] : - preserves_finite_limits F := {} - -instance id_preserves_finite_limits : - preserves_finite_limits (𝟭 C) := {} +noncomputable instance preserves_limits_of_shape_of_preserves_finite_limits (F : C ⥤ D) + [preserves_finite_limits F] (J : Type w) [small_category J] [fin_category J] : + preserves_limits_of_shape J F := +by apply preserves_limits_of_shape_of_equiv (fin_category.equiv_as_type J) + +-- This is a dangerous instance as it has unbound universe variables. +/-- If we preserve limits of some arbitrary size, then we preserve all finite limits. -/ +noncomputable def preserves_limits_of_size.preserves_finite_limits (F : C ⥤ D) + [preserves_limits_of_size.{w w₂} F] : preserves_finite_limits F := +⟨λ J sJ fJ, + begin + haveI := preserves_smallest_limits_of_preserves_limits F, + exact preserves_limits_of_shape_of_equiv (fin_category.equiv_as_type J) F, + end⟩ + +-- Added as a specialization of the dangerous instance above, for limits indexed in Type 0. +@[priority 120] +noncomputable instance preserves_limits_of_size.zero.preserves_finite_limits (F : C ⥤ D) + [preserves_limits_of_size.{0 0} F] : preserves_finite_limits F := + preserves_limits_of_size.preserves_finite_limits F + +-- An alternative specialization of the dangerous instance for small limits. +@[priority 120] +noncomputable instance preserves_limits.preserves_finite_limits (F : C ⥤ D) + [preserves_limits F] : preserves_finite_limits F := +preserves_limits_of_size.preserves_finite_limits F + +/-- We can always derive `preserves_finite_limits C` by showing that we are preserving limits at an +arbitrary universe. -/ +def preserves_finite_limits_of_preserves_finite_limits_of_size (F : C ⥤ D) + (h : ∀ (J : Type w) {𝒥 : small_category J} (hJ : @fin_category J 𝒥), + by { resetI, exact preserves_limits_of_shape J F }) : + preserves_finite_limits F := +⟨λ J hJ hhJ, + begin + resetI, + letI : category.{w w} (ulift_hom.{w} (ulift.{w 0} J)), + { apply ulift_hom.category.{0}, exact category_theory.ulift_category J }, + haveI := h (ulift_hom.{w} (ulift.{w} J)) category_theory.fin_category_ulift, + exact preserves_limits_of_shape_of_equiv (ulift_hom_ulift_category.equiv.{w w} J).symm F + end⟩ + +instance id_preserves_finite_limits : preserves_finite_limits (𝟭 C) := {} /-- The composition of two left exact functors is left exact. -/ def comp_preserves_finite_limits (F : C ⥤ D) (G : D ⥤ E) - [preserves_finite_limits F] [preserves_finite_limits G] : - preserves_finite_limits (F ⋙ G) := + [preserves_finite_limits F] [preserves_finite_limits G] : preserves_finite_limits (F ⋙ G) := ⟨λ _ _ _, by { resetI, apply_instance }⟩ /-- -A functor is said to preserve finite colimits, if it preserves all colimits of shape `J`, where -`J` is a finite category. +A functor is said to preserve finite colimits, if it preserves all colimits of +shape `J`, where `J : Type` is a finite category. -/ class preserves_finite_colimits (F : C ⥤ D) := -(preserves_finite_colimits : Π (J : Type v) [small_category J] [fin_category J], +(preserves_finite_colimits : Π (J : Type) [small_category J] [fin_category J], preserves_colimits_of_shape J F . tactic.apply_instance) attribute [instance] preserves_finite_colimits.preserves_finite_colimits +/-- Preserving finite limits also implies preserving limits over finite shapes in higher universes, +though through a noncomputable instance. -/ @[priority 100] -instance preserves_colimits.preserves_finite_colimits (F : C ⥤ D) [preserves_colimits F] : - preserves_finite_colimits F := {} - -instance id_preserves_finite_colimits : - preserves_finite_colimits (𝟭 C) := {} +noncomputable instance preserves_colimits_of_shape_of_preserves_finite_colimits (F : C ⥤ D) + [preserves_finite_colimits F] (J : Type w) [small_category J] [fin_category J] : + preserves_colimits_of_shape J F := +by apply preserves_colimits_of_shape_of_equiv (fin_category.equiv_as_type J) + +/-- If we preserve colimits of some arbitrary size, then we preserve all finite colimits. -/ +-- This is a dangerous instance as it has unbound universe variables. +noncomputable def preserves_colimits_of_size.preserves_finite_colimits (F : C ⥤ D) + [preserves_colimits_of_size.{w w₂} F] : preserves_finite_colimits F := +⟨λ J sJ fJ, + begin + haveI := preserves_smallest_colimits_of_preserves_colimits F, + exact preserves_colimits_of_shape_of_equiv (fin_category.equiv_as_type J) F, + end⟩ + +-- Added as a specialization of the dangerous instance above, for colimits indexed in Type 0. +@[priority 120] +noncomputable instance preserves_colimits_of_size.zero.preserves_finite_colimits (F : C ⥤ D) + [preserves_colimits_of_size.{0 0} F] : preserves_finite_colimits F := + preserves_colimits_of_size.preserves_finite_colimits F + +-- An alternative specialization of the dangerous instance for small colimits. +@[priority 120] +noncomputable instance preserves_colimits.preserves_finite_colimits (F : C ⥤ D) + [preserves_colimits F] : preserves_finite_colimits F := +preserves_colimits_of_size.preserves_finite_colimits F + +/-- We can always derive `preserves_finite_limits C` by showing that we are preserving limits at an +arbitrary universe. -/ +def preserves_finite_colimits_of_preserves_finite_colimits_of_size (F : C ⥤ D) + (h : ∀ (J : Type w) {𝒥 : small_category J} (hJ : @fin_category J 𝒥), + by { resetI, exact preserves_colimits_of_shape J F }) : + preserves_finite_colimits F := +⟨λ J hJ hhJ, + begin + resetI, + letI : category.{w w} (ulift_hom.{w} (ulift.{w 0} J)), + { apply ulift_hom.category.{0}, exact category_theory.ulift_category J }, + haveI := h (ulift_hom.{w} (ulift.{w} J)) category_theory.fin_category_ulift, + exact preserves_colimits_of_shape_of_equiv (ulift_hom_ulift_category.equiv.{w w} J).symm F + end⟩ + +instance id_preserves_finite_colimits : preserves_finite_colimits (𝟭 C) := {} /-- The composition of two right exact functors is right exact. -/ def comp_preserves_finite_colimits (F : C ⥤ D) (G : D ⥤ E) diff --git a/src/category_theory/limits/preserves/functor_category.lean b/src/category_theory/limits/preserves/functor_category.lean index a267cd407e0df..2db3de686ed80 100644 --- a/src/category_theory/limits/preserves/functor_category.lean +++ b/src/category_theory/limits/preserves/functor_category.lean @@ -11,6 +11,9 @@ import category_theory.limits.presheaf /-! # Preservation of (co)limits in the functor category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + * Show that if `X ⨯ -` preserves colimits in `D` for any `X : D`, then the product functor `F ⨯ -` for `F : C ⥤ D` preserves colimits. @@ -96,7 +99,7 @@ instance whiskering_right_preserves_limits {C : Type u} [category C] /-- If `Lan F.op : (Cᵒᵖ ⥤ Type*) ⥤ (Dᵒᵖ ⥤ Type*)` preserves limits of shape `J`, so will `F`. -/ noncomputable -def preserves_limit_of_Lan_presesrves_limit {C D : Type u} [small_category C] [small_category D] +def preserves_limit_of_Lan_preserves_limit {C D : Type u} [small_category C] [small_category D] (F : C ⥤ D) (J : Type u) [small_category J] [preserves_limits_of_shape J (Lan F.op : _ ⥤ (Dᵒᵖ ⥤ Type u))] : preserves_limits_of_shape J F := diff --git a/src/category_theory/limits/preserves/limits.lean b/src/category_theory/limits/preserves/limits.lean index de20dc065a9ea..4798fffae9805 100644 --- a/src/category_theory/limits/preserves/limits.lean +++ b/src/category_theory/limits/preserves/limits.lean @@ -8,6 +8,9 @@ import category_theory.limits.preserves.basic /-! # Isomorphisms about functors which preserve (co)limits +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `G` preserves limits, and `C` and `D` have limits, then for any diagram `F : J ⥤ C` we have a canonical isomorphism `preserves_limit_iso : G.obj (limit F) ≅ limit (F ⋙ G)`. We also show that we can commute `is_limit.lift` of a preserved limit with `functor.map_cone`: diff --git a/src/category_theory/limits/preserves/opposites.lean b/src/category_theory/limits/preserves/opposites.lean index 115f22c342131..915b9945217fc 100644 --- a/src/category_theory/limits/preserves/opposites.lean +++ b/src/category_theory/limits/preserves/opposites.lean @@ -9,6 +9,9 @@ import category_theory.limits.preserves.finite /-! # Limit preservation properties of `functor.op` and related constructions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We formulate conditions about `F` which imply that `F.op`, `F.unop`, `F.left_op` and `F.right_op` preserve certain (co)limits. diff --git a/src/category_theory/limits/preserves/shapes/binary_products.lean b/src/category_theory/limits/preserves/shapes/binary_products.lean index 32070a3d7366d..63991b148292e 100644 --- a/src/category_theory/limits/preserves/shapes/binary_products.lean +++ b/src/category_theory/limits/preserves/shapes/binary_products.lean @@ -9,6 +9,9 @@ import category_theory.limits.preserves.basic /-! # Preserving binary products +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructions to relate the notions of preserving binary products and reflecting binary products to concrete binary fans. @@ -18,12 +21,12 @@ the product of `X` and `Y`. noncomputable theory -universes v u₁ u₂ +universes v₁ v₂ u₁ u₂ open category_theory category_theory.category category_theory.limits -variables {C : Type u₁} [category.{v} C] -variables {D : Type u₂} [category.{v} D] +variables {C : Type u₁} [category.{v₁} C] +variables {D : Type u₂} [category.{v₂} D] variables (G : C ⥤ D) namespace category_theory.limits @@ -37,7 +40,7 @@ essentially lets us commute `binary_fan.mk` with `functor.map_cone`. -/ def is_limit_map_cone_binary_fan_equiv : is_limit (G.map_cone (binary_fan.mk f g)) ≃ is_limit (binary_fan.mk (G.map f) (G.map g)) := -(is_limit.postcompose_hom_equiv (diagram_iso_pair.{v} _) _).symm.trans +(is_limit.postcompose_hom_equiv (diagram_iso_pair _) _).symm.trans (is_limit.equiv_iso_limit (cones.ext (iso.refl _) (by { rintro (_ | _), tidy }))) /-- The property of preserving products expressed in terms of binary fans. -/ @@ -112,7 +115,7 @@ This essentially lets us commute `binary_cofan.mk` with `functor.map_cocone`. def is_colimit_map_cocone_binary_cofan_equiv : is_colimit (G.map_cocone (binary_cofan.mk f g)) ≃ is_colimit (binary_cofan.mk (G.map f) (G.map g)) := -(is_colimit.precompose_hom_equiv (diagram_iso_pair.{v} _).symm _).symm.trans +(is_colimit.precompose_hom_equiv (diagram_iso_pair _).symm _).symm.trans (is_colimit.equiv_iso_colimit (cocones.ext (iso.refl _) (by { rintro (_ | _), tidy, }))) /-- The property of preserving coproducts expressed in terms of binary cofans. -/ diff --git a/src/category_theory/limits/preserves/shapes/biproducts.lean b/src/category_theory/limits/preserves/shapes/biproducts.lean index e69f4ecaf044e..d98231a3610dc 100644 --- a/src/category_theory/limits/preserves/shapes/biproducts.lean +++ b/src/category_theory/limits/preserves/shapes/biproducts.lean @@ -9,17 +9,21 @@ import category_theory.limits.preserves.shapes.zero /-! # Preservation of biproducts +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the image of a (binary) bicone under a functor that preserves zero morphisms and define classes `preserves_biproduct` and `preserves_binary_biproduct`. We then * show that a functor that preserves biproducts of a two-element type preserves binary biproducts, -* give the canonical isomorphism between the image of a biproduct and the biproduct of the images, -* show that in a preadditive category, a functor preserves a biproduct if and only if it preserves - the corresponding product if and only if it preserves the corresponding coproduct. +* construct the comparison morphisms between the image of a biproduct and the biproduct of the + images and show that the biproduct is preserved if one of them is an isomorphism, +* give the canonical isomorphism between the image of a biproduct and the biproduct of the images + in case that the biproduct is preserved. -/ -universes v u u₂ +universes w₁ w₂ v₁ v₂ u₁ u₂ noncomputable theory @@ -28,7 +32,7 @@ open category_theory.limits namespace category_theory -variables {C : Type u} [category.{v} C] {D : Type u₂} [category.{v} D] +variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] section has_zero_morphisms variables [has_zero_morphisms C] [has_zero_morphisms D] @@ -39,7 +43,7 @@ section map variables (F : C ⥤ D) [preserves_zero_morphisms F] section bicone -variables {J : Type v} [decidable_eq J] +variables {J : Type w₁} /-- The image of a bicone under a functor. -/ @[simps] @@ -56,6 +60,9 @@ def map_bicone {f : J → C} (b : bicone f) : bicone (F.obj ∘ f) := { rw [bicone_ι_π_ne _ h, F.map_zero] } end } +lemma map_bicone_whisker {K : Type w₂} {g : K ≃ J} {f : J → C} (c : bicone f) : + F.map_bicone (c.whisker g) = (F.map_bicone c).whisker g := rfl + end bicone /-- The image of a binary bicone under a functor. -/ @@ -80,7 +87,7 @@ open category_theory.functor namespace limits section bicone -variables {J : Type v} [decidable_eq J] +variables {J : Type w₁} {K : Type w₂} /-- A functor `F` preserves biproducts of `f` if `F` maps every bilimit bicone over `f` to a bilimit bicone over `F.obj ∘ f`. -/ @@ -107,20 +114,29 @@ end bicone /-- A functor `F` preserves finite biproducts if it preserves biproducts of shape `J` whenever `J` is a fintype. -/ class preserves_finite_biproducts (F : C ⥤ D) [preserves_zero_morphisms F] := -(preserves : Π {J : Type v} [decidable_eq J] [fintype J], preserves_biproducts_of_shape J F) +(preserves : Π {J : Type} [fintype J], preserves_biproducts_of_shape J F) attribute [instance, priority 100] preserves_finite_biproducts.preserves -/-- A functor `F` preserves biproducts if it preserves biproducts of any (small) shape `J`. -/ +/-- A functor `F` preserves biproducts if it preserves biproducts of any shape `J` of size `w`. + The usual notion of preservation of biproducts is recovered by choosing `w` to be the universe + of the morphisms of `C`. -/ class preserves_biproducts (F : C ⥤ D) [preserves_zero_morphisms F] := -(preserves : Π {J : Type v} [decidable_eq J], preserves_biproducts_of_shape J F) +(preserves : Π {J : Type w₁}, preserves_biproducts_of_shape J F) attribute [instance, priority 100] preserves_biproducts.preserves +/-- Preserving biproducts at a bigger universe level implies preserving biproducts at a +smaller universe level. -/ +def preserves_biproducts_shrink (F : C ⥤ D) [preserves_zero_morphisms F] + [hp : preserves_biproducts.{max w₁ w₂} F] : preserves_biproducts.{w₁} F := +⟨λ J, ⟨λ f, ⟨λ b ib, ((F.map_bicone b).whisker_is_bilimit_iff _).to_fun + (is_bilimit_of_preserves F ((b.whisker_is_bilimit_iff equiv.ulift.{w₂}).inv_fun ib))⟩⟩⟩ + @[priority 100] instance preserves_finite_biproducts_of_preserves_biproducts (F : C ⥤ D) - [preserves_zero_morphisms F] [preserves_biproducts F] : preserves_finite_biproducts F := -{ preserves := λ J _ _, infer_instance } + [preserves_zero_morphisms F] [preserves_biproducts.{w₁} F] : preserves_finite_biproducts F := +{ preserves := λ J _, by letI := preserves_biproducts_shrink.{0} F; apply_instance } /-- A functor `F` preserves binary biproducts of `X` and `Y` if `F` maps every bilimit bicone over `X` and `Y` to a bilimit bicone over `F.obj X` and `F.obj Y`. -/ @@ -141,20 +157,20 @@ class preserves_binary_biproducts (F : C ⥤ D) [preserves_zero_morphisms F] := /-- A functor that preserves biproducts of a pair preserves binary biproducts. -/ def preserves_binary_biproduct_of_preserves_biproduct (F : C ⥤ D) [preserves_zero_morphisms F] - (X Y : C) [preserves_biproduct (pair X Y).obj F] : preserves_binary_biproduct X Y F := + (X Y : C) [preserves_biproduct (pair_function X Y) F] : preserves_binary_biproduct X Y F := { preserves := λ b hb, { is_limit := is_limit.of_iso_limit ((is_limit.postcompose_hom_equiv (by exact diagram_iso_pair _) _).symm ((is_bilimit_of_preserves F (b.to_bicone_is_bilimit.symm hb)).is_limit)) $ - cones.ext (iso.refl _) (λ j, by { cases j, tidy }), + cones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩, tidy, }), is_colimit := is_colimit.of_iso_colimit ((is_colimit.precompose_inv_equiv (by exact diagram_iso_pair _ ) _).symm ((is_bilimit_of_preserves F (b.to_bicone_is_bilimit.symm hb)).is_colimit)) $ - cocones.ext (iso.refl _) (λ j, by { cases j, tidy }) } } + cocones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩, tidy, }) } } /-- A functor that preserves biproducts of a pair preserves binary biproducts. -/ def preserves_binary_biproducts_of_preserves_biproducts (F : C ⥤ D) - [preserves_zero_morphisms F] [preserves_biproducts_of_shape (discrete walking_pair.{v}) F] : + [preserves_zero_morphisms F] [preserves_biproducts_of_shape walking_pair F] : preserves_binary_biproducts F := { preserves := λ X Y, preserves_binary_biproduct_of_preserves_biproduct F X Y } @@ -167,8 +183,57 @@ open category_theory.limits namespace functor section bicone -variables {J : Type v} [decidable_eq J] (F : C ⥤ D) [preserves_zero_morphisms F] (f : J → C) - [has_biproduct f] [preserves_biproduct f F] +variables {J : Type w₁} (F : C ⥤ D) (f : J → C) + [has_biproduct f] + +section +variables [has_biproduct (F.obj ∘ f)] + +/-- As for products, any functor between categories with biproducts gives rise to a morphism + `F.obj (⨁ f) ⟶ ⨁ (F.obj ∘ f)`. -/ +def biproduct_comparison : F.obj (⨁ f) ⟶ ⨁ (F.obj ∘ f) := +biproduct.lift (λ j, F.map (biproduct.π f j)) + +@[simp, reassoc] lemma biproduct_comparison_π (j : J) : + biproduct_comparison F f ≫ biproduct.π _ j = F.map (biproduct.π f j) := +biproduct.lift_π _ _ + +/-- As for coproducts, any functor between categories with biproducts gives rise to a morphism + `⨁ (F.obj ∘ f) ⟶ F.obj (⨁ f)` -/ +def biproduct_comparison' : ⨁ (F.obj ∘ f) ⟶ F.obj (⨁ f) := +biproduct.desc (λ j, F.map (biproduct.ι f j)) + +@[simp, reassoc] lemma ι_biproduct_comparison' (j : J) : + biproduct.ι _ j ≫ biproduct_comparison' F f = F.map (biproduct.ι f j) := +biproduct.ι_desc _ _ + +variables [preserves_zero_morphisms F] + +/-- The composition in the opposite direction is equal to the identity if and only if `F` preserves + the biproduct, see `preserves_biproduct_of_mono_biproduct_comparison`. -/ +@[simp, reassoc] lemma biproduct_comparison'_comp_biproduct_comparison : + biproduct_comparison' F f ≫ biproduct_comparison F f = 𝟙 (⨁ (F.obj ∘ f)) := +by { classical, ext, simp [biproduct.ι_π, ← functor.map_comp, eq_to_hom_map] } + +/-- `biproduct_comparison F f` is a split epimorphism. -/ +@[simps] +def split_epi_biproduct_comparison : split_epi (biproduct_comparison F f) := +⟨biproduct_comparison' F f⟩ + +instance : is_split_epi (biproduct_comparison F f) := +is_split_epi.mk' (split_epi_biproduct_comparison F f) + +/-- `biproduct_comparison' F f` is a split monomorphism. -/ +@[simps] +def split_mono_biproduct_comparison' : split_mono (biproduct_comparison' F f) := +⟨biproduct_comparison F f⟩ + +instance : is_split_mono (biproduct_comparison' F f) := +is_split_mono.mk' (split_mono_biproduct_comparison' F f) + +end + +variables [preserves_zero_morphisms F] [preserves_biproduct f F] instance has_biproduct_of_preserves : has_biproduct (F.obj ∘ f) := has_biproduct.mk @@ -189,8 +254,64 @@ rfl end bicone -variables (F : C ⥤ D) [preserves_zero_morphisms F] (X Y : C) [has_binary_biproduct X Y] - [preserves_binary_biproduct X Y F] +variables (F : C ⥤ D) (X Y : C) [has_binary_biproduct X Y] + +section +variables [has_binary_biproduct (F.obj X) (F.obj Y)] + +/-- As for products, any functor between categories with binary biproducts gives rise to a + morphism `F.obj (X ⊞ Y) ⟶ F.obj X ⊞ F.obj Y`. -/ +def biprod_comparison : F.obj (X ⊞ Y) ⟶ F.obj X ⊞ F.obj Y := +biprod.lift (F.map biprod.fst) (F.map biprod.snd) + +@[simp, reassoc] lemma biprod_comparison_fst : + biprod_comparison F X Y ≫ biprod.fst = F.map biprod.fst := +biprod.lift_fst _ _ + +@[simp, reassoc] lemma biprod_comparison_snd : + biprod_comparison F X Y ≫ biprod.snd = F.map biprod.snd := +biprod.lift_snd _ _ + +/-- As for coproducts, any functor between categories with binary biproducts gives rise to a + morphism `F.obj X ⊞ F.obj Y ⟶ F.obj (X ⊞ Y)`. -/ +def biprod_comparison' : F.obj X ⊞ F.obj Y ⟶ F.obj (X ⊞ Y) := +biprod.desc (F.map biprod.inl) (F.map biprod.inr) + +@[simp, reassoc] lemma inl_biprod_comparison' : + biprod.inl ≫ biprod_comparison' F X Y = F.map biprod.inl := +biprod.inl_desc _ _ + +@[simp, reassoc] lemma inr_biprod_comparison' : + biprod.inr ≫ biprod_comparison' F X Y = F.map biprod.inr := +biprod.inr_desc _ _ + +variables [preserves_zero_morphisms F] + +/-- The composition in the opposite direction is equal to the identity if and only if `F` preserves + the biproduct, see `preserves_binary_biproduct_of_mono_biprod_comparison`. -/ +@[simp, reassoc] lemma biprod_comparison'_comp_biprod_comparison : + biprod_comparison' F X Y ≫ biprod_comparison F X Y = 𝟙 (F.obj X ⊞ F.obj Y) := +by { ext; simp [← functor.map_comp] } + +/-- `biprod_comparison F X Y` is a split epi. -/ +@[simps] +def split_epi_biprod_comparison : split_epi (biprod_comparison F X Y) := +⟨biprod_comparison' F X Y⟩ + +instance : is_split_epi (biprod_comparison F X Y) := +is_split_epi.mk' (split_epi_biprod_comparison F X Y) + +/-- `biprod_comparison' F X Y` is a split mono. -/ +@[simps] +def split_mono_biprod_comparison' : split_mono (biprod_comparison' F X Y) := +⟨biprod_comparison F X Y⟩ + +instance : is_split_mono (biprod_comparison' F X Y) := +is_split_mono.mk' (split_mono_biprod_comparison' F X Y) + +end + +variables [preserves_zero_morphisms F] [preserves_binary_biproduct X Y F] instance has_binary_biproduct_of_preserves : has_binary_biproduct (F.obj X) (F.obj Y) := has_binary_biproduct.mk @@ -216,7 +337,7 @@ namespace limits variables (F : C ⥤ D) [preserves_zero_morphisms F] section bicone -variables {J : Type v} [decidable_eq J] (f : J → C) [has_biproduct f] [preserves_biproduct f F] +variables {J : Type w₁} (f : J → C) [has_biproduct f] [preserves_biproduct f F] {W : C} lemma biproduct.map_lift_map_biprod (g : Π j, W ⟶ f j) : @@ -258,163 +379,4 @@ end limits end has_zero_morphisms -open category_theory.functor - -section preadditive -variables [preadditive C] [preadditive D] (F : C ⥤ D) [preserves_zero_morphisms F] - -namespace limits - -section fintype -variables {J : Type v} [decidable_eq J] [fintype J] - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts - preserves finite products. -/ -def preserves_product_of_preserves_biproduct {f : J → C} [preserves_biproduct f F] : - preserves_limit (discrete.functor f) F := -{ preserves := λ c hc, is_limit.of_iso_limit - ((is_limit.postcompose_inv_equiv (discrete.comp_nat_iso_discrete _ _) _).symm - (is_bilimit_of_preserves F (bicone_is_bilimit_of_limit_cone_of_is_limit hc)).is_limit) $ - cones.ext (iso.refl _) (by tidy) } - -section -local attribute [instance] preserves_product_of_preserves_biproduct - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts - preserves finite products. -/ -def preserves_products_of_shape_of_preserves_biproducts_of_shape - [preserves_biproducts_of_shape J F] : preserves_limits_of_shape (discrete J) F := -{ preserves_limit := λ f, preserves_limit_of_iso_diagram _ discrete.nat_iso_functor.symm } - -end - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite products - preserves finite biproducts. -/ -def preserves_biproduct_of_preserves_product {f : J → C} [preserves_limit (discrete.functor f) F] : - preserves_biproduct f F := -{ preserves := λ b hb, is_bilimit_of_is_limit _ $ - is_limit.of_iso_limit ((is_limit.postcompose_hom_equiv (discrete.comp_nat_iso_discrete _ _) - (F.map_cone b.to_cone)).symm (is_limit_of_preserves F hb.is_limit)) $ - cones.ext (iso.refl _) (by tidy) } - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite products - preserves finite biproducts. -/ -def preserves_biproducts_of_shape_of_preserves_products_of_shape - [preserves_limits_of_shape (discrete J) F] : preserves_biproducts_of_shape J F := -{ preserves := λ f, preserves_biproduct_of_preserves_product F } - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts - preserves finite coproducts. -/ -def preserves_coproduct_of_preserves_biproduct {f : J → C} [preserves_biproduct f F] : - preserves_colimit (discrete.functor f) F := -{ preserves := λ c hc, is_colimit.of_iso_colimit - ((is_colimit.precompose_hom_equiv (discrete.comp_nat_iso_discrete _ _) _).symm - (is_bilimit_of_preserves F - (bicone_is_bilimit_of_colimit_cocone_of_is_colimit hc)).is_colimit) $ - cocones.ext (iso.refl _) (by tidy) } - -section -local attribute [instance] preserves_coproduct_of_preserves_biproduct - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts - preserves finite coproducts. -/ -def preserves_coproducts_of_shape_of_preserves_biproducts_of_shape - [preserves_biproducts_of_shape J F] : preserves_colimits_of_shape (discrete J) F := -{ preserves_colimit := λ f, preserves_colimit_of_iso_diagram _ discrete.nat_iso_functor.symm } - -end - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite coproducts - preserves finite biproducts. -/ -def preserves_biproduct_of_preserves_coproduct {f : J → C} - [preserves_colimit (discrete.functor f) F] : preserves_biproduct f F := -{ preserves := λ b hb, is_bilimit_of_is_colimit _ $ - is_colimit.of_iso_colimit ((is_colimit.precompose_inv_equiv (discrete.comp_nat_iso_discrete _ _) - (F.map_cocone b.to_cocone)).symm (is_colimit_of_preserves F hb.is_colimit)) $ - cocones.ext (iso.refl _) (by tidy) } - -/-- A functor between preadditive categories that preserves (zero morphisms and) finite coproducts - preserves finite biproducts. -/ -def preserves_biproducts_of_shape_of_preserves_coproducts_of_shape - [preserves_colimits_of_shape (discrete J) F] : preserves_biproducts_of_shape J F := -{ preserves := λ f, preserves_biproduct_of_preserves_coproduct F } - -end fintype - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts - preserves binary products. -/ -def preserves_binary_product_of_preserves_binary_biproduct {X Y : C} - [preserves_binary_biproduct X Y F] : preserves_limit (pair X Y) F := -{ preserves := λ c hc, is_limit.of_iso_limit - ((is_limit.postcompose_inv_equiv (by exact diagram_iso_pair _) _).symm - (is_binary_bilimit_of_preserves F - (binary_bicone_is_bilimit_of_limit_cone_of_is_limit hc)).is_limit) $ - cones.ext (iso.refl _) (λ j, by { cases j, tidy }) } - -section -local attribute [instance] preserves_binary_product_of_preserves_binary_biproduct - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts - preserves binary products. -/ -def preserves_binary_products_of_preserves_binary_biproducts - [preserves_binary_biproducts F] : preserves_limits_of_shape (discrete walking_pair.{v}) F := -{ preserves_limit := λ K, preserves_limit_of_iso_diagram _ (diagram_iso_pair _).symm } - -end - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary products - preserves binary biproducts. -/ -def preserves_binary_biproduct_of_preserves_binary_product {X Y : C} - [preserves_limit (pair X Y) F] : preserves_binary_biproduct X Y F := -{ preserves := λ b hb, is_binary_bilimit_of_is_limit _ $ - is_limit.of_iso_limit ((is_limit.postcompose_hom_equiv (by exact diagram_iso_pair _) - (F.map_cone b.to_cone)).symm (is_limit_of_preserves F hb.is_limit)) $ - cones.ext (iso.refl _) (λ j, by { cases j, tidy }) } - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary products - preserves binary biproducts. -/ -def preserves_binary_biproducts_of_preserves_binary_products - [preserves_limits_of_shape (discrete walking_pair.{v}) F] : preserves_binary_biproducts F := -{ preserves := λ X Y, preserves_binary_biproduct_of_preserves_binary_product F } - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts - preserves binary coproducts. -/ -def preserves_binary_coproduct_of_preserves_binary_biproduct {X Y : C} - [preserves_binary_biproduct X Y F] : preserves_colimit (pair X Y) F := -{ preserves := λ c hc, is_colimit.of_iso_colimit - ((is_colimit.precompose_hom_equiv (by exact diagram_iso_pair _) _).symm - (is_binary_bilimit_of_preserves F - (binary_bicone_is_bilimit_of_colimit_cocone_of_is_colimit hc)).is_colimit) $ - cocones.ext (iso.refl _) (λ j, by { cases j, tidy }) } - -section -local attribute [instance] preserves_binary_coproduct_of_preserves_binary_biproduct - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts - preserves binary coproducts. -/ -def preserves_binary_coproducts_of_preserves_binary_biproducts - [preserves_binary_biproducts F] : preserves_colimits_of_shape (discrete walking_pair.{v}) F := -{ preserves_colimit := λ K, preserves_colimit_of_iso_diagram _ (diagram_iso_pair _).symm } - -end - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary coproducts - preserves binary biproducts. -/ -def preserves_binary_biproduct_of_preserves_binary_coproduct {X Y : C} - [preserves_colimit (pair X Y) F] : preserves_binary_biproduct X Y F := -{ preserves := λ b hb, is_binary_bilimit_of_is_colimit _ $ - is_colimit.of_iso_colimit ((is_colimit.precompose_inv_equiv (by exact diagram_iso_pair _) - (F.map_cocone b.to_cocone)).symm (is_colimit_of_preserves F hb.is_colimit)) $ - cocones.ext (iso.refl _) (λ j, by { cases j, tidy }) } - -/-- A functor between preadditive categories that preserves (zero morphisms and) binary coproducts - preserves binary biproducts. -/ -def preserves_binary_biproducts_of_preserves_binary_coproducts - [preserves_colimits_of_shape (discrete walking_pair.{v}) F] : preserves_binary_biproducts F := -{ preserves := λ X Y, preserves_binary_biproduct_of_preserves_binary_coproduct F } - -end limits - -end preadditive - end category_theory diff --git a/src/category_theory/limits/preserves/shapes/equalizers.lean b/src/category_theory/limits/preserves/shapes/equalizers.lean index a499268a22f5d..0fa7a3b6f92b6 100644 --- a/src/category_theory/limits/preserves/shapes/equalizers.lean +++ b/src/category_theory/limits/preserves/shapes/equalizers.lean @@ -9,6 +9,9 @@ import category_theory.limits.preserves.basic /-! # Preserving (co)equalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers to concrete (co)forks. @@ -18,12 +21,12 @@ the limit of the parallel pair `f,g`, as well as the dual result. noncomputable theory -universes v u₁ u₂ +universes w v₁ v₂ u₁ u₂ open category_theory category_theory.category category_theory.limits -variables {C : Type u₁} [category.{v} C] -variables {D : Type u₂} [category.{v} D] +variables {C : Type u₁} [category.{v₁} C] +variables {D : Type u₂} [category.{v₂} D] variables (G : C ⥤ D) namespace category_theory.limits @@ -38,7 +41,7 @@ essentially lets us commute `fork.of_ι` with `functor.map_cone`. def is_limit_map_cone_fork_equiv : is_limit (G.map_cone (fork.of_ι h w)) ≃ is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) := -(is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans +(is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair _) _).symm.trans (is_limit.equiv_iso_limit (fork.ext (iso.refl _) (by { simp [fork.ι] }))) /-- The property of preserving equalizers expressed in terms of forks. -/ @@ -115,7 +118,7 @@ This essentially lets us commute `cofork.of_π` with `functor.map_cocone`. def is_colimit_map_cocone_cofork_equiv : is_colimit (G.map_cocone (cofork.of_π h w)) ≃ is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) := -(is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair.{v} _) _).symm.trans $ +(is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair _) _).symm.trans $ is_colimit.equiv_iso_colimit $ cofork.ext (iso.refl _) $ begin dsimp only [cofork.π, cofork.of_π_ι_app], @@ -183,6 +186,47 @@ begin apply_instance end +instance map_π_epi : epi (G.map (coequalizer.π f g)) := +⟨λ W h k, by { rw ←ι_comp_coequalizer_comparison, apply (cancel_epi _).1, apply epi_comp }⟩ + +@[reassoc] +lemma map_π_preserves_coequalizer_inv : + G.map (coequalizer.π f g) ≫ (preserves_coequalizer.iso G f g).inv = + coequalizer.π (G.map f) (G.map g) := +begin + rw [←ι_comp_coequalizer_comparison_assoc, ←preserves_coequalizer.iso_hom, + iso.hom_inv_id, comp_id], +end + +@[reassoc] +lemma map_π_preserves_coequalizer_inv_desc + {W : D} (k : G.obj Y ⟶ W) (wk : G.map f ≫ k = G.map g ≫ k) : + G.map (coequalizer.π f g) ≫ (preserves_coequalizer.iso G f g).inv ≫ coequalizer.desc k wk = k := +by rw [←category.assoc, map_π_preserves_coequalizer_inv, coequalizer.π_desc] + +@[reassoc] +lemma map_π_preserves_coequalizer_inv_colim_map + {X' Y' : D} (f' g' : X' ⟶ Y') [has_coequalizer f' g'] (p : G.obj X ⟶ X') (q : G.obj Y ⟶ Y') + (wf : (G.map f) ≫ q = p ≫ f') (wg : (G.map g) ≫ q = p ≫ g') : + G.map (coequalizer.π f g) ≫ (preserves_coequalizer.iso G f g).inv ≫ + colim_map (parallel_pair_hom (G.map f) (G.map g) f' g' p q wf wg) = + q ≫ coequalizer.π f' g' := +by rw [←category.assoc, map_π_preserves_coequalizer_inv, ι_colim_map, parallel_pair_hom_app_one] + +@[reassoc] +lemma map_π_preserves_coequalizer_inv_colim_map_desc + {X' Y' : D} (f' g' : X' ⟶ Y') [has_coequalizer f' g'] (p : G.obj X ⟶ X') (q : G.obj Y ⟶ Y') + (wf : (G.map f) ≫ q = p ≫ f') (wg : (G.map g) ≫ q = p ≫ g') + {Z' : D} (h : Y' ⟶ Z') (wh : f' ≫ h = g' ≫ h) : + G.map (coequalizer.π f g) ≫ (preserves_coequalizer.iso G f g).inv ≫ + colim_map (parallel_pair_hom (G.map f) (G.map g) f' g' p q wf wg) ≫ + coequalizer.desc h wh = + q ≫ h := +begin + slice_lhs 1 3 { rw map_π_preserves_coequalizer_inv_colim_map }, + slice_lhs 2 3 { rw coequalizer.π_desc }, +end + /-- Any functor preserves coequalizers of split pairs. -/ @[priority 1] instance preserves_split_coequalizers (f g : X ⟶ Y) [has_split_coequalizer f g] : diff --git a/src/category_theory/limits/preserves/shapes/images.lean b/src/category_theory/limits/preserves/shapes/images.lean new file mode 100644 index 0000000000000..d88487ddc47a4 --- /dev/null +++ b/src/category_theory/limits/preserves/shapes/images.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2022 Jujian Zhang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jujian Zhang +-/ +import category_theory.limits.shapes.images +import category_theory.limits.constructions.epi_mono + +/-! +# Preserving images + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we show that if a functor preserves span and cospan, then it preserves images. +-/ + + +noncomputable theory + +namespace category_theory + +namespace preserves_image + +open category_theory +open category_theory.limits + +universes u₁ u₂ v₁ v₂ + +variables {A : Type u₁} {B : Type u₂} [category.{v₁} A] [category.{v₂} B] +variables [has_equalizers A] [has_images A] +variables [strong_epi_category B] [has_images B] +variables (L : A ⥤ B) +variables [Π {X Y Z : A} (f : X ⟶ Z) (g : Y ⟶ Z), preserves_limit (cospan f g) L] +variables [Π {X Y Z : A} (f : X ⟶ Y) (g : X ⟶ Z), preserves_colimit (span f g) L] + +/-- +If a functor preserves span and cospan, then it preserves images. +-/ +@[simps] def iso {X Y : A} (f : X ⟶ Y) : image (L.map f) ≅ L.obj (image f) := +let aux1 : strong_epi_mono_factorisation (L.map f) := +{ I := L.obj (limits.image f), + m := L.map $ limits.image.ι _, + m_mono := preserves_mono_of_preserves_limit _ _, + e := L.map $ factor_thru_image _, + e_strong_epi := @@strong_epi_of_epi _ _ _ $ preserves_epi_of_preserves_colimit L _, + fac' := by rw [←L.map_comp, limits.image.fac] } in +is_image.iso_ext (image.is_image (L.map f)) aux1.to_mono_is_image + +@[reassoc] lemma factor_thru_image_comp_hom {X Y : A} (f : X ⟶ Y) : + factor_thru_image (L.map f) ≫ (iso L f).hom = + L.map (factor_thru_image f) := +by simp + +@[reassoc] lemma hom_comp_map_image_ι {X Y : A} (f : X ⟶ Y) : + (iso L f).hom ≫ L.map (image.ι f) = image.ι (L.map f) := +by simp + +@[reassoc] lemma inv_comp_image_ι_map {X Y : A} (f : X ⟶ Y) : + (iso L f).inv ≫ image.ι (L.map f) = L.map (image.ι f) := +by simp + +end preserves_image + +end category_theory diff --git a/src/category_theory/limits/preserves/shapes/kernels.lean b/src/category_theory/limits/preserves/shapes/kernels.lean index 0662414ba6c4e..7f916b5db6c08 100644 --- a/src/category_theory/limits/preserves/shapes/kernels.lean +++ b/src/category_theory/limits/preserves/shapes/kernels.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import category_theory.limits.shapes.kernels -import category_theory.limits.preserves.shapes.equalizers import category_theory.limits.preserves.shapes.zero /-! # Preserving (co)kernels +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructions to relate the notions of preserving (co)kernels and reflecting (co)kernels to concrete (co)forks. @@ -19,12 +21,12 @@ the limit of the parallel pair `f,0`, as well as the dual result. noncomputable theory -universes v u₁ u₂ +universes v₁ v₂ u₁ u₂ open category_theory category_theory.category category_theory.limits -variables {C : Type u₁} [category.{v} C] [has_zero_morphisms C] -variables {D : Type u₂} [category.{v} D] [has_zero_morphisms D] +variables {C : Type u₁} [category.{v₁} C] [has_zero_morphisms C] +variables {D : Type u₂} [category.{v₂} D] [has_zero_morphisms D] variables (G : C ⥤ D) [functor.preserves_zero_morphisms G] namespace category_theory.limits @@ -89,8 +91,8 @@ def preserves_kernel.of_iso_comparison [i : is_iso (kernel_comparison f G)] : begin apply preserves_limit_of_preserves_limit_cone (kernel_is_kernel f), apply (is_limit_map_cone_fork_equiv' G (kernel.condition f)).symm _, - apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) 0)), - apply i, + apply is_limit.of_point_iso (kernel_is_kernel (G.map f)), + exact i, end variables [preserves_limit (parallel_pair f 0) G] @@ -102,7 +104,7 @@ def preserves_kernel.iso : G.obj (kernel f) ≅ kernel (G.map f) := is_limit.cone_point_unique_up_to_iso (is_limit_of_has_kernel_of_preserves_limit G f) - (limit.is_limit _) + (kernel_is_kernel _) @[simp] lemma preserves_kernel.iso_hom : @@ -115,6 +117,17 @@ begin apply_instance end +@[reassoc] lemma kernel_map_comp_preserves_kernel_iso_inv {X' Y' : C} (g : X' ⟶ Y') [has_kernel g] + [has_kernel (G.map g)] [preserves_limit (parallel_pair g 0) G] (p : X ⟶ X') (q : Y ⟶ Y') + (hpq : f ≫ q = p ≫ g) : + kernel.map (G.map f) (G.map g) (G.map p) (G.map q) + (by rw [←G.map_comp, hpq, G.map_comp]) ≫ (preserves_kernel.iso G _).inv + = (preserves_kernel.iso G _).inv ≫ G.map (kernel.map f g p q hpq) := +begin + rw [iso.comp_inv_eq, category.assoc, preserves_kernel.iso_hom, iso.eq_inv_comp], + exact kernel_comparison_comp_kernel_map _ _ _ _ _ _, +end + end kernels section cokernels @@ -181,8 +194,8 @@ def preserves_cokernel.of_iso_comparison [i : is_iso (cokernel_comparison f G)] begin apply preserves_colimit_of_preserves_colimit_cocone (cokernel_is_cokernel f), apply (is_colimit_map_cocone_cofork_equiv' G (cokernel.condition f)).symm _, - apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) 0)), - apply i, + apply is_colimit.of_point_iso (cokernel_is_cokernel (G.map f)), + exact i, end variables [preserves_colimit (parallel_pair f 0) G] @@ -194,7 +207,7 @@ def preserves_cokernel.iso : G.obj (cokernel f) ≅ cokernel (G.map f) := is_colimit.cocone_point_unique_up_to_iso (is_colimit_of_has_cokernel_of_preserves_colimit G f) - (colimit.is_colimit _) + (cokernel_is_cokernel _) @[simp] lemma preserves_cokernel.iso_inv : @@ -207,6 +220,17 @@ begin apply_instance end +@[reassoc] lemma preserves_cokernel_iso_comp_cokernel_map {X' Y' : C} (g : X' ⟶ Y') + [has_cokernel g] [has_cokernel (G.map g)] [preserves_colimit (parallel_pair g 0) G] + (p : X ⟶ X') (q : Y ⟶ Y') (hpq : f ≫ q = p ≫ g) : + (preserves_cokernel.iso G _).hom ≫ cokernel.map (G.map f) (G.map g) (G.map p) (G.map q) + (by rw [←G.map_comp, hpq, G.map_comp]) = + G.map (cokernel.map f g p q hpq) ≫ (preserves_cokernel.iso G _).hom := +begin + rw [←iso.comp_inv_eq, category.assoc, ←iso.eq_inv_comp], + exact cokernel_map_comp_cokernel_comparison _ _ _ _ _ _, +end + end cokernels end category_theory.limits diff --git a/src/category_theory/limits/preserves/shapes/products.lean b/src/category_theory/limits/preserves/shapes/products.lean index 65c4572c5fcc1..751bb9de6af24 100644 --- a/src/category_theory/limits/preserves/shapes/products.lean +++ b/src/category_theory/limits/preserves/shapes/products.lean @@ -9,6 +9,9 @@ import category_theory.limits.preserves.basic /-! # Preserving products +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructions to relate the notions of preserving products and reflecting products to concrete fans. @@ -18,17 +21,17 @@ the limit of `f`. noncomputable theory -universes v u₁ u₂ +universes w v₁ v₂ u₁ u₂ open category_theory category_theory.category category_theory.limits -variables {C : Type u₁} [category.{v} C] -variables {D : Type u₂} [category.{v} D] +variables {C : Type u₁} [category.{v₁} C] +variables {D : Type u₂} [category.{v₂} D] variables (G : C ⥤ D) namespace category_theory.limits -variables {J : Type v} (f : J → C) +variables {J : Type w} (f : J → C) /-- The map of a fan is a limit iff the fan consisting of the mapped morphisms is a limit. This @@ -39,8 +42,8 @@ def is_limit_map_cone_fan_mk_equiv {P : C} (g : Π j, P ⟶ f j) : is_limit (fan.mk _ (λ j, G.map (g j)) : fan (λ j, G.obj (f j))) := begin refine (is_limit.postcompose_hom_equiv _ _).symm.trans (is_limit.equiv_iso_limit _), - refine discrete.nat_iso (λ j, iso.refl (G.obj (f j))), - refine cones.ext (iso.refl _) (λ j, by { dsimp, simp }), + refine discrete.nat_iso (λ j, iso.refl (G.obj (f j.as))), + refine cones.ext (iso.refl _) (λ j, by { discrete_cases, dsimp, simp }), end /-- The property of preserving products expressed in terms of fans. -/ @@ -111,8 +114,8 @@ def is_colimit_map_cocone_cofan_mk_equiv {P : C} (g : Π j, f j ⟶ P) : is_colimit (cofan.mk _ (λ j, G.map (g j)) : cofan (λ j, G.obj (f j))) := begin refine (is_colimit.precompose_hom_equiv _ _).symm.trans (is_colimit.equiv_iso_colimit _), - refine discrete.nat_iso (λ j, iso.refl (G.obj (f j))), - refine cocones.ext (iso.refl _) (λ j, by { dsimp, simp }), + refine discrete.nat_iso (λ j, iso.refl (G.obj (f j.as))), + refine cocones.ext (iso.refl _) (λ j, by { discrete_cases, dsimp, simp }), end /-- The property of preserving coproducts expressed in terms of cofans. -/ diff --git a/src/category_theory/limits/preserves/shapes/pullbacks.lean b/src/category_theory/limits/preserves/shapes/pullbacks.lean index 7b7086075200b..0c24c8404924c 100644 --- a/src/category_theory/limits/preserves/shapes/pullbacks.lean +++ b/src/category_theory/limits/preserves/shapes/pullbacks.lean @@ -9,6 +9,9 @@ import category_theory.limits.preserves.basic /-! # Preserving pullbacks +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructions to relate the notions of preserving pullbacks and reflecting pullbacks to concrete pullback cones. @@ -44,10 +47,9 @@ def is_limit_map_cone_pullback_cone_equiv : is_limit (G.map_cone (pullback_cone.mk h k comm)) ≃ is_limit (pullback_cone.mk (G.map h) (G.map k) (by simp only [← G.map_comp, comm]) : pullback_cone (G.map f) (G.map g)) := -(is_limit.whisker_equivalence_equiv walking_cospan_equiv.{v₂ v₁}).trans $ - (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₂} _) _).symm.trans $ - is_limit.equiv_iso_limit $ cones.ext (iso.refl _) $ - (by rintro (_|_|_); dsimp; simpa only [category.comp_id, category.id_comp, ← G.map_comp]) +(is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₂} _) _).symm.trans $ +is_limit.equiv_iso_limit $ cones.ext (iso.refl _) $ + (by rintro (_|_|_); dsimp; simp only [comp_id, id_comp, G.map_comp]) /-- The property of preserving pullbacks expressed in terms of binary fans. -/ def is_limit_pullback_cone_map_of_is_limit [preserves_limit (cospan f g) G] @@ -73,13 +75,12 @@ is_limit_pullback_cone_map_of_is_limit G _ (pullback_is_pullback f g) def preserves_pullback_symmetry : preserves_limit (cospan g f) G := { preserves := λ c hc, begin - apply (is_limit.whisker_equivalence_equiv walking_cospan_equiv.{v₂ v₁}).symm.to_fun, apply (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₂} _) _).to_fun, apply is_limit.of_iso_limit _ (pullback_cone.iso_mk _).symm, apply pullback_cone.flip_is_limit, apply (is_limit_map_cone_pullback_cone_equiv _ _).to_fun, { apply_with preserves_limit.preserves { instances := ff }, - { dsimp [walking_cospan_equiv], apply_instance }, + { dsimp, apply_instance }, apply pullback_cone.flip_is_limit, apply is_limit.of_iso_limit _ (pullback_cone.iso_mk _), exact (is_limit.postcompose_hom_equiv (diagram_iso_cospan.{v₁} _) _).inv_fun hc }, @@ -87,6 +88,10 @@ def preserves_pullback_symmetry : preserves_limit (cospan g f) G := (c.π.naturality walking_cospan.hom.inl : _) } end } +lemma has_pullback_of_preserves_pullback [has_pullback f g] : + has_pullback (G.map f) (G.map g) := +⟨⟨⟨_, is_limit_pullback_cone_map_of_is_limit G _ (pullback_is_pullback _ _)⟩⟩⟩ + variables [has_pullback f g] [has_pullback (G.map f) (G.map g)] /-- If `G` preserves the pullback of `(f,g)`, then the pullback comparison map for `G` at `(f,g)` is @@ -128,10 +133,9 @@ def is_colimit_map_cocone_pushout_cocone_equiv : is_colimit (G.map_cocone (pushout_cocone.mk h k comm)) ≃ is_colimit (pushout_cocone.mk (G.map h) (G.map k) (by simp only [← G.map_comp, comm]) : pushout_cocone (G.map f) (G.map g)) := -(is_colimit.whisker_equivalence_equiv walking_span_equiv.{v₂ v₁}).trans $ - (is_colimit.precompose_hom_equiv (diagram_iso_span.{v₂} _).symm _).symm.trans $ - is_colimit.equiv_iso_colimit $ cocones.ext (iso.refl _) $ - (by rintro (_|_|_); dsimp; simpa only [category.comp_id, category.id_comp, ← G.map_comp]) +(is_colimit.precompose_hom_equiv (diagram_iso_span.{v₂} _).symm _).symm.trans $ +is_colimit.equiv_iso_colimit $ cocones.ext (iso.refl _) $ + (by rintro (_|_|_); dsimp; simp only [category.comp_id, category.id_comp, ← G.map_comp]) /-- The property of preserving pushouts expressed in terms of binary cofans. -/ def is_colimit_pushout_cocone_map_of_is_colimit [preserves_colimit (span f g) G] @@ -157,13 +161,12 @@ is_colimit_pushout_cocone_map_of_is_colimit G _ (pushout_is_pushout f g) def preserves_pushout_symmetry : preserves_colimit (span g f) G := { preserves := λ c hc, begin - apply (is_colimit.whisker_equivalence_equiv walking_span_equiv.{v₂ v₁}).symm.to_fun, apply (is_colimit.precompose_hom_equiv (diagram_iso_span.{v₂} _).symm _).to_fun, apply is_colimit.of_iso_colimit _ (pushout_cocone.iso_mk _).symm, apply pushout_cocone.flip_is_colimit, apply (is_colimit_map_cocone_pushout_cocone_equiv _ _).to_fun, { apply_with preserves_colimit.preserves { instances := ff }, - { dsimp [walking_span_equiv], apply_instance }, + { dsimp, apply_instance }, apply pushout_cocone.flip_is_colimit, apply is_colimit.of_iso_colimit _ (pushout_cocone.iso_mk _), exact (is_colimit.precompose_hom_equiv (diagram_iso_span.{v₁} _) _).inv_fun hc }, @@ -171,6 +174,10 @@ def preserves_pushout_symmetry : preserves_colimit (span g f) G := (c.ι.naturality walking_span.hom.fst).symm } end } +lemma has_pushout_of_preserves_pushout [has_pushout f g] : + has_pushout (G.map f) (G.map g) := +⟨⟨⟨_, is_colimit_pushout_cocone_map_of_is_colimit G _ (pushout_is_pushout _ _)⟩⟩⟩ + variables [has_pushout f g] [has_pushout (G.map f) (G.map g)] /-- If `G` preserves the pushout of `(f,g)`, then the pushout comparison map for `G` at `(f,g)` is diff --git a/src/category_theory/limits/preserves/shapes/terminal.lean b/src/category_theory/limits/preserves/shapes/terminal.lean index c6f0381a6c1ea..a263aae00272b 100644 --- a/src/category_theory/limits/preserves/shapes/terminal.lean +++ b/src/category_theory/limits/preserves/shapes/terminal.lean @@ -9,6 +9,9 @@ import category_theory.limits.preserves.basic /-! # Preserving terminal object +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructions to relate the notions of preserving terminal objects and reflecting terminal objects to concrete objects. @@ -16,7 +19,7 @@ In particular, we show that `terminal_comparison G` is an isomorphism iff `G` pr objects. -/ -universes v v₁ v₂ u u₁ u₂ +universes w v v₁ v₂ u u₁ u₂ noncomputable theory @@ -36,25 +39,31 @@ section terminal The map of an empty cone is a limit iff the mapped object is terminal. -/ def is_limit_map_cone_empty_cone_equiv : - is_limit (G.map_cone (as_empty_cone.{v₁} X)) ≃ is_terminal (G.obj X) := + is_limit (G.map_cone (as_empty_cone X)) ≃ is_terminal (G.obj X) := is_limit_empty_cone_equiv D _ _ (eq_to_iso rfl) /-- The property of preserving terminal objects expressed in terms of `is_terminal`. -/ -def is_terminal.is_terminal_obj [preserves_limit (functor.empty.{v₁} C) G] +def is_terminal.is_terminal_obj [preserves_limit (functor.empty.{0} C) G] (l : is_terminal X) : is_terminal (G.obj X) := is_limit_map_cone_empty_cone_equiv G X (preserves_limit.preserves l) /-- The property of reflecting terminal objects expressed in terms of `is_terminal`. -/ -def is_terminal.is_terminal_of_obj [reflects_limit (functor.empty.{v₁} C) G] +def is_terminal.is_terminal_of_obj [reflects_limit (functor.empty.{0} C) G] (l : is_terminal (G.obj X)) : is_terminal X := reflects_limit.reflects ((is_limit_map_cone_empty_cone_equiv G X).symm l) +/-- Preserving the terminal object implies preserving all limits of the empty diagram. -/ +def preserves_limits_of_shape_pempty_of_preserves_terminal + [preserves_limit (functor.empty.{0} C) G] : preserves_limits_of_shape (discrete pempty) G := +{ preserves_limit := λ K, + preserves_limit_of_iso_diagram G (functor.empty_ext (functor.empty.{0} C) _) } + variables [has_terminal C] /-- If `G` preserves the terminal object and `C` has a terminal object, then the image of the terminal object is terminal. -/ -def is_limit_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty.{v₁} C) G] : +def is_limit_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty.{0} C) G] : is_terminal (G.obj (⊤_ C)) := terminal_is_terminal.is_terminal_obj G (⊤_ C) @@ -65,7 +74,7 @@ Note this property is somewhat unique to (co)limits of the empty diagram: for ge has limits of shape `J` and `G` preserves them, then `D` does not necessarily have limits of shape `J`. -/ -lemma has_terminal_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty.{v₁} C) G] : +lemma has_terminal_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty.{0} C) G] : has_terminal D := ⟨λ F, begin @@ -82,7 +91,7 @@ def preserves_terminal.of_iso_comparison begin apply preserves_limit_of_preserves_limit_cone terminal_is_terminal, apply (is_limit_map_cone_empty_cone_equiv _ _).symm _, - apply is_limit.of_point_iso (limit.is_limit (functor.empty.{v₂} D)), + apply is_limit.of_point_iso (limit.is_limit (functor.empty.{0} D)), apply i, end @@ -99,7 +108,7 @@ def preserves_terminal_of_iso (f : G.obj (⊤_ C) ≅ ⊤_ D) : preserves_limit (functor.empty C) G := preserves_terminal_of_is_iso G f.hom -variables [preserves_limit (functor.empty.{v₁} C) G] +variables [preserves_limit (functor.empty.{0} C) G] /-- If `G` preserves terminal objects, then the terminal comparison map for `G` is an isomorphism. @@ -129,21 +138,27 @@ def is_colimit_map_cocone_empty_cocone_equiv : is_colimit_empty_cocone_equiv D _ _ (eq_to_iso rfl) /-- The property of preserving initial objects expressed in terms of `is_initial`. -/ -def is_initial.is_initial_obj [preserves_colimit (functor.empty.{v₁} C) G] +def is_initial.is_initial_obj [preserves_colimit (functor.empty.{0} C) G] (l : is_initial X) : is_initial (G.obj X) := is_colimit_map_cocone_empty_cocone_equiv G X (preserves_colimit.preserves l) /-- The property of reflecting initial objects expressed in terms of `is_initial`. -/ -def is_initial.is_initial_of_obj [reflects_colimit (functor.empty.{v₁} C) G] +def is_initial.is_initial_of_obj [reflects_colimit (functor.empty.{0} C) G] (l : is_initial (G.obj X)) : is_initial X := reflects_colimit.reflects ((is_colimit_map_cocone_empty_cocone_equiv G X).symm l) +/-- Preserving the initial object implies preserving all colimits of the empty diagram. -/ +def preserves_colimits_of_shape_pempty_of_preserves_initial + [preserves_colimit (functor.empty.{0} C) G] : preserves_colimits_of_shape (discrete pempty) G := +{ preserves_colimit := λ K, + preserves_colimit_of_iso_diagram G (functor.empty_ext (functor.empty.{0} C) _) } + variables [has_initial C] /-- If `G` preserves the initial object and `C` has a initial object, then the image of the initial object is initial. -/ -def is_colimit_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty.{v₁} C) G] : +def is_colimit_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty.{0} C) G] : is_initial (G.obj (⊥_ C)) := initial_is_initial.is_initial_obj G (⊥_ C) @@ -154,7 +169,7 @@ Note this property is somewhat unique to colimits of the empty diagram: for gene has colimits of shape `J` and `G` preserves them, then `D` does not necessarily have colimits of shape `J`. -/ -lemma has_initial_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty.{v₁} C) G] : +lemma has_initial_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty.{0} C) G] : has_initial D := ⟨λ F, begin @@ -171,7 +186,7 @@ def preserves_initial.of_iso_comparison begin apply preserves_colimit_of_preserves_colimit_cocone initial_is_initial, apply (is_colimit_map_cocone_empty_cocone_equiv _ _).symm _, - apply is_colimit.of_point_iso (colimit.is_colimit (functor.empty.{v₂} D)), + apply is_colimit.of_point_iso (colimit.is_colimit (functor.empty.{0} D)), apply i, end @@ -188,7 +203,7 @@ def preserves_initial_of_iso (f : ⊥_ D ≅ G.obj (⊥_ C)) : preserves_colimit (functor.empty C) G := preserves_initial_of_is_iso G f.hom -variables [preserves_colimit (functor.empty.{v₁} C) G] +variables [preserves_colimit (functor.empty.{0} C) G] /-- If `G` preserves initial objects, then the initial comparison map for `G` is an isomorphism. -/ def preserves_initial.iso : G.obj (⊥_ C) ≅ ⊥_ D := diff --git a/src/category_theory/limits/preserves/shapes/zero.lean b/src/category_theory/limits/preserves/shapes/zero.lean index 407b1444f4f9f..643c7c51ab7b6 100644 --- a/src/category_theory/limits/preserves/shapes/zero.lean +++ b/src/category_theory/limits/preserves/shapes/zero.lean @@ -9,6 +9,9 @@ import category_theory.limits.shapes.zero_morphisms /-! # Preservation of zero objects and zero morphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the class `preserves_zero_morphisms` and show basic properties. ## Main results @@ -111,15 +114,33 @@ lemma preserves_zero_morphisms_of_map_zero_object (i : F.obj 0 ≅ 0) : preserve @[priority 100] instance preserves_zero_morphisms_of_preserves_initial_object - [preserves_colimit (functor.empty.{v₁} C) F] : preserves_zero_morphisms F := -preserves_zero_morphisms_of_map_zero_object $ (F.map_iso has_zero_object.zero_iso_initial).trans $ - (preserves_initial.iso F).trans has_zero_object.zero_iso_initial.symm + [preserves_colimit (functor.empty.{0} C) F] : preserves_zero_morphisms F := +preserves_zero_morphisms_of_map_zero_object $ + F.map_iso has_zero_object.zero_iso_initial + ≪≫ preserves_initial.iso F ≪≫ has_zero_object.zero_iso_initial.symm @[priority 100] instance preserves_zero_morphisms_of_preserves_terminal_object - [preserves_limit (functor.empty.{v₁} C) F] : preserves_zero_morphisms F := -preserves_zero_morphisms_of_map_zero_object $ (F.map_iso has_zero_object.zero_iso_terminal).trans $ - (preserves_terminal.iso F).trans has_zero_object.zero_iso_terminal.symm + [preserves_limit (functor.empty.{0} C) F] : preserves_zero_morphisms F := +preserves_zero_morphisms_of_map_zero_object $ + F.map_iso has_zero_object.zero_iso_terminal + ≪≫ preserves_terminal.iso F ≪≫ has_zero_object.zero_iso_terminal.symm + +variables (F) + +/-- Preserving zero morphisms implies preserving terminal objects. -/ +def preserves_terminal_object_of_preserves_zero_morphisms + [preserves_zero_morphisms F] : preserves_limit (functor.empty C) F := +preserves_terminal_of_iso F $ + F.map_iso has_zero_object.zero_iso_terminal.symm + ≪≫ map_zero_object F ≪≫ has_zero_object.zero_iso_terminal + +/-- Preserving zero morphisms implies preserving terminal objects. -/ +def preserves_initial_object_of_preserves_zero_morphisms + [preserves_zero_morphisms F] : preserves_colimit (functor.empty C) F := +preserves_initial_of_iso F $ + has_zero_object.zero_iso_initial.symm ≪≫ (map_zero_object F).symm + ≪≫ (F.map_iso has_zero_object.zero_iso_initial.symm).symm end zero_object diff --git a/src/category_theory/limits/presheaf.lean b/src/category_theory/limits/presheaf.lean index 9139a4069e2cb..166e034b49100 100644 --- a/src/category_theory/limits/presheaf.lean +++ b/src/category_theory/limits/presheaf.lean @@ -8,13 +8,15 @@ import category_theory.adjunction.opposites import category_theory.elements import category_theory.limits.functor_category import category_theory.limits.kan_extension -import category_theory.limits.preserves.limits import category_theory.limits.shapes.terminal import category_theory.limits.types /-! # Colimit of representables +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file constructs an adjunction `yoneda_adjunction` between `(Cᵒᵖ ⥤ Type u)` and `ℰ` given a functor `A : C ⥤ ℰ`, where the right adjoint sends `(E : ℰ)` to `c ↦ (A.obj c ⟶ E)` (provided `ℰ` has colimits). @@ -178,7 +180,8 @@ def is_initial (A : C) : is_initial (elements.initial A) := simp_rw ← m.2, dsimp [elements.initial], simp, - end } + end, + fac' := by rintros s ⟨⟨⟩⟩, } /-- `extend_along_yoneda A` is an extension of `A` to the presheaf category along the yoneda embedding. diff --git a/src/category_theory/limits/punit.lean b/src/category_theory/limits/punit.lean deleted file mode 100644 index 95732e70d9e95..0000000000000 --- a/src/category_theory/limits/punit.lean +++ /dev/null @@ -1,51 +0,0 @@ -/- -Copyright (c) 2020 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ - -import category_theory.punit -import category_theory.limits.has_limits - -/-! -# `discrete punit` has limits and colimits - -Mostly for the sake of constructing trivial examples, we show all (co)cones into `discrete punit` -are (co)limit (co)cones. We also show that such (co)cones exist, and that `discrete punit` has all -(co)limits. --/ - -universe v - -open category_theory -namespace category_theory.limits - -variables {J : Type v} [small_category J] {F : J ⥤ discrete punit.{v+1}} - -/-- A trivial cone for a functor into `punit`. `punit_cone_is_limit` shows it is a limit. -/ -def punit_cone : cone F := -⟨punit.star, (functor.punit_ext _ _).hom⟩ - -/-- A trivial cocone for a functor into `punit`. `punit_cocone_is_limit` shows it is a colimit. -/ -def punit_cocone : cocone F := -⟨punit.star, (functor.punit_ext _ _).hom⟩ - -/-- -Any cone over a functor into `punit` is a limit cone. --/ -def punit_cone_is_limit {c : cone F} : is_limit c := -by tidy - -/-- -Any cocone over a functor into `punit` is a colimit cocone. --/ -def punit_cocone_is_colimit {c : cocone F} : is_colimit c := -by tidy - -instance : has_limits (discrete punit) := -by tidy - -instance : has_colimits (discrete punit) := -by tidy - -end category_theory.limits diff --git a/src/category_theory/limits/shapes/binary_products.lean b/src/category_theory/limits/shapes/binary_products.lean index 2acc45e42b173..3a6301e637bd0 100644 --- a/src/category_theory/limits/shapes/binary_products.lean +++ b/src/category_theory/limits/shapes/binary_products.lean @@ -11,6 +11,9 @@ import category_theory.over /-! # Binary (co)products +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define a category `walking_pair`, which is the index category for a binary (co)product diagram. A convenience method `pair X Y` constructs the functor from the walking pair, hitting the given objects. @@ -38,7 +41,7 @@ namespace category_theory.limits /-- The type of objects for the diagram indexing a binary (co)product. -/ @[derive decidable_eq, derive inhabited] -inductive walking_pair : Type v +inductive walking_pair : Type | left | right open walking_pair @@ -71,38 +74,49 @@ def walking_pair.equiv_bool : walking_pair ≃ bool := @[simp] lemma walking_pair.equiv_bool_symm_apply_tt : walking_pair.equiv_bool.symm tt = left := rfl @[simp] lemma walking_pair.equiv_bool_symm_apply_ff : walking_pair.equiv_bool.symm ff = right := rfl -variables {C : Type u} [category.{v} C] +variables {C : Type u} + +/-- The function on the walking pair, sending the two points to `X` and `Y`. -/ +def pair_function (X Y : C) : walking_pair → C := λ j, walking_pair.cases_on j X Y + +@[simp] lemma pair_function_left (X Y : C) : pair_function X Y left = X := rfl +@[simp] lemma pair_function_right (X Y : C) : pair_function X Y right = Y := rfl + +variables [category.{v} C] /-- The diagram on the walking pair, sending the two points to `X` and `Y`. -/ -def pair (X Y : C) : discrete walking_pair.{v} ⥤ C := +def pair (X Y : C) : discrete walking_pair ⥤ C := discrete.functor (λ j, walking_pair.cases_on j X Y) -@[simp] lemma pair_obj_left (X Y : C) : (pair X Y).obj left = X := rfl -@[simp] lemma pair_obj_right (X Y : C) : (pair X Y).obj right = Y := rfl +@[simp] lemma pair_obj_left (X Y : C) : (pair X Y).obj ⟨left⟩ = X := rfl +@[simp] lemma pair_obj_right (X Y : C) : (pair X Y).obj ⟨right⟩ = Y := rfl section -variables {F G : discrete walking_pair.{v} ⥤ C} (f : F.obj left ⟶ G.obj left) - (g : F.obj right ⟶ G.obj right) +variables {F G : discrete walking_pair ⥤ C} (f : F.obj ⟨left⟩ ⟶ G.obj ⟨left⟩) + (g : F.obj ⟨right⟩ ⟶ G.obj ⟨right⟩) -/-- The natural transformation between two functors out of the walking pair, specified by its +local attribute [tidy] tactic.discrete_cases + +/-- The natural transformation between two functors out of the + walking pair, specified by its components. -/ -def map_pair : F ⟶ G := { app := λ j, walking_pair.cases_on j f g } +def map_pair : F ⟶ G := { app := λ j, discrete.rec_on j (λ j, walking_pair.cases_on j f g) } -@[simp] lemma map_pair_left : (map_pair f g).app left = f := rfl -@[simp] lemma map_pair_right : (map_pair f g).app right = g := rfl +@[simp] lemma map_pair_left : (map_pair f g).app ⟨left⟩ = f := rfl +@[simp] lemma map_pair_right : (map_pair f g).app ⟨right⟩ = g := rfl /-- The natural isomorphism between two functors out of the walking pair, specified by its components. -/ @[simps] -def map_pair_iso (f : F.obj left ≅ G.obj left) (g : F.obj right ≅ G.obj right) : F ≅ G := -nat_iso.of_components (λ j, walking_pair.cases_on j f g) (by tidy) +def map_pair_iso (f : F.obj ⟨left⟩ ≅ G.obj ⟨left⟩) (g : F.obj ⟨right⟩ ≅ G.obj ⟨right⟩) : F ≅ G := +nat_iso.of_components (λ j, discrete.rec_on j (λ j, walking_pair.cases_on j f g)) (by tidy) end /-- Every functor out of the walking pair is naturally isomorphic (actually, equal) to a `pair` -/ @[simps] def diagram_iso_pair (F : discrete walking_pair ⥤ C) : - F ≅ pair (F.obj walking_pair.left) (F.obj walking_pair.right) := + F ≅ pair (F.obj ⟨walking_pair.left⟩) (F.obj ⟨walking_pair.right⟩) := map_pair_iso (iso.refl _) (iso.refl _) section @@ -118,60 +132,125 @@ end abbreviation binary_fan (X Y : C) := cone (pair X Y) /-- The first projection of a binary fan. -/ -abbreviation binary_fan.fst {X Y : C} (s : binary_fan X Y) := s.π.app walking_pair.left +abbreviation binary_fan.fst {X Y : C} (s : binary_fan X Y) := s.π.app ⟨walking_pair.left⟩ /-- The second projection of a binary fan. -/ -abbreviation binary_fan.snd {X Y : C} (s : binary_fan X Y) := s.π.app walking_pair.right +abbreviation binary_fan.snd {X Y : C} (s : binary_fan X Y) := s.π.app ⟨walking_pair.right⟩ @[simp] lemma binary_fan.π_app_left {X Y : C} (s : binary_fan X Y) : - s.π.app walking_pair.left = s.fst := rfl + s.π.app ⟨walking_pair.left⟩ = s.fst := rfl @[simp] lemma binary_fan.π_app_right {X Y : C} (s : binary_fan X Y) : - s.π.app walking_pair.right = s.snd := rfl + s.π.app ⟨walking_pair.right⟩ = s.snd := rfl + +/-- A convenient way to show that a binary fan is a limit. -/ +def binary_fan.is_limit.mk {X Y : C} (s : binary_fan X Y) + (lift : Π {T : C} (f : T ⟶ X) (g : T ⟶ Y), T ⟶ s.X) + (hl₁ : ∀ {T : C} (f : T ⟶ X) (g : T ⟶ Y), lift f g ≫ s.fst = f) + (hl₂ : ∀ {T : C} (f : T ⟶ X) (g : T ⟶ Y), lift f g ≫ s.snd = g) + (uniq : ∀ {T : C} (f : T ⟶ X) (g : T ⟶ Y) (m : T ⟶ s.X) (h₁ : m ≫ s.fst = f) + (h₂ : m ≫ s.snd = g), m = lift f g) : is_limit s := is_limit.mk + (λ t, lift (binary_fan.fst t) (binary_fan.snd t)) + (by { rintros t (rfl|rfl), { exact hl₁ _ _ }, { exact hl₂ _ _ } }) + (λ t m h, uniq _ _ _ (h ⟨walking_pair.left⟩) (h ⟨walking_pair.right⟩)) lemma binary_fan.is_limit.hom_ext {W X Y : C} {s : binary_fan X Y} (h : is_limit s) {f g : W ⟶ s.X} (h₁ : f ≫ s.fst = g ≫ s.fst) (h₂ : f ≫ s.snd = g ≫ s.snd) : f = g := -h.hom_ext $ λ j, walking_pair.cases_on j h₁ h₂ +h.hom_ext $ λ j, discrete.rec_on j (λ j, walking_pair.cases_on j h₁ h₂) /-- A binary cofan is just a cocone on a diagram indexing a coproduct. -/ abbreviation binary_cofan (X Y : C) := cocone (pair X Y) /-- The first inclusion of a binary cofan. -/ -abbreviation binary_cofan.inl {X Y : C} (s : binary_cofan X Y) := s.ι.app walking_pair.left +abbreviation binary_cofan.inl {X Y : C} (s : binary_cofan X Y) := s.ι.app ⟨walking_pair.left⟩ /-- The second inclusion of a binary cofan. -/ -abbreviation binary_cofan.inr {X Y : C} (s : binary_cofan X Y) := s.ι.app walking_pair.right +abbreviation binary_cofan.inr {X Y : C} (s : binary_cofan X Y) := s.ι.app ⟨walking_pair.right⟩ @[simp] lemma binary_cofan.ι_app_left {X Y : C} (s : binary_cofan X Y) : - s.ι.app walking_pair.left = s.inl := rfl + s.ι.app ⟨walking_pair.left⟩ = s.inl := rfl @[simp] lemma binary_cofan.ι_app_right {X Y : C} (s : binary_cofan X Y) : - s.ι.app walking_pair.right = s.inr := rfl + s.ι.app ⟨walking_pair.right⟩ = s.inr := rfl + +/-- A convenient way to show that a binary cofan is a colimit. -/ +def binary_cofan.is_colimit.mk {X Y : C} (s : binary_cofan X Y) + (desc : Π {T : C} (f : X ⟶ T) (g : Y ⟶ T), s.X ⟶ T) + (hd₁ : ∀ {T : C} (f : X ⟶ T) (g : Y ⟶ T), s.inl ≫ desc f g = f) + (hd₂ : ∀ {T : C} (f : X ⟶ T) (g : Y ⟶ T), s.inr ≫ desc f g = g) + (uniq : ∀ {T : C} (f : X ⟶ T) (g : Y ⟶ T) (m : s.X ⟶ T) (h₁ : s.inl ≫ m = f) + (h₂ : s.inr ≫ m = g), m = desc f g) : is_colimit s := is_colimit.mk + (λ t, desc (binary_cofan.inl t) (binary_cofan.inr t)) + (by { rintros t (rfl|rfl), { exact hd₁ _ _ }, { exact hd₂ _ _ }}) + (λ t m h, uniq _ _ _ (h ⟨walking_pair.left⟩) (h ⟨walking_pair.right⟩)) lemma binary_cofan.is_colimit.hom_ext {W X Y : C} {s : binary_cofan X Y} (h : is_colimit s) {f g : s.X ⟶ W} (h₁ : s.inl ≫ f = s.inl ≫ g) (h₂ : s.inr ≫ f = s.inr ≫ g) : f = g := -h.hom_ext $ λ j, walking_pair.cases_on j h₁ h₂ +h.hom_ext $ λ j, discrete.rec_on j (λ j, walking_pair.cases_on j h₁ h₂) variables {X Y : C} +section +local attribute [tidy] tactic.discrete_cases + /-- A binary fan with vertex `P` consists of the two projections `π₁ : P ⟶ X` and `π₂ : P ⟶ Y`. -/ @[simps X] def binary_fan.mk {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : binary_fan X Y := { X := P, - π := { app := λ j, walking_pair.cases_on j π₁ π₂ }} + π := { app := λ j, discrete.rec_on j (λ j, walking_pair.cases_on j π₁ π₂) }} /-- A binary cofan with vertex `P` consists of the two inclusions `ι₁ : X ⟶ P` and `ι₂ : Y ⟶ P`. -/ @[simps X] def binary_cofan.mk {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : binary_cofan X Y := { X := P, - ι := { app := λ j, walking_pair.cases_on j ι₁ ι₂ }} + ι := { app := λ j, discrete.rec_on j (λ j, walking_pair.cases_on j ι₁ ι₂) }} + +end -@[simp] lemma binary_fan.mk_π_app_left {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : - (binary_fan.mk π₁ π₂).π.app walking_pair.left = π₁ := rfl -@[simp] lemma binary_fan.mk_π_app_right {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : - (binary_fan.mk π₁ π₂).π.app walking_pair.right = π₂ := rfl -@[simp] lemma binary_cofan.mk_ι_app_left {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : - (binary_cofan.mk ι₁ ι₂).ι.app walking_pair.left = ι₁ := rfl -@[simp] lemma binary_cofan.mk_ι_app_right {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : - (binary_cofan.mk ι₁ ι₂).ι.app walking_pair.right = ι₂ := rfl +@[simp] lemma binary_fan.mk_fst {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : + (binary_fan.mk π₁ π₂).fst = π₁ := rfl +@[simp] lemma binary_fan.mk_snd {P : C} (π₁ : P ⟶ X) (π₂ : P ⟶ Y) : + (binary_fan.mk π₁ π₂).snd = π₂ := rfl +@[simp] lemma binary_cofan.mk_inl {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : + (binary_cofan.mk ι₁ ι₂).inl = ι₁ := rfl +@[simp] lemma binary_cofan.mk_inr {P : C} (ι₁ : X ⟶ P) (ι₂ : Y ⟶ P) : + (binary_cofan.mk ι₁ ι₂).inr = ι₂ := rfl + +/-- Every `binary_fan` is isomorphic to an application of `binary_fan.mk`. -/ +def iso_binary_fan_mk {X Y : C} (c : binary_fan X Y) : c ≅ binary_fan.mk c.fst c.snd := +cones.ext (iso.refl _) (λ j, by discrete_cases; cases j; tidy) + +/-- Every `binary_fan` is isomorphic to an application of `binary_fan.mk`. -/ +def iso_binary_cofan_mk {X Y : C} (c : binary_cofan X Y) : c ≅ binary_cofan.mk c.inl c.inr := +cocones.ext (iso.refl _) (λ j, by discrete_cases; cases j; tidy) + +/-- +This is a more convenient formulation to show that a `binary_fan` constructed using +`binary_fan.mk` is a limit cone. +-/ +def binary_fan.is_limit_mk {W : C} {fst : W ⟶ X} {snd : W ⟶ Y} + (lift : Π (s : binary_fan X Y), s.X ⟶ W) + (fac_left : ∀ (s : binary_fan X Y), lift s ≫ fst = s.fst) + (fac_right : ∀ (s : binary_fan X Y), lift s ≫ snd = s.snd) + (uniq : ∀ (s : binary_fan X Y) (m : s.X ⟶ W) + (w_fst : m ≫ fst = s.fst) (w_snd : m ≫ snd = s.snd), m = lift s) : + is_limit (binary_fan.mk fst snd) := +{ lift := lift, + fac' := λ s j, by { rcases j with ⟨⟨⟩⟩, exacts [fac_left s, fac_right s], }, + uniq' := λ s m w, uniq s m (w ⟨walking_pair.left⟩) (w ⟨walking_pair.right⟩) } + +/-- +This is a more convenient formulation to show that a `binary_cofan` constructed using +`binary_cofan.mk` is a colimit cocone. +-/ +def binary_cofan.is_colimit_mk {W : C} {inl : X ⟶ W} {inr : Y ⟶ W} + (desc : Π (s : binary_cofan X Y), W ⟶ s.X) + (fac_left : ∀ (s : binary_cofan X Y), inl ≫ desc s = s.inl) + (fac_right : ∀ (s : binary_cofan X Y), inr ≫ desc s = s.inr) + (uniq : ∀ (s : binary_cofan X Y) (m : W ⟶ s.X) + (w_inl : inl ≫ m = s.inl) (w_inr : inr ≫ m = s.inr), m = desc s) : + is_colimit (binary_cofan.mk inl inr) := +{ desc := desc, + fac' := λ s j, by { rcases j with ⟨⟨⟩⟩, exacts [fac_left s, fac_right s], }, + uniq' := λ s m w, uniq s m (w ⟨walking_pair.left⟩) (w ⟨walking_pair.right⟩) } /-- If `s` is a limit binary fan over `X` and `Y`, then every pair of morphisms `f : W ⟶ X` and `g : W ⟶ Y` induces a morphism `l : W ⟶ s.X` satisfying `l ≫ s.fst = f` and `l ≫ s.snd = g`. @@ -189,6 +268,107 @@ def binary_cofan.is_colimit.desc' {W X Y : C} {s : binary_cofan X Y} (h : is_col (g : Y ⟶ W) : {l : s.X ⟶ W // s.inl ≫ l = f ∧ s.inr ≫ l = g} := ⟨h.desc $ binary_cofan.mk f g, h.fac _ _, h.fac _ _⟩ +/-- Binary products are symmetric. -/ +def binary_fan.is_limit_flip {X Y : C} {c : binary_fan X Y} (hc : is_limit c) : + is_limit (binary_fan.mk c.snd c.fst) := +binary_fan.is_limit_mk (λ s, hc.lift (binary_fan.mk s.snd s.fst)) + (λ s, hc.fac _ _) (λ s, hc.fac _ _) + (λ s m e₁ e₂, binary_fan.is_limit.hom_ext hc + (e₂.trans (hc.fac (binary_fan.mk s.snd s.fst) ⟨walking_pair.left⟩).symm) + (e₁.trans (hc.fac (binary_fan.mk s.snd s.fst) ⟨walking_pair.right⟩).symm)) + +lemma binary_fan.is_limit_iff_is_iso_fst {X Y : C} (h : is_terminal Y) (c : binary_fan X Y) : + nonempty (is_limit c) ↔ is_iso c.fst := +begin + split, + { rintro ⟨H⟩, + obtain ⟨l, hl, -⟩ := binary_fan.is_limit.lift' H (𝟙 X) (h.from X), + exact ⟨⟨l, binary_fan.is_limit.hom_ext H + (by simpa [hl, -category.comp_id] using category.comp_id _) (h.hom_ext _ _), hl⟩⟩ }, + { introI, + exact ⟨binary_fan.is_limit.mk _ (λ _ f _, f ≫ inv c.fst) + (λ _ _ _, by simp) (λ _ _ _, h.hom_ext _ _) + (λ _ _ _ _ e _, by simp [← e])⟩ } +end + +lemma binary_fan.is_limit_iff_is_iso_snd {X Y : C} (h : is_terminal X) (c : binary_fan X Y) : + nonempty (is_limit c) ↔ is_iso c.snd := +begin + refine iff.trans _ (binary_fan.is_limit_iff_is_iso_fst h (binary_fan.mk c.snd c.fst)), + exact ⟨λ h, ⟨binary_fan.is_limit_flip h.some⟩, + λ h, ⟨(binary_fan.is_limit_flip h.some).of_iso_limit (iso_binary_fan_mk c).symm⟩⟩, +end + +/-- If `X' ≅ X`, then `X × Y` also is the product of `X'` and `Y`. -/ +noncomputable +def binary_fan.is_limit_comp_left_iso {X Y X' : C} (c : binary_fan X Y) (f : X ⟶ X') + [is_iso f] (h : is_limit c) : is_limit (binary_fan.mk (c.fst ≫ f) c.snd) := +begin + fapply binary_fan.is_limit_mk, + { exact λ s, h.lift (binary_fan.mk (s.fst ≫ inv f) s.snd) }, + { intro s, simp }, + { intro s, simp }, + { intros s m e₁ e₂, apply binary_fan.is_limit.hom_ext h; simpa } +end + +/-- If `Y' ≅ Y`, then `X x Y` also is the product of `X` and `Y'`. -/ +noncomputable +def binary_fan.is_limit_comp_right_iso {X Y Y' : C} (c : binary_fan X Y) (f : Y ⟶ Y') + [is_iso f] (h : is_limit c) : is_limit (binary_fan.mk c.fst (c.snd ≫ f)) := +binary_fan.is_limit_flip $ binary_fan.is_limit_comp_left_iso _ f (binary_fan.is_limit_flip h) + +/-- Binary coproducts are symmetric. -/ +def binary_cofan.is_colimit_flip {X Y : C} {c : binary_cofan X Y} (hc : is_colimit c) : + is_colimit (binary_cofan.mk c.inr c.inl) := +binary_cofan.is_colimit_mk (λ s, hc.desc (binary_cofan.mk s.inr s.inl)) + (λ s, hc.fac _ _) (λ s, hc.fac _ _) + (λ s m e₁ e₂, binary_cofan.is_colimit.hom_ext hc + (e₂.trans (hc.fac (binary_cofan.mk s.inr s.inl) ⟨walking_pair.left⟩).symm) + (e₁.trans (hc.fac (binary_cofan.mk s.inr s.inl) ⟨walking_pair.right⟩).symm)) + +lemma binary_cofan.is_colimit_iff_is_iso_inl {X Y : C} (h : is_initial Y) (c : binary_cofan X Y) : + nonempty (is_colimit c) ↔ is_iso c.inl := +begin + split, + { rintro ⟨H⟩, + obtain ⟨l, hl, -⟩ := binary_cofan.is_colimit.desc' H (𝟙 X) (h.to X), + exact ⟨⟨l, hl, binary_cofan.is_colimit.hom_ext H (by simp [reassoc_of hl]) (h.hom_ext _ _)⟩⟩ }, + { introI, + exact ⟨binary_cofan.is_colimit.mk _ (λ _ f _, inv c.inl ≫ f) + (λ _ _ _, is_iso.hom_inv_id_assoc _ _) (λ _ _ _, h.hom_ext _ _) + (λ _ _ _ _ e _, (is_iso.eq_inv_comp _).mpr e)⟩ } +end + +lemma binary_cofan.is_colimit_iff_is_iso_inr {X Y : C} (h : is_initial X) (c : binary_cofan X Y) : + nonempty (is_colimit c) ↔ is_iso c.inr := +begin + refine iff.trans _ (binary_cofan.is_colimit_iff_is_iso_inl h (binary_cofan.mk c.inr c.inl)), + exact ⟨λ h, ⟨binary_cofan.is_colimit_flip h.some⟩, + λ h, ⟨(binary_cofan.is_colimit_flip h.some).of_iso_colimit (iso_binary_cofan_mk c).symm⟩⟩, +end + +/-- If `X' ≅ X`, then `X ⨿ Y` also is the coproduct of `X'` and `Y`. -/ +noncomputable +def binary_cofan.is_colimit_comp_left_iso {X Y X' : C} (c : binary_cofan X Y) (f : X' ⟶ X) + [is_iso f] (h : is_colimit c) : is_colimit (binary_cofan.mk (f ≫ c.inl) c.inr) := +begin + fapply binary_cofan.is_colimit_mk, + { exact λ s, h.desc (binary_cofan.mk (inv f ≫ s.inl) s.inr) }, + { intro s, simp }, + { intro s, simp }, + { intros s m e₁ e₂, + apply binary_cofan.is_colimit.hom_ext h, + { rw ← cancel_epi f, simpa using e₁ }, + { simpa } } +end + +/-- If `Y' ≅ Y`, then `X ⨿ Y` also is the coproduct of `X` and `Y'`. -/ +noncomputable +def binary_cofan.is_colimit_comp_right_iso {X Y Y' : C} (c : binary_cofan X Y) (f : Y' ⟶ Y) + [is_iso f] (h : is_colimit c) : is_colimit (binary_cofan.mk c.inl (f ≫ c.inr)) := +binary_cofan.is_colimit_flip $ + binary_cofan.is_colimit_comp_left_iso _ f (binary_cofan.is_colimit_flip h) + /-- An abbreviation for `has_limit (pair X Y)`. -/ abbreviation has_binary_product (X Y : C) := has_limit (pair X Y) /-- An abbreviation for `has_colimit (pair X Y)`. -/ @@ -207,19 +387,19 @@ notation X ` ⨿ `:20 Y:20 := coprod X Y /-- The projection map to the first component of the product. -/ abbreviation prod.fst {X Y : C} [has_binary_product X Y] : X ⨯ Y ⟶ X := -limit.π (pair X Y) walking_pair.left +limit.π (pair X Y) ⟨walking_pair.left⟩ /-- The projecton map to the second component of the product. -/ abbreviation prod.snd {X Y : C} [has_binary_product X Y] : X ⨯ Y ⟶ Y := -limit.π (pair X Y) walking_pair.right +limit.π (pair X Y) ⟨walking_pair.right⟩ /-- The inclusion map from the first component of the coproduct. -/ abbreviation coprod.inl {X Y : C} [has_binary_coproduct X Y] : X ⟶ X ⨿ Y := -colimit.ι (pair X Y) walking_pair.left +colimit.ι (pair X Y) ⟨walking_pair.left⟩ /-- The inclusion map from the second component of the coproduct. -/ abbreviation coprod.inr {X Y : C} [has_binary_coproduct X Y] : Y ⟶ X ⨿ Y := -colimit.ι (pair X Y) walking_pair.right +colimit.ι (pair X Y) ⟨walking_pair.right⟩ /-- The binary fan constructed from the projection maps is a limit. -/ def prod_is_prod (X Y : C) [has_binary_product X Y] : @@ -374,7 +554,7 @@ by { ext; simp } -- TODO: is it necessary to weaken the assumption here? @[reassoc] lemma prod.map_swap {A B X Y : C} (f : A ⟶ B) (g : X ⟶ Y) - [has_limits_of_shape (discrete walking_pair.{v}) C] : + [has_limits_of_shape (discrete walking_pair) C] : prod.map (𝟙 X) f ≫ prod.map g (𝟙 B) = prod.map g (𝟙 A) ≫ prod.map (𝟙 Y) f := by simp @@ -420,13 +600,13 @@ lemma prod.diag_map_fst_snd {X Y : C} [has_binary_product X Y] by simp @[simp, reassoc] -lemma prod.diag_map_fst_snd_comp [has_limits_of_shape (discrete walking_pair.{v}) C] +lemma prod.diag_map_fst_snd_comp [has_limits_of_shape (discrete walking_pair) C] {X X' Y Y' : C} (g : X ⟶ Y) (g' : X' ⟶ Y') : diag (X ⨯ X') ≫ prod.map (prod.fst ≫ g) (prod.snd ≫ g') = prod.map g g' := by simp -instance {X : C} [has_binary_product X X] : split_mono (diag X) := -{ retraction := prod.fst } +instance {X : C} [has_binary_product X X] : is_split_mono (diag X) := +is_split_mono.mk' { retraction := prod.fst } end prod_lemmas @@ -489,7 +669,7 @@ by { ext; simp } -- I don't think it's a good idea to make any of the following three simp lemmas. @[reassoc] lemma coprod.map_swap {A B X Y : C} (f : A ⟶ B) (g : X ⟶ Y) - [has_colimits_of_shape (discrete walking_pair.{v}) C] : + [has_colimits_of_shape (discrete walking_pair) C] : coprod.map (𝟙 X) f ≫ coprod.map g (𝟙 B) = coprod.map g (𝟙 A) ≫ coprod.map (𝟙 Y) f := by simp @@ -540,7 +720,7 @@ by simp -- The simp linter says simp can prove the reassoc version of this lemma. @[reassoc, simp] -lemma coprod.map_comp_inl_inr_codiag [has_colimits_of_shape (discrete walking_pair.{v}) C] +lemma coprod.map_comp_inl_inr_codiag [has_colimits_of_shape (discrete walking_pair) C] {X X' Y Y' : C} (g : X ⟶ Y) (g' : X' ⟶ Y') : coprod.map (g ≫ coprod.inl) (g' ≫ coprod.inr) ≫ codiag (Y ⨿ Y') = coprod.map g g' := by simp @@ -554,14 +734,14 @@ variables (C) See . -/ -abbreviation has_binary_products := has_limits_of_shape (discrete walking_pair.{v}) C +abbreviation has_binary_products := has_limits_of_shape (discrete walking_pair) C /-- `has_binary_coproducts` represents a choice of coproduct for every pair of objects. See . -/ -abbreviation has_binary_coproducts := has_colimits_of_shape (discrete walking_pair.{v}) C +abbreviation has_binary_coproducts := has_colimits_of_shape (discrete walking_pair) C /-- If `C` has all limits of diagrams `pair X Y`, then it has all binary products -/ lemma has_binary_products_of_has_limit_pair [Π {X Y : C}, has_limit (pair X Y)] : @@ -760,7 +940,9 @@ end coprod_functor section prod_comparison -variables {C} {D : Type u₂} [category.{v} D] +universe w + +variables {C} {D : Type u₂} [category.{w} D] variables (F : C ⥤ D) {A A' B B' : C} variables [has_binary_product A B] [has_binary_product A' B'] variables [has_binary_product (F.obj A) (F.obj B)] [has_binary_product (F.obj A') (F.obj B')] @@ -837,7 +1019,9 @@ end prod_comparison section coprod_comparison -variables {C} {D : Type u₂} [category.{v} D] +universe w + +variables {C} {D : Type u₂} [category.{w} D] variables (F : C ⥤ D) {A A' B B' : C} variables [has_binary_coproduct A B] [has_binary_coproduct A' B'] variables [has_binary_coproduct (F.obj A) (F.obj B)] [has_binary_coproduct (F.obj A') (F.obj B')] diff --git a/src/category_theory/limits/shapes/biproducts.lean b/src/category_theory/limits/shapes/biproducts.lean index 91e712e77d378..bef019a696072 100644 --- a/src/category_theory/limits/shapes/biproducts.lean +++ b/src/category_theory/limits/shapes/biproducts.lean @@ -3,23 +3,24 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Jakob von Raumer -/ -import algebra.group.ext import category_theory.limits.shapes.finite_products import category_theory.limits.shapes.binary_products -import category_theory.preadditive import category_theory.limits.shapes.kernels /-! # Biproducts and binary biproducts +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce the notion of (finite) biproducts and binary biproducts. These are slightly unusual relative to the other shapes in the library, as they are simultaneously limits and colimits. (Zero objects are similar; they are "biterminal".) -We treat first the case of a general category with zero morphisms, -and subsequently the case of a preadditive category. +For results about biproducts in preadditive categories see +`category_theory.preadditive.biproducts`. In a category with zero morphisms, we model the (binary) biproduct of `P Q : C` using a `binary_bicone`, which has a cone point `X`, @@ -28,37 +29,34 @@ such that `inl ≫ fst = 𝟙 P`, `inl ≫ snd = 0`, `inr ≫ fst = 0`, and `inr Such a `binary_bicone` is a biproduct if the cone is a limit cone, and the cocone is a colimit cocone. -In a preadditive category, -* any `binary_biproduct` satisfies `total : fst ≫ inl + snd ≫ inr = 𝟙 X` -* any `binary_product` is a `binary_biproduct` -* any `binary_coproduct` is a `binary_biproduct` - For biproducts indexed by a `fintype J`, a `bicone` again consists of a cone point `X` and morphisms `π j : X ⟶ F j` and `ι j : F j ⟶ X` for each `j`, such that `ι j ≫ π j'` is the identity when `j = j'` and zero otherwise. -In a preadditive category, -* any `biproduct` satisfies `total : ∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)` -* any `product` is a `biproduct` -* any `coproduct` is a `biproduct` - ## Notation As `⊕` is already taken for the sum of types, we introduce the notation `X ⊞ Y` for a binary biproduct. We introduce `⨁ f` for the indexed biproduct. + +## Implementation +Prior to #14046, `has_finite_biproducts` required a `decidable_eq` instance on the indexing type. +As this had no pay-off (everything about limits is non-constructive in mathlib), and occasional cost +(constructing decidability instances appropriate for constructions involving the indexing type), +we made everything classical. -/ noncomputable theory -universes v u +universes w w' v u open category_theory open category_theory.functor +open_locale classical namespace category_theory namespace limits -variables {J : Type v} [decidable_eq J] +variables {J : Type w} variables {C : Type u} [category.{v} C] [has_zero_morphisms C] /-- @@ -67,12 +65,12 @@ A `c : bicone F` is: * morphisms `π j : X ⟶ F j` and `ι j : F j ⟶ X` for each `j`, * such that `ι j ≫ π j'` is the identity when `j = j'` and zero otherwise. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure bicone (F : J → C) := (X : C) (π : Π j, X ⟶ F j) (ι : Π j, F j ⟶ X) -(ι_π : ∀ j j', ι j ≫ π j' = if h : j = j' then eq_to_hom (congr_arg F h) else 0) +(ι_π : ∀ j j', ι j ≫ π j' = if h : j = j' then eq_to_hom (congr_arg F h) else 0 . obviously) @[simp, reassoc] lemma bicone_ι_π_self {F : J → C} (B : bicone F) (j : J) : B.ι j ≫ B.π j = 𝟙 (F j) := @@ -85,30 +83,44 @@ by simpa [h] using B.ι_π j j' variables {F : J → C} namespace bicone + +local attribute [tidy] tactic.discrete_cases + /-- Extract the cone from a bicone. -/ -@[simps] def to_cone (B : bicone F) : cone (discrete.functor F) := { X := B.X, - π := { app := λ j, B.π j }, } + π := { app := λ j, B.π j.as }, } + +@[simp] lemma to_cone_X (B : bicone F) : B.to_cone.X = B.X := rfl + +@[simp] lemma to_cone_π_app (B : bicone F) (j : discrete J) : B.to_cone.π.app j = B.π j.as := rfl + +lemma to_cone_π_app_mk (B : bicone F) (j : J) : B.to_cone.π.app ⟨j⟩ = B.π j := rfl /-- Extract the cocone from a bicone. -/ -@[simps] def to_cocone (B : bicone F) : cocone (discrete.functor F) := { X := B.X, - ι := { app := λ j, B.ι j }, } + ι := { app := λ j, B.ι j.as }, } + +@[simp] lemma to_cocone_X (B : bicone F) : B.to_cocone.X = B.X := rfl + +@[simp] lemma to_cocone_ι_app (B : bicone F) (j : discrete J) : B.to_cocone.ι.app j = B.ι j.as := +rfl + +lemma to_cocone_ι_app_mk (B : bicone F) (j : J) : B.to_cocone.ι.app ⟨j⟩ = B.ι j := rfl /-- We can turn any limit cone over a discrete collection of objects into a bicone. -/ @[simps] def of_limit_cone {f : J → C} {t : cone (discrete.functor f)} (ht : is_limit t) : bicone f := { X := t.X, - π := t.π.app, + π := λ j, t.π.app ⟨j⟩, ι := λ j, ht.lift (fan.mk _ (λ j', if h : j = j' then eq_to_hom (congr_arg f h) else 0)), ι_π := λ j j', by simp } lemma ι_of_is_limit {f : J → C} {t : bicone f} (ht : is_limit t.to_cone) (j : J) : t.ι j = ht.lift (fan.mk _ (λ j', if h : j = j' then eq_to_hom (congr_arg f h) else 0)) := -ht.hom_ext (λ j', by { rw ht.fac, simp [t.ι_π] }) +ht.hom_ext (λ j', by { rw ht.fac, discrete_cases, simp [t.ι_π] }) /-- We can turn any colimit cocone over a discrete collection of objects into a bicone. -/ @[simps] @@ -116,25 +128,82 @@ def of_colimit_cocone {f : J → C} {t : cocone (discrete.functor f)} (ht : is_c bicone f := { X := t.X, π := λ j, ht.desc (cofan.mk _ (λ j', if h : j' = j then eq_to_hom (congr_arg f h) else 0)), - ι := t.ι.app, + ι := λ j, t.ι.app ⟨j⟩, ι_π := λ j j', by simp } lemma π_of_is_colimit {f : J → C} {t : bicone f} (ht : is_colimit t.to_cocone) (j : J) : t.π j = ht.desc (cofan.mk _ (λ j', if h : j' = j then eq_to_hom (congr_arg f h) else 0)) := -ht.hom_ext (λ j', by { rw ht.fac, simp [t.ι_π] }) +ht.hom_ext (λ j', by { rw ht.fac, discrete_cases, simp [t.ι_π] }) /-- Structure witnessing that a bicone is both a limit cone and a colimit cocone. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure is_bilimit {F : J → C} (B : bicone F) := (is_limit : is_limit B.to_cone) (is_colimit : is_colimit B.to_cocone) +local attribute [ext] bicone.is_bilimit + +instance subsingleton_is_bilimit {f : J → C} {c : bicone f} : subsingleton c.is_bilimit := +⟨λ h h', bicone.is_bilimit.ext _ _ (subsingleton.elim _ _) (subsingleton.elim _ _)⟩ + +section whisker +variables {K : Type w'} + +/-- Whisker a bicone with an equivalence between the indexing types. -/ +@[simps] +def whisker {f : J → C} (c : bicone f) (g : K ≃ J) : bicone (f ∘ g) := +{ X := c.X, + π := λ k, c.π (g k), + ι := λ k, c.ι (g k), + ι_π := λ k k', + begin + simp only [c.ι_π], + split_ifs with h h' h'; simp [equiv.apply_eq_iff_eq g] at h h'; tauto + end } + +local attribute [tidy] tactic.discrete_cases + +/-- Taking the cone of a whiskered bicone results in a cone isomorphic to one gained +by whiskering the cone and postcomposing with a suitable isomorphism. -/ +def whisker_to_cone {f : J → C} (c : bicone f) (g : K ≃ J) : + (c.whisker g).to_cone ≅ (cones.postcompose (discrete.functor_comp f g).inv).obj + (c.to_cone.whisker (discrete.functor (discrete.mk ∘ g))) := +cones.ext (iso.refl _) (by tidy) + +/-- Taking the cocone of a whiskered bicone results in a cone isomorphic to one gained +by whiskering the cocone and precomposing with a suitable isomorphism. -/ +def whisker_to_cocone {f : J → C} (c : bicone f) (g : K ≃ J) : + (c.whisker g).to_cocone ≅ (cocones.precompose (discrete.functor_comp f g).hom).obj + (c.to_cocone.whisker (discrete.functor (discrete.mk ∘ g))) := +cocones.ext (iso.refl _) (by tidy) + +/-- Whiskering a bicone with an equivalence between types preserves being a bilimit bicone. -/ +def whisker_is_bilimit_iff {f : J → C} (c : bicone f) (g : K ≃ J) : + (c.whisker g).is_bilimit ≃ c.is_bilimit := +begin + refine equiv_of_subsingleton_of_subsingleton (λ hc, ⟨_, _⟩) (λ hc, ⟨_, _⟩), + { let := is_limit.of_iso_limit hc.is_limit (bicone.whisker_to_cone c g), + let := (is_limit.postcompose_hom_equiv (discrete.functor_comp f g).symm _) this, + exact is_limit.of_whisker_equivalence (discrete.equivalence g) this }, + { let := is_colimit.of_iso_colimit hc.is_colimit (bicone.whisker_to_cocone c g), + let := (is_colimit.precompose_hom_equiv (discrete.functor_comp f g) _) this, + exact is_colimit.of_whisker_equivalence (discrete.equivalence g) this }, + { apply is_limit.of_iso_limit _ (bicone.whisker_to_cone c g).symm, + apply (is_limit.postcompose_hom_equiv (discrete.functor_comp f g).symm _).symm _, + exact is_limit.whisker_equivalence hc.is_limit (discrete.equivalence g) }, + { apply is_colimit.of_iso_colimit _ (bicone.whisker_to_cocone c g).symm, + apply (is_colimit.precompose_hom_equiv (discrete.functor_comp f g) _).symm _, + exact is_colimit.whisker_equivalence hc.is_colimit (discrete.equivalence g) } +end + +end whisker + end bicone /-- A bicone over `F : J → C`, which is both a limit cone and a colimit cocone. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure limit_bicone (F : J → C) := (bicone : bicone F) (is_bilimit : bicone.is_bilimit) @@ -171,12 +240,12 @@ def biproduct.is_colimit (F : J → C) [has_biproduct F] : (get_biproduct_data F).is_bilimit.is_colimit @[priority 100] -instance has_product_of_has_biproduct [has_biproduct F] : has_limit (discrete.functor F) := +instance has_product_of_has_biproduct [has_biproduct F] : has_product F := has_limit.mk { cone := (biproduct.bicone F).to_cone, is_limit := biproduct.is_limit F, } @[priority 100] -instance has_coproduct_of_has_biproduct [has_biproduct F] : has_colimit (discrete.functor F) := +instance has_coproduct_of_has_biproduct [has_biproduct F] : has_coproduct F := has_colimit.mk { cocone := (biproduct.bicone F).to_cocone, is_colimit := biproduct.is_colimit F, } @@ -188,27 +257,40 @@ a limit and a colimit, with the same cone points, of every function `F : J → C`. -/ class has_biproducts_of_shape : Prop := -(has_biproduct : Π F : J → C, has_biproduct F) +(has_biproduct : ∀ F : J → C, has_biproduct F) attribute [instance, priority 100] has_biproducts_of_shape.has_biproduct /-- `has_finite_biproducts C` represents a choice of biproduct for every family of objects in `C` -indexed by a finite type with decidable equality. -/ +indexed by a finite type. -/ class has_finite_biproducts : Prop := -(has_biproducts_of_shape : Π (J : Type v) [decidable_eq J] [fintype J], - has_biproducts_of_shape J C) +(out [] : ∀ n, has_biproducts_of_shape (fin n) C) + +variables {J} -attribute [instance, priority 100] has_finite_biproducts.has_biproducts_of_shape +lemma has_biproducts_of_shape_of_equiv {K : Type w'} [has_biproducts_of_shape K C] (e : J ≃ K) : + has_biproducts_of_shape J C := +⟨λ F, let ⟨⟨h⟩⟩ := has_biproducts_of_shape.has_biproduct (F ∘ e.symm), ⟨c, hc⟩ := h + in has_biproduct.mk $ by simpa only [(∘), e.symm_apply_apply] + using limit_bicone.mk (c.whisker e) ((c.whisker_is_bilimit_iff _).2 hc)⟩ + +@[priority 100] instance has_biproducts_of_shape_finite [has_finite_biproducts C] [finite J] : + has_biproducts_of_shape J C := +begin + rcases finite.exists_equiv_fin J with ⟨n, ⟨e⟩⟩, + haveI := has_finite_biproducts.out C n, + exact has_biproducts_of_shape_of_equiv C e +end @[priority 100] instance has_finite_products_of_has_finite_biproducts [has_finite_biproducts C] : has_finite_products C := -{ out := λ J _ _, ⟨λ F, by exactI has_limit_of_iso discrete.nat_iso_functor.symm⟩ } +{ out := λ n, ⟨λ F, has_limit_of_iso discrete.nat_iso_functor.symm⟩ } @[priority 100] instance has_finite_coproducts_of_has_finite_biproducts [has_finite_biproducts C] : has_finite_coproducts C := -{ out := λ J _ _, ⟨λ F, by exactI has_colimit_of_iso discrete.nat_iso_functor⟩ } +{ out := λ n, ⟨λ F, has_colimit_of_iso discrete.nat_iso_functor⟩ } variables {J C} @@ -224,7 +306,7 @@ def biproduct_iso (F : J → C) [has_biproduct F] : end limits namespace limits -variables {J : Type v} [decidable_eq J] +variables {J : Type w} variables {C : Type u} [category.{v} C] [has_zero_morphisms C] /-- `biproduct f` computes the biproduct of a family of elements `f`. (It is defined as an @@ -251,10 +333,12 @@ abbreviation biproduct.ι (f : J → C) [has_biproduct f] (b : J) : f b ⟶ ⨁ lemma biproduct.bicone_ι (f : J → C) [has_biproduct f] (b : J) : (biproduct.bicone f).ι b = biproduct.ι f b := rfl +/-- Note that as this lemma has a `if` in the statement, we include a `decidable_eq` argument. +This means you may not be able to `simp` using this lemma unless you `open_locale classical`. -/ @[reassoc] -lemma biproduct.ι_π (f : J → C) [has_biproduct f] (j j' : J) : +lemma biproduct.ι_π [decidable_eq J] (f : J → C) [has_biproduct f] (j j' : J) : biproduct.ι f j ≫ biproduct.π f j' = if h : j = j' then eq_to_hom (congr_arg f h) else 0 := -(biproduct.bicone f).ι_π j j' +by convert (biproduct.bicone f).ι_π j j' @[simp,reassoc] lemma biproduct.ι_π_self (f : J → C) [has_biproduct f] (j : J) : @@ -278,42 +362,69 @@ abbreviation biproduct.desc @[simp, reassoc] lemma biproduct.lift_π {f : J → C} [has_biproduct f] {P : C} (p : Π b, P ⟶ f b) (j : J) : biproduct.lift p ≫ biproduct.π f j = p j := -(biproduct.is_limit f).fac _ _ +(biproduct.is_limit f).fac _ ⟨j⟩ @[simp, reassoc] lemma biproduct.ι_desc {f : J → C} [has_biproduct f] {P : C} (p : Π b, f b ⟶ P) (j : J) : biproduct.ι f j ≫ biproduct.desc p = p j := -(biproduct.is_colimit f).fac _ _ +(biproduct.is_colimit f).fac _ ⟨j⟩ /-- Given a collection of maps between corresponding summands of a pair of biproducts indexed by the same type, we obtain a map between the biproducts. -/ abbreviation biproduct.map {f g : J → C} [has_biproduct f] [has_biproduct g] (p : Π b, f b ⟶ g b) : ⨁ f ⟶ ⨁ g := -is_limit.map (biproduct.bicone f).to_cone (biproduct.is_limit g) (discrete.nat_trans p) +is_limit.map (biproduct.bicone f).to_cone (biproduct.is_limit g) + (discrete.nat_trans (λ j, p j.as)) /-- An alternative to `biproduct.map` constructed via colimits. This construction only exists in order to show it is equal to `biproduct.map`. -/ abbreviation biproduct.map' {f g : J → C} [has_biproduct f] [has_biproduct g] (p : Π b, f b ⟶ g b) : ⨁ f ⟶ ⨁ g := -is_colimit.map (biproduct.is_colimit f) (biproduct.bicone g).to_cocone (discrete.nat_trans p) +is_colimit.map (biproduct.is_colimit f) (biproduct.bicone g).to_cocone + (discrete.nat_trans (λ j, p j.as)) @[ext] lemma biproduct.hom_ext {f : J → C} [has_biproduct f] {Z : C} (g h : Z ⟶ ⨁ f) (w : ∀ j, g ≫ biproduct.π f j = h ≫ biproduct.π f j) : g = h := -(biproduct.is_limit f).hom_ext w +(biproduct.is_limit f).hom_ext (λ j, w j.as) @[ext] lemma biproduct.hom_ext' {f : J → C} [has_biproduct f] {Z : C} (g h : ⨁ f ⟶ Z) (w : ∀ j, biproduct.ι f j ≫ g = biproduct.ι f j ≫ h) : g = h := -(biproduct.is_colimit f).hom_ext w +(biproduct.is_colimit f).hom_ext (λ j, w j.as) + +/-- The canonical isomorphism between the chosen biproduct and the chosen product. -/ +def biproduct.iso_product (f : J → C) [has_biproduct f] : ⨁ f ≅ ∏ f := +is_limit.cone_point_unique_up_to_iso (biproduct.is_limit f) (limit.is_limit _) + +@[simp] lemma biproduct.iso_product_hom {f : J → C} [has_biproduct f] : + (biproduct.iso_product f).hom = pi.lift (biproduct.π f) := +limit.hom_ext $ λ j, by simp [biproduct.iso_product] + +@[simp] lemma biproduct.iso_product_inv {f : J → C} [has_biproduct f] : + (biproduct.iso_product f).inv = biproduct.lift (pi.π f) := +biproduct.hom_ext _ _ $ λ j, by simp [iso.inv_comp_eq] + +/-- The canonical isomorphism between the chosen biproduct and the chosen coproduct. -/ +def biproduct.iso_coproduct (f : J → C) [has_biproduct f] : ⨁ f ≅ ∐ f := +is_colimit.cocone_point_unique_up_to_iso (biproduct.is_colimit f) (colimit.is_colimit _) + +@[simp] lemma biproduct.iso_coproduct_inv {f : J → C} [has_biproduct f] : + (biproduct.iso_coproduct f).inv = sigma.desc (biproduct.ι f) := +colimit.hom_ext $ λ j, by simp [biproduct.iso_coproduct] + +@[simp] lemma biproduct.iso_coproduct_hom {f : J → C} [has_biproduct f] : + (biproduct.iso_coproduct f).hom = biproduct.desc (sigma.ι f) := +biproduct.hom_ext' _ _ $ λ j, by simp [← iso.eq_comp_inv] lemma biproduct.map_eq_map' {f g : J → C} [has_biproduct f] [has_biproduct g] (p : Π b, f b ⟶ g b) : biproduct.map p = biproduct.map' p := begin ext j j', simp only [discrete.nat_trans_app, limits.is_colimit.ι_map, limits.is_limit.map_π, category.assoc, - ←bicone.to_cone_π_app, ←biproduct.bicone_π, ←bicone.to_cocone_ι_app, ←biproduct.bicone_ι], + ←bicone.to_cone_π_app_mk, ←biproduct.bicone_π, ←bicone.to_cocone_ι_app_mk, ←biproduct.bicone_ι], simp only [biproduct.bicone_ι, biproduct.bicone_π, bicone.to_cocone_ι_app, bicone.to_cone_π_app], + dsimp, rw [biproduct.ι_π_assoc, biproduct.ι_π], split_ifs, { subst h, rw [eq_to_hom_refl, category.id_comp], erw category.comp_id, }, @@ -324,7 +435,7 @@ end lemma biproduct.map_π {f g : J → C} [has_biproduct f] [has_biproduct g] (p : Π j, f j ⟶ g j) (j : J) : biproduct.map p ≫ biproduct.π g j = biproduct.π f j ≫ p j := -limits.is_limit.map_π _ _ _ _ +limits.is_limit.map_π _ _ _ (discrete.mk j) @[simp, reassoc] lemma biproduct.ι_map {f g : J → C} [has_biproduct f] [has_biproduct g] @@ -332,7 +443,7 @@ lemma biproduct.ι_map {f g : J → C} [has_biproduct f] [has_biproduct g] biproduct.ι f j ≫ biproduct.map p = p j ≫ biproduct.ι g j := begin rw biproduct.map_eq_map', - convert limits.is_colimit.ι_map _ _ _ _; refl + convert limits.is_colimit.ι_map _ _ _ (discrete.mk j); refl end @[simp, reassoc] @@ -366,13 +477,13 @@ the full index type. -/ def biproduct.from_subtype : ⨁ subtype.restrict p f ⟶ ⨁ f := biproduct.desc $ λ j, biproduct.ι _ _ -/-- The canonical morophism from a biproduct to the biproduct over a restriction of its index +/-- The canonical morphism from a biproduct to the biproduct over a restriction of its index type. -/ def biproduct.to_subtype : ⨁ f ⟶ ⨁ subtype.restrict p f := biproduct.lift $ λ j, biproduct.π _ _ @[simp, reassoc] -lemma biproduct.from_subtype_π (j : J) [decidable (p j)] : +lemma biproduct.from_subtype_π [decidable_pred p] (j : J) : biproduct.from_subtype f p ≫ biproduct.π f j = if h : p j then biproduct.π (subtype.restrict p f) ⟨j, h⟩ else 0 := begin @@ -406,7 +517,7 @@ lemma biproduct.to_subtype_π (j : subtype p) : biproduct.lift_π _ _ @[simp, reassoc] -lemma biproduct.ι_to_subtype (j : J) [decidable (p j)] : +lemma biproduct.ι_to_subtype [decidable_pred p] (j : J) : biproduct.ι f j ≫ biproduct.to_subtype f p = if h : p j then biproduct.ι (subtype.restrict p f) ⟨j, h⟩ else 0 := begin @@ -460,12 +571,13 @@ end end -variables (f : J → C) (i : J) [has_biproduct f] [has_biproduct (subtype.restrict (λ j, i ≠ j) f)] +section +variables (f : J → C) (i : J) [has_biproduct f] [has_biproduct (subtype.restrict (λ j, j ≠ i) f)] /-- The kernel of `biproduct.π f i` is the inclusion from the biproduct which omits `i` from the index set `J` into the biproduct over `J`. -/ def biproduct.is_limit_from_subtype : is_limit - (kernel_fork.of_ι (biproduct.from_subtype f (λ j, i ≠ j)) + (kernel_fork.of_ι (biproduct.from_subtype f (λ j, j ≠ i)) (by simp) : kernel_fork (biproduct.π f i)) := fork.is_limit.mk' _ $ λ s, ⟨s.ι ≫ biproduct.to_subtype _ _, @@ -475,7 +587,7 @@ fork.is_limit.mk' _ $ λ s, biproduct.to_subtype_from_subtype_assoc, biproduct.map_π], rcases em (i = j) with (rfl|h), { rw [if_neg (not_not.2 rfl), comp_zero, comp_zero, kernel_fork.condition] }, - { rw [if_pos h, category.comp_id] } + { rw [if_pos (ne.symm h), category.comp_id], } end, begin intros m hm, @@ -483,10 +595,18 @@ fork.is_limit.mk' _ $ λ s, exact (category.comp_id _).symm end⟩ +instance : has_kernel (biproduct.π f i) := +has_limit.mk ⟨_, biproduct.is_limit_from_subtype f i⟩ + +/-- The kernel of `biproduct.π f i` is `⨁ subtype.restrict {i}ᶜ f`. -/ +@[simps] +def kernel_biproduct_π_iso : kernel (biproduct.π f i) ≅ ⨁ subtype.restrict (λ j, j ≠ i) f := +limit.iso_limit_cone ⟨_, biproduct.is_limit_from_subtype f i⟩ + /-- The cokernel of `biproduct.ι f i` is the projection from the biproduct over the index set `J` onto the biproduct omitting `i`. -/ def biproduct.is_colimit_to_subtype : is_colimit - (cokernel_cofork.of_π (biproduct.to_subtype f (λ j, i ≠ j)) + (cokernel_cofork.of_π (biproduct.to_subtype f (λ j, j ≠ i)) (by simp) : cokernel_cofork (biproduct.ι f i)) := cofork.is_colimit.mk' _ $ λ s, ⟨biproduct.from_subtype _ _ ≫ s.π, @@ -496,7 +616,7 @@ cofork.is_colimit.mk' _ $ λ s, biproduct.ι_map_assoc], rcases em (i = j) with (rfl|h), { rw [if_neg (not_not.2 rfl), zero_comp, cokernel_cofork.condition] }, - { rw [if_pos h, category.id_comp] } + { rw [if_pos (ne.symm h), category.id_comp], } end, begin intros m hm, @@ -504,11 +624,100 @@ cofork.is_colimit.mk' _ $ λ s, exact (category.id_comp _).symm end⟩ -end π_kernel +instance : has_cokernel (biproduct.ι f i) := +has_colimit.mk ⟨_, biproduct.is_colimit_to_subtype f i⟩ + +/-- The cokernel of `biproduct.ι f i` is `⨁ subtype.restrict {i}ᶜ f`. -/ +@[simps] +def cokernel_biproduct_ι_iso : cokernel (biproduct.ι f i) ≅ ⨁ subtype.restrict (λ j, j ≠ i) f := +colimit.iso_colimit_cocone ⟨_, biproduct.is_colimit_to_subtype f i⟩ + +end section -variables [fintype J] {K : Type v} [fintype K] [decidable_eq K] {f : J → C} {g : K → C} - [has_finite_biproducts C] +open_locale classical + +-- Per #15067, we only allow indexing in `Type 0` here. +variables {K : Type} [fintype K] [has_finite_biproducts C] (f : K → C) + +/-- The limit cone exhibiting `⨁ subtype.restrict pᶜ f` as the kernel of +`biproduct.to_subtype f p` -/ +@[simps] +def kernel_fork_biproduct_to_subtype (p : set K) : + limit_cone (parallel_pair (biproduct.to_subtype f p) 0) := +{ cone := kernel_fork.of_ι (biproduct.from_subtype f pᶜ) begin + ext j k, + simp only [biproduct.ι_from_subtype_assoc, biproduct.ι_to_subtype, comp_zero, zero_comp], + erw [dif_neg j.2], + simp only [zero_comp], + end, + is_limit := kernel_fork.is_limit.of_ι _ _ (λ W g h, g ≫ biproduct.to_subtype f pᶜ) + begin + intros W' g' w, + ext j, + simp only [category.assoc, biproduct.to_subtype_from_subtype, pi.compl_apply, + biproduct.map_π], + split_ifs, + { simp, }, + { replace w := w =≫ biproduct.π _ ⟨j, not_not.mp h⟩, simpa using w.symm, }, + end + (by tidy), } + +instance (p : set K) : has_kernel (biproduct.to_subtype f p) := +has_limit.mk (kernel_fork_biproduct_to_subtype f p) + +/-- The kernel of `biproduct.to_subtype f p` is `⨁ subtype.restrict pᶜ f`. -/ +@[simps] +def kernel_biproduct_to_subtype_iso (p : set K) : + kernel (biproduct.to_subtype f p) ≅ ⨁ subtype.restrict pᶜ f := +limit.iso_limit_cone (kernel_fork_biproduct_to_subtype f p) + +/-- The colimit cocone exhibiting `⨁ subtype.restrict pᶜ f` as the cokernel of +`biproduct.from_subtype f p` -/ +@[simps] +def cokernel_cofork_biproduct_from_subtype (p : set K) : + colimit_cocone (parallel_pair (biproduct.from_subtype f p) 0) := +{ cocone := cokernel_cofork.of_π (biproduct.to_subtype f pᶜ) begin + ext j k, + simp only [pi.compl_apply, biproduct.ι_from_subtype_assoc, biproduct.ι_to_subtype, + comp_zero, zero_comp], + rw [dif_neg], + simp only [zero_comp], + exact not_not.mpr j.2, + end, + is_colimit := cokernel_cofork.is_colimit.of_π _ _ (λ W g h, biproduct.from_subtype f pᶜ ≫ g) + begin + intros W' g' w, + ext j, + simp only [biproduct.to_subtype_from_subtype_assoc, pi.compl_apply, biproduct.ι_map_assoc], + split_ifs, + { simp, }, + { replace w := biproduct.ι _ (⟨j, not_not.mp h⟩ : p) ≫= w, simpa using w.symm, }, + end + (by tidy), } + +instance (p : set K) : has_cokernel (biproduct.from_subtype f p) := +has_colimit.mk (cokernel_cofork_biproduct_from_subtype f p) + +/-- The cokernel of `biproduct.from_subtype f p` is `⨁ subtype.restrict pᶜ f`. -/ +@[simps] +def cokernel_biproduct_from_subtype_iso (p : set K) : + cokernel (biproduct.from_subtype f p) ≅ ⨁ subtype.restrict pᶜ f := +colimit.iso_colimit_cocone (cokernel_cofork_biproduct_from_subtype f p) + +end + +end π_kernel + +end limits + +namespace limits + +section finite_biproducts + +variables {J : Type} [fintype J] {K : Type} [fintype K] + {C : Type u} [category.{v} C] [has_zero_morphisms C] [has_finite_biproducts C] + {f : J → C} {g : K → C} /-- Convert a (dependently typed) matrix to a morphism of biproducts. @@ -548,17 +757,17 @@ def biproduct.matrix_equiv : (⨁ f ⟶ ⨁ g) ≃ (Π j k, f j ⟶ g k) := left_inv := biproduct.components_matrix, right_inv := λ m, by { ext, apply biproduct.matrix_components } } -end +end finite_biproducts -instance biproduct.ι_mono (f : J → C) [has_biproduct f] - (b : J) : split_mono (biproduct.ι f b) := -{ retraction := biproduct.desc $ - λ b', if h : b' = b then eq_to_hom (congr_arg f h) else biproduct.ι f b' ≫ biproduct.π f b } +variables {J : Type w} {C : Type u} [category.{v} C] [has_zero_morphisms C] -instance biproduct.π_epi (f : J → C) [has_biproduct f] - (b : J) : split_epi (biproduct.π f b) := -{ section_ := biproduct.lift $ - λ b', if h : b = b' then eq_to_hom (congr_arg f h) else biproduct.ι f b ≫ biproduct.π f b' } +instance biproduct.ι_mono (f : J → C) [has_biproduct f] (b : J) : + is_split_mono (biproduct.ι f b) := is_split_mono.mk' +{ retraction := biproduct.desc $ pi.single b _ } + +instance biproduct.π_epi (f : J → C) [has_biproduct f] (b : J) : + is_split_epi (biproduct.π f b) := is_split_epi.mk' +{ section_ := biproduct.lift $ pi.single b _ } /-- Auxiliary lemma for `biproduct.unique_up_to_iso`. -/ lemma biproduct.cone_point_unique_up_to_iso_hom (f : J → C) [has_biproduct f] {b : bicone f} @@ -572,6 +781,7 @@ lemma biproduct.cone_point_unique_up_to_iso_inv (f : J → C) [has_biproduct f] (hb.is_limit.cone_point_unique_up_to_iso (biproduct.is_limit _)).inv = biproduct.desc b.ι := begin refine biproduct.hom_ext' _ _ (λ j, hb.is_limit.hom_ext (λ j', _)), + discrete_cases, rw [category.assoc, is_limit.cone_point_unique_up_to_iso_inv_comp, bicone.to_cone_π_app, biproduct.bicone_π, biproduct.ι_desc, biproduct.ι_π, b.to_cone_π_app, b.ι_π] end @@ -590,22 +800,45 @@ def biproduct.unique_up_to_iso (f : J → C) [has_biproduct f] {b : bicone f} (h inv_hom_id' := by rw [← biproduct.cone_point_unique_up_to_iso_hom f hb, ← biproduct.cone_point_unique_up_to_iso_inv f hb, iso.inv_hom_id] } -section variables (C) /-- A category with finite biproducts has a zero object. -/ @[priority 100] -- see Note [lower instance priority] instance has_zero_object_of_has_finite_biproducts [has_finite_biproducts C] : has_zero_object C := -by { refine ⟨⟨biproduct pempty.elim, λ X, ⟨⟨⟨0⟩, _⟩⟩, λ X, ⟨⟨⟨0⟩, _⟩⟩⟩⟩, tidy, } +by { refine ⟨⟨biproduct empty.elim, λ X, ⟨⟨⟨0⟩, _⟩⟩, λ X, ⟨⟨⟨0⟩, _⟩⟩⟩⟩, tidy, } + +section +variables {C} [unique J] (f : J → C) + +/-- The limit bicone for the biproduct over an index type with exactly one term. -/ +@[simps] +def limit_bicone_of_unique : limit_bicone f := +{ bicone := + { X := f default, + π := λ j, eq_to_hom (by congr), + ι := λ j, eq_to_hom (by congr), }, + is_bilimit := + { is_limit := (limit_cone_of_unique f).is_limit, + is_colimit := (colimit_cocone_of_unique f).is_colimit, }, } + +@[priority 100] instance has_biproduct_unique : has_biproduct f := +has_biproduct.mk (limit_bicone_of_unique f) + +/-- A biproduct over a index type with exactly one term is just the object over that term. -/ +@[simps] +def biproduct_unique_iso : ⨁ f ≅ f default := +(biproduct.unique_up_to_iso _ (limit_bicone_of_unique f).is_bilimit).symm end +variables {C} + /-- A binary bicone for a pair of objects `P Q : C` consists of the cone point `X`, maps from `X` to both `P` and `Q`, and maps from both `P` and `Q` to `X`, so that `inl ≫ fst = 𝟙 P`, `inl ≫ snd = 0`, `inr ≫ fst = 0`, and `inr ≫ snd = 𝟙 Q` -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure binary_bicone (P Q : C) := (X : C) (fst : X ⟶ P) @@ -637,10 +870,10 @@ lemma to_cone_X (c : binary_bicone P Q) : @[simp] lemma to_cone_π_app_left (c : binary_bicone P Q) : - c.to_cone.π.app (walking_pair.left) = c.fst := rfl + c.to_cone.π.app ⟨walking_pair.left⟩ = c.fst := rfl @[simp] lemma to_cone_π_app_right (c : binary_bicone P Q) : - c.to_cone.π.app (walking_pair.right) = c.snd := rfl + c.to_cone.π.app ⟨walking_pair.right⟩ = c.snd := rfl @[simp] lemma binary_fan_fst_to_cone (c : binary_bicone P Q) : binary_fan.fst c.to_cone = c.fst := rfl @[simp] @@ -656,10 +889,10 @@ lemma to_cocone_X (c : binary_bicone P Q) : @[simp] lemma to_cocone_ι_app_left (c : binary_bicone P Q) : - c.to_cocone.ι.app (walking_pair.left) = c.inl := rfl + c.to_cocone.ι.app ⟨walking_pair.left⟩ = c.inl := rfl @[simp] lemma to_cocone_ι_app_right (c : binary_bicone P Q) : - c.to_cocone.ι.app (walking_pair.right) = c.inr := rfl + c.to_cocone.ι.app ⟨walking_pair.right⟩ = c.inr := rfl @[simp] lemma binary_cofan_inl_to_cocone (c : binary_bicone P Q) : binary_cofan.inl c.to_cocone = c.inl := rfl @@ -667,13 +900,25 @@ rfl lemma binary_cofan_inr_to_cocone (c : binary_bicone P Q) : binary_cofan.inr c.to_cocone = c.inr := rfl +instance (c : binary_bicone P Q) : is_split_mono c.inl := +is_split_mono.mk' { retraction := c.fst, id' := c.inl_fst } + +instance (c : binary_bicone P Q) : is_split_mono c.inr := +is_split_mono.mk' { retraction := c.snd, id' := c.inr_snd } + +instance (c : binary_bicone P Q) : is_split_epi c.fst := +is_split_epi.mk' { section_ := c.inl, id' := c.inl_fst } + +instance (c : binary_bicone P Q) : is_split_epi c.snd := +is_split_epi.mk' { section_ := c.inr, id' := c.inr_snd } + /-- Convert a `binary_bicone` into a `bicone` over a pair. -/ @[simps] -def to_bicone {X Y : C} (b : binary_bicone X Y) : bicone (pair X Y).obj := +def to_bicone {X Y : C} (b : binary_bicone X Y) : bicone (pair_function X Y) := { X := b.X, π := λ j, walking_pair.cases_on j b.fst b.snd, ι := λ j, walking_pair.cases_on j b.inl b.inr, - ι_π := λ j j', by { cases j; cases j', tidy } } + ι_π := λ j j', by { rcases j with ⟨⟩; rcases j' with ⟨⟩, tidy } } /-- A binary bicone is a limit cone if and only if the corresponding bicone is a limit cone. -/ def to_bicone_is_limit {X Y : C} (b : binary_bicone X Y) : @@ -692,7 +937,7 @@ namespace bicone /-- Convert a `bicone` over a function on `walking_pair` to a binary_bicone. -/ @[simps] -def to_binary_bicone {X Y : C} (b : bicone (pair X Y).obj) : binary_bicone X Y := +def to_binary_bicone {X Y : C} (b : bicone (pair_function X Y)) : binary_bicone X Y := { X := b.X, fst := b.π walking_pair.left, snd := b.π walking_pair.right, @@ -705,20 +950,20 @@ def to_binary_bicone {X Y : C} (b : bicone (pair X Y).obj) : binary_bicone X Y : /-- A bicone over a pair is a limit cone if and only if the corresponding binary bicone is a limit cone. -/ -def to_binary_bicone_is_limit {X Y : C} (b : bicone (pair X Y).obj) : +def to_binary_bicone_is_limit {X Y : C} (b : bicone (pair_function X Y)) : is_limit (b.to_binary_bicone.to_cone) ≃ is_limit (b.to_cone) := -is_limit.equiv_iso_limit $ cones.ext (iso.refl _) (λ j, by { cases j, tidy }) +is_limit.equiv_iso_limit $ cones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩; tidy }) /-- A bicone over a pair is a colimit cocone if and only if the corresponding binary bicone is a colimit cocone. -/ -def to_binary_bicone_is_colimit {X Y : C} (b : bicone (pair X Y).obj) : +def to_binary_bicone_is_colimit {X Y : C} (b : bicone (pair_function X Y)) : is_colimit (b.to_binary_bicone.to_cocone) ≃ is_colimit (b.to_cocone) := -is_colimit.equiv_iso_colimit $ cocones.ext (iso.refl _) (λ j, by { cases j, tidy }) +is_colimit.equiv_iso_colimit $ cocones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩; tidy }) end bicone /-- Structure witnessing that a binary bicone is a limit cone and a limit cocone. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure binary_bicone.is_bilimit {P Q : C} (b : binary_bicone P Q) := (is_limit : is_limit b.to_cone) (is_colimit : is_colimit b.to_cocone) @@ -733,7 +978,7 @@ def binary_bicone.to_bicone_is_bilimit {X Y : C} (b : binary_bicone X Y) : /-- A bicone over a pair is a bilimit bicone if and only if the corresponding binary bicone is a bilimit. -/ -def bicone.to_binary_bicone_is_bilimit {X Y : C} (b : bicone (pair X Y).obj) : +def bicone.to_binary_bicone_is_bilimit {X Y : C} (b : bicone (pair_function X Y)) : b.to_binary_bicone.is_bilimit ≃ b.is_bilimit := { to_fun := λ h, ⟨b.to_binary_bicone_is_limit h.is_limit, b.to_binary_bicone_is_colimit h.is_colimit⟩, @@ -745,7 +990,7 @@ def bicone.to_binary_bicone_is_bilimit {X Y : C} (b : bicone (pair X Y).obj) : /-- A bicone over `P Q : C`, which is both a limit cone and a colimit cocone. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure binary_biproduct_data (P Q : C) := (bicone : binary_bicone P Q) (is_bilimit : bicone.is_bilimit) @@ -807,7 +1052,7 @@ an alternative construction with nicer definitional properties. lemma has_binary_biproducts_of_finite_biproducts [has_finite_biproducts C] : has_binary_biproducts C := { has_binary_biproduct := λ P Q, has_binary_biproduct.mk - { bicone := (biproduct.bicone (pair P Q).obj).to_binary_bicone, + { bicone := (biproduct.bicone (pair_function P Q)).to_binary_bicone, is_bilimit := (bicone.to_binary_bicone_is_bilimit _).symm (biproduct.is_bilimit _) } } end @@ -899,22 +1144,22 @@ abbreviation biprod.desc {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g @[simp, reassoc] lemma biprod.lift_fst {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) : biprod.lift f g ≫ biprod.fst = f := -(binary_biproduct.is_limit X Y).fac _ walking_pair.left +(binary_biproduct.is_limit X Y).fac _ ⟨walking_pair.left⟩ @[simp, reassoc] lemma biprod.lift_snd {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) : biprod.lift f g ≫ biprod.snd = g := -(binary_biproduct.is_limit X Y).fac _ walking_pair.right +(binary_biproduct.is_limit X Y).fac _ ⟨walking_pair.right⟩ @[simp, reassoc] lemma biprod.inl_desc {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) : biprod.inl ≫ biprod.desc f g = f := -(binary_biproduct.is_colimit X Y).fac _ walking_pair.left +(binary_biproduct.is_colimit X Y).fac _ ⟨walking_pair.left⟩ @[simp, reassoc] lemma biprod.inr_desc {W X Y : C} [has_binary_biproduct X Y] (f : X ⟶ W) (g : Y ⟶ W) : biprod.inr ≫ biprod.desc f g = g := -(binary_biproduct.is_colimit X Y).fac _ walking_pair.right +(binary_biproduct.is_colimit X Y).fac _ ⟨walking_pair.right⟩ instance biprod.mono_lift_of_mono_left {W X Y : C} [has_binary_biproduct X Y] (f : W ⟶ X) (g : W ⟶ Y) [mono f] : mono (biprod.lift f g) := @@ -950,11 +1195,34 @@ is_colimit.map (binary_biproduct.is_colimit W X) (binary_biproduct.bicone Y Z).t (h₀ : f ≫ biprod.fst = g ≫ biprod.fst) (h₁ : f ≫ biprod.snd = g ≫ biprod.snd) : f = g := binary_fan.is_limit.hom_ext (binary_biproduct.is_limit X Y) h₀ h₁ - @[ext] lemma biprod.hom_ext' {X Y Z : C} [has_binary_biproduct X Y] (f g : X ⊞ Y ⟶ Z) (h₀ : biprod.inl ≫ f = biprod.inl ≫ g) (h₁ : biprod.inr ≫ f = biprod.inr ≫ g) : f = g := binary_cofan.is_colimit.hom_ext (binary_biproduct.is_colimit X Y) h₀ h₁ +/-- The canonical isomorphism between the chosen biproduct and the chosen product. -/ +def biprod.iso_prod (X Y : C) [has_binary_biproduct X Y] : X ⊞ Y ≅ X ⨯ Y := +is_limit.cone_point_unique_up_to_iso (binary_biproduct.is_limit X Y) (limit.is_limit _) + +@[simp] lemma biprod.iso_prod_hom {X Y : C} [has_binary_biproduct X Y] : + (biprod.iso_prod X Y).hom = prod.lift biprod.fst biprod.snd := +by ext; simp [biprod.iso_prod] + +@[simp] lemma biprod.iso_prod_inv {X Y : C} [has_binary_biproduct X Y] : + (biprod.iso_prod X Y).inv = biprod.lift prod.fst prod.snd := +by apply biprod.hom_ext; simp [iso.inv_comp_eq] + +/-- The canonical isomorphism between the chosen biproduct and the chosen coproduct. -/ +def biprod.iso_coprod (X Y : C) [has_binary_biproduct X Y] : X ⊞ Y ≅ X ⨿ Y := +is_colimit.cocone_point_unique_up_to_iso (binary_biproduct.is_colimit X Y) (colimit.is_colimit _) + +@[simp] lemma biprod.iso_coprod_inv {X Y : C} [has_binary_biproduct X Y] : + (biprod.iso_coprod X Y).inv = coprod.desc biprod.inl biprod.inr := +by ext; simp [biprod.iso_coprod]; refl + +@[simp] lemma biprod_iso_coprod_hom {X Y : C} [has_binary_biproduct X Y] : + (biprod.iso_coprod X Y).hom = biprod.desc coprod.inl coprod.inr := +by apply biprod.hom_ext'; simp [← iso.eq_comp_inv] + lemma biprod.map_eq_map' {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : biprod.map f g = biprod.map' f g := begin @@ -980,32 +1248,32 @@ begin end instance biprod.inl_mono {X Y : C} [has_binary_biproduct X Y] : - split_mono (biprod.inl : X ⟶ X ⊞ Y) := -{ retraction := biprod.desc (𝟙 X) (biprod.inr ≫ biprod.fst) } + is_split_mono (biprod.inl : X ⟶ X ⊞ Y) := +is_split_mono.mk' { retraction := biprod.fst } instance biprod.inr_mono {X Y : C} [has_binary_biproduct X Y] : - split_mono (biprod.inr : Y ⟶ X ⊞ Y) := -{ retraction := biprod.desc (biprod.inl ≫ biprod.snd) (𝟙 Y)} + is_split_mono (biprod.inr : Y ⟶ X ⊞ Y) := +is_split_mono.mk' { retraction := biprod.snd } instance biprod.fst_epi {X Y : C} [has_binary_biproduct X Y] : - split_epi (biprod.fst : X ⊞ Y ⟶ X) := -{ section_ := biprod.lift (𝟙 X) (biprod.inl ≫ biprod.snd) } + is_split_epi (biprod.fst : X ⊞ Y ⟶ X) := +is_split_epi.mk' { section_ := biprod.inl } instance biprod.snd_epi {X Y : C} [has_binary_biproduct X Y] : - split_epi (biprod.snd : X ⊞ Y ⟶ Y) := -{ section_ := biprod.lift (biprod.inr ≫ biprod.fst) (𝟙 Y) } + is_split_epi (biprod.snd : X ⊞ Y ⟶ Y) := +is_split_epi.mk' { section_ := biprod.inr } @[simp,reassoc] lemma biprod.map_fst {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : biprod.map f g ≫ biprod.fst = biprod.fst ≫ f := -is_limit.map_π _ _ _ walking_pair.left +is_limit.map_π _ _ _ (⟨walking_pair.left⟩ : discrete walking_pair) @[simp,reassoc] lemma biprod.map_snd {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biproduct Y Z] (f : W ⟶ Y) (g : X ⟶ Z) : biprod.map f g ≫ biprod.snd = biprod.snd ≫ g := -is_limit.map_π _ _ _ walking_pair.right +is_limit.map_π _ _ _ (⟨walking_pair.right⟩ : discrete walking_pair) -- Because `biprod.map` is defined in terms of `lim` rather than `colim`, -- we need to provide additional `simp` lemmas. @@ -1015,7 +1283,7 @@ lemma biprod.inl_map {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biprod biprod.inl ≫ biprod.map f g = f ≫ biprod.inl := begin rw biprod.map_eq_map', - exact is_colimit.ι_map (binary_biproduct.is_colimit W X) _ _ walking_pair.left + exact is_colimit.ι_map (binary_biproduct.is_colimit W X) _ _ ⟨walking_pair.left⟩ end @[simp,reassoc] @@ -1024,7 +1292,7 @@ lemma biprod.inr_map {W X Y Z : C} [has_binary_biproduct W X] [has_binary_biprod biprod.inr ≫ biprod.map f g = g ≫ biprod.inr := begin rw biprod.map_eq_map', - exact is_colimit.ι_map (binary_biproduct.is_colimit W X) _ _ walking_pair.right + exact is_colimit.ι_map (binary_biproduct.is_colimit W X) _ _ ⟨walking_pair.right⟩ end /-- Given a pair of isomorphisms between the summands of a pair of binary biproducts, @@ -1050,7 +1318,7 @@ lemma biprod.cone_point_unique_up_to_iso_inv (X Y : C) [has_binary_biproduct X Y begin refine biprod.hom_ext' _ _ (hb.is_limit.hom_ext (λ j, _)) (hb.is_limit.hom_ext (λ j, _)), all_goals { simp only [category.assoc, is_limit.cone_point_unique_up_to_iso_inv_comp], - cases j }, + rcases j with ⟨⟨⟩⟩ }, all_goals { simp } end @@ -1068,14 +1336,11 @@ def biprod.unique_up_to_iso (X Y : C) [has_binary_biproduct X Y] {b : binary_bic inv_hom_id' := by rw [← biprod.cone_point_unique_up_to_iso_hom X Y hb, ← biprod.cone_point_unique_up_to_iso_inv X Y hb, iso.inv_hom_id] } -section -variables (X Y : C) [has_binary_biproduct X Y] - -- There are three further variations, -- about `is_iso biprod.inr`, `is_iso biprod.fst` and `is_iso biprod.snd`, -- but any one suffices to prove `indecomposable_of_simple` -- and they are likely not separately useful. -lemma biprod.is_iso_inl_iff_id_eq_fst_comp_inl : +lemma biprod.is_iso_inl_iff_id_eq_fst_comp_inl (X Y : C) [has_binary_biproduct X Y] : is_iso (biprod.inl : X ⟶ X ⊞ Y) ↔ 𝟙 (X ⊞ Y) = biprod.fst ≫ biprod.inl := begin split, @@ -1086,16 +1351,76 @@ begin { intro h, exact ⟨⟨biprod.fst, biprod.inl_fst, h.symm⟩⟩, }, end -end - section biprod_kernel +section binary_bicone + +variables {X Y : C} (c : binary_bicone X Y) + +/-- A kernel fork for the kernel of `binary_bicone.fst`. It consists of the morphism +`binary_bicone.inr`. -/ +def binary_bicone.fst_kernel_fork : kernel_fork c.fst := kernel_fork.of_ι c.inr c.inr_fst + +@[simp] lemma binary_bicone.fst_kernel_fork_ι : (binary_bicone.fst_kernel_fork c).ι = c.inr := rfl + +/-- A kernel fork for the kernel of `binary_bicone.snd`. It consists of the morphism +`binary_bicone.inl`. -/ +def binary_bicone.snd_kernel_fork : kernel_fork c.snd := kernel_fork.of_ι c.inl c.inl_snd + +@[simp] lemma binary_bicone.snd_kernel_fork_ι : (binary_bicone.snd_kernel_fork c).ι = c.inl := rfl + +/-- A cokernel cofork for the cokernel of `binary_bicone.inl`. It consists of the morphism +`binary_bicone.snd`. -/ +def binary_bicone.inl_cokernel_cofork : cokernel_cofork c.inl := +cokernel_cofork.of_π c.snd c.inl_snd + +@[simp] lemma binary_bicone.inl_cokernel_cofork_π : + (binary_bicone.inl_cokernel_cofork c).π = c.snd := rfl + +/-- A cokernel cofork for the cokernel of `binary_bicone.inr`. It consists of the morphism +`binary_bicone.fst`. -/ +def binary_bicone.inr_cokernel_cofork : cokernel_cofork c.inr := +cokernel_cofork.of_π c.fst c.inr_fst + +@[simp] lemma binary_bicone.inr_cokernel_cofork_π : + (binary_bicone.inr_cokernel_cofork c).π = c.fst := rfl + +variables {c} + +/-- The fork defined in `binary_bicone.fst_kernel_fork` is indeed a kernel. -/ +def binary_bicone.is_limit_fst_kernel_fork (i : is_limit c.to_cone) : + is_limit c.fst_kernel_fork := +fork.is_limit.mk' _ $ λ s, +⟨s.ι ≫ c.snd, by apply binary_fan.is_limit.hom_ext i; simp, λ m hm, by simp [← hm]⟩ + +/-- The fork defined in `binary_bicone.snd_kernel_fork` is indeed a kernel. -/ +def binary_bicone.is_limit_snd_kernel_fork (i : is_limit c.to_cone) : + is_limit c.snd_kernel_fork := +fork.is_limit.mk' _ $ λ s, +⟨s.ι ≫ c.fst, by apply binary_fan.is_limit.hom_ext i; simp, λ m hm, by simp [← hm]⟩ + +/-- The cofork defined in `binary_bicone.inl_cokernel_cofork` is indeed a cokernel. -/ +def binary_bicone.is_colimit_inl_cokernel_cofork (i : is_colimit c.to_cocone) : + is_colimit c.inl_cokernel_cofork := +cofork.is_colimit.mk' _ $ λ s, ⟨c.inr ≫ s.π, by apply binary_cofan.is_colimit.hom_ext i; simp, + λ m hm, by simp [← hm]⟩ + +/-- The cofork defined in `binary_bicone.inr_cokernel_cofork` is indeed a cokernel. -/ +def binary_bicone.is_colimit_inr_cokernel_cofork (i : is_colimit c.to_cocone) : + is_colimit c.inr_cokernel_cofork := +cofork.is_colimit.mk' _ $ λ s, ⟨c.inl ≫ s.π, by apply binary_cofan.is_colimit.hom_ext i; simp, + λ m hm, by simp [← hm]⟩ + +end binary_bicone + +section has_binary_biproduct + variables (X Y : C) [has_binary_biproduct X Y] /-- A kernel fork for the kernel of `biprod.fst`. It consists of the morphism `biprod.inr`. -/ def biprod.fst_kernel_fork : kernel_fork (biprod.fst : X ⊞ Y ⟶ X) := -kernel_fork.of_ι biprod.inr biprod.inr_fst +binary_bicone.fst_kernel_fork _ @[simp] lemma biprod.fst_kernel_fork_ι : fork.ι (biprod.fst_kernel_fork X Y) = biprod.inr := @@ -1103,12 +1428,12 @@ rfl /-- The fork `biprod.fst_kernel_fork` is indeed a limit. -/ def biprod.is_kernel_fst_kernel_fork : is_limit (biprod.fst_kernel_fork X Y) := -fork.is_limit.mk' _ $ λ s, ⟨s.ι ≫ biprod.snd, by ext; simp, λ m hm, by simp [← hm]⟩ +binary_bicone.is_limit_fst_kernel_fork (binary_biproduct.is_limit _ _) /-- A kernel fork for the kernel of `biprod.snd`. It consists of the morphism `biprod.inl`. -/ def biprod.snd_kernel_fork : kernel_fork (biprod.snd : X ⊞ Y ⟶ Y) := -kernel_fork.of_ι biprod.inl biprod.inl_snd +binary_bicone.snd_kernel_fork _ @[simp] lemma biprod.snd_kernel_fork_ι : fork.ι (biprod.snd_kernel_fork X Y) = biprod.inl := @@ -1116,36 +1441,100 @@ rfl /-- The fork `biprod.snd_kernel_fork` is indeed a limit. -/ def biprod.is_kernel_snd_kernel_fork : is_limit (biprod.snd_kernel_fork X Y) := -fork.is_limit.mk' _ $ λ s, ⟨s.ι ≫ biprod.fst, by ext; simp, λ m hm, by simp [← hm]⟩ +binary_bicone.is_limit_snd_kernel_fork (binary_biproduct.is_limit _ _) /-- A cokernel cofork for the cokernel of `biprod.inl`. It consists of the morphism `biprod.snd`. -/ -def biprod.inl_cokernel_fork : cokernel_cofork (biprod.inl : X ⟶ X ⊞ Y) := -cokernel_cofork.of_π biprod.snd biprod.inl_snd +def biprod.inl_cokernel_cofork : cokernel_cofork (biprod.inl : X ⟶ X ⊞ Y) := +binary_bicone.inl_cokernel_cofork _ @[simp] -lemma biprod.inl_cokernel_fork_π : cofork.π (biprod.inl_cokernel_fork X Y) = biprod.snd := +lemma biprod.inl_cokernel_cofork_π : cofork.π (biprod.inl_cokernel_cofork X Y) = biprod.snd := rfl /-- The cofork `biprod.inl_cokernel_fork` is indeed a colimit. -/ -def biprod.is_cokernel_inl_cokernel_fork : is_colimit (biprod.inl_cokernel_fork X Y) := -cofork.is_colimit.mk' _ $ λ s, ⟨biprod.inr ≫ s.π, by ext; simp, λ m hm, by simp [← hm]⟩ +def biprod.is_cokernel_inl_cokernel_fork : is_colimit (biprod.inl_cokernel_cofork X Y) := +binary_bicone.is_colimit_inl_cokernel_cofork (binary_biproduct.is_colimit _ _) /-- A cokernel cofork for the cokernel of `biprod.inr`. It consists of the morphism `biprod.fst`. -/ -def biprod.inr_cokernel_fork : cokernel_cofork (biprod.inr : Y ⟶ X ⊞ Y) := -cokernel_cofork.of_π biprod.fst biprod.inr_fst +def biprod.inr_cokernel_cofork : cokernel_cofork (biprod.inr : Y ⟶ X ⊞ Y) := +binary_bicone.inr_cokernel_cofork _ @[simp] -lemma biprod.inr_cokernel_fork_π : cofork.π (biprod.inr_cokernel_fork X Y) = biprod.fst := +lemma biprod.inr_cokernel_cofork_π : cofork.π (biprod.inr_cokernel_cofork X Y) = biprod.fst := rfl /-- The cofork `biprod.inr_cokernel_fork` is indeed a colimit. -/ -def biprod.is_cokernel_inr_cokernel_fork : is_colimit (biprod.inr_cokernel_fork X Y) := -cofork.is_colimit.mk' _ $ λ s, ⟨biprod.inl ≫ s.π, by ext; simp, λ m hm, by simp [← hm]⟩ +def biprod.is_cokernel_inr_cokernel_fork : is_colimit (biprod.inr_cokernel_cofork X Y) := +binary_bicone.is_colimit_inr_cokernel_cofork (binary_biproduct.is_colimit _ _) + +end has_binary_biproduct + +variables {X Y : C} [has_binary_biproduct X Y] + +instance : has_kernel (biprod.fst : X ⊞ Y ⟶ X) := +has_limit.mk ⟨_, biprod.is_kernel_fst_kernel_fork X Y⟩ + +/-- The kernel of `biprod.fst : X ⊞ Y ⟶ X` is `Y`. -/ +@[simps] +def kernel_biprod_fst_iso : kernel (biprod.fst : X ⊞ Y ⟶ X) ≅ Y := +limit.iso_limit_cone ⟨_, biprod.is_kernel_fst_kernel_fork X Y⟩ + +instance : has_kernel (biprod.snd : X ⊞ Y ⟶ Y) := +has_limit.mk ⟨_, biprod.is_kernel_snd_kernel_fork X Y⟩ + +/-- The kernel of `biprod.snd : X ⊞ Y ⟶ Y` is `X`. -/ +@[simps] +def kernel_biprod_snd_iso : kernel (biprod.snd : X ⊞ Y ⟶ Y) ≅ X := +limit.iso_limit_cone ⟨_, biprod.is_kernel_snd_kernel_fork X Y⟩ + +instance : has_cokernel (biprod.inl : X ⟶ X ⊞ Y) := +has_colimit.mk ⟨_, biprod.is_cokernel_inl_cokernel_fork X Y⟩ + +/-- The cokernel of `biprod.inl : X ⟶ X ⊞ Y` is `Y`. -/ +@[simps] +def cokernel_biprod_inl_iso : cokernel (biprod.inl : X ⟶ X ⊞ Y) ≅ Y := +colimit.iso_colimit_cocone ⟨_, biprod.is_cokernel_inl_cokernel_fork X Y⟩ + +instance : has_cokernel (biprod.inr : Y ⟶ X ⊞ Y) := +has_colimit.mk ⟨_, biprod.is_cokernel_inr_cokernel_fork X Y⟩ + +/-- The cokernel of `biprod.inr : Y ⟶ X ⊞ Y` is `X`. -/ +@[simps] +def cokernel_biprod_inr_iso : cokernel (biprod.inr : Y ⟶ X ⊞ Y) ≅ X := +colimit.iso_colimit_cocone ⟨_, biprod.is_cokernel_inr_cokernel_fork X Y⟩ end biprod_kernel +section is_zero + +/-- If `Y` is a zero object, `X ≅ X ⊞ Y` for any `X`. -/ +@[simps] +def iso_biprod_zero {X Y : C} [has_binary_biproduct X Y] (hY : is_zero Y) : X ≅ X ⊞ Y := +{ hom := biprod.inl, + inv := biprod.fst, + inv_hom_id' := begin + apply category_theory.limits.biprod.hom_ext; + simp only [category.assoc, biprod.inl_fst, category.comp_id, category.id_comp, + biprod.inl_snd, comp_zero], + apply hY.eq_of_tgt + end } + +/-- If `X` is a zero object, `Y ≅ X ⊞ Y` for any `Y`. -/ +@[simps] +def iso_zero_biprod {X Y : C} [has_binary_biproduct X Y] (hY : is_zero X) : Y ≅ X ⊞ Y := +{ hom := biprod.inr, + inv := biprod.snd, + inv_hom_id' := begin + apply category_theory.limits.biprod.hom_ext; + simp only [category.assoc, biprod.inr_snd, category.comp_id, category.id_comp, + biprod.inr_fst, comp_zero], + apply hY.eq_of_tgt + end } + +end is_zero + section variables [has_binary_biproducts C] @@ -1187,506 +1576,58 @@ by simp end --- TODO: --- If someone is interested, they could provide the constructions: --- has_binary_biproducts ↔ has_finite_biproducts - end limits -namespace limits - -section preadditive -variables {C : Type u} [category.{v} C] [preadditive C] -variables {J : Type v} [decidable_eq J] [fintype J] - -open category_theory.preadditive -open_locale big_operators - -/-- -In a preadditive category, we can construct a biproduct for `f : J → C` from -any bicone `b` for `f` satisfying `total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X`. - -(That is, such a bicone is a limit cone and a colimit cocone.) --/ -def is_bilimit_of_total {f : J → C} (b : bicone f) (total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X) : - b.is_bilimit := -{ is_limit := - { lift := λ s, ∑ j, s.π.app j ≫ b.ι j, - uniq' := λ s m h, - begin - erw [←category.comp_id m, ←total, comp_sum], - apply finset.sum_congr rfl, - intros j m, - erw [reassoc_of (h j)], - end, - fac' := λ s j, - begin - simp only [sum_comp, category.assoc, bicone.to_cone_π_app, b.ι_π, comp_dite], - -- See note [dsimp, simp]. - dsimp, simp, - end }, - is_colimit := - { desc := λ s, ∑ j, b.π j ≫ s.ι.app j, - uniq' := λ s m h, - begin - erw [←category.id_comp m, ←total, sum_comp], - apply finset.sum_congr rfl, - intros j m, - erw [category.assoc, h], - end, - fac' := λ s j, - begin - simp only [comp_sum, ←category.assoc, bicone.to_cocone_ι_app, b.ι_π, dite_comp], - dsimp, simp, - end } } - -lemma is_bilimit.total {f : J → C} {b : bicone f} (i : b.is_bilimit) : - ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X := -i.is_limit.hom_ext (λ j, by simp [sum_comp, b.ι_π, comp_dite]) - -/-- -In a preadditive category, we can construct a biproduct for `f : J → C` from -any bicone `b` for `f` satisfying `total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X`. - -(That is, such a bicone is a limit cone and a colimit cocone.) --/ -lemma has_biproduct_of_total {f : J → C} (b : bicone f) (total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X) : - has_biproduct f := -has_biproduct.mk -{ bicone := b, - is_bilimit := is_bilimit_of_total b total } - -/-- In a preadditive category, any finite bicone which is a limit cone is in fact a bilimit - bicone. -/ -def is_bilimit_of_is_limit {f : J → C} (t : bicone f) (ht : is_limit t.to_cone) : t.is_bilimit := -is_bilimit_of_total _ $ ht.hom_ext $ λ j, by simp [sum_comp, t.ι_π, dite_comp, comp_dite] - -/-- We can turn any limit cone over a pair into a bilimit bicone. -/ -def bicone_is_bilimit_of_limit_cone_of_is_limit {f : J → C} {t : cone (discrete.functor f)} - (ht : is_limit t) : (bicone.of_limit_cone ht).is_bilimit := -is_bilimit_of_is_limit _ $ is_limit.of_iso_limit ht $ cones.ext (iso.refl _) (by tidy) - -/-- In a preadditive category, if the product over `f : J → C` exists, - then the biproduct over `f` exists. -/ -lemma has_biproduct.of_has_product (f : J → C) [has_product f] : has_biproduct f := -has_biproduct.mk -{ bicone := _, - is_bilimit := bicone_is_bilimit_of_limit_cone_of_is_limit (limit.is_limit _) } - -/-- In a preadditive category, any finite bicone which is a colimit cocone is in fact a bilimit - bicone. -/ -def is_bilimit_of_is_colimit {f : J → C} (t : bicone f) (ht : is_colimit t.to_cocone) : - t.is_bilimit := -is_bilimit_of_total _ $ ht.hom_ext $ λ j, - by { simp_rw [bicone.to_cocone_ι_app, comp_sum, ← category.assoc, t.ι_π, dite_comp], tidy } - -/-- We can turn any limit cone over a pair into a bilimit bicone. -/ -def bicone_is_bilimit_of_colimit_cocone_of_is_colimit {f : J → C} {t : cocone (discrete.functor f)} - (ht : is_colimit t) : (bicone.of_colimit_cocone ht).is_bilimit := -is_bilimit_of_is_colimit _ $ is_colimit.of_iso_colimit ht $ cocones.ext (iso.refl _) (by tidy) - -/-- In a preadditive category, if the coproduct over `f : J → C` exists, - then the biproduct over `f` exists. -/ -lemma has_biproduct.of_has_coproduct (f : J → C) [has_coproduct f] : has_biproduct f := -has_biproduct.mk -{ bicone := _, - is_bilimit := bicone_is_bilimit_of_colimit_cocone_of_is_colimit (colimit.is_colimit _) } - -/-- A preadditive category with finite products has finite biproducts. -/ -lemma has_finite_biproducts.of_has_finite_products [has_finite_products C] : - has_finite_biproducts C := -⟨λ J _ _, { has_biproduct := λ F, by exactI has_biproduct.of_has_product _ }⟩ - -/-- A preadditive category with finite coproducts has finite biproducts. -/ -lemma has_finite_biproducts.of_has_finite_coproducts [has_finite_coproducts C] : - has_finite_biproducts C := -⟨λ J _ _, { has_biproduct := λ F, by exactI has_biproduct.of_has_coproduct _ }⟩ - -section -variables {f : J → C} [has_biproduct f] - -/-- -In any preadditive category, any biproduct satsifies -`∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)` --/ -@[simp] lemma biproduct.total : ∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f) := -is_bilimit.total (biproduct.is_bilimit _) - -lemma biproduct.lift_eq {T : C} {g : Π j, T ⟶ f j} : - biproduct.lift g = ∑ j, g j ≫ biproduct.ι f j := -begin - ext j, - simp [sum_comp, biproduct.ι_π, comp_dite], -end - -lemma biproduct.desc_eq {T : C} {g : Π j, f j ⟶ T} : - biproduct.desc g = ∑ j, biproduct.π f j ≫ g j := -begin - ext j, - simp [comp_sum, biproduct.ι_π_assoc, dite_comp], -end - -@[simp, reassoc] lemma biproduct.lift_desc {T U : C} {g : Π j, T ⟶ f j} {h : Π j, f j ⟶ U} : - biproduct.lift g ≫ biproduct.desc h = ∑ j : J, g j ≫ h j := -by simp [biproduct.lift_eq, biproduct.desc_eq, comp_sum, sum_comp, biproduct.ι_π_assoc, - comp_dite, dite_comp] - -lemma biproduct.map_eq [has_finite_biproducts C] {f g : J → C} {h : Π j, f j ⟶ g j} : - biproduct.map h = ∑ j : J, biproduct.π f j ≫ h j ≫ biproduct.ι g j := -begin - ext, - simp [biproduct.ι_π, biproduct.ι_π_assoc, comp_sum, sum_comp, comp_dite, dite_comp], -end - -@[simp, reassoc] -lemma biproduct.matrix_desc - {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C] - {f : J → C} {g : K → C} (m : Π j k, f j ⟶ g k) {P} (x : Π k, g k ⟶ P) : - biproduct.matrix m ≫ biproduct.desc x = biproduct.desc (λ j, ∑ k, m j k ≫ x k) := -by { ext, simp, } - -@[simp, reassoc] -lemma biproduct.lift_matrix - {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C] - {f : J → C} {g : K → C} {P} (x : Π j, P ⟶ f j) (m : Π j k, f j ⟶ g k) : - biproduct.lift x ≫ biproduct.matrix m = biproduct.lift (λ k, ∑ j, x j ≫ m j k) := -by { ext, simp, } - -@[reassoc] -lemma biproduct.matrix_map - {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C] - {f : J → C} {g : K → C} {h : K → C} (m : Π j k, f j ⟶ g k) (n : Π k, g k ⟶ h k) : - biproduct.matrix m ≫ biproduct.map n = biproduct.matrix (λ j k, m j k ≫ n k) := -by { ext, simp, } - -@[reassoc] -lemma biproduct.map_matrix - {K : Type v} [fintype K] [decidable_eq K] [has_finite_biproducts C] - {f : J → C} {g : J → C} {h : K → C} (m : Π k, f k ⟶ g k) (n : Π j k, g j ⟶ h k) : - biproduct.map m ≫ biproduct.matrix n = biproduct.matrix (λ j k, m j ≫ n j k) := -by { ext, simp, } - -end - -/-- -In a preadditive category, we can construct a binary biproduct for `X Y : C` from -any binary bicone `b` satisfying `total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X`. - -(That is, such a bicone is a limit cone and a colimit cocone.) --/ -def is_binary_bilimit_of_total {X Y : C} (b : binary_bicone X Y) - (total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X) : b.is_bilimit := -{ is_limit := - { lift := λ s, binary_fan.fst s ≫ b.inl + - binary_fan.snd s ≫ b.inr, - uniq' := λ s m h, by erw [←category.comp_id m, ←total, - comp_add, reassoc_of (h walking_pair.left), reassoc_of (h walking_pair.right)], - fac' := λ s j, by cases j; simp, }, - is_colimit := - { desc := λ s, b.fst ≫ binary_cofan.inl s + - b.snd ≫ binary_cofan.inr s, - uniq' := λ s m h, by erw [←category.id_comp m, ←total, - add_comp, category.assoc, category.assoc, h walking_pair.left, h walking_pair.right], - fac' := λ s j, by cases j; simp, } } - -lemma is_bilimit.binary_total {X Y : C} {b : binary_bicone X Y} (i : b.is_bilimit) : - b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X := -i.is_limit.hom_ext (λ j, by { cases j; simp, }) - -/-- -In a preadditive category, we can construct a binary biproduct for `X Y : C` from -any binary bicone `b` satisfying `total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X`. - -(That is, such a bicone is a limit cone and a colimit cocone.) --/ -lemma has_binary_biproduct_of_total {X Y : C} (b : binary_bicone X Y) - (total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X) : has_binary_biproduct X Y := -has_binary_biproduct.mk -{ bicone := b, - is_bilimit := is_binary_bilimit_of_total b total } - -/-- We can turn any limit cone over a pair into a bicone. -/ -@[simps] -def binary_bicone.of_limit_cone {X Y : C} {t : cone (pair X Y)} (ht : is_limit t) : - binary_bicone X Y := -{ X := t.X, - fst := t.π.app walking_pair.left, - snd := t.π.app walking_pair.right, - inl := ht.lift (binary_fan.mk (𝟙 X) 0), - inr := ht.lift (binary_fan.mk 0 (𝟙 Y)) } - -lemma inl_of_is_limit {X Y : C} {t : binary_bicone X Y} (ht : is_limit t.to_cone) : - t.inl = ht.lift (binary_fan.mk (𝟙 X) 0) := -ht.hom_ext $ λ j, by { rw ht.fac, cases j; simp } - -lemma inr_of_is_limit {X Y : C} {t : binary_bicone X Y} (ht : is_limit t.to_cone) : - t.inr = ht.lift (binary_fan.mk 0 (𝟙 Y)) := -ht.hom_ext $ λ j, by { rw ht.fac, cases j; simp } - -/-- In a preadditive category, any binary bicone which is a limit cone is in fact a bilimit - bicone. -/ -def is_binary_bilimit_of_is_limit {X Y : C} (t : binary_bicone X Y) (ht : is_limit t.to_cone) : - t.is_bilimit := -is_binary_bilimit_of_total _ (by refine binary_fan.is_limit.hom_ext ht _ _; simp) - -/-- We can turn any limit cone over a pair into a bilimit bicone. -/ -def binary_bicone_is_bilimit_of_limit_cone_of_is_limit {X Y : C} {t : cone (pair X Y)} - (ht : is_limit t) : (binary_bicone.of_limit_cone ht).is_bilimit := -is_binary_bilimit_of_total _ $ binary_fan.is_limit.hom_ext ht (by simp) (by simp) - -/-- In a preadditive category, if the product of `X` and `Y` exists, then the - binary biproduct of `X` and `Y` exists. -/ -lemma has_binary_biproduct.of_has_binary_product (X Y : C) [has_binary_product X Y] : - has_binary_biproduct X Y := -has_binary_biproduct.mk -{ bicone := _, - is_bilimit := binary_bicone_is_bilimit_of_limit_cone_of_is_limit (limit.is_limit _) } - -/-- In a preadditive category, if all binary products exist, then all binary biproducts exist. -/ -lemma has_binary_biproducts.of_has_binary_products [has_binary_products C] : - has_binary_biproducts C := -{ has_binary_biproduct := λ X Y, has_binary_biproduct.of_has_binary_product X Y, } - -/-- We can turn any colimit cocone over a pair into a bicone. -/ -@[simps] -def binary_bicone.of_colimit_cocone {X Y : C} {t : cocone (pair X Y)} (ht : is_colimit t) : - binary_bicone X Y := -{ X := t.X, - fst := ht.desc (binary_cofan.mk (𝟙 X) 0), - snd := ht.desc (binary_cofan.mk 0 (𝟙 Y)), - inl := t.ι.app walking_pair.left, - inr := t.ι.app walking_pair.right } - -lemma fst_of_is_colimit {X Y : C} {t : binary_bicone X Y} (ht : is_colimit t.to_cocone) : - t.fst = ht.desc (binary_cofan.mk (𝟙 X) 0) := -begin - refine ht.hom_ext (λ j, _), - rw ht.fac, - cases j, - all_goals { simp only [binary_bicone.to_cocone_ι_app_left, binary_bicone.inl_fst, - binary_cofan.mk_ι_app_left, binary_bicone.to_cocone_ι_app_right, binary_bicone.inr_fst, - binary_cofan.mk_ι_app_right] }, - refl -end - -lemma snd_of_is_colimit {X Y : C} {t : binary_bicone X Y} (ht : is_colimit t.to_cocone) : - t.snd = ht.desc (binary_cofan.mk 0 (𝟙 Y)) := -begin - refine ht.hom_ext (λ j, _), - rw ht.fac, - cases j, - all_goals { simp only [binary_bicone.to_cocone_ι_app_left, binary_bicone.inl_snd, - binary_cofan.mk_ι_app_left, binary_bicone.to_cocone_ι_app_right, binary_bicone.inr_snd, - binary_cofan.mk_ι_app_right] }, - refl -end - -/-- In a preadditive category, any binary bicone which is a colimit cocone is in fact a - bilimit bicone. -/ -def is_binary_bilimit_of_is_colimit {X Y : C} (t : binary_bicone X Y) - (ht : is_colimit t.to_cocone) : t.is_bilimit := -is_binary_bilimit_of_total _ -begin - refine binary_cofan.is_colimit.hom_ext ht _ _; simp, - { rw [category.comp_id t.inl] }, - { rw [category.comp_id t.inr] } -end +open category_theory.limits -/-- We can turn any colimit cocone over a pair into a bilimit bicone. -/ -def binary_bicone_is_bilimit_of_colimit_cocone_of_is_colimit {X Y : C} {t : cocone (pair X Y)} - (ht : is_colimit t) : (binary_bicone.of_colimit_cocone ht).is_bilimit := -is_binary_bilimit_of_is_colimit (binary_bicone.of_colimit_cocone ht) $ - is_colimit.of_iso_colimit ht $ cocones.ext (iso.refl _) $ λ j, by { cases j, tidy } - -/-- In a preadditive category, if the coproduct of `X` and `Y` exists, then the - binary biproduct of `X` and `Y` exists. -/ -lemma has_binary_biproduct.of_has_binary_coproduct (X Y : C) [has_binary_coproduct X Y] : - has_binary_biproduct X Y := -has_binary_biproduct.mk -{ bicone := _, - is_bilimit := binary_bicone_is_bilimit_of_colimit_cocone_of_is_colimit (colimit.is_colimit _) } - -/-- In a preadditive category, if all binary coproducts exist, then all binary biproducts exist. -/ -lemma has_binary_biproducts.of_has_binary_coproducts [has_binary_coproducts C] : - has_binary_biproducts C := -{ has_binary_biproduct := λ X Y, has_binary_biproduct.of_has_binary_coproduct X Y, } +-- TODO: +-- If someone is interested, they could provide the constructions: +-- has_binary_biproducts ↔ has_finite_biproducts +variables {C : Type.{u}} [category.{v} C] [has_zero_morphisms C] [has_binary_biproducts C] -section -variables {X Y : C} [has_binary_biproduct X Y] +/-- An object is indecomposable if it cannot be written as the biproduct of two nonzero objects. -/ +def indecomposable (X : C) : Prop := ¬ is_zero X ∧ ∀ Y Z, (X ≅ Y ⊞ Z) → is_zero Y ∨ is_zero Z /-- -In any preadditive category, any binary biproduct satsifies -`biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y)`. +If +``` +(f 0) +(0 g) +``` +is invertible, then `f` is invertible. -/ -@[simp] lemma biprod.total : biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y) := -begin - ext; simp [add_comp], -end - -lemma biprod.lift_eq {T : C} {f : T ⟶ X} {g : T ⟶ Y} : - biprod.lift f g = f ≫ biprod.inl + g ≫ biprod.inr := -begin - ext; simp [add_comp], -end - -lemma biprod.desc_eq {T : C} {f : X ⟶ T} {g : Y ⟶ T} : - biprod.desc f g = biprod.fst ≫ f + biprod.snd ≫ g := -begin - ext; simp [add_comp], -end - -@[simp, reassoc] lemma biprod.lift_desc {T U : C} {f : T ⟶ X} {g : T ⟶ Y} {h : X ⟶ U} {i : Y ⟶ U} : - biprod.lift f g ≫ biprod.desc h i = f ≫ h + g ≫ i := -by simp [biprod.lift_eq, biprod.desc_eq] - -lemma biprod.map_eq [has_binary_biproducts C] {W X Y Z : C} {f : W ⟶ Y} {g : X ⟶ Z} : - biprod.map f g = biprod.fst ≫ f ≫ biprod.inl + biprod.snd ≫ g ≫ biprod.inr := -by apply biprod.hom_ext; apply biprod.hom_ext'; simp - -/-- -Every split mono `f` with a cokernel induces a binary bicone with `f` as its `inl` and -the cokernel map as its `snd`. -We will show in `is_bilimit_binary_bicone_of_split_mono_of_cokernel` that this binary bicone is in -fact already a biproduct. -/ -@[simps] -def binary_bicone_of_split_mono_of_cokernel {X Y : C} {f : X ⟶ Y} [split_mono f] - {c : cokernel_cofork f} (i : is_colimit c) : binary_bicone X c.X := -{ X := Y, - fst := retraction f, - snd := c.π, - inl := f, - inr := - let c' : cokernel_cofork (𝟙 Y - (𝟙 Y - retraction f ≫ f)) := - cokernel_cofork.of_π (cofork.π c) (by simp) in - let i' : is_colimit c' := is_cokernel_epi_comp i (retraction f) (by simp) in - let i'' := is_colimit_cofork_of_cokernel_cofork i' in - (split_epi_of_idempotent_of_is_colimit_cofork C (by simp) i'').section_, - inl_fst' := by simp, - inl_snd' := by simp, - inr_fst' := - begin - dsimp only, - rw [split_epi_of_idempotent_of_is_colimit_cofork_section_, - is_colimit_cofork_of_cokernel_cofork_desc, is_cokernel_epi_comp_desc], - dsimp only [cokernel_cofork_of_cofork_of_π], - letI := epi_of_is_colimit_cofork i, - apply zero_of_epi_comp c.π, - simp only [sub_comp, comp_sub, category.comp_id, category.assoc, split_mono.id, sub_self, - cofork.is_colimit.π_comp_desc_assoc, cokernel_cofork.π_of_π, split_mono.id_assoc], - apply sub_eq_zero_of_eq, - apply category.id_comp +lemma is_iso_left_of_is_iso_biprod_map + {W X Y Z : C} (f : W ⟶ Y) (g : X ⟶ Z) [is_iso (biprod.map f g)] : is_iso f := +⟨⟨biprod.inl ≫ inv (biprod.map f g) ≫ biprod.fst, + ⟨begin + have t := congr_arg (λ p : W ⊞ X ⟶ W ⊞ X, biprod.inl ≫ p ≫ biprod.fst) + (is_iso.hom_inv_id (biprod.map f g)), + simp only [category.id_comp, category.assoc, biprod.inl_map_assoc] at t, + simp [t], end, - inr_snd' := by apply split_epi.id } - -/-- The bicone constructed in `binary_bicone_of_split_mono_of_cokernel` is a bilimit. -This is a version of the splitting lemma that holds in all preadditive categories. -/ -def is_bilimit_binary_bicone_of_split_mono_of_cokernel {X Y : C} {f : X ⟶ Y} [split_mono f] - {c : cokernel_cofork f} (i : is_colimit c) : - (binary_bicone_of_split_mono_of_cokernel i).is_bilimit := -is_binary_bilimit_of_total _ -begin - simp only [binary_bicone_of_split_mono_of_cokernel_fst, - binary_bicone_of_split_mono_of_cokernel_inr, binary_bicone_of_split_mono_of_cokernel_snd, - split_epi_of_idempotent_of_is_colimit_cofork_section_], - dsimp only [binary_bicone_of_split_mono_of_cokernel_X], - rw [is_colimit_cofork_of_cokernel_cofork_desc, is_cokernel_epi_comp_desc], - simp only [binary_bicone_of_split_mono_of_cokernel_inl, cofork.is_colimit.π_comp_desc, - cokernel_cofork_of_cofork_π, cofork.π_of_π, add_sub_cancel'_right] -end - -/-- -Every split epi `f` with a kernel induces a binary bicone with `f` as its `snd` and -the kernel map as its `inl`. -We will show in `binary_bicone_of_split_mono_of_cokernel` that this binary bicone is in fact -already a biproduct. -/ -@[simps] -def binary_bicone_of_split_epi_of_kernel {X Y : C} {f : X ⟶ Y} [split_epi f] - {c : kernel_fork f} (i : is_limit c) : binary_bicone c.X Y := -{ X := X, - fst := - let c' : kernel_fork (𝟙 X - (𝟙 X - f ≫ section_ f)) := - kernel_fork.of_ι (fork.ι c) (by simp) in - let i' : is_limit c' := is_kernel_comp_mono i (section_ f) (by simp) in - let i'' := is_limit_fork_of_kernel_fork i' in - (split_mono_of_idempotent_of_is_limit_fork C (by simp) i'').retraction, - snd := f, - inl := c.ι, - inr := section_ f, - inl_fst' := by apply split_mono.id, - inl_snd' := by simp, - inr_fst' := begin - dsimp only, - rw [split_mono_of_idempotent_of_is_limit_fork_retraction, - is_limit_fork_of_kernel_fork_lift, is_kernel_comp_mono_lift], - dsimp only [kernel_fork_of_fork_ι], - letI := mono_of_is_limit_fork i, - apply zero_of_comp_mono c.ι, - simp only [comp_sub, category.comp_id, category.assoc, sub_self, fork.is_limit.lift_comp_ι, - fork.ι_of_ι, split_epi.id_assoc] - end, - inr_snd' := by simp } - -/-- The bicone constructed in `binary_bicone_of_split_epi_of_kernel` is a bilimit. -This is a version of the splitting lemma that holds in all preadditive categories. -/ -def is_bilimit_binary_bicone_of_split_epi_of_kernel {X Y : C} {f : X ⟶ Y} [split_epi f] - {c : kernel_fork f} (i : is_limit c) : - (binary_bicone_of_split_epi_of_kernel i).is_bilimit := -is_binary_bilimit_of_total _ -begin - simp only [binary_bicone_of_split_epi_of_kernel_fst, binary_bicone_of_split_epi_of_kernel_inl, - binary_bicone_of_split_epi_of_kernel_inr, binary_bicone_of_split_epi_of_kernel_snd, - split_mono_of_idempotent_of_is_limit_fork_retraction], - dsimp only [binary_bicone_of_split_epi_of_kernel_X], - rw [is_limit_fork_of_kernel_fork_lift, is_kernel_comp_mono_lift], - simp only [fork.is_limit.lift_comp_ι, fork.ι_of_ι, kernel_fork_of_fork_ι, sub_add_cancel] -end - -end - -section -variables {X Y : C} (f g : X ⟶ Y) - -/-- The existence of binary biproducts implies that there is at most one preadditive structure. -/ -lemma biprod.add_eq_lift_id_desc [has_binary_biproduct X X] : - f + g = biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g := -by simp - -/-- The existence of binary biproducts implies that there is at most one preadditive structure. -/ -lemma biprod.add_eq_lift_desc_id [has_binary_biproduct Y Y] : - f + g = biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y) := -by simp + have t := congr_arg (λ p : Y ⊞ Z ⟶ Y ⊞ Z, biprod.inl ≫ p ≫ biprod.fst) + (is_iso.inv_hom_id (biprod.map f g)), + simp only [category.id_comp, category.assoc, biprod.map_fst] at t, + simp only [category.assoc], + simp [t], + end⟩⟩⟩ -end - -end preadditive - -end limits - -open category_theory.limits - -section -local attribute [ext] preadditive - -/-- The existence of binary biproducts implies that there is at most one preadditive structure. -/ -instance subsingleton_preadditive_of_has_binary_biproducts {C : Type u} [category.{v} C] - [has_zero_morphisms C] [has_binary_biproducts C] : subsingleton (preadditive C) := -subsingleton.intro $ λ a b, +/-- +If +``` +(f 0) +(0 g) +``` +is invertible, then `g` is invertible. +-/ +lemma is_iso_right_of_is_iso_biprod_map + {W X Y Z : C} (f : W ⟶ Y) (g : X ⟶ Z) [is_iso (biprod.map f g)] : is_iso g := begin - ext X Y f g, - have h₁ := @biprod.add_eq_lift_id_desc _ _ a _ _ f g - (by convert (infer_instance : has_binary_biproduct X X)), - have h₂ := @biprod.add_eq_lift_id_desc _ _ b _ _ f g - (by convert (infer_instance : has_binary_biproduct X X)), - refine h₁.trans (eq.trans _ h₂.symm), - congr' 2; - exact subsingleton.elim _ _ -end + letI : is_iso (biprod.map g f) := by + { rw [←biprod.braiding_map_braiding], + apply_instance, }, + exact is_iso_left_of_is_iso_biprod_map g f, end -variables {C : Type u} [category.{v} C] [has_zero_morphisms C] [has_binary_biproducts C] - -/-- An object is indecomposable if it cannot be written as the biproduct of two nonzero objects. -/ -def indecomposable (X : C) : Prop := ¬ is_zero X ∧ ∀ Y Z, (X ≅ Y ⊞ Z) → is_zero Y ∨ is_zero Z - end category_theory diff --git a/src/category_theory/limits/shapes/comm_sq.lean b/src/category_theory/limits/shapes/comm_sq.lean new file mode 100644 index 0000000000000..6ff7ca160f1c9 --- /dev/null +++ b/src/category_theory/limits/shapes/comm_sq.lean @@ -0,0 +1,907 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Joël Riou +-/ +import category_theory.comm_sq +import category_theory.limits.opposites +import category_theory.limits.shapes.biproducts +import category_theory.limits.shapes.zero_morphisms +import category_theory.limits.constructions.binary_products +import category_theory.limits.constructions.zero_objects + +/-! +# Pullback and pushout squares, and bicartesian squares + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide another API for pullbacks and pushouts. + +`is_pullback fst snd f g` is the proposition that +``` + P --fst--> X + | | + snd f + | | + v v + Y ---g---> Z + +``` +is a pullback square. + +(And similarly for `is_pushout`.) + +We provide the glue to go back and forth to the usual `is_limit` API for pullbacks, and prove +`is_pullback (pullback.fst : pullback f g ⟶ X) (pullback.snd : pullback f g ⟶ Y) f g` +for the usual `pullback f g` provided by the `has_limit` API. + +We don't attempt to restate everything we know about pullbacks in this language, +but do restate the pasting lemmas. + +We define bicartesian squares, and +show that the pullback and pushout squares for a biproduct are bicartesian. +-/ + +noncomputable theory + +open category_theory +open category_theory.limits + +universes v₁ v₂ u₁ u₂ + +namespace category_theory + +variables {C : Type u₁} [category.{v₁} C] + +attribute [simp] comm_sq.mk + +namespace comm_sq + +variables {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + +/-- +The (not necessarily limiting) `pullback_cone h i` implicit in the statement +that we have `comm_sq f g h i`. +-/ +def cone (s : comm_sq f g h i) : pullback_cone h i := pullback_cone.mk _ _ s.w + +/-- +The (not necessarily limiting) `pushout_cocone f g` implicit in the statement +that we have `comm_sq f g h i`. +-/ +def cocone (s : comm_sq f g h i) : pushout_cocone f g := pushout_cocone.mk _ _ s.w + +@[simp] lemma cone_fst (s : comm_sq f g h i) : s.cone.fst = f := rfl +@[simp] lemma cone_snd (s : comm_sq f g h i) : s.cone.snd = g := rfl +@[simp] lemma cocone_inl (s : comm_sq f g h i) : s.cocone.inl = h := rfl +@[simp] lemma cocone_inr (s : comm_sq f g h i) : s.cocone.inr = i := rfl + +/-- The pushout cocone in the opposite category associated to the cone of +a commutative square identifies to the cocone of the flipped commutative square in +the opposite category -/ +def cone_op (p : comm_sq f g h i) : p.cone.op ≅ p.flip.op.cocone := +pushout_cocone.ext (iso.refl _) (by tidy) (by tidy) + +/-- The pullback cone in the opposite category associated to the cocone of +a commutative square identifies to the cone of the flipped commutative square in +the opposite category -/ +def cocone_op (p : comm_sq f g h i) : p.cocone.op ≅ p.flip.op.cone := +pullback_cone.ext (iso.refl _) (by tidy) (by tidy) + +/-- The pushout cocone obtained from the pullback cone associated to a +commutative square in the opposite category identifies to the cocone associated +to the flipped square. -/ +def cone_unop {W X Y Z : Cᵒᵖ} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + (p : comm_sq f g h i) : p.cone.unop ≅ p.flip.unop.cocone := +pushout_cocone.ext (iso.refl _) (by tidy) (by tidy) + +/-- The pullback cone obtained from the pushout cone associated to a +commutative square in the opposite category identifies to the cone associated +to the flipped square. -/ +def cocone_unop {W X Y Z : Cᵒᵖ} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + (p : comm_sq f g h i) : p.cocone.unop ≅ p.flip.unop.cone := +pullback_cone.ext (iso.refl _) (by tidy) (by tidy) + +end comm_sq + +/-- The proposition that a square +``` + P --fst--> X + | | + snd f + | | + v v + Y ---g---> Z + +``` +is a pullback square. (Also known as a fibered product or cartesian square.) +-/ +structure is_pullback {P X Y Z : C} (fst : P ⟶ X) (snd : P ⟶ Y) (f : X ⟶ Z) (g : Y ⟶ Z) + extends comm_sq fst snd f g : Prop := +(is_limit' : nonempty (is_limit (pullback_cone.mk _ _ w))) + +/-- The proposition that a square +``` + Z ---f---> X + | | + g inl + | | + v v + Y --inr--> P + +``` +is a pushout square. (Also known as a fiber coproduct or cocartesian square.) +-/ +structure is_pushout {Z X Y P : C} (f : Z ⟶ X) (g : Z ⟶ Y) (inl : X ⟶ P) (inr : Y ⟶ P) + extends comm_sq f g inl inr : Prop := +(is_colimit' : nonempty (is_colimit (pushout_cocone.mk _ _ w))) + + +section +set_option old_structure_cmd true + +/-- A *bicartesian* square is a commutative square +``` + W ---f---> X + | | + g h + | | + v v + Y ---i---> Z + +``` +that is both a pullback square and a pushout square. +-/ +structure bicartesian_sq {W X Y Z : C} (f : W ⟶ X) (g : W ⟶ Y) (h : X ⟶ Z) (i : Y ⟶ Z) + extends is_pullback f g h i, is_pushout f g h i : Prop + +-- Lean should make these parent projections as `lemma`, not `def`. +attribute [nolint def_lemma doc_blame] bicartesian_sq.to_is_pullback bicartesian_sq.to_is_pushout + +end + +/-! +We begin by providing some glue between `is_pullback` and the `is_limit` and `has_limit` APIs. +(And similarly for `is_pushout`.) +-/ + +namespace is_pullback + +variables {P X Y Z : C} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z} + +/-- +The (limiting) `pullback_cone f g` implicit in the statement +that we have a `is_pullback fst snd f g`. +-/ +def cone (h : is_pullback fst snd f g) : pullback_cone f g := h.to_comm_sq.cone + +@[simp] lemma cone_fst (h : is_pullback fst snd f g) : h.cone.fst = fst := rfl +@[simp] lemma cone_snd (h : is_pullback fst snd f g) : h.cone.snd = snd := rfl + +/-- +The cone obtained from `is_pullback fst snd f g` is a limit cone. +-/ +noncomputable def is_limit (h : is_pullback fst snd f g) : is_limit h.cone := +h.is_limit'.some + +/-- If `c` is a limiting pullback cone, then we have a `is_pullback c.fst c.snd f g`. -/ +lemma of_is_limit {c : pullback_cone f g} (h : limits.is_limit c) : + is_pullback c.fst c.snd f g := +{ w := c.condition, + is_limit' := ⟨is_limit.of_iso_limit h + (limits.pullback_cone.ext (iso.refl _) (by tidy) (by tidy))⟩, } + +/-- A variant of `of_is_limit` that is more useful with `apply`. -/ +lemma of_is_limit' (w : comm_sq fst snd f g) (h : limits.is_limit w.cone) : + is_pullback fst snd f g := +of_is_limit h + +/-- The pullback provided by `has_pullback f g` fits into a `is_pullback`. -/ +lemma of_has_pullback (f : X ⟶ Z) (g : Y ⟶ Z) [has_pullback f g] : + is_pullback (pullback.fst : pullback f g ⟶ X) (pullback.snd : pullback f g ⟶ Y) f g := +of_is_limit (limit.is_limit (cospan f g)) + +/-- If `c` is a limiting binary product cone, and we have a terminal object, +then we have `is_pullback c.fst c.snd 0 0` +(where each `0` is the unique morphism to the terminal object). -/ +lemma of_is_product {c : binary_fan X Y} (h : limits.is_limit c) (t : is_terminal Z) : + is_pullback c.fst c.snd (t.from _) (t.from _) := +of_is_limit (is_pullback_of_is_terminal_is_product _ _ _ _ t + (is_limit.of_iso_limit h (limits.cones.ext (iso.refl c.X) (by rintro ⟨⟨⟩⟩; { dsimp, simp, })))) + +/-- A variant of `of_is_product` that is more useful with `apply`. -/ +lemma of_is_product' (h : limits.is_limit (binary_fan.mk fst snd)) (t : is_terminal Z) : + is_pullback fst snd (t.from _) (t.from _) := +of_is_product h t + +variables (X Y) + +lemma of_has_binary_product' [has_binary_product X Y] [has_terminal C] : + is_pullback limits.prod.fst limits.prod.snd (terminal.from X) (terminal.from Y) := +of_is_product (limit.is_limit _) terminal_is_terminal + +open_locale zero_object + +lemma of_has_binary_product [has_binary_product X Y] [has_zero_object C] [has_zero_morphisms C] : + is_pullback limits.prod.fst limits.prod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +by convert of_is_product (limit.is_limit _) has_zero_object.zero_is_terminal + +variables {X Y} + +/-- Any object at the top left of a pullback square is +isomorphic to the pullback provided by the `has_limit` API. -/ +noncomputable +def iso_pullback (h : is_pullback fst snd f g) [has_pullback f g] : P ≅ pullback f g := +(limit.iso_limit_cone ⟨_, h.is_limit⟩).symm + +@[simp] lemma iso_pullback_hom_fst (h : is_pullback fst snd f g) [has_pullback f g] : + h.iso_pullback.hom ≫ pullback.fst = fst := +by { dsimp [iso_pullback, cone, comm_sq.cone], simp, } +@[simp] lemma iso_pullback_hom_snd (h : is_pullback fst snd f g) [has_pullback f g] : + h.iso_pullback.hom ≫ pullback.snd = snd := +by { dsimp [iso_pullback, cone, comm_sq.cone], simp, } +@[simp] lemma iso_pullback_inv_fst (h : is_pullback fst snd f g) [has_pullback f g] : + h.iso_pullback.inv ≫ fst = pullback.fst := +by simp [iso.inv_comp_eq] +@[simp] lemma iso_pullback_inv_snd (h : is_pullback fst snd f g) [has_pullback f g] : + h.iso_pullback.inv ≫ snd = pullback.snd := +by simp [iso.inv_comp_eq] + +lemma of_iso_pullback (h : comm_sq fst snd f g) [has_pullback f g] (i : P ≅ pullback f g) + (w₁ : i.hom ≫ pullback.fst = fst) (w₂ : i.hom ≫ pullback.snd = snd) : is_pullback fst snd f g := +of_is_limit' h (limits.is_limit.of_iso_limit (limit.is_limit _) + (@pullback_cone.ext _ _ _ _ _ _ _ (pullback_cone.mk _ _ _) _ i w₁.symm w₂.symm).symm) + +lemma of_horiz_is_iso [is_iso fst] [is_iso g] (sq : comm_sq fst snd f g) : + is_pullback fst snd f g := of_is_limit' sq +begin + refine pullback_cone.is_limit.mk _ (λ s, s.fst ≫ inv fst) (by tidy) (λ s, _) (by tidy), + simp only [← cancel_mono g, category.assoc, ← sq.w, is_iso.inv_hom_id_assoc, s.condition], +end + +end is_pullback + +namespace is_pushout + +variables {Z X Y P : C} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P} + +/-- +The (colimiting) `pushout_cocone f g` implicit in the statement +that we have a `is_pushout f g inl inr`. +-/ +def cocone (h : is_pushout f g inl inr) : pushout_cocone f g := h.to_comm_sq.cocone + +@[simp] lemma cocone_inl (h : is_pushout f g inl inr) : h.cocone.inl = inl := rfl +@[simp] lemma cocone_inr (h : is_pushout f g inl inr) : h.cocone.inr = inr := rfl + +/-- +The cocone obtained from `is_pushout f g inl inr` is a colimit cocone. +-/ +noncomputable def is_colimit (h : is_pushout f g inl inr) : is_colimit h.cocone := +h.is_colimit'.some + +/-- If `c` is a colimiting pushout cocone, then we have a `is_pushout f g c.inl c.inr`. -/ +lemma of_is_colimit {c : pushout_cocone f g} (h : limits.is_colimit c) : + is_pushout f g c.inl c.inr := +{ w := c.condition, + is_colimit' := ⟨is_colimit.of_iso_colimit h + (limits.pushout_cocone.ext (iso.refl _) (by tidy) (by tidy))⟩, } + +/-- A variant of `of_is_colimit` that is more useful with `apply`. -/ +lemma of_is_colimit' (w : comm_sq f g inl inr) (h : limits.is_colimit w.cocone) : + is_pushout f g inl inr := +of_is_colimit h + +/-- The pushout provided by `has_pushout f g` fits into a `is_pushout`. -/ +lemma of_has_pushout (f : Z ⟶ X) (g : Z ⟶ Y) [has_pushout f g] : + is_pushout f g (pushout.inl : X ⟶ pushout f g) (pushout.inr : Y ⟶ pushout f g) := +of_is_colimit (colimit.is_colimit (span f g)) + +/-- If `c` is a colimiting binary coproduct cocone, and we have an initial object, +then we have `is_pushout 0 0 c.inl c.inr` +(where each `0` is the unique morphism from the initial object). -/ +lemma of_is_coproduct {c : binary_cofan X Y} (h : limits.is_colimit c) (t : is_initial Z) : + is_pushout (t.to _) (t.to _) c.inl c.inr := +of_is_colimit (is_pushout_of_is_initial_is_coproduct _ _ _ _ t + (is_colimit.of_iso_colimit h + (limits.cocones.ext (iso.refl c.X) (by rintro ⟨⟨⟩⟩; { dsimp, simp, })))) + +/-- A variant of `of_is_coproduct` that is more useful with `apply`. -/ +lemma of_is_coproduct' (h : limits.is_colimit (binary_cofan.mk inl inr)) (t : is_initial Z) : + is_pushout (t.to _) (t.to _) inl inr := +of_is_coproduct h t + +variables (X Y) + +lemma of_has_binary_coproduct' [has_binary_coproduct X Y] [has_initial C] : + is_pushout (initial.to _) (initial.to _) (coprod.inl : X ⟶ _) (coprod.inr : Y ⟶ _) := +of_is_coproduct (colimit.is_colimit _) initial_is_initial + +open_locale zero_object + +lemma of_has_binary_coproduct + [has_binary_coproduct X Y] [has_zero_object C] [has_zero_morphisms C] : + is_pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) coprod.inl coprod.inr := +by convert of_is_coproduct (colimit.is_colimit _) has_zero_object.zero_is_initial + +variables {X Y} + +/-- Any object at the top left of a pullback square is +isomorphic to the pullback provided by the `has_limit` API. -/ +noncomputable +def iso_pushout (h : is_pushout f g inl inr) [has_pushout f g] : P ≅ pushout f g := +(colimit.iso_colimit_cocone ⟨_, h.is_colimit⟩).symm + +@[simp] lemma inl_iso_pushout_inv (h : is_pushout f g inl inr) [has_pushout f g] : + pushout.inl ≫ h.iso_pushout.inv = inl := +by { dsimp [iso_pushout, cocone, comm_sq.cocone], simp, } +@[simp] lemma inr_iso_pushout_inv (h : is_pushout f g inl inr) [has_pushout f g] : + pushout.inr ≫ h.iso_pushout.inv = inr := +by { dsimp [iso_pushout, cocone, comm_sq.cocone], simp, } +@[simp] lemma inl_iso_pushout_hom (h : is_pushout f g inl inr) [has_pushout f g] : + inl ≫ h.iso_pushout.hom = pushout.inl := +by simp [←iso.eq_comp_inv] +@[simp] lemma inr_iso_pushout_hom (h : is_pushout f g inl inr) [has_pushout f g] : + inr ≫ h.iso_pushout.hom = pushout.inr := +by simp [←iso.eq_comp_inv] + +lemma of_iso_pushout (h : comm_sq f g inl inr) [has_pushout f g] (i : P ≅ pushout f g) + (w₁ : inl ≫ i.hom = pushout.inl) (w₂ : inr ≫ i.hom = pushout.inr) : is_pushout f g inl inr := +of_is_colimit' h (limits.is_colimit.of_iso_colimit (colimit.is_colimit _) + (@pushout_cocone.ext _ _ _ _ _ _ _ (pushout_cocone.mk _ _ _) _ i w₁ w₂).symm) + +end is_pushout + +namespace is_pullback + +variables {P X Y Z : C} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z} + +lemma flip (h : is_pullback fst snd f g) : is_pullback snd fst g f := +of_is_limit (@pullback_cone.flip_is_limit _ _ _ _ _ _ _ _ _ _ h.w.symm h.is_limit) + +lemma flip_iff : is_pullback fst snd f g ↔ is_pullback snd fst g f := +⟨flip, flip⟩ + +section + +variables [has_zero_object C] [has_zero_morphisms C] +open_locale zero_object + +/-- The square with `0 : 0 ⟶ 0` on the left and `𝟙 X` on the right is a pullback square. -/ +@[simp] lemma zero_left (X : C) : is_pullback (0 : 0 ⟶ X) (0 : 0 ⟶ 0) (𝟙 X) (0 : 0 ⟶ X) := +{ w := by simp, + is_limit' := + ⟨{ lift := λ s, 0, + fac' := λ s, by simpa using @pullback_cone.equalizer_ext _ _ _ _ _ _ _ s _ 0 (𝟙 _) + (by simpa using (pullback_cone.condition s).symm), }⟩ } + +/-- The square with `0 : 0 ⟶ 0` on the top and `𝟙 X` on the bottom is a pullback square. -/ +@[simp] lemma zero_top (X : C) : is_pullback (0 : 0 ⟶ 0) (0 : 0 ⟶ X) (0 : 0 ⟶ X) (𝟙 X) := +(zero_left X).flip + +/-- The square with `0 : 0 ⟶ 0` on the right and `𝟙 X` on the left is a pullback square. -/ +@[simp] lemma zero_right (X : C) : is_pullback (0 : X ⟶ 0) (𝟙 X) (0 : 0 ⟶ 0) (0 : X ⟶ 0) := +of_iso_pullback (by simp) ((zero_prod_iso X).symm ≪≫ (pullback_zero_zero_iso _ _).symm) + (by simp) (by simp) + +/-- The square with `0 : 0 ⟶ 0` on the bottom and `𝟙 X` on the top is a pullback square. -/ +@[simp] lemma zero_bot (X : C) : is_pullback (𝟙 X) (0 : X ⟶ 0) (0 : X ⟶ 0) (0 : 0 ⟶ 0) := +(zero_right X).flip + +end + +/-- Paste two pullback squares "vertically" to obtain another pullback square. -/ +-- Objects here are arranged in a 3x2 grid, and indexed by their xy coordinates. +-- Morphisms are named `hᵢⱼ` for a horizontal morphism starting at `(i,j)`, +-- and `vᵢⱼ` for a vertical morphism starting at `(i,j)`. +lemma paste_vert {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂} + (s : is_pullback h₁₁ v₁₁ v₁₂ h₂₁) (t : is_pullback h₂₁ v₂₁ v₂₂ h₃₁) : + is_pullback h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ := +(of_is_limit + (big_square_is_pullback _ _ _ _ _ _ _ s.w t.w t.is_limit s.is_limit)) + +/-- Paste two pullback squares "horizontally" to obtain another pullback square. -/ +lemma paste_horiz {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃} + (s : is_pullback h₁₁ v₁₁ v₁₂ h₂₁) (t : is_pullback h₁₂ v₁₂ v₁₃ h₂₂) : + is_pullback (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) := +(paste_vert s.flip t.flip).flip + +/-- Given a pullback square assembled from a commuting square on the top and +a pullback square on the bottom, the top square is a pullback square. -/ +lemma of_bot {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂} + (s : is_pullback h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁) (p : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁) + (t : is_pullback h₂₁ v₂₁ v₂₂ h₃₁) : + is_pullback h₁₁ v₁₁ v₁₂ h₂₁ := +of_is_limit (left_square_is_pullback _ _ _ _ _ _ _ p _ t.is_limit s.is_limit) + +/-- Given a pullback square assembled from a commuting square on the left and +a pullback square on the right, the left square is a pullback square. -/ +lemma of_right {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃} + (s : is_pullback (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂)) (p : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁) + (t : is_pullback h₁₂ v₁₂ v₁₃ h₂₂) : + is_pullback h₁₁ v₁₁ v₁₂ h₂₁ := +(of_bot s.flip p.symm t.flip).flip + +lemma paste_vert_iff {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂} + (s : is_pullback h₂₁ v₂₁ v₂₂ h₃₁) (e : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁) : + is_pullback h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ ↔ is_pullback h₁₁ v₁₁ v₁₂ h₂₁ := +⟨λ h, h.of_bot e s, λ h, h.paste_vert s⟩ + +lemma paste_horiz_iff {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃} + (s : is_pullback h₁₂ v₁₂ v₁₃ h₂₂) (e : h₁₁ ≫ v₁₂ = v₁₁ ≫ h₂₁) : + is_pullback (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) ↔ is_pullback h₁₁ v₁₁ v₁₂ h₂₁ := +⟨λ h, h.of_right e s, λ h, h.paste_horiz s⟩ + +section + +variables [has_zero_object C] [has_zero_morphisms C] +open_locale zero_object + +lemma of_is_bilimit {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pullback b.fst b.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +by convert is_pullback.of_is_product' h.is_limit has_zero_object.zero_is_terminal + +@[simp] lemma of_has_biproduct (X Y : C) [has_binary_biproduct X Y] : + is_pullback biprod.fst biprod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +of_is_bilimit (binary_biproduct.is_bilimit X Y) + +lemma inl_snd' {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pullback b.inl (0 : X ⟶ 0) b.snd (0 : 0 ⟶ Y) := +by { refine of_right _ (by simp) (of_is_bilimit h), simp, } + +/-- +The square +``` + X --inl--> X ⊞ Y + | | + 0 snd + | | + v v + 0 ---0-----> Y +``` +is a pullback square. +-/ +@[simp] lemma inl_snd (X Y : C) [has_binary_biproduct X Y] : + is_pullback biprod.inl (0 : X ⟶ 0) biprod.snd (0 : 0 ⟶ Y) := +inl_snd' (binary_biproduct.is_bilimit X Y) + +lemma inr_fst' {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pullback b.inr (0 : Y ⟶ 0) b.fst (0 : 0 ⟶ X) := +by { apply flip, refine of_bot _ (by simp) (of_is_bilimit h), simp, } + +/-- +The square +``` + Y --inr--> X ⊞ Y + | | + 0 fst + | | + v v + 0 ---0-----> X +``` +is a pullback square. +-/ +@[simp] lemma inr_fst (X Y : C) [has_binary_biproduct X Y] : + is_pullback biprod.inr (0 : Y ⟶ 0) biprod.fst (0 : 0 ⟶ X) := +inr_fst' (binary_biproduct.is_bilimit X Y) + +lemma of_is_bilimit' {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pullback (0 : 0 ⟶ X) (0 : 0 ⟶ Y) b.inl b.inr := +by { refine is_pullback.of_right _ (by simp) (is_pullback.inl_snd' h).flip, simp, } + +lemma of_has_binary_biproduct (X Y : C) [has_binary_biproduct X Y] : + is_pullback (0 : 0 ⟶ X) (0 : 0 ⟶ Y) biprod.inl biprod.inr := +of_is_bilimit' (binary_biproduct.is_bilimit X Y) + +instance has_pullback_biprod_fst_biprod_snd [has_binary_biproduct X Y] : + has_pullback (biprod.inl : X ⟶ _) (biprod.inr : Y ⟶ _) := +has_limit.mk ⟨_, (of_has_binary_biproduct X Y).is_limit⟩ + +/-- The pullback of `biprod.inl` and `biprod.inr` is the zero object. -/ +def pullback_biprod_inl_biprod_inr [has_binary_biproduct X Y] : + pullback (biprod.inl : X ⟶ _) (biprod.inr : Y ⟶ _) ≅ 0 := +limit.iso_limit_cone ⟨_, (of_has_binary_biproduct X Y).is_limit⟩ + +end + +lemma op (h : is_pullback fst snd f g) : is_pushout g.op f.op snd.op fst.op := +is_pushout.of_is_colimit (is_colimit.of_iso_colimit + (limits.pullback_cone.is_limit_equiv_is_colimit_op h.flip.cone h.flip.is_limit) + h.to_comm_sq.flip.cone_op) + +lemma unop {P X Y Z : Cᵒᵖ} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z} + (h : is_pullback fst snd f g) : is_pushout g.unop f.unop snd.unop fst.unop := +is_pushout.of_is_colimit (is_colimit.of_iso_colimit + (limits.pullback_cone.is_limit_equiv_is_colimit_unop h.flip.cone h.flip.is_limit) + h.to_comm_sq.flip.cone_unop) + +lemma of_vert_is_iso [is_iso snd] [is_iso f] (sq : comm_sq fst snd f g) : + is_pullback fst snd f g := is_pullback.flip (of_horiz_is_iso sq.flip) + +end is_pullback + +namespace is_pushout + +variables {Z X Y P : C} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P} + +lemma flip (h : is_pushout f g inl inr) : is_pushout g f inr inl := +of_is_colimit (@pushout_cocone.flip_is_colimit _ _ _ _ _ _ _ _ _ _ h.w.symm h.is_colimit) + +lemma flip_iff : is_pushout f g inl inr ↔ is_pushout g f inr inl := +⟨flip, flip⟩ + +section + +variables [has_zero_object C] [has_zero_morphisms C] +open_locale zero_object + +/-- The square with `0 : 0 ⟶ 0` on the right and `𝟙 X` on the left is a pushout square. -/ +@[simp] lemma zero_right (X : C) : is_pushout (0 : X ⟶ 0) (𝟙 X) (0 : 0 ⟶ 0) (0 : X ⟶ 0) := +{ w := by simp, + is_colimit' := + ⟨{ desc := λ s, 0, + fac' := λ s, begin + have c := @pushout_cocone.coequalizer_ext _ _ _ _ _ _ _ s _ 0 (𝟙 _) (by simp) + (by simpa using (pushout_cocone.condition s)), + dsimp at c, + simpa using c, + end }⟩ } + +/-- The square with `0 : 0 ⟶ 0` on the bottom and `𝟙 X` on the top is a pushout square. -/ +@[simp] lemma zero_bot (X : C) : is_pushout (𝟙 X) (0 : X ⟶ 0) (0 : X ⟶ 0) (0 : 0 ⟶ 0) := +(zero_right X).flip + +/-- The square with `0 : 0 ⟶ 0` on the right left `𝟙 X` on the right is a pushout square. -/ +@[simp] lemma zero_left (X : C) : is_pushout (0 : 0 ⟶ X) (0 : 0 ⟶ 0) (𝟙 X) (0 : 0 ⟶ X) := +of_iso_pushout (by simp) ((coprod_zero_iso X).symm ≪≫ (pushout_zero_zero_iso _ _).symm) + (by simp) (by simp) + +/-- The square with `0 : 0 ⟶ 0` on the top and `𝟙 X` on the bottom is a pushout square. -/ +@[simp] lemma zero_top (X : C) : is_pushout (0 : 0 ⟶ 0) (0 : 0 ⟶ X) (0 : 0 ⟶ X) (𝟙 X) := +(zero_left X).flip + +end + +/-- Paste two pushout squares "vertically" to obtain another pushout square. -/ +-- Objects here are arranged in a 3x2 grid, and indexed by their xy coordinates. +-- Morphisms are named `hᵢⱼ` for a horizontal morphism starting at `(i,j)`, +-- and `vᵢⱼ` for a vertical morphism starting at `(i,j)`. +lemma paste_vert {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂} + (s : is_pushout h₁₁ v₁₁ v₁₂ h₂₁) (t : is_pushout h₂₁ v₂₁ v₂₂ h₃₁) : + is_pushout h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ := +(of_is_colimit + (big_square_is_pushout _ _ _ _ _ _ _ s.w t.w t.is_colimit s.is_colimit)) + +/-- Paste two pushout squares "horizontally" to obtain another pushout square. -/ +lemma paste_horiz {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃} + (s : is_pushout h₁₁ v₁₁ v₁₂ h₂₁) (t : is_pushout h₁₂ v₁₂ v₁₃ h₂₂) : + is_pushout (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) := +(paste_vert s.flip t.flip).flip + +/-- Given a pushout square assembled from a pushout square on the top and +a commuting square on the bottom, the bottom square is a pushout square. -/ +lemma of_bot {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂} + (s : is_pushout h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁) (p : h₂₁ ≫ v₂₂ = v₂₁ ≫ h₃₁) + (t : is_pushout h₁₁ v₁₁ v₁₂ h₂₁) : + is_pushout h₂₁ v₂₁ v₂₂ h₃₁ := +of_is_colimit (right_square_is_pushout _ _ _ _ _ _ _ _ p t.is_colimit s.is_colimit) + +/-- Given a pushout square assembled from a pushout square on the left and +a commuting square on the right, the right square is a pushout square. -/ +lemma of_right {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃} + (s : is_pushout (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂)) (p : h₁₂ ≫ v₁₃ = v₁₂ ≫ h₂₂) + (t : is_pushout h₁₁ v₁₁ v₁₂ h₂₁) : + is_pushout h₁₂ v₁₂ v₁₃ h₂₂ := +(of_bot s.flip p.symm t.flip).flip + +lemma paste_vert_iff {X₁₁ X₁₂ X₂₁ X₂₂ X₃₁ X₃₂ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₂₁ : X₂₁ ⟶ X₂₂} {h₃₁ : X₃₁ ⟶ X₃₂} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₂₁ : X₂₁ ⟶ X₃₁} {v₂₂ : X₂₂ ⟶ X₃₂} + (s : is_pushout h₁₁ v₁₁ v₁₂ h₂₁) (e : h₂₁ ≫ v₂₂ = v₂₁ ≫ h₃₁) : + is_pushout h₁₁ (v₁₁ ≫ v₂₁) (v₁₂ ≫ v₂₂) h₃₁ ↔ is_pushout h₂₁ v₂₁ v₂₂ h₃₁ := +⟨λ h, h.of_bot e s, s.paste_vert⟩ + +lemma paste_horiz_iff {X₁₁ X₁₂ X₁₃ X₂₁ X₂₂ X₂₃ : C} + {h₁₁ : X₁₁ ⟶ X₁₂} {h₁₂ : X₁₂ ⟶ X₁₃} {h₂₁ : X₂₁ ⟶ X₂₂} {h₂₂ : X₂₂ ⟶ X₂₃} + {v₁₁ : X₁₁ ⟶ X₂₁} {v₁₂ : X₁₂ ⟶ X₂₂} {v₁₃ : X₁₃ ⟶ X₂₃} + (s : is_pushout h₁₁ v₁₁ v₁₂ h₂₁) (e : h₁₂ ≫ v₁₃ = v₁₂ ≫ h₂₂) : + is_pushout (h₁₁ ≫ h₁₂) v₁₁ v₁₃ (h₂₁ ≫ h₂₂) ↔ is_pushout h₁₂ v₁₂ v₁₃ h₂₂ := +⟨λ h, h.of_right e s, s.paste_horiz⟩ + +section + +variables [has_zero_object C] [has_zero_morphisms C] +open_locale zero_object + +lemma of_is_bilimit {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) b.inl b.inr := +by convert is_pushout.of_is_coproduct' h.is_colimit has_zero_object.zero_is_initial + +@[simp] lemma of_has_biproduct (X Y : C) [has_binary_biproduct X Y] : + is_pushout (0 : 0 ⟶ X) (0 : 0 ⟶ Y) biprod.inl biprod.inr := +of_is_bilimit (binary_biproduct.is_bilimit X Y) + +lemma inl_snd' {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pushout b.inl (0 : X ⟶ 0) b.snd (0 : 0 ⟶ Y) := +by { apply flip, refine of_right _ (by simp) (of_is_bilimit h), simp, } + +/-- +The square +``` + X --inl--> X ⊞ Y + | | + 0 snd + | | + v v + 0 ---0-----> Y +``` +is a pushout square. +-/ +lemma inl_snd (X Y : C) [has_binary_biproduct X Y] : + is_pushout biprod.inl (0 : X ⟶ 0) biprod.snd (0 : 0 ⟶ Y) := +inl_snd' (binary_biproduct.is_bilimit X Y) + +lemma inr_fst' {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pushout b.inr (0 : Y ⟶ 0) b.fst (0 : 0 ⟶ X) := +by { refine of_bot _ (by simp) (of_is_bilimit h), simp, } + +/-- +The square +``` + Y --inr--> X ⊞ Y + | | + 0 fst + | | + v v + 0 ---0-----> X +``` +is a pushout square. +-/ +lemma inr_fst (X Y : C) [has_binary_biproduct X Y] : + is_pushout biprod.inr (0 : Y ⟶ 0) biprod.fst (0 : 0 ⟶ X) := +inr_fst' (binary_biproduct.is_bilimit X Y) + +lemma of_is_bilimit' {b : binary_bicone X Y} (h : b.is_bilimit) : + is_pushout b.fst b.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +by { refine is_pushout.of_right _ (by simp) (is_pushout.inl_snd' h), simp, } + +lemma of_has_binary_biproduct (X Y : C) [has_binary_biproduct X Y] : + is_pushout biprod.fst biprod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +of_is_bilimit' (binary_biproduct.is_bilimit X Y) + +instance has_pushout_biprod_fst_biprod_snd [has_binary_biproduct X Y] : + has_pushout (biprod.fst : _ ⟶ X) (biprod.snd : _ ⟶ Y) := +has_colimit.mk ⟨_, (of_has_binary_biproduct X Y).is_colimit⟩ + +/-- The pushout of `biprod.fst` and `biprod.snd` is the zero object. -/ +def pushout_biprod_fst_biprod_snd [has_binary_biproduct X Y] : + pushout (biprod.fst : _ ⟶ X) (biprod.snd : _ ⟶ Y) ≅ 0 := +colimit.iso_colimit_cocone ⟨_, (of_has_binary_biproduct X Y).is_colimit⟩ + +end + +lemma op (h : is_pushout f g inl inr) : is_pullback inr.op inl.op g.op f.op := +is_pullback.of_is_limit (is_limit.of_iso_limit + (limits.pushout_cocone.is_colimit_equiv_is_limit_op h.flip.cocone h.flip.is_colimit) + h.to_comm_sq.flip.cocone_op) + +lemma unop {Z X Y P : Cᵒᵖ} {f : Z ⟶ X} {g : Z ⟶ Y} {inl : X ⟶ P} {inr : Y ⟶ P} + (h : is_pushout f g inl inr) : is_pullback inr.unop inl.unop g.unop f.unop := +is_pullback.of_is_limit (is_limit.of_iso_limit + (limits.pushout_cocone.is_colimit_equiv_is_limit_unop h.flip.cocone h.flip.is_colimit) + h.to_comm_sq.flip.cocone_unop) + +lemma of_horiz_is_iso [is_iso f] [is_iso inr] (sq : comm_sq f g inl inr) : + is_pushout f g inl inr := of_is_colimit' sq +begin + refine pushout_cocone.is_colimit.mk _ (λ s, inv inr ≫ s.inr) (λ s, _) (by tidy) (by tidy), + simp only [← cancel_epi f, s.condition, sq.w_assoc, is_iso.hom_inv_id_assoc], +end + +lemma of_vert_is_iso [is_iso g] [is_iso inl] (sq : comm_sq f g inl inr) : + is_pushout f g inl inr := (of_horiz_is_iso sq.flip).flip + +end is_pushout + +section equalizer + +variables {X Y Z : C} {f f' : X ⟶ Y} {g g' : Y ⟶ Z} + +/-- If `f : X ⟶ Y`, `g g' : Y ⟶ Z` forms a pullback square, then `f` is the equalizer of +`g` and `g'`. -/ +noncomputable +def is_pullback.is_limit_fork (H : is_pullback f f g g') : + is_limit (fork.of_ι f H.w) := +begin + fapply fork.is_limit.mk, + { exact λ s, H.is_limit.lift (pullback_cone.mk s.ι s.ι s.condition) }, + { exact λ s, H.is_limit.fac _ walking_cospan.left }, + { intros s m e, apply pullback_cone.is_limit.hom_ext H.is_limit; refine e.trans _; + symmetry; exact H.is_limit.fac _ _ } +end + +/-- If `f f' : X ⟶ Y`, `g : Y ⟶ Z` forms a pushout square, then `g` is the coequalizer of +`f` and `f'`. -/ +noncomputable +def is_pushout.is_limit_fork (H : is_pushout f f' g g) : + is_colimit (cofork.of_π g H.w) := +begin + fapply cofork.is_colimit.mk, + { exact λ s, H.is_colimit.desc (pushout_cocone.mk s.π s.π s.condition) }, + { exact λ s, H.is_colimit.fac _ walking_span.left }, + { intros s m e, apply pushout_cocone.is_colimit.hom_ext H.is_colimit; refine e.trans _; + symmetry; exact H.is_colimit.fac _ _ } +end + +end equalizer + +namespace bicartesian_sq + +variables {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + +lemma of_is_pullback_is_pushout (p₁ : is_pullback f g h i) (p₂ : is_pushout f g h i) : + bicartesian_sq f g h i := +bicartesian_sq.mk p₁.to_comm_sq ⟨p₁.is_limit⟩ ⟨p₂.is_colimit⟩ + +lemma flip (p : bicartesian_sq f g h i) : bicartesian_sq g f i h := +of_is_pullback_is_pushout p.to_is_pullback.flip p.to_is_pushout.flip + +variables [has_zero_object C] [has_zero_morphisms C] +open_locale zero_object + +/-- +``` + X ⊞ Y --fst--> X + | | + snd 0 + | | + v v + Y -----0---> 0 +``` +is a bicartesian square. +-/ +lemma of_is_biproduct₁ {b : binary_bicone X Y} (h : b.is_bilimit) : + bicartesian_sq b.fst b.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +of_is_pullback_is_pushout (is_pullback.of_is_bilimit h) (is_pushout.of_is_bilimit' h) + +/-- +``` + 0 -----0---> X + | | + 0 inl + | | + v v + Y --inr--> X ⊞ Y +``` +is a bicartesian square. +-/ +lemma of_is_biproduct₂ {b : binary_bicone X Y} (h : b.is_bilimit) : + bicartesian_sq (0 : 0 ⟶ X) (0 : 0 ⟶ Y) b.inl b.inr := +of_is_pullback_is_pushout (is_pullback.of_is_bilimit' h) (is_pushout.of_is_bilimit h) + +/-- +``` + X ⊞ Y --fst--> X + | | + snd 0 + | | + v v + Y -----0---> 0 +``` +is a bicartesian square. +-/ +@[simp] lemma of_has_biproduct₁ [has_binary_biproduct X Y] : + bicartesian_sq biprod.fst biprod.snd (0 : X ⟶ 0) (0 : Y ⟶ 0) := +by convert of_is_biproduct₁ (binary_biproduct.is_bilimit X Y) + +/-- +``` + 0 -----0---> X + | | + 0 inl + | | + v v + Y --inr--> X ⊞ Y +``` +is a bicartesian square. +-/ +@[simp] lemma of_has_biproduct₂ [has_binary_biproduct X Y] : + bicartesian_sq (0 : 0 ⟶ X) (0 : 0 ⟶ Y) biprod.inl biprod.inr := +by convert of_is_biproduct₂ (binary_biproduct.is_bilimit X Y) + +end bicartesian_sq + +section functor + +variables {D : Type u₂} [category.{v₂} D] +variables (F : C ⥤ D) {W X Y Z : C} {f : W ⟶ X} {g : W ⟶ Y} {h : X ⟶ Z} {i : Y ⟶ Z} + +lemma functor.map_is_pullback [preserves_limit (cospan h i) F] (s : is_pullback f g h i) : + is_pullback (F.map f) (F.map g) (F.map h) (F.map i) := +-- This is made slightly awkward because `C` and `D` have different universes, +-- and so the relevant `walking_cospan` diagrams live in different universes too! +begin + refine is_pullback.of_is_limit' (F.map_comm_sq s.to_comm_sq) + (is_limit.equiv_of_nat_iso_of_iso (cospan_comp_iso F h i) _ _ (walking_cospan.ext _ _ _) + (is_limit_of_preserves F s.is_limit)), + { refl, }, + { dsimp, simp, }, + { dsimp, simp, }, +end + +lemma functor.map_is_pushout [preserves_colimit (span f g) F] (s : is_pushout f g h i) : + is_pushout (F.map f) (F.map g) (F.map h) (F.map i) := +begin + refine is_pushout.of_is_colimit' (F.map_comm_sq s.to_comm_sq) + (is_colimit.equiv_of_nat_iso_of_iso (span_comp_iso F f g) _ _ (walking_span.ext _ _ _) + (is_colimit_of_preserves F s.is_colimit)), + { refl, }, + { dsimp, simp, }, + { dsimp, simp, }, +end + +alias functor.map_is_pullback ← is_pullback.map +alias functor.map_is_pushout ← is_pushout.map + +lemma is_pullback.of_map [reflects_limit (cospan h i) F] (e : f ≫ h = g ≫ i) + (H : is_pullback (F.map f) (F.map g) (F.map h) (F.map i)) : is_pullback f g h i := +begin + refine ⟨⟨e⟩, ⟨is_limit_of_reflects F $ _⟩⟩, + refine (is_limit.equiv_of_nat_iso_of_iso (cospan_comp_iso F h i) _ _ + (walking_cospan.ext _ _ _)).symm H.is_limit, + exacts [iso.refl _, (category.comp_id _).trans (category.id_comp _).symm, + (category.comp_id _).trans (category.id_comp _).symm] +end + +lemma is_pullback.of_map_of_faithful [reflects_limit (cospan h i) F] [faithful F] + (H : is_pullback (F.map f) (F.map g) (F.map h) (F.map i)) : is_pullback f g h i := +H.of_map F (F.map_injective $ by simpa only [F.map_comp] using H.w) + +lemma is_pullback.map_iff {D : Type*} [category D] (F : C ⥤ D) + [preserves_limit (cospan h i) F] [reflects_limit (cospan h i) F] (e : f ≫ h = g ≫ i) : + is_pullback (F.map f) (F.map g) (F.map h) (F.map i) ↔ is_pullback f g h i := +⟨λ h, h.of_map F e, λ h, h.map F⟩ + +lemma is_pushout.of_map [reflects_colimit (span f g) F] (e : f ≫ h = g ≫ i) + (H : is_pushout (F.map f) (F.map g) (F.map h) (F.map i)) : is_pushout f g h i := +begin + refine ⟨⟨e⟩, ⟨is_colimit_of_reflects F $ _⟩⟩, + refine (is_colimit.equiv_of_nat_iso_of_iso (span_comp_iso F f g) _ _ + (walking_span.ext _ _ _)).symm H.is_colimit, + exacts [iso.refl _, (category.comp_id _).trans (category.id_comp _), + (category.comp_id _).trans (category.id_comp _)] +end + +lemma is_pushout.of_map_of_faithful [reflects_colimit (span f g) F] [faithful F] + (H : is_pushout (F.map f) (F.map g) (F.map h) (F.map i)) : is_pushout f g h i := +H.of_map F (F.map_injective $ by simpa only [F.map_comp] using H.w) + +lemma is_pushout.map_iff {D : Type*} [category D] (F : C ⥤ D) + [preserves_colimit (span f g) F] [reflects_colimit (span f g) F] (e : f ≫ h = g ≫ i) : + is_pushout (F.map f) (F.map g) (F.map h) (F.map i) ↔ is_pushout f g h i := +⟨λ h, h.of_map F e, λ h, h.map F⟩ + +end functor + +end category_theory diff --git a/src/category_theory/limits/shapes/concrete_category.lean b/src/category_theory/limits/shapes/concrete_category.lean deleted file mode 100644 index 9431a5aa1e86f..0000000000000 --- a/src/category_theory/limits/shapes/concrete_category.lean +++ /dev/null @@ -1,20 +0,0 @@ -/- -Copyright (c) 2017 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import category_theory.limits.shapes.kernels -import category_theory.concrete_category.basic -import category_theory.concrete_category.elementwise - -/-! -# Facts about limits of functors into concrete categories - -This file doesn't yet attempt to be exhaustive; -it just contains lemmas that are useful -while comparing categorical limits with existing constructions in concrete categories. --/ - -universes u - -open category_theory diff --git a/src/category_theory/limits/shapes/default.lean b/src/category_theory/limits/shapes/default.lean deleted file mode 100644 index ce39844b6f1e1..0000000000000 --- a/src/category_theory/limits/shapes/default.lean +++ /dev/null @@ -1,12 +0,0 @@ -import category_theory.limits.shapes.terminal -import category_theory.limits.shapes.binary_products -import category_theory.limits.shapes.products -import category_theory.limits.shapes.finite_products -import category_theory.limits.shapes.finite_limits -import category_theory.limits.shapes.biproducts -import category_theory.limits.shapes.images -import category_theory.limits.shapes.zero_morphisms -import category_theory.limits.shapes.kernels -import category_theory.limits.shapes.equalizers -import category_theory.limits.shapes.wide_pullbacks -import category_theory.limits.shapes.pullbacks diff --git a/src/category_theory/limits/shapes/diagonal.lean b/src/category_theory/limits/shapes/diagonal.lean new file mode 100644 index 0000000000000..012e76ec3148c --- /dev/null +++ b/src/category_theory/limits/shapes/diagonal.lean @@ -0,0 +1,372 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.limits.shapes.pullbacks +import category_theory.limits.shapes.kernel_pair +import category_theory.limits.shapes.comm_sq + +/-! +# The diagonal object of a morphism. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide various API and isomorphisms considering the diagonal object `Δ_{Y/X} := pullback f f` +of a morphism `f : X ⟶ Y`. + +-/ + +open category_theory + +noncomputable theory + +namespace category_theory.limits + +variables {C : Type*} [category C] {X Y Z : C} + +namespace pullback + +section diagonal + +variables (f : X ⟶ Y) [has_pullback f f] + +/-- The diagonal object of a morphism `f : X ⟶ Y` is `Δ_{X/Y} := pullback f f`. -/ +abbreviation diagonal_obj : C := pullback f f + +/-- The diagonal morphism `X ⟶ Δ_{X/Y}` for a morphism `f : X ⟶ Y`. -/ +def diagonal : X ⟶ diagonal_obj f := +pullback.lift (𝟙 _) (𝟙 _) rfl + +@[simp, reassoc] lemma diagonal_fst : diagonal f ≫ pullback.fst = 𝟙 _ := +pullback.lift_fst _ _ _ + +@[simp, reassoc] lemma diagonal_snd : diagonal f ≫ pullback.snd = 𝟙 _ := +pullback.lift_snd _ _ _ + +instance : is_split_mono (diagonal f) := +⟨⟨⟨pullback.fst, diagonal_fst f⟩⟩⟩ + +instance : is_split_epi (pullback.fst : pullback f f ⟶ X) := +⟨⟨⟨diagonal f, diagonal_fst f⟩⟩⟩ + +instance : is_split_epi (pullback.snd : pullback f f ⟶ X) := +⟨⟨⟨diagonal f, diagonal_snd f⟩⟩⟩ + +instance [mono f] : is_iso (diagonal f) := +begin + rw (is_iso.inv_eq_of_inv_hom_id (diagonal_fst f)).symm, + apply_instance +end + +/-- The two projections `Δ_{X/Y} ⟶ X` form a kernel pair for `f : X ⟶ Y`. -/ +lemma diagonal_is_kernel_pair : + is_kernel_pair f (pullback.fst : diagonal_obj f ⟶ _) pullback.snd := +is_pullback.of_has_pullback f f + +end diagonal + +end pullback + +variable [has_pullbacks C] + +open pullback + +section + +variables {U V₁ V₂ : C} (f : X ⟶ Y) (i : U ⟶ Y) +variables (i₁ : V₁ ⟶ pullback f i) (i₂ : V₂ ⟶ pullback f i) + +@[simp, reassoc] +lemma pullback_diagonal_map_snd_fst_fst : + (pullback.snd : pullback (diagonal f) (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i + (by simp [condition]) (by simp [condition])) ⟶ _) ≫ fst ≫ i₁ ≫ fst = pullback.fst := +begin + conv_rhs { rw ← category.comp_id pullback.fst }, + rw [← diagonal_fst f, pullback.condition_assoc, pullback.lift_fst] +end + +@[simp, reassoc] +lemma pullback_diagonal_map_snd_snd_fst : + (pullback.snd : pullback (diagonal f) (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i + (by simp [condition]) (by simp [condition])) ⟶ _) ≫ snd ≫ i₂ ≫ fst = pullback.fst := +begin + conv_rhs { rw ← category.comp_id pullback.fst }, + rw [← diagonal_snd f, pullback.condition_assoc, pullback.lift_snd] +end + +variable [has_pullback i₁ i₂] + +/-- +This iso witnesses the fact that +given `f : X ⟶ Y`, `i : U ⟶ Y`, and `i₁ : V₁ ⟶ X ×[Y] U`, `i₂ : V₂ ⟶ X ×[Y] U`, the diagram + +V₁ ×[X ×[Y] U] V₂ ⟶ V₁ ×[U] V₂ + | | + | | + ↓ ↓ + X ⟶ X ×[Y] X + +is a pullback square. +Also see `pullback_fst_map_snd_is_pullback`. +-/ +def pullback_diagonal_map_iso : + pullback (diagonal f) (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i + (by simp [condition]) (by simp [condition])) ≅ pullback i₁ i₂ := +{ hom := pullback.lift (pullback.snd ≫ pullback.fst) (pullback.snd ≫ pullback.snd) + begin + ext; simp only [category.assoc, pullback.condition, pullback_diagonal_map_snd_fst_fst, + pullback_diagonal_map_snd_snd_fst], + end, + inv := pullback.lift (pullback.fst ≫ i₁ ≫ pullback.fst) (pullback.map _ _ _ _ (𝟙 _) (𝟙 _) + pullback.snd (category.id_comp _).symm (category.id_comp _).symm) + begin + ext; simp only [diagonal_fst, diagonal_snd, category.comp_id, pullback.condition_assoc, + category.assoc, lift_fst, lift_fst_assoc, lift_snd, lift_snd_assoc], + end, + hom_inv_id' := by ext; simp only [category.id_comp, category.assoc, lift_fst_assoc, + pullback_diagonal_map_snd_fst_fst, lift_fst, lift_snd, category.comp_id], + inv_hom_id' := by ext; simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_iso_hom_fst : + (pullback_diagonal_map_iso f i i₁ i₂).hom ≫ pullback.fst = pullback.snd ≫ pullback.fst := +by { delta pullback_diagonal_map_iso, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_iso_hom_snd : + (pullback_diagonal_map_iso f i i₁ i₂).hom ≫ pullback.snd = pullback.snd ≫ pullback.snd := +by { delta pullback_diagonal_map_iso, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_iso_inv_fst : + (pullback_diagonal_map_iso f i i₁ i₂).inv ≫ pullback.fst = pullback.fst ≫ i₁ ≫ pullback.fst := +by { delta pullback_diagonal_map_iso, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_iso_inv_snd_fst : + (pullback_diagonal_map_iso f i i₁ i₂).inv ≫ pullback.snd ≫ pullback.fst = pullback.fst := +by { delta pullback_diagonal_map_iso, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_iso_inv_snd_snd : + (pullback_diagonal_map_iso f i i₁ i₂).inv ≫ pullback.snd ≫ pullback.snd = pullback.snd := +by { delta pullback_diagonal_map_iso, simp } + +lemma pullback_fst_map_snd_is_pullback : + is_pullback + (fst ≫ i₁ ≫ fst) + (map i₁ i₂ (i₁ ≫ snd) (i₂ ≫ snd) _ _ _ (category.id_comp _).symm (category.id_comp _).symm) + (diagonal f) + (map (i₁ ≫ snd) (i₂ ≫ snd) f f (i₁ ≫ fst) (i₂ ≫ fst) i + (by simp [condition]) (by simp [condition])) := +is_pullback.of_iso_pullback ⟨by ext; simp [condition_assoc]⟩ + (pullback_diagonal_map_iso f i i₁ i₂).symm (pullback_diagonal_map_iso_inv_fst f i i₁ i₂) + (by ext1; simp) + +end + +section + +variables {S T : C} (f : X ⟶ T) (g : Y ⟶ T) (i : T ⟶ S) +variables [has_pullback i i] [has_pullback f g] [has_pullback (f ≫ i) (g ≫ i)] +variable [has_pullback (diagonal i) (pullback.map (f ≫ i) (g ≫ i) i i f g (𝟙 _) + (category.comp_id _) (category.comp_id _))] + +/-- +This iso witnesses the fact that +given `f : X ⟶ T`, `g : Y ⟶ T`, and `i : T ⟶ S`, the diagram + +X ×ₜ Y ⟶ X ×ₛ Y + | | + | | + ↓ ↓ + T ⟶ T ×ₛ T + +is a pullback square. +Also see `pullback_map_diagonal_is_pullback`. +-/ +def pullback_diagonal_map_id_iso : + pullback (diagonal i) (pullback.map (f ≫ i) (g ≫ i) i i f g (𝟙 _) + (category.comp_id _) (category.comp_id _)) ≅ pullback f g := +begin + refine (as_iso $ pullback.map _ _ _ _ (𝟙 _) (pullback.congr_hom _ _).hom (𝟙 _) _ _) ≪≫ + pullback_diagonal_map_iso i (𝟙 _) (f ≫ inv pullback.fst) (g ≫ inv pullback.fst) ≪≫ + (as_iso $ pullback.map _ _ _ _ (𝟙 _) (𝟙 _) pullback.fst _ _), + { rw [← category.comp_id pullback.snd, ← condition, category.assoc, is_iso.inv_hom_id_assoc] }, + { rw [← category.comp_id pullback.snd, ← condition, category.assoc, is_iso.inv_hom_id_assoc] }, + { rw [category.comp_id, category.id_comp] }, + { ext; simp }, + { apply_instance }, + { rw [category.assoc, category.id_comp, is_iso.inv_hom_id, category.comp_id] }, + { rw [category.assoc, category.id_comp, is_iso.inv_hom_id, category.comp_id] }, + { apply_instance }, +end + +@[simp, reassoc] +lemma pullback_diagonal_map_id_iso_hom_fst : + (pullback_diagonal_map_id_iso f g i).hom ≫ pullback.fst = pullback.snd ≫ pullback.fst := +by { delta pullback_diagonal_map_id_iso, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_id_iso_hom_snd : + (pullback_diagonal_map_id_iso f g i).hom ≫ pullback.snd = pullback.snd ≫ pullback.snd := +by { delta pullback_diagonal_map_id_iso, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_id_iso_inv_fst : + (pullback_diagonal_map_id_iso f g i).inv ≫ pullback.fst = pullback.fst ≫ f := +begin + rw [iso.inv_comp_eq, ← category.comp_id pullback.fst, ← diagonal_fst i, pullback.condition_assoc], + simp, +end + +@[simp, reassoc] +lemma pullback_diagonal_map_id_iso_inv_snd_fst : + (pullback_diagonal_map_id_iso f g i).inv ≫ pullback.snd ≫ pullback.fst = pullback.fst := +by { rw iso.inv_comp_eq, simp } + +@[simp, reassoc] +lemma pullback_diagonal_map_id_iso_inv_snd_snd : + (pullback_diagonal_map_id_iso f g i).inv ≫ pullback.snd ≫ pullback.snd = pullback.snd := +by { rw iso.inv_comp_eq, simp } + +lemma pullback.diagonal_comp (f : X ⟶ Y) (g : Y ⟶ Z) [has_pullback f f] [has_pullback g g] + [has_pullback (f ≫ g) (f ≫ g)] : + diagonal (f ≫ g) = diagonal f ≫ (pullback_diagonal_map_id_iso f f g).inv ≫ pullback.snd := +by ext; simp + +lemma pullback_map_diagonal_is_pullback : is_pullback (pullback.fst ≫ f) + (pullback.map f g (f ≫ i) (g ≫ i) _ _ i (category.id_comp _).symm (category.id_comp _).symm) + (diagonal i) + (pullback.map (f ≫ i) (g ≫ i) i i f g (𝟙 _) (category.comp_id _) (category.comp_id _)) := +begin + apply is_pullback.of_iso_pullback _ (pullback_diagonal_map_id_iso f g i).symm, + { simp }, + { ext; simp }, + { constructor, ext; simp [condition] }, +end + +/-- The diagonal object of `X ×[Z] Y ⟶ X` is isomorphic to `Δ_{Y/Z} ×[Z] X`. -/ +def diagonal_obj_pullback_fst_iso {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : + diagonal_obj (pullback.fst : pullback f g ⟶ X) ≅ + pullback (pullback.snd ≫ g : diagonal_obj g ⟶ Z) f := +pullback_right_pullback_fst_iso _ _ _ ≪≫ pullback.congr_hom pullback.condition rfl ≪≫ + pullback_assoc _ _ _ _ ≪≫ pullback_symmetry _ _ ≪≫ pullback.congr_hom pullback.condition rfl + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_hom_fst_fst {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).hom ≫ pullback.fst ≫ pullback.fst = + pullback.fst ≫ pullback.snd := +by { delta diagonal_obj_pullback_fst_iso, simp } + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_hom_fst_snd {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).hom ≫ pullback.fst ≫ pullback.snd = + pullback.snd ≫ pullback.snd := +by { delta diagonal_obj_pullback_fst_iso, simp } + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_hom_snd {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).hom ≫ pullback.snd = pullback.fst ≫ pullback.fst := +by { delta diagonal_obj_pullback_fst_iso, simp } + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_fst_fst {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.fst ≫ pullback.fst = + pullback.snd := +by { delta diagonal_obj_pullback_fst_iso, simp } + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_fst_snd {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.fst ≫ pullback.snd = + pullback.fst ≫ pullback.fst := +by { delta diagonal_obj_pullback_fst_iso, simp } + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_snd_fst {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.snd ≫ pullback.fst = pullback.snd := +by { delta diagonal_obj_pullback_fst_iso, simp } + +@[simp, reassoc] lemma diagonal_obj_pullback_fst_iso_inv_snd_snd {X Y Z : C} (f : X ⟶ Z) + (g : Y ⟶ Z) : + (diagonal_obj_pullback_fst_iso f g).inv ≫ pullback.snd ≫ pullback.snd = + pullback.fst ≫ pullback.snd := +by { delta diagonal_obj_pullback_fst_iso, simp } + +lemma diagonal_pullback_fst {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : + diagonal (pullback.fst : pullback f g ⟶ _) = + (pullback_symmetry _ _).hom ≫ ((base_change f).map + (over.hom_mk (diagonal g) (by simp) : over.mk g ⟶ over.mk (pullback.snd ≫ g))).left ≫ + (diagonal_obj_pullback_fst_iso f g).inv := +by ext; simp + +end + +/-- +Given the following diagram with `S ⟶ S'` a monomorphism, + + X ⟶ X' + ↘ ↘ + S ⟶ S' + ↗ ↗ + Y ⟶ Y' + +This iso witnesses the fact that + + X ×[S] Y ⟶ (X' ×[S'] Y') ×[Y'] Y + | | + | | + ↓ ↓ +(X' ×[S'] Y') ×[X'] X ⟶ X' ×[S'] Y' + +is a pullback square. The diagonal map of this square is `pullback.map`. +Also see `pullback_lift_map_is_pullback`. +-/ +@[simps] +def pullback_fst_fst_iso {X Y S X' Y' S' : C} (f : X ⟶ S) (g : Y ⟶ S) (f' : X' ⟶ S') + (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f') + (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] : + pullback (pullback.fst : pullback (pullback.fst : pullback f' g' ⟶ _) i₁ ⟶ _) + (pullback.fst : pullback (pullback.snd : pullback f' g' ⟶ _) i₂ ⟶ _) ≅ pullback f g := +{ hom := pullback.lift (pullback.fst ≫ pullback.snd) (pullback.snd ≫ pullback.snd) + begin + rw [← cancel_mono i₃, category.assoc, category.assoc, category.assoc, category.assoc, e₁, e₂, + ← pullback.condition_assoc, pullback.condition_assoc, pullback.condition, + pullback.condition_assoc] + end, + inv := pullback.lift + (pullback.lift (pullback.map _ _ _ _ _ _ _ e₁ e₂) pullback.fst (pullback.lift_fst _ _ _)) + (pullback.lift (pullback.map _ _ _ _ _ _ _ e₁ e₂) pullback.snd (pullback.lift_snd _ _ _)) + begin + rw [pullback.lift_fst, pullback.lift_fst] + end, + hom_inv_id' := by ext; simp only [category.assoc, category.id_comp, lift_fst, lift_snd, + lift_fst_assoc, lift_snd_assoc, condition, ← condition_assoc], + inv_hom_id' := by ext; simp only [category.assoc, category.id_comp, lift_fst, lift_snd, + lift_fst_assoc, lift_snd_assoc], } + +lemma pullback_map_eq_pullback_fst_fst_iso_inv {X Y S X' Y' S' : C} (f : X ⟶ S) (g : Y ⟶ S) + (f' : X' ⟶ S') + (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f') + (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] : + pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂ = + (pullback_fst_fst_iso f g f' g' i₁ i₂ i₃ e₁ e₂).inv ≫ pullback.snd ≫ pullback.fst := +begin + ext; simp only [category.assoc, category.id_comp, lift_fst, lift_snd, lift_fst_assoc, + lift_snd_assoc, pullback_fst_fst_iso_inv, ← pullback.condition, ← pullback.condition_assoc], +end + +lemma pullback_lift_map_is_pullback {X Y S X' Y' S' : C} (f : X ⟶ S) (g : Y ⟶ S) (f' : X' ⟶ S') + (g' : Y' ⟶ S') (i₁ : X ⟶ X') (i₂ : Y ⟶ Y') (i₃ : S ⟶ S') (e₁ : f ≫ i₃ = i₁ ≫ f') + (e₂ : g ≫ i₃ = i₂ ≫ g') [mono i₃] : + is_pullback + (pullback.lift (pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂) fst (lift_fst _ _ _)) + (pullback.lift (pullback.map f g f' g' i₁ i₂ i₃ e₁ e₂) snd (lift_snd _ _ _)) + pullback.fst pullback.fst := +is_pullback.of_iso_pullback ⟨by rw [lift_fst, lift_fst]⟩ + (pullback_fst_fst_iso f g f' g' i₁ i₂ i₃ e₁ e₂).symm (by simp) (by simp) + + +end category_theory.limits diff --git a/src/category_theory/limits/shapes/disjoint_coproduct.lean b/src/category_theory/limits/shapes/disjoint_coproduct.lean index 55c611509640f..7e7ab8b99c895 100644 --- a/src/category_theory/limits/shapes/disjoint_coproduct.lean +++ b/src/category_theory/limits/shapes/disjoint_coproduct.lean @@ -9,6 +9,9 @@ import category_theory.limits.shapes.pullbacks /-! # Disjoint coproducts +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines disjoint coproducts: coproducts where the intersection is initial and the coprojections are monic. Shows that a category with disjoint coproducts is `initial_mono_class`. @@ -125,8 +128,9 @@ lemma initial_mono_class_of_disjoint_coproducts [coproducts_disjoint C] : initia { is_initial_mono_from := λ I X hI, coproduct_disjoint.mono_inl _ _ (𝟙 X) { desc := λ (s : binary_cofan _ _), s.inr, - fac' := λ s j, walking_pair.cases_on j (hI.hom_ext _ _) (id_comp _), - uniq' := λ (s : binary_cofan _ _) m w, (id_comp _).symm.trans (w walking_pair.right) } } + fac' := λ s j, discrete.cases_on j + (λ j, walking_pair.cases_on j (hI.hom_ext _ _) (id_comp _)), + uniq' := λ (s : binary_cofan _ _) m w, (id_comp _).symm.trans (w ⟨walking_pair.right⟩) } } end limits end category_theory diff --git a/src/category_theory/limits/shapes/equalizers.lean b/src/category_theory/limits/shapes/equalizers.lean index 85859db0360d1..f72c575d0371d 100644 --- a/src/category_theory/limits/shapes/equalizers.lean +++ b/src/category_theory/limits/shapes/equalizers.lean @@ -9,6 +9,9 @@ import category_theory.limits.has_limits /-! # Equalizers and coequalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines (co)equalizers as special cases of (co)limits. An equalizer is the categorical generalization of the subobject {a ∈ A | f(a) = g(a)} known @@ -51,20 +54,20 @@ namespace category_theory.limits local attribute [tidy] tactic.case_bash -universes v u u₂ +universes v v₂ u u₂ /-- The type of objects for the diagram indexing a (co)equalizer. -/ -@[derive decidable_eq, derive inhabited] inductive walking_parallel_pair : Type v +@[derive decidable_eq, derive inhabited] inductive walking_parallel_pair : Type | zero | one open walking_parallel_pair /-- The type family of morphisms for the diagram indexing a (co)equalizer. -/ @[derive decidable_eq] inductive walking_parallel_pair_hom : - walking_parallel_pair → walking_parallel_pair → Type v + walking_parallel_pair → walking_parallel_pair → Type | left : walking_parallel_pair_hom zero one | right : walking_parallel_pair_hom zero one -| id : Π X : walking_parallel_pair.{v}, walking_parallel_pair_hom X X +| id : Π X : walking_parallel_pair, walking_parallel_pair_hom X X /-- Satisfying the inhabited linter -/ instance : inhabited (walking_parallel_pair_hom zero one) := @@ -96,7 +99,7 @@ rfl The functor `walking_parallel_pair ⥤ walking_parallel_pairᵒᵖ` sending left to left and right to right. -/ -def walking_parallel_pair_op : walking_parallel_pair.{u} ⥤ walking_parallel_pair.{u₂}ᵒᵖ := +def walking_parallel_pair_op : walking_parallel_pair ⥤ walking_parallel_pairᵒᵖ := { obj := (λ x, op $ by { cases x, exacts [one, zero] }), map := λ i j f, by { cases f; apply quiver.hom.op, exacts [left, right, walking_parallel_pair_hom.id _] }, @@ -116,7 +119,7 @@ The equivalence `walking_parallel_pair ⥤ walking_parallel_pairᵒᵖ` sending right. -/ @[simps functor inverse] -def walking_parallel_pair_op_equiv : walking_parallel_pair.{u} ≌ walking_parallel_pair.{u₂}ᵒᵖ := +def walking_parallel_pair_op_equiv : walking_parallel_pair ≌ walking_parallel_pairᵒᵖ := { functor := walking_parallel_pair_op, inverse := walking_parallel_pair_op.left_op, unit_iso := nat_iso.of_components (λ j, eq_to_iso (by { cases j; refl })) @@ -128,20 +131,20 @@ def walking_parallel_pair_op_equiv : walking_parallel_pair.{u} ≌ walking_paral rcases i with (_|_); rcases j with (_|_); rcases g with (_|_|_); refl }) } @[simp] lemma walking_parallel_pair_op_equiv_unit_iso_zero : - walking_parallel_pair_op_equiv.{u u₂}.unit_iso.app zero = iso.refl zero := rfl + walking_parallel_pair_op_equiv.unit_iso.app zero = iso.refl zero := rfl @[simp] lemma walking_parallel_pair_op_equiv_unit_iso_one : - walking_parallel_pair_op_equiv.{u u₂}.unit_iso.app one = iso.refl one := rfl + walking_parallel_pair_op_equiv.unit_iso.app one = iso.refl one := rfl @[simp] lemma walking_parallel_pair_op_equiv_counit_iso_zero : - walking_parallel_pair_op_equiv.{u u₂}.counit_iso.app (op zero) = iso.refl (op zero) := rfl + walking_parallel_pair_op_equiv.counit_iso.app (op zero) = iso.refl (op zero) := rfl @[simp] lemma walking_parallel_pair_op_equiv_counit_iso_one : - walking_parallel_pair_op_equiv.{u u₂}.counit_iso.app (op one) = iso.refl (op one) := rfl + walking_parallel_pair_op_equiv.counit_iso.app (op one) = iso.refl (op one) := rfl variables {C : Type u} [category.{v} C] variables {X Y : C} /-- `parallel_pair f g` is the diagram in `C` consisting of the two morphisms `f` and `g` with common domain and codomain. -/ -def parallel_pair (f g : X ⟶ Y) : walking_parallel_pair.{v} ⥤ C := +def parallel_pair (f g : X ⟶ Y) : walking_parallel_pair ⥤ C := { obj := λ x, match x with | zero := X | one := Y @@ -198,7 +201,7 @@ def parallel_pair_hom {X' Y' : C} (f g : X ⟶ Y) (f' g' : X' ⟶ Y') (p : X ⟶ /-- Construct a natural isomorphism between functors out of the walking parallel pair from its components. -/ @[simps] -def parallel_pair.ext {F G : walking_parallel_pair.{v} ⥤ C} +def parallel_pair.ext {F G : walking_parallel_pair ⥤ C} (zero : F.obj zero ≅ G.obj zero) (one : F.obj one ≅ G.obj one) (left : F.map left ≫ one.hom = zero.hom ≫ G.map left) (right : F.map right ≫ one.hom = zero.hom ≫ G.map right) : F ≅ G := @@ -206,6 +209,13 @@ nat_iso.of_components (by { rintro ⟨j⟩, exacts [zero, one] }) (by { rintro ⟨j₁⟩ ⟨j₂⟩ ⟨f⟩; simp [left, right], }) +/-- Construct a natural isomorphism between `parallel_pair f g` and `parallel_pair f' g'` given +equalities `f = f'` and `g = g'`. -/ +@[simps] +def parallel_pair.eq_of_hom_eq {f g f' g' : X ⟶ Y} (hf : f = f') (hg : g = g') : + parallel_pair f g ≅ parallel_pair f' g' := +parallel_pair.ext (iso.refl _) (iso.refl _) (by simp [hf]) (by simp [hg]) + /-- A fork on `f` and `g` is just a `cone (parallel_pair f g)`. -/ abbreviation fork (f g : X ⟶ Y) := cone (parallel_pair f g) @@ -300,11 +310,11 @@ lemma cofork.is_colimit.hom_ext {s : cofork f g} (hs : is_colimit s) {W : C} {k (h : cofork.π s ≫ k = cofork.π s ≫ l) : k = l := hs.hom_ext $ cofork.coequalizer_ext _ h -@[simp, reassoc] lemma fork.is_limit.lift_comp_ι {s t : fork f g} (hs : is_limit s) : +@[simp, reassoc] lemma fork.is_limit.lift_ι {s t : fork f g} (hs : is_limit s) : hs.lift t ≫ s.ι = t.ι := hs.fac _ _ -@[simp, reassoc] lemma cofork.is_colimit.π_comp_desc {s t : cofork f g} (hs : is_colimit s) : +@[simp, reassoc] lemma cofork.is_colimit.π_desc {s t : cofork f g} (hs : is_colimit s) : s.π ≫ hs.desc t = t.π := hs.fac _ _ @@ -486,6 +496,12 @@ def cofork.of_cocone @[simp] lemma cofork.of_cocone_ι {F : walking_parallel_pair ⥤ C} (t : cocone F) (j) : (cofork.of_cocone t).ι.app j = eq_to_hom (by tidy) ≫ t.ι.app j := rfl +@[simp] lemma fork.ι_postcompose {f' g' : X ⟶ Y} {α : parallel_pair f g ⟶ parallel_pair f' g'} + {c : fork f g} : fork.ι ((cones.postcompose α).obj c) = c.ι ≫ α.app _ := rfl + +@[simp] lemma cofork.π_precompose {f' g' : X ⟶ Y} {α : parallel_pair f g ⟶ parallel_pair f' g'} + {c : cofork f' g'} : cofork.π ((cocones.precompose α).obj c) = α.app _ ≫ c.π := rfl + /-- Helper function for constructing morphisms between equalizer forks. -/ @@ -509,6 +525,10 @@ def fork.ext {s t : fork f g} (i : s.X ≅ t.X) (w : i.hom ≫ t.ι = s.ι) : s { hom := fork.mk_hom i.hom w, inv := fork.mk_hom i.inv (by rw [← w, iso.inv_hom_id_assoc]) } +/-- Every fork is isomorphic to one of the form `fork.of_ι _ _`. -/ +def fork.iso_fork_of_ι (c : fork f g) : c ≅ fork.of_ι c.ι c.condition := +fork.ext (by simp only [fork.of_ι_X, functor.const_obj_obj]) (by simp) + /-- Helper function for constructing morphisms between coequalizer coforks. -/ @@ -538,6 +558,10 @@ def cofork.ext {s t : cofork f g} (i : s.X ≅ t.X) (w : s.π ≫ i.hom = t.π) { hom := cofork.mk_hom i.hom w, inv := cofork.mk_hom i.inv (by rw [iso.comp_inv_eq, w]) } +/-- Every cofork is isomorphic to one of the form `cofork.of_π _ _`. -/ +def cofork.iso_cofork_of_π (c : cofork f g) : c ≅ cofork.of_π c.π c.condition := +cofork.ext (by simp only [cofork.of_π_X, functor.const_obj_obj]) (by dsimp; simp) + variables (f g) section @@ -730,6 +754,13 @@ lemma coequalizer.π_desc {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) : coequalizer.π f g ≫ coequalizer.desc k h = k := colimit.ι_desc _ _ +lemma coequalizer.π_colim_map_desc {X' Y' Z : C} (f' g' : X' ⟶ Y') [has_coequalizer f' g'] + (p : X ⟶ X') (q : Y ⟶ Y') (wf : f ≫ q = p ≫ f') (wg : g ≫ q = p ≫ g') + (h : Y' ⟶ Z) (wh : f' ≫ h = g' ≫ h) : + coequalizer.π f g ≫ colim_map (parallel_pair_hom f g f' g' p q wf wg) ≫ coequalizer.desc h wh = + q ≫ h := +by rw [ι_colim_map_assoc, parallel_pair_hom_app_one, coequalizer.π_desc] + /-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = g ≫ k` induces a morphism `l : coequalizer f g ⟶ W` satisfying `coequalizer.π ≫ g = l`. -/ def coequalizer.desc' {W : C} (k : Y ⟶ W) (h : f ≫ k = g ≫ k) : @@ -827,7 +858,7 @@ rfl section comparison -variables {D : Type u₂} [category.{v} D] (G : C ⥤ D) +variables {D : Type u₂} [category.{v₂} D] (G : C ⥤ D) /-- The comparison morphism for the equalizer of `f,g`. @@ -872,10 +903,10 @@ end comparison variables (C) /-- `has_equalizers` represents a choice of equalizer for every pair of morphisms -/ -abbreviation has_equalizers := has_limits_of_shape walking_parallel_pair.{v} C +abbreviation has_equalizers := has_limits_of_shape walking_parallel_pair C /-- `has_coequalizers` represents a choice of coequalizer for every pair of morphisms -/ -abbreviation has_coequalizers := has_colimits_of_shape walking_parallel_pair.{v} C +abbreviation has_coequalizers := has_colimits_of_shape walking_parallel_pair C /-- If `C` has all limits of diagrams `parallel_pair f g`, then it has all equalizers -/ lemma has_equalizers_of_has_limit_parallel_pair @@ -890,22 +921,23 @@ lemma has_coequalizers_of_has_colimit_parallel_pair section -- In this section we show that a split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`. -variables {C} [split_mono f] +variables {C} [is_split_mono f] /-- A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`. -Here we build the cone, and show in `split_mono_equalizes` that it is a limit cone. +Here we build the cone, and show in `is_split_mono_equalizes` that it is a limit cone. -/ @[simps {rhs_md := semireducible}] -def cone_of_split_mono : fork (𝟙 Y) (retraction f ≫ f) := +def cone_of_is_split_mono : fork (𝟙 Y) (retraction f ≫ f) := fork.of_ι f (by simp) -@[simp] lemma cone_of_split_mono_ι : (cone_of_split_mono f).ι = f := rfl +@[simp] lemma cone_of_is_split_mono_ι : (cone_of_is_split_mono f).ι = f := rfl /-- A split mono `f` equalizes `(retraction f ≫ f)` and `(𝟙 Y)`. -/ -def split_mono_equalizes {X Y : C} (f : X ⟶ Y) [split_mono f] : is_limit (cone_of_split_mono f) := +def is_split_mono_equalizes {X Y : C} (f : X ⟶ Y) [is_split_mono f] : + is_limit (cone_of_is_split_mono f) := fork.is_limit.mk' _ $ λ s, ⟨s.ι ≫ retraction f, by { dsimp, rw [category.assoc, ←s.condition], apply category.comp_id }, @@ -913,7 +945,7 @@ fork.is_limit.mk' _ $ λ s, end -/-- We show that the converse to `split_mono_equalizes` is true: +/-- We show that the converse to `is_split_mono_equalizes` is true: Whenever `f` equalizes `(r ≫ f)` and `(𝟙 Y)`, then `r` is a retraction of `f`. -/ def split_mono_of_equalizer {X Y : C} {f : X ⟶ Y} {r : Y ⟶ X} (hr : f ≫ r ≫ f = f) (h : is_limit (fork.of_ι f (hr.trans (category.comp_id _).symm : f ≫ r ≫ f = f ≫ 𝟙 Y))) : @@ -947,7 +979,7 @@ def split_mono_of_idempotent_of_is_limit_fork {X : C} {f : X ⟶ X} (hf : f ≫ id' := begin letI := mono_of_is_limit_fork i, - rw [←cancel_mono_id c.ι, category.assoc, fork.is_limit.lift_comp_ι, fork.ι_of_ι, ←c.condition], + rw [←cancel_mono_id c.ι, category.assoc, fork.is_limit.lift_ι, fork.ι_of_ι, ←c.condition], exact category.comp_id c.ι end } @@ -958,23 +990,23 @@ split_mono_of_idempotent_of_is_limit_fork _ hf (limit.is_limit _) section -- In this section we show that a split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`. -variables {C} [split_epi f] +variables {C} [is_split_epi f] /-- A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`. -Here we build the cocone, and show in `split_epi_coequalizes` that it is a colimit cocone. +Here we build the cocone, and show in `is_split_epi_coequalizes` that it is a colimit cocone. -/ @[simps {rhs_md := semireducible}] -def cocone_of_split_epi : cofork (𝟙 X) (f ≫ section_ f) := +def cocone_of_is_split_epi : cofork (𝟙 X) (f ≫ section_ f) := cofork.of_π f (by simp) -@[simp] lemma cocone_of_split_epi_π : (cocone_of_split_epi f).π = f := rfl +@[simp] lemma cocone_of_is_split_epi_π : (cocone_of_is_split_epi f).π = f := rfl /-- A split epi `f` coequalizes `(f ≫ section_ f)` and `(𝟙 X)`. -/ -def split_epi_coequalizes {X Y : C} (f : X ⟶ Y) [split_epi f] : - is_colimit (cocone_of_split_epi f) := +def is_split_epi_coequalizes {X Y : C} (f : X ⟶ Y) [is_split_epi f] : + is_colimit (cocone_of_is_split_epi f) := cofork.is_colimit.mk' _ $ λ s, ⟨section_ f ≫ s.π, by { dsimp, rw [← category.assoc, ← s.condition, category.id_comp] }, @@ -982,7 +1014,7 @@ cofork.is_colimit.mk' _ $ λ s, end -/-- We show that the converse to `split_epi_equalizes` is true: +/-- We show that the converse to `is_split_epi_equalizes` is true: Whenever `f` coequalizes `(f ≫ s)` and `(𝟙 X)`, then `s` is a section of `f`. -/ def split_epi_of_coequalizer {X Y : C} {f : X ⟶ Y} {s : Y ⟶ X} (hs : f ≫ s ≫ f = f) (h : is_colimit (cofork.of_π f ((category.assoc _ _ _).trans $ @@ -1018,7 +1050,7 @@ def split_epi_of_idempotent_of_is_colimit_cofork {X : C} {f : X ⟶ X} (hf : f id' := begin letI := epi_of_is_colimit_cofork i, - rw [← cancel_epi_id c.π, ← category.assoc, cofork.is_colimit.π_comp_desc, + rw [← cancel_epi_id c.π, ← category.assoc, cofork.is_colimit.π_desc, cofork.π_of_π, ← c.condition], exact category.id_comp _, end } diff --git a/src/category_theory/limits/shapes/equivalence.lean b/src/category_theory/limits/shapes/equivalence.lean new file mode 100644 index 0000000000000..9f38875f671d1 --- /dev/null +++ b/src/category_theory/limits/shapes/equivalence.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.adjunction.limits +import category_theory.limits.shapes.terminal + +/-! +# Transporting existence of specific limits across equivalences + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For now, we only treat the case of initial and terminal objects, but other special shapes can be +added in the future. +-/ + +open category_theory category_theory.limits + +namespace category_theory +universes v₁ v₂ u₁ u₂ +variables {C : Type u₁} [category.{v₁} C] {D : Type u₂} [category.{v₂} D] + +lemma has_initial_of_equivalence (e : D ⥤ C) [is_equivalence e] [has_initial C] : has_initial D := +adjunction.has_colimits_of_shape_of_equivalence e + +lemma equivalence.has_initial_iff (e : C ≌ D) : has_initial C ↔ has_initial D := +⟨λ h, by exactI has_initial_of_equivalence e.inverse, + λ h, by exactI has_initial_of_equivalence e.functor⟩ + +lemma has_terminal_of_equivalence (e : D ⥤ C) [is_equivalence e] [has_terminal C] : + has_terminal D := +adjunction.has_limits_of_shape_of_equivalence e + +lemma equivalence.has_terminal_iff (e : C ≌ D) : has_terminal C ↔ has_terminal D := +⟨λ h, by exactI has_terminal_of_equivalence e.inverse, + λ h, by exactI has_terminal_of_equivalence e.functor⟩ + +end category_theory diff --git a/src/category_theory/limits/shapes/finite_limits.lean b/src/category_theory/limits/shapes/finite_limits.lean index c19576c8cf5f0..c3664f088370a 100644 --- a/src/category_theory/limits/shapes/finite_limits.lean +++ b/src/category_theory/limits/shapes/finite_limits.lean @@ -8,15 +8,20 @@ import category_theory.limits.shapes.binary_products import category_theory.limits.shapes.equalizers import category_theory.limits.shapes.wide_pullbacks import category_theory.limits.shapes.pullbacks -import data.fintype.basic +import data.fintype.option /-! # Categories with finite limits. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A typeclass for categories with all finite (co)limits. -/ -universes v' u' v u +universes w' w v' u' v u + +noncomputable theory open category_theory @@ -25,20 +30,24 @@ namespace category_theory.limits variables (C : Type u) [category.{v} C] /-- -A category has all finite limits if every functor `J ⥤ C` with a `fin_category J` instance -has a limit. +A category has all finite limits if every functor `J ⥤ C` with a `fin_category J` +instance and `J : Type` has a limit. This is often called 'finitely complete'. -/ -- We can't just made this an `abbreviation` -- because of https://github.com/leanprover-community/lean/issues/429 class has_finite_limits : Prop := -(out (J : Type v) [𝒥 : small_category J] [@fin_category J 𝒥] : @has_limits_of_shape J 𝒥 C _) +(out (J : Type) [𝒥 : small_category J] [@fin_category J 𝒥] : @has_limits_of_shape J 𝒥 C _) @[priority 100] instance has_limits_of_shape_of_has_finite_limits - (J : Type v) [small_category J] [fin_category J] [has_finite_limits C] : - has_limits_of_shape J C := has_finite_limits.out J + (J : Type w) [small_category J] [fin_category J] [has_finite_limits C] : + has_limits_of_shape J C := +begin + apply has_limits_of_shape_of_equivalence (fin_category.equiv_as_type J), + apply has_finite_limits.out +end @[priority 100] instance has_finite_limits_of_has_limits_of_size [has_limits_of_size.{v' u'} C] : @@ -48,21 +57,41 @@ instance has_finite_limits_of_has_limits_of_size [has_limits_of_size.{v' u'} C] /-- If `C` has all limits, it has finite limits. -/ @[priority 100] -instance has_finite_limits_of_has_limits [has_limits C] : has_finite_limits C := infer_instance +instance has_finite_limits_of_has_limits [has_limits C] : has_finite_limits C := +infer_instance + +/-- We can always derive `has_finite_limits C` by providing limits at an +arbitrary universe. -/ +lemma has_finite_limits_of_has_finite_limits_of_size + (h : ∀ (J : Type w) {𝒥 : small_category J} (hJ : @fin_category J 𝒥), + by { resetI, exact has_limits_of_shape J C }) : + has_finite_limits C := +⟨λ J hJ hhJ, + begin + resetI, + letI : category.{w w} (ulift_hom.{w} (ulift.{w 0} J)), + { apply ulift_hom.category.{0}, exact category_theory.ulift_category J }, + haveI := h (ulift_hom.{w} (ulift.{w} J)) category_theory.fin_category_ulift, + exact has_limits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{w w} J).symm + end ⟩ /-- -A category has all finite colimits if every functor `J ⥤ C` with a `fin_category J` instance -has a colimit. +A category has all finite colimits if every functor `J ⥤ C` with a `fin_category J` +instance and `J : Type` has a colimit. This is often called 'finitely cocomplete'. -/ class has_finite_colimits : Prop := -(out (J : Type v) [𝒥 : small_category J] [@fin_category J 𝒥] : @has_colimits_of_shape J 𝒥 C _) +(out (J : Type) [𝒥 : small_category J] [@fin_category J 𝒥] : @has_colimits_of_shape J 𝒥 C _) @[priority 100] -instance has_limits_of_shape_of_has_finite_colimits - (J : Type v) [small_category J] [fin_category J] [has_finite_colimits C] : - has_colimits_of_shape J C := has_finite_colimits.out J +instance has_colimits_of_shape_of_has_finite_colimits + (J : Type w) [small_category J] [fin_category J] [has_finite_colimits C] : + has_colimits_of_shape J C := +begin + apply has_colimits_of_shape_of_equivalence (fin_category.equiv_as_type J), + apply has_finite_colimits.out +end @[priority 100] instance has_finite_colimits_of_has_colimits_of_size [has_colimits_of_size.{v' u'} C] : @@ -70,11 +99,20 @@ instance has_finite_colimits_of_has_colimits_of_size [has_colimits_of_size.{v' u ⟨λ J hJ hJ', by { haveI := has_colimits_of_size_shrink.{0 0} C, exact has_colimits_of_shape_of_equivalence (fin_category.equiv_as_type J) }⟩ -/-- If `C` has all colimits, it has finite colimits. -/ -@[priority 100] -instance has_finite_colimits_of_has_colimits [has_colimits C] : has_finite_colimits C := -infer_instance - +/-- We can always derive `has_finite_colimits C` by providing colimits at an +arbitrary universe. -/ +lemma has_finite_colimits_of_has_finite_colimits_of_size + (h : ∀ (J : Type w) {𝒥 : small_category J} (hJ : @fin_category J 𝒥), + by { resetI, exact has_colimits_of_shape J C }) : + has_finite_colimits C := +⟨λ J hJ hhJ, + begin + resetI, + letI : category.{w w} (ulift_hom.{w} (ulift.{w 0} J)), + { apply ulift_hom.category.{0}, exact category_theory.ulift_category J }, + haveI := h (ulift_hom.{w} (ulift.{w} J)) category_theory.fin_category_ulift, + exact has_colimits_of_shape_of_equivalence (ulift_hom_ulift_category.equiv.{w w} J).symm + end ⟩ section open walking_parallel_pair walking_parallel_pair_hom @@ -112,8 +150,7 @@ namespace wide_pullback_shape instance fintype_obj [fintype J] : fintype (wide_pullback_shape J) := by { rw wide_pullback_shape, apply_instance } -instance fintype_hom [decidable_eq J] (j j' : wide_pullback_shape J) : - fintype (j ⟶ j') := +instance fintype_hom (j j' : wide_pullback_shape J) : fintype (j ⟶ j') := { elems := begin cases j', @@ -134,8 +171,7 @@ namespace wide_pushout_shape instance fintype_obj [fintype J] : fintype (wide_pushout_shape J) := by { rw wide_pushout_shape, apply_instance } -instance fintype_hom [decidable_eq J] (j j' : wide_pushout_shape J) : - fintype (j ⟶ j') := +instance fintype_hom (j j' : wide_pushout_shape J) : fintype (j ⟶ j') := { elems := begin cases j, @@ -151,11 +187,10 @@ instance fintype_hom [decidable_eq J] (j j' : wide_pushout_shape J) : end wide_pushout_shape -instance fin_category_wide_pullback [decidable_eq J] [fintype J] : - fin_category (wide_pullback_shape J) := +instance fin_category_wide_pullback [fintype J] : fin_category (wide_pullback_shape J) := { fintype_hom := wide_pullback_shape.fintype_hom } -instance fin_category_wide_pushout [decidable_eq J] [fintype J] : +instance fin_category_wide_pushout [fintype J] : fin_category (wide_pushout_shape J) := { fintype_hom := wide_pushout_shape.fintype_hom } @@ -166,24 +201,24 @@ for every finite collection of morphisms -- We can't just made this an `abbreviation` -- because of https://github.com/leanprover-community/lean/issues/429 class has_finite_wide_pullbacks : Prop := -(out (J : Type v) [decidable_eq J] [fintype J] : has_limits_of_shape (wide_pullback_shape J) C) +(out (J : Type) [fintype J] : has_limits_of_shape (wide_pullback_shape J) C) instance has_limits_of_shape_wide_pullback_shape - (J : Type v) [fintype J] [has_finite_wide_pullbacks C] : + (J : Type) [finite J] [has_finite_wide_pullbacks C] : has_limits_of_shape (wide_pullback_shape J) C := -by { haveI := @has_finite_wide_pullbacks.out C _ _ J (classical.dec_eq _), apply_instance } +by { casesI nonempty_fintype J, haveI := @has_finite_wide_pullbacks.out C _ _ J, apply_instance } /-- `has_finite_wide_pushouts` represents a choice of wide pushout for every finite collection of morphisms -/ class has_finite_wide_pushouts : Prop := -(out (J : Type v) [decidable_eq J] [fintype J] : has_colimits_of_shape (wide_pushout_shape J) C) +(out (J : Type) [fintype J] : has_colimits_of_shape (wide_pushout_shape J) C) instance has_colimits_of_shape_wide_pushout_shape - (J : Type v) [fintype J] [has_finite_wide_pushouts C] : + (J : Type) [finite J] [has_finite_wide_pushouts C] : has_colimits_of_shape (wide_pushout_shape J) C := -by { haveI := @has_finite_wide_pushouts.out C _ _ J (classical.dec_eq _), apply_instance } +by { casesI nonempty_fintype J, haveI := @has_finite_wide_pushouts.out C _ _ J, apply_instance } /-- Finite wide pullbacks are finite limits, so if `C` has all finite limits, @@ -191,7 +226,7 @@ it also has finite wide pullbacks -/ lemma has_finite_wide_pullbacks_of_has_finite_limits [has_finite_limits C] : has_finite_wide_pullbacks C := -⟨λ J _ _, by exactI has_finite_limits.out _⟩ +⟨λ J _, by exactI has_finite_limits.out _⟩ /-- Finite wide pushouts are finite colimits, so if `C` has all finite colimits, @@ -199,7 +234,7 @@ it also has finite wide pushouts -/ lemma has_finite_wide_pushouts_of_has_finite_limits [has_finite_colimits C] : has_finite_wide_pushouts C := -⟨λ J _ _, by exactI has_finite_colimits.out _⟩ +⟨λ J _, by exactI has_finite_colimits.out _⟩ instance fintype_walking_pair : fintype walking_pair := { elems := {walking_pair.left, walking_pair.right}, diff --git a/src/category_theory/limits/shapes/finite_products.lean b/src/category_theory/limits/shapes/finite_products.lean index 1aff9db2e6872..701fbf5e74511 100644 --- a/src/category_theory/limits/shapes/finite_products.lean +++ b/src/category_theory/limits/shapes/finite_products.lean @@ -3,49 +3,50 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import category_theory.limits.shapes.binary_products import category_theory.limits.shapes.finite_limits import category_theory.limits.shapes.products -import category_theory.limits.shapes.terminal /-! # Categories with finite (co)products +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Typeclasses representing categories with (co)products over finite indexing types. -/ universes w v u open category_theory +open_locale classical + namespace category_theory.limits variables (C : Type u) [category.{v} C] /-- A category has finite products if there is a chosen limit for every diagram -with shape `discrete J`, where we have `[decidable_eq J]` and `[fintype J]`. +with shape `discrete J`, where we have `[finite J]`. + +We require this condition only for `J = fin n` in the definition, then deduce a version for any +`J : Type*` as a corollary of this definition. -/ --- We can't simply make this an abbreviation, as we do with other `has_Xs` limits typeclasses, --- because of https://github.com/leanprover-community/lean/issues/429 class has_finite_products : Prop := -(out (J : Type v) [decidable_eq J] [fintype J] : has_limits_of_shape (discrete J) C) - -instance has_limits_of_shape_discrete - (J : Type v) [fintype J] [has_finite_products C] : - has_limits_of_shape (discrete J) C := -by { haveI := @has_finite_products.out C _ _ J (classical.dec_eq _), apply_instance } +(out [] (n : ℕ) : has_limits_of_shape (discrete (fin n)) C) /-- If `C` has finite limits then it has finite products. -/ @[priority 10] -instance has_finite_products_of_has_finite_limits [has_finite_limits C] : has_finite_products C := -⟨λ J 𝒥₁ 𝒥₂, by { resetI, apply_instance }⟩ +instance has_finite_products_of_has_finite_limits [has_finite_limits C] : + has_finite_products C := +⟨λ n, infer_instance⟩ -instance has_fintype_products [has_finite_products C] (ι : Type w) [fintype ι] : +instance has_limits_of_shape_discrete [has_finite_products C] (ι : Type w) [finite ι] : has_limits_of_shape (discrete ι) C := -has_limits_of_shape_of_equivalence - (discrete.equivalence - ((show ulift.{v} (fin (fintype.card ι)) ≃ fin (fintype.card ι), by tidy).trans - (fintype.equiv_fin ι).symm)) +begin + rcases finite.exists_equiv_fin ι with ⟨n, ⟨e⟩⟩, + haveI := has_finite_products.out C n, + exact has_limits_of_shape_of_equivalence (discrete.equivalence e.symm) +end /-- We can now write this for powers. -/ noncomputable example [has_finite_products C] (X : C) : C := ∏ (λ (i : fin 5), X) @@ -53,40 +54,39 @@ noncomputable example [has_finite_products C] (X : C) : C := ∏ (λ (i : fin 5) /-- If a category has all products then in particular it has finite products. -/ -lemma has_finite_products_of_has_products [has_products C] : has_finite_products C := -⟨by apply_instance⟩ +lemma has_finite_products_of_has_products [has_products.{w} C] : has_finite_products C := +⟨λ n, has_limits_of_shape_of_equivalence (discrete.equivalence equiv.ulift.{w})⟩ /-- A category has finite coproducts if there is a chosen colimit for every diagram -with shape `discrete J`, where we have `[decidable_eq J]` and `[fintype J]`. +with shape `discrete J`, where we have `[fintype J]`. + +We require this condition only for `J = fin n` in the definition, then deduce a version for any +`J : Type*` as a corollary of this definition. -/ class has_finite_coproducts : Prop := -(out (J : Type v) [decidable_eq J] [fintype J] : has_colimits_of_shape (discrete J) C) +(out [] (n : ℕ) : has_colimits_of_shape (discrete (fin n)) C) attribute [class] has_finite_coproducts -instance has_colimits_of_shape_discrete - (J : Type v) [fintype J] [has_finite_coproducts C] : - has_colimits_of_shape (discrete J) C := -by { haveI := @has_finite_coproducts.out C _ _ J (classical.dec_eq _), apply_instance } +instance has_colimits_of_shape_discrete [has_finite_coproducts C] (ι : Type w) [finite ι] : + has_colimits_of_shape (discrete ι) C := +begin + rcases finite.exists_equiv_fin ι with ⟨n, ⟨e⟩⟩, + haveI := has_finite_coproducts.out C n, + exact has_colimits_of_shape_of_equivalence (discrete.equivalence e.symm) +end /-- If `C` has finite colimits then it has finite coproducts. -/ @[priority 10] instance has_finite_coproducts_of_has_finite_colimits [has_finite_colimits C] : has_finite_coproducts C := -⟨λ J 𝒥₁ 𝒥₂, by { resetI, apply_instance }⟩ - -instance has_fintype_coproducts [has_finite_coproducts C] (ι : Type w) [fintype ι] : - has_colimits_of_shape (discrete ι) C := -has_colimits_of_shape_of_equivalence - (discrete.equivalence - ((show ulift.{v} (fin (fintype.card ι)) ≃ fin (fintype.card ι), by tidy).trans - (fintype.equiv_fin ι).symm)) +⟨λ J, by apply_instance⟩ /-- If a category has all coproducts then in particular it has finite coproducts. -/ -lemma has_finite_coproducts_of_has_coproducts [has_coproducts C] : has_finite_coproducts C := -⟨by apply_instance⟩ +lemma has_finite_coproducts_of_has_coproducts [has_coproducts.{w} C] : has_finite_coproducts C := +⟨λ J, has_colimits_of_shape_of_equivalence (discrete.equivalence (equiv.ulift.{w}))⟩ end category_theory.limits diff --git a/src/category_theory/limits/shapes/functor_category.lean b/src/category_theory/limits/shapes/functor_category.lean index 0b056b578ea5f..e2d84559f7d9e 100644 --- a/src/category_theory/limits/shapes/functor_category.lean +++ b/src/category_theory/limits/shapes/functor_category.lean @@ -9,6 +9,9 @@ import category_theory.limits.functor_category /-! # If `D` has finite (co)limits, so do the functor categories `C ⥤ D`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + These are boiler-plate instances, in their own file as neither import otherwise needs the other. -/ @@ -16,12 +19,11 @@ open category_theory namespace category_theory.limits -universes z w v u -variables {C : Type (max v u)} [category.{v} C] -variables {D : Type w} [category.{max z v u} D] +universes v₁ v₂ u₁ u₂ w +variables {C : Type u₁} [category.{v₁} C] +variables {D : Type u₂} [category.{v₂} D] -instance functor_category_has_finite_limits [has_finite_limits D] : - has_finite_limits (C ⥤ D) := +instance functor_category_has_finite_limits [has_finite_limits D] : has_finite_limits (C ⥤ D) := { out := λ J _ _, by exactI infer_instance, } instance functor_category_has_finite_colimits [has_finite_colimits D] : diff --git a/src/category_theory/limits/shapes/images.lean b/src/category_theory/limits/shapes/images.lean index 7bac8641b479b..f470cbf709277 100644 --- a/src/category_theory/limits/shapes/images.lean +++ b/src/category_theory/limits/shapes/images.lean @@ -10,6 +10,9 @@ import category_theory.limits.shapes.strong_epi /-! # Categorical images +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the categorical image of `f` as a factorisation `f = e ≫ m` through a monomorphism `m`, so that `m` factors through the `m'` in any other such factorisation. @@ -247,6 +250,10 @@ lemma has_image.of_arrow_iso {f g : arrow C} [h : has_image f.hom] (sq : f ⟶ g has_image g.hom := ⟨⟨h.exists_image.some.of_arrow_iso sq⟩⟩ +@[priority 100] +instance mono_has_image (f : X ⟶ Y) [mono f] : has_image f := +has_image.mk ⟨_, is_image.self f⟩ + section variable [has_image f] @@ -285,6 +292,10 @@ lemma image.lift_fac (F' : mono_factorisation f) : image.lift F' ≫ F'.m = imag @[simp, reassoc] lemma image.fac_lift (F' : mono_factorisation f) : factor_thru_image f ≫ image.lift F' = F'.e := (image.is_image f).fac_lift F' +@[simp] +lemma image.is_image_lift (F : mono_factorisation f) : + (image.is_image f).lift F = image.lift F := +rfl @[simp, reassoc] lemma is_image.lift_ι {F : mono_factorisation f} (hF : is_image F) : @@ -327,7 +338,7 @@ attribute [instance, priority 100] has_images.has_image end section -variables (f) [has_image f] +variables (f) /-- The image of a monomorphism is isomorphic to the source. -/ def image_mono_iso_source [mono f] : image f ≅ X := is_image.iso_ext (image.is_image f) (is_image.self f) @@ -346,7 +357,7 @@ end -- from https://en.wikipedia.org/wiki/Image_%28category_theory%29, which is in turn taken from: -- Mitchell, Barry (1965), Theory of categories, MR 0202787, p.12, Proposition 10.1 @[ext] -lemma image.ext {W : C} {g h : image f ⟶ W} [has_limit (parallel_pair g h)] +lemma image.ext [has_image f] {W : C} {g h : image f ⟶ W} [has_limit (parallel_pair g h)] (w : factor_thru_image f ≫ g = factor_thru_image f ≫ h) : g = h := begin @@ -371,7 +382,7 @@ begin ... = h : by rw [category.id_comp] end -instance [Π {Z : C} (g h : image f ⟶ Z), has_limit (parallel_pair g h)] : +instance [has_image f] [Π {Z : C} (g h : image f ⟶ Z), has_limit (parallel_pair g h)] : epi (factor_thru_image f) := ⟨λ Z g h w, image.ext f w⟩ @@ -698,8 +709,8 @@ instance strong_epi_mono_factorisation_inhabited {X Y : C} (f : X ⟶ Y) [strong property of the image. -/ def strong_epi_mono_factorisation.to_mono_is_image {X Y : C} {f : X ⟶ Y} (F : strong_epi_mono_factorisation f) : is_image F.to_mono_factorisation := -{ lift := λ G, arrow.lift $ arrow.hom_mk' $ - show G.e ≫ G.m = F.e ≫ F.m, by rw [F.to_mono_factorisation.fac, G.fac] } +{ lift := λ G, (comm_sq.mk (show G.e ≫ G.m = F.e ≫ F.m, + by rw [F.to_mono_factorisation.fac, G.fac])).lift, } variable (C) @@ -768,26 +779,28 @@ variables [has_images C] instance has_image_maps_of_has_strong_epi_images [has_strong_epi_images C] : has_image_maps C := { has_image_map := λ f g st, has_image_map.mk - { map := arrow.lift $ arrow.hom_mk' $ show (st.left ≫ factor_thru_image g.hom) ≫ image.ι g.hom = - factor_thru_image f.hom ≫ (image.ι f.hom ≫ st.right), by simp } } + { map := (comm_sq.mk (show (st.left ≫ factor_thru_image g.hom) ≫ image.ι g.hom = + factor_thru_image f.hom ≫ (image.ι f.hom ≫ st.right), by simp)).lift, }, } /-- If a category has images, equalizers and pullbacks, then images are automatically strong epi images. -/ @[priority 100] instance has_strong_epi_images_of_has_pullbacks_of_has_equalizers [has_pullbacks C] [has_equalizers C] : has_strong_epi_images C := -{ strong_factor_thru_image := λ X Y f, - { epi := by apply_instance, - has_lift := λ A B x y h h_mono w, arrow.has_lift.mk - { lift := image.lift - { I := pullback h y, - m := pullback.snd ≫ image.ι f, - m_mono := by exactI mono_comp _ _, - e := pullback.lift _ _ w } ≫ pullback.fst } } } +{ strong_factor_thru_image := λ X Y f, strong_epi.mk' + (λ A B h h_mono x y sq, comm_sq.has_lift.mk' + { l := image.lift + { I := pullback h y, + m := pullback.snd ≫ image.ι f, + m_mono := by exactI mono_comp _ _, + e := pullback.lift _ _ sq.w } ≫ pullback.fst, + fac_left' := by simp only [image.fac_lift_assoc, pullback.lift_fst], + fac_right' := by { ext, simp only [sq.w, category.assoc, + image.fac_lift_assoc, pullback.lift_fst_assoc], }, }) } end has_strong_epi_images -variables [has_strong_epi_mono_factorisations.{v} C] +variables [has_strong_epi_mono_factorisations C] variables {X Y : C} {f : X ⟶ Y} /-- @@ -814,3 +827,28 @@ lemma image.iso_strong_epi_mono_inv_comp_mono {I' : C} (e : X ⟶ I') (m : I' image.lift_fac _ end category_theory.limits + +namespace category_theory.functor + +open category_theory.limits + +variables {C D : Type*} [category C] [category D] + +lemma has_strong_epi_mono_factorisations_imp_of_is_equivalence (F : C ⥤ D) [is_equivalence F] + [h : has_strong_epi_mono_factorisations C] : + has_strong_epi_mono_factorisations D := +⟨λ X Y f, begin + let em : strong_epi_mono_factorisation (F.inv.map f) := + (has_strong_epi_mono_factorisations.has_fac (F.inv.map f)).some, + haveI : mono (F.map em.m ≫ F.as_equivalence.counit_iso.hom.app Y) := mono_comp _ _, + haveI : strong_epi (F.as_equivalence.counit_iso.inv.app X ≫ F.map em.e) := strong_epi_comp _ _, + exact nonempty.intro + { I := F.obj em.I, + e := F.as_equivalence.counit_iso.inv.app X ≫ F.map em.e, + m := F.map em.m ≫ F.as_equivalence.counit_iso.hom.app Y, + fac' := by simpa only [category.assoc, ← F.map_comp_assoc, em.fac', + is_equivalence.fun_inv_map, iso.inv_hom_id_app, iso.inv_hom_id_app_assoc] + using category.comp_id _, }, +end⟩ + +end category_theory.functor diff --git a/src/category_theory/limits/shapes/kernel_pair.lean b/src/category_theory/limits/shapes/kernel_pair.lean index 222a172f72cca..aea26e543051c 100644 --- a/src/category_theory/limits/shapes/kernel_pair.lean +++ b/src/category_theory/limits/shapes/kernel_pair.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ import category_theory.limits.shapes.equalizers -import category_theory.limits.shapes.pullbacks +import category_theory.limits.shapes.comm_sq import category_theory.limits.shapes.regular_mono /-! # Kernel pairs +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines what it means for a parallel pair of morphisms `a b : R ⟶ X` to be the kernel pair for a morphism `f`. Some properties of kernel pairs are given, namely allowing one to transfer between @@ -47,13 +50,9 @@ and the square ↓ ↓ X → Y is a pullback square. -This is essentially just a convenience wrapper over `is_limit (pullback_cone.mk _ _ _)`. +This is just an abbreviation for `is_pullback a b f f`. -/ -structure is_kernel_pair := -(comm : a ≫ f = b ≫ f) -(is_limit : is_limit (pullback_cone.mk _ _ comm)) - -attribute [reassoc] is_kernel_pair.comm +abbreviation is_kernel_pair := is_pullback a b f f namespace is_kernel_pair @@ -62,8 +61,8 @@ instance : subsingleton (is_kernel_pair f a b) := ⟨λ P Q, by { cases P, cases Q, congr, }⟩ /-- If `f` is a monomorphism, then `(𝟙 _, 𝟙 _)` is a kernel pair for `f`. -/ -def id_of_mono [mono f] : is_kernel_pair f (𝟙 _) (𝟙 _) := -⟨rfl, pullback_cone.is_limit_mk_id_id _⟩ +lemma id_of_mono [mono f] : is_kernel_pair f (𝟙 _) (𝟙 _) := +⟨⟨rfl⟩, ⟨pullback_cone.is_limit_mk_id_id _⟩⟩ instance [mono f] : inhabited (is_kernel_pair f (𝟙 _) (𝟙 _)) := ⟨id_of_mono f⟩ @@ -73,6 +72,7 @@ variables {f a b} Given a pair of morphisms `p`, `q` to `X` which factor through `f`, they factor through any kernel pair of `f`. -/ +noncomputable def lift' {S : C} (k : is_kernel_pair f a b) (p q : S ⟶ X) (w : p ≫ f = q ≫ f) : { t : S ⟶ R // t ≫ a = p ∧ t ≫ b = q } := pullback_cone.is_limit.lift' k.is_limit _ _ w @@ -83,11 +83,11 @@ just `f₁`. That is, to show that `(a,b)` is a kernel pair for `f₁` it suffices to only show the square commutes, rather than to additionally show it's a pullback. -/ -def cancel_right {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} (comm : a ≫ f₁ = b ≫ f₁) +lemma cancel_right {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} (comm : a ≫ f₁ = b ≫ f₁) (big_k : is_kernel_pair (f₁ ≫ f₂) a b) : is_kernel_pair f₁ a b := -{ comm := comm, - is_limit := pullback_cone.is_limit_aux' _ $ λ s, +{ w := comm, + is_limit' := ⟨pullback_cone.is_limit_aux' _ $ λ s, begin let s' : pullback_cone (f₁ ≫ f₂) (f₁ ≫ f₂) := pullback_cone.mk s.fst s.snd (s.condition_assoc _), @@ -99,26 +99,26 @@ def cancel_right {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} (comm : a ≫ f₁ = b ≫ f refine ((pullback_cone.mk a b _) : pullback_cone (f₁ ≫ f₂) _).equalizer_ext _ _, apply m₁.trans (big_k.is_limit.fac s' walking_cospan.left).symm, apply m₂.trans (big_k.is_limit.fac s' walking_cospan.right).symm, - end } + end⟩ } /-- If `(a,b)` is a kernel pair for `f₁ ≫ f₂` and `f₂` is mono, then `(a,b)` is a kernel pair for just `f₁`. The converse of `comp_of_mono`. -/ -def cancel_right_of_mono {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] +lemma cancel_right_of_mono {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] (big_k : is_kernel_pair (f₁ ≫ f₂) a b) : is_kernel_pair f₁ a b := -cancel_right (begin rw [← cancel_mono f₂, assoc, assoc, big_k.comm] end) big_k +cancel_right (begin rw [← cancel_mono f₂, assoc, assoc, big_k.w] end) big_k /-- If `(a,b)` is a kernel pair for `f₁` and `f₂` is mono, then `(a,b)` is a kernel pair for `f₁ ≫ f₂`. The converse of `cancel_right_of_mono`. -/ -def comp_of_mono {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] (small_k : is_kernel_pair f₁ a b) : +lemma comp_of_mono {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] (small_k : is_kernel_pair f₁ a b) : is_kernel_pair (f₁ ≫ f₂) a b := -{ comm := by rw [small_k.comm_assoc], - is_limit := pullback_cone.is_limit_aux' _ $ λ s, +{ w := by rw [small_k.w_assoc], + is_limit' := ⟨pullback_cone.is_limit_aux' _ $ λ s, begin refine ⟨_, _, _, _⟩, apply (pullback_cone.is_limit.lift' small_k.is_limit s.fst s.snd _).1, @@ -128,16 +128,16 @@ def comp_of_mono {f₁ : X ⟶ Y} {f₂ : Y ⟶ Z} [mono f₂] (small_k : is_ker intros m m₁ m₂, apply small_k.is_limit.hom_ext, refine ((pullback_cone.mk a b _) : pullback_cone f₁ _).equalizer_ext _ _, - rwa (pullback_cone.is_limit.lift' small_k.is_limit s.fst s.snd _).2.1, - rwa (pullback_cone.is_limit.lift' small_k.is_limit s.fst s.snd _).2.2, - end } + { exact m₁.trans (pullback_cone.is_limit.lift' small_k.is_limit s.fst s.snd _).2.1.symm }, + { exact m₂.trans (pullback_cone.is_limit.lift' small_k.is_limit s.fst s.snd _).2.2.symm }, + end⟩ } /-- If `(a,b)` is the kernel pair of `f`, and `f` is a coequalizer morphism for some parallel pair, then `f` is a coequalizer morphism of `a` and `b`. -/ def to_coequalizer (k : is_kernel_pair f a b) [r : regular_epi f] : - is_colimit (cofork.of_π f k.comm) := + is_colimit (cofork.of_π f k.w) := begin let t := k.is_limit.lift (pullback_cone.mk _ _ r.w), have ht : t ≫ a = r.left := k.is_limit.fac _ walking_cospan.left, @@ -160,5 +160,72 @@ begin apply w } end +/-- If `a₁ a₂ : A ⟶ Y` is a kernel pair for `g : Y ⟶ Z`, then `a₁ ×[Z] X` and `a₂ ×[Z] X` +(`A ×[Z] X ⟶ Y ×[Z] X`) is a kernel pair for `Y ×[Z] X ⟶ X`. -/ +protected +lemma pullback {X Y Z A : C} {g : Y ⟶ Z} {a₁ a₂ : A ⟶ Y} + (h : is_kernel_pair g a₁ a₂) (f : X ⟶ Z) [has_pullback f g] [has_pullback f (a₁ ≫ g)] : + is_kernel_pair (pullback.fst : pullback f g ⟶ X) + (pullback.map f _ f _ (𝟙 X) a₁ (𝟙 Z) (by simp) $ category.comp_id _) + (pullback.map _ _ _ _ (𝟙 X) a₂ (𝟙 Z) (by simp) $ (category.comp_id _).trans h.1.1) := +begin + refine ⟨⟨_⟩, ⟨_⟩⟩, + { rw [pullback.lift_fst, pullback.lift_fst] }, + { fapply pullback_cone.is_limit_aux', + intro s, + refine ⟨pullback.lift (s.fst ≫ pullback.fst) + (h.lift' (s.fst ≫ pullback.snd) (s.snd ≫ pullback.snd) _).1 _, _, _, _⟩, + { simp_rw [category.assoc, ← pullback.condition, ← category.assoc, s.condition] }, + { rw [← category.assoc, (h.lift' _ _ _).2.1, category.assoc, + category.assoc, pullback.condition] }, + { rw limits.pullback_cone.mk_fst, + ext; simp only [category.assoc, pullback.lift_fst, pullback.lift_snd, pullback.lift_snd_assoc, + category.comp_id, (h.lift' _ _ _).2.1] }, + { rw limits.pullback_cone.mk_snd, + ext; simp only [category.assoc, pullback.lift_fst, pullback.lift_snd, pullback.lift_snd_assoc, + category.comp_id, (h.lift' _ _ _).2.2, s.condition] }, + { intros m h₁ h₂, + ext, + { rw pullback.lift_fst, + conv_rhs { rw [← h₁, category.assoc, pullback_cone.mk_fst] }, + congr' 1, + refine ((pullback.lift_fst _ _ _).trans $ category.comp_id _).symm }, + { rw pullback.lift_snd, + apply pullback_cone.is_limit.hom_ext h.is_limit; + dsimp only [is_pullback.cone, comm_sq.cone]; + simp only [pullback_cone.mk_fst, pullback_cone.mk_snd, category.assoc, + (h.lift' _ _ _).2.1, (h.lift' _ _ _).2.2], + { conv_rhs { rw [← h₁, category.assoc, pullback_cone.mk_fst, pullback.lift_snd] } }, + { conv_rhs { rw [← h₂, category.assoc, pullback_cone.mk_snd, pullback.lift_snd] } } } } } +end + +lemma mono_of_is_iso_fst (h : is_kernel_pair f a b) [is_iso a] : + mono f := +begin + obtain ⟨l, h₁, h₂⟩ := limits.pullback_cone.is_limit.lift' h.is_limit (𝟙 _) (𝟙 _) (by simp [h.w]), + rw [is_pullback.cone_fst, ← is_iso.eq_comp_inv, category.id_comp] at h₁, + rw [h₁, is_iso.inv_comp_eq, category.comp_id] at h₂, + constructor, + intros Z g₁ g₂ e, + obtain ⟨l', rfl, rfl⟩ := limits.pullback_cone.is_limit.lift' h.is_limit _ _ e, + rw [is_pullback.cone_fst, h₂], +end + +lemma is_iso_of_mono (h : is_kernel_pair f a b) [mono f] : + is_iso a := +begin + rw ← show _ = a, from (category.comp_id _).symm.trans ((is_kernel_pair.id_of_mono f) + .is_limit.cone_point_unique_up_to_iso_inv_comp h.is_limit walking_cospan.left), + apply_instance, +end + +lemma of_is_iso_of_mono [is_iso a] [mono f] : is_kernel_pair f a a := +begin + delta is_kernel_pair, + convert_to is_pullback a (a ≫ 𝟙 X) (𝟙 X ≫ f) f, + { rw category.comp_id }, { rw category.id_comp }, + exact (is_pullback.of_horiz_is_iso ⟨rfl⟩).paste_vert (is_kernel_pair.id_of_mono f) +end + end is_kernel_pair end category_theory diff --git a/src/category_theory/limits/shapes/kernels.lean b/src/category_theory/limits/shapes/kernels.lean index 3a244f923f03c..862a36f2f68cf 100644 --- a/src/category_theory/limits/shapes/kernels.lean +++ b/src/category_theory/limits/shapes/kernels.lean @@ -8,6 +8,9 @@ import category_theory.limits.preserves.shapes.zero /-! # Kernels and cokernels +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In a category with zero morphisms, the kernel of a morphism `f : X ⟶ Y` is the equalizer of `f` and `0 : X ⟶ Y`. (Similarly the cokernel is the coequalizer.) @@ -47,7 +50,7 @@ general limits can be used. noncomputable theory -universes v u u' u₂ +universes v v₂ u u' u₂ open category_theory open category_theory.limits.walking_parallel_pair @@ -128,7 +131,7 @@ def is_limit_aux (t : kernel_fork f) This is a more convenient formulation to show that a `kernel_fork` constructed using `kernel_fork.of_ι` is a limit cone. -/ -def is_limit.of_ι {W : C} (g : W ⟶ X) (eq : g ≫ f = 0) +def kernel_fork.is_limit.of_ι {W : C} (g : W ⟶ X) (eq : g ≫ f = 0) (lift : Π {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), W' ⟶ W) (fac : ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), lift g' eq' ≫ g = g') (uniq : @@ -150,6 +153,14 @@ lemma is_kernel_comp_mono_lift {c : kernel_fork f} (i : is_limit c) {Z} (g : Y (is_kernel_comp_mono i g hh).lift s = i.lift (fork.of_ι s.ι (by { rw [←cancel_mono g, category.assoc, ←hh], simp })) := rfl +/-- Every kernel of `f ≫ g` is also a kernel of `f`, as long as `c.ι ≫ f` vanishes. -/ +def is_kernel_of_comp {W : C} (g : Y ⟶ W) (h : X ⟶ W) {c : kernel_fork h} (i : is_limit c) + (hf : c.ι ≫ f = 0) (hfg : f ≫ g = h) : is_limit (kernel_fork.of_ι c.ι hf) := +fork.is_limit.mk _ + (λ s, i.lift (kernel_fork.of_ι s.ι (by simp [← hfg]))) + (λ s, by simp only [kernel_fork.ι_of_ι, fork.is_limit.lift_ι]) + (λ s m h, by { apply fork.is_limit.hom_ext i, simpa using h }) + end section @@ -174,11 +185,11 @@ is_limit.of_iso_limit (limit.is_limit _) (fork.ext (iso.refl _) (by tidy)) /-- Given any morphism `k : W ⟶ X` satisfying `k ≫ f = 0`, `k` factors through `kernel.ι f` via `kernel.lift : W ⟶ kernel f`. -/ abbreviation kernel.lift {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f := -limit.lift (parallel_pair f 0) (kernel_fork.of_ι k h) +(kernel_is_kernel f).lift (kernel_fork.of_ι k h) @[simp, reassoc] lemma kernel.lift_ι {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : kernel.lift f k h ≫ kernel.ι f = k := -limit.lift_π _ _ +(kernel_is_kernel f).fac (kernel_fork.of_ι k h) walking_parallel_pair.zero @[simp] lemma kernel.lift_zero {W : C} {h} : kernel.lift f (0 : W ⟶ X) h = 0 := @@ -457,7 +468,7 @@ def is_colimit_aux (t : cokernel_cofork f) This is a more convenient formulation to show that a `cokernel_cofork` constructed using `cokernel_cofork.of_π` is a limit cone. -/ -def is_colimit.of_π {Z : C} (g : Y ⟶ Z) (eq : f ≫ g = 0) +def cokernel_cofork.is_colimit.of_π {Z : C} (g : Y ⟶ Z) (eq : f ≫ g = 0) (desc : Π {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), Z ⟶ Z') (fac : ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), g ≫ desc g' eq' = g') (uniq : @@ -482,6 +493,14 @@ lemma is_cokernel_epi_comp_desc {c : cokernel_cofork f} (i : is_colimit c) {W} (is_cokernel_epi_comp i g hh).desc s = i.desc (cofork.of_π s.π (by { rw [←cancel_epi g, ←category.assoc, ←hh], simp })) := rfl +/-- Every cokernel of `g ≫ f` is also a cokernel of `f`, as long as `f ≫ c.π` vanishes. -/ +def is_cokernel_of_comp {W : C} (g : W ⟶ X) (h : W ⟶ Y) {c : cokernel_cofork h} (i : is_colimit c) + (hf : f ≫ c.π = 0) (hfg : g ≫ f = h) : is_colimit (cokernel_cofork.of_π c.π hf) := +cofork.is_colimit.mk _ + (λ s, i.desc (cokernel_cofork.of_π s.π (by simp [← hfg]))) + (λ s, by simp only [cokernel_cofork.π_of_π, cofork.is_colimit.π_desc]) + (λ s m h, by { apply cofork.is_colimit.hom_ext i, simpa using h }) + end section @@ -506,12 +525,12 @@ is_colimit.of_iso_colimit (colimit.is_colimit _) (cofork.ext (iso.refl _) (by ti /-- Given any morphism `k : Y ⟶ W` such that `f ≫ k = 0`, `k` factors through `cokernel.π f` via `cokernel.desc : cokernel f ⟶ W`. -/ abbreviation cokernel.desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel f ⟶ W := -colimit.desc (parallel_pair f 0) (cokernel_cofork.of_π k h) +(cokernel_is_cokernel f).desc (cokernel_cofork.of_π k h) @[simp, reassoc] lemma cokernel.π_desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel.π f ≫ cokernel.desc f k h = k := -colimit.ι_desc _ _ +(cokernel_is_cokernel f).fac (cokernel_cofork.of_π k h) walking_parallel_pair.one @[simp] lemma cokernel.desc_zero {W : C} {h} : cokernel.desc f (0 : Y ⟶ W) h = 0 := @@ -806,7 +825,7 @@ end transport section comparison -variables {D : Type u₂} [category.{v} D] [has_zero_morphisms D] +variables {D : Type u₂} [category.{v₂} D] [has_zero_morphisms D] variables (G : C ⥤ D) [functor.preserves_zero_morphisms G] /-- @@ -830,6 +849,16 @@ lemma map_lift_kernel_comparison [has_kernel f] [has_kernel (G.map f)] kernel.lift _ (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) := by { ext, simp [← G.map_comp] } +@[reassoc] lemma kernel_comparison_comp_kernel_map {X' Y' : C} [has_kernel f] + [has_kernel (G.map f)] (g : X' ⟶ Y') [has_kernel g] [has_kernel (G.map g)] (p : X ⟶ X') + (q : Y ⟶ Y') (hpq : f ≫ q = p ≫ g) : + kernel_comparison f G ≫ (kernel.map (G.map f) (G.map g) (G.map p) (G.map q) + (by rw [←G.map_comp, hpq, G.map_comp])) = + G.map (kernel.map f g p q hpq) ≫ kernel_comparison g G := +kernel.lift_map _ _ (by rw [←G.map_comp, kernel.condition, G.map_zero]) _ _ + (by rw [←G.map_comp, kernel.condition, G.map_zero]) _ _ _ + (by simp only [←G.map_comp]; exact G.congr_map (kernel.lift_ι _ _ _).symm) _ + /-- The comparison morphism for the cokernel of `f`. -/ def cokernel_comparison [has_cokernel f] [has_cokernel (G.map f)] : cokernel (G.map f) ⟶ G.obj (cokernel f) := @@ -848,6 +877,15 @@ lemma cokernel_comparison_map_desc [has_cokernel f] [has_cokernel (G.map f)] cokernel.desc _ (G.map h) (by simp only [←G.map_comp, w, functor.map_zero]) := by { ext, simp [← G.map_comp] } +@[reassoc] lemma cokernel_map_comp_cokernel_comparison {X' Y' : C} [has_cokernel f] + [has_cokernel (G.map f)] (g : X' ⟶ Y') [has_cokernel g] [has_cokernel (G.map g)] + (p : X ⟶ X') (q : Y ⟶ Y') (hpq : f ≫ q = p ≫ g) : + cokernel.map (G.map f) (G.map g) (G.map p) (G.map q) (by rw [←G.map_comp, hpq, G.map_comp]) + ≫ cokernel_comparison _ G = cokernel_comparison _ G ≫ G.map (cokernel.map f g p q hpq) := +cokernel.map_desc _ _ (by rw [←G.map_comp, cokernel.condition, G.map_zero]) _ _ + (by rw [←G.map_comp, cokernel.condition, G.map_zero]) _ _ _ _ + (by simp only [←G.map_comp]; exact G.congr_map (cokernel.π_desc _ _ _)) + end comparison end category_theory.limits diff --git a/src/category_theory/limits/shapes/multiequalizer.lean b/src/category_theory/limits/shapes/multiequalizer.lean index b0930c9f55178..aa905aa8b2ca0 100644 --- a/src/category_theory/limits/shapes/multiequalizer.lean +++ b/src/category_theory/limits/shapes/multiequalizer.lean @@ -6,12 +6,14 @@ Authors: Adam Topaz import category_theory.limits.shapes.products import category_theory.limits.shapes.equalizers import category_theory.limits.cone_category -import category_theory.adjunction /-! # Multi-(co)equalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A *multiequalizer* is an equalizer of two morphisms between two products. Since both products and equalizers are limits, such an object is again a limit. This file provides the diagram whose limit is indeed such an object. @@ -31,29 +33,29 @@ namespace category_theory.limits open category_theory -universes v u +universes w v u /-- The type underlying the multiequalizer diagram. -/ @[nolint unused_arguments] -inductive walking_multicospan {L R : Type v} (fst snd : R → L) : Type v +inductive walking_multicospan {L R : Type w} (fst snd : R → L) : Type w | left : L → walking_multicospan | right : R → walking_multicospan /-- The type underlying the multiecoqualizer diagram. -/ @[nolint unused_arguments] -inductive walking_multispan {L R : Type v} (fst snd : L → R) : Type v +inductive walking_multispan {L R : Type w} (fst snd : L → R) : Type w | left : L → walking_multispan | right : R → walking_multispan namespace walking_multicospan -variables {L R : Type v} {fst snd : R → L} +variables {L R : Type w} {fst snd : R → L} instance [inhabited L] : inhabited (walking_multicospan fst snd) := ⟨left default⟩ /-- Morphisms for `walking_multicospan`. -/ -inductive hom : Π (a b : walking_multicospan fst snd), Type v +inductive hom : Π (a b : walking_multicospan fst snd), Type w | id (A) : hom A A | fst (b) : hom (left (fst b)) (right b) | snd (b) : hom (left (snd b)) (right b) @@ -112,9 +114,9 @@ instance : small_category (walking_multispan fst snd) := end walking_multispan /-- This is a structure encapsulating the data necessary to define a `multicospan`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure multicospan_index (C : Type u) [category.{v} C] := -(L R : Type v) +(L R : Type w) (fst_to snd_to : R → L) (left : L → C) (right : R → C) @@ -122,9 +124,9 @@ structure multicospan_index (C : Type u) [category.{v} C] := (snd : Π b, left (snd_to b) ⟶ right b) /-- This is a structure encapsulating the data necessary to define a `multispan`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure multispan_index (C : Type u) [category.{v} C] := -(L R : Type v) +(L R : Type w) (fst_from snd_from : L → R) (left : L → C) (right : R → C) @@ -252,11 +254,11 @@ end multispan_index variables {C : Type u} [category.{v} C] /-- A multifork is a cone over a multicospan. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] abbreviation multifork (I : multicospan_index C) := cone I.multicospan /-- A multicofork is a cocone over a multispan. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] abbreviation multicofork (I : multispan_index C) := cocone I.multispan namespace multifork @@ -331,7 +333,7 @@ variables [has_product I.left] [has_product I.right] @[simp, reassoc] lemma pi_condition : pi.lift K.ι ≫ I.fst_pi_map = pi.lift K.ι ≫ I.snd_pi_map := -by { ext, simp } +by { ext, discrete_cases, simp, } /-- Given a multifork, we may obtain a fork over `∏ I.left ⇉ ∏ I.right`. -/ @[simps X] noncomputable @@ -392,7 +394,17 @@ local attribute [tidy] tactic.case_bash /-- `multifork.to_pi_fork` is functorial. -/ @[simps] noncomputable def to_pi_fork_functor : multifork I ⥤ fork I.fst_pi_map I.snd_pi_map := -{ obj := multifork.to_pi_fork, map := λ K₁ K₂ f, { hom := f.hom } } +{ obj := multifork.to_pi_fork, + map := λ K₁ K₂ f, + { hom := f.hom, + w' := begin + rintro (_|_), + { ext, dsimp, simp }, + { ext, + simp only [multifork.to_pi_fork_π_app_one, multifork.pi_condition, category.assoc], + dsimp [snd_pi_map], + simp }, + end } } /-- `multifork.of_pi_fork` is functorial. -/ @[simps] noncomputable @@ -411,7 +423,7 @@ def multifork_equiv_pi_fork : multifork I ≌ fork I.fst_pi_map I.snd_pi_map := unit_iso := nat_iso.of_components (λ K, cones.ext (iso.refl _) (by { rintros (_|_); dsimp; simp[←fork.app_one_eq_ι_comp_left, -fork.app_one_eq_ι_comp_left] })) (λ K₁ K₂ f, by { ext, simp }), - counit_iso := nat_iso.of_components (λ K, fork.ext (iso.refl _) (by { ext, dsimp, simp })) + counit_iso := nat_iso.of_components (λ K, fork.ext (iso.refl _) (by { ext ⟨j⟩, dsimp, simp })) (λ K₁ K₂ f, by { ext, simp }) } end multicospan_index @@ -484,7 +496,8 @@ variables [has_coproduct I.left] [has_coproduct I.right] @[simp, reassoc] lemma sigma_condition : - I.fst_sigma_map ≫ sigma.desc K.π = I.snd_sigma_map ≫ sigma.desc K.π := by { ext, simp } + I.fst_sigma_map ≫ sigma.desc K.π = I.snd_sigma_map ≫ sigma.desc K.π := +by { ext, discrete_cases, simp, } /-- Given a multicofork, we may obtain a cofork over `∐ I.left ⇉ ∐ I.right`. -/ @[simps X] noncomputable @@ -567,7 +580,7 @@ def multicofork_equiv_sigma_cofork : multicofork I ≌ cofork I.fst_sigma_map I. (by { rintros (_|_); dsimp; simp })) (λ K₁ K₂ f, by { ext, simp }), counit_iso := nat_iso.of_components (λ K, cofork.ext (iso.refl _) - (by { ext, dsimp, simp only [category.comp_id, colimit.ι_desc, cofan.mk_ι_app], refl })) + (by { ext ⟨j⟩, dsimp, simp only [category.comp_id, colimit.ι_desc, cofan.mk_ι_app], refl })) (λ K₁ K₂ f, by { ext, dsimp, simp, }) } end multispan_index diff --git a/src/category_theory/limits/shapes/normal_mono/basic.lean b/src/category_theory/limits/shapes/normal_mono/basic.lean index 8d9883af5c44b..c0c06beb4659d 100644 --- a/src/category_theory/limits/shapes/normal_mono/basic.lean +++ b/src/category_theory/limits/shapes/normal_mono/basic.lean @@ -10,6 +10,9 @@ import category_theory.limits.preserves.basic /-! # Definitions and basic properties of normal monomorphisms and epimorphisms. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A normal monomorphism is a morphism that is the kernel of some other morphism. We give the construction `normal_mono → regular_mono` (`category_theory.normal_mono.regular_mono`) @@ -220,7 +223,7 @@ def normal_epi_of_normal_mono_unop {X Y : Cᵒᵖ} (f : X ⟶ Y) (m : normal_mon { W := op m.Z, g := m.g.op, w := congr_arg quiver.hom.op m.w, - is_colimit := is_colimit.of_π _ _ + is_colimit := cokernel_cofork.is_colimit.of_π _ _ (λ Z' g' w', (kernel_fork.is_limit.lift' m.is_limit g'.unop (congr_arg quiver.hom.unop w')).1.op) (λ Z' g' w', @@ -239,7 +242,7 @@ def normal_mono_of_normal_epi_unop {X Y : Cᵒᵖ} (f : X ⟶ Y) (m : normal_epi { Z := op m.W, g := m.g.op, w := congr_arg quiver.hom.op m.w, - is_limit := is_limit.of_ι _ _ + is_limit := kernel_fork.is_limit.of_ι _ _ (λ Z' g' w', (cokernel_cofork.is_colimit.desc' m.is_colimit g'.unop (congr_arg quiver.hom.unop w')).1.op) (λ Z' g' w', diff --git a/src/category_theory/limits/shapes/normal_mono/equalizers.lean b/src/category_theory/limits/shapes/normal_mono/equalizers.lean index 2fd7929120b71..1c620830185d1 100644 --- a/src/category_theory/limits/shapes/normal_mono/equalizers.lean +++ b/src/category_theory/limits/shapes/normal_mono/equalizers.lean @@ -9,6 +9,9 @@ import category_theory.limits.shapes.finite_products /-! # Normal mono categories with finite products and kernels have all equalizers. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This, and the dual result, are used in the development of abelian categories. -/ diff --git a/src/category_theory/limits/shapes/products.lean b/src/category_theory/limits/shapes/products.lean index 2f2f89bbb803b..3ef9b72a2f599 100644 --- a/src/category_theory/limits/shapes/products.lean +++ b/src/category_theory/limits/shapes/products.lean @@ -9,6 +9,9 @@ import category_theory.discrete_category /-! # Categorical (co)products +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines (co)products as special cases of (co)limits. A product is the categorical generalization of the object `Π i, f i` where `f : ι → C`. It is a @@ -33,7 +36,7 @@ general limits can be used. noncomputable theory -universes w v u u₂ +universes w v v₂ u u₂ open category_theory @@ -45,6 +48,8 @@ variables {C : Type u} [category.{v} C] -- We don't need an analogue of `pair` (for binary products), `parallel_pair` (for equalizers), -- or `(co)span`, since we already have `discrete.functor`. +local attribute [tidy] tactic.discrete_cases + /-- A fan over `f : β → C` consists of a collection of maps from an object `P` to every `f b`. -/ abbreviation fan (f : β → C) := cone (discrete.functor f) /-- A cofan over `f : β → C` consists of a collection of maps from every `f b` to an object `P`. -/ @@ -54,13 +59,20 @@ abbreviation cofan (f : β → C) := cocone (discrete.functor f) @[simps] def fan.mk {f : β → C} (P : C) (p : Π b, P ⟶ f b) : fan f := { X := P, - π := { app := p } } + π := { app := λ X, p X.as } } /-- A cofan over `f : β → C` consists of a collection of maps from every `f b` to an object `P`. -/ @[simps] def cofan.mk {f : β → C} (P : C) (p : Π b, f b ⟶ P) : cofan f := { X := P, - ι := { app := p } } + ι := { app := λ X, p X.as } } + +-- FIXME dualize as needed below (and rename?) + +/-- Get the `j`th map in the fan -/ +def fan.proj {f : β → C} (p : fan f) (j : β) : p.X ⟶ f j := p.π.app (discrete.mk j) +@[simp] lemma fan_mk_proj {f : β → C} (P : C) (p : Π b, P ⟶ f b) (j : β) : + (fan.mk P p).proj j = p j := rfl /-- An abbreviation for `has_limit (discrete.functor f)`. -/ abbreviation has_product (f : β → C) := has_limit (discrete.functor f) @@ -68,6 +80,18 @@ abbreviation has_product (f : β → C) := has_limit (discrete.functor f) /-- An abbreviation for `has_colimit (discrete.functor f)`. -/ abbreviation has_coproduct (f : β → C) := has_colimit (discrete.functor f) +/-- Make a fan `f` into a limit fan by providing `lift`, `fac`, and `uniq` -- + just a convenience lemma to avoid having to go through `discrete` -/ +@[simps] def mk_fan_limit {f : β → C} (t : fan f) + (lift : Π s : fan f, s.X ⟶ t.X) + (fac : ∀ (s : fan f) (j : β), lift s ≫ (t.proj j) = s.proj j) + (uniq : ∀ (s : fan f) (m : s.X ⟶ t.X) (w : ∀ j : β, m ≫ t.proj j = s.proj j), m = lift s) : + is_limit t := +{ lift := lift, + fac' := λ s j, by convert fac s j.as; simp, + uniq' := λ s m w, uniq s m (λ j, w (discrete.mk j)), } + + section variables (C) @@ -91,10 +115,10 @@ notation `∐ ` f:20 := sigma_obj f /-- The `b`-th projection from the pi object over `f` has the form `∏ f ⟶ f b`. -/ abbreviation pi.π (f : β → C) [has_product f] (b : β) : ∏ f ⟶ f b := -limit.π (discrete.functor f) b +limit.π (discrete.functor f) (discrete.mk b) /-- The `b`-th inclusion into the sigma object over `f` has the form `f b ⟶ ∐ f`. -/ abbreviation sigma.ι (f : β → C) [has_coproduct f] (b : β) : f b ⟶ ∐ f := -colimit.ι (discrete.functor f) b +colimit.ι (discrete.functor f) (discrete.mk b) /-- The fan constructed of the projections from the product is limiting. -/ def product_is_product (f : β → C) [has_product f] : @@ -120,32 +144,42 @@ from a family of morphisms between the factors. -/ abbreviation pi.map {f g : β → C} [has_product f] [has_product g] (p : Π b, f b ⟶ g b) : ∏ f ⟶ ∏ g := -lim_map (discrete.nat_trans p) +lim_map (discrete.nat_trans (λ X, p X.as)) + +instance pi.map_mono {f g : β → C} [has_product f] [has_product g] + (p : Π b, f b ⟶ g b) [Π i, mono (p i)] : mono $ pi.map p := +@@limits.lim_map_mono _ _ _ _ _ (by { dsimp, apply_instance }) + /-- Construct an isomorphism between categorical products (indexed by the same type) from a family of isomorphisms between the factors. -/ abbreviation pi.map_iso {f g : β → C} [has_products_of_shape β C] (p : Π b, f b ≅ g b) : ∏ f ≅ ∏ g := -lim.map_iso (discrete.nat_iso p) +lim.map_iso (discrete.nat_iso (λ X, p X.as)) /-- Construct a morphism between categorical coproducts (indexed by the same type) from a family of morphisms between the factors. -/ abbreviation sigma.map {f g : β → C} [has_coproduct f] [has_coproduct g] (p : Π b, f b ⟶ g b) : ∐ f ⟶ ∐ g := -colim_map (discrete.nat_trans p) +colim_map (discrete.nat_trans (λ X, p X.as)) + +instance sigma.map_epi {f g : β → C} [has_coproduct f] [has_coproduct g] + (p : Π b, f b ⟶ g b) [Π i, epi (p i)] : epi $ sigma.map p := +@@limits.colim_map_epi _ _ _ _ _ (by { dsimp, apply_instance }) + /-- Construct an isomorphism between categorical coproducts (indexed by the same type) from a family of isomorphisms between the factors. -/ abbreviation sigma.map_iso {f g : β → C} [has_coproducts_of_shape β C] (p : Π b, f b ≅ g b) : ∐ f ≅ ∐ g := -colim.map_iso (discrete.nat_iso p) +colim.map_iso (discrete.nat_iso (λ X, p X.as)) section comparison -variables {D : Type u₂} [category.{v} D] (G : C ⥤ D) +variables {D : Type u₂} [category.{v₂} D] (G : C ⥤ D) variables (f : β → C) /-- The comparison morphism for the product of `f`. This is an iso iff `G` preserves the product @@ -157,13 +191,13 @@ pi.lift (λ b, G.map (pi.π f b)) @[simp, reassoc] lemma pi_comparison_comp_π [has_product f] [has_product (λ b, G.obj (f b))] (b : β) : pi_comparison G f ≫ pi.π _ b = G.map (pi.π f b) := -limit.lift_π _ b +limit.lift_π _ (discrete.mk b) @[simp, reassoc] lemma map_lift_pi_comparison [has_product f] [has_product (λ b, G.obj (f b))] (P : C) (g : Π j, P ⟶ f j) : G.map (pi.lift g) ≫ pi_comparison G f = pi.lift (λ j, G.map (g j)) := -by { ext, simp [← G.map_comp] } +by { ext, discrete_cases, simp [← G.map_comp] } /-- The comparison morphism for the coproduct of `f`. This is an iso iff `G` preserves the coproduct of `f`, see `preserves_coproduct.of_iso_comparison`. -/ @@ -174,21 +208,155 @@ sigma.desc (λ b, G.map (sigma.ι f b)) @[simp, reassoc] lemma ι_comp_sigma_comparison [has_coproduct f] [has_coproduct (λ b, G.obj (f b))] (b : β) : sigma.ι _ b ≫ sigma_comparison G f = G.map (sigma.ι f b) := -colimit.ι_desc _ b +colimit.ι_desc _ (discrete.mk b) @[simp, reassoc] lemma sigma_comparison_map_desc [has_coproduct f] [has_coproduct (λ b, G.obj (f b))] (P : C) (g : Π j, f j ⟶ P) : sigma_comparison G f ≫ G.map (sigma.desc g) = sigma.desc (λ j, G.map (g j)) := -by { ext, simp [← G.map_comp] } +by { ext, discrete_cases, simp [← G.map_comp] } end comparison variables (C) /-- An abbreviation for `Π J, has_limits_of_shape (discrete J) C` -/ -abbreviation has_products := Π (J : Type v), has_limits_of_shape (discrete J) C +abbreviation has_products := Π (J : Type w), has_limits_of_shape (discrete J) C /-- An abbreviation for `Π J, has_colimits_of_shape (discrete J) C` -/ -abbreviation has_coproducts := Π (J : Type v), has_colimits_of_shape (discrete J) C +abbreviation has_coproducts := Π (J : Type w), has_colimits_of_shape (discrete J) C + +variable {C} + +lemma has_smallest_products_of_has_products [has_products.{w} C] : has_products.{0} C := +λ J, has_limits_of_shape_of_equivalence + (discrete.equivalence equiv.ulift : discrete (ulift.{w} J) ≌ _) + +lemma has_smallest_coproducts_of_has_coproducts [has_coproducts.{w} C] : has_coproducts.{0} C := +λ J, has_colimits_of_shape_of_equivalence + (discrete.equivalence equiv.ulift : discrete (ulift.{w} J) ≌ _) + +lemma has_products_of_limit_fans (lf : ∀ {J : Type w} (f : J → C), fan f) + (lf_is_limit : ∀ {J : Type w} (f : J → C), is_limit (lf f)) : has_products.{w} C := +λ (J : Type w), { has_limit := λ F, has_limit.mk + ⟨(cones.postcompose discrete.nat_iso_functor.inv).obj (lf (λ j, F.obj ⟨j⟩)), + (is_limit.postcompose_inv_equiv _ _).symm (lf_is_limit _)⟩ } + +/-! +(Co)products over a type with a unique term. +-/ +section unique +variables {C} [unique β] (f : β → C) + +/-- The limit cone for the product over an index type with exactly one term. -/ +@[simps] +def limit_cone_of_unique : limit_cone (discrete.functor f) := +{ cone := + { X := f default, + π := { app := λ j, eq_to_hom (by { dsimp, congr, }), }, }, + is_limit := + { lift := λ s, s.π.app default, + fac' := λ s j, begin + have w := (s.π.naturality (eq_to_hom (unique.default_eq _))).symm, + dsimp at w, + simpa [eq_to_hom_map] using w, + end, + uniq' := λ s m w, begin + specialize w default, + dsimp at w, + simpa using w, + end, }, } + +@[priority 100] instance has_product_unique : has_product f := +has_limit.mk (limit_cone_of_unique f) + +/-- A product over a index type with exactly one term is just the object over that term. -/ +@[simps] +def product_unique_iso : ∏ f ≅ f default := +is_limit.cone_point_unique_up_to_iso (limit.is_limit _) (limit_cone_of_unique f).is_limit + +/-- The colimit cocone for the coproduct over an index type with exactly one term. -/ +@[simps] +def colimit_cocone_of_unique : colimit_cocone (discrete.functor f) := +{ cocone := + { X := f default, + ι := { app := λ j, eq_to_hom (by { discrete_cases, dsimp, congr, }), }, }, + is_colimit := + { desc := λ s, s.ι.app default, + fac' := λ s j, begin + have w := (s.ι.naturality (eq_to_hom (unique.eq_default _))), + dsimp at w, + simpa [eq_to_hom_map] using w, + end, + uniq' := λ s m w, begin + specialize w default, + dsimp at w, + simpa using w, + end, }, } + +@[priority 100] instance has_coproduct_unique : has_coproduct f := +has_colimit.mk (colimit_cocone_of_unique f) + +/-- A coproduct over a index type with exactly one term is just the object over that term. -/ +@[simps] +def coproduct_unique_iso : ∐ f ≅ f default := +is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) + (colimit_cocone_of_unique f).is_colimit + +end unique + +section reindex +variables {C} {γ : Type v} (ε : β ≃ γ) (f : γ → C) + +section +variables [has_product f] [has_product (f ∘ ε)] + +/-- Reindex a categorical product via an equivalence of the index types. -/ +def pi.reindex : pi_obj (f ∘ ε) ≅ pi_obj f := +has_limit.iso_of_equivalence (discrete.equivalence ε) (discrete.nat_iso (λ i, iso.refl _)) + +@[simp, reassoc] +lemma pi.reindex_hom_π (b : β) : (pi.reindex ε f).hom ≫ pi.π f (ε b) = pi.π (f ∘ ε) b := +begin + dsimp [pi.reindex], + simp only [has_limit.iso_of_equivalence_hom_π, discrete.nat_iso_inv_app, + equivalence.equivalence_mk'_counit, discrete.equivalence_counit_iso, discrete.nat_iso_hom_app, + eq_to_iso.hom, eq_to_hom_map], + dsimp, + simpa [eq_to_hom_map] using + limit.w (discrete.functor (f ∘ ε)) (discrete.eq_to_hom' (ε.symm_apply_apply b)), +end + +@[simp, reassoc] +lemma pi.reindex_inv_π (b : β) : (pi.reindex ε f).inv ≫ pi.π (f ∘ ε) b = pi.π f (ε b) := +by simp [iso.inv_comp_eq] + +end + +section +variables [has_coproduct f] [has_coproduct (f ∘ ε)] + +/-- Reindex a categorical coproduct via an equivalence of the index types. -/ +def sigma.reindex : sigma_obj (f ∘ ε) ≅ sigma_obj f := +has_colimit.iso_of_equivalence (discrete.equivalence ε) (discrete.nat_iso (λ i, iso.refl _)) + +@[simp, reassoc] +lemma sigma.ι_reindex_hom (b : β) : sigma.ι (f ∘ ε) b ≫ (sigma.reindex ε f).hom = sigma.ι f (ε b) := +begin + dsimp [sigma.reindex], + simp only [has_colimit.iso_of_equivalence_hom_π, equivalence.equivalence_mk'_unit, + discrete.equivalence_unit_iso, discrete.nat_iso_hom_app, eq_to_iso.hom, eq_to_hom_map, + discrete.nat_iso_inv_app], + dsimp, + simp [eq_to_hom_map, + ←colimit.w (discrete.functor f) (discrete.eq_to_hom' (ε.apply_symm_apply (ε b)))], +end + +@[simp, reassoc] +lemma sigma.ι_reindex_inv (b : β) : sigma.ι f (ε b) ≫ (sigma.reindex ε f).inv = sigma.ι (f ∘ ε) b := +by simp [iso.comp_inv_eq] + +end + +end reindex end category_theory.limits diff --git a/src/category_theory/limits/shapes/pullbacks.lean b/src/category_theory/limits/shapes/pullbacks.lean index 1f0e6bc85aad4..ff1a2095c1adf 100644 --- a/src/category_theory/limits/shapes/pullbacks.lean +++ b/src/category_theory/limits/shapes/pullbacks.lean @@ -9,6 +9,9 @@ import category_theory.limits.shapes.binary_products /-! # Pullbacks +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define a category `walking_cospan` (resp. `walking_span`), which is the index category for the given data for a pullback (resp. pushout) diagram. Convenience methods `cospan f g` and `span f g` construct functors from the walking (co)span, hitting the given morphisms. @@ -26,7 +29,7 @@ open category_theory namespace category_theory.limits -universes v₁ v₂ v u u₂ +universes w v₁ v₂ v u u₂ local attribute [tidy] tactic.case_bash @@ -34,7 +37,7 @@ local attribute [tidy] tactic.case_bash The type of objects for the diagram indexing a pullback, defined as a special case of `wide_pullback_shape`. -/ -abbreviation walking_cospan : Type v := wide_pullback_shape walking_pair +abbreviation walking_cospan : Type := wide_pullback_shape walking_pair /-- The left point of the walking cospan. -/ @[pattern] abbreviation walking_cospan.left : walking_cospan := some walking_pair.left @@ -47,7 +50,7 @@ abbreviation walking_cospan : Type v := wide_pullback_shape walking_pair The type of objects for the diagram indexing a pushout, defined as a special case of `wide_pushout_shape`. -/ -abbreviation walking_span : Type v := wide_pushout_shape walking_pair +abbreviation walking_span : Type := wide_pushout_shape walking_pair /-- The left point of the walking span. -/ @[pattern] abbreviation walking_span.left : walking_span := some walking_pair.left @@ -59,7 +62,7 @@ abbreviation walking_span : Type v := wide_pushout_shape walking_pair namespace walking_cospan /-- The type of arrows for the diagram indexing a pullback. -/ -abbreviation hom : walking_cospan → walking_cospan → Type v := wide_pullback_shape.hom +abbreviation hom : walking_cospan → walking_cospan → Type := wide_pullback_shape.hom /-- The left arrow of the walking cospan. -/ @[pattern] abbreviation hom.inl : left ⟶ one := wide_pullback_shape.hom.term _ @@ -75,7 +78,7 @@ end walking_cospan namespace walking_span /-- The type of arrows for the diagram indexing a pushout. -/ -abbreviation hom : walking_span → walking_span → Type v := wide_pushout_shape.hom +abbreviation hom : walking_span → walking_span → Type := wide_pushout_shape.hom /-- The left arrow of the walking span. -/ @[pattern] abbreviation hom.fst : zero ⟶ left := wide_pushout_shape.hom.init _ @@ -88,70 +91,48 @@ instance (X Y : walking_span) : subsingleton (X ⟶ Y) := by tidy end walking_span -section -open walking_cospan +open walking_span.hom walking_cospan.hom wide_pullback_shape.hom wide_pushout_shape.hom -/-- The functor between two `walking_cospan`s in different universes. -/ -def walking_cospan_functor : walking_cospan.{v₁} ⥤ walking_cospan.{v₂} := -{ obj := by { rintro (_|_|_), exacts [one, left, right] }, - map := by { rintro _ _ (_|_|_), exacts [hom.id _, hom.inl, hom.inr] }, - map_id' := λ X, rfl, - map_comp' := λ _ _ _ _ _, subsingleton.elim _ _ } - -@[simp] lemma walking_cospan_functor_one : walking_cospan_functor.obj one = one := rfl -@[simp] lemma walking_cospan_functor_left : walking_cospan_functor.obj left = left := rfl -@[simp] lemma walking_cospan_functor_right : walking_cospan_functor.obj right = right := rfl -@[simp] lemma walking_cospan_functor_id (X) : walking_cospan_functor.map (𝟙 X) = 𝟙 _ := rfl -@[simp] lemma walking_cospan_functor_inl : walking_cospan_functor.map hom.inl = hom.inl := rfl -@[simp] lemma walking_cospan_functor_inr : walking_cospan_functor.map hom.inr = hom.inr := rfl - -/-- The equivalence between two `walking_cospan`s in different universes. -/ -def walking_cospan_equiv : walking_cospan.{v₁} ≌ walking_cospan.{v₂} := -{ functor := walking_cospan_functor, - inverse := walking_cospan_functor, - unit_iso := nat_iso.of_components - (λ x, eq_to_iso (by { rcases x with (_|_|_); refl })) - (by { rintros _ _ (_|_|_); simp }), - counit_iso := nat_iso.of_components - (λ x, eq_to_iso (by { rcases x with (_|_|_); refl })) - (by { rintros _ _ (_|_|_); simp }) } +variables {C : Type u} [category.{v} C] +/-- To construct an isomorphism of cones over the walking cospan, +it suffices to construct an isomorphism +of the cone points and check it commutes with the legs to `left` and `right`. -/ +def walking_cospan.ext {F : walking_cospan ⥤ C} {s t : cone F} (i : s.X ≅ t.X) + (w₁ : s.π.app walking_cospan.left = i.hom ≫ t.π.app walking_cospan.left) + (w₂ : s.π.app walking_cospan.right = i.hom ≫ t.π.app walking_cospan.right) : + s ≅ t := +begin + apply cones.ext i, + rintro (⟨⟩|⟨⟨⟩⟩), + { have h₁ := s.π.naturality walking_cospan.hom.inl, + dsimp at h₁, simp only [category.id_comp] at h₁, + have h₂ := t.π.naturality walking_cospan.hom.inl, + dsimp at h₂, simp only [category.id_comp] at h₂, + simp_rw [h₂, ←category.assoc, ←w₁, ←h₁], }, + { exact w₁, }, + { exact w₂, }, end -section -open walking_span - -/-- The functor between two `walking_span`s in different universes. -/ -def walking_span_functor : walking_span.{v₁} ⥤ walking_span.{v₂} := -{ obj := by { rintro (_|_|_), exacts [zero, left, right] }, - map := by { rintro _ _ (_|_|_), exacts [hom.id _, hom.fst, hom.snd] }, - map_id' := λ X, rfl, - map_comp' := λ _ _ _ _ _, subsingleton.elim _ _ } - -@[simp] lemma walking_span_functor_zero : walking_span_functor.obj zero = zero := rfl -@[simp] lemma walking_span_functor_left : walking_span_functor.obj left = left := rfl -@[simp] lemma walking_span_functor_right : walking_span_functor.obj right = right := rfl -@[simp] lemma walking_span_functor_id (X) : walking_span_functor.map (𝟙 X) = 𝟙 _ := rfl -@[simp] lemma walking_span_functor_fst : walking_span_functor.map hom.fst = hom.fst := rfl -@[simp] lemma walking_span_functor_snd : walking_span_functor.map hom.snd = hom.snd := rfl - -/-- The equivalence between two `walking_span`s in different universes. -/ -def walking_span_equiv : walking_span.{v₁} ≌ walking_span.{v₂} := -{ functor := walking_span_functor, - inverse := walking_span_functor, - unit_iso := nat_iso.of_components - (λ x, eq_to_iso (by { rcases x with (_|_|_); refl })) - (by { rintros _ _ (_|_|_); simp }), - counit_iso := nat_iso.of_components - (λ x, eq_to_iso (by { rcases x with (_|_|_); refl })) - (by { rintros _ _ (_|_|_); simp }) } - +/-- To construct an isomorphism of cocones over the walking span, +it suffices to construct an isomorphism +of the cocone points and check it commutes with the legs from `left` and `right`. -/ +def walking_span.ext {F : walking_span ⥤ C} {s t : cocone F} (i : s.X ≅ t.X) + (w₁ : s.ι.app walking_cospan.left ≫ i.hom = t.ι.app walking_cospan.left) + (w₂ : s.ι.app walking_cospan.right ≫ i.hom = t.ι.app walking_cospan.right) : + s ≅ t := +begin + apply cocones.ext i, + rintro (⟨⟩|⟨⟨⟩⟩), + { have h₁ := s.ι.naturality walking_span.hom.fst, + dsimp at h₁, simp only [category.comp_id] at h₁, + have h₂ := t.ι.naturality walking_span.hom.fst, + dsimp at h₂, simp only [category.comp_id] at h₂, + simp_rw [←h₁, category.assoc, w₁, h₂], }, + { exact w₁, }, + { exact w₂, }, end -open walking_span.hom walking_cospan.hom wide_pullback_shape.hom wide_pushout_shape.hom - -variables {C : Type u} [category.{v} C] - /-- `cospan f g` is the functor from the walking cospan hitting `f` and `g`. -/ def cospan {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : walking_cospan ⥤ C := wide_pullback_shape.wide_cospan Z @@ -204,7 +185,7 @@ def diagram_iso_span (F : walking_span ⥤ C) : F ≅ span (F.map fst) (F.map snd) := nat_iso.of_components (λ j, eq_to_iso (by tidy)) (by tidy) -variables {D : Type*} [category.{v} D] +variables {D : Type u₂} [category.{v₂} D] /-- A functor applied to a cospan is a cospan. -/ def cospan_comp_iso (F : C ⥤ D) {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) : @@ -405,6 +386,16 @@ abbreviation fst (t : pullback_cone f g) : t.X ⟶ X := t.π.app walking_cospan. /-- The second projection of a pullback cone. -/ abbreviation snd (t : pullback_cone f g) : t.X ⟶ Y := t.π.app walking_cospan.right +@[simp] lemma π_app_left (c : pullback_cone f g) : c.π.app walking_cospan.left = c.fst := rfl + +@[simp] lemma π_app_right (c : pullback_cone f g) : c.π.app walking_cospan.right = c.snd := rfl + +@[simp] lemma condition_one (t : pullback_cone f g) : t.π.app walking_cospan.one = t.fst ≫ f := +begin + have w := t.π.naturality walking_cospan.hom.inl, + dsimp at w, simpa using w, +end + /-- This is a slightly more convenient method to verify that a pullback cone is a limit cone. It only asks for a proof of facts that carry any mathematical content -/ def is_limit_aux (t : pullback_cone f g) (lift : Π (s : pullback_cone f g), s.X ⟶ t.X) @@ -476,6 +467,13 @@ lemma mono_fst_of_is_pullback_of_mono {t : pullback_cone f g} (ht : is_limit t) mono t.fst := ⟨λ W h k i, is_limit.hom_ext ht i (by simp [←cancel_mono g, ←t.condition, reassoc_of i])⟩ +/-- To construct an isomorphism of pullback cones, it suffices to construct an isomorphism +of the cone points and check it commutes with `fst` and `snd`. -/ +def ext {s t : pullback_cone f g} (i : s.X ≅ t.X) + (w₁ : s.fst = i.hom ≫ t.fst) (w₂ : s.snd = i.hom ≫ t.snd) : + s ≅ t := +walking_cospan.ext i w₁ w₂ + /-- If `t` is a limit pullback cone over `f` and `g` and `h : W ⟶ X` and `k : W ⟶ Y` are such that `h ≫ f = k ≫ g`, then we have `l : W ⟶ t.X` satisfying `l ≫ fst t = h` and `l ≫ snd t = k`. -/ @@ -583,6 +581,16 @@ abbreviation inl (t : pushout_cocone f g) : Y ⟶ t.X := t.ι.app walking_span.l /-- The second inclusion of a pushout cocone. -/ abbreviation inr (t : pushout_cocone f g) : Z ⟶ t.X := t.ι.app walking_span.right +@[simp] lemma ι_app_left (c : pushout_cocone f g) : c.ι.app walking_span.left = c.inl := rfl + +@[simp] lemma ι_app_right (c : pushout_cocone f g) : c.ι.app walking_span.right = c.inr := rfl + +@[simp] lemma condition_zero (t : pushout_cocone f g) : t.ι.app walking_span.zero = f ≫ t.inl := +begin + have w := t.ι.naturality walking_span.hom.fst, + dsimp at w, simpa using w.symm, +end + /-- This is a slightly more convenient method to verify that a pushout cocone is a colimit cocone. It only asks for a proof of facts that carry any mathematical content -/ def is_colimit_aux (t : pushout_cocone f g) (desc : Π (s : pushout_cocone f g), t.X ⟶ s.X) @@ -660,6 +668,13 @@ lemma epi_inl_of_is_pushout_of_epi {t : pushout_cocone f g} (ht : is_colimit t) epi t.inl := ⟨λ W h k i, is_colimit.hom_ext ht i (by simp [←cancel_epi g, ←t.condition_assoc, i])⟩ +/-- To construct an isomorphism of pushout cocones, it suffices to construct an isomorphism +of the cocone points and check it commutes with `inl` and `inr`. -/ +def ext {s t : pushout_cocone f g} (i : s.X ≅ t.X) + (w₁ : s.inl ≫ i.hom = t.inl) (w₂ : s.inr ≫ i.hom = t.inr) : + s ≅ t := +walking_span.ext i w₁ w₂ + /-- This is a more convenient formulation to show that a `pushout_cocone` constructed using `pushout_cocone.mk` is a colimit cocone. @@ -854,6 +869,26 @@ abbreviation pushout.desc {W X Y Z : C} {f : X ⟶ Y} {g : X ⟶ Z} [has_pushout (h : Y ⟶ W) (k : Z ⟶ W) (w : f ≫ h = g ≫ k) : pushout f g ⟶ W := colimit.desc _ (pushout_cocone.mk h k w) +@[simp] +lemma pullback_cone.fst_colimit_cocone {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) + [has_limit (cospan f g)] : pullback_cone.fst (limit.cone (cospan f g)) = pullback.fst := +rfl + +@[simp] +lemma pullback_cone.snd_colimit_cocone {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) + [has_limit (cospan f g)] : pullback_cone.snd (limit.cone (cospan f g)) = pullback.snd := +rfl + +@[simp] +lemma pushout_cocone.inl_colimit_cocone {X Y Z : C} (f : Z ⟶ X) (g : Z ⟶ Y) + [has_colimit (span f g)] : pushout_cocone.inl (colimit.cocone (span f g)) = pushout.inl := +rfl + +@[simp] +lemma pushout_cocone.inr_colimit_cocone {X Y Z : C} (f : Z ⟶ X) (g : Z ⟶ Y) + [has_colimit (span f g)] : pushout_cocone.inr (colimit.cocone (span f g)) = pushout.inr := +rfl + @[simp, reassoc] lemma pullback.lift_fst {W X Y Z : C} {f : X ⟶ Z} {g : Y ⟶ Z} [has_pullback f g] (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) : pullback.lift h k w ≫ pullback.fst = h := @@ -914,6 +949,12 @@ abbreviation pullback.map {W X Y Z S T : C} (f₁ : W ⟶ S) (f₂ : X ⟶ S) [h pullback.lift (pullback.fst ≫ i₁) (pullback.snd ≫ i₂) (by simp [← eq₁, ← eq₂, pullback.condition_assoc]) +/-- The canonical map `X ×ₛ Y ⟶ X ×ₜ Y` given `S ⟶ T`. -/ +abbreviation pullback.map_desc {X Y S T : C} (f : X ⟶ S) (g : Y ⟶ S) (i : S ⟶ T) + [has_pullback f g] [has_pullback (f ≫ i) (g ≫ i)] : + pullback f g ⟶ pullback (f ≫ i) (g ≫ i) := +pullback.map f g (f ≫ i) (g ≫ i) (𝟙 _) (𝟙 _) i (category.id_comp _).symm (category.id_comp _).symm + /-- Given such a diagram, then there is a natural morphism `W ⨿ₛ X ⟶ Y ⨿ₜ Z`. @@ -931,6 +972,11 @@ abbreviation pushout.map {W X Y Z S T : C} (f₁ : S ⟶ W) (f₂ : S ⟶ X) [ha pushout.desc (i₁ ≫ pushout.inl) (i₂ ≫ pushout.inr) (by { simp only [← category.assoc, eq₁, eq₂], simp [pushout.condition] }) +/-- The canonical map `X ⨿ₛ Y ⟶ X ⨿ₜ Y` given `S ⟶ T`. -/ +abbreviation pushout.map_lift {X Y S T : C} (f : T ⟶ X) (g : T ⟶ Y) (i : S ⟶ T) + [has_pushout f g] [has_pushout (i ≫ f) (i ≫ g)] : + pushout (i ≫ f) (i ≫ g) ⟶ pushout f g := +pushout.map (i ≫ f) (i ≫ g) f g (𝟙 _) (𝟙 _) i (category.comp_id _) (category.comp_id _) /-- Two morphisms into a pullback are equal if their compositions with the pullback morphisms are equal -/ @@ -1045,6 +1091,13 @@ begin tidy end +lemma pullback.map_desc_comp {X Y S T S' : C} (f : X ⟶ T) (g : Y ⟶ T) (i : T ⟶ S) + (i' : S ⟶ S') [has_pullback f g] [has_pullback (f ≫ i) (g ≫ i)] + [has_pullback (f ≫ i ≫ i') (g ≫ i ≫ i')] [has_pullback ((f ≫ i) ≫ i') ((g ≫ i) ≫ i')] : + pullback.map_desc f g (i ≫ i') = pullback.map_desc f g i ≫ pullback.map_desc _ _ i' ≫ + (pullback.congr_hom (category.assoc _ _ _) (category.assoc _ _ _)).hom := +by { ext; simp } + /-- If `f₁ = f₂` and `g₁ = g₂`, we may construct a canonical isomorphism `pushout f₁ g₁ ≅ pullback f₂ g₂` -/ @[simps hom] @@ -1070,6 +1123,14 @@ begin rw category.id_comp } end +lemma pushout.map_lift_comp {X Y S T S' : C} (f : T ⟶ X) (g : T ⟶ Y) (i : S ⟶ T) + (i' : S' ⟶ S) [has_pushout f g] [has_pushout (i ≫ f) (i ≫ g)] + [has_pushout (i' ≫ i ≫ f) (i' ≫ i ≫ g)] [has_pushout ((i' ≫ i) ≫ f) ((i' ≫ i) ≫ g)] : + pushout.map_lift f g (i' ≫ i) = + (pushout.congr_hom (category.assoc _ _ _) (category.assoc _ _ _)).hom ≫ + pushout.map_lift _ _ i' ≫ pushout.map_lift f g i := +by { ext; simp } + section variables (G : C ⥤ D) @@ -1521,8 +1582,10 @@ instance has_cokernel_pair_of_epi [epi f] : has_pushout f f := ⟨⟨⟨_, pushout_cocone.is_colimit_mk_id_id f⟩⟩⟩ lemma inl_eq_inr_of_epi_eq [epi f] : (pushout.inl : _ ⟶ pushout f f) = pushout.inr := -((pushout_cocone.is_colimit_mk_id_id f).fac (get_colimit_cocone (span f f)).cocone left).symm.trans - ((pushout_cocone.is_colimit_mk_id_id f).fac (get_colimit_cocone (span f f)).cocone right : _) +((pushout_cocone.is_colimit_mk_id_id f).fac + (get_colimit_cocone (span f f)).cocone left).symm.trans + ((pushout_cocone.is_colimit_mk_id_id f).fac + (get_colimit_cocone (span f f)).cocone right : _) @[simp] lemma pullback_symmetry_hom_of_epi_eq [epi f] : (pushout_symmetry f f).hom = 𝟙 _ := by ext; simp [inl_eq_inr_of_epi_eq] @@ -2140,10 +2203,10 @@ variables (C) See -/ -abbreviation has_pullbacks := has_limits_of_shape walking_cospan.{v} C +abbreviation has_pullbacks := has_limits_of_shape walking_cospan C /-- `has_pushouts` represents a choice of pushout for every pair of morphisms -/ -abbreviation has_pushouts := has_colimits_of_shape walking_span.{v} C +abbreviation has_pushouts := has_colimits_of_shape walking_span C /-- If `C` has all limits of diagrams `cospan f g`, then it has all pullbacks -/ lemma has_pullbacks_of_has_limit_cospan @@ -2158,11 +2221,31 @@ lemma has_pushouts_of_has_colimit_span { has_colimit := λ F, has_colimit_of_iso (diagram_iso_span F) } /-- The duality equivalence `walking_spanᵒᵖ ≌ walking_cospan` -/ +@[simps] def walking_span_op_equiv : walking_spanᵒᵖ ≌ walking_cospan := wide_pushout_shape_op_equiv _ /-- The duality equivalence `walking_cospanᵒᵖ ≌ walking_span` -/ +@[simps] def walking_cospan_op_equiv : walking_cospanᵒᵖ ≌ walking_span := wide_pullback_shape_op_equiv _ +/-- Having wide pullback at any universe level implies having binary pullbacks. -/ +@[priority 100] -- see Note [lower instance priority] +instance has_pullbacks_of_has_wide_pullbacks [has_wide_pullbacks.{w} C] : has_pullbacks C := +begin + haveI := has_wide_pullbacks_shrink.{0 w} C, + apply_instance +end + +variable {C} + +/-- Given a morphism `f : X ⟶ Y`, we can take morphisms over `Y` to morphisms over `X` via +pullbacks. This is right adjoint to `over.map` (TODO) -/ +@[simps obj_left obj_hom map_left {rhs_md := semireducible, simp_rhs := tt}] +def base_change [has_pullbacks C] {X Y : C} (f : X ⟶ Y) : over Y ⥤ over X := +{ obj := λ g, over.mk (pullback.snd : pullback g.hom f ⟶ _), + map := λ g₁ g₂ i, over.hom_mk (pullback.map _ _ _ _ i.left (𝟙 _) (𝟙 _) (by simp) (by simp)) + (by simp) } + end category_theory.limits diff --git a/src/category_theory/limits/shapes/reflexive.lean b/src/category_theory/limits/shapes/reflexive.lean index 9415a43050ad7..96a14fb7045ad 100644 --- a/src/category_theory/limits/shapes/reflexive.lean +++ b/src/category_theory/limits/shapes/reflexive.lean @@ -9,6 +9,9 @@ import category_theory.limits.shapes.kernel_pair /-! # Reflexive coequalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define reflexive pairs as a pair of morphisms which have a common section. We say a category has reflexive coequalizers if it has coequalizers of all reflexive pairs. Reflexive coequalizers often enjoy nicer properties than general coequalizers, and feature heavily diff --git a/src/category_theory/limits/shapes/regular_mono.lean b/src/category_theory/limits/shapes/regular_mono.lean index 5713672ddc2bc..aebe52044659d 100644 --- a/src/category_theory/limits/shapes/regular_mono.lean +++ b/src/category_theory/limits/shapes/regular_mono.lean @@ -10,10 +10,13 @@ import category_theory.limits.shapes.equalizers /-! # Definitions and basic properties of regular monomorphisms and epimorphisms. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A regular monomorphism is a morphism that is the equalizer of some parallel pair. We give the constructions -* `split_mono → regular_mono` and +* `is_split_mono → regular_mono` and * `regular_mono → mono` as well as the dual constructions for regular epimorphisms. Additionally, we give the construction * `regular_epi ⟶ strong_epi`. @@ -59,12 +62,12 @@ instance equalizer_regular (g h : X ⟶ Y) [has_limit (parallel_pair g h)] : /-- Every split monomorphism is a regular monomorphism. -/ @[priority 100] -instance regular_mono.of_split_mono (f : X ⟶ Y) [split_mono f] : regular_mono f := +instance regular_mono.of_is_split_mono (f : X ⟶ Y) [is_split_mono f] : regular_mono f := { Z := Y, left := 𝟙 Y, right := retraction f ≫ f, w := by tidy, - is_limit := split_mono_equalizes f } + is_limit := is_split_mono_equalizes f } /-- If `f` is a regular mono, then any map `k : W ⟶ Y` equalizing `regular_mono.left` and `regular_mono.right` induces a morphism `l : W ⟶ X` such that `l ≫ f = k`. -/ @@ -118,17 +121,15 @@ regular_of_is_pullback_snd_of_regular comm.symm (pullback_cone.flip_is_limit t) @[priority 100] instance strong_mono_of_regular_mono (f : X ⟶ Y) [regular_mono f] : strong_mono f := -{ mono := by apply_instance, - has_lift := - begin - introsI, - have : v ≫ (regular_mono.left : Y ⟶ regular_mono.Z f) = v ≫ regular_mono.right, - { apply (cancel_epi z).1, - simp only [regular_mono.w, ← reassoc_of h] }, - obtain ⟨t, ht⟩ := regular_mono.lift' _ _ this, - refine arrow.has_lift.mk ⟨t, (cancel_mono f).1 _, ht⟩, - simp only [arrow.mk_hom, arrow.hom_mk'_left, category.assoc, ht, h] - end } +strong_mono.mk' begin + introsI A B z hz u v sq, + have : v ≫ (regular_mono.left : Y ⟶ regular_mono.Z f) = v ≫ regular_mono.right, + { apply (cancel_epi z).1, + simp only [regular_mono.w, ← reassoc_of sq.w] }, + obtain ⟨t, ht⟩ := regular_mono.lift' _ _ this, + refine comm_sq.has_lift.mk' ⟨t, (cancel_mono f).1 _, ht⟩, + simp only [arrow.mk_hom, arrow.hom_mk'_left, category.assoc, ht, sq.w], +end /-- A regular monomorphism is an isomorphism if it is an epimorphism. -/ lemma is_iso_of_regular_mono_of_epi (f : X ⟶ Y) [regular_mono f] [e : epi f] : is_iso f := @@ -152,7 +153,7 @@ regular_mono_category.regular_mono_of_mono _ instance regular_mono_category_of_split_mono_category [split_mono_category C] : regular_mono_category C := { regular_mono_of_mono := λ _ _ f _, - by { haveI := by exactI split_mono_of_mono f, apply_instance } } + by { haveI := by exactI is_split_mono_of_mono f, apply_instance } } @[priority 100] instance strong_mono_category_of_regular_mono_category [regular_mono_category C] : @@ -185,12 +186,12 @@ instance coequalizer_regular (g h : X ⟶ Y) [has_colimit (parallel_pair g h)] : /-- Every split epimorphism is a regular epimorphism. -/ @[priority 100] -instance regular_epi.of_split_epi (f : X ⟶ Y) [split_epi f] : regular_epi f := +instance regular_epi.of_split_epi (f : X ⟶ Y) [is_split_epi f] : regular_epi f := { W := X, left := 𝟙 X, right := f ≫ section_ f, w := by tidy, - is_colimit := split_epi_coequalizes f } + is_colimit := is_split_epi_coequalizes f } /-- If `f` is a regular epi, then every morphism `k : X ⟶ W` coequalizing `regular_epi.left` and `regular_epi.right` induces `l : Y ⟶ W` such that `f ≫ l = k`. -/ @@ -244,17 +245,15 @@ regular_of_is_pushout_snd_of_regular comm.symm (pushout_cocone.flip_is_colimit t @[priority 100] instance strong_epi_of_regular_epi (f : X ⟶ Y) [regular_epi f] : strong_epi f := -{ epi := by apply_instance, - has_lift := - begin - introsI, - have : (regular_epi.left : regular_epi.W f ⟶ X) ≫ u = regular_epi.right ≫ u, - { apply (cancel_mono z).1, - simp only [category.assoc, h, regular_epi.w_assoc] }, - obtain ⟨t, ht⟩ := regular_epi.desc' f u this, - exact arrow.has_lift.mk ⟨t, ht, (cancel_epi f).1 - (by simp only [←category.assoc, ht, ←h, arrow.mk_hom, arrow.hom_mk'_right])⟩, - end } +strong_epi.mk' begin + introsI A B z hz u v sq, + have : (regular_epi.left : regular_epi.W f ⟶ X) ≫ u = regular_epi.right ≫ u, + { apply (cancel_mono z).1, + simp only [category.assoc, sq.w, regular_epi.w_assoc] }, + obtain ⟨t, ht⟩ := regular_epi.desc' f u this, + exact comm_sq.has_lift.mk' ⟨t, ht, (cancel_epi f).1 + (by simp only [←category.assoc, ht, ←sq.w, arrow.mk_hom, arrow.hom_mk'_right])⟩, +end /-- A regular epimorphism is an isomorphism if it is a monomorphism. -/ lemma is_iso_of_regular_epi_of_mono (f : X ⟶ Y) [regular_epi f] [m : mono f] : is_iso f := @@ -277,7 +276,7 @@ regular_epi_category.regular_epi_of_epi _ @[priority 100] instance regular_epi_category_of_split_epi_category [split_epi_category C] : regular_epi_category C := -{ regular_epi_of_epi := λ _ _ f _, by { haveI := by exactI split_epi_of_epi f, apply_instance } } +{ regular_epi_of_epi := λ _ _ f _, by { haveI := by exactI is_split_epi_of_epi f, apply_instance } } @[priority 100] instance strong_epi_category_of_regular_epi_category [regular_epi_category C] : diff --git a/src/category_theory/limits/shapes/split_coequalizer.lean b/src/category_theory/limits/shapes/split_coequalizer.lean index e670a6ec31db1..1b13d4fe434ac 100644 --- a/src/category_theory/limits/shapes/split_coequalizer.lean +++ b/src/category_theory/limits/shapes/split_coequalizer.lean @@ -8,6 +8,9 @@ import category_theory.limits.shapes.equalizers /-! # Split coequalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define what it means for a triple of morphisms `f g : X ⟶ Y`, `π : Y ⟶ Z` to be a split coequalizer: there is a section `s` of `π` and a section `t` of `g`, which additionally satisfy `t ≫ f = π ≫ s`. @@ -32,7 +35,7 @@ namespace category_theory universes v v₂ u u₂ variables {C : Type u} [category.{v} C] -variables {D : Type u₂} [category.{v} D] +variables {D : Type u₂} [category.{v₂} D] variables (G : C ⥤ D) variables {X Y : C} (f g : X ⟶ Y) diff --git a/src/category_theory/limits/shapes/strict_initial.lean b/src/category_theory/limits/shapes/strict_initial.lean index f75fb39581491..3e64e95e5c077 100644 --- a/src/category_theory/limits/shapes/strict_initial.lean +++ b/src/category_theory/limits/shapes/strict_initial.lean @@ -6,11 +6,13 @@ Authors: Bhavik Mehta import category_theory.limits.shapes.terminal import category_theory.limits.shapes.binary_products -import category_theory.epi_mono /-! # Strict initial objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file sets up the basic theory of strict initial objects: initial objects where every morphism to it is an isomorphism. This generalises a property of the empty set in the category of sets: namely that the only function to the empty set is from itself. diff --git a/src/category_theory/limits/shapes/strong_epi.lean b/src/category_theory/limits/shapes/strong_epi.lean index 81e03fdfddf7a..01cfc4c59fcf4 100644 --- a/src/category_theory/limits/shapes/strong_epi.lean +++ b/src/category_theory/limits/shapes/strong_epi.lean @@ -3,16 +3,19 @@ Copyright (c) 2020 Markus Himmel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel -/ -import category_theory.arrow import category_theory.balanced +import category_theory.lifting_properties.basic /-! # Strong epimorphisms -In this file, we define strong epimorphisms. A strong epimorphism is an epimorphism `f`, such -that for every commutative square with `f` at the top and a monomorphism at the bottom, there is -a diagonal morphism making the two triangles commute. This lift is necessarily unique (as shown in -`comma.lean`). +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we define strong epimorphisms. A strong epimorphism is an epimorphism `f` +which has the (unique) left lifting property with respect to monomorphisms. Similarly, +a strong monomorphisms in a monomorphism which has the (unique) right lifting property +with respect to epimorphisms. ## Main results @@ -40,22 +43,32 @@ variables {C : Type u} [category.{v} C] variables {P Q : C} -/-- A strong epimorphism `f` is an epimorphism such that every commutative square with `f` at the - top and a monomorphism at the bottom has a lift. -/ +/-- A strong epimorphism `f` is an epimorphism which has the left lifting property +with respect to monomorphisms. -/ class strong_epi (f : P ⟶ Q) : Prop := (epi : epi f) -(has_lift : Π {X Y : C} {u : P ⟶ X} {v : Q ⟶ Y} {z : X ⟶ Y} [mono z] (h : u ≫ z = f ≫ v), - arrow.has_lift $ arrow.hom_mk' h) +(llp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [mono z], has_lifting_property f z) + +lemma strong_epi.mk' {f : P ⟶ Q} [epi f] + (hf : ∀ (X Y : C) (z : X ⟶ Y) (hz : mono z) (u : P ⟶ X) (v : Q ⟶ Y) + (sq : comm_sq u f z v), sq.has_lift) : strong_epi f := +{ epi := infer_instance, + llp := λ X Y z hz, ⟨λ u v sq, hf X Y z hz u v sq⟩, } -/-- A strong monomorphism `f` is a monomorphism such that every commutative square with `f` at the - bottom and an epimorphism at the top has a lift. -/ +/-- A strong monomorphism `f` is a monomorphism which has the right lifting property +with respect to epimorphisms. -/ class strong_mono (f : P ⟶ Q) : Prop := (mono : mono f) -(has_lift : Π {X Y : C} {u : X ⟶ P} {v : Y ⟶ Q} {z : X ⟶ Y} [epi z] (h : u ≫ f = z ≫ v), - arrow.has_lift $ arrow.hom_mk' h) +(rlp : ∀ ⦃X Y : C⦄ (z : X ⟶ Y) [epi z], has_lifting_property z f) + +lemma strong_mono.mk' {f : P ⟶ Q} [mono f] + (hf : ∀ (X Y : C) (z : X ⟶ Y) (hz : epi z) (u : X ⟶ P) (v : Y ⟶ Q) + (sq : comm_sq u z f v), sq.has_lift) : strong_mono f := +{ mono := infer_instance, + rlp := λ X Y z hz, ⟨λ u v sq, hf X Y z hz u v sq⟩, } -attribute [instance] strong_epi.has_lift -attribute [instance] strong_mono.has_lift +attribute [instance, priority 100] strong_epi.llp +attribute [instance, priority 100] strong_mono.rlp @[priority 100] instance epi_of_strong_epi (f : P ⟶ Q) [strong_epi f] : epi f := strong_epi.epi @@ -69,69 +82,81 @@ variables {R : C} (f : P ⟶ Q) (g : Q ⟶ R) /-- The composition of two strong epimorphisms is a strong epimorphism. -/ lemma strong_epi_comp [strong_epi f] [strong_epi g] : strong_epi (f ≫ g) := { epi := epi_comp _ _, - has_lift := - begin - introsI, - have h₀ : u ≫ z = f ≫ g ≫ v, by simpa [category.assoc] using h, - let w : Q ⟶ X := arrow.lift (arrow.hom_mk' h₀), - have h₁ : w ≫ z = g ≫ v, by rw arrow.lift_mk'_right, - exact arrow.has_lift.mk ⟨(arrow.lift (arrow.hom_mk' h₁) : R ⟶ X), by simp, by simp⟩ - end } + llp := by { introsI, apply_instance, }, } /-- The composition of two strong monomorphisms is a strong monomorphism. -/ lemma strong_mono_comp [strong_mono f] [strong_mono g] : strong_mono (f ≫ g) := { mono := mono_comp _ _, - has_lift := - begin - introsI, - have h₀ : (u ≫ f) ≫ g = z ≫ v, by simpa [category.assoc] using h, - let w : Y ⟶ Q := arrow.lift (arrow.hom_mk' h₀), - have h₁ : u ≫ f = z ≫ w, by rw arrow.lift_mk'_left, - exact arrow.has_lift.mk ⟨(arrow.lift (arrow.hom_mk' h₁) : Y ⟶ P), by simp, by simp⟩ - end } + rlp := by { introsI, apply_instance, }, } /-- If `f ≫ g` is a strong epimorphism, then so is `g`. -/ lemma strong_epi_of_strong_epi [strong_epi (f ≫ g)] : strong_epi g := { epi := epi_of_epi f g, - has_lift := - begin + llp := begin introsI, - have h₀ : (f ≫ u) ≫ z = (f ≫ g) ≫ v, by simp only [category.assoc, h], - exact arrow.has_lift.mk - ⟨(arrow.lift (arrow.hom_mk' h₀) : R ⟶ X), (cancel_mono z).1 (by simp [h]), by simp⟩, - end } + constructor, + intros u v sq, + have h₀ : (f ≫ u) ≫ z = (f ≫ g) ≫ v, by simp only [category.assoc, sq.w], + exact comm_sq.has_lift.mk' ⟨(comm_sq.mk h₀).lift, + by simp only [← cancel_mono z, category.assoc, comm_sq.fac_right, sq.w], by simp⟩, + end, } /-- If `f ≫ g` is a strong monomorphism, then so is `f`. -/ lemma strong_mono_of_strong_mono [strong_mono (f ≫ g)] : strong_mono f := { mono := mono_of_mono f g, - has_lift := - begin + rlp := begin introsI, - have h₀ : u ≫ f ≫ g = z ≫ v ≫ g, by rw reassoc_of h, - exact arrow.has_lift.mk - ⟨(arrow.lift (arrow.hom_mk' h₀) : Y ⟶ P), by simp, (cancel_epi z).1 (by simp [h])⟩ - end } + constructor, + intros u v sq, + have h₀ : u ≫ f ≫ g = z ≫ v ≫ g, by rw reassoc_of sq.w, + exact comm_sq.has_lift.mk' ⟨(comm_sq.mk h₀).lift, by simp, by simp [← cancel_epi z, sq.w]⟩, + end, } /-- An isomorphism is in particular a strong epimorphism. -/ @[priority 100] instance strong_epi_of_is_iso [is_iso f] : strong_epi f := { epi := by apply_instance, - has_lift := λ X Y u v z _ h, arrow.has_lift.mk ⟨inv f ≫ u, by simp, by simp [h]⟩ } + llp := λ X Y z hz, has_lifting_property.of_left_iso _ _, } /-- An isomorphism is in particular a strong monomorphism. -/ @[priority 100] instance strong_mono_of_is_iso [is_iso f] : strong_mono f := { mono := by apply_instance, - has_lift := λ X Y u v z _ h, arrow.has_lift.mk - ⟨v ≫ inv f, by simp [← category.assoc, ← h], by simp⟩ } + rlp := λ X Y z hz, has_lifting_property.of_right_iso _ _, } + +lemma strong_epi.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'} + (e : arrow.mk f ≅ arrow.mk g) [h : strong_epi f] : strong_epi g := +{ epi := begin + rw arrow.iso_w' e, + haveI := epi_comp f e.hom.right, + apply epi_comp, + end, + llp := λ X Y z, by { introI, apply has_lifting_property.of_arrow_iso_left e z, }, } + +lemma strong_mono.of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'} + (e : arrow.mk f ≅ arrow.mk g) [h : strong_mono f] : strong_mono g := +{ mono := begin + rw arrow.iso_w' e, + haveI := mono_comp f e.hom.right, + apply mono_comp, + end, + rlp := λ X Y z, by { introI, apply has_lifting_property.of_arrow_iso_right z e, }, } + +lemma strong_epi.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'} + (e : arrow.mk f ≅ arrow.mk g) : strong_epi f ↔ strong_epi g := +by { split; introI, exacts [strong_epi.of_arrow_iso e, strong_epi.of_arrow_iso e.symm], } + +lemma strong_mono.iff_of_arrow_iso {A B A' B' : C} {f : A ⟶ B} {g : A' ⟶ B'} + (e : arrow.mk f ≅ arrow.mk g) : strong_mono f ↔ strong_mono g := +by { split; introI, exacts [strong_mono.of_arrow_iso e, strong_mono.of_arrow_iso e.symm], } end /-- A strong epimorphism that is a monomorphism is an isomorphism. -/ lemma is_iso_of_mono_of_strong_epi (f : P ⟶ Q) [mono f] [strong_epi f] : is_iso f := -⟨⟨arrow.lift $ arrow.hom_mk' $ show 𝟙 P ≫ f = f ≫ 𝟙 Q, by simp, by tidy⟩⟩ +⟨⟨(comm_sq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q, by simp)).lift, by tidy⟩⟩ /-- A strong monomorphism that is an epimorphism is an isomorphism. -/ lemma is_iso_of_epi_of_strong_mono (f : P ⟶ Q) [epi f] [strong_mono f] : is_iso f := -⟨⟨arrow.lift $ arrow.hom_mk' $ show 𝟙 P ≫ f = f ≫ 𝟙 Q, by simp, by tidy⟩⟩ +⟨⟨(comm_sq.mk (show 𝟙 P ≫ f = f ≫ 𝟙 Q, by simp)).lift, by tidy⟩⟩ section variables (C) diff --git a/src/category_theory/limits/shapes/terminal.lean b/src/category_theory/limits/shapes/terminal.lean index c15698b68ceac..ac1431866c03b 100644 --- a/src/category_theory/limits/shapes/terminal.lean +++ b/src/category_theory/limits/shapes/terminal.lean @@ -11,6 +11,9 @@ import category_theory.category.preorder /-! # Initial and terminal objects in a category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## References * [Stacks: Initial and final objects](https://stacks.math.columbia.edu/tag/002B) -/ @@ -25,18 +28,20 @@ namespace category_theory.limits variables {C : Type u₁} [category.{v₁} C] +local attribute [tidy] tactic.discrete_cases + /-- Construct a cone for the empty diagram given an object. -/ -@[simps] def as_empty_cone (X : C) : cone (functor.empty.{w} C) := { X := X, π := by tidy } +@[simps] def as_empty_cone (X : C) : cone (functor.empty.{0} C) := { X := X, π := by tidy } /-- Construct a cocone for the empty diagram given an object. -/ -@[simps] def as_empty_cocone (X : C) : cocone (functor.empty.{w} C) := { X := X, ι := by tidy } +@[simps] def as_empty_cocone (X : C) : cocone (functor.empty.{0} C) := { X := X, ι := by tidy } /-- `X` is terminal if the cone it induces on the empty diagram is limiting. -/ -abbreviation is_terminal (X : C) := is_limit (as_empty_cone.{v₁} X) +abbreviation is_terminal (X : C) := is_limit (as_empty_cone X) /-- `X` is initial if the cocone it induces on the empty diagram is colimiting. -/ -abbreviation is_initial (X : C) := is_colimit (as_empty_cocone.{v₁} X) +abbreviation is_initial (X : C) := is_colimit (as_empty_cocone X) /-- An object `Y` is terminal iff for every `X` there is a unique morphism `X ⟶ Y`. -/ -def is_terminal_equiv_unique (F : discrete.{v₁} pempty ⥤ C) (Y : C) : +def is_terminal_equiv_unique (F : discrete.{0} pempty.{1} ⥤ C) (Y : C) : is_limit (⟨Y, by tidy⟩ : cone F) ≃ ∀ X : C, unique (X ⟶ Y) := { to_fun := λ t X, { default := t.lift ⟨X, by tidy⟩, uniq := λ f, t.uniq ⟨X, by tidy⟩ f (by tidy) }, @@ -60,7 +65,7 @@ is_limit.of_iso_limit hY inv := { hom := i.inv } } /-- An object `X` is initial iff for every `Y` there is a unique morphism `X ⟶ Y`. -/ -def is_initial_equiv_unique (F : discrete.{v₁} pempty ⥤ C) (X : C) : +def is_initial_equiv_unique (F : discrete.{0} pempty.{1} ⥤ C) (X : C) : is_colimit (⟨X, by tidy⟩ : cocone F) ≃ ∀ Y : C, unique (X ⟶ Y) := { to_fun := λ t X, { default := t.desc ⟨X, by tidy⟩, uniq := λ f, t.uniq ⟨X, by tidy⟩ f (by tidy) }, @@ -114,20 +119,20 @@ t.hom_ext _ _ t.hom_ext _ _ /-- Any morphism from a terminal object is split mono. -/ -def is_terminal.split_mono_from {X Y : C} (t : is_terminal X) (f : X ⟶ Y) : split_mono f := -⟨t.from _, t.hom_ext _ _⟩ +lemma is_terminal.is_split_mono_from {X Y : C} (t : is_terminal X) (f : X ⟶ Y) : + is_split_mono f := is_split_mono.mk' ⟨t.from _, t.hom_ext _ _⟩ /-- Any morphism to an initial object is split epi. -/ -def is_initial.split_epi_to {X Y : C} (t : is_initial X) (f : Y ⟶ X) : split_epi f := -⟨t.to _, t.hom_ext _ _⟩ +lemma is_initial.is_split_epi_to {X Y : C} (t : is_initial X) (f : Y ⟶ X) : + is_split_epi f := is_split_epi.mk' ⟨t.to _, t.hom_ext _ _⟩ /-- Any morphism from a terminal object is mono. -/ lemma is_terminal.mono_from {X Y : C} (t : is_terminal X) (f : X ⟶ Y) : mono f := -by haveI := t.split_mono_from f; apply_instance +by haveI := t.is_split_mono_from f; apply_instance /-- Any morphism to an initial object is epi. -/ lemma is_initial.epi_to {X Y : C} (t : is_initial X) (f : Y ⟶ X) : epi f := -by haveI := t.split_epi_to f; apply_instance +by haveI := t.is_split_epi_to f; apply_instance /-- If `T` and `T'` are terminal, they are isomorphic. -/ @[simps] @@ -147,12 +152,12 @@ variable (C) A category has a terminal object if it has a limit over the empty diagram. Use `has_terminal_of_unique` to construct instances. -/ -abbreviation has_terminal := has_limits_of_shape (discrete.{v₁} pempty) C +abbreviation has_terminal := has_limits_of_shape (discrete.{0} pempty) C /-- A category has an initial object if it has a colimit over the empty diagram. Use `has_initial_of_unique` to construct instances. -/ -abbreviation has_initial := has_colimits_of_shape (discrete.{v₁} pempty) C +abbreviation has_initial := has_colimits_of_shape (discrete.{0} pempty) C section univ @@ -163,8 +168,8 @@ variables (X : C) {F₁ : discrete.{w} pempty ⥤ C} {F₂ : discrete.{w'} pempt def is_limit_change_empty_cone {c₁ : cone F₁} (hl : is_limit c₁) (c₂ : cone F₂) (hi : c₁.X ≅ c₂.X) : is_limit c₂ := { lift := λ c, hl.lift ⟨c.X, by tidy⟩ ≫ hi.hom, - fac' := λ _ j, j.elim, - uniq' := λ c f _, by { erw ← hl.uniq ⟨c.X, by tidy⟩ (f ≫ hi.inv) (λ j, j.elim), simp } } + fac' := λ _ j, j.as.elim, + uniq' := λ c f _, by { erw ← hl.uniq ⟨c.X, by tidy⟩ (f ≫ hi.inv) (λ j, j.as.elim), simp } } /-- Replacing an empty cone in `is_limit` by another with the same cone point is an equivalence. -/ @@ -187,8 +192,8 @@ lemma has_terminal_change_universe [h : has_limits_of_shape (discrete.{w} pempty def is_colimit_change_empty_cocone {c₁ : cocone F₁} (hl : is_colimit c₁) (c₂ : cocone F₂) (hi : c₁.X ≅ c₂.X) : is_colimit c₂ := { desc := λ c, hi.inv ≫ hl.desc ⟨c.X, by tidy⟩, - fac' := λ _ j, j.elim, - uniq' := λ c f _, by { erw ← hl.uniq ⟨c.X, by tidy⟩ (hi.hom ≫ f) (λ j, j.elim), simp } } + fac' := λ _ j, j.as.elim, + uniq' := λ c f _, by { erw ← hl.uniq ⟨c.X, by tidy⟩ (hi.hom ≫ f) (λ j, j.as.elim), simp } } /-- Replacing an empty cocone in `is_colimit` by another with the same cocone point is an equivalence. -/ @@ -214,13 +219,13 @@ An arbitrary choice of terminal object, if one exists. You can use the notation `⊤_ C`. This object is characterized by having a unique morphism from any object. -/ -abbreviation terminal [has_terminal C] : C := limit (functor.empty.{v₁} C) +abbreviation terminal [has_terminal C] : C := limit (functor.empty.{0} C) /-- An arbitrary choice of initial object, if one exists. You can use the notation `⊥_ C`. This object is characterized by having a unique morphism to any object. -/ -abbreviation initial [has_initial C] : C := colimit (functor.empty.{v₁} C) +abbreviation initial [has_initial C] : C := colimit (functor.empty.{0} C) notation `⊤_ ` C:20 := terminal C notation `⊥_ ` C:20 := initial C @@ -233,11 +238,18 @@ and showing there is a unique morphism to it from any other object. -/ lemma has_terminal_of_unique (X : C) [h : Π Y : C, unique (Y ⟶ X)] : has_terminal C := { has_limit := λ F, has_limit.mk ⟨_, (is_terminal_equiv_unique F X).inv_fun h⟩ } +lemma is_terminal.has_terminal {X : C} (h : is_terminal X) : has_terminal C := +{ has_limit := λ F, has_limit.mk ⟨⟨X, by tidy⟩, is_limit_change_empty_cone _ h _ (iso.refl _)⟩ } + /-- We can more explicitly show that a category has an initial object by specifying the object, and showing there is a unique morphism from it to any other object. -/ lemma has_initial_of_unique (X : C) [h : Π Y : C, unique (X ⟶ Y)] : has_initial C := { has_colimit := λ F, has_colimit.mk ⟨_, (is_initial_equiv_unique F X).inv_fun h⟩ } +lemma is_initial.has_initial {X : C} (h : is_initial X) : has_initial C := +{ has_colimit := λ F, has_colimit.mk + ⟨⟨X, by tidy⟩, is_colimit_change_empty_cocone _ h _ (iso.refl _)⟩ } + /-- The map from an object to the terminal object. -/ abbreviation terminal.from [has_terminal C] (P : C) : P ⟶ ⊤_ C := limit.lift (functor.empty C) (as_empty_cone P) @@ -275,12 +287,12 @@ initial_is_initial.unique_up_to_iso t terminal_is_terminal.unique_up_to_iso t /-- Any morphism from a terminal object is split mono. -/ -instance terminal.split_mono_from {Y : C} [has_terminal C] (f : ⊤_ C ⟶ Y) : split_mono f := -is_terminal.split_mono_from terminal_is_terminal _ +instance terminal.is_split_mono_from {Y : C} [has_terminal C] (f : ⊤_ C ⟶ Y) : is_split_mono f := +is_terminal.is_split_mono_from terminal_is_terminal _ /-- Any morphism to an initial object is split epi. -/ -instance initial.split_epi_to {Y : C} [has_initial C] (f : Y ⟶ ⊥_ C) : split_epi f := -is_initial.split_epi_to initial_is_initial _ +instance initial.is_split_epi_to {Y : C} [has_initial C] (f : Y ⟶ ⊥_ C) : is_split_epi f := +is_initial.is_split_epi_to initial_is_initial _ /-- An initial object is terminal in the opposite category. -/ def terminal_op_of_initial {X : C} (t : is_initial X) : is_terminal (opposite.op X) := @@ -302,6 +314,18 @@ def initial_unop_of_terminal {X : Cᵒᵖ} (t : is_terminal X) : is_initial X.un { desc := λ s, (t.from (opposite.op s.X)).unop, uniq' := λ s m w, quiver.hom.op_inj (t.hom_ext _ _) } +instance has_initial_op_of_has_terminal [has_terminal C] : has_initial Cᵒᵖ := +(initial_op_of_terminal terminal_is_terminal).has_initial + +instance has_terminal_op_of_has_initial [has_initial C] : has_terminal Cᵒᵖ := +(terminal_op_of_initial initial_is_initial).has_terminal + +lemma has_terminal_of_has_initial_op [has_initial Cᵒᵖ] : has_terminal C := +(terminal_unop_of_initial initial_is_initial).has_terminal + +lemma has_initial_of_has_terminal_op [has_terminal Cᵒᵖ] : has_initial C := +(initial_unop_of_terminal terminal_is_terminal).has_initial + instance {J : Type*} [category J] {C : Type*} [category C] [has_terminal C] : has_limit ((category_theory.functor.const J).obj (⊤_ C)) := has_limit.mk @@ -323,7 +347,7 @@ def limit_const_terminal {J : Type*} [category J] {C : Type*} [category C] [has_ {J : Type*} [category J] {C : Type*} [category C] [has_terminal C] {j : J} : limit_const_terminal.inv ≫ limit.π ((category_theory.functor.const J).obj (⊤_ C)) j = terminal.from _ := -by ext ⟨⟩ +by ext ⟨⟨⟩⟩ instance {J : Type*} [category J] {C : Type*} [category C] [has_initial C] : has_colimit ((category_theory.functor.const J).obj (⊥_ C)) := @@ -346,7 +370,7 @@ def colimit_const_initial {J : Type*} [category J] {C : Type*} [category C] [has {J : Type*} [category J] {C : Type*} [category C] [has_initial C] {j : J} : colimit.ι ((category_theory.functor.const J).obj (⊥_ C)) j ≫ colimit_const_initial.hom = initial.to _ := -by ext ⟨⟩ +by ext ⟨⟨⟩⟩ /-- A category is a `initial_mono_class` if the canonical morphism of an initial object is a monomorphism. In practice, this is most useful when given an arbitrary morphism out of the chosen diff --git a/src/category_theory/limits/shapes/types.lean b/src/category_theory/limits/shapes/types.lean index 95c68a53e2b69..4666f03ce1a24 100644 --- a/src/category_theory/limits/shapes/types.lean +++ b/src/category_theory/limits/shapes/types.lean @@ -7,11 +7,15 @@ import category_theory.limits.types import category_theory.limits.shapes.products import category_theory.limits.shapes.binary_products import category_theory.limits.shapes.terminal +import category_theory.concrete_category.basic import tactic.elementwise /-! # Special shapes for limits in `Type`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The general shape (co)limits defined in `category_theory.limits.types` are intended for use through the limits API, and the actual implementation should mostly be considered "sealed". @@ -35,19 +39,21 @@ As an example, when setting up the monoidal category structure on `Type` we use the `types_has_terminal` and `types_has_binary_products` instances. -/ -universes u +universes u v open category_theory open category_theory.limits namespace category_theory.limits.types +local attribute [tidy] tactic.discrete_cases + /-- A restatement of `types.lift_π_apply` that uses `pi.π` and `pi.lift`. -/ @[simp] lemma pi_lift_π_apply {β : Type u} (f : β → Type u) {P : Type u} (s : Π b, P ⟶ f b) (b : β) (x : P) : (pi.π f b : (∏ f) → f b) (@pi.lift β _ _ f _ P s x) = s b x := -congr_fun (limit.lift_π (fan.mk P s) b) x +congr_fun (limit.lift_π (fan.mk P s) ⟨b⟩) x /-- A restatement of `types.map_π_apply` that uses `pi.π` and `pi.map`. -/ @[simp] @@ -66,6 +72,11 @@ def terminal_limit_cone : limits.limit_cone (functor.empty (Type u)) := noncomputable def terminal_iso : ⊤_ (Type u) ≅ punit := limit.iso_limit_cone terminal_limit_cone +/-- The terminal object in `Type u` is `punit`. -/ +noncomputable +def is_terminal_punit : is_terminal (punit : Type u) := +terminal_is_terminal.of_iso terminal_iso + /-- The category of types has `pempty` as an initial object. -/ def initial_colimit_cocone : limits.colimit_cocone (functor.empty (Type u)) := { cocone := @@ -73,10 +84,15 @@ def initial_colimit_cocone : limits.colimit_cocone (functor.empty (Type u)) := ι := by tidy, }, is_colimit := by tidy, } -/-- The initial object in `Type u` is `punit`. -/ +/-- The initial object in `Type u` is `pempty`. -/ noncomputable def initial_iso : ⊥_ (Type u) ≅ pempty := colimit.iso_colimit_cocone initial_colimit_cocone +/-- The initial object in `Type u` is `pempty`. -/ +noncomputable +def is_initial_punit : is_initial (pempty : Type u) := +initial_is_initial.of_iso initial_iso + open category_theory.limits.walking_pair /-- The product type `X × Y` forms a cone for the binary product of `X` and `Y`. -/ @@ -99,8 +115,8 @@ rfl @[simps] def binary_product_limit (X Y : Type u) : is_limit (binary_product_cone X Y) := { lift := λ (s : binary_fan X Y) x, (s.fst x, s.snd x), - fac' := λ s j, walking_pair.cases_on j rfl rfl, - uniq' := λ s m w, funext $ λ x, prod.ext (congr_fun (w left) x) (congr_fun (w right) x) } + fac' := λ s j, discrete.rec_on j (λ j, walking_pair.cases_on j rfl rfl), + uniq' := λ s m w, funext $ λ x, prod.ext (congr_fun (w ⟨left⟩) x) (congr_fun (w ⟨right⟩) x) } /-- The category of types has `X × Y`, the usual cartesian product, @@ -116,19 +132,19 @@ limit.iso_limit_cone (binary_product_limit_cone X Y) @[simp, elementwise] lemma binary_product_iso_hom_comp_fst (X Y : Type u) : (binary_product_iso X Y).hom ≫ prod.fst = limits.prod.fst := -limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) walking_pair.left +limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) ⟨walking_pair.left⟩ @[simp, elementwise] lemma binary_product_iso_hom_comp_snd (X Y : Type u) : (binary_product_iso X Y).hom ≫ prod.snd = limits.prod.snd := -limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) walking_pair.right +limit.iso_limit_cone_hom_π (binary_product_limit_cone X Y) ⟨walking_pair.right⟩ @[simp, elementwise] lemma binary_product_iso_inv_comp_fst (X Y : Type u) : (binary_product_iso X Y).inv ≫ limits.prod.fst = prod.fst := -limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) walking_pair.left +limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) ⟨walking_pair.left⟩ @[simp, elementwise] lemma binary_product_iso_inv_comp_snd (X Y : Type u) : (binary_product_iso X Y).inv ≫ limits.prod.snd = prod.snd := -limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) walking_pair.right +limit.iso_limit_cone_inv_π (binary_product_limit_cone X Y) ⟨walking_pair.right⟩ /-- The functor which sends `X, Y` to the product type `X × Y`. -/ -- We add the option `type_md` to tell `@[simps]` to not treat homomorphisms `X ⟶ Y` in `Type*` as @@ -167,8 +183,8 @@ binary_cofan.mk sum.inl sum.inr @[simps] def binary_coproduct_colimit (X Y : Type u) : is_colimit (binary_coproduct_cocone X Y) := { desc := λ (s : binary_cofan X Y), sum.elim s.inl s.inr, - fac' := λ s j, walking_pair.cases_on j rfl rfl, - uniq' := λ s m w, funext $ λ x, sum.cases_on x (congr_fun (w left)) (congr_fun (w right)) } + fac' := λ s j, discrete.rec_on j (λ j, walking_pair.cases_on j rfl rfl), + uniq' := λ s m w, funext $ λ x, sum.cases_on x (congr_fun (w ⟨left⟩)) (congr_fun (w ⟨right⟩)) } /-- The category of types has `X ⊕ Y`, @@ -185,42 +201,93 @@ open_locale category_theory.Type @[simp, elementwise] lemma binary_coproduct_iso_inl_comp_hom (X Y : Type u) : limits.coprod.inl ≫ (binary_coproduct_iso X Y).hom = sum.inl := -colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) walking_pair.left +colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.left⟩ @[simp, elementwise] lemma binary_coproduct_iso_inr_comp_hom (X Y : Type u) : limits.coprod.inr ≫ (binary_coproduct_iso X Y).hom = sum.inr := -colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) walking_pair.right +colimit.iso_colimit_cocone_ι_hom (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.right⟩ @[simp, elementwise] lemma binary_coproduct_iso_inl_comp_inv (X Y : Type u) : ↾(sum.inl : X ⟶ X ⊕ Y) ≫ (binary_coproduct_iso X Y).inv = limits.coprod.inl := -colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) walking_pair.left +colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.left⟩ @[simp, elementwise] lemma binary_coproduct_iso_inr_comp_inv (X Y : Type u) : ↾(sum.inr : Y ⟶ X ⊕ Y) ≫ (binary_coproduct_iso X Y).inv = limits.coprod.inr := -colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) walking_pair.right +colimit.iso_colimit_cocone_ι_inv (binary_coproduct_colimit_cocone X Y) ⟨walking_pair.right⟩ + +open function (injective) + +lemma binary_cofan_is_colimit_iff {X Y : Type u} (c : binary_cofan X Y) : + nonempty (is_colimit c) ↔ + injective c.inl ∧ injective c.inr ∧ is_compl (set.range c.inl) (set.range c.inr) := +begin + classical, + split, + { rintro ⟨h⟩, + rw [← show _ = c.inl, from h.comp_cocone_point_unique_up_to_iso_inv + (binary_coproduct_colimit X Y) ⟨walking_pair.left⟩, + ← show _ = c.inr, from h.comp_cocone_point_unique_up_to_iso_inv + (binary_coproduct_colimit X Y) ⟨walking_pair.right⟩], + dsimp [binary_coproduct_cocone], + refine + ⟨(h.cocone_point_unique_up_to_iso (binary_coproduct_colimit X Y)).symm.to_equiv.injective.comp + sum.inl_injective, (h.cocone_point_unique_up_to_iso (binary_coproduct_colimit X Y)).symm + .to_equiv.injective.comp sum.inr_injective, _⟩, + erw [set.range_comp, ← eq_compl_iff_is_compl, set.range_comp _ sum.inr, ← set.image_compl_eq + (h.cocone_point_unique_up_to_iso (binary_coproduct_colimit X Y)).symm.to_equiv.bijective], + congr' 1, + exact set.compl_range_inr.symm }, + { rintros ⟨h₁, h₂, h₃⟩, + have : ∀ x, x ∈ set.range c.inl ∨ x ∈ set.range c.inr, + { rw [eq_compl_iff_is_compl.mpr h₃.symm], exact λ _, or_not }, + refine ⟨binary_cofan.is_colimit.mk _ _ _ _ _⟩, + { intros T f g x, + exact if h : x ∈ set.range c.inl + then f ((equiv.of_injective _ h₁).symm ⟨x, h⟩) + else g ((equiv.of_injective _ h₂).symm ⟨x, (this x).resolve_left h⟩) }, + { intros T f g, ext x, dsimp, simp [h₁.eq_iff] }, + { intros T f g, ext x, dsimp, + simp only [forall_exists_index, equiv.of_injective_symm_apply, + dif_ctx_congr, dite_eq_right_iff], + intros y e, + have : c.inr x ∈ set.range c.inl ⊓ set.range c.inr := ⟨⟨_, e⟩, ⟨_, rfl⟩⟩, + rw disjoint_iff.mp h₃.1 at this, + exact this.elim }, + { rintro T _ _ m rfl rfl, ext x, dsimp, + split_ifs; exact congr_arg _ (equiv.apply_of_injective_symm _ ⟨_, _⟩).symm } } +end + +/-- Any monomorphism in `Type` is an coproduct injection. -/ +noncomputable +def is_coprod_of_mono {X Y : Type u} (f : X ⟶ Y) [mono f] : + is_colimit (binary_cofan.mk f (subtype.val : (set.range f)ᶜ → Y)) := +nonempty.some $ (binary_cofan_is_colimit_iff _).mpr + ⟨(mono_iff_injective f).mp infer_instance, subtype.val_injective, + (eq_compl_iff_is_compl.mp $ subtype.range_val).symm⟩ /-- The category of types has `Π j, f j` as the product of a type family `f : J → Type`. -/ -def product_limit_cone {J : Type u} (F : J → Type u) : limits.limit_cone (discrete.functor F) := +def product_limit_cone {J : Type u} (F : J → Type (max u v)) : + limits.limit_cone (discrete.functor F) := { cone := { X := Π j, F j, - π := { app := λ j f, f j }, }, + π := { app := λ j f, f j.as }, }, is_limit := - { lift := λ s x j, s.π.app j x, - uniq' := λ s m w, funext $ λ x, funext $ λ j, (congr_fun (w j) x : _) } } + { lift := λ s x j, s.π.app ⟨j⟩ x, + uniq' := λ s m w, funext $ λ x, funext $ λ j, (congr_fun (w ⟨j⟩) x : _) } } /-- The categorical product in `Type u` is the type theoretic product `Π j, F j`. -/ -noncomputable def product_iso {J : Type u} (F : J → Type u) : ∏ F ≅ Π j, F j := +noncomputable def product_iso {J : Type u} (F : J → Type (max u v)) : ∏ F ≅ Π j, F j := limit.iso_limit_cone (product_limit_cone F) -@[simp, elementwise] lemma product_iso_hom_comp_eval {J : Type u} (F : J → Type u) (j : J) : +@[simp, elementwise] lemma product_iso_hom_comp_eval {J : Type u} (F : J → Type (max u v)) (j : J) : (product_iso F).hom ≫ (λ f, f j) = pi.π F j := rfl -@[simp, elementwise] lemma product_iso_inv_comp_π {J : Type u} (F : J → Type u) (j : J) : +@[simp, elementwise] lemma product_iso_inv_comp_π {J : Type u} (F : J → Type (max u v)) (j : J) : (product_iso F).inv ≫ pi.π F j = (λ f, f j) := -limit.iso_limit_cone_inv_π (product_limit_cone F) j +limit.iso_limit_cone_inv_π (product_limit_cone F) ⟨j⟩ /-- The category of types has `Σ j, f j` as the coproduct of a type family `f : J → Type`. @@ -230,13 +297,13 @@ def coproduct_colimit_cocone {J : Type u} (F : J → Type u) : { cocone := { X := Σ j, F j, ι := - { app := λ j x, ⟨j, x⟩ }, }, + { app := λ j x, ⟨j.as, x⟩ }, }, is_colimit := - { desc := λ s x, s.ι.app x.1 x.2, + { desc := λ s x, s.ι.app ⟨x.1⟩ x.2, uniq' := λ s m w, begin ext ⟨j, x⟩, - have := congr_fun (w j) x, + have := congr_fun (w ⟨j⟩) x, exact this, end }, } @@ -246,7 +313,7 @@ colimit.iso_colimit_cocone (coproduct_colimit_cocone F) @[simp, elementwise] lemma coproduct_iso_ι_comp_hom {J : Type u} (F : J → Type u) (j : J) : sigma.ι F j ≫ (coproduct_iso F).hom = (λ x : F j, (⟨j, x⟩ : Σ j, F j)) := -colimit.iso_colimit_cocone_ι_hom (coproduct_colimit_cocone F) j +colimit.iso_colimit_cocone_ι_hom (coproduct_colimit_cocone F) ⟨j⟩ @[simp, elementwise] lemma coproduct_iso_mk_comp_inv {J : Type u} (F : J → Type u) (j : J) : ↾(λ x : F j, (⟨j, x⟩ : Σ j, F j)) ≫ (coproduct_iso F).inv = sigma.ι F j := @@ -386,7 +453,7 @@ variables (f : X ⟶ Z) (g : Y ⟶ Z) The usual explicit pullback in the category of types, as a subtype of the product. The full `limit_cone` data is bundled as `pullback_limit_cone f g`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] abbreviation pullback_obj : Type u := { p : X × Y // f p.1 = g p.2 } -- `pullback_obj f g` comes with a coercion to the product type `X × Y`. diff --git a/src/category_theory/limits/shapes/wide_equalizers.lean b/src/category_theory/limits/shapes/wide_equalizers.lean index 552590841f463..1ffed64a6845c 100644 --- a/src/category_theory/limits/shapes/wide_equalizers.lean +++ b/src/category_theory/limits/shapes/wide_equalizers.lean @@ -3,13 +3,15 @@ Copyright (c) 2021 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ -import category_theory.epi_mono import category_theory.limits.has_limits import category_theory.limits.shapes.equalizers /-! # Wide equalizers and wide coequalizers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines wide (co)equalizers as special cases of (co)limits. A wide equalizer for the family of morphisms `X ⟶ Y` indexed by `J` is the categorical @@ -50,12 +52,12 @@ namespace category_theory.limits open category_theory -universes v u u₂ +universes w v u u₂ -variables {J : Type v} +variables {J : Type w} /-- The type of objects for the diagram indexing a wide (co)equalizer. -/ -inductive walking_parallel_family (J : Type v) : Type v +inductive walking_parallel_family (J : Type w) : Type w | zero : walking_parallel_family | one : walking_parallel_family @@ -70,9 +72,9 @@ instance : decidable_eq (walking_parallel_family J) instance : inhabited (walking_parallel_family J) := ⟨zero⟩ /-- The type family of morphisms for the diagram indexing a wide (co)equalizer. -/ -@[derive decidable_eq] inductive walking_parallel_family.hom (J : Type v) : - walking_parallel_family J → walking_parallel_family J → Type v -| id : Π X : walking_parallel_family.{v} J, walking_parallel_family.hom X X +@[derive decidable_eq] inductive walking_parallel_family.hom (J : Type w) : + walking_parallel_family J → walking_parallel_family J → Type w +| id : Π X : walking_parallel_family.{w} J, walking_parallel_family.hom X X | line : Π (j : J), walking_parallel_family.hom zero one /-- Satisfying the inhabited linter -/ @@ -136,7 +138,7 @@ nat_iso.of_components (λ j, eq_to_iso $ by cases j; tidy) $ by tidy `walking_parallel_family`. -/ @[simps] def walking_parallel_family_equiv_walking_parallel_pair : - walking_parallel_family.{v} (ulift bool) ≌ walking_parallel_pair.{v} := + walking_parallel_family.{w} (ulift bool) ≌ walking_parallel_pair := { functor := parallel_family (λ p, cond p.down walking_parallel_pair_hom.left walking_parallel_pair_hom.right), inverse := parallel_pair (line (ulift.up tt)) (line (ulift.up ff)), @@ -624,27 +626,30 @@ end variables (C) /-- `has_wide_equalizers` represents a choice of wide equalizer for every family of morphisms -/ -abbreviation has_wide_equalizers := Π J, has_limits_of_shape (walking_parallel_family.{v} J) C +abbreviation has_wide_equalizers := Π J, has_limits_of_shape (walking_parallel_family.{w} J) C /-- `has_wide_coequalizers` represents a choice of wide coequalizer for every family of morphisms -/ -abbreviation has_wide_coequalizers := Π J, has_colimits_of_shape (walking_parallel_family.{v} J) C +abbreviation has_wide_coequalizers := Π J, has_colimits_of_shape (walking_parallel_family.{w} J) C /-- If `C` has all limits of diagrams `parallel_family f`, then it has all wide equalizers -/ lemma has_wide_equalizers_of_has_limit_parallel_family - [Π {J} {X Y : C} {f : J → (X ⟶ Y)}, has_limit (parallel_family f)] : has_wide_equalizers C := + [Π {J : Type w} {X Y : C} {f : J → (X ⟶ Y)}, has_limit (parallel_family f)] : + has_wide_equalizers.{w} C := λ J, { has_limit := λ F, has_limit_of_iso (diagram_iso_parallel_family F).symm } /-- If `C` has all colimits of diagrams `parallel_family f`, then it has all wide coequalizers -/ lemma has_wide_coequalizers_of_has_colimit_parallel_family - [Π {J} {X Y : C} {f : J → (X ⟶ Y)}, has_colimit (parallel_family f)] : has_wide_coequalizers C := + [Π {J : Type w} {X Y : C} {f : J → (X ⟶ Y)}, has_colimit (parallel_family f)] : + has_wide_coequalizers.{w} C := λ J, { has_colimit := λ F, has_colimit_of_iso (diagram_iso_parallel_family F) } @[priority 10] -instance has_equalizers_of_has_wide_equalizers [has_wide_equalizers C] : has_equalizers C := -has_limits_of_shape_of_equivalence walking_parallel_family_equiv_walking_parallel_pair +instance has_equalizers_of_has_wide_equalizers [has_wide_equalizers.{w} C] : has_equalizers C := +has_limits_of_shape_of_equivalence.{w} walking_parallel_family_equiv_walking_parallel_pair @[priority 10] -instance has_coequalizers_of_has_wide_coequalizers [has_wide_coequalizers C] : has_coequalizers C := -has_colimits_of_shape_of_equivalence walking_parallel_family_equiv_walking_parallel_pair +instance has_coequalizers_of_has_wide_coequalizers [has_wide_coequalizers.{w} C] : + has_coequalizers C := +has_colimits_of_shape_of_equivalence.{w} walking_parallel_family_equiv_walking_parallel_pair end category_theory.limits diff --git a/src/category_theory/limits/shapes/wide_pullbacks.lean b/src/category_theory/limits/shapes/wide_pullbacks.lean index b2183b92546df..03cec603eb75f 100644 --- a/src/category_theory/limits/shapes/wide_pullbacks.lean +++ b/src/category_theory/limits/shapes/wide_pullbacks.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Bhavik Mehta +Authors: Bhavik Mehta, Jakob von Raumer -/ import category_theory.limits.has_limits import category_theory.thin @@ -9,6 +9,9 @@ import category_theory.thin /-! # Wide pullbacks +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the category `wide_pullback_shape`, (resp. `wide_pushout_shape`) which is the category obtained from a discrete category of type `J` by adjoining a terminal (resp. initial) element. Limits of this shape are wide pullbacks (pushouts). @@ -24,13 +27,13 @@ Typeclasses `has_wide_pullbacks` and `has_finite_wide_pullbacks` assert the exis pullbacks and finite wide pullbacks. -/ -universes v u +universes w w' v u open category_theory category_theory.limits opposite namespace category_theory.limits -variable (J : Type v) +variable (J : Type w) /-- A wide pullback shape for any type `J` can be written simply as `option J`. -/ @[derive inhabited] @@ -46,7 +49,7 @@ variable {J} /-- The type of arrows for the shape indexing a wide pullback. -/ @[derive decidable_eq] -inductive hom : wide_pullback_shape J → wide_pullback_shape J → Type v +inductive hom : wide_pullback_shape J → wide_pullback_shape J → Type w | id : Π X, hom X X | term : Π (j : J), hom (some j) none @@ -67,8 +70,8 @@ instance hom.inhabited : inhabited (hom none none) := ⟨hom.id (none : wide_pul local attribute [tidy] tactic.case_bash -instance subsingleton_hom (j j' : wide_pullback_shape J) : subsingleton (j ⟶ j') := -⟨by tidy⟩ +instance subsingleton_hom : quiver.is_thin (wide_pullback_shape J) := +λ _ _, ⟨by tidy⟩ instance category : small_category (wide_pullback_shape J) := thin_category @@ -116,6 +119,22 @@ def mk_cone {F : wide_pullback_shape J ⥤ C} {X : C} end, naturality' := λ j j' f, by { cases j; cases j'; cases f; unfold_aux; dsimp; simp [w], }, } } +/-- Wide pullback diagrams of equivalent index types are equivlent. -/ +def equivalence_of_equiv (J' : Type w') (h : J ≃ J') : + wide_pullback_shape J ≌ wide_pullback_shape J' := +{ functor := wide_cospan none (λ j, some (h j)) (λ j, hom.term (h j)), + inverse := wide_cospan none (λ j, some (h.inv_fun j)) (λ j, hom.term (h.inv_fun j)), + unit_iso := nat_iso.of_components (λ j, by cases j; simp) + (λ j k f, by { simp only [eq_iff_true_of_subsingleton]}), + counit_iso := nat_iso.of_components (λ j, by cases j; simp) + (λ j k f, by { simp only [eq_iff_true_of_subsingleton]}) } + +/-- Lifting universe and morphism levels preserves wide pullback diagrams. -/ +def ulift_equivalence : + ulift_hom.{w'} (ulift.{w'} (wide_pullback_shape J)) ≌ wide_pullback_shape (ulift J) := +(ulift_hom_ulift_category.equiv.{w' w' w w} (wide_pullback_shape J)).symm.trans + (equivalence_of_equiv _ (equiv.ulift.{w' w}.symm : J ≃ ulift.{w'} J)) + end wide_pullback_shape namespace wide_pushout_shape @@ -124,7 +143,7 @@ variable {J} /-- The type of arrows for the shape indexing a wide psuhout. -/ @[derive decidable_eq] -inductive hom : wide_pushout_shape J → wide_pushout_shape J → Type v +inductive hom : wide_pushout_shape J → wide_pushout_shape J → Type w | id : Π X, hom X X | init : Π (j : J), hom none (some j) @@ -145,8 +164,8 @@ instance hom.inhabited : inhabited (hom none none) := ⟨hom.id (none : wide_pus local attribute [tidy] tactic.case_bash -instance subsingleton_hom (j j' : wide_pushout_shape J) : subsingleton (j ⟶ j') := -⟨by tidy⟩ +instance subsingleton_hom : quiver.is_thin (wide_pushout_shape J) := +λ _ _, ⟨by tidy⟩ instance category : small_category (wide_pushout_shape J) := thin_category @@ -193,11 +212,11 @@ variables (C : Type u) [category.{v} C] /-- `has_wide_pullbacks` represents a choice of wide pullback for every collection of morphisms -/ abbreviation has_wide_pullbacks : Prop := -Π (J : Type v), has_limits_of_shape (wide_pullback_shape J) C +Π (J : Type w), has_limits_of_shape (wide_pullback_shape J) C /-- `has_wide_pushouts` represents a choice of wide pushout for every collection of morphisms -/ abbreviation has_wide_pushouts : Prop := -Π (J : Type v), has_colimits_of_shape (wide_pushout_shape J) C +Π (J : Type w), has_colimits_of_shape (wide_pushout_shape J) C variables {C J} @@ -445,4 +464,10 @@ def wide_pullback_shape_op_equiv : (wide_pullback_shape J)ᵒᵖ ≌ wide_pushou unit_iso := (wide_pullback_shape_op_unop J).symm, counit_iso := wide_pushout_shape_unop_op J, } +/-- If a category has wide pullbacks on a higher universe level it also has wide pullbacks +on a lower universe level. -/ +lemma has_wide_pullbacks_shrink [has_wide_pullbacks.{max w w'} C] : has_wide_pullbacks.{w} C := +λ J, has_limits_of_shape_of_equivalence + (wide_pullback_shape.equivalence_of_equiv _ equiv.ulift.{w'}) + end category_theory.limits diff --git a/src/category_theory/limits/shapes/zero_morphisms.lean b/src/category_theory/limits/shapes/zero_morphisms.lean index d43911a8b2dae..a4c8d04ca24b4 100644 --- a/src/category_theory/limits/shapes/zero_morphisms.lean +++ b/src/category_theory/limits/shapes/zero_morphisms.lean @@ -3,6 +3,7 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ +import data.pi.algebra import category_theory.limits.shapes.products import category_theory.limits.shapes.images import category_theory.isomorphism_classes @@ -11,6 +12,9 @@ import category_theory.limits.shapes.zero_objects /-! # Zero morphisms and zero objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space, and compositions of zero morphisms with anything give the zero morphism. (Notice this is extra structure, not merely a property.) @@ -31,6 +35,7 @@ universes v' u' open category_theory open category_theory.category +open_locale classical namespace category_theory.limits @@ -159,20 +164,20 @@ by { unfreezingI { subst h, }, apply of_mono_zero X Y, } lemma of_epi_eq_zero {X Y : C} (f : X ⟶ Y) [epi f] (h : f = 0) : is_zero Y := by { unfreezingI { subst h, }, apply of_epi_zero X Y, } -lemma iff_split_mono_eq_zero {X Y : C} (f : X ⟶ Y) [split_mono f] : is_zero X ↔ f = 0 := +lemma iff_is_split_mono_eq_zero {X Y : C} (f : X ⟶ Y) [is_split_mono f] : is_zero X ↔ f = 0 := begin rw iff_id_eq_zero, split, { intro h, rw [←category.id_comp f, h, zero_comp], }, - { intro h, rw [←split_mono.id f], simp [h], }, + { intro h, rw [←is_split_mono.id f], simp [h], }, end -lemma iff_split_epi_eq_zero {X Y : C} (f : X ⟶ Y) [split_epi f] : is_zero Y ↔ f = 0 := +lemma iff_is_split_epi_eq_zero {X Y : C} (f : X ⟶ Y) [is_split_epi f] : is_zero Y ↔ f = 0 := begin rw iff_id_eq_zero, split, { intro h, rw [←category.comp_id f, h, comp_zero], }, - { intro h, rw [←split_epi.id f], simp [h], }, + { intro h, rw [←is_split_epi.id f], simp [h], }, end lemma of_mono {X Y : C} (f : X ⟶ Y) [mono f] (i : is_zero Y) : is_zero X := @@ -518,39 +523,31 @@ by { rw image.eq_fac h, simp } end image /-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/ -instance split_mono_sigma_ι - {β : Type v} [decidable_eq β] - [has_zero_morphisms C] - (f : β → C) [has_colimit (discrete.functor f)] (b : β) : split_mono (sigma.ι f b) := -{ retraction := sigma.desc (λ b', if h : b' = b then eq_to_hom (congr_arg f h) else 0), } +instance is_split_mono_sigma_ι {β : Type u'} [has_zero_morphisms C] (f : β → C) + [has_colimit (discrete.functor f)] (b : β) : is_split_mono (sigma.ι f b) := is_split_mono.mk' +{ retraction := sigma.desc $ pi.single b (𝟙 _) } /-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/ -instance split_epi_pi_π - {β : Type v} [decidable_eq β] - [has_zero_morphisms C] - (f : β → C) [has_limit (discrete.functor f)] (b : β) : split_epi (pi.π f b) := -{ section_ := pi.lift (λ b', if h : b = b' then eq_to_hom (congr_arg f h) else 0), } +instance is_split_epi_pi_π {β : Type u'} [has_zero_morphisms C] (f : β → C) + [has_limit (discrete.functor f)] (b : β) : is_split_epi (pi.π f b) := is_split_epi.mk' +{ section_ := pi.lift $ pi.single b (𝟙 _) } /-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/ -instance split_mono_coprod_inl - [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] : - split_mono (coprod.inl : X ⟶ X ⨿ Y) := +instance is_split_mono_coprod_inl [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] : + is_split_mono (coprod.inl : X ⟶ X ⨿ Y) := is_split_mono.mk' { retraction := coprod.desc (𝟙 X) 0, } /-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/ -instance split_mono_coprod_inr - [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] : - split_mono (coprod.inr : Y ⟶ X ⨿ Y) := +instance is_split_mono_coprod_inr [has_zero_morphisms C] {X Y : C} [has_colimit (pair X Y)] : + is_split_mono (coprod.inr : Y ⟶ X ⨿ Y) := is_split_mono.mk' { retraction := coprod.desc 0 (𝟙 Y), } /-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/ -instance split_epi_prod_fst - [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] : - split_epi (prod.fst : X ⨯ Y ⟶ X) := +instance is_split_epi_prod_fst [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] : + is_split_epi (prod.fst : X ⨯ Y ⟶ X) := is_split_epi.mk' { section_ := prod.lift (𝟙 X) 0, } /-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/ -instance split_epi_prod_snd - [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] : - split_epi (prod.snd : X ⨯ Y ⟶ Y) := +instance is_split_epi_prod_snd [has_zero_morphisms C] {X Y : C} [has_limit (pair X Y)] : + is_split_epi (prod.snd : X ⨯ Y ⟶ Y) := is_split_epi.mk' { section_ := prod.lift 0 (𝟙 Y), } end category_theory.limits diff --git a/src/category_theory/limits/shapes/zero_objects.lean b/src/category_theory/limits/shapes/zero_objects.lean index a7ab330b88932..cd8c7ee3cf8a5 100644 --- a/src/category_theory/limits/shapes/zero_objects.lean +++ b/src/category_theory/limits/shapes/zero_objects.lean @@ -3,13 +3,14 @@ Copyright (c) 2019 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Johan Commelin -/ -import category_theory.limits.shapes.products -import category_theory.limits.shapes.images -import category_theory.isomorphism_classes +import category_theory.limits.shapes.terminal /-! # Zero objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category "has a zero object" if it has an object which is both initial and terminal. Having a zero object provides zero morphisms, as the unique morphisms factoring through the zero object; see `category_theory.limits.shapes.zero_morphisms`. @@ -101,6 +102,14 @@ begin { rw ← cancel_mono e.hom, apply hY.eq_of_tgt, }, end +lemma op (h : is_zero X) : is_zero (opposite.op X) := +⟨λ Y, ⟨⟨⟨(h.from (opposite.unop Y)).op⟩, λ f, quiver.hom.unop_inj (h.eq_of_tgt _ _)⟩⟩, + λ Y, ⟨⟨⟨(h.to (opposite.unop Y)).op⟩, λ f, quiver.hom.unop_inj (h.eq_of_src _ _)⟩⟩⟩ + +lemma unop {X : Cᵒᵖ} (h : is_zero X) : is_zero (opposite.unop X) := +⟨λ Y, ⟨⟨⟨(h.from (opposite.op Y)).unop⟩, λ f, quiver.hom.op_inj (h.eq_of_tgt _ _)⟩⟩, + λ Y, ⟨⟨⟨(h.to (opposite.op Y)).unop⟩, λ f, quiver.hom.op_inj (h.eq_of_src _ _)⟩⟩⟩ + end is_zero end limits @@ -132,7 +141,7 @@ class has_zero_object : Prop := (zero : ∃ X : C, is_zero X) instance has_zero_object_punit : has_zero_object (discrete punit) := -{ zero := ⟨punit.star, by tidy, by tidy⟩, } +{ zero := ⟨⟨⟨⟩⟩, by tidy, by tidy⟩, } section @@ -150,10 +159,15 @@ localized "attribute [instance] category_theory.limits.has_zero_object.has_zero" lemma is_zero_zero : is_zero (0 : C) := has_zero_object.zero.some_spec +instance has_zero_object_op : has_zero_object Cᵒᵖ := ⟨⟨opposite.op 0, is_zero.op (is_zero_zero C)⟩⟩ + end open_locale zero_object +lemma has_zero_object_unop [has_zero_object Cᵒᵖ] : has_zero_object C := +⟨⟨opposite.unop 0, is_zero.unop (is_zero_zero Cᵒᵖ)⟩⟩ + variables {C} lemma is_zero.has_zero_object {X : C} (hX : is_zero X) : has_zero_object C := ⟨⟨X, hX⟩⟩ @@ -201,6 +215,10 @@ instance {X : C} (f : 0 ⟶ X) : mono f := instance {X : C} (f : X ⟶ 0) : epi f := { left_cancellation := λ Z g h w, by ext, } +instance zero_to_zero_is_iso (f : (0 : C) ⟶ 0) : + is_iso f := +by convert (show is_iso (𝟙 (0 : C)), by apply_instance) + /-- A zero object is in particular initial. -/ def zero_is_initial : is_initial (0 : C) := (is_zero_zero C).is_initial diff --git a/src/category_theory/limits/small_complete.lean b/src/category_theory/limits/small_complete.lean index e416c868d1212..c61016db8abe7 100644 --- a/src/category_theory/limits/small_complete.lean +++ b/src/category_theory/limits/small_complete.lean @@ -10,6 +10,9 @@ import set_theory.cardinal.basic /-! # Any small complete category is a preorder +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We show that any small category which has all (small) limits is a preorder: In particular, we show that if a small category `C` in universe `u` has products of size `u`, then for any `X Y : C` there is at most one morphism `X ⟶ Y`. @@ -32,7 +35,7 @@ open_locale cardinal universe u -variables {C : Type u} [small_category C] [has_products C] +variables {C : Type u} [small_category C] [has_products.{u} C] /-- A small category with products is a thin category. @@ -41,8 +44,8 @@ in Lean, a preorder category is one where the morphisms are in Prop, which is we notion of a preorder/thin category which says that each homset is subsingleton; we show the latter rather than providing a `preorder C` instance. -/ -instance {X Y : C} : subsingleton (X ⟶ Y) := -⟨λ r s, +@[priority 100] instance : quiver.is_thin C := +λ X Y, ⟨λ r s, begin classical, by_contra r_ne_s, @@ -63,7 +66,7 @@ begin ext k, simp }, { intros f, - ext, + ext ⟨j⟩, simp } }, { apply cardinal.mk_le_of_injective _, { intro f, diff --git a/src/category_theory/limits/types.lean b/src/category_theory/limits/types.lean index 52205fe28709e..e9e7959d7b6b9 100644 --- a/src/category_theory/limits/types.lean +++ b/src/category_theory/limits/types.lean @@ -7,26 +7,41 @@ import category_theory.limits.shapes.images import category_theory.filtered import tactic.equiv_rw -universes u +/-! +# Limits in the category of types. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that the category of types has all (co)limits, by providing the usual concrete models. + +We also give a characterisation of filtered colimits in `Type`, via +`colimit.ι F i xi = colimit.ι F j xj ↔ ∃ k (f : i ⟶ k) (g : j ⟶ k), F.map f xi = F.map g xj`. + +Finally, we prove the category of types has categorical images, +and that these agree with the range of a function. +-/ + +universes v u open category_theory open category_theory.limits namespace category_theory.limits.types -variables {J : Type u} [small_category J] +variables {J : Type v} [small_category J] /-- (internal implementation) the limit cone of a functor, implemented as flat sections of a pi type -/ -def limit_cone (F : J ⥤ Type u) : cone F := +def limit_cone (F : J ⥤ Type (max v u)) : cone F := { X := F.sections, π := { app := λ j u, u.val j } } local attribute [elab_simple] congr_fun /-- (internal implementation) the fact that the proposed limit cone is the limit -/ -def limit_cone_is_limit (F : J ⥤ Type u) : is_limit (limit_cone F) := +def limit_cone_is_limit (F : J ⥤ Type (max v u)) : is_limit (limit_cone F) := { lift := λ s v, ⟨λ j, s.π.app j v, λ j j' f, congr_fun (cone.w s f) _⟩, uniq' := by { intros, ext x j, exact congr_fun (w j) x } } @@ -35,28 +50,30 @@ The category of types has all limits. See . -/ -instance : has_limits (Type u) := +instance has_limits_of_size : has_limits_of_size.{v} (Type (max v u)) := { has_limits_of_shape := λ J 𝒥, by exactI { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } } +instance : has_limits (Type u) := types.has_limits_of_size.{u u} + /-- The equivalence between a limiting cone of `F` in `Type u` and the "concrete" definition as the sections of `F`. -/ -def is_limit_equiv_sections {F : J ⥤ Type u} {c : cone F} (t : is_limit c) : +def is_limit_equiv_sections {F : J ⥤ Type (max v u)} {c : cone F} (t : is_limit c) : c.X ≃ F.sections := (is_limit.cone_point_unique_up_to_iso t (limit_cone_is_limit F)).to_equiv @[simp] lemma is_limit_equiv_sections_apply - {F : J ⥤ Type u} {c : cone F} (t : is_limit c) (j : J) (x : c.X) : + {F : J ⥤ Type (max v u)} {c : cone F} (t : is_limit c) (j : J) (x : c.X) : (((is_limit_equiv_sections t) x) : Π j, F.obj j) j = c.π.app j x := rfl @[simp] lemma is_limit_equiv_sections_symm_apply - {F : J ⥤ Type u} {c : cone F} (t : is_limit c) (x : F.sections) (j : J) : + {F : J ⥤ Type (max v u)} {c : cone F} (t : is_limit c) (x : F.sections) (j : J) : c.π.app j ((is_limit_equiv_sections t).symm x) = (x : Π j, F.obj j) j := begin equiv_rw (is_limit_equiv_sections t).symm at x, @@ -68,38 +85,48 @@ The equivalence between the abstract limit of `F` in `Type u` and the "concrete" definition as the sections of `F`. -/ noncomputable -def limit_equiv_sections (F : J ⥤ Type u) : (limit F : Type u) ≃ F.sections := +def limit_equiv_sections (F : J ⥤ Type (max v u)) : (limit F : Type (max v u)) ≃ F.sections := is_limit_equiv_sections (limit.is_limit _) @[simp] -lemma limit_equiv_sections_apply (F : J ⥤ Type u) (x : limit F) (j : J) : +lemma limit_equiv_sections_apply (F : J ⥤ Type (max v u)) (x : limit F) (j : J) : (((limit_equiv_sections F) x) : Π j, F.obj j) j = limit.π F j x := rfl @[simp] -lemma limit_equiv_sections_symm_apply (F : J ⥤ Type u) (x : F.sections) (j : J) : +lemma limit_equiv_sections_symm_apply (F : J ⥤ Type (max v u)) (x : F.sections) (j : J) : limit.π F j ((limit_equiv_sections F).symm x) = (x : Π j, F.obj j) j := is_limit_equiv_sections_symm_apply _ _ _ +@[simp] +lemma limit_equiv_sections_symm_apply' (F : J ⥤ Type v) (x : F.sections) (j : J) : + limit.π F j ((limit_equiv_sections.{v v} F).symm x) = (x : Π j, F.obj j) j := +is_limit_equiv_sections_symm_apply _ _ _ + /-- Construct a term of `limit F : Type u` from a family of terms `x : Π j, F.obj j` which are "coherent": `∀ (j j') (f : j ⟶ j'), F.map f (x j) = x j'`. -/ @[ext] noncomputable -def limit.mk (F : J ⥤ Type u) (x : Π j, F.obj j) (h : ∀ (j j') (f : j ⟶ j'), F.map f (x j) = x j') : - (limit F : Type u) := +def limit.mk (F : J ⥤ Type (max v u)) (x : Π j, F.obj j) + (h : ∀ (j j') (f : j ⟶ j'), F.map f (x j) = x j') : (limit F : Type (max v u)) := (limit_equiv_sections F).symm ⟨x, h⟩ @[simp] -lemma limit.π_mk - (F : J ⥤ Type u) (x : Π j, F.obj j) (h : ∀ (j j') (f : j ⟶ j'), F.map f (x j) = x j') (j) : - limit.π F j (limit.mk F x h) = x j := +lemma limit.π_mk (F : J ⥤ Type (max v u)) (x : Π j, F.obj j) + (h : ∀ (j j') (f : j ⟶ j'), F.map f (x j) = x j') (j) : limit.π F j (limit.mk F x h) = x j := +by { dsimp [limit.mk], simp, } + +@[simp] +lemma limit.π_mk' (F : J ⥤ Type v) (x : Π j, F.obj j) + (h : ∀ (j j') (f : j ⟶ j'), F.map f (x j) = x j') (j) : + limit.π F j (limit.mk.{v v} F x h) = x j := by { dsimp [limit.mk], simp, } -- PROJECT: prove this for concrete categories where the forgetful functor preserves limits @[ext] -lemma limit_ext (F : J ⥤ Type u) (x y : limit F) (w : ∀ j, limit.π F j x = limit.π F j y) : +lemma limit_ext (F : J ⥤ Type (max v u)) (x y : limit F) (w : ∀ j, limit.π F j x = limit.π F j y) : x = y := begin apply (limit_equiv_sections F).injective, @@ -107,7 +134,20 @@ begin simp [w j], end -lemma limit_ext_iff (F : J ⥤ Type u) (x y : limit F) : +@[ext] +lemma limit_ext' (F : J ⥤ Type v) (x y : limit F) (w : ∀ j, limit.π F j x = limit.π F j y) : + x = y := +begin + apply (limit_equiv_sections.{v v} F).injective, + ext j, + simp [w j], +end + +lemma limit_ext_iff (F : J ⥤ Type (max v u)) (x y : limit F) : + x = y ↔ (∀ j, limit.π F j x = limit.π F j y) := +⟨λ t _, t ▸ rfl, limit_ext _ _ _⟩ + +lemma limit_ext_iff' (F : J ⥤ Type v) (x y : limit F) : x = y ↔ (∀ j, limit.π F j x = limit.π F j y) := ⟨λ t _, t ▸ rfl, limit_ext _ _ _⟩ @@ -116,17 +156,32 @@ lemma limit_ext_iff (F : J ⥤ Type u) (x y : limit F) : -- PROJECT: prove these for any concrete category where the forgetful functor preserves limits? @[simp] -lemma limit.w_apply {F : J ⥤ Type u} {j j' : J} {x : limit F} (f : j ⟶ j') : +lemma limit.w_apply {F : J ⥤ Type (max v u)} {j j' : J} {x : limit F} (f : j ⟶ j') : F.map f (limit.π F j x) = limit.π F j' x := congr_fun (limit.w F f) x @[simp] -lemma limit.lift_π_apply (F : J ⥤ Type u) (s : cone F) (j : J) (x : s.X) : +lemma limit.lift_π_apply (F : J ⥤ Type (max v u)) (s : cone F) (j : J) (x : s.X) : limit.π F j (limit.lift F s x) = s.π.app j x := congr_fun (limit.lift_π s j) x @[simp] -lemma limit.map_π_apply {F G : J ⥤ Type u} (α : F ⟶ G) (j : J) (x) : +lemma limit.map_π_apply {F G : J ⥤ Type (max v u)} (α : F ⟶ G) (j : J) (x) : + limit.π G j (lim_map α x) = α.app j (limit.π F j x) := +congr_fun (lim_map_π α j) x + +@[simp] +lemma limit.w_apply' {F : J ⥤ Type v} {j j' : J} {x : limit F} (f : j ⟶ j') : + F.map f (limit.π F j x) = limit.π F j' x := +congr_fun (limit.w F f) x + +@[simp] +lemma limit.lift_π_apply' (F : J ⥤ Type v) (s : cone F) (j : J) (x : s.X) : + limit.π F j (limit.lift F s x) = s.π.app j x := +congr_fun (limit.lift_π s j) x + +@[simp] +lemma limit.map_π_apply' {F G : J ⥤ Type v} (α : F ⟶ G) (j : J) (x) : limit.π G j (lim_map α x) = α.app j (limit.π F j x) := congr_fun (lim_map_π α j) x @@ -134,7 +189,7 @@ congr_fun (lim_map_π α j) x The relation defining the quotient type which implements the colimit of a functor `F : J ⥤ Type u`. See `category_theory.limits.types.quot`. -/ -def quot.rel (F : J ⥤ Type u) : (Σ j, F.obj j) → (Σ j, F.obj j) → Prop := +def quot.rel (F : J ⥤ Type (max v u)) : (Σ j, F.obj j) → (Σ j, F.obj j) → Prop := (λ p p', ∃ f : p.1 ⟶ p'.1, p'.2 = F.map f p.2) /-- @@ -142,15 +197,15 @@ A quotient type implementing the colimit of a functor `F : J ⥤ Type u`, as pairs `⟨j, x⟩` where `x : F.obj j`, modulo the equivalence relation generated by `⟨j, x⟩ ~ ⟨j', x'⟩` whenever there is a morphism `f : j ⟶ j'` so `F.map f x = x'`. -/ -@[nolint has_inhabited_instance] -def quot (F : J ⥤ Type u) : Type u := +@[nolint has_nonempty_instance] +def quot (F : J ⥤ Type (max v u)) : Type (max v u) := @quot (Σ j, F.obj j) (quot.rel F) /-- (internal implementation) the colimit cocone of a functor, implemented as a quotient of a sigma type -/ -def colimit_cocone (F : J ⥤ Type u) : cocone F := +def colimit_cocone (F : J ⥤ Type (max v u)) : cocone F := { X := quot F, ι := { app := λ j x, quot.mk _ ⟨j, x⟩, @@ -159,7 +214,7 @@ def colimit_cocone (F : J ⥤ Type u) : cocone F := local attribute [elab_with_expected_type] quot.lift /-- (internal implementation) the fact that the proposed colimit cocone is the colimit -/ -def colimit_cocone_is_colimit (F : J ⥤ Type u) : is_colimit (colimit_cocone F) := +def colimit_cocone_is_colimit (F : J ⥤ Type (max v u)) : is_colimit (colimit_cocone F) := { desc := λ s, quot.lift (λ (p : Σ j, F.obj j), s.ι.app p.1 p.2) (assume ⟨j, x⟩ ⟨j', x'⟩ ⟨f, hf⟩, by rw hf; exact (congr_fun (cocone.w s f) x).symm) } @@ -168,28 +223,30 @@ The category of types has all colimits. See . -/ -instance : has_colimits (Type u) := +instance has_colimits_of_size : has_colimits_of_size.{v} (Type (max v u)) := { has_colimits_of_shape := λ J 𝒥, by exactI { has_colimit := λ F, has_colimit.mk { cocone := colimit_cocone F, is_colimit := colimit_cocone_is_colimit F } } } +instance : has_colimits (Type u) := types.has_colimits_of_size.{u u} + /-- The equivalence between the abstract colimit of `F` in `Type u` and the "concrete" definition as a quotient. -/ noncomputable -def colimit_equiv_quot (F : J ⥤ Type u) : (colimit F : Type u) ≃ quot F := +def colimit_equiv_quot (F : J ⥤ Type (max v u)) : (colimit F : Type (max v u)) ≃ quot F := (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit F) (colimit_cocone_is_colimit F)).to_equiv @[simp] -lemma colimit_equiv_quot_symm_apply (F : J ⥤ Type u) (j : J) (x : F.obj j) : +lemma colimit_equiv_quot_symm_apply (F : J ⥤ Type (max v u)) (j : J) (x : F.obj j) : (colimit_equiv_quot F).symm (quot.mk _ ⟨j, x⟩) = colimit.ι F j x := rfl @[simp] -lemma colimit_equiv_quot_apply (F : J ⥤ Type u) (j : J) (x : F.obj j) : +lemma colimit_equiv_quot_apply (F : J ⥤ Type (max v u)) (j : J) (x : F.obj j) : (colimit_equiv_quot F) (colimit.ι F j x) = quot.mk _ ⟨j, x⟩ := begin apply (colimit_equiv_quot F).symm.injective, @@ -197,52 +254,67 @@ begin end @[simp] -lemma colimit.w_apply {F : J ⥤ Type u} {j j' : J} {x : F.obj j} (f : j ⟶ j') : +lemma colimit.w_apply {F : J ⥤ Type (max v u)} {j j' : J} {x : F.obj j} (f : j ⟶ j') : + colimit.ι F j' (F.map f x) = colimit.ι F j x := +congr_fun (colimit.w F f) x + +@[simp] +lemma colimit.ι_desc_apply (F : J ⥤ Type (max v u)) (s : cocone F) (j : J) (x : F.obj j) : + colimit.desc F s (colimit.ι F j x) = s.ι.app j x := +congr_fun (colimit.ι_desc s j) x + +@[simp] +lemma colimit.ι_map_apply {F G : J ⥤ Type (max v u)} (α : F ⟶ G) (j : J) (x) : + colim.map α (colimit.ι F j x) = colimit.ι G j (α.app j x) := +congr_fun (colimit.ι_map α j) x + +@[simp] +lemma colimit.w_apply' {F : J ⥤ Type v} {j j' : J} {x : F.obj j} (f : j ⟶ j') : colimit.ι F j' (F.map f x) = colimit.ι F j x := congr_fun (colimit.w F f) x @[simp] -lemma colimit.ι_desc_apply (F : J ⥤ Type u) (s : cocone F) (j : J) (x : F.obj j) : +lemma colimit.ι_desc_apply' (F : J ⥤ Type v) (s : cocone F) (j : J) (x : F.obj j) : colimit.desc F s (colimit.ι F j x) = s.ι.app j x := congr_fun (colimit.ι_desc s j) x @[simp] -lemma colimit.ι_map_apply {F G : J ⥤ Type u} (α : F ⟶ G) (j : J) (x) : +lemma colimit.ι_map_apply' {F G : J ⥤ Type v} (α : F ⟶ G) (j : J) (x) : colim.map α (colimit.ι F j x) = colimit.ι G j (α.app j x) := congr_fun (colimit.ι_map α j) x lemma colimit_sound - {F : J ⥤ Type u} {j j' : J} {x : F.obj j} {x' : F.obj j'} (f : j ⟶ j') (w : F.map f x = x') : - colimit.ι F j x = colimit.ι F j' x' := + {F : J ⥤ Type (max v u)} {j j' : J} {x : F.obj j} {x' : F.obj j'} + (f : j ⟶ j') (w : F.map f x = x') : colimit.ι F j x = colimit.ι F j' x' := begin rw [←w], simp, end lemma colimit_sound' - {F : J ⥤ Type u} {j j' : J} {x : F.obj j} {x' : F.obj j'} {j'' : J} (f : j ⟶ j'') (f' : j' ⟶ j'') - (w : F.map f x = F.map f' x') : + {F : J ⥤ Type (max v u)} {j j' : J} {x : F.obj j} {x' : F.obj j'} {j'' : J} + (f : j ⟶ j'') (f' : j' ⟶ j'') (w : F.map f x = F.map f' x') : colimit.ι F j x = colimit.ι F j' x' := begin rw [←colimit.w _ f, ←colimit.w _ f'], rw [types_comp_apply, types_comp_apply, w], end -lemma colimit_eq {F : J ⥤ Type u } {j j' : J} {x : F.obj j} {x' : F.obj j'} +lemma colimit_eq {F : J ⥤ Type (max v u)} {j j' : J} {x : F.obj j} {x' : F.obj j'} (w : colimit.ι F j x = colimit.ι F j' x') : eqv_gen (quot.rel F) ⟨j, x⟩ ⟨j', x'⟩ := begin apply quot.eq.1, simpa using congr_arg (colimit_equiv_quot F) w, end -lemma jointly_surjective (F : J ⥤ Type u) {t : cocone F} (h : is_colimit t) +lemma jointly_surjective (F : J ⥤ Type (max v u)) {t : cocone F} (h : is_colimit t) (x : t.X) : ∃ j y, t.ι.app j y = x := begin suffices : (λ (x : t.X), ulift.up (∃ j y, t.ι.app j y = x)) = (λ _, ulift.up true), { have := congr_fun this x, have H := congr_arg ulift.down this, dsimp at H, - rwa eq_true at H }, + rwa eq_true_iff at H }, refine h.hom_ext _, intro j, ext y, erw iff_true, @@ -250,7 +322,7 @@ begin end /-- A variant of `jointly_surjective` for `x : colimit F`. -/ -lemma jointly_surjective' {F : J ⥤ Type u} +lemma jointly_surjective' {F : J ⥤ Type (max v u)} (x : colimit F) : ∃ j y, colimit.ι F j y = x := jointly_surjective F (colimit.is_colimit _) x @@ -259,7 +331,7 @@ namespace filtered_colimit of the equivalence relation generated by the relation used to form the colimit. -/ -variables (F : J ⥤ Type u) +variables (F : J ⥤ Type (max v u)) /-- An alternative relation on `Σ j, F.obj j`, diff --git a/src/category_theory/limits/unit.lean b/src/category_theory/limits/unit.lean new file mode 100644 index 0000000000000..4bd4e49734706 --- /dev/null +++ b/src/category_theory/limits/unit.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2020 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ + +import category_theory.punit +import category_theory.limits.has_limits + +/-! +# `discrete punit` has limits and colimits + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Mostly for the sake of constructing trivial examples, we show all (co)cones into `discrete punit` +are (co)limit (co)cones. We also show that such (co)cones exist, and that `discrete punit` has all +(co)limits. +-/ + +universes v' v + +open category_theory +namespace category_theory.limits + +variables {J : Type v} [category.{v'} J] {F : J ⥤ discrete punit} + +/-- A trivial cone for a functor into `punit`. `punit_cone_is_limit` shows it is a limit. -/ +def punit_cone : cone F := +⟨⟨⟨⟩⟩, (functor.punit_ext _ _).hom⟩ + +/-- A trivial cocone for a functor into `punit`. `punit_cocone_is_limit` shows it is a colimit. -/ +def punit_cocone : cocone F := +⟨⟨⟨⟩⟩, (functor.punit_ext _ _).hom⟩ + +/-- +Any cone over a functor into `punit` is a limit cone. +-/ +def punit_cone_is_limit {c : cone F} : is_limit c := +by tidy + +/-- +Any cocone over a functor into `punit` is a colimit cocone. +-/ +def punit_cocone_is_colimit {c : cocone F} : is_colimit c := +by tidy + +instance : has_limits_of_size.{v' v} (discrete punit) := +by tidy + +instance : has_colimits_of_size.{v' v} (discrete punit) := +by tidy + +end category_theory.limits diff --git a/src/category_theory/limits/yoneda.lean b/src/category_theory/limits/yoneda.lean index 277433e9b8f46..a864a68910753 100644 --- a/src/category_theory/limits/yoneda.lean +++ b/src/category_theory/limits/yoneda.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Bhavik Mehta -/ import category_theory.limits.functor_category +import tactic.assert_exists /-! # Limit properties relating to the (co)yoneda embedding. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We calculate the colimit of `Y ↦ (X ⟶ Y)`, which is just `punit`. (This is used in characterising cofinal functors.) @@ -18,7 +22,7 @@ open opposite open category_theory open category_theory.limits -universes v u +universes w v u namespace category_theory @@ -87,7 +91,7 @@ instance coyoneda_preserves_limits (X : Cᵒᵖ) : preserves_limits (coyoneda.ob end } } } } /-- The yoneda embeddings jointly reflect limits. -/ -def yoneda_jointly_reflects_limits (J : Type v) [small_category J] (K : J ⥤ Cᵒᵖ) (c : cone K) +def yoneda_jointly_reflects_limits (J : Type w) [small_category J] (K : J ⥤ Cᵒᵖ) (c : cone K) (t : Π (X : C), is_limit ((yoneda.obj X).map_cone c)) : is_limit c := let s' : Π (s : cone K), cone (K ⋙ yoneda.obj s.X.unop) := λ s, ⟨punit, λ j _, (s.π.app j).unop, λ j₁ j₂ α, funext $ λ _, quiver.hom.op_inj (s.w α).symm⟩ @@ -105,7 +109,7 @@ in end } /-- The coyoneda embeddings jointly reflect limits. -/ -def coyoneda_jointly_reflects_limits (J : Type v) [small_category J] (K : J ⥤ C) (c : cone K) +def coyoneda_jointly_reflects_limits (J : Type w) [small_category J] (K : J ⥤ C) (c : cone K) (t : Π (X : Cᵒᵖ), is_limit ((coyoneda.obj X).map_cone c)) : is_limit c := let s' : Π (s : cone K), cone (K ⋙ coyoneda.obj (op s.X)) := λ s, ⟨punit, λ j _, s.π.app j, λ j₁ j₂ α, funext $ λ _, (s.w α).symm⟩ @@ -146,3 +150,8 @@ instance coyoneda_functor_reflects_limits : reflects_limits (@coyoneda D _) := limits.fully_faithful_reflects_limits _ end category_theory + +-- We don't need to have developed any algebra or set theory to reach (at least) this point +-- in the category theory hierarchy. +assert_not_exists set.range +assert_not_exists add_comm_monoid diff --git a/src/category_theory/linear/basic.lean b/src/category_theory/linear/basic.lean new file mode 100644 index 0000000000000..59a42152c0844 --- /dev/null +++ b/src/category_theory/linear/basic.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2021 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import category_theory.preadditive.basic +import algebra.module.linear_map +import algebra.invertible +import algebra.algebra.basic + +/-! +# Linear categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +An `R`-linear category is a category in which `X ⟶ Y` is an `R`-module in such a way that +composition of morphisms is `R`-linear in both variables. + +Note that sometimes in the literature a "linear category" is further required to be abelian. + +## Implementation + +Corresponding to the fact that we need to have an `add_comm_group X` structure in place +to talk about a `module R X` structure, +we need `preadditive C` as a prerequisite typeclass for `linear R C`. +This makes for longer signatures than would be ideal. + +## Future work + +It would be nice to have a usable framework of enriched categories in which this just became +a category enriched in `Module R`. + +-/ + +universes w v u + +open category_theory.limits +open linear_map + +namespace category_theory + +/-- A category is called `R`-linear if `P ⟶ Q` is an `R`-module such that composition is + `R`-linear in both variables. -/ +class linear (R : Type w) [semiring R] (C : Type u) [category.{v} C] [preadditive C] := +(hom_module : Π X Y : C, module R (X ⟶ Y) . tactic.apply_instance) +(smul_comp' : ∀ (X Y Z : C) (r : R) (f : X ⟶ Y) (g : Y ⟶ Z), + (r • f) ≫ g = r • (f ≫ g) . obviously) +(comp_smul' : ∀ (X Y Z : C) (f : X ⟶ Y) (r : R) (g : Y ⟶ Z), + f ≫ (r • g) = r • (f ≫ g) . obviously) + +attribute [instance] linear.hom_module +restate_axiom linear.smul_comp' +restate_axiom linear.comp_smul' +attribute [simp,reassoc] linear.smul_comp +attribute [reassoc, simp] linear.comp_smul -- (the linter doesn't like `simp` on the `_assoc` lemma) + +end category_theory + +open category_theory + +namespace category_theory.linear + +variables {C : Type u} [category.{v} C] [preadditive C] + +instance preadditive_nat_linear : linear ℕ C := +{ smul_comp' := λ X Y Z r f g, (preadditive.right_comp X g).map_nsmul f r, + comp_smul' := λ X Y Z f r g, (preadditive.left_comp Z f).map_nsmul g r, } + +instance preadditive_int_linear : linear ℤ C := +{ smul_comp' := λ X Y Z r f g, (preadditive.right_comp X g).map_zsmul f r, + comp_smul' := λ X Y Z f r g, (preadditive.left_comp Z f).map_zsmul g r, } + +section End + +variables {R : Type w} + +instance [semiring R] [linear R C] (X : C) : module R (End X) := +by { dsimp [End], apply_instance, } + +instance [comm_semiring R] [linear R C] (X : C) : algebra R (End X) := +algebra.of_module (λ r f g, comp_smul _ _ _ _ _ _) (λ r f g, smul_comp _ _ _ _ _ _) + +end End + +section +variables {R : Type w} [semiring R] [linear R C] + +section induced_category +universes u' +variables {C} {D : Type u'} (F : D → C) + +instance induced_category : linear.{w v} R (induced_category C F) := +{ hom_module := λ X Y, @linear.hom_module R _ C _ _ _ (F X) (F Y), + smul_comp' := λ P Q R f f' g, smul_comp' _ _ _ _ _ _, + comp_smul' := λ P Q R f g g', comp_smul' _ _ _ _ _ _, } + +end induced_category + +instance full_subcategory (Z : C → Prop) : linear.{w v} R (full_subcategory Z) := +{ hom_module := λ X Y, @linear.hom_module R _ C _ _ _ X.obj Y.obj, + smul_comp' := λ P Q R f f' g, smul_comp' _ _ _ _ _ _, + comp_smul' := λ P Q R f g g', comp_smul' _ _ _ _ _ _, } + +variables (R) + +/-- Composition by a fixed left argument as an `R`-linear map. -/ +@[simps] +def left_comp {X Y : C} (Z : C) (f : X ⟶ Y) : (Y ⟶ Z) →ₗ[R] (X ⟶ Z) := +{ to_fun := λ g, f ≫ g, + map_add' := by simp, + map_smul' := by simp, } + +/-- Composition by a fixed right argument as an `R`-linear map. -/ +@[simps] +def right_comp (X : C) {Y Z : C} (g : Y ⟶ Z) : (X ⟶ Y) →ₗ[R] (X ⟶ Z) := +{ to_fun := λ f, f ≫ g, + map_add' := by simp, + map_smul' := by simp, } + +instance {X Y : C} (f : X ⟶ Y) [epi f] (r : R) [invertible r] : epi (r • f) := +⟨λ R g g' H, begin + rw [smul_comp, smul_comp, ←comp_smul, ←comp_smul, cancel_epi] at H, + simpa [smul_smul] using congr_arg (λ f, ⅟r • f) H, +end⟩ + +instance {X Y : C} (f : X ⟶ Y) [mono f] (r : R) [invertible r] : mono (r • f) := +⟨λ R g g' H, begin + rw [comp_smul, comp_smul, ←smul_comp, ←smul_comp, cancel_mono] at H, + simpa [smul_smul] using congr_arg (λ f, ⅟r • f) H, +end⟩ + +/-- Given isomorphic objects `X ≅ Y, W ≅ Z` in a `k`-linear category, we have a `k`-linear +isomorphism between `Hom(X, W)` and `Hom(Y, Z).` -/ +def hom_congr (k : Type*) {C : Type*} [category C] [semiring k] + [preadditive C] [linear k C] {X Y W Z : C} (f₁ : X ≅ Y) (f₂ : W ≅ Z) : + (X ⟶ W) ≃ₗ[k] (Y ⟶ Z) := +{ inv_fun := (left_comp k W f₁.hom).comp (right_comp k Y f₂.symm.hom), + left_inv := λ x, by simp only [iso.symm_hom, linear_map.to_fun_eq_coe, linear_map.coe_comp, + function.comp_app, left_comp_apply, right_comp_apply, category.assoc, iso.hom_inv_id, + category.comp_id, iso.hom_inv_id_assoc], + right_inv := λ x, by simp only [iso.symm_hom, linear_map.coe_comp, function.comp_app, + right_comp_apply, left_comp_apply, linear_map.to_fun_eq_coe, iso.inv_hom_id_assoc, + category.assoc, iso.inv_hom_id, category.comp_id], + ..(right_comp k Y f₂.hom).comp (left_comp k W f₁.symm.hom) } + +lemma hom_congr_apply (k : Type*) {C : Type*} [category C] [semiring k] + [preadditive C] [linear k C] {X Y W Z : C} (f₁ : X ≅ Y) (f₂ : W ≅ Z) (f : X ⟶ W) : + hom_congr k f₁ f₂ f = (f₁.inv ≫ f) ≫ f₂.hom := rfl + +lemma hom_congr_symm_apply (k : Type*) {C : Type*} [category C] [semiring k] + [preadditive C] [linear k C] {X Y W Z : C} (f₁ : X ≅ Y) (f₂ : W ≅ Z) (f : Y ⟶ Z) : + (hom_congr k f₁ f₂).symm f = f₁.hom ≫ f ≫ f₂.inv := rfl + +end + +section +variables {S : Type w} [comm_semiring S] [linear S C] + +/-- Composition as a bilinear map. -/ +@[simps] +def comp (X Y Z : C) : (X ⟶ Y) →ₗ[S] ((Y ⟶ Z) →ₗ[S] (X ⟶ Z)) := +{ to_fun := λ f, left_comp S Z f, + map_add' := by { intros, ext, simp, }, + map_smul' := by { intros, ext, simp, }, } + +end + +end category_theory.linear diff --git a/src/category_theory/linear/default.lean b/src/category_theory/linear/default.lean deleted file mode 100644 index ea1e87f9ee9dd..0000000000000 --- a/src/category_theory/linear/default.lean +++ /dev/null @@ -1,139 +0,0 @@ -/- -Copyright (c) 2021 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import category_theory.preadditive -import algebra.module.linear_map -import algebra.invertible -import linear_algebra.basic -import algebra.algebra.basic - -/-! -# Linear categories - -An `R`-linear category is a category in which `X ⟶ Y` is an `R`-module in such a way that -composition of morphisms is `R`-linear in both variables. - -Note that sometimes in the literature a "linear category" is further required to be abelian. - -## Implementation - -Corresponding to the fact that we need to have an `add_comm_group X` structure in place -to talk about a `module R X` structure, -we need `preadditive C` as a prerequisite typeclass for `linear R C`. -This makes for longer signatures than would be ideal. - -## Future work - -It would be nice to have a usable framework of enriched categories in which this just became -a category enriched in `Module R`. - --/ - -universes w v u - -open category_theory.limits -open linear_map - -namespace category_theory - -/-- A category is called `R`-linear if `P ⟶ Q` is an `R`-module such that composition is - `R`-linear in both variables. -/ -class linear (R : Type w) [semiring R] (C : Type u) [category.{v} C] [preadditive C] := -(hom_module : Π X Y : C, module R (X ⟶ Y) . tactic.apply_instance) -(smul_comp' : ∀ (X Y Z : C) (r : R) (f : X ⟶ Y) (g : Y ⟶ Z), - (r • f) ≫ g = r • (f ≫ g) . obviously) -(comp_smul' : ∀ (X Y Z : C) (f : X ⟶ Y) (r : R) (g : Y ⟶ Z), - f ≫ (r • g) = r • (f ≫ g) . obviously) - -attribute [instance] linear.hom_module -restate_axiom linear.smul_comp' -restate_axiom linear.comp_smul' -attribute [simp,reassoc] linear.smul_comp -attribute [reassoc, simp] linear.comp_smul -- (the linter doesn't like `simp` on the `_assoc` lemma) - -end category_theory - -open category_theory - -namespace category_theory.linear - -variables {C : Type u} [category.{v} C] [preadditive C] - -instance preadditive_nat_linear : linear ℕ C := -{ smul_comp' := λ X Y Z r f g, (preadditive.right_comp X g).map_nsmul f r, - comp_smul' := λ X Y Z f r g, (preadditive.left_comp Z f).map_nsmul g r, } - -instance preadditive_int_linear : linear ℤ C := -{ smul_comp' := λ X Y Z r f g, (preadditive.right_comp X g).map_zsmul f r, - comp_smul' := λ X Y Z f r g, (preadditive.left_comp Z f).map_zsmul g r, } - -section End - -variables {R : Type w} [comm_ring R] [linear R C] - -instance (X : C) : module R (End X) := by { dsimp [End], apply_instance, } - -instance (X : C) : algebra R (End X) := -algebra.of_module (λ r f g, comp_smul _ _ _ _ _ _) (λ r f g, smul_comp _ _ _ _ _ _) - -end End - -section -variables {R : Type w} [semiring R] [linear R C] - -section induced_category -universes u' -variables {C} {D : Type u'} (F : D → C) - -instance induced_category.category : linear.{w v} R (induced_category C F) := -{ hom_module := λ X Y, @linear.hom_module R _ C _ _ _ (F X) (F Y), - smul_comp' := λ P Q R f f' g, smul_comp' _ _ _ _ _ _, - comp_smul' := λ P Q R f g g', comp_smul' _ _ _ _ _ _, } - -end induced_category - -variables (R) - -/-- Composition by a fixed left argument as an `R`-linear map. -/ -@[simps] -def left_comp {X Y : C} (Z : C) (f : X ⟶ Y) : (Y ⟶ Z) →ₗ[R] (X ⟶ Z) := -{ to_fun := λ g, f ≫ g, - map_add' := by simp, - map_smul' := by simp, } - -/-- Composition by a fixed right argument as an `R`-linear map. -/ -@[simps] -def right_comp (X : C) {Y Z : C} (g : Y ⟶ Z) : (X ⟶ Y) →ₗ[R] (X ⟶ Z) := -{ to_fun := λ f, f ≫ g, - map_add' := by simp, - map_smul' := by simp, } - -instance {X Y : C} (f : X ⟶ Y) [epi f] (r : R) [invertible r] : epi (r • f) := -⟨λ R g g' H, begin - rw [smul_comp, smul_comp, ←comp_smul, ←comp_smul, cancel_epi] at H, - simpa [smul_smul] using congr_arg (λ f, ⅟r • f) H, -end⟩ - -instance {X Y : C} (f : X ⟶ Y) [mono f] (r : R) [invertible r] : mono (r • f) := -⟨λ R g g' H, begin - rw [comp_smul, comp_smul, ←smul_comp, ←smul_comp, cancel_mono] at H, - simpa [smul_smul] using congr_arg (λ f, ⅟r • f) H, -end⟩ - -end - -section -variables {S : Type w} [comm_semiring S] [linear S C] - -/-- Composition as a bilinear map. -/ -@[simps] -def comp (X Y Z : C) : (X ⟶ Y) →ₗ[S] ((Y ⟶ Z) →ₗ[S] (X ⟶ Z)) := -{ to_fun := λ f, left_comp S Z f, - map_add' := by { intros, ext, simp, }, - map_smul' := by { intros, ext, simp, }, } - -end - -end category_theory.linear diff --git a/src/category_theory/linear/functor_category.lean b/src/category_theory/linear/functor_category.lean index 82e68a1a6f28b..594349a2a5381 100644 --- a/src/category_theory/linear/functor_category.lean +++ b/src/category_theory/linear/functor_category.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import category_theory.preadditive.functor_category -import category_theory.linear.default +import category_theory.linear.basic /-! # Linear structure on functor categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `C` and `D` are categories and `D` is `R`-linear, then `C ⥤ D` is also `R`-linear. diff --git a/src/category_theory/linear/linear_functor.lean b/src/category_theory/linear/linear_functor.lean index 18abc87553050..441907c22cb7e 100644 --- a/src/category_theory/linear/linear_functor.lean +++ b/src/category_theory/linear/linear_functor.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import category_theory.preadditive.additive_functor -import category_theory.linear +import category_theory.linear.basic /-! # Linear Functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An additive functor between two `R`-linear categories is called *linear* if the induced map on hom types is a morphism of `R`-modules. @@ -71,6 +74,10 @@ instance induced_functor_linear : functor.linear R (induced_functor F) := {} end induced_category +instance full_subcategory_inclusion_linear + {C : Type*} [category C] [preadditive C] [category_theory.linear R C] (Z : C → Prop) : + (full_subcategory_inclusion Z).linear R := {} + section variables {R} {C D : Type*} [category C] [category D] @@ -81,7 +88,7 @@ instance nat_linear : F.linear ℕ := { map_smul' := λ X Y f r, F.map_add_hom.map_nsmul f r, } instance int_linear : F.linear ℤ := -{ map_smul' := λ X Y f r, F.map_add_hom.map_zsmul f r, } +{ map_smul' := λ X Y f r, (F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_zsmul f r, } variables [category_theory.linear ℚ C] [category_theory.linear ℚ D] diff --git a/src/category_theory/linear/yoneda.lean b/src/category_theory/linear/yoneda.lean index c8b3cb3dd8a5f..c888432d38571 100644 --- a/src/category_theory/linear/yoneda.lean +++ b/src/category_theory/linear/yoneda.lean @@ -4,13 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import algebra.category.Module.basic -import category_theory.linear -import category_theory.preadditive.additive_functor -import category_theory.preadditive.yoneda +import category_theory.linear.basic +import category_theory.preadditive.yoneda.basic /-! # The Yoneda embedding for `R`-linear categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The Yoneda embedding for `R`-linear categories `C`, sends an object `X : C` to the `Module R`-valued presheaf on `C`, with value on `Y : Cᵒᵖ` given by `Module.of R (unop Y ⟶ X)`. @@ -35,11 +37,17 @@ def linear_yoneda : C ⥤ Cᵒᵖ ⥤ Module R := { obj := λ X, { obj := λ Y, Module.of R (unop Y ⟶ X), map := λ Y Y' f, linear.left_comp R _ f.unop, - map_comp' := λ _ _ _ f g, begin ext, dsimp, erw [category.assoc] end, - map_id' := λ Y, begin ext, dsimp, erw [category.id_comp] end }, - map := λ X X' f, { app := λ Y, linear.right_comp R _ f }, - map_id' := λ X, by { ext, simp }, -- `obviously` provides these, but slowly - map_comp' := λ _ _ _ f g, by { ext, simp } } + map_comp' := λ _ _ _ f g, linear_map.ext $ λ _, category.assoc _ _ _, + map_id' := λ Y, linear_map.ext $ λ _, category.id_comp _ }, + map := λ X X' f, + { app := λ Y, linear.right_comp R _ f, + naturality' := λ X Y f, linear_map.ext $ λ x, by simp only [category.assoc, Module.coe_comp, + function.comp_app, linear.left_comp_apply, linear.right_comp_apply] }, + map_id' := λ X, nat_trans.ext _ _ $ funext $ λ _, linear_map.ext $ λ _, + by simp only [linear.right_comp_apply, category.comp_id, nat_trans.id_app, Module.id_apply], + map_comp' := λ _ _ _ f g, nat_trans.ext _ _ $ funext $ λ _, linear_map.ext $ λ _, + by simp only [category.assoc, linear.right_comp_apply, nat_trans.comp_app, Module.coe_comp, + function.comp_app] } /-- The Yoneda embedding for `R`-linear categories `C`, sending an object `Y : Cᵒᵖ` to the `Module R`-valued copresheaf on `C`, @@ -49,11 +57,18 @@ def linear_coyoneda : Cᵒᵖ ⥤ C ⥤ Module R := { obj := λ Y, { obj := λ X, Module.of R (unop Y ⟶ X), map := λ Y Y', linear.right_comp _ _, - map_id' := λ Y, by { ext, exact category.comp_id _ }, - map_comp' := λ _ _ _ f g, by { ext, exact eq.symm (category.assoc _ _ _) } }, - map := λ Y Y' f, { app := λ X, linear.left_comp _ _ f.unop }, - map_id' := λ X, by { ext, simp }, -- `obviously` provides these, but slowly - map_comp' := λ _ _ _ f g, by { ext, simp } } + map_id' := λ Y, linear_map.ext $ λ _, category.comp_id _, + map_comp' := λ _ _ _ f g, linear_map.ext $ λ _, eq.symm (category.assoc _ _ _) }, + map := λ Y Y' f, + { app := λ X, linear.left_comp _ _ f.unop, + naturality' := λ X Y f, linear_map.ext $ λ x, by simp only [category.assoc, Module.coe_comp, + function.comp_app, linear.right_comp_apply, linear.left_comp_apply] }, + map_id' := λ X, nat_trans.ext _ _ $ funext $ λ _, linear_map.ext $ λ _, + by simp only [linear.left_comp_apply, unop_id, category.id_comp, nat_trans.id_app, + Module.id_apply], + map_comp' := λ _ _ _ f g, nat_trans.ext _ _ $ funext $ λ _, linear_map.ext $ λ _, + by simp only [category.assoc, Module.coe_comp, function.comp_app, linear.left_comp_apply, + unop_comp, nat_trans.comp_app]} instance linear_yoneda_obj_additive (X : C) : ((linear_yoneda R C).obj X).additive := {} instance linear_coyoneda_obj_additive (Y : Cᵒᵖ) : ((linear_coyoneda R C).obj Y).additive := {} diff --git a/src/category_theory/localization/construction.lean b/src/category_theory/localization/construction.lean new file mode 100644 index 0000000000000..e0d318df534db --- /dev/null +++ b/src/category_theory/localization/construction.lean @@ -0,0 +1,380 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.morphism_property +import category_theory.category.Quiv + +/-! + +# Construction of the localized category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file constructs the localized category, obtained by formally inverting +a class of maps `W : morphism_property C` in a category `C`. + +We first construct a quiver `loc_quiver W` whose objects are the same as those +of `C` and whose maps are the maps in `C` and placeholders for the formal +inverses of the maps in `W`. + +The localized category `W.localization` is obtained by taking the quotient +of the path category of `loc_quiver W` by the congruence generated by four +types of relations. + +The obvious functor `Q W : C ⥤ W.localization` satisfies the universal property +of the localization. Indeed, if `G : C ⥤ D` sends morphisms in `W` to isomorphisms +in `D` (i.e. we have `hG : W.is_inverted_by G`), then there exists a unique functor +`G' : W.localization ⥤ D` such that `Q W ≫ G' = G`. This `G'` is `lift G hG`. +The expected property of `lift G hG` if expressed by the lemma `fac` and the +uniqueness is expressed by `uniq`. + +## References + +* [P. Gabriel, M. Zisman, *Calculus of fractions and homotopy theory*][gabriel-zisman-1967] + +-/ + +noncomputable theory + +open category_theory.category + +namespace category_theory + +variables {C : Type*} [category C] (W : morphism_property C) {D : Type*} [category D] + +namespace localization + +namespace construction + +/-- If `W : morphism_property C`, `loc_quiver W` is a quiver with the same objects +as `C`, and whose morphisms are those in `C` and placeholders for formal +inverses of the morphisms in `W`. -/ +@[nolint has_nonempty_instance] +structure loc_quiver (W : morphism_property C) := (obj : C) + +instance : quiver (loc_quiver W) := +{ hom := λ A B, (A.obj ⟶ B.obj) ⊕ { f : B.obj ⟶ A.obj // W f} } + +/-- The object in the path category of `loc_quiver W` attached to an object in +the category `C` -/ +def ι_paths (X : C) : paths (loc_quiver W) := ⟨X⟩ + +/-- The morphism in the path category associated to a morphism in the original category. -/ +@[simp] +def ψ₁ {X Y : C} (f : X ⟶ Y) : ι_paths W X ⟶ ι_paths W Y := paths.of.map (sum.inl f) + +/-- The morphism in the path category corresponding to a formal inverse. -/ +@[simp] +def ψ₂ {X Y : C} (w : X ⟶ Y) (hw : W w) : ι_paths W Y ⟶ ι_paths W X := +paths.of.map (sum.inr ⟨w, hw⟩) + +/-- The relations by which we take the quotient in order to get the localized category. -/ +inductive relations : hom_rel (paths (loc_quiver W)) +| id (X : C) : + relations (ψ₁ W (𝟙 X)) (𝟙 _) +| comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : + relations (ψ₁ W (f ≫ g)) (ψ₁ W f ≫ ψ₁ W g) +| Winv₁ {X Y : C} (w : X ⟶ Y) (hw : W w) : + relations (ψ₁ W w ≫ ψ₂ W w hw) (𝟙 _) +| Winv₂ {X Y : C} (w : X ⟶ Y) (hw : W w) : + relations (ψ₂ W w hw ≫ ψ₁ W w) (𝟙 _) + +end construction + +end localization + +namespace morphism_property + +open localization.construction + +/-- The localized category obtained by formally inverting the morphisms +in `W : morphism_property C` -/ +@[derive category, nolint has_nonempty_instance] +def localization := category_theory.quotient (localization.construction.relations W) + +/-- The obvious functor `C ⥤ W.localization` -/ +def Q : C ⥤ W.localization := +{ obj := λ X, (quotient.functor _).obj (paths.of.obj ⟨X⟩), + map := λ X Y f, (quotient.functor _).map (ψ₁ W f), + map_id' := λ X, quotient.sound _ (relations.id X), + map_comp' := λ X Z Y f g, quotient.sound _ (relations.comp f g), } + +end morphism_property + +namespace localization + +namespace construction + +variable {W} + +/-- The isomorphism in `W.localization` associated to a morphism `w` in W -/ +def Wiso {X Y : C} (w : X ⟶ Y) (hw : W w) : iso (W.Q.obj X) (W.Q.obj Y) := +{ hom := W.Q.map w, + inv := (quotient.functor _).map (paths.of.map (sum.inr ⟨w, hw⟩)), + hom_inv_id' := quotient.sound _ (relations.Winv₁ w hw), + inv_hom_id' := quotient.sound _ (relations.Winv₂ w hw), } + +/-- The formal inverse in `W.localization` of a morphism `w` in `W`. -/ +abbreviation Winv {X Y : C} (w : X ⟶ Y) (hw : W w) := (Wiso w hw).inv + +variable (W) + +lemma _root_.category_theory.morphism_property.Q_inverts : W.is_inverted_by W.Q := +λ X Y w hw, is_iso.of_iso (localization.construction.Wiso w hw) + +variables {W} (G : C ⥤ D) (hG : W.is_inverted_by G) + +include G hG + +/-- The lifting of a functor to the path category of `loc_quiver W` -/ +@[simps] +def lift_to_path_category : paths (loc_quiver W) ⥤ D := +Quiv.lift +{ obj := λ X, G.obj X.obj, + map := λ X Y, begin + rintro (f|⟨g, hg⟩), + { exact G.map f, }, + { haveI := hG g hg, + exact inv (G.map g), }, + end, } + +/-- The lifting of a functor `C ⥤ D` inverting `W` as a functor `W.localization ⥤ D` -/ +@[simps] +def lift : W.localization ⥤ D := +quotient.lift (relations W) (lift_to_path_category G hG) +begin + rintro ⟨X⟩ ⟨Y⟩ f₁ f₂ r, + rcases r, + tidy, +end + +@[simp] +lemma fac : W.Q ⋙ lift G hG = G := +functor.ext (λ X, rfl) +begin + intros X Y f, + simp only [functor.comp_map, eq_to_hom_refl, comp_id, id_comp], + dsimp [lift, lift_to_path_category, morphism_property.Q], + rw compose_path_to_path, +end + +omit G hG + +lemma uniq (G₁ G₂ : W.localization ⥤ D) (h : W.Q ⋙ G₁ = W.Q ⋙ G₂) : + G₁ = G₂ := +begin + suffices h' : quotient.functor _ ⋙ G₁ = quotient.functor _ ⋙ G₂, + { refine functor.ext _ _, + { rintro ⟨⟨X⟩⟩, + apply functor.congr_obj h, }, + { rintros ⟨⟨X⟩⟩ ⟨⟨Y⟩⟩ ⟨f⟩, + apply functor.congr_hom h', }, }, + { refine paths.ext_functor _ _, + { ext X, + cases X, + apply functor.congr_obj h, }, + { rintro ⟨X⟩ ⟨Y⟩ (f|⟨w, hw⟩), + { simpa only using functor.congr_hom h f, }, + { have hw : W.Q.map w = (Wiso w hw).hom := rfl, + have hw' := functor.congr_hom h w, + simp only [functor.comp_map, hw] at hw', + refine functor.congr_inv_of_congr_hom _ _ _ _ _ hw', + all_goals + { apply functor.congr_obj h, }, }, }, }, +end + +variable (W) + +/-- The canonical bijection between objects in a category and its +localization with respect to a morphism_property `W` -/ +@[simps] +def obj_equiv : C ≃ W.localization := +{ to_fun := W.Q.obj, + inv_fun := λ X, X.as.obj, + left_inv := λ X, rfl, + right_inv := by { rintro ⟨⟨X⟩⟩, refl, }, } + +variable {W} + +/-- A `morphism_property` in `W.localization` is satisfied by all +morphisms in the localized category if it contains the image of the +morphisms in the original category, the inverses of the morphisms +in `W` and if it is stable under composition -/ +lemma morphism_property_is_top + (P : morphism_property W.localization) + (hP₁ : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), P (W.Q.map f)) + (hP₂ : ∀ ⦃X Y : C⦄ (w : X ⟶ Y) (hw : W w), P (Winv w hw)) + (hP₃ : P.stable_under_composition) : P = ⊤ := +begin + ext X Y f, + split, + { intro hf, + simp only [pi.top_apply], }, + { intro hf, clear hf, + let G : _ ⥤ W.localization := quotient.functor _, + suffices : ∀ (X₁ X₂ : C) (p : localization.construction.ι_paths W X₁ ⟶ + localization.construction.ι_paths W X₂), P (G.map p), + { rcases X with ⟨⟨X⟩⟩, + rcases Y with ⟨⟨Y⟩⟩, + simpa only [functor.image_preimage] using this _ _ (G.preimage f), }, + intros X₁ X₂ p, + induction p with X₂ X₃ p g hp, + { simpa only [functor.map_id] using hP₁ (𝟙 X₁), }, + { cases X₂, + cases X₃, + let p' : ι_paths W X₁ ⟶ ι_paths W X₂ := p, + rw [show p.cons g = p' ≫ quiver.hom.to_path g, by refl, G.map_comp], + refine hP₃ _ _ hp _, + rcases g with (g | ⟨g, hg⟩), + { apply hP₁, }, + { apply hP₂, }, }, }, +end + +/-- A `morphism_property` in `W.localization` is satisfied by all +morphisms in the localized category if it contains the image of the +morphisms in the original category, if is stable under composition +and if the property is stable by passing to inverses. -/ +lemma morphism_property_is_top' + (P : morphism_property W.localization) + (hP₁ : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), P (W.Q.map f)) + (hP₂ : ∀ ⦃X Y : W.localization⦄ (e : X ≅ Y) (he : P e.hom), P e.inv) + (hP₃ : P.stable_under_composition) : P = ⊤ := +morphism_property_is_top P hP₁ (λ X Y w hw, hP₂ _ (by exact hP₁ w)) hP₃ + +namespace nat_trans_extension + +variables {F₁ F₂ : W.localization ⥤ D} (τ : W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂) +include τ + +/-- If `F₁` and `F₂` are functors `W.localization ⥤ D` and if we have +`τ : W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂`, we shall define a natural transformation `F₁ ⟶ F₂`. +This is the `app` field of this natural transformation. -/ +def app (X : W.localization) : F₁.obj X ⟶ F₂.obj X := +eq_to_hom (congr_arg F₁.obj ((obj_equiv W).right_inv X).symm) ≫ + τ.app ((obj_equiv W).inv_fun X) ≫ eq_to_hom (congr_arg F₂.obj ((obj_equiv W).right_inv X)) + +@[simp] +lemma app_eq (X : C) : (app τ) (W.Q.obj X) = τ.app X := +by simpa only [app, eq_to_hom_refl, comp_id, id_comp] + +end nat_trans_extension + +/-- If `F₁` and `F₂` are functors `W.localization ⥤ D`, a natural transformation `F₁ ⟶ F₂` +can be obtained from a natural transformation `W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂`. -/ +@[simps] +def nat_trans_extension {F₁ F₂ : W.localization ⥤ D} (τ : W.Q ⋙ F₁ ⟶ W.Q ⋙ F₂) : + F₁ ⟶ F₂ := +{ app := nat_trans_extension.app τ, + naturality' := λ X Y f, begin + have h := morphism_property_is_top' + (morphism_property.naturality_property (nat_trans_extension.app τ)) _ + (morphism_property.naturality_property.is_stable_under_inverse _) + (morphism_property.naturality_property.is_stable_under_composition _), swap, + { intros X Y f, + simpa only [morphism_property.naturality_property, nat_trans_extension.app_eq] + using τ.naturality f, }, + have hf : (⊤ : morphism_property _) f := by simp only [pi.top_apply], + simpa only [← h] using hf, + end, } + +@[simp] +lemma nat_trans_extension_hcomp {F G : W.localization ⥤ D} (τ : W.Q ⋙ F ⟶ W.Q ⋙ G) : + (𝟙 W.Q) ◫ nat_trans_extension τ = τ := +begin + ext X, + simp only [nat_trans.hcomp_app, nat_trans.id_app, G.map_id, comp_id, + nat_trans_extension_app, nat_trans_extension.app_eq], +end + +lemma nat_trans_hcomp_injective {F G : W.localization ⥤ D} {τ₁ τ₂ : F ⟶ G} + (h : 𝟙 W.Q ◫ τ₁ = 𝟙 W.Q ◫ τ₂) : τ₁ = τ₂ := +begin + ext X, + have eq := (obj_equiv W).right_inv X, + simp only [obj_equiv] at eq, + rw [← eq, ← nat_trans.id_hcomp_app, ← nat_trans.id_hcomp_app, h], +end + +variables (W D) + +namespace whiskering_left_equivalence + +/-- The functor `(W.localization ⥤ D) ⥤ (W.functors_inverting D)` induced by the +composition with `W.Q : C ⥤ W.localization`. -/ +@[simps] +def functor : (W.localization ⥤ D) ⥤ (W.functors_inverting D) := +full_subcategory.lift _ ((whiskering_left _ _ D).obj W.Q) + (λ F, morphism_property.is_inverted_by.of_comp W W.Q W.Q_inverts _) + +/-- The function `(W.functors_inverting D) ⥤ (W.localization ⥤ D)` induced by +`construction.lift`. -/ +@[simps] +def inverse : (W.functors_inverting D) ⥤ (W.localization ⥤ D) := +{ obj := λ G, lift G.obj G.property, + map := λ G₁ G₂ τ, nat_trans_extension (eq_to_hom (by rw fac) ≫ τ ≫ eq_to_hom (by rw fac)), + map_id' := λ G, nat_trans_hcomp_injective begin + rw nat_trans_extension_hcomp, + ext X, + simpa only [nat_trans.comp_app, eq_to_hom_app, eq_to_hom_refl, comp_id, id_comp, + nat_trans.hcomp_id_app, nat_trans.id_app, functor.map_id], + end, + map_comp' := λ G₁ G₂ G₃ τ₁ τ₂, nat_trans_hcomp_injective begin + ext X, + simpa only [nat_trans_extension_hcomp, nat_trans.comp_app, eq_to_hom_app, eq_to_hom_refl, + id_comp, comp_id, nat_trans.hcomp_app, nat_trans.id_app, functor.map_id, + nat_trans_extension_app, nat_trans_extension.app_eq], + end, } + +/-- The unit isomorphism of the equivalence of categories `whiskering_left_equivalence W D`. -/ +@[simps] +def unit_iso : 𝟭 (W.localization ⥤ D) ≅ functor W D ⋙ inverse W D := eq_to_iso +begin + refine functor.ext (λ G, _) (λ G₁ G₂ τ, _), + { apply uniq, + dsimp [functor], + rw fac, }, + { apply nat_trans_hcomp_injective, + ext X, + simp only [functor.id_map, nat_trans.hcomp_app, comp_id, functor.comp_map, + inverse_map, nat_trans.comp_app, eq_to_hom_app, eq_to_hom_refl, nat_trans_extension_app, + nat_trans_extension.app_eq, functor_map_app, id_comp], }, +end + +/-- The counit isomorphism of the equivalence of categories `whiskering_left_equivalence W D`. -/ +@[simps] +def counit_iso : inverse W D ⋙ functor W D ≅ 𝟭 (W.functors_inverting D) := eq_to_iso +begin + refine functor.ext _ _, + { rintro ⟨G, hG⟩, + ext1, + apply fac, }, + { rintros ⟨G₁, hG₁⟩ ⟨G₂, hG₂⟩ f, + ext X, + apply nat_trans_extension.app_eq, }, +end + +end whiskering_left_equivalence + +/-- The equivalence of categories `(W.localization ⥤ D) ≌ (W.functors_inverting D)` +induced by the composition with `W.Q : C ⥤ W.localization`. -/ +def whiskering_left_equivalence : (W.localization ⥤ D) ≌ W.functors_inverting D := +{ functor := whiskering_left_equivalence.functor W D, + inverse := whiskering_left_equivalence.inverse W D, + unit_iso := whiskering_left_equivalence.unit_iso W D, + counit_iso := whiskering_left_equivalence.counit_iso W D, + functor_unit_iso_comp' := λ F, begin + ext X, + simpa only [eq_to_hom_app, whiskering_left_equivalence.unit_iso_hom, + whiskering_left_equivalence.counit_iso_hom, eq_to_hom_map, eq_to_hom_trans, + eq_to_hom_refl], + end, } + +end construction + +end localization + +end category_theory diff --git a/src/category_theory/localization/opposite.lean b/src/category_theory/localization/opposite.lean new file mode 100644 index 0000000000000..97b70abd9b354 --- /dev/null +++ b/src/category_theory/localization/opposite.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.localization.predicate + +/-! + +# Localization of the opposite category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +If a functor `L : C ⥤ D` is a localization functor for `W : morphism_property C`, it +is shown in this file that `L.op : Cᵒᵖ ⥤ Dᵒᵖ` is also a localization functor. + +-/ + +noncomputable theory + +open category_theory category_theory.category + +namespace category_theory + +variables {C D : Type*} [category C] [category D] {L : C ⥤ D} {W : morphism_property C} + +namespace localization + +/-- If `L : C ⥤ D` satisfies the universal property of the localisation +for `W : morphism_property C`, then `L.op` also does. -/ +def strict_universal_property_fixed_target.op {E : Type*} [category E] + (h : strict_universal_property_fixed_target L W Eᵒᵖ): + strict_universal_property_fixed_target L.op W.op E := +{ inverts := h.inverts.op, + lift := λ F hF, (h.lift F.right_op hF.right_op).left_op, + fac := λ F hF, begin + convert congr_arg functor.left_op (h.fac F.right_op hF.right_op), + exact F.right_op_left_op_eq.symm, + end, + uniq := λ F₁ F₂ eq, begin + suffices : F₁.right_op = F₂.right_op, + { rw [← F₁.right_op_left_op_eq, ← F₂.right_op_left_op_eq, this], }, + have eq' := congr_arg functor.right_op eq, + exact h.uniq _ _ eq', + end, } + +instance is_localization_op : W.Q.op.is_localization W.op := +functor.is_localization.mk' W.Q.op W.op + (strict_universal_property_fixed_target_Q W _).op + (strict_universal_property_fixed_target_Q W _).op + +end localization + +namespace functor + +instance is_localization.op [h : L.is_localization W] : L.op.is_localization W.op := +is_localization.of_equivalence_target W.Q.op W.op L.op + (localization.equivalence_from_model L W).op + (nat_iso.op (localization.Q_comp_equivalence_from_model_functor_iso L W).symm) + +end functor + +end category_theory diff --git a/src/category_theory/localization/predicate.lean b/src/category_theory/localization/predicate.lean new file mode 100644 index 0000000000000..89756a2b70089 --- /dev/null +++ b/src/category_theory/localization/predicate.lean @@ -0,0 +1,369 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.localization.construction + +/-! + +# Predicate for localized categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, a predicate `L.is_localization W` is introduced for a functor `L : C ⥤ D` +and `W : morphism_property C`: it expresses that `L` identifies `D` with the localized +category of `C` with respect to `W` (up to equivalence). + +We introduce a universal property `strict_universal_property_fixed_target L W E` which +states that `L` inverts the morphisms in `W` and that all functors `C ⥤ E` inverting +`W` uniquely factors as a composition of `L ⋙ G` with `G : D ⥤ E`. Such universal +properties are inputs for the constructor `is_localization.mk'` for `L.is_localization W`. + +When `L : C ⥤ D` is a localization functor for `W : morphism_property` (i.e. when +`[L.is_localization W]` holds), for any category `E`, there is +an equivalence `functor_equivalence L W E : (D ⥤ E) ≌ (W.functors_inverting E)` +that is induced by the composition with the functor `L`. When two functors +`F : C ⥤ E` and `F' : D ⥤ E` correspond via this equivalence, we shall say +that `F'` lifts `F`, and the associated isomorphism `L ⋙ F' ≅ F` is the +datum that is part of the class `lifting L W F F'`. The functions +`lift_nat_trans` and `lift_nat_iso` can be used to lift natural transformations +and natural isomorphisms between functors. + +-/ + +noncomputable theory + +namespace category_theory + +open category + +variables {C D : Type*} [category C] [category D] + (L : C ⥤ D) (W : morphism_property C) + (E : Type*) [category E] + +namespace functor + +/-- The predicate expressing that, up to equivalence, a functor `L : C ⥤ D` +identifies the category `D` with the localized category of `C` with respect +to `W : morphism_property C`. -/ +class is_localization : Prop := +(inverts : W.is_inverted_by L) +(nonempty_is_equivalence : nonempty (is_equivalence (localization.construction.lift L inverts))) + +instance Q_is_localization : W.Q.is_localization W := +{ inverts := W.Q_inverts, + nonempty_is_equivalence := begin + suffices : localization.construction.lift W.Q W.Q_inverts = 𝟭 _, + { apply nonempty.intro, rw this, apply_instance, }, + apply localization.construction.uniq, + simpa only [localization.construction.fac], + end, } + +end functor + +namespace localization + +/-- This universal property states that a functor `L : C ⥤ D` inverts morphisms +in `W` and the all functors `D ⥤ E` (for a fixed category `E`) uniquely factors +through `L`. -/ +structure strict_universal_property_fixed_target := +(inverts : W.is_inverted_by L) +(lift : Π (F : C ⥤ E) (hF : W.is_inverted_by F), D ⥤ E) +(fac : Π (F : C ⥤ E) (hF : W.is_inverted_by F), L ⋙ lift F hF = F) +(uniq : Π (F₁ F₂ : D ⥤ E) (h : L ⋙ F₁ = L ⋙ F₂), F₁ = F₂) + +/-- The localized category `W.localization` that was constructed satisfies +the universal property of the localization. -/ +@[simps] +def strict_universal_property_fixed_target_Q : + strict_universal_property_fixed_target W.Q W E := +{ inverts := W.Q_inverts, + lift := construction.lift, + fac := construction.fac, + uniq := construction.uniq, } + +instance : inhabited (strict_universal_property_fixed_target W.Q W E) := +⟨strict_universal_property_fixed_target_Q _ _⟩ + +/-- When `W` consists of isomorphisms, the identity satisfies the universal property +of the localization. -/ +@[simps] +def strict_universal_property_fixed_target_id (hW : W ⊆ morphism_property.isomorphisms C): + strict_universal_property_fixed_target (𝟭 C) W E := +{ inverts := λ X Y f hf, hW f hf, + lift := λ F hF, F, + fac := λ F hF, by { cases F, refl, }, + uniq := λ F₁ F₂ eq, by { cases F₁, cases F₂, exact eq, }, } + +end localization + +namespace functor + +lemma is_localization.mk' + (h₁ : localization.strict_universal_property_fixed_target L W D) + (h₂ : localization.strict_universal_property_fixed_target L W W.localization) : + is_localization L W := +{ inverts := h₁.inverts, + nonempty_is_equivalence := nonempty.intro + { inverse := h₂.lift W.Q W.Q_inverts, + unit_iso := eq_to_iso (localization.construction.uniq _ _ + (by simp only [← functor.assoc, localization.construction.fac, h₂.fac, functor.comp_id])), + counit_iso := eq_to_iso (h₁.uniq _ _ (by simp only [← functor.assoc, h₂.fac, + localization.construction.fac, functor.comp_id])), + functor_unit_iso_comp' := λ X, by simpa only [eq_to_iso.hom, eq_to_hom_app, + eq_to_hom_map, eq_to_hom_trans, eq_to_hom_refl], }, } + +lemma is_localization.for_id (hW : W ⊆ morphism_property.isomorphisms C): + (𝟭 C).is_localization W := +is_localization.mk' _ _ + (localization.strict_universal_property_fixed_target_id W _ hW) + (localization.strict_universal_property_fixed_target_id W _ hW) + +end functor + +namespace localization + +variable [L.is_localization W] + +lemma inverts : W.is_inverted_by L := (infer_instance : L.is_localization W).inverts + +/-- The isomorphism `L.obj X ≅ L.obj Y` that is deduced from a morphism `f : X ⟶ Y` which +belongs to `W`, when `L.is_localization W`. -/ +@[simps] +def iso_of_hom {X Y : C} (f : X ⟶ Y) (hf : W f) : L.obj X ≅ L.obj Y := +by { haveI : is_iso (L.map f) := inverts L W f hf, exact as_iso (L.map f), } + +instance : is_equivalence (localization.construction.lift L (inverts L W)) := +(infer_instance : L.is_localization W).nonempty_is_equivalence.some + +/-- A chosen equivalence of categories `W.localization ≅ D` for a functor +`L : C ⥤ D` which satisfies `L.is_localization W`. This shall be used in +order to deduce properties of `L` from properties of `W.Q`. -/ +def equivalence_from_model : W.localization ≌ D := +(localization.construction.lift L (inverts L W)).as_equivalence + +/-- Via the equivalence of categories `equivalence_from_model L W : W.localization ≌ D`, +one may identify the functors `W.Q` and `L`. -/ +def Q_comp_equivalence_from_model_functor_iso : + W.Q ⋙ (equivalence_from_model L W).functor ≅ L := eq_to_iso (construction.fac _ _) + +/-- Via the equivalence of categories `equivalence_from_model L W : W.localization ≌ D`, +one may identify the functors `L` and `W.Q`. -/ +def comp_equivalence_from_model_inverse_iso : + L ⋙ (equivalence_from_model L W).inverse ≅ W.Q := +calc L ⋙ (equivalence_from_model L W).inverse ≅ _ : + iso_whisker_right (Q_comp_equivalence_from_model_functor_iso L W).symm _ +... ≅ W.Q ⋙ ((equivalence_from_model L W).functor ⋙ (equivalence_from_model L W).inverse) : + functor.associator _ _ _ +... ≅ W.Q ⋙ 𝟭 _ : iso_whisker_left _ ((equivalence_from_model L W).unit_iso.symm) +... ≅ W.Q : functor.right_unitor _ + +lemma ess_surj : ess_surj L := +⟨λ X, ⟨(construction.obj_equiv W).inv_fun ((equivalence_from_model L W).inverse.obj X), + nonempty.intro ((Q_comp_equivalence_from_model_functor_iso L W).symm.app _ ≪≫ + (equivalence_from_model L W).counit_iso.app X)⟩⟩ + +/-- The functor `(D ⥤ E) ⥤ W.functors_inverting E` induced by the composition +with a localization functor `L : C ⥤ D` with respect to `W : morphism_property C`. -/ +def whiskering_left_functor : (D ⥤ E) ⥤ W.functors_inverting E := +full_subcategory.lift _ ((whiskering_left _ _ E).obj L) + (morphism_property.is_inverted_by.of_comp W L (inverts L W )) + +instance : is_equivalence (whiskering_left_functor L W E) := +begin + refine is_equivalence.of_iso _ (is_equivalence.of_equivalence + ((equivalence.congr_left (equivalence_from_model L W).symm).trans + (construction.whiskering_left_equivalence W E))), + refine nat_iso.of_components (λ F, eq_to_iso begin + ext, + change (W.Q ⋙ (localization.construction.lift L (inverts L W))) ⋙ F = L ⋙ F, + rw construction.fac, + end) + (λ F₁ F₂ τ, begin + ext X, + dsimp [equivalence_from_model, whisker_left, construction.whiskering_left_equivalence, + construction.whiskering_left_equivalence.functor, whiskering_left_functor, + morphism_property.Q], + erw [nat_trans.comp_app, nat_trans.comp_app, eq_to_hom_app, eq_to_hom_app, + eq_to_hom_refl, eq_to_hom_refl, comp_id, id_comp], + all_goals + { change (W.Q ⋙ (localization.construction.lift L (inverts L W))) ⋙ _ = L ⋙ _, + rw construction.fac, }, + end), +end + +/-- The equivalence of categories `(D ⥤ E) ≌ (W.functors_inverting E)` induced by +the composition with a localization functor `L : C ⥤ D` with respect to +`W : morphism_property C`. -/ +def functor_equivalence : (D ⥤ E) ≌ (W.functors_inverting E) := +(whiskering_left_functor L W E).as_equivalence + +include W + +/-- The functor `(D ⥤ E) ⥤ (C ⥤ E)` given by the composition with a localization +functor `L : C ⥤ D` with respect to `W : morphism_property C`. -/ +@[nolint unused_arguments] +def whiskering_left_functor' : + (D ⥤ E) ⥤ (C ⥤ E) := (whiskering_left C D E).obj L + +lemma whiskering_left_functor'_eq : + whiskering_left_functor' L W E = + localization.whiskering_left_functor L W E ⋙ induced_functor _ := rfl + +variable {E} + +@[simp] +lemma whiskering_left_functor'_obj + (F : D ⥤ E) : (whiskering_left_functor' L W E).obj F = L ⋙ F := rfl + +instance : full (whiskering_left_functor' L W E) := +by { rw whiskering_left_functor'_eq, apply_instance, } + +instance : faithful (whiskering_left_functor' L W E) := +by { rw whiskering_left_functor'_eq, apply_instance, } + +lemma nat_trans_ext {F₁ F₂ : D ⥤ E} (τ τ' : F₁ ⟶ F₂) + (h : ∀ (X : C), τ.app (L.obj X) = τ'.app (L.obj X)) : τ = τ' := +begin + haveI : category_theory.ess_surj L := ess_surj L W, + ext Y, + rw [← cancel_epi (F₁.map (L.obj_obj_preimage_iso Y).hom), τ.naturality, τ'.naturality, h], +end + +/-- When `L : C ⥤ D` is a localization functor for `W : morphism_property C` and +`F : C ⥤ E` is a functor, we shall say that `F' : D ⥤ E` lifts `F` if the obvious diagram +is commutative up to an isomorphism. -/ +class lifting (F : C ⥤ E) (F' : D ⥤ E) := +(iso [] : L ⋙ F' ≅ F) + +variable {W} + +/-- Given a localization functor `L : C ⥤ D` for `W : morphism_property C` and +a functor `F : C ⥤ E` which inverts `W`, this is a choice of functor +`D ⥤ E` which lifts `F`. -/ +def lift (F : C ⥤ E) (hF : W.is_inverted_by F) (L : C ⥤ D) [hL : L.is_localization W] : + D ⥤ E := +(functor_equivalence L W E).inverse.obj ⟨F, hF⟩ + +instance lifting_lift (F : C ⥤ E) (hF : W.is_inverted_by F) (L : C ⥤ D) + [hL : L.is_localization W] : lifting L W F (lift F hF L) := +⟨(induced_functor _).map_iso ((functor_equivalence L W E).counit_iso.app ⟨F, hF⟩)⟩ + +/-- The canonical isomorphism `L ⋙ lift F hF L ≅ F` for any functor `F : C ⥤ E` +which inverts `W`, when `L : C ⥤ D` is a localization functor for `W`. -/ +@[simps] +def fac (F : C ⥤ E) (hF : W.is_inverted_by F) (L : C ⥤ D) [hL : L.is_localization W] : + L ⋙ lift F hF L ≅ F := +lifting.iso _ W _ _ + +instance lifting_construction_lift (F : C ⥤ D) (hF : W.is_inverted_by F) : + lifting W.Q W F (construction.lift F hF) := +⟨eq_to_iso (construction.fac F hF)⟩ + +variable (W) + +/-- Given a localization functor `L : C ⥤ D` for `W : morphism_property C`, +if `(F₁' F₂' : D ⥤ E)` are functors which lifts functors `(F₁ F₂ : C ⥤ E)`, +a natural transformation `τ : F₁ ⟶ F₂` uniquely lifts to a natural transformation `F₁' ⟶ F₂'`. -/ +def lift_nat_trans (F₁ F₂ : C ⥤ E) (F₁' F₂' : D ⥤ E) [lifting L W F₁ F₁'] + [h₂ : lifting L W F₂ F₂'] (τ : F₁ ⟶ F₂) : F₁' ⟶ F₂' := +(whiskering_left_functor' L W E).preimage + ((lifting.iso L W F₁ F₁').hom ≫ τ ≫ (lifting.iso L W F₂ F₂').inv) + +@[simp] +lemma lift_nat_trans_app (F₁ F₂ : C ⥤ E) (F₁' F₂' : D ⥤ E) [lifting L W F₁ F₁'] + [lifting L W F₂ F₂'] (τ : F₁ ⟶ F₂) (X : C) : + (lift_nat_trans L W F₁ F₂ F₁' F₂' τ).app (L.obj X) = + (lifting.iso L W F₁ F₁').hom.app X ≫ τ.app X ≫ ((lifting.iso L W F₂ F₂')).inv.app X := +congr_app (functor.image_preimage (whiskering_left_functor' L W E) _) X + +@[simp, reassoc] +lemma comp_lift_nat_trans (F₁ F₂ F₃ : C ⥤ E) (F₁' F₂' F₃' : D ⥤ E) + [h₁ : lifting L W F₁ F₁'] [h₂ : lifting L W F₂ F₂'] [h₃ : lifting L W F₃ F₃'] + (τ : F₁ ⟶ F₂) (τ' : F₂ ⟶ F₃) : + lift_nat_trans L W F₁ F₂ F₁' F₂' τ ≫ lift_nat_trans L W F₂ F₃ F₂' F₃' τ' = + lift_nat_trans L W F₁ F₃ F₁' F₃' (τ ≫ τ') := +nat_trans_ext L W _ _ + (λ X, by simp only [nat_trans.comp_app, lift_nat_trans_app, assoc, iso.inv_hom_id_app_assoc]) + +@[simp] +lemma lift_nat_trans_id (F : C ⥤ E) (F' : D ⥤ E) [h : lifting L W F F'] : + lift_nat_trans L W F F F' F' (𝟙 F) = 𝟙 F' := +nat_trans_ext L W _ _ + (λ X, by simpa only [lift_nat_trans_app, nat_trans.id_app, id_comp, iso.hom_inv_id_app]) + +/-- Given a localization functor `L : C ⥤ D` for `W : morphism_property C`, +if `(F₁' F₂' : D ⥤ E)` are functors which lifts functors `(F₁ F₂ : C ⥤ E)`, +a natural isomorphism `τ : F₁ ⟶ F₂` lifts to a natural isomorphism `F₁' ⟶ F₂'`. -/ +@[simps] +def lift_nat_iso (F₁ F₂ : C ⥤ E) (F₁' F₂' : D ⥤ E) + [h₁ : lifting L W F₁ F₁'] [h₂ : lifting L W F₂ F₂'] + (e : F₁ ≅ F₂) : F₁' ≅ F₂' := +{ hom := lift_nat_trans L W F₁ F₂ F₁' F₂' e.hom, + inv := lift_nat_trans L W F₂ F₁ F₂' F₁' e.inv, } + +namespace lifting + +@[simps] +instance comp_right {E' : Type*} [category E'] (F : C ⥤ E) (F' : D ⥤ E) [lifting L W F F'] + (G : E ⥤ E') : lifting L W (F ⋙ G) (F' ⋙ G) := +⟨iso_whisker_right (iso L W F F') G⟩ + +@[simps] +instance id : lifting L W L (𝟭 D) := +⟨functor.right_unitor L⟩ + +/-- Given a localization functor `L : C ⥤ D` for `W : morphism_property C`, +if `F₁' : D ⥤ E` lifts a functor `F₁ : C ⥤ D`, then a functor `F₂'` which +is isomorphic to `F₁'` also lifts a functor `F₂` that is isomorphic to `F₁`. -/ +@[simps] +def of_isos {F₁ F₂ : C ⥤ E} {F₁' F₂' : D ⥤ E} (e : F₁ ≅ F₂) (e' : F₁' ≅ F₂') + [lifting L W F₁ F₁'] : lifting L W F₂ F₂' := +⟨iso_whisker_left L e'.symm ≪≫ iso L W F₁ F₁' ≪≫ e⟩ + +end lifting + +end localization + +namespace functor + +namespace is_localization + +open localization + +lemma of_iso {L₁ L₂ : C ⥤ D} (e : L₁ ≅ L₂) [L₁.is_localization W] : L₂.is_localization W := +begin + have h := localization.inverts L₁ W, + rw morphism_property.is_inverted_by.iff_of_iso W e at h, + let F₁ := localization.construction.lift L₁ (localization.inverts L₁ W), + let F₂ := localization.construction.lift L₂ h, + exact + { inverts := h, + nonempty_is_equivalence := nonempty.intro + (is_equivalence.of_iso (lift_nat_iso W.Q W L₁ L₂ F₁ F₂ e) infer_instance), }, +end + +/-- If `L : C ⥤ D` is a localization for `W : morphism_property C`, then it is also +the case of a functor obtained by post-composing `L` with an equivalence of categories. -/ +lemma of_equivalence_target {E : Type*} [category E] (L' : C ⥤ E) (eq : D ≌ E) + [L.is_localization W] (e : L ⋙ eq.functor ≅ L') : L'.is_localization W := +begin + have h : W.is_inverted_by L', + { rw ← morphism_property.is_inverted_by.iff_of_iso W e, + exact morphism_property.is_inverted_by.of_comp W L (localization.inverts L W) eq.functor, }, + let F₁ := localization.construction.lift L (localization.inverts L W), + let F₂ := localization.construction.lift L' h, + let e' : F₁ ⋙ eq.functor ≅ F₂ := lift_nat_iso W.Q W (L ⋙ eq.functor) L' _ _ e, + exact + { inverts := h, + nonempty_is_equivalence := nonempty.intro (is_equivalence.of_iso e' infer_instance) }, +end + +end is_localization + +end functor + +end category_theory diff --git a/src/category_theory/monad/adjunction.lean b/src/category_theory/monad/adjunction.lean index 3aa80891db0b4..e492d3f7a6923 100644 --- a/src/category_theory/monad/adjunction.lean +++ b/src/category_theory/monad/adjunction.lean @@ -6,6 +6,26 @@ Authors: Scott Morrison, Bhavik Mehta import category_theory.adjunction.reflective import category_theory.monad.algebra +/-! +# Adjunctions and monads + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We develop the basic relationship between adjunctions and monads. + +Given an adjunction `h : L ⊣ R`, we have `h.to_monad : monad C` and `h.to_comonad : comonad D`. +We then have +`monad.comparison (h : L ⊣ R) : D ⥤ h.to_monad.algebra` +sending `Y : D` to the Eilenberg-Moore algebra for `L ⋙ R` with underlying object `R.obj X`, +and dually `comonad.comparison`. + +We say `R : D ⥤ C` is `monadic_right_adjoint`, if it is a right adjoint and its `monad.comparison` +is an equivalence of categories. (Similarly for `monadic_left_adjoint`.) + +Finally we prove that reflective functors are `monadic_right_adjoint`. +-/ + namespace category_theory open category diff --git a/src/category_theory/monad/algebra.lean b/src/category_theory/monad/algebra.lean index 59e143acc3ad0..4f034f3323988 100644 --- a/src/category_theory/monad/algebra.lean +++ b/src/category_theory/monad/algebra.lean @@ -5,10 +5,14 @@ Authors: Scott Morrison, Bhavik Mehta -/ import category_theory.monad.basic import category_theory.adjunction.basic +import category_theory.functor.epi_mono /-! # Eilenberg-Moore (co)algebras for a (co)monad +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines Eilenberg-Moore (co)algebras for a (co)monad, and provides the category instance for them. @@ -150,6 +154,16 @@ instance forget_reflects_iso : reflects_isomorphisms T.forget := instance forget_faithful : faithful T.forget := {} +/-- Given an algebra morphism whose carrier part is an epimorphism, we get an algebra epimorphism. +-/ +lemma algebra_epi_of_epi {X Y : algebra T} (f : X ⟶ Y) [h : epi f.f] : epi f := +(forget T).epi_of_epi_map h + +/-- Given an algebra morphism whose carrier part is a monomorphism, we get an algebra monomorphism. +-/ +lemma algebra_mono_of_mono {X Y : algebra T} (f : X ⟶ Y) [h : mono f.f] : mono f := +(forget T).mono_of_mono_map h + instance : is_right_adjoint T.forget := ⟨T.free, T.adj⟩ @[simp] lemma left_adjoint_forget : left_adjoint T.forget = T.free := rfl @[simp] lemma of_right_adjoint_forget : adjunction.of_right_adjoint T.forget = T.adj := rfl @@ -230,7 +244,7 @@ end monad namespace comonad /-- An Eilenberg-Moore coalgebra for a comonad `T`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure coalgebra (G : comonad C) : Type (max u₁ v₁) := (A : C) (a : A ⟶ (G : C ⥤ C).obj A) @@ -245,7 +259,7 @@ namespace coalgebra variables {G : comonad C} /-- A morphism of Eilenberg-Moore coalgebras for the comonad `G`. -/ -@[ext, nolint has_inhabited_instance] structure hom (A B : coalgebra G) := +@[ext, nolint has_nonempty_instance] structure hom (A B : coalgebra G) := (f : A.A ⟶ B.A) (h' : A.a ≫ (G : C ⥤ C).map f = f ≫ B.a . obviously) @@ -350,6 +364,16 @@ instance forget_reflects_iso : reflects_isomorphisms G.forget := instance forget_faithful : faithful (forget G) := {} +/-- Given a coalgebra morphism whose carrier part is an epimorphism, we get an algebra epimorphism. +-/ +lemma algebra_epi_of_epi {X Y : coalgebra G} (f : X ⟶ Y) [h : epi f.f] : epi f := +(forget G).epi_of_epi_map h + +/-- Given a coalgebra morphism whose carrier part is a monomorphism, we get an algebra monomorphism. +-/ +lemma algebra_mono_of_mono {X Y : coalgebra G} (f : X ⟶ Y) [h : mono f.f] : mono f := +(forget G).mono_of_mono_map h + instance : is_left_adjoint G.forget := ⟨_, G.adj⟩ @[simp] lemma right_adjoint_forget : right_adjoint G.forget = G.cofree := rfl @[simp] lemma of_left_adjoint_forget : adjunction.of_left_adjoint G.forget = G.adj := rfl diff --git a/src/category_theory/monad/basic.lean b/src/category_theory/monad/basic.lean index 39ef7f54e7773..69302b5bd815b 100644 --- a/src/category_theory/monad/basic.lean +++ b/src/category_theory/monad/basic.lean @@ -7,6 +7,21 @@ import category_theory.functor.category import category_theory.functor.fully_faithful import category_theory.functor.reflects_isomorphisms +/-! +# Monads + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct the categories of monads and comonads, and their forgetful functors to endofunctors. + +(Note that these are the category theorist's monads, not the programmers monads. +For the translation, see the file `category_theory.monad.types`.) + +For the fact that monads are "just" monoids in the category of endofunctors, see the file +`category_theory.monad.equiv_mon`. +-/ + namespace category_theory open category @@ -127,13 +142,23 @@ instance : category (monad C) := { hom := monad_hom, id := λ M, { to_nat_trans := 𝟙 (M : C ⥤ C) }, comp := λ _ _ _ f g, - { to_nat_trans := { app := λ X, f.app X ≫ g.app X } } } + { to_nat_trans := + { app := λ X, f.app X ≫ g.app X, + naturality' := λ X Y h, by rw [assoc, f.1.naturality_assoc, g.1.naturality] } }, + id_comp' := λ _ _ _, by {ext, apply id_comp}, + comp_id' := λ _ _ _, by {ext, apply comp_id}, + assoc' := λ _ _ _ _ _ _ _, by {ext, apply assoc} } instance : category (comonad C) := { hom := comonad_hom, id := λ M, { to_nat_trans := 𝟙 (M : C ⥤ C) }, - comp := λ M N L f g, - { to_nat_trans := { app := λ X, f.app X ≫ g.app X } } } + comp := λ _ _ _ f g, + { to_nat_trans := + { app := λ X, f.app X ≫ g.app X, + naturality' := λ X Y h, by rw [assoc, f.1.naturality_assoc, g.1.naturality] } }, + id_comp' := λ _ _ _, by {ext, apply id_comp}, + comp_id' := λ _ _ _, by {ext, apply comp_id}, + assoc' := λ _ _ _ _ _ _ _, by {ext, apply assoc} } instance {T : monad C} : inhabited (monad_hom T T) := ⟨𝟙 T⟩ @@ -201,7 +226,6 @@ def monad_to_functor : monad C ⥤ (C ⥤ C) := instance : faithful (monad_to_functor C) := {}. -@[simp] lemma monad_to_functor_map_iso_monad_iso_mk {M N : monad C} (f : (M : C ⥤ C) ≅ N) (f_η f_μ) : (monad_to_functor _).map_iso (monad_iso.mk f f_η f_μ) = f := by { ext, refl } @@ -224,7 +248,6 @@ def comonad_to_functor : comonad C ⥤ (C ⥤ C) := instance : faithful (comonad_to_functor C) := {}. -@[simp] lemma comonad_to_functor_map_iso_comonad_iso_mk {M N : comonad C} (f : (M : C ⥤ C) ≅ N) (f_ε f_δ) : (comonad_to_functor _).map_iso (comonad_iso.mk f f_ε f_δ) = f := by { ext, refl } diff --git a/src/category_theory/monad/coequalizer.lean b/src/category_theory/monad/coequalizer.lean index 8e08c1c3ff8c6..3954e674ec514 100644 --- a/src/category_theory/monad/coequalizer.lean +++ b/src/category_theory/monad/coequalizer.lean @@ -11,6 +11,9 @@ import category_theory.monad.algebra /-! # Special coequalizers associated to a monad +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Associated to a monad `T : C ⥤ C` we have important coequalizer constructions: Any algebra is a coequalizer (in the category of algebras) of free algebras. Furthermore, this coequalizer is reflexive. diff --git a/src/category_theory/monad/default.lean b/src/category_theory/monad/default.lean deleted file mode 100644 index 9068ea7602cc2..0000000000000 --- a/src/category_theory/monad/default.lean +++ /dev/null @@ -1,2 +0,0 @@ -import category_theory.monad.limits -import category_theory.monad.types diff --git a/src/category_theory/monad/equiv_mon.lean b/src/category_theory/monad/equiv_mon.lean index f29bfa0557036..7765dc2798ed7 100644 --- a/src/category_theory/monad/equiv_mon.lean +++ b/src/category_theory/monad/equiv_mon.lean @@ -6,12 +6,14 @@ Authors: Adam Topaz import category_theory.monad.basic import category_theory.monoidal.End import category_theory.monoidal.Mon_ -import category_theory.category.Cat /-! # The equivalence between `Monad C` and `Mon_ (C ⥤ C)`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A monad "is just" a monoid in the category of endofunctors. # Definitions/Theorems diff --git a/src/category_theory/monad/kleisli.lean b/src/category_theory/monad/kleisli.lean index 9aef0b22dba5f..0f3bff8e8f12b 100644 --- a/src/category_theory/monad/kleisli.lean +++ b/src/category_theory/monad/kleisli.lean @@ -7,10 +7,15 @@ Authors: Wojciech Nawrocki, Bhavik Mehta import category_theory.adjunction.basic import category_theory.monad.basic -/-! # Kleisli category on a monad +/-! # Kleisli category on a (co)monad -This file defines the Kleisli category on a monad `(T, η_ T, μ_ T)`. It also defines the Kleisli -adjunction which gives rise to the monad `(T, η_ T, μ_ T)`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the Kleisli category on a monad `(T, η_ T, μ_ T)` as well as the co-Kleisli +category on a comonad `(U, ε_ U, δ_ U)`. It also defines the Kleisli adjunction which gives rise to +the monad `(T, η_ T, μ_ T)` as well as the co-Kleisli adjunction which gives rise to the comonad +`(U, ε_ U, δ_ U)`. ## References * [Riehl, *Category theory in context*, Definition 5.2.9][riehl2017] @@ -22,7 +27,7 @@ universes v u -- morphism levels before object levels. See note [category_theory variables {C : Type u} [category.{v} C] /-- -The objects for the Kleisli category of the functor (usually monad) `T : C ⥤ C`, which are the same +The objects for the Kleisli category of the monad `T : monad C`, which are the same thing as objects of the base category `C`. -/ @[nolint unused_arguments] @@ -93,4 +98,65 @@ nat_iso.of_components (λ X, iso.refl _) (λ X Y f, by { dsimp, simp }) end adjunction end kleisli +/-- +The objects for the co-Kleisli category of the comonad `U : monad C`, which are the same +thing as objects of the base category `C`. +-/ +@[nolint unused_arguments] +def cokleisli (U : comonad C) := C + +namespace cokleisli + +variables (U : comonad C) + +instance [inhabited C] (U : comonad C) : inhabited (cokleisli U) := ⟨(default : C)⟩ + +/-- The co-Kleisli category on a comonad `U`.-/ +instance cokleisli.category : category (cokleisli U) := +{ hom := λ (X Y : C), (U : C ⥤ C).obj X ⟶ Y, + id := λ X, U.ε.app X, + comp := λ X Y Z f g, U.δ.app X ≫ (U : C ⥤ C).map f ≫ g, + id_comp' := λ X Y f, by rw U.right_counit_assoc, + assoc' := λ W X Y Z f g h, + begin unfold_projs, + simp only [functor.map_comp, ← category.assoc, U.δ.naturality_assoc, functor.comp_map, + U.coassoc] end } + +namespace adjunction + +/-- The right adjoint of the adjunction which induces the comonad `(U, ε_ U, δ_ U)`. -/ +@[simps] def to_cokleisli : C ⥤ cokleisli U := +{ obj := λ X, (X : cokleisli U), + map := λ X Y f, (U.ε.app X ≫ f : _), + map_comp' := λ X Y Z f g, by { unfold_projs, simp [← U.ε.naturality g] } } + +/-- The left adjoint of the adjunction which induces the comonad `(U, ε_ U, δ_ U)`. -/ +@[simps] def from_cokleisli : cokleisli U ⥤ C := +{ obj := λ X, U.obj X, + map := λ X Y f, U.δ.app X ≫ U.map f, + map_id' := λ X, U.right_counit _, + map_comp' := λ X Y Z f g, + begin + unfold_projs, + dsimp, + simp only [functor.map_comp, ← category.assoc], + rw comonad.coassoc, + simp only [category.assoc, nat_trans.naturality, functor.comp_map], + end } + +/-- The co-Kleisli adjunction which gives rise to the monad `(U, ε_ U, δ_ U)`. -/ +def adj : from_cokleisli U ⊣ to_cokleisli U := +adjunction.mk_of_hom_equiv +{ hom_equiv := λ X Y, equiv.refl (U.obj X ⟶ Y), + hom_equiv_naturality_right' := λ X Y Z f g, + begin unfold_projs, dsimp, erw [← category.assoc (U.map f), U.ε.naturality], dsimp, + simp only [← category.assoc, comonad.left_counit, category.id_comp] end } + +/-- The composition of the adjunction gives the original functor. -/ +def to_cokleisli_comp_from_cokleisli_iso_self : to_cokleisli U ⋙ from_cokleisli U ≅ U := +nat_iso.of_components (λ X, iso.refl _) (λ X Y f, by { dsimp, simp }) + +end adjunction +end cokleisli + end category_theory diff --git a/src/category_theory/monad/limits.lean b/src/category_theory/monad/limits.lean index fe9acefab8e64..31bac6c46e2d7 100644 --- a/src/category_theory/monad/limits.lean +++ b/src/category_theory/monad/limits.lean @@ -5,11 +5,14 @@ Authors: Scott Morrison, Bhavik Mehta -/ import category_theory.monad.adjunction import category_theory.adjunction.limits -import category_theory.limits.preserves.shapes.terminal +import category_theory.limits.shapes.terminal /-! # Limits and colimits in the category of algebras +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file shows that the forgetful functor `forget T : algebra T ⥤ C` for a monad `T : C ⥤ C` creates limits and creates any colimits which `T` preserves. This is used to show that `algebra T` has any limits which `C` has, and any colimits which `C` has @@ -339,8 +342,8 @@ lemma has_colimits_of_shape_of_reflective (R : D ⥤ C) { has_colimit := λ F, begin let c := (left_adjoint R).map_cocone (colimit.cocone (F ⋙ R)), - let h := (adjunction.of_right_adjoint R).left_adjoint_preserves_colimits.1, - letI := @h J _, + letI : preserves_colimits_of_shape J _ := + (adjunction.of_right_adjoint R).left_adjoint_preserves_colimits.1, let t : is_colimit c := is_colimit_of_preserves (left_adjoint R) (colimit.is_colimit _), apply has_colimit.mk ⟨_, (is_colimit.precompose_inv_equiv _ _).symm t⟩, apply (iso_whisker_left F (as_iso (adjunction.of_right_adjoint R).counit) : _) ≪≫ F.right_unitor, diff --git a/src/category_theory/monad/monadicity.lean b/src/category_theory/monad/monadicity.lean index b96ecf8ae5998..3caeaa2ad27b2 100644 --- a/src/category_theory/monad/monadicity.lean +++ b/src/category_theory/monad/monadicity.lean @@ -12,6 +12,9 @@ import category_theory.monad.limits /-! # Monadicity theorems +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove monadicity theorems which can establish a given functor is monadic. In particular, we show three versions of Beck's monadicity theorem, and the reflexive (crude) monadicity theorem: @@ -172,7 +175,7 @@ lemma comparison_adjunction_unit_f (beck_coequalizer A).desc (unit_cofork A) := begin apply limits.cofork.is_colimit.hom_ext (beck_coequalizer A), - rw [cofork.is_colimit.π_comp_desc], + rw [cofork.is_colimit.π_desc], dsimp only [beck_cofork_π, unit_cofork_π], rw [comparison_adjunction_unit_f_aux, ← adj .hom_equiv_naturality_left A.a, coequalizer.condition, adj .hom_equiv_naturality_right, adj .hom_equiv_unit, category.assoc], diff --git a/src/category_theory/monad/products.lean b/src/category_theory/monad/products.lean index fea2f76ee9680..2062ee02cf3be 100644 --- a/src/category_theory/monad/products.lean +++ b/src/category_theory/monad/products.lean @@ -10,6 +10,9 @@ import category_theory.limits.shapes.binary_products /-! # Algebras for the coproduct monad +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The functor `Y ↦ X ⨿ Y` forms a monad, whose category of monads is equivalent to the under category of `X`. Similarly, `Y ↦ X ⨯ Y` forms a comonad, whose category of comonads is equivalent to the over category of `X`. diff --git a/src/category_theory/monad/types.lean b/src/category_theory/monad/types.lean index 962cb2e07c726..f231851f08ff5 100644 --- a/src/category_theory/monad/types.lean +++ b/src/category_theory/monad/types.lean @@ -12,6 +12,9 @@ import category_theory.types # Convert from `monad` (i.e. Lean's `Type`-based monads) to `category_theory.monad` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This allows us to use these monads in category theory. -/ diff --git a/src/category_theory/monoidal/Bimod.lean b/src/category_theory/monoidal/Bimod.lean new file mode 100644 index 0000000000000..48b955f7b99b4 --- /dev/null +++ b/src/category_theory/monoidal/Bimod.lean @@ -0,0 +1,1020 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Oleksandr Manzyuk +-/ +import category_theory.bicategory.basic +import category_theory.monoidal.Mon_ +import category_theory.limits.preserves.shapes.equalizers + +/-! +# The category of bimodule objects over a pair of monoid objects. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes v₁ v₂ u₁ u₂ + +open category_theory +open category_theory.monoidal_category + +variables {C : Type u₁} [category.{v₁} C] [monoidal_category.{v₁} C] + +section + +open category_theory.limits + +variables [has_coequalizers C] + +section + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] + +lemma id_tensor_π_preserves_coequalizer_inv_desc + {W X Y Z : C} (f g : X ⟶ Y) + (h : Z ⊗ Y ⟶ W) (wh : (𝟙 Z ⊗ f) ≫ h = (𝟙 Z ⊗ g) ≫ h) : + (𝟙 Z ⊗ coequalizer.π f g) ≫ (preserves_coequalizer.iso (tensor_left Z) f g).inv ≫ + coequalizer.desc h wh = h := +map_π_preserves_coequalizer_inv_desc (tensor_left Z) f g h wh + +lemma id_tensor_π_preserves_coequalizer_inv_colim_map_desc + {X Y Z X' Y' Z' : C} (f g : X ⟶ Y) (f' g' : X' ⟶ Y') (p : Z ⊗ X ⟶ X') (q : Z ⊗ Y ⟶ Y') + (wf : (𝟙 Z ⊗ f) ≫ q = p ≫ f') (wg : (𝟙 Z ⊗ g) ≫ q = p ≫ g') + (h : Y' ⟶ Z') (wh : f' ≫ h = g' ≫ h) : + (𝟙 Z ⊗ coequalizer.π f g) ≫ (preserves_coequalizer.iso (tensor_left Z) f g).inv ≫ + colim_map (parallel_pair_hom (𝟙 Z ⊗ f) (𝟙 Z ⊗ g) f' g' p q wf wg) ≫ + coequalizer.desc h wh = + q ≫ h := +map_π_preserves_coequalizer_inv_colim_map_desc (tensor_left Z) f g f' g' p q wf wg h wh + +end + +section + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +lemma π_tensor_id_preserves_coequalizer_inv_desc + {W X Y Z : C} (f g : X ⟶ Y) + (h : Y ⊗ Z ⟶ W) (wh : (f ⊗ 𝟙 Z) ≫ h = (g ⊗ 𝟙 Z) ≫ h) : + (coequalizer.π f g ⊗ 𝟙 Z) ≫ (preserves_coequalizer.iso (tensor_right Z) f g).inv ≫ + coequalizer.desc h wh = h := +map_π_preserves_coequalizer_inv_desc (tensor_right Z) f g h wh + +lemma π_tensor_id_preserves_coequalizer_inv_colim_map_desc + {X Y Z X' Y' Z' : C} (f g : X ⟶ Y) (f' g' : X' ⟶ Y') (p : X ⊗ Z ⟶ X') (q : Y ⊗ Z ⟶ Y') + (wf : (f ⊗ 𝟙 Z) ≫ q = p ≫ f') (wg : (g ⊗ 𝟙 Z) ≫ q = p ≫ g') + (h : Y' ⟶ Z') (wh : f' ≫ h = g' ≫ h) : + (coequalizer.π f g ⊗ 𝟙 Z) ≫ (preserves_coequalizer.iso (tensor_right Z) f g).inv ≫ + colim_map (parallel_pair_hom (f ⊗ 𝟙 Z) (g ⊗ 𝟙 Z) f' g' p q wf wg) ≫ + coequalizer.desc h wh = + q ≫ h := +map_π_preserves_coequalizer_inv_colim_map_desc (tensor_right Z) f g f' g' p q wf wg h wh + +end + +end + +/-- A bimodule object for a pair of monoid objects, all internal to some monoidal category. -/ +structure Bimod (A B : Mon_ C) := +(X : C) +(act_left : A.X ⊗ X ⟶ X) +(one_act_left' : (A.one ⊗ 𝟙 X) ≫ act_left = (λ_ X).hom . obviously) +(left_assoc' : + (A.mul ⊗ 𝟙 X) ≫ act_left = (α_ A.X A.X X).hom ≫ (𝟙 A.X ⊗ act_left) ≫ act_left . obviously) +(act_right : X ⊗ B.X ⟶ X) +(act_right_one' : (𝟙 X ⊗ B.one) ≫ act_right = (ρ_ X).hom . obviously) +(right_assoc' : + (𝟙 X ⊗ B.mul) ≫ act_right = (α_ X B.X B.X).inv ≫ (act_right ⊗ 𝟙 B.X) ≫ act_right . obviously) +(middle_assoc' : + (act_left ⊗ 𝟙 B.X) ≫ act_right = (α_ A.X X B.X).hom ≫ (𝟙 A.X ⊗ act_right) ≫ act_left . obviously) + +restate_axiom Bimod.one_act_left' +restate_axiom Bimod.act_right_one' +restate_axiom Bimod.left_assoc' +restate_axiom Bimod.right_assoc' +restate_axiom Bimod.middle_assoc' +attribute [simp, reassoc] +Bimod.one_act_left Bimod.act_right_one Bimod.left_assoc Bimod.right_assoc Bimod.middle_assoc + +namespace Bimod + +variables {A B : Mon_ C} (M : Bimod A B) + +/-- A morphism of bimodule objects. -/ +@[ext] +structure hom (M N : Bimod A B) := +(hom : M.X ⟶ N.X) +(left_act_hom' : M.act_left ≫ hom = (𝟙 A.X ⊗ hom) ≫ N.act_left . obviously) +(right_act_hom' : M.act_right ≫ hom = (hom ⊗ 𝟙 B.X) ≫ N.act_right . obviously) + +restate_axiom hom.left_act_hom' +restate_axiom hom.right_act_hom' +attribute [simp, reassoc] hom.left_act_hom hom.right_act_hom + +/-- The identity morphism on a bimodule object. -/ +@[simps] +def id' (M : Bimod A B) : hom M M := +{ hom := 𝟙 M.X, } + +instance hom_inhabited (M : Bimod A B) : inhabited (hom M M) := ⟨id' M⟩ + +/-- Composition of bimodule object morphisms. -/ +@[simps] +def comp {M N O : Bimod A B} (f : hom M N) (g : hom N O) : hom M O := +{ hom := f.hom ≫ g.hom, } + +instance : category (Bimod A B) := +{ hom := λ M N, hom M N, + id := id', + comp := λ M N O f g, comp f g, } + +@[simp] lemma id_hom' (M : Bimod A B) : (𝟙 M : hom M M).hom = 𝟙 M.X := rfl +@[simp] lemma comp_hom' {M N K : Bimod A B} (f : M ⟶ N) (g : N ⟶ K) : + (f ≫ g : hom M K).hom = f.hom ≫ g.hom := rfl + +/-- +Construct an isomorphism of bimodules by giving an isomorphism between the underlying objects +and checking compatibility with left and right actions only in the forward direction. +-/ +@[simps] +def iso_of_iso {X Y : Mon_ C} {P Q : Bimod X Y} + (f : P.X ≅ Q.X) + (f_left_act_hom : P.act_left ≫ f.hom = (𝟙 X.X ⊗ f.hom) ≫ Q.act_left) + (f_right_act_hom : P.act_right ≫ f.hom = (f.hom ⊗ 𝟙 Y.X) ≫ Q.act_right) : + P ≅ Q := +{ hom := ⟨f.hom⟩, + inv := + { hom := f.inv, + left_act_hom' := begin + rw [←(cancel_mono f.hom), category.assoc, category.assoc, iso.inv_hom_id, category.comp_id, + f_left_act_hom, ←category.assoc, ←id_tensor_comp, iso.inv_hom_id, + monoidal_category.tensor_id, category.id_comp], + end, + right_act_hom' := begin + rw [←(cancel_mono f.hom), category.assoc, category.assoc, iso.inv_hom_id, category.comp_id, + f_right_act_hom, ←category.assoc, ←comp_tensor_id, iso.inv_hom_id, + monoidal_category.tensor_id, category.id_comp], + end }, + hom_inv_id' := begin + ext, dsimp, rw iso.hom_inv_id, + end, + inv_hom_id' := begin + ext, dsimp, rw iso.inv_hom_id, + end } + +variables (A) + +/-- A monoid object as a bimodule over itself. -/ +@[simps] +def regular : Bimod A A := +{ X := A.X, + act_left := A.mul, + act_right := A.mul, } + +instance : inhabited (Bimod A A) := ⟨regular A⟩ + +/-- The forgetful functor from bimodule objects to the ambient category. -/ +def forget : Bimod A B ⥤ C := +{ obj := λ A, A.X, + map := λ A B f, f.hom, } + +open category_theory.limits + +variables [has_coequalizers C] + +namespace tensor_Bimod +variables {R S T : Mon_ C} (P : Bimod R S) (Q : Bimod S T) + +/-- The underlying object of the tensor product of two bimodules. -/ +noncomputable +def X : C := coequalizer (P.act_right ⊗ 𝟙 Q.X) ((α_ _ _ _).hom ≫ (𝟙 P.X ⊗ Q.act_left)) + +section + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] + +/-- Left action for the tensor product of two bimodules. -/ +noncomputable +def act_left : R.X ⊗ X P Q ⟶ X P Q := +(preserves_coequalizer.iso (tensor_left R.X) _ _).inv ≫ +colim_map + (parallel_pair_hom _ _ _ _ + ((𝟙 _ ⊗ (α_ _ _ _).hom) ≫ (α_ _ _ _).inv ≫ (P.act_left ⊗ 𝟙 S.X ⊗ 𝟙 Q.X) ≫ (α_ _ _ _).inv) + ((α_ _ _ _).inv ≫ (P.act_left ⊗ 𝟙 Q.X)) + begin + dsimp, + slice_lhs 1 2 { rw associator_inv_naturality }, + slice_rhs 3 4 { rw associator_inv_naturality }, + slice_rhs 4 5 { rw [←tensor_comp, middle_assoc, tensor_comp, comp_tensor_id] }, + coherence, + end + begin + dsimp, + slice_lhs 1 1 { rw id_tensor_comp }, + slice_lhs 2 3 { rw associator_inv_naturality }, + slice_lhs 3 4 { rw [tensor_id, id_tensor_comp_tensor_id] }, + slice_rhs 4 6 { rw iso.inv_hom_id_assoc }, + slice_rhs 3 4 { rw [tensor_id, tensor_id_comp_id_tensor] }, + end) + +lemma id_tensor_π_act_left : + (𝟙 R.X ⊗ coequalizer.π _ _) ≫ act_left P Q = + (α_ _ _ _).inv ≫ (P.act_left ⊗ 𝟙 Q.X) ≫ coequalizer.π _ _ := +begin + erw map_π_preserves_coequalizer_inv_colim_map (tensor_left _), + simp only [category.assoc], +end + +lemma one_act_left' : (R.one ⊗ 𝟙 _) ≫ act_left P Q = (λ_ _).hom := +begin + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp [X], + slice_lhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor] }, + slice_lhs 2 3 { rw id_tensor_π_act_left }, + slice_lhs 1 2 { rw [←monoidal_category.tensor_id, associator_inv_naturality] }, + slice_lhs 2 3 { rw [←comp_tensor_id, one_act_left] }, + slice_rhs 1 2 { rw left_unitor_naturality }, + coherence, +end + +lemma left_assoc' : + (R.mul ⊗ 𝟙 _) ≫ act_left P Q = + (α_ R.X R.X _).hom ≫ (𝟙 R.X ⊗ act_left P Q) ≫ act_left P Q := +begin + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp [X], + slice_lhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor] }, + slice_lhs 2 3 { rw id_tensor_π_act_left }, + slice_lhs 1 2 { rw [←monoidal_category.tensor_id, associator_inv_naturality] }, + slice_lhs 2 3 { rw [←comp_tensor_id, left_assoc, comp_tensor_id, comp_tensor_id] }, + slice_rhs 1 2 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_rhs 2 3 { rw [←id_tensor_comp, id_tensor_π_act_left, id_tensor_comp, id_tensor_comp] }, + slice_rhs 4 5 { rw id_tensor_π_act_left }, + slice_rhs 3 4 { rw associator_inv_naturality }, + coherence, +end + +end + +section + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +/-- Right action for the tensor product of two bimodules. -/ +noncomputable +def act_right : X P Q ⊗ T.X ⟶ X P Q := +(preserves_coequalizer.iso (tensor_right T.X) _ _).inv ≫ +colim_map + (parallel_pair_hom _ _ _ _ + ((α_ _ _ _).hom ≫ (α_ _ _ _).hom ≫ (𝟙 P.X ⊗ 𝟙 S.X ⊗ Q.act_right) ≫ (α_ _ _ _).inv) + ((α_ _ _ _).hom ≫ (𝟙 P.X ⊗ Q.act_right)) + begin + dsimp, + slice_lhs 1 2 { rw associator_naturality }, + slice_lhs 2 3 { rw [tensor_id, tensor_id_comp_id_tensor] }, + slice_rhs 3 4 { rw associator_inv_naturality }, + slice_rhs 2 4 { rw iso.hom_inv_id_assoc }, + slice_rhs 2 3 { rw [tensor_id, id_tensor_comp_tensor_id] }, + end + begin + dsimp, + slice_lhs 1 1 { rw comp_tensor_id }, + slice_lhs 2 3 { rw associator_naturality }, + slice_lhs 3 4 { rw [←id_tensor_comp, middle_assoc, id_tensor_comp] }, + slice_rhs 4 6 { rw iso.inv_hom_id_assoc }, + slice_rhs 3 4 { rw ←id_tensor_comp }, + coherence, + end) + +lemma π_tensor_id_act_right : + (coequalizer.π _ _ ⊗ 𝟙 T.X) ≫ act_right P Q = + (α_ _ _ _).hom ≫ (𝟙 P.X ⊗ Q.act_right) ≫ coequalizer.π _ _ := +begin + erw map_π_preserves_coequalizer_inv_colim_map (tensor_right _), + simp only [category.assoc], +end + +lemma act_right_one' : (𝟙 _ ⊗ T.one) ≫ act_right P Q = (ρ_ _).hom := +begin + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp [X], + slice_lhs 1 2 { rw [tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_lhs 2 3 { rw π_tensor_id_act_right }, + slice_lhs 1 2 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_lhs 2 3 { rw [←id_tensor_comp, act_right_one] }, + slice_rhs 1 2 { rw right_unitor_naturality }, + coherence, +end + +lemma right_assoc' : + (𝟙 _ ⊗ T.mul) ≫ act_right P Q = + (α_ _ T.X T.X).inv ≫ (act_right P Q ⊗ 𝟙 T.X) ≫ act_right P Q := +begin + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp [X], + slice_lhs 1 2 { rw [tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_lhs 2 3 { rw π_tensor_id_act_right }, + slice_lhs 1 2 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_lhs 2 3 { rw [←id_tensor_comp, right_assoc, id_tensor_comp, id_tensor_comp] }, + slice_rhs 1 2 { rw [←monoidal_category.tensor_id, associator_inv_naturality] }, + slice_rhs 2 3 { rw [←comp_tensor_id, π_tensor_id_act_right, comp_tensor_id, comp_tensor_id] }, + slice_rhs 4 5 { rw π_tensor_id_act_right }, + slice_rhs 3 4 { rw associator_naturality }, + coherence, +end + +end + +section + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +lemma middle_assoc' : + (act_left P Q ⊗ 𝟙 T.X) ≫ act_right P Q = + (α_ R.X _ T.X).hom ≫ (𝟙 R.X ⊗ act_right P Q) ≫ act_left P Q := +begin + refine (cancel_epi ((tensor_left _ ⋙ tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp [X], + slice_lhs 1 2 { rw [←comp_tensor_id, id_tensor_π_act_left, comp_tensor_id, comp_tensor_id] }, + slice_lhs 3 4 { rw π_tensor_id_act_right }, + slice_lhs 2 3 { rw associator_naturality }, + slice_lhs 3 4 { rw [monoidal_category.tensor_id, tensor_id_comp_id_tensor] }, + slice_rhs 1 2 { rw associator_naturality }, + slice_rhs 2 3 { rw [←id_tensor_comp, π_tensor_id_act_right, id_tensor_comp, id_tensor_comp] }, + slice_rhs 4 5 { rw id_tensor_π_act_left }, + slice_rhs 3 4 { rw associator_inv_naturality }, + slice_rhs 4 5 { rw [monoidal_category.tensor_id, id_tensor_comp_tensor_id] }, + coherence, +end + +end + +end tensor_Bimod + +section + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +/-- Tensor product of two bimodule objects as a bimodule object. -/ +@[simps] +noncomputable +def tensor_Bimod {X Y Z : Mon_ C} (M : Bimod X Y) (N : Bimod Y Z) : Bimod X Z := +{ X := tensor_Bimod.X M N, + act_left := tensor_Bimod.act_left M N, + act_right := tensor_Bimod.act_right M N, + one_act_left' := tensor_Bimod.one_act_left' M N, + act_right_one' := tensor_Bimod.act_right_one' M N, + left_assoc' := tensor_Bimod.left_assoc' M N, + right_assoc' := tensor_Bimod.right_assoc' M N, + middle_assoc' := tensor_Bimod.middle_assoc' M N, } + +/-- Tensor product of two morphisms of bimodule objects. -/ +@[simps] +noncomputable +def tensor_hom {X Y Z : Mon_ C} {M₁ M₂ : Bimod X Y} {N₁ N₂ : Bimod Y Z} + (f : M₁ ⟶ M₂) (g : N₁ ⟶ N₂) : M₁.tensor_Bimod N₁ ⟶ M₂.tensor_Bimod N₂ := +{ hom := + colim_map + (parallel_pair_hom _ _ _ _ ((f.hom ⊗ 𝟙 Y.X) ⊗ g.hom) (f.hom ⊗ g.hom) + (by rw [←tensor_comp, ←tensor_comp, hom.right_act_hom, category.id_comp, category.comp_id]) + begin + slice_lhs 2 3 { rw [←tensor_comp, hom.left_act_hom, category.id_comp] }, + slice_rhs 1 2 { rw associator_naturality }, + slice_rhs 2 3 { rw [←tensor_comp, category.comp_id] }, + end), + left_act_hom' := begin + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 2 { rw tensor_Bimod.id_tensor_π_act_left }, + slice_lhs 3 4 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_lhs 2 3 { rw [←tensor_comp, hom.left_act_hom, category.id_comp] }, + slice_rhs 1 2 { rw [←id_tensor_comp, ι_colim_map, parallel_pair_hom_app_one, id_tensor_comp] }, + slice_rhs 2 3 { rw tensor_Bimod.id_tensor_π_act_left }, + slice_rhs 1 2 { rw associator_inv_naturality }, + slice_rhs 2 3 { rw [←tensor_comp, category.comp_id] }, + end, + right_act_hom' := begin + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 2 { rw tensor_Bimod.π_tensor_id_act_right }, + slice_lhs 3 4 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_lhs 2 3 { rw [←tensor_comp, category.id_comp, hom.right_act_hom] }, + slice_rhs 1 2 { rw [←comp_tensor_id, ι_colim_map, parallel_pair_hom_app_one, comp_tensor_id] }, + slice_rhs 2 3 { rw tensor_Bimod.π_tensor_id_act_right }, + slice_rhs 1 2 { rw associator_naturality }, + slice_rhs 2 3 { rw [←tensor_comp, category.comp_id] }, + end } + +lemma tensor_id {X Y Z : Mon_ C} {M : Bimod X Y} {N : Bimod Y Z} : + tensor_hom (𝟙 M) (𝟙 N) = 𝟙 (M.tensor_Bimod N) := +begin + ext, + simp only [id_hom', tensor_id, tensor_hom_hom, ι_colim_map, parallel_pair_hom_app_one], + dsimp, dunfold tensor_Bimod.X, + simp only [category.id_comp, category.comp_id], +end + +lemma tensor_comp {X Y Z : Mon_ C} {M₁ M₂ M₃ : Bimod X Y} {N₁ N₂ N₃ : Bimod Y Z} + (f₁ : M₁ ⟶ M₂) (f₂ : M₂ ⟶ M₃) (g₁ : N₁ ⟶ N₂) (g₂ : N₂ ⟶ N₃) : + tensor_hom (f₁ ≫ f₂) (g₁ ≫ g₂) = tensor_hom f₁ g₁ ≫ tensor_hom f₂ g₂ := +begin + ext, + simp only [comp_hom', tensor_comp, tensor_hom_hom, ι_colim_map, parallel_pair_hom_app_one, + category.assoc, ι_colim_map_assoc] +end + +end + +namespace associator_Bimod + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +variables {R S T U : Mon_ C} (P : Bimod R S) (Q : Bimod S T) (L : Bimod T U) + +/-- An auxiliary morphism for the definition of the underlying morphism of the forward component of +the associator isomorphism. -/ +noncomputable +def hom_aux : (P.tensor_Bimod Q).X ⊗ L.X ⟶ (P.tensor_Bimod (Q.tensor_Bimod L)).X := +(preserves_coequalizer.iso (tensor_right L.X) _ _).inv ≫ +coequalizer.desc + ((α_ _ _ _).hom ≫ (𝟙 P.X ⊗ (coequalizer.π _ _)) ≫ (coequalizer.π _ _)) + begin + dsimp, dsimp [tensor_Bimod.X], + slice_lhs 1 2 { rw associator_naturality }, + slice_lhs 2 3 { rw [monoidal_category.tensor_id, + tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_lhs 3 4 { rw coequalizer.condition }, + slice_lhs 2 3 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_lhs 3 4 { rw [←id_tensor_comp, tensor_Bimod.id_tensor_π_act_left, id_tensor_comp] }, + slice_rhs 1 1 { rw comp_tensor_id }, + slice_rhs 2 3 { rw associator_naturality }, + slice_rhs 3 4 { rw ←id_tensor_comp }, + coherence, + end + +/-- The underlying morphism of the forward component of the associator isomorphism. -/ +noncomputable +def hom : ((P.tensor_Bimod Q).tensor_Bimod L).X ⟶ (P.tensor_Bimod (Q.tensor_Bimod L)).X := +coequalizer.desc + (hom_aux P Q L) + begin + dsimp [hom_aux], + refine (cancel_epi ((tensor_right _ ⋙ tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp [tensor_Bimod.X], + slice_lhs 1 2 { rw [←comp_tensor_id, + tensor_Bimod.π_tensor_id_act_right, + comp_tensor_id, comp_tensor_id] }, + slice_lhs 3 5 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_lhs 2 3 { rw associator_naturality }, + slice_lhs 3 4 { rw [←id_tensor_comp, coequalizer.condition, id_tensor_comp, id_tensor_comp] }, + slice_rhs 1 2 { rw associator_naturality }, + slice_rhs 2 3 { rw [monoidal_category.tensor_id, + tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_rhs 3 5 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_rhs 2 3 { rw [←monoidal_category.tensor_id, associator_naturality] }, + coherence, + end + +lemma hom_left_act_hom' : + ((P.tensor_Bimod Q).tensor_Bimod L).act_left ≫ hom P Q L = + (𝟙 R.X ⊗ hom P Q L) ≫ (P.tensor_Bimod (Q.tensor_Bimod L)).act_left := +begin + dsimp, dsimp [hom, hom_aux], + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + rw tensor_left_map, + slice_lhs 1 2 { rw tensor_Bimod.id_tensor_π_act_left }, + slice_lhs 3 4 { rw coequalizer.π_desc }, + slice_rhs 1 2 { rw [←id_tensor_comp, coequalizer.π_desc, id_tensor_comp] }, + refine (cancel_epi ((tensor_right _ ⋙ tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp, dsimp [tensor_Bimod.X], + slice_lhs 1 2 { rw associator_inv_naturality }, + slice_lhs 2 3 { rw [←comp_tensor_id, + tensor_Bimod.id_tensor_π_act_left, + comp_tensor_id, comp_tensor_id] }, + slice_lhs 4 6 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_lhs 3 4 { rw associator_naturality }, + slice_lhs 4 5 { rw [monoidal_category.tensor_id, tensor_id_comp_id_tensor] }, + slice_rhs 1 3 { rw [←id_tensor_comp, ←id_tensor_comp, + π_tensor_id_preserves_coequalizer_inv_desc, + id_tensor_comp, id_tensor_comp] }, + slice_rhs 3 4 { erw tensor_Bimod.id_tensor_π_act_left P (Q.tensor_Bimod L) }, + slice_rhs 2 3 { erw associator_inv_naturality }, + slice_rhs 3 4 { erw [monoidal_category.tensor_id, id_tensor_comp_tensor_id] }, + coherence, +end + +lemma hom_right_act_hom' : + ((P.tensor_Bimod Q).tensor_Bimod L).act_right ≫ hom P Q L = + (hom P Q L ⊗ 𝟙 U.X) ≫ (P.tensor_Bimod (Q.tensor_Bimod L)).act_right := +begin + dsimp, dsimp [hom, hom_aux], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + rw tensor_right_map, + slice_lhs 1 2 { rw tensor_Bimod.π_tensor_id_act_right }, + slice_lhs 3 4 { rw coequalizer.π_desc }, + slice_rhs 1 2 { rw [←comp_tensor_id, coequalizer.π_desc, comp_tensor_id] }, + refine (cancel_epi ((tensor_right _ ⋙ tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp, dsimp [tensor_Bimod.X], + slice_lhs 1 2 { rw associator_naturality }, + slice_lhs 2 3 { rw [monoidal_category.tensor_id, + tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_lhs 3 5 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_lhs 2 3 { rw [←monoidal_category.tensor_id, + associator_naturality] }, + slice_rhs 1 3 { rw [←comp_tensor_id, ←comp_tensor_id, + π_tensor_id_preserves_coequalizer_inv_desc, + comp_tensor_id, comp_tensor_id] }, + slice_rhs 3 4 { erw tensor_Bimod.π_tensor_id_act_right P (Q.tensor_Bimod L) }, + slice_rhs 2 3 { erw associator_naturality }, + dsimp, + slice_rhs 3 4 { rw [←id_tensor_comp, + tensor_Bimod.π_tensor_id_act_right, + id_tensor_comp, id_tensor_comp] }, + coherence, +end + +/-- An auxiliary morphism for the definition of the underlying morphism of the inverse component of +the associator isomorphism. -/ +noncomputable +def inv_aux : P.X ⊗ (Q.tensor_Bimod L).X ⟶ ((P.tensor_Bimod Q).tensor_Bimod L).X := +(preserves_coequalizer.iso (tensor_left P.X) _ _).inv ≫ +coequalizer.desc + ((α_ _ _ _).inv ≫ ((coequalizer.π _ _) ⊗ 𝟙 L.X) ≫ (coequalizer.π _ _)) + begin + dsimp, dsimp [tensor_Bimod.X], + slice_lhs 1 2 { rw associator_inv_naturality }, + rw [←(iso.inv_hom_id_assoc (α_ _ _ _) (𝟙 P.X ⊗ Q.act_right)), comp_tensor_id], + slice_lhs 3 4 { rw [←comp_tensor_id, category.assoc, ←tensor_Bimod.π_tensor_id_act_right, + comp_tensor_id] }, + slice_lhs 4 5 { rw coequalizer.condition }, + slice_lhs 3 4 { rw associator_naturality }, + slice_lhs 4 5 { rw [monoidal_category.tensor_id, tensor_id_comp_id_tensor] }, + slice_rhs 1 2 { rw id_tensor_comp }, + slice_rhs 2 3 { rw associator_inv_naturality }, + slice_rhs 3 4 { rw [monoidal_category.tensor_id, id_tensor_comp_tensor_id] }, + coherence, + end + +/-- The underlying morphism of the inverse component of the associator isomorphism. -/ +noncomputable +def inv : (P.tensor_Bimod (Q.tensor_Bimod L)).X ⟶ ((P.tensor_Bimod Q).tensor_Bimod L).X := +coequalizer.desc + (inv_aux P Q L) + begin + dsimp [inv_aux], + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp [tensor_Bimod.X], + slice_lhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor] }, + slice_lhs 2 4 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_lhs 1 2 { rw [←monoidal_category.tensor_id, associator_inv_naturality] }, + slice_lhs 2 3 { rw [←comp_tensor_id, coequalizer.condition, comp_tensor_id, comp_tensor_id] }, + slice_rhs 1 2 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_rhs 2 3 { rw [←id_tensor_comp, + tensor_Bimod.id_tensor_π_act_left, + id_tensor_comp, id_tensor_comp] }, + slice_rhs 4 6 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_rhs 3 4 { rw associator_inv_naturality }, + coherence, + end + +lemma hom_inv_id : hom P Q L ≫ inv P Q L = 𝟙 _ := +begin + dsimp [hom, hom_aux, inv, inv_aux], + ext, + slice_lhs 1 2 { rw coequalizer.π_desc }, + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + rw tensor_right_map, + slice_lhs 1 3 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_lhs 3 4 { rw coequalizer.π_desc }, + slice_lhs 2 4 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_lhs 1 3 { rw iso.hom_inv_id_assoc }, + dunfold tensor_Bimod.X, + slice_rhs 2 3 { rw category.comp_id }, + refl, +end + +lemma inv_hom_id : inv P Q L ≫ hom P Q L = 𝟙 _ := +begin + dsimp [hom, hom_aux, inv, inv_aux], + ext, + slice_lhs 1 2 { rw coequalizer.π_desc }, + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + rw tensor_left_map, + slice_lhs 1 3 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_lhs 3 4 { rw coequalizer.π_desc }, + slice_lhs 2 4 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_lhs 1 3 { rw iso.inv_hom_id_assoc }, + dunfold tensor_Bimod.X, + slice_rhs 2 3 { rw category.comp_id }, + refl, +end + +end associator_Bimod + +namespace left_unitor_Bimod +variables {R S : Mon_ C} (P : Bimod R S) + +/-- The underlying morphism of the forward component of the left unitor isomorphism. -/ +noncomputable +def hom : tensor_Bimod.X (regular R) P ⟶ P.X := +coequalizer.desc P.act_left (by { dsimp, rw [category.assoc, left_assoc] }) + +/-- The underlying morphism of the inverse component of the left unitor isomorphism. -/ +noncomputable +def inv : P.X ⟶ tensor_Bimod.X (regular R) P := +(λ_ P.X).inv ≫ (R.one ⊗ 𝟙 _) ≫ coequalizer.π _ _ + +lemma hom_inv_id : hom P ≫ inv P = 𝟙 _ := +begin + dunfold hom inv tensor_Bimod.X, + ext, dsimp, + slice_lhs 1 2 { rw coequalizer.π_desc }, + slice_lhs 1 2 { rw left_unitor_inv_naturality }, + slice_lhs 2 3 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor] }, + slice_lhs 3 3 { rw ←(iso.inv_hom_id_assoc (α_ R.X R.X P.X) (𝟙 R.X ⊗ P.act_left)) }, + slice_lhs 4 6 { rw [←category.assoc, ←coequalizer.condition] }, + slice_lhs 2 3 { rw [←monoidal_category.tensor_id, associator_inv_naturality] }, + slice_lhs 3 4 { rw [←comp_tensor_id, Mon_.one_mul] }, + slice_rhs 1 2 { rw category.comp_id }, + coherence, +end + +lemma inv_hom_id : inv P ≫ hom P = 𝟙 _ := +begin + dsimp [hom, inv], + slice_lhs 3 4 { rw coequalizer.π_desc }, + rw [one_act_left, iso.inv_hom_id], +end + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +lemma hom_left_act_hom' : + ((regular R).tensor_Bimod P).act_left ≫ hom P = (𝟙 R.X ⊗ hom P) ≫ P.act_left := +begin + dsimp, dsimp [hom, tensor_Bimod.act_left, regular], + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 4 { rw id_tensor_π_preserves_coequalizer_inv_colim_map_desc }, + slice_lhs 2 3 { rw left_assoc }, + slice_rhs 1 2 { rw [←id_tensor_comp, coequalizer.π_desc] }, + rw iso.inv_hom_id_assoc, +end + +lemma hom_right_act_hom' : + ((regular R).tensor_Bimod P).act_right ≫ hom P = (hom P ⊗ 𝟙 S.X) ≫ P.act_right := +begin + dsimp, dsimp [hom, tensor_Bimod.act_right, regular], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 4 { rw π_tensor_id_preserves_coequalizer_inv_colim_map_desc }, + slice_rhs 1 2 { rw [←comp_tensor_id, coequalizer.π_desc] }, + slice_rhs 1 2 { rw middle_assoc }, + simp only [category.assoc], +end + +end left_unitor_Bimod + +namespace right_unitor_Bimod +variables {R S : Mon_ C} (P : Bimod R S) + +/-- The underlying morphism of the forward component of the right unitor isomorphism. -/ +noncomputable +def hom : tensor_Bimod.X P (regular S) ⟶ P.X := +coequalizer.desc P.act_right + (by { dsimp, rw [category.assoc, right_assoc, iso.hom_inv_id_assoc] }) + +/-- The underlying morphism of the inverse component of the right unitor isomorphism. -/ +noncomputable +def inv : P.X ⟶ tensor_Bimod.X P (regular S) := +(ρ_ P.X).inv ≫ (𝟙 _ ⊗ S.one) ≫ coequalizer.π _ _ + +lemma hom_inv_id : hom P ≫ inv P = 𝟙 _ := +begin + dunfold hom inv tensor_Bimod.X, + ext, dsimp, + slice_lhs 1 2 { rw coequalizer.π_desc }, + slice_lhs 1 2 { rw right_unitor_inv_naturality }, + slice_lhs 2 3 { rw [tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_lhs 3 4 { rw coequalizer.condition }, + slice_lhs 2 3 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_lhs 3 4 { rw [←id_tensor_comp, Mon_.mul_one] }, + slice_rhs 1 2 { rw category.comp_id }, + coherence, +end + +lemma inv_hom_id : inv P ≫ hom P = 𝟙 _ := +begin + dsimp [hom, inv], + slice_lhs 3 4 { rw coequalizer.π_desc }, + rw [act_right_one, iso.inv_hom_id], +end + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +lemma hom_left_act_hom' : + (P.tensor_Bimod (regular S)).act_left ≫ hom P = (𝟙 R.X ⊗ hom P) ≫ P.act_left := +begin + dsimp, dsimp [hom, tensor_Bimod.act_left, regular], + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 4 { rw id_tensor_π_preserves_coequalizer_inv_colim_map_desc }, + slice_lhs 2 3 { rw middle_assoc }, + slice_rhs 1 2 { rw [←id_tensor_comp, coequalizer.π_desc] }, + rw iso.inv_hom_id_assoc, +end + +lemma hom_right_act_hom' : + (P.tensor_Bimod (regular S)).act_right ≫ hom P = (hom P ⊗ 𝟙 S.X) ≫ P.act_right := +begin + dsimp, dsimp [hom, tensor_Bimod.act_right, regular], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 4 { rw π_tensor_id_preserves_coequalizer_inv_colim_map_desc }, + slice_lhs 2 3 { rw right_assoc }, + slice_rhs 1 2 { rw [←comp_tensor_id, coequalizer.π_desc] }, + rw iso.hom_inv_id_assoc, +end + +end right_unitor_Bimod + +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_left X)] +variables [∀ X : C, preserves_colimits_of_size.{0 0} (tensor_right X)] + +/-- The associator as a bimodule isomorphism. -/ +noncomputable +def associator_Bimod {W X Y Z : Mon_ C} (L : Bimod W X) (M : Bimod X Y) (N : Bimod Y Z) : + (L.tensor_Bimod M).tensor_Bimod N ≅ L.tensor_Bimod (M.tensor_Bimod N) := +iso_of_iso + { hom := associator_Bimod.hom L M N, + inv := associator_Bimod.inv L M N, + hom_inv_id' := associator_Bimod.hom_inv_id L M N, + inv_hom_id' := associator_Bimod.inv_hom_id L M N } + (associator_Bimod.hom_left_act_hom' L M N) + (associator_Bimod.hom_right_act_hom' L M N) + +/-- The left unitor as a bimodule isomorphism. -/ +noncomputable +def left_unitor_Bimod {X Y : Mon_ C} (M : Bimod X Y) : (regular X).tensor_Bimod M ≅ M := +iso_of_iso + { hom := left_unitor_Bimod.hom M, + inv := left_unitor_Bimod.inv M, + hom_inv_id' := left_unitor_Bimod.hom_inv_id M, + inv_hom_id' := left_unitor_Bimod.inv_hom_id M } + (left_unitor_Bimod.hom_left_act_hom' M) + (left_unitor_Bimod.hom_right_act_hom' M) + +/-- The right unitor as a bimodule isomorphism. -/ +noncomputable +def right_unitor_Bimod {X Y : Mon_ C} (M : Bimod X Y) : M.tensor_Bimod (regular Y) ≅ M := +iso_of_iso + { hom := right_unitor_Bimod.hom M, + inv := right_unitor_Bimod.inv M, + hom_inv_id' := right_unitor_Bimod.hom_inv_id M, + inv_hom_id' := right_unitor_Bimod.inv_hom_id M } + (right_unitor_Bimod.hom_left_act_hom' M) + (right_unitor_Bimod.hom_right_act_hom' M) + +lemma whisker_left_comp_Bimod {X Y Z : Mon_ C} + (M : Bimod X Y) {N P Q : Bimod Y Z} (f : N ⟶ P) (g : P ⟶ Q) : + tensor_hom (𝟙 M) (f ≫ g) = tensor_hom (𝟙 M) f ≫ tensor_hom (𝟙 M) g := +by rw [←tensor_comp, category.comp_id] + +lemma id_whisker_left_Bimod {X Y : Mon_ C} {M N : Bimod X Y} (f : M ⟶ N) : + tensor_hom (𝟙 (regular X)) f = (left_unitor_Bimod M).hom ≫ f ≫ (left_unitor_Bimod N).inv := +begin + dsimp [tensor_hom, regular, left_unitor_Bimod], + ext, dsimp, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [left_unitor_Bimod.hom], + slice_rhs 1 2 { rw coequalizer.π_desc }, + dsimp [left_unitor_Bimod.inv], + slice_rhs 1 2 { rw hom.left_act_hom }, + slice_rhs 2 3 { rw left_unitor_inv_naturality }, + slice_rhs 3 4 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor] }, + slice_rhs 4 4 { rw ←(iso.inv_hom_id_assoc (α_ X.X X.X N.X) (𝟙 X.X ⊗ N.act_left)) }, + slice_rhs 5 7 { rw [←category.assoc, ←coequalizer.condition] }, + slice_rhs 3 4 { rw [←monoidal_category.tensor_id, associator_inv_naturality] }, + slice_rhs 4 5 { rw [←comp_tensor_id, Mon_.one_mul] }, + have : + (λ_ (X.X ⊗ N.X)).inv ≫ (α_ (𝟙_ C) X.X N.X).inv ≫ ((λ_ X.X).hom ⊗ 𝟙 N.X) = 𝟙 _ := + by pure_coherence, + slice_rhs 2 4 { rw this }, + slice_rhs 1 2 { rw category.comp_id }, +end + +lemma comp_whisker_left_Bimod {W X Y Z : Mon_ C} + (M : Bimod W X) (N : Bimod X Y) {P P' : Bimod Y Z} (f : P ⟶ P') : + tensor_hom (𝟙 (M.tensor_Bimod N)) f = + (associator_Bimod M N P).hom ≫ tensor_hom (𝟙 M) (tensor_hom (𝟙 N) f) ≫ + (associator_Bimod M N P').inv := +begin + dsimp [tensor_hom, tensor_Bimod, associator_Bimod], + ext, dsimp, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [tensor_Bimod.X, associator_Bimod.hom], + slice_rhs 1 2 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.hom_aux, associator_Bimod.inv], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + rw tensor_right_map, + slice_rhs 1 3 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_rhs 3 4 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 2 3 { rw [←id_tensor_comp, ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 3 4 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.inv_aux], + slice_rhs 2 2 { rw id_tensor_comp }, + slice_rhs 3 5 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_rhs 2 3 { rw associator_inv_naturality }, + slice_rhs 1 3 { rw [iso.hom_inv_id_assoc, monoidal_category.tensor_id] }, + slice_lhs 1 2 { rw [tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + dunfold tensor_Bimod.X, + simp only [category.assoc], +end + +lemma comp_whisker_right_Bimod {X Y Z : Mon_ C} + {M N P : Bimod X Y} (f : M ⟶ N) (g : N ⟶ P) (Q : Bimod Y Z) : + tensor_hom (f ≫ g) (𝟙 Q) = tensor_hom f (𝟙 Q) ≫ tensor_hom g (𝟙 Q) := +by rw [←tensor_comp, category.comp_id] + +lemma whisker_right_id_Bimod {X Y : Mon_ C} {M N : Bimod X Y} (f : M ⟶ N) : + tensor_hom f (𝟙 (regular Y)) = (right_unitor_Bimod M).hom ≫ f ≫ (right_unitor_Bimod N).inv := +begin + dsimp [tensor_hom, regular, right_unitor_Bimod], + ext, dsimp, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [right_unitor_Bimod.hom], + slice_rhs 1 2 { rw coequalizer.π_desc }, + dsimp [right_unitor_Bimod.inv], + slice_rhs 1 2 { rw hom.right_act_hom }, + slice_rhs 2 3 { rw right_unitor_inv_naturality }, + slice_rhs 3 4 { rw [tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_rhs 4 5 { rw coequalizer.condition }, + slice_rhs 3 4 { rw [←monoidal_category.tensor_id, associator_naturality] }, + slice_rhs 4 5 { rw [←id_tensor_comp, Mon_.mul_one] }, + have : + (ρ_ (N.X ⊗ Y.X)).inv ≫ (α_ N.X Y.X (𝟙_ C)).hom ≫ (𝟙 N.X ⊗ (ρ_ Y.X).hom) = 𝟙 _ := + by pure_coherence, + slice_rhs 2 4 { rw this }, + slice_rhs 1 2 { rw category.comp_id }, +end + +lemma whisker_right_comp_Bimod {W X Y Z : Mon_ C} + {M M' : Bimod W X} (f : M ⟶ M') (N : Bimod X Y) (P : Bimod Y Z) : + tensor_hom f (𝟙 (N.tensor_Bimod P)) = + (associator_Bimod M N P).inv ≫ tensor_hom (tensor_hom f (𝟙 N)) (𝟙 P) ≫ + (associator_Bimod M' N P).hom := +begin + dsimp [tensor_hom, tensor_Bimod, associator_Bimod], + ext, dsimp, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [tensor_Bimod.X, associator_Bimod.inv], + slice_rhs 1 2 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.inv_aux, associator_Bimod.hom], + refine (cancel_epi ((tensor_left _).map (coequalizer.π _ _))).1 _, + rw tensor_left_map, + slice_rhs 1 3 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_rhs 3 4 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 2 3 { rw [←comp_tensor_id, ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 3 4 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.hom_aux], + slice_rhs 2 2 { rw comp_tensor_id }, + slice_rhs 3 5 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_rhs 2 3 { rw associator_naturality }, + slice_rhs 1 3 { rw [iso.inv_hom_id_assoc, monoidal_category.tensor_id] }, + slice_lhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor] }, + dunfold tensor_Bimod.X, + simp only [category.assoc], +end + +lemma whisker_assoc_Bimod {W X Y Z : Mon_ C} + (M : Bimod W X) {N N' : Bimod X Y} (f : N ⟶ N') (P : Bimod Y Z) : + tensor_hom (tensor_hom (𝟙 M) f) (𝟙 P) = + (associator_Bimod M N P).hom ≫ tensor_hom (𝟙 M) (tensor_hom f (𝟙 P)) ≫ + (associator_Bimod M N' P).inv := +begin + dsimp [tensor_hom, tensor_Bimod, associator_Bimod], + ext, dsimp, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [associator_Bimod.hom], + slice_rhs 1 2 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.hom_aux], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + rw tensor_right_map, + slice_lhs 1 2 { rw [←comp_tensor_id, ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 1 3 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_rhs 3 4 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 2 3 { rw [←id_tensor_comp, ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [associator_Bimod.inv], + slice_rhs 3 4 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.inv_aux], + slice_rhs 2 2 { rw id_tensor_comp }, + slice_rhs 3 5 { rw id_tensor_π_preserves_coequalizer_inv_desc }, + slice_rhs 2 3 { rw associator_inv_naturality }, + slice_rhs 1 3 { rw iso.hom_inv_id_assoc }, + slice_lhs 1 1 { rw comp_tensor_id }, +end + +lemma whisker_exchange_Bimod {X Y Z : Mon_ C} + {M N : Bimod X Y} {P Q : Bimod Y Z} (f : M ⟶ N) (g : P ⟶ Q) : + tensor_hom (𝟙 M) g ≫ tensor_hom f (𝟙 Q) = tensor_hom f (𝟙 P) ≫ tensor_hom (𝟙 N) g := +begin + dsimp [tensor_hom], + ext, dsimp, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_lhs 2 3 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_lhs 1 2 { rw id_tensor_comp_tensor_id }, + slice_rhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 2 3 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_rhs 1 2 { rw tensor_id_comp_id_tensor }, +end + +lemma pentagon_Bimod {V W X Y Z : Mon_ C} + (M : Bimod V W) (N : Bimod W X) (P : Bimod X Y) (Q : Bimod Y Z) : + tensor_hom (associator_Bimod M N P).hom (𝟙 Q) ≫ (associator_Bimod M (N.tensor_Bimod P) Q).hom ≫ + tensor_hom (𝟙 M) (associator_Bimod N P Q).hom = + (associator_Bimod (M.tensor_Bimod N) P Q).hom ≫ (associator_Bimod M N (P.tensor_Bimod Q)).hom := +begin + dsimp [tensor_hom, associator_Bimod], ext, dsimp, + dunfold associator_Bimod.hom, + slice_lhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_lhs 2 3 { rw coequalizer.π_desc }, + slice_rhs 1 2 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.hom_aux], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 2 { rw [←comp_tensor_id, coequalizer.π_desc] }, + slice_rhs 1 3 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_rhs 3 4 { rw coequalizer.π_desc }, + refine (cancel_epi ((tensor_right _ ⋙ tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp, + slice_lhs 1 2 { rw [←comp_tensor_id, + π_tensor_id_preserves_coequalizer_inv_desc, + comp_tensor_id, comp_tensor_id ]}, + slice_lhs 3 5 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + dunfold tensor_Bimod.X, + slice_lhs 2 3 { rw associator_naturality }, + slice_lhs 5 6 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + slice_lhs 4 5 { rw [←id_tensor_comp, coequalizer.π_desc] }, + slice_lhs 3 4 { rw [←id_tensor_comp, + π_tensor_id_preserves_coequalizer_inv_desc, + id_tensor_comp, id_tensor_comp] }, + slice_rhs 1 2 { rw associator_naturality }, + slice_rhs 2 3 { rw [monoidal_category.tensor_id, + tensor_id_comp_id_tensor, ←id_tensor_comp_tensor_id] }, + slice_rhs 3 5 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_rhs 2 3 { rw [←monoidal_category.tensor_id, associator_naturality] }, + coherence, +end + +lemma triangle_Bimod {X Y Z : Mon_ C} (M : Bimod X Y) (N : Bimod Y Z) : + (associator_Bimod M (regular Y) N).hom ≫ tensor_hom (𝟙 M) (left_unitor_Bimod N).hom = + tensor_hom (right_unitor_Bimod M).hom (𝟙 N) := +begin + dsimp [tensor_hom, associator_Bimod, left_unitor_Bimod, right_unitor_Bimod], + ext, dsimp, + dsimp [associator_Bimod.hom], + slice_lhs 1 2 { rw coequalizer.π_desc }, + dsimp [associator_Bimod.hom_aux], + slice_rhs 1 2 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [right_unitor_Bimod.hom], + refine (cancel_epi ((tensor_right _).map (coequalizer.π _ _))).1 _, + dsimp [regular], + slice_lhs 1 3 { rw π_tensor_id_preserves_coequalizer_inv_desc }, + slice_lhs 3 4 { rw [ι_colim_map, parallel_pair_hom_app_one] }, + dsimp [left_unitor_Bimod.hom], + slice_lhs 2 3 { rw [←id_tensor_comp, coequalizer.π_desc] }, + slice_rhs 1 2 { rw [←comp_tensor_id, coequalizer.π_desc] }, + slice_rhs 1 2 { rw coequalizer.condition }, + simp only [category.assoc], +end + +/-- The bicategory of algebras (monoids) and bimodules, all internal to some monoidal category. -/ +noncomputable +def Mon_bicategory : bicategory (Mon_ C) := +{ hom := λ X Y, Bimod X Y, + id := λ X, regular X, + comp := λ _ _ _ M N, tensor_Bimod M N, + whisker_left := λ _ _ _ L _ _ f, tensor_hom (𝟙 L) f, + whisker_right := λ _ _ _ _ _ f N, tensor_hom f (𝟙 N), + associator := λ _ _ _ _ L M N, associator_Bimod L M N, + left_unitor := λ _ _ M, left_unitor_Bimod M, + right_unitor := λ _ _ M, right_unitor_Bimod M, + whisker_left_id' := λ _ _ _ _ _, tensor_id, + whisker_left_comp' := λ _ _ _ M _ _ _ f g, whisker_left_comp_Bimod M f g, + id_whisker_left' := λ _ _ _ _ f, id_whisker_left_Bimod f, + comp_whisker_left' := λ _ _ _ _ M N _ _ f, comp_whisker_left_Bimod M N f, + id_whisker_right' := λ _ _ _ _ _, tensor_id, + comp_whisker_right' := λ _ _ _ _ _ _ f g Q, comp_whisker_right_Bimod f g Q, + whisker_right_id' := λ _ _ _ _ f, whisker_right_id_Bimod f, + whisker_right_comp' := λ _ _ _ _ _ _ f N P, whisker_right_comp_Bimod f N P, + whisker_assoc' := λ _ _ _ _ M _ _ f P, whisker_assoc_Bimod M f P, + whisker_exchange' := λ _ _ _ _ _ _ _ f g, whisker_exchange_Bimod f g, + pentagon' := λ _ _ _ _ _ M N P Q, pentagon_Bimod M N P Q, + triangle' := λ _ _ _ M N, triangle_Bimod M N } + +end Bimod diff --git a/src/category_theory/monoidal/CommMon_.lean b/src/category_theory/monoidal/CommMon_.lean index 2fe0520065b16..b772938e4888b 100644 --- a/src/category_theory/monoidal/CommMon_.lean +++ b/src/category_theory/monoidal/CommMon_.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.Mon_ /-! # The category of commutative monoids in a braided monoidal category. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes v₁ v₂ u₁ u₂ u @@ -133,6 +136,9 @@ def CommMon_to_lax_braided : CommMon_ C ⥤ lax_braided_functor (discrete punit. unit' := f.one_hom, tensor' := λ _ _, f.mul_hom, }, } +local attribute [tidy] tactic.discrete_cases +local attribute [simp] eq_to_iso_map + /-- Implementation of `CommMon_.equiv_lax_braided_functor_punit`. -/ @[simps] def unit_iso : @@ -153,6 +159,7 @@ nat_iso.of_components (λ F, { hom := { hom := 𝟙 _, }, inv := { hom := 𝟙 _ end equiv_lax_braided_functor_punit open equiv_lax_braided_functor_punit +local attribute [simp] eq_to_iso_map /-- Commutative monoid objects in `C` are "just" braided lax monoidal functors from the trivial diff --git a/src/category_theory/monoidal/End.lean b/src/category_theory/monoidal/End.lean index f12b646e85e4c..502a540e79c6e 100644 --- a/src/category_theory/monoidal/End.lean +++ b/src/category_theory/monoidal/End.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.functor /-! # Endofunctors as a monoidal category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We give the monoidal category structure on `C ⥤ C`, and show that when `C` itself is monoidal, it embeds via a monoidal functor into `C ⥤ C`. diff --git a/src/category_theory/monoidal/Mod.lean b/src/category_theory/monoidal/Mod.lean deleted file mode 100644 index 1ac72705788c9..0000000000000 --- a/src/category_theory/monoidal/Mod.lean +++ /dev/null @@ -1,126 +0,0 @@ -/- -Copyright (c) 2020 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison --/ -import category_theory.monoidal.Mon_ - -/-! -# The category of module objects over a monoid object. --/ - -universes v₁ v₂ u₁ u₂ - -open category_theory -open category_theory.monoidal_category - -variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C] - -variables {C} - -/-- A module object for a monoid object, all internal to some monoidal category. -/ -structure Mod (A : Mon_ C) := -(X : C) -(act : A.X ⊗ X ⟶ X) -(one_act' : (A.one ⊗ 𝟙 X) ≫ act = (λ_ X).hom . obviously) -(assoc' : (A.mul ⊗ 𝟙 X) ≫ act = (α_ A.X A.X X).hom ≫ (𝟙 A.X ⊗ act) ≫ act . obviously) - -restate_axiom Mod.one_act' -restate_axiom Mod.assoc' -attribute [simp, reassoc] Mod.one_act Mod.assoc - -namespace Mod - -variables {A : Mon_ C} (M : Mod A) - -lemma assoc_flip : (𝟙 A.X ⊗ M.act) ≫ M.act = (α_ A.X A.X M.X).inv ≫ (A.mul ⊗ 𝟙 M.X) ≫ M.act := -by simp - -/-- A morphism of module objects. -/ -@[ext] -structure hom (M N : Mod A) := -(hom : M.X ⟶ N.X) -(act_hom' : M.act ≫ hom = (𝟙 A.X ⊗ hom) ≫ N.act . obviously) - -restate_axiom hom.act_hom' -attribute [simp, reassoc] hom.act_hom - -/-- The identity morphism on a module object. -/ -@[simps] -def id (M : Mod A) : hom M M := -{ hom := 𝟙 M.X, } - -instance hom_inhabited (M : Mod A) : inhabited (hom M M) := ⟨id M⟩ - -/-- Composition of module object morphisms. -/ -@[simps] -def comp {M N O : Mod A} (f : hom M N) (g : hom N O) : hom M O := -{ hom := f.hom ≫ g.hom, } - -instance : category (Mod A) := -{ hom := λ M N, hom M N, - id := id, - comp := λ M N O f g, comp f g, } - -@[simp] lemma id_hom' (M : Mod A) : (𝟙 M : hom M M).hom = 𝟙 M.X := rfl -@[simp] lemma comp_hom' {M N K : Mod A} (f : M ⟶ N) (g : N ⟶ K) : - (f ≫ g : hom M K).hom = f.hom ≫ g.hom := rfl - -variables (A) - -/-- A monoid object as a module over itself. -/ -@[simps] -def regular : Mod A := -{ X := A.X, - act := A.mul, } - -instance : inhabited (Mod A) := ⟨regular A⟩ - -/-- The forgetful functor from module objects to the ambient category. -/ -def forget : Mod A ⥤ C := -{ obj := λ A, A.X, - map := λ A B f, f.hom, } - -open category_theory.monoidal_category - -/-- -A morphism of monoid objects induces a "restriction" or "comap" functor -between the categories of module objects. --/ -@[simps] -def comap {A B : Mon_ C} (f : A ⟶ B) : Mod B ⥤ Mod A := -{ obj := λ M, - { X := M.X, - act := (f.hom ⊗ 𝟙 M.X) ≫ M.act, - one_act' := - begin - slice_lhs 1 2 { rw [←comp_tensor_id], }, - rw [f.one_hom, one_act], - end, - assoc' := - begin - -- oh, for homotopy.io in a widget! - slice_rhs 2 3 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor], }, - rw id_tensor_comp, - slice_rhs 4 5 { rw Mod.assoc_flip, }, - slice_rhs 3 4 { rw associator_inv_naturality, }, - slice_rhs 2 3 { rw [←tensor_id, associator_inv_naturality], }, - slice_rhs 1 3 { rw [iso.hom_inv_id_assoc], }, - slice_rhs 1 2 { rw [←comp_tensor_id, tensor_id_comp_id_tensor], }, - slice_rhs 1 2 { rw [←comp_tensor_id, ←f.mul_hom], }, - rw [comp_tensor_id, category.assoc], - end, }, - map := λ M N g, - { hom := g.hom, - act_hom' := - begin - dsimp, - slice_rhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor], }, - slice_rhs 2 3 { rw ←g.act_hom, }, - rw category.assoc, - end }, } - --- Lots more could be said about `comap`, e.g. how it interacts with --- identities, compositions, and equalities of monoid object morphisms. - -end Mod diff --git a/src/category_theory/monoidal/Mod_.lean b/src/category_theory/monoidal/Mod_.lean new file mode 100644 index 0000000000000..d3f89f976018c --- /dev/null +++ b/src/category_theory/monoidal/Mod_.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2020 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import category_theory.monoidal.Mon_ + +/-! +# The category of module objects over a monoid object. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +universes v₁ v₂ u₁ u₂ + +open category_theory +open category_theory.monoidal_category + +variables (C : Type u₁) [category.{v₁} C] [monoidal_category.{v₁} C] + +variables {C} + +/-- A module object for a monoid object, all internal to some monoidal category. -/ +structure Mod_ (A : Mon_ C) := +(X : C) +(act : A.X ⊗ X ⟶ X) +(one_act' : (A.one ⊗ 𝟙 X) ≫ act = (λ_ X).hom . obviously) +(assoc' : (A.mul ⊗ 𝟙 X) ≫ act = (α_ A.X A.X X).hom ≫ (𝟙 A.X ⊗ act) ≫ act . obviously) + +restate_axiom Mod_.one_act' +restate_axiom Mod_.assoc' +attribute [simp, reassoc] Mod_.one_act Mod_.assoc + +namespace Mod_ + +variables {A : Mon_ C} (M : Mod_ A) + +lemma assoc_flip : (𝟙 A.X ⊗ M.act) ≫ M.act = (α_ A.X A.X M.X).inv ≫ (A.mul ⊗ 𝟙 M.X) ≫ M.act := +by simp + +/-- A morphism of module objects. -/ +@[ext] +structure hom (M N : Mod_ A) := +(hom : M.X ⟶ N.X) +(act_hom' : M.act ≫ hom = (𝟙 A.X ⊗ hom) ≫ N.act . obviously) + +restate_axiom hom.act_hom' +attribute [simp, reassoc] hom.act_hom + +/-- The identity morphism on a module object. -/ +@[simps] +def id (M : Mod_ A) : hom M M := +{ hom := 𝟙 M.X, } + +instance hom_inhabited (M : Mod_ A) : inhabited (hom M M) := ⟨id M⟩ + +/-- Composition of module object morphisms. -/ +@[simps] +def comp {M N O : Mod_ A} (f : hom M N) (g : hom N O) : hom M O := +{ hom := f.hom ≫ g.hom, } + +instance : category (Mod_ A) := +{ hom := λ M N, hom M N, + id := id, + comp := λ M N O f g, comp f g, } + +@[simp] lemma id_hom' (M : Mod_ A) : (𝟙 M : hom M M).hom = 𝟙 M.X := rfl +@[simp] lemma comp_hom' {M N K : Mod_ A} (f : M ⟶ N) (g : N ⟶ K) : + (f ≫ g : hom M K).hom = f.hom ≫ g.hom := rfl + +variables (A) + +/-- A monoid object as a module over itself. -/ +@[simps] +def regular : Mod_ A := +{ X := A.X, + act := A.mul, } + +instance : inhabited (Mod_ A) := ⟨regular A⟩ + +/-- The forgetful functor from module objects to the ambient category. -/ +def forget : Mod_ A ⥤ C := +{ obj := λ A, A.X, + map := λ A B f, f.hom, } + +open category_theory.monoidal_category + +/-- +A morphism of monoid objects induces a "restriction" or "comap" functor +between the categories of module objects. +-/ +@[simps] +def comap {A B : Mon_ C} (f : A ⟶ B) : Mod_ B ⥤ Mod_ A := +{ obj := λ M, + { X := M.X, + act := (f.hom ⊗ 𝟙 M.X) ≫ M.act, + one_act' := + begin + slice_lhs 1 2 { rw [←comp_tensor_id], }, + rw [f.one_hom, one_act], + end, + assoc' := + begin + -- oh, for homotopy.io in a widget! + slice_rhs 2 3 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor], }, + rw id_tensor_comp, + slice_rhs 4 5 { rw Mod_.assoc_flip, }, + slice_rhs 3 4 { rw associator_inv_naturality, }, + slice_rhs 2 3 { rw [←tensor_id, associator_inv_naturality], }, + slice_rhs 1 3 { rw [iso.hom_inv_id_assoc], }, + slice_rhs 1 2 { rw [←comp_tensor_id, tensor_id_comp_id_tensor], }, + slice_rhs 1 2 { rw [←comp_tensor_id, ←f.mul_hom], }, + rw [comp_tensor_id, category.assoc], + end, }, + map := λ M N g, + { hom := g.hom, + act_hom' := + begin + dsimp, + slice_rhs 1 2 { rw [id_tensor_comp_tensor_id, ←tensor_id_comp_id_tensor], }, + slice_rhs 2 3 { rw ←g.act_hom, }, + rw category.assoc, + end }, } + +-- Lots more could be said about `comap`, e.g. how it interacts with +-- identities, compositions, and equalities of monoid object morphisms. + +end Mod_ diff --git a/src/category_theory/monoidal/Mon_.lean b/src/category_theory/monoidal/Mon_.lean index c25d0535bdc4f..5a26a67311fce 100644 --- a/src/category_theory/monoidal/Mon_.lean +++ b/src/category_theory/monoidal/Mon_.lean @@ -12,6 +12,9 @@ import algebra.punit_instances /-! # The category of monoids in a monoidal category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define monoids in a monoidal category `C` and show that the category of monoids is equivalent to the category of lax monoidal functors from the unit monoidal category to `C`. We also show that if `C` is braided, then the category of monoids is naturally monoidal. @@ -266,6 +269,9 @@ def Mon_to_lax_monoidal : Mon_ C ⥤ lax_monoidal_functor (discrete punit.{u+1}) unit' := f.one_hom, tensor' := λ _ _, f.mul_hom, }, } +local attribute [tidy] tactic.discrete_cases +local attribute [simp] eq_to_iso_map + /-- Implementation of `Mon_.equiv_lax_monoidal_functor_punit`. -/ @[simps] def unit_iso : @@ -287,6 +293,8 @@ end equiv_lax_monoidal_functor_punit open equiv_lax_monoidal_functor_punit +local attribute [simp] eq_to_iso_map + /-- Monoid objects in `C` are "just" lax monoidal functors from the trivial monoidal category to `C`. -/ diff --git a/src/category_theory/monoidal/braided.lean b/src/category_theory/monoidal/braided.lean index bec4e75332dae..bc15bf64ccc39 100644 --- a/src/category_theory/monoidal/braided.lean +++ b/src/category_theory/monoidal/braided.lean @@ -10,6 +10,9 @@ import category_theory.monoidal.discrete /-! # Braided and symmetric monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The basic definitions of braided monoidal categories, and symmetric monoidal categories, as well as braided functors. @@ -221,6 +224,9 @@ class symmetric_category (C : Type u) [category.{v} C] [monoidal_category.{v} C] restate_axiom symmetric_category.symmetry' attribute [simp,reassoc] symmetric_category.symmetry +initialize_simps_projections symmetric_category + (to_braided_category_braiding → braiding, -to_braided_category) + variables (C : Type u₁) [category.{v₁} C] [monoidal_category C] [braided_category C] variables (D : Type u₂) [category.{v₂} D] [monoidal_category D] [braided_category D] variables (E : Type u₃) [category.{v₃} E] [monoidal_category E] [braided_category E] @@ -339,10 +345,8 @@ section comm_monoid variables (M : Type u) [comm_monoid M] -instance comm_monoid_discrete : comm_monoid (discrete M) := by { dsimp [discrete], apply_instance } - instance : braided_category (discrete M) := -{ braiding := λ X Y, eq_to_iso (mul_comm X Y), } +{ braiding := λ X Y, discrete.eq_to_iso (mul_comm X.as Y.as), } variables {M} {N : Type u} [comm_monoid N] diff --git a/src/category_theory/monoidal/category.lean b/src/category_theory/monoidal/category.lean index 7dcc5f6d38b04..d475a9e130525 100644 --- a/src/category_theory/monoidal/category.lean +++ b/src/category_theory/monoidal/category.lean @@ -8,6 +8,9 @@ import category_theory.products.basic /-! # Monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A monoidal category is a category equipped with a tensor product, unitors, and an associator. In the definition, we provide the tensor product as a pair of functions * `tensor_obj : C → C → C` @@ -67,7 +70,7 @@ See . class monoidal_category (C : Type u) [𝒞 : category.{v} C] := -- curried tensor product of objects: (tensor_obj : C → C → C) -(infixr ` ⊗ `:70 := tensor_obj) -- This notation is only temporary +(infixr (name := tensor_obj) ` ⊗ `:70 := tensor_obj) -- This notation is only temporary -- curried tensor product of morphisms: (tensor_hom : Π {X₁ Y₁ X₂ Y₂ : C}, (X₁ ⟶ Y₁) → (X₂ ⟶ Y₂) → ((X₁ ⊗ X₂) ⟶ (Y₁ ⊗ Y₂))) @@ -124,8 +127,8 @@ attribute [simp, reassoc] monoidal_category.triangle open monoidal_category -infixr ` ⊗ `:70 := tensor_obj -infixr ` ⊗ `:70 := tensor_hom +infixr (name := tensor_obj) ` ⊗ `:70 := tensor_obj +infixr (name := tensor_hom) ` ⊗ `:70 := tensor_hom notation `𝟙_` := tensor_unit notation `α_` := associator @@ -142,7 +145,7 @@ def tensor_iso {C : Type u} {X Y X' Y' : C} [category.{v} C] [monoidal_category. hom_inv_id' := by rw [←tensor_comp, iso.hom_inv_id, iso.hom_inv_id, ←tensor_id], inv_hom_id' := by rw [←tensor_comp, iso.inv_hom_id, iso.inv_hom_id, ←tensor_id] } -infixr ` ⊗ `:70 := tensor_iso +infixr (name := tensor_iso) ` ⊗ `:70 := tensor_iso namespace monoidal_category @@ -477,31 +480,6 @@ rfl (tensor_right_tensor X Y).inv.app Z = (associator Z X Y).hom := by simp [tensor_right_tensor] -variables {C} - -/-- -Any property closed under `𝟙_` and `⊗` induces a full monoidal subcategory of `C`, where -the category on the subtype is given by `full_subcategory`. --/ -def full_monoidal_subcategory (P : C → Prop) (h_id : P (𝟙_ C)) - (h_tensor : ∀ {X Y}, P X → P Y → P (X ⊗ Y)) : monoidal_category {X : C // P X} := -{ tensor_obj := λ X Y, ⟨X ⊗ Y, h_tensor X.2 Y.2⟩, - tensor_hom := λ X₁ Y₁ X₂ Y₂ f g, by { change X₁.1 ⊗ X₂.1 ⟶ Y₁.1 ⊗ Y₂.1, - change X₁.1 ⟶ Y₁.1 at f, change X₂.1 ⟶ Y₂.1 at g, exact f ⊗ g }, - tensor_unit := ⟨𝟙_ C, h_id⟩, - associator := λ X Y Z, - ⟨(α_ X.1 Y.1 Z.1).hom, (α_ X.1 Y.1 Z.1).inv, - hom_inv_id (α_ X.1 Y.1 Z.1), inv_hom_id (α_ X.1 Y.1 Z.1)⟩, - left_unitor := λ X, ⟨(λ_ X.1).hom, (λ_ X.1).inv, hom_inv_id (λ_ X.1), inv_hom_id (λ_ X.1)⟩, - right_unitor := λ X, ⟨(ρ_ X.1).hom, (ρ_ X.1).inv, hom_inv_id (ρ_ X.1), inv_hom_id (ρ_ X.1)⟩, - tensor_id' := λ X Y, tensor_id X.1 Y.1, - tensor_comp' := λ X₁ Y₁ Z₁ X₂ Y₂ Z₂ f₁ f₂ g₁ g₂, tensor_comp f₁ f₂ g₁ g₂, - associator_naturality' := λ X₁ X₂ X₃ Y₁ Y₂ Y₃ f₁ f₂ f₃, associator_naturality f₁ f₂ f₃, - left_unitor_naturality' := λ X Y f, left_unitor_naturality f, - right_unitor_naturality' := λ X Y f, right_unitor_naturality f, - pentagon' := λ W X Y Z, pentagon W.1 X.1 Y.1 Z.1, - triangle' := λ X Y, triangle X.1 Y.1 } - end end diff --git a/src/category_theory/monoidal/center.lean b/src/category_theory/monoidal/center.lean index 4ffea5d7850a4..3d109154edcee 100644 --- a/src/category_theory/monoidal/center.lean +++ b/src/category_theory/monoidal/center.lean @@ -10,6 +10,9 @@ import category_theory.monoidal.coherence /-! # Half braidings and the Drinfeld center of a monoidal category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `center C` to be pairs `⟨X, b⟩`, where `X : C` and `b` is a half-braiding on `X`. We show that `center C` is braided monoidal, @@ -47,7 +50,7 @@ Thinking of `C` as a 2-category with a single `0`-morphism, these are the same a transformations (in the pseudo- sense) of the identity 2-functor on `C`, which send the unique `0`-morphism to `X`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure half_braiding (X : C) := (β : Π U, X ⊗ U ≅ U ⊗ X) (monoidal' : ∀ U U', (β (U ⊗ U')).hom = @@ -65,7 +68,7 @@ variables (C) The Drinfeld center of a monoidal category `C` has as objects pairs `⟨X, b⟩`, where `X : C` and `b` is a half-braiding on `X`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def center := Σ X : C, half_braiding X namespace center @@ -73,7 +76,7 @@ namespace center variables {C} /-- A morphism in the Drinfeld center of `C`. -/ -@[ext, nolint has_inhabited_instance] +@[ext, nolint has_nonempty_instance] structure hom (X Y : center C) := (f : X.1 ⟶ Y.1) (comm' : ∀ U, (f ⊗ 𝟙 U) ≫ (Y.2.β U).hom = (X.2.β U).hom ≫ (𝟙 U ⊗ f) . obviously) diff --git a/src/category_theory/monoidal/coherence.lean b/src/category_theory/monoidal/coherence.lean index 27b7e7bc6b669..33035d50beba4 100644 --- a/src/category_theory/monoidal/coherence.lean +++ b/src/category_theory/monoidal/coherence.lean @@ -9,6 +9,9 @@ import category_theory.bicategory.coherence_tactic /-! # A `coherence` tactic for monoidal categories, and `⊗≫` (composition up to associators) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide a `coherence` tactic, which proves equations where the two sides differ by replacing strings of monoidal structural morphisms with other such strings. diff --git a/src/category_theory/monoidal/coherence_lemmas.lean b/src/category_theory/monoidal/coherence_lemmas.lean index 8d8ff40a19d3c..0408bb098f37f 100644 --- a/src/category_theory/monoidal/coherence_lemmas.lean +++ b/src/category_theory/monoidal/coherence_lemmas.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.coherence /-! # Lemmas which are consequences of monoidal coherence +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + These lemmas are all proved `by coherence`. ## Future work diff --git a/src/category_theory/monoidal/discrete.lean b/src/category_theory/monoidal/discrete.lean index ead5f4a967ee8..45a90c545cf46 100644 --- a/src/category_theory/monoidal/discrete.lean +++ b/src/category_theory/monoidal/discrete.lean @@ -10,6 +10,9 @@ import category_theory.monoidal.natural_transformation /-! # Monoids as discrete monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The discrete category on a monoid is a monoidal category. Multiplicative morphisms induced monoidal functors. -/ @@ -23,17 +26,14 @@ variables (M : Type u) [monoid M] namespace category_theory -@[to_additive] -instance monoid_discrete : monoid (discrete M) := by { dsimp [discrete], apply_instance } - -@[to_additive discrete.add_monoidal] +@[to_additive discrete.add_monoidal, simps tensor_obj_as tensor_unit_as] instance discrete.monoidal : monoidal_category (discrete M) := -{ tensor_unit := 1, - tensor_obj := λ X Y, X * Y, +{ tensor_unit := discrete.mk 1, + tensor_obj := λ X Y, discrete.mk (X.as * Y.as), tensor_hom := λ W X Y Z f g, eq_to_hom (by rw [eq_of_hom f, eq_of_hom g]), - left_unitor := λ X, eq_to_iso (one_mul X), - right_unitor := λ X, eq_to_iso (mul_one X), - associator := λ X Y Z, eq_to_iso (mul_assoc _ _ _), } + left_unitor := λ X, discrete.eq_to_iso (one_mul X.as), + right_unitor := λ X, discrete.eq_to_iso (mul_one X.as), + associator := λ X Y Z, discrete.eq_to_iso (mul_assoc _ _ _ ), } variables {M} {N : Type u} [monoid N] @@ -44,10 +44,10 @@ discrete monoidal categories. @[to_additive discrete.add_monoidal_functor "An additive morphism between add_monoids gives a monoidal functor between the corresponding discrete monoidal categories.", simps] def discrete.monoidal_functor (F : M →* N) : monoidal_functor (discrete M) (discrete N) := -{ obj := F, - map := λ X Y f, eq_to_hom (F.congr_arg (eq_of_hom f)), - ε := eq_to_hom F.map_one.symm, - μ := λ X Y, eq_to_hom (F.map_mul X Y).symm, } +{ obj := λ X, discrete.mk (F X.as), + map := λ X Y f, discrete.eq_to_hom (F.congr_arg (eq_of_hom f)), + ε := discrete.eq_to_hom F.map_one.symm, + μ := λ X Y, discrete.eq_to_hom (F.map_mul X.as Y.as).symm, } variables {K : Type u} [monoid K] diff --git a/src/category_theory/monoidal/free/basic.lean b/src/category_theory/monoidal/free/basic.lean index 4b94068049a12..e3f694775af00 100644 --- a/src/category_theory/monoidal/free/basic.lean +++ b/src/category_theory/monoidal/free/basic.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.functor /-! # The free monoidal category over a type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a type `C`, the free monoidal category over `C` has as objects formal expressions built from (formal) tensor products of terms of `C` and a formal unit. Its morphisms are compositions and tensor products of identities, unitors and associators. @@ -52,7 +55,7 @@ namespace free_monoidal_category /-- Formal compositions and tensor products of identities, unitors and associators. The morphisms of the free monoidal category are obtained as a quotient of these formal morphisms by the relations defining a monoidal category. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] inductive hom : F C → F C → Type u | id (X) : hom X X | α_hom (X Y Z : F C) : hom ((X.tensor Y).tensor Z) (X.tensor (Y.tensor Z)) diff --git a/src/category_theory/monoidal/free/coherence.lean b/src/category_theory/monoidal/free/coherence.lean index 8304f1320f38a..8aab1c0a2e6f7 100644 --- a/src/category_theory/monoidal/free/coherence.lean +++ b/src/category_theory/monoidal/free/coherence.lean @@ -10,6 +10,9 @@ import category_theory.discrete_category /-! # The monoidal coherence theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove the monoidal coherence theorem, stated in the following form: the free monoidal category over any type `C` is thin. @@ -49,7 +52,7 @@ variables (C) /-- We say an object in the free monoidal category is in normal form if it is of the form `(((𝟙_ C) ⊗ X₁) ⊗ X₂) ⊗ ⋯`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] inductive normal_monoidal_object : Type u | unit : normal_monoidal_object | tensor : normal_monoidal_object → C → normal_monoidal_object @@ -70,36 +73,39 @@ local infixr ` ⟶ᵐ `:10 := hom discrete.functor inclusion_obj /-- Auxiliary definition for `normalize`. -/ -@[simp] def normalize_obj : F C → normal_monoidal_object C → normal_monoidal_object C -| unit n := n -| (of X) n := normal_monoidal_object.tensor n X -| (tensor X Y) n := normalize_obj Y (normalize_obj X n) +@[simp] def normalize_obj : F C → normal_monoidal_object C → N C +| unit n := ⟨n⟩ +| (of X) n := ⟨normal_monoidal_object.tensor n X⟩ +| (tensor X Y) n := normalize_obj Y (normalize_obj X n).as -@[simp] lemma normalize_obj_unitor (n : N C) : normalize_obj (𝟙_ (F C)) n = n := +@[simp] lemma normalize_obj_unitor (n : normal_monoidal_object C) : + normalize_obj (𝟙_ (F C)) n = ⟨n⟩ := rfl -@[simp] lemma normalize_obj_tensor (X Y : F C) (n : N C) : - normalize_obj (X ⊗ Y) n = normalize_obj Y (normalize_obj X n) := +@[simp] lemma normalize_obj_tensor (X Y : F C) (n : normal_monoidal_object C) : + normalize_obj (X ⊗ Y) n = normalize_obj Y (normalize_obj X n).as := rfl section open hom +local attribute [tidy] tactic.discrete_cases + /-- Auxiliary definition for `normalize`. Here we prove that objects that are related by associators and unitors map to the same normal form. -/ @[simp] def normalize_map_aux : Π {X Y : F C}, (X ⟶ᵐ Y) → ((discrete.functor (normalize_obj X) : _ ⥤ N C) ⟶ discrete.functor (normalize_obj Y)) | _ _ (id _) := 𝟙 _ -| _ _ (α_hom _ _ _) := ⟨λ X, 𝟙 _⟩ -| _ _ (α_inv _ _ _) := ⟨λ X, 𝟙 _⟩ -| _ _ (l_hom _) := ⟨λ X, 𝟙 _⟩ -| _ _ (l_inv _) := ⟨λ X, 𝟙 _⟩ -| _ _ (ρ_hom _) := ⟨λ X, 𝟙 _⟩ -| _ _ (ρ_inv _) := ⟨λ X, 𝟙 _⟩ +| _ _ (α_hom _ _ _) := ⟨λ X, 𝟙 _, by { rintros ⟨X⟩ ⟨Y⟩ f, simp }⟩ +| _ _ (α_inv _ _ _) := ⟨λ X, 𝟙 _, by { rintros ⟨X⟩ ⟨Y⟩ f, simp }⟩ +| _ _ (l_hom _) := ⟨λ X, 𝟙 _, by { rintros ⟨X⟩ ⟨Y⟩ f, simp }⟩ +| _ _ (l_inv _) := ⟨λ X, 𝟙 _, by { rintros ⟨X⟩ ⟨Y⟩ f, simp }⟩ +| _ _ (ρ_hom _) := ⟨λ ⟨X⟩, ⟨⟨by simp⟩⟩, by { rintros ⟨X⟩ ⟨Y⟩ f, simp }⟩ +| _ _ (ρ_inv _) := ⟨λ ⟨X⟩, ⟨⟨by simp⟩⟩, by { rintros ⟨X⟩ ⟨Y⟩ f, simp }⟩ | X Y (@comp _ U V W f g) := normalize_map_aux f ≫ normalize_map_aux g | X Y (@hom.tensor _ T U V W f g) := - ⟨λ X, (normalize_map_aux g).app (normalize_obj T X) ≫ + ⟨λ X, (normalize_map_aux g).app (normalize_obj T X.as) ≫ (discrete.functor (normalize_obj W) : _ ⥤ N C).map ((normalize_map_aux f).app X), by tidy⟩ end @@ -122,14 +128,14 @@ normalize C ⋙ (whiskering_right _ _ _).obj inclusion /-- The normalization functor for the free monoidal category over `C`. -/ def full_normalize : F C ⥤ N C := -{ obj := λ X, ((normalize C).obj X).obj normal_monoidal_object.unit, - map := λ X Y f, ((normalize C).map f).app normal_monoidal_object.unit } +{ obj := λ X, ((normalize C).obj X).obj ⟨normal_monoidal_object.unit⟩, + map := λ X Y f, ((normalize C).map f).app ⟨normal_monoidal_object.unit⟩ } /-- Given an object `X` of the free monoidal category and an object `n` in normal form, taking the tensor product `n ⊗ X` in the free monoidal category is functorial in both `X` and `n`. -/ @[simp] def tensor_func : F C ⥤ N C ⥤ F C := -{ obj := λ X, discrete.functor (λ n, (inclusion.obj n) ⊗ X), - map := λ X Y f, ⟨λ n, 𝟙 _ ⊗ f, by tidy⟩ } +{ obj := λ X, discrete.functor (λ n, (inclusion.obj ⟨n⟩) ⊗ X), + map := λ X Y f, ⟨λ n, 𝟙 _ ⊗ f, by { rintro ⟨X⟩ ⟨Y⟩, tidy }⟩ } lemma tensor_func_map_app {X Y : F C} (f : X ⟶ Y) (n) : ((tensor_func C).map f).app n = 𝟙 _ ⊗ f := @@ -137,7 +143,7 @@ rfl lemma tensor_func_obj_map (Z : F C) {n n' : N C} (f : n ⟶ n') : ((tensor_func C).obj Z).map f = inclusion.map f ⊗ 𝟙 Z := -by tidy +by { cases n, cases n', tidy } /-- Auxiliary definition for `normalize_iso`. Here we construct the isomorphism between `n ⊗ X` and `normalize X n`. -/ @@ -159,7 +165,20 @@ rfl /-- Auxiliary definition for `normalize_iso`. -/ @[simp] def normalize_iso_aux (X : F C) : (tensor_func C).obj X ≅ (normalize' C).obj X := -nat_iso.of_components (normalize_iso_app C X) (by tidy) +nat_iso.of_components (normalize_iso_app C X) (by { rintros ⟨X⟩ ⟨Y⟩, tidy }) + +section +variables {D : Type u} [category.{u} D] {I : Type u} (f : I → D) (X : discrete I) + +-- TODO: move to discrete_category.lean, decide whether this should be a global simp lemma +@[simp] lemma discrete_functor_obj_eq_as : (discrete.functor f).obj X = f X.as := +rfl + +-- TODO: move to discrete_category.lean, decide whether this should be a global simp lemma +@[simp] lemma discrete_functor_map_eq_id (g : X ⟶ X) : (discrete.functor f).map g = 𝟙 _ := +by tidy + +end /-- The isomorphism between `n ⊗ X` and `normalize X n` is natural (in both `X` and `n`, but naturality in `n` is trivial and was "proved" in `normalize_iso_aux`). This is the real heart @@ -177,7 +196,7 @@ begin simp only [id_tensor_associator_inv_naturality_assoc, ←pentagon_inv_assoc, tensor_hom_inv_id_assoc, tensor_id, category.id_comp, discrete.functor_map_id, comp_tensor_id, iso.cancel_iso_inv_left, category.assoc], - dsimp, simp only [category.comp_id] }, + dsimp, simp only [category.comp_id], }, { dsimp, simp only [discrete.functor_map_id, comp_tensor_id, category.assoc, pentagon_inv_assoc, ←associator_inv_naturality_assoc, tensor_id, iso.cancel_iso_inv_left], @@ -185,20 +204,27 @@ begin { dsimp, rw triangle_assoc_comp_right_assoc, simp only [discrete.functor_map_id, category.assoc], + cases n, dsimp, simp only [category.comp_id] }, { dsimp, simp only [triangle_assoc_comp_left_inv_assoc, inv_hom_id_tensor_assoc, tensor_id, category.id_comp, discrete.functor_map_id], - dsimp, simp only [category.comp_id] }, + dsimp, simp only [category.comp_id], + cases n, simp }, { dsimp, rw [←(iso.inv_comp_eq _).2 (right_unitor_tensor _ _), category.assoc, ←right_unitor_naturality], - simp only [discrete.functor_map_id, iso.cancel_iso_inv_left, category.assoc], - dsimp, simp only [category.comp_id] }, + simp only [iso.cancel_iso_inv_left, category.assoc], + congr' 1, + convert (category.comp_id _).symm, + convert discrete_functor_map_eq_id inclusion_obj _ _, + ext, + refl }, { dsimp, simp only [←(iso.eq_comp_inv _).1 (right_unitor_tensor_inv _ _), right_unitor_conjugation, - discrete.functor_map_id, category.assoc, - iso.hom_inv_id, iso.hom_inv_id_assoc, iso.inv_hom_id, iso.inv_hom_id_assoc], - dsimp, simp only [category.comp_id], }, + category.assoc, iso.hom_inv_id, iso.hom_inv_id_assoc, iso.inv_hom_id, iso.inv_hom_id_assoc], + congr, + convert (discrete_functor_map_eq_id inclusion_obj _ _).symm, + ext, refl, }, { dsimp at *, rw [id_tensor_comp, category.assoc, f_ih_g ⟦f_g⟧, ←category.assoc, f_ih_f ⟦f_f⟧, category.assoc, ←functor.map_comp], @@ -223,24 +249,25 @@ end /-- The isomorphism between an object and its normal form is natural. -/ def full_normalize_iso : 𝟭 (F C) ≅ full_normalize C ⋙ inclusion := nat_iso.of_components - (λ X, (λ_ X).symm ≪≫ ((normalize_iso C).app X).app normal_monoidal_object.unit) + (λ X, (λ_ X).symm ≪≫ ((normalize_iso C).app X).app ⟨normal_monoidal_object.unit⟩) begin intros X Y f, dsimp, rw [left_unitor_inv_naturality_assoc, category.assoc, iso.cancel_iso_inv_left], - exact congr_arg (λ f, nat_trans.app f normal_monoidal_object.unit) - ((normalize_iso.{u} C).hom.naturality f), + exact congr_arg (λ f, nat_trans.app f (discrete.mk normal_monoidal_object.unit)) + ((normalize_iso.{u} C).hom.naturality f) end end /-- The monoidal coherence theorem. -/ -instance subsingleton_hom {X Y : F C} : subsingleton (X ⟶ Y) := -⟨λ f g, have (full_normalize C).map f = (full_normalize C).map g, from subsingleton.elim _ _, - begin - rw [←functor.id_map f, ←functor.id_map g], - simp [←nat_iso.naturality_2 (full_normalize_iso.{u} C), this] - end⟩ +instance subsingleton_hom : quiver.is_thin (F C) := +λ _ _, + ⟨λ f g, have (full_normalize C).map f = (full_normalize C).map g, from subsingleton.elim _ _, + begin + rw [←functor.id_map f, ←functor.id_map g], + simp [←nat_iso.naturality_2 (full_normalize_iso.{u} C), this] + end⟩ section groupoid diff --git a/src/category_theory/monoidal/functor.lean b/src/category_theory/monoidal/functor.lean index 06d83b0860f67..18f74762dcea1 100644 --- a/src/category_theory/monoidal/functor.lean +++ b/src/category_theory/monoidal/functor.lean @@ -10,6 +10,9 @@ import category_theory.products.basic /-! # (Lax) monoidal functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A lax monoidal functor `F` between monoidal categories `C` and `D` is a functor between the underlying categories equipped with morphisms * `ε : 𝟙_ D ⟶ F.obj (𝟙_ C)` (called the unit morphism) @@ -220,6 +223,18 @@ nat_iso.of_components @[simp, reassoc] lemma ε_inv_hom_id : F.ε_iso.inv ≫ F.ε = 𝟙 _ := F.ε_iso.inv_hom_id @[simp] lemma ε_hom_inv_id : F.ε ≫ F.ε_iso.inv = 𝟙 _ := F.ε_iso.hom_inv_id +/-- Monoidal functors commute with left tensoring up to isomorphism -/ +@[simps] noncomputable def comm_tensor_left (X : C) : + F.to_functor ⋙ (tensor_left (F.to_functor.obj X)) ≅ + tensor_left X ⋙ F.to_functor := +nat_iso.of_components (λ Y, F.μ_iso X Y) (λ Y Z f, by { convert F.μ_natural' (𝟙 _) f, simp }) + +/-- Monoidal functors commute with right tensoring up to isomorphism -/ +@[simps] noncomputable def comm_tensor_right (X : C) : + F.to_functor ⋙ (tensor_right (F.to_functor.obj X)) ≅ + tensor_right X ⋙ F.to_functor := +nat_iso.of_components (λ Y, F.μ_iso Y X) (λ Y Z f, by { convert F.μ_natural' f (𝟙 _), simp }) + end section @@ -347,7 +362,8 @@ def comp : monoidal_functor.{v₁ v₃} C E := μ_is_iso := by { dsimp, apply_instance }, .. (F.to_lax_monoidal_functor).comp (G.to_lax_monoidal_functor) }. -infixr ` ⊗⋙ `:80 := comp -- We overload notation; potentially dangerous, but it seems to work. +-- We overload notation; potentially dangerous, but it seems to work. +infixr (name := monoidal_functor.comp) ` ⊗⋙ `:80 := comp end monoidal_functor diff --git a/src/category_theory/monoidal/functor_category.lean b/src/category_theory/monoidal/functor_category.lean index 0f5bc2d773ff6..937c29de0c9b9 100644 --- a/src/category_theory/monoidal/functor_category.lean +++ b/src/category_theory/monoidal/functor_category.lean @@ -10,6 +10,9 @@ import category_theory.functor.const /-! # Monoidal structure on `C ⥤ D` when `D` is monoidal. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `C` is any category, and `D` is a monoidal category, there is a natural "pointwise" monoidal structure on `C ⥤ D`. diff --git a/src/category_theory/monoidal/functorial.lean b/src/category_theory/monoidal/functorial.lean index 70225b04057d0..5e6bdb8f72252 100644 --- a/src/category_theory/monoidal/functorial.lean +++ b/src/category_theory/monoidal/functorial.lean @@ -9,6 +9,9 @@ import category_theory.functor.functorial /-! # Unbundled lax monoidal functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Design considerations The essential problem I've encountered that requires unbundled functors is having an existing (non-monoidal) functor `F : C ⥤ D` between monoidal categories, diff --git a/src/category_theory/monoidal/internal/Module.lean b/src/category_theory/monoidal/internal/Module.lean index 0b5fc52a0a1e3..a8dcbc32b37ac 100644 --- a/src/category_theory/monoidal/internal/Module.lean +++ b/src/category_theory/monoidal/internal/Module.lean @@ -3,7 +3,7 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import algebra.category.Module.monoidal +import algebra.category.Module.monoidal.basic import algebra.category.Algebra.basic import category_theory.monoidal.Mon_ @@ -11,6 +11,9 @@ import category_theory.monoidal.Mon_ /-! # `Mon_ (Module R) ≌ Algebra R` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The category of internal monoid objects in `Module R` is equivalent to the category of "native" bundled `R`-algebras. @@ -66,7 +69,7 @@ instance (A : Mon_ (Module.{u} R)) : algebra R A.X := have h₂ := linear_map.congr_fun A.mul_one (a ⊗ₜ r), exact h₁.trans h₂.symm, end, - smul_def' := λ r a, by { convert (linear_map.congr_fun A.one_mul (r ⊗ₜ a)).symm, simp, }, + smul_def' := λ r a, (linear_map.congr_fun A.one_mul (r ⊗ₜ a)).symm, ..A.one } @[simp] lemma algebra_map (A : Mon_ (Module.{u} R)) (r : R) : algebra_map R A.X r = A.one r := rfl @@ -91,7 +94,7 @@ Converting a bundled algebra to a monoid object in `Module R`. def inverse_obj (A : Algebra.{u} R) : Mon_ (Module.{u} R) := { X := Module.of R A, one := algebra.linear_map R A, - mul := @algebra.lmul' R A _ _ _, + mul := linear_map.mul' R A, one_mul' := begin ext x, @@ -99,7 +102,7 @@ def inverse_obj (A : Algebra.{u} R) : Mon_ (Module.{u} R) := algebra.linear_map_apply, linear_map.compr₂_apply, function.comp_app, ring_hom.map_one, Module.monoidal_category.hom_apply, Algebra.coe_comp, Module.monoidal_category.left_unitor_hom_apply], - rw [algebra.lmul'_apply, monoidal_category.left_unitor_hom_apply, ← algebra.smul_def] + rw [linear_map.mul'_apply, monoidal_category.left_unitor_hom_apply, ← algebra.smul_def] end, mul_one' := begin @@ -107,7 +110,7 @@ def inverse_obj (A : Algebra.{u} R) : Mon_ (Module.{u} R) := dsimp only [Algebra.id_apply, tensor_product.mk_apply, algebra.linear_map_apply, linear_map.compr₂_apply, function.comp_app, Module.monoidal_category.hom_apply, Algebra.coe_comp], - rw [algebra.lmul'_apply, Module.monoidal_category.right_unitor_hom_apply, + rw [linear_map.mul'_apply, Module.monoidal_category.right_unitor_hom_apply, ← algebra.commutes, ← algebra.smul_def] end, mul_assoc' := @@ -116,7 +119,7 @@ def inverse_obj (A : Algebra.{u} R) : Mon_ (Module.{u} R) := dsimp only [Algebra.id_apply, tensor_product.mk_apply, linear_map.compr₂_apply, function.comp_app, Module.monoidal_category.hom_apply, Algebra.coe_comp, monoidal_category.associator_hom_apply], - simp only [algebra.lmul'_apply, mul_assoc] + simp only [linear_map.mul'_apply, mul_assoc] end } /-- @@ -127,10 +130,8 @@ def inverse : Algebra.{u} R ⥤ Mon_ (Module.{u} R) := { obj := inverse_obj, map := λ A B f, { hom := f.to_linear_map, - one_hom' := - by { ext, dsimp, simp only [ring_hom.map_one, alg_hom.map_one] }, - mul_hom' := - by { ext, dsimp, simp only [algebra.lmul'_apply, ring_hom.map_mul, alg_hom.map_mul] } } }. + one_hom' := linear_map.ext f.commutes, + mul_hom' := tensor_product.ext $ linear_map.ext₂ $ map_mul f, } } end Mon_Module_equivalence_Algebra @@ -146,11 +147,9 @@ def Mon_Module_equivalence_Algebra : Mon_ (Module.{u} R) ≌ Algebra R := unit_iso := nat_iso.of_components (λ A, { hom := { hom := { to_fun := id, map_add' := λ x y, rfl, map_smul' := λ r a, rfl, }, - mul_hom' := by { ext, dsimp at *, - simp only [algebra.lmul'_apply, Mon_.X.ring_mul] } }, + mul_hom' := by { ext, dsimp at *, refl } }, inv := { hom := { to_fun := id, map_add' := λ x y, rfl, map_smul' := λ r a, rfl, }, - mul_hom' := by { ext, dsimp at *, - simp only [algebra.lmul'_apply, Mon_.X.ring_mul]} } }) + mul_hom' := by { ext, dsimp at *, refl } } }) (by tidy), counit_iso := nat_iso.of_components (λ A, { hom := @@ -158,14 +157,14 @@ def Mon_Module_equivalence_Algebra : Mon_ (Module.{u} R) ≌ Algebra R := map_zero' := rfl, map_add' := λ x y, rfl, map_one' := (algebra_map R A).map_one, - map_mul' := λ x y, algebra.lmul'_apply, + map_mul' := λ x y, (@linear_map.mul'_apply R _ _ _ _ _ _ x y), commutes' := λ r, rfl, }, inv := { to_fun := id, map_zero' := rfl, map_add' := λ x y, rfl, map_one' := (algebra_map R A).map_one.symm, - map_mul' := λ x y, algebra.lmul'_apply.symm, + map_mul' := λ x y, (@linear_map.mul'_apply R _ _ _ _ _ _ x y).symm, commutes' := λ r, rfl } }) (by { intros, refl }), }. /-- diff --git a/src/category_theory/monoidal/internal/functor_category.lean b/src/category_theory/monoidal/internal/functor_category.lean index 11f40f0aa9533..8e39949a504ef 100644 --- a/src/category_theory/monoidal/internal/functor_category.lean +++ b/src/category_theory/monoidal/internal/functor_category.lean @@ -9,6 +9,9 @@ import category_theory.monoidal.functor_category /-! # `Mon_ (C ⥤ D) ≌ C ⥤ Mon_ D` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `D` is a monoidal category, monoid objects in `C ⥤ D` are the same thing as functors from `C` into the monoid objects of `D`. diff --git a/src/category_theory/monoidal/internal/limits.lean b/src/category_theory/monoidal/internal/limits.lean index 45f02704db445..03df17a27c861 100644 --- a/src/category_theory/monoidal/internal/limits.lean +++ b/src/category_theory/monoidal/internal/limits.lean @@ -10,6 +10,9 @@ import category_theory.limits.preserves.basic /-! # Limits of monoid objects. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `C` has limits, so does `Mon_ C`, and the forgetful functor preserves these limits. (This could potentially replace many individual constructions for concrete categories, diff --git a/src/category_theory/monoidal/internal/types.lean b/src/category_theory/monoidal/internal/types.lean index 0830caa718827..39831cf76281a 100644 --- a/src/category_theory/monoidal/internal/types.lean +++ b/src/category_theory/monoidal/internal/types.lean @@ -5,11 +5,14 @@ Authors: Scott Morrison -/ import algebra.category.Mon.basic import category_theory.monoidal.CommMon_ -import category_theory.monoidal.types +import category_theory.monoidal.types.symmetric /-! # `Mon_ (Type u) ≌ Mon.{u}` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The category of internal monoid objects in `Type` is equivalent to the category of "native" bundled monoids. diff --git a/src/category_theory/monoidal/limits.lean b/src/category_theory/monoidal/limits.lean index b8d72308365e4..930b3912659ab 100644 --- a/src/category_theory/monoidal/limits.lean +++ b/src/category_theory/monoidal/limits.lean @@ -10,6 +10,9 @@ import category_theory.limits.has_limits /-! # `lim : (J ⥤ C) ⥤ C` is lax monoidal when `C` is a monoidal category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `C` is a monoidal category, the functorial association `F ↦ limit F` is lax monoidal, i.e. there are morphisms * `lim_lax.ε : (𝟙_ C) → limit (𝟙_ (J ⥤ C))` diff --git a/src/category_theory/monoidal/linear.lean b/src/category_theory/monoidal/linear.lean index 30269ad6723b5..639762539a871 100644 --- a/src/category_theory/monoidal/linear.lean +++ b/src/category_theory/monoidal/linear.lean @@ -9,6 +9,9 @@ import category_theory.monoidal.preadditive /-! # Linear monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A monoidal category is `monoidal_linear R` if it is monoidal preadditive and tensor product of morphisms is `R`-linear in both factors. -/ @@ -25,7 +28,7 @@ variables [monoidal_category C] [monoidal_preadditive C] /-- A category is `monoidal_linear R` if tensoring is `R`-linear in both factors. -/ -class monoidal_linear := +class monoidal_linear : Prop := (tensor_smul' : ∀ {W X Y Z : C} (f : W ⟶ X) (r : R) (g : Y ⟶ Z), f ⊗ (r • g) = r • (f ⊗ g) . obviously) (smul_tensor' : ∀ {W X Y Z : C} (r : R) (f : W ⟶ X) (g : Y ⟶ Z), @@ -35,11 +38,32 @@ restate_axiom monoidal_linear.tensor_smul' restate_axiom monoidal_linear.smul_tensor' attribute [simp] monoidal_linear.tensor_smul monoidal_linear.smul_tensor -variables [monoidal_linear R C] +variables {C} [monoidal_linear R C] instance tensor_left_linear (X : C) : (tensor_left X).linear R := {} instance tensor_right_linear (X : C) : (tensor_right X).linear R := {} instance tensoring_left_linear (X : C) : ((tensoring_left C).obj X).linear R := {} instance tensoring_right_linear (X : C) : ((tensoring_right C).obj X).linear R := {} +/-- A faithful linear monoidal functor to a linear monoidal category +ensures that the domain is linear monoidal. -/ +lemma monoidal_linear_of_faithful + {D : Type*} [category D] [preadditive D] [linear R D] + [monoidal_category D] [monoidal_preadditive D] + (F : monoidal_functor D C) [faithful F.to_functor] + [F.to_functor.additive] [F.to_functor.linear R] : + monoidal_linear R D := +{ tensor_smul' := begin + intros, + apply F.to_functor.map_injective, + simp only [F.to_functor.map_smul r (f ⊗ g), F.to_functor.map_smul r g, F.map_tensor, + monoidal_linear.tensor_smul, linear.smul_comp, linear.comp_smul], + end, + smul_tensor' := begin + intros, + apply F.to_functor.map_injective, + simp only [F.to_functor.map_smul r (f ⊗ g), F.to_functor.map_smul r f, F.map_tensor, + monoidal_linear.smul_tensor, linear.smul_comp, linear.comp_smul], + end, } + end category_theory diff --git a/src/category_theory/monoidal/natural_transformation.lean b/src/category_theory/monoidal/natural_transformation.lean index d4a4776b6313b..478f462028274 100644 --- a/src/category_theory/monoidal/natural_transformation.lean +++ b/src/category_theory/monoidal/natural_transformation.lean @@ -9,6 +9,9 @@ import category_theory.full_subcategory /-! # Monoidal natural transformations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Natural transformations between (lax) monoidal functors must satisfy an additional compatibility relation with the tensorators: `F.μ X Y ≫ app (X ⊗ Y) = (app X ⊗ app Y) ≫ G.μ X Y`. diff --git a/src/category_theory/monoidal/of_chosen_finite_products.lean b/src/category_theory/monoidal/of_chosen_finite_products.lean deleted file mode 100644 index 5c8057bd821a4..0000000000000 --- a/src/category_theory/monoidal/of_chosen_finite_products.lean +++ /dev/null @@ -1,399 +0,0 @@ -/- -Copyright (c) 2019 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Simon Hudon --/ -import category_theory.monoidal.braided -import category_theory.limits.shapes.binary_products -import category_theory.limits.shapes.terminal -import category_theory.pempty - -/-! -# The monoidal structure on a category with chosen finite products. - -This is a variant of the development in `category_theory.monoidal.of_has_finite_products`, -which uses specified choices of the terminal object and binary product, -enabling the construction of a cartesian category with specific definitions of the tensor unit -and tensor product. - -(Because the construction in `category_theory.monoidal.of_has_finite_products` uses `has_limit` -classes, the actual definitions there are opaque behind `classical.choice`.) - -We use this in `category_theory.monoidal.types` to construct the monoidal category of types -so that the tensor product is the usual cartesian product of types. - -For now we only do the construction from products, and not from coproducts, -which seems less often useful. --/ - -universes v u - -noncomputable theory - -namespace category_theory - -variables (C : Type u) [category.{v} C] {X Y : C} - -namespace limits - -section -variables {C} - -/-- Swap the two sides of a `binary_fan`. -/ -def binary_fan.swap {P Q : C} (t : binary_fan P Q) : binary_fan Q P := -binary_fan.mk t.snd t.fst - -@[simp] lemma binary_fan.swap_fst {P Q : C} (t : binary_fan P Q) : t.swap.fst = t.snd := rfl -@[simp] lemma binary_fan.swap_snd {P Q : C} (t : binary_fan P Q) : t.swap.snd = t.fst := rfl - -/-- -If a cone `t` over `P Q` is a limit cone, then `t.swap` is a limit cone over `Q P`. --/ -@[simps] -def is_limit.swap_binary_fan {P Q : C} {t : binary_fan P Q} (I : is_limit t) : is_limit t.swap := -{ lift := λ s, I.lift (binary_fan.swap s), - fac' := λ s, by { rintro ⟨⟩; simp, }, - uniq' := λ s m w, - begin - have h := I.uniq (binary_fan.swap s) m, - rw h, - intro j, - specialize w j.swap, - cases j; exact w, - end } - -/-- -Construct `has_binary_product Q P` from `has_binary_product P Q`. -This can't be an instance, as it would cause a loop in typeclass search. --/ -lemma has_binary_product.swap (P Q : C) [has_binary_product P Q] : has_binary_product Q P := -has_limit.mk ⟨binary_fan.swap (limit.cone (pair P Q)), (limit.is_limit (pair P Q)).swap_binary_fan⟩ - -/-- -Given a limit cone over `X` and `Y`, and another limit cone over `Y` and `X`, we can construct -an isomorphism between the cone points. Relative to some fixed choice of limits cones for every -pair, these isomorphisms constitute a braiding. --/ -def binary_fan.braiding {X Y : C} - {s : binary_fan X Y} (P : is_limit s) {t : binary_fan Y X} (Q : is_limit t) : - s.X ≅ t.X := -is_limit.cone_point_unique_up_to_iso P Q.swap_binary_fan - -/-- -Given binary fans `sXY` over `X Y`, and `sYZ` over `Y Z`, and `s` over `sXY.X Z`, -if `sYZ` is a limit cone we can construct a binary fan over `X sYZ.X`. - -This is an ingredient of building the associator for a cartesian category. --/ -def binary_fan.assoc {X Y Z : C} - {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan sXY.X Z) : - binary_fan X sYZ.X := -binary_fan.mk (s.fst ≫ sXY.fst) (Q.lift (binary_fan.mk (s.fst ≫ sXY.snd) s.snd)) - -@[simp] lemma binary_fan.assoc_fst {X Y Z : C} - {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan sXY.X Z) : - (s.assoc Q).fst = s.fst ≫ sXY.fst := rfl -@[simp] lemma binary_fan.assoc_snd {X Y Z : C} - {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan sXY.X Z) : - (s.assoc Q).snd = Q.lift (binary_fan.mk (s.fst ≫ sXY.snd) s.snd) := rfl - -/-- -Given binary fans `sXY` over `X Y`, and `sYZ` over `Y Z`, and `s` over `X sYZ.X`, -if `sYZ` is a limit cone we can construct a binary fan over `sXY.X Z`. - -This is an ingredient of building the associator for a cartesian category. --/ -def binary_fan.assoc_inv {X Y Z : C} - {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X sYZ.X) : - binary_fan sXY.X Z := -binary_fan.mk (P.lift (binary_fan.mk s.fst (s.snd ≫ sYZ.fst))) (s.snd ≫ sYZ.snd) - -@[simp] lemma binary_fan.assoc_inv_fst {X Y Z : C} - {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X sYZ.X) : - (s.assoc_inv P).fst = P.lift (binary_fan.mk s.fst (s.snd ≫ sYZ.fst)) := rfl -@[simp] lemma binary_fan.assoc_inv_snd {X Y Z : C} - {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X sYZ.X) : - (s.assoc_inv P).snd = s.snd ≫ sYZ.snd := rfl - -/-- -If all the binary fans involved a limit cones, `binary_fan.assoc` produces another limit cone. --/ -@[simps] -def is_limit.assoc {X Y Z : C} - {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (Q : is_limit sYZ) - {s : binary_fan sXY.X Z} (R : is_limit s) : is_limit (s.assoc Q) := -{ lift := λ t, R.lift (binary_fan.assoc_inv P t), - fac' := λ t, - begin - rintro ⟨⟩; simp, - apply Q.hom_ext, - rintro ⟨⟩; simp, - end, - uniq' := λ t m w, - begin - have h := R.uniq (binary_fan.assoc_inv P t) m, - rw h, - rintro ⟨⟩; simp, - apply P.hom_ext, - rintro ⟨⟩; simp, - { exact w walking_pair.left, }, - { specialize w walking_pair.right, - simp at w, - rw [←w], simp, }, - { specialize w walking_pair.right, - simp at w, - rw [←w], simp, }, - end, } - -/-- -Given two pairs of limit cones corresponding to the parenthesisations of `X × Y × Z`, -we obtain an isomorphism between the cone points. --/ -@[reducible] -def binary_fan.associator {X Y Z : C} - {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (Q : is_limit sYZ) - {s : binary_fan sXY.X Z} (R : is_limit s) {t : binary_fan X sYZ.X} (S : is_limit t) : - s.X ≅ t.X := -is_limit.cone_point_unique_up_to_iso (is_limit.assoc P Q R) S - -/-- -Given a fixed family of limit data for every pair `X Y`, we obtain an associator. --/ -@[reducible] -def binary_fan.associator_of_limit_cone - (L : Π X Y : C, limit_cone (pair X Y)) (X Y Z : C) : - (L (L X Y).cone.X Z).cone.X ≅ (L X (L Y Z).cone.X).cone.X := -binary_fan.associator - (L X Y).is_limit (L Y Z).is_limit - (L (L X Y).cone.X Z).is_limit (L X (L Y Z).cone.X).is_limit - -/-- -Construct a left unitor from specified limit cones. --/ -@[simps] -def binary_fan.left_unitor {X : C} {s : cone (functor.empty.{v} C)} (P : is_limit s) - {t : binary_fan s.X X} (Q : is_limit t) : t.X ≅ X := -{ hom := t.snd, - inv := Q.lift (binary_fan.mk (P.lift { X := X, π := { app := pempty.rec _ } }) (𝟙 X) ), - hom_inv_id' := by { apply Q.hom_ext, rintro ⟨⟩, { apply P.hom_ext, rintro ⟨⟩, }, { simp, }, }, } - -/-- -Construct a right unitor from specified limit cones. --/ -@[simps] -def binary_fan.right_unitor {X : C} {s : cone (functor.empty.{v} C)} (P : is_limit s) - {t : binary_fan X s.X} (Q : is_limit t) : t.X ≅ X := -{ hom := t.fst, - inv := Q.lift (binary_fan.mk (𝟙 X) (P.lift { X := X, π := { app := pempty.rec _ } })), - hom_inv_id' := by { apply Q.hom_ext, rintro ⟨⟩, { simp, }, { apply P.hom_ext, rintro ⟨⟩, }, }, } - -end - -end limits - -open category_theory.limits - -section -local attribute [tidy] tactic.case_bash - -variables {C} -variables (𝒯 : limit_cone (functor.empty.{v} C)) -variables (ℬ : Π (X Y : C), limit_cone (pair X Y)) - -namespace monoidal_of_chosen_finite_products - -/-- Implementation of the tensor product for `monoidal_of_chosen_finite_products`. -/ -@[reducible] -def tensor_obj (X Y : C) : C := (ℬ X Y).cone.X - -/-- Implementation of the tensor product of morphisms for `monoidal_of_chosen_finite_products`. -/ -@[reducible] -def tensor_hom {W X Y Z : C} (f : W ⟶ X) (g : Y ⟶ Z) : tensor_obj ℬ W Y ⟶ tensor_obj ℬ X Z := - (binary_fan.is_limit.lift' (ℬ X Z).is_limit - ((ℬ W Y).cone.π.app walking_pair.left ≫ f) - (((ℬ W Y).cone.π.app walking_pair.right : (ℬ W Y).cone.X ⟶ Y) ≫ g)).val - -lemma tensor_id (X₁ X₂ : C) : tensor_hom ℬ (𝟙 X₁) (𝟙 X₂) = 𝟙 (tensor_obj ℬ X₁ X₂) := -begin - apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩; - { dsimp [tensor_hom], simp, }, -end - -lemma tensor_comp {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} - (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) : - tensor_hom ℬ (f₁ ≫ g₁) (f₂ ≫ g₂) = - tensor_hom ℬ f₁ f₂ ≫ tensor_hom ℬ g₁ g₂ := -begin - apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩; - { dsimp [tensor_hom], simp, }, -end - -lemma pentagon (W X Y Z : C) : - tensor_hom ℬ (binary_fan.associator_of_limit_cone ℬ W X Y).hom (𝟙 Z) ≫ - (binary_fan.associator_of_limit_cone ℬ W (tensor_obj ℬ X Y) Z).hom ≫ - tensor_hom ℬ (𝟙 W) (binary_fan.associator_of_limit_cone ℬ X Y Z).hom = - (binary_fan.associator_of_limit_cone ℬ (tensor_obj ℬ W X) Y Z).hom ≫ - (binary_fan.associator_of_limit_cone ℬ W X (tensor_obj ℬ Y Z)).hom := -begin - dsimp [tensor_hom], - apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩, - { simp, }, - { apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩, - { simp, }, - apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩, - { simp, }, - { simp, }, } -end - -lemma triangle (X Y : C) : - (binary_fan.associator_of_limit_cone ℬ X 𝒯.cone.X Y).hom ≫ - tensor_hom ℬ (𝟙 X) (binary_fan.left_unitor 𝒯.is_limit (ℬ 𝒯.cone.X Y).is_limit).hom = - tensor_hom ℬ (binary_fan.right_unitor 𝒯.is_limit (ℬ X 𝒯.cone.X).is_limit).hom (𝟙 Y) := -begin - dsimp [tensor_hom], - apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩; simp, -end - -lemma left_unitor_naturality {X₁ X₂ : C} (f : X₁ ⟶ X₂) : - tensor_hom ℬ (𝟙 𝒯.cone.X) f ≫ (binary_fan.left_unitor 𝒯.is_limit (ℬ 𝒯.cone.X X₂).is_limit).hom = - (binary_fan.left_unitor 𝒯.is_limit (ℬ 𝒯.cone.X X₁).is_limit).hom ≫ f := -begin - dsimp [tensor_hom], - simp, -end - -lemma right_unitor_naturality {X₁ X₂ : C} (f : X₁ ⟶ X₂) : - tensor_hom ℬ f (𝟙 𝒯.cone.X) ≫ - (binary_fan.right_unitor 𝒯.is_limit (ℬ X₂ 𝒯.cone.X).is_limit).hom = - (binary_fan.right_unitor 𝒯.is_limit (ℬ X₁ 𝒯.cone.X).is_limit).hom ≫ f := -begin - dsimp [tensor_hom], - simp, -end - -lemma associator_naturality {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) : - tensor_hom ℬ (tensor_hom ℬ f₁ f₂) f₃ ≫ (binary_fan.associator_of_limit_cone ℬ Y₁ Y₂ Y₃).hom = - (binary_fan.associator_of_limit_cone ℬ X₁ X₂ X₃).hom ≫ - tensor_hom ℬ f₁ (tensor_hom ℬ f₂ f₃) := -begin - dsimp [tensor_hom], - apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩, - { simp, }, - { apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟩, - { simp, }, - { simp, }, }, -end - -end monoidal_of_chosen_finite_products - -open monoidal_of_chosen_finite_products - -/-- A category with a terminal object and binary products has a natural monoidal structure. -/ -def monoidal_of_chosen_finite_products : - monoidal_category C := -{ tensor_unit := 𝒯.cone.X, - tensor_obj := λ X Y, tensor_obj ℬ X Y, - tensor_hom := λ _ _ _ _ f g, tensor_hom ℬ f g, - tensor_id' := tensor_id ℬ, - tensor_comp' := λ _ _ _ _ _ _ f₁ f₂ g₁ g₂, tensor_comp ℬ f₁ f₂ g₁ g₂, - associator := λ X Y Z, binary_fan.associator_of_limit_cone ℬ X Y Z, - left_unitor := λ X, binary_fan.left_unitor (𝒯.is_limit) (ℬ 𝒯.cone.X X).is_limit, - right_unitor := λ X, binary_fan.right_unitor (𝒯.is_limit) (ℬ X 𝒯.cone.X).is_limit, - pentagon' := pentagon ℬ, - triangle' := triangle 𝒯 ℬ, - left_unitor_naturality' := λ _ _ f, left_unitor_naturality 𝒯 ℬ f, - right_unitor_naturality' := λ _ _ f, right_unitor_naturality 𝒯 ℬ f, - associator_naturality' := λ _ _ _ _ _ _ f₁ f₂ f₃, associator_naturality ℬ f₁ f₂ f₃, } - -namespace monoidal_of_chosen_finite_products - -open monoidal_category - -/-- -A type synonym for `C` carrying a monoidal category structure corresponding to -a fixed choice of limit data for the empty functor, and for `pair X Y` for every `X Y : C`. - -This is an implementation detail for `symmetric_of_chosen_finite_products`. --/ -@[derive category, nolint unused_arguments has_inhabited_instance] -def monoidal_of_chosen_finite_products_synonym - (𝒯 : limit_cone (functor.empty.{v} C)) (ℬ : Π (X Y : C), limit_cone (pair X Y)):= C - -instance : monoidal_category (monoidal_of_chosen_finite_products_synonym 𝒯 ℬ) := -monoidal_of_chosen_finite_products 𝒯 ℬ - -lemma braiding_naturality {X X' Y Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') : - (tensor_hom ℬ f g) ≫ (limits.binary_fan.braiding (ℬ Y Y').is_limit (ℬ Y' Y).is_limit).hom = - (limits.binary_fan.braiding (ℬ X X').is_limit (ℬ X' X).is_limit).hom ≫ (tensor_hom ℬ g f) := -begin - dsimp [tensor_hom, limits.binary_fan.braiding], - apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟩; - { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, -end - -lemma hexagon_forward (X Y Z : C) : - (binary_fan.associator_of_limit_cone ℬ X Y Z).hom ≫ - (limits.binary_fan.braiding - (ℬ X (tensor_obj ℬ Y Z)).is_limit - (ℬ (tensor_obj ℬ Y Z) X).is_limit).hom ≫ - (binary_fan.associator_of_limit_cone ℬ Y Z X).hom = - (tensor_hom ℬ (limits.binary_fan.braiding (ℬ X Y).is_limit (ℬ Y X).is_limit).hom (𝟙 Z)) ≫ - (binary_fan.associator_of_limit_cone ℬ Y X Z).hom ≫ - (tensor_hom ℬ (𝟙 Y) (limits.binary_fan.braiding (ℬ X Z).is_limit (ℬ Z X).is_limit).hom) := -begin - dsimp [tensor_hom, limits.binary_fan.braiding], - apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟩, - { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, - { apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟩; - { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, } -end - -lemma hexagon_reverse (X Y Z : C) : - (binary_fan.associator_of_limit_cone ℬ X Y Z).inv ≫ - (limits.binary_fan.braiding - (ℬ (tensor_obj ℬ X Y) Z).is_limit - (ℬ Z (tensor_obj ℬ X Y)).is_limit).hom ≫ - (binary_fan.associator_of_limit_cone ℬ Z X Y).inv = - (tensor_hom ℬ (𝟙 X) (limits.binary_fan.braiding (ℬ Y Z).is_limit (ℬ Z Y).is_limit).hom) ≫ - (binary_fan.associator_of_limit_cone ℬ X Z Y).inv ≫ - (tensor_hom ℬ (limits.binary_fan.braiding (ℬ X Z).is_limit (ℬ Z X).is_limit).hom (𝟙 Y)) := -begin - dsimp [tensor_hom, limits.binary_fan.braiding], - apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟩, - { apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟩; - { dsimp [binary_fan.associator_of_limit_cone, binary_fan.associator, - limits.is_limit.cone_point_unique_up_to_iso], - simp, }, }, - { dsimp [binary_fan.associator_of_limit_cone, binary_fan.associator, - limits.is_limit.cone_point_unique_up_to_iso], - simp, }, -end - -lemma symmetry (X Y : C) : - (limits.binary_fan.braiding (ℬ X Y).is_limit (ℬ Y X).is_limit).hom ≫ - (limits.binary_fan.braiding (ℬ Y X).is_limit (ℬ X Y).is_limit).hom = - 𝟙 (tensor_obj ℬ X Y) := -begin - dsimp [tensor_hom, limits.binary_fan.braiding], - apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟩; - { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, -end - -end monoidal_of_chosen_finite_products - -open monoidal_of_chosen_finite_products - -/-- -The monoidal structure coming from finite products is symmetric. --/ -def symmetric_of_chosen_finite_products : - symmetric_category (monoidal_of_chosen_finite_products_synonym 𝒯 ℬ) := -{ braiding := λ X Y, limits.binary_fan.braiding (ℬ _ _).is_limit (ℬ _ _).is_limit, - braiding_naturality' := λ X X' Y Y' f g, braiding_naturality ℬ f g, - hexagon_forward' := λ X Y Z, hexagon_forward ℬ X Y Z, - hexagon_reverse' := λ X Y Z, hexagon_reverse ℬ X Y Z, - symmetry' := λ X Y, symmetry ℬ X Y, } - -end - -end category_theory diff --git a/src/category_theory/monoidal/of_chosen_finite_products/basic.lean b/src/category_theory/monoidal/of_chosen_finite_products/basic.lean new file mode 100644 index 0000000000000..fb1123060e82a --- /dev/null +++ b/src/category_theory/monoidal/of_chosen_finite_products/basic.lean @@ -0,0 +1,337 @@ +/- +Copyright (c) 2019 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Simon Hudon +-/ +import category_theory.monoidal.category +import category_theory.limits.shapes.binary_products +import category_theory.pempty + +/-! +# The monoidal structure on a category with chosen finite products. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This is a variant of the development in `category_theory.monoidal.of_has_finite_products`, +which uses specified choices of the terminal object and binary product, +enabling the construction of a cartesian category with specific definitions of the tensor unit +and tensor product. + +(Because the construction in `category_theory.monoidal.of_has_finite_products` uses `has_limit` +classes, the actual definitions there are opaque behind `classical.choice`.) + +We use this in `category_theory.monoidal.types` to construct the monoidal category of types +so that the tensor product is the usual cartesian product of types. + +For now we only do the construction from products, and not from coproducts, +which seems less often useful. +-/ + +universes v u + +noncomputable theory + +namespace category_theory + +variables (C : Type u) [category.{v} C] {X Y : C} + +namespace limits + +section +variables {C} + +/-- Swap the two sides of a `binary_fan`. -/ +def binary_fan.swap {P Q : C} (t : binary_fan P Q) : binary_fan Q P := +binary_fan.mk t.snd t.fst + +@[simp] lemma binary_fan.swap_fst {P Q : C} (t : binary_fan P Q) : t.swap.fst = t.snd := rfl +@[simp] lemma binary_fan.swap_snd {P Q : C} (t : binary_fan P Q) : t.swap.snd = t.fst := rfl + +/-- +If a cone `t` over `P Q` is a limit cone, then `t.swap` is a limit cone over `Q P`. +-/ +@[simps] +def is_limit.swap_binary_fan {P Q : C} {t : binary_fan P Q} (I : is_limit t) : is_limit t.swap := +{ lift := λ s, I.lift (binary_fan.swap s), + fac' := λ s, by { rintro ⟨⟨⟩⟩; simp, }, + uniq' := λ s m w, + begin + have h := I.uniq (binary_fan.swap s) m, + rw h, + rintro ⟨j⟩, + specialize w ⟨j.swap⟩, + cases j; exact w, + end } + +/-- +Construct `has_binary_product Q P` from `has_binary_product P Q`. +This can't be an instance, as it would cause a loop in typeclass search. +-/ +lemma has_binary_product.swap (P Q : C) [has_binary_product P Q] : has_binary_product Q P := +has_limit.mk ⟨binary_fan.swap (limit.cone (pair P Q)), (limit.is_limit (pair P Q)).swap_binary_fan⟩ + +/-- +Given a limit cone over `X` and `Y`, and another limit cone over `Y` and `X`, we can construct +an isomorphism between the cone points. Relative to some fixed choice of limits cones for every +pair, these isomorphisms constitute a braiding. +-/ +def binary_fan.braiding {X Y : C} + {s : binary_fan X Y} (P : is_limit s) {t : binary_fan Y X} (Q : is_limit t) : + s.X ≅ t.X := +is_limit.cone_point_unique_up_to_iso P Q.swap_binary_fan + +/-- +Given binary fans `sXY` over `X Y`, and `sYZ` over `Y Z`, and `s` over `sXY.X Z`, +if `sYZ` is a limit cone we can construct a binary fan over `X sYZ.X`. + +This is an ingredient of building the associator for a cartesian category. +-/ +def binary_fan.assoc {X Y Z : C} + {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan sXY.X Z) : + binary_fan X sYZ.X := +binary_fan.mk (s.fst ≫ sXY.fst) (Q.lift (binary_fan.mk (s.fst ≫ sXY.snd) s.snd)) + +@[simp] lemma binary_fan.assoc_fst {X Y Z : C} + {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan sXY.X Z) : + (s.assoc Q).fst = s.fst ≫ sXY.fst := rfl +@[simp] lemma binary_fan.assoc_snd {X Y Z : C} + {sXY : binary_fan X Y} {sYZ : binary_fan Y Z} (Q : is_limit sYZ) (s : binary_fan sXY.X Z) : + (s.assoc Q).snd = Q.lift (binary_fan.mk (s.fst ≫ sXY.snd) s.snd) := rfl + +/-- +Given binary fans `sXY` over `X Y`, and `sYZ` over `Y Z`, and `s` over `X sYZ.X`, +if `sYZ` is a limit cone we can construct a binary fan over `sXY.X Z`. + +This is an ingredient of building the associator for a cartesian category. +-/ +def binary_fan.assoc_inv {X Y Z : C} + {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X sYZ.X) : + binary_fan sXY.X Z := +binary_fan.mk (P.lift (binary_fan.mk s.fst (s.snd ≫ sYZ.fst))) (s.snd ≫ sYZ.snd) + +@[simp] lemma binary_fan.assoc_inv_fst {X Y Z : C} + {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X sYZ.X) : + (s.assoc_inv P).fst = P.lift (binary_fan.mk s.fst (s.snd ≫ sYZ.fst)) := rfl +@[simp] lemma binary_fan.assoc_inv_snd {X Y Z : C} + {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (s : binary_fan X sYZ.X) : + (s.assoc_inv P).snd = s.snd ≫ sYZ.snd := rfl + +/-- +If all the binary fans involved a limit cones, `binary_fan.assoc` produces another limit cone. +-/ +@[simps] +def is_limit.assoc {X Y Z : C} + {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (Q : is_limit sYZ) + {s : binary_fan sXY.X Z} (R : is_limit s) : is_limit (s.assoc Q) := +{ lift := λ t, R.lift (binary_fan.assoc_inv P t), + fac' := λ t, + begin + rintro ⟨⟨⟩⟩; simp, + apply Q.hom_ext, + rintro ⟨⟨⟩⟩; simp, + end, + uniq' := λ t m w, + begin + have h := R.uniq (binary_fan.assoc_inv P t) m, + rw h, + rintro ⟨⟨⟩⟩; simp, + apply P.hom_ext, + rintro ⟨⟨⟩⟩; simp, + { exact w ⟨walking_pair.left⟩, }, + { specialize w ⟨walking_pair.right⟩, + simp at w, + rw [←w], simp, }, + { specialize w ⟨walking_pair.right⟩, + simp at w, + rw [←w], simp, }, + end, } + +/-- +Given two pairs of limit cones corresponding to the parenthesisations of `X × Y × Z`, +we obtain an isomorphism between the cone points. +-/ +@[reducible] +def binary_fan.associator {X Y Z : C} + {sXY : binary_fan X Y} (P : is_limit sXY) {sYZ : binary_fan Y Z} (Q : is_limit sYZ) + {s : binary_fan sXY.X Z} (R : is_limit s) {t : binary_fan X sYZ.X} (S : is_limit t) : + s.X ≅ t.X := +is_limit.cone_point_unique_up_to_iso (is_limit.assoc P Q R) S + +/-- +Given a fixed family of limit data for every pair `X Y`, we obtain an associator. +-/ +@[reducible] +def binary_fan.associator_of_limit_cone + (L : Π X Y : C, limit_cone (pair X Y)) (X Y Z : C) : + (L (L X Y).cone.X Z).cone.X ≅ (L X (L Y Z).cone.X).cone.X := +binary_fan.associator + (L X Y).is_limit (L Y Z).is_limit + (L (L X Y).cone.X Z).is_limit (L X (L Y Z).cone.X).is_limit + +local attribute [tidy] tactic.discrete_cases + +/-- +Construct a left unitor from specified limit cones. +-/ +@[simps] +def binary_fan.left_unitor {X : C} {s : cone (functor.empty.{v} C)} (P : is_limit s) + {t : binary_fan s.X X} (Q : is_limit t) : t.X ≅ X := +{ hom := t.snd, + inv := Q.lift (binary_fan.mk (P.lift + { X := X, π := { app := discrete.rec (pempty.rec _) } }) (𝟙 X) ), + hom_inv_id' := + by { apply Q.hom_ext, rintro ⟨⟨⟩⟩, { apply P.hom_ext, rintro ⟨⟨⟩⟩, }, { simp, }, }, } + +/-- +Construct a right unitor from specified limit cones. +-/ +@[simps] +def binary_fan.right_unitor {X : C} {s : cone (functor.empty.{v} C)} (P : is_limit s) + {t : binary_fan X s.X} (Q : is_limit t) : t.X ≅ X := +{ hom := t.fst, + inv := Q.lift (binary_fan.mk (𝟙 X) (P.lift + { X := X, π := { app := discrete.rec (pempty.rec _) } })), + hom_inv_id' := + by { apply Q.hom_ext, rintro ⟨⟨⟩⟩, { simp, }, { apply P.hom_ext, rintro ⟨⟨⟩⟩, }, }, } + +end + +end limits + +open category_theory.limits + +section +local attribute [tidy] tactic.case_bash + +variables {C} +variables (𝒯 : limit_cone (functor.empty.{v} C)) +variables (ℬ : Π (X Y : C), limit_cone (pair X Y)) + +namespace monoidal_of_chosen_finite_products + +/-- Implementation of the tensor product for `monoidal_of_chosen_finite_products`. -/ +@[reducible] +def tensor_obj (X Y : C) : C := (ℬ X Y).cone.X + +/-- Implementation of the tensor product of morphisms for `monoidal_of_chosen_finite_products`. -/ +@[reducible] +def tensor_hom {W X Y Z : C} (f : W ⟶ X) (g : Y ⟶ Z) : tensor_obj ℬ W Y ⟶ tensor_obj ℬ X Z := + (binary_fan.is_limit.lift' (ℬ X Z).is_limit + ((ℬ W Y).cone.π.app ⟨walking_pair.left⟩ ≫ f) + (((ℬ W Y).cone.π.app ⟨walking_pair.right⟩ : (ℬ W Y).cone.X ⟶ Y) ≫ g)).val + +lemma tensor_id (X₁ X₂ : C) : tensor_hom ℬ (𝟙 X₁) (𝟙 X₂) = 𝟙 (tensor_obj ℬ X₁ X₂) := +begin + apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩; + { dsimp [tensor_hom], simp, }, +end + +lemma tensor_comp {X₁ Y₁ Z₁ X₂ Y₂ Z₂ : C} + (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (g₁ : Y₁ ⟶ Z₁) (g₂ : Y₂ ⟶ Z₂) : + tensor_hom ℬ (f₁ ≫ g₁) (f₂ ≫ g₂) = + tensor_hom ℬ f₁ f₂ ≫ tensor_hom ℬ g₁ g₂ := +begin + apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩; + { dsimp [tensor_hom], simp, }, +end + +lemma pentagon (W X Y Z : C) : + tensor_hom ℬ (binary_fan.associator_of_limit_cone ℬ W X Y).hom (𝟙 Z) ≫ + (binary_fan.associator_of_limit_cone ℬ W (tensor_obj ℬ X Y) Z).hom ≫ + tensor_hom ℬ (𝟙 W) (binary_fan.associator_of_limit_cone ℬ X Y Z).hom = + (binary_fan.associator_of_limit_cone ℬ (tensor_obj ℬ W X) Y Z).hom ≫ + (binary_fan.associator_of_limit_cone ℬ W X (tensor_obj ℬ Y Z)).hom := +begin + dsimp [tensor_hom], + apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩, + { simp, }, + { apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩, + { simp, }, + apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩, + { simp, }, + { simp, }, } +end + +lemma triangle (X Y : C) : + (binary_fan.associator_of_limit_cone ℬ X 𝒯.cone.X Y).hom ≫ + tensor_hom ℬ (𝟙 X) (binary_fan.left_unitor 𝒯.is_limit (ℬ 𝒯.cone.X Y).is_limit).hom = + tensor_hom ℬ (binary_fan.right_unitor 𝒯.is_limit (ℬ X 𝒯.cone.X).is_limit).hom (𝟙 Y) := +begin + dsimp [tensor_hom], + apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩; simp, +end + +lemma left_unitor_naturality {X₁ X₂ : C} (f : X₁ ⟶ X₂) : + tensor_hom ℬ (𝟙 𝒯.cone.X) f ≫ (binary_fan.left_unitor 𝒯.is_limit (ℬ 𝒯.cone.X X₂).is_limit).hom = + (binary_fan.left_unitor 𝒯.is_limit (ℬ 𝒯.cone.X X₁).is_limit).hom ≫ f := +begin + dsimp [tensor_hom], + simp, +end + +lemma right_unitor_naturality {X₁ X₂ : C} (f : X₁ ⟶ X₂) : + tensor_hom ℬ f (𝟙 𝒯.cone.X) ≫ + (binary_fan.right_unitor 𝒯.is_limit (ℬ X₂ 𝒯.cone.X).is_limit).hom = + (binary_fan.right_unitor 𝒯.is_limit (ℬ X₁ 𝒯.cone.X).is_limit).hom ≫ f := +begin + dsimp [tensor_hom], + simp, +end + +lemma associator_naturality {X₁ X₂ X₃ Y₁ Y₂ Y₃ : C} (f₁ : X₁ ⟶ Y₁) (f₂ : X₂ ⟶ Y₂) (f₃ : X₃ ⟶ Y₃) : + tensor_hom ℬ (tensor_hom ℬ f₁ f₂) f₃ ≫ (binary_fan.associator_of_limit_cone ℬ Y₁ Y₂ Y₃).hom = + (binary_fan.associator_of_limit_cone ℬ X₁ X₂ X₃).hom ≫ + tensor_hom ℬ f₁ (tensor_hom ℬ f₂ f₃) := +begin + dsimp [tensor_hom], + apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩, + { simp, }, + { apply is_limit.hom_ext (ℬ _ _).is_limit, rintro ⟨⟨⟩⟩, + { simp, }, + { simp, }, }, +end + +end monoidal_of_chosen_finite_products + +open monoidal_of_chosen_finite_products + +/-- A category with a terminal object and binary products has a natural monoidal structure. -/ +def monoidal_of_chosen_finite_products : + monoidal_category C := +{ tensor_unit := 𝒯.cone.X, + tensor_obj := λ X Y, tensor_obj ℬ X Y, + tensor_hom := λ _ _ _ _ f g, tensor_hom ℬ f g, + tensor_id' := tensor_id ℬ, + tensor_comp' := λ _ _ _ _ _ _ f₁ f₂ g₁ g₂, tensor_comp ℬ f₁ f₂ g₁ g₂, + associator := λ X Y Z, binary_fan.associator_of_limit_cone ℬ X Y Z, + left_unitor := λ X, binary_fan.left_unitor (𝒯.is_limit) (ℬ 𝒯.cone.X X).is_limit, + right_unitor := λ X, binary_fan.right_unitor (𝒯.is_limit) (ℬ X 𝒯.cone.X).is_limit, + pentagon' := pentagon ℬ, + triangle' := triangle 𝒯 ℬ, + left_unitor_naturality' := λ _ _ f, left_unitor_naturality 𝒯 ℬ f, + right_unitor_naturality' := λ _ _ f, right_unitor_naturality 𝒯 ℬ f, + associator_naturality' := λ _ _ _ _ _ _ f₁ f₂ f₃, associator_naturality ℬ f₁ f₂ f₃, } + +namespace monoidal_of_chosen_finite_products + +open monoidal_category + +/-- +A type synonym for `C` carrying a monoidal category structure corresponding to +a fixed choice of limit data for the empty functor, and for `pair X Y` for every `X Y : C`. + +This is an implementation detail for `symmetric_of_chosen_finite_products`. +-/ +@[derive category, nolint unused_arguments has_nonempty_instance] +def monoidal_of_chosen_finite_products_synonym + (𝒯 : limit_cone (functor.empty.{v} C)) (ℬ : Π (X Y : C), limit_cone (pair X Y)):= C + +instance : monoidal_category (monoidal_of_chosen_finite_products_synonym 𝒯 ℬ) := +monoidal_of_chosen_finite_products 𝒯 ℬ + +end monoidal_of_chosen_finite_products + +end + +end category_theory diff --git a/src/category_theory/monoidal/of_chosen_finite_products/symmetric.lean b/src/category_theory/monoidal/of_chosen_finite_products/symmetric.lean new file mode 100644 index 0000000000000..a7e27822045b5 --- /dev/null +++ b/src/category_theory/monoidal/of_chosen_finite_products/symmetric.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2019 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Simon Hudon +-/ +import category_theory.monoidal.braided +import category_theory.monoidal.of_chosen_finite_products.basic + +/-! +# The symmetric monoidal structure on a category with chosen finite products. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +universes v u + +noncomputable theory + +namespace category_theory + +variables (C : Type u) [category.{v} C] {X Y : C} + +open category_theory.limits + +section +local attribute [tidy] tactic.case_bash + +variables {C} +variables (𝒯 : limit_cone (functor.empty.{v} C)) +variables (ℬ : Π (X Y : C), limit_cone (pair X Y)) + +open monoidal_of_chosen_finite_products + +namespace monoidal_of_chosen_finite_products + +open monoidal_category + +lemma braiding_naturality {X X' Y Y' : C} (f : X ⟶ Y) (g : X' ⟶ Y') : + (tensor_hom ℬ f g) ≫ (limits.binary_fan.braiding (ℬ Y Y').is_limit (ℬ Y' Y).is_limit).hom = + (limits.binary_fan.braiding (ℬ X X').is_limit (ℬ X' X).is_limit).hom ≫ (tensor_hom ℬ g f) := +begin + dsimp [tensor_hom, limits.binary_fan.braiding], + apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟨⟩⟩; + { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, +end + +lemma hexagon_forward (X Y Z : C) : + (binary_fan.associator_of_limit_cone ℬ X Y Z).hom ≫ + (limits.binary_fan.braiding + (ℬ X (tensor_obj ℬ Y Z)).is_limit + (ℬ (tensor_obj ℬ Y Z) X).is_limit).hom ≫ + (binary_fan.associator_of_limit_cone ℬ Y Z X).hom = + (tensor_hom ℬ (limits.binary_fan.braiding (ℬ X Y).is_limit (ℬ Y X).is_limit).hom (𝟙 Z)) ≫ + (binary_fan.associator_of_limit_cone ℬ Y X Z).hom ≫ + (tensor_hom ℬ (𝟙 Y) (limits.binary_fan.braiding (ℬ X Z).is_limit (ℬ Z X).is_limit).hom) := +begin + dsimp [tensor_hom, limits.binary_fan.braiding], + apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟨⟩⟩, + { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, + { apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟨⟩⟩; + { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, } +end + +lemma hexagon_reverse (X Y Z : C) : + (binary_fan.associator_of_limit_cone ℬ X Y Z).inv ≫ + (limits.binary_fan.braiding + (ℬ (tensor_obj ℬ X Y) Z).is_limit + (ℬ Z (tensor_obj ℬ X Y)).is_limit).hom ≫ + (binary_fan.associator_of_limit_cone ℬ Z X Y).inv = + (tensor_hom ℬ (𝟙 X) (limits.binary_fan.braiding (ℬ Y Z).is_limit (ℬ Z Y).is_limit).hom) ≫ + (binary_fan.associator_of_limit_cone ℬ X Z Y).inv ≫ + (tensor_hom ℬ (limits.binary_fan.braiding (ℬ X Z).is_limit (ℬ Z X).is_limit).hom (𝟙 Y)) := +begin + dsimp [tensor_hom, limits.binary_fan.braiding], + apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟨⟩⟩, + { apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟨⟩⟩; + { dsimp [binary_fan.associator_of_limit_cone, binary_fan.associator, + limits.is_limit.cone_point_unique_up_to_iso], + simp, }, }, + { dsimp [binary_fan.associator_of_limit_cone, binary_fan.associator, + limits.is_limit.cone_point_unique_up_to_iso], + simp, }, +end + +lemma symmetry (X Y : C) : + (limits.binary_fan.braiding (ℬ X Y).is_limit (ℬ Y X).is_limit).hom ≫ + (limits.binary_fan.braiding (ℬ Y X).is_limit (ℬ X Y).is_limit).hom = + 𝟙 (tensor_obj ℬ X Y) := +begin + dsimp [tensor_hom, limits.binary_fan.braiding], + apply (ℬ _ _).is_limit.hom_ext, rintro ⟨⟨⟩⟩; + { dsimp [limits.is_limit.cone_point_unique_up_to_iso], simp, }, +end + +end monoidal_of_chosen_finite_products + +open monoidal_of_chosen_finite_products + +/-- +The monoidal structure coming from finite products is symmetric. +-/ +def symmetric_of_chosen_finite_products : + symmetric_category (monoidal_of_chosen_finite_products_synonym 𝒯 ℬ) := +{ braiding := λ X Y, limits.binary_fan.braiding (ℬ _ _).is_limit (ℬ _ _).is_limit, + braiding_naturality' := λ X X' Y Y' f g, braiding_naturality ℬ f g, + hexagon_forward' := λ X Y Z, hexagon_forward ℬ X Y Z, + hexagon_reverse' := λ X Y Z, hexagon_reverse ℬ X Y Z, + symmetry' := λ X Y, symmetry ℬ X Y, } + +end + +end category_theory diff --git a/src/category_theory/monoidal/of_has_finite_products.lean b/src/category_theory/monoidal/of_has_finite_products.lean index 7ec14943a15dd..593daf66b24e1 100644 --- a/src/category_theory/monoidal/of_has_finite_products.lean +++ b/src/category_theory/monoidal/of_has_finite_products.lean @@ -10,6 +10,9 @@ import category_theory.limits.shapes.terminal /-! # The natural monoidal structure on any category with finite (co)products. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category with a monoidal structure provided in this way is sometimes called a (co)cartesian category, although this is also sometimes used to mean a finitely complete category. diff --git a/src/category_theory/monoidal/opposite.lean b/src/category_theory/monoidal/opposite.lean index 28f98b1404a0d..ff8730fff478e 100644 --- a/src/category_theory/monoidal/opposite.lean +++ b/src/category_theory/monoidal/opposite.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.coherence /-! # Monoidal opposites +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We write `Cᵐᵒᵖ` for the monoidal opposite of a monoidal category `C`. -/ @@ -21,7 +24,7 @@ namespace category_theory open category_theory.monoidal_category /-- A type synonym for the monoidal opposite. Use the notation `Cᴹᵒᵖ`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def monoidal_opposite (C : Type u₁) := C namespace monoidal_opposite diff --git a/src/category_theory/monoidal/preadditive.lean b/src/category_theory/monoidal/preadditive.lean index 9e9e69a16954d..8f8ab46005f02 100644 --- a/src/category_theory/monoidal/preadditive.lean +++ b/src/category_theory/monoidal/preadditive.lean @@ -4,16 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ import category_theory.preadditive.additive_functor -import category_theory.monoidal.category +import category_theory.monoidal.functor /-! # Preadditive monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A monoidal category is `monoidal_preadditive` if it is preadditive and tensor product of morphisms is linear in both factors. -/ noncomputable theory +open_locale classical namespace category_theory @@ -28,7 +32,7 @@ A category is `monoidal_preadditive` if tensoring is additive in both factors. Note we don't `extend preadditive C` here, as `abelian C` already extends it, and we'll need to have both typeclasses sometimes. -/ -class monoidal_preadditive := +class monoidal_preadditive : Prop := (tensor_zero' : ∀ {W X Y Z : C} (f : W ⟶ X), f ⊗ (0 : Y ⟶ Z) = 0 . obviously) (zero_tensor' : ∀ {W X Y Z : C} (f : Y ⟶ Z), (0 : W ⟶ X) ⊗ f = 0 . obviously) (tensor_add' : ∀ {W X Y Z : C} (f : W ⟶ X) (g h : Y ⟶ Z), f ⊗ (g + h) = f ⊗ g + f ⊗ h . obviously) @@ -40,7 +44,7 @@ restate_axiom monoidal_preadditive.tensor_add' restate_axiom monoidal_preadditive.add_tensor' attribute [simp] monoidal_preadditive.tensor_zero monoidal_preadditive.zero_tensor -variables [monoidal_preadditive C] +variables {C} [monoidal_preadditive C] local attribute [simp] monoidal_preadditive.tensor_add monoidal_preadditive.add_tensor @@ -49,6 +53,26 @@ instance tensor_right_additive (X : C) : (tensor_right X).additive := {} instance tensoring_left_additive (X : C) : ((tensoring_left C).obj X).additive := {} instance tensoring_right_additive (X : C) : ((tensoring_right C).obj X).additive := {} +/-- A faithful additive monoidal functor to a monoidal preadditive category +ensures that the domain is monoidal preadditive. -/ +lemma monoidal_preadditive_of_faithful {D} [category D] [preadditive D] [monoidal_category D] + (F : monoidal_functor D C) [faithful F.to_functor] [F.to_functor.additive] : + monoidal_preadditive D := +{ tensor_zero' := by { intros, apply F.to_functor.map_injective, simp [F.map_tensor], }, + zero_tensor' := by { intros, apply F.to_functor.map_injective, simp [F.map_tensor], }, + tensor_add' := begin + intros, + apply F.to_functor.map_injective, + simp only [F.map_tensor, F.to_functor.map_add, preadditive.comp_add, preadditive.add_comp, + monoidal_preadditive.tensor_add], + end, + add_tensor' := begin + intros, + apply F.to_functor.map_injective, + simp only [F.map_tensor, F.to_functor.map_add, preadditive.comp_add, preadditive.add_comp, + monoidal_preadditive.add_tensor], + end, } + open_locale big_operators lemma tensor_sum {P Q R S : C} {J : Type*} (s : finset J) (f : P ⟶ Q) (g : J → (R ⟶ S)) : @@ -79,7 +103,7 @@ variables {C} -- `tensor_left X` is a left adjoint and hence preserves all colimits. -- In any case it is true in any preadditive category. instance (X : C) : preserves_finite_biproducts (tensor_left X) := -{ preserves := λ J _ _, by exactI +{ preserves := λ J _, by exactI { preserves := λ f, { preserves := λ b i, is_bilimit_of_total _ begin dsimp, @@ -87,7 +111,7 @@ instance (X : C) : preserves_finite_biproducts (tensor_left X) := end } } } instance (X : C) : preserves_finite_biproducts (tensor_right X) := -{ preserves := λ J _ _, by exactI +{ preserves := λ J _, by exactI { preserves := λ f, { preserves := λ b i, is_bilimit_of_total _ begin dsimp, @@ -97,12 +121,12 @@ instance (X : C) : preserves_finite_biproducts (tensor_right X) := variables [has_finite_biproducts C] /-- The isomorphism showing how tensor product on the left distributes over direct sums. -/ -def left_distributor {J : Type*} [decidable_eq J] [fintype J] (X : C) (f : J → C) : +def left_distributor {J : Type} [fintype J] (X : C) (f : J → C) : X ⊗ (⨁ f) ≅ ⨁ (λ j, X ⊗ f j) := (tensor_left X).map_biproduct f @[simp] -lemma left_distributor_hom {J : Type*} [decidable_eq J] [fintype J] (X : C) (f : J → C) : +lemma left_distributor_hom {J : Type} [fintype J] (X : C) (f : J → C) : (left_distributor X f).hom = ∑ j : J, (𝟙 X ⊗ biproduct.π f j) ≫ biproduct.ι _ j := begin ext, dsimp [tensor_left, left_distributor], @@ -110,14 +134,14 @@ begin end @[simp] -lemma left_distributor_inv {J : Type*} [decidable_eq J] [fintype J] (X : C) (f : J → C) : +lemma left_distributor_inv {J : Type} [fintype J] (X : C) (f : J → C) : (left_distributor X f).inv = ∑ j : J, biproduct.π _ j ≫ (𝟙 X ⊗ biproduct.ι f j) := begin ext, dsimp [tensor_left, left_distributor], simp [preadditive.comp_sum, biproduct.ι_π_assoc, dite_comp], end -lemma left_distributor_assoc {J : Type*} [decidable_eq J] [fintype J] (X Y : C) (f : J → C) : +lemma left_distributor_assoc {J : Type} [fintype J] (X Y : C) (f : J → C) : (as_iso (𝟙 X) ⊗ left_distributor Y f) ≪≫ left_distributor X _ = (α_ X Y (⨁ f)).symm ≪≫ left_distributor (X ⊗ Y) f ≪≫ biproduct.map_iso (λ j, α_ X Y _) := begin @@ -136,12 +160,12 @@ begin end /-- The isomorphism showing how tensor product on the right distributes over direct sums. -/ -def right_distributor {J : Type*} [decidable_eq J] [fintype J] (X : C) (f : J → C) : +def right_distributor {J : Type} [fintype J] (X : C) (f : J → C) : (⨁ f) ⊗ X ≅ ⨁ (λ j, f j ⊗ X) := (tensor_right X).map_biproduct f @[simp] -lemma right_distributor_hom {J : Type*} [decidable_eq J] [fintype J] (X : C) (f : J → C) : +lemma right_distributor_hom {J : Type} [fintype J] (X : C) (f : J → C) : (right_distributor X f).hom = ∑ j : J, (biproduct.π f j ⊗ 𝟙 X) ≫ biproduct.ι _ j := begin ext, dsimp [tensor_right, right_distributor], @@ -149,14 +173,14 @@ begin end @[simp] -lemma right_distributor_inv {J : Type*} [decidable_eq J] [fintype J] (X : C) (f : J → C) : +lemma right_distributor_inv {J : Type} [fintype J] (X : C) (f : J → C) : (right_distributor X f).inv = ∑ j : J, biproduct.π _ j ≫ (biproduct.ι f j ⊗ 𝟙 X) := begin ext, dsimp [tensor_right, right_distributor], simp [preadditive.comp_sum, biproduct.ι_π_assoc, dite_comp], end -lemma right_distributor_assoc {J : Type*} [decidable_eq J] [fintype J] (X Y : C) (f : J → C) : +lemma right_distributor_assoc {J : Type} [fintype J] (X Y : C) (f : J → C) : (right_distributor X f ⊗ as_iso (𝟙 Y)) ≪≫ right_distributor Y _ = α_ (⨁ f) X Y ≪≫ right_distributor (X ⊗ Y) f ≪≫ biproduct.map_iso (λ j, (α_ _ X Y).symm) := begin @@ -174,7 +198,7 @@ begin end lemma left_distributor_right_distributor_assoc - {J : Type*} [decidable_eq J] [fintype J] (X Y : C) (f : J → C) : + {J : Type*} [fintype J] (X Y : C) (f : J → C) : (left_distributor X f ⊗ as_iso (𝟙 Y)) ≪≫ right_distributor Y _ = α_ X (⨁ f) Y ≪≫ (as_iso (𝟙 X) ⊗ right_distributor Y _) ≪≫ left_distributor X _ ≪≫ biproduct.map_iso (λ j, (α_ _ _ _).symm) := diff --git a/src/category_theory/monoidal/rigid/basic.lean b/src/category_theory/monoidal/rigid/basic.lean index bb43e26be3124..60a4001ff3ccc 100644 --- a/src/category_theory/monoidal/rigid/basic.lean +++ b/src/category_theory/monoidal/rigid/basic.lean @@ -10,6 +10,9 @@ import tactic.apply_fun /-! # Rigid (autonomous) monoidal categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines rigid (autonomous) monoidal categories and the necessary theory about exact pairings and duals. @@ -108,8 +111,8 @@ attribute [instance] has_left_dual.exact open exact_pairing has_right_dual has_left_dual monoidal_category -prefix `ᘁ`:1025 := left_dual -postfix `ᘁ`:1025 := right_dual +prefix (name := left_dual) `ᘁ`:1025 := left_dual +postfix (name := right_dual) `ᘁ`:1025 := right_dual instance has_right_dual_unit : has_right_dual (𝟙_ C) := { right_dual := 𝟙_ C } @@ -139,8 +142,8 @@ def left_adjoint_mate {X Y : C} [has_left_dual X] [has_left_dual Y] (f : X ⟶ Y (λ_ _).inv ≫ (η_ (ᘁX) X ⊗ 𝟙 _) ≫ ((𝟙 _ ⊗ f) ⊗ 𝟙 _) ≫ (α_ _ _ _).hom ≫ (𝟙 _ ⊗ ε_ _ _) ≫ (ρ_ _).hom -notation f `ᘁ` := right_adjoint_mate f -notation `ᘁ` f := left_adjoint_mate f +notation (name := right_adjoint_mate) f `ᘁ` := right_adjoint_mate f +notation (name := left_adjoint_mate) `ᘁ` f := left_adjoint_mate f @[simp] lemma right_adjoint_mate_id {X : C} [has_right_dual X] : (𝟙 X)ᘁ = 𝟙 (Xᘁ) := @@ -372,8 +375,19 @@ adjunction.mk_of_hom_equiv hom_equiv_naturality_right' := λ X Z Z' f g, tensor_right_hom_equiv_naturality f g, } +/-- +If `Y` has a left dual `ᘁY`, then it is a closed object, with the internal hom functor `Y ⟶[C] -` +given by left tensoring by `ᘁY`. +This has to be a definition rather than an instance to avoid diamonds, for example between +`category_theory.monoidal_closed.functor_closed` and +`category_theory.monoidal.functor_has_left_dual`. Moreover, in concrete applications there is often +a more useful definition of the internal hom object than `ᘁY ⊗ X`, in which case the closed +structure shouldn't come from `has_left_dual` (e.g. in the category `FinVect k`, it is more +convenient to define the internal hom as `Y →ₗ[k] X` rather than `ᘁY ⊗ X` even though these are +naturally isomorphic). +-/ @[priority 100] -instance closed_of_has_left_dual (Y : C) [has_left_dual Y] : closed Y := +def closed_of_has_left_dual (Y : C) [has_left_dual Y] : closed Y := { is_adj := ⟨_, tensor_left_adjunction (ᘁY) Y⟩, } /-- `tensor_left_hom_equiv` commutes with tensoring on the right -/ @@ -618,11 +632,19 @@ class left_rigid_category (C : Type u) [category.{v} C] [monoidal_category.{v} C attribute [instance, priority 100] right_rigid_category.right_dual attribute [instance, priority 100] left_rigid_category.left_dual +/-- Any left rigid category is monoidal closed, with the internal hom `X ⟶[C] Y = ᘁX ⊗ Y`. +This has to be a definition rather than an instance to avoid diamonds, for example between +`category_theory.monoidal_closed.functor_category` and +`category_theory.monoidal.left_rigid_functor_category`. Moreover, in concrete applications there is +often a more useful definition of the internal hom object than `ᘁY ⊗ X`, in which case the monoidal +closed structure shouldn't come the rigid structure (e.g. in the category `FinVect k`, it is more +convenient to define the internal hom as `Y →ₗ[k] X` rather than `ᘁY ⊗ X` even though these are +naturally isomorphic). -/ @[priority 100] -instance monoidal_closed_of_left_rigid_category +def monoidal_closed_of_left_rigid_category (C : Type u) [category.{v} C] [monoidal_category.{v} C] [left_rigid_category C] : monoidal_closed C := -{ closed' := λ X, by apply_instance, } +{ closed' := λ X, closed_of_has_left_dual X, } /-- A rigid monoidal category is a monoidal category which is left rigid and right rigid. -/ class rigid_category (C : Type u) [category.{v} C] [monoidal_category.{v} C] diff --git a/src/category_theory/monoidal/rigid/functor_category.lean b/src/category_theory/monoidal/rigid/functor_category.lean index ef3315f137b3d..61e3a4d4a5767 100644 --- a/src/category_theory/monoidal/rigid/functor_category.lean +++ b/src/category_theory/monoidal/rigid/functor_category.lean @@ -9,6 +9,9 @@ import category_theory.monoidal.functor_category /-! # Functors from a groupoid into a right/left rigid category form a right/left rigid category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + (Using the pointwise monoidal structure on the functor category.) -/ diff --git a/src/category_theory/monoidal/rigid/of_equivalence.lean b/src/category_theory/monoidal/rigid/of_equivalence.lean index 567fa184962d7..6646a63db923c 100644 --- a/src/category_theory/monoidal/rigid/of_equivalence.lean +++ b/src/category_theory/monoidal/rigid/of_equivalence.lean @@ -7,6 +7,9 @@ import category_theory.monoidal.rigid.basic /-! # Transport rigid structures over a monoidal equivalence. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ noncomputable theory diff --git a/src/category_theory/monoidal/skeleton.lean b/src/category_theory/monoidal/skeleton.lean index d90d0e99939f9..ab6b9cdf4fd4b 100644 --- a/src/category_theory/monoidal/skeleton.lean +++ b/src/category_theory/monoidal/skeleton.lean @@ -3,7 +3,6 @@ Copyright (c) 2021 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ -import category_theory.monoidal.functor import category_theory.monoidal.braided import category_theory.monoidal.transport import category_theory.skeletal @@ -11,6 +10,9 @@ import category_theory.skeletal /-! # The monoid on the skeleton of a monoidal category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The skeleton of a monoidal category is a monoid. -/ diff --git a/src/category_theory/monoidal/subcategory.lean b/src/category_theory/monoidal/subcategory.lean new file mode 100644 index 0000000000000..a1d995d799d5b --- /dev/null +++ b/src/category_theory/monoidal/subcategory.lean @@ -0,0 +1,220 @@ +/- +Copyright (c) 2022 Antoine Labelle. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Antoine Labelle +-/ +import category_theory.monoidal.braided +import category_theory.monoidal.linear +import category_theory.preadditive.additive_functor +import category_theory.linear.linear_functor +import category_theory.closed.monoidal + +/-! +# Full monoidal subcategories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given a monidal category `C` and a monoidal predicate on `C`, that is a function `P : C → Prop` +closed under `𝟙_` and `⊗`, we can put a monoidal structure on `{X : C // P X}` (the category +structure is defined in `category_theory.full_subcategory`). + +When `C` is also braided/symmetric, the full monoidal subcategory also inherits the +braided/symmetric structure. + +## TODO +* Add monoidal/braided versions of `category_theory.full_subcategory.lift` +-/ + +universes u v + +namespace category_theory + +namespace monoidal_category + +open iso + +variables {C : Type u} [category.{v} C] [monoidal_category C] (P : C → Prop) + +/-- +A property `C → Prop` is a monoidal predicate if it is closed under `𝟙_` and `⊗`. +-/ +class monoidal_predicate : Prop := +(prop_id' : P (𝟙_ C) . obviously) +(prop_tensor' : ∀ {X Y}, P X → P Y → P (X ⊗ Y) . obviously) + +restate_axiom monoidal_predicate.prop_id' +restate_axiom monoidal_predicate.prop_tensor' + +open monoidal_predicate + +variables [monoidal_predicate P] + +/-- +When `P` is a monoidal predicate, the full subcategory for `P` inherits the monoidal structure of + `C`. +-/ +instance full_monoidal_subcategory : monoidal_category (full_subcategory P) := +{ tensor_obj := λ X Y, ⟨X.1 ⊗ Y.1, prop_tensor X.2 Y.2⟩, + tensor_hom := λ X₁ Y₁ X₂ Y₂ f g, by { change X₁.1 ⊗ X₂.1 ⟶ Y₁.1 ⊗ Y₂.1, + change X₁.1 ⟶ Y₁.1 at f, change X₂.1 ⟶ Y₂.1 at g, exact f ⊗ g }, + tensor_unit := ⟨𝟙_ C, prop_id⟩, + associator := λ X Y Z, + ⟨(α_ X.1 Y.1 Z.1).hom, (α_ X.1 Y.1 Z.1).inv, + hom_inv_id (α_ X.1 Y.1 Z.1), inv_hom_id (α_ X.1 Y.1 Z.1)⟩, + left_unitor := λ X, ⟨(λ_ X.1).hom, (λ_ X.1).inv, hom_inv_id (λ_ X.1), inv_hom_id (λ_ X.1)⟩, + right_unitor := λ X, ⟨(ρ_ X.1).hom, (ρ_ X.1).inv, hom_inv_id (ρ_ X.1), inv_hom_id (ρ_ X.1)⟩, + tensor_id' := λ X Y, tensor_id X.1 Y.1, + tensor_comp' := λ X₁ Y₁ Z₁ X₂ Y₂ Z₂ f₁ f₂ g₁ g₂, tensor_comp f₁ f₂ g₁ g₂, + associator_naturality' := λ X₁ X₂ X₃ Y₁ Y₂ Y₃ f₁ f₂ f₃, associator_naturality f₁ f₂ f₃, + left_unitor_naturality' := λ X Y f, left_unitor_naturality f, + right_unitor_naturality' := λ X Y f, right_unitor_naturality f, + pentagon' := λ W X Y Z, pentagon W.1 X.1 Y.1 Z.1, + triangle' := λ X Y, triangle X.1 Y.1 } + +/-- +The forgetful monoidal functor from a full monoidal subcategory into the original category +("forgetting" the condition). +-/ +@[simps] +def full_monoidal_subcategory_inclusion : monoidal_functor (full_subcategory P) C := +{ to_functor := full_subcategory_inclusion P, + ε := 𝟙 _, + μ := λ X Y, 𝟙 _ } + +instance full_monoidal_subcategory.full : + full (full_monoidal_subcategory_inclusion P).to_functor := full_subcategory.full P +instance full_monoidal_subcategory.faithful : + faithful (full_monoidal_subcategory_inclusion P).to_functor := full_subcategory.faithful P + +section + +variables [preadditive C] + +instance full_monoidal_subcategory_inclusion_additive : + (full_monoidal_subcategory_inclusion P).to_functor.additive := +functor.full_subcategory_inclusion_additive _ + +instance [monoidal_preadditive C] : monoidal_preadditive (full_subcategory P) := +monoidal_preadditive_of_faithful (full_monoidal_subcategory_inclusion P) + +variables (R : Type*) [ring R] [linear R C] + +instance full_monoidal_subcategory_inclusion_linear : + (full_monoidal_subcategory_inclusion P).to_functor.linear R := +functor.full_subcategory_inclusion_linear R _ + +instance [monoidal_preadditive C] [monoidal_linear R C] : monoidal_linear R (full_subcategory P) := +monoidal_linear_of_faithful R (full_monoidal_subcategory_inclusion P) + +end + +variables {P} {P' : C → Prop} [monoidal_predicate P'] + +/-- An implication of predicates `P → P'` induces a monoidal functor between full monoidal +subcategories. -/ +@[simps] +def full_monoidal_subcategory.map (h : ∀ ⦃X⦄, P X → P' X) : + monoidal_functor (full_subcategory P) (full_subcategory P') := +{ to_functor := full_subcategory.map h, + ε := 𝟙 _, + μ := λ X Y, 𝟙 _ } + +instance full_monoidal_subcategory.map_full (h : ∀ ⦃X⦄, P X → P' X) : + full (full_monoidal_subcategory.map h).to_functor := { preimage := λ X Y f, f } +instance full_monoidal_subcategory.map_faithful (h : ∀ ⦃X⦄, P X → P' X) : + faithful (full_monoidal_subcategory.map h).to_functor := {} + +section braided + +variables (P) [braided_category C] + +/-- +The braided structure on a full subcategory inherited by the braided structure on `C`. +-/ +instance full_braided_subcategory : braided_category (full_subcategory P) := +braided_category_of_faithful (full_monoidal_subcategory_inclusion P) + (λ X Y, ⟨(β_ X.1 Y.1).hom, (β_ X.1 Y.1).inv, (β_ X.1 Y.1).hom_inv_id, (β_ X.1 Y.1).inv_hom_id⟩) + (λ X Y, by tidy) + +/-- +The forgetful braided functor from a full braided subcategory into the original category +("forgetting" the condition). +-/ +@[simps] +def full_braided_subcategory_inclusion : braided_functor (full_subcategory P) C := +{ to_monoidal_functor := full_monoidal_subcategory_inclusion P, + braided' := λ X Y, by { rw [is_iso.eq_inv_comp], tidy } } + +instance full_braided_subcategory.full : + full (full_braided_subcategory_inclusion P).to_functor := full_monoidal_subcategory.full P +instance full_braided_subcategory.faithful : + faithful (full_braided_subcategory_inclusion P).to_functor := full_monoidal_subcategory.faithful P + +variables {P} + +/-- An implication of predicates `P → P'` induces a braided functor between full braided +subcategories. -/ +@[simps] +def full_braided_subcategory.map (h : ∀ ⦃X⦄, P X → P' X) : + braided_functor (full_subcategory P) (full_subcategory P') := +{ to_monoidal_functor := full_monoidal_subcategory.map h, + braided' := λ X Y, by { rw [is_iso.eq_inv_comp], tidy } } + +instance full_braided_subcategory.map_full (h : ∀ ⦃X⦄, P X → P' X) : + full (full_braided_subcategory.map h).to_functor := full_monoidal_subcategory.map_full h +instance full_braided_subcategory.map_faithful (h : ∀ ⦃X⦄, P X → P' X) : + faithful (full_braided_subcategory.map h).to_functor := full_monoidal_subcategory.map_faithful h + +end braided + +section symmetric + +variables (P) [symmetric_category C] + +instance full_symmetric_subcategory : symmetric_category (full_subcategory P) := +symmetric_category_of_faithful (full_braided_subcategory_inclusion P) + +end symmetric + +section closed + +variables (P) [monoidal_closed C] + +/-- +A property `C → Prop` is a closed predicate if it is closed under taking internal homs +-/ +class closed_predicate : Prop := +(prop_ihom' : ∀ {X Y}, P X → P Y → P ((ihom X).obj Y) . obviously) + +restate_axiom closed_predicate.prop_ihom' + +open closed_predicate + +variable [closed_predicate P] + +instance full_monoidal_closed_subcategory : monoidal_closed (full_subcategory P) := +{ closed' := λ X, + { is_adj := + { right := full_subcategory.lift P (full_subcategory_inclusion P ⋙ (ihom X.1)) + (λ Y, prop_ihom X.2 Y.2), + adj := adjunction.mk_of_unit_counit + { unit := { app := λ Y, (ihom.coev X.1).app Y.1, + naturality' := λ Y Z f, ihom.coev_naturality X.1 f }, + counit := { app := λ Y, (ihom.ev X.1).app Y.1, + naturality' := λ Y Z f, ihom.ev_naturality X.1 f }, + left_triangle' := by { ext Y, simp, exact ihom.ev_coev X.1 Y.1 }, + right_triangle' := by { ext Y, simp, exact ihom.coev_ev X.1 Y.1 } } } } } + +@[simp] lemma full_monoidal_closed_subcategory_ihom_obj (X Y : full_subcategory P) : + ((ihom X).obj Y).obj = (ihom (X.obj)).obj Y.obj := rfl + +@[simp] lemma full_monoidal_closed_subcategory_ihom_map (X : full_subcategory P) + {Y Z : full_subcategory P} + (f : Y ⟶ Z) : (ihom X).map f = (ihom (X.obj)).map f := rfl + +end closed + +end monoidal_category + +end category_theory diff --git a/src/category_theory/monoidal/tor.lean b/src/category_theory/monoidal/tor.lean index 92a7d83b46575..9ea38314c8550 100644 --- a/src/category_theory/monoidal/tor.lean +++ b/src/category_theory/monoidal/tor.lean @@ -9,6 +9,9 @@ import category_theory.monoidal.preadditive /-! # Tor, the left-derived functor of tensor product +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `Tor C n : C ⥤ C ⥤ C`, by left-deriving in the second factor of `(X, Y) ↦ X ⊗ Y`. For now we have almost nothing to say about it! @@ -67,3 +70,5 @@ begin end end category_theory + +assert_not_exists Module.abelian diff --git a/src/category_theory/monoidal/transport.lean b/src/category_theory/monoidal/transport.lean index 954619dd50498..d447a53b4ff9c 100644 --- a/src/category_theory/monoidal/transport.lean +++ b/src/category_theory/monoidal/transport.lean @@ -8,6 +8,9 @@ import category_theory.monoidal.natural_transformation /-! # Transport a monoidal structure along an equivalence. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `C` and `D` are equivalent as categories, we can transport a monoidal structure on `C` along the equivalence, obtaining a monoidal structure on `D`. diff --git a/src/category_theory/monoidal/types.lean b/src/category_theory/monoidal/types.lean deleted file mode 100644 index 864e0c873577f..0000000000000 --- a/src/category_theory/monoidal/types.lean +++ /dev/null @@ -1,75 +0,0 @@ -/- -Copyright (c) 2018 Michael Jendrusch. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Michael Jendrusch, Scott Morrison --/ -import category_theory.monoidal.of_chosen_finite_products -import category_theory.limits.shapes.types - -/-! -# The category of types is a symmetric monoidal category --/ - -open category_theory -open category_theory.limits -open tactic - -universes v u - -namespace category_theory - -instance types_monoidal : monoidal_category.{u} (Type u) := -monoidal_of_chosen_finite_products (types.terminal_limit_cone) (types.binary_product_limit_cone) - -instance types_symmetric : symmetric_category.{u} (Type u) := -symmetric_of_chosen_finite_products (types.terminal_limit_cone) (types.binary_product_limit_cone) - -@[simp] lemma tensor_apply {W X Y Z : Type u} (f : W ⟶ X) (g : Y ⟶ Z) (p : W ⊗ Y) : - (f ⊗ g) p = (f p.1, g p.2) := rfl - -@[simp] lemma left_unitor_hom_apply {X : Type u} {x : X} {p : punit} : - ((λ_ X).hom : (𝟙_ (Type u)) ⊗ X → X) (p, x) = x := rfl -@[simp] lemma left_unitor_inv_apply {X : Type u} {x : X} : - ((λ_ X).inv : X ⟶ (𝟙_ (Type u)) ⊗ X) x = (punit.star, x) := rfl - -@[simp] lemma right_unitor_hom_apply {X : Type u} {x : X} {p : punit} : - ((ρ_ X).hom : X ⊗ (𝟙_ (Type u)) → X) (x, p) = x := rfl -@[simp] lemma right_unitor_inv_apply {X : Type u} {x : X} : - ((ρ_ X).inv : X ⟶ X ⊗ (𝟙_ (Type u))) x = (x, punit.star) := rfl - -@[simp] lemma associator_hom_apply {X Y Z : Type u} {x : X} {y : Y} {z : Z} : - ((α_ X Y Z).hom : (X ⊗ Y) ⊗ Z → X ⊗ (Y ⊗ Z)) ((x, y), z) = (x, (y, z)) := rfl -@[simp] lemma associator_inv_apply {X Y Z : Type u} {x : X} {y : Y} {z : Z} : - ((α_ X Y Z).inv : X ⊗ (Y ⊗ Z) → (X ⊗ Y) ⊗ Z) (x, (y, z)) = ((x, y), z) := rfl - -@[simp] lemma braiding_hom_apply {X Y : Type u} {x : X} {y : Y} : - ((β_ X Y).hom : X ⊗ Y → Y ⊗ X) (x, y) = (y, x) := rfl -@[simp] lemma braiding_inv_apply {X Y : Type u} {x : X} {y : Y} : - ((β_ X Y).inv : Y ⊗ X → X ⊗ Y) (y, x) = (x, y) := rfl - -open opposite - -open monoidal_category - -/-- `(𝟙_ C ⟶ -)` is a lax monoidal functor to `Type`. -/ -def coyoneda_tensor_unit (C : Type u) [category.{v} C] [monoidal_category C] : - lax_monoidal_functor C (Type v) := -{ ε := λ p, 𝟙 _, - μ := λ X Y p, (λ_ (𝟙_ C)).inv ≫ (p.1 ⊗ p.2), - μ_natural' := by tidy, - associativity' := λ X Y Z, begin - ext ⟨⟨f, g⟩, h⟩, dsimp at f g h, - dsimp, simp only [iso.cancel_iso_inv_left, category.assoc], - conv_lhs { rw [←category.id_comp h, tensor_comp, category.assoc, associator_naturality, - ←category.assoc, unitors_inv_equal, triangle_assoc_comp_right_inv], }, - conv_rhs { rw [←category.id_comp f, tensor_comp], }, - end, - left_unitality' := by tidy, - right_unitality' := λ X, begin - ext ⟨f, ⟨⟩⟩, dsimp at f, - dsimp, simp only [category.assoc], - rw [right_unitor_naturality, unitors_inv_equal, iso.inv_hom_id_assoc], - end, - ..coyoneda.obj (op (𝟙_ C)) } - -end category_theory diff --git a/src/category_theory/monoidal/types/basic.lean b/src/category_theory/monoidal/types/basic.lean new file mode 100644 index 0000000000000..72904c52b2636 --- /dev/null +++ b/src/category_theory/monoidal/types/basic.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2018 Michael Jendrusch. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Michael Jendrusch, Scott Morrison +-/ +import category_theory.monoidal.functor +import category_theory.monoidal.of_chosen_finite_products.basic +import category_theory.limits.shapes.types +import logic.equiv.fin + +/-! +# The category of types is a monoidal category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open category_theory +open category_theory.limits +open tactic + +universes v u + +namespace category_theory + +instance types_monoidal : monoidal_category.{u} (Type u) := +monoidal_of_chosen_finite_products (types.terminal_limit_cone) (types.binary_product_limit_cone) + +@[simp] lemma tensor_apply {W X Y Z : Type u} (f : W ⟶ X) (g : Y ⟶ Z) (p : W ⊗ Y) : + (f ⊗ g) p = (f p.1, g p.2) := rfl + +@[simp] lemma left_unitor_hom_apply {X : Type u} {x : X} {p : punit} : + ((λ_ X).hom : (𝟙_ (Type u)) ⊗ X → X) (p, x) = x := rfl +@[simp] lemma left_unitor_inv_apply {X : Type u} {x : X} : + ((λ_ X).inv : X ⟶ (𝟙_ (Type u)) ⊗ X) x = (punit.star, x) := rfl + +@[simp] lemma right_unitor_hom_apply {X : Type u} {x : X} {p : punit} : + ((ρ_ X).hom : X ⊗ (𝟙_ (Type u)) → X) (x, p) = x := rfl +@[simp] lemma right_unitor_inv_apply {X : Type u} {x : X} : + ((ρ_ X).inv : X ⟶ X ⊗ (𝟙_ (Type u))) x = (x, punit.star) := rfl + +@[simp] lemma associator_hom_apply {X Y Z : Type u} {x : X} {y : Y} {z : Z} : + ((α_ X Y Z).hom : (X ⊗ Y) ⊗ Z → X ⊗ (Y ⊗ Z)) ((x, y), z) = (x, (y, z)) := rfl +@[simp] lemma associator_inv_apply {X Y Z : Type u} {x : X} {y : Y} {z : Z} : + ((α_ X Y Z).inv : X ⊗ (Y ⊗ Z) → (X ⊗ Y) ⊗ Z) (x, (y, z)) = ((x, y), z) := rfl + +/-- If `F` is a monoidal functor out of `Type`, it takes the (n+1)st cartesian power +of a type to the image of that type, tensored with the image of the nth cartesian power. -/ +-- We don't yet have an API for tensor products indexed by finite ordered types, +-- but it would be nice to state how monoidal functors preserve these. +noncomputable +def monoidal_functor.map_pi {C : Type*} [category C] [monoidal_category C] + (F : monoidal_functor Type* C) (n : ℕ) (β : Type*) : + F.obj (fin (n+1) → β) ≅ F.obj β ⊗ F.obj (fin n → β) := +functor.map_iso _ (equiv.pi_fin_succ n β).to_iso ≪≫ (as_iso (F.μ β (fin n → β))).symm + +end category_theory diff --git a/src/category_theory/monoidal/types/coyoneda.lean b/src/category_theory/monoidal/types/coyoneda.lean new file mode 100644 index 0000000000000..9d1b1fa6ae7db --- /dev/null +++ b/src/category_theory/monoidal/types/coyoneda.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2018 Michael Jendrusch. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Michael Jendrusch, Scott Morrison +-/ +import category_theory.monoidal.types.basic +import category_theory.monoidal.coherence_lemmas + +/-! +# `(𝟙_ C ⟶ -)` is a lax monoidal functor to `Type` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open category_theory +open category_theory.limits +open tactic + +universes v u + +namespace category_theory + +open opposite +open monoidal_category + +/-- `(𝟙_ C ⟶ -)` is a lax monoidal functor to `Type`. -/ +def coyoneda_tensor_unit (C : Type u) [category.{v} C] [monoidal_category C] : + lax_monoidal_functor C (Type v) := +{ ε := λ p, 𝟙 _, + μ := λ X Y p, (λ_ (𝟙_ C)).inv ≫ (p.1 ⊗ p.2), + μ_natural' := by tidy, + associativity' := λ X Y Z, begin + ext ⟨⟨f, g⟩, h⟩, dsimp at f g h, + dsimp, simp only [iso.cancel_iso_inv_left, category.assoc], + conv_lhs { rw [←category.id_comp h, tensor_comp, category.assoc, associator_naturality, + ←category.assoc, unitors_inv_equal, triangle_assoc_comp_right_inv], }, + conv_rhs { rw [←category.id_comp f, tensor_comp], }, + end, + left_unitality' := by tidy, + right_unitality' := λ X, begin + ext ⟨f, ⟨⟩⟩, dsimp at f, + dsimp, simp only [category.assoc], + rw [right_unitor_naturality, unitors_inv_equal, iso.inv_hom_id_assoc], + end, + ..coyoneda.obj (op (𝟙_ C)) }. + +end category_theory diff --git a/src/category_theory/monoidal/types/symmetric.lean b/src/category_theory/monoidal/types/symmetric.lean new file mode 100644 index 0000000000000..c8d88e799b7e7 --- /dev/null +++ b/src/category_theory/monoidal/types/symmetric.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2018 Michael Jendrusch. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Michael Jendrusch, Scott Morrison +-/ +import category_theory.monoidal.of_chosen_finite_products.symmetric +import category_theory.monoidal.types.basic + +/-! +# The category of types is a symmetric monoidal category + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open category_theory +open category_theory.limits + +universes v u + +namespace category_theory + +instance types_symmetric : symmetric_category.{u} (Type u) := +symmetric_of_chosen_finite_products (types.terminal_limit_cone) (types.binary_product_limit_cone) + +@[simp] lemma braiding_hom_apply {X Y : Type u} {x : X} {y : Y} : + ((β_ X Y).hom : X ⊗ Y → Y ⊗ X) (x, y) = (y, x) := rfl +@[simp] lemma braiding_inv_apply {X Y : Type u} {x : X} {y : Y} : + ((β_ X Y).inv : Y ⊗ X → X ⊗ Y) (y, x) = (x, y) := rfl + +end category_theory diff --git a/src/category_theory/morphism_property.lean b/src/category_theory/morphism_property.lean new file mode 100644 index 0000000000000..bcf784ed4caf7 --- /dev/null +++ b/src/category_theory/morphism_property.lean @@ -0,0 +1,570 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.limits.shapes.diagonal +import category_theory.arrow +import category_theory.limits.shapes.comm_sq +import category_theory.concrete_category.basic + +/-! +# Properties of morphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide the basic framework for talking about properties of morphisms. +The following meta-properties are defined + +* `respects_iso`: `P` respects isomorphisms if `P f → P (e ≫ f)` and `P f → P (f ≫ e)`, where + `e` is an isomorphism. +* `stable_under_composition`: `P` is stable under composition if `P f → P g → P (f ≫ g)`. +* `stable_under_base_change`: `P` is stable under base change if in all pullback + squares, the left map satisfies `P` if the right map satisfies it. +* `stable_under_cobase_change`: `P` is stable under cobase change if in all pushout + squares, the right map satisfies `P` if the left map satisfies it. + +-/ + +universes v u + +open category_theory category_theory.limits opposite + +noncomputable theory + +namespace category_theory + +variables (C : Type u) [category.{v} C] {D : Type*} [category D] + +/-- A `morphism_property C` is a class of morphisms between objects in `C`. -/ +@[derive complete_lattice] +def morphism_property := ∀ ⦃X Y : C⦄ (f : X ⟶ Y), Prop + +instance : inhabited (morphism_property C) := ⟨⊤⟩ + +variable {C} + +namespace morphism_property + +instance : has_subset (morphism_property C) := +⟨λ P₁ P₂, ∀ ⦃X Y : C⦄ (f : X ⟶ Y) (hf : P₁ f), P₂ f⟩ +instance : has_inter (morphism_property C) := +⟨λ P₁ P₂ X Y f, P₁ f ∧ P₂ f⟩ + +/-- The morphism property in `Cᵒᵖ` associated to a morphism property in `C` -/ +@[simp] def op (P : morphism_property C) : morphism_property Cᵒᵖ := λ X Y f, P f.unop + +/-- The morphism property in `C` associated to a morphism property in `Cᵒᵖ` -/ +@[simp] def unop (P : morphism_property Cᵒᵖ) : morphism_property C := λ X Y f, P f.op + +lemma unop_op (P : morphism_property C) : P.op.unop = P := rfl +lemma op_unop (P : morphism_property Cᵒᵖ) : P.unop.op = P := rfl + +/-- The inverse image of a `morphism_property D` by a functor `C ⥤ D` -/ +def inverse_image (P : morphism_property D) (F : C ⥤ D) : morphism_property C := +λ X Y f, P (F.map f) + +/-- A morphism property `respects_iso` if it still holds when composed with an isomorphism -/ +def respects_iso (P : morphism_property C) : Prop := + (∀ {X Y Z} (e : X ≅ Y) (f : Y ⟶ Z), P f → P (e.hom ≫ f)) ∧ + (∀ {X Y Z} (e : Y ≅ Z) (f : X ⟶ Y), P f → P (f ≫ e.hom)) + +lemma respects_iso.op {P : morphism_property C} (h : respects_iso P) : respects_iso P.op := +⟨λ X Y Z e f hf, h.2 e.unop f.unop hf, λ X Y Z e f hf, h.1 e.unop f.unop hf⟩ + +lemma respects_iso.unop {P : morphism_property Cᵒᵖ} (h : respects_iso P) : respects_iso P.unop := +⟨λ X Y Z e f hf, h.2 e.op f.op hf, λ X Y Z e f hf, h.1 e.op f.op hf⟩ + +/-- A morphism property is `stable_under_composition` if the composition of two such morphisms +still falls in the class. -/ +def stable_under_composition (P : morphism_property C) : Prop := + ∀ ⦃X Y Z⦄ (f : X ⟶ Y) (g : Y ⟶ Z), P f → P g → P (f ≫ g) + +lemma stable_under_composition.op {P : morphism_property C} (h : stable_under_composition P) : + stable_under_composition P.op := λ X Y Z f g hf hg, h g.unop f.unop hg hf + +lemma stable_under_composition.unop {P : morphism_property Cᵒᵖ} (h : stable_under_composition P) : + stable_under_composition P.unop := λ X Y Z f g hf hg, h g.op f.op hg hf + +/-- A morphism property is `stable_under_inverse` if the inverse of a morphism satisfying +the property still falls in the class. -/ +def stable_under_inverse (P : morphism_property C) : Prop := +∀ ⦃X Y⦄ (e : X ≅ Y), P e.hom → P e.inv + +lemma stable_under_inverse.op {P : morphism_property C} (h : stable_under_inverse P) : + stable_under_inverse P.op := λ X Y e he, h e.unop he + +lemma stable_under_inverse.unop {P : morphism_property Cᵒᵖ} (h : stable_under_inverse P) : + stable_under_inverse P.unop := λ X Y e he, h e.op he + +/-- A morphism property is `stable_under_base_change` if the base change of such a morphism +still falls in the class. -/ +def stable_under_base_change (P : morphism_property C) : Prop := +∀ ⦃X Y Y' S : C⦄ ⦃f : X ⟶ S⦄ ⦃g : Y ⟶ S⦄ ⦃f' : Y' ⟶ Y⦄ ⦃g' : Y' ⟶ X⦄ + (sq : is_pullback f' g' g f) (hg : P g), P g' + +/-- A morphism property is `stable_under_cobase_change` if the cobase change of such a morphism +still falls in the class. -/ +def stable_under_cobase_change (P : morphism_property C) : Prop := +∀ ⦃A A' B B' : C⦄ ⦃f : A ⟶ A'⦄ ⦃g : A ⟶ B⦄ ⦃f' : B ⟶ B'⦄ ⦃g' : A' ⟶ B'⦄ + (sq : is_pushout g f f' g') (hf : P f), P f' + +lemma stable_under_composition.respects_iso {P : morphism_property C} + (hP : stable_under_composition P) (hP' : ∀ {X Y} (e : X ≅ Y), P e.hom) : respects_iso P := +⟨λ X Y Z e f hf, hP _ _ (hP' e) hf, λ X Y Z e f hf, hP _ _ hf (hP' e)⟩ + +lemma respects_iso.cancel_left_is_iso {P : morphism_property C} + (hP : respects_iso P) {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] : + P (f ≫ g) ↔ P g := +⟨λ h, by simpa using hP.1 (as_iso f).symm (f ≫ g) h, hP.1 (as_iso f) g⟩ + +lemma respects_iso.cancel_right_is_iso {P : morphism_property C} + (hP : respects_iso P) {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] : + P (f ≫ g) ↔ P f := +⟨λ h, by simpa using hP.2 (as_iso g).symm (f ≫ g) h, hP.2 (as_iso g) f⟩ + +lemma respects_iso.arrow_iso_iff {P : morphism_property C} + (hP : respects_iso P) {f g : arrow C} (e : f ≅ g) : P f.hom ↔ P g.hom := +by { rw [← arrow.inv_left_hom_right e.hom, hP.cancel_left_is_iso, hP.cancel_right_is_iso], refl } + +lemma respects_iso.arrow_mk_iso_iff {P : morphism_property C} + (hP : respects_iso P) {W X Y Z : C} {f : W ⟶ X} {g : Y ⟶ Z} (e : arrow.mk f ≅ arrow.mk g) : + P f ↔ P g := +hP.arrow_iso_iff e + +lemma respects_iso.of_respects_arrow_iso (P : morphism_property C) + (hP : ∀ (f g : arrow C) (e : f ≅ g) (hf : P f.hom), P g.hom) : respects_iso P := +begin + split, + { intros X Y Z e f hf, + refine hP (arrow.mk f) (arrow.mk (e.hom ≫ f)) (arrow.iso_mk e.symm (iso.refl _) _) hf, + dsimp, + simp only [iso.inv_hom_id_assoc, category.comp_id], }, + { intros X Y Z e f hf, + refine hP (arrow.mk f) (arrow.mk (f ≫ e.hom)) (arrow.iso_mk (iso.refl _) e _) hf, + dsimp, + simp only [category.id_comp], }, +end + +lemma stable_under_base_change.mk {P : morphism_property C} [has_pullbacks C] + (hP₁ : respects_iso P) + (hP₂ : ∀ (X Y S : C) (f : X ⟶ S) (g : Y ⟶ S) (hg : P g), P (pullback.fst : pullback f g ⟶ X)) : + stable_under_base_change P := λ X Y Y' S f g f' g' sq hg, +begin + let e := sq.flip.iso_pullback, + rw [← hP₁.cancel_left_is_iso e.inv, sq.flip.iso_pullback_inv_fst], + exact hP₂ _ _ _ f g hg, +end + +lemma stable_under_base_change.respects_iso {P : morphism_property C} + (hP : stable_under_base_change P) : respects_iso P := +begin + apply respects_iso.of_respects_arrow_iso, + intros f g e, + exact hP (is_pullback.of_horiz_is_iso (comm_sq.mk e.inv.w)), +end + +lemma stable_under_base_change.fst {P : morphism_property C} + (hP : stable_under_base_change P) {X Y S : C} (f : X ⟶ S) (g : Y ⟶ S) [has_pullback f g] + (H : P g) : P (pullback.fst : pullback f g ⟶ X) := +hP (is_pullback.of_has_pullback f g).flip H + +lemma stable_under_base_change.snd {P : morphism_property C} + (hP : stable_under_base_change P) {X Y S : C} (f : X ⟶ S) (g : Y ⟶ S) [has_pullback f g] + (H : P f) : P (pullback.snd : pullback f g ⟶ Y) := +hP (is_pullback.of_has_pullback f g) H + +lemma stable_under_base_change.base_change_obj [has_pullbacks C] {P : morphism_property C} + (hP : stable_under_base_change P) {S S' : C} (f : S' ⟶ S) + (X : over S) (H : P X.hom) : P ((base_change f).obj X).hom := +hP.snd X.hom f H + +lemma stable_under_base_change.base_change_map [has_pullbacks C] {P : morphism_property C} + (hP : stable_under_base_change P) {S S' : C} (f : S' ⟶ S) + {X Y : over S} (g : X ⟶ Y) (H : P g.left) : P ((base_change f).map g).left := +begin + let e := pullback_right_pullback_fst_iso Y.hom f g.left ≪≫ + pullback.congr_hom (g.w.trans (category.comp_id _)) rfl, + have : e.inv ≫ pullback.snd = ((base_change f).map g).left, + { apply pullback.hom_ext; dsimp; simp }, + rw [← this, hP.respects_iso.cancel_left_is_iso], + exact hP.snd _ _ H, +end + +lemma stable_under_base_change.pullback_map [has_pullbacks C] {P : morphism_property C} + (hP : stable_under_base_change P) (hP' : stable_under_composition P) {S X X' Y Y' : C} + {f : X ⟶ S} {g : Y ⟶ S} {f' : X' ⟶ S} {g' : Y' ⟶ S} {i₁ : X ⟶ X'} {i₂ : Y ⟶ Y'} + (h₁ : P i₁) (h₂ : P i₂) (e₁ : f = i₁ ≫ f') (e₂ : g = i₂ ≫ g') : + P (pullback.map f g f' g' i₁ i₂ (𝟙 _) + ((category.comp_id _).trans e₁) ((category.comp_id _).trans e₂)) := +begin + have : pullback.map f g f' g' i₁ i₂ (𝟙 _) + ((category.comp_id _).trans e₁) ((category.comp_id _).trans e₂) = + ((pullback_symmetry _ _).hom ≫ + ((base_change _).map (over.hom_mk _ e₂.symm : over.mk g ⟶ over.mk g')).left) ≫ + (pullback_symmetry _ _).hom ≫ + ((base_change g').map (over.hom_mk _ e₁.symm : over.mk f ⟶ over.mk f')).left, + { apply pullback.hom_ext; dsimp; simp }, + rw this, + apply hP'; rw hP.respects_iso.cancel_left_is_iso, + exacts [hP.base_change_map _ (over.hom_mk _ e₂.symm : over.mk g ⟶ over.mk g') h₂, + hP.base_change_map _ (over.hom_mk _ e₁.symm : over.mk f ⟶ over.mk f') h₁], +end + +lemma stable_under_cobase_change.mk {P : morphism_property C} [has_pushouts C] + (hP₁ : respects_iso P) + (hP₂ : ∀ (A B A' : C) (f : A ⟶ A') (g : A ⟶ B) (hf : P f), P (pushout.inr : B ⟶ pushout f g)) : + stable_under_cobase_change P := λ A A' B B' f g f' g' sq hf, +begin + let e := sq.flip.iso_pushout, + rw [← hP₁.cancel_right_is_iso _ e.hom, sq.flip.inr_iso_pushout_hom], + exact hP₂ _ _ _ f g hf, +end + +lemma stable_under_cobase_change.respects_iso {P : morphism_property C} + (hP : stable_under_cobase_change P) : respects_iso P := +respects_iso.of_respects_arrow_iso _ (λ f g e, hP (is_pushout.of_horiz_is_iso (comm_sq.mk e.hom.w))) + +lemma stable_under_cobase_change.inl {P : morphism_property C} + (hP : stable_under_cobase_change P) {A B A' : C} (f : A ⟶ A') (g : A ⟶ B) [has_pushout f g] + (H : P g) : P (pushout.inl : A' ⟶ pushout f g) := +hP (is_pushout.of_has_pushout f g) H + +lemma stable_under_cobase_change.inr {P : morphism_property C} + (hP : stable_under_cobase_change P) {A B A' : C} (f : A ⟶ A') (g : A ⟶ B) [has_pushout f g] + (H : P f) : P (pushout.inr : B ⟶ pushout f g) := +hP (is_pushout.of_has_pushout f g).flip H + +lemma stable_under_cobase_change.op {P : morphism_property C} + (hP : stable_under_cobase_change P) : stable_under_base_change P.op := +λ X Y Y' S f g f' g' sq hg, hP sq.unop hg + +lemma stable_under_cobase_change.unop {P : morphism_property Cᵒᵖ} + (hP : stable_under_cobase_change P) : stable_under_base_change P.unop := +λ X Y Y' S f g f' g' sq hg, hP sq.op hg + +lemma stable_under_base_change.op {P : morphism_property C} + (hP : stable_under_base_change P) : stable_under_cobase_change P.op := +λ A A' B B' f g f' g' sq hf, hP sq.unop hf + +lemma stable_under_base_change.unop {P : morphism_property Cᵒᵖ} + (hP : stable_under_base_change P) : stable_under_cobase_change P.unop := +λ A A' B B' f g f' g' sq hf, hP sq.op hf + +/-- If `P : morphism_property C` and `F : C ⥤ D`, then +`P.is_inverted_by F` means that all morphisms in `P` are mapped by `F` +to isomorphisms in `D`. -/ +def is_inverted_by (P : morphism_property C) (F : C ⥤ D) : Prop := +∀ ⦃X Y : C⦄ (f : X ⟶ Y) (hf : P f), is_iso (F.map f) + +namespace is_inverted_by + +lemma of_comp {C₁ C₂ C₃ : Type*} [category C₁] [category C₂] [category C₃] + (W : morphism_property C₁) (F : C₁ ⥤ C₂) (hF : W.is_inverted_by F) (G : C₂ ⥤ C₃) : + W.is_inverted_by (F ⋙ G) := +λ X Y f hf, by { haveI := hF f hf, dsimp, apply_instance, } + +lemma op {W : morphism_property C} {L : C ⥤ D} (h : W.is_inverted_by L) : + W.op.is_inverted_by L.op := +λ X Y f hf, by { haveI := h f.unop hf, dsimp, apply_instance, } + +lemma right_op {W : morphism_property C} {L : Cᵒᵖ ⥤ D} (h : W.op.is_inverted_by L) : + W.is_inverted_by L.right_op := +λ X Y f hf, by { haveI := h f.op hf, dsimp, apply_instance, } + +lemma left_op {W : morphism_property C} {L : C ⥤ Dᵒᵖ} (h : W.is_inverted_by L) : + W.op.is_inverted_by L.left_op := +λ X Y f hf, by { haveI := h f.unop hf, dsimp, apply_instance, } + +lemma unop {W : morphism_property C} {L : Cᵒᵖ ⥤ Dᵒᵖ} (h : W.op.is_inverted_by L) : + W.is_inverted_by L.unop := +λ X Y f hf, by { haveI := h f.op hf, dsimp, apply_instance, } + +end is_inverted_by + +/-- Given `app : Π X, F₁.obj X ⟶ F₂.obj X` where `F₁` and `F₂` are two functors, +this is the `morphism_property C` satisfied by the morphisms in `C` with respect +to whom `app` is natural. -/ +@[simp] +def naturality_property {F₁ F₂ : C ⥤ D} (app : Π X, F₁.obj X ⟶ F₂.obj X) : + morphism_property C := λ X Y f, F₁.map f ≫ app Y = app X ≫ F₂.map f + +namespace naturality_property + +lemma is_stable_under_composition {F₁ F₂ : C ⥤ D} (app : Π X, F₁.obj X ⟶ F₂.obj X) : + (naturality_property app).stable_under_composition := λ X Y Z f g hf hg, +begin + simp only [naturality_property] at ⊢ hf hg, + simp only [functor.map_comp, category.assoc, hg], + slice_lhs 1 2 { rw hf }, + rw category.assoc, +end + +lemma is_stable_under_inverse {F₁ F₂ : C ⥤ D} (app : Π X, F₁.obj X ⟶ F₂.obj X) : + (naturality_property app).stable_under_inverse := λ X Y e he, +begin + simp only [naturality_property] at ⊢ he, + rw ← cancel_epi (F₁.map e.hom), + slice_rhs 1 2 { rw he }, + simp only [category.assoc, ← F₁.map_comp_assoc, ← F₂.map_comp, + e.hom_inv_id, functor.map_id, category.id_comp, category.comp_id], +end + +end naturality_property + +lemma respects_iso.inverse_image {P : morphism_property D} (h : respects_iso P) (F : C ⥤ D) : + respects_iso (P.inverse_image F) := +begin + split, + all_goals + { intros X Y Z e f hf, + dsimp [inverse_image], + rw F.map_comp, }, + exacts [h.1 (F.map_iso e) (F.map f) hf, h.2 (F.map_iso e) (F.map f) hf], +end + +lemma stable_under_composition.inverse_image {P : morphism_property D} + (h : stable_under_composition P) (F : C ⥤ D) : stable_under_composition (P.inverse_image F) := +λ X Y Z f g hf hg, by simpa only [← F.map_comp] using h (F.map f) (F.map g) hf hg + +variable (C) + +/-- The `morphism_property C` satisfied by isomorphisms in `C`. -/ +def isomorphisms : morphism_property C := λ X Y f, is_iso f + +/-- The `morphism_property C` satisfied by monomorphisms in `C`. -/ +def monomorphisms : morphism_property C := λ X Y f, mono f + +/-- The `morphism_property C` satisfied by epimorphisms in `C`. -/ +def epimorphisms : morphism_property C := λ X Y f, epi f + +section + +variables {C} {X Y : C} (f : X ⟶ Y) + +@[simp] lemma isomorphisms.iff : (isomorphisms C) f ↔ is_iso f := by refl +@[simp] lemma monomorphisms.iff : (monomorphisms C) f ↔ mono f := by refl +@[simp] lemma epimorphisms.iff : (epimorphisms C) f ↔ epi f := by refl + +lemma isomorphisms.infer_property [hf : is_iso f] : (isomorphisms C) f := hf +lemma monomorphisms.infer_property [hf : mono f] : (monomorphisms C) f := hf +lemma epimorphisms.infer_property [hf : epi f] : (epimorphisms C) f := hf + +end + +lemma respects_iso.monomorphisms : respects_iso (monomorphisms C) := +by { split; { intros X Y Z e f, simp only [monomorphisms.iff], introI, apply mono_comp, }, } + +lemma respects_iso.epimorphisms : respects_iso (epimorphisms C) := +by { split; { intros X Y Z e f, simp only [epimorphisms.iff], introI, apply epi_comp, }, } + +lemma respects_iso.isomorphisms : respects_iso (isomorphisms C) := +by { split; { intros X Y Z e f, simp only [isomorphisms.iff], introI, apply_instance, }, } + +lemma stable_under_composition.isomorphisms : stable_under_composition (isomorphisms C) := +λ X Y Z f g hf hg, begin + rw isomorphisms.iff at hf hg ⊢, + haveI := hf, + haveI := hg, + apply_instance, +end + +lemma stable_under_composition.monomorphisms : stable_under_composition (monomorphisms C) := +λ X Y Z f g hf hg, begin + rw monomorphisms.iff at hf hg ⊢, + haveI := hf, + haveI := hg, + apply mono_comp, +end + +lemma stable_under_composition.epimorphisms : stable_under_composition (epimorphisms C) := +λ X Y Z f g hf hg, begin + rw epimorphisms.iff at hf hg ⊢, + haveI := hf, + haveI := hg, + apply epi_comp, +end + +variable {C} + +/-- The full subcategory of `C ⥤ D` consisting of functors inverting morphisms in `W` -/ +@[derive category, nolint has_nonempty_instance] +def functors_inverting (W : morphism_property C) (D : Type*) [category D] := +full_subcategory (λ (F : C ⥤ D), W.is_inverted_by F) + +/-- A constructor for `W.functors_inverting D` -/ +def functors_inverting.mk {W : morphism_property C} {D : Type*} [category D] +(F : C ⥤ D) (hF : W.is_inverted_by F) : W.functors_inverting D := ⟨F, hF⟩ + +lemma is_inverted_by.iff_of_iso (W : morphism_property C) {F₁ F₂ : C ⥤ D} (e : F₁ ≅ F₂) : + W.is_inverted_by F₁ ↔ W.is_inverted_by F₂ := +begin + suffices : ∀ (X Y : C) (f : X ⟶ Y), is_iso (F₁.map f) ↔ is_iso (F₂.map f), + { split, + exact λ h X Y f hf, by { rw ← this, exact h f hf, }, + exact λ h X Y f hf, by { rw this, exact h f hf, }, }, + intros X Y f, + exact (respects_iso.isomorphisms D).arrow_mk_iso_iff + (arrow.iso_mk (e.app X) (e.app Y) (by simp)), +end + +section diagonal + +variables [has_pullbacks C] {P : morphism_property C} + +/-- For `P : morphism_property C`, `P.diagonal` is a morphism property that holds for `f : X ⟶ Y` +whenever `P` holds for `X ⟶ Y xₓ Y`. -/ +def diagonal (P : morphism_property C) : morphism_property C := +λ X Y f, P (pullback.diagonal f) + +lemma diagonal_iff {X Y : C} {f : X ⟶ Y} : P.diagonal f ↔ P (pullback.diagonal f) := iff.rfl + +lemma respects_iso.diagonal (hP : P.respects_iso) : P.diagonal.respects_iso := +begin + split, + { introv H, + rwa [diagonal_iff, pullback.diagonal_comp, hP.cancel_left_is_iso, hP.cancel_left_is_iso, + ← hP.cancel_right_is_iso _ _, ← pullback.condition, hP.cancel_left_is_iso], + apply_instance }, + { introv H, + delta diagonal, + rwa [pullback.diagonal_comp, hP.cancel_right_is_iso] } +end + +lemma stable_under_composition.diagonal + (hP : stable_under_composition P) (hP' : respects_iso P) (hP'' : stable_under_base_change P) : + P.diagonal.stable_under_composition := +begin + introv X h₁ h₂, + rw [diagonal_iff, pullback.diagonal_comp], + apply hP, { assumption }, + rw hP'.cancel_left_is_iso, + apply hP''.snd, + assumption +end + +lemma stable_under_base_change.diagonal + (hP : stable_under_base_change P) (hP' : respects_iso P) : + P.diagonal.stable_under_base_change := +stable_under_base_change.mk hP'.diagonal +begin + introv h, + rw [diagonal_iff, diagonal_pullback_fst, hP'.cancel_left_is_iso, hP'.cancel_right_is_iso], + convert hP.base_change_map f _ _; simp; assumption +end + +end diagonal + +section universally + +/-- `P.universally` holds for a morphism `f : X ⟶ Y` iff `P` holds for all `X ×[Y] Y' ⟶ Y'`. -/ +def universally (P : morphism_property C) : morphism_property C := +λ X Y f, ∀ ⦃X' Y' : C⦄ (i₁ : X' ⟶ X) (i₂ : Y' ⟶ Y) (f' : X' ⟶ Y') + (h : is_pullback f' i₁ i₂ f), P f' + +lemma universally_respects_iso (P : morphism_property C) : + P.universally.respects_iso := +begin + constructor, + { intros X Y Z e f hf X' Z' i₁ i₂ f' H, + have : is_pullback (𝟙 _) (i₁ ≫ e.hom) i₁ e.inv := is_pullback.of_horiz_is_iso + ⟨by rw [category.id_comp, category.assoc, e.hom_inv_id, category.comp_id]⟩, + replace this := this.paste_horiz H, + rw [iso.inv_hom_id_assoc, category.id_comp] at this, + exact hf _ _ _ this }, + { intros X Y Z e f hf X' Z' i₁ i₂ f' H, + have : is_pullback (𝟙 _) i₂ (i₂ ≫ e.inv) e.inv := + is_pullback.of_horiz_is_iso ⟨category.id_comp _⟩, + replace this := H.paste_horiz this, + rw [category.assoc, iso.hom_inv_id, category.comp_id, category.comp_id] at this, + exact hf _ _ _ this }, +end + +lemma universally_stable_under_base_change (P : morphism_property C) : + P.universally.stable_under_base_change := +λ X Y Y' S f g f' g' H h₁ Y'' X'' i₁ i₂ f'' H', h₁ _ _ _ (H'.paste_vert H.flip) + +lemma stable_under_composition.universally [has_pullbacks C] + {P : morphism_property C} (hP : P.stable_under_composition) : + P.universally.stable_under_composition := +begin + intros X Y Z f g hf hg X' Z' i₁ i₂ f' H, + have := pullback.lift_fst _ _ (H.w.trans (category.assoc _ _ _).symm), + rw ← this at H ⊢, + apply hP _ _ _ (hg _ _ _ $ is_pullback.of_has_pullback _ _), + exact hf _ _ _ (H.of_right (pullback.lift_snd _ _ _) (is_pullback.of_has_pullback i₂ g)) +end + +lemma universally_le (P : morphism_property C) : + P.universally ≤ P := +begin + intros X Y f hf, + exact hf (𝟙 _) (𝟙 _) _ (is_pullback.of_vert_is_iso ⟨by rw [category.comp_id, category.id_comp]⟩) +end + +lemma stable_under_base_change.universally_eq + {P : morphism_property C} (hP : P.stable_under_base_change) : + P.universally = P := +P.universally_le.antisymm $ λ X Y f hf X' Y' i₁ i₂ f' H, hP H.flip hf + +lemma universally_mono : monotone (universally : morphism_property C → morphism_property C) := +λ P₁ P₂ h X Y f h₁ X' Y' i₁ i₂ f' H, h _ _ _ (h₁ _ _ _ H) + +end universally + +section bijective + +variables [concrete_category C] + +open function + +local attribute [instance] concrete_category.has_coe_to_fun concrete_category.has_coe_to_sort + +variable (C) + +/-- Injectiveness (in a concrete category) as a `morphism_property` -/ +protected def injective : morphism_property C := λ X Y f, injective f + +/-- Surjectiveness (in a concrete category) as a `morphism_property` -/ +protected def surjective : morphism_property C := λ X Y f, surjective f + +/-- Bijectiveness (in a concrete category) as a `morphism_property` -/ +protected def bijective : morphism_property C := λ X Y f, bijective f + +lemma bijective_eq_sup : morphism_property.bijective C = + morphism_property.injective C ⊓ morphism_property.surjective C := +rfl + +lemma injective_stable_under_composition : + (morphism_property.injective C).stable_under_composition := +λ X Y Z f g hf hg, by { delta morphism_property.injective, rw coe_comp, exact hg.comp hf } + +lemma surjective_stable_under_composition : + (morphism_property.surjective C).stable_under_composition := +λ X Y Z f g hf hg, by { delta morphism_property.surjective, rw coe_comp, exact hg.comp hf } + +lemma bijective_stable_under_composition : + (morphism_property.bijective C).stable_under_composition := +λ X Y Z f g hf hg, by { delta morphism_property.bijective, rw coe_comp, exact hg.comp hf } + +lemma injective_respects_iso : + (morphism_property.injective C).respects_iso := +(injective_stable_under_composition C).respects_iso + (λ X Y e, ((forget C).map_iso e).to_equiv.injective) + +lemma surjective_respects_iso : + (morphism_property.surjective C).respects_iso := +(surjective_stable_under_composition C).respects_iso + (λ X Y e, ((forget C).map_iso e).to_equiv.surjective) + +lemma bijective_respects_iso : + (morphism_property.bijective C).respects_iso := +(bijective_stable_under_composition C).respects_iso + (λ X Y e, ((forget C).map_iso e).to_equiv.bijective) + +end bijective + +end morphism_property + +end category_theory diff --git a/src/category_theory/natural_isomorphism.lean b/src/category_theory/natural_isomorphism.lean index d66413d606f11..7b44dc68f968b 100644 --- a/src/category_theory/natural_isomorphism.lean +++ b/src/category_theory/natural_isomorphism.lean @@ -9,6 +9,9 @@ import category_theory.isomorphism /-! # Natural isomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For the most part, natural isomorphisms are just another sort of isomorphism. We provide some special support for extracting components: @@ -155,11 +158,15 @@ instance is_iso_app_of_is_iso (α : F ⟶ G) [is_iso α] (X) : is_iso (α.app X) @[simp] lemma is_iso_inv_app (α : F ⟶ G) [is_iso α] (X) : (inv α).app X = inv (α.app X) := by { ext, rw ←nat_trans.comp_app, simp, } +@[simp] lemma inv_map_inv_app (F : C ⥤ D ⥤ E) {X Y : C} (e : X ≅ Y) (Z : D) : + inv ((F.map e.inv).app Z) = (F.map e.hom).app Z := +by { ext, simp, } + /-- Construct a natural isomorphism between functors by giving object level isomorphisms, and checking naturality only in the forward direction. -/ -def of_components (app : ∀ X : C, F.obj X ≅ G.obj X) +@[simps] def of_components (app : ∀ X : C, F.obj X ≅ G.obj X) (naturality : ∀ {X Y : C} (f : X ⟶ Y), F.map f ≫ (app Y).hom = (app X).hom ≫ G.map f) : F ≅ G := { hom := { app := λ X, (app X).hom }, @@ -175,11 +182,6 @@ def of_components (app : ∀ X : C, F.obj X ≅ G.obj X) @[simp] lemma of_components.app (app' : ∀ X : C, F.obj X ≅ G.obj X) (naturality) (X) : (of_components app' naturality).app X = app' X := by tidy -@[simp] lemma of_components.hom_app (app : ∀ X : C, F.obj X ≅ G.obj X) (naturality) (X) : - (of_components app naturality).hom.app X = (app X).hom := rfl -@[simp] lemma of_components.inv_app (app : ∀ X : C, F.obj X ≅ G.obj X) (naturality) (X) : - (of_components app naturality).inv.app X = (app X).inv := -by simp [of_components] /-- A natural transformation is an isomorphism if all its components are isomorphisms. @@ -189,6 +191,7 @@ lemma is_iso_of_is_iso_app (α : F ⟶ G) [∀ X : C, is_iso (α.app X)] : is_is ⟨(is_iso.of_iso (of_components (λ X, as_iso (α.app X)) (by tidy))).1⟩ /-- Horizontal composition of natural isomorphisms. -/ +@[simps] def hcomp {F G : C ⥤ D} {H I : D ⥤ E} (α : F ≅ G) (β : H ≅ I) : F ⋙ H ≅ G ⋙ I := begin refine ⟨α.hom ◫ β.hom, α.inv ◫ β.inv, _, _⟩, @@ -196,6 +199,18 @@ begin ext, rw [←nat_trans.exchange], simp, refl end +lemma is_iso_map_iff {F₁ F₂ : C ⥤ D} (e : F₁ ≅ F₂) {X Y : C} (f : X ⟶ Y) : + is_iso (F₁.map f) ↔ is_iso (F₂.map f) := +begin + revert F₁ F₂, + suffices : ∀ {F₁ F₂ : C ⥤ D} (e : F₁ ≅ F₂) (hf : is_iso (F₁.map f)), is_iso (F₂.map f), + { exact λ F₁ F₂ e, ⟨this e, this e.symm⟩, }, + introsI F₁ F₂ e hf, + refine is_iso.mk ⟨e.inv.app Y ≫ inv (F₁.map f) ≫ e.hom.app X, _, _⟩, + { simp only [nat_trans.naturality_assoc, is_iso.hom_inv_id_assoc, iso.inv_hom_id_app], }, + { simp only [assoc, ← e.hom.naturality, is_iso.inv_hom_id_assoc, iso.inv_hom_id_app], }, +end + end nat_iso end category_theory diff --git a/src/category_theory/natural_transformation.lean b/src/category_theory/natural_transformation.lean index f79814846df4d..872826db90422 100644 --- a/src/category_theory/natural_transformation.lean +++ b/src/category_theory/natural_transformation.lean @@ -3,11 +3,14 @@ Copyright (c) 2017 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn -/ -import category_theory.functor +import category_theory.functor.basic /-! # Natural transformations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines natural transformations between functors. A natural transformation `α : nat_trans F G` consists of morphisms `α.app X : F.obj X ⟶ G.obj X`, diff --git a/src/category_theory/noetherian.lean b/src/category_theory/noetherian.lean new file mode 100644 index 0000000000000..a622eb69677e4 --- /dev/null +++ b/src/category_theory/noetherian.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import category_theory.subobject.lattice +import category_theory.essentially_small +import category_theory.simple + +/-! +# Artinian and noetherian categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +An artinian category is a category in which objects do not +have infinite decreasing sequences of subobjects. + +A noetherian category is a category in which objects do not +have infinite increasing sequences of subobjects. + +We show that any nonzero artinian object has a simple subobject. + +## Future work +The Jordan-Hölder theorem, following https://stacks.math.columbia.edu/tag/0FCK. +-/ + +namespace category_theory +open category_theory.limits + +variables {C : Type*} [category C] + +/-- +A noetherian object is an object +which does not have infinite increasing sequences of subobjects. + +See https://stacks.math.columbia.edu/tag/0FCG +-/ +class noetherian_object (X : C) : Prop := +(subobject_gt_well_founded : well_founded ((>) : subobject X → subobject X → Prop)) + +/-- +An artinian object is an object +which does not have infinite decreasing sequences of subobjects. + +See https://stacks.math.columbia.edu/tag/0FCF +-/ +class artinian_object (X : C) : Prop := +(subobject_lt_well_founded [] : well_founded ((<) : subobject X → subobject X → Prop)) + +variables (C) + +/-- A category is noetherian if it is essentially small and all objects are noetherian. -/ +class noetherian extends essentially_small C := +(noetherian_object : ∀ (X : C), noetherian_object X) + +attribute [priority 100, instance] noetherian.noetherian_object + +/-- A category is artinian if it is essentially small and all objects are artinian. -/ +class artinian extends essentially_small C := +(artinian_object : ∀ (X : C), artinian_object X) + +attribute [priority 100, instance] artinian.artinian_object + +variables {C} + +open subobject +variables [has_zero_morphisms C] [has_zero_object C] + +lemma exists_simple_subobject {X : C} [artinian_object X] (h : ¬ is_zero X) : + ∃ (Y : subobject X), simple (Y : C) := +begin + haveI : nontrivial (subobject X) := nontrivial_of_not_is_zero h, + haveI := is_atomic_of_order_bot_well_founded_lt (artinian_object.subobject_lt_well_founded X), + have := is_atomic.eq_bot_or_exists_atom_le (⊤ : subobject X), + obtain ⟨Y, s⟩ := (is_atomic.eq_bot_or_exists_atom_le (⊤ : subobject X)).resolve_left top_ne_bot, + exact ⟨Y, (subobject_simple_iff_is_atom _).mpr s.1⟩, +end + +/-- Choose an arbitrary simple subobject of a non-zero artinian object. -/ +noncomputable def simple_subobject {X : C} [artinian_object X] (h : ¬ is_zero X) : C := +(exists_simple_subobject h).some + +/-- The monomorphism from the arbitrary simple subobject of a non-zero artinian object. -/ +@[derive mono] +noncomputable def simple_subobject_arrow {X : C} [artinian_object X] (h : ¬ is_zero X) : + simple_subobject h ⟶ X := +(exists_simple_subobject h).some.arrow + +instance {X : C} [artinian_object X] (h : ¬ is_zero X) : simple (simple_subobject h) := +(exists_simple_subobject h).some_spec + +end category_theory diff --git a/src/category_theory/opposites.lean b/src/category_theory/opposites.lean index e5981c0bb7bf6..b65f710780460 100644 --- a/src/category_theory/opposites.lean +++ b/src/category_theory/opposites.lean @@ -8,6 +8,9 @@ import category_theory.equivalence /-! # Opposite categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide a category instance on `Cᵒᵖ`. The morphisms `X ⟶ Y` are defined to be the morphisms `unop Y ⟶ unop X` in `C`. @@ -222,6 +225,10 @@ nat_iso.of_components (λ X, iso.refl _) (by tidy) def right_op_left_op_iso (F : Cᵒᵖ ⥤ D) : F.right_op.left_op ≅ F := nat_iso.of_components (λ X, iso.refl _) (by tidy) +/-- Whenever possible, it is advisable to use the isomorphism `right_op_left_op_iso` +instead of this equality of functors. -/ +lemma right_op_left_op_eq (F : Cᵒᵖ ⥤ D) : F.right_op.left_op = F := by { cases F, refl, } + end end functor @@ -442,6 +449,20 @@ instance subsingleton_of_unop (A B : Cᵒᵖ) [subsingleton (unop B ⟶ unop A)] instance decidable_eq_of_unop (A B : Cᵒᵖ) [decidable_eq (unop B ⟶ unop A)] : decidable_eq (A ⟶ B) := (op_equiv A B).decidable_eq +/-- +The equivalence between isomorphisms of the form `A ≅ B` and `B.unop ≅ A.unop`. + +Note this is definitionally the same as the other three variants: +* `(opposite.op A ≅ B) ≃ (B.unop ≅ A)` +* `(A ≅ opposite.op B) ≃ (B ≅ A.unop)` +* `(opposite.op A ≅ opposite.op B) ≃ (B ≅ A)` +-/ +@[simps] def iso_op_equiv (A B : Cᵒᵖ) : (A ≅ B) ≃ (B.unop ≅ A.unop) := +{ to_fun := λ f, f.unop, + inv_fun := λ g, g.op, + left_inv := λ _, by { ext, refl, }, + right_inv := λ _, by { ext, refl, } } + namespace functor variables (C) diff --git a/src/category_theory/over.lean b/src/category_theory/over.lean index fdd8918063f6c..20dc99aa1b98a 100644 --- a/src/category_theory/over.lean +++ b/src/category_theory/over.lean @@ -6,11 +6,14 @@ Authors: Johan Commelin, Bhavik Mehta import category_theory.structured_arrow import category_theory.punit import category_theory.functor.reflects_isomorphisms -import category_theory.epi_mono +import category_theory.functor.epi_mono /-! # Over and under categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Over (and under) categories are special cases of comma categories. * If `L` is the identity functor and `R` is a constant functor, then `comma L R` is the "slice" or "over" category over the object `R` maps to. @@ -40,6 +43,7 @@ def over (X : T) := costructured_arrow (𝟭 T) X instance over.inhabited [inhabited T] : inhabited (over (default : T)) := { default := { left := default, + right := default, hom := 𝟙 _ } } namespace over @@ -50,7 +54,7 @@ variables {X : T} (h : f.left = g.left) : f = g := by tidy -@[simp] lemma over_right (U : over X) : U.right = punit.star := by tidy +@[simp] lemma over_right (U : over X) : U.right = ⟨⟨⟩⟩ := by tidy @[simp] lemma id_left (U : over X) : comma_morphism.left (𝟙 U) = 𝟙 U.left := rfl @[simp] lemma comp_left (a b c : over X) (f : a ⟶ b) (g : b ⟶ c) : @@ -60,7 +64,7 @@ by tidy by have := f.w; tidy /-- To give an object in the over category, it suffices to give a morphism with codomain `X`. -/ -@[simps] +@[simps left hom] def mk {X Y : T} (f : Y ⟶ X) : over X := costructured_arrow.mk f @@ -143,11 +147,12 @@ instance forget_faithful : faithful (forget X) := {}. /-- If `k.left` is an epimorphism, then `k` is an epimorphism. In other words, `over.forget X` reflects epimorphisms. -The converse does not hold without additional assumptions on the underlying category. +The converse does not hold without additional assumptions on the underlying category, see +`category_theory.over.epi_left_of_epi`. -/ --- TODO: Show the converse holds if `T` has binary products or pushouts. +-- TODO: Show the converse holds if `T` has binary products. lemma epi_of_epi_left {f g : over X} (k : f ⟶ g) [hk : epi k.left] : epi k := -faithful_reflects_epi (forget X) hk +(forget X).epi_of_epi_map hk /-- If `k.left` is a monomorphism, then `k` is a monomorphism. In other words, `over.forget X` reflects @@ -157,7 +162,7 @@ The converse of `category_theory.over.mono_left_of_mono`. This lemma is not an instance, to avoid loops in type class inference. -/ lemma mono_of_mono_left {f g : over X} (k : f ⟶ g) [hk : mono k.left] : mono k := -faithful_reflects_mono (forget X) hk +(forget X).mono_of_mono_map hk /-- If `k` is a monomorphism, then `k.left` is a monomorphism. In other words, `over.forget X` preserves @@ -221,9 +226,7 @@ variables {D : Type u₂} [category.{v₂} D] @[simps] def post (F : T ⥤ D) : over X ⥤ over (F.obj X) := { obj := λ Y, mk $ F.map Y.hom, - map := λ Y₁ Y₂ f, - { left := F.map f.left, - w' := by tidy; erw [← F.map_comp, w] } } + map := λ Y₁ Y₂ f, over.hom_mk (F.map f.left) (by tidy; erw [← F.map_comp, w]) } end @@ -237,7 +240,8 @@ def under (X : T) := structured_arrow X (𝟭 T) -- Satisfying the inhabited linter instance under.inhabited [inhabited T] : inhabited (under (default : T)) := { default := - { right := default, + { left := default, + right := default, hom := 𝟙 _ } } namespace under @@ -248,7 +252,7 @@ variables {X : T} (h : f.right = g.right) : f = g := by tidy -@[simp] lemma under_left (U : under X) : U.left = punit.star := by tidy +@[simp] lemma under_left (U : under X) : U.left = ⟨⟨⟩⟩ := by tidy @[simp] lemma id_right (U : under X) : comma_morphism.right (𝟙 U) = 𝟙 U.right := rfl @[simp] lemma comp_right (a b c : under X) (f : a ⟶ b) (g : b ⟶ c) : @@ -258,7 +262,7 @@ by tidy by have := f.w; tidy /-- To give an object in the under category, it suffices to give an arrow with domain `X`. -/ -@[simps] +@[simps right hom] def mk {X Y : T} (f : X ⟶ Y) : under X := structured_arrow.mk f @@ -324,6 +328,43 @@ instance forget_reflects_iso : reflects_isomorphisms (forget X) := instance forget_faithful : faithful (forget X) := {}. +/-- +If `k.right` is a monomorphism, then `k` is a monomorphism. In other words, `under.forget X` +reflects epimorphisms. +The converse does not hold without additional assumptions on the underlying category, see +`category_theory.under.mono_right_of_mono`. +-/ +-- TODO: Show the converse holds if `T` has binary coproducts. +lemma mono_of_mono_right {f g : under X} (k : f ⟶ g) [hk : mono k.right] : mono k := +(forget X).mono_of_mono_map hk + +/-- +If `k.right` is a epimorphism, then `k` is a epimorphism. In other words, `under.forget X` reflects +epimorphisms. +The converse of `category_theory.under.epi_right_of_epi`. + +This lemma is not an instance, to avoid loops in type class inference. +-/ +lemma epi_of_epi_right {f g : under X} (k : f ⟶ g) [hk : epi k.right] : epi k := +(forget X).epi_of_epi_map hk + +/-- +If `k` is a epimorphism, then `k.right` is a epimorphism. In other words, `under.forget X` preserves +epimorphisms. +The converse of `category_theory.under.epi_of_epi_right`. +-/ +instance epi_right_of_epi {f g : under X} (k : f ⟶ g) [epi k] : epi k.right := +begin + refine ⟨λ (Y : T) l m a, _⟩, + let l' : g ⟶ mk (g.hom ≫ m) := hom_mk l + (by { dsimp, rw [←under.w k, category.assoc, a, category.assoc] }), + suffices : l' = hom_mk m, + { apply congr_arg comma_morphism.right this }, + rw ← cancel_epi k, + ext, + apply a, +end + section variables {D : Type u₂} [category.{v₂} D] @@ -331,9 +372,7 @@ variables {D : Type u₂} [category.{v₂} D] @[simps] def post {X : T} (F : T ⥤ D) : under X ⥤ under (F.obj X) := { obj := λ Y, mk $ F.map Y.hom, - map := λ Y₁ Y₂ f, - { right := F.map f.right, - w' := by tidy; erw [← F.map_comp, w] } } + map := λ Y₁ Y₂ f, under.hom_mk (F.map f.right) (by tidy; erw [← F.map_comp, w]), } end diff --git a/src/category_theory/path_category.lean b/src/category_theory/path_category.lean index 963973e54270a..6579b6eb0d858 100644 --- a/src/category_theory/path_category.lean +++ b/src/category_theory/path_category.lean @@ -9,6 +9,9 @@ import combinatorics.quiver.path /-! # The category paths on a quiver. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. When `C` is a quiver, `paths C` is the category of paths. ## When the quiver is itself a category @@ -46,12 +49,60 @@ variables {V} The inclusion of a quiver `V` into its path category, as a prefunctor. -/ @[simps] -def of : prefunctor V (paths V) := +def of : V ⥤q (paths V) := { obj := λ X, X, map := λ X Y f, f.to_path, } local attribute [ext] functor.ext +/-- Any prefunctor from `V` lifts to a functor from `paths V` -/ +def lift {C} [category C] (φ : V ⥤q C) : paths V ⥤ C := +{ obj := φ.obj, + map := λ X Y f, @quiver.path.rec V _ X (λ Y f, φ.obj X ⟶ φ.obj Y) (𝟙 $ φ.obj X) + (λ Y Z p f ihp, ihp ≫ (φ.map f)) Y f, + map_id' := λ X, by { refl, }, + map_comp' := λ X Y Z f g, by + { induction g with _ _ g' p ih _ _ _, + { rw category.comp_id, refl, }, + { have : f ≫ g'.cons p = (f ≫ g').cons p, by apply quiver.path.comp_cons, + rw this, simp only, rw [ih, category.assoc], } } } + +@[simp] lemma lift_nil {C} [category C] (φ : V ⥤q C) (X : V) : + (lift φ).map (quiver.path.nil) = 𝟙 (φ.obj X) := rfl + +@[simp] lemma lift_cons {C} [category C] (φ : V ⥤q C) {X Y Z : V} + (p : quiver.path X Y) (f : Y ⟶ Z) : + (lift φ).map (p.cons f) = (lift φ).map p ≫ (φ.map f) := rfl + +@[simp] lemma lift_to_path {C} [category C] (φ : V ⥤q C) {X Y : V} (f : X ⟶ Y) : + (lift φ).map f.to_path = φ.map f := by {dsimp [quiver.hom.to_path,lift], simp, } + +lemma lift_spec {C} [category C] (φ : V ⥤q C) : + of ⋙q (lift φ).to_prefunctor = φ := +begin + apply prefunctor.ext, rotate, + { rintro X, refl, }, + { rintro X Y f, rcases φ with ⟨φo,φm⟩, + dsimp [lift, quiver.hom.to_path], + simp only [category.id_comp], }, +end + +lemma lift_unique {C} [category C] (φ : V ⥤q C) (Φ : paths V ⥤ C) + (hΦ : of ⋙q Φ.to_prefunctor = φ) : Φ = lift φ := +begin + subst_vars, + apply functor.ext, rotate, + { rintro X, refl, }, + { rintro X Y f, + dsimp [lift], + induction f with _ _ p f' ih, + { simp only [category.comp_id], apply functor.map_id, }, + { simp only [category.comp_id, category.id_comp] at ih ⊢, + have : Φ.map (p.cons f') = Φ.map p ≫ (Φ.map (f'.to_path)), by + { convert functor.map_comp Φ p (f'.to_path), }, + rw [this, ih], }, }, +end + /-- Two functors out of a path category are equal when they agree on singleton paths. -/ @[ext] lemma ext_functor {C} [category C] @@ -74,8 +125,7 @@ end paths variables (W : Type u₂) [quiver.{v₂+1} W] -- A restatement of `prefunctor.map_path_comp` using `f ≫ g` instead of `f.comp g`. -@[simp] lemma prefunctor.map_path_comp' (F : prefunctor V W) - {X Y Z : paths V} (f : X ⟶ Y) (g : Y ⟶ Z) : +@[simp] lemma prefunctor.map_path_comp' (F : V ⥤q W) {X Y Z : paths V} (f : X ⟶ Y) (g : Y ⟶ Z) : F.map_path (f ≫ g) = (F.map_path f).comp (F.map_path g) := prefunctor.map_path_comp _ _ _ diff --git a/src/category_theory/pempty.lean b/src/category_theory/pempty.lean index 82c31284a288c..003d021913812 100644 --- a/src/category_theory/pempty.lean +++ b/src/category_theory/pempty.lean @@ -8,6 +8,9 @@ import category_theory.discrete_category /-! # The empty category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines a category structure on `pempty`, and the unique functor `pempty ⥤ C` for any category `C`. -/ @@ -21,8 +24,8 @@ variables (C : Type u) [category.{v} C] /-- Equivalence between two empty categories. -/ def empty_equivalence : discrete.{w} pempty ≌ discrete.{v} pempty := equivalence.mk -{ obj := pempty.elim, map := λ x, x.elim } -{ obj := pempty.elim, map := λ x, x.elim } +{ obj := pempty.elim ∘ discrete.as, map := λ x, x.as.elim } +{ obj := pempty.elim ∘ discrete.as, map := λ x, x.as.elim } (by tidy) (by tidy) /-- The canonical functor out of the empty category. -/ @@ -31,7 +34,7 @@ def empty : discrete.{w} pempty ⥤ C := discrete.functor pempty.elim variable {C} /-- Any two functors out of the empty category are isomorphic. -/ def empty_ext (F G : discrete.{w} pempty ⥤ C) : F ≅ G := -discrete.nat_iso (λ x, pempty.elim x) +discrete.nat_iso (λ x, x.as.elim) /-- Any functor out of the empty category is isomorphic to the canonical functor from the empty @@ -45,7 +48,7 @@ Any two functors out of the empty category are *equal*. You probably want to use `empty_ext` instead of this. -/ lemma empty_ext' (F G : discrete.{w} pempty ⥤ C) : F = G := -functor.ext (λ x, x.elim) (λ x _ _, x.elim) +functor.ext (λ x, x.as.elim) (λ x _ _, x.as.elim) end functor diff --git a/src/category_theory/pi/basic.lean b/src/category_theory/pi/basic.lean index 74edacb8e577b..f5f844e1027c9 100644 --- a/src/category_theory/pi/basic.lean +++ b/src/category_theory/pi/basic.lean @@ -5,10 +5,14 @@ Authors: Simon Hudon, Scott Morrison -/ import category_theory.natural_isomorphism import category_theory.eq_to_hom +import data.sum.basic /-! # Categories of indexed families of objects. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the pointwise category structure on indexed families of objects in a category (and also the dependent generalization). diff --git a/src/category_theory/preadditive/Mat.lean b/src/category_theory/preadditive/Mat.lean index c9265e87ecf09..3794457cb5e65 100644 --- a/src/category_theory/preadditive/Mat.lean +++ b/src/category_theory/preadditive/Mat.lean @@ -6,7 +6,7 @@ Authors: Scott Morrison import algebra.big_operators.basic import algebra.big_operators.pi import category_theory.limits.shapes.biproducts -import category_theory.preadditive +import category_theory.preadditive.basic import category_theory.preadditive.additive_functor import data.matrix.dmatrix import data.matrix.basic @@ -17,6 +17,9 @@ import algebra.opposites /-! # Matrices over a category. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + When `C` is a preadditive category, `Mat_ C` is the preadditive category whose objects are finite tuples of objects in `C`, and whose morphisms are matrices of morphisms from `C`. @@ -48,7 +51,7 @@ Ideally this would conveniently interact with both `Mat_` and `matrix`. -/ open category_theory category_theory.preadditive -open_locale big_operators +open_locale big_operators classical noncomputable theory namespace category_theory @@ -59,20 +62,19 @@ variables (C : Type u₁) [category.{v₁} C] [preadditive C] /-- An object in `Mat_ C` is a finite tuple of objects in `C`. -/ -structure Mat_ : Type (max (v₁+1) u₁) := -(ι : Type v₁) +structure Mat_ := +(ι : Type) [F : fintype ι] -[D : decidable_eq ι] (X : ι → C) -attribute [instance] Mat_.F Mat_.D +attribute [instance] Mat_.F namespace Mat_ variables {C} /-- A morphism in `Mat_ C` is a dependently typed matrix of morphisms. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def hom (M N : Mat_ C) : Type v₁ := dmatrix M.ι N.ι (λ i j, M.X i ⟶ N.X j) namespace hom @@ -145,15 +147,15 @@ even though the construction we give uses a sigma type. See however `iso_biproduct_embedding`. -/ instance has_finite_biproducts : has_finite_biproducts (Mat_ C) := -{ has_biproducts_of_shape := λ J 𝒟 ℱ, by exactI +{ out := λ n, { has_biproduct := λ f, has_biproduct_of_total - { X := ⟨Σ j : J, (f j).ι, λ p, (f p.1).X p.2⟩, + { X := ⟨Σ j, (f j).ι, λ p, (f p.1).X p.2⟩, π := λ j x y, begin dsimp at x ⊢, refine if h : x.1 = j then _ else 0, - refine if h' : (@eq.rec J x.1 (λ j, (f j).ι) x.2 _ h) = y then _ else 0, + refine if h' : (@eq.rec (fin n) x.1 (λ j, (f j).ι) x.2 _ h) = y then _ else 0, apply eq_to_hom, substs h h', -- Notice we were careful not to use `subst` until we had a goal in `Prop`. end, @@ -161,7 +163,7 @@ instance has_finite_biproducts : has_finite_biproducts (Mat_ C) := begin dsimp at y ⊢, refine if h : y.1 = j then _ else 0, - refine if h' : (@eq.rec J y.1 (λ j, (f j).ι) y.2 _ h) = x then _ else 0, + refine if h' : (@eq.rec _ y.1 (λ j, (f j).ι) y.2 _ h) = x then _ else 0, apply eq_to_hom, substs h h', end, @@ -210,7 +212,7 @@ end Mat_ namespace functor variables {C} {D : Type*} [category.{v₁} D] [preadditive D] -local attribute [simp] Mat_.id_apply +local attribute [simp] Mat_.id_apply eq_to_hom_map /-- A functor induces a functor of matrix categories. @@ -407,9 +409,7 @@ nat_iso.of_components congr, ext j k ⟨⟩, dsimp, simp, - convert α.hom.naturality (f j k), - erw [biproduct.matrix_π], - simp, + exact α.hom.naturality (f j k), end). -- TODO is there some uniqueness statement for the natural isomorphism in `lift_unique`? @@ -506,7 +506,7 @@ instance (M N : Mat R) : inhabited (M ⟶ N) := ⟨λ (i : M) (j : N), (0 : R) end -variables (R : Type u) [ring R] +variables (R : Type) [ring R] open opposite diff --git a/src/category_theory/preadditive/additive_functor.lean b/src/category_theory/preadditive/additive_functor.lean index fa8a760ce267e..34347aa14e68c 100644 --- a/src/category_theory/preadditive/additive_functor.lean +++ b/src/category_theory/preadditive/additive_functor.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Adam Topaz. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Adam Topaz, Scott Morrison -/ -import category_theory.limits.preserves.shapes.biproducts +import category_theory.limits.exact_functor +import category_theory.limits.preserves.finite +import category_theory.preadditive.biproducts import category_theory.preadditive.functor_category /-! # Additive Functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A functor between two preadditive categories is called *additive* provided that the induced map on hom types is a morphism of abelian groups. @@ -26,6 +31,8 @@ We also define the category of bundled additive functors. -/ +universes v₁ v₂ u₁ u₂ + namespace category_theory /-- A functor `F` is additive provided `F.map` is an additive homomorphism. -/ @@ -65,15 +72,18 @@ instance {E : Type*} [category E] [preadditive E] (G : D ⥤ E) [functor.additiv @[simp] lemma map_neg {X Y : C} {f : X ⟶ Y} : F.map (-f) = - F.map f := -F.map_add_hom.map_neg _ +(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_neg _ @[simp] lemma map_sub {X Y : C} {f g : X ⟶ Y} : F.map (f - g) = F.map f - F.map g := -F.map_add_hom.map_sub _ _ +(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_sub _ _ + +lemma map_nsmul {X Y : C} {f : X ⟶ Y} {n : ℕ} : F.map (n • f) = n • F.map f := +(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_nsmul _ _ -- You can alternatively just use `functor.map_smul` here, with an explicit `(r : ℤ)` argument. lemma map_zsmul {X Y : C} {f : X ⟶ Y} {r : ℤ} : F.map (r • f) = r • F.map f := -F.map_add_hom.map_zsmul _ _ +(F.map_add_hom : (X ⟶ Y) →+ (F.obj X ⟶ F.obj Y)).map_zsmul _ _ open_locale big_operators @@ -91,14 +101,16 @@ instance induced_functor_additive : functor.additive (induced_functor F) := {} end induced_category +instance full_subcategory_inclusion_additive + {C : Type*} [category C] [preadditive C] (Z : C → Prop) : + (full_subcategory_inclusion Z).additive := {} + section -- To talk about preservation of biproducts we need to specify universes explicitly. noncomputable theory -universes v u₁ u₂ - -variables {C : Type u₁} {D : Type u₂} [category.{v} C] [category.{v} D] +variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D] [preadditive C] [preadditive D] (F : C ⥤ D) open category_theory.limits @@ -106,7 +118,7 @@ open category_theory.preadditive @[priority 100] instance preserves_finite_biproducts_of_additive [additive F] : preserves_finite_biproducts F := -{ preserves := λ J _ _, +{ preserves := λ J _, { preserves := λ f, { preserves := λ b hb, by exactI is_bilimit_of_total _ begin @@ -114,7 +126,9 @@ instance preserves_finite_biproducts_of_additive [additive F] : preserves_finite dsimp only [map_bicone_X], simp_rw [← F.map_id], refine congr_arg _ (hb.is_limit.hom_ext (λ j, hb.is_colimit.hom_ext (λ j', _))), - simp [sum_comp, comp_sum, bicone.ι_π, comp_dite, dite_comp] + cases j, cases j', + dsimp only [limits.bicone.to_cone_π_app], + simp [sum_comp, comp_sum, bicone.ι_π, comp_dite, dite_comp], end } } } lemma additive_of_preserves_binary_biproducts [has_binary_biproducts C] [preserves_zero_morphisms F] @@ -140,14 +154,14 @@ section variables (C D : Type*) [category C] [category D] [preadditive C] [preadditive D] /-- Bundled additive functors. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def AdditiveFunctor := -{ F : C ⥤ D // functor.additive F } +full_subcategory (λ (F : C ⥤ D), F.additive) infixr ` ⥤+ `:26 := AdditiveFunctor instance : preadditive (C ⥤+ D) := -preadditive.induced_category.category _ +preadditive.induced_category _ /-- An additive functor is in particular a functor. -/ @[derive full, derive faithful] @@ -185,6 +199,54 @@ F.2 end +section exact +open category_theory.limits + +variables (C : Type u₁) (D : Type u₂) [category.{v₁} C] [category.{v₂} D] [preadditive C] +variables [preadditive D] [has_zero_object C] [has_zero_object D] [has_binary_biproducts C] + +section +local attribute [instance] preserves_binary_biproducts_of_preserves_binary_products +local attribute [instance] preserves_binary_biproducts_of_preserves_binary_coproducts + +/-- Turn a left exact functor into an additive functor. -/ +@[derive full, derive faithful] +def AdditiveFunctor.of_left_exact : (C ⥤ₗ D) ⥤ (C ⥤+ D) := +full_subcategory.map (λ F h, let hF := classical.choice h in + by exactI functor.additive_of_preserves_binary_biproducts F) + +/-- Turn a right exact functor into an additive functor. -/ +@[derive full, derive faithful] +def AdditiveFunctor.of_right_exact : (C ⥤ᵣ D) ⥤ (C ⥤+ D) := +full_subcategory.map (λ F h, let hF := classical.choice h in + by exactI functor.additive_of_preserves_binary_biproducts F) + +/-- Turn an exact functor into an additive functor. -/ +@[derive full, derive faithful] +def AdditiveFunctor.of_exact : (C ⥤ₑ D) ⥤ (C ⥤+ D) := +full_subcategory.map (λ F h, let hF := classical.choice h.1 in + by exactI functor.additive_of_preserves_binary_biproducts F) + +end + +variables {C D} + +@[simp] lemma AdditiveFunctor.of_left_exact_obj_fst (F : C ⥤ₗ D) : + ((AdditiveFunctor.of_left_exact C D).obj F).obj = F.obj := rfl +@[simp] lemma AdditiveFunctor.of_right_exact_obj_fst (F : C ⥤ᵣ D) : + ((AdditiveFunctor.of_right_exact C D).obj F).obj = F.obj := rfl +@[simp] lemma AdditiveFunctor.of_exact_obj_fst (F : C ⥤ₑ D) : + ((AdditiveFunctor.of_exact C D).obj F).obj = F.obj := rfl + +@[simp] lemma Additive_Functor.of_left_exact_map {F G : C ⥤ₗ D} (α : F ⟶ G) : + (AdditiveFunctor.of_left_exact C D).map α = α := rfl +@[simp] lemma Additive_Functor.of_right_exact_map {F G : C ⥤ᵣ D} (α : F ⟶ G) : + (AdditiveFunctor.of_right_exact C D).map α = α := rfl +@[simp] lemma Additive_Functor.of_exact_map {F G : C ⥤ₑ D} (α : F ⟶ G) : + (AdditiveFunctor.of_exact C D).map α = α := rfl + +end exact + end preadditive end category_theory diff --git a/src/category_theory/preadditive/basic.lean b/src/category_theory/preadditive/basic.lean new file mode 100644 index 0000000000000..8bf3044d5c0c5 --- /dev/null +++ b/src/category_theory/preadditive/basic.lean @@ -0,0 +1,349 @@ +/- +Copyright (c) 2020 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel, Jakob von Raumer +-/ +import algebra.big_operators.basic +import algebra.hom.group +import algebra.module.basic +import category_theory.endomorphism +import category_theory.limits.shapes.kernels + +/-! +# Preadditive categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A preadditive category is a category in which `X ⟶ Y` is an abelian group in such a way that +composition of morphisms is linear in both variables. + +This file contains a definition of preadditive category that directly encodes the definition given +above. The definition could also be phrased as follows: A preadditive category is a category +enriched over the category of Abelian groups. Once the general framework to state this in Lean is +available, the contents of this file should become obsolete. + +## Main results + +* Definition of preadditive categories and basic properties +* In a preadditive category, `f : Q ⟶ R` is mono if and only if `g ≫ f = 0 → g = 0` for all + composable `g`. +* A preadditive category with kernels has equalizers. + +## Implementation notes + +The simp normal form for negation and composition is to push negations as far as possible to +the outside. For example, `f ≫ (-g)` and `(-f) ≫ g` both become `-(f ≫ g)`, and `(-f) ≫ (-g)` +is simplified to `f ≫ g`. + +## References + +* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2] + +## Tags + +additive, preadditive, Hom group, Ab-category, Ab-enriched +-/ + +universes v u + +open category_theory.limits + +open_locale big_operators + +namespace category_theory + +variables (C : Type u) [category.{v} C] + +/-- A category is called preadditive if `P ⟶ Q` is an abelian group such that composition is + linear in both variables. -/ +class preadditive := +(hom_group : Π P Q : C, add_comm_group (P ⟶ Q) . tactic.apply_instance) +(add_comp' : ∀ (P Q R : C) (f f' : P ⟶ Q) (g : Q ⟶ R), + (f + f') ≫ g = f ≫ g + f' ≫ g . obviously) +(comp_add' : ∀ (P Q R : C) (f : P ⟶ Q) (g g' : Q ⟶ R), + f ≫ (g + g') = f ≫ g + f ≫ g' . obviously) + +attribute [instance] preadditive.hom_group +restate_axiom preadditive.add_comp' +restate_axiom preadditive.comp_add' +attribute [simp,reassoc] preadditive.add_comp +attribute [reassoc] preadditive.comp_add -- (the linter doesn't like `simp` on this lemma) +attribute [simp] preadditive.comp_add + +end category_theory + +open category_theory + +namespace category_theory +namespace preadditive + +section preadditive +open add_monoid_hom +variables {C : Type u} [category.{v} C] [preadditive C] + +section induced_category +universes u' +variables {C} {D : Type u'} (F : D → C) + +instance induced_category : preadditive.{v} (induced_category C F) := +{ hom_group := λ P Q, @preadditive.hom_group C _ _ (F P) (F Q), + add_comp' := λ P Q R f f' g, add_comp' _ _ _ _ _ _, + comp_add' := λ P Q R f g g', comp_add' _ _ _ _ _ _, } + +end induced_category + +instance full_subcategory (Z : C → Prop) : preadditive.{v} (full_subcategory Z) := +{ hom_group := λ P Q, @preadditive.hom_group C _ _ P.obj Q.obj, + add_comp' := λ P Q R f f' g, add_comp' _ _ _ _ _ _, + comp_add' := λ P Q R f g g', comp_add' _ _ _ _ _ _, } + +instance (X : C) : add_comm_group (End X) := by { dsimp [End], apply_instance, } + +instance (X : C) : ring (End X) := +{ left_distrib := λ f g h, preadditive.add_comp X X X g h f, + right_distrib := λ f g h, preadditive.comp_add X X X h f g, + ..(infer_instance : add_comm_group (End X)), + ..(infer_instance : monoid (End X)) } + +/-- Composition by a fixed left argument as a group homomorphism -/ +def left_comp {P Q : C} (R : C) (f : P ⟶ Q) : (Q ⟶ R) →+ (P ⟶ R) := +mk' (λ g, f ≫ g) $ λ g g', by simp + +/-- Composition by a fixed right argument as a group homomorphism -/ +def right_comp (P : C) {Q R : C} (g : Q ⟶ R) : (P ⟶ Q) →+ (P ⟶ R) := +mk' (λ f, f ≫ g) $ λ f f', by simp + +variables {P Q R : C} (f f' : P ⟶ Q) (g g' : Q ⟶ R) + +/-- Composition as a bilinear group homomorphism -/ +def comp_hom : (P ⟶ Q) →+ (Q ⟶ R) →+ (P ⟶ R) := +add_monoid_hom.mk' (λ f, left_comp _ f) $ + λ f₁ f₂, add_monoid_hom.ext $ λ g, (right_comp _ g).map_add f₁ f₂ + +@[simp, reassoc] lemma sub_comp : + (f - f') ≫ g = f ≫ g - f' ≫ g := +map_sub (right_comp P g) f f' + +-- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma. +@[reassoc, simp] lemma comp_sub : + f ≫ (g - g') = f ≫ g - f ≫ g' := +map_sub (left_comp R f) g g' + +@[simp, reassoc] lemma neg_comp : (-f) ≫ g = -(f ≫ g) := +map_neg (right_comp P g) f + +/- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma. -/ +@[reassoc, simp] lemma comp_neg : f ≫ (-g) = -(f ≫ g) := +map_neg (left_comp R f) g + +@[reassoc] lemma neg_comp_neg : (-f) ≫ (-g) = f ≫ g := +by simp + +lemma nsmul_comp (n : ℕ) : (n • f) ≫ g = n • (f ≫ g) := +map_nsmul (right_comp P g) n f + +lemma comp_nsmul (n : ℕ) : f ≫ (n • g) = n • (f ≫ g) := +map_nsmul (left_comp R f) n g + +lemma zsmul_comp (n : ℤ) : (n • f) ≫ g = n • (f ≫ g) := +map_zsmul (right_comp P g) n f + +lemma comp_zsmul (n : ℤ) : f ≫ (n • g) = n • (f ≫ g) := +map_zsmul (left_comp R f) n g + +@[reassoc] lemma comp_sum {P Q R : C} {J : Type*} (s : finset J) (f : P ⟶ Q) (g : J → (Q ⟶ R)) : + f ≫ ∑ j in s, g j = ∑ j in s, f ≫ g j := +map_sum (left_comp R f) _ _ + +@[reassoc] lemma sum_comp {P Q R : C} {J : Type*} (s : finset J) (f : J → (P ⟶ Q)) (g : Q ⟶ R) : + (∑ j in s, f j) ≫ g = ∑ j in s, f j ≫ g := +map_sum (right_comp P g) _ _ + +instance {P Q : C} {f : P ⟶ Q} [epi f] : epi (-f) := +⟨λ R g g' H, by rwa [neg_comp, neg_comp, ←comp_neg, ←comp_neg, cancel_epi, neg_inj] at H⟩ + +instance {P Q : C} {f : P ⟶ Q} [mono f] : mono (-f) := +⟨λ R g g' H, by rwa [comp_neg, comp_neg, ←neg_comp, ←neg_comp, cancel_mono, neg_inj] at H⟩ + +@[priority 100] +instance preadditive_has_zero_morphisms : has_zero_morphisms C := +{ has_zero := infer_instance, + comp_zero' := λ P Q f R, show left_comp R f 0 = 0, from map_zero _, + zero_comp' := λ P Q R f, show right_comp P f 0 = 0, from map_zero _ } + +instance module_End_right {X Y : C} : module (End Y) (X ⟶ Y) := +{ smul_add := λ r f g, add_comp _ _ _ _ _ _, + smul_zero := λ r, zero_comp, + add_smul := λ r s f, comp_add _ _ _ _ _ _, + zero_smul := λ r, comp_zero } + +lemma mono_of_cancel_zero {Q R : C} (f : Q ⟶ R) (h : ∀ {P : C} (g : P ⟶ Q), g ≫ f = 0 → g = 0) : + mono f := +⟨λ P g g' hg, sub_eq_zero.1 $ h _ $ (map_sub (right_comp P f) g g').trans $ sub_eq_zero.2 hg⟩ + +lemma mono_iff_cancel_zero {Q R : C} (f : Q ⟶ R) : + mono f ↔ ∀ (P : C) (g : P ⟶ Q), g ≫ f = 0 → g = 0 := +⟨λ m P g, by exactI zero_of_comp_mono _, mono_of_cancel_zero f⟩ + +lemma mono_of_kernel_zero {X Y : C} {f : X ⟶ Y} [has_limit (parallel_pair f 0)] + (w : kernel.ι f = 0) : mono f := +mono_of_cancel_zero f (λ P g h, by rw [←kernel.lift_ι f g h, w, limits.comp_zero]) + +lemma epi_of_cancel_zero {P Q : C} (f : P ⟶ Q) (h : ∀ {R : C} (g : Q ⟶ R), f ≫ g = 0 → g = 0) : + epi f := +⟨λ R g g' hg, sub_eq_zero.1 $ h _ $ (map_sub (left_comp R f) g g').trans $ sub_eq_zero.2 hg⟩ + +lemma epi_iff_cancel_zero {P Q : C} (f : P ⟶ Q) : + epi f ↔ ∀ (R : C) (g : Q ⟶ R), f ≫ g = 0 → g = 0 := +⟨λ e R g, by exactI zero_of_epi_comp _, epi_of_cancel_zero f⟩ + +lemma epi_of_cokernel_zero {X Y : C} {f : X ⟶ Y} [has_colimit (parallel_pair f 0 )] + (w : cokernel.π f = 0) : epi f := +epi_of_cancel_zero f (λ P g h, by rw [←cokernel.π_desc f g h, w, limits.zero_comp]) + +namespace is_iso + +@[simp] lemma comp_left_eq_zero [is_iso f] : + f ≫ g = 0 ↔ g = 0 := +by rw [← is_iso.eq_inv_comp, limits.comp_zero] + +@[simp] lemma comp_right_eq_zero [is_iso g] : + f ≫ g = 0 ↔ f = 0 := +by rw [← is_iso.eq_comp_inv, limits.zero_comp] + +end is_iso + +open_locale zero_object +variables [has_zero_object C] + +lemma mono_of_kernel_iso_zero {X Y : C} {f : X ⟶ Y} [has_limit (parallel_pair f 0)] + (w : kernel f ≅ 0) : mono f := +mono_of_kernel_zero (zero_of_source_iso_zero _ w) + +lemma epi_of_cokernel_iso_zero {X Y : C} {f : X ⟶ Y} [has_colimit (parallel_pair f 0)] + (w : cokernel f ≅ 0) : epi f := +epi_of_cokernel_zero (zero_of_target_iso_zero _ w) + +end preadditive + +section equalizers +variables {C : Type u} [category.{v} C] [preadditive C] + +section +variables {X Y : C} {f : X ⟶ Y} {g : X ⟶ Y} + +/-- Map a kernel cone on the difference of two morphisms to the equalizer fork. -/ +@[simps X] +def fork_of_kernel_fork (c : kernel_fork (f - g)) : fork f g := +fork.of_ι c.ι $ by rw [← sub_eq_zero, ← comp_sub, c.condition] + +@[simp] lemma fork_of_kernel_fork_ι (c : kernel_fork (f - g)) : + (fork_of_kernel_fork c).ι = c.ι := rfl + +/-- Map any equalizer fork to a cone on the difference of the two morphisms. -/ +def kernel_fork_of_fork (c : fork f g) : kernel_fork (f - g) := +fork.of_ι c.ι $ by rw [comp_sub, comp_zero, sub_eq_zero, c.condition] + +@[simp] lemma kernel_fork_of_fork_ι (c : fork f g) : (kernel_fork_of_fork c).ι = c.ι := rfl + +@[simp] lemma kernel_fork_of_fork_of_ι {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : + (kernel_fork_of_fork (fork.of_ι ι w)) = kernel_fork.of_ι ι (by simp [w]) := rfl + +/-- A kernel of `f - g` is an equalizer of `f` and `g`. -/ +def is_limit_fork_of_kernel_fork {c : kernel_fork (f - g)} (i : is_limit c) : + is_limit (fork_of_kernel_fork c) := +fork.is_limit.mk' _ $ λ s, + ⟨i.lift (kernel_fork_of_fork s), i.fac _ _, + λ m h, by apply fork.is_limit.hom_ext i; tidy⟩ + +@[simp] +lemma is_limit_fork_of_kernel_fork_lift {c : kernel_fork (f - g)} (i : is_limit c) (s : fork f g) : + (is_limit_fork_of_kernel_fork i).lift s = i.lift (kernel_fork_of_fork s) := rfl + +/-- An equalizer of `f` and `g` is a kernel of `f - g`. -/ +def is_limit_kernel_fork_of_fork {c : fork f g} (i : is_limit c) : + is_limit (kernel_fork_of_fork c) := +fork.is_limit.mk' _ $ λ s, + ⟨i.lift (fork_of_kernel_fork s), i.fac _ _, + λ m h, by apply fork.is_limit.hom_ext i; tidy⟩ + +variables (f g) + +/-- A preadditive category has an equalizer for `f` and `g` if it has a kernel for `f - g`. -/ +lemma has_equalizer_of_has_kernel [has_kernel (f - g)] : has_equalizer f g := +has_limit.mk { cone := fork_of_kernel_fork _, + is_limit := is_limit_fork_of_kernel_fork (equalizer_is_equalizer (f - g) 0) } + +/-- A preadditive category has a kernel for `f - g` if it has an equalizer for `f` and `g`. -/ +lemma has_kernel_of_has_equalizer [has_equalizer f g] : has_kernel (f - g) := +has_limit.mk { cone := kernel_fork_of_fork (equalizer.fork f g), + is_limit := is_limit_kernel_fork_of_fork (limit.is_limit (parallel_pair f g)) } + +variables {f g} + +/-- Map a cokernel cocone on the difference of two morphisms to the coequalizer cofork. -/ +@[simps X] +def cofork_of_cokernel_cofork (c : cokernel_cofork (f - g)) : cofork f g := +cofork.of_π c.π $ by rw [← sub_eq_zero, ← sub_comp, c.condition] + +@[simp] lemma cofork_of_cokernel_cofork_π (c : cokernel_cofork (f - g)) : + (cofork_of_cokernel_cofork c).π = c.π := rfl + +/-- Map any coequalizer cofork to a cocone on the difference of the two morphisms. -/ +def cokernel_cofork_of_cofork (c : cofork f g) : cokernel_cofork (f - g) := +cofork.of_π c.π $ by rw [sub_comp, zero_comp, sub_eq_zero, c.condition] + +@[simp] lemma cokernel_cofork_of_cofork_π (c : cofork f g) : + (cokernel_cofork_of_cofork c).π = c.π := rfl + +@[simp] lemma cokernel_cofork_of_cofork_of_π {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) : + (cokernel_cofork_of_cofork (cofork.of_π π w)) = cokernel_cofork.of_π π (by simp [w]) := rfl + +/-- A cokernel of `f - g` is a coequalizer of `f` and `g`. -/ +def is_colimit_cofork_of_cokernel_cofork {c : cokernel_cofork (f - g)} (i : is_colimit c) : + is_colimit (cofork_of_cokernel_cofork c) := +cofork.is_colimit.mk' _ $ λ s, + ⟨i.desc (cokernel_cofork_of_cofork s), i.fac _ _, + λ m h, by apply cofork.is_colimit.hom_ext i; tidy⟩ + +@[simp] +lemma is_colimit_cofork_of_cokernel_cofork_desc {c : cokernel_cofork (f - g)} + (i : is_colimit c) (s : cofork f g) : + (is_colimit_cofork_of_cokernel_cofork i).desc s = i.desc (cokernel_cofork_of_cofork s) := rfl + +/-- A coequalizer of `f` and `g` is a cokernel of `f - g`. -/ +def is_colimit_cokernel_cofork_of_cofork {c : cofork f g} (i : is_colimit c) : + is_colimit (cokernel_cofork_of_cofork c) := +cofork.is_colimit.mk' _ $ λ s, + ⟨i.desc (cofork_of_cokernel_cofork s), i.fac _ _, + λ m h, by apply cofork.is_colimit.hom_ext i; tidy⟩ + +variables (f g) + +/-- A preadditive category has a coequalizer for `f` and `g` if it has a cokernel for `f - g`. -/ +lemma has_coequalizer_of_has_cokernel [has_cokernel (f - g)] : has_coequalizer f g := +has_colimit.mk { cocone := cofork_of_cokernel_cofork _, + is_colimit := is_colimit_cofork_of_cokernel_cofork (coequalizer_is_coequalizer (f - g) 0) } + +/-- A preadditive category has a cokernel for `f - g` if it has a coequalizer for `f` and `g`. -/ +lemma has_cokernel_of_has_coequalizer [has_coequalizer f g] : has_cokernel (f - g) := +has_colimit.mk { cocone := cokernel_cofork_of_cofork (coequalizer.cofork f g), + is_colimit := is_colimit_cokernel_cofork_of_cofork (colimit.is_colimit (parallel_pair f g)) } + +end + +/-- If a preadditive category has all kernels, then it also has all equalizers. -/ +lemma has_equalizers_of_has_kernels [has_kernels C] : has_equalizers C := +@has_equalizers_of_has_limit_parallel_pair _ _ (λ _ _ f g, has_equalizer_of_has_kernel f g) + + +/-- If a preadditive category has all cokernels, then it also has all coequalizers. -/ +lemma has_coequalizers_of_has_cokernels [has_cokernels C] : has_coequalizers C := +@has_coequalizers_of_has_colimit_parallel_pair _ _ (λ _ _ f g, has_coequalizer_of_has_cokernel f g) + +end equalizers + +end preadditive + +end category_theory diff --git a/src/category_theory/preadditive/biproducts.lean b/src/category_theory/preadditive/biproducts.lean index f55a792f99a33..e50ebb7b168d3 100644 --- a/src/category_theory/preadditive/biproducts.lean +++ b/src/category_theory/preadditive/biproducts.lean @@ -3,18 +3,31 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import tactic.abel +import algebra.group.ext import category_theory.limits.shapes.biproducts -import category_theory.preadditive +import category_theory.limits.preserves.shapes.binary_products +import category_theory.limits.preserves.shapes.biproducts +import category_theory.limits.preserves.shapes.products +import category_theory.preadditive.basic +import tactic.abel /-! -# Basic facts about morphisms between biproducts in preadditive categories. +# Basic facts about biproducts in preadditive categories. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In (or between) preadditive categories, + +* Any biproduct satisfies the equality + `total : ∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)`, + or, in the binary case, `total : fst ≫ inl + snd ≫ inr = 𝟙 X`. + +* Any (binary) `product` or (binary) `coproduct` is a (binary) `biproduct`. * In any category (with zero morphisms), if `biprod.map f g` is an isomorphism, then both `f` and `g` are isomorphisms. -The remaining lemmas hold in any preadditive category. - * If `f` is a morphism `X₁ ⊞ X₂ ⟶ Y₁ ⊞ Y₂` whose `X₁ ⟶ Y₁` entry is an isomorphism, then we can construct isomorphisms `L : X₁ ⊞ X₂ ≅ X₁ ⊞ X₂` and `R : Y₁ ⊞ Y₂ ≅ Y₁ ⊞ Y₂` so that `L.hom ≫ g ≫ R.hom` is diagonal (with `X₁ ⟶ Y₁` component still `f`), @@ -30,68 +43,586 @@ The remaining lemmas hold in any preadditive category. * If `f : ⨁ S ⟶ ⨁ T` is an isomorphism, then every column (corresponding to a nonzero summand in the domain) has some nonzero matrix entry. + +* A functor preserves a biproduct if and only if it preserves + the corresponding product if and only if it preserves the corresponding coproduct. + +There are connections between this material and the special case of the category whose morphisms are +matrices over a ring, in particular the Schur complement (see +`linear_algebra.matrix.schur_complement`). In particular, the declarations +`category_theory.biprod.iso_elim`, `category_theory.biprod.gaussian` +and `matrix.invertible_of_from_blocks₁₁_invertible` are all closely related. + -/ open category_theory open category_theory.preadditive open category_theory.limits +open category_theory.functor +open category_theory.preadditive + +open_locale classical +open_locale big_operators -universes v u +universes v v' u u' noncomputable theory namespace category_theory -variables {C : Type u} [category.{v} C] +variables {C : Type u} [category.{v} C] [preadditive C] + +namespace limits + +variables {J : Type} [fintype J] + +/-- +In a preadditive category, we can construct a biproduct for `f : J → C` from +any bicone `b` for `f` satisfying `total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X`. + +(That is, such a bicone is a limit cone and a colimit cocone.) +-/ +def is_bilimit_of_total {f : J → C} (b : bicone f) (total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X) : + b.is_bilimit := +{ is_limit := + { lift := λ s, ∑ (j : J), s.π.app ⟨j⟩ ≫ b.ι j, + uniq' := λ s m h, + begin + erw [←category.comp_id m, ←total, comp_sum], + apply finset.sum_congr rfl, + intros j m, + erw [reassoc_of (h ⟨j⟩)], + end, + fac' := λ s j, + begin + cases j, + simp only [sum_comp, category.assoc, bicone.to_cone_π_app, b.ι_π, comp_dite], + -- See note [dsimp, simp]. + dsimp, simp, + end }, + is_colimit := + { desc := λ s, ∑ (j : J), b.π j ≫ s.ι.app ⟨j⟩, + uniq' := λ s m h, + begin + erw [←category.id_comp m, ←total, sum_comp], + apply finset.sum_congr rfl, + intros j m, + erw [category.assoc, h ⟨j⟩], + end, + fac' := λ s j, + begin + cases j, + simp only [comp_sum, ←category.assoc, bicone.to_cocone_ι_app, b.ι_π, dite_comp], + dsimp, simp, + end } } + +lemma is_bilimit.total {f : J → C} {b : bicone f} (i : b.is_bilimit) : + ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X := +i.is_limit.hom_ext (λ j, by { cases j, simp [sum_comp, b.ι_π, comp_dite] }) + +/-- +In a preadditive category, we can construct a biproduct for `f : J → C` from +any bicone `b` for `f` satisfying `total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X`. + +(That is, such a bicone is a limit cone and a colimit cocone.) +-/ +lemma has_biproduct_of_total {f : J → C} (b : bicone f) (total : ∑ j : J, b.π j ≫ b.ι j = 𝟙 b.X) : + has_biproduct f := +has_biproduct.mk +{ bicone := b, + is_bilimit := is_bilimit_of_total b total } + +/-- In a preadditive category, any finite bicone which is a limit cone is in fact a bilimit + bicone. -/ +def is_bilimit_of_is_limit {f : J → C} (t : bicone f) (ht : is_limit t.to_cone) : t.is_bilimit := +is_bilimit_of_total _ $ ht.hom_ext $ + λ j, by { cases j, simp [sum_comp, t.ι_π, dite_comp, comp_dite] } + +/-- We can turn any limit cone over a pair into a bilimit bicone. -/ +def bicone_is_bilimit_of_limit_cone_of_is_limit {f : J → C} {t : cone (discrete.functor f)} + (ht : is_limit t) : (bicone.of_limit_cone ht).is_bilimit := +is_bilimit_of_is_limit _ $ + is_limit.of_iso_limit ht $ cones.ext (iso.refl _) (by { rintro ⟨j⟩, tidy }) + +/-- In a preadditive category, if the product over `f : J → C` exists, + then the biproduct over `f` exists. -/ +lemma has_biproduct.of_has_product {J : Type} [finite J] (f : J → C) [has_product f] : + has_biproduct f := +by casesI nonempty_fintype J; exact +has_biproduct.mk +{ bicone := _, + is_bilimit := bicone_is_bilimit_of_limit_cone_of_is_limit (limit.is_limit _) } + +/-- In a preadditive category, any finite bicone which is a colimit cocone is in fact a bilimit + bicone. -/ +def is_bilimit_of_is_colimit {f : J → C} (t : bicone f) (ht : is_colimit t.to_cocone) : + t.is_bilimit := +is_bilimit_of_total _ $ ht.hom_ext $ λ j, begin + cases j, + simp_rw [bicone.to_cocone_ι_app, comp_sum, ← category.assoc, t.ι_π, dite_comp], + tidy +end + +/-- We can turn any limit cone over a pair into a bilimit bicone. -/ +def bicone_is_bilimit_of_colimit_cocone_of_is_colimit {f : J → C} {t : cocone (discrete.functor f)} + (ht : is_colimit t) : (bicone.of_colimit_cocone ht).is_bilimit := +is_bilimit_of_is_colimit _ $ + is_colimit.of_iso_colimit ht $ cocones.ext (iso.refl _) (by { rintro ⟨j⟩, tidy }) + +/-- In a preadditive category, if the coproduct over `f : J → C` exists, + then the biproduct over `f` exists. -/ +lemma has_biproduct.of_has_coproduct {J : Type} [finite J] (f : J → C) [has_coproduct f] : + has_biproduct f := +by casesI nonempty_fintype J; exact +has_biproduct.mk +{ bicone := _, + is_bilimit := bicone_is_bilimit_of_colimit_cocone_of_is_colimit (colimit.is_colimit _) } + +/-- A preadditive category with finite products has finite biproducts. -/ +lemma has_finite_biproducts.of_has_finite_products [has_finite_products C] : + has_finite_biproducts C := +⟨λ n, { has_biproduct := λ F, has_biproduct.of_has_product _ }⟩ + +/-- A preadditive category with finite coproducts has finite biproducts. -/ +lemma has_finite_biproducts.of_has_finite_coproducts [has_finite_coproducts C] : + has_finite_biproducts C := +⟨λ n, { has_biproduct := λ F, has_biproduct.of_has_coproduct _ }⟩ + section -variables [has_zero_morphisms.{v} C] [has_binary_biproducts.{v} C] +variables {f : J → C} [has_biproduct f] /-- -If -``` -(f 0) -(0 g) -``` -is invertible, then `f` is invertible. +In any preadditive category, any biproduct satsifies +`∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f)` -/ -lemma is_iso_left_of_is_iso_biprod_map - {W X Y Z : C} (f : W ⟶ Y) (g : X ⟶ Z) [is_iso (biprod.map f g)] : is_iso f := -⟨⟨biprod.inl ≫ inv (biprod.map f g) ≫ biprod.fst, - ⟨begin - have t := congr_arg (λ p : W ⊞ X ⟶ W ⊞ X, biprod.inl ≫ p ≫ biprod.fst) - (is_iso.hom_inv_id (biprod.map f g)), - simp only [category.id_comp, category.assoc, biprod.inl_map_assoc] at t, - simp [t], - end, - begin - have t := congr_arg (λ p : Y ⊞ Z ⟶ Y ⊞ Z, biprod.inl ≫ p ≫ biprod.fst) - (is_iso.inv_hom_id (biprod.map f g)), - simp only [category.id_comp, category.assoc, biprod.map_fst] at t, - simp only [category.assoc], - simp [t], - end⟩⟩⟩ +@[simp] lemma biproduct.total : ∑ j : J, biproduct.π f j ≫ biproduct.ι f j = 𝟙 (⨁ f) := +is_bilimit.total (biproduct.is_bilimit _) + +lemma biproduct.lift_eq {T : C} {g : Π j, T ⟶ f j} : + biproduct.lift g = ∑ j, g j ≫ biproduct.ι f j := +begin + ext j, + simp only [sum_comp, biproduct.ι_π, comp_dite, biproduct.lift_π, category.assoc, comp_zero, + finset.sum_dite_eq', finset.mem_univ, eq_to_hom_refl, category.comp_id, if_true], +end + +lemma biproduct.desc_eq {T : C} {g : Π j, f j ⟶ T} : + biproduct.desc g = ∑ j, biproduct.π f j ≫ g j := +begin + ext j, + simp [comp_sum, biproduct.ι_π_assoc, dite_comp], +end + +@[simp, reassoc] lemma biproduct.lift_desc {T U : C} {g : Π j, T ⟶ f j} {h : Π j, f j ⟶ U} : + biproduct.lift g ≫ biproduct.desc h = ∑ j : J, g j ≫ h j := +by simp [biproduct.lift_eq, biproduct.desc_eq, comp_sum, sum_comp, biproduct.ι_π_assoc, + comp_dite, dite_comp] + +lemma biproduct.map_eq [has_finite_biproducts C] {f g : J → C} {h : Π j, f j ⟶ g j} : + biproduct.map h = ∑ j : J, biproduct.π f j ≫ h j ≫ biproduct.ι g j := +begin + ext, + simp [biproduct.ι_π, biproduct.ι_π_assoc, comp_sum, sum_comp, comp_dite, dite_comp], +end + +@[simp, reassoc] +lemma biproduct.matrix_desc + {K : Type} [fintype K] [has_finite_biproducts C] + {f : J → C} {g : K → C} (m : Π j k, f j ⟶ g k) {P} (x : Π k, g k ⟶ P) : + biproduct.matrix m ≫ biproduct.desc x = biproduct.desc (λ j, ∑ k, m j k ≫ x k) := +by { ext, simp, } + +@[simp, reassoc] +lemma biproduct.lift_matrix + {K : Type} [fintype K] [has_finite_biproducts C] + {f : J → C} {g : K → C} {P} (x : Π j, P ⟶ f j) (m : Π j k, f j ⟶ g k) : + biproduct.lift x ≫ biproduct.matrix m = biproduct.lift (λ k, ∑ j, x j ≫ m j k) := +by { ext, simp, } + +@[reassoc] +lemma biproduct.matrix_map + {K : Type} [fintype K] [has_finite_biproducts C] + {f : J → C} {g : K → C} {h : K → C} (m : Π j k, f j ⟶ g k) (n : Π k, g k ⟶ h k) : + biproduct.matrix m ≫ biproduct.map n = biproduct.matrix (λ j k, m j k ≫ n k) := +by { ext, simp, } + +@[reassoc] +lemma biproduct.map_matrix + {K : Type} [fintype K] [has_finite_biproducts C] + {f : J → C} {g : J → C} {h : K → C} (m : Π k, f k ⟶ g k) (n : Π j k, g j ⟶ h k) : + biproduct.map m ≫ biproduct.matrix n = biproduct.matrix (λ j k, m j ≫ n j k) := +by { ext, simp, } + +end + +/-- Reindex a categorical biproduct via an equivalence of the index types. -/ +@[simps] +def biproduct.reindex {β γ : Type} [fintype β] [decidable_eq β] [decidable_eq γ] + (ε : β ≃ γ) (f : γ → C) [has_biproduct f] [has_biproduct (f ∘ ε)] : (⨁ (f ∘ ε)) ≅ (⨁ f) := +{ hom := biproduct.desc (λ b, biproduct.ι f (ε b)), + inv := biproduct.lift (λ b, biproduct.π f (ε b)), + hom_inv_id' := by { ext b b', by_cases h : b = b', { subst h, simp, }, { simp [h], }, }, + inv_hom_id' := begin + ext g g', + by_cases h : g = g'; + simp [preadditive.sum_comp, preadditive.comp_sum, biproduct.ι_π, biproduct.ι_π_assoc, comp_dite, + equiv.apply_eq_iff_eq_symm_apply, finset.sum_dite_eq' finset.univ (ε.symm g') _, h], + end, } /-- -If -``` -(f 0) -(0 g) -``` -is invertible, then `g` is invertible. +In a preadditive category, we can construct a binary biproduct for `X Y : C` from +any binary bicone `b` satisfying `total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X`. + +(That is, such a bicone is a limit cone and a colimit cocone.) -/ -lemma is_iso_right_of_is_iso_biprod_map - {W X Y Z : C} (f : W ⟶ Y) (g : X ⟶ Z) [is_iso (biprod.map f g)] : is_iso g := +def is_binary_bilimit_of_total {X Y : C} (b : binary_bicone X Y) + (total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X) : b.is_bilimit := +{ is_limit := + { lift := λ s, binary_fan.fst s ≫ b.inl + + binary_fan.snd s ≫ b.inr, + uniq' := λ s m h, by erw [←category.comp_id m, ←total, + comp_add, reassoc_of (h ⟨walking_pair.left⟩), reassoc_of (h ⟨walking_pair.right⟩)], + fac' := λ s j, by rcases j with ⟨⟨⟩⟩; simp, }, + is_colimit := + { desc := λ s, b.fst ≫ binary_cofan.inl s + + b.snd ≫ binary_cofan.inr s, + uniq' := λ s m h, by erw [←category.id_comp m, ←total, + add_comp, category.assoc, category.assoc, h ⟨walking_pair.left⟩, h ⟨walking_pair.right⟩], + fac' := λ s j, by rcases j with ⟨⟨⟩⟩; simp, } } + +lemma is_bilimit.binary_total {X Y : C} {b : binary_bicone X Y} (i : b.is_bilimit) : + b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X := +i.is_limit.hom_ext (λ j, by { rcases j with ⟨⟨⟩⟩; simp, }) + +/-- +In a preadditive category, we can construct a binary biproduct for `X Y : C` from +any binary bicone `b` satisfying `total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X`. + +(That is, such a bicone is a limit cone and a colimit cocone.) +-/ +lemma has_binary_biproduct_of_total {X Y : C} (b : binary_bicone X Y) + (total : b.fst ≫ b.inl + b.snd ≫ b.inr = 𝟙 b.X) : has_binary_biproduct X Y := +has_binary_biproduct.mk +{ bicone := b, + is_bilimit := is_binary_bilimit_of_total b total } + +/-- We can turn any limit cone over a pair into a bicone. -/ +@[simps] +def binary_bicone.of_limit_cone {X Y : C} {t : cone (pair X Y)} (ht : is_limit t) : + binary_bicone X Y := +{ X := t.X, + fst := t.π.app ⟨walking_pair.left⟩, + snd := t.π.app ⟨walking_pair.right⟩, + inl := ht.lift (binary_fan.mk (𝟙 X) 0), + inr := ht.lift (binary_fan.mk 0 (𝟙 Y)) } + +lemma inl_of_is_limit {X Y : C} {t : binary_bicone X Y} (ht : is_limit t.to_cone) : + t.inl = ht.lift (binary_fan.mk (𝟙 X) 0) := +by apply ht.uniq (binary_fan.mk (𝟙 X) 0); rintro ⟨⟨⟩⟩; dsimp; simp + +lemma inr_of_is_limit {X Y : C} {t : binary_bicone X Y} (ht : is_limit t.to_cone) : + t.inr = ht.lift (binary_fan.mk 0 (𝟙 Y)) := +by apply ht.uniq (binary_fan.mk 0 (𝟙 Y)); rintro ⟨⟨⟩⟩; dsimp; simp + +/-- In a preadditive category, any binary bicone which is a limit cone is in fact a bilimit + bicone. -/ +def is_binary_bilimit_of_is_limit {X Y : C} (t : binary_bicone X Y) (ht : is_limit t.to_cone) : + t.is_bilimit := +is_binary_bilimit_of_total _ (by refine binary_fan.is_limit.hom_ext ht _ _; simp) + +/-- We can turn any limit cone over a pair into a bilimit bicone. -/ +def binary_bicone_is_bilimit_of_limit_cone_of_is_limit {X Y : C} {t : cone (pair X Y)} + (ht : is_limit t) : (binary_bicone.of_limit_cone ht).is_bilimit := +is_binary_bilimit_of_total _ $ binary_fan.is_limit.hom_ext ht (by simp) (by simp) + +/-- In a preadditive category, if the product of `X` and `Y` exists, then the + binary biproduct of `X` and `Y` exists. -/ +lemma has_binary_biproduct.of_has_binary_product (X Y : C) [has_binary_product X Y] : + has_binary_biproduct X Y := +has_binary_biproduct.mk +{ bicone := _, + is_bilimit := binary_bicone_is_bilimit_of_limit_cone_of_is_limit (limit.is_limit _) } + +/-- In a preadditive category, if all binary products exist, then all binary biproducts exist. -/ +lemma has_binary_biproducts.of_has_binary_products [has_binary_products C] : + has_binary_biproducts C := +{ has_binary_biproduct := λ X Y, has_binary_biproduct.of_has_binary_product X Y, } + +/-- We can turn any colimit cocone over a pair into a bicone. -/ +@[simps] +def binary_bicone.of_colimit_cocone {X Y : C} {t : cocone (pair X Y)} (ht : is_colimit t) : + binary_bicone X Y := +{ X := t.X, + fst := ht.desc (binary_cofan.mk (𝟙 X) 0), + snd := ht.desc (binary_cofan.mk 0 (𝟙 Y)), + inl := t.ι.app ⟨walking_pair.left⟩, + inr := t.ι.app ⟨walking_pair.right⟩ } + +lemma fst_of_is_colimit {X Y : C} {t : binary_bicone X Y} (ht : is_colimit t.to_cocone) : + t.fst = ht.desc (binary_cofan.mk (𝟙 X) 0) := +begin + apply ht.uniq (binary_cofan.mk (𝟙 X) 0), + rintro ⟨⟨⟩⟩; dsimp; simp +end + +lemma snd_of_is_colimit {X Y : C} {t : binary_bicone X Y} (ht : is_colimit t.to_cocone) : + t.snd = ht.desc (binary_cofan.mk 0 (𝟙 Y)) := +begin + apply ht.uniq (binary_cofan.mk 0 (𝟙 Y)), + rintro ⟨⟨⟩⟩; dsimp; simp +end + +/-- In a preadditive category, any binary bicone which is a colimit cocone is in fact a + bilimit bicone. -/ +def is_binary_bilimit_of_is_colimit {X Y : C} (t : binary_bicone X Y) + (ht : is_colimit t.to_cocone) : t.is_bilimit := +is_binary_bilimit_of_total _ +begin + refine binary_cofan.is_colimit.hom_ext ht _ _; simp, + { rw [category.comp_id t.inl] }, + { rw [category.comp_id t.inr] } +end + +/-- We can turn any colimit cocone over a pair into a bilimit bicone. -/ +def binary_bicone_is_bilimit_of_colimit_cocone_of_is_colimit {X Y : C} {t : cocone (pair X Y)} + (ht : is_colimit t) : (binary_bicone.of_colimit_cocone ht).is_bilimit := +is_binary_bilimit_of_is_colimit (binary_bicone.of_colimit_cocone ht) $ + is_colimit.of_iso_colimit ht $ cocones.ext (iso.refl _) $ λ j, by { rcases j with ⟨⟨⟩⟩, tidy } + +/-- In a preadditive category, if the coproduct of `X` and `Y` exists, then the + binary biproduct of `X` and `Y` exists. -/ +lemma has_binary_biproduct.of_has_binary_coproduct (X Y : C) [has_binary_coproduct X Y] : + has_binary_biproduct X Y := +has_binary_biproduct.mk +{ bicone := _, + is_bilimit := binary_bicone_is_bilimit_of_colimit_cocone_of_is_colimit (colimit.is_colimit _) } + +/-- In a preadditive category, if all binary coproducts exist, then all binary biproducts exist. -/ +lemma has_binary_biproducts.of_has_binary_coproducts [has_binary_coproducts C] : + has_binary_biproducts C := +{ has_binary_biproduct := λ X Y, has_binary_biproduct.of_has_binary_coproduct X Y, } + +section +variables {X Y : C} [has_binary_biproduct X Y] + +/-- +In any preadditive category, any binary biproduct satsifies +`biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y)`. +-/ +@[simp] lemma biprod.total : biprod.fst ≫ biprod.inl + biprod.snd ≫ biprod.inr = 𝟙 (X ⊞ Y) := +begin + ext; simp [add_comp], +end + +lemma biprod.lift_eq {T : C} {f : T ⟶ X} {g : T ⟶ Y} : + biprod.lift f g = f ≫ biprod.inl + g ≫ biprod.inr := begin - letI : is_iso (biprod.map g f) := by - { rw [←biprod.braiding_map_braiding], - apply_instance, }, - exact is_iso_left_of_is_iso_biprod_map g f, + ext; simp [add_comp], end +lemma biprod.desc_eq {T : C} {f : X ⟶ T} {g : Y ⟶ T} : + biprod.desc f g = biprod.fst ≫ f + biprod.snd ≫ g := +begin + ext; simp [add_comp], +end + +@[simp, reassoc] lemma biprod.lift_desc {T U : C} {f : T ⟶ X} {g : T ⟶ Y} {h : X ⟶ U} {i : Y ⟶ U} : + biprod.lift f g ≫ biprod.desc h i = f ≫ h + g ≫ i := +by simp [biprod.lift_eq, biprod.desc_eq] + +lemma biprod.map_eq [has_binary_biproducts C] {W X Y Z : C} {f : W ⟶ Y} {g : X ⟶ Z} : + biprod.map f g = biprod.fst ≫ f ≫ biprod.inl + biprod.snd ≫ g ≫ biprod.inr := +by apply biprod.hom_ext; apply biprod.hom_ext'; simp + +/-- +Every split mono `f` with a cokernel induces a binary bicone with `f` as its `inl` and +the cokernel map as its `snd`. +We will show in `is_bilimit_binary_bicone_of_split_mono_of_cokernel` that this binary bicone is in +fact already a biproduct. -/ +@[simps] +def binary_bicone_of_is_split_mono_of_cokernel {X Y : C} {f : X ⟶ Y} [is_split_mono f] + {c : cokernel_cofork f} (i : is_colimit c) : binary_bicone X c.X := +{ X := Y, + fst := retraction f, + snd := c.π, + inl := f, + inr := + let c' : cokernel_cofork (𝟙 Y - (𝟙 Y - retraction f ≫ f)) := + cokernel_cofork.of_π (cofork.π c) (by simp) in + let i' : is_colimit c' := is_cokernel_epi_comp i (retraction f) (by simp) in + let i'' := is_colimit_cofork_of_cokernel_cofork i' in + (split_epi_of_idempotent_of_is_colimit_cofork C (by simp) i'').section_, + inl_fst' := by simp, + inl_snd' := by simp, + inr_fst' := + begin + dsimp only, + rw [split_epi_of_idempotent_of_is_colimit_cofork_section_, + is_colimit_cofork_of_cokernel_cofork_desc, is_cokernel_epi_comp_desc], + dsimp only [cokernel_cofork_of_cofork_of_π], + letI := epi_of_is_colimit_cofork i, + apply zero_of_epi_comp c.π, + simp only [sub_comp, comp_sub, category.comp_id, category.assoc, is_split_mono.id, sub_self, + cofork.is_colimit.π_desc_assoc, cokernel_cofork.π_of_π, is_split_mono.id_assoc], + apply sub_eq_zero_of_eq, + apply category.id_comp + end, + inr_snd' := by apply split_epi.id } + +/-- The bicone constructed in `binary_bicone_of_split_mono_of_cokernel` is a bilimit. +This is a version of the splitting lemma that holds in all preadditive categories. -/ +def is_bilimit_binary_bicone_of_is_split_mono_of_cokernel {X Y : C} {f : X ⟶ Y} [is_split_mono f] + {c : cokernel_cofork f} (i : is_colimit c) : + (binary_bicone_of_is_split_mono_of_cokernel i).is_bilimit := +is_binary_bilimit_of_total _ +begin + simp only [binary_bicone_of_is_split_mono_of_cokernel_fst, + binary_bicone_of_is_split_mono_of_cokernel_inr, binary_bicone_of_is_split_mono_of_cokernel_snd, + split_epi_of_idempotent_of_is_colimit_cofork_section_], + dsimp only [binary_bicone_of_is_split_mono_of_cokernel_X], + rw [is_colimit_cofork_of_cokernel_cofork_desc, is_cokernel_epi_comp_desc], + simp only [binary_bicone_of_is_split_mono_of_cokernel_inl, cofork.is_colimit.π_desc, + cokernel_cofork_of_cofork_π, cofork.π_of_π, add_sub_cancel'_right] end +/-- If `b` is a binary bicone such that `b.inl` is a kernel of `b.snd`, then `b` is a bilimit + bicone. -/ +def binary_bicone.is_bilimit_of_kernel_inl {X Y : C} (b : binary_bicone X Y) + (hb : is_limit b.snd_kernel_fork) : b.is_bilimit := +is_binary_bilimit_of_is_limit _ $ binary_fan.is_limit.mk _ + (λ T f g, f ≫ b.inl + g ≫ b.inr) (λ T f g, by simp) (λ T f g, by simp) $ λ T f g m h₁ h₂, + begin + have h₁' : (m - (f ≫ b.inl + g ≫ b.inr)) ≫ b.fst = 0 := by simpa using sub_eq_zero.2 h₁, + have h₂' : (m - (f ≫ b.inl + g ≫ b.inr)) ≫ b.snd = 0 := by simpa using sub_eq_zero.2 h₂, + obtain ⟨q : T ⟶ X, hq : q ≫ b.inl = m - (f ≫ b.inl + g ≫ b.inr)⟩ := + kernel_fork.is_limit.lift' hb _ h₂', + rw [←sub_eq_zero, ←hq, ←category.comp_id q, ←b.inl_fst, ←category.assoc, hq, h₁', zero_comp] + end + +/-- If `b` is a binary bicone such that `b.inr` is a kernel of `b.fst`, then `b` is a bilimit + bicone. -/ +def binary_bicone.is_bilimit_of_kernel_inr {X Y : C} (b : binary_bicone X Y) + (hb : is_limit b.fst_kernel_fork) : b.is_bilimit := +is_binary_bilimit_of_is_limit _ $ binary_fan.is_limit.mk _ + (λ T f g, f ≫ b.inl + g ≫ b.inr) (λ t f g, by simp) (λ t f g, by simp) $ λ T f g m h₁ h₂, + begin + have h₁' : (m - (f ≫ b.inl + g ≫ b.inr)) ≫ b.fst = 0 := by simpa using sub_eq_zero.2 h₁, + have h₂' : (m - (f ≫ b.inl + g ≫ b.inr)) ≫ b.snd = 0 := by simpa using sub_eq_zero.2 h₂, + obtain ⟨q : T ⟶ Y, hq : q ≫ b.inr = m - (f ≫ b.inl + g ≫ b.inr)⟩ := + kernel_fork.is_limit.lift' hb _ h₁', + rw [←sub_eq_zero, ←hq, ←category.comp_id q, ←b.inr_snd, ←category.assoc, hq, h₂', zero_comp] + end + +/-- If `b` is a binary bicone such that `b.fst` is a cokernel of `b.inr`, then `b` is a bilimit + bicone. -/ +def binary_bicone.is_bilimit_of_cokernel_fst {X Y : C} (b : binary_bicone X Y) + (hb : is_colimit b.inr_cokernel_cofork) : b.is_bilimit := +is_binary_bilimit_of_is_colimit _ $ binary_cofan.is_colimit.mk _ + (λ T f g, b.fst ≫ f + b.snd ≫ g) (λ T f g, by simp) (λ T f g, by simp) $ λ T f g m h₁ h₂, + begin + have h₁' : b.inl ≫ (m - (b.fst ≫ f + b.snd ≫ g)) = 0 := by simpa using sub_eq_zero.2 h₁, + have h₂' : b.inr ≫ (m - (b.fst ≫ f + b.snd ≫ g)) = 0 := by simpa using sub_eq_zero.2 h₂, + obtain ⟨q : X ⟶ T, hq : b.fst ≫ q = m - (b.fst ≫ f + b.snd ≫ g)⟩ := + cokernel_cofork.is_colimit.desc' hb _ h₂', + rw [←sub_eq_zero, ←hq, ←category.id_comp q, ←b.inl_fst, category.assoc, hq, h₁', comp_zero] + end + +/-- If `b` is a binary bicone such that `b.snd` is a cokernel of `b.inl`, then `b` is a bilimit + bicone. -/ +def binary_bicone.is_bilimit_of_cokernel_snd {X Y : C} (b : binary_bicone X Y) + (hb : is_colimit b.inl_cokernel_cofork) : b.is_bilimit := +is_binary_bilimit_of_is_colimit _ $ binary_cofan.is_colimit.mk _ + (λ T f g, b.fst ≫ f + b.snd ≫ g) (λ T f g, by simp) (λ T f g, by simp) $ λ T f g m h₁ h₂, + begin + have h₁' : b.inl ≫ (m - (b.fst ≫ f + b.snd ≫ g)) = 0 := by simpa using sub_eq_zero.2 h₁, + have h₂' : b.inr ≫ (m - (b.fst ≫ f + b.snd ≫ g)) = 0 := by simpa using sub_eq_zero.2 h₂, + obtain ⟨q : Y ⟶ T, hq : b.snd ≫ q = m - (b.fst ≫ f + b.snd ≫ g)⟩ := + cokernel_cofork.is_colimit.desc' hb _ h₁', + rw [←sub_eq_zero, ←hq, ←category.id_comp q, ←b.inr_snd, category.assoc, hq, h₂', comp_zero] + end + +/-- +Every split epi `f` with a kernel induces a binary bicone with `f` as its `snd` and +the kernel map as its `inl`. +We will show in `binary_bicone_of_is_split_mono_of_cokernel` that this binary bicone is in fact +already a biproduct. -/ +@[simps] +def binary_bicone_of_is_split_epi_of_kernel {X Y : C} {f : X ⟶ Y} [is_split_epi f] + {c : kernel_fork f} (i : is_limit c) : binary_bicone c.X Y := +{ X := X, + fst := + let c' : kernel_fork (𝟙 X - (𝟙 X - f ≫ section_ f)) := + kernel_fork.of_ι (fork.ι c) (by simp) in + let i' : is_limit c' := is_kernel_comp_mono i (section_ f) (by simp) in + let i'' := is_limit_fork_of_kernel_fork i' in + (split_mono_of_idempotent_of_is_limit_fork C (by simp) i'').retraction, + snd := f, + inl := c.ι, + inr := section_ f, + inl_fst' := by apply split_mono.id, + inl_snd' := by simp, + inr_fst' := + begin + dsimp only, + rw [split_mono_of_idempotent_of_is_limit_fork_retraction, + is_limit_fork_of_kernel_fork_lift, is_kernel_comp_mono_lift], + dsimp only [kernel_fork_of_fork_ι], + letI := mono_of_is_limit_fork i, + apply zero_of_comp_mono c.ι, + simp only [comp_sub, category.comp_id, category.assoc, sub_self, fork.is_limit.lift_ι, + fork.ι_of_ι, is_split_epi.id_assoc] + end, + inr_snd' := by simp } + +/-- The bicone constructed in `binary_bicone_of_is_split_epi_of_kernel` is a bilimit. +This is a version of the splitting lemma that holds in all preadditive categories. -/ +def is_bilimit_binary_bicone_of_is_split_epi_of_kernel {X Y : C} {f : X ⟶ Y} [is_split_epi f] + {c : kernel_fork f} (i : is_limit c) : + (binary_bicone_of_is_split_epi_of_kernel i).is_bilimit := +binary_bicone.is_bilimit_of_kernel_inl _ $ i.of_iso_limit $ fork.ext (iso.refl _) (by simp) + +end + +section +variables {X Y : C} (f g : X ⟶ Y) + +/-- The existence of binary biproducts implies that there is at most one preadditive structure. -/ +lemma biprod.add_eq_lift_id_desc [has_binary_biproduct X X] : + f + g = biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g := +by simp + +/-- The existence of binary biproducts implies that there is at most one preadditive structure. -/ +lemma biprod.add_eq_lift_desc_id [has_binary_biproduct Y Y] : + f + g = biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y) := +by simp + +end + +end limits + +open category_theory.limits + section -variables [preadditive.{v} C] [has_binary_biproducts.{v} C] +local attribute [ext] preadditive + +/-- The existence of binary biproducts implies that there is at most one preadditive structure. -/ +instance subsingleton_preadditive_of_has_binary_biproducts {C : Type u} [category.{v} C] + [has_zero_morphisms C] [has_binary_biproducts C] : subsingleton (preadditive C) := +subsingleton.intro $ λ a b, +begin + ext X Y f g, + have h₁ := @biprod.add_eq_lift_id_desc _ _ a _ _ f g + (by convert (infer_instance : has_binary_biproduct X X)), + have h₂ := @biprod.add_eq_lift_id_desc _ _ b _ _ f g + (by convert (infer_instance : has_binary_biproduct X X)), + refine h₁.trans (eq.trans _ h₂.symm), + congr' 2; + exact subsingleton.elim _ _ +end +end + +section +variables [has_binary_biproducts.{v} C] variables {X₁ X₂ Y₁ Y₂ : C} variables (f₁₁ : X₁ ⟶ Y₁) (f₁₂ : X₁ ⟶ Y₂) (f₂₁ : X₂ ⟶ Y₁) (f₂₂ : X₂ ⟶ Y₂) @@ -134,7 +665,10 @@ lemma biprod.of_components_eq (f : X₁ ⊞ X₂ ⟶ Y₁ ⊞ Y₂) : biprod.of_components (biprod.inl ≫ f ≫ biprod.fst) (biprod.inl ≫ f ≫ biprod.snd) (biprod.inr ≫ f ≫ biprod.fst) (biprod.inr ≫ f ≫ biprod.snd) = f := begin - ext; simp, + ext; + simp only [category.comp_id, biprod.inr_fst, biprod.inr_snd, biprod.inl_snd, add_zero, zero_add, + biprod.inl_of_components, biprod.inr_of_components, eq_self_iff_true, category.assoc, comp_zero, + biprod.inl_fst, preadditive.add_comp], end @[simp] @@ -267,14 +801,13 @@ end end -variables [preadditive.{v} C] - lemma biproduct.column_nonzero_of_iso' - {σ τ : Type v} [decidable_eq σ] [decidable_eq τ] [fintype τ] - {S : σ → C} [has_biproduct.{v} S] {T : τ → C} [has_biproduct.{v} T] + {σ τ : Type} [finite τ] + {S : σ → C} [has_biproduct S] {T : τ → C} [has_biproduct T] (s : σ) (f : ⨁ S ⟶ ⨁ T) [is_iso f] : (∀ t : τ, biproduct.ι S s ≫ f ≫ biproduct.π T t = 0) → 𝟙 (S s) = 0 := begin + casesI nonempty_fintype τ, intro z, set x := biproduct.ι S s ≫ f ≫ inv f ≫ biproduct.π S s, have h₁ : x = 𝟙 (S s), by simp [x], @@ -292,19 +825,229 @@ If `f : ⨁ S ⟶ ⨁ T` is an isomorphism, and `s` is a non-trivial summand of then there is some `t` in the target so that the `s, t` matrix entry of `f` is nonzero. -/ def biproduct.column_nonzero_of_iso - {σ τ : Type v} [decidable_eq σ] [decidable_eq τ] [fintype τ] - {S : σ → C} [has_biproduct.{v} S] {T : τ → C} [has_biproduct.{v} T] + {σ τ : Type} [fintype τ] + {S : σ → C} [has_biproduct S] {T : τ → C} [has_biproduct T] (s : σ) (nz : 𝟙 (S s) ≠ 0) - [∀ t, decidable_eq (S s ⟶ T t)] (f : ⨁ S ⟶ ⨁ T) [is_iso f] : trunc (Σ' t : τ, biproduct.ι S s ≫ f ≫ biproduct.π T t ≠ 0) := begin + classical, apply trunc_sigma_of_exists, - -- Do this before we run `classical`, so we get the right `decidable_eq` instances. have t := biproduct.column_nonzero_of_iso'.{v} s f, by_contradiction h, simp only [not_exists_not] at h, exact nz (t h) end +section preadditive +variables {D : Type.{u'}} [category.{v'} D] [preadditive.{v'} D] +variables (F : C ⥤ D) [preserves_zero_morphisms F] + +namespace limits + +section fintype +variables {J : Type} [fintype J] + +local attribute [tidy] tactic.discrete_cases + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts + preserves finite products. -/ +def preserves_product_of_preserves_biproduct {f : J → C} [preserves_biproduct f F] : + preserves_limit (discrete.functor f) F := +{ preserves := λ c hc, is_limit.of_iso_limit + ((is_limit.postcompose_inv_equiv (discrete.comp_nat_iso_discrete _ _) _).symm + (is_bilimit_of_preserves F (bicone_is_bilimit_of_limit_cone_of_is_limit hc)).is_limit) $ + cones.ext (iso.refl _) (by tidy) } + +section +local attribute [instance] preserves_product_of_preserves_biproduct + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts + preserves finite products. -/ +def preserves_products_of_shape_of_preserves_biproducts_of_shape + [preserves_biproducts_of_shape J F] : preserves_limits_of_shape (discrete J) F := +{ preserves_limit := λ f, preserves_limit_of_iso_diagram _ discrete.nat_iso_functor.symm } + +end + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite products + preserves finite biproducts. -/ +def preserves_biproduct_of_preserves_product {f : J → C} [preserves_limit (discrete.functor f) F] : + preserves_biproduct f F := +{ preserves := λ b hb, is_bilimit_of_is_limit _ $ + is_limit.of_iso_limit ((is_limit.postcompose_hom_equiv (discrete.comp_nat_iso_discrete _ _) + (F.map_cone b.to_cone)).symm (is_limit_of_preserves F hb.is_limit)) $ + cones.ext (iso.refl _) (by tidy) } + +/-- If the (product-like) biproduct comparison for `F` and `f` is a monomorphism, then `F` + preserves the biproduct of `f`. For the converse, see `map_biproduct`. -/ +def preserves_biproduct_of_mono_biproduct_comparison {f : J → C} [has_biproduct f] + [has_biproduct (F.obj ∘ f)] [mono (biproduct_comparison F f)] : preserves_biproduct f F := +begin + have : pi_comparison F f = (F.map_iso (biproduct.iso_product f)).inv ≫ + biproduct_comparison F f ≫ (biproduct.iso_product _).hom, + { ext, convert pi_comparison_comp_π F f j.as; simp [← functor.map_comp] }, + haveI : is_iso (biproduct_comparison F f) := is_iso_of_mono_of_is_split_epi _, + haveI : is_iso (pi_comparison F f) := by { rw this, apply_instance }, + haveI := preserves_product.of_iso_comparison F f, + apply preserves_biproduct_of_preserves_product +end + +/-- If the (coproduct-like) biproduct comparison for `F` and `f` is an epimorphism, then `F` + preserves the biproduct of `F` and `f`. For the converse, see `map_biproduct`. -/ +def preserves_biproduct_of_epi_biproduct_comparison' {f : J → C} [has_biproduct f] + [has_biproduct (F.obj ∘ f)] [epi (biproduct_comparison' F f)] : preserves_biproduct f F := +begin + haveI : epi ((split_epi_biproduct_comparison F f).section_) := by simpa, + haveI : is_iso (biproduct_comparison F f) := is_iso.of_epi_section' + (split_epi_biproduct_comparison F f), + apply preserves_biproduct_of_mono_biproduct_comparison +end + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite products + preserves finite biproducts. -/ +def preserves_biproducts_of_shape_of_preserves_products_of_shape + [preserves_limits_of_shape (discrete J) F] : preserves_biproducts_of_shape J F := +{ preserves := λ f, preserves_biproduct_of_preserves_product F } + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts + preserves finite coproducts. -/ +def preserves_coproduct_of_preserves_biproduct {f : J → C} [preserves_biproduct f F] : + preserves_colimit (discrete.functor f) F := +{ preserves := λ c hc, is_colimit.of_iso_colimit + ((is_colimit.precompose_hom_equiv (discrete.comp_nat_iso_discrete _ _) _).symm + (is_bilimit_of_preserves F + (bicone_is_bilimit_of_colimit_cocone_of_is_colimit hc)).is_colimit) $ + cocones.ext (iso.refl _) (by tidy) } + +section +local attribute [instance] preserves_coproduct_of_preserves_biproduct + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite biproducts + preserves finite coproducts. -/ +def preserves_coproducts_of_shape_of_preserves_biproducts_of_shape + [preserves_biproducts_of_shape J F] : preserves_colimits_of_shape (discrete J) F := +{ preserves_colimit := λ f, preserves_colimit_of_iso_diagram _ discrete.nat_iso_functor.symm } + +end + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite coproducts + preserves finite biproducts. -/ +def preserves_biproduct_of_preserves_coproduct {f : J → C} + [preserves_colimit (discrete.functor f) F] : preserves_biproduct f F := +{ preserves := λ b hb, is_bilimit_of_is_colimit _ $ + is_colimit.of_iso_colimit ((is_colimit.precompose_inv_equiv (discrete.comp_nat_iso_discrete _ _) + (F.map_cocone b.to_cocone)).symm (is_colimit_of_preserves F hb.is_colimit)) $ + cocones.ext (iso.refl _) (by tidy) } + +/-- A functor between preadditive categories that preserves (zero morphisms and) finite coproducts + preserves finite biproducts. -/ +def preserves_biproducts_of_shape_of_preserves_coproducts_of_shape + [preserves_colimits_of_shape (discrete J) F] : preserves_biproducts_of_shape J F := +{ preserves := λ f, preserves_biproduct_of_preserves_coproduct F } + +end fintype + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts + preserves binary products. -/ +def preserves_binary_product_of_preserves_binary_biproduct {X Y : C} + [preserves_binary_biproduct X Y F] : preserves_limit (pair X Y) F := +{ preserves := λ c hc, is_limit.of_iso_limit + ((is_limit.postcompose_inv_equiv (by exact diagram_iso_pair _) _).symm + (is_binary_bilimit_of_preserves F + (binary_bicone_is_bilimit_of_limit_cone_of_is_limit hc)).is_limit) $ + cones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩, tidy }) } + +section +local attribute [instance] preserves_binary_product_of_preserves_binary_biproduct + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts + preserves binary products. -/ +def preserves_binary_products_of_preserves_binary_biproducts + [preserves_binary_biproducts F] : preserves_limits_of_shape (discrete walking_pair) F := +{ preserves_limit := λ K, preserves_limit_of_iso_diagram _ (diagram_iso_pair _).symm } + +end + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary products + preserves binary biproducts. -/ +def preserves_binary_biproduct_of_preserves_binary_product {X Y : C} + [preserves_limit (pair X Y) F] : preserves_binary_biproduct X Y F := +{ preserves := λ b hb, is_binary_bilimit_of_is_limit _ $ + is_limit.of_iso_limit ((is_limit.postcompose_hom_equiv (by exact diagram_iso_pair _) + (F.map_cone b.to_cone)).symm (is_limit_of_preserves F hb.is_limit)) $ + cones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩, tidy }) } + +/-- If the (product-like) biproduct comparison for `F`, `X` and `Y` is a monomorphism, then + `F` preserves the biproduct of `X` and `Y`. For the converse, see `map_biprod`. -/ +def preserves_binary_biproduct_of_mono_biprod_comparison {X Y : C} [has_binary_biproduct X Y] + [has_binary_biproduct (F.obj X) (F.obj Y)] [mono (biprod_comparison F X Y)] : + preserves_binary_biproduct X Y F := +begin + have : prod_comparison F X Y = (F.map_iso (biprod.iso_prod X Y)).inv ≫ + biprod_comparison F X Y ≫ (biprod.iso_prod _ _).hom := by { ext; simp [← functor.map_comp] }, + haveI : is_iso (biprod_comparison F X Y) := is_iso_of_mono_of_is_split_epi _, + haveI : is_iso (prod_comparison F X Y) := by { rw this, apply_instance }, + haveI := preserves_limit_pair.of_iso_prod_comparison F X Y, + apply preserves_binary_biproduct_of_preserves_binary_product +end + +/-- If the (coproduct-like) biproduct comparison for `F`, `X` and `Y` is an epimorphism, then + `F` preserves the biproduct of `X` and `Y`. For the converse, see `map_biprod`. -/ +def preserves_binary_biproduct_of_epi_biprod_comparison' {X Y : C} [has_binary_biproduct X Y] + [has_binary_biproduct (F.obj X) (F.obj Y)] [epi (biprod_comparison' F X Y)] : + preserves_binary_biproduct X Y F := +begin + haveI : epi ((split_epi_biprod_comparison F X Y).section_) := by simpa, + haveI : is_iso (biprod_comparison F X Y) := is_iso.of_epi_section' + (split_epi_biprod_comparison F X Y), + apply preserves_binary_biproduct_of_mono_biprod_comparison +end + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary products + preserves binary biproducts. -/ +def preserves_binary_biproducts_of_preserves_binary_products + [preserves_limits_of_shape (discrete walking_pair) F] : preserves_binary_biproducts F := +{ preserves := λ X Y, preserves_binary_biproduct_of_preserves_binary_product F } + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts + preserves binary coproducts. -/ +def preserves_binary_coproduct_of_preserves_binary_biproduct {X Y : C} + [preserves_binary_biproduct X Y F] : preserves_colimit (pair X Y) F := +{ preserves := λ c hc, is_colimit.of_iso_colimit + ((is_colimit.precompose_hom_equiv (by exact diagram_iso_pair _) _).symm + (is_binary_bilimit_of_preserves F + (binary_bicone_is_bilimit_of_colimit_cocone_of_is_colimit hc)).is_colimit) $ + cocones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩, tidy }) } + +section +local attribute [instance] preserves_binary_coproduct_of_preserves_binary_biproduct + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary biproducts + preserves binary coproducts. -/ +def preserves_binary_coproducts_of_preserves_binary_biproducts + [preserves_binary_biproducts F] : preserves_colimits_of_shape (discrete walking_pair) F := +{ preserves_colimit := λ K, preserves_colimit_of_iso_diagram _ (diagram_iso_pair _).symm } + +end + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary coproducts + preserves binary biproducts. -/ +def preserves_binary_biproduct_of_preserves_binary_coproduct {X Y : C} + [preserves_colimit (pair X Y) F] : preserves_binary_biproduct X Y F := +{ preserves := λ b hb, is_binary_bilimit_of_is_colimit _ $ + is_colimit.of_iso_colimit ((is_colimit.precompose_inv_equiv (by exact diagram_iso_pair _) + (F.map_cocone b.to_cocone)).symm (is_colimit_of_preserves F hb.is_colimit)) $ + cocones.ext (iso.refl _) (λ j, by { rcases j with ⟨⟨⟩⟩, tidy }) } + +/-- A functor between preadditive categories that preserves (zero morphisms and) binary coproducts + preserves binary biproducts. -/ +def preserves_binary_biproducts_of_preserves_binary_coproducts + [preserves_colimits_of_shape (discrete walking_pair) F] : preserves_binary_biproducts F := +{ preserves := λ X Y, preserves_binary_biproduct_of_preserves_binary_coproduct F } + +end limits + +end preadditive + end category_theory diff --git a/src/category_theory/preadditive/default.lean b/src/category_theory/preadditive/default.lean deleted file mode 100644 index e7e601d26845e..0000000000000 --- a/src/category_theory/preadditive/default.lean +++ /dev/null @@ -1,333 +0,0 @@ -/- -Copyright (c) 2020 Markus Himmel. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Markus Himmel, Jakob von Raumer --/ -import algebra.big_operators.basic -import algebra.hom.group -import algebra.module.basic -import category_theory.endomorphism -import category_theory.limits.shapes.kernels - -/-! -# Preadditive categories - -A preadditive category is a category in which `X ⟶ Y` is an abelian group in such a way that -composition of morphisms is linear in both variables. - -This file contains a definition of preadditive category that directly encodes the definition given -above. The definition could also be phrased as follows: A preadditive category is a category -enriched over the category of Abelian groups. Once the general framework to state this in Lean is -available, the contents of this file should become obsolete. - -## Main results - -* Definition of preadditive categories and basic properties -* In a preadditive category, `f : Q ⟶ R` is mono if and only if `g ≫ f = 0 → g = 0` for all - composable `g`. -* A preadditive category with kernels has equalizers. - -## Implementation notes - -The simp normal form for negation and composition is to push negations as far as possible to -the outside. For example, `f ≫ (-g)` and `(-f) ≫ g` both become `-(f ≫ g)`, and `(-f) ≫ (-g)` -is simplified to `f ≫ g`. - -## References - -* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2] - -## Tags - -additive, preadditive, Hom group, Ab-category, Ab-enriched --/ - -universes v u - -open category_theory.limits - -open_locale big_operators - -namespace category_theory - -variables (C : Type u) [category.{v} C] - -/-- A category is called preadditive if `P ⟶ Q` is an abelian group such that composition is - linear in both variables. -/ -class preadditive := -(hom_group : Π P Q : C, add_comm_group (P ⟶ Q) . tactic.apply_instance) -(add_comp' : ∀ (P Q R : C) (f f' : P ⟶ Q) (g : Q ⟶ R), - (f + f') ≫ g = f ≫ g + f' ≫ g . obviously) -(comp_add' : ∀ (P Q R : C) (f : P ⟶ Q) (g g' : Q ⟶ R), - f ≫ (g + g') = f ≫ g + f ≫ g' . obviously) - -attribute [instance] preadditive.hom_group -restate_axiom preadditive.add_comp' -restate_axiom preadditive.comp_add' -attribute [simp,reassoc] preadditive.add_comp -attribute [reassoc] preadditive.comp_add -- (the linter doesn't like `simp` on this lemma) -attribute [simp] preadditive.comp_add - -end category_theory - -open category_theory - -namespace category_theory -namespace preadditive - -section preadditive -open add_monoid_hom -variables {C : Type u} [category.{v} C] [preadditive C] - -section induced_category -universes u' -variables {C} {D : Type u'} (F : D → C) - -instance induced_category.category : preadditive.{v} (induced_category C F) := -{ hom_group := λ P Q, @preadditive.hom_group C _ _ (F P) (F Q), - add_comp' := λ P Q R f f' g, add_comp' _ _ _ _ _ _, - comp_add' := λ P Q R f g g', comp_add' _ _ _ _ _ _, } - -end induced_category - -instance (X : C) : add_comm_group (End X) := by { dsimp [End], apply_instance, } - -instance (X : C) : ring (End X) := -{ left_distrib := λ f g h, preadditive.add_comp X X X g h f, - right_distrib := λ f g h, preadditive.comp_add X X X h f g, - ..(infer_instance : add_comm_group (End X)), - ..(infer_instance : monoid (End X)) } - -/-- Composition by a fixed left argument as a group homomorphism -/ -def left_comp {P Q : C} (R : C) (f : P ⟶ Q) : (Q ⟶ R) →+ (P ⟶ R) := -mk' (λ g, f ≫ g) $ λ g g', by simp - -/-- Composition by a fixed right argument as a group homomorphism -/ -def right_comp (P : C) {Q R : C} (g : Q ⟶ R) : (P ⟶ Q) →+ (P ⟶ R) := -mk' (λ f, f ≫ g) $ λ f f', by simp - -variables {P Q R : C} (f f' : P ⟶ Q) (g g' : Q ⟶ R) - -/-- Composition as a bilinear group homomorphism -/ -def comp_hom : (P ⟶ Q) →+ (Q ⟶ R) →+ (P ⟶ R) := -add_monoid_hom.mk' (λ f, left_comp _ f) $ - λ f₁ f₂, add_monoid_hom.ext $ λ g, (right_comp _ g).map_add f₁ f₂ - -@[simp, reassoc] lemma sub_comp : - (f - f') ≫ g = f ≫ g - f' ≫ g := -map_sub (right_comp P g) f f' - --- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma. -@[reassoc, simp] lemma comp_sub : - f ≫ (g - g') = f ≫ g - f ≫ g' := -map_sub (left_comp R f) g g' - -@[simp, reassoc] lemma neg_comp : (-f) ≫ g = -(f ≫ g) := -map_neg (right_comp P g) f - -/- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma. -/ -@[reassoc, simp] lemma comp_neg : f ≫ (-g) = -(f ≫ g) := -map_neg (left_comp R f) g - -@[reassoc] lemma neg_comp_neg : (-f) ≫ (-g) = f ≫ g := -by simp - -lemma nsmul_comp (n : ℕ) : (n • f) ≫ g = n • (f ≫ g) := -map_nsmul (right_comp P g) n f - -lemma comp_nsmul (n : ℕ) : f ≫ (n • g) = n • (f ≫ g) := -map_nsmul (left_comp R f) n g - -lemma zsmul_comp (n : ℤ) : (n • f) ≫ g = n • (f ≫ g) := -map_zsmul (right_comp P g) n f - -lemma comp_zsmul (n : ℤ) : f ≫ (n • g) = n • (f ≫ g) := -map_zsmul (left_comp R f) n g - -@[reassoc] lemma comp_sum {P Q R : C} {J : Type*} (s : finset J) (f : P ⟶ Q) (g : J → (Q ⟶ R)) : - f ≫ ∑ j in s, g j = ∑ j in s, f ≫ g j := -map_sum (left_comp R f) _ _ - -@[reassoc] lemma sum_comp {P Q R : C} {J : Type*} (s : finset J) (f : J → (P ⟶ Q)) (g : Q ⟶ R) : - (∑ j in s, f j) ≫ g = ∑ j in s, f j ≫ g := -map_sum (right_comp P g) _ _ - -instance {P Q : C} {f : P ⟶ Q} [epi f] : epi (-f) := -⟨λ R g g' H, by rwa [neg_comp, neg_comp, ←comp_neg, ←comp_neg, cancel_epi, neg_inj] at H⟩ - -instance {P Q : C} {f : P ⟶ Q} [mono f] : mono (-f) := -⟨λ R g g' H, by rwa [comp_neg, comp_neg, ←neg_comp, ←neg_comp, cancel_mono, neg_inj] at H⟩ - -@[priority 100] -instance preadditive_has_zero_morphisms : has_zero_morphisms C := -{ has_zero := infer_instance, - comp_zero' := λ P Q f R, show left_comp R f 0 = 0, from map_zero _, - zero_comp' := λ P Q R f, show right_comp P f 0 = 0, from map_zero _ } - -instance module_End_right {X Y : C} : module (End Y) (X ⟶ Y) := -{ smul_add := λ r f g, add_comp _ _ _ _ _ _, - smul_zero := λ r, zero_comp, - add_smul := λ r s f, comp_add _ _ _ _ _ _, - zero_smul := λ r, comp_zero } - -lemma mono_of_cancel_zero {Q R : C} (f : Q ⟶ R) (h : ∀ {P : C} (g : P ⟶ Q), g ≫ f = 0 → g = 0) : - mono f := -⟨λ P g g' hg, sub_eq_zero.1 $ h _ $ (map_sub (right_comp P f) g g').trans $ sub_eq_zero.2 hg⟩ - -lemma mono_iff_cancel_zero {Q R : C} (f : Q ⟶ R) : - mono f ↔ ∀ (P : C) (g : P ⟶ Q), g ≫ f = 0 → g = 0 := -⟨λ m P g, by exactI zero_of_comp_mono _, mono_of_cancel_zero f⟩ - -lemma mono_of_kernel_zero {X Y : C} {f : X ⟶ Y} [has_limit (parallel_pair f 0)] - (w : kernel.ι f = 0) : mono f := -mono_of_cancel_zero f (λ P g h, by rw [←kernel.lift_ι f g h, w, limits.comp_zero]) - -lemma epi_of_cancel_zero {P Q : C} (f : P ⟶ Q) (h : ∀ {R : C} (g : Q ⟶ R), f ≫ g = 0 → g = 0) : - epi f := -⟨λ R g g' hg, sub_eq_zero.1 $ h _ $ (map_sub (left_comp R f) g g').trans $ sub_eq_zero.2 hg⟩ - -lemma epi_iff_cancel_zero {P Q : C} (f : P ⟶ Q) : - epi f ↔ ∀ (R : C) (g : Q ⟶ R), f ≫ g = 0 → g = 0 := -⟨λ e R g, by exactI zero_of_epi_comp _, epi_of_cancel_zero f⟩ - -lemma epi_of_cokernel_zero {X Y : C} {f : X ⟶ Y} [has_colimit (parallel_pair f 0 )] - (w : cokernel.π f = 0) : epi f := -epi_of_cancel_zero f (λ P g h, by rw [←cokernel.π_desc f g h, w, limits.zero_comp]) - -namespace is_iso - -@[simp] lemma comp_left_eq_zero [is_iso f] : - f ≫ g = 0 ↔ g = 0 := -by rw [← is_iso.eq_inv_comp, limits.comp_zero] - -@[simp] lemma comp_right_eq_zero [is_iso g] : - f ≫ g = 0 ↔ f = 0 := -by rw [← is_iso.eq_comp_inv, limits.zero_comp] - -end is_iso - -open_locale zero_object -variables [has_zero_object C] - -lemma mono_of_kernel_iso_zero {X Y : C} {f : X ⟶ Y} [has_limit (parallel_pair f 0)] - (w : kernel f ≅ 0) : mono f := -mono_of_kernel_zero (zero_of_source_iso_zero _ w) - -lemma epi_of_cokernel_iso_zero {X Y : C} {f : X ⟶ Y} [has_colimit (parallel_pair f 0)] - (w : cokernel f ≅ 0) : epi f := -epi_of_cokernel_zero (zero_of_target_iso_zero _ w) - -end preadditive - -section equalizers -variables {C : Type u} [category.{v} C] [preadditive C] - -section -variables {X Y : C} {f : X ⟶ Y} {g : X ⟶ Y} - -/-- Map a kernel cone on the difference of two morphisms to the equalizer fork. -/ -def fork_of_kernel_fork (c : kernel_fork (f - g)) : fork f g := -fork.of_ι c.ι $ by rw [← sub_eq_zero, ← comp_sub, c.condition] - -/-- Map any equalizer fork to a cone on the difference of the two morphisms. -/ -def kernel_fork_of_fork (c : fork f g) : kernel_fork (f - g) := -fork.of_ι c.ι $ by rw [comp_sub, comp_zero, sub_eq_zero, c.condition] - -@[simp] lemma kernel_fork_of_fork_ι (c : fork f g) : (kernel_fork_of_fork c).ι = c.ι := rfl - -@[simp] lemma kernel_fork_of_fork_of_ι {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) : - (kernel_fork_of_fork (fork.of_ι ι w)) = kernel_fork.of_ι ι (by simp [w]) := rfl - -/-- A kernel of `f - g` is an equalizer of `f` and `g`. -/ -def is_limit_fork_of_kernel_fork {c : kernel_fork (f - g)} (i : is_limit c) : - is_limit (fork_of_kernel_fork c) := -fork.is_limit.mk' _ $ λ s, - ⟨i.lift (kernel_fork_of_fork s), i.fac _ _, - λ m h, by apply fork.is_limit.hom_ext i; tidy⟩ - -@[simp] -lemma is_limit_fork_of_kernel_fork_lift {c : kernel_fork (f - g)} (i : is_limit c) (s : fork f g) : - (is_limit_fork_of_kernel_fork i).lift s = i.lift (kernel_fork_of_fork s) := rfl - -/-- An equalizer of `f` and `g` is a kernel of `f - g`. -/ -def is_limit_kernel_fork_of_fork {c : fork f g} (i : is_limit c) : - is_limit (kernel_fork_of_fork c) := -fork.is_limit.mk' _ $ λ s, - ⟨i.lift (fork_of_kernel_fork s), i.fac _ _, - λ m h, by apply fork.is_limit.hom_ext i; tidy⟩ - -variables (f g) - -/-- A preadditive category has an equalizer for `f` and `g` if it has a kernel for `f - g`. -/ -lemma has_equalizer_of_has_kernel [has_kernel (f - g)] : has_equalizer f g := -has_limit.mk { cone := fork_of_kernel_fork _, - is_limit := is_limit_fork_of_kernel_fork (equalizer_is_equalizer (f - g) 0) } - -/-- A preadditive category has a kernel for `f - g` if it has an equalizer for `f` and `g`. -/ -lemma has_kernel_of_has_equalizer [has_equalizer f g] : has_kernel (f - g) := -has_limit.mk { cone := kernel_fork_of_fork (equalizer.fork f g), - is_limit := is_limit_kernel_fork_of_fork (limit.is_limit (parallel_pair f g)) } - -variables {f g} - -/-- Map a cokernel cocone on the difference of two morphisms to the coequalizer cofork. -/ -def cofork_of_cokernel_cofork (c : cokernel_cofork (f - g)) : cofork f g := -cofork.of_π c.π $ by rw [← sub_eq_zero, ← sub_comp, c.condition] - -/-- Map any coequalizer cofork to a cocone on the difference of the two morphisms. -/ -def cokernel_cofork_of_cofork (c : cofork f g) : cokernel_cofork (f - g) := -cofork.of_π c.π $ by rw [sub_comp, zero_comp, sub_eq_zero, c.condition] - -@[simp] lemma cokernel_cofork_of_cofork_π (c : cofork f g) : - (cokernel_cofork_of_cofork c).π = c.π := rfl - -@[simp] lemma cokernel_cofork_of_cofork_of_π {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) : - (cokernel_cofork_of_cofork (cofork.of_π π w)) = cokernel_cofork.of_π π (by simp [w]) := rfl - -/-- A cokernel of `f - g` is a coequalizer of `f` and `g`. -/ -def is_colimit_cofork_of_cokernel_cofork {c : cokernel_cofork (f - g)} (i : is_colimit c) : - is_colimit (cofork_of_cokernel_cofork c) := -cofork.is_colimit.mk' _ $ λ s, - ⟨i.desc (cokernel_cofork_of_cofork s), i.fac _ _, - λ m h, by apply cofork.is_colimit.hom_ext i; tidy⟩ - -@[simp] -lemma is_colimit_cofork_of_cokernel_cofork_desc {c : cokernel_cofork (f - g)} - (i : is_colimit c) (s : cofork f g) : - (is_colimit_cofork_of_cokernel_cofork i).desc s = i.desc (cokernel_cofork_of_cofork s) := rfl - -/-- A coequalizer of `f` and `g` is a cokernel of `f - g`. -/ -def is_colimit_cokernel_cofork_of_cofork {c : cofork f g} (i : is_colimit c) : - is_colimit (cokernel_cofork_of_cofork c) := -cofork.is_colimit.mk' _ $ λ s, - ⟨i.desc (cofork_of_cokernel_cofork s), i.fac _ _, - λ m h, by apply cofork.is_colimit.hom_ext i; tidy⟩ - -variables (f g) - -/-- A preadditive category has a coequalizer for `f` and `g` if it has a cokernel for `f - g`. -/ -lemma has_coequalizer_of_has_cokernel [has_cokernel (f - g)] : has_coequalizer f g := -has_colimit.mk { cocone := cofork_of_cokernel_cofork _, - is_colimit := is_colimit_cofork_of_cokernel_cofork (coequalizer_is_coequalizer (f - g) 0) } - -/-- A preadditive category has a cokernel for `f - g` if it has a coequalizer for `f` and `g`. -/ -lemma has_cokernel_of_has_coequalizer [has_coequalizer f g] : has_cokernel (f - g) := -has_colimit.mk { cocone := cokernel_cofork_of_cofork (coequalizer.cofork f g), - is_colimit := is_colimit_cokernel_cofork_of_cofork (colimit.is_colimit (parallel_pair f g)) } - -end - -/-- If a preadditive category has all kernels, then it also has all equalizers. -/ -lemma has_equalizers_of_has_kernels [has_kernels C] : has_equalizers C := -@has_equalizers_of_has_limit_parallel_pair _ _ (λ _ _ f g, has_equalizer_of_has_kernel f g) - - -/-- If a preadditive category has all cokernels, then it also has all coequalizers. -/ -lemma has_coequalizers_of_has_cokernels [has_cokernels C] : has_coequalizers C := -@has_coequalizers_of_has_colimit_parallel_pair _ _ (λ _ _ f g, has_coequalizer_of_has_cokernel f g) - -end equalizers - -end preadditive - -end category_theory diff --git a/src/category_theory/preadditive/eilenberg_moore.lean b/src/category_theory/preadditive/eilenberg_moore.lean new file mode 100644 index 0000000000000..fdb3f3332c170 --- /dev/null +++ b/src/category_theory/preadditive/eilenberg_moore.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2022 Julian Kuelshammer. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Julian Kuelshammer +-/ + +import category_theory.preadditive.basic +import category_theory.monad.algebra +import category_theory.preadditive.additive_functor + +/-! +# Preadditive structure on algebras over a monad + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +If `C` is a preadditive categories and `T` is an additive monad on `C` then `algebra T` is also +preadditive. Dually, if `U` is an additive comonad on `C` then `coalgebra U` is preadditive as well. + +-/ + +universes v₁ u₁ -- morphism levels before object levels. See note [category_theory universes]. + +namespace category_theory +variables (C : Type u₁) [category.{v₁} C] [preadditive C] (T : monad C) + [functor.additive (T : C ⥤ C)] + +open category_theory.limits preadditive + +/-- The category of algebras over an additive monad on a preadditive category is preadditive. -/ +@[simps] +instance monad.algebra_preadditive : preadditive (monad.algebra T) := +{ hom_group := λ F G, + { add := λ α β, + { f := α.f + β.f, + h' := by simp only [functor.map_add, add_comp, monad.algebra.hom.h, comp_add] }, + zero := + { f := 0, + h' := by simp only [functor.map_zero, zero_comp, comp_zero] }, + nsmul := λ n α, + { f := n • α.f, + h' := by rw [functor.map_nsmul, nsmul_comp, monad.algebra.hom.h, comp_nsmul] }, + neg := λ α, + { f := -α.f, + h' := by simp only [functor.map_neg, neg_comp, monad.algebra.hom.h, comp_neg] }, + sub := λ α β, + { f := α.f - β.f, + h' := by simp only [functor.map_sub, sub_comp, monad.algebra.hom.h, comp_sub] }, + zsmul := λ r α, + { f := r • α.f, + h' := by rw [functor.map_zsmul, zsmul_comp, monad.algebra.hom.h, comp_zsmul] }, + add_assoc := by { intros, ext, apply add_assoc }, + zero_add := by { intros, ext, apply zero_add }, + add_zero := by { intros, ext, apply add_zero }, + nsmul_zero' := by { intros, ext, apply zero_smul }, + nsmul_succ' := by { intros, ext, apply succ_nsmul }, + sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg }, + zsmul_zero' := by { intros, ext, apply zero_smul }, + zsmul_succ' := by { intros, ext, dsimp, simp only [coe_nat_zsmul, succ_nsmul], refl, }, + zsmul_neg' := by { intros, ext, simp only [zsmul_neg_succ_of_nat, neg_inj, + nsmul_eq_smul_cast ℤ] }, + add_left_neg := by { intros, ext, apply add_left_neg }, + add_comm := by { intros, ext, apply add_comm } }, + add_comp' := by { intros, ext, apply add_comp }, + comp_add' := by { intros, ext, apply comp_add } } + +instance monad.forget_additive : (monad.forget T).additive := {} + +variables (U : comonad C) [functor.additive (U : C ⥤ C)] + +/-- The category of coalgebras over an additive comonad on a preadditive category is preadditive. -/ +@[simps] +instance comonad.coalgebra_preadditive : preadditive (comonad.coalgebra U) := +{ hom_group := λ F G, + { add := λ α β, + { f := α.f + β.f, + h' := by simp only [functor.map_add, comp_add, comonad.coalgebra.hom.h, add_comp] }, + zero := + { f := 0, + h' := by simp only [functor.map_zero, comp_zero, zero_comp] }, + nsmul := λ n α, + { f := n • α.f, + h' := by rw [functor.map_nsmul, comp_nsmul, comonad.coalgebra.hom.h, nsmul_comp] }, + neg := λ α, + { f := -α.f, + h' := by simp only [functor.map_neg, comp_neg, comonad.coalgebra.hom.h, neg_comp] }, + sub := λ α β, + { f := α.f - β.f, + h' := by simp only [functor.map_sub, comp_sub, comonad.coalgebra.hom.h, sub_comp] }, + zsmul := λ r α, + { f := r • α.f, + h' := by rw [functor.map_zsmul, comp_zsmul, comonad.coalgebra.hom.h, zsmul_comp] }, + add_assoc := by { intros, ext, apply add_assoc }, + zero_add := by { intros, ext, apply zero_add }, + add_zero := by { intros, ext, apply add_zero }, + nsmul_zero' := by { intros, ext, apply zero_smul }, + nsmul_succ' := by { intros, ext, apply succ_nsmul }, + sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg }, + zsmul_zero' := by { intros, ext, apply zero_smul }, + zsmul_succ' := by { intros, ext, dsimp, simp only [coe_nat_zsmul, succ_nsmul], refl, }, + zsmul_neg' := by { intros, ext, simp only [zsmul_neg_succ_of_nat, neg_inj, + nsmul_eq_smul_cast ℤ] }, + add_left_neg := by { intros, ext, apply add_left_neg }, + add_comm := by { intros, ext, apply add_comm } }, + add_comp' := by { intros, ext, apply add_comp }, + comp_add' := by { intros, ext, apply comp_add } } + +instance comonad.forget_additive : (comonad.forget U).additive := {} + +end category_theory diff --git a/src/category_theory/preadditive/endo_functor.lean b/src/category_theory/preadditive/endo_functor.lean new file mode 100644 index 0000000000000..9bdf2f5e3cbf7 --- /dev/null +++ b/src/category_theory/preadditive/endo_functor.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2022 Julian Kuelshammer. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Julian Kuelshammer +-/ + +import category_theory.preadditive.basic +import category_theory.endofunctor.algebra +import category_theory.preadditive.additive_functor + +/-! +# Preadditive structure on algebras over a monad + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +If `C` is a preadditive categories and `F` is an additive endofunctor on `C` then `algebra F` is +also preadditive. Dually, the category `coalgebra F` is also preadditive. +-/ + +universes v₁ u₁ -- morphism levels before object levels. See note [category_theory universes]. + +namespace category_theory +variables (C : Type u₁) [category.{v₁} C] [preadditive C] (F : C ⥤ C) + [functor.additive (F : C ⥤ C)] + +open category_theory.limits preadditive + +/-- The category of algebras over an additive endofunctor on a preadditive category is preadditive. +-/ +@[simps] +instance endofunctor.algebra_preadditive : preadditive (endofunctor.algebra F) := +{ hom_group := λ A₁ A₂, { add := λ α β, + { f := α.f + β.f, + h' := by simp only [functor.map_add, add_comp, endofunctor.algebra.hom.h, comp_add] }, + zero := + { f := 0, + h' := by simp only [functor.map_zero, zero_comp, comp_zero] }, + nsmul := λ n α, + { f := n • α.f, + h' := by rw [comp_nsmul, functor.map_nsmul, nsmul_comp, endofunctor.algebra.hom.h] }, + neg := λ α, + { f := -α.f, + h' := by simp only [functor.map_neg, neg_comp, endofunctor.algebra.hom.h, comp_neg] }, + sub := λ α β, + { f := α.f - β.f, + h' := by simp only [functor.map_sub, sub_comp, endofunctor.algebra.hom.h, comp_sub] }, + zsmul := λ r α, + { f := r • α.f, + h' := by rw [comp_zsmul, functor.map_zsmul, zsmul_comp, endofunctor.algebra.hom.h] }, + add_assoc := by { intros, ext, apply add_assoc }, + zero_add := by { intros, ext, apply zero_add }, + add_zero := by { intros, ext, apply add_zero }, + nsmul_zero' := by { intros, ext, apply zero_smul }, + nsmul_succ' := by { intros, ext, apply succ_nsmul }, + sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg }, + zsmul_zero' := by { intros, ext, apply zero_smul }, + zsmul_succ' := by { intros, ext, dsimp, simp only [coe_nat_zsmul, succ_nsmul], refl, }, + zsmul_neg' := by { intros, ext, simp only [zsmul_neg_succ_of_nat, neg_inj, + nsmul_eq_smul_cast ℤ] }, + add_left_neg := by { intros, ext, apply add_left_neg }, + add_comm := by { intros, ext, apply add_comm } }, + add_comp' := by { intros, ext, apply add_comp }, + comp_add' := by { intros, ext, apply comp_add } } + +instance algebra.forget_additive : (endofunctor.algebra.forget F).additive := {} + +@[simps] +instance endofunctor.coalgebra_preadditive : preadditive (endofunctor.coalgebra F) := +{ hom_group := λ A₁ A₂, { add := λ α β, + { f := α.f + β.f, + h' := by simp only [functor.map_add, comp_add, endofunctor.coalgebra.hom.h, add_comp] }, + zero := + { f := 0, + h' := by simp only [functor.map_zero, zero_comp, comp_zero] }, + nsmul := λ n α, + { f := n • α.f, + h' := by rw [functor.map_nsmul, comp_nsmul, endofunctor.coalgebra.hom.h, nsmul_comp] }, + neg := λ α, + { f := -α.f, + h' := by simp only [functor.map_neg, comp_neg, endofunctor.coalgebra.hom.h, neg_comp] }, + sub := λ α β, + { f := α.f - β.f, + h' := by simp only [functor.map_sub, comp_sub, endofunctor.coalgebra.hom.h, sub_comp] }, + zsmul := λ r α, + { f := r • α.f, + h' := by rw [functor.map_zsmul, comp_zsmul, endofunctor.coalgebra.hom.h, zsmul_comp] }, + add_assoc := by { intros, ext, apply add_assoc }, + zero_add := by { intros, ext, apply zero_add }, + add_zero := by { intros, ext, apply add_zero }, + nsmul_zero' := by { intros, ext, apply zero_smul }, + nsmul_succ' := by { intros, ext, apply succ_nsmul }, + sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg }, + zsmul_zero' := by { intros, ext, apply zero_smul }, + zsmul_succ' := by { intros, ext, dsimp, simp only [coe_nat_zsmul, succ_nsmul], refl, }, + zsmul_neg' := by { intros, ext, simp only [zsmul_neg_succ_of_nat, neg_inj, + nsmul_eq_smul_cast ℤ] }, + add_left_neg := by { intros, ext, apply add_left_neg }, + add_comm := by { intros, ext, apply add_comm } }, + add_comp' := by { intros, ext, apply add_comp }, + comp_add' := by { intros, ext, apply comp_add } } + +instance coalgebra.forget_additive : (endofunctor.coalgebra.forget F).additive := {} + +end category_theory diff --git a/src/category_theory/preadditive/functor_category.lean b/src/category_theory/preadditive/functor_category.lean index 1d6dc357ec7db..6117d69648326 100644 --- a/src/category_theory/preadditive/functor_category.lean +++ b/src/category_theory/preadditive/functor_category.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ -import category_theory.preadditive.default +import category_theory.preadditive.basic /-! # Preadditive structure on functor categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If `C` and `D` are categories and `D` is preadditive, then `C ⥤ D` is also preadditive. @@ -65,7 +68,7 @@ as group homomorphism -/ (app_hom X).map_nsmul α n @[simp] lemma app_zsmul (X : C) (α : F ⟶ G) (n : ℤ) : (n • α).app X = n • α.app X := -(app_hom X).map_zsmul α n +(app_hom X : (F ⟶ G) →+ (F.obj X ⟶ G.obj X)).map_zsmul α n @[simp] lemma app_sum {ι : Type*} (s : finset ι) (X : C) (α : ι → (F ⟶ G)) : (∑ i in s, α i).app X = ∑ i in s, ((α i).app X) := diff --git a/src/category_theory/preadditive/generator.lean b/src/category_theory/preadditive/generator.lean index 2bd0885545ce6..c096257eed802 100644 --- a/src/category_theory/preadditive/generator.lean +++ b/src/category_theory/preadditive/generator.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel -/ import category_theory.generator -import category_theory.preadditive.yoneda +import category_theory.preadditive.yoneda.basic /-! # Separators in preadditive categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains characterizations of separating sets and objects that are valid in all preadditive categories. diff --git a/src/category_theory/preadditive/hom_orthogonal.lean b/src/category_theory/preadditive/hom_orthogonal.lean new file mode 100644 index 0000000000000..3e8d5b54b5aa6 --- /dev/null +++ b/src/category_theory/preadditive/hom_orthogonal.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2022 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import category_theory.linear.basic +import category_theory.preadditive.biproducts +import linear_algebra.matrix.invariant_basis_number + +/-! +# Hom orthogonal families. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A family of objects in a category with zero morphisms is "hom orthogonal" if the only +morphism between distinct objects is the zero morphism. + +We show that in any category with zero morphisms and finite biproducts, +a morphism between biproducts drawn from a hom orthogonal family `s : ι → C` +can be decomposed into a block diagonal matrix with entries in the endomorphism rings of the `s i`. + +When the category is preadditive, this decomposition is an additive equivalence, +and intertwines composition and matrix multiplication. +When the category is `R`-linear, the decomposition is an `R`-linear equivalence. + +If every object in the hom orthogonal family has an endomorphism ring with invariant basis number +(e.g. if each object in the family is simple, so its endomorphism ring is a division ring, +or otherwise if each endomorphism ring is commutative), +then decompositions of an object as a biproduct of the family have uniquely defined multiplicities. +We state this as: +``` +lemma hom_orthogonal.equiv_of_iso (o : hom_orthogonal s) {f : α → ι} {g : β → ι} + (i : ⨁ (λ a, s (f a)) ≅ ⨁ (λ b, s (g b))) : ∃ e : α ≃ β, ∀ a, g (e a) = f a +``` + +This is preliminary to defining semisimple categories. +-/ + +open_locale classical matrix + +open category_theory.limits + +universes v u + +namespace category_theory + +variables {C : Type u} [category.{v} C] + +/-- A family of objects is "hom orthogonal" if +there is at most one morphism between distinct objects. + +(In a category with zero morphisms, that must be the zero morphism.) -/ +def hom_orthogonal {ι : Type*} (s : ι → C) : Prop := +∀ i j, i ≠ j → subsingleton (s i ⟶ s j) + +namespace hom_orthogonal + +variables {ι : Type*} {s : ι → C} + +lemma eq_zero [has_zero_morphisms C] (o : hom_orthogonal s) + {i j : ι} (w : i ≠ j) (f : s i ⟶ s j) : f = 0 := +by { haveI := o i j w, apply subsingleton.elim, } + +section +variables [has_zero_morphisms C] [has_finite_biproducts C] + +/-- Morphisms between two direct sums over a hom orthogonal family `s : ι → C` +are equivalent to block diagonal matrices, +with blocks indexed by `ι`, +and matrix entries in `i`-th block living in the endomorphisms of `s i`. -/ +@[simps] noncomputable +def matrix_decomposition + (o : hom_orthogonal s) {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} : + (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃ + Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) := +{ to_fun := λ z i j k, + eq_to_hom (by { rcases k with ⟨k, ⟨⟩⟩, simp, }) ≫ + biproduct.components z k j ≫ eq_to_hom (by { rcases j with ⟨j, ⟨⟩⟩, simp, }), + inv_fun := λ z, biproduct.matrix (λ j k, if h : f j = g k then + z (f j) ⟨k, by simp [h]⟩ ⟨j, by simp⟩ ≫ eq_to_hom (by simp [h]) + else + 0), + left_inv := λ z, begin + ext j k, + simp only [category.assoc, biproduct.lift_π, biproduct.ι_matrix], + split_ifs, + { simp, refl, }, + { symmetry, apply o.eq_zero h, }, + end, + right_inv := λ z, begin + ext i ⟨j, w⟩ ⟨k, ⟨⟩⟩, + simp only [set.mem_preimage, set.mem_singleton_iff], + simp [w.symm], refl, + end, } + +end + +section +variables [preadditive C] [has_finite_biproducts C] + +/-- `hom_orthogonal.matrix_decomposition` as an additive equivalence. -/ +@[simps] noncomputable +def matrix_decomposition_add_equiv + (o : hom_orthogonal s) {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} : + (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃+ + Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) := +{ map_add' := λ w z, by { ext, dsimp [biproduct.components], simp, }, + ..o.matrix_decomposition, }. + +@[simp] +lemma matrix_decomposition_id + (o : hom_orthogonal s) {α : Type} [fintype α] {f : α → ι} (i : ι) : + o.matrix_decomposition (𝟙 (⨁ (λ a, s (f a)))) i = 1 := +begin + ext ⟨b, ⟨⟩⟩ ⟨a⟩, + simp only [set.mem_preimage, set.mem_singleton_iff] at j_property, + simp only [category.comp_id, category.id_comp, category.assoc, End.one_def, eq_to_hom_refl, + matrix.one_apply, hom_orthogonal.matrix_decomposition_apply, biproduct.components], + split_ifs with h, + { cases h, simp, }, + { convert comp_zero, + simpa using biproduct.ι_π_ne _ (ne.symm h), }, +end + +lemma matrix_decomposition_comp + (o : hom_orthogonal s) + {α β γ : Type} [fintype α] [fintype β] [fintype γ] {f : α → ι} {g : β → ι} {h : γ → ι} + (z : (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b)))) (w : (⨁ (λ b, s (g b)) ⟶ ⨁ (λ c, s (h c)))) + (i : ι) : + o.matrix_decomposition (z ≫ w) i = o.matrix_decomposition w i ⬝ o.matrix_decomposition z i := +begin + ext ⟨c, ⟨⟩⟩ ⟨a⟩, + simp only [set.mem_preimage, set.mem_singleton_iff] at j_property, + simp only [matrix.mul_apply, limits.biproduct.components, + hom_orthogonal.matrix_decomposition_apply, + category.comp_id, category.id_comp, category.assoc, End.mul_def, + eq_to_hom_refl, eq_to_hom_trans_assoc, finset.sum_congr], + conv_lhs { rw [←category.id_comp w, ←biproduct.total], }, + simp only [preadditive.sum_comp, preadditive.comp_sum], + apply finset.sum_congr_set, + { intros, simp, refl, }, + { intros b nm, + simp only [set.mem_preimage, set.mem_singleton_iff] at nm, + simp only [category.assoc], + convert comp_zero, + convert comp_zero, + convert comp_zero, + convert comp_zero, + apply o.eq_zero nm, }, +end + +section +variables {R : Type*} [semiring R] [linear R C] + +/-- `hom_orthogonal.matrix_decomposition` as an `R`-linear equivalence. -/ +@[simps] noncomputable +def matrix_decomposition_linear_equiv +(o : hom_orthogonal s) + {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} : + (⨁ (λ a, s (f a)) ⟶ ⨁ (λ b, s (g b))) ≃ₗ[R] + Π (i : ι), matrix (g ⁻¹' {i}) (f ⁻¹' {i}) (End (s i)) := +{ map_smul' := λ w z, by { ext, dsimp [biproduct.components], simp, }, + ..o.matrix_decomposition_add_equiv, } + +end + +/-! +The hypothesis that `End (s i)` has invariant basis number is automatically satisfied +if `s i` is simple (as then `End (s i)` is a division ring). +-/ +variables [∀ i, invariant_basis_number (End (s i))] + +/-- +Given a hom orthogonal family `s : ι → C` +for which each `End (s i)` is a ring with invariant basis number (e.g. if each `s i` is simple), +if two direct sums over `s` are isomorphic, then they have the same multiplicities. +-/ +lemma equiv_of_iso (o : hom_orthogonal s) + {α β : Type} [fintype α] [fintype β] {f : α → ι} {g : β → ι} + (i : ⨁ (λ a, s (f a)) ≅ ⨁ (λ b, s (g b))) : + ∃ e : α ≃ β, ∀ a, g (e a) = f a := +begin + refine ⟨equiv.of_preimage_equiv _, λ a, equiv.of_preimage_equiv_map _ _⟩, + intro c, + apply nonempty.some, + apply cardinal.eq.1, + simp only [cardinal.mk_fintype, nat.cast_inj], + exact matrix.square_of_invertible + (o.matrix_decomposition i.inv c) (o.matrix_decomposition i.hom c) + (by { rw ←o.matrix_decomposition_comp, simp, }) + (by { rw ←o.matrix_decomposition_comp, simp, }) +end + +end + +end hom_orthogonal + +end category_theory diff --git a/src/category_theory/preadditive/injective.lean b/src/category_theory/preadditive/injective.lean index 702aac98ea31b..bcb4693c4d9d9 100644 --- a/src/category_theory/preadditive/injective.lean +++ b/src/category_theory/preadditive/injective.lean @@ -3,15 +3,14 @@ Copyright (c) 2022 Jujian Zhang. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jujian Zhang, Kevin Buzzard -/ - -import algebra.homology.exact -import category_theory.types import category_theory.preadditive.projective -import category_theory.limits.shapes.biproducts /-! # Injective objects and categories with enough injectives +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An object `J` is injective iff every morphism into `J` can be obtained by extending a monomorphism. -/ @@ -19,11 +18,12 @@ noncomputable theory open category_theory open category_theory.limits +open opposite -universes v u +universes v v₁ v₂ u₁ u₂ namespace category_theory -variables {C : Type u} [category.{v} C] +variables {C : Type u₁} [category.{v₁} C] /-- An object `J` is injective iff every morphism into `J` can be obtained by extending a monomorphism. @@ -36,13 +36,15 @@ section An injective presentation of an object `X` consists of a monomorphism `f : X ⟶ J` to some injective object `J`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure injective_presentation (X : C) := (J : C) (injective : injective J . tactic.apply_instance) (f : X ⟶ J) (mono : mono f . tactic.apply_instance) +attribute [instance] injective_presentation.injective injective_presentation.mono + variables (C) /-- A category "has enough injectives" if every object has an injective presentation, @@ -83,7 +85,7 @@ lemma iso_iff {P Q : C} (i : P ≅ Q) : injective P ↔ injective Q := ⟨of_iso i, of_iso i.symm⟩ /-- The axiom of choice says that every nonempty type is an injective object in `Type`. -/ -instance (X : Type u) [nonempty X] : injective X := +instance (X : Type u₁) [nonempty X] : injective X := { factors := λ Y Z g f mono, ⟨λ z, by classical; exact if h : z ∈ set.range f @@ -97,7 +99,7 @@ instance (X : Type u) [nonempty X] : injective X := { exact false.elim (h ⟨y, rfl⟩) }, end⟩ } -instance Type.enough_injectives : enough_injectives (Type u) := +instance Type.enough_injectives : enough_injectives (Type u₁) := { presentation := λ X, nonempty.intro { J := with_bot X, injective := infer_instance, @@ -120,7 +122,7 @@ instance {β : Type v} (c : β → C) [has_product c] [∀ b, injective (c b)] : { factors := λ X Y g f mono, begin resetI, refine ⟨pi.lift (λ b, factor_thru (g ≫ (pi.π c _)) f), _⟩, - ext, + ext ⟨j⟩, simp only [category.assoc, limit.lift_π, fan.mk_π_app, comp_factor_thru], end } @@ -135,7 +137,7 @@ instance {P Q : C} [has_zero_morphisms C] [has_binary_biproduct P Q] { simp only [category.assoc, biprod.lift_snd, comp_factor_thru] }, end } -instance {β : Type v} [decidable_eq β] (c : β → C) [has_zero_morphisms C] [has_biproduct c] +instance {β : Type v} (c : β → C) [has_zero_morphisms C] [has_biproduct c] [∀ b, injective (c b)] : injective (⨁ c) := { factors := λ X Y g f mono, begin resetI, @@ -144,20 +146,46 @@ instance {β : Type v} [decidable_eq β] (c : β → C) [has_zero_morphisms C] [ simp only [category.assoc, biproduct.lift_π, comp_factor_thru], end } -instance {P : Cᵒᵖ} [projective P] : injective (P.unop) := -{ factors := λ X Y g f mono, begin - resetI, - refine ⟨(@projective.factor_thru Cᵒᵖ _ P (opposite.op X) (opposite.op Y) _ g.op f.op _).unop, _⟩, - convert congr_arg quiver.hom.unop (@projective.factor_thru_comp Cᵒᵖ _ P - (opposite.op X) (opposite.op Y) _ g.op f.op _), -end } +instance {P : Cᵒᵖ} [projective P] : injective (unop P) := +{ factors := λ X Y g f mono, by exactI ⟨(@projective.factor_thru Cᵒᵖ _ P _ _ _ g.op f.op _).unop, + quiver.hom.op_inj (by simp)⟩ } -instance {J : C} [injective J] : projective (opposite.op J) := -{ factors := λ E X f e epi, begin - resetI, - refine ⟨(@factor_thru C _ J _ _ _ f.unop e.unop _).op, _⟩, - convert congr_arg quiver.hom.op (@comp_factor_thru C _ J _ _ _ f.unop e.unop _), -end } +instance {J : Cᵒᵖ} [injective J] : projective (unop J) := +{ factors := λ E X f e he, by exactI ⟨(@factor_thru Cᵒᵖ _ J _ _ _ f.op e.op _).unop, + quiver.hom.op_inj (by simp)⟩ } + +instance {J : C} [injective J] : projective (op J) := +{ factors := λ E X f e epi, by exactI ⟨(@factor_thru C _ J _ _ _ f.unop e.unop _).op, + quiver.hom.unop_inj (by simp)⟩ } + +instance {P : C} [projective P] : injective (op P) := +{ factors := λ X Y g f mono, by exactI ⟨(@projective.factor_thru C _ P _ _ _ g.unop f.unop _).op, + quiver.hom.unop_inj (by simp)⟩ } + +lemma injective_iff_projective_op {J : C} : injective J ↔ projective (op J) := +⟨λ h, by exactI infer_instance, λ h, show injective (unop (op J)), by exactI infer_instance⟩ + +lemma projective_iff_injective_op {P : C} : projective P ↔ injective (op P) := +⟨λ h, by exactI infer_instance, λ h, show projective (unop (op P)), by exactI infer_instance⟩ + +lemma injective_iff_preserves_epimorphisms_yoneda_obj (J : C) : + injective J ↔ (yoneda.obj J).preserves_epimorphisms := +begin + rw [injective_iff_projective_op, projective.projective_iff_preserves_epimorphisms_coyoneda_obj], + exact functor.preserves_epimorphisms.iso_iff (coyoneda.obj_op_op _) +end + +section adjunction +open category_theory.functor + +variables {D : Type u₂} [category.{v₂} D] +variables {L : C ⥤ D} {R : D ⥤ C} [preserves_monomorphisms L] + +lemma injective_of_adjoint (adj : L ⊣ R) (J : D) [injective J] : injective $ R.obj J := +⟨λ A A' g f im, by exactI ⟨adj.hom_equiv _ _ (factor_thru ((adj.hom_equiv A J).symm g) (L.map f)), + (adj.hom_equiv _ _).symm.injective (by simp)⟩⟩ + +end adjunction section enough_injectives variable [enough_injectives C] @@ -206,6 +234,18 @@ end end enough_injectives +instance [enough_injectives C] : enough_projectives Cᵒᵖ := +⟨λ X, ⟨⟨_, infer_instance, (injective.ι (unop X)).op, infer_instance⟩⟩⟩ + +instance [enough_projectives C] : enough_injectives Cᵒᵖ := +⟨λ X, ⟨⟨_, infer_instance, (projective.π (unop X)).op, infer_instance⟩⟩⟩ + +lemma enough_projectives_of_enough_injectives_op [enough_injectives Cᵒᵖ] : enough_projectives C := +⟨λ X, ⟨⟨_, infer_instance, (injective.ι (op X)).unop, infer_instance⟩⟩⟩ + +lemma enough_injectives_of_enough_projectives_op [enough_projectives Cᵒᵖ] : enough_injectives C := +⟨λ X, ⟨⟨_, infer_instance, (projective.π (op X)).unop, infer_instance⟩⟩⟩ + open injective section @@ -235,5 +275,66 @@ by convert congr_arg quiver.hom.unop end end injective +namespace adjunction + +variables {D : Type*} [category D] {F : C ⥤ D} {G : D ⥤ C} + +lemma map_injective (adj : F ⊣ G) [F.preserves_monomorphisms] (I : D) (hI : injective I) : + injective (G.obj I) := +⟨λ X Y f g, begin + introI, + rcases hI.factors (F.map f ≫ adj.counit.app _) (F.map g), + use adj.unit.app Y ≫ G.map w, + rw [←unit_naturality_assoc, ←G.map_comp, h], + simp, +end⟩ + +lemma injective_of_map_injective (adj : F ⊣ G) [full G] [faithful G] (I : D) + (hI : injective (G.obj I)) : injective I := +⟨λ X Y f g, begin + introI, + haveI : preserves_limits_of_size.{0 0} G := adj.right_adjoint_preserves_limits, + rcases hI.factors (G.map f) (G.map g), + use inv (adj.counit.app _) ≫ F.map w ≫ adj.counit.app _, + refine faithful.map_injective G _, + simpa +end⟩ + +/-- Given an adjunction `F ⊣ G` such that `F` preserves monos, `G` maps an injective presentation +of `X` to an injective presentation of `G(X)`. -/ +def map_injective_presentation (adj : F ⊣ G) [F.preserves_monomorphisms] (X : D) + (I : injective_presentation X) : injective_presentation (G.obj X) := +{ J := G.obj I.J, + injective := adj.map_injective _ I.injective, + f := G.map I.f, + mono := by + haveI : preserves_limits_of_size.{0 0} G := adj.right_adjoint_preserves_limits; + apply_instance } + +end adjunction +namespace equivalence + +variables {D : Type*} [category D] (F : C ≌ D) + +/-- Given an equivalence of categories `F`, an injective presentation of `F(X)` induces an +injective presentation of `X.` -/ +def injective_presentation_of_map_injective_presentation + (X : C) (I : injective_presentation (F.functor.obj X)) : injective_presentation X := +{ J := F.inverse.obj I.J, + injective := adjunction.map_injective F.to_adjunction I.J I.injective, + f := F.unit.app _ ≫ F.inverse.map I.f, + mono := mono_comp _ _ } + +lemma enough_injectives_iff (F : C ≌ D) : + enough_injectives C ↔ enough_injectives D := +begin + split, + all_goals { intro H, constructor, intro X, constructor }, + { exact F.symm.injective_presentation_of_map_injective_presentation _ + (nonempty.some (H.presentation (F.inverse.obj X))) }, + { exact F.injective_presentation_of_map_injective_presentation X + (nonempty.some (H.presentation (F.functor.obj X))) }, +end +end equivalence end category_theory diff --git a/src/category_theory/preadditive/injective_resolution.lean b/src/category_theory/preadditive/injective_resolution.lean index 1ef24b230c5a9..e6e74beb9162a 100644 --- a/src/category_theory/preadditive/injective_resolution.lean +++ b/src/category_theory/preadditive/injective_resolution.lean @@ -9,6 +9,9 @@ import algebra.homology.single /-! # Injective resolutions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A injective resolution `I : InjectiveResolution Z` of an object `Z : C` consists of a `ℕ`-indexed cochain complex `I.cocomplex` of injective objects, along with a cochain map `I.ι` from cochain complex consisting just of `Z` in degree zero to `C`, @@ -49,7 +52,7 @@ you will not typically need to use this bundled object, and will instead use `injective_resolution Z` (all the components are equipped with `mono` instances, and when the category is `abelian` we will show `ι` is a quasi-iso). -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure InjectiveResolution (Z : C) := (cocomplex : cochain_complex C ℕ) (ι: ((cochain_complex.single₀ C).obj Z) ⟶ cocomplex) diff --git a/src/category_theory/preadditive/left_exact.lean b/src/category_theory/preadditive/left_exact.lean new file mode 100644 index 0000000000000..a2c9a6111c2ca --- /dev/null +++ b/src/category_theory/preadditive/left_exact.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2022 Jakob von Raumer. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel, Jakob von Raumer +-/ +import category_theory.limits.constructions.finite_products_of_binary_products +import category_theory.limits.preserves.shapes.kernels +import category_theory.limits.constructions.limits_of_products_and_equalizers +import category_theory.preadditive.additive_functor + +/-! +# Left exactness of functors between preadditive categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that a functor is left exact in the sense that it preserves finite limits, if it +preserves kernels. The dual result holds for right exact functors and cokernels. +## Main results +* We first derive preservation of binary product in the lemma + `preserves_binary_products_of_preserves_kernels`, +* then show the preservation of equalizers in `preserves_equalizer_of_preserves_kernels`, +* and then derive the preservation of all finite limits with the usual construction. + +-/ + +universes v₁ v₂ u₁ u₂ + +noncomputable theory + +open category_theory +open category_theory.limits +open category_theory.preadditive + +namespace category_theory + +namespace functor + +variables {C : Type u₁} [category.{v₁} C] [preadditive C] + {D : Type u₂} [category.{v₂} D] [preadditive D] + (F : C ⥤ D) [preserves_zero_morphisms F] + +section finite_limits + +/-- +A functor between preadditive categories which preserves kernels preserves that an +arbitrary binary fan is a limit. +-/ +def is_limit_map_cone_binary_fan_of_preserves_kernels {X Y Z : C} (π₁ : Z ⟶ X) (π₂ : Z ⟶ Y) + [preserves_limit (parallel_pair π₂ 0) F] (i : is_limit (binary_fan.mk π₁ π₂)) : + is_limit (F.map_cone (binary_fan.mk π₁ π₂)) := +begin + let bc := binary_bicone.of_limit_cone i, + letI presf : preserves_limit (parallel_pair bc.snd 0) F, { simpa }, + let hf : is_limit bc.snd_kernel_fork := binary_bicone.is_limit_snd_kernel_fork i, + exact (is_limit_map_cone_binary_fan_equiv F π₁ π₂).inv_fun + (binary_bicone.is_bilimit_of_kernel_inl (F.map_binary_bicone bc) + (is_limit_map_cone_fork_equiv' F _ (is_limit_of_preserves F hf))).is_limit +end + +/-- A kernel preserving functor between preadditive categories preserves any pair being a limit. -/ +def preserves_binary_product_of_preserves_kernels + [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] {X Y : C} : + preserves_limit (pair X Y) F := +{ preserves := λ c hc, is_limit.of_iso_limit + (is_limit_map_cone_binary_fan_of_preserves_kernels F _ _ + (is_limit.of_iso_limit hc (iso_binary_fan_mk c))) + ((cones.functoriality _ F).map_iso (iso_binary_fan_mk c).symm) } + +local attribute [instance] preserves_binary_product_of_preserves_kernels + +/-- A kernel preserving functor between preadditive categories preserves binary products. -/ +def preserves_binary_products_of_preserves_kernels + [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] : + preserves_limits_of_shape (discrete walking_pair) F := +{ preserves_limit := λ p, preserves_limit_of_iso_diagram F (diagram_iso_pair p).symm } + +local attribute [instance] preserves_binary_products_of_preserves_kernels + +variables [has_binary_biproducts C] + +/-- +A functor between preadditive categories preserves the equalizer of two +morphisms if it preserves all kernels. -/ +def preserves_equalizer_of_preserves_kernels + [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] {X Y : C} + (f g : X ⟶ Y) : preserves_limit (parallel_pair f g) F := +begin + letI := preserves_binary_biproducts_of_preserves_binary_products F, + haveI := additive_of_preserves_binary_biproducts F, + constructor, intros c i, + let c' := is_limit_kernel_fork_of_fork (i.of_iso_limit (fork.iso_fork_of_ι c)), + dsimp only [kernel_fork_of_fork_of_ι] at c', + let iFc := is_limit_fork_map_of_is_limit' F _ c', + apply is_limit.of_iso_limit _ ((cones.functoriality _ F).map_iso (fork.iso_fork_of_ι c).symm), + apply (is_limit_map_cone_fork_equiv F (fork.condition c)).inv_fun, + let p : parallel_pair (F.map (f - g)) 0 ≅ parallel_pair (F.map f - F.map g) 0 := + parallel_pair.eq_of_hom_eq F.map_sub rfl, + refine is_limit.of_iso_limit (is_limit_fork_of_kernel_fork + ((is_limit.postcompose_hom_equiv p _).symm iFc)) _, + convert fork.iso_fork_of_ι _, + rw [fork_of_kernel_fork_ι, fork.ι_postcompose, kernel_fork.ι_of_ι, + parallel_pair.eq_of_hom_eq_hom_app], + erw category.comp_id +end + +/-- +A functor between preadditive categories preserves all equalizers if it preserves all kernels. +-/ +def preserves_equalizers_of_preserves_kernels + [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] : + preserves_limits_of_shape walking_parallel_pair F := +{ preserves_limit := λ K, + begin + letI := preserves_equalizer_of_preserves_kernels F + (K.map walking_parallel_pair_hom.left) (K.map walking_parallel_pair_hom.right), + apply preserves_limit_of_iso_diagram F (diagram_iso_parallel_pair K).symm, + end } + +/-- +A functor between preadditive categories which preserves kernels preserves all finite limits. +-/ +def preserves_finite_limits_of_preserves_kernels + [has_finite_products C] [has_equalizers C] [has_zero_object C] [has_zero_object D] + [∀ {X Y} (f : X ⟶ Y), preserves_limit (parallel_pair f 0) F] : preserves_finite_limits F := +begin + letI := preserves_equalizers_of_preserves_kernels F, + letI := preserves_terminal_object_of_preserves_zero_morphisms F, + letI := preserves_limits_of_shape_pempty_of_preserves_terminal F, + letI p_prod := preserves_finite_products_of_preserves_binary_and_terminal F, + apply @preserves_finite_limits_of_preserves_equalizers_and_finite_products _ _ + _ _ _ _ _ _ @p_prod, +end + +end finite_limits + +section finite_colimits + +/-- +A functor between preadditive categories which preserves cokernels preserves finite coproducts. +-/ +def is_colimit_map_cocone_binary_cofan_of_preserves_cokernels {X Y Z : C} (ι₁ : X ⟶ Z) (ι₂ : Y ⟶ Z) + [preserves_colimit (parallel_pair ι₂ 0) F] (i : is_colimit (binary_cofan.mk ι₁ ι₂)) : + is_colimit (F.map_cocone (binary_cofan.mk ι₁ ι₂)) := +begin + let bc := binary_bicone.of_colimit_cocone i, + letI presf : preserves_colimit (parallel_pair bc.inr 0) F, { simpa }, + let hf : is_colimit bc.inr_cokernel_cofork := binary_bicone.is_colimit_inr_cokernel_cofork i, + exact (is_colimit_map_cocone_binary_cofan_equiv F ι₁ ι₂).inv_fun + (binary_bicone.is_bilimit_of_cokernel_fst (F.map_binary_bicone bc) + (is_colimit_map_cocone_cofork_equiv' F _ (is_colimit_of_preserves F hf))).is_colimit +end + +/-- A cokernel preserving functor between preadditive categories preserves any pair being +a colimit. -/ +def preserves_coproduct_of_preserves_cokernels + [∀ {X Y} (f : X ⟶ Y), preserves_colimit (parallel_pair f 0) F] {X Y : C} : + preserves_colimit (pair X Y) F := +{ preserves := λ c hc, is_colimit.of_iso_colimit + (is_colimit_map_cocone_binary_cofan_of_preserves_cokernels F _ _ + (is_colimit.of_iso_colimit hc (iso_binary_cofan_mk c))) + ((cocones.functoriality _ F).map_iso (iso_binary_cofan_mk c).symm) } + +local attribute [instance] preserves_coproduct_of_preserves_cokernels + +/-- A cokernel preserving functor between preadditive categories preserves binary coproducts. -/ +def preserves_binary_coproducts_of_preserves_cokernels + [∀ {X Y} (f : X ⟶ Y), preserves_colimit (parallel_pair f 0) F] : + preserves_colimits_of_shape (discrete walking_pair) F := +{ preserves_colimit := λ p, preserves_colimit_of_iso_diagram F (diagram_iso_pair p).symm } + +local attribute [instance] preserves_binary_coproducts_of_preserves_cokernels + +variables [has_binary_biproducts C] + +/-- +A functor between preadditive categoris preserves the coequalizer of two +morphisms if it preserves all cokernels. -/ +def preserves_coequalizer_of_preserves_cokernels + [∀ {X Y} (f : X ⟶ Y), preserves_colimit (parallel_pair f 0) F] {X Y : C} + (f g : X ⟶ Y) : preserves_colimit (parallel_pair f g) F := +begin + letI := preserves_binary_biproducts_of_preserves_binary_coproducts F, + haveI := additive_of_preserves_binary_biproducts F, + constructor, intros c i, + let c' := is_colimit_cokernel_cofork_of_cofork (i.of_iso_colimit (cofork.iso_cofork_of_π c)), + dsimp only [cokernel_cofork_of_cofork_of_π] at c', + let iFc := is_colimit_cofork_map_of_is_colimit' F _ c', + apply is_colimit.of_iso_colimit _ + ((cocones.functoriality _ F).map_iso (cofork.iso_cofork_of_π c).symm), + apply (is_colimit_map_cocone_cofork_equiv F (cofork.condition c)).inv_fun, + let p : parallel_pair (F.map (f - g)) 0 ≅ parallel_pair (F.map f - F.map g) 0, + { exact parallel_pair.ext (iso.refl _) (iso.refl _) (by simp) (by simp) }, + refine is_colimit.of_iso_colimit (is_colimit_cofork_of_cokernel_cofork + ((is_colimit.precompose_hom_equiv p.symm _).symm iFc)) _, + convert cofork.iso_cofork_of_π _, + rw [cofork_of_cokernel_cofork_π, cofork.π_precompose, cokernel_cofork.π_of_π, + iso.symm_hom, parallel_pair.ext_inv_app, iso.refl_inv], + erw category.id_comp +end + +/-- +A functor between preadditive categories preserves all coequalizers if it preserves all kernels. +-/ +def preserves_coequalizers_of_preserves_cokernels + [∀ {X Y} (f : X ⟶ Y), preserves_colimit (parallel_pair f 0) F] : + preserves_colimits_of_shape walking_parallel_pair F := +{ preserves_colimit := λ K, + begin + letI := preserves_coequalizer_of_preserves_cokernels F + (K.map limits.walking_parallel_pair_hom.left) + (K.map limits.walking_parallel_pair_hom.right), + apply preserves_colimit_of_iso_diagram F (diagram_iso_parallel_pair K).symm, + end } + +/-- +A functor between preadditive categories which preserves kernels preserves all finite limits. +-/ +def preserves_finite_colimits_of_preserves_cokernels + [has_finite_coproducts C] [has_coequalizers C] [has_zero_object C] [has_zero_object D] + [∀ {X Y} (f : X ⟶ Y), preserves_colimit (parallel_pair f 0) F] : preserves_finite_colimits F := +begin + letI := preserves_coequalizers_of_preserves_cokernels F, + letI := preserves_initial_object_of_preserves_zero_morphisms F, + letI := preserves_colimits_of_shape_pempty_of_preserves_initial F, + letI p_prod := preserves_finite_coproducts_of_preserves_binary_and_initial F, + apply @preserves_finite_colimits_of_preserves_coequalizers_and_finite_coproducts C _ + _ _ _ _ _ _ @p_prod, +end + +end finite_colimits + +end functor + +end category_theory diff --git a/src/category_theory/preadditive/of_biproducts.lean b/src/category_theory/preadditive/of_biproducts.lean new file mode 100644 index 0000000000000..6deac1483f48f --- /dev/null +++ b/src/category_theory/preadditive/of_biproducts.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.limits.shapes.biproducts +import group_theory.eckmann_hilton + +/-! +# Constructing a semiadditive structure from binary biproducts + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that any category with zero morphisms and binary biproducts is enriched over the category +of commutative monoids. + +-/ + +noncomputable theory + +universes v u + +open category_theory +open category_theory.limits + +namespace category_theory.semiadditive_of_binary_biproducts +variables {C : Type u} [category.{v} C] [has_zero_morphisms C] [has_binary_biproducts C] + +section +variables (X Y : C) + +/-- `f +ₗ g` is the composite `X ⟶ Y ⊞ Y ⟶ Y`, where the first map is `(f, g)` and the second map + is `(𝟙 𝟙)`. -/ +@[simp] def left_add (f g : X ⟶ Y) : X ⟶ Y := +biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y) + +/-- `f +ᵣ g` is the composite `X ⟶ X ⊞ X ⟶ Y`, where the first map is `(𝟙, 𝟙)` and the second map + is `(f g)`. -/ +@[simp] def right_add (f g : X ⟶ Y) : X ⟶ Y := +biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g + +local infixr ` +ₗ `:65 := left_add X Y +local infixr ` +ᵣ `:65 := right_add X Y + +lemma is_unital_left_add : eckmann_hilton.is_unital (+ₗ) 0 := +⟨⟨λ f, by simp [show biprod.lift (0 : X ⟶ Y) f = f ≫ biprod.inr, by ext; simp]⟩, + ⟨λ f, by simp [show biprod.lift f (0 : X ⟶ Y) = f ≫ biprod.inl, by ext; simp]⟩⟩ + +lemma is_unital_right_add : eckmann_hilton.is_unital (+ᵣ) 0 := +⟨⟨λ f, by simp [show biprod.desc (0 : X ⟶ Y) f = biprod.snd ≫ f, by ext; simp]⟩, + ⟨λ f, by simp [show biprod.desc f (0 : X ⟶ Y) = biprod.fst ≫ f, by ext; simp]⟩⟩ + +lemma distrib (f g h k : X ⟶ Y) : (f +ᵣ g) +ₗ (h +ᵣ k) = (f +ₗ h) +ᵣ (g +ₗ k) := +begin + let diag : X ⊞ X ⟶ Y ⊞ Y := biprod.lift (biprod.desc f g) (biprod.desc h k), + have hd₁ : biprod.inl ≫ diag = biprod.lift f h := by { ext; simp }, + have hd₂ : biprod.inr ≫ diag = biprod.lift g k := by { ext; simp }, + have h₁ : biprod.lift (f +ᵣ g) (h +ᵣ k) = biprod.lift (𝟙 X) (𝟙 X) ≫ diag := by { ext; simp }, + have h₂ : diag ≫ biprod.desc (𝟙 Y) (𝟙 Y) = biprod.desc (f +ₗ h) (g +ₗ k), + { ext; simp [reassoc_of hd₁, reassoc_of hd₂] }, + rw [left_add, h₁, category.assoc, h₂, right_add] +end + +/-- In a category with binary biproducts, the morphisms form a commutative monoid. -/ +def add_comm_monoid_hom_of_has_binary_biproducts : add_comm_monoid (X ⟶ Y) := +{ add := (+ᵣ), + add_assoc := (eckmann_hilton.mul_assoc (is_unital_left_add X Y) + (is_unital_right_add X Y) (distrib X Y)).assoc, + zero := 0, + zero_add := (is_unital_right_add X Y).left_id, + add_zero := (is_unital_right_add X Y).right_id, + add_comm := (eckmann_hilton.mul_comm (is_unital_left_add X Y) + (is_unital_right_add X Y) (distrib X Y)).comm } + +end + +section +variables {X Y Z : C} + +local attribute [instance] add_comm_monoid_hom_of_has_binary_biproducts + +lemma add_eq_right_addition (f g : X ⟶ Y) : f + g = biprod.lift (𝟙 X) (𝟙 X) ≫ biprod.desc f g := +rfl + +lemma add_eq_left_addition (f g : X ⟶ Y) : f + g = biprod.lift f g ≫ biprod.desc (𝟙 Y) (𝟙 Y) := +congr_fun₂ + (eckmann_hilton.mul (is_unital_left_add X Y) (is_unital_right_add X Y) (distrib X Y)).symm f g + +lemma add_comp (f g : X ⟶ Y) (h : Y ⟶ Z) : (f + g) ≫ h = f ≫ h + g ≫ h := +by { simp only [add_eq_right_addition, category.assoc], congr, ext; simp } + +lemma comp_add (f : X ⟶ Y) (g h : Y ⟶ Z) : f ≫ (g + h) = f ≫ g + f ≫ h := +by { simp only [add_eq_left_addition, ← category.assoc], congr, ext; simp } + +end + +end category_theory.semiadditive_of_binary_biproducts diff --git a/src/category_theory/preadditive/opposite.lean b/src/category_theory/preadditive/opposite.lean index f492483e15cab..f846ccb1ba59d 100644 --- a/src/category_theory/preadditive/opposite.lean +++ b/src/category_theory/preadditive/opposite.lean @@ -1,15 +1,17 @@ /- Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Adam Topaz +Authors: Scott Morrison, Adam Topaz, Johan Commelin, Joël Riou -/ -import category_theory.preadditive import category_theory.preadditive.additive_functor import logic.equiv.transfer_instance /-! # If `C` is preadditive, `Cᵒᵖ` has a natural preadditive structure. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + -/ open opposite @@ -33,10 +35,32 @@ instance module_End_left {X : Cᵒᵖ} {Y : C} : module (End X) (unop X ⟶ Y) : @[simp] lemma unop_zero (X Y : Cᵒᵖ) : (0 : X ⟶ Y).unop = 0 := rfl @[simp] lemma unop_add {X Y : Cᵒᵖ} (f g : X ⟶ Y) : (f + g).unop = f.unop + g.unop := rfl +@[simp] lemma unop_zsmul {X Y : Cᵒᵖ} (k : ℤ) (f : X ⟶ Y) : (k • f).unop = k • f.unop := rfl +@[simp] lemma unop_neg {X Y : Cᵒᵖ}(f : X ⟶ Y) : (-f).unop = -(f.unop) := rfl @[simp] lemma op_zero (X Y : C) : (0 : X ⟶ Y).op = 0 := rfl @[simp] lemma op_add {X Y : C} (f g : X ⟶ Y) : (f + g).op = f.op + g.op := rfl +@[simp] lemma op_zsmul {X Y : C} (k : ℤ) (f : X ⟶ Y) : (k • f).op = k • f.op := rfl +@[simp] lemma op_neg {X Y : C}(f : X ⟶ Y) : (-f).op = -(f.op) := rfl + +variable {C} + +/-- `unop` induces morphisms of monoids on hom groups of a preadditive category -/ +@[simps] def unop_hom (X Y : Cᵒᵖ) : (X ⟶ Y) →+ (opposite.unop Y ⟶ opposite.unop X) := +add_monoid_hom.mk' (λ f, f.unop) $ λ f g, unop_add _ f g + +@[simp] lemma unop_sum (X Y : Cᵒᵖ) {ι : Type*} (s : finset ι) (f : ι → (X ⟶ Y)) : + (s.sum f).unop = s.sum (λ i, (f i).unop) := +(unop_hom X Y).map_sum _ _ + +/-- `op` induces morphisms of monoids on hom groups of a preadditive category -/ +@[simps] def op_hom (X Y : C) : (X ⟶ Y) →+ (opposite.op Y ⟶ opposite.op X) := +add_monoid_hom.mk' (λ f, f.op) $ λ f g, op_add _ f g + +@[simp] lemma op_sum (X Y : C) {ι : Type*} (s : finset ι) (f : ι → (X ⟶ Y)) : + (s.sum f).op = s.sum (λ i, (f i).op) := +(op_hom X Y).map_sum _ _ -variables {C} {D : Type*} [category D] [preadditive D] +variables {D : Type*} [category D] [preadditive D] instance functor.op_additive (F : C ⥤ D) [F.additive] : F.op.additive := {} diff --git a/src/category_theory/preadditive/projective.lean b/src/category_theory/preadditive/projective.lean index ff2a5cbe534a8..9c6098ab570f8 100644 --- a/src/category_theory/preadditive/projective.lean +++ b/src/category_theory/preadditive/projective.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel, Scott Morrison -/ import algebra.homology.exact -import category_theory.types import category_theory.limits.shapes.biproducts +import category_theory.adjunction.limits +import category_theory.limits.preserves.finite /-! # Projective objects and categories with enough projectives +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An object `P` is called projective if every morphism out of `P` factors through every epimorphism. A category `C` has enough projectives if every object admits an epimorphism from some @@ -26,6 +30,7 @@ noncomputable theory open category_theory open category_theory.limits +open opposite universes v u @@ -44,13 +49,15 @@ section A projective presentation of an object `X` consists of an epimorphism `f : P ⟶ X` from some projective object `P`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure projective_presentation (X : C) := (P : C) (projective : projective P . tactic.apply_instance) (f : P ⟶ X) (epi : epi f . tactic.apply_instance) +attribute [instance] projective_presentation.projective projective_presentation.epi + variables (C) /-- A category "has enough projectives" if for every object `X` there is a projective object `P` and @@ -105,22 +112,34 @@ instance {P Q : C} [has_binary_coproduct P Q] [projective P] [projective Q] : { factors := λ E X' f e epi, by exactI ⟨coprod.desc (factor_thru (coprod.inl ≫ f) e) (factor_thru (coprod.inr ≫ f) e), by tidy⟩, } +section +local attribute [tidy] tactic.discrete_cases + instance {β : Type v} (g : β → C) [has_coproduct g] [∀ b, projective (g b)] : projective (∐ g) := { factors := λ E X' f e epi, by exactI ⟨sigma.desc (λ b, factor_thru (sigma.ι g b ≫ f) e), by tidy⟩, } +end + instance {P Q : C} [has_zero_morphisms C] [has_binary_biproduct P Q] [projective P] [projective Q] : projective (P ⊞ Q) := { factors := λ E X' f e epi, by exactI ⟨biprod.desc (factor_thru (biprod.inl ≫ f) e) (factor_thru (biprod.inr ≫ f) e), by tidy⟩, } -instance {β : Type v} [decidable_eq β] (g : β → C) [has_zero_morphisms C] [has_biproduct g] +instance {β : Type v} (g : β → C) [has_zero_morphisms C] [has_biproduct g] [∀ b, projective (g b)] : projective (⨁ g) := { factors := λ E X' f e epi, by exactI ⟨biproduct.desc (λ b, factor_thru (biproduct.ι g b ≫ f) e), by tidy⟩, } +lemma projective_iff_preserves_epimorphisms_coyoneda_obj (P : C) : + projective P ↔ (coyoneda.obj (op P)).preserves_epimorphisms := +⟨λ hP, ⟨λ X Y f hf, (epi_iff_surjective _).2 $ λ g, have projective (unop (op P)), from hP, + by exactI ⟨factor_thru g f, factor_thru_comp _ _⟩⟩, + λ h, ⟨λ E X f e he, by exactI (epi_iff_surjective _).1 + (infer_instance : epi ((coyoneda.obj (op P)).map e)) f⟩⟩ + section enough_projectives variables [enough_projectives C] @@ -169,9 +188,69 @@ end end enough_projectives end projective +namespace adjunction + +variables {D : Type*} [category D] {F : C ⥤ D} {G : D ⥤ C} + +lemma map_projective (adj : F ⊣ G) [G.preserves_epimorphisms] (P : C) (hP : projective P) : + projective (F.obj P) := +⟨λ X Y f g, begin + introI, + rcases hP.factors (adj.unit.app P ≫ G.map f) (G.map g), + use F.map w ≫ adj.counit.app X, + rw [category.assoc, ←adjunction.counit_naturality, ←category.assoc, ←F.map_comp, h], + simp, +end⟩ + +lemma projective_of_map_projective (adj : F ⊣ G) [full F] [faithful F] (P : C) + (hP : projective (F.obj P)) : projective P := +⟨λ X Y f g, begin + introI, + haveI : preserves_colimits_of_size.{0 0} F := adj.left_adjoint_preserves_colimits, + rcases @hP.1 (F.map f) (F.map g), + use adj.unit.app _ ≫ G.map w ≫ (inv $ adj.unit.app _), + refine faithful.map_injective F _, + simpa +end⟩ + +/-- Given an adjunction `F ⊣ G` such that `G` preserves epis, `F` maps a projective presentation of +`X` to a projective presentation of `F(X)`. -/ +def map_projective_presentation (adj : F ⊣ G) [G.preserves_epimorphisms] (X : C) + (Y : projective_presentation X) : projective_presentation (F.obj X) := +{ P := F.obj Y.P, + projective := adj.map_projective _ Y.projective, + f := F.map Y.f, + epi := by + haveI : preserves_colimits_of_size.{0 0} F := adj.left_adjoint_preserves_colimits; + apply_instance } + +end adjunction +namespace equivalence + +variables {D : Type*} [category D] (F : C ≌ D) + +/-- Given an equivalence of categories `F`, a projective presentation of `F(X)` induces a +projective presentation of `X.` -/ +def projective_presentation_of_map_projective_presentation + (X : C) (Y : projective_presentation (F.functor.obj X)) : projective_presentation X := +{ P := F.inverse.obj Y.P, + projective := adjunction.map_projective F.symm.to_adjunction Y.P Y.projective, + f := F.inverse.map Y.f ≫ F.unit_inv.app _, + epi := epi_comp _ _ } + +lemma enough_projectives_iff (F : C ≌ D) : + enough_projectives C ↔ enough_projectives D := +begin + split, + all_goals { intro H, constructor, intro X, constructor }, + { exact F.symm.projective_presentation_of_map_projective_presentation _ + (nonempty.some (H.presentation (F.inverse.obj X))) }, + { exact F.projective_presentation_of_map_projective_presentation X + (nonempty.some (H.presentation (F.functor.obj X))) }, +end +end equivalence open projective - section variables [has_zero_morphisms C] [has_equalizers C] [has_images C] diff --git a/src/category_theory/preadditive/projective_resolution.lean b/src/category_theory/preadditive/projective_resolution.lean index c61f01a3c8343..16f66b844bf9e 100644 --- a/src/category_theory/preadditive/projective_resolution.lean +++ b/src/category_theory/preadditive/projective_resolution.lean @@ -10,6 +10,9 @@ import algebra.homology.homotopy_category /-! # Projective resolutions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A projective resolution `P : ProjectiveResolution Z` of an object `Z : C` consists of a `ℕ`-indexed chain complex `P.complex` of projective objects, along with a chain map `P.π` from `C` to the chain complex consisting just of `Z` in degree zero, @@ -66,7 +69,7 @@ you will not typically need to use this bundled object, and will instead use `(single C _ 0).obj Z` (all the components are equipped with `epi` instances, and when the category is `abelian` we will show `π` is a quasi-iso). -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure ProjectiveResolution (Z : C) := (complex : chain_complex C ℕ) (π : homological_complex.hom complex ((chain_complex.single₀ C).obj Z)) @@ -172,11 +175,7 @@ chain_complex.mk_hom _ _ (lift_f_zero f _ _) (lift_f_one f _ _) (lift_f_one_zero lemma lift_commutes {Y Z : C} (f : Y ⟶ Z) (P : ProjectiveResolution Y) (Q : ProjectiveResolution Z) : lift f P Q ≫ Q.π = P.π ≫ (chain_complex.single₀ C).map f := -begin - ext n, - rcases n with (_|_|n); - { dsimp [lift, lift_f_zero, lift_f_one], simp, } -end +by { ext, dsimp [lift, lift_f_zero], apply factor_thru_comp, } -- Now that we've checked this property of the lift, -- we can seal away the actual definition. diff --git a/src/category_theory/preadditive/schur.lean b/src/category_theory/preadditive/schur.lean index e37533d9f1990..4e46403e03014 100644 --- a/src/category_theory/preadditive/schur.lean +++ b/src/category_theory/preadditive/schur.lean @@ -5,12 +5,15 @@ Authors: Markus Himmel, Scott Morrison -/ import algebra.group.ext import category_theory.simple -import category_theory.linear +import category_theory.linear.basic import category_theory.endomorphism -import algebra.algebra.spectrum +import field_theory.is_alg_closed.spectrum /-! # Schur's lemma + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. We first prove the part of Schur's Lemma that holds in any preadditive category with kernels, that any nonzero morphism between simple objects is an isomorphism. @@ -123,8 +126,7 @@ lemma finrank_endomorphism_eq_one finrank 𝕜 (X ⟶ X) = 1 := begin have id_nonzero := (is_iso_iff_nonzero (𝟙 X)).mp (by apply_instance), - apply finrank_eq_one (𝟙 X), - { exact id_nonzero, }, + refine finrank_eq_one (𝟙 X) id_nonzero _, { intro f, haveI : nontrivial (End X) := nontrivial_of_ne _ _ id_nonzero, obtain ⟨c, nu⟩ := @spectrum.nonempty_of_is_alg_closed_of_finite_dimensional 𝕜 (End X) _ _ _ _ _ @@ -180,11 +182,11 @@ lemma finrank_hom_simple_simple_le_one begin cases subsingleton_or_nontrivial (X ⟶ Y) with h, { resetI, - convert zero_le_one, - exact finrank_zero_of_subsingleton, }, + rw finrank_zero_of_subsingleton, + exact zero_le_one }, { obtain ⟨f, nz⟩ := (nontrivial_iff_exists_ne 0).mp h, haveI fi := (is_iso_iff_nonzero f).mpr nz, - apply finrank_le_one f, + refine finrank_le_one f _, intro g, obtain ⟨c, w⟩ := endomorphism_simple_eq_smul_id 𝕜 (g ≫ inv f), exact ⟨c, by simpa using w =≫ f⟩, }, @@ -219,4 +221,15 @@ begin { exact false.elim (h h'), }, end +open_locale classical + +lemma finrank_hom_simple_simple + (X Y : C) [∀ X Y : C, finite_dimensional 𝕜 (X ⟶ Y)] [simple X] [simple Y] : + finrank 𝕜 (X ⟶ Y) = if nonempty (X ≅ Y) then 1 else 0 := +begin + split_ifs, + exact (finrank_hom_simple_simple_eq_one_iff 𝕜 X Y).2 h, + exact (finrank_hom_simple_simple_eq_zero_iff 𝕜 X Y).2 (not_nonempty_iff.mp h), +end + end category_theory diff --git a/src/category_theory/preadditive/single_obj.lean b/src/category_theory/preadditive/single_obj.lean index 17cf6cf1c2897..f92d716ddd20a 100644 --- a/src/category_theory/preadditive/single_obj.lean +++ b/src/category_theory/preadditive/single_obj.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import category_theory.preadditive.default +import category_theory.preadditive.basic import category_theory.single_obj /-! # `single_obj α` is preadditive when `α` is a ring. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + -/ namespace category_theory diff --git a/src/category_theory/preadditive/yoneda.lean b/src/category_theory/preadditive/yoneda.lean deleted file mode 100644 index ee5bcc9ac3c17..0000000000000 --- a/src/category_theory/preadditive/yoneda.lean +++ /dev/null @@ -1,132 +0,0 @@ -/- -Copyright (c) 2022 Markus Himmel. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Markus Himmel --/ -import category_theory.preadditive.opposite -import algebra.category.Module.basic -import algebra.category.Group.preadditive - -/-! -# The Yoneda embedding for preadditive categories - -The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an -object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module -structure. - -We also show that this presheaf is additive and that it is compatible with the normal Yoneda -embedding in the expected way and deduce that the preadditive Yoneda embedding is fully faithful. - -## TODO -* The Yoneda embedding is additive itself - --/ - -universes v u - -open category_theory.preadditive opposite - -namespace category_theory - -variables {C : Type u} [category.{v} C] [preadditive C] - -/-- -The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an -object `X` to the `End Y`-module of morphisms `X ⟶ Y`. --/ -@[simps] -def preadditive_yoneda_obj (Y : C) : Cᵒᵖ ⥤ Module.{v} (End Y) := -{ obj := λ X, Module.of _ (X.unop ⟶ Y), - map := λ X X' f, - { to_fun := λ g, f.unop ≫ g, - map_add' := λ g g', comp_add _ _ _ _ _ _, - map_smul' := λ r g, eq.symm $ category.assoc _ _ _ } } - -/-- -The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an -object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module -structure, see `preadditive_yoneda_obj`. --/ -@[simps] -def preadditive_yoneda : C ⥤ (Cᵒᵖ ⥤ AddCommGroup.{v}) := -{ obj := λ Y, preadditive_yoneda_obj Y ⋙ forget₂ _ _, - map := λ Y Y' f, - { app := λ X, - { to_fun := λ g, g ≫ f, - map_zero' := limits.zero_comp, - map_add' := λ g g', add_comp _ _ _ _ _ _ }, - naturality' := λ X X' g, AddCommGroup.ext _ _ _ _ $ λ x, category.assoc _ _ _ }, - map_id' := λ X, by { ext, simp }, - map_comp' := λ X Y Z f g, by { ext, simp } } - -/-- -The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an -object `Y` to the `End X`-module of morphisms `X ⟶ Y`. --/ -@[simps] -def preadditive_coyoneda_obj (X : Cᵒᵖ) : C ⥤ Module.{v} (End X) := -{ obj := λ Y, Module.of _ (unop X ⟶ Y), - map := λ Y Y' f, - { to_fun := λ g, g ≫ f, - map_add' := λ g g', add_comp _ _ _ _ _ _, - map_smul' := λ r g, category.assoc _ _ _ } } - -/-- -The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an -object `Y` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End X`-module -structure, see `preadditive_coyoneda_obj`. --/ -@[simps] -def preadditive_coyoneda : Cᵒᵖ ⥤ (C ⥤ AddCommGroup.{v}) := -{ obj := λ X, preadditive_coyoneda_obj X ⋙ forget₂ _ _, - map := λ X X' f, - { app := λ Y, - { to_fun := λ g, f.unop ≫ g, - map_zero' := limits.comp_zero, - map_add' := λ g g', comp_add _ _ _ _ _ _ }, - naturality' := λ Y Y' g, AddCommGroup.ext _ _ _ _ $ λ x, eq.symm $ category.assoc _ _ _ }, - map_id' := λ X, by { ext, simp }, - map_comp' := λ X Y Z f g, by { ext, simp } } - -instance additive_yoneda_obj (X : C) : functor.additive (preadditive_yoneda_obj X) := {} -instance additive_yoneda_obj' (X : C) : functor.additive (preadditive_yoneda.obj X) := {} -instance additive_coyoneda_obj (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda_obj X) := {} -instance additive_coyoneda_obj' (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda.obj X) := {} - -/-- -Composing the preadditive yoneda embedding with the forgetful functor yields the regular -Yoneda embedding. --/ -@[simp] lemma whiskering_preadditive_yoneda : preadditive_yoneda ⋙ - (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup) = yoneda := -rfl - -/-- -Composing the preadditive yoneda embedding with the forgetful functor yields the regular -Yoneda embedding. --/ -@[simp] lemma whiskering_preadditive_coyoneda : preadditive_coyoneda ⋙ - (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup) = coyoneda := -rfl - -instance preadditive_yoneda_full : full (preadditive_yoneda : C ⥤ Cᵒᵖ ⥤ AddCommGroup) := -let yoneda_full : full (preadditive_yoneda ⋙ - (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup)) := yoneda.yoneda_full in -by exactI full.of_comp_faithful preadditive_yoneda - ((whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup)) - -instance preadditive_coyoneda_full : full (preadditive_coyoneda : Cᵒᵖ ⥤ C ⥤ AddCommGroup) := -let coyoneda_full : full (preadditive_coyoneda ⋙ - (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup)) := - coyoneda.coyoneda_full in -by exactI full.of_comp_faithful preadditive_coyoneda - ((whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup)) - -instance preadditive_yoneda_faithful : faithful (preadditive_yoneda : C ⥤ Cᵒᵖ ⥤ AddCommGroup) := -faithful.of_comp_eq whiskering_preadditive_yoneda - -instance preadditive_coyoneda_faithful : - faithful (preadditive_coyoneda : Cᵒᵖ ⥤ C ⥤ AddCommGroup) := -faithful.of_comp_eq whiskering_preadditive_coyoneda - -end category_theory diff --git a/src/category_theory/preadditive/yoneda/basic.lean b/src/category_theory/preadditive/yoneda/basic.lean new file mode 100644 index 0000000000000..64cd6f6302f84 --- /dev/null +++ b/src/category_theory/preadditive/yoneda/basic.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.limits.yoneda +import category_theory.preadditive.opposite +import algebra.category.Module.basic +import algebra.category.Group.preadditive + +/-! +# The Yoneda embedding for preadditive categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an +object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module +structure. + +We also show that this presheaf is additive and that it is compatible with the normal Yoneda +embedding in the expected way and deduce that the preadditive Yoneda embedding is fully faithful. + +## TODO +* The Yoneda embedding is additive itself + +-/ + +universes v u + +open category_theory.preadditive opposite category_theory.limits + +noncomputable theory + +namespace category_theory + +variables {C : Type u} [category.{v} C] [preadditive C] + +/-- +The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an +object `X` to the `End Y`-module of morphisms `X ⟶ Y`. +-/ +@[simps] +def preadditive_yoneda_obj (Y : C) : Cᵒᵖ ⥤ Module.{v} (End Y) := +{ obj := λ X, Module.of _ (X.unop ⟶ Y), + map := λ X X' f, + { to_fun := λ g, f.unop ≫ g, + map_add' := λ g g', comp_add _ _ _ _ _ _, + map_smul' := λ r g, eq.symm $ category.assoc _ _ _ } } + +/-- +The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an +object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module +structure, see `preadditive_yoneda_obj`. +-/ +@[simps] +def preadditive_yoneda : C ⥤ (Cᵒᵖ ⥤ AddCommGroup.{v}) := +{ obj := λ Y, preadditive_yoneda_obj Y ⋙ forget₂ _ _, + map := λ Y Y' f, + { app := λ X, + { to_fun := λ g, g ≫ f, + map_zero' := limits.zero_comp, + map_add' := λ g g', add_comp _ _ _ _ _ _ }, + naturality' := λ X X' g, AddCommGroup.ext _ _ _ _ $ λ x, category.assoc _ _ _ }, + map_id' := λ X, by { ext, simp }, + map_comp' := λ X Y Z f g, by { ext, simp } } + +/-- +The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an +object `Y` to the `End X`-module of morphisms `X ⟶ Y`. +-/ +@[simps] +def preadditive_coyoneda_obj (X : Cᵒᵖ) : C ⥤ Module.{v} (End X) := +{ obj := λ Y, Module.of _ (unop X ⟶ Y), + map := λ Y Y' f, + { to_fun := λ g, g ≫ f, + map_add' := λ g g', add_comp _ _ _ _ _ _, + map_smul' := λ r g, category.assoc _ _ _ } } + +/-- +The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an +object `Y` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End X`-module +structure, see `preadditive_coyoneda_obj`. +-/ +@[simps] +def preadditive_coyoneda : Cᵒᵖ ⥤ (C ⥤ AddCommGroup.{v}) := +{ obj := λ X, preadditive_coyoneda_obj X ⋙ forget₂ _ _, + map := λ X X' f, + { app := λ Y, + { to_fun := λ g, f.unop ≫ g, + map_zero' := limits.comp_zero, + map_add' := λ g g', comp_add _ _ _ _ _ _ }, + naturality' := λ Y Y' g, AddCommGroup.ext _ _ _ _ $ λ x, eq.symm $ category.assoc _ _ _ }, + map_id' := λ X, by { ext, simp }, + map_comp' := λ X Y Z f g, by { ext, simp } } + +instance additive_yoneda_obj (X : C) : functor.additive (preadditive_yoneda_obj X) := {} +instance additive_yoneda_obj' (X : C) : functor.additive (preadditive_yoneda.obj X) := {} +instance additive_coyoneda_obj (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda_obj X) := {} +instance additive_coyoneda_obj' (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda.obj X) := {} + +/-- +Composing the preadditive yoneda embedding with the forgetful functor yields the regular +Yoneda embedding. +-/ +@[simp] lemma whiskering_preadditive_yoneda : preadditive_yoneda ⋙ + (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup) = yoneda := +rfl + +/-- +Composing the preadditive yoneda embedding with the forgetful functor yields the regular +Yoneda embedding. +-/ +@[simp] lemma whiskering_preadditive_coyoneda : preadditive_coyoneda ⋙ + (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup) = coyoneda := +rfl + +instance preadditive_yoneda_full : full (preadditive_yoneda : C ⥤ Cᵒᵖ ⥤ AddCommGroup) := +let yoneda_full : full (preadditive_yoneda ⋙ + (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup)) := yoneda.yoneda_full in +by exactI full.of_comp_faithful preadditive_yoneda + ((whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup)) + +instance preadditive_coyoneda_full : full (preadditive_coyoneda : Cᵒᵖ ⥤ C ⥤ AddCommGroup) := +let coyoneda_full : full (preadditive_coyoneda ⋙ + (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup)) := + coyoneda.coyoneda_full in +by exactI full.of_comp_faithful preadditive_coyoneda + ((whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup)) + +instance preadditive_yoneda_faithful : faithful (preadditive_yoneda : C ⥤ Cᵒᵖ ⥤ AddCommGroup) := +faithful.of_comp_eq whiskering_preadditive_yoneda + +instance preadditive_coyoneda_faithful : + faithful (preadditive_coyoneda : Cᵒᵖ ⥤ C ⥤ AddCommGroup) := +faithful.of_comp_eq whiskering_preadditive_coyoneda + +end category_theory diff --git a/src/category_theory/preadditive/yoneda/injective.lean b/src/category_theory/preadditive/yoneda/injective.lean new file mode 100644 index 0000000000000..cd5a64ba95c78 --- /dev/null +++ b/src/category_theory/preadditive/yoneda/injective.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2020 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel, Scott Morrison +-/ +import category_theory.preadditive.yoneda.basic +import category_theory.preadditive.injective +import algebra.category.Group.epi_mono +import algebra.category.Module.epi_mono + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +An object is injective iff the preadditive yoneda functor on it preserves epimorphisms. +-/ + +universes v u + +open opposite + +namespace category_theory +variables {C : Type u} [category.{v} C] + +section preadditive +variables [preadditive C] + +namespace injective + +lemma injective_iff_preserves_epimorphisms_preadditive_yoneda_obj (J : C) : + injective J ↔ (preadditive_yoneda.obj J).preserves_epimorphisms := +begin + rw injective_iff_preserves_epimorphisms_yoneda_obj, + refine ⟨λ (h : (preadditive_yoneda.obj J ⋙ (forget _)).preserves_epimorphisms), _, _⟩, + { exactI functor.preserves_epimorphisms_of_preserves_of_reflects (preadditive_yoneda.obj J) + (forget _) }, + { introI, + exact (infer_instance : (preadditive_yoneda.obj J ⋙ forget _).preserves_epimorphisms) } +end + +lemma injective_iff_preserves_epimorphisms_preadditive_yoneda_obj' (J : C) : + injective J ↔ (preadditive_yoneda_obj J).preserves_epimorphisms := +begin + rw injective_iff_preserves_epimorphisms_yoneda_obj, + refine ⟨λ (h : (preadditive_yoneda_obj J ⋙ (forget _)).preserves_epimorphisms), _, _⟩, + { exactI functor.preserves_epimorphisms_of_preserves_of_reflects (preadditive_yoneda_obj J) + (forget _) }, + { introI, + exact (infer_instance : (preadditive_yoneda_obj J ⋙ forget _).preserves_epimorphisms) } +end + +end injective + +end preadditive + +end category_theory diff --git a/src/category_theory/preadditive/yoneda/limits.lean b/src/category_theory/preadditive/yoneda/limits.lean new file mode 100644 index 0000000000000..ebbec2599df58 --- /dev/null +++ b/src/category_theory/preadditive/yoneda/limits.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.preadditive.yoneda.basic +import algebra.category.Module.abelian + +/-! +# The Yoneda embedding for preadditive categories preserves limits + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The Yoneda embedding for preadditive categories preserves limits. + +## Implementation notes + +This is in a separate file to avoid having to import the development of the abelian structure on +`Module` in the main file about the preadditive Yoneda embedding. + +-/ + +universes v u + +open category_theory.preadditive opposite category_theory.limits + +noncomputable theory + +namespace category_theory + +variables {C : Type u} [category.{v} C] [preadditive C] + +instance preserves_limits_preadditive_yoneda_obj (X : C) : + preserves_limits (preadditive_yoneda_obj X) := +have preserves_limits (preadditive_yoneda_obj X ⋙ forget _), + from (infer_instance : preserves_limits (yoneda.obj X)), +by exactI preserves_limits_of_reflects_of_preserves _ (forget _) + +instance preserves_limits_preadditive_coyoneda_obj (X : Cᵒᵖ) : + preserves_limits (preadditive_coyoneda_obj X) := +have preserves_limits (preadditive_coyoneda_obj X ⋙ forget _), + from (infer_instance : preserves_limits (coyoneda.obj X)), +by exactI preserves_limits_of_reflects_of_preserves _ (forget _) + +instance preserves_limits_preadditive_yoneda.obj (X : C) : + preserves_limits (preadditive_yoneda.obj X) := +show preserves_limits (preadditive_yoneda_obj X ⋙ forget₂ _ _), from infer_instance + +instance preserves_limits_preadditive_coyoneda.obj (X : Cᵒᵖ) : + preserves_limits (preadditive_coyoneda.obj X) := +show preserves_limits (preadditive_coyoneda_obj X ⋙ forget₂ _ _), from infer_instance + +end category_theory diff --git a/src/category_theory/preadditive/yoneda/projective.lean b/src/category_theory/preadditive/yoneda/projective.lean new file mode 100644 index 0000000000000..0cc596a1ce183 --- /dev/null +++ b/src/category_theory/preadditive/yoneda/projective.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2020 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel, Scott Morrison +-/ +import category_theory.preadditive.yoneda.basic +import category_theory.preadditive.projective +import algebra.category.Group.epi_mono +import algebra.category.Module.epi_mono + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +An object is projective iff the preadditive coyoneda functor on it preserves epimorphisms. +-/ + +universes v u + +open opposite + +namespace category_theory +variables {C : Type u} [category.{v} C] + +section preadditive +variables [preadditive C] + +namespace projective + +lemma projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj (P : C) : + projective P ↔ (preadditive_coyoneda.obj (op P)).preserves_epimorphisms := +begin + rw projective_iff_preserves_epimorphisms_coyoneda_obj, + refine ⟨λ (h : (preadditive_coyoneda.obj (op P) ⋙ (forget _)).preserves_epimorphisms), _, _⟩, + { exactI functor.preserves_epimorphisms_of_preserves_of_reflects (preadditive_coyoneda.obj (op P)) + (forget _) }, + { introI, + exact (infer_instance : (preadditive_coyoneda.obj (op P) ⋙ forget _).preserves_epimorphisms) } +end + +lemma projective_iff_preserves_epimorphisms_preadditive_coyoneda_obj' (P : C) : + projective P ↔ (preadditive_coyoneda_obj (op P)).preserves_epimorphisms := +begin + rw projective_iff_preserves_epimorphisms_coyoneda_obj, + refine ⟨λ (h : (preadditive_coyoneda_obj (op P) ⋙ (forget _)).preserves_epimorphisms), _, _⟩, + { exactI functor.preserves_epimorphisms_of_preserves_of_reflects (preadditive_coyoneda_obj (op P)) + (forget _) }, + { introI, + exact (infer_instance : (preadditive_coyoneda_obj (op P) ⋙ forget _).preserves_epimorphisms) } +end + +end projective + +end preadditive + +end category_theory diff --git a/src/category_theory/products/associator.lean b/src/category_theory/products/associator.lean index 429dbc51729a2..f1b340d0b8750 100644 --- a/src/category_theory/products/associator.lean +++ b/src/category_theory/products/associator.lean @@ -6,6 +6,9 @@ Authors: Stephen Morgan, Scott Morrison import category_theory.products.basic /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The associator functor `((C × D) × E) ⥤ (C × (D × E))` and its inverse form an equivalence. -/ diff --git a/src/category_theory/products/basic.lean b/src/category_theory/products/basic.lean index 5bd7e8228e7e8..8fcb51d0ec542 100644 --- a/src/category_theory/products/basic.lean +++ b/src/category_theory/products/basic.lean @@ -4,10 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Stephen Morgan, Scott Morrison -/ import category_theory.eq_to_hom +import category_theory.functor.const +import data.prod.basic /-! # Cartesian products of categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the category instance on `C × D` when `C` and `D` are categories. We define: @@ -63,6 +68,10 @@ end section variables {C D} +/-- The isomorphism between `(X.1, X.2)` and `X`. -/ +@[simps] +def prod.eta_iso (X : C × D) : (X.1, X.2) ≅ X := { hom := (𝟙 _, 𝟙 _), inv := (𝟙 _, 𝟙 _) } + /-- Construct an isomorphism in `C × D` out of two isomorphisms in `C` and `D`. -/ @[simps] def iso.prod {P Q : C} {S T : D} (f : P ≅ Q) (g : S ≅ T) : (P, S) ≅ (Q, T) := @@ -168,6 +177,13 @@ as a functor `C × (C ⥤ D) ⥤ D`. category.assoc, nat_trans.naturality], end } +variables {C} + +/-- The constant functor followed by the evalutation functor is just the identity. -/ +@[simps] def functor.const_comp_evaluation_obj (X : C) : + functor.const C ⋙ (evaluation C D).obj X ≅ 𝟭 D := +nat_iso.of_components (λ Y, iso.refl _) (λ Y Z f, by simp) + end variables {A : Type u₁} [category.{v₁} A] @@ -189,6 +205,16 @@ namespace functor { obj := λ a, (F.obj a, G.obj a), map := λ x y f, (F.map f, G.map f), } +/-- The product `F.prod' G` followed by projection on the first component is isomorphic to `F` -/ +@[simps] +def prod'_comp_fst (F : A ⥤ B) (G : A ⥤ C) : (F.prod' G) ⋙ (category_theory.prod.fst B C) ≅ F := +nat_iso.of_components (λ X, iso.refl _) (λ X Y f, by simp) + +/-- The product `F.prod' G` followed by projection on the second component is isomorphic to `G` -/ +@[simps] +def prod'_comp_snd (F : A ⥤ B) (G : A ⥤ C) : (F.prod' G) ⋙ (category_theory.prod.snd B C) ≅ G := +nat_iso.of_components (λ X, iso.refl _) (λ X Y f, by simp) + section variable (C) @@ -227,4 +253,42 @@ def flip_comp_evaluation (F : A ⥤ B ⥤ C) (a) : F.flip ⋙ (evaluation _ _).obj a ≅ F.obj a := nat_iso.of_components (λ b, eq_to_iso rfl) $ by tidy +variables (A B C) + +/-- The forward direction for `functor_prod_functor_equiv` -/ +@[simps] def prod_functor_to_functor_prod : (A ⥤ B) × (A ⥤ C) ⥤ A ⥤ B × C := +{ obj := λ F, F.1.prod' F.2, + map := λ F G f, { app := λ X, (f.1.app X, f.2.app X) } } + +/-- The backward direction for `functor_prod_functor_equiv` -/ +@[simps] def functor_prod_to_prod_functor : (A ⥤ B × C) ⥤ (A ⥤ B) × (A ⥤ C) := +{ obj := λ F, ⟨F ⋙ (category_theory.prod.fst B C), F ⋙ (category_theory.prod.snd B C)⟩, + map := λ F G α, + ⟨{ app := λ X, (α.app X).1, + naturality' := λ X Y f, + by simp only [functor.comp_map, prod.fst_map, ←prod_comp_fst, α.naturality] }, + { app := λ X, (α.app X).2, + naturality' := λ X Y f, + by simp only [functor.comp_map, prod.snd_map, ←prod_comp_snd, α.naturality] }⟩ } + +/-- The unit isomorphism for `functor_prod_functor_equiv` -/ +@[simps] def functor_prod_functor_equiv_unit_iso : + 𝟭 _ ≅ prod_functor_to_functor_prod A B C ⋙ functor_prod_to_prod_functor A B C := +nat_iso.of_components + (λ F, (((functor.prod'_comp_fst _ _).prod (functor.prod'_comp_snd _ _)).trans + (prod.eta_iso F)).symm) (λ F G α, by {tidy}) + +/-- The counit isomorphism for `functor_prod_functor_equiv` -/ +@[simps] def functor_prod_functor_equiv_counit_iso : + functor_prod_to_prod_functor A B C ⋙ prod_functor_to_functor_prod A B C ≅ 𝟭 _ := +nat_iso.of_components + (λ F, nat_iso.of_components (λ X, prod.eta_iso (F.obj X)) (by tidy)) (by tidy) + +/-- The equivalence of categories between `(A ⥤ B) × (A ⥤ C)` and `A ⥤ (B × C)` -/ +@[simps] def functor_prod_functor_equiv : ((A ⥤ B) × (A ⥤ C)) ≌ (A ⥤ (B × C)) := +{ functor := prod_functor_to_functor_prod A B C, + inverse := functor_prod_to_prod_functor A B C, + unit_iso := functor_prod_functor_equiv_unit_iso A B C, + counit_iso := functor_prod_functor_equiv_counit_iso A B C } + end category_theory diff --git a/src/category_theory/products/bifunctor.lean b/src/category_theory/products/bifunctor.lean index f8b62a738ec1f..f20ec369fff1a 100644 --- a/src/category_theory/products/bifunctor.lean +++ b/src/category_theory/products/bifunctor.lean @@ -7,6 +7,9 @@ import category_theory.products.basic /-! # Lemmas about functors out of product categories. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open category_theory diff --git a/src/category_theory/products/default.lean b/src/category_theory/products/default.lean deleted file mode 100644 index 816bf1996a348..0000000000000 --- a/src/category_theory/products/default.lean +++ /dev/null @@ -1,2 +0,0 @@ -import category_theory.products.bifunctor -import category_theory.products.associator diff --git a/src/category_theory/punit.lean b/src/category_theory/punit.lean index 834a3f78b5fd4..a953c39ac8dc1 100644 --- a/src/category_theory/punit.lean +++ b/src/category_theory/punit.lean @@ -9,6 +9,9 @@ import category_theory.discrete_category /-! # The category `discrete punit` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `star : C ⥤ discrete punit` sending everything to `punit.star`, show that any two functors to `discrete punit` are naturally isomorphic, and construct the equivalence `(discrete punit ⥤ C) ≌ C`. @@ -24,7 +27,7 @@ namespace functor /-- The constant functor sending everything to `punit.star`. -/ @[simps] def star : C ⥤ discrete punit := -(functor.const _).obj punit.star +(functor.const _).obj ⟨⟨⟩⟩ variable {C} /-- Any two functors to `discrete punit` are isomorphic. -/ @@ -47,18 +50,18 @@ abbreviation from_punit (X : C) : discrete punit.{v+1} ⥤ C := @[simps] def equiv : (discrete punit ⥤ C) ≌ C := { functor := - { obj := λ F, F.obj punit.star, - map := λ F G θ, θ.app punit.star }, + { obj := λ F, F.obj ⟨⟨⟩⟩, + map := λ F G θ, θ.app ⟨⟨⟩⟩ }, inverse := functor.const _, unit_iso := begin apply nat_iso.of_components _ _, intro X, apply discrete.nat_iso, - rintro ⟨⟩, + rintro ⟨⟨⟩⟩, apply iso.refl _, intros, - ext ⟨⟩, + ext ⟨⟨⟩⟩, simp, end, counit_iso := @@ -77,10 +80,10 @@ theorem equiv_punit_iff_unique : begin split, { rintro ⟨h⟩, - refine ⟨⟨h.inverse.obj punit.star⟩, λ x y, nonempty.intro _⟩, + refine ⟨⟨h.inverse.obj ⟨⟨⟩⟩⟩, λ x y, nonempty.intro _⟩, apply (unique_of_subsingleton _), swap, - { have hx : x ⟶ h.inverse.obj punit.star := by convert h.unit.app x, - have hy : h.inverse.obj punit.star ⟶ y := by convert h.unit_inv.app y, + { have hx : x ⟶ h.inverse.obj ⟨⟨⟩⟩ := by convert h.unit.app x, + have hy : h.inverse.obj ⟨⟨⟩⟩ ⟶ y := by convert h.unit_inv.app y, exact hx ≫ hy, }, have : ∀ z, z = h.unit.app x ≫ (h.functor ⋙ h.inverse).map z ≫ h.unit_inv.app y, { intro z, simpa using congr_arg (≫ (h.unit_inv.app y)) (h.unit.naturality z), }, @@ -91,7 +94,7 @@ begin { rintro ⟨⟨p⟩, h⟩, haveI := λ x y, (h x y).some, refine nonempty.intro (category_theory.equivalence.mk - ((functor.const _).obj punit.star) ((functor.const _).obj p) _ (by apply functor.punit_ext)), + ((functor.const _).obj ⟨⟨⟩⟩) ((functor.const _).obj p) _ (by apply functor.punit_ext)), exact nat_iso.of_components (λ _, { hom := default, inv := default }) (λ _ _ _, by tidy), }, end diff --git a/src/category_theory/quotient.lean b/src/category_theory/quotient.lean index 94b63d2b1c21d..b853e969c8e2f 100644 --- a/src/category_theory/quotient.lean +++ b/src/category_theory/quotient.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: David Wärn -/ import category_theory.natural_isomorphism -import category_theory.equivalence import category_theory.eq_to_hom /-! # Quotient category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Constructs the quotient of a category by an arbitrary family of relations on its hom-sets, by introducing a type synonym for the objects, and identifying homs as necessary. @@ -126,10 +128,30 @@ include H def lift : quotient r ⥤ D := { obj := λ a, F.obj a.as, map := λ a b hf, quot.lift_on hf (λ f, F.map f) - (by { rintros _ _ ⟨_, _, _, _, _, _, h⟩, simp [H _ _ _ _ h], }), + (by { rintro _ _ ⟨_, _, _, _, h⟩, simp [H _ _ _ _ h], }), map_id' := λ a, F.map_id a.as, map_comp' := by { rintros a b c ⟨f⟩ ⟨g⟩, exact F.map_comp f g, } } +lemma lift_spec : (functor r) ⋙ lift r F H = F := +begin + apply functor.ext, rotate, + { rintro X, refl, }, + { rintro X Y f, simp, }, +end + +lemma lift_unique (Φ : quotient r ⥤ D) (hΦ : (functor r) ⋙ Φ = F) : Φ = lift r F H := +begin + subst_vars, + apply functor.hext, + { rintro X, dsimp [lift, functor], congr, ext, refl, }, + { rintro X Y f, + dsimp [lift, functor], + apply quot.induction_on f, + rintro ff, + simp only [quot.lift_on_mk, functor.comp_map], + congr; ext; refl, }, +end + /-- The original functor factors through the induced functor. -/ def lift.is_lift : (functor r) ⋙ lift r F H ≅ F := nat_iso.of_components (λ X, iso.refl _) (by tidy) diff --git a/src/category_theory/shift.lean b/src/category_theory/shift.lean deleted file mode 100644 index ef3d372d349bb..0000000000000 --- a/src/category_theory/shift.lean +++ /dev/null @@ -1,432 +0,0 @@ -/- -Copyright (c) 2020 Scott Morrison. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Scott Morrison, Johan Commelin, Andrew Yang --/ -import category_theory.limits.preserves.shapes.zero -import category_theory.monoidal.End -import category_theory.monoidal.discrete - -/-! -# Shift - -A `shift` on a category `C` indexed by a monoid `A` is is nothing more than a monoidal functor -from `A` to `C ⥤ C`. A typical example to keep in mind might be the category of -complexes `⋯ → C_{n-1} → C_n → C_{n+1} → ⋯`. It has a shift indexed by `ℤ`, where we assign to -each `n : ℤ` the functor `C ⥤ C` that re-indexing the terms, so the degree `i` term of `shift n C` -would be the degree `i+n`-th term of `C`. - -## Main definitions -* `has_shift`: A typeclass asserting the existence of a shift functor. -* `shift_equiv`: When the indexing monoid is a group, then the functor indexed by `n` and `-n` forms - an self-equivalence of `C`. -* `shift_comm`: When the indexing monoid is commutative, then shifts commute as well. - -## Implementation Notes - -Many of the definitions in this file are marked as an `abbreviation` so that the simp lemmas in -`category_theory/monoidal/End` can apply. - --/ -namespace category_theory - -noncomputable theory - -universes v u - -variables (C : Type u) (A : Type*) [category.{v} C] - -local attribute [instance] endofunctor_monoidal_category - -section eq_to_hom - -variables {A C} - -variables [add_monoid A] (F : monoidal_functor (discrete A) (C ⥤ C)) - - @[simp, reassoc] lemma eq_to_hom_μ_app {i j i' j' : A} (h₁ : i = i') (h₂ : j = j') (X : C) : - eq_to_hom (by rw [h₁, h₂]) ≫ (F.μ i' j').app X = - (F.μ i j).app X ≫ eq_to_hom (by rw [h₁, h₂]) := - by { cases h₁, cases h₂, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] } - - @[simp, reassoc] lemma μ_inv_app_eq_to_hom {i j i' j' : A} (h₁ : i = i') (h₂ : j = j') (X : C) : - (F.μ_iso i j).inv.app X ≫ eq_to_hom (by rw [h₁, h₂]) = - eq_to_hom (by rw [h₁, h₂]) ≫ (F.μ_iso i' j').inv.app X := - by { cases h₁, cases h₂, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] } - -end eq_to_hom - -variables {A C} - -/-- A monoidal functor from a group `A` into `C ⥤ C` induces -a self-equivalence of `C` for each `n : A`. -/ -@[simps functor inverse unit_iso_hom unit_iso_inv counit_iso_hom counit_iso_inv] -def add_neg_equiv [add_group A] (F : monoidal_functor (discrete A) (C ⥤ C)) (n : A) : C ≌ C := -equiv_of_tensor_iso_unit F n (-n : A) - (eq_to_iso (add_neg_self n)) (eq_to_iso (neg_add_self n)) (subsingleton.elim _ _) - -section defs - -variables (A C) [add_monoid A] - -/-- A category has a shift indexed by an additive monoid `A` -if there is a monoidal functor from `A` to `C ⥤ C`. -/ -class has_shift (C : Type u) (A : Type*) [category.{v} C] [add_monoid A] := -(shift : monoidal_functor (discrete A) (C ⥤ C)) - -/-- A helper structure to construct the shift functor `(discrete A) ⥤ (C ⥤ C)`. -/ -@[nolint has_inhabited_instance] -structure shift_mk_core := -(F : A → (C ⥤ C)) -(ε : 𝟭 C ≅ F 0) -(μ : Π n m : A, F n ⋙ F m ≅ F (n + m)) -(associativity : ∀ (m₁ m₂ m₃ : A) (X : C), - (F m₃).map ((μ m₁ m₂).hom.app X) ≫ (μ (m₁ + m₂) m₃).hom.app X ≫ - eq_to_hom (by { congr' 2, exact add_assoc _ _ _ }) = - (μ m₂ m₃).hom.app ((F m₁).obj X) ≫ (μ m₁ (m₂ + m₃)).hom.app X . obviously) -(left_unitality : ∀ (n : A) (X : C), - (F n).map (ε.hom.app X) ≫ (μ 0 n).hom.app X = - eq_to_hom (by { dsimp, rw zero_add }) . obviously) -(right_unitality : ∀ (n : A) (X : C), - ε.hom.app ((F n).obj X) ≫ (μ n 0).hom.app X = - eq_to_hom (by { dsimp, rw add_zero }) . obviously) - -section -local attribute [reducible] endofunctor_monoidal_category discrete.add_monoidal - -/-- Constructs a `has_shift C A` instance from `shift_mk_core`. -/ -@[simps] -def has_shift_mk (h : shift_mk_core C A) : has_shift C A := -⟨{ ε := h.ε.hom, - μ := λ m n, (h.μ m n).hom, - μ_natural' := by { rintros _ _ _ _ ⟨⟨rfl⟩⟩ ⟨⟨rfl⟩⟩, ext, dsimp, simp, dsimp, simp }, - associativity' := by { introv, ext, dsimp, simpa using h.associativity _ _ _ _, }, - left_unitality' := - by { introv, ext, dsimp, rw [category.id_comp, ← category.assoc, h.left_unitality], simp }, - right_unitality' := - by { introv, ext, dsimp, rw [functor.map_id, category.comp_id, - ← category.assoc, h.right_unitality], simp }, - ..(discrete.functor h.F) }⟩ - -end - -variables [has_shift C A] - -/-- The monoidal functor from `A` to `C ⥤ C` given a `has_shift` instance. -/ -def shift_monoidal_functor : monoidal_functor (discrete A) (C ⥤ C) := has_shift.shift - -variable {A} - -/-- The shift autoequivalence, moving objects and morphisms 'up'. -/ -abbreviation shift_functor (i : A) : C ⥤ C := (shift_monoidal_functor C A).obj i - -/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/ -abbreviation shift_functor_add (i j : A) : - shift_functor C (i + j) ≅ shift_functor C i ⋙ shift_functor C j := -((shift_monoidal_functor C A).μ_iso i j).symm - -variables (A) - -/-- Shifting by zero is the identity functor. -/ -abbreviation shift_functor_zero : shift_functor C (0 : A) ≅ 𝟭 C := -(shift_monoidal_functor C A).ε_iso.symm - --- Any better notational suggestions? -notation X`⟦`n`⟧`:20 := (shift_functor _ n).obj X -notation f`⟦`n`⟧'`:80 := (shift_functor _ n).map f - -end defs - -section add_monoid - -variables {C A} [add_monoid A] [has_shift C A] (X Y : C) (f : X ⟶ Y) - -@[simp] lemma has_shift.shift_obj_obj (n : A) (X : C) : (has_shift.shift.obj n).obj X = X⟦n⟧ := rfl - -/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/ -abbreviation shift_add (i j : A) : X⟦i + j⟧ ≅ X⟦i⟧⟦j⟧ := (shift_functor_add C i j).app _ - -@[reassoc] lemma shift_add_hom_comp_eq_to_hom₁ (i i' j : A) (h : i = i') : - (shift_add X i j).hom ≫ eq_to_hom (by rw h) = eq_to_hom (by rw h) ≫ (shift_add X i' j).hom := -by { cases h, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] } - -@[reassoc] lemma shift_add_hom_comp_eq_to_hom₂ (i j j' : A) (h : j = j') : - (shift_add X i j).hom ≫ eq_to_hom (by rw h) = eq_to_hom (by rw h) ≫ (shift_add X i j').hom := -by { cases h, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] } - -@[reassoc] lemma shift_add_hom_comp_eq_to_hom₁₂ (i j i' j' : A) (h₁ : i = i') (h₂ : j = j') : - (shift_add X i j).hom ≫ eq_to_hom (by rw [h₁, h₂]) = - eq_to_hom (by rw [h₁, h₂]) ≫ (shift_add X i' j').hom := -by { cases h₁, cases h₂, rw [eq_to_hom_refl, eq_to_hom_refl, category.id_comp, category.comp_id] } - -@[reassoc] lemma eq_to_hom_comp_shift_add_inv₁ (i i' j : A) (h : i = i') : - eq_to_hom (by rw h) ≫ (shift_add X i' j).inv = (shift_add X i j).inv ≫ eq_to_hom (by rw h) := -by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, shift_add_hom_comp_eq_to_hom₁] - -@[reassoc] lemma eq_to_hom_comp_shift_add_inv₂ (i j j' : A) (h : j = j') : - eq_to_hom (by rw h) ≫ (shift_add X i j').inv = (shift_add X i j).inv ≫ eq_to_hom (by rw h) := -by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, shift_add_hom_comp_eq_to_hom₂] - -@[reassoc] lemma eq_to_hom_comp_shift_add_inv₁₂ (i j i' j' : A) (h₁ : i = i') (h₂ : j = j') : - eq_to_hom (by rw [h₁, h₂]) ≫ (shift_add X i' j').inv = - (shift_add X i j).inv ≫ eq_to_hom (by rw [h₁, h₂]) := -by rw [iso.comp_inv_eq, category.assoc, iso.eq_inv_comp, shift_add_hom_comp_eq_to_hom₁₂] - -lemma shift_shift' (i j : A) : - f⟦i⟧'⟦j⟧' = (shift_add X i j).inv ≫ f⟦i + j⟧' ≫ (shift_add Y i j).hom := -by { symmetry, apply nat_iso.naturality_1 } - -variables (A) - -/-- Shifting by zero is the identity functor. -/ -abbreviation shift_zero : - X⟦0⟧ ≅ X := (shift_functor_zero C A).app _ - -lemma shift_zero' : - f⟦(0 : A)⟧' = (shift_zero A X).hom ≫ f ≫ (shift_zero A Y).inv := -by { symmetry, apply nat_iso.naturality_2 } - -end add_monoid - -section opaque_eq_to_iso - -variables {ι : Type*} {i j k : ι} - -/-- This definition is used instead of `eq_to_iso` so that the proof of `i = j` is visible -to the simplifier -/ -def opaque_eq_to_iso (h : i = j) : @iso (discrete ι) _ i j := eq_to_iso h - -@[simp] -lemma opaque_eq_to_iso_symm (h : i = j) : - (opaque_eq_to_iso h).symm = opaque_eq_to_iso h.symm := rfl - -@[simp] -lemma opaque_eq_to_iso_inv (h : i = j) : - (opaque_eq_to_iso h).inv = (opaque_eq_to_iso h.symm).hom := rfl - -@[simp, reassoc] -lemma map_opaque_eq_to_iso_comp_app (F : discrete ι ⥤ C ⥤ C) (h : i = j) (h' : j = k) (X : C) : - (F.map (opaque_eq_to_iso h).hom).app X ≫ (F.map (opaque_eq_to_iso h').hom).app X = - (F.map (opaque_eq_to_iso $ h.trans h').hom).app X := by { delta opaque_eq_to_iso, simp } - -end opaque_eq_to_iso - -section add_group - -variables (C) {A} [add_group A] [has_shift C A] -variables (X Y : C) (f : X ⟶ Y) - - -/-- Shifting by `i` and then shifting by `-i` is the identity. -/ -abbreviation shift_functor_comp_shift_functor_neg (i : A) : - shift_functor C i ⋙ shift_functor C (-i) ≅ 𝟭 C := -unit_of_tensor_iso_unit (shift_monoidal_functor C A) i (-i : A) (opaque_eq_to_iso (add_neg_self i)) - -/-- Shifting by `-i` and then shifting by `i` is the identity. -/ -abbreviation shift_functor_neg_comp_shift_functor (i : A) : - shift_functor C (-i) ⋙ shift_functor C i ≅ 𝟭 C := -unit_of_tensor_iso_unit (shift_monoidal_functor C A) (-i : A) i (opaque_eq_to_iso (neg_add_self i)) - -section - -variables (C) - -/-- Shifting by `n` is a faithful functor. -/ -instance shift_functor_faithful (i : A) : faithful (shift_functor C i) := -faithful.of_comp_iso (shift_functor_comp_shift_functor_neg C i) - -/-- Shifting by `n` is a full functor. -/ -instance shift_functor_full (i : A) : full (shift_functor C i) := -begin - haveI : full (shift_functor C i ⋙ shift_functor C (-i)) := - full.of_iso (shift_functor_comp_shift_functor_neg C i).symm, - exact full.of_comp_faithful _ (shift_functor C (-i)) -end - -/-- Shifting by `n` is an essentially surjective functor. -/ -instance shift_functor_ess_surj (i : A) : ess_surj (shift_functor C i) := -{ mem_ess_image := λ Y, ⟨Y⟦-i⟧, ⟨(shift_functor_neg_comp_shift_functor C i).app Y⟩⟩ } - -/-- Shifting by `n` is an equivalence. -/ -noncomputable instance shift_functor_is_equivalence (n : A) : is_equivalence (shift_functor C n) := -equivalence.of_fully_faithfully_ess_surj _ - -end - -variables {C} - -/-- Shifting by `i` and then shifting by `-i` is the identity. -/ -abbreviation shift_shift_neg (i : A) : X⟦i⟧⟦-i⟧ ≅ X := -(shift_functor_comp_shift_functor_neg C i).app _ - -/-- Shifting by `-i` and then shifting by `i` is the identity. -/ -abbreviation shift_neg_shift (i : A) : X⟦-i⟧⟦i⟧ ≅ X := -(shift_functor_neg_comp_shift_functor C i).app _ - -variables {X Y} - -lemma shift_shift_neg' (i : A) : - f⟦i⟧'⟦-i⟧' = (shift_shift_neg X i).hom ≫ f ≫ (shift_shift_neg Y i).inv := -by { symmetry, apply nat_iso.naturality_2 } - -lemma shift_neg_shift' (i : A) : - f⟦-i⟧'⟦i⟧' = (shift_neg_shift X i).hom ≫ f ≫ (shift_neg_shift Y i).inv := -by { symmetry, apply nat_iso.naturality_2 } - -lemma shift_equiv_triangle (n : A) (X : C) : - (shift_shift_neg X n).inv⟦n⟧' ≫ (shift_neg_shift (X⟦n⟧) n).hom = 𝟙 (X⟦n⟧) := -(add_neg_equiv (shift_monoidal_functor C A) n).functor_unit_iso_comp X - -section -local attribute [reducible] discrete.add_monoidal - -lemma shift_shift_neg_hom_shift (n : A) (X : C) : - (shift_shift_neg X n).hom ⟦n⟧' = (shift_neg_shift (X⟦n⟧) n).hom := -by simp - -end - -lemma shift_shift_neg_inv_shift (n : A) (X : C) : - (shift_shift_neg X n).inv ⟦n⟧' = (shift_neg_shift (X⟦n⟧) n).inv := -by { ext, rw [← shift_shift_neg_hom_shift, ← functor.map_comp, iso.hom_inv_id, functor.map_id] } - -@[simp] -lemma shift_shift_neg_shift_eq (n : A) (X : C) : - (shift_functor C n).map_iso (shift_shift_neg X n) = shift_neg_shift (X⟦n⟧) n := -category_theory.iso.ext $ shift_shift_neg_hom_shift _ _ - -variables (C) - -/-- Shifting by `n` and shifting by `-n` forms an equivalence. -/ -@[simps] -def shift_equiv (n : A) : C ≌ C := -{ functor := shift_functor C n, - inverse := shift_functor C (-n), - ..(add_neg_equiv (shift_monoidal_functor C A) n) } - -variable {C} - -open category_theory.limits - -variables [has_zero_morphisms C] - -lemma shift_zero_eq_zero (X Y : C) (n : A) : (0 : X ⟶ Y)⟦n⟧' = (0 : X⟦n⟧ ⟶ Y⟦n⟧) := -category_theory.functor.map_zero _ _ _ - -end add_group - -section add_comm_monoid - -variables {C A} [add_comm_monoid A] [has_shift C A] -variables (X Y : C) (f : X ⟶ Y) - -/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/ -def shift_comm (i j : A) : X⟦i⟧⟦j⟧ ≅ X⟦j⟧⟦i⟧ := -(shift_add X i j).symm ≪≫ ((shift_monoidal_functor C A).to_functor.map_iso - (opaque_eq_to_iso $ add_comm i j : _)).app X ≪≫ shift_add X j i - -@[simp] lemma shift_comm_symm (i j : A) : (shift_comm X i j).symm = shift_comm X j i := -begin - ext, dsimp [shift_comm], simpa -end - -variables {X Y} - -/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/ -lemma shift_comm' (i j : A) : - f⟦i⟧'⟦j⟧' = (shift_comm _ _ _).hom ≫ f⟦j⟧'⟦i⟧' ≫ (shift_comm _ _ _).hom := -by simp [shift_comm] - -@[reassoc] lemma shift_comm_hom_comp (i j : A) : - (shift_comm X i j).hom ≫ f⟦j⟧'⟦i⟧' = f⟦i⟧'⟦j⟧' ≫ (shift_comm Y i j).hom := -by rw [shift_comm', ← shift_comm_symm, iso.symm_hom, iso.inv_hom_id_assoc] - -end add_comm_monoid - -variables {D : Type*} [category D] [add_monoid A] [has_shift D A] -variables (F : C ⥤ D) [full F] [faithful F] - -section -local attribute [reducible] discrete.add_monoidal - -/-- Given a family of endomorphisms of `C` which are interwined by a fully faithful `F : C ⥤ D` -with shift functors on `D`, we can promote that family to shift functors on `C`. -/ -def has_shift_of_fully_faithful - (s : A → C ⥤ C) (i : ∀ i, s i ⋙ F ≅ F ⋙ shift_functor D i) : has_shift C A := -has_shift_mk C A -{ F := s, - ε := nat_iso_of_comp_fully_faithful F - (calc 𝟭 C ⋙ F ≅ F : functor.left_unitor _ - ... ≅ F ⋙ 𝟭 D : (functor.right_unitor _).symm - ... ≅ F ⋙ shift_functor D (0 : A) : - iso_whisker_left F (shift_functor_zero D A).symm - ... ≅ s 0 ⋙ F : (i 0).symm), - μ := λ a b, nat_iso_of_comp_fully_faithful F - (calc (s a ⋙ s b) ⋙ F ≅ s a ⋙ s b ⋙ F : functor.associator _ _ _ - ... ≅ s a ⋙ F ⋙ shift_functor D b : iso_whisker_left _ (i b) - ... ≅ (s a ⋙ F) ⋙ shift_functor D b : (functor.associator _ _ _).symm - ... ≅ (F ⋙ shift_functor D a) ⋙ shift_functor D b : iso_whisker_right (i a) _ - ... ≅ F ⋙ shift_functor D a ⋙ shift_functor D b : functor.associator _ _ _ - ... ≅ F ⋙ shift_functor D (a + b) : - iso_whisker_left _ (shift_functor_add D a b).symm - ... ≅ s (a + b) ⋙ F : (i (a + b)).symm), - associativity := begin - intros, apply F.map_injective, dsimp, - simp only [category.comp_id, category.id_comp, category.assoc, - category_theory.functor.map_comp, functor.image_preimage, - eq_to_hom_map, iso.inv_hom_id_app_assoc], - erw (i m₃).hom.naturality_assoc, - congr' 1, - dsimp, - simp only [eq_to_iso.inv, eq_to_hom_app, eq_to_hom_map, obj_μ_app, μ_naturality_assoc, - category.assoc, category_theory.functor.map_comp, functor.image_preimage], - congr' 3, - dsimp, - simp only [←(shift_functor D m₃).map_comp_assoc, iso.inv_hom_id_app], - erw [(shift_functor D m₃).map_id, category.id_comp], - erw [((shift_monoidal_functor D A).μ_iso (m₁ + m₂) m₃).inv_hom_id_app_assoc], - congr' 1, - have := dcongr_arg (λ a, (i a).inv.app X) (add_assoc m₁ m₂ m₃), - dsimp at this, - simp [this], - end, - left_unitality := begin - intros, apply F.map_injective, dsimp, - simp only [category.comp_id, category.id_comp, category.assoc, category_theory.functor.map_comp, - eq_to_hom_app, eq_to_hom_map, functor.image_preimage], - erw (i n).hom.naturality_assoc, - dsimp, - simp only [eq_to_iso.inv, eq_to_hom_app, category.assoc, category_theory.functor.map_comp, - eq_to_hom_map, obj_ε_app, functor.image_preimage], - simp only [←(shift_functor D n).map_comp_assoc, iso.inv_hom_id_app], - dsimp, - simp only [category.id_comp, μ_inv_hom_app_assoc, category_theory.functor.map_id], - have := dcongr_arg (λ a, (i a).inv.app X) (zero_add n), - dsimp at this, - simp [this], - end, - right_unitality := begin - intros, apply F.map_injective, dsimp, - simp only [category.comp_id, category.id_comp, category.assoc, - iso.inv_hom_id_app_assoc, eq_to_iso.inv, eq_to_hom_app, eq_to_hom_map, - category_theory.functor.map_comp, functor.image_preimage, - obj_zero_map_μ_app, ε_hom_inv_app_assoc], - have := dcongr_arg (λ a, (i a).inv.app X) (add_zero n), - dsimp at this, - simp [this], - end, } - -end - -/-- When we construct shifts on a subcategory from shifts on the ambient category, -the inclusion functor intertwines the shifts. -/ -@[nolint unused_arguments] -- incorrectly reports that `[full F]` and `[faithful F]` are unused. -def has_shift_of_fully_faithful_comm - (s : A → C ⥤ C) (i : ∀ i, s i ⋙ F ≅ F ⋙ shift_functor D i) (m : A) : - begin - haveI := has_shift_of_fully_faithful F s i, - exact (shift_functor C m) ⋙ F ≅ F ⋙ shift_functor D m - end := -i m - -end category_theory diff --git a/src/category_theory/shift/basic.lean b/src/category_theory/shift/basic.lean new file mode 100644 index 0000000000000..fb22baa97b3b6 --- /dev/null +++ b/src/category_theory/shift/basic.lean @@ -0,0 +1,736 @@ +/- +Copyright (c) 2020 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Johan Commelin, Andrew Yang, Joël Riou +-/ +import category_theory.limits.preserves.shapes.zero +import category_theory.monoidal.End +import category_theory.monoidal.discrete + +/-! +# Shift + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A `shift` on a category `C` indexed by a monoid `A` is nothing more than a monoidal functor +from `A` to `C ⥤ C`. A typical example to keep in mind might be the category of +complexes `⋯ → C_{n-1} → C_n → C_{n+1} → ⋯`. It has a shift indexed by `ℤ`, where we assign to +each `n : ℤ` the functor `C ⥤ C` that re-indexes the terms, so the degree `i` term of `shift n C` +would be the degree `i+n`-th term of `C`. + +## Main definitions +* `has_shift`: A typeclass asserting the existence of a shift functor. +* `shift_equiv`: When the indexing monoid is a group, then the functor indexed by `n` and `-n` forms + an self-equivalence of `C`. +* `shift_comm`: When the indexing monoid is commutative, then shifts commute as well. + +## Implementation Notes + +`[has_shift C A]` is implemented using `monoidal_functor (discrete A) (C ⥤ C)`. +However, the API of monodial functors is used only internally: one should use the API of +shifts functors which includes `shift_functor C a : C ⥤ C` for `a : A`, +`shift_functor_zero C A : shift_functor C (0 : A) ≅ 𝟭 C` and +`shift_functor_add C i j : shift_functor C (i + j) ≅ shift_functor C i ⋙ shift_functor C j` +(and its variant `shift_functor_add'`). These isomorphisms satisfy some coherence properties +which are stated in lemmas like `shift_functor_add'_assoc`, `shift_functor_add'_zero_add` and +`shift_functor_add'_add_zero`. + +-/ +namespace category_theory + +noncomputable theory + +universes v u + +variables (C : Type u) (A : Type*) [category.{v} C] + +local attribute [instance] endofunctor_monoidal_category + +section defs + +variables (A C) [add_monoid A] + +/-- A category has a shift indexed by an additive monoid `A` +if there is a monoidal functor from `A` to `C ⥤ C`. -/ +class has_shift (C : Type u) (A : Type*) [category.{v} C] [add_monoid A] := +(shift : monoidal_functor (discrete A) (C ⥤ C)) + +/-- A helper structure to construct the shift functor `(discrete A) ⥤ (C ⥤ C)`. -/ +@[nolint has_nonempty_instance] +structure shift_mk_core := +(F : A → (C ⥤ C)) +(zero : F 0 ≅ 𝟭 C) +(add : Π n m : A, F (n + m) ≅ F n ⋙ F m) +(assoc_hom_app : ∀ (m₁ m₂ m₃ : A) (X : C), + (add (m₁ + m₂) m₃).hom.app X ≫ (F m₃).map ((add m₁ m₂).hom.app X) = + eq_to_hom (by rw [add_assoc]) ≫ (add m₁ (m₂ + m₃)).hom.app X ≫ + (add m₂ m₃).hom.app ((F m₁).obj X)) +(zero_add_hom_app : ∀ (n : A) (X : C), (add 0 n).hom.app X = + eq_to_hom (by dsimp; rw [zero_add]) ≫ (F n).map (zero.inv.app X)) +(add_zero_hom_app : ∀ (n : A) (X : C), (add n 0).hom.app X = + eq_to_hom (by dsimp; rw [add_zero]) ≫ zero.inv.app ((F n).obj X)) + +namespace shift_mk_core + +variables {C A} + +attribute [reassoc] assoc_hom_app + +@[reassoc] +lemma assoc_inv_app (h : shift_mk_core C A) (m₁ m₂ m₃ : A) (X : C) : + (h.F m₃).map ((h.add m₁ m₂).inv.app X) ≫ (h.add (m₁ + m₂) m₃).inv.app X = + (h.add m₂ m₃).inv.app ((h.F m₁).obj X) ≫ (h.add m₁ (m₂ + m₃)).inv.app X ≫ + eq_to_hom (by rw [add_assoc]) := +begin + rw [← cancel_mono ((h.add (m₁ + m₂) m₃).hom.app X ≫ (h.F m₃).map ((h.add m₁ m₂).hom.app X)), + category.assoc, category.assoc, category.assoc, iso.inv_hom_id_app_assoc, ← functor.map_comp, + iso.inv_hom_id_app, functor.map_id, h.assoc_hom_app, eq_to_hom_trans_assoc, eq_to_hom_refl, + category.id_comp, iso.inv_hom_id_app_assoc, iso.inv_hom_id_app], + refl, +end + +lemma zero_add_inv_app (h : shift_mk_core C A) (n : A) (X : C) : + (h.add 0 n).inv.app X = (h.F n).map (h.zero.hom.app X) ≫ + eq_to_hom (by dsimp; rw [zero_add]) := +by rw [← cancel_epi ((h.add 0 n).hom.app X), iso.hom_inv_id_app, h.zero_add_hom_app, + category.assoc, ← functor.map_comp_assoc, iso.inv_hom_id_app, functor.map_id, + category.id_comp, eq_to_hom_trans, eq_to_hom_refl] + +lemma add_zero_inv_app (h : shift_mk_core C A) (n : A) (X : C) : + (h.add n 0).inv.app X = h.zero.hom.app ((h.F n).obj X) ≫ + eq_to_hom (by dsimp; rw [add_zero]) := +by rw [← cancel_epi ((h.add n 0).hom.app X), iso.hom_inv_id_app, h.add_zero_hom_app, + category.assoc, iso.inv_hom_id_app_assoc, eq_to_hom_trans, eq_to_hom_refl] + +end shift_mk_core + +section + +local attribute [simp] eq_to_hom_map +local attribute [reducible] endofunctor_monoidal_category discrete.add_monoidal + +/-- Constructs a `has_shift C A` instance from `shift_mk_core`. -/ +def has_shift_mk (h : shift_mk_core C A) : has_shift C A := +⟨ { ε := h.zero.inv, + μ := λ m n, (h.add m.as n.as).inv, + μ_natural' := by { rintros ⟨X⟩ ⟨Y⟩ ⟨X'⟩ ⟨Y'⟩ ⟨⟨⟨rfl⟩⟩⟩ ⟨⟨⟨rfl⟩⟩⟩, ext, + dsimp, simp only [discrete.functor_map_id, category.assoc], dsimp, simp }, + associativity' := + begin + rintros ⟨m₁⟩ ⟨m₂⟩ ⟨m₃⟩, + ext X, + dsimp, + simp [h.assoc_inv_app_assoc m₁ m₂ m₃ X], + end, + left_unitality' := + begin + rintro ⟨n⟩, + ext X, + dsimp, + simp only [h.zero_add_inv_app, ←functor.map_comp, category.id_comp, eq_to_hom_map, + eq_to_hom_app, category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id, + iso.inv_hom_id_app], + erw [functor.map_id], + end, + right_unitality' := + begin + rintro ⟨n⟩, + ext X, + dsimp, + simpa only [h.add_zero_inv_app, functor.map_id, category.comp_id, eq_to_hom_map, + eq_to_hom_app, category.assoc, eq_to_hom_trans, eq_to_hom_refl, iso.inv_hom_id_app], + end, + ..(discrete.functor h.F) }⟩ + +end + +section + +variables [has_shift C A] + +/-- The monoidal functor from `A` to `C ⥤ C` given a `has_shift` instance. -/ +def shift_monoidal_functor : monoidal_functor (discrete A) (C ⥤ C) := has_shift.shift + +variable {A} + +/-- The shift autoequivalence, moving objects and morphisms 'up'. -/ +def shift_functor (i : A) : C ⥤ C := (shift_monoidal_functor C A).obj ⟨i⟩ + +/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/ +def shift_functor_add (i j : A) : + shift_functor C (i + j) ≅ shift_functor C i ⋙ shift_functor C j := +((shift_monoidal_functor C A).μ_iso ⟨i⟩ ⟨j⟩).symm + +/-- When `k = i + j`, shifting by `k` is the same as shifting by `i` and then shifting by `j`. -/ +def shift_functor_add' (i j k : A) (h : i + j = k) : + shift_functor C k ≅ shift_functor C i ⋙ shift_functor C j := +eq_to_iso (by rw [h]) ≪≫ shift_functor_add C i j + +lemma shift_functor_add'_eq_shift_functor_add (i j : A) : + shift_functor_add' C i j (i+j) rfl = shift_functor_add C i j := +by { ext1, apply category.id_comp } + +variables (A) + +/-- Shifting by zero is the identity functor. -/ +def shift_functor_zero : shift_functor C (0 : A) ≅ 𝟭 C := +(shift_monoidal_functor C A).ε_iso.symm + +end + +variables {C A} + +lemma shift_mk_core.shift_functor_eq (h : shift_mk_core C A) (a : A) : + @shift_functor _ _ _ _ (has_shift_mk C A h) a = h.F a := +functor.ext (by tidy) (by tidy) + +lemma shift_mk_core.shift_functor_zero_eq (h : shift_mk_core C A) : + @shift_functor_zero _ _ _ _ (has_shift_mk C A h) = h.zero := +begin + letI := has_shift_mk C A h, + ext1, + suffices : (shift_functor_zero C A).inv = h.zero.inv, + { rw [← cancel_mono (h.zero.inv), h.zero.hom_inv_id, ← this, iso.hom_inv_id], + refl, }, + refl, +end + +lemma shift_mk_core.shift_functor_add_eq (h : shift_mk_core C A) (a b : A) : + @shift_functor_add _ _ _ _ (has_shift_mk C A h) a b = h.add a b := +begin + letI := has_shift_mk C A h, + ext1, + suffices : (shift_functor_add C a b).inv = (h.add a b).inv, + { rw [← cancel_mono ((h.add a b).inv), (h.add a b).hom_inv_id, ← this, iso.hom_inv_id], + refl, }, + refl, +end + +-- Any better notational suggestions? +notation X`⟦`n`⟧`:20 := (shift_functor _ n).obj X +notation f`⟦`n`⟧'`:80 := (shift_functor _ n).map f + +variable (C) + +variables [has_shift C A] + +local attribute [reducible] endofunctor_monoidal_category discrete.add_monoidal + +lemma shift_functor_add'_zero_add (a : A) : + shift_functor_add' C 0 a a (zero_add a) = (functor.left_unitor _).symm ≪≫ + iso_whisker_right (shift_functor_zero C A).symm (shift_functor C a) := +begin + ext X, + dsimp [shift_functor_add'], + erw [obj_ε_app], + simpa [eq_to_hom_map], +end + +lemma shift_functor_add'_add_zero (a : A) : + shift_functor_add' C a 0 a (add_zero a) = (functor.right_unitor _).symm ≪≫ + iso_whisker_left (shift_functor C a) (shift_functor_zero C A).symm := +begin + ext X, + dsimp [shift_functor_add'], + erw [ε_app_obj], + simpa [eq_to_hom_map], +end + +lemma shift_functor_add'_assoc (a₁ a₂ a₃ a₁₂ a₂₃ a₁₂₃ : A) + (h₁₂ : a₁ + a₂ = a₁₂) (h₂₃ : a₂ + a₃ = a₂₃) (h₁₂₃ : a₁ + a₂ + a₃ = a₁₂₃) : + shift_functor_add' C a₁₂ a₃ a₁₂₃ (by rw [← h₁₂, h₁₂₃]) ≪≫ + iso_whisker_right (shift_functor_add' C a₁ a₂ a₁₂ h₁₂) _ ≪≫ functor.associator _ _ _ = + shift_functor_add' C a₁ a₂₃ a₁₂₃ (by rw [← h₂₃, ← add_assoc, h₁₂₃]) ≪≫ + iso_whisker_left _ (shift_functor_add' C a₂ a₃ a₂₃ h₂₃) := +begin + substs h₁₂ h₂₃ h₁₂₃, + ext X, + dsimp, + simp only [shift_functor_add'_eq_shift_functor_add, category.comp_id], + dsimp [shift_functor_add', shift_functor_add, shift_functor], + simp [obj_μ_inv_app, eq_to_hom_map], +end + +lemma shift_functor_add_assoc (a₁ a₂ a₃ : A) : + shift_functor_add C (a₁ + a₂) a₃ ≪≫ + iso_whisker_right (shift_functor_add C a₁ a₂) _ ≪≫ functor.associator _ _ _ = + shift_functor_add' C a₁ (a₂ + a₃) _ (add_assoc a₁ a₂ a₃).symm ≪≫ + iso_whisker_left _ (shift_functor_add C a₂ a₃) := +begin + ext X, + simpa [shift_functor_add'_eq_shift_functor_add] + using nat_trans.congr_app (congr_arg iso.hom + (shift_functor_add'_assoc C a₁ a₂ a₃ _ _ _ rfl rfl rfl)) X, +end + +variable {C} + +lemma shift_functor_add'_zero_add_hom_app (a : A) (X : C) : + (shift_functor_add' C 0 a a (zero_add a)).hom.app X = + ((shift_functor_zero C A).inv.app X)⟦a⟧' := +by simpa using nat_trans.congr_app (congr_arg iso.hom (shift_functor_add'_zero_add C a)) X + +lemma shift_functor_add_zero_add_hom_app (a : A) (X : C) : + (shift_functor_add C 0 a).hom.app X = + eq_to_hom (by dsimp; rw [zero_add]) ≫ ((shift_functor_zero C A).inv.app X)⟦a⟧' := +begin + erw [← shift_functor_add'_zero_add_hom_app], + dsimp [shift_functor_add'], + simp, +end + +lemma shift_functor_add'_zero_add_inv_app (a : A) (X : C) : + (shift_functor_add' C 0 a a (zero_add a)).inv.app X = + ((shift_functor_zero C A).hom.app X)⟦a⟧' := +begin + have := nat_trans.congr_app (congr_arg iso.inv (shift_functor_add'_zero_add C a)) X, + simp only [iso.trans_inv, iso_whisker_right_inv, iso.symm_inv, nat_trans.comp_app, + whisker_right_app, functor.left_unitor_hom_app] at this, + dsimp at this, + simpa only [category.comp_id] using this, +end + +lemma shift_functor_add_zero_add_inv_app (a : A) (X : C) : + (shift_functor_add C 0 a).inv.app X = + ((shift_functor_zero C A).hom.app X)⟦a⟧' ≫ eq_to_hom (by dsimp; rw [zero_add]) := +begin + erw [← shift_functor_add'_zero_add_inv_app], + dsimp [shift_functor_add'], + simp, +end + +lemma shift_functor_add'_add_zero_hom_app (a : A) (X : C): + (shift_functor_add' C a 0 a (add_zero a)).hom.app X = + (shift_functor_zero C A).inv.app (X⟦a⟧) := +by simpa using nat_trans.congr_app (congr_arg iso.hom (shift_functor_add'_add_zero C a)) X + +lemma shift_functor_add_add_zero_hom_app (a : A) (X : C): + (shift_functor_add C a 0).hom.app X = + eq_to_hom (by dsimp; rw [add_zero]) ≫ (shift_functor_zero C A).inv.app (X⟦a⟧) := +begin + rw [← shift_functor_add'_add_zero_hom_app], + dsimp [shift_functor_add'], + simp, +end + +lemma shift_functor_add'_add_zero_inv_app (a : A) (X : C): + (shift_functor_add' C a 0 a (add_zero a)).inv.app X = + (shift_functor_zero C A).hom.app (X⟦a⟧) := +begin + have := nat_trans.congr_app (congr_arg iso.inv (shift_functor_add'_add_zero C a)) X, + simp only [iso.trans_inv, iso_whisker_left_inv, iso.symm_inv, nat_trans.comp_app, + whisker_left_app, functor.right_unitor_hom_app] at this, + dsimp at this, + simpa only [category.comp_id] using this, +end + +lemma shift_functor_add_add_zero_inv_app (a : A) (X : C): + (shift_functor_add C a 0).inv.app X = + (shift_functor_zero C A).hom.app (X⟦a⟧) ≫ eq_to_hom (by dsimp; rw [add_zero]) := +begin + rw [← shift_functor_add'_add_zero_inv_app], + dsimp [shift_functor_add'], + simp, +end + +@[reassoc] +lemma shift_functor_add'_assoc_hom_app (a₁ a₂ a₃ a₁₂ a₂₃ a₁₂₃ : A) + (h₁₂ : a₁ + a₂ = a₁₂) (h₂₃ : a₂ + a₃ = a₂₃) (h₁₂₃ : a₁ + a₂ + a₃ = a₁₂₃) (X : C) : + (shift_functor_add' C a₁₂ a₃ a₁₂₃ (by rw [← h₁₂, h₁₂₃])).hom.app X ≫ + ((shift_functor_add' C a₁ a₂ a₁₂ h₁₂).hom.app X)⟦a₃⟧' = + (shift_functor_add' C a₁ a₂₃ a₁₂₃ (by rw [← h₂₃, ← add_assoc, h₁₂₃])).hom.app X ≫ + (shift_functor_add' C a₂ a₃ a₂₃ h₂₃).hom.app (X⟦a₁⟧) := +by simpa using nat_trans.congr_app (congr_arg iso.hom + (shift_functor_add'_assoc C _ _ _ _ _ _ h₁₂ h₂₃ h₁₂₃)) X + +@[reassoc] +lemma shift_functor_add'_assoc_inv_app (a₁ a₂ a₃ a₁₂ a₂₃ a₁₂₃ : A) + (h₁₂ : a₁ + a₂ = a₁₂) (h₂₃ : a₂ + a₃ = a₂₃) (h₁₂₃ : a₁ + a₂ + a₃ = a₁₂₃) (X : C) : + ((shift_functor_add' C a₁ a₂ a₁₂ h₁₂).inv.app X)⟦a₃⟧' ≫ + (shift_functor_add' C a₁₂ a₃ a₁₂₃ (by rw [← h₁₂, h₁₂₃])).inv.app X = + (shift_functor_add' C a₂ a₃ a₂₃ h₂₃).inv.app (X⟦a₁⟧) ≫ + (shift_functor_add' C a₁ a₂₃ a₁₂₃ (by rw [← h₂₃, ← add_assoc, h₁₂₃])).inv.app X := +by simpa using nat_trans.congr_app (congr_arg iso.inv + (shift_functor_add'_assoc C _ _ _ _ _ _ h₁₂ h₂₃ h₁₂₃)) X + +@[reassoc] +lemma shift_functor_add_assoc_hom_app (a₁ a₂ a₃ : A) (X : C) : + (shift_functor_add C (a₁ + a₂) a₃).hom.app X ≫ + ((shift_functor_add C a₁ a₂).hom.app X)⟦a₃⟧' = + (shift_functor_add' C a₁ (a₂ + a₃) (a₁ + a₂ + a₃) (add_assoc _ _ _).symm).hom.app X ≫ + (shift_functor_add C a₂ a₃).hom.app (X⟦a₁⟧) := +by simpa using nat_trans.congr_app (congr_arg iso.hom + (shift_functor_add_assoc C a₁ a₂ a₃)) X + +@[reassoc] +lemma shift_functor_add_assoc_inv_app (a₁ a₂ a₃ : A) (X : C) : + ((shift_functor_add C a₁ a₂).inv.app X)⟦a₃⟧' ≫ + (shift_functor_add C (a₁ + a₂) a₃).inv.app X = + (shift_functor_add C a₂ a₃).inv.app (X⟦a₁⟧) ≫ + (shift_functor_add' C a₁ (a₂ + a₃) (a₁ + a₂ + a₃) (add_assoc _ _ _).symm).inv.app X := +by simpa using nat_trans.congr_app (congr_arg iso.inv + (shift_functor_add_assoc C a₁ a₂ a₃)) X + +end defs + +section add_monoid + +variables {C A} [add_monoid A] [has_shift C A] (X Y : C) (f : X ⟶ Y) + +@[simp] lemma has_shift.shift_obj_obj (n : A) (X : C) : (has_shift.shift.obj ⟨n⟩).obj X = X⟦n⟧ := +rfl + +/-- Shifting by `i + j` is the same as shifting by `i` and then shifting by `j`. -/ +abbreviation shift_add (i j : A) : X⟦i + j⟧ ≅ X⟦i⟧⟦j⟧ := (shift_functor_add C i j).app _ + +lemma shift_shift' (i j : A) : + f⟦i⟧'⟦j⟧' = (shift_add X i j).inv ≫ f⟦i + j⟧' ≫ (shift_add Y i j).hom := +by { symmetry, apply nat_iso.naturality_1 } + +variables (A) + +/-- Shifting by zero is the identity functor. -/ +abbreviation shift_zero : + X⟦0⟧ ≅ X := (shift_functor_zero C A).app _ + +lemma shift_zero' : + f⟦(0 : A)⟧' = (shift_zero A X).hom ≫ f ≫ (shift_zero A Y).inv := +by { symmetry, apply nat_iso.naturality_2 } + +variables (C) {A} + +/-- When `i + j = 0`, shifting by `i` and by `j` gives the identity functor -/ +def shift_functor_comp_iso_id (i j : A) (h : i + j = 0) : + shift_functor C i ⋙ shift_functor C j ≅ 𝟭 C := +(shift_functor_add' C i j 0 h).symm ≪≫ shift_functor_zero C A + +end add_monoid + +section add_group + +variables (C) {A} [add_group A] [has_shift C A] + +/-- shifting by `i` and shifting by `j` forms an equivalence when `i + j = 0`. -/ +@[simps] +def shift_equiv' (i j : A) (h : i + j = 0) : C ≌ C := +{ functor := shift_functor C i, + inverse := shift_functor C j, + unit_iso := (shift_functor_comp_iso_id C i j h).symm, + counit_iso := (shift_functor_comp_iso_id C j i + (by rw [← add_left_inj j, add_assoc, h, zero_add, add_zero])), + functor_unit_iso_comp' := λ X, begin + let E := equiv_of_tensor_iso_unit (shift_monoidal_functor C A) ⟨i⟩ ⟨j⟩ + (eq_to_iso (by ext; exact h)) + (eq_to_iso (by ext; dsimp; rw [← add_left_inj j, add_assoc, h, zero_add, add_zero])) + (subsingleton.elim _ _), + convert equivalence.functor_unit_iso_comp E X, + all_goals + { ext X, + dsimp [shift_functor_comp_iso_id, unit_of_tensor_iso_unit, shift_functor_add'], + simpa only [eq_to_hom_map, category.assoc], }, + end } + +/-- shifting by `n` and shifting by `-n` forms an equivalence. -/ +abbreviation shift_equiv (i : A) : C ≌ C := shift_equiv' C i (-i) (add_neg_self i) + +variables (X Y : C) (f : X ⟶ Y) + +/-- Shifting by `i` is an equivalence. -/ +instance (i : A) : is_equivalence (shift_functor C i) := +is_equivalence.of_equivalence (shift_equiv C i) + +@[simp] lemma shift_functor_inv (i : A) : + (shift_functor C i).inv = shift_functor C (-i) := +rfl + +section + +variables (C) + +/-- Shifting by `n` is an essentially surjective functor. -/ +instance shift_functor_ess_surj (i : A) : ess_surj (shift_functor C i) := + equivalence.ess_surj_of_equivalence _ + +end + +variables {C} + +/-- Shifting by `i` and then shifting by `-i` is the identity. -/ +abbreviation shift_shift_neg (i : A) : X⟦i⟧⟦-i⟧ ≅ X := +(shift_equiv C i).unit_iso.symm.app _ + +/-- Shifting by `-i` and then shifting by `i` is the identity. -/ +abbreviation shift_neg_shift (i : A) : X⟦-i⟧⟦i⟧ ≅ X := +(shift_equiv C i).counit_iso.app _ + +variables {X Y} + +lemma shift_shift_neg' (i : A) : + f⟦i⟧'⟦-i⟧' = (shift_functor_comp_iso_id C i (-i) (add_neg_self i)).hom.app X ≫ + f ≫ (shift_functor_comp_iso_id C i (-i) (add_neg_self i)).inv.app Y := +(nat_iso.naturality_2 (shift_functor_comp_iso_id C i (-i) (add_neg_self i)) f).symm + +lemma shift_neg_shift' (i : A) : + f⟦-i⟧'⟦i⟧' = (shift_functor_comp_iso_id C (-i) i (neg_add_self i)).hom.app X ≫ f ≫ + (shift_functor_comp_iso_id C (-i) i (neg_add_self i)).inv.app Y := +(nat_iso.naturality_2 (shift_functor_comp_iso_id C (-i) i (neg_add_self i)) f).symm + +lemma shift_equiv_triangle (n : A) (X : C) : + (shift_shift_neg X n).inv⟦n⟧' ≫ (shift_neg_shift (X⟦n⟧) n).hom = 𝟙 (X⟦n⟧) := +(shift_equiv C n).functor_unit_iso_comp X + +section + +lemma shift_shift_functor_comp_iso_id_hom_app (n m : A) (h : n + m = 0) (X : C) : + ((shift_functor_comp_iso_id C n m h).hom.app X)⟦n⟧' = + (shift_functor_comp_iso_id C m n + (by rw [← neg_eq_of_add_eq_zero_left h, add_right_neg])).hom.app (X⟦n⟧) := +begin + dsimp [shift_functor_comp_iso_id], + simpa only [functor.map_comp, ← shift_functor_add'_zero_add_inv_app n X, + ← shift_functor_add'_add_zero_inv_app n X ] + using shift_functor_add'_assoc_inv_app n m n 0 0 n h + (by rw [← neg_eq_of_add_eq_zero_left h, add_right_neg]) (by rw [h, zero_add]) X, +end + +lemma shift_shift_functor_comp_iso_id_inv_app (n m : A) (h : n + m = 0) (X : C) : + ((shift_functor_comp_iso_id C n m h).inv.app X)⟦n⟧' = + ((shift_functor_comp_iso_id C m n + (by rw [← neg_eq_of_add_eq_zero_left h, add_right_neg])).inv.app (X⟦n⟧)) := +begin + rw [← cancel_mono (((shift_functor_comp_iso_id C n m h).hom.app X)⟦n⟧'), + ← functor.map_comp, iso.inv_hom_id_app, functor.map_id, + shift_shift_functor_comp_iso_id_hom_app, iso.inv_hom_id_app], + refl, +end + +lemma shift_shift_functor_comp_iso_id_add_neg_self_hom_app (n : A) (X : C) : + ((shift_functor_comp_iso_id C n (-n) (add_neg_self n)).hom.app X)⟦n⟧' = + (shift_functor_comp_iso_id C (-n) n (neg_add_self n)).hom.app (X⟦n⟧) := +by apply shift_shift_functor_comp_iso_id_hom_app + +lemma shift_shift_functor_comp_iso_id_add_neg_self_inv_app (n : A) (X : C) : + ((shift_functor_comp_iso_id C n (-n) (add_neg_self n)).inv.app X)⟦n⟧' = + (shift_functor_comp_iso_id C (-n) n (neg_add_self n)).inv.app (X⟦n⟧) := +by apply shift_shift_functor_comp_iso_id_inv_app + +lemma shift_shift_functor_comp_iso_id_neg_add_self_hom_app (n : A) (X : C) : + ((shift_functor_comp_iso_id C (-n) n (neg_add_self n)).hom.app X)⟦-n⟧' = + (shift_functor_comp_iso_id C n (-n) (add_neg_self n)).hom.app (X⟦-n⟧) := +by apply shift_shift_functor_comp_iso_id_hom_app + +lemma shift_shift_functor_comp_iso_id_neg_add_self_inv_app (n : A) (X : C) : + ((shift_functor_comp_iso_id C (-n) n (neg_add_self n)).inv.app X)⟦-n⟧' = + (shift_functor_comp_iso_id C n (-n) (add_neg_self n)).inv.app (X⟦-n⟧) := +by apply shift_shift_functor_comp_iso_id_inv_app + +end + +variables {A C} + +open category_theory.limits + +variables [has_zero_morphisms C] + +lemma shift_zero_eq_zero (X Y : C) (n : A) : (0 : X ⟶ Y)⟦n⟧' = (0 : X⟦n⟧ ⟶ Y⟦n⟧) := +category_theory.functor.map_zero _ _ _ + +end add_group + +section add_comm_monoid + +variables (C) {A} [add_comm_monoid A] [has_shift C A] + +/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/ +def shift_functor_comm (i j : A) : + shift_functor C i ⋙ shift_functor C j ≅ + shift_functor C j ⋙ shift_functor C i := +(shift_functor_add C i j).symm ≪≫ shift_functor_add' C j i (i + j) (add_comm j i) + +lemma shift_functor_comm_eq (i j k : A) (h : i + j = k): + shift_functor_comm C i j = (shift_functor_add' C i j k h).symm ≪≫ + shift_functor_add' C j i k (by rw [add_comm j i, h]) := +begin + subst h, + rw [shift_functor_add'_eq_shift_functor_add], + refl, +end + +lemma shift_functor_comm_symm (i j : A) : + (shift_functor_comm C i j).symm = shift_functor_comm C j i := +begin + ext1, + dsimp, + simpa only [shift_functor_comm_eq C i j (i + j) rfl, + shift_functor_comm_eq C j i (i + j) (add_comm j i)], +end + +variables {C} (X Y : C) (f : X ⟶ Y) + +/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/ +abbreviation shift_comm (i j : A) : X⟦i⟧⟦j⟧ ≅ X⟦j⟧⟦i⟧ := + (shift_functor_comm C i j).app X + +@[simp] lemma shift_comm_symm (i j : A) : (shift_comm X i j).symm = shift_comm X j i := +begin + ext1, + exact nat_trans.congr_app (congr_arg iso.hom (shift_functor_comm_symm C i j)) X, +end + +variables {X Y} + +/-- When shifts are indexed by an additive commutative monoid, then shifts commute. -/ +lemma shift_comm' (i j : A) : + f⟦i⟧'⟦j⟧' = (shift_comm _ _ _).hom ≫ f⟦j⟧'⟦i⟧' ≫ (shift_comm _ _ _).hom := +begin + erw [← shift_comm_symm Y i j, ← ((shift_functor_comm C i j).hom.naturality_assoc f), + iso.hom_inv_id_app, category.comp_id], + refl, +end + +@[reassoc] lemma shift_comm_hom_comp (i j : A) : + (shift_comm X i j).hom ≫ f⟦j⟧'⟦i⟧' = f⟦i⟧'⟦j⟧' ≫ (shift_comm Y i j).hom := +by rw [shift_comm', ← shift_comm_symm, iso.symm_hom, iso.inv_hom_id_assoc] + +lemma shift_functor_zero_hom_app_shift (n : A) : + (shift_functor_zero C A).hom.app (X⟦n⟧) = + (shift_functor_comm C n 0).hom.app X ≫ ((shift_functor_zero C A).hom.app X)⟦n⟧' := +begin + rw [← shift_functor_add'_zero_add_inv_app n X, shift_functor_comm_eq C n 0 n (add_zero n)], + dsimp, + rw [category.assoc, iso.hom_inv_id_app, category.comp_id, shift_functor_add'_add_zero_inv_app], +end + +lemma shift_functor_zero_inv_app_shift (n : A) : + (shift_functor_zero C A).inv.app (X⟦n⟧) = + ((shift_functor_zero C A).inv.app X)⟦n⟧' ≫ (shift_functor_comm C n 0).inv.app X := +begin + rw [← cancel_mono ((shift_functor_zero C A).hom.app (X⟦n⟧)), category.assoc, iso.inv_hom_id_app, + shift_functor_zero_hom_app_shift, iso.inv_hom_id_app_assoc, ← functor.map_comp, + iso.inv_hom_id_app], + dsimp, + rw [functor.map_id], +end + +@[reassoc] +lemma shift_functor_comm_hom_app_comp_shift_shift_functor_add_hom_app (m₁ m₂ m₃ : A) (X : C) : + (shift_functor_comm C m₁ (m₂ + m₃)).hom.app X ≫ + ((shift_functor_add C m₂ m₃).hom.app X)⟦m₁⟧' = + (shift_functor_add C m₂ m₃).hom.app (X⟦m₁⟧) ≫ + ((shift_functor_comm C m₁ m₂).hom.app X)⟦m₃⟧' ≫ + (shift_functor_comm C m₁ m₃).hom.app (X⟦m₂⟧) := +begin + simp only [← cancel_mono ((shift_functor_comm C m₁ m₃).inv.app (X⟦m₂⟧)), + ← cancel_mono (((shift_functor_comm C m₁ m₂).inv.app X)⟦m₃⟧'), + category.assoc, iso.hom_inv_id_app], + dsimp, + simp only [category.id_comp, ← functor.map_comp, iso.hom_inv_id_app], + dsimp, + simp only [functor.map_id, category.comp_id, + shift_functor_comm_eq C _ _ _ rfl, ← shift_functor_add'_eq_shift_functor_add], + dsimp, + simp only [category.assoc, iso.hom_inv_id_app_assoc, iso.inv_hom_id_app_assoc, + ← functor.map_comp, + shift_functor_add'_assoc_hom_app_assoc m₂ m₃ m₁ (m₂ + m₃) (m₁ + m₃) (m₁ + (m₂ + m₃)) rfl + (add_comm m₃ m₁) (add_comm _ m₁) X, + ← shift_functor_add'_assoc_hom_app_assoc m₂ m₁ m₃ (m₁ + m₂) (m₁ + m₃) + (m₁ + (m₂ + m₃)) (add_comm _ _) rfl (by rw [add_comm m₂ m₁, add_assoc]) X, + shift_functor_add'_assoc_hom_app m₁ m₂ m₃ + (m₁ + m₂) (m₂ + m₃) (m₁ + (m₂ + m₃)) rfl rfl (add_assoc _ _ _) X], +end + +end add_comm_monoid + +variables {C A} {D : Type*} [category D] [add_monoid A] [has_shift D A] +variables (F : C ⥤ D) [full F] [faithful F] + +section + +variables (s : A → C ⥤ C) (i : ∀ i, s i ⋙ F ≅ F ⋙ shift_functor D i) + +include F s i + +/-- auxiliary definition for `has_shift_of_fully_faithful` -/ +def has_shift_of_fully_faithful_zero : s 0 ≅ 𝟭 C := +nat_iso_of_comp_fully_faithful F ((i 0) ≪≫ iso_whisker_left F (shift_functor_zero D A) ≪≫ + functor.right_unitor _ ≪≫ (functor.left_unitor _).symm) + +@[simp] +lemma map_has_shift_of_fully_faithful_zero_hom_app (X : C) : + F.map ((has_shift_of_fully_faithful_zero F s i).hom.app X) = + (i 0).hom.app X ≫ (shift_functor_zero D A).hom.app (F.obj X) := +by { dsimp [has_shift_of_fully_faithful_zero], simp, } + +@[simp] +lemma map_has_shift_of_fully_faithful_zero_inv_app (X : C) : +F.map ((has_shift_of_fully_faithful_zero F s i).inv.app X) = + (shift_functor_zero D A).inv.app (F.obj X) ≫ (i 0).inv.app X := +by { dsimp [has_shift_of_fully_faithful_zero], simp, } + +/-- auxiliary definition for `has_shift_of_fully_faithful` -/ +def has_shift_of_fully_faithful_add (a b : A) : s (a + b) ≅ s a ⋙ s b := +nat_iso_of_comp_fully_faithful F (i (a + b) ≪≫ + iso_whisker_left _ (shift_functor_add D a b) ≪≫ + (functor.associator _ _ _).symm ≪≫ (iso_whisker_right (i a).symm _) ≪≫ + functor.associator _ _ _ ≪≫ (iso_whisker_left _ (i b).symm) ≪≫ + (functor.associator _ _ _).symm) + +@[simp] +lemma map_has_shift_of_fully_faithful_add_hom_app (a b : A) (X : C) : + F.map ((has_shift_of_fully_faithful_add F s i a b).hom.app X) = + (i (a + b)).hom.app X ≫ (shift_functor_add D a b).hom.app (F.obj X) ≫ + ((i a).inv.app X)⟦b⟧' ≫ (i b).inv.app ((s a).obj X) := +by { dsimp [has_shift_of_fully_faithful_add], simp, } + +@[simp] +lemma map_has_shift_of_fully_faithful_add_inv_app (a b : A) (X : C) : + F.map ((has_shift_of_fully_faithful_add F s i a b).inv.app X) = + (i b).hom.app ((s a).obj X) ≫ ((i a).hom.app X)⟦b⟧' ≫ + (shift_functor_add D a b).inv.app (F.obj X) ≫ (i (a + b)).inv.app X := +by { dsimp [has_shift_of_fully_faithful_add], simp, } + +/-- Given a family of endomorphisms of `C` which are interwined by a fully faithful `F : C ⥤ D` +with shift functors on `D`, we can promote that family to shift functors on `C`. -/ +def has_shift_of_fully_faithful : has_shift C A := has_shift_mk C A + { F := s, + zero := has_shift_of_fully_faithful_zero F s i, + add := has_shift_of_fully_faithful_add F s i, + assoc_hom_app := λ m₁ m₂ m₃ X, F.map_injective begin + rw [← cancel_mono ((i m₃).hom.app ((s m₂).obj ((s m₁).obj X)))], + simp only [functor.map_comp, map_has_shift_of_fully_faithful_add_hom_app, category.assoc, + iso.inv_hom_id_app_assoc, iso.inv_hom_id_app], + erw [(i m₃).hom.naturality], + have := dcongr_arg (λ a, (i a).hom.app X) (add_assoc m₁ m₂ m₃), + dsimp at this, + dsimp, + rw [iso.inv_hom_id_app_assoc, map_has_shift_of_fully_faithful_add_hom_app, this, + eq_to_hom_map, category.comp_id, ← functor.map_comp, category.assoc, + iso.inv_hom_id_app_assoc, functor.map_comp, functor.map_comp, + shift_functor_add_assoc_hom_app_assoc m₁ m₂ m₃ (F.obj X)], + dsimp [shift_functor_add'], + simp only [eq_to_hom_app, category.assoc, eq_to_hom_trans_assoc, eq_to_hom_refl, + category.id_comp, nat_trans.naturality_assoc, functor.comp_map], + end, + zero_add_hom_app := λ n X, F.map_injective begin + have this := dcongr_arg (λ a, (i a).hom.app X) (zero_add n), + dsimp at this, + rw [← cancel_mono ((i n).hom.app ((s 0).obj X))], + simp only [this, map_has_shift_of_fully_faithful_add_hom_app, + shift_functor_add_zero_add_hom_app, eq_to_hom_map, category.assoc, + eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp, iso.inv_hom_id_app, + functor.map_comp], + erw [(i n).hom.naturality], + dsimp, + simp, + end, + add_zero_hom_app := λ n X, F.map_injective begin + have := dcongr_arg (λ a, (i a).hom.app X) (add_zero n), + dsimp at this, + simpa [this, ← nat_trans.naturality_assoc, eq_to_hom_map, + shift_functor_add_add_zero_hom_app], + end, } + +end + +end category_theory diff --git a/src/category_theory/sigma/basic.lean b/src/category_theory/sigma/basic.lean index e13edad051dbb..24e2fdd2b5c91 100644 --- a/src/category_theory/sigma/basic.lean +++ b/src/category_theory/sigma/basic.lean @@ -6,11 +6,13 @@ Authors: Bhavik Mehta import category_theory.whiskering import category_theory.functor.fully_faithful import category_theory.natural_isomorphism -import data.sigma.basic /-! # Disjoint union of categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the category structure on a sigma-type (disjoint union) of categories. -/ @@ -89,7 +91,7 @@ each subcategory. -/ def nat_trans {F G : (Σ i, C i) ⥤ D} (h : Π (i : I), incl i ⋙ F ⟶ incl i ⋙ G) : F ⟶ G := { app := λ ⟨j, X⟩, (h j).app X, - naturality' := by { rintro ⟨j, X⟩ ⟨_, _⟩ ⟨_, _, Y, f⟩, apply (h j).naturality } } + naturality' := by { rintro ⟨j, X⟩ ⟨_, _⟩ ⟨f⟩, apply (h j).naturality } } @[simp] lemma nat_trans_app {F G : (Σ i, C i) ⥤ D} (h : Π (i : I), incl i ⋙ F ⟶ incl i ⋙ G) @@ -115,7 +117,7 @@ def desc : (Σ i, C i) ⥤ D := { obj := λ X, (F X.1).obj X.2, map := λ X Y g, desc_map F X Y g, map_id' := by { rintro ⟨i, X⟩, apply (F i).map_id }, - map_comp' := by { rintro ⟨i, X⟩ ⟨_, Y⟩ ⟨_, Z⟩ ⟨i, _, Y, f⟩ ⟨_, _, Z, g⟩, apply (F i).map_comp } } + map_comp' := by { rintro ⟨i, X⟩ ⟨_, Y⟩ ⟨_, Z⟩ ⟨f⟩ ⟨g⟩, apply (F i).map_comp } } @[simp] lemma desc_map_mk {i : I} (X Y : C i) (f : X ⟶ Y) : @@ -146,7 +148,7 @@ If `q` when restricted to each subcategory `C i` agrees with `F i`, then `q` is -/ def desc_uniq (q : (Σ i, C i) ⥤ D) (h : Π i, incl i ⋙ q ≅ F i) : q ≅ desc F := nat_iso.of_components (λ ⟨i, X⟩, (h i).app X) $ - by { rintro ⟨i, X⟩ ⟨_, _⟩ ⟨_, _, Y, f⟩, apply (h i).hom.naturality f } + by { rintro ⟨i, X⟩ ⟨_, _⟩ ⟨f⟩, apply (h i).hom.naturality f } @[simp] lemma desc_uniq_hom_app (q : (Σ i, C i) ⥤ D) (h : Π i, incl i ⋙ q ≅ F i) (i : I) (X : C i) : @@ -231,7 +233,7 @@ def sigma (α : Π i, F i ⟶ G i) : functor.sigma F ⟶ functor.sigma G := { app := λ f, sigma_hom.mk ((α f.1).app _), naturality' := begin - rintro ⟨i, X⟩ ⟨_, _⟩ ⟨_, _, Y, f⟩, + rintro ⟨i, X⟩ ⟨_, _⟩ ⟨f⟩, change sigma_hom.mk _ = sigma_hom.mk _, rw (α i).naturality, end } diff --git a/src/category_theory/simple.lean b/src/category_theory/simple.lean index bbca168d6d05f..1b6d2ee0c5cb5 100644 --- a/src/category_theory/simple.lean +++ b/src/category_theory/simple.lean @@ -12,6 +12,9 @@ import order.atoms /-! # Simple objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define simple objects in any category with zero morphisms. A simple object is an object `Y` such that any monomorphism `f : X ⟶ Y` is either an isomorphism or zero (but not both). @@ -71,6 +74,9 @@ lemma simple.of_iso {X Y : C} [simple Y] (i : X ≅ Y) : simple X := apply_instance, }, end } +lemma simple.iff_of_iso {X Y : C} (i : X ≅ Y) : simple X ↔ simple Y := +⟨λ h, by exactI simple.of_iso i.symm, λ h, by exactI simple.of_iso i⟩ + lemma kernel_zero_of_nonzero_from_simple {X Y : C} [simple X] {f : X ⟶ Y} [has_kernel f] (w : f ≠ 0) : kernel.ι f = 0 := @@ -190,8 +196,9 @@ begin rw [biprod.is_iso_inl_iff_id_eq_fst_comp_inl, ←biprod.total, add_right_eq_self], split, { intro h, replace h := h =≫ biprod.snd, - simpa [←is_zero.iff_split_epi_eq_zero (biprod.snd : X ⊞ Y ⟶ Y)] using h, }, - { intro h, rw is_zero.iff_split_epi_eq_zero (biprod.snd : X ⊞ Y ⟶ Y) at h, rw [h, zero_comp], }, + simpa [←is_zero.iff_is_split_epi_eq_zero (biprod.snd : X ⊞ Y ⟶ Y)] using h, }, + { intro h, rw is_zero.iff_is_split_epi_eq_zero (biprod.snd : X ⊞ Y ⟶ Y) at h, + rw [h, zero_comp], }, end /-- Any simple object in a preadditive category is indecomposable. -/ @@ -199,7 +206,7 @@ lemma indecomposable_of_simple (X : C) [simple X] : indecomposable X := ⟨simple.not_is_zero X, λ Y Z i, begin refine or_iff_not_imp_left.mpr (λ h, _), - rw is_zero.iff_split_mono_eq_zero (biprod.inl : Y ⟶ Y ⊞ Z) at h, + rw is_zero.iff_is_split_mono_eq_zero (biprod.inl : Y ⟶ Y ⊞ Z) at h, change biprod.inl ≠ 0 at h, rw ←(simple.mono_is_iso_iff_nonzero biprod.inl) at h, { rwa biprod.is_iso_inl_iff_is_zero at h, }, @@ -216,14 +223,11 @@ open_locale zero_object open subobject instance {X : C} [simple X] : nontrivial (subobject X) := -⟨⟨mk (0 : 0 ⟶ X), mk (𝟙 X), λ h, begin - haveI := simple.of_iso (iso_of_mk_eq_mk _ _ h), - exact zero_not_simple C, -end⟩⟩ +nontrivial_of_not_is_zero (simple.not_is_zero X) instance {X : C} [simple X] : is_simple_order (subobject X) := { eq_bot_or_eq_top := begin - rintro ⟨⟨⟨(Y : C), ⟨⟩, (f : Y ⟶ X)⟩, (m : mono f)⟩⟩, resetI, + rintro ⟨⟨⟨(Y : C), ⟨⟨⟩⟩, (f : Y ⟶ X)⟩, (m : mono f)⟩⟩, resetI, change mk f = ⊥ ∨ mk f = ⊤, by_cases h : f = 0, { exact or.inl (mk_eq_bot_iff_zero.mpr h), }, @@ -251,6 +255,12 @@ lemma simple_iff_subobject_is_simple_order (X : C) : simple X ↔ is_simple_orde ⟨by { introI h, apply_instance, }, by { introI h, exact simple_of_is_simple_order_subobject X, }⟩ +/-- A subobject is simple iff it is an atom in the subobject lattice. -/ +lemma subobject_simple_iff_is_atom {X : C} (Y : subobject X) : simple (Y : C) ↔ is_atom Y := +(simple_iff_subobject_is_simple_order _).trans + ((order_iso.is_simple_order_iff (subobject_order_iso Y)).trans + set.is_simple_order_Iic_iff_is_atom) + end subobject end category_theory diff --git a/src/category_theory/single_obj.lean b/src/category_theory/single_obj.lean index 033642514465a..43eaf45676791 100644 --- a/src/category_theory/single_obj.lean +++ b/src/category_theory/single_obj.lean @@ -6,10 +6,14 @@ Authors: Yury Kudryashov import category_theory.endomorphism import category_theory.category.Cat import algebra.category.Mon.basic +import combinatorics.quiver.single_obj /-! # Single-object category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Single object category with a given monoid of endomorphisms. It is defined to facilitate transfering some definitions and lemmas (e.g., conjugacy etc.) from category theory to monoids and groups. @@ -37,9 +41,11 @@ An element `x : α` can be reinterpreted as an element of `End (single_obj.star universes u v w namespace category_theory -/-- Type tag on `unit` used to define single-object categories and groupoids. -/ -@[nolint unused_arguments has_inhabited_instance] -def single_obj (α : Type u) : Type := unit + +/-- +Abbreviation that allows writing `category_theory.single_obj` rather than `quiver.single_obj`. +-/ +abbreviation single_obj := quiver.single_obj namespace single_obj @@ -75,8 +81,11 @@ instance groupoid [group α] : groupoid (single_obj α) := lemma inv_as_inv [group α] {x y : single_obj α} (f : x ⟶ y) : inv f = f⁻¹ := by { ext, rw [comp_as_mul, inv_mul_self, id_as_one] } -/-- The single object in `single_obj α`. -/ -protected def star : single_obj α := unit.star +/-- +Abbreviation that allows writing `category_theory.single_obj.star` rather than +`quiver.single_obj.star`. +-/ +abbreviation star : single_obj α := quiver.single_obj.star α /-- The endomorphisms monoid of the only object in `single_obj α` is equivalent to the original monoid α. -/ diff --git a/src/category_theory/sites/adjunction.lean b/src/category_theory/sites/adjunction.lean index 4587bcca61a9f..d560f26d1e707 100644 --- a/src/category_theory/sites/adjunction.lean +++ b/src/category_theory/sites/adjunction.lean @@ -3,10 +3,14 @@ Copyright (c) 2021 Adam Topaz. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Adam Topaz -/ -import category_theory.sites.compatible_sheafification import category_theory.adjunction.whiskering +import category_theory.sites.sheafification +import category_theory.sites.whiskering /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we show that an adjunction `F ⊣ G` induces an adjunction between categories of sheaves, under certain hypotheses on `F` and `G`. @@ -98,7 +102,7 @@ abbreviation compose_and_sheafify_from_types (G : Type (max v u) ⥤ D) : is the forgetful functor to sheaves of types. -/ def adjunction_to_types {G : Type (max v u) ⥤ D} (adj : G ⊣ forget D) : compose_and_sheafify_from_types J G ⊣ Sheaf_forget J := -adjunction.comp _ _ ((Sheaf_equiv_SheafOfTypes J).symm.to_adjunction) (adjunction J adj) +((Sheaf_equiv_SheafOfTypes J).symm.to_adjunction).comp (adjunction J adj) @[simp] lemma adjunction_to_types_unit_app_val {G : Type (max v u) ⥤ D} (adj : G ⊣ forget D) diff --git a/src/category_theory/sites/canonical.lean b/src/category_theory/sites/canonical.lean index cd8ea2aa40f57..f92fdc076e0f1 100644 --- a/src/category_theory/sites/canonical.lean +++ b/src/category_theory/sites/canonical.lean @@ -10,6 +10,9 @@ import category_theory.sites.sheaf_of_types /-! # The canonical topology on a category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the finest (largest) Grothendieck topology for which a given presheaf `P` is a sheaf. This is well defined since if `P` is a sheaf for a topology `J`, then it is a sheaf for any coarser (smaller) topology. Nonetheless we define the topology explicitly by specifying its sieves: diff --git a/src/category_theory/sites/closed.lean b/src/category_theory/sites/closed.lean index 2a3ef6114eee2..a2cf4f46df1f3 100644 --- a/src/category_theory/sites/closed.lean +++ b/src/category_theory/sites/closed.lean @@ -9,6 +9,9 @@ import order.closure /-! # Closed sieves +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A natural closure operator on sieves is a closure operator on `sieve X` for each `X` which commutes with pullback. We show that a Grothendieck topology `J` induces a natural closure operator, and define what the diff --git a/src/category_theory/sites/compatible_plus.lean b/src/category_theory/sites/compatible_plus.lean index 3e654c5ccbef9..75a5242fe1bf1 100644 --- a/src/category_theory/sites/compatible_plus.lean +++ b/src/category_theory/sites/compatible_plus.lean @@ -3,10 +3,13 @@ Copyright (c) 2021 Adam Topaz. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Adam Topaz -/ -import category_theory.sites.sheafification import category_theory.sites.whiskering +import category_theory.sites.plus /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove that the plus functor is compatible with functors which preserve the correct limits and colimits. @@ -116,11 +119,17 @@ lemma ι_plus_comp_iso_hom (X) (W) : F.map (colimit.ι _ W) ≫ (J.plus_comp_iso (J.diagram_comp_iso F P X.unop).hom.app W ≫ colimit.ι _ W := begin delta diagram_comp_iso plus_comp_iso, - dsimp [is_colimit.cocone_point_unique_up_to_iso], - simp only [← category.assoc], + simp only [is_colimit.desc_cocone_morphism_hom, is_colimit.unique_up_to_iso_hom, + cocones.forget_map, iso.trans_hom, nat_iso.of_components_hom_app, functor.map_iso_hom, + ← category.assoc], erw (is_colimit_of_preserves F (colimit.is_colimit (J.diagram P (unop X)))).fac, - dsimp, - simp, + simp only [category.assoc, has_limit.iso_of_nat_iso_hom_π, iso.symm_hom, + cover.multicospan_comp_hom_inv_left, eq_to_hom_refl, category.comp_id, + limit.cone_point_unique_up_to_iso_hom_comp, functor.map_cone_π_app, + multiequalizer.multifork_π_app_left, multiequalizer.lift_ι, functor.map_comp, eq_self_iff_true, + category.assoc, iso.trans_hom, iso.cancel_iso_hom_left, nat_iso.of_components_hom_app, + colimit.cocone_ι, category.assoc, has_colimit.iso_of_nat_iso_ι_hom], + end @[simp, reassoc] diff --git a/src/category_theory/sites/compatible_sheafification.lean b/src/category_theory/sites/compatible_sheafification.lean index d6774e097c3e1..23051dd93fe7d 100644 --- a/src/category_theory/sites/compatible_sheafification.lean +++ b/src/category_theory/sites/compatible_sheafification.lean @@ -4,8 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Adam Topaz -/ import category_theory.sites.compatible_plus +import category_theory.sites.sheafification /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we prove that sheafification is compatible with functors which preserve the correct limits and colimits. diff --git a/src/category_theory/sites/cover_lifting.lean b/src/category_theory/sites/cover_lifting.lean index 6e3eb8f840867..e395e67985e3d 100644 --- a/src/category_theory/sites/cover_lifting.lean +++ b/src/category_theory/sites/cover_lifting.lean @@ -10,6 +10,9 @@ import category_theory.sites.cover_preserving /-! # Cover-lifting functors between sites. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define cover-lifting functors between sites as functors that pull covering sieves back to covering sieves. This concept is also known as *cocontinuous functors* or *cover-reflecting functors*, but we have chosen this name following [MM92] in order to avoid @@ -60,7 +63,7 @@ variables {L : grothendieck_topology E} A functor `G : (C, J) ⥤ (D, K)` between sites is called to have the cover-lifting property if for all covering sieves `R` in `D`, `R.pullback G` is a covering sieve in `C`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure cover_lifting (G : C ⥤ D) : Prop := (cover_lift : ∀ {U : C} {S : sieve (G.obj U)} (hS : S ∈ K (G.obj U)), S.functor_pullback G ∈ J U) diff --git a/src/category_theory/sites/cover_preserving.lean b/src/category_theory/sites/cover_preserving.lean index 0d0eb57677afd..fbfe8d21710ba 100644 --- a/src/category_theory/sites/cover_preserving.lean +++ b/src/category_theory/sites/cover_preserving.lean @@ -3,14 +3,16 @@ Copyright (c) 2021 Andrew Yang. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Andrew Yang -/ -import category_theory.sites.limits import category_theory.functor.flat -import category_theory.limits.preserves.filtered -import category_theory.sites.left_exact +import category_theory.sites.sheaf +import tactic.apply_fun /-! # Cover-preserving functors between sites. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define cover-preserving functors between sites as functors that push covering sieves to covering sieves. A cover-preserving and compatible-preserving functor `G : C ⥤ D` then pulls sheaves on `D` back to sheaves on `C` via `G.op ⋙ -`. @@ -25,10 +27,6 @@ if it pushes compatible families of elements to compatible families. compatible-preserving functor. * `category_theory.sites.pullback`: the induced functor `Sheaf K A ⥤ Sheaf J A` for a cover-preserving and compatible-preserving functor `G : (C, J) ⥤ (D, K)`. -* `category_theory.sites.pushforward`: the induced functor `Sheaf J A ⥤ Sheaf K A` for a -cover-preserving and compatible-preserving functor `G : (C, J) ⥤ (D, K)`. -* `category_theory.sites.pushforward`: the induced functor `Sheaf J A ⥤ Sheaf K A` for a -cover-preserving and compatible-preserving functor `G : (C, J) ⥤ (D, K)`. ## Main results @@ -62,7 +60,7 @@ variables {L : grothendieck_topology A} A functor `G : (C, J) ⥤ (D, K)` between sites is *cover-preserving* if for all covering sieves `R` in `C`, `R.pushforward_functor G` is a covering sieve in `D`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure cover_preserving (G : C ⥤ D) : Prop := (cover_preserve : ∀ {U : C} {S : sieve U} (hS : S ∈ J U), S.functor_pushforward G ∈ K (G.obj U)) @@ -86,7 +84,7 @@ compatible family of elements at `C` and valued in `G.op ⋙ ℱ`, and each comm This is actually stronger than merely preserving compatible families because of the definition of `functor_pushforward` used. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure compatible_preserving (K : grothendieck_topology D) (G : C ⥤ D) : Prop := (compatible : ∀ (ℱ : SheafOfTypes.{w} K) {Z} {T : presieve Z} @@ -162,6 +160,18 @@ begin exact hx (c'.π.app left).right (c'.π.app right).right hg₁ hg₂ (e₁.symm.trans e₂) end +lemma compatible_preserving_of_downwards_closed (F : C ⥤ D) [full F] [faithful F] + (hF : Π {c : C} {d : D} (f : d ⟶ F.obj c), Σ c', F.obj c' ≅ d) : compatible_preserving K F := +begin + constructor, + introv hx he, + obtain ⟨X', e⟩ := hF f₁, + apply (ℱ.1.map_iso e.op).to_equiv.injective, + simp only [iso.op_hom, iso.to_equiv_fun, ℱ.1.map_iso_hom, ← functor_to_types.map_comp_apply], + simpa using hx (F.preimage $ e.hom ≫ f₁) (F.preimage $ e.hom ≫ f₂) hg₁ hg₂ + (F.map_injective $ by simpa using he), +end + /-- If `G` is cover-preserving and compatible-preserving, then `G.op ⋙ _` pulls sheaves back to sheaves. @@ -212,48 +222,3 @@ if `G` is cover-preserving and compatible-preserving. map_comp' := λ _ _ _ f g, by { ext1, apply (((whiskering_left _ _ _).obj G.op)).map_comp } } end category_theory - -namespace category_theory - -variables {C : Type v₁} [small_category C] {D : Type v₁} [small_category D] -variables (A : Type u₂) [category.{v₁} A] -variables (J : grothendieck_topology C) (K : grothendieck_topology D) - -instance [has_limits A] : creates_limits (Sheaf_to_presheaf J A) := -category_theory.Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{u₂ v₁ v₁} - --- The assumptions so that we have sheafification -variables [concrete_category.{v₁} A] [preserves_limits (forget A)] [has_colimits A] [has_limits A] -variables [preserves_filtered_colimits (forget A)] [reflects_isomorphisms (forget A)] - -local attribute [instance] reflects_limits_of_reflects_isomorphisms - -instance {X : C} : is_cofiltered (J.cover X) := infer_instance - -/-- The pushforward functor `Sheaf J A ⥤ Sheaf K A` associated to a functor `G : C ⥤ D` in the -same direction as `G`. -/ -@[simps] def sites.pushforward (G : C ⥤ D) : Sheaf J A ⥤ Sheaf K A := -Sheaf_to_presheaf J A ⋙ Lan G.op ⋙ presheaf_to_Sheaf K A - -instance (G : C ⥤ D) [representably_flat G] : - preserves_finite_limits (sites.pushforward A J K G) := -begin - apply_with comp_preserves_finite_limits { instances := ff }, - { apply_instance }, - apply_with comp_preserves_finite_limits { instances := ff }, - { apply category_theory.Lan_preserves_finite_limits_of_flat }, - { apply category_theory.presheaf_to_Sheaf.limits.preserves_finite_limits.{u₂ v₁ v₁}, - apply_instance } -end - -/-- The pushforward functor is left adjoint to the pullback functor. -/ -def sites.pullback_pushforward_adjunction {G : C ⥤ D} (hG₁ : compatible_preserving K G) - (hG₂ : cover_preserving J K G) : sites.pushforward A J K G ⊣ sites.pullback A hG₁ hG₂ := -((Lan.adjunction A G.op).comp _ _ (sheafification_adjunction K A)).restrict_fully_faithful - (Sheaf_to_presheaf J A) (𝟭 _) - (nat_iso.of_components (λ _, iso.refl _) - (λ _ _ _,(category.comp_id _).trans (category.id_comp _).symm)) - (nat_iso.of_components (λ _, iso.refl _) - (λ _ _ _,(category.comp_id _).trans (category.id_comp _).symm)) - -end category_theory diff --git a/src/category_theory/sites/dense_subsite.lean b/src/category_theory/sites/dense_subsite.lean index d7498c315fffa..8a2498b39b159 100644 --- a/src/category_theory/sites/dense_subsite.lean +++ b/src/category_theory/sites/dense_subsite.lean @@ -10,6 +10,9 @@ import category_theory.adjunction.fully_faithful /-! # Dense subsites +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `cover_dense` functors into sites as functors such that there exists a covering sieve that factors through images of the functor for each object in `D`. @@ -51,7 +54,7 @@ variables {L : grothendieck_topology E} /-- An auxiliary structure that witnesses the fact that `f` factors through an image object of `G`. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure presieve.cover_by_image_structure (G : C ⥤ D) {V U : D} (f : V ⟶ U) := (obj : C) (lift : V ⟶ G.obj obj) @@ -141,7 +144,6 @@ lemma sheaf_eq_amalgamation (ℱ : Sheaf K A) {X : A} {U : D} {T : sieve U} (hT) t = (ℱ.cond X T hT).amalgamate x hx := (ℱ.cond X T hT).is_separated_for x t _ h ((ℱ.cond X T hT).is_amalgamation hx) -include H variable [full G] namespace types variables {ℱ : Dᵒᵖ ⥤ Type v} {ℱ' : SheafOfTypes.{v} K} (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) @@ -154,9 +156,11 @@ def pushforward_family {X} (x : ℱ.obj (op X)) : family_of_elements ℱ'.val (cover_by_image G X) := λ Y f hf, ℱ'.val.map hf.some.lift.op $ α.app (op _) (ℱ.map hf.some.map.op x : _) +include H + /-- (Implementation). The `pushforward_family` defined is compatible. -/ lemma pushforward_family_compatible {X} (x : ℱ.obj (op X)) : - (pushforward_family H α x).compatible := + (pushforward_family α x).compatible := begin intros Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ e, apply H.ext, @@ -175,15 +179,17 @@ begin simp [e] end +omit H + /-- (Implementation). The morphism `ℱ(X) ⟶ ℱ'(X)` given by gluing the `pushforward_family`. -/ noncomputable def app_hom (X : D) : ℱ.obj (op X) ⟶ ℱ'.val.obj (op X) := λ x, (ℱ'.cond _ (H.is_cover X)).amalgamate - (pushforward_family H α x) + (pushforward_family α x) (pushforward_family_compatible H α x) @[simp] lemma pushforward_family_apply {X} (x : ℱ.obj (op X)) {Y : C} (f : G.obj Y ⟶ X) : - pushforward_family H α x f (presieve.in_cover_by_image G f) = α.app (op Y) (ℱ.map f.op x) := + pushforward_family α x f (presieve.in_cover_by_image G f) = α.app (op Y) (ℱ.map f.op x) := begin unfold pushforward_family, refine congr_fun _ x, @@ -283,6 +289,7 @@ def sheaf_coyoneda_hom (α : G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) : simp end } +include H /-- (Implementation). `sheaf_coyoneda_hom` but the order of the arguments of the functor are swapped. -/ @@ -300,6 +307,8 @@ begin exact congr_fun ((α.app X).naturality i) x }, end +omit H + /-- Given an natural transformation `G ⋙ ℱ ⟶ G ⋙ ℱ'` between presheaves of arbitrary category, where `G` is full and cover-dense, and `ℱ'` is a sheaf, we may obtain a natural transformation @@ -312,6 +321,7 @@ let α' := sheaf_yoneda_hom H α in { app := λ X, yoneda.preimage (α'.app X), naturality' := λ X Y f, yoneda.map_injective (by simpa using α'.naturality f) } +include H /-- Given an natural isomorphism `G ⋙ ℱ ≅ G ⋙ ℱ'` between presheaves of arbitrary category, where `G` is full and cover-dense, and `ℱ', ℱ` are sheaves, @@ -335,6 +345,7 @@ begin apply as_iso (sheaf_hom H i.hom), end +omit H /-- Given an natural isomorphism `G ⋙ ℱ ≅ G ⋙ ℱ'` between presheaves of arbitrary category, where `G` is full and cover-dense, and `ℱ', ℱ` are sheaves, @@ -404,6 +415,7 @@ def restrict_hom_equiv_hom : (G.op ⋙ ℱ ⟶ G.op ⋙ ℱ'.val) ≃ (ℱ ⟶ left_inv := sheaf_hom_restrict_eq H, right_inv := sheaf_hom_eq H } +include H /-- Given a full and cover-dense functor `G` and a natural transformation of sheaves `α : ℱ ⟶ ℱ'`, if the pullback of `α` along `G` is iso, then `α` is also iso. @@ -431,6 +443,8 @@ begin simp [eq] end +omit H + noncomputable instance sites.pullback.full [faithful G] (Hp : cover_preserving J K G) : full (sites.pullback A H.compatible_preserving Hp) := diff --git a/src/category_theory/sites/grothendieck.lean b/src/category_theory/sites/grothendieck.lean index ebba468fb34db..18277bfba4c8e 100644 --- a/src/category_theory/sites/grothendieck.lean +++ b/src/category_theory/sites/grothendieck.lean @@ -13,6 +13,9 @@ import order.copy /-! # Grothendieck topologies +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Definition and lemmas about Grothendieck topologies. A Grothendieck topology for a category `C` is a set of sieves on each object `X` satisfying certain closure conditions. @@ -406,14 +409,14 @@ instance : semilattice_inf (J.cover X) := instance : inhabited (J.cover X) := ⟨⊤⟩ /-- An auxiliary structure, used to define `S.index` in `plus.lean`. -/ -@[nolint has_inhabited_instance, ext] +@[nolint has_nonempty_instance, ext] structure arrow (S : J.cover X) := (Y : C) (f : Y ⟶ X) (hf : S f) /-- An auxiliary structure, used to define `S.index` in `plus.lean`. -/ -@[nolint has_inhabited_instance, ext] +@[nolint has_nonempty_instance, ext] structure relation (S : J.cover X) := (Y₁ Y₂ Z : C) (g₁ : Z ⟶ Y₁) diff --git a/src/category_theory/sites/induced_topology.lean b/src/category_theory/sites/induced_topology.lean index 7f0cd626e339a..8c54a1624e131 100644 --- a/src/category_theory/sites/induced_topology.lean +++ b/src/category_theory/sites/induced_topology.lean @@ -8,6 +8,9 @@ import category_theory.sites.dense_subsite /-! # Induced Topology +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We say that a functor `G : C ⥤ (D, K)` is locally dense if for each covering sieve `T` in `D` of some `X : C`, `T ∩ mor(C)` generates a covering sieve of `X` in `D`. A locally dense fully faithful functor then induces a topology on `C` via `{ T ∩ mor(C) | T ∈ K }`. Note that this is equal to diff --git a/src/category_theory/sites/left_exact.lean b/src/category_theory/sites/left_exact.lean index a4e62d9e15218..7288d49ba3824 100644 --- a/src/category_theory/sites/left_exact.lean +++ b/src/category_theory/sites/left_exact.lean @@ -10,6 +10,9 @@ import category_theory.limits.filtered_colimit_commutes_finite_limit /-! # Left exactness of sheafification + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. In this file we show that sheafification commutes with finite limits. -/ @@ -192,7 +195,7 @@ begin dsimp, simp only [category.assoc], rw ι_colimit_limit_iso_limit_π_assoc, - simp only [nat_iso.of_components.inv_app, + simp only [nat_iso.of_components_inv_app, colimit_obj_iso_colimit_comp_evaluation_ι_app_hom, iso.symm_inv], dsimp [is_limit.cone_point_unique_up_to_iso], rw [← category.assoc, ← nat_trans.comp_app, limit.lift_π], @@ -202,7 +205,8 @@ end instance [has_finite_limits D] [preserves_finite_limits (forget D)] [reflects_isomorphisms (forget D)] : preserves_finite_limits (J.plus_functor D) := begin - constructor, introsI K _ _, + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{max v u}, + introsI K _ _, haveI : reflects_limits_of_shape K (forget D) := reflects_limits_of_shape_of_reflects_isomorphisms, apply_instance @@ -241,6 +245,9 @@ begin end instance [has_finite_limits D] : preserves_finite_limits (presheaf_to_Sheaf J D) := -⟨λ K _ _, by { resetI, apply_instance }⟩ +begin + apply preserves_finite_limits_of_preserves_finite_limits_of_size.{max v u}, + intros, resetI, apply_instance +end end category_theory diff --git a/src/category_theory/sites/limits.lean b/src/category_theory/sites/limits.lean index af9b4b93f99ca..8fcf057055190 100644 --- a/src/category_theory/sites/limits.lean +++ b/src/category_theory/sites/limits.lean @@ -10,6 +10,9 @@ import category_theory.sites.sheafification # Limits and colimits of sheaves +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Limits We prove that the forgetful functor from `Sheaf J D` to presheaves creates limits. @@ -33,10 +36,10 @@ open opposite section limits -universes w v u -variables {C : Type (max v u)} [category.{v} C] {J : grothendieck_topology C} +universes w v u z +variables {C : Type u} [category.{v} C] {J : grothendieck_topology C} variables {D : Type w} [category.{max v u} D] -variables {K : Type (max v u)} [small_category K] +variables {K : Type z} [small_category K] noncomputable theory @@ -166,7 +169,7 @@ end limits section colimits universes w v u -variables {C : Type (max v u)} [category.{v} C] {J : grothendieck_topology C} +variables {C : Type u} [category.{v} C] {J : grothendieck_topology C} variables {D : Type w} [category.{max v u} D] variables {K : Type (max v u)} [small_category K] -- Now we need a handful of instances to obtain sheafification... diff --git a/src/category_theory/sites/plus.lean b/src/category_theory/sites/plus.lean index 0520c3b1c40aa..b9673ffeb6709 100644 --- a/src/category_theory/sites/plus.lean +++ b/src/category_theory/sites/plus.lean @@ -9,6 +9,9 @@ import category_theory.sites.sheaf # The plus construction for presheaves. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the construction of `P⁺`, for a presheaf `P : Cᵒᵖ ⥤ D` where `C` is endowed with a grothendieck topology `J`. @@ -74,6 +77,11 @@ begin erw category.comp_id end +@[simp] +lemma diagram_nat_trans_zero [preadditive D] (X : C) (P Q : Cᵒᵖ ⥤ D) : + J.diagram_nat_trans (0 : P ⟶ Q) X = 0 := +by { ext j x, dsimp, rw [zero_comp, multiequalizer.lift_ι, comp_zero] } + @[simp] lemma diagram_nat_trans_comp {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R) (X : C) : J.diagram_nat_trans (η ≫ γ) X = J.diagram_nat_trans η X ≫ J.diagram_nat_trans γ X := @@ -160,6 +168,10 @@ begin simp, end +@[simp] +lemma plus_map_zero [preadditive D] (P Q : Cᵒᵖ ⥤ D) : J.plus_map (0 : P ⟶ Q) = 0 := +by { ext, erw [comp_zero, colimit.ι_map, J.diagram_nat_trans_zero, zero_comp] } + @[simp] lemma plus_map_comp {P Q R : Cᵒᵖ ⥤ D} (η : P ⟶ Q) (γ : Q ⟶ R) : J.plus_map (η ≫ γ) = J.plus_map η ≫ J.plus_map γ := @@ -264,14 +276,13 @@ end lemma is_iso_to_plus_of_is_sheaf (hP : presheaf.is_sheaf J P) : is_iso (J.to_plus P) := begin rw presheaf.is_sheaf_iff_multiequalizer at hP, - resetI, - suffices : ∀ X, is_iso ((J.to_plus P).app X), - { resetI, apply nat_iso.is_iso_of_is_iso_app }, + rsufficesI : ∀ X, is_iso ((J.to_plus P).app X), + { apply nat_iso.is_iso_of_is_iso_app }, intros X, dsimp, - suffices : is_iso (colimit.ι (J.diagram P X.unop) (op ⊤)), - { resetI, apply is_iso.comp_is_iso }, - suffices : ∀ (S T : (J.cover X.unop)ᵒᵖ) (f : S ⟶ T), is_iso ((J.diagram P X.unop).map f), - { resetI, apply is_iso_ι_of_is_initial (initial_op_of_terminal is_terminal_top) }, + rsufficesI : is_iso (colimit.ι (J.diagram P X.unop) (op ⊤)), + { apply is_iso.comp_is_iso }, + rsufficesI : ∀ (S T : (J.cover X.unop)ᵒᵖ) (f : S ⟶ T), is_iso ((J.diagram P X.unop).map f), + { apply is_iso_ι_of_is_initial (initial_op_of_terminal is_terminal_top) }, intros S T e, have : S.unop.to_multiequalizer P ≫ (J.diagram P (X.unop)).map e = T.unop.to_multiequalizer P, by { ext, dsimp, simpa }, @@ -338,4 +349,8 @@ begin rw [← category.assoc, ← J.to_plus_naturality, category.assoc, J.to_plus_plus_lift], end +instance plus_functor_preserves_zero_morphisms [preadditive D] : + (plus_functor J D).preserves_zero_morphisms := +{ map_zero' := λ F G, by { ext, dsimp, rw [J.plus_map_zero, nat_trans.app_zero] } } + end category_theory.grothendieck_topology diff --git a/src/category_theory/sites/pretopology.lean b/src/category_theory/sites/pretopology.lean index b8d0f9f3fa741..85c835126e84c 100644 --- a/src/category_theory/sites/pretopology.lean +++ b/src/category_theory/sites/pretopology.lean @@ -9,6 +9,9 @@ import category_theory.sites.grothendieck /-! # Grothendieck pretopologies +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Definition and lemmas about Grothendieck pretopologies. A Grothendieck pretopology for a category `C` is a set of families of morphisms with fixed codomain, satisfying certain closure conditions. diff --git a/src/category_theory/sites/pushforward.lean b/src/category_theory/sites/pushforward.lean new file mode 100644 index 0000000000000..c14c8316b1f0f --- /dev/null +++ b/src/category_theory/sites/pushforward.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2021 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.sites.cover_preserving +import category_theory.sites.left_exact + +/-! +# Pushforward of sheaves + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `category_theory.sites.pushforward`: the induced functor `Sheaf J A ⥤ Sheaf K A` for a +cover-preserving and compatible-preserving functor `G : (C, J) ⥤ (D, K)`. + +-/ + +universes v₁ u₁ +noncomputable theory + +open category_theory.limits + +namespace category_theory + +variables {C : Type v₁} [small_category C] {D : Type v₁} [small_category D] +variables (A : Type u₁) [category.{v₁} A] +variables (J : grothendieck_topology C) (K : grothendieck_topology D) + +instance [has_limits A] : creates_limits (Sheaf_to_presheaf J A) := +category_theory.Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{u₁ v₁ v₁} + +-- The assumptions so that we have sheafification +variables [concrete_category.{v₁} A] [preserves_limits (forget A)] [has_colimits A] [has_limits A] +variables [preserves_filtered_colimits (forget A)] [reflects_isomorphisms (forget A)] + +local attribute [instance] reflects_limits_of_reflects_isomorphisms + +instance {X : C} : is_cofiltered (J.cover X) := infer_instance + +/-- The pushforward functor `Sheaf J A ⥤ Sheaf K A` associated to a functor `G : C ⥤ D` in the +same direction as `G`. -/ +@[simps] def sites.pushforward (G : C ⥤ D) : Sheaf J A ⥤ Sheaf K A := +Sheaf_to_presheaf J A ⋙ Lan G.op ⋙ presheaf_to_Sheaf K A + +instance (G : C ⥤ D) [representably_flat G] : + preserves_finite_limits (sites.pushforward A J K G) := +begin + apply_with comp_preserves_finite_limits { instances := ff }, + { apply_instance }, + apply_with comp_preserves_finite_limits { instances := ff }, + { apply category_theory.Lan_preserves_finite_limits_of_flat }, + { apply category_theory.presheaf_to_Sheaf.limits.preserves_finite_limits.{u₁ v₁ v₁}, + apply_instance } +end + +/-- The pushforward functor is left adjoint to the pullback functor. -/ +def sites.pullback_pushforward_adjunction {G : C ⥤ D} (hG₁ : compatible_preserving K G) + (hG₂ : cover_preserving J K G) : sites.pushforward A J K G ⊣ sites.pullback A hG₁ hG₂ := +((Lan.adjunction A G.op).comp (sheafification_adjunction K A)).restrict_fully_faithful + (Sheaf_to_presheaf J A) (𝟭 _) + (nat_iso.of_components (λ _, iso.refl _) + (λ _ _ _,(category.comp_id _).trans (category.id_comp _).symm)) + (nat_iso.of_components (λ _, iso.refl _) + (λ _ _ _,(category.comp_id _).trans (category.id_comp _).symm)) + +end category_theory diff --git a/src/category_theory/sites/sheaf.lean b/src/category_theory/sites/sheaf.lean index c2983cbe2a316..04a1ec67fd722 100644 --- a/src/category_theory/sites/sheaf.lean +++ b/src/category_theory/sites/sheaf.lean @@ -7,11 +7,15 @@ Authors: Kevin Buzzard, Bhavik Mehta import category_theory.limits.preserves.shapes.equalizers import category_theory.limits.preserves.shapes.products import category_theory.limits.yoneda +import category_theory.preadditive.functor_category import category_theory.sites.sheaf_of_types /-! # Sheaves taking values in a category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + If C is a category with a Grothendieck topology, we define the notion of a sheaf taking values in an arbitrary category `A`. We follow the definition in https://stacks.math.columbia.edu/tag/00VR, noting that the presheaf of sets "defined above" can be seen in the comments between tags 00VQ and @@ -206,8 +210,16 @@ lemma is_sheaf.hom_ext {A : Type u₂} [category.{max v₁ u₁} A] e₁ = e₂ := (hP _ _ S.condition).is_separated_for.ext (λ Y f hf, h ⟨Y,f,hf⟩) +lemma is_sheaf_of_iso_iff {P P' : Cᵒᵖ ⥤ A} (e : P ≅ P') : is_sheaf J P ↔ is_sheaf J P' := +forall_congr $ λ a, ⟨presieve.is_sheaf_iso J (iso_whisker_right e _), + presieve.is_sheaf_iso J (iso_whisker_right e.symm _)⟩ + variable (J) +lemma is_sheaf_of_is_terminal {X : A} (hX : is_terminal X) : + presheaf.is_sheaf J ((category_theory.functor.const _).obj X) := +λ _ _ _ _ _ _, ⟨hX.from _, λ _ _ _, hX.hom_ext _ _, λ _ _, hX.hom_ext _ _⟩ + end presheaf variables {C : Type u₁} [category.{v₁} C] @@ -253,6 +265,14 @@ def Sheaf_to_presheaf : Sheaf J A ⥤ (Cᵒᵖ ⥤ A) := instance : full (Sheaf_to_presheaf J A) := { preimage := λ X Y f, ⟨f⟩ } instance : faithful (Sheaf_to_presheaf J A) := {} +/--This is stated as a lemma to prevent class search from forming a loop since a sheaf morphism is +monic if and only if it is monic as a presheaf morphism (under suitable assumption).-/ +lemma Sheaf.hom.mono_of_presheaf_mono {F G : Sheaf J A} (f : F ⟶ G) [h : mono f.1] : mono f := +(Sheaf_to_presheaf J A).mono_of_mono_map h + +instance Sheaf.hom.epi_of_presheaf_epi {F G : Sheaf J A} (f : F ⟶ G) [h : epi f.1] : epi f := +(Sheaf_to_presheaf J A).epi_of_epi_map h + /-- The sheaf of sections guaranteed by the sheaf condition. -/ @[simps] def sheaf_over {A : Type u₂} [category.{v₂} A] {J : grothendieck_topology C} (ℱ : Sheaf J A) (E : A) : SheafOfTypes J := ⟨ℱ.val ⋙ coyoneda.obj (op E), ℱ.cond E⟩ @@ -308,6 +328,60 @@ begin exact ⟨⟨t⟩, λ a, h.2 a (by tidy)⟩ end +section preadditive + +open preadditive + +variables [preadditive A] {P Q : Sheaf J A} + +instance Sheaf_hom_has_zsmul : has_smul ℤ (P ⟶ Q) := +{ smul := λ n f, Sheaf.hom.mk + { app := λ U, n • f.1.app U, + naturality' := λ U V i, begin + induction n using int.induction_on with n ih n ih, + { simp only [zero_smul, comp_zero, zero_comp], }, + { simpa only [add_zsmul, one_zsmul, comp_add, nat_trans.naturality, add_comp, add_left_inj] }, + { simpa only [sub_smul, one_zsmul, comp_sub, nat_trans.naturality, sub_comp, sub_left_inj] + using ih, } + end } } + +instance : has_sub (P ⟶ Q) := +{ sub := λ f g, Sheaf.hom.mk $ f.1 - g.1 } + +instance : has_neg (P ⟶ Q) := +{ neg := λ f, Sheaf.hom.mk $ -f.1 } + +instance Sheaf_hom_has_nsmul : has_smul ℕ (P ⟶ Q) := +{ smul := λ n f, Sheaf.hom.mk + { app := λ U, n • f.1.app U, + naturality' := λ U V i, begin + induction n with n ih, + { simp only [zero_smul, comp_zero, zero_comp], }, + { simp only [nat.succ_eq_add_one, add_smul, ih, one_nsmul, comp_add, nat_trans.naturality, + add_comp], }, + end } } + +instance : has_zero (P ⟶ Q) := +{ zero := Sheaf.hom.mk 0 } + +instance : has_add (P ⟶ Q) := +{ add := λ f g, Sheaf.hom.mk $ f.1 + g.1 } + +@[simp] lemma Sheaf.hom.add_app (f g : P ⟶ Q) (U) : + (f + g).1.app U = f.1.app U + g.1.app U := rfl + +instance : add_comm_group (P ⟶ Q) := +function.injective.add_comm_group (λ (f : Sheaf.hom P Q), f.1) + (λ _ _ h, Sheaf.hom.ext _ _ h) rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) + (λ _ _, by { ext, simpa [*] }) (λ _ _, by { ext, simpa [*] }) + +instance : preadditive (Sheaf J A) := +{ hom_group := λ P Q, infer_instance, + add_comp' := λ P Q R f f' g, by { ext, simp, }, + comp_add' := λ P Q R f g g', by { ext, simp, } } + +end preadditive + end category_theory namespace category_theory @@ -396,7 +470,7 @@ end multiequalizer_conditions section -variables [has_products A] +variables [has_products.{(max u₁ v₁)} A] /-- The middle object of the fork diagram given in Equation (3) of [MM92], as well as the fork diagram @@ -493,6 +567,7 @@ begin rw equalizer.presieve.sheaf_condition, refine ⟨_⟩, refine is_sheaf_for_is_sheaf_for' _ _ _ _ _, + letI := preserves_smallest_limits_of_preserves_limits (coyoneda.obj (op U)), apply is_limit_of_preserves, apply classical.choice (h _ S _), simpa } @@ -525,8 +600,10 @@ begin is_sheaf_for_is_sheaf_for' P s U R, rw ←equiv.nonempty_congr this, split, - { exact nonempty.map (λ t, is_limit_of_preserves s t) }, - { exact nonempty.map (λ t, is_limit_of_reflects s t) } + { haveI := preserves_smallest_limits_of_preserves_limits s, + exact nonempty.map (λ t, is_limit_of_preserves s t) }, + { haveI := reflects_smallest_limits_of_reflects_limits s, + exact nonempty.map (λ t, is_limit_of_reflects s t) } end end concrete diff --git a/src/category_theory/sites/sheaf_of_types.lean b/src/category_theory/sites/sheaf_of_types.lean index 37fa6d371ecc8..cdd033564ed27 100644 --- a/src/category_theory/sites/sheaf_of_types.lean +++ b/src/category_theory/sites/sheaf_of_types.lean @@ -6,11 +6,13 @@ Authors: Bhavik Mehta import category_theory.sites.pretopology import category_theory.limits.shapes.types -import category_theory.full_subcategory /-! # Sheaves of types on a Grothendieck topology +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines the notion of a sheaf of types (usually called a sheaf of sets by mathematicians) on a category equipped with a Grothendieck topology, as well as a range of equivalent conditions useful in different situations. @@ -663,7 +665,7 @@ Every presheaf is a sheaf for the maximal sieve. lemma is_sheaf_for_top_sieve (P : Cᵒᵖ ⥤ Type w) : is_sheaf_for P ((⊤ : sieve X) : presieve X) := begin - rw ← generate_of_singleton_split_epi (𝟙 X), + rw ← generate_of_singleton_is_split_epi (𝟙 X), rw ← is_sheaf_for_iff_generate, apply is_sheaf_for_singleton_iso, end @@ -817,7 +819,7 @@ def first_obj_eq_family : first_obj P R ≅ R.family_of_elements P := inv_hom_id' := begin ext x Y f hf, - apply limits.types.limit.lift_π_apply, + apply limits.types.limit.lift_π_apply', end } instance : inhabited (first_obj P (⊥ : presieve X)) := @@ -873,8 +875,8 @@ begin ext ⟨Y, Z, g, f, hf⟩, simpa [first_map, second_map] using t _ g hf }, { intros t Y Z f g hf, - rw types.limit_ext_iff at t, - simpa [first_map, second_map] using t ⟨Y, Z, g, f, hf⟩ } + rw types.limit_ext_iff' at t, + simpa [first_map, second_map] using t ⟨⟨Y, Z, g, f, hf⟩⟩ } end /-- `P` is a sheaf for `S`, iff the fork given by `w` is an equalizer. -/ @@ -952,8 +954,8 @@ begin ext ⟨⟨Y, f, hf⟩, Z, g, hg⟩, simpa [first_map, second_map] using t hf hg }, { intros t Y Z f g hf hg, - rw types.limit_ext_iff at t, - simpa [first_map, second_map] using t ⟨⟨Y, f, hf⟩, Z, g, hg⟩ } + rw types.limit_ext_iff' at t, + simpa [first_map, second_map] using t ⟨⟨⟨Y, f, hf⟩, Z, g, hg⟩⟩ } end /-- diff --git a/src/category_theory/sites/sheafification.lean b/src/category_theory/sites/sheafification.lean index fc5fb5a349270..f424ae433bc56 100644 --- a/src/category_theory/sites/sheafification.lean +++ b/src/category_theory/sites/sheafification.lean @@ -3,13 +3,18 @@ Copyright (c) 2021 Adam Topaz. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Adam Topaz -/ +import category_theory.adjunction.fully_faithful import category_theory.sites.plus import category_theory.limits.concrete_category +import category_theory.concrete_category.elementwise /-! # Sheafification +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We construct the sheafification of a presheaf over a site `C` with values in `D` whenever `D` is a concrete category for which the forgetful functor preserves the appropriate (co)limits and reflects isomorphisms. @@ -34,7 +39,7 @@ local attribute [instance] concrete_category.has_coe_to_fun /-- A concrete version of the multiequalizer, to be used below. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def meq {X : C} (P : Cᵒᵖ ⥤ D) (S : J.cover X) := { x : Π (I : S.arrow), P.obj (op I.Y) // ∀ (I : S.relation), P.map I.g₁.op (x I.fst) = P.map I.g₂.op (x I.snd) } @@ -606,6 +611,11 @@ def presheaf_to_Sheaf : (Cᵒᵖ ⥤ D) ⥤ Sheaf J D := map_id' := λ P, Sheaf.hom.ext _ _ $ J.sheafify_map_id _, map_comp' := λ P Q R f g, Sheaf.hom.ext _ _ $ J.sheafify_map_comp _ _ } +instance presheaf_to_Sheaf_preserves_zero_morphisms [preadditive D] : + (presheaf_to_Sheaf J D).preserves_zero_morphisms := +{ map_zero' := λ F G, by { ext, erw [colimit.ι_map, comp_zero, J.plus_map_zero, + J.diagram_nat_trans_zero, zero_comp] } } + /-- The sheafification functor is left adjoint to the forgetful functor. -/ @[simps unit_app counit_app_val] def sheafification_adjunction : presheaf_to_Sheaf J D ⊣ Sheaf_to_presheaf J D := @@ -621,6 +631,16 @@ adjunction.mk_of_hom_equiv end, hom_equiv_naturality_right' := λ P Q R η γ, by { dsimp, rw category.assoc } } +instance Sheaf_to_presheaf_is_right_adjoint : is_right_adjoint (Sheaf_to_presheaf J D) := +⟨_, sheafification_adjunction J D⟩ + +instance presheaf_mono_of_mono {F G : Sheaf J D} (f : F ⟶ G) [mono f] : mono f.1 := +(Sheaf_to_presheaf J D).map_mono _ + +lemma Sheaf.hom.mono_iff_presheaf_mono {F G : Sheaf J D} (f : F ⟶ G) : mono f ↔ mono f.1 := +⟨λ m, by { resetI, apply_instance }, + λ m, by { resetI, exact Sheaf.hom.mono_of_presheaf_mono J D f }⟩ + variables {J D} /-- A sheaf `P` is isomorphic to its own sheafification. -/ @[simps] diff --git a/src/category_theory/sites/sieves.lean b/src/category_theory/sites/sieves.lean index 41522c7061f28..0b439ab41467a 100644 --- a/src/category_theory/sites/sieves.lean +++ b/src/category_theory/sites/sieves.lean @@ -13,6 +13,9 @@ import data.set.lattice /-! # Theory of sieves +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + - For an object `X` of a category `C`, a `sieve X` is a set of morphisms to `X` which is closed under left-composition. - The complete lattice structure on sieves is given, as well as the Galois insertion @@ -44,7 +47,7 @@ instance : inhabited (presieve X) := ⟨⊤⟩ /-- Given a sieve `S` on `X : C`, its associated diagram `S.diagram` is defined to be the natural functor from the full subcategory of the over category `C/X` consisting of arrows in `S` to `C`. -/ -abbreviation diagram (S : presieve X) : {f : over X // S f.hom} ⥤ C := +abbreviation diagram (S : presieve X) : full_subcategory (λ (f : over X), S f.hom) ⥤ C := full_subcategory_inclusion _ ⋙ over.forget X /-- Given a sieve `S` on `X : C`, its associated cocone `S.cocone` is defined to be @@ -170,7 +173,7 @@ def functor_pushforward (S : presieve X) : presieve (F.obj X) := /-- An auxillary definition in order to fix the choice of the preimages between various definitions. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] structure functor_pushforward_structure (S : presieve X) {Y} (f : Y ⟶ F.obj X) := (preobj : C) (premap : preobj ⟶ X) (lift : Y ⟶ F.obj preobj) (cover : S premap) (fac : f = lift ≫ F.map premap) @@ -357,7 +360,7 @@ lemma id_mem_iff_eq_top : S (𝟙 X) ↔ S = ⊤ := λ h, h.symm ▸ trivial⟩ /-- If an arrow set contains a split epi, it generates the maximal sieve. -/ -lemma generate_of_contains_split_epi {R : presieve X} (f : Y ⟶ X) [split_epi f] +lemma generate_of_contains_is_split_epi {R : presieve X} (f : Y ⟶ X) [is_split_epi f] (hf : R f) : generate R = ⊤ := begin rw ← id_mem_iff_eq_top, @@ -365,13 +368,13 @@ begin end @[simp] -lemma generate_of_singleton_split_epi (f : Y ⟶ X) [split_epi f] : +lemma generate_of_singleton_is_split_epi (f : Y ⟶ X) [is_split_epi f] : generate (presieve.singleton f) = ⊤ := -generate_of_contains_split_epi f (presieve.singleton_self _) +generate_of_contains_is_split_epi f (presieve.singleton_self _) @[simp] lemma generate_top : generate (⊤ : presieve X) = ⊤ := -generate_of_contains_split_epi (𝟙 _) ⟨⟩ +generate_of_contains_is_split_epi (𝟙 _) ⟨⟩ /-- Given a morphism `h : Y ⟶ X`, send a sieve S on X to a sieve on Y as the inverse image of S with `_ ≫ h`. @@ -470,7 +473,7 @@ begin end /-- If `f` is a split epi, the pushforward-pullback adjunction on sieves is reflective. -/ -def galois_insertion_of_split_epi (f : Y ⟶ X) [split_epi f] : +def galois_insertion_of_is_split_epi (f : Y ⟶ X) [is_split_epi f] : galois_insertion (sieve.pushforward f) (sieve.pullback f) := begin apply (galois_connection f).to_galois_insertion, @@ -599,7 +602,7 @@ lemma functor_pullback_inter (S R : sieve (F.obj X)) : (⊤ : sieve X).functor_pushforward F = ⊤ := begin refine (generate_sieve _).symm.trans _, - apply generate_of_contains_split_epi (𝟙 (F.obj X)), + apply generate_of_contains_is_split_epi (𝟙 (F.obj X)), refine ⟨X, 𝟙 _, 𝟙 _, trivial, by simp⟩ end diff --git a/src/category_theory/sites/spaces.lean b/src/category_theory/sites/spaces.lean index cd20ac5cdb426..8148124c359f5 100644 --- a/src/category_theory/sites/spaces.lean +++ b/src/category_theory/sites/spaces.lean @@ -11,6 +11,9 @@ import topology.sets.opens /-! # Grothendieck topology on a topological space +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define the Grothendieck topology and the pretopology associated to a topological space, and show that the pretopology induces the topology. diff --git a/src/category_theory/sites/subsheaf.lean b/src/category_theory/sites/subsheaf.lean new file mode 100644 index 0000000000000..b0bd284af7278 --- /dev/null +++ b/src/category_theory/sites/subsheaf.lean @@ -0,0 +1,436 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.elementwise +import category_theory.adjunction.evaluation +import category_theory.sites.sheafification + +/-! + +# Subsheaf of types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We define the sub(pre)sheaf of a type valued presheaf. + +## Main results + +- `category_theory.grothendieck_topology.subpresheaf` : + A subpresheaf of a presheaf of types. +- `category_theory.grothendieck_topology.subpresheaf.sheafify` : + The sheafification of a subpresheaf as a subpresheaf. Note that this is a sheaf only when the + whole sheaf is. +- `category_theory.grothendieck_topology.subpresheaf.sheafify_is_sheaf` : + The sheafification is a sheaf +- `category_theory.grothendieck_topology.subpresheaf.sheafify_lift` : + The descent of a map into a sheaf to the sheafification. +- `category_theory.grothendieck_topology.image_sheaf` : The image sheaf of a morphism. +- `category_theory.grothendieck_topology.image_factorization` : The image sheaf as a + `limits.image_factorization`. +-/ + +universes w v u + +open opposite category_theory + +namespace category_theory.grothendieck_topology + +variables {C : Type u} [category.{v} C] (J : grothendieck_topology C) + +/-- A subpresheaf of a presheaf consists of a subset of `F.obj U` for every `U`, +compatible with the restriction maps `F.map i`. -/ +@[ext] +structure subpresheaf (F : Cᵒᵖ ⥤ Type w) := +(obj : Π U, set (F.obj U)) +(map : Π {U V : Cᵒᵖ} (i : U ⟶ V), (obj U) ⊆ (F.map i) ⁻¹' (obj V)) + +variables {F F' F'' : Cᵒᵖ ⥤ Type w} (G G' : subpresheaf F) + +instance : partial_order (subpresheaf F) := +partial_order.lift subpresheaf.obj subpresheaf.ext + +instance : has_top (subpresheaf F) := +⟨⟨λ U, ⊤, λ U V i x h, _root_.trivial⟩⟩ + +instance : nonempty (subpresheaf F) := infer_instance + +/-- The subpresheaf as a presheaf. -/ +@[simps] +def subpresheaf.to_presheaf : Cᵒᵖ ⥤ Type w := +{ obj := λ U, G.obj U, + map := λ U V i x, ⟨F.map i x, G.map i x.prop⟩, + map_id' := λ X, by { ext ⟨x, _⟩, dsimp, rw F.map_id, refl }, + map_comp' := λ X Y Z i j, by { ext ⟨x, _⟩, dsimp, rw F.map_comp, refl } } + +instance {U} : has_coe (G.to_presheaf.obj U) (F.obj U) := +coe_subtype + +/-- The inclusion of a subpresheaf to the original presheaf. -/ +@[simps] +def subpresheaf.ι : G.to_presheaf ⟶ F := +{ app := λ U x, x } + +instance : mono G.ι := +⟨λ H f₁ f₂ e, nat_trans.ext f₁ f₂ $ funext $ λ U, + funext $ λ x, subtype.ext $ congr_fun (congr_app e U) x⟩ + +/-- The inclusion of a subpresheaf to a larger subpresheaf -/ +@[simps] +def subpresheaf.hom_of_le {G G' : subpresheaf F} (h : G ≤ G') : G.to_presheaf ⟶ G'.to_presheaf := +{ app := λ U x, ⟨x, h U x.prop⟩ } + +instance {G G' : subpresheaf F} (h : G ≤ G') : mono (subpresheaf.hom_of_le h) := +⟨λ H f₁ f₂ e, nat_trans.ext f₁ f₂ $ funext $ λ U, + funext $ λ x, subtype.ext $ (congr_arg subtype.val $ (congr_fun (congr_app e U) x : _) : _)⟩ + +@[simp, reassoc] +lemma subpresheaf.hom_of_le_ι {G G' : subpresheaf F} (h : G ≤ G') : + subpresheaf.hom_of_le h ≫ G'.ι = G.ι := +by { ext, refl } + +instance : is_iso (subpresheaf.ι (⊤ : subpresheaf F)) := +begin + apply_with nat_iso.is_iso_of_is_iso_app { instances := ff }, + { intro X, rw is_iso_iff_bijective, + exact ⟨subtype.coe_injective, λ x, ⟨⟨x, _root_.trivial⟩, rfl⟩⟩ } +end + +lemma subpresheaf.eq_top_iff_is_iso : G = ⊤ ↔ is_iso G.ι := +begin + split, + { rintro rfl, apply_instance }, + { introI H, ext U x, apply (iff_true _).mpr, rw ← is_iso.inv_hom_id_apply (G.ι.app U) x, + exact ((inv (G.ι.app U)) x).2 } +end + +/-- If the image of a morphism falls in a subpresheaf, then the morphism factors through it. -/ +@[simps] +def subpresheaf.lift (f : F' ⟶ F) (hf : ∀ U x, f.app U x ∈ G.obj U) : F' ⟶ G.to_presheaf := +{ app := λ U x, ⟨f.app U x, hf U x⟩, + naturality' := by { have := elementwise_of f.naturality, intros, ext, simp [this] } } + +@[simp, reassoc] +lemma subpresheaf.lift_ι (f : F' ⟶ F) (hf : ∀ U x, f.app U x ∈ G.obj U) : + G.lift f hf ≫ G.ι = f := by { ext, refl } + +/-- Given a subpresheaf `G` of `F`, an `F`-section `s` on `U`, we may define a sieve of `U` +consisting of all `f : V ⟶ U` such that the restriction of `s` along `f` is in `G`. -/ +@[simps] +def subpresheaf.sieve_of_section {U : Cᵒᵖ} (s : F.obj U) : sieve (unop U) := +{ arrows := λ V f, F.map f.op s ∈ G.obj (op V), + downward_closed' := λ V W i hi j, + by { rw [op_comp, functor_to_types.map_comp_apply], exact G.map _ hi } } + +/-- Given a `F`-section `s` on `U` and a subpresheaf `G`, we may define a family of elements in +`G` consisting of the restrictions of `s` -/ +def subpresheaf.family_of_elements_of_section {U : Cᵒᵖ} (s : F.obj U) : + (G.sieve_of_section s).1.family_of_elements G.to_presheaf := +λ V i hi, ⟨F.map i.op s, hi⟩ + +lemma subpresheaf.family_of_elements_compatible {U : Cᵒᵖ} (s : F.obj U) : + (G.family_of_elements_of_section s).compatible := +begin + intros Y₁ Y₂ Z g₁ g₂ f₁ f₂ h₁ h₂ e, + ext1, + change F.map g₁.op (F.map f₁.op s) = F.map g₂.op (F.map f₂.op s), + rw [← functor_to_types.map_comp_apply, ← functor_to_types.map_comp_apply, + ← op_comp, ← op_comp, e], +end + +lemma subpresheaf.nat_trans_naturality (f : F' ⟶ G.to_presheaf) {U V : Cᵒᵖ} (i : U ⟶ V) + (x : F'.obj U) : + (f.app V (F'.map i x)).1 = F.map i (f.app U x).1 := +congr_arg subtype.val (functor_to_types.naturality _ _ f i x) + +include J + +/-- The sheafification of a subpresheaf as a subpresheaf. +Note that this is a sheaf only when the whole presheaf is a sheaf. -/ +def subpresheaf.sheafify : subpresheaf F := +{ obj := λ U, { s | G.sieve_of_section s ∈ J (unop U) }, + map := begin + rintros U V i s hs, + refine J.superset_covering _ (J.pullback_stable i.unop hs), + intros _ _ h, + dsimp at h ⊢, + rwa ← functor_to_types.map_comp_apply, + end } + +lemma subpresheaf.le_sheafify : G ≤ G.sheafify J := +begin + intros U s hs, + change _ ∈ J _, + convert J.top_mem _, + rw eq_top_iff, + rintros V i -, + exact G.map i.op hs, +end + +variable {J} + +lemma subpresheaf.eq_sheafify (h : presieve.is_sheaf J F) + (hG : presieve.is_sheaf J G.to_presheaf) : G = G.sheafify J := +begin + apply (G.le_sheafify J).antisymm, + intros U s hs, + suffices : ((hG _ hs).amalgamate _ (G.family_of_elements_compatible s)).1 = s, + { rw ← this, exact ((hG _ hs).amalgamate _ (G.family_of_elements_compatible s)).2 }, + apply (h _ hs).is_separated_for.ext, + intros V i hi, + exact (congr_arg subtype.val ((hG _ hs).valid_glue (G.family_of_elements_compatible s) _ hi) : _) +end + +lemma subpresheaf.sheafify_is_sheaf (hF : presieve.is_sheaf J F) : + presieve.is_sheaf J (G.sheafify J).to_presheaf := +begin + intros U S hS x hx, + let S' := sieve.bind S (λ Y f hf, G.sieve_of_section (x f hf).1), + have := λ {V} {i : V ⟶ U} (hi : S' i), hi, + choose W i₁ i₂ hi₂ h₁ h₂, + dsimp [-sieve.bind_apply] at *, + let x'' : presieve.family_of_elements F S' := + λ V i hi, F.map (i₁ hi).op (x _ (hi₂ hi)), + have H : ∀ s, x.is_amalgamation s ↔ x''.is_amalgamation s.1, + { intro s, + split, + { intros H V i hi, + dsimp only [x''], + conv_lhs { rw ← h₂ hi }, + rw ← H _ (hi₂ hi), + exact functor_to_types.map_comp_apply F (i₂ hi).op (i₁ hi).op _ }, + { intros H V i hi, + ext1, + apply (hF _ (x i hi).2).is_separated_for.ext, + intros V' i' hi', + have hi'' : S' (i' ≫ i) := ⟨_, _, _, hi, hi', rfl⟩, + have := H _ hi'', + rw [op_comp, F.map_comp] at this, + refine this.trans (congr_arg subtype.val (hx _ _ (hi₂ hi'') hi (h₂ hi''))) } }, + have : x''.compatible, + { intros V₁ V₂ V₃ g₁ g₂ g₃ g₄ S₁ S₂ e, + rw [← functor_to_types.map_comp_apply, ← functor_to_types.map_comp_apply], + exact congr_arg subtype.val + (hx (g₁ ≫ i₁ S₁) (g₂ ≫ i₁ S₂) (hi₂ S₁) (hi₂ S₂) (by simp only [category.assoc, h₂, e])) }, + obtain ⟨t, ht, ht'⟩ := hF _ (J.bind_covering hS (λ V i hi, (x i hi).2)) _ this, + refine ⟨⟨t, _⟩, (H ⟨t, _⟩).mpr ht, λ y hy, subtype.ext (ht' _ ((H _).mp hy))⟩, + show G.sieve_of_section t ∈ J _, + refine J.superset_covering _ (J.bind_covering hS (λ V i hi, (x i hi).2)), + intros V i hi, + dsimp, + rw ht _ hi, + exact h₁ hi +end + +lemma subpresheaf.eq_sheafify_iff (h : presieve.is_sheaf J F) : + G = G.sheafify J ↔ presieve.is_sheaf J G.to_presheaf := +⟨λ e, e.symm ▸ G.sheafify_is_sheaf h, G.eq_sheafify h⟩ + +lemma subpresheaf.is_sheaf_iff (h : presieve.is_sheaf J F) : + presieve.is_sheaf J G.to_presheaf ↔ + ∀ U (s : F.obj U), G.sieve_of_section s ∈ J (unop U) → s ∈ G.obj U := +begin + rw ← G.eq_sheafify_iff h, + change _ ↔ G.sheafify J ≤ G, + exact ⟨eq.ge, (G.le_sheafify J).antisymm⟩ +end + +lemma subpresheaf.sheafify_sheafify (h : presieve.is_sheaf J F) : + (G.sheafify J).sheafify J = G.sheafify J := +((subpresheaf.eq_sheafify_iff _ h).mpr $ G.sheafify_is_sheaf h).symm + +/-- The lift of a presheaf morphism onto the sheafification subpresheaf. -/ +noncomputable +def subpresheaf.sheafify_lift (f : G.to_presheaf ⟶ F') (h : presieve.is_sheaf J F') : + (G.sheafify J).to_presheaf ⟶ F' := +{ app := λ U s, + (h _ s.prop).amalgamate _ ((G.family_of_elements_compatible ↑s).comp_presheaf_map f), + naturality' := + begin + intros U V i, + ext s, + apply (h _ ((subpresheaf.sheafify J G).to_presheaf.map i s).prop).is_separated_for.ext, + intros W j hj, + refine (presieve.is_sheaf_for.valid_glue _ _ _ hj).trans _, + dsimp, + conv_rhs { rw ← functor_to_types.map_comp_apply }, + change _ = F'.map (j ≫ i.unop).op _, + refine eq.trans _ (presieve.is_sheaf_for.valid_glue _ _ _ _).symm, + { dsimp at ⊢ hj, rwa functor_to_types.map_comp_apply }, + { dsimp [presieve.family_of_elements.comp_presheaf_map], + congr' 1, + ext1, + exact (functor_to_types.map_comp_apply _ _ _ _).symm } + end } + +lemma subpresheaf.to_sheafify_lift (f : G.to_presheaf ⟶ F') (h : presieve.is_sheaf J F') : + subpresheaf.hom_of_le (G.le_sheafify J) ≫ G.sheafify_lift f h = f := +begin + ext U s, + apply (h _ ((subpresheaf.hom_of_le (G.le_sheafify J)).app U s).prop).is_separated_for.ext, + intros V i hi, + have := elementwise_of f.naturality, + exact (presieve.is_sheaf_for.valid_glue _ _ _ hi).trans (this _ _) +end + +lemma subpresheaf.to_sheafify_lift_unique (h : presieve.is_sheaf J F') + (l₁ l₂ : (G.sheafify J).to_presheaf ⟶ F') + (e : subpresheaf.hom_of_le (G.le_sheafify J) ≫ l₁ = + subpresheaf.hom_of_le (G.le_sheafify J) ≫ l₂) : l₁ = l₂ := +begin + ext U ⟨s, hs⟩, + apply (h _ hs).is_separated_for.ext, + rintros V i hi, + dsimp at hi, + erw [← functor_to_types.naturality, ← functor_to_types.naturality], + exact (congr_fun (congr_app e $ op V) ⟨_, hi⟩ : _) +end + +lemma subpresheaf.sheafify_le (h : G ≤ G') (hF : presieve.is_sheaf J F) + (hG' : presieve.is_sheaf J G'.to_presheaf) : + G.sheafify J ≤ G' := +begin + intros U x hx, + convert ((G.sheafify_lift (subpresheaf.hom_of_le h) hG').app U ⟨x, hx⟩).2, + apply (hF _ hx).is_separated_for.ext, + intros V i hi, + have := congr_arg (λ f : G.to_presheaf ⟶ G'.to_presheaf, (nat_trans.app f (op V) ⟨_, hi⟩).1) + (G.to_sheafify_lift (subpresheaf.hom_of_le h) hG'), + convert this.symm, + erw ← subpresheaf.nat_trans_naturality, + refl, +end + +omit J + +section image + +/-- The image presheaf of a morphism, whose components are the set-theoretic images. -/ +@[simps] +def image_presheaf (f : F' ⟶ F) : subpresheaf F := +{ obj := λ U, set.range (f.app U), + map := λ U V i, + by { rintros _ ⟨x, rfl⟩, have := elementwise_of f.naturality, exact ⟨_, this i x⟩ } } + +@[simp] lemma top_subpresheaf_obj (U) : (⊤ : subpresheaf F).obj U = ⊤ := rfl + +@[simp] +lemma image_presheaf_id : image_presheaf (𝟙 F) = ⊤ := +by { ext, simp } + +/-- A morphism factors through the image presheaf. -/ +@[simps] +def to_image_presheaf (f : F' ⟶ F) : F' ⟶ (image_presheaf f).to_presheaf := +(image_presheaf f).lift f (λ U x, set.mem_range_self _) + +variables (J) + +/-- A morphism factors through the sheafification of the image presheaf. -/ +@[simps] +def to_image_presheaf_sheafify (f : F' ⟶ F) : F' ⟶ ((image_presheaf f).sheafify J).to_presheaf := + to_image_presheaf f ≫ subpresheaf.hom_of_le ((image_presheaf f).le_sheafify J) + +variables {J} + +@[simp, reassoc] +lemma to_image_presheaf_ι (f : F' ⟶ F) : to_image_presheaf f ≫ (image_presheaf f).ι = f := +(image_presheaf f).lift_ι _ _ + +lemma image_presheaf_comp_le (f₁ : F ⟶ F') (f₂ : F' ⟶ F'') : + image_presheaf (f₁ ≫ f₂) ≤ image_presheaf f₂ := +λ U x hx, ⟨f₁.app U hx.some, hx.some_spec⟩ + +instance {F F' : Cᵒᵖ ⥤ Type (max v w)} (f : F ⟶ F') [hf : mono f] : + is_iso (to_image_presheaf f) := +begin + apply_with nat_iso.is_iso_of_is_iso_app { instances := ff }, + intro X, + rw is_iso_iff_bijective, + split, + { intros x y e, + have := (nat_trans.mono_iff_mono_app _ _).mp hf X, + rw mono_iff_injective at this, + exact this (congr_arg subtype.val e : _) }, + { rintro ⟨_, ⟨x, rfl⟩⟩, exact ⟨x, rfl⟩ } +end + +/-- The image sheaf of a morphism between sheaves, defined to be the sheafification of +`image_presheaf`. -/ +@[simps] +def image_sheaf {F F' : Sheaf J (Type w)} (f : F ⟶ F') : Sheaf J (Type w) := +⟨((image_presheaf f.1).sheafify J).to_presheaf, + by { rw is_sheaf_iff_is_sheaf_of_type, apply subpresheaf.sheafify_is_sheaf, + rw ← is_sheaf_iff_is_sheaf_of_type, exact F'.2 }⟩ + +/-- A morphism factors through the image sheaf. -/ +@[simps] +def to_image_sheaf {F F' : Sheaf J (Type w)} (f : F ⟶ F') : F ⟶ image_sheaf f := +⟨to_image_presheaf_sheafify J f.1⟩ + +/-- The inclusion of the image sheaf to the target. -/ +@[simps] +def image_sheaf_ι {F F' : Sheaf J (Type w)} (f : F ⟶ F') : image_sheaf f ⟶ F' := +⟨subpresheaf.ι _⟩ + +@[simp, reassoc] +lemma to_image_sheaf_ι {F F' : Sheaf J (Type w)} (f : F ⟶ F') : + to_image_sheaf f ≫ image_sheaf_ι f = f := +by { ext1, simp [to_image_presheaf_sheafify] } + +instance {F F' : Sheaf J (Type w)} (f : F ⟶ F') : mono (image_sheaf_ι f) := +(Sheaf_to_presheaf J _).mono_of_mono_map (by { dsimp, apply_instance }) + +instance {F F' : Sheaf J (Type w)} (f : F ⟶ F') : epi (to_image_sheaf f) := +begin + refine ⟨λ G' g₁ g₂ e, _⟩, + ext U ⟨s, hx⟩, + apply ((is_sheaf_iff_is_sheaf_of_type J _).mp G'.2 _ hx).is_separated_for.ext, + rintros V i ⟨y, e'⟩, + change (g₁.val.app _ ≫ G'.val.map _) _ = (g₂.val.app _ ≫ G'.val.map _) _, + rw [← nat_trans.naturality, ← nat_trans.naturality], + have E : (to_image_sheaf f).val.app (op V) y = + (image_sheaf f).val.map i.op ⟨s, hx⟩ := subtype.ext e', + have := congr_arg (λ f : F ⟶ G', (Sheaf.hom.val f).app _ y) e, + dsimp at this ⊢, + convert this; exact E.symm +end + +/-- The mono factorization given by `image_sheaf` for a morphism. -/ +def image_mono_factorization {F F' : Sheaf J (Type w)} (f : F ⟶ F') : + limits.mono_factorisation f := +{ I := image_sheaf f, + m := image_sheaf_ι f, + e := to_image_sheaf f } + +/-- The mono factorization given by `image_sheaf` for a morphism is an image. -/ +noncomputable +def image_factorization {F F' : Sheaf J (Type (max v u))} (f : F ⟶ F') : + limits.image_factorisation f := +{ F := image_mono_factorization f, + is_image := + { lift := λ I, begin + haveI := (Sheaf.hom.mono_iff_presheaf_mono J _ _).mp I.m_mono, + refine ⟨subpresheaf.hom_of_le _ ≫ inv (to_image_presheaf I.m.1)⟩, + apply subpresheaf.sheafify_le, + { conv_lhs { rw ← I.fac }, apply image_presheaf_comp_le }, + { rw ← is_sheaf_iff_is_sheaf_of_type, exact F'.2 }, + { apply presieve.is_sheaf_iso J (as_iso $ to_image_presheaf I.m.1), + rw ← is_sheaf_iff_is_sheaf_of_type, exact I.I.2 } + end, + lift_fac' := λ I, begin + ext1, + dsimp [image_mono_factorization], + generalize_proofs h, + rw [← subpresheaf.hom_of_le_ι h, category.assoc], + congr' 1, + rw [is_iso.inv_comp_eq, to_image_presheaf_ι], + end } } + +instance : limits.has_images (Sheaf J (Type (max v u))) := +⟨λ _ _ f, ⟨⟨image_factorization f⟩⟩⟩ + +end image + +end category_theory.grothendieck_topology diff --git a/src/category_theory/sites/surjective.lean b/src/category_theory/sites/surjective.lean new file mode 100644 index 0000000000000..ecaac4b81c737 --- /dev/null +++ b/src/category_theory/sites/surjective.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ +import category_theory.sites.subsheaf +import category_theory.sites.compatible_sheafification + +/-! + +# Locally surjective morphisms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +- `is_locally_surjective` : A morphism of presheaves valued in a concrete category is locally + surjective with respect to a grothendieck topology if every section in the target is locally + in the set-theoretic image, i.e. the image sheaf coincides with the target. + +## Main results + +- `to_sheafify_is_locally_surjective` : `to_sheafify` is locally surjective. + +-/ + +universes v u w v' u' w' + +open opposite category_theory category_theory.grothendieck_topology + +namespace category_theory + +variables {C : Type u} [category.{v} C] (J : grothendieck_topology C) + +local attribute [instance] concrete_category.has_coe_to_sort concrete_category.has_coe_to_fun + +variables {A : Type u'} [category.{v'} A] [concrete_category.{w'} A] + +/-- Given `f : F ⟶ G`, a morphism between presieves, and `s : G.obj (op U)`, this is the sieve +of `U` consisting of the `i : V ⟶ U` such that `s` restricted along `i` is in the image of `f`. -/ +@[simps (lemmas_only)] +def image_sieve {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) {U : C} (s : G.obj (op U)) : sieve U := +{ arrows := λ V i, ∃ t : F.obj (op V), f.app _ t = G.map i.op s, + downward_closed' := begin + rintros V W i ⟨t, ht⟩ j, + refine ⟨F.map j.op t, _⟩, + rw [op_comp, G.map_comp, comp_apply, ← ht, elementwise_of f.naturality], + end } + +lemma image_sieve_eq_sieve_of_section {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) {U : C} (s : G.obj (op U)) : + image_sieve f s = (image_presheaf (whisker_right f (forget A))).sieve_of_section s := rfl + +lemma image_sieve_whisker_forget {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) {U : C} (s : G.obj (op U)) : + image_sieve (whisker_right f (forget A)) s = image_sieve f s := rfl + +lemma image_sieve_app {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) {U : C} (s : F.obj (op U)) : + image_sieve f (f.app _ s) = ⊤ := +begin + ext V i, + simp only [sieve.top_apply, iff_true, image_sieve_apply], + have := elementwise_of (f.naturality i.op), + exact ⟨F.map i.op s, this s⟩, +end + +/-- A morphism of presheaves `f : F ⟶ G` is locally surjective with respect to a grothendieck +topology if every section of `G` is locally in the image of `f`. -/ +def is_locally_surjective {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) : Prop := +∀ (U : C) (s : G.obj (op U)), image_sieve f s ∈ J U + +lemma is_locally_surjective_iff_image_presheaf_sheafify_eq_top {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) : + is_locally_surjective J f ↔ (image_presheaf (whisker_right f (forget A))).sheafify J = ⊤ := +begin + simp only [subpresheaf.ext_iff, function.funext_iff, set.ext_iff, top_subpresheaf_obj, + set.top_eq_univ, set.mem_univ, iff_true], + exact ⟨λ H U, H (unop U), λ H U, H (op U)⟩ +end + +lemma is_locally_surjective_iff_image_presheaf_sheafify_eq_top' + {F G : Cᵒᵖ ⥤ (Type w)} (f : F ⟶ G) : + is_locally_surjective J f ↔ (image_presheaf f).sheafify J = ⊤ := +begin + simp only [subpresheaf.ext_iff, function.funext_iff, set.ext_iff, top_subpresheaf_obj, + set.top_eq_univ, set.mem_univ, iff_true], + exact ⟨λ H U, H (unop U), λ H U, H (op U)⟩ +end + +lemma is_locally_surjective_iff_is_iso + {F G : Sheaf J (Type w)} (f : F ⟶ G) : + is_locally_surjective J f.1 ↔ is_iso (image_sheaf_ι f) := +begin + rw [image_sheaf_ι, is_locally_surjective_iff_image_presheaf_sheafify_eq_top', + subpresheaf.eq_top_iff_is_iso], + exact ⟨λ h, @@is_iso_of_reflects_iso _ _ (image_sheaf_ι f) (Sheaf_to_presheaf J _) h _, + λ h, @@functor.map_is_iso _ _ (Sheaf_to_presheaf J _) _ h⟩, +end + +lemma is_locally_surjective_iff_whisker_forget {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) : + is_locally_surjective J f ↔ is_locally_surjective J (whisker_right f (forget A)) := +begin + simpa only [is_locally_surjective_iff_image_presheaf_sheafify_eq_top] +end + +lemma is_locally_surjective_of_surjective {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) + (H : ∀ U, function.surjective (f.app U)) : is_locally_surjective J f := +begin + intros U s, + obtain ⟨t, rfl⟩ := H _ s, + rw image_sieve_app, + exact J.top_mem _ +end + +lemma is_locally_surjective_of_iso {F G : Cᵒᵖ ⥤ A} (f : F ⟶ G) [is_iso f] : + is_locally_surjective J f := +begin + apply is_locally_surjective_of_surjective, + intro U, + apply function.bijective.surjective, + rw ← is_iso_iff_bijective, + apply_instance +end + +lemma is_locally_surjective.comp {F₁ F₂ F₃ : Cᵒᵖ ⥤ A} {f₁ : F₁ ⟶ F₂} {f₂ : F₂ ⟶ F₃} + (h₁ : is_locally_surjective J f₁) (h₂ : is_locally_surjective J f₂) : + is_locally_surjective J (f₁ ≫ f₂) := +begin + intros U s, + have : sieve.bind (image_sieve f₂ s) (λ _ _ h, image_sieve f₁ h.some) ≤ image_sieve (f₁ ≫ f₂) s, + { rintros V i ⟨W, i, j, H, ⟨t', ht'⟩, rfl⟩, + refine ⟨t', _⟩, + rw [op_comp, F₃.map_comp, nat_trans.comp_app, comp_apply, comp_apply, ht', + elementwise_of f₂.naturality, H.some_spec] }, + apply J.superset_covering this, + apply J.bind_covering, + { apply h₂ }, + { intros, apply h₁ } +end + +section + +variables (F : Cᵒᵖ ⥤ Type (max u v)) + +/-- The image of `F` in `J.sheafify F` is isomorphic to the sheafification. -/ +noncomputable +def sheafification_iso_image_presheaf : + J.sheafify F ≅ ((image_presheaf (J.to_sheafify F)).sheafify J).to_presheaf := +{ hom := J.sheafify_lift (to_image_presheaf_sheafify J _) + ((is_sheaf_iff_is_sheaf_of_type J _).mpr $ subpresheaf.sheafify_is_sheaf _ $ + (is_sheaf_iff_is_sheaf_of_type J _).mp $ sheafify_is_sheaf J _), + inv := subpresheaf.ι _, + hom_inv_id' := J.sheafify_hom_ext _ _ (J.sheafify_is_sheaf _) + (by simp [to_image_presheaf_sheafify]), + inv_hom_id' := begin + rw [← cancel_mono (subpresheaf.ι _), category.id_comp, category.assoc], + refine eq.trans _ (category.comp_id _), + congr' 1, + exact J.sheafify_hom_ext _ _ (J.sheafify_is_sheaf _) (by simp [to_image_presheaf_sheafify]), + apply_instance + end } + +-- We need to sheafify +variables {B : Type w} [category.{max u v} B] + [concrete_category.{max u v} B] + [∀ (X : C), limits.has_colimits_of_shape (J.cover X)ᵒᵖ B] + [∀ (P : Cᵒᵖ ⥤ B) (X : C) (S : J.cover X), limits.has_multiequalizer (S.index P)] + [Π (X : C) (W : J.cover X) (P : Cᵒᵖ ⥤ B), + limits.preserves_limit (W.index P).multicospan (forget B)] + [Π (X : C), limits.preserves_colimits_of_shape (J.cover X)ᵒᵖ (forget B)] + [∀ (α β : Type (max u v)) (fst snd : β → α), + limits.has_limits_of_shape (limits.walking_multicospan fst snd) B] + +lemma to_sheafify_is_locally_surjective (F : Cᵒᵖ ⥤ B) : + is_locally_surjective J (J.to_sheafify F) := +begin + rw [is_locally_surjective_iff_whisker_forget, ← to_sheafify_comp_sheafify_comp_iso_inv], + apply is_locally_surjective.comp, + { rw [is_locally_surjective_iff_image_presheaf_sheafify_eq_top, subpresheaf.eq_top_iff_is_iso], + exact is_iso.of_iso_inv (sheafification_iso_image_presheaf J (F ⋙ forget B)) }, + { exact is_locally_surjective_of_iso _ _ } +end + +end + +end category_theory diff --git a/src/category_theory/sites/types.lean b/src/category_theory/sites/types.lean index dcbea865d72c1..1c5d7b81c911c 100644 --- a/src/category_theory/sites/types.lean +++ b/src/category_theory/sites/types.lean @@ -9,6 +9,9 @@ import category_theory.sites.canonical /-! # Grothendieck Topology and Sheaves on the Category of Types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define a Grothendieck topology on the category of types, and construct the canonical functor that sends a type to a sheaf over the category of types, and make this an equivalence of categories. diff --git a/src/category_theory/sites/whiskering.lean b/src/category_theory/sites/whiskering.lean index 595368886b0d1..c437b9d5be03c 100644 --- a/src/category_theory/sites/whiskering.lean +++ b/src/category_theory/sites/whiskering.lean @@ -7,6 +7,9 @@ Authors: Adam Topaz import category_theory.sites.sheaf /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we construct the functor `Sheaf J A ⥤ Sheaf J B` between sheaf categories obtained by composition with a functor `F : A ⥤ B`. diff --git a/src/category_theory/skeletal.lean b/src/category_theory/skeletal.lean index 3695508690f72..7411364ac96e5 100644 --- a/src/category_theory/skeletal.lean +++ b/src/category_theory/skeletal.lean @@ -3,6 +3,7 @@ Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta -/ +import category_theory.adjunction.basic import category_theory.category.preorder import category_theory.isomorphism_classes import category_theory.thin @@ -10,6 +11,9 @@ import category_theory.thin /-! # Skeleton of a category +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Define skeletal categories as categories in which any two isomorphic objects are equal. Construct the skeleton of an arbitrary category by taking isomorphism classes, and show it is a @@ -47,7 +51,7 @@ local attribute [instance] is_isomorphic_setoid variables {C D} /-- If `C` is thin and skeletal, then any naturally isomorphic functors to `C` are equal. -/ -lemma functor.eq_of_iso {F₁ F₂ : D ⥤ C} [∀ X Y : C, subsingleton (X ⟶ Y)] (hC : skeletal C) +lemma functor.eq_of_iso {F₁ F₂ : D ⥤ C} [quiver.is_thin C] (hC : skeletal C) (hF : F₁ ≅ F₂) : F₁ = F₂ := functor.ext (λ X, hC ⟨hF.app X⟩) (λ _ _ _, subsingleton.elim _ _) @@ -55,7 +59,7 @@ functor.ext (λ X, hC ⟨hF.app X⟩) (λ _ _ _, subsingleton.elim _ _) If `C` is thin and skeletal, `D ⥤ C` is skeletal. `category_theory.functor_thin` shows it is thin also. -/ -lemma functor_skeletal [∀ X Y : C, subsingleton (X ⟶ Y)] (hC : skeletal C) : skeletal (D ⥤ C) := +lemma functor_skeletal [quiver.is_thin C] (hC : skeletal C) : skeletal (D ⥤ C) := λ F₁ F₂ h, h.elim (functor.eq_of_iso hC) variables (C D) @@ -147,8 +151,8 @@ some of the statements can be shown without this assumption. namespace thin_skeleton /-- The thin skeleton is thin. -/ -instance thin {X Y : thin_skeleton C} : subsingleton (X ⟶ Y) := -⟨by { rintros ⟨⟨f₁⟩⟩ ⟨⟨f₂⟩⟩, refl }⟩ +instance thin : quiver.is_thin (thin_skeleton C) := +λ _ _, ⟨by { rintros ⟨⟨f₁⟩⟩ ⟨⟨f₂⟩⟩, refl }⟩ variables {C} {D} @@ -186,7 +190,7 @@ def map₂ (F : C ⥤ D ⥤ E) : variables (C) section -variables [∀ X Y : C, subsingleton (X ⟶ Y)] +variables [quiver.is_thin C] instance to_thin_skeleton_faithful : faithful (to_thin_skeleton C) := {} @@ -286,7 +290,7 @@ the `thin_skeleton C` is order isomorphic to `α`. -/ noncomputable def equivalence.thin_skeleton_order_iso - [∀ X Y : C, subsingleton (X ⟶ Y)] (e : C ≌ α) : thin_skeleton C ≃o α := + [quiver.is_thin C] (e : C ≌ α) : thin_skeleton C ≃o α := ((thin_skeleton.equivalence C).trans e).to_order_iso end diff --git a/src/category_theory/structured_arrow.lean b/src/category_theory/structured_arrow.lean index 5158fe858211c..29df20ca72fdc 100644 --- a/src/category_theory/structured_arrow.lean +++ b/src/category_theory/structured_arrow.lean @@ -6,10 +6,14 @@ Authors: Adam Topaz, Scott Morrison import category_theory.punit import category_theory.comma import category_theory.limits.shapes.terminal +import category_theory.essentially_small /-! # The category of "structured arrows" +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For `T : C ⥤ D`, a `T`-structured arrow with source `S : D` is just a morphism `S ⟶ T.obj Y`, for some `Y : C`. @@ -29,7 +33,7 @@ The category of `T`-structured arrows with domain `S : D` (here `T : C ⥤ D`), has as its objects `D`-morphisms of the form `S ⟶ T Y`, for some `Y : C`, and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def structured_arrow (S : D) (T : C ⥤ D) := comma (functor.from_punit S) T namespace structured_arrow @@ -41,18 +45,15 @@ def proj (S : D) (T : C ⥤ D) : structured_arrow S T ⥤ C := comma.snd _ _ variables {S S' S'' : D} {Y Y' : C} {T : C ⥤ D} /-- Construct a structured arrow from a morphism. -/ -def mk (f : S ⟶ T.obj Y) : structured_arrow S T := ⟨⟨⟩, Y, f⟩ +def mk (f : S ⟶ T.obj Y) : structured_arrow S T := ⟨⟨⟨⟩⟩, Y, f⟩ -@[simp] lemma mk_left (f : S ⟶ T.obj Y) : (mk f).left = punit.star := rfl +@[simp] lemma mk_left (f : S ⟶ T.obj Y) : (mk f).left = ⟨⟨⟩⟩ := rfl @[simp] lemma mk_right (f : S ⟶ T.obj Y) : (mk f).right = Y := rfl @[simp] lemma mk_hom_eq_self (f : S ⟶ T.obj Y) : (mk f).hom = f := rfl @[simp, reassoc] lemma w {A B : structured_arrow S T} (f : A ⟶ B) : A.hom ≫ T.map f.right = B.hom := by { have := f.w; tidy } -lemma eq_mk (f : structured_arrow S T) : f = mk f.hom := -by { cases f, congr, ext, } - /-- To construct a morphism of structured arrows, we need a morphism of the objects underlying the target, @@ -71,7 +72,7 @@ structured arrow given by `(X ⟶ F(U)) ⟶ (X ⟶ F(U) ⟶ F(Y))`. -/ def hom_mk' {F : C ⥤ D} {X : D} {Y : C} (U : structured_arrow X F) (f : U.right ⟶ Y) : -U ⟶ mk (U.hom ≫ F.map f) := { right := f } +U ⟶ mk (U.hom ≫ F.map f) := { left := eq_to_hom (by ext), right := f } /-- To construct an isomorphism of structured arrows, @@ -81,7 +82,41 @@ and to check that the triangle commutes. @[simps] def iso_mk {f f' : structured_arrow S T} (g : f.right ≅ f'.right) (w : f.hom ≫ T.map g.hom = f'.hom) : f ≅ f' := -comma.iso_mk (eq_to_iso (by ext)) g (by simpa using w.symm) +comma.iso_mk (eq_to_iso (by ext)) g (by simpa [eq_to_hom_map] using w.symm) + +lemma ext {A B : structured_arrow S T} (f g : A ⟶ B) : f.right = g.right → f = g := +comma_morphism.ext _ _ (subsingleton.elim _ _) + +lemma ext_iff {A B : structured_arrow S T} (f g : A ⟶ B) : f = g ↔ f.right = g.right := +⟨λ h, h ▸ rfl, ext f g⟩ + +instance proj_faithful : faithful (proj S T) := +{ map_injective' := λ X Y, ext } + +/-- The converse of this is true with additional assumptions, see `mono_iff_mono_right`. -/ +lemma mono_of_mono_right {A B : structured_arrow S T} (f : A ⟶ B) [h : mono f.right] : mono f := +(proj S T).mono_of_mono_map h + +lemma epi_of_epi_right {A B : structured_arrow S T} (f : A ⟶ B) [h : epi f.right] : epi f := +(proj S T).epi_of_epi_map h + +instance mono_hom_mk {A B : structured_arrow S T} (f : A.right ⟶ B.right) (w) [h : mono f] : + mono (hom_mk f w) := +(proj S T).mono_of_mono_map h + +instance epi_hom_mk {A B : structured_arrow S T} (f : A.right ⟶ B.right) (w) [h : epi f] : + epi (hom_mk f w) := +(proj S T).epi_of_epi_map h + +/-- Eta rule for structured arrows. Prefer `structured_arrow.eta`, since equality of objects tends + to cause problems. -/ +lemma eq_mk (f : structured_arrow S T) : f = mk f.hom := +by { cases f, congr, ext, } + +/-- Eta rule for structured arrows. -/ +@[simps] +def eta (f : structured_arrow S T) : f ≅ mk f.hom := +iso_mk (iso.refl _) (by tidy) /-- A morphism between source objects `S ⟶ S'` @@ -112,6 +147,8 @@ instance proj_reflects_iso : reflects_isomorphisms (proj S T) := open category_theory.limits +local attribute [tidy] tactic.discrete_cases + /-- The identity structured arrow is initial. -/ def mk_id_initial [full T] [faithful T] : is_initial (mk (𝟙 (T.obj Y))) := { desc := λ c, hom_mk (T.preimage c.X.hom) (by { dsimp, simp, }), @@ -131,9 +168,17 @@ comma.pre_right _ F G /-- The functor `(S, F) ⥤ (G(S), F ⋙ G)`. -/ @[simps] def post (S : C) (F : B ⥤ C) (G : C ⥤ D) : structured_arrow S F ⥤ structured_arrow (G.obj S) (F ⋙ G) := -{ obj := λ X, { right := X.right, hom := G.map X.hom }, - map := λ X Y f, { right := f.right, w' := - by { simp [functor.comp_map, ←G.map_comp, ← f.w] } } } +{ obj := λ X, structured_arrow.mk (G.map X.hom), + map := λ X Y f, structured_arrow.hom_mk f.right + (by simp [functor.comp_map, ←G.map_comp, ← f.w]) } + +instance small_proj_preimage_of_locally_small {𝒢 : set C} [small.{v₁} 𝒢] [locally_small.{v₁} D] : + small.{v₁} ((proj S T).obj ⁻¹' 𝒢) := +begin + suffices : (proj S T).obj ⁻¹' 𝒢 = set.range (λ f : Σ G : 𝒢, S ⟶ T.obj G, mk f.2), + { rw this, apply_instance }, + exact set.ext (λ X, ⟨λ h, ⟨⟨⟨_, h⟩, X.hom⟩, (eq_mk _).symm⟩, by tidy⟩) +end end structured_arrow @@ -143,7 +188,7 @@ The category of `S`-costructured arrows with target `T : D` (here `S : C ⥤ D`) has as its objects `D`-morphisms of the form `S Y ⟶ T`, for some `Y : C`, and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute. -/ -@[derive category, nolint has_inhabited_instance] +@[derive category, nolint has_nonempty_instance] def costructured_arrow (S : C ⥤ D) (T : D) := comma S (functor.from_punit T) namespace costructured_arrow @@ -155,19 +200,16 @@ def proj (S : C ⥤ D) (T : D) : costructured_arrow S T ⥤ C := comma.fst _ _ variables {T T' T'' : D} {Y Y' : C} {S : C ⥤ D} /-- Construct a costructured arrow from a morphism. -/ -def mk (f : S.obj Y ⟶ T) : costructured_arrow S T := ⟨Y, ⟨⟩, f⟩ +def mk (f : S.obj Y ⟶ T) : costructured_arrow S T := ⟨Y, ⟨⟨⟩⟩, f⟩ @[simp] lemma mk_left (f : S.obj Y ⟶ T) : (mk f).left = Y := rfl -@[simp] lemma mk_right (f : S.obj Y ⟶ T) : (mk f).right = punit.star := rfl +@[simp] lemma mk_right (f : S.obj Y ⟶ T) : (mk f).right = ⟨⟨⟩⟩ := rfl @[simp] lemma mk_hom_eq_self (f : S.obj Y ⟶ T) : (mk f).hom = f := rfl @[simp, reassoc] lemma w {A B : costructured_arrow S T} (f : A ⟶ B) : S.map f.left ≫ B.hom = A.hom := by tidy -lemma eq_mk (f : costructured_arrow S T) : f = mk f.hom := -by { cases f, congr, ext, } - /-- To construct a morphism of costructured arrows, we need a morphism of the objects underlying the source, @@ -178,7 +220,7 @@ def hom_mk {f f' : costructured_arrow S T} (g : f.left ⟶ f'.left) (w : S.map g f ⟶ f' := { left := g, right := eq_to_hom (by ext), - w' := by simpa using w, } + w' := by simpa [eq_to_hom_map] using w, } /-- To construct an isomorphism of costructured arrows, @@ -188,7 +230,41 @@ and to check that the triangle commutes. @[simps] def iso_mk {f f' : costructured_arrow S T} (g : f.left ≅ f'.left) (w : S.map g.hom ≫ f'.hom = f.hom) : f ≅ f' := -comma.iso_mk g (eq_to_iso (by ext)) (by simpa using w) +comma.iso_mk g (eq_to_iso (by ext)) (by simpa [eq_to_hom_map] using w) + +lemma ext {A B : costructured_arrow S T} (f g : A ⟶ B) (h : f.left = g.left) : f = g := +comma_morphism.ext _ _ h (subsingleton.elim _ _) + +lemma ext_iff {A B : costructured_arrow S T} (f g : A ⟶ B) : f = g ↔ f.left = g.left := +⟨λ h, h ▸ rfl, ext f g⟩ + +instance proj_faithful : faithful (proj S T) := +{ map_injective' := λ X Y, ext } + +lemma mono_of_mono_left {A B : costructured_arrow S T} (f : A ⟶ B) [h : mono f.left] : mono f := +(proj S T).mono_of_mono_map h + +/-- The converse of this is true with additional assumptions, see `epi_iff_epi_left`. -/ +lemma epi_of_epi_left {A B : costructured_arrow S T} (f : A ⟶ B) [h : epi f.left] : epi f := +(proj S T).epi_of_epi_map h + +instance mono_hom_mk {A B : costructured_arrow S T} (f : A.left ⟶ B.left) (w) [h : mono f] : + mono (hom_mk f w) := +(proj S T).mono_of_mono_map h + +instance epi_hom_mk {A B : costructured_arrow S T} (f : A.left ⟶ B.left) (w) [h : epi f] : + epi (hom_mk f w) := +(proj S T).epi_of_epi_map h + +/-- Eta rule for costructured arrows. Prefer `costructured_arrow.eta`, as equality of objects tends + to cause problems. -/ +lemma eq_mk (f : costructured_arrow S T) : f = mk f.hom := +by { cases f, congr, ext, } + +/-- Eta rule for costructured arrows. -/ +@[simps] +def eta (f : costructured_arrow S T) : f ≅ mk f.hom := +iso_mk (iso.refl _) (by tidy) /-- A morphism between target objects `T ⟶ T'` @@ -219,6 +295,8 @@ instance proj_reflects_iso : reflects_isomorphisms (proj S T) := open category_theory.limits +local attribute [tidy] tactic.discrete_cases + /-- The identity costructured arrow is terminal. -/ def mk_id_terminal [full S] [faithful S] : is_terminal (mk (𝟙 (S.obj Y))) := { lift := λ c, hom_mk (S.preimage c.X.hom) (by { dsimp, simp, }), @@ -240,9 +318,17 @@ comma.pre_left F G _ /-- The functor `(F, S) ⥤ (F ⋙ G, G(S))`. -/ @[simps] def post (F : B ⥤ C) (G : C ⥤ D) (S : C) : costructured_arrow F S ⥤ costructured_arrow (F ⋙ G) (G.obj S) := -{ obj := λ X, { left := X.left, hom := G.map X.hom }, - map := λ X Y f, { left := f.left, w' := - by { simp [functor.comp_map, ←G.map_comp, ← f.w] } } } +{ obj := λ X, costructured_arrow.mk (G.map X.hom), + map := λ X Y f, costructured_arrow.hom_mk f.left + (by simp [functor.comp_map, ←G.map_comp, ← f.w]), } + +instance small_proj_preimage_of_locally_small {𝒢 : set C} [small.{v₁} 𝒢] [locally_small.{v₁} D] : + small.{v₁} ((proj S T).obj ⁻¹' 𝒢) := +begin + suffices : (proj S T).obj ⁻¹' 𝒢 = set.range (λ f : Σ G : 𝒢, S.obj G ⟶ T, mk f.2), + { rw this, apply_instance }, + exact set.ext (λ X, ⟨λ h, ⟨⟨⟨_, h⟩, X.hom⟩, (eq_mk _).symm⟩, by tidy⟩) +end end costructured_arrow @@ -262,7 +348,7 @@ def to_costructured_arrow (F : C ⥤ D) (d : D) : map := λ X Y f, costructured_arrow.hom_mk (f.unop.right.op) begin dsimp, - rw [← op_comp, ← f.unop.w, functor.const.obj_map], + rw [← op_comp, ← f.unop.w, functor.const_obj_map], erw category.id_comp, end } @@ -279,7 +365,7 @@ def to_costructured_arrow' (F : C ⥤ D) (d : D) : begin dsimp, rw [← quiver.hom.unop_op (F.map (quiver.hom.unop f.unop.right)), ← unop_comp, ← F.op_map, - ← f.unop.w, functor.const.obj_map], + ← f.unop.w, functor.const_obj_map], erw category.id_comp, end } @@ -299,7 +385,7 @@ def to_structured_arrow (F : C ⥤ D) (d : D) : map := λ X Y f, structured_arrow.hom_mk f.unop.left.op begin dsimp, - rw [← op_comp, f.unop.w, functor.const.obj_map], + rw [← op_comp, f.unop.w, functor.const_obj_map], erw category.comp_id, end } @@ -316,7 +402,7 @@ def to_structured_arrow' (F : C ⥤ D) (d : D) : begin dsimp, rw [← quiver.hom.unop_op (F.map f.unop.left.unop), ← unop_comp, ← F.op_map, - f.unop.w, functor.const.obj_map], + f.unop.w, functor.const_obj_map], erw category.comp_id, end } diff --git a/src/category_theory/subobject/basic.lean b/src/category_theory/subobject/basic.lean index 5a8913a0d8811..c32132d2d2711 100644 --- a/src/category_theory/subobject/basic.lean +++ b/src/category_theory/subobject/basic.lean @@ -5,12 +5,16 @@ Authors: Bhavik Mehta, Scott Morrison -/ import category_theory.subobject.mono_over import category_theory.skeletal -import tactic.elementwise +import category_theory.concrete_category.basic import tactic.apply_fun +import tactic.elementwise /-! # Subobjects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `subobject X` as the quotient (by isomorphisms) of `mono_over X := {f : over X // mono f.hom}`. @@ -98,6 +102,43 @@ namespace subobject abbreviation mk {X A : C} (f : A ⟶ X) [mono f] : subobject X := (to_thin_skeleton _).obj (mono_over.mk' f) +section +local attribute [ext] category_theory.comma + +protected lemma ind {X : C} (p : subobject X → Prop) + (h : ∀ ⦃A : C⦄ (f : A ⟶ X) [mono f], by exactI p (subobject.mk f)) (P : subobject X) : p P := +begin + apply quotient.induction_on', + intro a, + convert h a.arrow, + ext; refl +end + +protected lemma ind₂ {X : C} (p : subobject X → subobject X → Prop) + (h : ∀ ⦃A B : C⦄ (f : A ⟶ X) (g : B ⟶ X) [mono f] [mono g], + by exactI p (subobject.mk f) (subobject.mk g)) (P Q : subobject X) : p P Q := +begin + apply quotient.induction_on₂', + intros a b, + convert h a.arrow b.arrow; + ext; refl +end + +end + +/-- Declare a function on subobjects of `X` by specifying a function on monomorphisms with + codomain `X`. -/ +protected def lift {α : Sort*} {X : C} (F : Π ⦃A : C⦄ (f : A ⟶ X) [mono f], α) + (h : ∀ ⦃A B : C⦄ (f : A ⟶ X) (g : B ⟶ X) [mono f] [mono g] (i : A ≅ B), + i.hom ≫ g = f → by exactI F f = F g) : subobject X → α := +λ P, quotient.lift_on' P (λ m, by exactI F m.arrow) $ λ m n ⟨i⟩, + h m.arrow n.arrow ((mono_over.forget X ⋙ over.forget X).map_iso i) (over.w i.hom) + +@[simp] +protected lemma lift_mk {α : Sort*} {X : C} (F : Π ⦃A : C⦄ (f : A ⟶ X) [mono f], α) {h A} + (f : A ⟶ X) [mono f] : subobject.lift F h (subobject.mk f) = F f := +rfl + /-- The category of subobjects is equivalent to the `mono_over` category. It is more convenient to use the former due to the partial order instance, but oftentimes it is easier to define structures on the latter. -/ @@ -149,7 +190,7 @@ The morphism in `C` from the arbitrarily chosen underlying object to the ambient -/ noncomputable def arrow {X : C} (Y : subobject X) : (Y : C) ⟶ X := -(representative.obj Y).val.hom +(representative.obj Y).obj.hom instance arrow_mono {X : C} (Y : subobject X) : mono (Y.arrow) := (representative.obj Y).property diff --git a/src/category_theory/subobject/comma.lean b/src/category_theory/subobject/comma.lean new file mode 100644 index 0000000000000..3c74b8cf0034c --- /dev/null +++ b/src/category_theory/subobject/comma.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2022 Markus Himmel. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Markus Himmel +-/ +import category_theory.subobject.well_powered +import category_theory.limits.preserves.finite +import category_theory.limits.shapes.finite_limits + +/-! +# Subobjects in the category of structured arrows + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We compute the subobjects of an object `A` in the category `structured_arrow S T` for `T : C ⥤ D` +and `S : D` as a subtype of the subobjects of `A.right`. We deduce that `structured_arrow S T` is +well-powered if `C` is. + +## Main declarations +* `structured_arrow.equiv_subtype`: the order-equivalence between `subobject A` and a subtype of + `subobject A.right`. + +## Implementation notes +Our computation requires that `C` has all limits and `T` preserves all limits. Furthermore, we +require that the morphisms of `C` and `D` are in the same universe. It is possible that both of +these requirements can be relaxed by refining the results about limits in comma categories. + +We also provide the dual results. As usual, we use `subobject (op A)` for the quotient objects of +`A`. + +-/ + +noncomputable theory + +open category_theory.limits opposite + +universes v u₁ u₂ + +namespace category_theory +variables {C : Type u₁} [category.{v} C] {D : Type u₂} [category.{v} D] + +namespace structured_arrow +variables {S : D} {T : C ⥤ D} + +/-- Every subobject of a structured arrow can be projected to a subobject of the underlying + object. -/ +def project_subobject [has_limits C] [preserves_limits T] {A : structured_arrow S T} : + subobject A → subobject A.right := +begin + refine subobject.lift (λ P f hf, by exactI subobject.mk f.right) _, + introsI P Q f g hf hg i hi, + refine subobject.mk_eq_mk_of_comm _ _ ((proj S T).map_iso i) _, + exact congr_arg comma_morphism.right hi +end + +@[simp] +lemma project_subobject_mk [has_limits C] [preserves_limits T] {A P : structured_arrow S T} + (f : P ⟶ A) [mono f] : project_subobject (subobject.mk f) = subobject.mk f.right := +rfl + +lemma project_subobject_factors [has_limits C] [preserves_limits T] {A : structured_arrow S T} : + ∀ P : subobject A, ∃ q, q ≫ T.map (project_subobject P).arrow = A.hom := +subobject.ind _ $ λ P f hf, + ⟨P.hom ≫ T.map (subobject.underlying_iso _).inv, by { dsimp, simp [← T.map_comp] }⟩ + +/-- A subobject of the underlying object of a structured arrow can be lifted to a subobject of + the structured arrow, provided that there is a morphism making the subobject into a structured + arrow. -/ +@[simp] +def lift_subobject {A : structured_arrow S T} (P : subobject A.right) {q} + (hq : q ≫ T.map P.arrow = A.hom) : subobject A := +subobject.mk (hom_mk P.arrow hq : mk q ⟶ A) + +/-- Projecting and then lifting a subobject recovers the original subobject, because there is at + most one morphism making the projected subobject into a structured arrow. -/ +lemma lift_project_subobject [has_limits C] [preserves_limits T] {A : structured_arrow S T} : + ∀ (P : subobject A) {q} (hq : q ≫ T.map (project_subobject P).arrow = A.hom), + lift_subobject (project_subobject P) hq = P := subobject.ind _ +begin + introsI P f hf q hq, + fapply subobject.mk_eq_mk_of_comm, + { fapply iso_mk, + { exact subobject.underlying_iso _ }, + { exact (cancel_mono (T.map f.right)).1 (by { dsimp, simpa [← T.map_comp] using hq }) } }, + { exact ext _ _ (by { dsimp, simp })} +end + +/-- If `A : S → T.obj B` is a structured arrow for `S : D` and `T : C ⥤ D`, then we can explicitly + describe the subobjects of `A` as the subobjects `P` of `B` in `C` for which `A.hom` factors + through the image of `P` under `T`. -/ +@[simps] +def subobject_equiv [has_limits C] [preserves_limits T] (A : structured_arrow S T) : + subobject A ≃o { P : subobject A.right // ∃ q, q ≫ T.map P.arrow = A.hom } := +{ to_fun := λ P, ⟨project_subobject P, project_subobject_factors P⟩, + inv_fun := λ P, lift_subobject P.val P.prop.some_spec, + left_inv := λ P, lift_project_subobject _ _, + right_inv := λ P, subtype.ext (by simp), + map_rel_iff' := subobject.ind₂ _ + begin + introsI P Q f g hf hg, + refine ⟨λ h, subobject.mk_le_mk_of_comm _ (ext _ _ _), λ h, _⟩, + { refine hom_mk (subobject.of_mk_le_mk _ _ h) ((cancel_mono (T.map g.right)).1 _), + simp [← T.map_comp] }, + { simp only [mono_over.mk'_arrow, subobject.of_mk_le_mk_comp, comma.comp_right, hom_mk_right] }, + { refine subobject.mk_le_mk_of_comm (subobject.of_mk_le_mk _ _ h).right _, + exact congr_arg comma_morphism.right (subobject.of_mk_le_mk_comp h) } + end } + +/-- If `C` is well-powered and complete and `T` preserves limits, then `structured_arrow S T` is + well-powered. -/ +instance well_powered_structured_arrow [well_powered C] [has_limits C] [preserves_limits T] : + well_powered (structured_arrow S T) := +{ subobject_small := λ X, small_map (subobject_equiv X).to_equiv } + +end structured_arrow + +namespace costructured_arrow +variables {S : C ⥤ D} {T : D} + +/-- Every quotient of a costructured arrow can be projected to a quotient of the underlying + object. -/ +def project_quotient [has_colimits C] [preserves_colimits S] {A : costructured_arrow S T} : + subobject (op A) → subobject (op A.left) := +begin + refine subobject.lift (λ P f hf, by exactI subobject.mk f.unop.left.op) _, + introsI P Q f g hf hg i hi, + refine subobject.mk_eq_mk_of_comm _ _ ((proj S T).map_iso i.unop).op (quiver.hom.unop_inj _), + have := congr_arg quiver.hom.unop hi, + simpa using congr_arg comma_morphism.left this, +end + +@[simp] +lemma project_quotient_mk [has_colimits C] [preserves_colimits S] {A : costructured_arrow S T} + {P : (costructured_arrow S T)ᵒᵖ} (f : P ⟶ op A) [mono f] : + (project_quotient (subobject.mk f)) = subobject.mk f.unop.left.op := +rfl + +lemma project_quotient_factors [has_colimits C] [preserves_colimits S] + {A : costructured_arrow S T} : + ∀ P : subobject (op A), ∃ q, S.map (project_quotient P).arrow.unop ≫ q = A.hom := +subobject.ind _ $ λ P f hf, ⟨S.map (subobject.underlying_iso _).unop.inv ≫ P.unop.hom, + by { dsimp, rw [← category.assoc, ← S.map_comp, ← unop_comp], simp }⟩ + +/-- A quotient of the underlying object of a costructured arrow can be lifted to a quotient of + the costructured arrow, provided that there is a morphism making the quotient into a + costructured arrow. -/ +@[simp] +def lift_quotient {A : costructured_arrow S T} (P : subobject (op A.left)) {q} + (hq : S.map P.arrow.unop ≫ q = A.hom) : subobject (op A) := +subobject.mk (hom_mk P.arrow.unop hq : A ⟶ mk q).op + +/-- Technical lemma for `lift_project_quotient`. -/ +@[simp] +lemma unop_left_comp_underlying_iso_hom_unop {A : costructured_arrow S T} + {P : (costructured_arrow S T)ᵒᵖ} (f : P ⟶ op A) [mono f.unop.left.op] : + f.unop.left ≫ (subobject.underlying_iso f.unop.left.op).hom.unop = + (subobject.mk f.unop.left.op).arrow.unop := +begin + conv_lhs { congr, rw [← quiver.hom.unop_op f.unop.left] }, + rw [← unop_comp, subobject.underlying_iso_hom_comp_eq_mk] +end + +/-- Projecting and then lifting a quotient recovers the original quotient, because there is at most + one morphism making the projected quotient into a costructured arrow. -/ +lemma lift_project_quotient [has_colimits C] [preserves_colimits S] {A : costructured_arrow S T} : + ∀ (P : subobject (op A)) {q} (hq : S.map (project_quotient P).arrow.unop ≫ q = A.hom), + lift_quotient (project_quotient P) hq = P := subobject.ind _ +begin + introsI P f hf q hq, + fapply subobject.mk_eq_mk_of_comm, + { refine (iso.op (iso_mk _ _) : _ ≅ op (unop P)), + { exact (subobject.underlying_iso f.unop.left.op).unop }, + { refine (cancel_epi (S.map f.unop.left)).1 _, + simpa [← category.assoc, ← S.map_comp] using hq } }, + { exact quiver.hom.unop_inj (ext _ _ (by { dsimp, simp })) } +end + +/-- Technical lemma for `quotient_equiv`. -/ +lemma unop_left_comp_of_mk_le_mk_unop {A : costructured_arrow S T} + {P Q : (costructured_arrow S T)ᵒᵖ} {f : P ⟶ op A} {g : Q ⟶ op A} [mono f.unop.left.op] + [mono g.unop.left.op] (h : subobject.mk f.unop.left.op ≤ subobject.mk g.unop.left.op) : + g.unop.left ≫ (subobject.of_mk_le_mk f.unop.left.op g.unop.left.op h).unop = f.unop.left := +begin + conv_lhs { congr, rw [← quiver.hom.unop_op g.unop.left] }, + rw [← unop_comp], + simp only [subobject.of_mk_le_mk_comp, quiver.hom.unop_op] +end + +/-- If `A : S.obj B ⟶ T` is a costructured arrow for `S : C ⥤ D` and `T : D`, then we can + explicitly describe the quotients of `A` as the quotients `P` of `B` in `C` for which `A.hom` + factors through the image of `P` under `S`. -/ +def quotient_equiv [has_colimits C] [preserves_colimits S] (A : costructured_arrow S T) : + subobject (op A) ≃o { P : subobject (op A.left) // ∃ q, S.map P.arrow.unop ≫ q = A.hom } := +{ to_fun := λ P, ⟨project_quotient P, project_quotient_factors P⟩, + inv_fun := λ P, lift_quotient P.val P.prop.some_spec, + left_inv := λ P, lift_project_quotient _ _, + right_inv := λ P, subtype.ext (by simp), + map_rel_iff' := subobject.ind₂ _ + begin + introsI P Q f g hf hg, + refine ⟨λ h, subobject.mk_le_mk_of_comm _ (quiver.hom.unop_inj (ext _ _ _)), λ h, _⟩, + { refine (hom_mk (subobject.of_mk_le_mk _ _ h).unop ((cancel_epi (S.map g.unop.left)).1 _)).op, + dsimp only [mono_over.mk'_arrow], + rw [← category.assoc, ← S.map_comp, unop_left_comp_of_mk_le_mk_unop], + dsimp, + simp }, + { exact unop_left_comp_of_mk_le_mk_unop _ }, + { refine subobject.mk_le_mk_of_comm (subobject.of_mk_le_mk _ _ h).unop.left.op _, + refine quiver.hom.unop_inj _, + have := congr_arg quiver.hom.unop (subobject.of_mk_le_mk_comp h), + simpa [-subobject.of_mk_le_mk_comp] using congr_arg comma_morphism.left this } + end } + +/-- If `C` is well-copowered and cocomplete and `S` preserves colimits, then + `costructured_arrow S T` is well-copowered. -/ +instance well_copowered_costructured_arrow [well_powered Cᵒᵖ] [has_colimits C] + [preserves_colimits S] : well_powered (costructured_arrow S T)ᵒᵖ := +{ subobject_small := λ X, small_map (quotient_equiv (unop X)).to_equiv } + +end costructured_arrow + +end category_theory diff --git a/src/category_theory/subobject/default.lean b/src/category_theory/subobject/default.lean deleted file mode 100644 index ac3af1749199b..0000000000000 --- a/src/category_theory/subobject/default.lean +++ /dev/null @@ -1,5 +0,0 @@ -import category_theory.subobject.mono_over -import category_theory.subobject.basic -import category_theory.subobject.factor_thru -import category_theory.subobject.well_powered -import category_theory.subobject.lattice diff --git a/src/category_theory/subobject/factor_thru.lean b/src/category_theory/subobject/factor_thru.lean index adf579d3ea797..6d1fe817d6a5c 100644 --- a/src/category_theory/subobject/factor_thru.lean +++ b/src/category_theory/subobject/factor_thru.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta, Scott Morrison -/ import category_theory.subobject.basic -import category_theory.preadditive +import category_theory.preadditive.basic /-! # Factoring through subobjects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The predicate `h : P.factors f`, for `P : subobject Y` and `f : X ⟶ Y` asserts the existence of some `P.factor_thru f : X ⟶ (P : C)` making the obvious diagram commute. diff --git a/src/category_theory/subobject/lattice.lean b/src/category_theory/subobject/lattice.lean index 359d0877b0f9e..319f87ae235ef 100644 --- a/src/category_theory/subobject/lattice.lean +++ b/src/category_theory/subobject/lattice.lean @@ -9,6 +9,9 @@ import category_theory.subobject.well_powered /-! # The lattice of subobjects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We provide the `semilattice_inf` with `order_top (subobject X)` instance when `[has_pullback C]`, and the `semilattice_sup (subobject X)` instance when `[has_images C] [has_binary_coproducts C]`. -/ @@ -538,7 +541,7 @@ wide_pullback_shape.mk_cone f.arrow (le_Inf_cone s f k).π.app none = f.arrow := rfl -variables [has_wide_pullbacks C] +variables [has_wide_pullbacks.{v₁} C] /-- The limit of `wide_cospan s`. (This will be the supremum of the set of subobjects.) @@ -606,7 +609,7 @@ end Inf section Sup -variables [well_powered C] [has_coproducts C] +variables [well_powered C] [has_coproducts.{v₁} C] /-- The univesal morphism out of the coproduct of a set of subobjects, @@ -662,9 +665,11 @@ instance {B : C} : complete_semilattice_Sup (subobject B) := end Sup section complete_lattice -variables [well_powered C] [has_wide_pullbacks C] [has_images C] [has_coproducts C] +variables [well_powered C] [has_wide_pullbacks.{v₁} C] [has_images C] [has_coproducts.{v₁} C] [initial_mono_class C] +local attribute [instance] has_smallest_coproducts_of_has_coproducts + instance {B : C} : complete_lattice (subobject B) := { ..subobject.semilattice_inf, ..subobject.semilattice_sup, @@ -674,6 +679,35 @@ instance {B : C} : complete_lattice (subobject B) := end complete_lattice +section zero_object +variables [has_zero_morphisms C] [has_zero_object C] +open_locale zero_object + +/-- A nonzero object has nontrivial subobject lattice. -/ +lemma nontrivial_of_not_is_zero {X : C} (h : ¬ is_zero X) : nontrivial (subobject X) := +⟨⟨mk (0 : 0 ⟶ X), mk (𝟙 X), λ w, h (is_zero.of_iso (is_zero_zero C) (iso_of_mk_eq_mk _ _ w).symm)⟩⟩ + +end zero_object + +section subobject_subobject + +/-- The subobject lattice of a subobject `Y` is order isomorphic to the interval `set.Iic Y`. -/ +def subobject_order_iso {X : C} (Y : subobject X) : subobject (Y : C) ≃o set.Iic Y := +{ to_fun := λ Z, ⟨subobject.mk (Z.arrow ≫ Y.arrow), + set.mem_Iic.mpr (le_of_comm ((underlying_iso _).hom ≫ Z.arrow) (by simp))⟩, + inv_fun := λ Z, subobject.mk (of_le _ _ Z.2), + left_inv := λ Z, mk_eq_of_comm _ (underlying_iso _) (by { ext, simp, }), + right_inv := λ Z, subtype.ext (mk_eq_of_comm _ (underlying_iso _) + (by { dsimp, simp [←iso.eq_inv_comp], })), + map_rel_iff' := λ W Z, + ⟨λ h, le_of_comm + ((underlying_iso _).inv ≫ of_le _ _ (subtype.mk_le_mk.mp h) ≫ (underlying_iso _).hom) + (by { ext, simp, }), + λ h, subtype.mk_le_mk.mpr + (le_of_comm ((underlying_iso _).hom ≫ of_le _ _ h ≫ (underlying_iso _).inv) (by simp))⟩, } + +end subobject_subobject + end subobject end category_theory diff --git a/src/category_theory/subobject/limits.lean b/src/category_theory/subobject/limits.lean index bba0b81fc9511..08e559e0c2913 100644 --- a/src/category_theory/subobject/limits.lean +++ b/src/category_theory/subobject/limits.lean @@ -8,6 +8,9 @@ import category_theory.subobject.lattice /-! # Specific subobjects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `equalizer_subobject`, `kernel_subobject` and `image_subobject`, which are the subobjects represented by the equalizer, kernel and image of (a pair of) morphism(s) and provide conditions for `P.factors f`, where `P` is one of these special subobjects. @@ -22,6 +25,7 @@ universes v u noncomputable theory open category_theory category_theory.category category_theory.limits category_theory.subobject + opposite variables {C : Type u} [category.{v} C] {X Y Z : C} @@ -144,6 +148,17 @@ by { ext, simp, dsimp, simp, } -- See library note [dsimp, simp]. kernel_subobject_map (sq ≫ sq') = kernel_subobject_map sq ≫ kernel_subobject_map sq' := by { ext, simp, } +@[reassoc] lemma kernel_map_comp_kernel_subobject_iso_inv (sq : arrow.mk f ⟶ arrow.mk f') : + kernel.map f f' sq.1 sq.2 sq.3.symm ≫ (kernel_subobject_iso _).inv = + (kernel_subobject_iso _).inv ≫ kernel_subobject_map sq := +by ext; simp + +@[reassoc] lemma kernel_subobject_iso_comp_kernel_map + (sq : arrow.mk f ⟶ arrow.mk f') : + (kernel_subobject_iso _).hom ≫ kernel.map f f' sq.1 sq.2 sq.3.symm = + kernel_subobject_map sq ≫ (kernel_subobject_iso _).hom := +by simp [←iso.comp_inv_eq, kernel_map_comp_kernel_subobject_iso_inv] + end @[simp] @@ -203,6 +218,50 @@ begin { simp, }, end +/-- Taking cokernels is an order-reversing map from the subobjects of `X` to the quotient objects + of `X`. -/ +@[simps] +def cokernel_order_hom [has_cokernels C] (X : C) : subobject X →o (subobject (op X))ᵒᵈ := +{ to_fun := subobject.lift (λ A f hf, subobject.mk (cokernel.π f).op) + begin + rintros A B f g hf hg i rfl, + refine subobject.mk_eq_mk_of_comm _ _ (iso.op _) (quiver.hom.unop_inj _), + { exact (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _) + (is_cokernel_epi_comp (colimit.is_colimit _) i.hom rfl)).symm }, + { simp only [iso.comp_inv_eq, iso.op_hom, iso.symm_hom, unop_comp, quiver.hom.unop_op, + colimit.comp_cocone_point_unique_up_to_iso_hom, cofork.of_π_ι_app, coequalizer.cofork_π] } + end, + monotone' := subobject.ind₂ _ $ + begin + introsI A B f g hf hg h, + dsimp only [subobject.lift_mk], + refine subobject.mk_le_mk_of_comm (cokernel.desc f (cokernel.π g) _).op _, + { rw [← subobject.of_mk_le_mk_comp h, category.assoc, cokernel.condition, comp_zero] }, + { exact quiver.hom.unop_inj (cokernel.π_desc _ _ _) } + end } + +/-- Taking kernels is an order-reversing map from the quotient objects of `X` to the subobjects of + `X`. -/ +@[simps] +def kernel_order_hom [has_kernels C] (X : C) : (subobject (op X))ᵒᵈ →o subobject X := +{ to_fun := subobject.lift (λ A f hf, subobject.mk (kernel.ι f.unop)) + begin + rintros A B f g hf hg i rfl, + refine subobject.mk_eq_mk_of_comm _ _ _ _, + { exact is_limit.cone_point_unique_up_to_iso (limit.is_limit _) + (is_kernel_comp_mono (limit.is_limit (parallel_pair g.unop 0)) i.unop.hom rfl) }, + { dsimp, + simp only [←iso.eq_inv_comp, limit.cone_point_unique_up_to_iso_inv_comp, fork.of_ι_π_app] } + end, + monotone' := subobject.ind₂ _ $ + begin + introsI A B f g hf hg h, + dsimp only [subobject.lift_mk], + refine subobject.mk_le_mk_of_comm (kernel.lift g.unop (kernel.ι f.unop) _) _, + { rw [← subobject.of_mk_le_mk_comp h, unop_comp, kernel.condition_assoc, zero_comp] }, + { exact quiver.hom.op_inj (by simp) } + end } + end kernel section image @@ -328,6 +387,9 @@ by simp [image_subobject_comp_iso] end +lemma image_subobject_mono (f : X ⟶ Y) [mono f] : image_subobject f = mk f := +eq_of_comm (image_subobject_iso f ≪≫ image_mono_iso_source f ≪≫ (underlying_iso f).symm) (by simp) + /-- Precomposing by an isomorphism does not change the image subobject. -/ lemma image_subobject_iso_comp [has_equalizers C] {X' : C} (h : X' ⟶ X) [is_iso h] (f : X ⟶ Y) [has_image f] : @@ -364,6 +426,21 @@ begin erw [image.map_ι, ←category.assoc, image_subobject_arrow], end +lemma image_map_comp_image_subobject_iso_inv + {W X Y Z : C} {f : W ⟶ X} [has_image f] {g : Y ⟶ Z} [has_image g] + (sq : arrow.mk f ⟶ arrow.mk g) [has_image_map sq] : + image.map sq ≫ (image_subobject_iso _).inv = + (image_subobject_iso _).inv ≫ image_subobject_map sq := +by ext; simp + +lemma image_subobject_iso_comp_image_map + {W X Y Z : C} {f : W ⟶ X} [has_image f] {g : Y ⟶ Z} [has_image g] + (sq : arrow.mk f ⟶ arrow.mk g) [has_image_map sq] : + (image_subobject_iso _).hom ≫ image.map sq = + image_subobject_map sq ≫ (image_subobject_iso _).hom := +by rw [←iso.comp_inv_eq, category.assoc, ←(image_subobject_iso (arrow.mk f).hom).eq_inv_comp, + ←image_map_comp_image_subobject_iso_inv]; refl + end image end limits diff --git a/src/category_theory/subobject/mono_over.lean b/src/category_theory/subobject/mono_over.lean index 4e60fe012c2db..619c45c78ae36 100644 --- a/src/category_theory/subobject/mono_over.lean +++ b/src/category_theory/subobject/mono_over.lean @@ -3,7 +3,6 @@ Copyright (c) 2020 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta, Scott Morrison -/ -import category_theory.functor.currying import category_theory.limits.over import category_theory.limits.shapes.images import category_theory.adjunction.reflective @@ -11,6 +10,9 @@ import category_theory.adjunction.reflective /-! # Monomorphisms over a fixed object +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + As preparation for defining `subobject X`, we set up the theory for `mono_over X := {f : over X // mono f.hom}`. @@ -49,19 +51,19 @@ This isn't skeletal, so it's not a partial order. Later we define `subobject X` as the quotient of this by isomorphisms. -/ @[derive [category]] -def mono_over (X : C) := {f : over X // mono f.hom} +def mono_over (X : C) := full_subcategory (λ (f : over X), mono f.hom) namespace mono_over /-- Construct a `mono_over X`. -/ @[simps] -def mk' {X A : C} (f : A ⟶ X) [hf : mono f] : mono_over X := { val := over.mk f, property := hf } +def mk' {X A : C} (f : A ⟶ X) [hf : mono f] : mono_over X := { obj := over.mk f, property := hf } /-- The inclusion from monomorphisms over X to morphisms over X. -/ def forget (X : C) : mono_over X ⥤ over X := full_subcategory_inclusion _ instance : has_coe (mono_over X) C := -{ coe := λ Y, Y.val.left, } +{ coe := λ Y, Y.obj.left, } @[simp] lemma forget_obj_left {f} : ((forget X).obj f).left = (f : C) := rfl @@ -83,23 +85,24 @@ instance mono (f : mono_over X) : mono f.arrow := f.property /-- The category of monomorphisms over X is a thin category, which makes defining its skeleton easy. -/ -instance is_thin {X : C} (f g : mono_over X) : subsingleton (f ⟶ g) := -⟨begin - intros h₁ h₂, - ext1, - erw [← cancel_mono g.arrow, over.w h₁, over.w h₂], -end⟩ +instance is_thin {X : C} : quiver.is_thin (mono_over X) := +λ f g, + ⟨begin + intros h₁ h₂, + ext1, + erw [← cancel_mono g.arrow, over.w h₁, over.w h₂], + end⟩ @[reassoc] lemma w {f g : mono_over X} (k : f ⟶ g) : k.left ≫ g.arrow = f.arrow := over.w _ /-- Convenience constructor for a morphism in monomorphisms over `X`. -/ -abbreviation hom_mk {f g : mono_over X} (h : f.val.left ⟶ g.val.left) (w : h ≫ g.arrow = f.arrow) : +abbreviation hom_mk {f g : mono_over X} (h : f.obj.left ⟶ g.obj.left) (w : h ≫ g.arrow = f.arrow) : f ⟶ g := over.hom_mk h w /-- Convenience constructor for an isomorphism in monomorphisms over `X`. -/ @[simps] -def iso_mk {f g : mono_over X} (h : f.val.left ≅ g.val.left) (w : h.hom ≫ g.arrow = f.arrow) : +def iso_mk {f g : mono_over X} (h : f.obj.left ≅ g.obj.left) (w : h.hom ≫ g.arrow = f.arrow) : f ≅ g := { hom := hom_mk h.hom w, inv := hom_mk h.inv (by rw [h.inv_comp_eq, w]) } @@ -217,7 +220,7 @@ def map_id : map (𝟙 X) ≅ 𝟭 _ := lift_iso _ _ over.map_id ≪≫ lift_id @[simp] lemma map_obj_left (f : X ⟶ Y) [mono f] (g : mono_over X) : - (((map f).obj g) : C) = g.val.left := + (((map f).obj g) : C) = g.obj.left := rfl @[simp] @@ -324,7 +327,7 @@ adjunction.mk_of_hom_equiv inv_fun := λ k, begin refine over.hom_mk _ _, - refine image.lift {I := g.val.left, m := g.arrow, e := k.left, fac' := over.w k}, + refine image.lift {I := g.obj.left, m := g.arrow, e := k.left, fac' := over.w k}, apply image.lift_fac, end, left_inv := λ k, subsingleton.elim _ _, @@ -388,7 +391,7 @@ end /-- `exists` is adjoint to `pullback` when images exist -/ def exists_pullback_adj (f : X ⟶ Y) [has_pullbacks C] : «exists» f ⊣ pullback f := adjunction.restrict_fully_faithful (forget X) (𝟭 _) - ((over.map_pullback_adj f).comp _ _ image_forget_adj) + ((over.map_pullback_adj f).comp image_forget_adj) (iso.refl _) (iso.refl _) diff --git a/src/category_theory/subobject/types.lean b/src/category_theory/subobject/types.lean index a36e60ce02444..f53ee33ba1274 100644 --- a/src/category_theory/subobject/types.lean +++ b/src/category_theory/subobject/types.lean @@ -9,6 +9,9 @@ import category_theory.types /-! # `Type u` is well-powered +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + By building a categorical equivalence `mono_over α ≌ set α` for any `α : Type u`, we deduce that `subobject α ≃o set α` and that `Type u` is well-powered. diff --git a/src/category_theory/subobject/well_powered.lean b/src/category_theory/subobject/well_powered.lean index 9652b24e8a0c8..3336ecda1e177 100644 --- a/src/category_theory/subobject/well_powered.lean +++ b/src/category_theory/subobject/well_powered.lean @@ -9,6 +9,9 @@ import category_theory.essentially_small /-! # Well-powered categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A category `(C : Type u) [category.{v} C]` is `[well_powered C]` if for every `X : C`, we have `small.{v} (subobject X)`. diff --git a/src/category_theory/subterminal.lean b/src/category_theory/subterminal.lean index 8b93e141b5b25..0d523650bed41 100644 --- a/src/category_theory/subterminal.lean +++ b/src/category_theory/subterminal.lean @@ -10,6 +10,9 @@ import category_theory.subobject.mono_over /-! # Subterminal objects +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Subterminal objects are the objects which can be thought of as subobjects of the terminal object. In fact, the definition can be constructed to not require a terminal object, by defining `A` to be subterminal iff for any `Z`, there is at most one morphism `Z ⟶ A`. @@ -117,7 +120,7 @@ to the lattice of open subsets of `X`. More generally, if `C` is a topos, this i -/ @[derive category] def subterminals (C : Type u₁) [category.{v₁} C] := -{A : C // is_subterminal A} +full_subcategory (λ (A : C), is_subterminal A) instance [has_terminal C] : inhabited (subterminals C) := ⟨⟨⊤_ C, is_subterminal_of_terminal⟩⟩ @@ -138,9 +141,9 @@ def subterminals_equiv_mono_over_terminal [has_terminal C] : subterminals C ≌ mono_over (⊤_ C) := { functor := { obj := λ X, ⟨over.mk (terminal.from X.1), X.2.mono_terminal_from⟩, - map := λ X Y f, mono_over.hom_mk f (by ext1 ⟨⟩) }, + map := λ X Y f, mono_over.hom_mk f (by ext1 ⟨⟨⟩⟩) }, inverse := - { obj := λ X, ⟨X.val.left, λ Z f g, by { rw ← cancel_mono X.arrow, apply subsingleton.elim }⟩, + { obj := λ X, ⟨X.obj.left, λ Z f g, by { rw ← cancel_mono X.arrow, apply subsingleton.elim }⟩, map := λ X Y f, f.1 }, unit_iso := { hom := { app := λ X, 𝟙 _ }, diff --git a/src/category_theory/sums/associator.lean b/src/category_theory/sums/associator.lean index 4905f7c7ebe7e..b9c6c6da17307 100644 --- a/src/category_theory/sums/associator.lean +++ b/src/category_theory/sums/associator.lean @@ -8,6 +8,9 @@ import category_theory.sums.basic /-! # Associator for binary disjoint union of categories. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The associator functor `((C ⊕ D) ⊕ E) ⥤ (C ⊕ (D ⊕ E))` and its inverse form an equivalence. -/ diff --git a/src/category_theory/sums/basic.lean b/src/category_theory/sums/basic.lean index d994cf0f200d6..06ba51c49750d 100644 --- a/src/category_theory/sums/basic.lean +++ b/src/category_theory/sums/basic.lean @@ -8,6 +8,9 @@ import category_theory.eq_to_hom /-! # Binary disjoint unions of categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the category instance on `C ⊕ D` when `C` and `D` are categories. We define: diff --git a/src/category_theory/sums/default.lean b/src/category_theory/sums/default.lean deleted file mode 100644 index bc466880ac5de..0000000000000 --- a/src/category_theory/sums/default.lean +++ /dev/null @@ -1 +0,0 @@ -import category_theory.sums.associator diff --git a/src/category_theory/thin.lean b/src/category_theory/thin.lean index 9b4235db4698d..b402d5135f7ae 100644 --- a/src/category_theory/thin.lean +++ b/src/category_theory/thin.lean @@ -9,6 +9,9 @@ import category_theory.isomorphism /-! # Thin categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A thin category (also known as a sparse category) is a category with at most one morphism between each pair of objects. @@ -30,7 +33,7 @@ namespace category_theory variables {C : Type u₁} section -variables [category_struct.{v₁} C] [∀ X Y : C, subsingleton (X ⟶ Y)] +variables [category_struct.{v₁} C] [quiver.is_thin C] /-- Construct a category instance from a category_struct, using the fact that hom spaces are subsingletons to prove the axioms. -/ @@ -41,11 +44,11 @@ end -- In particular this allows `C` to be a preorder, with the category instance inherited from the -- preorder structure. variables [category.{v₁} C] {D : Type u₂} [category.{v₂} D] -variable [∀ X Y : C, subsingleton (X ⟶ Y)] +variable [quiver.is_thin C] /-- If `C` is a thin category, then `D ⥤ C` is a thin category. -/ -instance functor_thin (F₁ F₂ : D ⥤ C) : subsingleton (F₁ ⟶ F₂) := -⟨λ α β, nat_trans.ext α β (funext (λ _, subsingleton.elim _ _))⟩ +instance functor_thin : quiver.is_thin (D ⥤ C) := +λ _ _, ⟨λ α β, nat_trans.ext α β (funext (λ _, subsingleton.elim _ _))⟩ /-- To show `X ≅ Y` in a thin category, it suffices to just give any morphism in each direction. -/ def iso_of_both_ways {X Y : C} (f : X ⟶ Y) (g : Y ⟶ X) : X ≅ Y := diff --git a/src/category_theory/triangulated/basic.lean b/src/category_theory/triangulated/basic.lean index fb6ce12029b9d..94740f2468fd0 100644 --- a/src/category_theory/triangulated/basic.lean +++ b/src/category_theory/triangulated/basic.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Luke Kershaw -/ import data.int.basic -import category_theory.shift +import category_theory.shift.basic /-! # Triangles +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of triangles in an additive category with an additive shift. It also defines morphisms between these triangles. @@ -22,7 +25,7 @@ open category_theory.limits universes v v₀ v₁ v₂ u u₀ u₁ u₂ -namespace category_theory.triangulated +namespace category_theory.pretriangulated open category_theory.category /- @@ -43,6 +46,8 @@ structure triangle := mk' :: (mor₂ : obj₂ ⟶ obj₃) (mor₃ : obj₃ ⟶ obj₁⟦(1:ℤ)⟧) +variable {C} + /-- A triangle `(X,Y,Z,f,g,h)` in `C` is defined by the morphisms `f : X ⟶ Y`, `g : Y ⟶ Z` and `h : Z ⟶ X⟦1⟧`. @@ -67,12 +72,10 @@ instance : inhabited (triangle C) := For each object in `C`, there is a triangle of the form `(X,X,0,𝟙 X,0,0)` -/ @[simps] -def contractible_triangle (X : C) : triangle C := triangle.mk C (𝟙 X) (0 : X ⟶ 0) 0 +def contractible_triangle (X : C) : triangle C := triangle.mk (𝟙 X) (0 : X ⟶ 0) 0 end -variable {C} - /-- A morphism of triangles `(X,Y,Z,f,g,h) ⟶ (X',Y',Z',f',g',h')` in `C` is a triple of morphisms `a : X ⟶ X'`, `b : Y ⟶ Y'`, `c : Z ⟶ Z'` such that @@ -135,4 +138,33 @@ instance triangle_category : category (triangle C) := id := λ A, triangle_morphism_id A, comp := λ A B C f g, f.comp g } -end category_theory.triangulated +/-- a constructor for morphisms of triangles -/ +@[simps] +def triangle.hom_mk (A B : triangle C) + (hom₁ : A.obj₁ ⟶ B.obj₁) (hom₂ : A.obj₂ ⟶ B.obj₂) (hom₃ : A.obj₃ ⟶ B.obj₃) + (comm₁ : A.mor₁ ≫ hom₂ = hom₁ ≫ B.mor₁) (comm₂ : A.mor₂ ≫ hom₃ = hom₂ ≫ B.mor₂) + (comm₃ : A.mor₃ ≫ hom₁⟦1⟧' = hom₃ ≫ B.mor₃) : A ⟶ B := +{ hom₁ := hom₁, + hom₂ := hom₂, + hom₃ := hom₃, + comm₁' := comm₁, + comm₂' := comm₂, + comm₃' := comm₃, } + +/-- a constructor for isomorphisms of triangles -/ +@[simps] +def triangle.iso_mk (A B : triangle C) + (iso₁ : A.obj₁ ≅ B.obj₁) (iso₂ : A.obj₂ ≅ B.obj₂) (iso₃ : A.obj₃ ≅ B.obj₃) + (comm₁ : A.mor₁ ≫ iso₂.hom = iso₁.hom ≫ B.mor₁) + (comm₂ : A.mor₂ ≫ iso₃.hom = iso₂.hom ≫ B.mor₂) + (comm₃ : A.mor₃ ≫ iso₁.hom⟦1⟧' = iso₃.hom ≫ B.mor₃) : A ≅ B := +{ hom := triangle.hom_mk _ _ iso₁.hom iso₂.hom iso₃.hom comm₁ comm₂ comm₃, + inv := triangle.hom_mk _ _ iso₁.inv iso₂.inv iso₃.inv + (by simp only [← cancel_mono iso₂.hom, assoc, iso.inv_hom_id, comp_id, + comm₁, iso.inv_hom_id_assoc]) + (by simp only [← cancel_mono iso₃.hom, assoc, iso.inv_hom_id, comp_id, + comm₂, iso.inv_hom_id_assoc]) + (by simp only [← cancel_mono (iso₁.hom⟦(1 : ℤ)⟧'), assoc, ← functor.map_comp, + iso.inv_hom_id, category_theory.functor.map_id, comp_id, comm₃, iso.inv_hom_id_assoc]), } + +end category_theory.pretriangulated diff --git a/src/category_theory/triangulated/pretriangulated.lean b/src/category_theory/triangulated/pretriangulated.lean index e8fe2256ea2a3..bf6c5f20d6242 100644 --- a/src/category_theory/triangulated/pretriangulated.lean +++ b/src/category_theory/triangulated/pretriangulated.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Luke Kershaw -/ import category_theory.preadditive.additive_functor -import category_theory.shift +import category_theory.shift.basic import category_theory.triangulated.rotate /-! # Pretriangulated Categories +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of pretriangulated categories and triangulated functors between them. @@ -29,14 +32,16 @@ open category_theory.limits universes v v₀ v₁ v₂ u u₀ u₁ u₂ -namespace category_theory.triangulated -open category_theory.category +namespace category_theory +open category pretriangulated /- We work in a preadditive category `C` equipped with an additive shift. -/ variables (C : Type u) [category.{v} C] [has_zero_object C] [has_shift C ℤ] [preadditive C] [∀ n : ℤ, functor.additive (shift_functor C n)] +variables (D : Type u₂) [category.{v₂} D] [has_zero_object D] [has_shift D ℤ] [preadditive D] + [∀ n : ℤ, functor.additive (shift_functor D n)] /-- A preadditive category `C` with an additive shift, and a class of "distinguished triangles" @@ -64,10 +69,10 @@ class pretriangulated := (distinguished_triangles [] : set (triangle C)) (isomorphic_distinguished : Π (T₁ ∈ distinguished_triangles) (T₂ ≅ T₁), T₂ ∈ distinguished_triangles) -(contractible_distinguished : Π (X : C), (contractible_triangle C X) ∈ distinguished_triangles) +(contractible_distinguished : Π (X : C), (contractible_triangle X) ∈ distinguished_triangles) (distinguished_cocone_triangle : Π (X Y : C) (f : X ⟶ Y), (∃ (Z : C) (g : Y ⟶ Z) (h : Z ⟶ X⟦(1:ℤ)⟧), - triangle.mk _ f g h ∈ distinguished_triangles)) + triangle.mk f g h ∈ distinguished_triangles)) (rotate_distinguished_triangle : Π (T : triangle C), T ∈ distinguished_triangles ↔ T.rotate ∈ distinguished_triangles) (complete_distinguished_triangle_morphism : Π (T₁ T₂ : triangle C) @@ -76,7 +81,9 @@ class pretriangulated := (∃ (c : T₁.obj₃ ⟶ T₂.obj₃), (T₁.mor₂ ≫ c = b ≫ T₂.mor₂) ∧ (T₁.mor₃ ≫ a⟦1⟧' = c ≫ T₂.mor₃) )) namespace pretriangulated -variables [pretriangulated C] +variables [hC : pretriangulated C] + +include hC notation `dist_triang `:20 C := distinguished_triangles C /-- @@ -103,16 +110,10 @@ See -/ lemma comp_dist_triangle_mor_zero₁₂ (T ∈ dist_triang C) : T.mor₁ ≫ T.mor₂ = 0 := begin - have h := contractible_distinguished T.obj₁, - have f := complete_distinguished_triangle_morphism, - specialize f (contractible_triangle C T.obj₁) T h H (𝟙 T.obj₁) T.mor₁, - have t : (contractible_triangle C T.obj₁).mor₁ ≫ T.mor₁ = 𝟙 T.obj₁ ≫ T.mor₁, - by refl, - specialize f t, - cases f with c f, - rw ← f.left, - simp only [limits.zero_comp, contractible_triangle_mor₂], -end -- TODO : tidy this proof up + obtain ⟨c, hc⟩ := complete_distinguished_triangle_morphism _ _ + (contractible_distinguished T.obj₁) H (𝟙 T.obj₁) T.mor₁ rfl, + simpa only [contractible_triangle_mor₂, zero_comp] using hc.left.symm, +end /-- Given any distinguished triangle @@ -144,96 +145,6 @@ by simpa using comp_dist_triangle_mor_zero₁₂ C (T.rotate.rotate) H₂ TODO: If `C` is pretriangulated with respect to a shift, then `Cᵒᵖ` is pretriangulated with respect to the inverse shift. -/ -end pretriangulated -end category_theory.triangulated - -namespace category_theory.triangulated -namespace pretriangulated - -variables (C : Type u₁) [category.{v₁} C] [has_zero_object C] [has_shift C ℤ] [preadditive C] - [∀ n : ℤ, functor.additive (shift_functor C n)] -variables (D : Type u₂) [category.{v₂} D] [has_zero_object D] [has_shift D ℤ] [preadditive D] - [∀ n : ℤ, functor.additive (shift_functor D n)] - -/-- -The underlying structure of a triangulated functor between pretriangulated categories `C` and `D` -is a functor `F : C ⥤ D` together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧`. --/ -structure triangulated_functor_struct extends (C ⥤ D) := -(comm_shift : shift_functor C (1 : ℤ) ⋙ to_functor ≅ to_functor ⋙ shift_functor D (1 : ℤ)) - -namespace triangulated_functor_struct - -/-- The identity `triangulated_functor_struct`. -/ -def id : triangulated_functor_struct C C := -{ obj := λ X, X, - map := λ _ _ f, f, - comm_shift := by refl } - -instance : inhabited (triangulated_functor_struct C C) := ⟨id C⟩ - -variables {C D} -/-- -Given a `triangulated_functor_struct` we can define a functor from triangles of `C` to -triangles of `D`. --/ -@[simps] -def map_triangle (F : triangulated_functor_struct C D) : triangle C ⥤ triangle D := -{ obj := λ T, triangle.mk _ (F.map T.mor₁) (F.map T.mor₂) - (F.map T.mor₃ ≫ F.comm_shift.hom.app T.obj₁), - map := λ S T f, - { hom₁ := F.map f.hom₁, - hom₂ := F.map f.hom₂, - hom₃ := F.map f.hom₃, - comm₁' := by { dsimp, simp only [←F.to_functor.map_comp, f.comm₁], }, - comm₂' := by { dsimp, simp only [←F.to_functor.map_comp, f.comm₂], }, - comm₃' := begin - dsimp, - erw [category.assoc, ←F.comm_shift.hom.naturality], - simp only [functor.comp_map, ←F.to_functor.map_comp_assoc, f.comm₃], - end, }, } - -end triangulated_functor_struct - -variables (C D) -/-- -A triangulated functor between pretriangulated categories `C` and `D` is a functor `F : C ⥤ D` -together with given functorial isomorphisms `ξ X : F(X⟦1⟧) ⟶ F(X)⟦1⟧` such that for every -distinguished triangle `(X,Y,Z,f,g,h)` of `C`, the triangle -`(F(X), F(Y), F(Z), F(f), F(g), F(h) ≫ (ξ X))` is a distinguished triangle of `D`. -See --/ -structure triangulated_functor [pretriangulated C] [pretriangulated D] extends - triangulated_functor_struct C D := -(map_distinguished' : Π (T : triangle C), (T ∈ dist_triang C) → - (to_triangulated_functor_struct.map_triangle.obj T ∈ dist_triang D) ) - -instance [pretriangulated C] : inhabited (triangulated_functor C C) := -⟨{obj := λ X, X, - map := λ _ _ f, f, - comm_shift := by refl , - map_distinguished' := begin - rintros ⟨_,_,_,_⟩ Tdt, - dsimp at *, - rwa category.comp_id, - end }⟩ - -variables {C D} [pretriangulated C] [pretriangulated D] -/-- -Given a `triangulated_functor` we can define a functor from triangles of `C` to triangles of `D`. --/ -@[simps] -def triangulated_functor.map_triangle (F : triangulated_functor C D) : - triangle C ⥤ triangle D := -F.to_triangulated_functor_struct.map_triangle - -/-- -Given a `triangulated_functor` and a distinguished triangle `T` of `C`, then the triangle it -maps onto in `D` is also distinguished. --/ -lemma triangulated_functor.map_distinguished (F : triangulated_functor C D) (T : triangle C) - (h : T ∈ dist_triang C) : (F.map_triangle.obj T) ∈ dist_triang D := F.map_distinguished' T h - end pretriangulated -end category_theory.triangulated +end category_theory diff --git a/src/category_theory/triangulated/rotate.lean b/src/category_theory/triangulated/rotate.lean index f649eab584c1f..748094c376071 100644 --- a/src/category_theory/triangulated/rotate.lean +++ b/src/category_theory/triangulated/rotate.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2021 Luke Kershaw. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Luke Kershaw +Authors: Luke Kershaw, Joël Riou -/ import category_theory.preadditive.additive_functor import category_theory.triangulated.basic @@ -9,6 +9,9 @@ import category_theory.triangulated.basic /-! # Rotate +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file adds the ability to rotate triangles and triangle morphisms. It also shows that rotation gives an equivalence on the category of triangles. @@ -22,7 +25,7 @@ open category_theory.limits universes v v₀ v₁ v₂ u u₀ u₁ u₂ -namespace category_theory.triangulated +namespace category_theory.pretriangulated open category_theory.category /-- @@ -47,10 +50,9 @@ applying `rotate` gives a triangle of the form: ``` -/ @[simps] -def triangle.rotate (T : triangle C) : triangle C := triangle.mk _ T.mor₂ T.mor₃ (-T.mor₁⟦1⟧') +def triangle.rotate (T : triangle C) : triangle C := triangle.mk T.mor₂ T.mor₃ (-T.mor₁⟦1⟧') section -local attribute [semireducible] shift_shift_neg shift_neg_shift /-- Given a triangle of the form: @@ -68,97 +70,11 @@ not necessarily equal to `Z`, but it is isomorphic, by the `counit_iso` of `shif -/ @[simps] def triangle.inv_rotate (T : triangle C) : triangle C := -triangle.mk _ (-T.mor₃⟦(-1:ℤ)⟧' ≫ (shift_shift_neg _ _).hom) T.mor₁ +triangle.mk (-T.mor₃⟦(-1:ℤ)⟧' ≫ (shift_shift_neg _ _).hom) T.mor₁ (T.mor₂ ≫ (shift_neg_shift _ _).inv) end -namespace triangle_morphism -variables {T₁ T₂ T₃ T₄: triangle C} -open triangle -/-- -You can also rotate a triangle morphism to get a morphism between the two rotated triangles. -Given a triangle morphism of the form: -``` - f g h - X ───> Y ───> Z ───> X⟦1⟧ - │ │ │ │ - │a │b │c │a⟦1⟧ - V V V V - X' ───> Y' ───> Z' ───> X'⟦1⟧ - f' g' h' -``` -applying `rotate` gives a triangle morphism of the form: - -``` - g h -f⟦1⟧ - Y ───> Z ───> X⟦1⟧ ───> Y⟦1⟧ - │ │ │ │ - │b │c │a⟦1⟧ │b⟦1⟧' - V V V V - Y' ───> Z' ───> X'⟦1⟧ ───> Y'⟦1⟧ - g' h' -f'⟦1⟧ -``` --/ -@[simps] -def rotate (f : triangle_morphism T₁ T₂) : - triangle_morphism (T₁.rotate) (T₂.rotate):= -{ hom₁ := f.hom₂, - hom₂ := f.hom₃, - hom₃ := f.hom₁⟦1⟧', - comm₃' := begin - dsimp, - simp only [rotate_mor₃, comp_neg, neg_comp, ← functor.map_comp, f.comm₁] - end } - -/-- -Given a triangle morphism of the form: -``` - f g h - X ───> Y ───> Z ───> X⟦1⟧ - │ │ │ │ - │a │b │c │a⟦1⟧ - V V V V - X' ───> Y' ───> Z' ───> X'⟦1⟧ - f' g' h' -``` -applying `inv_rotate` gives a triangle morphism that can be thought of as: -``` - -h⟦-1⟧ f g - Z⟦-1⟧ ───> X ───> Y ───> Z - │ │ │ │ - │c⟦-1⟧' │a │b │c - V V V V - Z'⟦-1⟧ ───> X' ───> Y' ───> Z' - -h'⟦-1⟧ f' g' -``` -(note that this diagram doesn't technically fit the definition of triangle morphism, -as `Z⟦-1⟧⟦1⟧` is not necessarily equal to `Z`, and `Z'⟦-1⟧⟦1⟧` is not necessarily equal to `Z'`, -but they are isomorphic, by the `counit_iso` of `shift C`) --/ -@[simps] -def inv_rotate (f : triangle_morphism T₁ T₂) : - triangle_morphism (T₁.inv_rotate) (T₂.inv_rotate) := -{ hom₁ := f.hom₃⟦-1⟧', - hom₂ := f.hom₁, - hom₃ := f.hom₂, - comm₁' := begin - dsimp [inv_rotate_mor₁], - simp only [discrete.functor_map_id, id_comp, preadditive.comp_neg, assoc, - neg_inj, nat_trans.id_app, preadditive.neg_comp], - rw [← functor.map_comp_assoc, ← f.comm₃, functor.map_comp_assoc, μ_naturality_assoc, - nat_trans.naturality, functor.id_map], - end, - comm₃' := begin - dsimp, - simp only [discrete.functor_map_id, id_comp, opaque_eq_to_iso_inv, μ_inv_naturality, - category.assoc, nat_trans.id_app, unit_of_tensor_iso_unit_inv_app], - erw ε_naturality_assoc, - rw comm₂_assoc - end } - -end triangle_morphism - variables (C) /-- @@ -167,7 +83,11 @@ Rotating triangles gives an endofunctor on the category of triangles in `C`. @[simps] def rotate : triangle C ⥤ triangle C := { obj := triangle.rotate, - map := λ _ _ f, f.rotate } + map := λ T₁ T₂ f, + { hom₁ := f.hom₂, + hom₂ := f.hom₃, + hom₃ := f.hom₁⟦1⟧', + comm₃' := by { dsimp, simp only [comp_neg, neg_comp, ← functor.map_comp, f.comm₁], }, }, } /-- The inverse rotation of triangles gives an endofunctor on the category of triangles in `C`. @@ -175,153 +95,43 @@ The inverse rotation of triangles gives an endofunctor on the category of triang @[simps] def inv_rotate : triangle C ⥤ triangle C := { obj := triangle.inv_rotate, - map := λ _ _ f, f.inv_rotate } + map := λ T₁ T₂ f, + { hom₁ := f.hom₃⟦-1⟧', + hom₂ := f.hom₁, + hom₃ := f.hom₂, + comm₁' := + begin + dsimp, + rw [neg_comp, assoc, comp_neg, neg_inj, ← functor.map_comp_assoc, ← f.comm₃, + functor.map_comp, assoc], + erw [← nat_trans.naturality], + refl, + end, + comm₃' := by { dsimp, erw [← f.comm₂_assoc, assoc, ← nat_trans.naturality], refl, }, }, } variables {C} variables [∀ n : ℤ, functor.additive (shift_functor C n)] -/-- There is a natural map from a triangle to the `inv_rotate` of its `rotate`. -/ -@[simps] -def to_inv_rotate_rotate (T : triangle C) : T ⟶ (inv_rotate C).obj ((rotate C).obj T) := -{ hom₁ := (shift_shift_neg _ _).inv, - hom₂ := 𝟙 T.obj₂, - hom₃ := 𝟙 T.obj₃, - comm₃' := begin - dsimp, - simp only [ε_app_obj, eq_to_iso.hom, discrete.functor_map_id, id_comp, eq_to_iso.inv, - opaque_eq_to_iso_inv, category.assoc, obj_μ_inv_app, functor.map_comp, nat_trans.id_app, - obj_ε_app, unit_of_tensor_iso_unit_inv_app], - erw μ_inv_hom_app_assoc, - refl - end } - -/-- -There is a natural transformation between the identity functor on triangles in `C`, -and the composition of a rotation with an inverse rotation. --/ -@[simps] -def rot_comp_inv_rot_hom : 𝟭 (triangle C) ⟶ rotate C ⋙ inv_rotate C := -{ app := to_inv_rotate_rotate, - naturality' := begin - introv, ext, - { dsimp, - simp only [nat_iso.cancel_nat_iso_inv_right_assoc, discrete.functor_map_id, id_comp, - opaque_eq_to_iso_inv, μ_inv_naturality, assoc, nat_trans.id_app, - unit_of_tensor_iso_unit_inv_app], - erw ε_naturality }, - { dsimp, rw [comp_id, id_comp] }, - { dsimp, rw [comp_id, id_comp] }, - end } - -/-- There is a natural map from the `inv_rotate` of the `rotate` of a triangle to itself. -/ -@[simps] -def from_inv_rotate_rotate (T : triangle C) : (inv_rotate C).obj ((rotate C).obj T) ⟶ T := -{ hom₁ := (shift_equiv C 1).unit_inv.app T.obj₁, - hom₂ := 𝟙 T.obj₂, - hom₃ := 𝟙 T.obj₃, - comm₃' := begin - dsimp, - rw [unit_of_tensor_iso_unit_inv_app, ε_app_obj], - simp only [discrete.functor_map_id, nat_trans.id_app, id_comp, assoc, functor.map_comp, - obj_μ_app, obj_ε_inv_app, comp_id, μ_inv_hom_app_assoc], - erw [μ_inv_hom_app, μ_inv_hom_app_assoc, category.comp_id] - end } +local attribute [simp] shift_shift_neg' shift_neg_shift' + shift_shift_functor_comp_iso_id_add_neg_self_inv_app + shift_shift_functor_comp_iso_id_add_neg_self_hom_app -/-- -There is a natural transformation between the composition of a rotation with an inverse rotation -on triangles in `C`, and the identity functor. --/ -@[simps] -def rot_comp_inv_rot_inv : rotate C ⋙ inv_rotate C ⟶ 𝟭 (triangle C) := -{ app := from_inv_rotate_rotate } - -/-- -The natural transformations between the identity functor on triangles in `C` and the composition -of a rotation with an inverse rotation are natural isomorphisms (they are isomorphisms in the -category of functors). --/ +/-- The unit isomorphism of the auto-equivalence of categories `triangle_rotation C` of +`triangle C` given by the rotation of triangles. -/ @[simps] def rot_comp_inv_rot : 𝟭 (triangle C) ≅ rotate C ⋙ inv_rotate C := -{ hom := rot_comp_inv_rot_hom, - inv := rot_comp_inv_rot_inv } - -/-- There is a natural map from the `rotate` of the `inv_rotate` of a triangle to itself. -/ -@[simps] -def from_rotate_inv_rotate (T : triangle C) : (rotate C).obj ((inv_rotate C).obj T) ⟶ T := -{ hom₁ := 𝟙 T.obj₁, - hom₂ := 𝟙 T.obj₂, - hom₃ := (shift_equiv C 1).counit.app T.obj₃, - comm₂' := begin - dsimp, - rw unit_of_tensor_iso_unit_inv_app, - simp only [discrete.functor_map_id, nat_trans.id_app, - id_comp, add_neg_equiv_counit_iso_hom, eq_to_hom_refl, nat_trans.comp_app, assoc, - μ_inv_hom_app_assoc, ε_hom_inv_app], - exact category.comp_id _, - end, - comm₃' := begin - dsimp, - simp only [discrete.functor_map_id, nat_trans.id_app, id_comp, functor.map_neg, - functor.map_comp, obj_μ_app, obj_ε_inv_app, comp_id, assoc, μ_naturality_assoc, neg_neg, - category_theory.functor.map_id, add_neg_equiv_counit_iso_hom, eq_to_hom_refl, - nat_trans.comp_app], - erw [μ_inv_hom_app, category.comp_id, obj_zero_map_μ_app], - rw [discrete.functor_map_id, nat_trans.id_app, comp_id], - end } - -/-- -There is a natural transformation between the composition of an inverse rotation with a rotation -on triangles in `C`, and the identity functor. --/ -@[simps] -def inv_rot_comp_rot_hom : inv_rotate C ⋙ rotate C ⟶ 𝟭 (triangle C) := -{ app := from_rotate_inv_rotate } +nat_iso.of_components (λ T, triangle.iso_mk _ _ ((shift_equiv C (1 : ℤ)).unit_iso.app T.obj₁) + (iso.refl _) (iso.refl _) (by tidy) (by tidy) (by tidy)) (by tidy) -/-- There is a natural map from a triangle to the `rotate` of its `inv_rotate`. -/ -@[simps] -def to_rotate_inv_rotate (T : triangle C) : T ⟶ (rotate C).obj ((inv_rotate C).obj T) := -{ hom₁ := 𝟙 T.obj₁, - hom₂ := 𝟙 T.obj₂, - hom₃ := (shift_equiv C 1).counit_inv.app T.obj₃, - comm₃' := begin - dsimp, - rw category_theory.functor.map_id, - simp only [comp_id, add_neg_equiv_counit_iso_inv, eq_to_hom_refl, id_comp, nat_trans.comp_app, - discrete.functor_map_id, nat_trans.id_app, functor.map_neg, functor.map_comp, obj_μ_app, - obj_ε_inv_app, assoc, μ_naturality_assoc, neg_neg, μ_inv_hom_app_assoc], - erw [μ_inv_hom_app, category.comp_id, obj_zero_map_μ_app], - simp only [discrete.functor_map_id, nat_trans.id_app, comp_id, ε_hom_inv_app_assoc], - end } - -/-- -There is a natural transformation between the identity functor on triangles in `C`, -and the composition of an inverse rotation with a rotation. --/ -@[simps] -def inv_rot_comp_rot_inv : 𝟭 (triangle C) ⟶ inv_rotate C ⋙ rotate C := -{ app := to_rotate_inv_rotate, - naturality' := begin - introv, ext, - { dsimp, rw [comp_id, id_comp] }, - { dsimp, rw [comp_id, id_comp] }, - { dsimp, - rw [add_neg_equiv_counit_iso_inv, eq_to_hom_refl, id_comp], - simp only [nat_trans.comp_app, assoc], - erw [μ_inv_naturality, ε_naturality_assoc] }, - end } - -/-- -The natural transformations between the composition of a rotation with an inverse rotation -on triangles in `C`, and the identity functor on triangles are natural isomorphisms -(they are isomorphisms in the category of functors). --/ +/-- The counit isomorphism of the auto-equivalence of categories `triangle_rotation C` of +`triangle C` given by the rotation of triangles. -/ @[simps] def inv_rot_comp_rot : inv_rotate C ⋙ rotate C ≅ 𝟭 (triangle C) := -{ hom := inv_rot_comp_rot_hom, - inv := inv_rot_comp_rot_inv } +nat_iso.of_components (λ T, triangle.iso_mk _ _ (iso.refl _) (iso.refl _) + ((shift_equiv C (1 : ℤ)).counit_iso.app T.obj₃) (by tidy) (by tidy) (by tidy)) (by tidy) -variables (C) +variable (C) /-- Rotating triangles gives an auto-equivalence on the category of triangles in `C`. @@ -331,19 +141,7 @@ def triangle_rotation : equivalence (triangle C) (triangle C) := { functor := rotate C, inverse := inv_rotate C, unit_iso := rot_comp_inv_rot, - counit_iso := inv_rot_comp_rot, - functor_unit_iso_comp' := begin - introv, ext, - { dsimp, rw comp_id }, - { dsimp, rw comp_id }, - { dsimp, - rw unit_of_tensor_iso_unit_inv_app, - simp only [discrete.functor_map_id, nat_trans.id_app, id_comp, functor.map_comp, obj_ε_app, - obj_μ_inv_app, assoc, add_neg_equiv_counit_iso_hom, eq_to_hom_refl, nat_trans.comp_app, - ε_inv_app_obj, comp_id, μ_inv_hom_app_assoc], - erw [μ_inv_hom_app_assoc, μ_inv_hom_app], - refl } - end } + counit_iso := inv_rot_comp_rot, } variables {C} @@ -352,4 +150,4 @@ by { change is_equivalence (triangle_rotation C).functor, apply_instance, } instance : is_equivalence (inv_rotate C) := by { change is_equivalence (triangle_rotation C).inverse, apply_instance, } -end category_theory.triangulated +end category_theory.pretriangulated diff --git a/src/category_theory/triangulated/triangulated.lean b/src/category_theory/triangulated/triangulated.lean new file mode 100644 index 0000000000000..67892425d0ee2 --- /dev/null +++ b/src/category_theory/triangulated/triangulated.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2022 Joël Riou. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joël Riou +-/ + +import category_theory.triangulated.pretriangulated + +/-! +# Triangulated Categories + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains the definition of triangulated categories, which are +pretriangulated categories which satisfy the octahedron axiom. + +-/ + +noncomputable theory + +namespace category_theory + +open limits category preadditive pretriangulated +open_locale zero_object + +variables {C : Type*} [category C] [preadditive C] [has_zero_object C] [has_shift C ℤ] + [∀ (n : ℤ), functor.additive (shift_functor C n)] [pretriangulated C] + +variables {X₁ X₂ X₃ Z₁₂ Z₂₃ Z₁₃ : C} {u₁₂ : X₁ ⟶ X₂} {u₂₃ : X₂ ⟶ X₃} {u₁₃ : X₁ ⟶ X₃} + (comm : u₁₂ ≫ u₂₃ = u₁₃) + {v₁₂ : X₂ ⟶ Z₁₂} {w₁₂ : Z₁₂ ⟶ X₁⟦(1 : ℤ)⟧} (h₁₂ : triangle.mk u₁₂ v₁₂ w₁₂ ∈ dist_triang C) + {v₂₃ : X₃ ⟶ Z₂₃} {w₂₃ : Z₂₃ ⟶ X₂⟦(1 : ℤ)⟧} (h₂₃ : triangle.mk u₂₃ v₂₃ w₂₃ ∈ dist_triang C) + {v₁₃ : X₃ ⟶ Z₁₃} {w₁₃ : Z₁₃ ⟶ X₁⟦(1 : ℤ)⟧} (h₁₃ : triangle.mk u₁₃ v₁₃ w₁₃ ∈ dist_triang C) + +namespace triangulated + +include comm h₁₂ h₂₃ h₁₃ + +/-- An octahedron is a type of datum whose existence is asserted by +the octahedron axiom (TR 4), see https://stacks.math.columbia.edu/tag/05QK -/ +structure octahedron := +(m₁ : Z₁₂ ⟶ Z₁₃) +(m₃ : Z₁₃ ⟶ Z₂₃) +(comm₁ : v₁₂ ≫ m₁ = u₂₃ ≫ v₁₃) +(comm₂ : m₁ ≫ w₁₃ = w₁₂) +(comm₃ : v₁₃ ≫ m₃ = v₂₃) +(comm₄ : w₁₃ ≫ u₁₂⟦1⟧' = m₃ ≫ w₂₃) +(mem : triangle.mk m₁ m₃ (w₂₃ ≫ v₁₂⟦1⟧') ∈ dist_triang C) + +omit comm h₁₂ h₂₃ h₁₃ + +instance (X : C) : nonempty (octahedron (comp_id (𝟙 X)) (contractible_distinguished X) + (contractible_distinguished X) (contractible_distinguished X)) := +begin + refine ⟨⟨0, 0, _, _, _, _, by convert contractible_distinguished (0 : C)⟩⟩, + all_goals { apply subsingleton.elim, }, +end + +namespace octahedron + +attribute [reassoc] comm₁ comm₂ comm₃ comm₄ + +variables {comm h₁₂ h₂₃ h₁₃} (h : octahedron comm h₁₂ h₂₃ h₁₃) + +/-- The triangle `Z₁₂ ⟶ Z₁₃ ⟶ Z₂₃ ⟶ Z₁₂⟦1⟧` given by an octahedron. -/ +@[simps] +def triangle : triangle C := triangle.mk h.m₁ h.m₃ (w₂₃ ≫ v₁₂⟦1⟧') + +/-- The first morphism of triangles given by an octahedron. -/ +@[simps] +def triangle_morphism₁ : triangle.mk u₁₂ v₁₂ w₁₂ ⟶ triangle.mk u₁₃ v₁₃ w₁₃ := +{ hom₁ := 𝟙 X₁, + hom₂ := u₂₃, + hom₃ := h.m₁, + comm₁' := by { dsimp, rw [id_comp, comm], }, + comm₂' := h.comm₁, + comm₃' := by { dsimp, simpa only [functor.map_id, comp_id] using h.comm₂.symm, }, } + +/-- The second morphism of triangles given an octahedron. -/ +@[simps] +def triangle_morphism₂ : triangle.mk u₁₃ v₁₃ w₁₃ ⟶ triangle.mk u₂₃ v₂₃ w₂₃ := +{ hom₁ := u₁₂, + hom₂ := 𝟙 X₃, + hom₃ := h.m₃, + comm₁' := by { dsimp, rw [comp_id, comm], }, + comm₂' := by { dsimp, rw [id_comp, h.comm₃], }, + comm₃' := h.comm₄, } + +/- TODO (@joelriou): show that in order to verify the existence of an octahedron, one may +replace the composable maps `u₁₂` and `u₂₃` by any isomorphic composable maps +and the given "cones" of `u₁₂`, `u₂₃`, `u₁₃` by any choice of cones. -/ + +end octahedron + +end triangulated + +open triangulated + +variable (C) + +/-- A triangulated category is a pretriangulated category which satisfies +the octahedron axiom (TR 4), see https://stacks.math.columbia.edu/tag/05QK -/ +class is_triangulated := +(octahedron_axiom : ∀ ⦃X₁ X₂ X₃ Z₁₂ Z₂₃ Z₁₃ : C⦄ ⦃u₁₂ : X₁ ⟶ X₂⦄ ⦃u₂₃ : X₂ ⟶ X₃⦄ ⦃u₁₃ : X₁ ⟶ X₃⦄ + (comm : u₁₂ ≫ u₂₃ = u₁₃) + ⦃v₁₂ : X₂ ⟶ Z₁₂⦄ ⦃w₁₂ : Z₁₂ ⟶ X₁⟦1⟧⦄ (h₁₂ : triangle.mk u₁₂ v₁₂ w₁₂ ∈ dist_triang C) + ⦃v₂₃ : X₃ ⟶ Z₂₃⦄ ⦃w₂₃ : Z₂₃ ⟶ X₂⟦1⟧⦄ (h₂₃ : triangle.mk u₂₃ v₂₃ w₂₃ ∈ dist_triang C) + ⦃v₁₃ : X₃ ⟶ Z₁₃⦄ ⦃w₁₃ : Z₁₃ ⟶ X₁⟦1⟧⦄ (h₁₃ : triangle.mk u₁₃ v₁₃ w₁₃ ∈ dist_triang C), + nonempty (octahedron comm h₁₂ h₂₃ h₁₃)) + +namespace triangulated + +variable {C} + +/-- A choice of octahedron given by the octahedron axiom. -/ +def some_octahedron [is_triangulated C] : octahedron comm h₁₂ h₂₃ h₁₃ := +(is_triangulated.octahedron_axiom comm h₁₂ h₂₃ h₁₃).some + +end triangulated + +end category_theory diff --git a/src/category_theory/types.lean b/src/category_theory/types.lean index e1074994e2618..ad97ce8539f57 100644 --- a/src/category_theory/types.lean +++ b/src/category_theory/types.lean @@ -10,6 +10,9 @@ import logic.equiv.basic /-! # The category `Type`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this section we set up the theory so that Lean's types and functions between them can be viewed as a `large_category` in our framework. @@ -63,7 +66,7 @@ congr_fun f.inv_hom_id y -- Unfortunately without this wrapper we can't use `category_theory` idioms, such as `is_iso f`. abbreviation as_hom {α β : Type u} (f : α → β) : α ⟶ β := f -- If you don't mind some notation you can use fewer keystrokes: -localized "notation `↾` f : 200 := category_theory.as_hom f" +localized "notation (name := category_theory.as_hom) `↾` f : 200 := category_theory.as_hom f" in category_theory.Type -- type as \upr in VScode section -- We verify the expected type checking behaviour of `as_hom`. @@ -278,8 +281,8 @@ iff.intro (λ i, (by exactI as_iso f : X ≅ Y).to_equiv.bijective) (λ b, is_iso.of_iso (equiv.of_bijective f b).to_iso) -noncomputable instance : split_epi_category (Type u) := -{ split_epi_of_epi := λ X Y f hf, +instance : split_epi_category (Type u) := +{ is_split_epi_of_epi := λ X Y f hf, is_split_epi.mk' { section_ := function.surj_inv $ (epi_iff_surjective f).1 hf, id' := funext $ function.right_inverse_surj_inv $ (epi_iff_surjective f).1 hf } } diff --git a/src/category_theory/whiskering.lean b/src/category_theory/whiskering.lean index 3983f85813602..60bed39c4592b 100644 --- a/src/category_theory/whiskering.lean +++ b/src/category_theory/whiskering.lean @@ -10,6 +10,9 @@ import category_theory.functor.fully_faithful /-! # Whiskering +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a functor `F : C ⥤ D` and functors `G H : D ⥤ E` and a natural transformation `α : G ⟶ H`, we can construct a new natural transformation `F ⋙ G ⟶ F ⋙ H`, called `whisker_left F α`. This is the same as the horizontal composition of `𝟙 F` with `α`. @@ -201,6 +204,9 @@ and it's usually best to insert explicit associators.) { hom := { app := λ _, 𝟙 _ }, inv := { app := λ _, 𝟙 _ } } +@[protected] +lemma assoc (F : A ⥤ B) (G : B ⥤ C) (H : C ⥤ D) : ((F ⋙ G) ⋙ H) = (F ⋙ (G ⋙ H)) := rfl + lemma triangle (F : A ⥤ B) (G : B ⥤ C) : (associator F (𝟭 B) G).hom ≫ (whisker_left F (left_unitor G).hom) = (whisker_right (right_unitor F).hom G) := diff --git a/src/category_theory/with_terminal.lean b/src/category_theory/with_terminal.lean index b3e3142e36c5c..cab0ee066e006 100644 --- a/src/category_theory/with_terminal.lean +++ b/src/category_theory/with_terminal.lean @@ -9,6 +9,9 @@ import category_theory.limits.shapes.terminal # `with_initial` and `with_terminal` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a category `C`, this file constructs two objects: 1. `with_terminal C`, the category built from `C` by formally adjoining a terminal object. 2. `with_initial C`, the category built from `C` by formally adjoining an initial object. @@ -56,7 +59,7 @@ local attribute [tidy] tactic.case_bash variable {C} /-- Morphisms for `with_terminal C`. -/ -@[simp, nolint has_inhabited_instance] +@[simp, nolint has_nonempty_instance] def hom : with_terminal C → with_terminal C → Type v | (of X) (of Y) := X ⟶ Y | star (of X) := pempty @@ -213,7 +216,7 @@ local attribute [tidy] tactic.case_bash variable {C} /-- Morphisms for `with_initial C`. -/ -@[simp, nolint has_inhabited_instance] +@[simp, nolint has_nonempty_instance] def hom : with_initial C → with_initial C → Type v | (of X) (of Y) := X ⟶ Y | (of X) _ := pempty diff --git a/src/category_theory/yoneda.lean b/src/category_theory/yoneda.lean index 58c67b3ada75a..4d6761f2974e8 100644 --- a/src/category_theory/yoneda.lean +++ b/src/category_theory/yoneda.lean @@ -10,6 +10,9 @@ import category_theory.products.basic /-! # The Yoneda embedding +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The Yoneda embedding as a functor `yoneda : C ⥤ (Cᵒᵖ ⥤ Type v₁)`, along with an instance that it is `fully_faithful`. @@ -125,6 +128,10 @@ nat_iso.of_components (λ X, { hom := λ f, f ⟨⟩, inv := λ x _, x }) (by tidy) +/-- Taking the `unop` of morphisms is a natural isomorphism. -/ +@[simps] def obj_op_op (X : C) : coyoneda.obj (op (op X)) ≅ yoneda.obj X := +nat_iso.of_components (λ Y, (op_equiv _ _).to_iso) (λ X Y f, rfl) + end coyoneda namespace functor @@ -386,7 +393,7 @@ lemma yoneda_sections_small_inv_app_apply {C : Type u₁} [small_category C] (X ((yoneda_sections_small X F).inv t).app Y f = F.map f.op t := rfl -local attribute[ext] functor.ext +local attribute [ext] functor.ext /-- The curried version of yoneda lemma when `C` is small. -/ def curried_yoneda_lemma {C : Type u₁} [small_category C] : diff --git a/src/combinatorics/additive/behrend.lean b/src/combinatorics/additive/behrend.lean new file mode 100644 index 0000000000000..1257399320c11 --- /dev/null +++ b/src/combinatorics/additive/behrend.lean @@ -0,0 +1,542 @@ +/- +Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Bhavik Mehta +-/ +import analysis.inner_product_space.pi_L2 +import combinatorics.additive.salem_spencer +import combinatorics.pigeonhole +import data.complex.exponential_bounds + +/-! +# Behrend's bound on Roth numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Behrend's lower bound on Roth numbers. This says that we can find a subset of +`{1, ..., n}` of size `n / exp (O (sqrt (log n)))` which does not contain arithmetic progressions of +length `3`. + +The idea is that the sphere (in the `n` dimensional Euclidean space) doesn't contain arithmetic +progressions (literally) because the corresponding ball is strictly convex. Thus we can take +integer points on that sphere and map them onto `ℕ` in a way that preserves arithmetic progressions +(`behrend.map`). + +## Main declarations + +* `behrend.sphere`: The intersection of the Euclidean sphere with the positive integer quadrant. + This is the set that we will map on `ℕ`. +* `behrend.map`: Given a natural number `d`, `behrend.map d : ℕⁿ → ℕ` reads off the coordinates as + digits in base `d`. +* `behrend.card_sphere_le_roth_number_nat`: Implicit lower bound on Roth numbers in terms of + `behrend.sphere`. +* `behrend.roth_lower_bound`: Behrend's explicit lower bound on Roth numbers. + +## References + +* [Bryan Gillespie, *Behrend’s Construction*] + (http://www.epsilonsmall.com/resources/behrends-construction/behrend.pdf) +* Behrend, F. A., "On sets of integers which contain no three terms in arithmetical progression" +* [Wikipedia, *Salem-Spencer set*](https://en.wikipedia.org/wiki/Salem–Spencer_set) + +## Tags + +Salem-Spencer, Behrend construction, arithmetic progression, sphere, strictly convex +-/ + +open finset nat (hiding log) real +open_locale big_operators pointwise + +namespace behrend +variables {α β : Type*} {n d k N : ℕ} {x : fin n → ℕ} + +/-! +### Turning the sphere into a Salem-Spencer set + +We define `behrend.sphere`, the intersection of the $$L^2$$ sphere with the positive quadrant of +integer points. Because the $$L^2$$ closed ball is strictly convex, the $$L^2$$ sphere and +`behrend.sphere` are Salem-Spencer (`add_salem_spencer_sphere`). Then we can turn this set in +`fin n → ℕ` into a set in `ℕ` using `behrend.map`, which preserves `add_salem_spencer` because it is +an additive monoid homomorphism. +-/ + +/-- The box `{0, ..., d - 1}^n` as a finset. -/ +def box (n d : ℕ) : finset (fin n → ℕ) := fintype.pi_finset $ λ _, range d + +lemma mem_box : x ∈ box n d ↔ ∀ i, x i < d := by simp only [box, fintype.mem_pi_finset, mem_range] + +@[simp] lemma card_box : (box n d).card = d ^ n := by simp [box] +@[simp] lemma box_zero : box (n + 1) 0 = ∅ := by simp [box] + +/-- The intersection of the sphere of radius `sqrt k` with the integer points in the positive +quadrant. -/ +def sphere (n d k : ℕ) : finset (fin n → ℕ) := (box n d).filter $ λ x, ∑ i, x i^2 = k + +lemma sphere_zero_subset : sphere n d 0 ⊆ 0 := +λ x, by simp [sphere, function.funext_iff] {contextual := tt} + +@[simp] lemma sphere_zero_right (n k : ℕ) : sphere (n + 1) 0 k = ∅ := by simp [sphere] + +lemma sphere_subset_box : sphere n d k ⊆ box n d := filter_subset _ _ + +lemma norm_of_mem_sphere {x : fin n → ℕ} (hx : x ∈ sphere n d k) : + ‖(pi_Lp.equiv 2 _).symm (coe ∘ x : fin n → ℝ)‖ = sqrt k := +begin + rw euclidean_space.norm_eq, + dsimp, + simp_rw [abs_cast, ←cast_pow, ←cast_sum, (mem_filter.1 hx).2], +end + +lemma sphere_subset_preimage_metric_sphere : + (sphere n d k : set (fin n → ℕ)) ⊆ + (λ x : fin n → ℕ, (pi_Lp.equiv 2 _).symm (coe ∘ x : fin n → ℝ)) ⁻¹' + metric.sphere (0 : pi_Lp 2 (λ _ : fin n, ℝ)) (sqrt k) := +λ x hx, by rw [set.mem_preimage, mem_sphere_zero_iff_norm, norm_of_mem_sphere hx] + +/-- The map that appears in Behrend's bound on Roth numbers. -/ +@[simps] def map (d : ℕ) : (fin n → ℕ) →+ ℕ := +{ to_fun := λ a, ∑ i, a i * d ^ (i : ℕ), + map_zero' := by simp_rw [pi.zero_apply, zero_mul, sum_const_zero], + map_add' := λ a b, by simp_rw [pi.add_apply, add_mul, sum_add_distrib] } + +@[simp] lemma map_zero (d : ℕ) (a : fin 0 → ℕ) : map d a = 0 := by simp [map] + +lemma map_succ (a : fin (n + 1) → ℕ) : map d a = a 0 + (∑ x : fin n, a x.succ * d ^ (x : ℕ)) * d := +by simp [map, fin.sum_univ_succ, pow_succ', ←mul_assoc, ←sum_mul] + +lemma map_succ' (a : fin (n + 1) → ℕ) : map d a = a 0 + map d (a ∘ fin.succ) * d := map_succ _ + +lemma map_monotone (d : ℕ) : monotone (map d : (fin n → ℕ) → ℕ) := +λ x y h, by { dsimp, exact sum_le_sum (λ i _, nat.mul_le_mul_right _ $ h i) } + +lemma map_mod (a : fin n.succ → ℕ) : map d a % d = a 0 % d := +by rw [map_succ, nat.add_mul_mod_self_right] + +lemma map_eq_iff {x₁ x₂ : fin n.succ → ℕ} (hx₁ : ∀ i, x₁ i < d) (hx₂ : ∀ i, x₂ i < d) : + map d x₁ = map d x₂ ↔ x₁ 0 = x₂ 0 ∧ map d (x₁ ∘ fin.succ) = map d (x₂ ∘ fin.succ) := +begin + refine ⟨λ h, _, λ h, by rw [map_succ', map_succ', h.1, h.2]⟩, + have : x₁ 0 = x₂ 0, + { rw [←mod_eq_of_lt (hx₁ _), ←map_mod, ←mod_eq_of_lt (hx₂ _), ←map_mod, h] }, + rw [map_succ, map_succ, this, add_right_inj, mul_eq_mul_right_iff] at h, + exact ⟨this, h.resolve_right (pos_of_gt (hx₁ 0)).ne'⟩, +end + +lemma map_inj_on : {x : fin n → ℕ | ∀ i, x i < d}.inj_on (map d) := +begin + intros x₁ hx₁ x₂ hx₂ h, + induction n with n ih, + { simp }, + ext i, + have x := (map_eq_iff hx₁ hx₂).1 h, + refine fin.cases x.1 (congr_fun $ ih (λ _, _) (λ _, _) x.2) i, + { exact hx₁ _ }, + { exact hx₂ _ } +end + +lemma map_le_of_mem_box (hx : x ∈ box n d) : + map (2 * d - 1) x ≤ ∑ i : fin n, (d - 1) * (2 * d - 1) ^ (i : ℕ) := +map_monotone (2 * d - 1) $ λ _, nat.le_pred_of_lt $ mem_box.1 hx _ + +lemma add_salem_spencer_sphere : add_salem_spencer (sphere n d k : set (fin n → ℕ)) := +begin + set f : (fin n → ℕ) →+ euclidean_space ℝ (fin n) := + { to_fun := λ f, (coe : ℕ → ℝ) ∘ f, + map_zero' := funext $ λ _, cast_zero, + map_add' := λ _ _, funext $ λ _, cast_add _ _ }, + refine add_salem_spencer.of_image (f.to_add_freiman_hom (sphere n d k) 2) _ _, + { exact cast_injective.comp_left.inj_on _ }, + refine (add_salem_spencer_sphere 0 $ sqrt k).mono (set.image_subset_iff.2 $ λ x, _), + rw [set.mem_preimage, mem_sphere_zero_iff_norm], + exact norm_of_mem_sphere, +end + +lemma add_salem_spencer_image_sphere : + add_salem_spencer ((sphere n d k).image (map (2 * d - 1)) : set ℕ) := +begin + rw coe_image, + refine @add_salem_spencer.image _ (fin n → ℕ) ℕ _ _ (sphere n d k) _ (map (2 * d - 1)) + (map_inj_on.mono _) add_salem_spencer_sphere, + rw set.add_subset_iff, + rintro a ha b hb i, + have hai := mem_box.1 (sphere_subset_box ha) i, + have hbi := mem_box.1 (sphere_subset_box hb) i, + rw [lt_tsub_iff_right, ←succ_le_iff, two_mul], + exact (add_add_add_comm _ _ 1 1).trans_le (add_le_add hai hbi), +end + +lemma sum_sq_le_of_mem_box (hx : x ∈ box n d) : ∑ i : fin n, (x i)^2 ≤ n * (d - 1)^2 := +begin + rw mem_box at hx, + have : ∀ i, x i ^ 2 ≤ (d - 1) ^ 2 := λ i, nat.pow_le_pow_of_le_left (nat.le_pred_of_lt (hx i)) _, + exact (sum_le_card_nsmul univ _ _ $ λ i _, this i).trans (by rw [card_fin, smul_eq_mul]), +end + +lemma sum_eq : ∑ i : fin n, d * (2 * d + 1) ^ (i : ℕ) = ((2 * d + 1) ^ n - 1) / 2 := +begin + refine (nat.div_eq_of_eq_mul_left zero_lt_two _).symm, + rw [←sum_range (λ i, d * (2 * d + 1) ^ (i : ℕ)), ←mul_sum, mul_right_comm, mul_comm d, + ←geom_sum_mul_add, add_tsub_cancel_right, mul_comm], +end + +lemma sum_lt : ∑ i : fin n, d * (2 * d + 1) ^ (i : ℕ) < (2 * d + 1) ^ n := +sum_eq.trans_lt $ (nat.div_le_self _ 2).trans_lt $ pred_lt (pow_pos (succ_pos _) _).ne' + +lemma card_sphere_le_roth_number_nat (n d k : ℕ) : + (sphere n d k).card ≤ roth_number_nat ((2 * d - 1) ^ n) := +begin + cases n, + { refine (card_le_univ _).trans_eq _, + rw pow_zero, + exact fintype.card_unique }, + cases d, + { simp }, + refine add_salem_spencer_image_sphere.le_roth_number_nat _ _ (card_image_of_inj_on _), + { simp only [subset_iff, mem_image, and_imp, forall_exists_index, mem_range, + forall_apply_eq_imp_iff₂, sphere, mem_filter], + rintro _ x hx _ rfl, + exact (map_le_of_mem_box hx).trans_lt sum_lt }, + refine map_inj_on.mono (λ x, _), + simp only [mem_coe, sphere, mem_filter, mem_box, and_imp, two_mul], + exact λ h _ i, (h i).trans_le le_self_add, +end + +/-! +### Optimization + +Now that we know how to turn the integer points of any sphere into a Salem-Spencer set, we find a +sphere containing many integer points by the pigeonhole principle. This gives us an implicit bound +that we then optimize by tweaking the parameters. The (almost) optimal parameters are +`behrend.n_value` and `behrend.d_value`. +-/ + +lemma exists_large_sphere_aux (n d : ℕ) : + ∃ k ∈ range (n * (d - 1)^2 + 1), (↑(d ^ n) / (↑(n * (d - 1)^2) + 1) : ℝ) ≤ (sphere n d k).card := +begin + refine exists_le_card_fiber_of_nsmul_le_card_of_maps_to (λ x hx, _) nonempty_range_succ _, + { rw [mem_range, lt_succ_iff], + exact sum_sq_le_of_mem_box hx }, + { rw [card_range, _root_.nsmul_eq_mul, mul_div_assoc', cast_add_one, mul_div_cancel_left, + card_box], + exact (cast_add_one_pos _).ne' } +end + +lemma exists_large_sphere (n d : ℕ) : ∃ k, (d ^ n / ↑(n * d^2) : ℝ) ≤ (sphere n d k).card := +begin + obtain ⟨k, -, hk⟩ := exists_large_sphere_aux n d, + refine ⟨k, _⟩, + obtain rfl | hn := n.eq_zero_or_pos, + { simp }, + obtain rfl | hd := d.eq_zero_or_pos, + { simp }, + rw ←cast_pow, + refine (div_le_div_of_le_left _ _ _).trans hk, + { exact cast_nonneg _ }, + { exact cast_add_one_pos _ }, + simp only [←le_sub_iff_add_le', cast_mul, ←mul_sub, cast_pow, cast_sub hd, sub_sq, + one_pow, cast_one, mul_one, sub_add, sub_sub_self], + apply one_le_mul_of_one_le_of_one_le, + { rwa one_le_cast }, + rw le_sub_iff_add_le, + norm_num, + exact one_le_cast.2 hd, +end + +lemma bound_aux' (n d : ℕ) : (d ^ n / ↑(n * d^2) : ℝ) ≤ roth_number_nat ((2 * d - 1)^n) := +let ⟨k, h⟩ := exists_large_sphere n d in h.trans $ cast_le.2 $ card_sphere_le_roth_number_nat _ _ _ + +lemma bound_aux (hd : d ≠ 0) (hn : 2 ≤ n) : + (d ^ (n - 2) / n : ℝ) ≤ roth_number_nat ((2 * d - 1)^n) := +begin + convert bound_aux' n d using 1, + rw [cast_mul, cast_pow, mul_comm, ←div_div, pow_sub₀ _ _ hn, ←div_eq_mul_inv], + rwa cast_ne_zero, +end + +open_locale filter topology +open real + +section numerical_bounds + +lemma log_two_mul_two_le_sqrt_log_eight : log 2 * 2 ≤ sqrt (log 8) := +begin + rw [show (8 : ℝ) = 2 ^ ((3 : ℕ) : ℝ), by norm_num1, log_rpow zero_lt_two (3:ℕ)], + apply le_sqrt_of_sq_le, + rw [mul_pow, sq (log 2), mul_assoc, mul_comm], + refine mul_le_mul_of_nonneg_right _ (log_nonneg one_le_two), + rw ←le_div_iff, + apply log_two_lt_d9.le.trans, + all_goals { norm_num1 } +end + +lemma two_div_one_sub_two_div_e_le_eight : 2 / (1 - 2 / exp 1) ≤ 8 := +begin + rw [div_le_iff, mul_sub, mul_one, mul_div_assoc', le_sub_comm, div_le_iff (exp_pos _)], + { linarith [exp_one_gt_d9] }, + rw [sub_pos, div_lt_one]; + exact exp_one_gt_d9.trans' (by norm_num), +end + +lemma le_sqrt_log (hN : 4096 ≤ N) : log (2 / (1 - 2 / exp 1)) * (69 / 50) ≤ sqrt (log ↑N) := +begin + have : ((12 : ℕ) : ℝ) * log 2 ≤ log N, + { rw [←log_rpow zero_lt_two, log_le_log, rpow_nat_cast], + { norm_num1, + exact_mod_cast hN }, + { exact rpow_pos_of_pos zero_lt_two _ }, + rw cast_pos, + exact hN.trans_lt' (by norm_num1) }, + refine (mul_le_mul_of_nonneg_right ((log_le_log _ $ by norm_num1).2 + two_div_one_sub_two_div_e_le_eight) $ by norm_num1).trans (_), + { refine div_pos zero_lt_two _, + rw [sub_pos, div_lt_one (exp_pos _)], + exact exp_one_gt_d9.trans_le' (by norm_num1) }, + have l8 : log 8 = (3 : ℕ) * log 2, + { rw [←log_rpow zero_lt_two, rpow_nat_cast], + norm_num }, + rw [l8, cast_bit1, cast_one], + apply le_sqrt_of_sq_le (le_trans _ this), + simp only [cast_bit0, cast_bit1, cast_one], + rw [mul_right_comm, mul_pow, sq (log 2), ←mul_assoc], + apply mul_le_mul_of_nonneg_right _ (log_nonneg one_le_two), + rw ←le_div_iff' , + { exact log_two_lt_d9.le.trans (by norm_num1) }, + exact sq_pos_of_ne_zero _ (by norm_num1), +end + +lemma exp_neg_two_mul_le {x : ℝ} (hx : 0 < x) : exp (-2 * x) < exp (2 - ⌈x⌉₊) / ⌈x⌉₊ := +begin + have h₁ := ceil_lt_add_one hx.le, + have h₂ : 1 - x ≤ 2 - ⌈x⌉₊, + { rw le_sub_iff_add_le, + apply (add_le_add_left h₁.le _).trans_eq, + rw [←add_assoc, sub_add_cancel], + refl }, + have h₃ : exp (-(x+1)) ≤ 1 / (x + 1), + { rw [exp_neg, inv_eq_one_div], + refine one_div_le_one_div_of_le (add_pos hx zero_lt_one) _, + apply le_trans _ (add_one_le_exp_of_nonneg $ add_nonneg hx.le zero_le_one), + exact le_add_of_nonneg_right zero_le_one }, + refine lt_of_le_of_lt _ (div_lt_div_of_lt_left (exp_pos _) (cast_pos.2 $ ceil_pos.2 hx) h₁), + refine le_trans _ (div_le_div_of_le_of_nonneg (exp_le_exp.2 h₂) $ add_nonneg hx.le zero_le_one), + rw [le_div_iff (add_pos hx zero_lt_one), ←le_div_iff' (exp_pos _), ←exp_sub, neg_mul, + sub_neg_eq_add, two_mul, sub_add_add_cancel, add_comm _ x], + refine le_trans _ (add_one_le_exp_of_nonneg $ add_nonneg hx.le zero_le_one), + exact le_add_of_nonneg_right zero_le_one, +end + +lemma div_lt_floor {x : ℝ} (hx : 2 / (1 - 2 / exp 1) ≤ x) : x / exp 1 < (⌊x/2⌋₊ : ℝ) := +begin + apply lt_of_le_of_lt _ (sub_one_lt_floor _), + have : 0 < 1 - 2 / exp 1, + { rw [sub_pos, div_lt_one (exp_pos _)], + exact lt_of_le_of_lt (by norm_num) exp_one_gt_d9 }, + rwa [le_sub_comm, div_eq_mul_one_div x, div_eq_mul_one_div x, ←mul_sub, div_sub', + ←div_eq_mul_one_div, mul_div_assoc', one_le_div, ←div_le_iff this], + { exact zero_lt_two }, + { exact two_ne_zero } +end + +lemma ceil_lt_mul {x : ℝ} (hx : 50/19 ≤ x) : (⌈x⌉₊ : ℝ) < 1.38 * x := +begin + refine (ceil_lt_add_one $ hx.trans' $ by norm_num).trans_le _, + rwa [←le_sub_iff_add_le', ←sub_one_mul, show (69/50 - 1 : ℝ) = (50/19)⁻¹, by norm_num1, + ←div_eq_inv_mul, one_le_div], + norm_num1, +end + +end numerical_bounds + +/-- The (almost) optimal value of `n` in `behrend.bound_aux`. -/ +noncomputable def n_value (N : ℕ) : ℕ := ⌈sqrt (log N)⌉₊ + +/-- The (almost) optimal value of `d` in `behrend.bound_aux`. -/ +noncomputable def d_value (N : ℕ) : ℕ := ⌊(N : ℝ)^(1 / n_value N : ℝ)/2⌋₊ + +lemma n_value_pos (hN : 2 ≤ N) : 0 < n_value N := +ceil_pos.2 $ real.sqrt_pos.2 $ log_pos $ one_lt_cast.2 $ hN + +lemma two_le_n_value (hN : 3 ≤ N) : 2 ≤ n_value N := +begin + refine succ_le_of_lt (lt_ceil.2 $ lt_sqrt_of_sq_lt _), + rw [cast_one, one_pow, lt_log_iff_exp_lt], + refine lt_of_lt_of_le _ (cast_le.2 hN), + { exact exp_one_lt_d9.trans_le (by norm_num) }, + rw cast_pos, + exact (zero_lt_succ _).trans_le hN, +end + +lemma three_le_n_value (hN : 64 ≤ N) : 3 ≤ n_value N := +begin + rw [n_value, ←lt_iff_add_one_le, lt_ceil, cast_two], + apply lt_sqrt_of_sq_lt, + have : (2 : ℝ)^((6 : ℕ) : ℝ) ≤ N, + { rw rpow_nat_cast, + exact (cast_le.2 hN).trans' (by norm_num1) }, + apply lt_of_lt_of_le _ ((log_le_log (rpow_pos_of_pos zero_lt_two _) _).2 this), + rw [log_rpow zero_lt_two, cast_bit0, cast_bit1, cast_one, ←div_lt_iff'], + { exact log_two_gt_d9.trans_le' (by norm_num1) }, + { norm_num1 }, + rw cast_pos, + exact hN.trans_lt' (by norm_num1), +end + +lemma d_value_pos (hN₃ : 8 ≤ N) : 0 < d_value N := +begin + have hN₀ : 0 < (N : ℝ) := cast_pos.2 (succ_pos'.trans_le hN₃), + rw [d_value, floor_pos, ←log_le_log zero_lt_one, log_one, log_div _ two_ne_zero, log_rpow hN₀, + div_mul_eq_mul_div, one_mul, sub_nonneg, le_div_iff], + { have : (n_value N : ℝ) ≤ 2 * sqrt (log N), + { apply (ceil_lt_add_one $ sqrt_nonneg _).le.trans, + rw [two_mul, add_le_add_iff_left], + apply le_sqrt_of_sq_le, + rw [one_pow, le_log_iff_exp_le hN₀], + exact (exp_one_lt_d9.le.trans $ by norm_num).trans (cast_le.2 hN₃) }, + apply (mul_le_mul_of_nonneg_left this $ log_nonneg one_le_two).trans _, + rw [←mul_assoc, ←le_div_iff (real.sqrt_pos.2 $ log_pos $ one_lt_cast.2 _), div_sqrt], + { apply log_two_mul_two_le_sqrt_log_eight.trans, + apply real.sqrt_le_sqrt, + rw log_le_log _ hN₀, + { exact_mod_cast hN₃ }, + { norm_num } }, + exact hN₃.trans_lt' (by norm_num) }, + { exact cast_pos.2 (n_value_pos $ hN₃.trans' $ by norm_num) }, + { exact (rpow_pos_of_pos hN₀ _).ne' }, + { exact div_pos (rpow_pos_of_pos hN₀ _) zero_lt_two }, +end + +lemma le_N (hN : 2 ≤ N) : (2 * (d_value N) - 1)^(n_value N) ≤ N := +begin + have : (2 * d_value N - 1)^(n_value N) ≤ (2 * d_value N)^(n_value N) := + nat.pow_le_pow_of_le_left (nat.sub_le _ _) _, + apply this.trans, + suffices : ((2 * d_value N)^n_value N : ℝ) ≤ N, by exact_mod_cast this, + rw ←rpow_nat_cast, + suffices i : (2 * d_value N : ℝ) ≤ (N : ℝ)^(1/n_value N : ℝ), + { apply (rpow_le_rpow (mul_nonneg zero_le_two (cast_nonneg _)) i (cast_nonneg _)).trans, + rw [←rpow_mul (cast_nonneg _), one_div_mul_cancel, rpow_one], + rw cast_ne_zero, + apply (n_value_pos hN).ne', }, + rw ←le_div_iff', + { exact floor_le (div_nonneg (rpow_nonneg_of_nonneg (cast_nonneg _) _) zero_le_two) }, + apply zero_lt_two +end + +lemma bound (hN : 4096 ≤ N) : (N : ℝ)^(1/n_value N : ℝ) / exp 1 < d_value N := +begin + apply div_lt_floor _, + rw [←log_le_log, log_rpow, mul_comm, ←div_eq_mul_one_div], + { apply le_trans _ (div_le_div_of_le_left _ _ (ceil_lt_mul _).le), + rw [mul_comm, ←div_div, div_sqrt, le_div_iff], + { exact le_sqrt_log hN }, + { norm_num1 }, + { apply log_nonneg, + rw one_le_cast, + exact hN.trans' (by norm_num1) }, + { rw [cast_pos, lt_ceil, cast_zero, real.sqrt_pos], + refine log_pos _, + rw one_lt_cast, + exact hN.trans_lt' (by norm_num1) }, + apply le_sqrt_of_sq_le, + have : ((12 : ℕ) : ℝ) * log 2 ≤ log N, + { rw [←log_rpow zero_lt_two, log_le_log, rpow_nat_cast], + { norm_num1, + exact_mod_cast hN }, + { exact rpow_pos_of_pos zero_lt_two _ }, + rw cast_pos, + exact hN.trans_lt' (by norm_num1) }, + refine le_trans _ this, + simp only [cast_bit0, cast_bit1, cast_one], + rw ←div_le_iff', + { exact log_two_gt_d9.le.trans' (by norm_num1) }, + { norm_num1 } }, + { rw cast_pos, + exact hN.trans_lt' (by norm_num1) }, + { refine div_pos zero_lt_two _, + rw [sub_pos, div_lt_one (exp_pos _)], + exact lt_of_le_of_lt (by norm_num1) exp_one_gt_d9 }, + apply rpow_pos_of_pos, + rw cast_pos, + exact hN.trans_lt' (by norm_num1), +end + +lemma roth_lower_bound_explicit (hN : 4096 ≤ N) : + (N : ℝ) * exp (-4 * sqrt (log N)) < roth_number_nat N := +begin + let n := n_value N, + have hn : 0 < (n : ℝ) := cast_pos.2 (n_value_pos $ hN.trans' $ by norm_num1), + have hd : 0 < d_value N := d_value_pos (hN.trans' $ by norm_num1), + have hN₀ : 0 < (N : ℝ) := cast_pos.2 (hN.trans' $ by norm_num1), + have hn₂ : 2 ≤ n := two_le_n_value (hN.trans' $ by norm_num1), + have : (2 * d_value N - 1)^n ≤ N := le_N (hN.trans' $ by norm_num1), + refine ((bound_aux hd.ne' hn₂).trans $ cast_le.2 $ roth_number_nat.mono this).trans_lt' _, + refine (div_lt_div_of_lt hn $ pow_lt_pow_of_lt_left (bound hN) _ _).trans_le' _, + { exact div_nonneg (rpow_nonneg_of_nonneg (cast_nonneg _) _) (exp_pos _).le }, + { exact tsub_pos_of_lt (three_le_n_value $ hN.trans' $ by norm_num1) }, + rw [←rpow_nat_cast, div_rpow (rpow_nonneg_of_nonneg hN₀.le _) (exp_pos _).le, ←rpow_mul hN₀.le, + mul_comm (_ / _), mul_one_div, cast_sub hn₂, cast_two, same_sub_div hn.ne', exp_one_rpow, + div_div, rpow_sub hN₀, rpow_one, div_div, div_eq_mul_inv], + refine mul_le_mul_of_nonneg_left _ (cast_nonneg _), + rw [mul_inv, mul_inv, ←exp_neg, ←rpow_neg (cast_nonneg _), neg_sub, ←div_eq_mul_inv], + have : exp ((-4) * sqrt (log N)) = exp (-2 * sqrt (log N)) * exp (-2 * sqrt (log N)), + { rw [←exp_add, ←add_mul], + norm_num }, + rw this, + refine (mul_le_mul _ (exp_neg_two_mul_le $ real.sqrt_pos.2 $ log_pos _).le (exp_pos _).le $ + rpow_nonneg_of_nonneg (cast_nonneg _) _), + { rw [←le_log_iff_exp_le (rpow_pos_of_pos hN₀ _), log_rpow hN₀, ←le_div_iff, mul_div_assoc, + div_sqrt, neg_mul, neg_le_neg_iff, div_mul_eq_mul_div, div_le_iff hn], + { exact mul_le_mul_of_nonneg_left (le_ceil _) zero_le_two }, + refine real.sqrt_pos.2 (log_pos _), + rw one_lt_cast, + exact hN.trans_lt' (by norm_num1) }, + { rw one_lt_cast, + exact hN.trans_lt' (by norm_num1) } +end + +lemma exp_four_lt : exp 4 < 64 := +begin + rw [show (64 : ℝ) = 2 ^ ((6 : ℕ) : ℝ), by norm_num1, + ←lt_log_iff_exp_lt (rpow_pos_of_pos zero_lt_two _), log_rpow zero_lt_two, ←div_lt_iff'], + exact log_two_gt_d9.trans_le' (by norm_num1), + norm_num +end + +lemma four_zero_nine_six_lt_exp_sixteen : 4096 < exp 16 := +begin + rw [←log_lt_iff_lt_exp (show (0 : ℝ) < 4096, by norm_num), show (4096 : ℝ) = 2 ^ 12, by norm_num, + ←rpow_nat_cast, log_rpow zero_lt_two, cast_bit0, cast_bit0, cast_bit1, cast_one], + linarith [log_two_lt_d9], +end + +lemma lower_bound_le_one' (hN : 2 ≤ N) (hN' : N ≤ 4096) : (N : ℝ) * exp (-4 * sqrt (log N)) ≤ 1 := +begin + rw [←log_le_log (mul_pos (cast_pos.2 (zero_lt_two.trans_le hN)) (exp_pos _)) zero_lt_one, + log_one, log_mul (cast_pos.2 (zero_lt_two.trans_le hN)).ne' (exp_pos _).ne', log_exp, + neg_mul, ←sub_eq_add_neg, sub_nonpos, ←div_le_iff (real.sqrt_pos.2 $ log_pos $ + one_lt_cast.2 $ one_lt_two.trans_le hN), div_sqrt, sqrt_le_left + (zero_le_bit0.2 zero_le_two), log_le_iff_le_exp (cast_pos.2 (zero_lt_two.trans_le hN))], + norm_num1, + apply le_trans _ four_zero_nine_six_lt_exp_sixteen.le, + exact_mod_cast hN', +end + +lemma lower_bound_le_one (hN : 1 ≤ N) (hN' : N ≤ 4096) : (N : ℝ) * exp (-4 * sqrt (log N)) ≤ 1 := +begin + obtain rfl | hN := hN.eq_or_lt, + { norm_num }, + { exact lower_bound_le_one' hN hN' } +end + +lemma roth_lower_bound : (N : ℝ) * exp (-4 * sqrt (log N)) ≤ roth_number_nat N := +begin + obtain rfl | hN := nat.eq_zero_or_pos N, + { norm_num }, + obtain h₁ | h₁ := le_or_lt 4096 N, + { exact (roth_lower_bound_explicit h₁).le }, + { apply (lower_bound_le_one hN h₁.le).trans, + simpa using roth_number_nat.monotone hN } +end + +end behrend diff --git a/src/combinatorics/additive/e_transform.lean b/src/combinatorics/additive/e_transform.lean new file mode 100644 index 0000000000000..cee3e26fab0fd --- /dev/null +++ b/src/combinatorics/additive/e_transform.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2023 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.finset.pointwise + +/-! +# e-transforms + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +e-transforms are a family of transformations of pairs of finite sets that aim to reduce the size +of the sumset while keeping some invariant the same. This file defines a few of them, to be used +as internals of other proofs. + +## Main declarations + +* `finset.mul_dyson_e_transform`: The Dyson e-transform. Replaces `(s, t)` by + `(s ∪ e • t, t ∩ e⁻¹ • s)`. The additive version preserves `|s ∩ [1, m]| + |t ∩ [1, m - e]|`. +* `finset.mul_e_transform_left`/`finset.mul_e_transform_right`: Replace `(s, t)` by + `(s ∩ s • e, t ∪ e⁻¹ • t)` and `(s ∪ s • e, t ∩ e⁻¹ • t)`. Preserve (together) the sum of + the cardinalities (see `finset.mul_e_transform.card`). In particular, one of the two transforms + increases the sum of the cardinalities and the other one decreases it. See + `le_or_lt_of_add_le_add` and around. + +## TODO + +Prove the invariance property of the Dyson e-transform. +-/ + +open mul_opposite +open_locale pointwise + +variables {α : Type*} [decidable_eq α] + +namespace finset + +/-! ### Dyson e-transform -/ + +section comm_group +variables [comm_group α] (e : α) (x : finset α × finset α) + +/-- The **Dyson e-transform**. Turns `(s, t)` into `(s ∪ e • t, t ∩ e⁻¹ • s)`. This reduces the +product of the two sets. -/ +@[to_additive "The **Dyson e-transform**. Turns `(s, t)` into `(s ∪ e +ᵥ t, t ∩ -e +ᵥ s)`. This +reduces the sum of the two sets.", simps] +def mul_dyson_e_transform : finset α × finset α := (x.1 ∪ e • x.2, x.2 ∩ e⁻¹ • x.1) + +@[to_additive] lemma mul_dyson_e_transform.subset : + (mul_dyson_e_transform e x).1 * (mul_dyson_e_transform e x).2 ⊆ x.1 * x.2 := +begin + refine union_mul_inter_subset_union.trans (union_subset subset.rfl _), + rw [mul_smul_comm, smul_mul_assoc, inv_smul_smul, mul_comm], + refl, +end + +@[to_additive] lemma mul_dyson_e_transform.card : + (mul_dyson_e_transform e x).1.card + (mul_dyson_e_transform e x).2.card = x.1.card + x.2.card := +begin + dsimp, + rw [←card_smul_finset e (_ ∩ _), smul_finset_inter, smul_inv_smul, inter_comm, + card_union_add_card_inter, card_smul_finset], +end + +@[simp, to_additive] lemma mul_dyson_e_transform_idem : + mul_dyson_e_transform e (mul_dyson_e_transform e x) = mul_dyson_e_transform e x := +begin + ext : 1; dsimp, + { rw [smul_finset_inter, smul_inv_smul, inter_comm, union_eq_left_iff_subset], + exact inter_subset_union }, + { rw [smul_finset_union, inv_smul_smul, union_comm, inter_eq_left_iff_subset], + exact inter_subset_union } +end + +variables {e x} + +@[to_additive] lemma mul_dyson_e_transform.smul_finset_snd_subset_fst : + e • (mul_dyson_e_transform e x).2 ⊆ (mul_dyson_e_transform e x).1 := +by { dsimp, rw [smul_finset_inter, smul_inv_smul, inter_comm], exact inter_subset_union } + +end comm_group + +/-! +### Two unnamed e-transforms + +The following two transforms both reduce the product/sum of the two sets. Further, one of them must +decrease the sum of the size of the sets (and then the other increases it). + +This pair of transforms doesn't seem to be named in the literature. It is used by Sanders in his +bound on Roth numbers, and by DeVos in his proof of Cauchy-Davenport. +-/ + +section group +variables [group α] (e : α) (x : finset α × finset α) + +/-- An **e-transform**. Turns `(s, t)` into `(s ∩ s • e, t ∪ e⁻¹ • t)`. This reduces the +product of the two sets. -/ +@[to_additive "An **e-transform**. Turns `(s, t)` into `(s ∩ s +ᵥ e, t ∪ -e +ᵥ t)`. This +reduces the sum of the two sets.", simps] +def mul_e_transform_left : finset α × finset α := (x.1 ∩ op e • x.1, x.2 ∪ e⁻¹ • x.2) + +/-- An **e-transform**. Turns `(s, t)` into `(s ∪ s • e, t ∩ e⁻¹ • t)`. This reduces the product of +the two sets. -/ +@[to_additive "An **e-transform**. Turns `(s, t)` into `(s ∪ s +ᵥ e, t ∩ -e +ᵥ t)`. This reduces the +sum of the two sets.", simps] +def mul_e_transform_right : finset α × finset α := (x.1 ∪ op e • x.1, x.2 ∩ e⁻¹ • x.2) + +@[simp, to_additive] lemma mul_e_transform_left_one : mul_e_transform_left 1 x = x := +by simp [mul_e_transform_left] +@[simp, to_additive] lemma mul_e_transform_right_one : mul_e_transform_right 1 x = x := +by simp [mul_e_transform_right] + +@[to_additive] lemma mul_e_transform_left.fst_mul_snd_subset : + (mul_e_transform_left e x).1 * (mul_e_transform_left e x).2 ⊆ x.1 * x.2 := +begin + refine inter_mul_union_subset_union.trans (union_subset subset.rfl _), + rw [op_smul_finset_mul_eq_mul_smul_finset, smul_inv_smul], + refl, +end + +@[to_additive] lemma mul_e_transform_right.fst_mul_snd_subset : + (mul_e_transform_right e x).1 * (mul_e_transform_right e x).2 ⊆ x.1 * x.2 := +begin + refine union_mul_inter_subset_union.trans (union_subset subset.rfl _), + rw [op_smul_finset_mul_eq_mul_smul_finset, smul_inv_smul], + refl, +end + +@[to_additive] lemma mul_e_transform_left.card : + (mul_e_transform_left e x).1.card + (mul_e_transform_right e x).1.card = 2 * x.1.card := +(card_inter_add_card_union _ _).trans $ by rw [card_smul_finset, two_mul] + +@[to_additive] lemma mul_e_transform_right.card : + (mul_e_transform_left e x).2.card + (mul_e_transform_right e x).2.card = 2 * x.2.card := +(card_union_add_card_inter _ _).trans $ by rw [card_smul_finset, two_mul] + +/-- This statement is meant to be combined with `le_or_lt_of_add_le_add` and similar lemmas. -/ +@[to_additive add_e_transform.card "This statement is meant to be combined with +`le_or_lt_of_add_le_add` and similar lemmas."] +protected lemma mul_e_transform.card : + (mul_e_transform_left e x).1.card + (mul_e_transform_left e x).2.card + + ((mul_e_transform_right e x).1.card + (mul_e_transform_right e x).2.card) + = x.1.card + x.2.card + (x.1.card + x.2.card) := +by rw [add_add_add_comm, mul_e_transform_left.card, mul_e_transform_right.card, ←mul_add, two_mul] + +end group + +section comm_group +variables [comm_group α] (e : α) (x : finset α × finset α) + +@[simp, to_additive] lemma mul_e_transform_left_inv : + mul_e_transform_left e⁻¹ x = (mul_e_transform_right e x.swap).swap := +by simp [-op_inv, op_smul_eq_smul, mul_e_transform_left, mul_e_transform_right] + +@[simp, to_additive] lemma mul_e_transform_right_inv : + mul_e_transform_right e⁻¹ x = (mul_e_transform_left e x.swap).swap := +by simp [-op_inv, op_smul_eq_smul, mul_e_transform_left, mul_e_transform_right] + +end comm_group +end finset diff --git a/src/combinatorics/additive/energy.lean b/src/combinatorics/additive/energy.lean new file mode 100644 index 0000000000000..cb6bbc075dfa7 --- /dev/null +++ b/src/combinatorics/additive/energy.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2022 Yaël Dillies, Ella Yu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Ella Yu +-/ +import data.finset.prod +import data.fintype.prod + +/-! +# Additive energy + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the additive energy of two finsets of a group. This is a central quantity in +additive combinatorics. + +## TODO + +It's possibly interesting to have +`(s ×ˢ s) ×ˢ t ×ˢ t).filter (λ x : (α × α) × α × α, x.1.1 * x.2.1 = x.1.2 * x.2.2)` (whose `card` is +`multiplicative_energy s t`) as a standalone definition. +-/ + +section +variables {α : Type*} [partial_order α] {x y : α} + +end + +variables {α : Type*} [decidable_eq α] + +namespace finset +section has_mul +variables [has_mul α] {s s₁ s₂ t t₁ t₂ : finset α} + +/-- The multiplicative energy of two finsets `s` and `t` in a group is the number of quadruples +`(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ * b₁ = a₂ * b₂`. -/ +@[to_additive additive_energy "The additive energy of two finsets `s` and `t` in a group is the +number of quadruples `(a₁, a₂, b₁, b₂) ∈ s × s × t × t` such that `a₁ + b₁ = a₂ + b₂`."] +def multiplicative_energy (s t : finset α) : ℕ := +(((s ×ˢ s) ×ˢ t ×ˢ t).filter $ λ x : (α × α) × α × α, x.1.1 * x.2.1 = x.1.2 * x.2.2).card + +@[to_additive additive_energy_mono] +lemma multiplicative_energy_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : + multiplicative_energy s₁ t₁ ≤ multiplicative_energy s₂ t₂ := +card_le_of_subset $ filter_subset_filter _ $ product_subset_product (product_subset_product hs hs) $ + product_subset_product ht ht + +@[to_additive additive_energy_mono_left] +lemma multiplicative_energy_mono_left (hs : s₁ ⊆ s₂) : + multiplicative_energy s₁ t ≤ multiplicative_energy s₂ t := +multiplicative_energy_mono hs subset.rfl + +@[to_additive additive_energy_mono_right] +lemma multiplicative_energy_mono_right (ht : t₁ ⊆ t₂) : + multiplicative_energy s t₁ ≤ multiplicative_energy s t₂ := +multiplicative_energy_mono subset.rfl ht + +@[to_additive le_additive_energy] +lemma le_multiplicative_energy : s.card * t.card ≤ multiplicative_energy s t := +begin + rw ←card_product, + refine card_le_card_of_inj_on (λ x, ((x.1, x.1), x.2, x.2)) (by simp [←and_imp]) (λ a _ b _, _), + simp only [prod.mk.inj_iff, and_self, and_imp], + exact prod.ext, +end + +@[to_additive additive_energy_pos] +lemma multiplicative_energy_pos (hs : s.nonempty) (ht : t.nonempty) : + 0 < multiplicative_energy s t := +(mul_pos hs.card_pos ht.card_pos).trans_le le_multiplicative_energy + +variables (s t) + +@[simp, to_additive additive_energy_empty_left] +lemma multiplicative_energy_empty_left : multiplicative_energy ∅ t = 0 := +by simp [multiplicative_energy] + +@[simp, to_additive additive_energy_empty_right] +lemma multiplicative_energy_empty_right : multiplicative_energy s ∅ = 0 := +by simp [multiplicative_energy] + +variables {s t} + +@[simp, to_additive additive_energy_pos_iff] +lemma multiplicative_energy_pos_iff : 0 < multiplicative_energy s t ↔ s.nonempty ∧ t.nonempty := +⟨λ h, of_not_not $ λ H, begin + simp_rw [not_and_distrib, not_nonempty_iff_eq_empty] at H, + obtain rfl | rfl := H; simpa [nat.not_lt_zero] using h, +end, λ h, multiplicative_energy_pos h.1 h.2⟩ + +@[simp, to_additive additive_energy_eq_zero_iff] +lemma multiplicative_energy_eq_zero_iff : multiplicative_energy s t = 0 ↔ s = ∅ ∨ t = ∅ := +by simp [←(nat.zero_le _).not_gt_iff_eq, not_and_distrib] + +end has_mul + +section comm_monoid +variables [comm_monoid α] + +@[to_additive additive_energy_comm] +lemma multiplicative_energy_comm (s t : finset α) : + multiplicative_energy s t = multiplicative_energy t s := +begin + rw [multiplicative_energy, ←finset.card_map (equiv.prod_comm _ _).to_embedding, map_filter], + simp [-finset.card_map, eq_comm, multiplicative_energy, mul_comm, map_eq_image, function.comp], +end + +end comm_monoid + +section comm_group +variables [comm_group α] [fintype α] (s t : finset α) + +@[simp, to_additive additive_energy_univ_left] +lemma multiplicative_energy_univ_left : + multiplicative_energy univ t = fintype.card α * t.card ^ 2 := +begin + simp only [multiplicative_energy, univ_product_univ, fintype.card, sq, ←card_product], + set f : α × α × α → (α × α) × α × α := λ x, ((x.1 * x.2.2, x.1 * x.2.1), x.2) with hf, + have : (↑((univ : finset α) ×ˢ t ×ˢ t) : set (α × α × α)).inj_on f, + { rintro ⟨a₁, b₁, c₁⟩ h₁ ⟨a₂, b₂, c₂⟩ h₂ h, + simp_rw prod.ext_iff at h, + obtain ⟨h, rfl, rfl⟩ := h, + rw mul_right_cancel h.1 }, + rw [←card_image_of_inj_on this], + congr' with a, + simp only [hf, mem_filter, mem_product, mem_univ, true_and, mem_image, exists_prop, prod.exists], + refine ⟨λ h, ⟨a.1.1 * a.2.2⁻¹, _, _, h.1, by simp [mul_right_comm, h.2]⟩, _⟩, + rintro ⟨b, c, d, hcd, rfl⟩, + simpa [mul_right_comm], +end + +@[simp, to_additive additive_energy_univ_right] +lemma multiplicative_energy_univ_right : + multiplicative_energy s univ = fintype.card α * s.card ^ 2 := +by rw [multiplicative_energy_comm, multiplicative_energy_univ_left] + +end comm_group +end finset diff --git a/src/combinatorics/additive/pluennecke_ruzsa.lean b/src/combinatorics/additive/pluennecke_ruzsa.lean new file mode 100644 index 0000000000000..737dad50dfabf --- /dev/null +++ b/src/combinatorics/additive/pluennecke_ruzsa.lean @@ -0,0 +1,244 @@ +/- +Copyright (c) 2022 Yaël Dillies, George Shakan. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, George Shakan +-/ +import combinatorics.double_counting +import data.finset.pointwise +import data.rat.nnrat + +/-! +# The Plünnecke-Ruzsa inequality + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves Ruzsa's triangle inequality, the Plünnecke-Petridis lemma, and the Plünnecke-Ruzsa +inequality. + +## Main declarations + +* `finset.card_sub_mul_le_card_sub_mul_card_sub`: Ruzsa's triangle inequality, difference version. +* `finset.card_add_mul_le_card_add_mul_card_add`: Ruzsa's triangle inequality, sum version. +* `finset.pluennecke_petridis`: The Plünnecke-Petridis lemma. +* `finset.card_smul_div_smul_le`: The Plünnecke-Ruzsa inequality. + +## References + +* [Giorgis Petridis, *The Plünnecke-Ruzsa inequality: an overview*][petridis2014] +* [Terrence Tao, Van Vu, *Additive Combinatorics][tao-vu] +-/ + +open nat +open_locale nnrat pointwise + +namespace finset +variables {α : Type*} [comm_group α] [decidable_eq α] {A B C : finset α} + +/-- **Ruzsa's triangle inequality**. Division version. -/ +@[to_additive card_sub_mul_le_card_sub_mul_card_sub +"**Ruzsa's triangle inequality**. Subtraction version."] +lemma card_div_mul_le_card_div_mul_card_div (A B C : finset α) : + (A / C).card * B.card ≤ (A / B).card * (B / C).card := +begin + rw [←card_product (A / B), ←mul_one ((finset.product _ _).card)], + refine card_mul_le_card_mul (λ b ac, ac.1 * ac.2 = b) (λ x hx, _) + (λ x hx, card_le_one_iff.2 $ λ u v hu hv, + ((mem_bipartite_below _).1 hu).2.symm.trans ((mem_bipartite_below _).1 hv).2), + obtain ⟨a, c, ha, hc, rfl⟩ := mem_div.1 hx, + refine card_le_card_of_inj_on (λ b, (a / b, b / c)) (λ b hb, _) (λ b₁ _ b₂ _ h, _), + { rw mem_bipartite_above, + exact ⟨mk_mem_product (div_mem_div ha hb) (div_mem_div hb hc), div_mul_div_cancel' _ _ _⟩ }, + { exact div_right_injective (prod.ext_iff.1 h).1 } +end + +/-- **Ruzsa's triangle inequality**. Div-mul-mul version. -/ +@[to_additive card_sub_mul_le_card_add_mul_card_add +"**Ruzsa's triangle inequality**. Sub-add-add version."] +lemma card_div_mul_le_card_mul_mul_card_mul (A B C : finset α) : + (A / C).card * B.card ≤ (A * B).card * (B * C).card := +begin + rw [←div_inv_eq_mul, ←card_inv B, ←card_inv (B * C), mul_inv, ←div_eq_mul_inv], + exact card_div_mul_le_card_div_mul_card_div _ _ _, +end + +/-- **Ruzsa's triangle inequality**. Mul-div-div version. -/ +@[to_additive card_add_mul_le_card_sub_mul_card_add +"**Ruzsa's triangle inequality**. Add-sub-sub version."] +lemma card_mul_mul_le_card_div_mul_card_mul (A B C : finset α) : + (A * C).card * B.card ≤ (A / B).card * (B * C).card := +by { rw [←div_inv_eq_mul, ←div_inv_eq_mul B], exact card_div_mul_le_card_div_mul_card_div _ _ _ } + +/-- **Ruzsa's triangle inequality**. Mul-mul-div version. -/ +@[to_additive card_add_mul_le_card_add_mul_card_sub +"**Ruzsa's triangle inequality**. Add-add-sub version."] +lemma card_mul_mul_le_card_mul_mul_card_div (A B C : finset α) : + (A * C).card * B.card ≤ (A * B).card * (B / C).card := +by { rw [←div_inv_eq_mul, div_eq_mul_inv B], exact card_div_mul_le_card_mul_mul_card_mul _ _ _ } + +@[to_additive] +lemma mul_pluennecke_petridis (C : finset α) + (hA : ∀ A' ⊆ A, (A * B).card * A'.card ≤ (A' * B).card * A.card) : + (A * B * C).card * A.card ≤ (A * B).card * (A * C).card := +begin + induction C using finset.induction_on with x C hc ih, + { simp }, + set A' := A ∩ (A * C / {x}) with hA', + set C' := insert x C with hC', + have h₀ : A' * {x} = (A * {x}) ∩ (A * C), + { rw [hA', inter_mul_singleton, (is_unit_singleton x).div_mul_cancel] }, + have h₁ : A * B * C' = (A * B * C) ∪ (A * B * {x}) \ (A' * B * {x}), + { rw [hC', insert_eq, union_comm, mul_union], + refine (sup_sdiff_eq_sup _).symm, + rw [mul_right_comm, mul_right_comm A, h₀], + exact mul_subset_mul_right (inter_subset_right _ _) }, + have h₂ : A' * B * {x} ⊆ A * B * {x} := + mul_subset_mul_right (mul_subset_mul_right $ inter_subset_left _ _), + have h₃ : (A * B * C').card ≤ (A * B * C).card + (A * B).card - (A' * B).card, + { rw h₁, + refine (card_union_le _ _).trans_eq _, + rw [card_sdiff h₂, ←add_tsub_assoc_of_le (card_le_of_subset h₂), card_mul_singleton, + card_mul_singleton] }, + refine (mul_le_mul_right' h₃ _).trans _, + rw [tsub_mul, add_mul], + refine (tsub_le_tsub (add_le_add_right ih _) $ hA _ $ inter_subset_left _ _).trans_eq _, + rw [←mul_add, ←mul_tsub, ←hA', insert_eq, mul_union, ←card_mul_singleton A x, + ←card_mul_singleton A' x, add_comm (card _), h₀, + eq_tsub_of_add_eq (card_union_add_card_inter _ _)], +end + +/-! ### Sum triangle inequality -/ + +-- Auxiliary lemma for Ruzsa's triangle sum inequality, and the Plünnecke-Ruzsa inequality. +@[to_additive] +private lemma mul_aux (hA : A.nonempty) (hAB : A ⊆ B) + (h : ∀ A' ∈ B.powerset.erase ∅, ((A * C).card : ℚ≥0) / ↑(A.card) ≤ ((A' * C).card) / ↑(A'.card)) : + ∀ A' ⊆ A, (A * C).card * A'.card ≤ (A' * C).card * A.card := +begin + rintro A' hAA', + obtain rfl | hA' := A'.eq_empty_or_nonempty, + { simp }, + have hA₀ : (0 : ℚ≥0) < A.card := cast_pos.2 hA.card_pos, + have hA₀' : (0 : ℚ≥0) < A'.card := cast_pos.2 hA'.card_pos, + exact_mod_cast (div_le_div_iff hA₀ hA₀').1 (h _ $ mem_erase_of_ne_of_mem hA'.ne_empty $ + mem_powerset.2 $ hAA'.trans hAB), +end + +/-- **Ruzsa's triangle inequality**. Multiplication version. -/ +@[to_additive card_add_mul_card_le_card_add_mul_card_add +"**Ruzsa's triangle inequality**. Addition version."] +lemma card_mul_mul_card_le_card_mul_mul_card_mul (A B C : finset α) : + (A * C).card * B.card ≤ (A * B).card * (B * C).card := +begin + obtain rfl | hB := B.eq_empty_or_nonempty, + { simp }, + have hB' : B ∈ B.powerset.erase ∅ := mem_erase_of_ne_of_mem hB.ne_empty (mem_powerset_self _), + obtain ⟨U, hU, hUA⟩ := exists_min_image (B.powerset.erase ∅) (λ U, (U * A).card/U.card : _ → ℚ≥0) + ⟨B, hB'⟩, + rw [mem_erase, mem_powerset, ←nonempty_iff_ne_empty] at hU, + refine cast_le.1 (_ : (_ : ℚ≥0) ≤ _), + push_cast, + refine (le_div_iff $ by exact cast_pos.2 hB.card_pos).1 _, + rw [mul_div_right_comm, mul_comm _ B], + refine (cast_le.2 $ card_le_card_mul_left _ hU.1).trans _, + refine le_trans _ (mul_le_mul (hUA _ hB') (cast_le.2 $ card_le_of_subset $ + mul_subset_mul_right hU.2) (zero_le _) $ zero_le _), + rw [←mul_div_right_comm, ←mul_assoc], + refine (le_div_iff $ by exact cast_pos.2 hU.1.card_pos).2 _, + exact_mod_cast mul_pluennecke_petridis C (mul_aux hU.1 hU.2 hUA), +end + +/-- **Ruzsa's triangle inequality**. Add-sub-sub version. -/ +lemma card_mul_mul_le_card_div_mul_card_div (A B C : finset α) : + (A * C).card * B.card ≤ (A / B).card * (B / C).card := +begin + rw [div_eq_mul_inv, ←card_inv B, ←card_inv (B / C), inv_div', div_inv_eq_mul], + exact card_mul_mul_card_le_card_mul_mul_card_mul _ _ _, +end + +/-- **Ruzsa's triangle inequality**. Sub-add-sub version. -/ +lemma card_div_mul_le_card_mul_mul_card_div (A B C : finset α) : + (A / C).card * B.card ≤ (A * B).card * (B / C).card := +by { rw [div_eq_mul_inv, div_eq_mul_inv], exact card_mul_mul_card_le_card_mul_mul_card_mul _ _ _ } + +/-- **Ruzsa's triangle inequality**. Sub-sub-add version. -/ +lemma card_div_mul_le_card_div_mul_card_mul (A B C : finset α) : + (A / C).card * B.card ≤ (A / B).card * (B * C).card := +by { rw [←div_inv_eq_mul, div_eq_mul_inv], exact card_mul_mul_le_card_div_mul_card_div _ _ _ } + + +lemma card_add_nsmul_le {α : Type*} [add_comm_group α] [decidable_eq α] {A B : finset α} + (hAB : ∀ A' ⊆ A, (A + B).card * A'.card ≤ (A' + B).card * A.card) (n : ℕ) : + ((A + n • B).card : ℚ≥0) ≤ ((A + B).card / A.card) ^ n * A.card := +begin + obtain rfl | hA := A.eq_empty_or_nonempty, + { simp }, + induction n with n ih, + { simp }, + rw [succ_nsmul, ←add_assoc, pow_succ, mul_assoc, ←mul_div_right_comm, le_div_iff, ←cast_mul], + swap, exact (cast_pos.2 hA.card_pos), + refine (cast_le.2 $ add_pluennecke_petridis _ hAB).trans _, + rw cast_mul, + exact mul_le_mul_of_nonneg_left ih (zero_le _), +end + +@[to_additive] +lemma card_mul_pow_le (hAB : ∀ A' ⊆ A, (A * B).card * A'.card ≤ (A' * B).card * A.card) (n : ℕ) : + ((A * B ^ n).card : ℚ≥0) ≤ ((A * B).card / A.card) ^ n * A.card := +begin + obtain rfl | hA := A.eq_empty_or_nonempty, + { simp }, + induction n with n ih, + { simp }, + rw [pow_succ, ←mul_assoc, pow_succ, @mul_assoc ℚ≥0, ←mul_div_right_comm, le_div_iff, ←cast_mul], + swap, exact (cast_pos.2 hA.card_pos), + refine (cast_le.2 $ mul_pluennecke_petridis _ hAB).trans _, + rw cast_mul, + exact mul_le_mul_of_nonneg_left ih (zero_le _), +end + +/-- The **Plünnecke-Ruzsa inequality**. Multiplication version. Note that this is genuinely harder +than the division version because we cannot use a double counting argument. -/ +@[to_additive "The **Plünnecke-Ruzsa inequality**. Addition version. Note that this is genuinely +harder than the subtraction version because we cannot use a double counting argument."] +lemma card_pow_div_pow_le (hA : A.nonempty) (B : finset α) (m n : ℕ) : + ((B ^ m / B ^ n).card : ℚ≥0) ≤ ((A * B).card / A.card) ^ (m + n) * A.card := +begin + have hA' : A ∈ A.powerset.erase ∅ := mem_erase_of_ne_of_mem hA.ne_empty (mem_powerset_self _), + obtain ⟨C, hC, hCA⟩ := exists_min_image (A.powerset.erase ∅) (λ C, (C * B).card/C.card : _ → ℚ≥0) + ⟨A, hA'⟩, + rw [mem_erase, mem_powerset, ←nonempty_iff_ne_empty] at hC, + refine (mul_le_mul_right $ cast_pos.2 hC.1.card_pos).1 _, + norm_cast, + refine (cast_le.2 $ card_div_mul_le_card_mul_mul_card_mul _ _ _).trans _, + push_cast, + rw mul_comm _ C, + refine (mul_le_mul (card_mul_pow_le (mul_aux hC.1 hC.2 hCA) _) + (card_mul_pow_le (mul_aux hC.1 hC.2 hCA) _) (zero_le _) $ zero_le _).trans _, + rw [mul_mul_mul_comm, ←pow_add, ←mul_assoc], + exact mul_le_mul_of_nonneg_right (mul_le_mul (pow_le_pow_of_le_left (zero_le _) (hCA _ hA') _) + (cast_le.2 $ card_le_of_subset hC.2) (zero_le _) $ zero_le _) (zero_le _), +end + +/-- The **Plünnecke-Ruzsa inequality**. Subtraction version. -/ +@[to_additive "The **Plünnecke-Ruzsa inequality**. Subtraction version."] +lemma card_pow_div_pow_le' (hA : A.nonempty) (B : finset α) (m n : ℕ) : + ((B ^ m / B ^ n).card : ℚ≥0) ≤ ((A / B).card / A.card) ^ (m + n) * A.card := +begin + rw [←card_inv, inv_div', ←inv_pow, ←inv_pow, div_eq_mul_inv A], + exact card_pow_div_pow_le hA _ _ _, +end + +/-- Special case of the **Plünnecke-Ruzsa inequality**. Multiplication version. -/ +@[to_additive "Special case of the **Plünnecke-Ruzsa inequality**. Addition version."] +lemma card_pow_le (hA : A.nonempty) (B : finset α) (n : ℕ) : + ((B ^ n).card : ℚ≥0) ≤ ((A * B).card / A.card) ^ n * A.card := +by simpa only [pow_zero, div_one] using card_pow_div_pow_le hA _ _ 0 + +/-- Special case of the **Plünnecke-Ruzsa inequality**. Division version. -/ +@[to_additive "Special case of the **Plünnecke-Ruzsa inequality**. Subtraction version."] +lemma card_pow_le' (hA : A.nonempty) (B : finset α) (n : ℕ) : + ((B ^ n).card : ℚ≥0) ≤ ((A / B).card / A.card) ^ n * A.card := +by simpa only [pow_zero, div_one] using card_pow_div_pow_le' hA _ _ 0 + +end finset diff --git a/src/combinatorics/additive/ruzsa_covering.lean b/src/combinatorics/additive/ruzsa_covering.lean new file mode 100644 index 0000000000000..a7f65da9f18fa --- /dev/null +++ b/src/combinatorics/additive/ruzsa_covering.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.finset.pointwise + +/-! +# Ruzsa's covering lemma + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the Ruzsa covering lemma. This says that, for `s`, `t` finsets, we can cover `s` +with at most `(s + t).card / t.card` copies of `t - t`. + +## TODO + +Merge this file with other prerequisites to Freiman's theorem once we have them. +-/ + +open_locale pointwise + +namespace finset +variables {α : Type*} [decidable_eq α] [comm_group α] (s : finset α) {t : finset α} + +/-- **Ruzsa's covering lemma**. -/ +@[to_additive "**Ruzsa's covering lemma**"] +lemma exists_subset_mul_div (ht : t.nonempty) : + ∃ u : finset α, u.card * t.card ≤ (s * t).card ∧ s ⊆ u * t / t := +begin + haveI : Π u, decidable ((u : set α).pairwise_disjoint (• t)) := λ u, classical.dec _, + set C := s.powerset.filter (λ u, (u : set α).pairwise_disjoint (• t)), + obtain ⟨u, hu, hCmax⟩ := C.exists_maximal + (filter_nonempty_iff.2 ⟨∅, empty_mem_powerset _, set.pairwise_disjoint_empty⟩), + rw [mem_filter, mem_powerset] at hu, + refine ⟨u, (card_mul_iff.2 $ pairwise_disjoint_smul_iff.1 hu.2).ge.trans + (card_le_of_subset $ mul_subset_mul_right hu.1), λ a ha, _⟩, + rw mul_div_assoc, + by_cases hau : a ∈ u, + { exact subset_mul_left _ ht.one_mem_div hau }, + by_cases H : ∀ b ∈ u, disjoint (a • t) (b • t), + { refine (hCmax _ _ $ ssubset_insert hau).elim, + rw [mem_filter, mem_powerset, insert_subset, coe_insert], + exact ⟨⟨ha, hu.1⟩, hu.2.insert $ λ b hb _, H _ hb⟩ }, + push_neg at H, + simp_rw [not_disjoint_iff, ←inv_smul_mem_iff] at H, + obtain ⟨b, hb, c, hc₁, hc₂⟩ := H, + exact mem_mul.2 ⟨_, _, hb, mem_div.2 ⟨_, _, hc₂, hc₁, by simp [div_eq_mul_inv a b]⟩, by simp⟩, +end + +end finset diff --git a/src/combinatorics/additive/salem_spencer.lean b/src/combinatorics/additive/salem_spencer.lean index 4a86aae85b7b3..7b6fc3d940e27 100644 --- a/src/combinatorics/additive/salem_spencer.lean +++ b/src/combinatorics/additive/salem_spencer.lean @@ -10,6 +10,9 @@ import analysis.convex.strict_convex_space /-! # Salem-Spencer sets and Roth numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines Salem-Spencer sets and the Roth number of a set. A Salem-Spencer set is a set without arithmetic progressions of length `3`. Equivalently, the @@ -57,7 +60,7 @@ is a set such that the average of any two distinct elements is not in the set."] def mul_salem_spencer : Prop := ∀ ⦃a b c⦄, a ∈ s → b ∈ s → c ∈ s → a * b = c * c → a = b /-- Whether a given finset is Salem-Spencer is decidable. -/ -@[to_additive] +@[to_additive "Whether a given finset is Salem-Spencer is decidable."] instance {α : Type*} [decidable_eq α] [monoid α] {s : finset α} : decidable (mul_salem_spencer (s : set α)) := decidable_of_iff (∀ a ∈ s, ∀ b ∈ s, ∀ c ∈ s, a * b = c * c → a = b) @@ -194,7 +197,7 @@ lemma mul_salem_spencer_insert_of_lt (hs : ∀ i ∈ s, i < a) : begin refine mul_salem_spencer_insert.trans _, rw ←and_assoc, - exact and_iff_left (λ b c hb hc h, ((mul_lt_mul''' (hs _ hb) (hs _ hc)).ne h).elim), + exact and_iff_left (λ b c hb hc h, ((mul_lt_mul_of_lt_of_lt (hs _ hb) (hs _ hc)).ne h).elim), end end ordered_cancel_comm_monoid @@ -263,8 +266,8 @@ begin (add_halves _) hc.2, end -lemma add_salem_spencer_sphere [normed_group E] [normed_space ℝ E] [strict_convex_space ℝ E] (x : E) - (r : ℝ) : add_salem_spencer (sphere x r) := +lemma add_salem_spencer_sphere [normed_add_comm_group E] [normed_space ℝ E] + [strict_convex_space ℝ E] (x : E) (r : ℝ) : add_salem_spencer (sphere x r) := begin obtain rfl | hr := eq_or_ne r 0, { rw sphere_zero, @@ -302,7 +305,7 @@ lemma mul_roth_number_le : mul_roth_number s ≤ s.card := by convert nat.find_g @[to_additive] lemma mul_roth_number_spec : ∃ t ⊆ s, t.card = mul_roth_number s ∧ mul_salem_spencer (t : set α) := -@nat.find_greatest_spec _ (λ m, ∃ t ⊆ s, t.card = m ∧ mul_salem_spencer (t : set α)) _ _ +@nat.find_greatest_spec _ _ (λ m, ∃ t ⊆ s, t.card = m ∧ mul_salem_spencer (t : set α)) _ (nat.zero_le _) ⟨∅, empty_subset _, card_empty, mul_salem_spencer_empty⟩ variables {s t} {n : ℕ} @@ -345,7 +348,7 @@ calc @[to_additive] lemma le_mul_roth_number_product (s : finset α) (t : finset β) : - mul_roth_number s * mul_roth_number t ≤ mul_roth_number (s.product t) := + mul_roth_number s * mul_roth_number t ≤ mul_roth_number (s ×ˢ t) := begin obtain ⟨u, hus, hucard, hu⟩ := mul_roth_number_spec s, obtain ⟨v, hvt, hvcard, hv⟩ := mul_roth_number_spec t, @@ -452,12 +455,11 @@ end open asymptotics filter lemma roth_number_nat_is_O_with_id : - is_O_with 1 (λ N, (roth_number_nat N : ℝ)) (λ N, (N : ℝ)) at_top := -is_O_with.of_bound $ by simpa only [one_mul, real.norm_coe_nat, nat.cast_le] - using eventually_of_forall roth_number_nat_le + is_O_with 1 at_top (λ N, (roth_number_nat N : ℝ)) (λ N, (N : ℝ)) := +is_O_with_of_le _ $ by simpa only [real.norm_coe_nat, nat.cast_le] using roth_number_nat_le /-- The Roth number has the trivial bound `roth_number_nat N = O(N)`. -/ -lemma roth_number_nat_is_O_id : is_O (λ N, (roth_number_nat N : ℝ)) (λ N, (N : ℝ)) at_top := +lemma roth_number_nat_is_O_id : (λ N, (roth_number_nat N : ℝ)) =O[at_top] (λ N, (N : ℝ)) := roth_number_nat_is_O_with_id.is_O end roth_number_nat diff --git a/src/combinatorics/catalan.lean b/src/combinatorics/catalan.lean new file mode 100644 index 0000000000000..484d6028787cf --- /dev/null +++ b/src/combinatorics/catalan.lean @@ -0,0 +1,202 @@ +/- +Copyright (c) 2022 Julian Kuelshammer. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Julian Kuelshammer +-/ +import algebra.big_operators.fin +import algebra.big_operators.nat_antidiagonal +import algebra.char_zero.lemmas +import data.finset.nat_antidiagonal +import data.nat.choose.central +import data.tree +import tactic.field_simp +import tactic.linear_combination + +/-! +# Catalan numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The Catalan numbers (http://oeis.org/A000108) are probably the most ubiquitous sequence of integers +in mathematics. They enumerate several important objects like binary trees, Dyck paths, and +triangulations of convex polygons. + +## Main definitions + +* `catalan n`: the `n`th Catalan number, defined recursively as + `catalan (n + 1) = ∑ i : fin n.succ, catalan i * catalan (n - i)`. + +## Main results + +* `catalan_eq_central_binom_div `: The explicit formula for the Catalan number using the central + binomial coefficient, `catalan n = nat.central_binom n / (n + 1)`. + +* `trees_of_nodes_eq_card_eq_catalan`: The number of binary trees with `n` internal nodes + is `catalan n` + +## Implementation details + +The proof of `catalan_eq_central_binom_div` follows +https://math.stackexchange.com/questions/3304415/catalan-numbers-algebraic-proof-of-the-recurrence-relation + +## TODO + +* Prove that the Catalan numbers enumerate many interesting objects. +* Provide the many variants of Catalan numbers, e.g. associated to complex reflection groups, + Fuss-Catalan, etc. + +-/ + +open_locale big_operators + +open finset finset.nat.antidiagonal (fst_le snd_le) + +/-- The recursive definition of the sequence of Catalan numbers: +`catalan (n + 1) = ∑ i : fin n.succ, catalan i * catalan (n - i)` -/ +def catalan : ℕ → ℕ +| 0 := 1 +| (n + 1) := ∑ i : fin n.succ, have _ := i.2, have _ := nat.lt_succ_iff.mpr (n.sub_le i), + catalan i * catalan (n - i) + +@[simp] lemma catalan_zero : catalan 0 = 1 := by rw catalan + +lemma catalan_succ (n : ℕ) : catalan (n + 1) = ∑ i : fin n.succ, catalan i * catalan (n - i) := +by rw catalan + +lemma catalan_succ' (n : ℕ) : + catalan (n + 1) = ∑ ij in nat.antidiagonal n, catalan ij.1 * catalan ij.2 := +by rw [catalan_succ, nat.sum_antidiagonal_eq_sum_range_succ (λ x y, catalan x * catalan y) n, + sum_range] + +@[simp] lemma catalan_one : catalan 1 = 1 := by simp [catalan_succ] + +/-- A helper sequence that can be used to prove the equality of the recursive and the explicit +definition using a telescoping sum argument. -/ +private def gosper_catalan (n j : ℕ) : ℚ := +nat.central_binom j * nat.central_binom (n - j) * (2 * j - n) / (2 * n * (n + 1)) + +private lemma gosper_trick {n i : ℕ} (h : i ≤ n) : + gosper_catalan (n+1) (i+1) - gosper_catalan (n+1) i = + nat.central_binom i / (i + 1) * nat.central_binom (n - i) / (n - i + 1) := +begin + have : (n:ℚ) + 1 ≠ 0 := by exact_mod_cast n.succ_ne_zero, + have : (n:ℚ) + 1 + 1 ≠ 0 := by exact_mod_cast (n + 1).succ_ne_zero, + have : (i:ℚ) + 1 ≠ 0 := by exact_mod_cast i.succ_ne_zero, + have : (n:ℚ) - i + 1 ≠ 0 := by exact_mod_cast (n - i).succ_ne_zero, + have h₁ : ((i:ℚ) + 1) * (i + 1).central_binom = 2 * (2 * i + 1) * i.central_binom, + { exact_mod_cast nat.succ_mul_central_binom_succ i }, + have h₂ : ((n:ℚ) - i + 1) * (n - i + 1).central_binom + = 2 * (2 * (n - i) + 1) * (n - i).central_binom, + { exact_mod_cast nat.succ_mul_central_binom_succ (n - i) }, + simp only [gosper_catalan], + push_cast, + field_simp, + rw (nat.succ_sub h), + linear_combination + (2:ℚ) * (n - i).central_binom * (i + 1 - (n - i)) * (n + 1) * (n + 2) * ((n - i) + 1) * h₁ + - 2 * i.central_binom * (n + 1) * (n + 2) * (i - (n - i) - 1) * (i + 1) * h₂, +end + +private lemma gosper_catalan_sub_eq_central_binom_div (n : ℕ) : + gosper_catalan (n + 1) (n + 1) - gosper_catalan (n + 1) 0 = nat.central_binom (n + 1) / (n + 2) := +begin + have : (n:ℚ) + 1 ≠ 0 := by exact_mod_cast n.succ_ne_zero, + have : (n:ℚ) + 1 + 1 ≠ 0 := by exact_mod_cast (n + 1).succ_ne_zero, + have h : (n:ℚ) + 2 ≠ 0 := by exact_mod_cast (n + 1).succ_ne_zero, + simp only [gosper_catalan, nat.sub_zero, nat.central_binom_zero, nat.sub_self], + field_simp, + ring, +end + +theorem catalan_eq_central_binom_div (n : ℕ) : + catalan n = n.central_binom / (n + 1) := +begin + suffices : (catalan n : ℚ) = nat.central_binom n / (n + 1), + { have h := nat.succ_dvd_central_binom n, + exact_mod_cast this }, + induction n using nat.case_strong_induction_on with d hd, + { simp }, + { simp_rw [catalan_succ, nat.cast_sum, nat.cast_mul], + transitivity (∑ i : fin d.succ, (nat.central_binom i / (i + 1)) * (nat.central_binom (d - i) / + (d - i + 1)) : ℚ), + { refine sum_congr rfl (λ i _, _), + congr, + { exact_mod_cast hd i i.is_le }, + { rw_mod_cast hd (d - i), + push_cast, + rw nat.cast_sub i.is_le, + exact tsub_le_self }, }, + { transitivity ∑ i : fin d.succ, (gosper_catalan (d + 1) (i + 1) - gosper_catalan (d + 1) i), + { refine sum_congr rfl (λ i _, _), + rw_mod_cast [gosper_trick i.is_le, mul_div] }, + { rw [← sum_range (λi, gosper_catalan (d + 1) (i + 1) - gosper_catalan (d + 1) i), + sum_range_sub, nat.succ_eq_add_one], + exact_mod_cast gosper_catalan_sub_eq_central_binom_div d } } } +end + +theorem succ_mul_catalan_eq_central_binom (n : ℕ) : + (n+1) * catalan n = n.central_binom := +(nat.eq_mul_of_div_eq_right n.succ_dvd_central_binom (catalan_eq_central_binom_div n).symm).symm + +lemma catalan_two : catalan 2 = 2 := +by norm_num [catalan_eq_central_binom_div, nat.central_binom, nat.choose] + +lemma catalan_three : catalan 3 = 5 := +by norm_num [catalan_eq_central_binom_div, nat.central_binom, nat.choose] + +namespace tree +open_locale tree + +/-- Given two finsets, find all trees that can be formed with + left child in `a` and right child in `b` -/ +@[reducible] def pairwise_node (a b : finset (tree unit)) : finset (tree unit) := +(a ×ˢ b).map ⟨λ x, x.1 △ x.2, λ ⟨x₁, x₂⟩ ⟨y₁, y₂⟩, λ h, by simpa using h⟩ + +/-- A finset of all trees with `n` nodes. See `mem_trees_of_nodes_eq` -/ +def trees_of_num_nodes_eq : ℕ → finset (tree unit) +| 0 := {nil} +| (n+1) := (finset.nat.antidiagonal n).attach.bUnion $ λ ijh, + have _ := nat.lt_succ_of_le (fst_le ijh.2), + have _ := nat.lt_succ_of_le (snd_le ijh.2), + pairwise_node (trees_of_num_nodes_eq ijh.1.1) (trees_of_num_nodes_eq ijh.1.2) + +@[simp] lemma trees_of_nodes_eq_zero : trees_of_num_nodes_eq 0 = {nil} := +by rw [trees_of_num_nodes_eq] + +lemma trees_of_nodes_eq_succ (n : ℕ) : trees_of_num_nodes_eq (n + 1) = + (nat.antidiagonal n).bUnion (λ ij, pairwise_node (trees_of_num_nodes_eq ij.1) + (trees_of_num_nodes_eq ij.2)) := +by { rw trees_of_num_nodes_eq, ext, simp, } + +@[simp] theorem mem_trees_of_nodes_eq {x : tree unit} {n : ℕ} : + x ∈ trees_of_num_nodes_eq n ↔ x.num_nodes = n := +begin + induction x using tree.unit_rec_on generalizing n; + cases n; + simp [trees_of_nodes_eq_succ, nat.succ_eq_add_one, *], + trivial, +end + +lemma mem_trees_of_nodes_eq_num_nodes (x : tree unit) : + x ∈ trees_of_num_nodes_eq x.num_nodes := mem_trees_of_nodes_eq.mpr rfl + +@[simp, norm_cast] lemma coe_trees_of_nodes_eq (n : ℕ) : + ↑(trees_of_num_nodes_eq n) = {x : tree unit | x.num_nodes = n} := set.ext (by simp) + +lemma trees_of_nodes_eq_card_eq_catalan (n : ℕ) : + (trees_of_num_nodes_eq n).card = catalan n := +begin + induction n using nat.case_strong_induction_on with n ih, + { simp, }, + rw [trees_of_nodes_eq_succ, card_bUnion, catalan_succ'], + { apply sum_congr rfl, + rintro ⟨i, j⟩ H, + simp [ih _ (fst_le H), ih _ (snd_le H)], }, + { simp_rw disjoint_left, + rintros ⟨i, j⟩ _ ⟨i', j'⟩ _, + clear_except, + tidy, }, +end + +end tree diff --git a/src/combinatorics/colex.lean b/src/combinatorics/colex.lean index 202902e53ffb1..cc90e329aa314 100644 --- a/src/combinatorics/colex.lean +++ b/src/combinatorics/colex.lean @@ -9,6 +9,9 @@ import algebra.geom_sum /-! # Colex +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define the colex ordering for finite sets, and give a couple of important lemmas and properties relating to it. @@ -35,9 +38,10 @@ fixed size. If the size is 3, colex on ℕ starts Related files are: * `data.list.lex`: Lexicographic order on lists. +* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`. * `data.psigma.order`: Lexicographic order on `Σ' i, α i`. * `data.sigma.order`: Lexicographic order on `Σ i, α i`. -* `order.lexicographic`: Lexicographic order on `α × β`. +* `data.prod.lex`: Lexicographic order on `α × β`. ## Tags colex, colexicographic, binary @@ -93,7 +97,7 @@ lemma nat.sum_two_pow_lt {k : ℕ} {A : finset ℕ} (h₁ : ∀ {x}, x ∈ A → begin apply lt_of_le_of_lt (sum_le_sum_of_subset (λ t, mem_range.2 ∘ h₁)), have z := geom_sum_mul_add 1 k, - rw [geom_sum, mul_one, one_add_one_eq_two] at z, + rw [mul_one, one_add_one_eq_two] at z, rw ← z, apply nat.lt_succ_self, end diff --git a/src/combinatorics/composition.lean b/src/combinatorics/composition.lean index 1741afc367f99..bb6e5c5feb86a 100644 --- a/src/combinatorics/composition.lean +++ b/src/combinatorics/composition.lean @@ -10,6 +10,9 @@ import algebra.big_operators.fin /-! # Compositions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A composition of a natural number `n` is a decomposition `n = i₀ + ... + i_{k-1}` of `n` into a sum of positive integers. Combinatorially, it corresponds to a decomposition of `{0, ..., n-1}` into non-empty blocks of consecutive integers, where the `iⱼ` are the lengths of the blocks. @@ -207,8 +210,7 @@ a virtual point at the right of the last block, to make for a nice equiv with `composition_as_set n`. -/ def boundary : fin (c.length + 1) ↪o fin (n+1) := order_embedding.of_strict_mono (λ i, ⟨c.size_up_to i, nat.lt_succ_of_le (c.size_up_to_le i)⟩) $ - fin.strict_mono_iff_lt_succ.2 $ λ i hi, c.size_up_to_strict_mono $ - lt_of_add_lt_add_right hi + fin.strict_mono_iff_lt_succ.2 $ λ ⟨i, hi⟩, c.size_up_to_strict_mono hi @[simp] lemma boundary_zero : c.boundary 0 = 0 := by simp [boundary, fin.ext_iff] @@ -342,14 +344,12 @@ lemma disjoint_range {i₁ i₂ : fin c.length} (h : i₁ ≠ i₂) : disjoint (set.range (c.embedding i₁)) (set.range (c.embedding i₂)) := begin classical, - wlog h' : i₁ ≤ i₂ using i₁ i₂, - swap, exact (this h.symm).symm, + wlog h' : i₁ < i₂, { exact (this c h.symm (h.lt_or_lt.resolve_left h')).symm }, by_contradiction d, obtain ⟨x, hx₁, hx₂⟩ : ∃ x : fin n, (x ∈ set.range (c.embedding i₁) ∧ x ∈ set.range (c.embedding i₂)) := set.not_disjoint_iff.1 d, - have : i₁ < i₂ := lt_of_le_of_ne h' h, - have A : (i₁ : ℕ).succ ≤ i₂ := nat.succ_le_of_lt this, + have A : (i₁ : ℕ).succ ≤ i₂ := nat.succ_le_of_lt h', apply lt_irrefl (x : ℕ), calc (x : ℕ) < c.size_up_to (i₁ : ℕ).succ : (c.mem_range_embedding_iff.1 hx₁).2 ... ≤ c.size_up_to (i₂ : ℕ) : monotone_sum_take _ A @@ -428,22 +428,22 @@ end /-- The composition made of blocks all of size `1`. -/ def ones (n : ℕ) : composition n := -⟨repeat (1 : ℕ) n, λ i hi, by simp [list.eq_of_mem_repeat hi], by simp⟩ +⟨replicate n (1 : ℕ), λ i hi, by simp [list.eq_of_mem_replicate hi], by simp⟩ instance {n : ℕ} : inhabited (composition n) := ⟨composition.ones n⟩ @[simp] lemma ones_length (n : ℕ) : (ones n).length = n := -list.length_repeat 1 n +list.length_replicate n 1 -@[simp] lemma ones_blocks (n : ℕ) : (ones n).blocks = repeat (1 : ℕ) n := rfl +@[simp] lemma ones_blocks (n : ℕ) : (ones n).blocks = replicate n (1 : ℕ) := rfl @[simp] lemma ones_blocks_fun (n : ℕ) (i : fin (ones n).length) : (ones n).blocks_fun i = 1 := by simp [blocks_fun, ones, blocks, i.2] @[simp] lemma ones_size_up_to (n : ℕ) (i : ℕ) : (ones n).size_up_to i = min i n := -by simp [size_up_to, ones_blocks, take_repeat] +by simp [size_up_to, ones_blocks, take_replicate] @[simp] lemma ones_embedding (i : fin (ones n).length) (h : 0 < (ones n).blocks_fun i) : (ones n).embedding i ⟨0, h⟩ = ⟨i, lt_of_lt_of_le i.2 (ones n).length_le⟩ := @@ -454,10 +454,10 @@ lemma eq_ones_iff {c : composition n} : begin split, { rintro rfl, - exact λ i, eq_of_mem_repeat }, + exact λ i, eq_of_mem_replicate }, { assume H, ext1, - have A : c.blocks = repeat 1 c.blocks.length := eq_repeat_of_mem H, + have A : c.blocks = replicate c.blocks.length 1 := eq_replicate_of_mem H, have : c.blocks.length = n, by { conv_rhs { rw [← c.blocks_sum, A] }, simp }, rw [A, this, ones_blocks] }, end @@ -720,7 +720,7 @@ def composition_as_set_equiv (n : ℕ) : composition_as_set n ≃ finset (fin (n erw [set.mem_set_of_eq], simp only [this, false_or, add_right_inj, add_eq_zero_iff, one_ne_zero, false_and, fin.coe_mk], split, - { rintros ⟨j, js, hj⟩, convert js, exact (fin.ext_iff _ _).2 hj }, + { rintros ⟨j, js, hj⟩, convert js, exact fin.ext_iff.2 hj }, { assume h, exact ⟨i, h, rfl⟩ } end } @@ -887,18 +887,17 @@ end c.to_composition.boundaries = c.boundaries := begin ext j, - simp [c.mem_boundaries_iff_exists_blocks_sum_take_eq, c.card_boundaries_eq_succ_length, - composition.boundary, fin.ext_iff, composition.size_up_to, exists_prop, finset.mem_univ, - take, exists_prop_of_true, finset.mem_image, composition_as_set.to_composition_blocks, - composition.boundaries], + simp only [c.mem_boundaries_iff_exists_blocks_sum_take_eq, composition.boundaries, + finset.mem_map], split, - { rintros ⟨i, hi⟩, - refine ⟨i.1, _, hi⟩, - convert i.2, - simp }, + { rintros ⟨i, _, hi⟩, + refine ⟨i.1, _, _⟩, + simpa [c.card_boundaries_eq_succ_length] using i.2, + simp [composition.boundary, composition.size_up_to, ← hi] }, { rintros ⟨i, i_lt, hi⟩, - have : i < c.to_composition.length + 1, by simpa using i_lt, - exact ⟨⟨i, this⟩, hi⟩ } + refine ⟨i, by simp, _⟩, + rw [c.card_boundaries_eq_succ_length] at i_lt, + simp [composition.boundary, nat.mod_eq_of_lt i_lt, composition.size_up_to, hi] } end @[simp] lemma composition.to_composition_as_set_boundaries (c : composition n) : diff --git a/src/combinatorics/configuration.lean b/src/combinatorics/configuration.lean index c767e7bd0718e..28b4ea67e48e5 100644 --- a/src/combinatorics/configuration.lean +++ b/src/combinatorics/configuration.lean @@ -5,11 +5,14 @@ Authors: Thomas Browning -/ import algebra.big_operators.order import combinatorics.hall.basic -import data.fintype.card +import data.fintype.big_operators import set_theory.cardinal.finite /-! # Configurations of Points and lines + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. This file introduces abstract configurations of points and lines, and proves some basic properties. ## Main definitions @@ -34,17 +37,18 @@ Together, these four statements say that any two of the following properties imp open_locale big_operators -namespace configuration +set_option old_structure_cmd true -universe u +namespace configuration -variables (P L : Type u) [has_mem P L] +variables (P L : Type*) [has_mem P L] /-- A type synonym. -/ def dual := P instance [this : inhabited P] : inhabited (dual P) := this +instance [finite P] : finite (dual P) := ‹finite P› instance [this : fintype P] : fintype (dual P) := this instance : has_mem (dual L) (dual P) := @@ -62,16 +66,16 @@ class nondegenerate : Prop := (eq_or_eq : ∀ {p₁ p₂ : P} {l₁ l₂ : L}, p₁ ∈ l₁ → p₂ ∈ l₁ → p₁ ∈ l₂ → p₂ ∈ l₂ → p₁ = p₂ ∨ l₁ = l₂) /-- A nondegenerate configuration in which every pair of lines has an intersection point. -/ -class has_points extends nondegenerate P L : Type u := -(mk_point : ∀ {l₁ l₂ : L} (h : l₁ ≠ l₂), P) +class has_points extends nondegenerate P L := +(mk_point : Π {l₁ l₂ : L} (h : l₁ ≠ l₂), P) (mk_point_ax : ∀ {l₁ l₂ : L} (h : l₁ ≠ l₂), mk_point h ∈ l₁ ∧ mk_point h ∈ l₂) /-- A nondegenerate configuration in which every pair of points has a line through them. -/ -class has_lines extends nondegenerate P L : Type u := -(mk_line : ∀ {p₁ p₂ : P} (h : p₁ ≠ p₂), L) +class has_lines extends nondegenerate P L := +(mk_line : Π {p₁ p₂ : P} (h : p₁ ≠ p₂), L) (mk_line_ax : ∀ {p₁ p₂ : P} (h : p₁ ≠ p₂), p₁ ∈ mk_line h ∧ p₂ ∈ mk_line h) -open nondegenerate has_points has_lines +open nondegenerate has_points (mk_point mk_point_ax) has_lines (mk_line mk_line_ax) instance [nondegenerate P L] : nondegenerate (dual L) (dual P) := { exists_point := @exists_line P L _ _, @@ -80,11 +84,13 @@ instance [nondegenerate P L] : nondegenerate (dual L) (dual P) := instance [has_points P L] : has_lines (dual L) (dual P) := { mk_line := @mk_point P L _ _, - mk_line_ax := λ _ _, mk_point_ax } + mk_line_ax := λ _ _, mk_point_ax, + .. dual.nondegenerate _ _ } instance [has_lines P L] : has_points (dual L) (dual P) := { mk_point := @mk_line P L _ _, - mk_point_ax := λ _ _, mk_line_ax } + mk_point_ax := λ _ _, mk_line_ax, + .. dual.nondegenerate _ _ } lemma has_points.exists_unique_point [has_points P L] (l₁ l₂ : L) (hl : l₁ ≠ l₂) : ∃! p, p ∈ l₁ ∧ p ∈ l₂ := @@ -129,7 +135,7 @@ begin finset.one_lt_card_iff.mp (nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hs₀, hs₁⟩), exact (eq_or_eq (hp₁ l₁ hl₁) (hp₂ l₁ hl₁) (hp₁ l₂ hl₂) (hp₂ l₂ hl₂)).resolve_right hl₃ }, by_cases hs₃ : sᶜ.card = 0, - { rw [hs₃, nat.le_zero_iff], + { rw [hs₃, le_zero_iff], rw [finset.card_compl, tsub_eq_zero_iff_le, has_le.le.le_iff_eq (finset.card_le_univ _), eq_comm, finset.card_eq_iff_eq_univ] at hs₃ ⊢, rw hs₃, @@ -166,11 +172,12 @@ end variables {P L} lemma has_lines.point_count_le_line_count [has_lines P L] {p : P} {l : L} (h : p ∉ l) - [fintype {l : L // p ∈ l}] : point_count P l ≤ line_count L p := + [finite {l : L // p ∈ l}] : point_count P l ≤ line_count L p := begin by_cases hf : infinite {p : P // p ∈ l}, { exactI (le_of_eq nat.card_eq_zero_of_infinite).trans (zero_le (line_count L p)) }, haveI := fintype_of_not_infinite hf, + casesI nonempty_fintype {l : L // p ∈ l}, rw [line_count, point_count, nat.card_eq_fintype_card, nat.card_eq_fintype_card], have : ∀ p' : {p // p ∈ l}, p ≠ p' := λ p' hp', h ((congr_arg (∈ l) hp').mpr p'.2), exact fintype.card_le_of_injective (λ p', ⟨mk_line (this p'), (mk_line_ax (this p')).1⟩) @@ -180,7 +187,7 @@ begin end lemma has_points.line_count_le_point_count [has_points P L] {p : P} {l : L} (h : p ∉ l) - [hf : fintype {p : P // p ∈ l}] : line_count L p ≤ point_count P l := + [hf : finite {p : P // p ∈ l}] : line_count L p ≤ point_count P l := @has_lines.point_count_le_line_count (dual L) (dual P) _ _ l p h hf variables (P L) @@ -292,63 +299,54 @@ let this : ∀ l₁ l₂ : L, l₁ ≠ l₂ → ∃ p : P, p ∈ l₁ ∧ p ∈ exact ⟨q, (congr_arg _ (subtype.ext_iff.mp hq)).mp (mk_line_ax (this q)).2, q.2⟩, end in { mk_point := λ l₁ l₂ hl, classical.some (this l₁ l₂ hl), - mk_point_ax := λ l₁ l₂ hl, classical.some_spec (this l₁ l₂ hl) } + mk_point_ax := λ l₁ l₂ hl, classical.some_spec (this l₁ l₂ hl), + .. ‹has_lines P L› } /-- If a nondegenerate configuration has a unique point on any two lines, and if `|P| = |L|`, then there is a unique line through any two points. -/ noncomputable def has_points.has_lines [has_points P L] [fintype P] [fintype L] (h : fintype.card P = fintype.card L) : has_lines P L := let this := @has_lines.has_points (dual L) (dual P) _ _ _ _ h.symm in -{ mk_line := this.mk_point, - mk_line_ax := this.mk_point_ax } +{ mk_line := λ _ _, this.mk_point, + mk_line_ax := λ _ _, this.mk_point_ax, + .. ‹has_points P L› } variables (P L) /-- A projective plane is a nondegenerate configuration in which every pair of lines has an intersection point, every pair of points has a line through them, and which has three points in general position. -/ -class projective_plane extends nondegenerate P L : Type u := -(mk_point : ∀ {l₁ l₂ : L} (h : l₁ ≠ l₂), P) -(mk_point_ax : ∀ {l₁ l₂ : L} (h : l₁ ≠ l₂), mk_point h ∈ l₁ ∧ mk_point h ∈ l₂) -(mk_line : ∀ {p₁ p₂ : P} (h : p₁ ≠ p₂), L) -(mk_line_ax : ∀ {p₁ p₂ : P} (h : p₁ ≠ p₂), p₁ ∈ mk_line h ∧ p₂ ∈ mk_line h) +class projective_plane extends has_points P L, has_lines P L := (exists_config : ∃ (p₁ p₂ p₃ : P) (l₁ l₂ l₃ : L), p₁ ∉ l₂ ∧ p₁ ∉ l₃ ∧ p₂ ∉ l₁ ∧ p₂ ∈ l₂ ∧ p₂ ∈ l₃ ∧ p₃ ∉ l₁ ∧ p₃ ∈ l₂ ∧ p₃ ∉ l₃) namespace projective_plane -@[priority 100] -- see Note [lower instance priority] -instance has_points [h : projective_plane P L] : has_points P L := { .. h } - -@[priority 100] -- see Note [lower instance priority] -instance has_lines [h : projective_plane P L] : has_lines P L := { .. h } +variables [projective_plane P L] -instance [projective_plane P L] : projective_plane (dual L) (dual P) := -{ mk_line := @mk_point P L _ _, - mk_line_ax := λ _ _, mk_point_ax, - mk_point := @mk_line P L _ _, - mk_point_ax := λ _ _, mk_line_ax, - exists_config := by - { obtain ⟨p₁, p₂, p₃, l₁, l₂, l₃, h₁₂, h₁₃, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := - @exists_config P L _ _, - exact ⟨l₁, l₂, l₃, p₁, p₂, p₃, h₂₁, h₃₁, h₁₂, h₂₂, h₃₂, h₁₃, h₂₃, h₃₃⟩ }, - .. dual.nondegenerate P L } +instance : projective_plane (dual L) (dual P) := +{ exists_config := + let ⟨p₁, p₂, p₃, l₁, l₂, l₃, h₁₂, h₁₃, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := + @exists_config P L _ _ in + ⟨l₁, l₂, l₃, p₁, p₂, p₃, h₂₁, h₃₁, h₁₂, h₂₂, h₃₂, h₁₃, h₂₃, h₃₃⟩, + .. dual.has_points _ _, + .. dual.has_lines _ _ } /-- The order of a projective plane is one less than the number of lines through an arbitrary point. Equivalently, it is one less than the number of points on an arbitrary line. -/ -noncomputable def order [projective_plane P L] : ℕ := +noncomputable def order : ℕ := line_count L (classical.some (@exists_config P L _ _)) - 1 -variables [fintype P] [fintype L] - -lemma card_points_eq_card_lines [projective_plane P L] : fintype.card P = fintype.card L := +lemma card_points_eq_card_lines [fintype P] [fintype L] : fintype.card P = fintype.card L := le_antisymm (has_lines.card_le P L) (has_points.card_le P L) variables {P} (L) -lemma line_count_eq_line_count [projective_plane P L] (p q : P) : +lemma line_count_eq_line_count [finite P] [finite L] (p q : P) : line_count L p = line_count L q := begin + casesI nonempty_fintype P, + casesI nonempty_fintype L, obtain ⟨p₁, p₂, p₃, l₁, l₂, l₃, h₁₂, h₁₃, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := exists_config, have h := card_points_eq_card_lines P L, let n := line_count L p₂, @@ -366,28 +364,30 @@ end variables (P) {L} -lemma point_count_eq_point_count [projective_plane P L] (l m : L) : +lemma point_count_eq_point_count [finite P] [finite L] (l m : L) : point_count P l = point_count P m := line_count_eq_line_count (dual P) l m variables {P L} -lemma line_count_eq_point_count [projective_plane P L] (p : P) (l : L) : +lemma line_count_eq_point_count [finite P] [finite L] (p : P) (l : L) : line_count L p = point_count P l := -exists.elim (exists_point l) (λ q hq, (line_count_eq_line_count L p q).trans - (has_lines.line_count_eq_point_count (card_points_eq_card_lines P L) hq)) +exists.elim (exists_point l) $ λ q hq, (line_count_eq_line_count L p q).trans $ + by { casesI nonempty_fintype P, casesI nonempty_fintype L, + exact has_lines.line_count_eq_point_count (card_points_eq_card_lines P L) hq } variables (P L) -lemma dual.order [projective_plane P L] : order (dual L) (dual P) = order P L := +lemma dual.order [finite P] [finite L] : order (dual L) (dual P) = order P L := congr_arg (λ n, n - 1) (line_count_eq_point_count _ _) variables {P} (L) -lemma line_count_eq [projective_plane P L] (p : P) : line_count L p = order P L + 1 := +lemma line_count_eq [finite P] [finite L] (p : P) : line_count L p = order P L + 1 := begin classical, obtain ⟨q, -, -, l, -, -, -, -, h, -⟩ := classical.some_spec (@exists_config P L _ _), + casesI nonempty_fintype {l : L // q ∈ l}, rw [order, line_count_eq_line_count L p q, line_count_eq_line_count L (classical.some _) q, line_count, nat.card_eq_fintype_card, nat.sub_add_cancel], exact fintype.card_pos_iff.mpr ⟨⟨l, h⟩⟩, @@ -395,16 +395,17 @@ end variables (P) {L} -lemma point_count_eq [projective_plane P L] (l : L) : point_count P l = order P L + 1 := +lemma point_count_eq [finite P] [finite L] (l : L) : point_count P l = order P L + 1 := (line_count_eq (dual P) l).trans (congr_arg (λ n, n + 1) (dual.order P L)) variables (P L) -lemma one_lt_order [projective_plane P L] : 1 < order P L := +lemma one_lt_order [finite P] [finite L] : 1 < order P L := begin obtain ⟨p₁, p₂, p₃, l₁, l₂, l₃, -, -, h₂₁, h₂₂, h₂₃, h₃₁, h₃₂, h₃₃⟩ := @exists_config P L _ _, classical, - rw [←add_lt_add_iff_right, ←point_count_eq, point_count, nat.card_eq_fintype_card], + casesI nonempty_fintype {p : P // p ∈ l₂}, + rw [←add_lt_add_iff_right, ←point_count_eq _ l₂, point_count, nat.card_eq_fintype_card], simp_rw [fintype.two_lt_card_iff, ne, subtype.ext_iff], have h := mk_point_ax (λ h, h₂₁ ((congr_arg _ h).mpr h₂₂)), exact ⟨⟨mk_point _, h.2⟩, ⟨p₂, h₂₂⟩, ⟨p₃, h₃₂⟩, @@ -413,18 +414,19 @@ end variables {P} (L) -lemma two_lt_line_count [projective_plane P L] (p : P) : 2 < line_count L p := +lemma two_lt_line_count [finite P] [finite L] (p : P) : 2 < line_count L p := by simpa only [line_count_eq L p, nat.succ_lt_succ_iff] using one_lt_order P L variables (P) {L} -lemma two_lt_point_count [projective_plane P L] (l : L) : 2 < point_count P l := +lemma two_lt_point_count [finite P] [finite L] (l : L) : 2 < point_count P l := by simpa only [point_count_eq P l, nat.succ_lt_succ_iff] using one_lt_order P L variables (P) (L) -lemma card_points [projective_plane P L] : fintype.card P = order P L ^ 2 + order P L + 1 := +lemma card_points [fintype P] [finite L] : fintype.card P = order P L ^ 2 + order P L + 1 := begin + casesI nonempty_fintype L, obtain ⟨p, -⟩ := @exists_config P L _ _, let ϕ : {q // q ≠ p} ≃ Σ (l : {l : L // p ∈ l}), {q // q ∈ l.1 ∧ q ≠ p} := { to_fun := λ q, ⟨⟨mk_line q.2, (mk_line_ax q.2).2⟩, q, (mk_line_ax q.2).1, q.2⟩, @@ -435,11 +437,11 @@ begin classical, have h1 : fintype.card {q // q ≠ p} + 1 = fintype.card P, { apply (eq_tsub_iff_add_eq_of_le (nat.succ_le_of_lt (fintype.card_pos_iff.mpr ⟨p⟩))).mp, - convert (fintype.card_subtype_compl).trans (congr_arg _ (fintype.card_subtype_eq p)) }, + convert (fintype.card_subtype_compl _).trans (congr_arg _ (fintype.card_subtype_eq p)) }, have h2 : ∀ l : {l : L // p ∈ l}, fintype.card {q // q ∈ l.1 ∧ q ≠ p} = order P L, { intro l, - rw [←fintype.card_congr (equiv.subtype_subtype_equiv_subtype_inter _ _), - fintype.card_subtype_compl, ←nat.card_eq_fintype_card], + rw [←fintype.card_congr (equiv.subtype_subtype_equiv_subtype_inter (∈ l.val) (≠ p)), + fintype.card_subtype_compl (λ (x : subtype (∈ l.val)), x.val = p), ←nat.card_eq_fintype_card], refine tsub_eq_of_eq_add ((point_count_eq P l.1).trans _), rw ← fintype.card_subtype_eq (⟨p, l.2⟩ : {q : P // q ∈ l.1}), simp_rw subtype.ext_iff_val }, @@ -447,7 +449,8 @@ begin rw [←nat.card_eq_fintype_card, ←line_count, line_count_eq, smul_eq_mul, nat.succ_mul, sq], end -lemma card_lines [projective_plane P L] : fintype.card L = order P L ^ 2 + order P L + 1 := +lemma card_lines [finite P] [fintype L] : + fintype.card L = order P L ^ 2 + order P L + 1 := (card_points (dual L) (dual P)).trans (congr_arg (λ n, n ^ 2 + n + 1) (dual.order P L)) end projective_plane diff --git a/src/combinatorics/derangements/basic.lean b/src/combinatorics/derangements/basic.lean index 81abc44a5891b..efac282381219 100644 --- a/src/combinatorics/derangements/basic.lean +++ b/src/combinatorics/derangements/basic.lean @@ -5,12 +5,15 @@ Authors: Henry Swanson -/ import dynamics.fixed_points.basic import group_theory.perm.option -import logic.equiv.basic +import logic.equiv.defs import logic.equiv.option /-! # Derangements on types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `derangements α`, the set of derangements on a type `α`. We also define some equivalences involving various subtypes of `perm α` and `derangements α`: diff --git a/src/combinatorics/derangements/exponential.lean b/src/combinatorics/derangements/exponential.lean index afd91585d11dd..4bb378f6b3127 100644 --- a/src/combinatorics/derangements/exponential.lean +++ b/src/combinatorics/derangements/exponential.lean @@ -10,13 +10,16 @@ import order.filter.basic /-! # Derangement exponential series +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves that the probability of a permutation on n elements being a derangement is 1/e. The specific lemma is `num_derangements_tendsto_inv_e`. -/ open filter open_locale big_operators -open_locale topological_space +open_locale topology theorem num_derangements_tendsto_inv_e : tendsto (λ n, (num_derangements n : ℝ) / n.factorial) at_top diff --git a/src/combinatorics/derangements/finite.lean b/src/combinatorics/derangements/finite.lean index 3fe5af9fa252d..613acd5a43d7e 100644 --- a/src/combinatorics/derangements/finite.lean +++ b/src/combinatorics/derangements/finite.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Henry Swanson -/ import combinatorics.derangements.basic -import data.fintype.card +import data.fintype.big_operators import tactic.delta_instance import tactic.ring /-! # Derangements on fintypes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas that describe the cardinality of `derangements α` when `α` is a fintype. # Main definitions diff --git a/src/combinatorics/double_counting.lean b/src/combinatorics/double_counting.lean index 99e30deda21c4..c500b6f7b8bdf 100644 --- a/src/combinatorics/double_counting.lean +++ b/src/combinatorics/double_counting.lean @@ -8,6 +8,9 @@ import algebra.big_operators.order /-! # Double countings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file gathers a few double counting arguments. ## Bipartite graphs @@ -26,14 +29,16 @@ and `t`. * `card_mul_eq_card_mul`: Equality combination of the previous. -/ -open finset function +open finset function relator open_locale big_operators +variables {α β : Type*} + /-! ### Bipartite graph -/ namespace finset section bipartite -variables {α β : Type*} (r : α → β → Prop) (s : finset α) (t : finset β) (a a' : α) (b b' : β) +variables (r : α → β → Prop) (s : finset α) (t : finset β) (a a' : α) (b b' : β) [decidable_pred (r a)] [Π a, decidable (r a b)] {m n : ℕ} /-- Elements of `s` which are "below" `b` according to relation `r`. -/ @@ -45,6 +50,12 @@ def bipartite_above : finset β := t.filter (r a) lemma bipartite_below_swap : t.bipartite_below (swap r) a = t.bipartite_above r a := rfl lemma bipartite_above_swap : s.bipartite_above (swap r) b = s.bipartite_below r b := rfl +@[simp, norm_cast] lemma coe_bipartite_below : (s.bipartite_below r b : set α) = {a ∈ s | r a b} := +coe_filter _ _ + +@[simp, norm_cast] lemma coe_bipartite_above : (t.bipartite_above r a : set β) = {b ∈ t | r a b} := +coe_filter _ _ + variables {s t a a' b b'} @[simp] lemma mem_bipartite_below {a : α} : a ∈ s.bipartite_below r b ↔ a ∈ s ∧ r a b := mem_filter @@ -79,5 +90,33 @@ lemma card_mul_eq_card_mul [Π a b, decidable (r a b)] (card_mul_le_card_mul _ (λ a ha, (hm a ha).ge) $ λ b hb, (hn b hb).le).antisymm $ card_mul_le_card_mul' _ (λ a ha, (hn a ha).ge) $ λ b hb, (hm b hb).le +lemma card_le_card_of_forall_subsingleton + (hs : ∀ a ∈ s, ∃ b, b ∈ t ∧ r a b) (ht : ∀ b ∈ t, ({a ∈ s | r a b} : set α).subsingleton) : + s.card ≤ t.card := +by classical; simpa using card_mul_le_card_mul _ (λ a h, card_pos.2 $ + (by { rw [←coe_nonempty, coe_bipartite_above], exact hs _ h } : (t.bipartite_above r a).nonempty)) + (λ b h, card_le_one.2 $ by { simp_rw mem_bipartite_below, exact ht _ h }) + +lemma card_le_card_of_forall_subsingleton' + (ht : ∀ b ∈ t, ∃ a, a ∈ s ∧ r a b) (hs : ∀ a ∈ s, ({b ∈ t | r a b} : set β).subsingleton) : + t.card ≤ s.card := +card_le_card_of_forall_subsingleton (swap r) ht hs + end bipartite end finset + +open finset + +namespace fintype +variables [fintype α] [fintype β] {r : α → β → Prop} + +lemma card_le_card_of_left_total_unique (h₁ : left_total r) (h₂ : left_unique r) : + fintype.card α ≤ fintype.card β := +card_le_card_of_forall_subsingleton r (by simpa using h₁) $ λ b _ a₁ ha₁ a₂ ha₂, h₂ ha₁.2 ha₂.2 + +lemma card_le_card_of_right_total_unique (h₁ : right_total r) (h₂ : right_unique r) : + fintype.card β ≤ fintype.card α := +card_le_card_of_forall_subsingleton' r (by simpa using h₁) $ λ b _ a₁ ha₁ a₂ ha₂, h₂ ha₁.2 ha₂.2 + +end fintype + diff --git a/src/combinatorics/hales_jewett.lean b/src/combinatorics/hales_jewett.lean index bef6e7dab21b8..f7677fc09aca0 100644 --- a/src/combinatorics/hales_jewett.lean +++ b/src/combinatorics/hales_jewett.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 David Wärn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: David Wärn -/ -import data.fintype.basic +import data.fintype.option +import data.fintype.pi +import data.fintype.sum import algebra.big_operators.basic /-! # The Hales-Jewett theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove the Hales-Jewett theorem and deduce Van der Waerden's theorem as a corollary. The Hales-Jewett theorem is a result in Ramsey theory dealing with *combinatorial lines*. Given @@ -172,10 +177,10 @@ by simp_rw [line.apply, line.diagonal, option.get_or_else_none] /-- The Hales-Jewett theorem. This version has a restriction on universe levels which is necessary for the proof. See `exists_mono_in_high_dimension` for a fully universe-polymorphic version. -/ private theorem exists_mono_in_high_dimension' : - ∀ (α : Type u) [fintype α] (κ : Type (max v u)) [fintype κ], + ∀ (α : Type u) [finite α] (κ : Type (max v u)) [finite κ], ∃ (ι : Type) (_ : fintype ι), ∀ C : (ι → α) → κ, ∃ l : line α ι, l.is_mono C := -- The proof proceeds by induction on `α`. -fintype.induction_empty_option +finite.induction_empty_option -- We have to show that the theorem is invariant under `α ≃ α'` for the induction to work. (λ α α' e, forall_imp $ λ κ, forall_imp $ λ _, Exists.imp $ λ ι, Exists.imp $ λ _ h C, let ⟨l, c, lc⟩ := h (λ v, C (e ∘ v)) in @@ -188,6 +193,7 @@ begin -- This deals with the degenerate case where `α` is empty. end begin -- Now we have to show that the theorem holds for `option α` if it holds for `α`. introsI α _ ihα κ _, + casesI nonempty_fintype κ, -- Later we'll need `α` to be nonempty. So we first deal with the trivial case where `α` is empty. -- Then `option α` has only one element, so any line is monochromatic. by_cases h : nonempty α, @@ -267,7 +273,7 @@ end /-- The Hales-Jewett theorem: for any finite types `α` and `κ`, there exists a finite type `ι` such that whenever the hypercube `ι → α` is `κ`-colored, there is a monochromatic combinatorial line. -/ -theorem exists_mono_in_high_dimension (α : Type u) [fintype α] (κ : Type v) [fintype κ] : +theorem exists_mono_in_high_dimension (α : Type u) [finite α] (κ : Type v) [finite κ] : ∃ (ι : Type) [fintype ι], ∀ C : (ι → α) → κ, ∃ l : line α ι, l.is_mono C := let ⟨ι, ιfin, hι⟩ := exists_mono_in_high_dimension' α (ulift κ) in ⟨ι, ιfin, λ C, let ⟨l, c, hc⟩ := hι (ulift.up ∘ C) in ⟨l, c.down, λ x, by rw ←hc⟩ ⟩ @@ -276,8 +282,8 @@ end line /-- A generalization of Van der Waerden's theorem: if `M` is a finitely colored commutative monoid, and `S` is a finite subset, then there exists a monochromatic homothetic copy of `S`. -/ -theorem exists_mono_homothetic_copy - {M κ} [add_comm_monoid M] (S : finset M) [fintype κ] (C : M → κ) : +theorem exists_mono_homothetic_copy {M κ : Type*} [add_comm_monoid M] (S : finset M) [finite κ] + (C : M → κ) : ∃ (a > 0) (b : M) (c : κ), ∀ s ∈ S, C (a • s + b) = c := begin obtain ⟨ι, _inst, hι⟩ := line.exists_mono_in_high_dimension S κ, diff --git a/src/combinatorics/hall/basic.lean b/src/combinatorics/hall/basic.lean index 9081fb4d8c30d..b150a76c13cf9 100644 --- a/src/combinatorics/hall/basic.lean +++ b/src/combinatorics/hall/basic.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Alena Gusakov, Bhavik Mehta, Kyle Miller -/ import combinatorics.hall.finite -import topology.category.Top.limits +import category_theory.cofiltered_system +import data.rel /-! # Hall's Marriage Theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a list of finite subsets $X_1, X_2, \dots, X_n$ of some given set $S$, P. Hall in [Hall1935] gave a necessary and sufficient condition for there to be a list of distinct elements $x_1, x_2, \dots, x_n$ with @@ -26,7 +30,7 @@ The theorem can be generalized to remove the constraint that `ι` be a `fintype` As observed in [Halpern1966], one may use the constrained version of the theorem in a compactness argument to remove this constraint. The formulation of compactness we use is that inverse limits of nonempty finite sets -are nonempty (`nonempty_sections_of_fintype_inverse_system`), which uses the +are nonempty (`nonempty_sections_of_finite_inverse_system`), which uses the Tychonoff theorem. The core of this module is constructing the inverse system: for every finite subset `ι'` of `ι`, we can consider the matchings on the restriction of the indexed family `t` to `ι'`. @@ -82,7 +86,6 @@ begin convert h (s'.image coe) using 1, simp only [card_image_of_injective s' subtype.coe_injective], rw image_bUnion, - congr, end /-- @@ -94,9 +97,8 @@ def hall_matchings_functor {ι : Type u} {α : Type v} (t : ι → finset α) : { obj := λ ι', hall_matchings_on t ι'.unop, map := λ ι' ι'' g f, hall_matchings_on.restrict t (category_theory.le_of_hom g.unop) f } -noncomputable instance hall_matchings_on.fintype {ι : Type u} {α : Type v} - (t : ι → finset α) (ι' : finset ι) : - fintype (hall_matchings_on t ι') := +instance hall_matchings_on.finite {ι : Type u} {α : Type v} (t : ι → finset α) (ι' : finset ι) : + finite (hall_matchings_on t ι') := begin classical, rw hall_matchings_on, @@ -105,7 +107,7 @@ begin refine ⟨f.val i, _⟩, rw mem_bUnion, exact ⟨i, i.property, f.property.2 i⟩ }, - apply fintype.of_injective g, + apply finite.of_injective g, intros f f' h, simp only [g, function.funext_iff, subtype.val_eq_coe] at h, ext a, @@ -134,13 +136,13 @@ begin haveI : ∀ (ι' : (finset ι)ᵒᵖ), nonempty ((hall_matchings_functor t).obj ι') := λ ι', hall_matchings_on.nonempty t h ι'.unop, classical, - haveI : Π (ι' : (finset ι)ᵒᵖ), fintype ((hall_matchings_functor t).obj ι') := begin + haveI : Π (ι' : (finset ι)ᵒᵖ), finite ((hall_matchings_functor t).obj ι') := begin intro ι', rw [hall_matchings_functor], apply_instance, end, /- Apply the compactness argument -/ - obtain ⟨u, hu⟩ := nonempty_sections_of_fintype_inverse_system (hall_matchings_functor t), + obtain ⟨u, hu⟩ := nonempty_sections_of_finite_inverse_system (hall_matchings_functor t), /- Interpret the resulting section of the inverse limit -/ refine ⟨_, _, _⟩, { /- Build the matching function from the section -/ diff --git a/src/combinatorics/hall/finite.lean b/src/combinatorics/hall/finite.lean index e055708c15b73..e28815707c68d 100644 --- a/src/combinatorics/hall/finite.lean +++ b/src/combinatorics/hall/finite.lean @@ -9,11 +9,14 @@ import data.set.finite /-! # Hall's Marriage Theorem for finite index types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module proves the basic form of Hall's theorem. In constrast to the theorem described in `combinatorics.hall.basic`, this -version requires that the indexed family `t : ι → finset α` have `ι` be a `fintype`. +version requires that the indexed family `t : ι → finset α` have `ι` be finite. The `combinatorics.hall.basic` module applies a compactness argument to this version -to remove the `fintype` constraint on `ι`. +to remove the `finite` constraint on `ι`. The modules are split like this since the generalized statement depends on the topology and category theory libraries, but the finite @@ -38,7 +41,10 @@ universes u v namespace hall_marriage_theorem -variables {ι : Type u} {α : Type v} [fintype ι] {t : ι → finset α} [decidable_eq α] +variables {ι : Type u} {α : Type v} [decidable_eq α] {t : ι → finset α} + +section fintype +variables [fintype ι] lemma hall_cond_of_erase {x : ι} (a : α) (ha : ∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card) @@ -211,6 +217,11 @@ begin { exact sdiff_subset _ _ (hsf'' ⟨x, h⟩) } } end + +end fintype + +variables [finite ι] + /-- Here we combine the two inductive steps into a full strong induction proof, completing the proof the harder direction of **Hall's Marriage Theorem**. @@ -219,6 +230,7 @@ theorem hall_hard_inductive (ht : ∀ (s : finset ι), s.card ≤ (s.bUnion t).card) : ∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x := begin + casesI nonempty_fintype ι, unfreezingI { induction hn : fintype.card ι using nat.strong_induction_on with n ih generalizing ι }, rcases n with _|_, @@ -229,7 +241,7 @@ begin (∀ (s' : finset ι'), s'.card ≤ (s'.bUnion t').card) → ∃ (f : ι' → α), function.injective f ∧ ∀ x, f x ∈ t' x, { introsI ι' _ _ hι' ht', - exact ih _ (nat.lt_succ_of_le hι') ht' rfl, }, + exact ih _ (nat.lt_succ_of_le hι') ht' _ rfl }, by_cases h : ∀ (s : finset ι), s.nonempty → s ≠ univ → s.card < (s.bUnion t).card, { exact hall_hard_inductive_step_A hn ht ih' h, }, { push_neg at h, @@ -241,15 +253,15 @@ end hall_marriage_theorem /-- This is the version of **Hall's Marriage Theorem** in terms of indexed -families of finite sets `t : ι → finset α` with `ι` a `fintype`. +families of finite sets `t : ι → finset α` with `ι` finite. It states that there is a set of distinct representatives if and only if every union of `k` of the sets has at least `k` elements. See `finset.all_card_le_bUnion_card_iff_exists_injective` for a version -where the `fintype ι` constraint is removed. +where the `finite ι` constraint is removed. -/ theorem finset.all_card_le_bUnion_card_iff_exists_injective' - {ι α : Type*} [fintype ι] [decidable_eq α] (t : ι → finset α) : + {ι α : Type*} [finite ι] [decidable_eq α] (t : ι → finset α) : (∀ (s : finset ι), s.card ≤ (s.bUnion t).card) ↔ (∃ (f : ι → α), function.injective f ∧ ∀ x, f x ∈ t x) := begin diff --git a/src/combinatorics/hindman.lean b/src/combinatorics/hindman.lean index cffc80605c327..2a7da25298b50 100644 --- a/src/combinatorics/hindman.lean +++ b/src/combinatorics/hindman.lean @@ -10,6 +10,9 @@ import data.stream.init /-! # Hindman's theorem on finite sums +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We prove Hindman's theorem on finite sums, using idempotent ultrafilters. Given an infinite sequence `a₀, a₁, a₂, …` of positive integers, the set `FS(a₀, …)` is the set @@ -91,7 +94,8 @@ inductive FP {M} [semigroup M] : stream M → set M /-- If `m` and `m'` are finite products in `M`, then so is `m * m'`, provided that `m'` is obtained from a subsequence of `M` starting sufficiently late. -/ -@[to_additive] +@[to_additive "If `m` and `m'` are finite sums in `M`, then so is `m + m'`, provided that `m'` +is obtained from a subsequence of `M` starting sufficiently late."] lemma FP.mul {M} [semigroup M] {a : stream M} {m : M} (hm : m ∈ FP a) : ∃ n, ∀ m' ∈ FP (a.drop n), m * m' ∈ FP a := begin @@ -165,7 +169,8 @@ end /-- The strong form of **Hindman's theorem**: in any finite cover of an FP-set, one the parts contains an FP-set. -/ -@[to_additive FS_partition_regular] +@[to_additive FS_partition_regular "The strong form of **Hindman's theorem**: in any finite cover of +an FS-set, one the parts contains an FS-set."] lemma FP_partition_regular {M} [semigroup M] (a : stream M) (s : set (set M)) (sfin : s.finite) (scov : FP a ⊆ ⋃₀ s) : ∃ (c ∈ s) (b : stream M), FP b ⊆ c := let ⟨U, idem, aU⟩ := exists_idempotent_ultrafilter_le_FP a in @@ -174,7 +179,8 @@ let ⟨c, cs, hc⟩ := (ultrafilter.finite_sUnion_mem_iff sfin).mp (mem_of_super /-- The weak form of **Hindman's theorem**: in any finite cover of a nonempty semigroup, one of the parts contains an FP-set. -/ -@[to_additive exists_FS_of_finite_cover] +@[to_additive exists_FS_of_finite_cover "The weak form of **Hindman's theorem**: in any finite cover +of a nonempty additive semigroup, one of the parts contains an FS-set."] lemma exists_FP_of_finite_cover {M} [semigroup M] [nonempty M] (s : set (set M)) (sfin : s.finite) (scov : ⊤ ⊆ ⋃₀ s) : ∃ (c ∈ s) (a : stream M), FP a ⊆ c := let ⟨U, hU⟩ := exists_idempotent_of_compact_t2_of_continuous_mul_left diff --git a/src/combinatorics/partition.lean b/src/combinatorics/partition.lean index da174e729cfae..40f4e5e868093 100644 --- a/src/combinatorics/partition.lean +++ b/src/combinatorics/partition.lean @@ -11,6 +11,9 @@ import tactic.apply_fun /-! # Partitions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the order does not matter: two sums that differ only in the order of their summands are considered the same partition. This notion is closely related to that of a composition of `n`, but in a composition diff --git a/src/combinatorics/pigeonhole.lean b/src/combinatorics/pigeonhole.lean index 7c3655380f457..b16afa592b905 100644 --- a/src/combinatorics/pigeonhole.lean +++ b/src/combinatorics/pigeonhole.lean @@ -3,13 +3,18 @@ Copyright (c) 2020 Kyle Miller. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller, Yury Kudryashov -/ -import data.set.finite import data.nat.modeq +import data.set.finite import algebra.big_operators.order +import algebra.module.basic +import algebra.module.big_operators /-! # Pigeonhole principles +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given pigeons (possibly infinitely many) in pigeonholes, the pigeonhole principle states that, if there are more pigeons than pigeonholes, then there is a pigeonhole with two or more pigeons. @@ -23,8 +28,8 @@ following locations: * `data.finset.basic` has `finset.exists_ne_map_eq_of_card_lt_of_maps_to` * `data.fintype.basic` has `fintype.exists_ne_map_eq_of_card_lt` -* `data.fintype.basic` has `fintype.exists_ne_map_eq_of_infinite` -* `data.fintype.basic` has `fintype.exists_infinite_fiber` +* `data.fintype.basic` has `finite.exists_ne_map_eq_of_infinite` +* `data.fintype.basic` has `finite.exists_infinite_fiber` * `data.set.finite` has `set.infinite.exists_ne_map_eq_of_maps_to` This module gives access to these pigeonhole principles along with 20 more. @@ -54,13 +59,6 @@ docstrings instead of the names. `measure_theory.exists_nonempty_inter_of_measure_univ_lt_sum_measure`: pigeonhole principle in a measure space. -## TODO - -The `_nsmul` lemmas could be generalized from `linear_ordered_comm_ring` to -`linear_ordered_comm_semiring` if the latter existed (or some combination of -`covariant`/`contravariant` classes once the refactor has gone deep enough). This would allow -deriving the `_mul` lemmas from the `_nsmul` ones. - ## Tags pigeonhole principle @@ -198,7 +196,7 @@ lemma exists_sum_fiber_le_of_sum_fiber_nonneg_of_sum_le_nsmul end -variables [linear_ordered_comm_ring M] +variables [linear_ordered_comm_semiring M] /-! ### The pigeonhole principles on `finset`s, pigeons counted by heads @@ -237,11 +235,7 @@ elements. -/ lemma exists_lt_card_fiber_of_mul_lt_card_of_maps_to (hf : ∀ a ∈ s, f a ∈ t) (hn : t.card * n < s.card) : ∃ y ∈ t, n < (s.filter (λ x, f x = y)).card := -begin - simp only [card_eq_sum_ones], - apply exists_lt_sum_fiber_of_maps_to_of_nsmul_lt_sum hf, - simpa -end +exists_lt_card_fiber_of_nsmul_lt_card_of_maps_to hf hn /-- The pigeonhole principle for finitely many pigeons counted by heads: there is a pigeonhole with at most as many pigeons as the floor of the average number of pigeons across all pigeonholes. -/ @@ -261,12 +255,8 @@ More formally, given a function `f`, a finite sets `s` in its domain, a finite s codomain, and a natural number `n` such that `card s < card t * n`, there exists `y ∈ t` such that its preimage in `s` has less than `n` elements. -/ lemma exists_card_fiber_lt_of_card_lt_mul (hn : s.card < t.card * n) : - ∃ y ∈ t, (s.filter (λ x, f x = y)).card < n:= -begin - simp only [card_eq_sum_ones], - apply exists_sum_fiber_lt_of_sum_fiber_nonneg_of_sum_lt_nsmul (λ _ _, nat.zero_le _), - simpa -end + ∃ y ∈ t, (s.filter (λ x, f x = y)).card < n := +exists_card_fiber_lt_of_card_lt_nsmul hn /-- The pigeonhole principle for finitely many pigeons counted by heads: given a function between finite sets `s` and `t` and a number `b` such that `card t • b ≤ card s`, there exists `y ∈ t` such @@ -287,11 +277,7 @@ t` such that its preimage in `s` has at least `n` elements. See also lemma exists_le_card_fiber_of_mul_le_card_of_maps_to (hf : ∀ a ∈ s, f a ∈ t) (ht : t.nonempty) (hn : t.card * n ≤ s.card) : ∃ y ∈ t, n ≤ (s.filter (λ x, f x = y)).card := -begin - simp only [card_eq_sum_ones], - apply exists_le_sum_fiber_of_maps_to_of_nsmul_le_sum hf ht, - simpa -end +exists_le_card_fiber_of_nsmul_le_card_of_maps_to hf ht hn /-- The pigeonhole principle for finitely many pigeons counted by heads: given a function `f`, a finite sets `s` and `t`, and a number `b` such that `card s ≤ card t • b`, there exists `y ∈ t` such @@ -310,12 +296,8 @@ finite sets `s` in its domain, a finite set `t` in its codomain, and a natural n `card s ≤ card t * n`, there exists `y ∈ t` such that its preimage in `s` has no more than `n` elements. See also `finset.exists_card_fiber_lt_of_card_lt_mul` for a stronger statement. -/ lemma exists_card_fiber_le_of_card_le_mul (ht : t.nonempty) (hn : s.card ≤ t.card * n) : - ∃ y ∈ t, (s.filter (λ x, f x = y)).card ≤ n:= -begin - simp only [card_eq_sum_ones], - apply exists_sum_fiber_le_of_sum_fiber_nonneg_of_sum_le_nsmul (λ _ _, nat.zero_le _) ht, - simpa -end + ∃ y ∈ t, (s.filter (λ x, f x = y)).card ≤ n := +exists_card_fiber_le_of_card_le_nsmul ht hn end finset @@ -368,7 +350,7 @@ lemma exists_sum_fiber_le_of_sum_le_nsmul [nonempty β] (hb : (∑ x, w x) ≤ c end -variables [linear_ordered_comm_ring M] +variables [linear_ordered_comm_semiring M] /-- The strong pigeonhole principle for finitely many pigeons and pigeonholes. There is a pigeonhole @@ -389,7 +371,7 @@ More formally, given a function `f` between finite types `α` and `β` and a num elements. -/ lemma exists_lt_card_fiber_of_mul_lt_card (hn : card β * n < card α) : ∃ y : β, n < (univ.filter (λ x, f x = y)).card := -let ⟨y, _, h⟩ := exists_lt_card_fiber_of_mul_lt_card_of_maps_to (λ _ _, mem_univ _) hn in ⟨y, h⟩ +exists_lt_card_fiber_of_nsmul_lt_card _ hn /-- The strong pigeonhole principle for finitely many pigeons and pigeonholes. There is a pigeonhole with at most as many pigeons as the floor of the average number of pigeons across all pigeonholes. @@ -409,7 +391,7 @@ More formally, given a function `f` between finite types `α` and `β` and a num elements. -/ lemma exists_card_fiber_lt_of_card_lt_mul (hn : card α < card β * n) : ∃ y : β, (univ.filter (λ x, f x = y)).card < n := -let ⟨y, _, h⟩ := exists_card_fiber_lt_of_card_lt_mul hn in ⟨y, h⟩ +exists_card_fiber_lt_of_card_lt_nsmul _ hn /-- The strong pigeonhole principle for finitely many pigeons and pigeonholes. Given a function `f` between finite types `α` and `β` and a number `b` such that `card β • b ≤ card α`, there exists an @@ -426,8 +408,7 @@ element `y : β` such that its preimage has at least `n` elements. See also `fintype.exists_lt_card_fiber_of_mul_lt_card` for a stronger statement. -/ lemma exists_le_card_fiber_of_mul_le_card [nonempty β] (hn : card β * n ≤ card α) : ∃ y : β, n ≤ (univ.filter (λ x, f x = y)).card := -let ⟨y, _, h⟩ := exists_le_card_fiber_of_mul_le_card_of_maps_to (λ _ _, mem_univ _) univ_nonempty hn -in ⟨y, h⟩ +exists_le_card_fiber_of_nsmul_le_card _ hn /-- The strong pigeonhole principle for finitely many pigeons and pigeonholes. Given a function `f` between finite types `α` and `β` and a number `b` such that `card α ≤ card β • b`, there exists an @@ -443,7 +424,7 @@ element `y : β` such that its preimage has at most `n` elements. See also `fintype.exists_card_fiber_lt_of_card_lt_mul` for a stronger statement. -/ lemma exists_card_fiber_le_of_card_le_mul [nonempty β] (hn : card α ≤ card β * n) : ∃ y : β, (univ.filter (λ x, f x = y)).card ≤ n := -let ⟨y, _, h⟩ := exists_card_fiber_le_of_card_le_mul univ_nonempty hn in ⟨y, h⟩ +exists_card_fiber_le_of_card_le_nsmul _ hn end fintype diff --git a/src/combinatorics/quiver/arborescence.lean b/src/combinatorics/quiver/arborescence.lean index 8bf4a0e6207f1..9bc048ce718bd 100644 --- a/src/combinatorics/quiver/arborescence.lean +++ b/src/combinatorics/quiver/arborescence.lean @@ -11,6 +11,9 @@ import combinatorics.quiver.path /-! # Arborescences +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A quiver `V` is an arborescence (or directed rooted tree) when we have a root vertex `root : V` such that for every `b : V` there is a unique path from `root` to `b`. @@ -58,7 +61,7 @@ noncomputable def arborescence_mk {V : Type u} [quiver V] (r : V) { root := r, unique_path := λ b, ⟨classical.inhabited_of_nonempty begin - rcases (show ∃ n, height b < n, from ⟨_, lt_add_one _⟩) with ⟨n, hn⟩, + rcases (show ∃ n, height b < n, from ⟨_, nat.lt.base _⟩) with ⟨n, hn⟩, induction n with n ih generalizing b, { exact false.elim (nat.not_lt_zero _ hn) }, rcases root_or_arrow b with ⟨⟨⟩⟩ | ⟨a, ⟨e⟩⟩, @@ -108,9 +111,9 @@ arborescence_mk r (λ a, (shortest_path r a).length) (by { rintros a b c ⟨e, p, h⟩ ⟨f, q, j⟩, cases h.symm.trans j, split; refl }) begin intro b, - rcases hp : shortest_path r b with (_ | ⟨a, _, p, e⟩), + rcases hp : shortest_path r b with (_ | ⟨p, e⟩), { exact or.inl rfl }, - { exact or.inr ⟨a, ⟨⟨e, p, hp⟩⟩⟩ } + { exact or.inr ⟨_, ⟨⟨e, p, hp⟩⟩⟩ } end end geodesic_subtree diff --git a/src/combinatorics/quiver/basic.lean b/src/combinatorics/quiver/basic.lean index c0f0e947c10b3..245384adb31c4 100644 --- a/src/combinatorics/quiver/basic.lean +++ b/src/combinatorics/quiver/basic.lean @@ -8,6 +8,9 @@ import data.opposite /-! # Quivers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines quivers. A quiver on a type `V` of vertices assigns to every pair `a b : V` of vertices a type `a ⟶ b` of arrows from `a` to `b`. This is a very permissive notion of directed graph. @@ -53,6 +56,20 @@ structure prefunctor (V : Type u₁) [quiver.{v₁} V] (W : Type u₂) [quiver.{ namespace prefunctor +@[ext] +lemma ext {V : Type u} [quiver.{v₁} V] {W : Type u₂} [quiver.{v₂} W] + {F G : prefunctor V W} + (h_obj : ∀ X, F.obj X = G.obj X) + (h_map : ∀ (X Y : V) (f : X ⟶ Y), + F.map f = eq.rec_on (h_obj Y).symm (eq.rec_on (h_obj X).symm (G.map f))) : F = G := +begin + cases F with F_obj _, cases G with G_obj _, + obtain rfl : F_obj = G_obj, by { ext X, apply h_obj }, + congr, + funext X Y f, + simpa using h_map X Y f, +end + /-- The identity morphism between quivers. -/ @@ -72,6 +89,24 @@ def comp {U : Type*} [quiver U] {V : Type*} [quiver V] {W : Type*} [quiver W] { obj := λ X, G.obj (F.obj X), map := λ X Y f, G.map (F.map f), } +@[simp] lemma comp_id {U : Type*} [quiver U] {V : Type*} [quiver V] (F : prefunctor U V) : + F.comp (id _) = F := by { cases F, refl, } + +@[simp] lemma id_comp {U : Type*} [quiver U] {V : Type*} [quiver V] (F : prefunctor U V) : + (id _).comp F = F := by { cases F, refl, } + +@[simp] +lemma comp_assoc + {U V W Z : Type*} [quiver U] [quiver V] [quiver W] [quiver Z] + (F : prefunctor U V) (G : prefunctor V W) (H : prefunctor W Z) : + (F.comp G).comp H = F.comp (G.comp H) := rfl + +infix ` ⥤q `:50 := prefunctor + +infix ` ⋙q `:60 := prefunctor.comp + +notation `𝟭q` := id + end prefunctor namespace quiver @@ -92,11 +127,14 @@ def hom.unop {V} [quiver V] {X Y : Vᵒᵖ} (f : X ⟶ Y) : unop Y ⟶ unop X := attribute [irreducible] quiver.opposite /-- A type synonym for a quiver with no arrows. -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def empty (V) : Type u := V instance empty_quiver (V : Type u) : quiver.{u} (empty V) := ⟨λ a b, pempty⟩ @[simp] lemma empty_arrow {V : Type u} (a b : empty V) : (a ⟶ b) = pempty := rfl +/-- A quiver is thin if it has no parallel arrows. -/ +@[reducible] def is_thin (V : Type u) [quiver V] := ∀ (a b : V), subsingleton (a ⟶ b) + end quiver diff --git a/src/combinatorics/quiver/cast.lean b/src/combinatorics/quiver/cast.lean new file mode 100644 index 0000000000000..62b6fad9209ca --- /dev/null +++ b/src/combinatorics/quiver/cast.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2022 Antoine Labelle, Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Antoine Labelle, Rémi Bottinelli +-/ +import combinatorics.quiver.basic +import combinatorics.quiver.path + +/-! + +# Rewriting arrows and paths along vertex equalities + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This files defines `hom.cast` and `path.cast` (and associated lemmas) in order to allow +rewriting arrows and paths along equalities of their endpoints. + +-/ + +universes v v₁ v₂ u u₁ u₂ + +variables {U : Type*} [quiver.{u+1} U] + +namespace quiver + +/-! +### Rewriting arrows along equalities of vertices +-/ + +/-- Change the endpoints of an arrow using equalities. -/ +def hom.cast {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) : u' ⟶ v' := +eq.rec (eq.rec e hv) hu + +lemma hom.cast_eq_cast {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) : + e.cast hu hv = cast (by rw [hu, hv]) e := +by { subst_vars, refl } + +@[simp] lemma hom.cast_rfl_rfl {u v : U} (e : u ⟶ v) : + e.cast rfl rfl = e := rfl + +@[simp] lemma hom.cast_cast {u v u' v' u'' v'' : U} (e : u ⟶ v) + (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') : + (e.cast hu hv).cast hu' hv' = e.cast (hu.trans hu') (hv.trans hv') := +by { subst_vars, refl } + +lemma hom.cast_heq {u v u' v' : U} (hu : u = u') (hv : v = v') (e : u ⟶ v) : + e.cast hu hv == e := +by { subst_vars, refl } + +lemma hom.cast_eq_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v') + (e : u ⟶ v) (e' : u' ⟶ v') : e.cast hu hv = e' ↔ e == e' := +by { rw hom.cast_eq_cast, exact cast_eq_iff_heq } + +lemma hom.eq_cast_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v') + (e : u ⟶ v) (e' : u' ⟶ v') : e' = e.cast hu hv ↔ e' == e := +by { rw [eq_comm, hom.cast_eq_iff_heq], exact ⟨heq.symm, heq.symm⟩ } + +/-! +### Rewriting paths along equalities of vertices +-/ + +open path + +/-- Change the endpoints of a path using equalities. -/ +def path.cast {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) : path u' v' := +eq.rec (eq.rec p hv) hu + +lemma path.cast_eq_cast {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) : + p.cast hu hv = cast (by rw [hu, hv]) p:= +eq.drec (eq.drec (eq.refl (path.cast (eq.refl u) (eq.refl v) p)) hu) hv + +@[simp] lemma path.cast_rfl_rfl {u v : U} (p : path u v) : + p.cast rfl rfl = p := rfl + +@[simp] lemma path.cast_cast {u v u' v' u'' v'' : U} (p : path u v) + (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') : + (p.cast hu hv).cast hu' hv' = p.cast (hu.trans hu') (hv.trans hv') := +by { subst_vars, refl } + +@[simp] lemma path.cast_nil {u u' : U} (hu : u = u') : + (path.nil : path u u).cast hu hu = path.nil := +by { subst_vars, refl } + +lemma path.cast_heq {u v u' v' : U} (hu : u = u') (hv : v = v') (p : path u v) : + p.cast hu hv == p := +by { rw path.cast_eq_cast, exact cast_heq _ _ } + +lemma path.cast_eq_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v') + (p : path u v) (p' : path u' v') : p.cast hu hv = p' ↔ p == p' := +by { rw path.cast_eq_cast, exact cast_eq_iff_heq } + +lemma path.eq_cast_iff_heq {u v u' v' : U} (hu : u = u') (hv : v = v') + (p : path u v) (p' : path u' v') : p' = p.cast hu hv ↔ p' == p := +⟨λ h, ((p.cast_eq_iff_heq hu hv p').1 h.symm).symm, + λ h, ((p.cast_eq_iff_heq hu hv p').2 h.symm).symm⟩ + +lemma path.cast_cons {u v w u' w' : U} (p : path u v) (e : v ⟶ w) (hu : u = u') (hw : w = w') : + (p.cons e).cast hu hw = (p.cast hu rfl).cons (e.cast rfl hw) := +by { subst_vars, refl } + +lemma cast_eq_of_cons_eq_cons {u v v' w : U} {p : path u v} {p' : path u v'} + {e : v ⟶ w} {e' : v' ⟶ w} (h : p.cons e = p'.cons e') : + p.cast rfl (obj_eq_of_cons_eq_cons h) = p' := +by { rw path.cast_eq_iff_heq, exact heq_of_cons_eq_cons h } + +lemma hom_cast_eq_of_cons_eq_cons {u v v' w : U} {p : path u v} {p' : path u v'} + {e : v ⟶ w} {e' : v' ⟶ w} (h : p.cons e = p'.cons e') : + e.cast (obj_eq_of_cons_eq_cons h) rfl = e' := +by { rw hom.cast_eq_iff_heq, exact hom_heq_of_cons_eq_cons h } + +lemma eq_nil_of_length_zero {u v : U} (p : path u v) (hzero : p.length = 0) : + p.cast (eq_of_length_zero p hzero) rfl = path.nil := +by { cases p; simpa only [nat.succ_ne_zero, length_cons] using hzero, } + +end quiver diff --git a/src/combinatorics/quiver/connected_component.lean b/src/combinatorics/quiver/connected_component.lean index b43d6b4b177bc..c70c11e891995 100644 --- a/src/combinatorics/quiver/connected_component.lean +++ b/src/combinatorics/quiver/connected_component.lean @@ -5,50 +5,25 @@ Authors: David Wärn -/ import combinatorics.quiver.subquiver import combinatorics.quiver.path - +import combinatorics.quiver.symmetric /-! ## Weakly connected components -For a quiver `V`, we build a quiver `symmetrify V` by adding a reversal of every edge. -Informally, a path in `symmetrify V` corresponds to a 'zigzag' in `V`. This lets us -define the type `weakly_connected_component V` as the quotient of `V` by the relation which -identifies `a` with `b` if there is a path from `a` to `b` in `symmetrify V`. (These -zigzags can be seen as a proof-relevant analogue of `eqv_gen`.) +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + + +For a quiver `V`, we define the type `weakly_connected_component V` as the quotient of `V` +by the relation which identifies `a` with `b` if there is a path from `a` to `b` in `symmetrify V`. +(These zigzags can be seen as a proof-relevant analogue of `eqv_gen`.) Strongly connected components have not yet been defined. -/ -universes v u +universes u namespace quiver -/-- A type synonym for the symmetrized quiver (with an arrow both ways for each original arrow). - NB: this does not work for `Prop`-valued quivers. It requires `[quiver.{v+1} V]`. -/ -@[nolint has_inhabited_instance] -def symmetrify (V) : Type u := V - -instance symmetrify_quiver (V : Type u) [quiver V] : quiver (symmetrify V) := -⟨λ a b : V, (a ⟶ b) ⊕ (b ⟶ a)⟩ - -variables (V : Type u) [quiver.{v+1} V] - -/-- A quiver `has_reverse` if we can reverse an arrow `p` from `a` to `b` to get an arrow - `p.reverse` from `b` to `a`.-/ -class has_reverse := -(reverse' : Π {a b : V}, (a ⟶ b) → (b ⟶ a)) - -instance : has_reverse (symmetrify V) := ⟨λ a b e, e.swap⟩ - -variables {V} - -/-- Reverse the direction of an arrow. -/ -def reverse [has_reverse V] {a b : V} : (a ⟶ b) → (b ⟶ a) := has_reverse.reverse' - -/-- Reverse the direction of a path. -/ -def path.reverse [has_reverse V] {a : V} : Π {b}, path a b → path b a -| a path.nil := path.nil -| b (path.cons p e) := (reverse e).to_path.comp p.reverse - -variables (V) +variables (V : Type*) [quiver.{u+1} V] /-- Two vertices are related in the zigzag setoid if there is a zigzag of arrows from one to the other. -/ diff --git a/src/combinatorics/quiver/covering.lean b/src/combinatorics/quiver/covering.lean new file mode 100644 index 0000000000000..18c98970d2cfd --- /dev/null +++ b/src/combinatorics/quiver/covering.lean @@ -0,0 +1,266 @@ +/- +Copyright (c) 2022 Antoine Labelle, Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Antoine Labelle, Rémi Bottinelli +-/ +import combinatorics.quiver.cast +import combinatorics.quiver.symmetric +import data.sigma.basic +import logic.equiv.basic + +/-! +# Covering + +This file defines coverings of quivers as prefunctors that are bijective on the +so-called stars and costars at each vertex of the domain. + +## Main definitions + +* `quiver.star u` is the type of all arrows with source `u`; +* `quiver.costar u` is the type of all arrows with target `u`; +* `prefunctor.star φ u` is the obvious function `star u → star (φ.obj u)`; +* `prefunctor.costar φ u` is the obvious function `costar u → costar (φ.obj u)`; +* `prefunctor.is_covering φ` means that `φ.star u` and `φ.costar u` are bijections for all `u`; +* `quiver.star_path u` is the type of all paths with source `u`; +* `prefunctor.star_path u` is the obvious function `star_path u → star_path (φ.obj u)`. + +## Main statements + +* `prefunctor.is_covering.path_star_bijective` states that if `φ` is a covering, + then `φ.star_path u` is a bijection for all `u`. + In other words, every path in the codomain of `φ` lifts uniquely to its domain. + +## TODO + +Clean up the namespaces by renaming `prefunctor` to `quiver.prefunctor`. + +## Tags + +Cover, covering, quiver, path, lift +-/ + +open function quiver + +universes u v w + +variables {U : Type*} [quiver.{u+1} U] + {V : Type*} [quiver.{v+1} V] (φ : U ⥤q V) + {W : Type*} [quiver.{w+1} W] (ψ : V ⥤q W) + +/-- The `quiver.star` at a vertex is the collection of arrows whose source is the vertex. +The type `quiver.star u` is defined to be `Σ (v : U), (u ⟶ v)`. -/ +@[reducible] def quiver.star (u : U) := Σ (v : U), (u ⟶ v) + +/-- Constructor for `quiver.star`. Defined to be `sigma.mk`. -/ +@[reducible] protected def quiver.star.mk {u v : U} (f : u ⟶ v) : quiver.star u := ⟨_, f⟩ + +/-- The `quiver.costar` at a vertex is the collection of arrows whose target is the vertex. +The type `quiver.costar v` is defined to be `Σ (u : U), (u ⟶ v)`. -/ +@[reducible] def quiver.costar (v : U) := Σ (u : U), (u ⟶ v) + +/-- Constructor for `quiver.costar`. Defined to be `sigma.mk`. -/ +@[reducible] protected def quiver.costar.mk {u v : U} (f : u ⟶ v) : quiver.costar v := ⟨_, f⟩ + +/-- A prefunctor induces a map of `quiver.star` at every vertex. -/ +@[simps] def prefunctor.star (u : U) : quiver.star u → quiver.star (φ.obj u) := +λ F, quiver.star.mk (φ.map F.2) + +/-- A prefunctor induces a map of `quiver.costar` at every vertex. -/ +@[simps] def prefunctor.costar (u : U) : quiver.costar u → quiver.costar (φ.obj u) := +λ F, quiver.costar.mk (φ.map F.2) + +@[simp] lemma prefunctor.star_apply {u v : U} (e : u ⟶ v) : + φ.star u (quiver.star.mk e) = quiver.star.mk (φ.map e) := rfl + +@[simp] lemma prefunctor.costar_apply {u v : U} (e : u ⟶ v) : + φ.costar v (quiver.costar.mk e) = quiver.costar.mk (φ.map e) := rfl + +lemma prefunctor.star_comp (u : U) : + (φ ⋙q ψ).star u = (ψ.star (φ.obj u)) ∘ ((φ.star) u) := rfl + +lemma prefunctor.costar_comp (u : U) : + (φ ⋙q ψ).costar u = (ψ.costar (φ.obj u)) ∘ ((φ.costar) u) := rfl + +/-- A prefunctor is a covering of quivers if it defines bijections on all stars and costars. -/ +protected structure prefunctor.is_covering : Prop := +(star_bijective : ∀ u, bijective (φ.star u)) +(costar_bijective : ∀ u, bijective (φ.costar u)) + +@[simp] lemma prefunctor.is_covering.map_injective (hφ : φ.is_covering) {u v : U} : + injective (λ (f : u ⟶ v), φ.map f) := +begin + rintro f g he, + have : φ.star u (quiver.star.mk f) = φ.star u (quiver.star.mk g) := by simpa using he, + simpa using (hφ.star_bijective u).left this, +end + +lemma prefunctor.is_covering.comp (hφ : φ.is_covering) (hψ : ψ.is_covering) : + (φ ⋙q ψ).is_covering := +⟨λ u, (hψ.star_bijective _).comp (hφ.star_bijective _), + λ u, (hψ.costar_bijective _).comp (hφ.costar_bijective _)⟩ + +lemma prefunctor.is_covering.of_comp_right (hψ : ψ.is_covering) (hφψ : (φ ⋙q ψ).is_covering) : + φ.is_covering := +⟨λ u, (bijective.of_comp_iff' (hψ.star_bijective _) _).mp (hφψ.star_bijective _), + λ u, (bijective.of_comp_iff' (hψ.costar_bijective _) _).mp (hφψ.costar_bijective _)⟩ + +lemma prefunctor.is_covering.of_comp_left (hφ : φ.is_covering) (hφψ : (φ ⋙q ψ).is_covering) + (φsur : surjective φ.obj) : ψ.is_covering := +begin + refine ⟨λ v, _, λ v, _⟩; + obtain ⟨u, rfl⟩ := φsur v, + exacts [(bijective.of_comp_iff _ (hφ.star_bijective u)).mp (hφψ.star_bijective u), + (bijective.of_comp_iff _ (hφ.costar_bijective u)).mp (hφψ.costar_bijective u)], +end + +/-- The star of the symmetrification of a quiver at a vertex `u` is equivalent to the sum of the +star and the costar at `u` in the original quiver. -/ +def quiver.symmetrify_star (u : U) : + quiver.star (symmetrify.of.obj u) ≃ quiver.star u ⊕ quiver.costar u := +equiv.sigma_sum_distrib _ _ + +/-- The costar of the symmetrification of a quiver at a vertex `u` is equivalent to the sum of the +costar and the star at `u` in the original quiver. -/ +def quiver.symmetrify_costar (u : U) : + quiver.costar (symmetrify.of.obj u) ≃ quiver.costar u ⊕ quiver.star u := +equiv.sigma_sum_distrib _ _ + +lemma prefunctor.symmetrify_star (u : U) : + φ.symmetrify.star u = (quiver.symmetrify_star _).symm ∘ + sum.map (φ.star u) (φ.costar u) ∘ quiver.symmetrify_star u := +begin + rw equiv.eq_symm_comp, + ext ⟨v, (f|g)⟩; + simp [quiver.symmetrify_star], +end + +protected lemma prefunctor.symmetrify_costar (u : U) : + φ.symmetrify.costar u = (quiver.symmetrify_costar _).symm ∘ + sum.map (φ.costar u) (φ.star u) ∘ quiver.symmetrify_costar u := +begin + rw equiv.eq_symm_comp, + ext ⟨v, (f|g)⟩; + simp [quiver.symmetrify_costar], +end + +protected lemma prefunctor.is_covering.symmetrify (hφ : φ.is_covering) : φ.symmetrify.is_covering := +begin + refine ⟨λ u, _, λ u, _⟩; + simp [φ.symmetrify_star, φ.symmetrify_costar, hφ.star_bijective u, hφ.costar_bijective u], +end + +/-- The path star at a vertex `u` is the type of all paths starting at `u`. +The type `quiver.path_star u` is defined to be `Σ v : U, path u v`. -/ +@[reducible] def quiver.path_star (u : U) := Σ v : U, path u v + +/-- Constructor for `quiver.path_star`. Defined to be `sigma.mk`. -/ +@[reducible] protected def quiver.path_star.mk {u v : U} (p : path u v) : + quiver.path_star u := ⟨_, p⟩ + +/-- A prefunctor induces a map of path stars. -/ +def prefunctor.path_star (u : U) : quiver.path_star u → quiver.path_star (φ.obj u) := +λ p, quiver.path_star.mk (φ.map_path p.2) + +@[simp] lemma prefunctor.path_star_apply {u v : U} (p : path u v) : + φ.path_star u (quiver.path_star.mk p) = quiver.path_star.mk (φ.map_path p) := rfl + +theorem prefunctor.path_star_injective (hφ : ∀ u, injective (φ.star u)) (u : U) : + injective (φ.path_star u) := +begin + dsimp [prefunctor.path_star, quiver.path_star.mk], + rintro ⟨v₁, p₁⟩, + induction p₁ with x₁ y₁ p₁ e₁ ih; + rintro ⟨y₂, p₂⟩; cases p₂ with x₂ _ p₂ e₂; + intro h; + simp only [prefunctor.path_star_apply, prefunctor.map_path_nil, + prefunctor.map_path_cons] at h, + { exfalso, + cases h with h h', + rw [←path.eq_cast_iff_heq rfl h.symm, path.cast_cons] at h', + exact (path.nil_ne_cons _ _) h', }, + { exfalso, + cases h with h h', + rw [←path.cast_eq_iff_heq rfl h, path.cast_cons] at h', + exact (path.cons_ne_nil _ _) h', }, + { cases h with hφy h', + rw [←path.cast_eq_iff_heq rfl hφy, path.cast_cons, path.cast_rfl_rfl] at h', + have hφx := path.obj_eq_of_cons_eq_cons h', + have hφp := path.heq_of_cons_eq_cons h', + have hφe := heq.trans (hom.cast_heq rfl hφy _).symm (path.hom_heq_of_cons_eq_cons h'), + have h_path_star : φ.path_star u ⟨x₁, p₁⟩ = φ.path_star u ⟨x₂, p₂⟩, + { simp only [prefunctor.path_star_apply, sigma.mk.inj_iff], exact ⟨hφx, hφp⟩, }, + cases ih h_path_star, + have h_star : φ.star x₁ ⟨y₁, e₁⟩ = φ.star x₁ ⟨y₂, e₂⟩, + { simp only [prefunctor.star_apply, sigma.mk.inj_iff], exact ⟨hφy, hφe⟩, }, + cases hφ x₁ h_star, + refl, }, +end + +theorem prefunctor.path_star_surjective (hφ : ∀ u, surjective (φ.star u)) (u : U) : + surjective (φ.path_star u) := +begin + dsimp [prefunctor.path_star, quiver.path_star.mk], + rintro ⟨v, p⟩, + induction p with v' v'' p' ev ih, + { use ⟨u, path.nil⟩, + simp only [prefunctor.map_path_nil, eq_self_iff_true, heq_iff_eq, and_self], }, + { obtain ⟨⟨u', q'⟩, h⟩ := ih, + simp only at h, + obtain ⟨rfl,rfl⟩ := h, + obtain ⟨⟨u'', eu⟩, k⟩ := hφ u' ⟨_, ev⟩, + simp at k, + obtain ⟨rfl,rfl⟩ := k, + use ⟨_, q'.cons eu⟩, + simp only [prefunctor.map_path_cons, eq_self_iff_true, heq_iff_eq, and_self], } +end + +theorem prefunctor.path_star_bijective (hφ : ∀ u, bijective (φ.star u)) (u : U) : + bijective (φ.path_star u) := +⟨φ.path_star_injective (λ u, (hφ u).1) _, φ.path_star_surjective (λ u, (hφ u).2) _⟩ + +namespace prefunctor.is_covering +variable {φ} + +protected theorem path_star_bijective (hφ : φ.is_covering) (u : U) : + bijective (φ.path_star u) := φ.path_star_bijective hφ.1 u + +end prefunctor.is_covering + +section has_involutive_reverse + +variables [has_involutive_reverse U] [has_involutive_reverse V] [prefunctor.map_reverse φ] + +/-- In a quiver with involutive inverses, the star and costar at every vertex are equivalent. +This map is induced by `quiver.reverse`. -/ +@[simps] def quiver.star_equiv_costar (u : U) : + quiver.star u ≃ quiver.costar u := +{ to_fun := λ e, ⟨e.1, reverse e.2⟩, + inv_fun := λ e, ⟨e.1, reverse e.2⟩, + left_inv := λ e, by simp [sigma.ext_iff], + right_inv := λ e, by simp [sigma.ext_iff] } + +@[simp] lemma quiver.star_equiv_costar_apply {u v : U} (e : u ⟶ v) : + quiver.star_equiv_costar u (quiver.star.mk e) = quiver.costar.mk (reverse e) := rfl + +@[simp] lemma quiver.star_equiv_costar_symm_apply {u v : U} (e : u ⟶ v) : + (quiver.star_equiv_costar v).symm (quiver.costar.mk e) = quiver.star.mk (reverse e) := rfl + +lemma prefunctor.costar_conj_star (u : U) : + φ.costar u = + quiver.star_equiv_costar (φ.obj u) ∘ φ.star u ∘ (quiver.star_equiv_costar u).symm := +by { ext ⟨v, f⟩; simp, } + +lemma prefunctor.bijective_costar_iff_bijective_star (u : U) : + bijective (φ.costar u) ↔ bijective (φ.star u) := +begin + rw [prefunctor.costar_conj_star, bijective.of_comp_iff', bijective.of_comp_iff]; + exact equiv.bijective _, +end + +lemma prefunctor.is_covering_of_bijective_star (h : ∀ u, bijective (φ.star u)) : + φ.is_covering := ⟨h, λ u, (φ.bijective_costar_iff_bijective_star u).2 (h u)⟩ + +lemma prefunctor.is_covering_of_bijective_costar (h : ∀ u, bijective (φ.costar u)) : + φ.is_covering := ⟨λ u, (φ.bijective_costar_iff_bijective_star u).1 (h u), h⟩ + +end has_involutive_reverse diff --git a/src/combinatorics/quiver/path.lean b/src/combinatorics/quiver/path.lean index 62de1ffa1b554..65fbe46496e62 100644 --- a/src/combinatorics/quiver/path.lean +++ b/src/combinatorics/quiver/path.lean @@ -4,14 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: David Wärn, Scott Morrison -/ import combinatorics.quiver.basic +import logic.lemmas /-! # Paths in quivers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a quiver `V`, we define the type of paths from `a : V` to `b : V` as an inductive family. We define composition of paths and the action of prefunctors on paths. -/ +open function + universes v v₁ v₂ u u₁ u₂ namespace quiver @@ -27,7 +33,20 @@ path.nil.cons e namespace path -variables {V : Type u} [quiver V] +variables {V : Type u} [quiver V] {a b c d : V} + +lemma nil_ne_cons (p : path a b) (e : b ⟶ a) : path.nil ≠ p.cons e. + +lemma cons_ne_nil (p : path a b) (e : b ⟶ a) : p.cons e ≠ path.nil. + +lemma obj_eq_of_cons_eq_cons {p : path a b} {p' : path a c} + {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : b = c := by injection h + +lemma heq_of_cons_eq_cons {p : path a b} {p' : path a c} + {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : p == p' := by injection h + +lemma hom_heq_of_cons_eq_cons {p : path a b} {p' : path a c} + {e : b ⟶ d} {e' : c ⟶ d} (h : p.cons e = p'.cons e') : e == e' := by injection h /-- The length of a path is the number of arrows it uses. -/ def length {a : V} : Π {b : V}, path a b → ℕ @@ -42,6 +61,9 @@ instance {a : V} : inhabited (path a a) := ⟨path.nil⟩ @[simp] lemma length_cons (a b c : V) (p : path a b) (e : b ⟶ c) : (p.cons e).length = p.length + 1 := rfl +lemma eq_of_length_zero (p : path a b) (hzero : p.length = 0) : a = b := +by { cases p, { refl }, { cases nat.succ_ne_zero _ hzero } } + /-- Composition of paths. -/ def comp {a b : V} : Π {c}, path a b → path b c → path a c | _ p (path.nil) := p @@ -49,16 +71,88 @@ def comp {a b : V} : Π {c}, path a b → path b c → path a c @[simp] lemma comp_cons {a b c d : V} (p : path a b) (q : path b c) (e : c ⟶ d) : p.comp (q.cons e) = (p.comp q).cons e := rfl + @[simp] lemma comp_nil {a b : V} (p : path a b) : p.comp path.nil = p := rfl + @[simp] lemma nil_comp {a : V} : ∀ {b} (p : path a b), path.nil.comp p = p | a path.nil := rfl | b (path.cons p e) := by rw [comp_cons, nil_comp] + @[simp] lemma comp_assoc {a b c : V} : ∀ {d} (p : path a b) (q : path b c) (r : path c d), (p.comp q).comp r = p.comp (q.comp r) | c p q path.nil := rfl | d p q (path.cons r e) := by rw [comp_cons, comp_cons, comp_cons, comp_assoc] +@[simp] lemma length_comp (p : path a b) : + ∀ {c} (q : path b c), (p.comp q).length = p.length + q.length +| c nil := rfl +| c (cons q h) := congr_arg nat.succ q.length_comp + +lemma comp_inj {p₁ p₂ : path a b} {q₁ q₂ : path b c} (hq : q₁.length = q₂.length) : + p₁.comp q₁ = p₂.comp q₂ ↔ p₁ = p₂ ∧ q₁ = q₂ := +begin + refine ⟨λ h, _, by { rintro ⟨rfl, rfl⟩, refl }⟩, + induction q₁ with d₁ e₁ q₁ f₁ ih generalizing q₂; obtain _ | ⟨q₂, f₂⟩ := q₂, + { exact ⟨h, rfl⟩ }, + { cases hq }, + { cases hq }, + simp only [comp_cons] at h, + obtain rfl := h.1, + obtain ⟨rfl, rfl⟩ := ih (nat.succ.inj hq) h.2.1.eq, + rw h.2.2.eq, + exact ⟨rfl, rfl⟩, +end + +lemma comp_inj' {p₁ p₂ : path a b} {q₁ q₂ : path b c} (h : p₁.length = p₂.length) : + p₁.comp q₁ = p₂.comp q₂ ↔ p₁ = p₂ ∧ q₁ = q₂ := +⟨λ h_eq, (comp_inj $ nat.add_left_cancel $ + by simpa [h] using congr_arg length h_eq).1 h_eq, by { rintro ⟨rfl, rfl⟩, refl }⟩ + +lemma comp_injective_left (q : path b c) : injective (λ p : path a b, p.comp q) := +λ p₁ p₂ h, ((comp_inj rfl).1 h).1 + +lemma comp_injective_right (p : path a b) : injective (p.comp : path b c → path a c) := +λ q₁ q₂ h, ((comp_inj' rfl).1 h).2 + +@[simp] lemma comp_inj_left {p₁ p₂ : path a b} {q : path b c} : p₁.comp q = p₂.comp q ↔ p₁ = p₂ := +q.comp_injective_left.eq_iff + +@[simp] lemma comp_inj_right {p : path a b} {q₁ q₂ : path b c} : p.comp q₁ = p.comp q₂ ↔ q₁ = q₂ := +p.comp_injective_right.eq_iff + +/-- Turn a path into a list. The list contains `a` at its head, but not `b` a priori. -/ +@[simp] def to_list : Π {b : V}, path a b → list V +| b nil := [] +| b (@cons _ _ _ c _ p f) := c :: p.to_list + +/-- `quiver.path.to_list` is a contravariant functor. The inversion comes from `quiver.path` and +`list` having different preferred directions for adding elements. -/ +@[simp] lemma to_list_comp (p : path a b) : + ∀ {c} (q : path b c), (p.comp q).to_list = q.to_list ++ p.to_list +| c nil := by simp +| c (@cons _ _ _ d _ q f) := by simp [to_list_comp] + +lemma to_list_chain_nonempty : + ∀ {b} (p : path a b), p.to_list.chain (λ x y, nonempty (y ⟶ x)) b +| b nil := list.chain.nil +| b (cons p f) := p.to_list_chain_nonempty.cons ⟨f⟩ + +variables [∀ a b : V, subsingleton (a ⟶ b)] + +lemma to_list_injective (a : V) : ∀ b, injective (to_list : path a b → list V) +| b nil nil h := rfl +| b nil (@cons _ _ _ c _ p f) h := by cases h +| b (@cons _ _ _ c _ p f) nil h := by cases h +| b (@cons _ _ _ c _ p f) (@cons _ _ s t u C D) h := begin + simp only [to_list] at h, + obtain ⟨rfl, hAC⟩ := h, + simp [to_list_injective _ hAC], +end + +@[simp] lemma to_list_inj {p q : path a b} : p.to_list = q.to_list ↔ p = q := +(to_list_injective _ _).eq_iff + end path end quiver @@ -67,7 +161,7 @@ namespace prefunctor open quiver -variables {V : Type u₁} [quiver.{v₁} V] {W : Type u₂} [quiver.{v₂} W] (F : prefunctor V W) +variables {V : Type u₁} [quiver.{v₁} V] {W : Type u₂} [quiver.{v₂} W] (F : V ⥤q W) /-- The image of a path under a prefunctor. -/ def map_path {a : V} : @@ -84,4 +178,7 @@ def map_path {a : V} : | _ path.nil := rfl | _ (path.cons p e) := begin dsimp, rw [map_path_comp], end +@[simp] +lemma map_path_to_path {a b : V} (f : a ⟶ b) : F.map_path f.to_path = (F.map f).to_path := rfl + end prefunctor diff --git a/src/combinatorics/quiver/push.lean b/src/combinatorics/quiver/push.lean new file mode 100644 index 0000000000000..ee82a7c6ecd3e --- /dev/null +++ b/src/combinatorics/quiver/push.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2022 Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Rémi Bottinelli +-/ +import combinatorics.quiver.basic +/-! + +# Pushing a quiver structure along a map + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Given a map `σ : V → W` and a `quiver` instance on `V`, this files defines a `quiver` instance +on `W` by associating to each arrow `v ⟶ v'` in `V` an arrow `σ v ⟶ σ v'` in `W`. + +-/ + +universes v v₁ v₂ u u₁ u₂ + +variables {V : Type*} [quiver V] {W : Type*} (σ : V → W) + +namespace quiver + +/-- The `quiver` instance obtained by pushing arrows of `V` along the map `σ : V → W` -/ +@[nolint unused_arguments] +def push (σ : V → W) := W + +instance [h : nonempty W] : nonempty (push σ) := h + +/-- The quiver structure obtained by pushing arrows of `V` along the map `σ : V → W` -/ +@[nolint has_nonempty_instance] +inductive push_quiver {V : Type u} [quiver.{v} V] {W : Type u₂} (σ : V → W) : + W → W → Type (max u u₂ v) +| arrow {X Y : V} (f : X ⟶ Y) : push_quiver (σ X) (σ Y) + +instance : quiver (push σ) := ⟨push_quiver σ⟩ + +namespace push + +/-- The prefunctor induced by pushing arrows via `σ` -/ +def of : V ⥤q push σ := +{ obj := σ, + map := λ X Y f, push_quiver.arrow f } + +@[simp] lemma of_obj : (of σ).obj = σ := rfl + +variables {W' : Type*} [quiver W'] (φ : V ⥤q W') (τ : W → W') (h : ∀ x, φ.obj x = τ (σ x) ) + +include φ h +/-- Given a function `τ : W → W'` and a prefunctor `φ : V ⥤q W'`, one can extend `τ` to be +a prefunctor `W ⥤q W'` if `τ` and `σ` factorize `φ` at the level of objects, where `W` is given +the pushforward quiver structure `push σ`. -/ +def lift : push σ ⥤q W' := +{ obj := τ, + map := @push_quiver.rec V _ W σ + (λ X Y f, τ X ⟶ τ Y) + (λ X Y f, by { rw [←h X, ←h Y], exact φ.map f, }) } + +lemma lift_obj : (lift σ φ τ h).obj = τ := rfl + +lemma lift_comp : of σ ⋙q lift σ φ τ h = φ := +begin + fapply prefunctor.ext, + { rintros, simp only [prefunctor.comp_obj], symmetry, exact h X, }, + { rintros _ _ f, simp only [prefunctor.comp_map], + apply eq_of_heq, + iterate 2 { apply (cast_heq _ _).trans }, + symmetry, + iterate 2 { apply (eq_rec_heq _ _).trans }, + refl, }, +end + +lemma lift_unique (Φ : push σ ⥤q W') (Φ₀ : Φ.obj = τ) (Φcomp : of σ ⋙q Φ = φ) : + Φ = lift σ φ τ h := +begin + dsimp only [of,lift], + fapply prefunctor.ext, + { rintros, simp_rw [←Φ₀], }, + { rintros _ _ ⟨⟩, subst_vars, simp only [prefunctor.comp_map, cast_eq], refl, } +end + +end push + +end quiver diff --git a/src/combinatorics/quiver/single_obj.lean b/src/combinatorics/quiver/single_obj.lean new file mode 100644 index 0000000000000..8fc315d081ef6 --- /dev/null +++ b/src/combinatorics/quiver/single_obj.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2023 Antoine Labelle. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Antoine Labelle +-/ +import combinatorics.quiver.cast +import combinatorics.quiver.symmetric + +/-! +# Single-object quiver + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Single object quiver with a given arrows type. + +## Main definitions + +Given a type `α`, `single_obj α` is the `unit` type, whose single object is called `star α`, with +`quiver` structure such that `star α ⟶ star α` is the type `α`. +An element `x : α` can be reinterpreted as an element of `star α ⟶ star α` using +`to_hom`. +More generally, a list of elements of `a` can be reinterpreted as a path from `star α` to +itself using `path_equiv_list`. +-/ + +namespace quiver + +/-- Type tag on `unit` used to define single-object quivers. -/ +@[derive unique, nolint unused_arguments] +def single_obj (α : Type*) : Type := unit + +namespace single_obj + +variables (α β γ : Type*) + +instance : quiver (single_obj α) := ⟨λ _ _, α⟩ + +/-- The single object in `single_obj α`. -/ +def star : single_obj α := unit.star + +instance : inhabited (single_obj α) := ⟨star α⟩ + +variables {α β γ} + +/-- Equip `single_obj α` with a reverse operation. -/ +@[reducible] -- See note [reducible non-instances] +def has_reverse (rev : α → α) : has_reverse (single_obj α) := ⟨λ _ _, rev⟩ + +/-- Equip `single_obj α` with an involutive reverse operation. -/ +@[reducible] -- See note [reducible non-instances] +def has_involutive_reverse (rev : α → α) (h : function.involutive rev) : + has_involutive_reverse (single_obj α) := +{ to_has_reverse := has_reverse rev, + inv' := λ _ _, h} + +/-- The type of arrows from `star α` to itself is equivalent to the original type `α`. -/ +@[simps] def to_hom : α ≃ (star α ⟶ star α) := equiv.refl _ + +/-- +Prefunctors between two `single_obj` quivers correspond to functions between the corresponding +arrows types. +-/ +@[simps] def to_prefunctor : + (α → β) ≃ (single_obj α ⥤q single_obj β) := +{ to_fun := λ f, ⟨id, λ _ _, f⟩, + inv_fun := λ f a, f.map (to_hom a), + left_inv := λ _, rfl, + right_inv := λ f, by cases f; obviously } + +lemma to_prefunctor_id : to_prefunctor id = 𝟭q (single_obj α) := rfl + +@[simp] lemma to_prefunctor_symm_id : + to_prefunctor.symm (𝟭q (single_obj α)) = id := rfl + +lemma to_prefunctor_comp (f : α → β) (g : β → γ) : + to_prefunctor (g ∘ f) = to_prefunctor f ⋙q to_prefunctor g := rfl + +@[simp] lemma to_prefunctor_symm_comp (f : single_obj α ⥤q single_obj β) + (g : single_obj β ⥤q single_obj γ) : to_prefunctor.symm (f ⋙q g) = + to_prefunctor.symm g ∘ to_prefunctor.symm f := +by simp only [equiv.symm_apply_eq, to_prefunctor_comp, equiv.apply_symm_apply] + +/-- +Auxiliary definition for `quiver.single_obj.path_equiv_list`. +Converts a path in the quiver `single_obj α` into a list of elements of type `a`. +-/ +@[simp] def path_to_list : Π {x : single_obj α}, path (star α) x → list α +| _ path.nil := [] +| _ (path.cons p a) := a :: path_to_list p + +/-- +Auxiliary definition for `quiver.single_obj.path_equiv_list`. +Converts a list of elements of type `α` into a path in the quiver `single_obj α`. +-/ +@[simp] def list_to_path : list α → path (star α) (star α) +| [] := path.nil +| (a :: l) := (list_to_path l).cons a + +lemma path_to_list_to_path {x : single_obj α} (p : path (star α) x) : + list_to_path (path_to_list p) = p.cast rfl (unit.ext) := +by { induction p with y z p a ih, refl, tidy, } + +lemma list_to_path_to_list (l : list α) : + path_to_list (list_to_path l) = l := +by { induction l with a l ih, refl, simp [ih] } + +/-- Paths in `single_obj α` quiver correspond to lists of elements of type `α`. -/ +def path_equiv_list : path (star α) (star α) ≃ list α := +⟨path_to_list, list_to_path, λ p, path_to_list_to_path p, list_to_path_to_list⟩ + +@[simp] lemma path_equiv_list_nil : path_equiv_list path.nil = ([] : list α) := rfl + +@[simp] lemma path_equiv_list_cons (p : path (star α) (star α)) (a : star α ⟶ star α) : + path_equiv_list (path.cons p a) = a :: path_to_list p := rfl + +@[simp] lemma path_equiv_list_symm_nil : path_equiv_list.symm ([] : list α) = path.nil := rfl + +@[simp] lemma path_equiv_list_symm_cons (l : list α) (a : α) : + path_equiv_list.symm (a :: l) = path.cons (path_equiv_list.symm l) a := rfl + +end single_obj + +end quiver diff --git a/src/combinatorics/quiver/subquiver.lean b/src/combinatorics/quiver/subquiver.lean index 812fff2a73b8e..c9db6c0715667 100644 --- a/src/combinatorics/quiver/subquiver.lean +++ b/src/combinatorics/quiver/subquiver.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 David Wärn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: David Wärn -/ -import data.set.basic +import order.bounded_order import combinatorics.quiver.basic /-! ## Wide subquivers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A wide subquiver `H` of a quiver `H` consists of a subset of the edge set `a ⟶ b` for every pair of vertices `a b : V`. We include 'wide' in the name to emphasize that these subquivers by definition contain all vertices. @@ -25,7 +28,7 @@ def wide_subquiver (V) [quiver.{v+1} V] := /-- A type synonym for `V`, when thought of as a quiver having only the arrows from some `wide_subquiver`. -/ -@[nolint unused_arguments has_inhabited_instance] +@[nolint unused_arguments has_nonempty_instance] def wide_subquiver.to_Type (V) [quiver V] (H : wide_subquiver V) : Type u := V instance wide_subquiver_has_coe_to_sort {V} [quiver V] : @@ -34,7 +37,7 @@ instance wide_subquiver_has_coe_to_sort {V} [quiver V] : /-- A wide subquiver viewed as a quiver on its own. -/ instance wide_subquiver.quiver {V} [quiver V] (H : wide_subquiver V) : quiver H := -⟨λ a b, H a b⟩ +⟨λ a b, { f // f ∈ H a b }⟩ namespace quiver @@ -44,7 +47,7 @@ instance {V} [quiver V] : inhabited (wide_subquiver V) := ⟨⊤⟩ /-- `total V` is the type of _all_ arrows of `V`. -/ -- TODO Unify with `category_theory.arrow`? (The fields have been named to match.) -@[ext, nolint has_inhabited_instance] +@[ext, nolint has_nonempty_instance] structure total (V : Type u) [quiver.{v} V] : Sort (max (u+1) v) := (left : V) (right : V) diff --git a/src/combinatorics/quiver/symmetric.lean b/src/combinatorics/quiver/symmetric.lean new file mode 100644 index 0000000000000..640d4b1005b52 --- /dev/null +++ b/src/combinatorics/quiver/symmetric.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2021 David Wärn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: David Wärn +-/ +import combinatorics.quiver.basic +import combinatorics.quiver.path +import combinatorics.quiver.push +import data.sum.basic +/-! +## Symmetric quivers and arrow reversal + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains constructions related to symmetric quivers: + +* `symmetrify V` adds formal inverses to each arrow of `V`. +* `has_reverse` is the class of quivers where each arrow has an assigned formal inverse. +* `has_involutive_reverse` extends `has_reverse` by requiring that the reverse of the reverse + is equal to the original arrow. +* `prefunctor.preserve_reverse` is the class of prefunctors mapping reverses to reverses. +* `symmetrify.of`, `symmetrify.lift`, and the associated lemmas witness the universal property + of `symmetrify`. +-/ + +universes v u w v' + +namespace quiver + +/-- A type synonym for the symmetrized quiver (with an arrow both ways for each original arrow). + NB: this does not work for `Prop`-valued quivers. It requires `[quiver.{v+1} V]`. -/ +@[nolint has_nonempty_instance] +def symmetrify (V : Type*) := V + +instance symmetrify_quiver (V : Type u) [quiver V] : quiver (symmetrify V) := +⟨λ a b : V, (a ⟶ b) ⊕ (b ⟶ a)⟩ + +variables (U V W : Type*) [quiver.{u+1} U] [quiver.{v+1} V] [quiver.{w+1} W] + +/-- A quiver `has_reverse` if we can reverse an arrow `p` from `a` to `b` to get an arrow + `p.reverse` from `b` to `a`.-/ +class has_reverse := +(reverse' : Π {a b : V}, (a ⟶ b) → (b ⟶ a)) + +/-- Reverse the direction of an arrow. -/ +def reverse {V} [quiver.{v+1} V] [has_reverse V] {a b : V} : (a ⟶ b) → (b ⟶ a) := +has_reverse.reverse' + +/-- A quiver `has_involutive_reverse` if reversing twice is the identity.`-/ +class has_involutive_reverse extends has_reverse V := +(inv' : Π {a b : V} (f : a ⟶ b), reverse (reverse f) = f) + +variables {U V W} + +@[simp] lemma reverse_reverse [h : has_involutive_reverse V] + {a b : V} (f : a ⟶ b) : reverse (reverse f) = f := h.inv' f + +@[simp] lemma reverse_inj [has_involutive_reverse V] + {a b : V} (f g : a ⟶ b) : reverse f = reverse g ↔ f = g := +begin + split, + { rintro h, simpa using congr_arg quiver.reverse h, }, + { rintro h, congr, assumption, }, +end + +lemma eq_reverse_iff [has_involutive_reverse V] + {a b : V} (f : a ⟶ b) (g : b ⟶ a) : f = reverse g ↔ reverse f = g := +by rw [←reverse_inj, reverse_reverse] + +section map_reverse + +variables [has_reverse U] [has_reverse V] [has_reverse W] + +/-- A prefunctor preserving reversal of arrows -/ +class _root_.prefunctor.map_reverse (φ : U ⥤q V) := +(map_reverse' : ∀ {u v : U} (e : u ⟶ v), φ.map (reverse e) = reverse (φ.map e)) + +@[simp] lemma _root_.prefunctor.map_reverse' (φ : U ⥤q V) [φ.map_reverse] {u v : U} (e : u ⟶ v) : + φ.map (reverse e) = reverse (φ.map e) := +prefunctor.map_reverse.map_reverse' e + +instance _root_.prefunctor.map_reverse_comp (φ : U ⥤q V) (ψ : V ⥤q W) + [φ.map_reverse] [ψ.map_reverse] : (φ ⋙q ψ).map_reverse := +{ map_reverse' := λ u v e, by { simp only [prefunctor.comp_map, prefunctor.map_reverse'], } } + +instance _root_.prefunctor.map_reverse_id : (prefunctor.id U).map_reverse := +{ map_reverse' := λ u v e, rfl } + +end map_reverse + +instance : has_reverse (symmetrify V) := ⟨λ a b e, e.swap⟩ +instance : has_involutive_reverse (symmetrify V) := +{ reverse' := λ _ _ e, e.swap, + inv' := λ _ _ e, congr_fun sum.swap_swap_eq e } + +@[simp] lemma symmetrify_reverse {a b : symmetrify V} (e : a ⟶ b) : + reverse e = e.swap := rfl + +/-- Shorthand for the "forward" arrow corresponding to `f` in `symmetrify V` -/ +abbreviation hom.to_pos {X Y : V} (f : X ⟶ Y) : + (quiver.symmetrify_quiver V).hom X Y := sum.inl f + +/-- Shorthand for the "backward" arrow corresponding to `f` in `symmetrify V` -/ +abbreviation hom.to_neg {X Y : V} (f : X ⟶ Y) : + (quiver.symmetrify_quiver V).hom Y X := sum.inr f + +/-- Reverse the direction of a path. -/ +@[simp] def path.reverse [has_reverse V] {a : V} : Π {b}, path a b → path b a +| a path.nil := path.nil +| b (path.cons p e) := (reverse e).to_path.comp p.reverse + +@[simp] lemma path.reverse_to_path [has_reverse V] {a b : V} (f : a ⟶ b) : + f.to_path.reverse = (reverse f).to_path := rfl + +@[simp] lemma path.reverse_comp [has_reverse V] {a b c : V} (p : path a b) (q : path b c) : + (p.comp q).reverse = q.reverse.comp p.reverse := by +{ induction q, { simp, }, { simp [q_ih], }, } + +@[simp] lemma path.reverse_reverse [has_involutive_reverse V] {a b : V} (p : path a b) : + p.reverse.reverse = p := +begin + induction p, + { simp, }, + { simp only [path.reverse, path.reverse_comp, path.reverse_to_path, reverse_reverse, p_ih], + refl, }, +end + +namespace symmetrify + +/-- The inclusion of a quiver in its symmetrification -/ +@[simps] def of : V ⥤q symmetrify V := +{ obj := id, + map := λ X Y f, sum.inl f } + +variables {V' : Type*} [quiver.{v'+1} V'] + +/-- Given a quiver `V'` with reversible arrows, a prefunctor to `V'` can be lifted to one from + `symmetrify V` to `V'` -/ +def lift [has_reverse V'] (φ : V ⥤q V') : + (symmetrify V) ⥤q V' := +{ obj := φ.obj, + map := λ X Y f, sum.rec (λ fwd, φ.map fwd) (λ bwd, reverse (φ.map bwd)) f } + +lemma lift_spec [has_reverse V'] (φ : V ⥤q V') : + of ⋙q (lift φ) = φ := +begin + fapply prefunctor.ext, + { rintro X, refl, }, + { rintros X Y f, refl, }, +end + +lemma lift_reverse [h : has_involutive_reverse V'] + (φ : V ⥤q V') + {X Y : symmetrify V} (f : X ⟶ Y) : + (lift φ).map (quiver.reverse f) = quiver.reverse ((lift φ).map f) := +begin + dsimp [lift], cases f, + { simp only, refl, }, + { simp only [reverse_reverse], refl, } +end + +/-- `lift φ` is the only prefunctor extending `φ` and preserving reverses. -/ +lemma lift_unique [has_reverse V'] + (φ : V ⥤q V') + (Φ : (symmetrify V) ⥤q V') + (hΦ : of ⋙q Φ = φ) [hΦrev : Φ.map_reverse] : + Φ = lift φ := +begin + subst_vars, + fapply prefunctor.ext, + { rintro X, refl, }, + { rintros X Y f, + cases f, + { refl, }, + { dsimp [lift,of], + simp only [←prefunctor.map_reverse', symmetrify_reverse, sum.swap_inl], }, }, +end + +/-- A prefunctor canonically defines a prefunctor of the symmetrifications. -/ +@[simps] def _root_.prefunctor.symmetrify (φ : U ⥤q V) : (symmetrify U) ⥤q (symmetrify V) := +{ obj := φ.obj, + map := λ X Y, sum.map φ.map φ.map } + +instance _root_.prefunctor.symmetrify_map_reverse (φ : U ⥤q V) : + prefunctor.map_reverse φ.symmetrify := ⟨λ u v e, by { cases e; refl }⟩ + +end symmetrify + +namespace push + +variables {V' : Type*} (σ : V → V') + +instance [has_reverse V] : has_reverse (push σ) := +{ reverse' := λ a b F, by { cases F, constructor, apply reverse, exact F_f, } } + +instance [has_involutive_reverse V] : has_involutive_reverse (push σ) := +{ reverse' := λ a b F, by { cases F, constructor, apply reverse, exact F_f, }, + inv' := λ a b F, by { cases F, dsimp [reverse], congr, apply reverse_reverse, } } + +lemma of_reverse [h : has_involutive_reverse V] (X Y : V) (f : X ⟶ Y): + (reverse $ ((push.of σ)).map f) = ((push.of σ)).map (reverse f) := rfl + +instance of_map_reverse [h : has_involutive_reverse V] : (push.of σ).map_reverse := +⟨ by simp [of_reverse] ⟩ + +end push + +/-- +A quiver is preconnected iff there exists a path between any pair of +vertices. +Note that if `V` doesn't `has_reverse`, then the definition is stronger than +simply having a preconnected underlying `simple_graph`, since a path in one +direction doesn't induce one in the other. +-/ +def is_preconnected (V) [quiver.{u+1} V] := ∀ (X Y : V), nonempty (path X Y) + +end quiver diff --git a/src/combinatorics/set_family/ahlswede_zhang.lean b/src/combinatorics/set_family/ahlswede_zhang.lean new file mode 100644 index 0000000000000..276084c473ce1 --- /dev/null +++ b/src/combinatorics/set_family/ahlswede_zhang.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2023 Yaël Dillies, Vladimir Ivanov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Vladimir Ivanov +-/ +import data.finset.sups + +/-! +# The Ahlswede-Zhang identity + +This file proves the Ahlswede-Zhang identity, which is a nontrivial relation between the size of the +"truncated unions" of a set family. It sharpens the Lubell-Yamamoto-Meshalkin inequality +`finset.sum_card_slice_div_choose_le_one`, by making explicit the correction term. + +For a set family `𝒜`, the Ahlswede-Zhang identity states that the sum of +`|⋂ B ∈ 𝒜, B ⊆ A, B|/(|A| * n.choose |A|)` is exactly `1`. + +## Main declarations + +* `finset.truncated_sup`: `s.truncated_sup a` is the supremum of all `b ≤ a` in `𝒜` if there are + some, or `⊤` if there are none. +* `finset.truncated_inf` `s.truncated_inf a` is the infimum of all `b ≥ a` in `𝒜` if there are + some, or `⊥` if there are none. + +## References + +* [R. Ahlswede, Z. Zhang, *An identity in combinatorial extremal theory*](https://doi.org/10.1016/0001-8708(90)90023-G) +* [D. T. Tru, *An AZ-style identity and Bollobás deficiency*](https://doi.org/10.1016/j.jcta.2007.03.005) +-/ + +open_locale finset_family + +namespace finset +variables {α β : Type*} + +/-! ### Truncated supremum, truncated infimum -/ + +section semilattice_sup +variables [semilattice_sup α] [order_top α] [@decidable_rel α (≤)] + [semilattice_sup β] [bounded_order β] [@decidable_rel β (≤)] {s t : finset α} {a b : α} + +private lemma sup_aux : a ∈ lower_closure (s : set α) → (s.filter $ λ b, a ≤ b).nonempty := +λ ⟨b, hb, hab⟩, ⟨b, mem_filter.2 ⟨hb, hab⟩⟩ + +/-- The infimum of the elements of `s` less than `a` if there are some, otherwise `⊤`. -/ +def truncated_sup (s : finset α) (a : α) : α := +if h : a ∈ lower_closure (s : set α) then (s.filter $ λ b, a ≤ b).sup' (sup_aux h) id else ⊤ + +lemma truncated_sup_of_mem (h : a ∈ lower_closure (s : set α)) : + truncated_sup s a = (s.filter $ λ b, a ≤ b).sup' (sup_aux h) id := dif_pos h + +lemma truncated_sup_of_not_mem (h : a ∉ lower_closure (s : set α)) : truncated_sup s a = ⊤ := +dif_neg h + +@[simp] lemma truncated_sup_empty (a : α) : truncated_sup ∅ a = ⊤ := +truncated_sup_of_not_mem $ by simp + +lemma le_truncated_sup : a ≤ truncated_sup s a := +begin + rw truncated_sup, + split_ifs, + { obtain ⟨ℬ, hb, h⟩ := h, + exact h.trans (le_sup' _ $ mem_filter.2 ⟨hb, h⟩) }, + { exact le_top } +end + +lemma map_truncated_sup (e : α ≃o β) (s : finset α) (a : α) : + e (truncated_sup s a) = truncated_sup (s.map e.to_equiv.to_embedding) (e a) := +begin + have : e a ∈ lower_closure (s.map e.to_equiv.to_embedding : set β) + ↔ a ∈ lower_closure (s : set α), + { simp }, + simp_rw [truncated_sup, apply_dite e, map_finset_sup', map_top, this], + congr' with h, + simp only [filter_map, function.comp, equiv.coe_to_embedding, rel_iso.coe_fn_to_equiv, + order_iso.le_iff_le, id.def], + rw sup'_map, -- TODO: Why can't `simp` use `finset.sup'_map`? + simp only [equiv.coe_to_embedding, rel_iso.coe_fn_to_equiv], +end + +variables [decidable_eq α] + +private lemma lower_aux : + a ∈ lower_closure (↑(s ∪ t) : set α) ↔ + a ∈ lower_closure (s : set α) ∨ a ∈ lower_closure (t : set α) := +by rw [coe_union, lower_closure_union, lower_set.mem_sup_iff] + +lemma truncated_sup_union (hs : a ∈ lower_closure (s : set α)) + (ht : a ∈ lower_closure (t : set α)) : + truncated_sup (s ∪ t) a = truncated_sup s a ⊔ truncated_sup t a := +by simpa only [truncated_sup_of_mem, hs, ht, lower_aux.2 (or.inl hs), filter_union] + using sup'_union _ _ _ + +lemma truncated_sup_union_left (hs : a ∈ lower_closure (s : set α)) + (ht : a ∉ lower_closure (t : set α)) : + truncated_sup (s ∪ t) a = truncated_sup s a := +begin + simp only [mem_lower_closure, mem_coe, exists_prop, not_exists, not_and] at ht, + simp only [truncated_sup_of_mem, hs, filter_union, filter_false_of_mem ht, union_empty, + lower_aux.2 (or.inl hs), ht], +end + +lemma truncated_sup_union_right (hs : a ∉ lower_closure (s : set α)) + (ht : a ∈ lower_closure (t : set α)) : + truncated_sup (s ∪ t) a = truncated_sup t a := +by rw [union_comm, truncated_sup_union_left ht hs] + +lemma truncated_sup_union_of_not_mem (hs : a ∉ lower_closure (s : set α)) + (ht : a ∉ lower_closure (t : set α)) : + truncated_sup (s ∪ t) a = ⊤ := +truncated_sup_of_not_mem $ λ h, (lower_aux.1 h).elim hs ht + +end semilattice_sup + +section semilattice_inf +variables [semilattice_inf α] [bounded_order α] [@decidable_rel α (≤)] + [semilattice_inf β] [bounded_order β] [@decidable_rel β (≤)] {s t : finset α} {a : α} + +private lemma inf_aux : a ∈ upper_closure (s : set α) → (s.filter $ λ b, b ≤ a).nonempty := +λ ⟨b, hb, hab⟩, ⟨b, mem_filter.2 ⟨hb, hab⟩⟩ + +/-- The infimum of the elements of `s` less than `a` if there are some, otherwise `⊥`. -/ +def truncated_inf (s : finset α) (a : α) : α := +if h : a ∈ upper_closure (s : set α) then (s.filter $ λ b, b ≤ a).inf' (inf_aux h) id else ⊥ + +lemma truncated_inf_of_mem (h : a ∈ upper_closure (s : set α)) : + truncated_inf s a = (s.filter $ λ b, b ≤ a).inf' (inf_aux h) id := dif_pos h + +lemma truncated_inf_of_not_mem (h : a ∉ upper_closure (s : set α)) : truncated_inf s a = ⊥ := +dif_neg h + +lemma truncated_inf_le (s : finset α) (a : α) : truncated_inf s a ≤ a := +begin + unfold truncated_inf, + split_ifs, + { obtain ⟨ℬ, hb, h⟩ := h, + exact (inf'_le _ $ mem_filter.2 ⟨hb, h⟩).trans h }, + { exact bot_le } +end + +@[simp] lemma truncated_inf_empty (a : α) : truncated_inf ∅ a = ⊥ := +truncated_inf_of_not_mem $ by simp + +lemma map_truncated_inf (e : α ≃o β) (s : finset α) (a : α) : + e (truncated_inf s a) = truncated_inf (s.map e.to_equiv.to_embedding) (e a) := +begin + have : e a ∈ upper_closure (s.map e.to_equiv.to_embedding : set β) + ↔ a ∈ upper_closure (s : set α), + { simp }, + simp_rw [truncated_inf, apply_dite e, map_finset_inf', map_bot, this], + congr' with h, + simp only [filter_map, function.comp, equiv.coe_to_embedding, rel_iso.coe_fn_to_equiv, + order_iso.le_iff_le, id.def], + rw inf'_map, -- TODO: Why can't `simp` use `finset.inf'_map`? + simp only [equiv.coe_to_embedding, rel_iso.coe_fn_to_equiv], +end + +variables [decidable_eq α] + +private lemma upper_aux : + a ∈ upper_closure (↑(s ∪ t) : set α) ↔ + a ∈ upper_closure (s : set α) ∨ a ∈ upper_closure (t : set α) := +by rw [coe_union, upper_closure_union, upper_set.mem_inf_iff] + +lemma truncated_inf_union (hs : a ∈ upper_closure (s : set α)) + (ht : a ∈ upper_closure (t : set α)) : + truncated_inf (s ∪ t) a = truncated_inf s a ⊓ truncated_inf t a := +by simpa only [truncated_inf_of_mem, hs, ht, upper_aux.2 (or.inl hs), filter_union] + using inf'_union _ _ _ + +lemma truncated_inf_union_left (hs : a ∈ upper_closure (s : set α)) + (ht : a ∉ upper_closure (t : set α)) : + truncated_inf (s ∪ t) a = truncated_inf s a := +begin + simp only [mem_upper_closure, mem_coe, exists_prop, not_exists, not_and] at ht, + simp only [truncated_inf_of_mem, hs, filter_union, filter_false_of_mem ht, union_empty, + upper_aux.2 (or.inl hs), ht], +end + +lemma truncated_inf_union_right (hs : a ∉ upper_closure (s : set α)) + (ht : a ∈ upper_closure (t : set α)) : + truncated_inf (s ∪ t) a = truncated_inf t a := +by rw [union_comm, truncated_inf_union_left ht hs] + +lemma truncated_inf_union_of_not_mem (hs : a ∉ upper_closure (s : set α)) + (ht : a ∉ upper_closure (t : set α)) : + truncated_inf (s ∪ t) a = ⊥ := +truncated_inf_of_not_mem $ by { rw [coe_union, upper_closure_union], exact λ h, h.elim hs ht } + +end semilattice_inf + +section distrib_lattice +variables [distrib_lattice α] [bounded_order α] [decidable_eq α] [@decidable_rel α (≤)] + {s t : finset α} {a : α} + +private lemma infs_aux + : a ∈ lower_closure (↑(s ⊼ t) : set α) ↔ a ∈ lower_closure (s : set α) ⊓ lower_closure t := +by rw [coe_infs, lower_closure_infs, lower_set.mem_inf_iff] + +private lemma sups_aux : + a ∈ upper_closure (↑(s ⊻ t) : set α) ↔ a ∈ upper_closure (s : set α) ⊔ upper_closure t := +by rw [coe_sups, upper_closure_sups, upper_set.mem_sup_iff] + +lemma truncated_sup_infs (hs : a ∈ lower_closure (s : set α)) (ht : a ∈ lower_closure (t : set α)) : + truncated_sup (s ⊼ t) a = truncated_sup s a ⊓ truncated_sup t a := +begin + simp only [truncated_sup_of_mem, hs, ht, infs_aux.2 ⟨hs, ht⟩, sup'_inf_sup', filter_infs_ge], + simp_rw ←image_inf_product, + rw sup'_image, + refl, +end + +lemma truncated_inf_sups (hs : a ∈ upper_closure (s : set α)) (ht : a ∈ upper_closure (t : set α)) : + truncated_inf (s ⊻ t) a = truncated_inf s a ⊔ truncated_inf t a := +begin + simp only [truncated_inf_of_mem, hs, ht, sups_aux.2 ⟨hs, ht⟩, inf'_sup_inf', filter_sups_le], + simp_rw ←image_sup_product, + rw inf'_image, + refl, +end + +lemma truncated_sup_infs_of_not_mem (ha : a ∉ lower_closure (s : set α) ⊓ lower_closure t) : + truncated_sup (s ⊼ t) a = ⊤ := +truncated_sup_of_not_mem $ by rwa [coe_infs, lower_closure_infs] + +lemma truncated_inf_sups_of_not_mem (ha : a ∉ upper_closure (s : set α) ⊔ upper_closure t) : + truncated_inf (s ⊻ t) a = ⊥ := +truncated_inf_of_not_mem $ by rwa [coe_sups, upper_closure_sups] + +end distrib_lattice + +section boolean_algebra +variables [boolean_algebra α] [@decidable_rel α (≤)] {s : finset α} {a : α} + +@[simp] lemma compl_truncated_sup (s : finset α) (a : α) : + (truncated_sup s a)ᶜ = truncated_inf (s.map ⟨compl, compl_injective⟩) aᶜ := +map_truncated_sup (order_iso.compl α) _ _ + +@[simp] lemma compl_truncated_inf (s : finset α) (a : α) : + (truncated_inf s a)ᶜ = truncated_sup (s.map ⟨compl, compl_injective⟩) aᶜ := +map_truncated_inf (order_iso.compl α) _ _ + +end boolean_algebra + +variables [decidable_eq α] [fintype α] + +lemma card_truncated_sup_union_add_card_truncated_sup_infs (𝒜 ℬ : finset (finset α)) + (s : finset α) : + (truncated_sup (𝒜 ∪ ℬ) s).card + (truncated_sup (𝒜 ⊼ ℬ) s).card = + (truncated_sup 𝒜 s).card + (truncated_sup ℬ s).card := +begin + by_cases h𝒜 : s ∈ lower_closure (𝒜 : set $ finset α); + by_cases hℬ : s ∈ lower_closure (ℬ : set $ finset α), + { rw [truncated_sup_union h𝒜 hℬ, truncated_sup_infs h𝒜 hℬ], + exact card_union_add_card_inter _ _ }, + { rw [truncated_sup_union_left h𝒜 hℬ, truncated_sup_of_not_mem hℬ, + truncated_sup_infs_of_not_mem (λ h, hℬ h.2)] }, + { rw [truncated_sup_union_right h𝒜 hℬ, truncated_sup_of_not_mem h𝒜, + truncated_sup_infs_of_not_mem (λ h, h𝒜 h.1), add_comm] }, + { rw [truncated_sup_of_not_mem h𝒜, truncated_sup_of_not_mem hℬ, + truncated_sup_union_of_not_mem h𝒜 hℬ, truncated_sup_infs_of_not_mem (λ h, h𝒜 h.1)] } +end + +end finset diff --git a/src/combinatorics/set_family/compression/down.lean b/src/combinatorics/set_family/compression/down.lean new file mode 100644 index 0000000000000..2445f2eb75c10 --- /dev/null +++ b/src/combinatorics/set_family/compression/down.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.finset.card + +/-! +# Down-compressions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines down-compression. + +Down-compressing `𝒜 : finset (finset α)` along `a : α` means removing `a` from the elements of `𝒜`, +when the resulting set is not already in `𝒜`. + +## Main declarations + +* `finset.non_member_subfamily`: `𝒜.non_member_subfamily a` is the subfamily of sets not containing + `a`. +* `finset.member_subfamily`: `𝒜.member_subfamily a` is the image of the subfamily of sets containing + `a` under removing `a`. +* `down.compression`: Down-compression. + +## Notation + +`𝓓 a 𝒜` is notation for `down.compress a 𝒜` in locale `set_family`. + +## References + +* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf + +## Tags + +compression, down-compression +-/ + +variables {α : Type*} [decidable_eq α] {𝒜 ℬ : finset (finset α)} {s : finset α} {a : α} + +namespace finset + +/-- Elements of `𝒜` that do not contain `a`. -/ +def non_member_subfamily (a : α) (𝒜 : finset (finset α)) : finset (finset α) := +𝒜.filter $ λ s, a ∉ s + +/-- Image of the elements of `𝒜` which contain `a` under removing `a`. Finsets that do not contain +`a` such that `insert a s ∈ 𝒜`. -/ +def member_subfamily (a : α) (𝒜 : finset (finset α)) : finset (finset α) := +(𝒜.filter $ λ s, a ∈ s).image $ λ s, erase s a + +@[simp] lemma mem_non_member_subfamily : s ∈ 𝒜.non_member_subfamily a ↔ s ∈ 𝒜 ∧ a ∉ s := mem_filter +@[simp] lemma mem_member_subfamily : s ∈ 𝒜.member_subfamily a ↔ insert a s ∈ 𝒜 ∧ a ∉ s := +begin + simp_rw [member_subfamily, mem_image, mem_filter], + refine ⟨_, λ h, ⟨insert a s, ⟨h.1, mem_insert_self _ _⟩, erase_insert h.2⟩⟩, + rintro ⟨s, hs, rfl⟩, + rw insert_erase hs.2, + exact ⟨hs.1, not_mem_erase _ _⟩, +end + +lemma non_member_subfamily_inter (a : α) (𝒜 ℬ : finset (finset α)) : + (𝒜 ∩ ℬ).non_member_subfamily a = 𝒜.non_member_subfamily a ∩ ℬ.non_member_subfamily a := +filter_inter_distrib _ _ _ + +lemma member_subfamily_inter (a : α) (𝒜 ℬ : finset (finset α)) : + (𝒜 ∩ ℬ).member_subfamily a = 𝒜.member_subfamily a ∩ ℬ.member_subfamily a := +begin + unfold member_subfamily, + rw [filter_inter_distrib, image_inter_of_inj_on _ _ ((erase_inj_on' _).mono _)], + rw [←coe_union, ←filter_union, coe_filter], + exact set.inter_subset_right _ _, +end + +lemma non_member_subfamily_union (a : α) (𝒜 ℬ : finset (finset α)) : + (𝒜 ∪ ℬ).non_member_subfamily a = 𝒜.non_member_subfamily a ∪ ℬ.non_member_subfamily a := +filter_union _ _ _ + +lemma member_subfamily_union (a : α) (𝒜 ℬ : finset (finset α)) : + (𝒜 ∪ ℬ).member_subfamily a = 𝒜.member_subfamily a ∪ ℬ.member_subfamily a := +by simp_rw [member_subfamily, filter_union, image_union] + +lemma card_member_subfamily_add_card_non_member_subfamily (a : α) (𝒜 : finset (finset α)) : + (𝒜.member_subfamily a).card + (𝒜.non_member_subfamily a).card = 𝒜.card := +begin + rw [member_subfamily, non_member_subfamily, card_image_of_inj_on, + filter_card_add_filter_neg_card_eq_card], + exact (erase_inj_on' _).mono (λ s hs, (mem_filter.1 hs).2), +end + +lemma member_subfamily_union_non_member_subfamily (a : α) (𝒜 : finset (finset α)) : + 𝒜.member_subfamily a ∪ 𝒜.non_member_subfamily a = 𝒜.image (λ s, s.erase a) := +begin + ext s, + simp only [mem_union, mem_member_subfamily, mem_non_member_subfamily, mem_image, exists_prop], + split, + { rintro (h | h), + { exact ⟨_, h.1, erase_insert h.2⟩ }, + { exact ⟨_, h.1, erase_eq_of_not_mem h.2⟩ } }, + { rintro ⟨s, hs, rfl⟩, + by_cases ha : a ∈ s, + { exact or.inl ⟨by rwa insert_erase ha, not_mem_erase _ _⟩ }, + { exact or.inr ⟨by rwa erase_eq_of_not_mem ha, not_mem_erase _ _⟩ } } +end + +@[simp] lemma member_subfamily_member_subfamily : (𝒜.member_subfamily a).member_subfamily a = ∅ := +by { ext, simp } + +@[simp] lemma member_subfamily_non_member_subfamily : + (𝒜.non_member_subfamily a).member_subfamily a = ∅ := +by { ext, simp } + +@[simp] lemma non_member_subfamily_member_subfamily : + (𝒜.member_subfamily a).non_member_subfamily a = 𝒜.member_subfamily a := +by { ext, simp } + +@[simp] lemma non_member_subfamily_non_member_subfamily : + (𝒜.non_member_subfamily a).non_member_subfamily a = 𝒜.non_member_subfamily a := +by { ext, simp } + +end finset + +open finset + +-- The namespace is here to distinguish from other compressions. +namespace down + +/-- `a`-down-compressing `𝒜` means removing `a` from the elements of `𝒜` that contain it, when the +resulting finset is not already in `𝒜`. -/ +def compression (a : α) (𝒜 : finset (finset α)) : finset (finset α) := +(𝒜.filter $ λ s, erase s a ∈ 𝒜).disj_union ((𝒜.image $ λ s, erase s a).filter $ λ s, s ∉ 𝒜) $ + disjoint_left.2 $ λ s h₁ h₂, (mem_filter.1 h₂).2 (mem_filter.1 h₁).1 + +localized "notation (name := down.compression) `𝓓 ` := down.compression" in finset_family + +/-- `a` is in the down-compressed family iff it's in the original and its compression is in the +original, or it's not in the original but it's the compression of something in the original. -/ +lemma mem_compression : s ∈ 𝓓 a 𝒜 ↔ s ∈ 𝒜 ∧ s.erase a ∈ 𝒜 ∨ s ∉ 𝒜 ∧ insert a s ∈ 𝒜 := +begin + simp_rw [compression, mem_disj_union, mem_filter, mem_image, and_comm (s ∉ 𝒜)], + refine or_congr_right' (and_congr_left $ λ hs, + ⟨_, λ h, ⟨_, h, erase_insert $ insert_ne_self.1 $ ne_of_mem_of_not_mem h hs⟩⟩), + rintro ⟨t, ht, rfl⟩, + rwa insert_erase (erase_ne_self.1 (ne_of_mem_of_not_mem ht hs).symm), +end + +lemma erase_mem_compression (hs : s ∈ 𝒜) : s.erase a ∈ 𝓓 a 𝒜 := +begin + simp_rw [mem_compression, erase_idem, and_self], + refine (em _).imp_right (λ h, ⟨h, _⟩), + rwa insert_erase (erase_ne_self.1 (ne_of_mem_of_not_mem hs h).symm), +end + +-- This is a special case of `erase_mem_compression` once we have `compression_idem`. +lemma erase_mem_compression_of_mem_compression : s ∈ 𝓓 a 𝒜 → s.erase a ∈ 𝓓 a 𝒜 := +begin + simp_rw [mem_compression, erase_idem], + refine or.imp (λ h, ⟨h.2, h.2⟩) (λ h, _), + rwa [erase_eq_of_not_mem (insert_ne_self.1 $ ne_of_mem_of_not_mem h.2 h.1)], +end + +lemma mem_compression_of_insert_mem_compression (h : insert a s ∈ 𝓓 a 𝒜) : s ∈ 𝓓 a 𝒜 := +begin + by_cases ha : a ∈ s, + { rwa insert_eq_of_mem ha at h }, + { rw ←erase_insert ha, + exact erase_mem_compression_of_mem_compression h } +end + +/-- Down-compressing a family is idempotent. -/ +@[simp] lemma compression_idem (a : α) (𝒜 : finset (finset α)) : 𝓓 a (𝓓 a 𝒜) = 𝓓 a 𝒜 := +begin + ext s, + refine mem_compression.trans ⟨_, λ h, or.inl ⟨h, erase_mem_compression_of_mem_compression h⟩⟩, + rintro (h | h), + { exact h.1 }, + { cases h.1 (mem_compression_of_insert_mem_compression h.2) } +end + +/-- Down-compressing a family doesn't change its size. -/ +@[simp] lemma card_compression (a : α) (𝒜 : finset (finset α)) : (𝓓 a 𝒜).card = 𝒜.card := +begin + rw [compression, card_disj_union, image_filter, card_image_of_inj_on ((erase_inj_on' _).mono $ + λ s hs, _), ←card_disjoint_union, filter_union_filter_neg_eq], + { exact disjoint_filter_filter_neg _ _ _ }, + rw [mem_coe, mem_filter] at hs, + exact not_imp_comm.1 erase_eq_of_not_mem (ne_of_mem_of_not_mem hs.1 hs.2).symm, +end + +end down diff --git a/src/combinatorics/set_family/compression/uv.lean b/src/combinatorics/set_family/compression/uv.lean index efbf6d150d0c1..704e6b0f708dc 100644 --- a/src/combinatorics/set_family/compression/uv.lean +++ b/src/combinatorics/set_family/compression/uv.lean @@ -3,11 +3,15 @@ Copyright (c) 2021 Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Bhavik Mehta -/ -import data.finset.card +import combinatorics.set_family.shadow +import data.finset.sort /-! # UV-compressions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines UV-compression. It is an operation on a set family that reduces its shadow. UV-compressing `a : α` along `u v : α` means replacing `a` by `(a ⊔ u) \ v` if `a` and `u` are @@ -24,7 +28,9 @@ minimise the shadow. It is the compressions of the elements of `s` whose compression is not already in `s` along with the element whose compression is already in `s`. This way of splitting into what moves and what does not ensures the compression doesn't squash the set family, which is proved by - `uv.card_compress`. + `uv.card_compression`. +* `uv.card_shadow_compression_le`: Compressing reduces the size of the shadow. This is a key fact in + the proof of Kruskal-Katona. ## Notation @@ -35,11 +41,6 @@ minimise the shadow. Even though our emphasis is on `finset α`, we define UV-compressions more generally in a generalized boolean algebra, so that one can use it for `set α`. -## TODO - -Prove that compressing reduces the size of shadow. This result and some more already exist on the -branch `combinatorics`. - ## References * https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf @@ -74,8 +75,11 @@ section generalized_boolean_algebra variables [generalized_boolean_algebra α] [decidable_rel (@disjoint α _ _)] [decidable_rel ((≤) : α → α → Prop)] {s : finset α} {u v a b : α} -/-- To UV-compress `a`, if it doesn't touch `U` and does contain `V`, we remove `V` and -put `U` in. We'll only really use this when `|U| = |V|` and `U ∩ V = ∅`. -/ +local attribute [instance] decidable_eq_of_decidable_le + +/-- UV-compressing `a` means removing `v` from it and adding `u` if `a` and `u` are disjoint and +`v ≤ a` (it replaces the `v` part of `a` by the `u` part). Else, UV-compressing `a` doesn't do +anything. This is most useful when `u` and `v` are disjoint finsets of the same size. -/ def compress (u v a : α) : α := if disjoint u a ∧ v ≤ a then (a ⊔ u) \ v else a /-- To UV-compress a set family, we compress each of its elements, except that we don't want to @@ -83,7 +87,7 @@ reduce the cardinality, so we keep all elements whose compression is already pre def compression (u v : α) (s : finset α) := s.filter (λ a, compress u v a ∈ s) ∪ (s.image $ compress u v).filter (λ a, a ∉ s) -localized "notation `𝓒 ` := uv.compression" in finset_family +localized "notation (name := uv.compression) `𝓒 ` := uv.compression" in finset_family /-- `is_compressed u v s` expresses that `s` is UV-compressed. -/ def is_compressed (u v : α) (s : finset α) := 𝓒 u v s = s @@ -92,12 +96,20 @@ lemma compress_of_disjoint_of_le (hua : disjoint u a) (hva : v ≤ a) : compress u v a = (a ⊔ u) \ v := if_pos ⟨hua, hva⟩ +lemma compress_of_disjoint_of_le' (hva : disjoint v a) (hua : u ≤ a) : + compress u v ((a ⊔ v) \ u) = a := +by rw [compress_of_disjoint_of_le disjoint_sdiff_self_right + (le_sdiff.2 ⟨(le_sup_right : v ≤ a ⊔ v), hva.mono_right hua⟩), + sdiff_sup_cancel (le_sup_of_le_left hua), hva.symm.sup_sdiff_cancel_right] + /-- `a` is in the UV-compressed family iff it's in the original and its compression is in the original, or it's not in the original but it's the compression of something in the original. -/ lemma mem_compression : a ∈ 𝓒 u v s ↔ a ∈ s ∧ compress u v a ∈ s ∨ a ∉ s ∧ ∃ b ∈ s, compress u v b = a := by simp_rw [compression, mem_union, mem_filter, mem_image, and_comm (a ∉ s)] +protected lemma is_compressed.eq (h : is_compressed u v s) : 𝓒 u v s = s := h + @[simp] lemma compress_self (u a : α) : compress u u a = a := begin unfold compress, @@ -121,6 +133,14 @@ end /-- Any family is compressed along two identical elements. -/ lemma is_compressed_self (u : α) (s : finset α) : is_compressed u u s := compression_self u s +/-- An element can be compressed to any other element by removing/adding the differences. -/ +@[simp] lemma compress_sdiff_sdiff (a b : α) : compress (a \ b) (b \ a) b = a := +begin + refine (compress_of_disjoint_of_le disjoint_sdiff_self_left sdiff_le).trans _, + rw [sup_sdiff_self_right, sup_sdiff, disjoint_sdiff_self_right.sdiff_eq_left, sup_eq_right], + exact sdiff_sdiff_le, +end + lemma compress_disjoint (u v : α) : disjoint (s.filter (λ a, compress u v a ∈ s)) ((s.image $ compress u v).filter (λ a, a ∉ s)) := disjoint_left.2 $ λ a ha₁ ha₂, (mem_filter.1 ha₂).2 (mem_filter.1 ha₁).1 @@ -164,12 +184,12 @@ begin end /-- Compressing a family doesn't change its size. -/ -lemma card_compression (u v : α) (s : finset α) : (𝓒 u v s).card = s.card := +@[simp] lemma card_compression (u v : α) (s : finset α) : (𝓒 u v s).card = s.card := begin rw [compression, card_disjoint_union (compress_disjoint _ _), image_filter, card_image_of_inj_on, ←card_disjoint_union, filter_union_filter_neg_eq], { rw disjoint_iff_inter_eq_empty, - exact filter_inter_filter_neg_eq _ _ }, + exact filter_inter_filter_neg_eq _ _ _ }, intros a ha b hb hab, dsimp at hab, rw [mem_coe, mem_filter, function.comp_app] at ha hb, @@ -182,6 +202,43 @@ begin { exact (ha.2 ha.1).elim } end +lemma le_of_mem_compression_of_not_mem (h : a ∈ 𝓒 u v s) (ha : a ∉ s) : u ≤ a := +begin + rw mem_compression at h, + obtain _ | ⟨-, b, hb, hba⟩ := h, + { cases ha h.1 }, + unfold compress at hba, + split_ifs at hba, + { rw [←hba, le_sdiff], + exact ⟨le_sup_right, h.1.mono_right h.2⟩ }, + { cases ne_of_mem_of_not_mem hb ha hba } +end + +lemma disjoint_of_mem_compression_of_not_mem (h : a ∈ 𝓒 u v s) (ha : a ∉ s) : disjoint v a := +begin + rw mem_compression at h, + obtain _ | ⟨-, b, hb, hba⟩ := h, + { cases ha h.1 }, + unfold compress at hba, + split_ifs at hba, + { rw ←hba, + exact disjoint_sdiff_self_right }, + { cases ne_of_mem_of_not_mem hb ha hba } +end + +lemma sup_sdiff_mem_of_mem_compression_of_not_mem (h : a ∈ 𝓒 u v s) (ha : a ∉ s) : + (a ⊔ v) \ u ∈ s := +begin + rw mem_compression at h, + obtain _ | ⟨-, b, hb, hba⟩ := h, + { cases ha h.1 }, + unfold compress at hba, + split_ifs at hba, + { rwa [←hba, sdiff_sup_cancel (le_sup_of_le_left h.2), sup_sdiff_right_self, + h.1.symm.sdiff_eq_left] }, + { cases ne_of_mem_of_not_mem hb ha hba } +end + /-- If `a` is in the family compression and can be compressed, then its compression is in the original family. -/ lemma sup_sdiff_mem_of_mem_compression (ha : a ∈ 𝓒 u v s) (hva : v ≤ a) (hua : disjoint u a) : @@ -214,8 +271,7 @@ begin unfold compress at h, split_ifs at h, { rw [←h, le_sdiff_iff] at hva, - rw [hvu hva, hva, sup_bot_eq, sdiff_bot] at h, - rwa ←h }, + rwa [←h, hvu hva, hva, sup_bot_eq, sdiff_bot] }, { rwa ←h } end @@ -225,16 +281,132 @@ end generalized_boolean_algebra open_locale finset_family -variables [decidable_eq α] {𝒜 : finset (finset α)} {U V A : finset α} +variables [decidable_eq α] {𝒜 : finset (finset α)} {u v a : finset α} /-- Compressing a finset doesn't change its size. -/ -lemma card_compress (hUV : U.card = V.card) (A : finset α) : (compress U V A).card = A.card := +lemma card_compress (hUV : u.card = v.card) (A : finset α) : (compress u v A).card = A.card := begin unfold compress, split_ifs, { rw [card_sdiff (h.2.trans le_sup_left), sup_eq_union, card_disjoint_union h.1.symm, hUV, - add_tsub_cancel_right] }, + add_tsub_cancel_right] }, { refl } end +private lemma aux (huv : ∀ x ∈ u, ∃ y ∈ v, is_compressed (u.erase x) (v.erase y) 𝒜) : + v = ∅ → u = ∅ := +by { rintro rfl, refine eq_empty_of_forall_not_mem (λ a ha, _), obtain ⟨_, ⟨⟩, -⟩ := huv a ha } + +/-- UV-compression reduces the size of the shadow of `𝒜` if, for all `x ∈ u` there is `y ∈ v` such +that `𝒜` is `(u.erase x, v.erase y)`-compressed. This is the key fact about compression for +Kruskal-Katona. -/ +lemma shadow_compression_subset_compression_shadow (u v : finset α) + (huv : ∀ x ∈ u, ∃ y ∈ v, is_compressed (u.erase x) (v.erase y) 𝒜) : + ∂ (𝓒 u v 𝒜) ⊆ 𝓒 u v (∂ 𝒜) := +begin + set 𝒜' := 𝓒 u v 𝒜, + suffices H : ∀ s, s ∈ ∂ 𝒜' → s ∉ ∂ 𝒜 → + u ⊆ s ∧ disjoint v s ∧ (s ∪ v) \ u ∈ ∂ 𝒜 ∧ (s ∪ v) \ u ∉ ∂ 𝒜', + { rintro s hs', + rw mem_compression, + by_cases hs : s ∈ 𝒜.shadow, swap, + { obtain ⟨hus, hvs, h, _⟩ := H _ hs' hs, + exact or.inr ⟨hs, _, h, compress_of_disjoint_of_le' hvs hus⟩ }, + refine or.inl ⟨hs, _⟩, + rw compress, + split_ifs with huvs, swap, + { exact hs }, + rw mem_shadow_iff at hs', + obtain ⟨t, Ht, a, hat, rfl⟩ := hs', + have hav : a ∉ v := not_mem_mono huvs.2 (not_mem_erase a t), + have hvt : v ≤ t := huvs.2.trans (erase_subset _ t), + have ht : t ∈ 𝒜 := mem_of_mem_compression Ht hvt (aux huv), + by_cases hau : a ∈ u, + { obtain ⟨b, hbv, Hcomp⟩ := huv a hau, + refine mem_shadow_iff_insert_mem.2 ⟨b, not_mem_sdiff_of_mem_right hbv, _⟩, + rw ←Hcomp.eq at ht, + have hsb := sup_sdiff_mem_of_mem_compression ht ((erase_subset _ _).trans hvt) + (disjoint_erase_comm.2 huvs.1), + rwa [sup_eq_union, sdiff_erase (mem_union_left _ $ hvt hbv), union_erase_of_mem hat, + ←erase_union_of_mem hau] at hsb }, + { refine mem_shadow_iff.2 ⟨(t ⊔ u) \ v, sup_sdiff_mem_of_mem_compression Ht hvt $ + disjoint_of_erase_right hau huvs.1, a, _, _⟩, + { rw [sup_eq_union, mem_sdiff, mem_union], + exact ⟨or.inl hat, hav⟩ }, + { rw [←erase_sdiff_comm, sup_eq_union, erase_union_distrib, erase_eq_of_not_mem hau] } } }, + intros s hs𝒜' hs𝒜, + -- This is gonna be useful a couple of times so let's name it. + have m : ∀ y ∉ s, insert y s ∉ 𝒜 := λ y h a, hs𝒜 (mem_shadow_iff_insert_mem.2 ⟨y, h, a⟩), + obtain ⟨x, _, _⟩ := mem_shadow_iff_insert_mem.1 hs𝒜', + have hus : u ⊆ insert x s := le_of_mem_compression_of_not_mem ‹_ ∈ 𝒜'› (m _ ‹x ∉ s›), + have hvs : disjoint v (insert x s) := disjoint_of_mem_compression_of_not_mem ‹_› (m _ ‹x ∉ s›), + have : (insert x s ∪ v) \ u ∈ 𝒜 := sup_sdiff_mem_of_mem_compression_of_not_mem ‹_› (m _ ‹x ∉ s›), + have hsv : disjoint s v := hvs.symm.mono_left (subset_insert _ _), + have hvu : disjoint v u := disjoint_of_subset_right hus hvs, + have hxv : x ∉ v := disjoint_right.1 hvs (mem_insert_self _ _), + have : v \ u = v := ‹disjoint v u›.sdiff_eq_left, + -- The first key part is that `x ∉ u` + have : x ∉ u, + { intro hxu, + obtain ⟨y, hyv, hxy⟩ := huv x hxu, + -- If `x ∈ u`, we can get `y ∈ v` so that `𝒜` is `(u.erase x, v.erase y)`-compressed + apply m y (disjoint_right.1 hsv hyv), + -- and we will use this `y` to contradict `m`, so we would like to show `insert y s ∈ 𝒜`. + -- We do this by showing the below + have : ((insert x s ∪ v) \ u ∪ erase u x) \ erase v y ∈ 𝒜, + { refine sup_sdiff_mem_of_mem_compression (by rwa hxy.eq) _ + (disjoint_of_subset_left (erase_subset _ _) disjoint_sdiff), + rw [union_sdiff_distrib, ‹v \ u = v›], + exact (erase_subset _ _).trans (subset_union_right _ _) }, + -- and then arguing that it's the same + convert this, + rw [sdiff_union_erase_cancel (hus.trans $ subset_union_left _ _) ‹x ∈ u›, erase_union_distrib, + erase_insert ‹x ∉ s›, erase_eq_of_not_mem ‹x ∉ v›, sdiff_erase (mem_union_right _ hyv), + union_sdiff_cancel_right hsv] }, + -- Now that this is done, it's immediate that `u ⊆ s` + have hus : u ⊆ s, + { rwa [←erase_eq_of_not_mem ‹x ∉ u›, ←subset_insert_iff] }, + -- and we already had that `v` and `s` are disjoint, + -- so it only remains to get `(s ∪ v) \ u ∈ ∂ 𝒜 \ ∂ 𝒜'` + simp_rw [mem_shadow_iff_insert_mem], + refine ⟨hus, hsv.symm, ⟨x, _, _⟩, _⟩, + -- `(s ∪ v) \ u ∈ ∂ 𝒜` is pretty direct: + { exact not_mem_sdiff_of_not_mem_left (not_mem_union.2 ⟨‹x ∉ s›, ‹x ∉ v›⟩) }, + { rwa [←insert_sdiff_of_not_mem _ ‹x ∉ u›, ←insert_union] }, + -- For (s ∪ v) \ u ∉ ∂ 𝒜', we split up based on w ∈ u + rintro ⟨w, hwB, hw𝒜'⟩, + have : v ⊆ insert w ((s ∪ v) \ u) := (subset_sdiff.2 ⟨subset_union_right _ _, hvu⟩).trans + (subset_insert _ _), + by_cases hwu : w ∈ u, + -- If `w ∈ u`, we find `z ∈ v`, and contradict `m` again + { obtain ⟨z, hz, hxy⟩ := huv w hwu, + apply m z (disjoint_right.1 hsv hz), + have : insert w ((s ∪ v) \ u) ∈ 𝒜 := mem_of_mem_compression hw𝒜' ‹_› (aux huv), + have : (insert w ((s ∪ v) \ u) ∪ erase u w) \ erase v z ∈ 𝒜, + { refine sup_sdiff_mem_of_mem_compression (by rwa hxy.eq) ((erase_subset _ _).trans ‹_›) _, + rw ←sdiff_erase (mem_union_left _ $ hus hwu), + exact disjoint_sdiff }, + convert this, + rw [insert_union_comm, insert_erase ‹w ∈ u›, sdiff_union_of_subset + (hus.trans $ subset_union_left _ _), sdiff_erase (mem_union_right _ ‹z ∈ v›), + union_sdiff_cancel_right hsv] }, + -- If `w ∉ u`, we contradict `m` again + rw [mem_sdiff, ←not_imp, not_not] at hwB, + apply m w (hwu ∘ hwB ∘ mem_union_left _), + have : (insert w ((s ∪ v) \ u) ∪ u) \ v ∈ 𝒜 := sup_sdiff_mem_of_mem_compression + ‹insert w ((s ∪ v) \ u) ∈ 𝒜'› ‹_› (disjoint_insert_right.2 ⟨‹_›, disjoint_sdiff⟩), + convert this, + rw [insert_union, sdiff_union_of_subset (hus.trans $ subset_union_left _ _), + insert_sdiff_of_not_mem _ (hwu ∘ hwB ∘ mem_union_right _), union_sdiff_cancel_right hsv], +end + +/-- UV-compression reduces the size of the shadow of `𝒜` if, for all `x ∈ u` there is `y ∈ v` +such that `𝒜` is `(u.erase x, v.erase y)`-compressed. This is the key UV-compression fact needed for +Kruskal-Katona. -/ +lemma card_shadow_compression_le (u v : finset α) + (huv : ∀ x ∈ u, ∃ y ∈ v, is_compressed (u.erase x) (v.erase y) 𝒜) : + (∂ (𝓒 u v 𝒜)).card ≤ (∂ 𝒜).card := +(card_le_of_subset $ shadow_compression_subset_compression_shadow _ _ huv).trans + (card_compression _ _ _).le + end uv diff --git a/src/combinatorics/set_family/harris_kleitman.lean b/src/combinatorics/set_family/harris_kleitman.lean new file mode 100644 index 0000000000000..236ffca1e72bf --- /dev/null +++ b/src/combinatorics/set_family/harris_kleitman.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import combinatorics.set_family.compression.down +import order.upper_lower.basic +import data.fintype.big_operators + +/-! +# Harris-Kleitman inequality + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves the Harris-Kleitman inequality. This relates `𝒜.card * ℬ.card` and +`2 ^ card α * (𝒜 ∩ ℬ).card` where `𝒜` and `ℬ` are upward- or downcard-closed finite families of +finsets. This can be interpreted as saying that any two lower sets (resp. any two upper sets) +correlate in the uniform measure. + +## Main declarations + +* `is_lower_set.le_card_inter_finset`: One form of the Harris-Kleitman inequality. + +## References + +* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966] +-/ + +open finset +open_locale big_operators + +variables {α : Type*} [decidable_eq α] {𝒜 ℬ : finset (finset α)} {s : finset α} {a : α} + +lemma is_lower_set.non_member_subfamily (h : is_lower_set (𝒜 : set (finset α))) : + is_lower_set (𝒜.non_member_subfamily a : set (finset α)) := +λ s t hts, by { simp_rw [mem_coe, mem_non_member_subfamily], exact and.imp (h hts) (mt $ @hts _) } + +lemma is_lower_set.member_subfamily (h : is_lower_set (𝒜 : set (finset α))) : + is_lower_set (𝒜.member_subfamily a : set (finset α)) := +begin + rintro s t hts, + simp_rw [mem_coe, mem_member_subfamily], + exact and.imp (h $ insert_subset_insert _ hts) (mt $ @hts _), +end + +lemma is_lower_set.member_subfamily_subset_non_member_subfamily + (h : is_lower_set (𝒜 : set (finset α))) : + 𝒜.member_subfamily a ⊆ 𝒜.non_member_subfamily a := +λ s, by { rw [mem_member_subfamily, mem_non_member_subfamily], + exact and.imp_left (h $ subset_insert _ _) } + +/-- **Harris-Kleitman inequality**: Any two lower sets of finsets correlate. -/ +lemma is_lower_set.le_card_inter_finset' + (h𝒜 : is_lower_set (𝒜 : set (finset α))) (hℬ : is_lower_set (ℬ : set (finset α))) + (h𝒜s : ∀ t ∈ 𝒜, t ⊆ s) (hℬs : ∀ t ∈ ℬ, t ⊆ s) : + 𝒜.card * ℬ.card ≤ 2 ^ s.card * (𝒜 ∩ ℬ).card := +begin + induction s using finset.induction with a s hs ih generalizing 𝒜 ℬ, + { simp_rw [subset_empty, ←subset_singleton_iff', subset_singleton_iff] at h𝒜s hℬs, + obtain rfl | rfl := h𝒜s, + { simp only [card_empty, empty_inter, mul_zero, zero_mul] }, + obtain rfl | rfl := hℬs, + { simp only [card_empty, inter_empty, mul_zero, zero_mul] }, + { simp only [card_empty, pow_zero, inter_singleton_of_mem, mem_singleton, card_singleton] } }, + rw [card_insert_of_not_mem hs, ←card_member_subfamily_add_card_non_member_subfamily a 𝒜, + ←card_member_subfamily_add_card_non_member_subfamily a ℬ, add_mul, mul_add, mul_add, + add_comm (_ * _), add_add_add_comm], + refine (add_le_add_right (mul_add_mul_le_mul_add_mul + (card_le_of_subset h𝒜.member_subfamily_subset_non_member_subfamily) $ + card_le_of_subset hℬ.member_subfamily_subset_non_member_subfamily) _).trans _, + rw [←two_mul, pow_succ, mul_assoc], + have h₀ : ∀ 𝒞 : finset (finset α), (∀ t ∈ 𝒞, t ⊆ insert a s) → ∀ t ∈ 𝒞.non_member_subfamily a, + t ⊆ s, + { rintro 𝒞 h𝒞 t ht, + rw mem_non_member_subfamily at ht, + exact (subset_insert_iff_of_not_mem ht.2).1 (h𝒞 _ ht.1) }, + have h₁ : ∀ 𝒞 : finset (finset α), (∀ t ∈ 𝒞, t ⊆ insert a s) → ∀ t ∈ 𝒞.member_subfamily a, t ⊆ s, + { rintro 𝒞 h𝒞 t ht, + rw mem_member_subfamily at ht, + exact (subset_insert_iff_of_not_mem ht.2).1 ((subset_insert _ _).trans $ h𝒞 _ ht.1) }, + refine mul_le_mul_left' _ _, + refine (add_le_add (ih (h𝒜.member_subfamily) (hℬ.member_subfamily) (h₁ _ h𝒜s) $ h₁ _ hℬs) $ + ih (h𝒜.non_member_subfamily) (hℬ.non_member_subfamily) (h₀ _ h𝒜s) $ h₀ _ hℬs).trans_eq _, + rw [←mul_add, ←member_subfamily_inter, ←non_member_subfamily_inter, + card_member_subfamily_add_card_non_member_subfamily], +end + +variables [fintype α] + +/-- **Harris-Kleitman inequality**: Any two lower sets of finsets correlate. -/ +lemma is_lower_set.le_card_inter_finset + (h𝒜 : is_lower_set (𝒜 : set (finset α))) (hℬ : is_lower_set (ℬ : set (finset α))) : + 𝒜.card * ℬ.card ≤ 2 ^ fintype.card α * (𝒜 ∩ ℬ).card := +h𝒜.le_card_inter_finset' hℬ (λ _ _, subset_univ _) $ λ _ _, subset_univ _ + +/-- **Harris-Kleitman inequality**: Upper sets and lower sets of finsets anticorrelate. -/ +lemma is_upper_set.card_inter_le_finset + (h𝒜 : is_upper_set (𝒜 : set (finset α))) (hℬ : is_lower_set (ℬ : set (finset α))) : + 2 ^ fintype.card α * (𝒜 ∩ ℬ).card ≤ 𝒜.card * ℬ.card := +begin + rw [←is_lower_set_compl, ←coe_compl] at h𝒜, + have := h𝒜.le_card_inter_finset hℬ, + rwa [card_compl, fintype.card_finset, tsub_mul, tsub_le_iff_tsub_le, ←mul_tsub, ←card_sdiff + (inter_subset_right _ _), sdiff_inter_self_right, sdiff_compl, _root_.inf_comm] at this, +end + +/-- **Harris-Kleitman inequality**: Lower sets and upper sets of finsets anticorrelate. -/ +lemma is_lower_set.card_inter_le_finset + (h𝒜 : is_lower_set (𝒜 : set (finset α))) (hℬ : is_upper_set (ℬ : set (finset α))) : + 2 ^ fintype.card α * (𝒜 ∩ ℬ).card ≤ 𝒜.card * ℬ.card := +by { rw [inter_comm, mul_comm 𝒜.card], exact hℬ.card_inter_le_finset h𝒜 } + +/-- **Harris-Kleitman inequality**: Any two upper sets of finsets correlate. -/ +lemma is_upper_set.le_card_inter_finset + (h𝒜 : is_upper_set (𝒜 : set (finset α))) (hℬ : is_upper_set (ℬ : set (finset α))) : + 𝒜.card * ℬ.card ≤ 2 ^ fintype.card α * (𝒜 ∩ ℬ).card := +begin + rw [←is_lower_set_compl, ←coe_compl] at h𝒜, + have := h𝒜.card_inter_le_finset hℬ, + rwa [card_compl, fintype.card_finset, tsub_mul, le_tsub_iff_le_tsub, ←mul_tsub, ←card_sdiff + (inter_subset_right _ _), sdiff_inter_self_right, sdiff_compl, _root_.inf_comm] at this, + { exact mul_le_mul_left' (card_le_of_subset $ inter_subset_right _ _) _ }, + { rw ←fintype.card_finset, + exact mul_le_mul_right' (card_le_univ _) _ } +end diff --git a/src/combinatorics/set_family/intersecting.lean b/src/combinatorics/set_family/intersecting.lean new file mode 100644 index 0000000000000..b143e00a342b0 --- /dev/null +++ b/src/combinatorics/set_family/intersecting.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.fintype.card +import order.upper_lower.basic + +/-! +# Intersecting families + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines intersecting families and proves their basic properties. + +## Main declarations + +* `set.intersecting`: Predicate for a set of elements in a generalized boolean algebra to be an + intersecting family. +* `set.intersecting.card_le`: An intersecting family can only take up to half the elements, because + `a` and `aᶜ` cannot simultaneously be in it. +* `set.intersecting.is_max_iff_card_eq`: Any maximal intersecting family takes up half the elements. + +## References + +* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966] +-/ + +open finset + +variables {α : Type*} + +namespace set +section semilattice_inf +variables [semilattice_inf α] [order_bot α] {s t : set α} {a b c : α} + +/-- A set family is intersecting if every pair of elements is non-disjoint. -/ +def intersecting (s : set α) : Prop := ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → ¬ disjoint a b + +@[mono] lemma intersecting.mono (h : t ⊆ s) (hs : s.intersecting) : t.intersecting := +λ a ha b hb, hs (h ha) (h hb) + +lemma intersecting.not_bot_mem (hs : s.intersecting) : ⊥ ∉ s := λ h, hs h h disjoint_bot_left + +lemma intersecting.ne_bot (hs : s.intersecting) (ha : a ∈ s) : a ≠ ⊥ := +ne_of_mem_of_not_mem ha hs.not_bot_mem + +lemma intersecting_empty : (∅ : set α).intersecting := λ _, false.elim + +@[simp] lemma intersecting_singleton : ({a} : set α).intersecting ↔ a ≠ ⊥ := by simp [intersecting] + +lemma intersecting.insert (hs : s.intersecting) (ha : a ≠ ⊥) (h : ∀ b ∈ s, ¬ disjoint a b) : + (insert a s).intersecting := +begin + rintro b (rfl | hb) c (rfl | hc), + { rwa disjoint_self }, + { exact h _ hc }, + { exact λ H, h _ hb H.symm }, + { exact hs hb hc } +end + +lemma intersecting_insert : + (insert a s).intersecting ↔ s.intersecting ∧ a ≠ ⊥ ∧ ∀ b ∈ s, ¬ disjoint a b := +⟨λ h, ⟨h.mono $ subset_insert _ _, h.ne_bot $ mem_insert _ _, + λ b hb, h (mem_insert _ _) $ mem_insert_of_mem _ hb⟩, λ h, h.1.insert h.2.1 h.2.2⟩ + +lemma intersecting_iff_pairwise_not_disjoint : + s.intersecting ↔ s.pairwise (λ a b, ¬ disjoint a b) ∧ s ≠ {⊥} := +begin + refine ⟨λ h, ⟨λ a ha b hb _, h ha hb, _⟩, λ h a ha b hb hab, _⟩, + { rintro rfl, + exact intersecting_singleton.1 h rfl }, + { have := h.1.eq ha hb (not_not.2 hab), + rw [this, disjoint_self] at hab, + rw hab at hb, + exact h.2 (eq_singleton_iff_unique_mem.2 + ⟨hb, λ c hc, not_ne_iff.1 $ λ H, h.1 hb hc H.symm disjoint_bot_left⟩) } +end + +protected lemma subsingleton.intersecting (hs : s.subsingleton) : s.intersecting ↔ s ≠ {⊥} := +intersecting_iff_pairwise_not_disjoint.trans $ and_iff_right $ hs.pairwise _ + +lemma intersecting_iff_eq_empty_of_subsingleton [subsingleton α] (s : set α) : + s.intersecting ↔ s = ∅ := +begin + refine subsingleton_of_subsingleton.intersecting.trans + ⟨not_imp_comm.2 $ λ h, subsingleton_of_subsingleton.eq_singleton_of_mem _, _⟩, + { obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h, + rwa subsingleton.elim ⊥ a }, + { rintro rfl, + exact (set.singleton_nonempty _).ne_empty.symm } +end + +/-- Maximal intersecting families are upper sets. -/ +protected lemma intersecting.is_upper_set (hs : s.intersecting) + (h : ∀ t : set α, t.intersecting → s ⊆ t → s = t) : + is_upper_set s := +begin + classical, + rintro a b hab ha, + rw h (insert b s) _ (subset_insert _ _), + { exact mem_insert _ _ }, + exact hs.insert (mt (eq_bot_mono hab) $ hs.ne_bot ha) + (λ c hc hbc, hs ha hc $ hbc.mono_left hab), +end + +/-- Maximal intersecting families are upper sets. Finset version. -/ +lemma intersecting.is_upper_set' {s : finset α} (hs : (s : set α).intersecting) + (h : ∀ t : finset α, (t : set α).intersecting → s ⊆ t → s = t) : + is_upper_set (s : set α) := +begin + classical, + rintro a b hab ha, + rw h (insert b s) _ (finset.subset_insert _ _), + { exact mem_insert_self _ _ }, + rw coe_insert, + exact hs.insert (mt (eq_bot_mono hab) $ hs.ne_bot ha) + (λ c hc hbc, hs ha hc $ hbc.mono_left hab), +end + +end semilattice_inf + +lemma intersecting.exists_mem_set {𝒜 : set (set α)} (h𝒜 : 𝒜.intersecting) {s t : set α} + (hs : s ∈ 𝒜) (ht : t ∈ 𝒜) : ∃ a, a ∈ s ∧ a ∈ t := +not_disjoint_iff.1 $ h𝒜 hs ht + +lemma intersecting.exists_mem_finset [decidable_eq α] {𝒜 : set (finset α)} (h𝒜 : 𝒜.intersecting) + {s t : finset α} (hs : s ∈ 𝒜) (ht : t ∈ 𝒜) : ∃ a, a ∈ s ∧ a ∈ t := +not_disjoint_iff.1 $ disjoint_coe.not.2 $ h𝒜 hs ht + +variables [boolean_algebra α] + +lemma intersecting.not_compl_mem {s : set α} (hs : s.intersecting) {a : α} (ha : a ∈ s) : aᶜ ∉ s := +λ h, hs ha h disjoint_compl_right + +lemma intersecting.not_mem {s : set α} (hs : s.intersecting) {a : α} (ha : aᶜ ∈ s) : a ∉ s := +λ h, hs ha h disjoint_compl_left + +lemma intersecting.disjoint_map_compl {s : finset α} + (hs : (s : set α).intersecting) : + disjoint s (s.map ⟨compl, compl_injective⟩) := +begin + rw finset.disjoint_left, + rintro x hx hxc, + obtain ⟨x, hx', rfl⟩ := mem_map.mp hxc, + exact hs.not_compl_mem hx' hx, +end + +lemma intersecting.card_le [fintype α] {s : finset α} + (hs : (s : set α).intersecting) : 2 * s.card ≤ fintype.card α := +begin + classical, + refine (s.disj_union _ hs.disjoint_map_compl).card_le_univ.trans_eq' _, + rw [two_mul, card_disj_union, card_map], +end + +variables [nontrivial α] [fintype α] {s : finset α} + +-- Note, this lemma is false when `α` has exactly one element and boring when `α` is empty. +lemma intersecting.is_max_iff_card_eq (hs : (s : set α).intersecting) : + (∀ t : finset α, (t : set α).intersecting → s ⊆ t → s = t) ↔ 2 * s.card = fintype.card α := +begin + classical, + refine ⟨λ h, _, λ h t ht hst, finset.eq_of_subset_of_card_le hst $ + le_of_mul_le_mul_left (ht.card_le.trans_eq h.symm) two_pos⟩, + suffices : s.disj_union (s.map ⟨compl, compl_injective⟩) (hs.disjoint_map_compl) = finset.univ, + { rw [fintype.card, ←this, two_mul, card_disj_union, card_map] }, + rw [←coe_eq_univ, disj_union_eq_union, coe_union, coe_map, function.embedding.coe_fn_mk, + image_eq_preimage_of_inverse compl_compl compl_compl], + refine eq_univ_of_forall (λ a, _), + simp_rw [mem_union, mem_preimage], + by_contra' ha, + refine s.ne_insert_of_not_mem _ ha.1 (h _ _ $ s.subset_insert _), + rw coe_insert, + refine hs.insert _ (λ b hb hab, ha.2 $ (hs.is_upper_set' h) hab.le_compl_left hb), + rintro rfl, + have := h {⊤} (by { rw coe_singleton, exact intersecting_singleton.2 top_ne_bot }), + rw compl_bot at ha, + rw coe_eq_empty.1 ((hs.is_upper_set' h).not_top_mem.1 ha.2) at this, + exact finset.singleton_ne_empty _ (this $ empty_subset _).symm, +end + +lemma intersecting.exists_card_eq (hs : (s : set α).intersecting) : + ∃ t, s ⊆ t ∧ 2 * t.card = fintype.card α ∧ (t : set α).intersecting := +begin + have := hs.card_le, + rw [mul_comm, ←nat.le_div_iff_mul_le' two_pos] at this, + revert hs, + refine s.strong_downward_induction_on _ this, + rintro s ih hcard hs, + by_cases ∀ t : finset α, (t : set α).intersecting → s ⊆ t → s = t, + { exact ⟨s, subset.rfl, hs.is_max_iff_card_eq.1 h, hs⟩ }, + push_neg at h, + obtain ⟨t, ht, hst⟩ := h, + refine (ih _ (_root_.ssubset_iff_subset_ne.2 hst) ht).imp (λ u, and.imp_left hst.1.trans), + rw [nat.le_div_iff_mul_le' two_pos, mul_comm], + exact ht.card_le, +end + +end set diff --git a/src/combinatorics/set_family/kleitman.lean b/src/combinatorics/set_family/kleitman.lean new file mode 100644 index 0000000000000..4d1edd2943526 --- /dev/null +++ b/src/combinatorics/set_family/kleitman.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import combinatorics.set_family.harris_kleitman +import combinatorics.set_family.intersecting + +/-! +# Kleitman's bound on the size of intersecting families + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +An intersecting family on `n` elements has size at most `2ⁿ⁻¹`, so we could naïvely think that two +intersecting families could cover all `2ⁿ` sets. But actually that's not case because for example +none of them can contain the empty set. Intersecting families are in some sense correlated. +Kleitman's bound stipulates that `k` intersecting families cover at most `2ⁿ - 2ⁿ⁻ᵏ` sets. + +## Main declarations + +* `finset.card_bUnion_le_of_intersecting`: Kleitman's theorem. + +## References + +* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966] +-/ + +open finset fintype (card) + +variables {ι α : Type*} [fintype α] [decidable_eq α] [nonempty α] + +/-- **Kleitman's theorem**. An intersecting family on `n` elements contains at most `2ⁿ⁻¹` sets, and +each further intersecting family takes at most half of the sets that are in no previous family. -/ +lemma finset.card_bUnion_le_of_intersecting (s : finset ι) (f : ι → finset (finset α)) + (hf : ∀ i ∈ s, (f i : set (finset α)).intersecting) : + (s.bUnion f).card ≤ 2 ^ card α - 2 ^ (card α - s.card) := +begin + obtain hs | hs := le_total (card α) s.card, + { rw [tsub_eq_zero_of_le hs, pow_zero], + refine (card_le_of_subset $ bUnion_subset.2 $ λ i hi a ha, mem_compl.2 $ not_mem_singleton.2 $ + (hf _ hi).ne_bot ha).trans_eq _, + rw [card_compl, fintype.card_finset, card_singleton] }, + induction s using finset.cons_induction with i s hi ih generalizing f, + { simp }, + classical, + set f' : ι → finset (finset α) := λ j, + if hj : j ∈ cons i s hi then (hf j hj).exists_card_eq.some else ∅ with hf', + have hf₁ : ∀ j, j ∈ cons i s hi → + f j ⊆ f' j ∧ 2 * (f' j).card = 2 ^ card α ∧ (f' j : set (finset α)).intersecting, + { rintro j hj, + simp_rw [hf', dif_pos hj, ←fintype.card_finset], + exact classical.some_spec (hf j hj).exists_card_eq }, + have hf₂ : ∀ j, j ∈ cons i s hi → is_upper_set (f' j : set (finset α)), + { refine λ j hj, (hf₁ _ hj).2.2.is_upper_set' ((hf₁ _ hj).2.2.is_max_iff_card_eq.2 _), + rw fintype.card_finset, + exact (hf₁ _ hj).2.1 }, + refine (card_le_of_subset $ bUnion_mono $ λ j hj, (hf₁ _ hj).1).trans _, + nth_rewrite 0 cons_eq_insert i, + rw bUnion_insert, + refine (card_mono $ @le_sup_sdiff _ _ _ $ f' i).trans ((card_union_le _ _).trans _), + rw [union_sdiff_left, sdiff_eq_inter_compl], + refine le_of_mul_le_mul_left _ (pow_pos zero_lt_two $ card α + 1), + rw [pow_succ', mul_add, mul_assoc, mul_comm _ 2, mul_assoc], + refine (add_le_add ((mul_le_mul_left $ pow_pos (zero_lt_two' ℕ) _).2 + (hf₁ _ $ mem_cons_self _ _).2.2.card_le) $ (mul_le_mul_left $ zero_lt_two' ℕ).2 $ + is_upper_set.card_inter_le_finset _ _).trans _, + { rw coe_bUnion, + exact is_upper_set_Union₂ (λ i hi, hf₂ _ $ subset_cons _ hi) }, + { rw coe_compl, + exact (hf₂ _ $ mem_cons_self _ _).compl }, + rw [mul_tsub, card_compl, fintype.card_finset, mul_left_comm, mul_tsub, + (hf₁ _ $ mem_cons_self _ _).2.1, two_mul, add_tsub_cancel_left, ←mul_tsub, ←mul_two, mul_assoc, + ←add_mul, mul_comm], + refine mul_le_mul_left' _ _, + refine (add_le_add_left (ih ((card_le_of_subset $ subset_cons _).trans hs) _ $ λ i hi, + (hf₁ _ $ subset_cons _ hi).2.2) _).trans _, + rw [mul_tsub, two_mul, ←pow_succ, ←add_tsub_assoc_of_le (pow_le_pow' (one_le_two : (1 : ℕ) ≤ 2) + tsub_le_self), tsub_add_eq_add_tsub hs, card_cons, add_tsub_add_eq_tsub_right], +end diff --git a/src/combinatorics/set_family/lym.lean b/src/combinatorics/set_family/lym.lean index 524adeccc4f93..8d47f70ced332 100644 --- a/src/combinatorics/set_family/lym.lean +++ b/src/combinatorics/set_family/lym.lean @@ -4,14 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies -/ import algebra.big_operators.ring +import algebra.order.field.basic import combinatorics.double_counting import combinatorics.set_family.shadow import data.rat.order -import tactic.linarith /-! # Lubell-Yamamoto-Meshalkin inequality and Sperner's theorem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves the local LYM and LYM inequalities as well as Sperner's theorem. ## Main declarations @@ -141,7 +144,7 @@ begin { rintro ⟨⟨t, ht, hst⟩, hs⟩, by_cases s ∈ 𝒜, { exact or.inl ⟨h, hs⟩ }, - obtain ⟨a, ha, hst⟩ := ssubset_iff_exists_insert_subset.1 + obtain ⟨a, ha, hst⟩ := ssubset_iff.1 (ssubset_of_subset_of_ne hst (ht.ne_of_not_mem h).symm), refine or.inr ⟨insert a s, ⟨⟨t, ht, hst⟩, _⟩, a, mem_insert_self _ _, erase_insert ha⟩, rw [card_insert_of_not_mem ha, hs] } @@ -216,7 +219,7 @@ begin { rwa [←sum_div, ←nat.cast_sum, div_le_one, cast_le, sum_card_slice] at this, norm_cast, exact choose_pos (nat.div_le_self _ _) }, - rw [Iic, ←Ico_succ_right, bot_eq_zero, Ico_zero_eq_range], + rw [Iic_eq_Icc, ←Ico_succ_right, bot_eq_zero, Ico_zero_eq_range], refine (sum_le_sum $ λ r hr, _).trans (sum_card_slice_div_choose_le_one h𝒜), rw mem_range at hr, refine div_le_div_of_le_left _ _ _; norm_cast, diff --git a/src/combinatorics/set_family/shadow.lean b/src/combinatorics/set_family/shadow.lean index d08ac501c6671..f02c1165296ea 100644 --- a/src/combinatorics/set_family/shadow.lean +++ b/src/combinatorics/set_family/shadow.lean @@ -9,6 +9,9 @@ import logic.function.iterate /-! # Shadows +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines shadows of a set family. The shadow of a set family is the set family of sets we get by removing any element from any set of the original family. If one pictures `finset α` as a big hypercube (each dimension being membership of a given element), then taking the shadow corresponds @@ -53,7 +56,7 @@ variables [decidable_eq α] {𝒜 : finset (finset α)} {s t : finset α} {a : elements from any set in `𝒜`. -/ def shadow (𝒜 : finset (finset α)) : finset (finset α) := 𝒜.sup (λ s, s.image (erase s)) -localized "notation `∂ `:90 := finset.shadow" in finset_family +localized "notation (name := finset.shadow) `∂ `:90 := finset.shadow" in finset_family /-- The shadow of the empty set is empty. -/ @[simp] lemma shadow_empty : ∂ (∅ : finset (finset α)) = ∅ := rfl @@ -160,7 +163,7 @@ variables [decidable_eq α] [fintype α] {𝒜 : finset (finset α)} {s t : fins def up_shadow (𝒜 : finset (finset α)) : finset (finset α) := 𝒜.sup $ λ s, sᶜ.image $ λ a, insert a s -localized "notation `∂⁺ `:90 := finset.up_shadow" in finset_family +localized "notation (name := finset.up_shadow) `∂⁺ `:90 := finset.up_shadow" in finset_family /-- The upper shadow of the empty set is empty. -/ @[simp] lemma up_shadow_empty : ∂⁺ (∅ : finset (finset α)) = ∅ := rfl diff --git a/src/combinatorics/simple_graph/acyclic.lean b/src/combinatorics/simple_graph/acyclic.lean new file mode 100644 index 0000000000000..5324b67ef9476 --- /dev/null +++ b/src/combinatorics/simple_graph/acyclic.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import combinatorics.simple_graph.connectivity +/-! + +# Acyclic graphs and trees + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This module introduces *acyclic graphs* (a.k.a. *forests*) and *trees*. + +## Main definitions + +* `simple_graph.is_acyclic` is a predicate for a graph having no cyclic walks +* `simple_graph.is_tree` is a predicate for a graph being a tree (a connected acyclic graph) + +## Main statements + +* `simple_graph.is_acyclic_iff_path_unique` characterizes acyclicity in terms of uniqueness of + paths between pairs of vertices. +* `simple_graph.is_acyclic_iff_forall_edge_is_bridge` characterizes acyclicity in terms of every + edge being a bridge edge. +* `simple_graph.is_tree_iff_exists_unique_path` characterizes trees in terms of existence and + uniqueness of paths between pairs of vertices from a nonempty vertex type. + +## References + +The structure of the proofs for `simple_graph.is_acyclic` and `simple_graph.is_tree`, including +supporting lemmas about `simple_graph.is_bridge`, generally follows the high-level description +for these theorems for multigraphs from [Chou1994]. + +## Tags + +acyclic graphs, trees +-/ + +universes u v + +namespace simple_graph +variables {V : Type u} (G : simple_graph V) + +/-- A graph is *acyclic* (or a *forest*) if it has no cycles. -/ +def is_acyclic : Prop := ∀ (v : V) (c : G.walk v v), ¬c.is_cycle + +/-- A *tree* is a connected acyclic graph. -/ +@[mk_iff, protect_proj] structure is_tree : Prop := +(is_connected : G.connected) +(is_acyclic : G.is_acyclic) + +variables {G} + +lemma is_acyclic_iff_forall_adj_is_bridge : + G.is_acyclic ↔ ∀ ⦃v w : V⦄, G.adj v w → G.is_bridge ⟦(v, w)⟧ := +begin + simp_rw [is_bridge_iff_adj_and_forall_cycle_not_mem], + split, + { intros ha v w hvw, + apply and.intro hvw, + intros u p hp, + exact absurd hp (ha _ p), }, + { rintros hb v (_ | @⟨_, _, _, ha, p⟩) hp, + { exact hp.not_of_nil }, + { specialize hb ha, + apply hb.2 _ hp, + rw [walk.edges_cons], + apply list.mem_cons_self } }, +end + +lemma is_acyclic_iff_forall_edge_is_bridge : + G.is_acyclic ↔ ∀ ⦃e⦄, e ∈ G.edge_set → G.is_bridge e := +by simp [is_acyclic_iff_forall_adj_is_bridge, sym2.forall] + +lemma is_acyclic.path_unique {G : simple_graph V} (h : G.is_acyclic) {v w : V} (p q : G.path v w) : + p = q := +begin + obtain ⟨p, hp⟩ := p, + obtain ⟨q, hq⟩ := q, + simp only, + induction p with u pu pv pw ph p ih generalizing q, + { rw walk.is_path_iff_eq_nil at hq, + exact hq.symm, }, + { rw is_acyclic_iff_forall_adj_is_bridge at h, + specialize h ph, + rw is_bridge_iff_adj_and_forall_walk_mem_edges at h, + replace h := h.2 (q.append p.reverse), + simp only [walk.edges_append, walk.edges_reverse, list.mem_append, list.mem_reverse] at h, + cases h, + { cases q, + { simpa [walk.is_path_def] using hp }, + { rw walk.cons_is_path_iff at hp hq, + simp only [walk.edges_cons, list.mem_cons_iff, sym2.eq_iff] at h, + obtain (⟨h,rfl⟩ | ⟨rfl,rfl⟩) | h := h, + { rw [ih hp.1 _ hq.1] }, + { simpa using hq }, + { exact absurd (walk.fst_mem_support_of_mem_edges _ h) hq.2 } } }, + { rw walk.cons_is_path_iff at hp, + exact absurd (walk.fst_mem_support_of_mem_edges _ h) hp.2 } } +end + +lemma is_acyclic_of_path_unique (h : ∀ (v w : V) (p q : G.path v w), p = q) : G.is_acyclic := +begin + intros v c hc, + simp only [walk.is_cycle_def, ne.def] at hc, + cases c, + { exact absurd rfl hc.2.1 }, + { simp only [walk.cons_is_trail_iff, not_false_iff, walk.support_cons, + list.tail_cons, true_and] at hc, + specialize h _ _ ⟨c_p, by simp only [walk.is_path_def, hc.2]⟩ (path.singleton (G.symm c_h)), + simp only [path.singleton] at h, + simpa [-quotient.eq, sym2.eq_swap, h] using hc }, +end + +lemma is_acyclic_iff_path_unique : G.is_acyclic ↔ ∀ ⦃v w : V⦄ (p q : G.path v w), p = q := +⟨is_acyclic.path_unique, is_acyclic_of_path_unique⟩ + +lemma is_tree_iff_exists_unique_path : + G.is_tree ↔ nonempty V ∧ ∀ (v w : V), ∃! (p : G.walk v w), p.is_path := +begin + classical, + rw [is_tree_iff, is_acyclic_iff_path_unique], + split, + { rintro ⟨hc, hu⟩, + refine ⟨hc.nonempty, _⟩, + intros v w, + let q := (hc v w).some.to_path, + use q, + simp only [true_and, path.is_path], + intros p hp, + specialize hu ⟨p, hp⟩ q, + exact subtype.ext_iff.mp hu, }, + { unfreezingI { rintro ⟨hV, h⟩ }, + refine ⟨connected.mk _, _⟩, + { intros v w, + obtain ⟨p, hp⟩ := h v w, + exact p.reachable, }, + { rintros v w ⟨p, hp⟩ ⟨q, hq⟩, + simp only [unique_of_exists_unique (h v w) hp hq] } }, +end + +end simple_graph diff --git a/src/combinatorics/simple_graph/adj_matrix.lean b/src/combinatorics/simple_graph/adj_matrix.lean index 7ffea9676d53c..fa1cde99ecd1d 100644 --- a/src/combinatorics/simple_graph/adj_matrix.lean +++ b/src/combinatorics/simple_graph/adj_matrix.lean @@ -5,13 +5,15 @@ Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Lu-Ming Zhang -/ import combinatorics.simple_graph.basic import combinatorics.simple_graph.connectivity -import data.rel import linear_algebra.matrix.trace import linear_algebra.matrix.symmetric /-! # Adjacency Matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines the adjacency matrix of a graph, and provides theorems connecting graph properties to computational properties of the matrix. @@ -149,11 +151,12 @@ variables (α) /-- `adj_matrix G α` is the matrix `A` such that `A i j = (1 : α)` if `i` and `j` are adjacent in the simple graph `G`, and otherwise `A i j = 0`. -/ -def adj_matrix [has_zero α] [has_one α] : matrix V V α -| i j := if (G.adj i j) then 1 else 0 +def adj_matrix [has_zero α] [has_one α] : matrix V V α := +of $ λ i j, if (G.adj i j) then (1 : α) else 0 variable {α} +-- TODO: set as an equation lemma for `adj_matrix`, see mathlib4#3024 @[simp] lemma adj_matrix_apply (v w : V) [has_zero α] [has_one α] : G.adj_matrix α v w = if (G.adj v w) then 1 else 0 := rfl @@ -255,19 +258,16 @@ begin simp only [pow_add, pow_one, finset_walk_length, ih, mul_eq_mul, adj_matrix_mul_apply], rw finset.card_bUnion, { norm_cast, - rw set.sum_indicator_subset _ (subset_univ (G.neighbor_finset u)), - congr' 2, - ext x, - split_ifs with hux; simp [hux], }, + simp only [nat.cast_sum, card_map, neighbor_finset_def], + apply finset.sum_to_finset_eq_subtype, }, /- Disjointness for card_bUnion -/ - { intros x hx y hy hxy p hp, - split_ifs at hp with hx hy; - simp only [inf_eq_inter, empty_inter, inter_empty, not_mem_empty, mem_inter, mem_map, - function.embedding.coe_fn_mk, exists_prop] at hp; - try { simpa using hp }, - obtain ⟨⟨qx, hql, hqp⟩, ⟨rx, hrl, hrp⟩⟩ := hp, - unify_equations hqp hrp, - exact absurd rfl hxy, } }, + { rintros ⟨x, hx⟩ - ⟨y, hy⟩ - hxy, + rw disjoint_iff_inf_le, + intros p hp, + simp only [inf_eq_inter, mem_inter, mem_map, function.embedding.coe_fn_mk, exists_prop] at hp; + obtain ⟨⟨px, hpx, rfl⟩, ⟨py, hpy, hp⟩⟩ := hp, + cases hp, + simpa using hxy, } }, end end simple_graph diff --git a/src/combinatorics/simple_graph/basic.lean b/src/combinatorics/simple_graph/basic.lean index 9934190429130..0b1d706d9e560 100644 --- a/src/combinatorics/simple_graph/basic.lean +++ b/src/combinatorics/simple_graph/basic.lean @@ -3,6 +3,7 @@ Copyright (c) 2020 Aaron Anderson, Jalex Stark, Kyle Miller. All rights reserved Released under Apache 2.0 license as described in the file LICENSE. Authors: Aaron Anderson, Jalex Stark, Kyle Miller, Alena Gusakov, Hunter Monroe -/ +import data.fun_like.fintype import data.rel import data.set.finite import data.sym.sym2 @@ -10,6 +11,9 @@ import data.sym.sym2 /-! # Simple graphs +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines simple graphs on a vertex type `V` as an irreflexive symmetric relation. @@ -40,8 +44,9 @@ finitely many vertices. graph isomorphisms. Note that a graph embedding is a stronger notion than an injective graph homomorphism, since its image is an induced subgraph. -* `boolean_algebra` instance: Under the subgraph relation, `simple_graph` forms a `boolean_algebra`. - In other words, this is the lattice of spanning subgraphs of the complete graph. +* `complete_boolean_algebra` instance: Under the subgraph relation, `simple_graph` forms a + `complete_boolean_algebra`. In other words, this is the complete lattice of spanning subgraphs of + the complete graph. ## Notations @@ -65,15 +70,15 @@ finitely many vertices. ## Todo -* Upgrade `simple_graph.boolean_algebra` to a `complete_boolean_algebra`. - * This is the simplest notion of an unoriented graph. This should eventually fit into a more complete combinatorics hierarchy which includes multigraphs and directed graphs. We begin with simple graphs in order to start learning what the combinatorics hierarchy should look like. -/ -open finset + +open finset function + universes u v w /-- @@ -133,9 +138,8 @@ def complete_bipartite_graph (V W : Type*) : simple_graph (V ⊕ W) := end } namespace simple_graph - -variables {V : Type u} {W : Type v} {X : Type w} (G : simple_graph V) (G' : simple_graph W) - {a b c u v w : V} {e : sym2 V} +variables {ι : Sort*} {𝕜 : Type*} {V : Type u} {W : Type v} {X : Type w} (G : simple_graph V) + (G' : simple_graph W) {a b c u v w : V} {e : sym2 V} @[simp] protected lemma irrefl {v : V} : ¬G.adj v v := G.loopless v @@ -154,6 +158,11 @@ protected lemma adj.ne' {G : simple_graph V} {a b : V} (h : G.adj a b) : b ≠ a lemma ne_of_adj_of_not_adj {v w x : V} (h : G.adj v x) (hn : ¬ G.adj w x) : v ≠ w := λ h', hn (h' ▸ h) +lemma adj_injective : injective (adj : simple_graph V → V → V → Prop) := +λ G H h, by { cases G, cases H, congr' } + +@[simp] lemma adj_inj {G H : simple_graph V} : G.adj = H.adj ↔ G = H := adj_injective.eq_iff + section order /-- The relation that one `simple_graph` is a subgraph of another. @@ -201,7 +210,44 @@ instance : has_sdiff (simple_graph V) := ⟨λ x y, @[simp] lemma sdiff_adj (x y : simple_graph V) (v w : V) : (x \ y).adj v w ↔ (x.adj v w ∧ ¬ y.adj v w) := iff.rfl -instance : boolean_algebra (simple_graph V) := +instance : has_Sup (simple_graph V) := +⟨λ s, { adj := λ a b, ∃ G ∈ s, adj G a b, + symm := λ a b, Exists₂.imp $ λ _ _, adj.symm, + loopless := by { rintro a ⟨G, hG, ha⟩, exact ha.ne rfl } }⟩ + +instance : has_Inf (simple_graph V) := +⟨λ s, { adj := λ a b, (∀ ⦃G⦄, G ∈ s → adj G a b) ∧ a ≠ b, + symm := λ _ _, and.imp (forall₂_imp $ λ _ _, adj.symm) ne.symm, + loopless := λ a h, h.2 rfl }⟩ + +@[simp] lemma Sup_adj {s : set (simple_graph V)} {a b : V} : (Sup s).adj a b ↔ ∃ G ∈ s, adj G a b := +iff.rfl + +@[simp] lemma Inf_adj {s : set (simple_graph V)} : (Inf s).adj a b ↔ (∀ G ∈ s, adj G a b) ∧ a ≠ b := +iff.rfl + +@[simp] lemma supr_adj {f : ι → simple_graph V} : (⨆ i, f i).adj a b ↔ ∃ i, (f i).adj a b := +by simp [supr] + +@[simp] lemma infi_adj {f : ι → simple_graph V} : + (⨅ i, f i).adj a b ↔ (∀ i, (f i).adj a b) ∧ a ≠ b := +by simp [infi] + +lemma Inf_adj_of_nonempty {s : set (simple_graph V)} (hs : s.nonempty) : + (Inf s).adj a b ↔ ∀ G ∈ s, adj G a b := +Inf_adj.trans $ and_iff_left_of_imp $ by { obtain ⟨G, hG⟩ := hs, exact λ h, (h _ hG).ne } + +lemma infi_adj_of_nonempty [nonempty ι] {f : ι → simple_graph V} : + (⨅ i, f i).adj a b ↔ ∀ i, (f i).adj a b := +by simp [infi, Inf_adj_of_nonempty (set.range_nonempty _)] + +/-- For graphs `G`, `H`, `G ≤ H` iff `∀ a b, G.adj a b → H.adj a b`. -/ +instance : distrib_lattice (simple_graph V) := +{ le := λ G H, ∀ ⦃a b⦄, G.adj a b → H.adj a b, + ..show distrib_lattice (simple_graph V), + from adj_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl) } + +instance : complete_boolean_algebra (simple_graph V) := { le := (≤), sup := (⊔), inf := (⊓), @@ -211,23 +257,27 @@ instance : boolean_algebra (simple_graph V) := bot := empty_graph V, le_top := λ x v w h, x.ne_of_adj h, bot_le := λ x v w h, h.elim, - sup_le := λ x y z hxy hyz v w h, h.cases_on (λ h, hxy h) (λ h, hyz h), sdiff_eq := λ x y, by { ext v w, refine ⟨λ h, ⟨h.1, ⟨_, h.2⟩⟩, λ h, ⟨h.1, h.2.2⟩⟩, rintro rfl, exact x.irrefl h.1 }, - sup_inf_sdiff := λ a b, by { ext v w, refine ⟨λ h, _, λ h', _⟩, - obtain ⟨ha, _⟩|⟨ha, _⟩ := h; exact ha, - by_cases b.adj v w; exact or.inl ⟨h', h⟩ <|> exact or.inr ⟨h', h⟩ }, - inf_inf_sdiff := λ a b, by { ext v w, exact ⟨λ ⟨⟨_, hb⟩,⟨_, hb'⟩⟩, hb' hb, λ h, h.elim⟩ }, - le_sup_left := λ x y v w h, or.inl h, - le_sup_right := λ x y v w h, or.inr h, - le_inf := λ x y z hxy hyz v w h, ⟨hxy h, hyz h⟩, - le_sup_inf := λ a b c v w h, or.dcases_on h.2 or.inl $ - or.dcases_on h.1 (λ h _, or.inl h) $ λ hb hc, or.inr ⟨hb, hc⟩, inf_compl_le_bot := λ a v w h, false.elim $ h.2.2 h.1, top_le_sup_compl := λ a v w ne, by { by_cases a.adj v w, exact or.inl h, exact or.inr ⟨ne, h⟩ }, - inf_le_left := λ x y v w h, h.1, - inf_le_right := λ x y v w h, h.2, - .. partial_order.lift adj ext } + Sup := Sup, + le_Sup := λ s G hG a b hab, ⟨G, hG, hab⟩, + Sup_le := λ s G hG a b, by { rintro ⟨H, hH, hab⟩, exact hG _ hH hab }, + Inf := Inf, + Inf_le := λ s G hG a b hab, hab.1 hG, + le_Inf := λ s G hG a b hab, ⟨λ H hH, hG _ hH hab, hab.ne⟩, + inf_Sup_le_supr_inf := λ G s a b hab, by simpa only [exists_prop, Sup_adj, and_imp, + forall_exists_index, Inf_adj, supr_adj, inf_adj, ←exists_and_distrib_right, + exists_and_distrib_left, and_assoc, and_self_right] using hab, + infi_sup_le_sup_Inf := λ G s a b hab, begin + simp only [sup_adj, Inf_adj, infi_adj] at ⊢ hab, + have : (∀ G' ∈ s, adj G a b ∨ adj G' a b) ∧ a ≠ b := + (and_congr_left $ λ h, forall_congr $ λ H, _).1 hab, + simpa [forall_or_distrib_left, or_and_distrib_right, and_iff_left_of_imp adj.ne] using this, + exact and_iff_left h, + end, + ..simple_graph.distrib_lattice } @[simp] lemma top_adj (v w : V) : (⊤ : simple_graph V).adj v w ↔ v ≠ w := iff.rfl @@ -237,7 +287,14 @@ instance : boolean_algebra (simple_graph V) := @[simp] lemma empty_graph_eq_bot (V : Type u) : empty_graph V = ⊥ := rfl -instance (V : Type u) : inhabited (simple_graph V) := ⟨⊤⟩ +@[simps] instance (V : Type u) : inhabited (simple_graph V) := ⟨⊥⟩ + +instance [subsingleton V] : unique (simple_graph V) := +{ default := ⊥, + uniq := λ G, by ext a b; simp [subsingleton.elim a b] } + +instance [nontrivial V] : nontrivial (simple_graph V) := +⟨⟨⊥, ⊤, λ h, not_subsingleton V ⟨by simpa [ext_iff, function.funext_iff] using h⟩⟩⟩ section decidable @@ -275,6 +332,9 @@ def neighbor_set (v : V) : set V := set_of (G.adj v) instance neighbor_set.mem_decidable (v : V) [decidable_rel G.adj] : decidable_pred (∈ G.neighbor_set v) := by { unfold neighbor_set, apply_instance } +section edge_set +variables {G₁ G₂ : simple_graph V} + /-- The edges of G consist of the unordered pairs of vertices related by `G.adj`. @@ -282,10 +342,68 @@ The edges of G consist of the unordered pairs of vertices related by The way `edge_set` is defined is such that `mem_edge_set` is proved by `refl`. (That is, `⟦(v, w)⟧ ∈ G.edge_set` is definitionally equal to `G.adj v w`.) -/ -def edge_set : set (sym2 V) := sym2.from_rel G.symm +def edge_set : simple_graph V ↪o set (sym2 V) := +order_embedding.of_map_le_iff (λ G, sym2.from_rel G.symm) $ + λ G G', ⟨λ h a b, @h ⟦(a, b)⟧, λ h e, sym2.ind @h e⟩ @[simp] lemma mem_edge_set : ⟦(v, w)⟧ ∈ G.edge_set ↔ G.adj v w := iff.rfl +lemma not_is_diag_of_mem_edge_set : e ∈ G.edge_set → ¬ e.is_diag := sym2.ind (λ v w, adj.ne) e + +@[simp] lemma edge_set_inj : G₁.edge_set = G₂.edge_set ↔ G₁ = G₂ := +(edge_set : simple_graph V ↪o set (sym2 V)).eq_iff_eq + +@[simp] lemma edge_set_subset_edge_set : G₁.edge_set ⊆ G₂.edge_set ↔ G₁ ≤ G₂ := +(edge_set : simple_graph V ↪o set (sym2 V)).le_iff_le + +@[simp] lemma edge_set_ssubset_edge_set : G₁.edge_set ⊂ G₂.edge_set ↔ G₁ < G₂ := +(edge_set : simple_graph V ↪o set (sym2 V)).lt_iff_lt + +lemma edge_set_injective : injective (edge_set : simple_graph V → set (sym2 V)) := +edge_set.injective + +alias edge_set_subset_edge_set ↔ _ edge_set_mono +alias edge_set_ssubset_edge_set ↔ _ edge_set_strict_mono + +attribute [mono] edge_set_mono edge_set_strict_mono + +variables (G₁ G₂) + +@[simp] lemma edge_set_bot : (⊥ : simple_graph V).edge_set = ∅ := sym2.from_rel_bot + +@[simp] lemma edge_set_sup : (G₁ ⊔ G₂).edge_set = G₁.edge_set ∪ G₂.edge_set := +by { ext ⟨x, y⟩, refl } + +@[simp] lemma edge_set_inf : (G₁ ⊓ G₂).edge_set = G₁.edge_set ∩ G₂.edge_set := +by { ext ⟨x, y⟩, refl } + +@[simp] lemma edge_set_sdiff : (G₁ \ G₂).edge_set = G₁.edge_set \ G₂.edge_set := +by { ext ⟨x, y⟩, refl } + +variables {G G₁ G₂} + +@[simp] lemma disjoint_edge_set : disjoint G₁.edge_set G₂.edge_set ↔ disjoint G₁ G₂ := +by rw [set.disjoint_iff, disjoint_iff_inf_le, ←edge_set_inf, ←edge_set_bot, ←set.le_iff_subset, + order_embedding.le_iff_le] + +@[simp] lemma edge_set_eq_empty : G.edge_set = ∅ ↔ G = ⊥ := by rwa [←edge_set_bot, edge_set_inj] + +@[simp] lemma edge_set_nonempty : G.edge_set.nonempty ↔ G ≠ ⊥ := +by rw [set.nonempty_iff_ne_empty, edge_set_eq_empty.ne] + +/-- +This lemma, combined with `edge_set_sdiff` and `edge_set_from_edge_set`, +allows proving `(G \ from_edge_set s).edge_set = G.edge_set \ s` by `simp`. +-/ +@[simp] lemma edge_set_sdiff_sdiff_is_diag (G : simple_graph V) (s : set (sym2 V)) : + G.edge_set \ (s \ {e | e.is_diag}) = G.edge_set \ s := +begin + ext e, + simp only [set.mem_diff, set.mem_set_of_eq, not_and, not_not, and.congr_right_iff], + intro h, + simp only [G.not_is_diag_of_mem_edge_set h, imp_false], +end + /-- Two vertices are adjacent iff there is an edge between them. The condition `v ≠ w` ensures they are different endpoints of the edge, @@ -307,6 +425,8 @@ end lemma adj_iff_exists_edge_coe : G.adj a b ↔ ∃ (e : G.edge_set), ↑e = ⟦(a, b)⟧ := by simp only [mem_edge_set, exists_prop, set_coe.exists, exists_eq_right, subtype.coe_mk] +variables (G G₁ G₂) + lemma edge_other_ne {e : sym2 V} (he : e ∈ G.edge_set) {v : V} (h : v ∈ e) : h.other ≠ v := begin erw [← sym2.other_spec h, sym2.eq_swap] at he, @@ -316,9 +436,88 @@ end instance decidable_mem_edge_set [decidable_rel G.adj] : decidable_pred (∈ G.edge_set) := sym2.from_rel.decidable_pred _ -instance edges_fintype [decidable_eq V] [fintype V] [decidable_rel G.adj] : +instance fintype_edge_set [decidable_eq V] [fintype V] [decidable_rel G.adj] : fintype G.edge_set := subtype.fintype _ +instance fintype_edge_set_bot : fintype (⊥ : simple_graph V).edge_set := +by { rw edge_set_bot, apply_instance } + +instance fintype_edge_set_sup [decidable_eq V] [fintype G₁.edge_set] [fintype G₂.edge_set] : + fintype (G₁ ⊔ G₂).edge_set := +by { rw edge_set_sup, apply_instance } + +instance fintype_edge_set_inf [decidable_eq V] [fintype G₁.edge_set] [fintype G₂.edge_set] : + fintype (G₁ ⊓ G₂).edge_set := +by { rw edge_set_inf, exact set.fintype_inter _ _ } + +instance fintype_edge_set_sdiff [decidable_eq V] [fintype G₁.edge_set] [fintype G₂.edge_set] : + fintype (G₁ \ G₂).edge_set := +by { rw edge_set_sdiff, exact set.fintype_diff _ _ } + +end edge_set + +section from_edge_set + +variable (s : set (sym2 V)) + +/-- +`from_edge_set` constructs a `simple_graph` from a set of edges, without loops. +-/ +def from_edge_set : simple_graph V := +{ adj := sym2.to_rel s ⊓ ne, + symm := λ v w h, ⟨sym2.to_rel_symmetric s h.1, h.2.symm⟩} + +@[simp] lemma from_edge_set_adj : (from_edge_set s).adj v w ↔ ⟦(v, w)⟧ ∈ s ∧ v ≠ w := iff.rfl + +-- Note: we need to make sure `from_edge_set_adj` and this lemma are confluent. +-- In particular, both yield `⟦(u, v)⟧ ∈ (from_edge_set s).edge_set` ==> `⟦(v, w)⟧ ∈ s ∧ v ≠ w`. +@[simp] lemma edge_set_from_edge_set : (from_edge_set s).edge_set = s \ {e | e.is_diag} := +by { ext e, exact sym2.ind (by simp) e } + +@[simp] lemma from_edge_set_edge_set : from_edge_set G.edge_set = G := +by { ext v w, exact ⟨λ h, h.1, λ h, ⟨h, G.ne_of_adj h⟩⟩ } + +@[simp] lemma from_edge_set_empty : from_edge_set (∅ : set (sym2 V)) = ⊥ := +by { ext v w, simp only [from_edge_set_adj, set.mem_empty_iff_false, false_and, bot_adj] } + +@[simp] lemma from_edge_set_univ : from_edge_set (set.univ : set (sym2 V)) = ⊤ := +by { ext v w, simp only [from_edge_set_adj, set.mem_univ, true_and, top_adj] } + +@[simp] lemma from_edge_set_inf (s t : set (sym2 V)) : + from_edge_set s ⊓ from_edge_set t = from_edge_set (s ∩ t) := +by { ext v w, simp only [from_edge_set_adj, set.mem_inter_iff, ne.def, inf_adj], tauto, } + +@[simp] lemma from_edge_set_sup (s t : set (sym2 V)) : + from_edge_set s ⊔ from_edge_set t = from_edge_set (s ∪ t) := +by { ext v w, simp [set.mem_union, or_and_distrib_right], } + +@[simp] lemma from_edge_set_sdiff (s t : set (sym2 V)) : + from_edge_set s \ from_edge_set t = from_edge_set (s \ t) := +by { ext v w, split; simp { contextual := tt }, } + +@[mono] +lemma from_edge_set_mono {s t : set (sym2 V)} (h : s ⊆ t) : from_edge_set s ≤ from_edge_set t := +begin + rintro v w, + simp only [from_edge_set_adj, ne.def, not_false_iff, and_true, and_imp] {contextual := tt}, + exact λ vws _, h vws, +end + +@[simp] lemma disjoint_from_edge_set : disjoint G (from_edge_set s) ↔ disjoint G.edge_set s := +begin + conv_rhs { rw ←set.diff_union_inter s {e | e.is_diag} }, + rw [←disjoint_edge_set, edge_set_from_edge_set, set.disjoint_union_right, and_iff_left], + exact set.disjoint_left.2 (λ e he he', not_is_diag_of_mem_edge_set _ he he'.2), +end + +@[simp] lemma from_edge_set_disjoint : disjoint (from_edge_set s) G ↔ disjoint s G.edge_set := +by rw [disjoint.comm, disjoint_from_edge_set, disjoint.comm] + +instance [decidable_eq V] [fintype s] : fintype (from_edge_set s).edge_set := +by { rw edge_set_from_edge_set s, apply_instance } + +end from_edge_set + /-! ## Darts -/ /-- A `dart` is an oriented edge, implemented as an ordered pair of adjacent vertices. @@ -337,6 +536,8 @@ abbreviation dart.fst (d : G.dart) : V := d.fst /-- The second vertex for the dart. -/ abbreviation dart.snd (d : G.dart) : V := d.snd +lemma dart.to_prod_injective : function.injective (dart.to_prod : G.dart → V × V) := dart.ext + instance dart.fintype [fintype V] [decidable_rel G.adj] : fintype G.dart := fintype.of_equiv (Σ v, G.neighbor_set v) { to_fun := λ s, ⟨(s.fst, s.snd), s.snd.property⟩, @@ -395,15 +596,15 @@ the second dart's first vertex. -/ def dart_adj (d d' : G.dart) : Prop := d.snd = d'.fst /-- For a given vertex `v`, this is the bijective map from the neighbor set at `v` -to the darts `d` with `d.fst = v`. --/ +to the darts `d` with `d.fst = v`. -/ @[simps] def dart_of_neighbor_set (v : V) (w : G.neighbor_set v) : G.dart := ⟨(v, w), w.property⟩ lemma dart_of_neighbor_set_injective (v : V) : function.injective (G.dart_of_neighbor_set v) := λ e₁ e₂ h, subtype.ext $ by { injection h with h', convert congr_arg prod.snd h' } -instance dart.inhabited [inhabited V] [inhabited (G.neighbor_set default)] : - inhabited G.dart := ⟨G.dart_of_neighbor_set default default⟩ +instance nonempty_dart_top [nontrivial V] : nonempty (⊤ : simple_graph V).dart := +by { obtain ⟨v, w, h⟩ := exists_pair_ne V, exact ⟨⟨(v, w), h⟩⟩ } end darts @@ -447,7 +648,7 @@ by rwa [←mk_mem_incidence_set_left_iff, lemma incidence_set_inter_incidence_set_of_not_adj (h : ¬ G.adj a b) (hn : a ≠ b) : G.incidence_set a ∩ G.incidence_set b = ∅ := begin - simp_rw [set.eq_empty_iff_forall_not_mem, set.mem_inter_eq, not_and], + simp_rw [set.eq_empty_iff_forall_not_mem, set.mem_inter_iff, not_and], intros u ha hb, exact h (G.adj_of_mem_incidence_set hn ha hb), end @@ -455,25 +656,63 @@ end instance decidable_mem_incidence_set [decidable_eq V] [decidable_rel G.adj] (v : V) : decidable_pred (∈ G.incidence_set v) := λ e, and.decidable +section edge_finset +variables {G₁ G₂ : simple_graph V} [fintype G.edge_set] [fintype G₁.edge_set] [fintype G₂.edge_set] + /-- The `edge_set` of the graph as a `finset`. -/ -def edge_finset [decidable_eq V] [fintype V] [decidable_rel G.adj] : finset (sym2 V) := -set.to_finset G.edge_set +@[reducible] def edge_finset : finset (sym2 V) := set.to_finset G.edge_set -@[simp] lemma mem_edge_finset [decidable_eq V] [fintype V] [decidable_rel G.adj] (e : sym2 V) : - e ∈ G.edge_finset ↔ e ∈ G.edge_set := -set.mem_to_finset +@[simp, norm_cast] lemma coe_edge_finset : (G.edge_finset : set (sym2 V)) = G.edge_set := +set.coe_to_finset _ + +variables {G} + +@[simp] lemma mem_edge_finset : e ∈ G.edge_finset ↔ e ∈ G.edge_set := set.mem_to_finset + +lemma not_is_diag_of_mem_edge_finset : e ∈ G.edge_finset → ¬ e.is_diag := +not_is_diag_of_mem_edge_set _ ∘ mem_edge_finset.1 + +@[simp] lemma edge_finset_inj : G₁.edge_finset = G₂.edge_finset ↔ G₁ = G₂ := by simp [edge_finset] + +@[simp] lemma edge_finset_subset_edge_finset : G₁.edge_finset ⊆ G₂.edge_finset ↔ G₁ ≤ G₂ := +by simp [edge_finset] -@[simp] lemma edge_set_univ_card [decidable_eq V] [fintype V] [decidable_rel G.adj] : - (univ : finset G.edge_set).card = G.edge_finset.card := -fintype.card_of_subtype G.edge_finset (mem_edge_finset _) +@[simp] lemma edge_finset_ssubset_edge_finset : G₁.edge_finset ⊂ G₂.edge_finset ↔ G₁ < G₂ := +by simp [edge_finset] + +alias edge_finset_subset_edge_finset ↔ _ edge_finset_mono +alias edge_finset_ssubset_edge_finset ↔ _ edge_finset_strict_mono + +attribute [mono] edge_finset_mono edge_finset_strict_mono + +@[simp] lemma edge_finset_bot : (⊥ : simple_graph V).edge_finset = ∅ := by simp [edge_finset] + +@[simp] lemma edge_finset_sup [decidable_eq V] : + (G₁ ⊔ G₂).edge_finset = G₁.edge_finset ∪ G₂.edge_finset := +by simp [edge_finset] + +@[simp] lemma edge_finset_inf [decidable_eq V] : + (G₁ ⊓ G₂).edge_finset = G₁.edge_finset ∩ G₂.edge_finset := +by simp [edge_finset] + +@[simp] lemma edge_finset_sdiff [decidable_eq V] : + (G₁ \ G₂).edge_finset = G₁.edge_finset \ G₂.edge_finset := +by simp [edge_finset] + +lemma edge_finset_card : G.edge_finset.card = fintype.card G.edge_set := set.to_finset_card _ + +@[simp] lemma edge_set_univ_card : (univ : finset G.edge_set).card = G.edge_finset.card := +fintype.card_of_subtype G.edge_finset $ λ _, mem_edge_finset + +end edge_finset @[simp] lemma mem_neighbor_set (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w := iff.rfl -@[simp] lemma mem_neighbor_set' (v w : V) : G.neighbor_set v w ↔ G.adj v w := -iff.rfl +@[simp] lemma not_mem_neighbor_set_self : a ∉ G.neighbor_set a := +(mem_neighbor_set _ _ _).not.2 $ G.loopless _ @[simp] lemma mem_incidence_set (v w : V) : ⟦(v, w)⟧ ∈ G.incidence_set v ↔ G.adj v w := by simp [incidence_set] @@ -485,7 +724,7 @@ lemma adj_incidence_set_inter {v : V} {e : sym2 V} (he : e ∈ G.edge_set) (h : G.incidence_set v ∩ G.incidence_set h.other = {e} := begin ext e', - simp only [incidence_set, set.mem_sep_eq, set.mem_inter_eq, set.mem_singleton_iff], + simp only [incidence_set, set.mem_sep_iff, set.mem_inter_iff, set.mem_singleton_iff], refine ⟨λ h', _, _⟩, { rw ←sym2.other_spec h, exact (sym2.mem_and_mem_iff (edge_other_ne G he h).symm).mp ⟨h'.1.2, h'.2.2⟩ }, @@ -507,7 +746,7 @@ lemma neighbor_set_union_compl_neighbor_set_eq (G : simple_graph V) (v : V) : begin ext w, have h := @ne_of_adj _ G, - simp_rw [set.mem_union, mem_neighbor_set, compl_adj, set.mem_compl_eq, set.mem_singleton_iff], + simp_rw [set.mem_union, mem_neighbor_set, compl_adj, set.mem_compl_iff, set.mem_singleton_iff], tauto, end @@ -612,6 +851,13 @@ lemma sdiff_eq_delete_edges (G G' : simple_graph V) : G \ G' = G.delete_edges G'.edge_set := by { ext, simp } +lemma delete_edges_eq_sdiff_from_edge_set (s : set (sym2 V)) : + G.delete_edges s = G \ from_edge_set s := +by { ext, exact ⟨λ h, ⟨h.1, not_and_of_not_left _ h.2⟩, λ h, ⟨h.1, not_and'.mp h.2 h.ne⟩⟩ } + +@[simp] lemma delete_edges_eq {s : set (sym2 V)} : G.delete_edges s = G ↔ disjoint G.edge_set s := +by rw [delete_edges_eq_sdiff_from_edge_set, sdiff_eq_left, disjoint_from_edge_set] + lemma compl_eq_delete_edges : Gᶜ = (⊤ : simple_graph V).delete_edges G.edge_set := by { ext, simp } @@ -640,6 +886,167 @@ lemma delete_edges_eq_inter_edge_set (s : set (sym2 V)) : G.delete_edges s = G.delete_edges (s ∩ G.edge_set) := by { ext, simp [imp_false] { contextual := tt } } +lemma delete_edges_sdiff_eq_of_le {H : simple_graph V} (h : H ≤ G) : + G.delete_edges (G.edge_set \ H.edge_set) = H := +by { ext v w, split; simp [@h v w] { contextual := tt } } + +lemma edge_set_delete_edges (s : set (sym2 V)) : + (G.delete_edges s).edge_set = G.edge_set \ s := +by { ext e, refine sym2.ind _ e, simp } + +lemma edge_finset_delete_edges [fintype V] [decidable_eq V] [decidable_rel G.adj] + (s : finset (sym2 V)) [decidable_rel (G.delete_edges s).adj] : + (G.delete_edges s).edge_finset = G.edge_finset \ s := +by { ext e, simp [edge_set_delete_edges] } + +section delete_far +variables (G) [ordered_ring 𝕜] [fintype V] [decidable_eq V] [decidable_rel G.adj] + {p : simple_graph V → Prop} {r r₁ r₂ : 𝕜} + +/-- A graph is `r`-*delete-far* from a property `p` if we must delete at least `r` edges from it to +get a graph with the property `p`. -/ +def delete_far (p : simple_graph V → Prop) (r : 𝕜) : Prop := +∀ ⦃s⦄, s ⊆ G.edge_finset → p (G.delete_edges s) → r ≤ s.card + +variables {G} + +lemma delete_far_iff : + G.delete_far p r ↔ ∀ ⦃H : simple_graph _⦄ [decidable_rel H.adj], + by exactI H ≤ G → p H → r ≤ G.edge_finset.card - H.edge_finset.card := +begin + refine ⟨λ h H _ hHG hH, _, λ h s hs hG, _⟩, + { have := h (sdiff_subset G.edge_finset H.edge_finset), + simp only [delete_edges_sdiff_eq_of_le _ hHG, edge_finset_mono hHG, card_sdiff, + card_le_of_subset, coe_sdiff, coe_edge_finset, nat.cast_sub] at this, + convert this hH }, + { simpa [card_sdiff hs, edge_finset_delete_edges, -set.to_finset_card, nat.cast_sub, + card_le_of_subset hs] using h (G.delete_edges_le s) hG } +end + +alias delete_far_iff ↔ delete_far.le_card_sub_card _ + +lemma delete_far.mono (h : G.delete_far p r₂) (hr : r₁ ≤ r₂) : G.delete_far p r₁ := +λ s hs hG, hr.trans $ h hs hG + +end delete_far + +/-! ## Map and comap -/ + +/-- Given an injective function, there is an covariant induced map on graphs by pushing forward +the adjacency relation. + +This is injective (see `simple_graph.map_injective`). -/ +protected def map (f : V ↪ W) (G : simple_graph V) : simple_graph W := +{ adj := relation.map G.adj f f } + +@[simp] lemma map_adj (f : V ↪ W) (G : simple_graph V) (u v : W) : + (G.map f).adj u v ↔ ∃ (u' v' : V), G.adj u' v' ∧ f u' = u ∧ f v' = v := iff.rfl + +lemma map_adj_apply {G : simple_graph V} {f : V ↪ W} {a b : V} : + (G.map f).adj (f a) (f b) ↔ G.adj a b := by simp + +lemma map_monotone (f : V ↪ W) : monotone (simple_graph.map f) := +by { rintros G G' h _ _ ⟨u, v, ha, rfl, rfl⟩, exact ⟨_, _, h ha, rfl, rfl⟩ } + +@[simp] lemma map_id : G.map (function.embedding.refl _) = G := +ext _ _ $ relation.map_id_id _ + +@[simp] lemma map_map (f : V ↪ W) (g : W ↪ X) : (G.map f).map g = G.map (f.trans g) := +ext _ _ $ relation.map_map _ _ _ _ _ + +instance decidable_map (f : V ↪ W) (G : simple_graph V) [decidable_rel (relation.map G.adj f f)] : + decidable_rel (G.map f).adj := +‹decidable_rel _› + +/-- Given a function, there is a contravariant induced map on graphs by pulling back the +adjacency relation. +This is one of the ways of creating induced graphs. See `simple_graph.induce` for a wrapper. + +This is surjective when `f` is injective (see `simple_graph.comap_surjective`).-/ +@[simps] protected def comap (f : V → W) (G : simple_graph W) : simple_graph V := +{ adj := λ u v, G.adj (f u) (f v) } + +@[simp] lemma comap_id {G : simple_graph V} : G.comap id = G := ext _ _ rfl + +@[simp] lemma comap_comap {G : simple_graph X} (f : V → W) (g : W → X) : + (G.comap g).comap f = G.comap (g ∘ f) := rfl + +instance decidable_comap (f : V → W) (G : simple_graph W) [decidable_rel G.adj] : + decidable_rel (simple_graph.comap f G).adj := +λ _ _, ‹decidable_rel G.adj› _ _ + +lemma comap_symm (G : simple_graph V) (e : V ≃ W) : + G.comap e.symm.to_embedding = G.map e.to_embedding := +by { ext, simp only [equiv.apply_eq_iff_eq_symm_apply, comap_adj, map_adj, equiv.to_embedding_apply, + exists_eq_right_right, exists_eq_right] } + +lemma map_symm (G : simple_graph W) (e : V ≃ W) : + G.map e.symm.to_embedding = G.comap e.to_embedding := +by rw [←comap_symm, e.symm_symm] + +lemma comap_monotone (f : V ↪ W) : monotone (simple_graph.comap f) := +by { intros G G' h _ _ ha, exact h ha } + +@[simp] lemma comap_map_eq (f : V ↪ W) (G : simple_graph V) : (G.map f).comap f = G := +by { ext, simp } + +lemma left_inverse_comap_map (f : V ↪ W) : + function.left_inverse (simple_graph.comap f) (simple_graph.map f) := comap_map_eq f + +lemma map_injective (f : V ↪ W) : function.injective (simple_graph.map f) := +(left_inverse_comap_map f).injective + +lemma comap_surjective (f : V ↪ W) : function.surjective (simple_graph.comap f) := +(left_inverse_comap_map f).surjective + +lemma map_le_iff_le_comap (f : V ↪ W) (G : simple_graph V) (G' : simple_graph W) : + G.map f ≤ G' ↔ G ≤ G'.comap f := +⟨λ h u v ha, h ⟨_, _, ha, rfl, rfl⟩, by { rintros h _ _ ⟨u, v, ha, rfl, rfl⟩, exact h ha, }⟩ + +lemma map_comap_le (f : V ↪ W) (G : simple_graph W) : (G.comap f).map f ≤ G := +by { rw map_le_iff_le_comap, exact le_refl _ } + +/-- Equivalent types have equivalent simple graphs. -/ +@[simps apply] protected def _root_.equiv.simple_graph (e : V ≃ W) : + simple_graph V ≃ simple_graph W := +{ to_fun := simple_graph.comap e.symm, + inv_fun := simple_graph.comap e, + left_inv := λ _, by simp, + right_inv := λ _, by simp } + +@[simp] lemma _root_.equiv.simple_graph_refl : (equiv.refl V).simple_graph = equiv.refl _ := +by { ext, refl } + +@[simp] lemma _root_.equiv.simple_graph_trans (e₁ : V ≃ W) (e₂ : W ≃ X) : + (e₁.trans e₂).simple_graph = e₁.simple_graph.trans e₂.simple_graph := rfl + +@[simp] lemma _root_.equiv.symm_simple_graph (e : V ≃ W) : + e.simple_graph.symm = e.symm.simple_graph := rfl + +/-! ## Induced graphs -/ + +/- Given a set `s` of vertices, we can restrict a graph to those vertices by restricting its +adjacency relation. This gives a map between `simple_graph V` and `simple_graph s`. + +There is also a notion of induced subgraphs (see `simple_graph.subgraph.induce`). -/ + +/-- Restrict a graph to the vertices in the set `s`, deleting all edges incident to vertices +outside the set. This is a wrapper around `simple_graph.comap`. -/ +@[reducible] def induce (s : set V) (G : simple_graph V) : simple_graph s := +G.comap (function.embedding.subtype _) + +/-- Given a graph on a set of vertices, we can make it be a `simple_graph V` by +adding in the remaining vertices without adding in any additional edges. +This is a wrapper around `simple_graph.map`. -/ +@[reducible] def spanning_coe {s : set V} (G : simple_graph s) : simple_graph V := +G.map (function.embedding.subtype _) + +lemma induce_spanning_coe {s : set V} {G : simple_graph s} : G.spanning_coe.induce s = G := +comap_map_eq _ _ + +lemma spanning_coe_induce_le (s : set V) : (G.induce s).spanning_coe ≤ G := +map_comap_le _ _ + section finite_at /-! @@ -666,6 +1073,15 @@ lemma neighbor_finset_def : G.neighbor_finset v = (G.neighbor_set v).to_finset : w ∈ G.neighbor_finset v ↔ G.adj v w := set.mem_to_finset +@[simp] lemma not_mem_neighbor_finset_self : v ∉ G.neighbor_finset v := +(mem_neighbor_finset _ _ _).not.mpr $ G.loopless _ + +lemma neighbor_finset_disjoint_singleton : disjoint (G.neighbor_finset v) {v} := +finset.disjoint_singleton_right.mpr $ not_mem_neighbor_finset_self _ _ + +lemma singleton_disjoint_neighbor_finset : disjoint {v} (G.neighbor_finset v) := +finset.disjoint_singleton_left.mpr $ not_mem_neighbor_finset_self _ _ + /-- `G.degree v` is the number of vertices adjacent to `v`. -/ @@ -683,7 +1099,7 @@ lemma degree_compl [fintype (Gᶜ.neighbor_set v)] [fintype V] : begin classical, rw [← card_neighbor_set_union_compl_neighbor_set G v, set.to_finset_union], - simp [card_disjoint_union (set.to_finset_disjoint_iff.mpr (compl_neighbor_set_disjoint G v))], + simp [card_disjoint_union (set.disjoint_to_finset.mpr (compl_neighbor_set_disjoint G v))], end instance incidence_set_fintype [decidable_eq V] : fintype (G.incidence_set v) := @@ -709,6 +1125,14 @@ lemma mem_incidence_finset [decidable_eq V] (e : sym2 V) : e ∈ G.incidence_finset v ↔ e ∈ G.incidence_set v := set.mem_to_finset +lemma incidence_finset_eq_filter [decidable_eq V] [fintype G.edge_set] : + G.incidence_finset v = G.edge_finset.filter (has_mem.mem v) := +begin + ext e, + refine sym2.ind (λ x y, _) e, + simp [mk_mem_incidence_set_iff], +end + end finite_at section locally_finite @@ -752,7 +1176,7 @@ by { ext, simp } lemma neighbor_finset_compl [decidable_eq V] [decidable_rel G.adj] (v : V) : Gᶜ.neighbor_finset v = (G.neighbor_finset v)ᶜ \ {v} := -by simp only [neighbor_finset, neighbor_set_compl, set.to_finset_sdiff, set.to_finset_compl, +by simp only [neighbor_finset, neighbor_set_compl, set.to_finset_diff, set.to_finset_compl, set.to_finset_singleton] @[simp] @@ -776,7 +1200,7 @@ The key properties of this are given in `exists_minimal_degree_vertex`, `min_deg and `le_min_degree_of_forall_le_degree`. -/ def min_degree [decidable_rel G.adj] : ℕ := -option.get_or_else (univ.image (λ v, G.degree v)).min 0 +with_top.untop' 0 (univ.image (λ v, G.degree v)).min /-- There exists a vertex of minimal degree. Note the assumption of being nonempty is necessary, as @@ -794,9 +1218,8 @@ end lemma min_degree_le_degree [decidable_rel G.adj] (v : V) : G.min_degree ≤ G.degree v := begin obtain ⟨t, ht⟩ := finset.min_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)), - have := finset.min_le_of_mem (mem_image_of_mem _ (mem_univ v)) ht, - rw option.mem_def at ht, - rwa [min_degree, ht, option.get_or_else_some], + have := finset.min_le_of_eq (mem_image_of_mem _ (mem_univ v)) ht, + rwa [min_degree, ht] end /-- @@ -828,7 +1251,6 @@ begin have ht₂ := mem_of_max ht, simp only [mem_image, mem_univ, exists_prop_of_true] at ht₂, rcases ht₂ with ⟨v, rfl⟩, - rw option.mem_def at ht, refine ⟨v, _⟩, rw [max_degree, ht], refl @@ -838,8 +1260,8 @@ end lemma degree_le_max_degree [decidable_rel G.adj] (v : V) : G.degree v ≤ G.max_degree := begin obtain ⟨t, ht : _ = _⟩ := finset.max_of_mem (mem_image_of_mem (λ v, G.degree v) (mem_univ v)), - have := finset.le_max_of_mem (mem_image_of_mem _ (mem_univ v)) ht, - rwa [max_degree, ht, option.get_or_else_some], + have := finset.le_max_of_eq (mem_image_of_mem _ (mem_univ v)) ht, + rwa [max_degree, ht], end /-- @@ -914,17 +1336,17 @@ begin { rw finset.insert_subset, split, { simpa, }, - { rw [neighbor_finset, ← set.subset_iff_to_finset_subset], + { rw [neighbor_finset, set.to_finset_subset_to_finset], exact G.common_neighbors_subset_neighbor_set_left _ _ } } end lemma card_common_neighbors_top [decidable_eq V] {v w : V} (h : v ≠ w) : fintype.card ((⊤ : simple_graph V).common_neighbors v w) = fintype.card V - 2 := begin - simp only [common_neighbors_top_eq, ← set.to_finset_card, set.to_finset_sdiff], + simp only [common_neighbors_top_eq, ← set.to_finset_card, set.to_finset_diff], rw finset.card_sdiff, { simp [finset.card_univ, h], }, - { simp only [←set.subset_iff_to_finset_subset, set.subset_univ] }, + { simp only [set.to_finset_subset_to_finset, set.subset_univ] }, end end finite @@ -958,10 +1380,23 @@ infix ` ↪g ` : 50 := embedding infix ` ≃g ` : 50 := iso namespace hom -variables {G G'} (f : G →g G') +variables {G G'} {H : simple_graph W} (f : G →g G') /-- The identity homomorphism from a graph to itself. -/ -abbreviation id : G →g G := rel_hom.id _ +protected abbreviation id : G →g G := rel_hom.id _ + +@[simp, norm_cast] lemma coe_id : ⇑(hom.id : G →g G) = _root_.id := rfl + +instance [subsingleton (V → W)] : subsingleton (G →g H) := fun_like.coe_injective.subsingleton + +instance [is_empty V] : unique (G →g H) := +{ default := ⟨is_empty_elim, is_empty_elim⟩, + uniq := λ _, subsingleton.elim _ _ } + +noncomputable instance [fintype V] [fintype W] : fintype (G →g H) := +by classical; exact fun_like.fintype _ + +instance [finite V] [finite W] : finite (G →g H) := fun_like.finite _ lemma map_adj {v w : V} (h : G.adj v w) : G'.adj (f v) (f w) := f.map_rel' h @@ -986,6 +1421,7 @@ def map_dart (d : G.dart) : G'.dart := ⟨d.1.map f f, f.map_adj d.2⟩ @[simp] lemma map_dart_apply (d : G.dart) : f.map_dart d = ⟨d.1.map f f, f.map_adj d.2⟩ := rfl /-- The induced map for spanning subgraphs, which is the identity on vertices. -/ +@[simps] def map_spanning_subgraphs {G G' : simple_graph V} (h : G ≤ G') : G →g G' := { to_fun := λ x, x, map_rel' := h } @@ -998,6 +1434,20 @@ begin apply sym2.map.injective hinj, end +/-- Every graph homomomorphism from a complete graph is injective. -/ +lemma injective_of_top_hom (f : (⊤ : simple_graph V) →g G') : function.injective f := +begin + intros v w h, + contrapose! h, + exact G'.ne_of_adj (map_adj _ ((top_adj _ _).mpr h)), +end + +/-- There is a homomorphism to a graph from a comapped graph. +When the function is injective, this is an embedding (see `simple_graph.embedding.comap`). -/ +@[simps] protected def comap (f : V → W) (G : simple_graph W) : G.comap f →g G := +{ to_fun := f, + map_rel' := by simp } + variable {G'' : simple_graph X} /-- Composition of graph homomorphisms. -/ @@ -1005,10 +1455,15 @@ abbreviation comp (f' : G' →g G'') (f : G →g G') : G →g G'' := f'.comp f @[simp] lemma coe_comp (f' : G' →g G'') (f : G →g G') : ⇑(f'.comp f) = f' ∘ f := rfl +/-- The graph homomorphism from a smaller graph to a bigger one. -/ +def of_le {H : simple_graph V} (h : G ≤ H) : G →g H := ⟨id, h⟩ + +@[simp, norm_cast] lemma coe_of_le {H : simple_graph V} (h : G ≤ H) : ⇑(of_le h) = id := rfl + end hom namespace embedding -variables {G G'} (f : G ↪g G') +variables {G G'} {H : simple_graph W} (f : G ↪g G') /-- The identity embedding from a graph to itself. -/ abbreviation refl : G ↪g G := rel_embedding.refl _ @@ -1016,7 +1471,9 @@ abbreviation refl : G ↪g G := rel_embedding.refl _ /-- An embedding of graphs gives rise to a homomorphism of graphs. -/ abbreviation to_hom : G →g G' := f.to_rel_hom -lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff +@[simp] lemma coe_to_hom (f : G ↪g H) : ⇑f.to_hom = f := rfl + +@[simp] lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff lemma map_mem_edge_set_iff {e : sym2 V} : e.map f ∈ G'.edge_set ↔ e ∈ G.edge_set := quotient.ind (λ ⟨v, w⟩, f.map_adj_iff) e @@ -1038,11 +1495,32 @@ map_adj_iff f exact f.inj' h, end } +/-- Given an injective function, there is an embedding from the comapped graph into the original +graph. -/ +@[simps] +protected def comap (f : V ↪ W) (G : simple_graph W) : G.comap f ↪g G := +{ map_rel_iff' := by simp, ..f } + +/-- Given an injective function, there is an embedding from a graph into the mapped graph. -/ +@[simps] +protected def map (f : V ↪ W) (G : simple_graph V) : G ↪g G.map f := +{ map_rel_iff' := by simp, ..f } + +/-- Induced graphs embed in the original graph. + +Note that if `G.induce s = ⊤` (i.e., if `s` is a clique) then this gives the embedding of a +complete graph. -/ +@[reducible] protected def induce (s : set V) : G.induce s ↪g G := +simple_graph.embedding.comap (function.embedding.subtype _) G + +/-- Graphs on a set of vertices embed in their `spanning_coe`. -/ +@[reducible] protected def spanning_coe {s : set V} (G : simple_graph s) : G ↪g G.spanning_coe := +simple_graph.embedding.map (function.embedding.subtype _) G + /-- Embeddings of types induce embeddings of complete graphs on those types. -/ -def complete_graph.of_embedding {α β : Type*} (f : α ↪ β) : complete_graph α ↪g complete_graph β := -{ to_fun := f, - inj' := f.inj', - map_rel_iff' := by simp } +protected def complete_graph {α β : Type*} (f : α ↪ β) : + (⊤ : simple_graph α) ↪g (⊤ : simple_graph β) := +{ map_rel_iff' := by simp, ..f } variables {G'' : simple_graph X} @@ -1053,6 +1531,29 @@ abbreviation comp (f' : G' ↪g G'') (f : G ↪g G') : G ↪g G'' := f.trans f' end embedding +section induce_hom + +variables {G G'} {G'' : simple_graph X} {s : set V} {t : set W} {r : set X} + (φ : G →g G') (φst : set.maps_to φ s t) (ψ : G' →g G'') (ψtr : set.maps_to ψ t r) + +/-- The restriction of a morphism of graphs to induced subgraphs. -/ +def induce_hom : G.induce s →g G'.induce t := +{ to_fun := set.maps_to.restrict φ s t φst, + map_rel' := λ _ _, φ.map_rel', } + +@[simp, norm_cast] lemma coe_induce_hom : ⇑(induce_hom φ φst) = set.maps_to.restrict φ s t φst := +rfl + +@[simp] lemma induce_hom_id (G : simple_graph V) (s) : + induce_hom (hom.id : G →g G) (set.maps_to_id s) = hom.id := +by { ext x, refl } + +@[simp] lemma induce_hom_comp : + (induce_hom ψ ψtr).comp (induce_hom φ φst) = induce_hom (ψ.comp φ) (ψtr.comp φst) := +by { ext x, refl } + +end induce_hom + namespace iso variables {G G'} (f : G ≃g G') @@ -1065,7 +1566,7 @@ abbreviation to_embedding : G ↪g G' := f.to_rel_embedding /-- An isomorphism of graphs gives rise to a homomorphism of graphs. -/ abbreviation to_hom : G →g G' := f.to_embedding.to_hom -/-- The inverse of a graph isomorphism. --/ +/-- The inverse of a graph isomorphism. -/ abbreviation symm : G' ≃g G := f.symm lemma map_adj_iff {v w : V} : G'.adj (f v) (f w) ↔ G.adj v w := f.map_rel_iff @@ -1110,6 +1611,23 @@ map_adj_iff f lemma card_eq_of_iso [fintype V] [fintype W] (f : G ≃g G') : fintype.card V = fintype.card W := by convert (fintype.of_equiv_card f.to_equiv).symm +/-- Given a bijection, there is an embedding from the comapped graph into the original +graph. -/ +@[simps] protected def comap (f : V ≃ W) (G : simple_graph W) : G.comap f.to_embedding ≃g G := +{ map_rel_iff' := by simp, ..f } + +/-- Given an injective function, there is an embedding from a graph into the mapped graph. -/ +@[simps] protected def map (f : V ≃ W) (G : simple_graph V) : G ≃g G.map f.to_embedding := +{ map_rel_iff' := by simp, ..f } + +/-- Equivalences of types induce isomorphisms of complete graphs on those types. -/ +protected def complete_graph {α β : Type*} (f : α ≃ β) : + (⊤ : simple_graph α) ≃g (⊤ : simple_graph β) := +{ map_rel_iff' := by simp, ..f } + +lemma to_embedding_complete_graph {α β : Type*} (f : α ≃ β) : + (iso.complete_graph f).to_embedding = embedding.complete_graph f.to_embedding := rfl + variables {G'' : simple_graph X} /-- Composition of graph isomorphisms. -/ diff --git a/src/combinatorics/simple_graph/clique.lean b/src/combinatorics/simple_graph/clique.lean index 87996e7e1e54e..8d2b10d255ca5 100644 --- a/src/combinatorics/simple_graph/clique.lean +++ b/src/combinatorics/simple_graph/clique.lean @@ -5,10 +5,14 @@ Authors: Yaël Dillies, Bhavik Mehta -/ import combinatorics.simple_graph.basic import data.finset.pairwise +import data.finset.preimage /-! # Graph cliques +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines cliques in simple graphs. A clique is a set of vertices that are pairwise adjacent. @@ -22,14 +26,13 @@ adjacent. ## TODO * Clique numbers -* Going back and forth between cliques and complete subgraphs or embeddings of complete graphs. -* Do we need `clique_set`, a version of `clique_finset` for infinite graphs? +* Dualise all the API to get independent sets -/ -open finset fintype +open finset fintype function namespace simple_graph -variables {α : Type*} (G H : simple_graph α) +variables {α β : Type*} (G H : simple_graph α) /-! ### Cliques -/ @@ -41,21 +44,56 @@ abbreviation is_clique (s : set α) : Prop := s.pairwise G.adj lemma is_clique_iff : G.is_clique s ↔ s.pairwise G.adj := iff.rfl +/-- A clique is a set of vertices whose induced graph is complete. -/ +lemma is_clique_iff_induce_eq : G.is_clique s ↔ G.induce s = ⊤ := +begin + rw is_clique_iff, + split, + { intro h, + ext ⟨v, hv⟩ ⟨w, hw⟩, + simp only [comap_adj, subtype.coe_mk, top_adj, ne.def, subtype.mk_eq_mk], + exact ⟨adj.ne, h hv hw⟩, }, + { intros h v hv w hw hne, + have : (G.induce s).adj ⟨v, hv⟩ ⟨w, hw⟩ = _ := rfl, + conv_lhs at this { rw h }, + simpa [hne], } +end + instance [decidable_eq α] [decidable_rel G.adj] {s : finset α} : decidable (G.is_clique s) := decidable_of_iff' _ G.is_clique_iff -variables {G H} +variables {G H} {a b : α} + +@[simp] lemma is_clique_empty : G.is_clique ∅ := set.pairwise_empty _ +@[simp] lemma is_clique_singleton (a : α) : G.is_clique {a} := set.pairwise_singleton _ _ -lemma is_clique.mono (h : G ≤ H) : G.is_clique s → H.is_clique s := -by { simp_rw is_clique_iff, exact set.pairwise.mono' h } +lemma is_clique_pair : G.is_clique {a, b} ↔ a ≠ b → G.adj a b := +set.pairwise_pair_of_symmetric G.symm -lemma is_clique.subset (h : t ⊆ s) : G.is_clique s → G.is_clique t := -by { simp_rw is_clique_iff, exact set.pairwise.mono h } +@[simp] lemma is_clique_insert : + G.is_clique (insert a s) ↔ G.is_clique s ∧ ∀ b ∈ s, a ≠ b → G.adj a b := +set.pairwise_insert_of_symmetric G.symm + +lemma is_clique_insert_of_not_mem (ha : a ∉ s) : + G.is_clique (insert a s) ↔ G.is_clique s ∧ ∀ b ∈ s, G.adj a b := +set.pairwise_insert_of_symmetric_of_not_mem G.symm ha + +lemma is_clique.insert (hs : G.is_clique s) (h : ∀ b ∈ s, a ≠ b → G.adj a b) : + G.is_clique (insert a s) := +hs.insert_of_symmetric G.symm h + +lemma is_clique.mono (h : G ≤ H) : G.is_clique s → H.is_clique s := set.pairwise.mono' h +lemma is_clique.subset (h : t ⊆ s) : G.is_clique s → G.is_clique t := set.pairwise.mono h + +protected lemma is_clique.map {G : simple_graph α} {s : set α} (h : G.is_clique s) {f : α ↪ β} : + (G.map f).is_clique (f '' s) := +by { rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ hab, + exact ⟨a, b, h ha hb $ ne_of_apply_ne _ hab, rfl, rfl⟩ } @[simp] lemma is_clique_bot_iff : (⊥ : simple_graph α).is_clique s ↔ (s : set α).subsingleton := set.pairwise_bot_iff -alias is_clique_bot_iff ↔ simple_graph.is_clique.subsingleton _ +alias is_clique_bot_iff ↔ is_clique.subsingleton _ end clique @@ -76,11 +114,19 @@ instance [decidable_eq α] [decidable_rel G.adj] {n : ℕ} {s : finset α} : decidable (G.is_n_clique n s) := decidable_of_iff' _ G.is_n_clique_iff -variables {G H} +variables {G H} {a b c : α} + +@[simp] lemma is_n_clique_empty : G.is_n_clique n ∅ ↔ n = 0 := by simp [is_n_clique_iff, eq_comm] +@[simp] lemma is_n_clique_singleton : G.is_n_clique n {a} ↔ n = 1 := +by simp [is_n_clique_iff, eq_comm] lemma is_n_clique.mono (h : G ≤ H) : G.is_n_clique n s → H.is_n_clique n s := by { simp_rw is_n_clique_iff, exact and.imp_left (is_clique.mono h) } +protected lemma is_n_clique.map (h : G.is_n_clique n s) {f : α ↪ β} : + (G.map f).is_n_clique n (s.map f) := +⟨by { rw coe_map, exact h.1.map}, (card_map _).trans h.2⟩ + @[simp] lemma is_n_clique_bot_iff : (⊥ : simple_graph α).is_n_clique n s ↔ n ≤ 1 ∧ s.card = n := begin rw [is_n_clique_iff, is_clique_bot_iff], @@ -89,7 +135,22 @@ begin exact card_le_one.symm, end -variables [decidable_eq α] {a b c : α} +@[simp] lemma is_n_clique_zero : G.is_n_clique 0 s ↔ s = ∅ := +by { simp only [is_n_clique_iff, finset.card_eq_zero, and_iff_right_iff_imp], rintro rfl, simp } + +@[simp] lemma is_n_clique_one : G.is_n_clique 1 s ↔ ∃ a, s = {a} := +by { simp only [is_n_clique_iff, card_eq_one, and_iff_right_iff_imp], rintro ⟨a, rfl⟩, simp } + +variables [decidable_eq α] + +lemma is_n_clique.insert (hs : G.is_n_clique n s) (h : ∀ b ∈ s, G.adj a b) : + G.is_n_clique (n + 1) (insert a s) := +begin + split, + { push_cast, + exact hs.1.insert (λ b hb _, h _ hb) }, + { rw [card_insert_of_not_mem (λ ha, (h _ ha).ne rfl), hs.2] } +end lemma is_3_clique_triple_iff : G.is_n_clique 3 {a, b, c} ↔ G.adj a b ∧ G.adj a c ∧ G.adj b c := begin @@ -121,9 +182,62 @@ variables {m n : ℕ} /-- `G.clique_free n` means that `G` has no `n`-cliques. -/ def clique_free (n : ℕ) : Prop := ∀ t, ¬ G.is_n_clique n t -variables {G H} +variables {G H} {s : finset α} + +lemma is_n_clique.not_clique_free (hG : G.is_n_clique n s) : ¬ G.clique_free n := λ h, h _ hG + +lemma not_clique_free_of_top_embedding {n : ℕ} + (f : (⊤ : simple_graph (fin n)) ↪g G) : ¬ G.clique_free n := +begin + simp only [clique_free, is_n_clique_iff, is_clique_iff_induce_eq, not_forall, not_not], + use finset.univ.map f.to_embedding, + simp only [card_map, finset.card_fin, eq_self_iff_true, and_true], + ext ⟨v, hv⟩ ⟨w, hw⟩, + simp only [coe_map, rel_embedding.coe_fn_to_embedding, set.mem_image, + coe_univ, set.mem_univ, true_and] at hv hw, + obtain ⟨v', rfl⟩ := hv, + obtain ⟨w', rfl⟩ := hw, + simp only [f.map_adj_iff, comap_adj, function.embedding.coe_subtype, subtype.coe_mk, top_adj, + ne.def, subtype.mk_eq_mk], + exact (function.embedding.apply_eq_iff_eq _ _ _).symm.not, +end + +/-- An embedding of a complete graph that witnesses the fact that the graph is not clique-free. -/ +noncomputable +def top_embedding_of_not_clique_free {n : ℕ} (h : ¬ G.clique_free n) : + (⊤ : simple_graph (fin n)) ↪g G := +begin + simp only [clique_free, is_n_clique_iff, is_clique_iff_induce_eq, not_forall, not_not] at h, + obtain ⟨ha, hb⟩ := h.some_spec, + have : (⊤ : simple_graph (fin h.some.card)) ≃g (⊤ : simple_graph h.some), + { apply iso.complete_graph, + simpa using (fintype.equiv_fin h.some).symm }, + rw ← ha at this, + convert (embedding.induce ↑h.some).comp this.to_embedding; + exact hb.symm, +end + +lemma not_clique_free_iff (n : ℕ) : + ¬ G.clique_free n ↔ nonempty ((⊤ : simple_graph (fin n)) ↪g G) := +begin + split, + { exact λ h, ⟨top_embedding_of_not_clique_free h⟩ }, + { rintro ⟨f⟩, + exact not_clique_free_of_top_embedding f }, +end + +lemma clique_free_iff {n : ℕ} : + G.clique_free n ↔ is_empty ((⊤ : simple_graph (fin n)) ↪g G) := +by rw [← not_iff_not, not_clique_free_iff, not_is_empty_iff] + +lemma not_clique_free_card_of_top_embedding [fintype α] (f : (⊤ : simple_graph α) ↪g G) : + ¬ G.clique_free (card α) := +begin + rw [not_clique_free_iff], + use (iso.complete_graph (fintype.equiv_fin α)).symm.to_embedding.trans f, +end -lemma clique_free_bot (h : 2 ≤ n) : (⊥ : simple_graph α).clique_free n := +@[simp] lemma clique_free_bot (h : 2 ≤ n) : (⊥ : simple_graph α).clique_free n := begin rintro t ht, rw is_n_clique_bot_iff at ht, @@ -140,8 +254,150 @@ end lemma clique_free.anti (h : G ≤ H) : H.clique_free n → G.clique_free n := forall_imp $ λ s, mt $ is_n_clique.mono h +/-- See `simple_graph.clique_free_chromatic_number_succ` for a tighter bound. -/ +lemma clique_free_of_card_lt [fintype α] (hc : card α < n) : G.clique_free n := +begin + by_contra h, + refine nat.lt_le_antisymm hc _, + rw [clique_free_iff, not_is_empty_iff] at h, + simpa using fintype.card_le_of_embedding h.some.to_embedding, +end + +@[simp] lemma clique_free_two : G.clique_free 2 ↔ G = ⊥ := +begin + classical, + split, + { simp_rw [←edge_set_eq_empty, set.eq_empty_iff_forall_not_mem, sym2.forall, mem_edge_set], + exact λ h a b hab, h _ ⟨by simpa [hab.ne], card_doubleton hab.ne⟩ }, + { rintro rfl, + exact clique_free_bot le_rfl } +end + end clique_free +section clique_free_on +variables {s s₁ s₂ : set α} {t : finset α} {a b : α} {m n : ℕ} + +/-- `G.clique_free_on s n` means that `G` has no `n`-cliques contained in `s`. -/ +def clique_free_on (G : simple_graph α) (s : set α) (n : ℕ) : Prop := +∀ ⦃t⦄, ↑t ⊆ s → ¬G.is_n_clique n t + +lemma clique_free_on.subset (hs : s₁ ⊆ s₂) (h₂ : G.clique_free_on s₂ n) : G.clique_free_on s₁ n := +λ t hts, h₂ $ hts.trans hs + +lemma clique_free_on.mono (hmn : m ≤ n) (hG : G.clique_free_on s m) : G.clique_free_on s n := +begin + rintro t hts ht, + obtain ⟨u, hut, hu⟩ := t.exists_smaller_set _ (hmn.trans ht.card_eq.ge), + exact hG ((coe_subset.2 hut).trans hts) ⟨ht.clique.subset hut, hu⟩, +end + +lemma clique_free_on.anti (hGH : G ≤ H) (hH : H.clique_free_on s n) : G.clique_free_on s n := +λ t hts ht, hH hts $ ht.mono hGH + +@[simp] lemma clique_free_on_empty : G.clique_free_on ∅ n ↔ n ≠ 0 := +by simp [clique_free_on, set.subset_empty_iff] + +@[simp] lemma clique_free_on_singleton : G.clique_free_on {a} n ↔ 1 < n := +by obtain _ | _ | n := n; simp [clique_free_on, set.subset_singleton_iff_eq] + +@[simp] lemma clique_free_on_univ : G.clique_free_on set.univ n ↔ G.clique_free n := +by simp [clique_free, clique_free_on] + +protected lemma clique_free.clique_free_on (hG : G.clique_free n) : G.clique_free_on s n := +λ t _, hG _ + +lemma clique_free_on_of_card_lt {s : finset α} (h : s.card < n) : G.clique_free_on s n := +λ t hts ht, h.not_le $ ht.2.symm.trans_le $ card_mono hts + +--TOOD: Restate using `simple_graph.indep_set` once we have it +@[simp] lemma clique_free_on_two : G.clique_free_on s 2 ↔ s.pairwise G.adjᶜ := +begin + classical, + refine ⟨λ h a ha b hb _ hab, h _ ⟨by simpa [hab.ne], card_doubleton hab.ne⟩, _⟩, + { push_cast, + exact set.insert_subset.2 ⟨ha, set.singleton_subset_iff.2 hb⟩ }, + simp only [clique_free_on, is_n_clique_iff, card_eq_two, coe_subset, not_and, not_exists], + rintro h t hst ht a b hab rfl, + simp only [coe_insert, coe_singleton, set.insert_subset, set.singleton_subset_iff] at hst, + refine h hst.1 hst.2 hab (ht _ _ hab); simp, +end + +lemma clique_free_on.of_succ (hs : G.clique_free_on s (n + 1)) (ha : a ∈ s) : + G.clique_free_on (s ∩ G.neighbor_set a) n := +begin + classical, + refine λ t hts ht, hs _ (ht.insert $ λ b hb, (hts hb).2), + push_cast, + exact set.insert_subset.2 ⟨ha, hts.trans $ set.inter_subset_left _ _⟩, +end + +end clique_free_on + +/-! ### Set of cliques -/ + +section clique_set +variables (G) {n : ℕ} {a b c : α} {s : finset α} + +/-- The `n`-cliques in a graph as a set. -/ +def clique_set (n : ℕ) : set (finset α) := {s | G.is_n_clique n s} + +@[simp] lemma mem_clique_set_iff : s ∈ G.clique_set n ↔ G.is_n_clique n s := iff.rfl + +@[simp] lemma clique_set_eq_empty_iff : G.clique_set n = ∅ ↔ G.clique_free n := +by simp_rw [clique_free, set.eq_empty_iff_forall_not_mem, mem_clique_set_iff] + +variables {G H} + +protected lemma clique_free.clique_set : G.clique_free n → G.clique_set n = ∅ := +G.clique_set_eq_empty_iff.2 + +@[mono] lemma clique_set_mono (h : G ≤ H) : G.clique_set n ⊆ H.clique_set n := +λ _, is_n_clique.mono h + +lemma clique_set_mono' (h : G ≤ H) : G.clique_set ≤ H.clique_set := λ _, clique_set_mono h + +@[simp] lemma clique_set_zero (G : simple_graph α) : G.clique_set 0 = {∅} := +set.ext $ λ s, by simp + +@[simp] lemma clique_set_one (G : simple_graph α) : G.clique_set 1 = set.range singleton := +set.ext $ λ s, by simp [eq_comm] + +@[simp] lemma clique_set_bot (hn : 1 < n) : (⊥ : simple_graph α).clique_set n = ∅ := +(clique_free_bot hn).clique_set + +@[simp] lemma clique_set_map (hn : n ≠ 1) (G : simple_graph α) (f : α ↪ β) : + (G.map f).clique_set n = map f '' G.clique_set n := +begin + ext s, + split, + { rintro ⟨hs, rfl⟩, + have hs' : (s.preimage f $ f.injective.inj_on _).map f = s, + { classical, + rw [map_eq_image, image_preimage, filter_true_of_mem], + rintro a ha, + obtain ⟨b, hb, hba⟩ := exists_mem_ne (hn.lt_of_le' $ finset.card_pos.2 ⟨a, ha⟩) a, + obtain ⟨c, _, _, hc, _⟩ := hs ha hb hba.symm, + exact ⟨c, hc⟩ }, + refine ⟨s.preimage f $ f.injective.inj_on _, ⟨_, by rw [←card_map f, hs']⟩, hs'⟩, + rw coe_preimage, + exact λ a ha b hb hab, map_adj_apply.1 (hs ha hb $ f.injective.ne hab) }, + { rintro ⟨s, hs, rfl⟩, + exact is_n_clique.map hs } +end + +@[simp] lemma clique_set_map_of_equiv (G : simple_graph α) (e : α ≃ β) (n : ℕ) : + (G.map e.to_embedding).clique_set n = map e.to_embedding '' G.clique_set n := +begin + obtain rfl | hn := eq_or_ne n 1, + { ext, + simp [e.exists_congr_left] }, + { exact clique_set_map hn _ _ } +end + + +end clique_set + /-! ### Finset of cliques -/ section clique_finset @@ -150,20 +406,45 @@ variables (G) [fintype α] [decidable_eq α] [decidable_rel G.adj] {n : ℕ} {a /-- The `n`-cliques in a graph as a finset. -/ def clique_finset (n : ℕ) : finset (finset α) := univ.filter $ G.is_n_clique n -lemma mem_clique_finset_iff (s : finset α) : s ∈ G.clique_finset n ↔ G.is_n_clique n s := +@[simp] lemma mem_clique_finset_iff : s ∈ G.clique_finset n ↔ G.is_n_clique n s := mem_filter.trans $ and_iff_right $ mem_univ _ +@[simp, norm_cast] lemma coe_clique_finset (n : ℕ) : + (G.clique_finset n : set (finset α)) = G.clique_set n := +set.ext $ λ _, mem_clique_finset_iff _ + @[simp] lemma clique_finset_eq_empty_iff : G.clique_finset n = ∅ ↔ G.clique_free n := by simp_rw [clique_free, eq_empty_iff_forall_not_mem, mem_clique_finset_iff] -alias clique_finset_eq_empty_iff ↔ _ simple_graph.clique_free.clique_finset +alias clique_finset_eq_empty_iff ↔ _ _root_.simple_graph.clique_free.clique_finset attribute [protected] clique_free.clique_finset -variables {G} [decidable_rel H.adj] +variables {G} + +lemma card_clique_finset_le : (G.clique_finset n).card ≤ (card α).choose n := +begin + rw [←card_univ, ←card_powerset_len], + refine card_mono (λ s, _), + simpa [mem_powerset_len_univ_iff] using is_n_clique.card_eq, +end + +variables [decidable_rel H.adj] -lemma clique_finset_mono (h : G ≤ H) : G.clique_finset n ⊆ H.clique_finset n := +@[mono] lemma clique_finset_mono (h : G ≤ H) : G.clique_finset n ⊆ H.clique_finset n := monotone_filter_right _ $ λ _, is_n_clique.mono h +variables [fintype β] [decidable_eq β] (G) + +@[simp] lemma clique_finset_map (f : α ↪ β) (hn : n ≠ 1) : + (G.map f).clique_finset n = (G.clique_finset n).map ⟨map f, finset.map_injective _⟩ := +coe_injective $ + by simp_rw [coe_clique_finset, clique_set_map hn, coe_map, coe_clique_finset, embedding.coe_fn_mk] + +@[simp] lemma clique_finset_map_of_equiv (e : α ≃ β) (n : ℕ) : + (G.map e.to_embedding).clique_finset n = + (G.clique_finset n).map ⟨map e.to_embedding, finset.map_injective _⟩ := +coe_injective $ by push_cast; exact clique_set_map_of_equiv _ _ _ + end clique_finset end simple_graph diff --git a/src/combinatorics/simple_graph/coloring.lean b/src/combinatorics/simple_graph/coloring.lean index 8aaa57e487a69..7f71a8f81b713 100644 --- a/src/combinatorics/simple_graph/coloring.lean +++ b/src/combinatorics/simple_graph/coloring.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Arthur Paulino, Kyle Miller -/ -import combinatorics.simple_graph.subgraph +import combinatorics.simple_graph.clique import data.nat.lattice import data.setoid.partition import order.antichain @@ -12,6 +12,9 @@ import order.antichain /-! # Graph Coloring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines colorings of simple graphs (also known as proper colorings in the literature). A graph coloring is the attribution of "colors" to all of its vertices such that adjacent vertices have @@ -43,8 +46,6 @@ a complete graph, whose vertices represent the colors. * https://github.com/leanprover-community/mathlib/blob/simple_graph_matching/src/combinatorics/simple_graph/coloring.lean * https://github.com/kmill/lean-graphcoloring/blob/master/src/graph.lean - * Lowerbound for cliques - * Trees * Planar graphs @@ -100,8 +101,8 @@ setoid.is_partition_classes (setoid.ker C) lemma coloring.mem_color_classes {v : V} : C.color_class (C v) ∈ C.color_classes := ⟨v, rfl⟩ -lemma coloring.color_classes_finite_of_fintype [fintype α] : C.color_classes.finite := -by { rw set.finite_def, apply setoid.nonempty_fintype_classes_ker, } +lemma coloring.color_classes_finite [finite α] : C.color_classes.finite := +setoid.finite_classes_ker _ lemma coloring.card_color_classes_le [fintype α] [fintype C.color_classes] : fintype.card C.color_classes ≤ fintype.card α := @@ -157,13 +158,13 @@ Inf { n : ℕ | G.colorable n } /-- Given an embedding, there is an induced embedding of colorings. -/ def recolor_of_embedding {α β : Type*} (f : α ↪ β) : G.coloring α ↪ G.coloring β := -{ to_fun := λ C, (embedding.complete_graph.of_embedding f).to_hom.comp C, +{ to_fun := λ C, (embedding.complete_graph f).to_hom.comp C, inj' := begin -- this was strangely painful; seems like missing lemmas about embeddings intros C C' h, dsimp only at h, ext v, - apply (embedding.complete_graph.of_embedding f).inj', - change ((embedding.complete_graph.of_embedding f).to_hom.comp C) v = _, + apply (embedding.complete_graph f).inj', + change ((embedding.complete_graph f).to_hom.comp C) v = _, rw h, refl, end } @@ -214,7 +215,7 @@ begin split, { rintro hc, have C : G.coloring (fin n) := hc.to_coloring (by simp), - let f := embedding.complete_graph.of_embedding (fin.coe_embedding n).to_embedding, + let f := embedding.complete_graph fin.coe_embedding, use f.to_hom.comp C, intro v, cases C with color valid, @@ -223,7 +224,7 @@ begin refine ⟨coloring.mk _ _⟩, { exact λ v, ⟨C v, Cf v⟩, }, { rintro v w hvw, - simp only [subtype.mk_eq_mk, ne.def], + simp only [fin.mk_eq_mk, ne.def], exact C.valid hvw, } } end @@ -256,9 +257,9 @@ begin exact colorable_set_nonempty_of_colorable hc, end -lemma colorable_chromatic_number_of_fintype (G : simple_graph V) [fintype V] : +lemma colorable_chromatic_number_of_fintype (G : simple_graph V) [finite V] : G.colorable G.chromatic_number := -colorable_chromatic_number G.colorable_of_fintype +by { casesI nonempty_fintype V, exact colorable_chromatic_number G.colorable_of_fintype } lemma chromatic_number_le_one_of_subsingleton (G : simple_graph V) [subsingleton V] : G.chromatic_number ≤ 1 := @@ -280,7 +281,7 @@ begin apply colorable_of_is_empty, end -lemma is_empty_of_chromatic_number_eq_zero (G : simple_graph V) [fintype V] +lemma is_empty_of_chromatic_number_eq_zero (G : simple_graph V) [finite V] (h : G.chromatic_number = 0) : is_empty V := begin have h' := G.colorable_chromatic_number_of_fintype, @@ -366,7 +367,7 @@ end begin apply chromatic_number_eq_card_of_forall_surj (self_coloring _), intro C, - rw ←fintype.injective_iff_surjective, + rw ←finite.injective_iff_surjective, intros v w, contrapose, intro h, @@ -383,7 +384,7 @@ begin convert_to (⊤ : simple_graph {m | m < n + 1}).chromatic_number ≤ _, { simp, }, refine (colorable_of_chromatic_number_pos hc).chromatic_number_mono_of_embedding _, - apply embedding.complete_graph.of_embedding, + apply embedding.complete_graph, exact (function.embedding.subtype _).trans (infinite.nat_embedding V), end @@ -416,4 +417,47 @@ begin contradiction }, }, end +/-! ### Cliques -/ + +lemma is_clique.card_le_of_coloring {s : finset V} (h : G.is_clique s) + [fintype α] (C : G.coloring α) : + s.card ≤ fintype.card α := +begin + rw is_clique_iff_induce_eq at h, + have f : G.induce ↑s ↪g G := embedding.induce ↑s, + rw h at f, + convert fintype.card_le_of_injective _ (C.comp f.to_hom).injective_of_top_hom using 1, + simp, +end + +lemma is_clique.card_le_of_colorable {s : finset V} (h : G.is_clique s) + {n : ℕ} (hc : G.colorable n) : + s.card ≤ n := +begin + convert h.card_le_of_coloring hc.some, + simp, +end + +-- TODO eliminate `finite V` constraint once chromatic numbers are refactored. +-- This is just to ensure the chromatic number exists. +lemma is_clique.card_le_chromatic_number [finite V] {s : finset V} (h : G.is_clique s) : + s.card ≤ G.chromatic_number := +by { casesI nonempty_fintype V, + exact h.card_le_of_colorable G.colorable_chromatic_number_of_fintype } + +protected +lemma colorable.clique_free {n m : ℕ} (hc : G.colorable n) (hm : n < m) : G.clique_free m := +begin + by_contra h, + simp only [clique_free, is_n_clique_iff, not_forall, not_not] at h, + obtain ⟨s, h, rfl⟩ := h, + exact nat.lt_le_antisymm hm (h.card_le_of_colorable hc), +end + +-- TODO eliminate `finite V` constraint once chromatic numbers are refactored. +-- This is just to ensure the chromatic number exists. +lemma clique_free_of_chromatic_number_lt [finite V] {n : ℕ} (hc : G.chromatic_number < n) : + G.clique_free n := +G.colorable_chromatic_number_of_fintype.clique_free hc + end simple_graph diff --git a/src/combinatorics/simple_graph/connectivity.lean b/src/combinatorics/simple_graph/connectivity.lean index 2a5c053bedf40..d6621ff6c91d3 100644 --- a/src/combinatorics/simple_graph/connectivity.lean +++ b/src/combinatorics/simple_graph/connectivity.lean @@ -5,11 +5,14 @@ Authors: Kyle Miller -/ import combinatorics.simple_graph.basic import combinatorics.simple_graph.subgraph -import data.list +import data.list.rotate /-! # Graph connectivity +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In a simple graph, * A *walk* is a finite sequence of adjacent vertices, and can be @@ -55,15 +58,25 @@ counterparts in [Chou1994]. * `simple_graph.connected_component` is the type of connected components of a given graph. +* `simple_graph.is_bridge` for whether an edge is a bridge edge + +## Main statements + +* `simple_graph.is_bridge_iff_mem_and_forall_cycle_not_mem` characterizes bridge edges in terms of + there being no cycle containing them. + ## Tags -walks, trails, paths, circuits, cycles +walks, trails, paths, circuits, cycles, bridge edges -/ -universes u v +open function + +universes u v w namespace simple_graph -variables {V : Type u} {V' : Type v} (G : simple_graph V) (G' : simple_graph V') +variables {V : Type u} {V' : Type v} {V'' : Type w} +variables (G : simple_graph V) (G' : simple_graph V') (G'' : simple_graph V'') /-- A walk is a sequence of adjacent vertices. For vertices `u v : V`, the type `walk u v` consists of all walks starting at `u` and ending at `v`. @@ -80,7 +93,11 @@ inductive walk : V → V → Type u attribute [refl] walk.nil -instance walk.inhabited (v : V) : inhabited (G.walk v v) := ⟨by refl⟩ +@[simps] instance walk.inhabited (v : V) : inhabited (G.walk v v) := ⟨walk.nil⟩ + +/-- The one-edge walk associated to a pair of adjacent vertices. -/ +@[pattern, reducible] def adj.to_walk {G : simple_graph V} {u v : V} (h : G.adj u v) : + G.walk u v := walk.cons h walk.nil namespace walk variables {G} @@ -92,6 +109,35 @@ variables {G} @[pattern] abbreviation cons' (u v w : V) (h : G.adj u v) (p : G.walk v w) : G.walk u w := walk.cons h p +/-- Change the endpoints of a walk using equalities. This is helpful for relaxing +definitional equality constraints and to be able to state otherwise difficult-to-state +lemmas. While this is a simple wrapper around `eq.rec`, it gives a canonical way to write it. + +The simp-normal form is for the `copy` to be pushed outward. That way calculations can +occur within the "copy context." -/ +protected def copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : G.walk u' v' := +eq.rec (eq.rec p hv) hu + +@[simp] lemma copy_rfl_rfl {u v} (p : G.walk u v) : + p.copy rfl rfl = p := rfl + +@[simp] lemma copy_copy {u v u' v' u'' v''} (p : G.walk u v) + (hu : u = u') (hv : v = v') (hu' : u' = u'') (hv' : v' = v'') : + (p.copy hu hv).copy hu' hv' = p.copy (hu.trans hu') (hv.trans hv') := +by { subst_vars, refl } + +@[simp] lemma copy_nil {u u'} (hu : u = u') : (walk.nil : G.walk u u).copy hu hu = walk.nil := +by { subst_vars, refl } + +lemma copy_cons {u v w u' w'} (h : G.adj u v) (p : G.walk v w) (hu : u = u') (hw : w = w') : + (walk.cons h p).copy hu hw = walk.cons (by rwa ← hu) (p.copy rfl hw) := +by { subst_vars, refl } + +@[simp] +lemma cons_copy {u v w v' w'} (h : G.adj u v) (p : G.walk v' w') (hv : v' = v) (hw : w' = w) : + walk.cons h (p.copy hv hw) = (walk.cons (by rwa hv) p).copy rfl hw := +by { subst_vars, refl } + lemma exists_eq_cons_of_ne : Π {u v : V} (hne : u ≠ v) (p : G.walk u v), ∃ (w : V) (h : G.adj u w) (p' : G.walk w v), p = cons h p' | _ _ hne nil := (hne rfl).elim @@ -108,6 +154,13 @@ def append : Π {u v w : V}, G.walk u v → G.walk v w → G.walk u w | _ _ _ nil q := q | _ _ _ (cons h p) q := cons h (p.append q) +/-- The reversed version of `simple_graph.walk.cons`, concatenating an edge to +the end of a walk. -/ +def concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : G.walk u w := p.append (cons h nil) + +lemma concat_eq_append {u v w : V} (p : G.walk u v) (h : G.adj v w) : + p.concat h = p.append (cons h nil) := rfl + /-- The concatenation of the reverse of the first walk with the second walk. -/ protected def reverse_aux : Π {u v w : V}, G.walk u v → G.walk u w → G.walk v w | _ _ _ nil q := q @@ -168,6 +221,39 @@ lemma append_assoc : Π {u v w x : V} (p : G.walk u v) (q : G.walk v w) (r : G.w | _ _ _ _ nil _ _ := rfl | _ _ _ _ (cons h p') q r := by { dunfold append, rw append_assoc, } +@[simp] lemma append_copy_copy {u v w u' v' w'} (p : G.walk u v) (q : G.walk v w) + (hu : u = u') (hv : v = v') (hw : w = w') : + (p.copy hu hv).append (q.copy hv hw) = (p.append q).copy hu hw := by { subst_vars, refl } + +lemma concat_nil {u v : V} (h : G.adj u v) : nil.concat h = cons h nil := rfl + +@[simp] lemma concat_cons {u v w x : V} (h : G.adj u v) (p : G.walk v w) (h' : G.adj w x) : + (cons h p).concat h' = cons h (p.concat h') := rfl + +lemma append_concat {u v w x : V} (p : G.walk u v) (q : G.walk v w) (h : G.adj w x) : + p.append (q.concat h) = (p.append q).concat h := append_assoc _ _ _ + +lemma concat_append {u v w x : V} (p : G.walk u v) (h : G.adj v w) (q : G.walk w x) : + (p.concat h).append q = p.append (cons h q) := +by rw [concat_eq_append, ← append_assoc, cons_nil_append] + +/-- A non-trivial `cons` walk is representable as a `concat` walk. -/ +lemma exists_cons_eq_concat : Π {u v w : V} (h : G.adj u v) (p : G.walk v w), + ∃ (x : V) (q : G.walk u x) (h' : G.adj x w), cons h p = q.concat h' +| _ _ _ h nil := ⟨_, nil, h, rfl⟩ +| _ _ _ h (cons h' p) := + begin + obtain ⟨y, q, h'', hc⟩ := exists_cons_eq_concat h' p, + refine ⟨y, cons h q, h'', _⟩, + rw [concat_cons, hc], + end + +/-- A non-trivial `concat` walk is representable as a `cons` walk. -/ +lemma exists_concat_eq_cons : Π {u v w : V} (p : G.walk u v) (h : G.adj v w), + ∃ (x : V) (h' : G.adj u x) (q : G.walk x w), p.concat h = cons h' q +| _ _ _ nil h := ⟨_, h, nil, rfl⟩ +| _ _ _ (cons h' p) h := ⟨_, h', walk.concat p h, concat_cons _ _ _⟩ + @[simp] lemma reverse_nil {u : V} : (nil : G.walk u u).reverse = nil := rfl lemma reverse_singleton {u v : V} (h : G.adj u v) : @@ -196,10 +282,17 @@ by simp [reverse] (cons h p).reverse = p.reverse.append (cons (G.symm h) nil) := by simp [reverse] +@[simp] lemma reverse_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).reverse = p.reverse.copy hv hu := by { subst_vars, refl } + @[simp] lemma reverse_append {u v w : V} (p : G.walk u v) (q : G.walk v w) : (p.append q).reverse = q.reverse.append p.reverse := by simp [reverse] +@[simp] lemma reverse_concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : + (p.concat h).reverse = cons (G.symm h) p.reverse := +by simp [concat_eq_append] + @[simp] lemma reverse_reverse : Π {u v : V} (p : G.walk u v), p.reverse.reverse = p | _ _ nil := rfl | _ _ (cons h p) := by simp [reverse_reverse] @@ -209,11 +302,18 @@ by simp [reverse] @[simp] lemma length_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) : (cons h p).length = p.length + 1 := rfl +@[simp] lemma length_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).length = p.length := +by { subst_vars, refl } + @[simp] lemma length_append : Π {u v w : V} (p : G.walk u v) (q : G.walk v w), (p.append q).length = p.length + q.length | _ _ _ nil _ := by simp | _ _ _ (cons _ _) _ := by simp [length_append, add_left_comm, add_comm] +@[simp] lemma length_concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : + (p.concat h).length = p.length + 1 := length_append _ _ + @[simp] protected lemma length_reverse_aux : Π {u v w : V} (p : G.walk u v) (q : G.walk u w), (p.reverse_aux q).length = p.length + q.length | _ _ _ nil _ := by simp! @@ -237,6 +337,76 @@ end @[simp] lemma length_eq_zero_iff {u : V} {p : G.walk u u} : p.length = 0 ↔ p = nil := by cases p; simp +section concat_rec + +variables + {motive : Π (u v : V), G.walk u v → Sort*} + (Hnil : Π {u : V}, motive u u nil) + (Hconcat : Π {u v w : V} (p : G.walk u v) (h : G.adj v w), motive u v p → motive u w (p.concat h)) + +/-- Auxiliary definition for `simple_graph.walk.concat_rec` -/ +def concat_rec_aux : Π {u v : V} (p : G.walk u v), motive v u p.reverse +| _ _ nil := Hnil +| _ _ (cons h p) := eq.rec (Hconcat p.reverse (G.symm h) (concat_rec_aux p)) (reverse_cons h p).symm + +/-- Recursor on walks by inducting on `simple_graph.walk.concat`. + +This is inducting from the opposite end of the walk compared +to `simple_graph.walk.rec`, which inducts on `simple_graph.walk.cons`. -/ +@[elab_as_eliminator] +def concat_rec {u v : V} (p : G.walk u v) : motive u v p := +eq.rec (concat_rec_aux @Hnil @Hconcat p.reverse) (reverse_reverse p) + +@[simp] lemma concat_rec_nil (u : V) : + @concat_rec _ _ motive @Hnil @Hconcat _ _ (nil : G.walk u u) = Hnil := rfl + +@[simp] lemma concat_rec_concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : + @concat_rec _ _ motive @Hnil @Hconcat _ _ (p.concat h) + = Hconcat p h (concat_rec @Hnil @Hconcat p) := +begin + simp only [concat_rec], + apply eq_of_heq, + apply rec_heq_of_heq, + transitivity concat_rec_aux @Hnil @Hconcat (cons h.symm p.reverse), + { congr, simp }, + { rw [concat_rec_aux, rec_heq_iff_heq], + congr; simp [heq_rec_iff_heq], } +end + +end concat_rec + +lemma concat_ne_nil {u v : V} (p : G.walk u v) (h : G.adj v u) : + p.concat h ≠ nil := +by cases p; simp [concat] + +lemma concat_inj {u v v' w : V} + {p : G.walk u v} {h : G.adj v w} {p' : G.walk u v'} {h' : G.adj v' w} + (he : p.concat h = p'.concat h') : + ∃ (hv : v = v'), p.copy rfl hv = p' := +begin + induction p, + { cases p', + { exact ⟨rfl, rfl⟩ }, + { exfalso, + simp only [concat_nil, concat_cons] at he, + obtain ⟨rfl, he⟩ := he, + simp only [heq_iff_eq] at he, + exact concat_ne_nil _ _ he.symm, } }, + { rw concat_cons at he, + cases p', + { exfalso, + simp only [concat_nil] at he, + obtain ⟨rfl, he⟩ := he, + rw [heq_iff_eq] at he, + exact concat_ne_nil _ _ he, }, + { rw concat_cons at he, + simp only at he, + obtain ⟨rfl, he⟩ := he, + rw [heq_iff_eq] at he, + obtain ⟨rfl, rfl⟩ := p_ih he, + exact ⟨rfl, rfl⟩, } } +end + /-- The `support` of a walk is the list of vertices it visits in order. -/ def support : Π {u v : V}, G.walk u v → list V | u v nil := [u] @@ -256,6 +426,12 @@ def edges {u v : V} (p : G.walk u v) : list (sym2 V) := p.darts.map dart.edge @[simp] lemma support_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) : (cons h p).support = u :: p.support := rfl +@[simp] lemma support_concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : + (p.concat h).support = p.support.concat w := by induction p; simp [*, concat_nil] + +@[simp] lemma support_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).support = p.support := by { subst_vars, refl } + lemma support_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) : (p.append p').support = p.support ++ p'.support.tail := by induction p; cases p'; simp [*] @@ -280,6 +456,9 @@ by cases p; simp @[simp] lemma end_mem_support {u v : V} (p : G.walk u v) : v ∈ p.support := by induction p; simp [*] +@[simp] lemma support_nonempty {u v : V} (p : G.walk u v) : {w | w ∈ p.support}.nonempty := +⟨u, by simp⟩ + lemma mem_support_iff {u v w : V} (p : G.walk u v) : w ∈ p.support ↔ w = u ∨ w ∈ p.support.tail := by cases p; simp @@ -306,6 +485,18 @@ begin simp [*], end +@[simp] +lemma subset_support_append_left {V : Type u} {G : simple_graph V} {u v w : V} + (p : G.walk u v) (q : G.walk v w) : + p.support ⊆ (p.append q).support := +by simp only [walk.support_append, list.subset_append_left] + +@[simp] +lemma subset_support_append_right {V : Type u} {G : simple_graph V} {u v w : V} + (p : G.walk u v) (q : G.walk v w) : + q.support ⊆ (p.append q).support := +by { intro h, simp only [mem_support_append_iff, or_true, implies_true_iff] { contextual := tt }} + lemma coe_support {u v : V} (p : G.walk u v) : (p.support : multiset V) = {u} + p.support.tail := by cases p; refl @@ -347,11 +538,20 @@ lemma edges_subset_edge_set : Π {u v : V} (p : G.walk u v) ⦃e : sym2 V⦄ (h : e ∈ p.edges), e ∈ G.edge_set | _ _ (cons h' p') e h := by rcases h with ⟨rfl, h⟩; solve_by_elim +lemma adj_of_mem_edges {u v x y : V} (p : G.walk u v) (h : ⟦(x, y)⟧ ∈ p.edges) : G.adj x y := +edges_subset_edge_set p h + @[simp] lemma darts_nil {u : V} : (nil : G.walk u u).darts = [] := rfl @[simp] lemma darts_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) : (cons h p).darts = ⟨(u, v), h⟩ :: p.darts := rfl +@[simp] lemma darts_concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : + (p.concat h).darts = p.darts.concat ⟨(v, w), h⟩ := by induction p; simp [*, concat_nil] + +@[simp] lemma darts_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).darts = p.darts := by { subst_vars, refl } + @[simp] lemma darts_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) : (p.append p').darts = p.darts ++ p'.darts := by induction p; simp [*] @@ -360,6 +560,10 @@ by induction p; simp [*] p.reverse.darts = (p.darts.map dart.symm).reverse := by induction p; simp [*, sym2.eq_swap] +lemma mem_darts_reverse {u v : V} {d : G.dart} {p : G.walk u v} : + d ∈ p.reverse.darts ↔ d.symm ∈ p.darts := +by simp + lemma cons_map_snd_darts {u v : V} (p : G.walk u v) : u :: p.darts.map dart.snd = p.support := by induction p; simp! [*] @@ -381,6 +585,12 @@ by simpa! using congr_arg list.init (map_fst_darts_append p) @[simp] lemma edges_cons {u v w : V} (h : G.adj u v) (p : G.walk v w) : (cons h p).edges = ⟦(u, v)⟧ :: p.edges := rfl +@[simp] lemma edges_concat {u v w : V} (p : G.walk u v) (h : G.adj v w) : + (p.concat h).edges = p.edges.concat ⟦(v, w)⟧ := by simp [edges] + +@[simp] lemma edges_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).edges = p.edges := by { subst_vars, refl } + @[simp] lemma edges_append {u v w : V} (p : G.walk u v) (p' : G.walk v w) : (p.append p').edges = p.edges ++ p'.edges := by simp [edges] @@ -406,16 +616,11 @@ lemma dart_fst_mem_support_of_mem_darts : { exact or.inr (dart_fst_mem_support_of_mem_darts _ hd), }, end -lemma dart_snd_mem_support_of_mem_darts : - Π {u v : V} (p : G.walk u v) {d : G.dart}, d ∈ p.darts → d.snd ∈ p.support -| u v (cons h p') d hd := begin - simp only [support_cons, darts_cons, list.mem_cons_iff] at hd ⊢, - rcases hd with (rfl|hd), - { simp }, - { exact or.inr (dart_snd_mem_support_of_mem_darts _ hd), }, -end +lemma dart_snd_mem_support_of_mem_darts {u v : V} (p : G.walk u v) {d : G.dart} (h : d ∈ p.darts) : + d.snd ∈ p.support := +by simpa using p.reverse.dart_fst_mem_support_of_mem_darts (by simp [h] : d.symm ∈ p.reverse.darts) -lemma mem_support_of_mem_edges {t u v w : V} (p : G.walk v w) (he : ⟦(t, u)⟧ ∈ p.edges) : +lemma fst_mem_support_of_mem_edges {t u v w : V} (p : G.walk v w) (he : ⟦(t, u)⟧ ∈ p.edges) : t ∈ p.support := begin obtain ⟨d, hd, he⟩ := list.mem_map.mp he, @@ -425,6 +630,10 @@ begin { exact dart_snd_mem_support_of_mem_darts _ hd, }, end +lemma snd_mem_support_of_mem_edges {t u v w : V} (p : G.walk v w) (he : ⟦(t, u)⟧ ∈ p.edges) : + u ∈ p.support := +by { rw sym2.eq_swap at he, exact p.fst_mem_support_of_mem_edges he } + lemma darts_nodup_of_support_nodup {u v : V} {p : G.walk u v} (h : p.support.nodup) : p.darts.nodup := begin @@ -440,7 +649,7 @@ begin induction p, { simp, }, { simp only [edges_cons, support_cons, list.nodup_cons] at h ⊢, - exact ⟨λ h', h.1 (mem_support_of_mem_edges p_p h'), p_ih h.2⟩, } + exact ⟨λ h', h.1 (fst_mem_support_of_mem_edges p_p h'), p_ih h.2⟩, } end /-! ### Trails, paths, circuits, cycles -/ @@ -467,16 +676,32 @@ structure is_cycle {u : V} (p : G.walk u u) lemma is_trail_def {u v : V} (p : G.walk u v) : p.is_trail ↔ p.edges.nodup := ⟨is_trail.edges_nodup, λ h, ⟨h⟩⟩ +@[simp] lemma is_trail_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).is_trail ↔ p.is_trail := by { subst_vars, refl } + lemma is_path.mk' {u v : V} {p : G.walk u v} (h : p.support.nodup) : is_path p := ⟨⟨edges_nodup_of_support_nodup h⟩, h⟩ lemma is_path_def {u v : V} (p : G.walk u v) : p.is_path ↔ p.support.nodup := ⟨is_path.support_nodup, is_path.mk'⟩ +@[simp] lemma is_path_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).is_path ↔ p.is_path := by { subst_vars, refl } + +lemma is_circuit_def {u : V} (p : G.walk u u) : + p.is_circuit ↔ is_trail p ∧ p ≠ nil := +iff.intro (λ h, ⟨h.1, h.2⟩) (λ h, ⟨h.1, h.2⟩) + +@[simp] lemma is_circuit_copy {u u'} (p : G.walk u u) (hu : u = u') : + (p.copy hu hu).is_circuit ↔ p.is_circuit := by { subst_vars, refl } + lemma is_cycle_def {u : V} (p : G.walk u u) : p.is_cycle ↔ is_trail p ∧ p ≠ nil ∧ p.support.tail.nodup := iff.intro (λ h, ⟨h.1.1, h.1.2, h.2⟩) (λ h, ⟨⟨h.1, h.2.1⟩, h.2.2⟩) +@[simp] lemma is_cycle_copy {u u'} (p : G.walk u u) (hu : u = u') : + (p.copy hu hu).is_cycle ↔ p.is_cycle := by { subst_vars, refl } + @[simp] lemma is_trail.nil {u : V} : (nil : G.walk u u).is_trail := ⟨by simp [edges]⟩ @@ -511,7 +736,7 @@ lemma is_trail.count_edges_eq_one [decidable_eq V] {u v : V} p.edges.count e = 1 := list.count_eq_one_of_mem h.edges_nodup he -@[simp] lemma is_path.nil {u : V} : (nil : G.walk u u).is_path := +lemma is_path.nil {u : V} : (nil : G.walk u u).is_path := by { fsplit; simp } lemma is_path.of_cons {u v w : V} {h : G.adj u v} {p : G.walk v w} : @@ -522,6 +747,9 @@ by simp [is_path_def] (cons h p).is_path ↔ p.is_path ∧ u ∉ p.support := by split; simp [is_path_def] { contextual := tt } +@[simp] lemma is_path_iff_eq_nil {u : V} (p : G.walk u u) : p.is_path ↔ p = nil := +by { cases p; simp [is_path.nil] } + lemma is_path.reverse {u v : V} {p : G.walk u v} (h : p.is_path) : p.reverse.is_path := by simpa [is_path_def] using h @@ -540,6 +768,27 @@ begin apply h.of_append_left, end +@[simp] lemma is_cycle.not_of_nil {u : V} : ¬ (nil : G.walk u u).is_cycle := +λ h, h.ne_nil rfl + +lemma cons_is_cycle_iff {u v : V} (p : G.walk v u) (h : G.adj u v) : + (walk.cons h p).is_cycle ↔ p.is_path ∧ ¬ ⟦(u, v)⟧ ∈ p.edges := +begin + simp only [walk.is_cycle_def, walk.is_path_def, walk.is_trail_def, edges_cons, list.nodup_cons, + support_cons, list.tail_cons], + have : p.support.nodup → p.edges.nodup := edges_nodup_of_support_nodup, + tauto, +end + +/-! ### About paths -/ + +instance [decidable_eq V] {u v : V} (p : G.walk u v) : decidable p.is_path := +by { rw is_path_def, apply_instance } + +lemma is_path.length_lt [fintype V] {u v : V} {p : G.walk u v} (hp : p.is_path) : + p.length < fintype.card V := +by { rw [nat.lt_iff_add_one_le, ← length_support], exact hp.support_nodup.length_le_card } + /-! ### Walk decompositions -/ section walk_decomp @@ -579,6 +828,17 @@ begin split_ifs with h'; subst_vars; simp [*], } }, end +lemma mem_support_iff_exists_append {V : Type u} {G : simple_graph V} {u v w : V} + {p : G.walk u v} : + w ∈ p.support ↔ ∃ (q : G.walk u w) (r : G.walk w v), p = q.append r := +begin + classical, + split, + { exact λ h, ⟨_, _, (p.take_spec h).symm⟩ }, + { rintro ⟨q, r, rfl⟩, + simp only [mem_support_append_iff, end_mem_support, start_mem_support, or_self], }, +end + @[simp] lemma count_support_take_until_eq_one {u v w : V} (p : G.walk v w) (h : u ∈ p.support) : (p.take_until u h).support.count u = 1 := @@ -615,6 +875,16 @@ begin { apply ih, } } } }, end +@[simp] lemma take_until_copy {u v w v' w'} (p : G.walk v w) + (hv : v = v') (hw : w = w') (h : u ∈ (p.copy hv hw).support) : + (p.copy hv hw).take_until u h = (p.take_until u (by { subst_vars, exact h })).copy hv rfl := +by { subst_vars, refl } + +@[simp] lemma drop_until_copy {u v w v' w'} (p : G.walk v w) + (hv : v = v') (hw : w = w') (h : u ∈ (p.copy hv hw).support) : + (p.copy hv hw).drop_until u h = (p.drop_until u (by { subst_vars, exact h })).copy rfl hw := +by { subst_vars, refl } + lemma support_take_until_subset {u v w : V} (p : G.walk v w) (h : u ∈ p.support) : (p.take_until u h).support ⊆ p.support := λ x hx, by { rw [← take_spec p h, mem_support_append_iff], exact or.inl hx } @@ -732,13 +1002,83 @@ end end walk_decomp +/-- +Given a set `S` and a walk `w` from `u` to `v` such that `u ∈ S` but `v ∉ S`, +there exists a dart in the walk whose start is in `S` but whose end is not. +-/ +lemma exists_boundary_dart + {u v : V} (p : G.walk u v) (S : set V) (uS : u ∈ S) (vS : v ∉ S) : + ∃ (d : G.dart), d ∈ p.darts ∧ d.fst ∈ S ∧ d.snd ∉ S := +begin + induction p with _ x y w a p' ih, + { exact absurd uS vS }, + { by_cases h : y ∈ S, + { obtain ⟨d, hd, hcd⟩ := ih h vS, + exact ⟨d, or.inr hd, hcd⟩ }, + { exact ⟨⟨(x, y), a⟩, or.inl rfl, uS, h⟩ } } +end + + end walk -/-! ### Walks to paths -/ +/-! ### Type of paths -/ /-- The type for paths between two vertices. -/ abbreviation path (u v : V) := {p : G.walk u v // p.is_path} +namespace path +variables {G G'} + +@[simp] protected lemma is_path {u v : V} (p : G.path u v) : (p : G.walk u v).is_path := +p.property + +@[simp] protected lemma is_trail {u v : V} (p : G.path u v) : (p : G.walk u v).is_trail := +p.property.to_trail + +/-- The length-0 path at a vertex. -/ +@[refl, simps] protected def nil {u : V} : G.path u u := ⟨walk.nil, walk.is_path.nil⟩ + +/-- The length-1 path between a pair of adjacent vertices. -/ +@[simps] def singleton {u v : V} (h : G.adj u v) : G.path u v := +⟨walk.cons h walk.nil, by simp [h.ne]⟩ + +lemma mk_mem_edges_singleton {u v : V} (h : G.adj u v) : + ⟦(u, v)⟧ ∈ (singleton h : G.walk u v).edges := by simp [singleton] + +/-- The reverse of a path is another path. See also `simple_graph.walk.reverse`. -/ +@[symm, simps] def reverse {u v : V} (p : G.path u v) : G.path v u := +⟨walk.reverse p, p.property.reverse⟩ + +lemma count_support_eq_one [decidable_eq V] {u v w : V} {p : G.path u v} + (hw : w ∈ (p : G.walk u v).support) : (p : G.walk u v).support.count w = 1 := +list.count_eq_one_of_mem p.property.support_nodup hw + +lemma count_edges_eq_one [decidable_eq V] {u v : V} {p : G.path u v} (e : sym2 V) + (hw : e ∈ (p : G.walk u v).edges) : (p : G.walk u v).edges.count e = 1 := +list.count_eq_one_of_mem p.property.to_trail.edges_nodup hw + +@[simp] lemma nodup_support {u v : V} (p : G.path u v) : (p : G.walk u v).support.nodup := +(walk.is_path_def _).mp p.property + +lemma loop_eq {v : V} (p : G.path v v) : p = path.nil := +begin + obtain ⟨_|_, this⟩ := p, + { refl }, + { simpa }, +end + +lemma not_mem_edges_of_loop {v : V} {e : sym2 V} {p : G.path v v} : + ¬ e ∈ (p : G.walk v v).edges := +by simp [p.loop_eq] + +lemma cons_is_cycle {u v : V} (p : G.path v u) (h : G.adj u v) + (he : ¬ ⟦(u, v)⟧ ∈ (p : G.walk v u).edges) : (walk.cons h ↑p).is_cycle := +by simp [walk.is_cycle_def, walk.cons_is_trail_iff, he] + +end path + +/-! ### Walks to paths -/ + namespace walk variables {G} [decidable_eq V] @@ -753,6 +1093,9 @@ def bypass : Π {u v : V}, G.walk u v → G.walk u v then p'.drop_until u hs else cons ha p' +@[simp] lemma bypass_copy {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') : + (p.copy hu hv).bypass = p.bypass.copy hu hv := by { subst_vars, refl } + lemma bypass_is_path {u v : V} (p : G.walk u v) : p.bypass.is_path := begin induction p, @@ -824,23 +1167,38 @@ edges_bypass_subset _ end walk -/-! ## Mapping paths -/ +/-! ### Mapping paths -/ namespace walk -variables {G G'} +variables {G G' G''} /-- Given a graph homomorphism, map walks to walks. -/ protected def map (f : G →g G') : Π {u v : V}, G.walk u v → G'.walk (f u) (f v) | _ _ nil := nil | _ _ (cons h p) := cons (f.map_adj h) (map p) -variables (f : G →g G') {u v : V} (p : G.walk u v) +variables (f : G →g G') (f' : G' →g G'') {u v u' v' : V} (p : G.walk u v) @[simp] lemma map_nil : (nil : G.walk u u).map f = nil := rfl @[simp] lemma map_cons {w : V} (h : G.adj w u) : (cons h p).map f = cons (f.map_adj h) (p.map f) := rfl +@[simp] lemma map_copy (hu : u = u') (hv : v = v') : + (p.copy hu hv).map f = (p.map f).copy (by rw hu) (by rw hv) := by { subst_vars, refl } + +@[simp] lemma map_id (p : G.walk u v) : p.map hom.id = p := by { induction p; simp [*] } + +@[simp] lemma map_map : (p.map f).map f' = p.map (f'.comp f) := by { induction p; simp [*] } + +/-- Unlike categories, for graphs vertex equality is an important notion, so needing to be able to +to work with equality of graph homomorphisms is a necessary evil. -/ +lemma map_eq_of_eq {f : G →g G'} (f' : G →g G') (h : f = f') : + p.map f = (p.map f').copy (by rw h) (by rw h) := by { subst_vars, refl } + +@[simp] lemma map_eq_nil_iff {p : G.walk u u} : p.map f = nil ↔ p = nil := +by cases p; simp + @[simp] lemma length_map : (p.map f).length = p.length := by induction p; simp [*] @@ -860,6 +1218,8 @@ by induction p; simp [*] @[simp] lemma edges_map : (p.map f).edges = p.edges.map (sym2.map f) := by induction p; simp [*] +variables {p f} + lemma map_is_path_of_injective (hinj : function.injective f) (hp : p.is_path) : (p.map f).is_path := begin @@ -872,6 +1232,44 @@ begin exact hp.2 hx, }, end +protected lemma is_path.of_map {f : G →g G'} (hp : (p.map f).is_path) : p.is_path := +begin + induction p with w u v w huv hvw ih, + { simp }, + { rw [map_cons, walk.cons_is_path_iff, support_map] at hp, + rw walk.cons_is_path_iff, + cases hp with hp1 hp2, + refine ⟨ih hp1, _⟩, + contrapose! hp2, + exact list.mem_map_of_mem f hp2, } +end + +lemma map_is_path_iff_of_injective (hinj : function.injective f) : + (p.map f).is_path ↔ p.is_path := +⟨is_path.of_map, map_is_path_of_injective hinj⟩ + +lemma map_is_trail_iff_of_injective (hinj : function.injective f) : + (p.map f).is_trail ↔ p.is_trail := +begin + induction p with w u v w huv hvw ih, + { simp }, + { rw [map_cons, cons_is_trail_iff, cons_is_trail_iff, edges_map], + change _ ∧ sym2.map f ⟦(u, v)⟧ ∉ _ ↔ _, + rw list.mem_map_of_injective (sym2.map.injective hinj), + exact and_congr_left' ih, }, +end + +alias map_is_trail_iff_of_injective ↔ _ map_is_trail_of_injective + +lemma map_is_cycle_iff_of_injective {p : G.walk u u} (hinj : function.injective f) : + (p.map f).is_cycle ↔ p.is_cycle := +by rw [is_cycle_def, is_cycle_def, map_is_trail_iff_of_injective hinj, ne.def, map_eq_nil_iff, + support_map, ← list.map_tail, list.nodup_map_iff hinj] + +alias map_is_cycle_iff_of_injective ↔ _ map_is_cycle_of_injective + +variables (p f) + lemma map_injective_of_injective {f : G →g G'} (hinj : function.injective f) (u v : V) : function.injective (walk.map f : G.walk u v → G'.walk (f u) (f v)) := begin @@ -889,6 +1287,25 @@ begin simpa using h.2, } }, end +/-- The specialization of `simple_graph.walk.map` for mapping walks to supergraphs. -/ +@[reducible] def map_le {G G' : simple_graph V} (h : G ≤ G') {u v : V} (p : G.walk u v) : + G'.walk u v := p.map (hom.map_spanning_subgraphs h) + +@[simp] lemma map_le_is_trail {G G' : simple_graph V} (h : G ≤ G') {u v : V} {p : G.walk u v} : + (p.map_le h).is_trail ↔ p.is_trail := map_is_trail_iff_of_injective (function.injective_id) + +alias map_le_is_trail ↔ is_trail.of_map_le is_trail.map_le + +@[simp] lemma map_le_is_path {G G' : simple_graph V} (h : G ≤ G') {u v : V} {p : G.walk u v} : + (p.map_le h).is_path ↔ p.is_path := map_is_path_iff_of_injective (function.injective_id) + +alias map_le_is_path ↔ is_path.of_map_le is_path.map_le + +@[simp] lemma map_le_is_cycle {G G' : simple_graph V} (h : G ≤ G') {u : V} {p : G.walk u u} : + (p.map_le h).is_cycle ↔ p.is_cycle := map_is_cycle_iff_of_injective (function.injective_id) + +alias map_le_is_cycle ↔ is_cycle.of_map_le is_cycle.map_le + end walk namespace path @@ -897,7 +1314,7 @@ variables {G G'} /-- Given an injective graph homomorphism, map paths to paths. -/ @[simps] protected def map (f : G →g G') (hinj : function.injective f) {u v : V} (p : G.path u v) : G'.path (f u) (f v) := -⟨walk.map f p, walk.map_is_path_of_injective f p hinj p.2⟩ +⟨walk.map f p, walk.map_is_path_of_injective hinj p.2⟩ lemma map_injective {f : G →g G'} (hinj : function.injective f) (u v : V) : function.injective (path.map f hinj : G.path u v → G'.path (f u) (f v)) := @@ -918,6 +1335,135 @@ map_injective f.injective u v end path +/-! ### Transferring between graphs -/ + +namespace walk + +variables {G} + +/-- The walk `p` transferred to lie in `H`, given that `H` contains its edges. -/ +@[protected, simp] def transfer : Π {u v : V} (p : G.walk u v) (H : simple_graph V) + (h : ∀ e, e ∈ p.edges → e ∈ H.edge_set), H.walk u v +| _ _ (walk.nil) H h := walk.nil +| _ _ (walk.cons' u v w a p) H h := + walk.cons (h (⟦(u, v)⟧ : sym2 V) (by simp)) (p.transfer H (λ e he, h e (by simp [he]))) + +variables {u v w : V} (p : G.walk u v) (q : G.walk v w) + {H : simple_graph V} + (hp : ∀ e, e ∈ p.edges → e ∈ H.edge_set) + (hq : ∀ e, e ∈ q.edges → e ∈ H.edge_set) + +lemma transfer_self : p.transfer G p.edges_subset_edge_set = p := +by { induction p; simp only [*, transfer, eq_self_iff_true, heq_iff_eq, and_self], } + +lemma transfer_eq_map_of_le (GH : G ≤ H) : + p.transfer H hp = p.map (simple_graph.hom.map_spanning_subgraphs GH) := +by { induction p; simp only [*, transfer, map_cons, hom.map_spanning_subgraphs_apply, + eq_self_iff_true, heq_iff_eq, and_self, map_nil], } + +@[simp] lemma edges_transfer : (p.transfer H hp).edges = p.edges := +by { induction p; simp only [*, transfer, edges_nil, edges_cons, eq_self_iff_true, and_self], } + +@[simp] lemma support_transfer : (p.transfer H hp).support = p.support := +by { induction p; simp only [*, transfer, eq_self_iff_true, and_self, support_nil, support_cons], } + +@[simp] lemma length_transfer : (p.transfer H hp).length = p.length := +by induction p; simp [*] + +variables {p} + +protected lemma is_path.transfer (pp : p.is_path) : (p.transfer H hp).is_path := +begin + induction p; + simp only [transfer, is_path.nil, cons_is_path_iff, support_transfer] at pp ⊢, + { tauto, }, +end + +protected lemma is_cycle.transfer {p : G.walk u u} (pc : p.is_cycle) (hp) : + (p.transfer H hp).is_cycle := +begin + cases p; + simp only [transfer, is_cycle.not_of_nil, cons_is_cycle_iff, transfer, edges_transfer] at pc ⊢, + { exact pc, }, + { exact ⟨pc.left.transfer _, pc.right⟩, }, +end + +variables (p) + +@[simp] lemma transfer_transfer {K : simple_graph V} (hp' : ∀ e, e ∈ p.edges → e ∈ K.edge_set) : + (p.transfer H hp).transfer K (by { rw p.edges_transfer hp, exact hp', }) = p.transfer K hp' := +by { induction p; simp only [transfer, eq_self_iff_true, heq_iff_eq, true_and], apply p_ih, } + +@[simp] lemma transfer_append (hpq) : + (p.append q).transfer H hpq = + (p.transfer H (λ e he, by { apply hpq, simp [he] })).append + (q.transfer H (λ e he, by { apply hpq, simp [he] })) := +begin + induction p; + simp only [transfer, nil_append, cons_append, eq_self_iff_true, heq_iff_eq, true_and], + apply p_ih, +end + +@[simp] lemma reverse_transfer : + (p.transfer H hp).reverse = + p.reverse.transfer H (by { simp only [edges_reverse, list.mem_reverse], exact hp, }) := +begin + induction p; + simp only [*, transfer_append, transfer, reverse_nil, reverse_cons], + refl, +end + +end walk + +/-! ## Deleting edges -/ + +namespace walk +variables {G} + +/-- Given a walk that avoids a set of edges, produce a walk in the graph +with those edges deleted. -/ +@[reducible] +def to_delete_edges (s : set (sym2 V)) + {v w : V} (p : G.walk v w) (hp : ∀ e, e ∈ p.edges → ¬ e ∈ s) : (G.delete_edges s).walk v w := +p.transfer _ (by + { simp only [edge_set_delete_edges, set.mem_diff], + exact λ e ep, ⟨edges_subset_edge_set p ep, hp e ep⟩, }) + +@[simp] lemma to_delete_edges_nil (s : set (sym2 V)) {v : V} (hp) : + (walk.nil : G.walk v v).to_delete_edges s hp = walk.nil := rfl + +@[simp] lemma to_delete_edges_cons (s : set (sym2 V)) + {u v w : V} (h : G.adj u v) (p : G.walk v w) (hp) : + (walk.cons h p).to_delete_edges s hp = + walk.cons ⟨h, hp _ (or.inl rfl)⟩ (p.to_delete_edges s $ λ _ he, hp _ $ or.inr he) := rfl + +/-- Given a walk that avoids an edge, create a walk in the subgraph with that edge deleted. +This is an abbreviation for `simple_graph.walk.to_delete_edges`. -/ +abbreviation to_delete_edge {v w : V} (e : sym2 V) (p : G.walk v w) (hp : e ∉ p.edges) : + (G.delete_edges {e}).walk v w := +p.to_delete_edges {e} (λ e', by { contrapose!, simp [hp] { contextual := tt } }) + +@[simp] +lemma map_to_delete_edges_eq (s : set (sym2 V)) {v w : V} {p : G.walk v w} (hp) : + walk.map (hom.map_spanning_subgraphs (G.delete_edges_le s)) (p.to_delete_edges s hp) = p := +by rw [←transfer_eq_map_of_le, transfer_transfer, transfer_self] + +protected lemma is_path.to_delete_edges (s : set (sym2 V)) + {v w : V} {p : G.walk v w} (h : p.is_path) (hp) : + (p.to_delete_edges s hp).is_path := h.transfer _ + +protected lemma is_cycle.to_delete_edges (s : set (sym2 V)) + {v : V} {p : G.walk v v} (h : p.is_cycle) (hp) : + (p.to_delete_edges s hp).is_cycle := h.transfer _ + +@[simp] lemma to_delete_edges_copy (s : set (sym2 V)) + {u v u' v'} (p : G.walk u v) (hu : u = u') (hv : v = v') (h) : + (p.copy hu hv).to_delete_edges s h + = (p.to_delete_edges s (by { subst_vars, exact h })).copy hu hv := +by { subst_vars, refl } + +end walk + /-! ## `reachable` and `connected` -/ /-- Two vertices are *reachable* if there is a walk between them. @@ -942,12 +1488,21 @@ begin exact h.elim (λ q, hp q.to_path), end +protected lemma walk.reachable {G : simple_graph V} {u v : V} (p : G.walk u v) : + G.reachable u v := ⟨p⟩ + +protected lemma adj.reachable {u v : V} (h : G.adj u v) : + G.reachable u v := h.to_walk.reachable + @[refl] protected lemma reachable.refl (u : V) : G.reachable u u := by { fsplit, refl } protected lemma reachable.rfl {u : V} : G.reachable u u := reachable.refl _ @[symm] protected lemma reachable.symm {u v : V} (huv : G.reachable u v) : G.reachable v u := huv.elim (λ p, ⟨p.reverse⟩) +lemma reachable_comm {u v : V} : G.reachable u v ↔ G.reachable v u := +⟨reachable.symm, reachable.symm⟩ + @[trans] protected lemma reachable.trans {u v w : V} (huv : G.reachable u v) (hvw : G.reachable v w) : G.reachable u w := @@ -967,6 +1522,18 @@ begin { exact reachable.trans hr ⟨walk.cons ha walk.nil⟩, }, }, end +protected lemma reachable.map {G : simple_graph V} {G' : simple_graph V'} + (f : G →g G') {u v : V} (h : G.reachable u v) : G'.reachable (f u) (f v) := +h.elim (λ p, ⟨p.map f⟩) + +lemma iso.reachable_iff {G : simple_graph V} {G' : simple_graph V'} + {φ : G ≃g G'} {u v : V} : G'.reachable (φ u) (φ v) ↔ G.reachable u v := +⟨λ r, (φ.left_inv u) ▸ (φ.left_inv v) ▸ (r.map φ.symm.to_hom), reachable.map φ.to_hom⟩ + +lemma iso.symm_apply_reachable {G : simple_graph V} {G' : simple_graph V'} + {φ : G ≃g G'} {u : V} {v : V'} : G.reachable (φ.symm v) u ↔ G'.reachable v (φ u) := +by rw [← iso.reachable_iff, rel_iso.apply_symm_apply] + variables (G) lemma reachable_is_equivalence : equivalence G.reachable := @@ -978,13 +1545,22 @@ def reachable_setoid : setoid V := setoid.mk _ G.reachable_is_equivalence /-- A graph is preconnected if every pair of vertices is reachable from one another. -/ def preconnected : Prop := ∀ (u v : V), G.reachable u v +lemma preconnected.map {G : simple_graph V} {H : simple_graph V'} (f : G →g H) (hf : surjective f) + (hG : G.preconnected) : H.preconnected := +hf.forall₂.2 $ λ a b, nonempty.map (walk.map _) $ hG _ _ + +lemma iso.preconnected_iff {G : simple_graph V} {H : simple_graph V'} (e : G ≃g H) : + G.preconnected ↔ H.preconnected := +⟨preconnected.map e.to_hom e.to_equiv.surjective, + preconnected.map e.symm.to_hom e.symm.to_equiv.surjective⟩ + /-- A graph is connected if it's preconnected and contains at least one vertex. This follows the convention observed by mathlib that something is connected iff it has exactly one connected component. There is a `has_coe_to_fun` instance so that `h u v` can be used instead of `h.preconnected u v`. -/ -@[protect_proj] +@[protect_proj, mk_iff] structure connected : Prop := (preconnected : G.preconnected) [nonempty : nonempty V] @@ -992,6 +1568,15 @@ structure connected : Prop := instance : has_coe_to_fun G.connected (λ _, Π (u v : V), G.reachable u v) := ⟨λ h, h.preconnected⟩ +lemma connected.map {G : simple_graph V} {H : simple_graph V'} (f : G →g H) (hf : surjective f) + (hG : G.connected) : H.connected := +by { haveI := hG.nonempty.map f, exact ⟨hG.preconnected.map f hf⟩ } + +lemma iso.connected_iff {G : simple_graph V} {H : simple_graph V'} (e : G ≃g H) : + G.connected ↔ H.connected := +⟨connected.map e.to_hom e.to_equiv.surjective, + connected.map e.symm.to_hom e.symm.to_equiv.surjective⟩ + /-- The quotient of `V` by the `simple_graph.reachable` relation gives the connected components of a graph. -/ def connected_component := quot G.reachable @@ -999,63 +1584,189 @@ def connected_component := quot G.reachable /-- Gives the connected component containing a particular vertex. -/ def connected_component_mk (v : V) : G.connected_component := quot.mk G.reachable v -instance connected_component.inhabited [inhabited V] : inhabited G.connected_component := -⟨G.connected_component_mk default⟩ +variables {V' G G' G''} -section connected_component -variables {G} +namespace connected_component + +@[simps] instance inhabited [inhabited V] : inhabited G.connected_component := +⟨G.connected_component_mk default⟩ @[elab_as_eliminator] -protected lemma connected_component.ind {β : G.connected_component → Prop} +protected lemma ind {β : G.connected_component → Prop} (h : ∀ (v : V), β (G.connected_component_mk v)) (c : G.connected_component) : β c := quot.ind h c @[elab_as_eliminator] -protected lemma connected_component.ind₂ {β : G.connected_component → G.connected_component → Prop} +protected lemma ind₂ {β : G.connected_component → G.connected_component → Prop} (h : ∀ (v w : V), β (G.connected_component_mk v) (G.connected_component_mk w)) (c d : G.connected_component) : β c d := quot.induction_on₂ c d h -protected lemma connected_component.sound {v w : V} : +protected lemma sound {v w : V} : G.reachable v w → G.connected_component_mk v = G.connected_component_mk w := quot.sound -protected lemma connected_component.exact {v w : V} : +protected lemma exact {v w : V} : G.connected_component_mk v = G.connected_component_mk w → G.reachable v w := @quotient.exact _ G.reachable_setoid _ _ -@[simp] protected lemma connected_component.eq {v w : V} : +@[simp] protected lemma eq {v w : V} : G.connected_component_mk v = G.connected_component_mk w ↔ G.reachable v w := @quotient.eq _ G.reachable_setoid _ _ +lemma connected_component_mk_eq_of_adj {v w : V} (a : G.adj v w) : + G.connected_component_mk v = G.connected_component_mk w := +connected_component.sound a.reachable + /-- The `connected_component` specialization of `quot.lift`. Provides the stronger assumption that the vertices are connected by a path. -/ -protected def connected_component.lift {β : Sort*} (f : V → β) +protected def lift {β : Sort*} (f : V → β) (h : ∀ (v w : V) (p : G.walk v w), p.is_path → f v = f w) : G.connected_component → β := quot.lift f (λ v w (h' : G.reachable v w), h'.elim_path (λ hp, h v w hp hp.2)) -@[simp] protected lemma connected_component.lift_mk {β : Sort*} {f : V → β} +@[simp] protected lemma lift_mk {β : Sort*} {f : V → β} {h : ∀ (v w : V) (p : G.walk v w), p.is_path → f v = f w} {v : V} : connected_component.lift f h (G.connected_component_mk v) = f v := rfl -protected lemma connected_component.«exists» {p : G.connected_component → Prop} : +protected lemma «exists» {p : G.connected_component → Prop} : (∃ (c : G.connected_component), p c) ↔ ∃ v, p (G.connected_component_mk v) := (surjective_quot_mk G.reachable).exists -protected lemma connected_component.«forall» {p : G.connected_component → Prop} : +protected lemma «forall» {p : G.connected_component → Prop} : (∀ (c : G.connected_component), p c) ↔ ∀ v, p (G.connected_component_mk v) := (surjective_quot_mk G.reachable).forall -lemma preconnected.subsingleton_connected_component (h : G.preconnected) : +lemma _root_.simple_graph.preconnected.subsingleton_connected_component (h : G.preconnected) : subsingleton G.connected_component := ⟨connected_component.ind₂ (λ v w, connected_component.sound (h v w))⟩ +/-- The map on connected components induced by a graph homomorphism. -/ +def map (φ : G →g G') (C : G.connected_component) : G'.connected_component := +C.lift (λ v, G'.connected_component_mk (φ v)) $ λ v w p _, + connected_component.eq.mpr (p.map φ).reachable + +@[simp] lemma map_mk (φ : G →g G') (v : V) : + (G.connected_component_mk v).map φ = G'.connected_component_mk (φ v) := rfl + +@[simp] lemma map_id (C : connected_component G) : C.map hom.id = C := +by { refine C.ind _, exact (λ _, rfl) } + +@[simp] lemma map_comp (C : G.connected_component) + (φ : G →g G') (ψ : G' →g G'') : (C.map φ).map ψ = C.map (ψ.comp φ) := +by { refine C.ind _, exact (λ _, rfl), } + + +variables {φ : G ≃g G'} {v : V} {v' : V'} + +@[simp] lemma iso_image_comp_eq_map_iff_eq_comp + {C : G.connected_component} : + G'.connected_component_mk (φ v) = C.map (↑(↑φ : G ↪g G')) ↔ (G.connected_component_mk v) = C := +begin + refine C.ind (λ u, _), + simp only [iso.reachable_iff, connected_component.map_mk, + rel_embedding.coe_coe_fn, rel_iso.coe_coe_fn, connected_component.eq], +end + +@[simp] lemma iso_inv_image_comp_eq_iff_eq_map + {C : G.connected_component} : + G.connected_component_mk (φ.symm v') = C ↔ + G'.connected_component_mk v' = C.map φ := +begin + refine C.ind (λ u, _), + simp only [iso.symm_apply_reachable, connected_component.eq, coe_coe, + connected_component.map_mk, rel_embedding.coe_coe_fn, rel_iso.coe_coe_fn], +end + end connected_component -variables {G} +namespace iso + +/-- An isomorphism of graphs induces a bijection of connected components. -/ +@[simps] +def connected_component_equiv (φ : G ≃g G') : G.connected_component ≃ G'.connected_component := +{ to_fun := connected_component.map φ, + inv_fun := connected_component.map φ.symm, + left_inv := λ C, connected_component.ind + (λ v, congr_arg (G.connected_component_mk) (equiv.left_inv φ.to_equiv v)) C, + right_inv := λ C, connected_component.ind + (λ v, congr_arg (G'.connected_component_mk) (equiv.right_inv φ.to_equiv v)) C } + +@[simp] lemma connected_component_equiv_refl : + (iso.refl : G ≃g G).connected_component_equiv = equiv.refl _ := +by { ext ⟨v⟩, refl, } + +@[simp] lemma connected_component_equiv_symm (φ : G ≃g G') : + φ.symm.connected_component_equiv = φ.connected_component_equiv.symm := by { ext ⟨_⟩, refl, } + +@[simp] lemma connected_component_equiv_trans (φ : G ≃g G') (φ' : G' ≃g G'') : + connected_component_equiv (φ.trans φ') = + φ.connected_component_equiv.trans φ'.connected_component_equiv := by { ext ⟨_⟩, refl, } + +end iso + +namespace connected_component + +/-- The set of vertices in a connected component of a graph. -/ +def supp (C : G.connected_component) := + { v | G.connected_component_mk v = C } + +@[ext] lemma supp_injective : + function.injective (connected_component.supp : G.connected_component → set V) := +begin + refine connected_component.ind₂ _, + intros v w, + simp only [connected_component.supp, set.ext_iff, connected_component.eq, set.mem_set_of_eq], + intro h, + rw [reachable_comm, h], +end + +@[simp] +lemma supp_inj {C D : G.connected_component} : C.supp = D.supp ↔ C = D := +connected_component.supp_injective.eq_iff + +instance : set_like G.connected_component V := +{ coe := connected_component.supp, + coe_injective' := connected_component.supp_injective, } + +@[simp] lemma mem_supp_iff (C : G.connected_component) (v : V) : + v ∈ C.supp ↔ G.connected_component_mk v = C := iff.rfl + +lemma connected_component_mk_mem {v : V} : + v ∈ G.connected_component_mk v := by exact rfl + +/-- +The equivalence between connected components, induced by an isomorphism of graphs, +itself defines an equivalence on the supports of each connected component. +-/ +def iso_equiv_supp (φ : G ≃g G') (C : G.connected_component) : + C.supp ≃ (φ.connected_component_equiv C).supp := +{ to_fun := λ v, ⟨φ v, connected_component.iso_image_comp_eq_map_iff_eq_comp.mpr v.prop⟩, + inv_fun := λ v', ⟨φ.symm v', connected_component.iso_inv_image_comp_eq_iff_eq_map.mpr v'.prop⟩, + left_inv := λ v, subtype.ext_val (φ.to_equiv.left_inv ↑v), + right_inv := λ v, subtype.ext_val (φ.to_equiv.right_inv ↑v), } + +end connected_component /-- A subgraph is connected if it is connected as a simple graph. -/ abbreviation subgraph.connected (H : G.subgraph) : Prop := H.coe.connected +lemma singleton_subgraph_connected {v : V} : (G.singleton_subgraph v).connected := +begin + split, + rintros ⟨a, ha⟩ ⟨b, hb⟩, + simp only [singleton_subgraph_verts, set.mem_singleton_iff] at ha hb, + subst_vars +end + +@[simp] lemma subgraph_of_adj_connected {v w : V} (hvw : G.adj v w) : + (G.subgraph_of_adj hvw).connected := +begin + split, + rintro ⟨a, ha⟩ ⟨b, hb⟩, + simp only [subgraph_of_adj_verts, set.mem_insert_iff, set.mem_singleton_iff] at ha hb, + obtain (rfl|rfl) := ha; obtain (rfl|rfl) := hb; + refl <|> { apply adj.reachable, simp }, +end + lemma preconnected.set_univ_walk_nonempty (hconn : G.preconnected) (u v : V) : (set.univ : set (G.walk u v)).nonempty := by { rw ← set.nonempty_iff_univ_nonempty, exact hconn u v } @@ -1063,6 +1774,77 @@ by { rw ← set.nonempty_iff_univ_nonempty, exact hconn u v } lemma connected.set_univ_walk_nonempty (hconn : G.connected) (u v : V) : (set.univ : set (G.walk u v)).nonempty := hconn.preconnected.set_univ_walk_nonempty u v +/-! ### Walks as subgraphs -/ + +namespace walk +variables {G G'} {u v w : V} + +/-- The subgraph consisting of the vertices and edges of the walk. -/ +@[simp] protected def to_subgraph : Π {u v : V}, G.walk u v → G.subgraph +| u _ nil := G.singleton_subgraph u +| _ _ (cons h p) := G.subgraph_of_adj h ⊔ p.to_subgraph + +lemma to_subgraph_cons_nil_eq_subgraph_of_adj (h : G.adj u v) : + (cons h nil).to_subgraph = G.subgraph_of_adj h := +by simp + +lemma mem_verts_to_subgraph (p : G.walk u v) : + w ∈ p.to_subgraph.verts ↔ w ∈ p.support := +begin + induction p with _ x y z h p' ih, + { simp }, + { have : w = y ∨ w ∈ p'.support ↔ w ∈ p'.support := + ⟨by rintro (rfl | h); simp [*], by simp { contextual := tt}⟩, + simp [ih, or_assoc, this] } +end + +@[simp] lemma verts_to_subgraph (p : G.walk u v) : p.to_subgraph.verts = {w | w ∈ p.support} := +set.ext (λ _, p.mem_verts_to_subgraph) + +lemma mem_edges_to_subgraph (p : G.walk u v) {e : sym2 V} : + e ∈ p.to_subgraph.edge_set ↔ e ∈ p.edges := +by induction p; simp [*] + +@[simp] lemma edge_set_to_subgraph (p : G.walk u v) : p.to_subgraph.edge_set = {e | e ∈ p.edges} := +set.ext (λ _, p.mem_edges_to_subgraph) + +@[simp] lemma to_subgraph_append (p : G.walk u v) (q : G.walk v w) : + (p.append q).to_subgraph = p.to_subgraph ⊔ q.to_subgraph := +by induction p; simp [*, sup_assoc] + +@[simp] lemma to_subgraph_reverse (p : G.walk u v) : + p.reverse.to_subgraph = p.to_subgraph := +begin + induction p, + { simp }, + { simp only [*, walk.to_subgraph, reverse_cons, to_subgraph_append, subgraph_of_adj_symm], + rw [sup_comm], + congr, + ext; simp [-set.bot_eq_empty], } +end + +@[simp] lemma to_subgraph_rotate [decidable_eq V] (c : G.walk v v) (h : u ∈ c.support) : + (c.rotate h).to_subgraph = c.to_subgraph := +by rw [rotate, to_subgraph_append, sup_comm, ← to_subgraph_append, take_spec] + +@[simp] lemma to_subgraph_map (f : G →g G') (p : G.walk u v) : + (p.map f).to_subgraph = p.to_subgraph.map f := +by induction p; simp [*, subgraph.map_sup] + +@[simp] lemma finite_neighbor_set_to_subgraph (p : G.walk u v) : + (p.to_subgraph.neighbor_set w).finite := +begin + induction p, + { rw [walk.to_subgraph, neighbor_set_singleton_subgraph], + apply set.to_finite, }, + { rw [walk.to_subgraph, subgraph.neighbor_set_sup], + refine set.finite.union _ p_ih, + refine set.finite.subset _ (neighbor_set_subgraph_of_adj_subset p_h), + apply set.to_finite, }, +end + +end walk + /-! ### Walks of a given length -/ section walk_counting @@ -1075,7 +1857,7 @@ lemma set_walk_length_zero_eq_of_ne {u v : V} (h : u ≠ v) : {p : G.walk u v | p.length = 0} = ∅ := begin ext p, - simp only [set.mem_set_of_eq, set.mem_empty_eq, iff_false], + simp only [set.mem_set_of_eq, set.mem_empty_iff_false, iff_false], exact λ h', absurd (walk.eq_of_length_eq_zero h') h, end @@ -1095,7 +1877,10 @@ begin refl, } }, end -variables (G) [fintype V] [decidable_rel G.adj] [decidable_eq V] +variables (G) [decidable_eq V] + +section locally_finite +variables [locally_finite G] /-- The `finset` of length-`n` walks from `u` to `v`. This is used to give `{p : G.walk u v | p.length = n}` a `fintype` instance, and it @@ -1107,10 +1892,8 @@ def finset_walk_length : Π (n : ℕ) (u v : V), finset (G.walk u v) | 0 u v := if h : u = v then by { subst u, exact {walk.nil} } else ∅ -| (n+1) u v := finset.univ.bUnion (λ (w : V), - if h : G.adj u w - then (finset_walk_length n w v).map ⟨λ p, walk.cons h p, λ p q, by simp⟩ - else ∅) +| (n+1) u v := finset.univ.bUnion (λ (w : G.neighbor_set u), + (finset_walk_length n w v).map ⟨λ p, walk.cons w.property p, λ p q, by simp⟩) lemma coe_finset_walk_length_eq (n : ℕ) (u v : V) : (G.finset_walk_length n u v : set (G.walk u v)) = {p : G.walk u v | p.length = n} := @@ -1121,23 +1904,27 @@ begin { simp only [finset_walk_length, set_walk_length_succ_eq, finset.coe_bUnion, finset.mem_coe, finset.mem_univ, set.Union_true], ext p, - simp only [set.mem_Union, finset.mem_coe, set.mem_image, set.mem_set_of_eq], - congr' 2, - ext w, - simp only [set.ext_iff, finset.mem_coe, set.mem_set_of_eq] at ih, - split_ifs with huw; simp [huw, ih], }, + simp only [mem_neighbor_set, finset.coe_map, embedding.coe_fn_mk, set.Union_coe_set, + set.mem_Union, set.mem_image, finset.mem_coe, set.mem_set_of_eq], + congr' with w, + congr' with h, + congr' with q, + have := set.ext_iff.mp (ih w v) q, + simp only [finset.mem_coe, set.mem_set_of_eq] at this, + rw ← this, + refl, }, end variables {G} -lemma walk.length_eq_of_mem_finset_walk_length {n : ℕ} {u v : V} (p : G.walk u v) : - p ∈ G.finset_walk_length n u v → p.length = n := -(set.ext_iff.mp (G.coe_finset_walk_length_eq n u v) p).mp +lemma walk.mem_finset_walk_length_iff_length_eq {n : ℕ} {u v : V} (p : G.walk u v) : + p ∈ G.finset_walk_length n u v ↔ p.length = n := +set.ext_iff.mp (G.coe_finset_walk_length_eq n u v) p variables (G) instance fintype_set_walk_length (u v : V) (n : ℕ) : fintype {p : G.walk u v | p.length = n} := -fintype.subtype (G.finset_walk_length n u v) $ λ p, +fintype.of_finset (G.finset_walk_length n u v) $ λ p, by rw [←finset.mem_coe, coe_finset_walk_length_eq] lemma set_walk_length_to_finset_eq (n : ℕ) (u v : V) : @@ -1148,9 +1935,165 @@ by { ext p, simp [←coe_finset_walk_length_eq] } power of the adjacency matrix. -/ lemma card_set_walk_length_eq (u v : V) (n : ℕ) : fintype.card {p : G.walk u v | p.length = n} = (G.finset_walk_length n u v).card := -fintype.card_of_subtype (G.finset_walk_length n u v) $ λ p, -by rw [←finset.mem_coe, coe_finset_walk_length_eq] +fintype.card_of_finset (G.finset_walk_length n u v) $ λ p, + by rw [←finset.mem_coe, coe_finset_walk_length_eq] + +instance fintype_set_path_length (u v : V) (n : ℕ) : + fintype {p : G.walk u v | p.is_path ∧ p.length = n} := +fintype.of_finset ((G.finset_walk_length n u v).filter walk.is_path) $ + by simp [walk.mem_finset_walk_length_iff_length_eq, and_comm] + +end locally_finite + +section finite +variables [fintype V] [decidable_rel G.adj] + +lemma reachable_iff_exists_finset_walk_length_nonempty (u v : V) : + G.reachable u v ↔ ∃ (n : fin (fintype.card V)), (G.finset_walk_length n u v).nonempty := +begin + split, + { intro r, + refine r.elim_path (λ p, _), + refine ⟨⟨_, p.is_path.length_lt⟩, p, _⟩, + simp [walk.mem_finset_walk_length_iff_length_eq], }, + { rintro ⟨_, p, _⟩, use p }, +end + +instance : decidable_rel G.reachable := +λ u v, decidable_of_iff' _ (reachable_iff_exists_finset_walk_length_nonempty G u v) + +instance : fintype G.connected_component := +@quotient.fintype _ _ G.reachable_setoid (infer_instance : decidable_rel G.reachable) + +instance : decidable G.preconnected := +by { unfold preconnected, apply_instance } + +instance : decidable G.connected := +by { rw [connected_iff, ← finset.univ_nonempty_iff], exact and.decidable } + +end finite end walk_counting +section bridge_edges + +/-! ### Bridge edges -/ + +/-- An edge of a graph is a *bridge* if, after removing it, its incident vertices +are no longer reachable from one another. -/ +def is_bridge (G : simple_graph V) (e : sym2 V) : Prop := +e ∈ G.edge_set ∧ +sym2.lift ⟨λ v w, ¬ (G \ from_edge_set {e}).reachable v w, by simp [reachable_comm]⟩ e + +lemma is_bridge_iff {u v : V} : + G.is_bridge ⟦(u, v)⟧ ↔ G.adj u v ∧ ¬ (G \ from_edge_set {⟦(u, v)⟧}).reachable u v := iff.rfl + +lemma reachable_delete_edges_iff_exists_walk {v w : V} : + (G \ from_edge_set {⟦(v, w)⟧}).reachable v w ↔ ∃ (p : G.walk v w), ¬ ⟦(v, w)⟧ ∈ p.edges := +begin + split, + { rintro ⟨p⟩, + use p.map (hom.map_spanning_subgraphs (by simp)), + simp_rw [walk.edges_map, list.mem_map, hom.map_spanning_subgraphs_apply, sym2.map_id', id.def], + rintro ⟨e, h, rfl⟩, + simpa using p.edges_subset_edge_set h, }, + { rintro ⟨p, h⟩, + refine ⟨p.transfer _ (λ e ep, _)⟩, + simp only [edge_set_sdiff, edge_set_from_edge_set, edge_set_sdiff_sdiff_is_diag, + set.mem_diff, set.mem_singleton_iff], + exact ⟨p.edges_subset_edge_set ep, λ h', h (h' ▸ ep)⟩, }, +end + +lemma is_bridge_iff_adj_and_forall_walk_mem_edges {v w : V} : + G.is_bridge ⟦(v, w)⟧ ↔ G.adj v w ∧ ∀ (p : G.walk v w), ⟦(v, w)⟧ ∈ p.edges := +begin + rw [is_bridge_iff, and_congr_right'], + rw [reachable_delete_edges_iff_exists_walk, not_exists_not], +end + +lemma reachable_delete_edges_iff_exists_cycle.aux [decidable_eq V] + {u v w : V} + (hb : ∀ (p : G.walk v w), ⟦(v, w)⟧ ∈ p.edges) + (c : G.walk u u) + (hc : c.is_trail) + (he : ⟦(v, w)⟧ ∈ c.edges) + (hw : w ∈ (c.take_until v (c.fst_mem_support_of_mem_edges he)).support) : + false := +begin + have hv := c.fst_mem_support_of_mem_edges he, + -- decompose c into + -- puw pwv pvu + -- u ----> w ----> v ----> u + let puw := (c.take_until v hv).take_until w hw, + let pwv := (c.take_until v hv).drop_until w hw, + let pvu := c.drop_until v hv, + have : c = (puw.append pwv).append pvu := by simp, + -- We have two walks from v to w + -- pvu puw + -- v ----> u ----> w + -- | ^ + -- `-------------' + -- pwv.reverse + -- so they both contain the edge ⟦(v, w)⟧, but that's a contradiction since c is a trail. + have hbq := hb (pvu.append puw), + have hpq' := hb pwv.reverse, + rw [walk.edges_reverse, list.mem_reverse] at hpq', + rw [walk.is_trail_def, this, walk.edges_append, walk.edges_append, + list.nodup_append_comm, ← list.append_assoc, ← walk.edges_append] at hc, + exact list.disjoint_of_nodup_append hc hbq hpq', +end + +lemma adj_and_reachable_delete_edges_iff_exists_cycle {v w : V} : + G.adj v w ∧ (G \ from_edge_set {⟦(v, w)⟧}).reachable v w ↔ + ∃ (u : V) (p : G.walk u u), p.is_cycle ∧ ⟦(v, w)⟧ ∈ p.edges := +begin + classical, + rw reachable_delete_edges_iff_exists_walk, + split, + { rintro ⟨h, p, hp⟩, + refine ⟨w, walk.cons h.symm p.to_path, _, _⟩, + { apply path.cons_is_cycle, + rw [sym2.eq_swap], + intro h, + exact absurd (walk.edges_to_path_subset p h) hp, }, + simp only [sym2.eq_swap, walk.edges_cons, list.mem_cons_iff, eq_self_iff_true, true_or], }, + { rintro ⟨u, c, hc, he⟩, + have hvc : v ∈ c.support := walk.fst_mem_support_of_mem_edges c he, + have hwc : w ∈ c.support := walk.snd_mem_support_of_mem_edges c he, + let puv := c.take_until v hvc, + let pvu := c.drop_until v hvc, + obtain (hw | hw') : w ∈ puv.support ∨ w ∈ pvu.support, + { rwa [← walk.mem_support_append_iff, walk.take_spec] }, + { by_contra' h, + specialize h (c.adj_of_mem_edges he), + exact reachable_delete_edges_iff_exists_cycle.aux h c hc.to_trail he hw, }, + { by_contra' hb, + specialize hb (c.adj_of_mem_edges he), + have hb' : ∀ (p : G.walk w v), ⟦(w, v)⟧ ∈ p.edges, + { intro p, + simpa [sym2.eq_swap] using hb p.reverse, }, + apply reachable_delete_edges_iff_exists_cycle.aux hb' (pvu.append puv) + (hc.to_trail.rotate hvc) _ (walk.start_mem_support _), + rwa [walk.edges_append, list.mem_append, or_comm, ← list.mem_append, + ← walk.edges_append, walk.take_spec, sym2.eq_swap], } }, +end + +lemma is_bridge_iff_adj_and_forall_cycle_not_mem {v w : V} : + G.is_bridge ⟦(v, w)⟧ ↔ G.adj v w ∧ ∀ ⦃u : V⦄ (p : G.walk u u), p.is_cycle → ⟦(v, w)⟧ ∉ p.edges := +begin + rw [is_bridge_iff, and.congr_right_iff], + intro h, + rw ← not_iff_not, + push_neg, + rw ← adj_and_reachable_delete_edges_iff_exists_cycle, + simp only [h, true_and], +end + +lemma is_bridge_iff_mem_and_forall_cycle_not_mem {e : sym2 V} : + G.is_bridge e ↔ e ∈ G.edge_set ∧ ∀ ⦃u : V⦄ (p : G.walk u u), p.is_cycle → e ∉ p.edges := +sym2.ind (λ v w, is_bridge_iff_adj_and_forall_cycle_not_mem) e + +end bridge_edges + end simple_graph + diff --git a/src/combinatorics/simple_graph/degree_sum.lean b/src/combinatorics/simple_graph/degree_sum.lean index 795ded7bb0f87..06e9a8e6aa42e 100644 --- a/src/combinatorics/simple_graph/degree_sum.lean +++ b/src/combinatorics/simple_graph/degree_sum.lean @@ -11,6 +11,9 @@ import data.zmod.parity /-! # Degree-sum formula and handshaking lemma +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The degree-sum formula is that the sum of the degrees of the vertices in a finite graph is equal to twice the number of edges. The handshaking lemma, a corollary, is that the number of odd-degree vertices is even. @@ -119,8 +122,7 @@ begin rw ←zmod.eq_zero_iff_even, convert h, ext v, - rw ←zmod.ne_zero_iff_odd, - congr' }, + rw ←zmod.ne_zero_iff_odd, }, { intros v, simp only [true_and, mem_filter, mem_univ, ne.def], rw [zmod.eq_zero_iff_even, zmod.eq_one_iff_odd, nat.odd_iff_not_even, imp_self], diff --git a/src/combinatorics/simple_graph/density.lean b/src/combinatorics/simple_graph/density.lean index 16999a6634677..bf9bf9dfb761b 100644 --- a/src/combinatorics/simple_graph/density.lean +++ b/src/combinatorics/simple_graph/density.lean @@ -5,10 +5,14 @@ Authors: Yaël Dillies, Bhavik Mehta -/ import combinatorics.simple_graph.basic import order.partition.finpartition +import tactic.positivity /-! # Edge density +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the number and density of edges of a relation/graph. ## Main declarations @@ -21,19 +25,19 @@ Between two finsets of vertices, -/ open finset +open_locale big_operators -variables {ι κ α β : Type*} +variables {𝕜 ι κ α β : Type*} /-! ### Density of a relation -/ namespace rel section asymmetric -variables (r : α → β → Prop) [Π a, decidable_pred (r a)] {s s₁ s₂ : finset α} {t t₁ t₂ : finset β} - {a : α} {b : β} +variables [linear_ordered_field 𝕜] (r : α → β → Prop) [Π a, decidable_pred (r a)] + {s s₁ s₂ : finset α} {t t₁ t₂ : finset β} {a : α} {b : β} {δ : 𝕜} /-- Finset of edges of a relation between two finsets of vertices. -/ -def interedges (s : finset α) (t : finset β) : finset (α × β) := -(s.product t).filter $ λ e, r e.1 e.2 +def interedges (s : finset α) (t : finset β) : finset (α × β) := (s ×ˢ t).filter $ λ e, r e.1 e.2 /-- Edge density of a relation between two finsets of vertices. -/ def edge_density (s : finset α) (t : finset β) : ℚ := (interedges r s t).card / (s.card * t.card) @@ -62,25 +66,27 @@ begin convert disjoint_filter.2 (λ x _, not_not.2), end -section decidable_eq -variables [decidable_eq α] [decidable_eq β] - lemma interedges_disjoint_left {s s' : finset α} (hs : disjoint s s') (t : finset β) : disjoint (interedges r s t) (interedges r s' t) := begin - rintro x hx, - rw [inf_eq_inter, mem_inter, mem_interedges_iff, mem_interedges_iff] at hx, - exact hs (mem_inter.2 ⟨hx.1.1, hx.2.1⟩), + rw finset.disjoint_left at ⊢ hs, + rintro x hx hy, + rw [mem_interedges_iff] at hx hy, + exact hs hx.1 hy.1, end lemma interedges_disjoint_right (s : finset α) {t t' : finset β} (ht : disjoint t t') : disjoint (interedges r s t) (interedges r s t') := begin - rintro x hx, - rw [inf_eq_inter, mem_inter, mem_interedges_iff, mem_interedges_iff] at hx, - exact ht (mem_inter.2 ⟨hx.1.2.1, hx.2.2.1⟩), + rw finset.disjoint_left at ⊢ ht, + rintro x hx hy, + rw [mem_interedges_iff] at hx hy, + exact ht hx.2.1 hy.2.1, end +section decidable_eq +variables [decidable_eq α] [decidable_eq β] + lemma interedges_bUnion_left (s : finset ι) (t : finset β) (f : ι → finset α) : interedges r (s.bUnion f) t = s.bUnion (λ a, interedges r (f a) t) := ext $ λ a, by simp only [mem_bUnion, mem_interedges_iff, exists_and_distrib_right] @@ -92,7 +98,7 @@ ext $ λ a, by simp only [mem_interedges_iff, mem_bUnion, ←exists_and_distrib_ lemma interedges_bUnion (s : finset ι) (t : finset κ) (f : ι → finset α) (g : κ → finset β) : interedges r (s.bUnion f) (t.bUnion g) = - (s.product t).bUnion (λ ab, interedges r (f ab.1) (g ab.2)) := + (s ×ˢ t).bUnion (λ ab, interedges r (f ab.1) (g ab.2)) := by simp_rw [product_bUnion, interedges_bUnion_left, interedges_bUnion_right] end decidable_eq @@ -122,6 +128,110 @@ by rw [edge_density, finset.card_empty, nat.cast_zero, zero_mul, div_zero] @[simp] lemma edge_density_empty_right (s : finset α) : edge_density r s ∅ = 0 := by rw [edge_density, finset.card_empty, nat.cast_zero, mul_zero, div_zero] +lemma card_interedges_finpartition_left [decidable_eq α] (P : finpartition s) (t : finset β) : + (interedges r s t).card = ∑ a in P.parts, (interedges r a t).card := +begin + classical, + simp_rw [←P.bUnion_parts, interedges_bUnion_left, id.def], + rw card_bUnion, + exact λ x hx y hy h, interedges_disjoint_left r (P.disjoint hx hy h) _, +end + +lemma card_interedges_finpartition_right [decidable_eq β] (s : finset α) (P : finpartition t) : + (interedges r s t).card = ∑ b in P.parts, (interedges r s b).card := +begin + classical, + simp_rw [←P.bUnion_parts, interedges_bUnion_right, id], + rw card_bUnion, + exact λ x hx y hy h, interedges_disjoint_right r _ (P.disjoint hx hy h), +end + +lemma card_interedges_finpartition [decidable_eq α] [decidable_eq β] (P : finpartition s) + (Q : finpartition t) : + (interedges r s t).card = ∑ ab in P.parts ×ˢ Q.parts, (interedges r ab.1 ab.2).card := +by simp_rw [card_interedges_finpartition_left _ P, card_interedges_finpartition_right _ _ Q, + sum_product] + +lemma mul_edge_density_le_edge_density (hs : s₂ ⊆ s₁) (ht : t₂ ⊆ t₁) (hs₂ : s₂.nonempty) + (ht₂ : t₂.nonempty) : + (s₂.card : ℚ)/s₁.card * (t₂.card/t₁.card) * edge_density r s₂ t₂ ≤ edge_density r s₁ t₁ := +begin + have hst : (s₂.card : ℚ) * t₂.card ≠ 0 := by simp [hs₂.ne_empty, ht₂.ne_empty], + rw [edge_density, edge_density, div_mul_div_comm, mul_comm, div_mul_div_cancel _ hst], + refine div_le_div_of_le (by exact_mod_cast (s₁.card * t₁.card).zero_le) _, + exact_mod_cast card_le_of_subset (interedges_mono hs ht), +end + +lemma edge_density_sub_edge_density_le_one_sub_mul (hs : s₂ ⊆ s₁) (ht : t₂ ⊆ t₁) (hs₂ : s₂.nonempty) + (ht₂ : t₂.nonempty) : + edge_density r s₂ t₂ - edge_density r s₁ t₁ ≤ 1 - (s₂.card)/s₁.card * (t₂.card/t₁.card) := +begin + refine (sub_le_sub_left (mul_edge_density_le_edge_density r hs ht hs₂ ht₂) _).trans _, + refine le_trans _ (mul_le_of_le_one_right _ (edge_density_le_one r s₂ t₂)), + { rw [sub_mul, one_mul] }, + refine sub_nonneg_of_le (mul_le_one _ (by positivity) _); + exact div_le_one_of_le (nat.cast_le.2 (card_le_of_subset ‹_›)) (nat.cast_nonneg _), +end + +lemma abs_edge_density_sub_edge_density_le_one_sub_mul (hs : s₂ ⊆ s₁) (ht : t₂ ⊆ t₁) + (hs₂ : s₂.nonempty) (ht₂ : t₂.nonempty) : + |edge_density r s₂ t₂ - edge_density r s₁ t₁| ≤ 1 - s₂.card/s₁.card * (t₂.card/t₁.card) := +begin + have habs : abs (edge_density r s₂ t₂ - edge_density r s₁ t₁) ≤ 1, + { rw [abs_sub_le_iff, ←sub_zero (1 : ℚ)], + split; exact sub_le_sub (edge_density_le_one r _ _) (edge_density_nonneg r _ _) }, + refine abs_sub_le_iff.2 ⟨edge_density_sub_edge_density_le_one_sub_mul r hs ht hs₂ ht₂, _⟩, + rw [←add_sub_cancel (edge_density r s₁ t₁) (edge_density (λ x y, ¬r x y) s₁ t₁), + ←add_sub_cancel (edge_density r s₂ t₂) (edge_density (λ x y, ¬r x y) s₂ t₂), + edge_density_add_edge_density_compl _ (hs₂.mono hs) (ht₂.mono ht), + edge_density_add_edge_density_compl _ hs₂ ht₂, sub_sub_sub_cancel_left], + exact edge_density_sub_edge_density_le_one_sub_mul _ hs ht hs₂ ht₂, +end + +lemma abs_edge_density_sub_edge_density_le_two_mul_sub_sq (hs : s₂ ⊆ s₁) (ht : t₂ ⊆ t₁) + (hδ₀ : 0 ≤ δ) (hδ₁ : δ < 1) (hs₂ : (1 - δ) * s₁.card ≤ s₂.card) + (ht₂ : (1 - δ) * t₁.card ≤ t₂.card) : + |(edge_density r s₂ t₂ : 𝕜) - edge_density r s₁ t₁| ≤ 2*δ - δ^2 := +begin + have hδ' : 0 ≤ 2 * δ - δ ^ 2, + { rw [sub_nonneg, sq], + exact mul_le_mul_of_nonneg_right (hδ₁.le.trans (by norm_num)) hδ₀ }, + rw ←sub_pos at hδ₁, + obtain rfl | hs₂' := s₂.eq_empty_or_nonempty, + { rw [finset.card_empty, nat.cast_zero] at hs₂, + simpa [edge_density, (nonpos_of_mul_nonpos_right hs₂ hδ₁).antisymm (nat.cast_nonneg _)] + using hδ' }, + obtain rfl | ht₂' := t₂.eq_empty_or_nonempty, + { rw [finset.card_empty, nat.cast_zero] at ht₂, + simpa [edge_density, (nonpos_of_mul_nonpos_right ht₂ hδ₁).antisymm (nat.cast_nonneg _)] + using hδ' }, + rw [show 2 * δ - δ ^ 2 = 1 - (1 - δ) * (1 - δ), by ring], + norm_cast, + refine (rat.cast_le.2 $ + abs_edge_density_sub_edge_density_le_one_sub_mul r hs ht hs₂' ht₂').trans _, + push_cast, + have := hs₂'.mono hs, + have := ht₂'.mono ht, + refine sub_le_sub_left (mul_le_mul ((le_div_iff _).2 hs₂) ((le_div_iff _).2 ht₂) hδ₁.le _) _; + positivity, +end + +/-- If `s₂ ⊆ s₁`, `t₂ ⊆ t₁` and they take up all but a `δ`-proportion, then the difference in edge +densities is at most `2 * δ`. -/ +lemma abs_edge_density_sub_edge_density_le_two_mul (hs : s₂ ⊆ s₁) (ht : t₂ ⊆ t₁) (hδ : 0 ≤ δ) + (hscard : (1 - δ) * s₁.card ≤ s₂.card) (htcard : (1 - δ) * t₁.card ≤ t₂.card) : + |(edge_density r s₂ t₂ : 𝕜) - edge_density r s₁ t₁| ≤ 2 * δ := +begin + cases lt_or_le δ 1, + { exact (abs_edge_density_sub_edge_density_le_two_mul_sub_sq r hs ht hδ h hscard htcard).trans + ((sub_le_self_iff _).2 $ sq_nonneg δ) }, + rw two_mul, + refine (abs_sub _ _).trans (add_le_add (le_trans _ h) (le_trans _ h)); + { rw abs_of_nonneg, + exact_mod_cast edge_density_le_one r _ _, + exact_mod_cast edge_density_nonneg r _ _ } +end + end asymmetric section symmetric @@ -161,7 +271,7 @@ def interedges (s t : finset α) : finset (α × α) := interedges G.adj s t def edge_density : finset α → finset α → ℚ := edge_density G.adj lemma interedges_def (s t : finset α) : - G.interedges s t = (s.product t).filter (λ e, G.adj e.1 e.2) := rfl + G.interedges s t = (s ×ˢ t).filter (λ e, G.adj e.1 e.2) := rfl lemma edge_density_def (s t : finset α) : G.edge_density s t = (G.interedges s t).card / (s.card * t.card) := rfl @@ -180,9 +290,6 @@ mk_mem_interedges_iff lemma interedges_mono : s₂ ⊆ s₁ → t₂ ⊆ t₁ → G.interedges s₂ t₂ ⊆ G.interedges s₁ t₁ := interedges_mono -section decidable_eq -variables [decidable_eq α] - lemma interedges_disjoint_left (hs : disjoint s₁ s₂) (t : finset α) : disjoint (G.interedges s₁ t) (G.interedges s₂ t) := interedges_disjoint_left _ hs _ @@ -191,6 +298,9 @@ lemma interedges_disjoint_right (s : finset α) (ht : disjoint t₁ t₂) : disjoint (G.interedges s t₁) (G.interedges s t₂) := interedges_disjoint_right _ _ ht +section decidable_eq +variables [decidable_eq α] + lemma interedges_bUnion_left (s : finset ι) (t : finset α) (f : ι → finset α) : G.interedges (s.bUnion f) t = s.bUnion (λ a, G.interedges (f a) t) := interedges_bUnion_left _ _ _ _ @@ -201,14 +311,14 @@ interedges_bUnion_right _ _ _ _ lemma interedges_bUnion (s : finset ι) (t : finset κ) (f : ι → finset α) (g : κ → finset α) : G.interedges (s.bUnion f) (t.bUnion g) = - (s.product t).bUnion (λ ab, G.interedges (f ab.1) (g ab.2)) := + (s ×ˢ t).bUnion (λ ab, G.interedges (f ab.1) (g ab.2)) := interedges_bUnion _ _ _ _ _ lemma card_interedges_add_card_interedges_compl (h : disjoint s t) : (G.interedges s t).card + (Gᶜ.interedges s t).card = s.card * t.card := begin rw [←card_product, interedges_def, interedges_def], - have : (s.product t).filter (λ e , Gᶜ.adj e.1 e.2) = (s.product t).filter (λ e , ¬ G.adj e.1 e.2), + have : (s ×ˢ t).filter (λ e , Gᶜ.adj e.1 e.2) = (s ×ˢ t).filter (λ e , ¬ G.adj e.1 e.2), { refine filter_congr (λ x hx, _), rw mem_product at hx, rw [compl_adj, and_iff_right (h.forall_ne_finset hx.1 hx.2)] }, @@ -221,7 +331,7 @@ lemma edge_density_add_edge_density_compl (hs : s.nonempty) (ht : t.nonempty) (h begin rw [edge_density_def, edge_density_def, div_add_div_same, div_eq_one_iff_eq], { exact_mod_cast card_interedges_add_card_interedges_compl _ h }, - { exact_mod_cast (mul_pos hs.card_pos ht.card_pos).ne' } + { positivity } end end decidable_eq @@ -249,3 +359,19 @@ lemma edge_density_comm (s t : finset α) : G.edge_density s t = G.edge_density edge_density_comm G.symm s t end simple_graph + +namespace tactic +open positivity + +/-- Extension for the `positivity` tactic: `rel.edge_density` and `simple_graph.edge_density` are +always nonnegative. -/ +@[positivity] +meta def positivity_edge_density : expr → tactic strictness +| `(rel.edge_density %%r %%s %%t) := nonnegative <$> + mk_mapp ``rel.edge_density_nonneg [none, none, r, none, s, t] +| `(simple_graph.edge_density %%G %%s %%t) := nonnegative <$> + mk_mapp ``simple_graph.edge_density_nonneg [none, G, none, s, t] +| e := pp e >>= fail ∘ format.bracket "The expression `" + "` isn't of the form `rel.edge_density r s t` nor `simple_graph.edge_density G s t`" + +end tactic diff --git a/src/combinatorics/simple_graph/ends/defs.lean b/src/combinatorics/simple_graph/ends/defs.lean new file mode 100644 index 0000000000000..87889d5d0610f --- /dev/null +++ b/src/combinatorics/simple_graph/ends/defs.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2022 Anand Rao, Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anand Rao, Rémi Bottinelli +-/ +import category_theory.cofiltered_system +import combinatorics.simple_graph.connectivity +import data.set_like.basic + +/-! +# Ends + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains a definition of the ends of a simple graph, as sections of the inverse system +assigning, to each finite set of vertices, the connected components of its complement. +-/ + +universes u +variables {V : Type u} (G : simple_graph V) (K L L' M : set V) + +namespace simple_graph + +/-- The components outside a given set of vertices `K` -/ +@[reducible] def component_compl := (G.induce Kᶜ).connected_component + +variables {G} {K L M} + +/-- The connected component of `v` in `G.induce Kᶜ`. -/ +@[reducible] def component_compl_mk (G : simple_graph V) {v : V} (vK : v ∉ K) : + G.component_compl K := +connected_component_mk (G.induce Kᶜ) ⟨v, vK⟩ + +/-- The set of vertices of `G` making up the connected component `C` -/ +def component_compl.supp (C : G.component_compl K) : set V := +{v : V | ∃ h : v ∉ K, G.component_compl_mk h = C} + +@[ext] lemma component_compl.supp_injective : + function.injective (component_compl.supp : G.component_compl K → set V) := +begin + refine connected_component.ind₂ _, + rintros ⟨v, hv⟩ ⟨w, hw⟩ h, + simp only [set.ext_iff, connected_component.eq, set.mem_set_of_eq, component_compl.supp] at h ⊢, + exact ((h v).mp ⟨hv, reachable.refl _⟩).some_spec, +end + +lemma component_compl.supp_inj {C D : G.component_compl K} : C.supp = D.supp ↔ C = D := +component_compl.supp_injective.eq_iff + +instance component_compl.set_like : set_like (G.component_compl K) V := +{ coe := component_compl.supp, + coe_injective' := λ C D, (component_compl.supp_inj).mp, } + +@[simp] lemma component_compl.mem_supp_iff {v : V} {C : component_compl G K} : + v ∈ C ↔ ∃ (vK : v ∉ K), G.component_compl_mk vK = C := iff.rfl + +lemma component_compl_mk_mem (G : simple_graph V) {v : V} (vK : v ∉ K) : + v ∈ G.component_compl_mk vK := ⟨vK, rfl⟩ + +lemma component_compl_mk_eq_of_adj (G : simple_graph V) {v w : V} (vK : v ∉ K) (wK : w ∉ K) + (a : G.adj v w) : G.component_compl_mk vK = G.component_compl_mk wK := +by { rw [connected_component.eq], apply adj.reachable, exact a } + +namespace component_compl + +/-- +A `component_compl` specialization of `quot.lift`, where soundness has to be proved only +for adjacent vertices. +-/ +protected def lift {β : Sort*} (f : ∀ ⦃v⦄ (hv : v ∉ K), β) + (h : ∀ ⦃v w⦄ (hv : v ∉ K) (hw : w ∉ K) (a : G.adj v w), f hv = f hw) : G.component_compl K → β := +connected_component.lift (λ vv, f vv.prop) $ (λ v w p, by + { induction p with _ u v w a q ih, + { rintro _, refl, }, + { rintro h', exact (h u.prop v.prop a).trans (ih h'.of_cons), } }) + +protected lemma ind {β : G.component_compl K → Prop} + (f : ∀ ⦃v⦄ (hv : v ∉ K), β (G.component_compl_mk hv)) : ∀ (C : G.component_compl K), β C := by +{ apply connected_component.ind, exact λ ⟨v, vnK⟩, f vnK, } + +/-- The induced graph on the vertices `C`. -/ +@[reducible] +protected def coe_graph (C : component_compl G K) : simple_graph C := G.induce (C : set V) + +lemma coe_inj {C D : G.component_compl K} : (C : set V) = (D : set V) ↔ C = D := set_like.coe_set_eq + +@[simp] protected lemma nonempty (C : G.component_compl K) : (C : set V).nonempty := +C.ind (λ v vnK, ⟨v, vnK, rfl⟩) + +protected lemma exists_eq_mk (C : G.component_compl K) : + ∃ v (h : v ∉ K), G.component_compl_mk h = C := +C.nonempty + +protected lemma disjoint_right (C : G.component_compl K) : disjoint K C := +begin + rw set.disjoint_iff, + exact λ v ⟨vK, vC⟩, vC.some vK, +end + +lemma not_mem_of_mem {C : G.component_compl K} {c : V} (cC : c ∈ C) : c ∉ K := +λ cK, set.disjoint_iff.mp C.disjoint_right ⟨cK, cC⟩ + +protected lemma pairwise_disjoint : + pairwise $ λ C D : G.component_compl K, disjoint (C : set V) (D : set V) := +begin + rintro C D ne, + rw set.disjoint_iff, + exact λ u ⟨uC, uD⟩, ne (uC.some_spec.symm.trans uD.some_spec), +end + +/-- +Any vertex adjacent to a vertex of `C` and not lying in `K` must lie in `C`. +-/ +lemma mem_of_adj : ∀ {C : G.component_compl K} (c d : V), c ∈ C → d ∉ K → G.adj c d → d ∈ C := +λ C c d ⟨cnK, h⟩ dnK cd, + ⟨ dnK, by { rw [←h, connected_component.eq], exact adj.reachable cd.symm, } ⟩ + +/-- +Assuming `G` is preconnected and `K` not empty, given any connected component `C` outside of `K`, +there exists a vertex `k ∈ K` adjacent to a vertex `v ∈ C`. +-/ +lemma exists_adj_boundary_pair (Gc : G.preconnected) (hK : K.nonempty) : + ∀ (C : G.component_compl K), ∃ (ck : V × V), ck.1 ∈ C ∧ ck.2 ∈ K ∧ G.adj ck.1 ck.2 := +begin + refine component_compl.ind (λ v vnK, _), + let C : G.component_compl K := G.component_compl_mk vnK, + let dis := set.disjoint_iff.mp C.disjoint_right, + by_contra' h, + suffices : set.univ = (C : set V), + { exact dis ⟨hK.some_spec, this ▸ (set.mem_univ hK.some)⟩, }, + symmetry, + rw set.eq_univ_iff_forall, + rintro u, + by_contradiction unC, + obtain ⟨p⟩ := Gc v u, + obtain ⟨⟨⟨x, y⟩, xy⟩, d, xC, ynC⟩ := + p.exists_boundary_dart (C : set V) (G.component_compl_mk_mem vnK) unC, + exact ynC (mem_of_adj x y xC (λ (yK : y ∈ K), h ⟨x, y⟩ xC yK xy) xy), +end + +/-- +If `K ⊆ L`, the components outside of `L` are all contained in a single component outside of `K`. +-/ +@[reducible] def hom (h : K ⊆ L) (C : G.component_compl L) : G.component_compl K := +C.map $ induce_hom hom.id $ set.compl_subset_compl.2 h + +lemma subset_hom (C : G.component_compl L) (h : K ⊆ L) : (C : set V) ⊆ (C.hom h : set V) := by +{ rintro c ⟨cL, rfl⟩, exact ⟨λ h', cL (h h'), rfl⟩ } + +lemma _root_.simple_graph.component_compl_mk_mem_hom (G : simple_graph V) {v : V} (vK : v ∉ K) + (h : L ⊆ K) : v ∈ (G.component_compl_mk vK).hom h := +subset_hom (G.component_compl_mk vK) h (G.component_compl_mk_mem vK) + +lemma hom_eq_iff_le (C : G.component_compl L) (h : K ⊆ L) (D : G.component_compl K) : + C.hom h = D ↔ (C : set V) ⊆ (D : set V) := +⟨ λ h', h' ▸ (C.subset_hom h), C.ind (λ v vnL vD, (vD ⟨vnL, rfl⟩).some_spec) ⟩ + +lemma hom_eq_iff_not_disjoint (C : G.component_compl L) (h : K ⊆ L) (D : G.component_compl K) : + C.hom h = D ↔ ¬ disjoint (C : set V) (D : set V) := +begin + rw set.not_disjoint_iff, + split, + { rintro rfl, + apply C.ind (λ x xnL, _), + exact ⟨x, ⟨xnL, rfl⟩, ⟨(λ xK, xnL (h xK)), rfl⟩⟩, }, + { apply C.ind (λ x xnL, _), + rintro ⟨x, ⟨_, e₁⟩, _, rfl⟩, + rw ←e₁, refl, }, +end + +lemma hom_refl (C : G.component_compl L) : C.hom (subset_refl L) = C := +by { change C.map _ = C, erw [induce_hom_id G Lᶜ, connected_component.map_id], } + +lemma hom_trans (C : G.component_compl L) (h : K ⊆ L) (h' : M ⊆ K) : + C.hom (h'.trans h) = (C.hom h).hom h' := +by { change C.map _ = (C.map _).map _, erw [connected_component.map_comp, induce_hom_comp], refl, } + +lemma hom_mk {v : V} (vnL : v ∉ L) (h : K ⊆ L) : + (G.component_compl_mk vnL).hom h = (G.component_compl_mk (set.not_mem_subset h vnL)) := rfl + +lemma hom_infinite (C : G.component_compl L) (h : K ⊆ L) (Cinf : (C : set V).infinite) : + (C.hom h : set V).infinite := set.infinite.mono (C.subset_hom h) Cinf + +lemma infinite_iff_in_all_ranges {K : finset V} (C : G.component_compl K) : + C.supp.infinite ↔ ∀ L (h : K ⊆ L), ∃ D : G.component_compl L, D.hom h = C := +begin + classical, + split, + { rintro Cinf L h, + obtain ⟨v, ⟨vK, rfl⟩, vL⟩ := set.infinite.nonempty (set.infinite.diff Cinf L.finite_to_set), + exact ⟨component_compl_mk _ vL, rfl⟩ }, + { rintro h Cfin, + obtain ⟨D, e⟩ := h (K ∪ Cfin.to_finset) (finset.subset_union_left K Cfin.to_finset), + obtain ⟨v, vD⟩ := D.nonempty, + let Ddis := D.disjoint_right, + simp_rw [finset.coe_union, set.finite.coe_to_finset, set.disjoint_union_left, + set.disjoint_iff] at Ddis, + exact Ddis.right ⟨(component_compl.hom_eq_iff_le _ _ _).mp e vD, vD⟩, }, +end + +end component_compl + +section ends + +variables (G) + +open category_theory + +/-- +The functor assigning, to a finite set in `V`, the set of connected components in its complement. +-/ +@[simps] def component_compl_functor : (finset V)ᵒᵖ ⥤ Type u := +{ obj := λ K, G.component_compl K.unop, + map := λ _ _ f, component_compl.hom (le_of_op_hom f), + map_id' := λ K, funext $ λ C, C.hom_refl, + map_comp' := λ K L M h h', funext $ λ C, C.hom_trans (le_of_op_hom h) (le_of_op_hom h') } + +/-- The end of a graph, defined as the sections of the functor `component_compl_functor` . -/ +@[protected] +def «end» := (component_compl_functor G).sections + +lemma end_hom_mk_of_mk {s} (sec : s ∈ G.end) {K L : (finset V)ᵒᵖ} (h : L ⟶ K) + {v : V} (vnL : v ∉ L.unop) (hs : s L = G.component_compl_mk vnL) : + s K = G.component_compl_mk (set.not_mem_subset (le_of_op_hom h) vnL) := +begin + rw [←(sec h), hs], + apply component_compl.hom_mk, +end + +lemma infinite_iff_in_eventual_range {K : (finset V)ᵒᵖ} (C : G.component_compl_functor.obj K) : + C.supp.infinite ↔ C ∈ G.component_compl_functor.eventual_range K := +begin + simp only [C.infinite_iff_in_all_ranges, category_theory.functor.eventual_range, + set.mem_Inter, set.mem_range, component_compl_functor_map], + exact ⟨λ h Lop KL, h Lop.unop (le_of_op_hom KL), λ h L KL, h (opposite.op L) (op_hom_of_le KL)⟩, +end + +end ends + +end simple_graph diff --git a/src/combinatorics/simple_graph/ends/properties.lean b/src/combinatorics/simple_graph/ends/properties.lean new file mode 100644 index 0000000000000..009e5a47a1e97 --- /dev/null +++ b/src/combinatorics/simple_graph/ends/properties.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2022 Anand Rao, Rémi Bottinelli. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anand Rao, Rémi Bottinelli +-/ +import combinatorics.simple_graph.ends.defs +/-! +# Properties of the ends of graphs + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file is meant to contain results about the ends of (locally finite connected) graphs. + +-/ + +variables {V : Type} (G : simple_graph V) + +namespace simple_graph + +instance [finite V] : is_empty G.end := +⟨ begin + rintro ⟨s, _⟩, + casesI nonempty_fintype V, + obtain ⟨v, h⟩ := (s $ opposite.op finset.univ).nonempty, + exact set.disjoint_iff.mp (s _).disjoint_right + ⟨by simp only [opposite.unop_op, finset.coe_univ], h⟩, + end ⟩ + +end simple_graph diff --git a/src/combinatorics/simple_graph/finsubgraph.lean b/src/combinatorics/simple_graph/finsubgraph.lean new file mode 100644 index 0000000000000..dc13b8d50a0a5 --- /dev/null +++ b/src/combinatorics/simple_graph/finsubgraph.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2022 Joanna Choules. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Joanna Choules +-/ +import category_theory.cofiltered_system +import combinatorics.simple_graph.subgraph + +/-! +# Homomorphisms from finite subgraphs + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the type of finite subgraphs of a `simple_graph` and proves a compactness result +for homomorphisms to a finite codomain. + +## Main statements + +* `simple_graph.exists_hom_of_all_finite_homs`: If every finite subgraph of a (possibly infinite) + graph `G` has a homomorphism to some finite graph `F`, then there is also a homomorphism `G →g F`. + +## Notations + +`→fg` is a module-local variant on `→g` where the domain is a finite subgraph of some supergraph +`G`. + +## Implementation notes + +The proof here uses compactness as formulated in `nonempty_sections_of_finite_inverse_system`. For +finite subgraphs `G'' ≤ G'`, the inverse system `finsubgraph_hom_functor` restricts homomorphisms +`G' →fg F` to domain `G''`. +-/ + +open set + +universes u v +variables {V : Type u} {W : Type v} {G : simple_graph V} {F : simple_graph W} + +namespace simple_graph + +/-- The subtype of `G.subgraph` comprising those subgraphs with finite vertex sets. -/ +abbreviation finsubgraph (G : simple_graph V) := { G' : G.subgraph // G'.verts.finite } + +/-- A graph homomorphism from a finite subgraph of G to F. -/ +abbreviation finsubgraph_hom (G' : G.finsubgraph) (F : simple_graph W) := G'.val.coe →g F + +local infix ` →fg ` : 50 := finsubgraph_hom + +instance : order_bot G.finsubgraph := +{ bot := ⟨⊥, finite_empty⟩, + bot_le := λ _, bot_le } + +instance : has_sup G.finsubgraph := ⟨λ G₁ G₂, ⟨G₁ ⊔ G₂, G₁.2.union G₂.2⟩⟩ +instance : has_inf G.finsubgraph := ⟨λ G₁ G₂, ⟨G₁ ⊓ G₂, G₁.2.subset $ inter_subset_left _ _⟩⟩ + +instance : distrib_lattice G.finsubgraph := +subtype.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl) + +instance [finite V] : has_top G.finsubgraph := ⟨⟨⊤, finite_univ⟩⟩ +instance [finite V] : has_Sup G.finsubgraph := ⟨λ s, ⟨⨆ G ∈ s, ↑G, set.to_finite _⟩⟩ +instance [finite V] : has_Inf G.finsubgraph := ⟨λ s, ⟨⨅ G ∈ s, ↑G, set.to_finite _⟩⟩ + +instance [finite V] : complete_distrib_lattice G.finsubgraph := +subtype.coe_injective.complete_distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl + rfl + +/-- The finite subgraph of G generated by a single vertex. -/ +def singleton_finsubgraph (v : V) : G.finsubgraph := ⟨simple_graph.singleton_subgraph _ v, by simp⟩ + +/-- The finite subgraph of G generated by a single edge. -/ +def finsubgraph_of_adj {u v : V} (e : G.adj u v) : G.finsubgraph := +⟨simple_graph.subgraph_of_adj _ e, by simp⟩ + +/- Lemmas establishing the ordering between edge- and vertex-generated subgraphs. -/ + +lemma singleton_finsubgraph_le_adj_left {u v : V} {e : G.adj u v} : + singleton_finsubgraph u ≤ finsubgraph_of_adj e := +by simp [singleton_finsubgraph, finsubgraph_of_adj] + +lemma singleton_finsubgraph_le_adj_right {u v : V} {e : G.adj u v} : + singleton_finsubgraph v ≤ finsubgraph_of_adj e := +by simp [singleton_finsubgraph, finsubgraph_of_adj] + +/-- Given a homomorphism from a subgraph to `F`, construct its restriction to a sub-subgraph. -/ +def finsubgraph_hom.restrict {G' G'' : G.finsubgraph} (h : G'' ≤ G') (f : G' →fg F) : G'' →fg F := +begin + refine ⟨λ ⟨v, hv⟩, f.to_fun ⟨v, h.1 hv⟩, _⟩, + rintros ⟨u, hu⟩ ⟨v, hv⟩ huv, + exact f.map_rel' (h.2 huv), +end + +/-- The inverse system of finite homomorphisms. -/ +def finsubgraph_hom_functor (G : simple_graph V) (F : simple_graph W) : + (G.finsubgraph)ᵒᵖ ⥤ Type (max u v) := +{ obj := λ G', G'.unop →fg F, + map := λ G' G'' g f, f.restrict (category_theory.le_of_hom g.unop), } + +/-- If every finite subgraph of a graph `G` has a homomorphism to a finite graph `F`, then there is +a homomorphism from the whole of `G` to `F`. -/ +lemma nonempty_hom_of_forall_finite_subgraph_hom [finite W] + (h : Π (G' : G.subgraph), G'.verts.finite → G'.coe →g F) : nonempty (G →g F) := +begin + /- Obtain a `fintype` instance for `W`. -/ + casesI nonempty_fintype W, + /- Establish the required interface instances. -/ + haveI : ∀ (G' : (G.finsubgraph)ᵒᵖ), nonempty ((finsubgraph_hom_functor G F).obj G') := + λ G', ⟨h G'.unop G'.unop.property⟩, + haveI : Π (G' : (G.finsubgraph)ᵒᵖ), fintype ((finsubgraph_hom_functor G F).obj G') := + begin + intro G', + haveI : fintype (↥(G'.unop.val.verts)) := G'.unop.property.fintype, + haveI : fintype (↥(G'.unop.val.verts) → W) := begin + classical, + exact pi.fintype + end, + exact fintype.of_injective (λ f, f.to_fun) rel_hom.coe_fn_injective + end, + /- Use compactness to obtain a section. -/ + obtain ⟨u, hu⟩ := nonempty_sections_of_finite_inverse_system (finsubgraph_hom_functor G F), + refine ⟨⟨λ v, _, _⟩⟩, + { /- Map each vertex using the homomorphism provided for its singleton subgraph. -/ + exact (u (opposite.op (singleton_finsubgraph v))).to_fun + ⟨v, by {unfold singleton_finsubgraph, simp}⟩, }, + { /- Prove that the above mapping preserves adjacency. -/ + intros v v' e, + /- The homomorphism for each edge's singleton subgraph agrees with those for its source and + target vertices. -/ + have hv : opposite.op (finsubgraph_of_adj e) ⟶ opposite.op (singleton_finsubgraph v) := + quiver.hom.op (category_theory.hom_of_le singleton_finsubgraph_le_adj_left), + have hv' : opposite.op (finsubgraph_of_adj e) ⟶ opposite.op (singleton_finsubgraph v') := + quiver.hom.op (category_theory.hom_of_le singleton_finsubgraph_le_adj_right), + rw [← (hu hv), ← (hu hv')], + apply simple_graph.hom.map_adj, + /- `v` and `v'` are definitionally adjacent in `finsubgraph_of_adj e` -/ + simp [finsubgraph_of_adj], } +end + +end simple_graph diff --git a/src/combinatorics/simple_graph/hasse.lean b/src/combinatorics/simple_graph/hasse.lean index 937d1e815c118..0a65ddf502722 100644 --- a/src/combinatorics/simple_graph/hasse.lean +++ b/src/combinatorics/simple_graph/hasse.lean @@ -3,13 +3,16 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import combinatorics.simple_graph.connectivity +import combinatorics.simple_graph.prod import data.fin.succ_pred import order.succ_pred.relation /-! # The Hasse diagram as a graph +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the Hasse diagram of an order (graph of `covby`, the covering relation) and the path graph on `n` vertices. @@ -47,6 +50,15 @@ def hasse_dual_iso : hasse αᵒᵈ ≃g hasse α := end preorder +section partial_order +variables [partial_order α] [partial_order β] + +@[simp] lemma hasse_prod : hasse (α × β) = hasse α □ hasse β := +by { ext x y, simp_rw [box_prod_adj, hasse_adj, prod.covby_iff, or_and_distrib_right, + @eq_comm _ y.1, @eq_comm _ y.2, or_or_or_comm] } + +end partial_order + section linear_order variables [linear_order α] diff --git a/src/combinatorics/simple_graph/inc_matrix.lean b/src/combinatorics/simple_graph/inc_matrix.lean index 44cea122c62a5..46829ff8eceb3 100644 --- a/src/combinatorics/simple_graph/inc_matrix.lean +++ b/src/combinatorics/simple_graph/inc_matrix.lean @@ -9,6 +9,9 @@ import data.matrix.basic /-! # Incidence matrix of a simple graph +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the unoriented incidence matrix of a simple graph. ## Main definitions @@ -70,8 +73,7 @@ lemma inc_matrix_apply_mul_inc_matrix_apply : begin classical, simp only [inc_matrix, set.indicator_apply, ←ite_and_mul_zero, - pi.one_apply, mul_one, set.mem_inter_eq], - congr, + pi.one_apply, mul_one, set.mem_inter_iff], end lemma inc_matrix_apply_mul_inc_matrix_apply_of_not_adj (hab : a ≠ b) (h : ¬ G.adj a b) : @@ -98,7 +100,7 @@ begin end lemma inc_matrix_apply_eq_one_iff : G.inc_matrix R a e = 1 ↔ e ∈ G.incidence_set a := -by { convert one_ne_zero.ite_eq_left_iff, assumption } +by { convert one_ne_zero.ite_eq_left_iff, apply_instance } end mul_zero_one_class diff --git a/src/combinatorics/simple_graph/matching.lean b/src/combinatorics/simple_graph/matching.lean index 7fc17adc471d2..e3803b5e26a3e 100644 --- a/src/combinatorics/simple_graph/matching.lean +++ b/src/combinatorics/simple_graph/matching.lean @@ -9,6 +9,9 @@ import combinatorics.simple_graph.subgraph /-! # Matchings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A *matching* for a simple graph is a set of disjoint pairs of adjacent vertices, and the set of all the vertices in a matching is called its *support* (and sometimes the vertices in the support are said to be *saturated* by the matching). A *perfect matching* is a matching whose support contains diff --git a/src/combinatorics/simple_graph/metric.lean b/src/combinatorics/simple_graph/metric.lean index 9bc039fd1a880..53bef52576248 100644 --- a/src/combinatorics/simple_graph/metric.lean +++ b/src/combinatorics/simple_graph/metric.lean @@ -9,6 +9,9 @@ import data.nat.lattice /-! # Graph metric +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines the `simple_graph.dist` function, which takes pairs of vertices to the length of the shortest walk between them. diff --git a/src/combinatorics/simple_graph/partition.lean b/src/combinatorics/simple_graph/partition.lean index 7ee17a2e6af7e..840ae22c4ee4c 100644 --- a/src/combinatorics/simple_graph/partition.lean +++ b/src/combinatorics/simple_graph/partition.lean @@ -9,6 +9,9 @@ import combinatorics.simple_graph.coloring /-! # Graph partitions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides an interface for dealing with partitions on simple graphs. A partition of a graph `G`, with vertices `V`, is a set `P` of disjoint nonempty subsets of `V` such that: @@ -118,7 +121,8 @@ def coloring.to_partition {α : Type v} (C : G.coloring α) : G.partition := apply C.color_classes_independent, end } -instance : inhabited (partition G) := ⟨G.self_coloring.to_partition⟩ +/-- The partition where every vertex is in its own part. -/ +@[simps] instance : inhabited (partition G) := ⟨G.self_coloring.to_partition⟩ lemma partitionable_iff_colorable {n : ℕ} : G.partitionable n ↔ G.colorable n := @@ -129,9 +133,9 @@ begin rw set.finite.card_to_finset at h, apply P.to_colorable.mono h, }, { rintro ⟨C⟩, - refine ⟨C.to_partition, C.color_classes_finite_of_fintype, le_trans _ (fintype.card_fin n).le⟩, + refine ⟨C.to_partition, C.color_classes_finite, le_trans _ (fintype.card_fin n).le⟩, generalize_proofs h, - haveI : fintype C.color_classes := C.color_classes_finite_of_fintype.fintype, + haveI : fintype C.color_classes := C.color_classes_finite.fintype, rw h.card_to_finset, exact C.card_color_classes_le }, end diff --git a/src/combinatorics/simple_graph/prod.lean b/src/combinatorics/simple_graph/prod.lean new file mode 100644 index 0000000000000..0dca3687cb37e --- /dev/null +++ b/src/combinatorics/simple_graph/prod.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2022 George Peter Banyard, Yaël Dillies, Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: George Peter Banyard, Yaël Dillies, Kyle Miller +-/ +import combinatorics.simple_graph.connectivity + +/-! +# Graph products + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the box product of graphs and other product constructions. The box product of `G` +and `H` is the graph on the product of the vertices such that `x` and `y` are related iff they agree +on one component and the other one is related via either `G` or `H`. For example, the box product of +two edges is a square. + +## Main declarations + +* `simple_graph.box_prod`: The box product. + +## Notation + +* `G □ H`: The box product of `G` and `H`. + +## TODO + +Define all other graph products! +-/ + +variables {α β γ : Type*} + +namespace simple_graph +variables {G : simple_graph α} {H : simple_graph β} {I : simple_graph γ} {a a₁ a₂ : α} {b b₁ b₂ : β} + {x y : α × β} + +/-- Box product of simple graphs. It relates `(a₁, b)` and `(a₂, b)` if `G` relates `a₁` and `a₂`, +and `(a, b₁)` and `(a, b₂)` if `H` relates `b₁` and `b₂`. -/ +def box_prod (G : simple_graph α) (H : simple_graph β) : simple_graph (α × β) := +{ adj := λ x y, G.adj x.1 y.1 ∧ x.2 = y.2 ∨ H.adj x.2 y.2 ∧ x.1 = y.1, + symm := λ x y, by simp [and_comm, or_comm, eq_comm, adj_comm], + loopless := λ x, by simp } + +infix ` □ `:70 := box_prod + +@[simp] lemma box_prod_adj : + (G □ H).adj x y ↔ G.adj x.1 y.1 ∧ x.2 = y.2 ∨ H.adj x.2 y.2 ∧ x.1 = y.1 := iff.rfl + +@[simp] lemma box_prod_adj_left : (G □ H).adj (a₁, b) (a₂, b) ↔ G.adj a₁ a₂ := +by rw [box_prod_adj, and_iff_left rfl, or_iff_left (λ h : H.adj b b ∧ _, h.1.ne rfl)] + +@[simp] lemma box_prod_adj_right : (G □ H).adj (a, b₁) (a, b₂) ↔ H.adj b₁ b₂ := +by rw [box_prod_adj, and_iff_left rfl, or_iff_right (λ h : G.adj a a ∧ _, h.1.ne rfl)] + +lemma box_prod_neighbor_set (x : α × β) : + (G □ H).neighbor_set x = ((G.neighbor_set x.1) ×ˢ {x.2}) ∪ ({x.1} ×ˢ (H.neighbor_set x.2)) := +begin + ext ⟨a',b'⟩, + simp only [mem_neighbor_set, set.mem_union, box_prod_adj, set.mem_prod, set.mem_singleton_iff], + simp only [eq_comm, and_comm], +end + +variables (G H I) + +/-- The box product is commutative up to isomorphism. `equiv.prod_comm` as a graph isomorphism. -/ +@[simps] def box_prod_comm : G □ H ≃g H □ G := ⟨equiv.prod_comm _ _, λ x y, or_comm _ _⟩ + +/-- The box product is associative up to isomorphism. `equiv.prod_assoc` as a graph isomorphism. -/ +@[simps] def box_prod_assoc : (G □ H) □ I ≃g G □ (H □ I) := +⟨equiv.prod_assoc _ _ _, λ x y, by simp only [box_prod_adj, equiv.prod_assoc_apply, + or_and_distrib_right, or_assoc, prod.ext_iff, and_assoc, @and.comm (x.1.1 = _)]⟩ + +/-- The embedding of `G` into `G □ H` given by `b`. -/ +@[simps] def box_prod_left (b : β) : G ↪g G □ H := +{ to_fun := λ a, (a , b), + inj' := λ a₁ a₂, congr_arg prod.fst, + map_rel_iff' := λ a₁ a₂, box_prod_adj_left } + +/-- The embedding of `H` into `G □ H` given by `a`. -/ +@[simps] def box_prod_right (a : α) : H ↪g G □ H := +{ to_fun := prod.mk a, + inj' := λ b₁ b₂, congr_arg prod.snd, + map_rel_iff' := λ b₁ b₂, box_prod_adj_right } + +namespace walk +variables {G} + +/-- Turn a walk on `G` into a walk on `G □ H`. -/ +protected def box_prod_left (b : β) : G.walk a₁ a₂ → (G □ H).walk (a₁, b) (a₂, b) := +walk.map (G.box_prod_left H b).to_hom + +variables (G) {H} + +/-- Turn a walk on `H` into a walk on `G □ H`. -/ +protected def box_prod_right (a : α) : H.walk b₁ b₂ → (G □ H).walk (a, b₁) (a, b₂) := +walk.map (G.box_prod_right H a).to_hom + +variables {G} + +/-- Project a walk on `G □ H` to a walk on `G` by discarding the moves in the direction of `H`. -/ +def of_box_prod_left [decidable_eq β] [decidable_rel G.adj] : + Π {x y : α × β}, (G □ H).walk x y → G.walk x.1 y.1 +| _ _ nil := nil +| x z (cons h w) := or.by_cases h (λ hG, w.of_box_prod_left.cons hG.1) + (λ hH, show G.walk x.1 z.1, by rw hH.2; exact w.of_box_prod_left) + +/-- Project a walk on `G □ H` to a walk on `H` by discarding the moves in the direction of `G`. -/ +def of_box_prod_right [decidable_eq α] [decidable_rel H.adj] : + Π {x y : α × β}, (G □ H).walk x y → H.walk x.2 y.2 +| _ _ nil := nil +| x z (cons h w) := (or.symm h).by_cases (λ hH, w.of_box_prod_right.cons hH.1) + (λ hG, show H.walk x.2 z.2, by rw hG.2; exact w.of_box_prod_right) + +@[simp] lemma of_box_prod_left_box_prod_left [decidable_eq β] [decidable_rel G.adj] : + ∀ {a₁ a₂ : α} (w : G.walk a₁ a₂), (w.box_prod_left H b).of_box_prod_left = w +| _ _ nil := rfl +| _ _ (cons' x y z h w) := begin + rw [walk.box_prod_left, map_cons, of_box_prod_left, or.by_cases, dif_pos, ←walk.box_prod_left, + of_box_prod_left_box_prod_left], + exacts [rfl, ⟨h, rfl⟩], +end + +@[simp] lemma of_box_prod_left_box_prod_right [decidable_eq α] [decidable_rel G.adj] : + ∀ {b₁ b₂ : α} (w : G.walk b₁ b₂), (w.box_prod_right G a).of_box_prod_right = w +| _ _ nil := rfl +| _ _ (cons' x y z h w) := begin + rw [walk.box_prod_right, map_cons, of_box_prod_right, or.by_cases, dif_pos, ←walk.box_prod_right, + of_box_prod_left_box_prod_right], + exacts [rfl, ⟨h, rfl⟩], +end + +end walk + +variables {G H} + +protected lemma preconnected.box_prod (hG : G.preconnected) (hH : H.preconnected) : + (G □ H).preconnected := +begin + rintro x y, + obtain ⟨w₁⟩ := hG x.1 y.1, + obtain ⟨w₂⟩ := hH x.2 y.2, + rw [←@prod.mk.eta _ _ x, ←@prod.mk.eta _ _ y], + exact ⟨(w₁.box_prod_left _ _).append (w₂.box_prod_right _ _)⟩, +end + +protected lemma preconnected.of_box_prod_left [nonempty β] (h : (G □ H).preconnected) : + G.preconnected := +begin + classical, + rintro a₁ a₂, + obtain ⟨w⟩ := h (a₁, classical.arbitrary _) (a₂, classical.arbitrary _), + exact ⟨w.of_box_prod_left⟩, +end + +protected lemma preconnected.of_box_prod_right [nonempty α] (h : (G □ H).preconnected) : + H.preconnected := +begin + classical, + rintro b₁ b₂, + obtain ⟨w⟩ := h (classical.arbitrary _, b₁) (classical.arbitrary _, b₂), + exact ⟨w.of_box_prod_right⟩, +end + +protected lemma connected.box_prod (hG : G.connected) (hH : H.connected) : (G □ H).connected := +by { haveI := hG.nonempty, haveI := hH.nonempty, exact ⟨hG.preconnected.box_prod hH.preconnected⟩ } + +protected lemma connected.of_box_prod_left (h : (G □ H).connected) : G.connected := +by { haveI := (nonempty_prod.1 h.nonempty).1, haveI := (nonempty_prod.1 h.nonempty).2, + exact ⟨h.preconnected.of_box_prod_left⟩ } + +protected lemma connected.of_box_prod_right (h : (G □ H).connected) : H.connected := +by { haveI := (nonempty_prod.1 h.nonempty).1, haveI := (nonempty_prod.1 h.nonempty).2, + exact ⟨h.preconnected.of_box_prod_right⟩ } + +@[simp] lemma box_prod_connected : (G □ H).connected ↔ G.connected ∧ H.connected := +⟨λ h, ⟨h.of_box_prod_left, h.of_box_prod_right⟩, λ h, h.1.box_prod h.2⟩ + +instance box_prod_fintype_neighbor_set (x : α × β) + [fintype (G.neighbor_set x.1)] [fintype (H.neighbor_set x.2)] : + fintype ((G □ H).neighbor_set x) := +fintype.of_equiv + ((G.neighbor_finset x.1 ×ˢ {x.2}).disj_union ({x.1} ×ˢ H.neighbor_finset x.2) + $ finset.disjoint_product.mpr $ or.inl $ neighbor_finset_disjoint_singleton _ _) + ((equiv.refl _).subtype_equiv $ λ y, begin + simp_rw [finset.mem_disj_union, finset.mem_product, finset.mem_singleton, + mem_neighbor_finset, mem_neighbor_set, equiv.refl_apply, box_prod_adj], + simp only [eq_comm, and_comm], + end) + +lemma box_prod_neighbor_finset (x : α × β) + [fintype (G.neighbor_set x.1)] [fintype (H.neighbor_set x.2)] [fintype ((G □ H).neighbor_set x)] : + (G □ H).neighbor_finset x = + (G.neighbor_finset x.1 ×ˢ {x.2}).disj_union ({x.1} ×ˢ H.neighbor_finset x.2) + (finset.disjoint_product.mpr $ or.inl $ neighbor_finset_disjoint_singleton _ _) := +begin + -- swap out the fintype instance for the canonical one + letI : fintype ((G □ H).neighbor_set x) := simple_graph.box_prod_fintype_neighbor_set _, + refine eq.trans _ finset.attach_map_val, + convert (finset.map_map _ (function.embedding.subtype _) finset.univ), +end + +lemma box_prod_degree (x : α × β) + [fintype (G.neighbor_set x.1)] [fintype (H.neighbor_set x.2)] [fintype ((G □ H).neighbor_set x)] : + (G □ H).degree x = G.degree x.1 + H.degree x.2 := +begin + rw [degree, degree, degree, box_prod_neighbor_finset, finset.card_disj_union], + simp_rw [finset.card_product, finset.card_singleton, mul_one, one_mul], +end + +end simple_graph diff --git a/src/combinatorics/simple_graph/regularity/bound.lean b/src/combinatorics/simple_graph/regularity/bound.lean index 804327512ff25..6e2e8992eac1a 100644 --- a/src/combinatorics/simple_graph/regularity/bound.lean +++ b/src/combinatorics/simple_graph/regularity/bound.lean @@ -3,14 +3,20 @@ Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Bhavik Mehta -/ -import analysis.special_functions.pow +import algebra.order.chebyshev +import analysis.special_functions.pow.real import order.partition.equipartition /-! # Numerical bounds for Szemerédi Regularity Lemma +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file gathers the numerical facts required by the proof of Szemerédi's regularity lemma. +This entire file is internal to the proof of Szemerédi Regularity Lemma. + ## Main declarations * `szemeredi_regularity.step_bound`: During the inductive step, a partition of size `n` is blown to @@ -18,9 +24,14 @@ This file gathers the numerical facts required by the proof of Szemerédi's regu * `szemeredi_regularity.initial_bound`: The size of the partition we start the induction with. * `szemeredi_regularity.bound`: The upper bound on the size of the partition produced by our version of Szemerédi's regularity lemma. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] -/ open finset fintype function real +open_locale big_operators namespace szemeredi_regularity @@ -33,10 +44,13 @@ lemma le_step_bound : id ≤ step_bound := λ n, nat.le_mul_of_pos_right $ pow_p lemma step_bound_mono : monotone step_bound := λ a b h, nat.mul_le_mul h $ nat.pow_le_pow_of_le_right (by norm_num) h -lemma step_bound_pos_iff {n : ℕ} : 0 < step_bound n ↔ 0 < n := -zero_lt_mul_right $ pow_pos (by norm_num) _ +lemma step_bound_pos_iff {n : ℕ} : 0 < step_bound n ↔ 0 < n := zero_lt_mul_right $ by positivity + +alias step_bound_pos_iff ↔ _ step_bound_pos + +end szemeredi_regularity -alias step_bound_pos_iff ↔ _ szemeredi_regularity.step_bound_pos +open szemeredi_regularity variables {α : Type*} [decidable_eq α] [fintype α] {P : finpartition (univ : finset α)} {u : finset α} {ε : ℝ} @@ -44,30 +58,53 @@ variables {α : Type*} [decidable_eq α] [fintype α] {P : finpartition (univ : local notation `m` := (card α/step_bound P.parts.card : ℕ) local notation `a` := (card α/P.parts.card - m * 4^P.parts.card : ℕ) -lemma m_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : 0 < m := +namespace tactic +open positivity + +private lemma eps_pos {ε : ℝ} {n : ℕ} (h : 100 ≤ 4 ^ n * ε^5) : 0 < ε := +pow_bit1_pos_iff.1 $ pos_of_mul_pos_right (h.trans_lt' $ by norm_num) $ by positivity + +private lemma m_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : 0 < m := nat.div_pos ((nat.mul_le_mul_left _ $ nat.pow_le_pow_of_le_left (by norm_num) _).trans hPα) $ step_bound_pos (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos -lemma m_coe_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : (0 : ℝ) < m := -nat.cast_pos.2 $ m_pos hPα +/-- Local extension for the `positivity` tactic: A few facts that are needed many times for the +proof of Szemerédi's regularity lemma. -/ +meta def positivity_szemeredi_regularity : expr → tactic strictness +| `(%%n / step_bound (finpartition.parts %%P).card) := do + p ← to_expr + ``((finpartition.parts %%P).card * 16^(finpartition.parts %%P).card ≤ %%n) + >>= find_assumption, + positive <$> mk_app ``m_pos [p] +| ε := do + typ ← infer_type ε, + unify typ `(ℝ), + p ← to_expr ``(100 ≤ 4 ^ _ * %%ε ^ 5) >>= find_assumption, + positive <$> mk_app ``eps_pos [p] + +end tactic + +local attribute [positivity] tactic.positivity_szemeredi_regularity + +namespace szemeredi_regularity + +lemma m_pos [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : 0 < m := by positivity -lemma coe_m_add_one_pos : 0 < (m : ℝ) + 1 := nat.cast_add_one_pos _ +lemma coe_m_add_one_pos : 0 < (m : ℝ) + 1 := by positivity lemma one_le_m_coe [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) : (1 : ℝ) ≤ m := nat.one_le_cast.2 $ m_pos hPα lemma eps_pow_five_pos (hPε : 100 ≤ 4^P.parts.card * ε^5) : 0 < ε^5 := -pos_of_mul_pos_left ((by norm_num : (0 : ℝ) < 100).trans_le hPε) $ pow_nonneg (by norm_num) _ +pos_of_mul_pos_right ((by norm_num : (0 : ℝ) < 100).trans_le hPε) $ pow_nonneg (by norm_num) _ lemma eps_pos (hPε : 100 ≤ 4^P.parts.card * ε^5) : 0 < ε := pow_bit1_pos_iff.1 $ eps_pow_five_pos hPε -lemma four_pow_pos {n : ℕ} : 0 < (4 : ℝ)^n := pow_pos (by norm_num) n - lemma hundred_div_ε_pow_five_le_m [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) : 100 / ε^5 ≤ m := -(div_le_of_nonneg_of_le_mul (eps_pow_five_pos hPε).le four_pow_pos.le hPε).trans +(div_le_of_nonneg_of_le_mul (eps_pow_five_pos hPε).le (by positivity) hPε).trans begin norm_cast, rwa [nat.le_div_iff_mul_le'(step_bound_pos (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos), @@ -76,14 +113,13 @@ end lemma hundred_le_m [nonempty α] (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) (hε : ε ≤ 1) : 100 ≤ m := -by exact_mod_cast - (le_div_self (by norm_num) (eps_pow_five_pos hPε) $ pow_le_one _ (eps_pos hPε).le hε).trans - (hundred_div_ε_pow_five_le_m hPα hPε) +by exact_mod_cast (hundred_div_ε_pow_five_le_m hPα hPε).trans' + (le_div_self (by norm_num) (by positivity) $ pow_le_one _ (by positivity) hε) lemma a_add_one_le_four_pow_parts_card : a + 1 ≤ 4^P.parts.card := begin have h : 1 ≤ 4^P.parts.card := one_le_pow_of_one_le (by norm_num) _, - rw [step_bound, ←nat.div_div_eq_div_mul, nat.add_le_to_le_sub _ h, tsub_le_iff_left, + rw [step_bound, ←nat.div_div_eq_div_mul, ←nat.le_sub_iff_right h, tsub_le_iff_left, ←nat.add_sub_assoc h], exact nat.le_pred_of_lt (nat.lt_div_mul_add h), end @@ -130,7 +166,7 @@ lemma hundred_lt_pow_initial_bound_mul {ε : ℝ} (hε : 0 < ε) (l : ℕ) : begin rw [←rpow_nat_cast 4, ←div_lt_iff (pow_pos hε 5), lt_rpow_iff_log_lt _ zero_lt_four, ←div_lt_iff, initial_bound, nat.cast_max, nat.cast_max], - { exact lt_max_of_lt_right (lt_max_of_lt_right $ nat.lt_floor_add_one _) }, + { push_cast, exact lt_max_of_lt_right (lt_max_of_lt_right $ nat.lt_floor_add_one _) }, { exact log_pos (by norm_num) }, { exact div_pos (by norm_num) (pow_pos hε 5) } end @@ -141,9 +177,58 @@ noncomputable def bound : ℕ := (step_bound^[⌊4 / ε^5⌋₊] $ initial_bound ε l) * 16 ^ (step_bound^[⌊4 / ε^5⌋₊] $ initial_bound ε l) lemma initial_bound_le_bound : initial_bound ε l ≤ bound ε l := -(id_le_iterate_of_id_le le_step_bound _ _).trans $ nat.le_mul_of_pos_right $ pow_pos (by norm_num) _ +(id_le_iterate_of_id_le le_step_bound _ _).trans $ nat.le_mul_of_pos_right $ by positivity lemma le_bound : l ≤ bound ε l := (le_initial_bound ε l).trans $ initial_bound_le_bound ε l lemma bound_pos : 0 < bound ε l := (initial_bound_pos ε l).trans_le $ initial_bound_le_bound ε l +variables {ι 𝕜 : Type*} [linear_ordered_field 𝕜] (r : ι → ι → Prop) [decidable_rel r] + {s t : finset ι} {x : 𝕜} + +lemma mul_sq_le_sum_sq (hst : s ⊆ t) (f : ι → 𝕜) (hs : x^2 ≤ ((∑ i in s, f i) / s.card) ^ 2) + (hs' : (s.card : 𝕜) ≠ 0) : + (s.card : 𝕜) * x ^ 2 ≤ ∑ i in t, f i ^ 2 := +(mul_le_mul_of_nonneg_left (hs.trans sum_div_card_sq_le_sum_sq_div_card) $ + nat.cast_nonneg _).trans $ (mul_div_cancel' _ hs').le.trans $ sum_le_sum_of_subset_of_nonneg hst $ + λ i _ _, sq_nonneg _ + +lemma add_div_le_sum_sq_div_card (hst : s ⊆ t) (f : ι → 𝕜) (d : 𝕜) (hx : 0 ≤ x) + (hs : x ≤ |(∑ i in s, f i)/s.card - (∑ i in t, f i)/t.card|) + (ht : d ≤ ((∑ i in t, f i)/t.card)^2) : + d + s.card/t.card * x^2 ≤ (∑ i in t, f i^2)/t.card := +begin + obtain hscard | hscard := (s.card.cast_nonneg : (0 : 𝕜) ≤ s.card).eq_or_lt, + { simpa [←hscard] using ht.trans sum_div_card_sq_le_sum_sq_div_card }, + have htcard : (0:𝕜) < t.card := hscard.trans_le (nat.cast_le.2 (card_le_of_subset hst)), + have h₁ : x^2 ≤ ((∑ i in s, f i)/s.card - (∑ i in t, f i)/t.card)^2 := + sq_le_sq.2 (by rwa [abs_of_nonneg hx]), + have h₂ : x^2 ≤ ((∑ i in s, (f i - (∑ j in t, f j)/t.card))/s.card)^2, + { apply h₁.trans, + rw [sum_sub_distrib, sum_const, nsmul_eq_mul, sub_div, mul_div_cancel_left _ hscard.ne'] }, + apply (add_le_add_right ht _).trans, + rw [←mul_div_right_comm, le_div_iff htcard, add_mul, div_mul_cancel _ htcard.ne'], + have h₃ := mul_sq_le_sum_sq hst (λ i, f i - (∑ j in t, f j) / t.card) h₂ hscard.ne', + apply (add_le_add_left h₃ _).trans, + simp [←mul_div_right_comm _ (t.card : 𝕜), sub_div' _ _ _ htcard.ne', ←sum_div, ←add_div, mul_pow, + div_le_iff (sq_pos_of_ne_zero _ htcard.ne'), sub_sq, sum_add_distrib, ←sum_mul, ←mul_sum], + ring_nf, +end + end szemeredi_regularity + +namespace tactic +open positivity szemeredi_regularity + +/-- Extension for the `positivity` tactic: `szemeredi_regularity.initial_bound` and +`szemeredi_regularity.bound` are always positive. -/ +@[positivity] +meta def positivity_szemeredi_regularity_bound : expr → tactic strictness +| `(szemeredi_regularity.initial_bound %%ε %%l) := positive <$> mk_app ``initial_bound_pos [ε, l] +| `(szemeredi_regularity.bound %%ε %%l) := positive <$> mk_app ``bound_pos [ε, l] +| e := pp e >>= fail ∘ format.bracket "The expression `" + "` isn't of the form `szemeredi_regularity.initial_bound ε l` nor `szemeredi_regularity.bound ε l`" + +example (ε : ℝ) (l : ℕ) : 0 < szemeredi_regularity.initial_bound ε l := by positivity +example (ε : ℝ) (l : ℕ) : 0 < szemeredi_regularity.bound ε l := by positivity + +end tactic diff --git a/src/combinatorics/simple_graph/regularity/chunk.lean b/src/combinatorics/simple_graph/regularity/chunk.lean new file mode 100644 index 0000000000000..a72af72eec1e4 --- /dev/null +++ b/src/combinatorics/simple_graph/regularity/chunk.lean @@ -0,0 +1,557 @@ +/- +Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Bhavik Mehta +-/ +import combinatorics.simple_graph.regularity.bound +import combinatorics.simple_graph.regularity.equitabilise +import combinatorics.simple_graph.regularity.uniform + +/-! +# Chunk of the increment partition for Szemerédi Regularity Lemma + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In the proof of Szemerédi Regularity Lemma, we need to partition each part of a starting partition +to increase the energy. This file defines those partitions of parts and shows that they locally +increase the energy. + +This entire file is internal to the proof of Szemerédi Regularity Lemma. + +## Main declarations + +* `szemeredi_regularity.chunk`: The partition of a part of the starting partition. +* `szemeredi_regularity.edge_density_chunk_uniform`: `chunk` does not locally decrease the edge + density between uniform parts too much. +* `szemeredi_regularity.edge_density_chunk_not_uniform`: `chunk` locally increases the edge density + between non-uniform parts. + +## TODO + +Once ported to mathlib4, this file will be a great golfing ground for Heather's new tactic +`rel_congr`. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] +-/ + +open finpartition finset fintype rel nat +open_locale big_operators classical + +local attribute [positivity] tactic.positivity_szemeredi_regularity + +namespace szemeredi_regularity +variables {α : Type*} [fintype α] {P : finpartition (univ : finset α)} (hP : P.is_equipartition) + (G : simple_graph α) (ε : ℝ) {U : finset α} (hU : U ∈ P.parts) (V : finset α) + +local notation `m` := (card α/step_bound P.parts.card : ℕ) + +/-! +### Definitions + +We define `chunk`, the partition of a part, and `star`, the sets of parts of `chunk` that are +contained in the corresponding witness of non-uniformity. +-/ + +/-- The portion of `szemeredi_regularity.increment` which partitions `U`. -/ +noncomputable def chunk : finpartition U := +if hUcard : U.card = m * 4 ^ P.parts.card + (card α/P.parts.card - m * 4 ^ P.parts.card) + then (atomise U $ P.nonuniform_witnesses G ε U).equitabilise $ card_aux₁ hUcard + else (atomise U $ P.nonuniform_witnesses G ε U).equitabilise $ card_aux₂ hP hU hUcard +-- `hP` and `hU` are used to get that `U` has size +-- `m * 4 ^ P.parts.card + a or m * 4 ^ P.parts.card + a + 1` + +/-- The portion of `szemeredi_regularity.chunk` which is contained in the witness of non uniformity +of `U` and `V`. -/ +noncomputable def star (V : finset α) : finset (finset α) := +(chunk hP G ε hU).parts.filter (⊆ G.nonuniform_witness ε U V) + +/-! +### Density estimates + +We estimate the density between parts of `chunk`. +-/ + +lemma bUnion_star_subset_nonuniform_witness : + (star hP G ε hU V).bUnion id ⊆ G.nonuniform_witness ε U V := +bUnion_subset_iff_forall_subset.2 $ λ A hA, (mem_filter.1 hA).2 + +variables {hP G ε hU V} {𝒜 : finset (finset α)} {s : finset α} + +lemma star_subset_chunk : star hP G ε hU V ⊆ (chunk hP G ε hU).parts := filter_subset _ _ + +private lemma card_nonuniform_witness_sdiff_bUnion_star (hV : V ∈ P.parts) (hUV : U ≠ V) + (h₂ : ¬G.is_uniform ε U V) : + (G.nonuniform_witness ε U V \ (star hP G ε hU V).bUnion id).card ≤ 2 ^ (P.parts.card - 1) * m := +begin + have hX : G.nonuniform_witness ε U V ∈ P.nonuniform_witnesses G ε U := + nonuniform_witness_mem_nonuniform_witnesses h₂ hV hUV, + have q : G.nonuniform_witness ε U V \ (star hP G ε hU V).bUnion id ⊆ + ((atomise U $ P.nonuniform_witnesses G ε U).parts.filter $ + λ B, B ⊆ G.nonuniform_witness ε U V ∧ B.nonempty).bUnion + (λ B, B \ ((chunk hP G ε hU).parts.filter (⊆ B)).bUnion id), + { intros x hx, + rw [←bUnion_filter_atomise hX (G.nonuniform_witness_subset h₂), star, mem_sdiff, mem_bUnion] at + hx, + simp only [not_exists, mem_bUnion, and_imp, filter_congr_decidable, exists_prop, mem_filter, + not_and, mem_sdiff, id.def, mem_sdiff] at hx ⊢, + obtain ⟨⟨B, hB₁, hB₂⟩, hx⟩ := hx, + exact ⟨B, hB₁, hB₂, λ A hA AB, hx A hA $ AB.trans hB₁.2.1⟩ }, + apply (card_le_of_subset q).trans (card_bUnion_le.trans _), + transitivity ∑ i in (atomise U $ P.nonuniform_witnesses G ε U).parts.filter + (λ B, B ⊆ G.nonuniform_witness ε U V ∧ B.nonempty), m, + { suffices : ∀ B ∈ (atomise U $ P.nonuniform_witnesses G ε U).parts, + (B \ ((chunk hP G ε hU).parts.filter (⊆ B)).bUnion id).card ≤ m, + { exact sum_le_sum (λ B hB, this B $ filter_subset _ _ hB) }, + intros B hB, + unfold chunk, + split_ifs with h₁, + { convert card_parts_equitabilise_subset_le _ (card_aux₁ h₁) hB }, + { convert card_parts_equitabilise_subset_le _ (card_aux₂ hP hU h₁) hB } }, + rw sum_const, + refine mul_le_mul_right' _ _, + have t := card_filter_atomise_le_two_pow hX, + rw filter_congr_decidable at t, + refine t.trans (pow_le_pow (by norm_num) $ tsub_le_tsub_right _ _), + exact card_image_le.trans (card_le_of_subset $ filter_subset _ _), +end + +private lemma one_sub_eps_mul_card_nonuniform_witness_le_card_star (hV : V ∈ P.parts) (hUV : U ≠ V) + (hunif : ¬G.is_uniform ε U V) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) (hε₁ : ε ≤ 1) : + (1 - ε/10) * (G.nonuniform_witness ε U V).card ≤ ((star hP G ε hU V).bUnion id).card := +begin + have hP₁ : 0 < P.parts.card := finset.card_pos.2 ⟨_, hU⟩, + have : (2^P.parts.card : ℝ) * m/(U.card * ε) ≤ ε/10, + { rw [←div_div, div_le_iff'], + swap, + positivity, + refine le_of_mul_le_mul_left _ (pow_pos zero_lt_two P.parts.card), + calc + 2^P.parts.card * ((2^P.parts.card * m : ℝ)/U.card) + = (2 * 2)^P.parts.card * m/U.card : by rw [mul_pow, ←mul_div_assoc, mul_assoc] + ... = 4 ^ P.parts.card * m/U.card : by norm_num + ... ≤ 1 : div_le_one_of_le (pow_mul_m_le_card_part hP hU) (cast_nonneg _) + ... ≤ 2^P.parts.card * ε ^ 2 / 10 : begin + refine (one_le_sq_iff $ by positivity).1 _, + rw [div_pow, mul_pow, pow_right_comm, ←pow_mul ε, + one_le_div (sq_pos_of_ne_zero (10 : ℝ) $ by norm_num)], + calc + (10 ^ 2 : ℝ) + = 100 : by norm_num + ... ≤ 4 ^ P.parts.card * ε ^ 5 : hPε + ... ≤ 4 ^ P.parts.card * ε^4 + : mul_le_mul_of_nonneg_left (pow_le_pow_of_le_one (by positivity) hε₁ $ + le_succ _) (by positivity) + ... = (2 ^ 2)^P.parts.card * ε ^ (2 * 2) : by norm_num, + end + ... = 2^P.parts.card * (ε * (ε / 10)) : by rw [mul_div_assoc, sq, mul_div_assoc] }, + calc + (1 - ε/10) * (G.nonuniform_witness ε U V).card + ≤ (1 - 2^P.parts.card * m/(U.card * ε)) * (G.nonuniform_witness ε U V).card + : mul_le_mul_of_nonneg_right (sub_le_sub_left this _) (cast_nonneg _) + ... = (G.nonuniform_witness ε U V).card - 2^P.parts.card * m/(U.card * ε) + * (G.nonuniform_witness ε U V).card + : by rw [sub_mul, one_mul] + ... ≤ (G.nonuniform_witness ε U V).card - 2^(P.parts.card - 1) * m : begin + refine sub_le_sub_left _ _, + have : (2 : ℝ)^P.parts.card = 2^(P.parts.card - 1) * 2, + { rw [←pow_succ', tsub_add_cancel_of_le (succ_le_iff.2 hP₁)] }, + rw [←mul_div_right_comm, this, mul_right_comm _ (2 : ℝ), mul_assoc, le_div_iff], + refine mul_le_mul_of_nonneg_left _ (by positivity), + exact (G.le_card_nonuniform_witness hunif).trans + (le_mul_of_one_le_left (cast_nonneg _) one_le_two), + have := P.nonempty_of_mem_parts hU, + positivity, + end + ... ≤ ((star hP G ε hU V).bUnion id).card : begin + norm_cast, + rw [sub_le_comm, ←cast_sub (card_le_of_subset $ + bUnion_star_subset_nonuniform_witness hP G ε hU V), ←card_sdiff + (bUnion_star_subset_nonuniform_witness hP G ε hU V), cast_le], + exact card_nonuniform_witness_sdiff_bUnion_star hV hUV hunif, + end +end + +variables {hP G ε U hU V} + +/-! ### `chunk` -/ + +lemma card_chunk (hm : m ≠ 0) : (chunk hP G ε hU).parts.card = 4 ^ P.parts.card := +begin + unfold chunk, + split_ifs, + { rw [card_parts_equitabilise _ _ hm, tsub_add_cancel_of_le], + exact le_of_lt a_add_one_le_four_pow_parts_card }, + { rw [card_parts_equitabilise _ _ hm, tsub_add_cancel_of_le a_add_one_le_four_pow_parts_card] } +end + +lemma card_eq_of_mem_parts_chunk (hs : s ∈ (chunk hP G ε hU).parts) : s.card = m ∨ s.card = m + 1 := +by { unfold chunk at hs, split_ifs at hs; exact card_eq_of_mem_parts_equitabilise hs } + +lemma m_le_card_of_mem_chunk_parts (hs : s ∈ (chunk hP G ε hU).parts) : m ≤ s.card := +(card_eq_of_mem_parts_chunk hs).elim ge_of_eq $ λ i, by simp [i] + +lemma card_le_m_add_one_of_mem_chunk_parts (hs : s ∈ (chunk hP G ε hU).parts) : s.card ≤ m + 1 := +(card_eq_of_mem_parts_chunk hs).elim (λ i, by simp [i]) (λ i, i.le) + +lemma card_bUnion_star_le_m_add_one_card_star_mul : + (((star hP G ε hU V).bUnion id).card : ℝ) ≤ (star hP G ε hU V).card * (m + 1) := +by exact_mod_cast (card_bUnion_le_card_mul _ _ _ $ λ s hs, + card_le_m_add_one_of_mem_chunk_parts $ star_subset_chunk hs) + +private lemma le_sum_card_subset_chunk_parts (h𝒜 : 𝒜 ⊆ (chunk hP G ε hU).parts) (hs : s ∈ 𝒜) : + (𝒜.card : ℝ) * s.card * (m / (m + 1)) ≤ (𝒜.sup id).card := +begin + rw [mul_div_assoc', div_le_iff coe_m_add_one_pos, mul_right_comm], + refine mul_le_mul _ _ (cast_nonneg _) (cast_nonneg _), + { rw [←(of_subset _ h𝒜 rfl).sum_card_parts, of_subset_parts, ←cast_mul, cast_le], + exact card_nsmul_le_sum _ _ _ (λ x hx, m_le_card_of_mem_chunk_parts $ h𝒜 hx) }, + { exact_mod_cast card_le_m_add_one_of_mem_chunk_parts (h𝒜 hs) } +end + +private lemma sum_card_subset_chunk_parts_le (m_pos : (0 : ℝ) < m) + (h𝒜 : 𝒜 ⊆ (chunk hP G ε hU).parts) (hs : s ∈ 𝒜) : + ((𝒜.sup id).card : ℝ) ≤ (𝒜.card * s.card) * ((m+1)/m) := +begin + rw [sup_eq_bUnion, mul_div_assoc', le_div_iff m_pos, mul_right_comm], + refine mul_le_mul _ _ (cast_nonneg _) (by positivity), + { norm_cast, + refine card_bUnion_le_card_mul _ _ _ (λ x hx, _), + apply card_le_m_add_one_of_mem_chunk_parts (h𝒜 hx) }, + { exact_mod_cast m_le_card_of_mem_chunk_parts (h𝒜 hs) } +end + +private lemma one_sub_le_m_div_m_add_one_sq [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) : + 1 - ε ^ 5/50 ≤ (m/(m + 1)) ^ 2 := +begin + have : ((m:ℝ) / (m+1)) = 1 - 1/(m+1), + { rw [one_sub_div coe_m_add_one_pos.ne', add_sub_cancel] }, + rw [this, sub_sq, one_pow, mul_one], + refine le_trans _ (le_add_of_nonneg_right $ sq_nonneg _), + rw [sub_le_sub_iff_left, ←le_div_iff' (show (0:ℝ) < 2, by norm_num), div_div, + one_div_le coe_m_add_one_pos, one_div_div], + refine le_trans _ (le_add_of_nonneg_right zero_le_one), + norm_num, + apply hundred_div_ε_pow_five_le_m hPα hPε, + positivity, +end + +private lemma m_add_one_div_m_le_one_add [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hε₁ : ε ≤ 1) : + ((m + 1 : ℝ)/m) ^ 2 ≤ 1 + ε ^ 5/49 := +begin + rw same_add_div, + swap, + { positivity }, + have : 1 + 1/(m:ℝ) ≤ 1 + ε ^ 5/100, + { rw [add_le_add_iff_left, ←one_div_div (100:ℝ)], + exact one_div_le_one_div_of_le (by positivity) (hundred_div_ε_pow_five_le_m hPα hPε) }, + refine (pow_le_pow_of_le_left _ this 2).trans _, + { positivity }, + rw [add_sq, one_pow, add_assoc, add_le_add_iff_left, mul_one, ←le_sub_iff_add_le', + div_eq_mul_one_div _ (49:ℝ), mul_div_left_comm (2:ℝ), ←mul_sub_left_distrib, div_pow, + div_le_iff (show (0:ℝ) < 100 ^ 2, by norm_num), mul_assoc, sq], + refine mul_le_mul_of_nonneg_left _ (by positivity), + exact (pow_le_one 5 (by positivity) hε₁).trans (by norm_num), +end + +private lemma density_sub_eps_le_sum_density_div_card [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + {hU : U ∈ P.parts} {hV : V ∈ P.parts} {A B : finset (finset α)} + (hA : A ⊆ (chunk hP G ε hU).parts) (hB : B ⊆ (chunk hP G ε hV).parts) : + ↑(G.edge_density (A.bUnion id) (B.bUnion id)) - ε ^ 5/50 ≤ + (∑ ab in A.product B, G.edge_density ab.1 ab.2)/(A.card * B.card) := +begin + have : ↑(G.edge_density (A.bUnion id) (B.bUnion id)) - ε ^ 5/50 + ≤ (1 - ε ^ 5/50) * G.edge_density (A.bUnion id) (B.bUnion id), + { rw [sub_mul, one_mul, sub_le_sub_iff_left], + refine mul_le_of_le_one_right (by positivity) _, + exact_mod_cast G.edge_density_le_one _ _ }, + refine this.trans _, + simp only [simple_graph.edge_density_def, simple_graph.interedges, ←sup_eq_bUnion, cast_sum, + rel.card_interedges_finpartition _ (of_subset _ hA rfl) (of_subset _ hB rfl), of_subset_parts, + sum_div, mul_sum, rat.cast_sum, rat.cast_div, rat.cast_mul, div_div, + mul_div_left_comm ((1:ℝ) - _)], + push_cast, + apply sum_le_sum, + simp only [and_imp, prod.forall, mem_product], + rintro x y hx hy, + rw [mul_mul_mul_comm, mul_comm (x.card : ℝ), mul_comm (y.card : ℝ), le_div_iff, mul_assoc], + { refine mul_le_of_le_one_right (cast_nonneg _) _, + rw [div_mul_eq_mul_div, ←mul_assoc, mul_assoc], + refine div_le_one_of_le _ (by positivity), + refine (mul_le_mul_of_nonneg_right (one_sub_le_m_div_m_add_one_sq hPα hPε) _).trans _, + { exact_mod_cast (zero_le _) }, + rw [sq, mul_mul_mul_comm, mul_comm ((m:ℝ)/_), mul_comm ((m:ℝ)/_)], + refine mul_le_mul _ _ _ (cast_nonneg _), + apply le_sum_card_subset_chunk_parts hA hx, + apply le_sum_card_subset_chunk_parts hB hy, + positivity }, + refine mul_pos (mul_pos _ _) (mul_pos _ _); rw [cast_pos, finset.card_pos], + exacts [⟨_, hx⟩, nonempty_of_mem_parts _ (hA hx), ⟨_, hy⟩, nonempty_of_mem_parts _ (hB hy)] +end + +private lemma sum_density_div_card_le_density_add_eps [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hε₁ : ε ≤ 1) {hU : U ∈ P.parts} {hV : V ∈ P.parts} {A B : finset (finset α)} + (hA : A ⊆ (chunk hP G ε hU).parts) (hB : B ⊆ (chunk hP G ε hV).parts) : + (∑ ab in A.product B, G.edge_density ab.1 ab.2 : ℝ) / (A.card * B.card) ≤ + G.edge_density (A.bUnion id) (B.bUnion id) + ε ^ 5 / 49 := +begin + have : (1 + ε ^ 5/49) * G.edge_density (A.bUnion id) (B.bUnion id) ≤ + G.edge_density (A.bUnion id) (B.bUnion id) + ε ^ 5 / 49, + { rw [add_mul, one_mul, add_le_add_iff_left], + refine mul_le_of_le_one_right (by positivity) _, + exact_mod_cast G.edge_density_le_one _ _ }, + refine le_trans _ this, + simp only [simple_graph.edge_density, edge_density, ←sup_eq_bUnion, cast_sum, mul_sum, sum_div, + rel.card_interedges_finpartition _ (of_subset _ hA rfl) (of_subset _ hB rfl), rat.cast_sum, + rat.cast_div, rat.cast_mul, of_subset_parts, mul_div_left_comm ((1:ℝ) + _), div_div], + push_cast, + apply sum_le_sum, + simp only [and_imp, prod.forall, mem_product], + intros x y hx hy, + rw [mul_mul_mul_comm, mul_comm (x.card : ℝ), mul_comm (y.card : ℝ), div_le_iff, mul_assoc], + { refine le_mul_of_one_le_right (cast_nonneg _) _, + rw [div_mul_eq_mul_div, one_le_div], + refine le_trans _ (mul_le_mul_of_nonneg_right (m_add_one_div_m_le_one_add hPα hPε hε₁) _), + { rw [sq, mul_mul_mul_comm, mul_comm (_/(m:ℝ)), mul_comm (_/(m:ℝ))], + exact mul_le_mul (sum_card_subset_chunk_parts_le (by positivity) hA hx) + (sum_card_subset_chunk_parts_le (by positivity) hB hy) (by positivity) (by positivity) }, + { exact_mod_cast (zero_le _) }, + rw [←cast_mul, cast_pos], + apply mul_pos; rw [finset.card_pos, sup_eq_bUnion, bUnion_nonempty], + { exact ⟨_, hx, nonempty_of_mem_parts _ (hA hx)⟩ }, + { exact ⟨_, hy, nonempty_of_mem_parts _ (hB hy)⟩ } }, + refine mul_pos (mul_pos _ _) (mul_pos _ _); rw [cast_pos, finset.card_pos], + exacts [⟨_, hx⟩, nonempty_of_mem_parts _ (hA hx), ⟨_, hy⟩, nonempty_of_mem_parts _ (hB hy)] +end + +private lemma average_density_near_total_density [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hε₁ : ε ≤ 1) {hU : U ∈ P.parts} {hV : V ∈ P.parts} {A B : finset (finset α)} + (hA : A ⊆ (chunk hP G ε hU).parts) (hB : B ⊆ (chunk hP G ε hV).parts) : + |(∑ ab in A.product B, G.edge_density ab.1 ab.2 : ℝ)/(A.card * B.card) - + G.edge_density (A.bUnion id) (B.bUnion id)| ≤ ε ^ 5/49 := +begin + rw abs_sub_le_iff, + split, + { rw sub_le_iff_le_add', + exact sum_density_div_card_le_density_add_eps hPα hPε hε₁ hA hB }, + suffices : (G.edge_density (A.bUnion id) (B.bUnion id) : ℝ) - + (∑ ab in A.product B, G.edge_density ab.1 ab.2)/(A.card * B.card) ≤ ε ^ 5/50, + { apply this.trans, + exact div_le_div_of_le_left (by positivity) (by norm_num) (by norm_num) }, + rw [sub_le_iff_le_add, ←sub_le_iff_le_add'], + apply density_sub_eps_le_sum_density_div_card hPα hPε hA hB, +end + +private lemma edge_density_chunk_aux [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hU : U ∈ P.parts) (hV : V ∈ P.parts) : + ↑(G.edge_density U V) ^ 2 - ε ^ 5/25 ≤ + ((∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2)/16 ^ P.parts.card) ^ 2 := +begin + obtain hGε | hGε := le_total ↑(G.edge_density U V) (ε ^ 5/50), + { refine (sub_nonpos_of_le $ (sq_le _ _).trans $ hGε.trans _).trans (sq_nonneg _), + { exact_mod_cast G.edge_density_nonneg _ _ }, + { exact_mod_cast G.edge_density_le_one _ _ }, + { exact div_le_div_of_le_left (by positivity) (by norm_num) (by norm_num) } }, + rw ←sub_nonneg at hGε, + have : ↑(G.edge_density U V) - ε ^ 5 / 50 ≤ + (∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2) / (16 ^ P.parts.card), + { refine (le_trans _ $ density_sub_eps_le_sum_density_div_card hPα hPε + (set.subset.refl (chunk hP G ε hU).parts) + (set.subset.refl (chunk hP G ε hV).parts)).trans _, + { rw [bUnion_parts, bUnion_parts] }, + { rw [card_chunk (m_pos hPα).ne', card_chunk (m_pos hPα).ne', ←cast_mul, + ←mul_pow, cast_pow], + norm_cast } }, + refine le_trans _ (pow_le_pow_of_le_left hGε this 2), + rw [sub_sq, sub_add, sub_le_sub_iff_left], + refine (sub_le_self _ $ sq_nonneg $ ε ^ 5/50).trans _, + rw [mul_right_comm, mul_div_left_comm, div_eq_mul_inv (ε ^ 5), show (2:ℝ)/50 = 25⁻¹, by norm_num], + exact mul_le_of_le_one_right (by positivity) (by exact_mod_cast G.edge_density_le_one _ _), +end + +private lemma abs_density_star_sub_density_le_eps (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hε₁ : ε ≤ 1) {hU : U ∈ P.parts} {hV : V ∈ P.parts} (hUV' : U ≠ V) (hUV : ¬ G.is_uniform ε U V) : + |(G.edge_density ((star hP G ε hU V).bUnion id) ((star hP G ε hV U).bUnion id) : ℝ) - + G.edge_density (G.nonuniform_witness ε U V) (G.nonuniform_witness ε V U)| ≤ ε/5 := +begin + convert abs_edge_density_sub_edge_density_le_two_mul G.adj + (bUnion_star_subset_nonuniform_witness hP G ε hU V) + (bUnion_star_subset_nonuniform_witness hP G ε hV U) + (by positivity) + (one_sub_eps_mul_card_nonuniform_witness_le_card_star hV hUV' hUV hPε hε₁) + (one_sub_eps_mul_card_nonuniform_witness_le_card_star hU hUV'.symm (λ hVU, hUV hVU.symm) + hPε hε₁), + linarith, +end + +private lemma eps_le_card_star_div [nonempty α] (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) + (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) (hε₁ : ε ≤ 1) (hU : U ∈ P.parts) + (hV : V ∈ P.parts) (hUV : U ≠ V) (hunif : ¬ G.is_uniform ε U V) : + 4/5 * ε ≤ (star hP G ε hU V).card / 4 ^ P.parts.card := +begin + have hm : (0 : ℝ) ≤ 1 - m⁻¹ := sub_nonneg_of_le (inv_le_one $ one_le_m_coe hPα), + have hε : 0 ≤ 1 - ε / 10 := + sub_nonneg_of_le (div_le_one_of_le (hε₁.trans $ by norm_num) $ by norm_num), + calc + 4/5 * ε + = (1 - 1/10) * (1 - 9⁻¹) * ε : by norm_num + ... ≤ (1 - ε/10) * (1 - m⁻¹) * ((G.nonuniform_witness ε U V).card / U.card) + : mul_le_mul + (mul_le_mul (sub_le_sub_left (div_le_div_of_le_of_nonneg hε₁ $ by norm_num) _) + (sub_le_sub_left (inv_le_inv_of_le (by norm_num) $ + by exact_mod_cast (show 9 ≤ 100, by norm_num).trans (hundred_le_m hPα hPε hε₁)) _) + (by norm_num) hε) + ((le_div_iff' $ (@cast_pos ℝ _ _ _).2 (P.nonempty_of_mem_parts hU).card_pos).2 $ + G.le_card_nonuniform_witness hunif) + (by positivity) (by positivity) + ... = (1 - ε/10) * (G.nonuniform_witness ε U V).card * ((1 - m⁻¹) / U.card) + : by rw [mul_assoc, mul_assoc, mul_div_left_comm] + ... ≤ ((star hP G ε hU V).bUnion id).card * ((1 - m⁻¹) / U.card) + : mul_le_mul_of_nonneg_right + (one_sub_eps_mul_card_nonuniform_witness_le_card_star hV hUV hunif hPε hε₁) + (by positivity) + ... ≤ (star hP G ε hU V).card * (m + 1) * ((1 - m⁻¹) / U.card) : + mul_le_mul_of_nonneg_right card_bUnion_star_le_m_add_one_card_star_mul (by positivity) + ... ≤ (star hP G ε hU V).card * (m + 1) * ((1 - m⁻¹) / (4 ^ P.parts.card * m)) + : mul_le_mul_of_nonneg_left (div_le_div_of_le_left hm (by positivity) $ + pow_mul_m_le_card_part hP hU) (by positivity) + ... ≤ (star hP G ε hU V).card / 4 ^ P.parts.card : + begin + rw [mul_assoc, mul_comm ((4:ℝ)^P.parts.card), ←div_div, ←mul_div_assoc, ←mul_comm_div], + refine mul_le_of_le_one_right (by positivity) _, + have hm : (0 : ℝ) < m := by positivity, + rw [mul_div_assoc', div_le_one hm, ←one_div, one_sub_div hm.ne', mul_div_assoc', + div_le_iff hm], + linarith, + end +end + +/-! +### Final bounds + +Those inequalities are the end result of all this hard work. +-/ + +/-- Lower bound on the edge densities between non-uniform parts of `szemeredi_regularity.star`. -/ +private lemma edge_density_star_not_uniform [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hε₁ : ε ≤ 1) {hU : U ∈ P.parts} {hV : V ∈ P.parts} (hUVne : U ≠ V) (hUV : ¬ G.is_uniform ε U V) : + 3/4 * ε ≤ + |(∑ ab in (star hP G ε hU V).product (star hP G ε hV U), G.edge_density ab.1 ab.2) + / ((star hP G ε hU V).card * (star hP G ε hV U).card) - + (∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2)/16 ^ P.parts.card| := +begin + rw [(show (16:ℝ) = 4 ^ 2, by norm_num), pow_right_comm, sq ((4:ℝ)^_)], + set p : ℝ := (∑ ab in (star hP G ε hU V).product (star hP G ε hV U), G.edge_density ab.1 ab.2) + / ((star hP G ε hU V).card * (star hP G ε hV U).card), + set q : ℝ := (∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2)/(4 ^ P.parts.card * 4 ^ P.parts.card), + change _ ≤ |p - q|, + set r : ℝ := G.edge_density ((star hP G ε hU V).bUnion id) ((star hP G ε hV U).bUnion id), + set s : ℝ := G.edge_density (G.nonuniform_witness ε U V) (G.nonuniform_witness ε V U), + set t : ℝ := G.edge_density U V, + have hrs : |r - s| ≤ ε/5 := abs_density_star_sub_density_le_eps hPε hε₁ hUVne hUV, + have hst : ε ≤ |s - t| := G.nonuniform_witness_spec hUVne hUV, + have hpr : |p - r| ≤ ε ^ 5/49 := average_density_near_total_density hPα hPε hε₁ + star_subset_chunk star_subset_chunk, + have hqt : |q - t| ≤ ε ^ 5/49, + { have := average_density_near_total_density hPα hPε hε₁ + (subset.refl (chunk hP G ε hU).parts) + (subset.refl (chunk hP G ε hV).parts), + simp_rw [←sup_eq_bUnion, sup_parts, card_chunk (m_pos hPα).ne', cast_pow] at this, + norm_num at this, + exact this }, + have hε' : ε ^ 5 ≤ ε := by simpa using pow_le_pow_of_le_one (by positivity) hε₁ + (show 1 ≤ 5, by norm_num), + have hpr' : |p - r| ≤ ε/49 := hpr.trans (div_le_div_of_le_of_nonneg hε' $ by norm_num), + have hqt' : |q - t| ≤ ε/49 := hqt.trans (div_le_div_of_le_of_nonneg hε' $ by norm_num), + rw abs_sub_le_iff at hrs hpr' hqt', + rw le_abs at hst ⊢, + cases hst, + left, linarith, + right, linarith, +end + +/-- Lower bound on the edge densities between non-uniform parts of `szemeredi_regularity.increment`. +-/ +lemma edge_density_chunk_not_uniform [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hε₁ : ε ≤ 1) {hU : U ∈ P.parts} {hV : V ∈ P.parts} (hUVne : U ≠ V) (hUV : ¬ G.is_uniform ε U V) : + (G.edge_density U V : ℝ) ^ 2 - ε ^ 5/25 + ε^4/3 ≤ + (∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2 ^ 2)/16 ^ P.parts.card := +calc + ↑(G.edge_density U V) ^ 2 - ε ^ 5/25 + ε^4/3 + ≤ G.edge_density U V ^ 2 - ε ^ 5/25 + + (star hP G ε hU V).card * (star hP G ε hV U).card/16 ^ P.parts.card * (9/16) * ε ^ 2 : + begin + apply add_le_add_left, + have Ul : 4/5 * ε ≤ (star hP G ε hU V).card / _ := + eps_le_card_star_div hPα hPε hε₁ hU hV hUVne hUV, + have Vl : 4/5 * ε ≤ (star hP G ε hV U).card / _ := + eps_le_card_star_div hPα hPε hε₁ hV hU hUVne.symm (λ h, hUV h.symm), + rw [(show (16 : ℝ) = 4 ^ 2, by norm_num), pow_right_comm, sq ((4:ℝ)^_), + ←_root_.div_mul_div_comm, mul_assoc], + have : 0 < ε := by positivity, + have UVl := mul_le_mul Ul Vl (by positivity) (by positivity), + refine le_trans _ (mul_le_mul_of_nonneg_right UVl _), + { field_simp, + ring_nf, + apply mul_le_mul_of_nonneg_right, + norm_num, + positivity }, + { norm_num, + positivity } + end + ... ≤ (∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2 ^ 2)/16 ^ P.parts.card : + begin + have t : (star hP G ε hU V).product (star hP G ε hV U) ⊆ + (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts := + product_subset_product star_subset_chunk star_subset_chunk, + have hε : 0 ≤ ε := by positivity, + have := add_div_le_sum_sq_div_card t (λ x, (G.edge_density x.1 x.2 : ℝ)) + (G.edge_density U V ^ 2 - ε ^ 5/25) (show 0 ≤ 3/4 * ε, by linarith) _ _, + { simp_rw [card_product, card_chunk (m_pos hPα).ne', ←mul_pow, cast_pow, mul_pow, div_pow, + ←mul_assoc] at this, + norm_num at this, + exact this }, + { simp_rw [card_product, card_chunk (m_pos hPα).ne', ←mul_pow], + norm_num, + exact edge_density_star_not_uniform hPα hPε hε₁ hUVne hUV }, + { rw card_product, + apply (edge_density_chunk_aux hPα hPε hU hV).trans, + rw [card_chunk (m_pos hPα).ne', card_chunk (m_pos hPα).ne', ←mul_pow], + norm_num, + exact hP } + end + +/-- Lower bound on the edge densities between parts of `szemeredi_regularity.increment`. This is the +blanket lower bound used the uniform parts. -/ +lemma edge_density_chunk_uniform [nonempty α] + (hPα : P.parts.card * 16 ^ P.parts.card ≤ card α) (hPε : 100 ≤ 4 ^ P.parts.card * ε ^ 5) + (hU : U ∈ P.parts) (hV : V ∈ P.parts) : + (G.edge_density U V : ℝ) ^ 2 - ε ^ 5/25 ≤ + (∑ ab in (chunk hP G ε hU).parts.product (chunk hP G ε hV).parts, + G.edge_density ab.1 ab.2 ^ 2)/16 ^ P.parts.card := +begin + apply (edge_density_chunk_aux hPα hPε hU hV).trans, + convert sum_div_card_sq_le_sum_sq_div_card; + rw [card_product, cast_mul, card_chunk (m_pos hPα).ne', card_chunk (m_pos hPα).ne', ←cast_mul, + ←mul_pow]; + norm_cast, +end + +end szemeredi_regularity diff --git a/src/combinatorics/simple_graph/regularity/energy.lean b/src/combinatorics/simple_graph/regularity/energy.lean index 63c70714dcec0..e4e91107fb061 100644 --- a/src/combinatorics/simple_graph/regularity/energy.lean +++ b/src/combinatorics/simple_graph/regularity/energy.lean @@ -4,16 +4,25 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Bhavik Mehta -/ import algebra.big_operators.order +import algebra.module.basic import combinatorics.simple_graph.density +import data.rat.big_operators /-! # Energy of a partition +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the energy of a partition. The energy is the auxiliary quantity that drives the induction process in the proof of Szemerédi's Regularity Lemma. As long as we do not have a suitable equipartition, we will find a new one that has an energy greater than the previous one plus some fixed constant. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] -/ open finset @@ -40,4 +49,8 @@ div_le_of_nonneg_of_le_mul (sq_nonneg _) zero_le_one $ ... = P.parts.off_diag.card : nat.smul_one_eq_coe _ ... ≤ _ : by { rw [off_diag_card, one_mul, ←nat.cast_pow, nat.cast_le, sq], exact tsub_le_self } +@[simp, norm_cast] lemma coe_energy {𝕜 : Type*} [linear_ordered_field 𝕜] : + (P.energy G : 𝕜) = (∑ uv in P.parts.off_diag, G.edge_density uv.1 uv.2 ^ 2) / P.parts.card ^ 2 := +by { rw energy, norm_cast } + end finpartition diff --git a/src/combinatorics/simple_graph/regularity/equitabilise.lean b/src/combinatorics/simple_graph/regularity/equitabilise.lean new file mode 100644 index 0000000000000..35531993e5767 --- /dev/null +++ b/src/combinatorics/simple_graph/regularity/equitabilise.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Bhavik Mehta +-/ +import order.partition.equipartition + +/-! +# Equitabilising a partition + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file allows to blow partitions up into parts of controlled size. Given a partition `P` and +`a b m : ℕ`, we want to find a partition `Q` with `a` parts of size `m` and `b` parts of size +`m + 1` such that all parts of `P` are "as close as possible" to unions of parts of `Q`. By +"as close as possible", we mean that each part of `P` can be written as the union of some parts of +`Q` along with at most `m` other elements. + +## Main declarations + +* `finpartition.equitabilise`: `P.equitabilise h` where `h : a * m + b * (m + 1)` is a partition + with `a` parts of size `m` and `b` parts of size `m + 1` which almost refines `P`. +* `finpartition.exists_equipartition_card_eq`: We can find equipartitions of arbitrary size. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] +-/ + +open finset nat + +namespace finpartition +variables {α : Type*} [decidable_eq α] {s t : finset α} {m n a b : ℕ} {P : finpartition s} + +/-- Given a partition `P` of `s`, as well as a proof that `a * m + b * (m + 1) = s.card`, we can +find a new partition `Q` of `s` where each part has size `m` or `m + 1`, every part of `P` is the +union of parts of `Q` plus at most `m` extra elements, there are `b` parts of size `m + 1` and +(provided `m > 0`, because a partition does not have parts of size `0`) there are `a` parts of size +`m` and hence `a + b` parts in total. -/ +lemma equitabilise_aux (P : finpartition s) (hs : a * m + b * (m + 1) = s.card) : + ∃ Q : finpartition s, + (∀ x : finset α, x ∈ Q.parts → x.card = m ∨ x.card = m + 1) ∧ + (∀ x, x ∈ P.parts → (x \ (Q.parts.filter $ λ y, y ⊆ x).bUnion id).card ≤ m) ∧ + (Q.parts.filter $ λ i, card i = m + 1).card = b := +begin + -- Get rid of the easy case `m = 0` + obtain rfl | m_pos := m.eq_zero_or_pos, + { refine ⟨⊥, by simp, _, by simpa using hs.symm⟩, + simp only [le_zero_iff, card_eq_zero, mem_bUnion, exists_prop, mem_filter, id.def, and_assoc, + sdiff_eq_empty_iff_subset, subset_iff], + exact λ x hx a ha, ⟨{a}, mem_map_of_mem _ (P.le hx ha), singleton_subset_iff.2 ha, + mem_singleton_self _⟩ }, + -- Prove the case `m > 0` by strong induction on `s` + induction s using finset.strong_induction with s ih generalizing P a b, + -- If `a = b = 0`, then `s = ∅` and we can partition into zero parts + by_cases hab : a = 0 ∧ b = 0, + { simp only [hab.1, hab.2, add_zero, zero_mul, eq_comm, card_eq_zero] at hs, + subst hs, + exact ⟨finpartition.empty _, by simp, by simp [unique.eq_default P], by simp [hab.2]⟩ }, + simp_rw [not_and_distrib, ←ne.def, ←pos_iff_ne_zero] at hab, + -- `n` will be the size of the smallest part + set n := if 0 < a then m else m + 1 with hn, + -- Some easy facts about it + obtain ⟨hn₀, hn₁, hn₂, hn₃⟩ : 0 < n ∧ n ≤ m + 1 ∧ n ≤ a * m + b * (m + 1) ∧ + ite (0 < a) (a - 1) a * m + ite (0 < a) b (b - 1) * (m + 1) = s.card - n, + { rw [hn, ←hs], + split_ifs; rw [tsub_mul, one_mul], + { refine ⟨m_pos, le_succ _, le_add_right (le_mul_of_pos_left ‹0 < a›), _⟩, + rw tsub_add_eq_add_tsub (le_mul_of_pos_left h), }, + { refine ⟨succ_pos', le_rfl, le_add_left (le_mul_of_pos_left $ hab.resolve_left ‹¬0 < a›), _⟩, + rw ←add_tsub_assoc_of_le (le_mul_of_pos_left $ hab.resolve_left ‹¬0 < a›) } }, + /- We will call the inductive hypothesis on a partition of `s \ t` for a carefully chosen `t ⊆ s`. + To decide which, however, we must distinguish the case where all parts of `P` have size `m` (in + which case we take `t` to be an arbitrary subset of `s` of size `n`) from the case where at least + one part `u` of `P` has size `m + 1` (in which case we take `t` to be an arbitrary subset of `u` + of size `n`). The rest of each branch is just tedious calculations to satisfy the induction + hypothesis. -/ + by_cases ∀ u ∈ P.parts, card u < m + 1, + { obtain ⟨t, hts, htn⟩ := exists_smaller_set s n (hn₂.trans_eq hs), + have ht : t.nonempty := by rwa [←card_pos, htn], + have hcard : ite (0 < a) (a - 1) a * m + ite (0 < a) b (b - 1) * (m + 1) = (s \ t).card, + { rw [card_sdiff ‹t ⊆ s›, htn, hn₃] }, + obtain ⟨R, hR₁, hR₂, hR₃⟩ := @ih (s \ t) (sdiff_ssubset hts ‹t.nonempty›) (P.avoid t) + (if 0 < a then a-1 else a) (if 0 < a then b else b-1) hcard, + refine ⟨R.extend ht.ne_empty sdiff_disjoint (sdiff_sup_cancel hts), _, _, _⟩, + { simp only [extend_parts, mem_insert, forall_eq_or_imp, and_iff_left hR₁, htn, hn], + exact ite_eq_or_eq _ _ _ }, + { exact λ x hx, (card_le_of_subset $ sdiff_subset _ _).trans (lt_succ_iff.1 $ h _ hx) }, + simp_rw [extend_parts, filter_insert, htn, hn, m.succ_ne_self.symm.ite_eq_right_iff], + split_ifs with ha, + { rw [hR₃, if_pos ha] }, + rw [card_insert_of_not_mem (λ H, _), hR₃, if_neg ha, tsub_add_cancel_of_le], + { exact hab.resolve_left ha }, + { exact ht.ne_empty (le_sdiff_iff.1 $ R.le $ filter_subset _ _ H) } }, + push_neg at h, + obtain ⟨u, hu₁, hu₂⟩ := h, + obtain ⟨t, htu, htn⟩ := exists_smaller_set _ _ (hn₁.trans hu₂), + have ht : t.nonempty := by rwa [←card_pos, htn], + have hcard : ite (0 < a) (a - 1) a * m + ite (0 < a) b (b - 1) * (m + 1) = (s \ t).card, + { rw [card_sdiff (htu.trans $ P.le hu₁), htn, hn₃] }, + obtain ⟨R, hR₁, hR₂, hR₃⟩ := @ih (s \ t) (sdiff_ssubset (htu.trans $ P.le hu₁) ht) (P.avoid t) + (if 0 < a then a-1 else a) (if 0 < a then b else b-1) hcard, + refine ⟨R.extend ht.ne_empty sdiff_disjoint (sdiff_sup_cancel $ htu.trans $ P.le hu₁), _, _, _⟩, + { simp only [mem_insert, forall_eq_or_imp, extend_parts, and_iff_left hR₁, htn, hn], + exact ite_eq_or_eq _ _ _ }, + { conv in (_ ∈ _) {rw ←insert_erase hu₁}, + simp only [and_imp, mem_insert, forall_eq_or_imp, ne.def, extend_parts], + refine ⟨_, λ x hx, (card_le_of_subset _).trans $ hR₂ x _⟩, + { simp only [filter_insert, if_pos htu, bUnion_insert, mem_erase, id.def], + obtain rfl | hut := eq_or_ne u t, + { rw sdiff_eq_empty_iff_subset.2 (subset_union_left _ _), + exact bot_le }, + refine (card_le_of_subset $ λ i, _).trans (hR₂ (u \ t) $ + P.mem_avoid.2 ⟨u, hu₁, λ i, hut $ i.antisymm htu, rfl⟩), + simp only [not_exists, mem_bUnion, and_imp, mem_union, mem_filter, mem_sdiff, id.def, + not_or_distrib], + exact λ hi₁ hi₂ hi₃, ⟨⟨hi₁, hi₂⟩, λ x hx hx', hi₃ _ hx $ hx'.trans $ sdiff_subset _ _⟩ }, + { apply sdiff_subset_sdiff subset.rfl (bUnion_subset_bUnion_of_subset_left _ _), + exact filter_subset_filter _ (subset_insert _ _) }, + simp only [avoid, of_erase, mem_erase, mem_image, bot_eq_empty], + exact ⟨(nonempty_of_mem_parts _ $ mem_of_mem_erase hx).ne_empty, _, mem_of_mem_erase hx, + (disjoint_of_subset_right htu $ P.disjoint (mem_of_mem_erase hx) hu₁ $ + ne_of_mem_erase hx).sdiff_eq_left⟩ }, + simp only [extend_parts, filter_insert, htn, hn, m.succ_ne_self.symm.ite_eq_right_iff], + split_ifs, + { rw [hR₃, if_pos h] }, + { rw [card_insert_of_not_mem (λ H, _), hR₃, if_neg h, nat.sub_add_cancel (hab.resolve_left h)], + exact ht.ne_empty (le_sdiff_iff.1 $ R.le $ filter_subset _ _ H) } +end + +variables (P) (h : a * m + b * (m + 1) = s.card) + +/-- Given a partition `P` of `s`, as well as a proof that `a * m + b * (m + 1) = s.card`, build a +new partition `Q` of `s` where each part has size `m` or `m + 1`, every part of `P` is the union of +parts of `Q` plus at most `m` extra elements, there are `b` parts of size `m + 1` and (provided +`m > 0`, because a partition does not have parts of size `0`) there are `a` parts of size `m` and +hence `a + b` parts in total. -/ +noncomputable def equitabilise : finpartition s := (P.equitabilise_aux h).some + +variables {P h} + +lemma card_eq_of_mem_parts_equitabilise : + t ∈ (P.equitabilise h).parts → t.card = m ∨ t.card = m + 1 := +(P.equitabilise_aux h).some_spec.1 _ + +lemma equitabilise_is_equipartition : (P.equitabilise h).is_equipartition := +set.equitable_on_iff_exists_eq_eq_add_one.2 ⟨m, λ u, card_eq_of_mem_parts_equitabilise⟩ + +variables (P h) + +lemma card_filter_equitabilise_big : + ((P.equitabilise h).parts.filter $ λ u : finset α, u.card = m + 1).card = b := +(P.equitabilise_aux h).some_spec.2.2 + +lemma card_filter_equitabilise_small (hm : m ≠ 0) : + ((P.equitabilise h).parts.filter $ λ u : finset α, u.card = m).card = a := +begin + refine (mul_eq_mul_right_iff.1 $ (add_left_inj (b * (m + 1))).1 _).resolve_right hm, + rw [h, ←(P.equitabilise h).sum_card_parts], + have hunion : (P.equitabilise h).parts = (P.equitabilise h).parts.filter (λ u, u.card = m) ∪ + (P.equitabilise h).parts.filter (λ u, u.card = m + 1), + { rw [←filter_or, filter_true_of_mem], + exact λ x, card_eq_of_mem_parts_equitabilise }, + nth_rewrite 1 hunion, + rw [sum_union, sum_const_nat (λ x hx, (mem_filter.1 hx).2), + sum_const_nat (λ x hx, (mem_filter.1 hx).2), P.card_filter_equitabilise_big], + refine disjoint_filter_filter' _ _ _, + intros x ha hb i h, + apply succ_ne_self m _, + exact (hb i h).symm.trans (ha i h), +end + +lemma card_parts_equitabilise (hm : m ≠ 0) : (P.equitabilise h).parts.card = a + b := +begin + rw [←filter_true_of_mem (λ x, card_eq_of_mem_parts_equitabilise), filter_or, card_union_eq, + P.card_filter_equitabilise_small _ hm, P.card_filter_equitabilise_big], + exact disjoint_filter.2 (λ x _ h₀ h₁, nat.succ_ne_self m $ h₁.symm.trans h₀), + apply_instance +end + +lemma card_parts_equitabilise_subset_le : + t ∈ P.parts → (t \ ((P.equitabilise h).parts.filter $ λ u, u ⊆ t).bUnion id).card ≤ m := +(classical.some_spec $ P.equitabilise_aux h).2.1 t + +variables (s) + +/-- We can find equipartitions of arbitrary size. -/ +lemma exists_equipartition_card_eq (hn : n ≠ 0) (hs : n ≤ s.card) : + ∃ P : finpartition s, P.is_equipartition ∧ P.parts.card = n := +begin + rw ←pos_iff_ne_zero at hn, + have : (n - s.card % n) * (s.card / n) + (s.card % n) * (s.card / n + 1) = s.card, + { rw [tsub_mul, mul_add, ←add_assoc, tsub_add_cancel_of_le + (nat.mul_le_mul_right _ (mod_lt _ hn).le), mul_one, add_comm, mod_add_div] }, + refine ⟨(indiscrete (card_pos.1 $ hn.trans_le hs).ne_empty).equitabilise this, + equitabilise_is_equipartition, _⟩, + rw [card_parts_equitabilise _ _ (nat.div_pos hs hn).ne', tsub_add_cancel_of_le (mod_lt _ hn).le], +end + +end finpartition diff --git a/src/combinatorics/simple_graph/regularity/increment.lean b/src/combinatorics/simple_graph/regularity/increment.lean new file mode 100644 index 0000000000000..b19bae79f86d9 --- /dev/null +++ b/src/combinatorics/simple_graph/regularity/increment.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Bhavik Mehta +-/ +import combinatorics.simple_graph.regularity.chunk +import combinatorics.simple_graph.regularity.energy + +/-! +# Increment partition for Szemerédi Regularity Lemma + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In the proof of Szemerédi Regularity Lemma, we need to partition each part of a starting partition +to increase the energy. This file defines the partition obtained by gluing the parts partitions +together (the *increment partition*) and shows that the energy globally increases. + +This entire file is internal to the proof of Szemerédi Regularity Lemma. + +## Main declarations + +* `szemeredi_regularity.increment`: The increment partition. +* `szemeredi_regularity.card_increment`: The increment partition is much bigger than the original, + but by a controlled amount. +* `szemeredi_regularity.energy_increment`: The increment partition has energy greater than the + original by a known (small) fixed amount. + +## TODO + +Once ported to mathlib4, this file will be a great golfing ground for Heather's new tactic +`rel_congr`. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] +-/ + +open finset fintype simple_graph szemeredi_regularity +open_locale big_operators classical + +local attribute [positivity] tactic.positivity_szemeredi_regularity + +variables {α : Type*} [fintype α] {P : finpartition (univ : finset α)} (hP : P.is_equipartition) + (G : simple_graph α) (ε : ℝ) + +local notation `m` := (card α/step_bound P.parts.card : ℕ) + +namespace szemeredi_regularity + +/-- The **increment partition** in Szemerédi's Regularity Lemma. + +If an equipartition is *not* uniform, then the increment partition is a (much bigger) equipartition +with a slightly higher energy. This is helpful since the energy is bounded by a constant (see +`szemeredi_regularity.energy_le_one`), so this process eventually terminates and yields a +not-too-big uniform equipartition. -/ +noncomputable def increment : finpartition (univ : finset α) := P.bind $ λ U, chunk hP G ε + +open finpartition finpartition.is_equipartition + +variables {hP G ε} + +/-- The increment partition has a prescribed (very big) size in terms of the original partition. -/ +lemma card_increment (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPG : ¬P.is_uniform G ε) : + (increment hP G ε).parts.card = step_bound P.parts.card := +begin + have hPα' : step_bound P.parts.card ≤ card α := + (mul_le_mul_left' (pow_le_pow_of_le_left' (by norm_num) _) _).trans hPα, + have hPpos : 0 < step_bound P.parts.card := step_bound_pos (nonempty_of_not_uniform hPG).card_pos, + rw [increment, card_bind], + simp_rw [chunk, apply_dite finpartition.parts, apply_dite card, sum_dite], + rw [sum_const_nat, sum_const_nat, card_attach, card_attach], rotate, + any_goals { exact λ x hx, card_parts_equitabilise _ _ (nat.div_pos hPα' hPpos).ne' }, + rw [nat.sub_add_cancel a_add_one_le_four_pow_parts_card, nat.sub_add_cancel ((nat.le_succ _).trans + a_add_one_le_four_pow_parts_card), ←add_mul], + congr, + rw [filter_card_add_filter_neg_card_eq_card, card_attach], +end + +lemma increment_is_equipartition (hP : P.is_equipartition) (G : simple_graph α) (ε : ℝ) : + (increment hP G ε).is_equipartition := +begin + simp_rw [is_equipartition, set.equitable_on_iff_exists_eq_eq_add_one], + refine ⟨m, λ A hA, _⟩, + rw [mem_coe, increment, mem_bind] at hA, + obtain ⟨U, hU, hA⟩ := hA, + exact card_eq_of_mem_parts_chunk hA, +end + +private lemma distinct_pairs_increment : + P.parts.off_diag.attach.bUnion + (λ UV, (chunk hP G ε (mem_off_diag.1 UV.2).1).parts ×ˢ + (chunk hP G ε (mem_off_diag.1 UV.2).2.1).parts) + ⊆ (increment hP G ε).parts.off_diag := +begin + rintro ⟨Ui, Vj⟩, + simp only [increment, mem_off_diag, bind_parts, mem_bUnion, prod.exists, exists_and_distrib_left, + exists_prop, mem_product, mem_attach, true_and, subtype.exists, and_imp, mem_off_diag, + forall_exists_index, bex_imp_distrib, ne.def], + refine λ U V hUV hUi hVj, ⟨⟨_, hUV.1, hUi⟩, ⟨_, hUV.2.1, hVj⟩, _⟩, + rintro rfl, + obtain ⟨i, hi⟩ := nonempty_of_mem_parts _ hUi, + exact hUV.2.2 (P.disjoint.elim_finset hUV.1 hUV.2.1 i (finpartition.le _ hUi hi) $ + finpartition.le _ hVj hi), +end + +/-- The contribution to `finpartition.energy` of a pair of distinct parts of a finpartition. -/ +private noncomputable def pair_contrib (G : simple_graph α) (ε : ℝ) (hP : P.is_equipartition) + (x : {x // x ∈ P.parts.off_diag}) : ℚ := +∑ i in (chunk hP G ε (mem_off_diag.1 x.2).1).parts ×ˢ (chunk hP G ε (mem_off_diag.1 x.2).2.1).parts, + G.edge_density i.fst i.snd ^ 2 + +lemma off_diag_pairs_le_increment_energy : + ∑ x in P.parts.off_diag.attach, pair_contrib G ε hP x / (increment hP G ε).parts.card ^ 2 ≤ + (increment hP G ε).energy G := +begin + simp_rw [pair_contrib, ←sum_div], + refine div_le_div_of_le_of_nonneg _ (sq_nonneg _), + rw ←sum_bUnion, + { exact sum_le_sum_of_subset_of_nonneg distinct_pairs_increment (λ i _ _, sq_nonneg _) }, + simp only [set.pairwise_disjoint, function.on_fun, disjoint_left, inf_eq_inter, mem_inter, + mem_product], + rintro ⟨⟨s₁, s₂⟩, hs⟩ _ ⟨⟨t₁, t₂⟩, ht⟩ _ hst ⟨u, v⟩ huv₁ huv₂, + rw mem_off_diag at hs ht, + obtain ⟨a, ha⟩ := finpartition.nonempty_of_mem_parts _ huv₁.1, + obtain ⟨b, hb⟩ := finpartition.nonempty_of_mem_parts _ huv₁.2, + exact hst (subtype.ext_val $ prod.ext + (P.disjoint.elim_finset hs.1 ht.1 a + (finpartition.le _ huv₁.1 ha) $ finpartition.le _ huv₂.1 ha) $ + P.disjoint.elim_finset hs.2.1 ht.2.1 b + (finpartition.le _ huv₁.2 hb) $ finpartition.le _ huv₂.2 hb), +end + +lemma pair_contrib_lower_bound [nonempty α] (x : {i // i ∈ P.parts.off_diag}) (hε₁ : ε ≤ 1) + (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) : + ↑(G.edge_density x.1.1 x.1.2)^2 - ε^5/25 + (if G.is_uniform ε x.1.1 x.1.2 then 0 else ε^4/3) ≤ + pair_contrib G ε hP x / (16^P.parts.card) := +begin + rw pair_contrib, + push_cast, + split_ifs, + { rw add_zero, + exact edge_density_chunk_uniform hPα hPε _ _ }, + { exact edge_density_chunk_not_uniform hPα hPε hε₁ (mem_off_diag.1 x.2).2.2 h } +end + +lemma uniform_add_nonuniform_eq_off_diag_pairs [nonempty α] (hε₁ : ε ≤ 1) (hP₇ : 7 ≤ P.parts.card) + (hPα : P.parts.card * 16^P.parts.card ≤ card α) (hPε : 100 ≤ 4^P.parts.card * ε^5) + (hPG : ¬P.is_uniform G ε) : + (∑ x in P.parts.off_diag, G.edge_density x.1 x.2 ^ 2 + P.parts.card^2 * (ε ^ 5 / 4) : ℝ) + / P.parts.card ^ 2 + ≤ ∑ x in P.parts.off_diag.attach, pair_contrib G ε hP x / (increment hP G ε).parts.card ^ 2 := +begin + conv_rhs + { rw [←sum_div, card_increment hPα hPG, step_bound, ←nat.cast_pow, mul_pow, pow_right_comm, + nat.cast_mul, mul_comm, ←div_div, (show 4^2 = 16, by norm_num), sum_div] }, + rw [←nat.cast_pow, nat.cast_pow 16], + refine div_le_div_of_le_of_nonneg _ (nat.cast_nonneg _), + norm_num, + transitivity ∑ x in P.parts.off_diag.attach, + (G.edge_density x.1.1 x.1.2^2 - ε^5/25 + if G.is_uniform ε x.1.1 x.1.2 then 0 else ε^4/3 : ℝ), + swap, + { exact sum_le_sum (λ i hi, pair_contrib_lower_bound i hε₁ hPα hPε) }, + have : ∑ x in P.parts.off_diag.attach, + (G.edge_density x.1.1 x.1.2^2 - ε^5/25 + if G.is_uniform ε x.1.1 x.1.2 then 0 else ε^4/3 : ℝ) = + ∑ x in P.parts.off_diag, + (G.edge_density x.1 x.2^2 - ε^5/25 + if G.is_uniform ε x.1 x.2 then 0 else ε^4/3), + { convert sum_attach, refl }, + rw [this, sum_add_distrib, sum_sub_distrib, sum_const, nsmul_eq_mul, sum_ite, sum_const_zero, + zero_add, sum_const, nsmul_eq_mul, ←finpartition.non_uniforms], + rw [finpartition.is_uniform, not_le] at hPG, + refine le_trans _ (add_le_add_left (mul_le_mul_of_nonneg_right hPG.le $ by positivity) _), + conv_rhs { congr, congr, skip, rw [off_diag_card], congr, congr, + conv { congr, skip, rw ←mul_one P.parts.card }, rw ←nat.mul_sub_left_distrib }, + simp_rw [mul_assoc, sub_add_eq_add_sub, add_sub_assoc, ←mul_sub_left_distrib, mul_div_assoc' ε, + ←pow_succ, div_eq_mul_one_div (ε^5), ←mul_sub_left_distrib, mul_left_comm _ (ε^5), sq, + nat.cast_mul, mul_assoc, ←mul_assoc (ε ^ 5)], + refine add_le_add_left (mul_le_mul_of_nonneg_left _ $ by positivity) _, + rw [nat.cast_sub (P.parts_nonempty $ univ_nonempty.ne_empty).card_pos, mul_sub_right_distrib, + nat.cast_one, one_mul, le_sub_comm, ←mul_sub_left_distrib, + ←div_le_iff (show (0:ℝ) < 1/3 - 1/25 - 1/4, by norm_num)], + exact le_trans (show _ ≤ (7:ℝ), by norm_num) (by exact_mod_cast hP₇), +end + +/-- The increment partition has energy greater than the original one by a known fixed amount. -/ +lemma energy_increment [nonempty α] (hP : P.is_equipartition) (hP₇ : 7 ≤ P.parts.card) + (hε : 100 < 4^P.parts.card * ε^5) (hPα : P.parts.card * 16^P.parts.card ≤ card α) + (hPG : ¬P.is_uniform G ε) (hε₁ : ε ≤ 1) : + ↑(P.energy G) + ε^5 / 4 ≤ (increment hP G ε).energy G := +begin + rw coe_energy, + have h := uniform_add_nonuniform_eq_off_diag_pairs hε₁ hP₇ hPα hε.le hPG, + rw [add_div, mul_div_cancel_left] at h, + exact h.trans (by exact_mod_cast off_diag_pairs_le_increment_energy), + positivity, +end + +end szemeredi_regularity diff --git a/src/combinatorics/simple_graph/regularity/lemma.lean b/src/combinatorics/simple_graph/regularity/lemma.lean new file mode 100644 index 0000000000000..88ae521886eaa --- /dev/null +++ b/src/combinatorics/simple_graph/regularity/lemma.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Bhavik Mehta +-/ +import combinatorics.simple_graph.regularity.increment + +/-! +# Szemerédi's Regularity Lemma + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we prove Szemerédi's Regularity Lemma (aka SRL). This is a landmark result in +combinatorics roughly stating that any sufficiently big graph behaves like a random graph. This is +useful because random graphs are well-behaved in many aspects. + +More precisely, SRL states that for any `ε > 0` and integer `l` there exists a bound `M` such that +any graph on at least `l` vertices can be partitioned into at least `l` parts and at most `M` parts +such that the resulting partitioned graph is `ε`-uniform. + +This statement is very robust to tweaking and many different versions exist. Here, we prove the +version where the resulting partition is equitable (aka an *equipartition*), namely all parts have +the same size up to a difference of `1`. + +The proof we formalise goes as follows: +1. Define an auxiliary measure of edge density, the *energy* of a partition. +2. Start with an arbitrary equipartition of size `l`. +3. Repeatedly break up the parts of the current equipartition in a big but controlled number of + parts. The key point is to break along the witnesses of non-uniformity, so that a lesser portion + of the pairs of parts are non-`ε`-uniform. +4. Check that this results in an equipartition with an energy greater than the energy of the current + partition, plus some constant. +5. Since the energy is between zero and one, we can't run this process forever. Check that when the + process stops we have an `ε`-uniform equipartition. + +This file only contains the final result. The supporting material is spread across the +`combinatorics.simple_graph.regularity` folder: +* `combinatorics.simple_graph.regularity.bound`: Definition of the bound on the number of parts. + Numerical inequalities involving the lemma constants. +* `combinatorics.simple_graph.regularity.energy`: Definition of the energy of a simple graph along a + partition. +* `combinatorics.simple_graph.regularity.uniform`: Definition of uniformity of a simple graph along + a pair of parts and along a partition. +* `combinatorics.simple_graph.regularity.equitabilise`: Construction of an equipartition with + a prescribed number of parts of each size and almost refining a given partition. +* `combinatorics.simple_graph.regularity.chunk`: Break up one part of the current equipartition. + Check that density between non-uniform parts increases, and that density between uniform parts + doesn't decrease too much. +* `combinatorics.simple_graph.regularity.increment`: Gather all those broken up parts into the new + equipartition (aka *increment partition*). Check that energy increases by at least a fixed amount. +* `combinatorics.simple_graph.regularity.lemma`: Wrap everything up into an induction on the energy. + +## TODO + +We currently only prove the equipartition version of SRL. + +* Prove the diagonal version. +* Prove the degree version. +* Define the regularity of a partition and prove the corresponding version. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] +-/ + +open finpartition finset fintype function szemeredi_regularity +open_locale classical + +variables {α : Type*} [fintype α] (G : simple_graph α) {ε : ℝ} {l : ℕ} + +/-- Effective **Szemerédi Regularity Lemma**: For any sufficiently large graph, there is an +`ε`-uniform equipartition of bounded size (where the bound does not depend on the graph). -/ +theorem szemeredi_regularity (hε : 0 < ε) (hl : l ≤ card α) : + ∃ P : finpartition univ, + P.is_equipartition ∧ l ≤ P.parts.card ∧ P.parts.card ≤ bound ε l ∧ P.is_uniform G ε := +begin + obtain hα | hα := le_total (card α) (bound ε l), + -- If `card α ≤ bound ε l`, then the partition into singletons is acceptable. + { refine ⟨⊥, bot_is_equipartition _, _⟩, + rw [card_bot, card_univ], + exact ⟨hl, hα, bot_is_uniform _ hε⟩ }, + -- Else, let's start from a dummy equipartition of size `initial_bound ε l`. + let t := initial_bound ε l, + have htα : t ≤ (univ : finset α).card := + (initial_bound_le_bound _ _).trans (by rwa finset.card_univ), + obtain ⟨dum, hdum₁, hdum₂⟩ := exists_equipartition_card_eq (univ : finset α) + (initial_bound_pos _ _).ne' htα, + obtain hε₁ | hε₁ := le_total 1 ε, + ---If `ε ≥ 1`, then this dummy equipartition is `ε`-uniform, so we're done. + { exact ⟨dum, hdum₁, (le_initial_bound ε l).trans hdum₂.ge, + hdum₂.le.trans (initial_bound_le_bound ε l), (dum.is_uniform_one G).mono hε₁⟩ }, + -- Else, set up the induction on energy. We phrase it through the existence for each `i` of an + -- equipartition of size bounded by `step_bound^[i]) (initial_bound ε l)` and which is either + -- `ε`-uniform or has energy at least `ε ^ 5 / 4 * i`. + haveI : nonempty α, + { rw ←fintype.card_pos_iff, + exact (bound_pos _ _).trans_le hα }, + suffices h : ∀ i, ∃ P : finpartition (univ : finset α), P.is_equipartition ∧ + t ≤ P.parts.card ∧ P.parts.card ≤ (step_bound^[i]) t ∧ + (P.is_uniform G ε ∨ ε ^ 5 / 4 * i ≤ P.energy G), + -- For `i > 4 / ε ^ 5` we know that the partition we get can't have energy `≥ ε ^ 5 / 4 * i > 1`, + -- so it must instead be `ε`-uniform and we won. + { obtain ⟨P, hP₁, hP₂, hP₃, hP₄⟩ := h (⌊4 / ε ^ 5⌋₊ + 1), + refine ⟨P, hP₁, (le_initial_bound _ _).trans hP₂, hP₃.trans _, + hP₄.resolve_right $ λ hPenergy, lt_irrefl (1 : ℝ) _⟩, + { rw iterate_succ_apply', + exact mul_le_mul_left' (pow_le_pow_of_le_left (by norm_num) (by norm_num) _) _ }, + calc + 1 = ε ^ 5 / 4 * (4 / ε ^ 5) + : by { rw [mul_comm, div_mul_div_cancel 4 (pow_pos hε 5).ne'], norm_num } + ... < ε ^ 5 / 4 * (⌊4 / ε ^ 5⌋₊ + 1) + : (mul_lt_mul_left $ by positivity).2 (nat.lt_floor_add_one _) + ... ≤ (P.energy G : ℝ) : by rwa ←nat.cast_add_one + ... ≤ 1 : by exact_mod_cast P.energy_le_one G }, + -- Let's do the actual induction. + intro i, + induction i with i ih, + -- For `i = 0`, the dummy equipartition is enough. + { refine ⟨dum, hdum₁, hdum₂.ge, hdum₂.le, or.inr _⟩, + rw [nat.cast_zero, mul_zero], + exact_mod_cast dum.energy_nonneg G }, + -- For the induction step at `i + 1`, find `P` the equipartition at `i`. + obtain ⟨P, hP₁, hP₂, hP₃, hP₄⟩ := ih, + by_cases huniform : P.is_uniform G ε, + -- If `P` is already uniform, then no need to break it up further. We can just return `P` again. + { refine ⟨P, hP₁, hP₂, _, or.inl huniform⟩, + rw iterate_succ_apply', + exact hP₃.trans (le_step_bound _) }, + -- Else, `P` must instead have energy at least `ε ^ 5 / 4 * i`. + replace hP₄ := hP₄.resolve_left huniform, + -- We gather a few numerical facts. + have hεl' : 100 < 4 ^ P.parts.card * ε ^ 5, + { exact (hundred_lt_pow_initial_bound_mul hε l).trans_le + (mul_le_mul_of_nonneg_right (pow_le_pow (by norm_num) hP₂) $ by positivity) }, + have hi : (i : ℝ) ≤ 4 / ε ^ 5, + { have hi : ε ^ 5 / 4 * ↑i ≤ 1 := hP₄.trans (by exact_mod_cast P.energy_le_one G), + rw [div_mul_eq_mul_div, div_le_iff (show (0:ℝ) < 4, by norm_num)] at hi, + norm_num at hi, + rwa le_div_iff' (pow_pos hε _) }, + have hsize : P.parts.card ≤ (step_bound^[⌊4 / ε ^ 5⌋₊] t) := + hP₃.trans (monotone_iterate_of_id_le le_step_bound (nat.le_floor hi) _), + have hPα : P.parts.card * 16 ^ P.parts.card ≤ card α := + (nat.mul_le_mul hsize (nat.pow_le_pow_of_le_right (by norm_num) hsize)).trans hα, + -- We return the increment equipartition of `P`, which has energy `≥ ε ^ 5 / 4 * (i + 1)`. + refine ⟨increment hP₁ G ε, increment_is_equipartition hP₁ G ε, _, _, + or.inr $ le_trans _ $ energy_increment hP₁ ((seven_le_initial_bound ε l).trans hP₂) + hεl' hPα huniform hε₁⟩, + { rw card_increment hPα huniform, + exact hP₂.trans (le_step_bound _) }, + { rw [card_increment hPα huniform, iterate_succ_apply'], + exact step_bound_mono hP₃ }, + { rw [nat.cast_succ, mul_add, mul_one], + exact add_le_add_right hP₄ _ } +end diff --git a/src/combinatorics/simple_graph/regularity/uniform.lean b/src/combinatorics/simple_graph/regularity/uniform.lean index b20705022b884..226cc63112a9a 100644 --- a/src/combinatorics/simple_graph/regularity/uniform.lean +++ b/src/combinatorics/simple_graph/regularity/uniform.lean @@ -9,6 +9,9 @@ import set_theory.ordinal.basic /-! # Graph uniformity and uniform partitions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define uniformity of a pair of vertices in a graph and uniformity of a partition of vertices of a graph. Both are also known as ε-regularity. @@ -30,6 +33,10 @@ is less than `ε`. * `finpartition.is_uniform`: Uniformity of a partition. * `finpartition.nonuniform_witnesses`: For each non-uniform pair of parts of a partition, pick witnesses of non-uniformity and dump them all together. + +## References + +[Yaël Dillies, Bhavik Mehta, *Formalising Szemerédi’s Regularity Lemma in Lean*][srl_itp] -/ open finset @@ -67,9 +74,11 @@ begin intros s' hs' t' ht' hs ht, rw [card_singleton, nat.cast_one, one_mul] at hs ht, obtain rfl | rfl := finset.subset_singleton_iff.1 hs', - { exact (hε.not_le hs).elim }, + { replace hs : ε ≤ 0 := by simpa using hs, + exact (hε.not_le hs).elim }, obtain rfl | rfl := finset.subset_singleton_iff.1 ht', - { exact (hε.not_le ht).elim }, + { replace ht : ε ≤ 0 := by simpa using ht, + exact (hε.not_le ht).elim }, { rwa [sub_self, abs_zero] } end @@ -141,7 +150,7 @@ begin { exact G.right_nonuniform_witnesses_subset (λ i, h i.symm) } end -lemma nonuniform_witness_card_le (h : ¬ G.is_uniform ε s t) : +lemma le_card_nonuniform_witness (h : ¬ G.is_uniform ε s t) : (s.card : 𝕜) * ε ≤ (G.nonuniform_witness ε s t).card := begin unfold nonuniform_witness, diff --git a/src/combinatorics/simple_graph/strongly_regular.lean b/src/combinatorics/simple_graph/strongly_regular.lean index 524ac8e540e0d..05fb2fda4ad5c 100644 --- a/src/combinatorics/simple_graph/strongly_regular.lean +++ b/src/combinatorics/simple_graph/strongly_regular.lean @@ -8,6 +8,9 @@ import data.set.finite /-! # Strongly regular graphs +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `G.is_SRG_with n k ℓ μ` (see `simple_graph.is_SRG_with`) is a structure for @@ -134,7 +137,7 @@ lemma is_SRG_with.card_common_neighbors_eq_of_adj_compl (h : G.is_SRG_with n k fintype.card ↥(Gᶜ.common_neighbors v w) = n - (2 * k - μ) - 2 := begin simp only [←set.to_finset_card, common_neighbors, set.to_finset_inter, neighbor_set_compl, - set.to_finset_sdiff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def], + set.to_finset_diff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def], simp_rw compl_neighbor_finset_sdiff_inter_eq, have hne : v ≠ w := ne_of_adj _ ha, rw compl_adj at ha, @@ -153,7 +156,7 @@ lemma is_SRG_with.card_common_neighbors_eq_of_not_adj_compl (h : G.is_SRG_with n fintype.card ↥(Gᶜ.common_neighbors v w) = n - (2 * k - ℓ) := begin simp only [←set.to_finset_card, common_neighbors, set.to_finset_inter, neighbor_set_compl, - set.to_finset_sdiff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def], + set.to_finset_diff, set.to_finset_singleton, set.to_finset_compl, ←neighbor_finset_def], simp only [not_and, not_not, compl_adj] at hna, have h2' := hna hn, simp_rw [compl_neighbor_finset_sdiff_inter_eq, sdiff_compl_neighbor_finset_inter_eq h2'], diff --git a/src/combinatorics/simple_graph/subgraph.lean b/src/combinatorics/simple_graph/subgraph.lean index c74b205190a7d..ea5721223bd42 100644 --- a/src/combinatorics/simple_graph/subgraph.lean +++ b/src/combinatorics/simple_graph/subgraph.lean @@ -8,6 +8,9 @@ import combinatorics.simple_graph.basic /-! # Subgraphs of a simple graph +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A subgraph of a simple graph consists of subsets of the graph's vertices and edges such that the endpoints of each edge are present in the vertex subset. The edge subset is formalized as a sub-relation of the adjacency relation of the simple graph. @@ -44,7 +47,7 @@ sub-relation of the adjacency relation of the simple graph. -/ -universe u +universes u v namespace simple_graph @@ -61,9 +64,27 @@ structure subgraph {V : Type u} (G : simple_graph V) := (edge_vert : ∀ {v w : V}, adj v w → v ∈ verts) (symm : symmetric adj . obviously) +variables {ι : Sort*} {V : Type u} {W : Type v} + +/-- The one-vertex subgraph. -/ +@[simps] +protected def singleton_subgraph (G : simple_graph V) (v : V) : G.subgraph := +{ verts := {v}, + adj := ⊥, + adj_sub := by simp [-set.bot_eq_empty], + edge_vert := by simp [-set.bot_eq_empty] } + +/-- The one-edge subgraph. -/ +@[simps] +def subgraph_of_adj (G : simple_graph V) {v w : V} (hvw : G.adj v w) : G.subgraph := +{ verts := {v, w}, + adj := λ a b, ⟦(v, w)⟧ = ⟦(a, b)⟧, + adj_sub := λ a b h, by { rw [← G.mem_edge_set, ← h], exact hvw }, + edge_vert := λ a b h, by { apply_fun (λ e, a ∈ e) at h, simpa using h } } + namespace subgraph -variables {V : Type u} {G : simple_graph V} +variables {G : simple_graph V} {G₁ G₂ : G.subgraph} {a b : V} protected lemma loopless (G' : subgraph G) : irreflexive G'.adj := λ v h, G.loopless v (G'.adj_sub h) @@ -73,6 +94,18 @@ lemma adj_comm (G' : subgraph G) (v w : V) : G'.adj v w ↔ G'.adj w v := @[symm] lemma adj_symm (G' : subgraph G) {u v : V} (h : G'.adj u v) : G'.adj v u := G'.symm h +protected lemma adj.symm {G' : subgraph G} {u v : V} (h : G'.adj u v) : G'.adj v u := G'.symm h + +protected lemma adj.adj_sub {H : G.subgraph} {u v : V} (h : H.adj u v) : G.adj u v := H.adj_sub h + +protected lemma adj.fst_mem {H : G.subgraph} {u v : V} (h : H.adj u v) : u ∈ H.verts := +H.edge_vert h + +protected lemma adj.snd_mem {H : G.subgraph} {u v : V} (h : H.adj u v) : v ∈ H.verts := +h.symm.fst_mem + +protected lemma adj.ne {H : G.subgraph} {u v : V} (h : H.adj u v) : u ≠ v := h.adj_sub.ne + /-- Coercion from `G' : subgraph G` to a `simple_graph ↥G'.verts`. -/ @[simps] protected def coe (G' : subgraph G) : simple_graph G'.verts := { adj := λ v w, G'.adj v w, @@ -82,7 +115,11 @@ lemma adj_comm (G' : subgraph G) (v w : V) : G'.adj v w ↔ G'.adj w v := @[simp] lemma coe_adj_sub (G' : subgraph G) (u v : G'.verts) (h : G'.coe.adj u v) : G.adj u v := G'.adj_sub h -/-- A subgraph is called a *spanning subgraph* if it contains all the vertices of `G`. --/ +/- Given `h : H.adj u v`, then `h.coe : H.coe.adj ⟨u, _⟩ ⟨v, _⟩`. -/ +protected lemma adj.coe {H : G.subgraph} {u v : V} (h : H.adj u v) : + H.coe.adj ⟨u, H.edge_vert h⟩ ⟨v, H.edge_vert h.symm⟩ := h + +/-- A subgraph is called a *spanning subgraph* if it contains all the vertices of `G`. -/ def is_spanning (G' : subgraph G) : Prop := ∀ (v : V), v ∈ G'.verts lemma is_spanning_iff {G' : subgraph G} : G'.is_spanning ↔ G'.verts = set.univ := @@ -99,6 +136,9 @@ In general, this adds in all vertices from `V` as isolated vertices. -/ @[simp] lemma adj.of_spanning_coe {G' : subgraph G} {u v : G'.verts} (h : G'.spanning_coe.adj u v) : G.adj u v := G'.adj_sub h +@[simp] lemma spanning_coe_inj : G₁.spanning_coe = G₂.spanning_coe ↔ G₁.adj = G₂.adj := +by simp [subgraph.spanning_coe] + /-- `spanning_coe` is equivalent to `coe` for a subgraph that `is_spanning`. -/ @[simps] def spanning_coe_equiv_coe_of_spanning (G' : subgraph G) (h : G'.is_spanning) : G'.spanning_coe ≃g G'.coe := @@ -184,8 +224,8 @@ def copy (G' : subgraph G) subgraph G := { verts := V'', adj := adj', - adj_sub := hadj.symm ▸ G'.adj_sub, - edge_vert := hV.symm ▸ hadj.symm ▸ G'.edge_vert, + adj_sub := λ _ _, hadj.symm ▸ G'.adj_sub, + edge_vert := λ _ _, hV.symm ▸ hadj.symm ▸ G'.edge_vert, symm := hadj.symm ▸ G'.symm } lemma copy_eq (G' : subgraph G) @@ -195,84 +235,171 @@ lemma copy_eq (G' : subgraph G) subgraph.ext _ _ hV hadj /-- The union of two subgraphs. -/ -def union (x y : subgraph G) : subgraph G := -{ verts := x.verts ∪ y.verts, - adj := x.adj ⊔ y.adj, - adj_sub := λ v w h, or.cases_on h (λ h, x.adj_sub h) (λ h, y.adj_sub h), - edge_vert := λ v w h, or.cases_on h (λ h, or.inl (x.edge_vert h)) (λ h, or.inr (y.edge_vert h)), - symm := λ v w h, by rwa [pi.sup_apply, pi.sup_apply, x.adj_comm, y.adj_comm] } +instance : has_sup G.subgraph := +⟨λ G₁ G₂, + { verts := G₁.verts ∪ G₂.verts, + adj := G₁.adj ⊔ G₂.adj, + adj_sub := λ a b hab, or.elim hab (λ h, G₁.adj_sub h) (λ h, G₂.adj_sub h), + edge_vert := λ a b, or.imp (λ h, G₁.edge_vert h) (λ h, G₂.edge_vert h), + symm := λ a b, or.imp G₁.adj_symm G₂.adj_symm }⟩ /-- The intersection of two subgraphs. -/ -def inter (x y : subgraph G) : subgraph G := -{ verts := x.verts ∩ y.verts, - adj := x.adj ⊓ y.adj, - adj_sub := λ v w h, x.adj_sub h.1, - edge_vert := λ v w h, ⟨x.edge_vert h.1, y.edge_vert h.2⟩, - symm := λ v w h, by rwa [pi.inf_apply, pi.inf_apply, x.adj_comm, y.adj_comm] } +instance : has_inf G.subgraph := +⟨λ G₁ G₂, + { verts := G₁.verts ∩ G₂.verts, + adj := G₁.adj ⊓ G₂.adj, + adj_sub := λ a b hab, G₁.adj_sub hab.1, + edge_vert := λ a b, and.imp (λ h, G₁.edge_vert h) (λ h, G₂.edge_vert h), + symm := λ a b, and.imp G₁.adj_symm G₂.adj_symm }⟩ /-- The `top` subgraph is `G` as a subgraph of itself. -/ -def top : subgraph G := -{ verts := set.univ, +instance : has_top G.subgraph := +⟨{ verts := set.univ, adj := G.adj, adj_sub := λ v w h, h, edge_vert := λ v w h, set.mem_univ v, - symm := G.symm } + symm := G.symm }⟩ /-- The `bot` subgraph is the subgraph with no vertices or edges. -/ -def bot : subgraph G := -{ verts := ∅, +instance : has_bot G.subgraph := +⟨{ verts := ∅, adj := ⊥, adj_sub := λ v w h, false.rec _ h, edge_vert := λ v w h, false.rec _ h, - symm := λ u v h, h } - -instance subgraph_inhabited : inhabited (subgraph G) := ⟨bot⟩ - -/-- The relation that one subgraph is a subgraph of another. -/ -def is_subgraph (x y : subgraph G) : Prop := x.verts ⊆ y.verts ∧ ∀ ⦃v w : V⦄, x.adj v w → y.adj v w - -instance : lattice (subgraph G) := -{ le := is_subgraph, - sup := union, - inf := inter, - le_refl := λ x, ⟨rfl.subset, λ _ _ h, h⟩, - le_trans := λ x y z hxy hyz, ⟨hxy.1.trans hyz.1, λ _ _ h, hyz.2 (hxy.2 h)⟩, - le_antisymm := begin - intros x y hxy hyx, - ext1 v, - exact set.subset.antisymm hxy.1 hyx.1, - ext v w, - exact iff.intro (λ h, hxy.2 h) (λ h, hyx.2 h), - end, - sup_le := λ x y z hxy hyz, - ⟨set.union_subset hxy.1 hyz.1, - (λ v w h, h.cases_on (λ h, hxy.2 h) (λ h, hyz.2 h))⟩, - le_sup_left := λ x y, ⟨set.subset_union_left x.verts y.verts, (λ v w h, or.inl h)⟩, - le_sup_right := λ x y, ⟨set.subset_union_right x.verts y.verts, (λ v w h, or.inr h)⟩, - le_inf := λ x y z hxy hyz, ⟨set.subset_inter hxy.1 hyz.1, (λ v w h, ⟨hxy.2 h, hyz.2 h⟩)⟩, - inf_le_left := λ x y, ⟨set.inter_subset_left x.verts y.verts, (λ v w h, h.1)⟩, - inf_le_right := λ x y, ⟨set.inter_subset_right x.verts y.verts, (λ v w h, h.2)⟩ } + symm := λ u v h, h }⟩ + +instance : has_Sup G.subgraph := +⟨λ s, { verts := ⋃ G' ∈ s, verts G', + adj := λ a b, ∃ G' ∈ s, adj G' a b, + adj_sub := by { rintro a b ⟨G', -, hab⟩, exact G'.adj_sub hab }, + edge_vert := + by { rintro a b ⟨G', hG', hab⟩, exact set.mem_Union₂_of_mem hG' (G'.edge_vert hab) }, + symm := λ a b, Exists₂.imp $ λ _ _, adj.symm }⟩ + +instance : has_Inf G.subgraph := +⟨λ s, { verts := ⋂ G' ∈ s, verts G', + adj := λ a b, (∀ ⦃G'⦄, G' ∈ s → adj G' a b) ∧ G.adj a b, + adj_sub := λ a b, and.right, + edge_vert := λ a b hab, set.mem_Inter₂_of_mem $ λ G' hG', G'.edge_vert $ hab.1 hG', + symm := λ _ _, and.imp (forall₂_imp $ λ _ _, adj.symm) G.adj_symm }⟩ + +@[simp] lemma sup_adj : (G₁ ⊔ G₂).adj a b ↔ G₁.adj a b ∨ G₂.adj a b := iff.rfl +@[simp] lemma inf_adj : (G₁ ⊓ G₂).adj a b ↔ G₁.adj a b ∧ G₂.adj a b := iff.rfl +@[simp] lemma top_adj : (⊤ : subgraph G).adj a b ↔ G.adj a b := iff.rfl +@[simp] lemma not_bot_adj : ¬ (⊥ : subgraph G).adj a b := not_false + +@[simp] lemma verts_sup (G₁ G₂ : G.subgraph) : (G₁ ⊔ G₂).verts = G₁.verts ∪ G₂.verts := rfl +@[simp] lemma verts_inf (G₁ G₂ : G.subgraph) : (G₁ ⊓ G₂).verts = G₁.verts ∩ G₂.verts := rfl +@[simp] lemma verts_top : (⊤ : G.subgraph).verts = set.univ := rfl +@[simp] lemma verts_bot : (⊥ : G.subgraph).verts = ∅ := rfl + +@[simp] lemma Sup_adj {s : set G.subgraph} : (Sup s).adj a b ↔ ∃ G ∈ s, adj G a b := iff.rfl + +@[simp] lemma Inf_adj {s : set G.subgraph} : (Inf s).adj a b ↔ (∀ G' ∈ s, adj G' a b) ∧ G.adj a b := +iff.rfl + +@[simp] lemma supr_adj {f : ι → G.subgraph} : (⨆ i, f i).adj a b ↔ ∃ i, (f i).adj a b := +by simp [supr] + +@[simp] lemma infi_adj {f : ι → G.subgraph} : + (⨅ i, f i).adj a b ↔ (∀ i, (f i).adj a b) ∧ G.adj a b := +by simp [infi] + +lemma Inf_adj_of_nonempty {s : set G.subgraph} (hs : s.nonempty) : + (Inf s).adj a b ↔ ∀ G' ∈ s, adj G' a b := +Inf_adj.trans $ and_iff_left_of_imp $ by { obtain ⟨G', hG'⟩ := hs, exact λ h, G'.adj_sub (h _ hG') } + +lemma infi_adj_of_nonempty [nonempty ι] {f : ι → G.subgraph} : + (⨅ i, f i).adj a b ↔ ∀ i, (f i).adj a b := +by simp [infi, Inf_adj_of_nonempty (set.range_nonempty _)] + +@[simp] lemma verts_Sup (s : set G.subgraph) : (Sup s).verts = ⋃ G' ∈ s, verts G' := rfl +@[simp] lemma verts_Inf (s : set G.subgraph) : (Inf s).verts = ⋂ G' ∈ s, verts G' := rfl + +@[simp] lemma verts_supr {f : ι → G.subgraph} : (⨆ i, f i).verts = ⋃ i, (f i).verts := +by simp [supr] + +@[simp] lemma verts_infi {f : ι → G.subgraph} : (⨅ i, f i).verts = ⋂ i, (f i).verts := +by simp [infi] + +/-- For subgraphs `G₁`, `G₂`, `G₁ ≤ G₂` iff `G₁.verts ⊆ G₂.verts` and +`∀ a b, G₁.adj a b → G₂.adj a b`. -/ +instance : distrib_lattice G.subgraph := +{ le := λ x y, x.verts ⊆ y.verts ∧ ∀ ⦃v w : V⦄, x.adj v w → y.adj v w, + ..show distrib_lattice G.subgraph, from function.injective.distrib_lattice + (λ G', (G'.verts, G'.spanning_coe)) + (λ G₁ G₂ h, by { rw prod.ext_iff at h, exact ext _ _ h.1 (spanning_coe_inj.1 h.2) }) + (λ _ _, rfl) (λ _ _, rfl) } instance : bounded_order (subgraph G) := -{ top := top, - bot := bot, +{ top := ⊤, + bot := ⊥, le_top := λ x, ⟨set.subset_univ _, (λ v w h, x.adj_sub h)⟩, bot_le := λ x, ⟨set.empty_subset _, (λ v w h, false.rec _ h)⟩ } --- TODO simp lemmas for the other lattice operations on subgraphs -@[simp] lemma top_verts : (⊤ : subgraph G).verts = set.univ := rfl +-- Note that subgraphs do not form a Boolean algebra, because of `verts`. +instance : complete_distrib_lattice G.subgraph := +{ le := (≤), + sup := (⊔), + inf := (⊓), + top := ⊤, + bot := ⊥, + le_top := λ G', ⟨set.subset_univ _, λ a b, G'.adj_sub⟩, + bot_le := λ G', ⟨set.empty_subset _, λ a b, false.elim⟩, + Sup := Sup, + le_Sup := λ s G' hG', ⟨set.subset_Union₂ G' hG', λ a b hab, ⟨G', hG', hab⟩⟩, + Sup_le := λ s G' hG', ⟨set.Union₂_subset $ λ H hH, (hG' _ hH).1, + by { rintro a b ⟨H, hH, hab⟩, exact (hG' _ hH).2 hab }⟩, + Inf := Inf, + Inf_le := λ s G' hG', ⟨set.Inter₂_subset G' hG', λ a b hab, hab.1 hG'⟩, + le_Inf := λ s G' hG', ⟨set.subset_Inter₂ $ λ H hH, (hG' _ hH).1, + λ a b hab, ⟨λ H hH, (hG' _ hH).2 hab, G'.adj_sub hab⟩⟩, + inf_Sup_le_supr_inf := λ G' s, begin + refine ⟨_, λ a b hab, _⟩, + { simp only [verts_inf, verts_Sup, verts_supr, set.le_eq_subset], + exact (set.inter_Union₂ _ _).subset }, + { simpa only [spanning_coe_adj, exists_prop, Sup_adj, and_imp, forall_exists_index, supr_adj, + inf_adj, ←exists_and_distrib_right, exists_and_distrib_left, and_assoc, and_self_right] + using hab } + end, + infi_sup_le_sup_Inf := λ G' s, begin + refine ⟨_, λ a b hab, _⟩, + { simp only [set.le_eq_subset, verts_infi, verts_sup, verts_Inf], + exact (set.union_Inter₂ _ _).superset }, + simp only [spanning_coe_adj, sup_adj, Inf_adj, sup_adj, Inf_adj, infi_adj] at ⊢ hab, + have : (∀ G'' ∈ s, adj G' a b ∨ adj G'' a b) ∧ G.adj a b := + (and_congr_left $ λ h, forall_congr $ λ H, _).1 hab, + simpa [forall_or_distrib_left, or_and_distrib_right, and_iff_left_of_imp G'.adj_sub] using this, + exact and_iff_left h, + end, + ..subgraph.distrib_lattice } -@[simp] lemma top_adj_iff {v w : V} : (⊤ : subgraph G).adj v w ↔ G.adj v w := iff.rfl +@[simps] instance subgraph_inhabited : inhabited (subgraph G) := ⟨⊥⟩ -@[simp] lemma bot_verts : (⊥ : subgraph G).verts = ∅ := rfl +@[simp] lemma neighbor_set_sup {H H' : G.subgraph} (v : V) : + (H ⊔ H').neighbor_set v = H.neighbor_set v ∪ H'.neighbor_set v := rfl -@[simp] lemma not_bot_adj {v w : V} : ¬(⊥ : subgraph G).adj v w := not_false +@[simp] lemma neighbor_set_inf {H H' : G.subgraph} (v : V) : + (H ⊓ H').neighbor_set v = H.neighbor_set v ∩ H'.neighbor_set v := rfl -@[simp] lemma inf_adj {H₁ H₂ : subgraph G} {v w : V} : - (H₁ ⊓ H₂).adj v w ↔ H₁.adj v w ∧ H₂.adj v w := iff.rfl +@[simp] lemma neighbor_set_top (v : V) : (⊤ : G.subgraph).neighbor_set v = G.neighbor_set v := rfl +@[simp] lemma neighbor_set_bot (v : V) : (⊥ : G.subgraph).neighbor_set v = ∅ := rfl -@[simp] lemma sup_adj {H₁ H₂ : subgraph G} {v w : V} : - (H₁ ⊔ H₂).adj v w ↔ H₁.adj v w ∨ H₂.adj v w := iff.rfl +@[simp] lemma neighbor_set_Sup (s : set G.subgraph) (v : V) : + (Sup s).neighbor_set v = ⋃ G' ∈ s, neighbor_set G' v := +by { ext, simp } + +@[simp] lemma neighbor_set_Inf (s : set G.subgraph) (v : V) : + (Inf s).neighbor_set v = (⋂ G' ∈ s, neighbor_set G' v) ∩ G.neighbor_set v := +by { ext, simp } + +@[simp] lemma neighbor_set_supr (f : ι → G.subgraph) (v : V) : + (⨆ i, f i).neighbor_set v = ⋃ i, (f i).neighbor_set v := +by simp [supr] + +@[simp] lemma neighbor_set_infi (f : ι → G.subgraph) (v : V) : + (⨅ i, f i).neighbor_set v = (⋂ i, (f i).neighbor_set v) ∩ G.neighbor_set v := +by simp [infi] @[simp] lemma edge_set_top : (⊤ : subgraph G).edge_set = G.edge_set := rfl @@ -285,6 +412,20 @@ set.ext $ sym2.ind (by simp) @[simp] lemma edge_set_sup {H₁ H₂ : subgraph G} : (H₁ ⊔ H₂).edge_set = H₁.edge_set ∪ H₂.edge_set := set.ext $ sym2.ind (by simp) +@[simp] lemma edge_set_Sup (s : set G.subgraph) : (Sup s).edge_set = ⋃ G' ∈ s, edge_set G' := +by { ext e, induction e using sym2.ind, simp } + +@[simp] lemma edge_set_Inf (s : set G.subgraph) : + (Inf s).edge_set = (⋂ G' ∈ s, edge_set G') ∩ G.edge_set := +by { ext e, induction e using sym2.ind, simp } + +@[simp] lemma edge_set_supr (f : ι → G.subgraph) : (⨆ i, f i).edge_set = ⋃ i, (f i).edge_set := +by simp [supr] + +@[simp] lemma edge_set_infi (f : ι → G.subgraph) : + (⨅ i, f i).edge_set = (⋂ i, (f i).edge_set) ∩ G.edge_set := +by simp [infi] + @[simp] lemma spanning_coe_top : (⊤ : subgraph G).spanning_coe = G := by { ext, refl } @@ -329,35 +470,111 @@ lemma edge_set_mono {H₁ H₂ : subgraph G} (h : H₁ ≤ H₂) : H₁.edge_set lemma _root_.disjoint.edge_set {H₁ H₂ : subgraph G} (h : disjoint H₁ H₂) : disjoint H₁.edge_set H₂.edge_set := -by simpa using edge_set_mono h +disjoint_iff_inf_le.mpr $ by simpa using edge_set_mono h.le_bot + +/-- Graph homomorphisms induce a covariant function on subgraphs. -/ +@[simps] +protected def map {G' : simple_graph W} (f : G →g G') (H : G.subgraph) : G'.subgraph := +{ verts := f '' H.verts, + adj := relation.map H.adj f f, + adj_sub := by { rintro _ _ ⟨u, v, h, rfl, rfl⟩, exact f.map_rel (H.adj_sub h) }, + edge_vert := by { rintro _ _ ⟨u, v, h, rfl, rfl⟩, exact set.mem_image_of_mem _ (H.edge_vert h) }, + symm := by { rintro _ _ ⟨u, v, h, rfl, rfl⟩, exact ⟨v, u, H.symm h, rfl, rfl⟩ } } + +lemma map_monotone {G' : simple_graph W} (f : G →g G') : monotone (subgraph.map f) := +begin + intros H H' h, + split, + { intro, + simp only [map_verts, set.mem_image, forall_exists_index, and_imp], + rintro v hv rfl, + exact ⟨_, h.1 hv, rfl⟩ }, + { rintros _ _ ⟨u, v, ha, rfl, rfl⟩, + exact ⟨_, _, h.2 ha, rfl, rfl⟩ } +end + +lemma map_sup {G : simple_graph V} {G' : simple_graph W} (f : G →g G') + {H H' : G.subgraph} : + (H ⊔ H').map f = H.map f ⊔ H'.map f := +begin + ext1, + { simp only [set.image_union, map_verts, verts_sup]}, + { ext, + simp only [relation.map, map_adj, sup_adj], + split, + { rintro ⟨a, b, h|h, rfl, rfl⟩, + { exact or.inl ⟨_, _, h, rfl, rfl⟩ }, + { exact or.inr ⟨_, _, h, rfl, rfl⟩ } }, + { rintro (⟨a, b, h, rfl, rfl⟩|⟨a, b, h, rfl, rfl⟩), + { exact ⟨_, _, or.inl h, rfl, rfl⟩ }, + { exact ⟨_, _, or.inr h, rfl, rfl⟩ } } }, +end + +/-- Graph homomorphisms induce a contravariant function on subgraphs. -/ +@[simps] +protected def comap {G' : simple_graph W} (f : G →g G') (H : G'.subgraph) : G.subgraph := +{ verts := f ⁻¹' H.verts, + adj := λ u v, G.adj u v ∧ H.adj (f u) (f v), + adj_sub := by { rintros v w ⟨ga, ha⟩, exact ga }, + edge_vert := by { rintros v w ⟨ga, ha⟩, simp [H.edge_vert ha] } } + +lemma comap_monotone {G' : simple_graph W} (f : G →g G') : monotone (subgraph.comap f) := +begin + intros H H' h, + split, + { intro, + simp only [comap_verts, set.mem_preimage], + apply h.1, }, + { intros v w, + simp only [comap_adj, and_imp, true_and] { contextual := tt }, + intro, + apply h.2, } +end + +lemma map_le_iff_le_comap {G' : simple_graph W} (f : G →g G') (H : G.subgraph) (H' : G'.subgraph) : + H.map f ≤ H' ↔ H ≤ H'.comap f := +begin + refine ⟨λ h, ⟨λ v hv, _, λ v w hvw, _⟩, λ h, ⟨λ v, _, λ v w, _⟩⟩, + { simp only [comap_verts, set.mem_preimage], + exact h.1 ⟨v, hv, rfl⟩, }, + { simp only [H.adj_sub hvw, comap_adj, true_and], + exact h.2 ⟨v, w, hvw, rfl, rfl⟩, }, + { simp only [map_verts, set.mem_image, forall_exists_index, and_imp], + rintro w hw rfl, + exact h.1 hw, }, + { simp only [relation.map, map_adj, forall_exists_index, and_imp], + rintros u u' hu rfl rfl, + have := h.2 hu, + simp only [comap_adj] at this, + exact this.2, } +end /-- Given two subgraphs, one a subgraph of the other, there is an induced injective homomorphism of the subgraphs as graphs. -/ -def map {x y : subgraph G} (h : x ≤ y) : x.coe →g y.coe := +@[simps] +def inclusion {x y : subgraph G} (h : x ≤ y) : x.coe →g y.coe := { to_fun := λ v, ⟨↑v, and.left h v.property⟩, map_rel' := λ v w hvw, h.2 hvw } -lemma map.injective {x y : subgraph G} (h : x ≤ y) : function.injective (map h) := -λ v w h, by { simp only [map, rel_hom.coe_fn_mk, subtype.mk_eq_mk] at h, exact subtype.ext h } +lemma inclusion.injective {x y : subgraph G} (h : x ≤ y) : function.injective (inclusion h) := +λ v w h, by { simp only [inclusion, rel_hom.coe_fn_mk, subtype.mk_eq_mk] at h, exact subtype.ext h } /-- There is an induced injective homomorphism of a subgraph of `G` into `G`. -/ -def map_top (x : subgraph G) : x.coe →g G := +@[simps] +protected def hom (x : subgraph G) : x.coe →g G := { to_fun := λ v, v, map_rel' := λ v w hvw, x.adj_sub hvw } -lemma map_top.injective {x : subgraph G} : function.injective x.map_top := +lemma hom.injective {x : subgraph G} : function.injective x.hom := λ v w h, subtype.ext h -@[simp] -lemma map_top_to_fun {x : subgraph G} (v : x.verts) : x.map_top v = v := rfl - /-- There is an induced injective homomorphism of a subgraph of `G` as a spanning subgraph into `G`. -/ -@[simps] def map_spanning_top (x : subgraph G) : x.spanning_coe →g G := +@[simps] def spanning_hom (x : subgraph G) : x.spanning_coe →g G := { to_fun := id, map_rel' := λ v w hvw, x.adj_sub hvw } -lemma map_spanning_top.injective {x : subgraph G} : function.injective x.map_spanning_top := +lemma spanning_hom.injective {x : subgraph G} : function.injective x.spanning_hom := λ v w h, h lemma neighbor_set_subset_of_subgraph {x y : subgraph G} (h : x ≤ y) (v : V) : @@ -432,7 +649,161 @@ begin simp only [set.mem_to_finset, mem_neighbor_set], end -/-! ## Edge deletion -/ +end subgraph + +section mk_properties +/-! ### Properties of `singleton_subgraph` and `subgraph_of_adj` -/ + +variables {G : simple_graph V} {G' : simple_graph W} + +instance nonempty_singleton_subgraph_verts (v : V) : nonempty (G.singleton_subgraph v).verts := +⟨⟨v, set.mem_singleton v⟩⟩ + +@[simp] lemma singleton_subgraph_le_iff (v : V) (H : G.subgraph) : + G.singleton_subgraph v ≤ H ↔ v ∈ H.verts := +begin + refine ⟨λ h, h.1 (set.mem_singleton v), _⟩, + intro h, + split, + { simp [h] }, + { simp [-set.bot_eq_empty] } +end + +@[simp] lemma map_singleton_subgraph (f : G →g G') {v : V} : + subgraph.map f (G.singleton_subgraph v) = G'.singleton_subgraph (f v) := +by ext; simp only [relation.map, subgraph.map_adj, singleton_subgraph_adj, pi.bot_apply, + exists_and_distrib_left, and_iff_left_iff_imp, is_empty.forall_iff, subgraph.map_verts, + singleton_subgraph_verts, set.image_singleton] + +@[simp] lemma neighbor_set_singleton_subgraph (v w : V) : + (G.singleton_subgraph v).neighbor_set w = ∅ := +by { ext u, refl } + +@[simp] lemma edge_set_singleton_subgraph (v : V) : + (G.singleton_subgraph v).edge_set = ∅ := +sym2.from_rel_bot + +lemma eq_singleton_subgraph_iff_verts_eq (H : G.subgraph) {v : V} : + H = G.singleton_subgraph v ↔ H.verts = {v} := +begin + refine ⟨λ h, by simp [h], λ h, _⟩, + ext, + { rw [h, singleton_subgraph_verts] }, + { simp only [Prop.bot_eq_false, singleton_subgraph_adj, pi.bot_apply, iff_false], + intro ha, + have ha1 := ha.fst_mem, + have ha2 := ha.snd_mem, + rw [h, set.mem_singleton_iff] at ha1 ha2, + subst_vars, + exact ha.ne rfl }, +end + +instance nonempty_subgraph_of_adj_verts {v w : V} (hvw : G.adj v w) : + nonempty (G.subgraph_of_adj hvw).verts := ⟨⟨v, by simp⟩⟩ + +@[simp] lemma edge_set_subgraph_of_adj {v w : V} (hvw : G.adj v w) : + (G.subgraph_of_adj hvw).edge_set = {⟦(v, w)⟧} := +begin + ext e, + refine e.ind _, + simp only [eq_comm, set.mem_singleton_iff, subgraph.mem_edge_set, subgraph_of_adj_adj, + iff_self, forall_2_true_iff], +end + +lemma subgraph_of_adj_symm {v w : V} (hvw : G.adj v w) : + G.subgraph_of_adj hvw.symm = G.subgraph_of_adj hvw := +by ext; simp [or_comm, and_comm] + +@[simp] lemma map_subgraph_of_adj (f : G →g G') + {v w : V} (hvw : G.adj v w) : + subgraph.map f (G.subgraph_of_adj hvw) = G'.subgraph_of_adj (f.map_adj hvw) := +begin + ext, + { simp only [subgraph.map_verts, subgraph_of_adj_verts, set.mem_image, + set.mem_insert_iff, set.mem_singleton_iff], + split, + { rintro ⟨u, rfl|rfl, rfl⟩; simp }, + { rintro (rfl|rfl), + { use v, simp }, + { use w, simp } } }, + { simp only [relation.map, subgraph.map_adj, subgraph_of_adj_adj, quotient.eq, sym2.rel_iff], + split, + { rintro ⟨a, b, (⟨rfl,rfl⟩|⟨rfl,rfl⟩), rfl, rfl⟩; simp }, + { rintro (⟨rfl,rfl⟩|⟨rfl,rfl⟩), + { use [v, w], simp }, + { use [w, v], simp } } } +end + +lemma neighbor_set_subgraph_of_adj_subset {u v w : V} (hvw : G.adj v w) : + (G.subgraph_of_adj hvw).neighbor_set u ⊆ {v, w} := +(G.subgraph_of_adj hvw).neighbor_set_subset_verts _ + +@[simp] lemma neighbor_set_fst_subgraph_of_adj {v w : V} (hvw : G.adj v w) : + (G.subgraph_of_adj hvw).neighbor_set v = {w} := +begin + ext u, + suffices : w = u ↔ u = w, by simpa [hvw.ne.symm] using this, + rw eq_comm, +end + +@[simp] lemma neighbor_set_snd_subgraph_of_adj {v w : V} (hvw : G.adj v w) : + (G.subgraph_of_adj hvw).neighbor_set w = {v} := +begin + rw subgraph_of_adj_symm hvw.symm, + exact neighbor_set_fst_subgraph_of_adj hvw.symm, +end + +@[simp] lemma neighbor_set_subgraph_of_adj_of_ne_of_ne {u v w : V} (hvw : G.adj v w) + (hv : u ≠ v) (hw : u ≠ w) : + (G.subgraph_of_adj hvw).neighbor_set u = ∅ := +by { ext, simp [hv.symm, hw.symm] } + +lemma neighbor_set_subgraph_of_adj [decidable_eq V] {u v w : V} (hvw : G.adj v w) : + (G.subgraph_of_adj hvw).neighbor_set u = + (if u = v then {w} else ∅) ∪ (if u = w then {v} else ∅) := +by split_ifs; subst_vars; simp [*] + +lemma singleton_subgraph_fst_le_subgraph_of_adj {u v : V} {h : G.adj u v} : + G.singleton_subgraph u ≤ G.subgraph_of_adj h := +by split; simp [-set.bot_eq_empty] + +lemma singleton_subgraph_snd_le_subgraph_of_adj {u v : V} {h : G.adj u v} : + G.singleton_subgraph v ≤ G.subgraph_of_adj h := +by split; simp [-set.bot_eq_empty] + +end mk_properties + +namespace subgraph + +variables {G : simple_graph V} + +/-! ### Subgraphs of subgraphs -/ + +/-- Given a subgraph of a subgraph of `G`, construct a subgraph of `G`. -/ +@[reducible] +protected def coe_subgraph {G' : G.subgraph} : G'.coe.subgraph → G.subgraph := subgraph.map G'.hom + +/-- Given a subgraph of `G`, restrict it to being a subgraph of another subgraph `G'` by +taking the portion of `G` that intersects `G'`. -/ +@[reducible] +protected def restrict {G' : G.subgraph} : G.subgraph → G'.coe.subgraph := subgraph.comap G'.hom + +lemma restrict_coe_subgraph {G' : G.subgraph} (G'' : G'.coe.subgraph) : + G''.coe_subgraph.restrict = G'' := +begin + ext, + { simp }, + { simp only [relation.map, comap_adj, coe_adj, subtype.coe_prop, hom_apply, map_adj, + set_coe.exists, subtype.coe_mk, exists_and_distrib_right, exists_eq_right_right, + subtype.coe_eta, exists_true_left, exists_eq_right, and_iff_right_iff_imp], + apply G''.adj_sub, } +end + +lemma coe_subgraph_injective (G' : G.subgraph) : + function.injective (subgraph.coe_subgraph : G'.coe.subgraph → G.subgraph) := +function.left_inverse.injective restrict_coe_subgraph + +/-! ### Edge deletion -/ /-- Given a subgraph `G'` and a set of vertex pairs, remove all of the corresponding edges from its edge set, if present. @@ -515,6 +886,121 @@ spanning_coe_le_of_le (delete_edges_le s) end delete_edges +/-! ### Induced subgraphs -/ + +/- Given a subgraph, we can change its vertex set while removing any invalid edges, which +gives induced subgraphs. See also `simple_graph.induce` for the `simple_graph` version, which, +unlike for subgraphs, results in a graph with a different vertex type. -/ + +/-- The induced subgraph of a subgraph. The expectation is that `s ⊆ G'.verts` for the usual +notion of an induced subgraph, but, in general, `s` is taken to be the new vertex set and edges +are induced from the subgraph `G'`. -/ +@[simps] +def induce (G' : G.subgraph) (s : set V) : G.subgraph := +{ verts := s, + adj := λ u v, u ∈ s ∧ v ∈ s ∧ G'.adj u v, + adj_sub := λ u v, by { rintro ⟨-, -, ha⟩, exact G'.adj_sub ha }, + edge_vert := λ u v, by { rintro ⟨h, -, -⟩, exact h } } + +lemma _root_.simple_graph.induce_eq_coe_induce_top (s : set V) : + G.induce s = ((⊤ : G.subgraph).induce s).coe := +by { ext v w, simp } + +section induce +variables {G' G'' : G.subgraph} {s s' : set V} + +lemma induce_mono (hg : G' ≤ G'') (hs : s ⊆ s') : G'.induce s ≤ G''.induce s' := +begin + split, + { simp [hs], }, + { simp only [induce_adj, true_and, and_imp] { contextual := tt }, + intros v w hv hw ha, + exact ⟨hs hv, hs hw, hg.2 ha⟩, }, +end + +@[mono] +lemma induce_mono_left (hg : G' ≤ G'') : G'.induce s ≤ G''.induce s := induce_mono hg (by refl) + +@[mono] +lemma induce_mono_right (hs : s ⊆ s') : G'.induce s ≤ G'.induce s' := induce_mono (by refl) hs + +@[simp] lemma induce_empty : G'.induce ∅ = ⊥ := +by ext; simp + +@[simp] lemma induce_self_verts : G'.induce G'.verts = G' := +begin + ext, + { simp }, + { split; + simp only [induce_adj, implies_true_iff, and_true] {contextual := tt}, + exact λ ha, ⟨G'.edge_vert ha, G'.edge_vert ha.symm⟩ } +end + +lemma singleton_subgraph_eq_induce {v : V} : + G.singleton_subgraph v = (⊤ : G.subgraph).induce {v} := +by ext; simp [-set.bot_eq_empty, Prop.bot_eq_false] { contextual := tt } + +lemma subgraph_of_adj_eq_induce {v w : V} (hvw : G.adj v w) : + G.subgraph_of_adj hvw = (⊤ : G.subgraph).induce {v, w} := +begin + ext, + { simp }, + { split, + { intro h, + simp only [subgraph_of_adj_adj, quotient.eq, sym2.rel_iff] at h, + obtain ⟨rfl, rfl⟩|⟨rfl, rfl⟩ := h; simp [hvw, hvw.symm], }, + { intro h, + simp only [induce_adj, set.mem_insert_iff, set.mem_singleton_iff, top_adj] at h, + obtain ⟨rfl|rfl, rfl|rfl, ha⟩ := h; + exact (ha.ne rfl).elim <|> simp } } +end + +end induce + +/-- Given a subgraph and a set of vertices, delete all the vertices from the subgraph, +if present. Any edges indicent to the deleted vertices are deleted as well. -/ +@[reducible] def delete_verts (G' : G.subgraph) (s : set V) : G.subgraph := G'.induce (G'.verts \ s) + +section delete_verts +variables {G' : G.subgraph} {s : set V} + +lemma delete_verts_verts : (G'.delete_verts s).verts = G'.verts \ s := rfl + +lemma delete_verts_adj {u v : V} : + (G'.delete_verts s).adj u v ↔ + u ∈ G'.verts ∧ ¬ u ∈ s ∧ v ∈ G'.verts ∧ ¬ v ∈ s ∧ G'.adj u v := +by simp [and_assoc] + +@[simp] lemma delete_verts_delete_verts (s s' : set V) : + (G'.delete_verts s).delete_verts s' = G'.delete_verts (s ∪ s') := +by ext; simp [not_or_distrib, and_assoc] { contextual := tt } + +@[simp] lemma delete_verts_empty : G'.delete_verts ∅ = G' := +by simp [delete_verts] + +lemma delete_verts_le : G'.delete_verts s ≤ G' := +by split; simp [set.diff_subset] + +@[mono] +lemma delete_verts_mono {G' G'' : G.subgraph} (h : G' ≤ G'') : + G'.delete_verts s ≤ G''.delete_verts s := +induce_mono h (set.diff_subset_diff_left h.1) + +@[mono] +lemma delete_verts_anti {s s' : set V} (h : s ⊆ s') : + G'.delete_verts s' ≤ G'.delete_verts s := +induce_mono (le_refl _) (set.diff_subset_diff_right h) + +@[simp] lemma delete_verts_inter_verts_left_eq : + G'.delete_verts (G'.verts ∩ s) = G'.delete_verts s := +by ext; simp [imp_false] { contextual := tt } + +@[simp] lemma delete_verts_inter_verts_set_right_eq : + G'.delete_verts (s ∩ G'.verts) = G'.delete_verts s := +by ext; simp [imp_false] { contextual := tt } + +end delete_verts + end subgraph end simple_graph diff --git a/src/combinatorics/simple_graph/trails.lean b/src/combinatorics/simple_graph/trails.lean new file mode 100644 index 0000000000000..6c71112054a68 --- /dev/null +++ b/src/combinatorics/simple_graph/trails.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import combinatorics.simple_graph.connectivity +import data.nat.parity + +/-! + +# Trails and Eulerian trails + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This module contains additional theory about trails, including Eulerian trails (also known +as Eulerian circuits). + +## Main definitions + +* `simple_graph.walk.is_eulerian` is the predicate that a trail is an Eulerian trail. +* `simple_graph.walk.is_trail.even_countp_edges_iff` gives a condition on the number of edges + in a trail that can be incident to a given vertex. +* `simple_graph.walk.is_eulerian.even_degree_iff` gives a condition on the degrees of vertices + when there exists an Eulerian trail. +* `simple_graph.walk.is_eulerian.card_odd_degree` gives the possible numbers of odd-degree + vertices when there exists an Eulerian trail. + +## Todo + +* Prove that there exists an Eulerian trail when the conclusion to + `simple_graph.walk.is_eulerian.card_odd_degree` holds. + +## Tags + +Eulerian trails + +-/ + +namespace simple_graph +variables {V : Type*} {G : simple_graph V} + +namespace walk + +/-- The edges of a trail as a finset, since each edge in a trail appears exactly once. -/ +@[reducible] def is_trail.edges_finset {u v : V} {p : G.walk u v} + (h : p.is_trail) : finset (sym2 V) := +⟨p.edges, h.edges_nodup⟩ + +variables [decidable_eq V] + +lemma is_trail.even_countp_edges_iff {u v : V} {p : G.walk u v} (ht : p.is_trail) (x : V) : + even (p.edges.countp (λ e, x ∈ e)) ↔ (u ≠ v → x ≠ u ∧ x ≠ v) := +begin + induction p with u u v w huv p ih, + { simp, }, + { rw [cons_is_trail_iff] at ht, + specialize ih ht.1, + simp only [list.countp_cons, ne.def, edges_cons, sym2.mem_iff], + split_ifs with h, + { obtain (rfl | rfl) := h, + { rw [nat.even_add_one, ih], + simp only [huv.ne, imp_false, ne.def, not_false_iff, true_and, not_forall, not_not, + exists_prop, eq_self_iff_true, not_true, false_and, and_iff_right_iff_imp], + rintro rfl rfl, + exact G.loopless _ huv, }, + { rw [nat.even_add_one, ih, ← not_iff_not], + simp only [huv.ne.symm, ne.def, eq_self_iff_true, not_true, false_and, not_forall, + not_false_iff, exists_prop, and_true, not_not, true_and, iff_and_self], + rintro rfl, + exact huv.ne, } }, + { rw not_or_distrib at h, + simp only [h.1, h.2, not_false_iff, true_and, add_zero, ne.def] at ih ⊢, + rw ih, + split; + { rintro h' h'' rfl, + simp only [imp_false, eq_self_iff_true, not_true, not_not] at h', + cases h', + simpa using h } } }, +end + +/-- An *Eulerian trail* (also known as an "Eulerian path") is a walk +`p` that visits every edge exactly once. The lemma `simple_graph.walk.is_eulerian.is_trail` shows +that these are trails. + +Combine with `p.is_circuit` to get an Eulerian circuit (also known as an "Eulerian cycle"). -/ +def is_eulerian {u v : V} (p : G.walk u v) : Prop := +∀ e, e ∈ G.edge_set → p.edges.count e = 1 + +lemma is_eulerian.is_trail {u v : V} {p : G.walk u v} + (h : p.is_eulerian) : p.is_trail := +begin + rw [is_trail_def, list.nodup_iff_count_le_one], + intro e, + by_cases he : e ∈ p.edges, + { exact (h e (edges_subset_edge_set _ he)).le }, + { simp [he] }, +end + +lemma is_eulerian.mem_edges_iff {u v : V} {p : G.walk u v} (h : p.is_eulerian) {e : sym2 V} : + e ∈ p.edges ↔ e ∈ G.edge_set := +⟨λ h, p.edges_subset_edge_set h, λ he, by simpa using (h e he).ge⟩ + +/-- The edge set of an Eulerian graph is finite. -/ +def is_eulerian.fintype_edge_set {u v : V} {p : G.walk u v} + (h : p.is_eulerian) : fintype G.edge_set := +fintype.of_finset h.is_trail.edges_finset $ λ e, +by simp only [finset.mem_mk, multiset.mem_coe, h.mem_edges_iff] + +lemma is_trail.is_eulerian_of_forall_mem {u v : V} {p : G.walk u v} + (h : p.is_trail) (hc : ∀ e, e ∈ G.edge_set → e ∈ p.edges) : + p.is_eulerian := +λ e he, list.count_eq_one_of_mem h.edges_nodup (hc e he) + +lemma is_eulerian_iff {u v : V} (p : G.walk u v) : + p.is_eulerian ↔ p.is_trail ∧ ∀ e, e ∈ G.edge_set → e ∈ p.edges := +begin + split, + { intro h, + exact ⟨h.is_trail, λ _, h.mem_edges_iff.mpr⟩, }, + { rintro ⟨h, hl⟩, + exact h.is_eulerian_of_forall_mem hl, }, +end + +lemma is_eulerian.edges_finset_eq [fintype G.edge_set] + {u v : V} {p : G.walk u v} (h : p.is_eulerian) : + h.is_trail.edges_finset = G.edge_finset := +by { ext e, simp [h.mem_edges_iff] } + +lemma is_eulerian.even_degree_iff {x u v : V} {p : G.walk u v} (ht : p.is_eulerian) + [fintype V] [decidable_rel G.adj] : + even (G.degree x) ↔ (u ≠ v → x ≠ u ∧ x ≠ v) := +begin + convert ht.is_trail.even_countp_edges_iff x, + rw [← multiset.coe_countp, multiset.countp_eq_card_filter, ← card_incidence_finset_eq_degree], + change multiset.card _ = _, + congr' 1, + convert_to _ = (ht.is_trail.edges_finset.filter (has_mem.mem x)).val, + rw [ht.edges_finset_eq, G.incidence_finset_eq_filter x], +end + +lemma is_eulerian.card_filter_odd_degree [fintype V] [decidable_rel G.adj] + {u v : V} {p : G.walk u v} (ht : p.is_eulerian) + {s} (h : s = (finset.univ : finset V).filter (λ v, odd (G.degree v))) : + s.card = 0 ∨ s.card = 2 := +begin + subst s, + simp only [nat.odd_iff_not_even, finset.card_eq_zero], + simp only [ht.even_degree_iff, ne.def, not_forall, not_and, not_not, exists_prop], + obtain (rfl | hn) := eq_or_ne u v, + { left, + simp, }, + { right, + convert_to _ = ({u, v} : finset V).card, + { simp [hn], }, + { congr', + ext x, + simp [hn, imp_iff_not_or], } }, +end + +lemma is_eulerian.card_odd_degree [fintype V] [decidable_rel G.adj] + {u v : V} {p : G.walk u v} (ht : p.is_eulerian) : + fintype.card {v : V | odd (G.degree v)} = 0 ∨ fintype.card {v : V | odd (G.degree v)} = 2 := +begin + rw ← set.to_finset_card, + apply is_eulerian.card_filter_odd_degree ht, + ext v, + simp, +end + +end walk + +end simple_graph diff --git a/src/combinatorics/simple_graph/triangle/basic.lean b/src/combinatorics/simple_graph/triangle/basic.lean new file mode 100644 index 0000000000000..38c350e394e93 --- /dev/null +++ b/src/combinatorics/simple_graph/triangle/basic.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies, Bhavik Mehta +-/ +import combinatorics.simple_graph.clique + +/-! +# Triangles in graphs + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A *triangle* in a simple graph is a `3`-clique, namely a set of three vertices that are +pairwise adjacent. + +This module defines and proves properties about triangles in simple graphs. + +## Main declarations + +* `simple_graph.far_from_triangle_free`: Predicate for a graph to have enough triangles that, to + remove all of them, one must one must remove a lot of edges. This is the crux of the Triangle + Removal lemma. + +## TODO + +* Generalise `far_from_triangle_free` to other graphs, to state and prove the Graph Removal Lemma. +* Find a better name for `far_from_triangle_free`. Added 4/26/2022. Remove this TODO if it gets old. +-/ + +open finset fintype nat +open_locale classical + +namespace simple_graph +variables {α 𝕜 : Type*} [fintype α] [linear_ordered_field 𝕜] {G H : simple_graph α} {ε δ : 𝕜} + {n : ℕ} {s : finset α} + +/-- A simple graph is *`ε`-triangle-free far* if one must remove at least `ε * (card α)^2` edges to +make it triangle-free. -/ +def far_from_triangle_free (G : simple_graph α) (ε : 𝕜) : Prop := +G.delete_far (λ H, H.clique_free 3) $ ε * (card α^2 : ℕ) + +lemma far_from_triangle_free_iff : + G.far_from_triangle_free ε ↔ + ∀ ⦃H : simple_graph _⦄ [decidable_rel H.adj], by exactI + H ≤ G → H.clique_free 3 → ε * (card α^2 : ℕ) ≤ G.edge_finset.card - H.edge_finset.card := +delete_far_iff + +alias far_from_triangle_free_iff ↔ far_from_triangle_free.le_card_sub_card _ + +lemma far_from_triangle_free.mono (hε : G.far_from_triangle_free ε) (h : δ ≤ ε) : + G.far_from_triangle_free δ := +hε.mono $ mul_le_mul_of_nonneg_right h $ cast_nonneg _ + +lemma far_from_triangle_free.clique_finset_nonempty' (hH : H ≤ G) (hG : G.far_from_triangle_free ε) + (hcard : (G.edge_finset.card - H.edge_finset.card : 𝕜) < ε * (card α ^ 2 : ℕ)) : + (H.clique_finset 3).nonempty := +nonempty_of_ne_empty $ H.clique_finset_eq_empty_iff.not.2 $ λ hH', + (hG.le_card_sub_card hH hH').not_lt hcard + +variables [nonempty α] + +lemma far_from_triangle_free.nonpos (h₀ : G.far_from_triangle_free ε) (h₁ : G.clique_free 3) : + ε ≤ 0 := +begin + have := h₀ (empty_subset _), + rw [coe_empty, finset.card_empty, cast_zero, delete_edges_empty_eq] at this, + exact nonpos_of_mul_nonpos_left (this h₁) (cast_pos.2 $ sq_pos_of_pos fintype.card_pos), +end + +lemma clique_free.not_far_from_triangle_free (hG : G.clique_free 3) (hε : 0 < ε) : + ¬ G.far_from_triangle_free ε := +λ h, (h.nonpos hG).not_lt hε + +lemma far_from_triangle_free.not_clique_free (hG : G.far_from_triangle_free ε) (hε : 0 < ε) : + ¬ G.clique_free 3 := +λ h, (hG.nonpos h).not_lt hε + +lemma far_from_triangle_free.clique_finset_nonempty (hG : G.far_from_triangle_free ε) (hε : 0 < ε) : + (G.clique_finset 3).nonempty := +nonempty_of_ne_empty $ G.clique_finset_eq_empty_iff.not.2 $ hG.not_clique_free hε + +end simple_graph diff --git a/src/combinatorics/young/semistandard_tableau.lean b/src/combinatorics/young/semistandard_tableau.lean new file mode 100644 index 0000000000000..4c1261a411e9d --- /dev/null +++ b/src/combinatorics/young/semistandard_tableau.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2022 Jake Levinson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jake Levinson +-/ +import combinatorics.young.young_diagram + +/-! +# Semistandard Young tableaux + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A semistandard Young tableau is a filling of a Young diagram by natural numbers, such that +the entries are weakly increasing left-to-right along rows (i.e. for fixed `i`), and +strictly-increasing top-to-bottom along columns (i.e. for fixed `j`). + +An example of an SSYT of shape `μ = [4, 2, 1]` is: + +```text +0 0 0 2 +1 1 +2 +``` + +We represent an SSYT as a function `ℕ → ℕ → ℕ`, which is required to be zero for all pairs +`(i, j) ∉ μ` and to satisfy the row-weak and column-strict conditions on `μ`. + + +## Main definitions + +- `ssyt (μ : young_diagram)` : semistandard Young tableaux of shape `μ`. There is + a `has_coe_to_fun` instance such that `T i j` is value of the `(i, j)` entry of the SSYT `T`. +- `ssyt.highest_weight (μ : young_diagram)`: the semistandard Young tableau whose `i`th row + consists entirely of `i`s, for each `i`. + +## Tags + +Semistandard Young tableau + +## References + + + +-/ + +/-- A semistandard Young tableau (SSYT) is a filling of the cells of a Young diagram by natural +numbers, such that the entries in each row are weakly increasing (left to right), and the entries +in each column are strictly increasing (top to bottom). + +Here, an SSYT is represented as an unrestricted function `ℕ → ℕ → ℕ` that, for reasons +of extensionality, is required to vanish outside `μ`. -/ +structure ssyt (μ : young_diagram) := +(entry : ℕ → ℕ → ℕ) +(row_weak' : ∀ {i j1 j2 : ℕ}, j1 < j2 → (i, j2) ∈ μ → entry i j1 ≤ entry i j2) +(col_strict' : ∀ {i1 i2 j : ℕ}, i1 < i2 → (i2, j) ∈ μ → entry i1 j < entry i2 j) +(zeros' : ∀ {i j}, (i, j) ∉ μ → entry i j = 0) + +namespace ssyt + +instance fun_like {μ : young_diagram} : fun_like (ssyt μ) ℕ (λ _, ℕ → ℕ) := +{ coe := ssyt.entry, + coe_injective' := λ T T' h, by { cases T, cases T', congr' } } + +/-- Helper instance for when there's too many metavariables to apply +`fun_like.has_coe_to_fun` directly. -/ +instance {μ : young_diagram} : has_coe_to_fun (ssyt μ) (λ _, ℕ → ℕ → ℕ) := +fun_like.has_coe_to_fun + +@[simp] lemma to_fun_eq_coe {μ : young_diagram} {T : ssyt μ} : T.entry = (T : ℕ → ℕ → ℕ) := rfl + +@[ext] theorem ext {μ : young_diagram} {T T' : ssyt μ} (h : ∀ i j, T i j = T' i j) : T = T' := +fun_like.ext T T' (λ x, by { funext, apply h }) + +/-- Copy of an `ssyt μ` with a new `entry` equal to the old one. Useful to fix definitional +equalities. -/ +protected def copy {μ : young_diagram} (T : ssyt μ) (entry' : ℕ → ℕ → ℕ) (h : entry' = T) : + ssyt μ := +{ entry := entry', + row_weak' := λ _ _ _, h.symm ▸ T.row_weak', + col_strict' := λ _ _ _, h.symm ▸ T.col_strict', + zeros' := λ _ _, h.symm ▸ T.zeros' } + +@[simp] lemma coe_copy {μ : young_diagram} (T : ssyt μ) (entry' : ℕ → ℕ → ℕ) (h : entry' = T) : + ⇑(T.copy entry' h) = entry' := +rfl + +lemma copy_eq {μ : young_diagram} (T : ssyt μ) (entry' : ℕ → ℕ → ℕ) (h : entry' = T) : + T.copy entry' h = T := +fun_like.ext' h + +lemma row_weak {μ : young_diagram} (T : ssyt μ) {i j1 j2 : ℕ} + (hj : j1 < j2) (hcell : (i, j2) ∈ μ) : T i j1 ≤ T i j2 := +T.row_weak' hj hcell + +lemma col_strict {μ : young_diagram} (T : ssyt μ) {i1 i2 j : ℕ} + (hi : i1 < i2) (hcell : (i2, j) ∈ μ) : T i1 j < T i2 j := +T.col_strict' hi hcell + +lemma zeros {μ : young_diagram} (T : ssyt μ) + {i j : ℕ} (not_cell : (i, j) ∉ μ) : T i j = 0 := T.zeros' not_cell + +lemma row_weak_of_le {μ : young_diagram} (T : ssyt μ) {i j1 j2 : ℕ} + (hj : j1 ≤ j2) (cell : (i, j2) ∈ μ) : T i j1 ≤ T i j2 := +by { cases eq_or_lt_of_le hj, subst h, exact T.row_weak h cell } + +lemma col_weak {μ : young_diagram} (T : ssyt μ) {i1 i2 j : ℕ} + (hi : i1 ≤ i2) (cell : (i2, j) ∈ μ) : T i1 j ≤ T i2 j := +by { cases eq_or_lt_of_le hi, subst h, exact le_of_lt (T.col_strict h cell) } + +/-- The "highest weight" SSYT of a given shape is has all i's in row i, for each i. -/ +def highest_weight (μ : young_diagram) : ssyt μ := +{ entry := λ i j, if (i, j) ∈ μ then i else 0, + row_weak' := λ i j1 j2 hj hcell, + by rw [if_pos hcell, if_pos (μ.up_left_mem (by refl) (le_of_lt hj) hcell)], + col_strict' := λ i1 i2 j hi hcell, + by rwa [if_pos hcell, if_pos (μ.up_left_mem (le_of_lt hi) (by refl) hcell)], + zeros' := λ i j not_cell, if_neg not_cell } + +@[simp] lemma highest_weight_apply {μ : young_diagram} {i j : ℕ} : + highest_weight μ i j = if (i, j) ∈ μ then i else 0 := rfl + +instance {μ : young_diagram} : inhabited (ssyt μ) := ⟨ssyt.highest_weight μ⟩ + +end ssyt diff --git a/src/combinatorics/young/young_diagram.lean b/src/combinatorics/young/young_diagram.lean new file mode 100644 index 0000000000000..b24cc54c3edab --- /dev/null +++ b/src/combinatorics/young/young_diagram.lean @@ -0,0 +1,410 @@ +/- +Copyright (c) 2022 Jake Levinson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jake Levinson +-/ +import order.upper_lower.basic +import data.finset.preimage + +/-! +# Young diagrams + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A Young diagram is a finite set of up-left justified boxes: + +```text +□□□□□ +□□□ +□□□ +□ +``` +This Young diagram corresponds to the [5, 3, 3, 1] partition of 12. + +We represent it as a lower set in `ℕ × ℕ` in the product partial order. We write `(i, j) ∈ μ` +to say that `(i, j)` (in matrix coordinates) is in the Young diagram `μ`. + +## Main definitions + +- `young_diagram` : Young diagrams +- `young_diagram.card` : the number of cells in a Young diagram (its *cardinality*) +- `young_diagram.distrib_lattice` : a distributive lattice instance for Young diagrams + ordered by containment, with `(⊥ : young_diagram)` the empty diagram. +- `young_diagram.row` and `young_diagram.row_len`: rows of a Young diagram and their lengths +- `young_diagram.col` and `young_diagram.col_len`: columns of a Young diagram and their lengths + +## Notation + +In "English notation", a Young diagram is drawn so that (i1, j1) ≤ (i2, j2) +means (i1, j1) is weakly up-and-left of (i2, j2). This terminology is used +below, e.g. in `young_diagram.up_left_mem`. + +## Tags + +Young diagram + +## References + + + +-/ + +open function + +/-- A Young diagram is a finite collection of cells on the `ℕ × ℕ` grid such that whenever +a cell is present, so are all the ones above and to the left of it. Like matrices, an `(i, j)` cell +is a cell in row `i` and column `j`, where rows are enumerated downward and columns rightward. + +Young diagrams are modeled as finite sets in `ℕ × ℕ` that are lower sets with respect to the +standard order on products. -/ +@[ext] structure young_diagram := +(cells : finset (ℕ × ℕ)) +(is_lower_set : is_lower_set (cells : set (ℕ × ℕ))) + +namespace young_diagram + +instance : set_like young_diagram (ℕ × ℕ) := +{ coe := coe young_diagram.cells, + coe_injective' := λ μ ν h, by { rwa [young_diagram.ext_iff, ← finset.coe_inj] } } + +@[simp] lemma mem_cells {μ : young_diagram} (c : ℕ × ℕ) : + c ∈ μ.cells ↔ c ∈ μ := iff.rfl + +@[simp] lemma mem_mk (c : ℕ × ℕ) (cells) (is_lower_set) : + c ∈ young_diagram.mk cells is_lower_set ↔ c ∈ cells := iff.rfl + +instance decidable_mem (μ : young_diagram) : decidable_pred (∈ μ) := +show decidable_pred (∈ μ.cells), by apply_instance + +/-- In "English notation", a Young diagram is drawn so that (i1, j1) ≤ (i2, j2) + means (i1, j1) is weakly up-and-left of (i2, j2). -/ +lemma up_left_mem (μ : young_diagram) {i1 i2 j1 j2 : ℕ} + (hi : i1 ≤ i2) (hj : j1 ≤ j2) (hcell : (i2, j2) ∈ μ) : (i1, j1) ∈ μ := +μ.is_lower_set (prod.mk_le_mk.mpr ⟨hi, hj⟩) hcell + +section distrib_lattice + +@[simp] lemma cells_subset_iff {μ ν : young_diagram} : μ.cells ⊆ ν.cells ↔ μ ≤ ν := iff.rfl +@[simp] lemma cells_ssubset_iff {μ ν : young_diagram} : μ.cells ⊂ ν.cells ↔ μ < ν := iff.rfl + +instance : has_sup young_diagram := +{ sup := λ μ ν, { cells := μ.cells ∪ ν.cells, + is_lower_set := by { rw finset.coe_union, + exact μ.is_lower_set.union ν.is_lower_set } } } + +@[simp] lemma cells_sup (μ ν : young_diagram) : (μ ⊔ ν).cells = μ.cells ∪ ν.cells := rfl + +@[simp, norm_cast] lemma coe_sup (μ ν : young_diagram) : ↑(μ ⊔ ν) = (μ ∪ ν : set (ℕ × ℕ)) := +finset.coe_union _ _ + +@[simp] lemma mem_sup {μ ν : young_diagram} {x : ℕ × ℕ} : x ∈ (μ ⊔ ν) ↔ x ∈ μ ∨ x ∈ ν := +finset.mem_union + +instance : has_inf young_diagram := +{ inf := λ μ ν, { cells := μ.cells ∩ ν.cells, + is_lower_set := by { rw finset.coe_inter, + exact μ.is_lower_set.inter ν.is_lower_set } } } + +@[simp] lemma cells_inf (μ ν : young_diagram) : (μ ⊓ ν).cells = μ.cells ∩ ν.cells := rfl + +@[simp, norm_cast] lemma coe_inf (μ ν : young_diagram) : ↑(μ ⊓ ν) = (μ ∩ ν : set (ℕ × ℕ)) := +finset.coe_inter _ _ + +@[simp] lemma mem_inf {μ ν : young_diagram} {x : ℕ × ℕ} : x ∈ (μ ⊓ ν) ↔ x ∈ μ ∧ x ∈ ν := +finset.mem_inter + +/-- The empty Young diagram is (⊥ : young_diagram). -/ +instance : order_bot young_diagram := +{ bot := { cells := ∅, is_lower_set := λ _ _ _, false.elim }, bot_le := λ _ _, false.elim } + +@[simp] lemma cells_bot : (⊥ : young_diagram).cells = ∅ := rfl + +@[simp, norm_cast] lemma coe_bot : ↑(⊥ : young_diagram) = (∅ : set (ℕ × ℕ)) := rfl + +@[simp] lemma not_mem_bot (x : ℕ × ℕ) : x ∉ (⊥ : young_diagram) := finset.not_mem_empty x + +instance : inhabited young_diagram := ⟨⊥⟩ + +instance : distrib_lattice young_diagram := +function.injective.distrib_lattice + young_diagram.cells + (λ μ ν h, by rwa young_diagram.ext_iff) + (λ _ _, rfl) (λ _ _, rfl) + +end distrib_lattice + +/-- Cardinality of a Young diagram -/ +@[reducible] protected def card (μ : young_diagram) : ℕ := μ.cells.card + +section transpose + +/-- The `transpose` of a Young diagram is obtained by swapping i's with j's. -/ +def transpose (μ : young_diagram) : young_diagram := +{ cells := (equiv.prod_comm _ _).finset_congr μ.cells, + is_lower_set := λ _ _ h, begin + simp only [finset.mem_coe, equiv.finset_congr_apply, finset.mem_map_equiv], + intro hcell, + apply μ.is_lower_set _ hcell, + simp [h], + end } + +@[simp] lemma mem_transpose {μ : young_diagram} {c : ℕ × ℕ} : c ∈ μ.transpose ↔ c.swap ∈ μ := +by simp [transpose] + +@[simp] lemma transpose_transpose (μ : young_diagram) : μ.transpose.transpose = μ := +by { ext, simp } + +lemma transpose_eq_iff_eq_transpose {μ ν : young_diagram} : + μ.transpose = ν ↔ μ = ν.transpose := +by { split; { rintro rfl, simp } } + +@[simp] lemma transpose_eq_iff {μ ν : young_diagram} : + μ.transpose = ν.transpose ↔ μ = ν := +by { rw transpose_eq_iff_eq_transpose, simp } + +-- This is effectively both directions of `transpose_le_iff` below. +protected lemma le_of_transpose_le {μ ν : young_diagram} (h_le : μ.transpose ≤ ν) : + μ ≤ ν.transpose := +λ c hc, by { simp only [mem_transpose], apply h_le, simpa } + +@[simp] lemma transpose_le_iff {μ ν : young_diagram} : μ.transpose ≤ ν.transpose ↔ μ ≤ ν := +⟨ λ h, by { convert young_diagram.le_of_transpose_le h, simp }, + λ h, by { convert @young_diagram.le_of_transpose_le _ _ _, simpa } ⟩ + +@[mono] +protected lemma transpose_mono {μ ν : young_diagram} (h_le : μ ≤ ν) : μ.transpose ≤ ν.transpose := +transpose_le_iff.mpr h_le + +/-- Transposing Young diagrams is an `order_iso`. -/ +@[simps] def transpose_order_iso : young_diagram ≃o young_diagram := +⟨⟨transpose, transpose, λ _, by simp, λ _, by simp⟩, by simp⟩ + +end transpose + +section rows +/-! ### Rows and row lengths of Young diagrams. + +This section defines `μ.row` and `μ.row_len`, with the following API: + 1. `(i, j) ∈ μ ↔ j < μ.row_len i` + 2. `μ.row i = {i} ×ˢ (finset.range (μ.row_len i))` + 3. `μ.row_len i = (μ.row i).card` + 4. `∀ {i1 i2}, i1 ≤ i2 → μ.row_len i2 ≤ μ.row_len i1` + +Note: #3 is not convenient for defining `μ.row_len`; instead, `μ.row_len` is defined +as the smallest `j` such that `(i, j) ∉ μ`. -/ + +/-- The `i`-th row of a Young diagram consists of the cells whose first coordinate is `i`. -/ +def row (μ : young_diagram) (i : ℕ) : finset (ℕ × ℕ) := μ.cells.filter (λ c, c.fst = i) + +lemma mem_row_iff {μ : young_diagram} {i : ℕ} {c : ℕ × ℕ} : c ∈ μ.row i ↔ c ∈ μ ∧ c.fst = i := +by simp [row] + +lemma mk_mem_row_iff {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ.row i ↔ (i, j) ∈ μ := +by simp [row] + +protected lemma exists_not_mem_row (μ : young_diagram) (i : ℕ) : ∃ j, (i, j) ∉ μ := +begin + obtain ⟨j, hj⟩ := infinite.exists_not_mem_finset + ((μ.cells).preimage (prod.mk i) (λ _ _ _ _ h, by {cases h, refl})), + rw finset.mem_preimage at hj, + exact ⟨j, hj⟩, +end + +/-- Length of a row of a Young diagram -/ +def row_len (μ : young_diagram) (i : ℕ) : ℕ := nat.find $ μ.exists_not_mem_row i + +lemma mem_iff_lt_row_len {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ ↔ j < μ.row_len i := +by { rw [row_len, nat.lt_find_iff], push_neg, + exact ⟨λ h _ hmj, μ.up_left_mem (by refl) hmj h, λ h, h _ (by refl)⟩ } + +lemma row_eq_prod {μ : young_diagram} {i : ℕ} : μ.row i = {i} ×ˢ finset.range (μ.row_len i) := +by { ext ⟨a, b⟩, + simp only [finset.mem_product, finset.mem_singleton, finset.mem_range, + mem_row_iff, mem_iff_lt_row_len, and_comm, and.congr_right_iff], + rintro rfl, refl } + +lemma row_len_eq_card (μ : young_diagram) {i : ℕ} : μ.row_len i = (μ.row i).card := +by simp [row_eq_prod] + +@[mono] +lemma row_len_anti (μ : young_diagram) (i1 i2 : ℕ) (hi : i1 ≤ i2) : μ.row_len i2 ≤ μ.row_len i1 := +by { by_contra' h_lt, rw ← lt_self_iff_false (μ.row_len i1), + rw ← mem_iff_lt_row_len at h_lt ⊢, + exact μ.up_left_mem hi (by refl) h_lt } + +end rows + +section columns +/-! ### Columns and column lengths of Young diagrams. + +This section has an identical API to the rows section. -/ + +/-- The `j`-th column of a Young diagram consists of the cells whose second coordinate is `j`. -/ +def col (μ : young_diagram) (j : ℕ) : finset (ℕ × ℕ) := μ.cells.filter (λ c, c.snd = j) + +lemma mem_col_iff {μ : young_diagram} {j : ℕ} {c : ℕ × ℕ} : c ∈ μ.col j ↔ c ∈ μ ∧ c.snd = j := +by simp [col] + +lemma mk_mem_col_iff {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ.col j ↔ (i, j) ∈ μ := +by simp [col] + +protected lemma exists_not_mem_col (μ : young_diagram) (j : ℕ) : ∃ i, (i, j) ∉ μ.cells := +by { convert μ.transpose.exists_not_mem_row j, simp } + +/-- Length of a column of a Young diagram -/ +def col_len (μ : young_diagram) (j : ℕ) : ℕ := nat.find $ μ.exists_not_mem_col j + +@[simp] lemma col_len_transpose (μ : young_diagram) (j : ℕ) : μ.transpose.col_len j = μ.row_len j := +by simp [row_len, col_len] + +@[simp] lemma row_len_transpose (μ : young_diagram) (i : ℕ) : μ.transpose.row_len i = μ.col_len i := +by simp [row_len, col_len] + +lemma mem_iff_lt_col_len {μ : young_diagram} {i j : ℕ} : (i, j) ∈ μ ↔ i < μ.col_len j := +by { rw [← row_len_transpose, ← mem_iff_lt_row_len], simp } + +lemma col_eq_prod {μ : young_diagram} {j : ℕ} : μ.col j = (finset.range (μ.col_len j)) ×ˢ {j} := +by { ext ⟨a, b⟩, + simp only [finset.mem_product, finset.mem_singleton, finset.mem_range, + mem_col_iff, mem_iff_lt_col_len, and_comm, and.congr_right_iff], + rintro rfl, refl } + +lemma col_len_eq_card (μ : young_diagram) {j : ℕ} : μ.col_len j = (μ.col j).card := +by simp [col_eq_prod] + +@[mono] +lemma col_len_anti (μ : young_diagram) (j1 j2 : ℕ) (hj : j1 ≤ j2) : μ.col_len j2 ≤ μ.col_len j1 := +by { convert μ.transpose.row_len_anti j1 j2 hj; simp } + +end columns + +section row_lens +/-! ### The list of row lengths of a Young diagram + +This section defines `μ.row_lens : list ℕ`, the list of row lengths of a Young diagram `μ`. + 1. `young_diagram.row_lens_sorted` : It is weakly decreasing (`list.sorted (≥)`). + 2. `young_diagram.row_lens_pos` : It is strictly positive. + +-/ + +/-- List of row lengths of a Young diagram -/ +def row_lens (μ : young_diagram) : list ℕ := (list.range $ μ.col_len 0).map μ.row_len + +@[simp] lemma nth_le_row_lens {μ : young_diagram} {i : ℕ} {hi : i < μ.row_lens.length} : + μ.row_lens.nth_le i hi = μ.row_len i := +by simp only [row_lens, list.nth_le_range, list.nth_le_map'] + +@[simp] lemma length_row_lens {μ : young_diagram} : μ.row_lens.length = μ.col_len 0 := +by simp only [row_lens, list.length_map, list.length_range] + +lemma row_lens_sorted (μ : young_diagram) : μ.row_lens.sorted (≥) := +(list.pairwise_le_range _).map _ μ.row_len_anti + +lemma pos_of_mem_row_lens (μ : young_diagram) (x : ℕ) (hx : x ∈ μ.row_lens) : 0 < x := +begin + rw [row_lens, list.mem_map] at hx, + obtain ⟨i, hi, rfl : μ.row_len i = x⟩ := hx, + rwa [list.mem_range, ← mem_iff_lt_col_len, mem_iff_lt_row_len] at hi +end + +end row_lens + +section equiv_list_row_lens +/-! ### Equivalence between Young diagrams and lists of natural numbers + +This section defines the equivalence between Young diagrams `μ` and weakly decreasing lists `w` +of positive natural numbers, corresponding to row lengths of the diagram: + `young_diagram.equiv_list_row_lens :` + `young_diagram ≃ {w : list ℕ // w.sorted (≥) ∧ ∀ x ∈ w, 0 < x}` + +The two directions are `young_diagram.row_lens` (defined above) and `young_diagram.of_row_lens`. + +-/ + +/-- The cells making up a `young_diagram` from a list of row lengths -/ +protected def cells_of_row_lens : list ℕ → finset (ℕ × ℕ) +| [] := ∅ +| (w :: ws) := (({0} : finset ℕ) ×ˢ finset.range w) ∪ + (cells_of_row_lens ws).map + (embedding.prod_map ⟨_, nat.succ_injective⟩ (embedding.refl ℕ)) + +protected lemma mem_cells_of_row_lens {w : list ℕ} {c : ℕ × ℕ} : + c ∈ young_diagram.cells_of_row_lens w ↔ ∃ (h : c.fst < w.length), c.snd < w.nth_le c.fst h := +begin + induction w generalizing c; + rw young_diagram.cells_of_row_lens, + { simp [young_diagram.cells_of_row_lens] }, + { rcases c with ⟨⟨_, _⟩, _⟩, + { simp }, + { simpa [w_ih, -finset.singleton_product, nat.succ_lt_succ_iff] } } +end + +/-- Young diagram from a sorted list -/ +def of_row_lens (w : list ℕ) (hw : w.sorted (≥)) : young_diagram := +{ cells := young_diagram.cells_of_row_lens w, + is_lower_set := begin + rintros ⟨i2, j2⟩ ⟨i1, j1⟩ ⟨hi : i1 ≤ i2, hj : j1 ≤ j2⟩ hcell, + rw [finset.mem_coe, young_diagram.mem_cells_of_row_lens] at hcell ⊢, + obtain ⟨h1, h2⟩ := hcell, + refine ⟨hi.trans_lt h1, _⟩, + calc j1 ≤ j2 : hj + ... < w.nth_le i2 _ : h2 + ... ≤ w.nth_le i1 _ : _, + obtain (rfl | h) := eq_or_lt_of_le hi, + { refl }, + { apply list.pairwise_iff_nth_le.mp hw _ _ _ h } + end } + +lemma mem_of_row_lens {w : list ℕ} {hw : w.sorted (≥)} {c : ℕ × ℕ} : + c ∈ of_row_lens w hw ↔ ∃ (h : c.fst < w.length), c.snd < w.nth_le c.fst h := +young_diagram.mem_cells_of_row_lens + +/-- The number of rows in `of_row_lens w hw` is the length of `w` -/ +lemma row_lens_length_of_row_lens {w : list ℕ} {hw : w.sorted (≥)} (hpos : ∀ x ∈ w, 0 < x) : + (of_row_lens w hw).row_lens.length = w.length := +begin + simp only [length_row_lens, col_len, nat.find_eq_iff, mem_cells, mem_of_row_lens, + lt_self_iff_false, is_empty.exists_iff, not_not], + exact ⟨id, λ n hn, ⟨hn, hpos _ (list.nth_le_mem _ _ hn)⟩⟩, +end + +/-- The length of the `i`th row in `of_row_lens w hw` is the `i`th entry of `w` -/ +lemma row_len_of_row_lens {w : list ℕ} {hw : w.sorted (≥)} + (i : ℕ) (hi : i < w.length) : (of_row_lens w hw).row_len i = w.nth_le i hi := +by simp [row_len, nat.find_eq_iff, mem_of_row_lens, hi] + +/-- The left_inv direction of the equivalence -/ +lemma of_row_lens_to_row_lens_eq_self {μ : young_diagram} : + of_row_lens _ (row_lens_sorted μ) = μ := +begin + ext ⟨i, j⟩, + simp only [mem_cells, mem_of_row_lens, length_row_lens, nth_le_row_lens], + simpa [← mem_iff_lt_col_len, mem_iff_lt_row_len] using j.zero_le.trans_lt, +end + +/-- The right_inv direction of the equivalence -/ +lemma row_lens_of_row_lens_eq_self {w : list ℕ} {hw : w.sorted (≥)} (hpos : ∀ x ∈ w, 0 < x) : + (of_row_lens w hw).row_lens = w := +begin + ext i r, + cases lt_or_ge i w.length, + { simp only [option.mem_def, ← list.nth_le_eq_iff, h, row_lens_length_of_row_lens hpos], + revert r, + simpa only [eq_iff_eq_cancel_right, nth_le_row_lens] using row_len_of_row_lens _ h }, + { rw [list.nth_eq_none_iff.mpr h, list.nth_eq_none_iff.mpr], + rwa row_lens_length_of_row_lens hpos } +end + +/-- Equivalence between Young diagrams and weakly decreasing lists of positive natural numbers. +A Young diagram `μ` is equivalent to a list of row lengths. -/ +@[simps] +def equiv_list_row_lens : young_diagram ≃ {w : list ℕ // w.sorted (≥) ∧ ∀ x ∈ w, 0 < x} := +{ to_fun := λ μ, ⟨μ.row_lens, μ.row_lens_sorted, μ.pos_of_mem_row_lens⟩, + inv_fun := λ ww, of_row_lens ww.1 ww.2.1, + left_inv := λ μ, of_row_lens_to_row_lens_eq_self, + right_inv := λ ⟨w, hw⟩, subtype.mk_eq_mk.mpr (row_lens_of_row_lens_eq_self hw.2) } + +end equiv_list_row_lens + +end young_diagram diff --git a/src/computability/DFA.lean b/src/computability/DFA.lean index f369a88bf8dd1..2bf2fadcda8a2 100644 --- a/src/computability/DFA.lean +++ b/src/computability/DFA.lean @@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fox Thomson -/ -import data.fintype.basic +import data.fintype.card import computability.language import tactic.norm_num /-! # Deterministic Finite Automata + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of a Deterministic Finite Automaton (DFA), a state machine which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set in linear time. @@ -17,6 +21,8 @@ Note that this definition allows for Automaton with infinite states, a `fintype` supplied for true DFA's. -/ +open_locale computability + universes u v /-- A DFA is a set of states (`σ`), a transition function from state to state labelled by the @@ -74,8 +80,7 @@ lemma eval_from_split [fintype σ] {x : list α} {s t : σ} (hlen : fintype.card begin obtain ⟨n, m, hneq, heq⟩ := fintype.exists_ne_map_eq_of_card_lt (λ n : fin (fintype.card σ + 1), M.eval_from s (x.take n)) (by norm_num), - wlog hle : (n : ℕ) ≤ m using n m, - have hlt : (n : ℕ) < m := (ne.le_iff_lt hneq).mp hle, + wlog hle : (n : ℕ) ≤ m, { exact this hlen hx _ _ hneq.symm heq.symm (le_of_not_le hle), }, have hm : (m : ℕ) ≤ fintype.card σ := fin.is_le m, dsimp at heq, @@ -109,9 +114,9 @@ begin end lemma eval_from_of_pow {x y : list α} {s : σ} (hx : M.eval_from s x = s) - (hy : y ∈ @language.star α {x}) : M.eval_from s y = s := + (hy : y ∈ ({x} : language α)∗) : M.eval_from s y = s := begin - rw language.mem_star at hy, + rw language.mem_kstar at hy, rcases hy with ⟨ S, rfl, hS ⟩, induction S with a S ih, { refl }, @@ -126,7 +131,7 @@ end lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts) (hlen : fintype.card σ ≤ list.length x) : ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card σ ∧ b ≠ [] ∧ - {a} * language.star {b} * {c} ≤ M.accepts := + {a} * {b}∗ * {c} ≤ M.accepts := begin obtain ⟨_, a, b, c, hx, hlen, hnil, rfl, hb, hc⟩ := M.eval_from_split hlen rfl, use [a, b, c, hx, hlen, hnil], diff --git a/src/computability/NFA.lean b/src/computability/NFA.lean index 00d4c3e4fa5cb..1026ac008c6fb 100644 --- a/src/computability/NFA.lean +++ b/src/computability/NFA.lean @@ -4,10 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Fox Thomson -/ import computability.DFA -import data.set.functor +import data.fintype.powerset /-! # Nondeterministic Finite Automata + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. This file contains the definition of a Nondeterministic Finite Automaton (NFA), a state machine which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set by evaluating the string over every possible path. @@ -18,6 +21,7 @@ supplied for true NFA's. -/ open set +open_locale computability universes u v @@ -89,7 +93,7 @@ end lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts) (hlen : fintype.card (set σ) ≤ list.length x) : ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧ - {a} * language.star {b} * {c} ≤ M.accepts := + {a} * {b}∗ * {c} ≤ M.accepts := begin rw ←to_DFA_correct at hx ⊢, exact M.to_DFA.pumping_lemma hx hlen diff --git a/src/computability/ackermann.lean b/src/computability/ackermann.lean new file mode 100644 index 0000000000000..37a83d6c913b0 --- /dev/null +++ b/src/computability/ackermann.lean @@ -0,0 +1,332 @@ +/- +Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández Palacios +-/ +import computability.primrec +import tactic.linarith + +/-! +# Ackermann function + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we define the two-argument Ackermann function `ack`. Despite having a recursive +definition, we show that this isn't a primitive recursive function. + +## Main results + +- `exists_lt_ack_of_primrec`: any primitive recursive function is pointwise bounded above by `ack m` + for some `m`. +- `not_primrec₂_ack`: the two-argument Ackermann function is not primitive recursive. + +## Proof approach + +We very broadly adapt the proof idea from +https://www.planetmath.org/ackermannfunctionisnotprimitiverecursive. Namely, we prove that for any +primitive recursive `f : ℕ → ℕ`, there exists `m` such that `f n < ack m n` for all `n`. This then +implies that `λ n, ack n n` can't be primitive recursive, and so neither can `ack`. We aren't able +to use the same bounds as in that proof though, since our approach of using pairing functions +differs from their approach of using multivariate functions. + +The important bounds we show during the main inductive proof (`exists_lt_ack_of_primrec`) are the +following. Assuming `∀ n, f n < ack a n` and `∀ n, g n < ack b n`, we have: + +- `∀ n, nat.mkpair (f n) (g n) < ack (max a b + 3) n`. +- `∀ n, g (f n) < ack (max a b + 2) n`. +- `∀ n, nat.elim (f n.unpair.1) (λ (y IH : ℕ), g (nat.mkpair n.unpair.1 (nat.mkpair y IH))) + n.unpair.2 < ack (max a b + 9) n`. + +The last one is evidently the hardest. Using `nat.unpair_add_le`, we reduce it to the more +manageable + +- `∀ m n, elim (f m) (λ (y IH : ℕ), g (nat.mkpair m (nat.mkpair y IH))) n < + ack (max a b + 9) (m + n)`. + +We then prove this by induction on `n`. Our proof crucially depends on `ack_mkpair_lt`, which is +applied twice, giving us a constant of `4 + 4`. The rest of the proof consists of simpler bounds +which bump up our constant to `9`. +-/ + +open nat + +/-- The two-argument Ackermann function, defined so that + +- `ack 0 n = n + 1` +- `ack (m + 1) 0 = ack m 1` +- `ack (m + 1) (n + 1) = ack m (ack (m + 1) n)`. + +This is of interest as both a fast-growing function, and as an example of a recursive function that +isn't primitive recursive. -/ +def ack : ℕ → ℕ → ℕ +| 0 n := n + 1 +| (m + 1) 0 := ack m 1 +| (m + 1) (n + 1) := ack m (ack (m + 1) n) + +@[simp] theorem ack_zero (n : ℕ) : ack 0 n = n + 1 := by rw ack +@[simp] theorem ack_succ_zero (m : ℕ) : ack (m + 1) 0 = ack m 1 := by rw ack +@[simp] theorem ack_succ_succ (m n : ℕ) : ack (m + 1) (n + 1) = ack m (ack (m + 1) n) := by rw ack + +@[simp] theorem ack_one (n : ℕ) : ack 1 n = n + 2 := +begin + induction n with n IH, + { simp }, + { simp [IH] } +end + +@[simp] theorem ack_two (n : ℕ) : ack 2 n = 2 * n + 3 := +begin + induction n with n IH, + { simp }, + { simp [IH, mul_succ] } +end + +private theorem ack_three_aux (n : ℕ) : (ack 3 n : ℤ) = 2 ^ (n + 3) - 3 := +begin + induction n with n IH, + { simp, norm_num }, + { simp [IH, pow_succ], + rw [mul_sub, sub_add], + norm_num } +end + +@[simp] theorem ack_three (n : ℕ) : ack 3 n = 2 ^ (n + 3) - 3 := +begin + zify, + rw cast_sub, + { exact_mod_cast ack_three_aux n }, + { have H : 3 ≤ 2 ^ 3 := by norm_num, + exact H.trans (pow_mono one_le_two $ le_add_left le_rfl) } +end + +theorem ack_pos : ∀ m n, 0 < ack m n +| 0 n := by simp +| (m + 1) 0 := by { rw ack_succ_zero, apply ack_pos } +| (m + 1) (n + 1) := by { rw ack_succ_succ, apply ack_pos } + +theorem one_lt_ack_succ_left : ∀ m n, 1 < ack (m + 1) n +| 0 n := by simp +| (m + 1) 0 := by { rw ack_succ_zero, apply one_lt_ack_succ_left } +| (m + 1) (n + 1) := by { rw ack_succ_succ, apply one_lt_ack_succ_left } + +theorem one_lt_ack_succ_right : ∀ m n, 1 < ack m (n + 1) +| 0 n := by simp +| (m + 1) n := begin + rw ack_succ_succ, + cases exists_eq_succ_of_ne_zero (ack_pos (m + 1) n).ne', + rw h, + apply one_lt_ack_succ_right +end + +theorem ack_strict_mono_right : ∀ m, strict_mono (ack m) +| 0 n₁ n₂ h := by simpa using h +| (m + 1) 0 (n + 1) h := begin + rw [ack_succ_zero, ack_succ_succ], + exact ack_strict_mono_right _ (one_lt_ack_succ_left m n) +end +| (m + 1) (n₁ + 1) (n₂ + 1) h := begin + rw [ack_succ_succ, ack_succ_succ], + apply ack_strict_mono_right _ (ack_strict_mono_right _ _), + rwa add_lt_add_iff_right at h +end + +theorem ack_mono_right (m : ℕ) : monotone (ack m) := (ack_strict_mono_right m).monotone + +theorem ack_injective_right (m : ℕ) : function.injective (ack m) := +(ack_strict_mono_right m).injective + +@[simp] theorem ack_lt_iff_right {m n₁ n₂ : ℕ} : ack m n₁ < ack m n₂ ↔ n₁ < n₂ := +(ack_strict_mono_right m).lt_iff_lt + +@[simp] theorem ack_le_iff_right {m n₁ n₂ : ℕ} : ack m n₁ ≤ ack m n₂ ↔ n₁ ≤ n₂ := +(ack_strict_mono_right m).le_iff_le + +@[simp] theorem ack_inj_right {m n₁ n₂ : ℕ} : ack m n₁ = ack m n₂ ↔ n₁ = n₂ := +(ack_injective_right m).eq_iff + +theorem max_ack_right (m n₁ n₂ : ℕ) : ack m (max n₁ n₂) = max (ack m n₁) (ack m n₂) := +(ack_mono_right m).map_max + +theorem add_lt_ack : ∀ m n, m + n < ack m n +| 0 n := by simp +| (m + 1) 0 := by simpa using add_lt_ack m 1 +| (m + 1) (n + 1) := +calc (m + 1) + n + 1 + ≤ m + (m + n + 2) : by linarith + ... < ack m (m + n + 2) : add_lt_ack _ _ + ... ≤ ack m (ack (m + 1) n) : ack_mono_right m $ + le_of_eq_of_le (by ring_nf) $ succ_le_of_lt $ add_lt_ack (m + 1) n + ... = ack (m + 1) (n + 1) : (ack_succ_succ m n).symm + +theorem add_add_one_le_ack (m n : ℕ) : m + n + 1 ≤ ack m n := succ_le_of_lt (add_lt_ack m n) + +theorem lt_ack_left (m n : ℕ) : m < ack m n := (self_le_add_right m n).trans_lt $ add_lt_ack m n +theorem lt_ack_right (m n : ℕ) : n < ack m n := (self_le_add_left n m).trans_lt $ add_lt_ack m n + +-- we reorder the arguments to appease the equation compiler +private theorem ack_strict_mono_left' : ∀ {m₁ m₂} n, m₁ < m₂ → ack m₁ n < ack m₂ n +| m 0 n := λ h, (nat.not_lt_zero m h).elim +| 0 (m + 1) 0 := λ h, by simpa using one_lt_ack_succ_right m 0 +| 0 (m + 1) (n + 1) := λ h, begin + rw [ack_zero, ack_succ_succ], + apply lt_of_le_of_lt (le_trans _ $ add_le_add_left (add_add_one_le_ack _ _) m) (add_lt_ack _ _), + linarith +end +| (m₁ + 1) (m₂ + 1) 0 := λ h, by simpa using ack_strict_mono_left' 1 ((add_lt_add_iff_right 1).1 h) +| (m₁ + 1) (m₂ + 1) (n + 1) := λ h, begin + rw [ack_succ_succ, ack_succ_succ], + exact (ack_strict_mono_left' _ $ (add_lt_add_iff_right 1).1 h).trans + (ack_strict_mono_right _ $ ack_strict_mono_left' n h) +end + +theorem ack_strict_mono_left (n : ℕ) : strict_mono (λ m, ack m n) := +λ m₁ m₂, ack_strict_mono_left' n + +theorem ack_mono_left (n : ℕ) : monotone (λ m, ack m n) := (ack_strict_mono_left n).monotone + +theorem ack_injective_left (n : ℕ) : function.injective (λ m, ack m n) := +(ack_strict_mono_left n).injective + +@[simp] theorem ack_lt_iff_left {m₁ m₂ n : ℕ} : ack m₁ n < ack m₂ n ↔ m₁ < m₂ := +(ack_strict_mono_left n).lt_iff_lt + +@[simp] theorem ack_le_iff_left {m₁ m₂ n : ℕ} : ack m₁ n ≤ ack m₂ n ↔ m₁ ≤ m₂ := +(ack_strict_mono_left n).le_iff_le + +@[simp] theorem ack_inj_left {m₁ m₂ n : ℕ} : ack m₁ n = ack m₂ n ↔ m₁ = m₂ := +(ack_injective_left n).eq_iff + +theorem max_ack_left (m₁ m₂ n : ℕ) : ack (max m₁ m₂) n = max (ack m₁ n) (ack m₂ n) := +(ack_mono_left n).map_max + +theorem ack_le_ack {m₁ m₂ n₁ n₂ : ℕ} (hm : m₁ ≤ m₂) (hn : n₁ ≤ n₂) : ack m₁ n₁ ≤ ack m₂ n₂ := +(ack_mono_left n₁ hm).trans $ ack_mono_right m₂ hn + +theorem ack_succ_right_le_ack_succ_left (m n : ℕ) : ack m (n + 1) ≤ ack (m + 1) n := +begin + cases n, + { simp }, + { rw [ack_succ_succ, succ_eq_add_one], + apply ack_mono_right m (le_trans _ $ add_add_one_le_ack _ n), + linarith } +end + +-- All the inequalities from this point onwards are specific to the main proof. + +private theorem sq_le_two_pow_add_one_minus_three (n : ℕ) : n ^ 2 ≤ 2 ^ (n + 1) - 3 := +begin + induction n with k hk, + { norm_num }, + { cases k, + { norm_num }, + { rw [succ_eq_add_one, add_sq, pow_succ 2, two_mul (2 ^ _), add_tsub_assoc_of_le, + add_comm (2 ^ _), add_assoc], + { apply add_le_add hk, + norm_num, + apply succ_le_of_lt, + rw [pow_succ, mul_lt_mul_left (zero_lt_two' ℕ)], + apply lt_two_pow }, + { rw [pow_succ, pow_succ], + linarith [one_le_pow k 2 zero_lt_two] } } } +end + +theorem ack_add_one_sq_lt_ack_add_three : ∀ m n, (ack m n + 1) ^ 2 ≤ ack (m + 3) n +| 0 n := by simpa using sq_le_two_pow_add_one_minus_three (n + 2) +| (m + 1) 0 := by { rw [ack_succ_zero, ack_succ_zero], apply ack_add_one_sq_lt_ack_add_three } +| (m + 1) (n + 1) := begin + rw [ack_succ_succ, ack_succ_succ], + apply (ack_add_one_sq_lt_ack_add_three _ _).trans (ack_mono_right _ $ ack_mono_left _ _), + linarith +end + +theorem ack_ack_lt_ack_max_add_two (m n k : ℕ) : ack m (ack n k) < ack (max m n + 2) k := +calc ack m (ack n k) + ≤ ack (max m n) (ack n k) : ack_mono_left _ (le_max_left _ _) + ... < ack (max m n) (ack (max m n + 1) k) : ack_strict_mono_right _ $ ack_strict_mono_left k $ + lt_succ_of_le $ le_max_right m n + ... = ack (max m n + 1) (k + 1) : (ack_succ_succ _ _).symm + ... ≤ ack (max m n + 2) k : ack_succ_right_le_ack_succ_left _ _ + +theorem ack_add_one_sq_lt_ack_add_four (m n : ℕ) : ack m ((n + 1) ^ 2) < ack (m + 4) n := +calc ack m ((n + 1) ^ 2) + < ack m ((ack m n + 1) ^ 2) : ack_strict_mono_right m $ + pow_lt_pow_of_lt_left (succ_lt_succ $ lt_ack_right m n) zero_lt_two + ... ≤ ack m (ack (m + 3) n) : ack_mono_right m $ ack_add_one_sq_lt_ack_add_three m n + ... ≤ ack (m + 2) (ack (m + 3) n) : ack_mono_left _ $ by linarith + ... = ack (m + 3) (n + 1) : (ack_succ_succ _ n).symm + ... ≤ ack (m + 4) n : ack_succ_right_le_ack_succ_left _ n + +theorem ack_mkpair_lt (m n k : ℕ) : ack m (mkpair n k) < ack (m + 4) (max n k) := +(ack_strict_mono_right m $ mkpair_lt_max_add_one_sq n k).trans $ ack_add_one_sq_lt_ack_add_four _ _ + +/-- If `f` is primitive recursive, there exists `m` such that `f n < ack m n` for all `n`. -/ +theorem exists_lt_ack_of_nat_primrec {f : ℕ → ℕ} (hf : nat.primrec f) : ∃ m, ∀ n, f n < ack m n := +begin + induction hf with f g hf hg IHf IHg f g hf hg IHf IHg f g hf hg IHf IHg, + -- Zero function: + { exact ⟨0, ack_pos 0⟩ }, + -- Successor function: + { refine ⟨1, λ n, _⟩, + rw succ_eq_one_add, + apply add_lt_ack }, + -- Left projection: + { refine ⟨0, λ n, _⟩, + rw [ack_zero, lt_succ_iff], + exact unpair_left_le n }, + -- Right projection: + { refine ⟨0, λ n, _⟩, + rw [ack_zero, lt_succ_iff], + exact unpair_right_le n }, + all_goals { cases IHf with a ha, cases IHg with b hb }, + -- Pairing: + { refine ⟨max a b + 3, λ n, (mkpair_lt_max_add_one_sq _ _).trans_le $ + (nat.pow_le_pow_of_le_left (add_le_add_right _ _) 2).trans $ + ack_add_one_sq_lt_ack_add_three _ _⟩, + rw max_ack_left, + exact max_le_max (ha n).le (hb n).le }, + -- Composition: + { exact ⟨max a b + 2, λ n, + (ha _).trans $ (ack_strict_mono_right a $ hb n).trans $ ack_ack_lt_ack_max_add_two a b n⟩ }, + -- Primitive recursion operator: + { -- We prove this simpler inequality first. + have : ∀ {m n}, elim (f m) (λ y IH, g $ mkpair m $ mkpair y IH) n < ack (max a b + 9) (m + n), + { intros m n, + -- We induct on n. + induction n with n IH, + -- The base case is easy. + { apply (ha m).trans (ack_strict_mono_left m $ (le_max_left a b).trans_lt _), + linarith }, + { -- We get rid of the first `mkpair`. + rw elim_succ, + apply (hb _).trans ((ack_mkpair_lt _ _ _).trans_le _), + -- If m is the maximum, we get a very weak inequality. + cases lt_or_le _ m with h₁ h₁, + { rw max_eq_left h₁.le, + exact ack_le_ack (add_le_add (le_max_right a b) $ by norm_num) (self_le_add_right m _) }, + rw max_eq_right h₁, + -- We get rid of the second `mkpair`. + apply (ack_mkpair_lt _ _ _).le.trans, + -- If n is the maximum, we get a very weak inequality. + cases lt_or_le _ n with h₂ h₂, + { rw [max_eq_left h₂.le, add_assoc], + exact ack_le_ack (add_le_add (le_max_right a b) $ by norm_num) + ((le_succ n).trans $ self_le_add_left _ _) }, + rw max_eq_right h₂, + -- We now use the inductive hypothesis, and some simple algebraic manipulation. + apply (ack_strict_mono_right _ IH).le.trans, + rw [add_succ m, add_succ _ 8, ack_succ_succ (_ + 8), add_assoc], + exact ack_mono_left _ (add_le_add (le_max_right a b) le_rfl) } }, + -- The proof is now simple. + exact ⟨max a b + 9, λ n, this.trans_le $ ack_mono_right _ $ unpair_add_le n⟩ } +end + +theorem not_nat_primrec_ack_self : ¬ nat.primrec (λ n, ack n n) := +λ h, by { cases exists_lt_ack_of_nat_primrec h with m hm, exact (hm m).false } + +theorem not_primrec_ack_self : ¬ _root_.primrec (λ n, ack n n) := +by { rw primrec.nat_iff, exact not_nat_primrec_ack_self } + +/-- The Ackermann function is not primitive recursive. -/ +theorem not_primrec₂_ack : ¬ primrec₂ ack := +λ h, not_primrec_ack_self $ h.comp primrec.id primrec.id diff --git a/src/computability/encoding.lean b/src/computability/encoding.lean index d52384f7a2d0a..f161ff7a6237c 100644 --- a/src/computability/encoding.lean +++ b/src/computability/encoding.lean @@ -12,6 +12,9 @@ import tactic.derive_fintype /-! # Encodings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of a (finite) encoding, a map from a type to strings in an alphabet, used in defining computability by Turing machines. It also contains several examples: @@ -194,21 +197,19 @@ lemma encoding.card_le_card_list {α : Type u} (e : encoding.{u v} α) : cardinal.lift.{v} (# α) ≤ cardinal.lift.{u} (# (list e.Γ)) := (cardinal.lift_mk_le').2 ⟨⟨e.encode, e.encode_injective⟩⟩ -lemma encoding.card_le_omega {α : Type u} (e : encoding.{u v} α) [encodable e.Γ] : - (# α) ≤ ω := +lemma encoding.card_le_aleph_0 {α : Type u} (e : encoding.{u v} α) [encodable e.Γ] : #α ≤ ℵ₀ := begin refine cardinal.lift_le.1 (e.card_le_card_list.trans _), - simp only [cardinal.lift_omega, cardinal.lift_le_omega], + simp only [cardinal.lift_aleph_0, cardinal.lift_le_aleph_0], casesI is_empty_or_nonempty e.Γ with h h, - { simp only [cardinal.mk_le_omega], }, - { rw cardinal.mk_list_eq_omega }, + { simp only [cardinal.mk_le_aleph_0] }, + { rw cardinal.mk_list_eq_aleph_0 } end -lemma fin_encoding.card_le_omega {α : Type u} (e : fin_encoding α) : - (# α) ≤ ω := +lemma fin_encoding.card_le_aleph_0 {α : Type u} (e : fin_encoding α) : #α ≤ ℵ₀ := begin haveI : encodable e.Γ := fintype.to_encodable _, - exact e.to_encoding.card_le_omega, + exact e.to_encoding.card_le_aleph_0 end end computability diff --git a/src/computability/epsilon_NFA.lean b/src/computability/epsilon_NFA.lean index d19e5aa731b00..6035d3fa6977d 100644 --- a/src/computability/epsilon_NFA.lean +++ b/src/computability/epsilon_NFA.lean @@ -8,6 +8,10 @@ import computability.NFA /-! # Epsilon Nondeterministic Finite Automata + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of an epsilon Nondeterministic Finite Automaton (`ε_NFA`), a state machine which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular set by evaluating the string over every possible path, also having access to ε-transitons, @@ -17,6 +21,7 @@ supplied for true `ε_NFA`'s. -/ open set +open_locale computability universes u v @@ -116,7 +121,7 @@ end lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts) (hlen : fintype.card (set σ) ≤ list.length x) : ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧ - {a} * language.star {b} * {c} ≤ M.accepts := + {a} * {b}∗ * {c} ≤ M.accepts := begin rw ←to_NFA_correct at hx ⊢, exact M.to_NFA.pumping_lemma hx hlen @@ -148,7 +153,7 @@ begin rw [eval_from, ε_NFA.eval_from, to_ε_NFA_ε_closure], congr, ext S s, - simp only [step_set, ε_NFA.step_set, exists_prop, set.mem_Union, set.bind_def], + simp only [step_set, ε_NFA.step_set, exists_prop, set.mem_Union], apply exists_congr, simp only [and.congr_right_iff], intros t ht, diff --git a/src/computability/halting.lean b/src/computability/halting.lean index 0f0f670810b66..72f98378201bb 100644 --- a/src/computability/halting.lean +++ b/src/computability/halting.lean @@ -8,6 +8,9 @@ import computability.partrec_code /-! # Computability theory and the halting problem +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A universal partial recursive function, Rice's theorem, and the halting problem. ## References @@ -203,12 +206,12 @@ have hC : ∀ f, f ∈ C ↔ eval f ∈ eval '' C, from λ f, ⟨set.mem_image_of_mem _, λ ⟨g, hg, e⟩, (H _ _ e).1 hg⟩, ⟨λ h, or_iff_not_imp_left.2 $ λ C0, set.eq_univ_of_forall $ λ cg, - let ⟨cf, fC⟩ := set.ne_empty_iff_nonempty.1 C0 in + let ⟨cf, fC⟩ := set.nonempty_iff_ne_empty.2 C0 in (hC _).2 $ rice (eval '' C) (h.of_eq hC) (partrec.nat_iff.1 $ eval_part.comp (const cf) computable.id) (partrec.nat_iff.1 $ eval_part.comp (const cg) computable.id) ((hC _).1 fC), -λ h, by obtain rfl | rfl := h; simp [computable_pred, set.mem_empty_eq]; +λ h, by obtain rfl | rfl := h; simp [computable_pred, set.mem_empty_iff_false]; exact ⟨by apply_instance, computable.const _⟩⟩ theorem halting_problem_re (n) : re_pred (λ c, (eval c n).dom) := diff --git a/src/computability/language.lean b/src/computability/language.lean index 521d7a91ea88f..c1c741e9fc420 100644 --- a/src/computability/language.lean +++ b/src/computability/language.lean @@ -3,12 +3,17 @@ Copyright (c) 2020 Fox Thomson. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Fox Thomson -/ +import algebra.hom.ring +import algebra.order.kleene import data.list.join import data.set.lattice /-! # Languages +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition and operations on formal languages over an alphabet. Note strings are implemented as lists over the alphabet. The operations in this file define a [Kleene algebra](https://en.wikipedia.org/wiki/Kleene_algebra) @@ -16,6 +21,7 @@ over the languages. -/ open list set +open_locale computability universes v @@ -38,7 +44,7 @@ instance : has_one (language α) := ⟨{[]}⟩ instance : inhabited (language α) := ⟨0⟩ /-- The sum of two languages is their union. -/ -instance : has_add (language α) := ⟨set.union⟩ +instance : has_add (language α) := ⟨(∪)⟩ /-- The product of two languages `l` and `m` is the language made of the strings `x ++ y` where `x ∈ l` and `y ∈ m`. -/ @@ -50,23 +56,23 @@ lemma one_def : (1 : language α) = {[]} := rfl lemma add_def (l m : language α) : l + m = l ∪ m := rfl lemma mul_def (l m : language α) : l * m = image2 (++) l m := rfl -/-- The star of a language `L` is the set of all strings which can be written by concatenating - strings from `L`. -/ -def star (l : language α) : language α := -{ x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l} +/-- The Kleene star of a language `L` is the set of all strings which can be written by +concatenating strings from `L`. -/ +instance : has_kstar (language α) := ⟨λ l, {x | ∃ L : list (list α), x = L.join ∧ ∀ y ∈ L, y ∈ l}⟩ + +lemma kstar_def (l : language α) : l∗ = {x | ∃ L : list (list α), x = L.join ∧ ∀ y ∈ L, y ∈ l} := +rfl -lemma star_def (l : language α) : - l.star = { x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l} := rfl @[simp] lemma not_mem_zero (x : list α) : x ∉ (0 : language α) := id @[simp] lemma mem_one (x : list α) : x ∈ (1 : language α) ↔ x = [] := by refl lemma nil_mem_one : [] ∈ (1 : language α) := set.mem_singleton _ -@[simp] lemma mem_add (l m : language α) (x : list α) : x ∈ l + m ↔ x ∈ l ∨ x ∈ m := iff.rfl +lemma mem_add (l m : language α) (x : list α) : x ∈ l + m ↔ x ∈ l ∨ x ∈ m := iff.rfl lemma mem_mul : x ∈ l * m ↔ ∃ a b, a ∈ l ∧ b ∈ m ∧ a ++ b = x := mem_image2 lemma append_mem_mul : a ∈ l → b ∈ m → a ++ b ∈ l * m := mem_image2_of_mem -lemma mem_star : x ∈ l.star ↔ ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l := iff.rfl -lemma join_mem_star {S : list (list α)} (h : ∀ y ∈ S, y ∈ l) : S.join ∈ l.star := ⟨S, rfl, h⟩ -lemma nil_mem_star (l : language α) : [] ∈ l.star := ⟨[], rfl, λ _, false.elim⟩ +lemma mem_kstar : x ∈ l∗ ↔ ∃ L : list (list α), x = L.join ∧ ∀ y ∈ L, y ∈ l := iff.rfl +lemma join_mem_kstar {L : list (list α)} (h : ∀ y ∈ L, y ∈ l) : L.join ∈ l∗ := ⟨L, rfl, h⟩ +lemma nil_mem_kstar (l : language α) : [] ∈ l∗ := ⟨[], rfl, λ _, false.elim⟩ instance : semiring (language α) := { add := (+), @@ -82,6 +88,9 @@ instance : semiring (language α) := one := 1, one_mul := λ l, by simp [mul_def, one_def], mul_one := λ l, by simp [mul_def, one_def], + nat_cast := λ n, if n = 0 then 0 else 1, + nat_cast_zero := rfl, + nat_cast_succ := λ n, by cases n; simp [nat.cast, add_def, zero_def], left_distrib := λ _ _ _, image2_union_right, right_distrib := λ _ _ _, image2_union_left } @@ -99,8 +108,8 @@ def map (f : α → β) : language α →+* language β := @[simp] lemma map_map (g : β → γ) (f : α → β) (l : language α) : map g (map f l) = map (g ∘ f) l := by simp [map, image_image] -lemma star_def_nonempty (l : language α) : - l.star = {x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l ∧ y ≠ []} := +lemma kstar_def_nonempty (l : language α) : + l∗ = {x | ∃ S : list (list α), x = S.join ∧ ∀ y ∈ S, y ∈ l ∧ y ≠ []} := begin ext x, split, @@ -158,56 +167,54 @@ begin exact ⟨a, _, hS.1, ⟨S, rfl, rfl, hS.2⟩, rfl⟩ } } end -lemma star_eq_supr_pow (l : language α) : l.star = ⨆ i : ℕ, l ^ i := +lemma kstar_eq_supr_pow (l : language α) : l∗ = ⨆ i : ℕ, l ^ i := begin ext x, - simp only [mem_star, mem_supr, mem_pow], + simp only [mem_kstar, mem_supr, mem_pow], split, { rintro ⟨S, rfl, hS⟩, exact ⟨_, S, rfl, rfl, hS⟩ }, { rintro ⟨_, S, rfl, rfl, hS⟩, exact ⟨S, rfl, hS⟩ } end -@[simp] lemma map_star (f : α → β) (l : language α) : map f (star l) = star (map f l) := +@[simp] lemma map_kstar (f : α → β) (l : language α) : map f l∗ = (map f l)∗ := begin - rw [star_eq_supr_pow, star_eq_supr_pow], + rw [kstar_eq_supr_pow, kstar_eq_supr_pow], simp_rw ←map_pow, exact image_Union, end -lemma mul_self_star_comm (l : language α) : l.star * l = l * l.star := -by simp only [star_eq_supr_pow, mul_supr, supr_mul, ← pow_succ, ← pow_succ'] +lemma mul_self_kstar_comm (l : language α) : l∗ * l = l * l∗ := +by simp only [kstar_eq_supr_pow, mul_supr, supr_mul, ← pow_succ, ← pow_succ'] -@[simp] lemma one_add_self_mul_star_eq_star (l : language α) : 1 + l * l.star = l.star := +@[simp] lemma one_add_self_mul_kstar_eq_kstar (l : language α) : 1 + l * l∗ = l∗ := begin - simp only [star_eq_supr_pow, mul_supr, ← pow_succ, ← pow_zero l], + simp only [kstar_eq_supr_pow, mul_supr, ← pow_succ, ← pow_zero l], exact sup_supr_nat_succ _ end -@[simp] lemma one_add_star_mul_self_eq_star (l : language α) : 1 + l.star * l = l.star := -by rw [mul_self_star_comm, one_add_self_mul_star_eq_star] - -lemma star_mul_le_right_of_mul_le_right (l m : language α) : l * m ≤ m → l.star * m ≤ m := -begin - intro h, - rw [star_eq_supr_pow, supr_mul], - refine supr_le _, - intro n, - induction n with n ih, - { simp }, - rw [pow_succ', mul_assoc (l^n) l m], - exact le_trans (le_mul_congr le_rfl h) ih, -end - -lemma star_mul_le_left_of_mul_le_left (l m : language α) : m * l ≤ m → m * l.star ≤ m := -begin - intro h, - rw [star_eq_supr_pow, mul_supr], - refine supr_le _, - intro n, - induction n with n ih, - { simp }, - rw [pow_succ, ←mul_assoc m l (l^n)], - exact le_trans (le_mul_congr h le_rfl) ih -end +@[simp] lemma one_add_kstar_mul_self_eq_kstar (l : language α) : 1 + l∗ * l = l∗ := +by rw [mul_self_kstar_comm, one_add_self_mul_kstar_eq_kstar] + +instance : kleene_algebra (language α) := +{ one_le_kstar := λ a l hl, ⟨[], hl, by simp⟩, + mul_kstar_le_kstar := λ a, (one_add_self_mul_kstar_eq_kstar a).le.trans' le_sup_right, + kstar_mul_le_kstar := λ a, (one_add_kstar_mul_self_eq_kstar a).le.trans' le_sup_right, + kstar_mul_le_self := λ l m h, begin + rw [kstar_eq_supr_pow, supr_mul], + refine supr_le (λ n, _), + induction n with n ih, + { simp }, + rw [pow_succ', mul_assoc (l^n) l m], + exact le_trans (le_mul_congr le_rfl h) ih, + end, + mul_kstar_le_self := λ l m h, begin + rw [kstar_eq_supr_pow, mul_supr], + refine supr_le (λ n, _), + induction n with n ih, + { simp }, + rw [pow_succ, ←mul_assoc m l (l^n)], + exact le_trans (le_mul_congr h le_rfl) ih, + end, + ..language.semiring, ..set.complete_boolean_algebra, ..language.has_kstar } end language diff --git a/src/computability/partrec.lean b/src/computability/partrec.lean index f8124d3ee4546..67532caaa84e7 100644 --- a/src/computability/partrec.lean +++ b/src/computability/partrec.lean @@ -10,6 +10,9 @@ import data.pfun /-! # The partial recursive functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The partial recursive functions are defined similarly to the primitive recursive functions, but now all functions are partial, implemented using the `part` monad, and there is an additional operation, called diff --git a/src/computability/partrec_code.lean b/src/computability/partrec_code.lean index 71d8e9d285f3a..bd552ff740022 100644 --- a/src/computability/partrec_code.lean +++ b/src/computability/partrec_code.lean @@ -8,6 +8,9 @@ import computability.partrec /-! # Gödel Numbering for Partial Recursive Functions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `nat.partrec.code`, an inductive datatype describing code for partial recursive functions on ℕ. It defines an encoding for these codes, and proves that the constructors are primitive recursive with respect to the encoding. @@ -738,8 +741,8 @@ end theorem evaln_complete {c n x} : x ∈ eval c n ↔ ∃ k, x ∈ evaln k c n := ⟨λ h, begin - suffices : ∃ k, x ∈ evaln (k+1) c n, - { exact let ⟨k, h⟩ := this in ⟨k+1, h⟩ }, + rsuffices ⟨k, h⟩ : ∃ k, x ∈ evaln (k+1) c n, + { exact ⟨k + 1, h⟩ }, induction c generalizing n x; simp [eval, evaln, pure, pfun.pure, (<*>), (>>)] at h ⊢, iterate 4 { exact ⟨⟨_, le_rfl⟩, h.symm⟩ }, diff --git a/src/computability/primrec.lean b/src/computability/primrec.lean index 7ca8bfeb0e10d..98f60dbe6fa77 100644 --- a/src/computability/primrec.lean +++ b/src/computability/primrec.lean @@ -3,13 +3,16 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.list.join +import logic.equiv.array import logic.equiv.list import logic.function.iterate /-! # The primitive recursive functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The primitive recursive functions are the least collection of functions `nat → nat` which are closed under projections (using the mkpair pairing function), composition, zero, successor, and primitive recursion @@ -31,17 +34,20 @@ open denumerable encodable function namespace nat +/-- The non-dependent recursor on naturals. -/ def elim {C : Sort*} : C → (ℕ → C → C) → ℕ → C := @nat.rec (λ _, C) @[simp] theorem elim_zero {C} (a f) : @nat.elim C a f 0 = a := rfl @[simp] theorem elim_succ {C} (a f n) : @nat.elim C a f (succ n) = f n (nat.elim a f n) := rfl +/-- Cases on whether the input is 0 or a successor. -/ def cases {C : Sort*} (a : C) (f : ℕ → C) : ℕ → C := nat.elim a (λ n _, f n) @[simp] theorem cases_zero {C} (a f) : @nat.cases C a f 0 = a := rfl @[simp] theorem cases_succ {C} (a f n) : @nat.cases C a f (succ n) = f n := rfl +/-- Calls the given function on a pair of entries `n`, encoded via the pairing function. -/ @[simp, reducible] def unpaired {α} (f : ℕ → ℕ → α) (n : ℕ) : α := f n.unpair.1 n.unpair.2 @@ -72,7 +78,7 @@ theorem prec1 {f} (m : ℕ) (hf : primrec f) : primrec (λ n, n.elim m (λ y IH, f $ mkpair y IH)) := ((prec (const m) (hf.comp right)).comp (zero.pair primrec.id)).of_eq $ -λ n, by simp; dsimp; rw [unpair_mkpair] +λ n, by simp theorem cases1 {f} (m : ℕ) (hf : primrec f) : primrec (nat.cases m f) := (prec1 m (hf.comp left)).of_eq $ by simp [cases] @@ -121,6 +127,7 @@ open nat.primrec @[priority 10] instance of_denumerable (α) [denumerable α] : primcodable α := ⟨succ.of_eq $ by simp⟩ +/-- Builds a `primcodable` instance from an equivalence to a `primcodable` type. -/ def of_equiv (α) {β} [primcodable α] (e : β ≃ α) : primcodable β := { prim := (primcodable.prim α).of_eq $ λ n, show encode (decode α n) = @@ -577,7 +584,7 @@ theorem nat_le : primrec_rel ((≤) : ℕ → ℕ → Prop) := end theorem nat_min : primrec₂ (@min ℕ _) := ite nat_le fst snd -theorem nat_max : primrec₂ (@max ℕ _) := ite (nat_le.comp primrec.snd primrec.fst) fst snd +theorem nat_max : primrec₂ (@max ℕ _) := ite (nat_le.comp primrec.fst primrec.snd) snd fst theorem dom_bool (f : bool → α) : primrec f := (cond primrec.id (const (f tt)) (const (f ff))).of_eq $ @@ -648,7 +655,7 @@ theorem list_index_of₁ [decidable_eq α] (l : list α) : primrec (λ a, l.index_of a) := list_find_index₁ primrec.eq l theorem dom_fintype [fintype α] (f : α → σ) : primrec f := -let ⟨l, nd, m⟩ := fintype.exists_univ_list α in +let ⟨l, nd, m⟩ := finite.exists_univ_list α in option_some_iff.1 $ begin haveI := decidable_eq_of_encodable α, refine ((list_nth₁ (l.map f)).comp (list_index_of₁ l)).of_eq (λ a, _), @@ -941,8 +948,14 @@ this.to₂.of_eq $ λ l n, begin { apply IH } end +theorem list_nthd (d : α) : primrec₂ (λ l n, list.nthd l n d) := +begin + simp only [list.nthd_eq_get_or_else_nth], + exact option_get_or_else.comp₂ list_nth (const _) +end + theorem list_inth [inhabited α] : primrec₂ (@list.inth α _) := -option_iget.comp₂ list_nth +list_nthd _ theorem list_append : primrec₂ ((++) : list α → list α → list α) := (list_foldr fst snd $ to₂ $ comp (@list_cons α _) snd).to₂.of_eq $ @@ -1012,6 +1025,7 @@ variables {α : Type*} {β : Type*} variables [primcodable α] [primcodable β] open primrec +/-- A subtype of a primitive recursive predicate is `primcodable`. -/ def subtype {p : α → Prop} [decidable_pred p] (hp : primrec_pred p) : primcodable (subtype p) := ⟨have primrec (λ n, (decode α n).bind (λ a, option.guard p a)), @@ -1026,7 +1040,7 @@ def subtype {p : α → Prop} [decidable_pred p] instance fin {n} : primcodable (fin n) := @of_equiv _ _ (subtype $ nat_lt.comp primrec.id (const n)) - (equiv.fin_equiv_subtype _) + fin.equiv_subtype instance vector {n} : primcodable (vector α n) := subtype ((@primrec.eq _ _ nat.decidable_eq).comp list_length (const _)) @@ -1225,7 +1239,8 @@ theorem tail {n f} (hf : @primrec' n f) : @primrec' n.succ (λ v, f v.tail) := (hf.comp _ (λ i, @nth _ i.succ)).of_eq $ λ v, by rw [← of_fn_nth v.tail]; congr; funext i; simp -def vec {n m} (f : vector ℕ n → vector ℕ m) := +/-- A function from vectors to vectors is primitive recursive when all of its projections are. -/ +def vec {n m} (f : vector ℕ n → vector ℕ m) : Prop := ∀ i, primrec' (λ v, (f v).nth i) protected theorem nil {n} : @vec n 0 (λ _, nil) := λ i, i.elim0 diff --git a/src/computability/reduce.lean b/src/computability/reduce.lean index 9eba50837e9f7..513b16f0280b1 100644 --- a/src/computability/reduce.lean +++ b/src/computability/reduce.lean @@ -8,6 +8,9 @@ import computability.halting /-! # Strong reducibility and degrees. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the notions of computable many-one reduction and one-one reduction between sets, and shows that the corresponding degrees form a semilattice. diff --git a/src/computability/regular_expressions.lean b/src/computability/regular_expressions.lean index 41a82cfddd844..d1043d9886779 100644 --- a/src/computability/regular_expressions.lean +++ b/src/computability/regular_expressions.lean @@ -9,6 +9,9 @@ import computability.language /-! # Regular Expressions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the formal definition for regular expressions and basic lemmas. Note these are regular expressions in terms of formal language theory. Note this is different to regex's used in computer science such as the POSIX standard. @@ -20,6 +23,7 @@ computer science such as the POSIX standard. -/ open list set +open_locale computability universe u @@ -52,6 +56,7 @@ instance : has_add (regular_expression α) := ⟨plus⟩ instance : has_mul (regular_expression α) := ⟨comp⟩ instance : has_one (regular_expression α) := ⟨epsilon⟩ instance : has_zero (regular_expression α) := ⟨zero⟩ +instance : has_pow (regular_expression α) ℕ := ⟨λ n r, npow_rec r n⟩ attribute [pattern] has_mul.mul @@ -68,7 +73,7 @@ attribute [pattern] has_mul.mul | (char a) := {[a]} | (P + Q) := P.matches + Q.matches | (P * Q) := P.matches * Q.matches -| (star P) := P.matches.star +| (star P) := P.matches∗ @[simp] lemma matches_zero : (0 : regular_expression α).matches = 0 := rfl @[simp] lemma matches_epsilon : (1 : regular_expression α).matches = 1 := rfl @@ -77,7 +82,11 @@ attribute [pattern] has_mul.mul (P + Q).matches = P.matches + Q.matches := rfl @[simp] lemma matches_mul (P Q : regular_expression α) : (P * Q).matches = P.matches * Q.matches := rfl -@[simp] lemma matches_star (P : regular_expression α) : P.star.matches = P.matches.star := rfl +@[simp] lemma matches_pow (P : regular_expression α) : + ∀ n : ℕ, (P ^ n).matches = P.matches ^ n +| 0 := matches_epsilon +| (n + 1) := (matches_mul _ _).trans $ eq.trans (congr_arg _ (matches_pow n)) (pow_succ _ _).symm +@[simp] lemma matches_star (P : regular_expression α) : P.star.matches = P.matches∗ := rfl /-- `match_epsilon P` is true if and only if `P` matches the empty string -/ def match_epsilon : regular_expression α → bool @@ -294,7 +303,7 @@ begin rw ←ih₂ at hmatch₂, exact ⟨ x, y, hsum.symm, hmatch₁, hmatch₂ ⟩ } }, case star : _ ih - { rw [star_rmatch_iff, language.star_def_nonempty], + { rw [star_rmatch_iff, language.kstar_def_nonempty], split, all_goals { rintro ⟨ S, hx, hS ⟩, @@ -326,6 +335,11 @@ omit dec | (R * S) := map R * map S | (star R) := star (map R) +@[simp] protected lemma map_pow (f : α → β) (P : regular_expression α) : + ∀ n : ℕ, map f (P ^ n) = map f P ^ n +| 0 := rfl +| (n + 1) := (congr_arg ((*) (map f P)) (map_pow n) : _) + @[simp] lemma map_id : ∀ (P : regular_expression α), P.map id = P | 0 := rfl | 1 := rfl @@ -353,7 +367,7 @@ omit dec | (R * S) := by simp only [matches_map, map, matches_mul, map_mul] | (star R) := begin simp_rw [map, matches, matches_map], - rw [language.star_eq_supr_pow, language.star_eq_supr_pow], + rw [language.kstar_eq_supr_pow, language.kstar_eq_supr_pow], simp_rw ←map_pow, exact image_Union.symm, end diff --git a/src/computability/tm_computable.lean b/src/computability/tm_computable.lean index 8a62da32aac3d..45b5ada4d0133 100644 --- a/src/computability/tm_computable.lean +++ b/src/computability/tm_computable.lean @@ -12,6 +12,9 @@ import data.polynomial.eval /-! # Computable functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition of a Turing machine with some finiteness conditions (bundling the definition of TM2 in turing_machine.lean), a definition of when a TM gives a certain output (in a certain time), and the definition of computability (in polytime or any time function) diff --git a/src/computability/tm_to_partrec.lean b/src/computability/tm_to_partrec.lean index aaf1d55083009..267f6b2edda2b 100644 --- a/src/computability/tm_to_partrec.lean +++ b/src/computability/tm_to_partrec.lean @@ -11,6 +11,9 @@ import tactic.derive_fintype /-! # Modelling partial recursive functions using Turing machines +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a simplified basis for partial recursive functions, and a `turing.TM2` model Turing machine for evaluating these functions. This amounts to a constructive proof that every `partrec` function can be evaluated by a Turing machine. @@ -186,9 +189,9 @@ theorem exists_code.comp {m n} {f : vector ℕ n →. ℕ} {g : fin n → vector (hg : ∀ i, ∃ c : code, ∀ v : vector ℕ m, c.eval v.1 = pure <$> g i v) : ∃ c : code, ∀ v : vector ℕ m, c.eval v.1 = pure <$> (vector.m_of_fn (λ i, g i v) >>= f) := begin - suffices : ∃ c : code, ∀ v : vector ℕ m, + rsuffices ⟨cg, hg⟩ : ∃ c : code, ∀ v : vector ℕ m, c.eval v.1 = subtype.val <$> vector.m_of_fn (λ i, g i v), - { obtain ⟨cf, hf⟩ := hf, obtain ⟨cg, hg⟩ := this, + { obtain ⟨cf, hf⟩ := hf, exact ⟨cf.comp cg, λ v, by { simp [hg, hf, map_bind, seq_bind_eq, (∘), -subtype.val_eq_coe], refl }⟩ }, clear hf f, induction n with n IH, @@ -782,6 +785,7 @@ open TM2.stmt /-- A predicate that detects the end of a natural number, either `Γ'.cons` or `Γ'.Cons` (or implicitly the end of the list), for use in predicate-taking functions like `move` and `clear`. -/ +@[simp] def nat_end : Γ' → bool | Γ'.Cons := tt | Γ'.cons := tt @@ -923,7 +927,8 @@ binary natural numbers. (We could also use `nat.binary_rec_on`, but `num` and `p easy inductions.) -/ def tr_nat (n : ℕ) : list Γ' := tr_num n -@[simp] theorem tr_nat_zero : tr_nat 0 = [] := rfl +@[simp] theorem tr_nat_zero : tr_nat 0 = [] := by rw [tr_nat, nat.cast_zero]; refl +@[simp] theorem tr_nat_default : tr_nat default = [] := tr_nat_zero /-- Lists are translated with a `cons` after each encoded number. For example: @@ -1005,7 +1010,7 @@ def split_at_pred {α} (p : α → bool) : list α → list α × option α × l theorem split_at_pred_eq {α} (p : α → bool) : ∀ L l₁ o l₂, (∀ x ∈ l₁, p x = ff) → - option.elim o (L = l₁ ∧ l₂ = []) (λ a, p a = tt ∧ L = l₁ ++ a :: l₂) → + option.elim (L = l₁ ∧ l₂ = []) (λ a, p a = tt ∧ L = l₁ ++ a :: l₂) o → split_at_pred p L = (l₁, o, l₂) | [] _ none _ _ ⟨rfl, rfl⟩ := rfl | [] l₁ (some o) l₂ h₁ ⟨h₂, h₃⟩ := by simp at h₃; contradiction @@ -1137,7 +1142,7 @@ begin refine (move_ok dec_trivial (split_at_pred_eq _ _ (tr_nat L.head) o (tr_list L.tail) (tr_nat_nat_end _) _)).trans (trans_gen.head rfl (trans_gen.head rfl _)), - { cases L; exact ⟨rfl, rfl⟩ }, + { cases L; simp }, simp, rw if_neg (show o ≠ some Γ'.Cons, by cases L; rintro ⟨⟩), refine (clear_ok (split_at_pred_eq _ _ _ none [] _ ⟨rfl, rfl⟩)).trans _, @@ -1202,7 +1207,7 @@ theorem pred_ok (q₁ q₂ s v) (c d : list Γ') : begin rcases v with _|⟨_|n, v⟩, { refine ⟨none, trans_gen.single _⟩, simp, refl }, - { refine ⟨some Γ'.cons, trans_gen.single _⟩, simp, refl }, + { refine ⟨some Γ'.cons, trans_gen.single _⟩, simp }, refine ⟨none, _⟩, simp [tr_nat, num.add_one, num.succ, tr_num], cases (n:num) with a, { simp [tr_pos_num, tr_num, show num.zero.succ' = pos_num.one, from rfl], @@ -1217,7 +1222,7 @@ begin refine h.trans _, convert unrev_ok using 2, simp [e, list.reverse_core_eq] }, induction a with m IH m IH generalizing s; intro l₁, { refine ⟨Γ'.bit1 :: l₁, [], some Γ'.cons, rfl, trans_gen.head rfl (trans_gen.single _)⟩, - simp [tr_pos_num, show pos_num.one.succ = pos_num.one.bit0, from rfl], refl }, + simp [tr_pos_num, show pos_num.one.succ = pos_num.one.bit0, from rfl] }, { obtain ⟨l₁', l₂', s', e, h⟩ := IH (some Γ'.bit0) (Γ'.bit1 :: l₁), refine ⟨l₁', l₂', s', e, trans_gen.head _ h⟩, simp, refl }, { obtain ⟨a, l, e, h⟩ : ∃ a l, tr_pos_num m = a :: l ∧ nat_end a = ff, @@ -1238,7 +1243,7 @@ begin { let o : option Γ' := list.cases_on v none (λ _ _, some Γ'.cons), refine ⟨_, ⟨o, rfl⟩, _⟩, convert clear_ok _, simp, swap, refine split_at_pred_eq _ _ (tr_nat v.head) _ _ (tr_nat_nat_end _) _, - cases v; exact ⟨rfl, rfl⟩ }, + cases v; simp }, case cons : f fs IHf IHfs { obtain ⟨c, h₁, h₂⟩ := IHf (cont.cons₁ fs v k) v none, refine ⟨c, h₁, trans_gen.head rfl $ (move_ok dec_trivial (split_at_pred_ff _)).trans _⟩, @@ -1283,7 +1288,7 @@ begin then nat_end (tr_list v).head'.iget = tt ∧ (tr_list v).tail = tr_list v.tail else nat_end (tr_list v).head'.iget = ff ∧ (tr_list v).tail = (tr_nat v.head).tail ++ Γ'.cons :: tr_list v.tail, - { cases v with n, {exact ⟨rfl, rfl⟩}, cases n, {exact ⟨rfl, rfl⟩}, + { cases v with n, {exact ⟨rfl, rfl⟩}, cases n, {simp}, rw [tr_list, list.head, tr_nat, nat.cast_succ, num.add_one, num.succ, list.tail], cases (n:num).succ'; exact ⟨rfl, rfl⟩ }, by_cases v.head = 0; simp [h] at this ⊢, diff --git a/src/computability/turing_machine.lean b/src/computability/turing_machine.lean index 05d26c6f167ef..e8a283b317b00 100644 --- a/src/computability/turing_machine.lean +++ b/src/computability/turing_machine.lean @@ -3,7 +3,10 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.fintype.basic +import data.fintype.option +import data.fintype.prod +import data.fintype.pi +import data.vector.basic import data.pfun import logic.function.iterate import order.basic @@ -12,6 +15,9 @@ import tactic.apply_fun /-! # Turing machines +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a sequence of simple machine languages, starting with Turing machines and working up to more complex languages based on Wang B-machines. @@ -64,22 +70,22 @@ namespace turing /-- The `blank_extends` partial order holds of `l₁` and `l₂` if `l₂` is obtained by adding blanks (`default : Γ`) to the end of `l₁`. -/ def blank_extends {Γ} [inhabited Γ] (l₁ l₂ : list Γ) : Prop := -∃ n, l₂ = l₁ ++ list.repeat default n +∃ n, l₂ = l₁ ++ list.replicate n default @[refl] theorem blank_extends.refl {Γ} [inhabited Γ] (l : list Γ) : blank_extends l l := ⟨0, by simp⟩ @[trans] theorem blank_extends.trans {Γ} [inhabited Γ] {l₁ l₂ l₃ : list Γ} : blank_extends l₁ l₂ → blank_extends l₂ l₃ → blank_extends l₁ l₃ := -by { rintro ⟨i, rfl⟩ ⟨j, rfl⟩, exact ⟨i+j, by simp [list.repeat_add]⟩ } +by { rintro ⟨i, rfl⟩ ⟨j, rfl⟩, exact ⟨i+j, by simp [list.replicate_add]⟩ } theorem blank_extends.below_of_le {Γ} [inhabited Γ] {l l₁ l₂ : list Γ} : blank_extends l l₁ → blank_extends l l₂ → l₁.length ≤ l₂.length → blank_extends l₁ l₂ := begin rintro ⟨i, rfl⟩ ⟨j, rfl⟩ h, use j - i, - simp only [list.length_append, add_le_add_iff_left, list.length_repeat] at h, - simp only [← list.repeat_add, add_tsub_cancel_of_le h, list.append_assoc], + simp only [list.length_append, add_le_add_iff_left, list.length_replicate] at h, + simp only [← list.replicate_add, add_tsub_cancel_of_le h, list.append_assoc], end /-- Any two extensions by blank `l₁,l₂` of `l` have a common join (which can be taken to be the @@ -98,9 +104,9 @@ theorem blank_extends.above_of_le {Γ} [inhabited Γ] {l l₁ l₂ : list Γ} : begin rintro ⟨i, rfl⟩ ⟨j, e⟩ h, use i - j, refine list.append_right_cancel (e.symm.trans _), - rw [list.append_assoc, ← list.repeat_add, tsub_add_cancel_of_le], + rw [list.append_assoc, ← list.replicate_add, tsub_add_cancel_of_le], apply_fun list.length at e, - simp only [list.length_append, list.length_repeat] at e, + simp only [list.length_append, list.length_replicate] at e, rwa [← add_le_add_iff_left, e, add_le_add_iff_right] end @@ -238,11 +244,11 @@ theorem list_blank.exists_cons {Γ} [inhabited Γ] (l : list_blank Γ) : def list_blank.nth {Γ} [inhabited Γ] (l : list_blank Γ) (n : ℕ) : Γ := l.lift_on (λ l, list.inth l n) begin rintro l _ ⟨i, rfl⟩, - simp only [list.inth], - cases lt_or_le _ _ with h h, {rw list.nth_append h}, - rw list.nth_len_le h, - cases le_or_lt _ _ with h₂ h₂, {rw list.nth_len_le h₂}, - rw [list.nth_le_nth h₂, list.nth_le_append_right h, list.nth_le_repeat] + simp only, + cases lt_or_le _ _ with h h, {rw list.inth_append _ _ _ h}, + rw list.inth_eq_default _ h, + cases le_or_lt _ _ with h₂ h₂, {rw list.inth_eq_default _ h₂}, + rw [list.inth_eq_nth_le _ h₂, list.nth_le_append_right h, list.nth_le_replicate] end @[simp] theorem list_blank.nth_mk {Γ} [inhabited Γ] (l : list Γ) (n : ℕ) : @@ -265,17 +271,18 @@ end (∀ i, L₁.nth i = L₂.nth i) → L₁ = L₂ := list_blank.induction_on L₁ $ λ l₁, list_blank.induction_on L₂ $ λ l₂ H, begin - wlog h : l₁.length ≤ l₂.length using l₁ l₂, - swap, { exact (this $ λ i, (H i).symm).symm }, + wlog h : l₁.length ≤ l₂.length, + { cases le_total l₁.length l₂.length; [skip, symmetry]; apply_assumption; try {assumption}, + intro, rw H }, refine quotient.sound' (or.inl ⟨l₂.length - l₁.length, _⟩), refine list.ext_le _ (λ i h h₂, eq.symm _), - { simp only [add_tsub_cancel_of_le h, list.length_append, list.length_repeat] }, - simp at H, + { simp only [add_tsub_cancel_of_le h, list.length_append, list.length_replicate] }, + simp only [list_blank.nth_mk] at H, cases lt_or_le i l₁.length with h' h', - { simpa only [list.nth_le_append _ h', - list.nth_le_nth h, list.nth_le_nth h', option.iget] using H i }, - { simpa only [list.nth_le_append_right h', list.nth_le_repeat, - list.nth_le_nth h, list.nth_len_le h', option.iget] using H i }, + { simp only [list.nth_le_append _ h', list.nth_le_nth h, list.nth_le_nth h', + ←list.inth_eq_nth_le _ h, ←list.inth_eq_nth_le _ h', H] }, + { simp only [list.nth_le_append_right h', list.nth_le_replicate, list.nth_le_nth h, + list.nth_len_le h', ←list.inth_eq_default _ h', H, list.inth_eq_nth_le _ h] } end /-- Apply a function to a value stored at the nth position of the list. -/ @@ -302,7 +309,7 @@ structure {u v} pointed_map (Γ : Type u) (Γ' : Type v) (f : Γ → Γ') (map_pt' : f default = default) instance {Γ Γ'} [inhabited Γ] [inhabited Γ'] : inhabited (pointed_map Γ Γ') := -⟨⟨λ _, default, rfl⟩⟩ +⟨⟨default, rfl⟩⟩ instance {Γ Γ'} [inhabited Γ] [inhabited Γ'] : has_coe_to_fun (pointed_map Γ Γ') (λ _, Γ → Γ') := ⟨pointed_map.f⟩ @@ -323,7 +330,7 @@ def list_blank.map {Γ Γ'} [inhabited Γ] [inhabited Γ'] (f : pointed_map Γ Γ') (l : list_blank Γ) : list_blank Γ' := l.lift_on (λ l, list_blank.mk (list.map f l)) begin rintro l _ ⟨i, rfl⟩, refine quotient.sound' (or.inl ⟨i, _⟩), - simp only [pointed_map.map_pt, list.map_append, list.map_repeat], + simp only [pointed_map.map_pt, list.map_append, list.map_replicate], end @[simp] theorem list_blank.map_mk {Γ Γ'} [inhabited Γ] [inhabited Γ'] @@ -353,7 +360,7 @@ end @[simp] theorem list_blank.nth_map {Γ Γ'} [inhabited Γ] [inhabited Γ'] (f : pointed_map Γ Γ') (l : list_blank Γ) (n : ℕ) : (l.map f).nth n = f (l.nth n) := l.induction_on begin - intro l, simp only [list.nth_map, list_blank.map_mk, list_blank.nth_mk, list.inth], + intro l, simp only [list.nth_map, list_blank.map_mk, list_blank.nth_mk, list.inth_eq_iget_nth], cases l.nth n, {exact f.2.symm}, {refl} end @@ -390,12 +397,12 @@ l₃.induction_on $ by intro; simp only [list_blank.append_mk, list.append_assoc is sent to a sequence of default elements. -/ def list_blank.bind {Γ Γ'} [inhabited Γ] [inhabited Γ'] (l : list_blank Γ) (f : Γ → list Γ') - (hf : ∃ n, f default = list.repeat default n) : list_blank Γ' := + (hf : ∃ n, f default = list.replicate n default) : list_blank Γ' := l.lift_on (λ l, list_blank.mk (list.bind l f)) begin rintro l _ ⟨i, rfl⟩, cases hf with n e, refine quotient.sound' (or.inl ⟨i * n, _⟩), rw [list.bind_append, mul_comm], congr, induction i with i IH, refl, - simp only [IH, e, list.repeat_add, nat.mul_succ, add_comm, list.repeat_succ, list.cons_bind], + simp only [IH, e, list.replicate_add, nat.mul_succ, add_comm, list.replicate_succ, list.cons_bind] end @[simp] lemma list_blank.bind_mk {Γ Γ'} [inhabited Γ] [inhabited Γ'] @@ -1284,8 +1291,7 @@ end variables [fintype σ] /-- Given a finite set of accessible `Λ` machine states, there is a finite set of accessible machine states in the target (even though the type `Λ'` is infinite). -/ -noncomputable def tr_stmts (S : finset Λ) : finset Λ' := -(TM1.stmts M S).product finset.univ +noncomputable def tr_stmts (S : finset Λ) : finset Λ' := TM1.stmts M S ×ˢ finset.univ open_locale classical local attribute [simp] TM1.stmts₁_self @@ -1363,7 +1369,7 @@ parameters {Γ : Type*} [inhabited Γ] theorem exists_enc_dec [fintype Γ] : ∃ n (enc : Γ → vector bool n) (dec : vector bool n → Γ), - enc default = vector.repeat ff n ∧ ∀ a, dec (enc a) = a := + enc default = vector.replicate n ff ∧ ∀ a, dec (enc a) = a := begin letI := classical.dec_eq Γ, let n := fintype.card Γ, @@ -1373,7 +1379,7 @@ begin let H := (F.to_embedding.trans G).trans (equiv.vector_equiv_fin _ _).symm.to_embedding, classical, - let enc := H.set_value default (vector.repeat ff n), + let enc := H.set_value default (vector.replicate n ff), exact ⟨_, enc, function.inv_fun enc, H.set_value_eq _ _, function.left_inverse_inv_fun enc.2⟩ end @@ -1455,7 +1461,7 @@ from λ f hf, this n _ (by intro; simp only [supports_stmt_move, hf]), split; apply IH; intro; apply hf, end -parameter (enc0 : enc default = vector.repeat ff n) +parameter (enc0 : enc default = vector.replicate n ff) section parameter {enc} @@ -1467,8 +1473,8 @@ begin refine tape.mk' (L.bind (λ x, (enc x).to_list.reverse) ⟨n, _⟩) (R.bind (λ x, (enc x).to_list) ⟨n, _⟩); - simp only [enc0, vector.repeat, - list.reverse_repeat, bool.default_bool, vector.to_list_mk] + simp only [enc0, vector.replicate, + list.reverse_replicate, bool.default_bool, vector.to_list_mk] end /-- The low level tape corresponding to the given tape over alphabet `Γ`. -/ @@ -2002,7 +2008,7 @@ theorem stk_nth_val {K : Type*} {Γ : K → Type*} {L : list_blank (∀ k, optio (hL : list_blank.map (proj k) L = list_blank.mk (list.map some S).reverse) : L.nth n k = S.reverse.nth n := begin - rw [← proj_map_nth, hL, ← list.map_reverse, list_blank.nth_mk, list.inth, list.nth_map], + rw [←proj_map_nth, hL, ←list.map_reverse, list_blank.nth_mk, list.inth_eq_iget_nth, list.nth_map], cases S.reverse.nth n; refl end @@ -2207,15 +2213,15 @@ begin rw [list_blank.nth_map, list_blank.nth_modify_nth, proj, pointed_map.mk_val], by_cases h' : k' = k, { subst k', split_ifs; simp only [list.reverse_cons, - function.update_same, list_blank.nth_mk, list.inth, list.map], - { rw [list.nth_le_nth, list.nth_le_append_right]; + function.update_same, list_blank.nth_mk, list.map], + { rw [list.inth_eq_nth_le, list.nth_le_append_right]; simp only [h, list.nth_le_singleton, list.length_map, list.length_reverse, nat.succ_pos', list.length_append, lt_add_iff_pos_right, list.length] }, - rw [← proj_map_nth, hL, list_blank.nth_mk, list.inth], + rw [← proj_map_nth, hL, list_blank.nth_mk], cases lt_or_gt_of_ne h with h h, - { rw list.nth_append, simpa only [list.length_map, list.length_reverse] using h }, + { rw list.inth_append, simpa only [list.length_map, list.length_reverse] using h }, { rw gt_iff_lt at h, - rw [list.nth_len_le, list.nth_len_le]; + rw [list.inth_eq_default, list.inth_eq_default]; simp only [nat.add_one_le_iff, h, list.length, le_of_lt, list.length_reverse, list.length_append, list.length_map] } }, { split_ifs; rw [function.update_noteq h', ← proj_map_nth, hL], @@ -2245,12 +2251,12 @@ begin rw [list_blank.nth_map, list_blank.nth_modify_nth, proj, pointed_map.mk_val], by_cases h' : k' = k, { subst k', split_ifs; simp only [ - function.update_same, list_blank.nth_mk, list.tail, list.inth], - { rw [list.nth_len_le], {refl}, rw [h, list.length_reverse, list.length_map] }, - rw [← proj_map_nth, hL, list_blank.nth_mk, list.inth, e, list.map, list.reverse_cons], + function.update_same, list_blank.nth_mk, list.tail], + { rw [list.inth_eq_default], {refl}, rw [h, list.length_reverse, list.length_map] }, + rw [← proj_map_nth, hL, list_blank.nth_mk, e, list.map, list.reverse_cons], cases lt_or_gt_of_ne h with h h, - { rw list.nth_append, simpa only [list.length_map, list.length_reverse] using h }, - { rw gt_iff_lt at h, rw [list.nth_len_le, list.nth_len_le]; + { rw list.inth_append, simpa only [list.length_map, list.length_reverse] using h }, + { rw gt_iff_lt at h, rw [list.inth_eq_default, list.inth_eq_default]; simp only [nat.add_one_le_iff, h, list.length, le_of_lt, list.length_reverse, list.length_append, list.length_map] } }, { split_ifs; rw [function.update_noteq h', ← proj_map_nth, hL], @@ -2335,8 +2341,8 @@ theorem tr_respects : respects (TM2.step M) (TM1.step tr) tr_cfg := cases h with l v S L hT, clear h, cases l, {constructor}, simp only [TM2.step, respects, option.map_some'], - suffices : ∃ b, _ ∧ reaches (TM1.step (tr M)) _ _, - from let ⟨b, c, r⟩ := this in ⟨b, c, trans_gen.head' rfl r⟩, + rsuffices ⟨b, c, r⟩ : ∃ b, _ ∧ reaches (TM1.step (tr M)) _ _, + { exact ⟨b, c, trans_gen.head' rfl r⟩ }, rw [tr], revert v S L hT, refine stmt_st_rec _ _ _ _ _ (M l); intros, { exact tr_respects_aux M hT s @IH }, @@ -2353,13 +2359,13 @@ begin rw (_ : TM1.init _ = _), { refine ⟨list_blank.mk (L.reverse.map $ λ a, update default k (some a)), λ k', _⟩, refine list_blank.ext (λ i, _), - rw [list_blank.map_mk, list_blank.nth_mk, list.inth, list.map_map, (∘), + rw [list_blank.map_mk, list_blank.nth_mk, list.inth_eq_iget_nth, list.map_map, (∘), list.nth_map, proj, pointed_map.mk_val], by_cases k' = k, { subst k', simp only [function.update_same], - rw [list_blank.nth_mk, list.inth, ← list.map_reverse, list.nth_map] }, + rw [list_blank.nth_mk, list.inth_eq_iget_nth, ← list.map_reverse, list.nth_map] }, { simp only [function.update_noteq h], - rw [list_blank.nth_mk, list.inth, list.map, list.reverse_nil, list.nth], + rw [list_blank.nth_mk, list.inth_eq_iget_nth, list.map, list.reverse_nil, list.nth], cases L.reverse.nth i; refl } }, { rw [tr_init, TM1.init], dsimp only, congr; cases L.reverse; try {refl}, simp only [list.map_map, list.tail_cons, list.map], refl } @@ -2379,9 +2385,9 @@ theorem tr_eval (k) (L : list (Γ k)) {L₁ L₂} begin obtain ⟨c₁, h₁, rfl⟩ := (part.mem_map_iff _).1 H₁, obtain ⟨c₂, h₂, rfl⟩ := (part.mem_map_iff _).1 H₂, - obtain ⟨_, ⟨q, v, S, L', hT⟩, h₃⟩ := tr_eval (tr_respects M) (tr_cfg_init M k L) h₂, + obtain ⟨_, ⟨L', hT⟩, h₃⟩ := tr_eval (tr_respects M) (tr_cfg_init M k L) h₂, cases part.mem_unique h₁ h₃, - exact ⟨S, L', by simp only [tape.mk'_right₀], hT, rfl⟩ + exact ⟨_, L', by simp only [tape.mk'_right₀], hT, rfl⟩ end /-- The support of a set of TM2 states in the TM2 emulator. -/ diff --git a/src/control/applicative.lean b/src/control/applicative.lean index ffa4df13e1e84..7afdd96e3367f 100644 --- a/src/control/applicative.lean +++ b/src/control/applicative.lean @@ -9,6 +9,9 @@ import control.functor /-! # `applicative` instances +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides `applicative` instances for concrete functors: * `id` * `functor.comp` diff --git a/src/control/basic.lean b/src/control/basic.lean index ebb5951a04034..d5ee38648ff4e 100644 --- a/src/control/basic.lean +++ b/src/control/basic.lean @@ -5,6 +5,7 @@ Authors: Johannes Hölzl Extends the theory on functors, applicatives and monads. -/ +import tactic.mk_simp_attribute universes u v w variables {α β γ : Type u} @@ -14,9 +15,6 @@ notation a ` $< `:1 f:1 := f a section functor variables {f : Type u → Type v} [functor f] [is_lawful_functor f] -run_cmd mk_simp_attr `functor_norm -run_cmd tactic.add_doc_string `simp_attr.functor_norm "Simp set for functor_norm" - @[functor_norm] theorem functor.map_map (m : α → β) (g : β → γ) (x : f α) : g <$> (m <$> x) = (g ∘ m) <$> x := (comp_map _ _ _).symm @@ -85,6 +83,7 @@ lemma seq_bind_eq (x : m α) {g : β → m γ} {f : α → β} : (f <$> x) >>= g show bind (f <$> x) g = bind x (g ∘ f), by rw [← bind_pure_comp_eq_map, bind_assoc]; simp [pure_bind] +@[monad_norm] lemma seq_eq_bind_map {x : m α} {f : m (α → β)} : f <*> x = (f >>= (<$> x)) := (bind_map_eq_seq f x).symm diff --git a/src/control/bifunctor.lean b/src/control/bifunctor.lean index 356eab1bda53a..fae259c06f95a 100644 --- a/src/control/bifunctor.lean +++ b/src/control/bifunctor.lean @@ -9,6 +9,9 @@ import data.sum.basic /-! # Functors with two arguments +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines bifunctors. A bifunctor is a function `F : Type* → Type* → Type*` along with a bimap which turns `F α β` into diff --git a/src/control/bitraversable/basic.lean b/src/control/bitraversable/basic.lean index c91046710290f..2d9b48ea6a9f7 100644 --- a/src/control/bitraversable/basic.lean +++ b/src/control/bitraversable/basic.lean @@ -9,6 +9,9 @@ import control.traversable.basic /-! # Bitraversable type class +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Type class for traversing bifunctors. Simple examples of `bitraversable` are `prod` and `sum`. A more elaborate example is diff --git a/src/control/bitraversable/instances.lean b/src/control/bitraversable/instances.lean index 851bc71c60b8a..1b6bb4da9175d 100644 --- a/src/control/bitraversable/instances.lean +++ b/src/control/bitraversable/instances.lean @@ -9,6 +9,9 @@ import control.traversable.lemmas /-! # Bitraversable instances +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides `bitraversable` instances for concrete bifunctors: * `prod` * `sum` diff --git a/src/control/bitraversable/lemmas.lean b/src/control/bitraversable/lemmas.lean index d668f808be5b0..b2f76e42b630a 100644 --- a/src/control/bitraversable/lemmas.lean +++ b/src/control/bitraversable/lemmas.lean @@ -8,6 +8,9 @@ import control.bitraversable.basic /-! # Bitraversable Lemmas +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * tfst - traverse on first functor argument * tsnd - traverse on second functor argument diff --git a/src/control/equiv_functor.lean b/src/control/equiv_functor.lean index 5305c7e0136e6..b5588efafca50 100644 --- a/src/control/equiv_functor.lean +++ b/src/control/equiv_functor.lean @@ -3,11 +3,14 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import logic.equiv.basic +import logic.equiv.defs /-! # Functions functorial with respect to equivalences +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An `equiv_functor` is a function from `Type → Type` equipped with the additional data of coherently mapping equivalences to equivalences. diff --git a/src/control/equiv_functor/instances.lean b/src/control/equiv_functor/instances.lean index f88b4ca3a9b37..793d7e910ae04 100644 --- a/src/control/equiv_functor/instances.lean +++ b/src/control/equiv_functor/instances.lean @@ -9,6 +9,9 @@ import control.equiv_functor /-! # `equiv_functor` instances +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We derive some `equiv_functor` instances, to enable `equiv_rw` to rewrite under these functions. -/ diff --git a/src/control/fix.lean b/src/control/fix.lean index 839187dc350df..aae0456ab23e6 100644 --- a/src/control/fix.lean +++ b/src/control/fix.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ -import data.stream.init import data.part import data.nat.upto +import data.stream.defs /-! # Fixed point +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines a generic `fix` operator for defining recursive computations that are not necessarily well-founded or productive. An instance is defined for `part`. diff --git a/src/control/fold.lean b/src/control/fold.lean index efb64c4d35c80..487b7193192d2 100644 --- a/src/control/fold.lean +++ b/src/control/fold.lean @@ -3,8 +3,8 @@ Copyright (c) 2018 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon, Sean Leather -/ -import algebra.free_monoid -import algebra.opposites +import algebra.group.opposite +import algebra.free_monoid.basic import control.traversable.instances import control.traversable.lemmas import category_theory.endomorphism @@ -14,6 +14,9 @@ import category_theory.category.Kleisli # List folds generalized to `traversable` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Informally, we can think of `foldl` as a special case of `traverse` where we do not care about the reconstructed data structure and, in a state monad, we care about the final state. @@ -104,24 +107,18 @@ how the monoid of endofunctions define `foldl`. def foldl.mk (f : α → α) : foldl α := op f def foldl.get (x : foldl α) : α → α := unop x @[simps] def foldl.of_free_monoid (f : β → α → β) : free_monoid α →* monoid.foldl β := -{ to_fun := λ xs, op $ flip (list.foldl f) xs, +{ to_fun := λ xs, op $ flip (list.foldl f) xs.to_list, map_one' := rfl, - map_mul' := by intros; simp only [free_monoid.mul_def, flip, unop_op, + map_mul' := by intros; simp only [free_monoid.to_list_mul, flip, unop_op, list.foldl_append, op_inj]; refl } @[reducible] def foldr (α : Type u) : Type u := End α def foldr.mk (f : α → α) : foldr α := f def foldr.get (x : foldr α) : α → α := x @[simps] def foldr.of_free_monoid (f : α → β → β) : free_monoid α →* monoid.foldr β := -{ to_fun := λ xs, flip (list.foldr f) xs, +{ to_fun := λ xs, flip (list.foldr f) xs.to_list, map_one' := rfl, - map_mul' := - begin - intros, - simp only [free_monoid.mul_def, list.foldr_append, flip], - refl - end } - + map_mul' := λ xs ys, funext $ λ z, list.foldr_append _ _ _ _ } @[reducible] def mfoldl (m : Type u → Type u) [monad m] (α : Type u) : Type u := mul_opposite $ End $ Kleisli.mk m α @@ -129,7 +126,7 @@ def mfoldl.mk (f : α → m α) : mfoldl m α := op f def mfoldl.get (x : mfoldl m α) : α → m α := unop x @[simps] def mfoldl.of_free_monoid [is_lawful_monad m] (f : β → α → m β) : free_monoid α →* monoid.mfoldl m β := -{ to_fun := λ xs, op $ flip (list.mfoldl f) xs, +{ to_fun := λ xs, op $ flip (list.mfoldl f) xs.to_list, map_one' := rfl, map_mul' := by intros; apply unop_injective; ext; apply list.mfoldl_append } @@ -139,7 +136,7 @@ def mfoldr.mk (f : α → m α) : mfoldr m α := f def mfoldr.get (x : mfoldr m α) : α → m α := x @[simps] def mfoldr.of_free_monoid [is_lawful_monad m] (f : α → β → m β) : free_monoid α →* monoid.mfoldr m β := -{ to_fun := λ xs, flip (list.mfoldr f) xs, +{ to_fun := λ xs, flip (list.mfoldr f) xs.to_list, map_one' := rfl, map_mul' := by intros; ext; apply list.mfoldr_append } @@ -204,27 +201,18 @@ def map_fold [monoid α] [monoid β] (f : α →* β) : preserves_seq' := by { intros, simp only [f.map_mul, (<*>)], }, preserves_pure' := by { intros, simp only [f.map_one, pure] } } -def free.mk : α → free_monoid α := list.ret - -def free.map (f : α → β) : free_monoid α →* free_monoid β := -{ to_fun := list.map f, - map_mul' := λ x y, - by simp only [free_monoid.mul_def, list.map_append, free_add_monoid.add_def], - map_one' := by simp only [free_monoid.one_def, list.map, free_add_monoid.zero_def] } - lemma free.map_eq_map (f : α → β) (xs : list α) : - f <$> xs = free.map f xs := rfl + f <$> xs = (free_monoid.map f (free_monoid.of_list xs)).to_list := rfl lemma foldl.unop_of_free_monoid (f : β → α → β) (xs : free_monoid α) (a : β) : - unop (foldl.of_free_monoid f xs) a = list.foldl f a xs := rfl + unop (foldl.of_free_monoid f xs) a = list.foldl f a xs.to_list := rfl variables (m : Type u → Type u) [monad m] [is_lawful_monad m] variables {t : Type u → Type u} [traversable t] [is_lawful_traversable t] open is_lawful_traversable -lemma fold_map_hom - [monoid α] [monoid β] (f : α →* β) +lemma fold_map_hom [monoid α] [monoid β] (f : α →* β) (g : γ → α) (x : t γ) : f (fold_map g x) = fold_map (f ∘ g) x := calc f (fold_map g x) @@ -236,19 +224,9 @@ calc f (fold_map g x) lemma fold_map_hom_free [monoid β] (f : free_monoid α →* β) (x : t α) : - f (fold_map free.mk x) = fold_map (f ∘ free.mk) x := + f (fold_map free_monoid.of x) = fold_map (f ∘ free_monoid.of) x := fold_map_hom f _ x -variable {m} - -lemma fold_mfoldl_cons (f : α → β → m α) (x : β) (y : α) : - list.mfoldl f y (free.mk x) = f y x := -by simp only [free.mk, list.ret, list.mfoldl, bind_pure] - -lemma fold_mfoldr_cons (f : β → α → m α) (x : β) (y : α) : - list.mfoldr f y (free.mk x) = f x y := -by simp only [free.mk, list.ret, list.mfoldr, pure_bind] - end applicative_transformation section equalities @@ -257,37 +235,38 @@ variables {α β γ : Type u} variables {t : Type u → Type u} [traversable t] [is_lawful_traversable t] @[simp] -lemma foldl.of_free_monoid_comp_free_mk (f : α → β → α) : - foldl.of_free_monoid f ∘ free.mk = foldl.mk ∘ flip f := rfl +lemma foldl.of_free_monoid_comp_of (f : α → β → α) : + foldl.of_free_monoid f ∘ free_monoid.of = foldl.mk ∘ flip f := rfl @[simp] -lemma foldr.of_free_monoid_comp_free_mk (f : β → α → α) : - foldr.of_free_monoid f ∘ free.mk = foldr.mk ∘ f := rfl +lemma foldr.of_free_monoid_comp_of (f : β → α → α) : + foldr.of_free_monoid f ∘ free_monoid.of = foldr.mk ∘ f := rfl @[simp] -lemma mfoldl.of_free_monoid_comp_free_mk {m} [monad m] [is_lawful_monad m] (f : α → β → m α) : - mfoldl.of_free_monoid f ∘ free.mk = mfoldl.mk ∘ flip f := -by ext; simp [(∘), mfoldl.of_free_monoid, mfoldl.mk, flip, fold_mfoldl_cons]; refl +lemma mfoldl.of_free_monoid_comp_of {m} [monad m] [is_lawful_monad m] (f : α → β → m α) : + mfoldl.of_free_monoid f ∘ free_monoid.of = mfoldl.mk ∘ flip f := +by { ext1 x, simp [(∘), mfoldl.of_free_monoid, mfoldl.mk, flip], refl } @[simp] -lemma mfoldr.of_free_monoid_comp_free_mk {m} [monad m] [is_lawful_monad m] (f : β → α → m α) : - mfoldr.of_free_monoid f ∘ free.mk = mfoldr.mk ∘ f := -by { ext, simp [(∘), mfoldr.of_free_monoid, mfoldr.mk, flip, fold_mfoldr_cons] } +lemma mfoldr.of_free_monoid_comp_of {m} [monad m] [is_lawful_monad m] (f : β → α → m α) : + mfoldr.of_free_monoid f ∘ free_monoid.of = mfoldr.mk ∘ f := +by { ext, simp [(∘), mfoldr.of_free_monoid, mfoldr.mk, flip] } lemma to_list_spec (xs : t α) : - to_list xs = (fold_map free.mk xs : free_monoid _) := + to_list xs = free_monoid.to_list (fold_map free_monoid.of xs) := eq.symm $ -calc fold_map free.mk xs - = (fold_map free.mk xs).reverse.reverse : by simp only [list.reverse_reverse] -... = (list.foldr cons [] (fold_map free.mk xs).reverse).reverse +calc free_monoid.to_list (fold_map free_monoid.of xs) + = free_monoid.to_list (fold_map free_monoid.of xs).reverse.reverse + : by simp only [list.reverse_reverse] +... = free_monoid.to_list (list.foldr cons [] (fold_map free_monoid.of xs).reverse).reverse : by simp only [list.foldr_eta] -... = (unop (foldl.of_free_monoid (flip cons) (fold_map free.mk xs)) []).reverse - : by simp [flip,list.foldr_reverse,foldl.of_free_monoid, unop_op] +... = (unop (foldl.of_free_monoid (flip cons) (fold_map free_monoid.of xs)) []).reverse + : by simp [flip, list.foldr_reverse, foldl.of_free_monoid, unop_op] ... = to_list xs : begin rw fold_map_hom_free (foldl.of_free_monoid (flip $ @cons α)), - simp only [to_list, foldl, list.reverse_inj, foldl.get, - foldl.of_free_monoid_comp_free_mk], - all_goals { apply_instance } + { simp only [to_list, foldl, list.reverse_inj, foldl.get, + foldl.of_free_monoid_comp_of] }, + { apply_instance } end lemma fold_map_map [monoid γ] (f : α → β) (g : β → γ) (xs : t α) : @@ -297,23 +276,27 @@ by simp only [fold_map,traverse_map] lemma foldl_to_list (f : α → β → α) (xs : t β) (x : α) : foldl f x xs = list.foldl f x (to_list xs) := begin - rw ← foldl.unop_of_free_monoid, + rw [← free_monoid.to_list_of_list (to_list xs), ← foldl.unop_of_free_monoid], simp only [foldl, to_list_spec, fold_map_hom_free, - foldl.of_free_monoid_comp_free_mk, foldl.get] + foldl.of_free_monoid_comp_of, foldl.get, free_monoid.of_list_to_list] end lemma foldr_to_list (f : α → β → β) (xs : t α) (x : β) : foldr f x xs = list.foldr f x (to_list xs) := begin - change _ = foldr.of_free_monoid _ _ _, - simp only [foldr, to_list_spec, fold_map_hom_free, - foldr.of_free_monoid_comp_free_mk, foldr.get] + change _ = foldr.of_free_monoid _ (free_monoid.of_list $ to_list xs) _, + rw [to_list_spec, foldr, foldr.get, free_monoid.of_list_to_list, fold_map_hom_free, + foldr.of_free_monoid_comp_of] end +/- + +-/ + lemma to_list_map (f : α → β) (xs : t α) : - to_list (f <$> xs) = f <$> to_list xs := by -{ simp only [to_list_spec,free.map_eq_map,fold_map_hom (free.map f), fold_map_map]; - refl } + to_list (f <$> xs) = f <$> to_list xs := +by simp only [to_list_spec, free.map_eq_map, fold_map_hom, fold_map_map, + free_monoid.of_list_to_list, free_monoid.map_of, (∘)] @[simp] theorem foldl_map (g : β → γ) (f : α → γ → α) (a : α) (l : t β) : foldl f a (g <$> l) = foldl (λ x y, f x (g y)) a l := @@ -328,7 +311,7 @@ begin simp only [to_list_spec, fold_map, traverse], induction xs, case list.nil { refl }, - case list.cons : _ _ ih { unfold list.traverse list.ret, rw ih, refl } + case list.cons : _ _ ih { conv_rhs { rw [← ih] }, refl } end theorem length_to_list {xs : t α} : length xs = list.length (to_list xs) := @@ -353,17 +336,17 @@ variables {m : Type u → Type u} [monad m] [is_lawful_monad m] lemma mfoldl_to_list {f : α → β → m α} {x : α} {xs : t β} : mfoldl f x xs = list.mfoldl f x (to_list xs) := -calc mfoldl f x xs = unop (mfoldl.of_free_monoid f (to_list xs)) x : +calc mfoldl f x xs = unop (mfoldl.of_free_monoid f (free_monoid.of_list $ to_list xs)) x : by simp only [mfoldl, to_list_spec, fold_map_hom_free (mfoldl.of_free_monoid f), - mfoldl.of_free_monoid_comp_free_mk, mfoldl.get] + mfoldl.of_free_monoid_comp_of, mfoldl.get, free_monoid.of_list_to_list] ... = list.mfoldl f x (to_list xs) : by simp [mfoldl.of_free_monoid, unop_op, flip] lemma mfoldr_to_list (f : α → β → m β) (x : β) (xs : t α) : mfoldr f x xs = list.mfoldr f x (to_list xs) := begin - change _ = mfoldr.of_free_monoid f (to_list xs) x, + change _ = mfoldr.of_free_monoid f (free_monoid.of_list $ to_list xs) x, simp only [mfoldr, to_list_spec, fold_map_hom_free (mfoldr.of_free_monoid f), - mfoldr.of_free_monoid_comp_free_mk, mfoldr.get] + mfoldr.of_free_monoid_comp_of, mfoldr.get, free_monoid.of_list_to_list] end @[simp] theorem mfoldl_map (g : β → γ) (f : α → γ → m α) (a : α) (l : t β) : diff --git a/src/control/functor.lean b/src/control/functor.lean index 66020bb9dfa54..c18cd665db28e 100644 --- a/src/control/functor.lean +++ b/src/control/functor.lean @@ -3,12 +3,15 @@ Copyright (c) 2017 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ -import tactic.ext import tactic.lint +import control.basic /-! # Functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides additional lemmas, definitions, and instances for `functor`s. ## Main definitions diff --git a/src/control/functor/multivariate.lean b/src/control/functor/multivariate.lean index 9274109ee08a8..40e62aab0df6d 100644 --- a/src/control/functor/multivariate.lean +++ b/src/control/functor/multivariate.lean @@ -5,10 +5,11 @@ Authors: Jeremy Avigad, Mario Carneiro, Simon Hudon -/ import data.fin.fin2 import data.typevec -import logic.function.basic -import tactic.basic /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Functors between the category of tuples of types, and the category Type @@ -28,7 +29,7 @@ and the category of Type -/ class mvfunctor {n : ℕ} (F : typevec n → Type*) := (map : Π {α β : typevec n}, (α ⟹ β) → (F α → F β)) -localized "infixr ` <$$> `:100 := mvfunctor.map" in mvfunctor +localized "infixr (name := mvfunctor.map) ` <$$> `:100 := mvfunctor.map" in mvfunctor variables {n : ℕ} @@ -161,7 +162,7 @@ lemma liftp_last_pred_iff {β} (p : β → Prop) (x : F (α ::: β)) : begin dsimp only [liftp,liftp'], apply exists_iff_exists_of_mono F (f _ n α) (g _ n α), - { clear x _inst_2 _inst_1 F, ext i ⟨x,_⟩, cases i; refl }, + { ext i ⟨x,_⟩, cases i; refl }, { intros, rw [mvfunctor.map_map,(⊚)], congr'; ext i ⟨x,_⟩; cases i; refl } end @@ -189,7 +190,7 @@ lemma liftr_last_rel_iff (x y : F (α ::: β)) : begin dsimp only [liftr,liftr'], apply exists_iff_exists_of_mono F (f rr _ _) (g rr _ _), - { clear x y _inst_2 _inst_1 F, ext i ⟨x,_⟩ : 2, cases i; refl, }, + { ext i ⟨x,_⟩ : 2, cases i; refl, }, { intros, rw [mvfunctor.map_map,mvfunctor.map_map,(⊚),(⊚)], congr'; ext i ⟨x,_⟩; cases i; refl } end diff --git a/src/control/lawful_fix.lean b/src/control/lawful_fix.lean index 94bd04d7e3b37..0c1a46d66ca99 100644 --- a/src/control/lawful_fix.lean +++ b/src/control/lawful_fix.lean @@ -3,7 +3,7 @@ Copyright (c) 2020 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ - +import data.stream.init import tactic.apply import control.fix import order.omega_complete_partial_order @@ -11,6 +11,9 @@ import order.omega_complete_partial_order /-! # Lawful fixed point operators +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines the laws required of a `has_fix` instance, using the theory of omega complete partial orders (ωCPO). Proofs of the lawfulness of all `has_fix` instances in `control.fix` are provided. @@ -74,7 +77,8 @@ begin suffices : y = b, subst this, exact h₁, cases hh with i hh, revert h₁, generalize : (succ (nat.find h₀)) = j, intro, - wlog : i ≤ j := le_total i j using [i j b y,j i y b], + wlog case : i ≤ j, + { cases le_total i j with H H; [skip, symmetry]; apply_assumption; assumption }, replace hh := approx_mono f case _ _ hh, apply part.mem_unique h₁ hh }, { simp only [fix_def' ⇑f h₀, not_exists, false_iff, not_mem_none], diff --git a/src/control/monad/basic.lean b/src/control/monad/basic.lean index 28ba0a0117a64..33cfffa056f56 100644 --- a/src/control/monad/basic.lean +++ b/src/control/monad/basic.lean @@ -3,12 +3,15 @@ Copyright (c) 2019 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ -import logic.equiv.basic +import logic.equiv.defs import tactic.basic /-! # Monad +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Attributes * ext @@ -35,11 +38,7 @@ functor, applicative, monad, simp -/ -mk_simp_attribute monad_norm none with functor_norm - attribute [ext] reader_t.ext state_t.ext except_t.ext option_t.ext -attribute [functor_norm] bind_assoc pure_bind bind_pure -attribute [monad_norm] seq_eq_bind_map universes u v @[monad_norm] diff --git a/src/control/monad/writer.lean b/src/control/monad/writer.lean index 837d27543a48c..2b5fb0135e872 100644 --- a/src/control/monad/writer.lean +++ b/src/control/monad/writer.lean @@ -6,7 +6,7 @@ Authors: Simon Hudon The writer monad transformer for passing immutable state. -/ import algebra.group.defs -import logic.equiv.basic +import logic.equiv.defs universes u v w u₀ u₁ v₀ v₁ diff --git a/src/control/random.lean b/src/control/random.lean index d5e327be1af5c..b6fffc4515b7d 100644 --- a/src/control/random.lean +++ b/src/control/random.lean @@ -4,17 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ -import control.monad.basic -import data.int.basic -import data.stream.defs import control.uliftable -import tactic.norm_num import data.bitvec.basic +import data.stream.defs +import tactic.norm_num /-! # Rand Monad and Random Class +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides tools for formulating computations guided by randomness and for defining objects that can be created randomly. @@ -130,7 +131,7 @@ namespace io private def accum_char (w : ℕ) (c : char) : ℕ := c.to_nat + 256 * w -/-- create and a seed a random number generator -/ +/-- create and seed a random number generator -/ def mk_generator : io std_gen := do seed ← io.rand 0 shift_31_left, return $ mk_std_gen seed @@ -224,7 +225,7 @@ variables {g : Type} [random_gen g] open nat namespace fin -variables {n : ℕ} [fact (0 < n)] +variables {n : ℕ} [ne_zero n] /-- generate a `fin` randomly -/ protected def random : rand_g g (fin n) := @@ -252,7 +253,7 @@ instance int_bounded_random : bounded_random ℤ := (int.coe_nat_le_coe_nat_of_le h₁) (le_of_eq $ int.of_nat_nat_abs_eq_of_nonneg (int.sub_nonneg_of_le hxy)) ⟩ } -instance fin_random (n : ℕ) [fact (0 < n)] : random (fin n) := +instance fin_random (n : ℕ) [ne_zero n] : random (fin n) := { random := λ g inst, @fin.random g inst _ _ } instance fin_bounded_random (n : ℕ) : bounded_random (fin n) := @@ -284,8 +285,6 @@ instance : bounded_random bool := subtype.map bool.of_nat (bool_of_nat_mem_Icc_of_mem_Icc_to_nat x y) <$> @bounded_random.random_r ℕ _ _ g _inst x.to_nat y.to_nat (bool.to_nat_le_to_nat p) } -open_locale fin_fact - /-- generate a random bit vector of length `n` -/ def bitvec.random (n : ℕ) : rand_g g (bitvec n) := bitvec.of_fin <$> rand.random (fin $ 2^n) diff --git a/src/control/traversable/basic.lean b/src/control/traversable/basic.lean index fd30e7352d29d..6f297f03b087b 100644 --- a/src/control/traversable/basic.lean +++ b/src/control/traversable/basic.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ import control.functor +import tactic.ext /-! # Traversable type class +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Type classes for traversing collections. The concepts and laws are taken from @@ -115,11 +119,10 @@ section preserves variables (η : applicative_transformation F G) @[functor_norm] -lemma preserves_pure : ∀ {α} (x : α), η (pure x) = pure x := η.preserves_pure' +lemma preserves_pure {α} : ∀ (x : α), η (pure x) = pure x := η.preserves_pure' @[functor_norm] -lemma preserves_seq : - ∀ {α β : Type u} (x : F (α → β)) (y : F α), η (x <*> y) = η x <*> η y := +lemma preserves_seq {α β : Type u} : ∀ (x : F (α → β)) (y : F α), η (x <*> y) = η x <*> η y := η.preserves_seq' @[functor_norm] diff --git a/src/control/traversable/default.lean b/src/control/traversable/default.lean deleted file mode 100644 index 9a41fa82e3fcc..0000000000000 --- a/src/control/traversable/default.lean +++ /dev/null @@ -1,2 +0,0 @@ -import control.traversable.instances -import control.traversable.lemmas diff --git a/src/control/traversable/derive.lean b/src/control/traversable/derive.lean index b15f65b7dc517..3545bc23feb9c 100644 --- a/src/control/traversable/derive.lean +++ b/src/control/traversable/derive.lean @@ -5,6 +5,7 @@ Authors: Simon Hudon Automation to construct `traversable` instances -/ +import tactic.basic import control.traversable.lemmas namespace tactic.interactive @@ -49,7 +50,7 @@ meta def map_constructor (c n : name) (f α β : expr) do g ← target, (_, args') ← mmap_accuml (λ (x : list expr) (y : bool × expr), if y.1 then pure (x.tail,x.head) - else prod.mk rec_call <$> map_field n g.app_fn f α β y.2) rec_call args₁, + else prod.mk x <$> map_field n g.app_fn f α β y.2) rec_call args₁, constr ← mk_const c, let r := constr.mk_app (args₀ ++ args'), return r diff --git a/src/control/traversable/equiv.lean b/src/control/traversable/equiv.lean index 160d2e5cdcc22..205a4a8d4d7aa 100644 --- a/src/control/traversable/equiv.lean +++ b/src/control/traversable/equiv.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ import control.traversable.lemmas -import logic.equiv.basic +import logic.equiv.defs /-! # Transferring `traversable` instances along isomorphisms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file allows to transfer `traversable` instances along isomorphisms. ## Main declarations diff --git a/src/control/traversable/instances.lean b/src/control/traversable/instances.lean index 97fe4a08bf51e..18bd514d9a37c 100644 --- a/src/control/traversable/instances.lean +++ b/src/control/traversable/instances.lean @@ -10,6 +10,9 @@ import data.set.functor /-! # Traversable instances +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides instances of `traversable` for types from the core library: `option`, `list` and `sum`. -/ diff --git a/src/control/traversable/lemmas.lean b/src/control/traversable/lemmas.lean index 2a4134ddcbfdc..ec36c888752af 100644 --- a/src/control/traversable/lemmas.lean +++ b/src/control/traversable/lemmas.lean @@ -9,6 +9,9 @@ import control.traversable.basic /-! # Traversing collections +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic properties of traversable and applicative functors and defines `pure_transformation F`, the natural applicative transformation from the identity functor to `F`. diff --git a/src/control/ulift.lean b/src/control/ulift.lean index e26a362e1932e..0570be8666309 100644 --- a/src/control/ulift.lean +++ b/src/control/ulift.lean @@ -7,6 +7,9 @@ Authors: Scott Morrison, Jannis Limperg /-! # Monadic instances for `ulift` and `plift` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `monad` and `is_lawful_monad` instances on `plift` and `ulift`. -/ universes u v diff --git a/src/control/uliftable.lean b/src/control/uliftable.lean index 3cdadee22171d..104ed8c3b5399 100644 --- a/src/control/uliftable.lean +++ b/src/control/uliftable.lean @@ -12,6 +12,9 @@ import tactic.interactive /-! # Universe lifting for type families +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Some functors such as `option` and `list` are universe polymorphic. Unlike type polymorphism where `option α` is a function application and reasoning and generalizations that apply to functions can be used, `option.{u}` and `option.{v}` diff --git a/src/data/W/basic.lean b/src/data/W/basic.lean index c359b858fd788..98e0919dbef24 100644 --- a/src/data/W/basic.lean +++ b/src/data/W/basic.lean @@ -8,6 +8,9 @@ import logic.equiv.list /-! # W types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the inductively defined type of trees where the nodes are labeled by elements of `α` and the children of a node labeled `a` are indexed by elements of `β a`. @@ -90,7 +93,7 @@ lemma infinite_of_nonempty_of_is_empty (a b : α) [ha : nonempty (β a)] ⟨begin introsI hf, have hba : b ≠ a, from λ h, ha.elim (is_empty.elim' (show is_empty (β a), from h ▸ he)), - refine not_injective_infinite_fintype + refine not_injective_infinite_finite (λ n : ℕ, show W_type β, from nat.rec_on n ⟨b, is_empty.elim' he⟩ (λ n ih, ⟨a, λ _, ih⟩)) _, diff --git a/src/data/W/cardinal.lean b/src/data/W/cardinal.lean index d5dd68d7b2759..251c034ee7bed 100644 --- a/src/data/W/cardinal.lean +++ b/src/data/W/cardinal.lean @@ -9,10 +9,13 @@ import set_theory.cardinal.ordinal /-! # Cardinality of W-types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves some theorems about the cardinality of W-types. The main result is -`cardinal_mk_le_max_omega_of_fintype` which says that if for any `a : α`, +`cardinal_mk_le_max_aleph_0_of_fintype` which says that if for any `a : α`, `β a` is finite, then the cardinality of `W_type β` is at most the maximum of the -cardinality of `α` and `cardinal.omega`. +cardinality of `α` and `ℵ₀`. This can be used to prove theorems about the cardinality of algebraic constructions such as polynomials. There is a surjection from a `W_type` to `mv_polynomial` for example, and this surjection can be used to put an upper bound on the cardinality of `mv_polynomial`. @@ -50,38 +53,28 @@ begin end /-- If, for any `a : α`, `β a` is finite, then the cardinality of `W_type β` - is at most the maximum of the cardinality of `α` and `ω` -/ -lemma cardinal_mk_le_max_omega_of_fintype [Π a, fintype (β a)] : #(W_type β) ≤ max (#α) ω := + is at most the maximum of the cardinality of `α` and `ℵ₀` -/ +lemma cardinal_mk_le_max_aleph_0_of_finite [∀ a, finite (β a)] : #(W_type β) ≤ max (#α) ℵ₀ := (is_empty_or_nonempty α).elim (begin introI h, rw [cardinal.mk_eq_zero (W_type β)], exact zero_le _ end) $ -λ hn, -let m := max (#α) ω in -cardinal_mk_le_of_le $ -calc cardinal.sum (λ a : α, m ^ #(β a)) - ≤ #α * cardinal.sup.{u u} - (λ a : α, m ^ cardinal.mk (β a)) : - cardinal.sum_le_sup _ -... ≤ m * cardinal.sup.{u u} - (λ a : α, m ^ #(β a)) : - mul_le_mul' (le_max_left _ _) le_rfl +λ hn, let m := max (#α) ℵ₀ in cardinal_mk_le_of_le $ +calc cardinal.sum (λ a, m ^ #(β a)) + ≤ #α * ⨆ a, m ^ #(β a) : cardinal.sum_le_supr _ +... ≤ m * ⨆ a, m ^ #(β a) : mul_le_mul' (le_max_left _ _) le_rfl ... = m : mul_eq_left.{u} (le_max_right _ _) - (cardinal.sup_le (λ i, begin - cases lt_omega.1 (lt_omega_of_fintype (β i)) with n hn, - rw [hn], - exact power_nat_le (le_max_right _ _) - end)) - (pos_iff_ne_zero.1 (succ_le.1 + (csupr_le' $ λ i, pow_le (le_max_right _ _) (lt_aleph_0_of_finite _)) $ + pos_iff_ne_zero.1 $ order.succ_le_iff.1 begin - rw [succ_zero], + rw succ_zero, obtain ⟨a⟩ : nonempty α, from hn, - refine le_trans _ (le_sup _ a), - rw [← @power_zero m], + refine le_trans _ (le_csupr (bdd_above_range.{u u} _) a), + rw ←power_zero, exact power_le_power_left (pos_iff_ne_zero.1 - (lt_of_lt_of_le omega_pos (le_max_right _ _))) (zero_le _) - end)) + (aleph_0_pos.trans_le (le_max_right _ _))) (zero_le _) + end end W_type diff --git a/src/data/W/constructions.lean b/src/data/W/constructions.lean index 654dfd030b995..3e1698d34aa5e 100644 --- a/src/data/W/constructions.lean +++ b/src/data/W/constructions.lean @@ -8,6 +8,9 @@ import data.W.basic /-! # Examples of W-types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We take the view of W types as inductive types. Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the inductively with constructors from `α` and arities of each constructor `a : α` given by `β a`. diff --git a/src/data/analysis/filter.lean b/src/data/analysis/filter.lean index 6d4c8176442a5..edff2cd7db0d5 100644 --- a/src/data/analysis/filter.lean +++ b/src/data/analysis/filter.lean @@ -2,10 +2,24 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro - -Computational realization of filters (experimental). -/ import order.filter.cofinite + +/-! +# Computational realization of filters (experimental) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides infrastructure to compute with filters. + +## Main declarations + +* `cfilter`: Realization of a filter base. Note that this is in the generality of filters on + lattices, while `filter` is filters of sets (so corresponding to `cfilter (set α) σ`). +* `filter.realizer`: Realization of a `filter`. `cfilter` that generates the given filter. +-/ + open set filter /-- A `cfilter α σ` is a realization of a filter (base) on `α`, @@ -20,6 +34,13 @@ structure cfilter (α σ : Type*) [partial_order α] := variables {α : Type*} {β : Type*} {σ : Type*} {τ : Type*} +instance [inhabited α] [semilattice_inf α] : inhabited (cfilter α α) := +⟨{ f := id, + pt := default, + inf := (⊓), + inf_le_left := λ _ _, inf_le_left, + inf_le_right := λ _ _, inf_le_right }⟩ + namespace cfilter section variables [partial_order α] (F : cfilter α σ) @@ -62,6 +83,7 @@ structure filter.realizer (f : filter α) := (F : cfilter (set α) σ) (eq : F.to_filter = f) +/-- A `cfilter` realizes the filter it generates. -/ protected def cfilter.to_realizer (F : cfilter (set α) σ) : F.to_filter.realizer := ⟨σ, F, rfl⟩ namespace filter.realizer @@ -69,7 +91,8 @@ namespace filter.realizer theorem mem_sets {f : filter α} (F : f.realizer) {a : set α} : a ∈ f ↔ ∃ b, F.F b ⊆ a := by cases F; subst f; simp --- Used because it has better definitional equalities than the eq.rec proof +/-- Transfer a realizer along an equality of filter. This has better definitional equalities than +the `eq.rec` proof. -/ def of_eq {f g : filter α} (e : f = g) (F : f.realizer) : g.realizer := ⟨F.σ, F.F, F.eq.trans e⟩ @@ -105,6 +128,8 @@ filter_eq $ set.ext $ λ x, @[simp] theorem principal_σ (s : set α) : (realizer.principal s).σ = unit := rfl @[simp] theorem principal_F (s : set α) (u : unit) : (realizer.principal s).F u = s := rfl +instance (s : set α) : inhabited (principal s).realizer := ⟨realizer.principal s⟩ + /-- `unit` is a realizer for the top filter -/ protected def top : (⊤ : filter α).realizer := (realizer.principal _).of_eq principal_univ @@ -187,8 +212,7 @@ protected def cofinite [decidable_eq α] : (@cofinite α).realizer := ⟨finset inf_le_right := λ s t a, mt (finset.mem_union_right _) }, filter_eq $ set.ext $ λ x, ⟨λ ⟨s, h⟩, s.finite_to_set.subset (compl_subset_comm.1 h), - λ ⟨fs⟩, by exactI ⟨xᶜ.to_finset, λ a (h : a ∉ xᶜ.to_finset), - classical.by_contradiction $ λ h', h (mem_to_finset.2 h')⟩⟩⟩ + λ h, ⟨h.to_finset, by simp⟩⟩⟩ /-- Construct a realizer for filter bind -/ protected def bind {f : filter α} {m : α → filter β} (F : f.realizer) (G : ∀ i, (m i).realizer) : diff --git a/src/data/analysis/topology.lean b/src/data/analysis/topology.lean index 2a08d83df31d9..f66aac0b96661 100644 --- a/src/data/analysis/topology.lean +++ b/src/data/analysis/topology.lean @@ -2,14 +2,30 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro - -Computational realization of topological spaces (experimental). -/ -import topology.bases import data.analysis.filter +import topology.bases +import topology.locally_finite + +/-! +# Computational realization of topological spaces (experimental) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides infrastructure to compute with topological spaces. + +## Main declarations + +* `ctop`: Realization of a topology basis. +* `ctop.realizer`: Realization of a topological space. `ctop` that generates the given topology. +* `locally_finite.realizer`: Realization of the local finiteness of an indexed family of sets. +* `compact.realizer`: Realization of the compactness of a set. +-/ + open set open filter (hiding realizer) -open_locale topological_space +open_locale topology /-- A `ctop α σ` is a realization of a topology (basis) on `α`, represented by a type `σ` together with operations for the top element and @@ -24,6 +40,14 @@ structure ctop (α σ : Type*) := variables {α : Type*} {β : Type*} {σ : Type*} {τ : Type*} +instance : inhabited (ctop α (set α)) := +⟨{ f := id, + top := singleton, + top_mem := mem_singleton, + inter := λ s t _ _, s ∩ t, + inter_mem := λ s t a, id, + inter_sub := λ s t a ha, subset.rfl }⟩ + namespace ctop section variables (F : ctop α σ) @@ -74,9 +98,12 @@ structure ctop.realizer (α) [T : topological_space α] := (eq : F.to_topsp = T) open ctop +/-- A `ctop` realizes the topological space it generates. -/ protected def ctop.to_realizer (F : ctop α σ) : @ctop.realizer _ F.to_topsp := @ctop.realizer.mk _ F.to_topsp σ F rfl +instance (F : ctop α σ) : inhabited (@ctop.realizer _ F.to_topsp) := ⟨F.to_realizer⟩ + namespace ctop.realizer protected theorem is_basis [T : topological_space α] (F : realizer α) : @@ -122,6 +149,7 @@ ext' $ λ a s, ⟨H₂ a s, λ ⟨b, h₁, h₂⟩, mem_nhds_iff.2 ⟨_, h₂, H variable [topological_space α] +/-- The topological space realizer made of the open sets. -/ protected def id : realizer α := ⟨{x:set α // is_open x}, { f := subtype.val, top := λ _, ⟨univ, is_open_univ⟩, @@ -132,6 +160,7 @@ protected def id : realizer α := ⟨{x:set α // is_open x}, ext subtype.property $ λ x s h, let ⟨t, h, o, m⟩ := mem_nhds_iff.1 h in ⟨⟨t, o⟩, m, h⟩⟩ +/-- Replace the representation type of a `ctop` realizer. -/ def of_equiv (F : realizer α) (E : F.σ ≃ τ) : realizer α := ⟨τ, F.F.of_equiv E, ext' (λ a s, F.mem_nhds.trans $ ⟨λ ⟨s, h⟩, ⟨E s, by simpa using h⟩, λ ⟨t, h⟩, ⟨E.symm t, by simpa using h⟩⟩)⟩ @@ -140,6 +169,7 @@ def of_equiv (F : realizer α) (E : F.σ ≃ τ) : realizer α := @[simp] theorem of_equiv_F (F : realizer α) (E : F.σ ≃ τ) (s : τ) : (F.of_equiv E).F s = F.F (E.symm s) := by delta of_equiv; simp +/-- A realizer of the neighborhood of a point. -/ protected def nhds (F : realizer α) (a : α) : (𝓝 a).realizer := ⟨{s : F.σ // a ∈ F.F s}, { f := λ s, F.F s.1, @@ -151,10 +181,8 @@ filter_eq $ set.ext $ λ x, ⟨λ ⟨⟨s, as⟩, h⟩, mem_nhds_iff.2 ⟨_, h, F.is_open _, as⟩, λ h, let ⟨s, h, as⟩ := F.mem_nhds.1 h in ⟨⟨s, h⟩, as⟩⟩⟩ -@[simp] theorem nhds_σ (m : α → β) (F : realizer α) (a : α) : - (F.nhds a).σ = {s : F.σ // a ∈ F.F s} := rfl -@[simp] theorem nhds_F (m : α → β) (F : realizer α) (a : α) (s) : - (F.nhds a).F s = F.F s.1 := rfl +@[simp] lemma nhds_σ (F : realizer α) (a : α) : (F.nhds a).σ = {s : F.σ // a ∈ F.F s} := rfl +@[simp] lemma nhds_F (F : realizer α) (a : α) (s) : (F.nhds a).F s = F.F s.1 := rfl theorem tendsto_nhds_iff {m : β → α} {f : filter β} (F : f.realizer) (R : realizer α) {a : α} : tendsto m f (𝓝 a) ↔ ∀ t, a ∈ R.F t → ∃ s, ∀ x ∈ F.F s, m x ∈ R.F t := @@ -162,6 +190,9 @@ theorem tendsto_nhds_iff {m : β → α} {f : filter β} (F : f.realizer) (R : r end ctop.realizer +/-- A `locally_finite.realizer F f` is a realization that `f` is locally finite, namely it is a +choice of open sets from the basis of `F` such that they intersect only finitely many of the values +of `f`. -/ structure locally_finite.realizer [topological_space α] (F : realizer α) (f : β → set α) := (bas : ∀ a, {s // a ∈ F.F s}) (sets : ∀ x:α, fintype {i | (f i ∩ F.F (bas x)).nonempty}) @@ -183,6 +214,15 @@ theorem locally_finite_iff_exists_realizer [topological_space α] hi.mono (inter_subset_inter_right _ (h₂ x).2)⟩⟩, λ ⟨R⟩, R.to_locally_finite⟩ -def compact.realizer [topological_space α] (R : realizer α) (s : set α) := +instance [topological_space α] [finite β] (F : realizer α) (f : β → set α) : + nonempty (locally_finite.realizer F f) := +(locally_finite_iff_exists_realizer _).1 $ locally_finite_of_finite _ + +/-- A `compact.realizer s` is a realization that `s` is compact, namely it is a +choice of finite open covers for each set family covering `s`. -/ +def compact.realizer [topological_space α] (s : set α) := ∀ {f : filter α} (F : f.realizer) (x : F.σ), f ≠ ⊥ → F.F x ⊆ s → {a // a∈s ∧ 𝓝 a ⊓ f ≠ ⊥} + +instance [topological_space α] : inhabited (compact.realizer (∅ : set α)) := +⟨λ f F x h hF, by { cases h _, rw [←F.eq, eq_bot_iff], exact λ s _, ⟨x, hF.trans s.empty_subset⟩ }⟩ diff --git a/src/data/array/lemmas.lean b/src/data/array/lemmas.lean index 7b4821d5496eb..c459b4f2800dc 100644 --- a/src/data/array/lemmas.lean +++ b/src/data/array/lemmas.lean @@ -3,8 +3,8 @@ Copyright (c) 2017 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Mario Carneiro -/ -import control.traversable.equiv -import data.vector.basic +import data.fin.basic +import data.list.basic universes u v w @@ -12,7 +12,7 @@ namespace d_array variables {n : ℕ} {α : fin n → Type u} instance [∀ i, inhabited (α i)] : inhabited (d_array n α) := -⟨⟨λ _, default⟩⟩ +⟨⟨default⟩⟩ end d_array @@ -270,32 +270,3 @@ read_foreach end map₂ end array - -namespace equiv - -/-- The natural equivalence between length-`n` heterogeneous arrays -and dependent functions from `fin n`. -/ -def d_array_equiv_fin {n : ℕ} (α : fin n → Type*) : d_array n α ≃ (Π i, α i) := -⟨d_array.read, d_array.mk, λ ⟨f⟩, rfl, λ f, rfl⟩ - -/-- The natural equivalence between length-`n` arrays and functions from `fin n`. -/ -def array_equiv_fin (n : ℕ) (α : Type*) : array n α ≃ (fin n → α) := -d_array_equiv_fin _ - -/-- The natural equivalence between length-`n` vectors and length-`n` arrays. -/ -def vector_equiv_array (α : Type*) (n : ℕ) : vector α n ≃ array n α := -(vector_equiv_fin _ _).trans (array_equiv_fin _ _).symm - -end equiv - -namespace array -open function -variable {n : ℕ} - -instance : traversable (array n) := -@equiv.traversable (flip vector n) _ (λ α, equiv.vector_equiv_array α n) _ - -instance : is_lawful_traversable (array n) := -@equiv.is_lawful_traversable (flip vector n) _ (λ α, equiv.vector_equiv_array α n) _ _ - -end array diff --git a/src/data/bitvec/basic.lean b/src/data/bitvec/basic.lean index d3e65633c634c..5e76ec218b003 100644 --- a/src/data/bitvec/basic.lean +++ b/src/data/bitvec/basic.lean @@ -5,8 +5,8 @@ Authors: Simon Hudon -/ import data.bitvec.core import data.fin.basic -import tactic.norm_num import tactic.monotonicity +import tactic.norm_num namespace bitvec @@ -22,7 +22,7 @@ by rw [of_fin,to_nat_of_nat,nat.mod_eq_of_lt]; apply i.is_lt /-- convert `bitvec` to `fin` -/ def to_fin {n : ℕ} (i : bitvec n) : fin $ 2^n := -@fin.of_nat' _ ⟨pow_pos (by norm_num) _⟩ i.to_nat +i.to_nat lemma add_lsb_eq_twice_add_one {x b} : add_lsb x b = 2 * x + cond b 1 0 := @@ -46,8 +46,8 @@ begin rw [add_lsb_eq_twice_add_one], transitivity 2 * list.foldr (λ (x : bool) (y : ℕ), add_lsb y x) 0 ys_tl + 2 * 1, { ac_mono, rw two_mul, mono, cases ys_hd; simp }, - { rw ← left_distrib, ac_mono, norm_num, - apply ys_ih, refl } }, + { rw ← left_distrib, ac_mono, + exact ys_ih rfl, norm_num } } end lemma add_lsb_div_two {x b} : add_lsb x b / 2 = x := @@ -77,7 +77,7 @@ begin end lemma to_fin_val {n : ℕ} (v : bitvec n) : (to_fin v : ℕ) = v.to_nat := -by rw [to_fin, fin.coe_of_nat_eq_mod', nat.mod_eq_of_lt]; apply to_nat_lt +by rw [to_fin, fin.coe_of_nat_eq_mod, nat.mod_eq_of_lt]; apply to_nat_lt lemma to_fin_le_to_fin_of_le {n} {v₀ v₁ : bitvec n} (h : v₀ ≤ v₁) : v₀.to_fin ≤ v₁.to_fin := show (v₀.to_fin : ℕ) ≤ v₁.to_fin, diff --git a/src/data/bitvec/core.lean b/src/data/bitvec/core.lean index 25758c82e06f9..cc1f908c735d8 100644 --- a/src/data/bitvec/core.lean +++ b/src/data/bitvec/core.lean @@ -5,11 +5,14 @@ Authors: Joe Hendrix, Sebastian Ullrich -/ import data.vector.basic -import data.nat.basic +import data.nat.pow /-! # Basic operations on bitvectors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This is a work-in-progress, and contains additions to other theories. This file was moved to mathlib from core Lean in the switch to Lean 3.20.0c. @@ -26,12 +29,12 @@ open vector local infix `++ₜ`:65 := vector.append /-- Create a zero bitvector -/ -@[reducible] protected def zero (n : ℕ) : bitvec n := repeat ff n +@[reducible] protected def zero (n : ℕ) : bitvec n := replicate n ff /-- Create a bitvector of length `n` whose `n-1`st entry is 1 and other entries are 0. -/ @[reducible] protected def one : Π (n : ℕ), bitvec n | 0 := nil -| (succ n) := repeat ff n ++ₜ tt::ᵥnil +| (succ n) := replicate n ff ++ₜ tt::ᵥnil /-- Create a bitvector from another with a provably equal length. -/ protected def cong {a b : ℕ} (h : a = b) : bitvec a → bitvec b @@ -49,7 +52,7 @@ variable {n : ℕ} If `x.length < i` then this will return the all-`ff`s bitvector. -/ def shl (x : bitvec n) (i : ℕ) : bitvec n := bitvec.cong (by simp) $ - drop i x ++ₜ repeat ff (min n i) + drop i x ++ₜ replicate (min n i) ff /-- `fill_shr x i fill` is the bitvector obtained by right-shifting `x` `i` times and then padding with `fill : bool`. If `x.length < i` then this will return the constant `fill` @@ -64,7 +67,7 @@ bitvec.cong { have h₁ := le_of_not_ge h, rw [min_eq_left h₁, tsub_eq_zero_iff_le.mpr h₁, zero_min, nat.add_zero] } end $ - repeat fill (min n i) ++ₜ take (n-i) x + replicate (min n i) fill ++ₜ take (n-i) x /-- unsigned shift right -/ def ushr (x : bitvec n) (i : ℕ) : bitvec n := diff --git a/src/data/bool/all_any.lean b/src/data/bool/all_any.lean index 42d41296aec8c..150e38cf3ab26 100644 --- a/src/data/bool/all_any.lean +++ b/src/data/bool/all_any.lean @@ -8,6 +8,9 @@ import data.list.basic /-! # Boolean quantifiers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This proves a few properties about `list.all` and `list.any`, which are the `bool` universal and existential quantifiers. Their definitions are in core Lean. -/ @@ -47,10 +50,4 @@ theorem any_iff_exists_prop : any l (λ a, p a) ↔ ∃ a ∈ l, p a := by simp theorem any_of_mem {p : α → bool} (h₁ : a ∈ l) (h₂ : p a) : any l p := any_iff_exists.2 ⟨_, h₁, h₂⟩ -@[priority 500] instance decidable_forall_mem (l : list α) : decidable (∀ x ∈ l, p x) := -decidable_of_iff _ all_iff_forall_prop - -instance decidable_exists_mem (l : list α) : decidable (∃ x ∈ l, p x) := -decidable_of_iff _ any_iff_exists_prop - end list diff --git a/src/data/bool/basic.lean b/src/data/bool/basic.lean index 54fde78126e48..d1a90f2db5395 100644 --- a/src/data/bool/basic.lean +++ b/src/data/bool/basic.lean @@ -7,6 +7,9 @@ Authors: Leonardo de Moura, Jeremy Avigad /-! # booleans +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves various trivial lemmas about booleans and their relation to decidable propositions. @@ -50,7 +53,7 @@ eq_comm.trans of_to_bool_iff @[simp] lemma ff_eq_to_bool_iff {p : Prop} [decidable p] : ff = to_bool p ↔ ¬ p := eq_comm.trans (to_bool_ff_iff _) -@[simp] theorem to_bool_not (p : Prop) [decidable p] : to_bool (¬ p) = bnot (to_bool p) := +@[simp] theorem to_bool_not (p : Prop) [decidable p] : to_bool (¬ p) = !(to_bool p) := by by_cases p; simp * @[simp] theorem to_bool_and (p q : Prop) [decidable p] [decidable q] : @@ -91,13 +94,17 @@ decidable_of_decidable_of_iff or.decidable exists_bool.symm @[simp] theorem cond_tt {α} (t e : α) : cond tt t e = t := rfl +theorem cond_eq_ite {α} (b : bool) (t e : α) : cond b t e = if b then t else e := by cases b; simp + @[simp] theorem cond_to_bool {α} (p : Prop) [decidable p] (t e : α) : cond (to_bool p) t e = if p then t else e := -by by_cases p; simp * +by simp [cond_eq_ite] @[simp] theorem cond_bnot {α} (b : bool) (t e : α) : cond (!b) t e = cond b e t := by cases b; refl +theorem bnot_ne_id : bnot ≠ id := λ h, ff_ne_tt $ congr_fun h tt + theorem coe_bool_iff : ∀ {a b : bool}, (a ↔ b) ↔ a = b := dec_trivial theorem eq_tt_of_ne_ff : ∀ {a : bool}, a ≠ ff → a = tt := dec_trivial @@ -128,15 +135,34 @@ theorem band_intro : ∀ {a b : bool}, a → b → a && b := dec_trivial theorem band_elim_right : ∀ {a b : bool}, a && b → b := dec_trivial -@[simp] theorem bnot_false : bnot ff = tt := rfl +lemma band_bor_distrib_left (a b c : bool) : a && (b || c) = a && b || a && c := by cases a; simp +lemma band_bor_distrib_right (a b c : bool) : (a || b) && c = a && c || b && c := by cases c; simp +lemma bor_band_distrib_left (a b c : bool) : a || b && c = (a || b) && (a || c) := by cases a; simp +lemma bor_band_distrib_right (a b c : bool) : a && b || c = (a || c) && (b || c) := by cases c; simp + +@[simp] theorem bnot_ff : !ff = tt := rfl + +@[simp] theorem bnot_tt : !tt = ff := rfl -@[simp] theorem bnot_true : bnot tt = ff := rfl +lemma eq_bnot_iff : ∀ {a b : bool}, a = !b ↔ a ≠ b := dec_trivial +lemma bnot_eq_iff : ∀ {a b : bool}, !a = b ↔ a ≠ b := dec_trivial + +@[simp] lemma not_eq_bnot : ∀ {a b : bool}, ¬a = !b ↔ a = b := dec_trivial +@[simp] lemma bnot_not_eq : ∀ {a b : bool}, ¬!a = b ↔ a = b := dec_trivial + +lemma ne_bnot {a b : bool} : a ≠ !b ↔ a = b := not_eq_bnot +lemma bnot_ne {a b : bool} : !a ≠ b ↔ a = b := bnot_not_eq + +lemma bnot_ne_self : ∀ b : bool, !b ≠ b := dec_trivial +lemma self_ne_bnot : ∀ b : bool, b ≠ !b := dec_trivial + +lemma eq_or_eq_bnot : ∀ a b, a = b ∨ a = !b := dec_trivial @[simp] theorem bnot_iff_not : ∀ {b : bool}, !b ↔ ¬b := dec_trivial -theorem eq_tt_of_bnot_eq_ff : ∀ {a : bool}, bnot a = ff → a = tt := dec_trivial +theorem eq_tt_of_bnot_eq_ff : ∀ {a : bool}, !a = ff → a = tt := dec_trivial -theorem eq_ff_of_bnot_eq_tt : ∀ {a : bool}, bnot a = tt → a = ff := dec_trivial +theorem eq_ff_of_bnot_eq_tt : ∀ {a : bool}, !a = tt → a = ff := dec_trivial @[simp] lemma band_bnot_self : ∀ x, x && !x = ff := dec_trivial @[simp] lemma bnot_band_self : ∀ x, !x && x = ff := dec_trivial @@ -152,6 +178,11 @@ theorem bxor_left_comm : ∀ a b c, bxor a (bxor b c) = bxor b (bxor a c) := dec @[simp] theorem bxor_ff_left : ∀ a, bxor ff a = a := dec_trivial @[simp] theorem bxor_ff_right : ∀ a, bxor a ff = a := dec_trivial +lemma band_bxor_distrib_left (a b c : bool) : a && (bxor b c) = bxor (a && b) (a && c) := +by cases a; simp +lemma band_bxor_distrib_right (a b c : bool) : (bxor a b) && c = bxor (a && c) (b && c) := +by cases c; simp + lemma bxor_iff_ne : ∀ {x y : bool}, bxor x y = tt ↔ x ≠ y := dec_trivial /-! ### De Morgan's laws for booleans-/ @@ -168,7 +199,6 @@ instance : linear_order bool := le_total := dec_trivial, decidable_le := infer_instance, decidable_eq := infer_instance, - decidable_lt := infer_instance, max := bor, max_def := by { funext x y, revert x y, exact dec_trivial }, min := band, @@ -225,4 +255,8 @@ by cases b; simp only [of_nat,to_nat]; exact dec_trivial ⟨λ Hinj Heq, ff_ne_tt (Hinj Heq), λ H x y hxy, by { cases x; cases y, exacts [rfl, (H hxy).elim, (H hxy.symm).elim, rfl] }⟩ +/-- **Kaminski's Equation** -/ +theorem apply_apply_apply (f : bool → bool) (x : bool) : f (f (f x)) = f x := +by cases x; cases h₁ : f tt; cases h₂ : f ff; simp only [h₁, h₂] + end bool diff --git a/src/data/bool/count.lean b/src/data/bool/count.lean new file mode 100644 index 0000000000000..bfb0b4dc95a21 --- /dev/null +++ b/src/data/bool/count.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import data.nat.parity +import data.list.chain + +/-! +# List of booleans + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove lemmas about the number of `ff`s and `tt`s in a list of booleans. First we +prove that the number of `ff`s plus the number of `tt` equals the length of the list. Then we prove +that in a list with alternating `tt`s and `ff`s, the number of `tt`s differs from the number of +`ff`s by at most one. We provide several versions of these statements. +-/ + +namespace list + +@[simp] +theorem count_bnot_add_count (l : list bool) (b : bool) : count (!b) l + count b l = length l := +by simp only [length_eq_countp_add_countp (eq (!b)), bool.bnot_not_eq, count] + +@[simp] +theorem count_add_count_bnot (l : list bool) (b : bool) : count b l + count (!b) l = length l := +by rw [add_comm, count_bnot_add_count] + +@[simp] theorem count_ff_add_count_tt (l : list bool) : count ff l + count tt l = length l := +count_bnot_add_count l tt + +@[simp] theorem count_tt_add_count_ff (l : list bool) : count tt l + count ff l = length l := +count_bnot_add_count l ff + +lemma chain.count_bnot : + ∀ {b : bool} {l : list bool}, chain (≠) b l → count (!b) l = count b l + length l % 2 +| b [] h := rfl +| b (x :: l) h := + begin + obtain rfl : b = !x := bool.eq_bnot_iff.2 (rel_of_chain_cons h), + rw [bnot_bnot, count_cons_self, count_cons_of_ne x.bnot_ne_self, + chain.count_bnot (chain_of_chain_cons h), length, add_assoc, nat.mod_two_add_succ_mod_two] + end + +namespace chain' + +variables {l : list bool} + +theorem count_bnot_eq_count (hl : chain' (≠) l) (h2 : even (length l)) (b : bool) : + count (!b) l = count b l := +begin + cases l with x l, { refl }, + rw [length_cons, nat.even_add_one, nat.not_even_iff] at h2, + suffices : count (!x) (x :: l) = count x (x :: l), + { cases b; cases x; try { exact this }; exact this.symm }, + rw [count_cons_of_ne x.bnot_ne_self, hl.count_bnot, h2, count_cons_self] +end + +theorem count_ff_eq_count_tt (hl : chain' (≠) l) (h2 : even (length l)) : count ff l = count tt l := +hl.count_bnot_eq_count h2 tt + +lemma count_bnot_le_count_add_one (hl : chain' (≠) l) (b : bool) : + count (!b) l ≤ count b l + 1 := +begin + cases l with x l, { exact zero_le _ }, + obtain rfl | rfl : b = x ∨ b = !x, by simp only [bool.eq_bnot_iff, em], + { rw [count_cons_of_ne b.bnot_ne_self, count_cons_self, hl.count_bnot, add_assoc], + exact add_le_add_left (nat.mod_lt _ two_pos).le _ }, + { rw [bnot_bnot, count_cons_self, count_cons_of_ne x.bnot_ne_self, hl.count_bnot], + exact add_le_add_right (le_add_right le_rfl) _ } +end + +lemma count_ff_le_count_tt_add_one (hl : chain' (≠) l) : count ff l ≤ count tt l + 1 := +hl.count_bnot_le_count_add_one tt + +lemma count_tt_le_count_ff_add_one (hl : chain' (≠) l) : count tt l ≤ count ff l + 1 := +hl.count_bnot_le_count_add_one ff + +theorem two_mul_count_bool_of_even (hl : chain' (≠) l) (h2 : even (length l)) (b : bool) : + 2 * count b l = length l := +by rw [← count_bnot_add_count l b, hl.count_bnot_eq_count h2, two_mul] + +theorem two_mul_count_bool_eq_ite (hl : chain' (≠) l) (b : bool) : + 2 * count b l = if even (length l) then length l else + if b ∈ l.head' then length l + 1 else length l - 1 := +begin + by_cases h2 : even (length l), + { rw [if_pos h2, hl.two_mul_count_bool_of_even h2] }, + { cases l with x l, { exact (h2 even_zero).elim }, + simp only [if_neg h2, count_cons', mul_add, head', option.mem_some_iff, @eq_comm _ x], + rw [length_cons, nat.even_add_one, not_not] at h2, + replace hl : l.chain' (≠) := hl.tail, + rw [hl.two_mul_count_bool_of_even h2], + split_ifs; simp } +end + +theorem length_sub_one_le_two_mul_count_bool (hl : chain' (≠) l) (b : bool) : + length l - 1 ≤ 2 * count b l := +by { rw [hl.two_mul_count_bool_eq_ite], split_ifs; simp [le_tsub_add, nat.le_succ_of_le] } + +theorem length_div_two_le_count_bool (hl : chain' (≠) l) (b : bool) : length l / 2 ≤ count b l := +begin + rw [nat.div_le_iff_le_mul_add_pred two_pos, ← tsub_le_iff_right], + exact length_sub_one_le_two_mul_count_bool hl b +end + +lemma two_mul_count_bool_le_length_add_one (hl : chain' (≠) l) (b : bool) : + 2 * count b l ≤ length l + 1 := +by { rw [hl.two_mul_count_bool_eq_ite], split_ifs; simp [nat.le_succ_of_le] } + +end chain' + +end list diff --git a/src/data/bool/set.lean b/src/data/bool/set.lean index b911c3d8711dd..bc466d00bb3ee 100644 --- a/src/data/bool/set.lean +++ b/src/data/bool/set.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury G. Kudryashov -/ import data.bool.basic -import data.set.basic +import data.set.image /-! # Booleans and set operations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains two trivial lemmas about `bool`, `set.univ`, and `set.range`. -/ @@ -22,4 +25,7 @@ namespace bool @[simp] lemma range_eq {α : Type*} (f : bool → α) : range f = {f ff, f tt} := by rw [← image_univ, univ_eq, image_pair] +@[simp] lemma compl_singleton (b : bool) : ({b}ᶜ : set bool) = { !b } := +ext $ λ _, eq_bnot_iff.symm + end bool diff --git a/src/data/bracket.lean b/src/data/bracket.lean index f83892d912682..c0b544c455aed 100644 --- a/src/data/bracket.lean +++ b/src/data/bracket.lean @@ -7,6 +7,9 @@ Authors: Patrick Lutz, Oliver Nash /-! # Bracket Notation +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides notation which can be used for the Lie bracket, for the commutator of two subgroups, and for other similar operations. @@ -27,11 +30,11 @@ these are the Unicode "square with quill" brackets rather than the usual square `x`, `y` in a Lie algebra or the commutator of two elements `x` and `y` in a group. 2. for certain actions of one structure on another, like the action `⁅x, m⁆` of an element `x` - of a Lie algebra on an element `m` in one of its modules (analogous to `has_scalar` in the + of a Lie algebra on an element `m` in one of its modules (analogous to `has_smul` in the associative setting). 3. for binary operations on substructures, like the commutator `⁅H, K⁆` of two subgroups `H` and `K` of a group. -/ class has_bracket (L M : Type*) := (bracket : L → M → M) -notation `⁅`x`,` y`⁆` := has_bracket.bracket x y +notation `⁅`x`, `y`⁆` := has_bracket.bracket x y diff --git a/src/data/buffer/basic.lean b/src/data/buffer/basic.lean index 4ad7589694ea5..cdff3d2644bd8 100644 --- a/src/data/buffer/basic.lean +++ b/src/data/buffer/basic.lean @@ -5,9 +5,9 @@ Authors: Simon Hudon General utility functions for buffers. -/ -import data.buffer import data.array.lemmas import control.traversable.instances +import control.traversable.equiv namespace buffer @@ -189,7 +189,7 @@ lemma nth_le_to_list (b : buffer α) {i : ℕ} (h) : nth_le_to_list' _ _ _ lemma read_eq_nth_le_to_list (b : buffer α) (i) : - b.read i = b.to_list.nth_le i (by simpa using i.is_lt) := + b.read i = b.to_list.nth_le i (by simp) := by simp [nth_le_to_list] lemma read_singleton (c : α) : [c].to_buffer.read ⟨0, by simp⟩ = c := diff --git a/src/data/buffer/parser/basic.lean b/src/data/buffer/parser/basic.lean index 4c9b11621f64b..30f1b1f17d5ef 100644 --- a/src/data/buffer/parser/basic.lean +++ b/src/data/buffer/parser/basic.lean @@ -11,6 +11,9 @@ import data.buffer.parser /-! # Parsers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `parser α` is the type that describes a computation that can ingest a `char_buffer` and output, if successful, a term of type `α`. This file expands on the definitions in the core library, proving that all the core library diff --git a/src/data/buffer/parser/numeral.lean b/src/data/buffer/parser/numeral.lean index bbc5f7571d412..050b505ee8b8f 100644 --- a/src/data/buffer/parser/numeral.lean +++ b/src/data/buffer/parser/numeral.lean @@ -8,6 +8,9 @@ import data.buffer.parser.basic /-! # Numeral parsers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file expands on the existing `nat : parser ℕ` to provide parsers into any type `α` that can be represented by a numeral, which relies on `α` having a 0, 1, and addition operation. There are also convenience parsers that ensure that the numeral parsed in is not larger than @@ -116,4 +119,22 @@ do (sat (λ c, fromc ≤ c ∧ c.to_nat - fintype.card α < fromc.to_nat)), pure $ nat.bin_cast (c.to_nat - fromc.to_nat) +/-! ## Specific numeral types -/ + +/-- +Matches an integer, like `43` or `-2`. +Large numbers may cause performance issues, so don't run this parser on untrusted input. +-/ +def int : parser int := +(coe <$> nat) <|> (ch '-' >> has_neg.neg <$> coe <$> nat) + +/-- +Matches an rational number, like `43/1` or `-2/3`. +Requires that the negation is in the numerator, +and that both a numerator and denominator are provided (e.g. will not match `43`). +Large numbers may cause performance issues, so don't run this parser on untrusted input. +-/ +def rat : parser rat := +(λ x y, ↑x / ↑y) <$> int <*> (ch '/' >> nat) + end parser diff --git a/src/data/bundle.lean b/src/data/bundle.lean index b0bf890736593..b916ce0d12457 100644 --- a/src/data/bundle.lean +++ b/src/data/bundle.lean @@ -3,17 +3,38 @@ Copyright © 2021 Nicolò Cavalleri. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nicolò Cavalleri -/ - -import tactic.basic import algebra.module.basic /-! # Bundle + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. Basic data structure to implement fiber bundles, vector bundles (maybe fibrations?), etc. This file should contain all possible results that do not involve any topology. -We provide a type synonym of `Σ x, E x` as `bundle.total_space E`, to be able to endow it with -a topology which is not the disjoint union topology `sigma.topological_space`. In general, the -constructions of fiber bundles we will make will be of this form. + +We represent a bundle `E` over a base space `B` as a dependent type `E : B → Type*`. + +We define `bundle.total_space F E` to be the type of pairs `⟨b, x⟩`, where `b : B` and `x : E x`. +This type is isomorphic to `Σ x, E x` and uses an extra argument `F` for reasons explained below. In +general, the constructions of fiber bundles we will make will be of this form. + +## Main Definitions + +* `bundle.total_space` the total space of a bundle. +* `bundle.total_space.proj` the projection from the total space to the base space. +* `bundle.total_space.mk` the constructor for the total space. + +## Implementation Notes + +- We use a custom structure for the total space of a bundle instead of using a type synonym for the + canonical disjoint union `Σ x, E x` because the total space usually has a different topology and + Lean 4 `simp` fails to apply lemmas about `Σ x, E x` to elements of the total space. + +- The definition of `bundle.total_space` has an unused argument `F`. The reason is that in some + constructions (e.g., `bundle.continuous_linear_map.vector_bundle`) we need access to the atlas of + trivializations of original fiber bundles to construct the topology on the total space of the new + fiber bundle. ## References - https://en.wikipedia.org/wiki/Bundle_(mathematics) @@ -21,64 +42,102 @@ constructions of fiber bundles we will make will be of this form. namespace bundle -variables {B : Type*} (E : B → Type*) +variables {B F : Type*} (E : B → Type*) /-- -`total_space E` is the total space of the bundle `Σ x, E x`. This type synonym is used to avoid -conflicts with general sigma types. +`bundle.total_space E` is the total space of the bundle. It consists of pairs +`(proj : B, snd : E proj)`. -/ -def total_space := Σ x, E x +@[ext] +structure total_space (F : Type*) (E : B → Type*) := +(proj : B) +(snd : E proj) instance [inhabited B] [inhabited (E default)] : - inhabited (total_space E) := ⟨⟨default, default⟩⟩ + inhabited (total_space F E) := ⟨⟨default, default⟩⟩ + +variables {E} + +/-- `bundle.total_space.proj` is the canonical projection `bundle.total_space E → B` from the +total space to the base space. -/ +add_decl_doc total_space.proj -/-- `bundle.proj E` is the canonical projection `total_space E → B` on the base space. -/ -@[simp, reducible] def proj : total_space E → B := sigma.fst +-- this notation won't be used in the pretty-printer +localized "notation `π` := @bundle.total_space.proj _" in bundle -/-- Constructor for the total space of a `topological_fiber_bundle_core`. -/ -@[simp, reducible] def total_space_mk (E : B → Type*) (b : B) (a : E b) : - bundle.total_space E := ⟨b, a⟩ +-- TODO: try `abbrev` in Lean 4 +localized "notation `total_space.mk'` F:max := @bundle.total_space.mk _ F _" in bundle -instance {x : B} : has_coe_t (E x) (total_space E) := ⟨sigma.mk x⟩ +lemma total_space.mk_cast {x x' : B} (h : x = x') (b : E x) : + total_space.mk' F x' (cast (congr_arg E h) b) = total_space.mk x b := +by { subst h, refl } -@[simp] lemma coe_fst (x : B) (v : E x) : (v : total_space E).fst = x := rfl +instance {x : B} : has_coe_t (E x) (total_space F E) := ⟨total_space.mk x⟩ -lemma to_total_space_coe {x : B} (v : E x) : (v : total_space E) = ⟨x, v⟩ := rfl +@[simp] lemma total_space.coe_proj (x : B) (v : E x) : (v : total_space F E).proj = x := rfl +@[simp] lemma total_space.coe_snd {x : B} {y : E x} : (y : total_space F E).snd = y := rfl + +lemma total_space.coe_eq_mk {x : B} (v : E x) : (v : total_space F E) = total_space.mk x v := rfl + +lemma total_space.eta (z : total_space F E) : + total_space.mk z.proj z.2 = z := +by cases z; refl -- notation for the direct sum of two bundles over the same base -notation E₁ `×ᵇ`:100 E₂ := λ x, E₁ x × E₂ x +notation E₁ ` ×ᵇ `:100 E₂ := λ x, E₁ x × E₂ x /-- `bundle.trivial B F` is the trivial bundle over `B` of fiber `F`. -/ -def trivial (B : Type*) (F : Type*) : B → Type* := function.const B F - -instance {F : Type*} [inhabited F] {b : B} : inhabited (bundle.trivial B F b) := ⟨(default : F)⟩ +@[reducible, nolint unused_arguments] +def trivial (B : Type*) (F : Type*) : B → Type* := λ _, F /-- The trivial bundle, unlike other bundles, has a canonical projection on the fiber. -/ -def trivial.proj_snd (B : Type*) (F : Type*) : (total_space (bundle.trivial B F)) → F := sigma.snd +def total_space.trivial_snd (B : Type*) (F : Type*) : total_space F (bundle.trivial B F) → F := +total_space.snd -section fiber_structures +/-- A trivial bundle is equivalent to the product `B × F`. -/ +@[simps { attrs := [`simp, `mfld_simps] }] +def total_space.to_prod (B F : Type*) : total_space F (λ _ : B, F) ≃ B × F := +{ to_fun := λ x, (x.1, x.2), + inv_fun := λ x, ⟨x.1, x.2⟩, + left_inv := λ ⟨_, _⟩, rfl, + right_inv := λ ⟨_, _⟩, rfl } -variable [∀ x, add_comm_monoid (E x)] +section pullback -@[simp] lemma coe_snd_map_apply (x : B) (v w : E x) : - (↑(v + w) : total_space E).snd = (v : total_space E).snd + (w : total_space E).snd := rfl +variable {B' : Type*} -variables (R : Type*) [semiring R] [∀ x, module R (E x)] +/-- The pullback of a bundle `E` over a base `B` under a map `f : B' → B`, denoted by `pullback f E` +or `f *ᵖ E`, is the bundle over `B'` whose fiber over `b'` is `E (f b')`. -/ +def pullback (f : B' → B) (E : B → Type*) : B' → Type* := λ x, E (f x) -@[simp] lemma coe_snd_map_smul (x : B) (r : R) (v : E x) : - (↑(r • v) : total_space E).snd = r • (v : total_space E).snd := rfl +notation f ` *ᵖ ` E:max := pullback f E -end fiber_structures +instance {f : B' → B} {x : B'} [nonempty (E (f x))] : nonempty (f *ᵖ E x) := ‹nonempty (E (f x))› + +/-- Natural embedding of the total space of `f *ᵖ E` into `B' × total_space E`. -/ +@[simp] def pullback_total_space_embedding (f : B' → B) : + total_space F (f *ᵖ E) → B' × total_space F E := +λ z, (z.proj, total_space.mk (f z.proj) z.2) -section trivial_instances -local attribute [reducible] bundle.trivial +/-- The base map `f : B' → B` lifts to a canonical map on the total spaces. -/ +@[simps { attrs := [`simp, `mfld_simps] }] +def pullback.lift (f : B' → B) : total_space F (f *ᵖ E) → total_space F E := +λ z, ⟨f z.proj, z.2⟩ -variables {F : Type*} {R : Type*} [semiring R] (b : B) +@[simp, mfld_simps] lemma pullback.lift_mk (f : B' → B) (x : B') (y : E (f x)) : + pullback.lift f (total_space.mk' F x y) = ⟨f x, y⟩ := +rfl -instance [add_comm_monoid F] : add_comm_monoid (bundle.trivial B F b) := ‹add_comm_monoid F› -instance [add_comm_group F] : add_comm_group (bundle.trivial B F b) := ‹add_comm_group F› -instance [add_comm_monoid F] [module R F] : module R (bundle.trivial B F b) := ‹module R F› +end pullback -end trivial_instances +section fiber_structures + +@[simp] lemma coe_snd_map_apply [∀ x, has_add (E x)] (x : B) (v w : E x) : + (↑(v + w) : total_space F E).snd = (v : total_space F E).snd + (w : total_space F E).snd := rfl + +@[simp] lemma coe_snd_map_smul {R} [∀ x, has_smul R (E x)] (x : B) (r : R) (v : E x) : + (↑(r • v) : total_space F E).snd = r • (v : total_space F E).snd := rfl + +end fiber_structures end bundle diff --git a/src/data/char.lean b/src/data/char.lean index 70c6b1566c09a..886537912db32 100644 --- a/src/data/char.lean +++ b/src/data/char.lean @@ -7,6 +7,9 @@ Authors: Mario Carneiro /-! # More `char` instances +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides a `linear_order` instance on `char`. `char` is the type of Unicode scalar values. -/ diff --git a/src/data/complex/basic.lean b/src/data/complex/basic.lean index a68b5c91b8155..9644405e9b04f 100644 --- a/src/data/complex/basic.lean +++ b/src/data/complex/basic.lean @@ -8,12 +8,16 @@ import data.real.sqrt /-! # The complex numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The complex numbers are modelled as ℝ^2 in the obvious way and it is shown that they form a field of characteristic zero. The result that the complex numbers are algebraically closed, see `field_theory.algebraic_closure`. -/ open_locale big_operators +open set function /-! ### Definition and basic arithmmetic -/ @@ -30,7 +34,8 @@ open_locale complex_conjugate noncomputable instance : decidable_eq ℂ := classical.dec_eq _ /-- The equivalence between the complex numbers and `ℝ × ℝ`. -/ -@[simps] def equiv_real_prod : ℂ ≃ (ℝ × ℝ) := +@[simps apply] +def equiv_real_prod : ℂ ≃ (ℝ × ℝ) := { to_fun := λ z, ⟨z.re, z.im⟩, inv_fun := λ p, ⟨p.1, p.2⟩, left_inv := λ ⟨x, y⟩, rfl, @@ -44,7 +49,13 @@ theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w | ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im := -⟨λ H, by simp [H], and.rec ext⟩ +⟨λ H, by simp [H], λ h, ext h.1 h.2⟩ + +theorem re_surjective : surjective re := λ x, ⟨⟨x, 0⟩, rfl⟩ +theorem im_surjective : surjective im := λ y, ⟨⟨0, y⟩, rfl⟩ + +@[simp] theorem range_re : range re = univ := re_surjective.range_eq +@[simp] theorem range_im : range im = univ := im_surjective.range_eq instance : has_coe ℝ ℂ := ⟨λ r, ⟨r, 0⟩⟩ @@ -58,10 +69,8 @@ lemma of_real_def (r : ℝ) : (r : ℂ) = ⟨r, 0⟩ := rfl theorem of_real_injective : function.injective (coe : ℝ → ℂ) := λ z w, congr_arg re -instance : can_lift ℂ ℝ := -{ cond := λ z, z.im = 0, - coe := coe, - prf := λ z hz, ⟨z.re, ext rfl hz.symm⟩ } +instance can_lift : can_lift ℂ ℝ coe (λ z, z.im = 0) := +{ prf := λ z hz, ⟨z.re, ext rfl hz.symm⟩ } /-- The product of a set on the real axis and a set on the imaginary axis of the complex plane, denoted by `s ×ℂ t`. -/ @@ -153,34 +162,56 @@ lemma mul_I_im (z : ℂ) : (z * I).im = z.re := by simp lemma I_mul_re (z : ℂ) : (I * z).re = -z.im := by simp lemma I_mul_im (z : ℂ) : (I * z).im = z.re := by simp +@[simp] lemma equiv_real_prod_symm_apply (p : ℝ × ℝ) : + equiv_real_prod.symm p = p.1 + p.2 * I := +by { ext; simp [equiv_real_prod] } + /-! ### Commutative ring instance and lemmas -/ /- We use a nonstandard formula for the `ℕ` and `ℤ` actions to make sure there is no diamond from the other actions they inherit through the `ℝ`-action on `ℂ` and action transitivity defined in `data.complex.module.lean`. -/ -instance : comm_ring ℂ := + +instance : nontrivial ℂ := pullback_nonzero re rfl rfl + +instance : add_comm_group ℂ := by refine_struct { zero := (0 : ℂ), add := (+), neg := has_neg.neg, sub := has_sub.sub, - one := 1, - mul := (*), - zero_add := λ z, by { apply ext_iff.2, simp }, - add_zero := λ z, by { apply ext_iff.2, simp }, nsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩, - npow := @npow_rec _ ⟨(1 : ℂ)⟩ ⟨(*)⟩, zsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩ }; intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf} -/-- This shortcut instance ensures we do not find `add_comm_group` via the noncomputable -`complex.normed_group` instance. -/ -instance : add_comm_group ℂ := by apply_instance +instance : add_group_with_one ℂ := +{ nat_cast := λ n, ⟨n, 0⟩, + nat_cast_zero := by ext; simp [nat.cast], + nat_cast_succ := λ _, by ext; simp [nat.cast], + int_cast := λ n, ⟨n, 0⟩, + int_cast_of_nat := λ _, by ext; simp [λ n, show @coe ℕ ℂ ⟨_⟩ n = ⟨n, 0⟩, from rfl], + int_cast_neg_succ_of_nat := λ _, by ext; simp [λ n, show @coe ℕ ℂ ⟨_⟩ n = ⟨n, 0⟩, from rfl], + one := 1, + .. complex.add_comm_group } + +instance : comm_ring ℂ := +by refine_struct + { zero := (0 : ℂ), + add := (+), + one := 1, + mul := (*), + npow := @npow_rec _ ⟨(1 : ℂ)⟩ ⟨(*)⟩, + .. complex.add_group_with_one }; +intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf} /-- This shortcut instance ensures we do not find `ring` via the noncomputable `complex.field` instance. -/ instance : ring ℂ := by apply_instance +/-- This shortcut instance ensures we do not find `comm_semiring` via the noncomputable +`complex.field` instance. -/ +instance : comm_semiring ℂ := infer_instance + /-- The "real part" map, considered as an additive group homomorphism. -/ def re_add_group_hom : ℂ →+ ℝ := { to_fun := re, @@ -226,14 +257,14 @@ lemma conj_bit1 (z : ℂ) : conj (bit1 z) = bit1 (conj z) := ext_iff.2 $ by simp @[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp -lemma eq_conj_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r := +lemma conj_eq_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r := ⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩, λ ⟨h, e⟩, by rw [e, conj_of_real]⟩ -lemma eq_conj_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z := -eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩ +lemma conj_eq_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z := +conj_eq_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩ -lemma eq_conj_iff_im {z : ℂ} : conj z = z ↔ z.im = 0 := +lemma conj_eq_iff_im {z : ℂ} : conj z = z ↔ z.im = 0 := ⟨λ h, add_self_eq_zero.mp (neg_eq_iff_add_eq_zero.mp (congr_arg im h)), λ h, ext rfl (neg_eq_iff_add_eq_zero.mpr (add_self_eq_zero.mpr h))⟩ @@ -270,6 +301,10 @@ by { ext; simp [norm_sq, mul_comm], } lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z := add_nonneg (mul_self_nonneg _) (mul_self_nonneg _) +@[simp] lemma range_norm_sq : range norm_sq = Ici 0 := +subset.antisymm (range_subset_iff.2 norm_sq_nonneg) $ λ x hx, + ⟨real.sqrt x, by rw [norm_sq_of_real, real.mul_self_sqrt hx]⟩ + lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 := ⟨λ h, ext (eq_zero_of_mul_self_add_mul_self_eq_zero h) @@ -348,10 +383,9 @@ by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul, noncomputable instance : field ℂ := { inv := has_inv.inv, - exists_pair_ne := ⟨0, 1, mt (congr_arg re) zero_ne_one⟩, mul_inv_cancel := @complex.mul_inv_cancel, inv_zero := complex.inv_zero, - ..complex.comm_ring } + ..complex.comm_ring, ..complex.nontrivial } @[simp] lemma I_zpow_bit0 (n : ℤ) : I ^ (bit0 n) = (-1) ^ n := by rw [zpow_bit0', I_mul_I] @@ -367,10 +401,10 @@ by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm] lemma conj_inv (x : ℂ) : conj (x⁻¹) = (conj x)⁻¹ := star_inv' _ @[simp, norm_cast] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s := -of_real.map_div r s +map_div₀ of_real r s @[simp, norm_cast] lemma of_real_zpow (r : ℝ) (n : ℤ) : ((r ^ n : ℝ) : ℂ) = (r : ℂ) ^ n := -of_real.map_zpow r n +map_zpow₀ of_real r n @[simp] lemma div_I (z : ℂ) : z / I = -(z * I) := (div_eq_iff_mul_eq I_ne_zero).2 $ by simp [mul_assoc] @@ -379,10 +413,10 @@ of_real.map_zpow r n by simp [inv_eq_one_div] @[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ := -norm_sq.map_inv z +map_inv₀ norm_sq z @[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w := -norm_sq.map_div z w +map_div₀ norm_sq z w /-! ### Cast lemmas -/ @@ -395,8 +429,7 @@ by rw [← of_real_nat_cast, of_real_re] @[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℂ).im = 0 := by rw [← of_real_nat_cast, of_real_im] -@[simp, norm_cast] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : ℂ) = n := -of_real.map_int_cast n +@[simp, norm_cast] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : ℂ) = n := map_int_cast of_real n @[simp, norm_cast] lemma int_cast_re (n : ℤ) : (n : ℂ).re = n := by rw [← of_real_int_cast, of_real_re] @@ -421,19 +454,65 @@ by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h /-- A complex number `z` plus its conjugate `conj z` is `2` times its real part. -/ theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 := by simp only [add_conj, of_real_mul, of_real_one, of_real_bit0, - mul_div_cancel_left (z.re:ℂ) two_ne_zero'] + mul_div_cancel_left (z.re:ℂ) two_ne_zero] /-- A complex number `z` minus its conjugate `conj z` is `2i` times its imaginary part. -/ theorem im_eq_sub_conj (z : ℂ) : (z.im : ℂ) = (z - conj(z))/(2 * I) := by simp only [sub_conj, of_real_mul, of_real_one, of_real_bit0, mul_right_comm, - mul_div_cancel_left _ (mul_ne_zero two_ne_zero' I_ne_zero : 2 * I ≠ 0)] + mul_div_cancel_left _ (mul_ne_zero two_ne_zero I_ne_zero : 2 * I ≠ 0)] /-! ### Absolute value -/ +namespace abs_theory +-- We develop enough theory to bundle `abs` into an `absolute_value` before making things public; +-- this is so there's not two versions of it hanging around. + +local notation (name := abs) `abs` z := ((norm_sq z).sqrt) + +private lemma mul_self_abs (z : ℂ) : (abs z) * (abs z) = norm_sq z := +real.mul_self_sqrt (norm_sq_nonneg _) + +private lemma abs_nonneg' (z : ℂ) : 0 ≤ abs z := +real.sqrt_nonneg _ + +lemma abs_conj (z : ℂ) : (abs (conj z)) = abs z := +by simp + +private lemma abs_re_le_abs (z : ℂ) : |z.re| ≤ abs z := +begin + rw [mul_self_le_mul_self_iff (abs_nonneg z.re) (abs_nonneg' _), + abs_mul_abs_self, mul_self_abs], + apply re_sq_le_norm_sq +end + +private lemma re_le_abs (z : ℂ) : z.re ≤ abs z := +(abs_le.1 (abs_re_le_abs _)).2 + +private lemma abs_mul (z w : ℂ) : (abs (z * w)) = (abs z) * abs w := +by rw [norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)] + +private lemma abs_add (z w : ℂ) : (abs (z + w)) ≤ (abs z) + abs w := +(mul_self_le_mul_self_iff (abs_nonneg' (z + w)) + (add_nonneg (abs_nonneg' z) (abs_nonneg' w))).2 $ +begin + rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs, add_right_comm, norm_sq_add, + add_le_add_iff_left, mul_assoc, mul_le_mul_left (zero_lt_two' ℝ), + ←real.sqrt_mul $ norm_sq_nonneg z, ←norm_sq_conj w, ←map_mul], + exact re_le_abs (z * conj w) +end + /-- The complex absolute value function, defined as the square root of the norm squared. -/ -@[pp_nodot] noncomputable def abs (z : ℂ) : ℝ := (norm_sq z).sqrt +noncomputable def _root_.complex.abs : absolute_value ℂ ℝ := +{ to_fun := λ x, abs x, + map_mul' := abs_mul, + nonneg' := abs_nonneg', + eq_zero' := λ _, (real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero, + add_le' := abs_add } -local notation `abs'` := has_abs.abs +end abs_theory + +lemma abs_def : (abs : ℂ → ℝ) = λ z, (norm_sq z).sqrt := rfl +lemma abs_apply {z : ℂ} : abs z = (norm_sq z).sqrt := rfl @[simp, norm_cast] lemma abs_of_real (r : ℝ) : abs r = |r| := by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs] @@ -457,55 +536,32 @@ by rw [sq_abs, norm_sq_apply, ← sq, ← sq, add_sub_cancel'] @[simp] lemma sq_abs_sub_sq_im (z : ℂ) : abs z ^ 2 - z.im ^ 2 = z.re ^ 2 := by rw [← sq_abs_sub_sq_re, sub_sub_cancel] -@[simp] lemma abs_zero : abs 0 = 0 := by simp [abs] -@[simp] lemma abs_one : abs 1 = 1 := by simp [abs] @[simp] lemma abs_I : abs I = 1 := by simp [abs] @[simp] lemma abs_two : abs 2 = 2 := calc abs 2 = abs (2 : ℝ) : by rw [of_real_bit0, of_real_one] ... = (2 : ℝ) : abs_of_nonneg (by norm_num) -lemma abs_nonneg (z : ℂ) : 0 ≤ abs z := -real.sqrt_nonneg _ - -@[simp] lemma abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 := -(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero - -lemma abs_ne_zero {z : ℂ} : abs z ≠ 0 ↔ z ≠ 0 := -not_congr abs_eq_zero - -@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z := -by simp [abs] - -@[simp] lemma abs_mul (z w : ℂ) : abs (z * w) = abs z * abs w := -by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl +@[simp] lemma range_abs : range abs = Ici 0 := +subset.antisymm (range_subset_iff.2 abs.nonneg) $ λ x hx, ⟨x, abs_of_nonneg hx⟩ -/-- `complex.abs` as a `monoid_with_zero_hom`. -/ -@[simps] noncomputable def abs_hom : ℂ →*₀ ℝ := -{ to_fun := abs, - map_zero' := abs_zero, - map_one' := abs_one, - map_mul' := abs_mul } +@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z := abs_theory.abs_conj z @[simp] lemma abs_prod {ι : Type*} (s : finset ι) (f : ι → ℂ) : abs (s.prod f) = s.prod (λ i, abs (f i)) := -map_prod abs_hom _ _ +map_prod abs _ _ @[simp] lemma abs_pow (z : ℂ) (n : ℕ) : abs (z ^ n) = abs z ^ n := -map_pow abs_hom z n +map_pow abs z n @[simp] lemma abs_zpow (z : ℂ) (n : ℤ) : abs (z ^ n) = abs z ^ n := -abs_hom.map_zpow z n +map_zpow₀ abs z n lemma abs_re_le_abs (z : ℂ) : |z.re| ≤ abs z := -by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.re) (abs_nonneg _), - abs_mul_abs_self, mul_self_abs]; - apply re_sq_le_norm_sq +real.abs_le_sqrt $ by { rw [norm_sq_apply, ← sq], exact le_add_of_nonneg_right (mul_self_nonneg _) } lemma abs_im_le_abs (z : ℂ) : |z.im| ≤ abs z := -by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.im) (abs_nonneg _), - abs_mul_abs_self, mul_self_abs]; - apply im_sq_le_norm_sq +real.abs_le_sqrt $ by { rw [norm_sq_apply, ← sq, ← sq], exact le_add_of_nonneg_left (sq_nonneg _) } lemma re_le_abs (z : ℂ) : z.re ≤ abs z := (abs_le.1 (abs_re_le_abs _)).2 @@ -514,55 +570,37 @@ lemma im_le_abs (z : ℂ) : z.im ≤ abs z := (abs_le.1 (abs_im_le_abs _)).2 @[simp] lemma abs_re_lt_abs {z : ℂ} : |z.re| < abs z ↔ z.im ≠ 0 := -by rw [abs, real.lt_sqrt (_root_.abs_nonneg _), norm_sq_apply, _root_.sq_abs, ← sq, - lt_add_iff_pos_right, mul_self_pos] +by rw [abs, absolute_value.coe_mk, mul_hom.coe_mk, real.lt_sqrt (abs_nonneg _), norm_sq_apply, + _root_.sq_abs, ← sq, lt_add_iff_pos_right, mul_self_pos] @[simp] lemma abs_im_lt_abs {z : ℂ} : |z.im| < abs z ↔ z.re ≠ 0 := by simpa using @abs_re_lt_abs (z * I) -/-- -The **triangle inequality** for complex numbers. --/ -lemma abs_add (z w : ℂ) : abs (z + w) ≤ abs z + abs w := -(mul_self_le_mul_self_iff (abs_nonneg _) - (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $ -begin - rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs, - add_right_comm, norm_sq_add, add_le_add_iff_left, - mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _)], - simpa [-mul_re] using re_le_abs (z * conj w) -end - -instance : is_absolute_value abs := -{ abv_nonneg := abs_nonneg, - abv_eq_zero := λ _, abs_eq_zero, - abv_add := abs_add, - abv_mul := abs_mul } -open is_absolute_value - @[simp] lemma abs_abs (z : ℂ) : |(abs z)| = abs z := -_root_.abs_of_nonneg (abs_nonneg _) - -@[simp] lemma abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 := abv_pos abs -@[simp] lemma abs_neg : ∀ z, abs (-z) = abs z := abv_neg abs -lemma abs_sub_comm : ∀ z w, abs (z - w) = abs (w - z) := abv_sub abs -lemma abs_sub_le : ∀ a b c, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs -@[simp] theorem abs_inv : ∀ z, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs -@[simp] theorem abs_div : ∀ z w, abs (z / w) = abs z / abs w := abv_div abs - -lemma abs_abs_sub_le_abs_sub : ∀ z w, |abs z - abs w| ≤ abs (z - w) := -abs_abv_sub_le_abv_sub abs +_root_.abs_of_nonneg (abs.nonneg _) lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ |z.re| + |z.im| := -by simpa [re_add_im] using abs_add z.re (z.im * I) +by simpa [re_add_im] using abs.add_le z.re (z.im * I) + +lemma abs_le_sqrt_two_mul_max (z : ℂ) : abs z ≤ real.sqrt 2 * max (|z.re|) (|z.im|) := +begin + cases z with x y, + simp only [abs_apply, norm_sq_mk, ← sq], + wlog hle : |x| ≤ |y|, + { rw [add_comm, max_comm], exact this _ _ (le_of_not_le hle), }, + calc real.sqrt (x ^ 2 + y ^ 2) ≤ real.sqrt (y ^ 2 + y ^ 2) : + real.sqrt_le_sqrt (add_le_add_right (sq_le_sq.2 hle) _) + ... = real.sqrt 2 * max (|x|) (|y|) : + by rw [max_eq_right hle, ← two_mul, real.sqrt_mul two_pos.le, real.sqrt_sq_eq_abs], +end lemma abs_re_div_abs_le_one (z : ℂ) : |z.re / z.abs| ≤ 1 := if hz : z = 0 then by simp [hz, zero_le_one] -else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_re_le_abs] } +else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs.pos hz), one_mul, abs_re_le_abs] } lemma abs_im_div_abs_le_one (z : ℂ) : |z.im / z.abs| ≤ 1 := if hz : z = 0 then by simp [hz, zero_le_one] -else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_im_le_abs] } +else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs.pos hz), one_mul, abs_im_le_abs] } @[simp, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : ℂ) = n := by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)] @@ -571,7 +609,7 @@ by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)] by rw [← of_real_int_cast, abs_of_real, int.cast_abs] lemma norm_sq_eq_abs (x : ℂ) : norm_sq x = abs x ^ 2 := -by rw [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)] +by simp [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)] /-- We put a partial order on ℂ so that `z ≤ w` exactly if `w - z` is real and nonnegative. @@ -608,36 +646,39 @@ by rw [lt_def, not_and_distrib, not_lt] lemma not_le_zero_iff {z : ℂ} : ¬z ≤ 0 ↔ 0 < z.re ∨ z.im ≠ 0 := not_le_iff lemma not_lt_zero_iff {z : ℂ} : ¬z < 0 ↔ 0 ≤ z.re ∨ z.im ≠ 0 := not_lt_iff +lemma eq_re_of_real_le {r : ℝ} {z : ℂ} (hz : (r : ℂ) ≤ z) : z = z.re := +by { ext, refl, simp only [←(complex.le_def.1 hz).2, complex.zero_im, complex.of_real_im] } + /-- -With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is an ordered ring. +With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a strictly ordered ring. -/ -protected def ordered_comm_ring : ordered_comm_ring ℂ := +protected def strict_ordered_comm_ring : strict_ordered_comm_ring ℂ := { zero_le_one := ⟨zero_le_one, rfl⟩, add_le_add_left := λ w z h y, ⟨add_le_add_left h.1 _, congr_arg2 (+) rfl h.2⟩, mul_pos := λ z w hz hw, by simp [lt_def, mul_re, mul_im, ← hz.2, ← hw.2, mul_pos hz.1 hw.1], - .. complex.partial_order, - .. complex.comm_ring } + ..complex.partial_order, ..complex.comm_ring, ..complex.nontrivial } -localized "attribute [instance] complex.ordered_comm_ring" in complex_order +localized "attribute [instance] complex.strict_ordered_comm_ring" in complex_order /-- With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a star ordered ring. (That is, a star ring in which the nonnegative elements are those of the form `star z * z`.) -/ protected def star_ordered_ring : star_ordered_ring ℂ := -{ nonneg_iff := λ r, by - { refine ⟨λ hr, ⟨real.sqrt r.re, _⟩, λ h, _⟩, - { have h₁ : 0 ≤ r.re := by { rw [le_def] at hr, exact hr.1 }, - have h₂ : r.im = 0 := by { rw [le_def] at hr, exact hr.2.symm }, - ext, - { simp only [of_real_im, star_def, of_real_re, sub_zero, conj_re, mul_re, mul_zero, - ←real.sqrt_mul h₁ r.re, real.sqrt_mul_self h₁] }, - { simp only [h₂, add_zero, of_real_im, star_def, zero_mul, conj_im, - mul_im, mul_zero, neg_zero] } }, - { obtain ⟨s, rfl⟩ := h, - simp only [←norm_sq_eq_conj_mul_self, norm_sq_nonneg, zero_le_real, star_def] } }, - ..complex.ordered_comm_ring } +star_ordered_ring.of_nonneg_iff' (λ _ _, add_le_add_left) $ λ r, +begin + refine ⟨λ hr, ⟨real.sqrt r.re, _⟩, λ h, _⟩, + { have h₁ : 0 ≤ r.re := by { rw [le_def] at hr, exact hr.1 }, + have h₂ : r.im = 0 := by { rw [le_def] at hr, exact hr.2.symm }, + ext, + { simp only [of_real_im, star_def, of_real_re, sub_zero, conj_re, mul_re, mul_zero, + ←real.sqrt_mul h₁ r.re, real.sqrt_mul_self h₁] }, + { simp only [h₂, add_zero, of_real_im, star_def, zero_mul, conj_im, + mul_im, mul_zero, neg_zero] } }, + { obtain ⟨s, rfl⟩ := h, + simp only [←norm_sq_eq_conj_mul_self, norm_sq_nonneg, zero_le_real, star_def] }, +end localized "attribute [instance] complex.star_ordered_ring" in complex_order @@ -645,6 +686,8 @@ end complex_order /-! ### Cauchy sequences -/ +local notation `abs'` := has_abs.abs + theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) := λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij, lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij) @@ -664,7 +707,7 @@ noncomputable def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs' := lemma is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) : is_cau_seq abs' (abs ∘ f) := λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in -⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩ +⟨i, λ j hj, lt_of_le_of_lt (abs.abs_abv_sub_le_abv_sub _ _) (hi j hj)⟩ /-- The limit of a Cauchy sequence of complex numbers. -/ noncomputable def lim_aux (f : cau_seq ℂ abs) : ℂ := @@ -719,14 +762,22 @@ noncomputable def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs' := lemma lim_abs (f : cau_seq ℂ abs) : lim (cau_seq_abs f) = abs (lim f) := lim_eq_of_equiv_const (λ ε ε0, let ⟨i, hi⟩ := equiv_lim f ε ε0 in -⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩) +⟨i, λ j hj, lt_of_le_of_lt (abs.abs_abv_sub_le_abv_sub _ _) (hi j hj)⟩) -@[simp, norm_cast] lemma of_real_prod {α : Type*} (s : finset α) (f : α → ℝ) : +variables {α : Type*} (s : finset α) + +@[simp, norm_cast] lemma of_real_prod (f : α → ℝ) : ((∏ i in s, f i : ℝ) : ℂ) = ∏ i in s, (f i : ℂ) := ring_hom.map_prod of_real _ _ -@[simp, norm_cast] lemma of_real_sum {α : Type*} (s : finset α) (f : α → ℝ) : +@[simp, norm_cast] lemma of_real_sum (f : α → ℝ) : ((∑ i in s, f i : ℝ) : ℂ) = ∑ i in s, (f i : ℂ) := ring_hom.map_sum of_real _ _ +@[simp] lemma re_sum (f : α → ℂ) : (∑ i in s, f i).re = ∑ i in s, (f i).re := +re_add_group_hom.map_sum f s + +@[simp] lemma im_sum (f : α → ℂ) : (∑ i in s, f i).im = ∑ i in s, (f i).im := +im_add_group_hom.map_sum f s + end complex diff --git a/src/data/complex/cardinality.lean b/src/data/complex/cardinality.lean index ca811fe49ad88..7b1ff847899bc 100644 --- a/src/data/complex/cardinality.lean +++ b/src/data/complex/cardinality.lean @@ -10,6 +10,9 @@ import data.real.cardinality /-! # The cardinality of the complex numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file shows that the complex numbers have cardinality continuum, i.e. `#ℂ = 𝔠`. -/ @@ -26,5 +29,5 @@ by rw [mk_congr complex.equiv_real_prod, mk_prod, lift_id, mk_real, continuum_mu by rw [mk_univ, mk_complex] /-- The complex numbers are not countable. -/ -lemma not_countable_complex : ¬ countable (set.univ : set ℂ) := -by { rw [← mk_set_le_omega, not_le, mk_univ_complex], apply cantor } +lemma not_countable_complex : ¬ (set.univ : set ℂ).countable := +by { rw [← le_aleph_0_iff_set_countable, not_le, mk_univ_complex], apply cantor } diff --git a/src/data/complex/determinant.lean b/src/data/complex/determinant.lean index 7e1fc42dd016c..331fdff1eb76b 100644 --- a/src/data/complex/determinant.lean +++ b/src/data/complex/determinant.lean @@ -9,6 +9,9 @@ import linear_algebra.determinant /-! # Determinants of maps in the complex numbers as a vector space over `ℝ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides results about the determinants of maps in the complex numbers as a vector space over `ℝ`. @@ -19,7 +22,7 @@ namespace complex /-- The determinant of `conj_ae`, as a linear map. -/ @[simp] lemma det_conj_ae : conj_ae.to_linear_map.det = -1 := begin - rw [←linear_map.det_to_matrix basis_one_I, to_matrix_conj_ae, matrix.det_fin_two], + rw [←linear_map.det_to_matrix basis_one_I, to_matrix_conj_ae, matrix.det_fin_two_of], simp end diff --git a/src/data/complex/exponential.lean b/src/data/complex/exponential.lean index 5f26576b36824..4bdb7cd7d4d5c 100644 --- a/src/data/complex/exponential.lean +++ b/src/data/complex/exponential.lean @@ -10,6 +10,9 @@ import data.nat.choose.sum /-! # Exponential, trigonometric and hyperbolic trigonometric functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definitions of the real and complex exponential, sine, cosine, tangent, hyperbolic sine, hyperbolic cosine, and hyperbolic tangent functions. @@ -117,10 +120,7 @@ lemma is_cau_geo_series {β : Type*} [ring β] [nontrivial β] {abv : β → α} have hx1' : abv x ≠ 1 := λ h, by simpa [h, lt_irrefl] using hx1, is_cau_series_of_abv_cau begin - simp only [abv_pow abv] {eta := ff}, - have : (λ (m : ℕ), ∑ n in range m, (abv x) ^ n) = - λ m, geom_sum (abv x) m := rfl, - simp only [this, geom_sum_eq hx1'] {eta := ff}, + simp only [abv_pow abv, geom_sum_eq hx1'], conv in (_ / _) { rw [← neg_div_neg_eq, neg_sub, neg_sub] }, refine @is_cau_of_mono_bounded _ _ _ _ ((1 : α) / (1 - abv x)) 0 _ _, { assume n hn, @@ -163,7 +163,7 @@ begin have r_pos : 0 < r := lt_of_le_of_ne hr0 (ne.symm r_ne_zero), replace hk : m = k + n.succ := (tsub_eq_iff_eq_add_of_le hmn).1 hk, induction k with k ih generalizing m n, - { rw [hk, zero_add, mul_right_comm, inv_pow₀ _ _, ← div_eq_mul_inv, mul_div_cancel], + { rw [hk, zero_add, mul_right_comm, inv_pow _ _, ← div_eq_mul_inv, mul_div_cancel], exact (ne_of_lt (pow_pos r_pos _)).symm }, { have kn : k + n.succ ≥ n.succ, by rw ← zero_add n.succ; exact add_le_add (zero_le _) (by simp), rw [hk, nat.succ_add, pow_succ' r, ← mul_assoc], @@ -247,8 +247,8 @@ have two_mul_two : (4 : α) = 2 * 2, by norm_num, have hQ0 : Q ≠ 0, from λ h, by simpa [h, lt_irrefl] using hQε0, have h2Q0 : 2 * Q ≠ 0, from mul_ne_zero two_ne_zero hQ0, have hε : ε / (2 * P) * P + ε / (4 * Q) * (2 * Q) = ε, - by rw [← div_div_eq_div_mul, div_mul_cancel _ (ne.symm (ne_of_lt hP0)), - two_mul_two, mul_assoc, ← div_div_eq_div_mul, div_mul_cancel _ h2Q0, add_halves], + by rw [← div_div, div_mul_cancel _ (ne.symm (ne_of_lt hP0)), + two_mul_two, mul_assoc, ← div_div, div_mul_cancel _ h2Q0, add_halves], have hNMK : max N M + 1 < K, from lt_of_lt_of_le (by rw two_mul; exact lt_add_of_pos_left _ (nat.succ_pos _)) hK, have hKN : N < K, @@ -316,16 +316,16 @@ namespace complex lemma is_cau_abs_exp (z : ℂ) : is_cau_seq has_abs.abs (λ n, ∑ m in range n, abs (z ^ m / m!)) := let ⟨n, hn⟩ := exists_nat_gt (abs z) in -have hn0 : (0 : ℝ) < n, from lt_of_le_of_lt (abs_nonneg _) hn, -series_ratio_test n (complex.abs z / n) (div_nonneg (complex.abs_nonneg _) (le_of_lt hn0)) +have hn0 : (0 : ℝ) < n, from lt_of_le_of_lt (abs.nonneg _) hn, +series_ratio_test n (complex.abs z / n) (div_nonneg (abs.nonneg _) (le_of_lt hn0)) (by rwa [div_lt_iff hn0, one_mul]) (λ m hm, by rw [abs_abs, abs_abs, nat.factorial_succ, pow_succ, - mul_comm m.succ, nat.cast_mul, ← div_div_eq_div_mul, mul_div_assoc, - mul_div_right_comm, abs_mul, abs_div, abs_cast_nat]; + mul_comm m.succ, nat.cast_mul, ← div_div, mul_div_assoc, + mul_div_right_comm, abs.map_mul, map_div₀, abs_cast_nat]; exact mul_le_mul_of_nonneg_right - (div_le_div_of_le_left (abs_nonneg _) hn0 - (nat.cast_le.2 (le_trans hm (nat.le_succ _)))) (abs_nonneg _)) + (div_le_div_of_le_left (abs.nonneg _) hn0 + (nat.cast_le.2 (le_trans hm (nat.le_succ _)))) (abs.nonneg _)) noncomputable theory @@ -340,7 +340,7 @@ the complex exponential function -/ ⟨λ n, ∑ m in range n, z ^ m / m!, is_cau_exp z⟩ /-- The complex exponential function, defined via its Taylor series -/ -@[pp_nodot] def exp (z : ℂ) : ℂ := lim (exp' z) +@[irreducible, pp_nodot] def exp (z : ℂ) : ℂ := lim (exp' z) /-- The complex sine function, defined via `exp` -/ @[pp_nodot] def sin (z : ℂ) : ℂ := ((exp (-z * I) - exp (z * I)) * I) / 2 @@ -395,8 +395,9 @@ namespace complex variables (x y : ℂ) @[simp] lemma exp_zero : exp 0 = 1 := -lim_eq_of_equiv_const $ - λ ε ε0, ⟨1, λ j hj, begin +begin + rw exp, + refine lim_eq_of_equiv_const (λ ε ε0, ⟨1, λ j hj, _⟩), convert ε0, cases j, { exact absurd hj (not_le_of_gt zero_lt_one) }, @@ -406,33 +407,29 @@ lim_eq_of_equiv_const $ { rw ← ih dec_trivial, simp only [sum_range_succ, pow_succ], simp } } -end⟩ +end lemma exp_add : exp (x + y) = exp x * exp y := -show lim (⟨_, is_cau_exp (x + y)⟩ : cau_seq ℂ abs) = - lim (show cau_seq ℂ abs, from ⟨_, is_cau_exp x⟩) - * lim (show cau_seq ℂ abs, from ⟨_, is_cau_exp y⟩), -from -have hj : ∀ j : ℕ, ∑ m in range j, (x + y) ^ m / m! = - ∑ i in range j, ∑ k in range (i + 1), x ^ k / k! * (y ^ (i - k) / (i - k)!), - from assume j, - finset.sum_congr rfl (λ m hm, begin - rw [add_pow, div_eq_mul_inv, sum_mul], - refine finset.sum_congr rfl (λ i hi, _), - have h₁ : (m.choose i : ℂ) ≠ 0 := nat.cast_ne_zero.2 - (pos_iff_ne_zero.1 (nat.choose_pos (nat.le_of_lt_succ (mem_range.1 hi)))), - have h₂ := nat.choose_mul_factorial_mul_factorial (nat.le_of_lt_succ $ finset.mem_range.1 hi), - rw [← h₂, nat.cast_mul, nat.cast_mul, mul_inv₀, mul_inv₀], - simp only [mul_left_comm (m.choose i : ℂ), mul_assoc, mul_left_comm (m.choose i : ℂ)⁻¹, - mul_comm (m.choose i : ℂ)], - rw inv_mul_cancel h₁, - simp [div_eq_mul_inv, mul_comm, mul_assoc, mul_left_comm] - end), -by rw lim_mul_lim; - exact eq.symm (lim_eq_lim_of_equiv (by dsimp; simp only [hj]; - exact cauchy_product (is_cau_abs_exp x) (is_cau_exp y))) - -attribute [irreducible] complex.exp +begin + have hj : ∀ j : ℕ, ∑ m in range j, (x + y) ^ m / m! = + ∑ i in range j, ∑ k in range (i + 1), x ^ k / k! * (y ^ (i - k) / (i - k)!), + { assume j, + refine finset.sum_congr rfl (λ m hm, _), + rw [add_pow, div_eq_mul_inv, sum_mul], + refine finset.sum_congr rfl (λ i hi, _), + have h₁ : (m.choose i : ℂ) ≠ 0 := nat.cast_ne_zero.2 + (pos_iff_ne_zero.1 (nat.choose_pos (nat.le_of_lt_succ (mem_range.1 hi)))), + have h₂ := nat.choose_mul_factorial_mul_factorial (nat.le_of_lt_succ $ finset.mem_range.1 hi), + rw [← h₂, nat.cast_mul, nat.cast_mul, mul_inv, mul_inv], + simp only [mul_left_comm (m.choose i : ℂ), mul_assoc, mul_left_comm (m.choose i : ℂ)⁻¹, + mul_comm (m.choose i : ℂ)], + rw inv_mul_cancel h₁, + simp [div_eq_mul_inv, mul_comm, mul_assoc, mul_left_comm] }, + simp_rw [exp, exp', lim_mul_lim], + apply (lim_eq_lim_of_equiv _).symm, + simp only [hj], + exact cauchy_product (is_cau_abs_exp x) (is_cau_exp y) +end lemma exp_list_sum (l : list ℂ) : exp l.sum = (l.map exp).prod := @monoid_hom.map_list_prod (multiplicative ℂ) ℂ _ _ ⟨exp, exp_zero, exp_add⟩ l @@ -473,11 +470,11 @@ begin dsimp [exp', function.comp, cau_seq_conj], rw (star_ring_end _).map_sum, refine sum_congr rfl (λ n hn, _), - rw [ring_hom.map_div, ring_hom.map_pow, ← of_real_nat_cast, conj_of_real] + rw [map_div₀, map_pow, ← of_real_nat_cast, conj_of_real] end @[simp] lemma of_real_exp_of_real_re (x : ℝ) : ((exp x).re : ℂ) = exp x := -eq_conj_iff_re.1 $ by rw [← exp_conj, conj_of_real] +conj_eq_iff_re.1 $ by rw [← exp_conj, conj_of_real] @[simp, norm_cast] lemma of_real_exp (x : ℝ) : (real.exp x : ℂ) = exp x := of_real_exp_of_real_re _ @@ -488,10 +485,10 @@ by rw [← of_real_exp_of_real_re, of_real_im] lemma exp_of_real_re (x : ℝ) : (exp x).re = real.exp x := rfl lemma two_sinh : 2 * sinh x = exp x - exp (-x) := -mul_div_cancel' _ two_ne_zero' +mul_div_cancel' _ two_ne_zero lemma two_cosh : 2 * cosh x = exp x + exp (-x) := -mul_div_cancel' _ two_ne_zero' +mul_div_cancel' _ two_ne_zero @[simp] lemma sinh_zero : sinh 0 = 0 := by simp [sinh] @@ -503,10 +500,10 @@ private lemma sinh_add_aux {a b c d : ℂ} : lemma sinh_add : sinh (x + y) = sinh x * cosh y + cosh x * sinh y := begin - rw [← mul_right_inj' (@two_ne_zero' ℂ _ _ _), two_sinh, + rw [← mul_right_inj' (two_ne_zero' ℂ), two_sinh, exp_add, neg_add, exp_add, eq_comm, mul_add, ← mul_assoc, two_sinh, mul_left_comm, two_sinh, - ← mul_right_inj' (@two_ne_zero' ℂ _ _ _), mul_add, + ← mul_right_inj' (two_ne_zero' ℂ), mul_add, mul_left_comm, two_cosh, ← mul_assoc, two_cosh], exact sinh_add_aux end @@ -521,10 +518,10 @@ private lemma cosh_add_aux {a b c d : ℂ} : lemma cosh_add : cosh (x + y) = cosh x * cosh y + sinh x * sinh y := begin - rw [← mul_right_inj' (@two_ne_zero' ℂ _ _ _), two_cosh, + rw [← mul_right_inj' (two_ne_zero' ℂ), two_cosh, exp_add, neg_add, exp_add, eq_comm, mul_add, ← mul_assoc, two_cosh, ← mul_assoc, two_sinh, - ← mul_right_inj' (@two_ne_zero' ℂ _ _ _), mul_add, + ← mul_right_inj' (two_ne_zero' ℂ), mul_add, mul_left_comm, two_cosh, mul_left_comm, two_sinh], exact cosh_add_aux end @@ -537,10 +534,10 @@ by simp [sub_eq_add_neg, cosh_add, sinh_neg, cosh_neg] lemma sinh_conj : sinh (conj x) = conj (sinh x) := by rw [sinh, ← ring_hom.map_neg, exp_conj, exp_conj, ← ring_hom.map_sub, sinh, - ring_hom.map_div, conj_bit0, ring_hom.map_one] + map_div₀, conj_bit0, ring_hom.map_one] @[simp] lemma of_real_sinh_of_real_re (x : ℝ) : ((sinh x).re : ℂ) = sinh x := -eq_conj_iff_re.1 $ by rw [← sinh_conj, conj_of_real] +conj_eq_iff_re.1 $ by rw [← sinh_conj, conj_of_real] @[simp, norm_cast] lemma of_real_sinh (x : ℝ) : (real.sinh x : ℂ) = sinh x := of_real_sinh_of_real_re _ @@ -553,11 +550,11 @@ lemma sinh_of_real_re (x : ℝ) : (sinh x).re = real.sinh x := rfl lemma cosh_conj : cosh (conj x) = conj (cosh x) := begin rw [cosh, ← ring_hom.map_neg, exp_conj, exp_conj, ← ring_hom.map_add, cosh, - ring_hom.map_div, conj_bit0, ring_hom.map_one] + map_div₀, conj_bit0, ring_hom.map_one] end -@[simp] lemma of_real_cosh_of_real_re (x : ℝ) : ((cosh x).re : ℂ) = cosh x := -eq_conj_iff_re.1 $ by rw [← cosh_conj, conj_of_real] +lemma of_real_cosh_of_real_re (x : ℝ) : ((cosh x).re : ℂ) = cosh x := +conj_eq_iff_re.1 $ by rw [← cosh_conj, conj_of_real] @[simp, norm_cast] lemma of_real_cosh (x : ℝ) : (real.cosh x : ℂ) = cosh x := of_real_cosh_of_real_re _ @@ -565,7 +562,7 @@ of_real_cosh_of_real_re _ @[simp] lemma cosh_of_real_im (x : ℝ) : (cosh x).im = 0 := by rw [← of_real_cosh_of_real_re, of_real_im] -lemma cosh_of_real_re (x : ℝ) : (cosh x).re = real.cosh x := rfl +@[simp] lemma cosh_of_real_re (x : ℝ) : (cosh x).re = real.cosh x := rfl lemma tanh_eq_sinh_div_cosh : tanh x = sinh x / cosh x := rfl @@ -574,10 +571,10 @@ lemma tanh_eq_sinh_div_cosh : tanh x = sinh x / cosh x := rfl @[simp] lemma tanh_neg : tanh (-x) = -tanh x := by simp [tanh, neg_div] lemma tanh_conj : tanh (conj x) = conj (tanh x) := -by rw [tanh, sinh_conj, cosh_conj, ← ring_hom.map_div, tanh] +by rw [tanh, sinh_conj, cosh_conj, ← map_div₀, tanh] @[simp] lemma of_real_tanh_of_real_re (x : ℝ) : ((tanh x).re : ℂ) = tanh x := -eq_conj_iff_re.1 $ by rw [← tanh_conj, conj_of_real] +conj_eq_iff_re.1 $ by rw [← tanh_conj, conj_of_real] @[simp, norm_cast] lemma of_real_tanh (x : ℝ) : (real.tanh x : ℂ) = tanh x := of_real_tanh_of_real_re _ @@ -587,18 +584,27 @@ by rw [← of_real_tanh_of_real_re, of_real_im] lemma tanh_of_real_re (x : ℝ) : (tanh x).re = real.tanh x := rfl -lemma cosh_add_sinh : cosh x + sinh x = exp x := -by rw [← mul_right_inj' (@two_ne_zero' ℂ _ _ _), mul_add, +@[simp] lemma cosh_add_sinh : cosh x + sinh x = exp x := +by rw [← mul_right_inj' (two_ne_zero' ℂ), mul_add, two_cosh, two_sinh, add_add_sub_cancel, two_mul] -lemma sinh_add_cosh : sinh x + cosh x = exp x := +@[simp] lemma sinh_add_cosh : sinh x + cosh x = exp x := by rw [add_comm, cosh_add_sinh] -lemma cosh_sub_sinh : cosh x - sinh x = exp (-x) := -by rw [← mul_right_inj' (@two_ne_zero' ℂ _ _ _), mul_sub, +@[simp] lemma exp_sub_cosh : exp x - cosh x = sinh x := +sub_eq_iff_eq_add.2 (sinh_add_cosh x).symm + +@[simp] lemma exp_sub_sinh : exp x - sinh x = cosh x := +sub_eq_iff_eq_add.2 (cosh_add_sinh x).symm + +@[simp] lemma cosh_sub_sinh : cosh x - sinh x = exp (-x) := +by rw [← mul_right_inj' (two_ne_zero' ℂ), mul_sub, two_cosh, two_sinh, add_sub_sub_cancel, two_mul] -lemma cosh_sq_sub_sinh_sq : cosh x ^ 2 - sinh x ^ 2 = 1 := +@[simp] lemma sinh_sub_cosh : sinh x - cosh x = -exp (-x) := +by rw [← neg_sub, cosh_sub_sinh] + +@[simp] lemma cosh_sq_sub_sinh_sq : cosh x ^ 2 - sinh x ^ 2 = 1 := by rw [sq_sub_sq, cosh_add_sinh, cosh_sub_sinh, ← exp_add, add_neg_self, exp_zero] lemma cosh_sq : cosh x ^ 2 = sinh x ^ 2 + 1 := @@ -648,18 +654,18 @@ end by simp [sin, sub_eq_add_neg, exp_neg, (neg_div _ _).symm, add_mul] lemma two_sin : 2 * sin x = (exp (-x * I) - exp (x * I)) * I := -mul_div_cancel' _ two_ne_zero' +mul_div_cancel' _ two_ne_zero lemma two_cos : 2 * cos x = exp (x * I) + exp (-x * I) := -mul_div_cancel' _ two_ne_zero' +mul_div_cancel' _ two_ne_zero lemma sinh_mul_I : sinh (x * I) = sin x * I := -by rw [← mul_right_inj' (@two_ne_zero' ℂ _ _ _), two_sinh, +by rw [← mul_right_inj' (two_ne_zero' ℂ), two_sinh, ← mul_assoc, two_sin, mul_assoc, I_mul_I, mul_neg_one, neg_sub, neg_mul_eq_neg_mul] lemma cosh_mul_I : cosh (x * I) = cos x := -by rw [← mul_right_inj' (@two_ne_zero' ℂ _ _ _), two_cosh, +by rw [← mul_right_inj' (two_ne_zero' ℂ), two_cosh, two_cos, neg_mul_eq_neg_mul] lemma tanh_mul_I : tanh (x * I) = tan x * I := @@ -751,7 +757,7 @@ by rw [← mul_left_inj' I_ne_zero, ← sinh_mul_I, mul_neg, sinh_neg, sinh_mul_I, mul_neg] @[simp] lemma of_real_sin_of_real_re (x : ℝ) : ((sin x).re : ℂ) = sin x := -eq_conj_iff_re.1 $ by rw [← sin_conj, conj_of_real] +conj_eq_iff_re.1 $ by rw [← sin_conj, conj_of_real] @[simp, norm_cast] lemma of_real_sin (x : ℝ) : (real.sin x : ℂ) = sin x := of_real_sin_of_real_re _ @@ -766,7 +772,7 @@ by rw [← cosh_mul_I, ← conj_neg_I, ← ring_hom.map_mul, ← cosh_mul_I, cosh_conj, mul_neg, cosh_neg] @[simp] lemma of_real_cos_of_real_re (x : ℝ) : ((cos x).re : ℂ) = cos x := -eq_conj_iff_re.1 $ by rw [← cos_conj, conj_of_real] +conj_eq_iff_re.1 $ by rw [← cos_conj, conj_of_real] @[simp, norm_cast] lemma of_real_cos (x : ℝ) : (real.cos x : ℂ) = cos x := of_real_cos_of_real_re _ @@ -786,10 +792,10 @@ by rw [tan_eq_sin_div_cos, div_mul_cancel _ hx] @[simp] lemma tan_neg : tan (-x) = -tan x := by simp [tan, neg_div] lemma tan_conj : tan (conj x) = conj (tan x) := -by rw [tan, sin_conj, cos_conj, ← ring_hom.map_div, tan] +by rw [tan, sin_conj, cos_conj, ← map_div₀, tan] @[simp] lemma of_real_tan_of_real_re (x : ℝ) : ((tan x).re : ℂ) = tan x := -eq_conj_iff_re.1 $ by rw [← tan_conj, conj_of_real] +conj_eq_iff_re.1 $ by rw [← tan_conj, conj_of_real] @[simp, norm_cast] lemma of_real_tan (x : ℝ) : (real.tan x : ℂ) = tan x := of_real_tan_of_real_re _ @@ -824,7 +830,7 @@ lemma sin_two_mul : sin (2 * x) = 2 * sin x * cos x := by rw [two_mul, sin_add, two_mul, add_mul, mul_comm] lemma cos_sq : cos x ^ 2 = 1 / 2 + cos (2 * x) / 2 := -by simp [cos_two_mul, div_add_div_same, mul_div_cancel_left, two_ne_zero', -one_div] +by simp [cos_two_mul, div_add_div_same, mul_div_cancel_left, two_ne_zero, -one_div] lemma cos_sq' : cos x ^ 2 = 1 - sin x ^ 2 := by rw [←sin_sq_add_cos_sq x, add_sub_cancel'] @@ -1071,7 +1077,7 @@ by rw ← of_real_inj; simp [sin_three_mul] /-- The definition of `sinh` in terms of `exp`. -/ lemma sinh_eq (x : ℝ) : sinh x = (exp x - exp (-x)) / 2 := eq_div_of_mul_eq two_ne_zero $ by rw [sinh, exp, exp, complex.of_real_neg, complex.sinh, mul_two, - ← complex.add_re, ← mul_two, div_mul_cancel _ (two_ne_zero' : (2 : ℂ) ≠ 0), complex.sub_re] + ← complex.add_re, ← mul_two, div_mul_cancel _ (two_ne_zero' ℂ), complex.sub_re] @[simp] lemma sinh_zero : sinh 0 = 0 := by simp [sinh] @@ -1084,15 +1090,17 @@ by rw ← of_real_inj; simp [sinh_add] /-- The definition of `cosh` in terms of `exp`. -/ lemma cosh_eq (x : ℝ) : cosh x = (exp x + exp (-x)) / 2 := eq_div_of_mul_eq two_ne_zero $ by rw [cosh, exp, exp, complex.of_real_neg, complex.cosh, mul_two, - ← complex.add_re, ← mul_two, div_mul_cancel _ (two_ne_zero' : (2 : ℂ) ≠ 0), complex.add_re] + ← complex.add_re, ← mul_two, div_mul_cancel _ (two_ne_zero' ℂ), complex.add_re] @[simp] lemma cosh_zero : cosh 0 = 1 := by simp [cosh] -@[simp] lemma cosh_neg : cosh (-x) = cosh x := -by simp [cosh, exp_neg] +@[simp] lemma cosh_neg : cosh (-x) = cosh x := of_real_inj.1 $ by simp + +@[simp] lemma cosh_abs : cosh (|x|) = cosh x := +by cases le_total x 0; simp [*, _root_.abs_of_nonneg, abs_of_nonpos] lemma cosh_add : cosh (x + y) = cosh x * cosh y + sinh x * sinh y := -by rw ← of_real_inj; simp [cosh, cosh_add] +by rw ← of_real_inj; simp [cosh_add] lemma sinh_sub : sinh (x - y) = sinh x * cosh y - cosh x * sinh y := by simp [sub_eq_add_neg, sinh_add, sinh_neg, cosh_neg] @@ -1107,18 +1115,33 @@ of_real_inj.1 $ by simp [tanh_eq_sinh_div_cosh] @[simp] lemma tanh_neg : tanh (-x) = -tanh x := by simp [tanh, neg_div] -lemma cosh_add_sinh : cosh x + sinh x = exp x := -by rw ← of_real_inj; simp [cosh_add_sinh] +@[simp] lemma cosh_add_sinh : cosh x + sinh x = exp x := +by rw ← of_real_inj; simp + +@[simp] lemma sinh_add_cosh : sinh x + cosh x = exp x := +by rw [add_comm, cosh_add_sinh] + +@[simp] lemma exp_sub_cosh : exp x - cosh x = sinh x := +sub_eq_iff_eq_add.2 (sinh_add_cosh x).symm + +@[simp] lemma exp_sub_sinh : exp x - sinh x = cosh x := +sub_eq_iff_eq_add.2 (cosh_add_sinh x).symm -lemma sinh_add_cosh : sinh x + cosh x = exp x := -by rw ← of_real_inj; simp [sinh_add_cosh] +@[simp] lemma cosh_sub_sinh : cosh x - sinh x = exp (-x) := +by { rw [← of_real_inj], simp } -lemma cosh_sq_sub_sinh_sq (x : ℝ) : cosh x ^ 2 - sinh x ^ 2 = 1 := -by rw ← of_real_inj; simp [cosh_sq_sub_sinh_sq] +@[simp] lemma sinh_sub_cosh : sinh x - cosh x = -exp (-x) := +by rw [← neg_sub, cosh_sub_sinh] + +@[simp] lemma cosh_sq_sub_sinh_sq (x : ℝ) : cosh x ^ 2 - sinh x ^ 2 = 1 := +by rw ← of_real_inj; simp lemma cosh_sq : cosh x ^ 2 = sinh x ^ 2 + 1 := by rw ← of_real_inj; simp [cosh_sq] +lemma cosh_sq' : cosh x ^ 2 = 1 + sinh x ^ 2 := +(cosh_sq x).trans (add_comm _ _) + lemma sinh_sq : sinh x ^ 2 = cosh x ^ 2 - 1 := by rw ← of_real_inj; simp [sinh_sq] @@ -1136,23 +1159,33 @@ by rw ← of_real_inj; simp [sinh_three_mul] open is_absolute_value +lemma sum_le_exp_of_nonneg {x : ℝ} (hx : 0 ≤ x) (n : ℕ) : ∑ i in range n, x ^ i / i! ≤ exp x := +calc ∑ i in range n, x ^ i / i! ≤ lim (⟨_, is_cau_seq_re (exp' x)⟩ : cau_seq ℝ has_abs.abs) : + begin + refine le_lim (cau_seq.le_of_exists ⟨n, λ j hj, _⟩), + simp only [exp', const_apply, mk_to_fun, re_sum], + norm_cast, + rw [← nat.add_sub_of_le hj, finset.sum_range_add], + refine le_add_of_nonneg_right (sum_nonneg (λ i hi, _)), + positivity, + end +... = exp x : by rw [exp, complex.exp, ← cau_seq_re, lim_re] + +lemma quadratic_le_exp_of_nonneg {x : ℝ} (hx : 0 ≤ x) : 1 + x + x ^ 2 / 2 ≤ exp x := +calc 1 + x + x ^ 2 / 2 = ∑ i in range 3, x ^ i / i! : by simp [finset.sum_range_succ] +... ≤ exp x : sum_le_exp_of_nonneg hx 3 + +lemma add_one_lt_exp_of_pos {x : ℝ} (hx : 0 < x) : x + 1 < exp x := +(by nlinarith : x + 1 < 1 + x + x ^ 2 / 2).trans_le (quadratic_le_exp_of_nonneg hx.le) + /-- This is an intermediate result that is later replaced by `real.add_one_le_exp`; use that lemma instead. -/ lemma add_one_le_exp_of_nonneg {x : ℝ} (hx : 0 ≤ x) : x + 1 ≤ exp x := -calc x + 1 ≤ lim (⟨(λ n : ℕ, ((exp' x) n).re), is_cau_seq_re (exp' x)⟩ : cau_seq ℝ has_abs.abs) : - le_lim (cau_seq.le_of_exists ⟨2, - λ j hj, show x + (1 : ℝ) ≤ (∑ m in range j, (x ^ m / m! : ℂ)).re, - from have h₁ : (((λ m : ℕ, (x ^ m / m! : ℂ)) ∘ nat.succ) 0).re = x, by simp, - have h₂ : ((x : ℂ) ^ 0 / 0!).re = 1, by simp, - begin - rw [← tsub_add_cancel_of_le hj, sum_range_succ', sum_range_succ', - add_re, add_re, h₁, h₂, add_assoc, - ← coe_re_add_group_hom, (re_add_group_hom).map_sum, coe_re_add_group_hom ], - refine le_add_of_nonneg_of_le (sum_nonneg (λ m hm, _)) le_rfl, - rw [← of_real_pow, ← of_real_nat_cast, ← of_real_div, of_real_re], - exact div_nonneg (pow_nonneg hx _) (nat.cast_nonneg _), - end⟩) -... = exp x : by rw [exp, complex.exp, ← cau_seq_re, lim_re] +begin + rcases eq_or_lt_of_le hx with rfl | h, + { simp }, + exact (add_one_lt_exp_of_pos h).le +end lemma one_le_exp {x : ℝ} (hx : 0 ≤ x) : 1 ≤ exp x := by linarith [add_one_le_exp_of_nonneg hx] @@ -1165,12 +1198,12 @@ lemma exp_pos (x : ℝ) : 0 < exp x := @[simp] lemma abs_exp (x : ℝ) : |exp x| = exp x := abs_of_pos (exp_pos _) -lemma exp_strict_mono : strict_mono exp := +@[mono] lemma exp_strict_mono : strict_mono exp := λ x y h, by rw [← sub_add_cancel y x, real.exp_add]; exact (lt_mul_iff_one_lt_left (exp_pos _)).2 (lt_of_lt_of_le (by linarith) (add_one_le_exp_of_nonneg (by linarith))) -@[mono] lemma exp_monotone : ∀ {x y : ℝ}, x ≤ y → exp x ≤ exp y := exp_strict_mono.monotone +@[mono] lemma exp_monotone : monotone exp := exp_strict_mono.monotone @[simp] lemma exp_lt_exp {x y : ℝ} : exp x < exp y ↔ x < y := exp_strict_mono.lt_iff_lt @@ -1180,8 +1213,7 @@ lemma exp_injective : function.injective exp := exp_strict_mono.injective @[simp] lemma exp_eq_exp {x y : ℝ} : exp x = exp y ↔ x = y := exp_injective.eq_iff -@[simp] lemma exp_eq_one_iff : exp x = 1 ↔ x = 0 := -by rw [← exp_zero, exp_injective.eq_iff] +@[simp] lemma exp_eq_one_iff : exp x = 1 ↔ x = 0 := exp_injective.eq_iff' exp_zero @[simp] lemma one_lt_exp_iff {x : ℝ} : 1 < exp x ↔ 0 < x := by rw [← exp_zero, exp_lt_exp] @@ -1199,6 +1231,9 @@ exp_zero ▸ exp_le_exp lemma cosh_pos (x : ℝ) : 0 < real.cosh x := (cosh_eq x).symm ▸ half_pos (add_pos (exp_pos x) (exp_pos (-x))) +lemma sinh_lt_cosh : sinh x < cosh x := +lt_of_pow_lt_pow 2 (cosh_pos _).le $ (cosh_sq x).symm ▸ lt_add_one _ + end real namespace complex @@ -1229,17 +1264,17 @@ calc ∑ m in filter (λ k, n ≤ k) (range j), (1 / m! : α) (pow_pos (nat.cast_pos.2 (nat.succ_pos _)) _) }, end ... = n!⁻¹ * ∑ m in range (j - n), n.succ⁻¹ ^ m : - by simp [mul_inv₀, mul_sum.symm, sum_mul.symm, -nat.factorial_succ, mul_comm, inv_pow₀] + by simp [mul_inv, mul_sum.symm, sum_mul.symm, -nat.factorial_succ, mul_comm, inv_pow] ... = (n.succ - n.succ * n.succ⁻¹ ^ (j - n)) / (n! * n) : - have h₁ : (n.succ : α) ≠ 1, from @nat.cast_one α _ _ ▸ mt nat.cast_inj.1 + have h₁ : (n.succ : α) ≠ 1, from @nat.cast_one α _ ▸ mt nat.cast_inj.1 (mt nat.succ.inj (pos_iff_ne_zero.1 hn)), have h₂ : (n.succ : α) ≠ 0, from nat.cast_ne_zero.2 (nat.succ_ne_zero _), have h₃ : (n! * n : α) ≠ 0, from mul_ne_zero (nat.cast_ne_zero.2 (pos_iff_ne_zero.1 (nat.factorial_pos _))) (nat.cast_ne_zero.2 (pos_iff_ne_zero.1 hn)), have h₄ : (n.succ - 1 : α) = n, by simp, - by rw [← geom_sum_def, geom_sum_inv h₁ h₂, eq_div_iff_mul_eq h₃, - mul_comm _ (n! * n : α), ← mul_assoc (n!⁻¹ : α), ← mul_inv_rev₀, h₄, + by rw [geom_sum_inv h₁ h₂, eq_div_iff_mul_eq h₃, + mul_comm _ (n! * n : α), ← mul_assoc (n!⁻¹ : α), ← mul_inv_rev, h₄, ← mul_assoc (n! * n : α), mul_comm (n : α) n!, mul_inv_cancel h₃]; simp [mul_add, add_mul, mul_assoc, mul_comm] ... ≤ n.succ / (n! * n) : @@ -1271,17 +1306,17 @@ begin ... ≤ ∑ m in filter (λ k, n ≤ k) (range j), abs x ^ n * (1 / m!) : begin refine sum_le_sum (λ m hm, _), - rw [abs_mul, abv_pow abs, abs_div, abs_cast_nat], + rw [map_mul, map_pow, map_div₀, abs_cast_nat], refine mul_le_mul_of_nonneg_left ((div_le_div_right _).2 _) _, { exact nat.cast_pos.2 (nat.factorial_pos _), }, { rw abv_pow abs, - exact (pow_le_one _ (abs_nonneg _) hx), }, - { exact pow_nonneg (abs_nonneg _) _ }, + exact (pow_le_one _ (abs.nonneg _) hx), }, + { exact pow_nonneg (abs.nonneg _) _ }, end ... = abs x ^ n * (∑ m in (range j).filter (λ k, n ≤ k), (1 / m! : ℝ)) : by simp [abs_mul, abv_pow abs, abs_div, mul_sum.symm] ... ≤ abs x ^ n * (n.succ * (n! * n)⁻¹) : - mul_le_mul_of_nonneg_left (sum_div_factorial_le _ _ hn) (pow_nonneg (abs_nonneg _) _) + mul_le_mul_of_nonneg_left (sum_div_factorial_le _ _ hn) (pow_nonneg (abs.nonneg _) _) end lemma exp_bound' {x : ℂ} {n : ℕ} (hx : abs x / (n.succ) ≤ 1 / 2) : @@ -1297,26 +1332,27 @@ begin calc abs (∑ (i : ℕ) in range k, x ^ (n + i) / ((n + i)! : ℂ)) ≤ ∑ (i : ℕ) in range k, abs (x ^ (n + i) / ((n + i)! : ℂ)) : abv_sum_le_sum_abv _ _ ... ≤ ∑ (i : ℕ) in range k, (abs x) ^ (n + i) / (n + i)! : - by simp only [complex.abs_cast_nat, complex.abs_div, abv_pow abs] + by simp only [complex.abs_cast_nat, map_div₀, abv_pow abs] ... ≤ ∑ (i : ℕ) in range k, (abs x) ^ (n + i) / (n! * n.succ ^ i) : _ ... = ∑ (i : ℕ) in range k, (abs x) ^ (n) / (n!) * ((abs x)^i / n.succ ^ i) : _ ... ≤ abs x ^ n / (↑n!) * 2 : _, - { refine sum_le_sum (λ m hm, div_le_div (pow_nonneg (abs_nonneg x) (n + m)) le_rfl _ _), + { refine sum_le_sum (λ m hm, div_le_div (pow_nonneg (abs.nonneg x) (n + m)) le_rfl _ _), { exact_mod_cast mul_pos n.factorial_pos (pow_pos n.succ_pos _), }, { exact_mod_cast (nat.factorial_mul_pow_le_factorial), }, }, { refine finset.sum_congr rfl (λ _ _, _), - simp only [pow_add, div_eq_inv_mul, mul_inv₀, mul_left_comm, mul_assoc], }, + simp only [pow_add, div_eq_inv_mul, mul_inv, mul_left_comm, mul_assoc], }, { rw [←mul_sum], apply mul_le_mul_of_nonneg_left, { simp_rw [←div_pow], - rw [←geom_sum_def, geom_sum_eq, div_le_iff_of_neg], + rw [geom_sum_eq, div_le_iff_of_neg], { transitivity (-1 : ℝ), { linarith }, { simp only [neg_le_sub_iff_le_add, div_pow, nat.cast_succ, le_add_iff_nonneg_left], - exact div_nonneg (pow_nonneg (abs_nonneg x) k) (pow_nonneg (n+1).cast_nonneg k) } }, + exact div_nonneg (pow_nonneg (abs.nonneg x) k) + (pow_nonneg (add_nonneg n.cast_nonneg zero_le_one) k) } }, { linarith }, { linarith }, }, - { exact div_nonneg (pow_nonneg (abs_nonneg x) n) (nat.cast_nonneg (n!)), }, }, + { exact div_nonneg (pow_nonneg (abs.nonneg x) n) (nat.cast_nonneg (n!)), }, }, end lemma abs_exp_sub_one_le {x : ℂ} (hx : abs x ≤ 1) : @@ -1363,6 +1399,19 @@ begin simpa [mul_div_assoc] using t end +lemma abs_exp_sub_one_le {x : ℝ} (hx : |x| ≤ 1) : |exp x - 1| ≤ 2 * |x| := +begin + have : complex.abs x ≤ 1 := by exact_mod_cast hx, + exact_mod_cast complex.abs_exp_sub_one_le this, +end + +lemma abs_exp_sub_one_sub_id_le {x : ℝ} (hx : |x| ≤ 1) : |exp x - 1 - x| ≤ x ^ 2 := +begin + rw ←_root_.sq_abs, + have : complex.abs x ≤ 1 := by exact_mod_cast hx, + exact_mod_cast complex.abs_exp_sub_one_sub_id_le this, +end + /-- A finite initial segment of the exponential series, followed by an arbitrary tail. For fixed `n` this is just a linear map wrt `r`, and each map is a simple linear function of the previous (see `exp_near_succ`), with `exp_near n x r ⟶ exp x` as `n ⟶ ∞`, @@ -1373,7 +1422,7 @@ def exp_near (n : ℕ) (x r : ℝ) : ℝ := ∑ m in range n, x ^ m / m! + x ^ n @[simp] theorem exp_near_succ (n x r) : exp_near (n + 1) x r = exp_near n x (1 + x / (n+1) * r) := by simp [exp_near, range_succ, mul_add, add_left_comm, add_assoc, pow_succ, div_eq_mul_inv, - mul_inv₀]; ac_refl + mul_inv]; ac_refl theorem exp_near_sub (n x r₁ r₂) : exp_near n x r₁ - exp_near n x r₂ = x ^ n / n! * (r₁ - r₂) := by simp [exp_near, mul_sub] @@ -1392,7 +1441,7 @@ begin refine (_root_.abs_sub_le _ _ _).trans ((add_le_add_right h _).trans _), subst e₁, rw [exp_near_succ, exp_near_sub, _root_.abs_mul], convert mul_le_mul_of_nonneg_left (le_sub_iff_add_le'.1 e) _, - { simp [mul_add, pow_succ', div_eq_mul_inv, _root_.abs_mul, _root_.abs_inv, ← pow_abs, mul_inv₀], + { simp [mul_add, pow_succ', div_eq_mul_inv, _root_.abs_mul, _root_.abs_inv, ← pow_abs, mul_inv], ac_refl }, { simp [_root_.div_nonneg, _root_.abs_nonneg] } end @@ -1424,7 +1473,7 @@ lemma cos_bound {x : ℝ} (hx : |x| ≤ 1) : calc |cos x - (1 - x ^ 2 / 2)| = abs (complex.cos x - (1 - x ^ 2 / 2)) : by rw ← abs_of_real; simp [of_real_bit0, of_real_one, of_real_inv] ... = abs ((complex.exp (x * I) + complex.exp (-x * I) - (2 - x ^ 2)) / 2) : - by simp [complex.cos, sub_div, add_div, neg_div, div_self (@two_ne_zero' ℂ _ _ _)] + by simp [complex.cos, sub_div, add_div, neg_div, div_self (two_ne_zero' ℂ)] ... = abs (((complex.exp (x * I) - ∑ m in range 4, (x * I) ^ m / m!) + ((complex.exp (-x * I) - ∑ m in range 4, (-x * I) ^ m / m!))) / 2) : congr_arg abs (congr_arg (λ x : ℂ, x / 2) begin @@ -1434,10 +1483,10 @@ calc |cos x - (1 - x ^ 2 / 2)| = abs (complex.cos x - (1 - x ^ 2 / 2)) : end) ... ≤ abs ((complex.exp (x * I) - ∑ m in range 4, (x * I) ^ m / m!) / 2) + abs ((complex.exp (-x * I) - ∑ m in range 4, (-x * I) ^ m / m!) / 2) : - by rw add_div; exact abs_add _ _ + by rw add_div; exact complex.abs.add_le _ _ ... = (abs ((complex.exp (x * I) - ∑ m in range 4, (x * I) ^ m / m!)) / 2 + abs ((complex.exp (-x * I) - ∑ m in range 4, (-x * I) ^ m / m!)) / 2) : - by simp [complex.abs_div] + by simp [map_div₀] ... ≤ ((complex.abs (x * I) ^ 4 * (nat.succ 4 * (4! * (4 : ℕ))⁻¹)) / 2 + (complex.abs (-x * I) ^ 4 * (nat.succ 4 * (4! * (4 : ℕ))⁻¹)) / 2) : add_le_add ((div_le_div_right (by norm_num)).2 (complex.exp_bound (by simpa) dec_trivial)) @@ -1449,8 +1498,8 @@ lemma sin_bound {x : ℝ} (hx : |x| ≤ 1) : calc |sin x - (x - x ^ 3 / 6)| = abs (complex.sin x - (x - x ^ 3 / 6)) : by rw ← abs_of_real; simp [of_real_bit0, of_real_one, of_real_inv] ... = abs (((complex.exp (-x * I) - complex.exp (x * I)) * I - (2 * x - x ^ 3 / 3)) / 2) : - by simp [complex.sin, sub_div, add_div, neg_div, mul_div_cancel_left _ (@two_ne_zero' ℂ _ _ _), - div_div_eq_div_mul, show (3 : ℂ) * 2 = 6, by norm_num] + by simp [complex.sin, sub_div, add_div, neg_div, mul_div_cancel_left _ (two_ne_zero' ℂ), + div_div, show (3 : ℂ) * 2 = 6, by norm_num] ... = abs ((((complex.exp (-x * I) - ∑ m in range 4, (-x * I) ^ m / m!) - (complex.exp (x * I) - ∑ m in range 4, (x * I) ^ m / m!)) * I) / 2) : congr_arg abs (congr_arg (λ x : ℂ, x / 2) begin @@ -1460,10 +1509,10 @@ calc |sin x - (x - x ^ 3 / 6)| = abs (complex.sin x - (x - x ^ 3 / 6)) : end) ... ≤ abs ((complex.exp (-x * I) - ∑ m in range 4, (-x * I) ^ m / m!) * I / 2) + abs (-((complex.exp (x * I) - ∑ m in range 4, (x * I) ^ m / m!) * I) / 2) : - by rw [sub_mul, sub_eq_add_neg, add_div]; exact abs_add _ _ + by rw [sub_mul, sub_eq_add_neg, add_div]; exact complex.abs.add_le _ _ ... = (abs ((complex.exp (x * I) - ∑ m in range 4, (x * I) ^ m / m!)) / 2 + abs ((complex.exp (-x * I) - ∑ m in range 4, (-x * I) ^ m / m!)) / 2) : - by simp [add_comm, complex.abs_div, complex.abs_mul] + by simp [add_comm, map_div₀] ... ≤ ((complex.abs (x * I) ^ 4 * (nat.succ 4 * (4! * (4 : ℕ))⁻¹)) / 2 + (complex.abs (-x * I) ^ 4 * (nat.succ 4 * (4! * (4 : ℕ))⁻¹)) / 2) : add_le_add ((div_le_div_right (by norm_num)).2 (complex.exp_bound (by simpa) dec_trivial)) @@ -1480,7 +1529,7 @@ calc 0 < (1 - x ^ 2 / 2) - |x| ^ 4 * (5 / 96) : ((div_le_div_right (by norm_num)).2 (by rw [sq, ← abs_mul_self, _root_.abs_mul]; exact mul_le_one hx (abs_nonneg _) hx)) ... < 1 : by norm_num) -... ≤ cos x : sub_le.1 (abs_sub_le_iff.1 (cos_bound hx)).2 +... ≤ cos x : sub_le_comm.1 (abs_sub_le_iff.1 (cos_bound hx)).2 lemma sin_pos_of_pos_of_le_one {x : ℝ} (hx0 : 0 < x) (hx : x ≤ 1) : 0 < sin x := calc 0 < x - x ^ 3 / 6 - |x| ^ 4 * (5 / 96) : @@ -1497,7 +1546,7 @@ calc 0 < x - x ^ 3 / 6 - |x| ^ 4 * (5 / 96) : (calc x ^ 3 ≤ x ^ 1 : pow_le_pow_of_le_one (le_of_lt hx0) hx dec_trivial ... = x : pow_one _)) ... < x : by linarith) -... ≤ sin x : sub_le.1 (abs_sub_le_iff.1 (sin_bound +... ≤ sin x : sub_le_comm.1 (abs_sub_le_iff.1 (sin_bound (by rwa [_root_.abs_of_nonneg (le_of_lt hx0)]))).2 lemma sin_pos_of_pos_of_le_two {x : ℝ} (hx0 : 0 < x) (hx : x ≤ 2) : 0 < sin x := @@ -1522,75 +1571,84 @@ calc cos 2 = cos (2 * 1) : congr_arg cos (mul_one _).symm zero_le_two) _ ... < 0 : by norm_num -lemma exp_bound_div_one_sub_of_interval_approx {x : ℝ} (h1 : 0 ≤ x) (h2 : x ≤ 1) : - ∑ (j : ℕ) in finset.range 3, x ^ j / (j.factorial) - + x ^ 3 * ((3 : ℕ) + 1) / ((3 : ℕ).factorial * (3 : ℕ)) - ≤ ∑ j in (finset.range 3), x ^ j := -begin - norm_num [finset.sum], - rw [add_assoc, add_comm (x + 1) (x ^ 3 * 4 / 18), ← add_assoc, add_le_add_iff_right, - ← add_le_add_iff_left (-(x ^ 2 / 2)), ← add_assoc, comm_ring.add_left_neg (x ^ 2 / 2), - zero_add, neg_add_eq_sub, sub_half, sq, pow_succ, sq], - have i1 : x * 4 / 18 ≤ 1 / 2 := by linarith, - have i2 : 0 ≤ x * 4 / 18 := by linarith, - have i3 := mul_le_mul h1 h1 le_rfl h1, - rw zero_mul at i3, - have t := mul_le_mul le_rfl i1 i2 i3, - rw ← mul_assoc, - rwa [mul_one_div, ← mul_div_assoc, ← mul_assoc] at t, -end +lemma exp_bound_div_one_sub_of_interval' {x : ℝ} (h1 : 0 < x) (h2 : x < 1) : + real.exp x < 1 / (1 - x) := +have H : 0 < 1 - (1 + x + x ^ 2) * (1 - x) := +calc 0 < x ^ 3 : by positivity +... = 1 - (1 + x + x ^ 2) * (1 - x) : by ring, +calc exp x ≤ _ : exp_bound' h1.le h2.le zero_lt_three +... ≤ 1 + x + x ^ 2 : by norm_num [finset.sum]; nlinarith +... < 1 / (1 - x) : by rw lt_div_iff; nlinarith lemma exp_bound_div_one_sub_of_interval {x : ℝ} (h1 : 0 ≤ x) (h2 : x < 1) : real.exp x ≤ 1 / (1 - x) := begin - have h : ∑ j in (finset.range 3), x ^ j ≤ 1 / (1 - x), - { norm_num [finset.sum], - have h1x : 0 < 1 - x := by simpa, - rw le_div_iff h1x, - norm_num [← add_assoc, mul_sub_left_distrib, mul_one, add_mul, - sub_add_eq_sub_sub, pow_succ' x 2], - have hx3 : 0 ≤ x ^ 3, - { norm_num, - exact h1 }, - linarith }, - exact (exp_bound' h1 h2.le $ by linarith).trans - ((exp_bound_div_one_sub_of_interval_approx h1 h2.le).trans h), + rcases eq_or_lt_of_le h1 with rfl | h1, + { simp }, + { exact (exp_bound_div_one_sub_of_interval' h1 h2).le } end -lemma one_sub_le_exp_minus_of_pos {y : ℝ} (h : 0 ≤ y) : 1 - y ≤ real.exp (-y) := +lemma one_sub_lt_exp_minus_of_pos {y : ℝ} (h : 0 < y) : 1 - y < real.exp (-y) := begin - rw real.exp_neg, - have r1 : (1 - y) * (real.exp y) ≤ 1, - { cases le_or_lt (1 - y) 0, - { have h'' : (1 - y) * y.exp ≤ 0, - { rw mul_nonpos_iff, - right, - exact ⟨h_1, y.exp_pos.le⟩ }, - linarith }, - have hy1 : y < 1 := by linarith, - rw ← le_div_iff' h_1, - exact exp_bound_div_one_sub_of_interval h hy1 }, - rw inv_eq_one_div, - rw le_div_iff' y.exp_pos, - rwa mul_comm at r1, + cases le_or_lt 1 y with h' h', + { linarith [(-y).exp_pos] }, + rw [exp_neg, lt_inv _ y.exp_pos, inv_eq_one_div], + { exact exp_bound_div_one_sub_of_interval' h h' }, + { linarith }, end -lemma add_one_le_exp_of_nonpos {x : ℝ} (h : x ≤ 0) : x + 1 ≤ real.exp x := +lemma one_sub_le_exp_minus_of_nonneg {y : ℝ} (h : 0 ≤ y) : 1 - y ≤ real.exp (-y) := begin - rw add_comm, - have h1 : 0 ≤ -x := by linarith, - simpa using one_sub_le_exp_minus_of_pos h1 + rcases eq_or_lt_of_le h with rfl | h, + { simp }, + { exact (one_sub_lt_exp_minus_of_pos h).le } +end + +lemma add_one_lt_exp_of_neg {x : ℝ} (h : x < 0) : x + 1 < real.exp x := +begin + have h1 : 0 < -x := by linarith, + simpa [add_comm] using one_sub_lt_exp_minus_of_pos h1 +end + +lemma add_one_lt_exp_of_nonzero {x : ℝ} (hx : x ≠ 0) : x + 1 < real.exp x := +begin + cases lt_or_gt_of_ne hx, + { exact real.add_one_lt_exp_of_neg h }, + exact add_one_lt_exp_of_pos h, end lemma add_one_le_exp (x : ℝ) : x + 1 ≤ real.exp x := begin cases le_or_lt 0 x, { exact real.add_one_le_exp_of_nonneg h }, - exact add_one_le_exp_of_nonpos h.le, + exact (add_one_lt_exp_of_neg h).le, +end + +lemma one_sub_div_pow_le_exp_neg {n : ℕ} {t : ℝ} (ht' : t ≤ n) : (1 - t / n) ^ n ≤ exp (-t) := +begin + rcases eq_or_ne n 0 with rfl | hn, + { simp, rwa nat.cast_zero at ht' }, + convert pow_le_pow_of_le_left _ (add_one_le_exp (-(t / n))) n, + { abel }, + { rw ←real.exp_nat_mul, congr' 1, + field_simp [nat.cast_ne_zero.mpr hn], ring }, + { rwa [add_comm, ←sub_eq_add_neg, sub_nonneg, div_le_one], + positivity } end end real +namespace tactic +open positivity real + +/-- Extension for the `positivity` tactic: `real.exp` is always positive. -/ +@[positivity] +meta def positivity_exp : expr → tactic strictness +| `(real.exp %%a) := positive <$> mk_app `real.exp_pos [a] +| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `real.exp r`" + +end tactic + namespace complex @[simp] lemma abs_cos_add_sin_mul_I (x : ℝ) : abs (cos x + sin x * I) = 1 := @@ -1603,8 +1661,8 @@ by rw [← of_real_exp]; exact abs_of_nonneg (le_of_lt (real.exp_pos _)) @[simp] lemma abs_exp_of_real_mul_I (x : ℝ) : abs (exp (x * I)) = 1 := by rw [exp_mul_I, abs_cos_add_sin_mul_I] -lemma abs_exp (z : ℂ) : abs (exp z) = real.exp (z.re) := -by rw [exp_eq_exp_re_mul_sin_add_cos, abs_mul, abs_exp_of_real, abs_cos_add_sin_mul_I, mul_one] +lemma abs_exp (z : ℂ) : abs (exp z) = real.exp z.re := +by rw [exp_eq_exp_re_mul_sin_add_cos, map_mul, abs_exp_of_real, abs_cos_add_sin_mul_I, mul_one] lemma abs_exp_eq_iff_re_eq {x y : ℂ} : abs (exp x) = abs (exp y) ↔ x.re = y.re := by rw [abs_exp, abs_exp, real.exp_eq_exp] diff --git a/src/data/complex/exponential_bounds.lean b/src/data/complex/exponential_bounds.lean index 28bffde9acb89..53d37bc86f1be 100644 --- a/src/data/complex/exponential_bounds.lean +++ b/src/data/complex/exponential_bounds.lean @@ -9,6 +9,9 @@ import analysis.special_functions.log.deriv /-! # Bounds on specific values of the exponential + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace real @@ -33,7 +36,7 @@ begin end lemma exp_one_gt_d9 : 2.7182818283 < exp 1 := -lt_of_lt_of_le (by norm_num) (sub_le.1 (abs_sub_le_iff.1 exp_one_near_10).2) +lt_of_lt_of_le (by norm_num) (sub_le_comm.1 (abs_sub_le_iff.1 exp_one_near_10).2) lemma exp_one_lt_d9 : exp 1 < 2.7182818286 := lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) (by norm_num) @@ -48,7 +51,7 @@ end lemma exp_neg_one_lt_d9 : exp (-1) < 0.36787944120 := begin rw [exp_neg, inv_lt (exp_pos _)], - refine lt_of_lt_of_le _ (sub_le.1 (abs_sub_le_iff.1 exp_one_near_10).2), + refine lt_of_lt_of_le _ (sub_le_comm.1 (abs_sub_le_iff.1 exp_one_near_10).2), all_goals {norm_num}, end @@ -71,7 +74,7 @@ begin end lemma log_two_gt_d9 : 0.6931471803 < log 2 := -lt_of_lt_of_le (by norm_num1) (sub_le.1 (abs_sub_le_iff.1 log_two_near_10).2) +lt_of_lt_of_le (by norm_num1) (sub_le_comm.1 (abs_sub_le_iff.1 log_two_near_10).2) lemma log_two_lt_d9 : log 2 < 0.6931471808 := lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 log_two_near_10).1) (by norm_num) diff --git a/src/data/complex/is_R_or_C.lean b/src/data/complex/is_R_or_C.lean deleted file mode 100644 index e417e3e209d13..0000000000000 --- a/src/data/complex/is_R_or_C.lean +++ /dev/null @@ -1,880 +0,0 @@ -/- -Copyright (c) 2020 Frédéric Dupuis. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Frédéric Dupuis --/ -import data.real.sqrt -import field_theory.tower -import analysis.normed_space.finite_dimension -import analysis.normed_space.star.basic - -/-! -# `is_R_or_C`: a typeclass for ℝ or ℂ - -This file defines the typeclass `is_R_or_C` intended to have only two instances: -ℝ and ℂ. It is meant for definitions and theorems which hold for both the real and the complex case, -and in particular when the real case follows directly from the complex case by setting `re` to `id`, -`im` to zero and so on. Its API follows closely that of ℂ. - -Applications include defining inner products and Hilbert spaces for both the real and -complex case. One typically produces the definitions and proof for an arbitrary field of this -typeclass, which basically amounts to doing the complex case, and the two cases then fall out -immediately from the two instances of the class. - -The instance for `ℝ` is registered in this file. -The instance for `ℂ` is declared in `analysis.complex.basic`. - -## Implementation notes - -The coercion from reals into an `is_R_or_C` field is done by registering `algebra_map ℝ K` as -a `has_coe_t`. For this to work, we must proceed carefully to avoid problems involving circular -coercions in the case `K=ℝ`; in particular, we cannot use the plain `has_coe` and must set -priorities carefully. This problem was already solved for `ℕ`, and we copy the solution detailed -in `data/nat/cast`. See also Note [coercion into rings] for more details. - -In addition, several lemmas need to be set at priority 900 to make sure that they do not override -their counterparts in `complex.lean` (which causes linter errors). --/ - -open_locale big_operators - -section - -local notation `𝓚` := algebra_map ℝ _ -open_locale complex_conjugate - -/-- -This typeclass captures properties shared by ℝ and ℂ, with an API that closely matches that of ℂ. --/ -class is_R_or_C (K : Type*) - extends nondiscrete_normed_field K, star_ring K, normed_algebra ℝ K, complete_space K := -(re : K →+ ℝ) -(im : K →+ ℝ) -(I : K) -- Meant to be set to 0 for K=ℝ -(I_re_ax : re I = 0) -(I_mul_I_ax : I = 0 ∨ I * I = -1) -(re_add_im_ax : ∀ (z : K), 𝓚 (re z) + 𝓚 (im z) * I = z) -(of_real_re_ax : ∀ r : ℝ, re (𝓚 r) = r) -(of_real_im_ax : ∀ r : ℝ, im (𝓚 r) = 0) -(mul_re_ax : ∀ z w : K, re (z * w) = re z * re w - im z * im w) -(mul_im_ax : ∀ z w : K, im (z * w) = re z * im w + im z * re w) -(conj_re_ax : ∀ z : K, re (conj z) = re z) -(conj_im_ax : ∀ z : K, im (conj z) = -(im z)) -(conj_I_ax : conj I = -I) -(norm_sq_eq_def_ax : ∀ (z : K), ∥z∥^2 = (re z) * (re z) + (im z) * (im z)) -(mul_im_I_ax : ∀ (z : K), (im z) * im I = im z) -(inv_def_ax : ∀ (z : K), z⁻¹ = conj z * 𝓚 ((∥z∥^2)⁻¹)) -(div_I_ax : ∀ (z : K), z / I = -(z * I)) - -end - -mk_simp_attribute is_R_or_C_simps "Simp attribute for lemmas about `is_R_or_C`" - -variables {K : Type*} [is_R_or_C K] - -namespace is_R_or_C - -open_locale complex_conjugate - -/- The priority must be set at 900 to ensure that coercions are tried in the right order. -See Note [coercion into rings], or `data/nat/cast.lean` for more details. -/ -@[priority 900] noncomputable instance algebra_map_coe : has_coe_t ℝ K := ⟨algebra_map ℝ K⟩ - -lemma of_real_alg (x : ℝ) : (x : K) = x • (1 : K) := -algebra.algebra_map_eq_smul_one x - -lemma algebra_map_eq_of_real : ⇑(algebra_map ℝ K) = coe := rfl - -@[simp, is_R_or_C_simps] lemma re_add_im (z : K) : ((re z) : K) + (im z) * I = z := -is_R_or_C.re_add_im_ax z -@[simp, norm_cast, is_R_or_C_simps] lemma of_real_re : ∀ r : ℝ, re (r : K) = r := -is_R_or_C.of_real_re_ax -@[simp, norm_cast, is_R_or_C_simps] lemma of_real_im : ∀ r : ℝ, im (r : K) = 0 := -is_R_or_C.of_real_im_ax -@[simp, is_R_or_C_simps] lemma mul_re : ∀ z w : K, re (z * w) = re z * re w - im z * im w := -is_R_or_C.mul_re_ax -@[simp, is_R_or_C_simps] lemma mul_im : ∀ z w : K, im (z * w) = re z * im w + im z * re w := -is_R_or_C.mul_im_ax - -theorem inv_def (z : K) : z⁻¹ = conj z * ((∥z∥^2)⁻¹:ℝ) := -is_R_or_C.inv_def_ax z - -theorem ext_iff : ∀ {z w : K}, z = w ↔ re z = re w ∧ im z = im w := -λ z w, { mp := by { rintro rfl, cc }, - mpr := by { rintro ⟨h₁,h₂⟩, rw [←re_add_im z, ←re_add_im w, h₁, h₂] } } - -theorem ext : ∀ {z w : K}, re z = re w → im z = im w → z = w := -by { simp_rw ext_iff, cc } - - -@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_zero : ((0 : ℝ) : K) = 0 := -by rw [of_real_alg, zero_smul] - -@[simp, is_R_or_C_simps] lemma zero_re' : re (0 : K) = (0 : ℝ) := re.map_zero - -@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_one : ((1 : ℝ) : K) = 1 := -by rw [of_real_alg, one_smul] -@[simp, is_R_or_C_simps] lemma one_re : re (1 : K) = 1 := by rw [←of_real_one, of_real_re] -@[simp, is_R_or_C_simps] lemma one_im : im (1 : K) = 0 := by rw [←of_real_one, of_real_im] - -@[simp, norm_cast, priority 900] theorem of_real_inj {z w : ℝ} : (z : K) = (w : K) ↔ z = w := -{ mp := λ h, by { convert congr_arg re h; simp only [of_real_re] }, - mpr := λ h, by rw h } - -@[simp, is_R_or_C_simps] lemma bit0_re (z : K) : re (bit0 z) = bit0 (re z) := -by simp only [bit0, map_add] -@[simp, is_R_or_C_simps] lemma bit1_re (z : K) : re (bit1 z) = bit1 (re z) := -by simp only [bit1, add_monoid_hom.map_add, bit0_re, add_right_inj, one_re] -@[simp, is_R_or_C_simps] lemma bit0_im (z : K) : im (bit0 z) = bit0 (im z) := -by simp only [bit0, map_add] -@[simp, is_R_or_C_simps] lemma bit1_im (z : K) : im (bit1 z) = bit0 (im z) := -by simp only [bit1, add_right_eq_self, add_monoid_hom.map_add, bit0_im, one_im] - -@[simp, is_R_or_C_simps, priority 900] -theorem of_real_eq_zero {z : ℝ} : (z : K) = 0 ↔ z = 0 := -by rw [←of_real_zero]; exact of_real_inj - -@[simp, is_R_or_C_simps, norm_cast, priority 900] -lemma of_real_add ⦃r s : ℝ⦄ : ((r + s : ℝ) : K) = r + s := -by { apply (@is_R_or_C.ext_iff K _ ((r + s : ℝ) : K) (r + s)).mpr, simp } - -@[simp, is_R_or_C_simps, norm_cast, priority 900] -lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : K) = bit0 (r : K) := -ext_iff.2 $ by simp [bit0] - -@[simp, is_R_or_C_simps, norm_cast, priority 900] -lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : K) = bit1 (r : K) := -ext_iff.2 $ by simp [bit1] - -/- Note: This can be proven by `norm_num` once K is proven to be of characteristic zero below. -/ -lemma two_ne_zero : (2 : K) ≠ 0 := -begin - intro h, rw [(show (2 : K) = ((2 : ℝ) : K), by norm_num), ←of_real_zero, of_real_inj] at h, - linarith, -end - -@[simp, norm_cast, is_R_or_C_simps, priority 900] -lemma of_real_neg (r : ℝ) : ((-r : ℝ) : K) = -r := ext_iff.2 $ by simp - -@[simp, norm_cast, is_R_or_C_simps, priority 900] -lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : K) = r * s := ext_iff.2 $ by simp with is_R_or_C_simps - -@[simp, norm_cast, is_R_or_C_simps] -lemma of_real_smul (r x : ℝ) : r • (x : K) = (r : K) * (x : K) := -begin - simp_rw [← smul_eq_mul, of_real_alg r], - simp only [algebra.id.smul_eq_mul, one_mul, algebra.smul_mul_assoc], -end - -@[is_R_or_C_simps] lemma of_real_mul_re (r : ℝ) (z : K) : re (↑r * z) = r * re z := -by simp only [mul_re, of_real_im, zero_mul, of_real_re, sub_zero] -@[is_R_or_C_simps] lemma of_real_mul_im (r : ℝ) (z : K) : im (↑r * z) = r * (im z) := -by simp only [add_zero, of_real_im, zero_mul, of_real_re, mul_im] - -@[is_R_or_C_simps] lemma smul_re : ∀ (r : ℝ) (z : K), re (r • z) = r * (re z) := -λ r z, by { rw algebra.smul_def, apply of_real_mul_re } -@[is_R_or_C_simps] lemma smul_im : ∀ (r : ℝ) (z : K), im (r • z) = r * (im z) := -λ r z, by { rw algebra.smul_def, apply of_real_mul_im } - -/-! ### The imaginary unit, `I` -/ - -/-- The imaginary unit. -/ -@[simp, is_R_or_C_simps] lemma I_re : re (I : K) = 0 := I_re_ax -@[simp, is_R_or_C_simps] lemma I_im (z : K) : im z * im (I : K) = im z := mul_im_I_ax z -@[simp, is_R_or_C_simps] lemma I_im' (z : K) : im (I : K) * im z = im z := -by rw [mul_comm, I_im _] - -@[simp, is_R_or_C_simps] lemma I_mul_re (z : K) : re (I * z) = - im z := -by simp only [I_re, zero_sub, I_im', zero_mul, mul_re] - -lemma I_mul_I : (I : K) = 0 ∨ (I : K) * I = -1 := I_mul_I_ax - -@[simp, is_R_or_C_simps] lemma conj_re (z : K) : re (conj z) = re z := is_R_or_C.conj_re_ax z -@[simp, is_R_or_C_simps] lemma conj_im (z : K) : im (conj z) = -(im z) := is_R_or_C.conj_im_ax z -@[simp, is_R_or_C_simps] lemma conj_I : conj (I : K) = -I := is_R_or_C.conj_I_ax -@[simp, is_R_or_C_simps] lemma conj_of_real (r : ℝ) : conj (r : K) = (r : K) := -by { rw ext_iff, simp only [of_real_im, conj_im, eq_self_iff_true, conj_re, and_self, neg_zero] } - - -@[simp, is_R_or_C_simps] lemma conj_bit0 (z : K) : conj (bit0 z) = bit0 (conj z) := -by simp only [bit0, ring_hom.map_add, eq_self_iff_true] -@[simp, is_R_or_C_simps] lemma conj_bit1 (z : K) : conj (bit1 z) = bit1 (conj z) := -by simp only [bit0, ext_iff, bit1_re, conj_im, eq_self_iff_true, conj_re, neg_add_rev, - and_self, bit1_im] - -@[simp, is_R_or_C_simps] lemma conj_neg_I : conj (-I) = (I : K) := -by simp only [conj_I, ring_hom.map_neg, eq_self_iff_true, neg_neg] - -lemma conj_eq_re_sub_im (z : K) : conj z = re z - (im z) * I := -by { rw ext_iff, simp only [add_zero, I_re, of_real_im, I_im, zero_sub, zero_mul, conj_im, - of_real_re, eq_self_iff_true, sub_zero, conj_re, mul_im, neg_inj, - and_self, mul_re, mul_zero, map_sub], } - -@[is_R_or_C_simps] lemma conj_smul (r : ℝ) (z : K) : conj (r • z) = r • conj z := -begin - simp_rw conj_eq_re_sub_im, - simp only [smul_re, smul_im, of_real_mul], - rw smul_sub, - simp_rw of_real_alg, - simp only [one_mul, algebra.smul_mul_assoc], -end - -lemma eq_conj_iff_real {z : K} : conj z = z ↔ ∃ r : ℝ, z = (r : K) := -begin - split, - { intro h, - suffices : im z = 0, - { use (re z), - rw ← add_zero (coe _), - convert (re_add_im z).symm, simp [this] }, - contrapose! h, - rw ← re_add_im z, - simp only [conj_of_real, ring_hom.map_add, ring_hom.map_mul, conj_I_ax], - rw [add_left_cancel_iff, ext_iff], - simpa [neg_eq_iff_add_eq_zero, add_self_eq_zero] }, - { rintros ⟨r, rfl⟩, apply conj_of_real } -end - -@[simp] lemma star_def : (has_star.star : K → K) = conj := rfl - -variables (K) -/-- Conjugation as a ring equivalence. This is used to convert the inner product into a -sesquilinear product. -/ -abbreviation conj_to_ring_equiv : K ≃+* Kᵐᵒᵖ := star_ring_equiv - -variables {K} - -lemma eq_conj_iff_re {z : K} : conj z = z ↔ ((re z) : K) = z := -eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩ - -/-- The norm squared function. -/ -def norm_sq : K →*₀ ℝ := -{ to_fun := λ z, re z * re z + im z * im z, - map_zero' := by simp only [add_zero, mul_zero, map_zero], - map_one' := by simp only [one_im, add_zero, mul_one, one_re, mul_zero], - map_mul' := λ z w, by { simp only [mul_im, mul_re], ring } } - -lemma norm_sq_eq_def {z : K} : ∥z∥^2 = (re z) * (re z) + (im z) * (im z) := norm_sq_eq_def_ax z -lemma norm_sq_eq_def' (z : K) : norm_sq z = ∥z∥^2 := by { rw norm_sq_eq_def, refl } - -@[simp, is_R_or_C_simps] lemma norm_sq_of_real (r : ℝ) : ∥(r : K)∥^2 = r * r := -by simp only [norm_sq_eq_def, add_zero, mul_zero] with is_R_or_C_simps - -@[is_R_or_C_simps] lemma norm_sq_zero : norm_sq (0 : K) = 0 := norm_sq.map_zero -@[is_R_or_C_simps] lemma norm_sq_one : norm_sq (1 : K) = 1 := norm_sq.map_one - -lemma norm_sq_nonneg (z : K) : 0 ≤ norm_sq z := -add_nonneg (mul_self_nonneg _) (mul_self_nonneg _) - -@[simp, is_R_or_C_simps] lemma norm_sq_eq_zero {z : K} : norm_sq z = 0 ↔ z = 0 := -by { rw [norm_sq_eq_def'], simp [sq] } - -@[simp, is_R_or_C_simps] lemma norm_sq_pos {z : K} : 0 < norm_sq z ↔ z ≠ 0 := -by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [norm_sq_nonneg] - -@[simp, is_R_or_C_simps] lemma norm_sq_neg (z : K) : norm_sq (-z) = norm_sq z := -by simp only [norm_sq_eq_def', norm_neg] - -@[simp, is_R_or_C_simps] lemma norm_sq_conj (z : K) : norm_sq (conj z) = norm_sq z := -by simp only [norm_sq, neg_mul, monoid_with_zero_hom.coe_mk, - mul_neg, neg_neg] with is_R_or_C_simps - -@[simp, is_R_or_C_simps] lemma norm_sq_mul (z w : K) : norm_sq (z * w) = norm_sq z * norm_sq w := -norm_sq.map_mul z w - -lemma norm_sq_add (z w : K) : - norm_sq (z + w) = norm_sq z + norm_sq w + 2 * (re (z * conj w)) := -by { simp only [norm_sq, map_add, monoid_with_zero_hom.coe_mk, mul_neg, - sub_neg_eq_add] with is_R_or_C_simps, ring } - -lemma re_sq_le_norm_sq (z : K) : re z * re z ≤ norm_sq z := -le_add_of_nonneg_right (mul_self_nonneg _) - -lemma im_sq_le_norm_sq (z : K) : im z * im z ≤ norm_sq z := -le_add_of_nonneg_left (mul_self_nonneg _) - -theorem mul_conj (z : K) : z * conj z = ((norm_sq z) : K) := -by simp only [map_add, add_zero, ext_iff, monoid_with_zero_hom.coe_mk, - add_left_inj, mul_eq_mul_left_iff, zero_mul, add_comm, true_or, eq_self_iff_true, - mul_neg, add_right_neg, zero_add, norm_sq, mul_comm, and_self, - neg_neg, mul_zero, sub_eq_neg_add, neg_zero] with is_R_or_C_simps - -theorem add_conj (z : K) : z + conj z = 2 * (re z) := -by simp only [ext_iff, two_mul, map_add, add_zero, of_real_im, conj_im, of_real_re, - eq_self_iff_true, add_right_neg, conj_re, and_self] - -/-- The pseudo-coercion `of_real` as a `ring_hom`. -/ -noncomputable def of_real_hom : ℝ →+* K := algebra_map ℝ K - -/-- The coercion from reals as a `ring_hom`. -/ -noncomputable def coe_hom : ℝ →+* K := ⟨coe, of_real_one, of_real_mul, of_real_zero, of_real_add⟩ - -@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_sub (r s : ℝ) : - ((r - s : ℝ) : K) = r - s := -ext_iff.2 $ by simp only [of_real_im, of_real_re, eq_self_iff_true, sub_zero, and_self, map_sub] - -@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_pow (r : ℝ) (n : ℕ) : - ((r ^ n : ℝ) : K) = r ^ n := -begin - induction n, - { simp only [of_real_one, pow_zero]}, - { simp only [*, of_real_mul, pow_succ]} -end - -theorem sub_conj (z : K) : z - conj z = (2 * im z) * I := -by simp only [ext_iff, two_mul, sub_eq_add_neg, add_mul, map_add, add_zero, add_left_inj, zero_mul, - map_add_neg, eq_self_iff_true, add_right_neg, and_self, neg_neg, mul_zero, neg_zero] - with is_R_or_C_simps - -lemma norm_sq_sub (z w : K) : norm_sq (z - w) = norm_sq z + norm_sq w - 2 * re (z * conj w) := -by simp only [norm_sq_add, sub_eq_add_neg, ring_equiv.map_neg, mul_neg, - norm_sq_neg, map_neg] - -lemma sqrt_norm_sq_eq_norm {z : K} : real.sqrt (norm_sq z) = ∥z∥ := -begin - have h₂ : ∥z∥ = real.sqrt (∥z∥^2) := (real.sqrt_sq (norm_nonneg z)).symm, - rw [h₂], - exact congr_arg real.sqrt (norm_sq_eq_def' z) -end - -/-! ### Inversion -/ - -@[simp, is_R_or_C_simps] lemma inv_re (z : K) : re (z⁻¹) = re z / norm_sq z := -by simp only [inv_def, norm_sq_eq_def, norm_sq, division_def, - monoid_with_zero_hom.coe_mk, sub_zero, mul_zero] with is_R_or_C_simps -@[simp, is_R_or_C_simps] lemma inv_im (z : K) : im (z⁻¹) = im (-z) / norm_sq z := -by simp only [inv_def, norm_sq_eq_def, norm_sq, division_def, of_real_im, - monoid_with_zero_hom.coe_mk, of_real_re, zero_add, map_neg, mul_zero] - with is_R_or_C_simps - -@[simp, norm_cast, is_R_or_C_simps, priority 900] -lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : K) = r⁻¹ := -begin - rw ext_iff, - by_cases r = 0, - { simp only [h, of_real_zero, inv_zero, and_self, map_zero]}, - { simp only with is_R_or_C_simps, - field_simp [h, norm_sq] } -end - -protected lemma inv_zero : (0⁻¹ : K) = 0 := -by rw [← of_real_zero, ← of_real_inv, inv_zero] - -protected theorem mul_inv_cancel {z : K} (h : z ≠ 0) : z * z⁻¹ = 1 := -by rw [inv_def, ←mul_assoc, mul_conj, ←of_real_mul, ←norm_sq_eq_def', - mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one] - -lemma div_re (z w : K) : re (z / w) = re z * re w / norm_sq w + im z * im w / norm_sq w := -by simp only [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, neg_mul, - mul_neg, neg_neg, map_neg] with is_R_or_C_simps -lemma div_im (z w : K) : im (z / w) = im z * re w / norm_sq w - re z * im w / norm_sq w := -by simp only [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm, neg_mul, - mul_neg, map_neg] with is_R_or_C_simps - -@[simp, is_R_or_C_simps] -lemma conj_inv (x : K) : conj (x⁻¹) = (conj x)⁻¹ := star_inv' _ - -@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_div (r s : ℝ) : - ((r / s : ℝ) : K) = r / s := -(@is_R_or_C.coe_hom K _).map_div r s - -lemma div_re_of_real {z : K} {r : ℝ} : re (z / r) = re z / r := -begin - by_cases h : r = 0, - { simp only [h, of_real_zero, div_zero, zero_re']}, - { change r ≠ 0 at h, - rw [div_eq_mul_inv, ←of_real_inv, div_eq_mul_inv], - simp only [one_div, of_real_im, of_real_re, sub_zero, mul_re, mul_zero]} -end - -@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_zpow (r : ℝ) (n : ℤ) : - ((r ^ n : ℝ) : K) = r ^ n := -(@is_R_or_C.coe_hom K _).map_zpow r n - -lemma I_mul_I_of_nonzero : (I : K) ≠ 0 → (I : K) * I = -1 := -by { have := I_mul_I_ax, tauto } - -@[simp, is_R_or_C_simps] lemma div_I (z : K) : z / I = -(z * I) := -begin - by_cases h : (I : K) = 0, - { simp [h] }, - { field_simp [mul_assoc, I_mul_I_of_nonzero h] } -end - -@[simp, is_R_or_C_simps] lemma inv_I : (I : K)⁻¹ = -I := -by field_simp - -@[simp, is_R_or_C_simps] lemma norm_sq_inv (z : K) : norm_sq z⁻¹ = (norm_sq z)⁻¹ := -(@norm_sq K _).map_inv z - -@[simp, is_R_or_C_simps] lemma norm_sq_div (z w : K) : norm_sq (z / w) = norm_sq z / norm_sq w := -(@norm_sq K _).map_div z w - -@[is_R_or_C_simps] lemma norm_conj {z : K} : ∥conj z∥ = ∥z∥ := -by simp only [←sqrt_norm_sq_eq_norm, norm_sq_conj] - -@[priority 100] instance : cstar_ring K := -{ norm_star_mul_self := λ x, (norm_mul _ _).trans $ congr_arg (* ∥x∥) norm_conj } - -/-! ### Cast lemmas -/ - -@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_nat_cast (n : ℕ) : - ((n : ℝ) : K) = n := -show (algebra_map ℝ K) n = n, from map_nat_cast of_real_hom n ---of_real_hom.map_nat_cast n ---@[simp, norm_cast, priority 900] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : K) = n := - -@[simp, is_R_or_C_simps, norm_cast] lemma nat_cast_re (n : ℕ) : re (n : K) = n := -by rw [← of_real_nat_cast, of_real_re] - -@[simp, is_R_or_C_simps, norm_cast] lemma nat_cast_im (n : ℕ) : im (n : K) = 0 := -by rw [← of_real_nat_cast, of_real_im] - -@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_int_cast (n : ℤ) : - ((n : ℝ) : K) = n := -of_real_hom.map_int_cast n - -@[simp, is_R_or_C_simps, norm_cast] lemma int_cast_re (n : ℤ) : re (n : K) = n := -by rw [← of_real_int_cast, of_real_re] - -@[simp, is_R_or_C_simps, norm_cast] lemma int_cast_im (n : ℤ) : im (n : K) = 0 := -by rw [← of_real_int_cast, of_real_im] - -@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_rat_cast (n : ℚ) : - ((n : ℝ) : K) = n := -map_rat_cast (@is_R_or_C.of_real_hom K _) n - -@[simp, is_R_or_C_simps, norm_cast] lemma rat_cast_re (q : ℚ) : re (q : K) = q := -by rw [← of_real_rat_cast, of_real_re] - -@[simp, is_R_or_C_simps, norm_cast] lemma rat_cast_im (q : ℚ) : im (q : K) = 0 := -by rw [← of_real_rat_cast, of_real_im] - -/-! ### Characteristic zero -/ -/-- ℝ and ℂ are both of characteristic zero. -/ -@[priority 100] -- see Note [lower instance priority] -instance char_zero_R_or_C : char_zero K := -char_zero_of_inj_zero $ λ n h, -by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h - -theorem re_eq_add_conj (z : K) : ↑(re z) = (z + conj z) / 2 := -by rw [add_conj, mul_div_cancel_left ((re z):K) two_ne_zero'] - -theorem im_eq_conj_sub (z : K) : ↑(im z) = I * (conj z - z) / 2 := -begin - rw [← neg_inj, ← of_real_neg, ← I_mul_re, re_eq_add_conj], - simp only [mul_add, sub_eq_add_neg, neg_div', neg_mul, conj_I, - mul_neg, neg_add_rev, neg_neg, ring_hom.map_mul] -end - -/-! ### Absolute value -/ - -/-- The complex absolute value function, defined as the square root of the norm squared. -/ -@[pp_nodot] noncomputable def abs (z : K) : ℝ := (norm_sq z).sqrt - -local notation `abs'` := has_abs.abs -local notation `absK` := @abs K _ - -@[simp, norm_cast] lemma abs_of_real (r : ℝ) : absK r = abs' r := -by simp only [abs, norm_sq, real.sqrt_mul_self_eq_abs, add_zero, of_real_im, - monoid_with_zero_hom.coe_mk, of_real_re, mul_zero] - -lemma norm_eq_abs (z : K) : ∥z∥ = absK z := -by simp only [abs, norm_sq_eq_def', norm_nonneg, real.sqrt_sq] - -@[is_R_or_C_simps, norm_cast] -lemma norm_of_real (z : ℝ) : ∥(z : K)∥ = ∥z∥ := -by { rw [is_R_or_C.norm_eq_abs, is_R_or_C.abs_of_real, real.norm_eq_abs] } - -lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : absK r = r := -(abs_of_real _).trans (abs_of_nonneg h) - -lemma norm_of_nonneg {r : ℝ} (r_nn : 0 ≤ r) : ∥(r : K)∥ = r := -by { rw norm_of_real, exact abs_eq_self.mpr r_nn, } - -lemma abs_of_nat (n : ℕ) : absK n = n := -by { rw [← of_real_nat_cast], exact abs_of_nonneg (nat.cast_nonneg n) } - -lemma mul_self_abs (z : K) : abs z * abs z = norm_sq z := -real.mul_self_sqrt (norm_sq_nonneg _) - -@[simp, is_R_or_C_simps] lemma abs_zero : absK 0 = 0 := by simp only [abs, real.sqrt_zero, map_zero] -@[simp, is_R_or_C_simps] lemma abs_one : absK 1 = 1 := by simp only [abs, map_one, real.sqrt_one] - -@[simp, is_R_or_C_simps] lemma abs_two : absK 2 = 2 := -calc absK 2 = absK (2 : ℝ) : by rw [of_real_bit0, of_real_one] -... = (2 : ℝ) : abs_of_nonneg (by norm_num) - -lemma abs_nonneg (z : K) : 0 ≤ absK z := -real.sqrt_nonneg _ - -@[simp, is_R_or_C_simps] lemma abs_eq_zero {z : K} : absK z = 0 ↔ z = 0 := -(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero - -lemma abs_ne_zero {z : K} : abs z ≠ 0 ↔ z ≠ 0 := -not_congr abs_eq_zero - -@[simp, is_R_or_C_simps] lemma abs_conj (z : K) : abs (conj z) = abs z := -by simp only [abs, norm_sq_conj] - -@[simp, is_R_or_C_simps] lemma abs_mul (z w : K) : abs (z * w) = abs z * abs w := -by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl - -lemma abs_re_le_abs (z : K) : abs' (re z) ≤ abs z := -by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg (re z)) (abs_nonneg _), - abs_mul_abs_self, mul_self_abs]; - apply re_sq_le_norm_sq - -lemma abs_im_le_abs (z : K) : abs' (im z) ≤ abs z := -by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg (im z)) (abs_nonneg _), - abs_mul_abs_self, mul_self_abs]; - apply im_sq_le_norm_sq - -lemma norm_re_le_norm (z : K) : ∥re z∥ ≤ ∥z∥ := -by { rw [is_R_or_C.norm_eq_abs, real.norm_eq_abs], exact is_R_or_C.abs_re_le_abs _, } - -lemma norm_im_le_norm (z : K) : ∥im z∥ ≤ ∥z∥ := -by { rw [is_R_or_C.norm_eq_abs, real.norm_eq_abs], exact is_R_or_C.abs_im_le_abs _, } - -lemma re_le_abs (z : K) : re z ≤ abs z := -(abs_le.1 (abs_re_le_abs _)).2 - -lemma im_le_abs (z : K) : im z ≤ abs z := -(abs_le.1 (abs_im_le_abs _)).2 - -lemma im_eq_zero_of_le {a : K} (h : abs a ≤ re a) : im a = 0 := -begin - rw ← zero_eq_mul_self, - have : re a * re a = re a * re a + im a * im a, - { convert is_R_or_C.mul_self_abs a; - linarith [re_le_abs a] }, - linarith -end - -lemma re_eq_self_of_le {a : K} (h : abs a ≤ re a) : (re a : K) = a := -by { rw ← re_add_im a, simp only [im_eq_zero_of_le h, add_zero, zero_mul] with is_R_or_C_simps } - -lemma abs_add (z w : K) : abs (z + w) ≤ abs z + abs w := -(mul_self_le_mul_self_iff (abs_nonneg _) - (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $ -begin - rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs, - add_right_comm, norm_sq_add, add_le_add_iff_left, - mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _)], - simpa [-mul_re] with is_R_or_C_simps using re_le_abs (z * conj w) -end - -instance : is_absolute_value absK := -{ abv_nonneg := abs_nonneg, - abv_eq_zero := λ _, abs_eq_zero, - abv_add := abs_add, - abv_mul := abs_mul } -open is_absolute_value - -@[simp, is_R_or_C_simps] lemma abs_abs (z : K) : abs' (abs z) = abs z := -_root_.abs_of_nonneg (abs_nonneg _) - -@[simp, is_R_or_C_simps] lemma abs_pos {z : K} : 0 < abs z ↔ z ≠ 0 := abv_pos abs -@[simp, is_R_or_C_simps] lemma abs_neg : ∀ z : K, abs (-z) = abs z := abv_neg abs -lemma abs_sub : ∀ z w : K, abs (z - w) = abs (w - z) := abv_sub abs -lemma abs_sub_le : ∀ a b c : K, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs -@[simp, is_R_or_C_simps] theorem abs_inv : ∀ z : K, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs -@[simp, is_R_or_C_simps] theorem abs_div : ∀ z w : K, abs (z / w) = abs z / abs w := abv_div abs - -lemma abs_abs_sub_le_abs_sub : ∀ z w : K, abs' (abs z - abs w) ≤ abs (z - w) := -abs_abv_sub_le_abv_sub abs - -lemma abs_re_div_abs_le_one (z : K) : abs' (re z / abs z) ≤ 1 := -begin - by_cases hz : z = 0, - { simp [hz, zero_le_one] }, - { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_re_le_abs] } -end - -lemma abs_im_div_abs_le_one (z : K) : abs' (im z / abs z) ≤ 1 := -begin - by_cases hz : z = 0, - { simp [hz, zero_le_one] }, - { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_im_le_abs] } -end - -@[simp, is_R_or_C_simps, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : K) = n := -by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)] - -lemma norm_sq_eq_abs (x : K) : norm_sq x = abs x ^ 2 := -by rw [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)] - -lemma re_eq_abs_of_mul_conj (x : K) : re (x * (conj x)) = abs (x * (conj x)) := -by rw [mul_conj, of_real_re, abs_of_real, norm_sq_eq_abs, sq, _root_.abs_mul, abs_abs] - -lemma abs_sq_re_add_conj (x : K) : (abs (x + conj x))^2 = (re (x + conj x))^2 := -by simp only [sq, ←norm_sq_eq_abs, norm_sq, map_add, add_zero, monoid_with_zero_hom.coe_mk, - add_right_neg, mul_zero] with is_R_or_C_simps - -lemma abs_sq_re_add_conj' (x : K) : (abs (conj x + x))^2 = (re (conj x + x))^2 := -by simp only [sq, ←norm_sq_eq_abs, norm_sq, map_add, add_zero, monoid_with_zero_hom.coe_mk, - add_left_neg, mul_zero] with is_R_or_C_simps - -lemma conj_mul_eq_norm_sq_left (x : K) : conj x * x = ((norm_sq x) : K) := -begin - rw ext_iff, - refine ⟨by simp only [norm_sq, neg_mul, monoid_with_zero_hom.coe_mk, - sub_neg_eq_add, map_add, sub_zero, mul_zero] with is_R_or_C_simps, _⟩, - simp only [mul_comm, mul_neg, add_left_neg] with is_R_or_C_simps -end - -/-! ### Cauchy sequences -/ - -theorem is_cau_seq_re (f : cau_seq K abs) : is_cau_seq abs' (λ n, re (f n)) := -λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij, -lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij) - -theorem is_cau_seq_im (f : cau_seq K abs) : is_cau_seq abs' (λ n, im (f n)) := -λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij, -lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij) - -/-- The real part of a K Cauchy sequence, as a real Cauchy sequence. -/ -noncomputable def cau_seq_re (f : cau_seq K abs) : cau_seq ℝ abs' := -⟨_, is_cau_seq_re f⟩ - -/-- The imaginary part of a K Cauchy sequence, as a real Cauchy sequence. -/ -noncomputable def cau_seq_im (f : cau_seq K abs) : cau_seq ℝ abs' := -⟨_, is_cau_seq_im f⟩ - -lemma is_cau_seq_abs {f : ℕ → K} (hf : is_cau_seq abs f) : - is_cau_seq abs' (abs ∘ f) := -λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in -⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩ - -@[simp, is_R_or_C_simps, norm_cast, priority 900] -lemma of_real_prod {α : Type*} (s : finset α) (f : α → ℝ) : - ((∏ i in s, f i : ℝ) : K) = ∏ i in s, (f i : K) := -ring_hom.map_prod _ _ _ - -@[simp, is_R_or_C_simps, norm_cast, priority 900] -lemma of_real_sum {α : Type*} (s : finset α) (f : α → ℝ) : - ((∑ i in s, f i : ℝ) : K) = ∑ i in s, (f i : K) := -ring_hom.map_sum _ _ _ - -@[simp, is_R_or_C_simps, norm_cast] lemma of_real_finsupp_sum - {α M : Type*} [has_zero M] (f : α →₀ M) (g : α → M → ℝ) : - ((f.sum (λ a b, g a b) : ℝ) : K) = f.sum (λ a b, ((g a b) : K)) := -ring_hom.map_finsupp_sum _ f g - -@[simp, is_R_or_C_simps, norm_cast] lemma of_real_finsupp_prod - {α M : Type*} [has_zero M] (f : α →₀ M) (g : α → M → ℝ) : - ((f.prod (λ a b, g a b) : ℝ) : K) = f.prod (λ a b, ((g a b) : K)) := -ring_hom.map_finsupp_prod _ f g - -end is_R_or_C - -namespace polynomial - -open_locale polynomial - -lemma of_real_eval (p : ℝ[X]) (x : ℝ) : (p.eval x : K) = aeval ↑x p := -(@aeval_algebra_map_apply ℝ K _ _ _ x p).symm - -end polynomial - -namespace finite_dimensional - -open_locale classical -open is_R_or_C - -/-- This instance generates a type-class problem with a metavariable `?m` that should satisfy -`is_R_or_C ?m`. Since this can only be satisfied by `ℝ` or `ℂ`, this does not cause problems. -/ -library_note "is_R_or_C instance" - -/-- An `is_R_or_C` field is finite-dimensional over `ℝ`, since it is spanned by `{1, I}`. -/ -@[nolint dangerous_instance] instance is_R_or_C_to_real : finite_dimensional ℝ K := -⟨⟨{1, I}, - begin - rw eq_top_iff, - intros a _, - rw [finset.coe_insert, finset.coe_singleton, submodule.mem_span_insert], - refine ⟨re a, (im a) • I, _, _⟩, - { rw submodule.mem_span_singleton, - use im a }, - simp [re_add_im a, algebra.smul_def, algebra_map_eq_of_real] - end⟩⟩ - -variables (K) (E : Type*) [normed_group E] [normed_space K E] - -/-- A finite dimensional vector space Over an `is_R_or_C` is a proper metric space. - -This is not an instance because it would cause a search for `finite_dimensional ?x E` before -`is_R_or_C ?x`. -/ -lemma proper_is_R_or_C [finite_dimensional K E] : proper_space E := -begin - letI : normed_space ℝ E := restrict_scalars.normed_space ℝ K E, - letI : finite_dimensional ℝ E := finite_dimensional.trans ℝ K E, - apply_instance -end - -variable {E} - -instance is_R_or_C.proper_space_submodule (S : submodule K E) [finite_dimensional K ↥S] : - proper_space S := -proper_is_R_or_C K S - -end finite_dimensional - -section instances - -noncomputable instance real.is_R_or_C : is_R_or_C ℝ := -{ re := add_monoid_hom.id ℝ, - im := 0, - I := 0, - I_re_ax := by simp only [add_monoid_hom.map_zero], - I_mul_I_ax := or.intro_left _ rfl, - re_add_im_ax := λ z, by simp only [add_zero, mul_zero, algebra.id.map_eq_id, ring_hom.id_apply, - add_monoid_hom.id_apply], - of_real_re_ax := λ r, by simp only [add_monoid_hom.id_apply, algebra.id.map_eq_self], - of_real_im_ax := λ r, by simp only [add_monoid_hom.zero_apply], - mul_re_ax := λ z w, - by simp only [sub_zero, mul_zero, add_monoid_hom.zero_apply, add_monoid_hom.id_apply], - mul_im_ax := λ z w, by simp only [add_zero, zero_mul, mul_zero, add_monoid_hom.zero_apply], - conj_re_ax := λ z, by simp only [star_ring_end_apply, star_id_of_comm], - conj_im_ax := λ z, by simp only [neg_zero, add_monoid_hom.zero_apply], - conj_I_ax := by simp only [ring_hom.map_zero, neg_zero], - norm_sq_eq_def_ax := λ z, by simp only [sq, norm, ←abs_mul, abs_mul_self z, add_zero, - mul_zero, add_monoid_hom.zero_apply, add_monoid_hom.id_apply], - mul_im_I_ax := λ z, by simp only [mul_zero, add_monoid_hom.zero_apply], - inv_def_ax := λ z, by simp only [star_ring_end_apply, star, sq, real.norm_eq_abs, - abs_mul_abs_self, ←div_eq_mul_inv, algebra.id.map_eq_id, id.def, ring_hom.id_apply, - div_self_mul_self'], - div_I_ax := λ z, by simp only [div_zero, mul_zero, neg_zero]} - -end instances - -namespace is_R_or_C - -open_locale complex_conjugate - -section cleanup_lemmas - -local notation `reR` := @is_R_or_C.re ℝ _ -local notation `imR` := @is_R_or_C.im ℝ _ -local notation `IR` := @is_R_or_C.I ℝ _ -local notation `absR` := @is_R_or_C.abs ℝ _ -local notation `norm_sqR` := @is_R_or_C.norm_sq ℝ _ - -@[simp, is_R_or_C_simps] lemma re_to_real {x : ℝ} : reR x = x := rfl -@[simp, is_R_or_C_simps] lemma im_to_real {x : ℝ} : imR x = 0 := rfl -@[simp, is_R_or_C_simps] lemma conj_to_real {x : ℝ} : conj x = x := rfl -@[simp, is_R_or_C_simps] lemma I_to_real : IR = 0 := rfl -@[simp, is_R_or_C_simps] lemma norm_sq_to_real {x : ℝ} : norm_sq x = x*x := -by simp [is_R_or_C.norm_sq] -@[simp, is_R_or_C_simps] lemma abs_to_real {x : ℝ} : absR x = has_abs.abs x := -by simp [is_R_or_C.abs, abs, real.sqrt_mul_self_eq_abs] - -@[simp] lemma coe_real_eq_id : @coe ℝ ℝ _ = id := rfl - -end cleanup_lemmas - -section linear_maps - -/-- The real part in a `is_R_or_C` field, as a linear map. -/ -def re_lm : K →ₗ[ℝ] ℝ := -{ map_smul' := smul_re, .. re } - -@[simp, is_R_or_C_simps] lemma re_lm_coe : (re_lm : K → ℝ) = re := rfl - -/-- The real part in a `is_R_or_C` field, as a continuous linear map. -/ -noncomputable def re_clm : K →L[ℝ] ℝ := -linear_map.mk_continuous re_lm 1 $ by -{ simp only [norm_eq_abs, re_lm_coe, one_mul, abs_to_real], exact abs_re_le_abs, } - -@[simp, is_R_or_C_simps] lemma re_clm_norm : ∥(re_clm : K →L[ℝ] ℝ)∥ = 1 := -begin - apply le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _), - convert continuous_linear_map.ratio_le_op_norm _ (1 : K), - { simp }, - { apply_instance } -end - -@[simp, is_R_or_C_simps, norm_cast] lemma re_clm_coe : ((re_clm : K →L[ℝ] ℝ) : - K →ₗ[ℝ] ℝ) = re_lm := rfl - -@[simp, is_R_or_C_simps] lemma re_clm_apply : ((re_clm : K →L[ℝ] ℝ) : K → ℝ) = re := rfl - -@[continuity] lemma continuous_re : continuous (re : K → ℝ) := re_clm.continuous - -/-- The imaginary part in a `is_R_or_C` field, as a linear map. -/ -def im_lm : K →ₗ[ℝ] ℝ := -{ map_smul' := smul_im, .. im } - -@[simp, is_R_or_C_simps] lemma im_lm_coe : (im_lm : K → ℝ) = im := rfl - -/-- The imaginary part in a `is_R_or_C` field, as a continuous linear map. -/ -noncomputable def im_clm : K →L[ℝ] ℝ := -linear_map.mk_continuous im_lm 1 $ by -{ simp only [norm_eq_abs, re_lm_coe, one_mul, abs_to_real], exact abs_im_le_abs, } - -@[simp, is_R_or_C_simps, norm_cast] lemma im_clm_coe : ((im_clm : K →L[ℝ] ℝ) : - K →ₗ[ℝ] ℝ) = im_lm := rfl - -@[simp, is_R_or_C_simps] lemma im_clm_apply : ((im_clm : K →L[ℝ] ℝ) : K → ℝ) = im := rfl - -@[continuity] lemma continuous_im : continuous (im : K → ℝ) := im_clm.continuous - -/-- Conjugate as an `ℝ`-algebra equivalence -/ -def conj_ae : K ≃ₐ[ℝ] K := -{ inv_fun := conj, - left_inv := conj_conj, - right_inv := conj_conj, - commutes' := conj_of_real, - .. conj } - -@[simp, is_R_or_C_simps] lemma conj_ae_coe : (conj_ae : K → K) = conj := rfl - -/-- Conjugate as a linear isometry -/ -noncomputable def conj_lie : K ≃ₗᵢ[ℝ] K := -⟨conj_ae.to_linear_equiv, λ z, by simp [norm_eq_abs] with is_R_or_C_simps⟩ - -@[simp, is_R_or_C_simps] lemma conj_lie_apply : (conj_lie : K → K) = conj := rfl - -/-- Conjugate as a continuous linear equivalence -/ -noncomputable def conj_cle : K ≃L[ℝ] K := @conj_lie K _ - -@[simp, is_R_or_C_simps] lemma conj_cle_coe : - (@conj_cle K _).to_linear_equiv = conj_ae.to_linear_equiv := rfl - -@[simp, is_R_or_C_simps] lemma conj_cle_apply : (conj_cle : K → K) = conj := rfl - -@[simp, is_R_or_C_simps] lemma conj_cle_norm : ∥(@conj_cle K _ : K →L[ℝ] K)∥ = 1 := -(@conj_lie K _).to_linear_isometry.norm_to_continuous_linear_map - -@[priority 100] -instance : has_continuous_star K := ⟨conj_lie.continuous⟩ - -@[continuity] lemma continuous_conj : continuous (conj : K → K) := continuous_star - -/-- The `ℝ → K` coercion, as a linear map -/ -noncomputable def of_real_am : ℝ →ₐ[ℝ] K := algebra.of_id ℝ K - -@[simp, is_R_or_C_simps] lemma of_real_am_coe : (of_real_am : ℝ → K) = coe := rfl - -/-- The ℝ → K coercion, as a linear isometry -/ -noncomputable def of_real_li : ℝ →ₗᵢ[ℝ] K := -{ to_linear_map := of_real_am.to_linear_map, norm_map' := by simp [norm_eq_abs] } - -@[simp, is_R_or_C_simps] lemma of_real_li_apply : (of_real_li : ℝ → K) = coe := rfl - -/-- The `ℝ → K` coercion, as a continuous linear map -/ -noncomputable def of_real_clm : ℝ →L[ℝ] K := of_real_li.to_continuous_linear_map - -@[simp, is_R_or_C_simps] lemma of_real_clm_coe : - ((@of_real_clm K _) : ℝ →ₗ[ℝ] K) = of_real_am.to_linear_map := rfl - -@[simp, is_R_or_C_simps] lemma of_real_clm_apply : (of_real_clm : ℝ → K) = coe := rfl - -@[simp, is_R_or_C_simps] lemma of_real_clm_norm : ∥(of_real_clm : ℝ →L[ℝ] K)∥ = 1 := -linear_isometry.norm_to_continuous_linear_map of_real_li - -@[continuity] lemma continuous_of_real : continuous (coe : ℝ → K) := of_real_li.continuous - -end linear_maps - -end is_R_or_C diff --git a/src/data/complex/module.lean b/src/data/complex/module.lean index 4490993562cf0..cac447e5921fc 100644 --- a/src/data/complex/module.lean +++ b/src/data/complex/module.lean @@ -7,12 +7,16 @@ import algebra.order.smul import data.complex.basic import data.fin.vec_notation import field_theory.tower +import algebra.char_p.invertible /-! # Complex number as a vector space over `ℝ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the following instances: -* Any `•`-structure (`has_scalar`, `mul_action`, `distrib_mul_action`, `module`, `algebra`) on +* Any `•`-structure (`has_smul`, `mul_action`, `distrib_mul_action`, `module`, `algebra`) on `ℝ` imbues a corresponding structure on `ℂ`. This includes the statement that `ℂ` is an `ℝ` algebra. * any complex vector space is a real vector space; @@ -31,6 +35,13 @@ part, the embedding of `ℝ` in `ℂ`, and the complex conjugate): It also provides a universal property of the complex numbers `complex.lift`, which constructs a `ℂ →ₐ[ℝ] A` into any `ℝ`-algebra `A` given a square root of `-1`. +In addition, this file provides a decomposition into `real_part` and `imaginary_part` for any +element of a `star_module` over `ℂ`. + +## Notation + +* `ℜ` and `ℑ` for the `real_part` and `imaginary_part`, respectively, in the locale + `complex_star_module`. -/ namespace complex @@ -41,11 +52,11 @@ variables {R : Type*} {S : Type*} section -variables [has_scalar R ℝ] +variables [has_smul R ℝ] /- The useless `0` multiplication in `smul` is to make sure that `restrict_scalars.module ℝ ℂ ℂ = complex.module` definitionally. -/ -instance : has_scalar R ℂ := +instance : has_smul R ℂ := { smul := λ r x, ⟨r • x.re - 0 * x.im, r • x.im + 0 * x.re⟩ } lemma smul_re (r : R) (z : ℂ) : (r • z).re = r • z.re := by simp [(•)] @@ -55,14 +66,14 @@ lemma smul_im (r : R) (z : ℂ) : (r • z).im = r • z.im := by simp [(•)] end -instance [has_scalar R ℝ] [has_scalar S ℝ] [smul_comm_class R S ℝ] : smul_comm_class R S ℂ := +instance [has_smul R ℝ] [has_smul S ℝ] [smul_comm_class R S ℝ] : smul_comm_class R S ℂ := { smul_comm := λ r s x, by ext; simp [smul_re, smul_im, smul_comm] } -instance [has_scalar R S] [has_scalar R ℝ] [has_scalar S ℝ] [is_scalar_tower R S ℝ] : +instance [has_smul R S] [has_smul R ℝ] [has_smul S ℝ] [is_scalar_tower R S ℝ] : is_scalar_tower R S ℂ := { smul_assoc := λ r s x, by ext; simp [smul_re, smul_im, smul_assoc] } -instance [has_scalar R ℝ] [has_scalar Rᵐᵒᵖ ℝ] [is_central_scalar R ℝ] : +instance [has_smul R ℝ] [has_smul Rᵐᵒᵖ ℝ] [is_central_scalar R ℝ] : is_central_scalar R ℂ := { op_smul_eq_smul := λ r x, by ext; simp [smul_re, smul_im, op_smul_eq_smul] } @@ -70,10 +81,13 @@ instance [monoid R] [mul_action R ℝ] : mul_action R ℂ := { one_smul := λ x, by ext; simp [smul_re, smul_im, one_smul], mul_smul := λ r s x, by ext; simp [smul_re, smul_im, mul_smul] } -instance [semiring R] [distrib_mul_action R ℝ] : distrib_mul_action R ℂ := +instance [distrib_smul R ℝ] : distrib_smul R ℂ := { smul_add := λ r x y, by ext; simp [smul_re, smul_im, smul_add], smul_zero := λ r, by ext; simp [smul_re, smul_im, smul_zero] } +instance [semiring R] [distrib_mul_action R ℝ] : distrib_mul_action R ℂ := +{ ..complex.distrib_smul } + instance [semiring R] [module R ℝ] : module R ℂ := { add_smul := λ r s x, by ext; simp [smul_re, smul_im, add_smul], zero_smul := λ r, by ext; simp [smul_re, smul_im, zero_smul] } @@ -136,21 +150,20 @@ basis.of_equiv_fun @[simp] lemma coe_basis_one_I : ⇑basis_one_I = ![1, I] := funext $ λ i, basis.apply_eq_iff.mpr $ finsupp.ext $ λ j, by fin_cases i; fin_cases j; - simp only [coe_basis_one_I_repr, finsupp.single_eq_same, finsupp.single_eq_of_ne, - matrix.cons_val_zero, matrix.cons_val_one, matrix.head_cons, - nat.one_ne_zero, fin.one_eq_zero_iff, fin.zero_eq_one_iff, ne.def, not_false_iff, - one_re, one_im, I_re, I_im] + simp only [coe_basis_one_I_repr, finsupp.single_eq_of_ne, matrix.cons_val_zero, + matrix.cons_val_one, matrix.head_cons, fin.one_eq_zero_iff, ne.def, not_false_iff, I_re, + nat.succ_succ_ne_one, one_im, I_im, one_re, finsupp.single_eq_same, fin.zero_eq_one_iff] instance : finite_dimensional ℝ ℂ := of_fintype_basis basis_one_I @[simp] lemma finrank_real_complex : finite_dimensional.finrank ℝ ℂ = 2 := by rw [finrank_eq_card_basis basis_one_I, fintype.card_fin] -@[simp] lemma dim_real_complex : module.rank ℝ ℂ = 2 := -by simp [← finrank_eq_dim, finrank_real_complex] +@[simp] lemma rank_real_complex : module.rank ℝ ℂ = 2 := +by simp [← finrank_eq_rank, finrank_real_complex] -lemma {u} dim_real_complex' : cardinal.lift.{u} (module.rank ℝ ℂ) = 2 := -by simp [← finrank_eq_dim, finrank_real_complex, bit0] +lemma {u} rank_real_complex' : cardinal.lift.{u} (module.rank ℝ ℂ) = 2 := +by simp [← finrank_eq_rank, finrank_real_complex, bit0] /-- `fact` version of the dimension of `ℂ` over `ℝ`, locally useful in the definition of the circle. -/ @@ -173,15 +186,22 @@ restrict_scalars.is_scalar_tower ℝ ℂ E (x : ℂ) • y = x • y := rfl +/-- The scalar action of `ℝ` on a `ℂ`-module `E` induced by `module.complex_to_real` commutes with +another scalar action of `M` on `E` whenever the action of `ℂ` commutes with the action of `M`. -/ +@[priority 900] +instance smul_comm_class.complex_to_real {M E : Type*} + [add_comm_group E] [module ℂ E] [has_smul M E] [smul_comm_class ℂ M E] : smul_comm_class ℝ M E := +{ smul_comm := λ r _ _, (smul_comm (r : ℂ) _ _ : _) } + @[priority 100] instance finite_dimensional.complex_to_real (E : Type*) [add_comm_group E] [module ℂ E] [finite_dimensional ℂ E] : finite_dimensional ℝ E := finite_dimensional.trans ℝ ℂ E -lemma dim_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] : +lemma rank_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] : module.rank ℝ E = 2 * module.rank ℂ E := cardinal.lift_inj.1 $ - by { rw [← dim_mul_dim' ℝ ℂ E, complex.dim_real_complex], simp [bit0] } + by { rw [← lift_rank_mul_lift_rank ℝ ℂ E, complex.rank_real_complex], simp [bit0] } lemma finrank_real_of_complex (E : Type*) [add_comm_group E] [module ℂ E] : finite_dimensional.finrank ℝ E = 2 * finite_dimensional.finrank ℂ E := @@ -190,8 +210,7 @@ by rw [← finite_dimensional.finrank_mul_finrank ℝ ℂ E, complex.finrank_rea @[priority 900] instance star_module.complex_to_real {E : Type*} [add_comm_group E] [has_star E] [module ℂ E] [star_module ℂ E] : star_module ℝ E := -⟨λ r a, by rw [star_trivial r, restrict_scalars_smul_def, restrict_scalars_smul_def, star_smul, - complex.coe_algebra_map, complex.star_def, complex.conj_of_real]⟩ +⟨λ r a, by rw [←smul_one_smul ℂ r a, star_smul, star_smul, star_one, smul_one_smul]⟩ namespace complex @@ -230,13 +249,31 @@ def conj_ae : ℂ ≃ₐ[ℝ] ℂ := /-- The matrix representation of `conj_ae`. -/ @[simp] lemma to_matrix_conj_ae : - linear_map.to_matrix basis_one_I basis_one_I conj_ae.to_linear_map = ![![1, 0], ![0, -1]] := + linear_map.to_matrix basis_one_I basis_one_I conj_ae.to_linear_map = !![1, 0; 0, -1] := begin ext i j, simp [linear_map.to_matrix_apply], fin_cases i; fin_cases j; simp end +/-- The identity and the complex conjugation are the only two `ℝ`-algebra homomorphisms of `ℂ`. -/ +lemma real_alg_hom_eq_id_or_conj (f : ℂ →ₐ[ℝ] ℂ) : f = alg_hom.id ℝ ℂ ∨ f = conj_ae := +begin + refine (eq_or_eq_neg_of_sq_eq_sq (f I) I $ by rw [← map_pow, I_sq, map_neg, map_one]).imp _ _; + refine λ h, alg_hom_ext _, + exacts [h, conj_I.symm ▸ h], +end + +/-- The natural `add_equiv` from `ℂ` to `ℝ × ℝ`. -/ +@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }] +def equiv_real_prod_add_hom : ℂ ≃+ ℝ × ℝ := +{ map_add' := by simp, .. equiv_real_prod } + +/-- The natural `linear_equiv` from `ℂ` to `ℝ × ℝ`. -/ +@[simps apply symm_apply_re symm_apply_im { simp_rhs := tt }] +def equiv_real_prod_lm : ℂ ≃ₗ[ℝ] ℝ × ℝ := +{ map_smul' := by simp [equiv_real_prod_add_hom], .. equiv_real_prod_add_hom } + section lift variables {A : Type*} [ring A] [algebra ℝ A] @@ -292,3 +329,72 @@ alg_hom_ext $ (lift_aux_apply_I _ _).trans conj_I.symm end lift end complex + +section real_imaginary_part + +open complex + +variables {A : Type*} [add_comm_group A] [module ℂ A] [star_add_monoid A] [star_module ℂ A] + +/-- Create a `self_adjoint` element from a `skew_adjoint` element by multiplying by the scalar +`-complex.I`. -/ +@[simps] def skew_adjoint.neg_I_smul : skew_adjoint A →ₗ[ℝ] self_adjoint A := +{ to_fun := λ a, ⟨-I • a, by simp only [self_adjoint.mem_iff, neg_smul, star_neg, star_smul, + star_def, conj_I, skew_adjoint.star_coe_eq, neg_smul_neg]⟩, + map_add' := λ a b, by { ext, simp only [add_subgroup.coe_add, smul_add, add_mem_class.mk_add_mk]}, + map_smul' := λ a b, by { ext, simp only [neg_smul, skew_adjoint.coe_smul, add_subgroup.coe_mk, + ring_hom.id_apply, self_adjoint.coe_smul, smul_neg, neg_inj], rw smul_comm, } } + +lemma skew_adjoint.I_smul_neg_I (a : skew_adjoint A) : + I • (skew_adjoint.neg_I_smul a : A) = a := +by simp only [smul_smul, skew_adjoint.neg_I_smul_apply_coe, neg_smul, smul_neg, I_mul_I, one_smul, + neg_neg] + +/-- The real part `ℜ a` of an element `a` of a star module over `ℂ`, as a linear map. This is just +`self_adjoint_part ℝ`, but we provide it as a separate definition in order to link it with lemmas +concerning the `imaginary_part`, which doesn't exist in star modules over other rings. -/ +noncomputable def real_part : A →ₗ[ℝ] self_adjoint A := self_adjoint_part ℝ + +/-- The imaginary part `ℑ a` of an element `a` of a star module over `ℂ`, as a linear map into the +self adjoint elements. In a general star module, we have a decomposition into the `self_adjoint` +and `skew_adjoint` parts, but in a star module over `ℂ` we have +`real_part_add_I_smul_imaginary_part`, which allows us to decompose into a linear combination of +`self_adjoint`s. -/ +noncomputable +def imaginary_part : A →ₗ[ℝ] self_adjoint A := skew_adjoint.neg_I_smul.comp (skew_adjoint_part ℝ) + +localized "notation `ℜ` := real_part" in complex_star_module +localized "notation `ℑ` := imaginary_part" in complex_star_module + +@[simp] lemma real_part_apply_coe (a : A) : + (ℜ a : A) = (2 : ℝ)⁻¹ • (a + star a) := +by { unfold real_part, simp only [self_adjoint_part_apply_coe, inv_of_eq_inv]} + +@[simp] lemma imaginary_part_apply_coe (a : A) : + (ℑ a : A) = -I • (2 : ℝ)⁻¹ • (a - star a) := +begin + unfold imaginary_part, + simp only [linear_map.coe_comp, skew_adjoint.neg_I_smul_apply_coe, skew_adjoint_part_apply_coe, + inv_of_eq_inv], +end + +/-- The standard decomposition of `ℜ a + complex.I • ℑ a = a` of an element of a star module over +`ℂ` into a linear combination of self adjoint elements. -/ +lemma real_part_add_I_smul_imaginary_part (a : A) : (ℜ a + I • ℑ a : A) = a := +by simpa only [smul_smul, real_part_apply_coe, imaginary_part_apply_coe, neg_smul, I_mul_I, + one_smul, neg_sub, add_add_sub_cancel, smul_sub, smul_add, neg_sub_neg, inv_of_eq_inv] + using inv_of_two_smul_add_inv_of_two_smul ℝ a + +@[simp] lemma real_part_I_smul (a : A) : ℜ (I • a) = - ℑ a := +by { ext, simp [smul_comm I, smul_sub, sub_eq_add_neg, add_comm] } + +@[simp] lemma imaginary_part_I_smul (a : A) : ℑ (I • a) = ℜ a := +by { ext, simp [smul_comm I, smul_smul I] } + +lemma real_part_smul (z : ℂ) (a : A) : ℜ (z • a) = z.re • ℜ a - z.im • ℑ a := +by { nth_rewrite 0 ←re_add_im z, simp [-re_add_im, add_smul, ←smul_smul, sub_eq_add_neg] } + +lemma imaginary_part_smul (z : ℂ) (a : A) : ℑ (z • a) = z.re • ℑ a + z.im • ℜ a := +by { nth_rewrite 0 ←re_add_im z, simp [-re_add_im, add_smul, ←smul_smul] } + +end real_imaginary_part diff --git a/src/data/complex/orientation.lean b/src/data/complex/orientation.lean new file mode 100644 index 0000000000000..074bfb08338d6 --- /dev/null +++ b/src/data/complex/orientation.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2021 Heather Macbeth. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Heather Macbeth +-/ +import data.complex.module +import linear_algebra.orientation + +/-! +# The standard orientation on `ℂ`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This had previously been in `linear_algebra.orientation`, +but keeping it separate results in a significant import reduction. +-/ + +namespace complex + +/-- The standard orientation on `ℂ`. -/ +protected noncomputable def orientation : orientation ℝ ℂ (fin 2) := complex.basis_one_I.orientation + +end complex diff --git a/src/data/countable/basic.lean b/src/data/countable/basic.lean new file mode 100644 index 0000000000000..f167ba762df1a --- /dev/null +++ b/src/data/countable/basic.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import logic.equiv.nat +import logic.equiv.fin +import data.countable.defs + +/-! +# Countable types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we provide basic instances of the `countable` typeclass defined elsewhere. +-/ + +universes u v w + +open function + +instance : countable ℤ := countable.of_equiv ℕ equiv.int_equiv_nat.symm + +/-! +### Definition in terms of `function.embedding` +-/ + +section embedding + +variables {α : Sort u} {β : Sort v} + +lemma countable_iff_nonempty_embedding : countable α ↔ nonempty (α ↪ ℕ) := +⟨λ ⟨⟨f, hf⟩⟩, ⟨⟨f, hf⟩⟩, λ ⟨f⟩, ⟨⟨f, f.2⟩⟩⟩ + +lemma nonempty_embedding_nat (α) [countable α] : nonempty (α ↪ ℕ) := +countable_iff_nonempty_embedding.1 ‹_› + +protected lemma function.embedding.countable [countable β] (f : α ↪ β) : countable α := +f.injective.countable + +end embedding + +/-! +### Operations on `Type*`s +-/ + +section type + +variables {α : Type u} {β : Type v} {π : α → Type w} + +instance [countable α] [countable β] : countable (α ⊕ β) := +begin + rcases exists_injective_nat α with ⟨f, hf⟩, + rcases exists_injective_nat β with ⟨g, hg⟩, + exact (equiv.nat_sum_nat_equiv_nat.injective.comp $ hf.sum_map hg).countable +end + +instance [countable α] : countable (option α) := +countable.of_equiv _ (equiv.option_equiv_sum_punit α).symm + +instance [countable α] [countable β] : countable (α × β) := +begin + rcases exists_injective_nat α with ⟨f, hf⟩, + rcases exists_injective_nat β with ⟨g, hg⟩, + exact (nat.mkpair_equiv.injective.comp $ hf.prod_map hg).countable +end + +instance [countable α] [Π a, countable (π a)] : countable (sigma π) := +begin + rcases exists_injective_nat α with ⟨f, hf⟩, + choose g hg using λ a, exists_injective_nat (π a), + exact ((equiv.sigma_equiv_prod ℕ ℕ).injective.comp $ hf.sigma_map hg).countable +end + +end type + +section sort + +variables {α : Sort u} {β : Sort v} {π : α → Sort w} + +/-! +### Operations on and `Sort*`s +-/ + +@[priority 500] +instance set_coe.countable {α} [countable α] (s : set α) : countable s := subtype.countable + +instance [countable α] [countable β] : countable (psum α β) := +countable.of_equiv (plift α ⊕ plift β) (equiv.plift.sum_psum equiv.plift) + +instance [countable α] [countable β] : countable (pprod α β) := +countable.of_equiv (plift α × plift β) (equiv.plift.prod_pprod equiv.plift) + +instance [countable α] [Π a, countable (π a)] : countable (psigma π) := +countable.of_equiv (Σ a : plift α, plift (π a.down)) (equiv.psigma_equiv_sigma_plift π).symm + +instance [finite α] [Π a, countable (π a)] : countable (Π a, π a) := +begin + haveI : ∀ n, countable (fin n → ℕ), + { intro n, induction n with n ihn, + { apply_instance }, + { exactI countable.of_equiv _ (equiv.pi_fin_succ _ _).symm } }, + rcases finite.exists_equiv_fin α with ⟨n, ⟨e⟩⟩, + have f := λ a, (nonempty_embedding_nat (π a)).some, + exact ((embedding.Pi_congr_right f).trans (equiv.Pi_congr_left' _ e).to_embedding).countable +end + +end sort diff --git a/src/data/countable/defs.lean b/src/data/countable/defs.lean new file mode 100644 index 0000000000000..c24a9c97eab72 --- /dev/null +++ b/src/data/countable/defs.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import data.finite.defs + +/-! +# Countable types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define a typeclass saying that a given `Sort*` is countable. See also `encodable` +for a version that singles out a specific encoding of elements of `α` by natural numbers. + +This file also provides a few instances of this typeclass. More instances can be found in other +files. +-/ + +open function +universes u v +variables {α : Sort u} {β : Sort v} + +/-! +### Definition and basic properties +-/ + +/-- A type `α` is countable if there exists an injective map `α → ℕ`. -/ +@[mk_iff countable_iff_exists_injective] class countable (α : Sort u) : Prop := +(exists_injective_nat [] : ∃ f : α → ℕ, injective f) + +instance : countable ℕ := ⟨⟨id, injective_id⟩⟩ + +export countable (exists_injective_nat) + +protected lemma function.injective.countable [countable β] {f : α → β} (hf : injective f) : + countable α := +let ⟨g, hg⟩ := exists_injective_nat β in ⟨⟨g ∘ f, hg.comp hf⟩⟩ + +protected lemma function.surjective.countable [countable α] {f : α → β} (hf : surjective f) : + countable β := +(injective_surj_inv hf).countable + +lemma exists_surjective_nat (α : Sort u) [nonempty α] [countable α] : ∃ f : ℕ → α, surjective f := +let ⟨f, hf⟩ := exists_injective_nat α in ⟨inv_fun f, inv_fun_surjective hf⟩ + +lemma countable_iff_exists_surjective [nonempty α] : countable α ↔ ∃ f : ℕ → α, surjective f := +⟨@exists_surjective_nat _ _, λ ⟨f, hf⟩, hf.countable⟩ + +lemma countable.of_equiv (α : Sort*) [countable α] (e : α ≃ β) : countable β := +e.symm.injective.countable + +lemma equiv.countable_iff (e : α ≃ β) : countable α ↔ countable β := +⟨λ h, @countable.of_equiv _ _ h e, λ h, @countable.of_equiv _ _ h e.symm⟩ + +instance {β : Type v} [countable β] : countable (ulift.{u} β) := +countable.of_equiv _ equiv.ulift.symm + +/-! +### Operations on `Sort*`s +-/ + +instance [countable α] : countable (plift α) := equiv.plift.injective.countable + +@[priority 100] +instance subsingleton.to_countable [subsingleton α] : countable α := +⟨⟨λ _, 0, λ x y h, subsingleton.elim x y⟩⟩ + +@[priority 500] +instance [countable α] {p : α → Prop} : countable {x // p x} := subtype.val_injective.countable + +instance {n : ℕ} : countable (fin n) := +function.injective.countable (@fin.eq_of_veq n) + +@[priority 100] +instance finite.to_countable [finite α] : countable α := +let ⟨n, ⟨e⟩⟩ := finite.exists_equiv_fin α in countable.of_equiv _ e.symm + +instance : countable punit.{u} := subsingleton.to_countable + +-- Since this always succeeds, there is no reason not to have this at normal priority. +-- Perhaps the `instance_priority` linter could be clever enough to notice this itself. +@[nolint instance_priority] +instance Prop.countable (p : Prop) : countable p := subsingleton.to_countable + +instance bool.countable : countable bool := +⟨⟨λ b, cond b 0 1, bool.injective_iff.2 nat.one_ne_zero⟩⟩ + +instance Prop.countable' : countable Prop := countable.of_equiv bool equiv.Prop_equiv_bool.symm + +@[priority 500] instance [countable α] {r : α → α → Prop} : countable (quot r) := +(surjective_quot_mk r).countable + +@[priority 500] instance [countable α] {s : setoid α} : countable (quotient s) := quot.countable diff --git a/src/data/countable/small.lean b/src/data/countable/small.lean new file mode 100644 index 0000000000000..6b2280e7188fb --- /dev/null +++ b/src/data/countable/small.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2021 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import logic.small.basic +import data.countable.defs + +/-! +# All countable types are small. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +That is, any countable type is equivalent to a type in any universe. +-/ + +universes w v + +@[priority 100] +instance small_of_countable (α : Type v) [countable α] : small.{w} α := +let ⟨f, hf⟩ := exists_injective_nat α in small_of_injective hf diff --git a/src/data/dfinsupp/basic.lean b/src/data/dfinsupp/basic.lean index 9e43ed9591b97..f5327b314b0bb 100644 --- a/src/data/dfinsupp/basic.lean +++ b/src/data/dfinsupp/basic.lean @@ -3,51 +3,66 @@ Copyright (c) 2018 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Kenny Lau -/ -import algebra.module.pi import algebra.module.linear_map import algebra.big_operators.basic import data.set.finite import group_theory.submonoid.membership +import group_theory.group_action.big_operators import data.finset.preimage /-! # Dependent functions with finite support +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For a non-dependent version see `data/finsupp.lean`. --/ -universes u u₁ u₂ v v₁ v₂ v₃ w x y l +## Notation -open_locale big_operators +This file introduces the notation `Π₀ a, β a` as notation for `dfinsupp β`, mirroring the `α →₀ β` +notation used for `finsupp`. This works for nested binders too, with `Π₀ a b, γ a b` as notation +for `dfinsupp (λ a, dfinsupp (γ a))`. -variables (ι : Type u) {γ : Type w} (β : ι → Type v) {β₁ : ι → Type v₁} {β₂ : ι → Type v₂} +## Implementation notes -namespace dfinsupp +The support is internally represented (in the primed `dfinsupp.support'`) as a `multiset` that +represents a superset of the true support of the function, quotiented by the always-true relation so +that this does not impact equality. This approach has computational benefits over storing a +`finset`; it allows us to add together two finitely-supported functions (`dfinsupp.has_add`) without +having to evaluate the resulting function to recompute its support (which would required +decidability of `b = 0` for `b : β i`). -variable [Π i, has_zero (β i)] +The true support of the function can still be recovered with `dfinsupp.support`; but these +decidability obligations are now postponed to when the support is actually needed. As a consequence, +there are two ways to sum a `dfinsupp`: with `dfinsupp.sum` which works over an arbitrary function +but requires recomputation of the support and therefore a `decidable` argument; and with +`dfinsupp.sum_add_hom` which requires an additive morphism, using its properties to show that +summing over a superset of the support is sufficient. -/-- An auxiliary structure used in the definition of of `dfinsupp`, -the type used to make infinite direct sum of modules over a ring. -/ -structure pre : Type (max u v) := -(to_fun : Π i, β i) -(pre_support : multiset ι) -(zero : ∀ i, i ∈ pre_support ∨ to_fun i = 0) +`finsupp` takes an altogether different approach here; it uses `classical.decidable` and declares +`finsupp.has_add` as noncomputable. This design difference is independent of the fact that +`dfinsupp` is dependently-typed and `finsupp` is not; in future, we may want to align these two +definitions, or introduce two more definitions for the other combinations of decisions. +-/ + +universes u u₁ u₂ v v₁ v₂ v₃ w x y l -instance inhabited_pre : inhabited (pre ι β) := -⟨⟨λ i, 0, ∅, λ i, or.inr rfl⟩⟩ +open_locale big_operators -instance : setoid (pre ι β) := -{ r := λ x y, ∀ i, x.to_fun i = y.to_fun i, - iseqv := ⟨λ f i, rfl, λ f g H i, (H i).symm, - λ f g h H1 H2 i, (H1 i).trans (H2 i)⟩ } +variables {ι : Type u} {γ : Type w} {β : ι → Type v} {β₁ : ι → Type v₁} {β₂ : ι → Type v₂} -end dfinsupp -variable {ι} -/-- A dependent function `Π i, β i` with finite support. -/ -@[reducible] -def dfinsupp [Π i, has_zero (β i)] : Type* := -quotient (dfinsupp.pre.setoid ι β) +variable (β) +/-- A dependent function `Π i, β i` with finite support, with notation `Π₀ i, β i`. + +Note that `dfinsupp.support` is the preferred API for accessing the support of the function, +`dfinsupp.support'` is a implementation detail that aids computability; see the implementation +notes in this file for more information. -/ +structure dfinsupp [Π i, has_zero (β i)] : Type (max u v) := +mk' :: +(to_fun : Π i, β i) +(support' : trunc {s : multiset ι // ∀ i, i ∈ s ∨ to_fun i = 0}) variable {β} notation `Π₀` binders `, ` r:(scoped f, dfinsupp f) := r @@ -59,25 +74,25 @@ section basic variables [Π i, has_zero (β i)] [Π i, has_zero (β₁ i)] [Π i, has_zero (β₂ i)] instance fun_like : fun_like (Π₀ i, β i) ι β := -⟨λ f, quotient.lift_on f pre.to_fun $ λ _ _, funext, - λ f g H, quotient.induction_on₂ f g (λ _ _ H, quotient.sound H) (congr_fun H)⟩ +⟨λ f, f.to_fun, λ ⟨f₁, s₁⟩ ⟨f₂, s₁⟩ (h : f₁= f₂), by { subst h, congr'} ⟩ /-- Helper instance for when there are too many metavariables to apply `fun_like.has_coe_to_fun` directly. -/ instance : has_coe_to_fun (Π₀ i, β i) (λ _, Π i, β i) := fun_like.has_coe_to_fun +@[simp] lemma to_fun_eq_coe (f : Π₀ i, β i) : f.to_fun = f := rfl + @[ext] lemma ext {f g : Π₀ i, β i} (h : ∀ i, f i = g i) : f = g := fun_like.ext _ _ h /-- Deprecated. Use `fun_like.ext_iff` instead. -/ lemma ext_iff {f g : Π₀ i, β i} : f = g ↔ ∀ i, f i = g i := fun_like.ext_iff /-- Deprecated. Use `fun_like.coe_injective` instead. -/ lemma coe_fn_injective : @function.injective (Π₀ i, β i) (Π i, β i) coe_fn := fun_like.coe_injective -instance : has_zero (Π₀ i, β i) := ⟨⟦⟨0, ∅, λ i, or.inr rfl⟩⟧⟩ +instance : has_zero (Π₀ i, β i) := ⟨⟨0, trunc.mk $ ⟨∅, λ i, or.inr rfl⟩⟩⟩ instance : inhabited (Π₀ i, β i) := ⟨0⟩ @[simp] -lemma coe_pre_mk (f : Π i, β i) (s : multiset ι) (hf) : - ⇑(⟦⟨f, s, hf⟩⟧ : Π₀ i, β i) = f := rfl +lemma coe_mk' (f : Π i, β i) (s) : ⇑(⟨f, s⟩ : Π₀ i, β i) = f := rfl @[simp] lemma coe_zero : ⇑(0 : Π₀ i, β i) = 0 := rfl lemma zero_apply (i : ι) : (0 : Π₀ i, β i) i = 0 := rfl @@ -93,19 +108,17 @@ bundled: * `dfinsupp.map_range.linear_map` * `dfinsupp.map_range.linear_equiv` -/ -def map_range (f : Π i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0) : (Π₀ i, β₁ i) → Π₀ i, β₂ i := -quotient.map - (λ x, ⟨λ i, f i (x.1 i), x.2, λ i, (x.3 i).imp_right $ λ H, by rw [H, hf]⟩) - (λ x y H i, by simp only [H i]) +def map_range (f : Π i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0) (x : Π₀ i, β₁ i) : Π₀ i, β₂ i := +⟨λ i, f i (x i), x.support'.map $ λ s, ⟨s, λ i, (s.2 i).imp_right $ λ h : x i = 0, h.symm ▸ hf i⟩⟩ @[simp] lemma map_range_apply (f : Π i, β₁ i → β₂ i) (hf : ∀ i, f i 0 = 0) (g : Π₀ i, β₁ i) (i : ι) : map_range f hf g i = f i (g i) := -quotient.induction_on g $ λ x, rfl +rfl @[simp] lemma map_range_id (h : ∀ i, id (0 : β₁ i) = 0 := λ i, rfl) (g : Π₀ (i : ι), β₁ i) : map_range (λ i, (id : β₁ i → β₁ i)) h g = g := -by { ext, simp only [map_range_apply, id.def] } +by { ext, refl } lemma map_range_comp (f : Π i, β₁ i → β₂ i) (f₂ : Π i, β i → β₁ i) (hf : ∀ i, f i 0 = 0) (hf₂ : ∀ i, f₂ i 0 = 0) (h : ∀ i, (f i ∘ f₂ i) 0 = 0) @@ -119,23 +132,38 @@ by { ext, simp only [map_range_apply, coe_zero, pi.zero_apply, hf] } /-- Let `f i` be a binary operation `β₁ i → β₂ i → β i` such that `f i 0 0 = 0`. Then `zip_with f hf` is a binary operation `Π₀ i, β₁ i → Π₀ i, β₂ i → Π₀ i, β i`. -/ -def zip_with (f : Π i, β₁ i → β₂ i → β i) (hf : ∀ i, f i 0 0 = 0) : - (Π₀ i, β₁ i) → (Π₀ i, β₂ i) → (Π₀ i, β i) := -begin - refine quotient.map₂ - (λ x y, ⟨λ i, f i (x.1 i) (y.1 i), x.2 + y.2, λ i, _⟩) _, - { cases x.3 i with h1 h1, - { left, rw multiset.mem_add, left, exact h1 }, - cases y.3 i with h2 h2, - { left, rw multiset.mem_add, right, exact h2 }, - right, rw [h1, h2, hf] }, - exact λ x₁ x₂ H1 y₁ y₂ H2 i, by simp only [H1 i, H2 i] -end +def zip_with (f : Π i, β₁ i → β₂ i → β i) (hf : ∀ i, f i 0 0 = 0) + (x : Π₀ i, β₁ i) (y : Π₀ i, β₂ i) : (Π₀ i, β i) := +⟨λ i, f i (x i) (y i), begin + refine x.support'.bind (λ xs, _), + refine y.support'.map (λ ys, _), + refine ⟨xs + ys, λ i, _⟩, + obtain h1 | (h1 : x i = 0) := xs.prop i, + { left, rw multiset.mem_add, left, exact h1 }, + obtain h2 | (h2 : y i = 0) := ys.prop i, + { left, rw multiset.mem_add, right, exact h2 }, + right, rw [h1, h2, hf] +end⟩ @[simp] lemma zip_with_apply (f : Π i, β₁ i → β₂ i → β i) (hf : ∀ i, f i 0 0 = 0) (g₁ : Π₀ i, β₁ i) (g₂ : Π₀ i, β₂ i) (i : ι) : zip_with f hf g₁ g₂ i = f i (g₁ i) (g₂ i) := -quotient.induction_on₂ g₁ g₂ $ λ _ _, rfl +rfl + +section piecewise +variables (x y : Π₀ i, β i) (s : set ι) [Π i, decidable (i ∈ s)] + +/-- `x.piecewise y s` is the finitely supported function equal to `x` on the set `s`, + and to `y` on its complement. -/ +def piecewise : Π₀ i, β i := zip_with (λ i x y, if i ∈ s then x else y) (λ _, if_t_t _ 0) x y + +lemma piecewise_apply (i : ι) : x.piecewise y s i = if i ∈ s then x i else y i := +zip_with_apply _ _ x y i + +@[simp, norm_cast] lemma coe_piecewise : ⇑(x.piecewise y s) = s.piecewise x y := +by { ext, apply piecewise_apply } + +end piecewise end basic @@ -146,26 +174,26 @@ instance [Π i, add_zero_class (β i)] : has_add (Π₀ i, β i) := lemma add_apply [Π i, add_zero_class (β i)] (g₁ g₂ : Π₀ i, β i) (i : ι) : (g₁ + g₂) i = g₁ i + g₂ i := -zip_with_apply _ _ g₁ g₂ i +rfl @[simp] lemma coe_add [Π i, add_zero_class (β i)] (g₁ g₂ : Π₀ i, β i) : ⇑(g₁ + g₂) = g₁ + g₂ := -funext $ add_apply g₁ g₂ +rfl instance [Π i, add_zero_class (β i)] : add_zero_class (Π₀ i, β i) := fun_like.coe_injective.add_zero_class _ coe_zero coe_add -/-- Note the general `dfinsupp.has_scalar` instance doesn't apply as `ℕ` is not distributive +/-- Note the general `dfinsupp.has_smul` instance doesn't apply as `ℕ` is not distributive unless `β i`'s addition is commutative. -/ -instance has_nat_scalar [Π i, add_monoid (β i)] : has_scalar ℕ (Π₀ i, β i) := +instance has_nat_scalar [Π i, add_monoid (β i)] : has_smul ℕ (Π₀ i, β i) := ⟨λc v, v.map_range (λ _, (•) c) (λ _, nsmul_zero _)⟩ lemma nsmul_apply [Π i, add_monoid (β i)] (b : ℕ) (v : Π₀ i, β i) (i : ι) : (b • v) i = b • (v i) := -map_range_apply _ _ v i +rfl @[simp] lemma coe_nsmul [Π i, add_monoid (β i)] (b : ℕ) (v : Π₀ i, β i) : ⇑(b • v) = b • v := -funext $ nsmul_apply b v +rfl instance [Π i, add_monoid (β i)] : add_monoid (Π₀ i, β i) := fun_like.coe_injective.add_monoid _ coe_zero coe_add (λ _ _, coe_nsmul _ _) @@ -195,32 +223,32 @@ instance [Π i, add_group (β i)] : has_neg (Π₀ i, β i) := ⟨λ f, f.map_range (λ _, has_neg.neg) (λ _, neg_zero)⟩ lemma neg_apply [Π i, add_group (β i)] (g : Π₀ i, β i) (i : ι) : (- g) i = - g i := -map_range_apply _ _ g i +rfl @[simp] lemma coe_neg [Π i, add_group (β i)] (g : Π₀ i, β i) : ⇑(- g) = - g := -funext $ neg_apply g +rfl instance [Π i, add_group (β i)] : has_sub (Π₀ i, β i) := ⟨zip_with (λ _, has_sub.sub) (λ _, sub_zero 0)⟩ lemma sub_apply [Π i, add_group (β i)] (g₁ g₂ : Π₀ i, β i) (i : ι) : (g₁ - g₂) i = g₁ i - g₂ i := -zip_with_apply _ _ g₁ g₂ i +rfl @[simp] lemma coe_sub [Π i, add_group (β i)] (g₁ g₂ : Π₀ i, β i) : ⇑(g₁ - g₂) = g₁ - g₂ := -funext $ sub_apply g₁ g₂ +rfl -/-- Note the general `dfinsupp.has_scalar` instance doesn't apply as `ℤ` is not distributive +/-- Note the general `dfinsupp.has_smul` instance doesn't apply as `ℤ` is not distributive unless `β i`'s addition is commutative. -/ -instance has_int_scalar [Π i, add_group (β i)] : has_scalar ℤ (Π₀ i, β i) := +instance has_int_scalar [Π i, add_group (β i)] : has_smul ℤ (Π₀ i, β i) := ⟨λc v, v.map_range (λ _, (•) c) (λ _, zsmul_zero _)⟩ lemma zsmul_apply [Π i, add_group (β i)] (b : ℤ) (v : Π₀ i, β i) (i : ι) : (b • v) i = b • (v i) := -map_range_apply _ _ v i +rfl @[simp] lemma coe_zsmul [Π i, add_group (β i)] (b : ℤ) (v : Π₀ i, β i) : ⇑(b • v) = b • v := -funext $ zsmul_apply b v +rfl instance [Π i, add_group (β i)] : add_group (Π₀ i, β i) := fun_like.coe_injective.add_group _ @@ -233,18 +261,18 @@ fun_like.coe_injective.add_comm_group _ /-- Dependent functions with finite support inherit a semiring action from an action on each coordinate. -/ instance [monoid γ] [Π i, add_monoid (β i)] [Π i, distrib_mul_action γ (β i)] : - has_scalar γ (Π₀ i, β i) := + has_smul γ (Π₀ i, β i) := ⟨λc v, v.map_range (λ _, (•) c) (λ _, smul_zero _)⟩ lemma smul_apply [monoid γ] [Π i, add_monoid (β i)] [Π i, distrib_mul_action γ (β i)] (b : γ) (v : Π₀ i, β i) (i : ι) : (b • v) i = b • (v i) := -map_range_apply _ _ v i +rfl @[simp] lemma coe_smul [monoid γ] [Π i, add_monoid (β i)] [Π i, distrib_mul_action γ (β i)] (b : γ) (v : Π₀ i, β i) : ⇑(b • v) = b • v := -funext $ smul_apply b v +rfl instance {δ : Type*} [monoid γ] [monoid δ] [Π i, add_monoid (β i)] [Π i, distrib_mul_action γ (β i)] [Π i, distrib_mul_action δ (β i)] @@ -254,7 +282,7 @@ instance {δ : Type*} [monoid γ] [monoid δ] instance {δ : Type*} [monoid γ] [monoid δ] [Π i, add_monoid (β i)] [Π i, distrib_mul_action γ (β i)] [Π i, distrib_mul_action δ (β i)] - [has_scalar γ δ] [Π i, is_scalar_tower γ δ (β i)] : + [has_smul γ δ] [Π i, is_scalar_tower γ δ (β i)] : is_scalar_tower γ δ (Π₀ i, β i) := { smul_assoc := λ r s m, ext $ λ i, by simp only [smul_apply, smul_assoc r s (m i)] } @@ -282,15 +310,14 @@ end algebra section filter_and_subtype_domain /-- `filter p f` is the function which is `f i` if `p i` is true and 0 otherwise. -/ -def filter [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p] : (Π₀ i, β i) → Π₀ i, β i := -quotient.map - (λ x, ⟨λ i, if p i then x.1 i else 0, x.2, λ i, (x.3 i).imp_right $ λ H, by rw [H, if_t_t]⟩) - (λ x y H i, by simp only [H i]) +def filter [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p] (x : Π₀ i, β i) : Π₀ i, β i := +⟨λ i, if p i then x i else 0, x.support'.map + (λ xs, ⟨xs, λ i, (xs.prop i).imp_right $ λ H : x i = 0, by rw [H, if_t_t]⟩)⟩ @[simp] lemma filter_apply [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p] (i : ι) (f : Π₀ i, β i) : f.filter p i = if p i then f i else 0 := -quotient.induction_on f $ λ x, rfl +rfl lemma filter_apply_pos [Π i, has_zero (β i)] {p : ι → Prop} [decidable_pred p] (f : Π₀ i, β i) {i : ι} (h : p i) : @@ -354,13 +381,12 @@ variables {γ β} /-- `subtype_domain p f` is the restriction of the finitely supported function `f` to the subtype `p`. -/ -def subtype_domain [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p] : - (Π₀ i, β i) → Π₀ i : subtype p, β i := -quotient.map - (λ x, ⟨λ i, x.1 (i : ι), (x.2.filter p).attach.map $ λ j, ⟨j, (multiset.mem_filter.1 j.2).2⟩, - λ i, (x.3 i).imp_left $ λ H, multiset.mem_map.2 - ⟨⟨i, multiset.mem_filter.2 ⟨H, i.2⟩⟩, multiset.mem_attach _ _, subtype.eta _ _⟩⟩) - (λ x y H i, H i) +def subtype_domain [Π i, has_zero (β i)] (p : ι → Prop) [decidable_pred p] (x : Π₀ i, β i) : + Π₀ i : subtype p, β i := +⟨λ i, x (i : ι), x.support'.map + (λ xs, ⟨(multiset.filter p xs).attach.map $ λ j, ⟨j, (multiset.mem_filter.1 j.2).2⟩, + λ i, (xs.prop i).imp_left $ λ H, multiset.mem_map.2 + ⟨⟨i, multiset.mem_filter.2 ⟨H, i.2⟩⟩, multiset.mem_attach _ _, subtype.eta _ _⟩⟩)⟩ @[simp] lemma subtype_domain_zero [Π i, has_zero (β i)] {p : ι → Prop} [decidable_pred p] : subtype_domain p (0 : Π₀ i, β i) = 0 := @@ -369,17 +395,17 @@ rfl @[simp] lemma subtype_domain_apply [Π i, has_zero (β i)] {p : ι → Prop} [decidable_pred p] {i : subtype p} {v : Π₀ i, β i} : (subtype_domain p v) i = v i := -quotient.induction_on v $ λ x, rfl +rfl @[simp] lemma subtype_domain_add [Π i, add_zero_class (β i)] {p : ι → Prop} [decidable_pred p] (v v' : Π₀ i, β i) : (v + v').subtype_domain p = v.subtype_domain p + v'.subtype_domain p := -ext $ λ i, by simp only [add_apply, subtype_domain_apply] +coe_fn_injective rfl @[simp] lemma subtype_domain_smul [monoid γ] [Π i, add_monoid (β i)] [Π i, distrib_mul_action γ (β i)] {p : ι → Prop} [decidable_pred p] (r : γ) (f : Π₀ i, β i) : (r • f).subtype_domain p = r • f.subtype_domain p := -quotient.induction_on f $ λ x, rfl +coe_fn_injective rfl variables (γ β) @@ -404,12 +430,12 @@ variables {γ β} @[simp] lemma subtype_domain_neg [Π i, add_group (β i)] {p : ι → Prop} [decidable_pred p] {v : Π₀ i, β i} : (- v).subtype_domain p = - v.subtype_domain p := -ext $ λ i, by simp only [neg_apply, subtype_domain_apply] +coe_fn_injective rfl @[simp] lemma subtype_domain_sub [Π i, add_group (β i)] {p : ι → Prop} [decidable_pred p] {v v' : Π₀ i, β i} : (v - v').subtype_domain p = v.subtype_domain p - v'.subtype_domain p := -ext $ λ i, by simp only [sub_apply, subtype_domain_apply] +coe_fn_injective rfl end filter_and_subtype_domain @@ -424,16 +450,16 @@ omit dec lemma finite_support (f : Π₀ i, β i) : set.finite {i | f i ≠ 0} := begin classical, - exact quotient.induction_on f (λ x, x.2.to_finset.finite_to_set.subset (λ i H, - multiset.mem_to_finset.2 ((x.3 i).resolve_right H))) + exact trunc.induction_on f.support' (λ xs, (multiset.to_finset ↑xs).finite_to_set.subset (λ i H, + multiset.mem_to_finset.2 ((xs.prop i).resolve_right H))) end include dec /-- Create an element of `Π₀ i, β i` from a finset `s` and a function `x` defined on this `finset`. -/ def mk (s : finset ι) (x : Π i : (↑s : set ι), β (i : ι)) : Π₀ i, β i := -⟦⟨λ i, if H : i ∈ s then x ⟨i, H⟩ else 0, s.1, -λ i, if H : i ∈ s then or.inl H else or.inr $ dif_neg H⟩⟧ +⟨λ i, if H : i ∈ s then x ⟨i, H⟩ else 0, trunc.mk ⟨s.1, + λ i, if H : i ∈ s then or.inl H else or.inr $ dif_neg H⟩⟩ variables {s : finset ι} {x : Π i : (↑s : set ι), β i} {i : ι} @@ -453,14 +479,16 @@ begin end omit dec -instance [is_empty ι] : unique (Π₀ i, β i) := -⟨⟨0⟩, λ a, by { ext, exact is_empty_elim i }⟩ + +instance unique [∀ i, subsingleton (β i)] : unique (Π₀ i, β i) := fun_like.coe_injective.unique + +instance unique_of_is_empty [is_empty ι] : unique (Π₀ i, β i) := fun_like.coe_injective.unique /-- Given `fintype ι`, `equiv_fun_on_fintype` is the `equiv` between `Π₀ i, β i` and `Π i, β i`. (All dependent functions on a finite type are finitely supported.) -/ @[simps apply] def equiv_fun_on_fintype [fintype ι] : (Π₀ i, β i) ≃ (Π i, β i) := { to_fun := coe_fn, - inv_fun := λ f, ⟦⟨f, finset.univ.1, λ i, or.inl $ finset.mem_univ_val _⟩⟧, + inv_fun := λ f, ⟨f, trunc.mk ⟨finset.univ.1, λ i, or.inl $ finset.mem_univ_val _⟩⟩, left_inv := λ x, coe_fn_injective rfl, right_inv := λ x, rfl } @@ -472,32 +500,21 @@ include dec /-- The function `single i b : Π₀ i, β i` sends `i` to `b` and all other points to `0`. -/ def single (i : ι) (b : β i) : Π₀ i, β i := -mk {i} $ λ j, eq.rec_on (finset.mem_singleton.1 j.prop).symm b +⟨pi.single i b, + trunc.mk ⟨{i}, λ j, (decidable.eq_or_ne j i).imp (by simp) (λ h, pi.single_eq_of_ne h _)⟩⟩ + +lemma single_eq_pi_single {i b} : ⇑(single i b : Π₀ i, β i) = pi.single i b := +rfl @[simp] lemma single_apply {i i' b} : (single i b : Π₀ i, β i) i' = (if h : i = i' then eq.rec_on h b else 0) := begin - dsimp only [single], - by_cases h : i = i', - { have h1 : i' ∈ ({i} : finset ι) := finset.mem_singleton.2 h.symm, - simp only [mk_apply, dif_pos h, dif_pos h1], refl }, - { have h1 : i' ∉ ({i} : finset ι) := finset.not_mem_singleton.2 (ne.symm h), - simp only [mk_apply, dif_neg h, dif_neg h1] } -end - -lemma single_eq_pi_single {i b} : ⇑(single i b : Π₀ i, β i) = pi.single i b := -begin - ext i', - simp only [pi.single, function.update], - split_ifs, - { simp [h] }, - { simp [ne.symm h] } + rw [single_eq_pi_single, pi.single, function.update], + simp [@eq_comm _ i i'], end @[simp] lemma single_zero (i) : (single i 0 : Π₀ i, β i) = 0 := -quotient.sound $ λ j, if H : j ∈ ({i} : finset _) -then by dsimp only; rw [dif_pos H]; cases finset.mem_singleton.1 H; refl -else dif_neg H +fun_like.coe_injective $ pi.single_zero _ @[simp] lemma single_eq_same {i b} : (single i b : Π₀ i, β i) i = b := by simp only [single_apply, dif_pos rfl] @@ -506,7 +523,7 @@ lemma single_eq_of_ne {i i' b} (h : i ≠ i') : (single i b : Π₀ i, β i) i' by simp only [single_apply, dif_neg h] lemma single_injective {i} : function.injective (single i : β i → Π₀ i, β i) := -λ x y H, congr_fun (mk_injective _ H) ⟨i, by simp⟩ +λ x y H, pi.single_injective β i $ coe_fn_injective.eq_iff.mpr H /-- Like `finsupp.single_eq_single_iff`, but with a `heq` due to dependent types -/ lemma single_eq_single_iff (i j : ι) (xi : β i) (xj : β j) : @@ -529,6 +546,12 @@ begin { rw [hi, hj, dfinsupp.single_zero, dfinsupp.single_zero], }, }, end +/-- `dfinsupp.single a b` is injective in `a`. For the statement that it is injective in `b`, see +`dfinsupp.single_injective` -/ +lemma single_left_injective {b : Π (i : ι), β i} (h : ∀ i, b i ≠ 0) : + function.injective (λ i, single i (b i) : ι → Π₀ i, β i) := +λ a a' H, (((single_eq_single_iff _ _ _ _).mp H).resolve_right $ λ hb, h _ hb.1).left + @[simp] lemma single_eq_zero {i : ι} {xi : β i} : single i xi = 0 ↔ xi = 0 := begin rw [←single_zero i, single_eq_single_iff], @@ -570,15 +593,13 @@ by { ext, simp [dfinsupp.single_eq_pi_single], } by { ext i', simp only [← single_eq_pi_single, equiv_fun_on_fintype_symm_coe] } /-- Redefine `f i` to be `0`. -/ -def erase (i : ι) : (Π₀ i, β i) → Π₀ i, β i := -quotient.map - (λ x, ⟨λ j, if j = i then 0 else x.1 j, x.2, - λ j, (x.3 j).imp_right $ λ H, by simp only [H, if_t_t]⟩) - (λ x y H j, if h : j = i then by simp only [if_pos h] else by simp only [if_neg h, H j]) +def erase (i : ι) (x : Π₀ i, β i) : Π₀ i, β i := +⟨λ j, if j = i then 0 else x.1 j, x.support'.map $ λ xs, + ⟨xs, λ j, (xs.prop j).imp_right $ λ H, by simp only [H, if_t_t]⟩⟩ @[simp] lemma erase_apply {i j : ι} {f : Π₀ i, β i} : (f.erase i) j = if j = i then 0 else f j := -quotient.induction_on f $ λ x, rfl +rfl @[simp] lemma erase_same {i : ι} {f : Π₀ i, β i} : (f.erase i) i = 0 := by simp @@ -586,6 +607,14 @@ by simp lemma erase_ne {i i' : ι} {f : Π₀ i, β i} (h : i' ≠ i) : (f.erase i) i' = f i' := by simp [h] +lemma piecewise_single_erase (x : Π₀ i, β i) (i : ι) : + (single i (x i)).piecewise (x.erase i) {i} = x := +begin + ext j, rw piecewise_apply, split_ifs, + { rw [(id h : j = i), single_eq_same] }, + { exact erase_ne h }, +end + lemma erase_eq_sub_single {β : ι → Type*} [Π i, add_group (β i)] (f : Π₀ i, β i) (i : ι) : f.erase i = f - single i (f i) := begin @@ -623,7 +652,7 @@ by rw [erase_single, if_neg h] section update -variables (f : Π₀ i, β i) (i) (b : β i) [decidable (b = 0)] +variables (f : Π₀ i, β i) (i) (b : β i) /-- Replace the value of a `Π₀ i, β i` at a given point `i : ι` by a given value `b : β i`. If `b = 0`, this amounts to removing `i` from the support. @@ -631,31 +660,23 @@ Otherwise, `i` is added to it. This is the (dependent) finitely-supported version of `function.update`. -/ def update : Π₀ i, β i := -quotient.map (λ (x : pre _ _), ⟨function.update x.to_fun i b, - if b = 0 then x.pre_support.erase i else i ::ₘ x.pre_support, - begin - intro j, +⟨function.update f i b, f.support'.map $ λ s, + ⟨i ::ₘ s, λ j, begin rcases eq_or_ne i j with rfl|hi, - { split_ifs with hb, - { simp [hb] }, - { simp } }, - { cases x.zero j with hj hj, - { split_ifs; - simp [multiset.mem_erase_of_ne hi.symm, hj] }, - { simp [function.update_noteq hi.symm, hj] } } - end⟩) - (λ x y h j, - show function.update x.to_fun i b j = function.update y.to_fun i b j, - by rw (funext h : x.to_fun = y.to_fun)) f + { simp, }, + { obtain hj | (hj : f j = 0) := s.prop j, + { exact or.inl (multiset.mem_cons_of_mem hj), }, + { exact or.inr ((function.update_noteq hi.symm b _).trans hj) } } + end⟩⟩ variables (j : ι) -@[simp] lemma coe_update : (f.update i b : Π (i : ι), β i) = function.update f i b := -quotient.induction_on f (λ _, rfl) -@[simp] lemma update_self [decidable (f i = 0)] : f.update i (f i) = f := +@[simp] lemma coe_update : (f.update i b : Π (i : ι), β i) = function.update f i b := rfl + +@[simp] lemma update_self : f.update i (f i) = f := by { ext, simp } -@[simp] lemma update_eq_erase [decidable ((0 : β i) = 0)] : f.update i 0 = f.erase i := +@[simp] lemma update_eq_erase : f.update i 0 = f.erase i := begin ext j, rcases eq_or_ne i j with rfl|hi, @@ -664,7 +685,7 @@ begin end lemma update_eq_single_add_erase {β : ι → Type*} [Π i, add_zero_class (β i)] (f : Π₀ i, β i) (i : ι) - (b : β i) [decidable (b = 0)] : + (b : β i) : f.update i b = single i b + f.erase i := begin ext j, @@ -674,7 +695,7 @@ begin end lemma update_eq_erase_add_single {β : ι → Type*} [Π i, add_zero_class (β i)] (f : Π₀ i, β i) (i : ι) - (b : β i) [decidable (b = 0)] : + (b : β i) : f.update i b = f.erase i + single i b := begin ext j, @@ -684,7 +705,7 @@ begin end lemma update_eq_sub_add_single {β : ι → Type*} [Π i, add_group (β i)] (f : Π₀ i, β i) (i : ι) - (b : β i) [decidable (b = 0)] : + (b : β i) : f.update i b = f - single i (f i) + single i b := by rw [update_eq_erase_add_single f i b, erase_eq_sub_single f i] @@ -751,25 +772,26 @@ protected theorem induction {p : (Π₀ i, β i) → Prop} (f : Π₀ i, β i) (h0 : p 0) (ha : ∀i b (f : Π₀ i, β i), f i = 0 → b ≠ 0 → p f → p (single i b + f)) : p f := begin - refine quotient.induction_on f (λ x, _), - cases x with f s H, revert f H, - apply multiset.induction_on s, - { intros f H, convert h0, ext i, exact (H i).resolve_left id }, - intros i s ih f H, - have H2 : p (erase i ⟦{to_fun := f, pre_support := i ::ₘ s, zero := H}⟧), - { dsimp only [erase, quotient.map_mk], + cases f with f s, + induction s using trunc.induction_on, + cases s with s H, + induction s using multiset.induction_on with i s ih generalizing f, + { have : f = 0 := funext (λ i, (H i).resolve_left id), + subst this, + exact h0 }, + have H2 : p (erase i ⟨f, trunc.mk ⟨i ::ₘ s, H⟩⟩), + { dsimp only [erase, trunc.map, trunc.bind, trunc.lift_on, trunc.lift_mk, function.comp, + subtype.coe_mk], have H2 : ∀ j, j ∈ s ∨ ite (j = i) 0 (f j) = 0, { intro j, cases H j with H2 H2, { cases multiset.mem_cons.1 H2 with H3 H3, { right, exact if_pos H3 }, { left, exact H3 } }, right, split_ifs; [refl, exact H2] }, - have H3 : (⟦{to_fun := λ (j : ι), ite (j = i) 0 (f j), - pre_support := i ::ₘ s, zero := _}⟧ : Π₀ i, β i) - = ⟦{to_fun := λ (j : ι), ite (j = i) 0 (f j), pre_support := s, zero := H2}⟧ := - quotient.sound (λ i, rfl), + have H3 : (⟨λ (j : ι), ite (j = i) 0 (f j), trunc.mk ⟨i ::ₘ s, _⟩⟩ : Π₀ i, β i) + = ⟨λ (j : ι), ite (j = i) 0 (f j), trunc.mk ⟨s, H2⟩⟩ := ext (λ _, rfl), rw H3, apply ih }, - have H3 : single i _ + _ = (⟦{to_fun := f, pre_support := i ::ₘ s, zero := H}⟧ : Π₀ i, β i) := + have H3 : single i _ + _ = (⟨f, trunc.mk ⟨i ::ₘ s, H⟩⟩ : Π₀ i, β i) := single_add_erase _ _, rw ← H3, change p (single i (f i) + _), @@ -864,30 +886,34 @@ variables [Π i, has_zero (β i)] [Π i (x : β i), decidable (x ≠ 0)] /-- Set `{i | f x ≠ 0}` as a `finset`. -/ def support (f : Π₀ i, β i) : finset ι := -quotient.lift_on f (λ x, x.2.to_finset.filter $ λ i, x.1 i ≠ 0) $ +f.support'.lift (λ xs, (multiset.to_finset ↑xs).filter $ λ i, f i ≠ 0) $ begin - intros x y Hxy, + rintros ⟨sx, hx⟩ ⟨sy, hy⟩, + dsimp only [subtype.coe_mk, to_fun_eq_coe] at *, ext i, split, { intro H, rcases finset.mem_filter.1 H with ⟨h1, h2⟩, - rw Hxy i at h2, - exact finset.mem_filter.2 ⟨multiset.mem_to_finset.2 $ (y.3 i).resolve_right h2, h2⟩ }, + exact finset.mem_filter.2 ⟨multiset.mem_to_finset.2 $ (hy i).resolve_right h2, h2⟩ }, { intro H, rcases finset.mem_filter.1 H with ⟨h1, h2⟩, - rw ← Hxy i at h2, - exact finset.mem_filter.2 ⟨multiset.mem_to_finset.2 $ (x.3 i).resolve_right h2, h2⟩ }, + exact finset.mem_filter.2 ⟨multiset.mem_to_finset.2 $ (hx i).resolve_right h2, h2⟩ }, end @[simp] theorem support_mk_subset {s : finset ι} {x : Π i : (↑s : set ι), β i.1} : (mk s x).support ⊆ s := λ i H, multiset.mem_to_finset.1 (finset.mem_filter.1 H).1 +@[simp] theorem support_mk'_subset {f : Π i, β i} {s : multiset ι} {h} : + (mk' f $ trunc.mk ⟨s, h⟩).support ⊆ s.to_finset := +λ i H, multiset.mem_to_finset.1 $ by simpa using (finset.mem_filter.1 H).1 + @[simp] theorem mem_support_to_fun (f : Π₀ i, β i) (i) : i ∈ f.support ↔ f i ≠ 0 := begin - refine quotient.induction_on f (λ x, _), - dsimp only [support, quotient.lift_on_mk], - rw [finset.mem_filter, multiset.mem_to_finset], - exact and_iff_right_of_imp (x.3 i).resolve_right + cases f with f s, + induction s using trunc.induction_on, + dsimp only [support, trunc.lift_mk], + rw [finset.mem_filter, multiset.mem_to_finset, coe_mk'], + exact and_iff_right_of_imp (s.prop i).resolve_right end theorem eq_mk_support (f : Π₀ i, β i) : f = mk f.support (λ i, f i) := @@ -924,7 +950,7 @@ begin end lemma support_single_subset {i : ι} {b : β i} : (single i b).support ⊆ {i} := -support_mk_subset +support_mk'_subset section map_range_and_zip_with @@ -976,7 +1002,7 @@ by { ext j, by_cases h1 : j = i; by_cases h2 : f j ≠ 0; simp at h2; simp [h1, (f.erase i).support = f.support.erase i := by { ext j, by_cases h1 : j = i, simp [h1], by_cases h2 : f j ≠ 0; simp at h2; simp [h1, h2] } -lemma support_update_ne_zero (f : Π₀ i, β i) (i : ι) {b : β i} [decidable (b = 0)] (h : b ≠ 0) : +lemma support_update_ne_zero (f : Π₀ i, β i) (i : ι) {b : β i} (h : b ≠ 0) : support (f.update i b) = insert i f.support := begin ext j, @@ -1048,19 +1074,17 @@ open finset variables {κ : Type*} /--Reindexing (and possibly removing) terms of a dfinsupp.-/ -noncomputable def comap_domain [Π i, has_zero (β i)] (h : κ → ι) (hh : function.injective h) : - (Π₀ i, β i) → Π₀ k, β (h k) := -begin - refine quotient.lift (λ f, ⟦_⟧) (λ f f' h, _), - exact { to_fun := λ x, f.to_fun (h x), - pre_support := (f.pre_support.to_finset.preimage h (hh.inj_on _)).val, - zero := λ x, (f.zero (h x)).imp_left $ λ hx, mem_preimage.mpr $ multiset.mem_to_finset.mpr hx }, - exact quot.sound (λ x, h _) -end +noncomputable def comap_domain [Π i, has_zero (β i)] (h : κ → ι) (hh : function.injective h) + (f : Π₀ i, β i) : Π₀ k, β (h k) := +{ to_fun := λ x, f (h x), + support' := f.support'.map $ λ s, + ⟨((multiset.to_finset ↑s).preimage h (hh.inj_on _)).val, + λ x, (s.prop (h x)).imp_left $ λ hx, mem_preimage.mpr $ multiset.mem_to_finset.mpr hx ⟩ } + @[simp] lemma comap_domain_apply [Π i, has_zero (β i)] (h : κ → ι) (hh : function.injective h) (f : Π₀ i, β i) (k : κ) : comap_domain h hh f k = f (h k) := -by { rcases f, refl } +rfl @[simp] lemma comap_domain_zero [Π i, has_zero (β i)] (h : κ → ι) (hh : function.injective h) : comap_domain h hh (0 : Π₀ i, β i) = 0 := @@ -1076,21 +1100,28 @@ by { ext, rw [add_apply, comap_domain_apply, comap_domain_apply, comap_domain_ap comap_domain h hh (r • f) = r • comap_domain h hh f := by { ext, rw [smul_apply, comap_domain_apply, smul_apply, comap_domain_apply] } -omit dec -/--A computable version of comap_domain when an explicit left inverse is provided.-/ -def comap_domain'[Π i, has_zero (β i)] (h : κ → ι) {h' : ι → κ} (hh' : function.left_inverse h' h) : - (Π₀ i, β i) → (Π₀ k, β (h k)) := +@[simp] lemma comap_domain_single [decidable_eq κ] [Π i, has_zero (β i)] + (h : κ → ι) (hh : function.injective h) (k : κ) (x : β (h k)) : + comap_domain h hh (single (h k) x) = single k x := begin - refine quotient.lift (λ f, ⟦_⟧) (λ f f' h, _), - exact { to_fun := λ x, f.to_fun (h x), - pre_support := f.pre_support.map h', - zero := λ x, (f.zero (h x)).imp_left $ λ hx, multiset.mem_map.mpr ⟨_, hx, hh' _⟩ }, - exact quot.sound (λ x, h _), + ext, + rw comap_domain_apply, + obtain rfl | hik := decidable.eq_or_ne i k, + { rw [single_eq_same, single_eq_same] }, + { rw [single_eq_of_ne hik.symm, single_eq_of_ne (hh.ne hik.symm)] }, end +omit dec +/--A computable version of comap_domain when an explicit left inverse is provided.-/ +def comap_domain' [Π i, has_zero (β i)] (h : κ → ι) {h' : ι → κ} + (hh' : function.left_inverse h' h) (f : Π₀ i, β i) : (Π₀ k, β (h k)) := +{ to_fun := λ x, f (h x), + support' := f.support'.map $ λ s, ⟨multiset.map h' s, λ x, + (s.prop (h x)).imp_left $ λ hx, multiset.mem_map.mpr ⟨_, hx, hh' _⟩⟩ } + @[simp] lemma comap_domain'_apply [Π i, has_zero (β i)] (h : κ → ι) {h' : ι → κ} (hh' : function.left_inverse h' h) (f : Π₀ i, β i) (k : κ) : comap_domain' h hh' f k = f (h k) := -by { rcases f, refl } +rfl @[simp] lemma comap_domain'_zero [Π i, has_zero (β i)] (h : κ → ι) {h' : ι → κ} (hh' : function.left_inverse h' h) : @@ -1108,6 +1139,17 @@ by { ext, rw [add_apply, comap_domain'_apply, comap_domain'_apply, comap_domain' comap_domain' h hh' (r • f) = r • comap_domain' h hh' f := by { ext, rw [smul_apply, comap_domain'_apply, smul_apply, comap_domain'_apply] } +@[simp] lemma comap_domain'_single [decidable_eq ι] [decidable_eq κ] [Π i, has_zero (β i)] + (h : κ → ι) {h' : ι → κ} (hh' : function.left_inverse h' h) (k : κ) (x : β (h k)) : + comap_domain' h hh' (single (h k) x) = single k x := +begin + ext, + rw comap_domain'_apply, + obtain rfl | hik := decidable.eq_or_ne i k, + { rw [single_eq_same, single_eq_same] }, + { rw [single_eq_of_ne hik.symm, single_eq_of_ne (hh'.injective.ne hik.symm)] }, +end + /-- Reindexing terms of a dfinsupp. This is the dfinsupp version of `equiv.Pi_congr_left'`. -/ @@ -1182,42 +1224,88 @@ begin sigma_curry_apply, smul_apply] end +@[simp] lemma sigma_curry_single [decidable_eq ι] [Π i, decidable_eq (α i)] + [Π i j, has_zero (δ i j)] (ij : Σ i, α i) (x : δ ij.1 ij.2) : + @sigma_curry _ _ _ _ (single ij x) = single ij.1 (single ij.2 x : Π₀ j, δ ij.1 j) := +begin + obtain ⟨i, j⟩ := ij, + ext i' j', + dsimp only, + rw sigma_curry_apply, + obtain rfl | hi := eq_or_ne i i', + { rw single_eq_same, + obtain rfl | hj := eq_or_ne j j', + { rw [single_eq_same, single_eq_same] }, + { rw [single_eq_of_ne, single_eq_of_ne hj], + simpa using hj }, }, + { rw [single_eq_of_ne, single_eq_of_ne hi, zero_apply], + simpa using hi }, +end + /--The natural map between `Π₀ i (j : α i), δ i j` and `Π₀ (i : Σ i, α i), δ i.1 i.2`, inverse of `curry`.-/ -noncomputable def sigma_uncurry [Π i j, has_zero (δ i j)] (f : Π₀ i j, δ i j) : +def sigma_uncurry [Π i j, has_zero (δ i j)] + [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)] (f : Π₀ i j, δ i j) : Π₀ (i : Σ i, _), δ i.1 i.2 := -by { classical, - exact mk (f.support.bUnion $ λ i, (f i).support.image $ sigma.mk i) (λ ⟨⟨i, j⟩, _⟩, f i j) } - -@[simp] lemma sigma_uncurry_apply [Π i j, has_zero (δ i j)] (f : Π₀ i j, δ i j) (i : ι) (j : α i) : +{ to_fun := λ i, f i.1 i.2, + support' := f.support'.map $ λ s, + ⟨(multiset.bind ↑s $ λ i, ((f i).support.map ⟨sigma.mk i, sigma_mk_injective⟩).val), λ i, begin + simp_rw [multiset.mem_bind, map_val, multiset.mem_map, function.embedding.coe_fn_mk, + ←finset.mem_def, mem_support_to_fun], + obtain hi | (hi : f i.1 = 0) := s.prop i.1, + { by_cases hi' : f i.1 i.2 = 0, + { exact or.inr hi' }, + { exact or.inl ⟨_, hi, i.2, hi', sigma.eta _⟩ } }, + { right, + rw [hi, zero_apply] } + end⟩ } + +@[simp] lemma sigma_uncurry_apply [Π i j, has_zero (δ i j)] + [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)] + (f : Π₀ i j, δ i j) (i : ι) (j : α i) : sigma_uncurry f ⟨i, j⟩ = f i j := -begin - dunfold sigma_uncurry, by_cases h : f i j = 0, - { rw mk_apply, split_ifs, { refl }, { exact h.symm } }, - { apply mk_of_mem, rw mem_bUnion, refine ⟨i, _, _⟩, - { rw mem_support_to_fun, intro H, rw ext_iff at H, exact h (H j) }, - { apply mem_image_of_mem, rw mem_support_to_fun, exact h } } -end +rfl -@[simp] lemma sigma_uncurry_zero [Π i j, has_zero (δ i j)] : +@[simp] lemma sigma_uncurry_zero [Π i j, has_zero (δ i j)] + [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)]: sigma_uncurry (0 : Π₀ i j, δ i j) = 0 := -by { ext ⟨i, j⟩, rw sigma_uncurry_apply, refl } +rfl -@[simp] lemma sigma_uncurry_add [Π i j, add_zero_class (δ i j)] (f g : Π₀ i j, δ i j) : +@[simp] lemma sigma_uncurry_add [Π i j, add_zero_class (δ i j)] + [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)] + (f g : Π₀ i j, δ i j) : sigma_uncurry (f + g) = sigma_uncurry f + sigma_uncurry g := -by { ext ⟨i, j⟩, rw [add_apply, sigma_uncurry_apply, - sigma_uncurry_apply, sigma_uncurry_apply, @add_apply _ (λ i, Π₀ j, δ i j) _, add_apply] } +coe_fn_injective rfl @[simp] lemma sigma_uncurry_smul [monoid γ] [Π i j, add_monoid (δ i j)] + [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)] [Π i j, distrib_mul_action γ (δ i j)] (r : γ) (f : Π₀ i j, δ i j) : sigma_uncurry (r • f) = r • sigma_uncurry f := -by { ext ⟨i, j⟩, rw [smul_apply, sigma_uncurry_apply, - sigma_uncurry_apply, @smul_apply _ _ (λ i, Π₀ j, δ i j) _ _ _, smul_apply] } +coe_fn_injective rfl + +@[simp] lemma sigma_uncurry_single [Π i j, has_zero (δ i j)] + [decidable_eq ι] [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)] + (i) (j : α i) (x : δ i j) : + sigma_uncurry (single i (single j x : Π₀ (j : α i), δ i j)) = single ⟨i, j⟩ x:= +begin + ext ⟨i', j'⟩, + dsimp only, + rw sigma_uncurry_apply, + obtain rfl | hi := eq_or_ne i i', + { rw single_eq_same, + obtain rfl | hj := eq_or_ne j j', + { rw [single_eq_same, single_eq_same] }, + { rw [single_eq_of_ne hj, single_eq_of_ne], + simpa using hj }, }, + { rw [single_eq_of_ne hi, single_eq_of_ne, zero_apply], + simpa using hi }, +end /--The natural bijection between `Π₀ (i : Σ i, α i), δ i.1 i.2` and `Π₀ i (j : α i), δ i j`. This is the dfinsupp version of `equiv.Pi_curry`. -/ -noncomputable def sigma_curry_equiv [Π i j, has_zero (δ i j)] : +noncomputable def sigma_curry_equiv [Π i j, has_zero (δ i j)] + [Π i, decidable_eq (α i)] [Π i j (x : δ i j), decidable (x ≠ 0)] : (Π₀ (i : Σ i, _), δ i.1 i.2) ≃ Π₀ i j, δ i j := { to_fun := sigma_curry, inv_fun := sigma_uncurry, @@ -1231,21 +1319,38 @@ variables {α : option ι → Type v} /-- Adds a term to a dfinsupp, making a dfinsupp indexed by an `option`. This is the dfinsupp version of `option.rec`. -/ -def extend_with [Π i, has_zero (α i)] (a : α none) : (Π₀ i, α (some i)) → Π₀ i, α i := -begin - refine quotient.lift (λ f, ⟦_⟧) (λ f f' h, _), - exact { to_fun := option.rec a f.to_fun, - pre_support := none ::ₘ (f.pre_support.map some), - zero := λ i, option.rec (or.inl $ multiset.mem_cons_self _ _) - (λ i, (f.zero i).imp_left $ λ h, multiset.mem_cons_of_mem $ multiset.mem_map_of_mem _ h) i }, - { refine quot.sound (option.rec _ $ λ x, _), refl, exact h x }, -end +def extend_with [Π i, has_zero (α i)] (a : α none) (f : Π₀ i, α (some i)) : Π₀ i, α i := +{ to_fun := option.rec a f, + support' := f.support'.map $ λ s, ⟨none ::ₘ multiset.map some s, λ i, + option.rec (or.inl $ multiset.mem_cons_self _ _) + (λ i, (s.prop i).imp_left $ λ h, multiset.mem_cons_of_mem $ multiset.mem_map_of_mem _ h) i⟩ } + @[simp] lemma extend_with_none [Π i, has_zero (α i)] (f : Π₀ i, α (some i)) (a : α none) : f.extend_with a none = a := -by { rcases f, refl } +rfl @[simp] lemma extend_with_some [Π i, has_zero (α i)] (f : Π₀ i, α (some i)) (a : α none) (i : ι) : f.extend_with a (some i) = f i := -by { rcases f, refl } +rfl + +@[simp] lemma extend_with_single_zero [decidable_eq ι] [Π i, has_zero (α i)] + (i : ι) (x : α (some i)) : + (single i x).extend_with 0 = single (some i) x := +begin + ext (_ | j), + { rw [extend_with_none, single_eq_of_ne (option.some_ne_none _)] }, + { rw extend_with_some, + obtain rfl | hij := decidable.eq_or_ne i j, + { rw [single_eq_same, single_eq_same] }, + { rw [single_eq_of_ne hij, single_eq_of_ne ((option.some_injective _).ne hij)] }, }, +end + +@[simp] lemma extend_with_zero [decidable_eq ι] [Π i, has_zero (α i)] (x : α none) : + (0 : Π₀ i, α (some i)).extend_with x = single none x := +begin + ext (_ | j), + { rw [extend_with_none, single_eq_same] }, + { rw [extend_with_some, single_eq_of_ne (option.some_ne_none _).symm, zero_apply] }, +end include dec /-- Bijection obtained by separating the term of index `none` of a dfinsupp over `option ι`. @@ -1260,9 +1365,10 @@ This is the dfinsupp version of `equiv.pi_option_equiv_prod`. -/ { rw extend_with_none }, { rw [extend_with_some, comap_domain_apply] } end, - right_inv := λ _, begin + right_inv := λ x, begin + dsimp only, ext, - { exact extend_with_none _ _ }, + { exact extend_with_none x.snd _ }, { rw [comap_domain_apply, extend_with_some] } end } @@ -1367,7 +1473,7 @@ finset.prod_mul_distrib @[simp, to_additive] lemma prod_inv [Π i, add_comm_monoid (β i)] [Π i (x : β i), decidable (x ≠ 0)] [comm_group γ] {f : Π₀ i, β i} {h : Π i, β i → γ} : f.prod (λi b, (h i b)⁻¹) = (f.prod h)⁻¹ := -((comm_group.inv_monoid_hom : γ →* γ).map_prod _ f.support).symm +((inv_monoid_hom : γ →* γ).map_prod _ f.support).symm @[to_additive] lemma prod_eq_one [Π i, has_zero (β i)] [Π i (x : β i), decidable (x ≠ 0)] [comm_monoid γ] {f : Π₀ i, β i} {h : Π i, β i → γ} (hyp : ∀ i, h i (f i) = 1) : @@ -1423,43 +1529,44 @@ also an `add_monoid_hom`. def sum_add_hom [Π i, add_zero_class (β i)] [add_comm_monoid γ] (φ : Π i, β i →+ γ) : (Π₀ i, β i) →+ γ := { to_fun := (λ f, - quotient.lift_on f (λ x, ∑ i in x.2.to_finset, φ i (x.1 i)) $ λ x y H, + f.support'.lift (λ s, ∑ i in multiset.to_finset ↑s, φ i (f i)) $ begin - have H1 : x.2.to_finset ∩ y.2.to_finset ⊆ x.2.to_finset, from finset.inter_subset_left _ _, - have H2 : x.2.to_finset ∩ y.2.to_finset ⊆ y.2.to_finset, from finset.inter_subset_right _ _, + rintros ⟨sx, hx⟩ ⟨sy, hy⟩, + dsimp only [subtype.coe_mk, to_fun_eq_coe] at *, + have H1 : sx.to_finset ∩ sy.to_finset ⊆ sx.to_finset, from finset.inter_subset_left _ _, + have H2 : sx.to_finset ∩ sy.to_finset ⊆ sy.to_finset, from finset.inter_subset_right _ _, refine (finset.sum_subset H1 _).symm.trans ((finset.sum_congr rfl _).trans (finset.sum_subset H2 _)), - { intros i H1 H2, rw finset.mem_inter at H2, rw H i, + { intros i H1 H2, rw finset.mem_inter at H2, simp only [multiset.mem_to_finset] at H1 H2, - rw [(y.3 i).resolve_left (mt (and.intro H1) H2), add_monoid_hom.map_zero] }, - { intros i H1, rw H i }, - { intros i H1 H2, rw finset.mem_inter at H2, rw ← H i, + rw [(hy i).resolve_left (mt (and.intro H1) H2), add_monoid_hom.map_zero] }, + { intros i H1, refl }, + { intros i H1 H2, rw finset.mem_inter at H2, simp only [multiset.mem_to_finset] at H1 H2, - rw [(x.3 i).resolve_left (mt (λ H3, and.intro H3 H1) H2), add_monoid_hom.map_zero] } + rw [(hx i).resolve_left (mt (λ H3, and.intro H3 H1) H2), add_monoid_hom.map_zero] } end), - map_add' := assume f g, - begin - refine quotient.induction_on f (λ x, _), - refine quotient.induction_on g (λ y, _), + map_add' := begin + rintros ⟨f, sf, hf⟩ ⟨g, sg, hg⟩, change ∑ i in _, _ = (∑ i in _, _) + (∑ i in _, _), - simp only, conv { to_lhs, congr, skip, funext, rw add_monoid_hom.map_add }, - simp only [finset.sum_add_distrib], + simp only [coe_add, coe_mk', subtype.coe_mk, pi.add_apply, map_add, finset.sum_add_distrib], congr' 1, { refine (finset.sum_subset _ _).symm, { intro i, simp only [multiset.mem_to_finset, multiset.mem_add], exact or.inl }, { intros i H1 H2, simp only [multiset.mem_to_finset, multiset.mem_add] at H2, - rw [(x.3 i).resolve_left H2, add_monoid_hom.map_zero] } }, + rw [(hf i).resolve_left H2, add_monoid_hom.map_zero] } }, { refine (finset.sum_subset _ _).symm, { intro i, simp only [multiset.mem_to_finset, multiset.mem_add], exact or.inr }, { intros i H1 H2, simp only [multiset.mem_to_finset, multiset.mem_add] at H2, - rw [(y.3 i).resolve_left H2, add_monoid_hom.map_zero] } } + rw [(hg i).resolve_left H2, add_monoid_hom.map_zero] } } end, map_zero' := rfl } @[simp] lemma sum_add_hom_single [Π i, add_zero_class (β i)] [add_comm_monoid γ] (φ : Π i, β i →+ γ) (i) (x : β i) : sum_add_hom φ (single i x) = φ i x := -(add_zero _).trans $ congr_arg (φ i) $ show (if H : i ∈ ({i} : finset _) then x else 0) = x, -from dif_pos $ finset.mem_singleton_self i +begin + dsimp [sum_add_hom, single, trunc.lift_mk], + rw [multiset.to_finset_singleton, finset.sum_singleton, pi.single_eq_same], +end @[simp] lemma sum_add_hom_comp_single [Π i, add_zero_class (β i)] [add_comm_monoid γ] (f : Π i, β i →+ γ) (i : ι) : @@ -1471,11 +1578,11 @@ lemma sum_add_hom_apply [Π i, add_zero_class (β i)] [Π i (x : β i), decidabl [add_comm_monoid γ] (φ : Π i, β i →+ γ) (f : Π₀ i, β i) : sum_add_hom φ f = f.sum (λ x, φ x) := begin - refine quotient.induction_on f (λ x, _), + rcases f with ⟨f, s, hf⟩, change ∑ i in _, _ = (∑ i in finset.filter _ _, _), rw [finset.sum_filter, finset.sum_congr rfl], intros i _, - dsimp only, + dsimp only [coe_mk', subtype.coe_mk] at *, split_ifs, refl, rw [(not_not.mp h), add_monoid_hom.map_zero], @@ -1556,9 +1663,9 @@ lemma sum_add_hom_comm {ι₁ ι₂ : Sort*} {β₁ : ι₁ → Type*} {β₂ : sum_add_hom (λ i₂, sum_add_hom (λ i₁, h i₁ i₂) f₁) f₂ = sum_add_hom (λ i₁, sum_add_hom (λ i₂, (h i₁ i₂).flip) f₂) f₁ := begin - refine quotient.induction_on₂ f₁ f₂ (λ x₁ x₂, _), + obtain ⟨⟨f₁, s₁, h₁⟩, ⟨f₂, s₂, h₂⟩⟩ := ⟨f₁, f₂⟩, simp only [sum_add_hom, add_monoid_hom.finset_sum_apply, quotient.lift_on_mk, - add_monoid_hom.coe_mk, add_monoid_hom.flip_apply], + add_monoid_hom.coe_mk, add_monoid_hom.flip_apply, trunc.lift], exact finset.sum_comm, end @@ -1864,3 +1971,32 @@ add_monoid_hom.congr_fun (comp_lift_add_hom h.to_add_monoid_hom g) f end add_equiv end + +section finite_infinite + +instance dfinsupp.fintype {ι : Sort*} {π : ι → Sort*} [decidable_eq ι] [Π i, has_zero (π i)] + [fintype ι] [∀ i, fintype (π i)] : + fintype (Π₀ i, π i) := +fintype.of_equiv (Π i, π i) dfinsupp.equiv_fun_on_fintype.symm + +instance dfinsupp.infinite_of_left {ι : Sort*} {π : ι → Sort*} + [∀ i, nontrivial (π i)] [Π i, has_zero (π i)] [infinite ι] : + infinite (Π₀ i, π i) := +by letI := classical.dec_eq ι; choose m hm using (λ i, exists_ne (0 : π i)); exact +infinite.of_injective _ (dfinsupp.single_left_injective hm) + +/-- See `dfinsupp.infinite_of_right` for this in instance form, with the drawback that +it needs all `π i` to be infinite. -/ +lemma dfinsupp.infinite_of_exists_right {ι : Sort*} {π : ι → Sort*} + (i : ι) [infinite (π i)] [Π i, has_zero (π i)] : + infinite (Π₀ i, π i) := +by letI := classical.dec_eq ι; exact +infinite.of_injective (λ j, dfinsupp.single i j) dfinsupp.single_injective + +/-- See `dfinsupp.infinite_of_exists_right` for the case that only one `π ι` is infinite. -/ +instance dfinsupp.infinite_of_right {ι : Sort*} {π : ι → Sort*} + [∀ i, infinite (π i)] [Π i, has_zero (π i)] [nonempty ι] : + infinite (Π₀ i, π i) := +dfinsupp.infinite_of_exists_right (classical.arbitrary ι) + +end finite_infinite diff --git a/src/data/dfinsupp/interval.lean b/src/data/dfinsupp/interval.lean index f589ac9929f4a..990341f78ec32 100644 --- a/src/data/dfinsupp/interval.lean +++ b/src/data/dfinsupp/interval.lean @@ -5,12 +5,15 @@ Authors: Yaël Dillies -/ import data.finset.locally_finite import data.finset.pointwise -import data.fintype.card +import data.fintype.big_operators import data.dfinsupp.order /-! # Finite intervals of finitely supported functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides the `locally_finite_order` instance for `Π₀ i, α i` when `α` itself is locally finite and calculates the cardinality of its finite intervals. -/ @@ -70,16 +73,14 @@ end finset open finset namespace dfinsupp -variables [decidable_eq ι] [Π i, decidable_eq (α i)] section bundled_singleton variables [Π i, has_zero (α i)] {f : Π₀ i, α i} {i : ι} {a : α i} /-- Pointwise `finset.singleton` bundled as a `dfinsupp`. -/ def singleton (f : Π₀ i, α i) : Π₀ i, finset (α i) := -⟦{ to_fun := λ i, {f i}, - pre_support := f.support.1, - zero := λ i, (ne_or_eq (f i) 0).imp mem_support_iff.2 (congr_arg _) }⟧ +{ to_fun := λ i, {f i}, + support' := f.support'.map $ λ s, ⟨s, λ i, (s.prop i).imp id (congr_arg _) ⟩ } lemma mem_singleton_apply_iff : a ∈ f.singleton i ↔ a = f i := mem_singleton @@ -91,20 +92,23 @@ variables [Π i, has_zero (α i)] [Π i, partial_order (α i)] [Π i, locally_fi /-- Pointwise `finset.Icc` bundled as a `dfinsupp`. -/ def range_Icc (f g : Π₀ i, α i) : Π₀ i, finset (α i) := -⟦{ to_fun := λ i, Icc (f i) (g i), - pre_support := f.support.1 + g.support.1, - zero := λ i, begin - refine or_iff_not_imp_left.2 (λ h, _), - rw [not_mem_support_iff.1 (multiset.not_mem_mono (multiset.le_add_right _ _).subset h), - not_mem_support_iff.1 (multiset.not_mem_mono (multiset.le_add_left _ _).subset h)], - exact Icc_self _, - end }⟧ +{ to_fun := λ i, Icc (f i) (g i), + support' := f.support'.bind $ λ fs, g.support'.map $ λ gs, + ⟨fs + gs, λ i, or_iff_not_imp_left.2 $ λ h, begin + have hf : f i = 0 := (fs.prop i).resolve_left + (multiset.not_mem_mono (multiset.le.subset $ multiset.le_add_right _ _) h), + have hg : g i = 0 := (gs.prop i).resolve_left + (multiset.not_mem_mono (multiset.le.subset $ multiset.le_add_left _ _) h), + rw [hf, hg], + exact Icc_self _, + end⟩ } @[simp] lemma range_Icc_apply (f g : Π₀ i, α i) (i : ι) : f.range_Icc g i = Icc (f i) (g i) := rfl lemma mem_range_Icc_apply_iff : a ∈ f.range_Icc g i ↔ f i ≤ a ∧ a ≤ g i := mem_Icc -lemma support_range_Icc_subset : (f.range_Icc g).support ⊆ f.support ∪ g.support := +lemma support_range_Icc_subset [decidable_eq ι] [Π i, decidable_eq (α i)] : + (f.range_Icc g).support ⊆ f.support ∪ g.support := begin refine λ x hx, _, by_contra, @@ -119,7 +123,7 @@ end end bundled_Icc section pi -variables [Π i, has_zero (α i)] +variables [Π i, has_zero (α i)] [decidable_eq ι] [Π i, decidable_eq (α i)] /-- Given a finitely supported function `f : Π₀ i, finset (α i)`, one can define the finset `f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/ @@ -136,7 +140,8 @@ end end pi -section locally_finite +section partial_order +variables [decidable_eq ι] [Π i, decidable_eq (α i)] variables [Π i, partial_order (α i)] [Π i, has_zero (α i)] [Π i, locally_finite_order (α i)] instance : locally_finite_order (Π₀ i, α i) := @@ -150,6 +155,8 @@ locally_finite_order.of_Icc (Π₀ i, α i) variables (f g : Π₀ i, α i) +lemma Icc_eq : Icc f g = (f.support ∪ g.support).dfinsupp (f.range_Icc g) := rfl + lemma card_Icc : (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card := card_dfinsupp _ _ @@ -162,5 +169,30 @@ by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc] lemma card_Ioo : (Ioo f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 2 := by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc] -end locally_finite +end partial_order + +section lattice +variables [decidable_eq ι] [Π i, decidable_eq (α i)] [Π i, lattice (α i)] [Π i, has_zero (α i)] + [Π i, locally_finite_order (α i)] (f g : Π₀ i, α i) + +lemma card_uIcc : (uIcc f g).card = ∏ i in f.support ∪ g.support, (uIcc (f i) (g i)).card := +by { rw ←support_inf_union_support_sup, exact card_Icc _ _ } + +end lattice + +section canonically_ordered +variables [decidable_eq ι] [Π i, decidable_eq (α i)] +variables [Π i, canonically_ordered_add_monoid (α i)] [Π i, locally_finite_order (α i)] + +variables (f : Π₀ i, α i) + +lemma card_Iic : (Iic f).card = ∏ i in f.support, (Iic (f i)).card := +by simp_rw [Iic_eq_Icc, card_Icc, dfinsupp.bot_eq_zero, support_zero, empty_union, zero_apply, + bot_eq_zero] + +lemma card_Iio : (Iio f).card = ∏ i in f.support, (Iic (f i)).card - 1 := +by rw [card_Iio_eq_card_Iic_sub_one, card_Iic] + +end canonically_ordered + end dfinsupp diff --git a/src/data/dfinsupp/lex.lean b/src/data/dfinsupp/lex.lean new file mode 100644 index 0000000000000..3f52398c4be95 --- /dev/null +++ b/src/data/dfinsupp/lex.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2022 Junyan Xu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa, Junyan Xu +-/ +import data.dfinsupp.order +import data.dfinsupp.ne_locus +import order.well_founded_set + +/-! +# Lexicographic order on finitely supported dependent functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the lexicographic order on `dfinsupp`. +-/ + +variables {ι : Type*} {α : ι → Type*} + +namespace dfinsupp + +section has_zero + +variable [Π i, has_zero (α i)] + +/-- `dfinsupp.lex r s` is the lexicographic relation on `Π₀ i, α i`, where `ι` is ordered by `r`, +and `α i` is ordered by `s i`. +The type synonym `lex (Π₀ i, α i)` has an order given by `dfinsupp.lex (<) (λ i, (<))`. +-/ +protected def lex (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) (x y : Π₀ i, α i) : Prop := +pi.lex r s x y + +lemma _root_.pi.lex_eq_dfinsupp_lex {r : ι → ι → Prop} {s : Π i, α i → α i → Prop} + (a b : Π₀ i, α i) : pi.lex r s (a : Π i, α i) b = dfinsupp.lex r s a b := rfl + +lemma lex_def {r : ι → ι → Prop} {s : Π i, α i → α i → Prop} {a b : Π₀ i, α i} : + dfinsupp.lex r s a b ↔ ∃ j, (∀ d, r d j → a d = b d) ∧ s j (a j) (b j) := iff.rfl + +instance [has_lt ι] [Π i, has_lt (α i)] : has_lt (lex (Π₀ i, α i)) := +⟨λ f g, dfinsupp.lex (<) (λ i, (<)) (of_lex f) (of_lex g)⟩ + +lemma lex_lt_of_lt_of_preorder [Π i, preorder (α i)] (r) [is_strict_order ι r] + {x y : Π₀ i, α i} (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i := +begin + obtain ⟨hle, j, hlt⟩ := pi.lt_def.1 hlt, classical, + have : (x.ne_locus y : set ι).well_founded_on r := (x.ne_locus y).finite_to_set.well_founded_on, + obtain ⟨i, hi, hl⟩ := this.has_min {i | x i < y i} ⟨⟨j, mem_ne_locus.2 hlt.ne⟩, hlt⟩, + exact ⟨i, λ k hk, ⟨hle k, of_not_not $ λ h, + hl ⟨k, mem_ne_locus.2 (ne_of_not_le h).symm⟩ ((hle k).lt_of_not_le h) hk⟩, hi⟩, +end + +lemma lex_lt_of_lt [Π i, partial_order (α i)] (r) [is_strict_order ι r] + {x y : Π₀ i, α i} (hlt : x < y) : pi.lex r (λ i, (<)) x y := +by { simp_rw [pi.lex, le_antisymm_iff], exact lex_lt_of_lt_of_preorder r hlt } + +instance lex.is_strict_order [linear_order ι] [Π i, partial_order (α i)] : + is_strict_order (lex (Π₀ i, α i)) (<) := +let i : is_strict_order (lex (Π i, α i)) (<) := pi.lex.is_strict_order in +{ irrefl := to_lex.surjective.forall.2 $ λ a, @irrefl _ _ i.to_is_irrefl a, + trans := to_lex.surjective.forall₃.2 $ λ a b c, @trans _ _ i.to_is_trans a b c } + +variables [linear_order ι] + +/-- The partial order on `dfinsupp`s obtained by the lexicographic ordering. +See `dfinsupp.lex.linear_order` for a proof that this partial order is in fact linear. -/ +instance lex.partial_order [Π i, partial_order (α i)] : partial_order (lex (Π₀ i, α i)) := +partial_order.lift (λ x, to_lex ⇑(of_lex x)) dfinsupp.coe_fn_injective + +section linear_order + +variable [Π i, linear_order (α i)] + +/-- Auxiliary helper to case split computably. There is no need for this to be public, as it +can be written with `or.by_cases` on `lt_trichotomy` once the instances below are constructed. -/ +private def lt_trichotomy_rec {P : lex (Π₀ i, α i) → lex (Π₀ i, α i) → Sort*} + (h_lt : Π {f g}, to_lex f < to_lex g → P (to_lex f) (to_lex g)) + (h_eq : Π {f g}, to_lex f = to_lex g → P (to_lex f) (to_lex g)) + (h_gt : Π {f g}, to_lex g < to_lex f → P (to_lex f) (to_lex g)) : + Π f g, P f g := +lex.rec $ λ f, lex.rec $ λ g, + match _, rfl : ∀ y, (f.ne_locus g).min = y → _ with + | ⊤, h := h_eq (ne_locus_eq_empty.mp $ finset.min_eq_top.mp h) + | (wit : ι), h := (mem_ne_locus.mp $ finset.mem_of_min h).lt_or_lt.by_cases + (λ hwit, h_lt ⟨wit, λ j hj, not_mem_ne_locus.mp (finset.not_mem_of_lt_min hj h), hwit⟩) + (λ hwit, h_gt ⟨wit, λ j hj, not_mem_ne_locus.mp + (finset.not_mem_of_lt_min hj $ by rwa ne_locus_comm), hwit⟩) + end + +@[irreducible] instance lex.decidable_le : @decidable_rel (lex (Π₀ i, α i)) (≤) := +lt_trichotomy_rec + (λ f g h, is_true $ or.inr h) + (λ f g h, is_true $ or.inl $ congr_arg _ h) + (λ f g h, is_false $ λ h', (lt_irrefl _ (h.trans_le h')).elim) + +@[irreducible] instance lex.decidable_lt : @decidable_rel (lex (Π₀ i, α i)) (<) := +lt_trichotomy_rec + (λ f g h, is_true h) + (λ f g h, is_false h.not_lt) + (λ f g h, is_false h.asymm) + +/-- The linear order on `dfinsupp`s obtained by the lexicographic ordering. -/ +instance lex.linear_order : linear_order (lex (Π₀ i, α i)) := +{ le_total := lt_trichotomy_rec + (λ f g h, or.inl h.le) + (λ f g h, or.inl h.le) + (λ f g h, or.inr h.le), + decidable_lt := by apply_instance, + decidable_le := by apply_instance, + decidable_eq := by apply_instance, + ..lex.partial_order } + +end linear_order + +variable [Π i, partial_order (α i)] + +lemma to_lex_monotone : monotone (@to_lex (Π₀ i, α i)) := +λ a b h, le_of_lt_or_eq $ or_iff_not_imp_right.2 $ λ hne, by classical; exact + ⟨finset.min' _ (nonempty_ne_locus_iff.2 hne), + λ j hj, not_mem_ne_locus.1 (λ h, (finset.min'_le _ _ h).not_lt hj), + (h _).lt_of_ne (mem_ne_locus.1 $ finset.min'_mem _ _)⟩ + +lemma lt_of_forall_lt_of_lt (a b : lex (Π₀ i, α i)) (i : ι) : + (∀ j < i, of_lex a j = of_lex b j) → of_lex a i < of_lex b i → a < b := +λ h1 h2, ⟨i, h1, h2⟩ + +end has_zero + +section covariants +variables [linear_order ι] [Π i, add_monoid (α i)] [Π i, linear_order (α i)] + +/-! We are about to sneak in a hypothesis that might appear to be too strong. +We assume `covariant_class` with *strict* inequality `<` also when proving the one with the +*weak* inequality `≤`. This is actually necessary: addition on `lex (Π₀ i, α i)` may fail to be +monotone, when it is "just" monotone on `α i`. -/ +section left +variables [Π i, covariant_class (α i) (α i) (+) (<)] + +instance lex.covariant_class_lt_left : + covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (+) (<) := +⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg ((+) _) (lta j ja), add_lt_add_left ha _⟩⟩ + +instance lex.covariant_class_le_left : + covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (+) (≤) := has_add.to_covariant_class_left _ + +end left + +section right +variables [Π i, covariant_class (α i) (α i) (function.swap (+)) (<)] + +instance lex.covariant_class_lt_right : + covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (function.swap (+)) (<) := +⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg (+ (of_lex f j)) (lta j ja), add_lt_add_right ha _⟩⟩ + +instance lex.covariant_class_le_right : + covariant_class (lex (Π₀ i, α i)) (lex (Π₀ i, α i)) (function.swap (+)) (≤) := +has_add.to_covariant_class_right _ + +end right + +end covariants + +end dfinsupp diff --git a/src/data/dfinsupp/multiset.lean b/src/data/dfinsupp/multiset.lean new file mode 100644 index 0000000000000..9b20c21615ef9 --- /dev/null +++ b/src/data/dfinsupp/multiset.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import data.dfinsupp.order + +/-! +# Equivalence between `multiset` and `ℕ`-valued finitely supported functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This defines `dfinsupp.to_multiset` the equivalence between `Π₀ a : α, ℕ` and `multiset α`, along +with `multiset.to_dfinsupp` the reverse equivalence. + +Note that this provides a computable alternative to `finsupp.to_multiset`. +-/ + +open function + +variables {α : Type*} {β : α → Type*} + +namespace dfinsupp + +/-- Non-dependent special case of `dfinsupp.add_zero_class` to help typeclass search. -/ +instance add_zero_class' {β} [add_zero_class β] : add_zero_class (Π₀ a : α, β) := +@dfinsupp.add_zero_class α (λ _, β) _ + +variables [decidable_eq α] + +/-- A computable version of `finsupp.to_multiset`. -/ +def to_multiset : (Π₀ a : α, ℕ) →+ multiset α := +dfinsupp.sum_add_hom (λ a : α, multiset.replicate_add_monoid_hom a) + +@[simp] lemma to_multiset_single (a : α) (n : ℕ) : + to_multiset (dfinsupp.single a n) = multiset.replicate n a := +dfinsupp.sum_add_hom_single _ _ _ + +end dfinsupp + +namespace multiset +variables [decidable_eq α] {s t : multiset α} + +/-- A computable version of `multiset.to_finsupp` -/ +def to_dfinsupp : multiset α →+ Π₀ a : α, ℕ := +{ to_fun := λ s, + { to_fun := λ n, s.count n, + support' := trunc.mk ⟨s, λ i, (em (i ∈ s)).imp_right multiset.count_eq_zero_of_not_mem⟩ }, + map_zero' := rfl, + map_add' := λ s t, dfinsupp.ext $ λ _, multiset.count_add _ _ _ } + +@[simp] lemma to_dfinsupp_apply (s : multiset α) (a : α) : + s.to_dfinsupp a = s.count a := rfl + +@[simp] lemma to_dfinsupp_support (s : multiset α) : s.to_dfinsupp.support = s.to_finset := +finset.filter_true_of_mem $ λ x hx, count_ne_zero.mpr $ multiset.mem_to_finset.1 hx + +@[simp] lemma to_dfinsupp_replicate (a : α) (n : ℕ) : + to_dfinsupp (multiset.replicate n a) = dfinsupp.single a n := +begin + ext i, + dsimp [to_dfinsupp], + simp [count_replicate, eq_comm], +end + +@[simp] lemma to_dfinsupp_singleton (a : α) : to_dfinsupp {a} = dfinsupp.single a 1 := +by rw [←replicate_one, to_dfinsupp_replicate] + +/-- `multiset.to_dfinsupp` as an `add_equiv`. -/ +@[simps apply symm_apply] +def equiv_dfinsupp : multiset α ≃+ Π₀ a : α, ℕ := +add_monoid_hom.to_add_equiv + multiset.to_dfinsupp + dfinsupp.to_multiset + (by { ext x : 1, simp }) + (by { refine @dfinsupp.add_hom_ext α (λ _, ℕ) _ _ _ _ _ _ (λ i hi, _), simp, }) + +@[simp] lemma to_dfinsupp_to_multiset (s : multiset α) : s.to_dfinsupp.to_multiset = s := +equiv_dfinsupp.symm_apply_apply s + +lemma to_dfinsupp_injective : injective (to_dfinsupp : multiset α → Π₀ a, ℕ) := +equiv_dfinsupp.injective + +@[simp] lemma to_dfinsupp_inj : to_dfinsupp s = to_dfinsupp t ↔ s = t := +to_dfinsupp_injective.eq_iff + +@[simp] lemma to_dfinsupp_le_to_dfinsupp : to_dfinsupp s ≤ to_dfinsupp t ↔ s ≤ t := +by simp [multiset.le_iff_count, dfinsupp.le_def] + +@[simp] lemma to_dfinsupp_lt_to_dfinsupp : to_dfinsupp s < to_dfinsupp t ↔ s < t := +lt_iff_lt_of_le_iff_le' to_dfinsupp_le_to_dfinsupp to_dfinsupp_le_to_dfinsupp + +@[simp] lemma to_dfinsupp_inter (s t : multiset α) : + to_dfinsupp (s ∩ t) = s.to_dfinsupp ⊓ t.to_dfinsupp := +by { ext i, simp [inf_eq_min] } + +@[simp] lemma to_dfinsupp_union (s t : multiset α) : + to_dfinsupp (s ∪ t) = s.to_dfinsupp ⊔ t.to_dfinsupp := +by { ext i, simp [sup_eq_max] } + +end multiset + +namespace dfinsupp +variables [decidable_eq α] {f g : Π₀ a : α, ℕ} + +@[simp] lemma to_multiset_to_dfinsupp : f.to_multiset.to_dfinsupp = f := +multiset.equiv_dfinsupp.apply_symm_apply f + +lemma to_multiset_injective : injective (to_multiset : (Π₀ a, ℕ) → multiset α) := +multiset.equiv_dfinsupp.symm.injective + +@[simp] lemma to_multiset_inj : to_multiset f = to_multiset g ↔ f = g := +to_multiset_injective.eq_iff + +@[simp] lemma to_multiset_le_to_multiset : to_multiset f ≤ to_multiset g ↔ f ≤ g := +by simp_rw [←multiset.to_dfinsupp_le_to_dfinsupp, to_multiset_to_dfinsupp] + +@[simp] lemma to_multiset_lt_to_multiset : to_multiset f < to_multiset g ↔ f < g := +by simp_rw [←multiset.to_dfinsupp_lt_to_dfinsupp, to_multiset_to_dfinsupp] + +variables (f g) + +@[simp] lemma to_multiset_inf : to_multiset (f ⊓ g) = f.to_multiset ∩ g.to_multiset := +multiset.to_dfinsupp_injective $ by simp + +@[simp] lemma to_multiset_sup : to_multiset (f ⊔ g) = f.to_multiset ∪ g.to_multiset := +multiset.to_dfinsupp_injective $ by simp + +end dfinsupp diff --git a/src/data/dfinsupp/ne_locus.lean b/src/data/dfinsupp/ne_locus.lean new file mode 100644 index 0000000000000..772d04af470e8 --- /dev/null +++ b/src/data/dfinsupp/ne_locus.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2022 Junyan Xu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa, Junyan Xu +-/ +import data.dfinsupp.basic + +/-! +# Locus of unequal values of finitely supported dependent functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `N : α → Type*` be a type family, assume that `N a` has a `0` for all `a : α` and let +`f g : Π₀ a, N a` be finitely supported dependent functions. + +## Main definition + +* `dfinsupp.ne_locus f g : finset α`, the finite subset of `α` where `f` and `g` differ. +In the case in which `N a` is an additive group for all `a`, `dfinsupp.ne_locus f g` coincides with +`dfinsupp.support (f - g)`. +-/ + +variables {α : Type*} {N : α → Type*} + +namespace dfinsupp +variable [decidable_eq α] + +section N_has_zero +variables [Π a, decidable_eq (N a)] [Π a, has_zero (N a)] (f g : Π₀ a, N a) + +/-- Given two finitely supported functions `f g : α →₀ N`, `finsupp.ne_locus f g` is the `finset` +where `f` and `g` differ. This generalizes `(f - g).support` to situations without subtraction. -/ +def ne_locus (f g : Π₀ a, N a) : finset α := +(f.support ∪ g.support).filter (λ x, f x ≠ g x) + +@[simp] lemma mem_ne_locus {f g : Π₀ a, N a} {a : α} : a ∈ f.ne_locus g ↔ f a ≠ g a := +by simpa only [ne_locus, finset.mem_filter, finset.mem_union, mem_support_iff, + and_iff_right_iff_imp] using ne.ne_or_ne _ + +lemma not_mem_ne_locus {f g : Π₀ a, N a} {a : α} : a ∉ f.ne_locus g ↔ f a = g a := +mem_ne_locus.not.trans not_ne_iff + +@[simp] lemma coe_ne_locus : ↑(f.ne_locus g) = {x | f x ≠ g x} := +set.ext $ λ x, mem_ne_locus + +@[simp] lemma ne_locus_eq_empty {f g : Π₀ a, N a} : f.ne_locus g = ∅ ↔ f = g := +⟨λ h, ext (λ a, not_not.mp (mem_ne_locus.not.mp (finset.eq_empty_iff_forall_not_mem.mp h a))), + λ h, h ▸ by simp only [ne_locus, ne.def, eq_self_iff_true, not_true, finset.filter_false]⟩ + +@[simp] lemma nonempty_ne_locus_iff {f g : Π₀ a, N a} : (f.ne_locus g).nonempty ↔ f ≠ g := +finset.nonempty_iff_ne_empty.trans ne_locus_eq_empty.not + +lemma ne_locus_comm : f.ne_locus g = g.ne_locus f := +by simp_rw [ne_locus, finset.union_comm, ne_comm] + +@[simp] +lemma ne_locus_zero_right : f.ne_locus 0 = f.support := +by { ext, rw [mem_ne_locus, mem_support_iff, coe_zero, pi.zero_apply] } + +@[simp] +lemma ne_locus_zero_left : (0 : Π₀ a, N a).ne_locus f = f.support := +(ne_locus_comm _ _).trans (ne_locus_zero_right _) + +end N_has_zero + +section ne_locus_and_maps + +variables {M P : α → Type*} [Π a, has_zero (N a)] [Π a, has_zero (M a)] [Π a, has_zero (P a)] + +lemma subset_map_range_ne_locus [Π a, decidable_eq (N a)] [Π a, decidable_eq (M a)] + (f g : Π₀ a, N a) {F : Π a, N a → M a} (F0 : ∀ a, F a 0 = 0) : + (f.map_range F F0).ne_locus (g.map_range F F0) ⊆ f.ne_locus g := +λ a, by simpa only [mem_ne_locus, map_range_apply, not_imp_not] using congr_arg (F a) + +lemma zip_with_ne_locus_eq_left [Π a, decidable_eq (N a)] [Π a, decidable_eq (P a)] + {F : Π a, M a → N a → P a} (F0 : ∀ a, F a 0 0 = 0) + (f : Π₀ a, M a) (g₁ g₂ : Π₀ a, N a) (hF : ∀ a f, function.injective (λ g, F a f g)) : + (zip_with F F0 f g₁).ne_locus (zip_with F F0 f g₂) = g₁.ne_locus g₂ := +by { ext, simpa only [mem_ne_locus] using (hF a _).ne_iff } + +lemma zip_with_ne_locus_eq_right [Π a, decidable_eq (M a)] [Π a, decidable_eq (P a)] + {F : Π a, M a → N a → P a} (F0 : ∀ a, F a 0 0 = 0) + (f₁ f₂ : Π₀ a, M a) (g : Π₀ a, N a) (hF : ∀ a g, function.injective (λ f, F a f g)) : + (zip_with F F0 f₁ g).ne_locus (zip_with F F0 f₂ g) = f₁.ne_locus f₂ := +by { ext, simpa only [mem_ne_locus] using (hF a _).ne_iff } + +lemma map_range_ne_locus_eq [Π a, decidable_eq (N a)] [Π a, decidable_eq (M a)] (f g : Π₀ a, N a) + {F : Π a, N a → M a} (F0 : ∀ a, F a 0 = 0) (hF : ∀ a, function.injective (F a)) : + (f.map_range F F0).ne_locus (g.map_range F F0) = f.ne_locus g := +by { ext, simpa only [mem_ne_locus] using (hF a).ne_iff } + +end ne_locus_and_maps + +variables [Π a, decidable_eq (N a)] + +@[simp] lemma ne_locus_add_left [Π a, add_left_cancel_monoid (N a)] (f g h : Π₀ a, N a) : + (f + g).ne_locus (f + h) = g.ne_locus h := +zip_with_ne_locus_eq_left _ _ _ _ $ λ a, add_right_injective + +@[simp] lemma ne_locus_add_right [Π a, add_right_cancel_monoid (N a)] (f g h : Π₀ a, N a) : + (f + h).ne_locus (g + h) = f.ne_locus g := +zip_with_ne_locus_eq_right _ _ _ _ $ λ a, add_left_injective + +section add_group +variables [Π a, add_group (N a)] (f f₁ f₂ g g₁ g₂ : Π₀ a, N a) + +@[simp] lemma ne_locus_neg_neg : ne_locus (-f) (-g) = f.ne_locus g := +map_range_ne_locus_eq _ _ (λ a, neg_zero) (λ a, neg_injective) + +lemma ne_locus_neg : ne_locus (-f) g = f.ne_locus (-g) := by rw [←ne_locus_neg_neg, neg_neg] + +lemma ne_locus_eq_support_sub : f.ne_locus g = (f - g).support := +by rw [←@ne_locus_add_right α N _ _ _ _ _ (-g), add_right_neg, ne_locus_zero_right, sub_eq_add_neg] + +@[simp] lemma ne_locus_sub_left : ne_locus (f - g₁) (f - g₂) = ne_locus g₁ g₂ := +by simp only [sub_eq_add_neg, @ne_locus_add_left α N _ _ _, ne_locus_neg_neg] + +@[simp] lemma ne_locus_sub_right : ne_locus (f₁ - g) (f₂ - g) = ne_locus f₁ f₂ := +by simpa only [sub_eq_add_neg] using @ne_locus_add_right α N _ _ _ _ _ _ + +@[simp] lemma ne_locus_self_add_right : ne_locus f (f + g) = g.support := +by rw [←ne_locus_zero_left, ←@ne_locus_add_left α N _ _ _ f 0 g, add_zero] + +@[simp] lemma ne_locus_self_add_left : ne_locus (f + g) f = g.support := +by rw [ne_locus_comm, ne_locus_self_add_right] + +@[simp] lemma ne_locus_self_sub_right : ne_locus f (f - g) = g.support := +by rw [sub_eq_add_neg, ne_locus_self_add_right, support_neg] + +@[simp] lemma ne_locus_self_sub_left : ne_locus (f - g) f = g.support := +by rw [ne_locus_comm, ne_locus_self_sub_right] + +end add_group +end dfinsupp diff --git a/src/data/dfinsupp/order.lean b/src/data/dfinsupp/order.lean index 63b93b84c8129..c5a90bc29224c 100644 --- a/src/data/dfinsupp/order.lean +++ b/src/data/dfinsupp/order.lean @@ -8,6 +8,9 @@ import data.dfinsupp.basic /-! # Pointwise order on finitely supported dependent functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file lifts order structures on the `α i` to `Π₀ i, α i`. ## Main declarations @@ -15,9 +18,6 @@ This file lifts order structures on the `α i` to `Π₀ i, α i`. * `dfinsupp.order_embedding_to_fun`: The order embedding from finitely supported dependent functions to functions. -## TODO - -Add `is_well_order (Π₀ i, α i) (<)`. -/ open_locale big_operators @@ -31,21 +31,19 @@ namespace dfinsupp /-! ### Order structures -/ section has_zero -variables (α) [Π i, has_zero (α i)] +variables [Π i, has_zero (α i)] section has_le variables [Π i, has_le (α i)] instance : has_le (Π₀ i, α i) := ⟨λ f g, ∀ i, f i ≤ g i⟩ -variables {α} - lemma le_def {f g : Π₀ i, α i} : f ≤ g ↔ ∀ i, f i ≤ g i := iff.rfl /-- The order on `dfinsupp`s over a partial order embeds into the order on functions -/ def order_embedding_to_fun : (Π₀ i, α i) ↪o Π i, α i := -{ to_fun := λ f, f, - inj' := λ f g h, dfinsupp.ext $ λ i, by { dsimp at h, rw h }, +{ to_fun := coe_fn, + inj' := coe_fn_injective, map_rel_iff' := λ a b, (@le_def _ _ _ _ a b).symm } @[simp] lemma order_embedding_to_fun_apply {f : Π₀ i, α i} {i : ι} : @@ -59,7 +57,7 @@ variables [Π i, preorder (α i)] instance : preorder (Π₀ i, α i) := { le_refl := λ f i, le_rfl, le_trans := λ f g h hfg hgh i, (hfg i).trans (hgh i), - .. dfinsupp.has_le α } + .. dfinsupp.has_le } lemma coe_fn_mono : monotone (coe_fn : (Π₀ i, α i) → Π i, α i) := λ f g, le_def.1 @@ -67,14 +65,14 @@ end preorder instance [Π i, partial_order (α i)] : partial_order (Π₀ i, α i) := { le_antisymm := λ f g hfg hgf, ext $ λ i, (hfg i).antisymm (hgf i), - .. dfinsupp.preorder α} + .. dfinsupp.preorder } instance [Π i, semilattice_inf (α i)] : semilattice_inf (Π₀ i, α i) := { inf := zip_with (λ _, (⊓)) (λ _, inf_idem), inf_le_left := λ f g i, by { rw zip_with_apply, exact inf_le_left }, inf_le_right := λ f g i, by { rw zip_with_apply, exact inf_le_right }, le_inf := λ f g h hf hg i, by { rw zip_with_apply, exact le_inf (hf i) (hg i) }, - ..dfinsupp.partial_order α } + ..dfinsupp.partial_order } @[simp] lemma inf_apply [Π i, semilattice_inf (α i)] (f g : Π₀ i, α i) (i : ι) : (f ⊓ g) i = f i ⊓ g i := @@ -85,15 +83,26 @@ instance [Π i, semilattice_sup (α i)] : semilattice_sup (Π₀ i, α i) := le_sup_left := λ f g i, by { rw zip_with_apply, exact le_sup_left }, le_sup_right := λ f g i, by { rw zip_with_apply, exact le_sup_right }, sup_le := λ f g h hf hg i, by { rw zip_with_apply, exact sup_le (hf i) (hg i) }, - ..dfinsupp.partial_order α } + ..dfinsupp.partial_order } @[simp] lemma sup_apply [Π i, semilattice_sup (α i)] (f g : Π₀ i, α i) (i : ι) : (f ⊔ g) i = f i ⊔ g i := zip_with_apply _ _ _ _ _ -instance lattice [Π i, lattice (α i)] : lattice (Π₀ i, α i) := -{ .. dfinsupp.semilattice_inf α, .. dfinsupp.semilattice_sup α } +section lattice +variables [Π i, lattice (α i)] (f g : Π₀ i, α i) + +instance lattice : lattice (Π₀ i, α i) := { ..dfinsupp.semilattice_inf, ..dfinsupp.semilattice_sup } +variables [decidable_eq ι] [Π i (x : α i), decidable (x ≠ 0)] + +lemma support_inf_union_support_sup : (f ⊓ g).support ∪ (f ⊔ g).support = f.support ∪ g.support := +coe_injective $ compl_injective $ by { ext, simp [inf_eq_and_sup_eq_iff] } + +lemma support_sup_union_support_inf : (f ⊔ g).support ∪ (f ⊓ g).support = f.support ∪ g.support := +(union_comm _ _).trans $ support_inf_union_support_sup _ _ + +end lattice end has_zero /-! ### Algebraic order structures -/ @@ -102,7 +111,7 @@ instance (α : ι → Type*) [Π i, ordered_add_comm_monoid (α i)] : ordered_add_comm_monoid (Π₀ i, α i) := { add_le_add_left := λ a b h c i, by { rw [add_apply, add_apply], exact add_le_add_left (h i) (c i) }, - .. dfinsupp.add_comm_monoid, .. dfinsupp.partial_order α } + .. dfinsupp.add_comm_monoid, .. dfinsupp.partial_order } instance (α : ι → Type*) [Π i, ordered_cancel_add_comm_monoid (α i)] : ordered_cancel_add_comm_monoid (Π₀ i, α i) := @@ -111,11 +120,6 @@ instance (α : ι → Type*) [Π i, ordered_cancel_add_comm_monoid (α i)] : rw [add_apply, add_apply] at H, exact le_of_add_le_add_left H, end, - add_left_cancel := λ f g h H, ext $ λ i, begin - refine add_left_cancel _, - exact f i, - rw [←add_apply, ←add_apply, H], - end, .. dfinsupp.ordered_add_comm_monoid α } instance [Π i, ordered_add_comm_monoid (α i)] [Π i, contravariant_class (α i) (α i) (+) (≤)] : @@ -177,15 +181,9 @@ instance : has_ordered_sub (Π₀ i, α i) := ⟨λ n m k, forall_congr $ λ i, by { rw [add_apply, tsub_apply], exact tsub_le_iff_right }⟩ instance : canonically_ordered_add_monoid (Π₀ i, α i) := -{ le_iff_exists_add := λ f g, begin - refine ⟨λ h, ⟨g - f, _⟩, _⟩, - { ext i, - rw [add_apply, tsub_apply], - exact (add_tsub_cancel_of_le $ h i).symm }, - { rintro ⟨g, rfl⟩ i, - rw add_apply, - exact self_le_add_right (f i) (g i) } - end, +{ exists_add_of_le := λ f g h, ⟨g - f, + by { ext i, rw [add_apply, tsub_apply], exact (add_tsub_cancel_of_le $ h i).symm }⟩, + le_self_add := λ f g i, by { rw add_apply, exact le_self_add }, .. dfinsupp.order_bot α, .. dfinsupp.ordered_add_comm_monoid α } diff --git a/src/data/dfinsupp/well_founded.lean b/src/data/dfinsupp/well_founded.lean new file mode 100644 index 0000000000000..a51551fba65f5 --- /dev/null +++ b/src/data/dfinsupp/well_founded.lean @@ -0,0 +1,230 @@ +/- +Copyright (c) 2022 Junyan Xu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Junyan Xu +-/ +import data.dfinsupp.lex +import order.game_add +import order.antisymmetrization +import set_theory.ordinal.basic + +/-! +# Well-foundedness of the lexicographic and product orders on `dfinsupp` and `pi` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The primary results are `dfinsupp.lex.well_founded` and the two variants that follow it, +which essentially say that if `(>)` is a well order on `ι`, `(<)` is well-founded on each +`α i`, and `0` is a bottom element in `α i`, then the lexicographic `(<)` is well-founded +on `Π₀ i, α i`. The proof is modelled on the proof of `well_founded.cut_expand`. + +The results are used to prove `pi.lex.well_founded` and two variants, which say that if +`ι` is finite and equipped with a linear order and `(<)` is well-founded on each `α i`, +then the lexicographic `(<)` is well-founded on `Π i, α i`, and the same is true for +`Π₀ i, α i` (`dfinsupp.lex.well_founded_of_finite`), because `dfinsupp` is order-isomorphic +to `pi` when `ι` is finite. + +Finally, we deduce `dfinsupp.well_founded_lt`, `pi.well_founded_lt`, +`dfinsupp.well_founded_lt_of_finite` and variants, which concern the product order +rather than the lexicographic one. An order on `ι` is not required in these results, +but we deduce them from the well-foundedness of the lexicographic order by choosing +a well order on `ι` so that the product order `(<)` becomes a subrelation +of the lexicographic `(<)`. + +All results are provided in two forms whenever possible: a general form where the relations +can be arbitrary (not the `(<)` of a preorder, or not even transitive, etc.) and a specialized +form provided as `well_founded_lt` instances where the `(d)finsupp/pi` type (or their `lex` +type synonyms) carries a natural `(<)`. + +Notice that the definition of `dfinsupp.lex` says that `x < y` according to `dfinsupp.lex r s` +iff there exists a coordinate `i : ι` such that `x i < y i` according to `s i`, and at all +`r`-smaller coordinates `j` (i.e. satisfying `r j i`), `x` remains unchanged relative to `y`; +in other words, coordinates `j` such that `¬ r j i` and `j ≠ i` are exactly where changes +can happen arbitrarily. This explains the appearance of `rᶜ ⊓ (≠)` in +`dfinsupp.acc_single` and `dfinsupp.well_founded`. When `r` is trichotomous (e.g. the `(<)` +of a linear order), `¬ r j i ∧ j ≠ i` implies `r i j`, so it suffices to require `r.swap` +to be well-founded. +-/ + +variables {ι : Type*} {α : ι → Type*} + +namespace dfinsupp + +variables [hz : Π i, has_zero (α i)] (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) +include hz + +open relation prod + +/-- This key lemma says that if a finitely supported dependent function `x₀` is obtained by merging + two such functions `x₁` and `x₂`, and if we evolve `x₀` down the `dfinsupp.lex` relation one + step and get `x`, we can always evolve one of `x₁` and `x₂` down the `dfinsupp.lex` relation + one step while keeping the other unchanged, and merge them back (possibly in a different way) + to get back `x`. In other words, the two parts evolve essentially independently under + `dfinsupp.lex`. This is used to show that a function `x` is accessible if + `dfinsupp.single i (x i)` is accessible for each `i` in the (finite) support of `x` + (`dfinsupp.lex.acc_of_single`). -/ +lemma lex_fibration [Π i (s : set ι), decidable (i ∈ s)] : fibration + (inv_image (game_add (dfinsupp.lex r s) (dfinsupp.lex r s)) snd) + (dfinsupp.lex r s) + (λ x, piecewise x.2.1 x.2.2 x.1) := +begin + rintro ⟨p, x₁, x₂⟩ x ⟨i, hr, hs⟩, + simp_rw [piecewise_apply] at hs hr, + split_ifs at hs, classical, + work_on_goal 1 + { refine ⟨⟨{j | r j i → j ∈ p}, piecewise x₁ x {j | r j i}, x₂⟩, game_add.fst ⟨i, _⟩, _⟩ }, + work_on_goal 3 + { refine ⟨⟨{j | r j i ∧ j ∈ p}, x₁, piecewise x₂ x {j | r j i}⟩, game_add.snd ⟨i, _⟩, _⟩ }, + swap 3, iterate 2 + { simp_rw piecewise_apply, + refine ⟨λ j h, if_pos h, _⟩, + convert hs, + refine ite_eq_right_iff.2 (λ h', (hr i h').symm ▸ _), + rw if_neg h <|> rw if_pos h }, + all_goals { ext j, simp_rw piecewise_apply, split_ifs with h₁ h₂ }, + { rw [hr j h₂, if_pos (h₁ h₂)] }, + { refl }, + { rw [set.mem_set_of, not_imp] at h₁, rw [hr j h₁.1, if_neg h₁.2] }, + { rw [hr j h₁.1, if_pos h₁.2] }, + { rw [hr j h₂, if_neg (λ h', h₁ ⟨h₂, h'⟩)] }, + { refl }, +end + +variables {r s} + +lemma lex.acc_of_single_erase [decidable_eq ι] {x : Π₀ i, α i} (i : ι) + (hs : acc (dfinsupp.lex r s) $ single i (x i)) + (hu : acc (dfinsupp.lex r s) $ x.erase i) : acc (dfinsupp.lex r s) x := +begin + classical, + convert ← @acc.of_fibration _ _ _ _ _ + (lex_fibration r s) ⟨{i}, _⟩ (inv_image.accessible snd $ hs.prod_game_add hu), + convert piecewise_single_erase x i, +end + +variable (hbot : ∀ ⦃i a⦄, ¬ s i a 0) +include hbot + +lemma lex.acc_zero : acc (dfinsupp.lex r s) 0 := acc.intro 0 $ λ x ⟨_, _, h⟩, (hbot h).elim + +lemma lex.acc_of_single [decidable_eq ι] [Π i (x : α i), decidable (x ≠ 0)] (x : Π₀ i, α i) : + (∀ i ∈ x.support, acc (dfinsupp.lex r s) $ single i (x i)) → acc (dfinsupp.lex r s) x := +begin + generalize ht : x.support = t, revert x, classical, + induction t using finset.induction with b t hb ih, + { intros x ht, rw support_eq_empty.1 ht, exact λ _, lex.acc_zero hbot }, + refine λ x ht h, lex.acc_of_single_erase b (h b $ t.mem_insert_self b) _, + refine ih _ (by rw [support_erase, ht, finset.erase_insert hb]) (λ a ha, _), + rw [erase_ne (ha.ne_of_not_mem hb)], + exact h a (finset.mem_insert_of_mem ha), +end + +variable (hs : ∀ i, well_founded (s i)) +include hs + +lemma lex.acc_single [decidable_eq ι] {i : ι} (hi : acc (rᶜ ⊓ (≠)) i) : + ∀ a, acc (dfinsupp.lex r s) (single i a) := +begin + induction hi with i hi ih, + refine λ a, (hs i).induction a (λ a ha, _), + refine acc.intro _ (λ x, _), + rintro ⟨k, hr, hs⟩, classical, + rw single_apply at hs, + split_ifs at hs with hik, + swap, { exact (hbot hs).elim }, subst hik, + refine lex.acc_of_single hbot x (λ j hj, _), + obtain rfl | hij := eq_or_ne i j, { exact ha _ hs }, + by_cases r j i, + { rw [hr j h, single_eq_of_ne hij, single_zero], exact lex.acc_zero hbot }, + { exact ih _ ⟨h, hij.symm⟩ _ }, +end + +lemma lex.acc [decidable_eq ι] [Π i (x : α i), decidable (x ≠ 0)] (x : Π₀ i, α i) + (h : ∀ i ∈ x.support, acc (rᶜ ⊓ (≠)) i) : acc (dfinsupp.lex r s) x := +lex.acc_of_single hbot x $ λ i hi, lex.acc_single hbot hs (h i hi) _ + +theorem lex.well_founded (hr : well_founded $ rᶜ ⊓ (≠)) : well_founded (dfinsupp.lex r s) := +⟨λ x, by classical; exact lex.acc hbot hs x (λ i _, hr.apply i)⟩ + +theorem lex.well_founded' [is_trichotomous ι r] + (hr : well_founded r.swap) : well_founded (dfinsupp.lex r s) := +lex.well_founded hbot hs $ subrelation.wf + (λ i j h, ((@is_trichotomous.trichotomous ι r _ i j).resolve_left h.1).resolve_left h.2) hr + +omit hz hbot hs + +instance lex.well_founded_lt [has_lt ι] [is_trichotomous ι (<)] + [hι : well_founded_gt ι] [Π i, canonically_ordered_add_monoid (α i)] + [hα : ∀ i, well_founded_lt (α i)] : well_founded_lt (lex (Π₀ i, α i)) := +⟨lex.well_founded' (λ i a, (zero_le a).not_lt) (λ i, (hα i).wf) hι.wf⟩ + +end dfinsupp + +open dfinsupp + +variables (r : ι → ι → Prop) {s : Π i, α i → α i → Prop} + +theorem pi.lex.well_founded [is_strict_total_order ι r] [finite ι] + (hs : ∀ i, well_founded (s i)) : well_founded (pi.lex r s) := +begin + obtain h | ⟨⟨x⟩⟩ := is_empty_or_nonempty (Π i, α i), + { convert empty_wf, ext1 x, exact (h.1 x).elim }, + letI : Π i, has_zero (α i) := λ i, ⟨(hs i).min ⊤ ⟨x i, trivial⟩⟩, + haveI := is_trans.swap r, haveI := is_irrefl.swap r, haveI := fintype.of_finite ι, + refine inv_image.wf equiv_fun_on_fintype.symm (lex.well_founded' (λ i a, _) hs _), + exacts [(hs i).not_lt_min ⊤ _ trivial, finite.well_founded_of_trans_of_irrefl r.swap], +end + +instance pi.lex.well_founded_lt [linear_order ι] [finite ι] [Π i, has_lt (α i)] + [hwf : ∀ i, well_founded_lt (α i)] : well_founded_lt (lex (Π i, α i)) := +⟨pi.lex.well_founded (<) (λ i, (hwf i).1)⟩ + +instance function.lex.well_founded_lt {α} [linear_order ι] [finite ι] [has_lt α] + [well_founded_lt α] : well_founded_lt (lex (ι → α)) := pi.lex.well_founded_lt + +theorem dfinsupp.lex.well_founded_of_finite [is_strict_total_order ι r] [finite ι] + [Π i, has_zero (α i)] (hs : ∀ i, well_founded (s i)) : well_founded (dfinsupp.lex r s) := +have _ := fintype.of_finite ι, + by exactI inv_image.wf equiv_fun_on_fintype (pi.lex.well_founded r hs) + +instance dfinsupp.lex.well_founded_lt_of_finite [linear_order ι] [finite ι] [Π i, has_zero (α i)] + [Π i, has_lt (α i)] [hwf : ∀ i, well_founded_lt (α i)] : well_founded_lt (lex (Π₀ i, α i)) := +⟨dfinsupp.lex.well_founded_of_finite (<) $ λ i, (hwf i).1⟩ + +protected theorem dfinsupp.well_founded_lt [Π i, has_zero (α i)] [Π i, preorder (α i)] + [∀ i, well_founded_lt (α i)] (hbot : ∀ ⦃i⦄ ⦃a : α i⦄, ¬ a < 0) : well_founded_lt (Π₀ i, α i) := +⟨begin + letI : Π i, has_zero (antisymmetrization (α i) (≤)) := λ i, ⟨to_antisymmetrization (≤) 0⟩, + let f := map_range (λ i, @to_antisymmetrization (α i) (≤) _) (λ i, rfl), + refine subrelation.wf (λ x y h, _) (inv_image.wf f $ lex.well_founded' _ (λ i, _) _), + { exact well_ordering_rel.swap }, { exact λ i, (<) }, + { haveI := is_strict_order.swap (@well_ordering_rel ι), + obtain ⟨i, he, hl⟩ := lex_lt_of_lt_of_preorder well_ordering_rel.swap h, + exact ⟨i, λ j hj, quot.sound (he j hj), hl⟩ }, + { rintro i ⟨a⟩, apply hbot }, + exacts [is_well_founded.wf, is_trichotomous.swap _, is_well_founded.wf], +end⟩ + +instance dfinsupp.well_founded_lt' [Π i, canonically_ordered_add_monoid (α i)] + [∀ i, well_founded_lt (α i)] : well_founded_lt (Π₀ i, α i) := +dfinsupp.well_founded_lt $ λ i a, (zero_le a).not_lt + +instance pi.well_founded_lt [finite ι] [Π i, preorder (α i)] + [hw : ∀ i, well_founded_lt (α i)] : well_founded_lt (Π i, α i) := +⟨begin + obtain h | ⟨⟨x⟩⟩ := is_empty_or_nonempty (Π i, α i), + { convert empty_wf, ext1 x, exact (h.1 x).elim }, + letI : Π i, has_zero (α i) := λ i, ⟨(hw i).wf.min ⊤ ⟨x i, trivial⟩⟩, + haveI := fintype.of_finite ι, + refine inv_image.wf equiv_fun_on_fintype.symm (dfinsupp.well_founded_lt $ λ i a, _).wf, + exact (hw i).wf.not_lt_min ⊤ _ trivial, +end⟩ + +instance function.well_founded_lt {α} [finite ι] [preorder α] + [well_founded_lt α] : well_founded_lt (ι → α) := pi.well_founded_lt + +instance dfinsupp.well_founded_lt_of_finite [finite ι] [Π i, has_zero (α i)] [Π i, preorder (α i)] + [∀ i, well_founded_lt (α i)] : well_founded_lt (Π₀ i, α i) := +have _ := fintype.of_finite ι, + by exactI ⟨inv_image.wf equiv_fun_on_fintype pi.well_founded_lt.wf⟩ diff --git a/src/data/dlist/basic.lean b/src/data/dlist/basic.lean index d241690d7c437..d73414a31a5ae 100644 --- a/src/data/dlist/basic.lean +++ b/src/data/dlist/basic.lean @@ -8,6 +8,9 @@ import data.dlist /-! # Difference list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides a few results about `dlist`, which is defined in core Lean. A difference list is a function that, given a list, returns the original content of the diff --git a/src/data/dlist/instances.lean b/src/data/dlist/instances.lean index cc0c8faa21507..62d1d97465dfa 100644 --- a/src/data/dlist/instances.lean +++ b/src/data/dlist/instances.lean @@ -5,11 +5,13 @@ Authors: Simon Hudon -/ import control.traversable.equiv import control.traversable.instances -import data.dlist /-! # Traversable instance for dlists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides the equivalence between `list α` and `dlist α` and the traversable instance for `dlist`. -/ diff --git a/src/data/enat/basic.lean b/src/data/enat/basic.lean new file mode 100644 index 0000000000000..105dac551f4f0 --- /dev/null +++ b/src/data/enat/basic.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import data.nat.succ_pred +import algebra.char_zero.lemmas +import algebra.order.sub.with_top +import algebra.order.ring.with_top + +/-! +# Definition and basic properties of extended natural numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we define `enat` (notation: `ℕ∞`) to be `with_top ℕ` and prove some basic lemmas +about this type. +-/ + +/-- Extended natural numbers `ℕ∞ = with_top ℕ`. -/ +@[derive [has_zero, add_comm_monoid_with_one, canonically_ordered_comm_semiring, nontrivial, + linear_order, order_bot, order_top, has_bot, has_top, canonically_linear_ordered_add_monoid, + has_sub, has_ordered_sub, linear_ordered_add_comm_monoid_with_top, succ_order, well_founded_lt, + has_well_founded, char_zero, has_coe_t ℕ]] +def enat : Type := with_top ℕ + +notation `ℕ∞` := enat + +namespace enat + +instance : inhabited ℕ∞ := ⟨0⟩ +instance : is_well_order ℕ∞ (<) := { } + +variables {m n : ℕ∞} + +-- eligible for `dsimp` +@[simp, nolint simp_nf, norm_cast] lemma coe_zero : ((0 : ℕ) : ℕ∞) = 0 := rfl +@[simp, norm_cast] lemma coe_one : ((1 : ℕ) : ℕ∞) = 1 := rfl +@[simp, norm_cast] lemma coe_add (m n : ℕ) : ↑(m + n) = (m + n : ℕ∞) := rfl +@[simp, norm_cast] lemma coe_sub (m n : ℕ) : ↑(m - n) = (m - n : ℕ∞) := rfl +@[simp, norm_cast] lemma coe_mul (m n : ℕ) : ↑(m * n) = (m * n : ℕ∞) := with_top.coe_mul + +instance can_lift : can_lift ℕ∞ ℕ coe (λ n, n ≠ ⊤) := with_top.can_lift + +/-- Conversion of `ℕ∞` to `ℕ` sending `∞` to `0`. -/ +def to_nat : monoid_with_zero_hom ℕ∞ ℕ := +{ to_fun := with_top.untop' 0, + map_one' := rfl, + map_zero' := rfl, + map_mul' := with_top.untop'_zero_mul } + +@[simp] lemma to_nat_coe (n : ℕ) : to_nat n = n := rfl +@[simp] lemma to_nat_top : to_nat ⊤ = 0 := rfl + +@[simp] lemma coe_to_nat_eq_self : ↑n.to_nat = n ↔ n ≠ ⊤ := +with_top.rec_top_coe (by simp) (by simp) n + +alias coe_to_nat_eq_self ↔ _ coe_to_nat + +lemma coe_to_nat_le_self (n : ℕ∞) : ↑(to_nat n) ≤ n := with_top.rec_top_coe le_top (λ k, le_rfl) n + +lemma to_nat_add {m n : ℕ∞} (hm : m ≠ ⊤) (hn : n ≠ ⊤) : to_nat (m + n) = to_nat m + to_nat n := +by { lift m to ℕ using hm, lift n to ℕ using hn, refl } + +lemma to_nat_sub {n : ℕ∞} (hn : n ≠ ⊤) (m : ℕ∞) : to_nat (m - n) = to_nat m - to_nat n := +begin + lift n to ℕ using hn, + induction m using with_top.rec_top_coe, + { rw [with_top.top_sub_coe, to_nat_top, zero_tsub] }, + { rw [← coe_sub, to_nat_coe, to_nat_coe, to_nat_coe] } +end + +lemma to_nat_eq_iff {m : ℕ∞} {n : ℕ} (hn : n ≠ 0) : m.to_nat = n ↔ m = n := +by induction m using with_top.rec_top_coe; simp [hn.symm] + +@[simp] lemma succ_def (m : ℕ∞) : order.succ m = m + 1 := by cases m; refl + +lemma add_one_le_of_lt (h : m < n) : m + 1 ≤ n := +m.succ_def ▸ order.succ_le_of_lt h + +lemma add_one_le_iff (hm : m ≠ ⊤) : m + 1 ≤ n ↔ m < n := +m.succ_def ▸ (order.succ_le_iff_of_not_is_max $ by rwa [is_max_iff_eq_top]) + +lemma one_le_iff_pos : 1 ≤ n ↔ 0 < n := add_one_le_iff with_top.zero_ne_top + +lemma one_le_iff_ne_zero : 1 ≤ n ↔ n ≠ 0 := one_le_iff_pos.trans pos_iff_ne_zero + +lemma le_of_lt_add_one (h : m < n + 1) : m ≤ n := order.le_of_lt_succ $ n.succ_def.symm ▸ h + +@[elab_as_eliminator] +lemma nat_induction {P : ℕ∞ → Prop} (a : ℕ∞) (h0 : P 0) (hsuc : ∀ n : ℕ, P n → P n.succ) + (htop : (∀ n : ℕ, P n) → P ⊤) : P a := +begin + have A : ∀ n : ℕ, P n := λ n, nat.rec_on n h0 hsuc, + cases a, + exacts [htop A, A a] +end + +end enat diff --git a/src/data/enat/lattice.lean b/src/data/enat/lattice.lean new file mode 100644 index 0000000000000..887e933c7a73c --- /dev/null +++ b/src/data/enat/lattice.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2022 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ +import data.nat.lattice +import data.enat.basic + +/-! +# Extended natural numbers form a complete linear order + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This instance is not in `data.enat.basic` to avoid dependency on `finset`s. +-/ + +attribute [derive complete_linear_order] enat diff --git a/src/data/erased.lean b/src/data/erased.lean index 7ccca5b054b77..6831006f15927 100644 --- a/src/data/erased.lean +++ b/src/data/erased.lean @@ -3,11 +3,14 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import logic.equiv.basic +import logic.equiv.defs /-! # A type for VM-erased data +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a type `erased α` which is classically isomorphic to `α`, but erased in the VM. That is, at runtime every value of `erased α` is represented as `0`, just like types and proofs. diff --git a/src/data/fin/basic.lean b/src/data/fin/basic.lean index a5f7a3788fc1f..1579e1a3837ba 100644 --- a/src/data/fin/basic.lean +++ b/src/data/fin/basic.lean @@ -3,14 +3,18 @@ Copyright (c) 2017 Robert Y. Lewis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Robert Y. Lewis, Keeley Hoek -/ -import tactic.apply_fun -import data.nat.cast -import order.rel_iso -import tactic.localized +import algebra.ne_zero +import algebra.order.with_zero +import order.rel_iso.basic +import data.nat.order.basic +import order.hom.set /-! # The finite type with `n` elements +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `fin n` is the type whose elements are natural numbers smaller than `n`. This file expands on the development in the core library. @@ -41,7 +45,9 @@ This file expands on the development in the core library. ### Order embeddings and an order isomorphism -* `fin.coe_embedding` : coercion to natural numbers as an `order_embedding`; +* `fin.order_iso_subtype` : coercion to `{ i // i < n }` as an `order_iso`; +* `fin.coe_embedding` : coercion to natural numbers as an `embedding`; +* `fin.coe_order_embedding` : coercion to natural numbers as an `order_embedding`; * `fin.succ_embedding` : `fin.succ` as an `order_embedding`; * `fin.cast_le h` : embed `fin n` into `fin m`, `h : n ≤ m`; * `fin.cast eq` : order isomorphism between `fin n` and fin m` provided that `n = m`, @@ -54,7 +60,7 @@ This file expands on the development in the core library. ### Other casts -* `fin.of_nat'`: given a positive number `n` (deduced from `[fact (0 < n)]`), `fin.of_nat' i` is +* `fin.of_nat'`: given a positive number `n` (deduced from `[ne_zero n]`), `fin.of_nat' i` is `i % n` interpreted as an element of `fin n`; * `fin.cast_lt i h` : embed `i` into a `fin` where `h` proves it belongs into; * `fin.pred_above (p : fin n) i` : embed `i : fin (n+1)` into `fin n` by subtracting one if `p < i`; @@ -68,6 +74,7 @@ This file expands on the development in the core library. ### Misc definitions * `fin.last n` : The greatest value of `fin (n+1)`. +* `fin.rev : fin n → fin n` : the antitone involution given by `i ↦ n-(i+1)` -/ @@ -77,33 +84,30 @@ open fin nat function /-- Elimination principle for the empty set `fin 0`, dependent version. -/ def fin_zero_elim {α : fin 0 → Sort u} (x : fin 0) : α x := x.elim0 -lemma fact.succ.pos {n} : fact (0 < succ n) := ⟨zero_lt_succ _⟩ +namespace fin -lemma fact.bit0.pos {n} [h : fact (0 < n)] : fact (0 < bit0 n) := -⟨nat.zero_lt_bit0 $ ne_of_gt h.1⟩ +/-- A non-dependent variant of `elim0`. -/ +def elim0' {α : Sort*} (x : fin 0) : α := x.elim0 -lemma fact.bit1.pos {n} : fact (0 < bit1 n) := -⟨nat.zero_lt_bit1 _⟩ +variables {n m : ℕ} {a b : fin n} -lemma fact.pow.pos {p n : ℕ} [h : fact $ 0 < p] : fact (0 < p ^ n) := -⟨pow_pos h.1 _⟩ +instance fin_to_nat (n : ℕ) : has_coe (fin n) nat := ⟨fin.val⟩ -localized "attribute [instance] fact.succ.pos" in fin_fact -localized "attribute [instance] fact.bit0.pos" in fin_fact -localized "attribute [instance] fact.bit1.pos" in fin_fact -localized "attribute [instance] fact.pow.pos" in fin_fact +lemma val_injective : function.injective (@fin.val n) := @fin.eq_of_veq n -namespace fin +protected lemma prop (a : fin n) : a.val < n := a.2 -/-- A non-dependent variant of `elim0`. -/ -def elim0' {α : Sort*} (x : fin 0) : α := x.elim0 +@[simp] lemma is_lt (a : fin n) : (a : ℕ) < n := a.2 -variables {n m : ℕ} {a b : fin n} +protected lemma pos (i : fin n) : 0 < n := lt_of_le_of_lt (nat.zero_le _) i.is_lt -instance fin_to_nat (n : ℕ) : has_coe (fin n) nat := ⟨subtype.val⟩ +lemma pos_iff_nonempty {n : ℕ} : 0 < n ↔ nonempty (fin n) := ⟨λ h, ⟨⟨0, h⟩⟩, λ ⟨i⟩, i.pos⟩ -lemma pos_iff_nonempty {n : ℕ} : 0 < n ↔ nonempty (fin n) := -⟨λ h, ⟨⟨0, h⟩⟩, λ ⟨i⟩, lt_of_le_of_lt (nat.zero_le _) i.2⟩ +/-- Equivalence between `fin n` and `{ i // i < n }`. -/ +@[simps apply symm_apply] +def equiv_subtype : fin n ≃ { i // i < n } := +{ to_fun := λ a, ⟨a.1, a.2⟩, inv_fun := λ a, ⟨a.1, a.2⟩, + left_inv := λ ⟨_, _⟩, rfl, right_inv := λ ⟨_, _⟩, rfl } section coe @@ -117,10 +121,13 @@ by cases a; refl @[ext] lemma ext {a b : fin n} (h : (a : ℕ) = b) : a = b := eq_of_veq h -lemma ext_iff (a b : fin n) : a = b ↔ (a : ℕ) = b := +lemma ext_iff {a b : fin n} : a = b ↔ (a : ℕ) = b := iff.intro (congr_arg _) fin.eq_of_veq -lemma coe_injective {n : ℕ} : injective (coe : fin n → ℕ) := subtype.coe_injective +lemma coe_injective {n : ℕ} : injective (coe : fin n → ℕ) := fin.val_injective + +lemma coe_eq_coe (a b : fin n) : (a : ℕ) = b ↔ a = b := +ext_iff.symm lemma eq_iff_veq (a b : fin n) : a = b ↔ a.1 = b.1 := ⟨veq_of_eq, eq_of_veq⟩ @@ -128,11 +135,13 @@ lemma eq_iff_veq (a b : fin n) : a = b ↔ a.1 = b.1 := lemma ne_iff_vne (a b : fin n) : a ≠ b ↔ a.1 ≠ b.1 := ⟨vne_of_ne, ne_of_vne⟩ -@[simp] lemma mk_eq_subtype_mk (a : ℕ) (h : a < n) : mk a h = ⟨a, h⟩ := rfl +@[simp, nolint simp_nf] -- built-in reduction doesn't always work +theorem mk_eq_mk {a h a' h'} : @mk n a h = @mk n a' h' ↔ a = a' := +ext_iff protected lemma mk.inj_iff {n a b : ℕ} {ha : a < n} {hb : b < n} : (⟨a, ha⟩ : fin n) = ⟨b, hb⟩ ↔ a = b := -subtype.mk_eq_mk +eq_iff_veq _ _ lemma mk_val {m n : ℕ} (h : m < n) : (⟨m, h⟩ : fin n).val = m := rfl @@ -152,11 +161,11 @@ lemma coe_eq_val (a : fin n) : (a : ℕ) = a.val := rfl then they coincide (in the heq sense). -/ protected lemma heq_fun_iff {α : Sort*} {k l : ℕ} (h : k = l) {f : fin k → α} {g : fin l → α} : f == g ↔ (∀ (i : fin k), f i = g ⟨(i : ℕ), h ▸ i.2⟩) := -by { induction h, simp [heq_iff_eq, function.funext_iff] } +by { subst h, simp [function.funext_iff] } protected lemma heq_ext_iff {k l : ℕ} (h : k = l) {i : fin k} {j : fin l} : i == j ↔ (i : ℕ) = (j : ℕ) := -by { induction h, simp [ext_iff] } +by { subst h, simp [coe_eq_coe] } lemma exists_iff {p : fin n → Prop} : (∃ i, p i) ↔ ∃ i h, p ⟨i, h⟩ := ⟨λ h, exists.elim h (λ ⟨i, hi⟩ hpi, ⟨i, hi, hpi⟩), @@ -173,10 +182,10 @@ section order ### order -/ -lemma is_lt (i : fin n) : (i : ℕ) < n := i.2 - lemma is_le (i : fin (n + 1)) : (i : ℕ) ≤ n := le_of_lt_succ i.is_lt +@[simp] lemma is_le' : (a : ℕ) ≤ n := le_of_lt a.is_lt + lemma lt_iff_coe_lt_coe : a < b ↔ (a : ℕ) < b := iff.rfl lemma le_iff_coe_le_coe : a ≤ b ↔ (a : ℕ) ≤ b := iff.rfl @@ -194,23 +203,43 @@ iff.rfl iff.rfl instance {n : ℕ} : linear_order (fin n) := -{ le := (≤), lt := (<), - decidable_le := fin.decidable_le, - decidable_lt := fin.decidable_lt, - decidable_eq := fin.decidable_eq _, - ..linear_order.lift (coe : fin n → ℕ) (@fin.eq_of_veq _) } +@linear_order.lift (fin n) _ _ ⟨λ x y, ⟨max x y, max_rec' (< n) x.2 y.2⟩⟩ + ⟨λ x y, ⟨min x y, min_rec' (< n) x.2 y.2⟩⟩ fin.val fin.val_injective (λ _ _, rfl) (λ _ _, rfl) + +@[simp] lemma mk_le_mk {x y : nat} {hx} {hy} : (⟨x, hx⟩ : fin n) ≤ ⟨y, hy⟩ ↔ x ≤ y := iff.rfl + +@[simp] lemma mk_lt_mk {x y : nat} {hx} {hy} : (⟨x, hx⟩ : fin n) < ⟨y, hy⟩ ↔ x < y := iff.rfl -instance {n : ℕ} : partial_order (fin n) := linear_order.to_partial_order (fin n) +@[simp] lemma min_coe : min (a : ℕ) n = a := by simp + +@[simp] lemma max_coe : max (a : ℕ) n = n := by simp + +instance {n : ℕ} : partial_order (fin n) := by apply_instance lemma coe_strict_mono : strict_mono (coe : fin n → ℕ) := λ _ _, id -/-- The inclusion map `fin n → ℕ` is a relation embedding. -/ -def coe_embedding (n) : (fin n) ↪o ℕ := -⟨⟨coe, @fin.eq_of_veq _⟩, λ a b, iff.rfl⟩ +/-- The equivalence `fin n ≃ { i // i < n }` is an order isomorphism. -/ +@[simps apply symm_apply] +def order_iso_subtype : fin n ≃o { i // i < n } := +equiv_subtype.to_order_iso (by simp [monotone]) (by simp [monotone]) + +/-- The inclusion map `fin n → ℕ` is an embedding. -/ +@[simps apply] +def coe_embedding : fin n ↪ ℕ := +⟨coe, coe_injective⟩ + +@[simp] lemma equiv_subtype_symm_trans_val_embedding : + equiv_subtype.symm.to_embedding.trans coe_embedding = embedding.subtype (< n) := +rfl + +/-- The inclusion map `fin n → ℕ` is an order embedding. -/ +@[simps apply] +def coe_order_embedding (n) : (fin n) ↪o ℕ := +⟨coe_embedding, λ a b, iff.rfl⟩ /-- The ordering on `fin n` is a well order. -/ instance fin.lt.is_well_order (n) : is_well_order (fin n) (<) := -(coe_embedding n).is_well_order +(coe_order_embedding n).is_well_order /-- Use the ordering on `fin n` for checking recursive definitions. @@ -225,18 +254,28 @@ def factorial {n : ℕ} : fin n → ℕ instance {n : ℕ} : has_well_founded (fin n) := ⟨_, measure_wf coe⟩ -@[simp] lemma coe_zero {n : ℕ} : ((0 : fin (n+1)) : ℕ) = 0 := rfl +instance has_zero_of_ne_zero [ne_zero n] : has_zero (fin n) := +⟨⟨0, ne_zero.pos _⟩⟩ + +/-- Given a positive `n`, `fin.of_nat' i` is `i % n` as an element of `fin n`. -/ +def of_nat' [ne_zero n] (i : ℕ) : fin n := ⟨i%n, mod_lt _ $ ne_zero.pos n⟩ + +instance has_one_of_ne_zero [ne_zero n] : has_one (fin n) := +⟨of_nat' 1⟩ + +@[simp] lemma coe_zero (n : ℕ) [ne_zero n] : ((0 : fin n) : ℕ) = 0 := rfl attribute [simp] val_zero -@[simp] lemma val_zero' (n) : (0 : fin (n+1)).val = 0 := rfl -@[simp] lemma mk_zero : (⟨0, nat.succ_pos'⟩ : fin (n + 1)) = (0 : fin _) := rfl +@[simp] lemma val_zero' (n) [ne_zero n] : (0 : fin n).val = 0 := rfl +@[simp] lemma mk_zero [ne_zero n] : + (⟨0, nat.pos_of_ne_zero (ne_zero.ne n)⟩ : fin n) = (0 : fin _) := rfl -@[simp] lemma zero_le (a : fin (n + 1)) : 0 ≤ a := zero_le a.1 +@[simp] lemma zero_le [ne_zero n] (a : fin n) : 0 ≤ a := zero_le a.1 lemma zero_lt_one : (0 : fin (n + 2)) < 1 := nat.zero_lt_one @[simp] lemma not_lt_zero (a : fin n.succ) : ¬a < 0. -lemma pos_iff_ne_zero (a : fin (n+1)) : 0 < a ↔ a ≠ 0 := +lemma pos_iff_ne_zero [ne_zero n] (a : fin n) : 0 < a ↔ a ≠ 0 := by rw [← coe_fin_lt, coe_zero, pos_iff_ne_zero, ne.def, ne.def, ext_iff, coe_zero] lemma eq_zero_or_eq_succ {n : ℕ} (i : fin (n+1)) : i = 0 ∨ ∃ j : fin n, i = j.succ := @@ -246,6 +285,47 @@ begin { right, exact ⟨⟨j, nat.lt_of_succ_lt_succ h⟩, rfl⟩, } end +lemma eq_succ_of_ne_zero {n : ℕ} {i : fin (n + 1)} (hi : i ≠ 0) : ∃ j : fin n, i = j.succ := +(eq_zero_or_eq_succ i).resolve_left hi + +/-- The antitone involution `fin n → fin n` given by `i ↦ n-(i+1)`. -/ +def rev : equiv.perm (fin n) := +involutive.to_perm (λ i, ⟨n - (i + 1), tsub_lt_self i.pos (nat.succ_pos _)⟩) $ + λ i, ext $ by rw [coe_mk, coe_mk, ← tsub_tsub, + tsub_tsub_cancel_of_le (nat.add_one_le_iff.2 i.is_lt), add_tsub_cancel_right] + +@[simp] lemma coe_rev (i : fin n) : (i.rev : ℕ) = n - (i + 1) := rfl +lemma rev_involutive : involutive (@rev n) := involutive.to_perm_involutive _ +lemma rev_injective : injective (@rev n) := rev_involutive.injective +lemma rev_surjective : surjective (@rev n) := rev_involutive.surjective +lemma rev_bijective : bijective (@rev n) := rev_involutive.bijective +@[simp] lemma rev_inj {i j : fin n} : i.rev = j.rev ↔ i = j := rev_injective.eq_iff +@[simp] lemma rev_rev (i : fin n) : i.rev.rev = i := rev_involutive _ +@[simp] lemma rev_symm : (@rev n).symm = rev := rfl + +lemma rev_eq {n a : ℕ} (i : fin (n+1)) (h : n=a+i) : + i.rev = ⟨a, nat.lt_succ_iff.mpr (nat.le.intro (h.symm))⟩ := +begin + ext, + dsimp, + conv_lhs { congr, rw h, }, + rw [add_assoc, add_tsub_cancel_right], +end + +@[simp] lemma rev_le_rev {i j : fin n} : i.rev ≤ j.rev ↔ j ≤ i := +by simp only [le_iff_coe_le_coe, coe_rev, tsub_le_tsub_iff_left (nat.add_one_le_iff.2 j.is_lt), + add_le_add_iff_right] + +@[simp] lemma rev_lt_rev {i j : fin n} : i.rev < j.rev ↔ j < i := +lt_iff_lt_of_le_iff_le rev_le_rev + +/-- `fin.rev n` as an order-reversing isomorphism. -/ +@[simps apply to_equiv] def rev_order_iso {n} : (fin n)ᵒᵈ ≃o fin n := +⟨order_dual.of_dual.trans rev, λ i j, rev_le_rev⟩ + +@[simp] lemma rev_order_iso_symm_apply (i : fin n) : + rev_order_iso.symm i = order_dual.to_dual i.rev := rfl + /-- The greatest value of `fin (n+1)` -/ def last (n : ℕ) : fin (n+1) := ⟨_, n.lt_succ_self⟩ @@ -256,7 +336,7 @@ lemma last_val (n : ℕ) : (last n).val = n := rfl theorem le_last (i : fin (n+1)) : i ≤ last n := le_of_lt_succ i.is_lt -instance : bounded_order (fin (n + 1)) := +instance : bounded_order (fin (n+1)) := { top := last n, le_top := le_last, bot := 0, @@ -272,7 +352,7 @@ le_antisymm (le_last i) (not_lt.1 h) lemma top_eq_last (n : ℕ) : ⊤ = fin.last n := rfl -lemma bot_eq_zero (n : ℕ) : ⊥ = (0 : fin (n + 1)) := rfl +lemma bot_eq_zero (n : ℕ) : ⊥ = (0 : fin (n+1)) := rfl section @@ -284,7 +364,7 @@ map. In this lemma we state that for each `i : fin n` we have `(e i : ℕ) = (i @[simp] lemma coe_order_iso_apply (e : fin n ≃o fin m) (i : fin n) : (e i : ℕ) = i := begin rcases i with ⟨i, hi⟩, - rw [subtype.coe_mk], + rw [fin.coe_mk], induction i using nat.strong_induction_on with i h, refine le_antisymm (forall_lt_iff_le.1 $ λ j hj, _) (forall_lt_iff_le.1 $ λ j hj, _), { have := e.symm.lt_iff_lt.2 (mk_lt_of_lt_coe hj), @@ -318,23 +398,6 @@ rel_embedding.ext $ funext_iff.1 $ strict_mono_unique f.strict_mono g.strict_mon end -/-- A function `f` on `fin n` is strictly monotone if and only if `f i < f (i+1)` for all `i`. -/ -lemma strict_mono_iff_lt_succ {α : Type*} [preorder α] {f : fin n → α} : - strict_mono f ↔ ∀ i (h : i + 1 < n), f ⟨i, lt_of_le_of_lt (nat.le_succ i) h⟩ < f ⟨i+1, h⟩ := -begin - split, - { assume H i hi, - apply H, - exact nat.lt_succ_self _ }, - { assume H, - have A : ∀ i j (h : i < j) (h' : j < n), f ⟨i, lt_trans h h'⟩ < f ⟨j, h'⟩, - { assume i j h h', - induction h with k h IH, - { exact H _ _ }, - { exact lt_trans (IH (nat.lt_of_succ_lt h')) (H _ _) } }, - assume i j hij, - convert A (i : ℕ) (j : ℕ) hij j.2; ext; simp only [subtype.coe_eta] } -end end order @@ -344,32 +407,46 @@ section add ### addition, numerals, and coercion from nat -/ -/-- Given a positive `n`, `fin.of_nat' i` is `i % n` as an element of `fin n`. -/ -def of_nat' [h : fact (0 < n)] (i : ℕ) : fin n := ⟨i%n, mod_lt _ h.1⟩ - lemma one_val {n : ℕ} : (1 : fin (n+1)).val = 1 % (n+1) := rfl -lemma coe_one' {n : ℕ} : ((1 : fin (n+1)) : ℕ) = 1 % (n+1) := rfl -@[simp] lemma val_one {n : ℕ} : (1 : fin (n+2)).val = 1 := rfl -@[simp] lemma coe_one {n : ℕ} : ((1 : fin (n+2)) : ℕ) = 1 := rfl +lemma coe_one' (n : ℕ) [ne_zero n] : ((1 : fin n) : ℕ) = 1 % n := rfl +@[simp] lemma val_one (n : ℕ) : (1 : fin (n+2)).val = 1 := rfl +@[simp] lemma coe_one (n : ℕ) : ((1 : fin (n+2)) : ℕ) = 1 := rfl @[simp] lemma mk_one : (⟨1, nat.succ_lt_succ (nat.succ_pos n)⟩ : fin (n + 2)) = (1 : fin _) := rfl instance {n : ℕ} : nontrivial (fin (n + 2)) := ⟨⟨0, 1, dec_trivial⟩⟩ +lemma nontrivial_iff_two_le : nontrivial (fin n) ↔ 2 ≤ n := +by rcases n with _|_|n; simp [fin.nontrivial, not_nontrivial, nat.succ_le_iff] + +lemma subsingleton_iff_le_one : subsingleton (fin n) ↔ n ≤ 1 := +by rcases n with _|_|n; simp [is_empty.subsingleton, unique.subsingleton, not_subsingleton] + section monoid -@[simp] protected lemma add_zero (k : fin (n + 1)) : k + 0 = k := +instance add_comm_semigroup (n : ℕ) : add_comm_semigroup (fin n) := +{ add := (+), + add_assoc := by simp [eq_iff_veq, add_def, add_assoc], + add_comm := by simp [eq_iff_veq, add_def, add_comm] } + +@[simp] protected lemma add_zero [ne_zero n] (k : fin n) : k + 0 = k := by simp [eq_iff_veq, add_def, mod_eq_of_lt (is_lt k)] -@[simp] protected lemma zero_add (k : fin (n + 1)) : (0 : fin (n + 1)) + k = k := +@[simp] protected lemma zero_add [ne_zero n] (k : fin n) : (0 : fin n) + k = k := by simp [eq_iff_veq, add_def, mod_eq_of_lt (is_lt k)] -instance add_comm_monoid (n : ℕ) : add_comm_monoid (fin (n + 1)) := +instance add_comm_monoid (n : ℕ) [ne_zero n] : add_comm_monoid (fin n) := { add := (+), - add_assoc := by simp [eq_iff_veq, add_def, add_assoc], zero := 0, zero_add := fin.zero_add, add_zero := fin.add_zero, - add_comm := by simp [eq_iff_veq, add_def, add_comm] } + ..fin.add_comm_semigroup n } + +instance [ne_zero n] : add_monoid_with_one (fin n) := +{ one := 1, + nat_cast := fin.of_nat', + nat_cast_zero := rfl, + nat_cast_succ := λ i, eq_of_veq (add_mod _ _ _), + .. fin.add_comm_monoid n } end monoid @@ -387,12 +464,9 @@ by rw [fin.coe_add, nat.add_mod_eq_ite, lemma coe_bit0 {n : ℕ} (k : fin n) : ((bit0 k : fin n) : ℕ) = bit0 (k : ℕ) % n := by { cases k, refl } -lemma coe_bit1 {n : ℕ} (k : fin (n + 1)) : - ((bit1 k : fin (n + 1)) : ℕ) = bit1 (k : ℕ) % (n + 1) := -begin - cases n, { cases k with k h, cases k, {show _ % _ = _, simp}, cases h with _ h, cases h }, - simp [bit1, fin.coe_bit0, fin.coe_add, fin.coe_one], -end +lemma coe_bit1 {n : ℕ} [ne_zero n] (k : fin n) : + ((bit1 k : fin n) : ℕ) = bit1 (k : ℕ) % n := +by simp [bit1, coe_add, coe_bit0, coe_one'] lemma coe_add_one_of_lt {n : ℕ} {i : fin n.succ} (h : i < last _) : (↑(i + 1) : ℕ) = i + 1 := @@ -423,8 +497,8 @@ section bit (⟨bit0 m, h⟩ : fin n) = (bit0 ⟨m, (nat.le_add_right m m).trans_lt h⟩ : fin _) := eq_of_veq (nat.mod_eq_of_lt h).symm -@[simp] lemma mk_bit1 {m n : ℕ} (h : bit1 m < n + 1) : - (⟨bit1 m, h⟩ : fin (n + 1)) = (bit1 ⟨m, (nat.le_add_right m m).trans_lt +@[simp] lemma mk_bit1 {m n : ℕ} [ne_zero n] (h : bit1 m < n) : + (⟨bit1 m, h⟩ : fin n) = (bit1 ⟨m, (nat.le_add_right m m).trans_lt ((m + m).lt_succ_self.trans h)⟩ : fin _) := begin ext, @@ -441,39 +515,38 @@ section of_nat_coe @[simp] lemma of_nat_eq_coe (n : ℕ) (a : ℕ) : (of_nat a : fin (n+1)) = a := -begin - induction a with a ih, { refl }, - ext, show (a+1) % (n+1) = subtype.val (a+1 : fin (n+1)), - { rw [val_add, ← ih, of_nat], - exact add_mod _ _ _ } -end +rfl -/-- Converting an in-range number to `fin (n + 1)` produces a result +@[simp] +lemma of_nat'_eq_coe (n : ℕ) [ne_zero n] (a : ℕ) : (of_nat' a : fin n) = a := +rfl + +/-- Converting an in-range number to `fin n` produces a result whose value is the original number. -/ -lemma coe_val_of_lt {n : ℕ} {a : ℕ} (h : a < n + 1) : - ((a : fin (n + 1)).val) = a := +lemma coe_val_of_lt {n : ℕ} [ne_zero n] {a : ℕ} (h : a < n) : + ((a : fin n).val) = a := begin - rw ←of_nat_eq_coe, + rw ←of_nat'_eq_coe, exact nat.mod_eq_of_lt h end -/-- Converting the value of a `fin (n + 1)` to `fin (n + 1)` results +/-- Converting the value of a `fin n` to `fin n` results in the same value. -/ -lemma coe_val_eq_self {n : ℕ} (a : fin (n + 1)) : (a.val : fin (n + 1)) = a := +lemma coe_val_eq_self {n : ℕ} [ne_zero n] (a : fin n) : (a.val : fin n) = a := begin rw fin.eq_iff_veq, exact coe_val_of_lt a.property end -/-- Coercing an in-range number to `fin (n + 1)`, and converting back +/-- Coercing an in-range number to `fin n`, and converting back to `ℕ`, results in that number. -/ -lemma coe_coe_of_lt {n : ℕ} {a : ℕ} (h : a < n + 1) : - ((a : fin (n + 1)) : ℕ) = a := +lemma coe_coe_of_lt {n : ℕ} [ne_zero n] {a : ℕ} (h : a < n) : + ((a : fin n) : ℕ) = a := coe_val_of_lt h -/-- Converting a `fin (n + 1)` to `ℕ` and back results in the same +/-- Converting a `fin n` to `ℕ` and back results in the same value. -/ -@[simp] lemma coe_coe_eq_self {n : ℕ} (a : fin (n + 1)) : ((a : ℕ) : fin (n + 1)) = a := +@[simp] lemma coe_coe_eq_self {n : ℕ} [ne_zero n] (a : fin n) : ((a : ℕ) : fin n) = a := coe_val_eq_self a lemma coe_nat_eq_last (n) : (n : fin (n + 1)) = fin.last n := @@ -497,16 +570,17 @@ lemma one_pos : (0 : fin (n + 2)) < 1 := succ_pos 0 lemma zero_ne_one : (0 : fin (n + 2)) ≠ 1 := ne_of_lt one_pos -@[simp] lemma zero_eq_one_iff : (0 : fin (n + 1)) = 1 ↔ n = 0 := +@[simp] lemma zero_eq_one_iff [ne_zero n]: (0 : fin n) = 1 ↔ n = 1 := begin split, - { cases n; intro h, - { refl }, - { have := zero_ne_one, contradiction } }, - { rintro rfl, refl } + { intro h, + have := congr_arg (coe : fin n → ℕ) h, + simp only [fin.coe_zero, ← nat.dvd_iff_mod_eq_zero, fin.coe_one', @eq_comm _ 0] at this, + exact eq_one_of_dvd_one this }, + { unfreezingI { rintro rfl }, refl } end -@[simp] lemma one_eq_zero_iff : (1 : fin (n + 1)) = 0 ↔ n = 0 := +@[simp] lemma one_eq_zero_iff [ne_zero n]: (1 : fin n) = 0 ↔ n = 1 := by rw [eq_comm, zero_eq_one_iff] end add @@ -542,11 +616,27 @@ lemma succ_injective (n : ℕ) : injective (@fin.succ n) := (succ_injective n).eq_iff lemma succ_ne_zero {n} : ∀ k : fin n, fin.succ k ≠ 0 -| ⟨k, hk⟩ heq := nat.succ_ne_zero k $ (ext_iff _ _).1 heq +| ⟨k, hk⟩ heq := nat.succ_ne_zero k $ ext_iff.1 heq -@[simp] lemma succ_zero_eq_one : fin.succ (0 : fin (n + 1)) = 1 := rfl +@[simp] lemma succ_zero_eq_one [ne_zero n] : fin.succ (0 : fin n) = 1 := +begin + unfreezingI { cases n }, + { exact (ne_zero.ne 0 rfl).elim }, + { refl } +end + +/-- Version of `succ_zero_eq_one` to be used by `dsimp` -/ +@[simp] lemma succ_zero_eq_one' : fin.succ (0 : fin (n+1)) = 1 := rfl + +@[simp] lemma succ_one_eq_two [ne_zero n] : fin.succ (1 : fin (n + 1)) = 2 := +begin + unfreezingI { cases n }, + { exact (ne_zero.ne 0 rfl).elim }, + { refl } +end -@[simp] lemma succ_one_eq_two : fin.succ (1 : fin (n + 2)) = 2 := rfl +/-- Version of `succ_one_eq_two` to be used by `dsimp` -/ +@[simp] lemma succ_one_eq_two' : fin.succ (1 : fin (n + 2)) = 2 := rfl @[simp] lemma succ_mk (n i : ℕ) (h : i < n) : fin.succ ⟨i, h⟩ = ⟨i + 1, nat.succ_lt_succ h⟩ := rfl @@ -561,6 +651,43 @@ begin { rw [←succ_zero_eq_one, succ_lt_succ_iff], exact succ_pos a } end +@[simp] lemma add_one_lt_iff {n : ℕ} {k : fin (n + 2)} : + k + 1 < k ↔ k = last _ := +begin + simp only [lt_iff_coe_lt_coe, coe_add, coe_last, ext_iff], + cases k with k hk, + rcases (le_of_lt_succ hk).eq_or_lt with rfl|hk', + { simp }, + { simp [hk'.ne, mod_eq_of_lt (succ_lt_succ hk'), le_succ _] } +end + +@[simp] lemma add_one_le_iff {n : ℕ} {k : fin (n + 1)} : + k + 1 ≤ k ↔ k = last _ := +begin + cases n, + { simp [subsingleton.elim (k + 1) k, subsingleton.elim (fin.last _) k] }, + rw [←not_iff_not, ←add_one_lt_iff, lt_iff_le_and_ne, not_and'], + refine ⟨λ h _, h, λ h, h _⟩, + rw [ne.def, ext_iff, coe_add_one], + split_ifs with hk hk; + simp [hk, eq_comm], +end + +@[simp] lemma last_le_iff {n : ℕ} {k : fin (n + 1)} : + last n ≤ k ↔ k = last n := +top_le_iff + +@[simp] lemma lt_add_one_iff {n : ℕ} {k : fin (n + 1)} : + k < k + 1 ↔ k < last n := +begin + rw ←not_iff_not, + simp +end + +@[simp] lemma le_zero_iff {n : ℕ} [ne_zero n] {k : fin n} : + k ≤ 0 ↔ k = 0 := +⟨λ h, fin.eq_of_veq $ by rw [nat.eq_zero_of_le_zero h]; refl, by rintro rfl; refl⟩ + lemma succ_succ_ne_one (a : fin n) : fin.succ (fin.succ a) ≠ 1 := ne_of_gt (one_lt_succ_succ a) /-- `cast_lt i h` embeds `i` into a `fin` where `h` proves it belongs into. -/ @@ -598,6 +725,14 @@ end cast_le h i.succ = (cast_le (nat.succ_le_succ_iff.mp h) i).succ := by simp [fin.eq_iff_veq] +@[simp] lemma cast_le_cast_le {k m n} (km : k ≤ m) (mn : m ≤ n) (i : fin k) : + fin.cast_le mn (fin.cast_le km i) = fin.cast_le (km.trans mn) i := +fin.ext (by simp only [coe_cast_le]) + +@[simp] lemma cast_le_comp_cast_le {k m n} (km : k ≤ m) (mn : m ≤ n) : + fin.cast_le mn ∘ fin.cast_le km = fin.cast_le (km.trans mn) := +funext (cast_le_cast_le km mn) + /-- `cast eq i` embeds `i` into a equal `fin` type, see also `equiv.fin_congr`. -/ def cast (eq : n = m) : fin n ≃o fin m := { to_equiv := ⟨cast_le eq.le, cast_le eq.symm.le, λ a, eq_of_veq rfl, λ a, eq_of_veq rfl⟩, @@ -610,8 +745,8 @@ as it is eligible for `dsimp`. -/ @[simp] lemma coe_cast (h : n = m) (i : fin n) : (cast h i : ℕ) = i := rfl -@[simp] lemma cast_zero {n' : ℕ} {h : n + 1 = n' + 1} : - cast h (0 : fin (n + 1)) = 0 := +@[simp] lemma cast_zero {n' : ℕ} [ne_zero n] {h : n = n'} : + cast h (0 : fin n) = by { haveI : ne_zero n' := by { rw ← h; apply_instance }, exact 0 } := ext rfl @[simp] lemma cast_last {n' : ℕ} {h : n + 1 = n' + 1} : @@ -674,6 +809,10 @@ ext rfl cast h (cast_add m' i) = cast_add m i := ext rfl +lemma cast_add_cast_add {m n p : ℕ} (i : fin m) : + cast_add p (cast_add n i) = cast (add_assoc _ _ _).symm (cast_add (n + p) i) := +ext rfl + /-- The cast of the successor is the succesor of the cast. See `fin.succ_cast_eq` for rewriting in the reverse direction. -/ @[simp] lemma cast_succ_eq {n' : ℕ} (i : fin n) (h : n.succ = n'.succ) : @@ -729,18 +868,18 @@ lemma cast_succ_inj {a b : fin n} : a.cast_succ = b.cast_succ ↔ a = b := lemma cast_succ_lt_last (a : fin n) : cast_succ a < last n := lt_iff_coe_lt_coe.mpr a.is_lt -@[simp] lemma cast_succ_zero : cast_succ (0 : fin (n + 1)) = 0 := rfl +@[simp] lemma cast_succ_zero [ne_zero n] : cast_succ (0 : fin n) = 0 := rfl @[simp] lemma cast_succ_one {n : ℕ} : fin.cast_succ (1 : fin (n + 2)) = 1 := rfl /-- `cast_succ i` is positive when `i` is positive -/ -lemma cast_succ_pos {i : fin (n + 1)} (h : 0 < i) : 0 < cast_succ i := +lemma cast_succ_pos [ne_zero n] {i : fin n} (h : 0 < i) : 0 < cast_succ i := by simpa [lt_iff_coe_lt_coe] using h -@[simp] lemma cast_succ_eq_zero_iff (a : fin (n + 1)) : a.cast_succ = 0 ↔ a = 0 := -subtype.ext_iff.trans $ (subtype.ext_iff.trans $ by exact iff.rfl).symm +@[simp] lemma cast_succ_eq_zero_iff [ne_zero n] (a : fin n) : a.cast_succ = 0 ↔ a = 0 := +fin.ext_iff.trans $ (fin.ext_iff.trans $ by exact iff.rfl).symm -lemma cast_succ_ne_zero_iff (a : fin (n + 1)) : a.cast_succ ≠ 0 ↔ a ≠ 0 := +lemma cast_succ_ne_zero_iff [ne_zero n] (a : fin n) : a.cast_succ ≠ 0 ↔ a ≠ 0 := not_iff_not.mpr $ cast_succ_eq_zero_iff a lemma cast_succ_fin_succ (n : ℕ) (j : fin n) : @@ -767,7 +906,7 @@ by { rw [cast_succ, lt_iff_coe_lt_coe, coe_cast_add, coe_succ], exact lt_add_one set.range (cast_succ : fin n → fin n.succ) = {i | (i : ℕ) < n} := range_cast_le _ -@[simp] lemma coe_of_injective_cast_succ_symm {n : ℕ} (i : fin n.succ) (hi) : +@[simp] lemma coe_of_injective_cast_succ_symm {n : ℕ} (i : fin (n+1)) (hi) : ((equiv.of_injective cast_succ (cast_succ_injective _)).symm ⟨i, hi⟩ : ℕ) = i := begin rw ← coe_cast_succ, @@ -838,6 +977,18 @@ ext rfl cast h (nat_add m' i) = nat_add m i := ext $ (congr_arg (+ (i : ℕ)) (add_right_cancel h) : _) +lemma cast_add_nat_add (p m : ℕ) {n : ℕ} (i : fin n) : + cast_add p (nat_add m i) = cast (add_assoc _ _ _).symm (nat_add m (cast_add p i)) := +ext rfl + +lemma nat_add_cast_add (p m : ℕ) {n : ℕ} (i : fin n) : + nat_add m (cast_add p i) = cast (add_assoc _ _ _) (cast_add p (nat_add m i)) := +ext rfl + +lemma nat_add_nat_add (m n : ℕ) {p : ℕ} (i : fin p) : + nat_add m (nat_add n i) = cast (add_assoc _ _ _) (nat_add (m + n) i) := +ext $ (add_assoc _ _ _).symm + @[simp] lemma cast_nat_add_zero {n n' : ℕ} (i : fin n) (h : 0 + n = n') : cast h (nat_add 0 i) = cast ((zero_add _).symm.trans h) i := ext $ zero_add _ @@ -850,6 +1001,11 @@ ext $ add_comm _ _ cast (add_comm _ _) (add_nat m i) = nat_add m i := ext $ add_comm _ _ +@[simp] lemma nat_add_last {m n : ℕ} : nat_add n (last m) = last (n + m) := rfl + +lemma nat_add_cast_succ {m n : ℕ} {i : fin m} : + nat_add n (cast_succ i) = cast_succ (nat_add n i) := rfl + end succ section pred @@ -868,6 +1024,10 @@ by { cases j, refl } @[simp] lemma pred_succ (i : fin n) {h : i.succ ≠ 0} : i.succ.pred h = i := by { cases i, refl } +lemma pred_eq_iff_eq_succ {n : ℕ} (i : fin (n+1)) (hi : i ≠ 0) (j : fin n) : + i.pred hi = j ↔ i = j.succ := +⟨λ h, by simp only [← h, fin.succ_pred], λ h, by simp only [h, fin.pred_succ]⟩ + @[simp] lemma pred_mk_succ (i : ℕ) (h : i < n + 1) : fin.pred ⟨i + 1, add_lt_add_right h 1⟩ (ne_of_vne (ne_of_gt (mk_succ_pos i h))) = ⟨i, h⟩ := by simp only [ext_iff, coe_pred, coe_mk, add_tsub_cancel_right] @@ -940,7 +1100,7 @@ def div_nat (i : fin (m * n)) : fin m := /-- Compute `i % n`, where `n` is a `nat` and inferred the type of `i`. -/ def mod_nat (i : fin (m * n)) : fin n := -⟨i % n, nat.mod_lt _ $ pos_of_mul_pos_left ((nat.zero_le i).trans_lt i.is_lt) m.zero_le⟩ +⟨i % n, nat.mod_lt _ $ pos_of_mul_pos_right i.pos m.zero_le⟩ @[simp] lemma coe_mod_nat (i : fin (m * n)) : (i.mod_nat : ℕ) = i % n := rfl @@ -1002,6 +1162,14 @@ begin exact IH (lt_of_succ_lt hi) } end +@[simp] lemma induction_zero {C : fin (n + 1) → Sort*} (h0 : C 0) + (hs : ∀ i : fin n, C i.cast_succ → C i.succ) : + (induction h0 hs : _) 0 = h0 := rfl + +@[simp] lemma induction_succ {C : fin (n + 1) → Sort*} (h0 : C 0) + (hs : ∀ i : fin n, C i.cast_succ → C i.succ) (i : fin n) : + (induction h0 hs : _) i.succ = hs i (induction h0 hs i.cast_succ) := by cases i; refl + /-- Define `C i` by induction on `i : fin (n + 1)` via induction on the underlying `nat` value. This function has two arguments: `h0` handles the base case on `C 0`, @@ -1040,7 +1208,7 @@ lemma forall_fin_succ {P : fin (n+1) → Prop} : lemma exists_fin_succ {P : fin (n+1) → Prop} : (∃ i, P i) ↔ P 0 ∨ (∃i:fin n, P i.succ) := ⟨λ ⟨i, h⟩, fin.cases or.inl (λ i hi, or.inr ⟨i, hi⟩) i h, - λ h, or.elim h (λ h, ⟨0, h⟩) $ λ⟨i, hi⟩, ⟨i.succ, hi⟩⟩ + λ h, h.elim (λ h, ⟨0, h⟩) $ λ⟨i, hi⟩, ⟨i.succ, hi⟩⟩ lemma forall_fin_one {p : fin 1 → Prop} : (∀ i, p i) ↔ p 0 := @unique.forall_iff (fin 1) _ p lemma exists_fin_one {p : fin 1 → Prop} : (∃ i, p i) ↔ p 0 := @unique.exists_iff (fin 1) _ p @@ -1101,7 +1269,7 @@ end /-- Define `f : Π i : fin n.succ, C i` by separately handling the cases `i = fin.last n` and `i = j.cast_succ`, `j : fin n`. -/ -@[elab_as_eliminator, elab_strategy] +@[elab_as_eliminator] def last_cases {n : ℕ} {C : fin (n + 1) → Sort*} (hlast : C (fin.last n)) (hcast : (Π (i : fin n), C i.cast_succ)) (i : fin (n + 1)) : C i := reverse_induction hlast (λ i _, hcast i) i @@ -1118,7 +1286,7 @@ reverse_induction_cast_succ _ _ _ /-- Define `f : Π i : fin (m + n), C i` by separately handling the cases `i = cast_add n i`, `j : fin m` and `i = nat_add m j`, `j : fin n`. -/ -@[elab_as_eliminator, elab_strategy] +@[elab_as_eliminator] def add_cases {m n : ℕ} {C : fin (m + n) → Sort u} (hleft : Π i, C (cast_add n i)) (hright : Π i, C (nat_add m i)) (i : fin (m + n)) : C i := @@ -1127,7 +1295,7 @@ else eq.rec_on (nat_add_sub_nat_cast (le_of_not_lt hi)) (hright _) @[simp] lemma add_cases_left {m n : ℕ} {C : fin (m + n) → Sort*} (hleft : Π i, C (cast_add n i)) (hright : Π i, C (nat_add m i)) (i : fin m) : - add_cases hleft hright (fin.cast_add n i) = hleft i := + @add_cases _ _ C hleft hright (fin.cast_add n i) = hleft i := begin cases i with i hi, rw [add_cases, dif_pos (cast_add_lt _ _)], @@ -1136,7 +1304,7 @@ end @[simp] lemma add_cases_right {m n : ℕ} {C : fin (m + n) → Sort*} (hleft : Π i, C (cast_add n i)) (hright : Π i, C (nat_add m i)) (i : fin n) : - add_cases hleft hright (nat_add m i) = hright i := + @add_cases _ _ C hleft hright (nat_add m i) = hright i := begin have : ¬ (nat_add m i : ℕ) < m, from (le_coe_nat_add _ _).not_lt, rw [add_cases, dif_neg this], @@ -1146,23 +1314,76 @@ end end rec +lemma lift_fun_iff_succ {α : Type*} (r : α → α → Prop) [is_trans α r] {f : fin (n + 1) → α} : + ((<) ⇒ r) f f ↔ ∀ i : fin n, r (f i.cast_succ) (f i.succ) := +begin + split, + { intros H i, + exact H i.cast_succ_lt_succ }, + { refine λ H i, fin.induction _ _, + { exact λ h, (h.not_le (zero_le i)).elim }, + { intros j ihj hij, + rw [← le_cast_succ_iff] at hij, + rcases hij.eq_or_lt with rfl|hlt, + exacts [H j, trans (ihj hlt) (H j)] } } +end + +/-- A function `f` on `fin (n + 1)` is strictly monotone if and only if `f i < f (i + 1)` +for all `i`. -/ +lemma strict_mono_iff_lt_succ {α : Type*} [preorder α] {f : fin (n + 1) → α} : + strict_mono f ↔ ∀ i : fin n, f i.cast_succ < f i.succ := +lift_fun_iff_succ (<) + +/-- A function `f` on `fin (n + 1)` is monotone if and only if `f i ≤ f (i + 1)` for all `i`. -/ +lemma monotone_iff_le_succ {α : Type*} [preorder α] {f : fin (n + 1) → α} : + monotone f ↔ ∀ i : fin n, f i.cast_succ ≤ f i.succ := +monotone_iff_forall_lt.trans $ lift_fun_iff_succ (≤) + +/-- A function `f` on `fin (n + 1)` is strictly antitone if and only if `f (i + 1) < f i` +for all `i`. -/ +lemma strict_anti_iff_succ_lt {α : Type*} [preorder α] {f : fin (n + 1) → α} : + strict_anti f ↔ ∀ i : fin n, f i.succ < f i.cast_succ := +lift_fun_iff_succ (>) + +/-- A function `f` on `fin (n + 1)` is antitone if and only if `f (i + 1) ≤ f i` for all `i`. -/ +lemma antitone_iff_succ_le {α : Type*} [preorder α] {f : fin (n + 1) → α} : + antitone f ↔ ∀ i : fin n, f i.succ ≤ f i.cast_succ := +antitone_iff_forall_lt.trans $ lift_fun_iff_succ (≥) + section add_group open nat int /-- Negation on `fin n` -/ -instance (n : ℕ) : has_neg (fin n) := -⟨λ a, ⟨(n - a) % n, nat.mod_lt _ (lt_of_le_of_lt (nat.zero_le _) a.2)⟩⟩ +instance (n : ℕ) : has_neg (fin n) := ⟨λ a, ⟨(n - a) % n, nat.mod_lt _ a.pos⟩⟩ -/-- Abelian group structure on `fin (n+1)`. -/ -instance (n : ℕ) : add_comm_group (fin (n+1)) := +/-- Abelian group structure on `fin n`. -/ +instance (n : ℕ) [ne_zero n] : add_comm_group (fin n) := { add_left_neg := λ ⟨a, ha⟩, fin.ext $ trans (nat.mod_add_mod _ _ _) $ by { rw [fin.coe_mk, fin.coe_zero, tsub_add_cancel_of_le, nat.mod_self], exact le_of_lt ha }, sub_eq_add_neg := λ ⟨a, ha⟩ ⟨b, hb⟩, fin.ext $ - show (a + (n + 1 - b)) % (n + 1) = (a + (n + 1 - b) % (n + 1)) % (n + 1), by simp, + show (a + (n - b)) % n = (a + (n - b) % n) % n, by simp, sub := fin.sub, ..fin.add_comm_monoid n, - ..fin.has_neg n.succ } + ..fin.has_neg n } + +/-- Note this is more general than `fin.add_comm_group` as it applies (vacuously) to `fin 0` too. -/ +instance (n : ℕ) : has_involutive_neg (fin n) := +{ neg := has_neg.neg, + neg_neg := nat.cases_on n fin_zero_elim (λ i, neg_neg) } + +/-- Note this is more general than `fin.add_comm_group` as it applies (vacuously) to `fin 0` too. -/ +instance (n : ℕ) : is_cancel_add (fin n) := +{ add_left_cancel := nat.cases_on n fin_zero_elim (λ i _ _ _, add_left_cancel), + add_right_cancel := nat.cases_on n fin_zero_elim (λ i _ _ _, add_right_cancel) } + +/-- Note this is more general than `fin.add_comm_group` as it applies (vacuously) to `fin 0` too. -/ +instance (n : ℕ) : add_left_cancel_semigroup (fin n) := +{ ..fin.add_comm_semigroup n, .. fin.is_cancel_add n } + +/-- Note this is more general than `fin.add_comm_group` as it applies (vacuously) to `fin 0` too. -/ +instance (n : ℕ) : add_right_cancel_semigroup (fin n) := +{ ..fin.add_comm_semigroup n, .. fin.is_cancel_add n } protected lemma coe_neg (a : fin n) : ((-a : fin n) : ℕ) = (n - a) % n := rfl @@ -1188,34 +1409,60 @@ begin { simp [h] }, rw [sub_eq_add_neg, coe_add_eq_ite, coe_neg_one, if_pos, add_comm, add_tsub_add_eq_tsub_left], rw [add_comm ↑a, add_le_add_iff_left, nat.one_le_iff_ne_zero], - rwa subtype.ext_iff at h + rwa fin.ext_iff at h end -/-- By sending `x` to `last n - x`, `fin n` is order-equivalent to its `order_dual`. -/ -def _root_.order_iso.fin_equiv : ∀ {n}, (fin n)ᵒᵈ ≃o fin n -| 0 := ⟨⟨elim0, elim0, elim0, elim0⟩, elim0⟩ -| (n+1) := order_iso.symm $ -{ to_fun := λ x, last n - x, - inv_fun := λ x, last n - x, - left_inv := sub_sub_cancel _, - right_inv := sub_sub_cancel _, - map_rel_iff' := λ a b, - begin - rw [order_dual.has_le], - simp only [equiv.coe_fn_mk], - rw [le_iff_coe_le_coe, fin.coe_sub, fin.coe_sub, coe_last], - have : (n - ↑b) % (n + 1) ≤ (n - ↑a) % (n + 1) ↔ a ≤ b, - { rw [nat.mod_eq_of_lt, nat.mod_eq_of_lt, tsub_le_tsub_iff_left a.is_le, - le_iff_coe_le_coe]; exact tsub_le_self.trans_lt n.lt_succ_self }, - suffices key : ∀ {x : fin (n + 1)}, (n + (n + 1 - x)) % (n + 1) = (n - x) % (n + 1), - { convert this using 2; exact key }, - intro x, - rw [add_comm, tsub_add_eq_add_tsub x.is_lt.le, add_tsub_assoc_of_le x.is_le, nat.add_mod_left] - end } - -lemma _root_.order_iso.fin_equiv_apply (a) : order_iso.fin_equiv a = last n - a.of_dual := rfl -lemma _root_.order_iso.fin_equiv_symm_apply (a) : - order_iso.fin_equiv.symm a = order_dual.to_dual (last n - a) := rfl +lemma coe_sub_iff_le {n : ℕ} {a b : fin n} : + (↑(a - b) : ℕ) = a - b ↔ b ≤ a := +begin + cases n, {exact fin_zero_elim a}, + rw [le_iff_coe_le_coe, fin.coe_sub, ←add_tsub_assoc_of_le b.is_lt.le a], + cases le_or_lt (b : ℕ) a with h h, + { simp [←tsub_add_eq_add_tsub h, h, nat.mod_eq_of_lt ((nat.sub_le _ _).trans_lt a.is_lt)] }, + { rw [nat.mod_eq_of_lt, tsub_eq_zero_of_le h.le, tsub_eq_zero_iff_le, ←not_iff_not], + { simpa [b.is_lt.trans_le (le_add_self)] using h }, + { rwa [tsub_lt_iff_left (b.is_lt.le.trans (le_add_self)), add_lt_add_iff_right] } } +end + +lemma coe_sub_iff_lt {n : ℕ} {a b : fin n} : + (↑(a - b) : ℕ) = n + a - b ↔ a < b := +begin + cases n, {exact fin_zero_elim a}, + rw [lt_iff_coe_lt_coe, fin.coe_sub, add_comm], + cases le_or_lt (b : ℕ) a with h h, + { simpa [add_tsub_assoc_of_le h, ←not_le, h] + using ((nat.mod_lt _ (nat.succ_pos _)).trans_le le_self_add).ne }, + { simp [←tsub_tsub_assoc b.is_lt.le h.le, ←tsub_add_eq_add_tsub b.is_lt.le, + nat.mod_eq_of_lt (tsub_lt_self (nat.succ_pos _) (tsub_pos_of_lt h)), h] } +end + +@[simp] lemma lt_sub_one_iff {n : ℕ} {k : fin (n + 2)} : + k < k - 1 ↔ k = 0 := +begin + rcases k with ⟨(_|k), hk⟩, + simp [lt_iff_coe_lt_coe], + have : (k + 1 + (n + 1)) % (n + 2) = k % (n + 2), + { rw [add_right_comm, add_assoc, add_mod_right] }, + simp [lt_iff_coe_lt_coe, ext_iff, fin.coe_sub, succ_eq_add_one, this, + mod_eq_of_lt ((lt_succ_self _).trans hk)] +end + +@[simp] lemma le_sub_one_iff {n : ℕ} {k : fin (n + 1)} : + k ≤ k - 1 ↔ k = 0 := +begin + cases n, + { simp [subsingleton.elim (k - 1) k, subsingleton.elim 0 k] }, + rw [←lt_sub_one_iff, le_iff_lt_or_eq, lt_sub_one_iff, or_iff_left_iff_imp, eq_comm, + sub_eq_iff_eq_add], + simp +end + +@[simp] lemma sub_one_lt_iff {n : ℕ} {k : fin (n + 1)} : + k - 1 < k ↔ 0 < k := +not_iff_not.1 $ by simp only [not_lt, le_sub_one_iff, le_zero_iff] + +lemma last_sub (i : fin (n + 1)) : last n - i = i.rev := +ext $ by rw [coe_sub_iff_le.2 i.le_last, coe_last, coe_rev, nat.succ_sub_succ_eq_sub] end add_group @@ -1237,18 +1484,19 @@ lemma succ_above_below (p : fin (n + 1)) (i : fin n) (h : i.cast_succ < p) : p.succ_above i = i.cast_succ := by { rw [succ_above], exact if_pos h } -@[simp] lemma succ_above_ne_zero_zero {a : fin (n + 2)} (ha : a ≠ 0) : a.succ_above 0 = 0 := +@[simp] lemma succ_above_ne_zero_zero [ne_zero n] {a : fin (n + 1)} (ha : a ≠ 0) : + a.succ_above 0 = 0 := begin rw fin.succ_above_below, { refl }, { exact bot_lt_iff_ne_bot.mpr ha } end -lemma succ_above_eq_zero_iff {a : fin (n + 2)} {b : fin (n + 1)} (ha : a ≠ 0) : +lemma succ_above_eq_zero_iff [ne_zero n] {a : fin (n + 1)} {b : fin n} (ha : a ≠ 0) : a.succ_above b = 0 ↔ b = 0 := by simp only [←succ_above_ne_zero_zero ha, order_embedding.eq_iff_eq] -lemma succ_above_ne_zero {a : fin (n + 2)} {b : fin (n + 1)} (ha : a ≠ 0) (hb : b ≠ 0) : +lemma succ_above_ne_zero [ne_zero n] {a : fin (n + 1)} {b : fin n} (ha : a ≠ 0) (hb : b ≠ 0) : a.succ_above b ≠ 0 := mt (succ_above_eq_zero_iff ha).mp hb @@ -1319,7 +1567,8 @@ begin end /-- Embedding a positive `fin n` results in a positive fin (n + 1)` -/ -lemma succ_above_pos (p : fin (n + 2)) (i : fin (n + 1)) (h : 0 < i) : 0 < p.succ_above i := +lemma succ_above_pos [ne_zero n] (p : fin (n + 1)) (i : fin n) (h : 0 < i) : + 0 < p.succ_above i := begin by_cases H : i.cast_succ < p, { simpa [succ_above_below _ _ H] using cast_succ_pos h }, @@ -1363,6 +1612,12 @@ end @[simp] lemma range_succ_above (p : fin (n + 1)) : set.range (p.succ_above) = {p}ᶜ := set.ext $ λ _, exists_succ_above_eq_iff +@[simp] lemma range_succ (n : ℕ) : set.range (fin.succ : fin n → fin (n + 1)) = {0}ᶜ := +range_succ_above 0 + +@[simp] lemma exists_succ_eq_iff {x : fin (n + 1)} : (∃ y, fin.succ y = x) ↔ x ≠ 0 := +@exists_succ_above_eq_iff n 0 x + /-- Given a fixed pivot `x : fin (n + 1)`, `x.succ_above` is injective -/ lemma succ_above_right_injective {x : fin (n + 1)} : injective (succ_above x) := (succ_above x).injective @@ -1385,7 +1640,7 @@ succ_above_left_injective.eq_iff (0 : fin (n + 1)).succ_above i = i.succ := rfl -@[simp] lemma succ_succ_above_zero {n : ℕ} (i : fin (n + 1)) : +@[simp] lemma succ_succ_above_zero {n : ℕ} [ne_zero n] (i : fin n) : (i.succ).succ_above 0 = 0 := succ_above_below _ _ (succ_pos _) @@ -1403,9 +1658,9 @@ succ_succ_above_zero 0 /-- By moving `succ` to the outside of this expression, we create opportunities for further simplification using `succ_above_zero` or `succ_succ_above_zero`. -/ -@[simp] lemma succ_succ_above_one {n : ℕ} (i : fin (n + 2)) : +@[simp] lemma succ_succ_above_one {n : ℕ} [ne_zero n] (i : fin (n + 1)) : (i.succ).succ_above 1 = (i.succ_above 0).succ := -succ_succ_above_succ i 0 +by rw [← succ_succ_above_succ i 0, succ_zero_eq_one] @[simp] lemma one_succ_above_succ {n : ℕ} (j : fin n) : (1 : fin (n + 2)).succ_above j.succ = j.succ.succ := @@ -1469,7 +1724,7 @@ begin end @[simp] lemma cast_pred_last : cast_pred (last (n + 1)) = last n := -by simp [eq_iff_veq, cast_pred, pred_above, cast_succ_lt_last] +eq_of_veq (by simp [cast_pred, pred_above, cast_succ_lt_last]) @[simp] lemma cast_pred_mk (n i : ℕ) (h : i < n + 1) : cast_pred ⟨i, lt_succ_of_lt h⟩ = ⟨i, h⟩ := @@ -1479,6 +1734,14 @@ begin simp [cast_pred, pred_above, this] end +lemma coe_cast_pred {n : ℕ} (a : fin (n + 2)) (hx : a < fin.last _) : + (a.cast_pred : ℕ) = a := +begin + rcases a with ⟨a, ha⟩, + rw cast_pred_mk, + exacts [rfl, hx], +end + lemma pred_above_below (p : fin (n + 1)) (i : fin (n + 2)) (h : i ≤ p.cast_succ) : p.pred_above i = i.cast_pred := begin @@ -1512,8 +1775,8 @@ begin swap 3, -- For some reason `simp` doesn't fire fully unless we discharge the third goal. { exact lt_of_le_of_ne H (ne.symm h), }, { simp, }, - { simp only [subtype.mk_eq_mk, ne.def, fin.cast_succ_mk] at h, - simp only [pred, subtype.mk_lt_mk, not_lt], + { simp only [fin.mk_eq_mk, ne.def, fin.cast_succ_mk] at h, + simp only [pred, fin.mk_lt_mk, not_lt], exact nat.le_pred_of_lt (nat.lt_of_le_and_ne H (ne.symm h)), }, }, end @@ -1556,6 +1819,32 @@ begin { rwa [cast_succ_pred_eq_pred_cast_succ , fin.pred_le_pred_iff] } } end +/-- `succ` commutes with `pred_above`. -/ +@[simp] +lemma succ_pred_above_succ (a : fin n) (b : fin (n+1)) : + a.succ.pred_above b.succ = (a.pred_above b).succ := +begin + obtain h₁ | h₂ := lt_or_le a.cast_succ b, + { rw [fin.pred_above_above _ _ h₁, fin.succ_pred, + fin.pred_above_above, fin.pred_succ], + simpa only [fin.lt_iff_coe_lt_coe, fin.coe_cast_succ, + fin.coe_succ, add_lt_add_iff_right] using h₁, }, + { cases n, + { exfalso, + exact not_lt_zero' a.is_lt, }, + { rw [fin.pred_above_below a b h₂, fin.pred_above_below a.succ b.succ + (by simpa only [le_iff_coe_le_coe, coe_succ, coe_cast_succ, + add_le_add_iff_right] using h₂)], + ext, + have h₀ : (b : ℕ) < n+1, + { simp only [le_iff_coe_le_coe, coe_cast_succ] at h₂, + simpa only [lt_succ_iff] using h₂.trans a.is_le, }, + have h₁ : (b.succ : ℕ) < n+2, + { rw ← nat.succ_lt_succ_iff at h₀, + simpa only [coe_succ] using h₀, }, + simp only [coe_cast_pred b h₀, coe_cast_pred b.succ h₁, coe_succ], }, }, +end + @[simp] theorem cast_pred_cast_succ (i : fin (n + 1)) : cast_pred i.cast_succ = i := by simp [cast_pred, pred_above, le_last] @@ -1602,13 +1891,8 @@ def clamp (n m : ℕ) : fin (m + 1) := of_nat $ min n m @[simp] lemma coe_clamp (n m : ℕ) : (clamp n m : ℕ) = min n m := nat.mod_eq_of_lt $ nat.lt_succ_iff.mpr $ min_le_right _ _ -@[simp] -lemma coe_of_nat_eq_mod (m n : ℕ) : - ((n : fin (succ m)) : ℕ) = n % succ m := -by rw [← of_nat_eq_coe]; refl - -@[simp] lemma coe_of_nat_eq_mod' (m n : ℕ) [I : fact (0 < m)] : - (@fin.of_nat' _ I n : ℕ) = n % m := +@[simp] lemma coe_of_nat_eq_mod (m n : ℕ) [ne_zero m] : + ((n : fin m) : ℕ) = n % m := rfl section mul @@ -1623,18 +1907,40 @@ lemma val_mul {n : ℕ} : ∀ a b : fin n, (a * b).val = (a.val * b.val) % n lemma coe_mul {n : ℕ} : ∀ a b : fin n, ((a * b : fin n) : ℕ) = (a * b) % n | ⟨_, _⟩ ⟨_, _⟩ := rfl -@[simp] protected lemma mul_one (k : fin (n + 1)) : k * 1 = k := -by { cases n, simp, simp [eq_iff_veq, mul_def, mod_eq_of_lt (is_lt k)] } +@[simp] protected lemma mul_one [ne_zero n] (k : fin n) : k * 1 = k := +begin + unfreezingI { cases n }, + { simp }, + unfreezingI { cases n }, + { simp }, + simp [eq_iff_veq, mul_def, mod_eq_of_lt (is_lt k)] +end -@[simp] protected lemma one_mul (k : fin (n + 1)) : (1 : fin (n + 1)) * k = k := -by { cases n, simp, simp [eq_iff_veq, mul_def, mod_eq_of_lt (is_lt k)] } +protected lemma mul_comm (a b : fin n) : a * b = b * a := +fin.eq_of_veq $ by rw [mul_def, mul_def, mul_comm] -@[simp] protected lemma mul_zero (k : fin (n + 1)) : k * 0 = 0 := +@[simp] protected lemma one_mul [ne_zero n] (k : fin n) : (1 : fin n) * k = k := +by rw [fin.mul_comm, fin.mul_one] + +@[simp] protected lemma mul_zero [ne_zero n] (k : fin n) : k * 0 = 0 := by simp [eq_iff_veq, mul_def] -@[simp] protected lemma zero_mul (k : fin (n + 1)) : (0 : fin (n + 1)) * k = 0 := +@[simp] protected lemma zero_mul [ne_zero n] (k : fin n) : (0 : fin n) * k = 0 := by simp [eq_iff_veq, mul_def] end mul +section +-- Note that here we are disabling the "safety" of reflected, to allow us to reuse `nat.mk_numeral`. +-- The usual way to provide the required `reflected` instance would be via rewriting to prove that +-- the expression we use here is equivalent. +local attribute [semireducible] reflected +meta instance reflect : Π n, has_reflect (fin n) +| 0 := fin_zero_elim +| (n + 1) := nat.mk_numeral `(fin n.succ) + `(by apply_instance : has_zero (fin n.succ)) + `(by apply_instance : has_one (fin n.succ)) + `(by apply_instance : has_add (fin n.succ)) ∘ fin.val +end + end fin diff --git a/src/data/fin/fin2.lean b/src/data/fin/fin2.lean index d005f33e90a0d..97382f66c75f2 100644 --- a/src/data/fin/fin2.lean +++ b/src/data/fin/fin2.lean @@ -7,6 +7,9 @@ Authors: Mario Carneiro /-! # Inductive type variant of `fin` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `fin` is defined as a subtype of `ℕ`. This file defines an equivalent type, `fin2`, which is defined inductively. This is useful for its induction principle and different definitional equalities. diff --git a/src/data/fin/interval.lean b/src/data/fin/interval.lean index 9c9a3976f0ef6..46e3a23c11bdf 100644 --- a/src/data/fin/interval.lean +++ b/src/data/fin/interval.lean @@ -4,47 +4,67 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ import data.nat.interval +import data.finset.locally_finite /-! # Finite intervals in `fin n` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves that `fin n` is a `locally_finite_order` and calculates the cardinality of its intervals as finsets and fintypes. -/ -open finset fin +namespace fin +variables {n : ℕ} (a b : fin n) + +@[simp, norm_cast] lemma coe_sup : (↑(a ⊔ b) : ℕ) = a ⊔ b := rfl +@[simp, norm_cast] lemma coe_inf : (↑(a ⊓ b) : ℕ) = a ⊓ b := rfl +@[simp, norm_cast] lemma coe_max : (↑(max a b) : ℕ) = max a b := rfl +@[simp, norm_cast] lemma coe_min : (↑(min a b) : ℕ) = min a b := rfl + +end fin + +open finset fin function open_locale big_operators variables (n : ℕ) -instance : locally_finite_order (fin n) := subtype.locally_finite_order _ +instance : locally_finite_order (fin n) := +order_iso.locally_finite_order fin.order_iso_subtype -namespace fin +instance : locally_finite_order_bot (fin n) := +order_iso.locally_finite_order_bot fin.order_iso_subtype + +instance : Π n, locally_finite_order_top (fin n) +| 0 := is_empty.to_locally_finite_order_top +| (n + 1) := infer_instance -section bounded +namespace fin variables {n} (a b : fin n) -lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).subtype (λ x, x < n) := rfl -lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).subtype (λ x, x < n) := rfl -lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).subtype (λ x, x < n) := rfl -lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).subtype (λ x, x < n) := rfl +lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).fin n := rfl +lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).fin n := rfl +lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).fin n := rfl +lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).fin n := rfl +lemma uIcc_eq_finset_subtype : uIcc a b = (uIcc (a : ℕ) b).fin n := rfl + +@[simp] lemma map_subtype_embedding_Icc : (Icc a b).map fin.coe_embedding = Icc a b := +by simp [Icc_eq_finset_subtype, finset.fin, finset.map_map, Icc_filter_lt_of_lt_right] -@[simp] lemma map_subtype_embedding_Icc : - (Icc a b).map (function.embedding.subtype _) = Icc (a : ℕ) b := -map_subtype_embedding_Icc _ _ _ (λ _ c x _ hx _, hx.trans_lt) +@[simp] lemma map_subtype_embedding_Ico : (Ico a b).map fin.coe_embedding = Ico a b := +by simp [Ico_eq_finset_subtype, finset.fin, finset.map_map] -@[simp] lemma map_subtype_embedding_Ico : - (Ico a b).map (function.embedding.subtype _) = Ico (a : ℕ) b := -map_subtype_embedding_Ico _ _ _ (λ _ c x _ hx _, hx.trans_lt) +@[simp] lemma map_subtype_embedding_Ioc : (Ioc a b).map fin.coe_embedding = Ioc a b := +by simp [Ioc_eq_finset_subtype, finset.fin, finset.map_map, Ioc_filter_lt_of_lt_right] -@[simp] lemma map_subtype_embedding_Ioc : - (Ioc a b).map (function.embedding.subtype _) = Ioc (a : ℕ) b := -map_subtype_embedding_Ioc _ _ _ (λ _ c x _ hx _, hx.trans_lt) +@[simp] lemma map_subtype_embedding_Ioo : (Ioo a b).map fin.coe_embedding = Ioo a b := +by simp [Ioo_eq_finset_subtype, finset.fin, finset.map_map] -@[simp] lemma map_subtype_embedding_Ioo : - (Ioo a b).map (function.embedding.subtype _) = Ioo (a : ℕ) b := -map_subtype_embedding_Ioo _ _ _ (λ _ c x _ hx _, hx.trans_lt) +@[simp] lemma map_subtype_embedding_uIcc : (uIcc a b).map coe_embedding = uIcc a b := +map_subtype_embedding_Icc _ _ @[simp] lemma card_Icc : (Icc a b).card = b + 1 - a := by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map] @@ -58,6 +78,9 @@ by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map] @[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 := by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map] +@[simp] lemma card_uIcc : (uIcc a b).card = (b - a : ℤ).nat_abs + 1 := +by rw [coe_coe, coe_coe, ←nat.card_uIcc, ←map_subtype_embedding_uIcc, card_map] + @[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a := by rw [←card_Icc, fintype.card_of_finset] @@ -70,71 +93,49 @@ by rw [←card_Ioc, fintype.card_of_finset] @[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 := by rw [←card_Ioo, fintype.card_of_finset] -end bounded - -section unbounded -variables {n} (a b : fin (n + 1)) - -lemma Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) (n + 1)).subtype (λ x, x < n + 1) := -begin - ext x, - simp only [mem_subtype, mem_Ici, mem_Icc, coe_fin_le, iff_self_and], - exact λ _, x.2.le, -end - -lemma Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) (n + 1)).subtype (λ x, x < n + 1) := -begin - ext x, - simp only [mem_subtype, mem_Ioi, mem_Ioc, coe_fin_lt, iff_self_and], - exact λ _, x.2.le, -end +@[simp] lemma card_fintype_uIcc : fintype.card (set.uIcc a b) = (b - a : ℤ).nat_abs + 1 := +by rw [←card_uIcc, fintype.card_of_finset] -lemma Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).subtype (λ x, x < n + 1) := rfl -lemma Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).subtype (λ x, x < n + 1) := rfl +lemma Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) n).fin n := by { ext, simp } +lemma Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) n).fin n := by { ext, simp } +lemma Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).fin n := rfl +lemma Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).fin n := rfl -@[simp] lemma map_subtype_embedding_Ici : (Ici a).map (function.embedding.subtype _) = Icc a n := +@[simp] lemma map_subtype_embedding_Ici : (Ici a).map fin.coe_embedding = Icc a (n - 1) := begin ext x, - simp only [exists_prop, function.embedding.coe_subtype, mem_Ici, mem_map, mem_Icc], + simp only [exists_prop, embedding.coe_subtype, mem_Ici, mem_map, mem_Icc], split, { rintro ⟨x, hx, rfl⟩, - exact ⟨hx, nat.lt_succ_iff.1 x.2⟩ }, - { rintro hx, - exact ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ } + exact ⟨hx, le_tsub_of_add_le_right $ x.2⟩ }, + cases n, + { exact fin.elim0 a }, + { exact λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ } end -@[simp] lemma map_subtype_embedding_Ioi : (Ioi a).map (function.embedding.subtype _) = Ioc a n := +@[simp] lemma map_subtype_embedding_Ioi : (Ioi a).map fin.coe_embedding = Ioc a (n - 1) := begin ext x, - simp only [exists_prop, function.embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc], - refine ⟨_, λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩⟩, - rintro ⟨x, hx, rfl⟩, - exact ⟨hx, nat.lt_succ_iff.1 x.2⟩, + simp only [exists_prop, embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc], + split, + { rintro ⟨x, hx, rfl⟩, + exact ⟨hx, le_tsub_of_add_le_right $ x.2⟩ }, + cases n, + { exact fin.elim0 a }, + { exact λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ } end -@[simp] lemma map_subtype_embedding_Iic : (Iic b).map (function.embedding.subtype _) = Iic b := -begin - ext x, - simp only [exists_prop, function.embedding.coe_subtype, mem_Iic, mem_map], - refine ⟨_, λ hx, ⟨⟨x, hx.trans_lt b.2⟩, hx, rfl⟩⟩, - rintro ⟨x, hx, rfl⟩, - exact hx, -end +@[simp] lemma map_subtype_embedding_Iic : (Iic b).map fin.coe_embedding = Iic b := +by simp [Iic_eq_finset_subtype, finset.fin, finset.map_map, Iic_filter_lt_of_lt_right] -@[simp] lemma map_subtype_embedding_Iio : (Iio b).map (function.embedding.subtype _) = Iio b := -begin - ext x, - simp only [exists_prop, function.embedding.coe_subtype, mem_Iio, mem_map], - refine ⟨_, λ hx, ⟨⟨x, hx.trans b.2⟩, hx, rfl⟩⟩, - rintro ⟨x, hx, rfl⟩, - exact hx, -end +@[simp] lemma map_subtype_embedding_Iio : (Iio b).map fin.coe_embedding = Iio b := +by simp [Iio_eq_finset_subtype, finset.fin, finset.map_map] -@[simp] lemma card_Ici : (Ici a).card = n + 1 - a := -by rw [←nat.card_Icc, ←map_subtype_embedding_Ici, card_map] +@[simp] lemma card_Ici : (Ici a).card = n - a := +by { cases n, { exact fin.elim0 a }, rw [←card_map, map_subtype_embedding_Ici, nat.card_Icc], refl } -@[simp] lemma card_Ioi : (Ioi a).card = n - a := -by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioi, card_map] +@[simp] lemma card_Ioi : (Ioi a).card = n - 1 - a := +by { rw [←card_map, map_subtype_embedding_Ioi, nat.card_Ioc] } @[simp] lemma card_Iic : (Iic b).card = b + 1 := by rw [←nat.card_Iic b, ←map_subtype_embedding_Iic, card_map] @@ -142,10 +143,10 @@ by rw [←nat.card_Iic b, ←map_subtype_embedding_Iic, card_map] @[simp] lemma card_Iio : (Iio b).card = b := by rw [←nat.card_Iio b, ←map_subtype_embedding_Iio, card_map] -@[simp] lemma card_fintype_Ici : fintype.card (set.Ici a) = n + 1 - a := +@[simp] lemma card_fintype_Ici : fintype.card (set.Ici a) = n - a := by rw [fintype.card_of_finset, card_Ici] -@[simp] lemma card_fintype_Ioi : fintype.card (set.Ioi a) = n - a := +@[simp] lemma card_fintype_Ioi : fintype.card (set.Ioi a) = n - 1 - a := by rw [fintype.card_of_finset, card_Ioi] @[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 := @@ -154,94 +155,4 @@ by rw [fintype.card_of_finset, card_Iic] @[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b := by rw [fintype.card_of_finset, card_Iio] -end unbounded - -section filter - -variables {n} (a b : fin n) - -@[simp] -lemma card_filter_lt : (finset.univ.filter (λ j, a < j)).card = n - a - 1 := -begin - cases n, - { simp }, - { rw [filter_lt_eq_Ioi, card_Ioi, tsub_tsub], - exact (add_tsub_add_eq_tsub_right _ 1 _).symm } -end - -@[simp] -lemma card_filter_le : (univ.filter (λ j, a ≤ j)).card = n - a := -begin - cases n, - { simp }, - { rw [filter_le_eq_Ici, card_Ici] } -end - -@[simp] -lemma card_filter_gt : (finset.univ.filter (λ j, j < a)).card = a := -begin - cases n, - { exact fin.elim0 a }, - { rw [filter_gt_eq_Iio, card_Iio] } -end - -@[simp] -lemma card_filter_ge : (finset.univ.filter (λ j, j ≤ a)).card = a + 1 := -begin - cases n, - { exact fin.elim0 a }, - { rw [filter_ge_eq_Iic, card_Iic] } -end - -@[simp] -lemma card_filter_lt_lt : (finset.univ.filter (λ j, a < j ∧ j < b)).card = b - a - 1 := -begin - cases n, - { exact fin.elim0 a }, - { rw [filter_lt_lt_eq_Ioo, card_Ioo] } -end - -@[simp] -lemma card_filter_lt_le : (finset.univ.filter (λ j, a < j ∧ j ≤ b)).card = b - a := -begin - cases n, - { exact fin.elim0 a }, - { rw [filter_lt_le_eq_Ioc, card_Ioc] } -end - -@[simp] -lemma card_filter_le_lt : (finset.univ.filter (λ j, a ≤ j ∧ j < b)).card = b - a := -begin - cases n, - { exact fin.elim0 a }, - { rw [filter_le_lt_eq_Ico, card_Ico] } -end - -@[simp] -lemma card_filter_le_le : (finset.univ.filter (λ j, a ≤ j ∧ j ≤ b)).card = b + 1 - a := -begin - cases n, - { exact fin.elim0 a }, - { rw [filter_le_le_eq_Icc, card_Icc] } -end - -lemma prod_filter_lt_mul_neg_eq_prod_off_diag {R : Type*} [comm_monoid R] {n : ℕ} - {f : fin n → fin n → R} : - ∏ i, (∏ j in univ.filter (λ j, i < j), (f j i) * (f i j)) = - ∏ i, (∏ j in univ.filter (λ j, i ≠ j), (f j i)) := -begin - simp_rw [ne_iff_lt_or_gt, or.comm, filter_or, prod_mul_distrib], - have : ∀ i : fin n, disjoint (filter (gt i) univ) (filter (has_lt.lt i) univ), - { simp_rw disjoint_filter, - intros i x y, - apply lt_asymm }, - simp only [prod_union, this, prod_mul_distrib], - rw mul_comm, - congr' 1, - rw [prod_sigma', prod_sigma'], - refine prod_bij' (λ i hi, ⟨i.2, i.1⟩) _ _ (λ i hi, ⟨i.2, i.1⟩) _ _ _; simp -end - -end filter - end fin diff --git a/src/data/fin/succ_pred.lean b/src/data/fin/succ_pred.lean index 85b2168310baa..1a8277e5e971f 100644 --- a/src/data/fin/succ_pred.lean +++ b/src/data/fin/succ_pred.lean @@ -3,11 +3,15 @@ Copyright (c) 2022 Eric Rodriguez. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Rodriguez -/ +import data.fin.basic import order.succ_pred.basic /-! # Successors and predecessors of `fin n` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we show that `fin n` is both a `succ_order` and a `pred_order`. Note that they are also archimedean, but this is derived from the general instance for well-orderings as opposed to a specific `fin` instance. diff --git a/src/data/fin/tuple/basic.lean b/src/data/fin/tuple/basic.lean index 97a15f219fdf6..e9509b715fdca 100644 --- a/src/data/fin/tuple/basic.lean +++ b/src/data/fin/tuple/basic.lean @@ -5,10 +5,14 @@ Authors: Floris van Doorn, Yury Kudryashov, Sébastien Gouëzel, Chris Hughes -/ import data.fin.basic import data.pi.lex +import data.set.intervals.basic /-! # Operation on tuples +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We interpret maps `Π i : fin n, α i` as `n`-tuples of elements of possibly varying type `α i`, `(α 0, …, α (n-1))`. A particular case is `fin n → α` of elements with all the same type. In this case when `α i` is a constant map, then tuples are isomorphic (but not definitionally equal) @@ -24,6 +28,8 @@ We define the following operations: * `fin.insert_nth` : insert an element to a tuple at a given position. * `fin.find p` : returns the first index `n` where `p n` is satisfied, and `none` if it is never satisfied. +* `fin.append a b` : append two tuples. +* `fin.repeat n a` : repeat a tuple `n` times. -/ universes u v @@ -119,19 +125,74 @@ end /-- Recurse on an `n+1`-tuple by splitting it into a single element and an `n`-tuple. -/ @[elab_as_eliminator] -def cons_induction {P : (Π i : fin n.succ, α i) → Sort v} +def cons_cases {P : (Π i : fin n.succ, α i) → Sort v} (h : ∀ x₀ x, P (fin.cons x₀ x)) (x : (Π i : fin n.succ, α i)) : P x := _root_.cast (by rw cons_self_tail) $ h (x 0) (tail x) -@[simp] lemma cons_induction_cons {P : (Π i : fin n.succ, α i) → Sort v} +@[simp] lemma cons_cases_cons {P : (Π i : fin n.succ, α i) → Sort v} (h : Π x₀ x, P (fin.cons x₀ x)) (x₀ : α 0) (x : Π i : fin n, α i.succ) : - @cons_induction _ _ _ h (cons x₀ x) = h x₀ x := + @cons_cases _ _ _ h (cons x₀ x) = h x₀ x := begin - rw [cons_induction, cast_eq], + rw [cons_cases, cast_eq], congr', exact tail_cons _ _ end +/-- Recurse on an tuple by splitting into `fin.elim0` and `fin.cons`. -/ +@[elab_as_eliminator] +def cons_induction {α : Type*} {P : Π {n : ℕ}, (fin n → α) → Sort v} + (h0 : P fin.elim0) + (h : ∀ {n} x₀ (x : fin n → α), P x → P (fin.cons x₀ x)) : Π {n : ℕ} (x : fin n → α), P x +| 0 x := by convert h0 +| (n + 1) x := cons_cases (λ x₀ x, h _ _ $ cons_induction _) x + +lemma cons_injective_of_injective {α} {x₀ : α} {x : fin n → α} (hx₀ : x₀ ∉ set.range x) + (hx : function.injective x) : + function.injective (cons x₀ x : fin n.succ → α) := +begin + refine fin.cases _ _, + { refine fin.cases _ _, + { intro _, + refl }, + { intros j h, + rw [cons_zero, cons_succ] at h, + exact hx₀.elim ⟨_, h.symm⟩ } }, + { intro i, + refine fin.cases _ _, + { intro h, + rw [cons_zero, cons_succ] at h, + exact hx₀.elim ⟨_, h⟩ }, + { intros j h, + rw [cons_succ, cons_succ] at h, + exact congr_arg _ (hx h), } }, +end + +lemma cons_injective_iff {α} {x₀ : α} {x : fin n → α} : + function.injective (cons x₀ x : fin n.succ → α) ↔ x₀ ∉ set.range x ∧ function.injective x := +begin + refine ⟨λ h, ⟨_, _⟩, λ h, cons_injective_of_injective h.1 h.2⟩, + { rintros ⟨i, hi⟩, + replace h := @h i.succ 0, + simpa [hi, succ_ne_zero] using h, }, + { simpa [function.comp] using h.comp (fin.succ_injective _) }, +end + +@[simp] lemma forall_fin_zero_pi {α : fin 0 → Sort*} {P : (Π i, α i) → Prop} : + (∀ x, P x) ↔ P fin_zero_elim := +⟨λ h, h _, λ h x, subsingleton.elim fin_zero_elim x ▸ h⟩ + +@[simp] lemma exists_fin_zero_pi {α : fin 0 → Sort*} {P : (Π i, α i) → Prop} : + (∃ x, P x) ↔ P fin_zero_elim := +⟨λ ⟨x, h⟩, subsingleton.elim x fin_zero_elim ▸ h, λ h, ⟨_, h⟩⟩ + +lemma forall_fin_succ_pi {P : (Π i, α i) → Prop} : + (∀ x, P x) ↔ (∀ a v, P (fin.cons a v)) := +⟨λ h a v, h (fin.cons a v), cons_cases⟩ + +lemma exists_fin_succ_pi {P : (Π i, α i) → Prop} : + (∃ x, P x) ↔ (∃ a v, P (fin.cons a v)) := +⟨λ ⟨x, h⟩, ⟨x 0, tail x, (cons_self_tail x).symm ▸ h⟩, λ ⟨a, v, h⟩, ⟨_, h⟩⟩ + /-- Updating the first element of a tuple does not change the tail. -/ @[simp] lemma tail_update_zero : tail (update q 0 z) = tail q := by { ext j, simp [tail, fin.succ_ne_zero] } @@ -182,33 +243,132 @@ begin simp [and_assoc, exists_and_distrib_left], end -@[simp] -lemma range_cons {α : Type*} {n : ℕ} (x : α) (b : fin n → α) : +lemma range_fin_succ {α} (f : fin (n + 1) → α) : + set.range f = insert (f 0) (set.range (fin.tail f)) := +set.ext $ λ y, exists_fin_succ.trans $ eq_comm.or iff.rfl + +@[simp] lemma range_cons {α : Type*} {n : ℕ} (x : α) (b : fin n → α) : set.range (fin.cons x b : fin n.succ → α) = insert x (set.range b) := +by rw [range_fin_succ, cons_zero, tail_cons] + +section append + +/-- Append a tuple of length `m` to a tuple of length `n` to get a tuple of length `m + n`. +This is a non-dependent version of `fin.add_cases`. -/ +def append {α : Type*} (a : fin m → α) (b : fin n → α) : fin (m + n) → α := +@fin.add_cases _ _ (λ _, α) a b + +@[simp] lemma append_left {α : Type*} (u : fin m → α) (v : fin n → α) (i : fin m) : + append u v (fin.cast_add n i) = u i := +add_cases_left _ _ _ + +@[simp] lemma append_right {α : Type*} (u : fin m → α) (v : fin n → α) (i : fin n) : + append u v (nat_add m i) = v i := +add_cases_right _ _ _ + +lemma append_right_nil {α : Type*} (u : fin m → α) (v : fin n → α) (hv : n = 0) : + append u v = u ∘ fin.cast (by rw [hv, add_zero]) := +begin + refine funext (fin.add_cases (λ l, _) (λ r, _)), + { rw [append_left, function.comp_apply], + refine congr_arg u (fin.ext _), + simp }, + { exact (fin.cast hv r).elim0' } +end + +@[simp] lemma append_elim0' {α : Type*} (u : fin m → α) : + append u fin.elim0' = u ∘ fin.cast (add_zero _) := +append_right_nil _ _ rfl + +lemma append_left_nil {α : Type*} (u : fin m → α) (v : fin n → α) (hu : m = 0) : + append u v = v ∘ fin.cast (by rw [hu, zero_add]) := +begin + refine funext (fin.add_cases (λ l, _) (λ r, _)), + { exact (fin.cast hu l).elim0' }, + { rw [append_right, function.comp_apply], + refine congr_arg v (fin.ext _), + simp [hu] }, +end + +@[simp] lemma elim0'_append {α : Type*} (v : fin n → α) : + append fin.elim0' v = v ∘ fin.cast (zero_add _) := +append_left_nil _ _ rfl + +lemma append_assoc {p : ℕ} {α : Type*} (a : fin m → α) (b : fin n → α) (c : fin p → α) : + append (append a b) c = append a (append b c) ∘ fin.cast (add_assoc _ _ _) := +begin + ext i, + rw function.comp_apply, + refine fin.add_cases (λ l, _) (λ r, _) i, + { rw append_left, + refine fin.add_cases (λ ll, _) (λ lr, _) l, + { rw append_left, + simp [cast_add_cast_add] }, + { rw append_right, + simp [cast_add_nat_add], }, }, + { rw append_right, + simp [←nat_add_nat_add] }, +end + +/-- Appending a one-tuple to the left is the same as `fin.cons`. -/ +lemma append_left_eq_cons {α : Type*} {n : ℕ} (x₀ : fin 1 → α) (x : fin n → α): + fin.append x₀ x = fin.cons (x₀ 0) x ∘ fin.cast (add_comm _ _) := +begin + ext i, + refine fin.add_cases _ _ i; clear i, + { intro i, + rw [subsingleton.elim i 0, fin.append_left, function.comp_apply, eq_comm], + exact fin.cons_zero _ _, }, + { intro i, + rw [fin.append_right, function.comp_apply, fin.cast_nat_add, eq_comm, fin.add_nat_one], + exact fin.cons_succ _ _ _ }, +end + +end append + +section repeat + +/-- Repeat `a` `m` times. For example `fin.repeat 2 ![0, 3, 7] = ![0, 3, 7, 0, 3, 7]`. -/ +@[simp] def repeat {α : Type*} (m : ℕ) (a : fin n → α) : fin (m * n) → α +| i := a i.mod_nat + +@[simp] lemma repeat_zero {α : Type*} (a : fin n → α) : + repeat 0 a = fin.elim0' ∘ cast (zero_mul _) := +funext $ λ x, (cast (zero_mul _) x).elim0' + +@[simp] lemma repeat_one {α : Type*} (a : fin n → α) : + repeat 1 a = a ∘ cast (one_mul _) := +begin + generalize_proofs h, + apply funext, + rw (fin.cast h.symm).surjective.forall, + intro i, + simp [mod_nat, nat.mod_eq_of_lt i.is_lt], +end + +lemma repeat_succ {α : Type*} (a : fin n → α) (m : ℕ) : + repeat m.succ a = append a (repeat m a) ∘ cast ((nat.succ_mul _ _).trans (add_comm _ _)) := +begin + generalize_proofs h, + apply funext, + rw (fin.cast h.symm).surjective.forall, + refine fin.add_cases (λ l, _) (λ r, _), + { simp [mod_nat, nat.mod_eq_of_lt l.is_lt], }, + { simp [mod_nat] } +end + +@[simp] lemma repeat_add {α : Type*} (a : fin n → α) (m₁ m₂ : ℕ) : + repeat (m₁ + m₂) a = append (repeat m₁ a) (repeat m₂ a) ∘ cast (add_mul _ _ _) := begin - ext y, - simp only [set.mem_range, set.mem_insert_iff], - split, - { rintros ⟨i, rfl⟩, - refine cases (or.inl (cons_zero _ _)) (λ i, or.inr ⟨i, _⟩) i, - rw cons_succ }, - { rintros (rfl | ⟨i, hi⟩), - { exact ⟨0, fin.cons_zero _ _⟩ }, - { refine ⟨i.succ, _⟩, - rw [cons_succ, hi] } } -end - -/-- `fin.append ho u v` appends two vectors of lengths `m` and `n` to produce -one of length `o = m + n`. `ho` provides control of definitional equality -for the vector length. -/ -def append {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) : fin o → α := -λ i, if h : (i : ℕ) < m - then u ⟨i, h⟩ - else v ⟨(i : ℕ) - m, (tsub_lt_iff_left (le_of_not_lt h)).2 (ho ▸ i.property)⟩ - -@[simp] lemma fin_append_apply_zero {α : Type*} {o : ℕ} (ho : (o + 1) = (m + 1) + n) - (u : fin (m + 1) → α) (v : fin n → α) : - fin.append ho u v 0 = u 0 := rfl + generalize_proofs h, + apply funext, + rw (fin.cast h.symm).surjective.forall, + refine fin.add_cases (λ l, _) (λ r, _), + { simp [mod_nat, nat.mod_eq_of_lt l.is_lt], }, + { simp [mod_nat, nat.add_mod] } +end + +end repeat end tuple @@ -259,6 +419,27 @@ funext (λ i, by rw [function.comp_app, snoc_cast_succ]) @[simp] lemma snoc_last : snoc p x (last n) = x := by { simp [snoc] } +@[simp] lemma snoc_comp_nat_add {n m : ℕ} {α : Sort*} (f : fin (m + n) → α) (a : α) : + (snoc f a : fin _ → α) ∘ (nat_add m : fin (n + 1) → fin (m + n + 1)) = snoc (f ∘ nat_add m) a := +begin + ext i, + refine fin.last_cases _ (λ i, _) i, + { simp only [function.comp_app], + rw [snoc_last, nat_add_last, snoc_last] }, + { simp only [function.comp_app], + rw [snoc_cast_succ, nat_add_cast_succ, snoc_cast_succ] } +end + +@[simp] lemma snoc_cast_add {α : fin (n + m + 1) → Type*} + (f : Π i : fin (n + m), α (cast_succ i)) (a : α (last (n + m))) + (i : fin n) : + (snoc f a) (cast_add (m + 1) i) = f (cast_add m i) := +dif_pos _ + +@[simp] lemma snoc_comp_cast_add {n m : ℕ} {α : Sort*} (f : fin (n + m) → α) (a : α) : + (snoc f a : fin _ → α) ∘ cast_add (m + 1) = f ∘ cast_add m := +funext (snoc_cast_add f a) + /-- Updating a tuple and adding an element at the end commute. -/ @[simp] lemma snoc_update : snoc (update p i y) x = update (snoc p x) i.cast_succ y := begin @@ -367,6 +548,20 @@ begin simp } end +/-- Appending a one-tuple to the right is the same as `fin.snoc`. -/ +lemma append_right_eq_snoc {α : Type*} {n : ℕ} (x : fin n → α) (x₀ : fin 1 → α) : + fin.append x x₀ = fin.snoc x (x₀ 0) := +begin + ext i, + refine fin.add_cases _ _ i; clear i, + { intro i, + rw [fin.append_left], + exact (@snoc_cast_succ _ (λ _, α) _ _ i).symm, }, + { intro i, + rw [subsingleton.elim i 0, fin.append_right], + exact (@snoc_last _ (λ _, α) _ _).symm, }, +end + lemma comp_init {α : Type*} {β : Type*} (g : α → β) (q : fin n.succ → α) : g ∘ (init q) = init (g ∘ q) := by { ext j, simp [init] } @@ -532,7 +727,7 @@ set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, true_and] lemma preimage_insert_nth_Icc_of_not_mem {i : fin (n + 1)} {x : α i} {q₁ q₂ : Π j, α j} (hx : x ∉ Icc (q₁ i) (q₂ i)) : i.insert_nth x ⁻¹' (Icc q₁ q₂) = ∅ := -set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, false_and, mem_empty_eq] +set.ext $ λ p, by simp only [mem_preimage, insert_nth_mem_Icc, hx, false_and, mem_empty_iff_false] end insert_nth @@ -558,8 +753,8 @@ lemma find_spec : Π {n : ℕ} (p : fin n → Prop) [decidable_pred p] {i : fin { rw h at hi, dsimp at hi, split_ifs at hi with hl hl, - { exact option.some_inj.1 hi ▸ hl }, - { exact option.no_confusion hi } }, + { exact hi ▸ hl }, + { exact hi.elim } }, { rw h at hi, rw [← option.some_inj.1 hi], exact find_spec _ h } @@ -604,10 +799,10 @@ lemma find_min : Π {n : ℕ} {p : fin n → Prop} [decidable_pred p] {i : fin n cases h : find (λ i : fin n, (p (i.cast_lt (nat.lt_succ_of_lt i.2)))) with k, { rw [h] at hi, split_ifs at hi with hl hl, - { obtain rfl := option.some_inj.1 hi, + { subst hi, rw [find_eq_none_iff] at h, exact h ⟨j, hj⟩ hpj }, - { exact option.no_confusion hi } }, + { exact hi.elim } }, { rw h at hi, dsimp at hi, obtain rfl := option.some_inj.1 hi, @@ -652,5 +847,62 @@ lemma mem_find_of_unique {p : fin n → Prop} [decidable_pred p] mem_find_iff.2 ⟨hi, λ j hj, le_of_eq $ h i j hi hj⟩ end find +section contract_nth + +variables {α : Type*} + +/-- Sends `(g₀, ..., gₙ)` to `(g₀, ..., op gⱼ gⱼ₊₁, ..., gₙ)`. -/ +def contract_nth (j : fin (n + 1)) (op : α → α → α) (g : fin (n + 1) → α) (k : fin n) : α := +if (k : ℕ) < j then g k.cast_succ else +if (k : ℕ) = j then op (g k.cast_succ) (g k.succ) +else g k.succ + +lemma contract_nth_apply_of_lt (j : fin (n + 1)) (op : α → α → α) (g : fin (n + 1) → α) + (k : fin n) (h : (k : ℕ) < j) : + contract_nth j op g k = g k.cast_succ := if_pos h + +lemma contract_nth_apply_of_eq (j : fin (n + 1)) (op : α → α → α) (g : fin (n + 1) → α) + (k : fin n) (h : (k : ℕ) = j) : + contract_nth j op g k = op (g k.cast_succ) (g k.succ) := +begin + have : ¬(k : ℕ) < j, from not_lt.2 (le_of_eq h.symm), + rw [contract_nth, if_neg this, if_pos h], +end + +lemma contract_nth_apply_of_gt (j : fin (n + 1)) (op : α → α → α) (g : fin (n + 1) → α) + (k : fin n) (h : (j : ℕ) < k) : + contract_nth j op g k = g k.succ := +by rw [contract_nth, if_neg (not_lt_of_gt h), if_neg (ne.symm $ ne_of_lt h)] + +lemma contract_nth_apply_of_ne (j : fin (n + 1)) (op : α → α → α) (g : fin (n + 1) → α) + (k : fin n) (hjk : (j : ℕ) ≠ k) : + contract_nth j op g k = g (j.succ_above k) := +begin + rcases lt_trichotomy (k : ℕ) j with (h|h|h), + { rwa [j.succ_above_below, contract_nth_apply_of_lt], + { rwa [ fin.lt_iff_coe_lt_coe] }}, + { exact false.elim (hjk h.symm) }, + { rwa [j.succ_above_above, contract_nth_apply_of_gt], + { exact fin.le_iff_coe_le_coe.2 (le_of_lt h) }} +end + +end contract_nth + +/-- To show two sigma pairs of tuples agree, it to show the second elements are related via +`fin.cast`. -/ +lemma sigma_eq_of_eq_comp_cast {α : Type*} : + ∀ {a b : Σ ii, fin ii → α} (h : a.fst = b.fst), a.snd = b.snd ∘ fin.cast h → a = b +| ⟨ai, a⟩ ⟨bi, b⟩ hi h := +begin + dsimp only at hi, + subst hi, + simpa using h, +end + +/-- `fin.sigma_eq_of_eq_comp_cast` as an `iff`. -/ +lemma sigma_eq_iff_eq_comp_cast {α : Type*} {a b : Σ ii, fin ii → α} : + a = b ↔ ∃ (h : a.fst = b.fst), a.snd = b.snd ∘ fin.cast h := +⟨λ h, h ▸ ⟨rfl, funext $ fin.rec $ by exact λ i hi, rfl⟩, + λ ⟨h, h'⟩, sigma_eq_of_eq_comp_cast _ h'⟩ end fin diff --git a/src/data/fin/tuple/bubble_sort_induction.lean b/src/data/fin/tuple/bubble_sort_induction.lean new file mode 100644 index 0000000000000..8e7a0ca355e02 --- /dev/null +++ b/src/data/fin/tuple/bubble_sort_induction.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2022 Michael Stoll. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Michael Stoll +-/ +import data.fin.tuple.sort +import data.fintype.perm +import order.well_founded + +/-! +# "Bubble sort" induction + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We implement the following induction principle `tuple.bubble_sort_induction` +on tuples with values in a linear order `α`. + +Let `f : fin n → α` and let `P` be a predicate on `fin n → α`. Then we can show that +`f ∘ sort f` satisfies `P` if `f` satisfies `P`, and whenever some `g : fin n → α` +satisfies `P` and `g i > g j` for some `i < j`, then `g ∘ swap i j` also satisfies `P`. + +We deduce it from a stronger variant `tuple.bubble_sort_induction'`, which +requires the assumption only for `g` that are permutations of `f`. + +The latter is proved by well-founded induction via `well_founded.induction_bot'` +with respect to the lexicographic ordering on the finite set of all permutations of `f`. +-/ + +namespace tuple + +/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P` +if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two +antitone values. -/ +lemma bubble_sort_induction' {n : ℕ} {α : Type*} [linear_order α] {f : fin n → α} + {P : (fin n → α) → Prop} (hf : P f) + (h : ∀ (σ : equiv.perm (fin n)) (i j : fin n), + i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ equiv.swap i j)) : + P (f ∘ sort f) := +begin + letI := @preorder.lift _ (lex (fin n → α)) _ (λ σ : equiv.perm (fin n), to_lex (f ∘ σ)), + refine @well_founded.induction_bot' _ _ _ (is_well_founded.wf : well_founded (<)) + (equiv.refl _) (sort f) P (λ σ, f ∘ σ) (λ σ hσ hfσ, _) hf, + obtain ⟨i, j, hij₁, hij₂⟩ := antitone_pair_of_not_sorted' hσ, + exact ⟨σ * equiv.swap i j, pi.lex_desc hij₁ hij₂, h σ i j hij₁ hij₂ hfσ⟩, +end + +/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P` +if `f` satsifies `P` and `P` is preserved when swapping two antitone values. -/ +lemma bubble_sort_induction {n : ℕ} {α : Type*} [linear_order α] {f : fin n → α} + {P : (fin n → α) → Prop} (hf : P f) + (h : ∀ (g : fin n → α) (i j : fin n), i < j → g j < g i → P g → P (g ∘ equiv.swap i j)) : + P (f ∘ sort f) := +bubble_sort_induction' hf (λ σ, h _) + +end tuple diff --git a/src/data/fin/tuple/default.lean b/src/data/fin/tuple/default.lean deleted file mode 100644 index 8254c590aabd2..0000000000000 --- a/src/data/fin/tuple/default.lean +++ /dev/null @@ -1 +0,0 @@ -import data.fin.tuple.basic diff --git a/src/data/fin/tuple/monotone.lean b/src/data/fin/tuple/monotone.lean new file mode 100644 index 0000000000000..e67d043a65cb3 --- /dev/null +++ b/src/data/fin/tuple/monotone.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2022 Yury G. Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury G. Kudryashov +-/ +import data.fin.vec_notation + +/-! +# Monotone finite sequences + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove `simp` lemmas that allow to simplify propositions like `monotone ![a, b, c]`. +-/ + +open set fin matrix function +variables {α : Type*} + +lemma lift_fun_vec_cons {n : ℕ} (r : α → α → Prop) [is_trans α r] {f : fin (n + 1) → α} {a : α} : + ((<) ⇒ r) (vec_cons a f) (vec_cons a f) ↔ r a (f 0) ∧ ((<) ⇒ r) f f := +by simp only [lift_fun_iff_succ r, forall_fin_succ, cons_val_succ, cons_val_zero, ← succ_cast_succ, + cast_succ_zero] + +variables [preorder α] {n : ℕ} {f : fin (n + 1) → α} {a : α} + +@[simp] lemma strict_mono_vec_cons : strict_mono (vec_cons a f) ↔ a < f 0 ∧ strict_mono f := +lift_fun_vec_cons (<) + +@[simp] lemma monotone_vec_cons : monotone (vec_cons a f) ↔ a ≤ f 0 ∧ monotone f := +by simpa only [monotone_iff_forall_lt] using @lift_fun_vec_cons α n (≤) _ f a + +@[simp] lemma strict_anti_vec_cons : strict_anti (vec_cons a f) ↔ f 0 < a ∧ strict_anti f := +lift_fun_vec_cons (>) + +@[simp] lemma antitone_vec_cons : antitone (vec_cons a f) ↔ f 0 ≤ a ∧ antitone f := +@monotone_vec_cons αᵒᵈ _ _ _ _ + +lemma strict_mono.vec_cons (hf : strict_mono f) (ha : a < f 0) : + strict_mono (vec_cons a f) := +strict_mono_vec_cons.2 ⟨ha, hf⟩ + +lemma strict_anti.vec_cons (hf : strict_anti f) (ha : f 0 < a) : + strict_anti (vec_cons a f) := +strict_anti_vec_cons.2 ⟨ha, hf⟩ + +lemma monotone.vec_cons (hf : monotone f) (ha : a ≤ f 0) : + monotone (vec_cons a f) := +monotone_vec_cons.2 ⟨ha, hf⟩ + +lemma antitone.vec_cons (hf : antitone f) (ha : f 0 ≤ a) : + antitone (vec_cons a f) := +antitone_vec_cons.2 ⟨ha, hf⟩ + +example : monotone ![1, 2, 2, 3] := by simp [subsingleton.monotone] diff --git a/src/data/fin/tuple/nat_antidiagonal.lean b/src/data/fin/tuple/nat_antidiagonal.lean index 6f76b6696dd2a..e6aa9a68a4b4b 100644 --- a/src/data/fin/tuple/nat_antidiagonal.lean +++ b/src/data/fin/tuple/nat_antidiagonal.lean @@ -3,17 +3,17 @@ Copyright (c) 2022 Eric Wieser. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Wieser -/ - -import data.fin.vec_notation -import algebra.big_operators.basic -import data.list.nat_antidiagonal -import data.multiset.nat_antidiagonal +import algebra.big_operators.fin import data.finset.nat_antidiagonal +import data.fin.vec_notation import logic.equiv.fin /-! # Collections of tuples of naturals with the same sum +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file generalizes `list.nat.antidiagonal n`, `multiset.nat.antidiagonal n`, and `finset.nat.antidiagonal n` from the pair of elements `x : ℕ × ℕ` such that `n = x.1 + x.2`, to the sequence of elements `x : fin k → ℕ` such that `n = ∑ i, x i`. @@ -71,19 +71,17 @@ def antidiagonal_tuple : Π k, ℕ → list (fin k → ℕ) lemma mem_antidiagonal_tuple {n : ℕ} {k : ℕ} {x : fin k → ℕ} : x ∈ antidiagonal_tuple k n ↔ ∑ i, x i = n := begin - induction k with k ih generalizing n, - { cases n, + revert n, + refine fin.cons_induction _ _ x, + { intro n, + cases n, { simp }, - { simp [eq_comm] }, }, - { refine fin.cons_induction (λ x₀ x, _) x, - have : (0 : fin k.succ) ∉ finset.image fin.succ (finset.univ : finset (fin k)) := by simp, - simp_rw [antidiagonal_tuple, list.mem_bind, list.mem_map, list.nat.mem_antidiagonal, - fin.univ_succ, finset.sum_insert this, fin.cons_zero, - finset.sum_image (λ x hx y hy h, fin.succ_injective _ h), fin.cons_succ, fin.cons_eq_cons, - exists_eq_right_right, ih, prod.exists], - split, - { rintros ⟨a, b, rfl, rfl, rfl⟩, refl }, - { rintro rfl, exact ⟨_, _, rfl, rfl, rfl⟩, } }, + { simp [eq_comm] } }, + { intros k x₀ x ih n, + simp_rw [fin.sum_cons, antidiagonal_tuple, list.mem_bind, list.mem_map, + list.nat.mem_antidiagonal, fin.cons_eq_cons, exists_eq_right_right, ih, + @eq_comm _ _ (prod.snd _), and_comm (prod.snd _ = _), ←prod.mk.inj_iff, prod.mk.eta, + exists_prop, exists_eq_right] }, end /-- The antidiagonal of `n` does not contain duplicate entries. -/ diff --git a/src/data/fin/tuple/reflection.lean b/src/data/fin/tuple/reflection.lean new file mode 100644 index 0000000000000..9c338280ad8c5 --- /dev/null +++ b/src/data/fin/tuple/reflection.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import data.fin.vec_notation +import algebra.big_operators.fin + +/-! +# Lemmas for tuples `fin m → α` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains alternative definitions of common operators on vectors which expand +definitionally to the expected expression when evaluated on `![]` notation. + +This allows "proof by reflection", where we prove `f = ![f 0, f 1]` by defining +`fin_vec.eta_expand f` to be equal to the RHS definitionally, and then prove that +`f = eta_expand f`. + +The definitions in this file should normally not be used directly; the intent is for the +corresponding `*_eq` lemmas to be used in a place where they are definitionally unfolded. + +## Main definitions + +* `fin_vec.seq` +* `fin_vec.map` +* `fin_vec.sum` +* `fin_vec.eta_expand` +-/ + +namespace fin_vec +variables {m n : ℕ} {α β γ : Type*} + +/-- Evaluate `fin_vec.seq f v = ![(f 0) (v 0), (f 1) (v 1), ...]` -/ +def seq : Π {m}, (fin m → (α → β)) → (fin m → α) → fin m → β +| 0 f v := ![] +| (n + 1) f v := matrix.vec_cons (f 0 (v 0)) (seq (matrix.vec_tail f) (matrix.vec_tail v)) + +@[simp] +lemma seq_eq : Π {m} (f : fin m → (α → β)) (v : fin m → α), + seq f v = (λ i, f i (v i)) +| 0 f v := subsingleton.elim _ _ +| (n + 1) f v := funext $ λ i, begin + simp_rw [seq, seq_eq], + refine i.cases _ (λ i, _), + { refl }, + { simp only [matrix.cons_val_succ], refl }, +end + +example {f₁ f₂ : α → β} (a₁ a₂ : α) : seq ![f₁, f₂] ![a₁, a₂] = ![f₁ a₁, f₂ a₂] := rfl + +/-- `fin_vec.map f v = ![f (v 0), f (v 1), ...]` -/ +def map (f : α → β) {m} : (fin m → α) → fin m → β := seq (λ i, f) + +/-- +This can be use to prove +```lean +example {f : α → β} (a₁ a₂ : α) : f ∘ ![a₁, a₂] = ![f a₁, f a₂] := +(map_eq _ _).symm +``` +-/ +@[simp] +lemma map_eq (f : α → β) {m} (v : fin m → α) : map f v = (f ∘ v) := +seq_eq _ _ + +example {f : α → β} (a₁ a₂ : α) : f ∘ ![a₁, a₂] = ![f a₁, f a₂] := +(map_eq _ _).symm + +/-- Expand `v` to `![v 0, v 1, ...]` -/ +def eta_expand {m} (v : fin m → α) : fin m → α := map id v + +/-- +This can be use to prove +```lean +example {f : α → β} (a : fin 2 → α) : a = ![a 0, a 1] := (eta_expand_eq _).symm +``` +-/ +@[simp] +lemma eta_expand_eq {m} (v : fin m → α) : eta_expand v = v := map_eq id v + +example {f : α → β} (a : fin 2 → α) : a = ![a 0, a 1] := (eta_expand_eq _).symm + +/-- `∀` with better defeq for `∀ x : fin m → α, P x`. -/ +def «forall» : Π {m} (P : (fin m → α) → Prop), Prop +| 0 P := P ![] +| (n + 1) P := ∀ x : α, «forall» (λ v, P (matrix.vec_cons x v)) + +/-- +This can be use to prove +```lean +example (P : (fin 2 → α) → Prop) : (∀ f, P f) ↔ (∀ a₀ a₁, P ![a₀, a₁]) := (forall_iff _).symm +``` +-/ +@[simp] +lemma forall_iff : Π {m} (P : (fin m → α) → Prop), «forall» P ↔ ∀ x, P x +| 0 P := by { simp only [«forall», fin.forall_fin_zero_pi], refl } +| (n + 1) P := by simp only [«forall», forall_iff, fin.forall_fin_succ_pi, matrix.vec_cons] + +example (P : (fin 2 → α) → Prop) : (∀ f, P f) ↔ (∀ a₀ a₁, P ![a₀, a₁]) := (forall_iff _).symm + +/-- `∃` with better defeq for `∃ x : fin m → α, P x`. -/ +def «exists» : Π {m} (P : (fin m → α) → Prop), Prop +| 0 P := P ![] +| (n + 1) P := ∃ x : α, «exists» (λ v, P (matrix.vec_cons x v)) + +/-- +This can be use to prove +```lean +example (P : (fin 2 → α) → Prop) : (∃ f, P f) ↔ (∃ a₀ a₁, P ![a₀, a₁]) := (exists_iff _).symm +``` +-/ +lemma exists_iff : Π {m} (P : (fin m → α) → Prop), «exists» P ↔ ∃ x, P x +| 0 P := by { simp only [«exists», fin.exists_fin_zero_pi, matrix.vec_empty], refl } +| (n + 1) P := by simp only [«exists», exists_iff, fin.exists_fin_succ_pi, matrix.vec_cons] + +example (P : (fin 2 → α) → Prop) : (∃ f, P f) ↔ (∃ a₀ a₁, P ![a₀, a₁]) := (exists_iff _).symm + +/-- `finset.univ.sum` with better defeq for `fin` -/ +def sum [has_add α] [has_zero α] : Π{m} (v : fin m → α), α +| 0 v := 0 +| 1 v := v 0 +| (n + 2) v := sum (v ∘ fin.cast_succ) + v (fin.last _) + +open_locale big_operators + +/-- This can be used to prove +```lean +example [add_comm_monoid α] (a : fin 3 → α) : ∑ i, a i = a 0 + a 1 + a 2 := +(sum_eq _).symm +``` +-/ +@[simp] +lemma sum_eq [add_comm_monoid α] : Π {m} (a : fin m → α), + sum a = ∑ i, a i +| 0 a := rfl +| 1 a := (fintype.sum_unique a).symm +| (n + 2) a := by rw [fin.sum_univ_cast_succ, sum, sum_eq] + +example [add_comm_monoid α] (a : fin 3 → α) : ∑ i, a i = a 0 + a 1 + a 2 := +(sum_eq _).symm + +end fin_vec diff --git a/src/data/fin/tuple/sort.lean b/src/data/fin/tuple/sort.lean index ee93cbc77b8e4..27d0bcc70bfbf 100644 --- a/src/data/fin/tuple/sort.lean +++ b/src/data/fin/tuple/sort.lean @@ -3,15 +3,18 @@ Copyright (c) 2021 Kyle Miller. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kyle Miller -/ - -import data.fin.basic import data.finset.sort -import order.lexicographic +import data.list.fin_range +import data.prod.lex +import group_theory.perm.basic /-! # Sorting tuples by their values +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given an `n`-tuple `f : fin n → α` where `α` is ordered, we may want to turn it into a sorted `n`-tuple. This file provides an API for doing so, with the sorted `n`-tuple given by @@ -72,14 +75,17 @@ finset.order_iso_of_fin _ (by simp) def sort (f : fin n → α) : equiv.perm (fin n) := (graph_equiv₂ f).to_equiv.trans (graph_equiv₁ f).symm +lemma graph_equiv₂_apply (f : fin n → α) (i : fin n) : + graph_equiv₂ f i = graph_equiv₁ f (sort f i) := +((graph_equiv₁ f).apply_symm_apply _).symm + lemma self_comp_sort (f : fin n → α) : f ∘ sort f = graph.proj ∘ graph_equiv₂ f := show graph.proj ∘ ((graph_equiv₁ f) ∘ (graph_equiv₁ f).symm) ∘ (graph_equiv₂ f).to_equiv = _, by simp - lemma monotone_proj (f : fin n → α) : monotone (graph.proj : graph f → α) := begin - rintro ⟨⟨x, i⟩, hx⟩ ⟨⟨y, j⟩, hy⟩ (h|h), + rintro ⟨⟨x, i⟩, hx⟩ ⟨⟨y, j⟩, hy⟩ (_|h), { exact le_of_lt ‹_› }, { simp [graph.proj] }, end @@ -91,3 +97,71 @@ begin end end tuple + +namespace tuple + +open list + +variables {n : ℕ} {α : Type*} + +/-- If two permutations of a tuple `f` are both monotone, then they are equal. -/ +lemma unique_monotone [partial_order α] {f : fin n → α} {σ τ : equiv.perm (fin n)} + (hfσ : monotone (f ∘ σ)) (hfτ : monotone (f ∘ τ)) : f ∘ σ = f ∘ τ := +of_fn_injective $ eq_of_perm_of_sorted + ((σ.of_fn_comp_perm f).trans (τ.of_fn_comp_perm f).symm) hfσ.of_fn_sorted hfτ.of_fn_sorted + +variables [linear_order α] {f : fin n → α} {σ : equiv.perm (fin n)} + +/-- A permutation `σ` equals `sort f` if and only if the map `i ↦ (f (σ i), σ i)` is +strictly monotone (w.r.t. the lexicographic ordering on the target). -/ +lemma eq_sort_iff' : σ = sort f ↔ strict_mono (σ.trans $ graph_equiv₁ f) := +begin + split; intro h, + { rw [h, sort, equiv.trans_assoc, equiv.symm_trans_self], exact (graph_equiv₂ f).strict_mono }, + { have := subsingleton.elim (graph_equiv₂ f) (h.order_iso_of_surjective _ $ equiv.surjective _), + ext1, exact (graph_equiv₁ f).apply_eq_iff_eq_symm_apply.1 (fun_like.congr_fun this x).symm }, +end + +/-- A permutation `σ` equals `sort f` if and only if `f ∘ σ` is monotone and whenever `i < j` +and `f (σ i) = f (σ j)`, then `σ i < σ j`. This means that `sort f` is the lexicographically +smallest permutation `σ` such that `f ∘ σ` is monotone. -/ +lemma eq_sort_iff : σ = sort f ↔ monotone (f ∘ σ) ∧ ∀ i j, i < j → f (σ i) = f (σ j) → σ i < σ j := +begin + rw eq_sort_iff', + refine ⟨λ h, ⟨(monotone_proj f).comp h.monotone, λ i j hij hfij, _⟩, λ h i j hij, _⟩, + { exact (((prod.lex.lt_iff _ _).1 $ h hij).resolve_left hfij.not_lt).2 }, + { obtain he|hl := (h.1 hij.le).eq_or_lt; apply (prod.lex.lt_iff _ _).2, + exacts [or.inr ⟨he, h.2 i j hij he⟩, or.inl hl] }, +end + +/-- The permutation that sorts `f` is the identity if and only if `f` is monotone. -/ +lemma sort_eq_refl_iff_monotone : sort f = equiv.refl _ ↔ monotone f := +begin + rw [eq_comm, eq_sort_iff, equiv.coe_refl, function.comp.right_id], + simp only [id.def, and_iff_left_iff_imp], + exact λ _ _ _ hij _, hij, +end + +/-- A permutation of a tuple `f` is `f` sorted if and only if it is monotone. -/ +lemma comp_sort_eq_comp_iff_monotone : f ∘ σ = f ∘ sort f ↔ monotone (f ∘ σ) := +⟨λ h, h.symm ▸ monotone_sort f, λ h, unique_monotone h (monotone_sort f)⟩ + +/-- The sorted versions of a tuple `f` and of any permutation of `f` agree. -/ +lemma comp_perm_comp_sort_eq_comp_sort : (f ∘ σ) ∘ (sort (f ∘ σ)) = f ∘ sort f := +begin + rw [function.comp.assoc, ← equiv.perm.coe_mul], + exact unique_monotone (monotone_sort (f ∘ σ)) (monotone_sort f), +end + +/-- If a permutation `f ∘ σ` of the tuple `f` is not the same as `f ∘ sort f`, then `f ∘ σ` +has a pair of strictly decreasing entries. -/ +lemma antitone_pair_of_not_sorted' (h : f ∘ σ ≠ f ∘ sort f) : + ∃ i j, i < j ∧ (f ∘ σ) j < (f ∘ σ) i := +by { contrapose! h, exact comp_sort_eq_comp_iff_monotone.mpr (monotone_iff_forall_lt.mpr h) } + +/-- If the tuple `f` is not the same as `f ∘ sort f`, then `f` has a pair of strictly decreasing +entries. -/ +lemma antitone_pair_of_not_sorted (h : f ≠ f ∘ sort f) : ∃ i j, i < j ∧ f j < f i := +antitone_pair_of_not_sorted' (id h : f ∘ equiv.refl _ ≠ _) + +end tuple diff --git a/src/data/fin/vec_notation.lean b/src/data/fin/vec_notation.lean index e55841bcc108e..29033f48f7911 100644 --- a/src/data/fin/vec_notation.lean +++ b/src/data/fin/vec_notation.lean @@ -3,18 +3,21 @@ Copyright (c) 2020 Anne Baanen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ -import data.fin.tuple +import data.fin.tuple.basic import data.list.range import group_theory.group_action.pi +import meta.univs /-! # Matrix and vector notation +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines notation for vectors and matrices. Given `a b c d : α`, the notation allows us to write `![a, b, c, d] : fin 4 → α`. -Nesting vectors gives a matrix, so `![![a, b], ![c, d]] : fin 2 → fin 2 → α`. -Later we will define `matrix m n α` to be `m → n → α`, so the type of `![![a, b], ![c, d]]` -can be written as `matrix (fin 2) (fin 2) α`. +Nesting vectors gives coefficients of a matrix, so `![![a, b], ![c, d]] : fin 2 → fin 2 → α`. +In later files we introduce `!![a, b; c, d]` as notation for `matrix.of ![![a, b], ![c, d]]`. ## Main definitions @@ -45,8 +48,7 @@ variables {α : Type u} section matrix_notation /-- `![]` is the vector with no entries. -/ -def vec_empty : fin 0 → α := -fin_zero_elim +def vec_empty : fin 0 → α := fin.elim0' /-- `vec_cons h t` prepends an entry `h` to a vector `t`. @@ -74,7 +76,7 @@ variables {m n : ℕ} #eval ![1, 2] + ![3, 4] -- ![4, 6] ``` -/ -instance pi_fin.has_repr [has_repr α] : has_repr (fin n → α) := +instance _root_.pi_fin.has_repr [has_repr α] : has_repr (fin n → α) := { repr := λ f, "![" ++ (string.intercalate ", " ((list.fin_range n).map (λ n, repr (f n)))) ++ "]" } end matrix_notation @@ -124,6 +126,13 @@ set.ext $ λ y, by simp [fin.exists_fin_succ, eq_comm] @[simp] lemma range_empty (u : fin 0 → α) : set.range u = ∅ := set.range_eq_empty _ +@[simp] lemma range_cons_empty (x : α) (u : fin 0 → α) : set.range (matrix.vec_cons x u) = {x} := +by rw [range_cons, range_empty, set.union_empty] + +@[simp] lemma range_cons_cons_empty (x y : α) (u : fin 0 → α) : + set.range (vec_cons x $ vec_cons y u) = {x, y} := +by rw [range_cons, range_cons_empty, set.singleton_union] + @[simp] lemma vec_cons_const (a : α) : vec_cons a (λ k : fin n, a) = λ _, a := funext $ fin.forall_fin_succ.2 ⟨rfl, cons_val_succ _ _⟩ @@ -146,6 +155,18 @@ by { refine fin.forall_fin_one.2 _ i, refl } lemma cons_fin_one (x : α) (u : fin 0 → α) : vec_cons x u = (λ _, x) := funext (cons_val_fin_one x u) +meta instance _root_.pi_fin.reflect [reflected_univ.{u}] [reflected _ α] [has_reflect α] : + Π {n}, has_reflect (fin n → α) +| 0 v := (subsingleton.elim vec_empty v).rec + ((by reflect_name : reflected _ (@vec_empty.{u})).subst `(α)) +| (n + 1) v := (cons_head_tail v).rec $ + (by reflect_name : reflected _ @vec_cons.{u}).subst₄ `(α) `(n) `(_) (_root_.pi_fin.reflect _) + +/-- Convert a vector of pexprs to the pexpr constructing that vector.-/ +meta def _root_.pi_fin.to_pexpr : Π {n}, (fin n → pexpr) → pexpr +| 0 v := ``(![]) +| (n + 1) v := ``(vec_cons %%(v 0) %%(_root_.pi_fin.to_pexpr $ vec_tail v)) + /-! ### Numeral (`bit0` and `bit1`) indices The following definitions and `simp` lemmas are to allow any numeral-indexed element of a vector given with matrix notation to @@ -155,16 +176,43 @@ of elements by virtue of the semantics of `bit0` and `bit1` and of addition on `fin n`). -/ -@[simp] lemma empty_append (v : fin n → α) : fin.append (zero_add _).symm ![] v = v := -by { ext, simp [fin.append] } +/-- `vec_append ho u v` appends two vectors of lengths `m` and `n` to produce +one of length `o = m + n`. This is a variant of `fin.append` with an additional `ho` argument, +which provides control of definitional equality for the vector length. + +This turns out to be helpful when providing simp lemmas to reduce `![a, b, c] n`, and also means +that `vec_append ho u v 0` is valid. `fin.append u v 0` is not valid in this case because there is +no `has_zero (fin (m + n))` instance. -/ +def vec_append {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) : fin o → α := +fin.append u v ∘ fin.cast ho + +lemma vec_append_eq_ite {α : Type*} {o : ℕ} (ho : o = m + n) (u : fin m → α) (v : fin n → α) : + vec_append ho u v = λ i, + if h : (i : ℕ) < m + then u ⟨i, h⟩ + else v ⟨(i : ℕ) - m, (tsub_lt_iff_left (le_of_not_lt h)).2 (ho ▸ i.property)⟩ := +begin + ext i, + rw [vec_append, fin.append, function.comp_apply, fin.add_cases], + congr' with hi, + simp only [eq_rec_constant], + refl, +end + +@[simp] lemma vec_append_apply_zero {α : Type*} {o : ℕ} (ho : (o + 1) = (m + 1) + n) + (u : fin (m + 1) → α) (v : fin n → α) : + vec_append ho u v 0 = u 0 := rfl + +@[simp] lemma empty_vec_append (v : fin n → α) : vec_append (zero_add _).symm ![] v = v := +by { ext, simp [vec_append_eq_ite] } -@[simp] lemma cons_append (ho : o + 1 = m + 1 + n) (x : α) (u : fin m → α) (v : fin n → α) : - fin.append ho (vec_cons x u) v = - vec_cons x (fin.append (by rwa [add_assoc, add_comm 1, ←add_assoc, +@[simp] lemma cons_vec_append (ho : o + 1 = m + 1 + n) (x : α) (u : fin m → α) (v : fin n → α) : + vec_append ho (vec_cons x u) v = + vec_cons x (vec_append (by rwa [add_assoc, add_comm 1, ←add_assoc, add_right_cancel_iff] at ho) u v) := begin ext i, - simp_rw [fin.append], + simp_rw [vec_append_eq_ite], split_ifs with h, { rcases i with ⟨⟨⟩ | i, hi⟩, { simp }, @@ -186,10 +234,10 @@ only alternate elements (odd-numbered). -/ def vec_alt1 (hm : m = n + n) (v : fin m → α) (k : fin n) : α := v ⟨(k : ℕ) + k + 1, hm.symm ▸ nat.add_succ_lt_add k.property k.property⟩ -lemma vec_alt0_append (v : fin n → α) : vec_alt0 rfl (fin.append rfl v v) = v ∘ bit0 := +lemma vec_alt0_vec_append (v : fin n → α) : vec_alt0 rfl (vec_append rfl v v) = v ∘ bit0 := begin ext i, - simp_rw [function.comp, bit0, vec_alt0, fin.append], + simp_rw [function.comp, bit0, vec_alt0, vec_append_eq_ite], split_ifs with h; congr, { rw fin.coe_mk at h, simp only [fin.ext_iff, fin.coe_add, fin.coe_mk], @@ -201,10 +249,10 @@ begin exact add_lt_add i.property i.property } end -lemma vec_alt1_append (v : fin (n + 1) → α) : vec_alt1 rfl (fin.append rfl v v) = v ∘ bit1 := +lemma vec_alt1_vec_append (v : fin (n + 1) → α) : vec_alt1 rfl (vec_append rfl v v) = v ∘ bit1 := begin ext i, - simp_rw [function.comp, vec_alt1, fin.append], + simp_rw [function.comp, vec_alt1, vec_append_eq_ite], cases n, { simp, congr }, { split_ifs with h; simp_rw [bit1, bit0]; congr, @@ -229,12 +277,12 @@ end by simp [vec_head, vec_alt1] @[simp] lemma cons_vec_bit0_eq_alt0 (x : α) (u : fin n → α) (i : fin (n + 1)) : - vec_cons x u (bit0 i) = vec_alt0 rfl (fin.append rfl (vec_cons x u) (vec_cons x u)) i := -by rw vec_alt0_append + vec_cons x u (bit0 i) = vec_alt0 rfl (vec_append rfl (vec_cons x u) (vec_cons x u)) i := +by rw vec_alt0_vec_append @[simp] lemma cons_vec_bit1_eq_alt1 (x : α) (u : fin n → α) (i : fin (n + 1)) : - vec_cons x u (bit1 i) = vec_alt1 rfl (fin.append rfl (vec_cons x u) (vec_cons x u)) i := -by rw vec_alt1_append + vec_cons x u (bit1 i) = vec_alt1 rfl (vec_append rfl (vec_cons x u) (vec_cons x u)) i := +by rw vec_alt1_vec_append @[simp] lemma cons_vec_alt0 (h : m + 1 + 1 = (n + 1) + (n + 1)) (x y : α) (u : fin m → α) : vec_alt0 h (vec_cons x (vec_cons y u)) = vec_cons x (vec_alt0 @@ -274,7 +322,7 @@ end val section smul -variables {M : Type*} [has_scalar M α] +variables {M : Type*} [has_smul M α] @[simp] lemma smul_empty (x : M) (v : fin 0 → α) : x • v = ![] := empty_eq _ diff --git a/src/data/fin_enum.lean b/src/data/fin_enum.lean index 338b1b1bb5db0..d8119788da8e0 100644 --- a/src/data/fin_enum.lean +++ b/src/data/fin_enum.lean @@ -8,6 +8,9 @@ import data.fintype.basic import data.list.prod_sigma /-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Type class for finitely enumerable types. The property is stronger than `fintype` in that it assigns each element a rank in a finite enumeration. @@ -86,7 +89,7 @@ instance punit : fin_enum punit := of_list [punit.star] (λ x, by cases x; simp) instance prod {β} [fin_enum α] [fin_enum β] : fin_enum (α × β) := -of_list ( (to_list α).product (to_list β) ) (λ x, by cases x; simp) +of_list (to_list α ×ˢ to_list β) (λ x, by cases x; simp) instance sum {β} [fin_enum α] [fin_enum β] : fin_enum (α ⊕ β) := of_list ( (to_list α).map sum.inl ++ (to_list β).map sum.inr ) (λ x, by cases x; simp) @@ -117,7 +120,7 @@ begin { exact or.inl hx }, { exact or.inr (h _ hx) } }, intro h, existsi s \ ({xs_hd} : finset α), - simp only [and_imp, union_comm, mem_sdiff, mem_singleton], + simp only [and_imp, mem_sdiff, mem_singleton], simp only [or_iff_not_imp_left] at h, existsi h, by_cases xs_hd ∈ s, @@ -125,7 +128,7 @@ begin simp only [union_sdiff_of_subset this, or_true, finset.union_sdiff_of_subset, eq_self_iff_true], }, { left, symmetry, simp only [sdiff_eq_self], - intro a, simp only [and_imp, mem_inter, mem_singleton, not_mem_empty], + intro a, simp only [and_imp, mem_inter, mem_singleton], rintro h₀ rfl, apply h h₀, } } end diff --git a/src/data/finite/basic.lean b/src/data/finite/basic.lean new file mode 100644 index 0000000000000..b92e642b7944d --- /dev/null +++ b/src/data/finite/basic.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import data.fintype.powerset +import data.fintype.prod +import data.fintype.sigma +import data.fintype.sum +import data.fintype.vector + +/-! +# Finite types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove some theorems about `finite` and provide some instances. This typeclass is a +`Prop`-valued counterpart of the typeclass `fintype`. See more details in the file where `finite` is +defined. + +## Main definitions + +* `fintype.finite`, `finite.of_fintype` creates a `finite` instance from a `fintype` instance. The + former lemma takes `fintype α` as an explicit argument while the latter takes it as an instance + argument. +* `fintype.of_finite` noncomputably creates a `fintype` instance from a `finite` instance. + +## Implementation notes + +There is an apparent duplication of many `fintype` instances in this module, +however they follow a pattern: if a `fintype` instance depends on `decidable` +instances or other `fintype` instances, then we need to "lower" the instance +to be a `finite` instance by removing the `decidable` instances and switching +the `fintype` instances to `finite` instances. These are precisely the ones +that cannot be inferred using `finite.of_fintype`. (However, when using +`open_locale classical` or the `classical` tactic the instances relying only +on `decidable` instances will give `finite` instances.) In the future we might +consider writing automation to create these "lowered" instances. + +## Tags + +finiteness, finite types +-/ + +noncomputable theory +open_locale classical + +variables {α β γ : Type*} + +namespace finite + +@[priority 100] -- see Note [lower instance priority] +instance of_subsingleton {α : Sort*} [subsingleton α] : finite α := +of_injective (function.const α ()) $ function.injective_of_subsingleton _ + +@[nolint instance_priority] -- Higher priority for `Prop`s +instance prop (p : Prop) : finite p := finite.of_subsingleton + +instance [finite α] [finite β] : finite (α × β) := +by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, apply_instance } + +instance {α β : Sort*} [finite α] [finite β] : finite (pprod α β) := +of_equiv _ equiv.pprod_equiv_prod_plift.symm + +lemma prod_left (β) [finite (α × β)] [nonempty β] : finite α := +of_surjective (prod.fst : α × β → α) prod.fst_surjective + +lemma prod_right (α) [finite (α × β)] [nonempty α] : finite β := +of_surjective (prod.snd : α × β → β) prod.snd_surjective + +instance [finite α] [finite β] : finite (α ⊕ β) := +by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, apply_instance } + +lemma sum_left (β) [finite (α ⊕ β)] : finite α := +of_injective (sum.inl : α → α ⊕ β) sum.inl_injective + +lemma sum_right (α) [finite (α ⊕ β)] : finite β := +of_injective (sum.inr : β → α ⊕ β) sum.inr_injective + +instance {β : α → Type*} [finite α] [Π a, finite (β a)] : finite (Σ a, β a) := +by { letI := fintype.of_finite α, letI := λ a, fintype.of_finite (β a), apply_instance } + +instance {ι : Sort*} {π : ι → Sort*} [finite ι] [Π i, finite (π i)] : finite (Σ' i, π i) := +of_equiv _ (equiv.psigma_equiv_sigma_plift π).symm + +instance [finite α] : finite (set α) := by { casesI nonempty_fintype α, apply_instance } + +end finite + +/-- This instance also provides `[finite s]` for `s : set α`. -/ +instance subtype.finite {α : Sort*} [finite α] {p : α → Prop} : finite {x // p x} := +finite.of_injective coe subtype.coe_injective + +instance pi.finite {α : Sort*} {β : α → Sort*} [finite α] [∀ a, finite (β a)] : finite (Π a, β a) := +begin + haveI := fintype.of_finite (plift α), + haveI := λ a, fintype.of_finite (plift (β a)), + exact finite.of_equiv (Π (a : plift α), plift (β (equiv.plift a))) + (equiv.Pi_congr equiv.plift (λ _, equiv.plift)), +end + +instance vector.finite {α : Type*} [finite α] {n : ℕ} : finite (vector α n) := +by { haveI := fintype.of_finite α, apply_instance } + +instance quot.finite {α : Sort*} [finite α] (r : α → α → Prop) : finite (quot r) := +finite.of_surjective _ (surjective_quot_mk r) + +instance quotient.finite {α : Sort*} [finite α] (s : setoid α) : finite (quotient s) := +quot.finite _ + +instance function.embedding.finite {α β : Sort*} [finite β] : finite (α ↪ β) := +begin + casesI is_empty_or_nonempty (α ↪ β) with _ h, + { apply_instance, }, + { refine h.elim (λ f, _), + haveI : finite α := finite.of_injective _ f.injective, + exact finite.of_injective _ fun_like.coe_injective }, +end + +instance equiv.finite_right {α β : Sort*} [finite β] : finite (α ≃ β) := +finite.of_injective equiv.to_embedding $ λ e₁ e₂ h, equiv.ext $ + by convert fun_like.congr_fun h + +instance equiv.finite_left {α β : Sort*} [finite α] : finite (α ≃ β) := +finite.of_equiv _ ⟨equiv.symm, equiv.symm, equiv.symm_symm, equiv.symm_symm⟩ + +instance [finite α] {n : ℕ} : finite (sym α n) := +by { haveI := fintype.of_finite α, apply_instance } diff --git a/src/data/finite/card.lean b/src/data/finite/card.lean new file mode 100644 index 0000000000000..bda3efd6479ac --- /dev/null +++ b/src/data/finite/card.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import set_theory.cardinal.finite + +/-! + +# Cardinality of finite types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The cardinality of a finite type `α` is given by `nat.card α`. This function has +the "junk value" of `0` for infinite types, but to ensure the function has valid +output, one just needs to know that it's possible to produce a `finite` instance +for the type. (Note: we could have defined a `finite.card` that required you to +supply a `finite` instance, but (a) the function would be `noncomputable` anyway +so there is no need to supply the instance and (b) the function would have a more +complicated dependent type that easily leads to "motive not type correct" errors.) + +## Implementation notes + +Theorems about `nat.card` are sometimes incidentally true for both finite and infinite +types. If removing a finiteness constraint results in no loss in legibility, we remove +it. We generally put such theorems into the `set_theory.cardinal.finite` module. + +-/ + +noncomputable theory +open_locale classical + +variables {α β γ : Type*} + +/-- There is (noncomputably) an equivalence between a finite type `α` and `fin (nat.card α)`. -/ +def finite.equiv_fin (α : Type*) [finite α] : α ≃ fin (nat.card α) := +begin + have := (finite.exists_equiv_fin α).some_spec.some, + rwa nat.card_eq_of_equiv_fin this, +end + +/-- Similar to `finite.equiv_fin` but with control over the term used for the cardinality. -/ +def finite.equiv_fin_of_card_eq [finite α] {n : ℕ} (h : nat.card α = n) : α ≃ fin n := +by { subst h, apply finite.equiv_fin } + +lemma nat.card_eq (α : Type*) : + nat.card α = if h : finite α then by exactI @fintype.card α (fintype.of_finite α) else 0 := +begin + casesI finite_or_infinite α, + { letI := fintype.of_finite α, + simp only [*, nat.card_eq_fintype_card, dif_pos] }, + { simp [*, not_finite_iff_infinite.mpr h] }, +end + +lemma finite.card_pos_iff [finite α] : 0 < nat.card α ↔ nonempty α := +begin + haveI := fintype.of_finite α, + rw [nat.card_eq_fintype_card, fintype.card_pos_iff], +end + +lemma finite.card_pos [finite α] [h : nonempty α] : 0 < nat.card α := +finite.card_pos_iff.mpr h + +namespace finite + +lemma cast_card_eq_mk {α : Type*} [finite α] : ↑(nat.card α) = cardinal.mk α := +cardinal.cast_to_nat_of_lt_aleph_0 (cardinal.lt_aleph_0_of_finite α) + +lemma card_eq [finite α] [finite β] : nat.card α = nat.card β ↔ nonempty (α ≃ β) := +by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, simp [fintype.card_eq] } + +lemma card_le_one_iff_subsingleton [finite α] : nat.card α ≤ 1 ↔ subsingleton α := +by { haveI := fintype.of_finite α, simp [fintype.card_le_one_iff_subsingleton] } + +lemma one_lt_card_iff_nontrivial [finite α] : 1 < nat.card α ↔ nontrivial α := +by { haveI := fintype.of_finite α, simp [fintype.one_lt_card_iff_nontrivial] } + +lemma one_lt_card [finite α] [h : nontrivial α] : 1 < nat.card α := +one_lt_card_iff_nontrivial.mpr h + +@[simp] lemma card_option [finite α] : nat.card (option α) = nat.card α + 1 := +by { haveI := fintype.of_finite α, simp } + +lemma card_le_of_injective [finite β] (f : α → β) (hf : function.injective f) : + nat.card α ≤ nat.card β := +by { haveI := fintype.of_finite β, haveI := fintype.of_injective f hf, + simpa using fintype.card_le_of_injective f hf } + +lemma card_le_of_embedding [finite β] (f : α ↪ β) : nat.card α ≤ nat.card β := +card_le_of_injective _ f.injective + +lemma card_le_of_surjective [finite α] (f : α → β) (hf : function.surjective f) : + nat.card β ≤ nat.card α := +by { haveI := fintype.of_finite α, haveI := fintype.of_surjective f hf, + simpa using fintype.card_le_of_surjective f hf } + +lemma card_eq_zero_iff [finite α] : nat.card α = 0 ↔ is_empty α := +by { haveI := fintype.of_finite α, simp [fintype.card_eq_zero_iff] } + +/-- If `f` is injective, then `nat.card α ≤ nat.card β`. We must also assume + `nat.card β = 0 → nat.card α = 0` since `nat.card` is defined to be `0` for infinite types. -/ +lemma card_le_of_injective' {f : α → β} (hf : function.injective f) + (h : nat.card β = 0 → nat.card α = 0) : nat.card α ≤ nat.card β := +(or_not_of_imp h).cases_on (λ h, le_of_eq_of_le h zero_le') + (λ h, @card_le_of_injective α β (nat.finite_of_card_ne_zero h) f hf) + +/-- If `f` is an embedding, then `nat.card α ≤ nat.card β`. We must also assume + `nat.card β = 0 → nat.card α = 0` since `nat.card` is defined to be `0` for infinite types. -/ +lemma card_le_of_embedding' (f : α ↪ β) (h : nat.card β = 0 → nat.card α = 0) : + nat.card α ≤ nat.card β := +card_le_of_injective' f.2 h + +/-- If `f` is surjective, then `nat.card β ≤ nat.card α`. We must also assume + `nat.card α = 0 → nat.card β = 0` since `nat.card` is defined to be `0` for infinite types. -/ +lemma card_le_of_surjective' {f : α → β} (hf : function.surjective f) + (h : nat.card α = 0 → nat.card β = 0) : nat.card β ≤ nat.card α := +(or_not_of_imp h).cases_on (λ h, le_of_eq_of_le h zero_le') + (λ h, @card_le_of_surjective α β (nat.finite_of_card_ne_zero h) f hf) + +/-- NB: `nat.card` is defined to be `0` for infinite types. -/ +lemma card_eq_zero_of_surjective {f : α → β} (hf : function.surjective f) (h : nat.card β = 0) : + nat.card α = 0 := +begin + casesI finite_or_infinite β, + { haveI := card_eq_zero_iff.mp h, + haveI := function.is_empty f, + exact nat.card_of_is_empty }, + { haveI := infinite.of_surjective f hf, + exact nat.card_eq_zero_of_infinite }, +end + +/-- NB: `nat.card` is defined to be `0` for infinite types. -/ +lemma card_eq_zero_of_injective [nonempty α] {f : α → β} (hf : function.injective f) + (h : nat.card α = 0) : nat.card β = 0 := +card_eq_zero_of_surjective (function.inv_fun_surjective hf) h + +/-- NB: `nat.card` is defined to be `0` for infinite types. -/ +lemma card_eq_zero_of_embedding [nonempty α] (f : α ↪ β) (h : nat.card α = 0) : nat.card β = 0 := +card_eq_zero_of_injective f.2 h + +lemma card_sum [finite α] [finite β] : nat.card (α ⊕ β) = nat.card α + nat.card β := +by { haveI := fintype.of_finite α, haveI := fintype.of_finite β, simp } + +lemma card_image_le {s : set α} [finite s] (f : α → β) : nat.card (f '' s) ≤ nat.card s := +card_le_of_surjective _ set.surjective_onto_image + +lemma card_range_le [finite α] (f : α → β) : nat.card (set.range f) ≤ nat.card α := +card_le_of_surjective _ set.surjective_onto_range + +theorem card_subtype_le [finite α] (p : α → Prop) : + nat.card {x // p x} ≤ nat.card α := +by { haveI := fintype.of_finite α, simpa using fintype.card_subtype_le p } + +theorem card_subtype_lt [finite α] {p : α → Prop} {x : α} (hx : ¬ p x) : + nat.card {x // p x} < nat.card α := +by { haveI := fintype.of_finite α, simpa using fintype.card_subtype_lt hx } + +end finite + +namespace part_enat + +lemma card_eq_coe_nat_card (α : Type*) [finite α] : card α = nat.card α := +begin + unfold part_enat.card, + apply symm, + rw cardinal.coe_nat_eq_to_part_enat_iff, + exact finite.cast_card_eq_mk , +end + +end part_enat + +namespace set + +lemma card_union_le (s t : set α) : nat.card ↥(s ∪ t) ≤ nat.card s + nat.card t := +begin + casesI _root_.finite_or_infinite ↥(s ∪ t) with h h, + { rw [finite_coe_iff, finite_union, ←finite_coe_iff, ←finite_coe_iff] at h, + casesI h, + rw [←cardinal.nat_cast_le, nat.cast_add, + finite.cast_card_eq_mk, finite.cast_card_eq_mk, finite.cast_card_eq_mk], + exact cardinal.mk_union_le s t }, + { exact nat.card_eq_zero_of_infinite.trans_le (zero_le _) }, +end + +end set diff --git a/src/data/finite/defs.lean b/src/data/finite/defs.lean new file mode 100644 index 0000000000000..9c6ecfee5479a --- /dev/null +++ b/src/data/finite/defs.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import logic.equiv.basic + +/-! +# Definition of the `finite` typeclass + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines a typeclass `finite` saying that `α : Sort*` is finite. A type is `finite` if it +is equivalent to `fin n` for some `n`. We also define `infinite α` as a typeclass equivalent to +`¬finite α`. + +The `finite` predicate has no computational relevance and, being `Prop`-valued, gets to enjoy proof +irrelevance -- it represents the mere fact that the type is finite. While the `fintype` class also +represents finiteness of a type, a key difference is that a `fintype` instance represents finiteness +in a computable way: it gives a concrete algorithm to produce a `finset` whose elements enumerate +the terms of the given type. As such, one generally relies on congruence lemmas when rewriting +expressions involving `fintype` instances. + +Every `fintype` instance automatically gives a `finite` instance, see `fintype.finite`, but not vice +versa. Every `fintype` instance should be computable since they are meant for computation. If it's +not possible to write a computable `fintype` instance, one should prefer writing a `finite` instance +instead. + +## Main definitions + +* `finite α` denotes that `α` is a finite type. +* `infinite α` denotes that `α` is an infinite type. + +## Implementation notes + +The definition of `finite α` is not just `nonempty (fintype α)` since `fintype` requires +that `α : Type*`, and the definition in this module allows for `α : Sort*`. This means +we can write the instance `finite.prop`. + +## Tags + +finite, fintype +-/ + +universes u v +open function +variables {α β : Sort*} + +/-- A type is `finite` if it is in bijective correspondence to some +`fin n`. + +While this could be defined as `nonempty (fintype α)`, it is defined +in this way to allow there to be `finite` instances for propositions. +-/ +class inductive finite (α : Sort*) : Prop +| intro {n : ℕ} : α ≃ fin n → finite + +lemma finite_iff_exists_equiv_fin {α : Sort*} : finite α ↔ ∃ n, nonempty (α ≃ fin n) := +⟨λ ⟨e⟩, ⟨_, ⟨e⟩⟩, λ ⟨n, ⟨e⟩⟩, ⟨e⟩⟩ + +lemma finite.exists_equiv_fin (α : Sort*) [h : finite α] : ∃ (n : ℕ), nonempty (α ≃ fin n) := +finite_iff_exists_equiv_fin.mp h + +lemma finite.of_equiv (α : Sort*) [h : finite α] (f : α ≃ β) : finite β := +by { casesI h with n e, exact finite.intro (f.symm.trans e) } + +lemma equiv.finite_iff (f : α ≃ β) : finite α ↔ finite β := +⟨λ _, by exactI finite.of_equiv _ f, λ _, by exactI finite.of_equiv _ f.symm⟩ + +lemma function.bijective.finite_iff {f : α → β} (h : bijective f) : finite α ↔ finite β := +(equiv.of_bijective f h).finite_iff + +lemma finite.of_bijective [finite α] {f : α → β} (h : bijective f) : finite β := h.finite_iff.mp ‹_› + +instance [finite α] : finite (plift α) := finite.of_equiv α equiv.plift.symm +instance {α : Type v} [finite α] : finite (ulift.{u} α) := finite.of_equiv α equiv.ulift.symm + +/-- A type is said to be infinite if it is not finite. Note that `infinite α` is equivalent to +`is_empty (fintype α)` or `is_empty (finite α)`. -/ +class infinite (α : Sort*) : Prop := +(not_finite : ¬finite α) + +@[simp] lemma not_finite_iff_infinite : ¬finite α ↔ infinite α := ⟨infinite.mk, λ h, h.1⟩ + +@[simp] lemma not_infinite_iff_finite : ¬infinite α ↔ finite α := +not_finite_iff_infinite.not_right.symm + +lemma equiv.infinite_iff (e : α ≃ β) : infinite α ↔ infinite β := +not_finite_iff_infinite.symm.trans $ e.finite_iff.not.trans not_finite_iff_infinite + +instance [infinite α] : infinite (plift α) := equiv.plift.infinite_iff.2 ‹_› +instance {α : Type v} [infinite α] : infinite (ulift.{u} α) := equiv.ulift.infinite_iff.2 ‹_› + +lemma finite_or_infinite (α : Sort*) : finite α ∨ infinite α := +or_iff_not_imp_left.2 $ not_finite_iff_infinite.1 + +lemma not_finite (α : Sort*) [infinite α] [finite α] : false := @infinite.not_finite α ‹_› ‹_› + +protected lemma finite.false [infinite α] (h : finite α) : false := not_finite α +protected lemma infinite.false [finite α] (h : infinite α) : false := not_finite α + +alias not_infinite_iff_finite ↔ finite.of_not_infinite finite.not_infinite diff --git a/src/data/finite/set.lean b/src/data/finite/set.lean new file mode 100644 index 0000000000000..9436d239c7d16 --- /dev/null +++ b/src/data/finite/set.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import data.fintype.card + +/-! +# Lemmas about `finite` and `set`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove two lemmas about `finite` and `set`s. + +## Tags + +finiteness, finite sets +-/ + +open set + +universes u v w x +variables {α : Type u} {β : Type v} {ι : Sort w} + +lemma finite.set.finite_of_finite_image (s : set α) + {f : α → β} (h : s.inj_on f) [finite (f '' s)] : finite s := +finite.of_equiv _ (equiv.of_bijective _ h.bij_on_image.bijective).symm + +lemma finite.of_injective_finite_range {f : ι → α} + (hf : function.injective f) [finite (range f)] : finite ι := +finite.of_injective (set.range_factorization f) (hf.cod_restrict _) diff --git a/src/data/finmap.lean b/src/data/finmap.lean index 7b064236817dc..0518cbb1a88c7 100644 --- a/src/data/finmap.lean +++ b/src/data/finmap.lean @@ -4,10 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Sean Leather, Mario Carneiro -/ import data.list.alist -import data.finset.basic +import data.finset.sigma import data.part /-! # Finite maps over `multiset` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v w @@ -32,6 +35,14 @@ quot.lift_on s list.nodupkeys (λ s t p, propext $ perm_nodupkeys p) @[simp] theorem coe_nodupkeys {l : list (sigma β)} : @nodupkeys α β l ↔ l.nodupkeys := iff.rfl +lemma nodup_keys {m : multiset (Σ a, β a)} : m.keys.nodup ↔ m.nodupkeys := +by { rcases m with ⟨l⟩, refl } + +alias nodup_keys ↔ _ nodupkeys.nodup_keys + +lemma nodupkeys.nodup {m : multiset (Σ a, β a)} (h : m.nodupkeys) : m.nodup := +h.nodup_keys.of_map _ + end multiset /-! ### finmap -/ @@ -45,7 +56,7 @@ structure finmap (β : α → Type v) : Type (max u v) := /-- The quotient map from `alist` to `finmap`. -/ def alist.to_finmap (s : alist β) : finmap β := ⟨s.entries, s.nodupkeys⟩ -local notation `⟦`:max a `⟧`:0 := alist.to_finmap a +local notation (name := to_finmap) `⟦`:max a `⟧`:0 := alist.to_finmap a theorem alist.to_finmap_eq {s₁ s₂ : alist β} : ⟦s₁⟧ = ⟦s₂⟧ ↔ s₁.entries ~ s₂.entries := @@ -60,6 +71,8 @@ def list.to_finmap [decidable_eq α] (s : list (sigma β)) : finmap β := s.to_a namespace finmap open alist +lemma nodup_entries (f : finmap β) : f.entries.nodup := f.nodupkeys.nodup + /-! ### lifting from alist -/ /-- Lift a permutation-respecting function on `alist` to `finmap`. -/ @@ -126,7 +139,7 @@ theorem mem_def {a : α} {s : finmap β} : /-- The set of keys of a finite map. -/ def keys (s : finmap β) : finset α := -⟨s.entries.keys, induction_on s keys_nodup⟩ +⟨s.entries.keys, s.nodupkeys.nodup_keys⟩ @[simp] theorem keys_val (s : alist β) : (keys ⟦s⟧).val = s.keys := rfl @@ -194,6 +207,23 @@ induction_on s $ λ s, alist.lookup_is_some theorem lookup_eq_none {a} {s : finmap β} : lookup a s = none ↔ a ∉ s := induction_on s $ λ s, alist.lookup_eq_none +lemma mem_lookup_iff {f : finmap β} {a : α} {b : β a} : + b ∈ f.lookup a ↔ sigma.mk a b ∈ f.entries := +by { rcases f with ⟨⟨l⟩, hl⟩, exact list.mem_lookup_iff hl } + +/-- A version of `finmap.mem_lookup_iff` with LHS in the simp-normal form. -/ +lemma lookup_eq_some_iff {f : finmap β} {a : α} {b : β a} : + f.lookup a = some b ↔ sigma.mk a b ∈ f.entries := +mem_lookup_iff + +@[simp] lemma sigma_keys_lookup (f : finmap β) : + f.keys.sigma (λ i, (f.lookup i).to_finset) = ⟨f.entries, f.nodup_entries⟩ := +begin + ext x, + have : x ∈ f.entries → x.fst ∈ f.keys, from multiset.mem_map_of_mem _, + simpa [lookup_eq_some_iff] +end + @[simp] lemma lookup_singleton_eq {a : α} {b : β a} : (singleton a b).lookup a = some b := by rw [singleton, lookup_to_finmap, alist.singleton, alist.lookup, lookup_cons_eq] @@ -203,7 +233,7 @@ decidable_of_iff _ lookup_is_some lemma mem_iff {a : α} {s : finmap β} : a ∈ s ↔ ∃ b, s.lookup a = some b := induction_on s $ λ s, iff.trans list.mem_keys $ exists_congr $ λ b, -(mem_lookup_iff s.nodupkeys).symm +(list.mem_lookup_iff s.nodupkeys).symm lemma mem_of_lookup_eq_some {a : α} {b : β a} {s : finmap β} (h : s.lookup a = some b) : a ∈ s := mem_iff.mpr ⟨_, h⟩ @@ -218,6 +248,46 @@ begin rw h, end +/-- An equivalence between `finmap β` and pairs `(keys : finset α, lookup : Π a, option (β a))` such +that `(lookup a).is_some ↔ a ∈ keys`. -/ +@[simps apply_coe_fst apply_coe_snd] +def keys_lookup_equiv : + finmap β ≃ {f : finset α × (Π a, option (β a)) // ∀ i, (f.2 i).is_some ↔ i ∈ f.1} := +{ to_fun := λ f, ⟨(f.keys, λ i, f.lookup i), λ i, lookup_is_some⟩, + inv_fun := λ f, ⟨(f.1.1.sigma $ λ i, (f.1.2 i).to_finset).val, + begin + refine multiset.nodup_keys.1 ((finset.nodup _).map_on _), + simp only [finset.mem_val, finset.mem_sigma, option.mem_to_finset, option.mem_def], + rintro ⟨i, x⟩ ⟨hi, hx⟩ ⟨j, y⟩ ⟨hj, hy⟩ (rfl : i = j), + obtain rfl : x = y, from option.some.inj (hx.symm.trans hy), + refl + end⟩, + left_inv := λ f, ext $ by simp, + right_inv := λ ⟨⟨s, f⟩, hf⟩, + begin + ext : 2; dsimp [keys], + { ext1 i, + have : i ∈ s → (∃ x, f i = some x), + from λ hi, ⟨option.get _, option.get_mem $ (hf i).2 hi⟩, + simpa [multiset.keys] }, + { ext i x : 2, + simp only [option.mem_def, lookup_eq_some_iff, finset.mem_val, finset.mem_sigma, + option.mem_to_finset, and_iff_right_iff_imp, ← hf], + exact λ h, option.is_some_iff_exists.2 ⟨_, h⟩ } + end } + +@[simp] lemma keys_lookup_equiv_symm_apply_keys : + ∀ f : {f : finset α × (Π a, option (β a)) // ∀ i, (f.2 i).is_some ↔ i ∈ f.1}, + (keys_lookup_equiv.symm f).keys = (f : finset α × Π a, option (β a)).1 := +keys_lookup_equiv.surjective.forall.2 $ λ f, + by simp only [equiv.symm_apply_apply, keys_lookup_equiv_apply_coe_fst] + +@[simp] lemma keys_lookup_equiv_symm_apply_lookup : + ∀ (f : {f : finset α × (Π a, option (β a)) // ∀ i, (f.2 i).is_some ↔ i ∈ f.1}) a, + (keys_lookup_equiv.symm f).lookup a = (f : finset α × Π a, option (β a)).2 a := +keys_lookup_equiv.surjective.forall.2 $ λ f a, + by simp only [equiv.symm_apply_apply, keys_lookup_equiv_apply_coe_snd] + /-! ### replace -/ /-- Replace a key with a given value in a finite map. @@ -249,11 +319,11 @@ m.entries.foldl (λ d s, f d s.1 s.2) (λ d s t, H _ _ _ _ _) d /-- `any f s` returns `tt` iff there exists a value `v` in `s` such that `f v = tt`. -/ def any (f : Π x, β x → bool) (s : finmap β) : bool := -s.foldl (λ x y z, x ∨ f y z) (by { intros, simp [or.right_comm] }) ff +s.foldl (λ x y z, x || f y z) (by { intros, simp_rw [bool.bor_assoc, bool.bor_comm] }) ff /-- `all f s` returns `tt` iff `f v = tt` for all values `v` in `s`. -/ def all (f : Π x, β x → bool) (s : finmap β) : bool := -s.foldl (λ x y z, x ∧ f y z) (by { intros, simp [and.right_comm] }) ff +s.foldl (λ x y z, x && f y z) (by { intros, simp_rw [bool.band_assoc, bool.band_comm] }) tt /-! ### erase -/ @@ -352,7 +422,7 @@ by { induction xs with x xs; [skip, cases x]; exists_false, mem_cons_iff, mem_insert, exists_and_distrib_left]; apply or_congr _ iff.rfl, conv { to_lhs, rw ← and_true (a = x_fst) }, - apply and_congr_right, rintro ⟨⟩, simp only [exists_eq, iff_self, heq_iff_eq] } + apply and_congr_right, rintro ⟨⟩, simp only [exists_eq, heq_iff_eq] } @[simp] theorem insert_singleton_eq {a : α} {b b' : β a} : insert a b (singleton a b') = singleton a b := diff --git a/src/data/finset/basic.lean b/src/data/finset/basic.lean index f918904435070..9bb6c39eb6a06 100644 --- a/src/data/finset/basic.lean +++ b/src/data/finset/basic.lean @@ -3,15 +3,17 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Minchao Wu, Mario Carneiro -/ -import data.int.basic import data.multiset.finset_ops import tactic.apply -import tactic.monotonicity import tactic.nth_rewrite +import tactic.monotonicity /-! # Finite sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Terms of type `finset α` are one way of talking about finite subsets of `α` in mathlib. Below, `finset α` is defined as a structure with 2 fields: @@ -69,8 +71,6 @@ and the empty finset otherwise. See `data.fintype.basic`. ### Finsets from functions -* `finset.image`: Given a function `f : α → β`, `s.image f` is the image finset in `β`. -* `finset.map`: Given an embedding `f : α ↪ β`, `s.map f` is the image finset in `β`. * `finset.filter`: Given a predicate `p : α → Prop`, `s.filter p` is the finset consisting of those elements in `s` satisfying the predicate `p`. @@ -141,13 +141,18 @@ structure finset (α : Type*) := (val : multiset α) (nodup : nodup val) +instance multiset.can_lift_finset {α} : + can_lift (multiset α) (finset α) finset.val multiset.nodup := +⟨λ m hm, ⟨⟨m, hm⟩, rfl⟩⟩ + namespace finset theorem eq_of_veq : ∀ {s t : finset α}, s.1 = t.1 → s = t | ⟨s, _⟩ ⟨t, _⟩ rfl := rfl -@[simp] theorem val_inj {s t : finset α} : s.1 = t.1 ↔ s = t := -⟨eq_of_veq, congr_arg _⟩ +theorem val_injective : injective (val : finset α → multiset α) := λ _ _, eq_of_veq + +@[simp] theorem val_inj {s t : finset α} : s.1 = t.1 ↔ s = t := val_injective.eq_iff @[simp] theorem dedup_eq_self [decidable_eq α] (s : finset α) : dedup s.1 = s.1 := s.2.dedup @@ -160,6 +165,7 @@ instance has_decidable_eq [decidable_eq α] : decidable_eq (finset α) instance : has_mem α (finset α) := ⟨λ a s, a ∈ s.1⟩ theorem mem_def {a : α} {s : finset α} : a ∈ s ↔ a ∈ s.1 := iff.rfl +@[simp] lemma mem_val {a : α} {s : finset α} : a ∈ s.1 ↔ a ∈ s := iff.rfl @[simp] theorem mem_mk {a : α} {s nd} : a ∈ @finset.mk α s nd ↔ a ∈ s := iff.rfl @@ -203,20 +209,23 @@ lemma coe_injective {α} : injective (coe : finset α → set α) := /-- Coercion from a finset to the corresponding subtype. -/ instance {α : Type u} : has_coe_to_sort (finset α) (Type u) := ⟨λ s, {x // x ∈ s}⟩ +@[simp] protected lemma forall_coe {α : Type*} (s : finset α) (p : s → Prop) : + (∀ (x : s), p x) ↔ ∀ (x : α) (h : x ∈ s), p ⟨x, h⟩ := subtype.forall + +@[simp] protected lemma exists_coe {α : Type*} (s : finset α) (p : s → Prop) : + (∃ (x : s), p x) ↔ ∃ (x : α) (h : x ∈ s), p ⟨x, h⟩ := subtype.exists + instance pi_finset_coe.can_lift (ι : Type*) (α : Π i : ι, Type*) [ne : Π i, nonempty (α i)] (s : finset ι) : -can_lift (Π i : s, α i) (Π i, α i) := -{ coe := λ f i, f i, - .. pi_subtype.can_lift ι α (∈ s) } + can_lift (Π i : s, α i) (Π i, α i) (λ f i, f i) (λ _, true) := +pi_subtype.can_lift ι α (∈ s) instance pi_finset_coe.can_lift' (ι α : Type*) [ne : nonempty α] (s : finset ι) : - can_lift (s → α) (ι → α) := + can_lift (s → α) (ι → α) (λ f i, f i) (λ _, true) := pi_finset_coe.can_lift ι (λ _, α) s -instance finset_coe.can_lift (s : finset α) : can_lift α s := -{ coe := coe, - cond := λ a, a ∈ s, - prf := λ a ha, ⟨⟨a, ha⟩, rfl⟩ } +instance finset_coe.can_lift (s : finset α) : can_lift α s coe (λ a, a ∈ s) := +{ prf := λ a ha, ⟨⟨a, ha⟩, rfl⟩ } @[simp, norm_cast] lemma coe_sort_coe (s : finset α) : ((s : set α) : Sort*) = s := rfl @@ -274,8 +283,7 @@ theorem subset_iff {s₁ s₂ : finset α} : s₁ ⊆ s₂ ↔ ∀ ⦃x⦄, x theorem subset.antisymm_iff {s₁ s₂ : finset α} : s₁ = s₂ ↔ s₁ ⊆ s₂ ∧ s₂ ⊆ s₁ := le_antisymm_iff -theorem not_subset (s t : finset α) : ¬(s ⊆ t) ↔ ∃ x ∈ s, ¬(x ∈ t) := -by simp only [←finset.coe_subset, set.not_subset, exists_prop, finset.mem_coe] +lemma not_subset : ¬ s ⊆ t ↔ ∃ x ∈ s, x ∉ t := by simp only [←coe_subset, set.not_subset, mem_coe] @[simp] theorem le_eq_subset : ((≤) : finset α → finset α → Prop) = (⊆) := rfl @[simp] theorem lt_eq_subset : ((<) : finset α → finset α → Prop) = (⊂) := rfl @@ -308,6 +316,11 @@ lemma exists_of_ssubset {s₁ s₂ : finset α} (h : s₁ ⊂ s₂) : ∃ x ∈ s₂, x ∉ s₁ := set.exists_of_ssubset h +instance is_well_founded_ssubset : is_well_founded (finset α) (⊂) := +subrelation.is_well_founded (inv_image _ _) $ λ _ _, val_lt_iff.2 + +instance is_well_founded_lt : well_founded_lt (finset α) := finset.is_well_founded_ssubset + end subset -- TODO: these should be global attributes, but this will require fixing other files @@ -325,15 +338,19 @@ def coe_emb : finset α ↪o set α := ⟨⟨coe, coe_injective⟩, λ s t, coe_ /-- The property `s.nonempty` expresses the fact that the finset `s` is not empty. It should be used in theorem assumptions instead of `∃ x, x ∈ s` or `s ≠ ∅` as it gives access to a nice API thanks to the dot notation. -/ -protected def nonempty (s : finset α) : Prop := ∃ x:α, x ∈ s +protected def nonempty (s : finset α) : Prop := ∃ x : α, x ∈ s + +instance decidable_nonempty {s : finset α} : decidable s.nonempty := +decidable_of_iff (∃ a ∈ s, true) $ by simp_rw [exists_prop, and_true, finset.nonempty] -@[simp, norm_cast] lemma coe_nonempty {s : finset α} : (s:set α).nonempty ↔ s.nonempty := iff.rfl +@[simp, norm_cast] lemma coe_nonempty {s : finset α} : (s : set α).nonempty ↔ s.nonempty := iff.rfl -@[simp] lemma nonempty_coe_sort (s : finset α) : nonempty ↥s ↔ s.nonempty := nonempty_subtype +@[simp] lemma nonempty_coe_sort {s : finset α} : nonempty ↥s ↔ s.nonempty := nonempty_subtype -alias coe_nonempty ↔ _ finset.nonempty.to_set +alias coe_nonempty ↔ _ nonempty.to_set +alias nonempty_coe_sort ↔ _ nonempty.coe_sort -lemma nonempty.bex {s : finset α} (h : s.nonempty) : ∃ x:α, x ∈ s := h +lemma nonempty.bex {s : finset α} (h : s.nonempty) : ∃ x : α, x ∈ s := h lemma nonempty.mono {s t : finset α} (hst : s ⊆ t) (hs : s.nonempty) : t.nonempty := set.nonempty.mono hst hs @@ -341,8 +358,14 @@ set.nonempty.mono hst hs lemma nonempty.forall_const {s : finset α} (h : s.nonempty) {p : Prop} : (∀ x ∈ s, p) ↔ p := let ⟨x, hx⟩ := h in ⟨λ h, h x hx, λ h x hx, h⟩ +lemma nonempty.to_subtype {s : finset α} : s.nonempty → nonempty s := nonempty_coe_sort.2 +lemma nonempty.to_type {s : finset α} : s.nonempty → nonempty α := λ ⟨x, hx⟩, ⟨x⟩ + /-! ### empty -/ +section empty +variables {s : finset α} + /-- The empty finset -/ protected def empty : finset α := ⟨0, nodup_zero⟩ @@ -397,11 +420,32 @@ classical.by_cases or.inl (λ h, or.inr (nonempty_of_ne_empty h)) @[simp, norm_cast] lemma coe_eq_empty {s : finset α} : (s : set α) = ∅ ↔ s = ∅ := by rw [← coe_empty, coe_inj] +@[simp] lemma is_empty_coe_sort {s : finset α} : is_empty ↥s ↔ s = ∅ := +by simpa using @set.is_empty_coe_sort α s + +instance : is_empty (∅ : finset α) := is_empty_coe_sort.2 rfl + /-- A `finset` for an empty type is empty. -/ lemma eq_empty_of_is_empty [is_empty α] (s : finset α) : s = ∅ := finset.eq_empty_of_forall_not_mem is_empty_elim +instance : order_bot (finset α) := +{ bot := ∅, bot_le := empty_subset } + +@[simp] lemma bot_eq_empty : (⊥ : finset α) = ∅ := rfl + +@[simp] lemma empty_ssubset : ∅ ⊂ s ↔ s.nonempty := +(@bot_lt_iff_ne_bot (finset α) _ _ _).trans nonempty_iff_ne_empty.symm + +alias empty_ssubset ↔ _ nonempty.empty_ssubset + +end empty + /-! ### singleton -/ + +section singleton +variables {s : finset α} {a b : α} + /-- `{a} : finset a` is the set `{a}` containing `a` and nothing else. @@ -419,22 +463,25 @@ theorem not_mem_singleton {a b : α} : a ∉ ({b} : finset α) ↔ a ≠ b := no theorem mem_singleton_self (a : α) : a ∈ ({a} : finset α) := or.inl rfl +@[simp] lemma val_eq_singleton_iff {a : α} {s : finset α} : s.val = {a} ↔ s = {a} := +by { rw ←val_inj, refl } + lemma singleton_injective : injective (singleton : α → finset α) := λ a b h, mem_singleton.1 (h ▸ mem_singleton_self _) -theorem singleton_inj {a b : α} : ({a} : finset α) = {b} ↔ a = b := -singleton_injective.eq_iff +@[simp] lemma singleton_inj : ({a} : finset α) = {b} ↔ a = b := singleton_injective.eq_iff @[simp] theorem singleton_nonempty (a : α) : ({a} : finset α).nonempty := ⟨a, mem_singleton_self a⟩ @[simp] theorem singleton_ne_empty (a : α) : ({a} : finset α) ≠ ∅ := (singleton_nonempty a).ne_empty +lemma empty_ssubset_singleton : (∅ : finset α) ⊂ {a} := (singleton_nonempty _).empty_ssubset + @[simp, norm_cast] lemma coe_singleton (a : α) : (({a} : finset α) : set α) = {a} := by { ext, simp } -@[simp, norm_cast] lemma coe_eq_singleton {α : Type*} {s : finset α} {a : α} : - (s : set α) = {a} ↔ s = {a} := -by rw [←finset.coe_singleton, finset.coe_inj] +@[simp, norm_cast] lemma coe_eq_singleton {s : finset α} {a : α} : (s : set α) = {a} ↔ s = {a} := +by rw [←coe_singleton, coe_inj] lemma eq_singleton_iff_unique_mem {s : finset α} {a : α} : s = {a} ↔ a ∈ s ∧ ∀ x ∈ s, x = a := @@ -455,6 +502,12 @@ begin rw ← h_uniq hne.some hne.some_spec, exact hne.some_spec } end +lemma nonempty_iff_eq_singleton_default [unique α] {s : finset α} : + s.nonempty ↔ s = {default} := +by simp [eq_singleton_iff_nonempty_unique_mem] + +alias nonempty_iff_eq_singleton_default ↔ nonempty.eq_singleton_default _ + lemma singleton_iff_unique_mem (s : finset α) : (∃ a, s = {a}) ↔ ∃! a, a ∈ s := by simp only [eq_singleton_iff_unique_mem, exists_unique] @@ -465,15 +518,13 @@ by rw [coe_singleton, set.singleton_subset_iff] singleton_subset_set_iff @[simp] lemma subset_singleton_iff {s : finset α} {a : α} : s ⊆ {a} ↔ s = ∅ ∨ s = {a} := -begin - refine ⟨λ hs, s.eq_empty_or_nonempty.imp_right _, _⟩, - { rintro ⟨t, ht⟩, - apply subset.antisymm hs, - rwa [singleton_subset_iff, ←mem_singleton.1 (hs ht)] }, - rintro (rfl | rfl), - { exact empty_subset _ }, - exact subset.rfl, -end +by rw [←coe_subset, coe_singleton, set.subset_singleton_iff_eq, coe_eq_empty, coe_eq_singleton] + +lemma singleton_subset_singleton : ({a} : finset α) ⊆ {b} ↔ a = b := by simp + +protected lemma nonempty.subset_singleton_iff {s : finset α} {a : α} (h : s.nonempty) : + s ⊆ {a} ↔ s = {a} := +subset_singleton_iff.trans $ or_iff_right h.ne_empty lemma subset_singleton_iff' {s : finset α} {a : α} : s ⊆ {a} ↔ ∀ b ∈ s, b = a := forall₂_congr $ λ _ _, mem_singleton @@ -485,6 +536,35 @@ by rw [←coe_ssubset, coe_singleton, set.ssubset_singleton_iff, coe_eq_empty] lemma eq_empty_of_ssubset_singleton {s : finset α} {x : α} (hs : s ⊂ {x}) : s = ∅ := ssubset_singleton_iff.1 hs +/-- A finset is nontrivial if it has at least two elements. -/ +@[reducible] protected def nontrivial (s : finset α) : Prop := (s : set α).nontrivial + +@[simp] lemma not_nontrivial_empty : ¬ (∅ : finset α).nontrivial := by simp [finset.nontrivial] + +@[simp] lemma not_nontrivial_singleton : ¬ ({a} : finset α).nontrivial := +by simp [finset.nontrivial] + +lemma nontrivial.ne_singleton (hs : s.nontrivial) : s ≠ {a} := +by { rintro rfl, exact not_nontrivial_singleton hs } + +lemma eq_singleton_or_nontrivial (ha : a ∈ s) : s = {a} ∨ s.nontrivial := +by { rw ←coe_eq_singleton, exact set.eq_singleton_or_nontrivial ha } + +lemma nontrivial_iff_ne_singleton (ha : a ∈ s) : s.nontrivial ↔ s ≠ {a} := +⟨nontrivial.ne_singleton, (eq_singleton_or_nontrivial ha).resolve_left⟩ + +lemma nonempty.exists_eq_singleton_or_nontrivial : s.nonempty → (∃ a, s = {a}) ∨ s.nontrivial := +λ ⟨a, ha⟩, (eq_singleton_or_nontrivial ha).imp_left $ exists.intro a + +instance nontrivial' [nonempty α] : nontrivial (finset α) := +‹nonempty α›.elim $ λ a, ⟨⟨{a}, ∅, singleton_ne_empty _⟩⟩ + +instance [is_empty α] : unique (finset α) := +{ default := ∅, + uniq := λ s, eq_empty_of_forall_not_mem is_empty_elim } + +end singleton + /-! ### cons -/ section cons @@ -503,14 +583,19 @@ lemma forall_mem_cons (h : a ∉ s) (p : α → Prop) : (∀ x, x ∈ cons a s h → p x) ↔ p a ∧ ∀ x, x ∈ s → p x := by simp only [mem_cons, or_imp_distrib, forall_and_distrib, forall_eq] +/-- Useful in proofs by induction. -/ +lemma forall_of_forall_cons {p : α → Prop} {h : a ∉ s} (H : ∀ x, x ∈ cons a s h → p x) (x) + (h : x ∈ s) : p x := H _ $ mem_cons.2 $ or.inr h + @[simp] lemma mk_cons {s : multiset α} (h : (a ::ₘ s).nodup) : (⟨a ::ₘ s, h⟩ : finset α) = cons a ⟨s, (nodup_cons.1 h).2⟩ (nodup_cons.1 h).1 := rfl +@[simp] lemma cons_empty (a : α) : cons a ∅ (not_mem_empty _) = {a} := rfl + @[simp] lemma nonempty_cons (h : a ∉ s) : (cons a s h).nonempty := ⟨a, mem_cons.2 $ or.inl rfl⟩ -@[simp] lemma nonempty_mk_coe : ∀ {l : list α} {hl}, (⟨↑l, hl⟩ : finset α).nonempty ↔ l ≠ [] -| [] hl := by simp -| (a :: l) hl := by simp [← multiset.cons_coe] +@[simp] lemma nonempty_mk {m : multiset α} {hm} : (⟨m, hm⟩ : finset α).nonempty ↔ m ≠ 0 := +by induction m using multiset.induction_on; simp @[simp] lemma coe_cons {a s h} : (@cons α a s h : set α) = insert a s := by { ext, simp } @@ -524,27 +609,98 @@ by rwa [← coe_subset, coe_cons, coe_cons, set.insert_subset_insert_iff, coe_su lemma ssubset_iff_exists_cons_subset : s ⊂ t ↔ ∃ a (h : a ∉ s), s.cons a h ⊆ t := begin refine ⟨λ h, _, λ ⟨a, ha, h⟩, ssubset_of_ssubset_of_subset (ssubset_cons _) h⟩, - obtain ⟨a, hs, ht⟩ := (not_subset _ _).1 h.2, + obtain ⟨a, hs, ht⟩ := not_subset.1 h.2, exact ⟨a, ht, cons_subset.2 ⟨hs, h.subset⟩⟩, end end cons +/-! ### disjoint -/ + +section disjoint +variables {f : α → β} {s t u : finset α} {a b : α} + +lemma disjoint_left : disjoint s t ↔ ∀ ⦃a⦄, a ∈ s → a ∉ t := +⟨λ h a hs ht, + singleton_subset_iff.mp (h (singleton_subset_iff.mpr hs) (singleton_subset_iff.mpr ht)), + λ h x hs ht a ha, h (hs ha) (ht ha)⟩ + +lemma disjoint_right : disjoint s t ↔ ∀ ⦃a⦄, a ∈ t → a ∉ s := by rw [disjoint.comm, disjoint_left] +lemma disjoint_iff_ne : disjoint s t ↔ ∀ a ∈ s, ∀ b ∈ t, a ≠ b := +by simp only [disjoint_left, imp_not_comm, forall_eq'] + +@[simp] lemma disjoint_val : s.1.disjoint t.1 ↔ disjoint s t := disjoint_left.symm + +lemma _root_.disjoint.forall_ne_finset (h : disjoint s t) (ha : a ∈ s) (hb : b ∈ t) : a ≠ b := +disjoint_iff_ne.1 h _ ha _ hb + +lemma not_disjoint_iff : ¬ disjoint s t ↔ ∃ a, a ∈ s ∧ a ∈ t := +disjoint_left.not.trans $ not_forall.trans $ exists_congr $ λ _, by rw [not_imp, not_not] + +lemma disjoint_of_subset_left (h : s ⊆ u) (d : disjoint u t) : disjoint s t := +disjoint_left.2 (λ x m₁, (disjoint_left.1 d) (h m₁)) + +lemma disjoint_of_subset_right (h : t ⊆ u) (d : disjoint s u) : disjoint s t := +disjoint_right.2 (λ x m₁, (disjoint_right.1 d) (h m₁)) + +@[simp] theorem disjoint_empty_left (s : finset α) : disjoint ∅ s := disjoint_bot_left +@[simp] theorem disjoint_empty_right (s : finset α) : disjoint s ∅ := disjoint_bot_right + +@[simp] lemma disjoint_singleton_left : disjoint (singleton a) s ↔ a ∉ s := +by simp only [disjoint_left, mem_singleton, forall_eq] + +@[simp] lemma disjoint_singleton_right : disjoint s (singleton a) ↔ a ∉ s := +disjoint.comm.trans disjoint_singleton_left + +@[simp] lemma disjoint_singleton : disjoint ({a} : finset α) {b} ↔ a ≠ b := +by rw [disjoint_singleton_left, mem_singleton] + +lemma disjoint_self_iff_empty (s : finset α) : disjoint s s ↔ s = ∅ := disjoint_self + +@[simp, norm_cast] lemma disjoint_coe : disjoint (s : set α) t ↔ disjoint s t := +by { rw [finset.disjoint_left, set.disjoint_left], refl } + +@[simp, norm_cast] lemma pairwise_disjoint_coe {ι : Type*} {s : set ι} {f : ι → finset α} : + s.pairwise_disjoint (λ i, f i : ι → set α) ↔ s.pairwise_disjoint f := +forall₅_congr $ λ _ _ _ _ _, disjoint_coe + +end disjoint + /-! ### disjoint union -/ /-- `disj_union s t h` is the set such that `a ∈ disj_union s t h` iff `a ∈ s` or `a ∈ t`. It is the same as `s ∪ t`, but it does not require decidable equality on the type. The hypothesis ensures that the sets are disjoint. -/ -def disj_union {α} (s t : finset α) (h : ∀ a ∈ s, a ∉ t) : finset α := -⟨s.1 + t.1, multiset.nodup_add.2 ⟨s.2, t.2, h⟩⟩ +def disj_union (s t : finset α) (h : disjoint s t) : finset α := +⟨s.1 + t.1, multiset.nodup_add.2 ⟨s.2, t.2, disjoint_val.2 h⟩⟩ @[simp] theorem mem_disj_union {α s t h a} : a ∈ @disj_union α s t h ↔ a ∈ s ∨ a ∈ t := by rcases s with ⟨⟨s⟩⟩; rcases t with ⟨⟨t⟩⟩; apply list.mem_append +lemma disj_union_comm (s t : finset α) (h : disjoint s t) : + disj_union s t h = disj_union t s h.symm := +eq_of_veq $ add_comm _ _ + +@[simp] lemma empty_disj_union (t : finset α) (h : disjoint ∅ t := disjoint_bot_left) : + disj_union ∅ t h = t := +eq_of_veq $ zero_add _ + +@[simp] lemma disj_union_empty (s : finset α) (h : disjoint s ∅ := disjoint_bot_right) : + disj_union s ∅ h = s := +eq_of_veq $ add_zero _ + +lemma singleton_disj_union (a : α) (t : finset α) (h : disjoint {a} t) : + disj_union {a} t h = cons a t (disjoint_singleton_left.mp h) := +eq_of_veq $ multiset.singleton_add _ _ + +lemma disj_union_singleton (s : finset α) (a : α) (h : disjoint s {a}) : + disj_union s {a} h = cons a s (disjoint_singleton_right.mp h) := +by rw [disj_union_comm, singleton_disj_union] + /-! ### insert -/ -section decidable_eq +section insert variables [decidable_eq α] {s t u v : finset α} {a b : α} /-- `insert a s` is the set `{a} ∪ s` containing `a` and the elements of `s`. -/ @@ -568,8 +724,7 @@ lemma mem_of_mem_insert_of_ne (h : b ∈ insert a s) : b ≠ a → b ∈ s := (m lemma eq_of_not_mem_of_mem_insert (ha : b ∈ insert a s) (hb : b ∉ s) : b = a := (mem_insert.1 ha).resolve_right hb -@[simp] theorem cons_eq_insert {α} [decidable_eq α] (a s h) : @cons α a s h = insert a s := -ext $ λ a, by simp +@[simp] theorem cons_eq_insert (a s h) : @cons α a s h = insert a s := ext $ λ a, by simp @[simp, norm_cast] lemma coe_insert (a : α) (s : finset α) : ↑(insert a s) = (insert a s : set α) := @@ -582,17 +737,24 @@ instance : is_lawful_singleton α (finset α) := ⟨λ a, by { ext, simp }⟩ @[simp] lemma insert_eq_of_mem (h : a ∈ s) : insert a s = s := eq_of_veq $ ndinsert_of_mem h -@[simp] theorem insert_singleton_self_eq (a : α) : ({a, a} : finset α) = {a} := +@[simp] lemma insert_eq_self : insert a s = s ↔ a ∈ s := +⟨λ h, h ▸ mem_insert_self _ _, insert_eq_of_mem⟩ + +lemma insert_ne_self : insert a s ≠ s ↔ a ∉ s := insert_eq_self.not + +@[simp] theorem pair_eq_singleton (a : α) : ({a, a} : finset α) = {a} := insert_eq_of_mem $ mem_singleton_self _ theorem insert.comm (a b : α) (s : finset α) : insert a (insert b s) = insert b (insert a s) := ext $ λ x, by simp only [mem_insert, or.left_comm] -theorem insert_singleton_comm (a b : α) : ({a, b} : finset α) = {b, a} := -begin - ext, - simp [or.comm] -end +@[simp, norm_cast] lemma coe_pair {a b : α} : + (({a, b} : finset α) : set α) = {a, b} := by { ext, simp } + +@[simp, norm_cast] lemma coe_eq_pair {s : finset α} {a b : α} : + (s : set α) = {a, b} ↔ s = {a, b} := by rw [←coe_pair, coe_inj] + +theorem pair_comm (a b : α) : ({a, b} : finset α) = {b, a} := insert.comm a b ∅ @[simp] theorem insert_idem (a : α) (s : finset α) : insert a (insert a s) = insert a s := ext $ λ x, by simp only [mem_insert, or.assoc.symm, or_self] @@ -633,9 +795,6 @@ by exact_mod_cast @set.ssubset_iff_insert α s t lemma ssubset_insert (h : a ∉ s) : s ⊂ insert a s := ssubset_iff.mpr ⟨a, h, subset.rfl⟩ -lemma ssubset_iff_exists_insert_subset {s t : finset α} : s ⊂ t ↔ ∃ a ∉ s, insert a s ⊆ t := -by simp_rw [ssubset_iff_exists_cons_subset, cons_eq_insert] - @[elab_as_eliminator] lemma cons_induction {α : Type*} {p : finset α → Prop} (h₁ : p ∅) (h₂ : ∀ ⦃a : α⦄ {s : finset α} (h : a ∉ s), p s → p (cons a s h)) : ∀ s, p s @@ -712,8 +871,19 @@ begin subtype.coe_mk] }, end +@[simp] lemma disjoint_insert_left : disjoint (insert a s) t ↔ a ∉ t ∧ disjoint s t := +by simp only [disjoint_left, mem_insert, or_imp_distrib, forall_and_distrib, forall_eq] + +@[simp] lemma disjoint_insert_right : disjoint s (insert a t) ↔ a ∉ s ∧ disjoint s t := +disjoint.comm.trans $ by rw [disjoint_insert_left, disjoint.comm] + +end insert + /-! ### Lattice structure -/ +section lattice +variables [decidable_eq α] {s s₁ s₂ t t₁ t₂ u v : finset α} {a b : α} + /-- `s ∪ t` is the set such that `a ∈ s ∪ t` iff `a ∈ s` or `a ∈ t`. -/ instance : has_union (finset α) := ⟨λ s t, ⟨_, t.2.ndunion s.1⟩⟩ @@ -731,11 +901,16 @@ instance : lattice (finset α) := inf_le_right := λ s t a h, (mem_ndinter.1 h).2, ..finset.partial_order } -/-! #### union -/ - @[simp] lemma sup_eq_union : ((⊔) : finset α → finset α → finset α) = (∪) := rfl @[simp] lemma inf_eq_inter : ((⊓) : finset α → finset α → finset α) = (∩) := rfl +lemma disjoint_iff_inter_eq_empty : disjoint s t ↔ s ∩ t = ∅ := disjoint_iff + +instance decidable_disjoint (U V : finset α) : decidable (disjoint U V) := +decidable_of_iff _ disjoint_left.symm + +/-! #### union -/ + lemma union_val_nd (s t : finset α) : (s ∪ t).1 = ndunion s.1 t.1 := rfl @[simp] lemma union_val (s t : finset α) : (s ∪ t).1 = s.1 ∪ t.1 := ndunion_eq_union s.2 @@ -762,6 +937,9 @@ theorem subset_union_right (s₁ s₂ : finset α) : s₂ ⊆ s₁ ∪ s₂ := lemma union_subset_union (hsu : s ⊆ u) (htv : t ⊆ v) : s ∪ t ⊆ u ∪ v := sup_le_sup (le_iff_subset.2 hsu) htv +lemma union_subset_union_left (h : s₁ ⊆ s₂) : s₁ ∪ t ⊆ s₂ ∪ t := union_subset_union h subset.rfl +lemma union_subset_union_right (h : t₁ ⊆ t₂) : s ∪ t₁ ⊆ s ∪ t₂ := union_subset_union subset.rfl h + lemma union_comm (s₁ s₂ : finset α) : s₁ ∪ s₂ = s₂ ∪ s₁ := sup_comm instance : is_commutative (finset α) (∪) := ⟨union_comm⟩ @@ -812,6 +990,18 @@ by rw [← union_eq_left_iff_subset, eq_comm] @[simp] lemma right_eq_union_iff_subset {s t : finset α} : s = t ∪ s ↔ t ⊆ s := by rw [← union_eq_right_iff_subset, eq_comm] +lemma union_congr_left (ht : t ⊆ s ∪ u) (hu : u ⊆ s ∪ t) : s ∪ t = s ⊔ u := sup_congr_left ht hu +lemma union_congr_right (hs : s ⊆ t ∪ u) (ht : t ⊆ s ∪ u) : s ∪ u = t ∪ u := sup_congr_right hs ht + +lemma union_eq_union_iff_left : s ∪ t = s ∪ u ↔ t ⊆ s ∪ u ∧ u ⊆ s ∪ t := sup_eq_sup_iff_left +lemma union_eq_union_iff_right : s ∪ u = t ∪ u ↔ s ⊆ t ∪ u ∧ t ⊆ s ∪ u := sup_eq_sup_iff_right + +@[simp] lemma disjoint_union_left : disjoint (s ∪ t) u ↔ disjoint s u ∧ disjoint t u := +by simp only [disjoint_left, mem_union, or_imp_distrib, forall_and_distrib] + +@[simp] lemma disjoint_union_right : disjoint s (t ∪ u) ↔ disjoint s t ∧ disjoint s u := +by simp only [disjoint_right, mem_union, or_imp_distrib, forall_and_distrib] + /-- To prove a relation on pairs of `finset X`, it suffices to show that it is * symmetric, @@ -860,7 +1050,7 @@ lemma _root_.directed_on.exists_mem_subset_of_finset_subset_bUnion {α ι : Type {s : finset α} (hs : (s : set α) ⊆ ⋃ i ∈ c, f i) : ∃ i ∈ c, (s : set α) ⊆ f i := begin rw set.bUnion_eq_Union at hs, - haveI := c.nonempty_coe_sort.2 hn, + haveI := hn.coe_sort, obtain ⟨⟨i, hic⟩, hi⟩ := (directed_comp.2 hc.directed_coe).exists_mem_subset_of_finset_subset_bUnion hs, exact ⟨i, hic, hi⟩ @@ -959,10 +1149,7 @@ end lemma inter_subset_inter_left (h : t ⊆ u) : s ∩ t ⊆ s ∩ u := inter_subset_inter subset.rfl h lemma inter_subset_inter_right (h : s ⊆ t) : s ∩ u ⊆ t ∩ u := inter_subset_inter h subset.rfl -instance {α : Type u} : order_bot (finset α) := -{ bot := ∅, bot_le := empty_subset } - -@[simp] lemma bot_eq_empty {α : Type u} : (⊥ : finset α) = ∅ := rfl +lemma inter_subset_union : s ∩ t ⊆ s ∪ t := le_iff_subset.1 inf_le_sup instance : distrib_lattice (finset α) := { le_sup_inf := assume a b c, show (a ∪ b) ∩ (a ∪ c) ⊆ a ∪ b ∩ c, @@ -985,13 +1172,37 @@ theorem union_distrib_left (s t u : finset α) : s ∪ (t ∩ u) = (s ∪ t) ∩ theorem union_distrib_right (s t u : finset α) : (s ∩ t) ∪ u = (s ∪ u) ∩ (t ∪ u) := sup_inf_right +lemma union_union_distrib_left (s t u : finset α) : s ∪ (t ∪ u) = (s ∪ t) ∪ (s ∪ u) := +sup_sup_distrib_left _ _ _ + +lemma union_union_distrib_right (s t u : finset α) : (s ∪ t) ∪ u = (s ∪ u) ∪ (t ∪ u) := +sup_sup_distrib_right _ _ _ + +lemma inter_inter_distrib_left (s t u : finset α) : s ∩ (t ∩ u) = (s ∩ t) ∩ (s ∩ u) := +inf_inf_distrib_left _ _ _ + +lemma inter_inter_distrib_right (s t u : finset α) : (s ∩ t) ∩ u = (s ∩ u) ∩ (t ∩ u) := +inf_inf_distrib_right _ _ _ + +lemma union_union_union_comm (s t u v : finset α) : (s ∪ t) ∪ (u ∪ v) = (s ∪ u) ∪ (t ∪ v) := +sup_sup_sup_comm _ _ _ _ + +lemma inter_inter_inter_comm (s t u v : finset α) : (s ∩ t) ∩ (u ∩ v) = (s ∩ u) ∩ (t ∩ v) := +inf_inf_inf_comm _ _ _ _ + lemma union_eq_empty_iff (A B : finset α) : A ∪ B = ∅ ↔ A = ∅ ∧ B = ∅ := sup_eq_bot_iff lemma union_subset_iff : s ∪ t ⊆ u ↔ s ⊆ u ∧ t ⊆ u := (sup_le_iff : s ⊔ t ≤ u ↔ s ≤ u ∧ t ≤ u) lemma subset_inter_iff : s ⊆ t ∩ u ↔ s ⊆ t ∧ s ⊆ u := (le_inf_iff : s ≤ t ⊓ u ↔ s ≤ t ∧ s ≤ u) -lemma inter_eq_left_iff_subset (s t : finset α) : s ∩ t = s ↔ s ⊆ t := inf_eq_left -lemma inter_eq_right_iff_subset (s t : finset α) : t ∩ s = s ↔ s ⊆ t := inf_eq_right +@[simp] lemma inter_eq_left_iff_subset (s t : finset α) : s ∩ t = s ↔ s ⊆ t := inf_eq_left +@[simp] lemma inter_eq_right_iff_subset (s t : finset α) : t ∩ s = s ↔ s ⊆ t := inf_eq_right + +lemma inter_congr_left (ht : s ∩ u ⊆ t) (hu : s ∩ t ⊆ u) : s ∩ t = s ∩ u := inf_congr_left ht hu +lemma inter_congr_right (hs : t ∩ u ⊆ s) (ht : s ∩ u ⊆ t) : s ∩ u = t ∩ u := inf_congr_right hs ht + +lemma inter_eq_inter_iff_left : s ∩ t = s ∩ u ↔ s ∩ u ⊆ t ∧ s ∩ t ⊆ u := inf_eq_inf_iff_left +lemma inter_eq_inter_iff_right : s ∩ u = t ∩ u ↔ t ∩ u ⊆ s ∧ s ∩ u ⊆ t := inf_eq_inf_iff_right lemma ite_subset_union (s s' : finset α) (P : Prop) [decidable P] : ite P s s' ⊆ s ∪ s' := ite_le_sup s s' P @@ -999,7 +1210,19 @@ lemma ite_subset_union (s s' : finset α) (P : Prop) [decidable P] : lemma inter_subset_ite (s s' : finset α) (P : Prop) [decidable P] : s ∩ s' ⊆ ite P s s' := inf_le_ite s s' P +lemma not_disjoint_iff_nonempty_inter : ¬disjoint s t ↔ (s ∩ t).nonempty := +not_disjoint_iff.trans $ by simp [finset.nonempty] + +alias not_disjoint_iff_nonempty_inter ↔ _ nonempty.not_disjoint + +lemma disjoint_or_nonempty_inter (s t : finset α) : disjoint s t ∨ (s ∩ t).nonempty := +by { rw ←not_disjoint_iff_nonempty_inter, exact em _ } + +end lattice + /-! ### erase -/ +section erase +variables [decidable_eq α] {s t u v : finset α} {a b : α} /-- `erase s a` is the set `s - {a}`, that is, the elements of `s` which are not equal to `a`. -/ @@ -1036,9 +1259,29 @@ begin exact not_imp_not.mp hsa hs end +@[simp] +theorem erase_eq_of_not_mem {a : α} {s : finset α} (h : a ∉ s) : erase s a = s := +eq_of_veq $ erase_of_not_mem h + +@[simp] lemma erase_eq_self : s.erase a = s ↔ a ∉ s := +⟨λ h, h ▸ not_mem_erase _ _, erase_eq_of_not_mem⟩ + +@[simp] lemma erase_insert_eq_erase (s : finset α) (a : α) : + (insert a s).erase a = s.erase a := +ext $ λ x, by simp only [mem_erase, mem_insert, and.congr_right_iff, false_or, iff_self, + implies_true_iff] { contextual := tt } + theorem erase_insert {a : α} {s : finset α} (h : a ∉ s) : erase (insert a s) a = s := -ext $ assume x, by simp only [mem_erase, mem_insert, and_or_distrib_left, not_and_self, false_or]; -apply and_iff_right_of_imp; rintro H rfl; exact h H +by rw [erase_insert_eq_erase, erase_eq_of_not_mem h] + +theorem erase_insert_of_ne {a b : α} {s : finset α} (h : a ≠ b) : + erase (insert a s) b = insert a (erase s b) := +ext $ λ x, have x ≠ b ∧ x = a ↔ x = a, from and_iff_right_of_imp (λ hx, hx.symm ▸ h), +by simp only [mem_erase, mem_insert, and_or_distrib_left, this] + +theorem erase_cons_of_ne {a b : α} {s : finset α} (ha : a ∉ s) (hb : a ≠ b) : + erase (cons a s ha) b = cons a (erase s b) (λ h, ha $ erase_subset _ _ h) := +by simp only [cons_eq_insert, erase_insert_of_ne hb] theorem insert_erase {a : α} {s : finset α} (h : a ∈ s) : insert a (erase s a) = s := ext $ assume x, by simp only [mem_insert, mem_erase, or_and_distrib_left, dec_em, true_and]; @@ -1063,17 +1306,17 @@ calc s.erase a ⊂ insert a (s.erase a) : ssubset_insert $ not_mem_erase _ _ lemma ssubset_iff_exists_subset_erase {s t : finset α} : s ⊂ t ↔ ∃ a ∈ t, s ⊆ t.erase a := begin refine ⟨λ h, _, λ ⟨a, ha, h⟩, ssubset_of_subset_of_ssubset h $ erase_ssubset ha⟩, - obtain ⟨a, ht, hs⟩ := (not_subset _ _).1 h.2, + obtain ⟨a, ht, hs⟩ := not_subset.1 h.2, exact ⟨a, ht, subset_erase.2 ⟨h.1, hs⟩⟩, end -@[simp] -theorem erase_eq_of_not_mem {a : α} {s : finset α} (h : a ∉ s) : erase s a = s := -eq_of_veq $ erase_of_not_mem h +lemma erase_ssubset_insert (s : finset α) (a : α) : s.erase a ⊂ insert a s := +ssubset_iff_exists_subset_erase.2 ⟨a, mem_insert_self _ _, erase_subset_erase _ $ subset_insert _ _⟩ -@[simp] lemma erase_insert_eq_erase (s : finset α) (a : α) : - (insert a s).erase a = s.erase a := -by by_cases ha : a ∈ s; { simp [ha, erase_insert] } +lemma erase_ne_self : s.erase a ≠ s ↔ a ∈ s := erase_eq_self.not_left + +lemma erase_cons {s : finset α} {a : α} (h : a ∉ s) : (s.cons a h).erase a = s := +by rw [cons_eq_insert, erase_insert_eq_erase, erase_eq_of_not_mem h] lemma erase_idem {a : α} {s : finset α} : erase (erase s a) a = erase s a := by simp @@ -1091,6 +1334,12 @@ subset_insert_iff.1 $ subset.rfl theorem insert_erase_subset (a : α) (s : finset α) : s ⊆ insert a (erase s a) := subset_insert_iff.2 $ subset.rfl +lemma subset_insert_iff_of_not_mem (h : a ∉ s) : s ⊆ insert a t ↔ s ⊆ t := +by rw [subset_insert_iff, erase_eq_of_not_mem h] + +lemma erase_subset_iff_of_mem (h : a ∈ t) : s.erase a ⊆ t ↔ s ⊆ t := +by rw [←subset_insert_iff, insert_eq_of_mem h] + lemma erase_inj {x y : α} (s : finset α) (hx : x ∈ s) : s.erase x = s.erase y ↔ x = y := begin refine ⟨λ h, _, congr_arg _⟩, @@ -1101,8 +1350,16 @@ end lemma erase_inj_on (s : finset α) : set.inj_on s.erase s := λ _ _ _ _, (erase_inj s ‹_›).mp +lemma erase_inj_on' (a : α) : {s : finset α | a ∈ s}.inj_on (λ s, erase s a) := +λ s hs t ht (h : s.erase a = _), by rw [←insert_erase hs, ←insert_erase ht, h] + +end erase + /-! ### sdiff -/ +section sdiff +variables [decidable_eq α] {s t u v : finset α} {a b : α} + /-- `s \ t` is the set consisting of the elements of `s` that are not in `t`. -/ instance : has_sdiff (finset α) := ⟨λs₁ s₂, ⟨s₁.1 - s₂.1, nodup_of_le tsub_le_self s₁.2⟩⟩ @@ -1137,12 +1394,15 @@ lemma inter_sdiff (s t u : finset α) : s ∩ (t \ u) = s ∩ t \ u := by { ext @[simp] lemma sdiff_inter_self (s₁ s₂ : finset α) : (s₂ \ s₁) ∩ s₁ = ∅ := inf_sdiff_self_left -@[simp] lemma sdiff_self (s₁ : finset α) : s₁ \ s₁ = ∅ := sdiff_self +@[simp] protected lemma sdiff_self (s₁ : finset α) : s₁ \ s₁ = ∅ := sdiff_self lemma sdiff_inter_distrib_right (s t u : finset α) : s \ (t ∩ u) = (s \ t) ∪ (s \ u) := sdiff_inf -@[simp] lemma sdiff_inter_self_left (s t : finset α) : s \ (s ∩ t) = s \ t := sdiff_inf_self_left -@[simp] lemma sdiff_inter_self_right (s t : finset α) : s \ (t ∩ s) = s \ t := sdiff_inf_self_right +@[simp] lemma sdiff_inter_self_left (s t : finset α) : s \ (s ∩ t) = s \ t := +sdiff_inf_self_left _ _ + +@[simp] lemma sdiff_inter_self_right (s t : finset α) : s \ (t ∩ s) = s \ t := +sdiff_inf_self_right _ _ @[simp] lemma sdiff_empty : s \ ∅ = s := sdiff_bot @@ -1152,17 +1412,24 @@ sdiff_le_sdiff ‹s ≤ t› ‹v ≤ u› @[simp, norm_cast] lemma coe_sdiff (s₁ s₂ : finset α) : ↑(s₁ \ s₂) = (s₁ \ s₂ : set α) := set.ext $ λ _, mem_sdiff -@[simp] theorem union_sdiff_self_eq_union : s ∪ (t \ s) = s ∪ t := sup_sdiff_self_right +@[simp] lemma union_sdiff_self_eq_union : s ∪ t \ s = s ∪ t := sup_sdiff_self_right _ _ +@[simp] lemma sdiff_union_self_eq_union : s \ t ∪ t = s ∪ t := sup_sdiff_self_left _ _ + +lemma union_sdiff_left (s t : finset α) : (s ∪ t) \ s = t \ s := sup_sdiff_left_self +lemma union_sdiff_right (s t : finset α) : (s ∪ t) \ t = s \ t := sup_sdiff_right_self -@[simp] theorem sdiff_union_self_eq_union : (s \ t) ∪ t = s ∪ t := sup_sdiff_self_left +lemma union_sdiff_cancel_left (h : disjoint s t) : (s ∪ t) \ s = t := h.sup_sdiff_cancel_left +lemma union_sdiff_cancel_right (h : disjoint s t) : (s ∪ t) \ t = s := h.sup_sdiff_cancel_right -lemma union_sdiff_symm : s ∪ (t \ s) = t ∪ (s \ t) := sup_sdiff_symm +lemma union_sdiff_symm : s ∪ (t \ s) = t ∪ (s \ t) := by simp [union_comm] lemma sdiff_union_inter (s t : finset α) : (s \ t) ∪ (s ∩ t) = s := sup_sdiff_inf _ _ @[simp] lemma sdiff_idem (s t : finset α) : s \ t \ t = s \ t := sdiff_idem -lemma sdiff_eq_empty_iff_subset : s \ t = ∅ ↔ s ⊆ t := sdiff_eq_bot_iff +lemma subset_sdiff : s ⊆ t \ u ↔ s ⊆ t ∧ disjoint s u := le_iff_subset.symm.trans le_sdiff + +@[simp] lemma sdiff_eq_empty_iff_subset : s \ t = ∅ ↔ s ⊆ t := sdiff_eq_bot_iff lemma sdiff_nonempty : (s \ t).nonempty ↔ ¬ s ⊆ t := nonempty_iff_ne_empty.trans sdiff_eq_empty_iff_subset.not @@ -1202,17 +1469,84 @@ lemma sdiff_union_distrib (s t₁ t₂ : finset α) : s \ (t₁ ∪ t₂) = (s \ lemma union_sdiff_self (s t : finset α) : (s ∪ t) \ t = s \ t := sup_sdiff_right_self +-- TODO: Do we want to delete this lemma and `finset.disj_union_singleton`, +-- or instead add `finset.union_singleton`/`finset.singleton_union`? lemma sdiff_singleton_eq_erase (a : α) (s : finset α) : s \ singleton a = erase s a := by { ext, rw [mem_erase, mem_sdiff, mem_singleton], tauto } -@[simp] lemma sdiff_singleton_not_mem_eq_self (s : finset α) {a : α} (ha : a ∉ s) : s \ {a} = s := -by simp only [sdiff_singleton_eq_erase, ha, erase_eq_of_not_mem, not_false_iff] +-- This lemma matches `finset.insert_eq` in functionality. +lemma erase_eq (s : finset α) (a : α) : s.erase a = s \ {a} := (sdiff_singleton_eq_erase _ _).symm -lemma sdiff_erase {x : α} (hx : x ∈ s) : s \ s.erase x = {x} := -begin - rw [← sdiff_singleton_eq_erase, sdiff_sdiff_right_self], - exact inf_eq_right.2 (singleton_subset_iff.2 hx), -end +lemma disjoint_erase_comm : disjoint (s.erase a) t ↔ disjoint s (t.erase a) := +by simp_rw [erase_eq, disjoint_sdiff_comm] + +lemma disjoint_of_erase_left (ha : a ∉ t) (hst : disjoint (s.erase a) t) : disjoint s t := +by { rw [←erase_insert ha, ←disjoint_erase_comm, disjoint_insert_right], + exact ⟨not_mem_erase _ _, hst⟩ } + +lemma disjoint_of_erase_right (ha : a ∉ s) (hst : disjoint s (t.erase a)) : disjoint s t := +by { rw [←erase_insert ha, disjoint_erase_comm, disjoint_insert_left], + exact ⟨not_mem_erase _ _, hst⟩ } + +@[simp] lemma inter_erase (a : α) (s t : finset α) : s ∩ t.erase a = (s ∩ t).erase a := +by simp only [erase_eq, inter_sdiff] + +@[simp] lemma erase_inter (a : α) (s t : finset α) : s.erase a ∩ t = (s ∩ t).erase a := +by simpa only [inter_comm t] using inter_erase a t s + +lemma erase_sdiff_comm (s t : finset α) (a : α) : s.erase a \ t = (s \ t).erase a := +by simp_rw [erase_eq, sdiff_right_comm] + +lemma insert_union_comm (s t : finset α) (a : α) : insert a s ∪ t = s ∪ insert a t := +by rw [insert_union, union_insert] + +lemma erase_inter_comm (s t : finset α) (a : α) : s.erase a ∩ t = s ∩ t.erase a := +by rw [erase_inter, inter_erase] + +lemma erase_union_distrib (s t : finset α) (a : α) : (s ∪ t).erase a = s.erase a ∪ t.erase a := +by simp_rw [erase_eq, union_sdiff_distrib] + +lemma insert_inter_distrib (s t : finset α) (a : α) : insert a (s ∩ t) = insert a s ∩ insert a t := +by simp_rw [insert_eq, union_distrib_left] + +lemma erase_sdiff_distrib (s t : finset α) (a : α) : (s \ t).erase a = s.erase a \ t.erase a := +by simp_rw [erase_eq, sdiff_sdiff, sup_sdiff_eq_sup le_rfl, sup_comm] + +lemma erase_union_of_mem (ha : a ∈ t) (s : finset α) : s.erase a ∪ t = s ∪ t := +by rw [←insert_erase (mem_union_right s ha), erase_union_distrib, ←union_insert, insert_erase ha] + +lemma union_erase_of_mem (ha : a ∈ s) (t : finset α) : s ∪ t.erase a = s ∪ t := +by rw [←insert_erase (mem_union_left t ha), erase_union_distrib, ←insert_union, insert_erase ha] + +@[simp] lemma sdiff_singleton_eq_self (ha : a ∉ s) : s \ {a} = s := +sdiff_eq_self_iff_disjoint.2 $ by simp [ha] + +lemma sdiff_sdiff_left' (s t u : finset α) : + (s \ t) \ u = (s \ t) ∩ (s \ u) := sdiff_sdiff_left' + +lemma sdiff_union_sdiff_cancel (hts : t ⊆ s) (hut : u ⊆ t) : s \ t ∪ t \ u = s \ u := +sdiff_sup_sdiff_cancel hts hut + +lemma sdiff_union_erase_cancel (hts : t ⊆ s) (ha : a ∈ t) : s \ t ∪ t.erase a = s.erase a := +by simp_rw [erase_eq, sdiff_union_sdiff_cancel hts (singleton_subset_iff.2 ha)] + +lemma sdiff_sdiff_eq_sdiff_union (h : u ⊆ s) : s \ (t \ u) = s \ t ∪ u := sdiff_sdiff_eq_sdiff_sup h + +lemma sdiff_insert (s t : finset α) (x : α) : + s \ insert x t = (s \ t).erase x := +by simp_rw [← sdiff_singleton_eq_erase, insert_eq, + sdiff_sdiff_left', sdiff_union_distrib, inter_comm] + +lemma sdiff_insert_insert_of_mem_of_not_mem {s t : finset α} {x : α} (hxs : x ∈ s) (hxt : x ∉ t) : + insert x (s \ insert x t) = s \ t := +by rw [sdiff_insert, insert_erase (mem_sdiff.mpr ⟨hxs, hxt⟩)] + +lemma sdiff_erase (h : a ∈ s) : s \ t.erase a = insert a (s \ t) := +by rw [←sdiff_singleton_eq_erase, sdiff_sdiff_eq_sdiff_union (singleton_subset_iff.2 h), insert_eq, + union_comm] + +lemma sdiff_erase_self (ha : a ∈ s) : s \ s.erase a = {a} := +by rw [sdiff_erase ha, finset.sdiff_self, insert_emptyc_eq] lemma sdiff_sdiff_self_left (s t : finset α) : s \ (s \ t) = s ∩ t := sdiff_sdiff_right_self @@ -1228,7 +1562,29 @@ sup_eq_sdiff_sup_sdiff_sup_inf lemma erase_eq_empty_iff (s : finset α) (a : α) : s.erase a = ∅ ↔ s = ∅ ∨ s = {a} := by rw [←sdiff_singleton_eq_erase, sdiff_eq_empty_iff_subset, subset_singleton_iff] -end decidable_eq +--TODO@Yaël: Kill lemmas duplicate with `boolean_algebra` +lemma sdiff_disjoint : disjoint (t \ s) s := disjoint_left.2 $ assume a ha, (mem_sdiff.1 ha).2 +lemma disjoint_sdiff : disjoint s (t \ s) := sdiff_disjoint.symm + +lemma disjoint_sdiff_inter (s t : finset α) : disjoint (s \ t) (s ∩ t) := +disjoint_of_subset_right (inter_subset_right _ _) sdiff_disjoint + +lemma sdiff_eq_self_iff_disjoint : s \ t = s ↔ disjoint s t := sdiff_eq_self_iff_disjoint' +lemma sdiff_eq_self_of_disjoint (h : disjoint s t) : s \ t = s := sdiff_eq_self_iff_disjoint.2 h + +end sdiff + +/-! ### Symmetric difference -/ + +section symm_diff +variables [decidable_eq α] {s t : finset α} {a b : α} + +lemma mem_symm_diff : a ∈ s ∆ t ↔ a ∈ s ∧ a ∉ t ∨ a ∈ t ∧ a ∉ s := +by simp_rw [symm_diff, sup_eq_union, mem_union, mem_sdiff] + +@[simp, norm_cast] lemma coe_symm_diff : (↑(s ∆ t) : set α) = s ∆ t := set.ext $ λ _, mem_symm_diff + +end symm_diff /-! ### attach -/ @@ -1247,10 +1603,10 @@ theorem sizeof_lt_sizeof_of_mem [has_sizeof α] {x : α} {s : finset α} (hx : x @[simp] theorem attach_empty : attach (∅ : finset α) = ∅ := rfl -@[simp] lemma attach_nonempty_iff (s : finset α) : s.attach.nonempty ↔ s.nonempty := +@[simp] lemma attach_nonempty_iff {s : finset α} : s.attach.nonempty ↔ s.nonempty := by simp [finset.nonempty] -@[simp] lemma attach_eq_empty_iff (s : finset α) : s.attach = ∅ ↔ s = ∅ := +@[simp] lemma attach_eq_empty_iff {s : finset α} : s.attach = ∅ ↔ s = ∅ := by simpa [eq_empty_iff_forall_not_mem] /-! ### piecewise -/ @@ -1406,7 +1762,7 @@ end decidable_pi_exists /-! ### filter -/ section filter -variables (p q : α → Prop) [decidable_pred p] [decidable_pred q] +variables (p q : α → Prop) [decidable_pred p] [decidable_pred q] {s : finset α} /-- `filter p s` is the set of elements of `s` that satisfy `p`. -/ def filter (s : finset α) : finset α := ⟨_, s.2.filter p⟩ @@ -1431,38 +1787,34 @@ variable (p) theorem filter_filter (s : finset α) : (s.filter p).filter q = s.filter (λa, p a ∧ q a) := ext $ assume a, by simp only [mem_filter, and_comm, and.left_comm] -lemma filter_true {s : finset α} [h : decidable_pred (λ _, true)] : - @finset.filter α (λ _, true) h s = s := -by ext; simp +lemma filter_comm (s : finset α) : (s.filter p).filter q = (s.filter q).filter p := +by simp_rw [filter_filter, and_comm] -@[simp] theorem filter_false {h} (s : finset α) : @filter α (λa, false) h s = ∅ := -ext $ assume a, by simp only [mem_filter, and_false]; refl +/- We can simplify an application of filter where the decidability is inferred in "the wrong way" -/ +@[simp] lemma filter_congr_decidable (s : finset α) (p : α → Prop) (h : decidable_pred p) + [decidable_pred p] : @filter α p h s = s.filter p := +by congr + +lemma filter_true {h} (s : finset α) : @filter α (λ a, true) h s = s := by ext; simp +lemma filter_false {h} (s : finset α) : @filter α (λ a, false) h s = ∅ := by ext; simp variables {p q} -lemma filter_eq_self (s : finset α) : - s.filter p = s ↔ ∀ x ∈ s, p x := -by simp [finset.ext_iff] +lemma filter_eq_self : s.filter p = s ↔ ∀ ⦃x⦄, x ∈ s → p x := by simp [finset.ext_iff] +lemma filter_eq_empty_iff : s.filter p = ∅ ↔ ∀ ⦃x⦄, x ∈ s → ¬ p x := by simp [finset.ext_iff] + +lemma filter_nonempty_iff {s : finset α} : (s.filter p).nonempty ↔ ∃ a ∈ s, p a := +by simp only [nonempty_iff_ne_empty, ne.def, filter_eq_empty_iff, not_not, not_forall] /-- If all elements of a `finset` satisfy the predicate `p`, `s.filter p` is `s`. -/ -@[simp] lemma filter_true_of_mem {s : finset α} (h : ∀ x ∈ s, p x) : s.filter p = s := -(filter_eq_self s).mpr h +@[simp] lemma filter_true_of_mem (h : ∀ x ∈ s, p x) : s.filter p = s := filter_eq_self.2 h /-- If all elements of a `finset` fail to satisfy the predicate `p`, `s.filter p` is `∅`. -/ -lemma filter_false_of_mem {s : finset α} (h : ∀ x ∈ s, ¬ p x) : s.filter p = ∅ := -eq_empty_of_forall_not_mem (by simpa) - -lemma filter_eq_empty_iff (s : finset α) : - (s.filter p = ∅) ↔ ∀ x ∈ s, ¬ p x := -begin - refine ⟨_, filter_false_of_mem⟩, - intros hs, - injection hs with hs', - rwa filter_eq_nil at hs' -end +@[simp] lemma filter_false_of_mem (h : ∀ x ∈ s, ¬ p x) : s.filter p = ∅ := filter_eq_empty_iff.2 h -lemma filter_nonempty_iff {s : finset α} : (s.filter p).nonempty ↔ ∃ a ∈ s, p a := -by simp only [nonempty_iff_ne_empty, ne.def, filter_eq_empty_iff, not_not, not_forall] +@[simp] lemma filter_const (p : Prop) [decidable p] (s : finset α) : + s.filter (λ a, p) = if p then s else ∅ := +by split_ifs; simp [*] lemma filter_congr {s : finset α} (H : ∀ x ∈ s, p x ↔ q x) : filter p s = filter q s := eq_of_veq $ filter_congr H @@ -1492,6 +1844,54 @@ lemma subset_coe_filter_of_subset_forall (s : finset α) {t : set α} theorem filter_singleton (a : α) : filter p (singleton a) = if p a then singleton a else ∅ := by { classical, ext x, simp, split_ifs with h; by_cases h' : x = a; simp [h, h'] } +theorem filter_cons_of_pos (a : α) (s : finset α) (ha : a ∉ s) (hp : p a): + filter p (cons a s ha) = cons a (filter p s) (mem_filter.not.mpr $ mt and.left ha) := +eq_of_veq $ multiset.filter_cons_of_pos s.val hp + +theorem filter_cons_of_neg (a : α) (s : finset α) (ha : a ∉ s) (hp : ¬p a): + filter p (cons a s ha) = filter p s := +eq_of_veq $ multiset.filter_cons_of_neg s.val hp + +lemma disjoint_filter {s : finset α} {p q : α → Prop} [decidable_pred p] [decidable_pred q] : + disjoint (s.filter p) (s.filter q) ↔ ∀ x ∈ s, p x → ¬ q x := +by split; simp [disjoint_left] {contextual := tt} + +lemma disjoint_filter_filter {s t : finset α} {p q : α → Prop} + [decidable_pred p] [decidable_pred q] : + disjoint s t → disjoint (s.filter p) (t.filter q) := +disjoint.mono (filter_subset _ _) (filter_subset _ _) + +lemma disjoint_filter_filter' (s t : finset α) {p q : α → Prop} + [decidable_pred p] [decidable_pred q] (h : disjoint p q) : + disjoint (s.filter p) (t.filter q) := +begin + simp_rw [disjoint_left, mem_filter], + rintros a ⟨hs, hp⟩ ⟨ht, hq⟩, + exact h.le_bot _ ⟨hp, hq⟩, +end + +lemma disjoint_filter_filter_neg (s t : finset α) (p : α → Prop) + [decidable_pred p] [decidable_pred (λ a, ¬ p a)] : + disjoint (s.filter p) (t.filter $ λ a, ¬ p a) := +disjoint_filter_filter' s t disjoint_compl_right + +theorem filter_disj_union (s : finset α) (t : finset α) (h : disjoint s t) : + filter p (disj_union s t h) = (filter p s).disj_union (filter p t) + (disjoint_filter_filter h) := +eq_of_veq $ multiset.filter_add _ _ _ + +theorem filter_cons {a : α} (s : finset α) (ha : a ∉ s) : + filter p (cons a s ha) = (if p a then {a} else ∅ : finset α).disj_union (filter p s) (by + { split_ifs, + { rw disjoint_singleton_left, + exact (mem_filter.not.mpr $ mt and.left ha) }, + { exact disjoint_empty_left _ } }) := +begin + split_ifs with h, + { rw [filter_cons_of_pos _ _ _ ha h, singleton_disj_union] }, + { rw [filter_cons_of_neg _ _ _ ha h, empty_disj_union] }, +end + variable [decidable_eq α] theorem filter_union (s₁ s₂ : finset α) : (s₁ ∪ s₂).filter p = s₁.filter p ∪ s₂.filter p := @@ -1504,6 +1904,9 @@ lemma filter_mem_eq_inter {s t : finset α} [Π i, decidable (i ∈ t)] : s.filter (λ i, i ∈ t) = s ∩ t := ext $ λ i, by rw [mem_filter, mem_inter] +lemma filter_inter_distrib (s t : finset α) : (s ∩ t).filter p = s.filter p ∩ t.filter p := +by { ext, simp only [mem_filter, mem_inter], exact and_and_distrib_right _ _ _ } + theorem filter_inter (s t : finset α) : filter p s ∩ t = filter p (s ∩ t) := by { ext, simp only [mem_inter, mem_filter, and.right_comm] } @@ -1542,14 +1945,6 @@ by { simp [subset.antisymm_iff], ... ⊇ s₁ \ ∅ : by mono using [(⊇)] ... ⊇ s₁ : by simp [(⊇)] } } -theorem filter_union_filter_neg_eq [decidable_pred (λ a, ¬ p a)] - (s : finset α) : s.filter p ∪ s.filter (λa, ¬ p a) = s := -by simp only [filter_not, union_sdiff_of_subset (filter_subset p s)] - -theorem filter_inter_filter_neg_eq [decidable_pred (λ a, ¬ p a)] - (s : finset α) : s.filter p ∩ s.filter (λa, ¬ p a) = ∅ := -by simp only [filter_not, inter_sdiff_self] - lemma subset_union_elim {s : finset α} {t₁ t₂ : set α} (h : ↑s ⊆ t₁ ∪ t₂) : ∃ s₁ s₂ : finset α, s₁ ∪ s₂ = s ∧ ↑s₁ ⊆ t₁ ∧ ↑s₂ ⊆ t₂ \ t₁ := begin @@ -1560,11 +1955,6 @@ begin { intro x, simp, intros hx hx₂, refine ⟨or.resolve_left (h hx) hx₂, hx₂⟩ } end -/- We can simplify an application of filter where the decidability is inferred in "the wrong way" -/ -@[simp] lemma filter_congr_decidable {α} (s : finset α) (p : α → Prop) (h : decidable_pred p) - [decidable_pred p] : @filter α p h s = s.filter p := -by congr - section classical open_locale classical /-- The following instance allows us to write `{x ∈ s | p x}` for `finset.filter p s`. @@ -1615,6 +2005,18 @@ by { ext, simp only [mem_filter, mem_erase, ne.def], tauto } lemma filter_ne' [decidable_eq β] (s : finset β) (b : β) : s.filter (λ a, a ≠ b) = s.erase b := trans (filter_congr (λ _ _, ⟨ne.symm, ne.symm⟩)) (filter_ne s b) +theorem filter_inter_filter_neg_eq [decidable_pred (λ a, ¬ p a)] (s t : finset α) : + s.filter p ∩ t.filter (λa, ¬ p a) = ∅ := +(disjoint_filter_filter_neg s t p).eq_bot + +theorem filter_union_filter_of_codisjoint (s : finset α) (h : codisjoint p q) : + s.filter p ∪ s.filter q = s := +(filter_or _ _ _).symm.trans $ filter_true_of_mem $ λ x hx, h.top_le x trivial + +theorem filter_union_filter_neg_eq [decidable_pred (λ a, ¬ p a)] (s : finset α) : + s.filter p ∪ s.filter (λa, ¬ p a) = s := +filter_union_filter_of_codisjoint _ _ _ codisjoint_hnot_right + end filter /-! ### range -/ @@ -1625,10 +2027,13 @@ variables {n m l : ℕ} /-- `range n` is the set of natural numbers less than `n`. -/ def range (n : ℕ) : finset ℕ := ⟨_, nodup_range n⟩ -@[simp] theorem range_coe (n : ℕ) : (range n).1 = multiset.range n := rfl +@[simp] theorem range_val (n : ℕ) : (range n).1 = multiset.range n := rfl @[simp] theorem mem_range : m ∈ range n ↔ m < n := mem_range +@[simp, norm_cast] lemma coe_range (n : ℕ) : (range n : set ℕ) = set.Iio n := +set.ext $ λ _, mem_range + @[simp] theorem range_zero : range 0 = ∅ := rfl @[simp] theorem range_one : range 1 = {0} := rfl @@ -1664,6 +2069,14 @@ by rw [← not_nonempty_iff_eq_empty, nonempty_range_iff, not_not] lemma nonempty_range_succ : (range $ n + 1).nonempty := nonempty_range_iff.2 n.succ_ne_zero +@[simp] +lemma range_filter_eq {n m : ℕ} : (range n).filter (= m) = if m < n then {m} else ∅ := +begin + convert filter_eq (range n) m, + { ext, exact comm }, + { simp } +end + end range /- useful rules for calculations with quantifiers -/ @@ -1681,6 +2094,10 @@ lemma forall_mem_insert [decidable_eq α] (a : α) (s : finset α) (p : α → P (∀ x, x ∈ insert a s → p x) ↔ p a ∧ ∀ x, x ∈ s → p x := by simp only [mem_insert, or_imp_distrib, forall_and_distrib, forall_eq] +/-- Useful in proofs by induction. -/ +lemma forall_of_forall_insert [decidable_eq α] {p : α → Prop} {a : α} {s : finset α} + (H : ∀ x, x ∈ insert a s → p x) (x) (h : x ∈ s) : p x := H _ $ mem_insert_of_mem h + end finset /-- Equivalence between the set of natural numbers which are `≥ k` and `ℕ`, given by `n → n - k`. -/ @@ -1704,7 +2121,7 @@ def not_mem_range_equiv (k : ℕ) : {n // n ∉ range k} ≃ ℕ := /-! ### dedup on list and multiset -/ namespace multiset -variable [decidable_eq α] +variables [decidable_eq α] {s t : multiset α} /-- `to_finset s` removes duplicates from the multiset `s` to produce a finset. -/ def to_finset (s : multiset α) : finset α := ⟨_, nodup_dedup s⟩ @@ -1727,7 +2144,7 @@ by simpa [←to_finset_eq hl, ←to_finset_eq hl'] using h finset.eq_of_veq dedup_cons @[simp] lemma to_finset_singleton (a : α) : to_finset ({a} : multiset α) = {a} := -by rw [singleton_eq_cons, to_finset_cons, to_finset_zero, is_lawful_singleton.insert_emptyc_eq] +by rw [←cons_zero, to_finset_cons, to_finset_zero, is_lawful_singleton.insert_emptyc_eq] @[simp] lemma to_finset_add (s t : multiset α) : to_finset (s + t) = to_finset s ∪ to_finset t := finset.ext $ by simp @@ -1751,9 +2168,26 @@ by ext; simp @[simp] theorem to_finset_eq_empty {m : multiset α} : m.to_finset = ∅ ↔ m = 0 := finset.val_inj.symm.trans multiset.dedup_eq_zero -@[simp] lemma to_finset_subset (s t : multiset α) : s.to_finset ⊆ t.to_finset ↔ s ⊆ t := +@[simp] lemma to_finset_nonempty : s.to_finset.nonempty ↔ s ≠ 0 := +by simp only [to_finset_eq_empty, ne.def, finset.nonempty_iff_ne_empty] + +@[simp] lemma to_finset_subset : s.to_finset ⊆ t.to_finset ↔ s ⊆ t := by simp only [finset.subset_iff, multiset.subset_iff, multiset.mem_to_finset] +@[simp] lemma to_finset_ssubset : s.to_finset ⊂ t.to_finset ↔ s ⊂ t := +by { simp_rw [finset.ssubset_def, to_finset_subset], refl } + +@[simp] lemma to_finset_dedup (m : multiset α) : + m.dedup.to_finset = m.to_finset := +by simp_rw [to_finset, dedup_idempotent] + +@[simp] lemma to_finset_bind_dedup [decidable_eq β] (m : multiset α) (f : α → multiset β) : + (m.dedup.bind f).to_finset = (m.bind f).to_finset := +by simp_rw [to_finset, dedup_bind_dedup] + +instance is_well_founded_ssubset : is_well_founded (multiset β) (⊂) := +subrelation.is_well_founded (inv_image _ _) $ λ _ _, by classical; exact to_finset_ssubset.2 + end multiset namespace finset @@ -1773,10 +2207,14 @@ variables [decidable_eq α] {l l' : list α} {a : α} def to_finset (l : list α) : finset α := multiset.to_finset l @[simp] theorem to_finset_val (l : list α) : l.to_finset.1 = (l.dedup : multiset α) := rfl +@[simp] theorem to_finset_coe (l : list α) : (l : multiset α).to_finset = l.to_finset := rfl lemma to_finset_eq (n : nodup l) : @finset.mk α l n = l.to_finset := multiset.to_finset_eq n @[simp] lemma mem_to_finset : a ∈ l.to_finset ↔ a ∈ l := mem_dedup +@[simp, norm_cast] lemma coe_to_finset (l : list α) : (l.to_finset : set α) = {a | a ∈ l} := +set.ext $ λ _, list.mem_to_finset + @[simp] lemma to_finset_nil : to_finset (@nil α) = ∅ := rfl @[simp] lemma to_finset_cons : to_finset (a :: l) = insert a (to_finset l) := @@ -1813,8 +2251,8 @@ end @[simp] lemma to_finset_reverse {l : list α} : to_finset l.reverse = l.to_finset := to_finset_eq_of_perm _ _ (reverse_perm l) -lemma to_finset_repeat_of_ne_zero {n : ℕ} (hn : n ≠ 0) : (list.repeat a n).to_finset = {a} := -by { ext x, simp [hn, list.mem_repeat] } +lemma to_finset_replicate_of_ne_zero {n : ℕ} (hn : n ≠ 0) : (list.replicate n a).to_finset = {a} := +by { ext x, simp [hn, list.mem_replicate] } @[simp] lemma to_finset_union (l l' : list α) : (l ∪ l').to_finset = l.to_finset ∪ l'.to_finset := by { ext, simp } @@ -1824,434 +2262,48 @@ by { ext, simp } @[simp] lemma to_finset_eq_empty_iff (l : list α) : l.to_finset = ∅ ↔ l = nil := by cases l; simp +@[simp] lemma to_finset_nonempty_iff (l : list α) : l.to_finset.nonempty ↔ l ≠ [] := +by simp [finset.nonempty_iff_ne_empty] + end list namespace finset -/-! ### map -/ -section map -open function - -/-- When `f` is an embedding of `α` in `β` and `s` is a finset in `α`, then `s.map f` is the image -finset in `β`. The embedding condition guarantees that there are no duplicates in the image. -/ -def map (f : α ↪ β) (s : finset α) : finset β := ⟨s.1.map f, s.2.map f.2⟩ - -@[simp] theorem map_val (f : α ↪ β) (s : finset α) : (map f s).1 = s.1.map f := rfl - -@[simp] theorem map_empty (f : α ↪ β) : (∅ : finset α).map f = ∅ := rfl - -variables {f : α ↪ β} {s : finset α} - -@[simp] theorem mem_map {b : β} : b ∈ s.map f ↔ ∃ a ∈ s, f a = b := -mem_map.trans $ by simp only [exists_prop]; refl - -@[simp] lemma mem_map_equiv {f : α ≃ β} {b : β} : b ∈ s.map f.to_embedding ↔ f.symm b ∈ s := -by { rw mem_map, exact ⟨by { rintro ⟨a, H, rfl⟩, simpa }, λ h, ⟨_, h, by simp⟩⟩ } - -lemma mem_map' (f : α ↪ β) {a} {s : finset α} : f a ∈ s.map f ↔ a ∈ s := mem_map_of_injective f.2 - -lemma mem_map_of_mem (f : α ↪ β) {a} {s : finset α} : a ∈ s → f a ∈ s.map f := (mem_map' _).2 - -lemma apply_coe_mem_map (f : α ↪ β) (s : finset α) (x : s) : f x ∈ s.map f := -mem_map_of_mem f x.prop - -@[simp, norm_cast] theorem coe_map (f : α ↪ β) (s : finset α) : (s.map f : set β) = f '' s := -set.ext $ λ x, mem_map.trans set.mem_image_iff_bex.symm - -theorem coe_map_subset_range (f : α ↪ β) (s : finset α) : (s.map f : set β) ⊆ set.range f := -calc ↑(s.map f) = f '' s : coe_map f s - ... ⊆ set.range f : set.image_subset_range f ↑s - -/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect. --/ -lemma map_perm {σ : equiv.perm α} (hs : {a | σ a ≠ a} ⊆ s) : s.map (σ : α ↪ α) = s := -coe_injective $ (coe_map _ _).trans $ set.image_perm hs - -theorem map_to_finset [decidable_eq α] [decidable_eq β] {s : multiset α} : - s.to_finset.map f = (s.map f).to_finset := -ext $ λ _, by simp only [mem_map, multiset.mem_map, exists_prop, multiset.mem_to_finset] - -@[simp] theorem map_refl : s.map (embedding.refl _) = s := -ext $ λ _, by simpa only [mem_map, exists_prop] using exists_eq_right - -@[simp] theorem map_cast_heq {α β} (h : α = β) (s : finset α) : - s.map (equiv.cast h).to_embedding == s := -by { subst h, simp } - -theorem map_map {g : β ↪ γ} : (s.map f).map g = s.map (f.trans g) := -eq_of_veq $ by simp only [map_val, multiset.map_map]; refl - -@[simp] theorem map_subset_map {s₁ s₂ : finset α} : s₁.map f ⊆ s₂.map f ↔ s₁ ⊆ s₂ := -⟨λ h x xs, (mem_map' _).1 $ h $ (mem_map' f).2 xs, - λ h, by simp [subset_def, map_subset_map h]⟩ - -/-- Associate to an embedding `f` from `α` to `β` the order embedding that maps a finset to its -image under `f`. -/ -def map_embedding (f : α ↪ β) : finset α ↪o finset β := -order_embedding.of_map_le_iff (map f) (λ _ _, map_subset_map) - -@[simp] theorem map_inj {s₁ s₂ : finset α} : s₁.map f = s₂.map f ↔ s₁ = s₂ := -(map_embedding f).injective.eq_iff - -lemma map_injective (f : α ↪ β) : injective (map f) := (map_embedding f).injective - -@[simp] theorem map_embedding_apply : map_embedding f s = map f s := rfl - -theorem map_filter {p : β → Prop} [decidable_pred p] : - (s.map f).filter p = (s.filter (p ∘ f)).map f := -eq_of_veq (map_filter _ _ _) - -theorem map_union [decidable_eq α] [decidable_eq β] - {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∪ s₂).map f = s₁.map f ∪ s₂.map f := -coe_injective $ by simp only [coe_map, coe_union, set.image_union] - -theorem map_inter [decidable_eq α] [decidable_eq β] - {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∩ s₂).map f = s₁.map f ∩ s₂.map f := -coe_injective $ by simp only [coe_map, coe_inter, set.image_inter f.injective] - -@[simp] theorem map_singleton (f : α ↪ β) (a : α) : map f {a} = {f a} := -coe_injective $ by simp only [coe_map, coe_singleton, set.image_singleton] - -@[simp] lemma map_insert [decidable_eq α] [decidable_eq β] (f : α ↪ β) (a : α) (s : finset α) : - (insert a s).map f = insert (f a) (s.map f) := -by simp only [insert_eq, map_union, map_singleton] - -@[simp] theorem map_eq_empty : s.map f = ∅ ↔ s = ∅ := -⟨λ h, eq_empty_of_forall_not_mem $ - λ a m, ne_empty_of_mem (mem_map_of_mem _ m) h, λ e, e.symm ▸ rfl⟩ - -@[simp] lemma map_nonempty : (s.map f).nonempty ↔ s.nonempty := -by rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, map_eq_empty] - -alias map_nonempty ↔ _ finset.nonempty.map - -lemma attach_map_val {s : finset α} : s.attach.map (embedding.subtype _) = s := -eq_of_veq $ by rw [map_val, attach_val]; exact attach_map_val _ - -lemma disjoint_range_add_left_embedding (a b : ℕ) : - disjoint (range a) (map (add_left_embedding a) (range b)) := -begin - intros k hk, - simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply, - mem_inter] at hk, - obtain ⟨a, haQ, ha⟩ := hk.2, - simpa [← ha] using hk.1, -end - -lemma disjoint_range_add_right_embedding (a b : ℕ) : - disjoint (range a) (map (add_right_embedding a) (range b)) := -begin - intros k hk, - simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply, - mem_inter] at hk, - obtain ⟨a, haQ, ha⟩ := hk.2, - simpa [← ha] using hk.1, -end - -end map - -lemma range_add_one' (n : ℕ) : - range (n + 1) = insert 0 ((range n).map ⟨λi, i + 1, assume i j, nat.succ.inj⟩) := -by ext (⟨⟩ | ⟨n⟩); simp [nat.succ_eq_add_one, nat.zero_lt_succ n] - -/-! ### image -/ - -section image -variables [decidable_eq β] - -/-- `image f s` is the forward image of `s` under `f`. -/ -def image (f : α → β) (s : finset α) : finset β := (s.1.map f).to_finset - -@[simp] theorem image_val (f : α → β) (s : finset α) : (image f s).1 = (s.1.map f).dedup := rfl - -@[simp] theorem image_empty (f : α → β) : (∅ : finset α).image f = ∅ := rfl - -variables {f g : α → β} {s : finset α} {t : finset β} {a : α} {b c : β} - -@[simp] lemma mem_image : b ∈ s.image f ↔ ∃ a ∈ s, f a = b := -by simp only [mem_def, image_val, mem_dedup, multiset.mem_map, exists_prop] - -lemma mem_image_of_mem (f : α → β) {a} (h : a ∈ s) : f a ∈ s.image f := mem_image.2 ⟨_, h, rfl⟩ - -@[simp] lemma mem_image_const : c ∈ s.image (const α b) ↔ s.nonempty ∧ b = c := -by { rw mem_image, simp only [exists_prop, const_apply, exists_and_distrib_right], refl } - -lemma mem_image_const_self : b ∈ s.image (const α b) ↔ s.nonempty := -mem_image_const.trans $ and_iff_left rfl - -instance [can_lift β α] : can_lift (finset β) (finset α) := -{ cond := λ s, ∀ x ∈ s, can_lift.cond α x, - coe := image can_lift.coe, - prf := - begin - rintro ⟨⟨l⟩, hd : l.nodup⟩ hl, - lift l to list α using hl, - exact ⟨⟨l, hd.of_map _⟩, ext $ λ a, by simp⟩, - end } - -lemma image_congr (h : (s : set α).eq_on f g) : finset.image f s = finset.image g s := -by { ext, simp_rw mem_image, exact bex_congr (λ x hx, by rw h hx) } - -lemma _root_.function.injective.mem_finset_image (hf : injective f) : f a ∈ s.image f ↔ a ∈ s := -begin - refine ⟨λ h, _, finset.mem_image_of_mem f⟩, - obtain ⟨y, hy, heq⟩ := mem_image.1 h, - exact hf heq ▸ hy, -end - -lemma filter_mem_image_eq_image (f : α → β) (s : finset α) (t : finset β) (h : ∀ x ∈ s, f x ∈ t) : - t.filter (λ y, y ∈ s.image f) = s.image f := -by { ext, rw [mem_filter, mem_image], - simp only [and_imp, exists_prop, and_iff_right_iff_imp, exists_imp_distrib], - rintros x xel rfl, exact h _ xel } - -lemma fiber_nonempty_iff_mem_image (f : α → β) (s : finset α) (y : β) : - (s.filter (λ x, f x = y)).nonempty ↔ y ∈ s.image f := -by simp [finset.nonempty] - -@[simp, norm_cast] lemma coe_image {f : α → β} : ↑(s.image f) = f '' ↑s := -set.ext $ λ _, mem_image.trans set.mem_image_iff_bex.symm - -protected lemma nonempty.image (h : s.nonempty) (f : α → β) : (s.image f).nonempty := -let ⟨a, ha⟩ := h in ⟨f a, mem_image_of_mem f ha⟩ - -@[simp] lemma nonempty.image_iff (f : α → β) : (s.image f).nonempty ↔ s.nonempty := -⟨λ ⟨y, hy⟩, let ⟨x, hx, _⟩ := mem_image.mp hy in ⟨x, hx⟩, λ h, h.image f⟩ - -theorem image_to_finset [decidable_eq α] {s : multiset α} : - s.to_finset.image f = (s.map f).to_finset := -ext $ λ _, by simp only [mem_image, multiset.mem_to_finset, exists_prop, multiset.mem_map] - -lemma image_val_of_inj_on (H : set.inj_on f s) : (image f s).1 = s.1.map f := (s.2.map_on H).dedup - -@[simp] lemma image_id [decidable_eq α] : s.image id = s := -ext $ λ _, by simp only [mem_image, exists_prop, id, exists_eq_right] - -@[simp] theorem image_id' [decidable_eq α] : s.image (λ x, x) = s := image_id - -theorem image_image [decidable_eq γ] {g : β → γ} : (s.image f).image g = s.image (g ∘ f) := -eq_of_veq $ by simp only [image_val, dedup_map_dedup_eq, multiset.map_map] - -theorem image_subset_image {s₁ s₂ : finset α} (h : s₁ ⊆ s₂) : s₁.image f ⊆ s₂.image f := -by simp only [subset_def, image_val, subset_dedup', dedup_subset', - multiset.map_subset_map h] - -lemma image_subset_iff : s.image f ⊆ t ↔ ∀ x ∈ s, f x ∈ t := -calc s.image f ⊆ t ↔ f '' ↑s ⊆ ↑t : by norm_cast - ... ↔ _ : set.image_subset_iff - -theorem image_mono (f : α → β) : monotone (finset.image f) := λ _ _, image_subset_image - -theorem coe_image_subset_range : ↑(s.image f) ⊆ set.range f := -calc ↑(s.image f) = f '' ↑s : coe_image - ... ⊆ set.range f : set.image_subset_range f ↑s - -theorem image_filter {p : β → Prop} [decidable_pred p] : - (s.image f).filter p = (s.filter (p ∘ f)).image f := -ext $ λ b, by simp only [mem_filter, mem_image, exists_prop]; exact -⟨by rintro ⟨⟨x, h1, rfl⟩, h2⟩; exact ⟨x, ⟨h1, h2⟩, rfl⟩, - by rintro ⟨x, ⟨h1, h2⟩, rfl⟩; exact ⟨⟨x, h1, rfl⟩, h2⟩⟩ - -theorem image_union [decidable_eq α] {f : α → β} (s₁ s₂ : finset α) : - (s₁ ∪ s₂).image f = s₁.image f ∪ s₂.image f := -ext $ λ _, by simp only [mem_image, mem_union, exists_prop, or_and_distrib_right, - exists_or_distrib] - -lemma image_inter_subset [decidable_eq α] (f : α → β) (s t : finset α) : - (s ∩ t).image f ⊆ s.image f ∩ t.image f := -subset_inter (image_subset_image $ inter_subset_left _ _) $ - image_subset_image $ inter_subset_right _ _ - -lemma image_inter [decidable_eq α] (s₁ s₂ : finset α) (hf : ∀ x y, f x = f y → x = y) : - (s₁ ∩ s₂).image f = s₁.image f ∩ s₂.image f := -ext $ by simp only [mem_image, exists_prop, mem_inter]; exact λ b, -⟨λ ⟨a, ⟨m₁, m₂⟩, e⟩, ⟨⟨a, m₁, e⟩, ⟨a, m₂, e⟩⟩, - λ ⟨⟨a, m₁, e₁⟩, ⟨a', m₂, e₂⟩⟩, ⟨a, ⟨m₁, hf _ _ (e₂.trans e₁.symm) ▸ m₂⟩, e₁⟩⟩. - -@[simp] theorem image_singleton (f : α → β) (a : α) : image f {a} = {f a} := -ext $ λ x, by simpa only [mem_image, exists_prop, mem_singleton, exists_eq_left] using eq_comm - -@[simp] theorem image_insert [decidable_eq α] (f : α → β) (a : α) (s : finset α) : - (insert a s).image f = insert (f a) (s.image f) := -by simp only [insert_eq, image_singleton, image_union] - -@[simp] lemma image_erase [decidable_eq α] {f : α → β} (hf : injective f) (s : finset α) (a : α) : - (s.erase a).image f = (s.image f).erase (f a) := -begin - ext b, - simp only [mem_image, exists_prop, mem_erase], - split, - { rintro ⟨a', ⟨haa', ha'⟩, rfl⟩, - exact ⟨hf.ne haa', a', ha', rfl⟩ }, - { rintro ⟨h, a', ha', rfl⟩, - exact ⟨a', ⟨ne_of_apply_ne _ h, ha'⟩, rfl⟩ } -end - -@[simp] theorem image_eq_empty : s.image f = ∅ ↔ s = ∅ := -⟨λ h, eq_empty_of_forall_not_mem $ - λ a m, ne_empty_of_mem (mem_image_of_mem _ m) h, λ e, e.symm ▸ rfl⟩ - -lemma mem_range_iff_mem_finset_range_of_mod_eq' [decidable_eq α] {f : ℕ → α} {a : α} {n : ℕ} - (hn : 0 < n) (h : ∀ i, f (i % n) = f i) : - a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) := -begin - split, - { rintros ⟨i, hi⟩, - simp only [mem_image, exists_prop, mem_range], - exact ⟨i % n, nat.mod_lt i hn, (rfl.congr hi).mp (h i)⟩ }, - { rintro h, - simp only [mem_image, exists_prop, set.mem_range, mem_range] at *, - rcases h with ⟨i, hi, ha⟩, - exact ⟨i, ha⟩ } -end - -lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ} - (hn : 0 < n) (h : ∀ i, f (i % n) = f i) : - a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) := -suffices (∃ i, f (i % n) = a) ↔ ∃ i, i < n ∧ f ↑i = a, by simpa [h], -have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn, -iff.intro - (assume ⟨i, hi⟩, - have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'), - ⟨int.to_nat (i % n), - by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩) - (assume ⟨i, hi, ha⟩, - ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩) - -lemma range_add (a b : ℕ) : range (a + b) = range a ∪ (range b).map (add_left_embedding a) := -by { rw [←val_inj, union_val], exact multiset.range_add_eq_union a b } - -@[simp] lemma attach_image_val [decidable_eq α] {s : finset α} : s.attach.image subtype.val = s := -eq_of_veq $ by rw [image_val, attach_val, multiset.attach_map_val, dedup_eq_self] - -@[simp] lemma attach_image_coe [decidable_eq α] {s : finset α} : s.attach.image coe = s := -finset.attach_image_val - -@[simp] lemma attach_insert [decidable_eq α] {a : α} {s : finset α} : - attach (insert a s) = insert (⟨a, mem_insert_self a s⟩ : {x // x ∈ insert a s}) - ((attach s).image (λx, ⟨x.1, mem_insert_of_mem x.2⟩)) := -ext $ λ ⟨x, hx⟩, ⟨or.cases_on (mem_insert.1 hx) - (λ h : x = a, λ _, mem_insert.2 $ or.inl $ subtype.eq h) - (λ h : x ∈ s, λ _, mem_insert_of_mem $ mem_image.2 $ ⟨⟨x, h⟩, mem_attach _ _, subtype.eq rfl⟩), -λ _, finset.mem_attach _ _⟩ - -theorem map_eq_image (f : α ↪ β) (s : finset α) : s.map f = s.image f := -eq_of_veq (s.map f).2.dedup.symm - -lemma image_const {s : finset α} (h : s.nonempty) (b : β) : s.image (λa, b) = singleton b := -ext $ assume b', by simp only [mem_image, exists_prop, exists_and_distrib_right, - h.bex, true_and, mem_singleton, eq_comm] - -@[simp] lemma map_erase [decidable_eq α] (f : α ↪ β) (s : finset α) (a : α) : - (s.erase a).map f = (s.map f).erase (f a) := -by { simp_rw map_eq_image, exact s.image_erase f.2 a } - -/-! ### Subtype -/ - -/-- Given a finset `s` and a predicate `p`, `s.subtype p` is the finset of `subtype p` whose -elements belong to `s`. -/ -protected def subtype {α} (p : α → Prop) [decidable_pred p] (s : finset α) : finset (subtype p) := -(s.filter p).attach.map ⟨λ x, ⟨x.1, (finset.mem_filter.1 x.2).2⟩, -λ x y H, subtype.eq $ subtype.mk.inj H⟩ - -@[simp] lemma mem_subtype {p : α → Prop} [decidable_pred p] {s : finset α} : - ∀ {a : subtype p}, a ∈ s.subtype p ↔ (a : α) ∈ s -| ⟨a, ha⟩ := by simp [finset.subtype, ha] - -lemma subtype_eq_empty {p : α → Prop} [decidable_pred p] {s : finset α} : - s.subtype p = ∅ ↔ ∀ x, p x → x ∉ s := -by simp [ext_iff, subtype.forall, subtype.coe_mk]; refl - -@[mono] lemma subtype_mono {p : α → Prop} [decidable_pred p] : monotone (finset.subtype p) := -λ s t h x hx, mem_subtype.2 $ h $ mem_subtype.1 hx - -/-- `s.subtype p` converts back to `s.filter p` with -`embedding.subtype`. -/ -@[simp] lemma subtype_map (p : α → Prop) [decidable_pred p] : - (s.subtype p).map (embedding.subtype _) = s.filter p := -begin - ext x, - simp [and_comm _ (_ = _), @and.left_comm _ (_ = _), and_comm (p x) (x ∈ s)] -end - -/-- If all elements of a `finset` satisfy the predicate `p`, -`s.subtype p` converts back to `s` with `embedding.subtype`. -/ -lemma subtype_map_of_mem {p : α → Prop} [decidable_pred p] (h : ∀ x ∈ s, p x) : - (s.subtype p).map (embedding.subtype _) = s := -by rw [subtype_map, filter_true_of_mem h] - -/-- If a `finset` of a subtype is converted to the main type with -`embedding.subtype`, all elements of the result have the property of -the subtype. -/ -lemma property_of_mem_map_subtype {p : α → Prop} (s : finset {x // p x}) {a : α} - (h : a ∈ s.map (embedding.subtype _)) : p a := -begin - rcases mem_map.1 h with ⟨x, hx, rfl⟩, - exact x.2 -end - -/-- If a `finset` of a subtype is converted to the main type with -`embedding.subtype`, the result does not contain any value that does -not satisfy the property of the subtype. -/ -lemma not_mem_map_subtype_of_not_property {p : α → Prop} (s : finset {x // p x}) - {a : α} (h : ¬ p a) : a ∉ (s.map (embedding.subtype _)) := -mt s.property_of_mem_map_subtype h - -/-- If a `finset` of a subtype is converted to the main type with -`embedding.subtype`, the result is a subset of the set giving the -subtype. -/ -lemma map_subtype_subset {t : set α} (s : finset t) : ↑(s.map (embedding.subtype _)) ⊆ t := -begin - intros a ha, - rw mem_coe at ha, - convert property_of_mem_map_subtype s ha -end - -lemma subset_image_iff {s : set α} : ↑t ⊆ f '' s ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ s'.image f = t := -begin - split, swap, - { rintro ⟨t, ht, rfl⟩, rw [coe_image], exact set.image_subset f ht }, - intro h, - letI : can_lift β s := ⟨f ∘ coe, λ y, y ∈ f '' s, λ y ⟨x, hxt, hy⟩, ⟨⟨x, hxt⟩, hy⟩⟩, - lift t to finset s using h, - refine ⟨t.map (embedding.subtype _), map_subtype_subset _, _⟩, - ext y, simp -end - -lemma range_sdiff_zero {n : ℕ} : range (n + 1) \ {0} = (range n).image nat.succ := -begin - induction n with k hk, - { simp }, - nth_rewrite 1 range_succ, - rw [range_succ, image_insert, ←hk, insert_sdiff_of_not_mem], - simp -end - -end image - -lemma _root_.multiset.to_finset_map [decidable_eq α] [decidable_eq β] (f : α → β) (m : multiset α) : - (m.map f).to_finset = m.to_finset.image f := -finset.val_inj.1 (multiset.dedup_map_dedup_eq _ _).symm - section to_list /-- Produce a list of the elements in the finite set using choice. -/ -@[reducible] noncomputable def to_list (s : finset α) : list α := s.1.to_list +noncomputable def to_list (s : finset α) : list α := s.1.to_list lemma nodup_to_list (s : finset α) : s.to_list.nodup := by { rw [to_list, ←multiset.coe_nodup, multiset.coe_to_list], exact s.nodup } -@[simp] lemma mem_to_list {a : α} (s : finset α) : a ∈ s.to_list ↔ a ∈ s := -by { rw [to_list, ←multiset.mem_coe, multiset.coe_to_list], exact iff.rfl } +@[simp] lemma mem_to_list {a : α} {s : finset α} : a ∈ s.to_list ↔ a ∈ s := mem_to_list + +@[simp] lemma to_list_eq_nil {s : finset α} : s.to_list = [] ↔ s = ∅ := +to_list_eq_nil.trans val_eq_zero + +@[simp] lemma empty_to_list {s : finset α} : s.to_list.empty ↔ s = ∅ := +list.empty_iff_eq_nil.trans to_list_eq_nil + +@[simp] lemma to_list_empty : (∅ : finset α).to_list = [] := to_list_eq_nil.mpr rfl + +lemma nonempty.to_list_ne_nil {s : finset α} (hs : s.nonempty) : s.to_list ≠ [] := +mt to_list_eq_nil.mp hs.ne_empty -@[simp] lemma to_list_empty : (∅ : finset α).to_list = [] := by simp [to_list] +lemma nonempty.not_empty_to_list {s : finset α} (hs : s.nonempty) : ¬s.to_list.empty := +mt empty_to_list.mp hs.ne_empty @[simp, norm_cast] -lemma coe_to_list (s : finset α) : (s.to_list : multiset α) = s.val := by { classical, ext, simp } +lemma coe_to_list (s : finset α) : (s.to_list : multiset α) = s.val := s.val.coe_to_list @[simp] lemma to_list_to_finset [decidable_eq α] (s : finset α) : s.to_list.to_finset = s := by { ext, simp } +@[simp] lemma to_list_eq_singleton_iff {a : α} {s : finset α} : s.to_list = [a] ↔ s = {a} := +by rw [to_list, to_list_eq_singleton_iff, val_eq_singleton_iff] + +@[simp] lemma to_list_singleton : ∀ a, ({a} : finset α).to_list = [a] := to_list_singleton + lemma exists_list_nodup_eq [decidable_eq α] (s : finset α) : ∃ (l : list α), l.nodup ∧ l.to_finset = s := ⟨s.to_list, s.nodup_to_list, s.to_list_to_finset⟩ @@ -2266,6 +2318,76 @@ cons_eq_insert _ _ h ▸ to_list_cons _ end to_list +/-! +### disj_Union + +This section is about the bounded union of a disjoint indexed family `t : α → finset β` of finite +sets over a finite set `s : finset α`. In most cases `finset.bUnion` should be preferred. +-/ +section disj_Union + +variables {s s₁ s₂ : finset α} {t t₁ t₂ : α → finset β} + +/-- `disj_Union s f h` is the set such that `a ∈ disj_Union s f` iff `a ∈ f i` for some `i ∈ s`. +It is the same as `s.bUnion f`, but it does not require decidable equality on the type. The +hypothesis ensures that the sets are disjoint. -/ +def disj_Union (s : finset α) (t : α → finset β) + (hf : (s : set α).pairwise_disjoint t) : finset β := +⟨(s.val.bind (finset.val ∘ t)), multiset.nodup_bind.mpr + ⟨λ a ha, (t a).nodup, s.nodup.pairwise $ λ a ha b hb hab, disjoint_val.2 $ hf ha hb hab⟩⟩ + +@[simp] theorem disj_Union_val (s : finset α) (t : α → finset β) (h) : + (s.disj_Union t h).1 = (s.1.bind (λ a, (t a).1)) := rfl + +@[simp] theorem disj_Union_empty (t : α → finset β) : disj_Union ∅ t (by simp) = ∅ := rfl + +@[simp] lemma mem_disj_Union {b : β} {h} : + b ∈ s.disj_Union t h ↔ ∃ a ∈ s, b ∈ t a := +by simp only [mem_def, disj_Union_val, mem_bind, exists_prop] + +@[simp, norm_cast] lemma coe_disj_Union {h} : (s.disj_Union t h : set β) = ⋃ x ∈ (s : set α), t x := +by simp only [set.ext_iff, mem_disj_Union, set.mem_Union, iff_self, mem_coe, implies_true_iff] + +@[simp] theorem disj_Union_cons (a : α) (s : finset α) (ha : a ∉ s) (f : α → finset β) (H) : + disj_Union (cons a s ha) f H = (f a).disj_union + (s.disj_Union f $ + λ b hb c hc, H (mem_cons_of_mem hb) (mem_cons_of_mem hc)) + (disjoint_left.mpr $ λ b hb h, let ⟨c, hc, h⟩ := mem_disj_Union.mp h in + disjoint_left.mp + (H (mem_cons_self a s) (mem_cons_of_mem hc) (ne_of_mem_of_not_mem hc ha).symm) hb h) + := +eq_of_veq $ multiset.cons_bind _ _ _ + +@[simp] lemma singleton_disj_Union (a : α) {h} : finset.disj_Union {a} t h = t a := +eq_of_veq $ multiset.singleton_bind _ _ + + +lemma disj_Union_disj_Union (s : finset α) (f : α → finset β) (g : β → finset γ) (h1 h2) : + (s.disj_Union f h1).disj_Union g h2 = + s.attach.disj_Union (λ a, (f a).disj_Union g $ + λ b hb c hc, h2 (mem_disj_Union.mpr ⟨_, a.prop, hb⟩) (mem_disj_Union.mpr ⟨_, a.prop, hc⟩)) + (λ a ha b hb hab, disjoint_left.mpr $ λ x hxa hxb, begin + obtain ⟨xa, hfa, hga⟩ := mem_disj_Union.mp hxa, + obtain ⟨xb, hfb, hgb⟩ := mem_disj_Union.mp hxb, + refine disjoint_left.mp (h2 + (mem_disj_Union.mpr ⟨_, a.prop, hfa⟩) (mem_disj_Union.mpr ⟨_, b.prop, hfb⟩) _) hga hgb, + rintro rfl, + exact disjoint_left.mp (h1 a.prop b.prop $ subtype.coe_injective.ne hab) hfa hfb, + end) := +eq_of_veq $ multiset.bind_assoc.trans (multiset.attach_bind_coe _ _).symm + +lemma disj_Union_filter_eq_of_maps_to [decidable_eq β] {s : finset α} {t : finset β} {f : α → β} + (h : ∀ x ∈ s, f x ∈ t) : + t.disj_Union (λ a, s.filter $ (λ c, f c = a)) + (λ x' hx y' hy hne, disjoint_filter_filter' _ _ begin + simp_rw [pi.disjoint_iff, Prop.disjoint_iff], + rintros i ⟨rfl, rfl⟩, + exact hne rfl, + end) = s := +ext $ λ b, by simpa using h b + +end disj_Union + section bUnion /-! ### bUnion @@ -2289,7 +2411,7 @@ protected def bUnion (s : finset α) (t : α → finset β) : finset β := @[simp] lemma mem_bUnion {b : β} : b ∈ s.bUnion t ↔ ∃ a ∈ s, b ∈ t a := by simp only [mem_def, bUnion_val, mem_dedup, mem_bind, exists_prop] -@[simp] lemma coe_bUnion : (s.bUnion t : set β) = ⋃ x ∈ (s : set α), t x := +@[simp, norm_cast] lemma coe_bUnion : (s.bUnion t : set β) = ⋃ x ∈ (s : set α), t x := by simp only [set.ext_iff, mem_bUnion, set.mem_Union, iff_self, mem_coe, implies_true_iff] @[simp] theorem bUnion_insert [decidable_eq α] {a : α} : (insert a s).bUnion t = t a ∪ s.bUnion t := @@ -2300,6 +2422,14 @@ ext $ λ x, by simp only [mem_bUnion, exists_prop, mem_union, mem_insert, lemma bUnion_congr (hs : s₁ = s₂) (ht : ∀ a ∈ s₁, t₁ a = t₂ a) : s₁.bUnion t₁ = s₂.bUnion t₂ := ext $ λ x, by simp [hs, ht] { contextual := tt } +@[simp] lemma disj_Union_eq_bUnion (s : finset α) (f : α → finset β) (hf) : + s.disj_Union f hf = s.bUnion f := +begin + dsimp [disj_Union, finset.bUnion, function.comp], + generalize_proofs h, + exact eq_of_veq h.dedup.symm, +end + theorem bUnion_subset {s' : finset β} : s.bUnion t ⊆ s' ↔ ∀ x ∈ s, t x ⊆ s' := by simp only [subset_iff, mem_bUnion]; exact ⟨λ H a ha b hb, H ⟨a, ha, hb⟩, λ H b ⟨a, ha, hb⟩, H a ha hb⟩ @@ -2319,18 +2449,6 @@ theorem inter_bUnion (t : finset β) (s : finset α) (f : α → finset β) : t ∩ s.bUnion f = s.bUnion (λ x, t ∩ f x) := by rw [inter_comm, bUnion_inter]; simp [inter_comm] -theorem image_bUnion [decidable_eq γ] {f : α → β} {s : finset α} {t : β → finset γ} : - (s.image f).bUnion t = s.bUnion (λa, t (f a)) := -by haveI := classical.dec_eq α; exact -finset.induction_on s rfl (λ a s has ih, - by simp only [image_insert, bUnion_insert, ih]) - -theorem bUnion_image [decidable_eq γ] {s : finset α} {t : α → finset β} {f : β → γ} : - (s.bUnion t).image f = s.bUnion (λa, (t a).image f) := -by haveI := classical.dec_eq α; exact -finset.induction_on s rfl (λ a s has ih, - by simp only [bUnion_insert, image_union, ih]) - lemma bUnion_bUnion [decidable_eq γ] (s : finset α) (f : α → finset β) (g : β → finset γ) : (s.bUnion f).bUnion g = s.bUnion (λ a, (f a).bUnion g) := begin @@ -2365,11 +2483,8 @@ singleton_bUnion.superset.trans $ bUnion_subset_bUnion_of_subset_left u $ single ⟨λ h x hx, (subset_bUnion_of_mem f hx).trans h, λ h x hx, let ⟨a, ha₁, ha₂⟩ := mem_bUnion.mp hx in h _ ha₁ ha₂⟩ -lemma bUnion_singleton {f : α → β} : s.bUnion (λa, {f a}) = s.image f := -ext $ λ x, by simp only [mem_bUnion, mem_image, mem_singleton, eq_comm] - @[simp] lemma bUnion_singleton_eq_self [decidable_eq α] : s.bUnion (singleton : α → finset α) = s := -by { rw bUnion_singleton, exact image_id } +ext $ λ x, by simp only [mem_bUnion, mem_singleton, exists_prop, exists_eq_right'] lemma filter_bUnion (s : finset α) (f : α → finset β) (p : β → Prop) [decidable_pred p] : (s.bUnion f).filter p = s.bUnion (λ a, (f a).filter p) := @@ -2385,12 +2500,8 @@ end lemma bUnion_filter_eq_of_maps_to [decidable_eq α] {s : finset α} {t : finset β} {f : α → β} (h : ∀ x ∈ s, f x ∈ t) : - t.bUnion (λa, s.filter $ (λc, f c = a)) = s := -ext $ λ b, by simpa using h b - -lemma image_bUnion_filter_eq [decidable_eq α] (s : finset β) (g : β → α) : - (s.image g).bUnion (λa, s.filter $ (λc, g c = a)) = s := -bUnion_filter_eq_of_maps_to (λ x, mem_image_of_mem g) + t.bUnion (λ a, s.filter $ (λ c, f c = a)) = s := +by simpa only [disj_Union_eq_bUnion] using disj_Union_filter_eq_of_maps_to h lemma erase_bUnion (f : α → finset β) (s : finset α) (b : β) : (s.bUnion f).erase b = s.bUnion (λ x, (f x).erase b) := @@ -2402,74 +2513,7 @@ by simp [finset.nonempty, ← exists_and_distrib_left, @exists_swap α] lemma nonempty.bUnion (hs : s.nonempty) (ht : ∀ x ∈ s, (t x).nonempty) : (s.bUnion t).nonempty := bUnion_nonempty.2 $ hs.imp $ λ x hx, ⟨hx, ht x hx⟩ -end bUnion - -/-! ### disjoint -/ ---TODO@Yaël: Kill lemmas duplicate with `boolean_algebra` -section disjoint -variables [decidable_eq α] [decidable_eq β] {f : α → β} {s t u : finset α} {a b : α} - -lemma disjoint_left : disjoint s t ↔ ∀ {a}, a ∈ s → a ∉ t := -by simp only [_root_.disjoint, inf_eq_inter, le_iff_subset, subset_iff, mem_inter, not_and, - and_imp]; refl - -lemma disjoint_val : disjoint s t ↔ s.1.disjoint t.1 := disjoint_left -lemma disjoint_iff_inter_eq_empty : disjoint s t ↔ s ∩ t = ∅ := disjoint_iff - -instance decidable_disjoint (U V : finset α) : decidable (disjoint U V) := -decidable_of_decidable_of_iff (by apply_instance) eq_bot_iff - -lemma disjoint_right : disjoint s t ↔ ∀ {a}, a ∈ t → a ∉ s := by rw [disjoint.comm, disjoint_left] -lemma disjoint_iff_ne : disjoint s t ↔ ∀ a ∈ s, ∀ b ∈ t, a ≠ b := -by simp only [disjoint_left, imp_not_comm, forall_eq'] - -lemma _root_.disjoint.forall_ne_finset (h : disjoint s t) (ha : a ∈ s) (hb : b ∈ t) : a ≠ b := -disjoint_iff_ne.1 h _ ha _ hb - -lemma not_disjoint_iff : ¬ disjoint s t ↔ ∃ a, a ∈ s ∧ a ∈ t := -not_forall.trans $ exists_congr $ λ a, not_not.trans mem_inter - -lemma disjoint_of_subset_left (h : s ⊆ u) (d : disjoint u t) : disjoint s t := -disjoint_left.2 (λ x m₁, (disjoint_left.1 d) (h m₁)) - -lemma disjoint_of_subset_right (h : t ⊆ u) (d : disjoint s u) : disjoint s t := -disjoint_right.2 (λ x m₁, (disjoint_right.1 d) (h m₁)) - -@[simp] theorem disjoint_empty_left (s : finset α) : disjoint ∅ s := disjoint_bot_left -@[simp] theorem disjoint_empty_right (s : finset α) : disjoint s ∅ := disjoint_bot_right - -@[simp] lemma disjoint_singleton_left : disjoint (singleton a) s ↔ a ∉ s := -by simp only [disjoint_left, mem_singleton, forall_eq] - -@[simp] lemma disjoint_singleton_right : disjoint s (singleton a) ↔ a ∉ s := -disjoint.comm.trans disjoint_singleton_left - -@[simp] lemma disjoint_singleton : disjoint ({a} : finset α) {b} ↔ a ≠ b := -by rw [disjoint_singleton_left, mem_singleton] - -@[simp] lemma disjoint_insert_left : disjoint (insert a s) t ↔ a ∉ t ∧ disjoint s t := -by simp only [disjoint_left, mem_insert, or_imp_distrib, forall_and_distrib, forall_eq] - -@[simp] lemma disjoint_insert_right : disjoint s (insert a t) ↔ a ∉ s ∧ disjoint s t := -disjoint.comm.trans $ by rw [disjoint_insert_left, disjoint.comm] - -@[simp] lemma disjoint_union_left : disjoint (s ∪ t) u ↔ disjoint s u ∧ disjoint t u := -by simp only [disjoint_left, mem_union, or_imp_distrib, forall_and_distrib] - -@[simp] lemma disjoint_union_right : disjoint s (t ∪ u) ↔ disjoint s t ∧ disjoint s u := -by simp only [disjoint_right, mem_union, or_imp_distrib, forall_and_distrib] - -lemma sdiff_disjoint : disjoint (t \ s) s := disjoint_left.2 $ assume a ha, (mem_sdiff.1 ha).2 -lemma disjoint_sdiff : disjoint s (t \ s) := sdiff_disjoint.symm - -lemma disjoint_sdiff_inter (s t : finset α) : disjoint (s \ t) (s ∩ t) := -disjoint_of_subset_right (inter_subset_right _ _) sdiff_disjoint - -lemma sdiff_eq_self_iff_disjoint : s \ t = s ↔ disjoint s t := sdiff_eq_self_iff_disjoint' -lemma sdiff_eq_self_of_disjoint (h : disjoint s t) : s \ t = s := sdiff_eq_self_iff_disjoint.2 h -lemma disjoint_self_iff_empty (s : finset α) : disjoint s s ↔ s = ∅ := disjoint_self - -lemma disjoint_bUnion_left {ι : Type*} (s : finset ι) (f : ι → finset α) (t : finset α) : +lemma disjoint_bUnion_left (s : finset α) (f : α → finset β) (t : finset β) : disjoint (s.bUnion f) t ↔ (∀ i ∈ s, disjoint (f i) t) := begin classical, @@ -2479,43 +2523,11 @@ begin simp only [disjoint_union_left, bUnion_insert, his, forall_mem_insert, ih] } end -lemma disjoint_bUnion_right {ι : Type*} (s : finset α) (t : finset ι) (f : ι → finset α) : +lemma disjoint_bUnion_right (s : finset β) (t : finset α) (f : α → finset β) : disjoint s (t.bUnion f) ↔ ∀ i ∈ t, disjoint s (f i) := by simpa only [disjoint.comm] using disjoint_bUnion_left t f s -lemma disjoint_filter {p q : α → Prop} [decidable_pred p] [decidable_pred q] : - disjoint (s.filter p) (s.filter q) ↔ ∀ x ∈ s, p x → ¬ q x := -by split; simp [disjoint_left] {contextual := tt} - -lemma disjoint_filter_filter {p q : α → Prop} [decidable_pred p] [decidable_pred q] : - (disjoint s t) → disjoint (s.filter p) (t.filter q) := -disjoint.mono (filter_subset _ _) (filter_subset _ _) - -lemma disjoint_filter_filter_neg (s : finset α) (p : α → Prop) [decidable_pred p] : - disjoint (s.filter p) (s.filter $ λ a, ¬ p a) := -(disjoint_filter.2 $ λ a _, id).symm - -lemma disjoint_iff_disjoint_coe : disjoint s t ↔ disjoint (s : set α) (t : set α) := -by { rw [finset.disjoint_left, set.disjoint_left], refl } - -@[simp] lemma _root_.disjoint.of_image_finset (h : disjoint (s.image f) (t.image f)) : - disjoint s t := -disjoint_iff_ne.2 $ λ a ha b hb, ne_of_apply_ne f $ h.forall_ne_finset - (mem_image_of_mem _ ha) (mem_image_of_mem _ hb) - -@[simp] lemma disjoint_image {f : α → β} (hf : injective f) : - disjoint (s.image f) (t.image f) ↔ disjoint s t := -begin - simp only [disjoint_iff_ne, mem_image, exists_prop, exists_imp_distrib, and_imp], - refine ⟨λ h a ha b hb hab, h _ _ ha rfl _ _ hb rfl $ congr_arg _ hab, _⟩, - rintro h _ a ha rfl _ b hb rfl, - exact hf.ne (h _ ha _ hb), -end - -@[simp] lemma disjoint_map {f : α ↪ β} : disjoint (s.map f) (t.map f) ↔ disjoint s t := -by { simp_rw map_eq_image, exact disjoint_image f.injective } - -end disjoint +end bUnion /-! ### choose -/ section choose @@ -2544,11 +2556,7 @@ variables {s : finset α} lemma pairwise_subtype_iff_pairwise_finset' (r : β → β → Prop) (f : α → β) : pairwise (r on λ x : s, f x) ↔ (s : set α).pairwise (r on f) := -begin - refine ⟨λ h x hx y hy hxy, h ⟨x, hx⟩ ⟨y, hy⟩ (by simpa only [subtype.mk_eq_mk, ne.def]), _⟩, - rintros h ⟨x, hx⟩ ⟨y, hy⟩ hxy, - exact h hx hy (subtype.mk_eq_mk.not.mp hxy) -end +pairwise_subtype_iff_pairwise_set (s : set α) (r on f) lemma pairwise_subtype_iff_pairwise_finset (r : α → α → Prop) : pairwise (r on λ x : s, x) ↔ (s : set α).pairwise r := @@ -2572,24 +2580,6 @@ end finset namespace equiv -/-- Given an equivalence `α` to `β`, produce an equivalence between `finset α` and `finset β`. -/ -protected def finset_congr (e : α ≃ β) : finset α ≃ finset β := -{ to_fun := λ s, s.map e.to_embedding, - inv_fun := λ s, s.map e.symm.to_embedding, - left_inv := λ s, by simp [finset.map_map], - right_inv := λ s, by simp [finset.map_map] } - -@[simp] lemma finset_congr_apply (e : α ≃ β) (s : finset α) : - e.finset_congr s = s.map e.to_embedding := -rfl - -@[simp] lemma finset_congr_refl : (equiv.refl α).finset_congr = equiv.refl _ := by { ext, simp } -@[simp] lemma finset_congr_symm (e : α ≃ β) : e.finset_congr.symm = e.symm.finset_congr := rfl - -@[simp] lemma finset_congr_trans (e : α ≃ β) (e' : β ≃ γ) : - e.finset_congr.trans (e'.finset_congr) = (e.trans e').finset_congr := -by { ext, simp [-finset.mem_map, -equiv.trans_to_embedding] } - /-- Inhabited types are equivalent to `option β` for some `β` by identifying `default α` with `none`. -/ @@ -2597,7 +2587,7 @@ def sigma_equiv_option_of_inhabited (α : Type u) [inhabited α] [decidable_eq Σ (β : Type u), α ≃ option β := ⟨{x : α // x ≠ default}, { to_fun := λ (x : α), if h : x = default then none else some ⟨x, h⟩, - inv_fun := λ o, option.elim o (default) coe, + inv_fun := option.elim default coe, left_inv := λ x, by { dsimp only, split_ifs; simp [*] }, right_inv := begin rintro (_|⟨x,h⟩), @@ -2634,3 +2624,8 @@ lemma disjoint_to_finset_iff_disjoint : _root_.disjoint l.to_finset l'.to_finset multiset.disjoint_to_finset end list + +-- Assert that we define `finset` without the material on `list.sublists`. +-- Note that we cannot use `list.sublists` itself as that is defined very early. +assert_not_exists list.sublists_len +assert_not_exists multiset.powerset diff --git a/src/data/finset/card.lean b/src/data/finset/card.lean index 13778c0ec9a3c..ae354aa222531 100644 --- a/src/data/finset/card.lean +++ b/src/data/finset/card.lean @@ -3,12 +3,15 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad -/ -import data.finset.basic +import data.finset.image import tactic.by_contra /-! # Cardinality of a finite set +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines the cardinality of a `finset` and provides induction principles for finsets. ## Main declarations @@ -39,6 +42,7 @@ variables {s t : finset α} {a b : α} def card (s : finset α) : ℕ := s.1.card lemma card_def (s : finset α) : s.card = s.1.card := rfl +@[simp] lemma card_val (s : finset α) : s.1.card = s.card := rfl @[simp] lemma card_mk {m nodup} : (⟨m, nodup⟩ : finset α).card = m.card := rfl @@ -53,7 +57,7 @@ lemma card_le_of_subset : s ⊆ t → s.card ≤ t.card := multiset.card_le_of_l lemma card_pos : 0 < s.card ↔ s.nonempty := pos_iff_ne_zero.trans $ (not_congr card_eq_zero).trans nonempty_iff_ne_empty.symm -alias finset.card_pos ↔ _ finset.nonempty.card_pos +alias card_pos ↔ _ nonempty.card_pos lemma card_ne_zero_of_mem (h : a ∈ s) : s.card ≠ 0 := (not_congr card_eq_zero).2 $ ne_empty_of_mem h @@ -160,7 +164,7 @@ begin exact inj_on_of_nodup_map this, end -lemma card_image_eq_iff_inj_on [decidable_eq β] : (s.image f).card = s.card ↔ set.inj_on f s := +lemma card_image_iff [decidable_eq β] : (s.image f).card = s.card ↔ set.inj_on f s := ⟨inj_on_of_card_image_eq, card_image_of_inj_on⟩ lemma card_image_of_injective [decidable_eq β] (s : finset α) (H : injective f) : @@ -184,6 +188,12 @@ card_le_of_subset $ filter_subset _ _ lemma eq_of_subset_of_card_le {s t : finset α} (h : s ⊆ t) (h₂ : t.card ≤ s.card) : s = t := eq_of_veq $ multiset.eq_of_le_of_card_le (val_le_iff.mpr h) h₂ +lemma eq_of_superset_of_card_ge (hst : s ⊆ t) (hts : t.card ≤ s.card) : t = s := +(eq_of_subset_of_card_le hst hts).symm + +lemma subset_iff_eq_of_card_le (h : t.card ≤ s.card) : s ⊆ t ↔ s = t := +⟨λ hst, eq_of_subset_of_card_le hst h, eq.subset'⟩ + lemma map_eq_of_subset {f : α ↪ α} (hs : s.map f ⊆ s) : s.map f = s := eq_of_subset_of_card_le hs (card_map _).ge @@ -301,11 +311,14 @@ variables [decidable_eq α] lemma card_union_add_card_inter (s t : finset α) : (s ∪ t).card + (s ∩ t).card = s.card + t.card := finset.induction_on t (by simp) $ λ a r har, by by_cases a ∈ s; simp *; cc +lemma card_inter_add_card_union (s t : finset α) : (s ∩ t).card + (s ∪ t).card = s.card + t.card := +by rw [add_comm, card_union_add_card_inter] + lemma card_union_le (s t : finset α) : (s ∪ t).card ≤ s.card + t.card := card_union_add_card_inter s t ▸ nat.le_add_right _ _ lemma card_union_eq (h : disjoint s t) : (s ∪ t).card = s.card + t.card := -by rw [←disj_union_eq_union s t $ λ x, disjoint_left.mp h, card_disj_union _ _ _] +by rw [←disj_union_eq_union s t h, card_disj_union _ _ _] @[simp] lemma card_disjoint_union (h : disjoint s t) : card (s ∪ t) = s.card + t.card := card_union_eq h @@ -323,6 +336,9 @@ calc card t - card s ... = card (t \ (s ∩ t)) : (card_sdiff (inter_subset_right s t)).symm ... ≤ card (t \ s) : by rw sdiff_inter_self_right t s +lemma card_le_card_sdiff_add_card : s.card ≤ (s \ t).card + t.card := +tsub_le_iff_right.1 $ le_card_sdiff _ _ + lemma card_sdiff_add_card : (s \ t).card + t.card = (s ∪ t).card := by rw [←card_disjoint_union sdiff_disjoint, sdiff_union_self_eq_union] @@ -419,6 +435,13 @@ begin exact card_le_of_subset hx } end +lemma exists_mem_ne (hs : 1 < s.card) (a : α) : ∃ b ∈ s, b ≠ a := +begin + by_contra', + haveI : nonempty α := ⟨a⟩, + exact hs.not_le (card_le_one_iff_subset_singleton.2 ⟨a, subset_singleton_iff'.2 this⟩), +end + /-- A `finset` of a subsingleton type has cardinality at most one. -/ lemma card_le_one_of_subsingleton [subsingleton α] (s : finset α) : s.card ≤ 1 := finset.card_le_one_iff.2 $ λ _ _ _ _, subsingleton.elim _ _ diff --git a/src/data/finset/default.lean b/src/data/finset/default.lean deleted file mode 100644 index fb51ca936bb36..0000000000000 --- a/src/data/finset/default.lean +++ /dev/null @@ -1,9 +0,0 @@ -import data.finset.basic -import data.finset.fold -import data.finset.lattice -import data.finset.locally_finite -import data.finset.nat_antidiagonal -import data.finset.pi -import data.finset.powerset -import data.finset.sort -import data.finset.preimage diff --git a/src/data/finset/fin.lean b/src/data/finset/fin.lean index 4fb4f1955eb37..e034777f9a1b1 100644 --- a/src/data/finset/fin.lean +++ b/src/data/finset/fin.lean @@ -8,11 +8,13 @@ import data.finset.card /-! # Finsets in `fin n` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + A few constructions for finsets in `fin n`. ## Main declarations -* `finset.fin_range`: `{0, 1, ..., n - 1}` as a `finset (fin n)`. * `finset.attach_fin`: Turns a finset of naturals strictly less than `n` into a `finset (fin n)`. -/ @@ -20,18 +22,6 @@ variables {n : ℕ} namespace finset -/-- `finset.fin_range n` is the finset `{0, 1, ..., n - 1}`, as a `finset (fin n)`. -/ -def fin_range (n : ℕ) : finset (fin n) := ⟨list.fin_range n, list.nodup_fin_range n⟩ - -@[simp] -lemma fin_range_card : (fin_range n).card = n := by simp [fin_range] - -@[simp] -lemma mem_fin_range (m : fin n) : m ∈ fin_range n := list.mem_fin_range m - -@[simp] lemma coe_fin_range (n : ℕ) : (fin_range n : set (fin n)) = set.univ := -set.eq_univ_of_forall mem_fin_range - /-- Given a finset `s` of `ℕ` contained in `{0,..., n-1}`, the corresponding finset in `fin n` is `s.attach_fin h` where `h` is a proof that all elements of `s` are less than `n`. -/ def attach_fin (s : finset ℕ) {n : ℕ} (h : ∀ m ∈ s, m < n) : finset (fin n) := diff --git a/src/data/finset/finsupp.lean b/src/data/finset/finsupp.lean index bdff527eeafe4..9bed84e1c0669 100644 --- a/src/data/finset/finsupp.lean +++ b/src/data/finset/finsupp.lean @@ -3,13 +3,17 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ +import algebra.big_operators.finsupp import data.finset.pointwise import data.finsupp.indicator -import data.fintype.card +import data.fintype.big_operators /-! # Finitely supported product of finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the finitely supported product of finsets as a `finset (ι →₀ α)`. ## Main declarations diff --git a/src/data/finset/fold.lean b/src/data/finset/fold.lean index 725e3bfd48945..9ebaefe51cdc6 100644 --- a/src/data/finset/fold.lean +++ b/src/data/finset/fold.lean @@ -3,11 +3,15 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.finset.basic +import algebra.order.monoid.with_top +import data.finset.image import data.multiset.fold /-! # The fold operation for a commutative associative operation over a finset. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace finset @@ -18,7 +22,7 @@ variables {α β γ : Type*} /-! ### fold -/ section fold variables (op : β → β → β) [hc : is_commutative β op] [ha : is_associative β op] -local notation a * b := op a b +local notation (name := op) a ` * ` b := op a b include hc ha /-- `fold op b f s` folds the commutative associative operation `op` over the @@ -30,11 +34,11 @@ variables {op} {f : α → β} {b : β} {s : finset α} {a : α} @[simp] theorem fold_empty : (∅ : finset α).fold op b f = b := rfl @[simp] theorem fold_cons (h : a ∉ s) : (cons a s h).fold op b f = f a * s.fold op b f := -by { dunfold fold, rw [cons_val, map_cons, fold_cons_left], } +by { dunfold fold, rw [cons_val, multiset.map_cons, fold_cons_left], } @[simp] theorem fold_insert [decidable_eq α] (h : a ∉ s) : (insert a s).fold op b f = f a * s.fold op b f := -by unfold fold; rw [insert_val, ndinsert_of_not_mem h, map_cons, fold_cons_left] +by unfold fold; rw [insert_val, ndinsert_of_not_mem h, multiset.map_cons, fold_cons_left] @[simp] theorem fold_singleton : ({a} : finset α).fold op b f = f a * b := rfl @@ -70,6 +74,14 @@ theorem fold_hom {op' : γ → γ → γ} [is_commutative γ op'] [is_associativ s.fold op' (m b) (λx, m (f x)) = m (s.fold op b f) := by rw [fold, fold, ← fold_hom op hm, multiset.map_map] +theorem fold_disj_union {s₁ s₂ : finset α} {b₁ b₂ : β} (h) : + (s₁.disj_union s₂ h).fold op (b₁ * b₂) f = s₁.fold op b₁ f * s₂.fold op b₂ f := +(congr_arg _ $ multiset.map_add _ _ _).trans (multiset.fold_add _ _ _ _ _) + +theorem fold_disj_Union {ι : Type*} {s : finset ι} {t : ι → finset α} {b : ι → β} {b₀ : β} (h) : + (s.disj_Union t h).fold op (s.fold op b₀ b) f = s.fold op b₀ (λ i, (t i).fold op (b i) f) := +(congr_arg _ $ multiset.map_bind _ _ _).trans (multiset.fold_bind _ _ _ _ _) + theorem fold_union_inter [decidable_eq α] {s₁ s₂ : finset α} {b₁ b₂ : β} : (s₁ ∪ s₂).fold op b₁ f * (s₁ ∩ s₂).fold op b₂ f = s₁.fold op b₂ f * s₂.fold op b₁ f := by unfold fold; rw [← fold_add op, ← multiset.map_add, union_val, @@ -226,6 +238,11 @@ end lemma lt_fold_max : c < s.fold max b f ↔ (c < b ∨ ∃ x∈s, c < f x) := fold_op_rel_iff_or $ λ x y z, lt_max_iff +lemma fold_max_add [has_add β] [covariant_class β β (function.swap (+)) (≤)] + (n : with_bot β) (s : finset α) : + s.fold max ⊥ (λ (x : α), ↑(f x) + n) = s.fold max ⊥ (coe ∘ f) + n := +by { classical, apply s.induction_on; simp [max_add_add_right] {contextual := tt} } + end order end fold diff --git a/src/data/finset/functor.lean b/src/data/finset/functor.lean index d3073272295de..32dd58644474c 100644 --- a/src/data/finset/functor.lean +++ b/src/data/finset/functor.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Scott Morrison -/ import data.finset.lattice +import data.finset.n_ary import data.multiset.functor /-! # Functoriality of `finset` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the functor structure of `finset`. ## TODO @@ -64,6 +68,12 @@ instance : applicative finset := @[simp] lemma seq_left_def (s : finset α) (t : finset β) : s <* t = if t = ∅ then ∅ else s := rfl @[simp] lemma seq_right_def (s : finset α) (t : finset β) : s *> t = if s = ∅ then ∅ else t := rfl +/-- `finset.image₂` in terms of monadic operations. Note that this can't be taken as the definition +because of the lack of universe polymorphism. -/ +lemma image₂_def {α β γ : Type*} (f : α → β → γ) (s : finset α) (t : finset β) : + image₂ f s t = f <$> s <*> t := +by { ext, simp [mem_sup] } + instance : is_lawful_applicative finset := { seq_left_eq := λ α β s t, begin rw [seq_def, fmap_def, seq_left_def], @@ -110,7 +120,7 @@ instance : is_comm_applicative finset := { commutative_prod := λ α β s t, begin simp_rw [seq_def, fmap_def, sup_image, sup_eq_bUnion], change s.bUnion (λ a, t.image $ λ b, (a, b)) = t.bUnion (λ b, s.image $ λ a, (a, b)), - transitivity s.product t; + transitivity s ×ˢ t; [rw product_eq_bUnion, rw product_eq_bUnion_right]; congr; ext; simp_rw mem_image, end, .. finset.is_lawful_applicative } diff --git a/src/data/finset/image.lean b/src/data/finset/image.lean new file mode 100644 index 0000000000000..74a678a27cabc --- /dev/null +++ b/src/data/finset/image.lean @@ -0,0 +1,636 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura, Jeremy Avigad, Minchao Wu, Mario Carneiro +-/ +import algebra.hom.embedding +import data.fin.basic +import data.finset.basic +import data.int.order.basic + +/-! # Image and map operations on finite sets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Thie file provides the finite analog of `set.image`, along with some other similar functions. + +Note there are two ways to take the image over a finset; via `finset.image` which applies the +function then removes duplicates (requiring `decidable_eq`), or via `finset.map` which exploits +injectivity of the function to avoid needing to deduplicate. Choosing between these is similar to +choosing between `insert` and `finset.cons`, or between `finset.union` and `finset.disj_union`. + +## Main definitions + +* `finset.image`: Given a function `f : α → β`, `s.image f` is the image finset in `β`. +* `finset.map`: Given an embedding `f : α ↪ β`, `s.map f` is the image finset in `β`. +* `finset.subtype`: `s.subtype p` is the the finset of `subtype p` whose elements belong to `s`. +* `finset.fin`:`s.fin n` is the finset of all elements of `s` less than `n`. + +-/ + +variables {α β γ : Type*} +open multiset +open function + +namespace finset + +/-! ### map -/ +section map +open function + +/-- When `f` is an embedding of `α` in `β` and `s` is a finset in `α`, then `s.map f` is the image +finset in `β`. The embedding condition guarantees that there are no duplicates in the image. -/ +def map (f : α ↪ β) (s : finset α) : finset β := ⟨s.1.map f, s.2.map f.2⟩ + +@[simp] theorem map_val (f : α ↪ β) (s : finset α) : (map f s).1 = s.1.map f := rfl + +@[simp] theorem map_empty (f : α ↪ β) : (∅ : finset α).map f = ∅ := rfl + +variables {f : α ↪ β} {s : finset α} + +@[simp] theorem mem_map {b : β} : b ∈ s.map f ↔ ∃ a ∈ s, f a = b := +mem_map.trans $ by simp only [exists_prop]; refl + +@[simp] lemma mem_map_equiv {f : α ≃ β} {b : β} : b ∈ s.map f.to_embedding ↔ f.symm b ∈ s := +by { rw mem_map, exact ⟨by { rintro ⟨a, H, rfl⟩, simpa }, λ h, ⟨_, h, by simp⟩⟩ } + +lemma mem_map' (f : α ↪ β) {a} {s : finset α} : f a ∈ s.map f ↔ a ∈ s := mem_map_of_injective f.2 + +lemma mem_map_of_mem (f : α ↪ β) {a} {s : finset α} : a ∈ s → f a ∈ s.map f := (mem_map' _).2 + +lemma forall_mem_map {f : α ↪ β} {s : finset α} {p : Π a, a ∈ s.map f → Prop} : + (∀ y ∈ s.map f, p y H) ↔ ∀ x ∈ s, p (f x) (mem_map_of_mem _ H) := +⟨λ h y hy, h (f y) (mem_map_of_mem _ hy), λ h x hx, + by { obtain ⟨y, hy, rfl⟩ := mem_map.1 hx, exact h _ hy }⟩ + +lemma apply_coe_mem_map (f : α ↪ β) (s : finset α) (x : s) : f x ∈ s.map f := +mem_map_of_mem f x.prop + +@[simp, norm_cast] theorem coe_map (f : α ↪ β) (s : finset α) : (s.map f : set β) = f '' s := +set.ext $ λ x, mem_map.trans set.mem_image_iff_bex.symm + +theorem coe_map_subset_range (f : α ↪ β) (s : finset α) : (s.map f : set β) ⊆ set.range f := +calc ↑(s.map f) = f '' s : coe_map f s + ... ⊆ set.range f : set.image_subset_range f ↑s + +/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect. +-/ +lemma map_perm {σ : equiv.perm α} (hs : {a | σ a ≠ a} ⊆ s) : s.map (σ : α ↪ α) = s := +coe_injective $ (coe_map _ _).trans $ set.image_perm hs + +theorem map_to_finset [decidable_eq α] [decidable_eq β] {s : multiset α} : + s.to_finset.map f = (s.map f).to_finset := +ext $ λ _, by simp only [mem_map, multiset.mem_map, exists_prop, multiset.mem_to_finset] + +@[simp] theorem map_refl : s.map (embedding.refl _) = s := +ext $ λ _, by simpa only [mem_map, exists_prop] using exists_eq_right + +@[simp] theorem map_cast_heq {α β} (h : α = β) (s : finset α) : + s.map (equiv.cast h).to_embedding == s := +by { subst h, simp } + +theorem map_map (f : α ↪ β) (g : β ↪ γ) (s : finset α) : (s.map f).map g = s.map (f.trans g) := +eq_of_veq $ by simp only [map_val, multiset.map_map]; refl + +lemma map_comm {β'} {f : β ↪ γ} {g : α ↪ β} {f' : α ↪ β'} {g' : β' ↪ γ} + (h_comm : ∀ a, f (g a) = g' (f' a)) : + (s.map g).map f = (s.map f').map g' := +by simp_rw [map_map, embedding.trans, function.comp, h_comm] + +lemma _root_.function.semiconj.finset_map {f : α ↪ β} {ga : α ↪ α} {gb : β ↪ β} + (h : function.semiconj f ga gb) : + function.semiconj (map f) (map ga) (map gb) := +λ s, map_comm h + +lemma _root_.function.commute.finset_map {f g : α ↪ α} (h : function.commute f g) : + function.commute (map f) (map g) := +h.finset_map + +@[simp] theorem map_subset_map {s₁ s₂ : finset α} : s₁.map f ⊆ s₂.map f ↔ s₁ ⊆ s₂ := +⟨λ h x xs, (mem_map' _).1 $ h $ (mem_map' f).2 xs, + λ h, by simp [subset_def, map_subset_map h]⟩ + +/-- Associate to an embedding `f` from `α` to `β` the order embedding that maps a finset to its +image under `f`. -/ +def map_embedding (f : α ↪ β) : finset α ↪o finset β := +order_embedding.of_map_le_iff (map f) (λ _ _, map_subset_map) + +@[simp] theorem map_inj {s₁ s₂ : finset α} : s₁.map f = s₂.map f ↔ s₁ = s₂ := +(map_embedding f).injective.eq_iff + +lemma map_injective (f : α ↪ β) : injective (map f) := (map_embedding f).injective + +@[simp] theorem map_embedding_apply : map_embedding f s = map f s := rfl + +lemma filter_map {p : β → Prop} [decidable_pred p] : + (s.map f).filter p = (s.filter (p ∘ f)).map f := +eq_of_veq (map_filter _ _ _) + +lemma map_filter' (p : α → Prop) [decidable_pred p] (f : α ↪ β) (s : finset α) + [decidable_pred (λ b, ∃ a, p a ∧ f a = b)] : + (s.filter p).map f = (s.map f).filter (λ b, ∃ a, p a ∧ f a = b) := +by simp [(∘), filter_map, f.injective.eq_iff] + +lemma filter_attach' [decidable_eq α] (s : finset α) (p : s → Prop) [decidable_pred p] : + s.attach.filter p = + (s.filter $ λ x, ∃ h, p ⟨x, h⟩).attach.map ⟨subtype.map id $ filter_subset _ _, + subtype.map_injective _ injective_id⟩ := +eq_of_veq $ multiset.filter_attach' _ _ + +@[simp] lemma filter_attach (p : α → Prop) [decidable_pred p] (s : finset α) : + (s.attach.filter (λ x, p ↑x)) = + (s.filter p).attach.map ((embedding.refl _).subtype_map mem_of_mem_filter) := +eq_of_veq $ multiset.filter_attach _ _ + +lemma map_filter {f : α ≃ β} {p : α → Prop} [decidable_pred p] : + (s.filter p).map f.to_embedding = (s.map f.to_embedding).filter (p ∘ f.symm) := +by simp only [filter_map, function.comp, equiv.to_embedding_apply, equiv.symm_apply_apply] + +@[simp] lemma disjoint_map {s t : finset α} (f : α ↪ β) : + disjoint (s.map f) (t.map f) ↔ disjoint s t := +begin + simp only [disjoint_iff_ne, mem_map, exists_prop, exists_imp_distrib, and_imp], + refine ⟨λ h a ha b hb hab, h _ _ ha rfl _ _ hb rfl $ congr_arg _ hab, _⟩, + rintro h _ a ha rfl _ b hb rfl, + exact f.injective.ne (h _ ha _ hb), +end + +theorem map_disj_union {f : α ↪ β} (s₁ s₂ : finset α) (h) (h' := (disjoint_map _).mpr h) : + (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' := +eq_of_veq $ multiset.map_add _ _ _ + +/-- A version of `finset.map_disj_union` for writing in the other direction. -/ +theorem map_disj_union' {f : α ↪ β} (s₁ s₂ : finset α) (h') (h := (disjoint_map _).mp h') : + (s₁.disj_union s₂ h).map f = (s₁.map f).disj_union (s₂.map f) h' := +map_disj_union _ _ _ + +theorem map_union [decidable_eq α] [decidable_eq β] + {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∪ s₂).map f = s₁.map f ∪ s₂.map f := +coe_injective $ by simp only [coe_map, coe_union, set.image_union] + +theorem map_inter [decidable_eq α] [decidable_eq β] + {f : α ↪ β} (s₁ s₂ : finset α) : (s₁ ∩ s₂).map f = s₁.map f ∩ s₂.map f := +coe_injective $ by simp only [coe_map, coe_inter, set.image_inter f.injective] + +@[simp] theorem map_singleton (f : α ↪ β) (a : α) : map f {a} = {f a} := +coe_injective $ by simp only [coe_map, coe_singleton, set.image_singleton] + +@[simp] lemma map_insert [decidable_eq α] [decidable_eq β] (f : α ↪ β) (a : α) (s : finset α) : + (insert a s).map f = insert (f a) (s.map f) := +by simp only [insert_eq, map_union, map_singleton] + +@[simp] lemma map_cons (f : α ↪ β) (a : α) (s : finset α) (ha : a ∉ s) : + (cons a s ha).map f = cons (f a) (s.map f) (by simpa using ha) := +eq_of_veq $ multiset.map_cons f a s.val + +@[simp] theorem map_eq_empty : s.map f = ∅ ↔ s = ∅ := +⟨λ h, eq_empty_of_forall_not_mem $ + λ a m, ne_empty_of_mem (mem_map_of_mem _ m) h, λ e, e.symm ▸ rfl⟩ + +@[simp] lemma map_nonempty : (s.map f).nonempty ↔ s.nonempty := +by rw [nonempty_iff_ne_empty, nonempty_iff_ne_empty, ne.def, map_eq_empty] + +alias map_nonempty ↔ _ nonempty.map + +lemma attach_map_val {s : finset α} : s.attach.map (embedding.subtype _) = s := +eq_of_veq $ by rw [map_val, attach_val]; exact attach_map_val _ + +lemma disjoint_range_add_left_embedding (a b : ℕ) : + disjoint (range a) (map (add_left_embedding a) (range b)) := +begin + refine disjoint_iff_inf_le.mpr _, + intros k hk, + simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply, + mem_inter] at hk, + obtain ⟨a, haQ, ha⟩ := hk.2, + simpa [← ha] using hk.1, +end + +lemma disjoint_range_add_right_embedding (a b : ℕ) : + disjoint (range a) (map (add_right_embedding a) (range b)) := +begin + refine disjoint_iff_inf_le.mpr _, + intros k hk, + simp only [exists_prop, mem_range, inf_eq_inter, mem_map, add_left_embedding_apply, + mem_inter] at hk, + obtain ⟨a, haQ, ha⟩ := hk.2, + simpa [← ha] using hk.1, +end + +theorem map_disj_Union {f : α ↪ β} {s : finset α} {t : β → finset γ} {h} : + (s.map f).disj_Union t h = s.disj_Union (λa, t (f a)) + (λ a ha b hb hab, h (mem_map_of_mem _ ha) (mem_map_of_mem _ hb) (f.injective.ne hab)) := +eq_of_veq $ multiset.bind_map _ _ _ + +theorem disj_Union_map {s : finset α} {t : α → finset β} {f : β ↪ γ} {h} : + (s.disj_Union t h).map f = s.disj_Union (λa, (t a).map f) + (λ a ha b hb hab, disjoint_left.mpr $ λ x hxa hxb, begin + obtain ⟨xa, hfa, rfl⟩ := mem_map.mp hxa, + obtain ⟨xb, hfb, hfab⟩ := mem_map.mp hxb, + obtain rfl := f.injective hfab, + exact disjoint_left.mp (h ha hb hab) hfa hfb, + end) := +eq_of_veq $ multiset.map_bind _ _ _ + +end map + +lemma range_add_one' (n : ℕ) : + range (n + 1) = insert 0 ((range n).map ⟨λi, i + 1, assume i j, nat.succ.inj⟩) := +by ext (⟨⟩ | ⟨n⟩); simp [nat.succ_eq_add_one, nat.zero_lt_succ n] + +/-! ### image -/ + +section image +variables [decidable_eq β] + +/-- `image f s` is the forward image of `s` under `f`. -/ +def image (f : α → β) (s : finset α) : finset β := (s.1.map f).to_finset + +@[simp] theorem image_val (f : α → β) (s : finset α) : (image f s).1 = (s.1.map f).dedup := rfl + +@[simp] theorem image_empty (f : α → β) : (∅ : finset α).image f = ∅ := rfl + +variables {f g : α → β} {s : finset α} {t : finset β} {a : α} {b c : β} + +@[simp] lemma mem_image : b ∈ s.image f ↔ ∃ a ∈ s, f a = b := +by simp only [mem_def, image_val, mem_dedup, multiset.mem_map, exists_prop] + +lemma mem_image_of_mem (f : α → β) {a} (h : a ∈ s) : f a ∈ s.image f := mem_image.2 ⟨_, h, rfl⟩ + +lemma forall_image {p : β → Prop} : (∀ b ∈ s.image f, p b) ↔ ∀ a ∈ s, p (f a) := +by simp only [mem_image, forall_exists_index, forall_apply_eq_imp_iff₂] + +@[simp] lemma mem_image_const : c ∈ s.image (const α b) ↔ s.nonempty ∧ b = c := +by { rw mem_image, simp only [exists_prop, const_apply, exists_and_distrib_right], refl } + +lemma mem_image_const_self : b ∈ s.image (const α b) ↔ s.nonempty := +mem_image_const.trans $ and_iff_left rfl + +instance can_lift (c) (p) [can_lift β α c p] : + can_lift (finset β) (finset α) (image c) (λ s, ∀ x ∈ s, p x) := +{ prf := + begin + rintro ⟨⟨l⟩, hd : l.nodup⟩ hl, + lift l to list α using hl, + exact ⟨⟨l, hd.of_map _⟩, ext $ λ a, by simp⟩, + end } + +lemma image_congr (h : (s : set α).eq_on f g) : finset.image f s = finset.image g s := +by { ext, simp_rw mem_image, exact bex_congr (λ x hx, by rw h hx) } + +lemma _root_.function.injective.mem_finset_image (hf : injective f) : f a ∈ s.image f ↔ a ∈ s := +begin + refine ⟨λ h, _, finset.mem_image_of_mem f⟩, + obtain ⟨y, hy, heq⟩ := mem_image.1 h, + exact hf heq ▸ hy, +end + +lemma filter_mem_image_eq_image (f : α → β) (s : finset α) (t : finset β) (h : ∀ x ∈ s, f x ∈ t) : + t.filter (λ y, y ∈ s.image f) = s.image f := +by { ext, rw [mem_filter, mem_image], + simp only [and_imp, exists_prop, and_iff_right_iff_imp, exists_imp_distrib], + rintros x xel rfl, exact h _ xel } + +lemma fiber_nonempty_iff_mem_image (f : α → β) (s : finset α) (y : β) : + (s.filter (λ x, f x = y)).nonempty ↔ y ∈ s.image f := +by simp [finset.nonempty] + +@[simp, norm_cast] lemma coe_image {f : α → β} : ↑(s.image f) = f '' ↑s := +set.ext $ λ _, mem_image.trans set.mem_image_iff_bex.symm + +protected lemma nonempty.image (h : s.nonempty) (f : α → β) : (s.image f).nonempty := +let ⟨a, ha⟩ := h in ⟨f a, mem_image_of_mem f ha⟩ + +@[simp] lemma nonempty.image_iff (f : α → β) : (s.image f).nonempty ↔ s.nonempty := +⟨λ ⟨y, hy⟩, let ⟨x, hx, _⟩ := mem_image.mp hy in ⟨x, hx⟩, λ h, h.image f⟩ + +theorem image_to_finset [decidable_eq α] {s : multiset α} : + s.to_finset.image f = (s.map f).to_finset := +ext $ λ _, by simp only [mem_image, multiset.mem_to_finset, exists_prop, multiset.mem_map] + +lemma image_val_of_inj_on (H : set.inj_on f s) : (image f s).1 = s.1.map f := (s.2.map_on H).dedup + +@[simp] lemma image_id [decidable_eq α] : s.image id = s := +ext $ λ _, by simp only [mem_image, exists_prop, id, exists_eq_right] + +@[simp] theorem image_id' [decidable_eq α] : s.image (λ x, x) = s := image_id + +theorem image_image [decidable_eq γ] {g : β → γ} : (s.image f).image g = s.image (g ∘ f) := +eq_of_veq $ by simp only [image_val, dedup_map_dedup_eq, multiset.map_map] + +lemma image_comm {β'} [decidable_eq β'] [decidable_eq γ] {f : β → γ} {g : α → β} + {f' : α → β'} {g' : β' → γ} (h_comm : ∀ a, f (g a) = g' (f' a)) : + (s.image g).image f = (s.image f').image g' := +by simp_rw [image_image, comp, h_comm] + +lemma _root_.function.semiconj.finset_image [decidable_eq α] {f : α → β} {ga : α → α} {gb : β → β} + (h : function.semiconj f ga gb) : + function.semiconj (image f) (image ga) (image gb) := +λ s, image_comm h + +lemma _root_.function.commute.finset_image [decidable_eq α] {f g : α → α} + (h : function.commute f g) : + function.commute (image f) (image g) := +h.finset_image + +theorem image_subset_image {s₁ s₂ : finset α} (h : s₁ ⊆ s₂) : s₁.image f ⊆ s₂.image f := +by simp only [subset_def, image_val, subset_dedup', dedup_subset', + multiset.map_subset_map h] + +lemma image_subset_iff : s.image f ⊆ t ↔ ∀ x ∈ s, f x ∈ t := +calc s.image f ⊆ t ↔ f '' ↑s ⊆ ↑t : by norm_cast + ... ↔ _ : set.image_subset_iff + +theorem image_mono (f : α → β) : monotone (finset.image f) := λ _ _, image_subset_image + +lemma image_subset_image_iff {t : finset α} (hf : injective f) : s.image f ⊆ t.image f ↔ s ⊆ t := +by { simp_rw ←coe_subset, push_cast, exact set.image_subset_image_iff hf } + +theorem coe_image_subset_range : ↑(s.image f) ⊆ set.range f := +calc ↑(s.image f) = f '' ↑s : coe_image + ... ⊆ set.range f : set.image_subset_range f ↑s + +theorem image_filter {p : β → Prop} [decidable_pred p] : + (s.image f).filter p = (s.filter (p ∘ f)).image f := +ext $ λ b, by simp only [mem_filter, mem_image, exists_prop]; exact +⟨by rintro ⟨⟨x, h1, rfl⟩, h2⟩; exact ⟨x, ⟨h1, h2⟩, rfl⟩, + by rintro ⟨x, ⟨h1, h2⟩, rfl⟩; exact ⟨⟨x, h1, rfl⟩, h2⟩⟩ + +theorem image_union [decidable_eq α] {f : α → β} (s₁ s₂ : finset α) : + (s₁ ∪ s₂).image f = s₁.image f ∪ s₂.image f := +ext $ λ _, by simp only [mem_image, mem_union, exists_prop, or_and_distrib_right, + exists_or_distrib] + +lemma image_inter_subset [decidable_eq α] (f : α → β) (s t : finset α) : + (s ∩ t).image f ⊆ s.image f ∩ t.image f := +subset_inter (image_subset_image $ inter_subset_left _ _) $ + image_subset_image $ inter_subset_right _ _ + +lemma image_inter_of_inj_on [decidable_eq α] {f : α → β} (s t : finset α) + (hf : set.inj_on f (s ∪ t)) : + (s ∩ t).image f = s.image f ∩ t.image f := +coe_injective $ by { push_cast, exact set.image_inter_on (λ a ha b hb, hf (or.inr ha) $ or.inl hb) } + +lemma image_inter [decidable_eq α] (s₁ s₂ : finset α) (hf : injective f) : + (s₁ ∩ s₂).image f = s₁.image f ∩ s₂.image f := +image_inter_of_inj_on _ _ $ hf.inj_on _ + +@[simp] theorem image_singleton (f : α → β) (a : α) : image f {a} = {f a} := +ext $ λ x, by simpa only [mem_image, exists_prop, mem_singleton, exists_eq_left] using eq_comm + +@[simp] theorem image_insert [decidable_eq α] (f : α → β) (a : α) (s : finset α) : + (insert a s).image f = insert (f a) (s.image f) := +by simp only [insert_eq, image_singleton, image_union] + +lemma erase_image_subset_image_erase [decidable_eq α] (f : α → β) (s : finset α) (a : α) : + (s.image f).erase (f a) ⊆ (s.erase a).image f := +begin + simp only [subset_iff, and_imp, exists_prop, mem_image, exists_imp_distrib, mem_erase], + rintro b hb x hx rfl, + exact ⟨_, ⟨ne_of_apply_ne f hb, hx⟩, rfl⟩, +end + +@[simp] lemma image_erase [decidable_eq α] {f : α → β} (hf : injective f) (s : finset α) (a : α) : + (s.erase a).image f = (s.image f).erase (f a) := +begin + refine (erase_image_subset_image_erase _ _ _).antisymm' (λ b, _), + simp only [mem_image, exists_prop, mem_erase], + rintro ⟨a', ⟨haa', ha'⟩, rfl⟩, + exact ⟨hf.ne haa', a', ha', rfl⟩, +end + +@[simp] theorem image_eq_empty : s.image f = ∅ ↔ s = ∅ := +⟨λ h, eq_empty_of_forall_not_mem $ + λ a m, ne_empty_of_mem (mem_image_of_mem _ m) h, λ e, e.symm ▸ rfl⟩ + +lemma image_sdiff [decidable_eq α] {f : α → β} (s t : finset α) (hf : injective f) : + (s \ t).image f = s.image f \ t.image f := +coe_injective $ by { push_cast, exact set.image_diff hf _ _ } + +lemma image_symm_diff [decidable_eq α] {f : α → β} (s t : finset α) (hf : injective f) : + (s ∆ t).image f = s.image f ∆ t.image f := +coe_injective $ by { push_cast, exact set.image_symm_diff hf _ _ } + +@[simp] lemma _root_.disjoint.of_image_finset + {s t : finset α} {f : α → β} (h : disjoint (s.image f) (t.image f)) : + disjoint s t := +disjoint_iff_ne.2 $ λ a ha b hb, ne_of_apply_ne f $ h.forall_ne_finset + (mem_image_of_mem _ ha) (mem_image_of_mem _ hb) + +lemma mem_range_iff_mem_finset_range_of_mod_eq' [decidable_eq α] {f : ℕ → α} {a : α} {n : ℕ} + (hn : 0 < n) (h : ∀ i, f (i % n) = f i) : + a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) := +begin + split, + { rintros ⟨i, hi⟩, + simp only [mem_image, exists_prop, mem_range], + exact ⟨i % n, nat.mod_lt i hn, (rfl.congr hi).mp (h i)⟩ }, + { rintro h, + simp only [mem_image, exists_prop, set.mem_range, mem_range] at *, + rcases h with ⟨i, hi, ha⟩, + exact ⟨i, ha⟩ } +end + +lemma mem_range_iff_mem_finset_range_of_mod_eq [decidable_eq α] {f : ℤ → α} {a : α} {n : ℕ} + (hn : 0 < n) (h : ∀ i, f (i % n) = f i) : + a ∈ set.range f ↔ a ∈ (finset.range n).image (λi, f i) := +suffices (∃ i, f (i % n) = a) ↔ ∃ i, i < n ∧ f ↑i = a, by simpa [h], +have hn' : 0 < (n : ℤ), from int.coe_nat_lt.mpr hn, +iff.intro + (assume ⟨i, hi⟩, + have 0 ≤ i % ↑n, from int.mod_nonneg _ (ne_of_gt hn'), + ⟨int.to_nat (i % n), + by rw [←int.coe_nat_lt, int.to_nat_of_nonneg this]; exact ⟨int.mod_lt_of_pos i hn', hi⟩⟩) + (assume ⟨i, hi, ha⟩, + ⟨i, by rw [int.mod_eq_of_lt (int.coe_zero_le _) (int.coe_nat_lt_coe_nat_of_lt hi), ha]⟩) + +lemma range_add (a b : ℕ) : range (a + b) = range a ∪ (range b).map (add_left_embedding a) := +by { rw [←val_inj, union_val], exact multiset.range_add_eq_union a b } + +@[simp] lemma attach_image_val [decidable_eq α] {s : finset α} : s.attach.image subtype.val = s := +eq_of_veq $ by rw [image_val, attach_val, multiset.attach_map_val, dedup_eq_self] + +@[simp] lemma attach_image_coe [decidable_eq α] {s : finset α} : s.attach.image coe = s := +finset.attach_image_val + +@[simp] lemma attach_insert [decidable_eq α] {a : α} {s : finset α} : + attach (insert a s) = insert (⟨a, mem_insert_self a s⟩ : {x // x ∈ insert a s}) + ((attach s).image (λx, ⟨x.1, mem_insert_of_mem x.2⟩)) := +ext $ λ ⟨x, hx⟩, ⟨or.cases_on (mem_insert.1 hx) + (λ h : x = a, λ _, mem_insert.2 $ or.inl $ subtype.eq h) + (λ h : x ∈ s, λ _, mem_insert_of_mem $ mem_image.2 $ ⟨⟨x, h⟩, mem_attach _ _, subtype.eq rfl⟩), +λ _, finset.mem_attach _ _⟩ + +theorem map_eq_image (f : α ↪ β) (s : finset α) : s.map f = s.image f := +eq_of_veq (s.map f).2.dedup.symm + +@[simp] lemma disjoint_image + {s t : finset α} {f : α → β} (hf : injective f) : + disjoint (s.image f) (t.image f) ↔ disjoint s t := +by convert disjoint_map ⟨_, hf⟩; simp [map_eq_image] + +lemma image_const {s : finset α} (h : s.nonempty) (b : β) : s.image (λa, b) = singleton b := +ext $ assume b', by simp only [mem_image, exists_prop, exists_and_distrib_right, + h.bex, true_and, mem_singleton, eq_comm] + +@[simp] lemma map_erase [decidable_eq α] (f : α ↪ β) (s : finset α) (a : α) : + (s.erase a).map f = (s.map f).erase (f a) := +by { simp_rw map_eq_image, exact s.image_erase f.2 a } + +theorem image_bUnion [decidable_eq γ] {f : α → β} {s : finset α} {t : β → finset γ} : + (s.image f).bUnion t = s.bUnion (λa, t (f a)) := +by haveI := classical.dec_eq α; exact +finset.induction_on s rfl (λ a s has ih, + by simp only [image_insert, bUnion_insert, ih]) + +theorem bUnion_image [decidable_eq γ] {s : finset α} {t : α → finset β} {f : β → γ} : + (s.bUnion t).image f = s.bUnion (λa, (t a).image f) := +by haveI := classical.dec_eq α; exact +finset.induction_on s rfl (λ a s has ih, + by simp only [bUnion_insert, image_union, ih]) + +lemma image_bUnion_filter_eq [decidable_eq α] (s : finset β) (g : β → α) : + (s.image g).bUnion (λa, s.filter $ (λc, g c = a)) = s := +bUnion_filter_eq_of_maps_to (λ x, mem_image_of_mem g) + +lemma bUnion_singleton {f : α → β} : s.bUnion (λa, {f a}) = s.image f := +ext $ λ x, by simp only [mem_bUnion, mem_image, mem_singleton, eq_comm] + +end image + +/-! ### Subtype -/ +section subtype + +/-- Given a finset `s` and a predicate `p`, `s.subtype p` is the finset of `subtype p` whose +elements belong to `s`. -/ +protected def subtype {α} (p : α → Prop) [decidable_pred p] (s : finset α) : finset (subtype p) := +(s.filter p).attach.map ⟨λ x, ⟨x.1, (finset.mem_filter.1 x.2).2⟩, +λ x y H, subtype.eq $ subtype.mk.inj H⟩ + +@[simp] lemma mem_subtype {p : α → Prop} [decidable_pred p] {s : finset α} : + ∀ {a : subtype p}, a ∈ s.subtype p ↔ (a : α) ∈ s +| ⟨a, ha⟩ := by simp [finset.subtype, ha] + +lemma subtype_eq_empty {p : α → Prop} [decidable_pred p] {s : finset α} : + s.subtype p = ∅ ↔ ∀ x, p x → x ∉ s := +by simp [ext_iff, subtype.forall, subtype.coe_mk]; refl + +@[mono] lemma subtype_mono {p : α → Prop} [decidable_pred p] : monotone (finset.subtype p) := +λ s t h x hx, mem_subtype.2 $ h $ mem_subtype.1 hx + +/-- `s.subtype p` converts back to `s.filter p` with +`embedding.subtype`. -/ +@[simp] lemma subtype_map (p : α → Prop) [decidable_pred p] {s : finset α} : + (s.subtype p).map (embedding.subtype _) = s.filter p := +begin + ext x, + simp [and_comm _ (_ = _), @and.left_comm _ (_ = _), and_comm (p x) (x ∈ s)] +end + +/-- If all elements of a `finset` satisfy the predicate `p`, +`s.subtype p` converts back to `s` with `embedding.subtype`. -/ +lemma subtype_map_of_mem {p : α → Prop} [decidable_pred p] {s : finset α} (h : ∀ x ∈ s, p x) : + (s.subtype p).map (embedding.subtype _) = s := +by rw [subtype_map, filter_true_of_mem h] + +/-- If a `finset` of a subtype is converted to the main type with +`embedding.subtype`, all elements of the result have the property of +the subtype. -/ +lemma property_of_mem_map_subtype {p : α → Prop} (s : finset {x // p x}) {a : α} + (h : a ∈ s.map (embedding.subtype _)) : p a := +begin + rcases mem_map.1 h with ⟨x, hx, rfl⟩, + exact x.2 +end + +/-- If a `finset` of a subtype is converted to the main type with +`embedding.subtype`, the result does not contain any value that does +not satisfy the property of the subtype. -/ +lemma not_mem_map_subtype_of_not_property {p : α → Prop} (s : finset {x // p x}) + {a : α} (h : ¬ p a) : a ∉ (s.map (embedding.subtype _)) := +mt s.property_of_mem_map_subtype h + +/-- If a `finset` of a subtype is converted to the main type with +`embedding.subtype`, the result is a subset of the set giving the +subtype. -/ +lemma map_subtype_subset {t : set α} (s : finset t) : ↑(s.map (embedding.subtype _)) ⊆ t := +begin + intros a ha, + rw mem_coe at ha, + convert property_of_mem_map_subtype s ha +end + +end subtype + +/-! ### Fin -/ + +/-- +Given a finset `s` of natural numbers and a bound `n`, +`s.fin n` is the finset of all elements of `s` less than `n`. +-/ +protected def fin (n : ℕ) (s : finset ℕ) : finset (fin n) := +(s.subtype _).map fin.equiv_subtype.symm.to_embedding + +@[simp] lemma mem_fin {n} {s : finset ℕ} : + ∀ a : fin n, a ∈ s.fin n ↔ (a : ℕ) ∈ s +| ⟨a, ha⟩ := by simp [finset.fin] + +@[mono] lemma fin_mono {n} : monotone (finset.fin n) := +λ s t h x, by simpa using @h x + +@[simp] lemma fin_map {n} {s : finset ℕ} : (s.fin n).map fin.coe_embedding = s.filter (< n) := +by simp [finset.fin, finset.map_map] + +lemma subset_image_iff [decidable_eq β] {s : set α} {t : finset β} {f : α → β}: + ↑t ⊆ f '' s ↔ ∃ s' : finset α, ↑s' ⊆ s ∧ s'.image f = t := +begin + split, swap, + { rintro ⟨t, ht, rfl⟩, rw [coe_image], exact set.image_subset f ht }, + intro h, + letI : can_lift β s (f ∘ coe) (λ y, y ∈ f '' s) := ⟨λ y ⟨x, hxt, hy⟩, ⟨⟨x, hxt⟩, hy⟩⟩, + lift t to finset s using h, + refine ⟨t.map (embedding.subtype _), map_subtype_subset _, _⟩, + ext y, simp +end + +lemma range_sdiff_zero {n : ℕ} : range (n + 1) \ {0} = (range n).image nat.succ := +begin + induction n with k hk, + { simp }, + nth_rewrite 1 range_succ, + rw [range_succ, image_insert, ←hk, insert_sdiff_of_not_mem], + simp +end + +end finset + +lemma _root_.multiset.to_finset_map [decidable_eq α] [decidable_eq β] (f : α → β) (m : multiset α) : + (m.map f).to_finset = m.to_finset.image f := +finset.val_inj.1 (multiset.dedup_map_dedup_eq _ _).symm + + +namespace equiv + +/-- Given an equivalence `α` to `β`, produce an equivalence between `finset α` and `finset β`. -/ +protected def finset_congr (e : α ≃ β) : finset α ≃ finset β := +{ to_fun := λ s, s.map e.to_embedding, + inv_fun := λ s, s.map e.symm.to_embedding, + left_inv := λ s, by simp [finset.map_map], + right_inv := λ s, by simp [finset.map_map] } + +@[simp] lemma finset_congr_apply (e : α ≃ β) (s : finset α) : + e.finset_congr s = s.map e.to_embedding := +rfl + +@[simp] lemma finset_congr_refl : (equiv.refl α).finset_congr = equiv.refl _ := by { ext, simp } +@[simp] lemma finset_congr_symm (e : α ≃ β) : e.finset_congr.symm = e.symm.finset_congr := rfl + +@[simp] lemma finset_congr_trans (e : α ≃ β) (e' : β ≃ γ) : + e.finset_congr.trans (e'.finset_congr) = (e.trans e').finset_congr := +by { ext, simp [-finset.mem_map, -equiv.trans_to_embedding] } + +lemma finset_congr_to_embedding (e : α ≃ β) : + e.finset_congr.to_embedding = (finset.map_embedding e.to_embedding).to_embedding := rfl + +end equiv diff --git a/src/data/finset/interval.lean b/src/data/finset/interval.lean index 6d6db2e17a73d..a8e5585b4c7da 100644 --- a/src/data/finset/interval.lean +++ b/src/data/finset/interval.lean @@ -8,6 +8,9 @@ import data.finset.locally_finite /-! # Intervals of finsets as finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides the `locally_finite_order` instance for `finset α` and calculates the cardinality of finite intervals of finsets. @@ -68,7 +71,7 @@ end /-- Cardinality of a non-empty `Icc` of finsets. -/ lemma card_Icc_finset (h : s ⊆ t) : (Icc s t).card = 2 ^ (t.card - s.card) := begin - rw [←card_sdiff h, ←card_powerset, Icc_eq_image_powerset h, finset.card_image_eq_iff_inj_on], + rw [←card_sdiff h, ←card_powerset, Icc_eq_image_powerset h, finset.card_image_iff], rintro u hu v hv (huv : s ⊔ u = s ⊔ v), rw [mem_coe, mem_powerset] at hu hv, rw [←(disjoint_sdiff.mono_right hu : disjoint s u).sup_sdiff_cancel_left, @@ -87,4 +90,12 @@ by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc_finset h] lemma card_Ioo_finset (h : s ⊆ t) : (Ioo s t).card = 2 ^ (t.card - s.card) - 2 := by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc_finset h] +/-- Cardinality of an `Iic` of finsets. -/ +lemma card_Iic_finset : (Iic s).card = 2 ^ s.card := +by rw [Iic_eq_powerset, card_powerset] + +/-- Cardinality of an `Iio` of finsets. -/ +lemma card_Iio_finset : (Iio s).card = 2 ^ s.card - 1 := +by rw [Iio_eq_ssubsets, ssubsets, card_erase_of_mem (mem_powerset_self _), card_powerset] + end finset diff --git a/src/data/finset/lattice.lean b/src/data/finset/lattice.lean index 7e275fba769c7..60a235f53593d 100644 --- a/src/data/finset/lattice.lean +++ b/src/data/finset/lattice.lean @@ -5,15 +5,20 @@ Authors: Mario Carneiro -/ import data.finset.fold import data.finset.option +import data.finset.pi import data.finset.prod import data.multiset.lattice import order.complete_lattice -import order.lexicographic +import order.hom.lattice + /-! # Lattice operations on finsets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ -variables {α β γ ι : Type*} +variables {F α β γ ι κ : Type*} namespace finset open multiset order_dual @@ -26,7 +31,7 @@ variables [semilattice_sup α] [order_bot α] /-- Supremum of a finite set: `sup {a, b, c} f = f a ⊔ f b ⊔ f c` -/ def sup (s : finset β) (f : β → α) : α := s.fold (⊔) ⊥ f -variables {s s₁ s₂ : finset β} {f g : β → α} +variables {s s₁ s₂ : finset β} {f g : β → α} {a : α} lemma sup_def : s.sup f = (s.1.map f).sup := rfl @@ -50,10 +55,6 @@ fold_map @[simp] lemma sup_singleton {b : β} : ({b} : finset β).sup f = f b := sup_singleton -lemma sup_union [decidable_eq β] : (s₁ ∪ s₂).sup f = s₁.sup f ⊔ s₂.sup f := -finset.induction_on s₁ (by rw [empty_union, sup_empty, bot_sup_eq]) $ λ a s has ih, -by rw [insert_union, sup_insert, sup_insert, ih, sup_assoc] - lemma sup_sup : s.sup (f ⊔ g) = s.sup f ⊔ s.sup g := begin refine finset.cons_induction_on s _ (λ b t _ h, _), @@ -62,22 +63,39 @@ begin exact sup_sup_sup_comm _ _ _ _ } end -theorem sup_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a∈s₂, f a = g a) : s₁.sup f = s₂.sup g := +theorem sup_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀ a ∈ s₂, f a = g a) : s₁.sup f = s₂.sup g := by subst hs; exact finset.fold_congr hfg -@[simp] lemma sup_le_iff {a : α} : s.sup f ≤ a ↔ (∀b ∈ s, f b ≤ a) := +@[simp] lemma _root_.map_finset_sup [semilattice_sup β] [order_bot β] [sup_bot_hom_class F α β] + (f : F) (s : finset ι) (g : ι → α) : f (s.sup g) = s.sup (f ∘ g) := +finset.cons_induction_on s (map_bot f) $ λ i s _ h, by rw [sup_cons, sup_cons, map_sup, h] + +@[simp] protected lemma sup_le_iff {a : α} : s.sup f ≤ a ↔ (∀ b ∈ s, f b ≤ a) := begin apply iff.trans multiset.sup_le, simp only [multiset.mem_map, and_imp, exists_imp_distrib], exact ⟨λ k b hb, k _ _ hb rfl, λ k a' b hb h, h ▸ k _ hb⟩, end +alias finset.sup_le_iff ↔ _ sup_le + +attribute [protected] sup_le + +lemma sup_const_le : s.sup (λ _, a) ≤ a := finset.sup_le $ λ _ _, le_rfl + +lemma le_sup {b : β} (hb : b ∈ s) : f b ≤ s.sup f := finset.sup_le_iff.1 le_rfl _ hb + +lemma le_sup_of_le {b : β} (hb : b ∈ s) (h : a ≤ f b) : a ≤ s.sup f := h.trans $ le_sup hb + +lemma sup_union [decidable_eq β] : (s₁ ∪ s₂).sup f = s₁.sup f ⊔ s₂.sup f := +eq_of_forall_ge_iff $ λ c, by simp [or_imp_distrib, forall_and_distrib] + @[simp] lemma sup_bUnion [decidable_eq β] (s : finset γ) (t : γ → finset β) : (s.bUnion t).sup f = s.sup (λ x, (t x).sup f) := eq_of_forall_ge_iff $ λ c, by simp [@forall_swap _ β] lemma sup_const {s : finset β} (h : s.nonempty) (c : α) : s.sup (λ _, c) = c := -eq_of_forall_ge_iff $ λ b, sup_le_iff.trans h.forall_const +eq_of_forall_ge_iff $ λ b, finset.sup_le_iff.trans h.forall_const @[simp] lemma sup_bot (s : finset β) : s.sup (λ _, ⊥) = (⊥ : α) := begin @@ -91,44 +109,26 @@ lemma sup_ite (p : β → Prop) [decidable_pred p] : (s.filter p).sup f ⊔ (s.filter (λ i, ¬ p i)).sup g := fold_ite _ -lemma sup_le {a : α} : (∀b ∈ s, f b ≤ a) → s.sup f ≤ a := -sup_le_iff.2 - -lemma le_sup {b : β} (hb : b ∈ s) : f b ≤ s.sup f := -sup_le_iff.1 le_rfl _ hb - -lemma sup_mono_fun {g : β → α} (h : ∀b∈s, f b ≤ g b) : s.sup f ≤ s.sup g := -sup_le (λ b hb, le_trans (h b hb) (le_sup hb)) +lemma sup_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ≤ g b) : s.sup f ≤ s.sup g := +finset.sup_le (λ b hb, le_trans (h b hb) (le_sup hb)) -lemma sup_mono (h : s₁ ⊆ s₂) : s₁.sup f ≤ s₂.sup f := -sup_le $ assume b hb, le_sup (h hb) +lemma sup_mono (h : s₁ ⊆ s₂) : s₁.sup f ≤ s₂.sup f := finset.sup_le $ λ b hb, le_sup $ h hb -lemma sup_comm (s : finset β) (t : finset γ) (f : β → γ → α) : +protected lemma sup_comm (s : finset β) (t : finset γ) (f : β → γ → α) : s.sup (λ b, t.sup (f b)) = t.sup (λ c, s.sup (λ b, f b c)) := -begin - refine eq_of_forall_ge_iff (λ a, _), - simp_rw sup_le_iff, - exact ⟨λ h c hc b hb, h b hb c hc, λ h b hb c hc, h c hc b hb⟩, -end +eq_of_forall_ge_iff $ λ a, by simpa using forall₂_swap @[simp] lemma sup_attach (s : finset β) (f : β → α) : s.attach.sup (λ x, f x) = s.sup f := (s.attach.sup_map (function.embedding.subtype _) f).symm.trans $ congr_arg _ attach_map_val /-- See also `finset.product_bUnion`. -/ lemma sup_product_left (s : finset β) (t : finset γ) (f : β × γ → α) : - (s.product t).sup f = s.sup (λ i, t.sup $ λ i', f ⟨i, i'⟩) := -begin - refine le_antisymm _ (sup_le (λ i hi, sup_le $ λ i' hi', le_sup $ mem_product.2 ⟨hi, hi'⟩)), - refine sup_le _, - rintro ⟨i, i'⟩ hi, - rw mem_product at hi, - refine le_trans _ (le_sup hi.1), - convert le_sup hi.2, -end + (s ×ˢ t).sup f = s.sup (λ i, t.sup $ λ i', f ⟨i, i'⟩) := +eq_of_forall_ge_iff $ λ a, by simp [@forall_swap _ γ] lemma sup_product_right (s : finset β) (t : finset γ) (f : β × γ → α) : - (s.product t).sup f = t.sup (λ i', s.sup $ λ i, f ⟨i, i'⟩) := -by rw [sup_product_left, sup_comm] + (s ×ˢ t).sup f = t.sup (λ i', s.sup $ λ i, f ⟨i, i'⟩) := +by rw [sup_product_left, finset.sup_comm] @[simp] lemma sup_erase_bot [decidable_eq α] (s : finset α) : (s.erase ⊥).sup id = s.sup id := begin @@ -154,7 +154,7 @@ finset.cons_induction_on s bot (λ c t hc ih, by rw [sup_cons, sup_cons, g_sup, /-- Computing `sup` in a subtype (closed under `sup`) is the same as computing it in `α`. -/ lemma sup_coe {P : α → Prop} - {Pbot : P ⊥} {Psup : ∀{{x y}}, P x → P y → P (x ⊔ y)} + {Pbot : P ⊥} {Psup : ∀ {{x y}}, P x → P y → P (x ⊔ y)} (t : finset β) (f : β → {x : α // P x}) : (@sup _ _ (subtype.semilattice_sup Psup) (subtype.order_bot Pbot) t f : α) = t.sup (λ x, f x) := by { rw [comp_sup_eq_sup_comp coe]; intros; refl } @@ -164,6 +164,14 @@ by { rw [comp_sup_eq_sup_comp coe]; intros; refl } (s.sup f).to_finset = s.sup (λ x, (f x).to_finset) := comp_sup_eq_sup_comp multiset.to_finset to_finset_union rfl +lemma _root_.list.foldr_sup_eq_sup_to_finset [decidable_eq α] (l : list α) : + l.foldr (⊔) ⊥ = l.to_finset.sup id := +begin + rw [←coe_fold_r, ←multiset.fold_dedup_idem, sup_def, ←list.to_finset_coe, to_finset_val, + multiset.map_id], + refl +end + theorem subset_range_sup_succ (s : finset ℕ) : s ⊆ range (s.sup id).succ := λ n hn, mem_range.2 $ nat.lt_succ_of_le $ le_sup hn @@ -198,7 +206,7 @@ begin -- z ∈ s is above x and y obtain ⟨z, hzs, ⟨hxz, hyz⟩⟩ := hdir x hxs y hys, use [z, hzs], - rw [sup_insert, id.def, _root_.sup_le_iff], + rw [sup_insert, id.def, sup_le_iff], exact ⟨le_trans hay hyz, le_trans hsx_sup hxz⟩, }, end @@ -211,8 +219,7 @@ lemma sup_mem @sup_induction _ _ _ _ _ _ (∈ s) w₁ w₂ h @[simp] -lemma sup_eq_bot_iff (f : β → α) - (S : finset β) : S.sup f = ⊥ ↔ ∀ s ∈ S, f s = ⊥ := +protected lemma sup_eq_bot_iff (f : β → α) (S : finset β) : S.sup f = ⊥ ↔ ∀ s ∈ S, f s = ⊥ := begin classical, induction S using finset.induction with a S haS hi; @@ -221,7 +228,7 @@ end end sup -lemma sup_eq_supr [complete_lattice β] (s : finset α) (f : α → β) : s.sup f = (⨆a∈s, f a) := +lemma sup_eq_supr [complete_lattice β] (s : finset α) (f : α → β) : s.sup f = (⨆ a ∈ s, f a) := le_antisymm (finset.sup_le $ assume a ha, le_supr_of_le a $ le_supr _ ha) (supr_le $ assume a, supr_le $ assume ha, le_sup ha) @@ -249,7 +256,7 @@ variables [semilattice_inf α] [order_top α] /-- Infimum of a finite set: `inf {a, b, c} f = f a ⊓ f b ⊓ f c` -/ def inf (s : finset β) (f : β → α) : α := s.fold (⊓) ⊤ f -variables {s s₁ s₂ : finset β} {f g : β → α} +variables {s s₁ s₂ : finset β} {f g : β → α} {a : α} lemma inf_def : s.inf f = (s.1.map f).inf := rfl @@ -273,15 +280,19 @@ fold_map @[simp] lemma inf_singleton {b : β} : ({b} : finset β).inf f = f b := inf_singleton -lemma inf_union [decidable_eq β] : (s₁ ∪ s₂).inf f = s₁.inf f ⊓ s₂.inf f := -@sup_union αᵒᵈ _ _ _ _ _ _ _ - lemma inf_inf : s.inf (f ⊓ g) = s.inf f ⊓ s.inf g := @sup_sup αᵒᵈ _ _ _ _ _ _ -theorem inf_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀a∈s₂, f a = g a) : s₁.inf f = s₂.inf g := +theorem inf_congr {f g : β → α} (hs : s₁ = s₂) (hfg : ∀ a ∈ s₂, f a = g a) : s₁.inf f = s₂.inf g := by subst hs; exact finset.fold_congr hfg +@[simp] lemma _root_.map_finset_inf [semilattice_inf β] [order_top β] [inf_top_hom_class F α β] + (f : F) (s : finset ι) (g : ι → α) : f (s.inf g) = s.inf (f ∘ g) := +finset.cons_induction_on s (map_top f) $ λ i s _ h, by rw [inf_cons, inf_cons, map_inf, h] + +lemma inf_union [decidable_eq β] : (s₁ ∪ s₂).inf f = s₁.inf f ⊓ s₂.inf f := +@sup_union αᵒᵈ _ _ _ _ _ _ _ + @[simp] lemma inf_bUnion [decidable_eq β] (s : finset γ) (t : γ → finset β) : (s.bUnion t).inf f = s.inf (λ x, (t x).inf f) := @sup_bUnion αᵒᵈ _ _ _ _ _ _ _ _ @@ -291,65 +302,42 @@ lemma inf_const {s : finset β} (h : s.nonempty) (c : α) : s.inf (λ _, c) = c @[simp] lemma inf_top (s : finset β) : s.inf (λ _, ⊤) = (⊤ : α) := @sup_bot αᵒᵈ _ _ _ _ -lemma le_inf_iff {a : α} : a ≤ s.inf f ↔ ∀ b ∈ s, a ≤ f b := -@sup_le_iff αᵒᵈ _ _ _ _ _ _ +protected lemma le_inf_iff {a : α} : a ≤ s.inf f ↔ ∀ b ∈ s, a ≤ f b := +@finset.sup_le_iff αᵒᵈ _ _ _ _ _ _ -lemma inf_le {b : β} (hb : b ∈ s) : s.inf f ≤ f b := -le_inf_iff.1 le_rfl _ hb +alias finset.le_inf_iff ↔ _ le_inf -lemma le_inf {a : α} : (∀b ∈ s, a ≤ f b) → a ≤ s.inf f := -le_inf_iff.2 +attribute [protected] le_inf -lemma inf_mono_fun {g : β → α} (h : ∀b∈s, f b ≤ g b) : s.inf f ≤ s.inf g := -le_inf (λ b hb, le_trans (inf_le hb) (h b hb)) +lemma le_inf_const_le : a ≤ s.inf (λ _, a) := finset.le_inf $ λ _ _, le_rfl -lemma inf_mono (h : s₁ ⊆ s₂) : s₂.inf f ≤ s₁.inf f := -le_inf $ assume b hb, inf_le (h hb) +lemma inf_le {b : β} (hb : b ∈ s) : s.inf f ≤ f b := finset.le_inf_iff.1 le_rfl _ hb + +lemma inf_le_of_le {b : β} (hb : b ∈ s) (h : f b ≤ a) : s.inf f ≤ a := (inf_le hb).trans h + +lemma inf_mono_fun {g : β → α} (h : ∀ b ∈ s, f b ≤ g b) : s.inf f ≤ s.inf g := +finset.le_inf (λ b hb, le_trans (inf_le hb) (h b hb)) + +lemma inf_mono (h : s₁ ⊆ s₂) : s₂.inf f ≤ s₁.inf f := finset.le_inf $ λ b hb, inf_le $h hb lemma inf_attach (s : finset β) (f : β → α) : s.attach.inf (λ x, f x) = s.inf f := @sup_attach αᵒᵈ _ _ _ _ _ -lemma inf_comm (s : finset β) (t : finset γ) (f : β → γ → α) : +protected lemma inf_comm (s : finset β) (t : finset γ) (f : β → γ → α) : s.inf (λ b, t.inf (f b)) = t.inf (λ c, s.inf (λ b, f b c)) := -@sup_comm αᵒᵈ _ _ _ _ _ _ _ +@finset.sup_comm αᵒᵈ _ _ _ _ _ _ _ lemma inf_product_left (s : finset β) (t : finset γ) (f : β × γ → α) : - (s.product t).inf f = s.inf (λ i, t.inf $ λ i', f ⟨i, i'⟩) := + (s ×ˢ t).inf f = s.inf (λ i, t.inf $ λ i', f ⟨i, i'⟩) := @sup_product_left αᵒᵈ _ _ _ _ _ _ _ lemma inf_product_right (s : finset β) (t : finset γ) (f : β × γ → α) : - (s.product t).inf f = t.inf (λ i', s.inf $ λ i, f ⟨i, i'⟩) := + (s ×ˢ t).inf f = t.inf (λ i', s.inf $ λ i, f ⟨i, i'⟩) := @sup_product_right αᵒᵈ _ _ _ _ _ _ _ @[simp] lemma inf_erase_top [decidable_eq α] (s : finset α) : (s.erase ⊤).inf id = s.inf id := @sup_erase_bot αᵒᵈ _ _ _ _ -lemma sup_sdiff_left {α β : Type*} [boolean_algebra α] (s : finset β) (f : β → α) (a : α) : - s.sup (λ b, a \ f b) = a \ s.inf f := -begin - refine finset.cons_induction_on s _ (λ b t _ h, _), - { rw [sup_empty, inf_empty, sdiff_top] }, - { rw [sup_cons, inf_cons, h, sdiff_inf] } -end - -lemma inf_sdiff_left {α β : Type*} [boolean_algebra α] {s : finset β} (hs : s.nonempty) (f : β → α) - (a : α) : - s.inf (λ b, a \ f b) = a \ s.sup f := -begin - induction hs using finset.nonempty.cons_induction with b b t _ _ h, - { rw [sup_singleton, inf_singleton] }, - { rw [sup_cons, inf_cons, h, sdiff_sup] } -end - -lemma inf_sdiff_right {α β : Type*} [boolean_algebra α] {s : finset β} (hs : s.nonempty) (f : β → α) - (a : α) : - s.inf (λ b, f b \ a) = s.inf f \ a := -begin - induction hs using finset.nonempty.cons_induction with b b t _ _ h, - { rw [inf_singleton, inf_singleton] }, - { rw [inf_cons, inf_cons, h, inf_sdiff] } -end - lemma comp_inf_eq_inf_comp [semilattice_inf γ] [order_top γ] {s : finset β} {f : β → α} (g : α → γ) (g_inf : ∀ x y, g (x ⊓ y) = g x ⊓ g y) (top : g ⊤ = ⊤) : g (s.inf f) = s.inf (g ∘ f) := @@ -357,11 +345,19 @@ lemma comp_inf_eq_inf_comp [semilattice_inf γ] [order_top γ] {s : finset β} /-- Computing `inf` in a subtype (closed under `inf`) is the same as computing it in `α`. -/ lemma inf_coe {P : α → Prop} - {Ptop : P ⊤} {Pinf : ∀{{x y}}, P x → P y → P (x ⊓ y)} + {Ptop : P ⊤} {Pinf : ∀ {{x y}}, P x → P y → P (x ⊓ y)} (t : finset β) (f : β → {x : α // P x}) : (@inf _ _ (subtype.semilattice_inf Pinf) (subtype.order_top Ptop) t f : α) = t.inf (λ x, f x) := @sup_coe αᵒᵈ _ _ _ _ Ptop Pinf t f +lemma _root_.list.foldr_inf_eq_inf_to_finset [decidable_eq α] (l : list α) : + l.foldr (⊓) ⊤ = l.to_finset.inf id := +begin + rw [←coe_fold_r, ←multiset.fold_dedup_idem, inf_def, ←list.to_finset_coe, to_finset_val, + multiset.map_id], + refl +end + lemma inf_induction {p : α → Prop} (ht : p ⊤) (hp : ∀ a₁, p a₁ → ∀ a₂, p a₂ → p (a₁ ⊓ a₂)) (hs : ∀ b ∈ s, p (f b)) : p (s.inf f) := @sup_induction αᵒᵈ _ _ _ _ _ _ ht hp hs @@ -373,17 +369,25 @@ lemma inf_mem @inf_induction _ _ _ _ _ _ (∈ s) w₁ w₂ h @[simp] -lemma inf_eq_top_iff (f : β → α) - (S : finset β) : S.inf f = ⊤ ↔ ∀ s ∈ S, f s = ⊤ := +protected lemma inf_eq_top_iff (f : β → α) (S : finset β) : S.inf f = ⊤ ↔ ∀ s ∈ S, f s = ⊤ := @finset.sup_eq_bot_iff αᵒᵈ _ _ _ _ _ end inf +@[simp] lemma to_dual_sup [semilattice_sup α] [order_bot α] (s : finset β) (f : β → α) : + to_dual (s.sup f) = s.inf (to_dual ∘ f) := rfl +@[simp] lemma to_dual_inf [semilattice_inf α] [order_top α] (s : finset β) (f : β → α) : + to_dual (s.inf f) = s.sup (to_dual ∘ f) := rfl +@[simp] lemma of_dual_sup [semilattice_inf α] [order_top α] (s : finset β) (f : β → αᵒᵈ) : + of_dual (s.sup f) = s.inf (of_dual ∘ f) := rfl +@[simp] lemma of_dual_inf [semilattice_sup α] [order_bot α] (s : finset β) (f : β → αᵒᵈ) : + of_dual (s.inf f) = s.sup (of_dual ∘ f) := rfl + section distrib_lattice variables [distrib_lattice α] section order_bot -variables [order_bot α] {s : finset β} {f : β → α} {a : α} +variables [order_bot α] {s : finset ι} {t : finset κ} {f : ι → α} {g : κ → α} {a : α} lemma sup_inf_distrib_left (s : finset ι) (f : ι → α) (a : α) : a ⊓ s.sup f = s.sup (λ i, a ⊓ f i) := @@ -397,16 +401,20 @@ lemma sup_inf_distrib_right (s : finset ι) (f : ι → α) (a : α) : s.sup f ⊓ a = s.sup (λ i, f i ⊓ a) := by { rw [_root_.inf_comm, s.sup_inf_distrib_left], simp_rw _root_.inf_comm } -lemma disjoint_sup_right : disjoint a (s.sup f) ↔ ∀ i ∈ s, disjoint a (f i) := -by simp only [disjoint_iff, sup_inf_distrib_left, sup_eq_bot_iff] +protected lemma disjoint_sup_right : disjoint a (s.sup f) ↔ ∀ ⦃i⦄, i ∈ s → disjoint a (f i) := +by simp only [disjoint_iff, sup_inf_distrib_left, finset.sup_eq_bot_iff] + +protected lemma disjoint_sup_left : disjoint (s.sup f) a ↔ ∀ ⦃i⦄, i ∈ s → disjoint (f i) a := +by simp only [disjoint_iff, sup_inf_distrib_right, finset.sup_eq_bot_iff] -lemma disjoint_sup_left : disjoint (s.sup f) a ↔ ∀ i ∈ s, disjoint (f i) a := -by simp only [disjoint_iff, sup_inf_distrib_right, sup_eq_bot_iff] +lemma sup_inf_sup (s : finset ι) (t : finset κ) (f : ι → α) (g : κ → α) : + s.sup f ⊓ t.sup g = (s ×ˢ t).sup (λ i, f i.1 ⊓ g i.2) := +by simp_rw [finset.sup_inf_distrib_right, finset.sup_inf_distrib_left, sup_product_left] end order_bot section order_top -variables [order_top α] +variables [order_top α] {f : ι → α} {g : κ → α} {s : finset ι} {t : finset κ} {a : α} lemma inf_sup_distrib_left (s : finset ι) (f : ι → α) (a : α) : a ⊔ s.inf f = s.inf (λ i, a ⊔ f i) := @@ -416,9 +424,92 @@ lemma inf_sup_distrib_right (s : finset ι) (f : ι → α) (a : α) : s.inf f ⊔ a = s.inf (λ i, f i ⊔ a) := @sup_inf_distrib_right αᵒᵈ _ _ _ _ _ _ +protected lemma codisjoint_inf_right : codisjoint a (s.inf f) ↔ ∀ ⦃i⦄, i ∈ s → codisjoint a (f i) := +@finset.disjoint_sup_right αᵒᵈ _ _ _ _ _ _ + +protected lemma codisjoint_inf_left : codisjoint (s.inf f) a ↔ ∀ ⦃i⦄, i ∈ s → codisjoint (f i) a := +@finset.disjoint_sup_left αᵒᵈ _ _ _ _ _ _ + +lemma inf_sup_inf (s : finset ι) (t : finset κ) (f : ι → α) (g : κ → α) : + s.inf f ⊔ t.inf g = (s ×ˢ t).inf (λ i, f i.1 ⊔ g i.2) := +@sup_inf_sup αᵒᵈ _ _ _ _ _ _ _ _ + end order_top + +section bounded_order +variables [bounded_order α] [decidable_eq ι] + +--TODO: Extract out the obvious isomorphism `(insert i s).pi t ≃ t i ×ˢ s.pi t` from this proof +lemma inf_sup {κ : ι → Type*} (s : finset ι) (t : Π i, finset (κ i)) (f : Π i, κ i → α) : + s.inf (λ i, (t i).sup (f i)) = (s.pi t).sup (λ g, s.attach.inf $ λ i, f _ $ g _ i.prop) := +begin + induction s using finset.induction with i s hi ih, + { simp }, + rw [inf_insert, ih, attach_insert, sup_inf_sup], + refine eq_of_forall_ge_iff (λ c, _), + simp only [subtype.val_eq_coe, finset.sup_le_iff, mem_product, mem_pi, and_imp, prod.forall, + inf_insert, inf_image], + refine ⟨λ h g hg, h (g i $ mem_insert_self _ _) (λ j hj, g j $ mem_insert_of_mem hj) + (hg _ $ mem_insert_self _ _) (λ j hj, hg _ $ mem_insert_of_mem hj), λ h a g ha hg, _⟩, + -- TODO: This `have` must be named to prevent it being shadowed by the internal `this` in `simpa` + have aux : ∀ j : {x // x ∈ s}, ↑j ≠ i := λ j : s, ne_of_mem_of_not_mem j.2 hi, + simpa only [cast_eq, dif_pos, function.comp, subtype.coe_mk, dif_neg, aux] + using h (λ j hj, if hji : j = i then cast (congr_arg κ hji.symm) a + else g _ $ mem_of_mem_insert_of_ne hj hji) _, + simp_rw mem_insert, + rintro j (rfl | hj), + { simpa }, + { simpa [ne_of_mem_of_not_mem hj hi] using hg _ _ } +end + +lemma sup_inf {κ : ι → Type*} (s : finset ι) (t : Π i, finset (κ i)) (f : Π i, κ i → α) : + s.sup (λ i, (t i).inf (f i)) = (s.pi t).inf (λ g, s.attach.sup $ λ i, f _ $ g _ i.2) := +@inf_sup αᵒᵈ _ _ _ _ _ _ _ _ + +end bounded_order end distrib_lattice +section boolean_algebra +variables [boolean_algebra α] {s : finset ι} + +lemma sup_sdiff_left (s : finset ι) (f : ι → α) (a : α) : s.sup (λ b, a \ f b) = a \ s.inf f := +begin + refine finset.cons_induction_on s _ (λ b t _ h, _), + { rw [sup_empty, inf_empty, sdiff_top] }, + { rw [sup_cons, inf_cons, h, sdiff_inf] } +end + +lemma inf_sdiff_left (hs : s.nonempty) (f : ι → α) (a : α) : s.inf (λ b, a \ f b) = a \ s.sup f := +begin + induction hs using finset.nonempty.cons_induction with b b t _ _ h, + { rw [sup_singleton, inf_singleton] }, + { rw [sup_cons, inf_cons, h, sdiff_sup] } +end + +lemma inf_sdiff_right (hs : s.nonempty) (f : ι → α) (a : α) : s.inf (λ b, f b \ a) = s.inf f \ a := +begin + induction hs using finset.nonempty.cons_induction with b b t _ _ h, + { rw [inf_singleton, inf_singleton] }, + { rw [inf_cons, inf_cons, h, inf_sdiff] } +end + +lemma inf_himp_right (s : finset ι) (f : ι → α) (a : α) : s.inf (λ b, f b ⇨ a) = s.sup f ⇨ a := +@sup_sdiff_left αᵒᵈ _ _ _ _ _ + +lemma sup_himp_right (hs : s.nonempty) (f : ι → α) (a : α) : s.sup (λ b, f b ⇨ a) = s.inf f ⇨ a := +@inf_sdiff_left αᵒᵈ _ _ _ hs _ _ + +lemma sup_himp_left (hs : s.nonempty) (f : ι → α) (a : α) : s.sup (λ b, a ⇨ f b) = a ⇨ s.sup f := +@inf_sdiff_right αᵒᵈ _ _ _ hs _ _ + +@[simp] protected lemma compl_sup (s : finset ι) (f : ι → α) : (s.sup f)ᶜ = s.inf (λ i, (f i)ᶜ) := +map_finset_sup (order_iso.compl α) _ _ + +@[simp] protected lemma compl_inf (s : finset ι) (f : ι → α) : (s.inf f)ᶜ = s.sup (λ i, (f i)ᶜ) := +map_finset_inf (order_iso.compl α) _ _ + +end boolean_algebra + section linear_order variables [linear_order α] @@ -471,7 +562,7 @@ lemma inf_eq_infi [complete_lattice β] (s : finset α) (f : α → β) : s.inf lemma inf_id_eq_Inf [complete_lattice α] (s : finset α) : s.inf id = Inf s := @sup_id_eq_Sup αᵒᵈ _ _ -lemma inf_id_set_eq_sInter (s : finset (set α)) : s.inf id = ⋂₀(↑s) := +lemma inf_id_set_eq_sInter (s : finset (set α)) : s.inf id = ⋂₀ ↑s := inf_id_eq_Inf _ @[simp] lemma inf_set_eq_bInter (s : finset α) (f : α → set β) : s.inf f = ⋂ x ∈ s, f x := @@ -491,12 +582,12 @@ Exists.imp (λ a, Exists.fst) (@le_sup (with_bot α) _ _ _ _ _ _ h (f b) rfl) unbounded) join-semilattice `α`, where `H` is a proof of nonemptiness. If `α` has a bottom element you may instead use `finset.sup` which does not require `s` nonempty. -/ def sup' (s : finset β) (H : s.nonempty) (f : β → α) : α := -option.get $ let ⟨b, hb⟩ := H in option.is_some_iff_exists.2 (sup_of_mem f hb) +with_bot.unbot (s.sup (coe ∘ f)) (by simpa using H) variables {s : finset β} (H : s.nonempty) (f : β → α) @[simp] lemma coe_sup' : ((s.sup' H f : α) : with_bot α) = s.sup (coe ∘ f) := -by rw [sup', ←with_bot.some_eq_coe, option.some_get] +by rw [sup', with_bot.coe_unbot] @[simp] lemma sup'_cons {b : β} {hb : b ∉ s} {h : (cons b s hb).nonempty} : (cons b s hb).sup' h f = f b ⊔ s.sup' H f := @@ -510,11 +601,15 @@ by { rw ←with_bot.coe_eq_coe, simp only [coe_sup', sup_insert, with_bot.coe_su ({b} : finset β).sup' h f = f b := rfl lemma sup'_le {a : α} (hs : ∀ b ∈ s, f b ≤ a) : s.sup' H f ≤ a := -by { rw [←with_bot.coe_le_coe, coe_sup'], exact sup_le (λ b h, with_bot.coe_le_coe.2 $ hs b h), } +by { rw [←with_bot.coe_le_coe, coe_sup'], + exact finset.sup_le (λ b h, with_bot.coe_le_coe.2 $ hs b h) } lemma le_sup' {b : β} (h : b ∈ s) : f b ≤ s.sup' ⟨b, h⟩ f := by { rw [←with_bot.coe_le_coe, coe_sup'], exact le_sup h, } +lemma le_sup'_of_le {a : α} {b : β} (hb : b ∈ s) (h : a ≤ f b) : a ≤ s.sup' ⟨b, hb⟩ f := +h.trans $ le_sup' _ hb + @[simp] lemma sup'_const (a : α) : s.sup' H (λ b, a) = a := begin apply le_antisymm, @@ -525,25 +620,43 @@ end @[simp] lemma sup'_le_iff {a : α} : s.sup' H f ≤ a ↔ ∀ b ∈ s, f b ≤ a := iff.intro (λ h b hb, trans (le_sup' f hb) h) (sup'_le H f) +lemma sup'_union [decidable_eq β] {s₁ s₂ : finset β} (h₁ : s₁.nonempty) (h₂ : s₂.nonempty) + (f : β → α) : + (s₁ ∪ s₂).sup' (h₁.mono $ subset_union_left _ _) f = s₁.sup' h₁ f ⊔ s₂.sup' h₂ f := +eq_of_forall_ge_iff $ λ a, by simp [or_imp_distrib, forall_and_distrib] + lemma sup'_bUnion [decidable_eq β] {s : finset γ} (Hs : s.nonempty) {t : γ → finset β} (Ht : ∀ b, (t b).nonempty) : (s.bUnion t).sup' (Hs.bUnion (λ b _, Ht b)) f = s.sup' Hs (λ b, (t b).sup' (Ht b) f) := eq_of_forall_ge_iff $ λ c, by simp [@forall_swap _ β] +protected lemma sup'_comm {t : finset γ} (hs : s.nonempty) (ht : t.nonempty) (f : β → γ → α) : + s.sup' hs (λ b, t.sup' ht (f b)) = t.sup' ht (λ c, s.sup' hs $ λ b, f b c) := +eq_of_forall_ge_iff $ λ a, by simpa using forall₂_swap + +lemma sup'_product_left {t : finset γ} (hs : s.nonempty) (ht : t.nonempty) (f : β × γ → α) : + (s ×ˢ t).sup' (hs.product ht) f = s.sup' hs (λ i, t.sup' ht $ λ i', f ⟨i, i'⟩) := +eq_of_forall_ge_iff $ λ a, by simp [@forall_swap _ γ] + +lemma sup'_product_right {t : finset γ} (hs : s.nonempty) (ht : t.nonempty) (f : β × γ → α) : + (s ×ˢ t).sup' (hs.product ht) f = t.sup' ht (λ i', s.sup' hs $ λ i, f ⟨i, i'⟩) := +by rw [sup'_product_left, finset.sup'_comm] + lemma comp_sup'_eq_sup'_comp [semilattice_sup γ] {s : finset β} (H : s.nonempty) {f : β → α} (g : α → γ) (g_sup : ∀ x y, g (x ⊔ y) = g x ⊔ g y) : g (s.sup' H f) = s.sup' H (g ∘ f) := begin rw [←with_bot.coe_eq_coe, coe_sup'], - let g' : with_bot α → with_bot γ := with_bot.rec_bot_coe ⊥ (λ x, ↑(g x)), + let g' := with_bot.map g, show g' ↑(s.sup' H f) = s.sup (λ a, g' ↑(f a)), rw coe_sup', refine comp_sup_eq_sup_comp g' _ rfl, intros f₁ f₂, - cases f₁, - { rw [with_bot.none_eq_bot, bot_sup_eq], exact bot_sup_eq.symm, }, - { cases f₂, refl, - exact congr_arg coe (g_sup f₁ f₂), }, + induction f₁ using with_bot.rec_bot_coe, + { rw [bot_sup_eq], exact bot_sup_eq.symm, }, + { induction f₂ using with_bot.rec_bot_coe, + { refl }, + { exact congr_arg coe (g_sup f₁ f₂) } } end lemma sup'_induction {p : α → Prop} (hp : ∀ a₁, p a₁ → ∀ a₂, p a₂ → p (a₁ ⊔ a₂)) @@ -571,6 +684,20 @@ begin simp only [sup'_le_iff, h₂] { contextual := tt } end +@[simp] lemma _root_.map_finset_sup' [semilattice_sup β] [sup_hom_class F α β] (f : F) + {s : finset ι} (hs) (g : ι → α) : f (s.sup' hs g) = s.sup' hs (f ∘ g) := +by refine hs.cons_induction _ _; intros; simp [*] + +@[simp] lemma sup'_image [decidable_eq β] {s : finset γ} {f : γ → β} (hs : (s.image f).nonempty) + (g : β → α) (hs': s.nonempty := (nonempty.image_iff _).1 hs) : + (s.image f).sup' hs g = s.sup' hs' (g ∘ f) := +by { rw ←with_bot.coe_eq_coe, simp only [coe_sup', sup_image, with_bot.coe_sup] } + +@[simp] lemma sup'_map {s : finset γ} {f : γ ↪ β} (g : β → α) (hs : (s.map f).nonempty) + (hs': s.nonempty := finset.map_nonempty.mp hs) : + (s.map f).sup' hs g = s.sup' hs' (g ∘ f) := +by rw [←with_bot.coe_eq_coe, coe_sup', sup_map, coe_sup'] + end sup' section inf' @@ -584,7 +711,7 @@ lemma inf_of_mem {s : finset β} (f : β → α) {b : β} (h : b ∈ s) : unbounded) meet-semilattice `α`, where `H` is a proof of nonemptiness. If `α` has a top element you may instead use `finset.inf` which does not require `s` nonempty. -/ def inf' (s : finset β) (H : s.nonempty) (f : β → α) : α := -@sup' αᵒᵈ _ _ s H f +with_top.untop (s.inf (coe ∘ f)) (by simpa using H) variables {s : finset β} (H : s.nonempty) (f : β → α) {a : α} {b : β} @@ -593,27 +720,45 @@ variables {s : finset β} (H : s.nonempty) (f : β → α) {a : α} {b : β} @[simp] lemma inf'_cons {b : β} {hb : b ∉ s} {h : (cons b s hb).nonempty} : (cons b s hb).inf' h f = f b ⊓ s.inf' H f := -@sup'_cons αᵒᵈ _ _ _ H f _ _ _ +@sup'_cons αᵒᵈ _ _ _ H f _ _ h @[simp] lemma inf'_insert [decidable_eq β] {b : β} {h : (insert b s).nonempty} : (insert b s).inf' h f = f b ⊓ s.inf' H f := -@sup'_insert αᵒᵈ _ _ _ H f _ _ _ +@sup'_insert αᵒᵈ _ _ _ H f _ _ h @[simp] lemma inf'_singleton {b : β} {h : ({b} : finset β).nonempty} : ({b} : finset β).inf' h f = f b := rfl lemma le_inf' (hs : ∀ b ∈ s, a ≤ f b) : a ≤ s.inf' H f := @sup'_le αᵒᵈ _ _ _ H f _ hs lemma inf'_le (h : b ∈ s) : s.inf' ⟨b, h⟩ f ≤ f b := @le_sup' αᵒᵈ _ _ _ f _ h +lemma inf'_le_of_le (hb : b ∈ s) (h : f b ≤ a) : s.inf' ⟨b, hb⟩ f ≤ a := (inf'_le _ hb).trans h -@[simp] lemma inf'_const (a : α) : s.inf' H (λ b, a) = a := @sup'_const αᵒᵈ _ _ _ _ _ +@[simp] lemma inf'_const (a : α) : s.inf' H (λ b, a) = a := @sup'_const αᵒᵈ _ _ _ H _ @[simp] lemma le_inf'_iff : a ≤ s.inf' H f ↔ ∀ b ∈ s, a ≤ f b := @sup'_le_iff αᵒᵈ _ _ _ H f _ +lemma inf'_union [decidable_eq β] {s₁ s₂ : finset β} (h₁ : s₁.nonempty) (h₂ : s₂.nonempty) + (f : β → α) : + (s₁ ∪ s₂).inf' (h₁.mono $ subset_union_left _ _) f = s₁.inf' h₁ f ⊓ s₂.inf' h₂ f := +@sup'_union αᵒᵈ _ _ _ _ _ h₁ h₂ _ + lemma inf'_bUnion [decidable_eq β] {s : finset γ} (Hs : s.nonempty) {t : γ → finset β} (Ht : ∀ b, (t b).nonempty) : (s.bUnion t).inf' (Hs.bUnion (λ b _, Ht b)) f = s.inf' Hs (λ b, (t b).inf' (Ht b) f) := @sup'_bUnion αᵒᵈ _ _ _ _ _ _ Hs _ Ht +protected lemma inf'_comm {t : finset γ} (hs : s.nonempty) (ht : t.nonempty) (f : β → γ → α) : + s.inf' hs (λ b, t.inf' ht (f b)) = t.inf' ht (λ c, s.inf' hs $ λ b, f b c) := +@finset.sup'_comm αᵒᵈ _ _ _ _ _ hs ht _ + +lemma inf'_product_left {t : finset γ} (hs : s.nonempty) (ht : t.nonempty) (f : β × γ → α) : + (s ×ˢ t).inf' (hs.product ht) f = s.inf' hs (λ i, t.inf' ht $ λ i', f ⟨i, i'⟩) := +@sup'_product_left αᵒᵈ _ _ _ _ _ hs ht _ + +lemma inf'_product_right {t : finset γ} (hs : s.nonempty) (ht : t.nonempty) (f : β × γ → α) : + (s ×ˢ t).inf' (hs.product ht) f = t.inf' ht (λ i', s.inf' hs $ λ i, f ⟨i, i'⟩) := +@sup'_product_right αᵒᵈ _ _ _ _ _ hs ht _ + lemma comp_inf'_eq_inf'_comp [semilattice_inf γ] {s : finset β} (H : s.nonempty) {f : β → α} (g : α → γ) (g_inf : ∀ x y, g (x ⊓ y) = g x ⊓ g y) : g (s.inf' H f) = s.inf' H (g ∘ f) := @@ -631,13 +776,27 @@ lemma inf'_mem (s : set α) (w : ∀ x y ∈ s, x ⊓ y ∈ s) s.inf' H f = t.inf' (h₁ ▸ H) g := @sup'_congr αᵒᵈ _ _ _ H _ _ _ h₁ h₂ +@[simp] lemma _root_.map_finset_inf' [semilattice_inf β] [inf_hom_class F α β] (f : F) + {s : finset ι} (hs) (g : ι → α) : f (s.inf' hs g) = s.inf' hs (f ∘ g) := +by refine hs.cons_induction _ _; intros; simp [*] + +@[simp] lemma inf'_image [decidable_eq β] {s : finset γ} {f : γ → β} (hs : (s.image f).nonempty) + (g : β → α) (hs': s.nonempty := (nonempty.image_iff _).1 hs) : + (s.image f).inf' hs g = s.inf' hs' (g ∘ f) := +@sup'_image αᵒᵈ _ _ _ _ _ _ hs _ hs' + +@[simp] lemma inf'_map {s : finset γ} {f : γ ↪ β} (g : β → α) (hs : (s.map f).nonempty) + (hs': s.nonempty := finset.map_nonempty.mp hs) : + (s.map f).inf' hs g = s.inf' hs' (g ∘ f) := +@sup'_map αᵒᵈ _ _ _ _ _ _ hs hs' + end inf' section sup variables [semilattice_sup α] [order_bot α] lemma sup'_eq_sup {s : finset β} (H : s.nonempty) (f : β → α) : s.sup' H f = s.sup f := -le_antisymm (sup'_le H f (λ b, le_sup)) (sup_le (λ b, le_sup' f)) +le_antisymm (sup'_le H f (λ b, le_sup)) (finset.sup_le (λ b, le_sup' f)) lemma sup_closed_of_sup_closed {s : set α} (t : finset α) (htne : t.nonempty) (h_subset : ↑t ⊆ s) (h : ∀ a b ∈ s, a ⊔ b ∈ s) : t.sup id ∈ s := @@ -705,6 +864,46 @@ protected lemma inf'_apply {s : finset α} (H : s.nonempty) (f : α → Π (b : end inf' +@[simp] lemma to_dual_sup' [semilattice_sup α] {s : finset ι} (hs : s.nonempty) (f : ι → α) : + to_dual (s.sup' hs f) = s.inf' hs (to_dual ∘ f) := rfl +@[simp] lemma to_dual_inf' [semilattice_inf α] {s : finset ι} (hs : s.nonempty) (f : ι → α) : + to_dual (s.inf' hs f) = s.sup' hs (to_dual ∘ f) := rfl +@[simp] lemma of_dual_sup' [semilattice_inf α] {s : finset ι} (hs : s.nonempty) (f : ι → αᵒᵈ) : + of_dual (s.sup' hs f) = s.inf' hs (of_dual ∘ f) := rfl +@[simp] lemma of_dual_inf' [semilattice_sup α] {s : finset ι} (hs : s.nonempty) (f : ι → αᵒᵈ) : + of_dual (s.inf' hs f) = s.sup' hs (of_dual ∘ f) := rfl + +section distrib_lattice +variables [distrib_lattice α] {s : finset ι} {t : finset κ} (hs : s.nonempty) (ht : t.nonempty) + {f : ι → α} {g : κ → α} {a : α} + +lemma sup'_inf_distrib_left (f : ι → α) (a : α) : a ⊓ s.sup' hs f = s.sup' hs (λ i, a ⊓ f i) := +begin + refine hs.cons_induction (λ i, _) (λ i s hi hs ih, _) , + { simp }, + { simp_rw [sup'_cons hs, inf_sup_left], + rw ih } +end + +lemma sup'_inf_distrib_right (f : ι → α) (a : α) : s.sup' hs f ⊓ a = s.sup' hs (λ i, f i ⊓ a) := +by { rw [inf_comm, sup'_inf_distrib_left], simp_rw inf_comm } + +lemma sup'_inf_sup' (f : ι → α) (g : κ → α) : + s.sup' hs f ⊓ t.sup' ht g = (s ×ˢ t).sup' (hs.product ht) (λ i, f i.1 ⊓ g i.2) := +by simp_rw [finset.sup'_inf_distrib_right, finset.sup'_inf_distrib_left, sup'_product_left] + +lemma inf'_sup_distrib_left (f : ι → α) (a : α) : a ⊔ s.inf' hs f = s.inf' hs (λ i, a ⊔ f i) := +@sup'_inf_distrib_left αᵒᵈ _ _ _ hs _ _ + +lemma inf'_sup_distrib_right (f : ι → α) (a : α) : s.inf' hs f ⊔ a = s.inf' hs (λ i, f i ⊔ a) := +@sup'_inf_distrib_right αᵒᵈ _ _ _ hs _ _ + +lemma inf'_sup_inf' (f : ι → α) (g : κ → α) : + s.inf' hs f ⊔ t.inf' ht g = (s ×ˢ t).inf' (hs.product ht) (λ i, f i.1 ⊔ g i.2) := +@sup'_inf_sup' αᵒᵈ _ _ _ _ _ hs ht _ _ + +end distrib_lattice + section linear_order variables [linear_order α] {s : finset ι} (H : s.nonempty) {f : ι → α} {a : α} @@ -759,105 +958,134 @@ section max_min variables [linear_order α] /-- Let `s` be a finset in a linear order. Then `s.max` is the maximum of `s` if `s` is not empty, -and `none` otherwise. It belongs to `option α`. If you want to get an element of `α`, see +and `⊥` otherwise. It belongs to `with_bot α`. If you want to get an element of `α`, see `s.max'`. -/ -protected def max : finset α → option α := -fold (option.lift_or_get max) none some +protected def max (s : finset α) : with_bot α := +sup s coe + +lemma max_eq_sup_coe {s : finset α} : s.max = s.sup coe := rfl theorem max_eq_sup_with_bot (s : finset α) : - s.max = @sup (with_bot α) α _ _ s some := rfl + s.max = sup s coe := rfl -@[simp] theorem max_empty : (∅ : finset α).max = none := rfl +@[simp] theorem max_empty : (∅ : finset α).max = ⊥ := rfl @[simp] theorem max_insert {a : α} {s : finset α} : - (insert a s).max = option.lift_or_get max (some a) s.max := fold_insert_idem + (insert a s).max = max a s.max := fold_insert_idem -@[simp] theorem max_singleton {a : α} : finset.max {a} = some a := +@[simp] theorem max_singleton {a : α} : finset.max {a} = (a : with_bot α) := by { rw [← insert_emptyc_eq], exact max_insert } -theorem max_of_mem {s : finset α} {a : α} (h : a ∈ s) : ∃ b, b ∈ s.max := +theorem max_of_mem {s : finset α} {a : α} (h : a ∈ s) : ∃ (b : α), s.max = b := (@le_sup (with_bot α) _ _ _ _ _ _ h _ rfl).imp $ λ b, Exists.fst -theorem max_of_nonempty {s : finset α} (h : s.nonempty) : ∃ a, a ∈ s.max := +theorem max_of_nonempty {s : finset α} (h : s.nonempty) : ∃ (a : α), s.max = a := let ⟨a, ha⟩ := h in max_of_mem ha -theorem max_eq_none {s : finset α} : s.max = none ↔ s = ∅ := +theorem max_eq_bot {s : finset α} : s.max = ⊥ ↔ s = ∅ := ⟨λ h, s.eq_empty_or_nonempty.elim id (λ H, let ⟨a, ha⟩ := max_of_nonempty H in by rw h at ha; cases ha), λ h, h.symm ▸ max_empty⟩ -theorem mem_of_max {s : finset α} : ∀ {a : α}, a ∈ s.max → a ∈ s := +theorem mem_of_max {s : finset α} : ∀ {a : α}, s.max = a → a ∈ s := finset.induction_on s (λ _ H, by cases H) - (λ b s _ (ih : ∀ {a}, a ∈ s.max → a ∈ s) a (h : a ∈ (insert b s).max), + (λ b s _ (ih : ∀ {a : α}, s.max = a → a ∈ s) a (h : (insert b s).max = a), begin by_cases p : b = a, { induction p, exact mem_insert_self b s }, - { cases option.lift_or_get_choice max_choice (some b) s.max with q q; + { cases max_choice ↑b s.max with q q; rw [max_insert, q] at h, { cases h, cases p rfl }, { exact mem_insert_of_mem (ih h) } } end) -theorem le_max_of_mem {s : finset α} {a b : α} (h₁ : a ∈ s) (h₂ : b ∈ s.max) : a ≤ b := -by rcases @le_sup (with_bot α) _ _ _ _ _ _ h₁ _ rfl with ⟨b', hb, ab⟩; - cases h₂.symm.trans hb; assumption +lemma le_max {a : α} {s : finset α} (as : a ∈ s) : ↑a ≤ s.max := +le_sup as + +lemma not_mem_of_max_lt_coe {a : α} {s : finset α} (h : s.max < a) : a ∉ s := +mt le_max h.not_le + +theorem le_max_of_eq {s : finset α} {a b : α} (h₁ : a ∈ s) (h₂ : s.max = b) : a ≤ b := +with_bot.coe_le_coe.mp $ (le_max h₁).trans h₂.le + +theorem not_mem_of_max_lt {s : finset α} {a b : α} (h₁ : b < a) (h₂ : s.max = ↑b) : a ∉ s := +finset.not_mem_of_max_lt_coe $ h₂.trans_lt $ with_bot.coe_lt_coe.mpr h₁ + +lemma max_mono {s t : finset α} (st : s ⊆ t) : s.max ≤ t.max := +sup_mono st + +protected lemma max_le {M : with_bot α} {s : finset α} (st : ∀ a ∈ s, (a : with_bot α) ≤ M) : + s.max ≤ M := +finset.sup_le st /-- Let `s` be a finset in a linear order. Then `s.min` is the minimum of `s` if `s` is not empty, -and `none` otherwise. It belongs to `option α`. If you want to get an element of `α`, see +and `⊤` otherwise. It belongs to `with_top α`. If you want to get an element of `α`, see `s.min'`. -/ -protected def min : finset α → option α := -fold (option.lift_or_get min) none some +protected def min (s : finset α) : with_top α := +inf s coe theorem min_eq_inf_with_top (s : finset α) : - s.min = @inf (with_top α) α _ _ s some := rfl + s.min = inf s coe := rfl -@[simp] theorem min_empty : (∅ : finset α).min = none := rfl +@[simp] theorem min_empty : (∅ : finset α).min = ⊤ := rfl @[simp] theorem min_insert {a : α} {s : finset α} : - (insert a s).min = option.lift_or_get min (some a) s.min := + (insert a s).min = min ↑a s.min := fold_insert_idem -@[simp] theorem min_singleton {a : α} : finset.min {a} = some a := +@[simp] theorem min_singleton {a : α} : finset.min {a} = (a : with_top α) := by { rw ← insert_emptyc_eq, exact min_insert } -theorem min_of_mem {s : finset α} {a : α} (h : a ∈ s) : ∃ b, b ∈ s.min := +theorem min_of_mem {s : finset α} {a : α} (h : a ∈ s) : ∃ b : α, s.min = b := (@inf_le (with_top α) _ _ _ _ _ _ h _ rfl).imp $ λ b, Exists.fst -theorem min_of_nonempty {s : finset α} (h : s.nonempty) : ∃ a, a ∈ s.min := +theorem min_of_nonempty {s : finset α} (h : s.nonempty) : ∃ a : α, s.min = a := let ⟨a, ha⟩ := h in min_of_mem ha -theorem min_eq_none {s : finset α} : s.min = none ↔ s = ∅ := +theorem min_eq_top {s : finset α} : s.min = ⊤ ↔ s = ∅ := ⟨λ h, s.eq_empty_or_nonempty.elim id (λ H, let ⟨a, ha⟩ := min_of_nonempty H in by rw h at ha; cases ha), λ h, h.symm ▸ min_empty⟩ -theorem mem_of_min {s : finset α} : ∀ {a : α}, a ∈ s.min → a ∈ s := @mem_of_max αᵒᵈ _ s +theorem mem_of_min {s : finset α} : ∀ {a : α}, s.min = a → a ∈ s := @mem_of_max αᵒᵈ _ s + +lemma min_le {a : α} {s : finset α} (as : a ∈ s) : s.min ≤ a := +inf_le as + +lemma not_mem_of_coe_lt_min {a : α} {s : finset α} (h : ↑a < s.min) : a ∉ s := +mt min_le h.not_le -theorem min_le_of_mem {s : finset α} {a b : α} (h₁ : b ∈ s) (h₂ : a ∈ s.min) : a ≤ b := -by rcases @inf_le (with_top α) _ _ _ _ _ _ h₁ _ rfl with ⟨b', hb, ab⟩; - cases h₂.symm.trans hb; assumption +theorem min_le_of_eq {s : finset α} {a b : α} (h₁ : b ∈ s) (h₂ : s.min = a) : a ≤ b := +with_top.coe_le_coe.mp $ h₂.ge.trans (min_le h₁) -/-- Given a nonempty finset `s` in a linear order `α `, then `s.min' h` is its minimum, as an +theorem not_mem_of_lt_min {s : finset α} {a b : α} (h₁ : a < b) (h₂ : s.min = ↑b) : a ∉ s := +finset.not_mem_of_coe_lt_min $ (with_top.coe_lt_coe.mpr h₁).trans_eq h₂.symm + +lemma min_mono {s t : finset α} (st : s ⊆ t) : t.min ≤ s.min := +inf_mono st + +protected lemma le_min {m : with_top α} {s : finset α} (st : ∀ a : α, a ∈ s → m ≤ a) : + m ≤ s.min := +finset.le_inf st + +/-- Given a nonempty finset `s` in a linear order `α`, then `s.min' h` is its minimum, as an element of `α`, where `h` is a proof of nonemptiness. Without this assumption, use instead `s.min`, -taking values in `option α`. -/ +taking values in `with_top α`. -/ def min' (s : finset α) (H : s.nonempty) : α := -@option.get _ s.min $ - let ⟨k, hk⟩ := H in - let ⟨b, hb⟩ := min_of_mem hk in by simp at hb; simp [hb] +inf' s H id -/-- Given a nonempty finset `s` in a linear order `α `, then `s.max' h` is its maximum, as an +/-- Given a nonempty finset `s` in a linear order `α`, then `s.max' h` is its maximum, as an element of `α`, where `h` is a proof of nonemptiness. Without this assumption, use instead `s.max`, -taking values in `option α`. -/ +taking values in `with_bot α`. -/ def max' (s : finset α) (H : s.nonempty) : α := -@option.get _ s.max $ - let ⟨k, hk⟩ := H in - let ⟨b, hb⟩ := max_of_mem hk in by simp at hb; simp [hb] +sup' s H id variables (s : finset α) (H : s.nonempty) {x : α} -theorem min'_mem : s.min' H ∈ s := mem_of_min $ by simp [min'] +theorem min'_mem : s.min' H ∈ s := mem_of_min $ by simp [min', finset.min] -theorem min'_le (x) (H2 : x ∈ s) : s.min' ⟨x, H2⟩ ≤ x := min_le_of_mem H2 $ option.get_mem _ +theorem min'_le (x) (H2 : x ∈ s) : s.min' ⟨x, H2⟩ ≤ x := +min_le_of_eq H2 (with_top.coe_untop _ _).symm theorem le_min' (x) (H2 : ∀ y ∈ s, x ≤ y) : x ≤ s.min' H := H2 _ $ min'_mem _ _ @@ -871,9 +1099,10 @@ le_is_glb_iff (is_least_min' s H).is_glb ({a} : finset α).min' (singleton_nonempty _) = a := by simp [min'] -theorem max'_mem : s.max' H ∈ s := mem_of_max $ by simp [max'] +theorem max'_mem : s.max' H ∈ s := mem_of_max $ by simp [max', finset.max] -theorem le_max' (x) (H2 : x ∈ s) : x ≤ s.max' ⟨x, H2⟩ := le_max_of_mem H2 $ option.get_mem _ +theorem le_max' (x) (H2 : x ∈ s) : x ≤ s.max' ⟨x, H2⟩ := +le_max_of_eq H2 (with_bot.coe_unbot _ _).symm theorem max'_le (x) (H2 : ∀ y ∈ s, y ≤ x) : s.max' H ≤ x := H2 _ $ max'_mem _ _ @@ -913,27 +1142,33 @@ begin exact s.min'_lt_max' ha hb hab end -lemma max'_eq_of_dual_min' {s : finset α} (hs : s.nonempty) : - max' s hs = of_dual (min' (image to_dual s) (nonempty.image hs to_dual)) := -begin - rw [of_dual, to_dual, equiv.coe_fn_mk, equiv.coe_fn_symm_mk, id.def], - simp_rw (@image_id (order_dual α) (s : finset (order_dual α))), - refl, -end +lemma map_of_dual_min (s : finset αᵒᵈ) : s.min.map of_dual = (s.image of_dual).max := +by { rw [max_eq_sup_with_bot, sup_image], exact congr_fun option.map_id _ } -lemma min'_eq_of_dual_max' {s : finset α} (hs : s.nonempty) : - min' s hs = of_dual (max' (image to_dual s) (nonempty.image hs to_dual)) := -begin - rw [of_dual, to_dual, equiv.coe_fn_mk, equiv.coe_fn_symm_mk, id.def], - simp_rw (@image_id (order_dual α) (s : finset (order_dual α))), - refl, -end +lemma map_of_dual_max (s : finset αᵒᵈ) : s.max.map of_dual = (s.image of_dual).min := +by { rw [min_eq_inf_with_top, inf_image], exact congr_fun option.map_id _ } + +lemma map_to_dual_min (s : finset α) : s.min.map to_dual = (s.image to_dual).max := +by { rw [max_eq_sup_with_bot, sup_image], exact congr_fun option.map_id _ } + +lemma map_to_dual_max (s : finset α) : s.max.map to_dual = (s.image to_dual).min := +by { rw [min_eq_inf_with_top, inf_image], exact congr_fun option.map_id _ } + +lemma of_dual_min' {s : finset αᵒᵈ} (hs : s.nonempty) : + of_dual (min' s hs) = max' (s.image of_dual) (hs.image _) := +by { convert rfl, exact image_id } + +lemma of_dual_max' {s : finset αᵒᵈ} (hs : s.nonempty) : + of_dual (max' s hs) = min' (s.image of_dual) (hs.image _) := +by { convert rfl, exact image_id } -@[simp] lemma of_dual_max_eq_min_of_dual {a b : α} : - of_dual (max a b) = min (of_dual a) (of_dual b) := rfl +lemma to_dual_min' {s : finset α} (hs : s.nonempty) : + to_dual (min' s hs) = max' (s.image to_dual) (hs.image _) := +by { convert rfl, exact image_id } -@[simp] lemma of_dual_min_eq_max_of_dual {a b : α} : - of_dual (min a b) = max (of_dual a) (of_dual b) := rfl +lemma to_dual_max' {s : finset α} (hs : s.nonempty) : + to_dual (max' s hs) = min' (s.image to_dual) (hs.image _) := +by { convert rfl, exact image_id } lemma max'_subset {s t : finset α} (H : s.nonempty) (hst : s ⊆ t) : s.max' H ≤ t.max' (H.mono hst) := @@ -975,12 +1210,91 @@ end {f : α → β} (hf : monotone f) (s : finset α) (h : (s.image f).nonempty) : (s.image f).min' h = f (s.min' ((nonempty.image_iff f).mp h)) := begin - refine le_antisymm (min'_le _ _ (mem_image.mpr ⟨_, min'_mem _ _, rfl⟩)) - (le_min' _ _ _ (λ y hy, _)), - obtain ⟨x, hx, rfl⟩ := mem_image.mp hy, - exact hf (min'_le _ _ hx) + convert @max'_image αᵒᵈ βᵒᵈ _ _ (λ a : αᵒᵈ, to_dual (f (of_dual a))) (by simpa) _ _; convert h, + rw nonempty.image_iff, +end + +lemma coe_max' {s : finset α} (hs : s.nonempty) : ↑(s.max' hs) = s.max := coe_sup' hs id + +lemma coe_min' {s : finset α} (hs : s.nonempty) : ↑(s.min' hs) = s.min := coe_inf' hs id + +lemma max_mem_image_coe {s : finset α} (hs : s.nonempty) : + s.max ∈ (s.image coe : finset (with_bot α)) := +mem_image.2 ⟨max' s hs, max'_mem _ _, coe_max' hs⟩ + +lemma min_mem_image_coe {s : finset α} (hs : s.nonempty) : + s.min ∈ (s.image coe : finset (with_top α)) := +mem_image.2 ⟨min' s hs, min'_mem _ _, coe_min' hs⟩ + +lemma max_mem_insert_bot_image_coe (s : finset α) : + s.max ∈ (insert ⊥ (s.image coe) : finset (with_bot α)) := +mem_insert.2 $ s.eq_empty_or_nonempty.imp max_eq_bot.2 max_mem_image_coe + +lemma min_mem_insert_top_image_coe (s : finset α) : + s.min ∈ (insert ⊤ (s.image coe) : finset (with_top α)) := +mem_insert.2 $ s.eq_empty_or_nonempty.imp min_eq_top.2 min_mem_image_coe + +lemma max'_erase_ne_self {s : finset α} (s0 : (s.erase x).nonempty) : + (s.erase x).max' s0 ≠ x := +ne_of_mem_erase (max'_mem _ s0) + +lemma min'_erase_ne_self {s : finset α} (s0 : (s.erase x).nonempty) : + (s.erase x).min' s0 ≠ x := +ne_of_mem_erase (min'_mem _ s0) + +lemma max_erase_ne_self {s : finset α} : (s.erase x).max ≠ x := +begin + by_cases s0 : (s.erase x).nonempty, + { refine ne_of_eq_of_ne (coe_max' s0).symm _, + exact with_bot.coe_eq_coe.not.mpr (max'_erase_ne_self _) }, + { rw [not_nonempty_iff_eq_empty.mp s0, max_empty], + exact with_bot.bot_ne_coe } end +lemma min_erase_ne_self {s : finset α} : (s.erase x).min ≠ x := +by convert @max_erase_ne_self αᵒᵈ _ _ _ + +lemma exists_next_right {x : α} {s : finset α} (h : ∃ y ∈ s, x < y) : + ∃ y ∈ s, x < y ∧ ∀ z ∈ s, x < z → y ≤ z := +have Hne : (s.filter ((<) x)).nonempty := h.imp $ λ y hy, mem_filter.2 ⟨hy.fst, hy.snd⟩, +⟨min' _ Hne, (mem_filter.1 (min'_mem _ Hne)).1, (mem_filter.1 (min'_mem _ Hne)).2, + λ z hzs hz, min'_le _ _ $ mem_filter.2 ⟨hzs, hz⟩⟩ + +lemma exists_next_left {x : α} {s : finset α} (h : ∃ y ∈ s, y < x) : + ∃ y ∈ s, y < x ∧ ∀ z ∈ s, z < x → z ≤ y := +@exists_next_right αᵒᵈ _ x s h + +/-- If finsets `s` and `t` are interleaved, then `finset.card s ≤ finset.card t + 1`. -/ +lemma card_le_of_interleaved {s t : finset α} + (h : ∀ x y ∈ s, x < y → (∀ z ∈ s, z ∉ set.Ioo x y) → ∃ z ∈ t, x < z ∧ z < y) : + s.card ≤ t.card + 1 := +begin + replace h : ∀ x y ∈ s, x < y → ∃ z ∈ t, x < z ∧ z < y, + { intros x hx y hy hxy, + rcases exists_next_right ⟨y, hy, hxy⟩ with ⟨a, has, hxa, ha⟩, + rcases h x hx a has hxa (λ z hzs hz, hz.2.not_le $ ha _ hzs hz.1) with ⟨b, hbt, hxb, hba⟩, + exact ⟨b, hbt, hxb, hba.trans_le $ ha _ hy hxy⟩ }, + set f : α → with_top α := λ x, (t.filter (λ y, x < y)).min, + have f_mono : strict_mono_on f s, + { intros x hx y hy hxy, + rcases h x hx y hy hxy with ⟨a, hat, hxa, hay⟩, + calc f x ≤ a : min_le (mem_filter.2 ⟨hat, hxa⟩) + ... < f y : (finset.lt_inf_iff $ with_top.coe_lt_top a).2 $ + λ b hb, with_top.coe_lt_coe.2 $ hay.trans (mem_filter.1 hb).2 }, + calc s.card = (s.image f).card : (card_image_of_inj_on f_mono.inj_on).symm + ... ≤ (insert ⊤ (t.image coe) : finset (with_top α)).card : card_mono $ image_subset_iff.2 $ + λ x hx, insert_subset_insert _ (image_subset_image $ filter_subset _ _) + (min_mem_insert_top_image_coe _) + ... ≤ t.card + 1 : (card_insert_le _ _).trans (add_le_add_right card_image_le _) +end + +/-- If finsets `s` and `t` are interleaved, then `finset.card s ≤ finset.card (t \ s) + 1`. -/ +lemma card_le_diff_of_interleaved {s t : finset α} + (h : ∀ x y ∈ s, x < y → (∀ z ∈ s, z ∉ set.Ioo x y) → ∃ z ∈ t, x < z ∧ z < y) : + s.card ≤ (t \ s).card + 1 := +card_le_of_interleaved $ λ x hx y hy hxy hs, let ⟨z, hzt, hxz, hzy⟩ := h x hx y hy hxy hs +in ⟨z, mem_sdiff.2 ⟨hzt, λ hzs, hs z hzs ⟨hxz, hzy⟩⟩, hxz, hzy⟩ + /-- Induction principle for `finset`s in a linearly ordered type: a predicate is true on all `s : finset α` provided that: @@ -1062,7 +1376,7 @@ lemma exists_max_image (s : finset β) (f : β → α) (h : s.nonempty) : begin cases max_of_nonempty (h.image f) with y hy, rcases mem_image.mp (mem_of_max hy) with ⟨x, hx, rfl⟩, - exact ⟨x, hx, λ x' hx', le_max_of_mem (mem_image_of_mem f hx') hy⟩, + exact ⟨x, hx, λ x' hx', le_max_of_eq (mem_image_of_mem f hx') hy⟩, end lemma exists_min_image (s : finset β) (f : β → α) (h : s.nonempty) : @@ -1070,6 +1384,29 @@ lemma exists_min_image (s : finset β) (f : β → α) (h : s.nonempty) : @exists_max_image αᵒᵈ β _ s f h end exists_max_min + +lemma is_glb_iff_is_least [linear_order α] (i : α) (s : finset α) (hs : s.nonempty) : + is_glb (s : set α) i ↔ is_least ↑s i := +begin + refine ⟨λ his, _, is_least.is_glb⟩, + suffices : i = min' s hs, + { rw this, exact is_least_min' s hs, }, + rw [is_glb, is_greatest, mem_lower_bounds, mem_upper_bounds] at his, + exact le_antisymm (his.1 (finset.min' s hs) (finset.min'_mem s hs)) (his.2 _ (finset.min'_le s)), +end + +lemma is_lub_iff_is_greatest [linear_order α] (i : α) (s : finset α) (hs : s.nonempty) : + is_lub (s : set α) i ↔ is_greatest ↑s i := +@is_glb_iff_is_least αᵒᵈ _ i s hs + +lemma is_glb_mem [linear_order α] {i : α} (s : finset α) + (his : is_glb (s : set α) i) (hs : s.nonempty) : i ∈ s := +by { rw ← mem_coe, exact ((is_glb_iff_is_least i s hs).mp his).1, } + +lemma is_lub_mem [linear_order α] {i : α} (s : finset α) + (his : is_lub (s : set α) i) (hs : s.nonempty) : i ∈ s := +@is_glb_mem αᵒᵈ _ i s his hs + end finset namespace multiset @@ -1145,7 +1482,7 @@ variables {ι' : Sort*} [complete_lattice α] `⨆ i ∈ t, s i`. This version assumes `ι` is a `Type*`. See `supr_eq_supr_finset'` for a version that works for `ι : Sort*`. -/ lemma supr_eq_supr_finset (s : ι → α) : - (⨆i, s i) = (⨆t:finset ι, ⨆i∈t, s i) := + (⨆ i, s i) = (⨆ t : finset ι, ⨆ i ∈ t, s i) := begin classical, exact le_antisymm @@ -1158,7 +1495,7 @@ end `⨆ i ∈ t, s i`. This version works for `ι : Sort*`. See `supr_eq_supr_finset` for a version that assumes `ι : Type*` but has no `plift`s. -/ lemma supr_eq_supr_finset' (s : ι' → α) : - (⨆i, s i) = (⨆t:finset (plift ι'), ⨆i∈t, s (plift.down i)) := + (⨆ i, s i) = (⨆ t : finset (plift ι'), ⨆ i ∈ t, s (plift.down i)) := by rw [← supr_eq_supr_finset, ← equiv.plift.surjective.supr_comp]; refl /-- Infimum of `s i`, `i : ι`, is equal to the infimum over `t : finset ι` of infima @@ -1171,7 +1508,7 @@ lemma infi_eq_infi_finset (s : ι → α) : (⨅ i, s i) = ⨅ (t : finset ι) ( `⨅ i ∈ t, s i`. This version works for `ι : Sort*`. See `infi_eq_infi_finset` for a version that assumes `ι : Type*` but has no `plift`s. -/ lemma infi_eq_infi_finset' (s : ι' → α) : - (⨅i, s i) = (⨅t:finset (plift ι'), ⨅i∈t, s (plift.down i)) := + (⨅ i, s i) = (⨅ t : finset (plift ι'), ⨅ i ∈ t, s (plift.down i)) := @supr_eq_supr_finset' αᵒᵈ _ _ _ end lattice @@ -1183,21 +1520,21 @@ variables {ι' : Sort*} of finite subfamilies. This version assumes `ι : Type*`. See also `Union_eq_Union_finset'` for a version that works for `ι : Sort*`. -/ lemma Union_eq_Union_finset (s : ι → set α) : - (⋃i, s i) = (⋃t:finset ι, ⋃i∈t, s i) := + (⋃ i, s i) = (⋃ t : finset ι, ⋃ i ∈ t, s i) := supr_eq_supr_finset s /-- Union of an indexed family of sets `s : ι → set α` is equal to the union of the unions of finite subfamilies. This version works for `ι : Sort*`. See also `Union_eq_Union_finset` for a version that assumes `ι : Type*` but avoids `plift`s in the right hand side. -/ lemma Union_eq_Union_finset' (s : ι' → set α) : - (⋃i, s i) = (⋃t:finset (plift ι'), ⋃i∈t, s (plift.down i)) := + (⋃ i, s i) = (⋃ t : finset (plift ι'), ⋃ i ∈ t, s (plift.down i)) := supr_eq_supr_finset' s /-- Intersection of an indexed family of sets `s : ι → set α` is equal to the intersection of the intersections of finite subfamilies. This version assumes `ι : Type*`. See also `Inter_eq_Inter_finset'` for a version that works for `ι : Sort*`. -/ lemma Inter_eq_Inter_finset (s : ι → set α) : - (⋂i, s i) = (⋂t:finset ι, ⋂i∈t, s i) := + (⋂ i, s i) = (⋂ t : finset ι, ⋂ i ∈ t, s i) := infi_eq_infi_finset s /-- Intersection of an indexed family of sets `s : ι → set α` is equal to the intersection of the @@ -1205,7 +1542,7 @@ intersections of finite subfamilies. This version works for `ι : Sort*`. See al `Inter_eq_Inter_finset` for a version that assumes `ι : Type*` but avoids `plift`s in the right hand side. -/ lemma Inter_eq_Inter_finset' (s : ι' → set α) : - (⋂i, s i) = (⋂t:finset (plift ι'), ⋂i∈t, s (plift.down i)) := + (⋂ i, s i) = (⋂ t : finset (plift ι'), ⋂ i ∈ t, s (plift.down i)) := infi_eq_infi_finset' s end set @@ -1267,7 +1604,7 @@ lemma infi_option_to_finset (o : option α) (f : α → β) : (⨅ x ∈ o.to_fi variables [decidable_eq α] theorem supr_union {f : α → β} {s t : finset α} : - (⨆ x ∈ s ∪ t, f x) = (⨆x∈s, f x) ⊔ (⨆x∈t, f x) := + (⨆ x ∈ s ∪ t, f x) = (⨆ x ∈ s, f x) ⊔ (⨆ x ∈ t, f x) := by simp [supr_or, supr_sup_eq] theorem infi_union {f : α → β} {s t : finset α} : @@ -1286,14 +1623,6 @@ lemma supr_finset_image {f : γ → α} {g : α → β} {s : finset γ} : (⨆ x ∈ s.image f, g x) = (⨆ y ∈ s, g (f y)) := by rw [← supr_coe, coe_image, supr_image, supr_coe] -lemma sup_finset_image {β γ : Type*} [semilattice_sup β] [order_bot β] - (f : γ → α) (g : α → β) (s : finset γ) : - (s.image f).sup g = s.sup (g ∘ f) := -begin - classical, - induction s using finset.induction_on with a s' ha ih; simp * -end - lemma infi_finset_image {f : γ → α} {g : α → β} {s : finset γ} : (⨅ x ∈ s.image f, g x) = (⨅ y ∈ s, g (f y)) := by rw [← infi_coe, coe_image, infi_image, infi_coe] @@ -1370,7 +1699,7 @@ lemma set_bInter_insert (a : α) (s : finset α) (t : α → set β) : infi_insert a s t lemma set_bUnion_finset_image {f : γ → α} {g : α → set β} {s : finset γ} : - (⋃x ∈ s.image f, g x) = (⋃y ∈ s, g (f y)) := + (⋃ x ∈ s.image f, g x) = (⋃ y ∈ s, g (f y)) := supr_finset_image lemma set_bInter_finset_image {f : γ → α} {g : α → set β} {s : finset γ} : diff --git a/src/data/finset/locally_finite.lean b/src/data/finset/locally_finite.lean index ebe1b669ddf15..7864e60893459 100644 --- a/src/data/finset/locally_finite.lean +++ b/src/data/finset/locally_finite.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Yaël Dillies -/ import order.locally_finite +import data.set.intervals.monoid /-! # Intervals as finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides basic results about all the `finset.Ixx`, which are defined in `order.locally_finite`. @@ -16,13 +20,23 @@ This file provides basic results about all the `finset.Ixx`, which are defined i This file was originally only about `finset.Ico a b` where `a b : ℕ`. No care has yet been taken to generalize these lemmas properly and many lemmas about `Icc`, `Ioc`, `Ioo` are missing. In general, what's to do is taking the lemmas in `data.x.intervals` and abstract away the concrete structure. + +Complete the API. See +https://github.com/leanprover-community/mathlib/pull/14448#discussion_r906109235 +for some ideas. -/ -variables {α : Type*} +open function order_dual +open_locale big_operators finset_interval + +variables {ι α : Type*} namespace finset section preorder -variables [preorder α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α} +variables [preorder α] + +section locally_finite_order +variables [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α} @[simp] lemma nonempty_Icc : (Icc a b).nonempty ↔ a ≤ b := by rw [←coe_nonempty, coe_Icc, set.nonempty_Icc] @@ -48,9 +62,9 @@ by rw [←coe_eq_empty, coe_Ioc, set.Ioc_eq_empty_iff] @[simp] lemma Ioo_eq_empty_iff [densely_ordered α] : Ioo a b = ∅ ↔ ¬a < b := by rw [←coe_eq_empty, coe_Ioo, set.Ioo_eq_empty_iff] -alias Icc_eq_empty_iff ↔ _ finset.Icc_eq_empty -alias Ico_eq_empty_iff ↔ _ finset.Ico_eq_empty -alias Ioc_eq_empty_iff ↔ _ finset.Ioc_eq_empty +alias Icc_eq_empty_iff ↔ _ Icc_eq_empty +alias Ico_eq_empty_iff ↔ _ Ico_eq_empty +alias Ioc_eq_empty_iff ↔ _ Ioc_eq_empty @[simp] lemma Ioo_eq_empty (h : ¬a < b) : Ioo a b = ∅ := eq_empty_iff_forall_not_mem.2 $ λ x hx, h ((mem_Ioo.1 hx).1.trans (mem_Ioo.1 hx).2) @@ -183,6 +197,19 @@ begin exact and_iff_right_of_imp (λ h, hac.trans h.1), end +lemma Icc_filter_lt_of_lt_right {a b c : α} [decidable_pred (< c)] (h : b < c) : + (Icc a b).filter (< c) = Icc a b := +filter_true_of_mem $ λ x hx, (mem_Icc.1 hx).2.trans_lt h + +lemma Ioc_filter_lt_of_lt_right {a b c : α} [decidable_pred (< c)] (h : b < c) : + (Ioc a b).filter (< c) = Ioc a b := +filter_true_of_mem $ λ x hx, (mem_Ioc.1 hx).2.trans_lt h + +lemma Iic_filter_lt_of_lt_right {α} [preorder α] [locally_finite_order_bot α] + {a c : α} [decidable_pred (< c)] (h : a < c) : + (Iic a).filter (< c) = Iic a := +filter_true_of_mem $ λ x hx, (mem_Iic.1 hx).trans_lt h + variables (a b) [fintype α] lemma filter_lt_lt_eq_Ioo [decidable_pred (λ j, a < j ∧ j < b)] : @@ -197,50 +224,73 @@ lemma filter_le_lt_eq_Ico [decidable_pred (λ j, a ≤ j ∧ j < b)] : lemma filter_le_le_eq_Icc [decidable_pred (λ j, a ≤ j ∧ j ≤ b)] : univ.filter (λ j, a ≤ j ∧ j ≤ b) = Icc a b := by { ext, simp } -lemma filter_lt_eq_Ioi [order_top α] [decidable_pred ((<) a)] : univ.filter ((<) a) = Ioi a := -by { ext, simp } +end filter + +section locally_finite_order_top +variables [locally_finite_order_top α] -lemma filter_le_eq_Ici [order_top α] [decidable_pred ((≤) a)] : univ.filter ((≤) a) = Ici a := -by { ext, simp } +lemma Icc_subset_Ici_self : Icc a b ⊆ Ici a := by simpa [←coe_subset] using set.Icc_subset_Ici_self +lemma Ico_subset_Ici_self : Ico a b ⊆ Ici a := by simpa [←coe_subset] using set.Ico_subset_Ici_self +lemma Ioc_subset_Ioi_self : Ioc a b ⊆ Ioi a := by simpa [←coe_subset] using set.Ioc_subset_Ioi_self +lemma Ioo_subset_Ioi_self : Ioo a b ⊆ Ioi a := by simpa [←coe_subset] using set.Ioo_subset_Ioi_self +lemma Ioc_subset_Ici_self : Ioc a b ⊆ Ici a := Ioc_subset_Icc_self.trans Icc_subset_Ici_self +lemma Ioo_subset_Ici_self : Ioo a b ⊆ Ici a := Ioo_subset_Ico_self.trans Ico_subset_Ici_self -lemma filter_gt_eq_Iio [order_bot α] [decidable_pred (< a)] : univ.filter (< a) = Iio a := -by { ext, simp } +end locally_finite_order_top -lemma filter_ge_eq_Iic [order_bot α] [decidable_pred (≤ a)] : univ.filter (≤ a) = Iic a := -by { ext, simp } +section locally_finite_order_bot +variables [locally_finite_order_bot α] -end filter +lemma Icc_subset_Iic_self : Icc a b ⊆ Iic b := by simpa [←coe_subset] using set.Icc_subset_Iic_self +lemma Ioc_subset_Iic_self : Ioc a b ⊆ Iic b := by simpa [←coe_subset] using set.Ioc_subset_Iic_self +lemma Ico_subset_Iio_self : Ico a b ⊆ Iio b := by simpa [←coe_subset] using set.Ico_subset_Iio_self +lemma Ioo_subset_Iio_self : Ioo a b ⊆ Iio b := by simpa [←coe_subset] using set.Ioo_subset_Iio_self +lemma Ico_subset_Iic_self : Ico a b ⊆ Iic b := Ico_subset_Icc_self.trans Icc_subset_Iic_self +lemma Ioo_subset_Iic_self : Ioo a b ⊆ Iic b := Ioo_subset_Ioc_self.trans Ioc_subset_Iic_self -section order_top -variables [order_top α] +end locally_finite_order_bot +end locally_finite_order -lemma Icc_subset_Ici_self : Icc a b ⊆ Ici a := Icc_subset_Icc_right le_top -lemma Ico_subset_Ici_self : Ico a b ⊆ Ici a := Ico_subset_Icc_self.trans Icc_subset_Ici_self -lemma Ioc_subset_Ici_self : Ioc a b ⊆ Ici a := Ioc_subset_Icc_self.trans Icc_subset_Ici_self -lemma Ioo_subset_Ici_self : Ioo a b ⊆ Ici a := Ioo_subset_Icc_self.trans Icc_subset_Ici_self -lemma Ioi_subset_Ici_self : Ioi a ⊆ Ici a := Ioc_subset_Icc_self -lemma Ioc_subset_Ioi_self : Ioc a b ⊆ Ioi a := Ioc_subset_Ioc_right le_top -lemma Ioo_subset_Ioi_self : Ioo a b ⊆ Ioi a := Ioo_subset_Ioc_self.trans Ioc_subset_Ioi_self +section locally_finite_order_top +variables [locally_finite_order_top α] {a : α} + +lemma Ioi_subset_Ici_self : Ioi a ⊆ Ici a := by simpa [←coe_subset] using set.Ioi_subset_Ici_self lemma _root_.bdd_below.finite {s : set α} (hs : bdd_below s) : s.finite := -hs.finite_of_bdd_above $ order_top.bdd_above s +let ⟨a, ha⟩ := hs in (Ici a).finite_to_set.subset $ λ x hx, mem_Ici.2 $ ha hx -end order_top +lemma _root_.set.infinite.not_bdd_below {s : set α} : s.infinite → ¬ bdd_below s := +mt bdd_below.finite -section order_bot -variables [order_bot α] +variables [fintype α] -lemma Icc_subset_Iic_self : Icc a b ⊆ Iic b := Icc_subset_Icc_left bot_le -lemma Ico_subset_Iic_self : Ico a b ⊆ Iic b := Ico_subset_Icc_self.trans Icc_subset_Iic_self -lemma Ioc_subset_Iic_self : Ioc a b ⊆ Iic b := Ioc_subset_Icc_self.trans Icc_subset_Iic_self -lemma Ioo_subset_Iic_self : Ioo a b ⊆ Iic b := Ioo_subset_Icc_self.trans Icc_subset_Iic_self -lemma Iio_subset_Iic_self : Iio b ⊆ Iic b := Ico_subset_Icc_self -lemma Ico_subset_Iio_self : Ico a b ⊆ Iio b := Ico_subset_Ico_left bot_le -lemma Ioo_subset_Iio_self : Ioo a b ⊆ Iio b := Ioo_subset_Ico_self.trans Ico_subset_Iio_self +lemma filter_lt_eq_Ioi [decidable_pred ((<) a)] : univ.filter ((<) a) = Ioi a := by { ext, simp } +lemma filter_le_eq_Ici [decidable_pred ((≤) a)] : univ.filter ((≤) a) = Ici a := by { ext, simp } + +end locally_finite_order_top + +section locally_finite_order_bot +variables [locally_finite_order_bot α] {a : α} + +lemma Iio_subset_Iic_self : Iio a ⊆ Iic a := by simpa [←coe_subset] using set.Iio_subset_Iic_self lemma _root_.bdd_above.finite {s : set α} (hs : bdd_above s) : s.finite := hs.dual.finite -end order_bot +lemma _root_.set.infinite.not_bdd_above {s : set α} : s.infinite → ¬ bdd_above s := +mt bdd_above.finite + +variables [fintype α] + +lemma filter_gt_eq_Iio [decidable_pred (< a)] : univ.filter (< a) = Iio a := by { ext, simp } +lemma filter_ge_eq_Iic [decidable_pred (≤ a)] : univ.filter (≤ a) = Iic a := by { ext, simp } + +end locally_finite_order_bot + +variables [locally_finite_order_top α] [locally_finite_order_bot α] + +lemma disjoint_Ioi_Iio (a : α) : disjoint (Ioi a) (Iio a) := +disjoint_left.2 $ λ b hab hba, (mem_Ioi.1 hab).not_lt $ mem_Iio.1 hba + end preorder section partial_order @@ -251,6 +301,9 @@ variables [partial_order α] [locally_finite_order α] {a b c : α} @[simp] lemma Icc_eq_singleton_iff : Icc a b = {c} ↔ a = c ∧ b = c := by rw [←coe_eq_singleton, coe_Icc, set.Icc_eq_singleton_iff] +lemma Ico_disjoint_Ico_consecutive (a b c : α) : disjoint (Ico a b) (Ico b c) := +disjoint_left.2 $ λ x hab hbc, (mem_Ico.mp hab).2.not_le (mem_Ico.mp hbc).1 + section decidable_eq variables [decidable_eq α] @@ -279,25 +332,28 @@ by rw [←coe_inj, coe_insert, coe_Ioo, coe_Ioc, set.insert_eq, set.union_comm, @[simp] lemma Ioc_diff_Ioo_self (h : a < b) : Ioc a b \ Ioo a b = {b} := by simp [←coe_inj, h] @[simp] lemma Ico_inter_Ico_consecutive (a b c : α) : Ico a b ∩ Ico b c = ∅ := -begin - refine eq_empty_of_forall_not_mem (λ x hx, _), - rw [mem_inter, mem_Ico, mem_Ico] at hx, - exact hx.1.2.not_le hx.2.1, -end - -lemma Ico_disjoint_Ico_consecutive (a b c : α) : disjoint (Ico a b) (Ico b c) := -le_of_eq $ Ico_inter_Ico_consecutive a b c +(Ico_disjoint_Ico_consecutive a b c).eq_bot end decidable_eq -- Those lemmas are purposefully the other way around +/-- `finset.cons` version of `finset.Ico_insert_right`. -/ lemma Icc_eq_cons_Ico (h : a ≤ b) : Icc a b = (Ico a b).cons b right_not_mem_Ico := by { classical, rw [cons_eq_insert, Ico_insert_right h] } +/-- `finset.cons` version of `finset.Ioc_insert_left`. -/ lemma Icc_eq_cons_Ioc (h : a ≤ b) : Icc a b = (Ioc a b).cons a left_not_mem_Ioc := by { classical, rw [cons_eq_insert, Ioc_insert_left h] } +/-- `finset.cons` version of `finset.Ioo_insert_right`. -/ +lemma Ioc_eq_cons_Ioo (h : a < b) : Ioc a b = (Ioo a b).cons b right_not_mem_Ioo := +by { classical, rw [cons_eq_insert, Ioo_insert_right h], } + +/-- `finset.cons` version of `finset.Ioo_insert_left`. -/ +lemma Ico_eq_cons_Ioo (h : a < b) : Ico a b = (Ioo a b).cons a left_not_mem_Ioo := +by { classical, rw [cons_eq_insert, Ioo_insert_left h] } + lemma Ico_filter_le_left {a b : α} [decidable_pred (≤ a)] (hab : a < b) : (Ico a b).filter (λ x, x ≤ a) = {a} := begin @@ -310,7 +366,7 @@ lemma card_Ico_eq_card_Icc_sub_one (a b : α) : (Ico a b).card = (Icc a b).card begin classical, by_cases h : a ≤ b, - { rw [←Ico_insert_right h, card_insert_of_not_mem right_not_mem_Ico], + { rw [Icc_eq_cons_Ico h, card_cons], exact (nat.add_sub_cancel _ _).symm }, { rw [Ico_eq_empty (λ h', h h'.le), Icc_eq_empty h, card_empty, zero_tsub] } end @@ -321,12 +377,10 @@ lemma card_Ioc_eq_card_Icc_sub_one (a b : α) : (Ioc a b).card = (Icc a b).card lemma card_Ioo_eq_card_Ico_sub_one (a b : α) : (Ioo a b).card = (Ico a b).card - 1 := begin classical, - by_cases h : a ≤ b, - { obtain rfl | h' := h.eq_or_lt, - { rw [Ioo_self, Ico_self, card_empty] }, - rw [←Ioo_insert_left h', card_insert_of_not_mem left_not_mem_Ioo], + by_cases h : a < b, + { rw [Ico_eq_cons_Ioo h, card_cons], exact (nat.add_sub_cancel _ _).symm }, - { rw [Ioo_eq_empty (λ h', h h'.le), Ico_eq_empty (λ h', h h'.le), card_empty, zero_tsub] } + { rw [Ioo_eq_empty h, Ico_eq_empty h, card_empty, zero_tsub] } end lemma card_Ioo_eq_card_Ioc_sub_one (a b : α) : (Ioo a b).card = (Ioc a b).card - 1 := @@ -335,35 +389,58 @@ lemma card_Ioo_eq_card_Ioc_sub_one (a b : α) : (Ioo a b).card = (Ioc a b).card lemma card_Ioo_eq_card_Icc_sub_two (a b : α) : (Ioo a b).card = (Icc a b).card - 2 := by { rw [card_Ioo_eq_card_Ico_sub_one, card_Ico_eq_card_Icc_sub_one], refl } +end partial_order + +section bounded_partial_order +variables [partial_order α] + section order_top -variables [order_top α] +variables [locally_finite_order_top α] -@[simp] lemma Ici_erase [decidable_eq α] (a : α) : (Ici a).erase a = Ioi a := Icc_erase_left _ _ +@[simp] lemma Ici_erase [decidable_eq α] (a : α) : (Ici a).erase a = Ioi a := +by { ext, simp_rw [finset.mem_erase, mem_Ici, mem_Ioi, lt_iff_le_and_ne, and_comm, ne_comm], } @[simp] lemma Ioi_insert [decidable_eq α] (a : α) : insert a (Ioi a) = Ici a := -Ioc_insert_left le_top +by { ext, simp_rw [finset.mem_insert, mem_Ici, mem_Ioi, le_iff_lt_or_eq, or_comm, eq_comm] } + +@[simp] lemma not_mem_Ioi_self {b : α} : b ∉ Ioi b := λ h, lt_irrefl _ (mem_Ioi.1 h) -- Purposefully written the other way around -lemma Ici_eq_cons_Ioi (a : α) : Ici a = (Ioi a).cons a left_not_mem_Ioc := +/-- `finset.cons` version of `finset.Ioi_insert`. -/ +lemma Ici_eq_cons_Ioi (a : α) : Ici a = (Ioi a).cons a not_mem_Ioi_self := by { classical, rw [cons_eq_insert, Ioi_insert] } +lemma card_Ioi_eq_card_Ici_sub_one (a : α) : (Ioi a).card = (Ici a).card - 1 := +by rw [Ici_eq_cons_Ioi, card_cons, add_tsub_cancel_right] + end order_top section order_bot -variables [order_bot α] +variables [locally_finite_order_bot α] -@[simp] lemma Iic_erase [decidable_eq α] (b : α) : (Iic b).erase b = Iio b := Icc_erase_right _ _ +@[simp] lemma Iic_erase [decidable_eq α] (b : α) : (Iic b).erase b = Iio b := +by { ext, simp_rw [finset.mem_erase, mem_Iic, mem_Iio, lt_iff_le_and_ne, and_comm] } @[simp] lemma Iio_insert [decidable_eq α] (b : α) : insert b (Iio b) = Iic b := -Ico_insert_right bot_le +by { ext, simp_rw [finset.mem_insert, mem_Iic, mem_Iio, le_iff_lt_or_eq, or_comm] } + +@[simp] lemma not_mem_Iio_self {b : α} : b ∉ Iio b := λ h, lt_irrefl _ (mem_Iio.1 h) -- Purposefully written the other way around -lemma Iic_eq_cons_Iio (b : α) : Iic b = (Iio b).cons b right_not_mem_Ico := +/-- `finset.cons` version of `finset.Iio_insert`. -/ +lemma Iic_eq_cons_Iio (b : α) : Iic b = (Iio b).cons b not_mem_Iio_self := by { classical, rw [cons_eq_insert, Iio_insert] } +lemma card_Iio_eq_card_Iic_sub_one (a : α) : (Iio a).card = (Iic a).card - 1 := +by rw [Iic_eq_cons_Iio, card_cons, add_tsub_cancel_right] + end order_bot -end partial_order + +end bounded_partial_order section linear_order -variables [linear_order α] [locally_finite_order α] {a b : α} +variables [linear_order α] + +section locally_finite_order +variables [locally_finite_order α] {a b : α} lemma Ico_subset_Ico_iff {a₁ b₁ a₂ b₂ : α} (h : a₁ < b₁) : Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ := @@ -406,6 +483,13 @@ begin { rw [Ico_filter_le_of_le_left h, max_eq_left h] } end +@[simp] lemma Ioo_filter_lt (a b c : α) : (Ioo a b).filter (< c) = Ioo a (min b c) := +by { ext, simp [and_assoc] } + +@[simp] lemma Iio_filter_lt {α} [linear_order α] [locally_finite_order_bot α] (a b : α) : + (Iio a).filter (< b) = Iio (min a b) := +by { ext, simp [and_assoc] } + @[simp] lemma Ico_diff_Ico_left (a b c : α) : (Ico a b) \ (Ico a c) = Ico (max a c) b := begin cases le_total a c, @@ -424,81 +508,207 @@ begin exact and_congr_right' ⟨λ hx, hx.2 hx.1, λ hx, ⟨hx.trans_le h, λ _, hx⟩⟩ } end +end locally_finite_order + +section locally_finite_order_bot +variables [locally_finite_order_bot α] {s : set α} + +lemma _root_.set.infinite.exists_gt (hs : s.infinite) : ∀ a, ∃ b ∈ s, a < b := +not_bdd_above_iff.1 hs.not_bdd_above + +lemma _root_.set.infinite_iff_exists_gt [nonempty α] : s.infinite ↔ ∀ a, ∃ b ∈ s, a < b := +⟨set.infinite.exists_gt, set.infinite_of_forall_exists_gt⟩ + +end locally_finite_order_bot + +section locally_finite_order_top +variables [locally_finite_order_top α] {s : set α} + +lemma _root_.set.infinite.exists_lt (hs : s.infinite) : ∀ a, ∃ b ∈ s, b < a := +not_bdd_below_iff.1 hs.not_bdd_below + +lemma _root_.set.infinite_iff_exists_lt [nonempty α] : s.infinite ↔ ∀ a, ∃ b ∈ s, b < a := +⟨set.infinite.exists_lt, set.infinite_of_forall_exists_lt⟩ + +end locally_finite_order_top + +variables [fintype α] [locally_finite_order_top α] [locally_finite_order_bot α] + +lemma Ioi_disj_union_Iio (a : α) : + (Ioi a).disj_union (Iio a) (disjoint_Ioi_Iio a) = ({a} : finset α)ᶜ := +by { ext, simp [eq_comm] } + +end linear_order + +section lattice +variables [lattice α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α} + +lemma uIcc_to_dual (a b : α) : [to_dual a, to_dual b] = [a, b].map to_dual.to_embedding := +Icc_to_dual _ _ + +@[simp] lemma uIcc_of_le (h : a ≤ b) : [a, b] = Icc a b := +by rw [uIcc, inf_eq_left.2 h, sup_eq_right.2 h] + +@[simp] lemma uIcc_of_ge (h : b ≤ a) : [a, b] = Icc b a := +by rw [uIcc, inf_eq_right.2 h, sup_eq_left.2 h] + +lemma uIcc_comm (a b : α) : [a, b] = [b, a] := by rw [uIcc, uIcc, inf_comm, sup_comm] + +@[simp] lemma uIcc_self : [a, a] = {a} := by simp [uIcc] + +@[simp] lemma nonempty_uIcc : finset.nonempty [a, b] := nonempty_Icc.2 inf_le_sup + +lemma Icc_subset_uIcc : Icc a b ⊆ [a, b] := Icc_subset_Icc inf_le_left le_sup_right +lemma Icc_subset_uIcc' : Icc b a ⊆ [a, b] := Icc_subset_Icc inf_le_right le_sup_left + +@[simp] lemma left_mem_uIcc : a ∈ [a, b] := mem_Icc.2 ⟨inf_le_left, le_sup_left⟩ +@[simp] lemma right_mem_uIcc : b ∈ [a, b] := mem_Icc.2 ⟨inf_le_right, le_sup_right⟩ + +lemma mem_uIcc_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] := +Icc_subset_uIcc $ mem_Icc.2 ⟨ha, hb⟩ + +lemma mem_uIcc_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] := +Icc_subset_uIcc' $ mem_Icc.2 ⟨hb, ha⟩ + +lemma uIcc_subset_uIcc (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] := +by { rw mem_uIcc at h₁ h₂, exact Icc_subset_Icc (le_inf h₁.1 h₂.1) (sup_le h₁.2 h₂.2) } + +lemma uIcc_subset_Icc (ha : a₁ ∈ Icc a₂ b₂) (hb : b₁ ∈ Icc a₂ b₂) : [a₁, b₁] ⊆ Icc a₂ b₂ := +by { rw mem_Icc at ha hb, exact Icc_subset_Icc (le_inf ha.1 hb.1) (sup_le ha.2 hb.2) } + +lemma uIcc_subset_uIcc_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] := +⟨λ h, ⟨h left_mem_uIcc, h right_mem_uIcc⟩, λ h, uIcc_subset_uIcc h.1 h.2⟩ + +lemma uIcc_subset_uIcc_iff_le' : + [a₁, b₁] ⊆ [a₂, b₂] ↔ a₂ ⊓ b₂ ≤ a₁ ⊓ b₁ ∧ a₁ ⊔ b₁ ≤ a₂ ⊔ b₂ := +Icc_subset_Icc_iff inf_le_sup + +lemma uIcc_subset_uIcc_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] := +uIcc_subset_uIcc h right_mem_uIcc + +lemma uIcc_subset_uIcc_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] := +uIcc_subset_uIcc left_mem_uIcc h + +end lattice + +section distrib_lattice +variables [distrib_lattice α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α} + +lemma eq_of_mem_uIcc_of_mem_uIcc : a ∈ [b, c] → b ∈ [a, c] → a = b := +by { simp_rw mem_uIcc, exact set.eq_of_mem_uIcc_of_mem_uIcc } + +lemma eq_of_mem_uIcc_of_mem_uIcc' : b ∈ [a, c] → c ∈ [a, b] → b = c := +by { simp_rw mem_uIcc, exact set.eq_of_mem_uIcc_of_mem_uIcc' } + +lemma uIcc_injective_right (a : α) : injective (λ b, [b, a]) := +λ b c h, by { rw ext_iff at h, + exact eq_of_mem_uIcc_of_mem_uIcc ((h _).1 left_mem_uIcc) ((h _).2 left_mem_uIcc) } + +lemma uIcc_injective_left (a : α) : injective (uIcc a) := +by simpa only [uIcc_comm] using uIcc_injective_right a + +end distrib_lattice + +section linear_order +variables [linear_order α] [locally_finite_order α] {a a₁ a₂ b b₁ b₂ c x : α} + +lemma Icc_min_max : Icc (min a b) (max a b) = [a, b] := rfl + +lemma uIcc_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a := uIcc_of_ge $ le_of_not_ge h +lemma uIcc_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b := uIcc_of_le $ le_of_not_ge h + +lemma uIcc_eq_union : [a, b] = Icc a b ∪ Icc b a := +coe_injective $ by { push_cast, exact set.uIcc_eq_union } + +lemma mem_uIcc' : a ∈ [b, c] ↔ b ≤ a ∧ a ≤ c ∨ c ≤ a ∧ a ≤ b := by simp [uIcc_eq_union] + +lemma not_mem_uIcc_of_lt : c < a → c < b → c ∉ [a, b] := +by { rw mem_uIcc, exact set.not_mem_uIcc_of_lt } + +lemma not_mem_uIcc_of_gt : a < c → b < c → c ∉ [a, b] := +by { rw mem_uIcc, exact set.not_mem_uIcc_of_gt } + +lemma uIcc_subset_uIcc_iff_le : + [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ := +uIcc_subset_uIcc_iff_le' + +/-- A sort of triangle inequality. -/ +lemma uIcc_subset_uIcc_union_uIcc : [a, c] ⊆ [a, b] ∪ [b, c] := +coe_subset.1 $ by { push_cast, exact set.uIcc_subset_uIcc_union_uIcc } + end linear_order section ordered_cancel_add_comm_monoid -variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [decidable_eq α] - [locally_finite_order α] +variables [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] [locally_finite_order α] -lemma image_add_left_Icc (a b c : α) : (Icc a b).image ((+) c) = Icc (c + a) (c + b) := -begin - ext x, - rw [mem_image, mem_Icc], - split, - { rintro ⟨y, hy, rfl⟩, - rw mem_Icc at hy, - exact ⟨add_le_add_left hy.1 c, add_le_add_left hy.2 c⟩ }, - { intro hx, - obtain ⟨y, hy⟩ := exists_add_of_le hx.1, - rw add_assoc at hy, - rw hy at hx, - exact ⟨a + y, mem_Icc.2 ⟨le_of_add_le_add_left hx.1, le_of_add_le_add_left hx.2⟩, hy.symm⟩ } -end +@[simp] lemma map_add_left_Icc (a b c : α) : + (Icc a b).map (add_left_embedding c) = Icc (c + a) (c + b) := +by { rw [← coe_inj, coe_map, coe_Icc, coe_Icc], exact set.image_const_add_Icc _ _ _ } -lemma image_add_left_Ico (a b c : α) : (Ico a b).image ((+) c) = Ico (c + a) (c + b) := -begin - ext x, - rw [mem_image, mem_Ico], - split, - { rintro ⟨y, hy, rfl⟩, - rw mem_Ico at hy, - exact ⟨add_le_add_left hy.1 c, add_lt_add_left hy.2 c⟩ }, - { intro hx, - obtain ⟨y, hy⟩ := exists_add_of_le hx.1, - rw add_assoc at hy, - rw hy at hx, - exact ⟨a + y, mem_Ico.2 ⟨le_of_add_le_add_left hx.1, lt_of_add_lt_add_left hx.2⟩, hy.symm⟩ } -end +@[simp] lemma map_add_right_Icc (a b c : α) : + (Icc a b).map (add_right_embedding c) = Icc (a + c) (b + c) := +by { rw [← coe_inj, coe_map, coe_Icc, coe_Icc], exact set.image_add_const_Icc _ _ _ } -lemma image_add_left_Ioc (a b c : α) : (Ioc a b).image ((+) c) = Ioc (c + a) (c + b) := -begin - ext x, - rw [mem_image, mem_Ioc], - refine ⟨_, λ hx, _⟩, - { rintro ⟨y, hy, rfl⟩, - rw mem_Ioc at hy, - exact ⟨add_lt_add_left hy.1 c, add_le_add_left hy.2 c⟩ }, - { obtain ⟨y, hy⟩ := exists_add_of_le hx.1.le, - rw add_assoc at hy, - rw hy at hx, - exact ⟨a + y, mem_Ioc.2 ⟨lt_of_add_lt_add_left hx.1, le_of_add_le_add_left hx.2⟩, hy.symm⟩ } -end +@[simp] lemma map_add_left_Ico (a b c : α) : + (Ico a b).map (add_left_embedding c) = Ico (c + a) (c + b) := +by { rw [← coe_inj, coe_map, coe_Ico, coe_Ico], exact set.image_const_add_Ico _ _ _ } -lemma image_add_left_Ioo (a b c : α) : (Ioo a b).image ((+) c) = Ioo (c + a) (c + b) := -begin - ext x, - rw [mem_image, mem_Ioo], - refine ⟨_, λ hx, _⟩, - { rintro ⟨y, hy, rfl⟩, - rw mem_Ioo at hy, - exact ⟨add_lt_add_left hy.1 c, add_lt_add_left hy.2 c⟩ }, - { obtain ⟨y, hy⟩ := exists_add_of_le hx.1.le, - rw add_assoc at hy, - rw hy at hx, - exact ⟨a + y, mem_Ioo.2 ⟨lt_of_add_lt_add_left hx.1, lt_of_add_lt_add_left hx.2⟩, hy.symm⟩ } -end +@[simp] lemma map_add_right_Ico (a b c : α) : + (Ico a b).map (add_right_embedding c) = Ico (a + c) (b + c) := +by { rw [← coe_inj, coe_map, coe_Ico, coe_Ico], exact set.image_add_const_Ico _ _ _ } + +@[simp] lemma map_add_left_Ioc (a b c : α) : + (Ioc a b).map (add_left_embedding c) = Ioc (c + a) (c + b) := +by { rw [← coe_inj, coe_map, coe_Ioc, coe_Ioc], exact set.image_const_add_Ioc _ _ _ } + +@[simp] lemma map_add_right_Ioc (a b c : α) : + (Ioc a b).map (add_right_embedding c) = Ioc (a + c) (b + c) := +by { rw [← coe_inj, coe_map, coe_Ioc, coe_Ioc], exact set.image_add_const_Ioc _ _ _ } + +@[simp] lemma map_add_left_Ioo (a b c : α) : + (Ioo a b).map (add_left_embedding c) = Ioo (c + a) (c + b) := +by { rw [← coe_inj, coe_map, coe_Ioo, coe_Ioo], exact set.image_const_add_Ioo _ _ _ } + +@[simp] lemma map_add_right_Ioo (a b c : α) : + (Ioo a b).map (add_right_embedding c) = Ioo (a + c) (b + c) := +by { rw [← coe_inj, coe_map, coe_Ioo, coe_Ioo], exact set.image_add_const_Ioo _ _ _ } + +variables [decidable_eq α] + +@[simp] lemma image_add_left_Icc (a b c : α) : (Icc a b).image ((+) c) = Icc (c + a) (c + b) := +by { rw [← map_add_left_Icc, map_eq_image], refl } -lemma image_add_right_Icc (a b c : α) : (Icc a b).image (+ c) = Icc (a + c) (b + c) := -by { simp_rw add_comm _ c, exact image_add_left_Icc a b c } +@[simp] lemma image_add_left_Ico (a b c : α) : (Ico a b).image ((+) c) = Ico (c + a) (c + b) := +by { rw [← map_add_left_Ico, map_eq_image], refl } + +@[simp] lemma image_add_left_Ioc (a b c : α) : (Ioc a b).image ((+) c) = Ioc (c + a) (c + b) := +by { rw [← map_add_left_Ioc, map_eq_image], refl } + +@[simp] lemma image_add_left_Ioo (a b c : α) : (Ioo a b).image ((+) c) = Ioo (c + a) (c + b) := +by { rw [← map_add_left_Ioo, map_eq_image], refl } + +@[simp] lemma image_add_right_Icc (a b c : α) : (Icc a b).image (+ c) = Icc (a + c) (b + c) := +by { rw [← map_add_right_Icc, map_eq_image], refl } lemma image_add_right_Ico (a b c : α) : (Ico a b).image (+ c) = Ico (a + c) (b + c) := -by { simp_rw add_comm _ c, exact image_add_left_Ico a b c } +by { rw [← map_add_right_Ico, map_eq_image], refl } lemma image_add_right_Ioc (a b c : α) : (Ioc a b).image (+ c) = Ioc (a + c) (b + c) := -by { simp_rw add_comm _ c, exact image_add_left_Ioc a b c } +by { rw [← map_add_right_Ioc, map_eq_image], refl } lemma image_add_right_Ioo (a b c : α) : (Ioo a b).image (+ c) = Ioo (a + c) (b + c) := -by { simp_rw add_comm _ c, exact image_add_left_Ioo a b c } +by { rw [← map_add_right_Ioo, map_eq_image], refl } end ordered_cancel_add_comm_monoid + +@[to_additive] lemma prod_prod_Ioi_mul_eq_prod_prod_off_diag [fintype ι] [linear_order ι] + [locally_finite_order_top ι] [locally_finite_order_bot ι] [comm_monoid α] (f : ι → ι → α) : + ∏ i, ∏ j in Ioi i, f j i * f i j = ∏ i, ∏ j in {i}ᶜ, f j i := +begin + simp_rw [←Ioi_disj_union_Iio, prod_disj_union, prod_mul_distrib], + congr' 1, + rw [prod_sigma', prod_sigma'], + refine prod_bij' (λ i hi, ⟨i.2, i.1⟩) _ _ (λ i hi, ⟨i.2, i.1⟩) _ _ _; simp, +end + end finset diff --git a/src/data/finset/mul_antidiagonal.lean b/src/data/finset/mul_antidiagonal.lean new file mode 100644 index 0000000000000..a03bf9fff06a8 --- /dev/null +++ b/src/data/finset/mul_antidiagonal.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2020 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn, Yaël Dillies +-/ +import data.set.pointwise.basic +import data.set.mul_antidiagonal + +/-! # Multiplication antidiagonal as a `finset`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We construct the `finset` of all pairs +of an element in `s` and an element in `t` that multiply to `a`, +given that `s` and `t` are well-ordered.-/ + +namespace set + +open_locale pointwise +variables {α : Type*} {s t : set α} + +@[to_additive] +lemma is_pwo.mul [ordered_cancel_comm_monoid α] (hs : s.is_pwo) (ht : t.is_pwo) : is_pwo (s * t) := +by { rw ←image_mul_prod, exact (hs.prod ht).image_of_monotone (monotone_fst.mul' monotone_snd) } + +variables [linear_ordered_cancel_comm_monoid α] + +@[to_additive] +lemma is_wf.mul (hs : s.is_wf) (ht : t.is_wf) : is_wf (s * t) := (hs.is_pwo.mul ht.is_pwo).is_wf + +@[to_additive] +lemma is_wf.min_mul (hs : s.is_wf) (ht : t.is_wf) (hsn : s.nonempty) (htn : t.nonempty) : + (hs.mul ht).min (hsn.mul htn) = hs.min hsn * ht.min htn := +begin + refine le_antisymm (is_wf.min_le _ _ (mem_mul.2 ⟨_, _, hs.min_mem _, ht.min_mem _, rfl⟩)) _, + rw is_wf.le_min_iff, + rintro _ ⟨x, y, hx, hy, rfl⟩, + exact mul_le_mul' (hs.min_le _ hx) (ht.min_le _ hy), +end + +end set + +namespace finset + +open_locale pointwise + +variables {α : Type*} +variables [ordered_cancel_comm_monoid α] {s t : set α} (hs : s.is_pwo) (ht : t.is_pwo) (a : α) + +/-- `finset.mul_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in `s` and an +element in `t` that multiply to `a`, but its construction requires proofs that `s` and `t` are +well-ordered. -/ +@[to_additive "`finset.add_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in +`s` and an element in `t` that add to `a`, but its construction requires proofs that `s` and `t` are +well-ordered."] +noncomputable def mul_antidiagonal : finset (α × α) := +(set.mul_antidiagonal.finite_of_is_pwo hs ht a).to_finset + +variables {hs ht a} {u : set α} {hu : u.is_pwo} {x : α × α} + +@[simp, to_additive] +lemma mem_mul_antidiagonal : x ∈ mul_antidiagonal hs ht a ↔ x.1 ∈ s ∧ x.2 ∈ t ∧ x.1 * x.2 = a := +by simp [mul_antidiagonal, and_rotate] + +@[to_additive] lemma mul_antidiagonal_mono_left (h : u ⊆ s) : + mul_antidiagonal hu ht a ⊆ mul_antidiagonal hs ht a := +set.finite.to_finset_mono $ set.mul_antidiagonal_mono_left h + +@[to_additive] lemma mul_antidiagonal_mono_right (h : u ⊆ t) : + mul_antidiagonal hs hu a ⊆ mul_antidiagonal hs ht a := +set.finite.to_finset_mono $ set.mul_antidiagonal_mono_right h + +@[simp, to_additive] lemma swap_mem_mul_antidiagonal : + x.swap ∈ finset.mul_antidiagonal hs ht a ↔ x ∈ finset.mul_antidiagonal ht hs a := +by simp [mul_comm, and.left_comm] + +@[to_additive] +lemma support_mul_antidiagonal_subset_mul : {a | (mul_antidiagonal hs ht a).nonempty} ⊆ s * t := +λ a ⟨b, hb⟩, by { rw mem_mul_antidiagonal at hb, exact ⟨b.1, b.2, hb⟩ } + +@[to_additive] +lemma is_pwo_support_mul_antidiagonal : {a | (mul_antidiagonal hs ht a).nonempty}.is_pwo := +(hs.mul ht).mono support_mul_antidiagonal_subset_mul + +@[to_additive] +lemma mul_antidiagonal_min_mul_min {α} [linear_ordered_cancel_comm_monoid α] {s t : set α} + (hs : s.is_wf) (ht : t.is_wf) (hns : s.nonempty) (hnt : t.nonempty) : + mul_antidiagonal hs.is_pwo ht.is_pwo ((hs.min hns) * (ht.min hnt)) = {(hs.min hns, ht.min hnt)} := +begin + ext ⟨a, b⟩, + simp only [mem_mul_antidiagonal, mem_singleton, prod.ext_iff], + split, + { rintro ⟨has, hat, hst⟩, + obtain rfl := (hs.min_le hns has).eq_of_not_lt + (λ hlt, (mul_lt_mul_of_lt_of_le hlt $ ht.min_le hnt hat).ne' hst), + exact ⟨rfl, mul_left_cancel hst⟩ }, + { rintro ⟨rfl, rfl⟩, + exact ⟨hs.min_mem _, ht.min_mem _, rfl⟩ } +end + +end finset diff --git a/src/data/finset/n_ary.lean b/src/data/finset/n_ary.lean index 79e9f331d4769..dd7d4df71f086 100644 --- a/src/data/finset/n_ary.lean +++ b/src/data/finset/n_ary.lean @@ -4,17 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ import data.finset.prod +import data.set.finite /-! # N-ary images of finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `finset.image₂`, the binary image of finsets. This is the finset version of `set.image2`. This is mostly useful to define pointwise operations. ## Notes -This file is very similar to the n-ary section of `data.set.basic` and to `order.filter.n_ary`. -Please keep them in sync. +This file is very similar to `data.set.n_ary`, `order.filter.n_ary` and `data.option.n_ary`. Please +keep them in sync. We do not define `finset.image₃` as its only purpose would be to prove properties of `finset.image₂` and `set.image2` already fulfills this task. @@ -22,18 +26,18 @@ and `set.image2` already fulfills this task. open function set -namespace finset +variables {α α' β β' γ γ' δ δ' ε ε' ζ ζ' ν : Type*} -variables {α α' β β' γ γ' δ δ' ε ε' : Type*} - [decidable_eq α'] [decidable_eq β'] [decidable_eq γ] [decidable_eq δ] [decidable_eq δ'] - [decidable_eq ε] [decidable_eq ε'] +namespace finset +variables [decidable_eq α'] [decidable_eq β'] [decidable_eq γ] [decidable_eq γ'] [decidable_eq δ] + [decidable_eq δ'] [decidable_eq ε] [decidable_eq ε'] {f f' : α → β → γ} {g g' : α → β → γ → δ} {s s' : finset α} {t t' : finset β} {u u' : finset γ} {a a' : α} {b b' : β} {c : γ} /-- The image of a binary function `f : α → β → γ` as a function `finset α → finset β → finset γ`. Mathematically this should be thought of as the image of the corresponding function `α × β → γ`. -/ def image₂ (f : α → β → γ) (s : finset α) (t : finset β) : finset γ := -(s.product t).image $ uncurry f +(s ×ˢ t).image $ uncurry f @[simp] lemma mem_image₂ : c ∈ image₂ f s t ↔ ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c := by simp [image₂, and_assoc] @@ -46,6 +50,10 @@ lemma card_image₂_le (f : α → β → γ) (s : finset α) (t : finset β) : (image₂ f s t).card ≤ s.card * t.card := card_image_le.trans_eq $ card_product _ _ +lemma card_image₂_iff : + (image₂ f s t).card = s.card * t.card ↔ (s ×ˢ t : set (α × β)).inj_on (λ x, f x.1 x.2) := +by { rw [←card_product, ←coe_product], exact card_image_iff } + lemma card_image₂ (hf : injective2 f) (s : finset α) (t : finset β) : (image₂ f s t).card = s.card * t.card := (card_image_of_injective _ hf.uncurry).trans $ card_product _ _ @@ -64,11 +72,11 @@ lemma image₂_subset_left (ht : t ⊆ t') : image₂ f s t ⊆ image₂ f s t' lemma image₂_subset_right (hs : s ⊆ s') : image₂ f s t ⊆ image₂ f s' t := image₂_subset hs subset.rfl -lemma image_subset_image₂_left (hb : b ∈ t) : (λ a, f a b) '' s ⊆ image₂ f s t := -ball_image_of_ball $ λ a ha, mem_image₂_of_mem ha hb +lemma image_subset_image₂_left (hb : b ∈ t) : s.image (λ a, f a b) ⊆ image₂ f s t := +image_subset_iff.2 $ λ a ha, mem_image₂_of_mem ha hb -lemma image_subset_image₂_right (ha : a ∈ s) : f a '' t ⊆ image₂ f s t := -ball_image_of_ball $ λ b, mem_image₂_of_mem ha +lemma image_subset_image₂_right (ha : a ∈ s) : t.image (λ b, f a b) ⊆ image₂ f s t := +image_subset_iff.2 $ λ b, mem_image₂_of_mem ha lemma forall_image₂_iff {p : γ → Prop} : (∀ z ∈ image₂ f s t, p z) ↔ ∀ (x ∈ s) (y ∈ t), p (f x y) := by simp_rw [←mem_coe, coe_image₂, forall_image2_iff] @@ -76,6 +84,12 @@ by simp_rw [←mem_coe, coe_image₂, forall_image2_iff] @[simp] lemma image₂_subset_iff : image₂ f s t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), f x y ∈ u := forall_image₂_iff +lemma image₂_subset_iff_left : image₂ f s t ⊆ u ↔ ∀ a ∈ s, t.image (λ b, f a b) ⊆ u := +by simp_rw [image₂_subset_iff, image_subset_iff] + +lemma image₂_subset_iff_right : image₂ f s t ⊆ u ↔ ∀ b ∈ t, s.image (λ a, f a b) ⊆ u := +by simp_rw [image₂_subset_iff, image_subset_iff, @forall₂_swap α] + @[simp] lemma image₂_nonempty_iff : (image₂ f s t).nonempty ↔ s.nonempty ∧ t.nonempty := by { rw [←coe_nonempty, coe_image₂], exact image2_nonempty_iff } @@ -93,8 +107,9 @@ lemma nonempty.of_image₂_right (h : (image₂ f s t).nonempty) : t.nonempty := @[simp] lemma image₂_eq_empty_iff : image₂ f s t = ∅ ↔ s = ∅ ∨ t = ∅ := by simp_rw [←not_nonempty_iff_eq_empty, image₂_nonempty_iff, not_and_distrib] -@[simp] lemma image₂_singleton_left : image₂ f {a} t = t.image (f a) := ext $ λ x, by simp +@[simp] lemma image₂_singleton_left : image₂ f {a} t = t.image (λ b, f a b) := ext $ λ x, by simp @[simp] lemma image₂_singleton_right : image₂ f s {b} = s.image (λ a, f a b) := ext $ λ x, by simp +lemma image₂_singleton_left' : image₂ f {a} t = t.image (f a) := image₂_singleton_left lemma image₂_singleton : image₂ f {a} {b} = {f a b} := by simp @@ -104,6 +119,22 @@ coe_injective $ by { push_cast, exact image2_union_left } lemma image₂_union_right [decidable_eq β] : image₂ f s (t ∪ t') = image₂ f s t ∪ image₂ f s t' := coe_injective $ by { push_cast, exact image2_union_right } +@[simp] lemma image₂_insert_left [decidable_eq α] : + image₂ f (insert a s) t = t.image (λ b, f a b) ∪ image₂ f s t := +coe_injective $ by { push_cast, exact image2_insert_left } + +@[simp] lemma image₂_insert_right [decidable_eq β] : + image₂ f s (insert b t) = s.image (λ a, f a b) ∪ image₂ f s t := +coe_injective $ by { push_cast, exact image2_insert_right } + +lemma image₂_inter_left [decidable_eq α] (hf : injective2 f) : + image₂ f (s ∩ s') t = image₂ f s t ∩ image₂ f s' t := +coe_injective $ by { push_cast, exact image2_inter_left hf } + +lemma image₂_inter_right [decidable_eq β] (hf : injective2 f) : + image₂ f s (t ∩ t') = image₂ f s t ∩ image₂ f s t' := +coe_injective $ by { push_cast, exact image2_inter_right hf } + lemma image₂_inter_subset_left [decidable_eq α] : image₂ f (s ∩ s') t ⊆ image₂ f s t ∩ image₂ f s' t := coe_subset.1 $ by { push_cast, exact image2_inter_subset_left } @@ -134,6 +165,47 @@ begin mem_insert_self _ _, ha⟩, h.trans $ image₂_subset (subset_insert _ _) $ subset_insert _ _⟩⟩, end +variables (s t) + +lemma card_image₂_singleton_left (hf : injective (f a)) : (image₂ f {a} t).card = t.card := +by rw [image₂_singleton_left, card_image_of_injective _ hf] + +lemma card_image₂_singleton_right (hf : injective (λ a, f a b)) : (image₂ f s {b}).card = s.card := +by rw [image₂_singleton_right, card_image_of_injective _ hf] + +lemma image₂_singleton_inter [decidable_eq β] (t₁ t₂ : finset β) (hf : injective (f a)) : + image₂ f {a} (t₁ ∩ t₂) = image₂ f {a} t₁ ∩ image₂ f {a} t₂ := +by simp_rw [image₂_singleton_left, image_inter _ _ hf] + +lemma image₂_inter_singleton [decidable_eq α] (s₁ s₂ : finset α) (hf : injective (λ a, f a b)) : + image₂ f (s₁ ∩ s₂) {b} = image₂ f s₁ {b} ∩ image₂ f s₂ {b} := +by simp_rw [image₂_singleton_right, image_inter _ _ hf] + +lemma card_le_card_image₂_left {s : finset α} (hs : s.nonempty) (hf : ∀ a, injective (f a)) : + t.card ≤ (image₂ f s t).card := +begin + obtain ⟨a, ha⟩ := hs, + rw ←card_image₂_singleton_left _ (hf a), + exact card_le_of_subset (image₂_subset_right $ singleton_subset_iff.2 ha), +end + +lemma card_le_card_image₂_right {t : finset β} (ht : t.nonempty) + (hf : ∀ b, injective (λ a, f a b)) : + s.card ≤ (image₂ f s t).card := +begin + obtain ⟨b, hb⟩ := ht, + rw ←card_image₂_singleton_right _ (hf b), + exact card_le_of_subset (image₂_subset_left $ singleton_subset_iff.2 hb), +end + +variables {s t} + +lemma bUnion_image_left : s.bUnion (λ a, t.image $ f a) = image₂ f s t := +coe_injective $ by { push_cast, exact set.Union_image_left _ } + +lemma bUnion_image_right : t.bUnion (λ b, s.image $ λ a, f a b) = image₂ f s t := +coe_injective $ by { push_cast, exact set.Union_image_right _ } + /-! ### Algebraic replacement rules @@ -156,6 +228,17 @@ lemma image₂_image_right (f : α → γ → δ) (g : β → γ) : image₂ f s (t.image g) = image₂ (λ a b, f a (g b)) s t := coe_injective $ by { push_cast, exact image2_image_right _ _ } +@[simp] lemma image₂_mk_eq_product [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) : + image₂ prod.mk s t = s ×ˢ t := +by ext; simp [prod.ext_iff] + +@[simp] lemma image₂_curry (f : α × β → γ) (s : finset α) (t : finset β) : + image₂ (curry f) s t = (s ×ˢ t).image f := +by { classical, rw [←image₂_mk_eq_product, image_image₂, curry] } + +@[simp] lemma image_uncurry_product (f : α → β → γ) (s : finset α) (t : finset β) : + (s ×ˢ t).image (uncurry f) = image₂ f s t := by rw [←image₂_curry, curry_uncurry] + lemma image₂_swap (f : α → β → γ) (s : finset α) (t : finset β) : image₂ f s t = image₂ (λ a b, f b a) t s := coe_injective $ by { push_cast, exact image2_swap _ _ _ } @@ -184,62 +267,159 @@ lemma image₂_right_comm {γ : Type*} {u : finset γ} {f : δ → γ → ε} {g image₂ f (image₂ g s t) u = image₂ g' (image₂ f' s u) t := coe_injective $ by { push_cast, exact image2_right_comm h_right_comm } +lemma image₂_image₂_image₂_comm {γ δ : Type*} {u : finset γ} {v : finset δ} [decidable_eq ζ] + [decidable_eq ζ'] [decidable_eq ν] {f : ε → ζ → ν} {g : α → β → ε} {h : γ → δ → ζ} + {f' : ε' → ζ' → ν} {g' : α → γ → ε'} {h' : β → δ → ζ'} + (h_comm : ∀ a b c d, f (g a b) (h c d) = f' (g' a c) (h' b d)) : + image₂ f (image₂ g s t) (image₂ h u v) = image₂ f' (image₂ g' s u) (image₂ h' t v) := +coe_injective $ by { push_cast, exact image2_image2_image2_comm h_comm } + lemma image_image₂_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'} (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) : (image₂ f s t).image g = image₂ f' (s.image g₁) (t.image g₂) := coe_injective $ by { push_cast, exact image_image2_distrib h_distrib } -/-- Symmetric of `finset.image₂_image_left_comm`. -/ +/-- Symmetric statement to `finset.image₂_image_left_comm`. -/ lemma image_image₂_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'} (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) : (image₂ f s t).image g = image₂ f' (s.image g') t := coe_injective $ by { push_cast, exact image_image2_distrib_left h_distrib } -/-- Symmetric of `finset.image_image₂_right_comm`. -/ +/-- Symmetric statement to `finset.image_image₂_right_comm`. -/ lemma image_image₂_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'} (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) : (image₂ f s t).image g = image₂ f' s (t.image g') := coe_injective $ by { push_cast, exact image_image2_distrib_right h_distrib } -/-- Symmetric of `finset.image_image₂_distrib_left`. -/ +/-- Symmetric statement to `finset.image_image₂_distrib_left`. -/ lemma image₂_image_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ} (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) : image₂ f (s.image g) t = (image₂ f' s t).image g' := (image_image₂_distrib_left $ λ a b, (h_left_comm a b).symm).symm -/-- Symmetric of `finset.image_image₂_distrib_right`. -/ +/-- Symmetric statement to `finset.image_image₂_distrib_right`. -/ lemma image_image₂_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ} (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) : image₂ f s (t.image g) = (image₂ f' s t).image g' := (image_image₂_distrib_right $ λ a b, (h_right_comm a b).symm).symm +/-- The other direction does not hold because of the `s`-`s` cross terms on the RHS. -/ +lemma image₂_distrib_subset_left {γ : Type*} {u : finset γ} {f : α → δ → ε} {g : β → γ → δ} + {f₁ : α → β → β'} {f₂ : α → γ → γ'} {g' : β' → γ' → ε} + (h_distrib : ∀ a b c, f a (g b c) = g' (f₁ a b) (f₂ a c)) : + image₂ f s (image₂ g t u) ⊆ image₂ g' (image₂ f₁ s t) (image₂ f₂ s u) := +coe_subset.1 $ by { push_cast, exact set.image2_distrib_subset_left h_distrib } + +/-- The other direction does not hold because of the `u`-`u` cross terms on the RHS. -/ +lemma image₂_distrib_subset_right {γ : Type*} {u : finset γ} {f : δ → γ → ε} {g : α → β → δ} + {f₁ : α → γ → α'} {f₂ : β → γ → β'} {g' : α' → β' → ε} + (h_distrib : ∀ a b c, f (g a b) c = g' (f₁ a c) (f₂ b c)) : + image₂ f (image₂ g s t) u ⊆ image₂ g' (image₂ f₁ s u) (image₂ f₂ t u) := +coe_subset.1 $ by { push_cast, exact set.image2_distrib_subset_right h_distrib } + lemma image_image₂_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'} (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) : (image₂ f s t).image g = image₂ f' (t.image g₁) (s.image g₂) := by { rw image₂_swap f, exact image_image₂_distrib (λ _ _, h_antidistrib _ _) } -/-- Symmetric of `finset.image₂_image_left_anticomm`. -/ +/-- Symmetric statement to `finset.image₂_image_left_anticomm`. -/ lemma image_image₂_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'} (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) : (image₂ f s t).image g = image₂ f' (t.image g') s := coe_injective $ by { push_cast, exact image_image2_antidistrib_left h_antidistrib } -/-- Symmetric of `finset.image_image₂_right_anticomm`. -/ +/-- Symmetric statement to `finset.image_image₂_right_anticomm`. -/ lemma image_image₂_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'} (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) : (image₂ f s t).image g = image₂ f' t (s.image g') := coe_injective $ by { push_cast, exact image_image2_antidistrib_right h_antidistrib } -/-- Symmetric of `finset.image_image₂_antidistrib_left`. -/ +/-- Symmetric statement to `finset.image_image₂_antidistrib_left`. -/ lemma image₂_image_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ} (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) : image₂ f (s.image g) t = (image₂ f' t s).image g' := (image_image₂_antidistrib_left $ λ a b, (h_left_anticomm b a).symm).symm -/-- Symmetric of `finset.image_image₂_antidistrib_right`. -/ +/-- Symmetric statement to `finset.image_image₂_antidistrib_right`. -/ lemma image_image₂_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ} (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) : image₂ f s (t.image g) = (image₂ f' t s).image g' := (image_image₂_antidistrib_right $ λ a b, (h_right_anticomm b a).symm).symm +/-- If `a` is a left identity for `f : α → β → β`, then `{a}` is a left identity for +`finset.image₂ f`. -/ +lemma image₂_left_identity {f : α → γ → γ} {a : α} (h : ∀ b, f a b = b) (t : finset γ) : + image₂ f {a} t = t := +coe_injective $ by rw [coe_image₂, coe_singleton, set.image2_left_identity h] + +/-- If `b` is a right identity for `f : α → β → α`, then `{b}` is a right identity for +`finset.image₂ f`. -/ +lemma image₂_right_identity {f : γ → β → γ} {b : β} (h : ∀ a, f a b = a) (s : finset γ) : + image₂ f s {b} = s := +by rw [image₂_singleton_right, funext h, image_id'] + +/-- If each partial application of `f` is injective, and images of `s` under those partial +applications are disjoint (but not necessarily distinct!), then the size of `t` divides the size of +`finset.image₂ f s t`. -/ +lemma card_dvd_card_image₂_right (hf : ∀ a ∈ s, injective (f a)) + (hs : ((λ a, t.image $ f a) '' s).pairwise_disjoint id) : + t.card ∣ (image₂ f s t).card := +begin + classical, + induction s using finset.induction with a s ha ih, + { simp }, + specialize ih (forall_of_forall_insert hf) + (hs.subset $ set.image_subset _ $ coe_subset.2 $ subset_insert _ _), + rw image₂_insert_left, + by_cases h : disjoint (image (f a) t) (image₂ f s t), + { rw card_union_eq h, + exact (card_image_of_injective _ $ hf _ $ mem_insert_self _ _).symm.dvd.add ih }, + simp_rw [←bUnion_image_left, disjoint_bUnion_right, not_forall] at h, + obtain ⟨b, hb, h⟩ := h, + rwa union_eq_right_iff_subset.2, + exact (hs.eq (set.mem_image_of_mem _ $ mem_insert_self _ _) + (set.mem_image_of_mem _ $ mem_insert_of_mem hb) h).trans_subset (image_subset_image₂_right hb), +end + +/-- If each partial application of `f` is injective, and images of `t` under those partial +applications are disjoint (but not necessarily distinct!), then the size of `s` divides the size of +`finset.image₂ f s t`. -/ +lemma card_dvd_card_image₂_left (hf : ∀ b ∈ t, injective (λ a, f a b)) + (ht : ((λ b, s.image $ λ a, f a b) '' t).pairwise_disjoint id) : + s.card ∣ (image₂ f s t).card := +by { rw ←image₂_swap, exact card_dvd_card_image₂_right hf ht } + +variables [decidable_eq α] [decidable_eq β] + +lemma image₂_inter_union_subset_union : + image₂ f (s ∩ s') (t ∪ t') ⊆ image₂ f s t ∪ image₂ f s' t' := +coe_subset.1 $ by { push_cast, exact set.image2_inter_union_subset_union } + +lemma image₂_union_inter_subset_union : + image₂ f (s ∪ s') (t ∩ t') ⊆ image₂ f s t ∪ image₂ f s' t' := +coe_subset.1 $ by { push_cast, exact set.image2_union_inter_subset_union } + +lemma image₂_inter_union_subset {f : α → α → β} {s t : finset α} (hf : ∀ a b, f a b = f b a) : + image₂ f (s ∩ t) (s ∪ t) ⊆ image₂ f s t := +coe_subset.1 $ by { push_cast, exact image2_inter_union_subset hf } + +lemma image₂_union_inter_subset {f : α → α → β} {s t : finset α} (hf : ∀ a b, f a b = f b a) : + image₂ f (s ∪ t) (s ∩ t) ⊆ image₂ f s t := +coe_subset.1 $ by { push_cast, exact image2_union_inter_subset hf } + end finset + +namespace set +variables [decidable_eq γ] {s : set α} {t : set β} + +@[simp] lemma to_finset_image2 (f : α → β → γ) (s : set α) (t : set β) [fintype s] [fintype t] + [fintype (image2 f s t)] : + (image2 f s t).to_finset = finset.image₂ f s.to_finset t.to_finset := +finset.coe_injective $ by simp + +lemma finite.to_finset_image2 (f : α → β → γ) (hs : s.finite) (ht : t.finite) + (hf := hs.image2 f ht) : + hf.to_finset = finset.image₂ f hs.to_finset ht.to_finset := +finset.coe_injective $ by simp + +end set diff --git a/src/data/finset/nat_antidiagonal.lean b/src/data/finset/nat_antidiagonal.lean index 66f68b4a912f4..89b428effedb0 100644 --- a/src/data/finset/nat_antidiagonal.lean +++ b/src/data/finset/nat_antidiagonal.lean @@ -9,6 +9,9 @@ import data.multiset.nat_antidiagonal /-! # Antidiagonals in ℕ × ℕ as finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the antidiagonals of ℕ × ℕ as finsets: the `n`-th antidiagonal is the finset of pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more generally for sums going from `0` to `n`. @@ -39,32 +42,33 @@ by simp [antidiagonal] @[simp] lemma antidiagonal_zero : antidiagonal 0 = {(0, 0)} := rfl -lemma antidiagonal_succ {n : ℕ} : - antidiagonal (n + 1) = insert (0, n + 1) ((antidiagonal n).map - (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _))) := +lemma antidiagonal_succ (n : ℕ) : + antidiagonal (n + 1) = cons (0, n + 1) ((antidiagonal n).map + (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ (function.embedding.refl _))) + (by simp) := begin apply eq_of_veq, - rw [insert_val_of_not_mem, map_val], + rw [cons_val, map_val], { apply multiset.nat.antidiagonal_succ }, - { intro con, rcases mem_map.1 con with ⟨⟨a,b⟩, ⟨h1, h2⟩⟩, - simp only [prod.mk.inj_iff, function.embedding.coe_prod_map, prod.map_mk] at h2, - apply nat.succ_ne_zero a h2.1, } end -lemma antidiagonal_succ' {n : ℕ} : - antidiagonal (n + 1) = insert (n + 1, 0) ((antidiagonal n).map - (function.embedding.prod_map (function.embedding.refl _) ⟨nat.succ, nat.succ_injective⟩)) := +lemma antidiagonal_succ' (n : ℕ) : + antidiagonal (n + 1) = cons (n + 1, 0) ((antidiagonal n).map + (function.embedding.prod_map (function.embedding.refl _) ⟨nat.succ, nat.succ_injective⟩)) + (by simp) := begin apply eq_of_veq, - rw [insert_val_of_not_mem, map_val], - { apply multiset.nat.antidiagonal_succ' }, - { simp }, + rw [cons_val, map_val], + exact multiset.nat.antidiagonal_succ', end lemma antidiagonal_succ_succ' {n : ℕ} : - antidiagonal (n + 2) = insert (0, n + 2) (insert (n + 2, 0) ((antidiagonal n).map - (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ ⟨nat.succ, nat.succ_injective⟩))) := -by { rw [antidiagonal_succ, antidiagonal_succ', map_insert, map_map], refl } + antidiagonal (n + 2) = + cons (0, n + 2) + (cons (n + 2, 0) ((antidiagonal n).map + (function.embedding.prod_map ⟨nat.succ, nat.succ_injective⟩ ⟨nat.succ, nat.succ_injective⟩)) + $ by simp) (by simp) := +by { simp_rw [antidiagonal_succ (n + 1), antidiagonal_succ', finset.map_cons, map_map], refl } lemma map_swap_antidiagonal {n : ℕ} : (antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩ = antidiagonal n := @@ -113,7 +117,7 @@ begin have : (λ (x : ℕ × ℕ), x.snd = m) ∘ prod.swap = (λ (x : ℕ × ℕ), x.fst = m), { ext, simp }, rw ←map_swap_antidiagonal, - simp [map_filter, this, filter_fst_eq_antidiagonal, apply_ite (finset.map _)] + simp [filter_map, this, filter_fst_eq_antidiagonal, apply_ite (finset.map _)] end section equiv_prod diff --git a/src/data/finset/noncomm_prod.lean b/src/data/finset/noncomm_prod.lean index f3b54b4642b67..cf80a04194924 100644 --- a/src/data/finset/noncomm_prod.lean +++ b/src/data/finset/noncomm_prod.lean @@ -3,12 +3,16 @@ Copyright (c) 2021 Yakov Pechersky. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yakov Pechersky -/ - +import data.fintype.card +import algebra.hom.commute import algebra.big_operators.basic /-! # Products (respectively, sums) over a finset or a multiset. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The regular `finset.prod` and `multiset.prod` require `[comm_monoid α]`. Often, there are collections `s : finset α` where `[monoid α]` and we know, in a dependent fashion, that for all the terms `∀ (x ∈ s) (y ∈ s), commute x y`. @@ -27,18 +31,21 @@ the two must be equal. -/ -variables {α β γ : Type*} (f : α → β → β) (op : α → α → α) +variables {F ι α β γ : Type*} (f : α → β → β) (op : α → α → α) namespace multiset /-- Fold of a `s : multiset α` with `f : α → β → β`, given a proof that `left_commutative f` on all elements `x ∈ s`. -/ -def noncomm_foldr (s : multiset α) (comm : ∀ (x ∈ s) (y ∈ s) b, f x (f y b) = f y (f x b)) (b : β) : +def noncomm_foldr (s : multiset α) + (comm : {x | x ∈ s}.pairwise $ λ x y, ∀ b, f x (f y b) = f y (f x b)) (b : β) : β := -s.attach.foldr (f ∘ subtype.val) (λ ⟨x, hx⟩ ⟨y, hy⟩, comm x hx y hy) b +s.attach.foldr (f ∘ subtype.val) (λ ⟨x, hx⟩ ⟨y, hy⟩, begin + haveI : is_refl α (λ x y, ∀ b, f x (f y b) = f y (f x b)) := ⟨λ x b, rfl⟩, + exact comm.of_refl hx hy, + end) b -@[simp] lemma noncomm_foldr_coe (l : list α) - (comm : ∀ (x ∈ (l : multiset α)) (y ∈ (l : multiset α)) b, f x (f y b) = f y (f x b)) (b : β) : +@[simp] lemma noncomm_foldr_coe (l : list α) (comm) (b : β) : noncomm_foldr f (l : multiset α) comm b = l.foldr f b := begin simp only [noncomm_foldr, coe_foldr, coe_attach, list.attach], @@ -46,14 +53,9 @@ begin simp [list.map_pmap, list.pmap_eq_map] end -@[simp] lemma noncomm_foldr_empty - (h : ∀ (x ∈ (0 : multiset α)) (y ∈ (0 : multiset α)) b, f x (f y b) = f y (f x b)) (b : β) : - noncomm_foldr f (0 : multiset α) h b = b := rfl +@[simp] lemma noncomm_foldr_empty (h) (b : β) : noncomm_foldr f (0 : multiset α) h b = b := rfl -lemma noncomm_foldr_cons (s : multiset α) (a : α) - (h : ∀ (x ∈ (a ::ₘ s)) (y ∈ (a ::ₘ s)) b, f x (f y b) = f y (f x b)) - (h' : ∀ (x ∈ s) (y ∈ s) b, f x (f y b) = f y (f x b)) - (b : β) : +lemma noncomm_foldr_cons (s : multiset α) (a : α) (h h') (b : β) : noncomm_foldr f (a ::ₘ s) h b = f a (noncomm_foldr f s h' b) := begin induction s using quotient.induction_on, @@ -61,7 +63,7 @@ begin end lemma noncomm_foldr_eq_foldr (s : multiset α) (h : left_commutative f) (b : β) : - noncomm_foldr f s (λ x _ y _, h x y) b = foldr f h b s := + noncomm_foldr f s (λ x _ y _ _, h x y) b = foldr f h b s := begin induction s using quotient.induction_on, simp @@ -72,34 +74,24 @@ include assoc /-- Fold of a `s : multiset α` with an associative `op : α → α → α`, given a proofs that `op` is commutative on all elements `x ∈ s`. -/ -def noncomm_fold (s : multiset α) - (comm : ∀ (x ∈ s) (y ∈ s), op x y = op y x) - (a : α) : α := -noncomm_foldr op s (λ x hx y hy b, by rw [←assoc.assoc, comm _ hx _ hy, assoc.assoc]) a - -@[simp] lemma noncomm_fold_coe (l : list α) - (comm : ∀ (x ∈ (l : multiset α)) (y ∈ (l : multiset α)), op x y = op y x) - (a : α) : +def noncomm_fold (s : multiset α) (comm : {x | x ∈ s}.pairwise $ λ x y, op x y = op y x) : α → α := +noncomm_foldr op s (λ x hx y hy h b, by rw [←assoc.assoc, comm hx hy h, assoc.assoc]) + +@[simp] lemma noncomm_fold_coe (l : list α) (comm) (a : α) : noncomm_fold op (l : multiset α) comm a = l.foldr op a := by simp [noncomm_fold] -@[simp] lemma noncomm_fold_empty - (h : ∀ (x ∈ (0 : multiset α)) (y ∈ (0 : multiset α)), op x y = op y x) (a : α) : - noncomm_fold op (0 : multiset α) h a = a := rfl +@[simp] lemma noncomm_fold_empty (h) (a : α) : noncomm_fold op (0 : multiset α) h a = a := rfl -lemma noncomm_fold_cons (s : multiset α) (a : α) - (h : ∀ (x ∈ a ::ₘ s) (y ∈ a ::ₘ s), op x y = op y x) - (h' : ∀ (x ∈ s) (y ∈ s), op x y = op y x) - (x : α) : +lemma noncomm_fold_cons (s : multiset α) (a : α) (h h') (x : α) : noncomm_fold op (a ::ₘ s) h x = op a (noncomm_fold op s h' x) := begin induction s using quotient.induction_on, simp end -lemma noncomm_fold_eq_fold (s : multiset α) [is_commutative α op] - (a : α) : - noncomm_fold op s (λ x _ y _, is_commutative.comm x y) a = fold op a s := +lemma noncomm_fold_eq_fold (s : multiset α) [is_commutative α op] (a : α) : + noncomm_fold op s (λ x _ y _ _, is_commutative.comm x y) a = fold op a s := begin induction s using quotient.induction_on, simp @@ -112,11 +104,10 @@ variables [monoid α] [monoid β] on all elements `x ∈ s`. -/ @[to_additive "Sum of a `s : multiset α` with `[add_monoid α]`, given a proof that `+` commutes on all elements `x ∈ s`." ] -def noncomm_prod (s : multiset α) (comm : ∀ (x ∈ s) (y ∈ s), commute x y) : α := +def noncomm_prod (s : multiset α) (comm : {x | x ∈ s}.pairwise commute) : α := s.noncomm_fold (*) comm 1 -@[simp, to_additive] lemma noncomm_prod_coe (l : list α) - (comm : ∀ (x ∈ (l : multiset α)) (y ∈ (l : multiset α)), commute x y) : +@[simp, to_additive] lemma noncomm_prod_coe (l : list α) (comm) : noncomm_prod (l : multiset α) comm = l.prod := begin rw [noncomm_prod], @@ -125,26 +116,17 @@ begin { simp }, { rw [list.prod_cons, list.foldr, hl], intros x hx y hy, - exact comm x (list.mem_cons_of_mem _ hx) y (list.mem_cons_of_mem _ hy) } + exact comm (list.mem_cons_of_mem _ hx) (list.mem_cons_of_mem _ hy) } end -@[simp, to_additive] lemma noncomm_prod_empty - (h : ∀ (x ∈ (0 : multiset α)) (y ∈ (0 : multiset α)), commute x y) : - noncomm_prod (0 : multiset α) h = 1 := rfl +@[simp, to_additive] lemma noncomm_prod_empty (h) : noncomm_prod (0 : multiset α) h = 1 := rfl -@[simp, to_additive] lemma noncomm_prod_cons (s : multiset α) (a : α) - (comm : ∀ (x ∈ a ::ₘ s) (y ∈ a ::ₘ s), commute x y) : - noncomm_prod (a ::ₘ s) comm = a * noncomm_prod s - (λ x hx y hy, comm _ (mem_cons_of_mem hx) _ (mem_cons_of_mem hy)) := -begin - induction s using quotient.induction_on, - simp -end +@[simp, to_additive] lemma noncomm_prod_cons (s : multiset α) (a : α) (comm) : + noncomm_prod (a ::ₘ s) comm = a * noncomm_prod s (comm.mono $ λ _, mem_cons_of_mem) := +by { induction s using quotient.induction_on, simp } -@[to_additive] lemma noncomm_prod_cons' (s : multiset α) (a : α) - (comm : ∀ (x ∈ a ::ₘ s) (y ∈ a ::ₘ s), commute x y) : - noncomm_prod (a ::ₘ s) comm = noncomm_prod s - (λ x hx y hy, comm _ (mem_cons_of_mem hx) _ (mem_cons_of_mem hy)) * a := +@[to_additive] lemma noncomm_prod_cons' (s : multiset α) (a : α) (comm) : + noncomm_prod (a ::ₘ s) comm = noncomm_prod s (comm.mono $ λ _, mem_cons_of_mem) * a := begin induction s using quotient.induction_on with s, simp only [quot_mk_to_coe, cons_coe, noncomm_prod_coe, list.prod_cons], @@ -152,7 +134,7 @@ begin { simp }, { rw [list.prod_cons, mul_assoc, ←IH, ←mul_assoc, ←mul_assoc], { congr' 1, - apply comm; + apply comm.of_refl; simp }, { intros x hx y hy, simp only [quot_mk_to_coe, list.mem_cons_iff, mem_coe, cons_coe] at hx hy, @@ -163,29 +145,33 @@ begin simp [hy] } } } end +@[to_additive] lemma noncomm_prod_add (s t : multiset α) (comm) : + noncomm_prod (s + t) comm = + noncomm_prod s (comm.mono $ subset_of_le $ s.le_add_right t) * + noncomm_prod t (comm.mono $ subset_of_le $ t.le_add_left s) := +by { rcases s, rcases t, simp } + @[protected, to_additive] -lemma nocomm_prod_map_aux (s : multiset α) - (comm : ∀ (x ∈ s) (y ∈ s), commute x y) - {F : Type*} [monoid_hom_class F α β] (f : F) : - ∀ (x ∈ s.map f) (y ∈ s.map f), commute x y := +lemma noncomm_prod_map_aux [monoid_hom_class F α β] (s : multiset α) + (comm : {x | x ∈ s}.pairwise commute) (f : F) : + {x | x ∈ s.map f}.pairwise commute := begin simp only [multiset.mem_map], - rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩, - exact (comm _ hx _ hy).map f, + rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ _, + exact (comm.of_refl hx hy).map f, end @[to_additive] -lemma noncomm_prod_map (s : multiset α) (comm : ∀ (x ∈ s) (y ∈ s), commute x y) - {F : Type*} [monoid_hom_class F α β] (f : F) : - f (s.noncomm_prod comm) = (s.map f).noncomm_prod (nocomm_prod_map_aux s comm f) := +lemma noncomm_prod_map [monoid_hom_class F α β] (s : multiset α) (comm) (f : F) : + f (s.noncomm_prod comm) = (s.map f).noncomm_prod (noncomm_prod_map_aux s comm f) := begin induction s using quotient.induction_on, simpa using map_list_prod f _, end @[to_additive noncomm_sum_eq_card_nsmul] -lemma noncomm_prod_eq_pow_card (s : multiset α) (comm : ∀ (x ∈ s) (y ∈ s), commute x y) - (m : α) (h : ∀ (x ∈ s), x = m) : s.noncomm_prod comm = m ^ s.card := +lemma noncomm_prod_eq_pow_card (s : multiset α) (comm) (m : α) (h : ∀ x ∈ s, x = m) : + s.noncomm_prod comm = m ^ s.card := begin induction s using quotient.induction_on, simp only [quot_mk_to_coe, noncomm_prod_coe, coe_card, mem_coe] at *, @@ -193,16 +179,15 @@ begin end @[to_additive] lemma noncomm_prod_eq_prod {α : Type*} [comm_monoid α] (s : multiset α) : - noncomm_prod s (λ _ _ _ _, commute.all _ _) = prod s := + noncomm_prod s (λ _ _ _ _ _, commute.all _ _) = prod s := begin induction s using quotient.induction_on, simp end @[to_additive noncomm_sum_add_commute] -lemma noncomm_prod_commute (s : multiset α) - (comm : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → commute x y) - (y : α) (h : ∀ (x : α), x ∈ s → commute y x) : commute y (s.noncomm_prod comm) := +lemma noncomm_prod_commute (s : multiset α) (comm) (y : α) (h : ∀ x ∈ s, commute y x) : + commute y (s.noncomm_prod comm) := begin induction s using quotient.induction_on, simp only [quot_mk_to_coe, noncomm_prod_coe], @@ -219,19 +204,19 @@ variables [monoid β] [monoid γ] given a proof that `*` commutes on all elements `f x` for `x ∈ s`. -/ @[to_additive "Sum of a `s : finset α` mapped with `f : α → β` with `[add_monoid β]`, given a proof that `+` commutes on all elements `f x` for `x ∈ s`."] -def noncomm_prod (s : finset α) (f : α → β) (comm : ∀ (x ∈ s) (y ∈ s), commute (f x) (f y)) : β := -(s.1.map f).noncomm_prod (by simpa [multiset.mem_map, ←finset.mem_def] using comm) +def noncomm_prod (s : finset α) (f : α → β) + (comm : (s : set α).pairwise (λ a b, commute (f a) (f b))) : β := +(s.1.map f).noncomm_prod $ + by { simp_rw multiset.mem_map, rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ _, exact comm.of_refl ha hb } @[congr, to_additive] -lemma noncomm_prod_congr - {s₁ s₂ : finset α} {f g : α → β} (h₁ : s₁ = s₂) (h₂ : ∀ (x ∈ s₂), f x = g x) - (comm : ∀ (x ∈ s₁) (y ∈ s₁), commute (f x) (f y)) : +lemma noncomm_prod_congr {s₁ s₂ : finset α} {f g : α → β} (h₁ : s₁ = s₂) + (h₂ : ∀ (x ∈ s₂), f x = g x) (comm) : noncomm_prod s₁ f comm = noncomm_prod s₂ g - (λ x hx y hy, h₂ x hx ▸ h₂ y hy ▸ comm x (h₁.symm ▸ hx) y (h₁.symm ▸ hy)) := + (λ x hx y hy h, by { rw [←h₂ _ hx, ←h₂ _ hy], subst h₁, exact comm hx hy h }) := by simp_rw [noncomm_prod, multiset.map_congr (congr_arg _ h₁) h₂] -@[simp, to_additive] lemma noncomm_prod_to_finset [decidable_eq α] (l : list α) (f : α → β) - (comm : ∀ (x ∈ l.to_finset) (y ∈ l.to_finset), commute (f x) (f y)) +@[simp, to_additive] lemma noncomm_prod_to_finset [decidable_eq α] (l : list α) (f : α → β) (comm) (hl : l.nodup) : noncomm_prod l.to_finset f comm = (l.map f).prod := begin @@ -239,43 +224,32 @@ begin simp [noncomm_prod, hl] end -@[simp, to_additive] lemma noncomm_prod_empty (f : α → β) - (h : ∀ (x ∈ (∅ : finset α)) (y ∈ (∅ : finset α)), commute (f x) (f y)) : +@[simp, to_additive] lemma noncomm_prod_empty (f : α → β) (h) : noncomm_prod (∅ : finset α) f h = 1 := rfl @[simp, to_additive] lemma noncomm_prod_insert_of_not_mem [decidable_eq α] (s : finset α) (a : α) - (f : α → β) - (comm : ∀ (x ∈ insert a s) (y ∈ insert a s), commute (f x) (f y)) - (ha : a ∉ s) : - noncomm_prod (insert a s) f comm = f a * noncomm_prod s f - (λ x hx y hy, comm _ (mem_insert_of_mem hx) _ (mem_insert_of_mem hy)) := + (f : α → β) (comm) (ha : a ∉ s) : + noncomm_prod (insert a s) f comm = f a * noncomm_prod s f (comm.mono $ λ _, mem_insert_of_mem) := by simp [insert_val_of_not_mem ha, noncomm_prod] @[to_additive] lemma noncomm_prod_insert_of_not_mem' [decidable_eq α] (s : finset α) (a : α) - (f : α → β) - (comm : ∀ (x ∈ insert a s) (y ∈ insert a s), commute (f x) (f y)) - (ha : a ∉ s) : - noncomm_prod (insert a s) f comm = noncomm_prod s f - (λ x hx y hy, comm _ (mem_insert_of_mem hx) _ (mem_insert_of_mem hy)) * f a := + (f : α → β) (comm) (ha : a ∉ s) : + noncomm_prod (insert a s) f comm = noncomm_prod s f (comm.mono $ λ _, mem_insert_of_mem) * f a := by simp [noncomm_prod, insert_val_of_not_mem ha, multiset.noncomm_prod_cons'] @[simp, to_additive] lemma noncomm_prod_singleton (a : α) (f : α → β) : - noncomm_prod ({a} : finset α) f - (λ x hx y hy, by rw [mem_singleton.mp hx, mem_singleton.mp hy]) = f a := -by simp [noncomm_prod, multiset.singleton_eq_cons] + noncomm_prod ({a} : finset α) f (by { norm_cast, exact set.pairwise_singleton _ _ }) = f a := +by simp [noncomm_prod, ←multiset.cons_zero] @[to_additive] -lemma noncomm_prod_map (s : finset α) (f : α → β) - (comm : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → commute (f x) (f y)) - {F : Type*} [monoid_hom_class F β γ] (g : F) : +lemma noncomm_prod_map [monoid_hom_class F β γ] (s : finset α) (f : α → β) (comm) (g : F) : g (s.noncomm_prod f comm) = s.noncomm_prod (λ i, g (f i)) - (λ x hx y hy, (comm x hx y hy).map g) := + (λ x hx y hy h, (comm.of_refl hx hy).map g) := by simp [noncomm_prod, multiset.noncomm_prod_map] @[to_additive noncomm_sum_eq_card_nsmul] -lemma noncomm_prod_eq_pow_card (s : finset α) (f : α → β) - (comm : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → commute (f x) (f y)) - (m : β) (h : ∀ (x : α), x ∈ s → f x = m) : s.noncomm_prod f comm = m ^ s.card := +lemma noncomm_prod_eq_pow_card (s : finset α) (f : α → β) (comm) (m : β) (h : ∀ x ∈ s, f x = m) : + s.noncomm_prod f comm = m ^ s.card := begin rw [noncomm_prod, multiset.noncomm_prod_eq_pow_card _ _ m], simp only [finset.card_def, multiset.card_map], @@ -283,9 +257,8 @@ begin end @[to_additive noncomm_sum_add_commute] -lemma noncomm_prod_commute (s : finset α) (f : α → β) - (comm : ∀ (x : α), x ∈ s → ∀ (y : α), y ∈ s → commute (f x) (f y)) - (y : β) (h : ∀ (x : α), x ∈ s → commute y (f x)) : commute y (s.noncomm_prod f comm) := +lemma noncomm_prod_commute (s : finset α) (f : α → β) (comm) (y : β) + (h : ∀ x ∈ s, commute y (f x)) : commute y (s.noncomm_prod f comm) := begin apply multiset.noncomm_prod_commute, intro y, @@ -295,7 +268,7 @@ begin end @[to_additive] lemma noncomm_prod_eq_prod {β : Type*} [comm_monoid β] (s : finset α) (f : α → β) : - noncomm_prod s f (λ _ _ _ _, commute.all _ _) = s.prod f := + noncomm_prod s f (λ _ _ _ _ _, commute.all _ _) = s.prod f := begin classical, induction s using finset.induction_on with a s ha IH, @@ -303,16 +276,12 @@ begin { simp [ha, IH] } end -/- The non-commutative version of `finset.prod_union` -/ +/-- The non-commutative version of `finset.prod_union` -/ @[to_additive "The non-commutative version of `finset.sum_union`"] lemma noncomm_prod_union_of_disjoint [decidable_eq α] {s t : finset α} - (h : disjoint s t) (f : α → β) - (comm : ∀ (x ∈ s ∪ t) (y ∈ s ∪ t), commute (f x) (f y)) - (scomm : ∀ (x ∈ s) (y ∈ s), commute (f x) (f y) := - λ _ hx _ hy, comm _ (mem_union_left _ hx) _ (mem_union_left _ hy)) - (tcomm : ∀ (x ∈ t) (y ∈ t), commute (f x) (f y) := - λ _ hx _ hy, comm _ (mem_union_right _ hx) _ (mem_union_right _ hy)) : - noncomm_prod (s ∪ t) f comm = noncomm_prod s f scomm * noncomm_prod t f tcomm := + (h : disjoint s t) (f : α → β) (comm : {x | x ∈ s ∪ t}.pairwise $ λ a b, commute (f a) (f b)) : + noncomm_prod (s ∪ t) f comm = noncomm_prod s f (comm.mono $ coe_subset.2 $ subset_union_left _ _) + * noncomm_prod t f (comm.mono $ coe_subset.2 $ subset_union_right _ _) := begin obtain ⟨sl, sl', rfl⟩ := exists_list_nodup_eq s, obtain ⟨tl, tl', rfl⟩ := exists_list_nodup_eq t, @@ -323,56 +292,46 @@ end @[protected, to_additive] lemma noncomm_prod_mul_distrib_aux {s : finset α} {f : α → β} {g : α → β} - (comm_ff : ∀ (x ∈ s) (y ∈ s), commute (f x) (f y)) - (comm_gg : ∀ (x ∈ s) (y ∈ s), commute (g x) (g y)) - (comm_gf : ∀ (x ∈ s) (y ∈ s), x ≠ y → commute (g x) (f y)) : - (∀ (x ∈ s) (y ∈ s), commute ((f * g) x) ((f * g) y)) := + (comm_ff : (s : set α).pairwise $ λ x y, commute (f x) (f y)) + (comm_gg : (s : set α).pairwise $ λ x y, commute (g x) (g y)) + (comm_gf : (s : set α).pairwise $ λ x y, commute (g x) (f y)) : + (s : set α).pairwise $ λ x y, commute ((f * g) x) ((f * g) y) := begin - intros x hx y hy, - by_cases h : x = y, { subst h }, + intros x hx y hy h, apply commute.mul_left; apply commute.mul_right, - { exact comm_ff x hx y hy }, - { exact (comm_gf y hy x hx (ne.symm h)).symm }, - { exact comm_gf x hx y hy h }, - { exact comm_gg x hx y hy }, + { exact comm_ff.of_refl hx hy }, + { exact (comm_gf hy hx h.symm).symm }, + { exact comm_gf hx hy h }, + { exact comm_gg.of_refl hx hy } end /-- The non-commutative version of `finset.prod_mul_distrib` -/ @[to_additive "The non-commutative version of `finset.sum_add_distrib`"] -lemma noncomm_prod_mul_distrib {s : finset α} (f : α → β) (g : α → β) - (comm_ff : ∀ (x ∈ s) (y ∈ s), commute (f x) (f y)) - (comm_gg : ∀ (x ∈ s) (y ∈ s), commute (g x) (g y)) - (comm_gf : ∀ (x ∈ s) (y ∈ s), x ≠ y → commute (g x) (f y)) : +lemma noncomm_prod_mul_distrib {s : finset α} (f : α → β) (g : α → β) (comm_ff comm_gg comm_gf) : noncomm_prod s (f * g) (noncomm_prod_mul_distrib_aux comm_ff comm_gg comm_gf) = noncomm_prod s f comm_ff * noncomm_prod s g comm_gg := begin classical, induction s using finset.induction_on with x s hnmem ih, { simp, }, - { simp only [finset.noncomm_prod_insert_of_not_mem _ _ _ _ hnmem], - specialize ih - (λ x hx y hy, comm_ff x (mem_insert_of_mem hx) y (mem_insert_of_mem hy)) - (λ x hx y hy, comm_gg x (mem_insert_of_mem hx) y (mem_insert_of_mem hy)) - (λ x hx y hy hne, comm_gf x (mem_insert_of_mem hx) y (mem_insert_of_mem hy) hne), - rw [ih, pi.mul_apply], - simp only [mul_assoc], - congr' 1, - simp only [← mul_assoc], - congr' 1, - apply noncomm_prod_commute, - intros y hy, - have : x ≠ y, by {rintro rfl, contradiction}, - exact comm_gf x (mem_insert_self x s) y (mem_insert_of_mem hy) this, } + simp only [finset.noncomm_prod_insert_of_not_mem _ _ _ _ hnmem], + specialize ih (comm_ff.mono $ λ _, mem_insert_of_mem) (comm_gg.mono $ λ _, mem_insert_of_mem) + (comm_gf.mono $ λ _, mem_insert_of_mem), + rw [ih, pi.mul_apply], + simp only [mul_assoc], + congr' 1, + simp only [← mul_assoc], + congr' 1, + refine noncomm_prod_commute _ _ _ _ (λ y hy, _), + exact comm_gf (mem_insert_self x s) (mem_insert_of_mem hy) (ne_of_mem_of_not_mem hy hnmem).symm, end section finite_pi - -variables {ι : Type*} [fintype ι] [decidable_eq ι] {M : ι → Type*} [∀ i, monoid (M i)] -variables (x : Π i, M i) +variables {M : ι → Type*} [Π i, monoid (M i)] @[to_additive] -lemma noncomm_prod_mul_single : - univ.noncomm_prod (λ i, pi.mul_single i (x i)) (λ i _ j _, pi.mul_single_apply_commute x i j) +lemma noncomm_prod_mul_single [fintype ι] [decidable_eq ι] (x : Π i, M i) : + univ.noncomm_prod (λ i, pi.mul_single i (x i)) (λ i _ j _ _, pi.mul_single_apply_commute x i j) = x := begin ext i, @@ -387,10 +346,11 @@ begin end @[to_additive] -lemma _root_.monoid_hom.pi_ext {f g : (Π i, M i) →* γ} +lemma _root_.monoid_hom.pi_ext [finite ι] [decidable_eq ι] {f g : (Π i, M i) →* γ} (h : ∀ i x, f (pi.mul_single i x) = g (pi.mul_single i x)) : f = g := begin + casesI nonempty_fintype ι, ext x, rw [← noncomm_prod_mul_single x, univ.noncomm_prod_map, univ.noncomm_prod_map], congr' 1 with i, exact h i (x i), diff --git a/src/data/finset/option.lean b/src/data/finset/option.lean index 62acd32e05217..88793ad39b3f3 100644 --- a/src/data/finset/option.lean +++ b/src/data/finset/option.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov, Mario Carneiro, Sean Leather -/ import data.finset.card -import order.hom.basic /-! # Finite sets in `option α` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define * `option.to_finset`: construct an empty or singleton `finset α` from an `option α`; diff --git a/src/data/finset/order.lean b/src/data/finset/order.lean index af8b632cd9c4f..188ddc4c16205 100644 --- a/src/data/finset/order.lean +++ b/src/data/finset/order.lean @@ -8,6 +8,9 @@ import data.finset.basic /-! # Finsets of ordered types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u v w diff --git a/src/data/finset/pairwise.lean b/src/data/finset/pairwise.lean index e88d00420d312..4cdbc55112e2a 100644 --- a/src/data/finset/pairwise.lean +++ b/src/data/finset/pairwise.lean @@ -8,7 +8,12 @@ import data.finset.lattice /-! # Relations holding pairwise on finite sets -In this file we prove a few results about the interaction of `set.pairwise_disjoint` and `finset`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file we prove a few results about the interaction of `set.pairwise_disjoint` and `finset`, +as well as the interaction of `list.pairwise disjoint` and the condition of +`disjoint` on `list.to_finset`, in `set` form. -/ open finset @@ -19,7 +24,7 @@ instance [decidable_eq α] {r : α → α → Prop} [decidable_rel r] {s : finse decidable ((s : set α).pairwise r) := decidable_of_iff' (∀ a ∈ s, ∀ b ∈ s, a ≠ b → r a b) iff.rfl -lemma finset.pairwise_disjoint_range_singleton [decidable_eq α] : +lemma finset.pairwise_disjoint_range_singleton : (set.range (singleton : α → finset α)).pairwise_disjoint id := begin rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h, @@ -28,21 +33,29 @@ end namespace set -lemma pairwise_disjoint.elim_finset [decidable_eq α] {s : set ι} {f : ι → finset α} +lemma pairwise_disjoint.elim_finset {s : set ι} {f : ι → finset α} (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i) (haj : a ∈ f j) : i = j := hs.elim hi hj (finset.not_disjoint_iff.2 ⟨a, hai, haj⟩) -lemma pairwise_disjoint.image_finset_of_le [decidable_eq ι] [semilattice_inf α] [order_bot α] - {s : finset ι} {f : ι → α} (hs : (s : set ι).pairwise_disjoint f) {g : ι → ι} - (hf : ∀ a, f (g a) ≤ f a) : +section semilattice_inf +variables [semilattice_inf α] [order_bot α] {s : finset ι} {f : ι → α} + +lemma pairwise_disjoint.image_finset_of_le [decidable_eq ι] {s : finset ι} {f : ι → α} + (hs : (s : set ι).pairwise_disjoint f) {g : ι → ι} (hf : ∀ a, f (g a) ≤ f a) : (s.image g : set ι).pairwise_disjoint f := begin rw coe_image, exact hs.image_of_le hf, end +lemma pairwise_disjoint.attach (hs : (s : set ι).pairwise_disjoint f) : + (s.attach : set {x // x ∈ s}).pairwise_disjoint (f ∘ subtype.val) := +λ i _ j _ hij, hs i.2 j.2 $ mt subtype.ext_val hij + +end semilattice_inf + variables [lattice α] [order_bot α] /-- Bind operation for `set.pairwise_disjoint`. In a complete lattice, you can use @@ -62,3 +75,27 @@ begin end end set + +namespace list +variables {β : Type*} [decidable_eq α] {r : α → α → Prop} {l : list α} + +lemma pairwise_of_coe_to_finset_pairwise (hl : (l.to_finset : set α).pairwise r) (hn : l.nodup) : + l.pairwise r := +by { rw coe_to_finset at hl, exact hn.pairwise_of_set_pairwise hl } + +lemma pairwise_iff_coe_to_finset_pairwise (hn : l.nodup) (hs : symmetric r) : + (l.to_finset : set α).pairwise r ↔ l.pairwise r := +by { rw [coe_to_finset, hn.pairwise_coe], exact ⟨hs⟩ } + +lemma pairwise_disjoint_of_coe_to_finset_pairwise_disjoint {α ι} + [semilattice_inf α] [order_bot α] [decidable_eq ι] {l : list ι} {f : ι → α} + (hl : (l.to_finset : set ι).pairwise_disjoint f) (hn : l.nodup) : + l.pairwise (_root_.disjoint on f) := +pairwise_of_coe_to_finset_pairwise hl hn + +lemma pairwise_disjoint_iff_coe_to_finset_pairwise_disjoint {α ι} + [semilattice_inf α] [order_bot α] [decidable_eq ι] {l : list ι} {f : ι → α} (hn : l.nodup) : + (l.to_finset : set ι).pairwise_disjoint f ↔ l.pairwise (_root_.disjoint on f) := +pairwise_iff_coe_to_finset_pairwise hn (symmetric_disjoint.comap f) + +end list diff --git a/src/data/finset/pi.lean b/src/data/finset/pi.lean index cf2fe7e7c48bc..0978ffba703e9 100644 --- a/src/data/finset/pi.lean +++ b/src/data/finset/pi.lean @@ -3,11 +3,14 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl -/ -import data.finset.basic +import data.finset.image import data.multiset.pi /-! # The cartesian product of finsets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace finset @@ -22,18 +25,18 @@ satisfied. -/ def pi.empty (β : α → Sort*) (a : α) (h : a ∈ (∅ : finset α)) : β a := multiset.pi.empty β a h -variables {δ : α → Type*} [decidable_eq α] +variables {β : α → Type*} {δ : α → Sort*} [decidable_eq α] /-- Given a finset `s` of `α` and for all `a : α` a finset `t a` of `δ a`, then one can define the finset `s.pi t` of all functions defined on elements of `s` taking values in `t a` for `a ∈ s`. Note that the elements of `s.pi t` are only partially defined, on `s`. -/ -def pi (s : finset α) (t : Πa, finset (δ a)) : finset (Πa∈s, δ a) := +def pi (s : finset α) (t : Πa, finset (β a)) : finset (Πa∈s, β a) := ⟨s.1.pi (λ a, (t a).1), s.nodup.pi $ λ a _, (t a).nodup⟩ -@[simp] lemma pi_val (s : finset α) (t : Πa, finset (δ a)) : +@[simp] lemma pi_val (s : finset α) (t : Πa, finset (β a)) : (s.pi t).1 = s.1.pi (λ a, (t a).1) := rfl -@[simp] lemma mem_pi {s : finset α} {t : Πa, finset (δ a)} {f : Πa∈s, δ a} : +@[simp] lemma mem_pi {s : finset α} {t : Πa, finset (β a)} {f : Πa∈s, β a} : f ∈ s.pi t ↔ (∀a (h : a ∈ s), f a h ∈ t a) := mem_pi _ _ _ @@ -55,21 +58,21 @@ lemma pi.cons_ne {s : finset α} {a a' : α} {b : δ a} {f : Πa, a ∈ s → δ pi.cons s a b f a' h = f a' ((mem_insert.1 h).resolve_left ha.symm) := multiset.pi.cons_ne _ _ -lemma pi_cons_injective {a : α} {b : δ a} {s : finset α} (hs : a ∉ s) : +lemma pi.cons_injective {a : α} {b : δ a} {s : finset α} (hs : a ∉ s) : function.injective (pi.cons s a b) := assume e₁ e₂ eq, -@multiset.pi_cons_injective α _ δ a b s.1 hs _ _ $ +@multiset.pi.cons_injective α _ δ a b s.1 hs _ _ $ funext $ assume e, funext $ assume h, have pi.cons s a b e₁ e (by simpa only [multiset.mem_cons, mem_insert] using h) = pi.cons s a b e₂ e (by simpa only [multiset.mem_cons, mem_insert] using h), { rw [eq] }, this -@[simp] lemma pi_empty {t : Πa:α, finset (δ a)} : - pi (∅ : finset α) t = singleton (pi.empty δ) := rfl +@[simp] lemma pi_empty {t : Πa:α, finset (β a)} : + pi (∅ : finset α) t = singleton (pi.empty β) := rfl -@[simp] lemma pi_insert [∀a, decidable_eq (δ a)] - {s : finset α} {t : Πa:α, finset (δ a)} {a : α} (ha : a ∉ s) : +@[simp] lemma pi_insert [∀a, decidable_eq (β a)] + {s : finset α} {t : Πa:α, finset (β a)} {a : α} (ha : a ∉ s) : pi (insert a s) t = (t a).bUnion (λb, (pi s t).image (pi.cons s a b)) := begin apply eq_of_veq, @@ -80,7 +83,8 @@ begin λ f a' h', multiset.pi.cons s.1 a b f a' (h ▸ h')))) _ (insert_val_of_not_mem ha), subst s', rw pi_cons, congr, funext b, - exact ((pi s t).nodup.map $ multiset.pi_cons_injective ha).dedup.symm, + refine ((pi s t).nodup.map _).dedup.symm, + exact multiset.pi.cons_injective ha, end lemma pi_singletons {β : Type*} (s : finset α) (f : α → β) : @@ -99,14 +103,13 @@ lemma pi_const_singleton {β : Type*} (s : finset α) (i : β) : s.pi (λ _, ({i} : finset β)) = {λ _ _, i} := pi_singletons s (λ _, i) -lemma pi_subset {s : finset α} (t₁ t₂ : Πa, finset (δ a)) (h : ∀ a ∈ s, t₁ a ⊆ t₂ a) : +lemma pi_subset {s : finset α} (t₁ t₂ : Πa, finset (β a)) (h : ∀ a ∈ s, t₁ a ⊆ t₂ a) : s.pi t₁ ⊆ s.pi t₂ := λ g hg, mem_pi.2 $ λ a ha, h a ha (mem_pi.mp hg a ha) -lemma pi_disjoint_of_disjoint {δ : α → Type*} [∀a, decidable_eq (δ a)] - {s : finset α} [decidable_eq (Πa∈s, δ a)] - (t₁ t₂ : Πa, finset (δ a)) {a : α} (ha : a ∈ s) (h : disjoint (t₁ a) (t₂ a)) : +lemma pi_disjoint_of_disjoint {δ : α → Type*} + {s : finset α} (t₁ t₂ : Πa, finset (δ a)) {a : α} (ha : a ∈ s) (h : disjoint (t₁ a) (t₂ a)) : disjoint (s.pi t₁) (s.pi t₂) := disjoint_iff_ne.2 $ λ f₁ hf₁ f₂ hf₂ eq₁₂, disjoint_iff_ne.1 h (f₁ a ha) (mem_pi.mp hf₁ a ha) (f₂ a ha) (mem_pi.mp hf₂ a ha) diff --git a/src/data/finset/pi_induction.lean b/src/data/finset/pi_induction.lean index 23fd8ef8cb3bb..646a65e5c0126 100644 --- a/src/data/finset/pi_induction.lean +++ b/src/data/finset/pi_induction.lean @@ -3,15 +3,19 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ -import data.fintype.basic +import data.fintype.lattice +import data.finset.sigma /-! # Induction principles for `Π i, finset (α i)` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove a few induction principles for functions `Π i : ι, finset (α i)` defined on a finite type. -* `finset.induction_on_pi` is a generic lemma that requires only `[fintype ι]`, `[decidable_eq ι]`, +* `finset.induction_on_pi` is a generic lemma that requires only `[finite ι]`, `[decidable_eq ι]`, and `[Π i, decidable_eq (α i)]`; this version can be seen as a direct generalization of `finset.induction_on`. @@ -25,7 +29,7 @@ finite set, finite type, induction, function open function -variables {ι : Type*} {α : ι → Type*} [fintype ι] [decidable_eq ι] [Π i, decidable_eq (α i)] +variables {ι : Type*} {α : ι → Type*} [finite ι] [decidable_eq ι] [Π i, decidable_eq (α i)] namespace finset @@ -37,6 +41,7 @@ lemma induction_on_pi_of_choice (r : Π i, α i → finset (α i) → Prop) r i x (g i) → p g → p (update g i (insert x (g i)))) : p f := begin + casesI nonempty_fintype ι, induction hs : univ.sigma f using finset.strong_induction_on with s ihs generalizing f, subst s, cases eq_empty_or_nonempty (univ.sigma f) with he hne, { convert h0, simpa [funext_iff] using he }, diff --git a/src/data/finset/pimage.lean b/src/data/finset/pimage.lean index 7b2a3f6aec4bb..9ed110e3d7479 100644 --- a/src/data/finset/pimage.lean +++ b/src/data/finset/pimage.lean @@ -9,6 +9,9 @@ import data.pfun /-! # Image of a `finset α` under a partially defined function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `part.to_finset` and `finset.pimage`. We also prove some trivial lemmas about these definitions. diff --git a/src/data/finset/pointwise.lean b/src/data/finset/pointwise.lean index dd2f87783c0ab..0f441be5a12ec 100644 --- a/src/data/finset/pointwise.lean +++ b/src/data/finset/pointwise.lean @@ -5,11 +5,16 @@ Authors: Floris van Doorn, Yaël Dillies -/ import data.finset.n_ary import data.finset.preimage -import data.set.pointwise +import data.set.pointwise.finite +import data.set.pointwise.smul +import data.set.pointwise.list_of_fn /-! # Pointwise operations of finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines pointwise algebraic operations on finsets. ## Main declarations @@ -24,17 +29,17 @@ For finsets `s` and `t`: * `s - t` (`finset.has_sub`): Subtraction, finset of all `x - y` where `x ∈ s` and `y ∈ t`. * `s / t` (`finset.has_div`): Division, finset of all `x / y` where `x ∈ s` and `y ∈ t`. * `s +ᵥ t` (`finset.has_vadd`): Scalar addition, finset of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`. -* `s • t` (`finset.has_scalar`): Scalar multiplication, finset of all `x • y` where `x ∈ s` and +* `s • t` (`finset.has_smul`): Scalar multiplication, finset of all `x • y` where `x ∈ s` and `y ∈ t`. * `s -ᵥ t` (`finset.has_vsub`): Scalar subtraction, finset of all `x -ᵥ y` where `x ∈ s` and `y ∈ t`. -* `a • s` (`finset.has_scalar_finset`): Scaling, finset of all `a • x` where `x ∈ s`. +* `a • s` (`finset.has_smul_finset`): Scaling, finset of all `a • x` where `x ∈ s`. * `a +ᵥ s` (`finset.has_vadd_finset`): Translation, finset of all `a +ᵥ x` where `x ∈ s`. For `α` a semigroup/monoid, `finset α` is a semigroup/monoid. As an unfortunate side effect, this means that `n • s`, where `n : ℕ`, is ambiguous between pointwise scaling and repeated pointwise addition; the former has `(2 : ℕ) • {1, 2} = {2, 4}`, while -the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`. +the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`. See note [pointwise nat action]. ## Implementation notes @@ -49,46 +54,63 @@ finset multiplication, finset addition, pointwise addition, pointwise multiplica pointwise subtraction -/ -open function -open_locale pointwise +open function mul_opposite +open_locale big_operators pointwise variables {F α β γ : Type*} namespace finset -/-! ### `0`/`1` as sets -/ +/-! ### `0`/`1` as finsets -/ section has_one variables [has_one α] {s : finset α} {a : α} -/-- The finset `(1 : finset α)` is defined as `{1}` in locale `pointwise`. -/ -@[to_additive "The finset `(0 : finset α)` is defined as `{0}` in locale `pointwise`."] +/-- The finset `1 : finset α` is defined as `{1}` in locale `pointwise`. -/ +@[to_additive "The finset `0 : finset α` is defined as `{0}` in locale `pointwise`."] protected def has_one : has_one (finset α) := ⟨{1}⟩ localized "attribute [instance] finset.has_one finset.has_zero" in pointwise @[simp, to_additive] lemma mem_one : a ∈ (1 : finset α) ↔ a = 1 := mem_singleton -@[simp, to_additive] lemma coe_one : ↑(1 : finset α) = (1 : set α) := coe_singleton 1 +@[simp, norm_cast, to_additive] lemma coe_one : ↑(1 : finset α) = (1 : set α) := coe_singleton 1 @[simp, to_additive] lemma one_subset : (1 : finset α) ⊆ s ↔ (1 : α) ∈ s := singleton_subset_iff @[to_additive] lemma singleton_one : ({1} : finset α) = 1 := rfl @[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : finset α) := mem_singleton_self _ @[to_additive] lemma one_nonempty : (1 : finset α).nonempty := ⟨1, one_mem_one⟩ @[simp, to_additive] protected lemma map_one {f : α ↪ β} : map f 1 = {f 1} := map_singleton f 1 - -@[simp, to_additive] -lemma image_one [decidable_eq β] {f : α → β} : image f 1 = {f 1} := image_singleton f 1 +@[simp, to_additive] lemma image_one [decidable_eq β] {f : α → β} : image f 1 = {f 1} := +image_singleton _ _ +@[to_additive] lemma subset_one_iff_eq : s ⊆ 1 ↔ s = ∅ ∨ s = 1 := subset_singleton_iff +@[to_additive] lemma nonempty.subset_one_iff (h : s.nonempty) : s ⊆ 1 ↔ s = 1 := +h.subset_singleton_iff +@[simp, to_additive] lemma card_one : (1 : finset α).card = 1 := card_singleton _ + +/-- The singleton operation as a `one_hom`. -/ +@[to_additive "The singleton operation as a `zero_hom`."] +def singleton_one_hom : one_hom α (finset α) := ⟨singleton, singleton_one⟩ + +@[simp, to_additive] lemma coe_singleton_one_hom : (singleton_one_hom : α → finset α) = singleton := +rfl +@[simp, to_additive] lemma singleton_one_hom_apply (a : α) : singleton_one_hom a = {a} := rfl + +/-- Lift a `one_hom` to `finset` via `image`. -/ +@[to_additive "Lift a `zero_hom` to `finset` via `image`", simps] +def image_one_hom [decidable_eq β] [has_one β] [one_hom_class F α β] (f : F) : + one_hom (finset α) (finset β) := +{ to_fun := finset.image f, + map_one' := by rw [image_one, map_one, singleton_one] } end has_one -open_locale pointwise - /-! ### Finset negation/inversion -/ section has_inv variables [decidable_eq α] [has_inv α] {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α} -/-- The pointwise inverse of a finset `s`: `s⁻¹ = {x⁻¹ | x ∈ s}`. -/ -@[to_additive "The pointwise negation of a finset `s`: `-s = {-x | x ∈ s}`."] +/-- The pointwise inversion of finset `s⁻¹` is defined as `{x⁻¹ | x ∈ s}` in locale `pointwise`. -/ +@[to_additive "The pointwise negation of finset `-s` is defined as `{-x | x ∈ s}` in locale +`pointwise`."] protected def has_inv : has_inv (finset α) := ⟨image has_inv.inv⟩ localized "attribute [instance] finset.has_inv finset.has_neg" in pointwise @@ -102,7 +124,9 @@ localized "attribute [instance] finset.has_inv finset.has_neg" in pointwise @[simp, to_additive] lemma inv_empty : (∅ : finset α)⁻¹ = ∅ := image_empty _ @[simp, to_additive] lemma inv_nonempty_iff : s⁻¹.nonempty ↔ s.nonempty := nonempty.image_iff _ -alias inv_nonempty_iff ↔ finset.nonempty.inv finset.nonempty.of_inv +alias inv_nonempty_iff ↔ nonempty.of_inv nonempty.inv + +attribute [to_additive] nonempty.inv nonempty.of_inv @[to_additive, mono] lemma inv_subset_inv (h : s ⊆ t) : s⁻¹ ⊆ t⁻¹ := image_subset_image h @@ -110,15 +134,18 @@ attribute [mono] neg_subset_neg @[simp, to_additive] lemma inv_singleton (a : α) : ({a} : finset α)⁻¹ = {a⁻¹} := image_singleton _ _ +@[simp, to_additive] +lemma inv_insert (a : α) (s : finset α) : (insert a s)⁻¹ = insert a⁻¹ s⁻¹ := image_insert _ _ _ + end has_inv open_locale pointwise section has_involutive_inv -variables [decidable_eq α] [has_involutive_inv α] {s t : finset α} +variables [decidable_eq α] [has_involutive_inv α] (s : finset α) @[simp, norm_cast, to_additive] -lemma coe_inv (s : finset α) : ↑(s⁻¹) = (s : set α)⁻¹ := coe_image.trans set.image_inv +lemma coe_inv : ↑(s⁻¹) = (s : set α)⁻¹ := coe_image.trans set.image_inv @[simp, to_additive] lemma card_inv : s⁻¹.card = s.card := card_image_of_injective _ inv_injective @@ -130,19 +157,22 @@ end has_involutive_inv /-! ### Finset addition/multiplication -/ section has_mul -variables [decidable_eq α] [has_mul α] {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α} +variables [decidable_eq α] [decidable_eq β] [has_mul α] [has_mul β] [mul_hom_class F α β] (f : F) + {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α} -/-- The pointwise product of two finsets `s` and `t`: `s * t = {x * y | x ∈ s, y ∈ t}`. -/ -@[to_additive "The pointwise sum of two finsets `s` and `t`: `s + t = {x + y | x ∈ s, y ∈ t}`."] +/-- The pointwise multiplication of finsets `s * t` and `t` is defined as `{x * y | x ∈ s, y ∈ t}` +in locale `pointwise`. -/ +@[to_additive "The pointwise addition of finsets `s + t` is defined as `{x + y | x ∈ s, y ∈ t}` in +locale `pointwise`."] protected def has_mul : has_mul (finset α) := ⟨image₂ (*)⟩ localized "attribute [instance] finset.has_mul finset.has_add" in pointwise @[to_additive] -lemma mul_def : s * t = (s.product t).image (λ p : α × α, p.1 * p.2) := rfl +lemma mul_def : s * t = (s ×ˢ t).image (λ p : α × α, p.1 * p.2) := rfl -@[to_additive add_image_prod] -lemma image_mul_prod : (s.product t).image (λ x : α × α, x.fst * x.snd) = s * t := rfl +@[to_additive] +lemma image_mul_product : (s ×ˢ t).image (λ x : α × α, x.fst * x.snd) = s * t := rfl @[to_additive] lemma mem_mul {x : α} : x ∈ s * t ↔ ∃ y z, y ∈ s ∧ z ∈ t ∧ y * z = x := mem_image₂ @@ -151,7 +181,11 @@ lemma mem_mul {x : α} : x ∈ s * t ↔ ∃ y z, y ∈ s ∧ z ∈ t ∧ y * z lemma coe_mul (s t : finset α) : (↑(s * t) : set α) = ↑s * ↑t := coe_image₂ _ _ _ @[to_additive] lemma mul_mem_mul : a ∈ s → b ∈ t → a * b ∈ s * t := mem_image₂_of_mem -@[to_additive] lemma mul_card_le : (s * t).card ≤ s.card * t.card := card_image₂_le _ _ _ +@[to_additive] lemma card_mul_le : (s * t).card ≤ s.card * t.card := card_image₂_le _ _ _ + +@[to_additive] lemma card_mul_iff : + (s * t).card = s.card * t.card ↔ + (s ×ˢ t : set (α × α)).inj_on (λ p, p.1 * p.2) := card_image₂_iff @[simp, to_additive] lemma empty_mul (s : finset α) : ∅ * s = ∅ := image₂_empty_left @[simp, to_additive] lemma mul_empty (s : finset α) : s * ∅ = ∅ := image₂_empty_right @@ -162,9 +196,8 @@ image₂_nonempty_iff @[to_additive] lemma nonempty.of_mul_left : (s * t).nonempty → s.nonempty := nonempty.of_image₂_left @[to_additive] lemma nonempty.of_mul_right : (s * t).nonempty → t.nonempty := nonempty.of_image₂_right -@[simp, to_additive] lemma mul_singleton (a : α) : s * {a} = s.image (* a) := image₂_singleton_right -@[simp, to_additive] lemma singleton_mul (a : α) : {a} * s = s.image ((*) a) := -image₂_singleton_left +@[to_additive] lemma mul_singleton (a : α) : s * {a} = s.image (* a) := image₂_singleton_right +@[to_additive] lemma singleton_mul (a : α) : {a} * s = s.image ((*) a) := image₂_singleton_left @[simp, to_additive] lemma singleton_mul_singleton (a b : α) : ({a} : finset α) * {b} = {a * b} := image₂_singleton @@ -181,6 +214,10 @@ attribute [mono] add_subset_add image₂_inter_subset_left @[to_additive] lemma mul_inter_subset : s * (t₁ ∩ t₂) ⊆ s * t₁ ∩ (s * t₂) := image₂_inter_subset_right +@[to_additive] lemma inter_mul_union_subset_union : s₁ ∩ s₂ * (t₁ ∪ t₂) ⊆ (s₁ * t₁) ∪ (s₂ * t₂) := +image₂_inter_union_subset_union +@[to_additive] lemma union_mul_inter_subset_union : (s₁ ∪ s₂) * (t₁ ∩ t₂) ⊆ (s₁ * t₁) ∪ (s₂ * t₂) := +image₂_union_inter_subset_union /-- If a finset `u` is contained in the product of two sets `s * t`, we can find two finsets `s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' * t'`. -/ @@ -189,97 +226,43 @@ image₂_inter_subset_right lemma subset_mul {s t : set α} : ↑u ⊆ s * t → ∃ s' t' : finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' * t' := subset_image₂ -end has_mul - -open_locale pointwise - -section mul_zero_class -variables [decidable_eq α] [mul_zero_class α] {s t : finset α} - -lemma mul_zero_subset (s : finset α) : s * 0 ⊆ 0 := by simp [subset_iff, mem_mul] -lemma zero_mul_subset (s : finset α) : 0 * s ⊆ 0 := by simp [subset_iff, mem_mul] - -lemma nonempty.mul_zero (hs : s.nonempty) : s * 0 = 0 := -s.mul_zero_subset.antisymm $ by simpa [mem_mul] using hs - -lemma nonempty.zero_mul (hs : s.nonempty) : 0 * s = 0 := -s.zero_mul_subset.antisymm $ by simpa [mem_mul] using hs - -end mul_zero_class - -section group -variables [group α] {s t : finset α} {a b : α} - -section decidable_eq -variables [decidable_eq α] - -@[simp, to_additive] -lemma image_mul_left : - image (λ b, a * b) t = preimage t (λ b, a⁻¹ * b) (λ x hx y hy, (mul_right_inj a⁻¹).mp) := -coe_injective $ by simp - -@[simp, to_additive] -lemma image_mul_right : image (* b) t = preimage t (* b⁻¹) (λ x hx y hy, (mul_left_inj b⁻¹).mp) := -coe_injective $ by simp - -@[to_additive] -lemma image_mul_left' : - image (λ b, a⁻¹ * b) t = preimage t (λ b, a * b) (λ x hx y hy, (mul_right_inj a).mp) := -by simp - -@[to_additive] -lemma image_mul_right' : image (* b⁻¹) t = preimage t (* b) (λ x hx y hy, (mul_left_inj b).mp) := -by simp - -end decidable_eq - -@[simp, to_additive] -lemma preimage_mul_left_singleton : - preimage {b} ((*) a) (λ x hx y hy, (mul_right_inj a).mp) = {a⁻¹ * b} := -by { classical, rw [← image_mul_left', image_singleton] } - -@[simp, to_additive] -lemma preimage_mul_right_singleton : - preimage {b} (* a) (λ x hx y hy, (mul_left_inj a).mp) = {b * a⁻¹} := -by { classical, rw [← image_mul_right', image_singleton] } - -@[simp, to_additive] -lemma preimage_mul_left_one : preimage 1 (λ b, a * b) (λ x hx y hy, (mul_right_inj a).mp) = {a⁻¹} := -by { classical, rw [← image_mul_left', image_one, mul_one] } - -@[simp, to_additive] -lemma preimage_mul_right_one : preimage 1 (* b) (λ x hx y hy, (mul_left_inj b).mp) = {b⁻¹} := -by { classical, rw [← image_mul_right', image_one, one_mul] } +@[to_additive] lemma image_mul : (s * t).image (f : α → β) = s.image f * t.image f := +image_image₂_distrib $ map_mul f -@[to_additive] -lemma preimage_mul_left_one' : - preimage 1 (λ b, a⁻¹ * b) (λ x hx y hy, (mul_right_inj _).mp) = {a} := -by rw [preimage_mul_left_one, inv_inv] +/-- The singleton operation as a `mul_hom`. -/ +@[to_additive "The singleton operation as an `add_hom`."] +def singleton_mul_hom : α →ₙ* finset α := ⟨singleton, λ a b, (singleton_mul_singleton _ _).symm⟩ -@[to_additive] -lemma preimage_mul_right_one' : preimage 1 (* b⁻¹) (λ x hx y hy, (mul_left_inj _).mp) = {b} := -by rw [preimage_mul_right_one, inv_inv] +@[simp, to_additive] lemma coe_singleton_mul_hom : (singleton_mul_hom : α → finset α) = singleton := +rfl +@[simp, to_additive] lemma singleton_mul_hom_apply (a : α) : singleton_mul_hom a = {a} := rfl -end group +/-- Lift a `mul_hom` to `finset` via `image`. -/ +@[to_additive "Lift an `add_hom` to `finset` via `image`", simps] +def image_mul_hom : finset α →ₙ* finset β := +{ to_fun := finset.image f, + map_mul' := λ s t, image_mul _ } -open_locale pointwise +end has_mul /-! ### Finset subtraction/division -/ section has_div variables [decidable_eq α] [has_div α] {s s₁ s₂ t t₁ t₂ u : finset α} {a b : α} -/-- The pointwise product of two finsets `s` and `t`: `s / t = {x / y | x ∈ s, y ∈ t}`. -/ -@[to_additive "The pointwise sum of two finsets `s` and `t`: `s - t = {x - y | x ∈ s, y ∈ t}`."] -protected def has_div : has_div (finset α) := ⟨λ s t, (s.product t).image $ λ p : α × α, p.1 / p.2⟩ +/-- The pointwise division of sfinets `s / t` is defined as `{x / y | x ∈ s, y ∈ t}` in locale +`pointwise`. -/ +@[to_additive "The pointwise subtraction of finsets `s - t` is defined as `{x - y | x ∈ s, y ∈ t}` +in locale `pointwise`."] +protected def has_div : has_div (finset α) := ⟨image₂ (/)⟩ -localized "attribute [instance] finset.has_div finset.has_add" in pointwise +localized "attribute [instance] finset.has_div finset.has_sub" in pointwise @[to_additive] -lemma div_def : s / t = (s.product t).image (λ p : α × α, p.1 / p.2) := rfl +lemma div_def : s / t = (s ×ˢ t).image (λ p : α × α, p.1 / p.2) := rfl @[to_additive add_image_prod] -lemma image_div_prod : (s.product t).image (λ x : α × α, x.fst / x.snd) = s / t := rfl +lemma image_div_prod : (s ×ˢ t).image (λ x : α × α, x.fst / x.snd) = s / t := rfl @[to_additive] lemma mem_div : a ∈ s / t ↔ ∃ b c, b ∈ s ∧ c ∈ t ∧ b / c = a := mem_image₂ @@ -317,6 +300,10 @@ attribute [mono] sub_subset_sub image₂_inter_subset_left @[to_additive] lemma div_inter_subset : s / (t₁ ∩ t₂) ⊆ s / t₁ ∩ (s / t₂) := image₂_inter_subset_right +@[to_additive] lemma inter_div_union_subset_union : (s₁ ∩ s₂) / (t₁ ∪ t₂) ⊆ (s₁ / t₁) ∪ (s₂ / t₂) := +image₂_inter_union_subset_union +@[to_additive] lemma union_div_inter_subset_union : (s₁ ∪ s₂) / (t₁ ∩ t₂) ⊆ (s₁ / t₁) ∪ (s₂ / t₂) := +image₂_union_inter_subset_union /-- If a finset `u` is contained in the product of two sets `s / t`, we can find two finsets `s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' / t'`. -/ @@ -327,52 +314,102 @@ subset_image₂ end has_div -open_locale pointwise - -section group_with_zero -variables [decidable_eq α] [group_with_zero α] {s t : finset α} - -lemma div_zero_subset (s : finset α) : s / 0 ⊆ 0 := by simp [subset_iff, mem_div] -lemma zero_div_subset (s : finset α) : 0 / s ⊆ 0 := by simp [subset_iff, mem_div] - -lemma nonempty.div_zero (hs : s.nonempty) : s / 0 = 0 := -s.div_zero_subset.antisymm $ by simpa [mem_div] using hs - -lemma nonempty.zero_div (hs : s.nonempty) : 0 / s = 0 := -s.zero_div_subset.antisymm $ by simpa [mem_div] using hs - -end group_with_zero - /-! ### Instances -/ open_locale pointwise section instances -variables [decidable_eq α] +variables [decidable_eq α] [decidable_eq β] -/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `finset`. -/ -protected def has_nsmul [has_zero α] [has_add α] : has_scalar ℕ (finset α) := ⟨nsmul_rec⟩ +/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `finset`. See +note [pointwise nat action]. -/ +protected def has_nsmul [has_zero α] [has_add α] : has_smul ℕ (finset α) := ⟨nsmul_rec⟩ /-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a -`finset`. -/ +`finset`. See note [pointwise nat action]. -/ @[to_additive] protected def has_npow [has_one α] [has_mul α] : has_pow (finset α) ℕ := ⟨λ s n, npow_rec n s⟩ /-- Repeated pointwise addition/subtraction (not the same as pointwise repeated -addition/subtraction!) of a `finset`. -/ -protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_scalar ℤ (finset α) := +addition/subtraction!) of a `finset`. See note [pointwise nat action]. -/ +protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_smul ℤ (finset α) := ⟨zsmul_rec⟩ /-- Repeated pointwise multiplication/division (not the same as pointwise repeated -multiplication/division!) of a `finset`. -/ +multiplication/division!) of a `finset`. See note [pointwise nat action]. -/ @[to_additive] protected def has_zpow [has_one α] [has_mul α] [has_inv α] : has_pow (finset α) ℤ := ⟨λ s n, zpow_rec n s⟩ localized "attribute [instance] finset.has_nsmul finset.has_npow finset.has_zsmul finset.has_zpow" in pointwise -@[simp, to_additive] -lemma coe_pow [monoid α] (s : finset α) (n : ℕ) : ↑(s ^ n) = (s ^ n : set α) := +/-- `finset α` is a `semigroup` under pointwise operations if `α` is. -/ +@[to_additive "`finset α` is an `add_semigroup` under pointwise operations if `α` is. "] +protected def semigroup [semigroup α] : semigroup (finset α) := +coe_injective.semigroup _ coe_mul + +section comm_semigroup +variables [comm_semigroup α] {s t : finset α} + +/-- `finset α` is a `comm_semigroup` under pointwise operations if `α` is. -/ +@[to_additive "`finset α` is an `add_comm_semigroup` under pointwise operations if `α` is. "] +protected def comm_semigroup : comm_semigroup (finset α) := coe_injective.comm_semigroup _ coe_mul + +@[to_additive] lemma inter_mul_union_subset : s ∩ t * (s ∪ t) ⊆ s * t := +image₂_inter_union_subset mul_comm + +@[to_additive] lemma union_mul_inter_subset : (s ∪ t) * (s ∩ t) ⊆ s * t := +image₂_union_inter_subset mul_comm + +end comm_semigroup + +section mul_one_class +variables [mul_one_class α] + +/-- `finset α` is a `mul_one_class` under pointwise operations if `α` is. -/ +@[to_additive "`finset α` is an `add_zero_class` under pointwise operations if `α` is."] +protected def mul_one_class : mul_one_class (finset α) := +coe_injective.mul_one_class _ (coe_singleton 1) coe_mul + +localized "attribute [instance] finset.semigroup finset.add_semigroup finset.comm_semigroup + finset.add_comm_semigroup finset.mul_one_class finset.add_zero_class" in pointwise + +@[to_additive] lemma subset_mul_left (s : finset α) {t : finset α} (ht : (1 : α) ∈ t) : s ⊆ s * t := +λ a ha, mem_mul.2 ⟨a, 1, ha, ht, mul_one _⟩ + +@[to_additive] lemma subset_mul_right {s : finset α} (t : finset α) (hs : (1 : α) ∈ s) : + t ⊆ s * t := +λ a ha, mem_mul.2 ⟨1, a, hs, ha, one_mul _⟩ + +/-- The singleton operation as a `monoid_hom`. -/ +@[to_additive "The singleton operation as an `add_monoid_hom`."] +def singleton_monoid_hom : α →* finset α := { ..singleton_mul_hom, ..singleton_one_hom } + +@[simp, to_additive] lemma coe_singleton_monoid_hom : + (singleton_monoid_hom : α → finset α) = singleton := rfl +@[simp, to_additive] lemma singleton_monoid_hom_apply (a : α) : singleton_monoid_hom a = {a} := rfl + +/-- The coercion from `finset` to `set` as a `monoid_hom`. -/ +@[to_additive "The coercion from `finset` to `set` as an `add_monoid_hom`."] +def coe_monoid_hom : finset α →* set α := +{ to_fun := coe, + map_one' := coe_one, + map_mul' := coe_mul } + +@[simp, to_additive] lemma coe_coe_monoid_hom : (coe_monoid_hom : finset α → set α) = coe := rfl +@[simp, to_additive] lemma coe_monoid_hom_apply (s : finset α) : coe_monoid_hom s = s := rfl + +/-- Lift a `monoid_hom` to `finset` via `image`. -/ +@[to_additive "Lift an `add_monoid_hom` to `finset` via `image`", simps] +def image_monoid_hom [mul_one_class β] [monoid_hom_class F α β] (f : F) : finset α →* finset β := +{ ..image_mul_hom f, ..image_one_hom f } + +end mul_one_class + +section monoid +variables [monoid α] {s t : finset α} {a : α} {m n : ℕ} + +@[simp, norm_cast, to_additive] lemma coe_pow (s : finset α) (n : ℕ) : ↑(s ^ n) = (s ^ n : set α) := begin change ↑(npow_rec n s) = _, induction n with n ih, @@ -380,80 +417,270 @@ begin { rw [npow_rec, pow_succ, coe_mul, ih] } end -/- TODO: The below lemmas are duplicate because there is no typeclass greater than -`div_inv_monoid` and `has_involutive_inv` but smaller than `group` and `group_with_zero`. -/ +/-- `finset α` is a `monoid` under pointwise operations if `α` is. -/ +@[to_additive "`finset α` is an `add_monoid` under pointwise operations if `α` is. "] +protected def monoid : monoid (finset α) := coe_injective.monoid _ coe_one coe_mul coe_pow -@[simp, to_additive] lemma coe_zpow [group α] (s : finset α) : ∀ n : ℤ, ↑(s ^ n) = (s ^ n : set α) -| (int.of_nat n) := coe_pow _ _ -| (int.neg_succ_of_nat n) := - by { refine (coe_inv _).trans _, convert congr_arg has_inv.inv (coe_pow _ _) } +localized "attribute [instance] finset.monoid finset.add_monoid" in pointwise -@[simp] lemma coe_zpow' [group_with_zero α] (s : finset α) : ∀ n : ℤ, ↑(s ^ n) = (s ^ n : set α) -| (int.of_nat n) := coe_pow _ _ -| (int.neg_succ_of_nat n) := - by { refine (coe_inv _).trans _, convert congr_arg has_inv.inv (coe_pow _ _) } +@[to_additive] lemma pow_mem_pow (ha : a ∈ s) : ∀ n : ℕ, a ^ n ∈ s ^ n +| 0 := by { rw pow_zero, exact one_mem_one } +| (n + 1) := by { rw pow_succ, exact mul_mem_mul ha (pow_mem_pow _) } -/-- `finset α` is a `mul_one_class` under pointwise operations if `α` is. -/ -@[to_additive "`finset α` is an `add_zero_class` under pointwise operations if `α` is."] -protected def mul_one_class [mul_one_class α] : mul_one_class (finset α) := -coe_injective.mul_one_class _ (coe_singleton 1) (by simp) +@[to_additive] lemma pow_subset_pow (hst : s ⊆ t) : ∀ n : ℕ, s ^ n ⊆ t ^ n +| 0 := by { rw pow_zero, exact subset.rfl } +| (n + 1) := by { rw pow_succ, exact mul_subset_mul hst (pow_subset_pow _) } -/-- `finset α` is a `semigroup` under pointwise operations if `α` is. -/ -@[to_additive "`finset α` is an `add_semigroup` under pointwise operations if `α` is. "] -protected def semigroup [semigroup α] : semigroup (finset α) := -coe_injective.semigroup _ coe_mul +@[to_additive] lemma pow_subset_pow_of_one_mem (hs : (1 : α) ∈ s) : m ≤ n → s ^ m ⊆ s ^ n := +begin + refine nat.le_induction _ (λ n h ih, _) _, + { exact subset.rfl }, + { rw pow_succ, + exact ih.trans (subset_mul_right _ hs) } +end -/-- `finset α` is a `comm_semigroup` under pointwise operations if `α` is. -/ -@[to_additive "`finset α` is an `add_comm_semigroup` under pointwise operations if `α` is. "] -protected def comm_semigroup [comm_semigroup α] : comm_semigroup (finset α) := -coe_injective.comm_semigroup _ coe_mul +@[simp, norm_cast, to_additive] +lemma coe_list_prod (s : list (finset α)) : (↑s.prod : set α) = (s.map coe).prod := +map_list_prod (coe_monoid_hom : finset α →* set α) _ -/-- `finset α` is a `monoid` under pointwise operations if `α` is. -/ -@[to_additive "`finset α` is an `add_monoid` under pointwise operations if `α` is. "] -protected def monoid [monoid α] : monoid (finset α) := -coe_injective.monoid _ coe_one coe_mul coe_pow +@[to_additive] lemma mem_prod_list_of_fn {a : α} {s : fin n → finset α} : + a ∈ (list.of_fn s).prod ↔ ∃ f : (Π i : fin n, s i), (list.of_fn (λ i, (f i : α))).prod = a := +by { rw [←mem_coe, coe_list_prod, list.map_of_fn, set.mem_prod_list_of_fn], refl } + +@[to_additive] lemma mem_pow {a : α} {n : ℕ} : + a ∈ s ^ n ↔ ∃ f : fin n → s, (list.of_fn (λ i, ↑(f i))).prod = a := +by { simp_rw [←mem_coe, coe_pow, set.mem_pow], refl } + +@[simp, to_additive] lemma empty_pow (hn : n ≠ 0) : (∅ : finset α) ^ n = ∅ := +by rw [←tsub_add_cancel_of_le (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn), pow_succ, empty_mul] + +@[to_additive] lemma mul_univ_of_one_mem [fintype α] (hs : (1 : α) ∈ s) : s * univ = univ := +eq_univ_iff_forall.2 $ λ a, mem_mul.2 ⟨_, _, hs, mem_univ _, one_mul _⟩ + +@[to_additive] lemma univ_mul_of_one_mem [fintype α] (ht : (1 : α) ∈ t) : univ * t = univ := +eq_univ_iff_forall.2 $ λ a, mem_mul.2 ⟨_, _, mem_univ _, ht, mul_one _⟩ + +@[simp, to_additive] lemma univ_mul_univ [fintype α] : (univ : finset α) * univ = univ := +mul_univ_of_one_mem $ mem_univ _ + +@[simp, to_additive nsmul_univ] lemma univ_pow [fintype α] (hn : n ≠ 0) : + (univ : finset α) ^ n = univ := +coe_injective $ by rw [coe_pow, coe_univ, set.univ_pow hn] + +@[to_additive] protected lemma _root_.is_unit.finset : is_unit a → is_unit ({a} : finset α) := +is_unit.map (singleton_monoid_hom : α →* finset α) + +end monoid + +section comm_monoid +variables [comm_monoid α] /-- `finset α` is a `comm_monoid` under pointwise operations if `α` is. -/ @[to_additive "`finset α` is an `add_comm_monoid` under pointwise operations if `α` is. "] -protected def comm_monoid [comm_monoid α] : comm_monoid (finset α) := +protected def comm_monoid : comm_monoid (finset α) := coe_injective.comm_monoid _ coe_one coe_mul coe_pow -/- TODO: The below instances are duplicate because there is no typeclass greater than -`div_inv_monoid` and `has_involutive_inv` but smaller than `group` and `group_with_zero`. -/ +localized "attribute [instance] finset.comm_monoid finset.add_comm_monoid" in pointwise -/-- `finset α` is a `div_inv_monoid` under pointwise operations if `α` is. -/ -@[to_additive "`finset α` is an `sub_neg_add_monoid` under pointwise operations if `α` is."] -protected def div_inv_monoid [group α] : div_inv_monoid (finset α) := -coe_injective.div_inv_monoid _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow +@[simp, norm_cast, to_additive] +lemma coe_prod {ι : Type*} (s : finset ι) (f : ι → finset α) : + (↑(∏ i in s, f i) : set α) = ∏ i in s, f i := +map_prod (coe_monoid_hom : finset α →* set α) _ _ -/-- `finset α` is a `div_inv_monoid` under pointwise operations if `α` is. -/ -protected def div_inv_monoid' [group_with_zero α] : div_inv_monoid (finset α) := -coe_injective.div_inv_monoid _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow' +end comm_monoid -localized "attribute [instance] finset.mul_one_class finset.add_zero_class finset.semigroup - finset.add_semigroup finset.monoid finset.add_monoid finset.comm_monoid finset.add_comm_monoid - finset.div_inv_monoid finset.sub_neg_add_monoid finset.div_inv_monoid'" - in pointwise +open_locale pointwise + +section division_monoid +variables [division_monoid α] {s t : finset α} + +@[simp, to_additive] lemma coe_zpow (s : finset α) : ∀ n : ℤ, ↑(s ^ n) = (s ^ n : set α) +| (int.of_nat n) := coe_pow _ _ +| (int.neg_succ_of_nat n) := + by { refine (coe_inv _).trans _, convert congr_arg has_inv.inv (coe_pow _ _) } + +@[to_additive] protected lemma mul_eq_one_iff : s * t = 1 ↔ ∃ a b, s = {a} ∧ t = {b} ∧ a * b = 1 := +by simp_rw [←coe_inj, coe_mul, coe_one, set.mul_eq_one_iff, coe_singleton] + +/-- `finset α` is a division monoid under pointwise operations if `α` is. -/ +@[to_additive "`finset α` is a subtraction monoid under pointwise operations if +`α` is."] +protected def division_monoid : division_monoid (finset α) := +coe_injective.division_monoid _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow + +@[simp, to_additive] lemma is_unit_iff : is_unit s ↔ ∃ a, s = {a} ∧ is_unit a := +begin + split, + { rintro ⟨u, rfl⟩, + obtain ⟨a, b, ha, hb, h⟩ := finset.mul_eq_one_iff.1 u.mul_inv, + refine ⟨a, ha, ⟨a, b, h, singleton_injective _⟩, rfl⟩, + rw [←singleton_mul_singleton, ←ha, ←hb], + exact u.inv_mul }, + { rintro ⟨a, rfl, ha⟩, + exact ha.finset } +end + +@[simp, to_additive] lemma is_unit_coe : is_unit (s : set α) ↔ is_unit s := +by simp_rw [is_unit_iff, set.is_unit_iff, coe_eq_singleton] + +end division_monoid + +/-- `finset α` is a commutative division monoid under pointwise operations if `α` is. -/ +@[to_additive subtraction_comm_monoid "`finset α` is a commutative subtraction monoid under +pointwise operations if `α` is."] +protected def division_comm_monoid [division_comm_monoid α] : division_comm_monoid (finset α) := +coe_injective.division_comm_monoid _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow + +/-- `finset α` has distributive negation if `α` has. -/ +protected def has_distrib_neg [has_mul α] [has_distrib_neg α] : has_distrib_neg (finset α) := +coe_injective.has_distrib_neg _ coe_neg coe_mul + +localized "attribute [instance] finset.division_monoid finset.subtraction_monoid + finset.division_comm_monoid finset.subtraction_comm_monoid finset.has_distrib_neg" in pointwise + +section distrib +variables [distrib α] (s t u : finset α) + +/-! +Note that `finset α` is not a `distrib` because `s * t + s * u` has cross terms that `s * (t + u)` +lacks. + +```lean +-- {10, 16, 18, 20, 8, 9} +#eval {1, 2} * ({3, 4} + {5, 6} : finset ℕ) + +-- {10, 11, 12, 13, 14, 15, 16, 18, 20, 8, 9} +#eval ({1, 2} : finset ℕ) * {3, 4} + {1, 2} * {5, 6} +``` +-/ + +lemma mul_add_subset : s * (t + u) ⊆ s * t + s * u := image₂_distrib_subset_left mul_add +lemma add_mul_subset : (s + t) * u ⊆ s * u + t * u := image₂_distrib_subset_right add_mul + +end distrib + +section mul_zero_class +variables [mul_zero_class α] {s t : finset α} + +/-! Note that `finset` is not a `mul_zero_class` because `0 * ∅ ≠ 0`. -/ + +lemma mul_zero_subset (s : finset α) : s * 0 ⊆ 0 := by simp [subset_iff, mem_mul] +lemma zero_mul_subset (s : finset α) : 0 * s ⊆ 0 := by simp [subset_iff, mem_mul] + +lemma nonempty.mul_zero (hs : s.nonempty) : s * 0 = 0 := +s.mul_zero_subset.antisymm $ by simpa [mem_mul] using hs + +lemma nonempty.zero_mul (hs : s.nonempty) : 0 * s = 0 := +s.zero_mul_subset.antisymm $ by simpa [mem_mul] using hs + +end mul_zero_class + +section group +variables [group α] [division_monoid β] [monoid_hom_class F α β] (f : F) {s t : finset α} {a b : α} + +/-! Note that `finset` is not a `group` because `s / s ≠ 1` in general. -/ + +@[simp, to_additive] lemma one_mem_div_iff : (1 : α) ∈ s / t ↔ ¬ disjoint s t := +by rw [←mem_coe, ←disjoint_coe, coe_div, set.one_mem_div_iff] + +@[to_additive] lemma not_one_mem_div_iff : (1 : α) ∉ s / t ↔ disjoint s t := +one_mem_div_iff.not_left + +@[to_additive] lemma nonempty.one_mem_div (h : s.nonempty) : (1 : α) ∈ s / s := +let ⟨a, ha⟩ := h in mem_div.2 ⟨a, a, ha, ha, div_self' _⟩ + +@[to_additive] lemma is_unit_singleton (a : α) : is_unit ({a} : finset α) := +(group.is_unit a).finset + +@[simp] lemma is_unit_iff_singleton : is_unit s ↔ ∃ a, s = {a} := +by simp only [is_unit_iff, group.is_unit, and_true] +@[simp, to_additive] +lemma image_mul_left : + image (λ b, a * b) t = preimage t (λ b, a⁻¹ * b) ((mul_right_injective _).inj_on _) := +coe_injective $ by simp + +@[simp, to_additive] +lemma image_mul_right : image (* b) t = preimage t (* b⁻¹) ((mul_left_injective _).inj_on _) := +coe_injective $ by simp + +@[to_additive] +lemma image_mul_left' : + image (λ b, a⁻¹ * b) t = preimage t (λ b, a * b) ((mul_right_injective _).inj_on _) := +by simp + +@[to_additive] +lemma image_mul_right' : image (* b⁻¹) t = preimage t (* b) ((mul_left_injective _).inj_on _) := +by simp + +lemma image_div : (s / t).image (f : α → β) = s.image f / t.image f := +image_image₂_distrib $ map_div f + +end group + +section group_with_zero +variables [group_with_zero α] {s t : finset α} + +lemma div_zero_subset (s : finset α) : s / 0 ⊆ 0 := by simp [subset_iff, mem_div] +lemma zero_div_subset (s : finset α) : 0 / s ⊆ 0 := by simp [subset_iff, mem_div] + +lemma nonempty.div_zero (hs : s.nonempty) : s / 0 = 0 := +s.div_zero_subset.antisymm $ by simpa [mem_div] using hs + +lemma nonempty.zero_div (hs : s.nonempty) : 0 / s = 0 := +s.zero_div_subset.antisymm $ by simpa [mem_div] using hs + +end group_with_zero end instances -/-! ### Finset addition/multiplication -/ +section group +variables [group α] {s t : finset α} {a b : α} + +@[simp, to_additive] +lemma preimage_mul_left_singleton : + preimage {b} ((*) a) ((mul_right_injective _).inj_on _) = {a⁻¹ * b} := +by { classical, rw [← image_mul_left', image_singleton] } + +@[simp, to_additive] +lemma preimage_mul_right_singleton : + preimage {b} (* a) ((mul_left_injective _).inj_on _) = {b * a⁻¹} := +by { classical, rw [← image_mul_right', image_singleton] } + +@[simp, to_additive] +lemma preimage_mul_left_one : preimage 1 ((*) a) ((mul_right_injective _).inj_on _) = {a⁻¹} := +by { classical, rw [← image_mul_left', image_one, mul_one] } + +@[simp, to_additive] +lemma preimage_mul_right_one : preimage 1 (* b) ((mul_left_injective _).inj_on _) = {b⁻¹} := +by { classical, rw [← image_mul_right', image_one, one_mul] } + +@[to_additive] +lemma preimage_mul_left_one' : preimage 1 ((*) a⁻¹) ((mul_right_injective _).inj_on _) = {a} := +by rw [preimage_mul_left_one, inv_inv] + +@[to_additive] +lemma preimage_mul_right_one' : preimage 1 (* b⁻¹) ((mul_left_injective _).inj_on _) = {b} := +by rw [preimage_mul_right_one, inv_inv] + +end group -section has_scalar -variables [decidable_eq β] [has_scalar α β] {s s₁ s₂ : finset α} {t t₁ t₂ u : finset β} {a : α} +/-! ### Scalar addition/multiplication of finsets -/ + +section has_smul +variables [decidable_eq β] [has_smul α β] {s s₁ s₂ : finset α} {t t₁ t₂ u : finset β} {a : α} {b : β} /-- The pointwise product of two finsets `s` and `t`: `s • t = {x • y | x ∈ s, y ∈ t}`. -/ -@[to_additive has_vadd "The pointwise sum of two finsets `s` and +@[to_additive "The pointwise sum of two finsets `s` and `t`: `s +ᵥ t = {x +ᵥ y | x ∈ s, y ∈ t}`."] -protected def has_scalar : has_scalar (finset α) (finset β) := ⟨image₂ (•)⟩ +protected def has_smul : has_smul (finset α) (finset β) := ⟨image₂ (•)⟩ -localized "attribute [instance] finset.has_scalar finset.has_vadd" in pointwise +localized "attribute [instance] finset.has_smul finset.has_vadd" in pointwise -@[to_additive] lemma smul_def : s • t = (s.product t).image (λ p : α × β, p.1 • p.2) := rfl +@[to_additive] lemma smul_def : s • t = (s ×ˢ t).image (λ p : α × β, p.1 • p.2) := rfl @[to_additive] -lemma image_smul_product : (s.product t).image (λ x : α × β, x.fst • x.snd) = s • t := rfl +lemma image_smul_product : (s ×ˢ t).image (λ x : α × β, x.fst • x.snd) = s • t := rfl @[to_additive] lemma mem_smul {x : β} : x ∈ s • t ↔ ∃ y z, y ∈ s ∧ z ∈ t ∧ y • z = x := mem_image₂ @@ -474,11 +701,9 @@ image₂_nonempty_iff nonempty.of_image₂_left @[to_additive] lemma nonempty.of_smul_right : (s • t).nonempty → t.nonempty := nonempty.of_image₂_right -@[simp, to_additive] lemma smul_singleton (b : β) : s • ({b} : finset β) = s.image (• b) := +@[to_additive] lemma smul_singleton (b : β) : s • ({b} : finset β) = s.image (• b) := image₂_singleton_right -@[simp, to_additive] lemma singleton_smul (a : α) : ({a} : finset α) • t = t.image ((•) a) := -image₂_singleton_left -@[simp, to_additive] lemma singleton_smul_singleton (a : α) (b : β) : +@[to_additive] lemma singleton_smul_singleton (a : α) (b : β) : ({a} : finset α) • ({b} : finset β) = {a • b} := image₂_singleton @@ -496,6 +721,12 @@ image₂_union_left image₂_inter_subset_left @[to_additive] lemma smul_inter_subset : s • (t₁ ∩ t₂) ⊆ s • t₁ ∩ s • t₂ := image₂_inter_subset_right +@[to_additive] lemma inter_smul_union_subset_union [decidable_eq α] : + (s₁ ∩ s₂) • (t₁ ∪ t₂) ⊆ (s₁ • t₁) ∪ (s₂ • t₂) := +image₂_inter_union_subset_union +@[to_additive] lemma union_smul_inter_subset_union [decidable_eq α] : + (s₁ ∪ s₂) • (t₁ ∩ t₂) ⊆ (s₁ • t₁) ∪ (s₂ • t₂) := +image₂_union_inter_subset_union /-- If a finset `u` is contained in the scalar product of two sets `s • t`, we can find two finsets `s'`, `t'` such that `s' ⊆ s`, `t' ⊆ t` and `u ⊆ s' • t'`. -/ @@ -505,9 +736,9 @@ lemma subset_smul {s : set α} {t : set β} : ↑u ⊆ s • t → ∃ (s' : finset α) (t' : finset β), ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' • t' := subset_image₂ -end has_scalar +end has_smul -/-! ### Finset addition/multiplication -/ +/-! ### Scalar subtraction of finsets -/ section has_vsub variables [decidable_eq α] [has_vsub α β] {s s₁ s₂ t t₁ t₂ : finset β} {u : finset α} {a : α} @@ -540,8 +771,7 @@ lemma nonempty.of_vsub_left : (s -ᵥ t : finset α).nonempty → s.nonempty := lemma nonempty.of_vsub_right : (s -ᵥ t : finset α).nonempty → t.nonempty := nonempty.of_image₂_right @[simp] lemma vsub_singleton (b : β) : s -ᵥ ({b} : finset β) = s.image (-ᵥ b) := image₂_singleton_right -@[simp] lemma singleton_vsub (a : β) : ({a} : finset β) -ᵥ t = t.image ((-ᵥ) a) := -image₂_singleton_left +lemma singleton_vsub (a : β) : ({a} : finset β) -ᵥ t = t.image ((-ᵥ) a) := image₂_singleton_left @[simp] lemma singleton_vsub_singleton (a b : β) : ({a} : finset β) -ᵥ {b} = {a -ᵥ b} := image₂_singleton @@ -572,15 +802,15 @@ open_locale pointwise /-! ### Translation/scaling of finsets -/ -section has_scalar -variables [decidable_eq β] [has_scalar α β] {s s₁ s₂ t u : finset β} {a : α} {b : β} +section has_smul +variables [decidable_eq β] [has_smul α β] {s s₁ s₂ t u : finset β} {a : α} {b : β} /-- The scaling of a finset `s` by a scalar `a`: `a • s = {a • x | x ∈ s}`. -/ -@[to_additive has_vadd_finset "The translation of a finset `s` by a vector `a`: +@[to_additive "The translation of a finset `s` by a vector `a`: `a +ᵥ s = {a +ᵥ x | x ∈ s}`."] -protected def has_scalar_finset : has_scalar α (finset β) := ⟨λ a, image $ (•) a⟩ +protected def has_smul_finset : has_smul α (finset β) := ⟨λ a, image $ (•) a⟩ -localized "attribute [instance] finset.has_scalar_finset finset.has_vadd_finset" in pointwise +localized "attribute [instance] finset.has_smul_finset finset.has_vadd_finset" in pointwise @[to_additive] lemma smul_finset_def : a • s = s.image ((•) a) := rfl @[to_additive] lemma image_smul : s.image (λ x, a • x) = a • s := rfl @@ -590,9 +820,9 @@ lemma mem_smul_finset {x : β} : x ∈ a • s ↔ ∃ y, y ∈ s ∧ a • y = by simp only [finset.smul_finset_def, and.assoc, mem_image, exists_prop, prod.exists, mem_product] @[simp, norm_cast, to_additive] -lemma coe_smul_finset (s : finset β) : (↑(a • s) : set β) = a • s := coe_image +lemma coe_smul_finset (a : α) (s : finset β) : (↑(a • s) : set β) = a • s := coe_image -@[to_additive] lemma smul_finset_mem_smul_finset : b ∈ s → a • b ∈ a • s := mem_image_of_mem _ +@[to_additive] lemma smul_mem_smul_finset : b ∈ s → a • b ∈ a • s := mem_image_of_mem _ @[to_additive] lemma smul_finset_card_le : (a • s).card ≤ s.card := card_image_le @[simp, to_additive] lemma smul_finset_empty (a : α) : a • (∅ : finset β) = ∅ := image_empty _ @@ -600,11 +830,13 @@ lemma coe_smul_finset (s : finset β) : (↑(a • s) : set β) = a • s := coe @[simp, to_additive] lemma smul_finset_nonempty : (a • s).nonempty ↔ s.nonempty := nonempty.image_iff _ @[to_additive] lemma nonempty.smul_finset (hs : s.nonempty) : (a • s).nonempty := hs.image _ +@[simp, to_additive] lemma singleton_smul (a : α) : ({a} : finset α) • t = a • t := +image₂_singleton_left @[to_additive, mono] lemma smul_finset_subset_smul_finset : s ⊆ t → a • s ⊆ a • t := image_subset_image -attribute [mono] add_subset_add +attribute [mono] vadd_finset_subset_vadd_finset @[simp, to_additive] lemma smul_finset_singleton (b : β) : a • ({b} : finset β) = {a • b} := image_singleton _ _ @@ -613,7 +845,14 @@ lemma smul_finset_singleton (b : β) : a • ({b} : finset β) = {a • b} := im @[to_additive] lemma smul_finset_inter_subset : a • (s₁ ∩ s₂) ⊆ a • s₁ ∩ (a • s₂) := image_inter_subset _ _ _ -end has_scalar +@[to_additive] lemma smul_finset_subset_smul {s : finset α} : a ∈ s → a • t ⊆ s • t := +image_subset_image₂_right + +@[simp, to_additive] lemma bUnion_smul_finset (s : finset α) (t : finset β) : + s.bUnion (• t) = s • t := +bUnion_image_left + +end has_smul open_locale pointwise @@ -621,40 +860,412 @@ section instances variables [decidable_eq γ] @[to_additive] -instance smul_comm_class_set [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] : +instance smul_comm_class_finset [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] : + smul_comm_class α β (finset γ) := +⟨λ _ _, commute.finset_image $ smul_comm _ _⟩ + +@[to_additive] +instance smul_comm_class_finset' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] : smul_comm_class α (finset β) (finset γ) := ⟨λ a s t, coe_injective $ by simp only [coe_smul_finset, coe_smul, smul_comm]⟩ @[to_additive] -instance smul_comm_class_set' [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] : +instance smul_comm_class_finset'' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] : smul_comm_class (finset α) β (finset γ) := by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _ @[to_additive] -instance smul_comm_class [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] : +instance smul_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] : smul_comm_class (finset α) (finset β) (finset γ) := ⟨λ s t u, coe_injective $ by simp_rw [coe_smul, smul_comm]⟩ -instance is_scalar_tower [has_scalar α β] [has_scalar α γ] [has_scalar β γ] - [is_scalar_tower α β γ] : +@[to_additive] +instance is_scalar_tower [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] : is_scalar_tower α β (finset γ) := ⟨λ a b s, by simp only [←image_smul, image_image, smul_assoc]⟩ variables [decidable_eq β] -instance is_scalar_tower' [has_scalar α β] [has_scalar α γ] [has_scalar β γ] - [is_scalar_tower α β γ] : +@[to_additive] +instance is_scalar_tower' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] : is_scalar_tower α (finset β) (finset γ) := ⟨λ a s t, coe_injective $ by simp only [coe_smul_finset, coe_smul, smul_assoc]⟩ -instance is_scalar_tower'' [has_scalar α β] [has_scalar α γ] [has_scalar β γ] - [is_scalar_tower α β γ] : +@[to_additive] +instance is_scalar_tower'' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] : is_scalar_tower (finset α) (finset β) (finset γ) := ⟨λ a s t, coe_injective $ by simp only [coe_smul_finset, coe_smul, smul_assoc]⟩ -instance is_central_scalar [has_scalar α β] [has_scalar αᵐᵒᵖ β] [is_central_scalar α β] : +@[to_additive] +instance is_central_scalar [has_smul α β] [has_smul αᵐᵒᵖ β] [is_central_scalar α β] : is_central_scalar α (finset β) := ⟨λ a s, coe_injective $ by simp only [coe_smul_finset, coe_smul, op_smul_eq_smul]⟩ +/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of +`finset α` on `finset β`. -/ +@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action +of `finset α` on `finset β`"] +protected def mul_action [decidable_eq α] [monoid α] [mul_action α β] : + mul_action (finset α) (finset β) := +{ mul_smul := λ _ _ _, image₂_assoc mul_smul, + one_smul := λ s, image₂_singleton_left.trans $ by simp_rw [one_smul, image_id'] } + +/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `finset β`. +-/ +@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action +on `finset β`."] +protected def mul_action_finset [monoid α] [mul_action α β] : mul_action α (finset β) := +coe_injective.mul_action _ coe_smul_finset + +localized "attribute [instance] finset.mul_action_finset finset.add_action_finset + finset.mul_action finset.add_action" in pointwise + +/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive +multiplicative action on `finset β`. -/ +protected def distrib_mul_action_finset [monoid α] [add_monoid β] [distrib_mul_action α β] : + distrib_mul_action α (finset β) := +function.injective.distrib_mul_action ⟨coe, coe_zero, coe_add⟩ coe_injective coe_smul_finset + +/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/ +protected def mul_distrib_mul_action_finset [monoid α] [monoid β] [mul_distrib_mul_action α β] : + mul_distrib_mul_action α (finset β) := +function.injective.mul_distrib_mul_action ⟨coe, coe_one, coe_mul⟩ coe_injective coe_smul_finset + +localized "attribute [instance] finset.distrib_mul_action_finset + finset.mul_distrib_mul_action_finset" in pointwise + +instance [decidable_eq α] [has_zero α] [has_mul α] [no_zero_divisors α] : + no_zero_divisors (finset α) := +coe_injective.no_zero_divisors _ coe_zero coe_mul + +instance [has_zero α] [has_zero β] [has_smul α β] [no_zero_smul_divisors α β] : + no_zero_smul_divisors (finset α) (finset β) := +⟨λ s t h, begin + by_contra' H, + have hst : (s • t).nonempty := h.symm.subst zero_nonempty, + simp_rw [←hst.of_smul_left.subset_zero_iff, ←hst.of_smul_right.subset_zero_iff, not_subset, + mem_zero] at H, + obtain ⟨⟨a, hs, ha⟩, b, ht, hb⟩ := H, + have := subset_of_eq h, + exact (eq_zero_or_eq_zero_of_smul_eq_zero $ mem_zero.1 $ this $ smul_mem_smul hs ht).elim ha hb, +end⟩ + +instance no_zero_smul_divisors_finset [has_zero α] [has_zero β] [has_smul α β] + [no_zero_smul_divisors α β] : no_zero_smul_divisors α (finset β) := +coe_injective.no_zero_smul_divisors _ coe_zero coe_smul_finset + end instances + +section has_smul +variables [decidable_eq β] [decidable_eq γ] [has_smul αᵐᵒᵖ β] [has_smul β γ] [has_smul α γ] + +-- TODO: replace hypothesis and conclusion with a typeclass +@[to_additive] lemma op_smul_finset_smul_eq_smul_smul_finset (a : α) (s : finset β) (t : finset γ) + (h : ∀ (a : α) (b : β) (c : γ), (op a • b) • c = b • a • c) : + (op a • s) • t = s • a • t := +by { ext, simp [mem_smul, mem_smul_finset, h] } + +end has_smul + +section has_mul +variables [has_mul α] [decidable_eq α] {s t u : finset α} {a : α} + +@[to_additive] lemma op_smul_finset_subset_mul : a ∈ t → op a • s ⊆ s * t := +image_subset_image₂_left + +@[simp, to_additive] lemma bUnion_op_smul_finset (s t : finset α) : + t.bUnion (λ a, op a • s) = s * t := +bUnion_image_right + +@[to_additive] lemma mul_subset_iff_left : s * t ⊆ u ↔ ∀ a ∈ s, a • t ⊆ u := image₂_subset_iff_left +@[to_additive] lemma mul_subset_iff_right : s * t ⊆ u ↔ ∀ b ∈ t, op b • s ⊆ u := +image₂_subset_iff_right + +end has_mul + +section semigroup +variables [semigroup α] [decidable_eq α] + +@[to_additive] lemma op_smul_finset_mul_eq_mul_smul_finset (a : α) (s : finset α) (t : finset α) : + (op a • s) * t = s * a • t := +op_smul_finset_smul_eq_smul_smul_finset _ _ _ $ λ _ _ _, mul_assoc _ _ _ + +end semigroup + +section left_cancel_semigroup +variables [left_cancel_semigroup α] [decidable_eq α] (s t : finset α) (a : α) + +@[to_additive] lemma pairwise_disjoint_smul_iff {s : set α} {t : finset α} : + s.pairwise_disjoint (• t) ↔ (s ×ˢ t : set (α × α)).inj_on (λ p, p.1 * p.2) := +by simp_rw [←pairwise_disjoint_coe, coe_smul_finset, set.pairwise_disjoint_smul_iff] + +@[simp, to_additive] lemma card_singleton_mul : ({a} * t).card = t.card := +card_image₂_singleton_left _ $ mul_right_injective _ + +@[to_additive] lemma singleton_mul_inter : {a} * (s ∩ t) = ({a} * s) ∩ ({a} * t) := +image₂_singleton_inter _ _ $ mul_right_injective _ + +@[to_additive] lemma card_le_card_mul_left {s : finset α} (hs : s.nonempty) : + t.card ≤ (s * t).card := +card_le_card_image₂_left _ hs mul_right_injective + +end left_cancel_semigroup + +section +variables [right_cancel_semigroup α] [decidable_eq α] (s t : finset α) (a : α) + +@[simp, to_additive] lemma card_mul_singleton : (s * {a}).card = s.card := +card_image₂_singleton_right _ $ mul_left_injective _ + +@[to_additive] lemma inter_mul_singleton : (s ∩ t) * {a} = (s * {a}) ∩ (t * {a}) := +image₂_inter_singleton _ _ $ mul_left_injective _ + +@[to_additive] lemma card_le_card_mul_right {t : finset α} (ht : t.nonempty) : + s.card ≤ (s * t).card := +card_le_card_image₂_right _ ht mul_left_injective + +end + +open_locale pointwise + +@[to_additive] lemma image_smul_comm [decidable_eq β] [decidable_eq γ] [has_smul α β] [has_smul α γ] + (f : β → γ) (a : α) (s : finset β) : + (∀ b, f (a • b) = a • f b) → (a • s).image f = a • s.image f := +image_comm + +@[to_additive] lemma image_smul_distrib [decidable_eq α] [decidable_eq β] [monoid α] [monoid β] + [monoid_hom_class F α β] (f : F) (a : α) (s : finset α) : + (a • s).image f = f a • s.image f := +image_comm $ map_mul _ _ + +section group +variables [decidable_eq β] [group α] [mul_action α β] {s t : finset β} {a : α} {b : β} + +@[simp, to_additive] lemma smul_mem_smul_finset_iff (a : α) : a • b ∈ a • s ↔ b ∈ s := +(mul_action.injective _).mem_finset_image + +@[to_additive] lemma inv_smul_mem_iff : a⁻¹ • b ∈ s ↔ b ∈ a • s := +by rw [←smul_mem_smul_finset_iff a, smul_inv_smul] + +@[to_additive] lemma mem_inv_smul_finset_iff : b ∈ a⁻¹ • s ↔ a • b ∈ s := +by rw [←smul_mem_smul_finset_iff a, smul_inv_smul] + +@[simp, to_additive] lemma smul_finset_subset_smul_finset_iff : a • s ⊆ a • t ↔ s ⊆ t := +image_subset_image_iff $ mul_action.injective _ + +@[to_additive] lemma smul_finset_subset_iff : a • s ⊆ t ↔ s ⊆ a⁻¹ • t := +by { simp_rw ←coe_subset, push_cast, exact set.set_smul_subset_iff } + +@[to_additive] lemma subset_smul_finset_iff : s ⊆ a • t ↔ a⁻¹ • s ⊆ t := +by { simp_rw ←coe_subset, push_cast, exact set.subset_set_smul_iff } + +@[to_additive] lemma smul_finset_inter : a • (s ∩ t) = a • s ∩ a • t := +image_inter _ _ $ mul_action.injective a + +@[to_additive] lemma smul_finset_sdiff : a • (s \ t) = a • s \ a • t := +image_sdiff _ _ $ mul_action.injective a + +@[to_additive] lemma smul_finset_symm_diff : a • (s ∆ t) = (a • s) ∆ (a • t) := +image_symm_diff _ _ $ mul_action.injective a + +@[simp, to_additive] lemma smul_finset_univ [fintype β] : a • (univ : finset β) = univ := +image_univ_of_surjective $ mul_action.surjective a + +@[simp, to_additive] lemma smul_univ [fintype β] {s : finset α} (hs : s.nonempty) : + s • (univ : finset β) = univ := +coe_injective $ by { push_cast, exact set.smul_univ hs } + +@[simp, to_additive] lemma card_smul_finset (a : α) (s : finset β) : (a • s).card = s.card := +card_image_of_injective _ $ mul_action.injective _ + +/-- If the left cosets of `t` by elements of `s` are disjoint (but not necessarily distinct!), then +the size of `t` divides the size of `s * t`. -/ +@[to_additive "If the left cosets of `t` by elements of `s` are disjoint (but not necessarily +distinct!), then the size of `t` divides the size of `s + t`."] +lemma card_dvd_card_smul_right {s : finset α} : + ((• t) '' (s : set α)).pairwise_disjoint id → t.card ∣ (s • t).card := +card_dvd_card_image₂_right (λ _ _, mul_action.injective _) + +variables [decidable_eq α] + +/-- If the right cosets of `s` by elements of `t` are disjoint (but not necessarily distinct!), then +the size of `s` divides the size of `s * t`. -/ +@[to_additive "If the right cosets of `s` by elements of `t` are disjoint (but not necessarily +distinct!), then the size of `s` divides the size of `s + t`."] +lemma card_dvd_card_mul_left {s t : finset α} : + ((λ b, s.image $ λ a, a * b) '' (t : set α)).pairwise_disjoint id → s.card ∣ (s * t).card := +card_dvd_card_image₂_left (λ _ _, mul_left_injective _) + +end group + +section group_with_zero +variables [decidable_eq β] [group_with_zero α] [mul_action α β] {s t : finset β} {a : α} {b : β} + +@[simp] lemma smul_mem_smul_finset_iff₀ (ha : a ≠ 0) : a • b ∈ a • s ↔ b ∈ s := +smul_mem_smul_finset_iff (units.mk0 a ha) + +lemma inv_smul_mem_iff₀ (ha : a ≠ 0) : a⁻¹ • b ∈ s ↔ b ∈ a • s := +show _ ↔ _ ∈ units.mk0 a ha • _, from inv_smul_mem_iff + +lemma mem_inv_smul_finset_iff₀ (ha : a ≠ 0) : b ∈ a⁻¹ • s ↔ a • b ∈ s := +show _ ∈ (units.mk0 a ha)⁻¹ • _ ↔ _, from mem_inv_smul_finset_iff + +@[simp] lemma smul_finset_subset_smul_finset_iff₀ (ha : a ≠ 0) : a • s ⊆ a • t ↔ s ⊆ t := +show units.mk0 a ha • _ ⊆ _ ↔ _, from smul_finset_subset_smul_finset_iff + +lemma smul_finset_subset_iff₀ (ha : a ≠ 0) : a • s ⊆ t ↔ s ⊆ a⁻¹ • t := +show units.mk0 a ha • _ ⊆ _ ↔ _, from smul_finset_subset_iff + +lemma subset_smul_finset_iff₀ (ha : a ≠ 0) : s ⊆ a • t ↔ a⁻¹ • s ⊆ t := +show _ ⊆ units.mk0 a ha • _ ↔ _, from subset_smul_finset_iff + +lemma smul_finset_inter₀ (ha : a ≠ 0) : a • (s ∩ t) = a • s ∩ a • t := +image_inter _ _ $ mul_action.injective₀ ha + +lemma smul_finset_sdiff₀ (ha : a ≠ 0) : a • (s \ t) = a • s \ a • t := +image_sdiff _ _ $ mul_action.injective₀ ha + +lemma smul_finset_symm_diff₀ (ha : a ≠ 0) : a • (s ∆ t) = (a • s) ∆ (a • t) := +image_symm_diff _ _ $ mul_action.injective₀ ha + +lemma smul_univ₀ [fintype β] {s : finset α} (hs : ¬ s ⊆ 0) : s • (univ : finset β) = univ := +coe_injective $ by { rw ←coe_subset at hs, push_cast at ⊢ hs, exact set.smul_univ₀ hs } + +lemma smul_finset_univ₀ [fintype β] (ha : a ≠ 0) : a • (univ : finset β) = univ := +coe_injective $ by { push_cast, exact set.smul_set_univ₀ ha } + +end group_with_zero + +section smul_with_zero +variables [has_zero α] [has_zero β] [smul_with_zero α β] [decidable_eq β] {s : finset α} + {t : finset β} + +/-! +Note that we have neither `smul_with_zero α (finset β)` nor `smul_with_zero (finset α) (finset β)` +because `0 * ∅ ≠ 0`. +-/ + +lemma smul_zero_subset (s : finset α) : s • (0 : finset β) ⊆ 0 := by simp [subset_iff, mem_smul] +lemma zero_smul_subset (t : finset β) : (0 : finset α) • t ⊆ 0 := by simp [subset_iff, mem_smul] + +lemma nonempty.smul_zero (hs : s.nonempty) : s • (0 : finset β) = 0 := +s.smul_zero_subset.antisymm $ by simpa [mem_smul] using hs + +lemma nonempty.zero_smul (ht : t.nonempty) : (0 : finset α) • t = 0 := +t.zero_smul_subset.antisymm $ by simpa [mem_smul] using ht + +/-- A nonempty set is scaled by zero to the singleton set containing 0. -/ +lemma zero_smul_finset {s : finset β} (h : s.nonempty) : (0 : α) • s = (0 : finset β) := +coe_injective $ by simpa using @set.zero_smul_set α _ _ _ _ _ h + +lemma zero_smul_finset_subset (s : finset β) : (0 : α) • s ⊆ 0 := +image_subset_iff.2 $ λ x _, mem_zero.2 $ zero_smul α x + +lemma zero_mem_smul_finset {t : finset β} {a : α} (h : (0 : β) ∈ t) : (0 : β) ∈ a • t := +mem_smul_finset.2 ⟨0, h, smul_zero _⟩ + +variables [no_zero_smul_divisors α β] {a : α} + +lemma zero_mem_smul_iff : (0 : β) ∈ s • t ↔ (0 : α) ∈ s ∧ t.nonempty ∨ (0 : β) ∈ t ∧ s.nonempty := +by { rw [←mem_coe, coe_smul, set.zero_mem_smul_iff], refl } + +lemma zero_mem_smul_finset_iff (ha : a ≠ 0) : (0 : β) ∈ a • t ↔ (0 : β) ∈ t := +by { rw [←mem_coe, coe_smul_finset, set.zero_mem_smul_set_iff ha, mem_coe], apply_instance } + +end smul_with_zero + +section monoid +variables [monoid α] [add_group β] [distrib_mul_action α β] [decidable_eq β] (a : α) (s : finset α) + (t : finset β) + +@[simp] lemma smul_finset_neg : a • -t = -(a • t) := +by simp only [←image_smul, ←image_neg, function.comp, image_image, smul_neg] + +@[simp] protected lemma smul_neg : s • -t = -(s • t) := +by { simp_rw ←image_neg, exact image_image₂_right_comm smul_neg } + +end monoid + +section ring +variables [ring α] [add_comm_group β] [module α β] [decidable_eq β] {s : finset α} {t : finset β} + {a : α} + +@[simp] lemma neg_smul_finset : -a • t = -(a • t) := +by simp only [←image_smul, ←image_neg, image_image, neg_smul] + +@[simp] protected lemma neg_smul [decidable_eq α] : -s • t = -(s • t) := +by { simp_rw ←image_neg, exact image₂_image_left_comm neg_smul } + +end ring end finset + +open_locale pointwise + +namespace set +section has_one +variables [has_one α] + +@[simp, to_additive] lemma to_finset_one : (1 : set α).to_finset = 1 := rfl + +@[simp, to_additive] +lemma finite.to_finset_one (h : (1 : set α).finite := finite_one) : h.to_finset = 1 := +finite.to_finset_singleton _ + +end has_one + +section has_mul +variables [decidable_eq α] [has_mul α] {s t : set α} + +@[simp, to_additive] lemma to_finset_mul (s t : set α) [fintype s] [fintype t] [fintype ↥(s * t)] : + (s * t).to_finset = s.to_finset * t.to_finset := +to_finset_image2 _ _ _ + +@[to_additive] lemma finite.to_finset_mul (hs : s.finite) (ht : t.finite) (hf := hs.mul ht) : + hf.to_finset = hs.to_finset * ht.to_finset := +finite.to_finset_image2 _ _ _ + +end has_mul + +section has_smul +variables [has_smul α β] [decidable_eq β] {a : α} {s : set α} {t : set β} + +@[simp, to_additive] +lemma to_finset_smul (s : set α) (t : set β) [fintype s] [fintype t] [fintype ↥(s • t)] : + (s • t).to_finset = s.to_finset • t.to_finset := +to_finset_image2 _ _ _ + +@[to_additive] lemma finite.to_finset_smul (hs : s.finite) (ht : t.finite) (hf := hs.smul ht) : + hf.to_finset = hs.to_finset • ht.to_finset := +finite.to_finset_image2 _ _ _ + +end has_smul + +section has_smul +variables [decidable_eq β] [has_smul α β] {a : α} {s : set β} + +@[simp, to_additive] +lemma to_finset_smul_set (a : α) (s : set β) [fintype s] [fintype ↥(a • s)] : + (a • s).to_finset = a • s.to_finset := +to_finset_image _ _ + +@[to_additive] +lemma finite.to_finset_smul_set (hs : s.finite) (hf : (a • s).finite := hs.smul_set) : + hf.to_finset = a • hs.to_finset := +finite.to_finset_image _ _ _ + +end has_smul + +section has_vsub +variables [decidable_eq α] [has_vsub α β] {s t : set β} +include α + +@[simp] lemma to_finset_vsub (s t : set β) [fintype s] [fintype t] [fintype ↥(s -ᵥ t)] : + (s -ᵥ t : set α).to_finset = s.to_finset -ᵥ t.to_finset := +to_finset_image2 _ _ _ + +lemma finite.to_finset_vsub (hs : s.finite) (ht : t.finite) (hf := hs.vsub ht) : + hf.to_finset = hs.to_finset -ᵥ ht.to_finset := +finite.to_finset_image2 _ _ _ + +end has_vsub +end set diff --git a/src/data/finset/powerset.lean b/src/data/finset/powerset.lean index c9e0dc9e24a8c..adeeb63e6f1c4 100644 --- a/src/data/finset/powerset.lean +++ b/src/data/finset/powerset.lean @@ -4,15 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import data.finset.lattice +import data.multiset.powerset /-! # The powerset of a finset + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace finset -open multiset +open function multiset -variables {α : Type*} +variables {α : Type*} {s t : finset α} /-! ### powerset -/ section powerset @@ -26,18 +30,31 @@ def powerset (s : finset α) : finset (finset α) := by cases s; simp only [powerset, mem_mk, mem_pmap, mem_powerset, exists_prop, exists_eq_right]; rw ← val_le_iff +@[simp, norm_cast] lemma coe_powerset (s : finset α) : + (s.powerset : set (finset α)) = coe ⁻¹' (s : set α).powerset := +by { ext, simp } + @[simp] theorem empty_mem_powerset (s : finset α) : ∅ ∈ powerset s := mem_powerset.2 (empty_subset _) -@[simp] theorem mem_powerset_self (s : finset α) : s ∈ powerset s := -mem_powerset.2 (subset.refl _) +@[simp] lemma mem_powerset_self (s : finset α) : s ∈ powerset s := mem_powerset.2 subset.rfl -@[simp] lemma powerset_empty : finset.powerset (∅ : finset α) = {∅} := rfl +lemma powerset_nonempty (s : finset α) : s.powerset.nonempty := ⟨∅, empty_mem_powerset _⟩ @[simp] theorem powerset_mono {s t : finset α} : powerset s ⊆ powerset t ↔ s ⊆ t := ⟨λ h, (mem_powerset.1 $ h $ mem_powerset_self _), λ st u h, mem_powerset.2 $ subset.trans (mem_powerset.1 h) st⟩ +lemma powerset_injective : injective (powerset : finset α → finset (finset α)) := +injective_of_le_imp_le _ $ λ s t, powerset_mono.1 + +@[simp] lemma powerset_inj : powerset s = powerset t ↔ s = t := powerset_injective.eq_iff + +@[simp] lemma powerset_empty : (∅ : finset α).powerset = {∅} := rfl + +@[simp] lemma powerset_eq_singleton_empty : s.powerset = {∅} ↔ s = ∅ := +by rw [←powerset_empty, powerset_inj] + /-- **Number of Subsets of a Set** -/ @[simp] theorem card_powerset (s : finset α) : card (powerset s) = 2 ^ card s := @@ -182,15 +199,17 @@ begin simp [card_insert_of_not_mem this, nat.succ_inj'] end -lemma powerset_len_nonempty {n : ℕ} {s : finset α} (h : n < s.card) : +lemma powerset_len_nonempty {n : ℕ} {s : finset α} (h : n ≤ s.card) : (powerset_len n s).nonempty := begin classical, induction s using finset.induction_on with x s hx IH generalizing n, - { simpa using h }, + { rw [card_empty, le_zero_iff] at h, + rw [h, powerset_len_zero], + exact finset.singleton_nonempty _, }, { cases n, { simp }, - { rw [card_insert_of_not_mem hx, nat.succ_lt_succ_iff] at h, + { rw [card_insert_of_not_mem hx, nat.succ_le_succ_iff] at h, rw powerset_len_succ_insert hx, refine nonempty.mono _ ((IH h).image (insert x)), convert (subset_union_right _ _) } } @@ -207,22 +226,33 @@ begin simp } end -lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) : - finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) := +lemma pairwise_disjoint_powerset_len (s : finset α) : + _root_.pairwise (λ i j, disjoint (s.powerset_len i) (s.powerset_len j)) := +λ i j hij, finset.disjoint_left.mpr $ λ x hi hj, hij $ + (mem_powerset_len.mp hi).2.symm.trans (mem_powerset_len.mp hj).2 + +lemma powerset_card_disj_Union (s : finset α) : + finset.powerset s = + (range (s.card + 1)).disj_Union (λ i, powerset_len i s) + (s.pairwise_disjoint_powerset_len.set_pairwise _) := begin refine ext (λ a, ⟨λ ha, _, λ ha, _ ⟩), - { rw mem_bUnion, + { rw mem_disj_Union, exact ⟨a.card, mem_range.mpr (nat.lt_succ_of_le (card_le_of_subset (mem_powerset.mp ha))), mem_powerset_len.mpr ⟨mem_powerset.mp ha, rfl⟩⟩ }, - { rcases mem_bUnion.mp ha with ⟨i, hi, ha⟩, + { rcases mem_disj_Union.mp ha with ⟨i, hi, ha⟩, exact mem_powerset.mpr (mem_powerset_len.mp ha).1, } end +lemma powerset_card_bUnion [decidable_eq (finset α)] (s : finset α) : + finset.powerset s = (range (s.card + 1)).bUnion (λ i, powerset_len i s) := +by simpa only [disj_Union_eq_bUnion] using powerset_card_disj_Union s + lemma powerset_len_sup [decidable_eq α] (u : finset α) (n : ℕ) (hn : n < u.card) : (powerset_len n.succ u).sup id = u := begin apply le_antisymm, - { simp_rw [sup_le_iff, mem_powerset_len], + { simp_rw [finset.sup_le_iff, mem_powerset_len], rintros x ⟨h, -⟩, exact h }, { rw [sup_eq_bUnion, le_iff_subset, subset_iff], @@ -234,7 +264,8 @@ begin { refine ⟨insert x t, _, mem_insert_self _ _⟩, rw [←insert_erase hx, powerset_len_succ_insert (not_mem_erase _ _)], exact mem_union_right _ (mem_image_of_mem _ ht) }, - { rwa [card_erase_of_mem hx, lt_tsub_iff_right] } } } + { rw [card_erase_of_mem hx], + exact nat.le_pred_of_lt hn, } } } end @[simp] @@ -246,5 +277,12 @@ finset.powerset_len_empty _ (lt_add_of_pos_right (finset.card s) hi) (s.powerset_len i).val.map finset.val = s.1.powerset_len i := by simp [finset.powerset_len, map_pmap, pmap_eq_map, map_id'] +theorem powerset_len_map {β : Type*} (f : α ↪ β) (n : ℕ) (s : finset α) : + powerset_len n (s.map f) = (powerset_len n s).map (map_embedding f).to_embedding := +eq_of_veq $ multiset.map_injective (@eq_of_veq _) $ + by simp_rw [map_val_val_powerset_len, map_val, multiset.map_map, function.comp, + rel_embedding.coe_fn_to_embedding, map_embedding_apply, map_val, ←multiset.map_map _ val, + map_val_val_powerset_len, multiset.powerset_len_map] + end powerset_len end finset diff --git a/src/data/finset/preimage.lean b/src/data/finset/preimage.lean index 18e70d447838e..afe69fac91482 100644 --- a/src/data/finset/preimage.lean +++ b/src/data/finset/preimage.lean @@ -8,6 +8,9 @@ import algebra.big_operators.basic /-! # Preimage of a `finset` under an injective map. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open set function @@ -58,6 +61,10 @@ finset.coe_injective (by simp) preimage sᶜ f (hf.inj_on _) = (preimage s f (hf.inj_on _))ᶜ := finset.coe_injective (by simp) +@[simp] lemma preimage_map (f : α ↪ β) (s : finset α) : + (s.map f).preimage f (f.injective.inj_on _) = s := +coe_injective $ by simp only [coe_preimage, coe_map, set.preimage_image_eq _ f.injective] + lemma monotone_preimage {f : α → β} (h : injective f) : monotone (λ s, preimage s f (h.inj_on _)) := λ s t hst x hx, mem_preimage.2 (hst $ mem_preimage.1 hx) diff --git a/src/data/finset/prod.lean b/src/data/finset/prod.lean index 9b4c075613496..278f9ac72858b 100644 --- a/src/data/finset/prod.lean +++ b/src/data/finset/prod.lean @@ -8,6 +8,9 @@ import data.finset.card /-! # Finsets in product types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines finset constructions on the product type `α × β`. Beware not to confuse with the `finset.prod` operation which computes the multiplicative product. @@ -33,55 +36,86 @@ variables {s s' : finset α} {t t' : finset β} {a : α} {b : β} /-- `product s t` is the set of pairs `(a, b)` such that `a ∈ s` and `b ∈ t`. -/ protected def product (s : finset α) (t : finset β) : finset (α × β) := ⟨_, s.nodup.product t.nodup⟩ -@[simp] lemma product_val : (s.product t).1 = s.1.product t.1 := rfl +/- This notation binds more strongly than (pre)images, unions and intersections. -/ +infixr (name := finset.product) ` ×ˢ `:82 := finset.product + +@[simp] lemma product_val : (s ×ˢ t).1 = s.1 ×ˢ t.1 := rfl -@[simp] lemma mem_product {p : α × β} : p ∈ s.product t ↔ p.1 ∈ s ∧ p.2 ∈ t := mem_product +@[simp] lemma mem_product {p : α × β} : p ∈ s ×ˢ t ↔ p.1 ∈ s ∧ p.2 ∈ t := mem_product -lemma mk_mem_product (ha : a ∈ s) (hb : b ∈ t) : (a, b) ∈ s.product t := mem_product.2 ⟨ha, hb⟩ +lemma mk_mem_product (ha : a ∈ s) (hb : b ∈ t) : (a, b) ∈ s ×ˢ t := mem_product.2 ⟨ha, hb⟩ @[simp, norm_cast] lemma coe_product (s : finset α) (t : finset β) : - (s.product t : set (α × β)) = (s : set α) ×ˢ (t : set β) := + (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := set.ext $ λ x, finset.mem_product +lemma subset_product_image_fst [decidable_eq α] : (s ×ˢ t).image prod.fst ⊆ s := +λ i, by simp [mem_image] {contextual := tt} + +lemma subset_product_image_snd [decidable_eq β] : (s ×ˢ t).image prod.snd ⊆ t := +λ i, by simp [mem_image] {contextual := tt} + +lemma product_image_fst [decidable_eq α] (ht : t.nonempty) : (s ×ˢ t).image prod.fst = s := +by { ext i, simp [mem_image, ht.bex] } + +lemma product_image_snd [decidable_eq β] (ht : s.nonempty) : (s ×ˢ t).image prod.snd = t := +by { ext i, simp [mem_image, ht.bex] } + lemma subset_product [decidable_eq α] [decidable_eq β] {s : finset (α × β)} : - s ⊆ (s.image prod.fst).product (s.image prod.snd) := + s ⊆ s.image prod.fst ×ˢ s.image prod.snd := λ p hp, mem_product.2 ⟨mem_image_of_mem _ hp, mem_image_of_mem _ hp⟩ -lemma product_subset_product (hs : s ⊆ s') (ht : t ⊆ t') : s.product t ⊆ s'.product t' := +lemma product_subset_product (hs : s ⊆ s') (ht : t ⊆ t') : s ×ˢ t ⊆ s' ×ˢ t' := λ ⟨x,y⟩ h, mem_product.2 ⟨hs (mem_product.1 h).1, ht (mem_product.1 h).2⟩ -lemma product_subset_product_left (hs : s ⊆ s') : s.product t ⊆ s'.product t := +lemma product_subset_product_left (hs : s ⊆ s') : s ×ˢ t ⊆ s' ×ˢ t := product_subset_product hs (subset.refl _) -lemma product_subset_product_right (ht : t ⊆ t') : s.product t ⊆ s.product t' := +lemma product_subset_product_right (ht : t ⊆ t') : s ×ˢ t ⊆ s ×ˢ t' := product_subset_product (subset.refl _) ht +lemma map_swap_product (s : finset α) (t : finset β) : + (t ×ˢ s).map ⟨prod.swap, prod.swap_injective⟩ = s ×ˢ t := +coe_injective $ by { push_cast, exact set.image_swap_prod _ _ } + +@[simp] lemma image_swap_product [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) : + (t ×ˢ s).image prod.swap = s ×ˢ t := +coe_injective $ by { push_cast, exact set.image_swap_prod _ _ } + lemma product_eq_bUnion [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) : - s.product t = s.bUnion (λa, t.image $ λb, (a, b)) := + s ×ˢ t = s.bUnion (λa, t.image $ λb, (a, b)) := ext $ λ ⟨x, y⟩, by simp only [mem_product, mem_bUnion, mem_image, exists_prop, prod.mk.inj_iff, and.left_comm, exists_and_distrib_left, exists_eq_right, exists_eq_left] lemma product_eq_bUnion_right [decidable_eq α] [decidable_eq β] (s : finset α) (t : finset β) : - s.product t = t.bUnion (λ b, s.image $ λ a, (a, b)) := + s ×ˢ t = t.bUnion (λ b, s.image $ λ a, (a, b)) := ext $ λ ⟨x, y⟩, by simp only [mem_product, mem_bUnion, mem_image, exists_prop, prod.mk.inj_iff, and.left_comm, exists_and_distrib_left, exists_eq_right, exists_eq_left] /-- See also `finset.sup_product_left`. -/ @[simp] lemma product_bUnion [decidable_eq γ] (s : finset α) (t : finset β) (f : α × β → finset γ) : - (s.product t).bUnion f = s.bUnion (λ a, t.bUnion (λ b, f (a, b))) := + (s ×ˢ t).bUnion f = s.bUnion (λ a, t.bUnion (λ b, f (a, b))) := by { classical, simp_rw [product_eq_bUnion, bUnion_bUnion, image_bUnion] } -@[simp] lemma card_product (s : finset α) (t : finset β) : card (s.product t) = card s * card t := +@[simp] lemma card_product (s : finset α) (t : finset β) : card (s ×ˢ t) = card s * card t := multiset.card_product _ _ lemma filter_product (p : α → Prop) (q : β → Prop) [decidable_pred p] [decidable_pred q] : - (s.product t).filter (λ (x : α × β), p x.1 ∧ q x.2) = (s.filter p).product (t.filter q) := + (s ×ˢ t).filter (λ (x : α × β), p x.1 ∧ q x.2) = s.filter p ×ˢ t.filter q := by { ext ⟨a, b⟩, simp only [mem_filter, mem_product], exact and_and_and_comm (a ∈ s) (b ∈ t) (p a) (q b) } +lemma filter_product_left (p : α → Prop) [decidable_pred p] : + (s ×ˢ t).filter (λ (x : α × β), p x.1) = s.filter p ×ˢ t := +by simpa using filter_product p (λ _, true) + +lemma filter_product_right (q : β → Prop) [decidable_pred q] : + (s ×ˢ t).filter (λ (x : α × β), q x.2) = s ×ˢ t.filter q := +by simpa using filter_product (λ _ : α, true) q + lemma filter_product_card (s : finset α) (t : finset β) (p : α → Prop) (q : β → Prop) [decidable_pred p] [decidable_pred q] : - ((s.product t).filter (λ (x : α × β), p x.1 ↔ q x.2)).card = + ((s ×ˢ t).filter (λ (x : α × β), p x.1 ↔ q x.2)).card = (s.filter p).card * (t.filter q).card + (s.filter (not ∘ p)).card * (t.filter (not ∘ q)).card := begin classical, @@ -90,73 +124,104 @@ begin split; intros h; use h.1, simp only [function.comp_app, and_self, h.2, em (q b)], cases h.2; { try { simp at h_1 }, simp [h_1] } }, - { rw disjoint_iff, change _ ∩ _ = ∅, ext ⟨a, b⟩, rw mem_inter, - simp only [and_imp, mem_filter, not_and, not_not, function.comp_app, iff_false, mem_product, - not_mem_empty], intros, assumption } + { apply finset.disjoint_filter_filter', + exact (disjoint_compl_right.inf_left _).inf_right _ } end -lemma empty_product (t : finset β) : (∅ : finset α).product t = ∅ := rfl +lemma empty_product (t : finset β) : (∅ : finset α) ×ˢ t = ∅ := rfl -lemma product_empty (s : finset α) : s.product (∅ : finset β) = ∅ := +lemma product_empty (s : finset α) : s ×ˢ (∅ : finset β) = ∅ := eq_empty_of_forall_not_mem (λ x h, (finset.mem_product.1 h).2) -lemma nonempty.product (hs : s.nonempty) (ht : t.nonempty) : (s.product t).nonempty := +lemma nonempty.product (hs : s.nonempty) (ht : t.nonempty) : (s ×ˢ t).nonempty := let ⟨x, hx⟩ := hs, ⟨y, hy⟩ := ht in ⟨(x, y), mem_product.2 ⟨hx, hy⟩⟩ -lemma nonempty.fst (h : (s.product t).nonempty) : s.nonempty := +lemma nonempty.fst (h : (s ×ˢ t).nonempty) : s.nonempty := let ⟨xy, hxy⟩ := h in ⟨xy.1, (mem_product.1 hxy).1⟩ -lemma nonempty.snd (h : (s.product t).nonempty) : t.nonempty := +lemma nonempty.snd (h : (s ×ˢ t).nonempty) : t.nonempty := let ⟨xy, hxy⟩ := h in ⟨xy.2, (mem_product.1 hxy).2⟩ -@[simp] lemma nonempty_product : (s.product t).nonempty ↔ s.nonempty ∧ t.nonempty := +@[simp] lemma nonempty_product : (s ×ˢ t).nonempty ↔ s.nonempty ∧ t.nonempty := ⟨λ h, ⟨h.fst, h.snd⟩, λ h, h.1.product h.2⟩ -@[simp] lemma product_eq_empty {s : finset α} {t : finset β} : s.product t = ∅ ↔ s = ∅ ∨ t = ∅ := +@[simp] lemma product_eq_empty {s : finset α} {t : finset β} : s ×ˢ t = ∅ ↔ s = ∅ ∨ t = ∅ := by rw [←not_nonempty_iff_eq_empty, nonempty_product, not_and_distrib, not_nonempty_iff_eq_empty, not_nonempty_iff_eq_empty] @[simp] lemma singleton_product {a : α} : - ({a} : finset α).product t = t.map ⟨prod.mk a, prod.mk.inj_left _⟩ := + ({a} : finset α) ×ˢ t = t.map ⟨prod.mk a, prod.mk.inj_left _⟩ := by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] } @[simp] lemma product_singleton {b : β} : - s.product {b} = s.map ⟨λ i, (i, b), prod.mk.inj_right _⟩ := + s ×ˢ {b} = s.map ⟨λ i, (i, b), prod.mk.inj_right _⟩ := by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] } lemma singleton_product_singleton {a : α} {b : β} : - ({a} : finset α).product ({b} : finset β) = {(a, b)} := + ({a} : finset α) ×ˢ ({b} : finset β) = {(a, b)} := by simp only [product_singleton, function.embedding.coe_fn_mk, map_singleton] @[simp] lemma union_product [decidable_eq α] [decidable_eq β] : - (s ∪ s').product t = s.product t ∪ s'.product t := + (s ∪ s') ×ˢ t = s ×ˢ t ∪ s' ×ˢ t := by { ext ⟨x, y⟩, simp only [or_and_distrib_right, mem_union, mem_product] } @[simp] lemma product_union [decidable_eq α] [decidable_eq β] : - s.product (t ∪ t') = s.product t ∪ s.product t' := + s ×ˢ (t ∪ t') = s ×ˢ t ∪ s ×ˢ t' := by { ext ⟨x, y⟩, simp only [and_or_distrib_left, mem_union, mem_product] } +lemma inter_product [decidable_eq α] [decidable_eq β] : + (s ∩ s') ×ˢ t = s ×ˢ t ∩ s' ×ˢ t := +by { ext ⟨x, y⟩, simp only [←and_and_distrib_right, mem_inter, mem_product] } + +lemma product_inter [decidable_eq α] [decidable_eq β] : + s ×ˢ (t ∩ t') = s ×ˢ t ∩ s ×ˢ t' := +by { ext ⟨x, y⟩, simp only [←and_and_distrib_left, mem_inter, mem_product] } + +lemma product_inter_product [decidable_eq α] [decidable_eq β] : + s ×ˢ t ∩ s' ×ˢ t' = (s ∩ s') ×ˢ (t ∩ t') := +by { ext ⟨x, y⟩, simp only [and_assoc, and.left_comm, mem_inter, mem_product] } + +lemma disjoint_product : disjoint (s ×ˢ t) (s' ×ˢ t') ↔ disjoint s s' ∨ disjoint t t' := +by simp_rw [←disjoint_coe, coe_product, set.disjoint_prod] + +@[simp] lemma disj_union_product (hs : disjoint s s') : + s.disj_union s' hs ×ˢ t = (s ×ˢ t).disj_union (s' ×ˢ t) + (disjoint_product.mpr $ or.inl hs) := +eq_of_veq $ multiset.add_product _ _ _ + +@[simp] lemma product_disj_union (ht : disjoint t t') : + s ×ˢ t.disj_union t' ht = (s ×ˢ t).disj_union (s ×ˢ t') + (disjoint_product.mpr $ or.inr ht) := +eq_of_veq $ multiset.product_add _ _ _ + end prod section diag -variables (s t : finset α) [decidable_eq α] +variables [decidable_eq α] (s t : finset α) /-- Given a finite set `s`, the diagonal, `s.diag` is the set of pairs of the form `(a, a)` for `a ∈ s`. -/ -def diag := (s.product s).filter (λ (a : α × α), a.fst = a.snd) +def diag := (s ×ˢ s).filter (λ a : α × α, a.fst = a.snd) /-- Given a finite set `s`, the off-diagonal, `s.off_diag` is the set of pairs `(a, b)` with `a ≠ b` for `a, b ∈ s`. -/ -def off_diag := (s.product s).filter (λ (a : α × α), a.fst ≠ a.snd) +def off_diag := (s ×ˢ s).filter (λ (a : α × α), a.fst ≠ a.snd) -@[simp] lemma mem_diag (x : α × α) : x ∈ s.diag ↔ x.1 ∈ s ∧ x.1 = x.2 := +variables {s} {x : α × α} + +@[simp] lemma mem_diag : x ∈ s.diag ↔ x.1 ∈ s ∧ x.1 = x.2 := by { simp only [diag, mem_filter, mem_product], split; intros h; simp only [h, and_true, eq_self_iff_true, and_self], rw ←h.2, exact h.1 } -@[simp] lemma mem_off_diag (x : α × α) : x ∈ s.off_diag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 := +@[simp] lemma mem_off_diag : x ∈ s.off_diag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 := by { simp only [off_diag, mem_filter, mem_product], split; intros h; simp only [h, ne.def, not_false_iff, and_self] } +variables (s) + +@[simp, norm_cast] lemma coe_off_diag : (s.off_diag : set (α × α)) = (s : set α).off_diag := +set.ext $ λ _, mem_off_diag + @[simp] lemma diag_card : (diag s).card = s.card := begin suffices : diag s = s.image (λ a, (a, a)), @@ -174,38 +239,43 @@ begin apply filter_card_add_filter_neg_card_eq_card, end +@[mono] lemma diag_mono : monotone (diag : finset α → finset (α × α)) := +λ s t h x hx, mem_diag.2 $ and.imp_left (@h _) $ mem_diag.1 hx + +@[mono] lemma off_diag_mono : monotone (off_diag : finset α → finset (α × α)) := +λ s t h x hx, mem_off_diag.2 $ and.imp (@h _) (and.imp_left $ @h _) $ mem_off_diag.1 hx + @[simp] lemma diag_empty : (∅ : finset α).diag = ∅ := rfl @[simp] lemma off_diag_empty : (∅ : finset α).off_diag = ∅ := rfl -@[simp] lemma diag_union_off_diag : s.diag ∪ s.off_diag = s.product s := +@[simp] lemma diag_union_off_diag : s.diag ∪ s.off_diag = s ×ˢ s := filter_union_filter_neg_eq _ _ -@[simp] lemma disjoint_diag_off_diag : disjoint s.diag s.off_diag := disjoint_filter_filter_neg _ _ +@[simp] lemma disjoint_diag_off_diag : disjoint s.diag s.off_diag := +disjoint_filter_filter_neg _ _ _ -lemma product_sdiff_diag : s.product s \ s.diag = s.off_diag := +lemma product_sdiff_diag : s ×ˢ s \ s.diag = s.off_diag := by rw [←diag_union_off_diag, union_comm, union_sdiff_self, sdiff_eq_self_of_disjoint (disjoint_diag_off_diag _).symm] -lemma product_sdiff_off_diag : s.product s \ s.off_diag = s.diag := +lemma product_sdiff_off_diag : s ×ˢ s \ s.off_diag = s.diag := by rw [←diag_union_off_diag, union_sdiff_self, sdiff_eq_self_of_disjoint (disjoint_diag_off_diag _)] +lemma diag_inter : (s ∩ t).diag = s.diag ∩ t.diag := +ext $ λ x, by simpa only [mem_diag, mem_inter] using and_and_distrib_right _ _ _ + +lemma off_diag_inter : (s ∩ t).off_diag = s.off_diag ∩ t.off_diag := +coe_injective $ by { push_cast, exact set.off_diag_inter _ _ } + lemma diag_union : (s ∪ t).diag = s.diag ∪ t.diag := by { ext ⟨i, j⟩, simp only [mem_diag, mem_union, or_and_distrib_right] } variables {s t} lemma off_diag_union (h : disjoint s t) : - (s ∪ t).off_diag = s.off_diag ∪ t.off_diag ∪ s.product t ∪ t.product s := -begin - rw [off_diag, union_product, product_union, product_union, union_comm _ (t.product t), - union_assoc, union_left_comm (s.product t), ←union_assoc, filter_union, filter_union, ←off_diag, - ←off_diag, filter_true_of_mem, ←union_assoc], - simp only [mem_union, mem_product, ne.def, prod.forall], - rintro i j (⟨hi, hj⟩ | ⟨hi, hj⟩), - { exact h.forall_ne_finset hi hj }, - { exact h.symm.forall_ne_finset hi hj }, -end + (s ∪ t).off_diag = s.off_diag ∪ t.off_diag ∪ s ×ˢ t ∪ t ×ˢ s := +coe_injective $ by { push_cast, exact set.off_diag_union (disjoint_coe.2 h) } variables (a : α) @@ -219,7 +289,7 @@ lemma diag_insert : (insert a s).diag = insert (a, a) s.diag := by rw [insert_eq, insert_eq, diag_union, diag_singleton] lemma off_diag_insert (has : a ∉ s) : - (insert a s).off_diag = s.off_diag ∪ ({a} : finset α).product s ∪ s.product {a} := + (insert a s).off_diag = s.off_diag ∪ {a} ×ˢ s ∪ s ×ˢ {a} := by rw [insert_eq, union_comm, off_diag_union (disjoint_singleton_right.2 has), off_diag_singleton, union_empty, union_right_comm] diff --git a/src/data/finset/sigma.lean b/src/data/finset/sigma.lean index 6b24cf5fc1a91..e000ed62e556e 100644 --- a/src/data/finset/sigma.lean +++ b/src/data/finset/sigma.lean @@ -9,6 +9,9 @@ import data.set.sigma /-! # Finite sets in a sigma type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a few `finset` constructions on `Σ i, α i`. ## Main declarations @@ -53,6 +56,21 @@ by simp only [← not_nonempty_iff_eq_empty, sigma_nonempty, not_exists] @[mono] lemma sigma_mono (hs : s₁ ⊆ s₂) (ht : ∀ i, t₁ i ⊆ t₂ i) : s₁.sigma t₁ ⊆ s₂.sigma t₂ := λ ⟨i, a⟩ h, let ⟨hi, ha⟩ := mem_sigma.1 h in mem_sigma.2 ⟨hs hi, ht i ha⟩ +lemma pairwise_disjoint_map_sigma_mk : + (s : set ι).pairwise_disjoint (λ i, (t i).map (embedding.sigma_mk i)) := +begin + intros i hi j hj hij, + rw [function.on_fun, disjoint_left], + simp_rw [mem_map, function.embedding.sigma_mk_apply], + rintros _ ⟨y, hy, rfl⟩ ⟨z, hz, hz'⟩, + exact hij (congr_arg sigma.fst hz'.symm) +end + +@[simp] +lemma disj_Union_map_sigma_mk : + s.disj_Union (λ i, (t i).map (embedding.sigma_mk i)) + pairwise_disjoint_map_sigma_mk = s.sigma t := rfl + lemma sigma_eq_bUnion [decidable_eq (Σ i, α i)] (s : finset ι) (t : Π i, finset (α i)) : s.sigma t = s.bUnion (λ i, (t i).map $ embedding.sigma_mk i) := by { ext ⟨x, y⟩, simp [and.left_comm] } @@ -62,11 +80,8 @@ variables (s t) (f : (Σ i, α i) → β) lemma sup_sigma [semilattice_sup β] [order_bot β] : (s.sigma t).sup f = s.sup (λ i, (t i).sup $ λ b, f ⟨i, b⟩) := begin - refine (sup_le _).antisymm (sup_le $ λ i hi, sup_le $ λ b hb, le_sup $ mem_sigma.2 ⟨hi, hb⟩), - rintro ⟨i, b⟩ hb, - rw mem_sigma at hb, - refine le_trans _ (le_sup hb.1), - convert le_sup hb.2, + simp only [le_antisymm_iff, finset.sup_le_iff, mem_sigma, and_imp, sigma.forall], + exact ⟨λ i a hi ha, (le_sup hi).trans' $ le_sup ha, λ i hi a ha, le_sup $ mem_sigma.2 ⟨hi, ha⟩⟩, end lemma inf_sigma [semilattice_inf β] [order_top β] : diff --git a/src/data/finset/slice.lean b/src/data/finset/slice.lean index d3a729689bb02..b88806deb040e 100644 --- a/src/data/finset/slice.lean +++ b/src/data/finset/slice.lean @@ -10,6 +10,9 @@ import order.antichain /-! # `r`-sets and slice +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the `r`-th slice of a set family and provides a way to say that a set family is made of `r`-sets. @@ -45,7 +48,7 @@ lemma sized_union : (A ∪ B).sized r ↔ A.sized r ∧ B.sized r := ⟨λ hA, ⟨hA.mono $ subset_union_left _ _, hA.mono $ subset_union_right _ _⟩, λ hA x hx, hx.elim (λ h, hA.1 h) $ λ h, hA.2 h⟩ -alias sized_union ↔ _ set.sized.union +alias sized_union ↔ _ sized.union --TODO: A `forall_Union` lemma would be handy here. @[simp] lemma sized_Union {f : ι → set (finset α)} : (⋃ i, f i).sized r ↔ ∀ i, (f i).sized r := @@ -81,7 +84,7 @@ variables [fintype α] {𝒜 : finset (finset α)} {s : finset α} {r : ℕ} lemma subset_powerset_len_univ_iff : 𝒜 ⊆ powerset_len r univ ↔ (𝒜 : set (finset α)).sized r := forall_congr $ λ A, by rw [mem_powerset_len_univ_iff, mem_coe] -alias subset_powerset_len_univ_iff ↔ _ set.sized.subset_powerset_len_univ +alias subset_powerset_len_univ_iff ↔ _ _root_.set.sized.subset_powerset_len_univ lemma _root_.set.sized.card_le (h𝒜 : (𝒜 : set (finset α)).sized r) : card 𝒜 ≤ (fintype.card α).choose r := @@ -100,7 +103,7 @@ variables {𝒜 : finset (finset α)} {A A₁ A₂ : finset α} {r r₁ r₂ : /-- The `r`-th slice of a set family is the subset of its elements which have cardinality `r`. -/ def slice (𝒜 : finset (finset α)) (r : ℕ) : finset (finset α) := 𝒜.filter (λ i, i.card = r) -localized "infix ` # `:90 := finset.slice" in finset_family +localized "infix (name := finset.slice) ` # `:90 := finset.slice" in finset_family /-- `A` is in the `r`-th slice of `𝒜` iff it's in `𝒜` and has cardinality `r`. -/ lemma mem_slice : A ∈ 𝒜 # r ↔ A ∈ 𝒜 ∧ A.card = r := mem_filter @@ -118,7 +121,7 @@ lemma eq_of_mem_slice (h₁ : A ∈ 𝒜 # r₁) (h₂ : A ∈ 𝒜 # r₂) : r lemma ne_of_mem_slice (h₁ : A₁ ∈ 𝒜 # r₁) (h₂ : A₂ ∈ 𝒜 # r₂) : r₁ ≠ r₂ → A₁ ≠ A₂ := mt $ λ h, (sized_slice h₁).symm.trans ((congr_arg card h).trans (sized_slice h₂)) -lemma pairwise_disjoint_slice [decidable_eq α] : (set.univ : set ℕ).pairwise_disjoint (slice 𝒜) := +lemma pairwise_disjoint_slice : (set.univ : set ℕ).pairwise_disjoint (slice 𝒜) := λ m _ n _ hmn, disjoint_filter.2 $ λ s hs hm hn, hmn $ hm.symm.trans hn variables [fintype α] (𝒜) @@ -128,8 +131,11 @@ subset.antisymm (bUnion_subset.2 $ λ r _, slice_subset) $ λ s hs, mem_bUnion.2 ⟨s.card, mem_Iic.2 $ s.card_le_univ, mem_slice.2 $ ⟨hs, rfl⟩⟩ @[simp] lemma sum_card_slice : ∑ r in Iic (fintype.card α), (𝒜 # r).card = 𝒜.card := -by { rw [←card_bUnion (finset.pairwise_disjoint_slice.subset (set.subset_univ _)), bUnion_slice], - exact classical.dec_eq _ } +begin + letI := classical.dec_eq α, + rw [←card_bUnion, bUnion_slice], + exact finset.pairwise_disjoint_slice.subset (set.subset_univ _), +end end slice end finset diff --git a/src/data/finset/sort.lean b/src/data/finset/sort.lean index e8e20dd8b84a5..2e7d38585c847 100644 --- a/src/data/finset/sort.lean +++ b/src/data/finset/sort.lean @@ -3,12 +3,16 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.fintype.basic +import order.rel_iso.set +import data.fintype.lattice import data.multiset.sort import data.list.nodup_equiv_fin /-! # Construct a sorted list from a finset. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace finset @@ -143,12 +147,21 @@ rfl @[simp] lemma range_order_emb_of_fin (s : finset α) {k : ℕ} (h : s.card = k) : set.range (s.order_emb_of_fin h) = s := -by simp [order_emb_of_fin, set.range_comp coe (s.order_iso_of_fin h)] +by simp only [order_emb_of_fin, set.range_comp coe (s.order_iso_of_fin h), rel_embedding.coe_trans, + set.image_univ, + finset.order_emb_of_fin.equations._eqn_1, + rel_iso.range_eq, + order_embedding.subtype_apply, + order_iso.coe_to_order_embedding, + eq_self_iff_true, + subtype.range_coe_subtype, + finset.set_of_mem, + finset.coe_inj] /-- The bijection `order_emb_of_fin s h` sends `0` to the minimum of `s`. -/ lemma order_emb_of_fin_zero {s : finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) : order_emb_of_fin s h ⟨0, hz⟩ = s.min' (card_pos.mp (h.symm ▸ hz)) := -by simp only [order_emb_of_fin_apply, subtype.coe_mk, sorted_zero_eq_min'] +by simp only [order_emb_of_fin_apply, fin.coe_mk, sorted_zero_eq_min'] /-- The bijection `order_emb_of_fin s h` sends `k-1` to the maximum of `s`. -/ lemma order_emb_of_fin_last {s : finset α} {k : ℕ} (h : s.card = k) (hz : 0 < k) : @@ -166,10 +179,10 @@ lemma order_emb_of_fin_unique {s : finset α} {k : ℕ} (h : s.card = k) {f : fi (hfs : ∀ x, f x ∈ s) (hmono : strict_mono f) : f = s.order_emb_of_fin h := begin apply fin.strict_mono_unique hmono (s.order_emb_of_fin h).strict_mono, - rw [range_order_emb_of_fin, ← set.image_univ, ← coe_fin_range, ← coe_image, coe_inj], + rw [range_order_emb_of_fin, ← set.image_univ, ← coe_univ, ← coe_image, coe_inj], refine eq_of_subset_of_card_le (λ x hx, _) _, { rcases mem_image.1 hx with ⟨x, hx, rfl⟩, exact hfs x }, - { rw [h, card_image_of_injective _ hmono.injective, fin_range_card] } + { rw [h, card_image_of_injective _ hmono.injective, card_univ, fintype.card_fin] } end /-- An order embedding `f` from `fin k` to a finset of cardinality `k` has to coincide with @@ -186,7 +199,7 @@ and only if `i = j`. Since they can be defined on a priori not defeq types `fin s.order_emb_of_fin h i = s.order_emb_of_fin h' j ↔ (i : ℕ) = (j : ℕ) := begin substs k l, - exact (s.order_emb_of_fin rfl).eq_iff_eq.trans (fin.ext_iff _ _) + exact (s.order_emb_of_fin rfl).eq_iff_eq.trans fin.ext_iff end /-- Given a finset `s` of size at least `k` in a linear order `α`, the map `order_emb_of_card_le` @@ -199,34 +212,8 @@ lemma order_emb_of_card_le_mem (s : finset α) {k : ℕ} (h : k ≤ s.card) (a) order_emb_of_card_le s h a ∈ s := by simp only [order_emb_of_card_le, rel_embedding.coe_trans, finset.order_emb_of_fin_mem] -lemma card_le_of_interleaved {s t : finset α} (h : ∀ x y ∈ s, x < y → ∃ z ∈ t, x < z ∧ z < y) : - s.card ≤ t.card + 1 := -begin - have h1 : ∀ i : fin (s.card - 1), ↑i + 1 < (s.sort (≤)).length, - { intro i, - rw [finset.length_sort, ←lt_tsub_iff_right], - exact i.2 }, - have h0 : ∀ i : fin (s.card - 1), ↑i < (s.sort (≤)).length := - λ i, lt_of_le_of_lt (nat.le_succ i) (h1 i), - have p := λ i : fin (s.card - 1), h ((s.sort (≤)).nth_le i (h0 i)) - ((finset.mem_sort (≤)).mp (list.nth_le_mem _ _ (h0 i))) - ((s.sort (≤)).nth_le (i + 1) (h1 i)) - ((finset.mem_sort (≤)).mp (list.nth_le_mem _ _ (h1 i))) - (s.sort_sorted_lt.rel_nth_le_of_lt (h0 i) (h1 i) (nat.lt_succ_self i)), - let f : fin (s.card - 1) → t := - λ i, ⟨classical.some (p i), (exists_prop.mp (classical.some_spec (p i))).1⟩, - have hf : ∀ i j : fin (s.card - 1), i < j → f i < f j := - λ i j hij, subtype.coe_lt_coe.mp ((exists_prop.mp (classical.some_spec (p i))).2.2.trans - (lt_of_le_of_lt ((s.sort_sorted (≤)).rel_nth_le_of_le (h1 i) (h0 j) (nat.succ_le_iff.mpr hij)) - (exists_prop.mp (classical.some_spec (p j))).2.1)), - have key := fintype.card_le_of_embedding (function.embedding.mk f (λ i j hij, le_antisymm - (not_lt.mp (mt (hf j i) (not_lt.mpr (le_of_eq hij)))) - (not_lt.mp (mt (hf i j) (not_lt.mpr (ge_of_eq hij)))))), - rwa [fintype.card_fin, fintype.card_coe, tsub_le_iff_right] at key, -end - end sort_linear_order -instance [has_repr α] : has_repr (finset α) := ⟨λ s, repr s.1⟩ +meta instance [has_repr α] : has_repr (finset α) := ⟨λ s, repr s.1⟩ end finset diff --git a/src/data/finset/sum.lean b/src/data/finset/sum.lean index 8933dd3cdc3e6..a940205835735 100644 --- a/src/data/finset/sum.lean +++ b/src/data/finset/sum.lean @@ -3,11 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import data.finset.card import data.multiset.sum +import data.finset.card + /-! # Disjoint sum of finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the disjoint sum of two finsets as `finset (α ⊕ β)`. Beware not to confuse with the `finset.sum` operation which computes the additive sum. @@ -34,6 +38,14 @@ val_inj.1 $ multiset.disj_sum_zero _ @[simp] lemma card_disj_sum : (s.disj_sum t).card = s.card + t.card := multiset.card_disj_sum _ _ +lemma disjoint_map_inl_map_inr : disjoint (s.map embedding.inl) (t.map embedding.inr) := +by { simp_rw [disjoint_left, mem_map], rintro x ⟨a, _, rfl⟩ ⟨b, _, ⟨⟩⟩ } + +@[simp] +lemma map_inl_disj_union_map_inr : + (s.map embedding.inl).disj_union (t.map embedding.inr) (disjoint_map_inl_map_inr _ _) = + s.disj_sum t := rfl + variables {s t} {s₁ s₂ : finset α} {t₁ t₂ : finset β} {a : α} {b : β} {x : α ⊕ β} lemma mem_disj_sum : x ∈ s.disj_sum t ↔ (∃ a, a ∈ s ∧ inl a = x) ∨ ∃ b, b ∈ t ∧ inr b = x := @@ -42,6 +54,8 @@ multiset.mem_disj_sum @[simp] lemma inl_mem_disj_sum : inl a ∈ s.disj_sum t ↔ a ∈ s := inl_mem_disj_sum @[simp] lemma inr_mem_disj_sum : inr b ∈ s.disj_sum t ↔ b ∈ t := inr_mem_disj_sum +@[simp] lemma disj_sum_eq_empty : s.disj_sum t = ∅ ↔ s = ∅ ∧ t = ∅ := by simp [ext_iff] + lemma disj_sum_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁.disj_sum t₁ ⊆ s₂.disj_sum t₂ := val_le_iff.1 $ disj_sum_mono (val_le_iff.2 hs) (val_le_iff.2 ht) diff --git a/src/data/finset/sups.lean b/src/data/finset/sups.lean new file mode 100644 index 0000000000000..b94a8777cedc4 --- /dev/null +++ b/src/data/finset/sups.lean @@ -0,0 +1,363 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.finset.n_ary +import data.set.sups + +/-! +# Set family operations + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines a few binary operations on `finset α` for use in set family combinatorics. + +## Main declarations + +* `s ⊻ t`: Finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`. +* `s ⊼ t`: Finset of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`. +* `finset.disj_sups s t`: Finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t` and `a` + and `b` are disjoint. + +## Notation + +We define the following notation in locale `finset_family`: +* `s ⊻ t` +* `s ⊼ t` +* `s ○ t` for `finset.disj_sups s t` + +## References + +[B. Bollobás, *Combinatorics*][bollobas1986] +-/ + +open function +open_locale set_family + +-- TODO: Is there a better spot for those two instances? +namespace finset +variables {α : Type*} [preorder α] {s t : set α} {a : α} + +instance decidable_pred_mem_upper_closure (s : finset α) [@decidable_rel α (≤)] : + decidable_pred (∈ upper_closure (s : set α)) := +λ _, finset.decidable_dexists_finset + +instance decidable_pred_mem_lower_closure (s : finset α) [@decidable_rel α (≤)] : + decidable_pred (∈ lower_closure (s : set α)) := +λ _, finset.decidable_dexists_finset + +end finset + +variables {α : Type*} [decidable_eq α] + +namespace finset +section sups +variables [semilattice_sup α] (s s₁ s₂ t t₁ t₂ u v : finset α) + +/-- `s ⊻ t` is the finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`. -/ +protected def has_sups : has_sups (finset α) := ⟨image₂ (⊔)⟩ + +localized "attribute [instance] finset.has_sups" in finset_family + +variables {s t} {a b c : α} + +@[simp] lemma mem_sups : c ∈ s ⊻ t ↔ ∃ (a ∈ s) (b ∈ t), a ⊔ b = c := by simp [(⊻)] + +variables (s t) + +@[simp, norm_cast] lemma coe_sups : (↑(s ⊻ t) : set α) = s ⊻ t := coe_image₂ _ _ _ + +lemma card_sups_le : (s ⊻ t).card ≤ s.card * t.card := card_image₂_le _ _ _ + +lemma card_sups_iff : + (s ⊻ t).card = s.card * t.card ↔ (s ×ˢ t : set (α × α)).inj_on (λ x, x.1 ⊔ x.2) := +card_image₂_iff + +variables {s s₁ s₂ t t₁ t₂ u} + +lemma sup_mem_sups : a ∈ s → b ∈ t → a ⊔ b ∈ s ⊻ t := mem_image₂_of_mem +lemma sups_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊻ t₁ ⊆ s₂ ⊻ t₂ := image₂_subset +lemma sups_subset_left : t₁ ⊆ t₂ → s ⊻ t₁ ⊆ s ⊻ t₂ := image₂_subset_left +lemma sups_subset_right : s₁ ⊆ s₂ → s₁ ⊻ t ⊆ s₂ ⊻ t := image₂_subset_right + +lemma image_subset_sups_left : b ∈ t → s.image (λ a, a ⊔ b) ⊆ s ⊻ t := image_subset_image₂_left +lemma image_subset_sups_right : a ∈ s → t.image ((⊔) a) ⊆ s ⊻ t := image_subset_image₂_right + +lemma forall_sups_iff {p : α → Prop} : (∀ c ∈ s ⊻ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), p (a ⊔ b) := +forall_image₂_iff + +@[simp] lemma sups_subset_iff : s ⊻ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a ⊔ b ∈ u := image₂_subset_iff + +@[simp] lemma sups_nonempty : (s ⊻ t).nonempty ↔ s.nonempty ∧ t.nonempty := image₂_nonempty_iff + +protected lemma nonempty.sups : s.nonempty → t.nonempty → (s ⊻ t).nonempty := nonempty.image₂ +lemma nonempty.of_sups_left : (s ⊻ t).nonempty → s.nonempty := nonempty.of_image₂_left +lemma nonempty.of_sups_right : (s ⊻ t).nonempty → t.nonempty := nonempty.of_image₂_right + +@[simp] lemma empty_sups : ∅ ⊻ t = ∅ := image₂_empty_left +@[simp] lemma sups_empty : s ⊻ ∅ = ∅ := image₂_empty_right +@[simp] lemma sups_eq_empty : s ⊻ t = ∅ ↔ s = ∅ ∨ t = ∅ := image₂_eq_empty_iff + +@[simp] lemma singleton_sups : {a} ⊻ t = t.image (λ b, a ⊔ b) := image₂_singleton_left +@[simp] lemma sups_singleton : s ⊻ {b} = s.image (λ a, a ⊔ b) := image₂_singleton_right + +lemma singleton_sups_singleton : ({a} ⊻ {b} : finset α) = {a ⊔ b} := image₂_singleton + +lemma sups_union_left : (s₁ ∪ s₂) ⊻ t = s₁ ⊻ t ∪ s₂ ⊻ t := image₂_union_left +lemma sups_union_right : s ⊻ (t₁ ∪ t₂) = s ⊻ t₁ ∪ s ⊻ t₂ := image₂_union_right + +lemma sups_inter_subset_left : (s₁ ∩ s₂) ⊻ t ⊆ s₁ ⊻ t ∩ s₂ ⊻ t := image₂_inter_subset_left +lemma sups_inter_subset_right : s ⊻ (t₁ ∩ t₂) ⊆ s ⊻ t₁ ∩ s ⊻ t₂ := image₂_inter_subset_right + +lemma subset_sups {s t : set α} : + ↑u ⊆ s ⊻ t → ∃ s' t' : finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' ⊻ t' := +subset_image₂ + +variables (s t u v) + +lemma bUnion_image_sup_left : s.bUnion (λ a, t.image $ (⊔) a) = s ⊻ t := bUnion_image_left +lemma bUnion_image_sup_right : t.bUnion (λ b, s.image $ λ a, a ⊔ b) = s ⊻ t := bUnion_image_right + +@[simp] lemma image_sup_product (s t : finset α) : (s ×ˢ t).image (uncurry (⊔)) = s ⊻ t := +image_uncurry_product _ _ _ + +lemma sups_assoc : (s ⊻ t) ⊻ u = s ⊻ (t ⊻ u) := image₂_assoc $ λ _ _ _, sup_assoc +lemma sups_comm : s ⊻ t = t ⊻ s := image₂_comm $ λ _ _, sup_comm +lemma sups_left_comm : s ⊻ (t ⊻ u) = t ⊻ (s ⊻ u) := image₂_left_comm sup_left_comm +lemma sups_right_comm : (s ⊻ t) ⊻ u = (s ⊻ u) ⊻ t := image₂_right_comm sup_right_comm +lemma sups_sups_sups_comm : (s ⊻ t) ⊻ (u ⊻ v) = (s ⊻ u) ⊻ (t ⊻ v) := +image₂_image₂_image₂_comm sup_sup_sup_comm + +variables [@decidable_rel α (≤)] + +lemma filter_sups_le (s t : finset α) (a : α) : + (s ⊻ t).filter (λ b, b ≤ a) = s.filter (λ b, b ≤ a) ⊻ t.filter (λ b, b ≤ a) := +begin + ext b, + simp only [mem_filter, mem_sups], + split, + { rintro ⟨⟨b, hb, c, hc, rfl⟩, ha⟩, + rw sup_le_iff at ha, + exact ⟨_, ⟨hb, ha.1⟩, _, ⟨hc, ha.2⟩, rfl⟩ }, + { rintro ⟨b, hb, c, hc, _, rfl⟩, + exact ⟨⟨_, hb.1, _, hc.1, rfl⟩, sup_le hb.2 hc.2⟩ } +end + +end sups + +section infs +variables [semilattice_inf α] (s s₁ s₂ t t₁ t₂ u v : finset α) + +/-- `s ⊼ t` is the finset of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`. -/ +protected def has_infs : has_infs (finset α) := ⟨image₂ (⊓)⟩ + +localized "attribute [instance] finset.has_infs" in finset_family + +variables {s t} {a b c : α} + +@[simp] lemma mem_infs : c ∈ s ⊼ t ↔ ∃ (a ∈ s) (b ∈ t), a ⊓ b = c := by simp [(⊼)] + +variables (s t) + +@[simp, norm_cast] lemma coe_infs : (↑(s ⊼ t) : set α) = s ⊼ t := coe_image₂ _ _ _ + +lemma card_infs_le : (s ⊼ t).card ≤ s.card * t.card := card_image₂_le _ _ _ + +lemma card_infs_iff : + (s ⊼ t).card = s.card * t.card ↔ (s ×ˢ t : set (α × α)).inj_on (λ x, x.1 ⊓ x.2) := +card_image₂_iff + +variables {s s₁ s₂ t t₁ t₂ u} + +lemma inf_mem_infs : a ∈ s → b ∈ t → a ⊓ b ∈ s ⊼ t := mem_image₂_of_mem +lemma infs_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊼ t₁ ⊆ s₂ ⊼ t₂ := image₂_subset +lemma infs_subset_left : t₁ ⊆ t₂ → s ⊼ t₁ ⊆ s ⊼ t₂ := image₂_subset_left +lemma infs_subset_right : s₁ ⊆ s₂ → s₁ ⊼ t ⊆ s₂ ⊼ t := image₂_subset_right + +lemma image_subset_infs_left : b ∈ t → s.image (λ a, a ⊓ b) ⊆ s ⊼ t := image_subset_image₂_left +lemma image_subset_infs_right : a ∈ s → t.image ((⊓) a) ⊆ s ⊼ t := image_subset_image₂_right + +lemma forall_infs_iff {p : α → Prop} : (∀ c ∈ s ⊼ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), p (a ⊓ b) := +forall_image₂_iff + +@[simp] lemma infs_subset_iff : s ⊼ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a ⊓ b ∈ u := image₂_subset_iff + +@[simp] lemma infs_nonempty : (s ⊼ t).nonempty ↔ s.nonempty ∧ t.nonempty := image₂_nonempty_iff + +protected lemma nonempty.infs : s.nonempty → t.nonempty → (s ⊼ t).nonempty := nonempty.image₂ +lemma nonempty.of_infs_left : (s ⊼ t).nonempty → s.nonempty := nonempty.of_image₂_left +lemma nonempty.of_infs_right : (s ⊼ t).nonempty → t.nonempty := nonempty.of_image₂_right + +@[simp] lemma empty_infs : ∅ ⊼ t = ∅ := image₂_empty_left +@[simp] lemma infs_empty : s ⊼ ∅ = ∅ := image₂_empty_right +@[simp] lemma infs_eq_empty : s ⊼ t = ∅ ↔ s = ∅ ∨ t = ∅ := image₂_eq_empty_iff + +@[simp] lemma singleton_infs : {a} ⊼ t = t.image (λ b, a ⊓ b) := image₂_singleton_left +@[simp] lemma infs_singleton : s ⊼ {b} = s.image (λ a, a ⊓ b) := image₂_singleton_right + +lemma singleton_infs_singleton : ({a} ⊼ {b} : finset α) = {a ⊓ b} := image₂_singleton + +lemma infs_union_left : (s₁ ∪ s₂) ⊼ t = s₁ ⊼ t ∪ s₂ ⊼ t := image₂_union_left +lemma infs_union_right : s ⊼ (t₁ ∪ t₂) = s ⊼ t₁ ∪ s ⊼ t₂ := image₂_union_right + +lemma infs_inter_subset_left : (s₁ ∩ s₂) ⊼ t ⊆ s₁ ⊼ t ∩ s₂ ⊼ t := image₂_inter_subset_left +lemma infs_inter_subset_right : s ⊼ (t₁ ∩ t₂) ⊆ s ⊼ t₁ ∩ s ⊼ t₂ := image₂_inter_subset_right + +lemma subset_infs {s t : set α} : + ↑u ⊆ s ⊼ t → ∃ s' t' : finset α, ↑s' ⊆ s ∧ ↑t' ⊆ t ∧ u ⊆ s' ⊼ t' := +subset_image₂ + +variables (s t u v) + +lemma bUnion_image_inf_left : s.bUnion (λ a, t.image $ (⊓) a) = s ⊼ t := bUnion_image_left +lemma bUnion_image_inf_right : t.bUnion (λ b, s.image $ λ a, a ⊓ b) = s ⊼ t := bUnion_image_right + +@[simp] lemma image_inf_product (s t : finset α) : (s ×ˢ t).image (uncurry (⊓)) = s ⊼ t := +image_uncurry_product _ _ _ + +lemma infs_assoc : (s ⊼ t) ⊼ u = s ⊼ (t ⊼ u) := image₂_assoc $ λ _ _ _, inf_assoc +lemma infs_comm : s ⊼ t = t ⊼ s := image₂_comm $ λ _ _, inf_comm +lemma infs_left_comm : s ⊼ (t ⊼ u) = t ⊼ (s ⊼ u) := image₂_left_comm inf_left_comm +lemma infs_right_comm : (s ⊼ t) ⊼ u = (s ⊼ u) ⊼ t := image₂_right_comm inf_right_comm +lemma infs_infs_infs_comm : (s ⊼ t) ⊼ (u ⊼ v) = (s ⊼ u) ⊼ (t ⊼ v) := +image₂_image₂_image₂_comm inf_inf_inf_comm + +variables [@decidable_rel α (≤)] + +lemma filter_infs_ge (s t : finset α) (a : α) : + (s ⊼ t).filter (λ b, a ≤ b) = s.filter (λ b, a ≤ b) ⊼ t.filter (λ b, a ≤ b) := +begin + ext b, + simp only [mem_filter, mem_infs], + split, + { rintro ⟨⟨b, hb, c, hc, rfl⟩, ha⟩, + rw le_inf_iff at ha, + exact ⟨_, ⟨hb, ha.1⟩, _, ⟨hc, ha.2⟩, rfl⟩ }, + { rintro ⟨b, hb, c, hc, _, rfl⟩, + exact ⟨⟨_, hb.1, _, hc.1, rfl⟩, le_inf hb.2 hc.2⟩ } +end + +end infs + +open_locale finset_family + +section distrib_lattice +variables [distrib_lattice α] (s t u : finset α) + +lemma sups_infs_subset_left : s ⊻ (t ⊼ u) ⊆ (s ⊻ t) ⊼ (s ⊻ u) := +image₂_distrib_subset_left $ λ _ _ _, sup_inf_left + +lemma sups_infs_subset_right : (t ⊼ u) ⊻ s ⊆ (t ⊻ s) ⊼ (u ⊻ s) := +image₂_distrib_subset_right $ λ _ _ _, sup_inf_right + +lemma infs_sups_subset_left : s ⊼ (t ⊻ u) ⊆ (s ⊼ t) ⊻ (s ⊼ u) := +image₂_distrib_subset_left $ λ _ _ _, inf_sup_left + +lemma infs_sups_subset_right : (t ⊻ u) ⊼ s ⊆ (t ⊼ s) ⊻ (u ⊼ s) := +image₂_distrib_subset_right $ λ _ _ _, inf_sup_right + +end distrib_lattice + +section disj_sups +variables [semilattice_sup α] [order_bot α] [@decidable_rel α disjoint] + (s s₁ s₂ t t₁ t₂ u : finset α) + +/-- The finset of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t` and `a` and `b` are disjoint. +-/ +def disj_sups : finset α := +((s ×ˢ t).filter $ λ ab : α × α, disjoint ab.1 ab.2).image $ λ ab, ab.1 ⊔ ab.2 + +localized "infix (name := finset.disj_sups) ` ○ `:74 := finset.disj_sups" in finset_family + +variables {s t u} {a b c : α} + +@[simp] lemma mem_disj_sups : c ∈ s ○ t ↔ ∃ (a ∈ s) (b ∈ t), disjoint a b ∧ a ⊔ b = c := +by simp [disj_sups, and_assoc] + +lemma disj_sups_subset_sups : s ○ t ⊆ s ⊻ t := +begin + simp_rw [subset_iff, mem_sups, mem_disj_sups], + exact λ c ⟨a, b, ha, hb, h, hc⟩, ⟨a, b, ha, hb, hc⟩, +end + +variables (s t) + +lemma card_disj_sups_le : (s ○ t).card ≤ s.card * t.card := +(card_le_of_subset disj_sups_subset_sups).trans $ card_sups_le _ _ + +variables {s s₁ s₂ t t₁ t₂ u} + +lemma disj_sups_subset (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ○ t₁ ⊆ s₂ ○ t₂ := +image_subset_image $ filter_subset_filter _ $ product_subset_product hs ht + +lemma disj_sups_subset_left (ht : t₁ ⊆ t₂) : s ○ t₁ ⊆ s ○ t₂ := disj_sups_subset subset.rfl ht +lemma disj_sups_subset_right (hs : s₁ ⊆ s₂) : s₁ ○ t ⊆ s₂ ○ t := disj_sups_subset hs subset.rfl + +lemma forall_disj_sups_iff {p : α → Prop} : + (∀ c ∈ s ○ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), disjoint a b → p (a ⊔ b) := +begin + simp_rw mem_disj_sups, + refine ⟨λ h a ha b hb hab, h _ ⟨_, ha, _, hb, hab, rfl⟩, _⟩, + rintro h _ ⟨a, ha, b, hb, hab, rfl⟩, + exact h _ ha _ hb hab, +end + +@[simp] lemma disj_sups_subset_iff : s ○ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), disjoint a b → a ⊔ b ∈ u := +forall_disj_sups_iff + +lemma nonempty.of_disj_sups_left : (s ○ t).nonempty → s.nonempty := +by { simp_rw [finset.nonempty, mem_disj_sups], exact λ ⟨_, a, ha, _⟩, ⟨a, ha⟩ } + +lemma nonempty.of_disj_sups_right : (s ○ t).nonempty → t.nonempty := +by { simp_rw [finset.nonempty, mem_disj_sups], exact λ ⟨_, _, _, b, hb, _⟩, ⟨b, hb⟩ } + +@[simp] lemma disj_sups_empty_left : ∅ ○ t = ∅ := by simp [disj_sups] +@[simp] lemma disj_sups_empty_right : s ○ ∅ = ∅ := by simp [disj_sups] + +lemma disj_sups_singleton : ({a} ○ {b} : finset α) = if disjoint a b then {a ⊔ b} else ∅ := +by split_ifs; simp [disj_sups, filter_singleton, h] + +lemma disj_sups_union_left : (s₁ ∪ s₂) ○ t = s₁ ○ t ∪ s₂ ○ t := +by simp [disj_sups, filter_union, image_union] +lemma disj_sups_union_right : s ○ (t₁ ∪ t₂) = s ○ t₁ ∪ s ○ t₂ := +by simp [disj_sups, filter_union, image_union] + +lemma disj_sups_inter_subset_left : (s₁ ∩ s₂) ○ t ⊆ s₁ ○ t ∩ s₂ ○ t := +by simpa only [disj_sups, inter_product, filter_inter_distrib] using image_inter_subset _ _ _ +lemma disj_sups_inter_subset_right : s ○ (t₁ ∩ t₂) ⊆ s ○ t₁ ∩ s ○ t₂ := +by simpa only [disj_sups, product_inter, filter_inter_distrib] using image_inter_subset _ _ _ + +variables (s t) + +lemma disj_sups_comm : s ○ t = t ○ s := +by { ext, rw [mem_disj_sups, exists₂_comm], simp [sup_comm, disjoint.comm] } + +end disj_sups + +open_locale finset_family + +section distrib_lattice +variables [distrib_lattice α] [order_bot α] [@decidable_rel α disjoint] (s t u v : finset α) + +lemma disj_sups_assoc : ∀ s t u : finset α, (s ○ t) ○ u = s ○ (t ○ u) := +begin + refine associative_of_commutative_of_le disj_sups_comm _, + simp only [le_eq_subset, disj_sups_subset_iff, mem_disj_sups], + rintro s t u _ ⟨a, ha, b, hb, hab, rfl⟩ c hc habc, + rw disjoint_sup_left at habc, + exact ⟨a, ha, _, ⟨b, hb, c, hc, habc.2, rfl⟩, hab.sup_right habc.1, sup_assoc.symm⟩, +end + +lemma disj_sups_left_comm : s ○ (t ○ u) = t ○ (s ○ u) := +by simp_rw [←disj_sups_assoc, disj_sups_comm s] + +lemma disj_sups_right_comm : (s ○ t) ○ u = (s ○ u) ○ t := +by simp_rw [disj_sups_assoc, disj_sups_comm] + +lemma disj_sups_disj_sups_disj_sups_comm : (s ○ t) ○ (u ○ v) = (s ○ u) ○ (t ○ v) := +by simp_rw [←disj_sups_assoc, disj_sups_right_comm] + +end distrib_lattice +end finset diff --git a/src/data/finset/sym.lean b/src/data/finset/sym.lean index 06c02270db1cf..9b6246c51e858 100644 --- a/src/data/finset/sym.lean +++ b/src/data/finset/sym.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import data.finset.prod +import data.finset.lattice +import data.fintype.prod +import data.fintype.vector import data.sym.sym2 /-! # Symmetric powers of a finset +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the symmetric powers of a finset as `finset (sym α n)` and `finset (sym2 α)`. ## Main declarations @@ -28,16 +33,16 @@ namespace finset variables {α : Type*} [decidable_eq α] {s t : finset α} {a b : α} lemma is_diag_mk_of_mem_diag {a : α × α} (h : a ∈ s.diag) : sym2.is_diag ⟦a⟧ := -(sym2.is_diag_iff_proj_eq _).2 ((mem_diag _ _).1 h).2 +(sym2.is_diag_iff_proj_eq _).2 (mem_diag.1 h).2 lemma not_is_diag_mk_of_mem_off_diag {a : α × α} (h : a ∈ s.off_diag) : ¬ sym2.is_diag ⟦a⟧ := -by { rw sym2.is_diag_iff_proj_eq, exact ((mem_off_diag _ _).1 h).2.2 } +by { rw sym2.is_diag_iff_proj_eq, exact (mem_off_diag.1 h).2.2 } section sym2 variables {m : sym2 α} /-- Lifts a finset to `sym2 α`. `s.sym2` is the finset of all pairs with elements in `s`. -/ -protected def sym2 (s : finset α) : finset (sym2 α) := (s.product s).image quotient.mk +protected def sym2 (s : finset α) : finset (sym2 α) := (s ×ˢ s).image quotient.mk @[simp] lemma mem_sym2_iff : m ∈ s.sym2 ↔ ∀ a ∈ m, a ∈ s := begin @@ -58,9 +63,9 @@ by rw [finset.sym2, image_eq_empty, product_eq_empty, or_self] @[simp] lemma sym2_nonempty : s.sym2.nonempty ↔ s.nonempty := by rw [finset.sym2, nonempty.image_iff, nonempty_product, and_self] -alias sym2_nonempty ↔ _ finset.nonempty.sym2 +alias sym2_nonempty ↔ _ nonempty.sym2 -attribute [protected] finset.nonempty.sym2 +attribute [protected] nonempty.sym2 @[simp] lemma sym2_univ [fintype α] : (univ : finset α).sym2 = univ := rfl @@ -96,7 +101,7 @@ begin { refine mem_singleton.trans ⟨_, λ _, sym.eq_nil_of_card_zero _⟩, rintro rfl, exact λ a ha, ha.elim }, - refine mem_sup.trans ⟨_, λ h, _⟩, + refine mem_sup.trans ⟨_, λ h, _⟩, { rintro ⟨a, ha, he⟩ b hb, rw mem_image at he, obtain ⟨m, he, rfl⟩ := he, @@ -111,15 +116,15 @@ end @[simp] lemma sym_empty (n : ℕ) : (∅ : finset α).sym (n + 1) = ∅ := rfl -lemma repeat_mem_sym (ha : a ∈ s) (n : ℕ) : sym.repeat a n ∈ s.sym n := -mem_sym_iff.2 $ λ b hb, by rwa (sym.mem_repeat.1 hb).2 +lemma replicate_mem_sym (ha : a ∈ s) (n : ℕ) : sym.replicate n a ∈ s.sym n := +mem_sym_iff.2 $ λ b hb, by rwa (sym.mem_replicate.1 hb).2 protected lemma nonempty.sym (h : s.nonempty) (n : ℕ) : (s.sym n).nonempty := -let ⟨a, ha⟩ := h in ⟨_, repeat_mem_sym ha n⟩ +let ⟨a, ha⟩ := h in ⟨_, replicate_mem_sym ha n⟩ -@[simp] lemma sym_singleton (a : α) (n : ℕ) : ({a} : finset α).sym n = {sym.repeat a n} := -eq_singleton_iff_nonempty_unique_mem.2 ⟨(singleton_nonempty _).sym n, - λ s hs, sym.eq_repeat_iff.2 $ λ b hb, eq_of_mem_singleton $ mem_sym_iff.1 hs _ hb⟩ +@[simp] lemma sym_singleton (a : α) (n : ℕ) : ({a} : finset α).sym n = {sym.replicate n a} := +eq_singleton_iff_unique_mem.2 ⟨replicate_mem_sym (mem_singleton.2 rfl) _, + λ s hs, sym.eq_replicate_iff.2 $ λ b hb, eq_of_mem_singleton $ mem_sym_iff.1 hs _ hb⟩ lemma eq_empty_of_sym_eq_empty (h : s.sym n = ∅) : s = ∅ := begin @@ -139,10 +144,6 @@ end @[simp] lemma sym_nonempty : (s.sym n).nonempty ↔ n = 0 ∨ s.nonempty := by simp_rw [nonempty_iff_ne_empty, ne.def, sym_eq_empty, not_and_distrib, not_ne_iff] -alias sym2_nonempty ↔ _ finset.nonempty.sym2 - -attribute [protected] finset.nonempty.sym2 - @[simp] lemma sym_univ [fintype α] (n : ℕ) : (univ : finset α).sym n = univ := eq_univ_iff_forall.2 $ λ s, mem_sym_iff.2 $ λ a _, mem_univ _ @@ -155,5 +156,29 @@ by { ext m, simp only [mem_inter, mem_sym_iff, imp_and_distrib, forall_and_distr @[simp] lemma sym_union (s t : finset α) (n : ℕ) : s.sym n ∪ t.sym n ⊆ (s ∪ t).sym n := union_subset (sym_mono (subset_union_left s t) n) (sym_mono (subset_union_right s t) n) +lemma sym_fill_mem (a : α) {i : fin (n + 1)} {m : sym α (n - i)} (h : m ∈ s.sym (n - i)) : + m.fill a i ∈ (insert a s).sym n := +mem_sym_iff.2 $ λ b hb, mem_insert.2 $ (sym.mem_fill_iff.1 hb).imp and.right $ mem_sym_iff.1 h b + +lemma sym_filter_ne_mem (a : α) (h : m ∈ s.sym n) : + (m.filter_ne a).2 ∈ (s.erase a).sym (n - (m.filter_ne a).1) := +mem_sym_iff.2 $ λ b H, mem_erase.2 $ (multiset.mem_filter.1 H).symm.imp ne.symm $ mem_sym_iff.1 h b + +/-- If `a` does not belong to the finset `s`, then the `n`th symmetric power of `{a} ∪ s` is + in 1-1 correspondence with the disjoint union of the `n - i`th symmetric powers of `s`, + for `0 ≤ i ≤ n`. -/ +@[simps] def sym_insert_equiv (h : a ∉ s) : (insert a s).sym n ≃ Σ i : fin (n + 1), s.sym (n - i) := +{ to_fun := λ m, ⟨_, (m.1.filter_ne a).2, by convert sym_filter_ne_mem a m.2; rw erase_insert h⟩, + inv_fun := λ m, ⟨m.2.1.fill a m.1, sym_fill_mem a m.2.2⟩, + left_inv := λ m, subtype.ext $ m.1.fill_filter_ne a, + right_inv := λ ⟨i, m, hm⟩, begin + refine (_ : id.injective).sigma_map (λ i, _) _, + { exact λ i, sym α (n - i) }, + swap, { exact λ _ _, id }, + swap, { exact subtype.coe_injective }, + refine eq.trans _ (sym.filter_ne_fill a _ _), + exacts [rfl, h ∘ mem_sym_iff.1 hm a], + end } + end sym end finset diff --git a/src/data/finsupp/alist.lean b/src/data/finsupp/alist.lean new file mode 100644 index 0000000000000..fd8e54be5a929 --- /dev/null +++ b/src/data/finsupp/alist.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2022 Violeta Hernández. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Violeta Hernández +-/ +import data.finsupp.basic +import data.list.alist + +/-! +# Connections between `finsupp` and `alist` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `finsupp.to_alist` +* `alist.lookup_finsupp`: converts an association list into a finitely supported function + via `alist.lookup`, sending absent keys to zero. + +-/ + +namespace finsupp +variables {α M : Type*} [has_zero M] + +/-- Produce an association list for the finsupp over its support using choice. -/ +@[simps] noncomputable def to_alist (f : α →₀ M) : alist (λ x : α, M) := +⟨f.graph.to_list.map prod.to_sigma, begin + rw [list.nodupkeys, list.keys, list.map_map, prod.fst_comp_to_sigma, list.nodup_map_iff_inj_on], + { rintros ⟨b, m⟩ hb ⟨c, n⟩ hc (rfl : b = c), + rw [finset.mem_to_list, finsupp.mem_graph_iff] at hb hc, + dsimp at hb hc, + rw [←hc.1, hb.1] }, + { apply finset.nodup_to_list } +end⟩ + +@[simp] lemma to_alist_keys_to_finset [decidable_eq α] (f : α →₀ M) : + f.to_alist.keys.to_finset = f.support := +by { ext, simp [to_alist, alist.mem_keys, alist.keys, list.keys] } + +@[simp] lemma mem_to_alist {f : α →₀ M} {x : α} : x ∈ f.to_alist ↔ f x ≠ 0 := +begin + classical, + rw [alist.mem_keys, ←list.mem_to_finset, to_alist_keys_to_finset, mem_support_iff] +end + +end finsupp + +namespace alist +variables {α M : Type*} [has_zero M] +open list + +/-- Converts an association list into a finitely supported function via `alist.lookup`, sending +absent keys to zero. -/ +noncomputable def lookup_finsupp (l : alist (λ x : α, M)) : α →₀ M := +{ support := by haveI := classical.dec_eq α; haveI := classical.dec_eq M; exact + (l.1.filter $ λ x, sigma.snd x ≠ 0).keys.to_finset, + to_fun := λ a, by haveI := classical.dec_eq α; exact (l.lookup a).get_or_else 0, + mem_support_to_fun := λ a, begin + classical, + simp_rw [mem_to_finset, list.mem_keys, list.mem_filter, ←mem_lookup_iff], + cases lookup a l; + simp + end } + +@[simp] lemma lookup_finsupp_apply [decidable_eq α] (l : alist (λ x : α, M)) (a : α) : + l.lookup_finsupp a = (l.lookup a).get_or_else 0 := +by convert rfl + +@[simp] lemma lookup_finsupp_support [decidable_eq α] [decidable_eq M] (l : alist (λ x : α, M)) : + l.lookup_finsupp.support = (l.1.filter $ λ x, sigma.snd x ≠ 0).keys.to_finset := +by convert rfl + +lemma lookup_finsupp_eq_iff_of_ne_zero [decidable_eq α] + {l : alist (λ x : α, M)} {a : α} {x : M} (hx : x ≠ 0) : + l.lookup_finsupp a = x ↔ x ∈ l.lookup a := +by { rw lookup_finsupp_apply, cases lookup a l with m; simp [hx.symm] } + +lemma lookup_finsupp_eq_zero_iff [decidable_eq α] {l : alist (λ x : α, M)} {a : α} : + l.lookup_finsupp a = 0 ↔ a ∉ l ∨ (0 : M) ∈ l.lookup a := +by { rw [lookup_finsupp_apply, ←lookup_eq_none], cases lookup a l with m; simp } + +@[simp] lemma empty_lookup_finsupp : lookup_finsupp (∅ : alist (λ x : α, M)) = 0 := +by { classical, ext, simp } + +@[simp] lemma insert_lookup_finsupp [decidable_eq α] (l : alist (λ x : α, M)) (a : α) (m : M) : + (l.insert a m).lookup_finsupp = l.lookup_finsupp.update a m := +by { ext b, by_cases h : b = a; simp [h] } + +@[simp] lemma singleton_lookup_finsupp (a : α) (m : M) : + (singleton a m).lookup_finsupp = finsupp.single a m := +by { classical, simp [←alist.insert_empty] } + +@[simp] lemma _root_.finsupp.to_alist_lookup_finsupp (f : α →₀ M) : f.to_alist.lookup_finsupp = f := +begin + ext, + classical, + by_cases h : f a = 0, + { suffices : f.to_alist.lookup a = none, + { simp [h, this] }, + { simp [lookup_eq_none, h] } }, + { suffices : f.to_alist.lookup a = some (f a), + { simp [h, this] }, + { apply mem_lookup_iff.2, + simpa using h } } +end + +lemma lookup_finsupp_surjective : function.surjective (@lookup_finsupp α M _) := +λ f, ⟨_, finsupp.to_alist_lookup_finsupp f⟩ + +end alist diff --git a/src/data/finsupp/antidiagonal.lean b/src/data/finsupp/antidiagonal.lean index 769145608c0b8..388c8dcdfb787 100644 --- a/src/data/finsupp/antidiagonal.lean +++ b/src/data/finsupp/antidiagonal.lean @@ -9,6 +9,9 @@ import data.multiset.antidiagonal /-! # The `finsupp` counterpart of `multiset.antidiagonal`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The antidiagonal of `s : α →₀ ℕ` consists of all pairs `(t₁, t₂) : (α →₀ ℕ) × (α →₀ ℕ)` such that `t₁ + t₂ = s`. -/ diff --git a/src/data/finsupp/basic.lean b/src/data/finsupp/basic.lean index 473f2a0a7af0f..8e49f3d64eff3 100644 --- a/src/data/finsupp/basic.lean +++ b/src/data/finsupp/basic.lean @@ -3,74 +3,31 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Scott Morrison -/ +import algebra.big_operators.finsupp import algebra.hom.group_action -import algebra.indicator_function +import algebra.regular.smul import data.finset.preimage +import data.rat.big_operators /-! -# Type of functions with finite support +# Miscellaneous definitions, lemmas, and constructions using finsupp -For any type `α` and a type `M` with zero, we define the type `finsupp α M` (notation: `α →₀ M`) -of finitely supported functions from `α` to `M`, i.e. the functions which are zero everywhere -on `α` except on a finite set. - -Functions with finite support are used (at least) in the following parts of the library: - -* `monoid_algebra R M` and `add_monoid_algebra R M` are defined as `M →₀ R`; - -* polynomials and multivariate polynomials are defined as `add_monoid_algebra`s, hence they use - `finsupp` under the hood; - -* the linear combination of a family of vectors `v i` with coefficients `f i` (as used, e.g., to - define linearly independent family `linear_independent`) is defined as a map - `finsupp.total : (ι → M) → (ι →₀ R) →ₗ[R] M`. - -Some other constructions are naturally equivalent to `α →₀ M` with some `α` and `M` but are defined -in a different way in the library: - -* `multiset α ≃+ α →₀ ℕ`; -* `free_abelian_group α ≃+ α →₀ ℤ`. - -Most of the theory assumes that the range is a commutative additive monoid. This gives us the big -sum operator as a powerful way to construct `finsupp` elements. - -Many constructions based on `α →₀ M` use `semireducible` type tags to avoid reusing unwanted type -instances. E.g., `monoid_algebra`, `add_monoid_algebra`, and types based on these two have -non-pointwise multiplication. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. ## Main declarations -* `finsupp`: The type of finitely supported functions from `α` to `β`. -* `finsupp.single`: The `finsupp` which is nonzero in exactly one point. -* `finsupp.update`: Changes one value of a `finsupp`. -* `finsupp.erase`: Replaces one value of a `finsupp` by `0`. -* `finsupp.on_finset`: The restriction of a function to a `finset` as a `finsupp`. -* `finsupp.map_range`: Composition of a `zero_hom` with a`finsupp`. -* `finsupp.emb_domain`: Maps the domain of a `finsupp` by an embedding. -* `finsupp.map_domain`: Maps the domain of a `finsupp` by a function and by summing. -* `finsupp.comap_domain`: Postcomposition of a `finsupp` with a function injective on the preimage +* `finsupp.graph`: the finset of input and output pairs with non-zero outputs. +* `finsupp.map_range.equiv`: `finsupp.map_range` as an equiv. +* `finsupp.map_domain`: maps the domain of a `finsupp` by a function and by summing. +* `finsupp.comap_domain`: postcomposition of a `finsupp` with a function injective on the preimage of its support. -* `finsupp.zip_with`: Postcomposition of two `finsupp`s with a function `f` such that `f 0 0 = 0`. -* `finsupp.sum`: Sum of the values of a `finsupp`. -* `finsupp.prod`: Product of the nonzero values of a `finsupp`. - -## Notations - -This file adds `α →₀ M` as a global notation for `finsupp α M`. - -We also use the following convention for `Type*` variables in this file - -* `α`, `β`, `γ`: types with no additional structure that appear as the first argument to `finsupp` - somewhere in the statement; - -* `ι` : an auxiliary index type; - -* `M`, `M'`, `N`, `P`: types with `has_zero` or `(add_)(comm_)monoid` structure; `M` is also used - for a (semi)module over a (semi)ring. - -* `G`, `H`: groups (commutative or not, multiplicative or additive); - -* `R`, `S`: (semi)rings. +* `finsupp.some`: restrict a finitely supported function on `option α` to a finitely supported + function on `α`. +* `finsupp.filter`: `filter p f` is the finitely supported function that is `f a` if `p a` is true + and 0 otherwise. +* `finsupp.frange`: the image of a finitely supported function on its support. +* `finsupp.subtype_domain`: the restriction of a finitely supported function `f` to a subtype. ## Implementation notes @@ -78,9 +35,8 @@ This file is a `noncomputable theory` and uses classical logic throughout. ## TODO -* This file is currently ~2.7K lines long, so it should be splitted into smaller chunks. - One option would be to move all the sum and product stuff to `algebra.big_operators.finsupp` and - move the definitions that depend on it to new files under `data.finsupp.`. +* This file is currently ~1600 lines long and is quite a miscellany of definitions and lemmas, + so it should be divided into smaller pieces. * Expand the list of definitions and important lemmas to the module docstring. @@ -89,1325 +45,80 @@ This file is a `noncomputable theory` and uses classical logic throughout. noncomputable theory open finset function -open_locale classical big_operators +open_locale big_operators variables {α β γ ι M M' N P G H R S : Type*} -/-- `finsupp α M`, denoted `α →₀ M`, is the type of functions `f : α → M` such that - `f x = 0` for all but finitely many `x`. -/ -structure finsupp (α : Type*) (M : Type*) [has_zero M] := -(support : finset α) -(to_fun : α → M) -(mem_support_to_fun : ∀a, a ∈ support ↔ to_fun a ≠ 0) - -infixr ` →₀ `:25 := finsupp - namespace finsupp -/-! ### Basic declarations about `finsupp` -/ - -section basic -variable [has_zero M] - -instance fun_like : fun_like (α →₀ M) α (λ _, M) := ⟨to_fun, begin - rintro ⟨s, f, hf⟩ ⟨t, g, hg⟩ (rfl : f = g), - congr', - ext a, - exact (hf _).trans (hg _).symm, -end⟩ - -/-- Helper instance for when there are too many metavariables to apply `fun_like.has_coe_to_fun` -directly. -/ -instance : has_coe_to_fun (α →₀ M) (λ _, α → M) := fun_like.has_coe_to_fun - -@[ext] lemma ext {f g : α →₀ M} (h : ∀ a, f a = g a) : f = g := fun_like.ext _ _ h -/-- Deprecated. Use `fun_like.ext_iff` instead. -/ -lemma ext_iff {f g : α →₀ M} : f = g ↔ ∀ a, f a = g a := fun_like.ext_iff -/-- Deprecated. Use `fun_like.coe_fn_eq` instead. -/ -lemma coe_fn_inj {f g : α →₀ M} : (f : α → M) = g ↔ f = g := fun_like.coe_fn_eq -/-- Deprecated. Use `fun_like.coe_injective` instead. -/ -lemma coe_fn_injective : @function.injective (α →₀ M) (α → M) coe_fn := fun_like.coe_injective -/-- Deprecated. Use `fun_like.congr_fun` instead. -/ -lemma congr_fun {f g : α →₀ M} (h : f = g) (a : α) : f a = g a := fun_like.congr_fun h _ - -@[simp] lemma coe_mk (f : α → M) (s : finset α) (h : ∀ a, a ∈ s ↔ f a ≠ 0) : - ⇑(⟨s, f, h⟩ : α →₀ M) = f := rfl - -instance : has_zero (α →₀ M) := ⟨⟨∅, 0, λ _, ⟨false.elim, λ H, H rfl⟩⟩⟩ - -@[simp] lemma coe_zero : ⇑(0 : α →₀ M) = 0 := rfl -lemma zero_apply {a : α} : (0 : α →₀ M) a = 0 := rfl -@[simp] lemma support_zero : (0 : α →₀ M).support = ∅ := rfl - -instance : inhabited (α →₀ M) := ⟨0⟩ - -@[simp] lemma mem_support_iff {f : α →₀ M} : ∀{a:α}, a ∈ f.support ↔ f a ≠ 0 := -f.mem_support_to_fun - -@[simp, norm_cast] lemma fun_support_eq (f : α →₀ M) : function.support f = f.support := -set.ext $ λ x, mem_support_iff.symm - -lemma not_mem_support_iff {f : α →₀ M} {a} : a ∉ f.support ↔ f a = 0 := -not_iff_comm.1 mem_support_iff.symm - -@[simp, norm_cast] lemma coe_eq_zero {f : α →₀ M} : (f : α → M) = 0 ↔ f = 0 := -by rw [← coe_zero, coe_fn_inj] - -lemma ext_iff' {f g : α →₀ M} : f = g ↔ f.support = g.support ∧ ∀ x ∈ f.support, f x = g x := -⟨λ h, h ▸ ⟨rfl, λ _ _, rfl⟩, λ ⟨h₁, h₂⟩, ext $ λ a, - if h : a ∈ f.support then h₂ a h else - have hf : f a = 0, from not_mem_support_iff.1 h, - have hg : g a = 0, by rwa [h₁, not_mem_support_iff] at h, - by rw [hf, hg]⟩ - -@[simp] lemma support_eq_empty {f : α →₀ M} : f.support = ∅ ↔ f = 0 := -by exact_mod_cast @function.support_eq_empty_iff _ _ _ f - -lemma support_nonempty_iff {f : α →₀ M} : f.support.nonempty ↔ f ≠ 0 := -by simp only [finsupp.support_eq_empty, finset.nonempty_iff_ne_empty, ne.def] - -lemma nonzero_iff_exists {f : α →₀ M} : f ≠ 0 ↔ ∃ a : α, f a ≠ 0 := -by simp [← finsupp.support_eq_empty, finset.eq_empty_iff_forall_not_mem] - -lemma card_support_eq_zero {f : α →₀ M} : card f.support = 0 ↔ f = 0 := -by simp - -instance [decidable_eq α] [decidable_eq M] : decidable_eq (α →₀ M) := -assume f g, decidable_of_iff (f.support = g.support ∧ (∀a∈f.support, f a = g a)) ext_iff'.symm - -lemma finite_support (f : α →₀ M) : set.finite (function.support f) := -f.fun_support_eq.symm ▸ f.support.finite_to_set - -lemma support_subset_iff {s : set α} {f : α →₀ M} : - ↑f.support ⊆ s ↔ (∀a∉s, f a = 0) := -by simp only [set.subset_def, mem_coe, mem_support_iff]; - exact forall_congr (assume a, not_imp_comm) - -/-- Given `fintype α`, `equiv_fun_on_fintype` is the `equiv` between `α →₀ β` and `α → β`. - (All functions on a finite type are finitely supported.) -/ -@[simps] def equiv_fun_on_fintype [fintype α] : (α →₀ M) ≃ (α → M) := -⟨λf a, f a, λf, mk (finset.univ.filter $ λa, f a ≠ 0) f (by simp only [true_and, finset.mem_univ, - iff_self, finset.mem_filter, finset.filter_congr_decidable, forall_true_iff]), - begin intro f, ext a, refl end, - begin intro f, ext a, refl end⟩ - -@[simp] lemma equiv_fun_on_fintype_symm_coe {α} [fintype α] (f : α →₀ M) : - equiv_fun_on_fintype.symm f = f := -by { ext, simp [equiv_fun_on_fintype], } - -/-- If `α` has a unique term, -then the type of finitely supported functions `α →₀ β` is equivalent to `β`. -/ -@[simps] noncomputable -def _root_.equiv.finsupp_unique {ι : Type*} [unique ι] : (ι →₀ M) ≃ M := -finsupp.equiv_fun_on_fintype.trans (equiv.fun_unique ι M) - -end basic +/-! ### Declarations about `graph` -/ -/-! ### Declarations about `single` -/ +section graph -section single -variables [has_zero M] {a a' : α} {b : M} - -/-- `single a b` is the finitely supported function which has - value `b` at `a` and zero otherwise. -/ -def single (a : α) (b : M) : α →₀ M := -⟨if b = 0 then ∅ else {a}, λ a', if a = a' then b else 0, λ a', begin - by_cases hb : b = 0; by_cases a = a'; - simp only [hb, h, if_pos, if_false, mem_singleton], - { exact ⟨false.elim, λ H, H rfl⟩ }, - { exact ⟨false.elim, λ H, H rfl⟩ }, - { exact ⟨λ _, hb, λ _, rfl⟩ }, - { exact ⟨λ H _, h H.symm, λ H, (H rfl).elim⟩ } -end⟩ - -lemma single_apply [decidable (a = a')] : single a b a' = if a = a' then b else 0 := -by convert rfl - -lemma single_eq_indicator : ⇑(single a b) = set.indicator {a} (λ _, b) := -by { ext, simp [single_apply, set.indicator, @eq_comm _ a] } - -@[simp] lemma single_eq_same : (single a b : α →₀ M) a = b := -if_pos rfl - -@[simp] lemma single_eq_of_ne (h : a ≠ a') : (single a b : α →₀ M) a' = 0 := -if_neg h - -lemma single_eq_update [decidable_eq α] : ⇑(single a b) = function.update 0 a b := -by rw [single_eq_indicator, ← set.piecewise_eq_indicator, set.piecewise_singleton] - -lemma single_eq_pi_single [decidable_eq α] : ⇑(single a b) = pi.single a b := -single_eq_update - -@[simp] lemma single_zero : (single a 0 : α →₀ M) = 0 := -coe_fn_injective $ by simpa only [single_eq_update, coe_zero] - using function.update_eq_self a (0 : α → M) - -lemma single_of_single_apply (a a' : α) (b : M) : - single a ((single a' b) a) = single a' (single a' b) a := -begin - rw [single_apply, single_apply], - ext, - split_ifs, - { rw h, }, - { rw [zero_apply, single_apply, if_t_t], }, -end - -lemma support_single_ne_zero (hb : b ≠ 0) : (single a b).support = {a} := -if_neg hb - -lemma support_single_subset : (single a b).support ⊆ {a} := -show ite _ _ _ ⊆ _, by split_ifs; [exact empty_subset _, exact subset.refl _] - -lemma single_apply_mem (x) : single a b x ∈ ({0, b} : set M) := -by rcases em (a = x) with (rfl|hx); [simp, simp [single_eq_of_ne hx]] - -lemma range_single_subset : set.range (single a b) ⊆ {0, b} := -set.range_subset_iff.2 single_apply_mem - -/-- `finsupp.single a b` is injective in `b`. For the statement that it is injective in `a`, see -`finsupp.single_left_injective` -/ -lemma single_injective (a : α) : function.injective (single a : M → α →₀ M) := -assume b₁ b₂ eq, -have (single a b₁ : α →₀ M) a = (single a b₂ : α →₀ M) a, by rw eq, -by rwa [single_eq_same, single_eq_same] at this - -lemma single_apply_eq_zero {a x : α} {b : M} : single a b x = 0 ↔ (x = a → b = 0) := -by simp [single_eq_indicator] - -lemma single_apply_ne_zero {a x : α} {b : M} : single a b x ≠ 0 ↔ (x = a ∧ b ≠ 0) := -by simp [single_apply_eq_zero] +variable [has_zero M] -lemma mem_support_single (a a' : α) (b : M) : - a ∈ (single a' b).support ↔ a = a' ∧ b ≠ 0 := -by simp [single_apply_eq_zero, not_or_distrib] +/-- The graph of a finitely supported function over its support, i.e. the finset of input and output +pairs with non-zero outputs. -/ +def graph (f : α →₀ M) : finset (α × M) := +f.support.map ⟨λ a, prod.mk a (f a), λ x y h, (prod.mk.inj h).1⟩ -lemma eq_single_iff {f : α →₀ M} {a b} : f = single a b ↔ f.support ⊆ {a} ∧ f a = b := -begin - refine ⟨λ h, h.symm ▸ ⟨support_single_subset, single_eq_same⟩, _⟩, - rintro ⟨h, rfl⟩, - ext x, - by_cases hx : a = x; simp only [hx, single_eq_same, single_eq_of_ne, ne.def, not_false_iff], - exact not_mem_support_iff.1 (mt (λ hx, (mem_singleton.1 (h hx)).symm) hx) -end - -lemma single_eq_single_iff (a₁ a₂ : α) (b₁ b₂ : M) : - single a₁ b₁ = single a₂ b₂ ↔ ((a₁ = a₂ ∧ b₁ = b₂) ∨ (b₁ = 0 ∧ b₂ = 0)) := +lemma mk_mem_graph_iff {a : α} {m : M} {f : α →₀ M} : (a, m) ∈ f.graph ↔ f a = m ∧ m ≠ 0 := begin + simp_rw [graph, mem_map, mem_support_iff], split, - { assume eq, - by_cases a₁ = a₂, - { refine or.inl ⟨h, _⟩, - rwa [h, (single_injective a₂).eq_iff] at eq }, - { rw [ext_iff] at eq, - have h₁ := eq a₁, - have h₂ := eq a₂, - simp only [single_eq_same, single_eq_of_ne h, single_eq_of_ne (ne.symm h)] at h₁ h₂, - exact or.inr ⟨h₁, h₂.symm⟩ } }, - { rintros (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩), - { refl }, - { rw [single_zero, single_zero] } } -end - -/-- `finsupp.single a b` is injective in `a`. For the statement that it is injective in `b`, see -`finsupp.single_injective` -/ -lemma single_left_injective (h : b ≠ 0) : function.injective (λ a : α, single a b) := -λ a a' H, (((single_eq_single_iff _ _ _ _).mp H).resolve_right $ λ hb, h hb.1).left - -lemma single_left_inj (h : b ≠ 0) : single a b = single a' b ↔ a = a' := -(single_left_injective h).eq_iff - -lemma support_single_ne_bot (i : α) (h : b ≠ 0) : - (single i b).support ≠ ⊥ := -by simpa only [support_single_ne_zero h] using singleton_ne_empty _ - -lemma support_single_disjoint [decidable_eq α] {b' : M} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : α} : - disjoint (single i b).support (single j b').support ↔ i ≠ j := -by rw [support_single_ne_zero hb, support_single_ne_zero hb', disjoint_singleton] - -@[simp] lemma single_eq_zero : single a b = 0 ↔ b = 0 := -by simp [ext_iff, single_eq_indicator] - -lemma single_swap (a₁ a₂ : α) (b : M) : single a₁ b a₂ = single a₂ b a₁ := -by simp only [single_apply]; ac_refl - -instance [nonempty α] [nontrivial M] : nontrivial (α →₀ M) := -begin - inhabit α, - rcases exists_ne (0 : M) with ⟨x, hx⟩, - exact nontrivial_of_ne (single default x) 0 (mt single_eq_zero.1 hx) -end - -lemma unique_single [unique α] (x : α →₀ M) : x = single default (x default) := -ext $ unique.forall_iff.2 single_eq_same.symm - -@[ext] -lemma unique_ext [unique α] {f g : α →₀ M} (h : f default = g default) : f = g := -ext $ λ a, by rwa [unique.eq_default a] - -lemma unique_ext_iff [unique α] {f g : α →₀ M} : f = g ↔ f default = g default := -⟨λ h, h ▸ rfl, unique_ext⟩ - -@[simp] lemma unique_single_eq_iff [unique α] {b' : M} : - single a b = single a' b' ↔ b = b' := -by rw [unique_ext_iff, unique.eq_default a, unique.eq_default a', single_eq_same, single_eq_same] - -lemma support_eq_singleton {f : α →₀ M} {a : α} : - f.support = {a} ↔ f a ≠ 0 ∧ f = single a (f a) := -⟨λ h, ⟨mem_support_iff.1 $ h.symm ▸ finset.mem_singleton_self a, - eq_single_iff.2 ⟨subset_of_eq h, rfl⟩⟩, λ h, h.2.symm ▸ support_single_ne_zero h.1⟩ - -lemma support_eq_singleton' {f : α →₀ M} {a : α} : - f.support = {a} ↔ ∃ b ≠ 0, f = single a b := -⟨λ h, let h := support_eq_singleton.1 h in ⟨_, h.1, h.2⟩, - λ ⟨b, hb, hf⟩, hf.symm ▸ support_single_ne_zero hb⟩ - -lemma card_support_eq_one {f : α →₀ M} : card f.support = 1 ↔ ∃ a, f a ≠ 0 ∧ f = single a (f a) := -by simp only [card_eq_one, support_eq_singleton] - -lemma card_support_eq_one' {f : α →₀ M} : card f.support = 1 ↔ ∃ a (b ≠ 0), f = single a b := -by simp only [card_eq_one, support_eq_singleton'] - -lemma support_subset_singleton {f : α →₀ M} {a : α} : - f.support ⊆ {a} ↔ f = single a (f a) := -⟨λ h, eq_single_iff.mpr ⟨h, rfl⟩, λ h, (eq_single_iff.mp h).left⟩ - -lemma support_subset_singleton' {f : α →₀ M} {a : α} : - f.support ⊆ {a} ↔ ∃ b, f = single a b := -⟨λ h, ⟨f a, support_subset_singleton.mp h⟩, - λ ⟨b, hb⟩, by rw [hb, support_subset_singleton, single_eq_same]⟩ - -lemma card_support_le_one [nonempty α] {f : α →₀ M} : - card f.support ≤ 1 ↔ ∃ a, f = single a (f a) := -by simp only [card_le_one_iff_subset_singleton, support_subset_singleton] - -lemma card_support_le_one' [nonempty α] {f : α →₀ M} : - card f.support ≤ 1 ↔ ∃ a b, f = single a b := -by simp only [card_le_one_iff_subset_singleton, support_subset_singleton'] - -@[simp] lemma equiv_fun_on_fintype_single [decidable_eq α] [fintype α] (x : α) (m : M) : - (@finsupp.equiv_fun_on_fintype α M _ _) (finsupp.single x m) = pi.single x m := -by { ext, simp [finsupp.single_eq_pi_single, finsupp.equiv_fun_on_fintype], } - -@[simp] lemma equiv_fun_on_fintype_symm_single [decidable_eq α] [fintype α] (x : α) (m : M) : - (@finsupp.equiv_fun_on_fintype α M _ _).symm (pi.single x m) = finsupp.single x m := -by { ext, simp [finsupp.single_eq_pi_single, finsupp.equiv_fun_on_fintype], } - -end single - -/-! ### Declarations about `update` -/ - -section update - -variables [has_zero M] (f : α →₀ M) (a : α) (b : M) (i : α) - -/-- Replace the value of a `α →₀ M` at a given point `a : α` by a given value `b : M`. -If `b = 0`, this amounts to removing `a` from the `finsupp.support`. -Otherwise, if `a` was not in the `finsupp.support`, it is added to it. - -This is the finitely-supported version of `function.update`. -/ -def update : α →₀ M := -⟨if b = 0 then f.support.erase a else insert a f.support, - function.update f a b, - λ i, begin - simp only [function.update_apply, ne.def], - split_ifs with hb ha ha hb; - simp [ha, hb] - end⟩ - -@[simp] lemma coe_update [decidable_eq α] : (f.update a b : α → M) = function.update f a b := -by convert rfl -@[simp] lemma update_self : f.update a (f a) = f := -by { ext, simp } - -lemma support_update [decidable_eq α] : support (f.update a b) = - if b = 0 then f.support.erase a else insert a f.support := by convert rfl - -@[simp] lemma support_update_zero [decidable_eq α] : - support (f.update a 0) = f.support.erase a := by convert if_pos rfl - -variables {b} - -lemma support_update_ne_zero [decidable_eq α] (h : b ≠ 0) : - support (f.update a b) = insert a f.support := by convert if_neg h - -end update - -/-! ### Declarations about `on_finset` -/ - -section on_finset -variables [has_zero M] - -/-- `on_finset s f hf` is the finsupp function representing `f` restricted to the finset `s`. - The function needs to be `0` outside of `s`. Use this when the set needs to be filtered anyways, - otherwise a better set representation is often available. -/ -def on_finset (s : finset α) (f : α → M) (hf : ∀a, f a ≠ 0 → a ∈ s) : α →₀ M := -⟨s.filter (λa, f a ≠ 0), f, by simpa⟩ - -@[simp] lemma on_finset_apply {s : finset α} {f : α → M} {hf a} : - (on_finset s f hf : α →₀ M) a = f a := -rfl - -@[simp] lemma support_on_finset_subset {s : finset α} {f : α → M} {hf} : - (on_finset s f hf).support ⊆ s := -filter_subset _ _ - -@[simp] lemma mem_support_on_finset - {s : finset α} {f : α → M} (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) {a : α} : - a ∈ (finsupp.on_finset s f hf).support ↔ f a ≠ 0 := -by rw [finsupp.mem_support_iff, finsupp.on_finset_apply] - -lemma support_on_finset - {s : finset α} {f : α → M} (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) : - (finsupp.on_finset s f hf).support = s.filter (λ a, f a ≠ 0) := -rfl - -end on_finset - -section of_support_finite - -variables [has_zero M] - -/-- The natural `finsupp` induced by the function `f` given that it has finite support. -/ -noncomputable def of_support_finite - (f : α → M) (hf : (function.support f).finite) : α →₀ M := -{ support := hf.to_finset, - to_fun := f, - mem_support_to_fun := λ _, hf.mem_to_finset } - -lemma of_support_finite_coe {f : α → M} {hf : (function.support f).finite} : - (of_support_finite f hf : α → M) = f := rfl - -instance : can_lift (α → M) (α →₀ M) := -{ coe := coe_fn, - cond := λ f, (function.support f).finite, - prf := λ f hf, ⟨of_support_finite f hf, rfl⟩ } - -end of_support_finite - -/-! ### Declarations about `map_range` -/ - -section map_range -variables [has_zero M] [has_zero N] [has_zero P] - -/-- The composition of `f : M → N` and `g : α →₀ M` is -`map_range f hf g : α →₀ N`, well-defined when `f 0 = 0`. - -This preserves the structure on `f`, and exists in various bundled forms for when `f` is itself -bundled: - -* `finsupp.map_range.equiv` -* `finsupp.map_range.zero_hom` -* `finsupp.map_range.add_monoid_hom` -* `finsupp.map_range.add_equiv` -* `finsupp.map_range.linear_map` -* `finsupp.map_range.linear_equiv` --/ -def map_range (f : M → N) (hf : f 0 = 0) (g : α →₀ M) : α →₀ N := -on_finset g.support (f ∘ g) $ - assume a, by rw [mem_support_iff, not_imp_not]; exact λ H, (congr_arg f H).trans hf - -@[simp] lemma map_range_apply {f : M → N} {hf : f 0 = 0} {g : α →₀ M} {a : α} : - map_range f hf g a = f (g a) := -rfl - -@[simp] lemma map_range_zero {f : M → N} {hf : f 0 = 0} : map_range f hf (0 : α →₀ M) = 0 := -ext $ λ a, by simp only [hf, zero_apply, map_range_apply] - -@[simp] lemma map_range_id (g : α →₀ M) : map_range id rfl g = g := -ext $ λ _, rfl - -lemma map_range_comp - (f : N → P) (hf : f 0 = 0) (f₂ : M → N) (hf₂ : f₂ 0 = 0) (h : (f ∘ f₂) 0 = 0) (g : α →₀ M) : - map_range (f ∘ f₂) h g = map_range f hf (map_range f₂ hf₂ g) := -ext $ λ _, rfl - -lemma support_map_range {f : M → N} {hf : f 0 = 0} {g : α →₀ M} : - (map_range f hf g).support ⊆ g.support := -support_on_finset_subset - -@[simp] lemma map_range_single {f : M → N} {hf : f 0 = 0} {a : α} {b : M} : - map_range f hf (single a b) = single a (f b) := -ext $ λ a', show f (ite _ _ _) = ite _ _ _, by split_ifs; [refl, exact hf] - -lemma support_map_range_of_injective - {e : M → N} (he0 : e 0 = 0) (f : ι →₀ M) (he : function.injective e) : - (finsupp.map_range e he0 f).support = f.support := -begin - ext, - simp only [finsupp.mem_support_iff, ne.def, finsupp.map_range_apply], - exact he.ne_iff' he0, + { rintro ⟨b, ha, rfl, -⟩, + exact ⟨rfl, ha⟩ }, + { rintro ⟨rfl, ha⟩, + exact ⟨a, ha, rfl⟩ } end -end map_range +@[simp] lemma mem_graph_iff {c : α × M} {f : α →₀ M} : c ∈ f.graph ↔ f c.1 = c.2 ∧ c.2 ≠ 0 := +by { cases c, exact mk_mem_graph_iff } -/-! ### Declarations about `emb_domain` -/ +lemma mk_mem_graph (f : α →₀ M) {a : α} (ha : a ∈ f.support) : (a, f a) ∈ f.graph := +mk_mem_graph_iff.2 ⟨rfl, mem_support_iff.1 ha⟩ -section emb_domain -variables [has_zero M] [has_zero N] +lemma apply_eq_of_mem_graph {a : α} {m : M} {f : α →₀ M} (h : (a, m) ∈ f.graph) : f a = m := +(mem_graph_iff.1 h).1 -/-- Given `f : α ↪ β` and `v : α →₀ M`, `emb_domain f v : β →₀ M` -is the finitely supported function whose value at `f a : β` is `v a`. -For a `b : β` outside the range of `f`, it is zero. -/ -def emb_domain (f : α ↪ β) (v : α →₀ M) : β →₀ M := -begin - refine ⟨v.support.map f, λa₂, - if h : a₂ ∈ v.support.map f then v (v.support.choose (λa₁, f a₁ = a₂) _) else 0, _⟩, - { rcases finset.mem_map.1 h with ⟨a, ha, rfl⟩, - exact exists_unique.intro a ⟨ha, rfl⟩ (assume b ⟨_, hb⟩, f.injective hb) }, - { assume a₂, - split_ifs, - { simp only [h, true_iff, ne.def], - rw [← not_mem_support_iff, not_not], - apply finset.choose_mem }, - { simp only [h, ne.def, ne_self_iff_false] } } -end +@[simp] lemma not_mem_graph_snd_zero (a : α) (f : α →₀ M) : (a, (0 : M)) ∉ f.graph := +λ h, (mem_graph_iff.1 h).2.irrefl -@[simp] lemma support_emb_domain (f : α ↪ β) (v : α →₀ M) : - (emb_domain f v).support = v.support.map f := -rfl - -@[simp] lemma emb_domain_zero (f : α ↪ β) : (emb_domain f 0 : β →₀ M) = 0 := -rfl - -@[simp] lemma emb_domain_apply (f : α ↪ β) (v : α →₀ M) (a : α) : - emb_domain f v (f a) = v a := -begin - change dite _ _ _ = _, - split_ifs; rw [finset.mem_map' f] at h, - { refine congr_arg (v : α → M) (f.inj' _), - exact finset.choose_property (λa₁, f a₁ = f a) _ _ }, - { exact (not_mem_support_iff.1 h).symm } -end - -lemma emb_domain_notin_range (f : α ↪ β) (v : α →₀ M) (a : β) (h : a ∉ set.range f) : - emb_domain f v a = 0 := -begin - refine dif_neg (mt (assume h, _) h), - rcases finset.mem_map.1 h with ⟨a, h, rfl⟩, - exact set.mem_range_self a -end - -lemma emb_domain_injective (f : α ↪ β) : - function.injective (emb_domain f : (α →₀ M) → (β →₀ M)) := -λ l₁ l₂ h, ext $ λ a, by simpa only [emb_domain_apply] using ext_iff.1 h (f a) - -@[simp] lemma emb_domain_inj {f : α ↪ β} {l₁ l₂ : α →₀ M} : - emb_domain f l₁ = emb_domain f l₂ ↔ l₁ = l₂ := -(emb_domain_injective f).eq_iff - -@[simp] lemma emb_domain_eq_zero {f : α ↪ β} {l : α →₀ M} : - emb_domain f l = 0 ↔ l = 0 := -(emb_domain_injective f).eq_iff' $ emb_domain_zero f - -lemma emb_domain_map_range - (f : α ↪ β) (g : M → N) (p : α →₀ M) (hg : g 0 = 0) : - emb_domain f (map_range g hg p) = map_range g hg (emb_domain f p) := -begin - ext a, - by_cases a ∈ set.range f, - { rcases h with ⟨a', rfl⟩, - rw [map_range_apply, emb_domain_apply, emb_domain_apply, map_range_apply] }, - { rw [map_range_apply, emb_domain_notin_range, emb_domain_notin_range, ← hg]; assumption } -end - -lemma single_of_emb_domain_single - (l : α →₀ M) (f : α ↪ β) (a : β) (b : M) (hb : b ≠ 0) - (h : l.emb_domain f = single a b) : - ∃ x, l = single x b ∧ f x = a := -begin - have h_map_support : finset.map f (l.support) = {a}, - by rw [←support_emb_domain, h, support_single_ne_zero hb]; refl, - have ha : a ∈ finset.map f (l.support), - by simp only [h_map_support, finset.mem_singleton], - rcases finset.mem_map.1 ha with ⟨c, hc₁, hc₂⟩, - use c, - split, - { ext d, - rw [← emb_domain_apply f l, h], - by_cases h_cases : c = d, - { simp only [eq.symm h_cases, hc₂, single_eq_same] }, - { rw [single_apply, single_apply, if_neg, if_neg h_cases], - by_contra hfd, - exact h_cases (f.injective (hc₂.trans hfd)) } }, - { exact hc₂ } -end - -@[simp] lemma emb_domain_single (f : α ↪ β) (a : α) (m : M) : - emb_domain f (single a m) = single (f a) m := -begin - ext b, - by_cases h : b ∈ set.range f, - { rcases h with ⟨a', rfl⟩, - simp [single_apply], }, - { simp only [emb_domain_notin_range, h, single_apply, not_false_iff], - rw if_neg, - rintro rfl, - simpa using h, }, -end - -end emb_domain - -/-! ### Declarations about `zip_with` -/ - -section zip_with -variables [has_zero M] [has_zero N] [has_zero P] - -/-- `zip_with f hf g₁ g₂` is the finitely supported function satisfying - `zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a)`, and it is well-defined when `f 0 0 = 0`. -/ -def zip_with (f : M → N → P) (hf : f 0 0 = 0) (g₁ : α →₀ M) (g₂ : α →₀ N) : α →₀ P := -on_finset (g₁.support ∪ g₂.support) (λa, f (g₁ a) (g₂ a)) $ λ a H, -begin - simp only [mem_union, mem_support_iff, ne], rw [← not_and_distrib], - rintro ⟨h₁, h₂⟩, rw [h₁, h₂] at H, exact H hf -end - -@[simp] lemma zip_with_apply - {f : M → N → P} {hf : f 0 0 = 0} {g₁ : α →₀ M} {g₂ : α →₀ N} {a : α} : - zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a) := -rfl - -lemma support_zip_with [D : decidable_eq α] {f : M → N → P} {hf : f 0 0 = 0} - {g₁ : α →₀ M} {g₂ : α →₀ N} : (zip_with f hf g₁ g₂).support ⊆ g₁.support ∪ g₂.support := -by rw subsingleton.elim D; exact support_on_finset_subset - -end zip_with - -/-! ### Declarations about `erase` -/ - -section erase - -variables [has_zero M] - -/-- `erase a f` is the finitely supported function equal to `f` except at `a` where it is equal to - `0`. -/ -def erase (a : α) (f : α →₀ M) : α →₀ M := -⟨f.support.erase a, (λa', if a' = a then 0 else f a'), - assume a', by rw [mem_erase, mem_support_iff]; split_ifs; - [exact ⟨λ H _, H.1 h, λ H, (H rfl).elim⟩, - exact and_iff_right h]⟩ - -@[simp] lemma support_erase [decidable_eq α] {a : α} {f : α →₀ M} : - (f.erase a).support = f.support.erase a := -by convert rfl - -@[simp] lemma erase_same {a : α} {f : α →₀ M} : (f.erase a) a = 0 := -if_pos rfl - -@[simp] lemma erase_ne {a a' : α} {f : α →₀ M} (h : a' ≠ a) : (f.erase a) a' = f a' := -if_neg h - -@[simp] lemma erase_single {a : α} {b : M} : (erase a (single a b)) = 0 := -begin - ext s, by_cases hs : s = a, - { rw [hs, erase_same], refl }, - { rw [erase_ne hs], exact single_eq_of_ne (ne.symm hs) } -end - -lemma erase_single_ne {a a' : α} {b : M} (h : a ≠ a') : (erase a (single a' b)) = single a' b := -begin - ext s, by_cases hs : s = a, - { rw [hs, erase_same, single_eq_of_ne (h.symm)] }, - { rw [erase_ne hs] } -end - -@[simp] lemma erase_of_not_mem_support {f : α →₀ M} {a} (haf : a ∉ f.support) : erase a f = f := -begin - ext b, by_cases hab : b = a, - { rwa [hab, erase_same, eq_comm, ←not_mem_support_iff] }, - { rw erase_ne hab } -end - -@[simp] lemma erase_zero (a : α) : erase a (0 : α →₀ M) = 0 := -by rw [← support_eq_empty, support_erase, support_zero, erase_empty] - -end erase - -/-! -### Declarations about `sum` and `prod` - -In most of this section, the domain `β` is assumed to be an `add_monoid`. --/ - -section sum_prod - -/-- `prod f g` is the product of `g a (f a)` over the support of `f`. -/ -@[to_additive "`sum f g` is the sum of `g a (f a)` over the support of `f`. "] -def prod [has_zero M] [comm_monoid N] (f : α →₀ M) (g : α → M → N) : N := -∏ a in f.support, g a (f a) - -variables [has_zero M] [has_zero M'] [comm_monoid N] - -@[to_additive] -lemma prod_of_support_subset (f : α →₀ M) {s : finset α} - (hs : f.support ⊆ s) (g : α → M → N) (h : ∀ i ∈ s, g i 0 = 1) : - f.prod g = ∏ x in s, g x (f x) := -finset.prod_subset hs $ λ x hxs hx, h x hxs ▸ congr_arg (g x) $ not_mem_support_iff.1 hx - -@[to_additive] -lemma prod_fintype [fintype α] (f : α →₀ M) (g : α → M → N) (h : ∀ i, g i 0 = 1) : - f.prod g = ∏ i, g i (f i) := -f.prod_of_support_subset (subset_univ _) g (λ x _, h x) - -@[simp, to_additive] -lemma prod_single_index {a : α} {b : M} {h : α → M → N} (h_zero : h a 0 = 1) : - (single a b).prod h = h a b := -calc (single a b).prod h = ∏ x in {a}, h x (single a b x) : - prod_of_support_subset _ support_single_subset h $ λ x hx, (mem_singleton.1 hx).symm ▸ h_zero -... = h a b : by simp - -@[to_additive] -lemma prod_map_range_index {f : M → M'} {hf : f 0 = 0} {g : α →₀ M} {h : α → M' → N} - (h0 : ∀a, h a 0 = 1) : (map_range f hf g).prod h = g.prod (λa b, h a (f b)) := -finset.prod_subset support_map_range $ λ _ _ H, - by rw [not_mem_support_iff.1 H, h0] - -@[simp, to_additive] -lemma prod_zero_index {h : α → M → N} : (0 : α →₀ M).prod h = 1 := rfl - -@[to_additive] -lemma prod_comm (f : α →₀ M) (g : β →₀ M') (h : α → M → β → M' → N) : - f.prod (λ x v, g.prod (λ x' v', h x v x' v')) = g.prod (λ x' v', f.prod (λ x v, h x v x' v')) := -finset.prod_comm - -@[simp, to_additive] -lemma prod_ite_eq [decidable_eq α] (f : α →₀ M) (a : α) (b : α → M → N) : - f.prod (λ x v, ite (a = x) (b x v) 1) = ite (a ∈ f.support) (b a (f a)) 1 := -by { dsimp [finsupp.prod], rw f.support.prod_ite_eq, } - -@[simp] lemma sum_ite_self_eq - [decidable_eq α] {N : Type*} [add_comm_monoid N] (f : α →₀ N) (a : α) : - f.sum (λ x v, ite (a = x) v 0) = f a := -by { convert f.sum_ite_eq a (λ x, id), simp [ite_eq_right_iff.2 eq.symm] } - -/-- A restatement of `prod_ite_eq` with the equality test reversed. -/ -@[simp, to_additive "A restatement of `sum_ite_eq` with the equality test reversed."] -lemma prod_ite_eq' [decidable_eq α] (f : α →₀ M) (a : α) (b : α → M → N) : - f.prod (λ x v, ite (x = a) (b x v) 1) = ite (a ∈ f.support) (b a (f a)) 1 := -by { dsimp [finsupp.prod], rw f.support.prod_ite_eq', } - -@[simp] lemma sum_ite_self_eq' - [decidable_eq α] {N : Type*} [add_comm_monoid N] (f : α →₀ N) (a : α) : - f.sum (λ x v, ite (x = a) v 0) = f a := -by { convert f.sum_ite_eq' a (λ x, id), simp [ite_eq_right_iff.2 eq.symm] } - -@[simp] lemma prod_pow [fintype α] (f : α →₀ ℕ) (g : α → N) : - f.prod (λ a b, g a ^ b) = ∏ a, g a ^ (f a) := -f.prod_fintype _ $ λ a, pow_zero _ - -/-- If `g` maps a second argument of 0 to 1, then multiplying it over the -result of `on_finset` is the same as multiplying it over the original -`finset`. -/ -@[to_additive "If `g` maps a second argument of 0 to 0, summing it over the -result of `on_finset` is the same as summing it over the original -`finset`."] -lemma on_finset_prod {s : finset α} {f : α → M} {g : α → M → N} - (hf : ∀a, f a ≠ 0 → a ∈ s) (hg : ∀ a, g a 0 = 1) : - (on_finset s f hf).prod g = ∏ a in s, g a (f a) := -finset.prod_subset support_on_finset_subset $ by simp [*] { contextual := tt } - -/-- Taking a product over `f : α →₀ M` is the same as multiplying the value on a single element -`y ∈ f.support` by the product over `erase y f`. -/ -@[to_additive /-" Taking a sum over over `f : α →₀ M` is the same as adding the value on a -single element `y ∈ f.support` to the sum over `erase y f`. "-/] -lemma mul_prod_erase (f : α →₀ M) (y : α) (g : α → M → N) (hyf : y ∈ f.support) : - g y (f y) * (erase y f).prod g = f.prod g := -begin - rw [finsupp.prod, finsupp.prod, ←finset.mul_prod_erase _ _ hyf, finsupp.support_erase, - finset.prod_congr rfl], - intros h hx, - rw finsupp.erase_ne (ne_of_mem_erase hx), -end - -/-- Generalization of `finsupp.mul_prod_erase`: if `g` maps a second argument of 0 to 1, -then its product over `f : α →₀ M` is the same as multiplying the value on any element -`y : α` by the product over `erase y f`. -/ -@[to_additive /-" Generalization of `finsupp.add_sum_erase`: if `g` maps a second argument of 0 -to 0, then its sum over `f : α →₀ M` is the same as adding the value on any element -`y : α` to the sum over `erase y f`. "-/] -lemma mul_prod_erase' (f : α →₀ M) (y : α) (g : α → M → N) (hg : ∀ (i : α), g i 0 = 1) : - g y (f y) * (erase y f).prod g = f.prod g := +@[simp] lemma image_fst_graph [decidable_eq α] (f : α →₀ M) : f.graph.image prod.fst = f.support := begin classical, - by_cases hyf : y ∈ f.support, - { exact finsupp.mul_prod_erase f y g hyf }, - { rw [not_mem_support_iff.mp hyf, hg y, erase_of_not_mem_support hyf, one_mul] }, -end - -@[to_additive] -lemma _root_.submonoid_class.finsupp_prod_mem {S : Type*} [set_like S N] [submonoid_class S N] - (s : S) (f : α →₀ M) (g : α → M → N) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ s) : f.prod g ∈ s := -prod_mem $ λ i hi, h _ (finsupp.mem_support_iff.mp hi) - -@[to_additive] -lemma prod_congr {f : α →₀ M} {g1 g2 : α → M → N} - (h : ∀ x ∈ f.support, g1 x (f x) = g2 x (f x)) : f.prod g1 = f.prod g2 := -finset.prod_congr rfl h - -end sum_prod - -/-! -### Additive monoid structure on `α →₀ M` --/ - -section add_zero_class - -variables [add_zero_class M] - -instance : has_add (α →₀ M) := ⟨zip_with (+) (add_zero 0)⟩ - -@[simp] lemma coe_add (f g : α →₀ M) : ⇑(f + g) = f + g := rfl -lemma add_apply (g₁ g₂ : α →₀ M) (a : α) : (g₁ + g₂) a = g₁ a + g₂ a := rfl - -lemma support_add [decidable_eq α] {g₁ g₂ : α →₀ M} : - (g₁ + g₂).support ⊆ g₁.support ∪ g₂.support := -support_zip_with - -lemma support_add_eq [decidable_eq α] {g₁ g₂ : α →₀ M} (h : disjoint g₁.support g₂.support) : - (g₁ + g₂).support = g₁.support ∪ g₂.support := -le_antisymm support_zip_with $ assume a ha, -(finset.mem_union.1 ha).elim - (assume ha, have a ∉ g₂.support, from disjoint_left.1 h ha, - by simp only [mem_support_iff, not_not] at *; - simpa only [add_apply, this, add_zero]) - (assume ha, have a ∉ g₁.support, from disjoint_right.1 h ha, - by simp only [mem_support_iff, not_not] at *; - simpa only [add_apply, this, zero_add]) - -@[simp] lemma single_add {a : α} {b₁ b₂ : M} : single a (b₁ + b₂) = single a b₁ + single a b₂ := -ext $ assume a', -begin - by_cases h : a = a', - { rw [h, add_apply, single_eq_same, single_eq_same, single_eq_same] }, - { rw [add_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, zero_add] } + simp only [graph, map_eq_image, image_image, embedding.coe_fn_mk, (∘), image_id'], end -instance : add_zero_class (α →₀ M) := -fun_like.coe_injective.add_zero_class _ coe_zero coe_add - -/-- `finsupp.single` as an `add_monoid_hom`. - -See `finsupp.lsingle` for the stronger version as a linear map. --/ -@[simps] def single_add_hom (a : α) : M →+ α →₀ M := -⟨single a, single_zero, λ _ _, single_add⟩ - -/-- Evaluation of a function `f : α →₀ M` at a point as an additive monoid homomorphism. - -See `finsupp.lapply` for the stronger version as a linear map. -/ -@[simps apply] -def apply_add_hom (a : α) : (α →₀ M) →+ M := ⟨λ g, g a, zero_apply, λ _ _, add_apply _ _ _⟩ - -/-- Coercion from a `finsupp` to a function type is an `add_monoid_hom`. -/ -@[simps] -noncomputable def coe_fn_add_hom : (α →₀ M) →+ (α → M) := -{ to_fun := coe_fn, - map_zero' := coe_zero, - map_add' := coe_add } - -lemma update_eq_single_add_erase (f : α →₀ M) (a : α) (b : M) : - f.update a b = single a b + f.erase a := -begin - ext j, - rcases eq_or_ne a j with rfl|h, - { simp }, - { simp [function.update_noteq h.symm, single_apply, h, erase_ne, h.symm] } -end - -lemma update_eq_erase_add_single (f : α →₀ M) (a : α) (b : M) : - f.update a b = f.erase a + single a b := -begin - ext j, - rcases eq_or_ne a j with rfl|h, - { simp }, - { simp [function.update_noteq h.symm, single_apply, h, erase_ne, h.symm] } -end - -lemma single_add_erase (a : α) (f : α →₀ M) : single a (f a) + f.erase a = f := -by rw [←update_eq_single_add_erase, update_self] - -lemma erase_add_single (a : α) (f : α →₀ M) : f.erase a + single a (f a) = f := -by rw [←update_eq_erase_add_single, update_self] - -@[simp] lemma erase_add (a : α) (f f' : α →₀ M) : erase a (f + f') = erase a f + erase a f' := -begin - ext s, by_cases hs : s = a, - { rw [hs, add_apply, erase_same, erase_same, erase_same, add_zero] }, - rw [add_apply, erase_ne hs, erase_ne hs, erase_ne hs, add_apply], -end - -/-- `finsupp.erase` as an `add_monoid_hom`. -/ -@[simps] -def erase_add_hom (a : α) : (α →₀ M) →+ (α →₀ M) := -{ to_fun := erase a, map_zero' := erase_zero a, map_add' := erase_add a } - -@[elab_as_eliminator] -protected theorem induction {p : (α →₀ M) → Prop} (f : α →₀ M) - (h0 : p 0) (ha : ∀a b (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (single a b + f)) : - p f := -suffices ∀s (f : α →₀ M), f.support = s → p f, from this _ _ rfl, -assume s, finset.induction_on s (λ f hf, by rwa [support_eq_empty.1 hf]) $ -assume a s has ih f hf, -suffices p (single a (f a) + f.erase a), by rwa [single_add_erase] at this, -begin - apply ha, - { rw [support_erase, mem_erase], exact λ H, H.1 rfl }, - { rw [← mem_support_iff, hf], exact mem_insert_self _ _ }, - { apply ih _ _, - rw [support_erase, hf, finset.erase_insert has] } -end - -lemma induction₂ {p : (α →₀ M) → Prop} (f : α →₀ M) - (h0 : p 0) (ha : ∀a b (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (f + single a b)) : - p f := -suffices ∀s (f : α →₀ M), f.support = s → p f, from this _ _ rfl, -assume s, finset.induction_on s (λ f hf, by rwa [support_eq_empty.1 hf]) $ -assume a s has ih f hf, -suffices p (f.erase a + single a (f a)), by rwa [erase_add_single] at this, -begin - apply ha, - { rw [support_erase, mem_erase], exact λ H, H.1 rfl }, - { rw [← mem_support_iff, hf], exact mem_insert_self _ _ }, - { apply ih _ _, - rw [support_erase, hf, finset.erase_insert has] } -end - -lemma induction_linear {p : (α →₀ M) → Prop} (f : α →₀ M) - (h0 : p 0) (hadd : ∀ f g : α →₀ M, p f → p g → p (f + g)) (hsingle : ∀ a b, p (single a b)) : - p f := -induction₂ f h0 (λ a b f _ _ w, hadd _ _ w (hsingle _ _)) - -@[simp] lemma add_closure_set_of_eq_single : - add_submonoid.closure {f : α →₀ M | ∃ a b, f = single a b} = ⊤ := -top_unique $ λ x hx, finsupp.induction x (add_submonoid.zero_mem _) $ - λ a b f ha hb hf, add_submonoid.add_mem _ - (add_submonoid.subset_closure $ ⟨a, b, rfl⟩) hf - -/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`, then -they are equal. -/ -lemma add_hom_ext [add_zero_class N] ⦃f g : (α →₀ M) →+ N⦄ - (H : ∀ x y, f (single x y) = g (single x y)) : - f = g := -begin - refine add_monoid_hom.eq_of_eq_on_mdense add_closure_set_of_eq_single _, - rintro _ ⟨x, y, rfl⟩, - apply H -end - -/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`, then -they are equal. - -We formulate this using equality of `add_monoid_hom`s so that `ext` tactic can apply a type-specific -extensionality lemma after this one. E.g., if the fiber `M` is `ℕ` or `ℤ`, then it suffices to -verify `f (single a 1) = g (single a 1)`. -/ -@[ext] lemma add_hom_ext' [add_zero_class N] ⦃f g : (α →₀ M) →+ N⦄ - (H : ∀ x, f.comp (single_add_hom x) = g.comp (single_add_hom x)) : - f = g := -add_hom_ext $ λ x, add_monoid_hom.congr_fun (H x) - -lemma mul_hom_ext [mul_one_class N] ⦃f g : multiplicative (α →₀ M) →* N⦄ - (H : ∀ x y, f (multiplicative.of_add $ single x y) = g (multiplicative.of_add $ single x y)) : - f = g := -monoid_hom.ext $ add_monoid_hom.congr_fun $ - @add_hom_ext α M (additive N) _ _ f.to_additive'' g.to_additive'' H - -@[ext] lemma mul_hom_ext' [mul_one_class N] {f g : multiplicative (α →₀ M) →* N} - (H : ∀ x, f.comp (single_add_hom x).to_multiplicative = - g.comp (single_add_hom x).to_multiplicative) : - f = g := -mul_hom_ext $ λ x, monoid_hom.congr_fun (H x) - -lemma map_range_add [add_zero_class N] - {f : M → N} {hf : f 0 = 0} (hf' : ∀ x y, f (x + y) = f x + f y) (v₁ v₂ : α →₀ M) : - map_range f hf (v₁ + v₂) = map_range f hf v₁ + map_range f hf v₂ := -ext $ λ a, by simp only [hf', add_apply, map_range_apply] - -/-- Bundle `emb_domain f` as an additive map from `α →₀ M` to `β →₀ M`. -/ -@[simps] def emb_domain.add_monoid_hom (f : α ↪ β) : (α →₀ M) →+ β →₀ M := -{ to_fun := λ v, emb_domain f v, - map_zero' := by simp, - map_add' := λ v w, - begin - ext b, - by_cases h : b ∈ set.range f, - { rcases h with ⟨a, rfl⟩, - simp, }, - { simp [emb_domain_notin_range, h], }, - end, } - -@[simp] lemma emb_domain_add (f : α ↪ β) (v w : α →₀ M) : - emb_domain f (v + w) = emb_domain f v + emb_domain f w := -(emb_domain.add_monoid_hom f).map_add v w - -end add_zero_class - -section add_monoid - -variables [add_monoid M] - -/-- Note the general `finsupp.has_scalar` instance doesn't apply as `ℕ` is not distributive -unless `β i`'s addition is commutative. -/ -instance has_nat_scalar : has_scalar ℕ (α →₀ M) := -⟨λ n v, v.map_range ((•) n) (nsmul_zero _)⟩ - -instance : add_monoid (α →₀ M) := -fun_like.coe_injective.add_monoid _ coe_zero coe_add (λ _ _, rfl) - -end add_monoid - -end finsupp - -@[to_additive] -lemma map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] {H : Type*} - [monoid_hom_class H N P] (h : H) (f : α →₀ M) (g : α → M → N) : - h (f.prod g) = f.prod (λ a b, h (g a b)) := -map_prod h _ _ - -/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/ -@[to_additive "Deprecated, use `_root_.map_finsupp_sum` instead."] -protected lemma mul_equiv.map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] - (h : N ≃* P) (f : α →₀ M) (g : α → M → N) : h (f.prod g) = f.prod (λ a b, h (g a b)) := -map_finsupp_prod h f g - -/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/ -@[to_additive "Deprecated, use `_root_.map_finsupp_sum` instead."] -protected lemma monoid_hom.map_finsupp_prod [has_zero M] [comm_monoid N] [comm_monoid P] - (h : N →* P) (f : α →₀ M) (g : α → M → N) : h (f.prod g) = f.prod (λ a b, h (g a b)) := -map_finsupp_prod h f g - -/-- Deprecated, use `_root_.map_finsupp_sum` instead. -/ -protected lemma ring_hom.map_finsupp_sum [has_zero M] [semiring R] [semiring S] - (h : R →+* S) (f : α →₀ M) (g : α → M → R) : h (f.sum g) = f.sum (λ a b, h (g a b)) := -map_finsupp_sum h f g - -/-- Deprecated, use `_root_.map_finsupp_prod` instead. -/ -protected lemma ring_hom.map_finsupp_prod [has_zero M] [comm_semiring R] [comm_semiring S] - (h : R →+* S) (f : α →₀ M) (g : α → M → R) : h (f.prod g) = f.prod (λ a b, h (g a b)) := -map_finsupp_prod h f g - -@[to_additive] -lemma monoid_hom.coe_finsupp_prod [has_zero β] [monoid N] [comm_monoid P] - (f : α →₀ β) (g : α → β → N →* P) : - ⇑(f.prod g) = f.prod (λ i fi, g i fi) := -monoid_hom.coe_finset_prod _ _ - -@[simp, to_additive] -lemma monoid_hom.finsupp_prod_apply [has_zero β] [monoid N] [comm_monoid P] - (f : α →₀ β) (g : α → β → N →* P) (x : N) : - f.prod g x = f.prod (λ i fi, g i fi x) := -monoid_hom.finset_prod_apply _ _ _ - -namespace finsupp - -instance [add_comm_monoid M] : add_comm_monoid (α →₀ M) := -fun_like.coe_injective.add_comm_monoid _ coe_zero coe_add (λ _ _, rfl) - -instance [add_group G] : has_neg (α →₀ G) := ⟨map_range (has_neg.neg) neg_zero⟩ - -@[simp] lemma coe_neg [add_group G] (g : α →₀ G) : ⇑(-g) = -g := rfl -lemma neg_apply [add_group G] (g : α →₀ G) (a : α) : (- g) a = - g a := rfl - -instance [add_group G] : has_sub (α →₀ G) := ⟨zip_with has_sub.sub (sub_zero _)⟩ - -@[simp] lemma coe_sub [add_group G] (g₁ g₂ : α →₀ G) : ⇑(g₁ - g₂) = g₁ - g₂ := rfl -lemma sub_apply [add_group G] (g₁ g₂ : α →₀ G) (a : α) : (g₁ - g₂) a = g₁ a - g₂ a := rfl - -/-- Note the general `finsupp.has_scalar` instance doesn't apply as `ℤ` is not distributive -unless `β i`'s addition is commutative. -/ -instance has_int_scalar [add_group G] : has_scalar ℤ (α →₀ G) := -⟨λ n v, v.map_range ((•) n) (zsmul_zero _)⟩ - -instance [add_group G] : add_group (α →₀ G) := -fun_like.coe_injective.add_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl) - -instance [add_comm_group G] : add_comm_group (α →₀ G) := -fun_like.coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl) - -lemma single_multiset_sum [add_comm_monoid M] (s : multiset M) (a : α) : - single a s.sum = (s.map (single a)).sum := -multiset.induction_on s single_zero $ λ a s ih, -by rw [multiset.sum_cons, single_add, ih, multiset.map_cons, multiset.sum_cons] - -lemma single_finset_sum [add_comm_monoid M] (s : finset ι) (f : ι → M) (a : α) : - single a (∑ b in s, f b) = ∑ b in s, single a (f b) := -begin - transitivity, - apply single_multiset_sum, - rw [multiset.map_map], - refl -end - -lemma single_sum [has_zero M] [add_comm_monoid N] (s : ι →₀ M) (f : ι → M → N) (a : α) : - single a (s.sum f) = s.sum (λd c, single a (f d c)) := -single_finset_sum _ _ _ - -@[to_additive] -lemma prod_neg_index [add_group G] [comm_monoid M] {g : α →₀ G} {h : α → G → M} - (h0 : ∀a, h a 0 = 1) : - (-g).prod h = g.prod (λa b, h a (- b)) := -prod_map_range_index h0 - -@[simp] lemma support_neg [add_group G] (f : α →₀ G) : support (-f) = support f := -finset.subset.antisymm - support_map_range - (calc support f = support (- (- f)) : congr_arg support (neg_neg _).symm - ... ⊆ support (- f) : support_map_range) - -lemma support_sub [decidable_eq α] [add_group G] {f g : α →₀ G} : - support (f - g) ⊆ support f ∪ support g := -begin - rw [sub_eq_add_neg, ←support_neg g], - exact support_add, -end - -lemma erase_eq_sub_single [add_group G] (f : α →₀ G) (a : α) : - f.erase a = f - single a (f a) := -begin - ext a', - rcases eq_or_ne a a' with rfl|h, - { simp }, - { simp [erase_ne h.symm, single_eq_of_ne h] } -end - -lemma update_eq_sub_add_single [add_group G] (f : α →₀ G) (a : α) (b : G) : - f.update a b = f - single a (f a) + single a b := -by rw [update_eq_erase_add_single, erase_eq_sub_single] - -lemma finset_sum_apply [add_comm_monoid N] (S : finset ι) (f : ι → α →₀ N) (a : α) : - (∑ i in S, f i) a = ∑ i in S, f i a := -(apply_add_hom a : (α →₀ N) →+ _).map_sum _ _ - -@[simp] lemma sum_apply [has_zero M] [add_comm_monoid N] - {f : α →₀ M} {g : α → M → β →₀ N} {a₂ : β} : - (f.sum g) a₂ = f.sum (λa₁ b, g a₁ b a₂) := -finset_sum_apply _ _ _ - -lemma coe_finset_sum [add_comm_monoid N] (S : finset ι) (f : ι → α →₀ N) : - ⇑(∑ i in S, f i) = ∑ i in S, f i := -(coe_fn_add_hom : (α →₀ N) →+ _).map_sum _ _ - -lemma coe_sum [has_zero M] [add_comm_monoid N] (f : α →₀ M) (g : α → M → β →₀ N) : - ⇑(f.sum g) = f.sum (λ a₁ b, g a₁ b) := -coe_finset_sum _ _ - -lemma support_sum [decidable_eq β] [has_zero M] [add_comm_monoid N] - {f : α →₀ M} {g : α → M → (β →₀ N)} : - (f.sum g).support ⊆ f.support.bUnion (λa, (g a (f a)).support) := -have ∀ c, f.sum (λ a b, g a b c) ≠ 0 → (∃ a, f a ≠ 0 ∧ ¬ (g a (f a)) c = 0), - from assume a₁ h, - let ⟨a, ha, ne⟩ := finset.exists_ne_zero_of_sum_ne_zero h in - ⟨a, mem_support_iff.mp ha, ne⟩, -by simpa only [finset.subset_iff, mem_support_iff, finset.mem_bUnion, sum_apply, exists_prop] - -lemma support_finset_sum [decidable_eq β] [add_comm_monoid M] {s : finset α} {f : α → (β →₀ M)} : - (finset.sum s f).support ⊆ s.bUnion (λ x, (f x).support) := -begin - rw ←finset.sup_eq_bUnion, - induction s using finset.cons_induction_on with a s ha ih, - { refl }, - { rw [finset.sum_cons, finset.sup_cons], - exact support_add.trans (finset.union_subset_union (finset.subset.refl _) ih), }, -end - -@[simp] lemma sum_zero [has_zero M] [add_comm_monoid N] {f : α →₀ M} : - f.sum (λa b, (0 : N)) = 0 := -finset.sum_const_zero - -@[simp, to_additive] -lemma prod_mul [has_zero M] [comm_monoid N] {f : α →₀ M} {h₁ h₂ : α → M → N} : - f.prod (λa b, h₁ a b * h₂ a b) = f.prod h₁ * f.prod h₂ := -finset.prod_mul_distrib - -@[simp, to_additive] -lemma prod_inv [has_zero M] [comm_group G] {f : α →₀ M} - {h : α → M → G} : f.prod (λa b, (h a b)⁻¹) = (f.prod h)⁻¹ := -(map_prod ((monoid_hom.id G)⁻¹) _ _).symm - -@[simp] lemma sum_sub [has_zero M] [add_comm_group G] {f : α →₀ M} - {h₁ h₂ : α → M → G} : - f.sum (λa b, h₁ a b - h₂ a b) = f.sum h₁ - f.sum h₂ := -finset.sum_sub_distrib - -/-- Taking the product under `h` is an additive-to-multiplicative homomorphism of finsupps, -if `h` is an additive-to-multiplicative homomorphism on the support. -This is a more general version of `finsupp.prod_add_index'`; the latter has simpler hypotheses. -/ -@[to_additive "Taking the product under `h` is an additive homomorphism of finsupps, -if `h` is an additive homomorphism on the support. -This is a more general version of `finsupp.sum_add_index'`; the latter has simpler hypotheses."] -lemma prod_add_index [add_zero_class M] [comm_monoid N] {f g : α →₀ M} - {h : α → M → N} (h_zero : ∀ a ∈ f.support ∪ g.support, h a 0 = 1) - (h_add : ∀ (a ∈ f.support ∪ g.support) b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : - (f + g).prod h = f.prod h * g.prod h := -begin - rw [finsupp.prod_of_support_subset f (subset_union_left _ g.support) h h_zero, - finsupp.prod_of_support_subset g (subset_union_right f.support _) h h_zero, - ←finset.prod_mul_distrib, - finsupp.prod_of_support_subset (f + g) finsupp.support_add h h_zero], - exact finset.prod_congr rfl (λ x hx, (by apply h_add x hx)), -end - -/-- Taking the product under `h` is an additive-to-multiplicative homomorphism of finsupps, -if `h` is an additive-to-multiplicative homomorphism. -This is a more specialized version of `finsupp.prod_add_index` with simpler hypotheses. -/ -@[to_additive "Taking the product under `h` is an additive homomorphism of finsupps, -if `h` is an additive homomorphism. -This is a more specific version of `finsupp.sum_add_index` with simpler hypotheses."] -lemma prod_add_index' [add_zero_class M] [comm_monoid N] {f g : α →₀ M} - {h : α → M → N} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : - (f + g).prod h = f.prod h * g.prod h := -prod_add_index (λ a ha, h_zero a) (λ a ha, h_add a) - -@[simp] -lemma sum_hom_add_index [add_zero_class M] [add_comm_monoid N] {f g : α →₀ M} (h : α → M →+ N) : - (f + g).sum (λ x, h x) = f.sum (λ x, h x) + g.sum (λ x, h x) := -sum_add_index' (λ a, (h a).map_zero) (λ a, (h a).map_add) - -@[simp] -lemma prod_hom_add_index [add_zero_class M] [comm_monoid N] {f g : α →₀ M} - (h : α → multiplicative M →* N) : - (f + g).prod (λ a b, h a (multiplicative.of_add b)) = - f.prod (λ a b, h a (multiplicative.of_add b)) * g.prod (λ a b, h a (multiplicative.of_add b)) := -prod_add_index' (λ a, (h a).map_one) (λ a, (h a).map_mul) - - -/-- The canonical isomorphism between families of additive monoid homomorphisms `α → (M →+ N)` -and monoid homomorphisms `(α →₀ M) →+ N`. -/ -def lift_add_hom [add_zero_class M] [add_comm_monoid N] : (α → M →+ N) ≃+ ((α →₀ M) →+ N) := -{ to_fun := λ F, - { to_fun := λ f, f.sum (λ x, F x), - map_zero' := finset.sum_empty, - map_add' := λ _ _, sum_add_index' (λ x, (F x).map_zero) (λ x, (F x).map_add) }, - inv_fun := λ F x, F.comp $ single_add_hom x, - left_inv := λ F, by { ext, simp }, - right_inv := λ F, by { ext, simp }, - map_add' := λ F G, by { ext, simp } } - -@[simp] lemma lift_add_hom_apply [add_comm_monoid M] [add_comm_monoid N] - (F : α → M →+ N) (f : α →₀ M) : - lift_add_hom F f = f.sum (λ x, F x) := -rfl - -@[simp] lemma lift_add_hom_symm_apply [add_comm_monoid M] [add_comm_monoid N] - (F : (α →₀ M) →+ N) (x : α) : - lift_add_hom.symm F x = F.comp (single_add_hom x) := -rfl - -lemma lift_add_hom_symm_apply_apply [add_comm_monoid M] [add_comm_monoid N] - (F : (α →₀ M) →+ N) (x : α) (y : M) : - lift_add_hom.symm F x y = F (single x y) := -rfl - -@[simp] lemma lift_add_hom_single_add_hom [add_comm_monoid M] : - lift_add_hom (single_add_hom : α → M →+ α →₀ M) = add_monoid_hom.id _ := -lift_add_hom.to_equiv.apply_eq_iff_eq_symm_apply.2 rfl - -@[simp] lemma sum_single [add_comm_monoid M] (f : α →₀ M) : - f.sum single = f := -add_monoid_hom.congr_fun lift_add_hom_single_add_hom f - -@[simp] lemma sum_univ_single [add_comm_monoid M] [fintype α] (i : α) (m : M) : - ∑ (j : α), (single i m) j = m := -by simp [single] - -@[simp] lemma sum_univ_single' [add_comm_monoid M] [fintype α] (i : α) (m : M) : - ∑ (j : α), (single j m) i = m := -by simp [single] - -@[simp] lemma lift_add_hom_apply_single [add_comm_monoid M] [add_comm_monoid N] - (f : α → M →+ N) (a : α) (b : M) : - lift_add_hom f (single a b) = f a b := -sum_single_index (f a).map_zero - -@[simp] lemma lift_add_hom_comp_single [add_comm_monoid M] [add_comm_monoid N] (f : α → M →+ N) - (a : α) : - (lift_add_hom f).comp (single_add_hom a) = f a := -add_monoid_hom.ext $ λ b, lift_add_hom_apply_single f a b - -lemma comp_lift_add_hom [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] - (g : N →+ P) (f : α → M →+ N) : - g.comp (lift_add_hom f) = lift_add_hom (λ a, g.comp (f a)) := -lift_add_hom.symm_apply_eq.1 $ funext $ λ a, - by rw [lift_add_hom_symm_apply, add_monoid_hom.comp_assoc, lift_add_hom_comp_single] - -lemma sum_sub_index [add_comm_group β] [add_comm_group γ] {f g : α →₀ β} - {h : α → β → γ} (h_sub : ∀a b₁ b₂, h a (b₁ - b₂) = h a b₁ - h a b₂) : - (f - g).sum h = f.sum h - g.sum h := -(lift_add_hom (λ a, add_monoid_hom.of_map_sub (h a) (h_sub a))).map_sub f g - -@[to_additive] -lemma prod_emb_domain [has_zero M] [comm_monoid N] {v : α →₀ M} {f : α ↪ β} {g : β → M → N} : - (v.emb_domain f).prod g = v.prod (λ a b, g (f a) b) := -begin - rw [prod, prod, support_emb_domain, finset.prod_map], - simp_rw emb_domain_apply, -end - -@[to_additive] -lemma prod_finset_sum_index [add_comm_monoid M] [comm_monoid N] - {s : finset ι} {g : ι → α →₀ M} - {h : α → M → N} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : - ∏ i in s, (g i).prod h = (∑ i in s, g i).prod h := -finset.induction_on s rfl $ λ a s has ih, -by rw [prod_insert has, ih, sum_insert has, prod_add_index' h_zero h_add] - -@[to_additive] -lemma prod_sum_index - [add_comm_monoid M] [add_comm_monoid N] [comm_monoid P] - {f : α →₀ M} {g : α → M → β →₀ N} - {h : β → N → P} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) : - (f.sum g).prod h = f.prod (λa b, (g a b).prod h) := -(prod_finset_sum_index h_zero h_add).symm - -lemma multiset_sum_sum_index - [add_comm_monoid M] [add_comm_monoid N] - (f : multiset (α →₀ M)) (h : α → M → N) - (h₀ : ∀a, h a 0 = 0) (h₁ : ∀ (a : α) (b₁ b₂ : M), h a (b₁ + b₂) = h a b₁ + h a b₂) : - (f.sum.sum h) = (f.map $ λg:α →₀ M, g.sum h).sum := -multiset.induction_on f rfl $ assume a s ih, -by rw [multiset.sum_cons, multiset.map_cons, multiset.sum_cons, sum_add_index' h₀ h₁, ih] - -lemma support_sum_eq_bUnion {α : Type*} {ι : Type*} {M : Type*} [add_comm_monoid M] - {g : ι → α →₀ M} (s : finset ι) (h : ∀ i₁ i₂, i₁ ≠ i₂ → disjoint (g i₁).support (g i₂).support) : - (∑ i in s, g i).support = s.bUnion (λ i, (g i).support) := +lemma graph_injective (α M) [has_zero M] : injective (@graph α M _) := begin - apply finset.induction_on s, - { simp }, - { intros i s hi, - simp only [hi, sum_insert, not_false_iff, bUnion_insert], - intro hs, - rw [finsupp.support_add_eq, hs], - rw [hs], - intros x hx, - simp only [mem_bUnion, exists_prop, inf_eq_inter, ne.def, mem_inter] at hx, - obtain ⟨hxi, j, hj, hxj⟩ := hx, - have hn : i ≠ j := λ H, hi (H.symm ▸ hj), - apply h _ _ hn, - simp [hxi, hxj] } + intros f g h, + classical, + have hsup : f.support = g.support, by rw [← image_fst_graph, h, image_fst_graph], + refine ext_iff'.2 ⟨hsup, λ x hx, apply_eq_of_mem_graph $ h.symm ▸ _⟩, + exact mk_mem_graph _ (hsup ▸ hx) end -lemma multiset_map_sum [has_zero M] {f : α →₀ M} {m : β → γ} {h : α → M → multiset β} : - multiset.map m (f.sum h) = f.sum (λa b, (h a b).map m) := -(multiset.map_add_monoid_hom m).map_sum _ f.support +@[simp] lemma graph_inj {f g : α →₀ M} : f.graph = g.graph ↔ f = g := +(graph_injective α M).eq_iff + +@[simp] lemma graph_zero : graph (0 : α →₀ M) = ∅ := by simp [graph] + +@[simp] lemma graph_eq_empty {f : α →₀ M} : f.graph = ∅ ↔ f = 0 := +(graph_injective α M).eq_iff' graph_zero -lemma multiset_sum_sum [has_zero M] [add_comm_monoid N] {f : α →₀ M} {h : α → M → multiset N} : - multiset.sum (f.sum h) = f.sum (λa b, multiset.sum (h a b)) := -(multiset.sum_add_monoid_hom : multiset N →+ N).map_sum _ f.support +end graph +end finsupp -/-- For disjoint `f1` and `f2`, and function `g`, the product of the products of `g` -over `f1` and `f2` equals the product of `g` over `f1 + f2` -/ -lemma prod_add_index_of_disjoint [add_comm_monoid M] {f1 f2 : α →₀ M} - (hd : disjoint f1.support f2.support) {β : Type*} [comm_monoid β] (g : α → M → β) : - (f1 + f2).prod g = f1.prod g * f2.prod g := -have ∀ {f1 f2 : α →₀ M}, disjoint f1.support f2.support → - ∏ x in f1.support, g x (f1 x + f2 x) = f1.prod g := - λ f1 f2 hd, finset.prod_congr rfl (λ x hx, - by simp only [not_mem_support_iff.mp (disjoint_left.mp hd hx), add_zero]), -by simp_rw [← this hd, ← this hd.symm, - add_comm (f2 _), finsupp.prod, support_add_eq hd, prod_union hd, add_apply] +/-! ### Declarations about `map_range` -/ section map_range +namespace finsupp + section equiv + variables [has_zero M] [has_zero N] [has_zero P] /-- `finsupp.map_range` as an equiv. -/ @@ -1445,6 +156,7 @@ equiv.ext $ λ x, rfl end equiv section zero_hom + variables [has_zero M] [has_zero N] [has_zero P] /-- Composition with a fixed zero-preserving homomorphism is itself an zero-preserving homomorphism @@ -1501,7 +213,6 @@ lemma map_range_finset_sum (f : M →+ N) (s : finset ι) (g : ι → (α →₀ map_range f f.map_zero (∑ x in s, g x) = ∑ x in s, map_range f f.map_zero (g x) := (map_range.add_monoid_hom f : (α →₀ _) →+ _).map_sum _ _ - /-- `finsupp.map_range.add_monoid_hom` as an equiv. -/ @[simps apply] def map_range.add_equiv (f : M ≃+ N) : (α →₀ M) ≃+ (α →₀ N) := @@ -1547,13 +258,124 @@ equiv.ext $ λ _, rfl end add_monoid_hom +end finsupp + end map_range +/-! ### Declarations about `equiv_congr_left` -/ + +section equiv_congr_left +variable [has_zero M] + +namespace finsupp + +/-- Given `f : α ≃ β`, we can map `l : α →₀ M` to `equiv_map_domain f l : β →₀ M` (computably) +by mapping the support forwards and the function backwards. -/ +def equiv_map_domain (f : α ≃ β) (l : α →₀ M) : β →₀ M := +{ support := l.support.map f.to_embedding, + to_fun := λ a, l (f.symm a), + mem_support_to_fun := λ a, by simp only [finset.mem_map_equiv, mem_support_to_fun]; refl } + +@[simp] lemma equiv_map_domain_apply (f : α ≃ β) (l : α →₀ M) (b : β) : + equiv_map_domain f l b = l (f.symm b) := rfl + +lemma equiv_map_domain_symm_apply (f : α ≃ β) (l : β →₀ M) (a : α) : + equiv_map_domain f.symm l a = l (f a) := rfl + +@[simp] lemma equiv_map_domain_refl (l : α →₀ M) : equiv_map_domain (equiv.refl _) l = l := +by ext x; refl + +lemma equiv_map_domain_refl' : equiv_map_domain (equiv.refl _) = @id (α →₀ M) := +by ext x; refl + +lemma equiv_map_domain_trans (f : α ≃ β) (g : β ≃ γ) (l : α →₀ M) : + equiv_map_domain (f.trans g) l = equiv_map_domain g (equiv_map_domain f l) := by ext x; refl + +lemma equiv_map_domain_trans' (f : α ≃ β) (g : β ≃ γ) : + @equiv_map_domain _ _ M _ (f.trans g) = equiv_map_domain g ∘ equiv_map_domain f := by ext x; refl + +@[simp] lemma equiv_map_domain_single (f : α ≃ β) (a : α) (b : M) : + equiv_map_domain f (single a b) = single (f a) b := +begin + classical, + ext x, + simp only [single_apply, equiv.apply_eq_iff_eq_symm_apply, equiv_map_domain_apply], +end + +@[simp] lemma equiv_map_domain_zero {f : α ≃ β} : equiv_map_domain f (0 : α →₀ M) = (0 : β →₀ M) := +by ext x; simp only [equiv_map_domain_apply, coe_zero, pi.zero_apply] + +/-- Given `f : α ≃ β`, the finitely supported function spaces are also in bijection: +`(α →₀ M) ≃ (β →₀ M)`. + +This is the finitely-supported version of `equiv.Pi_congr_left`. -/ +def equiv_congr_left (f : α ≃ β) : (α →₀ M) ≃ (β →₀ M) := +by refine ⟨equiv_map_domain f, equiv_map_domain f.symm, λ f, _, λ f, _⟩; + ext x; simp only [equiv_map_domain_apply, equiv.symm_symm, + equiv.symm_apply_apply, equiv.apply_symm_apply] + +@[simp] lemma equiv_congr_left_apply (f : α ≃ β) (l : α →₀ M) : + equiv_congr_left f l = equiv_map_domain f l := rfl + +@[simp] lemma equiv_congr_left_symm (f : α ≃ β) : + (@equiv_congr_left _ _ M _ f).symm = equiv_congr_left f.symm := rfl + +end finsupp + +end equiv_congr_left + + +section cast_finsupp +variables [has_zero M] (f : α →₀ M) + +namespace nat + +@[simp, norm_cast] lemma cast_finsupp_prod [comm_semiring R] (g : α → M → ℕ) : + (↑(f.prod g) : R) = f.prod (λ a b, ↑(g a b)) := +nat.cast_prod _ _ + +@[simp, norm_cast] lemma cast_finsupp_sum [comm_semiring R] (g : α → M → ℕ) : + (↑(f.sum g) : R) = f.sum (λ a b, ↑(g a b)) := +nat.cast_sum _ _ + +end nat + +namespace int + +@[simp, norm_cast] lemma cast_finsupp_prod [comm_ring R] (g : α → M → ℤ) : + (↑(f.prod g) : R) = f.prod (λ a b, ↑(g a b)) := +int.cast_prod _ _ + +@[simp, norm_cast] lemma cast_finsupp_sum [comm_ring R] (g : α → M → ℤ) : + (↑(f.sum g) : R) = f.sum (λ a b, ↑(g a b)) := +int.cast_sum _ _ + +end int + +namespace rat + +@[simp, norm_cast] lemma cast_finsupp_sum [division_ring R] [char_zero R] (g : α → M → ℚ) : + (↑(f.sum g) : R) = f.sum (λ a b, g a b) := +cast_sum _ _ + +@[simp, norm_cast] lemma cast_finsupp_prod [field R] [char_zero R] (g : α → M → ℚ) : + (↑(f.prod g) : R) = f.prod (λ a b, g a b) := +cast_prod _ _ + +end rat +end cast_finsupp + + + + /-! ### Declarations about `map_domain` -/ +namespace finsupp + section map_domain variables [add_comm_monoid M] {v v₁ v₂ : α →₀ M} + /-- Given `f : α → β` and `v : α →₀ M`, `map_domain f v : β →₀ M` is the finitely supported function whose value at `a : β` is the sum of `v x` over all `x` such that `f x = a`. -/ @@ -1584,15 +406,15 @@ lemma map_domain_comp {f : α → β} {g : β → γ} : map_domain (g ∘ f) v = map_domain g (map_domain f v) := begin refine ((sum_sum_index _ _).trans _).symm, - { intros, exact single_zero }, - { intros, exact single_add }, + { intro, exact single_zero _ }, + { intro, exact single_add _ }, refine sum_congr (λ _ _, sum_single_index _), - { exact single_zero } + { exact single_zero _ } end @[simp] lemma map_domain_single {f : α → β} {a : α} {b : M} : map_domain f (single a b) = single (f a) b := -sum_single_index single_zero +sum_single_index $ single_zero _ @[simp] lemma map_domain_zero {f : α → β} : map_domain f (0 : α →₀ M) = (0 : β →₀ M) := sum_zero_index @@ -1602,7 +424,7 @@ lemma map_domain_congr {f g : α → β} (h : ∀x∈v.support, f x = g x) : finset.sum_congr rfl $ λ _ H, by simp only [h _ H] lemma map_domain_add {f : α → β} : map_domain f (v₁ + v₂) = map_domain f v₁ + map_domain f v₂ := -sum_add_index' (λ _, single_zero) (λ _ _ _, single_add) +sum_add_index' (λ _, single_zero _) (λ _, single_add _) @[simp] lemma map_domain_equiv_apply {f : α ≃ β} (x : α →₀ M) (a : β) : map_domain f x a = x (f.symm a) := @@ -1645,26 +467,17 @@ lemma map_domain_apply' (S : set α) {f : α → β} (x : α →₀ M) (hS : (x.support : set α) ⊆ S) (hf : set.inj_on f S) {a : α} (ha : a ∈ S) : map_domain f x (f a) = x a := begin + classical, rw [map_domain, sum_apply, sum], simp_rw single_apply, - have : ∀ (b : α) (ha1 : b ∈ x.support), - (if f b = f a then x b else 0) = if f b = f a then x a else 0, - { intros b hb, - refine if_ctx_congr iff.rfl (λ hh, _) (λ _, rfl), - rw hf (hS hb) ha hh, }, - conv in (ite _ _ _) - { rw [this _ H], }, - by_cases ha : a ∈ x.support, - { rw [← finset.add_sum_erase _ _ ha, if_pos rfl], + by_cases hax : a ∈ x.support, + { rw [← finset.add_sum_erase _ _ hax, if_pos rfl], convert add_zero _, - have : ∀ i ∈ x.support.erase a, f i ≠ f a, - { intros i hi, - exact (finset.ne_of_mem_erase hi) ∘ (hf (hS $ finset.mem_of_mem_erase hi) (hS ha)), }, - conv in (ite _ _ _) - { rw if_neg (this x H), }, - exact finset.sum_const_zero, }, - { rw [mem_support_iff, not_not] at ha, - simp [ha], } + refine finset.sum_eq_zero (λ i hi, if_neg _), + exact (hf.mono hS).ne (finset.mem_of_mem_erase hi) hax (finset.ne_of_mem_erase hi), }, + { rw not_mem_support_iff.1 hax, + refine finset.sum_eq_zero (λ i hi, if_neg _), + exact hf.ne (hS hi) ha (ne_of_mem_of_not_mem hi hax) } end lemma map_domain_support_of_inj_on [decidable_eq β] {f : α → β} (s : α →₀ M) @@ -1764,6 +577,7 @@ lemma map_domain_inj_on (S : set α) {f : α → β} begin intros v₁ hv₁ v₂ hv₂ eq, ext a, + classical, by_cases h : a ∈ v₁.support ∪ v₂.support, { rw [← map_domain_apply' S _ hv₁ hf _, ← map_domain_apply' S _ hv₂ hf _, eq]; { apply set.union_subset hv₁ hv₂, @@ -1772,9 +586,12 @@ begin simp [h], }, end +lemma equiv_map_domain_eq_map_domain {M} [add_comm_monoid M] (f : α ≃ β) (l : α →₀ M) : + equiv_map_domain f l = map_domain f l := by ext x; simp [map_domain_equiv_apply] end map_domain + /-! ### Declarations about `comap_domain` -/ section comap_domain @@ -1782,6 +599,7 @@ section comap_domain /-- Given `f : α → β`, `l : β →₀ M` and a proof `hf` that `f` is injective on the preimage of `l.support`, `comap_domain f l hf` is the finitely supported function from `α` to `M` given by composing `l` with `f`. -/ +@[simps support] def comap_domain [has_zero M] (f : α → β) (l : β →₀ M) (hf : set.inj_on f (f ⁻¹' ↑l.support)) : α →₀ M := { support := l.support.preimage f hf, @@ -1819,8 +637,59 @@ begin exact h b (hb.2.symm ▸ ha) end -lemma map_domain_comap_domain [add_comm_monoid M] (f : α → β) (l : β →₀ M) - (hf : function.injective f) (hl : ↑l.support ⊆ set.range f): +section f_injective + +section has_zero +variables [has_zero M] + +/-- Note the `hif` argument is needed for this to work in `rw`. -/ +@[simp] lemma comap_domain_zero (f : α → β) + (hif : set.inj_on f (f ⁻¹' ↑((0 : β →₀ M).support)) := set.inj_on_empty _) : + comap_domain f (0 : β →₀ M) hif = (0 : α →₀ M) := +by { ext, refl } + +@[simp] lemma comap_domain_single (f : α → β) (a : α) (m : M) + (hif : set.inj_on f (f ⁻¹' (single (f a) m).support)) : + comap_domain f (finsupp.single (f a) m) hif = finsupp.single a m := +begin + rcases eq_or_ne m 0 with rfl | hm, + { simp only [single_zero, comap_domain_zero] }, + { rw [eq_single_iff, comap_domain_apply, comap_domain_support, ← finset.coe_subset, coe_preimage, + support_single_ne_zero _ hm, coe_singleton, coe_singleton, single_eq_same], + rw [support_single_ne_zero _ hm, coe_singleton] at hif, + exact ⟨λ x hx, hif hx rfl hx, rfl⟩ } +end + +end has_zero + +section add_zero_class +variables [add_zero_class M] {f : α → β} + +lemma comap_domain_add (v₁ v₂ : β →₀ M) + (hv₁ : set.inj_on f (f ⁻¹' ↑(v₁.support))) (hv₂ : set.inj_on f (f ⁻¹' ↑(v₂.support))) + (hv₁₂ : set.inj_on f (f ⁻¹' ↑((v₁ + v₂).support))) : + comap_domain f (v₁ + v₂) hv₁₂ = comap_domain f v₁ hv₁ + comap_domain f v₂ hv₂ := +by { ext, simp only [comap_domain_apply, coe_add, pi.add_apply] } + +/-- A version of `finsupp.comap_domain_add` that's easier to use. -/ +lemma comap_domain_add_of_injective (hf : function.injective f) (v₁ v₂ : β →₀ M) : + comap_domain f (v₁ + v₂) (hf.inj_on _) + = comap_domain f v₁ (hf.inj_on _) + comap_domain f v₂ (hf.inj_on _) := +comap_domain_add _ _ _ _ _ + +/-- `finsupp.comap_domain` is an `add_monoid_hom`. -/ +@[simps] +def comap_domain.add_monoid_hom (hf : function.injective f) : (β →₀ M) →+ (α →₀ M) := +{ to_fun := λ x, comap_domain f x (hf.inj_on _), + map_zero' := comap_domain_zero f, + map_add' := comap_domain_add_of_injective hf } + +end add_zero_class + +variables [add_comm_monoid M] (f : α → β) + +lemma map_domain_comap_domain + (hf : function.injective f) (l : β →₀ M) (hl : ↑l.support ⊆ set.range f) : map_domain f (comap_domain f l (hf.inj_on _)) = l := begin ext a, @@ -1832,8 +701,13 @@ begin apply h_cases (hl $ finset.mem_coe.2 $ mem_support_iff.2 $ λ h, h_contr h.symm) } end +end f_injective + end comap_domain + +/-! ### Declarations about finitely supported functions whose support is an `option` type -/ + section option /-- Restrict a finitely supported function on `option α` to a finitely supported function on `α`. -/ @@ -1854,7 +728,7 @@ by { ext, simp, } @[simp] lemma some_single_some [has_zero M] (a : α) (m : M) : (single (option.some a) m : option α →₀ M).some = single a m := -by { ext b, simp [single_apply], } +by { classical, ext b, simp [single_apply], } @[to_additive] lemma prod_option_index [add_comm_monoid M] [comm_monoid N] @@ -1862,8 +736,9 @@ lemma prod_option_index [add_comm_monoid M] [comm_monoid N] (h_add : ∀ o m₁ m₂, b o (m₁ + m₂) = b o m₁ * b o m₂) : f.prod b = b none (f none) * f.some.prod (λ a, b (option.some a)) := begin + classical, apply induction_linear f, - { simp [h_zero], }, + { simp [some_zero, h_zero], }, { intros f₁ f₂ h₁ h₂, rw [finsupp.prod_add_index, h₁, h₂, some_add, finsupp.prod_add_index], simp only [h_add, pi.add_apply, finsupp.coe_add], @@ -1880,74 +755,17 @@ f.sum_option_index _ (λ _, zero_smul _ _) (λ _ _ _, add_smul _ _ _) end option -/-! ### Declarations about `equiv_congr_left` -/ - -section equiv_congr_left - -variable [has_zero M] - -/-- Given `f : α ≃ β`, we can map `l : α →₀ M` to `equiv_map_domain f l : β →₀ M` (computably) -by mapping the support forwards and the function backwards. -/ -def equiv_map_domain (f : α ≃ β) (l : α →₀ M) : β →₀ M := -{ support := l.support.map f.to_embedding, - to_fun := λ a, l (f.symm a), - mem_support_to_fun := λ a, by simp only [finset.mem_map_equiv, mem_support_to_fun]; refl } - -@[simp] lemma equiv_map_domain_apply (f : α ≃ β) (l : α →₀ M) (b : β) : - equiv_map_domain f l b = l (f.symm b) := rfl - -lemma equiv_map_domain_symm_apply (f : α ≃ β) (l : β →₀ M) (a : α) : - equiv_map_domain f.symm l a = l (f a) := rfl - -@[simp] lemma equiv_map_domain_refl (l : α →₀ M) : equiv_map_domain (equiv.refl _) l = l := -by ext x; refl - -lemma equiv_map_domain_refl' : equiv_map_domain (equiv.refl _) = @id (α →₀ M) := -by ext x; refl - -lemma equiv_map_domain_trans (f : α ≃ β) (g : β ≃ γ) (l : α →₀ M) : - equiv_map_domain (f.trans g) l = equiv_map_domain g (equiv_map_domain f l) := by ext x; refl - -lemma equiv_map_domain_trans' (f : α ≃ β) (g : β ≃ γ) : - @equiv_map_domain _ _ M _ (f.trans g) = equiv_map_domain g ∘ equiv_map_domain f := by ext x; refl - -@[simp] lemma equiv_map_domain_single (f : α ≃ β) (a : α) (b : M) : - equiv_map_domain f (single a b) = single (f a) b := -by ext x; simp only [single_apply, equiv.apply_eq_iff_eq_symm_apply, equiv_map_domain_apply]; congr - -@[simp] lemma equiv_map_domain_zero {f : α ≃ β} : equiv_map_domain f (0 : α →₀ M) = (0 : β →₀ M) := -by ext x; simp only [equiv_map_domain_apply, coe_zero, pi.zero_apply] - -lemma equiv_map_domain_eq_map_domain {M} [add_comm_monoid M] (f : α ≃ β) (l : α →₀ M) : - equiv_map_domain f l = map_domain f l := by ext x; simp [map_domain_equiv_apply] - -/-- Given `f : α ≃ β`, the finitely supported function spaces are also in bijection: -`(α →₀ M) ≃ (β →₀ M)`. - -This is the finitely-supported version of `equiv.Pi_congr_left`. -/ -def equiv_congr_left (f : α ≃ β) : (α →₀ M) ≃ (β →₀ M) := -by refine ⟨equiv_map_domain f, equiv_map_domain f.symm, λ f, _, λ f, _⟩; - ext x; simp only [equiv_map_domain_apply, equiv.symm_symm, - equiv.symm_apply_apply, equiv.apply_symm_apply] - -@[simp] lemma equiv_congr_left_apply (f : α ≃ β) (l : α →₀ M) : - equiv_congr_left f l = equiv_map_domain f l := rfl - -@[simp] lemma equiv_congr_left_symm (f : α ≃ β) : - (@equiv_congr_left _ _ M _ f).symm = equiv_congr_left f.symm := rfl - -end equiv_congr_left - /-! ### Declarations about `filter` -/ section filter section has_zero variables [has_zero M] (p : α → Prop) (f : α →₀ M) -/-- `filter p f` is the function which is `f a` if `p a` is true and 0 otherwise. -/ +/-- +`filter p f` is the finitely supported function that is `f a` if `p a` is true and 0 otherwise. -/ def filter (p : α → Prop) (f : α →₀ M) : α →₀ M := -{ to_fun := λ a, if p a then f a else 0, - support := f.support.filter (λ a, p a), +{ to_fun := λ a, by haveI := classical.dec_pred p; exact if p a then f a else 0, + support := by haveI := classical.dec_pred p; exact f.support.filter (λ a, p a), mem_support_to_fun := λ a, by split_ifs; { simp only [h, mem_filter, mem_support_iff], tauto } } lemma filter_apply (a : α) [D : decidable (p a)] : f.filter p a = if p a then f a else 0 := @@ -1964,16 +782,16 @@ by simp only [fun_like.ext_iff, filter_eq_indicator, set.indicator_apply_eq_self not_imp_comm] @[simp] lemma filter_apply_pos {a : α} (h : p a) : f.filter p a = f a := -if_pos h +by { classical, convert if_pos h } @[simp] lemma filter_apply_neg {a : α} (h : ¬ p a) : f.filter p a = 0 := -if_neg h +by { classical, convert if_neg h } @[simp] lemma support_filter [D : decidable_pred p] : (f.filter p).support = f.support.filter p := by rw subsingleton.elim D; refl lemma filter_zero : (0 : α →₀ M).filter p = 0 := -by rw [← support_eq_empty, support_filter, support_zero, finset.filter_empty] +by { classical, rw [← support_eq_empty, support_filter, support_zero, finset.filter_empty] } @[simp] lemma filter_single_of_pos {a : α} {b : M} (h : p a) : (single a b).filter p = single a b := @@ -1985,6 +803,7 @@ by rw [← support_eq_empty, support_filter, support_zero, finset.filter_empty] @[to_additive] lemma prod_filter_index [comm_monoid N] (g : α → M → N) : (f.filter p).prod g = ∏ x in (f.filter p).support, g x (f x) := begin + classical, refine finset.prod_congr rfl (λ x hx, _), rw [support_filter, finset.mem_filter] at hx, rw [filter_apply_pos _ _ hx.2] @@ -1992,7 +811,10 @@ end @[simp, to_additive] lemma prod_filter_mul_prod_filter_not [comm_monoid N] (g : α → M → N) : (f.filter p).prod g * (f.filter (λ a, ¬ p a)).prod g = f.prod g := -by simp_rw [prod_filter_index, support_filter, prod_filter_mul_prod_filter_not, finsupp.prod] +begin + classical, + simp_rw [prod_filter_index, support_filter, prod_filter_mul_prod_filter_not, finsupp.prod] +end @[simp, to_additive] lemma prod_div_prod_filter [comm_group G] (g : α → M → G) : f.prod g / (f.filter p).prod g = (f.filter (λ a, ¬p a)).prod g := @@ -2012,11 +834,12 @@ section frange variables [has_zero M] /-- `frange f` is the image of `f` on the support of `f`. -/ -def frange (f : α →₀ M) : finset M := finset.image f f.support +def frange (f : α →₀ M) : finset M := +by haveI := classical.dec_eq M; exact finset.image f f.support theorem mem_frange {f : α →₀ M} {y : M} : y ∈ f.frange ↔ y ≠ 0 ∧ ∃ x, f x = y := -finset.mem_image.trans +by classical; exact finset.mem_image.trans ⟨λ ⟨x, hx1, hx2⟩, ⟨hx2 ▸ mem_support_iff.1 hx1, x, hx2⟩, λ ⟨hy, x, hx⟩, ⟨x, mem_support_iff.2 (hx.symm ▸ hy), hx⟩⟩ @@ -2024,8 +847,13 @@ theorem zero_not_mem_frange {f : α →₀ M} : (0:M) ∉ f.frange := λ H, (mem_frange.1 H).1 rfl theorem frange_single {x : α} {y : M} : frange (single x y) ⊆ {y} := -λ r hr, let ⟨t, ht1, ht2⟩ := mem_frange.1 hr in ht2 ▸ - (by rw single_apply at ht2 ⊢; split_ifs at ht2 ⊢; [exact finset.mem_singleton_self _, cc]) +λ r hr, let ⟨t, ht1, ht2⟩ := mem_frange.1 hr in ht2 ▸ begin + classical, + rw single_apply at ht2 ⊢, + split_ifs at ht2 ⊢, + { exact finset.mem_singleton_self _ }, + { exact (t ht2.symm).elim } +end end frange @@ -2033,15 +861,16 @@ end frange section subtype_domain - section zero variables [has_zero M] {p : α → Prop} -/-- `subtype_domain p f` is the restriction of the finitely supported function - `f` to the subtype `p`. -/ +/-- +`subtype_domain p f` is the restriction of the finitely supported function `f` to subtype `p`. -/ def subtype_domain (p : α → Prop) (f : α →₀ M) : (subtype p →₀ M) := -⟨f.support.subtype p, f ∘ coe, λ a, by simp only [mem_subtype, mem_support_iff]⟩ +{ support := by haveI := classical.dec_pred p; exact f.support.subtype p, + to_fun := f ∘ coe, + mem_support_to_fun := λ a, by simp only [mem_subtype, mem_support_iff] } @[simp] lemma support_subtype_domain [D : decidable_pred p] {f : α →₀ M} : (subtype_domain p f).support = f.support.subtype p := @@ -2056,22 +885,26 @@ rfl lemma subtype_domain_eq_zero_iff' {f : α →₀ M} : f.subtype_domain p = 0 ↔ ∀ x, p x → f x = 0 := -by simp_rw [← support_eq_empty, support_subtype_domain, subtype_eq_empty, not_mem_support_iff] +begin + classical, + simp_rw [← support_eq_empty, support_subtype_domain, subtype_eq_empty, not_mem_support_iff] +end lemma subtype_domain_eq_zero_iff {f : α →₀ M} (hf : ∀ x ∈ f.support , p x) : f.subtype_domain p = 0 ↔ f = 0 := subtype_domain_eq_zero_iff'.trans ⟨λ H, ext $ λ x, - if hx : p x then H x hx else not_mem_support_iff.1 $ mt (hf x) hx, λ H x _, by simp [H]⟩ + by classical; exact + if hx : p x then H x hx else not_mem_support_iff.1 $ mt (hf x) hx, λ H x _, by simp [H]⟩ @[to_additive] lemma prod_subtype_domain_index [comm_monoid N] {v : α →₀ M} {h : α → M → N} (hp : ∀x∈v.support, p x) : (v.subtype_domain p).prod (λa b, h a b) = v.prod h := prod_bij (λp _, p.val) - (λ _, mem_subtype.1) + (λ _, by classical; exact mem_subtype.1) (λ _ _, rfl) (λ _ _ _ _, subtype.eq) - (λ b hb, ⟨⟨b, hp b hb⟩, mem_subtype.2 hb, rfl⟩) + (λ b hb, ⟨⟨b, hp b hb⟩, by classical; exact mem_subtype.2 hb, rfl⟩) end zero @@ -2131,10 +964,10 @@ ext $ λ _, rfl (v - v').subtype_domain p = v.subtype_domain p - v'.subtype_domain p := ext $ λ _, rfl -@[simp] lemma single_neg {a : α} {b : G} : single a (-b) = -single a b := +@[simp] lemma single_neg (a : α) (b : G) : single a (-b) = -single a b := (single_add_hom a : G →+ _).map_neg b -@[simp] lemma single_sub {a : α} {b₁ b₂ : G} : single a (b₁ - b₂) = single a b₁ - single a b₂ := +@[simp] lemma single_sub (a : α) (b₁ b₂ : G) : single a (b₁ - b₂) = single a b₁ - single a b₂ := (single_add_hom a : G →+ _).map_sub b₁ b₂ @[simp] lemma erase_neg (a : α) (f : α →₀ G) : erase a (-f) = -erase a f := @@ -2175,6 +1008,7 @@ let ⟨f, hf, hfa⟩ := mem_support_multiset_sum a ha in let ⟨c, hc, eq⟩ := multiset.mem_map.1 hf in ⟨c, hc, eq.symm ▸ hfa⟩ + /-! ### Declarations about `curry` and `uncurry` -/ section curry_uncurry @@ -2190,6 +1024,7 @@ f.sum $ λp c, single p.1 (single p.2 c) @[simp] lemma curry_apply (f : (α × β) →₀ M) (x : α) (y : β) : f.curry x y = f (x, y) := begin + classical, have : ∀ (b : α × β), single b.fst (single b.snd (f b)) x y = if b = (x, y) then f b else 0, { rintros ⟨b₁, b₂⟩, simp [single_apply, ite_apply, prod.ext_iff, ite_and], @@ -2222,14 +1057,23 @@ f.sum $ λa g, g.sum $ λb c, single (a, b) c /-- `finsupp_prod_equiv` defines the `equiv` between `((α × β) →₀ M)` and `(α →₀ (β →₀ M))` given by currying and uncurrying. -/ def finsupp_prod_equiv : ((α × β) →₀ M) ≃ (α →₀ (β →₀ M)) := -by refine ⟨finsupp.curry, finsupp.uncurry, λ f, _, λ f, _⟩; simp only [ - finsupp.curry, finsupp.uncurry, sum_sum_index, sum_zero_index, sum_add_index, - sum_single_index, single_zero, single_add, eq_self_iff_true, forall_true_iff, - forall_3_true_iff, prod.mk.eta, (single_sum _ _ _).symm, sum_single] +{ to_fun := finsupp.curry, + inv_fun := finsupp.uncurry, + left_inv := λ f, begin + rw [finsupp.uncurry, sum_curry_index], + { simp_rw [prod.mk.eta, sum_single], }, + { intros, apply single_zero }, + { intros, apply single_add } + end, + right_inv := λ f, by simp only [ + finsupp.curry, finsupp.uncurry, sum_sum_index, sum_zero_index, sum_add_index, + sum_single_index, single_zero, single_add, eq_self_iff_true, forall_true_iff, + forall_3_true_iff, prod.mk.eta, (single_sum _ _ _).symm, sum_single] } lemma filter_curry (f : α × β →₀ M) (p : α → Prop) : (f.filter (λa:α×β, p a.1)).curry = f.curry.filter p := begin + classical, rw [finsupp.curry, finsupp.curry, finsupp.sum, finsupp.sum, filter_sum, support_filter, sum_filter], refine finset.sum_congr rfl _, @@ -2250,13 +1094,16 @@ end end curry_uncurry +/-! ### Declarations about finitely supported functions whose support is a `sum` type -/ + section sum /-- `finsupp.sum_elim f g` maps `inl x` to `f x` and `inr y` to `g y`. -/ def sum_elim {α β γ : Type*} [has_zero γ] (f : α →₀ γ) (g : β →₀ γ) : α ⊕ β →₀ γ := on_finset - ((f.support.map ⟨_, sum.inl_injective⟩) ∪ g.support.map ⟨_, sum.inr_injective⟩) + (by haveI := classical.dec_eq α; haveI := classical.dec_eq β; + exact (f.support.map ⟨_, sum.inl_injective⟩) ∪ g.support.map ⟨_, sum.inr_injective⟩) (sum.elim f g) (λ ab h, by { cases ab with a b; simp only [sum.elim_inl, sum.elim_inr] at h; simpa }) @@ -2340,6 +1187,8 @@ rfl end sum +/-! ### Declarations about scalar multiplication -/ + section variables [has_zero M] [monoid_with_zero R] [mul_action_with_zero R M] @@ -2356,10 +1205,10 @@ variables [monoid G] [mul_action G α] [add_comm_monoid M] This is not an instance as it would conflict with the action on the range. See the `instance_diamonds` test for examples of such conflicts. -/ -def comap_has_scalar : has_scalar G (α →₀ M) := +def comap_has_smul : has_smul G (α →₀ M) := { smul := λ g, map_domain ((•) g) } -local attribute [instance] comap_has_scalar +local attribute [instance] comap_has_smul lemma comap_smul_def (g : G) (f : α →₀ M) : g • f = map_domain ((•) g) f := rfl @@ -2367,7 +1216,7 @@ lemma comap_smul_def (g : G) (f : α →₀ M) : g • f = map_domain ((•) g) g • single a b = single (g • a) b := map_domain_single -/-- `finsupp.comap_has_scalar` is multiplicative -/ +/-- `finsupp.comap_has_smul` is multiplicative -/ def comap_mul_action : mul_action G (α →₀ M) := { one_smul := λ f, by rw [comap_smul_def, one_smul_eq_id, map_domain_id], mul_smul := λ g g' f, by rw [comap_smul_def, comap_smul_def, comap_smul_def, ←comp_smul_left, @@ -2375,7 +1224,7 @@ def comap_mul_action : mul_action G (α →₀ M) := local attribute [instance] comap_mul_action -/-- `finsupp.comap_has_scalar` is distributive -/ +/-- `finsupp.comap_has_smul` is distributive -/ def comap_distrib_mul_action : distrib_mul_action G (α →₀ M) := { smul_zero := λ g, by { ext, dsimp [(•)], simp, }, @@ -2386,9 +1235,9 @@ end section variables [group G] [mul_action G α] [add_comm_monoid M] -local attribute [instance] comap_has_scalar comap_mul_action comap_distrib_mul_action +local attribute [instance] comap_has_smul comap_mul_action comap_distrib_mul_action -/-- When `G` is a group, `finsupp.comap_has_scalar` acts by precomposition with the action of `g⁻¹`. +/-- When `G` is a group, `finsupp.comap_has_smul` acts by precomposition with the action of `g⁻¹`. -/ @[simp] lemma comap_smul_apply (g : G) (f : α →₀ M) (a : α) : (g • f) a = f (g⁻¹ • a) := @@ -2400,49 +1249,53 @@ end end section -instance [monoid R] [add_monoid M] [distrib_mul_action R M] : has_scalar R (α →₀ M) := -⟨λa v, v.map_range ((•) a) (smul_zero _)⟩ + +instance [has_zero M] [smul_zero_class R M] : smul_zero_class R (α →₀ M) := +{ smul := λ a v, v.map_range ((•) a) (smul_zero _), + smul_zero := λ a, by { ext, apply smul_zero } } /-! Throughout this section, some `monoid` and `semiring` arguments are specified with `{}` instead of `[]`. See note [implicit instance arguments]. -/ -@[simp] lemma coe_smul {_ : monoid R} [add_monoid M] [distrib_mul_action R M] +@[simp] lemma coe_smul [has_zero M] [smul_zero_class R M] (b : R) (v : α →₀ M) : ⇑(b • v) = b • v := rfl -lemma smul_apply {_ : monoid R} [add_monoid M] [distrib_mul_action R M] +lemma smul_apply [has_zero M] [smul_zero_class R M] (b : R) (v : α →₀ M) (a : α) : (b • v) a = b • (v a) := rfl -lemma _root_.is_smul_regular.finsupp {_ : monoid R} [add_monoid M] [distrib_mul_action R M] {k : R} +lemma _root_.is_smul_regular.finsupp [has_zero M] [smul_zero_class R M] {k : R} (hk : is_smul_regular M k) : is_smul_regular (α →₀ M) k := λ _ _ h, ext $ λ i, hk (congr_fun h i) -instance [monoid R] [nonempty α] [add_monoid M] [distrib_mul_action R M] [has_faithful_scalar R M] : - has_faithful_scalar R (α →₀ M) := +instance [nonempty α] [has_zero M] [smul_zero_class R M] [has_faithful_smul R M] : + has_faithful_smul R (α →₀ M) := { eq_of_smul_eq_smul := λ r₁ r₂ h, let ⟨a⟩ := ‹nonempty α› in eq_of_smul_eq_smul $ λ m : M, by simpa using congr_fun (h (single a m)) a } variables (α M) -instance [monoid R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action R (α →₀ M) := +instance [add_zero_class M] [distrib_smul R M] : distrib_smul R (α →₀ M) := { smul := (•), smul_add := λ a x y, ext $ λ _, smul_add _ _ _, + smul_zero := λ x, ext $ λ _, smul_zero _ } + +instance [monoid R] [add_monoid M] [distrib_mul_action R M] : distrib_mul_action R (α →₀ M) := +{ smul := (•), one_smul := λ x, ext $ λ _, one_smul _ _, mul_smul := λ r s x, ext $ λ _, mul_smul _ _ _, - smul_zero := λ x, ext $ λ _, smul_zero _ } + ..finsupp.distrib_smul _ _ } -instance [monoid R] [monoid S] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action S M] - [has_scalar R S] [is_scalar_tower R S M] : - is_scalar_tower R S (α →₀ M) := +instance [has_zero M] [smul_zero_class R M] [smul_zero_class S M] [has_smul R S] + [is_scalar_tower R S M] : is_scalar_tower R S (α →₀ M) := { smul_assoc := λ r s a, ext $ λ _, smul_assoc _ _ _ } -instance [monoid R] [monoid S] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action S M] - [smul_comm_class R S M] : - smul_comm_class R S (α →₀ M) := +instance [has_zero M] [smul_zero_class R M] [smul_zero_class S M] + [smul_comm_class R S M] : smul_comm_class R S (α →₀ M) := { smul_comm := λ r s a, ext $ λ _, smul_comm _ _ _ } -instance [monoid R] [add_monoid M] [distrib_mul_action R M] [distrib_mul_action Rᵐᵒᵖ M] - [is_central_scalar R M] : is_central_scalar R (α →₀ M) := +instance [has_zero M] [smul_zero_class R M] [smul_zero_class Rᵐᵒᵖ M] [is_central_scalar R M] : + is_central_scalar R (α →₀ M) := { op_smul_eq_smul := λ r a, ext $ λ _, op_smul_eq_smul _ _ } instance [semiring R] [add_comm_monoid M] [module R M] : module R (α →₀ M) := @@ -2453,7 +1306,7 @@ instance [semiring R] [add_comm_monoid M] [module R M] : module R (α →₀ M) variables {α M} {R} -lemma support_smul {_ : monoid R} [add_monoid M] [distrib_mul_action R M] {b : R} {g : α →₀ M} : +lemma support_smul [add_monoid M] [smul_zero_class R M] {b : R} {g : α →₀ M} : (b • g).support ⊆ g.support := λ a, by { simp only [smul_apply, mem_support_iff, ne.def], exact mt (λ h, h.symm ▸ smul_zero _) } @@ -2477,7 +1330,7 @@ lemma map_domain_smul {_ : monoid R} [add_comm_monoid M] [distrib_mul_action R M {f : α → β} (b : R) (v : α →₀ M) : map_domain f (b • v) = b • map_domain f v := map_domain_map_range _ _ _ _ (smul_add b) -@[simp] lemma smul_single {_ : monoid R} [add_monoid M] [distrib_mul_action R M] +@[simp] lemma smul_single [has_zero M] [smul_zero_class R M] (c : R) (a : α) (b : M) : c • finsupp.single a b = finsupp.single a (c • b) := map_range_single @@ -2500,20 +1353,34 @@ end lemma smul_single_one [semiring R] (a : α) (b : R) : b • single a 1 = single a b := by rw [smul_single, smul_eq_mul, mul_one] +lemma comap_domain_smul [add_monoid M] [monoid R] [distrib_mul_action R M] + {f : α → β} (r : R) (v : β →₀ M) + (hfv : set.inj_on f (f ⁻¹' ↑(v.support))) + (hfrv : set.inj_on f (f ⁻¹' ↑((r • v).support)) := + hfv.mono $ set.preimage_mono $ finset.coe_subset.mpr support_smul): + comap_domain f (r • v) hfrv = r • comap_domain f v hfv := +by { ext, refl } + +/-- A version of `finsupp.comap_domain_smul` that's easier to use. -/ +lemma comap_domain_smul_of_injective [add_monoid M] [monoid R] [distrib_mul_action R M] + {f : α → β} (hf : function.injective f) (r : R) (v : β →₀ M) : + comap_domain f (r • v) (hf.inj_on _) = r • comap_domain f v (hf.inj_on _) := +comap_domain_smul _ _ _ _ + end lemma sum_smul_index [semiring R] [add_comm_monoid M] {g : α →₀ R} {b : R} {h : α → R → M} (h0 : ∀i, h i 0 = 0) : (b • g).sum h = g.sum (λi a, h i (b * a)) := finsupp.sum_map_range_index h0 -lemma sum_smul_index' [monoid R] [add_monoid M] [distrib_mul_action R M] [add_comm_monoid N] +lemma sum_smul_index' [add_monoid M] [distrib_smul R M] [add_comm_monoid N] {g : α →₀ M} {b : R} {h : α → M → N} (h0 : ∀i, h i 0 = 0) : (b • g).sum h = g.sum (λi c, h i (b • c)) := finsupp.sum_map_range_index h0 /-- A version of `finsupp.sum_smul_index'` for bundled additive maps. -/ lemma sum_smul_index_add_monoid_hom - [monoid R] [add_monoid M] [add_comm_monoid N] [distrib_mul_action R M] + [add_monoid M] [add_comm_monoid N] [distrib_smul R M] {g : α →₀ M} {b : R} {h : α → M →+ N} : (b • g).sum (λ a, h a) = g.sum (λ i c, h i (b • c)) := sum_map_range_index (λ i, (h i).map_zero) @@ -2554,14 +1421,10 @@ section variables [has_zero R] /-- The `finsupp` version of `pi.unique`. -/ -instance unique_of_right [subsingleton R] : unique (α →₀ R) := -{ uniq := λ l, ext $ λ i, subsingleton.elim _ _, - .. finsupp.inhabited } +instance unique_of_right [subsingleton R] : unique (α →₀ R) := fun_like.coe_injective.unique /-- The `finsupp` version of `pi.unique_of_is_empty`. -/ -instance unique_of_left [is_empty α] : unique (α →₀ R) := -{ uniq := λ l, ext is_empty_elim, - .. finsupp.inhabited } +instance unique_of_left [is_empty α] : unique (α →₀ R) := fun_like.coe_injective.unique end @@ -2570,12 +1433,15 @@ between the subtype of finitely supported functions with support contained in `s the type of finitely supported functions from `s`. -/ def restrict_support_equiv (s : set α) (M : Type*) [add_comm_monoid M] : {f : α →₀ M // ↑f.support ⊆ s } ≃ (s →₀ M) := -begin - refine ⟨λf, subtype_domain (λx, x ∈ s) f.1, λ f, ⟨f.map_domain subtype.val, _⟩, _, _⟩, - { refine set.subset.trans (finset.coe_subset.2 map_domain_support) _, +{ to_fun := λ f, subtype_domain (λ x, x ∈ s) f.1, + inv_fun := λ f, ⟨f.map_domain subtype.val, begin + classical, + refine set.subset.trans (finset.coe_subset.2 map_domain_support) _, rw [finset.coe_image, set.image_subset_iff], - exact assume x hx, x.2 }, - { rintros ⟨f, hf⟩, + exact assume x hx, x.2, + end⟩, + left_inv := begin + rintros ⟨f, hf⟩, apply subtype.eq, ext a, dsimp only, @@ -2585,12 +1451,13 @@ begin { convert map_domain_notin_range _ _ h, rw [← not_mem_support_iff], refine mt _ h, - exact assume ha, ⟨⟨a, hf ha⟩, rfl⟩ } }, - { assume f, + exact assume ha, ⟨⟨a, hf ha⟩, rfl⟩ } + end, + right_inv := λ f, begin ext ⟨a, ha⟩, dsimp only, - rw [subtype_domain_apply, map_domain_apply subtype.val_injective] } -end + rw [subtype_domain_apply, map_domain_apply subtype.val_injective] + end } /-- Given `add_comm_monoid M` and `e : α ≃ β`, `dom_congr e` is the corresponding `equiv` between `α →₀ M` and `β →₀ M`. @@ -2651,7 +1518,8 @@ end /-- Given `l`, a finitely supported function from the sigma type `Σ (i : ι), αs i` to `β`, `split_support l` is the finset of indices in `ι` that appear in the support of `l`. -/ -def split_support : finset ι := l.support.image sigma.fst +def split_support (l : (Σ i, αs i) →₀ M) : finset ι := +by haveI := classical.dec_eq ι; exact l.support.image sigma.fst lemma mem_split_support_iff_nonzero (i : ι) : i ∈ split_support l ↔ split l i ≠ 0 := @@ -2721,32 +1589,16 @@ sigma_finsupp_add_equiv_pi_finsupp f j i = f ⟨j, i⟩ := rfl end sigma -end finsupp - -section cast_finsupp -variables [has_zero M] (f : α →₀ M) - -namespace nat - -@[simp, norm_cast] lemma cast_finsupp_prod [comm_semiring R] (g : α → M → ℕ) : - (↑(f.prod g) : R) = f.prod (λ a b, ↑(g a b)) := -nat.cast_prod _ _ - -@[simp, norm_cast] lemma cast_finsupp_sum [comm_semiring R] (g : α → M → ℕ) : - (↑(f.sum g) : R) = f.sum (λ a b, ↑(g a b)) := -nat.cast_sum _ _ - -end nat - -namespace int +/-! ### Meta declarations -/ -@[simp, norm_cast] lemma cast_finsupp_prod [comm_ring R] (g : α → M → ℤ) : - (↑(f.prod g) : R) = f.prod (λ a b, ↑(g a b)) := -int.cast_prod _ _ +/-- Stringify a `finsupp` as a sequence of `finsupp.single` terms. -@[simp, norm_cast] lemma cast_finsupp_sum [comm_ring R] (g : α → M → ℤ) : - (↑(f.sum g) : R) = f.sum (λ a b, ↑(g a b)) := -int.cast_sum _ _ +Note this is `meta` as it has to choose some order for the terms. -/ +meta instance (ι α : Type*) [has_zero α] [has_repr ι] [has_repr α] : + has_repr (ι →₀ α) := +{ repr := λ f, + if f.support.card = 0 then "0" + else " + ".intercalate $ + f.support.val.unquot.map (λ i, "finsupp.single " ++ repr i ++ " " ++ repr (f i)) } -end int -end cast_finsupp +end finsupp diff --git a/src/data/finsupp/big_operators.lean b/src/data/finsupp/big_operators.lean new file mode 100644 index 0000000000000..9f0051a7f7e10 --- /dev/null +++ b/src/data/finsupp/big_operators.lean @@ -0,0 +1,132 @@ +/- +Copyright (c) 2022 Yakov Pechersky. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yakov Pechersky +-/ + +import data.finsupp.defs +import data.finset.pairwise + +/-! + +# Sums of collections of finsupp, and their support + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +This file provides results about the `finsupp.support` of sums of collections of `finsupp`, +including sums of `list`, `multiset`, and `finset`. + +The support of the sum is a subset of the union of the supports: +* `list.support_sum_subset` +* `multiset.support_sum_subset` +* `finset.support_sum_subset` + +The support of the sum of pairwise disjoint finsupps is equal to the union of the supports +* `list.support_sum_eq` +* `multiset.support_sum_eq` +* `finset.support_sum_eq` + +Member in the support of the indexed union over a collection iff +it is a member of the support of a member of the collection: +* `list.mem_foldr_sup_support_iff` +* `multiset.mem_sup_map_support_iff` +* `finset.mem_sup_support_iff` + +-/ + +variables {ι M : Type*} [decidable_eq ι] + +lemma list.support_sum_subset [add_monoid M] (l : list (ι →₀ M)) : + l.sum.support ⊆ l.foldr ((⊔) ∘ finsupp.support) ∅ := +begin + induction l with hd tl IH, + { simp }, + { simp only [list.sum_cons, finset.union_comm], + refine finsupp.support_add.trans (finset.union_subset_union _ IH), + refl } +end + +lemma multiset.support_sum_subset [add_comm_monoid M] (s : multiset (ι →₀ M)) : + s.sum.support ⊆ (s.map (finsupp.support)).sup := +begin + induction s using quot.induction_on, + simpa using list.support_sum_subset _ +end + +lemma finset.support_sum_subset [add_comm_monoid M] (s : finset (ι →₀ M)) : + (s.sum id).support ⊆ finset.sup s finsupp.support := +by { classical, convert multiset.support_sum_subset s.1; simp } + +lemma list.mem_foldr_sup_support_iff [has_zero M] {l : list (ι →₀ M)} {x : ι} : + x ∈ l.foldr ((⊔) ∘ finsupp.support) ∅ ↔ ∃ (f : ι →₀ M) (hf : f ∈ l), x ∈ f.support := +begin + simp only [finset.sup_eq_union, list.foldr_map, finsupp.mem_support_iff, exists_prop], + induction l with hd tl IH, + { simp }, + { simp only [IH, list.foldr_cons, finset.mem_union, finsupp.mem_support_iff, list.mem_cons_iff], + split, + { rintro (h|h), + { exact ⟨hd, or.inl rfl, h⟩ }, + { exact h.imp (λ f hf, hf.imp_left or.inr) } }, + { rintro ⟨f, rfl|hf, h⟩, + { exact or.inl h }, + { exact or.inr ⟨f, hf, h⟩ } } } +end + +lemma multiset.mem_sup_map_support_iff [has_zero M] {s : multiset (ι →₀ M)} {x : ι} : + x ∈ (s.map (finsupp.support)).sup ↔ ∃ (f : ι →₀ M) (hf : f ∈ s), x ∈ f.support := +quot.induction_on s $ λ _, by simpa using list.mem_foldr_sup_support_iff + +lemma finset.mem_sup_support_iff [has_zero M] {s : finset (ι →₀ M)} {x : ι} : + x ∈ s.sup finsupp.support ↔ ∃ (f : ι →₀ M) (hf : f ∈ s), x ∈ f.support := +multiset.mem_sup_map_support_iff + +lemma list.support_sum_eq [add_monoid M] (l : list (ι →₀ M)) + (hl : l.pairwise (disjoint on finsupp.support)) : + l.sum.support = l.foldr ((⊔) ∘ finsupp.support) ∅ := +begin + induction l with hd tl IH, + { simp }, + { simp only [list.pairwise_cons] at hl, + simp only [list.sum_cons, list.foldr_cons, function.comp_app], + rw [finsupp.support_add_eq, IH hl.right, finset.sup_eq_union], + suffices : disjoint hd.support (tl.foldr ((⊔) ∘ finsupp.support) ∅), + { exact finset.disjoint_of_subset_right (list.support_sum_subset _) this }, + { rw [←list.foldr_map, ←finset.bot_eq_empty, list.foldr_sup_eq_sup_to_finset], + rw finset.disjoint_sup_right, + intros f hf, + simp only [list.mem_to_finset, list.mem_map] at hf, + obtain ⟨f, hf, rfl⟩ := hf, + exact hl.left _ hf } } +end + +lemma multiset.support_sum_eq [add_comm_monoid M] (s : multiset (ι →₀ M)) + (hs : s.pairwise (disjoint on finsupp.support)) : + s.sum.support = (s.map finsupp.support).sup := +begin + induction s using quot.induction_on, + obtain ⟨l, hl, hd⟩ := hs, + convert list.support_sum_eq _ _, + { simp }, + { simp }, + { simp only [multiset.quot_mk_to_coe'', multiset.coe_map, multiset.coe_eq_coe] at hl, + exact hl.symm.pairwise hd (λ _ _ h, disjoint.symm h) } +end + +lemma finset.support_sum_eq [add_comm_monoid M] (s : finset (ι →₀ M)) + (hs : (s : set (ι →₀ M)).pairwise_disjoint finsupp.support) : + (s.sum id).support = finset.sup s finsupp.support := +begin + classical, + convert multiset.support_sum_eq s.1 _, + { exact (finset.sum_val _).symm }, + { obtain ⟨l, hl, hn⟩ : ∃ (l : list (ι →₀ M)), l.to_finset = s ∧ l.nodup, + { refine ⟨s.to_list, _, finset.nodup_to_list _⟩, + simp }, + subst hl, + rwa [list.to_finset_val, list.dedup_eq_self.mpr hn, + multiset.pairwise_coe_iff_pairwise, + ←list.pairwise_disjoint_iff_coe_to_finset_pairwise_disjoint hn], + intros x y hxy, + exact symmetric_disjoint hxy } +end diff --git a/src/data/finsupp/default.lean b/src/data/finsupp/default.lean deleted file mode 100644 index 359ca8e4e73cc..0000000000000 --- a/src/data/finsupp/default.lean +++ /dev/null @@ -1,10 +0,0 @@ -/- -Copyright (c) 2020 Chris Hughes. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes --/ -import data.finsupp.basic -/-! - # Default finsupp file - This file imports `data.finsupp.basic` --/ diff --git a/src/data/finsupp/defs.lean b/src/data/finsupp/defs.lean new file mode 100644 index 0000000000000..d21d60bc1202e --- /dev/null +++ b/src/data/finsupp/defs.lean @@ -0,0 +1,1055 @@ +/- +Copyright (c) 2017 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Scott Morrison +-/ +import algebra.indicator_function +import group_theory.submonoid.basic + +/-! +# Type of functions with finite support + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +For any type `α` and any type `M` with zero, we define the type `finsupp α M` (notation: `α →₀ M`) +of finitely supported functions from `α` to `M`, i.e. the functions which are zero everywhere +on `α` except on a finite set. + +Functions with finite support are used (at least) in the following parts of the library: + +* `monoid_algebra R M` and `add_monoid_algebra R M` are defined as `M →₀ R`; + +* polynomials and multivariate polynomials are defined as `add_monoid_algebra`s, hence they use + `finsupp` under the hood; + +* the linear combination of a family of vectors `v i` with coefficients `f i` (as used, e.g., to + define linearly independent family `linear_independent`) is defined as a map + `finsupp.total : (ι → M) → (ι →₀ R) →ₗ[R] M`. + +Some other constructions are naturally equivalent to `α →₀ M` with some `α` and `M` but are defined +in a different way in the library: + +* `multiset α ≃+ α →₀ ℕ`; +* `free_abelian_group α ≃+ α →₀ ℤ`. + +Most of the theory assumes that the range is a commutative additive monoid. This gives us the big +sum operator as a powerful way to construct `finsupp` elements, which is defined in +`algebra/big_operators/finsupp`. + +Many constructions based on `α →₀ M` use `semireducible` type tags to avoid reusing unwanted type +instances. E.g., `monoid_algebra`, `add_monoid_algebra`, and types based on these two have +non-pointwise multiplication. + +## Main declarations + +* `finsupp`: The type of finitely supported functions from `α` to `β`. +* `finsupp.single`: The `finsupp` which is nonzero in exactly one point. +* `finsupp.update`: Changes one value of a `finsupp`. +* `finsupp.erase`: Replaces one value of a `finsupp` by `0`. +* `finsupp.on_finset`: The restriction of a function to a `finset` as a `finsupp`. +* `finsupp.map_range`: Composition of a `zero_hom` with a `finsupp`. +* `finsupp.emb_domain`: Maps the domain of a `finsupp` by an embedding. +* `finsupp.zip_with`: Postcomposition of two `finsupp`s with a function `f` such that `f 0 0 = 0`. + +## Notations + +This file adds `α →₀ M` as a global notation for `finsupp α M`. + +We also use the following convention for `Type*` variables in this file + +* `α`, `β`, `γ`: types with no additional structure that appear as the first argument to `finsupp` + somewhere in the statement; + +* `ι` : an auxiliary index type; + +* `M`, `M'`, `N`, `P`: types with `has_zero` or `(add_)(comm_)monoid` structure; `M` is also used + for a (semi)module over a (semi)ring. + +* `G`, `H`: groups (commutative or not, multiplicative or additive); + +* `R`, `S`: (semi)rings. + +## Implementation notes + +This file is a `noncomputable theory` and uses classical logic throughout. + +## TODO + +* Expand the list of definitions and important lemmas to the module docstring. + +-/ + +noncomputable theory + +open finset function +open_locale big_operators + +variables {α β γ ι M M' N P G H R S : Type*} + +/-- `finsupp α M`, denoted `α →₀ M`, is the type of functions `f : α → M` such that + `f x = 0` for all but finitely many `x`. -/ +structure finsupp (α : Type*) (M : Type*) [has_zero M] := +(support : finset α) +(to_fun : α → M) +(mem_support_to_fun : ∀a, a ∈ support ↔ to_fun a ≠ 0) + +infixr ` →₀ `:25 := finsupp + +namespace finsupp + +/-! ### Basic declarations about `finsupp` -/ + +section basic +variable [has_zero M] + +instance fun_like : fun_like (α →₀ M) α (λ _, M) := ⟨to_fun, begin + rintro ⟨s, f, hf⟩ ⟨t, g, hg⟩ (rfl : f = g), + congr', + ext a, + exact (hf _).trans (hg _).symm, +end⟩ + +/-- Helper instance for when there are too many metavariables to apply `fun_like.has_coe_to_fun` +directly. -/ +instance : has_coe_to_fun (α →₀ M) (λ _, α → M) := fun_like.has_coe_to_fun + +@[ext] lemma ext {f g : α →₀ M} (h : ∀ a, f a = g a) : f = g := fun_like.ext _ _ h +/-- Deprecated. Use `fun_like.ext_iff` instead. -/ +lemma ext_iff {f g : α →₀ M} : f = g ↔ ∀ a, f a = g a := fun_like.ext_iff +/-- Deprecated. Use `fun_like.coe_fn_eq` instead. -/ +lemma coe_fn_inj {f g : α →₀ M} : (f : α → M) = g ↔ f = g := fun_like.coe_fn_eq +/-- Deprecated. Use `fun_like.coe_injective` instead. -/ +lemma coe_fn_injective : @function.injective (α →₀ M) (α → M) coe_fn := fun_like.coe_injective +/-- Deprecated. Use `fun_like.congr_fun` instead. -/ +lemma congr_fun {f g : α →₀ M} (h : f = g) (a : α) : f a = g a := fun_like.congr_fun h _ + +@[simp] lemma coe_mk (f : α → M) (s : finset α) (h : ∀ a, a ∈ s ↔ f a ≠ 0) : + ⇑(⟨s, f, h⟩ : α →₀ M) = f := rfl + +instance : has_zero (α →₀ M) := ⟨⟨∅, 0, λ _, ⟨false.elim, λ H, H rfl⟩⟩⟩ + +@[simp] lemma coe_zero : ⇑(0 : α →₀ M) = 0 := rfl +lemma zero_apply {a : α} : (0 : α →₀ M) a = 0 := rfl +@[simp] lemma support_zero : (0 : α →₀ M).support = ∅ := rfl + +instance : inhabited (α →₀ M) := ⟨0⟩ + +@[simp] lemma mem_support_iff {f : α →₀ M} : ∀{a:α}, a ∈ f.support ↔ f a ≠ 0 := +f.mem_support_to_fun + +@[simp, norm_cast] lemma fun_support_eq (f : α →₀ M) : function.support f = f.support := +set.ext $ λ x, mem_support_iff.symm + +lemma not_mem_support_iff {f : α →₀ M} {a} : a ∉ f.support ↔ f a = 0 := +not_iff_comm.1 mem_support_iff.symm + +@[simp, norm_cast] lemma coe_eq_zero {f : α →₀ M} : (f : α → M) = 0 ↔ f = 0 := +by rw [← coe_zero, coe_fn_inj] + +lemma ext_iff' {f g : α →₀ M} : f = g ↔ f.support = g.support ∧ ∀ x ∈ f.support, f x = g x := +⟨λ h, h ▸ ⟨rfl, λ _ _, rfl⟩, λ ⟨h₁, h₂⟩, ext $ λ a, + by classical; exact if h : a ∈ f.support then h₂ a h else + have hf : f a = 0, from not_mem_support_iff.1 h, + have hg : g a = 0, by rwa [h₁, not_mem_support_iff] at h, + by rw [hf, hg]⟩ + +@[simp] lemma support_eq_empty {f : α →₀ M} : f.support = ∅ ↔ f = 0 := +by exact_mod_cast @function.support_eq_empty_iff _ _ _ f + +lemma support_nonempty_iff {f : α →₀ M} : f.support.nonempty ↔ f ≠ 0 := +by simp only [finsupp.support_eq_empty, finset.nonempty_iff_ne_empty, ne.def] + +lemma nonzero_iff_exists {f : α →₀ M} : f ≠ 0 ↔ ∃ a : α, f a ≠ 0 := +by simp [← finsupp.support_eq_empty, finset.eq_empty_iff_forall_not_mem] + +lemma card_support_eq_zero {f : α →₀ M} : card f.support = 0 ↔ f = 0 := +by simp + +instance [decidable_eq α] [decidable_eq M] : decidable_eq (α →₀ M) := +assume f g, decidable_of_iff (f.support = g.support ∧ (∀a∈f.support, f a = g a)) ext_iff'.symm + +lemma finite_support (f : α →₀ M) : set.finite (function.support f) := +f.fun_support_eq.symm ▸ f.support.finite_to_set + +lemma support_subset_iff {s : set α} {f : α →₀ M} : + ↑f.support ⊆ s ↔ (∀a∉s, f a = 0) := +by simp only [set.subset_def, mem_coe, mem_support_iff]; + exact forall_congr (assume a, not_imp_comm) + +/-- Given `finite α`, `equiv_fun_on_finite` is the `equiv` between `α →₀ β` and `α → β`. + (All functions on a finite type are finitely supported.) -/ +@[simps] def equiv_fun_on_finite [finite α] : (α →₀ M) ≃ (α → M) := +{ to_fun := coe_fn, + inv_fun := λ f, mk (function.support f).to_finite.to_finset f (λ a, set.finite.mem_to_finset _), + left_inv := λ f, ext $ λ x, rfl, + right_inv := λ f, rfl } + +@[simp] lemma equiv_fun_on_finite_symm_coe {α} [finite α] (f : α →₀ M) : + equiv_fun_on_finite.symm f = f := +equiv_fun_on_finite.symm_apply_apply f + +/-- +If `α` has a unique term, the type of finitely supported functions `α →₀ β` is equivalent to `β`. +-/ +@[simps] noncomputable +def _root_.equiv.finsupp_unique {ι : Type*} [unique ι] : (ι →₀ M) ≃ M := +finsupp.equiv_fun_on_finite.trans (equiv.fun_unique ι M) + +@[ext] +lemma unique_ext [unique α] {f g : α →₀ M} (h : f default = g default) : f = g := +ext $ λ a, by rwa [unique.eq_default a] + +lemma unique_ext_iff [unique α] {f g : α →₀ M} : f = g ↔ f default = g default := +⟨λ h, h ▸ rfl, unique_ext⟩ + +end basic + +/-! ### Declarations about `single` -/ + +section single +variables [has_zero M] {a a' : α} {b : M} + +/-- `single a b` is the finitely supported function with value `b` at `a` and zero otherwise. -/ +def single (a : α) (b : M) : α →₀ M := +{ support := by haveI := classical.dec_eq M; exact if b = 0 then ∅ else {a}, + to_fun := by haveI := classical.dec_eq α; exact pi.single a b, + mem_support_to_fun := λ a', begin + classical, + obtain rfl | hb := eq_or_ne b 0, + { simp }, + rw [if_neg hb, mem_singleton], + obtain rfl | ha := eq_or_ne a' a, + { simp [hb] }, + simp [pi.single_eq_of_ne', ha], + end } + +lemma single_apply [decidable (a = a')] : single a b a' = if a = a' then b else 0 := +by { classical, simp_rw [@eq_comm _ a a'], convert pi.single_apply _ _ _, } + +lemma single_apply_left {f : α → β} (hf : function.injective f) + (x z : α) (y : M) : + single (f x) y (f z) = single x y z := +by { classical, simp only [single_apply, hf.eq_iff] } + +lemma single_eq_set_indicator : ⇑(single a b) = set.indicator {a} (λ _, b) := +by { classical, ext, simp [single_apply, set.indicator, @eq_comm _ a] } + +@[simp] lemma single_eq_same : (single a b : α →₀ M) a = b := +by { classical, exact pi.single_eq_same a b } + +@[simp] lemma single_eq_of_ne (h : a ≠ a') : (single a b : α →₀ M) a' = 0 := +by { classical, exact pi.single_eq_of_ne' h _ } + +lemma single_eq_update [decidable_eq α] (a : α) (b : M) : ⇑(single a b) = function.update 0 a b := +by rw [single_eq_set_indicator, ← set.piecewise_eq_indicator, set.piecewise_singleton] + +lemma single_eq_pi_single [decidable_eq α] (a : α) (b : M) : ⇑(single a b) = pi.single a b := +single_eq_update a b + +@[simp] lemma single_zero (a : α) : (single a 0 : α →₀ M) = 0 := +coe_fn_injective $ begin + classical, + simpa only [single_eq_update, coe_zero] using function.update_eq_self a (0 : α → M) +end + +lemma single_of_single_apply (a a' : α) (b : M) : + single a ((single a' b) a) = single a' (single a' b) a := +begin + classical, + rw [single_apply, single_apply], + ext, + split_ifs, + { rw h, }, + { rw [zero_apply, single_apply, if_t_t], }, +end + +lemma support_single_ne_zero (a : α) (hb : b ≠ 0) : (single a b).support = {a} := +by { classical, exact if_neg hb } + +lemma support_single_subset : (single a b).support ⊆ {a} := +by { classical, show ite _ _ _ ⊆ _, split_ifs; [exact empty_subset _, exact subset.refl _] } + +lemma single_apply_mem (x) : single a b x ∈ ({0, b} : set M) := +by rcases em (a = x) with (rfl|hx); [simp, simp [single_eq_of_ne hx]] + +lemma range_single_subset : set.range (single a b) ⊆ {0, b} := +set.range_subset_iff.2 single_apply_mem + +/-- `finsupp.single a b` is injective in `b`. For the statement that it is injective in `a`, see +`finsupp.single_left_injective` -/ +lemma single_injective (a : α) : function.injective (single a : M → α →₀ M) := +assume b₁ b₂ eq, +have (single a b₁ : α →₀ M) a = (single a b₂ : α →₀ M) a, by rw eq, +by rwa [single_eq_same, single_eq_same] at this + +lemma single_apply_eq_zero {a x : α} {b : M} : single a b x = 0 ↔ (x = a → b = 0) := +by simp [single_eq_set_indicator] + +lemma single_apply_ne_zero {a x : α} {b : M} : single a b x ≠ 0 ↔ (x = a ∧ b ≠ 0) := +by simp [single_apply_eq_zero] + +lemma mem_support_single (a a' : α) (b : M) : + a ∈ (single a' b).support ↔ a = a' ∧ b ≠ 0 := +by simp [single_apply_eq_zero, not_or_distrib] + +lemma eq_single_iff {f : α →₀ M} {a b} : f = single a b ↔ f.support ⊆ {a} ∧ f a = b := +begin + refine ⟨λ h, h.symm ▸ ⟨support_single_subset, single_eq_same⟩, _⟩, + rintro ⟨h, rfl⟩, + ext x, + by_cases hx : a = x; simp only [hx, single_eq_same, single_eq_of_ne, ne.def, not_false_iff], + exact not_mem_support_iff.1 (mt (λ hx, (mem_singleton.1 (h hx)).symm) hx) +end + +lemma single_eq_single_iff (a₁ a₂ : α) (b₁ b₂ : M) : + single a₁ b₁ = single a₂ b₂ ↔ ((a₁ = a₂ ∧ b₁ = b₂) ∨ (b₁ = 0 ∧ b₂ = 0)) := +begin + split, + { assume eq, + by_cases a₁ = a₂, + { refine or.inl ⟨h, _⟩, + rwa [h, (single_injective a₂).eq_iff] at eq }, + { rw [ext_iff] at eq, + have h₁ := eq a₁, + have h₂ := eq a₂, + simp only [single_eq_same, single_eq_of_ne h, single_eq_of_ne (ne.symm h)] at h₁ h₂, + exact or.inr ⟨h₁, h₂.symm⟩ } }, + { rintros (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩), + { refl }, + { rw [single_zero, single_zero] } } +end + +/-- `finsupp.single a b` is injective in `a`. For the statement that it is injective in `b`, see +`finsupp.single_injective` -/ +lemma single_left_injective (h : b ≠ 0) : function.injective (λ a : α, single a b) := +λ a a' H, (((single_eq_single_iff _ _ _ _).mp H).resolve_right $ λ hb, h hb.1).left + +lemma single_left_inj (h : b ≠ 0) : single a b = single a' b ↔ a = a' := +(single_left_injective h).eq_iff + +lemma support_single_ne_bot (i : α) (h : b ≠ 0) : + (single i b).support ≠ ⊥ := +by simpa only [support_single_ne_zero _ h] using singleton_ne_empty _ + +lemma support_single_disjoint {b' : M} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : α} : + disjoint (single i b).support (single j b').support ↔ i ≠ j := +by rw [support_single_ne_zero _ hb, support_single_ne_zero _ hb', disjoint_singleton] + +@[simp] lemma single_eq_zero : single a b = 0 ↔ b = 0 := +by simp [ext_iff, single_eq_set_indicator] + +lemma single_swap (a₁ a₂ : α) (b : M) : single a₁ b a₂ = single a₂ b a₁ := +by { classical, simp only [single_apply], ac_refl } + +instance [nonempty α] [nontrivial M] : nontrivial (α →₀ M) := +begin + inhabit α, + rcases exists_ne (0 : M) with ⟨x, hx⟩, + exact nontrivial_of_ne (single default x) 0 (mt single_eq_zero.1 hx) +end + +lemma unique_single [unique α] (x : α →₀ M) : x = single default (x default) := +ext $ unique.forall_iff.2 single_eq_same.symm + +@[simp] lemma unique_single_eq_iff [unique α] {b' : M} : + single a b = single a' b' ↔ b = b' := +by rw [unique_ext_iff, unique.eq_default a, unique.eq_default a', single_eq_same, single_eq_same] + +lemma support_eq_singleton {f : α →₀ M} {a : α} : + f.support = {a} ↔ f a ≠ 0 ∧ f = single a (f a) := +⟨λ h, ⟨mem_support_iff.1 $ h.symm ▸ finset.mem_singleton_self a, + eq_single_iff.2 ⟨subset_of_eq h, rfl⟩⟩, λ h, h.2.symm ▸ support_single_ne_zero _ h.1⟩ + +lemma support_eq_singleton' {f : α →₀ M} {a : α} : + f.support = {a} ↔ ∃ b ≠ 0, f = single a b := +⟨λ h, let h := support_eq_singleton.1 h in ⟨_, h.1, h.2⟩, + λ ⟨b, hb, hf⟩, hf.symm ▸ support_single_ne_zero _ hb⟩ + +lemma card_support_eq_one {f : α →₀ M} : card f.support = 1 ↔ ∃ a, f a ≠ 0 ∧ f = single a (f a) := +by simp only [card_eq_one, support_eq_singleton] + +lemma card_support_eq_one' {f : α →₀ M} : card f.support = 1 ↔ ∃ a (b ≠ 0), f = single a b := +by simp only [card_eq_one, support_eq_singleton'] + +lemma support_subset_singleton {f : α →₀ M} {a : α} : + f.support ⊆ {a} ↔ f = single a (f a) := +⟨λ h, eq_single_iff.mpr ⟨h, rfl⟩, λ h, (eq_single_iff.mp h).left⟩ + +lemma support_subset_singleton' {f : α →₀ M} {a : α} : + f.support ⊆ {a} ↔ ∃ b, f = single a b := +⟨λ h, ⟨f a, support_subset_singleton.mp h⟩, + λ ⟨b, hb⟩, by rw [hb, support_subset_singleton, single_eq_same]⟩ + +lemma card_support_le_one [nonempty α] {f : α →₀ M} : + card f.support ≤ 1 ↔ ∃ a, f = single a (f a) := +by simp only [card_le_one_iff_subset_singleton, support_subset_singleton] + +lemma card_support_le_one' [nonempty α] {f : α →₀ M} : + card f.support ≤ 1 ↔ ∃ a b, f = single a b := +by simp only [card_le_one_iff_subset_singleton, support_subset_singleton'] + +@[simp] lemma equiv_fun_on_finite_single [decidable_eq α] [finite α] (x : α) (m : M) : + finsupp.equiv_fun_on_finite (finsupp.single x m) = pi.single x m := +by { ext, simp [finsupp.single_eq_pi_single], } + +@[simp] lemma equiv_fun_on_finite_symm_single [decidable_eq α] [finite α] (x : α) (m : M) : + finsupp.equiv_fun_on_finite.symm (pi.single x m) = finsupp.single x m := +by rw [← equiv_fun_on_finite_single, equiv.symm_apply_apply] + +end single + +/-! ### Declarations about `update` -/ + +section update + +variables [has_zero M] (f : α →₀ M) (a : α) (b : M) (i : α) + +/-- Replace the value of a `α →₀ M` at a given point `a : α` by a given value `b : M`. +If `b = 0`, this amounts to removing `a` from the `finsupp.support`. +Otherwise, if `a` was not in the `finsupp.support`, it is added to it. + +This is the finitely-supported version of `function.update`. -/ +def update (f : α →₀ M) (a : α) (b : M) : α →₀ M := +{ support := by haveI := classical.dec_eq α; haveI := classical.dec_eq M; exact + if b = 0 then f.support.erase a else insert a f.support, + to_fun := by haveI := classical.dec_eq α; exact + function.update f a b, + mem_support_to_fun := λ i, begin + simp only [function.update_apply, ne.def], + split_ifs with hb ha ha hb; + simp [ha, hb] + end } + +@[simp] lemma coe_update [decidable_eq α] : (f.update a b : α → M) = function.update f a b := +by convert rfl + +@[simp] lemma update_self : f.update a (f a) = f := +by { classical, ext, simp } + +@[simp] lemma zero_update : update 0 a b = single a b := +by { classical, ext, rw single_eq_update, refl } + +lemma support_update [decidable_eq α] [decidable_eq M] : + support (f.update a b) = if b = 0 then f.support.erase a else insert a f.support := +by convert rfl + +@[simp] lemma support_update_zero [decidable_eq α] : + support (f.update a 0) = f.support.erase a := by convert if_pos rfl + +variables {b} + +lemma support_update_ne_zero [decidable_eq α] (h : b ≠ 0) : + support (f.update a b) = insert a f.support := by { classical, convert if_neg h } + +end update + +/-! ### Declarations about `erase` -/ + +section erase + +variables [has_zero M] + +/-- +`erase a f` is the finitely supported function equal to `f` except at `a` where it is equal to `0`. +If `a` is not in the support of `f` then `erase a f = f`. +-/ +def erase (a : α) (f : α →₀ M) : α →₀ M := +{ support := by haveI := classical.dec_eq α; exact f.support.erase a, + to_fun := λ a', by haveI := classical.dec_eq α; exact if a' = a then 0 else f a', + mem_support_to_fun := assume a', by rw [mem_erase, mem_support_iff]; split_ifs; + [exact ⟨λ H _, H.1 h, λ H, (H rfl).elim⟩, + exact and_iff_right h] } + +@[simp] lemma support_erase [decidable_eq α] {a : α} {f : α →₀ M} : + (f.erase a).support = f.support.erase a := +by convert rfl + +@[simp] lemma erase_same {a : α} {f : α →₀ M} : (f.erase a) a = 0 := +by convert if_pos rfl + +@[simp] lemma erase_ne {a a' : α} {f : α →₀ M} (h : a' ≠ a) : (f.erase a) a' = f a' := +by { classical, convert if_neg h } + +@[simp] lemma erase_single {a : α} {b : M} : (erase a (single a b)) = 0 := +begin + ext s, by_cases hs : s = a, + { rw [hs, erase_same], refl }, + { rw [erase_ne hs], exact single_eq_of_ne (ne.symm hs) } +end + +lemma erase_single_ne {a a' : α} {b : M} (h : a ≠ a') : (erase a (single a' b)) = single a' b := +begin + ext s, by_cases hs : s = a, + { rw [hs, erase_same, single_eq_of_ne (h.symm)] }, + { rw [erase_ne hs] } +end + +@[simp] lemma erase_of_not_mem_support {f : α →₀ M} {a} (haf : a ∉ f.support) : erase a f = f := +begin + ext b, by_cases hab : b = a, + { rwa [hab, erase_same, eq_comm, ←not_mem_support_iff] }, + { rw erase_ne hab } +end + +@[simp] lemma erase_zero (a : α) : erase a (0 : α →₀ M) = 0 := +by { classical, rw [← support_eq_empty, support_erase, support_zero, erase_empty] } + +end erase + +/-! ### Declarations about `on_finset` -/ + +section on_finset +variables [has_zero M] + +/-- `on_finset s f hf` is the finsupp function representing `f` restricted to the finset `s`. +The function must be `0` outside of `s`. Use this when the set needs to be filtered anyways, +otherwise a better set representation is often available. -/ +def on_finset (s : finset α) (f : α → M) (hf : ∀a, f a ≠ 0 → a ∈ s) : α →₀ M := +{ support := by haveI := classical.dec_eq M; exact s.filter (λa, f a ≠ 0), + to_fun := f, + mem_support_to_fun := by simpa } + +@[simp] lemma on_finset_apply {s : finset α} {f : α → M} {hf a} : + (on_finset s f hf : α →₀ M) a = f a := +rfl + +@[simp] lemma support_on_finset_subset {s : finset α} {f : α → M} {hf} : + (on_finset s f hf).support ⊆ s := +by convert filter_subset _ _ + +@[simp] lemma mem_support_on_finset + {s : finset α} {f : α → M} (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) {a : α} : + a ∈ (finsupp.on_finset s f hf).support ↔ f a ≠ 0 := +by rw [finsupp.mem_support_iff, finsupp.on_finset_apply] + +lemma support_on_finset [decidable_eq M] + {s : finset α} {f : α → M} (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) : + (finsupp.on_finset s f hf).support = s.filter (λ a, f a ≠ 0) := +by convert rfl + +end on_finset + +section of_support_finite + +variables [has_zero M] + +/-- The natural `finsupp` induced by the function `f` given that it has finite support. -/ +noncomputable def of_support_finite + (f : α → M) (hf : (function.support f).finite) : α →₀ M := +{ support := hf.to_finset, + to_fun := f, + mem_support_to_fun := λ _, hf.mem_to_finset } + +lemma of_support_finite_coe {f : α → M} {hf : (function.support f).finite} : + (of_support_finite f hf : α → M) = f := rfl + +instance can_lift : can_lift (α → M) (α →₀ M) coe_fn (λ f, (function.support f).finite) := +{ prf := λ f hf, ⟨of_support_finite f hf, rfl⟩ } + +end of_support_finite + +/-! ### Declarations about `map_range` -/ + +section map_range +variables [has_zero M] [has_zero N] [has_zero P] + +/-- The composition of `f : M → N` and `g : α →₀ M` is `map_range f hf g : α →₀ N`, +which is well-defined when `f 0 = 0`. + +This preserves the structure on `f`, and exists in various bundled forms for when `f` is itself +bundled (defined in `data/finsupp/basic`): + +* `finsupp.map_range.equiv` +* `finsupp.map_range.zero_hom` +* `finsupp.map_range.add_monoid_hom` +* `finsupp.map_range.add_equiv` +* `finsupp.map_range.linear_map` +* `finsupp.map_range.linear_equiv` +-/ +def map_range (f : M → N) (hf : f 0 = 0) (g : α →₀ M) : α →₀ N := +on_finset g.support (f ∘ g) $ + assume a, by rw [mem_support_iff, not_imp_not]; exact λ H, (congr_arg f H).trans hf + +@[simp] lemma map_range_apply {f : M → N} {hf : f 0 = 0} {g : α →₀ M} {a : α} : + map_range f hf g a = f (g a) := +rfl + +@[simp] lemma map_range_zero {f : M → N} {hf : f 0 = 0} : map_range f hf (0 : α →₀ M) = 0 := +ext $ λ a, by simp only [hf, zero_apply, map_range_apply] + +@[simp] lemma map_range_id (g : α →₀ M) : map_range id rfl g = g := +ext $ λ _, rfl + +lemma map_range_comp + (f : N → P) (hf : f 0 = 0) (f₂ : M → N) (hf₂ : f₂ 0 = 0) (h : (f ∘ f₂) 0 = 0) (g : α →₀ M) : + map_range (f ∘ f₂) h g = map_range f hf (map_range f₂ hf₂ g) := +ext $ λ _, rfl + +lemma support_map_range {f : M → N} {hf : f 0 = 0} {g : α →₀ M} : + (map_range f hf g).support ⊆ g.support := +support_on_finset_subset + +@[simp] lemma map_range_single {f : M → N} {hf : f 0 = 0} {a : α} {b : M} : + map_range f hf (single a b) = single a (f b) := +ext $ λ a', begin + classical, + simpa only [single_eq_pi_single] using pi.apply_single _ (λ _, hf) a _ a' +end + +lemma support_map_range_of_injective + {e : M → N} (he0 : e 0 = 0) (f : ι →₀ M) (he : function.injective e) : + (finsupp.map_range e he0 f).support = f.support := +begin + ext, + simp only [finsupp.mem_support_iff, ne.def, finsupp.map_range_apply], + exact he.ne_iff' he0, +end + +end map_range + +/-! ### Declarations about `emb_domain` -/ + +section emb_domain +variables [has_zero M] [has_zero N] + +/-- Given `f : α ↪ β` and `v : α →₀ M`, `emb_domain f v : β →₀ M` +is the finitely supported function whose value at `f a : β` is `v a`. +For a `b : β` outside the range of `f`, it is zero. -/ +def emb_domain (f : α ↪ β) (v : α →₀ M) : β →₀ M := +{ support := v.support.map f, + to_fun := λ a₂, + by haveI := classical.dec_eq β; exact + if h : a₂ ∈ v.support.map f + then v (v.support.choose (λa₁, f a₁ = a₂) begin + rcases finset.mem_map.1 h with ⟨a, ha, rfl⟩, + exact exists_unique.intro a ⟨ha, rfl⟩ (assume b ⟨_, hb⟩, f.injective hb) + end) + else 0, + mem_support_to_fun := λ a₂, begin + split_ifs, + { simp only [h, true_iff, ne.def], + rw [← not_mem_support_iff, not_not], + apply finset.choose_mem }, + { simp only [h, ne.def, ne_self_iff_false] } + end } + +@[simp] lemma support_emb_domain (f : α ↪ β) (v : α →₀ M) : + (emb_domain f v).support = v.support.map f := +rfl + +@[simp] lemma emb_domain_zero (f : α ↪ β) : (emb_domain f 0 : β →₀ M) = 0 := +rfl + +@[simp] lemma emb_domain_apply (f : α ↪ β) (v : α →₀ M) (a : α) : + emb_domain f v (f a) = v a := +begin + classical, + change dite _ _ _ = _, + split_ifs; rw [finset.mem_map' f] at h, + { refine congr_arg (v : α → M) (f.inj' _), + exact finset.choose_property (λa₁, f a₁ = f a) _ _ }, + { exact (not_mem_support_iff.1 h).symm } +end + +lemma emb_domain_notin_range (f : α ↪ β) (v : α →₀ M) (a : β) (h : a ∉ set.range f) : + emb_domain f v a = 0 := +begin + classical, + refine dif_neg (mt (assume h, _) h), + rcases finset.mem_map.1 h with ⟨a, h, rfl⟩, + exact set.mem_range_self a +end + +lemma emb_domain_injective (f : α ↪ β) : + function.injective (emb_domain f : (α →₀ M) → (β →₀ M)) := +λ l₁ l₂ h, ext $ λ a, by simpa only [emb_domain_apply] using ext_iff.1 h (f a) + +@[simp] lemma emb_domain_inj {f : α ↪ β} {l₁ l₂ : α →₀ M} : + emb_domain f l₁ = emb_domain f l₂ ↔ l₁ = l₂ := +(emb_domain_injective f).eq_iff + +@[simp] lemma emb_domain_eq_zero {f : α ↪ β} {l : α →₀ M} : + emb_domain f l = 0 ↔ l = 0 := +(emb_domain_injective f).eq_iff' $ emb_domain_zero f + +lemma emb_domain_map_range + (f : α ↪ β) (g : M → N) (p : α →₀ M) (hg : g 0 = 0) : + emb_domain f (map_range g hg p) = map_range g hg (emb_domain f p) := +begin + ext a, + by_cases a ∈ set.range f, + { rcases h with ⟨a', rfl⟩, + rw [map_range_apply, emb_domain_apply, emb_domain_apply, map_range_apply] }, + { rw [map_range_apply, emb_domain_notin_range, emb_domain_notin_range, ← hg]; assumption } +end + +lemma single_of_emb_domain_single + (l : α →₀ M) (f : α ↪ β) (a : β) (b : M) (hb : b ≠ 0) + (h : l.emb_domain f = single a b) : + ∃ x, l = single x b ∧ f x = a := +begin + classical, + have h_map_support : finset.map f (l.support) = {a}, + by rw [←support_emb_domain, h, support_single_ne_zero _ hb]; refl, + have ha : a ∈ finset.map f (l.support), + by simp only [h_map_support, finset.mem_singleton], + rcases finset.mem_map.1 ha with ⟨c, hc₁, hc₂⟩, + use c, + split, + { ext d, + rw [← emb_domain_apply f l, h], + by_cases h_cases : c = d, + { simp only [eq.symm h_cases, hc₂, single_eq_same] }, + { rw [single_apply, single_apply, if_neg, if_neg h_cases], + by_contra hfd, + exact h_cases (f.injective (hc₂.trans hfd)) } }, + { exact hc₂ } +end + +@[simp] lemma emb_domain_single (f : α ↪ β) (a : α) (m : M) : + emb_domain f (single a m) = single (f a) m := +begin + classical, + ext b, + by_cases h : b ∈ set.range f, + { rcases h with ⟨a', rfl⟩, + simp [single_apply], }, + { simp only [emb_domain_notin_range, h, single_apply, not_false_iff], + rw if_neg, + rintro rfl, + simpa using h, }, +end + +end emb_domain + +/-! ### Declarations about `zip_with` -/ + +section zip_with +variables [has_zero M] [has_zero N] [has_zero P] + +/-- Given finitely supported functions `g₁ : α →₀ M` and `g₂ : α →₀ N` and function `f : M → N → P`, +`zip_with f hf g₁ g₂` is the finitely supported function `α →₀ P` satisfying +`zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a)`, which is well-defined when `f 0 0 = 0`. -/ +def zip_with (f : M → N → P) (hf : f 0 0 = 0) (g₁ : α →₀ M) (g₂ : α →₀ N) : α →₀ P := +on_finset + (by haveI := classical.dec_eq α; exact g₁.support ∪ g₂.support) + (λa, f (g₁ a) (g₂ a)) $ λ a H, + begin + simp only [mem_union, mem_support_iff, ne], rw [← not_and_distrib], + rintro ⟨h₁, h₂⟩, rw [h₁, h₂] at H, exact H hf + end + +@[simp] lemma zip_with_apply + {f : M → N → P} {hf : f 0 0 = 0} {g₁ : α →₀ M} {g₂ : α →₀ N} {a : α} : + zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a) := +rfl + +lemma support_zip_with [D : decidable_eq α] {f : M → N → P} {hf : f 0 0 = 0} + {g₁ : α →₀ M} {g₂ : α →₀ N} : (zip_with f hf g₁ g₂).support ⊆ g₁.support ∪ g₂.support := +by rw subsingleton.elim D; exact support_on_finset_subset + +end zip_with + +/-! ### Additive monoid structure on `α →₀ M` -/ + +section add_zero_class + +variables [add_zero_class M] + +instance : has_add (α →₀ M) := ⟨zip_with (+) (add_zero 0)⟩ + +@[simp] lemma coe_add (f g : α →₀ M) : ⇑(f + g) = f + g := rfl +lemma add_apply (g₁ g₂ : α →₀ M) (a : α) : (g₁ + g₂) a = g₁ a + g₂ a := rfl + +lemma support_add [decidable_eq α] {g₁ g₂ : α →₀ M} : + (g₁ + g₂).support ⊆ g₁.support ∪ g₂.support := +support_zip_with + +lemma support_add_eq [decidable_eq α] {g₁ g₂ : α →₀ M} (h : disjoint g₁.support g₂.support) : + (g₁ + g₂).support = g₁.support ∪ g₂.support := +le_antisymm support_zip_with $ assume a ha, +(finset.mem_union.1 ha).elim + (assume ha, have a ∉ g₂.support, from disjoint_left.1 h ha, + by simp only [mem_support_iff, not_not] at *; + simpa only [add_apply, this, add_zero]) + (assume ha, have a ∉ g₁.support, from disjoint_right.1 h ha, + by simp only [mem_support_iff, not_not] at *; + simpa only [add_apply, this, zero_add]) + +@[simp] lemma single_add (a : α) (b₁ b₂ : M) : single a (b₁ + b₂) = single a b₁ + single a b₂ := +ext $ assume a', +begin + by_cases h : a = a', + { rw [h, add_apply, single_eq_same, single_eq_same, single_eq_same] }, + { rw [add_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, zero_add] } +end + +instance : add_zero_class (α →₀ M) := +fun_like.coe_injective.add_zero_class _ coe_zero coe_add + +/-- `finsupp.single` as an `add_monoid_hom`. + +See `finsupp.lsingle` in `linear_algebra/finsupp` for the stronger version as a linear map. -/ +@[simps] def single_add_hom (a : α) : M →+ α →₀ M := +⟨single a, single_zero a, single_add a⟩ + +/-- Evaluation of a function `f : α →₀ M` at a point as an additive monoid homomorphism. + +See `finsupp.lapply` in `linear_algebra/finsupp` for the stronger version as a linear map. -/ +@[simps apply] +def apply_add_hom (a : α) : (α →₀ M) →+ M := ⟨λ g, g a, zero_apply, λ _ _, add_apply _ _ _⟩ + +/-- Coercion from a `finsupp` to a function type is an `add_monoid_hom`. -/ +@[simps] +noncomputable def coe_fn_add_hom : (α →₀ M) →+ (α → M) := +{ to_fun := coe_fn, + map_zero' := coe_zero, + map_add' := coe_add } + +lemma update_eq_single_add_erase (f : α →₀ M) (a : α) (b : M) : + f.update a b = single a b + f.erase a := +begin + classical, + ext j, + rcases eq_or_ne a j with rfl|h, + { simp }, + { simp [function.update_noteq h.symm, single_apply, h, erase_ne, h.symm] } +end + +lemma update_eq_erase_add_single (f : α →₀ M) (a : α) (b : M) : + f.update a b = f.erase a + single a b := +begin + classical, + ext j, + rcases eq_or_ne a j with rfl|h, + { simp }, + { simp [function.update_noteq h.symm, single_apply, h, erase_ne, h.symm] } +end + +lemma single_add_erase (a : α) (f : α →₀ M) : single a (f a) + f.erase a = f := +by rw [←update_eq_single_add_erase, update_self] + +lemma erase_add_single (a : α) (f : α →₀ M) : f.erase a + single a (f a) = f := +by rw [←update_eq_erase_add_single, update_self] + +@[simp] lemma erase_add (a : α) (f f' : α →₀ M) : erase a (f + f') = erase a f + erase a f' := +begin + ext s, by_cases hs : s = a, + { rw [hs, add_apply, erase_same, erase_same, erase_same, add_zero] }, + rw [add_apply, erase_ne hs, erase_ne hs, erase_ne hs, add_apply], +end + +/-- `finsupp.erase` as an `add_monoid_hom`. -/ +@[simps] +def erase_add_hom (a : α) : (α →₀ M) →+ (α →₀ M) := +{ to_fun := erase a, map_zero' := erase_zero a, map_add' := erase_add a } + +@[elab_as_eliminator] +protected theorem induction {p : (α →₀ M) → Prop} (f : α →₀ M) + (h0 : p 0) (ha : ∀a b (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (single a b + f)) : + p f := +suffices ∀s (f : α →₀ M), f.support = s → p f, from this _ _ rfl, +assume s, finset.cons_induction_on s (λ f hf, by rwa [support_eq_empty.1 hf]) $ +assume a s has ih f hf, +suffices p (single a (f a) + f.erase a), by rwa [single_add_erase] at this, +begin + classical, + apply ha, + { rw [support_erase, mem_erase], exact λ H, H.1 rfl }, + { rw [← mem_support_iff, hf], exact mem_cons_self _ _ }, + { apply ih _ _, + rw [support_erase, hf, finset.erase_cons] } +end + +lemma induction₂ {p : (α →₀ M) → Prop} (f : α →₀ M) + (h0 : p 0) (ha : ∀a b (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (f + single a b)) : + p f := +suffices ∀s (f : α →₀ M), f.support = s → p f, from this _ _ rfl, +assume s, finset.cons_induction_on s (λ f hf, by rwa [support_eq_empty.1 hf]) $ +assume a s has ih f hf, +suffices p (f.erase a + single a (f a)), by rwa [erase_add_single] at this, +begin + classical, + apply ha, + { rw [support_erase, mem_erase], exact λ H, H.1 rfl }, + { rw [← mem_support_iff, hf], + exact mem_cons_self _ _ }, + { apply ih _ _, + rw [support_erase, hf, finset.erase_cons] } +end + +lemma induction_linear {p : (α →₀ M) → Prop} (f : α →₀ M) + (h0 : p 0) (hadd : ∀ f g : α →₀ M, p f → p g → p (f + g)) (hsingle : ∀ a b, p (single a b)) : + p f := +induction₂ f h0 (λ a b f _ _ w, hadd _ _ w (hsingle _ _)) + +@[simp] lemma add_closure_set_of_eq_single : + add_submonoid.closure {f : α →₀ M | ∃ a b, f = single a b} = ⊤ := +top_unique $ λ x hx, finsupp.induction x (add_submonoid.zero_mem _) $ + λ a b f ha hb hf, add_submonoid.add_mem _ + (add_submonoid.subset_closure $ ⟨a, b, rfl⟩) hf + +/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`, +then they are equal. -/ +lemma add_hom_ext [add_zero_class N] ⦃f g : (α →₀ M) →+ N⦄ + (H : ∀ x y, f (single x y) = g (single x y)) : + f = g := +begin + refine add_monoid_hom.eq_of_eq_on_mdense add_closure_set_of_eq_single _, + rintro _ ⟨x, y, rfl⟩, + apply H +end + +/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`, +then they are equal. + +We formulate this using equality of `add_monoid_hom`s so that `ext` tactic can apply a type-specific +extensionality lemma after this one. E.g., if the fiber `M` is `ℕ` or `ℤ`, then it suffices to +verify `f (single a 1) = g (single a 1)`. -/ +@[ext] lemma add_hom_ext' [add_zero_class N] ⦃f g : (α →₀ M) →+ N⦄ + (H : ∀ x, f.comp (single_add_hom x) = g.comp (single_add_hom x)) : + f = g := +add_hom_ext $ λ x, add_monoid_hom.congr_fun (H x) + +lemma mul_hom_ext [mul_one_class N] ⦃f g : multiplicative (α →₀ M) →* N⦄ + (H : ∀ x y, f (multiplicative.of_add $ single x y) = g (multiplicative.of_add $ single x y)) : + f = g := +monoid_hom.ext $ add_monoid_hom.congr_fun $ + @add_hom_ext α M (additive N) _ _ f.to_additive'' g.to_additive'' H + +@[ext] lemma mul_hom_ext' [mul_one_class N] {f g : multiplicative (α →₀ M) →* N} + (H : ∀ x, f.comp (single_add_hom x).to_multiplicative = + g.comp (single_add_hom x).to_multiplicative) : + f = g := +mul_hom_ext $ λ x, monoid_hom.congr_fun (H x) + +lemma map_range_add [add_zero_class N] + {f : M → N} {hf : f 0 = 0} (hf' : ∀ x y, f (x + y) = f x + f y) (v₁ v₂ : α →₀ M) : + map_range f hf (v₁ + v₂) = map_range f hf v₁ + map_range f hf v₂ := +ext $ λ _, by simp only [hf', add_apply, map_range_apply] + +lemma map_range_add' [add_zero_class N] [add_monoid_hom_class β M N] + {f : β} (v₁ v₂ : α →₀ M) : + map_range f (map_zero f) (v₁ + v₂) = map_range f (map_zero f) v₁ + map_range f (map_zero f) v₂ := +map_range_add (map_add f) v₁ v₂ + +/-- Bundle `emb_domain f` as an additive map from `α →₀ M` to `β →₀ M`. -/ +@[simps] def emb_domain.add_monoid_hom (f : α ↪ β) : (α →₀ M) →+ β →₀ M := +{ to_fun := λ v, emb_domain f v, + map_zero' := by simp, + map_add' := λ v w, + begin + ext b, + by_cases h : b ∈ set.range f, + { rcases h with ⟨a, rfl⟩, + simp, }, + { simp [emb_domain_notin_range, h], }, + end, } + +@[simp] lemma emb_domain_add (f : α ↪ β) (v w : α →₀ M) : + emb_domain f (v + w) = emb_domain f v + emb_domain f w := +(emb_domain.add_monoid_hom f).map_add v w + +end add_zero_class + +section add_monoid + +variables [add_monoid M] + +/-- Note the general `finsupp.has_smul` instance doesn't apply as `ℕ` is not distributive +unless `β i`'s addition is commutative. -/ +instance has_nat_scalar : has_smul ℕ (α →₀ M) := +⟨λ n v, v.map_range ((•) n) (nsmul_zero _)⟩ + +instance : add_monoid (α →₀ M) := +fun_like.coe_injective.add_monoid _ coe_zero coe_add (λ _ _, rfl) + +end add_monoid + +instance [add_comm_monoid M] : add_comm_monoid (α →₀ M) := +fun_like.coe_injective.add_comm_monoid _ coe_zero coe_add (λ _ _, rfl) + +instance [neg_zero_class G] : has_neg (α →₀ G) := ⟨map_range (has_neg.neg) neg_zero⟩ + +@[simp] lemma coe_neg [neg_zero_class G] (g : α →₀ G) : ⇑(-g) = -g := rfl + +lemma neg_apply [neg_zero_class G] (g : α →₀ G) (a : α) : (- g) a = - g a := rfl + +lemma map_range_neg [neg_zero_class G] [neg_zero_class H] + {f : G → H} {hf : f 0 = 0} (hf' : ∀ x, f (-x) = -f x) (v : α →₀ G) : + map_range f hf (-v) = -map_range f hf v := +ext $ λ _, by simp only [hf', neg_apply, map_range_apply] + +lemma map_range_neg' [add_group G] [subtraction_monoid H] [add_monoid_hom_class β G H] + {f : β} (v : α →₀ G) : + map_range f (map_zero f) (-v) = -map_range f (map_zero f) v := +map_range_neg (map_neg f) v + +instance [sub_neg_zero_monoid G] : has_sub (α →₀ G) := ⟨zip_with has_sub.sub (sub_zero _)⟩ + +@[simp] lemma coe_sub [sub_neg_zero_monoid G] (g₁ g₂ : α →₀ G) : ⇑(g₁ - g₂) = g₁ - g₂ := +rfl + +lemma sub_apply [sub_neg_zero_monoid G] (g₁ g₂ : α →₀ G) (a : α) : (g₁ - g₂) a = g₁ a - g₂ a := rfl + +lemma map_range_sub [sub_neg_zero_monoid G] [sub_neg_zero_monoid H] + {f : G → H} {hf : f 0 = 0} (hf' : ∀ x y, f (x - y) = f x - f y) (v₁ v₂ : α →₀ G) : + map_range f hf (v₁ - v₂) = map_range f hf v₁ - map_range f hf v₂ := +ext $ λ _, by simp only [hf', sub_apply, map_range_apply] + +lemma map_range_sub' [add_group G] [subtraction_monoid H] [add_monoid_hom_class β G H] + {f : β} (v₁ v₂ : α →₀ G) : + map_range f (map_zero f) (v₁ - v₂) = map_range f (map_zero f) v₁ - map_range f (map_zero f) v₂ := +map_range_sub (map_sub f) v₁ v₂ + +/-- Note the general `finsupp.has_smul` instance doesn't apply as `ℤ` is not distributive +unless `β i`'s addition is commutative. -/ +instance has_int_scalar [add_group G] : has_smul ℤ (α →₀ G) := +⟨λ n v, v.map_range ((•) n) (zsmul_zero _)⟩ + +instance [add_group G] : add_group (α →₀ G) := +fun_like.coe_injective.add_group _ coe_zero coe_add coe_neg coe_sub + (λ _ _, rfl) (λ _ _, rfl) + +instance [add_comm_group G] : add_comm_group (α →₀ G) := +fun_like.coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub + (λ _ _, rfl) (λ _ _, rfl) + +lemma single_add_single_eq_single_add_single [add_comm_monoid M] + {k l m n : α} {u v : M} (hu : u ≠ 0) (hv : v ≠ 0) : + single k u + single l v = single m u + single n v ↔ + (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u + v = 0 ∧ k = l ∧ m = n) := +begin + classical, + simp_rw [fun_like.ext_iff, coe_add, single_eq_pi_single, ←funext_iff], + exact pi.single_add_single_eq_single_add_single hu hv, +end + +@[simp] lemma support_neg [add_group G] (f : α →₀ G) : support (-f) = support f := +finset.subset.antisymm + support_map_range + (calc support f = support (- (- f)) : congr_arg support (neg_neg _).symm + ... ⊆ support (- f) : support_map_range) + +lemma support_sub [decidable_eq α] [add_group G] {f g : α →₀ G} : + support (f - g) ⊆ support f ∪ support g := +begin + rw [sub_eq_add_neg, ←support_neg g], + exact support_add, +end + +lemma erase_eq_sub_single [add_group G] (f : α →₀ G) (a : α) : + f.erase a = f - single a (f a) := +begin + ext a', + rcases eq_or_ne a a' with rfl|h, + { simp }, + { simp [erase_ne h.symm, single_eq_of_ne h] } +end + +lemma update_eq_sub_add_single [add_group G] (f : α →₀ G) (a : α) (b : G) : + f.update a b = f - single a (f a) + single a b := +by rw [update_eq_erase_add_single, erase_eq_sub_single] + +end finsupp diff --git a/src/data/finsupp/fin.lean b/src/data/finsupp/fin.lean index e8ab345a5d6c9..eafd0136429cb 100644 --- a/src/data/finsupp/fin.lean +++ b/src/data/finsupp/fin.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Ivan Sadofschi Costa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Ivan Sadofschi Costa -/ -import data.fin.tuple -import data.finsupp.basic +import data.finsupp.defs + /-! # `cons` and `tail` for maps `fin n →₀ M` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We interpret maps `fin n →₀ M` as `n`-tuples of elements of `M`, We define the following operations: * `finsupp.tail` : the tail of a map `fin (n + 1) →₀ M`, i.e., its last `n` entries; @@ -24,38 +27,22 @@ namespace finsupp variables {n : ℕ} (i : fin n) {M : Type*} [has_zero M] (y : M) (t : fin (n + 1) →₀ M) (s : fin n →₀ M) - /-- `tail` for maps `fin (n + 1) →₀ M`. See `fin.tail` for more details. -/ def tail (s : fin (n + 1) →₀ M) : fin n →₀ M := -finsupp.equiv_fun_on_fintype.inv_fun (fin.tail s.to_fun) +finsupp.equiv_fun_on_finite.symm (fin.tail s) /-- `cons` for maps `fin n →₀ M`. See `fin.cons` for more details. -/ def cons (y : M) (s : fin n →₀ M) : fin (n + 1) →₀ M := -finsupp.equiv_fun_on_fintype.inv_fun (fin.cons y s.to_fun) +finsupp.equiv_fun_on_finite.symm (fin.cons y s : fin (n + 1) → M) -lemma tail_apply : tail t i = t i.succ := -begin - simp only [tail, equiv_fun_on_fintype_symm_apply_to_fun, equiv.inv_fun_as_coe], - refl, -end +lemma tail_apply : tail t i = t i.succ := rfl -@[simp] lemma cons_zero : cons y s 0 = y := -by simp [cons, finsupp.equiv_fun_on_fintype] +@[simp] lemma cons_zero : cons y s 0 = y := rfl -@[simp] lemma cons_succ : cons y s i.succ = s i := -begin - simp only [finsupp.cons, fin.cons, finsupp.equiv_fun_on_fintype, fin.cases_succ, finsupp.coe_mk], - refl, -end +@[simp] lemma cons_succ : cons y s i.succ = s i := fin.cons_succ _ _ _ @[simp] lemma tail_cons : tail (cons y s) = s := -begin - simp only [finsupp.cons, fin.cons, finsupp.tail, fin.tail], - ext, - simp only [equiv_fun_on_fintype_symm_apply_to_fun, equiv.inv_fun_as_coe, - finsupp.coe_mk, fin.cases_succ, equiv_fun_on_fintype], - refl, -end +ext $ λ k, by simp only [tail_apply, cons_succ] @[simp] lemma cons_tail : cons (t 0) (tail t) = t := begin diff --git a/src/data/finsupp/fintype.lean b/src/data/finsupp/fintype.lean new file mode 100644 index 0000000000000..9f776641e39f0 --- /dev/null +++ b/src/data/finsupp/fintype.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2022 Anne Baanen. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anne Baanen, Alex J. Best +-/ +import data.finsupp.defs +import data.fintype.basic + +/-! + +# Finiteness and infiniteness of `finsupp` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Some lemmas on the combination of `finsupp`, `fintype` and `infinite`. + +-/ + +noncomputable instance finsupp.fintype {ι π : Sort*} [decidable_eq ι] [has_zero π] + [fintype ι] [fintype π] : + fintype (ι →₀ π) := +fintype.of_equiv _ finsupp.equiv_fun_on_finite.symm + +instance finsupp.infinite_of_left {ι π : Sort*} [nontrivial π] [has_zero π] [infinite ι] : + infinite (ι →₀ π) := +let ⟨m, hm⟩ := exists_ne (0 : π) in infinite.of_injective _ $ finsupp.single_left_injective hm + +instance finsupp.infinite_of_right {ι π : Sort*} [infinite π] [has_zero π] [nonempty ι] : + infinite (ι →₀ π) := +infinite.of_injective (λ i, finsupp.single (classical.arbitrary ι) i) + (finsupp.single_injective (classical.arbitrary ι)) diff --git a/src/data/finsupp/indicator.lean b/src/data/finsupp/indicator.lean index 918c6da0c0ae8..a6449f604f820 100644 --- a/src/data/finsupp/indicator.lean +++ b/src/data/finsupp/indicator.lean @@ -3,11 +3,14 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import data.finsupp.basic +import data.finsupp.defs /-! # Building finitely supported functions off finsets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `finsupp.indicator` to help create finsupps from finsets. ## Main declarations @@ -18,7 +21,6 @@ This file defines `finsupp.indicator` to help create finsupps from finsets. noncomputable theory open finset function -open_locale classical variables {ι α : Type*} @@ -27,20 +29,26 @@ variables [has_zero α] {s : finset ι} (f : Π i ∈ s, α) {i : ι} /-- Create an element of `ι →₀ α` from a finset `s` and a function `f` defined on this finset. -/ def indicator (s : finset ι) (f : Π i ∈ s, α) : ι →₀ α := -{ to_fun := λ i, if H : i ∈ s then f i H else 0, - support := (s.attach.filter $ λ i : s, f i.1 i.2 ≠ 0).map $ embedding.subtype _, +{ to_fun := λ i, by haveI := classical.dec_eq ι; exact + if H : i ∈ s then f i H else 0, + support := by haveI := classical.dec_eq α; exact + (s.attach.filter $ λ i : s, f i.1 i.2 ≠ 0).map (embedding.subtype _), mem_support_to_fun := λ i, begin + letI := classical.dec_eq α, rw [mem_map, dite_ne_right_iff], exact ⟨λ ⟨⟨j, hj⟩, hf, rfl⟩, ⟨hj, (mem_filter.1 hf).2⟩, λ ⟨hi, hf⟩, ⟨⟨i, hi⟩, mem_filter.2 $ ⟨mem_attach _ _, hf⟩, rfl⟩⟩, end } -lemma indicator_of_mem (hi : i ∈ s) (f : Π i ∈ s, α) : indicator s f i = f i hi := dif_pos hi -lemma indicator_of_not_mem (hi : i ∉ s) (f : Π i ∈ s, α) : indicator s f i = 0 := dif_neg hi +lemma indicator_of_mem (hi : i ∈ s) (f : Π i ∈ s, α) : indicator s f i = f i hi := +@dif_pos _ (id _) hi _ _ _ +lemma indicator_of_not_mem (hi : i ∉ s) (f : Π i ∈ s, α) : indicator s f i = 0 := +@dif_neg _ (id _) hi _ _ _ variables (s i) -@[simp] lemma indicator_apply : indicator s f i = if hi : i ∈ s then f i hi else 0 := rfl +@[simp] lemma indicator_apply [decidable_eq ι] : + indicator s f i = if hi : i ∈ s then f i hi else 0 := by convert rfl lemma indicator_injective : injective (λ f : Π i ∈ s, α, indicator s f) := begin @@ -58,4 +66,8 @@ begin exact hi (indicator_of_not_mem h _), end +lemma single_eq_indicator (i : ι) (b : α) : + single i b = indicator {i} (λ _ _, b) := +by { classical, ext, simp [single_apply, indicator_apply, @eq_comm _ a] } + end finsupp diff --git a/src/data/finsupp/interval.lean b/src/data/finsupp/interval.lean index e82f01c069ac3..b05e89043e75b 100644 --- a/src/data/finsupp/interval.lean +++ b/src/data/finsupp/interval.lean @@ -10,6 +10,9 @@ import data.finsupp.order /-! # Finite intervals of finitely supported functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides the `locally_finite_order` instance for `ι →₀ α` when `α` itself is locally finite and calculates the cardinality of its finite intervals. @@ -51,40 +54,82 @@ section range_Icc variables [has_zero α] [partial_order α] [locally_finite_order α] {f g : ι →₀ α} {i : ι} {a : α} /-- Pointwise `finset.Icc` bundled as a `finsupp`. -/ -@[simps] def range_Icc (f g : ι →₀ α) : ι →₀ finset α := +@[simps to_fun] def range_Icc (f g : ι →₀ α) : ι →₀ finset α := { to_fun := λ i, Icc (f i) (g i), - support := f.support ∪ g.support, + support := by haveI := classical.dec_eq ι; exact f.support ∪ g.support, mem_support_to_fun := λ i, begin rw [mem_union, ←not_iff_not, not_or_distrib, not_mem_support_iff, not_mem_support_iff, not_ne_iff], exact Icc_eq_singleton_iff.symm, end } +@[simp] lemma range_Icc_support [decidable_eq ι] (f g : ι →₀ α) : + (range_Icc f g).support = f.support ∪ g.support := +by convert rfl + lemma mem_range_Icc_apply_iff : a ∈ f.range_Icc g i ↔ f i ≤ a ∧ a ≤ g i := mem_Icc end range_Icc +section partial_order variables [partial_order α] [has_zero α] [locally_finite_order α] (f g : ι →₀ α) instance : locally_finite_order (ι →₀ α) := +by haveI := classical.dec_eq ι; haveI := classical.dec_eq α; exact locally_finite_order.of_Icc (ι →₀ α) (λ f g, (f.support ∪ g.support).finsupp $ f.range_Icc g) (λ f g x, begin - refine (mem_finsupp_iff_of_support_subset $ subset.rfl).trans _, + refine (mem_finsupp_iff_of_support_subset $ finset.subset_of_eq $ + range_Icc_support _ _).trans _, simp_rw mem_range_Icc_apply_iff, exact forall_and_distrib, end) -lemma card_Icc : (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card := -card_finsupp _ _ +lemma Icc_eq [decidable_eq ι] : Icc f g = (f.support ∪ g.support).finsupp (f.range_Icc g) := +by convert rfl + +lemma card_Icc [decidable_eq ι] : + (Icc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card := +by simp_rw [Icc_eq, card_finsupp, range_Icc_to_fun] -lemma card_Ico : (Ico f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 := +lemma card_Ico [decidable_eq ι] : + (Ico f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 := by rw [card_Ico_eq_card_Icc_sub_one, card_Icc] -lemma card_Ioc : (Ioc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 := +lemma card_Ioc [decidable_eq ι] : + (Ioc f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 1 := by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc] -lemma card_Ioo : (Ioo f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 2 := +lemma card_Ioo [decidable_eq ι] : + (Ioo f g).card = ∏ i in f.support ∪ g.support, (Icc (f i) (g i)).card - 2 := by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc] +end partial_order + +section lattice +variables [lattice α] [has_zero α] [locally_finite_order α] (f g : ι →₀ α) + +lemma card_uIcc [decidable_eq ι] : + (uIcc f g).card = ∏ i in f.support ∪ g.support, (uIcc (f i) (g i)).card := +by { rw ←support_inf_union_support_sup, exact card_Icc _ _ } + +end lattice + +section canonically_ordered +variables [canonically_ordered_add_monoid α] [locally_finite_order α] + +variables (f : ι →₀ α) + +lemma card_Iic : (Iic f).card = ∏ i in f.support, (Iic (f i)).card := +begin + classical, + simp_rw [Iic_eq_Icc, card_Icc, finsupp.bot_eq_zero, support_zero, empty_union, zero_apply, + bot_eq_zero] +end + +lemma card_Iio : (Iio f).card = ∏ i in f.support, (Iic (f i)).card - 1 := +by rw [card_Iio_eq_card_Iic_sub_one, card_Iic] + +end canonically_ordered + end finsupp diff --git a/src/data/finsupp/lex.lean b/src/data/finsupp/lex.lean new file mode 100644 index 0000000000000..09fdd2c4fc9ef --- /dev/null +++ b/src/data/finsupp/lex.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import data.finsupp.order +import data.dfinsupp.lex +import data.finsupp.to_dfinsupp + +/-! +# Lexicographic order on finitely supported functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the lexicographic order on `finsupp`. +-/ + +variables {α N : Type*} + +namespace finsupp + +section N_has_zero +variables [has_zero N] + +/-- `finsupp.lex r s` is the lexicographic relation on `α →₀ N`, where `α` is ordered by `r`, +and `N` is ordered by `s`. + +The type synonym `lex (α →₀ N)` has an order given by `finsupp.lex (<) (<)`. +-/ +protected def lex (r : α → α → Prop) (s : N → N → Prop) (x y : α →₀ N) : Prop := +pi.lex r (λ _, s) x y + +lemma _root_.pi.lex_eq_finsupp_lex {r : α → α → Prop} {s : N → N → Prop} (a b : α →₀ N) : + pi.lex r (λ _, s) (a : α → N) (b : α → N) = finsupp.lex r s a b := +rfl + +lemma lex_def {r : α → α → Prop} {s : N → N → Prop} {a b : α →₀ N} : + finsupp.lex r s a b ↔ ∃ j, (∀ d, r d j → a d = b d) ∧ s (a j) (b j) := iff.rfl + +lemma lex_eq_inv_image_dfinsupp_lex (r : α → α → Prop) (s : N → N → Prop) : + finsupp.lex r s = inv_image (dfinsupp.lex r $ λ a, s) to_dfinsupp := rfl + +instance [has_lt α] [has_lt N] : has_lt (lex (α →₀ N)) := +⟨λ f g, finsupp.lex (<) (<) (of_lex f) (of_lex g)⟩ + +lemma lex_lt_of_lt_of_preorder [preorder N] (r) [is_strict_order α r] + {x y : α →₀ N} (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i := +dfinsupp.lex_lt_of_lt_of_preorder r (id hlt : x.to_dfinsupp < y.to_dfinsupp) + +lemma lex_lt_of_lt [partial_order N] (r) [is_strict_order α r] + {x y : α →₀ N} (hlt : x < y) : pi.lex r (λ i, (<)) x y := +dfinsupp.lex_lt_of_lt r (id hlt : x.to_dfinsupp < y.to_dfinsupp) + +instance lex.is_strict_order [linear_order α] [partial_order N] : + is_strict_order (lex (α →₀ N)) (<) := +let i : is_strict_order (lex (α → N)) (<) := pi.lex.is_strict_order in +{ irrefl := to_lex.surjective.forall.2 $ λ a, @irrefl _ _ i.to_is_irrefl a, + trans := to_lex.surjective.forall₃.2 $ λ a b c, @trans _ _ i.to_is_trans a b c } + +variables [linear_order α] + +/-- The partial order on `finsupp`s obtained by the lexicographic ordering. +See `finsupp.lex.linear_order` for a proof that this partial order is in fact linear. -/ +instance lex.partial_order [partial_order N] : partial_order (lex (α →₀ N)) := +partial_order.lift (λ x, to_lex ⇑(of_lex x)) finsupp.coe_fn_injective--fun_like.coe_injective + +/-- The linear order on `finsupp`s obtained by the lexicographic ordering. -/ +instance lex.linear_order [linear_order N] : linear_order (lex (α →₀ N)) := +{ ..lex.partial_order, + ..linear_order.lift' (to_lex ∘ to_dfinsupp ∘ of_lex) finsupp_equiv_dfinsupp.injective } + +variable [partial_order N] + +lemma to_lex_monotone : monotone (@to_lex (α →₀ N)) := +λ a b h, dfinsupp.to_lex_monotone (id h : ∀ i, of_lex (to_dfinsupp a) i ≤ of_lex (to_dfinsupp b) i) + +lemma lt_of_forall_lt_of_lt (a b : lex (α →₀ N)) (i : α) : + (∀ j < i, of_lex a j = of_lex b j) → of_lex a i < of_lex b i → a < b := +λ h1 h2, ⟨i, h1, h2⟩ + +end N_has_zero + +section covariants +variables [linear_order α] [add_monoid N] [linear_order N] + +/-! We are about to sneak in a hypothesis that might appear to be too strong. +We assume `covariant_class` with *strict* inequality `<` also when proving the one with the +*weak* inequality `≤`. This is actually necessary: addition on `lex (α →₀ N)` may fail to be +monotone, when it is "just" monotone on `N`. + +See `counterexamples.zero_divisors_in_add_monoid_algebras` for a counterexample. -/ +section left +variables [covariant_class N N (+) (<)] + +instance lex.covariant_class_lt_left : covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (+) (<) := +⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg ((+) _) (lta j ja), add_lt_add_left ha _⟩⟩ + +instance lex.covariant_class_le_left : covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (+) (≤) := +has_add.to_covariant_class_left _ + +end left + +section right +variables [covariant_class N N (function.swap (+)) (<)] + +instance lex.covariant_class_lt_right : + covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (function.swap (+)) (<) := +⟨λ f g h ⟨a, lta, ha⟩, ⟨a, λ j ja, congr_arg (+ (of_lex f j)) (lta j ja), add_lt_add_right ha _⟩⟩ + +instance lex.covariant_class_le_right : + covariant_class (lex (α →₀ N)) (lex (α →₀ N)) (function.swap (+)) (≤) := +has_add.to_covariant_class_right _ + +end right + +end covariants + +end finsupp diff --git a/src/data/finsupp/multiset.lean b/src/data/finsupp/multiset.lean index 22074554cfe59..f9d687b13f87f 100644 --- a/src/data/finsupp/multiset.lean +++ b/src/data/finsupp/multiset.lean @@ -3,11 +3,15 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl -/ +import data.finsupp.basic import data.finsupp.order /-! # Equivalence between `multiset` and `ℕ`-valued finitely supported functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines `finsupp.to_multiset` the equivalence between `α →₀ ℕ` and `multiset α`, along with `multiset.to_finsupp` the reverse equivalence and `finsupp.order_iso_multiset` the equivalence promoted to an order isomorphism. @@ -89,7 +93,7 @@ begin { rw [to_multiset_zero, multiset.to_finset_zero, support_zero] }, { assume a n f ha hn ih, rw [to_multiset_add, multiset.to_finset_add, ih, to_multiset_single, support_add_eq, - support_single_ne_zero hn, multiset.to_finset_nsmul _ _ hn, multiset.to_finset_singleton], + support_single_ne_zero _ hn, multiset.to_finset_nsmul _ _ hn, multiset.to_finset_singleton], refine disjoint.mono_left support_single_subset _, rwa [finset.disjoint_singleton_left] } end diff --git a/src/data/finsupp/ne_locus.lean b/src/data/finsupp/ne_locus.lean new file mode 100644 index 0000000000000..3a37840ccb78e --- /dev/null +++ b/src/data/finsupp/ne_locus.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2022 Damiano Testa. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Damiano Testa +-/ +import data.finsupp.defs + +/-! +# Locus of unequal values of finitely supported functions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Let `α N` be two Types, assume that `N` has a `0` and let `f g : α →₀ N` be finitely supported +functions. + +## Main definition + +* `finsupp.ne_locus f g : finset α`, the finite subset of `α` where `f` and `g` differ. + +In the case in which `N` is an additive group, `finsupp.ne_locus f g` coincides with +`finsupp.support (f - g)`. +-/ + +variables {α M N P : Type*} + +namespace finsupp +variable [decidable_eq α] + +section N_has_zero +variables [decidable_eq N] [has_zero N] (f g : α →₀ N) + +/-- Given two finitely supported functions `f g : α →₀ N`, `finsupp.ne_locus f g` is the `finset` +where `f` and `g` differ. This generalizes `(f - g).support` to situations without subtraction. -/ +def ne_locus (f g : α →₀ N) : finset α := +(f.support ∪ g.support).filter (λ x, f x ≠ g x) + +@[simp] lemma mem_ne_locus {f g : α →₀ N} {a : α} : a ∈ f.ne_locus g ↔ f a ≠ g a := +by simpa only [ne_locus, finset.mem_filter, finset.mem_union, mem_support_iff, + and_iff_right_iff_imp] using ne.ne_or_ne _ + +lemma not_mem_ne_locus {f g : α →₀ N} {a : α} : a ∉ f.ne_locus g ↔ f a = g a := +mem_ne_locus.not.trans not_ne_iff + +@[simp] lemma coe_ne_locus : ↑(f.ne_locus g) = {x | f x ≠ g x} := +by { ext, exact mem_ne_locus } + +@[simp] lemma ne_locus_eq_empty {f g : α →₀ N} : f.ne_locus g = ∅ ↔ f = g := +⟨λ h, ext (λ a, not_not.mp (mem_ne_locus.not.mp (finset.eq_empty_iff_forall_not_mem.mp h a))), + λ h, h ▸ by simp only [ne_locus, ne.def, eq_self_iff_true, not_true, finset.filter_false]⟩ + +@[simp] lemma nonempty_ne_locus_iff {f g : α →₀ N} : (f.ne_locus g).nonempty ↔ f ≠ g := +finset.nonempty_iff_ne_empty.trans ne_locus_eq_empty.not + +lemma ne_locus_comm : f.ne_locus g = g.ne_locus f := +by simp_rw [ne_locus, finset.union_comm, ne_comm] + +@[simp] +lemma ne_locus_zero_right : f.ne_locus 0 = f.support := +by { ext, rw [mem_ne_locus, mem_support_iff, coe_zero, pi.zero_apply] } + +@[simp] +lemma ne_locus_zero_left : (0 : α →₀ N).ne_locus f = f.support := +(ne_locus_comm _ _).trans (ne_locus_zero_right _) + +end N_has_zero + +section ne_locus_and_maps + +lemma subset_map_range_ne_locus [decidable_eq N] [has_zero N] [decidable_eq M] [has_zero M] + (f g : α →₀ N) {F : N → M} (F0 : F 0 = 0) : + (f.map_range F F0).ne_locus (g.map_range F F0) ⊆ f.ne_locus g := +λ x, by simpa only [mem_ne_locus, map_range_apply, not_imp_not] using congr_arg F + +lemma zip_with_ne_locus_eq_left [decidable_eq N] [has_zero M] [decidable_eq P] [has_zero P] + [has_zero N] {F : M → N → P} (F0 : F 0 0 = 0) + (f : α →₀ M) (g₁ g₂ : α →₀ N) (hF : ∀ f, function.injective (λ g, F f g)) : + (zip_with F F0 f g₁).ne_locus (zip_with F F0 f g₂) = g₁.ne_locus g₂ := +by { ext, simpa only [mem_ne_locus] using (hF _).ne_iff } + +lemma zip_with_ne_locus_eq_right [decidable_eq M] [has_zero M] [decidable_eq P] [has_zero P] + [has_zero N] {F : M → N → P} (F0 : F 0 0 = 0) + (f₁ f₂ : α →₀ M) (g : α →₀ N) (hF : ∀ g, function.injective (λ f, F f g)) : + (zip_with F F0 f₁ g).ne_locus (zip_with F F0 f₂ g) = f₁.ne_locus f₂ := +by { ext, simpa only [mem_ne_locus] using (hF _).ne_iff } + +lemma map_range_ne_locus_eq [decidable_eq N] [decidable_eq M] [has_zero M] [has_zero N] + (f g : α →₀ N) {F : N → M} (F0 : F 0 = 0) (hF : function.injective F) : + (f.map_range F F0).ne_locus (g.map_range F F0) = f.ne_locus g := +by { ext, simpa only [mem_ne_locus] using hF.ne_iff } + +end ne_locus_and_maps + +variables [decidable_eq N] + +@[simp] lemma ne_locus_add_left [add_left_cancel_monoid N] (f g h : α →₀ N) : + (f + g).ne_locus (f + h) = g.ne_locus h := +zip_with_ne_locus_eq_left _ _ _ _ add_right_injective + +@[simp] lemma ne_locus_add_right [add_right_cancel_monoid N] (f g h : α →₀ N) : + (f + h).ne_locus (g + h) = f.ne_locus g := +zip_with_ne_locus_eq_right _ _ _ _ add_left_injective + +section add_group +variables [add_group N] (f f₁ f₂ g g₁ g₂ : α →₀ N) + +@[simp] lemma ne_locus_neg_neg : ne_locus (-f) (-g) = f.ne_locus g := +map_range_ne_locus_eq _ _ neg_zero neg_injective + +lemma ne_locus_neg : ne_locus (-f) g = f.ne_locus (-g) := by rw [←ne_locus_neg_neg, neg_neg] + +lemma ne_locus_eq_support_sub : f.ne_locus g = (f - g).support := +by rw [←ne_locus_add_right _ _ (-g), add_right_neg, ne_locus_zero_right, sub_eq_add_neg] + +@[simp] lemma ne_locus_sub_left : ne_locus (f - g₁) (f - g₂) = ne_locus g₁ g₂ := +by simp only [sub_eq_add_neg, ne_locus_add_left, ne_locus_neg_neg] + +@[simp] lemma ne_locus_sub_right : ne_locus (f₁ - g) (f₂ - g) = ne_locus f₁ f₂ := +by simpa only [sub_eq_add_neg] using ne_locus_add_right _ _ _ + +@[simp] lemma ne_locus_self_add_right : ne_locus f (f + g) = g.support := +by rw [←ne_locus_zero_left, ←ne_locus_add_left f 0 g, add_zero] + +@[simp] lemma ne_locus_self_add_left : ne_locus (f + g) f = g.support := +by rw [ne_locus_comm, ne_locus_self_add_right] + +@[simp] lemma ne_locus_self_sub_right : ne_locus f (f - g) = g.support := +by rw [sub_eq_add_neg, ne_locus_self_add_right, support_neg] + +@[simp] lemma ne_locus_self_sub_left : ne_locus (f - g) f = g.support := +by rw [ne_locus_comm, ne_locus_self_sub_right] + +end add_group +end finsupp diff --git a/src/data/finsupp/order.lean b/src/data/finsupp/order.lean index ca2d3b3d1f3a5..b5aa762727bc9 100644 --- a/src/data/finsupp/order.lean +++ b/src/data/finsupp/order.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin, Aaron Anderson -/ -import data.finsupp.basic +import data.finsupp.defs /-! # Pointwise order on finitely supported functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file lifts order structures on `α` to `ι →₀ α`. ## Main declarations @@ -19,7 +22,7 @@ This file lifts order structures on `α` to `ι →₀ α`. -/ noncomputable theory -open_locale classical big_operators +open_locale big_operators open finset @@ -83,8 +86,18 @@ instance [semilattice_sup α] : semilattice_sup (ι →₀ α) := @[simp] lemma sup_apply [semilattice_sup α] {i : ι} {f g : ι →₀ α} : (f ⊔ g) i = f i ⊔ g i := rfl -instance lattice [lattice α] : lattice (ι →₀ α) := -{ .. finsupp.semilattice_inf, .. finsupp.semilattice_sup } +instance [lattice α] : lattice (ι →₀ α) := { ..finsupp.semilattice_inf, ..finsupp.semilattice_sup } + +section lattice +variables [decidable_eq ι] [lattice α] (f g : ι →₀ α) + +lemma support_inf_union_support_sup : (f ⊓ g).support ∪ (f ⊔ g).support = f.support ∪ g.support := +coe_injective $ compl_injective $ by { ext, simp [inf_eq_and_sup_eq_iff] } + +lemma support_sup_union_support_inf : (f ⊔ g).support ∪ (f ⊓ g).support = f.support ∪ g.support := +(union_comm _ _).trans $ support_inf_union_support_sup _ _ + +end lattice end has_zero @@ -96,7 +109,6 @@ instance [ordered_add_comm_monoid α] : ordered_add_comm_monoid (ι →₀ α) : instance [ordered_cancel_add_comm_monoid α] : ordered_cancel_add_comm_monoid (ι →₀ α) := { le_of_add_le_add_left := λ f g i h s, le_of_add_le_add_left (h s), - add_left_cancel := λ f g i h, ext $ λ s, add_left_cancel (ext_iff.1 h s), .. finsupp.ordered_add_comm_monoid } instance [ordered_add_comm_monoid α] [contravariant_class α α (+) (≤)] : @@ -117,7 +129,8 @@ by simp [ext_iff, forall_and_distrib] lemma le_iff' (f g : ι →₀ α) {s : finset ι} (hf : f.support ⊆ s) : f ≤ g ↔ ∀ i ∈ s, f i ≤ g i := ⟨λ h s hs, h s, -λ h s, if H : s ∈ f.support then h s (hf H) else (not_mem_support_iff.1 H).symm ▸ zero_le (g s)⟩ +λ h s, by classical; exact + if H : s ∈ f.support then h s (hf H) else (not_mem_support_iff.1 H).symm ▸ zero_le (g s)⟩ lemma le_iff (f g : ι →₀ α) : f ≤ g ↔ ∀ i ∈ f.support, f i ≤ g i := le_iff' f g $ subset.refl _ @@ -136,13 +149,8 @@ instance tsub : has_sub (ι →₀ α) := ⟨zip_with (λ m n, m - n) (tsub_self instance : has_ordered_sub (ι →₀ α) := ⟨λ n m k, forall_congr $ λ x, tsub_le_iff_right⟩ instance : canonically_ordered_add_monoid (ι →₀ α) := -{ le_iff_exists_add := λ f g, begin - refine ⟨λ h, ⟨g - f, _⟩, _⟩, - { ext x, - exact (add_tsub_cancel_of_le $ h x).symm }, - { rintro ⟨g, rfl⟩ x, - exact self_le_add_right (f x) (g x) } - end, +{ exists_add_of_le := λ f g h, ⟨g - f, ext $ λ x, (add_tsub_cancel_of_le $ h x).symm⟩, + le_self_add := λ f g x, le_self_add, .. finsupp.order_bot, .. finsupp.ordered_add_comm_monoid } @@ -162,15 +170,17 @@ lemma support_tsub {f1 f2 : ι →₀ α} : (f1 - f2).support ⊆ f1.support := by simp only [subset_iff, tsub_eq_zero_iff_le, mem_support_iff, ne.def, coe_tsub, pi.sub_apply, not_imp_not, zero_le, implies_true_iff] {contextual := tt} -lemma subset_support_tsub {f1 f2 : ι →₀ α} : f1.support \ f2.support ⊆ (f1 - f2).support := +lemma subset_support_tsub [decidable_eq ι] {f1 f2 : ι →₀ α} : + f1.support \ f2.support ⊆ (f1 - f2).support := by simp [subset_iff] {contextual := tt} end canonically_ordered_add_monoid section canonically_linear_ordered_add_monoid -variables [canonically_linear_ordered_add_monoid α] [decidable_eq ι] {f g : ι →₀ α} +variables [canonically_linear_ordered_add_monoid α] -@[simp] lemma support_inf : (f ⊓ g).support = f.support ∩ g.support := +@[simp] lemma support_inf [decidable_eq ι] (f g : ι →₀ α) : + (f ⊓ g).support = f.support ∩ g.support := begin ext, simp only [inf_apply, mem_support_iff, ne.def, @@ -178,15 +188,17 @@ begin simp only [inf_eq_min, ←nonpos_iff_eq_zero, min_le_iff, not_or_distrib], end -@[simp] lemma support_sup : (f ⊔ g).support = f.support ∪ g.support := +@[simp] lemma support_sup [decidable_eq ι] (f g : ι →₀ α) : + (f ⊔ g).support = f.support ∪ g.support := begin ext, simp only [finset.mem_union, mem_support_iff, sup_apply, ne.def, ←bot_eq_zero], rw [_root_.sup_eq_bot_iff, not_and_distrib], end -lemma disjoint_iff : disjoint f g ↔ disjoint f.support g.support := +lemma disjoint_iff {f g : ι →₀ α} : disjoint f g ↔ disjoint f.support g.support := begin + classical, rw [disjoint_iff, disjoint_iff, finsupp.bot_eq_zero, ← finsupp.support_eq_empty, finsupp.support_inf], refl, diff --git a/src/data/finsupp/pointwise.lean b/src/data/finsupp/pointwise.lean index 17a4c91e3e405..e2de0c10f122e 100644 --- a/src/data/finsupp/pointwise.lean +++ b/src/data/finsupp/pointwise.lean @@ -3,11 +3,15 @@ Copyright (c) 2020 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import data.finsupp.basic +import data.finsupp.defs +import algebra.ring.pi /-! # The pointwise product on `finsupp`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + For the convolution product on `finsupp` when the domain has a binary operation, see the type synonyms `add_monoid_algebra` (which is in turn used to define `polynomial` and `mv_polynomial`) @@ -77,10 +81,10 @@ instance [non_unital_comm_ring β] : non_unital_comm_ring (α →₀ β) := finsupp.coe_fn_injective.non_unital_comm_ring _ coe_zero coe_add coe_mul coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl) --- TODO can this be generalized in the direction of `pi.has_scalar'` +-- TODO can this be generalized in the direction of `pi.has_smul'` -- (i.e. dependent functions and finsupps) -- TODO in theory this could be generalised, we only really need `smul_zero` for the definition -instance pointwise_scalar [semiring β] : has_scalar (α → β) (α →₀ β) := +instance pointwise_scalar [semiring β] : has_smul (α → β) (α →₀ β) := { smul := λ f g, finsupp.of_support_finite (λ a, f a • g a) begin apply set.finite.subset g.finite_support, simp only [function.support_subset_iff, finsupp.mem_support_iff, ne.def, diff --git a/src/data/finsupp/pwo.lean b/src/data/finsupp/pwo.lean index 0334cc2d8fcd6..572dbef6e3bc1 100644 --- a/src/data/finsupp/pwo.lean +++ b/src/data/finsupp/pwo.lean @@ -6,10 +6,12 @@ Authors: Alex J. Best import data.finsupp.order import order.well_founded_set - /-! # Partial well ordering on finsupps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the fact that finitely supported functions from a fintype are partially well ordered when the codomain is a linear order that is well ordered. It is in a separate file for now so as to not add imports to the file `order.well_founded_set`. @@ -24,14 +26,11 @@ It is in a separate file for now so as to not add imports to the file `order.wel Dickson, order, partial well order -/ - /-- A version of **Dickson's lemma** any subset of functions `σ →₀ α` is partially well -ordered, when `σ` is a `fintype` and `α` is a linear well order. -This version uses finsupps on a fintype as it is intended for use with `mv_power_series`. +ordered, when `σ` is `finite` and `α` is a linear well order. +This version uses finsupps on a finite type as it is intended for use with `mv_power_series`. -/ -lemma finsupp.is_pwo {α σ : Type*} [has_zero α] [linear_order α] [is_well_order α (<)] [fintype σ] +lemma finsupp.is_pwo {α σ : Type*} [has_zero α] [linear_order α] [is_well_order α (<)] [finite σ] (S : set (σ →₀ α)) : S.is_pwo := -begin - rw ← finsupp.equiv_fun_on_fintype.symm.image_preimage S, - refine set.partially_well_ordered_on.image_of_monotone_on (pi.is_pwo _) (λ a b ha hb, id), -end +finsupp.equiv_fun_on_finite.symm_image_image S ▸ + set.partially_well_ordered_on.image_of_monotone_on (pi.is_pwo _) (λ a b ha hb, id) diff --git a/src/data/finsupp/to_dfinsupp.lean b/src/data/finsupp/to_dfinsupp.lean index 5f5784a57584c..e855ec369bbb3 100644 --- a/src/data/finsupp/to_dfinsupp.lean +++ b/src/data/finsupp/to_dfinsupp.lean @@ -10,6 +10,9 @@ import data.finsupp.basic /-! # Conversion between `finsupp` and homogenous `dfinsupp` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module provides conversions between `finsupp` and `dfinsupp`. It is in its own file since neither `finsupp` or `dfinsupp` depend on each other. @@ -65,7 +68,9 @@ section defs /-- Interpret a `finsupp` as a homogenous `dfinsupp`. -/ def finsupp.to_dfinsupp [has_zero M] (f : ι →₀ M) : Π₀ i : ι, M := -⟦⟨f, f.support.1, λ i, (classical.em (f i = 0)).symm.imp_left (finsupp.mem_support_iff.mpr)⟩⟧ +{ to_fun := f, + support' := trunc.mk + ⟨f.support.1, λ i, (classical.em (f i = 0)).symm.imp_left (finsupp.mem_support_iff.mpr)⟩ } @[simp] lemma finsupp.to_dfinsupp_coe [has_zero M] (f : ι →₀ M) : ⇑f.to_dfinsupp = f := rfl @@ -196,7 +201,6 @@ section sigma /-- ### Stronger versions of `finsupp.split` -/ noncomputable theory -open_locale classical variables {η : ι → Type*} {N : Type*} [semiring R] @@ -204,13 +208,15 @@ open finsupp /-- `finsupp.split` is an equivalence between `(Σ i, η i) →₀ N` and `Π₀ i, (η i →₀ N)`. -/ def sigma_finsupp_equiv_dfinsupp [has_zero N] : ((Σ i, η i) →₀ N) ≃ (Π₀ i, (η i →₀ N)) := -{ to_fun := λ f, ⟦⟨split f, (split_support f : finset ι).val, λ i, +{ to_fun := λ f, ⟨split f, trunc.mk ⟨(split_support f : finset ι).val, λ i, begin - rw [← finset.mem_def, mem_split_support_iff_nonzero], - exact (decidable.em _).symm - end⟩⟧, + rw [← finset.mem_def, mem_split_support_iff_nonzero], + exact (em _).symm + end⟩⟩, inv_fun := λ f, begin + haveI := classical.dec_eq ι, + haveI := λ i, classical.dec_eq (η i →₀ N), refine on_finset (finset.sigma f.support (λ j, (f j).support)) (λ ji, f ji.1 ji.2) (λ g hg, finset.mem_sigma.mpr ⟨_, mem_support_iff.mpr hg⟩), simp only [ne.def, dfinsupp.mem_support_to_fun], @@ -230,7 +236,9 @@ lemma sigma_finsupp_equiv_dfinsupp_symm_apply [has_zero N] (f : Π₀ i, (η i (sigma_finsupp_equiv_dfinsupp.symm f : (Σ i, η i) →₀ N) s = f s.1 s.2 := rfl @[simp] -lemma sigma_finsupp_equiv_dfinsupp_support [has_zero N] (f : (Σ i, η i) →₀ N) : +lemma sigma_finsupp_equiv_dfinsupp_support + [decidable_eq ι] [has_zero N] [Π (i : ι) (x : η i →₀ N), decidable (x ≠ 0)] + (f : (Σ i, η i) →₀ N) : (sigma_finsupp_equiv_dfinsupp f).support = finsupp.split_support f := begin ext, @@ -238,7 +246,8 @@ begin exact (finsupp.mem_split_support_iff_nonzero _ _).symm, end -@[simp] lemma sigma_finsupp_equiv_dfinsupp_single [has_zero N] (a : Σ i, η i) (n : N) : +@[simp] lemma sigma_finsupp_equiv_dfinsupp_single [decidable_eq ι] [has_zero N] + (a : Σ i, η i) (n : N) : sigma_finsupp_equiv_dfinsupp (finsupp.single a n) = @dfinsupp.single _ (λ i, η i →₀ N) _ _ a.1 (finsupp.single a.2 n) := begin @@ -246,10 +255,12 @@ begin ext j b, by_cases h : i = j, { subst h, + classical, simp [split_apply, finsupp.single_apply] }, suffices : finsupp.single (⟨i, a⟩ : Σ i, η i) n ⟨j, b⟩ = 0, { simp [split_apply, dif_neg h, this] }, have H : (⟨i, a⟩ : Σ i, η i) ≠ ⟨j, b⟩ := by simp [h], + classical, rw [finsupp.single_apply, if_neg H] end @@ -276,7 +287,7 @@ local attribute [-instance] finsupp.add_zero_class @[simp] lemma sigma_finsupp_equiv_dfinsupp_smul {R} [monoid R] [add_monoid N] [distrib_mul_action R N] (r : R) (f : (Σ i, η i) →₀ N) : sigma_finsupp_equiv_dfinsupp (r • f) = - @has_scalar.smul R (Π₀ i, η i →₀ N) mul_action.to_has_scalar r (sigma_finsupp_equiv_dfinsupp f) := + @has_smul.smul R (Π₀ i, η i →₀ N) mul_action.to_has_smul r (sigma_finsupp_equiv_dfinsupp f) := by { ext, refl } local attribute [-instance] finsupp.add_monoid diff --git a/src/data/finsupp/well_founded.lean b/src/data/finsupp/well_founded.lean new file mode 100644 index 0000000000000..9a9450b297ebc --- /dev/null +++ b/src/data/finsupp/well_founded.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2022 Junyan Xu. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Junyan Xu +-/ +import data.dfinsupp.well_founded +import data.finsupp.lex + +/-! +# Well-foundedness of the lexicographic and product orders on `finsupp` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +`finsupp.lex.well_founded` and the two variants that follow it essentially say that if +`(>)` is a well order on `α`, `(<)` is well-founded on `N`, and `0` is a bottom element in `N`, +then the lexicographic `(<)` is well-founded on `α →₀ N`. + +`finsupp.lex.well_founded_lt_of_finite` says that if `α` is finite and equipped with a linear +order and `(<)` is well-founded on `N`, then the lexicographic `(<)` is well-founded on `α →₀ N`. + +`finsupp.well_founded_lt` and `well_founded_lt_of_finite` state the same results for the product +order `(<)`, but without the ordering conditions on `α`. + +All results are transferred from `dfinsupp` via `finsupp.to_dfinsupp`. +-/ + +variables {α N : Type*} + +namespace finsupp + +variables [hz : has_zero N] {r : α → α → Prop} {s : N → N → Prop} + (hbot : ∀ ⦃n⦄, ¬ s n 0) (hs : well_founded s) +include hbot hs + +/-- Transferred from `dfinsupp.lex.acc`. See the top of that file for an explanation for the + appearance of the relation `rᶜ ⊓ (≠)`. -/ +lemma lex.acc (x : α →₀ N) (h : ∀ a ∈ x.support, acc (rᶜ ⊓ (≠)) a) : acc (finsupp.lex r s) x := +begin + rw lex_eq_inv_image_dfinsupp_lex, classical, + refine inv_image.accessible to_dfinsupp (dfinsupp.lex.acc (λ a, hbot) (λ a, hs) _ _), + simpa only [to_dfinsupp_support] using h, +end + +theorem lex.well_founded (hr : well_founded $ rᶜ ⊓ (≠)) : well_founded (finsupp.lex r s) := +⟨λ x, lex.acc hbot hs x $ λ a _, hr.apply a⟩ + +theorem lex.well_founded' [is_trichotomous α r] + (hr : well_founded r.swap) : well_founded (finsupp.lex r s) := +(lex_eq_inv_image_dfinsupp_lex r s).symm ▸ + inv_image.wf _ (dfinsupp.lex.well_founded' (λ a, hbot) (λ a, hs) hr) + +omit hbot hs + +instance lex.well_founded_lt [has_lt α] [is_trichotomous α (<)] [hα : well_founded_gt α] + [canonically_ordered_add_monoid N] [hN : well_founded_lt N] : well_founded_lt (lex (α →₀ N)) := +⟨lex.well_founded' (λ n, (zero_le n).not_lt) hN.wf hα.wf⟩ + +variable (r) + +theorem lex.well_founded_of_finite [is_strict_total_order α r] [finite α] [has_zero N] + (hs : well_founded s) : well_founded (finsupp.lex r s) := +inv_image.wf (@equiv_fun_on_finite α N _ _) (pi.lex.well_founded r $ λ a, hs) + +theorem lex.well_founded_lt_of_finite [linear_order α] [finite α] [has_zero N] [has_lt N] + [hwf : well_founded_lt N] : well_founded_lt (lex (α →₀ N)) := +⟨finsupp.lex.well_founded_of_finite (<) hwf.1⟩ + +protected theorem well_founded_lt [has_zero N] [preorder N] [well_founded_lt N] + (hbot : ∀ n : N, ¬ n < 0) : well_founded_lt (α →₀ N) := +⟨inv_image.wf to_dfinsupp (dfinsupp.well_founded_lt $ λ i a, hbot a).wf⟩ + +instance well_founded_lt' [canonically_ordered_add_monoid N] + [well_founded_lt N] : well_founded_lt (α →₀ N) := +finsupp.well_founded_lt $ λ a, (zero_le a).not_lt + +instance well_founded_lt_of_finite [finite α] [has_zero N] [preorder N] + [well_founded_lt N] : well_founded_lt (α →₀ N) := +⟨inv_image.wf equiv_fun_on_finite function.well_founded_lt.wf⟩ + +end finsupp diff --git a/src/data/fintype/array.lean b/src/data/fintype/array.lean new file mode 100644 index 0000000000000..134d9d2837d71 --- /dev/null +++ b/src/data/fintype/array.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.pi +import logic.equiv.array + +/-! +# `array n α` is a fintype when `α` is. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +instance d_array.fintype {n : ℕ} {α : fin n → Type*} + [∀ n, fintype (α n)] : fintype (d_array n α) := +fintype.of_equiv _ (equiv.d_array_equiv_fin _).symm + +instance array.fintype {n : ℕ} {α : Type*} [fintype α] : fintype (array n α) := +d_array.fintype diff --git a/src/data/fintype/basic.lean b/src/data/fintype/basic.lean index f323070c5ba65..88ddb700bf59b 100644 --- a/src/data/fintype/basic.lean +++ b/src/data/fintype/basic.lean @@ -3,23 +3,14 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.array.lemmas -import data.finset.fin -import data.finset.option -import data.finset.pi -import data.finset.powerset -import data.finset.prod -import data.finset.sigma -import data.list.nodup_equiv_fin -import data.sym.basic -import data.ulift -import group_theory.perm.basic -import order.well_founded -import tactic.wlog +import data.finset.image /-! # Finite types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a typeclass to state that a type is finite. ## Main declarations @@ -27,47 +18,28 @@ This file defines a typeclass to state that a type is finite. * `fintype α`: Typeclass saying that a type is finite. It takes as fields a `finset` and a proof that all terms of type `α` are in it. * `finset.univ`: The finset of all elements of a fintype. -* `fintype.card α`: Cardinality of a fintype. Equal to `finset.univ.card`. -* `perms_of_finset s`: The finset of permutations of the finset `s`. -* `fintype.trunc_equiv_fin`: A fintype `α` is computably equivalent to `fin (card α)`. The - `trunc`-free, noncomputable version is `fintype.equiv_fin`. -* `fintype.trunc_equiv_of_card_eq` `fintype.equiv_of_card_eq`: Two fintypes of same cardinality are - equivalent. See above. -* `fin.equiv_iff_eq`: `fin m ≃ fin n` iff `m = n`. -* `infinite α`: Typeclass saying that a type is infinite. Defined as `fintype α → false`. -* `not_fintype`: No `fintype` has an `infinite` instance. -* `infinite.nat_embedding`: An embedding of `ℕ` into an infinite type. - -We also provide the following versions of the pigeonholes principle. -* `fintype.exists_ne_map_eq_of_card_lt` and `is_empty_of_card_lt`: Finitely many pigeons and - pigeonholes. Weak formulation. -* `fintype.exists_ne_map_eq_of_infinite`: Infinitely many pigeons in finitely many pigeonholes. - Weak formulation. -* `fintype.exists_infinite_fiber`: Infinitely many pigeons in finitely many pigeonholes. Strong - formulation. - -Some more pigeonhole-like statements can be found in `data.fintype.card_embedding`. + +See `data.fintype.card` for the cardinality of a fintype, +the equivalence with `fin (fintype.card α)`, and pigeonhole principles. ## Instances -Among others, we provide `fintype` instances for -* A `subtype` of a fintype. See `fintype.subtype`. -* The `option` of a fintype. -* The product of two fintypes. -* The sum of two fintypes. -* `Prop`. - -and `infinite` instances for -* specific types: `ℕ`, `ℤ` -* type constructors: `set α`, `finset α`, `multiset α`, `list α`, `α ⊕ β`, `α × β` - -along with some machinery -* Types which have a surjection from/an injection to a `fintype` are themselves fintypes. See - `fintype.of_injective` and `fintype.of_surjective`. -* Types which have an injection from/a surjection to an `infinite` type are themselves `infinite`. - See `infinite.of_injective` and `infinite.of_surjective`. +Instances for `fintype` for +* `{x // p x}` are in this file as `fintype.subtype` +* `option α` are in `data.fintype.option` +* `α × β` are in `data.fintype.prod` +* `α ⊕ β` are in `data.fintype.sum` +* `Σ (a : α), β a` are in `data.fintype.sigma` + +These files also contain appropriate `infinite` instances for these types. + +`infinite` instances for `ℕ`, `ℤ`, `multiset α`, and `list α` are in `data.fintype.lattice`. + +Types which have a surjection from/an injection to a `fintype` are themselves fintypes. +See `fintype.of_injective` and `fintype.of_surjective`. -/ +open function open_locale nat universes u v @@ -83,7 +55,7 @@ class fintype (α : Type*) := (complete : ∀ x : α, x ∈ elems) namespace finset -variable [fintype α] +variables [fintype α] {s t : finset α} /-- `univ` is the universal finite set of type `finset α` implied from the assumption `fintype α`. -/ @@ -94,10 +66,15 @@ fintype.complete x @[simp] theorem mem_univ_val : ∀ x, x ∈ (univ : finset α).1 := mem_univ -lemma eq_univ_iff_forall {s : finset α} : s = univ ↔ ∀ x, x ∈ s := by simp [ext_iff] +lemma eq_univ_iff_forall : s = univ ↔ ∀ x, x ∈ s := by simp [ext_iff] +lemma eq_univ_of_forall : (∀ x, x ∈ s) → s = univ := eq_univ_iff_forall.2 -@[simp] lemma coe_univ : ↑(univ : finset α) = (set.univ : set α) := -by ext; simp +@[simp, norm_cast] lemma coe_univ : ↑(univ : finset α) = (set.univ : set α) := by ext; simp +@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = set.univ ↔ s = univ := +by rw [←coe_univ, coe_inj] + +lemma nonempty.eq_univ [subsingleton α] : s.nonempty → s = univ := +by { rintro ⟨x, hx⟩, refine eq_univ_of_forall (λ y, by rwa subsingleton.elim y x) } lemma univ_nonempty_iff : (univ : finset α).nonempty ↔ nonempty α := by rw [← coe_nonempty, coe_univ, set.nonempty_iff_univ_nonempty] @@ -115,21 +92,27 @@ finset.ext $ λ x, iff_of_true (mem_univ _) $ mem_singleton.2 $ subsingleton.eli @[simp] theorem subset_univ (s : finset α) : s ⊆ univ := λ a _, mem_univ a -instance : order_top (finset α) := +instance : bounded_order (finset α) := { top := univ, - le_top := subset_univ } + le_top := subset_univ, + .. finset.order_bot } + +@[simp] lemma top_eq_univ : (⊤ : finset α) = univ := rfl + +lemma ssubset_univ_iff {s : finset α} : s ⊂ univ ↔ s ≠ univ := @lt_top_iff_ne_top _ _ _ s + +lemma codisjoint_left : codisjoint s t ↔ ∀ ⦃a⦄, a ∉ s → a ∈ t := +by { classical, simp [codisjoint_iff, eq_univ_iff_forall, or_iff_not_imp_left] } + +lemma codisjoint_right : codisjoint s t ↔ ∀ ⦃a⦄, a ∉ t → a ∈ s := +codisjoint.comm.trans codisjoint_left section boolean_algebra -variables [decidable_eq α] {s : finset α} {a : α} +variables [decidable_eq α] {a : α} + +instance : boolean_algebra (finset α) := generalized_boolean_algebra.to_boolean_algebra -instance : boolean_algebra (finset α) := -{ compl := λ s, univ \ s, - inf_compl_le_bot := λ s x hx, by simpa using hx, - top_le_sup_compl := λ s x hx, by simp, - sdiff_eq := λ s t, by simp [ext_iff, compl], - ..finset.order_top, - ..finset.order_bot, - ..finset.generalized_boolean_algebra } +lemma sdiff_eq_inter_compl (s t : finset α) : s \ t = s ∩ tᶜ := sdiff_eq lemma compl_eq_univ_sdiff (s : finset α) : sᶜ = univ \ s := rfl @@ -142,6 +125,12 @@ set.ext $ λ x, mem_compl @[simp] lemma compl_empty : (∅ : finset α)ᶜ = univ := compl_bot +@[simp] lemma compl_univ : (univ : finset α)ᶜ = ∅ := compl_top + +@[simp] lemma compl_eq_empty_iff (s : finset α) : sᶜ = ∅ ↔ s = univ := compl_eq_bot + +@[simp] lemma compl_eq_univ_iff (s : finset α) : sᶜ = univ ↔ s = ∅ := compl_eq_top + @[simp] lemma union_compl (s : finset α) : s ∪ sᶜ = univ := sup_compl_eq_top @[simp] lemma inter_compl (s : finset α) : s ∩ sᶜ = ∅ := inf_compl_eq_bot @@ -172,8 +161,17 @@ by rw [compl_eq_univ_sdiff, sdiff_singleton_eq_erase] lemma insert_inj_on' (s : finset α) : set.inj_on (λ a, insert a s) (sᶜ : finset α) := by { rw coe_compl, exact s.insert_inj_on } +lemma image_univ_of_surjective [fintype β] {f : β → α} (hf : surjective f) : univ.image f = univ := +eq_univ_of_forall $ hf.forall.2 $ λ _, mem_image_of_mem _ $ mem_univ _ + end boolean_algebra +lemma map_univ_of_surjective [fintype β] {f : β ↪ α} (hf : surjective f) : univ.map f = univ := +eq_univ_of_forall $ hf.forall.2 $ λ _, mem_map_of_mem _ $ mem_univ _ + +@[simp] lemma map_univ_equiv [fintype β] (f : β ≃ α) : univ.map f.to_embedding = univ := +map_univ_of_surjective f.surjective + @[simp] lemma univ_inter [decidable_eq α] (s : finset α) : univ ∩ s = s := ext $ λ a, by simp @@ -212,23 +210,6 @@ univ_filter_exists f lemma coe_filter_univ (p : α → Prop) [decidable_pred p] : (univ.filter p : set α) = {x | p x} := by rw [coe_filter, coe_univ, set.sep_univ] -/-- A special case of `finset.sup_eq_supr` that omits the useless `x ∈ univ` binder. -/ -lemma sup_univ_eq_supr [complete_lattice β] (f : α → β) : finset.univ.sup f = supr f := -(sup_eq_supr _ f).trans $ congr_arg _ $ funext $ λ a, supr_pos (mem_univ _) - -/-- A special case of `finset.inf_eq_infi` that omits the useless `x ∈ univ` binder. -/ -lemma inf_univ_eq_infi [complete_lattice β] (f : α → β) : finset.univ.inf f = infi f := -sup_univ_eq_supr (by exact f : α → βᵒᵈ) - -@[simp] lemma fold_inf_univ [semilattice_inf α] [order_bot α] (a : α) : - finset.univ.fold (⊓) a (λ x, x) = ⊥ := -eq_bot_iff.2 $ ((finset.fold_op_rel_iff_and $ @_root_.le_inf_iff α _).1 le_rfl).2 ⊥ $ - finset.mem_univ _ - -@[simp] lemma fold_sup_univ [semilattice_sup α] [order_top α] (a : α) : - finset.univ.fold (⊔) a (λ x, x) = ⊤ := -@fold_inf_univ αᵒᵈ ‹fintype α› _ _ _ - end finset open finset function @@ -307,15 +288,6 @@ instance decidable_left_inverse_fintype [decidable_eq β] [fintype β] (f : α decidable (function.left_inverse f g) := show decidable (∀ x, f (g x) = x), by apply_instance -lemma exists_max [fintype α] [nonempty α] {β : Type*} [linear_order β] (f : α → β) : - ∃ x₀ : α, ∀ x, f x ≤ f x₀ := -by simpa using exists_max_image univ f univ_nonempty - -lemma exists_min [fintype α] [nonempty α] - {β : Type*} [linear_order β] (f : α → β) : - ∃ x₀ : α, ∀ x, f x₀ ≤ f x := -by simpa using exists_min_image univ f univ_nonempty - /-- Construct a proof of `fintype α` from a universal multiset -/ def of_multiset [decidable_eq α] (s : multiset α) (H : ∀ x : α, x ∈ s) : fintype α := @@ -326,60 +298,6 @@ def of_list [decidable_eq α] (l : list α) (H : ∀ x : α, x ∈ l) : fintype α := ⟨l.to_finset, by simpa using H⟩ -theorem exists_univ_list (α) [fintype α] : - ∃ l : list α, l.nodup ∧ ∀ x : α, x ∈ l := -let ⟨l, e⟩ := quotient.exists_rep (@univ α _).1 in -by have := and.intro univ.2 mem_univ_val; - exact ⟨_, by rwa ←e at this⟩ - -/-- `card α` is the number of elements in `α`, defined when `α` is a fintype. -/ -def card (α) [fintype α] : ℕ := (@univ α _).card - -/-- There is (computably) an equivalence between `α` and `fin (card α)`. - -Since it is not unique and depends on which permutation -of the universe list is used, the equivalence is wrapped in `trunc` to -preserve computability. - -See `fintype.equiv_fin` for the noncomputable version, -and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` -for an equiv `α ≃ fin n` given `fintype.card α = n`. - -See `fintype.trunc_fin_bijection` for a version without `[decidable_eq α]`. --/ -def trunc_equiv_fin (α) [decidable_eq α] [fintype α] : trunc (α ≃ fin (card α)) := -by { unfold card finset.card, - exact quot.rec_on_subsingleton (@univ α _).1 - (λ l (h : ∀ x : α, x ∈ l) (nd : l.nodup), - trunc.mk (nd.nth_le_equiv_of_forall_mem_list _ h).symm) - mem_univ_val univ.2 } - -/-- There is (noncomputably) an equivalence between `α` and `fin (card α)`. - -See `fintype.trunc_equiv_fin` for the computable version, -and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` -for an equiv `α ≃ fin n` given `fintype.card α = n`. --/ -noncomputable def equiv_fin (α) [fintype α] : α ≃ fin (card α) := -by { letI := classical.dec_eq α, exact (trunc_equiv_fin α).out } - -/-- There is (computably) a bijection between `fin (card α)` and `α`. - -Since it is not unique and depends on which permutation -of the universe list is used, the bijection is wrapped in `trunc` to -preserve computability. - -See `fintype.trunc_equiv_fin` for a version that gives an equivalence -given `[decidable_eq α]`. --/ -def trunc_fin_bijection (α) [fintype α] : - trunc {f : fin (card α) → α // bijective f} := -by { dunfold card finset.card, - exact quot.rec_on_subsingleton (@univ α _).1 - (λ l (h : ∀ x : α, x ∈ l) (nd : l.nodup), - trunc.mk (nd.nth_le_bijection_of_forall_mem_list _ h)) - mem_univ_val univ.2 } - instance (α : Type*) : subsingleton (fintype α) := ⟨λ ⟨s₁, h₁⟩ ⟨s₂, h₂⟩, by congr; simp [finset.ext_iff, h₁, h₂]⟩ @@ -391,27 +309,10 @@ protected def subtype {p : α → Prop} (s : finset α) (H : ∀ x : α, x ∈ s s.nodup.pmap $ λ a _ b _, congr_arg subtype.val⟩, λ ⟨x, px⟩, multiset.mem_pmap.2 ⟨x, (H x).2 px, rfl⟩⟩ -theorem subtype_card {p : α → Prop} (s : finset α) (H : ∀ x : α, x ∈ s ↔ p x) : - @card {x // p x} (fintype.subtype s H) = s.card := -multiset.card_pmap _ _ _ - -theorem card_of_subtype {p : α → Prop} (s : finset α) (H : ∀ x : α, x ∈ s ↔ p x) - [fintype {x // p x}] : - card {x // p x} = s.card := -by { rw ← subtype_card s H, congr } - /-- Construct a fintype from a finset with the same elements. -/ def of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : fintype p := fintype.subtype s H -@[simp] theorem card_of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : - @fintype.card p (of_finset s H) = s.card := -fintype.subtype_card s H - -theorem card_of_finset' {p : set α} (s : finset α) - (H : ∀ x, x ∈ s ↔ x ∈ p) [fintype p] : fintype.card p = s.card := -by rw ←card_of_finset s H; congr - /-- If `f : α → β` is a bijection and `α` is a fintype, then `β` is also a fintype. -/ def of_bijective [fintype α] (f : α → β) (H : function.bijective f) : fintype β := ⟨univ.map ⟨f, H.1⟩, @@ -424,6 +325,16 @@ def of_surjective [decidable_eq β] [fintype α] (f : α → β) (H : function.s end fintype +namespace finset +variables [fintype α] [decidable_eq α] {s t : finset α} + +instance decidable_codisjoint : decidable (codisjoint s t) := +decidable_of_iff _ codisjoint_left.symm + +instance decidable_is_compl : decidable (is_compl s t) := decidable_of_iff' _ is_compl_iff + +end finset + section inv namespace function @@ -522,66 +433,6 @@ else ⟨∅, λ x, (hα ⟨x⟩).elim⟩ /-- If `f : α ≃ β` and `α` is a fintype, then `β` is also a fintype. -/ def of_equiv (α : Type*) [fintype α] (f : α ≃ β) : fintype β := of_bijective _ f.bijective -theorem of_equiv_card [fintype α] (f : α ≃ β) : - @card β (of_equiv α f) = card α := -multiset.card_map _ _ - -theorem card_congr {α β} [fintype α] [fintype β] (f : α ≃ β) : card α = card β := -by rw ← of_equiv_card f; congr - -@[congr] -lemma card_congr' {α β} [fintype α] [fintype β] (h : α = β) : card α = card β := -card_congr (by rw h) - -section - -variables [fintype α] [fintype β] - -/-- If the cardinality of `α` is `n`, there is computably a bijection between `α` and `fin n`. - -See `fintype.equiv_fin_of_card_eq` for the noncomputable definition, -and `fintype.trunc_equiv_fin` and `fintype.equiv_fin` for the bijection `α ≃ fin (card α)`. --/ -def trunc_equiv_fin_of_card_eq [decidable_eq α] {n : ℕ} (h : fintype.card α = n) : - trunc (α ≃ fin n) := -(trunc_equiv_fin α).map (λ e, e.trans (fin.cast h).to_equiv) - - -/-- If the cardinality of `α` is `n`, there is noncomputably a bijection between `α` and `fin n`. - -See `fintype.trunc_equiv_fin_of_card_eq` for the computable definition, -and `fintype.trunc_equiv_fin` and `fintype.equiv_fin` for the bijection `α ≃ fin (card α)`. --/ -noncomputable def equiv_fin_of_card_eq {n : ℕ} (h : fintype.card α = n) : - α ≃ fin n := -by { letI := classical.dec_eq α, exact (trunc_equiv_fin_of_card_eq h).out } - -/-- Two `fintype`s with the same cardinality are (computably) in bijection. - -See `fintype.equiv_of_card_eq` for the noncomputable version, -and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` for -the specialization to `fin`. --/ -def trunc_equiv_of_card_eq [decidable_eq α] [decidable_eq β] (h : card α = card β) : - trunc (α ≃ β) := -(trunc_equiv_fin_of_card_eq h).bind (λ e, (trunc_equiv_fin β).map (λ e', e.trans e'.symm)) - -/-- Two `fintype`s with the same cardinality are (noncomputably) in bijection. - -See `fintype.trunc_equiv_of_card_eq` for the computable version, -and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` for -the specialization to `fin`. --/ -noncomputable def equiv_of_card_eq (h : card α = card β) : α ≃ β := -by { letI := classical.dec_eq α, letI := classical.dec_eq β, - exact (trunc_equiv_of_card_eq h).out } - -end - -theorem card_eq {α β} [F : fintype α] [G : fintype β] : card α = card β ↔ nonempty (α ≃ β) := -⟨λ h, by { haveI := classical.prop_decidable, exact (trunc_equiv_of_card_eq h).nonempty }, - λ ⟨f⟩, card_congr f⟩ - /-- Any subsingleton type with a witness is a fintype (with one term). -/ def of_subsingleton (a : α) [subsingleton α] : fintype α := ⟨{a}, λ b, finset.mem_singleton.2 (subsingleton.elim _ _)⟩ @@ -589,16 +440,6 @@ def of_subsingleton (a : α) [subsingleton α] : fintype α := @[simp] theorem univ_of_subsingleton (a : α) [subsingleton α] : @univ _ (of_subsingleton a) = {a} := rfl -/-- Note: this lemma is specifically about `fintype.of_subsingleton`. For a statement about -arbitrary `fintype` instances, use either `fintype.card_le_one_iff_subsingleton` or -`fintype.card_unique`. -/ -@[simp] theorem card_of_subsingleton (a : α) [subsingleton α] : - @fintype.card _ (of_subsingleton a) = 1 := rfl - -@[simp] theorem card_unique [unique α] [h : fintype α] : - fintype.card α = 1 := -subsingleton.elim (of_subsingleton default) h ▸ card_of_subsingleton _ - @[priority 100] -- see Note [lower instance priority] instance of_is_empty [is_empty α] : fintype α := ⟨∅, is_empty_elim⟩ @@ -607,28 +448,14 @@ arbitrary `fintype` instances, use `finset.univ_eq_empty`. -/ -- no-lint since while `finset.univ_eq_empty` can prove this, it isn't applicable for `dsimp`. @[simp, nolint simp_nf] theorem univ_of_is_empty [is_empty α] : @univ α _ = ∅ := rfl -/-- Note: this lemma is specifically about `fintype.of_is_empty`. For a statement about -arbitrary `fintype` instances, use `fintype.card_eq_zero_iff`. -/ -@[simp] theorem card_of_is_empty [is_empty α] : fintype.card α = 0 := rfl - -open_locale classical -variables (α) - -/-- Any subsingleton type is (noncomputably) a fintype (with zero or one term). -/ -@[priority 5] -- see Note [lower instance priority] -noncomputable instance of_subsingleton' [subsingleton α] : fintype α := -if h : nonempty α then - of_subsingleton (nonempty.some h) -else - @fintype.of_is_empty _ $ not_nonempty_iff.mp h - end fintype namespace set +variables {s t : set α} /-- Construct a finset enumerating a set `s`, given a `fintype` instance. -/ def to_finset (s : set α) [fintype s] : finset α := -⟨(@finset.univ s _).1.map subtype.val, finset.univ.nodup.map $ λ a b, subtype.eq⟩ +(@finset.univ s _).map $ function.embedding.subtype _ @[congr] lemma to_finset_congr {s t : set α} [fintype s] [fintype t] (h : s = t) : @@ -638,114 +465,135 @@ by cc @[simp] theorem mem_to_finset {s : set α} [fintype s] {a : α} : a ∈ s.to_finset ↔ a ∈ s := by simp [to_finset] -@[simp] theorem mem_to_finset_val {s : set α} [fintype s] {a : α} : a ∈ s.to_finset.1 ↔ a ∈ s := -mem_to_finset +/-- Many `fintype` instances for sets are defined using an extensionally equal `finset`. +Rewriting `s.to_finset` with `set.to_finset_of_finset` replaces the term with such a `finset`. -/ +theorem to_finset_of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : + @set.to_finset _ p (fintype.of_finset s H) = s := +finset.ext (λ x, by rw [mem_to_finset, H]) --- We use an arbitrary `[fintype s]` instance here, --- not necessarily coming from a `[fintype α]`. -@[simp] -lemma to_finset_card {α : Type*} (s : set α) [fintype s] : - s.to_finset.card = fintype.card s := -multiset.card_map subtype.val finset.univ.val +/-- Membership of a set with a `fintype` instance is decidable. + +Using this as an instance leads to potential loops with `subtype.fintype` under certain decidability +assumptions, so it should only be declared a local instance. -/ +def decidable_mem_of_fintype [decidable_eq α] (s : set α) [fintype s] (a) : decidable (a ∈ s) := +decidable_of_iff _ mem_to_finset @[simp] theorem coe_to_finset (s : set α) [fintype s] : (↑s.to_finset : set α) = s := set.ext $ λ _, mem_to_finset +@[simp] lemma to_finset_nonempty {s : set α} [fintype s] : s.to_finset.nonempty ↔ s.nonempty := +by rw [←finset.coe_nonempty, coe_to_finset] + @[simp] theorem to_finset_inj {s t : set α} [fintype s] [fintype t] : s.to_finset = t.to_finset ↔ s = t := ⟨λ h, by rw [←s.coe_to_finset, h, t.coe_to_finset], λ h, by simp [h]; congr⟩ -@[simp, mono] theorem to_finset_mono {s t : set α} [fintype s] [fintype t] : - s.to_finset ⊆ t.to_finset ↔ s ⊆ t := +@[mono] +lemma to_finset_subset_to_finset [fintype s] [fintype t] : s.to_finset ⊆ t.to_finset ↔ s ⊆ t := by simp [finset.subset_iff, set.subset_def] -@[simp, mono] theorem to_finset_strict_mono {s t : set α} [fintype s] [fintype t] : - s.to_finset ⊂ t.to_finset ↔ s ⊂ t := -by simp only [finset.ssubset_def, to_finset_mono, ssubset_def] +@[simp] lemma to_finset_ssubset [fintype s] {t : finset α} : s.to_finset ⊂ t ↔ s ⊂ t := +by rw [←finset.coe_ssubset, coe_to_finset] + +@[simp] lemma subset_to_finset {s : finset α} [fintype t] : s ⊆ t.to_finset ↔ ↑s ⊆ t := +by rw [←finset.coe_subset, coe_to_finset] + +@[simp] lemma ssubset_to_finset {s : finset α} [fintype t] : s ⊂ t.to_finset ↔ ↑s ⊂ t := +by rw [←finset.coe_ssubset, coe_to_finset] + +@[mono] +lemma to_finset_ssubset_to_finset [fintype s] [fintype t] : s.to_finset ⊂ t.to_finset ↔ s ⊂ t := +by simp only [finset.ssubset_def, to_finset_subset_to_finset, ssubset_def] + +@[simp] lemma to_finset_subset [fintype s] {t : finset α} : s.to_finset ⊆ t ↔ s ⊆ t := +by rw [←finset.coe_subset, coe_to_finset] + +alias to_finset_subset_to_finset ↔ _ to_finset_mono +alias to_finset_ssubset_to_finset ↔ _ to_finset_strict_mono -@[simp] theorem to_finset_disjoint_iff [decidable_eq α] {s t : set α} [fintype s] [fintype t] : +@[simp] lemma disjoint_to_finset [fintype s] [fintype t] : disjoint s.to_finset t.to_finset ↔ disjoint s t := -by simp only [disjoint_iff_disjoint_coe, coe_to_finset] +by simp only [←disjoint_coe, coe_to_finset] -theorem to_finset_compl [decidable_eq α] [fintype α] (s : set α) [fintype s] [fintype ↥sᶜ] : - (sᶜ).to_finset = s.to_finsetᶜ := -by { ext a, simp } +section decidable_eq +variables [decidable_eq α] (s t) [fintype s] [fintype t] -lemma filter_mem_univ_eq_to_finset [fintype α] (s : set α) [fintype s] [decidable_pred (∈ s)] : - finset.univ.filter (∈ s) = s.to_finset := -by { ext, simp only [mem_filter, finset.mem_univ, true_and, mem_to_finset] } +@[simp] lemma to_finset_inter [fintype ↥(s ∩ t)] : (s ∩ t).to_finset = s.to_finset ∩ t.to_finset := +by { ext, simp } -end set +@[simp] lemma to_finset_union [fintype ↥(s ∪ t)] : (s ∪ t).to_finset = s.to_finset ∪ t.to_finset := +by { ext, simp } -lemma finset.card_univ [fintype α] : (finset.univ : finset α).card = fintype.card α := -rfl +@[simp] lemma to_finset_diff [fintype ↥(s \ t)] : (s \ t).to_finset = s.to_finset \ t.to_finset := +by { ext, simp } + +@[simp] lemma to_finset_symm_diff [fintype ↥(s ∆ t)] : + (s ∆ t).to_finset = s.to_finset ∆ t.to_finset := +by { ext, simp [mem_symm_diff, finset.mem_symm_diff] } -lemma finset.eq_univ_of_card [fintype α] (s : finset α) (hs : s.card = fintype.card α) : - s = univ := -eq_of_subset_of_card_le (subset_univ _) $ by rw [hs, finset.card_univ] +@[simp] lemma to_finset_compl [fintype α] [fintype ↥sᶜ] : sᶜ.to_finset = s.to_finsetᶜ := +by { ext, simp } -lemma finset.card_eq_iff_eq_univ [fintype α] (s : finset α) : - s.card = fintype.card α ↔ s = finset.univ := -⟨s.eq_univ_of_card, by { rintro rfl, exact finset.card_univ, }⟩ +end decidable_eq -lemma finset.card_le_univ [fintype α] (s : finset α) : - s.card ≤ fintype.card α := -card_le_of_subset (subset_univ s) +/- TODO The `↥` circumvents an elaboration bug. See comment on `set.to_finset_univ`. -/ +@[simp] lemma to_finset_empty [fintype ↥(∅ : set α)] : (∅ : set α).to_finset = ∅ := by { ext, simp } -lemma finset.card_lt_univ_of_not_mem [fintype α] {s : finset α} {x : α} (hx : x ∉ s) : - s.card < fintype.card α := -card_lt_card ⟨subset_univ s, not_forall.2 ⟨x, λ hx', hx (hx' $ mem_univ x)⟩⟩ +/- TODO Without the coercion arrow (`↥`) there is an elaboration bug in the following two; +it essentially infers `fintype.{v} (set.univ.{u} : set α)` with `v` and `u` distinct. +Reported in leanprover-community/lean#672 -/ +@[simp] lemma to_finset_univ [fintype α] [fintype ↥(set.univ : set α)] : + (set.univ : set α).to_finset = finset.univ := +by { ext, simp } -lemma finset.card_lt_iff_ne_univ [fintype α] (s : finset α) : - s.card < fintype.card α ↔ s ≠ finset.univ := -s.card_le_univ.lt_iff_ne.trans (not_iff_not_of_iff s.card_eq_iff_eq_univ) +@[simp] lemma to_finset_eq_empty [fintype s] : s.to_finset = ∅ ↔ s = ∅ := +by rw [←to_finset_empty, to_finset_inj] -lemma finset.card_compl_lt_iff_nonempty [fintype α] [decidable_eq α] (s : finset α) : - sᶜ.card < fintype.card α ↔ s.nonempty := -sᶜ.card_lt_iff_ne_univ.trans s.compl_ne_univ_iff_nonempty +@[simp] lemma to_finset_eq_univ [fintype α] [fintype s] : s.to_finset = finset.univ ↔ s = univ := +by rw [← coe_inj, coe_to_finset, coe_univ] -lemma finset.card_univ_diff [decidable_eq α] [fintype α] (s : finset α) : - (finset.univ \ s).card = fintype.card α - s.card := -finset.card_sdiff (subset_univ s) +@[simp] lemma to_finset_set_of [fintype α] (p : α → Prop) [decidable_pred p] [fintype {x | p x}] : + {x | p x}.to_finset = finset.univ.filter p := +by { ext, simp } -lemma finset.card_compl [decidable_eq α] [fintype α] (s : finset α) : - sᶜ.card = fintype.card α - s.card := -finset.card_univ_diff s +@[simp] lemma to_finset_ssubset_univ [fintype α] {s : set α} [fintype s] : + s.to_finset ⊂ finset.univ ↔ s ⊂ univ := +by rw [← coe_ssubset, coe_to_finset, coe_univ] -lemma fintype.card_compl_set [fintype α] (s : set α) [fintype s] [fintype ↥sᶜ] : - fintype.card ↥sᶜ = fintype.card α - fintype.card s := -begin - classical, - rw [← set.to_finset_card, ← set.to_finset_card, ← finset.card_compl, set.to_finset_compl] -end +@[simp] +lemma to_finset_image [decidable_eq β] (f : α → β) (s : set α) [fintype s] [fintype (f '' s)] : + (f '' s).to_finset = s.to_finset.image f := +finset.coe_injective $ by simp -instance (n : ℕ) : fintype (fin n) := -⟨finset.fin_range n, finset.mem_fin_range⟩ +@[simp] lemma to_finset_range [decidable_eq α] [fintype β] (f : β → α) [fintype (set.range f)] : + (set.range f).to_finset = finset.univ.image f := +by { ext, simp } -lemma fin.univ_def (n : ℕ) : (univ : finset (fin n)) = finset.fin_range n := rfl +/- TODO The `↥` circumvents an elaboration bug. See comment on `set.to_finset_univ`. -/ +lemma to_finset_singleton (a : α) [fintype ↥({a} : set α)] : ({a} : set α).to_finset = {a} := +by { ext, simp } -@[simp] theorem fintype.card_fin (n : ℕ) : fintype.card (fin n) = n := -list.length_fin_range n +/- TODO The `↥` circumvents an elaboration bug. See comment on `set.to_finset_univ`. -/ +@[simp] lemma to_finset_insert [decidable_eq α] {a : α} {s : set α} + [fintype ↥(insert a s : set α)] [fintype s] : + (insert a s).to_finset = insert a s.to_finset := +by { ext, simp } -@[simp] lemma finset.card_fin (n : ℕ) : finset.card (finset.univ : finset (fin n)) = n := -by rw [finset.card_univ, fintype.card_fin] +lemma filter_mem_univ_eq_to_finset [fintype α] (s : set α) [fintype s] [decidable_pred (∈ s)] : + finset.univ.filter (∈ s) = s.to_finset := +by { ext, simp only [mem_filter, finset.mem_univ, true_and, mem_to_finset] } -/-- `fin` as a map from `ℕ` to `Type` is injective. Note that since this is a statement about -equality of types, using it should be avoided if possible. -/ -lemma fin_injective : function.injective fin := -λ m n h, - (fintype.card_fin m).symm.trans $ (fintype.card_congr $ equiv.cast h).trans (fintype.card_fin n) +end set -/-- A reversed version of `fin.cast_eq_cast` that is easier to rewrite with. -/ -theorem fin.cast_eq_cast' {n m : ℕ} (h : fin n = fin m) : - cast h = ⇑(fin.cast $ fin_injective h) := -(fin.cast_eq_cast _).symm +@[simp] lemma finset.to_finset_coe (s : finset α) [fintype ↥(s : set α)] : + (s : set α).to_finset = s := +ext $ λ _, set.mem_to_finset -lemma card_finset_fin_le {n : ℕ} (s : finset (fin n)) : s.card ≤ n := -by simpa only [fintype.card_fin] using s.card_le_univ +instance (n : ℕ) : fintype (fin n) := +⟨⟨list.fin_range n, list.nodup_fin_range n⟩, list.mem_fin_range⟩ -lemma fin.equiv_iff_eq {m n : ℕ} : nonempty (fin m ≃ fin n) ↔ m = n := - ⟨λ ⟨h⟩, by simpa using fintype.card_congr h, λ h, ⟨equiv.cast $ h ▸ rfl ⟩ ⟩ +lemma fin.univ_def (n : ℕ) : (univ : finset (fin n)) = ⟨list.fin_range n, list.nodup_fin_range n⟩ := +rfl @[simp] lemma fin.image_succ_above_univ {n : ℕ} (i : fin (n + 1)) : univ.image i.succ_above = {i}ᶜ := @@ -758,21 +606,26 @@ by rw [← fin.succ_above_zero, fin.image_succ_above_univ] (univ : finset (fin n)).image fin.cast_succ = {fin.last n}ᶜ := by rw [← fin.succ_above_last, fin.image_succ_above_univ] +/- The following three lemmas use `finset.cons` instead of `insert` and `finset.map` instead of +`finset.image` to reduce proof obligations downstream. -/ + /-- Embed `fin n` into `fin (n + 1)` by prepending zero to the `univ` -/ lemma fin.univ_succ (n : ℕ) : - (univ : finset (fin (n + 1))) = insert 0 (univ.image fin.succ) := -by simp + (univ : finset (fin (n + 1))) = + cons 0 (univ.map ⟨fin.succ, fin.succ_injective _⟩) (by simp [map_eq_image]) := +by simp [map_eq_image] /-- Embed `fin n` into `fin (n + 1)` by appending a new `fin.last n` to the `univ` -/ lemma fin.univ_cast_succ (n : ℕ) : - (univ : finset (fin (n + 1))) = insert (fin.last n) (univ.image fin.cast_succ) := -by simp + (univ : finset (fin (n + 1))) = + cons (fin.last n) (univ.map fin.cast_succ.to_embedding) (by simp [map_eq_image]) := +by simp [map_eq_image] /-- Embed `fin n` into `fin (n + 1)` by inserting around a specified pivot `p : fin (n + 1)` into the `univ` -/ lemma fin.univ_succ_above (n : ℕ) (p : fin (n + 1)) : - (univ : finset (fin (n + 1))) = insert p (univ.image (fin.succ_above p)) := -by simp + (univ : finset (fin (n + 1))) = cons p (univ.map $ (fin.succ_above p).to_embedding) (by simp) := +by simp [map_eq_image] @[instance, priority 10] def unique.fintype {α : Type*} [unique α] : fintype α := fintype.of_subsingleton default @@ -787,86 +640,26 @@ since that relies on a subsingleton elimination for `unique`. -/ instance fintype.subtype_eq' (y : α) : fintype {x // y = x} := fintype.subtype {y} (by simp [eq_comm]) -@[simp] lemma fintype.card_subtype_eq (y : α) [fintype {x // x = y}] : - fintype.card {x // x = y} = 1 := -fintype.card_unique - -@[simp] lemma fintype.card_subtype_eq' (y : α) [fintype {x // y = x}] : - fintype.card {x // y = x} = 1 := -fintype.card_unique - @[simp] theorem fintype.univ_empty : @univ empty _ = ∅ := rfl -@[simp] theorem fintype.card_empty : fintype.card empty = 0 := rfl - @[simp] theorem fintype.univ_pempty : @univ pempty _ = ∅ := rfl -@[simp] theorem fintype.card_pempty : fintype.card pempty = 0 := rfl - instance : fintype unit := fintype.of_subsingleton () theorem fintype.univ_unit : @univ unit _ = {()} := rfl -theorem fintype.card_unit : fintype.card unit = 1 := rfl - instance : fintype punit := fintype.of_subsingleton punit.star @[simp] theorem fintype.univ_punit : @univ punit _ = {punit.star} := rfl -@[simp] theorem fintype.card_punit : fintype.card punit = 1 := rfl - -instance : fintype bool := ⟨⟨tt ::ₘ ff ::ₘ 0, by simp⟩, λ x, by cases x; simp⟩ +instance : fintype bool := ⟨⟨{tt, ff}, by simp⟩, λ x, by cases x; simp⟩ @[simp] theorem fintype.univ_bool : @univ bool _ = {tt, ff} := rfl -instance units_int.fintype : fintype ℤˣ := -⟨{1, -1}, λ x, by cases int.units_eq_one_or x; simp *⟩ - -@[simp] lemma units_int.univ : (finset.univ : finset ℤˣ) = {1, -1} := rfl - instance additive.fintype : Π [fintype α], fintype (additive α) := id instance multiplicative.fintype : Π [fintype α], fintype (multiplicative α) := id -@[simp] theorem fintype.card_units_int : fintype.card ℤˣ = 2 := rfl - -@[simp] theorem fintype.card_bool : fintype.card bool = 2 := rfl - -instance {α : Type*} [fintype α] : fintype (option α) := -⟨univ.insert_none, λ a, by simp⟩ - -lemma univ_option (α : Type*) [fintype α] : (univ : finset (option α)) = insert_none univ := rfl - -@[simp] theorem fintype.card_option {α : Type*} [fintype α] : - fintype.card (option α) = fintype.card α + 1 := -(finset.card_cons _).trans $ congr_arg2 _ (card_map _) rfl - -/-- If `option α` is a `fintype` then so is `α` -/ -def fintype_of_option {α : Type*} [fintype (option α)] : fintype α := -⟨finset.erase_none (fintype.elems (option α)), λ x, mem_erase_none.mpr (fintype.complete (some x))⟩ - -/-- A type is a `fintype` if its successor (using `option`) is a `fintype`. -/ -def fintype_of_option_equiv [fintype α] (f : α ≃ option β) : fintype β := -by { haveI := fintype.of_equiv _ f, exact fintype_of_option } - -instance {α : Type*} (β : α → Type*) - [fintype α] [∀ a, fintype (β a)] : fintype (sigma β) := -⟨univ.sigma (λ _, univ), λ ⟨a, b⟩, by simp⟩ - -@[simp] lemma finset.univ_sigma_univ {α : Type*} {β : α → Type*} [fintype α] [∀ a, fintype (β a)] : - (univ : finset α).sigma (λ a, (univ : finset (β a))) = univ := rfl - -instance (α β : Type*) [fintype α] [fintype β] : fintype (α × β) := -⟨univ.product univ, λ ⟨a, b⟩, by simp⟩ - -@[simp] lemma finset.univ_product_univ {α β : Type*} [fintype α] [fintype β] : - (univ : finset α).product (univ : finset β) = univ := -rfl - -@[simp] theorem fintype.card_prod (α β : Type*) [fintype α] [fintype β] : - fintype.card (α × β) = fintype.card α * fintype.card β := -card_product _ _ - /-- Given that `α × β` is a fintype, `α` is also a fintype. -/ def fintype.prod_left {α β} [decidable_eq α] [fintype (α × β)] [nonempty β] : fintype α := ⟨(fintype.elems (α × β)).image prod.fst, @@ -880,68 +673,14 @@ def fintype.prod_right {α β} [decidable_eq β] [fintype (α × β)] [nonempty instance (α : Type*) [fintype α] : fintype (ulift α) := fintype.of_equiv _ equiv.ulift.symm -@[simp] theorem fintype.card_ulift (α : Type*) [fintype α] : - fintype.card (ulift α) = fintype.card α := -fintype.of_equiv_card _ - instance (α : Type*) [fintype α] : fintype (plift α) := fintype.of_equiv _ equiv.plift.symm -@[simp] theorem fintype.card_plift (α : Type*) [fintype α] : - fintype.card (plift α) = fintype.card α := -fintype.of_equiv_card _ - instance (α : Type*) [fintype α] : fintype αᵒᵈ := ‹fintype α› - -@[simp] lemma fintype.card_order_dual (α : Type*) [fintype α] : fintype.card αᵒᵈ = fintype.card α := -rfl +instance (α : Type*) [finite α] : finite αᵒᵈ := ‹finite α› instance (α : Type*) [fintype α] : fintype (lex α) := ‹fintype α› -@[simp] lemma fintype.card_lex (α : Type*) [fintype α] : - fintype.card (lex α) = fintype.card α := rfl - -lemma univ_sum_type {α β : Type*} [fintype α] [fintype β] [fintype (α ⊕ β)] [decidable_eq (α ⊕ β)] : - (univ : finset (α ⊕ β)) = map function.embedding.inl univ ∪ map function.embedding.inr univ := -begin - rw [eq_comm, eq_univ_iff_forall], simp only [mem_union, mem_map, exists_prop, mem_univ, true_and], - rintro (x|y), exacts [or.inl ⟨x, rfl⟩, or.inr ⟨y, rfl⟩] -end - -instance (α : Type u) (β : Type v) [fintype α] [fintype β] : fintype (α ⊕ β) := -@fintype.of_equiv _ _ (@sigma.fintype _ - (λ b, cond b (ulift α) (ulift.{(max u v) v} β)) _ - (λ b, by cases b; apply ulift.fintype)) - ((equiv.sum_equiv_sigma_bool _ _).symm.trans - (equiv.sum_congr equiv.ulift equiv.ulift)) - -/-- Given that `α ⊕ β` is a fintype, `α` is also a fintype. This is non-computable as it uses -that `sum.inl` is an injection, but there's no clear inverse if `α` is empty. -/ -noncomputable def fintype.sum_left {α β} [fintype (α ⊕ β)] : fintype α := -fintype.of_injective (sum.inl : α → α ⊕ β) sum.inl_injective - -/-- Given that `α ⊕ β` is a fintype, `β` is also a fintype. This is non-computable as it uses -that `sum.inr` is an injection, but there's no clear inverse if `β` is empty. -/ -noncomputable def fintype.sum_right {α β} [fintype (α ⊕ β)] : fintype β := -fintype.of_injective (sum.inr : β → α ⊕ β) sum.inr_injective - -@[simp] theorem fintype.card_sum [fintype α] [fintype β] : - fintype.card (α ⊕ β) = fintype.card α + fintype.card β := -begin - classical, - rw [←finset.card_univ, univ_sum_type, finset.card_union_eq], - { simp [finset.card_univ] }, - { intros x hx, - suffices : (∃ (a : α), sum.inl a = x) ∧ ∃ (b : β), sum.inr b = x, - { obtain ⟨⟨a, rfl⟩, ⟨b, hb⟩⟩ := this, - simpa using hb }, - simpa using hx } -end - -/-- If the subtype of all-but-one elements is a `fintype` then the type itself is a `fintype`. -/ -def fintype_of_fintype_ne (a : α) [decidable_pred (= a)] (h : fintype {b // b ≠ a}) : fintype α := -fintype.of_equiv _ $ equiv.sum_compl (= a) - section finset /-! ### `fintype (s : finset α)` -/ @@ -955,181 +694,6 @@ rfl end finset -namespace fintype -variables [fintype α] [fintype β] - -lemma card_le_of_injective (f : α → β) (hf : function.injective f) : card α ≤ card β := -finset.card_le_card_of_inj_on f (λ _ _, finset.mem_univ _) (λ _ _ _ _ h, hf h) - -lemma card_le_of_embedding (f : α ↪ β) : card α ≤ card β := card_le_of_injective f f.2 - -lemma card_lt_of_injective_of_not_mem (f : α → β) (h : function.injective f) - {b : β} (w : b ∉ set.range f) : card α < card β := -calc card α = (univ.map ⟨f, h⟩).card : (card_map _).symm -... < card β : finset.card_lt_univ_of_not_mem $ - by rwa [← mem_coe, coe_map, coe_univ, set.image_univ] - -lemma card_lt_of_injective_not_surjective (f : α → β) (h : function.injective f) - (h' : ¬function.surjective f) : card α < card β := -let ⟨y, hy⟩ := not_forall.1 h' in card_lt_of_injective_of_not_mem f h hy - -lemma card_le_of_surjective (f : α → β) (h : function.surjective f) : card β ≤ card α := -card_le_of_injective _ (function.injective_surj_inv h) - -lemma card_range_le {α β : Type*} (f : α → β) [fintype α] [fintype (set.range f)] : - fintype.card (set.range f) ≤ fintype.card α := -fintype.card_le_of_surjective (λ a, ⟨f a, by simp⟩) (λ ⟨_, a, ha⟩, ⟨a, by simpa using ha⟩) - -lemma card_range {α β F : Type*} [embedding_like F α β] (f : F) [fintype α] - [fintype (set.range f)] : - fintype.card (set.range f) = fintype.card α := -eq.symm $ fintype.card_congr $ equiv.of_injective _ $ embedding_like.injective f - -/-- -The pigeonhole principle for finitely many pigeons and pigeonholes. -This is the `fintype` version of `finset.exists_ne_map_eq_of_card_lt_of_maps_to`. --/ -lemma exists_ne_map_eq_of_card_lt (f : α → β) (h : fintype.card β < fintype.card α) : - ∃ x y, x ≠ y ∧ f x = f y := -let ⟨x, _, y, _, h⟩ := finset.exists_ne_map_eq_of_card_lt_of_maps_to h (λ x _, mem_univ (f x)) -in ⟨x, y, h⟩ - -lemma card_eq_one_iff : card α = 1 ↔ (∃ x : α, ∀ y, y = x) := -by rw [←card_unit, card_eq]; exact -⟨λ ⟨a⟩, ⟨a.symm (), λ y, a.injective (subsingleton.elim _ _)⟩, - λ ⟨x, hx⟩, ⟨⟨λ _, (), λ _, x, λ _, (hx _).trans (hx _).symm, - λ _, subsingleton.elim _ _⟩⟩⟩ - -lemma card_eq_zero_iff : card α = 0 ↔ is_empty α := -by rw [card, finset.card_eq_zero, univ_eq_empty_iff] - -lemma card_eq_zero [is_empty α] : card α = 0 := card_eq_zero_iff.2 ‹_› - -lemma card_eq_one_iff_nonempty_unique : card α = 1 ↔ nonempty (unique α) := -⟨λ h, let ⟨d, h⟩ := fintype.card_eq_one_iff.mp h in ⟨{ default := d, uniq := h}⟩, - λ ⟨h⟩, by exactI fintype.card_unique⟩ - -/-- A `fintype` with cardinality zero is equivalent to `empty`. -/ -def card_eq_zero_equiv_equiv_empty : card α = 0 ≃ (α ≃ empty) := -(equiv.of_iff card_eq_zero_iff).trans (equiv.equiv_empty_equiv α).symm - -lemma card_pos_iff : 0 < card α ↔ nonempty α := -pos_iff_ne_zero.trans $ not_iff_comm.mp $ not_nonempty_iff.trans card_eq_zero_iff.symm - -lemma card_pos [h : nonempty α] : 0 < card α := -card_pos_iff.mpr h - -lemma card_ne_zero [nonempty α] : card α ≠ 0 := -ne_of_gt card_pos - -lemma card_le_one_iff : card α ≤ 1 ↔ (∀ a b : α, a = b) := -let n := card α in -have hn : n = card α := rfl, -match n, hn with -| 0 := λ ha, ⟨λ h, λ a, (card_eq_zero_iff.1 ha.symm).elim a, λ _, ha ▸ nat.le_succ _⟩ -| 1 := λ ha, ⟨λ h, λ a b, let ⟨x, hx⟩ := card_eq_one_iff.1 ha.symm in - by rw [hx a, hx b], - λ _, ha ▸ le_rfl⟩ -| (n+2) := λ ha, ⟨λ h, by rw ← ha at h; exact absurd h dec_trivial, - (λ h, card_unit ▸ card_le_of_injective (λ _, ()) - (λ _ _ _, h _ _))⟩ -end - -lemma card_le_one_iff_subsingleton : card α ≤ 1 ↔ subsingleton α := -card_le_one_iff.trans subsingleton_iff.symm - -lemma one_lt_card_iff_nontrivial : 1 < card α ↔ nontrivial α := -begin - classical, - rw ←not_iff_not, - push_neg, - rw [not_nontrivial_iff_subsingleton, card_le_one_iff_subsingleton] -end - -lemma exists_ne_of_one_lt_card (h : 1 < card α) (a : α) : ∃ b : α, b ≠ a := -by { haveI : nontrivial α := one_lt_card_iff_nontrivial.1 h, exact exists_ne a } - -lemma exists_pair_of_one_lt_card (h : 1 < card α) : ∃ (a b : α), a ≠ b := -by { haveI : nontrivial α := one_lt_card_iff_nontrivial.1 h, exact exists_pair_ne α } - -lemma card_eq_one_of_forall_eq {i : α} (h : ∀ j, j = i) : card α = 1 := -fintype.card_eq_one_iff.2 ⟨i,h⟩ - -lemma one_lt_card [h : nontrivial α] : 1 < fintype.card α := -fintype.one_lt_card_iff_nontrivial.mpr h - -lemma one_lt_card_iff : 1 < card α ↔ ∃ a b : α, a ≠ b := -one_lt_card_iff_nontrivial.trans nontrivial_iff - -lemma two_lt_card_iff : 2 < card α ↔ ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c := -by simp_rw [←finset.card_univ, two_lt_card_iff, mem_univ, true_and] - -lemma injective_iff_surjective {f : α → α} : injective f ↔ surjective f := -by haveI := classical.prop_decidable; exact -have ∀ {f : α → α}, injective f → surjective f, -from λ f hinj x, - have h₁ : image f univ = univ := eq_of_subset_of_card_le (subset_univ _) - ((card_image_of_injective univ hinj).symm ▸ le_rfl), - have h₂ : x ∈ image f univ := h₁.symm ▸ mem_univ _, - exists_of_bex (mem_image.1 h₂), -⟨this, - λ hsurj, has_left_inverse.injective - ⟨surj_inv hsurj, left_inverse_of_surjective_of_right_inverse - (this (injective_surj_inv _)) (right_inverse_surj_inv _)⟩⟩ - -lemma injective_iff_bijective {f : α → α} : injective f ↔ bijective f := -by simp [bijective, injective_iff_surjective] - -lemma surjective_iff_bijective {f : α → α} : surjective f ↔ bijective f := -by simp [bijective, injective_iff_surjective] - -lemma injective_iff_surjective_of_equiv {β : Type*} {f : α → β} (e : α ≃ β) : - injective f ↔ surjective f := -have injective (e.symm ∘ f) ↔ surjective (e.symm ∘ f), from injective_iff_surjective, -⟨λ hinj, by simpa [function.comp] using - e.surjective.comp (this.1 (e.symm.injective.comp hinj)), -λ hsurj, by simpa [function.comp] using - e.injective.comp (this.2 (e.symm.surjective.comp hsurj))⟩ - -lemma card_of_bijective {f : α → β} (hf : bijective f) : card α = card β := -card_congr (equiv.of_bijective f hf) - -lemma bijective_iff_injective_and_card (f : α → β) : - bijective f ↔ injective f ∧ card α = card β := -begin - split, - { intro h, exact ⟨h.1, card_of_bijective h⟩ }, - { rintro ⟨hf, h⟩, - refine ⟨hf, _⟩, - rwa ←injective_iff_surjective_of_equiv (equiv_of_card_eq h) } -end - -lemma bijective_iff_surjective_and_card (f : α → β) : - bijective f ↔ surjective f ∧ card α = card β := -begin - split, - { intro h, exact ⟨h.2, card_of_bijective h⟩ }, - { rintro ⟨hf, h⟩, - refine ⟨_, hf⟩, - rwa injective_iff_surjective_of_equiv (equiv_of_card_eq h) } -end - -lemma right_inverse_of_left_inverse_of_card_le {f : α → β} {g : β → α} - (hfg : left_inverse f g) (hcard : card α ≤ card β) : - right_inverse f g := -have hsurj : surjective f, from surjective_iff_has_right_inverse.2 ⟨g, hfg⟩, -right_inverse_of_injective_of_left_inverse - ((bijective_iff_surjective_and_card _).2 - ⟨hsurj, le_antisymm hcard (card_le_of_surjective f hsurj)⟩ ).1 - hfg - -lemma left_inverse_of_right_inverse_of_card_le {f : α → β} {g : β → α} - (hfg : right_inverse f g) (hcard : card β ≤ card α) : - left_inverse f g := -right_inverse_of_left_inverse_of_card_le hfg hcard - -end fintype - lemma fintype.coe_image_univ [fintype α] [decidable_eq β] {f : α → β} : ↑(finset.image f finset.univ) = set.range f := by { ext x, simp } @@ -1146,52 +710,24 @@ instance finset.subtype.fintype (s : finset α) : fintype {x // x ∈ s} := instance finset_coe.fintype (s : finset α) : fintype (↑s : set α) := finset.subtype.fintype s -@[simp] lemma fintype.card_coe (s : finset α) [fintype s] : - fintype.card s = s.card := fintype.card_of_finset' s (λ _, iff.rfl) - lemma finset.attach_eq_univ {s : finset α} : s.attach = finset.univ := rfl instance plift.fintype_Prop (p : Prop) [decidable p] : fintype (plift p) := ⟨if h : p then {⟨h⟩} else ∅, λ ⟨h⟩, by simp [h]⟩ instance Prop.fintype : fintype Prop := -⟨⟨true ::ₘ false ::ₘ 0, by simp [true_ne_false]⟩, - classical.cases (by simp) (by simp)⟩ +⟨⟨{true, false}, by simp [true_ne_false]⟩, classical.cases (by simp) (by simp)⟩ -@[simp] lemma fintype.card_Prop : fintype.card Prop = 2 := rfl +@[simp] lemma fintype.univ_Prop : (finset.univ : finset Prop) = {true, false} := +finset.eq_of_veq $ by simp; refl instance subtype.fintype (p : α → Prop) [decidable_pred p] [fintype α] : fintype {x // p x} := fintype.subtype (univ.filter p) (by simp) -/- TODO Without the coercion arrow (`↥`) there is an elaboration bug; -it essentially infers `fintype.{v} (set.univ.{u} : set α)` with `v` and `u` distinct. -Reported in leanprover-community/lean#672 -/ -@[simp] lemma set.to_finset_univ [fintype ↥(set.univ : set α)] [fintype α] : - (set.univ : set α).to_finset = finset.univ := -by { ext, simp only [set.mem_univ, mem_univ, set.mem_to_finset] } - -@[simp] lemma set.to_finset_eq_empty_iff {s : set α} [fintype s] : s.to_finset = ∅ ↔ s = ∅ := -by simp [ext_iff, set.ext_iff] - -@[simp] lemma set.to_finset_empty : (∅ : set α).to_finset = ∅ := -set.to_finset_eq_empty_iff.mpr rfl - -@[simp] lemma set.to_finset_range [decidable_eq α] [fintype β] (f : β → α) [fintype (set.range f)] : - (set.range f).to_finset = finset.univ.image f := -by simp [ext_iff] - /-- A set on a fintype, when coerced to a type, is a fintype. -/ def set_fintype [fintype α] (s : set α) [decidable_pred (∈ s)] : fintype s := subtype.fintype (λ x, x ∈ s) -lemma set_fintype_card_le_univ [fintype α] (s : set α) [fintype ↥s] : - fintype.card ↥s ≤ fintype.card α := -fintype.card_le_of_embedding (function.embedding.subtype s) - -lemma set_fintype_card_eq_univ_iff [fintype α] (s : set α) [fintype ↥s] : - fintype.card s = fintype.card α ↔ s = set.univ := -by rw [←set.to_finset_card, finset.card_eq_iff_eq_univ, ←set.to_finset_univ, set.to_finset_inj] - section variables (α) @@ -1212,214 +748,28 @@ def _root_.units_equiv_ne_zero [group_with_zero α] : αˣ ≃ {a : α // a ≠ end -instance [monoid α] [fintype α] [decidable_eq α] : fintype αˣ := -fintype.of_equiv _ (units_equiv_prod_subtype α).symm - -lemma fintype.card_units [group_with_zero α] [fintype α] [fintype αˣ] : - fintype.card αˣ = fintype.card α - 1 := -begin - classical, - rw [eq_comm, nat.sub_eq_iff_eq_add (fintype.card_pos_iff.2 ⟨(0 : α)⟩), - fintype.card_congr (units_equiv_ne_zero α)], - have := fintype.card_congr (equiv.sum_compl (= (0 : α))).symm, - rwa [fintype.card_sum, add_comm, fintype.card_subtype_eq] at this, -end - -namespace function.embedding - -/-- An embedding from a `fintype` to itself can be promoted to an equivalence. -/ -noncomputable def equiv_of_fintype_self_embedding [fintype α] (e : α ↪ α) : α ≃ α := -equiv.of_bijective e (fintype.injective_iff_bijective.1 e.2) - -@[simp] -lemma equiv_of_fintype_self_embedding_to_embedding [fintype α] (e : α ↪ α) : - e.equiv_of_fintype_self_embedding.to_embedding = e := -by { ext, refl, } - -/-- If `‖β‖ < ‖α‖` there are no embeddings `α ↪ β`. -This is a formulation of the pigeonhole principle. - -Note this cannot be an instance as it needs `h`. -/ -@[simp] lemma is_empty_of_card_lt [fintype α] [fintype β] - (h : fintype.card β < fintype.card α) : is_empty (α ↪ β) := -⟨λ f, let ⟨x, y, ne, feq⟩ := fintype.exists_ne_map_eq_of_card_lt f h in ne $ f.injective feq⟩ - -/-- A constructive embedding of a fintype `α` in another fintype `β` when `card α ≤ card β`. -/ -def trunc_of_card_le [fintype α] [fintype β] [decidable_eq α] [decidable_eq β] - (h : fintype.card α ≤ fintype.card β) : trunc (α ↪ β) := -(fintype.trunc_equiv_fin α).bind $ λ ea, - (fintype.trunc_equiv_fin β).map $ λ eb, - ea.to_embedding.trans ((fin.cast_le h).to_embedding.trans eb.symm.to_embedding) - -lemma nonempty_of_card_le [fintype α] [fintype β] - (h : fintype.card α ≤ fintype.card β) : nonempty (α ↪ β) := -by { classical, exact (trunc_of_card_le h).nonempty } - -lemma exists_of_card_le_finset [fintype α] {s : finset β} (h : fintype.card α ≤ s.card) : - ∃ (f : α ↪ β), set.range f ⊆ s := -begin - rw ← fintype.card_coe at h, - rcases nonempty_of_card_le h with ⟨f⟩, - exact ⟨f.trans (embedding.subtype _), by simp [set.range_subset_iff]⟩ -end - -end function.embedding - -@[simp] -lemma finset.univ_map_embedding {α : Type*} [fintype α] (e : α ↪ α) : - univ.map e = univ := -by rw [←e.equiv_of_fintype_self_embedding_to_embedding, univ_map_equiv_to_embedding] - namespace fintype -lemma card_lt_of_surjective_not_injective [fintype α] [fintype β] (f : α → β) - (h : function.surjective f) (h' : ¬function.injective f) : card β < card α := -card_lt_of_injective_not_surjective _ (function.injective_surj_inv h) $ λ hg, -have w : function.bijective (function.surj_inv h) := ⟨function.injective_surj_inv h, hg⟩, -h' $ (injective_iff_surjective_of_equiv (equiv.of_bijective _ w).symm).mpr h +/-- Given `fintype α`, `finset_equiv_set` is the equiv between `finset α` and `set α`. (All +sets on a finite type are finite.) -/ +noncomputable def finset_equiv_set [fintype α] : finset α ≃ set α := +{ to_fun := coe, + inv_fun := by { classical, exact λ s, s.to_finset }, + left_inv := λ s, by convert finset.to_finset_coe s, + right_inv := λ s, by { classical, exact s.coe_to_finset } } -variables [decidable_eq α] [fintype α] {δ : α → Type*} +@[simp] lemma finset_equiv_set_apply [fintype α] (s : finset α) : finset_equiv_set s = s := rfl -/-- Given for all `a : α` a finset `t a` of `δ a`, then one can define the -finset `fintype.pi_finset t` of all functions taking values in `t a` for all `a`. This is the -analogue of `finset.pi` where the base finset is `univ` (but formally they are not the same, as -there is an additional condition `i ∈ finset.univ` in the `finset.pi` definition). -/ -def pi_finset (t : Π a, finset (δ a)) : finset (Π a, δ a) := -(finset.univ.pi t).map ⟨λ f a, f a (mem_univ a), λ _ _, by simp [function.funext_iff]⟩ - -@[simp] lemma mem_pi_finset {t : Π a, finset (δ a)} {f : Π a, δ a} : - f ∈ pi_finset t ↔ ∀ a, f a ∈ t a := -begin - split, - { simp only [pi_finset, mem_map, and_imp, forall_prop_of_true, exists_prop, mem_univ, - exists_imp_distrib, mem_pi], - rintro g hg hgf a, - rw ← hgf, - exact hg a }, - { simp only [pi_finset, mem_map, forall_prop_of_true, exists_prop, mem_univ, mem_pi], - exact λ hf, ⟨λ a ha, f a, hf, rfl⟩ } -end - -@[simp] lemma coe_pi_finset (t : Π a, finset (δ a)) : - (pi_finset t : set (Π a, δ a)) = set.pi set.univ (λ a, t a) := -set.ext $ λ x, by { rw set.mem_univ_pi, exact fintype.mem_pi_finset } - -lemma pi_finset_subset (t₁ t₂ : Π a, finset (δ a)) (h : ∀ a, t₁ a ⊆ t₂ a) : - pi_finset t₁ ⊆ pi_finset t₂ := -λ g hg, mem_pi_finset.2 $ λ a, h a $ mem_pi_finset.1 hg a - -lemma pi_finset_disjoint_of_disjoint [∀ a, decidable_eq (δ a)] - (t₁ t₂ : Π a, finset (δ a)) {a : α} (h : disjoint (t₁ a) (t₂ a)) : - disjoint (pi_finset t₁) (pi_finset t₂) := -disjoint_iff_ne.2 $ λ f₁ hf₁ f₂ hf₂ eq₁₂, -disjoint_iff_ne.1 h (f₁ a) (mem_pi_finset.1 hf₁ a) (f₂ a) (mem_pi_finset.1 hf₂ a) (congr_fun eq₁₂ a) +@[simp] lemma finset_equiv_set_symm_apply [fintype α] (s : set α) [fintype s] : + finset_equiv_set.symm s = s.to_finset := +by convert rfl end fintype -/-! ### pi -/ - -/-- A dependent product of fintypes, indexed by a fintype, is a fintype. -/ -instance pi.fintype {α : Type*} {β : α → Type*} - [decidable_eq α] [fintype α] [∀ a, fintype (β a)] : fintype (Π a, β a) := -⟨fintype.pi_finset (λ _, univ), by simp⟩ - -@[simp] lemma fintype.pi_finset_univ {α : Type*} {β : α → Type*} - [decidable_eq α] [fintype α] [∀ a, fintype (β a)] : - fintype.pi_finset (λ a : α, (finset.univ : finset (β a))) = (finset.univ : finset (Π a, β a)) := -rfl - -instance d_array.fintype {n : ℕ} {α : fin n → Type*} - [∀ n, fintype (α n)] : fintype (d_array n α) := -fintype.of_equiv _ (equiv.d_array_equiv_fin _).symm - -instance array.fintype {n : ℕ} {α : Type*} [fintype α] : fintype (array n α) := -d_array.fintype - -instance vector.fintype {α : Type*} [fintype α] {n : ℕ} : fintype (vector α n) := -fintype.of_equiv _ (equiv.vector_equiv_fin _ _).symm - instance quotient.fintype [fintype α] (s : setoid α) [decidable_rel ((≈) : α → α → Prop)] : fintype (quotient s) := fintype.of_surjective quotient.mk (λ x, quotient.induction_on x (λ x, ⟨x, rfl⟩)) -instance finset.fintype [fintype α] : fintype (finset α) := -⟨univ.powerset, λ x, finset.mem_powerset.2 (finset.subset_univ _)⟩ - --- irreducible due to this conversation on Zulip: --- https://leanprover.zulipchat.com/#narrow/stream/113488-general/ --- topic/.60simp.60.20ignoring.20lemmas.3F/near/241824115 -@[irreducible] instance function.embedding.fintype {α β} [fintype α] [fintype β] - [decidable_eq α] [decidable_eq β] : fintype (α ↪ β) := -fintype.of_equiv _ (equiv.subtype_injective_equiv_embedding α β) - -instance [decidable_eq α] [fintype α] {n : ℕ} : fintype (sym.sym' α n) := -quotient.fintype _ - -instance [decidable_eq α] [fintype α] {n : ℕ} : fintype (sym α n) := -fintype.of_equiv _ sym.sym_equiv_sym'.symm - -@[simp] lemma fintype.card_finset [fintype α] : - fintype.card (finset α) = 2 ^ (fintype.card α) := -finset.card_powerset finset.univ - -lemma finset.mem_powerset_len_univ_iff [fintype α] {s : finset α} {k : ℕ} : - s ∈ powerset_len k (univ : finset α) ↔ card s = k := -mem_powerset_len.trans $ and_iff_right $ subset_univ _ - -@[simp] lemma finset.univ_filter_card_eq (α : Type*) [fintype α] (k : ℕ) : - (finset.univ : finset (finset α)).filter (λ s, s.card = k) = finset.univ.powerset_len k := -by { ext, simp [finset.mem_powerset_len] } - -@[simp] lemma fintype.card_finset_len [fintype α] (k : ℕ) : - fintype.card {s : finset α // s.card = k} = nat.choose (fintype.card α) k := -by simp [fintype.subtype_card, finset.card_univ] - -theorem fintype.card_subtype_le [fintype α] (p : α → Prop) [decidable_pred p] : - fintype.card {x // p x} ≤ fintype.card α := -fintype.card_le_of_embedding (function.embedding.subtype _) - -theorem fintype.card_subtype_lt [fintype α] {p : α → Prop} [decidable_pred p] - {x : α} (hx : ¬ p x) : fintype.card {x // p x} < fintype.card α := -fintype.card_lt_of_injective_of_not_mem coe subtype.coe_injective $ by rwa subtype.range_coe_subtype - -lemma fintype.card_subtype [fintype α] (p : α → Prop) [decidable_pred p] : - fintype.card {x // p x} = ((finset.univ : finset α).filter p).card := -begin - refine fintype.card_of_subtype _ _, - simp -end - -lemma fintype.card_subtype_or (p q : α → Prop) - [fintype {x // p x}] [fintype {x // q x}] [fintype {x // p x ∨ q x}] : - fintype.card {x // p x ∨ q x} ≤ fintype.card {x // p x} + fintype.card {x // q x} := -begin - classical, - convert fintype.card_le_of_embedding (subtype_or_left_embedding p q), - rw fintype.card_sum -end - -lemma fintype.card_subtype_or_disjoint (p q : α → Prop) (h : disjoint p q) - [fintype {x // p x}] [fintype {x // q x}] [fintype {x // p x ∨ q x}] : - fintype.card {x // p x ∨ q x} = fintype.card {x // p x} + fintype.card {x // q x} := -begin - classical, - convert fintype.card_congr (subtype_or_equiv p q h), - simp -end - -theorem fintype.card_quotient_le [fintype α] (s : setoid α) [decidable_rel ((≈) : α → α → Prop)] : - fintype.card (quotient s) ≤ fintype.card α := -fintype.card_le_of_surjective _ (surjective_quotient_mk _) - -theorem fintype.card_quotient_lt [fintype α] {s : setoid α} [decidable_rel ((≈) : α → α → Prop)] - {x y : α} (h1 : x ≠ y) (h2 : x ≈ y) : fintype.card (quotient s) < fintype.card α := -fintype.card_lt_of_surjective_not_injective _ (surjective_quotient_mk _) $ λ w, -h1 (w $ quotient.eq.mpr h2) - -instance psigma.fintype {α : Type*} {β : α → Type*} [fintype α] [∀ a, fintype (β a)] : - fintype (Σ' a, β a) := -fintype.of_equiv _ (equiv.psigma_equiv_sigma _).symm - instance psigma.fintype_prop_left {α : Prop} {β : α → Type*} [decidable α] [∀ a, fintype (β a)] : fintype (Σ' a, β a) := if h : α then fintype.of_equiv (β h) ⟨λ x, ⟨h, x⟩, psigma.snd, λ _, rfl, λ ⟨_, _⟩, rfl⟩ @@ -1433,236 +783,16 @@ instance psigma.fintype_prop_prop {α : Prop} {β : α → Prop} [decidable α] fintype (Σ' a, β a) := if h : ∃ a, β a then ⟨{⟨h.fst, h.snd⟩}, λ ⟨_, _⟩, by simp⟩ else ⟨∅, λ ⟨x, y⟩, h ⟨x, y⟩⟩ -instance set.fintype [fintype α] : fintype (set α) := -⟨(@finset.univ α _).powerset.map ⟨coe, coe_injective⟩, λ s, begin - classical, refine mem_map.2 ⟨finset.univ.filter s, mem_powerset.2 (subset_univ _), _⟩, - apply (coe_filter _ _).trans, rw [coe_univ, set.sep_univ], refl -end⟩ - -@[simp] lemma fintype.card_set [fintype α] : fintype.card (set α) = 2 ^ fintype.card α := -(finset.card_map _).trans (finset.card_powerset _) - instance pfun_fintype (p : Prop) [decidable p] (α : p → Type*) [Π hp, fintype (α hp)] : fintype (Π hp : p, α hp) := if hp : p then fintype.of_equiv (α hp) ⟨λ a _, a, λ f, f hp, λ _, rfl, λ _, rfl⟩ else ⟨singleton (λ h, (hp h).elim), by simp [hp, function.funext_iff]⟩ -@[simp] lemma finset.univ_pi_univ {α : Type*} {β : α → Type*} - [decidable_eq α] [fintype α] [∀ a, fintype (β a)] : - finset.univ.pi (λ a : α, (finset.univ : finset (β a))) = finset.univ := -by { ext, simp } - lemma mem_image_univ_iff_mem_range {α β : Type*} [fintype α] [decidable_eq β] {f : α → β} {b : β} : b ∈ univ.image f ↔ b ∈ set.range f := by simp -/-- An auxiliary function for `quotient.fin_choice`. Given a -collection of setoids indexed by a type `ι`, a (finite) list `l` of -indices, and a function that for each `i ∈ l` gives a term of the -corresponding quotient type, then there is a corresponding term in the -quotient of the product of the setoids indexed by `l`. -/ -def quotient.fin_choice_aux {ι : Type*} [decidable_eq ι] - {α : ι → Type*} [S : ∀ i, setoid (α i)] : - Π (l : list ι), (Π i ∈ l, quotient (S i)) → @quotient (Π i ∈ l, α i) (by apply_instance) -| [] f := ⟦λ i, false.elim⟧ -| (i :: l) f := begin - refine quotient.lift_on₂ (f i (list.mem_cons_self _ _)) - (quotient.fin_choice_aux l (λ j h, f j (list.mem_cons_of_mem _ h))) - _ _, - exact λ a l, ⟦λ j h, - if e : j = i then by rw e; exact a else - l _ (h.resolve_left e)⟧, - refine λ a₁ l₁ a₂ l₂ h₁ h₂, quotient.sound (λ j h, _), - by_cases e : j = i; simp [e], - { subst j, exact h₁ }, - { exact h₂ _ _ } -end - -theorem quotient.fin_choice_aux_eq {ι : Type*} [decidable_eq ι] - {α : ι → Type*} [S : ∀ i, setoid (α i)] : - ∀ (l : list ι) (f : Π i ∈ l, α i), quotient.fin_choice_aux l (λ i h, ⟦f i h⟧) = ⟦f⟧ -| [] f := quotient.sound (λ i h, h.elim) -| (i :: l) f := begin - simp [quotient.fin_choice_aux, quotient.fin_choice_aux_eq l], - refine quotient.sound (λ j h, _), - by_cases e : j = i; simp [e], - subst j, refl -end - -/-- Given a collection of setoids indexed by a fintype `ι` and a -function that for each `i : ι` gives a term of the corresponding -quotient type, then there is corresponding term in the quotient of the -product of the setoids. -/ -def quotient.fin_choice {ι : Type*} [decidable_eq ι] [fintype ι] - {α : ι → Type*} [S : ∀ i, setoid (α i)] - (f : Π i, quotient (S i)) : @quotient (Π i, α i) (by apply_instance) := -quotient.lift_on (@quotient.rec_on _ _ (λ l : multiset ι, - @quotient (Π i ∈ l, α i) (by apply_instance)) - finset.univ.1 - (λ l, quotient.fin_choice_aux l (λ i _, f i)) - (λ a b h, begin - have := λ a, quotient.fin_choice_aux_eq a (λ i h, quotient.out (f i)), - simp [quotient.out_eq] at this, - simp [this], - let g := λ a:multiset ι, ⟦λ (i : ι) (h : i ∈ a), quotient.out (f i)⟧, - refine eq_of_heq ((eq_rec_heq _ _).trans (_ : g a == g b)), - congr' 1, exact quotient.sound h, - end)) - (λ f, ⟦λ i, f i (finset.mem_univ _)⟧) - (λ a b h, quotient.sound $ λ i, h _ _) - -theorem quotient.fin_choice_eq {ι : Type*} [decidable_eq ι] [fintype ι] - {α : ι → Type*} [∀ i, setoid (α i)] - (f : Π i, α i) : quotient.fin_choice (λ i, ⟦f i⟧) = ⟦f⟧ := -begin - let q, swap, change quotient.lift_on q _ _ = _, - have : q = ⟦λ i h, f i⟧, - { dsimp [q], - exact quotient.induction_on - (@finset.univ ι _).1 (λ l, quotient.fin_choice_aux_eq _ _) }, - simp [this], exact setoid.refl _ -end - -section equiv - -open list equiv equiv.perm - -variables [decidable_eq α] [decidable_eq β] - -/-- Given a list, produce a list of all permutations of its elements. -/ -def perms_of_list : list α → list (perm α) -| [] := [1] -| (a :: l) := perms_of_list l ++ l.bind (λ b, (perms_of_list l).map (λ f, swap a b * f)) - -lemma length_perms_of_list : ∀ l : list α, length (perms_of_list l) = l.length! -| [] := rfl -| (a :: l) := -begin - rw [length_cons, nat.factorial_succ], - simp [perms_of_list, length_bind, length_perms_of_list, function.comp, nat.succ_mul], - cc -end - -lemma mem_perms_of_list_of_mem {l : list α} {f : perm α} (h : ∀ x, f x ≠ x → x ∈ l) : - f ∈ perms_of_list l := -begin - induction l with a l IH generalizing f h, - { exact list.mem_singleton.2 (equiv.ext $ λ x, decidable.by_contradiction $ h _) }, - by_cases hfa : f a = a, - { refine mem_append_left _ (IH (λ x hx, mem_of_ne_of_mem _ (h x hx))), - rintro rfl, exact hx hfa }, - have hfa' : f (f a) ≠ f a := mt (λ h, f.injective h) hfa, - have : ∀ (x : α), (swap a (f a) * f) x ≠ x → x ∈ l, - { intros x hx, - have hxa : x ≠ a, - { rintro rfl, apply hx, simp only [mul_apply, swap_apply_right] }, - refine list.mem_of_ne_of_mem hxa (h x (λ h, _)), - simp only [h, mul_apply, swap_apply_def, mul_apply, ne.def, apply_eq_iff_eq] at hx; - split_ifs at hx, exacts [hxa (h.symm.trans h_1), hx h] }, - suffices : f ∈ perms_of_list l ∨ ∃ (b ∈ l) (g ∈ perms_of_list l), swap a b * g = f, - { simpa only [perms_of_list, exists_prop, list.mem_map, mem_append, list.mem_bind] }, - refine or_iff_not_imp_left.2 (λ hfl, ⟨f a, _, swap a (f a) * f, IH this, _⟩), - { exact mem_of_ne_of_mem hfa (h _ hfa') }, - { rw [←mul_assoc, mul_def (swap a (f a)) (swap a (f a)), - swap_swap, ←perm.one_def, one_mul] } -end - -lemma mem_of_mem_perms_of_list : - ∀ {l : list α} {f : perm α}, f ∈ perms_of_list l → ∀ {x}, f x ≠ x → x ∈ l -| [] f h := have f = 1 := by simpa [perms_of_list] using h, by rw this; simp -| (a :: l) f h := -(mem_append.1 h).elim - (λ h x hx, mem_cons_of_mem _ (mem_of_mem_perms_of_list h hx)) - (λ h x hx, - let ⟨y, hy, hy'⟩ := list.mem_bind.1 h in - let ⟨g, hg₁, hg₂⟩ := list.mem_map.1 hy' in - if hxa : x = a then by simp [hxa] - else if hxy : x = y then mem_cons_of_mem _ $ by rwa hxy - else mem_cons_of_mem _ $ - mem_of_mem_perms_of_list hg₁ $ - by rw [eq_inv_mul_iff_mul_eq.2 hg₂, mul_apply, swap_inv, swap_apply_def]; - split_ifs; [exact ne.symm hxy, exact ne.symm hxa, exact hx]) - -lemma mem_perms_of_list_iff {l : list α} {f : perm α} : - f ∈ perms_of_list l ↔ ∀ {x}, f x ≠ x → x ∈ l := -⟨mem_of_mem_perms_of_list, mem_perms_of_list_of_mem⟩ - -lemma nodup_perms_of_list : ∀ {l : list α} (hl : l.nodup), (perms_of_list l).nodup -| [] hl := by simp [perms_of_list] -| (a :: l) hl := -have hl' : l.nodup, from hl.of_cons, -have hln' : (perms_of_list l).nodup, from nodup_perms_of_list hl', -have hmeml : ∀ {f : perm α}, f ∈ perms_of_list l → f a = a, - from λ f hf, not_not.1 (mt (mem_of_mem_perms_of_list hf) (nodup_cons.1 hl).1), -by rw [perms_of_list, list.nodup_append, list.nodup_bind, pairwise_iff_nth_le]; exact -⟨hln', ⟨λ _ _, hln'.map $ λ _ _, mul_left_cancel, - λ i j hj hij x hx₁ hx₂, - let ⟨f, hf⟩ := list.mem_map.1 hx₁ in - let ⟨g, hg⟩ := list.mem_map.1 hx₂ in - have hix : x a = nth_le l i (lt_trans hij hj), - by rw [←hf.2, mul_apply, hmeml hf.1, swap_apply_left], - have hiy : x a = nth_le l j hj, - by rw [← hg.2, mul_apply, hmeml hg.1, swap_apply_left], - absurd (hf.2.trans (hg.2.symm)) $ - λ h, ne_of_lt hij $ nodup_iff_nth_le_inj.1 hl' i j (lt_trans hij hj) hj $ - by rw [← hix, hiy]⟩, - λ f hf₁ hf₂, - let ⟨x, hx, hx'⟩ := list.mem_bind.1 hf₂ in - let ⟨g, hg⟩ := list.mem_map.1 hx' in - have hgxa : g⁻¹ x = a, from f.injective $ - by rw [hmeml hf₁, ← hg.2]; simp, - have hxa : x ≠ a, from λ h, (list.nodup_cons.1 hl).1 (h ▸ hx), - (list.nodup_cons.1 hl).1 $ - hgxa ▸ mem_of_mem_perms_of_list hg.1 (by rwa [apply_inv_self, hgxa])⟩ - -/-- Given a finset, produce the finset of all permutations of its elements. -/ -def perms_of_finset (s : finset α) : finset (perm α) := -quotient.hrec_on s.1 (λ l hl, ⟨perms_of_list l, nodup_perms_of_list hl⟩) - (λ a b hab, hfunext (congr_arg _ (quotient.sound hab)) - (λ ha hb _, heq_of_eq $ finset.ext $ - by simp [mem_perms_of_list_iff, hab.mem_iff])) - s.2 - -lemma mem_perms_of_finset_iff : ∀ {s : finset α} {f : perm α}, - f ∈ perms_of_finset s ↔ ∀ {x}, f x ≠ x → x ∈ s := -by rintros ⟨⟨l⟩, hs⟩ f; exact mem_perms_of_list_iff - -lemma card_perms_of_finset : ∀ (s : finset α), - (perms_of_finset s).card = s.card! := -by rintros ⟨⟨l⟩, hs⟩; exact length_perms_of_list l - -/-- The collection of permutations of a fintype is a fintype. -/ -def fintype_perm [fintype α] : fintype (perm α) := -⟨perms_of_finset (@finset.univ α _), by simp [mem_perms_of_finset_iff]⟩ - -instance [fintype α] [fintype β] : fintype (α ≃ β) := -if h : fintype.card β = fintype.card α -then trunc.rec_on_subsingleton (fintype.trunc_equiv_fin α) - (λ eα, trunc.rec_on_subsingleton (fintype.trunc_equiv_fin β) - (λ eβ, @fintype.of_equiv _ (perm α) fintype_perm - (equiv_congr (equiv.refl α) (eα.trans (eq.rec_on h eβ.symm)) : (α ≃ α) ≃ (α ≃ β)))) -else ⟨∅, λ x, false.elim (h (fintype.card_eq.2 ⟨x.symm⟩))⟩ - -lemma fintype.card_perm [fintype α] : fintype.card (perm α) = (fintype.card α)! := -subsingleton.elim (@fintype_perm α _ _) (@equiv.fintype α α _ _ _ _) ▸ -card_perms_of_finset _ - -lemma fintype.card_equiv [fintype α] [fintype β] (e : α ≃ β) : - fintype.card (α ≃ β) = (fintype.card α)! := -fintype.card_congr (equiv_congr (equiv.refl α) e) ▸ fintype.card_perm - -lemma univ_eq_singleton_of_card_one {α} [fintype α] (x : α) (h : fintype.card α = 1) : - (univ : finset α) = {x} := -begin - symmetry, - apply eq_of_subset_of_card_le (subset_univ ({x})), - apply le_of_eq, - simp [h, finset.card_univ] -end - -end equiv - namespace fintype section choose @@ -1716,264 +846,8 @@ lemma bijective_bij_inv (f_bij : bijective f) : bijective (bij_inv f_bij) := ⟨(right_inverse_bij_inv _).injective, (left_inverse_bij_inv _).surjective⟩ end bijection_inverse - -lemma well_founded_of_trans_of_irrefl [fintype α] (r : α → α → Prop) - [is_trans α r] [is_irrefl α r] : well_founded r := -by classical; exact -have ∀ x y, r x y → (univ.filter (λ z, r z x)).card < (univ.filter (λ z, r z y)).card, - from λ x y hxy, finset.card_lt_card $ - by simp only [finset.lt_iff_ssubset.symm, lt_iff_le_not_le, - finset.le_iff_subset, finset.subset_iff, mem_filter, true_and, mem_univ, hxy]; - exact ⟨λ z hzx, trans hzx hxy, not_forall_of_exists_not ⟨x, not_imp.2 ⟨hxy, irrefl x⟩⟩⟩, -subrelation.wf this (measure_wf _) - -lemma preorder.well_founded_lt [fintype α] [preorder α] : well_founded ((<) : α → α → Prop) := -well_founded_of_trans_of_irrefl _ - -lemma preorder.well_founded_gt [fintype α] [preorder α] : well_founded ((>) : α → α → Prop) := -well_founded_of_trans_of_irrefl _ - -@[instance, priority 10] lemma linear_order.is_well_order_lt [fintype α] [linear_order α] : - is_well_order α (<) := -{ wf := preorder.well_founded_lt } - -@[instance, priority 10] lemma linear_order.is_well_order_gt [fintype α] [linear_order α] : - is_well_order α (>) := -{ wf := preorder.well_founded_gt } - end fintype -/-- A type is said to be infinite if it has no fintype instance. - Note that `infinite α` is equivalent to `is_empty (fintype α)`. -/ -class infinite (α : Type*) : Prop := -(not_fintype : fintype α → false) - -lemma not_fintype (α : Type*) [h1 : infinite α] [h2 : fintype α] : false := -infinite.not_fintype h2 - -protected lemma fintype.false {α : Type*} [infinite α] (h : fintype α) : false := -not_fintype α - -protected lemma infinite.false {α : Type*} [fintype α] (h : infinite α) : false := -not_fintype α - -@[simp] lemma is_empty_fintype {α : Type*} : is_empty (fintype α) ↔ infinite α := -⟨λ ⟨x⟩, ⟨x⟩, λ ⟨x⟩, ⟨x⟩⟩ - -/-- A non-infinite type is a fintype. -/ -noncomputable def fintype_of_not_infinite {α : Type*} (h : ¬ infinite α) : fintype α := -nonempty.some $ by rwa [← not_is_empty_iff, is_empty_fintype] - -section -open_locale classical - -/-- -Any type is (classically) either a `fintype`, or `infinite`. - -One can obtain the relevant typeclasses via `cases fintype_or_infinite α; resetI`. --/ -noncomputable def fintype_or_infinite (α : Type*) : psum (fintype α) (infinite α) := -if h : infinite α then psum.inr h else psum.inl (fintype_of_not_infinite h) - -end - -lemma finset.exists_minimal {α : Type*} [preorder α] (s : finset α) (h : s.nonempty) : - ∃ m ∈ s, ∀ x ∈ s, ¬ (x < m) := -begin - obtain ⟨c, hcs : c ∈ s⟩ := h, - have : well_founded (@has_lt.lt {x // x ∈ s} _) := fintype.well_founded_of_trans_of_irrefl _, - obtain ⟨⟨m, hms : m ∈ s⟩, -, H⟩ := this.has_min set.univ ⟨⟨c, hcs⟩, trivial⟩, - exact ⟨m, hms, λ x hx hxm, H ⟨x, hx⟩ trivial hxm⟩, -end - -lemma finset.exists_maximal {α : Type*} [preorder α] (s : finset α) (h : s.nonempty) : - ∃ m ∈ s, ∀ x ∈ s, ¬ (m < x) := -@finset.exists_minimal αᵒᵈ _ s h - -namespace infinite - -lemma exists_not_mem_finset [infinite α] (s : finset α) : ∃ x, x ∉ s := -not_forall.1 $ λ h, fintype.false ⟨s, h⟩ - -@[priority 100] -- see Note [lower instance priority] -instance (α : Type*) [H : infinite α] : nontrivial α := -⟨let ⟨x, hx⟩ := exists_not_mem_finset (∅ : finset α) in -let ⟨y, hy⟩ := exists_not_mem_finset ({x} : finset α) in -⟨y, x, by simpa only [mem_singleton] using hy⟩⟩ - -protected lemma nonempty (α : Type*) [infinite α] : nonempty α := -by apply_instance - -lemma of_injective [infinite β] (f : β → α) (hf : injective f) : infinite α := -⟨λ I, by exactI (fintype.of_injective f hf).false⟩ - -lemma of_surjective [infinite β] (f : α → β) (hf : surjective f) : infinite α := -⟨λ I, by { classical, exactI (fintype.of_surjective f hf).false }⟩ - -end infinite - -instance : infinite ℕ := -⟨λ ⟨s, hs⟩, finset.not_mem_range_self $ s.subset_range_sup_succ (hs _)⟩ - -instance : infinite ℤ := -infinite.of_injective int.of_nat (λ _ _, int.of_nat.inj) - -instance infinite.set [infinite α] : infinite (set α) := -infinite.of_injective singleton (λ a b, set.singleton_eq_singleton_iff.1) - -instance [infinite α] : infinite (finset α) := -infinite.of_injective singleton finset.singleton_injective - -instance [nonempty α] : infinite (multiset α) := -begin - inhabit α, - exact infinite.of_injective (multiset.repeat default) (multiset.repeat_injective _), -end - -instance [nonempty α] : infinite (list α) := -infinite.of_surjective (coe : list α → multiset α) (surjective_quot_mk _) - -instance [infinite α] : infinite (option α) := -infinite.of_injective some (option.some_injective α) - -instance sum.infinite_of_left [infinite α] : infinite (α ⊕ β) := -infinite.of_injective sum.inl sum.inl_injective - -instance sum.infinite_of_right [infinite β] : infinite (α ⊕ β) := -infinite.of_injective sum.inr sum.inr_injective - -@[simp] lemma infinite_sum : infinite (α ⊕ β) ↔ infinite α ∨ infinite β := -begin - refine ⟨λ H, _, λ H, H.elim (@sum.infinite_of_left α β) (@sum.infinite_of_right α β)⟩, - contrapose! H, haveI := fintype_of_not_infinite H.1, haveI := fintype_of_not_infinite H.2, - exact infinite.false -end - -instance prod.infinite_of_right [nonempty α] [infinite β] : infinite (α × β) := -infinite.of_surjective prod.snd prod.snd_surjective - -instance prod.infinite_of_left [infinite α] [nonempty β] : infinite (α × β) := -infinite.of_surjective prod.fst prod.fst_surjective - -@[simp] lemma infinite_prod : - infinite (α × β) ↔ infinite α ∧ nonempty β ∨ nonempty α ∧ infinite β := -begin - refine ⟨λ H, _, λ H, H.elim (and_imp.2 $ @prod.infinite_of_left α β) - (and_imp.2 $ @prod.infinite_of_right α β)⟩, - rw and.comm, contrapose! H, introI H', - rcases infinite.nonempty (α × β) with ⟨a, b⟩, - haveI := fintype_of_not_infinite (H.1 ⟨b⟩), haveI := fintype_of_not_infinite (H.2 ⟨a⟩), - exact H'.false -end - -namespace infinite - -private noncomputable def nat_embedding_aux (α : Type*) [infinite α] : ℕ → α -| n := by letI := classical.dec_eq α; exact classical.some (exists_not_mem_finset - ((multiset.range n).pmap (λ m (hm : m < n), nat_embedding_aux m) - (λ _, multiset.mem_range.1)).to_finset) - -private lemma nat_embedding_aux_injective (α : Type*) [infinite α] : - function.injective (nat_embedding_aux α) := -begin - rintro m n h, - letI := classical.dec_eq α, - wlog hmlen : m ≤ n using m n, - by_contradiction hmn, - have hmn : m < n, from lt_of_le_of_ne hmlen hmn, - refine (classical.some_spec (exists_not_mem_finset - ((multiset.range n).pmap (λ m (hm : m < n), nat_embedding_aux α m) - (λ _, multiset.mem_range.1)).to_finset)) _, - refine multiset.mem_to_finset.2 (multiset.mem_pmap.2 - ⟨m, multiset.mem_range.2 hmn, _⟩), - rw [h, nat_embedding_aux] -end - -/-- Embedding of `ℕ` into an infinite type. -/ -noncomputable def nat_embedding (α : Type*) [infinite α] : ℕ ↪ α := -⟨_, nat_embedding_aux_injective α⟩ - -lemma exists_subset_card_eq (α : Type*) [infinite α] (n : ℕ) : - ∃ s : finset α, s.card = n := -⟨(range n).map (nat_embedding α), by rw [card_map, card_range]⟩ - -end infinite - -/-- If every finset in a type has bounded cardinality, that type is finite. -/ -noncomputable def fintype_of_finset_card_le {ι : Type*} (n : ℕ) - (w : ∀ s : finset ι, s.card ≤ n) : fintype ι := -begin - apply fintype_of_not_infinite, - introI i, - obtain ⟨s, c⟩ := infinite.exists_subset_card_eq ι (n+1), - specialize w s, - rw c at w, - exact nat.not_succ_le_self n w, -end - -lemma not_injective_infinite_fintype [infinite α] [fintype β] (f : α → β) : - ¬ injective f := -λ hf, (fintype.of_injective f hf).false - -/-- -The pigeonhole principle for infinitely many pigeons in finitely many pigeonholes. If there are -infinitely many pigeons in finitely many pigeonholes, then there are at least two pigeons in the -same pigeonhole. - -See also: `fintype.exists_ne_map_eq_of_card_lt`, `fintype.exists_infinite_fiber`. --/ -lemma fintype.exists_ne_map_eq_of_infinite [infinite α] [fintype β] (f : α → β) : - ∃ x y : α, x ≠ y ∧ f x = f y := -begin - classical, by_contra' hf, - apply not_injective_infinite_fintype f, - intros x y, contrapose, apply hf, -end - --- irreducible due to this conversation on Zulip: --- https://leanprover.zulipchat.com/#narrow/stream/113488-general/ --- topic/.60simp.60.20ignoring.20lemmas.3F/near/241824115 - -@[irreducible] -instance function.embedding.is_empty {α β} [infinite α] [fintype β] : is_empty (α ↪ β) := - ⟨λ f, let ⟨x, y, ne, feq⟩ := fintype.exists_ne_map_eq_of_infinite f in ne $ f.injective feq⟩ - -@[priority 100] -noncomputable instance function.embedding.fintype' {α β : Type*} [fintype β] : fintype (α ↪ β) := -begin - by_cases h : infinite α, - { resetI, apply_instance }, - { have := fintype_of_not_infinite h, classical, apply_instance } - -- the `classical` generates `decidable_eq α/β` instances, and resets instance cache -end - -/-- -The strong pigeonhole principle for infinitely many pigeons in -finitely many pigeonholes. If there are infinitely many pigeons in -finitely many pigeonholes, then there is a pigeonhole with infinitely -many pigeons. - -See also: `fintype.exists_ne_map_eq_of_infinite` --/ -lemma fintype.exists_infinite_fiber [infinite α] [fintype β] (f : α → β) : - ∃ y : β, infinite (f ⁻¹' {y}) := -begin - classical, - by_contra' hf, - - haveI := λ y, fintype_of_not_infinite $ hf y, - let key : fintype α := - { elems := univ.bUnion (λ (y : β), (f ⁻¹' {y}).to_finset), - complete := by simp }, - exact key.false, -end - -lemma not_surjective_fintype_infinite [fintype α] [infinite β] (f : α → β) : - ¬ surjective f := -assume (hf : surjective f), -have H : infinite α := infinite.of_surjective f hf, -by exactI not_fintype α - section trunc /-- @@ -1992,12 +866,6 @@ A `nonempty` `fintype` constructively contains an element. def trunc_of_nonempty_fintype (α) [nonempty α] [fintype α] : trunc α := trunc_of_multiset_exists_mem finset.univ.val (by simp) -/-- -A `fintype` with positive cardinality constructively contains an element. --/ -def trunc_of_card_pos {α} [fintype α] (h : 0 < fintype.card α) : trunc α := -by { letI := (fintype.card_pos_iff.mp h), exact trunc_of_nonempty_fintype α } - /-- By iterating over the elements of a fintype, we can lift an existential statement `∃ a, P a` to `trunc (Σ' a, P a)`, containing data. @@ -2018,69 +886,6 @@ count_eq_one_of_mem finset.univ.nodup (finset.mem_univ _) end multiset -namespace fintype - -/-- A recursor principle for finite types, analogous to `nat.rec`. It effectively says -that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/ -def trunc_rec_empty_option {P : Type u → Sort v} - (of_equiv : ∀ {α β}, α ≃ β → P α → P β) - (h_empty : P pempty) - (h_option : ∀ {α} [fintype α] [decidable_eq α], P α → P (option α)) - (α : Type u) [fintype α] [decidable_eq α] : trunc (P α) := -begin - suffices : ∀ n : ℕ, trunc (P (ulift $ fin n)), - { apply trunc.bind (this (fintype.card α)), - intro h, - apply trunc.map _ (fintype.trunc_equiv_fin α), - intro e, - exact of_equiv (equiv.ulift.trans e.symm) h }, - intro n, - induction n with n ih, - { have : card pempty = card (ulift (fin 0)), - { simp only [card_fin, card_pempty, card_ulift] }, - apply trunc.bind (trunc_equiv_of_card_eq this), - intro e, - apply trunc.mk, - refine of_equiv e h_empty, }, - { have : card (option (ulift (fin n))) = card (ulift (fin n.succ)), - { simp only [card_fin, card_option, card_ulift] }, - apply trunc.bind (trunc_equiv_of_card_eq this), - intro e, - apply trunc.map _ ih, - intro ih, - refine of_equiv e (h_option ih), }, -end - -/-- An induction principle for finite types, analogous to `nat.rec`. It effectively says -that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/ -@[elab_as_eliminator] -lemma induction_empty_option' {P : Π (α : Type u) [fintype α], Prop} - (of_equiv : ∀ α β [fintype β] (e : α ≃ β), @P α (@fintype.of_equiv α β ‹_› e.symm) → @P β ‹_›) - (h_empty : P pempty) - (h_option : ∀ α [fintype α], by exactI P α → P (option α)) - (α : Type u) [fintype α] : P α := -begin - obtain ⟨p⟩ := @trunc_rec_empty_option (λ α, ∀ h, @P α h) - (λ α β e hα hβ, @of_equiv α β hβ e (hα _)) (λ _i, by convert h_empty) - _ α _ (classical.dec_eq α), - { exact p _ }, - { rintro α hα - Pα hα', resetI, convert h_option α (Pα _) } -end - -/-- An induction principle for finite types, analogous to `nat.rec`. It effectively says -that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/ -lemma induction_empty_option {P : Type u → Prop} - (of_equiv : ∀ {α β}, α ≃ β → P α → P β) - (h_empty : P pempty) - (h_option : ∀ {α} [fintype α], P α → P (option α)) - (α : Type u) [fintype α] : P α := -begin - refine induction_empty_option' _ _ _ α, - exacts [λ α β _, of_equiv, h_empty, @h_option] -end - -end fintype - /-- Auxiliary definition to show `exists_seq_of_forall_finset_exists`. -/ noncomputable def seq_of_forall_finset_exists_aux {α : Type*} [decidable_eq α] (P : α → Prop) (r : α → α → Prop) @@ -2142,29 +947,3 @@ begin { apply symm, exact hf' n m h } end - -/-- A custom induction principle for fintypes. The base case is a subsingleton type, -and the induction step is for non-trivial types, and one can assume the hypothesis for -smaller types (via `fintype.card`). - -The major premise is `fintype α`, so to use this with the `induction` tactic you have to give a name -to that instance and use that name. --/ -@[elab_as_eliminator] -lemma fintype.induction_subsingleton_or_nontrivial - {P : Π α [fintype α], Prop} (α : Type*) [fintype α] - (hbase : ∀ α [fintype α] [subsingleton α], by exactI P α) - (hstep : ∀ α [fintype α] [nontrivial α], - by exactI ∀ (ih : ∀ β [fintype β], by exactI ∀ (h : fintype.card β < fintype.card α), P β), - P α) : - P α := -begin - obtain ⟨ n, hn ⟩ : ∃ n, fintype.card α = n := ⟨fintype.card α, rfl⟩, - unfreezingI { induction n using nat.strong_induction_on with n ih generalizing α }, - casesI (subsingleton_or_nontrivial α) with hsing hnontriv, - { apply hbase, }, - { apply hstep, - introsI β _ hlt, - rw hn at hlt, - exact (ih (fintype.card β) hlt _ rfl), } -end diff --git a/src/data/fintype/big_operators.lean b/src/data/fintype/big_operators.lean new file mode 100644 index 0000000000000..c34174eba89f2 --- /dev/null +++ b/src/data/fintype/big_operators.lean @@ -0,0 +1,258 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.option +import data.fintype.powerset +import data.fintype.sigma +import data.fintype.sum +import data.fintype.vector +import algebra.big_operators.ring +import algebra.big_operators.option + +/-! +Results about "big operations" over a `fintype`, and consequent +results about cardinalities of certain types. + +## Implementation note + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +This content had previously been in `data.fintype.basic`, but was moved here to avoid +requiring `algebra.big_operators` (and hence many other imports) as a +dependency of `fintype`. + +However many of the results here really belong in `algebra.big_operators.basic` +and should be moved at some point. +-/ + +universes u v + +variables {α : Type*} {β : Type*} {γ : Type*} + +open_locale big_operators + +namespace fintype + +@[to_additive] +lemma prod_bool [comm_monoid α] (f : bool → α) : ∏ b, f b = f tt * f ff := by simp + +lemma card_eq_sum_ones {α} [fintype α] : fintype.card α = ∑ a : α, 1 := +finset.card_eq_sum_ones _ + +section +open finset + +variables {ι : Type*} [decidable_eq ι] [fintype ι] + +@[to_additive] +lemma prod_extend_by_one [comm_monoid α] (s : finset ι) (f : ι → α) : + ∏ i, (if i ∈ s then f i else 1) = ∏ i in s, f i := +by rw [← prod_filter, filter_mem_eq_inter, univ_inter] + +end + +section +variables {M : Type*} [fintype α] [comm_monoid M] + +@[to_additive] +lemma prod_eq_one (f : α → M) (h : ∀ a, f a = 1) : + (∏ a, f a) = 1 := +finset.prod_eq_one $ λ a ha, h a + +@[to_additive] +lemma prod_congr (f g : α → M) (h : ∀ a, f a = g a) : + (∏ a, f a) = ∏ a, g a := +finset.prod_congr rfl $ λ a ha, h a + +@[to_additive] +lemma prod_eq_single {f : α → M} (a : α) (h : ∀ x ≠ a, f x = 1) : + (∏ x, f x) = f a := +finset.prod_eq_single a (λ x _ hx, h x hx) $ λ ha, (ha (finset.mem_univ a)).elim + +@[to_additive] +lemma prod_eq_mul {f : α → M} (a b : α) (h₁ : a ≠ b) (h₂ : ∀ x, x ≠ a ∧ x ≠ b → f x = 1) : + (∏ x, f x) = (f a) * (f b) := +begin + apply finset.prod_eq_mul a b h₁ (λ x _ hx, h₂ x hx); + exact λ hc, (hc (finset.mem_univ _)).elim +end + +/-- If a product of a `finset` of a subsingleton type has a given +value, so do the terms in that product. -/ +@[to_additive "If a sum of a `finset` of a subsingleton type has a given +value, so do the terms in that sum."] +lemma eq_of_subsingleton_of_prod_eq {ι : Type*} [subsingleton ι] {s : finset ι} + {f : ι → M} {b : M} (h : ∏ i in s, f i = b) : ∀ i ∈ s, f i = b := +finset.eq_of_card_le_one_of_prod_eq (finset.card_le_one_of_subsingleton s) h + +end + +end fintype + +open finset + +section + +variables {M : Type*} [fintype α] [comm_monoid M] + +@[simp, to_additive] +lemma fintype.prod_option (f : option α → M) : ∏ i, f i = f none * ∏ i, f (some i) := +finset.prod_insert_none f univ + +end + +open finset + +@[simp] theorem fintype.card_sigma {α : Type*} (β : α → Type*) + [fintype α] [∀ a, fintype (β a)] : + fintype.card (sigma β) = ∑ a, fintype.card (β a) := +card_sigma _ _ + +@[simp] lemma finset.card_pi [decidable_eq α] {δ : α → Type*} + (s : finset α) (t : Π a, finset (δ a)) : + (s.pi t).card = ∏ a in s, card (t a) := +multiset.card_pi _ _ + +@[simp] lemma fintype.card_pi_finset [decidable_eq α] [fintype α] + {δ : α → Type*} (t : Π a, finset (δ a)) : + (fintype.pi_finset t).card = ∏ a, card (t a) := +by simp [fintype.pi_finset, card_map] + +@[simp] lemma fintype.card_pi {β : α → Type*} [decidable_eq α] [fintype α] + [f : Π a, fintype (β a)] : fintype.card (Π a, β a) = ∏ a, fintype.card (β a) := +fintype.card_pi_finset _ + +-- FIXME ouch, this should be in the main file. +@[simp] lemma fintype.card_fun [decidable_eq α] [fintype α] [fintype β] : + fintype.card (α → β) = fintype.card β ^ fintype.card α := +by rw [fintype.card_pi, finset.prod_const]; refl + +@[simp] lemma card_vector [fintype α] (n : ℕ) : + fintype.card (vector α n) = fintype.card α ^ n := +by rw fintype.of_equiv_card; simp + +@[simp, to_additive] +lemma finset.prod_attach_univ [fintype α] [comm_monoid β] (f : {a : α // a ∈ @univ α _} → β) : + ∏ x in univ.attach, f x = ∏ x, f ⟨x, (mem_univ _)⟩ := +fintype.prod_equiv (equiv.subtype_univ_equiv (λ x, mem_univ _)) _ _ (λ x, by simp) + +/-- Taking a product over `univ.pi t` is the same as taking the product over `fintype.pi_finset t`. + `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, but differ + in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and + `fintype.pi_finset t` is a `finset (Π a, t a)`. -/ +@[to_additive "Taking a sum over `univ.pi t` is the same as taking the sum over + `fintype.pi_finset t`. `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, + but differ in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and + `fintype.pi_finset t` is a `finset (Π a, t a)`."] +lemma finset.prod_univ_pi [decidable_eq α] [fintype α] [comm_monoid β] + {δ : α → Type*} {t : Π (a : α), finset (δ a)} + (f : (Π (a : α), a ∈ (univ : finset α) → δ a) → β) : + ∏ x in univ.pi t, f x = ∏ x in fintype.pi_finset t, f (λ a _, x a) := +prod_bij (λ x _ a, x a (mem_univ _)) + (by simp) + (by simp) + (by simp [function.funext_iff] {contextual := tt}) + (λ x hx, ⟨λ a _, x a, by simp * at *⟩) + +/-- The product over `univ` of a sum can be written as a sum over the product of sets, + `fintype.pi_finset`. `finset.prod_sum` is an alternative statement when the product is not + over `univ` -/ +lemma finset.prod_univ_sum [decidable_eq α] [fintype α] [comm_semiring β] {δ : α → Type u_1} + [Π (a : α), decidable_eq (δ a)] {t : Π (a : α), finset (δ a)} + {f : Π (a : α), δ a → β} : + ∏ a, ∑ b in t a, f a b = ∑ p in fintype.pi_finset t, ∏ x, f x (p x) := +by simp only [finset.prod_attach_univ, prod_sum, finset.sum_univ_pi] + +/-- Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a fintype of cardinality `n` +gives `(a + b)^n`. The "good" proof involves expanding along all coordinates using the fact that +`x^n` is multilinear, but multilinear maps are only available now over rings, so we give instead +a proof reducing to the usual binomial theorem to have a result over semirings. -/ +lemma fintype.sum_pow_mul_eq_add_pow + (α : Type*) [fintype α] {R : Type*} [comm_semiring R] (a b : R) : + ∑ s : finset α, a ^ s.card * b ^ (fintype.card α - s.card) = + (a + b) ^ (fintype.card α) := +finset.sum_pow_mul_eq_add_pow _ _ _ + +@[to_additive] +lemma function.bijective.prod_comp [fintype α] [fintype β] [comm_monoid γ] {f : α → β} + (hf : function.bijective f) (g : β → γ) : + ∏ i, g (f i) = ∏ i, g i := +fintype.prod_bijective f hf _ _ (λ x, rfl) + +@[to_additive] +lemma equiv.prod_comp [fintype α] [fintype β] [comm_monoid γ] (e : α ≃ β) (f : β → γ) : + ∏ i, f (e i) = ∏ i, f i := +e.bijective.prod_comp f + +@[to_additive] +lemma equiv.prod_comp' [fintype α] [fintype β] [comm_monoid γ] (e : α ≃ β) (f : α → γ) (g : β → γ) + (h : ∀ i, f i = g (e i)) : ∏ i, f i = ∏ i, g i := +(show f = g ∘ e, from funext h).symm ▸ e.prod_comp _ + +/-- It is equivalent to compute the product of a function over `fin n` or `finset.range n`. -/ +@[to_additive "It is equivalent to sum a function over `fin n` or `finset.range n`."] +lemma fin.prod_univ_eq_prod_range [comm_monoid α] (f : ℕ → α) (n : ℕ) : + ∏ i : fin n, f i = ∏ i in range n, f i := +calc (∏ i : fin n, f i) = ∏ i : {x // x ∈ range n}, f i : + (fin.equiv_subtype.trans (equiv.subtype_equiv_right (by simp))).prod_comp' _ _ (by simp) +... = ∏ i in range n, f i : by rw [← attach_eq_univ, prod_attach] + +@[to_additive] +lemma finset.prod_fin_eq_prod_range [comm_monoid β] {n : ℕ} (c : fin n → β) : + ∏ i, c i = ∏ i in finset.range n, if h : i < n then c ⟨i, h⟩ else 1 := +begin + rw [← fin.prod_univ_eq_prod_range, finset.prod_congr rfl], + rintros ⟨i, hi⟩ _, + simp only [fin.coe_eq_val, hi, dif_pos] +end + +@[to_additive] +lemma finset.prod_to_finset_eq_subtype {M : Type*} [comm_monoid M] [fintype α] + (p : α → Prop) [decidable_pred p] (f : α → M) : + ∏ a in {x | p x}.to_finset, f a = ∏ a : subtype p, f a := +by { rw ← finset.prod_subtype, simp } + +@[to_additive] lemma finset.prod_fiberwise [decidable_eq β] [fintype β] [comm_monoid γ] + (s : finset α) (f : α → β) (g : α → γ) : + ∏ b : β, ∏ a in s.filter (λ a, f a = b), g a = ∏ a in s, g a := +finset.prod_fiberwise_of_maps_to (λ x _, mem_univ _) _ + +@[to_additive] +lemma fintype.prod_fiberwise [fintype α] [decidable_eq β] [fintype β] [comm_monoid γ] + (f : α → β) (g : α → γ) : + (∏ b : β, ∏ a : {a // f a = b}, g (a : α)) = ∏ a, g a := +begin + rw [← (equiv.sigma_fiber_equiv f).prod_comp, ← univ_sigma_univ, prod_sigma], + refl +end + +lemma fintype.prod_dite [fintype α] {p : α → Prop} [decidable_pred p] + [comm_monoid β] (f : Π (a : α) (ha : p a), β) (g : Π (a : α) (ha : ¬p a), β) : + (∏ a, dite (p a) (f a) (g a)) = (∏ a : {a // p a}, f a a.2) * (∏ a : {a // ¬p a}, g a a.2) := +begin + simp only [prod_dite, attach_eq_univ], + congr' 1, + { convert (equiv.subtype_equiv_right _).prod_comp (λ x : {x // p x}, f x x.2), + simp }, + { convert (equiv.subtype_equiv_right _).prod_comp (λ x : {x // ¬p x}, g x x.2), + simp } +end + +section +open finset + +variables {α₁ : Type*} {α₂ : Type*} {M : Type*} [fintype α₁] [fintype α₂] [comm_monoid M] + +@[to_additive] +lemma fintype.prod_sum_elim (f : α₁ → M) (g : α₂ → M) : + (∏ x, sum.elim f g x) = (∏ a₁, f a₁) * (∏ a₂, g a₂) := +prod_disj_sum _ _ _ + +@[simp, to_additive] +lemma fintype.prod_sum_type (f : α₁ ⊕ α₂ → M) : + (∏ x, f x) = (∏ a₁, f (sum.inl a₁)) * (∏ a₂, f (sum.inr a₂)) := +prod_disj_sum _ _ _ + +end diff --git a/src/data/fintype/card.lean b/src/data/fintype/card.lean index 3faa0026a84c4..be6e5f6be0c7c 100644 --- a/src/data/fintype/card.lean +++ b/src/data/fintype/card.lean @@ -4,244 +4,1007 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import data.fintype.basic -import algebra.big_operators.ring -import algebra.big_operators.option +import data.finset.card +import data.list.nodup_equiv_fin +import tactic.positivity +import tactic.wlog /-! -Results about "big operations" over a `fintype`, and consequent -results about cardinalities of certain types. +# Cardinalities of finite types -## Implementation note -This content had previously been in `data.fintype.basic`, but was moved here to avoid -requiring `algebra.big_operators` (and hence many other imports) as a -dependency of `fintype`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main declarations + +* `fintype.card α`: Cardinality of a fintype. Equal to `finset.univ.card`. +* `fintype.trunc_equiv_fin`: A fintype `α` is computably equivalent to `fin (card α)`. The + `trunc`-free, noncomputable version is `fintype.equiv_fin`. +* `fintype.trunc_equiv_of_card_eq` `fintype.equiv_of_card_eq`: Two fintypes of same cardinality are + equivalent. See above. +* `fin.equiv_iff_eq`: `fin m ≃ fin n` iff `m = n`. +* `infinite.nat_embedding`: An embedding of `ℕ` into an infinite type. + +We also provide the following versions of the pigeonholes principle. +* `fintype.exists_ne_map_eq_of_card_lt` and `is_empty_of_card_lt`: Finitely many pigeons and + pigeonholes. Weak formulation. +* `finite.exists_ne_map_eq_of_infinite`: Infinitely many pigeons in finitely many pigeonholes. + Weak formulation. +* `finite.exists_infinite_fiber`: Infinitely many pigeons in finitely many pigeonholes. Strong + formulation. + +Some more pigeonhole-like statements can be found in `data.fintype.card_embedding`. + +Types which have an injection from/a surjection to an `infinite` type are themselves `infinite`. +See `infinite.of_injective` and `infinite.of_surjective`. + +## Instances + +We provide `infinite` instances for +* specific types: `ℕ`, `ℤ` +* type constructors: `multiset α`, `list α` -However many of the results here really belong in `algebra.big_operators.basic` -and should be moved at some point. -/ +open function +open_locale nat + universes u v -variables {α : Type*} {β : Type*} {γ : Type*} +variables {α β γ : Type*} -open_locale big_operators +open finset function namespace fintype -@[to_additive] -lemma prod_bool [comm_monoid α] (f : bool → α) : ∏ b, f b = f tt * f ff := by simp +/-- `card α` is the number of elements in `α`, defined when `α` is a fintype. -/ +def card (α) [fintype α] : ℕ := (@univ α _).card + +/-- There is (computably) an equivalence between `α` and `fin (card α)`. + +Since it is not unique and depends on which permutation +of the universe list is used, the equivalence is wrapped in `trunc` to +preserve computability. + +See `fintype.equiv_fin` for the noncomputable version, +and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` +for an equiv `α ≃ fin n` given `fintype.card α = n`. + +See `fintype.trunc_fin_bijection` for a version without `[decidable_eq α]`. +-/ +def trunc_equiv_fin (α) [decidable_eq α] [fintype α] : trunc (α ≃ fin (card α)) := +by { unfold card finset.card, + exact quot.rec_on_subsingleton (@univ α _).1 + (λ l (h : ∀ x : α, x ∈ l) (nd : l.nodup), + trunc.mk (nd.nth_le_equiv_of_forall_mem_list _ h).symm) + mem_univ_val univ.2 } + +/-- There is (noncomputably) an equivalence between `α` and `fin (card α)`. + +See `fintype.trunc_equiv_fin` for the computable version, +and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` +for an equiv `α ≃ fin n` given `fintype.card α = n`. +-/ +noncomputable def equiv_fin (α) [fintype α] : α ≃ fin (card α) := +by { letI := classical.dec_eq α, exact (trunc_equiv_fin α).out } + +/-- There is (computably) a bijection between `fin (card α)` and `α`. -lemma card_eq_sum_ones {α} [fintype α] : fintype.card α = ∑ a : α, 1 := -finset.card_eq_sum_ones _ +Since it is not unique and depends on which permutation +of the universe list is used, the bijection is wrapped in `trunc` to +preserve computability. + +See `fintype.trunc_equiv_fin` for a version that gives an equivalence +given `[decidable_eq α]`. +-/ +def trunc_fin_bijection (α) [fintype α] : + trunc {f : fin (card α) → α // bijective f} := +by { dunfold card finset.card, + exact quot.rec_on_subsingleton (@univ α _).1 + (λ l (h : ∀ x : α, x ∈ l) (nd : l.nodup), + trunc.mk (nd.nth_le_bijection_of_forall_mem_list _ h)) + mem_univ_val univ.2 } + +theorem subtype_card {p : α → Prop} (s : finset α) (H : ∀ x : α, x ∈ s ↔ p x) : + @card {x // p x} (fintype.subtype s H) = s.card := +multiset.card_pmap _ _ _ + +theorem card_of_subtype {p : α → Prop} (s : finset α) (H : ∀ x : α, x ∈ s ↔ p x) + [fintype {x // p x}] : + card {x // p x} = s.card := +by { rw ← subtype_card s H, congr } + +@[simp] theorem card_of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : + @fintype.card p (of_finset s H) = s.card := +fintype.subtype_card s H + +theorem card_of_finset' {p : set α} (s : finset α) + (H : ∀ x, x ∈ s ↔ x ∈ p) [fintype p] : fintype.card p = s.card := +by rw ←card_of_finset s H; congr + +end fintype + +namespace fintype + +theorem of_equiv_card [fintype α] (f : α ≃ β) : + @card β (of_equiv α f) = card α := +multiset.card_map _ _ + +theorem card_congr {α β} [fintype α] [fintype β] (f : α ≃ β) : card α = card β := +by rw ← of_equiv_card f; congr + +@[congr] +lemma card_congr' {α β} [fintype α] [fintype β] (h : α = β) : card α = card β := +card_congr (by rw h) section -open finset -variables {ι : Type*} [decidable_eq ι] [fintype ι] +variables [fintype α] [fintype β] -@[to_additive] -lemma prod_extend_by_one [comm_monoid α] (s : finset ι) (f : ι → α) : - ∏ i, (if i ∈ s then f i else 1) = ∏ i in s, f i := -by rw [← prod_filter, filter_mem_eq_inter, univ_inter] +/-- If the cardinality of `α` is `n`, there is computably a bijection between `α` and `fin n`. + +See `fintype.equiv_fin_of_card_eq` for the noncomputable definition, +and `fintype.trunc_equiv_fin` and `fintype.equiv_fin` for the bijection `α ≃ fin (card α)`. +-/ +def trunc_equiv_fin_of_card_eq [decidable_eq α] {n : ℕ} (h : fintype.card α = n) : + trunc (α ≃ fin n) := +(trunc_equiv_fin α).map (λ e, e.trans (fin.cast h).to_equiv) + + +/-- If the cardinality of `α` is `n`, there is noncomputably a bijection between `α` and `fin n`. + +See `fintype.trunc_equiv_fin_of_card_eq` for the computable definition, +and `fintype.trunc_equiv_fin` and `fintype.equiv_fin` for the bijection `α ≃ fin (card α)`. +-/ +noncomputable def equiv_fin_of_card_eq {n : ℕ} (h : fintype.card α = n) : + α ≃ fin n := +by { letI := classical.dec_eq α, exact (trunc_equiv_fin_of_card_eq h).out } + +/-- Two `fintype`s with the same cardinality are (computably) in bijection. + +See `fintype.equiv_of_card_eq` for the noncomputable version, +and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` for +the specialization to `fin`. +-/ +def trunc_equiv_of_card_eq [decidable_eq α] [decidable_eq β] (h : card α = card β) : + trunc (α ≃ β) := +(trunc_equiv_fin_of_card_eq h).bind (λ e, (trunc_equiv_fin β).map (λ e', e.trans e'.symm)) + +/-- Two `fintype`s with the same cardinality are (noncomputably) in bijection. + +See `fintype.trunc_equiv_of_card_eq` for the computable version, +and `fintype.trunc_equiv_fin_of_card_eq` and `fintype.equiv_fin_of_card_eq` for +the specialization to `fin`. +-/ +noncomputable def equiv_of_card_eq (h : card α = card β) : α ≃ β := +by { letI := classical.dec_eq α, letI := classical.dec_eq β, + exact (trunc_equiv_of_card_eq h).out } end -section -variables {M : Type*} [fintype α] [comm_monoid M] - -@[to_additive] -lemma prod_eq_one (f : α → M) (h : ∀ a, f a = 1) : - (∏ a, f a) = 1 := -finset.prod_eq_one $ λ a ha, h a - -@[to_additive] -lemma prod_congr (f g : α → M) (h : ∀ a, f a = g a) : - (∏ a, f a) = ∏ a, g a := -finset.prod_congr rfl $ λ a ha, h a - -@[to_additive] -lemma prod_eq_single {f : α → M} (a : α) (h : ∀ x ≠ a, f x = 1) : - (∏ x, f x) = f a := -finset.prod_eq_single a (λ x _ hx, h x hx) $ λ ha, (ha (finset.mem_univ a)).elim - -@[to_additive] -lemma prod_eq_mul {f : α → M} (a b : α) (h₁ : a ≠ b) (h₂ : ∀ x, x ≠ a ∧ x ≠ b → f x = 1) : - (∏ x, f x) = (f a) * (f b) := +theorem card_eq {α β} [F : fintype α] [G : fintype β] : card α = card β ↔ nonempty (α ≃ β) := +⟨λ h, by { haveI := classical.prop_decidable, exact (trunc_equiv_of_card_eq h).nonempty }, + λ ⟨f⟩, card_congr f⟩ + +/-- Note: this lemma is specifically about `fintype.of_subsingleton`. For a statement about +arbitrary `fintype` instances, use either `fintype.card_le_one_iff_subsingleton` or +`fintype.card_unique`. -/ +@[simp] theorem card_of_subsingleton (a : α) [subsingleton α] : + @fintype.card _ (of_subsingleton a) = 1 := rfl + +@[simp] theorem card_unique [unique α] [h : fintype α] : + fintype.card α = 1 := +subsingleton.elim (of_subsingleton default) h ▸ card_of_subsingleton _ + +/-- Note: this lemma is specifically about `fintype.of_is_empty`. For a statement about +arbitrary `fintype` instances, use `fintype.card_eq_zero_iff`. -/ +@[simp] theorem card_of_is_empty [is_empty α] : fintype.card α = 0 := rfl + +end fintype + +namespace set +variables {s t : set α} + +-- We use an arbitrary `[fintype s]` instance here, +-- not necessarily coming from a `[fintype α]`. +@[simp] +lemma to_finset_card {α : Type*} (s : set α) [fintype s] : + s.to_finset.card = fintype.card s := +multiset.card_map subtype.val finset.univ.val + +end set + +lemma finset.card_univ [fintype α] : (finset.univ : finset α).card = fintype.card α := +rfl + +lemma finset.eq_univ_of_card [fintype α] (s : finset α) (hs : s.card = fintype.card α) : + s = univ := +eq_of_subset_of_card_le (subset_univ _) $ by rw [hs, finset.card_univ] + +lemma finset.card_eq_iff_eq_univ [fintype α] (s : finset α) : + s.card = fintype.card α ↔ s = finset.univ := +⟨s.eq_univ_of_card, by { rintro rfl, exact finset.card_univ, }⟩ + +lemma finset.card_le_univ [fintype α] (s : finset α) : + s.card ≤ fintype.card α := +card_le_of_subset (subset_univ s) + +lemma finset.card_lt_univ_of_not_mem [fintype α] {s : finset α} {x : α} (hx : x ∉ s) : + s.card < fintype.card α := +card_lt_card ⟨subset_univ s, not_forall.2 ⟨x, λ hx', hx (hx' $ mem_univ x)⟩⟩ + +lemma finset.card_lt_iff_ne_univ [fintype α] (s : finset α) : + s.card < fintype.card α ↔ s ≠ finset.univ := +s.card_le_univ.lt_iff_ne.trans (not_iff_not_of_iff s.card_eq_iff_eq_univ) + +lemma finset.card_compl_lt_iff_nonempty [fintype α] [decidable_eq α] (s : finset α) : + sᶜ.card < fintype.card α ↔ s.nonempty := +sᶜ.card_lt_iff_ne_univ.trans s.compl_ne_univ_iff_nonempty + +lemma finset.card_univ_diff [decidable_eq α] [fintype α] (s : finset α) : + (finset.univ \ s).card = fintype.card α - s.card := +finset.card_sdiff (subset_univ s) + +lemma finset.card_compl [decidable_eq α] [fintype α] (s : finset α) : + sᶜ.card = fintype.card α - s.card := +finset.card_univ_diff s + +lemma fintype.card_compl_set [fintype α] (s : set α) [fintype s] [fintype ↥sᶜ] : + fintype.card ↥sᶜ = fintype.card α - fintype.card s := +begin + classical, + rw [← set.to_finset_card, ← set.to_finset_card, ← finset.card_compl, set.to_finset_compl] +end + +@[simp] theorem fintype.card_fin (n : ℕ) : fintype.card (fin n) = n := +list.length_fin_range n + +@[simp] lemma finset.card_fin (n : ℕ) : finset.card (finset.univ : finset (fin n)) = n := +by rw [finset.card_univ, fintype.card_fin] + +/-- `fin` as a map from `ℕ` to `Type` is injective. Note that since this is a statement about +equality of types, using it should be avoided if possible. -/ +lemma fin_injective : function.injective fin := +λ m n h, + (fintype.card_fin m).symm.trans $ (fintype.card_congr $ equiv.cast h).trans (fintype.card_fin n) + +/-- A reversed version of `fin.cast_eq_cast` that is easier to rewrite with. -/ +theorem fin.cast_eq_cast' {n m : ℕ} (h : fin n = fin m) : + cast h = ⇑(fin.cast $ fin_injective h) := +(fin.cast_eq_cast _).symm + +lemma card_finset_fin_le {n : ℕ} (s : finset (fin n)) : s.card ≤ n := +by simpa only [fintype.card_fin] using s.card_le_univ + +lemma fin.equiv_iff_eq {m n : ℕ} : nonempty (fin m ≃ fin n) ↔ m = n := +⟨λ ⟨h⟩, by simpa using fintype.card_congr h, λ h, ⟨equiv.cast $ h ▸ rfl ⟩ ⟩ + + +@[simp] lemma fintype.card_subtype_eq (y : α) [fintype {x // x = y}] : + fintype.card {x // x = y} = 1 := +fintype.card_unique + +@[simp] lemma fintype.card_subtype_eq' (y : α) [fintype {x // y = x}] : + fintype.card {x // y = x} = 1 := +fintype.card_unique + +@[simp] theorem fintype.card_empty : fintype.card empty = 0 := rfl + +@[simp] theorem fintype.card_pempty : fintype.card pempty = 0 := rfl + +theorem fintype.card_unit : fintype.card unit = 1 := rfl + +@[simp] theorem fintype.card_punit : fintype.card punit = 1 := rfl + +@[simp] theorem fintype.card_bool : fintype.card bool = 2 := rfl + +@[simp] theorem fintype.card_ulift (α : Type*) [fintype α] : + fintype.card (ulift α) = fintype.card α := +fintype.of_equiv_card _ + +@[simp] theorem fintype.card_plift (α : Type*) [fintype α] : + fintype.card (plift α) = fintype.card α := +fintype.of_equiv_card _ + +@[simp] lemma fintype.card_order_dual (α : Type*) [fintype α] : fintype.card αᵒᵈ = fintype.card α := +rfl + +@[simp] lemma fintype.card_lex (α : Type*) [fintype α] : + fintype.card (lex α) = fintype.card α := rfl + +/-- Given that `α ⊕ β` is a fintype, `α` is also a fintype. This is non-computable as it uses +that `sum.inl` is an injection, but there's no clear inverse if `α` is empty. -/ +noncomputable def fintype.sum_left {α β} [fintype (α ⊕ β)] : fintype α := +fintype.of_injective (sum.inl : α → α ⊕ β) sum.inl_injective + +/-- Given that `α ⊕ β` is a fintype, `β` is also a fintype. This is non-computable as it uses +that `sum.inr` is an injection, but there's no clear inverse if `β` is empty. -/ +noncomputable def fintype.sum_right {α β} [fintype (α ⊕ β)] : fintype β := +fintype.of_injective (sum.inr : β → α ⊕ β) sum.inr_injective + +/-! +### Relation to `finite` + +In this section we prove that `α : Type*` is `finite` if and only if `fintype α` is nonempty. +-/ + +@[nolint fintype_finite] +protected lemma fintype.finite {α : Type*} (h : fintype α) : finite α := ⟨fintype.equiv_fin α⟩ + +/-- For efficiency reasons, we want `finite` instances to have higher +priority than ones coming from `fintype` instances. -/ +@[nolint fintype_finite, priority 900] +instance finite.of_fintype (α : Type*) [fintype α] : finite α := fintype.finite ‹_› + +lemma finite_iff_nonempty_fintype (α : Type*) : + finite α ↔ nonempty (fintype α) := +⟨λ h, let ⟨k, ⟨e⟩⟩ := @finite.exists_equiv_fin α h in ⟨fintype.of_equiv _ e.symm⟩, + λ ⟨_⟩, by exactI infer_instance⟩ + +/-- See also `nonempty_encodable`, `nonempty_denumerable`. -/ +lemma nonempty_fintype (α : Type*) [finite α] : nonempty (fintype α) := +(finite_iff_nonempty_fintype α).mp ‹_› + +/-- Noncomputably get a `fintype` instance from a `finite` instance. This is not an +instance because we want `fintype` instances to be useful for computations. -/ +noncomputable def fintype.of_finite (α : Type*) [finite α] : fintype α := (nonempty_fintype α).some + +lemma finite.of_injective {α β : Sort*} [finite β] (f : α → β) (H : injective f) : finite α := begin - apply finset.prod_eq_mul a b h₁ (λ x _ hx, h₂ x hx); - exact λ hc, (hc (finset.mem_univ _)).elim + casesI nonempty_fintype (plift β), + rw [← equiv.injective_comp equiv.plift f, ← equiv.comp_injective _ equiv.plift.symm] at H, + haveI := fintype.of_injective _ H, + exact finite.of_equiv _ equiv.plift, +end + +lemma finite.of_surjective {α β : Sort*} [finite α] (f : α → β) (H : surjective f) : + finite β := +finite.of_injective _ $ injective_surj_inv H + +lemma finite.exists_univ_list (α) [finite α] : ∃ l : list α, l.nodup ∧ ∀ x : α, x ∈ l := +by { casesI nonempty_fintype α, obtain ⟨l, e⟩ := quotient.exists_rep (@univ α _).1, + have := and.intro univ.2 mem_univ_val, exact ⟨_, by rwa ←e at this⟩ } + +lemma list.nodup.length_le_card {α : Type*} [fintype α] {l : list α} (h : l.nodup) : + l.length ≤ fintype.card α := +by { classical, exact list.to_finset_card_of_nodup h ▸ l.to_finset.card_le_univ } + +namespace fintype +variables [fintype α] [fintype β] + +lemma card_le_of_injective (f : α → β) (hf : function.injective f) : card α ≤ card β := +finset.card_le_card_of_inj_on f (λ _ _, finset.mem_univ _) (λ _ _ _ _ h, hf h) + +lemma card_le_of_embedding (f : α ↪ β) : card α ≤ card β := card_le_of_injective f f.2 + +lemma card_lt_of_injective_of_not_mem (f : α → β) (h : function.injective f) + {b : β} (w : b ∉ set.range f) : card α < card β := +calc card α = (univ.map ⟨f, h⟩).card : (card_map _).symm +... < card β : finset.card_lt_univ_of_not_mem $ + by rwa [← mem_coe, coe_map, coe_univ, set.image_univ] + +lemma card_lt_of_injective_not_surjective (f : α → β) (h : function.injective f) + (h' : ¬function.surjective f) : card α < card β := +let ⟨y, hy⟩ := not_forall.1 h' in card_lt_of_injective_of_not_mem f h hy + +lemma card_le_of_surjective (f : α → β) (h : function.surjective f) : card β ≤ card α := +card_le_of_injective _ (function.injective_surj_inv h) + +lemma card_range_le {α β : Type*} (f : α → β) [fintype α] [fintype (set.range f)] : + fintype.card (set.range f) ≤ fintype.card α := +fintype.card_le_of_surjective (λ a, ⟨f a, by simp⟩) (λ ⟨_, a, ha⟩, ⟨a, by simpa using ha⟩) + +lemma card_range {α β F : Type*} [embedding_like F α β] (f : F) [fintype α] + [fintype (set.range f)] : + fintype.card (set.range f) = fintype.card α := +eq.symm $ fintype.card_congr $ equiv.of_injective _ $ embedding_like.injective f + +/-- +The pigeonhole principle for finitely many pigeons and pigeonholes. +This is the `fintype` version of `finset.exists_ne_map_eq_of_card_lt_of_maps_to`. +-/ +lemma exists_ne_map_eq_of_card_lt (f : α → β) (h : fintype.card β < fintype.card α) : + ∃ x y, x ≠ y ∧ f x = f y := +let ⟨x, _, y, _, h⟩ := finset.exists_ne_map_eq_of_card_lt_of_maps_to h (λ x _, mem_univ (f x)) +in ⟨x, y, h⟩ + +lemma card_eq_one_iff : card α = 1 ↔ (∃ x : α, ∀ y, y = x) := +by rw [←card_unit, card_eq]; exact +⟨λ ⟨a⟩, ⟨a.symm (), λ y, a.injective (subsingleton.elim _ _)⟩, + λ ⟨x, hx⟩, ⟨⟨λ _, (), λ _, x, λ _, (hx _).trans (hx _).symm, + λ _, subsingleton.elim _ _⟩⟩⟩ + +lemma card_eq_zero_iff : card α = 0 ↔ is_empty α := +by rw [card, finset.card_eq_zero, univ_eq_empty_iff] + +lemma card_eq_zero [is_empty α] : card α = 0 := card_eq_zero_iff.2 ‹_› + +lemma card_eq_one_iff_nonempty_unique : card α = 1 ↔ nonempty (unique α) := +⟨λ h, let ⟨d, h⟩ := fintype.card_eq_one_iff.mp h in ⟨{ default := d, uniq := h}⟩, + λ ⟨h⟩, by exactI fintype.card_unique⟩ + +/-- A `fintype` with cardinality zero is equivalent to `empty`. -/ +def card_eq_zero_equiv_equiv_empty : card α = 0 ≃ (α ≃ empty) := +(equiv.of_iff card_eq_zero_iff).trans (equiv.equiv_empty_equiv α).symm + +lemma card_pos_iff : 0 < card α ↔ nonempty α := +pos_iff_ne_zero.trans $ not_iff_comm.mp $ not_nonempty_iff.trans card_eq_zero_iff.symm + +lemma card_pos [h : nonempty α] : 0 < card α := +card_pos_iff.mpr h + +lemma card_ne_zero [nonempty α] : card α ≠ 0 := +ne_of_gt card_pos + +lemma card_le_one_iff : card α ≤ 1 ↔ (∀ a b : α, a = b) := +let n := card α in +have hn : n = card α := rfl, +match n, hn with +| 0 := λ ha, ⟨λ h, λ a, (card_eq_zero_iff.1 ha.symm).elim a, λ _, ha ▸ nat.le_succ _⟩ +| 1 := λ ha, ⟨λ h, λ a b, let ⟨x, hx⟩ := card_eq_one_iff.1 ha.symm in + by rw [hx a, hx b], + λ _, ha ▸ le_rfl⟩ +| (n+2) := λ ha, ⟨λ h, by rw ← ha at h; exact absurd h dec_trivial, + (λ h, card_unit ▸ card_le_of_injective (λ _, ()) + (λ _ _ _, h _ _))⟩ end -/-- If a product of a `finset` of a subsingleton type has a given -value, so do the terms in that product. -/ -@[to_additive "If a sum of a `finset` of a subsingleton type has a given -value, so do the terms in that sum."] -lemma eq_of_subsingleton_of_prod_eq {ι : Type*} [subsingleton ι] {s : finset ι} - {f : ι → M} {b : M} (h : ∏ i in s, f i = b) : ∀ i ∈ s, f i = b := -finset.eq_of_card_le_one_of_prod_eq (finset.card_le_one_of_subsingleton s) h +lemma card_le_one_iff_subsingleton : card α ≤ 1 ↔ subsingleton α := +card_le_one_iff.trans subsingleton_iff.symm +lemma one_lt_card_iff_nontrivial : 1 < card α ↔ nontrivial α := +begin + classical, + rw ←not_iff_not, + push_neg, + rw [not_nontrivial_iff_subsingleton, card_le_one_iff_subsingleton] end +lemma exists_ne_of_one_lt_card (h : 1 < card α) (a : α) : ∃ b : α, b ≠ a := +by { haveI : nontrivial α := one_lt_card_iff_nontrivial.1 h, exact exists_ne a } + +lemma exists_pair_of_one_lt_card (h : 1 < card α) : ∃ (a b : α), a ≠ b := +by { haveI : nontrivial α := one_lt_card_iff_nontrivial.1 h, exact exists_pair_ne α } + +lemma card_eq_one_of_forall_eq {i : α} (h : ∀ j, j = i) : card α = 1 := +fintype.card_eq_one_iff.2 ⟨i,h⟩ + +lemma one_lt_card [h : nontrivial α] : 1 < fintype.card α := +fintype.one_lt_card_iff_nontrivial.mpr h + +lemma one_lt_card_iff : 1 < card α ↔ ∃ a b : α, a ≠ b := +one_lt_card_iff_nontrivial.trans nontrivial_iff + +lemma two_lt_card_iff : 2 < card α ↔ ∃ a b c : α, a ≠ b ∧ a ≠ c ∧ b ≠ c := +by simp_rw [←finset.card_univ, two_lt_card_iff, mem_univ, true_and] + +lemma card_of_bijective {f : α → β} (hf : bijective f) : card α = card β := +card_congr (equiv.of_bijective f hf) + end fintype -open finset +namespace finite +variables [finite α] -section +lemma injective_iff_surjective {f : α → α} : injective f ↔ surjective f := +by haveI := classical.prop_decidable; casesI nonempty_fintype α; exact +have ∀ {f : α → α}, injective f → surjective f, +from λ f hinj x, + have h₁ : image f univ = univ := eq_of_subset_of_card_le (subset_univ _) + ((card_image_of_injective univ hinj).symm ▸ le_rfl), + have h₂ : x ∈ image f univ := h₁.symm ▸ mem_univ _, + exists_of_bex (mem_image.1 h₂), +⟨this, + λ hsurj, has_left_inverse.injective + ⟨surj_inv hsurj, left_inverse_of_surjective_of_right_inverse + (this (injective_surj_inv _)) (right_inverse_surj_inv _)⟩⟩ + +lemma injective_iff_bijective {f : α → α} : injective f ↔ bijective f := +by simp [bijective, injective_iff_surjective] + +lemma surjective_iff_bijective {f : α → α} : surjective f ↔ bijective f := +by simp [bijective, injective_iff_surjective] + +lemma injective_iff_surjective_of_equiv {f : α → β} (e : α ≃ β) : injective f ↔ surjective f := +have injective (e.symm ∘ f) ↔ surjective (e.symm ∘ f), from injective_iff_surjective, +⟨λ hinj, by simpa [function.comp] using + e.surjective.comp (this.1 (e.symm.injective.comp hinj)), +λ hsurj, by simpa [function.comp] using + e.injective.comp (this.2 (e.symm.surjective.comp hsurj))⟩ -variables {M : Type*} [fintype α] [comm_monoid M] - -@[simp, to_additive] -lemma fintype.prod_option (f : option α → M) : ∏ i, f i = f none * ∏ i, f (some i) := -finset.prod_insert_none f univ - -end - -open finset - -@[simp] theorem fintype.card_sigma {α : Type*} (β : α → Type*) - [fintype α] [∀ a, fintype (β a)] : - fintype.card (sigma β) = ∑ a, fintype.card (β a) := -card_sigma _ _ - -@[simp] lemma finset.card_pi [decidable_eq α] {δ : α → Type*} - (s : finset α) (t : Π a, finset (δ a)) : - (s.pi t).card = ∏ a in s, card (t a) := -multiset.card_pi _ _ - -@[simp] lemma fintype.card_pi_finset [decidable_eq α] [fintype α] - {δ : α → Type*} (t : Π a, finset (δ a)) : - (fintype.pi_finset t).card = ∏ a, card (t a) := -by simp [fintype.pi_finset, card_map] - -@[simp] lemma fintype.card_pi {β : α → Type*} [decidable_eq α] [fintype α] - [f : Π a, fintype (β a)] : fintype.card (Π a, β a) = ∏ a, fintype.card (β a) := -fintype.card_pi_finset _ - --- FIXME ouch, this should be in the main file. -@[simp] lemma fintype.card_fun [decidable_eq α] [fintype α] [fintype β] : - fintype.card (α → β) = fintype.card β ^ fintype.card α := -by rw [fintype.card_pi, finset.prod_const]; refl - -@[simp] lemma card_vector [fintype α] (n : ℕ) : - fintype.card (vector α n) = fintype.card α ^ n := -by rw fintype.of_equiv_card; simp - -@[simp, to_additive] -lemma finset.prod_attach_univ [fintype α] [comm_monoid β] (f : {a : α // a ∈ @univ α _} → β) : - ∏ x in univ.attach, f x = ∏ x, f ⟨x, (mem_univ _)⟩ := -fintype.prod_equiv (equiv.subtype_univ_equiv (λ x, mem_univ _)) _ _ (λ x, by simp) - -/-- Taking a product over `univ.pi t` is the same as taking the product over `fintype.pi_finset t`. - `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, but differ - in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and - `fintype.pi_finset t` is a `finset (Π a, t a)`. -/ -@[to_additive "Taking a sum over `univ.pi t` is the same as taking the sum over - `fintype.pi_finset t`. `univ.pi t` and `fintype.pi_finset t` are essentially the same `finset`, - but differ in the type of their element, `univ.pi t` is a `finset (Π a ∈ univ, t a)` and - `fintype.pi_finset t` is a `finset (Π a, t a)`."] -lemma finset.prod_univ_pi [decidable_eq α] [fintype α] [comm_monoid β] - {δ : α → Type*} {t : Π (a : α), finset (δ a)} - (f : (Π (a : α), a ∈ (univ : finset α) → δ a) → β) : - ∏ x in univ.pi t, f x = ∏ x in fintype.pi_finset t, f (λ a _, x a) := -prod_bij (λ x _ a, x a (mem_univ _)) - (by simp) - (by simp) - (by simp [function.funext_iff] {contextual := tt}) - (λ x hx, ⟨λ a _, x a, by simp * at *⟩) - -/-- The product over `univ` of a sum can be written as a sum over the product of sets, - `fintype.pi_finset`. `finset.prod_sum` is an alternative statement when the product is not - over `univ` -/ -lemma finset.prod_univ_sum [decidable_eq α] [fintype α] [comm_semiring β] {δ : α → Type u_1} - [Π (a : α), decidable_eq (δ a)] {t : Π (a : α), finset (δ a)} - {f : Π (a : α), δ a → β} : - ∏ a, ∑ b in t a, f a b = ∑ p in fintype.pi_finset t, ∏ x, f x (p x) := -by simp only [finset.prod_attach_univ, prod_sum, finset.sum_univ_pi] - -/-- Summing `a^s.card * b^(n-s.card)` over all finite subsets `s` of a fintype of cardinality `n` -gives `(a + b)^n`. The "good" proof involves expanding along all coordinates using the fact that -`x^n` is multilinear, but multilinear maps are only available now over rings, so we give instead -a proof reducing to the usual binomial theorem to have a result over semirings. -/ -lemma fintype.sum_pow_mul_eq_add_pow - (α : Type*) [fintype α] {R : Type*} [comm_semiring R] (a b : R) : - ∑ s : finset α, a ^ s.card * b ^ (fintype.card α - s.card) = - (a + b) ^ (fintype.card α) := -finset.sum_pow_mul_eq_add_pow _ _ _ - -@[to_additive] -lemma function.bijective.prod_comp [fintype α] [fintype β] [comm_monoid γ] {f : α → β} - (hf : function.bijective f) (g : β → γ) : - ∏ i, g (f i) = ∏ i, g i := -fintype.prod_bijective f hf _ _ (λ x, rfl) - -@[to_additive] -lemma equiv.prod_comp [fintype α] [fintype β] [comm_monoid γ] (e : α ≃ β) (f : β → γ) : - ∏ i, f (e i) = ∏ i, f i := -e.bijective.prod_comp f - -/-- It is equivalent to sum a function over `fin n` or `finset.range n`. -/ -@[to_additive] -lemma fin.prod_univ_eq_prod_range [comm_monoid α] (f : ℕ → α) (n : ℕ) : - ∏ i : fin n, f i = ∏ i in range n, f i := -calc (∏ i : fin n, f i) = ∏ i : {x // x ∈ range n}, f i : - ((equiv.fin_equiv_subtype n).trans - (equiv.subtype_equiv_right (λ _, mem_range.symm))).prod_comp (f ∘ coe) -... = ∏ i in range n, f i : by rw [← attach_eq_univ, prod_attach] - -@[to_additive] -lemma finset.prod_fin_eq_prod_range [comm_monoid β] {n : ℕ} (c : fin n → β) : - ∏ i, c i = ∏ i in finset.range n, if h : i < n then c ⟨i, h⟩ else 1 := + +alias injective_iff_bijective ↔ _root_.function.injective.bijective_of_finite _ +alias surjective_iff_bijective ↔ _root_.function.surjective.bijective_of_finite _ +alias injective_iff_surjective_of_equiv ↔ _root_.function.injective.surjective_of_fintype + _root_.function.surjective.injective_of_fintype + +end finite + +namespace fintype +variables [fintype α] [fintype β] + +lemma bijective_iff_injective_and_card (f : α → β) : + bijective f ↔ injective f ∧ card α = card β := +⟨λ h, ⟨h.1, card_of_bijective h⟩, λ h, ⟨h.1, h.1.surjective_of_fintype $ equiv_of_card_eq h.2⟩⟩ + +lemma bijective_iff_surjective_and_card (f : α → β) : + bijective f ↔ surjective f ∧ card α = card β := +⟨λ h, ⟨h.2, card_of_bijective h⟩, λ h, ⟨h.1.injective_of_fintype $ equiv_of_card_eq h.2, h.1⟩⟩ + +lemma _root_.function.left_inverse.right_inverse_of_card_le {f : α → β} {g : β → α} + (hfg : left_inverse f g) (hcard : card α ≤ card β) : + right_inverse f g := +have hsurj : surjective f, from surjective_iff_has_right_inverse.2 ⟨g, hfg⟩, +right_inverse_of_injective_of_left_inverse + ((bijective_iff_surjective_and_card _).2 + ⟨hsurj, le_antisymm hcard (card_le_of_surjective f hsurj)⟩ ).1 + hfg + +lemma _root_.function.right_inverse.left_inverse_of_card_le {f : α → β} {g : β → α} + (hfg : right_inverse f g) (hcard : card β ≤ card α) : + left_inverse f g := +function.left_inverse.right_inverse_of_card_le hfg hcard + +end fintype + +namespace equiv +variables [fintype α] [fintype β] + +open fintype + +/-- Construct an equivalence from functions that are inverse to each other. -/ +@[simps] def of_left_inverse_of_card_le (hβα : card β ≤ card α) (f : α → β) (g : β → α) + (h : left_inverse g f) : α ≃ β := +{ to_fun := f, + inv_fun := g, + left_inv := h, + right_inv := h.right_inverse_of_card_le hβα } + +/-- Construct an equivalence from functions that are inverse to each other. -/ +@[simps] def of_right_inverse_of_card_le (hαβ : card α ≤ card β) (f : α → β) (g : β → α) + (h : right_inverse g f) : α ≃ β := +{ to_fun := f, + inv_fun := g, + left_inv := h.left_inverse_of_card_le hαβ, + right_inv := h } + +end equiv + +@[simp] lemma fintype.card_coe (s : finset α) [fintype s] : + fintype.card s = s.card := fintype.card_of_finset' s (λ _, iff.rfl) + +/-- Noncomputable equivalence between a finset `s` coerced to a type and `fin s.card`. -/ +noncomputable def finset.equiv_fin (s : finset α) : s ≃ fin s.card := +fintype.equiv_fin_of_card_eq (fintype.card_coe _) + +/-- Noncomputable equivalence between a finset `s` as a fintype and `fin n`, when there is a +proof that `s.card = n`. -/ +noncomputable def finset.equiv_fin_of_card_eq {s : finset α} {n : ℕ} (h : s.card = n) : s ≃ fin n := +fintype.equiv_fin_of_card_eq ((fintype.card_coe _).trans h) + +/-- Noncomputable equivalence between two finsets `s` and `t` as fintypes when there is a proof +that `s.card = t.card`.-/ +noncomputable def finset.equiv_of_card_eq {s t : finset α} (h : s.card = t.card) : s ≃ t := +fintype.equiv_of_card_eq ((fintype.card_coe _).trans (h.trans (fintype.card_coe _).symm)) + +@[simp] lemma fintype.card_Prop : fintype.card Prop = 2 := rfl + +lemma set_fintype_card_le_univ [fintype α] (s : set α) [fintype ↥s] : + fintype.card ↥s ≤ fintype.card α := +fintype.card_le_of_embedding (function.embedding.subtype s) + +lemma set_fintype_card_eq_univ_iff [fintype α] (s : set α) [fintype ↥s] : + fintype.card s = fintype.card α ↔ s = set.univ := +by rw [←set.to_finset_card, finset.card_eq_iff_eq_univ, ←set.to_finset_univ, set.to_finset_inj] + +namespace function.embedding + +/-- An embedding from a `fintype` to itself can be promoted to an equivalence. -/ +noncomputable def equiv_of_fintype_self_embedding [finite α] (e : α ↪ α) : α ≃ α := +equiv.of_bijective e e.2.bijective_of_finite + +@[simp] +lemma equiv_of_fintype_self_embedding_to_embedding [finite α] (e : α ↪ α) : + e.equiv_of_fintype_self_embedding.to_embedding = e := +by { ext, refl, } + +/-- If `‖β‖ < ‖α‖` there are no embeddings `α ↪ β`. +This is a formulation of the pigeonhole principle. + +Note this cannot be an instance as it needs `h`. -/ +@[simp] lemma is_empty_of_card_lt [fintype α] [fintype β] + (h : fintype.card β < fintype.card α) : is_empty (α ↪ β) := +⟨λ f, let ⟨x, y, ne, feq⟩ := fintype.exists_ne_map_eq_of_card_lt f h in ne $ f.injective feq⟩ + +/-- A constructive embedding of a fintype `α` in another fintype `β` when `card α ≤ card β`. -/ +def trunc_of_card_le [fintype α] [fintype β] [decidable_eq α] [decidable_eq β] + (h : fintype.card α ≤ fintype.card β) : trunc (α ↪ β) := +(fintype.trunc_equiv_fin α).bind $ λ ea, + (fintype.trunc_equiv_fin β).map $ λ eb, + ea.to_embedding.trans ((fin.cast_le h).to_embedding.trans eb.symm.to_embedding) + +lemma nonempty_of_card_le [fintype α] [fintype β] + (h : fintype.card α ≤ fintype.card β) : nonempty (α ↪ β) := +by { classical, exact (trunc_of_card_le h).nonempty } + +lemma nonempty_iff_card_le [fintype α] [fintype β] : + nonempty (α ↪ β) ↔ fintype.card α ≤ fintype.card β := +⟨λ ⟨e⟩, fintype.card_le_of_embedding e, nonempty_of_card_le⟩ + +lemma exists_of_card_le_finset [fintype α] {s : finset β} (h : fintype.card α ≤ s.card) : + ∃ (f : α ↪ β), set.range f ⊆ s := begin - rw [← fin.prod_univ_eq_prod_range, finset.prod_congr rfl], - rintros ⟨i, hi⟩ _, - simp only [fin.coe_eq_val, hi, dif_pos] -end - -@[to_additive] -lemma finset.prod_to_finset_eq_subtype {M : Type*} [comm_monoid M] [fintype α] - (p : α → Prop) [decidable_pred p] (f : α → M) : - ∏ a in {x | p x}.to_finset, f a = ∏ a : subtype p, f a := -by { rw ← finset.prod_subtype, simp } - -@[to_additive] lemma finset.prod_fiberwise [decidable_eq β] [fintype β] [comm_monoid γ] - (s : finset α) (f : α → β) (g : α → γ) : - ∏ b : β, ∏ a in s.filter (λ a, f a = b), g a = ∏ a in s, g a := -finset.prod_fiberwise_of_maps_to (λ x _, mem_univ _) _ - -@[to_additive] -lemma fintype.prod_fiberwise [fintype α] [decidable_eq β] [fintype β] [comm_monoid γ] - (f : α → β) (g : α → γ) : - (∏ b : β, ∏ a : {a // f a = b}, g (a : α)) = ∏ a, g a := + rw ← fintype.card_coe at h, + rcases nonempty_of_card_le h with ⟨f⟩, + exact ⟨f.trans (embedding.subtype _), by simp [set.range_subset_iff]⟩ +end + +end function.embedding + +@[simp] +lemma finset.univ_map_embedding {α : Type*} [fintype α] (e : α ↪ α) : + univ.map e = univ := +by rw [←e.equiv_of_fintype_self_embedding_to_embedding, univ_map_equiv_to_embedding] + +namespace fintype + +lemma card_lt_of_surjective_not_injective [fintype α] [fintype β] (f : α → β) + (h : function.surjective f) (h' : ¬function.injective f) : card β < card α := +card_lt_of_injective_not_surjective _ (function.injective_surj_inv h) $ λ hg, +have w : function.bijective (function.surj_inv h) := ⟨function.injective_surj_inv h, hg⟩, +h' $ h.injective_of_fintype (equiv.of_bijective _ w).symm + +end fintype + +theorem fintype.card_subtype_le [fintype α] (p : α → Prop) [decidable_pred p] : + fintype.card {x // p x} ≤ fintype.card α := +fintype.card_le_of_embedding (function.embedding.subtype _) + +theorem fintype.card_subtype_lt [fintype α] {p : α → Prop} [decidable_pred p] + {x : α} (hx : ¬ p x) : fintype.card {x // p x} < fintype.card α := +fintype.card_lt_of_injective_of_not_mem coe subtype.coe_injective $ by rwa subtype.range_coe_subtype + +lemma fintype.card_subtype [fintype α] (p : α → Prop) [decidable_pred p] : + fintype.card {x // p x} = ((finset.univ : finset α).filter p).card := begin - rw [← (equiv.sigma_fiber_equiv f).prod_comp, ← univ_sigma_univ, prod_sigma], - refl + refine fintype.card_of_subtype _ _, + simp end -lemma fintype.prod_dite [fintype α] {p : α → Prop} [decidable_pred p] - [comm_monoid β] (f : Π (a : α) (ha : p a), β) (g : Π (a : α) (ha : ¬p a), β) : - (∏ a, dite (p a) (f a) (g a)) = (∏ a : {a // p a}, f a a.2) * (∏ a : {a // ¬p a}, g a a.2) := +@[simp] +lemma fintype.card_subtype_compl [fintype α] + (p : α → Prop) [fintype {x // p x}] [fintype {x // ¬ p x}] : + fintype.card {x // ¬ p x} = fintype.card α - fintype.card {x // p x} := begin - simp only [prod_dite, attach_eq_univ], - congr' 1, - { convert (equiv.subtype_equiv_right _).prod_comp (λ x : {x // p x}, f x x.2), - simp }, - { convert (equiv.subtype_equiv_right _).prod_comp (λ x : {x // ¬p x}, g x x.2), - simp } + classical, + rw [fintype.card_of_subtype (set.to_finset pᶜ), set.to_finset_compl p, finset.card_compl, + fintype.card_of_subtype (set.to_finset p)]; + intro; simp only [set.mem_to_finset, set.mem_compl_iff]; refl, end +theorem fintype.card_subtype_mono (p q : α → Prop) (h : p ≤ q) + [fintype {x // p x}] [fintype {x // q x}] : + fintype.card {x // p x} ≤ fintype.card {x // q x} := +fintype.card_le_of_embedding (subtype.imp_embedding _ _ h) + +/-- If two subtypes of a fintype have equal cardinality, so do their complements. -/ +lemma fintype.card_compl_eq_card_compl [finite α] (p q : α → Prop) + [fintype {x // p x}] [fintype {x // ¬ p x}] + [fintype {x // q x}] [fintype {x // ¬ q x}] + (h : fintype.card {x // p x} = fintype.card {x // q x}) : + fintype.card {x // ¬ p x} = fintype.card {x // ¬ q x} := +by { casesI nonempty_fintype α, simp only [fintype.card_subtype_compl, h] } + +theorem fintype.card_quotient_le [fintype α] (s : setoid α) [decidable_rel ((≈) : α → α → Prop)] : + fintype.card (quotient s) ≤ fintype.card α := +fintype.card_le_of_surjective _ (surjective_quotient_mk _) + +theorem fintype.card_quotient_lt [fintype α] {s : setoid α} [decidable_rel ((≈) : α → α → Prop)] + {x y : α} (h1 : x ≠ y) (h2 : x ≈ y) : fintype.card (quotient s) < fintype.card α := +fintype.card_lt_of_surjective_not_injective _ (surjective_quotient_mk _) $ λ w, +h1 (w $ quotient.eq.mpr h2) + +lemma univ_eq_singleton_of_card_one {α} [fintype α] (x : α) (h : fintype.card α = 1) : + (univ : finset α) = {x} := +begin + symmetry, + apply eq_of_subset_of_card_le (subset_univ ({x})), + apply le_of_eq, + simp [h, finset.card_univ] +end + +namespace finite +variables [finite α] + +lemma well_founded_of_trans_of_irrefl (r : α → α → Prop) [is_trans α r] [is_irrefl α r] : + well_founded r := +by classical; casesI nonempty_fintype α; exact +have ∀ x y, r x y → (univ.filter (λ z, r z x)).card < (univ.filter (λ z, r z y)).card, + from λ x y hxy, finset.card_lt_card $ + by simp only [finset.lt_iff_ssubset.symm, lt_iff_le_not_le, + finset.le_iff_subset, finset.subset_iff, mem_filter, true_and, mem_univ, hxy]; + exact ⟨λ z hzx, trans hzx hxy, not_forall_of_exists_not ⟨x, not_imp.2 ⟨hxy, irrefl x⟩⟩⟩, +subrelation.wf this (measure_wf _) + +@[priority 100] -- See note [lower instance priority] +instance finite.to_well_founded_lt [preorder α] : well_founded_lt α := +⟨well_founded_of_trans_of_irrefl _⟩ +@[priority 100] -- See note [lower instance priority] +instance finite.to_well_founded_gt [preorder α] : well_founded_gt α := +⟨well_founded_of_trans_of_irrefl _⟩ + +@[priority 10] instance linear_order.is_well_order_lt [linear_order α] : is_well_order α (<) := {} +@[priority 10] instance linear_order.is_well_order_gt [linear_order α] : is_well_order α (>) := {} + +end finite + +@[nolint fintype_finite] +protected lemma fintype.false [infinite α] (h : fintype α) : false := not_finite α + +@[simp] lemma is_empty_fintype {α : Type*} : is_empty (fintype α) ↔ infinite α := +⟨λ ⟨h⟩, ⟨λ h', (@nonempty_fintype α h').elim h⟩, λ ⟨h⟩, ⟨λ h', h h'.finite⟩⟩ + +/-- A non-infinite type is a fintype. -/ +noncomputable def fintype_of_not_infinite {α : Type*} (h : ¬ infinite α) : fintype α := +@fintype.of_finite _ (not_infinite_iff_finite.mp h) + section -open finset +open_locale classical + +/-- +Any type is (classically) either a `fintype`, or `infinite`. + +One can obtain the relevant typeclasses via `cases fintype_or_infinite α; resetI`. +-/ +noncomputable def fintype_or_infinite (α : Type*) : psum (fintype α) (infinite α) := +if h : infinite α then psum.inr h else psum.inl (fintype_of_not_infinite h) + +end + +lemma finset.exists_minimal {α : Type*} [preorder α] (s : finset α) (h : s.nonempty) : + ∃ m ∈ s, ∀ x ∈ s, ¬ (x < m) := +begin + obtain ⟨c, hcs : c ∈ s⟩ := h, + have : well_founded (@has_lt.lt {x // x ∈ s} _) := finite.well_founded_of_trans_of_irrefl _, + obtain ⟨⟨m, hms : m ∈ s⟩, -, H⟩ := this.has_min set.univ ⟨⟨c, hcs⟩, trivial⟩, + exact ⟨m, hms, λ x hx hxm, H ⟨x, hx⟩ trivial hxm⟩, +end -variables {α₁ : Type*} {α₂ : Type*} {M : Type*} [fintype α₁] [fintype α₂] [comm_monoid M] +lemma finset.exists_maximal {α : Type*} [preorder α] (s : finset α) (h : s.nonempty) : + ∃ m ∈ s, ∀ x ∈ s, ¬ (m < x) := +@finset.exists_minimal αᵒᵈ _ s h -@[to_additive] -lemma fintype.prod_sum_elim (f : α₁ → M) (g : α₂ → M) : - (∏ x, sum.elim f g x) = (∏ a₁, f a₁) * (∏ a₂, g a₂) := -by { classical, rw [univ_sum_type, prod_sum_elim] } +namespace infinite -@[to_additive] -lemma fintype.prod_sum_type (f : α₁ ⊕ α₂ → M) : - (∏ x, f x) = (∏ a₁, f (sum.inl a₁)) * (∏ a₂, f (sum.inr a₂)) := -by simp only [← fintype.prod_sum_elim, sum.elim_comp_inl_inr] +lemma of_not_fintype (h : fintype α → false) : infinite α := is_empty_fintype.mp ⟨h⟩ +/-- If `s : set α` is a proper subset of `α` and `f : α → s` is injective, then `α` is infinite. -/ +lemma of_injective_to_set {s : set α} (hs : s ≠ set.univ) {f : α → s} (hf : injective f) : + infinite α := +of_not_fintype $ λ h, begin + resetI, classical, + refine lt_irrefl (fintype.card α) _, + calc fintype.card α ≤ fintype.card s : fintype.card_le_of_injective f hf + ... = s.to_finset.card : s.to_finset_card.symm + ... < fintype.card α : finset.card_lt_card $ + by rwa [set.to_finset_ssubset_univ, set.ssubset_univ_iff] end + +/-- If `s : set α` is a proper subset of `α` and `f : s → α` is surjective, then `α` is infinite. -/ +lemma of_surjective_from_set {s : set α} (hs : s ≠ set.univ) {f : s → α} (hf : surjective f) : + infinite α := +of_injective_to_set hs (injective_surj_inv hf) + +lemma exists_not_mem_finset [infinite α] (s : finset α) : ∃ x, x ∉ s := +not_forall.1 $ λ h, fintype.false ⟨s, h⟩ + +@[priority 100] -- see Note [lower instance priority] +instance (α : Type*) [H : infinite α] : nontrivial α := +⟨let ⟨x, hx⟩ := exists_not_mem_finset (∅ : finset α) in +let ⟨y, hy⟩ := exists_not_mem_finset ({x} : finset α) in +⟨y, x, by simpa only [mem_singleton] using hy⟩⟩ + +protected lemma nonempty (α : Type*) [infinite α] : nonempty α := +by apply_instance + +lemma of_injective {α β} [infinite β] (f : β → α) (hf : injective f) : infinite α := +⟨λ I, by exactI (finite.of_injective f hf).false⟩ + +lemma of_surjective {α β} [infinite β] (f : α → β) (hf : surjective f) : infinite α := +⟨λ I, by exactI (finite.of_surjective f hf).false⟩ + +end infinite + +instance : infinite ℕ := +infinite.of_not_fintype $ by { introI h, + exact (finset.range _).card_le_univ.not_lt ((nat.lt_succ_self _).trans_eq (card_range _).symm) } + +instance : infinite ℤ := +infinite.of_injective int.of_nat (λ _ _, int.of_nat.inj) + +instance [nonempty α] : infinite (multiset α) := +let ⟨x⟩ := ‹nonempty α› in + infinite.of_injective (λ n, multiset.replicate n x) (multiset.replicate_left_injective _) + +instance [nonempty α] : infinite (list α) := +infinite.of_surjective (coe : list α → multiset α) (surjective_quot_mk _) + +instance infinite.set [infinite α] : infinite (set α) := +infinite.of_injective singleton set.singleton_injective + +instance [infinite α] : infinite (finset α) := +infinite.of_injective singleton finset.singleton_injective + +instance [infinite α] : infinite (option α) := +infinite.of_injective some (option.some_injective α) + +instance sum.infinite_of_left [infinite α] : infinite (α ⊕ β) := +infinite.of_injective sum.inl sum.inl_injective + +instance sum.infinite_of_right [infinite β] : infinite (α ⊕ β) := +infinite.of_injective sum.inr sum.inr_injective + +instance prod.infinite_of_right [nonempty α] [infinite β] : infinite (α × β) := +infinite.of_surjective prod.snd prod.snd_surjective + +instance prod.infinite_of_left [infinite α] [nonempty β] : infinite (α × β) := +infinite.of_surjective prod.fst prod.fst_surjective + +namespace infinite + +private noncomputable def nat_embedding_aux (α : Type*) [infinite α] : ℕ → α +| n := by letI := classical.dec_eq α; exact classical.some (exists_not_mem_finset + ((multiset.range n).pmap (λ m (hm : m < n), nat_embedding_aux m) + (λ _, multiset.mem_range.1)).to_finset) + +private lemma nat_embedding_aux_injective (α : Type*) [infinite α] : + function.injective (nat_embedding_aux α) := +begin + rintro m n h, + letI := classical.dec_eq α, + wlog hmlen : m ≤ n generalizing m n, + { exact (this h.symm $ le_of_not_le hmlen).symm }, + by_contradiction hmn, + have hmn : m < n, from lt_of_le_of_ne hmlen hmn, + refine (classical.some_spec (exists_not_mem_finset + ((multiset.range n).pmap (λ m (hm : m < n), nat_embedding_aux α m) + (λ _, multiset.mem_range.1)).to_finset)) _, + refine multiset.mem_to_finset.2 (multiset.mem_pmap.2 + ⟨m, multiset.mem_range.2 hmn, _⟩), + rw [h, nat_embedding_aux] +end + +/-- Embedding of `ℕ` into an infinite type. -/ +noncomputable def nat_embedding (α : Type*) [infinite α] : ℕ ↪ α := +⟨_, nat_embedding_aux_injective α⟩ + +/-- See `infinite.exists_superset_card_eq` for a version that, for a `s : finset α`, +provides a superset `t : finset α`, `s ⊆ t` such that `t.card` is fixed. -/ +lemma exists_subset_card_eq (α : Type*) [infinite α] (n : ℕ) : + ∃ s : finset α, s.card = n := +⟨(range n).map (nat_embedding α), by rw [card_map, card_range]⟩ + +/-- See `infinite.exists_subset_card_eq` for a version that provides an arbitrary +`s : finset α` for any cardinality. -/ +lemma exists_superset_card_eq [infinite α] (s : finset α) (n : ℕ) (hn : s.card ≤ n) : + ∃ t : finset α, s ⊆ t ∧ t.card = n := +begin + induction n with n IH generalizing s, + { exact ⟨s, subset_refl _, nat.eq_zero_of_le_zero hn⟩ }, + { cases hn.eq_or_lt with hn' hn', + { exact ⟨s, subset_refl _, hn'⟩ }, + obtain ⟨t, hs, ht⟩ := IH _ (nat.le_of_lt_succ hn'), + obtain ⟨x, hx⟩ := exists_not_mem_finset t, + refine ⟨finset.cons x t hx, hs.trans (finset.subset_cons _), _⟩, + simp [hx, ht] } +end + +end infinite + +/-- If every finset in a type has bounded cardinality, that type is finite. -/ +noncomputable def fintype_of_finset_card_le {ι : Type*} (n : ℕ) + (w : ∀ s : finset ι, s.card ≤ n) : fintype ι := +begin + apply fintype_of_not_infinite, + introI i, + obtain ⟨s, c⟩ := infinite.exists_subset_card_eq ι (n+1), + specialize w s, + rw c at w, + exact nat.not_succ_le_self n w, +end + +lemma not_injective_infinite_finite {α β} [infinite α] [finite β] (f : α → β) : ¬ injective f := +λ hf, (finite.of_injective f hf).false + +/-- +The pigeonhole principle for infinitely many pigeons in finitely many pigeonholes. If there are +infinitely many pigeons in finitely many pigeonholes, then there are at least two pigeons in the +same pigeonhole. + +See also: `fintype.exists_ne_map_eq_of_card_lt`, `finite.exists_infinite_fiber`. +-/ +lemma finite.exists_ne_map_eq_of_infinite {α β} [infinite α] [finite β] (f : α → β) : + ∃ x y : α, x ≠ y ∧ f x = f y := +by simpa only [injective, not_forall, not_imp, and.comm] using not_injective_infinite_finite f + +instance function.embedding.is_empty {α β} [infinite α] [finite β] : is_empty (α ↪ β) := +⟨λ f, not_injective_infinite_finite f f.2⟩ + +/-- +The strong pigeonhole principle for infinitely many pigeons in +finitely many pigeonholes. If there are infinitely many pigeons in +finitely many pigeonholes, then there is a pigeonhole with infinitely +many pigeons. + +See also: `finite.exists_ne_map_eq_of_infinite` +-/ +lemma finite.exists_infinite_fiber [infinite α] [finite β] (f : α → β) : + ∃ y : β, infinite (f ⁻¹' {y}) := +begin + classical, + by_contra' hf, + casesI nonempty_fintype β, + haveI := λ y, fintype_of_not_infinite $ hf y, + let key : fintype α := + { elems := univ.bUnion (λ (y : β), (f ⁻¹' {y}).to_finset), + complete := by simp }, + exact key.false, +end + +lemma not_surjective_finite_infinite {α β} [finite α] [infinite β] (f : α → β) : ¬ surjective f := +λ hf, (infinite.of_surjective f hf).not_finite ‹_› + +section trunc + +/-- +A `fintype` with positive cardinality constructively contains an element. +-/ +def trunc_of_card_pos {α} [fintype α] (h : 0 < fintype.card α) : trunc α := +by { letI := (fintype.card_pos_iff.mp h), exact trunc_of_nonempty_fintype α } + +end trunc + +/-- A custom induction principle for fintypes. The base case is a subsingleton type, +and the induction step is for non-trivial types, and one can assume the hypothesis for +smaller types (via `fintype.card`). + +The major premise is `fintype α`, so to use this with the `induction` tactic you have to give a name +to that instance and use that name. +-/ +@[elab_as_eliminator] +lemma fintype.induction_subsingleton_or_nontrivial + {P : Π α [fintype α], Prop} (α : Type*) [fintype α] + (hbase : ∀ α [fintype α] [subsingleton α], by exactI P α) + (hstep : ∀ α [fintype α] [nontrivial α], + by exactI ∀ (ih : ∀ β [fintype β], by exactI ∀ (h : fintype.card β < fintype.card α), P β), + P α) : + P α := +begin + obtain ⟨ n, hn ⟩ : ∃ n, fintype.card α = n := ⟨fintype.card α, rfl⟩, + unfreezingI { induction n using nat.strong_induction_on with n ih generalizing α }, + casesI (subsingleton_or_nontrivial α) with hsing hnontriv, + { apply hbase, }, + { apply hstep, + introsI β _ hlt, + rw hn at hlt, + exact (ih (fintype.card β) hlt _ rfl), } +end + +namespace tactic +open positivity + +private lemma card_univ_pos (α : Type*) [fintype α] [nonempty α] : + 0 < (finset.univ : finset α).card := +finset.univ_nonempty.card_pos + +/-- Extension for the `positivity` tactic: `finset.card s` is positive if `s` is nonempty. -/ +@[positivity] +meta def positivity_finset_card : expr → tactic strictness +| `(finset.card %%s) := do -- TODO: Partial decision procedure for `finset.nonempty` + p ← to_expr ``(finset.nonempty %%s) >>= find_assumption, + positive <$> mk_app ``finset.nonempty.card_pos [p] +| `(@fintype.card %%α %%i) := positive <$> mk_mapp ``fintype.card_pos [α, i, none] +| e := pp e >>= fail ∘ format.bracket "The expression `" + "` isn't of the form `finset.card s` or `fintype.card α`" + +end tactic diff --git a/src/data/fintype/card_embedding.lean b/src/data/fintype/card_embedding.lean index 4b8b24fcdc02e..e4b885e127971 100644 --- a/src/data/fintype/card_embedding.lean +++ b/src/data/fintype/card_embedding.lean @@ -3,18 +3,20 @@ Copyright (c) 2021 Eric Rodriguez. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Eric Rodriguez -/ -import data.fintype.card -import logic.equiv.fin +import data.fintype.big_operators import logic.equiv.embedding /-! # Number of embeddings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file establishes the cardinality of `α ↪ β` in full generality. -/ -local notation `|` x `|` := finset.card x -local notation `‖` x `‖` := fintype.card x +local notation (name := finset.card) `|` x `|` := finset.card x +local notation (name := fintype.card) `‖` x `‖` := fintype.card x open function open_locale nat big_operators @@ -29,7 +31,7 @@ lemma card_embedding_eq_of_unique {α β : Type*} [unique α] [fintype β] [fint ‖α ↪ β‖ = (‖β‖.desc_factorial ‖α‖) := begin classical, - unfreezingI { induction ‹fintype α› using fintype.induction_empty_option' + unfreezingI { induction ‹fintype α› using fintype.induction_empty_option with α₁ α₂ h₂ e ih α h ih }, { letI := fintype.of_equiv _ e.symm, rw [← card_congr (equiv.embedding_congr e (equiv.refl β)), ih, card_congr e] }, @@ -43,8 +45,9 @@ end /- The cardinality of embeddings from an infinite type to a finite type is zero. This is a re-statement of the pigeonhole principle. -/ -@[simp] lemma card_embedding_eq_of_infinite {α β} [infinite α] [fintype β] [fintype (α ↪ β)] : +@[simp] lemma card_embedding_eq_of_infinite {α β : Type*} [infinite α] [fintype β] + [fintype (α ↪ β)] : ‖α ↪ β‖ = 0 := -card_eq_zero_iff.mpr function.embedding.is_empty +card_eq_zero end fintype diff --git a/src/data/fintype/fin.lean b/src/data/fintype/fin.lean index 6246fedbb1101..1a68e3bf35ae7 100644 --- a/src/data/fintype/fin.lean +++ b/src/data/fintype/fin.lean @@ -3,11 +3,14 @@ Copyright (c) 2021 Anne Baanen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ -import data.fin.basic -import data.fintype.basic +import data.fin.interval + /-! # The structure of `fintype (fin n)` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains some basic results about the `fintype` instance for `fin`, especially properties of `finset.univ : finset (fin n)`. -/ @@ -18,14 +21,21 @@ open fintype namespace fin -@[simp] -lemma univ_filter_zero_lt {n : ℕ} : - (univ : finset (fin n.succ)).filter (λ i, 0 < i) = - univ.map (fin.succ_embedding _).to_embedding := +variables {α β : Type*} {n : ℕ} + +-- TODO: replace `subtype` with `coe` in the name of this lemma and `fin.map_subtype_embedding_Iio` +lemma map_subtype_embedding_univ : + (finset.univ : finset (fin n)).map fin.coe_embedding = Iio n := +begin + ext, + simp [order_iso_subtype.symm.surjective.exists, order_iso.symm], +end + +@[simp] lemma Ioi_zero_eq_map : + Ioi (0 : fin n.succ) = univ.map (fin.succ_embedding _).to_embedding := begin ext i, - simp only [mem_filter, mem_map, mem_univ, true_and, - function.embedding.coe_fn_mk, exists_true_left], + simp only [mem_Ioi, mem_map, mem_univ, function.embedding.coe_fn_mk, exists_true_left], split, { refine cases _ _ i, { rintro ⟨⟨⟩⟩ }, @@ -34,13 +44,19 @@ begin exact succ_pos _ }, end -@[simp] -lemma univ_filter_succ_lt {n : ℕ} (j : fin n) : - (univ : finset (fin n.succ)).filter (λ i, j.succ < i) = - (univ.filter (λ i, j < i)).map (fin.succ_embedding _).to_embedding := +@[simp] lemma Iio_last_eq_map : + Iio (fin.last n) = finset.univ.map fin.cast_succ.to_embedding := +begin + apply finset.map_injective fin.coe_embedding, + rw [finset.map_map, fin.map_subtype_embedding_Iio, fin.coe_last], + exact map_subtype_embedding_univ.symm +end + +@[simp] lemma Ioi_succ (i : fin n) : + Ioi i.succ = (Ioi i).map (fin.succ_embedding _).to_embedding := begin ext i, - simp only [mem_filter, mem_map, mem_univ, true_and, + simp only [mem_filter, mem_Ioi, mem_map, mem_univ, true_and, function.embedding.coe_fn_mk, exists_true_left], split, { refine cases _ _ i, @@ -50,4 +66,33 @@ begin { rintro ⟨i, hi, rfl⟩, simpa }, end +@[simp] lemma Iio_cast_succ (i : fin n) : + Iio (cast_succ i) = (Iio i).map fin.cast_succ.to_embedding := +begin + apply finset.map_injective fin.coe_embedding, + rw [finset.map_map, fin.map_subtype_embedding_Iio], + exact (fin.map_subtype_embedding_Iio i).symm, +end + +lemma card_filter_univ_succ' (p : fin (n + 1) → Prop) [decidable_pred p] : + (univ.filter p).card = (ite (p 0) 1 0) + (univ.filter (p ∘ fin.succ)).card := +begin + rw [fin.univ_succ, filter_cons, card_disj_union, filter_map, card_map], + split_ifs; simp, +end + +lemma card_filter_univ_succ (p : fin (n + 1) → Prop) [decidable_pred p] : + (univ.filter p).card = + if p 0 then (univ.filter (p ∘ fin.succ)).card + 1 else (univ.filter (p ∘ fin.succ)).card := +(card_filter_univ_succ' p).trans (by split_ifs; simp [add_comm 1]) + +lemma card_filter_univ_eq_vector_nth_eq_count [decidable_eq α] (a : α) (v : vector α n) : + (univ.filter $ λ i, a = v.nth i).card = v.to_list.count a := +begin + induction v using vector.induction_on with n x xs hxs, + { simp }, + { simp_rw [card_filter_univ_succ', vector.nth_cons_zero, vector.to_list_cons, + function.comp, vector.nth_cons_succ, hxs, list.count_cons', add_comm (ite (a = x) 1 0)] } +end + end fin diff --git a/src/data/fintype/lattice.lean b/src/data/fintype/lattice.lean new file mode 100644 index 0000000000000..da74d1a887fca --- /dev/null +++ b/src/data/fintype/lattice.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import data.finset.lattice + +/-! +# Lemmas relating fintypes and order/lattice structure. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open function +open_locale nat + +universes u v + +variables {α β γ : Type*} + +namespace finset +variables [fintype α] {s : finset α} + +/-- A special case of `finset.sup_eq_supr` that omits the useless `x ∈ univ` binder. -/ +lemma sup_univ_eq_supr [complete_lattice β] (f : α → β) : finset.univ.sup f = supr f := +(sup_eq_supr _ f).trans $ congr_arg _ $ funext $ λ a, supr_pos (mem_univ _) + +/-- A special case of `finset.inf_eq_infi` that omits the useless `x ∈ univ` binder. -/ +lemma inf_univ_eq_infi [complete_lattice β] (f : α → β) : finset.univ.inf f = infi f := +sup_univ_eq_supr (by exact f : α → βᵒᵈ) + +@[simp] lemma fold_inf_univ [semilattice_inf α] [order_bot α] (a : α) : + finset.univ.fold (⊓) a (λ x, x) = ⊥ := +eq_bot_iff.2 $ ((finset.fold_op_rel_iff_and $ @_root_.le_inf_iff α _).1 le_rfl).2 ⊥ $ + finset.mem_univ _ + +@[simp] lemma fold_sup_univ [semilattice_sup α] [order_top α] (a : α) : + finset.univ.fold (⊔) a (λ x, x) = ⊤ := +@fold_inf_univ αᵒᵈ ‹fintype α› _ _ _ + +end finset + +open finset function + +lemma finite.exists_max [finite α] [nonempty α] [linear_order β] (f : α → β) : + ∃ x₀ : α, ∀ x, f x ≤ f x₀ := +by { casesI nonempty_fintype α, simpa using exists_max_image univ f univ_nonempty } + +lemma finite.exists_min [finite α] [nonempty α] [linear_order β] (f : α → β) : + ∃ x₀ : α, ∀ x, f x₀ ≤ f x := +by { casesI nonempty_fintype α, simpa using exists_min_image univ f univ_nonempty } diff --git a/src/data/fintype/list.lean b/src/data/fintype/list.lean index a679f2290cdd5..2c9201bc56e31 100644 --- a/src/data/fintype/list.lean +++ b/src/data/fintype/list.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yakov Pechersky -/ import data.fintype.basic -import data.list.perm +import data.finset.powerset /-! # Fintype instance for nodup lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The subtype of `{l : list α // l.nodup}` over a `[fintype α]` admits a `fintype` instance. diff --git a/src/data/fintype/option.lean b/src/data/fintype/option.lean new file mode 100644 index 0000000000000..30ba9cda38553 --- /dev/null +++ b/src/data/fintype/option.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import data.finset.option + +/-! +# fintype instances for option + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open function +open_locale nat + +universes u v + +variables {α β γ : Type*} + + +open finset function + +instance {α : Type*} [fintype α] : fintype (option α) := +⟨univ.insert_none, λ a, by simp⟩ + +lemma univ_option (α : Type*) [fintype α] : (univ : finset (option α)) = insert_none univ := rfl + +@[simp] theorem fintype.card_option {α : Type*} [fintype α] : + fintype.card (option α) = fintype.card α + 1 := +(finset.card_cons _).trans $ congr_arg2 _ (card_map _) rfl + +/-- If `option α` is a `fintype` then so is `α` -/ +def fintype_of_option {α : Type*} [fintype (option α)] : fintype α := +⟨finset.erase_none (fintype.elems (option α)), λ x, mem_erase_none.mpr (fintype.complete (some x))⟩ + +/-- A type is a `fintype` if its successor (using `option`) is a `fintype`. -/ +def fintype_of_option_equiv [fintype α] (f : α ≃ option β) : fintype β := +by { haveI := fintype.of_equiv _ f, exact fintype_of_option } + +namespace fintype + +/-- A recursor principle for finite types, analogous to `nat.rec`. It effectively says +that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/ +def trunc_rec_empty_option {P : Type u → Sort v} + (of_equiv : ∀ {α β}, α ≃ β → P α → P β) + (h_empty : P pempty) + (h_option : ∀ {α} [fintype α] [decidable_eq α], P α → P (option α)) + (α : Type u) [fintype α] [decidable_eq α] : trunc (P α) := +begin + suffices : ∀ n : ℕ, trunc (P (ulift $ fin n)), + { apply trunc.bind (this (fintype.card α)), + intro h, + apply trunc.map _ (fintype.trunc_equiv_fin α), + intro e, + exact of_equiv (equiv.ulift.trans e.symm) h }, + intro n, + induction n with n ih, + { have : card pempty = card (ulift (fin 0)), + { simp only [card_fin, card_pempty, card_ulift] }, + apply trunc.bind (trunc_equiv_of_card_eq this), + intro e, + apply trunc.mk, + refine of_equiv e h_empty, }, + { have : card (option (ulift (fin n))) = card (ulift (fin n.succ)), + { simp only [card_fin, card_option, card_ulift] }, + apply trunc.bind (trunc_equiv_of_card_eq this), + intro e, + apply trunc.map _ ih, + intro ih, + refine of_equiv e (h_option ih), }, +end + +/-- An induction principle for finite types, analogous to `nat.rec`. It effectively says +that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/ +@[elab_as_eliminator] +lemma induction_empty_option {P : Π (α : Type u) [fintype α], Prop} + (of_equiv : ∀ α β [fintype β] (e : α ≃ β), @P α (@fintype.of_equiv α β ‹_› e.symm) → @P β ‹_›) + (h_empty : P pempty) + (h_option : ∀ α [fintype α], by exactI P α → P (option α)) + (α : Type u) [fintype α] : P α := +begin + obtain ⟨p⟩ := @trunc_rec_empty_option (λ α, ∀ h, @P α h) + (λ α β e hα hβ, @of_equiv α β hβ e (hα _)) (λ _i, by convert h_empty) + _ α _ (classical.dec_eq α), + { exact p _ }, + { rintro α hα - Pα hα', resetI, convert h_option α (Pα _) } +end + +end fintype + +/-- An induction principle for finite types, analogous to `nat.rec`. It effectively says +that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/ +lemma finite.induction_empty_option {P : Type u → Prop} + (of_equiv : ∀ {α β}, α ≃ β → P α → P β) + (h_empty : P pempty) + (h_option : ∀ {α} [fintype α], P α → P (option α)) + (α : Type u) [finite α] : P α := +begin + casesI nonempty_fintype α, + refine fintype.induction_empty_option _ _ _ α, + exacts [λ α β _, of_equiv, h_empty, @h_option] +end diff --git a/src/data/fintype/order.lean b/src/data/fintype/order.lean index 2c350ed8a56b7..b3234143e11f7 100644 --- a/src/data/fintype/order.lean +++ b/src/data/fintype/order.lean @@ -3,13 +3,15 @@ Copyright (c) 2021 Peter Nelson. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Peter Nelson, Yaël Dillies -/ -import data.fintype.basic -import order.conditionally_complete_lattice +import data.fintype.lattice import data.finset.order /-! # Order structures on finite types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides order instances on fintypes. ## Computable instances diff --git a/src/data/fintype/parity.lean b/src/data/fintype/parity.lean new file mode 100644 index 0000000000000..9efe5b21bc594 --- /dev/null +++ b/src/data/fintype/parity.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import algebra.parity + +/-! +# The cardinality of `fin (bit0 n)` is even. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +namespace fintype + +instance is_square.decidable_pred [has_mul α] [fintype α] [decidable_eq α] : + decidable_pred (is_square : α → Prop) := +λ a, fintype.decidable_exists_fintype + +end fintype + +/-- The cardinality of `fin (bit0 n)` is even, `fact` version. +This `fact` is needed as an instance by `matrix.special_linear_group.has_neg`. -/ +lemma fintype.card_fin_even {n : ℕ} : fact (even (fintype.card (fin (bit0 n)))) := +⟨by { rw fintype.card_fin, exact even_bit0 _ }⟩ diff --git a/src/data/fintype/perm.lean b/src/data/fintype/perm.lean new file mode 100644 index 0000000000000..c3609830054bd --- /dev/null +++ b/src/data/fintype/perm.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import group_theory.perm.basic + +/-! +# fintype instances for `equiv` and `perm` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Main declarations: +* `perms_of_finset s`: The finset of permutations of the finset `s`. + +-/ + +open function +open_locale nat + +universes u v + +variables {α β γ : Type*} + +open finset function list equiv equiv.perm + +variables [decidable_eq α] [decidable_eq β] + +/-- Given a list, produce a list of all permutations of its elements. -/ +def perms_of_list : list α → list (perm α) +| [] := [1] +| (a :: l) := perms_of_list l ++ l.bind (λ b, (perms_of_list l).map (λ f, swap a b * f)) + +lemma length_perms_of_list : ∀ l : list α, length (perms_of_list l) = l.length! +| [] := rfl +| (a :: l) := +begin + rw [length_cons, nat.factorial_succ], + simp [perms_of_list, length_bind, length_perms_of_list, function.comp, nat.succ_mul], + cc +end + +lemma mem_perms_of_list_of_mem {l : list α} {f : perm α} (h : ∀ x, f x ≠ x → x ∈ l) : + f ∈ perms_of_list l := +begin + induction l with a l IH generalizing f h, + { exact list.mem_singleton.2 (equiv.ext $ λ x, decidable.by_contradiction $ h _) }, + by_cases hfa : f a = a, + { refine mem_append_left _ (IH (λ x hx, mem_of_ne_of_mem _ (h x hx))), + rintro rfl, exact hx hfa }, + have hfa' : f (f a) ≠ f a := mt (λ h, f.injective h) hfa, + have : ∀ (x : α), (swap a (f a) * f) x ≠ x → x ∈ l, + { intros x hx, + have hxa : x ≠ a, + { rintro rfl, apply hx, simp only [mul_apply, swap_apply_right] }, + refine list.mem_of_ne_of_mem hxa (h x (λ h, _)), + simp only [h, mul_apply, swap_apply_def, mul_apply, ne.def, apply_eq_iff_eq] at hx; + split_ifs at hx, exacts [hxa (h.symm.trans h_1), hx h] }, + suffices : f ∈ perms_of_list l ∨ ∃ (b ∈ l) (g ∈ perms_of_list l), swap a b * g = f, + { simpa only [perms_of_list, exists_prop, list.mem_map, mem_append, list.mem_bind] }, + refine or_iff_not_imp_left.2 (λ hfl, ⟨f a, _, swap a (f a) * f, IH this, _⟩), + { exact mem_of_ne_of_mem hfa (h _ hfa') }, + { rw [←mul_assoc, mul_def (swap a (f a)) (swap a (f a)), + swap_swap, ←perm.one_def, one_mul] } +end + +lemma mem_of_mem_perms_of_list : + ∀ {l : list α} {f : perm α}, f ∈ perms_of_list l → ∀ {x}, f x ≠ x → x ∈ l +| [] f h := have f = 1 := by simpa [perms_of_list] using h, by rw this; simp +| (a :: l) f h := +(mem_append.1 h).elim + (λ h x hx, mem_cons_of_mem _ (mem_of_mem_perms_of_list h hx)) + (λ h x hx, + let ⟨y, hy, hy'⟩ := list.mem_bind.1 h in + let ⟨g, hg₁, hg₂⟩ := list.mem_map.1 hy' in + if hxa : x = a then by simp [hxa] + else if hxy : x = y then mem_cons_of_mem _ $ by rwa hxy + else mem_cons_of_mem _ $ + mem_of_mem_perms_of_list hg₁ $ + by rw [eq_inv_mul_iff_mul_eq.2 hg₂, mul_apply, swap_inv, swap_apply_def]; + split_ifs; [exact ne.symm hxy, exact ne.symm hxa, exact hx]) + +lemma mem_perms_of_list_iff {l : list α} {f : perm α} : + f ∈ perms_of_list l ↔ ∀ {x}, f x ≠ x → x ∈ l := +⟨mem_of_mem_perms_of_list, mem_perms_of_list_of_mem⟩ + +lemma nodup_perms_of_list : ∀ {l : list α} (hl : l.nodup), (perms_of_list l).nodup +| [] hl := by simp [perms_of_list] +| (a :: l) hl := +have hl' : l.nodup, from hl.of_cons, +have hln' : (perms_of_list l).nodup, from nodup_perms_of_list hl', +have hmeml : ∀ {f : perm α}, f ∈ perms_of_list l → f a = a, + from λ f hf, not_not.1 (mt (mem_of_mem_perms_of_list hf) (nodup_cons.1 hl).1), +by rw [perms_of_list, list.nodup_append, list.nodup_bind, pairwise_iff_nth_le]; exact +⟨hln', ⟨λ _ _, hln'.map $ λ _ _, mul_left_cancel, + λ i j hj hij x hx₁ hx₂, + let ⟨f, hf⟩ := list.mem_map.1 hx₁ in + let ⟨g, hg⟩ := list.mem_map.1 hx₂ in + have hix : x a = nth_le l i (lt_trans hij hj), + by rw [←hf.2, mul_apply, hmeml hf.1, swap_apply_left], + have hiy : x a = nth_le l j hj, + by rw [← hg.2, mul_apply, hmeml hg.1, swap_apply_left], + absurd (hf.2.trans (hg.2.symm)) $ + λ h, ne_of_lt hij $ nodup_iff_nth_le_inj.1 hl' i j (lt_trans hij hj) hj $ + by rw [← hix, hiy]⟩, + λ f hf₁ hf₂, + let ⟨x, hx, hx'⟩ := list.mem_bind.1 hf₂ in + let ⟨g, hg⟩ := list.mem_map.1 hx' in + have hgxa : g⁻¹ x = a, from f.injective $ + by rw [hmeml hf₁, ← hg.2]; simp, + have hxa : x ≠ a, from λ h, (list.nodup_cons.1 hl).1 (h ▸ hx), + (list.nodup_cons.1 hl).1 $ + hgxa ▸ mem_of_mem_perms_of_list hg.1 (by rwa [apply_inv_self, hgxa])⟩ + +/-- Given a finset, produce the finset of all permutations of its elements. -/ +def perms_of_finset (s : finset α) : finset (perm α) := +quotient.hrec_on s.1 (λ l hl, ⟨perms_of_list l, nodup_perms_of_list hl⟩) + (λ a b hab, hfunext (congr_arg _ (quotient.sound hab)) + (λ ha hb _, heq_of_eq $ finset.ext $ + by simp [mem_perms_of_list_iff, hab.mem_iff])) + s.2 + +lemma mem_perms_of_finset_iff : ∀ {s : finset α} {f : perm α}, + f ∈ perms_of_finset s ↔ ∀ {x}, f x ≠ x → x ∈ s := +by rintros ⟨⟨l⟩, hs⟩ f; exact mem_perms_of_list_iff + +lemma card_perms_of_finset : ∀ (s : finset α), + (perms_of_finset s).card = s.card! := +by rintros ⟨⟨l⟩, hs⟩; exact length_perms_of_list l + +/-- The collection of permutations of a fintype is a fintype. -/ +def fintype_perm [fintype α] : fintype (perm α) := +⟨perms_of_finset (@finset.univ α _), by simp [mem_perms_of_finset_iff]⟩ + +instance [fintype α] [fintype β] : fintype (α ≃ β) := +if h : fintype.card β = fintype.card α +then trunc.rec_on_subsingleton (fintype.trunc_equiv_fin α) + (λ eα, trunc.rec_on_subsingleton (fintype.trunc_equiv_fin β) + (λ eβ, @fintype.of_equiv _ (perm α) fintype_perm + (equiv_congr (equiv.refl α) (eα.trans (eq.rec_on h eβ.symm)) : (α ≃ α) ≃ (α ≃ β)))) +else ⟨∅, λ x, false.elim (h (fintype.card_eq.2 ⟨x.symm⟩))⟩ + +lemma fintype.card_perm [fintype α] : fintype.card (perm α) = (fintype.card α)! := +subsingleton.elim (@fintype_perm α _ _) (@equiv.fintype α α _ _ _ _) ▸ +card_perms_of_finset _ + +lemma fintype.card_equiv [fintype α] [fintype β] (e : α ≃ β) : + fintype.card (α ≃ β) = (fintype.card α)! := +fintype.card_congr (equiv_congr (equiv.refl α) e) ▸ fintype.card_perm diff --git a/src/data/fintype/pi.lean b/src/data/fintype/pi.lean new file mode 100644 index 0000000000000..2c5a26cf37d81 --- /dev/null +++ b/src/data/fintype/pi.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.basic +import data.finset.pi + +/-! +# fintype instances for pi types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +open finset + +namespace fintype + +variables [decidable_eq α] [fintype α] {δ : α → Type*} + +/-- Given for all `a : α` a finset `t a` of `δ a`, then one can define the +finset `fintype.pi_finset t` of all functions taking values in `t a` for all `a`. This is the +analogue of `finset.pi` where the base finset is `univ` (but formally they are not the same, as +there is an additional condition `i ∈ finset.univ` in the `finset.pi` definition). -/ +def pi_finset (t : Π a, finset (δ a)) : finset (Π a, δ a) := +(finset.univ.pi t).map ⟨λ f a, f a (mem_univ a), λ _ _, by simp [function.funext_iff]⟩ + +@[simp] lemma mem_pi_finset {t : Π a, finset (δ a)} {f : Π a, δ a} : + f ∈ pi_finset t ↔ ∀ a, f a ∈ t a := +begin + split, + { simp only [pi_finset, mem_map, and_imp, forall_prop_of_true, exists_prop, mem_univ, + exists_imp_distrib, mem_pi], + rintro g hg hgf a, + rw ← hgf, + exact hg a }, + { simp only [pi_finset, mem_map, forall_prop_of_true, exists_prop, mem_univ, mem_pi], + exact λ hf, ⟨λ a ha, f a, hf, rfl⟩ } +end + +@[simp] lemma coe_pi_finset (t : Π a, finset (δ a)) : + (pi_finset t : set (Π a, δ a)) = set.pi set.univ (λ a, t a) := +set.ext $ λ x, by { rw set.mem_univ_pi, exact fintype.mem_pi_finset } + +lemma pi_finset_subset (t₁ t₂ : Π a, finset (δ a)) (h : ∀ a, t₁ a ⊆ t₂ a) : + pi_finset t₁ ⊆ pi_finset t₂ := +λ g hg, mem_pi_finset.2 $ λ a, h a $ mem_pi_finset.1 hg a + +@[simp] lemma pi_finset_empty [nonempty α] : pi_finset (λ _, ∅ : Π i, finset (δ i)) = ∅ := +eq_empty_of_forall_not_mem $ λ _, by simp + +@[simp] lemma pi_finset_singleton (f : Π i, δ i) : + pi_finset (λ i, {f i} : Π i, finset (δ i)) = {f} := +ext $ λ _, by simp only [function.funext_iff, fintype.mem_pi_finset, mem_singleton] + +lemma pi_finset_subsingleton {f : Π i, finset (δ i)} + (hf : ∀ i, (f i : set (δ i)).subsingleton) : + (fintype.pi_finset f : set (Π i, δ i)).subsingleton := +λ a ha b hb, funext $ λ i, hf _ (mem_pi_finset.1 ha _) (mem_pi_finset.1 hb _) + +lemma pi_finset_disjoint_of_disjoint + (t₁ t₂ : Π a, finset (δ a)) {a : α} (h : disjoint (t₁ a) (t₂ a)) : + disjoint (pi_finset t₁) (pi_finset t₂) := +disjoint_iff_ne.2 $ λ f₁ hf₁ f₂ hf₂ eq₁₂, +disjoint_iff_ne.1 h (f₁ a) (mem_pi_finset.1 hf₁ a) (f₂ a) (mem_pi_finset.1 hf₂ a) (congr_fun eq₁₂ a) + +end fintype + +/-! ### pi -/ + +/-- A dependent product of fintypes, indexed by a fintype, is a fintype. -/ +instance pi.fintype {α : Type*} {β : α → Type*} + [decidable_eq α] [fintype α] [∀ a, fintype (β a)] : fintype (Π a, β a) := +⟨fintype.pi_finset (λ _, univ), by simp⟩ + +@[simp] lemma fintype.pi_finset_univ {α : Type*} {β : α → Type*} + [decidable_eq α] [fintype α] [∀ a, fintype (β a)] : + fintype.pi_finset (λ a : α, (finset.univ : finset (β a))) = (finset.univ : finset (Π a, β a)) := +rfl + + +instance function.embedding.fintype {α β} [fintype α] [fintype β] [decidable_eq α] + [decidable_eq β] : fintype (α ↪ β) := +fintype.of_equiv _ (equiv.subtype_injective_equiv_embedding α β) + +@[simp] lemma finset.univ_pi_univ {α : Type*} {β : α → Type*} + [decidable_eq α] [fintype α] [∀ a, fintype (β a)] : + finset.univ.pi (λ a : α, (finset.univ : finset (β a))) = finset.univ := +by { ext, simp } diff --git a/src/data/fintype/powerset.lean b/src/data/fintype/powerset.lean new file mode 100644 index 0000000000000..00d0d0f68ac52 --- /dev/null +++ b/src/data/fintype/powerset.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import data.finset.powerset + +/-! +# fintype instance for `set α`, when `α` is a fintype + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +open finset + +instance finset.fintype [fintype α] : fintype (finset α) := +⟨univ.powerset, λ x, finset.mem_powerset.2 (finset.subset_univ _)⟩ + +@[simp] lemma fintype.card_finset [fintype α] : + fintype.card (finset α) = 2 ^ (fintype.card α) := +finset.card_powerset finset.univ + +@[simp] lemma finset.powerset_univ [fintype α] : (univ : finset α).powerset = univ := +coe_injective $ by simp [-coe_eq_univ] + +@[simp] lemma finset.powerset_eq_univ [fintype α] {s : finset α} : s.powerset = univ ↔ s = univ := +by rw [←finset.powerset_univ, powerset_inj] + +lemma finset.mem_powerset_len_univ_iff [fintype α] {s : finset α} {k : ℕ} : + s ∈ powerset_len k (univ : finset α) ↔ card s = k := +mem_powerset_len.trans $ and_iff_right $ subset_univ _ + +@[simp] lemma finset.univ_filter_card_eq (α : Type*) [fintype α] (k : ℕ) : + (finset.univ : finset (finset α)).filter (λ s, s.card = k) = finset.univ.powerset_len k := +by { ext, simp [finset.mem_powerset_len] } + +@[simp] lemma fintype.card_finset_len [fintype α] (k : ℕ) : + fintype.card {s : finset α // s.card = k} = nat.choose (fintype.card α) k := +by simp [fintype.subtype_card, finset.card_univ] + +instance set.fintype [fintype α] : fintype (set α) := +⟨(@finset.univ α _).powerset.map ⟨coe, coe_injective⟩, λ s, begin + classical, refine mem_map.2 ⟨finset.univ.filter s, mem_powerset.2 (subset_univ _), _⟩, + apply (coe_filter _ _).trans, rw [coe_univ, set.sep_univ], refl +end⟩ + +-- Not to be confused with `set.finite`, the predicate +instance set.finite' [finite α] : finite (set α) := +by { casesI nonempty_fintype α, apply_instance } + +@[simp] lemma fintype.card_set [fintype α] : fintype.card (set α) = 2 ^ fintype.card α := +(finset.card_map _).trans (finset.card_powerset _) diff --git a/src/data/fintype/prod.lean b/src/data/fintype/prod.lean new file mode 100644 index 0000000000000..a307a74dddf4b --- /dev/null +++ b/src/data/fintype/prod.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import data.finset.prod + +/-! +# fintype instance for the product of two fintypes. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +-/ + +open function +open_locale nat + +universes u v + +variables {α β γ : Type*} + +open finset function + +namespace set +variables {s t : set α} + +lemma to_finset_prod (s : set α) (t : set β) [fintype s] [fintype t] [fintype (s ×ˢ t)] : + (s ×ˢ t).to_finset = s.to_finset ×ˢ t.to_finset := +by { ext, simp } + +lemma to_finset_off_diag {s : set α} [decidable_eq α] [fintype s] [fintype s.off_diag] : + s.off_diag.to_finset = s.to_finset.off_diag := +finset.ext $ by simp + +end set + +instance (α β : Type*) [fintype α] [fintype β] : fintype (α × β) := +⟨univ ×ˢ univ, λ ⟨a, b⟩, by simp⟩ + +@[simp] lemma finset.univ_product_univ {α β : Type*} [fintype α] [fintype β] : + (univ : finset α) ×ˢ (univ : finset β) = univ := +rfl + +@[simp] theorem fintype.card_prod (α β : Type*) [fintype α] [fintype β] : + fintype.card (α × β) = fintype.card α * fintype.card β := +card_product _ _ + +section +open_locale classical + +@[simp] lemma infinite_prod : + infinite (α × β) ↔ infinite α ∧ nonempty β ∨ nonempty α ∧ infinite β := +begin + refine ⟨λ H, _, λ H, H.elim (and_imp.2 $ @prod.infinite_of_left α β) + (and_imp.2 $ @prod.infinite_of_right α β)⟩, + rw and.comm, contrapose! H, introI H', + rcases infinite.nonempty (α × β) with ⟨a, b⟩, + haveI := fintype_of_not_infinite (H.1 ⟨b⟩), haveI := fintype_of_not_infinite (H.2 ⟨a⟩), + exact H'.false +end + +instance pi.infinite_of_left {ι : Sort*} {π : ι → Sort*} [∀ i, nontrivial $ π i] + [infinite ι] : infinite (Π i : ι, π i) := +begin + choose m n hm using λ i, exists_pair_ne (π i), + refine infinite.of_injective (λ i, m.update i (n i)) (λ x y h, not_not.1 $ λ hne, _), + simp_rw [update_eq_iff, update_noteq hne] at h, + exact (hm x h.1.symm).elim, +end + +/-- If at least one `π i` is infinite and the rest nonempty, the pi type of all `π` is infinite. -/ +lemma pi.infinite_of_exists_right {ι : Type*} {π : ι → Type*} (i : ι) + [infinite $ π i] [∀ i, nonempty $ π i] : + infinite (Π i : ι, π i) := +let ⟨m⟩ := @pi.nonempty ι π _ in infinite.of_injective _ (update_injective m i) + +/-- See `pi.infinite_of_exists_right` for the case that only one `π i` is infinite. -/ +instance pi.infinite_of_right {ι : Sort*} {π : ι → Sort*} [∀ i, infinite $ π i] [nonempty ι] : + infinite (Π i : ι, π i) := +pi.infinite_of_exists_right (classical.arbitrary ι) + +/-- Non-dependent version of `pi.infinite_of_left`. -/ +instance function.infinite_of_left {ι π : Sort*} [nontrivial π] + [infinite ι] : infinite (ι → π) := +pi.infinite_of_left + +/-- Non-dependent version of `pi.infinite_of_exists_right` and `pi.infinite_of_right`. -/ +instance function.infinite_of_right {ι π : Sort*} [infinite π] [nonempty ι] : + infinite (ι → π) := +pi.infinite_of_right + +end diff --git a/src/data/fintype/quotient.lean b/src/data/fintype/quotient.lean new file mode 100644 index 0000000000000..2151d3594a6b3 --- /dev/null +++ b/src/data/fintype/quotient.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2018 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.basic + +/-! +# Quotients of families indexed by a finite type + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides `quotient.fin_choice`, a mechanism to go from a finite family of quotients +to a quotient of finite families. + +## Main definitions + +* `quotient.fin_choice` + +-/ + +/-- An auxiliary function for `quotient.fin_choice`. Given a +collection of setoids indexed by a type `ι`, a (finite) list `l` of +indices, and a function that for each `i ∈ l` gives a term of the +corresponding quotient type, then there is a corresponding term in the +quotient of the product of the setoids indexed by `l`. -/ +def quotient.fin_choice_aux {ι : Type*} [decidable_eq ι] + {α : ι → Type*} [S : ∀ i, setoid (α i)] : + Π (l : list ι), (Π i ∈ l, quotient (S i)) → @quotient (Π i ∈ l, α i) (by apply_instance) +| [] f := ⟦λ i, false.elim⟧ +| (i :: l) f := begin + refine quotient.lift_on₂ (f i (list.mem_cons_self _ _)) + (quotient.fin_choice_aux l (λ j h, f j (list.mem_cons_of_mem _ h))) + _ _, + exact λ a l, ⟦λ j h, + if e : j = i then by rw e; exact a else + l _ (h.resolve_left e)⟧, + refine λ a₁ l₁ a₂ l₂ h₁ h₂, quotient.sound (λ j h, _), + by_cases e : j = i; simp [e], + { subst j, exact h₁ }, + { exact h₂ _ _ } +end + +theorem quotient.fin_choice_aux_eq {ι : Type*} [decidable_eq ι] + {α : ι → Type*} [S : ∀ i, setoid (α i)] : + ∀ (l : list ι) (f : Π i ∈ l, α i), quotient.fin_choice_aux l (λ i h, ⟦f i h⟧) = ⟦f⟧ +| [] f := quotient.sound (λ i h, h.elim) +| (i :: l) f := begin + simp [quotient.fin_choice_aux, quotient.fin_choice_aux_eq l], + refine quotient.sound (λ j h, _), + by_cases e : j = i; simp [e], + subst j, refl +end + +/-- Given a collection of setoids indexed by a fintype `ι` and a +function that for each `i : ι` gives a term of the corresponding +quotient type, then there is corresponding term in the quotient of the +product of the setoids. -/ +def quotient.fin_choice {ι : Type*} [decidable_eq ι] [fintype ι] + {α : ι → Type*} [S : ∀ i, setoid (α i)] + (f : Π i, quotient (S i)) : @quotient (Π i, α i) (by apply_instance) := +quotient.lift_on (@quotient.rec_on _ _ (λ l : multiset ι, + @quotient (Π i ∈ l, α i) (by apply_instance)) + finset.univ.1 + (λ l, quotient.fin_choice_aux l (λ i _, f i)) + (λ a b h, begin + have := λ a, quotient.fin_choice_aux_eq a (λ i h, quotient.out (f i)), + simp [quotient.out_eq] at this, + simp [this], + let g := λ a:multiset ι, ⟦λ (i : ι) (h : i ∈ a), quotient.out (f i)⟧, + refine eq_of_heq ((eq_rec_heq _ _).trans (_ : g a == g b)), + congr' 1, exact quotient.sound h, + end)) + (λ f, ⟦λ i, f i (finset.mem_univ _)⟧) + (λ a b h, quotient.sound $ λ i, h _ _) + +theorem quotient.fin_choice_eq {ι : Type*} [decidable_eq ι] [fintype ι] + {α : ι → Type*} [∀ i, setoid (α i)] + (f : Π i, α i) : quotient.fin_choice (λ i, ⟦f i⟧) = ⟦f⟧ := +begin + let q, swap, change quotient.lift_on q _ _ = _, + have : q = ⟦λ i h, f i⟧, + { dsimp only [q], + exact quotient.induction_on + (@finset.univ ι _).1 (λ l, quotient.fin_choice_aux_eq _ _) }, + simp [this], exact setoid.refl _ +end diff --git a/src/data/fintype/sigma.lean b/src/data/fintype/sigma.lean new file mode 100644 index 0000000000000..7cea94a731f50 --- /dev/null +++ b/src/data/fintype/sigma.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.basic +import data.finset.sigma + + +/-! +# fintype instances for sigma types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open function +open_locale nat + +universes u v + +variables {α β γ : Type*} + +open finset function + +instance {α : Type*} (β : α → Type*) + [fintype α] [∀ a, fintype (β a)] : fintype (sigma β) := +⟨univ.sigma (λ _, univ), λ ⟨a, b⟩, by simp⟩ + +@[simp] lemma finset.univ_sigma_univ {α : Type*} {β : α → Type*} [fintype α] [∀ a, fintype (β a)] : + (univ : finset α).sigma (λ a, (univ : finset (β a))) = univ := rfl + +instance psigma.fintype {α : Type*} {β : α → Type*} [fintype α] [∀ a, fintype (β a)] : + fintype (Σ' a, β a) := +fintype.of_equiv _ (equiv.psigma_equiv_sigma _).symm diff --git a/src/data/fintype/small.lean b/src/data/fintype/small.lean index 3c08b81c13615..6c24ac71f1cbb 100644 --- a/src/data/fintype/small.lean +++ b/src/data/fintype/small.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ -import data.fintype.basic -import logic.small +import data.fintype.card +import logic.small.basic /-! # All finite types are small. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + That is, any `α` with `[fintype α]` is equivalent to a type in any universe. -/ diff --git a/src/data/fintype/sort.lean b/src/data/fintype/sort.lean index 551e297a1002d..5d72701738f36 100644 --- a/src/data/fintype/sort.lean +++ b/src/data/fintype/sort.lean @@ -9,6 +9,9 @@ import data.fintype.basic /-! # Sorting a finite type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides two equivalences for linearly ordered fintypes: * `mono_equiv_of_fin`: Order isomorphism between `α` and `fin (card α)`. * `fin_sum_equiv_of_finset`: Equivalence between `α` and `fin m ⊕ fin n` where `m` and `n` are diff --git a/src/data/fintype/sum.lean b/src/data/fintype/sum.lean new file mode 100644 index 0000000000000..fe14ab22471cc --- /dev/null +++ b/src/data/fintype/sum.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.card +import data.finset.sum +import logic.embedding.set + +/-! +## Instances + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We provide the `fintype` instance for the sum of two fintypes. +-/ + +universes u v + +variables {α β : Type*} + +open finset + +instance (α : Type u) (β : Type v) [fintype α] [fintype β] : fintype (α ⊕ β) := +{ elems := univ.disj_sum univ, + complete := by rintro (_ | _); simp } + +@[simp] lemma finset.univ_disj_sum_univ {α β : Type*} [fintype α] [fintype β] : + univ.disj_sum univ = (univ : finset (α ⊕ β)) := +rfl + +@[simp] theorem fintype.card_sum [fintype α] [fintype β] : + fintype.card (α ⊕ β) = fintype.card α + fintype.card β := +card_disj_sum _ _ + +/-- If the subtype of all-but-one elements is a `fintype` then the type itself is a `fintype`. -/ +def fintype_of_fintype_ne (a : α) (h : fintype {b // b ≠ a}) : fintype α := +fintype.of_bijective (sum.elim (coe : {b // b = a} → α) (coe : {b // b ≠ a} → α)) $ + by { classical, exact (equiv.sum_compl (= a)).bijective } + +lemma image_subtype_ne_univ_eq_image_erase [fintype α] [decidable_eq β] (k : β) (b : α → β) : + image (λ i : {a // b a ≠ k}, b ↑i) univ = (image b univ).erase k := +begin + apply subset_antisymm, + { rw image_subset_iff, + intros i _, + apply mem_erase_of_ne_of_mem i.2 (mem_image_of_mem _ (mem_univ _)) }, + { intros i hi, + rw mem_image, + rcases mem_image.1 (erase_subset _ _ hi) with ⟨a, _, ha⟩, + subst ha, + exact ⟨⟨a, ne_of_mem_erase hi⟩, mem_univ _, rfl⟩ } +end + +lemma image_subtype_univ_ssubset_image_univ [fintype α] [decidable_eq β] (k : β) (b : α → β) + (hk : k ∈ image b univ) (p : β → Prop) [decidable_pred p] (hp : ¬ p k) : + image (λ i : {a // p (b a)}, b ↑i) univ ⊂ image b univ := +begin + split, + { intros x hx, + rcases mem_image.1 hx with ⟨y, _, hy⟩, + exact hy ▸ mem_image_of_mem b (mem_univ y) }, + { intros h, + rw mem_image at hk, + rcases hk with ⟨k', _, hk'⟩, subst hk', + have := h (mem_image_of_mem b (mem_univ k')), + rw mem_image at this, + rcases this with ⟨j, hj, hj'⟩, + exact hp (hj' ▸ j.2) } +end + +/-- Any injection from a finset `s` in a fintype `α` to a finset `t` of the same cardinality as `α` +can be extended to a bijection between `α` and `t`. -/ +lemma finset.exists_equiv_extend_of_card_eq [fintype α] [decidable_eq β] {t : finset β} + (hαt : fintype.card α = t.card) {s : finset α} {f : α → β} (hfst : s.image f ⊆ t) + (hfs : set.inj_on f s) : + ∃ g : α ≃ t, ∀ i ∈ s, (g i : β) = f i := +begin + classical, + induction s using finset.induction with a s has H generalizing f, + { obtain ⟨e⟩ : nonempty (α ≃ ↥t) := by rwa [← fintype.card_eq, fintype.card_coe], + use e, + simp }, + have hfst' : finset.image f s ⊆ t := (finset.image_mono _ (s.subset_insert a)).trans hfst, + have hfs' : set.inj_on f s := hfs.mono (s.subset_insert a), + obtain ⟨g', hg'⟩ := H hfst' hfs', + have hfat : f a ∈ t := hfst (mem_image_of_mem _ (s.mem_insert_self a)), + use g'.trans (equiv.swap (⟨f a, hfat⟩ : t) (g' a)), + simp_rw mem_insert, + rintro i (rfl | hi), + { simp }, + rw [equiv.trans_apply, equiv.swap_apply_of_ne_of_ne, hg' _ hi], + { exact ne_of_apply_ne subtype.val (ne_of_eq_of_ne (hg' _ hi) $ + hfs.ne (subset_insert _ _ hi) (mem_insert_self _ _) $ ne_of_mem_of_not_mem hi has) }, + { exact g'.injective.ne (ne_of_mem_of_not_mem hi has) }, +end + +/-- Any injection from a set `s` in a fintype `α` to a finset `t` of the same cardinality as `α` +can be extended to a bijection between `α` and `t`. -/ +lemma set.maps_to.exists_equiv_extend_of_card_eq [fintype α] {t : finset β} + (hαt : fintype.card α = t.card) {s : set α} {f : α → β} (hfst : s.maps_to f t) + (hfs : set.inj_on f s) : + ∃ g : α ≃ t, ∀ i ∈ s, (g i : β) = f i := +begin + classical, + let s' : finset α := s.to_finset, + have hfst' : s'.image f ⊆ t := by simpa [← finset.coe_subset] using hfst, + have hfs' : set.inj_on f s' := by simpa using hfs, + obtain ⟨g, hg⟩ := finset.exists_equiv_extend_of_card_eq hαt hfst' hfs', + refine ⟨g, λ i hi, _⟩, + apply hg, + simpa using hi, +end + +lemma fintype.card_subtype_or (p q : α → Prop) + [fintype {x // p x}] [fintype {x // q x}] [fintype {x // p x ∨ q x}] : + fintype.card {x // p x ∨ q x} ≤ fintype.card {x // p x} + fintype.card {x // q x} := +begin + classical, + convert fintype.card_le_of_embedding (subtype_or_left_embedding p q), + rw fintype.card_sum +end + +lemma fintype.card_subtype_or_disjoint (p q : α → Prop) (h : disjoint p q) + [fintype {x // p x}] [fintype {x // q x}] [fintype {x // p x ∨ q x}] : + fintype.card {x // p x ∨ q x} = fintype.card {x // p x} + fintype.card {x // q x} := +begin + classical, + convert fintype.card_congr (subtype_or_equiv p q h), + simp +end + +section +open_locale classical + +@[simp] lemma infinite_sum : infinite (α ⊕ β) ↔ infinite α ∨ infinite β := +begin + refine ⟨λ H, _, λ H, H.elim (@sum.infinite_of_left α β) (@sum.infinite_of_right α β)⟩, + contrapose! H, haveI := fintype_of_not_infinite H.1, haveI := fintype_of_not_infinite H.2, + exact infinite.false +end + +end diff --git a/src/data/fintype/units.lean b/src/data/fintype/units.lean new file mode 100644 index 0000000000000..de94d0ad60d8c --- /dev/null +++ b/src/data/fintype/units.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.prod +import data.fintype.sum +import data.int.units + +/-! +# fintype instances relating to units + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +instance units_int.fintype : fintype ℤˣ := +⟨{1, -1}, λ x, by cases int.units_eq_one_or x; simp *⟩ + +@[simp] lemma units_int.univ : (finset.univ : finset ℤˣ) = {1, -1} := rfl + +@[simp] theorem fintype.card_units_int : fintype.card ℤˣ = 2 := rfl + +instance [monoid α] [fintype α] [decidable_eq α] : fintype αˣ := +fintype.of_equiv _ (units_equiv_prod_subtype α).symm + +instance [monoid α] [finite α] : finite αˣ := finite.of_injective _ units.ext + +lemma fintype.card_units [group_with_zero α] [fintype α] [fintype αˣ] : + fintype.card αˣ = fintype.card α - 1 := +begin + classical, + rw [eq_comm, nat.sub_eq_iff_eq_add (fintype.card_pos_iff.2 ⟨(0 : α)⟩), + fintype.card_congr (units_equiv_ne_zero α)], + have := fintype.card_congr (equiv.sum_compl (= (0 : α))).symm, + rwa [fintype.card_sum, add_comm, fintype.card_subtype_eq] at this, +end diff --git a/src/data/fintype/vector.lean b/src/data/fintype/vector.lean new file mode 100644 index 0000000000000..ab666e8105583 --- /dev/null +++ b/src/data/fintype/vector.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.fintype.pi +import data.sym.basic + +/-! +# `vector α n` and `sym α n` are fintypes when `α` is. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α : Type*} + +instance vector.fintype [fintype α] {n : ℕ} : fintype (vector α n) := +fintype.of_equiv _ (equiv.vector_equiv_fin _ _).symm + +instance [decidable_eq α] [fintype α] {n : ℕ} : fintype (sym.sym' α n) := +quotient.fintype _ + +instance [decidable_eq α] [fintype α] {n : ℕ} : fintype (sym α n) := +fintype.of_equiv _ sym.sym_equiv_sym'.symm diff --git a/src/data/fp/basic.lean b/src/data/fp/basic.lean index 4bbed9f2e17f8..3936873bc42a4 100644 --- a/src/data/fp/basic.lean +++ b/src/data/fp/basic.lean @@ -7,6 +7,9 @@ import data.semiquot import data.rat.floor /-! # Implementation of floating-point numbers (experimental). + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ def int.shift2 (a b : ℕ) : ℤ → ℕ × ℕ diff --git a/src/data/fun_like/basic.lean b/src/data/fun_like/basic.lean index 1a31579795082..dd8d40155d436 100644 --- a/src/data/fun_like/basic.lean +++ b/src/data/fun_like/basic.lean @@ -11,6 +11,9 @@ import tactic.norm_cast /-! # Typeclass for a type `F` with an injective map to `A → B` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This typeclass is primarily for use by homomorphisms like `monoid_hom` and `linear_map`. ## Basic usage of `fun_like` @@ -57,12 +60,16 @@ the axioms of your new type of morphisms. Continuing the example above: ``` +section +set_option old_structure_cmd true + /-- `my_hom_class F A B` states that `F` is a type of `my_class.op`-preserving morphisms. You should extend this class when you extend `my_hom`. -/ class my_hom_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B] extends fun_like F A (λ _, B) := (map_op : ∀ (f : F) (x y : A), f (my_class.op x y) = my_class.op (f x) (f y)) +end @[simp] lemma map_op {F A B : Type*} [my_class A] [my_class B] [my_hom_class F A B] (f : F) (x y : A) : f (my_class.op x y) = my_class.op (f x) (f y) := my_hom_class.map_op @@ -84,10 +91,15 @@ structure cooler_hom (A B : Type*) [cool_class A] [cool_class B] extends my_hom A B := (map_cool' : to_fun cool_class.cool = cool_class.cool) +section +set_option old_structure_cmd true + class cooler_hom_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B] extends my_hom_class F A B := (map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool) +end + @[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_hom_class F A B] (f : F) : f cool_class.cool = cool_class.cool := my_hom_class.map_op @@ -175,6 +187,10 @@ ext_iff.not.trans not_forall lemma exists_ne {f g : F} (h : f ≠ g) : ∃ x, f x ≠ g x := ne_iff.mp h +/-- This is not an instance to avoid slowing down every single `subsingleton` typeclass search.-/ +lemma subsingleton_cod [∀ a, subsingleton (β a)] : subsingleton F := +⟨λ f g, coe_injective $ subsingleton.elim _ _⟩ + end fun_like end dependent diff --git a/src/data/fun_like/embedding.lean b/src/data/fun_like/embedding.lean index ac3107e07fd46..fa5f28da6027a 100644 --- a/src/data/fun_like/embedding.lean +++ b/src/data/fun_like/embedding.lean @@ -9,6 +9,9 @@ import data.fun_like.basic /-! # Typeclass for a type `F` with an injective map to `A ↪ B` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This typeclass is primarily for use by embeddings such as `rel_embedding`. ## Basic usage of `embedding_like` @@ -59,12 +62,17 @@ the axioms of your new type of morphisms. Continuing the example above: ``` +section +set_option old_structure_cmd true + /-- `my_embedding_class F A B` states that `F` is a type of `my_class.op`-preserving embeddings. You should extend this class when you extend `my_embedding`. -/ class my_embedding_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B] extends embedding_like F A B := (map_op : ∀ (f : F) (x y : A), f (my_class.op x y) = my_class.op (f x) (f y)) +end + @[simp] lemma map_op {F A B : Type*} [my_class A] [my_class B] [my_embedding_class F A B] (f : F) (x y : A) : f (my_class.op x y) = my_class.op (f x) (f y) := my_embedding_class.map_op @@ -88,10 +96,15 @@ structure cooler_embedding (A B : Type*) [cool_class A] [cool_class B] extends my_embedding A B := (map_cool' : to_fun cool_class.cool = cool_class.cool) +section +set_option old_structure_cmd true + class cooler_embedding_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B] extends my_embedding_class F A B := (map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool) +end + @[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_embedding_class F A B] (f : F) : f cool_class.cool = cool_class.cool := my_embedding_class.map_op @@ -120,6 +133,8 @@ instead of linearly increasing the work per `my_embedding`-related declaration. -/ +set_option old_structure_cmd true + /-- The class `embedding_like F α β` expresses that terms of type `F` have an injective coercion to injective functions `α ↪ β`. -/ diff --git a/src/data/fun_like/equiv.lean b/src/data/fun_like/equiv.lean index 233753fd76c1f..d32322e2a0958 100644 --- a/src/data/fun_like/equiv.lean +++ b/src/data/fun_like/equiv.lean @@ -9,6 +9,9 @@ import data.fun_like.embedding /-! # Typeclass for a type `F` with an injective map to `A ≃ B` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This typeclass is primarily for use by isomorphisms like `monoid_equiv` and `linear_equiv`. ## Basic usage of `equiv_like` @@ -61,11 +64,16 @@ the axioms of your new type of isomorphisms. Continuing the example above: ``` +section +set_option old_structure_cmd true + /-- `my_iso_class F A B` states that `F` is a type of `my_class.op`-preserving morphisms. You should extend this class when you extend `my_iso`. -/ class my_iso_class (F : Type*) (A B : out_param $ Type*) [my_class A] [my_class B] extends equiv_like F A (λ _, B), my_hom_class F A B. +end + -- You can replace `my_iso.equiv_like` with the below instance: instance : my_iso_class (my_iso A B) A B := { coe := my_iso.to_fun, @@ -86,10 +94,15 @@ structure cooler_iso (A B : Type*) [cool_class A] [cool_class B] extends my_iso A B := (map_cool' : to_fun cool_class.cool = cool_class.cool) +section +set_option old_structure_cmd true + class cooler_iso_class (F : Type*) (A B : out_param $ Type*) [cool_class A] [cool_class B] extends my_iso_class F A B := (map_cool : ∀ (f : F), f cool_class.cool = cool_class.cool) +end + @[simp] lemma map_cool {F A B : Type*} [cool_class A] [cool_class B] [cooler_iso_class F A B] (f : F) : f cool_class.cool = cool_class.cool := my_iso_class.map_op @@ -141,7 +154,7 @@ lemma inv_injective : function.injective (equiv_like.inv : E → (β → α)) := @[priority 100] instance to_embedding_like : embedding_like E α β := -{ coe := coe, +{ coe := (coe : E → α → β), coe_injective' := λ e g h, coe_injective' e g h ((left_inv e).eq_right_inverse (h.symm ▸ right_inv g)), injective' := λ e, (left_inv e).injective } @@ -165,6 +178,22 @@ function.injective.of_comp_iff' f (equiv_like.bijective e) function.bijective (f ∘ e) ↔ function.bijective f := (equiv_like.bijective e).of_comp_iff f +/-- This lemma is only supposed to be used in the generic context, when working with instances +of classes extending `equiv_like`. +For concrete isomorphism types such as `equiv`, you should use `equiv.symm_apply_apply` +or its equivalent. + +TODO: define a generic form of `equiv.symm`. -/ +@[simp] lemma inv_apply_apply (e : E) (a : α) : equiv_like.inv e (e a) = a := left_inv _ _ + +/-- This lemma is only supposed to be used in the generic context, when working with instances +of classes extending `equiv_like`. +For concrete isomorphism types such as `equiv`, you should use `equiv.apply_symm_apply` +or its equivalent. + +TODO: define a generic form of `equiv.symm`. -/ +@[simp] lemma apply_inv_apply (e : E) (b : β) : e (equiv_like.inv e b) = b := right_inv _ _ + omit iE include iF @@ -180,4 +209,8 @@ function.surjective.of_comp_iff' (equiv_like.bijective e) f function.bijective (e ∘ f) ↔ function.bijective f := (equiv_like.bijective e).of_comp_iff' f +/-- This is not an instance to avoid slowing down every single `subsingleton` typeclass search.-/ +lemma subsingleton_dom [subsingleton β] : subsingleton F := +⟨λ f g, fun_like.ext f g $ λ x, (right_inv f).injective $ subsingleton.elim _ _⟩ + end equiv_like diff --git a/src/data/fun_like/fintype.lean b/src/data/fun_like/fintype.lean new file mode 100644 index 0000000000000..168b503062b7b --- /dev/null +++ b/src/data/fun_like/fintype.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2022 Anne Baanen. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anne Baanen +-/ + +import data.finite.basic +import data.fintype.basic +import data.fun_like.basic + +/-! +# Finiteness of `fun_like` types + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show a type `F` with a `fun_like F α β` is finite if both `α` and `β` are finite. +This corresponds to the following two pairs of declarations: + + * `fun_like.fintype` is a definition stating all `fun_like`s are finite if their domain and + codomain are. + * `fun_like.finite` is a lemma stating all `fun_like`s are finite if their domain and + codomain are. + * `fun_like.fintype'` is a non-dependent version of `fun_like.fintype` and + * `fun_like.finite` is a non-dependent version of `fun_like.finite`, because dependent instances + are harder to infer. + +You can use these to produce instances for specific `fun_like` types. +(Although there might be options for `fintype` instances with better definitional behaviour.) +They can't be instances themselves since they can cause loops. +-/ + +section type + +variables (F G : Type*) {α γ : Type*} {β : α → Type*} [fun_like F α β] [fun_like G α (λ _, γ)] + +/-- All `fun_like`s are finite if their domain and codomain are. + +This is not an instance because specific `fun_like` types might have a better-suited definition. + +See also `fun_like.finite`. +-/ +noncomputable def fun_like.fintype [decidable_eq α] [fintype α] [Π i, fintype (β i)] : fintype F := +fintype.of_injective _ fun_like.coe_injective + +/-- All `fun_like`s are finite if their domain and codomain are. + +Non-dependent version of `fun_like.fintype` that might be easier to infer. +This is not an instance because specific `fun_like` types might have a better-suited definition. +-/ +noncomputable def fun_like.fintype' [decidable_eq α] [fintype α] [fintype γ] : fintype G := +fun_like.fintype G + +end type + +section sort + +variables (F G : Sort*) {α γ : Sort*} {β : α → Sort*} [fun_like F α β] [fun_like G α (λ _, γ)] + +/-- All `fun_like`s are finite if their domain and codomain are. + +Can't be an instance because it can cause infinite loops. +-/ +lemma fun_like.finite [finite α] [∀ i, finite (β i)] : finite F := +finite.of_injective _ fun_like.coe_injective + +/-- All `fun_like`s are finite if their domain and codomain are. + +Non-dependent version of `fun_like.finite` that might be easier to infer. +Can't be an instance because it can cause infinite loops. +-/ +lemma fun_like.finite' [finite α] [finite γ] : finite G := +fun_like.finite G + +end sort diff --git a/src/data/hash_map.lean b/src/data/hash_map.lean index 60f9ec9b3f180..1c105b600c392 100644 --- a/src/data/hash_map.lean +++ b/src/data/hash_map.lean @@ -6,11 +6,15 @@ Authors: Leonardo de Moura, Mario Carneiro import data.array.lemmas import data.list.join import data.list.range -import data.pnat.basic +import data.list.nodup +import data.pnat.defs /-! # Hash maps +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Defines a hash map data structure, representing a finite key-value map with a value type that may depend on the key type. The structure requires a `nat`-valued hash function to associate keys to buckets. @@ -262,7 +266,7 @@ section { by_cases bidx = i, { subst i, rw [bkts', array.read_write, hfl], have := @valid.idx _ _ _ v bidx a, - simp only [hl, list.mem_append, or_imp_distrib, forall_and_distrib] at this ⊢, + simp only [hl, list.mem_append, or_imp_distrib] at this ⊢, exact ⟨⟨this.1.1, hal _⟩, this.2⟩ }, { rw [bkts', array.read_write_of_ne _ _ h], apply v.idx } }, { by_cases bidx = i, diff --git a/src/data/holor.lean b/src/data/holor.lean index 35699760c4404..18a484aba6560 100644 --- a/src/data/holor.lean +++ b/src/data/holor.lean @@ -9,6 +9,9 @@ import algebra.big_operators.basic /-! # Basic properties of holors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Holors are indexed collections of tensor coefficients. Confusingly, they are often called tensors in physics and in the neural network community. @@ -38,7 +41,7 @@ open_locale big_operators /-- `holor_index ds` is the type of valid index tuples used to identify an entry of a holor of dimensions `ds`. -/ -def holor_index (ds : list ℕ) : Type := { is : list ℕ // forall₂ (<) is ds} +def holor_index (ds : list ℕ) : Type := {is : list ℕ // forall₂ (<) is ds} namespace holor_index variables {ds₁ ds₂ ds₃ : list ℕ} @@ -80,7 +83,7 @@ lemma drop_drop : end holor_index /-- Holor (indexed collections of tensor coefficients) -/ -def holor (α : Type u) (ds:list ℕ) := holor_index ds → α +def holor (α : Type u) (ds : list ℕ) := holor_index ds → α namespace holor @@ -117,7 +120,7 @@ tactic.pi_instance_derive_field /- scalar product -/ -instance [has_mul α] : has_scalar α (holor α ds) := +instance [has_mul α] : has_smul α (holor α ds) := ⟨λ a x, λ t, a * x t⟩ instance [semiring α] : module α (holor α ds) := pi.module _ _ _ @@ -175,7 +178,7 @@ funext (λ t, mul_zero (x (holor_index.take t))) lemma mul_scalar_mul [monoid α] (x : holor α []) (y : holor α ds) : x ⊗ y = x ⟨[], forall₂.nil⟩ • y := -by simp [mul, has_scalar.smul, holor_index.take, holor_index.drop] +by simp [mul, has_smul.smul, holor_index.take, holor_index.drop] /- holor slices -/ @@ -308,7 +311,7 @@ exact finset.induction_on s (by simp [cprank_max.zero]) (begin assume x s (h_x_notin_s : x ∉ s) ih h_cprank, - simp only [finset.sum_insert h_x_notin_s,finset.card_insert_of_not_mem h_x_notin_s], + simp only [finset.sum_insert h_x_notin_s, finset.card_insert_of_not_mem h_x_notin_s], rw nat.right_distrib, simp only [nat.one_mul, nat.add_comm], have ih' : cprank_max (finset.card s * n) (∑ x in s, f x), diff --git a/src/data/int/absolute_value.lean b/src/data/int/absolute_value.lean index 5c3a369601a7d..754cf1b10bbb0 100644 --- a/src/data/int/absolute_value.lean +++ b/src/data/int/absolute_value.lean @@ -4,18 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Anne Baanen -/ import algebra.module.basic -import group_theory.group_action.units -import data.int.cast import algebra.order.absolute_value +import data.int.cast.lemmas +import data.int.units +import group_theory.group_action.units /-! # Absolute values and the integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains some results on absolute values applied to integers. ## Main results * `absolute_value.map_units_int`: an absolute value sends all units of `ℤ` to `1` + * `int.nat_abs_hom`: `int.nat_abs` bundled as a `monoid_with_zero_hom` -/ variables {R S : Type*} [ring R] [linear_ordered_comm_ring S] @@ -34,3 +39,11 @@ by rcases int.units_eq_one_or x with (rfl | rfl); simp lemma absolute_value.map_units_int_smul (abv : absolute_value R S) (x : ℤˣ) (y : R) : abv (x • y) = abv y := by rcases int.units_eq_one_or x with (rfl | rfl); simp + +/-- `int.nat_abs` as a bundled monoid with zero hom. -/ +@[simps] +def int.nat_abs_hom : ℤ →*₀ ℕ := +{ to_fun := int.nat_abs, + map_mul' := int.nat_abs_mul, + map_one' := int.nat_abs_one, + map_zero' := int.nat_abs_zero } diff --git a/src/data/int/associated.lean b/src/data/int/associated.lean new file mode 100644 index 0000000000000..1aae01eef87ac --- /dev/null +++ b/src/data/int/associated.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2022 Anne Baanen. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Anne Baanen +-/ + +import algebra.associated +import data.int.units + +/-! +# Associated elements and the integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains some results on equality up to units in the integers. + +## Main results + + * `int.nat_abs_eq_iff_associated`: the absolute value is equal iff integers are associated +-/ + +lemma int.nat_abs_eq_iff_associated {a b : ℤ} : + a.nat_abs = b.nat_abs ↔ associated a b := +begin + refine int.nat_abs_eq_nat_abs_iff.trans _, + split, + { rintro (rfl | rfl), + { refl }, + { exact ⟨-1, by simp⟩ } }, + { rintro ⟨u, rfl⟩, + obtain (rfl | rfl) := int.units_eq_one_or u, + { exact or.inl (by simp) }, + { exact or.inr (by simp) } } +end diff --git a/src/data/int/basic.lean b/src/data/int/basic.lean index b0889489c4f38..f83bb630be5bd 100644 --- a/src/data/int/basic.lean +++ b/src/data/int/basic.lean @@ -3,26 +3,19 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad -/ -import data.nat.pow -import order.min_max +import data.nat.basic +import order.monotone.basic /-! -# Basic operations on the integers +# Basic instances on the integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. This file contains: -* instances on `ℤ`. The stronger one is `int.linear_ordered_comm_ring`. -* some basic lemmas about integers - -## Recursors - -* `int.rec`: Sign disjunction. Something is true/defined on `ℤ` if it's true/defined for nonnegative - and for negative values. -* `int.bit_cases_on`: Parity disjunction. Something is true/defined on `ℤ` if it's true/defined for - even and for odd values. -* `int.induction_on`: Simple growing induction on positive numbers, plus simple decreasing induction - on negative numbers. Note that this recursor is currently only `Prop`-valued. -* `int.induction_on'`: Simple growing induction for numbers greater than `b`, plus simple decreasing - induction on numbers less than `b`. +* instances on `ℤ`. The stronger one is `int.comm_ring`. + See `data/int/defs/order` for `int.linear_ordered_comm_ring`. +* basic lemmas about the integers, but which do not use the ordered algebra hierarchy. -/ open nat @@ -34,7 +27,7 @@ instance : inhabited ℤ := ⟨int.zero⟩ instance : nontrivial ℤ := ⟨⟨0, 1, int.zero_ne_one⟩⟩ -instance : comm_ring int := +instance : comm_ring ℤ := { add := int.add, add_assoc := int.add_assoc, zero := int.zero, @@ -52,61 +45,65 @@ instance : comm_ring int := left_distrib := int.distrib_left, right_distrib := int.distrib_right, mul_comm := int.mul_comm, + nat_cast := int.of_nat, + nat_cast_zero := rfl, + nat_cast_succ := λ n, rfl, + int_cast := λ n, n, + int_cast_of_nat := λ n, rfl, + int_cast_neg_succ_of_nat := λ n, rfl, zsmul := (*), zsmul_zero' := int.zero_mul, - zsmul_succ' := λ n x, by rw [succ_eq_one_add, of_nat_add, int.distrib_right, of_nat_one, - int.one_mul], + zsmul_succ' := λ n x, by rw [nat.succ_eq_add_one, nat.add_comm, of_nat_add, int.distrib_right, + of_nat_one, int.one_mul], zsmul_neg' := λ n x, int.neg_mul_eq_neg_mul_symm (n.succ : ℤ) x } + /-! ### Extra instances to short-circuit type class resolution These also prevent non-computable instances like `int.normed_comm_ring` being used to construct these instances non-computably. -/ -- instance : has_sub int := by apply_instance -- This is in core -instance : add_comm_monoid int := by apply_instance -instance : add_monoid int := by apply_instance -instance : monoid int := by apply_instance -instance : comm_monoid int := by apply_instance -instance : comm_semigroup int := by apply_instance -instance : semigroup int := by apply_instance -instance : add_comm_group int := by apply_instance -instance : add_group int := by apply_instance -instance : add_comm_semigroup int := by apply_instance -instance : add_semigroup int := by apply_instance -instance : comm_semiring int := by apply_instance -instance : semiring int := by apply_instance -instance : ring int := by apply_instance -instance : distrib int := by apply_instance - -instance : linear_ordered_comm_ring int := -{ add_le_add_left := @int.add_le_add_left, - mul_pos := @int.mul_pos, - zero_le_one := le_of_lt int.zero_lt_one, - .. int.comm_ring, .. int.linear_order, .. int.nontrivial } - -instance : linear_ordered_add_comm_group int := -by apply_instance +instance : add_comm_monoid ℤ := by apply_instance +instance : add_monoid ℤ := by apply_instance +instance : monoid ℤ := by apply_instance +instance : comm_monoid ℤ := by apply_instance +instance : comm_semigroup ℤ := by apply_instance +instance : semigroup ℤ := by apply_instance +instance : add_comm_group ℤ := by apply_instance +instance : add_group ℤ := by apply_instance +instance : add_comm_semigroup ℤ := by apply_instance +instance : add_semigroup ℤ := by apply_instance +instance : comm_semiring ℤ := by apply_instance +instance : semiring ℤ := by apply_instance +instance : ring ℤ := by apply_instance +instance : distrib ℤ := by apply_instance + +end int -@[simp] lemma add_neg_one (i : ℤ) : i + -1 = i - 1 := rfl -theorem abs_eq_nat_abs : ∀ a : ℤ, |a| = nat_abs a -| (n : ℕ) := abs_of_nonneg $ coe_zero_le _ -| -[1+ n] := abs_of_nonpos $ le_of_lt $ neg_succ_lt_zero _ +namespace int -theorem nat_abs_abs (a : ℤ) : nat_abs (|a|) = nat_abs a := -by rw [abs_eq_nat_abs]; refl +@[simp] lemma add_neg_one (i : ℤ) : i + -1 = i - 1 := rfl -theorem sign_mul_abs (a : ℤ) : sign a * |a| = a := -by rw [abs_eq_nat_abs, sign_mul_nat_abs] +@[simp] theorem sign_coe_add_one (n : ℕ) : int.sign (n + 1) = 1 := rfl +@[simp] theorem sign_neg_succ_of_nat (n : ℕ) : int.sign -[1+ n] = -1 := rfl @[simp] lemma default_eq_zero : default = (0 : ℤ) := rfl meta instance : has_to_format ℤ := ⟨λ z, to_string z⟩ -meta instance : has_reflect ℤ := by tactic.mk_has_reflect_instance -attribute [simp] int.coe_nat_add int.coe_nat_mul int.coe_nat_zero int.coe_nat_one int.coe_nat_succ -attribute [simp] int.of_nat_eq_coe int.bodd +section +-- Note that here we are disabling the "safety" of reflected, to allow us to reuse `int.mk_numeral`. +-- The usual way to provide the required `reflected` instance would be via rewriting to prove that +-- the expression we use here is equivalent. +local attribute [semireducible] reflected +meta instance reflect : has_reflect ℤ := +int.mk_numeral `(ℤ) `(by apply_instance : has_zero ℤ) `(by apply_instance : has_one ℤ) + `(by apply_instance : has_add ℤ) `(by apply_instance : has_neg ℤ) +end + +attribute [simp] int.bodd @[simp] theorem add_def {a b : ℤ} : int.add a b = a + b := rfl @[simp] theorem mul_def {a b : ℤ} : int.mul a b = a * b := rfl @@ -122,42 +119,16 @@ by simp only [not_lt, iff_false] @[simp] theorem neg_succ_mul_coe_nat (m n : ℕ) : -[1+ m] * n = -(succ m * n) := rfl @[simp] theorem neg_succ_mul_neg_succ (m n : ℕ) : -[1+ m] * -[1+ n] = succ m * succ n := rfl -@[simp, norm_cast] theorem coe_nat_le {m n : ℕ} : (↑m : ℤ) ≤ ↑n ↔ m ≤ n := coe_nat_le_coe_nat_iff m n -@[simp, norm_cast] theorem coe_nat_lt {m n : ℕ} : (↑m : ℤ) < ↑n ↔ m < n := coe_nat_lt_coe_nat_iff m n -@[simp, norm_cast] theorem coe_nat_inj' {m n : ℕ} : (↑m : ℤ) = ↑n ↔ m = n := int.coe_nat_eq_coe_nat_iff m n lemma coe_nat_strict_mono : strict_mono (coe : ℕ → ℤ) := λ _ _, int.coe_nat_lt.2 -@[simp] theorem coe_nat_pos {n : ℕ} : (0 : ℤ) < n ↔ 0 < n := -by rw [← int.coe_nat_zero, coe_nat_lt] - -@[simp] theorem coe_nat_eq_zero {n : ℕ} : (n : ℤ) = 0 ↔ n = 0 := -by rw [← int.coe_nat_zero, coe_nat_inj'] +lemma coe_nat_nonneg (n : ℕ) : 0 ≤ (n : ℤ) := coe_nat_le.2 (nat.zero_le _) -theorem coe_nat_ne_zero {n : ℕ} : (n : ℤ) ≠ 0 ↔ n ≠ 0 := -not_congr coe_nat_eq_zero - -@[simp] lemma coe_nat_nonneg (n : ℕ) : 0 ≤ (n : ℤ) := coe_nat_le.2 (nat.zero_le _) - -lemma le_coe_nat_sub (m n : ℕ) : - (m - n : ℤ) ≤ ↑(m - n : ℕ) := -begin - by_cases h: m ≥ n, - { exact le_of_eq (int.coe_nat_sub h).symm }, - { simp [le_of_not_ge h] } -end - -lemma coe_nat_ne_zero_iff_pos {n : ℕ} : (n : ℤ) ≠ 0 ↔ 0 < n := -⟨λ h, nat.pos_of_ne_zero (coe_nat_ne_zero.1 h), -λ h, (ne_of_lt (coe_nat_lt.2 h)).symm⟩ - -lemma coe_nat_succ_pos (n : ℕ) : 0 < (n.succ : ℤ) := int.coe_nat_pos.2 (succ_pos n) - -@[simp, norm_cast] theorem coe_nat_abs (n : ℕ) : |(n : ℤ)| = n := -abs_of_nonneg (coe_nat_nonneg n) +@[simp] lemma neg_of_nat_ne_zero (n : ℕ) : -[1+ n] ≠ 0 := λ h, int.no_confusion h +@[simp] lemma zero_ne_neg_of_nat (n : ℕ) : 0 ≠ -[1+ n] := λ h, int.no_confusion h /-! ### succ and pred -/ @@ -179,7 +150,7 @@ theorem succ_neg_succ (a : ℤ) : succ (-succ a) = -a := by rw [neg_succ, succ_pred] theorem neg_pred (a : ℤ) : -pred a = succ (-a) := -by rw [eq_neg_of_eq_neg (neg_succ (-a)).symm, neg_neg] +by rw [neg_eq_iff_eq_neg.mp (neg_succ (-a)), neg_neg] theorem pred_neg_pred (a : ℤ) : pred (-pred a) = -a := by rw [neg_pred, pred_succ] @@ -190,42 +161,11 @@ theorem neg_nat_succ (n : ℕ) : -(nat.succ n : ℤ) = pred (-n) := neg_succ n theorem succ_neg_nat_succ (n : ℕ) : succ (-nat.succ n) = -n := succ_neg_succ n -theorem lt_succ_self (a : ℤ) : a < succ a := -lt_add_of_pos_right _ zero_lt_one - -theorem pred_self_lt (a : ℤ) : pred a < a := -sub_lt_self _ zero_lt_one - theorem add_one_le_iff {a b : ℤ} : a + 1 ≤ b ↔ a < b := iff.rfl -theorem lt_add_one_iff {a b : ℤ} : a < b + 1 ↔ a ≤ b := -add_le_add_iff_right _ - -@[simp] lemma succ_coe_nat_pos (n : ℕ) : 0 < (n : ℤ) + 1 := -lt_add_one_iff.mpr (by simp) - @[norm_cast] lemma coe_pred_of_pos {n : ℕ} (h : 0 < n) : ((n - 1 : ℕ) : ℤ) = (n : ℤ) - 1 := by { cases n, cases h, simp, } -lemma le_add_one {a b : ℤ} (h : a ≤ b) : a ≤ b + 1 := -le_of_lt (int.lt_add_one_iff.mpr h) - -theorem sub_one_lt_iff {a b : ℤ} : a - 1 < b ↔ a ≤ b := -sub_lt_iff_lt_add.trans lt_add_one_iff - -theorem le_sub_one_iff {a b : ℤ} : a ≤ b - 1 ↔ a < b := -le_sub_iff_add_le - -@[simp] lemma abs_lt_one_iff {a : ℤ} : |a| < 1 ↔ a = 0 := -⟨λ a0, let ⟨hn, hp⟩ := abs_lt.mp a0 in (le_of_lt_add_one (by exact hp)).antisymm hn, - λ a0, (abs_eq_zero.mpr a0).le.trans_lt zero_lt_one⟩ - -lemma abs_le_one_iff {a : ℤ} : |a| ≤ 1 ↔ a = 0 ∨ a = 1 ∨ a = -1 := -by rw [le_iff_lt_or_eq, abs_lt_one_iff, abs_eq (@zero_le_one ℤ _)] - -lemma one_le_abs {z : ℤ} (h₀: z ≠ 0) : 1 ≤ |z| := -add_one_le_iff.mpr (abs_pos.mpr h₀) - @[elab_as_eliminator] protected lemma induction_on {p : ℤ → Prop} (i : ℤ) (hz : p 0) (hp : ∀ i : ℕ, p i → p (i + 1)) (hn : ∀ i : ℕ, p (-i) → p (-i - 1)) : p i := begin @@ -240,59 +180,13 @@ begin exact this (i + 1) } end -/-- Inductively define a function on `ℤ` by defining it at `b`, for the `succ` of a number greater -than `b`, and the `pred` of a number less than `b`. -/ -protected def induction_on' {C : ℤ → Sort*} (z : ℤ) (b : ℤ) - (H0 : C b) (Hs : ∀ k, b ≤ k → C k → C (k + 1)) (Hp : ∀ k ≤ b, C k → C (k - 1)) : C z := -begin - -- Note that we use `convert` here where possible as we are constructing data, and this reduces - -- the number of times `eq.mpr` appears in the term. - rw ←sub_add_cancel z b, - induction (z - b) with n n, - { induction n with n ih, - { convert H0 using 1, - rw [of_nat_zero, zero_add] }, - convert Hs _ (le_add_of_nonneg_left (of_nat_nonneg _)) ih using 1, - rw [of_nat_succ, add_assoc, add_comm 1 b, ←add_assoc] }, - { induction n with n ih, - { convert Hp _ le_rfl H0 using 1, - rw [neg_succ_of_nat_eq, ←of_nat_eq_coe, of_nat_zero, zero_add, neg_add_eq_sub] }, - { convert Hp _ (le_of_lt (add_lt_of_neg_of_le (neg_succ_lt_zero _) le_rfl)) ih using 1, - rw [neg_succ_of_nat_coe', nat.succ_eq_add_one, ←neg_succ_of_nat_coe, sub_add_eq_add_sub] } } -end - -/-- See `int.induction_on'` for an induction in both directions. -/ -protected lemma le_induction {P : ℤ → Prop} {m : ℤ} (h0 : P m) - (h1 : ∀ (n : ℤ), m ≤ n → P n → P (n + 1)) (n : ℤ) : - m ≤ n → P n := -begin - apply int.induction_on' n m, - { intro _, exact h0, }, - { intros k hle hi _, exact h1 k hle (hi hle), }, - { intros _ hle _ hle', - exfalso, - exact lt_irrefl k (le_sub_one_iff.mp (hle.trans hle')), }, -end - -/-- See `int.induction_on'` for an induction in both directions. -/ -protected lemma le_induction_down {P : ℤ → Prop} {m : ℤ} (h0 : P m) - (h1 : ∀ (n : ℤ), n ≤ m → P n → P (n - 1)) (n : ℤ) : - n ≤ m → P n := -begin - apply int.induction_on' n m, - { intro _, exact h0, }, - { intros _ hle _ hle', - exfalso, - exact lt_irrefl k (add_one_le_iff.mp (hle'.trans hle)), }, - { intros k hle hi _, - exact h1 k hle (hi hle), }, -end - /-! ### nat abs -/ variables {a b : ℤ} {n : ℕ} -attribute [simp] nat_abs nat_abs_of_nat nat_abs_zero nat_abs_one +attribute [simp] nat_abs_of_nat nat_abs_zero nat_abs_one + +lemma nat_abs_surjective : nat_abs.surjective := λ n, ⟨n, nat_abs_of_nat n⟩ theorem nat_abs_add_le (a b : ℤ) : nat_abs (a + b) ≤ nat_abs a + nat_abs b := begin @@ -323,7 +217,7 @@ lemma nat_abs_mul_nat_abs_eq {a b : ℤ} {c : ℕ} (h : a * b = (c : ℤ)) : a.nat_abs * b.nat_abs = c := by rw [← nat_abs_mul, h, nat_abs_of_nat] -@[simp] lemma nat_abs_mul_self' (a : ℤ) : (nat_abs a * nat_abs a : ℤ) = a * a := +lemma nat_abs_mul_self' (a : ℤ) : (nat_abs a * nat_abs a : ℤ) = a * a := by rw [← int.coe_nat_mul, nat_abs_mul_self] theorem neg_succ_of_nat_eq' (m : ℕ) : -[1+ m] = -m - 1 := @@ -342,7 +236,7 @@ lemma nat_abs_lt_nat_abs_of_nonneg_of_lt {a b : ℤ} (w₁ : 0 ≤ a) (w₂ : a begin lift b to ℕ using le_trans w₁ (le_of_lt w₂), lift a to ℕ using w₁, - simpa using w₂, + simpa [coe_nat_lt] using w₂, end lemma nat_abs_eq_nat_abs_iff {a b : ℤ} : a.nat_abs = b.nat_abs ↔ a = b ∨ a = -b := @@ -356,80 +250,6 @@ end lemma nat_abs_eq_iff {a : ℤ} {n : ℕ} : a.nat_abs = n ↔ a = n ∨ a = -n := by rw [←int.nat_abs_eq_nat_abs_iff, int.nat_abs_of_nat] -lemma nat_abs_eq_iff_mul_self_eq {a b : ℤ} : a.nat_abs = b.nat_abs ↔ a * a = b * b := -begin - rw [← abs_eq_iff_mul_self_eq, abs_eq_nat_abs, abs_eq_nat_abs], - exact int.coe_nat_inj'.symm -end - -lemma eq_nat_abs_iff_mul_eq_zero : a.nat_abs = n ↔ (a - n) * (a + n) = 0 := -by rw [nat_abs_eq_iff, mul_eq_zero, sub_eq_zero, add_eq_zero_iff_eq_neg] - -lemma nat_abs_lt_iff_mul_self_lt {a b : ℤ} : a.nat_abs < b.nat_abs ↔ a * a < b * b := -begin - rw [← abs_lt_iff_mul_self_lt, abs_eq_nat_abs, abs_eq_nat_abs], - exact int.coe_nat_lt.symm -end - -lemma nat_abs_le_iff_mul_self_le {a b : ℤ} : a.nat_abs ≤ b.nat_abs ↔ a * a ≤ b * b := -begin - rw [← abs_le_iff_mul_self_le, abs_eq_nat_abs, abs_eq_nat_abs], - exact int.coe_nat_le.symm -end - -lemma nat_abs_eq_iff_sq_eq {a b : ℤ} : a.nat_abs = b.nat_abs ↔ a ^ 2 = b ^ 2 := -by { rw [sq, sq], exact nat_abs_eq_iff_mul_self_eq } - -lemma nat_abs_lt_iff_sq_lt {a b : ℤ} : a.nat_abs < b.nat_abs ↔ a ^ 2 < b ^ 2 := -by { rw [sq, sq], exact nat_abs_lt_iff_mul_self_lt } - -lemma nat_abs_le_iff_sq_le {a b : ℤ} : a.nat_abs ≤ b.nat_abs ↔ a ^ 2 ≤ b ^ 2 := -by { rw [sq, sq], exact nat_abs_le_iff_mul_self_le } - -@[simp] lemma nat_abs_dvd_iff_dvd {a b : ℤ} : a.nat_abs ∣ b.nat_abs ↔ a ∣ b := -begin - refine ⟨_, λ ⟨k, hk⟩, ⟨k.nat_abs, hk.symm ▸ nat_abs_mul a k⟩⟩, - rintro ⟨k, hk⟩, - rw [←nat_abs_of_nat k, ←nat_abs_mul, nat_abs_eq_nat_abs_iff, neg_mul_eq_mul_neg] at hk, - cases hk; exact ⟨_, hk⟩ -end - -lemma nat_abs_inj_of_nonneg_of_nonneg {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) : - nat_abs a = nat_abs b ↔ a = b := -by rw [←sq_eq_sq ha hb, ←nat_abs_eq_iff_sq_eq] - -lemma nat_abs_inj_of_nonpos_of_nonpos {a b : ℤ} (ha : a ≤ 0) (hb : b ≤ 0) : - nat_abs a = nat_abs b ↔ a = b := -by simpa only [int.nat_abs_neg, neg_inj] - using nat_abs_inj_of_nonneg_of_nonneg - (neg_nonneg_of_nonpos ha) (neg_nonneg_of_nonpos hb) - -lemma nat_abs_inj_of_nonneg_of_nonpos {a b : ℤ} (ha : 0 ≤ a) (hb : b ≤ 0) : - nat_abs a = nat_abs b ↔ a = -b := -by simpa only [int.nat_abs_neg] - using nat_abs_inj_of_nonneg_of_nonneg ha (neg_nonneg_of_nonpos hb) - -lemma nat_abs_inj_of_nonpos_of_nonneg {a b : ℤ} (ha : a ≤ 0) (hb : 0 ≤ b) : - nat_abs a = nat_abs b ↔ -a = b := -by simpa only [int.nat_abs_neg] - using nat_abs_inj_of_nonneg_of_nonneg (neg_nonneg_of_nonpos ha) hb - -section intervals -open set - -lemma strict_mono_on_nat_abs : strict_mono_on nat_abs (Ici 0) := -λ a ha b hb hab, nat_abs_lt_nat_abs_of_nonneg_of_lt ha hab - -lemma strict_anti_on_nat_abs : strict_anti_on nat_abs (Iic 0) := -λ a ha b hb hab, by simpa [int.nat_abs_neg] - using nat_abs_lt_nat_abs_of_nonneg_of_lt (right.nonneg_neg_iff.mpr hb) (neg_lt_neg_iff.mpr hab) - -lemma inj_on_nat_abs_Ici : inj_on nat_abs (Ici 0) := strict_mono_on_nat_abs.inj_on - -lemma inj_on_nat_abs_Iic : inj_on nat_abs (Iic 0) := strict_anti_on_nat_abs.inj_on - -end intervals - /-! ### `/` -/ @[simp] theorem of_nat_div (m n : ℕ) : of_nat (m / n) = (of_nat m) / (of_nat n) := rfl @@ -471,9 +291,6 @@ match a, b, eq_coe_of_zero_le Ha, eq_coe_of_zero_le Hb with | ._, ._, ⟨m, rfl⟩, ⟨n, rfl⟩ := coe_zero_le _ end -protected theorem div_nonpos {a b : ℤ} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 := -nonpos_of_neg_nonneg $ by rw [← int.div_neg]; exact int.div_nonneg Ha (neg_nonneg_of_nonpos Hb) - theorem div_neg' {a b : ℤ} (Ha : a < 0) (Hb : 0 < b) : a / b < 0 := match a, b, eq_neg_succ_of_lt_zero Ha, eq_succ_of_zero_lt Hb with | ._, ._, ⟨m, rfl⟩, ⟨n, rfl⟩ := neg_succ_lt_zero _ @@ -489,78 +306,6 @@ match a, b, eq_coe_of_zero_le H1, eq_succ_of_zero_lt (lt_of_le_of_lt H1 H2), H2 congr_arg of_nat $ nat.div_eq_of_lt $ lt_of_coe_nat_lt_coe_nat H2 end -theorem div_eq_zero_of_lt_abs {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < |b|) : a / b = 0 := -match b, |b|, abs_eq_nat_abs b, H2 with -| (n : ℕ), ._, rfl, H2 := div_eq_zero_of_lt H1 H2 -| -[1+ n], ._, rfl, H2 := neg_injective $ by rw [← int.div_neg]; exact div_eq_zero_of_lt H1 H2 -end - -protected theorem add_mul_div_right (a b : ℤ) {c : ℤ} (H : c ≠ 0) : - (a + b * c) / c = a / c + b := -have ∀ {k n : ℕ} {a : ℤ}, (a + n * k.succ) / k.succ = a / k.succ + n, from -λ k n a, match a with -| (m : ℕ) := congr_arg of_nat $ nat.add_mul_div_right _ _ k.succ_pos -| -[1+ m] := show ((n * k.succ:ℕ) - m.succ : ℤ) / k.succ = - n - (m / k.succ + 1 : ℕ), begin - cases lt_or_ge m (n*k.succ) with h h, - { rw [← int.coe_nat_sub h, - ← int.coe_nat_sub ((nat.div_lt_iff_lt_mul _ _ k.succ_pos).2 h)], - apply congr_arg of_nat, - rw [mul_comm, nat.mul_sub_div], rwa mul_comm }, - { change (↑(n * nat.succ k) - (m + 1) : ℤ) / ↑(nat.succ k) = - ↑n - ((m / nat.succ k : ℕ) + 1), - rw [← sub_sub, ← sub_sub, ← neg_sub (m:ℤ), ← neg_sub _ (n:ℤ), - ← int.coe_nat_sub h, - ← int.coe_nat_sub ((nat.le_div_iff_mul_le _ _ k.succ_pos).2 h), - ← neg_succ_of_nat_coe', ← neg_succ_of_nat_coe'], - { apply congr_arg neg_succ_of_nat, - rw [mul_comm, nat.sub_mul_div], rwa mul_comm } } - end -end, -have ∀ {a b c : ℤ}, 0 < c → (a + b * c) / c = a / c + b, from -λ a b c H, match c, eq_succ_of_zero_lt H, b with -| ._, ⟨k, rfl⟩, (n : ℕ) := this -| ._, ⟨k, rfl⟩, -[1+ n] := - show (a - n.succ * k.succ) / k.succ = (a / k.succ) - n.succ, from - eq_sub_of_add_eq $ by rw [← this, sub_add_cancel] -end, -match lt_trichotomy c 0 with -| or.inl hlt := neg_inj.1 $ by rw [← int.div_neg, neg_add, ← int.div_neg, ← neg_mul_neg]; - apply this (neg_pos_of_neg hlt) -| or.inr (or.inl heq) := absurd heq H -| or.inr (or.inr hgt) := this hgt -end - -protected theorem add_mul_div_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b ≠ 0) : - (a + b * c) / b = a / b + c := -by rw [mul_comm, int.add_mul_div_right _ _ H] - -protected theorem add_div_of_dvd_right {a b c : ℤ} (H : c ∣ b) : - (a + b) / c = a / c + b / c := -begin - by_cases h1 : c = 0, - { simp [h1] }, - cases H with k hk, - rw hk, - change c ≠ 0 at h1, - rw [mul_comm c k, int.add_mul_div_right _ _ h1, ←zero_add (k * c), int.add_mul_div_right _ _ h1, - int.zero_div, zero_add] -end - -protected theorem add_div_of_dvd_left {a b c : ℤ} (H : c ∣ a) : - (a + b) / c = a / c + b / c := -by rw [add_comm, int.add_div_of_dvd_right H, add_comm] - -@[simp] protected theorem mul_div_cancel (a : ℤ) {b : ℤ} (H : b ≠ 0) : a * b / b = a := -by have := int.add_mul_div_right 0 a H; - rwa [zero_add, int.zero_div, zero_add] at this - -@[simp] protected theorem mul_div_cancel_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : a * b / a = b := -by rw [mul_comm, int.mul_div_cancel _ H] - -@[simp] protected theorem div_self {a : ℤ} (H : a ≠ 0) : a / a = 1 := -by have := int.mul_div_cancel 1 H; rwa one_mul at this - /-! ### mod -/ theorem of_nat_mod (m n : nat) : (m % n : ℤ) = of_nat (m % n) := rfl @@ -576,9 +321,6 @@ match b, eq_succ_of_zero_lt bpos with ._, ⟨n, rfl⟩ := rfl end | (m : ℕ) n := @congr_arg ℕ ℤ _ _ (λ i, ↑(m % i)) (nat_abs_neg _) | -[1+ m] n := @congr_arg ℕ ℤ _ _ (λ i, sub_nat_nat i (nat.succ (m % i))) (nat_abs_neg _) -@[simp] theorem mod_abs (a b : ℤ) : a % (|b|) = a % b := -abs_by_cases (λ i, a % i = a % b) rfl (mod_neg _ _) - local attribute [simp] -- Will be generalized to Euclidean domains. theorem zero_mod (b : ℤ) : 0 % b = 0 := rfl @@ -598,25 +340,10 @@ match a, b, eq_coe_of_zero_le H1, eq_coe_of_zero_le (le_trans H1 (le_of_lt H2)), congr_arg of_nat $ nat.mod_eq_of_lt (lt_of_coe_nat_lt_coe_nat H2) end -theorem mod_nonneg : ∀ (a : ℤ) {b : ℤ}, b ≠ 0 → 0 ≤ a % b -| (m : ℕ) n H := coe_zero_le _ -| -[1+ m] n H := - sub_nonneg_of_le $ coe_nat_le_coe_nat_of_le $ nat.mod_lt _ (nat_abs_pos_of_ne_zero H) - -theorem mod_lt_of_pos (a : ℤ) {b : ℤ} (H : 0 < b) : a % b < b := -match a, b, eq_succ_of_zero_lt H with -| (m : ℕ), ._, ⟨n, rfl⟩ := coe_nat_lt_coe_nat_of_lt (nat.mod_lt _ (nat.succ_pos _)) -| -[1+ m], ._, ⟨n, rfl⟩ := sub_lt_self _ (coe_nat_lt_coe_nat_of_lt $ nat.succ_pos _) -end - -theorem mod_lt (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b < |b| := -by rw [← mod_abs]; exact mod_lt_of_pos _ (abs_pos.2 H) - theorem mod_add_div_aux (m n : ℕ) : (n - (m % n + 1) - (n * (m / n) + n) : ℤ) = -[1+ m] := begin - rw [← sub_sub, neg_succ_of_nat_coe, sub_sub (n:ℤ)], - apply eq_neg_of_eq_neg, - rw [neg_sub, sub_sub_self, add_right_comm], + rw [← sub_sub, neg_succ_of_nat_coe, sub_sub (n:ℤ), eq_comm, neg_eq_iff_eq_neg, + neg_sub, sub_sub_self, add_right_comm], exact @congr_arg ℕ ℤ _ _ (λi, (i + 1 : ℤ)) (nat.mod_add_div _ _).symm end @@ -640,95 +367,6 @@ by { rw mul_comm, exact div_add_mod _ _ } theorem mod_def (a b : ℤ) : a % b = a - b * (a / b) := eq_sub_of_add_eq (mod_add_div _ _) -@[simp] theorem add_mul_mod_self {a b c : ℤ} : (a + b * c) % c = a % c := -if cz : c = 0 then by rw [cz, mul_zero, add_zero] else -by rw [mod_def, mod_def, int.add_mul_div_right _ _ cz, - mul_add, mul_comm, add_sub_add_right_eq_sub] - -@[simp] theorem add_mul_mod_self_left (a b c : ℤ) : (a + b * c) % b = a % b := -by rw [mul_comm, add_mul_mod_self] - -@[simp] theorem add_mod_self {a b : ℤ} : (a + b) % b = a % b := -by have := add_mul_mod_self_left a b 1; rwa mul_one at this - -@[simp] theorem add_mod_self_left {a b : ℤ} : (a + b) % a = b % a := -by rw [add_comm, add_mod_self] - -@[simp] theorem mod_add_mod (m n k : ℤ) : (m % n + k) % n = (m + k) % n := -by have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm; - rwa [add_right_comm, mod_add_div] at this - -@[simp] theorem add_mod_mod (m n k : ℤ) : (m + n % k) % k = (m + n) % k := -by rw [add_comm, mod_add_mod, add_comm] - -lemma add_mod (a b n : ℤ) : (a + b) % n = ((a % n) + (b % n)) % n := -by rw [add_mod_mod, mod_add_mod] - -theorem add_mod_eq_add_mod_right {m n k : ℤ} (i : ℤ) (H : m % n = k % n) : - (m + i) % n = (k + i) % n := -by rw [← mod_add_mod, ← mod_add_mod k, H] - -theorem add_mod_eq_add_mod_left {m n k : ℤ} (i : ℤ) (H : m % n = k % n) : - (i + m) % n = (i + k) % n := -by rw [add_comm, add_mod_eq_add_mod_right _ H, add_comm] - -theorem mod_add_cancel_right {m n k : ℤ} (i) : (m + i) % n = (k + i) % n ↔ - m % n = k % n := -⟨λ H, by have := add_mod_eq_add_mod_right (-i) H; - rwa [add_neg_cancel_right, add_neg_cancel_right] at this, - add_mod_eq_add_mod_right _⟩ - -theorem mod_add_cancel_left {m n k i : ℤ} : - (i + m) % n = (i + k) % n ↔ m % n = k % n := -by rw [add_comm, add_comm i, mod_add_cancel_right] - -theorem mod_sub_cancel_right {m n k : ℤ} (i) : (m - i) % n = (k - i) % n ↔ - m % n = k % n := -mod_add_cancel_right _ - -theorem mod_eq_mod_iff_mod_sub_eq_zero {m n k : ℤ} : m % n = k % n ↔ (m - k) % n = 0 := -(mod_sub_cancel_right k).symm.trans $ by simp - -@[simp] theorem mul_mod_left (a b : ℤ) : (a * b) % b = 0 := -by rw [← zero_add (a * b), add_mul_mod_self, zero_mod] - -@[simp] theorem mul_mod_right (a b : ℤ) : (a * b) % a = 0 := -by rw [mul_comm, mul_mod_left] - -lemma mul_mod (a b n : ℤ) : (a * b) % n = ((a % n) * (b % n)) % n := -begin - conv_lhs - { rw [←mod_add_div a n, ←mod_add_div' b n, right_distrib, left_distrib, left_distrib, - mul_assoc, mul_assoc, ←left_distrib n _ _, add_mul_mod_self_left, ← mul_assoc, - add_mul_mod_self] } -end - -@[simp] lemma neg_mod_two (i : ℤ) : (-i) % 2 = i % 2 := -begin - apply int.mod_eq_mod_iff_mod_sub_eq_zero.mpr, - convert int.mul_mod_right 2 (-i), - simp only [two_mul, sub_eq_add_neg] -end - -local attribute [simp] -- Will be generalized to Euclidean domains. -theorem mod_self {a : ℤ} : a % a = 0 := -by have := mul_mod_left 1 a; rwa one_mul at this - -@[simp] theorem mod_mod_of_dvd (n : ℤ) {m k : ℤ} (h : m ∣ k) : n % k % m = n % m := -begin - conv { to_rhs, rw ←mod_add_div n k }, - rcases h with ⟨t, rfl⟩, rw [mul_assoc, add_mul_mod_self_left] -end - -@[simp] theorem mod_mod (a b : ℤ) : a % b % b = a % b := -by conv {to_rhs, rw [← mod_add_div a b, add_mul_mod_self_left]} - -lemma sub_mod (a b n : ℤ) : (a - b) % n = ((a % n) - (b % n)) % n := -begin - apply (mod_add_cancel_right b).mp, - rw [sub_add_cancel, ← add_mod_mod, sub_add_cancel, mod_mod] -end - /-! ### properties of `/` and `%` -/ @[simp] theorem mul_div_mul_of_pos {a : ℤ} (b c : ℤ) (H : 0 < a) : a * b / (a * c) = b / c := @@ -751,7 +389,7 @@ end, { change m.succ * n.succ ≤ _, rw [mul_left_comm], apply nat.mul_le_mul_left, - apply (nat.div_lt_iff_lt_mul _ _ k.succ_pos).1, + apply (nat.div_lt_iff_lt_mul k.succ_pos).1, apply nat.lt_succ_self } end end @@ -763,156 +401,12 @@ by rw [mul_comm, mul_comm c, mul_div_mul_of_pos _ _ H] @[simp] theorem mul_mod_mul_of_pos {a : ℤ} (H : 0 < a) (b c : ℤ) : a * b % (a * c) = a * (b % c) := by rw [mod_def, mod_def, mul_div_mul_of_pos _ _ H, mul_sub_left_distrib, mul_assoc] -theorem lt_div_add_one_mul_self (a : ℤ) {b : ℤ} (H : 0 < b) : a < (a / b + 1) * b := -by { rw [add_mul, one_mul, mul_comm, ← sub_lt_iff_lt_add', ← mod_def], - exact mod_lt_of_pos _ H } - -theorem abs_div_le_abs : ∀ (a b : ℤ), |a / b| ≤ |a| := -suffices ∀ (a : ℤ) (n : ℕ), |a / n| ≤ |a|, from -λ a b, match b, eq_coe_or_neg b with -| ._, ⟨n, or.inl rfl⟩ := this _ _ -| ._, ⟨n, or.inr rfl⟩ := by rw [int.div_neg, abs_neg]; apply this -end, -λ a n, by rw [abs_eq_nat_abs, abs_eq_nat_abs]; exact -coe_nat_le_coe_nat_of_le (match a, n with -| (m : ℕ), n := nat.div_le_self _ _ -| -[1+ m], 0 := nat.zero_le _ -| -[1+ m], n+1 := nat.succ_le_succ (nat.div_le_self _ _) -end) - -theorem div_le_self {a : ℤ} (b : ℤ) (Ha : 0 ≤ a) : a / b ≤ a := -by have := le_trans (le_abs_self _) (abs_div_le_abs a b); - rwa [abs_of_nonneg Ha] at this - theorem mul_div_cancel_of_mod_eq_zero {a b : ℤ} (H : a % b = 0) : b * (a / b) = a := by have := mod_add_div a b; rwa [H, zero_add] at this theorem div_mul_cancel_of_mod_eq_zero {a b : ℤ} (H : a % b = 0) : a / b * b = a := by rw [mul_comm, mul_div_cancel_of_mod_eq_zero H] -lemma mod_two_eq_zero_or_one (n : ℤ) : n % 2 = 0 ∨ n % 2 = 1 := -have h : n % 2 < 2 := abs_of_nonneg (show 0 ≤ (2 : ℤ), from dec_trivial) ▸ int.mod_lt _ dec_trivial, -have h₁ : 0 ≤ n % 2 := int.mod_nonneg _ dec_trivial, -match (n % 2), h, h₁ with -| (0 : ℕ) := λ _ _, or.inl rfl -| (1 : ℕ) := λ _ _, or.inr rfl -| (k + 2 : ℕ) := λ h _, absurd h dec_trivial -| -[1+ a] := λ _ h₁, absurd h₁ dec_trivial -end - -/-! ### dvd -/ - -@[norm_cast] theorem coe_nat_dvd {m n : ℕ} : (↑m : ℤ) ∣ ↑n ↔ m ∣ n := -⟨λ ⟨a, ae⟩, m.eq_zero_or_pos.elim - (λm0, by simp [m0] at ae; simp [ae, m0]) - (λm0l, by - { cases eq_coe_of_zero_le (@nonneg_of_mul_nonneg_left ℤ _ m a - (by simp [ae.symm]) (by simpa using m0l)) with k e, - subst a, exact ⟨k, int.coe_nat_inj ae⟩ }), - λ ⟨k, e⟩, dvd.intro k $ by rw [e, int.coe_nat_mul]⟩ - -theorem coe_nat_dvd_left {n : ℕ} {z : ℤ} : (↑n : ℤ) ∣ z ↔ n ∣ z.nat_abs := -by rcases nat_abs_eq z with eq | eq; rw eq; simp [coe_nat_dvd] - -theorem coe_nat_dvd_right {n : ℕ} {z : ℤ} : z ∣ (↑n : ℤ) ↔ z.nat_abs ∣ n := -by rcases nat_abs_eq z with eq | eq; rw eq; simp [coe_nat_dvd] - -theorem dvd_antisymm {a b : ℤ} (H1 : 0 ≤ a) (H2 : 0 ≤ b) : a ∣ b → b ∣ a → a = b := -begin - rw [← abs_of_nonneg H1, ← abs_of_nonneg H2, abs_eq_nat_abs, abs_eq_nat_abs], - rw [coe_nat_dvd, coe_nat_dvd, coe_nat_inj'], - apply nat.dvd_antisymm -end - -theorem dvd_of_mod_eq_zero {a b : ℤ} (H : b % a = 0) : a ∣ b := -⟨b / a, (mul_div_cancel_of_mod_eq_zero H).symm⟩ - -theorem mod_eq_zero_of_dvd : ∀ {a b : ℤ}, a ∣ b → b % a = 0 -| a ._ ⟨c, rfl⟩ := mul_mod_right _ _ - -theorem dvd_iff_mod_eq_zero (a b : ℤ) : a ∣ b ↔ b % a = 0 := -⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ - -/-- If `a % b = c` then `b` divides `a - c`. -/ -lemma dvd_sub_of_mod_eq {a b c : ℤ} (h : a % b = c) : b ∣ a - c := -begin - have hx : a % b % b = c % b, { rw h }, - rw [mod_mod, ←mod_sub_cancel_right c, sub_self, zero_mod] at hx, - exact dvd_of_mod_eq_zero hx -end - -theorem nat_abs_dvd {a b : ℤ} : (a.nat_abs : ℤ) ∣ b ↔ a ∣ b := -(nat_abs_eq a).elim (λ e, by rw ← e) (λ e, by rw [← neg_dvd, ← e]) - -theorem dvd_nat_abs {a b : ℤ} : a ∣ b.nat_abs ↔ a ∣ b := -(nat_abs_eq b).elim (λ e, by rw ← e) (λ e, by rw [← dvd_neg, ← e]) - -instance decidable_dvd : @decidable_rel ℤ (∣) := -assume a n, decidable_of_decidable_of_iff (by apply_instance) (dvd_iff_mod_eq_zero _ _).symm - -protected theorem div_mul_cancel {a b : ℤ} (H : b ∣ a) : a / b * b = a := -div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H) - -protected theorem mul_div_cancel' {a b : ℤ} (H : a ∣ b) : a * (b / a) = b := -by rw [mul_comm, int.div_mul_cancel H] - -protected theorem mul_div_assoc (a : ℤ) : ∀ {b c : ℤ}, c ∣ b → (a * b) / c = a * (b / c) -| ._ c ⟨d, rfl⟩ := if cz : c = 0 then by simp [cz] else - by rw [mul_left_comm, int.mul_div_cancel_left _ cz, int.mul_div_cancel_left _ cz] - -protected theorem mul_div_assoc' (b : ℤ) {a c : ℤ} (h : c ∣ a) : a * b / c = a / c * b := -by rw [mul_comm, int.mul_div_assoc _ h, mul_comm] - -theorem div_dvd_div : ∀ {a b c : ℤ} (H1 : a ∣ b) (H2 : b ∣ c), b / a ∣ c / a -| a ._ ._ ⟨b, rfl⟩ ⟨c, rfl⟩ := if az : a = 0 then by simp [az] else - by rw [int.mul_div_cancel_left _ az, mul_assoc, int.mul_div_cancel_left _ az]; - apply dvd_mul_right - -protected theorem eq_mul_of_div_eq_right {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) : - a = b * c := -by rw [← H2, int.mul_div_cancel' H1] - -protected theorem div_eq_of_eq_mul_right {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = b * c) : - a / b = c := -by rw [H2, int.mul_div_cancel_left _ H1] - -protected theorem eq_div_of_mul_eq_right {a b c : ℤ} (H1 : a ≠ 0) (H2 : a * b = c) : - b = c / a := -eq.symm $ int.div_eq_of_eq_mul_right H1 H2.symm - -protected theorem div_eq_iff_eq_mul_right {a b c : ℤ} (H : b ≠ 0) (H' : b ∣ a) : - a / b = c ↔ a = b * c := -⟨int.eq_mul_of_div_eq_right H', int.div_eq_of_eq_mul_right H⟩ - -protected theorem div_eq_iff_eq_mul_left {a b c : ℤ} (H : b ≠ 0) (H' : b ∣ a) : - a / b = c ↔ a = c * b := -by rw mul_comm; exact int.div_eq_iff_eq_mul_right H H' - -protected theorem eq_mul_of_div_eq_left {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) : - a = c * b := -by rw [mul_comm, int.eq_mul_of_div_eq_right H1 H2] - -protected theorem div_eq_of_eq_mul_left {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = c * b) : - a / b = c := -int.div_eq_of_eq_mul_right H1 (by rw [mul_comm, H2]) - -protected lemma eq_zero_of_div_eq_zero {d n : ℤ} (h : d ∣ n) (H : n / d = 0) : n = 0 := -by rw [← int.mul_div_cancel' h, H, mul_zero] - -theorem neg_div_of_dvd : ∀ {a b : ℤ} (H : b ∣ a), -a / b = -(a / b) -| ._ b ⟨c, rfl⟩ := if bz : b = 0 then by simp [bz] else - by rw [neg_mul_eq_mul_neg, int.mul_div_cancel_left _ bz, int.mul_div_cancel_left _ bz] - -lemma sub_div_of_dvd (a : ℤ) {b c : ℤ} (hcb : c ∣ b) : (a - b) / c = a / c - b / c := -begin - rw [sub_eq_add_neg, sub_eq_add_neg, int.add_div_of_dvd_right ((dvd_neg c b).mpr hcb)], - congr, - exact neg_div_of_dvd hcb, -end - -lemma sub_div_of_dvd_sub {a b c : ℤ} (hcab : c ∣ (a - b)) : (a - b) / c = a / c - b / c := -by rw [eq_sub_iff_add_eq, ← int.add_div_of_dvd_left hcab, sub_add_cancel] - lemma nat_abs_sign (z : ℤ) : z.sign.nat_abs = if z = 0 then 0 else 1 := by rcases z with (_ | _) | _; refl @@ -921,9 +415,6 @@ lemma nat_abs_sign_of_nonzero {z : ℤ} (hz : z ≠ 0) : z.sign.nat_abs = 1 := by rw [int.nat_abs_sign, if_neg hz] -lemma abs_sign_of_nonzero {z : ℤ} (hz : z ≠ 0) : |z.sign| = 1 := -by rw [abs_eq_nat_abs, nat_abs_sign_of_nonzero hz, int.coe_nat_one] - lemma sign_coe_nat_of_nonzero {n : ℕ} (hn : n ≠ 0) : int.sign n = 1 := begin @@ -948,178 +439,11 @@ theorem div_sign : ∀ a b, a / sign b = a * sign b | -[1+ m] (n+1:ℕ) := rfl | -[1+ m] -[1+ n] := rfl -protected theorem sign_eq_div_abs (a : ℤ) : sign a = a / |a| := -if az : a = 0 then by simp [az] else -(int.div_eq_of_eq_mul_left (mt abs_eq_zero.1 az) - (sign_mul_abs _).symm).symm - theorem mul_sign : ∀ (i : ℤ), i * sign i = nat_abs i | (n+1:ℕ) := mul_one _ | 0 := mul_zero _ | -[1+ n] := mul_neg_one _ -@[simp] -theorem sign_pow_bit1 (k : ℕ) : ∀ n : ℤ, n.sign ^ (bit1 k) = n.sign -| (n+1:ℕ) := one_pow (bit1 k) -| 0 := zero_pow (nat.zero_lt_bit1 k) -| -[1+ n] := (neg_pow_bit1 1 k).trans (congr_arg (λ x, -x) (one_pow (bit1 k))) - -theorem le_of_dvd {a b : ℤ} (bpos : 0 < b) (H : a ∣ b) : a ≤ b := -match a, b, eq_succ_of_zero_lt bpos, H with -| (m : ℕ), ._, ⟨n, rfl⟩, H := coe_nat_le_coe_nat_of_le $ - nat.le_of_dvd n.succ_pos $ coe_nat_dvd.1 H -| -[1+ m], ._, ⟨n, rfl⟩, _ := - le_trans (le_of_lt $ neg_succ_lt_zero _) (coe_zero_le _) -end - -theorem eq_one_of_dvd_one {a : ℤ} (H : 0 ≤ a) (H' : a ∣ 1) : a = 1 := -match a, eq_coe_of_zero_le H, H' with -| ._, ⟨n, rfl⟩, H' := congr_arg coe $ - nat.eq_one_of_dvd_one $ coe_nat_dvd.1 H' -end - -theorem eq_one_of_mul_eq_one_right {a b : ℤ} (H : 0 ≤ a) (H' : a * b = 1) : a = 1 := -eq_one_of_dvd_one H ⟨b, H'.symm⟩ - -theorem eq_one_of_mul_eq_one_left {a b : ℤ} (H : 0 ≤ b) (H' : a * b = 1) : b = 1 := -eq_one_of_mul_eq_one_right H (by rw [mul_comm, H']) - -lemma of_nat_dvd_of_dvd_nat_abs {a : ℕ} : ∀ {z : ℤ} (haz : a ∣ z.nat_abs), ↑a ∣ z -| (int.of_nat _) haz := int.coe_nat_dvd.2 haz -| -[1+k] haz := - begin - change ↑a ∣ -(k+1 : ℤ), - apply dvd_neg_of_dvd, - apply int.coe_nat_dvd.2, - exact haz - end - -lemma dvd_nat_abs_of_of_nat_dvd {a : ℕ} : ∀ {z : ℤ} (haz : ↑a ∣ z), a ∣ z.nat_abs -| (int.of_nat _) haz := int.coe_nat_dvd.1 (int.dvd_nat_abs.2 haz) -| -[1+k] haz := - have haz' : (↑a:ℤ) ∣ (↑(k+1):ℤ), from dvd_of_dvd_neg haz, - int.coe_nat_dvd.1 haz' - -lemma pow_dvd_of_le_of_pow_dvd {p m n : ℕ} {k : ℤ} (hmn : m ≤ n) (hdiv : ↑(p ^ n) ∣ k) : - ↑(p ^ m) ∣ k := -begin - induction k, - { apply int.coe_nat_dvd.2, - apply pow_dvd_of_le_of_pow_dvd hmn, - apply int.coe_nat_dvd.1 hdiv }, - change -[1+k] with -(↑(k+1) : ℤ), - apply dvd_neg_of_dvd, - apply int.coe_nat_dvd.2, - apply pow_dvd_of_le_of_pow_dvd hmn, - apply int.coe_nat_dvd.1, - apply dvd_of_dvd_neg, - exact hdiv, -end - -lemma dvd_of_pow_dvd {p k : ℕ} {m : ℤ} (hk : 1 ≤ k) (hpk : ↑(p^k) ∣ m) : ↑p ∣ m := -by rw ←pow_one p; exact pow_dvd_of_le_of_pow_dvd hk hpk - -/-- If `n > 0` then `m` is not divisible by `n` iff it is between `n * k` and `n * (k + 1)` - for some `k`. -/ -lemma exists_lt_and_lt_iff_not_dvd (m : ℤ) {n : ℤ} (hn : 0 < n) : - (∃ k, n * k < m ∧ m < n * (k + 1)) ↔ ¬ n ∣ m := -begin - split, - { rintro ⟨k, h1k, h2k⟩ ⟨l, rfl⟩, rw [mul_lt_mul_left hn] at h1k h2k, - rw [lt_add_one_iff, ← not_lt] at h2k, exact h2k h1k }, - { intro h, rw [dvd_iff_mod_eq_zero, ← ne.def] at h, - have := (mod_nonneg m hn.ne.symm).lt_of_ne h.symm, - simp only [← mod_add_div m n] {single_pass := tt}, - refine ⟨m / n, lt_add_of_pos_left _ this, _⟩, - rw [add_comm _ (1 : ℤ), left_distrib, mul_one], exact add_lt_add_right (mod_lt_of_pos _ hn) _ } -end - -/-! ### `/` and ordering -/ - -protected theorem div_mul_le (a : ℤ) {b : ℤ} (H : b ≠ 0) : a / b * b ≤ a := -le_of_sub_nonneg $ by rw [mul_comm, ← mod_def]; apply mod_nonneg _ H - -protected theorem div_le_of_le_mul {a b c : ℤ} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b := -le_of_mul_le_mul_right (le_trans (int.div_mul_le _ (ne_of_gt H)) H') H - -protected theorem mul_lt_of_lt_div {a b c : ℤ} (H : 0 < c) (H3 : a < b / c) : a * c < b := -lt_of_not_ge $ mt (int.div_le_of_le_mul H) (not_le_of_gt H3) - -protected theorem mul_le_of_le_div {a b c : ℤ} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b := -le_trans (decidable.mul_le_mul_of_nonneg_right H2 (le_of_lt H1)) (int.div_mul_le _ (ne_of_gt H1)) - -protected theorem le_div_of_mul_le {a b c : ℤ} (H1 : 0 < c) (H2 : a * c ≤ b) : a ≤ b / c := -le_of_lt_add_one $ lt_of_mul_lt_mul_right - (lt_of_le_of_lt H2 (lt_div_add_one_mul_self _ H1)) (le_of_lt H1) - -protected theorem le_div_iff_mul_le {a b c : ℤ} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b := -⟨int.mul_le_of_le_div H, int.le_div_of_mul_le H⟩ - -protected theorem div_le_div {a b c : ℤ} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c := -int.le_div_of_mul_le H (le_trans (int.div_mul_le _ (ne_of_gt H)) H') - -protected theorem div_lt_of_lt_mul {a b c : ℤ} (H : 0 < c) (H' : a < b * c) : a / c < b := -lt_of_not_ge $ mt (int.mul_le_of_le_div H) (not_le_of_gt H') - -protected theorem lt_mul_of_div_lt {a b c : ℤ} (H1 : 0 < c) (H2 : a / c < b) : a < b * c := -lt_of_not_ge $ mt (int.le_div_of_mul_le H1) (not_le_of_gt H2) - -protected theorem div_lt_iff_lt_mul {a b c : ℤ} (H : 0 < c) : a / c < b ↔ a < b * c := -⟨int.lt_mul_of_div_lt H, int.div_lt_of_lt_mul H⟩ - -protected theorem le_mul_of_div_le {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) : - a ≤ c * b := -by rw [← int.div_mul_cancel H2]; exact decidable.mul_le_mul_of_nonneg_right H3 H1 - -protected theorem lt_div_of_mul_lt {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) : - a < c / b := -lt_of_not_ge $ mt (int.le_mul_of_div_le H1 H2) (not_le_of_gt H3) - -protected theorem lt_div_iff_mul_lt {a b : ℤ} (c : ℤ) (H : 0 < c) (H' : c ∣ b) : - a < b / c ↔ a * c < b := -⟨int.mul_lt_of_lt_div H, int.lt_div_of_mul_lt (le_of_lt H) H'⟩ - -theorem div_pos_of_pos_of_dvd {a b : ℤ} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b := -int.lt_div_of_mul_lt H2 H3 (by rwa zero_mul) - -theorem div_eq_div_of_mul_eq_mul {a b c d : ℤ} (H2 : d ∣ c) (H3 : b ≠ 0) - (H4 : d ≠ 0) (H5 : a * d = b * c) : - a / b = c / d := -int.div_eq_of_eq_mul_right H3 $ -by rw [← int.mul_div_assoc _ H2]; exact -(int.div_eq_of_eq_mul_left H4 H5.symm).symm - -theorem eq_mul_div_of_mul_eq_mul_of_dvd_left {a b c d : ℤ} (hb : b ≠ 0) (hbc : b ∣ c) - (h : b * a = c * d) : - a = c / b * d := -begin - cases hbc with k hk, - subst hk, - rw [int.mul_div_cancel_left _ hb], - rw mul_assoc at h, - apply mul_left_cancel₀ hb h -end - -/-- If an integer with larger absolute value divides an integer, it is -zero. -/ -lemma eq_zero_of_dvd_of_nat_abs_lt_nat_abs {a b : ℤ} (w : a ∣ b) (h : nat_abs b < nat_abs a) : - b = 0 := -begin - rw [←nat_abs_dvd, ←dvd_nat_abs, coe_nat_dvd] at w, - rw ←nat_abs_eq_zero, - exact eq_zero_of_dvd_of_lt w h -end - -lemma eq_zero_of_dvd_of_nonneg_of_lt {a b : ℤ} (w₁ : 0 ≤ a) (w₂ : a < b) (h : b ∣ a) : a = 0 := -eq_zero_of_dvd_of_nat_abs_lt_nat_abs h (nat_abs_lt_nat_abs_of_nonneg_of_lt w₁ w₂) - -/-- If two integers are congruent to a sufficiently large modulus, -they are equal. -/ -lemma eq_of_mod_eq_of_nat_abs_sub_lt_nat_abs {a b c : ℤ} (h1 : a % b = c) - (h2 : nat_abs (a - c) < nat_abs b) : - a = c := -eq_of_sub_eq_zero (eq_zero_of_dvd_of_nat_abs_lt_nat_abs (dvd_sub_of_mod_eq h1) h2) - theorem of_nat_add_neg_succ_of_nat_of_lt {m n : ℕ} (h : m < n.succ) : of_nat m + -[1+n] = -[1+ n - m] := begin @@ -1130,40 +454,8 @@ begin simp [*, sub_nat_nat] end -theorem of_nat_add_neg_succ_of_nat_of_ge {m n : ℕ} - (h : n.succ ≤ m) : of_nat m + -[1+n] = of_nat (m - n.succ) := -begin - change sub_nat_nat _ _ = _, - have h' : n.succ - m = 0, - apply tsub_eq_zero_iff_le.mpr h, - simp [*, sub_nat_nat] -end - @[simp] theorem neg_add_neg (m n : ℕ) : -[1+m] + -[1+n] = -[1+nat.succ(m+n)] := rfl -lemma nat_abs_le_of_dvd_ne_zero {s t : ℤ} (hst : s ∣ t) (ht : t ≠ 0) : nat_abs s ≤ nat_abs t := -not_lt.mp (mt (eq_zero_of_dvd_of_nat_abs_lt_nat_abs hst) ht) - -lemma nat_abs_eq_of_dvd_dvd {s t : ℤ} (hst : s ∣ t) (hts : t ∣ s) : nat_abs s = nat_abs t := -nat.dvd_antisymm (nat_abs_dvd_iff_dvd.mpr hst) (nat_abs_dvd_iff_dvd.mpr hts) - -lemma div_dvd_of_dvd {s t : ℤ} (hst : s ∣ t) : (t / s) ∣ t := -begin - rcases eq_or_ne s 0 with rfl | hs, - { simpa using hst }, - rcases hst with ⟨c, hc⟩, - simp [hc, int.mul_div_cancel_left _ hs], -end - -lemma dvd_div_of_mul_dvd {a b c : ℤ} (h : a * b ∣ c) : b ∣ c / a := -begin - rcases eq_or_ne a 0 with rfl | ha, - { simp only [int.div_zero, dvd_zero] }, - rcases h with ⟨d, rfl⟩, - refine ⟨d, _⟩, - rw [mul_assoc, int.mul_div_cancel_left _ ha], -end - /-! ### to_nat -/ theorem to_nat_eq_max : ∀ (a : ℤ), (to_nat a : ℤ) = max a 0 @@ -1177,9 +469,6 @@ theorem to_nat_eq_max : ∀ (a : ℤ), (to_nat a : ℤ) = max a 0 @[simp] theorem to_nat_of_nonneg {a : ℤ} (h : 0 ≤ a) : (to_nat a : ℤ) = a := by rw [to_nat_eq_max, max_eq_left h] -@[simp] lemma to_nat_sub_of_le {a b : ℤ} (h : b ≤ a) : (to_nat (a - b) : ℤ) = a - b := -int.to_nat_of_nonneg (sub_nonneg_of_le h) - @[simp] theorem to_nat_coe_nat (n : ℕ) : to_nat ↑n = n := rfl @[simp] lemma to_nat_coe_nat_add_one {n : ℕ} : ((n : ℤ) + 1).to_nat = n + 1 := rfl @@ -1187,31 +476,9 @@ int.to_nat_of_nonneg (sub_nonneg_of_le h) theorem le_to_nat (a : ℤ) : a ≤ to_nat a := by rw [to_nat_eq_max]; apply le_max_left -@[simp] theorem to_nat_le {a : ℤ} {n : ℕ} : to_nat a ≤ n ↔ a ≤ n := -by rw [(coe_nat_le_coe_nat_iff _ _).symm, to_nat_eq_max, max_le_iff]; - exact and_iff_left (coe_zero_le _) - -@[simp] theorem lt_to_nat {n : ℕ} {a : ℤ} : n < to_nat a ↔ (n : ℤ) < a := -le_iff_le_iff_lt_iff_lt.1 to_nat_le - @[simp]lemma le_to_nat_iff {n : ℕ} {z : ℤ} (h : 0 ≤ z) : n ≤ z.to_nat ↔ (n : ℤ) ≤ z := by rw [←int.coe_nat_le_coe_nat_iff, int.to_nat_of_nonneg h] -@[simp] -lemma coe_nat_nonpos_iff {n : ℕ} : (n : ℤ) ≤ 0 ↔ n = 0 := -⟨ λ h, le_antisymm (int.coe_nat_le.mp (h.trans int.coe_nat_zero.le)) n.zero_le, - λ h, (coe_nat_eq_zero.mpr h).le⟩ - -theorem to_nat_le_to_nat {a b : ℤ} (h : a ≤ b) : to_nat a ≤ to_nat b := -by rw to_nat_le; exact le_trans h (le_to_nat b) - -theorem to_nat_lt_to_nat {a b : ℤ} (hb : 0 < b) : to_nat a < to_nat b ↔ a < b := -⟨λ h, begin cases a, exact lt_to_nat.1 h, exact lt_trans (neg_succ_of_nat_lt_zero a) hb, end, - λ h, begin rw lt_to_nat, cases a, exact h, exact hb end⟩ - -theorem lt_of_to_nat_lt {a b : ℤ} (h : to_nat a < to_nat b) : a < b := -(to_nat_lt_to_nat $ lt_to_nat.1 $ lt_of_le_of_lt (nat.zero_le _) h).1 h - lemma to_nat_add {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) : (a + b).to_nat = a.to_nat + b.to_nat := begin @@ -1232,10 +499,6 @@ lemma pred_to_nat : ∀ (i : ℤ), (i - 1).to_nat = i.to_nat - 1 | (n+1:ℕ) := by simp | -[1+ n] := rfl -@[simp] -lemma to_nat_pred_coe_of_pos {i : ℤ} (h : 0 < i) : ((i.to_nat - 1 : ℕ) : ℤ) = i - 1 := -by simp [h, le_of_lt h] with push_cast - @[simp] lemma to_nat_sub_to_nat_neg : ∀ (n : ℤ), ↑n.to_nat - ↑((-n).to_nat) = n | (0 : ℕ) := rfl | (n+1 : ℕ) := show ↑(n+1) - (0:ℤ) = n+1, from sub_zero _ @@ -1256,334 +519,11 @@ theorem mem_to_nat' : ∀ (a : ℤ) (n : ℕ), n ∈ to_nat' a ↔ a = n | (m : ℕ) n := option.some_inj.trans coe_nat_inj'.symm | -[1+ m] n := by split; intro h; cases h -lemma to_nat_of_nonpos : ∀ {z : ℤ}, z ≤ 0 → z.to_nat = 0 -| 0 _ := rfl -| (n + 1 : ℕ) h := (h.not_lt (coe_nat_succ_pos _)).elim -| -[1+ n] _ := rfl - @[simp] lemma to_nat_neg_nat : ∀ (n : ℕ), (-(n : ℤ)).to_nat = 0 | 0 := rfl | (n + 1) := rfl -@[simp] -lemma to_nat_eq_zero : ∀ {n : ℤ}, n.to_nat = 0 ↔ n ≤ 0 -| (n : ℕ) := calc _ ↔ (n = 0) : ⟨(to_nat_coe_nat n).symm.trans, (to_nat_coe_nat n).trans⟩ - ... ↔ _ : coe_nat_nonpos_iff.symm -| -[1+ n] := show ((-((n : ℤ) + 1)).to_nat = 0) ↔ (-(n + 1) : ℤ) ≤ 0, from -calc _ ↔ true : ⟨λ _, trivial, λ h, to_nat_neg_nat _⟩ - ... ↔ _ : ⟨λ h, neg_nonpos_of_nonneg (coe_zero_le _), λ _, trivial⟩ - -/-! ### units -/ - -@[simp] theorem units_nat_abs (u : ℤˣ) : nat_abs u = 1 := -units.ext_iff.1 $ nat.units_eq_one ⟨nat_abs u, nat_abs ↑u⁻¹, - by rw [← nat_abs_mul, units.mul_inv]; refl, - by rw [← nat_abs_mul, units.inv_mul]; refl⟩ - -theorem units_eq_one_or (u : ℤˣ) : u = 1 ∨ u = -1 := -by simpa only [units.ext_iff, units_nat_abs] using nat_abs_eq u - -lemma is_unit_eq_one_or {a : ℤ} : is_unit a → a = 1 ∨ a = -1 -| ⟨x, hx⟩ := hx ▸ (units_eq_one_or _).imp (congr_arg coe) (congr_arg coe) - -lemma is_unit_iff {a : ℤ} : is_unit a ↔ a = 1 ∨ a = -1 := -begin - refine ⟨λ h, is_unit_eq_one_or h, λ h, _⟩, - rcases h with rfl | rfl, - { exact is_unit_one }, - { exact is_unit_one.neg } -end - -lemma eq_one_or_neg_one_of_mul_eq_one {z w : ℤ} (h : z * w = 1) : z = 1 ∨ z = -1 := -is_unit_iff.mp (is_unit_of_mul_eq_one z w h) - -lemma eq_one_or_neg_one_of_mul_eq_one' {z w : ℤ} (h : z * w = 1) : - (z = 1 ∧ w = 1) ∨ (z = -1 ∧ w = -1) := -begin - have h' : w * z = 1 := (mul_comm z w) ▸ h, - rcases eq_one_or_neg_one_of_mul_eq_one h with rfl | rfl; - rcases eq_one_or_neg_one_of_mul_eq_one h' with rfl | rfl; - tauto, -end - -theorem is_unit_iff_nat_abs_eq {n : ℤ} : is_unit n ↔ n.nat_abs = 1 := -by simp [nat_abs_eq_iff, is_unit_iff] - -lemma is_unit_iff_abs_eq {x : ℤ} : is_unit x ↔ abs x = 1 := -by rw [is_unit_iff_nat_abs_eq, abs_eq_nat_abs, ←int.coe_nat_one, coe_nat_inj'] - -@[norm_cast] -lemma of_nat_is_unit {n : ℕ} : is_unit (n : ℤ) ↔ is_unit n := -by rw [nat.is_unit_iff, is_unit_iff_nat_abs_eq, nat_abs_of_nat] - -lemma is_unit_mul_self {a : ℤ} (ha : is_unit a) : a * a = 1 := -(is_unit_eq_one_or ha).elim (λ h, h.symm ▸ rfl) (λ h, h.symm ▸ rfl) - -lemma is_unit_sq {a : ℤ} (ha : is_unit a) : a ^ 2 = 1 := -by rw [sq, is_unit_mul_self ha] - -@[simp] lemma units_sq (u : ℤˣ) : u ^ 2 = 1 := -by rw [units.ext_iff, units.coe_pow, units.coe_one, is_unit_sq u.is_unit] - -@[simp] lemma units_mul_self (u : ℤˣ) : u * u = 1 := -by rw [←sq, units_sq] - -@[simp] lemma units_inv_eq_self (u : ℤˣ) : u⁻¹ = u := -by rw [inv_eq_iff_mul_eq_one, units_mul_self] - --- `units.coe_mul` is a "wrong turn" for the simplifier, this undoes it and simplifies further -@[simp] lemma units_coe_mul_self (u : ℤˣ) : (u * u : ℤ) = 1 := -by rw [←units.coe_mul, units_mul_self, units.coe_one] - -@[simp] lemma neg_one_pow_ne_zero {n : ℕ} : (-1 : ℤ)^n ≠ 0 := -pow_ne_zero _ (abs_pos.mp trivial) - -/-! ### bitwise ops -/ - -@[simp] lemma bodd_zero : bodd 0 = ff := rfl -@[simp] lemma bodd_one : bodd 1 = tt := rfl -lemma bodd_two : bodd 2 = ff := rfl - -@[simp, norm_cast] lemma bodd_coe (n : ℕ) : int.bodd n = nat.bodd n := rfl - -@[simp] lemma bodd_sub_nat_nat (m n : ℕ) : bodd (sub_nat_nat m n) = bxor m.bodd n.bodd := -by apply sub_nat_nat_elim m n (λ m n i, bodd i = bxor m.bodd n.bodd); intros; - simp; cases i.bodd; simp - -@[simp] lemma bodd_neg_of_nat (n : ℕ) : bodd (neg_of_nat n) = n.bodd := -by cases n; simp; refl - -@[simp] lemma bodd_neg (n : ℤ) : bodd (-n) = bodd n := -by cases n; simp [has_neg.neg, int.coe_nat_eq, int.neg, bodd, -of_nat_eq_coe] - -@[simp] lemma bodd_add (m n : ℤ) : bodd (m + n) = bxor (bodd m) (bodd n) := -by cases m with m m; cases n with n n; unfold has_add.add; - simp [int.add, -of_nat_eq_coe, bool.bxor_comm] - -@[simp] lemma bodd_mul (m n : ℤ) : bodd (m * n) = bodd m && bodd n := -by cases m with m m; cases n with n n; - simp [← int.mul_def, int.mul, -of_nat_eq_coe, bool.bxor_comm] - -theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n -| (n : ℕ) := - by rw [show (cond (bodd n) 1 0 : ℤ) = (cond (bodd n) 1 0 : ℕ), - by cases bodd n; refl]; exact congr_arg of_nat n.bodd_add_div2 -| -[1+ n] := begin - refine eq.trans _ (congr_arg neg_succ_of_nat n.bodd_add_div2), - dsimp [bodd], cases nat.bodd n; dsimp [cond, bnot, div2, int.mul], - { change -[1+ 2 * nat.div2 n] = _, rw zero_add }, - { rw [zero_add, add_comm], refl } - end - -theorem div2_val : ∀ n, div2 n = n / 2 -| (n : ℕ) := congr_arg of_nat n.div2_val -| -[1+ n] := congr_arg neg_succ_of_nat n.div2_val - -lemma bit0_val (n : ℤ) : bit0 n = 2 * n := (two_mul _).symm - -lemma bit1_val (n : ℤ) : bit1 n = 2 * n + 1 := congr_arg (+(1:ℤ)) (bit0_val _) - -lemma bit_val (b n) : bit b n = 2 * n + cond b 1 0 := -by { cases b, apply (bit0_val n).trans (add_zero _).symm, apply bit1_val } - -lemma bit_decomp (n : ℤ) : bit (bodd n) (div2 n) = n := -(bit_val _ _).trans $ (add_comm _ _).trans $ bodd_add_div2 _ - -/-- Defines a function from `ℤ` conditionally, if it is defined for odd and even integers separately - using `bit`. -/ -def {u} bit_cases_on {C : ℤ → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n := -by rw [← bit_decomp n]; apply h - -@[simp] lemma bit_zero : bit ff 0 = 0 := rfl - -@[simp] lemma bit_coe_nat (b) (n : ℕ) : bit b n = nat.bit b n := -by rw [bit_val, nat.bit_val]; cases b; refl - -@[simp] lemma bit_neg_succ (b) (n : ℕ) : bit b -[1+ n] = -[1+ nat.bit (bnot b) n] := -by rw [bit_val, nat.bit_val]; cases b; refl - -@[simp] lemma bodd_bit (b n) : bodd (bit b n) = b := -by rw bit_val; simp; cases b; cases bodd n; refl - -@[simp] lemma bodd_bit0 (n : ℤ) : bodd (bit0 n) = ff := bodd_bit ff n - -@[simp] lemma bodd_bit1 (n : ℤ) : bodd (bit1 n) = tt := bodd_bit tt n - -@[simp] lemma div2_bit (b n) : div2 (bit b n) = n := -begin - rw [bit_val, div2_val, add_comm, int.add_mul_div_left, (_ : (_/2:ℤ) = 0), zero_add], - cases b, - { simp }, - { show of_nat _ = _, rw nat.div_eq_zero; simp }, - { cc } -end - -lemma bit0_ne_bit1 (m n : ℤ) : bit0 m ≠ bit1 n := -mt (congr_arg bodd) $ by simp - -lemma bit1_ne_bit0 (m n : ℤ) : bit1 m ≠ bit0 n := -(bit0_ne_bit1 _ _).symm - -lemma bit1_ne_zero (m : ℤ) : bit1 m ≠ 0 := -by simpa only [bit0_zero] using bit1_ne_bit0 m 0 - -@[simp] lemma test_bit_zero (b) : ∀ n, test_bit (bit b n) 0 = b -| (n : ℕ) := by rw [bit_coe_nat]; apply nat.test_bit_zero -| -[1+ n] := by rw [bit_neg_succ]; dsimp [test_bit]; rw [nat.test_bit_zero]; - clear test_bit_zero; cases b; refl - -@[simp] lemma test_bit_succ (m b) : ∀ n, test_bit (bit b n) (nat.succ m) = test_bit n m -| (n : ℕ) := by rw [bit_coe_nat]; apply nat.test_bit_succ -| -[1+ n] := by rw [bit_neg_succ]; dsimp [test_bit]; rw [nat.test_bit_succ] - -private meta def bitwise_tac : tactic unit := `[ - funext m, - funext n, - cases m with m m; cases n with n n; try {refl}, - all_goals - { apply congr_arg of_nat <|> apply congr_arg neg_succ_of_nat, - try {dsimp [nat.land, nat.ldiff, nat.lor]}, - try {rw [ - show nat.bitwise (λ a b, a && bnot b) n m = - nat.bitwise (λ a b, b && bnot a) m n, from - congr_fun (congr_fun (@nat.bitwise_swap (λ a b, b && bnot a) rfl) n) m]}, - apply congr_arg (λ f, nat.bitwise f m n), - funext a, - funext b, - cases a; cases b; refl }, - all_goals {unfold nat.land nat.ldiff nat.lor} -] - -theorem bitwise_or : bitwise bor = lor := by bitwise_tac -theorem bitwise_and : bitwise band = land := by bitwise_tac -theorem bitwise_diff : bitwise (λ a b, a && bnot b) = ldiff := by bitwise_tac -theorem bitwise_xor : bitwise bxor = lxor := by bitwise_tac - -@[simp] lemma bitwise_bit (f : bool → bool → bool) (a m b n) : - bitwise f (bit a m) (bit b n) = bit (f a b) (bitwise f m n) := -begin - cases m with m m; cases n with n n; - repeat { rw [← int.coe_nat_eq] <|> rw bit_coe_nat <|> rw bit_neg_succ }; - unfold bitwise nat_bitwise bnot; - [ induction h : f ff ff, - induction h : f ff tt, - induction h : f tt ff, - induction h : f tt tt ], - all_goals - { unfold cond, rw nat.bitwise_bit, - repeat { rw bit_coe_nat <|> rw bit_neg_succ <|> rw bnot_bnot } }, - all_goals { unfold bnot {fail_if_unchanged := ff}; rw h; refl } -end - -@[simp] lemma lor_bit (a m b n) : lor (bit a m) (bit b n) = bit (a || b) (lor m n) := -by rw [← bitwise_or, bitwise_bit] - -@[simp] lemma land_bit (a m b n) : land (bit a m) (bit b n) = bit (a && b) (land m n) := -by rw [← bitwise_and, bitwise_bit] - -@[simp] lemma ldiff_bit (a m b n) : ldiff (bit a m) (bit b n) = bit (a && bnot b) (ldiff m n) := -by rw [← bitwise_diff, bitwise_bit] - -@[simp] lemma lxor_bit (a m b n) : lxor (bit a m) (bit b n) = bit (bxor a b) (lxor m n) := -by rw [← bitwise_xor, bitwise_bit] - -@[simp] lemma lnot_bit (b) : ∀ n, lnot (bit b n) = bit (bnot b) (lnot n) -| (n : ℕ) := by simp [lnot] -| -[1+ n] := by simp [lnot] - -@[simp] lemma test_bit_bitwise (f : bool → bool → bool) (m n k) : - test_bit (bitwise f m n) k = f (test_bit m k) (test_bit n k) := -begin - induction k with k IH generalizing m n; - apply bit_cases_on m; intros a m'; - apply bit_cases_on n; intros b n'; - rw bitwise_bit, - { simp [test_bit_zero] }, - { simp [test_bit_succ, IH] } -end - -@[simp] lemma test_bit_lor (m n k) : test_bit (lor m n) k = test_bit m k || test_bit n k := -by rw [← bitwise_or, test_bit_bitwise] - -@[simp] lemma test_bit_land (m n k) : test_bit (land m n) k = test_bit m k && test_bit n k := -by rw [← bitwise_and, test_bit_bitwise] - -@[simp] -lemma test_bit_ldiff (m n k) : test_bit (ldiff m n) k = test_bit m k && bnot (test_bit n k) := -by rw [← bitwise_diff, test_bit_bitwise] - -@[simp] lemma test_bit_lxor (m n k) : test_bit (lxor m n) k = bxor (test_bit m k) (test_bit n k) := -by rw [← bitwise_xor, test_bit_bitwise] - -@[simp] lemma test_bit_lnot : ∀ n k, test_bit (lnot n) k = bnot (test_bit n k) -| (n : ℕ) k := by simp [lnot, test_bit] -| -[1+ n] k := by simp [lnot, test_bit] - -lemma shiftl_add : ∀ (m : ℤ) (n : ℕ) (k : ℤ), shiftl m (n + k) = shiftl (shiftl m n) k -| (m : ℕ) n (k:ℕ) := congr_arg of_nat (nat.shiftl_add _ _ _) -| -[1+ m] n (k:ℕ) := congr_arg neg_succ_of_nat (nat.shiftl'_add _ _ _ _) -| (m : ℕ) n -[1+k] := sub_nat_nat_elim n k.succ - (λ n k i, shiftl ↑m i = nat.shiftr (nat.shiftl m n) k) - (λ i n, congr_arg coe $ - by rw [← nat.shiftl_sub, add_tsub_cancel_left]; apply nat.le_add_right) - (λ i n, congr_arg coe $ - by rw [add_assoc, nat.shiftr_add, ← nat.shiftl_sub, tsub_self]; refl) -| -[1+ m] n -[1+k] := sub_nat_nat_elim n k.succ - (λ n k i, shiftl -[1+ m] i = -[1+ nat.shiftr (nat.shiftl' tt m n) k]) - (λ i n, congr_arg neg_succ_of_nat $ - by rw [← nat.shiftl'_sub, add_tsub_cancel_left]; apply nat.le_add_right) - (λ i n, congr_arg neg_succ_of_nat $ - by rw [add_assoc, nat.shiftr_add, ← nat.shiftl'_sub, tsub_self]; refl) - -lemma shiftl_sub (m : ℤ) (n : ℕ) (k : ℤ) : shiftl m (n - k) = shiftr (shiftl m n) k := -shiftl_add _ _ _ - -@[simp] lemma shiftl_neg (m n : ℤ) : shiftl m (-n) = shiftr m n := rfl -@[simp] lemma shiftr_neg (m n : ℤ) : shiftr m (-n) = shiftl m n := by rw [← shiftl_neg, neg_neg] - -@[simp] lemma shiftl_coe_nat (m n : ℕ) : shiftl m n = nat.shiftl m n := rfl -@[simp] lemma shiftr_coe_nat (m n : ℕ) : shiftr m n = nat.shiftr m n := by cases n; refl - -@[simp] lemma shiftl_neg_succ (m n : ℕ) : shiftl -[1+ m] n = -[1+ nat.shiftl' tt m n] := rfl -@[simp] -lemma shiftr_neg_succ (m n : ℕ) : shiftr -[1+ m] n = -[1+ nat.shiftr m n] := by cases n; refl - -lemma shiftr_add : ∀ (m : ℤ) (n k : ℕ), shiftr m (n + k) = shiftr (shiftr m n) k -| (m : ℕ) n k := by rw [shiftr_coe_nat, shiftr_coe_nat, - ← int.coe_nat_add, shiftr_coe_nat, nat.shiftr_add] -| -[1+ m] n k := by rw [shiftr_neg_succ, shiftr_neg_succ, - ← int.coe_nat_add, shiftr_neg_succ, nat.shiftr_add] - -lemma shiftl_eq_mul_pow : ∀ (m : ℤ) (n : ℕ), shiftl m n = m * ↑(2 ^ n) -| (m : ℕ) n := congr_arg coe (nat.shiftl_eq_mul_pow _ _) -| -[1+ m] n := @congr_arg ℕ ℤ _ _ (λi, -i) (nat.shiftl'_tt_eq_mul_pow _ _) - -lemma shiftr_eq_div_pow : ∀ (m : ℤ) (n : ℕ), shiftr m n = m / ↑(2 ^ n) -| (m : ℕ) n := by rw shiftr_coe_nat; exact congr_arg coe (nat.shiftr_eq_div_pow _ _) -| -[1+ m] n := begin - rw [shiftr_neg_succ, neg_succ_of_nat_div, nat.shiftr_eq_div_pow], refl, - exact coe_nat_lt_coe_nat_of_lt (pow_pos dec_trivial _) -end - -lemma one_shiftl (n : ℕ) : shiftl 1 n = (2 ^ n : ℕ) := -congr_arg coe (nat.one_shiftl _) - -@[simp] lemma zero_shiftl : ∀ n : ℤ, shiftl 0 n = 0 -| (n : ℕ) := congr_arg coe (nat.zero_shiftl _) -| -[1+ n] := congr_arg coe (nat.zero_shiftr _) - -@[simp] lemma zero_shiftr (n) : shiftr 0 n = 0 := zero_shiftl _ - -lemma eq_zero_of_abs_lt_dvd {m x : ℤ} (h1 : m ∣ x) (h2 : | x | < m) : x = 0 := -begin - by_cases hm : m = 0, { subst m, exact zero_dvd_iff.mp h1, }, - rcases h1 with ⟨d, rfl⟩, - apply mul_eq_zero_of_right, - rw [←abs_lt_one_iff, ←mul_lt_iff_lt_one_right (abs_pos.mpr hm), ←abs_mul], - exact lt_of_lt_of_le h2 (le_abs_self m), -end - end int attribute [irreducible] int.nonneg diff --git a/src/data/int/bitwise.lean b/src/data/int/bitwise.lean new file mode 100644 index 0000000000000..0114fb8fc132e --- /dev/null +++ b/src/data/int/bitwise.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.int.basic +import data.nat.pow +import data.nat.size + +/-! +# Bitwise operations on integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + + +## Recursors +* `int.bit_cases_on`: Parity disjunction. Something is true/defined on `ℤ` if it's true/defined for + even and for odd values. + +-/ + +namespace int + +/-! ### bitwise ops -/ + +@[simp] lemma bodd_zero : bodd 0 = ff := rfl +@[simp] lemma bodd_one : bodd 1 = tt := rfl +lemma bodd_two : bodd 2 = ff := rfl + +@[simp, norm_cast] lemma bodd_coe (n : ℕ) : int.bodd n = nat.bodd n := rfl + +@[simp] lemma bodd_sub_nat_nat (m n : ℕ) : bodd (sub_nat_nat m n) = bxor m.bodd n.bodd := +by apply sub_nat_nat_elim m n (λ m n i, bodd i = bxor m.bodd n.bodd); intros; + simp; cases i.bodd; simp + +@[simp] lemma bodd_neg_of_nat (n : ℕ) : bodd (neg_of_nat n) = n.bodd := +by cases n; simp; refl + +@[simp] lemma bodd_neg (n : ℤ) : bodd (-n) = bodd n := +by cases n; simp [has_neg.neg, int.coe_nat_eq, int.neg, bodd, -of_nat_eq_coe] + +@[simp] lemma bodd_add (m n : ℤ) : bodd (m + n) = bxor (bodd m) (bodd n) := +by cases m with m m; cases n with n n; unfold has_add.add; + simp [int.add, -of_nat_eq_coe, bool.bxor_comm] + +@[simp] lemma bodd_mul (m n : ℤ) : bodd (m * n) = bodd m && bodd n := +by cases m with m m; cases n with n n; + simp [← int.mul_def, int.mul, -of_nat_eq_coe, bool.bxor_comm] + +theorem bodd_add_div2 : ∀ n, cond (bodd n) 1 0 + 2 * div2 n = n +| (n : ℕ) := + by rw [show (cond (bodd n) 1 0 : ℤ) = (cond (bodd n) 1 0 : ℕ), + by cases bodd n; refl]; exact congr_arg of_nat n.bodd_add_div2 +| -[1+ n] := begin + refine eq.trans _ (congr_arg neg_succ_of_nat n.bodd_add_div2), + dsimp [bodd], cases nat.bodd n; dsimp [cond, bnot, div2, int.mul], + { change -[1+ 2 * nat.div2 n] = _, rw zero_add }, + { rw [zero_add, add_comm], refl } + end + +theorem div2_val : ∀ n, div2 n = n / 2 +| (n : ℕ) := congr_arg of_nat n.div2_val +| -[1+ n] := congr_arg neg_succ_of_nat n.div2_val + +lemma bit0_val (n : ℤ) : bit0 n = 2 * n := (two_mul _).symm + +lemma bit1_val (n : ℤ) : bit1 n = 2 * n + 1 := congr_arg (+(1:ℤ)) (bit0_val _) + +lemma bit_val (b n) : bit b n = 2 * n + cond b 1 0 := +by { cases b, apply (bit0_val n).trans (add_zero _).symm, apply bit1_val } + +lemma bit_decomp (n : ℤ) : bit (bodd n) (div2 n) = n := +(bit_val _ _).trans $ (add_comm _ _).trans $ bodd_add_div2 _ + +/-- Defines a function from `ℤ` conditionally, if it is defined for odd and even integers separately + using `bit`. -/ +def {u} bit_cases_on {C : ℤ → Sort u} (n) (h : ∀ b n, C (bit b n)) : C n := +by rw [← bit_decomp n]; apply h + +@[simp] lemma bit_zero : bit ff 0 = 0 := rfl + +@[simp] lemma bit_coe_nat (b) (n : ℕ) : bit b n = nat.bit b n := +by rw [bit_val, nat.bit_val]; cases b; refl + +@[simp] lemma bit_neg_succ (b) (n : ℕ) : bit b -[1+ n] = -[1+ nat.bit (bnot b) n] := +by rw [bit_val, nat.bit_val]; cases b; refl + +@[simp] lemma bodd_bit (b n) : bodd (bit b n) = b := +by rw bit_val; simp; cases b; cases bodd n; refl + +@[simp] lemma bodd_bit0 (n : ℤ) : bodd (bit0 n) = ff := bodd_bit ff n + +@[simp] lemma bodd_bit1 (n : ℤ) : bodd (bit1 n) = tt := bodd_bit tt n + +lemma bit0_ne_bit1 (m n : ℤ) : bit0 m ≠ bit1 n := +mt (congr_arg bodd) $ by simp + +lemma bit1_ne_bit0 (m n : ℤ) : bit1 m ≠ bit0 n := +(bit0_ne_bit1 _ _).symm + +lemma bit1_ne_zero (m : ℤ) : bit1 m ≠ 0 := +by simpa only [bit0_zero] using bit1_ne_bit0 m 0 + +@[simp] lemma test_bit_zero (b) : ∀ n, test_bit (bit b n) 0 = b +| (n : ℕ) := by rw [bit_coe_nat]; apply nat.test_bit_zero +| -[1+ n] := by rw [bit_neg_succ]; dsimp [test_bit]; rw [nat.test_bit_zero]; + clear test_bit_zero; cases b; refl + +@[simp] lemma test_bit_succ (m b) : ∀ n, test_bit (bit b n) (nat.succ m) = test_bit n m +| (n : ℕ) := by rw [bit_coe_nat]; apply nat.test_bit_succ +| -[1+ n] := by rw [bit_neg_succ]; dsimp [test_bit]; rw [nat.test_bit_succ] + +private meta def bitwise_tac : tactic unit := `[ + funext m, + funext n, + cases m with m m; cases n with n n; try {refl}, + all_goals + { apply congr_arg of_nat <|> apply congr_arg neg_succ_of_nat, + try {dsimp [nat.land, nat.ldiff, nat.lor]}, + try {rw [ + show nat.bitwise (λ a b, a && bnot b) n m = + nat.bitwise (λ a b, b && bnot a) m n, from + congr_fun (congr_fun (@nat.bitwise_swap (λ a b, b && bnot a) rfl) n) m]}, + apply congr_arg (λ f, nat.bitwise f m n), + funext a, + funext b, + cases a; cases b; refl }, + all_goals {unfold nat.land nat.ldiff nat.lor} +] + +theorem bitwise_or : bitwise bor = lor := by bitwise_tac +theorem bitwise_and : bitwise band = land := by bitwise_tac +theorem bitwise_diff : bitwise (λ a b, a && bnot b) = ldiff := by bitwise_tac +theorem bitwise_xor : bitwise bxor = lxor := by bitwise_tac + +@[simp] lemma bitwise_bit (f : bool → bool → bool) (a m b n) : + bitwise f (bit a m) (bit b n) = bit (f a b) (bitwise f m n) := +begin + cases m with m m; cases n with n n; + repeat { rw [← int.coe_nat_eq] <|> rw bit_coe_nat <|> rw bit_neg_succ }; + unfold bitwise nat_bitwise bnot; + [ induction h : f ff ff, + induction h : f ff tt, + induction h : f tt ff, + induction h : f tt tt ], + all_goals + { unfold cond, rw nat.bitwise_bit, + repeat { rw bit_coe_nat <|> rw bit_neg_succ <|> rw bnot_bnot } }, + all_goals { unfold bnot {fail_if_unchanged := ff}; rw h; refl } +end + +@[simp] lemma lor_bit (a m b n) : lor (bit a m) (bit b n) = bit (a || b) (lor m n) := +by rw [← bitwise_or, bitwise_bit] + +@[simp] lemma land_bit (a m b n) : land (bit a m) (bit b n) = bit (a && b) (land m n) := +by rw [← bitwise_and, bitwise_bit] + +@[simp] lemma ldiff_bit (a m b n) : ldiff (bit a m) (bit b n) = bit (a && bnot b) (ldiff m n) := +by rw [← bitwise_diff, bitwise_bit] + +@[simp] lemma lxor_bit (a m b n) : lxor (bit a m) (bit b n) = bit (bxor a b) (lxor m n) := +by rw [← bitwise_xor, bitwise_bit] + +@[simp] lemma lnot_bit (b) : ∀ n, lnot (bit b n) = bit (bnot b) (lnot n) +| (n : ℕ) := by simp [lnot] +| -[1+ n] := by simp [lnot] + +@[simp] lemma test_bit_bitwise (f : bool → bool → bool) (m n k) : + test_bit (bitwise f m n) k = f (test_bit m k) (test_bit n k) := +begin + induction k with k IH generalizing m n; + apply bit_cases_on m; intros a m'; + apply bit_cases_on n; intros b n'; + rw bitwise_bit, + { simp [test_bit_zero] }, + { simp [test_bit_succ, IH] } +end + +@[simp] lemma test_bit_lor (m n k) : test_bit (lor m n) k = test_bit m k || test_bit n k := +by rw [← bitwise_or, test_bit_bitwise] + +@[simp] lemma test_bit_land (m n k) : test_bit (land m n) k = test_bit m k && test_bit n k := +by rw [← bitwise_and, test_bit_bitwise] + +@[simp] +lemma test_bit_ldiff (m n k) : test_bit (ldiff m n) k = test_bit m k && bnot (test_bit n k) := +by rw [← bitwise_diff, test_bit_bitwise] + +@[simp] lemma test_bit_lxor (m n k) : test_bit (lxor m n) k = bxor (test_bit m k) (test_bit n k) := +by rw [← bitwise_xor, test_bit_bitwise] + +@[simp] lemma test_bit_lnot : ∀ n k, test_bit (lnot n) k = bnot (test_bit n k) +| (n : ℕ) k := by simp [lnot, test_bit] +| -[1+ n] k := by simp [lnot, test_bit] + +@[simp] lemma shiftl_neg (m n : ℤ) : shiftl m (-n) = shiftr m n := rfl +@[simp] lemma shiftr_neg (m n : ℤ) : shiftr m (-n) = shiftl m n := by rw [← shiftl_neg, neg_neg] + +@[simp] lemma shiftl_coe_nat (m n : ℕ) : shiftl m n = nat.shiftl m n := rfl +@[simp] lemma shiftr_coe_nat (m n : ℕ) : shiftr m n = nat.shiftr m n := by cases n; refl + +@[simp] lemma shiftl_neg_succ (m n : ℕ) : shiftl -[1+ m] n = -[1+ nat.shiftl' tt m n] := rfl +@[simp] +lemma shiftr_neg_succ (m n : ℕ) : shiftr -[1+ m] n = -[1+ nat.shiftr m n] := by cases n; refl + +lemma shiftr_add : ∀ (m : ℤ) (n k : ℕ), shiftr m (n + k) = shiftr (shiftr m n) k +| (m : ℕ) n k := by rw [shiftr_coe_nat, shiftr_coe_nat, + ← int.coe_nat_add, shiftr_coe_nat, nat.shiftr_add] +| -[1+ m] n k := by rw [shiftr_neg_succ, shiftr_neg_succ, + ← int.coe_nat_add, shiftr_neg_succ, nat.shiftr_add] + +/-! ### bitwise ops -/ + +local attribute [simp] int.zero_div + +lemma shiftl_add : ∀ (m : ℤ) (n : ℕ) (k : ℤ), shiftl m (n + k) = shiftl (shiftl m n) k +| (m : ℕ) n (k:ℕ) := congr_arg of_nat (nat.shiftl_add _ _ _) +| -[1+ m] n (k:ℕ) := congr_arg neg_succ_of_nat (nat.shiftl'_add _ _ _ _) +| (m : ℕ) n -[1+k] := sub_nat_nat_elim n k.succ + (λ n k i, shiftl ↑m i = nat.shiftr (nat.shiftl m n) k) + (λ i n, congr_arg coe $ + by rw [← nat.shiftl_sub, add_tsub_cancel_left]; apply nat.le_add_right) + (λ i n, congr_arg coe $ + by rw [add_assoc, nat.shiftr_add, ← nat.shiftl_sub, tsub_self]; refl) +| -[1+ m] n -[1+k] := sub_nat_nat_elim n k.succ + (λ n k i, shiftl -[1+ m] i = -[1+ nat.shiftr (nat.shiftl' tt m n) k]) + (λ i n, congr_arg neg_succ_of_nat $ + by rw [← nat.shiftl'_sub, add_tsub_cancel_left]; apply nat.le_add_right) + (λ i n, congr_arg neg_succ_of_nat $ + by rw [add_assoc, nat.shiftr_add, ← nat.shiftl'_sub, tsub_self]; refl) + +lemma shiftl_sub (m : ℤ) (n : ℕ) (k : ℤ) : shiftl m (n - k) = shiftr (shiftl m n) k := +shiftl_add _ _ _ + +lemma shiftl_eq_mul_pow : ∀ (m : ℤ) (n : ℕ), shiftl m n = m * ↑(2 ^ n) +| (m : ℕ) n := congr_arg coe (nat.shiftl_eq_mul_pow _ _) +| -[1+ m] n := @congr_arg ℕ ℤ _ _ (λi, -i) (nat.shiftl'_tt_eq_mul_pow _ _) + +lemma shiftr_eq_div_pow : ∀ (m : ℤ) (n : ℕ), shiftr m n = m / ↑(2 ^ n) +| (m : ℕ) n := by rw shiftr_coe_nat; exact congr_arg coe (nat.shiftr_eq_div_pow _ _) +| -[1+ m] n := begin + rw [shiftr_neg_succ, neg_succ_of_nat_div, nat.shiftr_eq_div_pow], refl, + exact coe_nat_lt_coe_nat_of_lt (pow_pos dec_trivial _) +end + +lemma one_shiftl (n : ℕ) : shiftl 1 n = (2 ^ n : ℕ) := +congr_arg coe (nat.one_shiftl _) + +@[simp] lemma zero_shiftl : ∀ n : ℤ, shiftl 0 n = 0 +| (n : ℕ) := congr_arg coe (nat.zero_shiftl _) +| -[1+ n] := congr_arg coe (nat.zero_shiftr _) + +@[simp] lemma zero_shiftr (n) : shiftr 0 n = 0 := zero_shiftl _ + +end int diff --git a/src/data/int/cast.lean b/src/data/int/cast.lean deleted file mode 100644 index 8a0be11ecfbf3..0000000000000 --- a/src/data/int/cast.lean +++ /dev/null @@ -1,379 +0,0 @@ -/- -Copyright (c) 2017 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import data.int.basic -import data.nat.cast - -/-! -# Cast of integers - -This file defines the *canonical* homomorphism from the integers into a type `α` with `0`, -`1`, `+` and `-` (typically a `ring`). - -## Main declarations - -* `cast`: Canonical homomorphism `ℤ → α` where `α` has a `0`, `1`, `+` and `-`. -* `cast_add_hom`: `cast` bundled as an `add_monoid_hom`. -* `cast_ring_hom`: `cast` bundled as a `ring_hom`. - -## Implementation note - -Setting up the coercions priorities is tricky. See Note [coercion into rings]. --/ - -open nat - -namespace int - -@[simp, push_cast] theorem nat_cast_eq_coe_nat : ∀ n, - @coe ℕ ℤ (@coe_to_lift _ _ nat.cast_coe) n = - @coe ℕ ℤ (@coe_to_lift _ _ (@coe_base _ _ int.has_coe)) n -| 0 := rfl -| (n+1) := congr_arg (+(1:ℤ)) (nat_cast_eq_coe_nat n) - -/-- Coercion `ℕ → ℤ` as a `ring_hom`. -/ -def of_nat_hom : ℕ →+* ℤ := ⟨coe, rfl, int.of_nat_mul, rfl, int.of_nat_add⟩ - -section cast -variables {α : Type*} - -section -variables [has_zero α] [has_one α] [has_add α] [has_neg α] - -/-- Canonical homomorphism from the integers to any ring(-like) structure `α` -/ -protected def cast : ℤ → α -| (n : ℕ) := n -| -[1+ n] := -(n+1) - --- see Note [coercion into rings] -@[priority 900] instance cast_coe : has_coe_t ℤ α := ⟨int.cast⟩ - -@[simp, norm_cast] theorem cast_zero : ((0 : ℤ) : α) = 0 := rfl - -theorem cast_of_nat (n : ℕ) : (of_nat n : α) = n := rfl -@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : α) = n := rfl -theorem cast_coe_nat' (n : ℕ) : - (@coe ℕ ℤ (@coe_to_lift _ _ nat.cast_coe) n : α) = n := -by simp - -@[simp, norm_cast] theorem cast_neg_succ_of_nat (n : ℕ) : (-[1+ n] : α) = -(n + 1) := rfl - -end - -@[simp, norm_cast] theorem cast_one [add_monoid α] [has_one α] [has_neg α] : - ((1 : ℤ) : α) = 1 := nat.cast_one - -@[simp] theorem cast_sub_nat_nat [add_group α] [has_one α] (m n) : - ((int.sub_nat_nat m n : ℤ) : α) = m - n := -begin - unfold sub_nat_nat, cases e : n - m, - { simp [sub_nat_nat, e, tsub_eq_zero_iff_le.mp e] }, - { rw [sub_nat_nat, cast_neg_succ_of_nat, ← nat.cast_succ, ← e, - nat.cast_sub $ _root_.le_of_lt $ nat.lt_of_sub_eq_succ e, neg_sub] }, -end - -@[simp, norm_cast] theorem cast_neg_of_nat [add_group α] [has_one α] : - ∀ n, ((neg_of_nat n : ℤ) : α) = -n -| 0 := neg_zero.symm -| (n+1) := rfl - -@[simp, norm_cast] theorem cast_add [add_group α] [has_one α] : ∀ m n, ((m + n : ℤ) : α) = m + n -| (m : ℕ) (n : ℕ) := nat.cast_add _ _ -| (m : ℕ) -[1+ n] := by simpa only [sub_eq_add_neg] using cast_sub_nat_nat _ _ -| -[1+ m] (n : ℕ) := (cast_sub_nat_nat _ _).trans $ sub_eq_of_eq_add $ - show (n:α) = -(m+1) + n + (m+1), - by rw [add_assoc, ← cast_succ, ← nat.cast_add, add_comm, - nat.cast_add, cast_succ, neg_add_cancel_left] -| -[1+ m] -[1+ n] := show -((m + n + 1 + 1 : ℕ) : α) = -(m + 1) + -(n + 1), - begin - rw [← neg_add_rev, ← nat.cast_add_one, ← nat.cast_add_one, ← nat.cast_add], - apply congr_arg (λ x:ℕ, -(x:α)), - ac_refl - end - -@[simp, norm_cast] theorem cast_neg [add_group α] [has_one α] : ∀ n, ((-n : ℤ) : α) = -n -| (n : ℕ) := cast_neg_of_nat _ -| -[1+ n] := (neg_neg _).symm - -@[simp, norm_cast] theorem cast_sub [add_group α] [has_one α] (m n) : ((m - n : ℤ) : α) = m - n := -by simp [sub_eq_add_neg] - -@[simp, norm_cast] theorem cast_mul [ring α] : ∀ m n, ((m * n : ℤ) : α) = m * n -| (m : ℕ) (n : ℕ) := nat.cast_mul _ _ -| (m : ℕ) -[1+ n] := (cast_neg_of_nat _).trans $ - show (-(m * (n + 1) : ℕ) : α) = m * -(n + 1), - by rw [nat.cast_mul, nat.cast_add_one, neg_mul_eq_mul_neg] -| -[1+ m] (n : ℕ) := (cast_neg_of_nat _).trans $ - show (-((m + 1) * n : ℕ) : α) = -(m + 1) * n, - by rw [nat.cast_mul, nat.cast_add_one, neg_mul_eq_neg_mul] -| -[1+ m] -[1+ n] := show (((m + 1) * (n + 1) : ℕ) : α) = -(m + 1) * -(n + 1), - by rw [nat.cast_mul, nat.cast_add_one, nat.cast_add_one, neg_mul_neg] - -@[simp] theorem cast_div [field α] {m n : ℤ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) : - ((m / n : ℤ) : α) = m / n := -begin - rcases n_dvd with ⟨k, rfl⟩, - have : n ≠ 0, { rintro rfl, simpa using n_nonzero }, - rw [int.mul_div_cancel_left _ this, int.cast_mul, mul_div_cancel_left _ n_nonzero], -end - -/-- `coe : ℤ → α` as an `add_monoid_hom`. -/ -def cast_add_hom (α : Type*) [add_group α] [has_one α] : ℤ →+ α := ⟨coe, cast_zero, cast_add⟩ - -@[simp] lemma coe_cast_add_hom [add_group α] [has_one α] : ⇑(cast_add_hom α) = coe := rfl - -/-- `coe : ℤ → α` as a `ring_hom`. -/ -def cast_ring_hom (α : Type*) [ring α] : ℤ →+* α := ⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩ - -@[simp] lemma coe_cast_ring_hom [ring α] : ⇑(cast_ring_hom α) = coe := rfl - -lemma cast_commute [ring α] (m : ℤ) (x : α) : commute ↑m x := -int.cases_on m (λ n, n.cast_commute x) (λ n, ((n+1).cast_commute x).neg_left) - -lemma cast_comm [ring α] (m : ℤ) (x : α) : (m : α) * x = x * m := -(cast_commute m x).eq - -lemma commute_cast [ring α] (x : α) (m : ℤ) : commute x m := -(m.cast_commute x).symm - -@[simp, norm_cast] -theorem coe_nat_bit0 (n : ℕ) : (↑(bit0 n) : ℤ) = bit0 ↑n := by {unfold bit0, simp} - -@[simp, norm_cast] -theorem coe_nat_bit1 (n : ℕ) : (↑(bit1 n) : ℤ) = bit1 ↑n := by {unfold bit1, unfold bit0, simp} - -@[simp, norm_cast] theorem cast_bit0 [ring α] (n : ℤ) : ((bit0 n : ℤ) : α) = bit0 n := cast_add _ _ - -@[simp, norm_cast] theorem cast_bit1 [ring α] (n : ℤ) : ((bit1 n : ℤ) : α) = bit1 n := -by rw [bit1, cast_add, cast_one, cast_bit0]; refl - -lemma cast_two [ring α] : ((2 : ℤ) : α) = 2 := by simp - -lemma cast_three [ring α] : ((3 : ℤ) : α) = 3 := by simp - -lemma cast_four [ring α] : ((4 : ℤ) : α) = 4 := by simp - -theorem cast_mono [ordered_ring α] : monotone (coe : ℤ → α) := -begin - intros m n h, - rw ← sub_nonneg at h, - lift n - m to ℕ using h with k, - rw [← sub_nonneg, ← cast_sub, ← h_1, cast_coe_nat], - exact k.cast_nonneg -end - -@[simp] theorem cast_nonneg [ordered_ring α] [nontrivial α] : ∀ {n : ℤ}, (0 : α) ≤ n ↔ 0 ≤ n -| (n : ℕ) := by simp -| -[1+ n] := have -(n:α) < 1, from lt_of_le_of_lt (by simp) zero_lt_one, - by simpa [(neg_succ_lt_zero n).not_le, ← sub_eq_add_neg, le_neg] using this.not_le - -@[simp, norm_cast] theorem cast_le [ordered_ring α] [nontrivial α] {m n : ℤ} : - (m : α) ≤ n ↔ m ≤ n := -by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg] - -theorem cast_strict_mono [ordered_ring α] [nontrivial α] : strict_mono (coe : ℤ → α) := -strict_mono_of_le_iff_le $ λ m n, cast_le.symm - -@[simp, norm_cast] theorem cast_lt [ordered_ring α] [nontrivial α] {m n : ℤ} : - (m : α) < n ↔ m < n := -cast_strict_mono.lt_iff_lt - -@[simp] theorem cast_nonpos [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) ≤ 0 ↔ n ≤ 0 := -by rw [← cast_zero, cast_le] - -@[simp] theorem cast_pos [ordered_ring α] [nontrivial α] {n : ℤ} : (0 : α) < n ↔ 0 < n := -by rw [← cast_zero, cast_lt] - -@[simp] theorem cast_lt_zero [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) < 0 ↔ n < 0 := -by rw [← cast_zero, cast_lt] - -section linear_ordered_ring - -variables [linear_ordered_ring α] {a b : ℤ} (n : ℤ) - -@[simp, norm_cast] theorem cast_min : (↑(min a b) : α) = min a b := -monotone.map_min cast_mono - -@[simp, norm_cast] theorem cast_max : (↑(max a b) : α) = max a b := -monotone.map_max cast_mono - -@[simp, norm_cast] theorem cast_abs : ((|a| : ℤ) : α) = |a| := -by simp [abs_eq_max_neg] - -lemma cast_one_le_of_pos (h : 0 < a) : (1 : α) ≤ a := -by exact_mod_cast int.add_one_le_of_lt h - -lemma cast_le_neg_one_of_neg (h : a < 0) : (a : α) ≤ -1 := -by exact_mod_cast int.le_sub_one_of_lt h - -lemma nneg_mul_add_sq_of_abs_le_one {x : α} (hx : |x| ≤ 1) : - (0 : α) ≤ n * x + n * n := -begin - have hnx : 0 < n → 0 ≤ x + n := λ hn, by - { convert add_le_add (neg_le_of_abs_le hx) (cast_one_le_of_pos hn), - rw add_left_neg, }, - have hnx' : n < 0 → x + n ≤ 0 := λ hn, by - { convert add_le_add (le_of_abs_le hx) (cast_le_neg_one_of_neg hn), - rw add_right_neg, }, - rw [← mul_add, mul_nonneg_iff], - rcases lt_trichotomy n 0 with h | rfl | h, - { exact or.inr ⟨by exact_mod_cast h.le, hnx' h⟩, }, - { simp [le_total 0 x], }, - { exact or.inl ⟨by exact_mod_cast h.le, hnx h⟩, }, -end - -lemma cast_nat_abs : (n.nat_abs : α) = |n| := -begin - cases n, - { simp, }, - { simp only [int.nat_abs, int.cast_neg_succ_of_nat, abs_neg, ← nat.cast_succ, nat.abs_cast], }, -end - -end linear_ordered_ring - -lemma coe_int_dvd [comm_ring α] (m n : ℤ) (h : m ∣ n) : - (m : α) ∣ (n : α) := -ring_hom.map_dvd (int.cast_ring_hom α) h - -end cast - -end int - -namespace prod - -variables {α : Type*} {β : Type*} [has_zero α] [has_one α] [has_add α] [has_neg α] - [has_zero β] [has_one β] [has_add β] [has_neg β] - -@[simp] lemma fst_int_cast (n : ℤ) : (n : α × β).fst = n := -by induction n; simp * - -@[simp] lemma snd_int_cast (n : ℤ) : (n : α × β).snd = n := -by induction n; simp * - -end prod - -open int - -namespace add_monoid_hom - -variables {A : Type*} - -/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal -if `f 1 = g 1`. -/ -@[ext] theorem ext_int [add_monoid A] {f g : ℤ →+ A} (h1 : f 1 = g 1) : f = g := -have f.comp (int.of_nat_hom : ℕ →+ ℤ) = g.comp (int.of_nat_hom : ℕ →+ ℤ) := ext_nat' _ _ h1, -have ∀ n : ℕ, f n = g n := ext_iff.1 this, -ext $ λ n, int.cases_on n this $ λ n, eq_on_neg (this $ n + 1) - -variables [add_group A] [has_one A] - -theorem eq_int_cast_hom (f : ℤ →+ A) (h1 : f 1 = 1) : f = int.cast_add_hom A := -ext_int $ by simp [h1] - -theorem eq_int_cast (f : ℤ →+ A) (h1 : f 1 = 1) : ∀ n : ℤ, f n = n := -ext_iff.1 (f.eq_int_cast_hom h1) - -end add_monoid_hom - -@[simp] lemma int.cast_add_hom_int : int.cast_add_hom ℤ = add_monoid_hom.id ℤ := -((add_monoid_hom.id ℤ).eq_int_cast_hom rfl).symm - -namespace monoid_hom -variables {M : Type*} [monoid M] -open multiplicative - -@[ext] theorem ext_mint {f g : multiplicative ℤ →* M} (h1 : f (of_add 1) = g (of_add 1)) : f = g := -monoid_hom.ext $ add_monoid_hom.ext_iff.mp $ - @add_monoid_hom.ext_int _ _ f.to_additive g.to_additive h1 - -/-- If two `monoid_hom`s agree on `-1` and the naturals then they are equal. -/ -@[ext] theorem ext_int {f g : ℤ →* M} - (h_neg_one : f (-1) = g (-1)) - (h_nat : f.comp int.of_nat_hom.to_monoid_hom = g.comp int.of_nat_hom.to_monoid_hom) : - f = g := -begin - ext (x | x), - { exact (monoid_hom.congr_fun h_nat x : _), }, - { rw [int.neg_succ_of_nat_eq, ← neg_one_mul, f.map_mul, g.map_mul], - congr' 1, - exact_mod_cast (monoid_hom.congr_fun h_nat (x + 1) : _), } -end - -end monoid_hom - -namespace monoid_with_zero_hom - -variables {M : Type*} [monoid_with_zero M] - -/-- If two `monoid_with_zero_hom`s agree on `-1` and the naturals then they are equal. -/ -@[ext] lemma ext_int {f g : ℤ →*₀ M} (h_neg_one : f (-1) = g (-1)) - (h_nat : f.comp int.of_nat_hom.to_monoid_with_zero_hom = - g.comp int.of_nat_hom.to_monoid_with_zero_hom) : - f = g := -to_monoid_hom_injective $ monoid_hom.ext_int h_neg_one $ monoid_hom.ext (congr_fun h_nat : _) - -/-- If two `monoid_with_zero_hom`s agree on `-1` and the _positive_ naturals then they are equal. -/ -lemma ext_int' {φ₁ φ₂ : ℤ →*₀ M} (h_neg_one : φ₁ (-1) = φ₂ (-1)) - (h_pos : ∀ n : ℕ, 0 < n → φ₁ n = φ₂ n) : φ₁ = φ₂ := -ext_int h_neg_one $ ext_nat h_pos - -end monoid_with_zero_hom - -namespace ring_hom - -variables {α : Type*} {β : Type*} [ring α] [ring β] - -@[simp] lemma eq_int_cast (f : ℤ →+* α) (n : ℤ) : f n = n := -f.to_add_monoid_hom.eq_int_cast f.map_one n - -lemma eq_int_cast' (f : ℤ →+* α) : f = int.cast_ring_hom α := -ring_hom.ext f.eq_int_cast - -@[simp] lemma map_int_cast (f : α →+* β) (n : ℤ) : f n = n := -(f.comp (int.cast_ring_hom α)).eq_int_cast n - -lemma ext_int {R : Type*} [semiring R] (f g : ℤ →+* R) : f = g := -coe_add_monoid_hom_injective $ add_monoid_hom.ext_int $ f.map_one.trans g.map_one.symm - -instance int.subsingleton_ring_hom {R : Type*} [semiring R] : subsingleton (ℤ →+* R) := -⟨ring_hom.ext_int⟩ - -end ring_hom - -@[simp, norm_cast] theorem int.cast_id (n : ℤ) : ↑n = n := -((ring_hom.id ℤ).eq_int_cast n).symm - -@[simp] lemma int.cast_ring_hom_int : int.cast_ring_hom ℤ = ring_hom.id ℤ := -(ring_hom.id ℤ).eq_int_cast'.symm - -namespace pi - -variables {α β : Type*} - -lemma int_apply [has_zero β] [has_one β] [has_add β] [has_neg β] : - ∀ (n : ℤ) (a : α), (n : α → β) a = n -| (n:ℕ) a := pi.nat_apply n a -| -[1+n] a := -by rw [cast_neg_succ_of_nat, cast_neg_succ_of_nat, neg_apply, add_apply, one_apply, nat_apply] - -@[simp] lemma coe_int [has_zero β] [has_one β] [has_add β] [has_neg β] (n : ℤ) : - (n : α → β) = λ _, n := -by { ext, rw pi.int_apply } - -end pi - -namespace mul_opposite - -variables {α : Type*} [has_zero α] [has_one α] [has_add α] [has_neg α] - -@[simp, norm_cast] lemma op_int_cast : ∀ z : ℤ, op (z : α) = z -| (n:ℕ) := op_nat_cast n -| -[1+n] := congr_arg (λ a : αᵐᵒᵖ, -(a + 1)) $ op_nat_cast n - -@[simp, norm_cast] lemma unop_int_cast : ∀ n : ℤ, unop (n : αᵐᵒᵖ) = n -| (n:ℕ) := unop_nat_cast n -| -[1+n] := congr_arg (λ a : α, -(a + 1)) $ unop_nat_cast n - -end mul_opposite diff --git a/src/data/int/cast/basic.lean b/src/data/int/cast/basic.lean new file mode 100644 index 0000000000000..32a9faf7c8004 --- /dev/null +++ b/src/data/int/cast/basic.lean @@ -0,0 +1,103 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Gabriel Ebner +-/ +import data.int.cast.defs +import algebra.group.basic + +/-! +# Cast of integers (additional theorems) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves additional properties about the *canonical* homomorphism from +the integers into an additive group with a one (`int.cast`). + +There is also `data.int.cast.lemmas`, +which includes lemmas stated in terms of algebraic homomorphisms, +and results involving the order structure of `ℤ`. + +By contrast, this file's only import beyond `data.int.cast.defs` is `algebra.group.basic`. +-/ + +universes u + +namespace nat +variables {R : Type u} [add_group_with_one R] + +@[simp, norm_cast] theorem cast_sub {m n} (h : m ≤ n) : ((n - m : ℕ) : R) = n - m := +eq_sub_of_add_eq $ by rw [← cast_add, nat.sub_add_cancel h] + +@[simp, norm_cast] theorem cast_pred : ∀ {n}, 0 < n → ((n - 1 : ℕ) : R) = n - 1 +| 0 h := by cases h +| (n+1) h := by rw [cast_succ, add_sub_cancel]; refl + +end nat + +open nat + +namespace int +variables {R : Type u} [add_group_with_one R] + +@[simp] theorem cast_neg_succ_of_nat (n : ℕ) : (-[1+ n] : R) = -(n + 1 : ℕ) := +add_group_with_one.int_cast_neg_succ_of_nat n + +@[simp, norm_cast] theorem cast_zero : ((0 : ℤ) : R) = 0 := (cast_of_nat 0).trans nat.cast_zero + +@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℤ) : R) = n := cast_of_nat _ + +@[simp, norm_cast] theorem cast_one : ((1 : ℤ) : R) = 1 := +show (((1 : ℕ) : ℤ) : R) = 1, by simp + +@[simp, norm_cast] theorem cast_neg : ∀ n, ((-n : ℤ) : R) = -n +| (0 : ℕ) := by erw [cast_zero, neg_zero] +| (n + 1 : ℕ) := by erw [cast_of_nat, cast_neg_succ_of_nat]; refl +| -[1+ n] := by erw [cast_of_nat, cast_neg_succ_of_nat, neg_neg] + +@[simp] theorem cast_sub_nat_nat (m n) : + ((int.sub_nat_nat m n : ℤ) : R) = m - n := +begin + unfold sub_nat_nat, cases e : n - m, + { simp only [sub_nat_nat, cast_of_nat], simp [e, nat.le_of_sub_eq_zero e] }, + { rw [sub_nat_nat, cast_neg_succ_of_nat, nat.add_one, ← e, + nat.cast_sub $ _root_.le_of_lt $ nat.lt_of_sub_eq_succ e, neg_sub] }, +end + +lemma neg_of_nat_eq (n : ℕ) : neg_of_nat n = -(n : ℤ) := by cases n; refl + +@[simp] theorem cast_neg_of_nat (n : ℕ) : ((neg_of_nat n : ℤ) : R) = -n := +by simp [neg_of_nat_eq] + +@[simp, norm_cast] theorem cast_add : ∀ m n, ((m + n : ℤ) : R) = m + n +| (m : ℕ) (n : ℕ) := by simp [← int.coe_nat_add] +| (m : ℕ) -[1+ n] := by erw [cast_sub_nat_nat, cast_coe_nat, cast_neg_succ_of_nat, sub_eq_add_neg] +| -[1+ m] (n : ℕ) := by erw [cast_sub_nat_nat, cast_coe_nat, cast_neg_succ_of_nat, + sub_eq_iff_eq_add, add_assoc, eq_neg_add_iff_add_eq, ← nat.cast_add, ← nat.cast_add, nat.add_comm] +| -[1+ m] -[1+ n] := show (-[1+ m + n + 1] : R) = _, + by rw [cast_neg_succ_of_nat, cast_neg_succ_of_nat, cast_neg_succ_of_nat, ← neg_add_rev, + ← nat.cast_add, nat.add_right_comm m n 1, nat.add_assoc, nat.add_comm] + +@[simp, norm_cast] theorem cast_sub (m n) : ((m - n : ℤ) : R) = m - n := +by simp [int.sub_eq_add_neg, sub_eq_add_neg] + +@[simp, norm_cast] +theorem coe_nat_bit0 (n : ℕ) : (↑(bit0 n) : ℤ) = bit0 ↑n := rfl + +@[simp, norm_cast] +theorem coe_nat_bit1 (n : ℕ) : (↑(bit1 n) : ℤ) = bit1 ↑n := rfl + +@[simp, norm_cast] theorem cast_bit0 (n : ℤ) : ((bit0 n : ℤ) : R) = bit0 n := +cast_add _ _ + +@[simp, norm_cast] theorem cast_bit1 (n : ℤ) : ((bit1 n : ℤ) : R) = bit1 n := +by rw [bit1, cast_add, cast_one, cast_bit0]; refl + +lemma cast_two : ((2 : ℤ) : R) = 2 := by simp + +lemma cast_three : ((3 : ℤ) : R) = 3 := by simp + +lemma cast_four : ((4 : ℤ) : R) = 4 := by simp + +end int diff --git a/src/data/int/cast/defs.lean b/src/data/int/cast/defs.lean new file mode 100644 index 0000000000000..ec6e9b20d5463 --- /dev/null +++ b/src/data/int/cast/defs.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Gabriel Ebner +-/ +import data.nat.cast.defs + +/-! +# Cast of integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the *canonical* homomorphism from the integers into an +additive group with a one (typically a `ring`). In additive groups with a one +element, there exists a unique such homomorphism and we store it in the +`int_cast : ℤ → R` field. + +Preferentially, the homomorphism is written as a coercion. + +## Main declarations + +* `int.cast`: Canonical homomorphism `ℤ → R`. +* `add_group_with_one`: Type class for `int.cast`. +-/ + +universes u +set_option old_structure_cmd true + +attribute [simp] int.of_nat_eq_coe + +/-- Default value for `add_group_with_one.int_cast`. -/ +protected def int.cast_def {R : Type u} [has_nat_cast R] [has_neg R] : ℤ → R +| (n : ℕ) := n +| -[1+ n] := -(n+1 : ℕ) + +/-- +Type class for the canonical homomorphism `ℤ → R`. +-/ +class has_int_cast (R : Type u) := +(int_cast : ℤ → R) + +/-- +An `add_group_with_one` is an `add_group` with a `1`. +It also contains data for the unique homomorphisms `ℕ → R` and `ℤ → R`. +-/ +@[protect_proj, ancestor has_int_cast add_group add_monoid_with_one] +class add_group_with_one (R : Type u) + extends has_int_cast R, add_group R, add_monoid_with_one R := +(int_cast := int.cast_def) +(int_cast_of_nat : ∀ n : ℕ, int_cast n = (n : R) . control_laws_tac) +(int_cast_neg_succ_of_nat : ∀ n : ℕ, int_cast (-(n+1 : ℕ)) = -((n+1 : ℕ) : R) . control_laws_tac) + +/-- An `add_comm_group_with_one` is an `add_group_with_one` satisfying `a + b = b + a`. -/ +@[protect_proj, ancestor add_comm_group add_group_with_one add_comm_monoid_with_one] +class add_comm_group_with_one (R : Type u) + extends add_comm_group R, add_group_with_one R, add_comm_monoid_with_one R + +/-- Canonical homomorphism from the integers to any ring(-like) structure `R` -/ +protected def int.cast {R : Type u} [has_int_cast R] (i : ℤ) : R := has_int_cast.int_cast i + +open nat + +namespace int +variables {R : Type u} [add_group_with_one R] + +-- see Note [coercion into rings] +@[priority 900] instance cast_coe {R} [has_int_cast R] : has_coe_t ℤ R := ⟨int.cast⟩ + +theorem cast_of_nat (n : ℕ) : (of_nat n : R) = n := add_group_with_one.int_cast_of_nat n + +end int diff --git a/src/data/int/cast/field.lean b/src/data/int/cast/field.lean new file mode 100644 index 0000000000000..30f364581d4bd --- /dev/null +++ b/src/data/int/cast/field.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bhavik Mehta +-/ +import data.int.cast.lemmas +import algebra.field.defs +import algebra.group_with_zero.units.lemmas + +/-! +# Cast of integers into fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file concerns the canonical homomorphism `ℤ → F`, where `F` is a field. + +## Main results + + * `int.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n` +-/ + +namespace int + +open nat +variables {α : Type*} + +/-- +Auxiliary lemma for norm_cast to move the cast `-↑n` upwards to `↑-↑n`. + +(The restriction to `division_ring` is necessary, otherwise this would also apply in the case where +`R = ℤ` and cause nontermination.) +-/ +@[norm_cast] +lemma cast_neg_nat_cast {R} [division_ring R] (n : ℕ) : ((-n : ℤ) : R) = -n := by simp + +@[simp] theorem cast_div [division_ring α] {m n : ℤ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) : + ((m / n : ℤ) : α) = m / n := +begin + rcases n_dvd with ⟨k, rfl⟩, + have : n ≠ 0, { rintro rfl, simpa using n_nonzero }, + rw [int.mul_div_cancel_left _ this, mul_comm n k, int.cast_mul, mul_div_cancel _ n_nonzero], +end + +end int diff --git a/src/data/int/cast/lemmas.lean b/src/data/int/cast/lemmas.lean new file mode 100644 index 0000000000000..88b021a9cab0c --- /dev/null +++ b/src/data/int/cast/lemmas.lean @@ -0,0 +1,311 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.int.order.basic +import data.nat.cast.basic + +/-! +# Cast of integers (additional theorems) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves additional properties about the *canonical* homomorphism from +the integers into an additive group with a one (`int.cast`), +particularly results involving algebraic homomorphisms or the order structure on `ℤ` +which were not available in the import dependencies of `data.int.cast.basic`. + +## Main declarations + +* `cast_add_hom`: `cast` bundled as an `add_monoid_hom`. +* `cast_ring_hom`: `cast` bundled as a `ring_hom`. +-/ + +open nat + +variables {F ι α β : Type*} + +namespace int + +/-- Coercion `ℕ → ℤ` as a `ring_hom`. -/ +def of_nat_hom : ℕ →+* ℤ := ⟨coe, rfl, int.of_nat_mul, rfl, int.of_nat_add⟩ + +@[simp] theorem coe_nat_pos {n : ℕ} : (0 : ℤ) < n ↔ 0 < n := nat.cast_pos + +lemma coe_nat_succ_pos (n : ℕ) : 0 < (n.succ : ℤ) := int.coe_nat_pos.2 (succ_pos n) + +lemma to_nat_lt {a : ℤ} {b : ℕ} (hb : b ≠ 0) : a.to_nat < b ↔ a < b := +by { rw [←to_nat_lt_to_nat, to_nat_coe_nat], exact coe_nat_pos.2 hb.bot_lt } + +lemma nat_mod_lt {a : ℤ} {b : ℕ} (hb : b ≠ 0) : a.nat_mod b < b := +(to_nat_lt hb).2 $ mod_lt_of_pos _ $ coe_nat_pos.2 hb.bot_lt + +section cast + +@[simp, norm_cast] theorem cast_mul [non_assoc_ring α] : ∀ m n, ((m * n : ℤ) : α) = m * n := +λ m, int.induction_on' m 0 (by simp) (λ k _ ih n, by simp [add_mul, ih]) + (λ k _ ih n, by simp [sub_mul, ih]) + +@[simp, norm_cast] theorem cast_ite [add_group_with_one α] (P : Prop) [decidable P] (m n : ℤ) : + ((ite P m n : ℤ) : α) = ite P m n := +apply_ite _ _ _ _ + +/-- `coe : ℤ → α` as an `add_monoid_hom`. -/ +def cast_add_hom (α : Type*) [add_group_with_one α] : ℤ →+ α := ⟨coe, cast_zero, cast_add⟩ + +@[simp] lemma coe_cast_add_hom [add_group_with_one α] : ⇑(cast_add_hom α) = coe := rfl + +/-- `coe : ℤ → α` as a `ring_hom`. -/ +def cast_ring_hom (α : Type*) [non_assoc_ring α] : ℤ →+* α := +⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩ + +@[simp] lemma coe_cast_ring_hom [non_assoc_ring α] : ⇑(cast_ring_hom α) = coe := rfl + +lemma cast_commute [non_assoc_ring α] : ∀ (m : ℤ) (x : α), commute ↑m x +| (n : ℕ) x := by simpa using n.cast_commute x +| -[1+ n] x := by simpa only [cast_neg_succ_of_nat, commute.neg_left_iff, commute.neg_right_iff] + using (n + 1).cast_commute (-x) + +lemma cast_comm [non_assoc_ring α] (m : ℤ) (x : α) : (m : α) * x = x * m := +(cast_commute m x).eq + +lemma commute_cast [non_assoc_ring α] (x : α) (m : ℤ) : commute x m := +(m.cast_commute x).symm + +theorem cast_mono [ordered_ring α] : monotone (coe : ℤ → α) := +begin + intros m n h, + rw ← sub_nonneg at h, + lift n - m to ℕ using h with k, + rw [← sub_nonneg, ← cast_sub, ← h_1, cast_coe_nat], + exact k.cast_nonneg +end + +@[simp] theorem cast_nonneg [ordered_ring α] [nontrivial α] : ∀ {n : ℤ}, (0 : α) ≤ n ↔ 0 ≤ n +| (n : ℕ) := by simp +| -[1+ n] := have -(n:α) < 1, from lt_of_le_of_lt (by simp) zero_lt_one, + by simpa [(neg_succ_lt_zero n).not_le, ← sub_eq_add_neg, le_neg] using this.not_le + +@[simp, norm_cast] theorem cast_le [ordered_ring α] [nontrivial α] {m n : ℤ} : + (m : α) ≤ n ↔ m ≤ n := +by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg] + +theorem cast_strict_mono [ordered_ring α] [nontrivial α] : strict_mono (coe : ℤ → α) := +strict_mono_of_le_iff_le $ λ m n, cast_le.symm + +@[simp, norm_cast] theorem cast_lt [ordered_ring α] [nontrivial α] {m n : ℤ} : + (m : α) < n ↔ m < n := +cast_strict_mono.lt_iff_lt + +@[simp] theorem cast_nonpos [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) ≤ 0 ↔ n ≤ 0 := +by rw [← cast_zero, cast_le] + +@[simp] theorem cast_pos [ordered_ring α] [nontrivial α] {n : ℤ} : (0 : α) < n ↔ 0 < n := +by rw [← cast_zero, cast_lt] + +@[simp] theorem cast_lt_zero [ordered_ring α] [nontrivial α] {n : ℤ} : (n : α) < 0 ↔ n < 0 := +by rw [← cast_zero, cast_lt] + +section linear_ordered_ring + +variables [linear_ordered_ring α] {a b : ℤ} (n : ℤ) + +@[simp, norm_cast] theorem cast_min : (↑(min a b) : α) = min a b := +monotone.map_min cast_mono + +@[simp, norm_cast] theorem cast_max : (↑(max a b) : α) = max a b := +monotone.map_max cast_mono + +@[simp, norm_cast] theorem cast_abs : ((|a| : ℤ) : α) = |a| := +by simp [abs_eq_max_neg] + +lemma cast_one_le_of_pos (h : 0 < a) : (1 : α) ≤ a := +by exact_mod_cast int.add_one_le_of_lt h + +lemma cast_le_neg_one_of_neg (h : a < 0) : (a : α) ≤ -1 := +begin + rw [← int.cast_one, ← int.cast_neg, cast_le], + exact int.le_sub_one_of_lt h, +end + +variables (α) {n} + +lemma cast_le_neg_one_or_one_le_cast_of_ne_zero (hn : n ≠ 0) : (n : α) ≤ -1 ∨ 1 ≤ (n : α) := +hn.lt_or_lt.imp cast_le_neg_one_of_neg cast_one_le_of_pos + +variables {α} (n) + +lemma nneg_mul_add_sq_of_abs_le_one {x : α} (hx : |x| ≤ 1) : + (0 : α) ≤ n * x + n * n := +begin + have hnx : 0 < n → 0 ≤ x + n := λ hn, by + { convert add_le_add (neg_le_of_abs_le hx) (cast_one_le_of_pos hn), + rw add_left_neg, }, + have hnx' : n < 0 → x + n ≤ 0 := λ hn, by + { convert add_le_add (le_of_abs_le hx) (cast_le_neg_one_of_neg hn), + rw add_right_neg, }, + rw [← mul_add, mul_nonneg_iff], + rcases lt_trichotomy n 0 with h | rfl | h, + { exact or.inr ⟨by exact_mod_cast h.le, hnx' h⟩, }, + { simp [le_total 0 x], }, + { exact or.inl ⟨by exact_mod_cast h.le, hnx h⟩, }, +end + +lemma cast_nat_abs : (n.nat_abs : α) = |n| := +begin + cases n, + { simp, }, + { simp only [int.nat_abs, int.cast_neg_succ_of_nat, abs_neg, ← nat.cast_succ, nat.abs_cast], }, +end + +end linear_ordered_ring + +lemma coe_int_dvd [comm_ring α] (m n : ℤ) (h : m ∣ n) : + (m : α) ∣ (n : α) := +ring_hom.map_dvd (int.cast_ring_hom α) h + +end cast + +end int + +open int + +namespace add_monoid_hom + +variables {A : Type*} + +/-- Two additive monoid homomorphisms `f`, `g` from `ℤ` to an additive monoid are equal +if `f 1 = g 1`. -/ +@[ext] theorem ext_int [add_monoid A] {f g : ℤ →+ A} (h1 : f 1 = g 1) : f = g := +have f.comp (int.of_nat_hom : ℕ →+ ℤ) = g.comp (int.of_nat_hom : ℕ →+ ℤ) := ext_nat' _ _ h1, +have ∀ n : ℕ, f n = g n := ext_iff.1 this, +ext $ λ n, int.cases_on n this $ λ n, eq_on_neg _ _ (this $ n + 1) + +variables [add_group_with_one A] + +theorem eq_int_cast_hom (f : ℤ →+ A) (h1 : f 1 = 1) : f = int.cast_add_hom A := +ext_int $ by simp [h1] + +end add_monoid_hom + +lemma eq_int_cast' [add_group_with_one α] [add_monoid_hom_class F ℤ α] (f : F) (h₁ : f 1 = 1) : + ∀ n : ℤ, f n = n := +add_monoid_hom.ext_iff.1 $ (f : ℤ →+ α).eq_int_cast_hom h₁ + +@[simp] lemma int.cast_add_hom_int : int.cast_add_hom ℤ = add_monoid_hom.id ℤ := +((add_monoid_hom.id ℤ).eq_int_cast_hom rfl).symm + +namespace monoid_hom +variables {M : Type*} [monoid M] +open multiplicative + +@[ext] theorem ext_mint {f g : multiplicative ℤ →* M} (h1 : f (of_add 1) = g (of_add 1)) : f = g := +monoid_hom.ext $ add_monoid_hom.ext_iff.mp $ + @add_monoid_hom.ext_int _ _ f.to_additive g.to_additive h1 + +/-- If two `monoid_hom`s agree on `-1` and the naturals then they are equal. -/ +@[ext] theorem ext_int {f g : ℤ →* M} + (h_neg_one : f (-1) = g (-1)) + (h_nat : f.comp int.of_nat_hom.to_monoid_hom = g.comp int.of_nat_hom.to_monoid_hom) : + f = g := +begin + ext (x | x), + { exact (monoid_hom.congr_fun h_nat x : _), }, + { rw [int.neg_succ_of_nat_eq, ← neg_one_mul, f.map_mul, g.map_mul], + congr' 1, + exact_mod_cast (monoid_hom.congr_fun h_nat (x + 1) : _), } +end + +end monoid_hom + +namespace monoid_with_zero_hom + +variables {M : Type*} [monoid_with_zero M] + +/-- If two `monoid_with_zero_hom`s agree on `-1` and the naturals then they are equal. -/ +@[ext] lemma ext_int {f g : ℤ →*₀ M} (h_neg_one : f (-1) = g (-1)) + (h_nat : f.comp int.of_nat_hom.to_monoid_with_zero_hom = + g.comp int.of_nat_hom.to_monoid_with_zero_hom) : + f = g := +to_monoid_hom_injective $ monoid_hom.ext_int h_neg_one $ monoid_hom.ext (congr_fun h_nat : _) + +end monoid_with_zero_hom + +/-- If two `monoid_with_zero_hom`s agree on `-1` and the _positive_ naturals then they are equal. -/ +lemma ext_int' [monoid_with_zero α] [monoid_with_zero_hom_class F ℤ α] {f g : F} + (h_neg_one : f (-1) = g (-1)) (h_pos : ∀ n : ℕ, 0 < n → f n = g n) : f = g := +fun_like.ext _ _ $ λ n, by { have := fun_like.congr_fun (@monoid_with_zero_hom.ext_int _ _ + (f : ℤ →*₀ α) (g : ℤ →*₀ α) h_neg_one $ monoid_with_zero_hom.ext_nat h_pos) n, exact this } + +section non_assoc_ring +variables [non_assoc_ring α] [non_assoc_ring β] + +@[simp] lemma eq_int_cast [ring_hom_class F ℤ α] (f : F) (n : ℤ) : f n = n := +eq_int_cast' f (map_one _) n + +@[simp] lemma map_int_cast [ring_hom_class F α β] (f : F) (n : ℤ) : f n = n := +eq_int_cast ((f : α →+* β).comp (int.cast_ring_hom α)) n + +namespace ring_hom + +lemma eq_int_cast' (f : ℤ →+* α) : f = int.cast_ring_hom α := ring_hom.ext $ eq_int_cast f + +lemma ext_int {R : Type*} [non_assoc_semiring R] (f g : ℤ →+* R) : f = g := +coe_add_monoid_hom_injective $ add_monoid_hom.ext_int $ f.map_one.trans g.map_one.symm + +instance int.subsingleton_ring_hom {R : Type*} [non_assoc_semiring R] : subsingleton (ℤ →+* R) := +⟨ring_hom.ext_int⟩ + +end ring_hom +end non_assoc_ring + +@[simp, norm_cast] lemma int.cast_id (n : ℤ) : ↑n = n := (eq_int_cast (ring_hom.id ℤ) _).symm + +@[simp] lemma int.cast_ring_hom_int : int.cast_ring_hom ℤ = ring_hom.id ℤ := +(ring_hom.id ℤ).eq_int_cast'.symm + +namespace pi +variables {π : ι → Type*} [Π i, has_int_cast (π i)] + +instance : has_int_cast (Π i, π i) := +by refine_struct { .. }; tactic.pi_instance_derive_field + +lemma int_apply (n : ℤ) (i : ι) : (n : Π i, π i) i = n := rfl + +@[simp] lemma coe_int (n : ℤ) : (n : Π i, π i) = λ _, n := rfl + +end pi + +lemma sum.elim_int_cast_int_cast {α β γ : Type*} [has_int_cast γ] (n : ℤ) : + sum.elim (n : α → γ) (n : β → γ) = n := +@sum.elim_lam_const_lam_const α β γ n + +namespace pi +variables {π : ι → Type*} [Π i, add_group_with_one (π i)] + +instance : add_group_with_one (Π i, π i) := +by refine_struct { .. }; tactic.pi_instance_derive_field + +end pi + +/-! ### Order dual -/ + +open order_dual + +instance [h : has_int_cast α] : has_int_cast αᵒᵈ := h +instance [h : add_group_with_one α] : add_group_with_one αᵒᵈ := h +instance [h : add_comm_group_with_one α] : add_comm_group_with_one αᵒᵈ := h + +@[simp] lemma to_dual_int_cast [has_int_cast α] (n : ℤ) : to_dual (n : α) = n := rfl +@[simp] lemma of_dual_int_cast [has_int_cast α] (n : ℤ) : (of_dual n : α) = n := rfl + +/-! ### Lexicographic order -/ + +instance [h : has_int_cast α] : has_int_cast (lex α) := h +instance [h : add_group_with_one α] : add_group_with_one (lex α) := h +instance [h : add_comm_group_with_one α] : add_comm_group_with_one (lex α) := h + +@[simp] lemma to_lex_int_cast [has_int_cast α] (n : ℤ) : to_lex (n : α) = n := rfl +@[simp] lemma of_lex_int_cast [has_int_cast α] (n : ℤ) : (of_lex n : α) = n := rfl diff --git a/src/data/int/cast/prod.lean b/src/data/int/cast/prod.lean new file mode 100644 index 0000000000000..ab51bcbacc89d --- /dev/null +++ b/src/data/int/cast/prod.lean @@ -0,0 +1,30 @@ +/- +Copyright (c) 2017 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.int.cast.lemmas +import data.nat.cast.prod + +/-! +# The product of two `add_group_with_one`s. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +namespace prod + +variables {α β : Type*} [add_group_with_one α] [add_group_with_one β] + +instance : add_group_with_one (α × β) := +{ int_cast := λ n, (n, n), + int_cast_of_nat := λ _, by simp; refl, + int_cast_neg_succ_of_nat := λ _, by simp; refl, + .. prod.add_monoid_with_one, .. prod.add_group } + +@[simp] lemma fst_int_cast (n : ℤ) : (n : α × β).fst = n := rfl + +@[simp] lemma snd_int_cast (n : ℤ) : (n : α × β).snd = n := rfl + +end prod diff --git a/src/data/int/char_zero.lean b/src/data/int/char_zero.lean index f8209451f13cb..a233cbca4adb6 100644 --- a/src/data/int/char_zero.lean +++ b/src/data/int/char_zero.lean @@ -3,11 +3,13 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.int.cast -import algebra.char_zero +import data.int.cast.field /-! -# Injectivity of `int.cast` into characteristic zero rings. +# Injectivity of `int.cast` into characteristic zero rings and fields. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ @@ -18,25 +20,31 @@ open nat namespace int @[simp] -theorem cast_eq_zero [add_group α] [has_one α] [char_zero α] {n : ℤ} : (n : α) = 0 ↔ n = 0 := +theorem cast_eq_zero [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) = 0 ↔ n = 0 := ⟨λ h, begin cases n, - { exact congr_arg coe (nat.cast_eq_zero.1 h) }, - { rw [cast_neg_succ_of_nat, neg_eq_zero, ← cast_succ, nat.cast_eq_zero] at h, + { rw [int.cast_of_nat] at h, exact congr_arg coe (nat.cast_eq_zero.1 h) }, + { rw [cast_neg_succ_of_nat, neg_eq_zero, nat.cast_eq_zero] at h, contradiction } end, λ h, by rw [h, cast_zero]⟩ -@[simp, norm_cast] theorem cast_inj [add_group α] [has_one α] [char_zero α] {m n : ℤ} : +@[simp, norm_cast] theorem cast_inj [add_group_with_one α] [char_zero α] {m n : ℤ} : (m : α) = n ↔ m = n := by rw [← sub_eq_zero, ← cast_sub, cast_eq_zero, sub_eq_zero] -theorem cast_injective [add_group α] [has_one α] [char_zero α] : function.injective (coe : ℤ → α) +theorem cast_injective [add_group_with_one α] [char_zero α] : function.injective (coe : ℤ → α) | m n := cast_inj.1 -theorem cast_ne_zero [add_group α] [has_one α] [char_zero α] {n : ℤ} : (n : α) ≠ 0 ↔ n ≠ 0 := +theorem cast_ne_zero [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) ≠ 0 ↔ n ≠ 0 := not_congr cast_eq_zero +@[simp] lemma cast_eq_one [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) = 1 ↔ n = 1 := +by rw [←cast_one, cast_inj] + +lemma cast_ne_one [add_group_with_one α] [char_zero α] {n : ℤ} : (n : α) ≠ 1 ↔ n ≠ 1 := +cast_eq_one.not + @[simp, norm_cast] -theorem cast_div_char_zero {k : Type*} [field k] [char_zero k] {m n : ℤ} +theorem cast_div_char_zero {k : Type*} [division_ring k] [char_zero k] {m n : ℤ} (n_dvd : n ∣ m) : ((m / n : ℤ) : k) = m / n := begin rcases eq_or_ne n 0 with rfl | hn, @@ -46,6 +54,6 @@ end end int -lemma ring_hom.injective_int {α : Type*} [ring α] (f : ℤ →+* α) [char_zero α] : +lemma ring_hom.injective_int {α : Type*} [non_assoc_ring α] (f : ℤ →+* α) [char_zero α] : function.injective f := subsingleton.elim (int.cast_ring_hom _) f ▸ int.cast_injective diff --git a/src/data/int/conditionally_complete_order.lean b/src/data/int/conditionally_complete_order.lean new file mode 100644 index 0000000000000..63efc9885b7e2 --- /dev/null +++ b/src/data/int/conditionally_complete_order.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2021 Floris van Doorn. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn +-/ +import order.conditionally_complete_lattice.basic +import data.int.least_greatest + +/-! +## `ℤ` forms a conditionally complete linear order + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The integers form a conditionally complete linear order. +-/ + +open int +open_locale classical +noncomputable theory + +instance : conditionally_complete_linear_order ℤ := +{ Sup := λ s, if h : s.nonempty ∧ bdd_above s then + greatest_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0, + Inf := λ s, if h : s.nonempty ∧ bdd_below s then + least_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0, + le_cSup := begin + intros s n hs hns, + have : s.nonempty ∧ bdd_above s := ⟨⟨n, hns⟩, hs⟩, + rw [dif_pos this], + exact (greatest_of_bdd _ _ _).2.2 n hns + end, + cSup_le := begin + intros s n hs hns, + have : s.nonempty ∧ bdd_above s := ⟨hs, ⟨n, hns⟩⟩, + rw [dif_pos this], + exact hns (greatest_of_bdd _ (classical.some_spec this.2) _).2.1 + end, + cInf_le := begin + intros s n hs hns, + have : s.nonempty ∧ bdd_below s := ⟨⟨n, hns⟩, hs⟩, + rw [dif_pos this], + exact (least_of_bdd _ _ _).2.2 n hns + end, + le_cInf := begin + intros s n hs hns, + have : s.nonempty ∧ bdd_below s := ⟨hs, ⟨n, hns⟩⟩, + rw [dif_pos this], + exact hns (least_of_bdd _ (classical.some_spec this.2) _).2.1 + end, + .. int.linear_order, ..linear_order.to_lattice } + +namespace int + +lemma cSup_eq_greatest_of_bdd {s : set ℤ} [decidable_pred (∈ s)] + (b : ℤ) (Hb : ∀ z ∈ s, z ≤ b) (Hinh : ∃ z : ℤ, z ∈ s) : + Sup s = greatest_of_bdd b Hb Hinh := +begin + convert dif_pos _ using 1, + { convert coe_greatest_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_above s)) _ }, + { exact ⟨Hinh, b, Hb⟩, } +end + +@[simp] +lemma cSup_empty : Sup (∅ : set ℤ) = 0 := dif_neg (by simp) + +lemma cSup_of_not_bdd_above {s : set ℤ} (h : ¬ bdd_above s) : Sup s = 0 := dif_neg (by simp [h]) + +lemma cInf_eq_least_of_bdd {s : set ℤ} [decidable_pred (∈ s)] + (b : ℤ) (Hb : ∀ z ∈ s, b ≤ z) (Hinh : ∃ z : ℤ, z ∈ s) : + Inf s = least_of_bdd b Hb Hinh := +begin + convert dif_pos _ using 1, + { convert coe_least_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_below s)) _ }, + { exact ⟨Hinh, b, Hb⟩, } +end + +@[simp] +lemma cInf_empty : Inf (∅ : set ℤ) = 0 := dif_neg (by simp) + +lemma cInf_of_not_bdd_below {s : set ℤ} (h : ¬ bdd_below s) : Inf s = 0 := dif_neg (by simp [h]) + +lemma cSup_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_above s) : Sup s ∈ s := +begin + convert (greatest_of_bdd _ (classical.some_spec h2) h1).2.1, + exact dif_pos ⟨h1, h2⟩, +end + +lemma cInf_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_below s) : Inf s ∈ s := +begin + convert (least_of_bdd _ (classical.some_spec h2) h1).2.1, + exact dif_pos ⟨h1, h2⟩, +end + +end int diff --git a/src/data/int/div.lean b/src/data/int/div.lean new file mode 100644 index 0000000000000..9b44e3a92579a --- /dev/null +++ b/src/data/int/div.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.int.dvd.basic +import data.nat.order.lemmas +import algebra.ring.regular + +/-! +# Lemmas relating `/` in `ℤ` with the ordering. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open nat + +namespace int + +theorem eq_mul_div_of_mul_eq_mul_of_dvd_left {a b c d : ℤ} (hb : b ≠ 0) (hbc : b ∣ c) + (h : b * a = c * d) : + a = c / b * d := +begin + cases hbc with k hk, + subst hk, + rw [int.mul_div_cancel_left _ hb], + rw mul_assoc at h, + apply mul_left_cancel₀ hb h +end + +/-- If an integer with larger absolute value divides an integer, it is +zero. -/ +lemma eq_zero_of_dvd_of_nat_abs_lt_nat_abs {a b : ℤ} (w : a ∣ b) (h : nat_abs b < nat_abs a) : + b = 0 := +begin + rw [←nat_abs_dvd, ←dvd_nat_abs, coe_nat_dvd] at w, + rw ←nat_abs_eq_zero, + exact eq_zero_of_dvd_of_lt w h +end + +lemma eq_zero_of_dvd_of_nonneg_of_lt {a b : ℤ} (w₁ : 0 ≤ a) (w₂ : a < b) (h : b ∣ a) : a = 0 := +eq_zero_of_dvd_of_nat_abs_lt_nat_abs h (nat_abs_lt_nat_abs_of_nonneg_of_lt w₁ w₂) + +/-- If two integers are congruent to a sufficiently large modulus, +they are equal. -/ +lemma eq_of_mod_eq_of_nat_abs_sub_lt_nat_abs {a b c : ℤ} (h1 : a % b = c) + (h2 : nat_abs (a - c) < nat_abs b) : + a = c := +eq_of_sub_eq_zero (eq_zero_of_dvd_of_nat_abs_lt_nat_abs (dvd_sub_of_mod_eq h1) h2) + +theorem of_nat_add_neg_succ_of_nat_of_ge {m n : ℕ} + (h : n.succ ≤ m) : of_nat m + -[1+n] = of_nat (m - n.succ) := +begin + change sub_nat_nat _ _ = _, + have h' : n.succ - m = 0, + apply tsub_eq_zero_iff_le.mpr h, + simp [*, sub_nat_nat] +end + +lemma nat_abs_le_of_dvd_ne_zero {s t : ℤ} (hst : s ∣ t) (ht : t ≠ 0) : nat_abs s ≤ nat_abs t := +not_lt.mp (mt (eq_zero_of_dvd_of_nat_abs_lt_nat_abs hst) ht) + +end int diff --git a/src/data/int/dvd/basic.lean b/src/data/int/dvd/basic.lean new file mode 100644 index 0000000000000..8b1da123a6620 --- /dev/null +++ b/src/data/int/dvd/basic.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.int.order.basic +import data.nat.cast.basic + +/-! +# Basic lemmas about the divisibility relation in `ℤ`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open nat + +namespace int + +@[norm_cast] theorem coe_nat_dvd {m n : ℕ} : (↑m : ℤ) ∣ ↑n ↔ m ∣ n := +⟨λ ⟨a, ae⟩, m.eq_zero_or_pos.elim + (λm0, by simp [m0] at ae; simp [ae, m0]) + (λm0l, by + { cases eq_coe_of_zero_le (@nonneg_of_mul_nonneg_right ℤ _ m a + (by simp [ae.symm]) (by simpa using m0l)) with k e, + subst a, exact ⟨k, int.coe_nat_inj ae⟩ }), + λ ⟨k, e⟩, dvd.intro k $ by rw [e, int.coe_nat_mul]⟩ + +theorem coe_nat_dvd_left {n : ℕ} {z : ℤ} : (↑n : ℤ) ∣ z ↔ n ∣ z.nat_abs := +by rcases nat_abs_eq z with eq | eq; rw eq; simp [←coe_nat_dvd] + +theorem coe_nat_dvd_right {n : ℕ} {z : ℤ} : z ∣ (↑n : ℤ) ↔ z.nat_abs ∣ n := +by rcases nat_abs_eq z with eq | eq; rw eq; simp [←coe_nat_dvd] + +theorem le_of_dvd {a b : ℤ} (bpos : 0 < b) (H : a ∣ b) : a ≤ b := +match a, b, eq_succ_of_zero_lt bpos, H with +| (m : ℕ), ._, ⟨n, rfl⟩, H := coe_nat_le_coe_nat_of_le $ + nat.le_of_dvd n.succ_pos $ coe_nat_dvd.1 H +| -[1+ m], ._, ⟨n, rfl⟩, _ := + le_trans (le_of_lt $ neg_succ_lt_zero _) (coe_zero_le _) +end + +theorem eq_one_of_dvd_one {a : ℤ} (H : 0 ≤ a) (H' : a ∣ 1) : a = 1 := +match a, eq_coe_of_zero_le H, H' with +| ._, ⟨n, rfl⟩, H' := congr_arg coe $ + nat.eq_one_of_dvd_one $ coe_nat_dvd.1 H' +end + +theorem eq_one_of_mul_eq_one_right {a b : ℤ} (H : 0 ≤ a) (H' : a * b = 1) : a = 1 := +eq_one_of_dvd_one H ⟨b, H'.symm⟩ + +theorem eq_one_of_mul_eq_one_left {a b : ℤ} (H : 0 ≤ b) (H' : a * b = 1) : b = 1 := +eq_one_of_mul_eq_one_right H (by rw [mul_comm, H']) + +theorem dvd_antisymm {a b : ℤ} (H1 : 0 ≤ a) (H2 : 0 ≤ b) : a ∣ b → b ∣ a → a = b := +begin + rw [← abs_of_nonneg H1, ← abs_of_nonneg H2, abs_eq_nat_abs, abs_eq_nat_abs], + rw [coe_nat_dvd, coe_nat_dvd, coe_nat_inj'], + apply nat.dvd_antisymm +end + +end int diff --git a/src/data/int/dvd/pow.lean b/src/data/int/dvd/pow.lean new file mode 100644 index 0000000000000..aab19316e3ea5 --- /dev/null +++ b/src/data/int/dvd/pow.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.int.dvd.basic +import data.nat.pow + +/-! +# Basic lemmas about the divisibility relation in `ℤ` involving powers. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +open nat + +namespace int + +@[simp] +theorem sign_pow_bit1 (k : ℕ) : ∀ n : ℤ, n.sign ^ (bit1 k) = n.sign +| (n+1:ℕ) := one_pow (bit1 k) +| 0 := zero_pow (nat.zero_lt_bit1 k) +| -[1+ n] := (neg_pow_bit1 1 k).trans (congr_arg (λ x, -x) (one_pow (bit1 k))) + +--TODO: Do we really need this lemma? +lemma pow_dvd_of_le_of_pow_dvd {p m n : ℕ} {k : ℤ} (hmn : m ≤ n) (hdiv : ↑(p ^ n) ∣ k) : + ↑(p ^ m) ∣ k := +(pow_dvd_pow _ hmn).nat_cast.trans hdiv + +lemma dvd_of_pow_dvd {p k : ℕ} {m : ℤ} (hk : 1 ≤ k) (hpk : ↑(p^k) ∣ m) : ↑p ∣ m := +(dvd_pow_self _ $ pos_iff_ne_zero.1 hk).nat_cast.trans hpk + +end int diff --git a/src/data/int/gcd.lean b/src/data/int/gcd.lean index fd2612cb1d56a..e05c44e65c5e4 100644 --- a/src/data/int/gcd.lean +++ b/src/data/int/gcd.lean @@ -3,12 +3,15 @@ Copyright (c) 2018 Guy Leroy. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Sangwoo Jo (aka Jason), Guy Leroy, Johannes Hölzl, Mario Carneiro -/ -import data.nat.prime -import data.int.order +import data.nat.gcd.basic +import tactic.norm_num /-! # Extended GCD and divisibility over ℤ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * Given `x y : ℕ`, `xgcd x y` computes the pair of integers `(a, b)` such that @@ -160,31 +163,12 @@ begin ... = nat_abs a / nat_abs b : by rw int.div_mul_cancel H, end -lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : nat.prime p) {m n : ℤ} {k l : ℕ} - (hpm : ↑(p ^ k) ∣ m) - (hpn : ↑(p ^ l) ∣ n) (hpmn : ↑(p ^ (k+l+1)) ∣ m*n) : ↑(p ^ (k+1)) ∣ m ∨ ↑(p ^ (l+1)) ∣ n := -have hpm' : p ^ k ∣ m.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpm, -have hpn' : p ^ l ∣ n.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpn, -have hpmn' : (p ^ (k+l+1)) ∣ m.nat_abs*n.nat_abs, - by rw ←int.nat_abs_mul; apply (int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpmn), -let hsd := nat.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hpm' hpn' hpmn' in -hsd.elim - (λ hsd1, or.inl begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd1 end) - (λ hsd2, or.inr begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd2 end) - theorem dvd_of_mul_dvd_mul_left {i j k : ℤ} (k_non_zero : k ≠ 0) (H : k * i ∣ k * j) : i ∣ j := dvd.elim H (λl H1, by rw mul_assoc at H1; exact ⟨_, mul_left_cancel₀ k_non_zero H1⟩) theorem dvd_of_mul_dvd_mul_right {i j k : ℤ} (k_non_zero : k ≠ 0) (H : i * k ∣ j * k) : i ∣ j := by rw [mul_comm i k, mul_comm j k] at H; exact dvd_of_mul_dvd_mul_left k_non_zero H -lemma prime.dvd_nat_abs_of_coe_dvd_sq {p : ℕ} (hp : p.prime) (k : ℤ) (h : ↑p ∣ k ^ 2) : - p ∣ k.nat_abs := -begin - apply @nat.prime.dvd_of_dvd_pow _ _ 2 hp, - rwa [sq, ← nat_abs_mul, ← coe_nat_dvd_left, ← sq] -end - /-- ℤ specific version of least common multiple. -/ def lcm (i j : ℤ) : ℕ := nat.lcm (nat_abs i) (nat_abs j) @@ -218,17 +202,23 @@ theorem gcd_assoc (i j k : ℤ) : gcd (gcd i j) k = gcd i (gcd j k) := nat.gcd_a @[simp] theorem gcd_one_right (i : ℤ) : gcd i 1 = 1 := nat.gcd_one_right _ +@[simp] lemma gcd_neg_right {x y : ℤ} : gcd x (-y) = gcd x y := +by rw [int.gcd, int.gcd, nat_abs_neg] + +@[simp] lemma gcd_neg_left {x y : ℤ} : gcd (-x) y = gcd x y := +by rw [int.gcd, int.gcd, nat_abs_neg] + theorem gcd_mul_left (i j k : ℤ) : gcd (i * j) (i * k) = nat_abs i * gcd j k := by { rw [int.gcd, int.gcd, nat_abs_mul, nat_abs_mul], apply nat.gcd_mul_left } theorem gcd_mul_right (i j k : ℤ) : gcd (i * j) (k * j) = gcd i k * nat_abs j := by { rw [int.gcd, int.gcd, nat_abs_mul, nat_abs_mul], apply nat.gcd_mul_right } -theorem gcd_pos_of_non_zero_left {i : ℤ} (j : ℤ) (i_non_zero : i ≠ 0) : 0 < gcd i j := -nat.gcd_pos_of_pos_left (nat_abs j) (nat_abs_pos_of_ne_zero i_non_zero) +theorem gcd_pos_of_ne_zero_left {i : ℤ} (j : ℤ) (hi : i ≠ 0) : 0 < gcd i j := +nat.gcd_pos_of_pos_left _ $ nat_abs_pos_of_ne_zero hi -theorem gcd_pos_of_non_zero_right (i : ℤ) {j : ℤ} (j_non_zero : j ≠ 0) : 0 < gcd i j := -nat.gcd_pos_of_pos_right (nat_abs i) (nat_abs_pos_of_ne_zero j_non_zero) +theorem gcd_pos_of_ne_zero_right (i : ℤ) {j : ℤ} (hj : j ≠ 0) : 0 < gcd i j := +nat.gcd_pos_of_pos_right _ $ nat_abs_pos_of_ne_zero hj theorem gcd_eq_zero_iff {i j : ℤ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := begin @@ -349,7 +339,7 @@ theorem gcd_least_linear {a b : ℤ} (ha : a ≠ 0) : begin simp_rw ←gcd_dvd_iff, split, - { simpa [and_true, dvd_refl, set.mem_set_of_eq] using gcd_pos_of_non_zero_left b ha }, + { simpa [and_true, dvd_refl, set.mem_set_of_eq] using gcd_pos_of_ne_zero_left b ha }, { simp only [lower_bounds, and_imp, set.mem_set_of_eq], exact λ n hn_pos hn, nat.le_of_dvd hn_pos hn }, end @@ -397,8 +387,7 @@ lemma pow_gcd_eq_one {M : Type*} [monoid M] (x : M) {m n : ℕ} (hm : x ^ m = 1) x ^ m.gcd n = 1 := begin cases m, { simp only [hn, nat.gcd_zero_left] }, - obtain ⟨x, rfl⟩ : is_unit x, - { apply is_unit_of_pow_eq_one _ _ hm m.succ_pos }, + lift x to Mˣ using is_unit_of_pow_eq_one hm m.succ_ne_zero, simp only [← units.coe_pow] at *, rw [← units.coe_one, ← zpow_coe_nat, ← units.ext_iff] at *, simp only [nat.gcd_eq_gcd_ab, zpow_add, zpow_mul, hm, hn, one_zpow, one_mul] @@ -451,7 +440,7 @@ lemma nat_gcd_helper_1 (d x y a b u v tx ty : ℕ) (hu : d * u = x) (hv : d * v lemma nat_lcm_helper (x y d m n : ℕ) (hd : nat.gcd x y = d) (d0 : 0 < d) (xy : x * y = n) (dm : d * m = n) : nat.lcm x y = m := -(nat.mul_right_inj d0).1 $ by rw [dm, ← xy, ← hd, nat.gcd_mul_lcm] +mul_right_injective₀ d0.ne' $ by rw [dm, ← xy, ← hd, nat.gcd_mul_lcm] lemma nat_coprime_helper_zero_left (x : ℕ) (h : 1 < x) : ¬ nat.coprime 0 x := mt (nat.coprime_zero_left _).1 $ ne_of_gt h diff --git a/src/data/int/interval.lean b/src/data/int/interval.lean index a85e73fcf9c52..4b0c1c7b84641 100644 --- a/src/data/int/interval.lean +++ b/src/data/int/interval.lean @@ -3,14 +3,16 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import data.int.basic -import algebra.char_zero +import algebra.char_zero.lemmas import order.locally_finite import data.finset.locally_finite /-! # Finite intervals of integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves that `ℤ` is a `locally_finite_order` and calculates the cardinality of its intervals as finsets and fintypes. -/ @@ -28,7 +30,7 @@ instance : locally_finite_order ℤ := nat.cast_embedding.trans $ add_left_embedding (a + 1), finset_mem_Icc := λ a b x, begin simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply, - nat.cast_embedding_apply, add_left_embedding_apply, nat_cast_eq_coe_nat], + nat.cast_embedding_apply, add_left_embedding_apply], split, { rintro ⟨a, h, rfl⟩, rw [lt_sub_iff_add_lt, int.lt_add_one_iff, add_comm] at h, @@ -41,7 +43,7 @@ instance : locally_finite_order ℤ := end, finset_mem_Ico := λ a b x, begin simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply, - nat.cast_embedding_apply, add_left_embedding_apply, nat_cast_eq_coe_nat], + nat.cast_embedding_apply, add_left_embedding_apply], split, { rintro ⟨a, h, rfl⟩, exact ⟨int.le.intro rfl, lt_sub_iff_add_lt'.mp h⟩ }, @@ -52,7 +54,7 @@ instance : locally_finite_order ℤ := end, finset_mem_Ioc := λ a b x, begin simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply, - nat.cast_embedding_apply, add_left_embedding_apply, nat_cast_eq_coe_nat], + nat.cast_embedding_apply, add_left_embedding_apply], split, { rintro ⟨a, h, rfl⟩, rw [←add_one_le_iff, le_sub_iff_add_le', add_comm _ (1 : ℤ), ←add_assoc] at h, @@ -64,7 +66,7 @@ instance : locally_finite_order ℤ := end, finset_mem_Ioo := λ a b x, begin simp_rw [mem_map, exists_prop, mem_range, int.lt_to_nat, function.embedding.trans_apply, - nat.cast_embedding_apply, add_left_embedding_apply, nat_cast_eq_coe_nat], + nat.cast_embedding_apply, add_left_embedding_apply], split, { rintro ⟨a, h, rfl⟩, rw [sub_sub, lt_sub_iff_add_lt'] at h, @@ -90,18 +92,18 @@ lemma Ioc_eq_finset_map : lemma Ioo_eq_finset_map : Ioo a b = (finset.range (b - a - 1).to_nat).map (nat.cast_embedding.trans $ add_left_embedding (a + 1)) := rfl +lemma uIcc_eq_finset_map : uIcc a b = (range (max a b + 1 - min a b).to_nat).map + (nat.cast_embedding.trans $ add_left_embedding $ min a b) := rfl -@[simp] lemma card_Icc : (Icc a b).card = (b + 1 - a).to_nat := -by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] } - -@[simp] lemma card_Ico : (Ico a b).card = (b - a).to_nat := -by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] } +@[simp] lemma card_Icc : (Icc a b).card = (b + 1 - a).to_nat := (card_map _).trans $ card_range _ +@[simp] lemma card_Ico : (Ico a b).card = (b - a).to_nat := (card_map _).trans $ card_range _ +@[simp] lemma card_Ioc : (Ioc a b).card = (b - a).to_nat := (card_map _).trans $ card_range _ +@[simp] lemma card_Ioo : (Ioo a b).card = (b - a - 1).to_nat := (card_map _).trans $ card_range _ -@[simp] lemma card_Ioc : (Ioc a b).card = (b - a).to_nat := -by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] } - -@[simp] lemma card_Ioo : (Ioo a b).card = (b - a - 1).to_nat := -by { change (finset.map _ _).card = _, rw [finset.card_map, finset.card_range] } +@[simp] lemma card_uIcc : (uIcc a b).card = (b - a).nat_abs + 1 := +(card_map _).trans $ int.coe_nat_inj $ by rw [card_range, sup_eq_max, inf_eq_min, + int.to_nat_of_nonneg (sub_nonneg_of_le $ le_add_one min_le_max), int.coe_nat_add, int.coe_nat_abs, + add_comm, add_sub_assoc, max_sub_min_eq_abs, add_comm, int.coe_nat_one] lemma card_Icc_of_le (h : a ≤ b + 1) : ((Icc a b).card : ℤ) = b + 1 - a := by rw [card_Icc, to_nat_sub_of_le h] @@ -127,6 +129,9 @@ by rw [←card_Ioc, fintype.card_of_finset] @[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = (b - a - 1).to_nat := by rw [←card_Ioo, fintype.card_of_finset] +@[simp] lemma card_fintype_uIcc : fintype.card (set.uIcc a b) = (b - a).nat_abs + 1 := +by rw [←card_uIcc, fintype.card_of_finset] + lemma card_fintype_Icc_of_le (h : a ≤ b + 1) : (fintype.card (set.Icc a b) : ℤ) = b + 1 - a := by rw [card_fintype_Icc, to_nat_sub_of_le h] diff --git a/src/data/int/least_greatest.lean b/src/data/int/least_greatest.lean index ad8f0861ed120..f9d07dcc6c83d 100644 --- a/src/data/int/least_greatest.lean +++ b/src/data/int/least_greatest.lean @@ -3,9 +3,13 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad, Mario Carneiro -/ -import data.int.basic +import data.int.order.basic + /-! # Least upper bound and greatest lower bound properties for integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that a bounded above nonempty set of integers has the greatest element, and a counterpart of this statement for the least element. diff --git a/src/data/int/lemmas.lean b/src/data/int/lemmas.lean new file mode 100644 index 0000000000000..f3192a3f8d971 --- /dev/null +++ b/src/data/int/lemmas.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.set.function +import data.int.order.lemmas +import data.int.bitwise +import data.nat.cast.basic +import data.nat.order.lemmas + +/-! +# Miscellaneous lemmas about the integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains lemmas about integers, which require further imports than +`data.int.basic` or `data.int.order`. + +-/ + +open nat + +namespace int + +lemma le_coe_nat_sub (m n : ℕ) : + (m - n : ℤ) ≤ ↑(m - n : ℕ) := +begin + by_cases h: m ≥ n, + { exact le_of_eq (int.coe_nat_sub h).symm }, + { simp [le_of_not_ge h, coe_nat_le] } +end + +/-! ### succ and pred -/ + +@[simp] lemma succ_coe_nat_pos (n : ℕ) : 0 < (n : ℤ) + 1 := +lt_add_one_iff.mpr (by simp) + +/-! ### nat abs -/ + +variables {a b : ℤ} {n : ℕ} + +lemma nat_abs_eq_iff_sq_eq {a b : ℤ} : a.nat_abs = b.nat_abs ↔ a ^ 2 = b ^ 2 := +by { rw [sq, sq], exact nat_abs_eq_iff_mul_self_eq } + +lemma nat_abs_lt_iff_sq_lt {a b : ℤ} : a.nat_abs < b.nat_abs ↔ a ^ 2 < b ^ 2 := +by { rw [sq, sq], exact nat_abs_lt_iff_mul_self_lt } + +lemma nat_abs_le_iff_sq_le {a b : ℤ} : a.nat_abs ≤ b.nat_abs ↔ a ^ 2 ≤ b ^ 2 := +by { rw [sq, sq], exact nat_abs_le_iff_mul_self_le } + +lemma nat_abs_inj_of_nonneg_of_nonneg {a b : ℤ} (ha : 0 ≤ a) (hb : 0 ≤ b) : + nat_abs a = nat_abs b ↔ a = b := +by rw [←sq_eq_sq ha hb, ←nat_abs_eq_iff_sq_eq] + +lemma nat_abs_inj_of_nonpos_of_nonpos {a b : ℤ} (ha : a ≤ 0) (hb : b ≤ 0) : + nat_abs a = nat_abs b ↔ a = b := +by simpa only [int.nat_abs_neg, neg_inj] + using nat_abs_inj_of_nonneg_of_nonneg + (neg_nonneg_of_nonpos ha) (neg_nonneg_of_nonpos hb) + +lemma nat_abs_inj_of_nonneg_of_nonpos {a b : ℤ} (ha : 0 ≤ a) (hb : b ≤ 0) : + nat_abs a = nat_abs b ↔ a = -b := +by simpa only [int.nat_abs_neg] + using nat_abs_inj_of_nonneg_of_nonneg ha (neg_nonneg_of_nonpos hb) + +lemma nat_abs_inj_of_nonpos_of_nonneg {a b : ℤ} (ha : a ≤ 0) (hb : 0 ≤ b) : + nat_abs a = nat_abs b ↔ -a = b := +by simpa only [int.nat_abs_neg] + using nat_abs_inj_of_nonneg_of_nonneg (neg_nonneg_of_nonpos ha) hb + +section intervals +open set + +lemma strict_mono_on_nat_abs : strict_mono_on nat_abs (Ici 0) := +λ a ha b hb hab, nat_abs_lt_nat_abs_of_nonneg_of_lt ha hab + +lemma strict_anti_on_nat_abs : strict_anti_on nat_abs (Iic 0) := +λ a ha b hb hab, by simpa [int.nat_abs_neg] + using nat_abs_lt_nat_abs_of_nonneg_of_lt (right.nonneg_neg_iff.mpr hb) (neg_lt_neg_iff.mpr hab) + +lemma inj_on_nat_abs_Ici : inj_on nat_abs (Ici 0) := strict_mono_on_nat_abs.inj_on + +lemma inj_on_nat_abs_Iic : inj_on nat_abs (Iic 0) := strict_anti_on_nat_abs.inj_on + +end intervals + +/-! ### to_nat -/ + +lemma to_nat_of_nonpos : ∀ {z : ℤ}, z ≤ 0 → z.to_nat = 0 +| 0 _ := rfl +| (n + 1 : ℕ) h := (h.not_lt (by simp)).elim +| -[1+ n] _ := rfl + + +/-! ### bitwise ops + +This lemma is orphaned from `data.int.bitwise` as it also requires material from `data.int.order`. +-/ + +local attribute [simp] int.zero_div + +@[simp] lemma div2_bit (b n) : div2 (bit b n) = n := +begin + rw [bit_val, div2_val, add_comm, int.add_mul_div_left, (_ : (_/2:ℤ) = 0), zero_add], + cases b, + { simp }, + { show of_nat _ = _, rw nat.div_eq_zero; simp }, + { cc } +end + +end int diff --git a/src/data/int/log.lean b/src/data/int/log.lean new file mode 100644 index 0000000000000..2ce1f2a995695 --- /dev/null +++ b/src/data/int/log.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.order.floor +import data.nat.log + +/-! +# Integer logarithms in a field with respect to a natural base + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines two `ℤ`-valued analogs of the logarithm of `r : R` with base `b : ℕ`: + +* `int.log b r`: Lower logarithm, or floor **log**. Greatest `k` such that `↑b^k ≤ r`. +* `int.clog b r`: Upper logarithm, or **c**eil **log**. Least `k` such that `r ≤ ↑b^k`. + +Note that `int.log` gives the position of the left-most non-zero digit: +```lean +#eval (int.log 10 (0.09 : ℚ), int.log 10 (0.10 : ℚ), int.log 10 (0.11 : ℚ)) +-- (-2, -1, -1) +#eval (int.log 10 (9 : ℚ), int.log 10 (10 : ℚ), int.log 10 (11 : ℚ)) +-- (0, 1, 1) +``` +which means it can be used for computing digit expansions +```lean +import data.fin.vec_notation + +def digits (b : ℕ) (q : ℚ) (n : ℕ) : ℕ := +⌊q*b^(↑n - int.log b q)⌋₊ % b + +#eval digits 10 (1/7) ∘ (coe : fin 8 → ℕ) +-- ![1, 4, 2, 8, 5, 7, 1, 4] +``` + +## Main results + +* For `int.log`: + * `int.zpow_log_le_self`, `int.lt_zpow_succ_log_self`: the bounds formed by `int.log`, + `(b : R) ^ log b r ≤ r < (b : R) ^ (log b r + 1)`. + * `int.zpow_log_gi`: the galois coinsertion between `zpow` and `int.log`. +* For `int.clog`: + * `int.zpow_pred_clog_lt_self`, `int.self_le_zpow_clog`: the bounds formed by `int.clog`, + `(b : R) ^ (clog b r - 1) < r ≤ (b : R) ^ clog b r`. + * `int.clog_zpow_gi`: the galois insertion between `int.clog` and `zpow`. +* `int.neg_log_inv_eq_clog`, `int.neg_clog_inv_eq_log`: the link between the two definitions. +-/ + +variables {R : Type*} [linear_ordered_semifield R] [floor_semiring R] + +namespace int + +/-- The greatest power of `b` such that `b ^ log b r ≤ r`. -/ +def log (b : ℕ) (r : R) : ℤ := +if 1 ≤ r then + nat.log b ⌊r⌋₊ +else + -nat.clog b ⌈r⁻¹⌉₊ + +lemma log_of_one_le_right (b : ℕ) {r : R} (hr : 1 ≤ r) : log b r = nat.log b ⌊r⌋₊ := +if_pos hr + +lemma log_of_right_le_one (b : ℕ) {r : R} (hr : r ≤ 1) : log b r = -nat.clog b ⌈r⁻¹⌉₊ := +begin + obtain rfl | hr := hr.eq_or_lt, + { rw [log, if_pos hr, inv_one, nat.ceil_one, nat.floor_one, nat.log_one_right, nat.clog_one_right, + int.coe_nat_zero, neg_zero], }, + { exact if_neg hr.not_le } +end + +@[simp, norm_cast] lemma log_nat_cast (b : ℕ) (n : ℕ) : log b (n : R) = nat.log b n := +begin + cases n, + { simp [log_of_right_le_one _ _, nat.log_zero_right] }, + { have : 1 ≤ (n.succ : R) := by simp, + simp [log_of_one_le_right _ this, ←nat.cast_succ] } +end + +lemma log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (r : R) : log b r = 0 := +begin + cases le_total 1 r, + { rw [log_of_one_le_right _ h, nat.log_of_left_le_one hb, int.coe_nat_zero] }, + { rw [log_of_right_le_one _ h, nat.clog_of_left_le_one hb, int.coe_nat_zero, neg_zero] }, +end + +lemma log_of_right_le_zero (b : ℕ) {r : R} (hr : r ≤ 0) : log b r = 0 := +by rw [log_of_right_le_one _ (hr.trans zero_le_one), + nat.clog_of_right_le_one ((nat.ceil_eq_zero.mpr $ inv_nonpos.2 hr).trans_le zero_le_one), + int.coe_nat_zero, neg_zero] + +lemma zpow_log_le_self {b : ℕ} {r : R} (hb : 1 < b) (hr : 0 < r) : + (b : R) ^ log b r ≤ r := +begin + cases le_total 1 r with hr1 hr1, + { rw log_of_one_le_right _ hr1, + rw [zpow_coe_nat, ← nat.cast_pow, ← nat.le_floor_iff hr.le], + exact nat.pow_log_le_self b (nat.floor_pos.mpr hr1).ne' }, + { rw [log_of_right_le_one _ hr1, zpow_neg, zpow_coe_nat, ← nat.cast_pow], + exact inv_le_of_inv_le hr (nat.ceil_le.1 $ nat.le_pow_clog hb _) }, +end + +lemma lt_zpow_succ_log_self {b : ℕ} (hb : 1 < b) (r : R) : + r < (b : R) ^ (log b r + 1) := +begin + cases le_or_lt r 0 with hr hr, + { rw [log_of_right_le_zero _ hr, zero_add, zpow_one], + exact hr.trans_lt (zero_lt_one.trans_le $ by exact_mod_cast hb.le) }, + cases le_or_lt 1 r with hr1 hr1, + { rw log_of_one_le_right _ hr1, + rw [int.coe_nat_add_one_out, zpow_coe_nat, ←nat.cast_pow], + apply nat.lt_of_floor_lt, + exact nat.lt_pow_succ_log_self hb _, }, + { rw log_of_right_le_one _ hr1.le, + have hcri : 1 < r⁻¹ := one_lt_inv hr hr1, + have : 1 ≤ nat.clog b ⌈r⁻¹⌉₊ := + nat.succ_le_of_lt (nat.clog_pos hb $ nat.one_lt_cast.1 $ hcri.trans_le (nat.le_ceil _)), + rw [neg_add_eq_sub, ←neg_sub, ←int.coe_nat_one, ← int.coe_nat_sub this, + zpow_neg, zpow_coe_nat, lt_inv hr (pow_pos (nat.cast_pos.mpr $ zero_lt_one.trans hb) _), + ←nat.cast_pow], + refine nat.lt_ceil.1 _, + exact (nat.pow_pred_clog_lt_self hb $ nat.one_lt_cast.1 $ hcri.trans_le $ nat.le_ceil _), } +end + +@[simp] lemma log_zero_right (b : ℕ) : log b (0 : R) = 0 := +log_of_right_le_zero b le_rfl + +@[simp] lemma log_one_right (b : ℕ) : log b (1 : R) = 0 := +by rw [log_of_one_le_right _ le_rfl, nat.floor_one, nat.log_one_right, int.coe_nat_zero] + +lemma log_zpow {b : ℕ} (hb : 1 < b) (z : ℤ) : log b (b ^ z : R) = z := +begin + obtain ⟨n, rfl | rfl⟩ := z.eq_coe_or_neg, + { rw [log_of_one_le_right _ (one_le_zpow_of_nonneg _ $ int.coe_nat_nonneg _), + zpow_coe_nat, ←nat.cast_pow, nat.floor_coe, nat.log_pow hb], + exact_mod_cast hb.le, }, + { rw [log_of_right_le_one _ (zpow_le_one_of_nonpos _ $ neg_nonpos.mpr (int.coe_nat_nonneg _)), + zpow_neg, inv_inv, zpow_coe_nat, ←nat.cast_pow, nat.ceil_nat_cast, nat.clog_pow _ _ hb], + exact_mod_cast hb.le, }, +end + +@[mono] lemma log_mono_right {b : ℕ} {r₁ r₂ : R} (h₀ : 0 < r₁) (h : r₁ ≤ r₂) : + log b r₁ ≤ log b r₂ := +begin + cases le_or_lt b 1 with hb hb, + { rw [log_of_left_le_one hb, log_of_left_le_one hb], }, + cases le_total r₁ 1 with h₁ h₁; cases le_total r₂ 1 with h₂ h₂, + { rw [log_of_right_le_one _ h₁, log_of_right_le_one _ h₂, neg_le_neg_iff, int.coe_nat_le], + exact nat.clog_mono_right _ (nat.ceil_mono $ inv_le_inv_of_le h₀ h), }, + { rw [log_of_right_le_one _ h₁, log_of_one_le_right _ h₂], + exact (neg_nonpos.mpr (int.coe_nat_nonneg _)).trans (int.coe_nat_nonneg _) }, + { obtain rfl := le_antisymm h (h₂.trans h₁), refl, }, + { rw [log_of_one_le_right _ h₁, log_of_one_le_right _ h₂, int.coe_nat_le], + exact nat.log_mono_right (nat.floor_mono h), }, +end + +variables (R) + +/-- Over suitable subtypes, `zpow` and `int.log` form a galois coinsertion -/ +def zpow_log_gi {b : ℕ} (hb : 1 < b) : + galois_coinsertion + (λ z : ℤ, subtype.mk ((b : R) ^ z) $ zpow_pos_of_pos (by exact_mod_cast zero_lt_one.trans hb) z) + (λ r : set.Ioi (0 : R), int.log b (r : R)) := +galois_coinsertion.monotone_intro + (λ r₁ r₂, log_mono_right r₁.prop) + (λ z₁ z₂ hz, subtype.coe_le_coe.mp $ (zpow_strict_mono $ by exact_mod_cast hb).monotone hz) + (λ r, subtype.coe_le_coe.mp $ zpow_log_le_self hb r.prop) + (λ _, log_zpow hb _) + +variables {R} + +/-- `zpow b` and `int.log b` (almost) form a Galois connection. -/ +lemma lt_zpow_iff_log_lt {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) : + r < (b : R) ^ x ↔ log b r < x := +@galois_connection.lt_iff_lt _ _ _ _ _ _ (zpow_log_gi R hb).gc x ⟨r, hr⟩ + +/-- `zpow b` and `int.log b` (almost) form a Galois connection. -/ +lemma zpow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) : + (b : R) ^ x ≤ r ↔ x ≤ log b r := +@galois_connection.le_iff_le _ _ _ _ _ _ (zpow_log_gi R hb).gc x ⟨r, hr⟩ + +/-- The least power of `b` such that `r ≤ b ^ log b r`. -/ +def clog (b : ℕ) (r : R) : ℤ := +if 1 ≤ r then + nat.clog b ⌈r⌉₊ +else + -nat.log b ⌊r⁻¹⌋₊ + +lemma clog_of_one_le_right (b : ℕ) {r : R} (hr : 1 ≤ r) : clog b r = nat.clog b ⌈r⌉₊ := +if_pos hr + +lemma clog_of_right_le_one (b : ℕ) {r : R} (hr : r ≤ 1) : clog b r = -nat.log b ⌊r⁻¹⌋₊ := +begin + obtain rfl | hr := hr.eq_or_lt, + { rw [clog, if_pos hr, inv_one, nat.ceil_one, nat.floor_one, nat.log_one_right, + nat.clog_one_right, int.coe_nat_zero, neg_zero], }, + { exact if_neg hr.not_le } +end + +lemma clog_of_right_le_zero (b : ℕ) {r : R} (hr : r ≤ 0) : clog b r = 0 := +begin + rw [clog, if_neg (hr.trans_lt zero_lt_one).not_le, neg_eq_zero, int.coe_nat_eq_zero, + nat.log_eq_zero_iff], + cases le_or_lt b 1 with hb hb, + { exact or.inr hb }, + { refine or.inl (lt_of_le_of_lt _ hb), + exact nat.floor_le_one_of_le_one ((inv_nonpos.2 hr).trans zero_le_one) }, +end + +@[simp] lemma clog_inv (b : ℕ) (r : R) : clog b r⁻¹ = -log b r := +begin + cases lt_or_le 0 r with hrp hrp, + { obtain hr | hr := le_total 1 r, + { rw [clog_of_right_le_one _ (inv_le_one hr), log_of_one_le_right _ hr, inv_inv] }, + { rw [clog_of_one_le_right _ (one_le_inv hrp hr), log_of_right_le_one _ hr, neg_neg] }, }, + { rw [clog_of_right_le_zero _ (inv_nonpos.mpr hrp), log_of_right_le_zero _ hrp, neg_zero], }, +end + +@[simp] lemma log_inv (b : ℕ) (r : R) : log b r⁻¹ = -clog b r := +by rw [←inv_inv r, clog_inv, neg_neg, inv_inv] + +-- note this is useful for writing in reverse +lemma neg_log_inv_eq_clog (b : ℕ) (r : R) : -log b r⁻¹ = clog b r := +by rw [log_inv, neg_neg] + +lemma neg_clog_inv_eq_log (b : ℕ) (r : R) : -clog b r⁻¹ = log b r := +by rw [clog_inv, neg_neg] + +@[simp, norm_cast] lemma clog_nat_cast (b : ℕ) (n : ℕ) : clog b (n : R) = nat.clog b n := +begin + cases n, + { simp [clog_of_right_le_one _ _, nat.clog_zero_right] }, + { have : 1 ≤ (n.succ : R) := by simp, + simp [clog_of_one_le_right _ this, ←nat.cast_succ] } +end + +lemma clog_of_left_le_one {b : ℕ} (hb : b ≤ 1) (r : R) : clog b r = 0 := +by rw [←neg_log_inv_eq_clog, log_of_left_le_one hb, neg_zero] + +lemma self_le_zpow_clog {b : ℕ} (hb : 1 < b) (r : R) : r ≤ (b : R) ^ clog b r := +begin + cases le_or_lt r 0 with hr hr, + { rw [clog_of_right_le_zero _ hr, zpow_zero], + exact hr.trans zero_le_one }, + rw [←neg_log_inv_eq_clog, zpow_neg, le_inv hr (zpow_pos_of_pos _ _)], + { exact zpow_log_le_self hb (inv_pos.mpr hr), }, + { exact nat.cast_pos.mpr (zero_le_one.trans_lt hb), }, +end + +lemma zpow_pred_clog_lt_self {b : ℕ} {r : R} (hb : 1 < b) (hr : 0 < r) : + (b : R) ^ (clog b r - 1) < r := +begin + rw [←neg_log_inv_eq_clog, ←neg_add', zpow_neg, inv_lt _ hr], + { exact lt_zpow_succ_log_self hb _, }, + { exact zpow_pos_of_pos (nat.cast_pos.mpr $ zero_le_one.trans_lt hb) _ } +end + +@[simp] lemma clog_zero_right (b : ℕ) : clog b (0 : R) = 0 := +clog_of_right_le_zero _ le_rfl + +@[simp] lemma clog_one_right (b : ℕ) : clog b (1 : R) = 0 := +by rw [clog_of_one_le_right _ le_rfl, nat.ceil_one, nat.clog_one_right, int.coe_nat_zero] + +lemma clog_zpow {b : ℕ} (hb : 1 < b) (z : ℤ) : clog b (b ^ z : R) = z := +by rw [←neg_log_inv_eq_clog, ←zpow_neg, log_zpow hb, neg_neg] + +@[mono] lemma clog_mono_right {b : ℕ} {r₁ r₂ : R} (h₀ : 0 < r₁) (h : r₁ ≤ r₂) : + clog b r₁ ≤ clog b r₂ := +begin + rw [←neg_log_inv_eq_clog, ←neg_log_inv_eq_clog, neg_le_neg_iff], + exact log_mono_right (inv_pos.mpr $ h₀.trans_le h) (inv_le_inv_of_le h₀ h), +end + +variables (R) +/-- Over suitable subtypes, `int.clog` and `zpow` form a galois insertion -/ +def clog_zpow_gi {b : ℕ} (hb : 1 < b) : + galois_insertion + (λ r : set.Ioi (0 : R), int.clog b (r : R)) + (λ z : ℤ, ⟨(b : R) ^ z, zpow_pos_of_pos (by exact_mod_cast zero_lt_one.trans hb) z⟩) := +galois_insertion.monotone_intro + (λ z₁ z₂ hz, subtype.coe_le_coe.mp $ (zpow_strict_mono $ by exact_mod_cast hb).monotone hz) + (λ r₁ r₂, clog_mono_right r₁.prop) + (λ r, subtype.coe_le_coe.mp $ self_le_zpow_clog hb _) + (λ _, clog_zpow hb _) +variables {R} + +/-- `int.clog b` and `zpow b` (almost) form a Galois connection. -/ +lemma zpow_lt_iff_lt_clog {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) : + (b : R) ^ x < r ↔ x < clog b r := +(@galois_connection.lt_iff_lt _ _ _ _ _ _ (clog_zpow_gi R hb).gc ⟨r, hr⟩ x).symm + +/-- `int.clog b` and `zpow b` (almost) form a Galois connection. -/ +lemma le_zpow_iff_clog_le {b : ℕ} (hb : 1 < b) {x : ℤ} {r : R} (hr : 0 < r) : + r ≤ (b : R) ^ x ↔ clog b r ≤ x := +(@galois_connection.le_iff_le _ _ _ _ _ _ (clog_zpow_gi R hb).gc ⟨r, hr⟩ x).symm + +end int diff --git a/src/data/int/modeq.lean b/src/data/int/modeq.lean index 3fd8d7e07c7b1..0476b3250506c 100644 --- a/src/data/int/modeq.lean +++ b/src/data/int/modeq.lean @@ -10,6 +10,9 @@ import tactic.ring # Congruences modulo an integer +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the equivalence relation `a ≡ b [ZMOD n]` on the integers, similarly to how `data.nat.modeq` defines them for the natural numbers. The notation is short for `n.modeq a b`, which is defined to be `a % n = b % n` for integers `a b n`. @@ -36,12 +39,18 @@ namespace modeq protected theorem rfl : a ≡ a [ZMOD n] := modeq.refl _ +instance : is_refl _ (modeq n) := ⟨modeq.refl⟩ + @[symm] protected theorem symm : a ≡ b [ZMOD n] → b ≡ a [ZMOD n] := eq.symm @[trans] protected theorem trans : a ≡ b [ZMOD n] → b ≡ c [ZMOD n] → a ≡ c [ZMOD n] := eq.trans +protected lemma eq : a ≡ b [ZMOD n] → a % n = b % n := id + end modeq +lemma modeq_comm : a ≡ b [ZMOD n] ↔ b ≡ a [ZMOD n] := ⟨modeq.symm, modeq.symm⟩ + lemma coe_nat_modeq_iff {a b n : ℕ} : a ≡ b [ZMOD n] ↔ a ≡ b [MOD n] := by unfold modeq nat.modeq; rw ← int.coe_nat_eq_coe_nat_iff; simp [coe_nat_mod] @@ -53,26 +62,39 @@ lemma _root_.has_dvd.dvd.zero_modeq_int (h : n ∣ a) : 0 ≡ a [ZMOD n] := h.mo theorem modeq_iff_dvd : a ≡ b [ZMOD n] ↔ n ∣ b - a := by rw [modeq, eq_comm]; - simp [mod_eq_mod_iff_mod_sub_eq_zero, dvd_iff_mod_eq_zero, -euclidean_domain.mod_eq_zero] + simp [mod_eq_mod_iff_mod_sub_eq_zero, dvd_iff_mod_eq_zero] + +theorem modeq_iff_add_fac {a b n : ℤ} : a ≡ b [ZMOD n] ↔ ∃ t, b = a + n * t := +begin + rw modeq_iff_dvd, + exact exists_congr (λ t, sub_eq_iff_eq_add'), +end -theorem modeq.dvd : a ≡ b [ZMOD n] → n ∣ b - a := modeq_iff_dvd.1 -theorem modeq_of_dvd : n ∣ b - a → a ≡ b [ZMOD n] := modeq_iff_dvd.2 +alias modeq_iff_dvd ↔ modeq.dvd modeq_of_dvd theorem mod_modeq (a n) : a % n ≡ a [ZMOD n] := mod_mod _ _ +@[simp] lemma neg_modeq_neg : -a ≡ -b [ZMOD n] ↔ a ≡ b [ZMOD n] := +by simp [modeq_iff_dvd, dvd_sub_comm] + +@[simp] lemma modeq_neg : a ≡ b [ZMOD -n] ↔ a ≡ b [ZMOD n] := by simp [modeq_iff_dvd] + namespace modeq -protected theorem modeq_of_dvd (d : m ∣ n) (h : a ≡ b [ZMOD n]) : a ≡ b [ZMOD m] := -modeq_iff_dvd.2 $ d.trans h.dvd +protected lemma of_dvd (d : m ∣ n) (h : a ≡ b [ZMOD n]) : a ≡ b [ZMOD m] := +modeq_of_dvd $ d.trans h.dvd -protected theorem mul_left' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD (c * n)] := -or.cases_on hc.lt_or_eq (λ hc, - by unfold modeq; - simp [mul_mod_mul_of_pos hc, (show _ = _, from h)] ) -(λ hc, by simp [hc.symm]) +protected theorem mul_left' (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD (c * n)] := +begin + obtain hc | rfl | hc := lt_trichotomy c 0, + { rw [←neg_modeq_neg, ←modeq_neg, ←neg_mul, ←neg_mul, ←neg_mul], + simp only [modeq, mul_mod_mul_of_pos (neg_pos.2 hc), h.eq] }, + { simp }, + { simp only [modeq, mul_mod_mul_of_pos hc, h.eq] } +end -protected theorem mul_right' (hc : 0 ≤ c) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD (n * c)] := -by rw [mul_comm a, mul_comm b, mul_comm n]; exact h.mul_left' hc +protected theorem mul_right' (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD (n * c)] := +by rw [mul_comm a, mul_comm b, mul_comm n]; exact h.mul_left' protected theorem add (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a + c ≡ b + d [ZMOD n] := modeq_iff_dvd.2 $ by { convert dvd_add h₁.dvd h₂.dvd, ring } @@ -112,13 +134,10 @@ protected theorem sub_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a - c ≡ b - c [ h.sub modeq.rfl protected theorem mul_left (c : ℤ) (h : a ≡ b [ZMOD n]) : c * a ≡ c * b [ZMOD n] := -or.cases_on (le_total 0 c) -(λ hc, (h.mul_left' hc).modeq_of_dvd (dvd_mul_left _ _) ) -(λ hc, by rw [← neg_neg c, neg_mul, neg_mul _ b]; - exact ((h.mul_left' $ neg_nonneg.2 hc).modeq_of_dvd (dvd_mul_left _ _)).neg) +h.mul_left'.of_dvd $ dvd_mul_left _ _ protected theorem mul_right (c : ℤ) (h : a ≡ b [ZMOD n]) : a * c ≡ b * c [ZMOD n] := -by { rw [mul_comm a, mul_comm b], exact h.mul_left c } +h.mul_right'.of_dvd $ dvd_mul_right _ _ protected theorem mul (h₁ : a ≡ b [ZMOD n]) (h₂ : c ≡ d [ZMOD n]) : a * c ≡ b * d [ZMOD n] := (h₂.mul_left _).trans (h₁.mul_right _) @@ -130,11 +149,33 @@ begin exact h.mul hd, end -theorem of_modeq_mul_left (m : ℤ) (h : a ≡ b [ZMOD m * n]) : a ≡ b [ZMOD n] := +theorem of_mul_left (m : ℤ) (h : a ≡ b [ZMOD m * n]) : a ≡ b [ZMOD n] := by rw [modeq_iff_dvd] at *; exact (dvd_mul_left n m).trans h -theorem of_modeq_mul_right (m : ℤ) : a ≡ b [ZMOD n * m] → a ≡ b [ZMOD n] := -mul_comm m n ▸ of_modeq_mul_left _ +theorem of_mul_right (m : ℤ) : a ≡ b [ZMOD n * m] → a ≡ b [ZMOD n] := +mul_comm m n ▸ of_mul_left _ + +/-- To cancel a common factor `c` from a `modeq` we must divide the modulus `m` by `gcd m c`. -/ +lemma cancel_right_div_gcd (hm : 0 < m) (h : a * c ≡ b * c [ZMOD m]) : a ≡ b [ZMOD m / gcd m c] := +begin + let d := gcd m c, + have hmd := gcd_dvd_left m c, + have hcd := gcd_dvd_right m c, + rw modeq_iff_dvd at ⊢ h, + refine int.dvd_of_dvd_mul_right_of_gcd_one _ _, + show m / d ∣ c / d * (b - a), + { rw [mul_comm, ←int.mul_div_assoc (b - a) hcd, sub_mul], + exact int.div_dvd_div hmd h }, + { rw [gcd_div hmd hcd, nat_abs_of_nat, nat.div_self (gcd_pos_of_ne_zero_left c hm.ne')] } +end + +/-- To cancel a common factor `c` from a `modeq` we must divide the modulus `m` by `gcd m c`. -/ +lemma cancel_left_div_gcd (hm : 0 < m) (h : c * a ≡ c * b [ZMOD m]) : a ≡ b [ZMOD m / gcd m c] := +cancel_right_div_gcd hm $ by simpa [mul_comm] using h + +lemma of_div (h : a / c ≡ b / c [ZMOD m / c]) (ha : c ∣ a) (ha : c ∣ b) (ha : c ∣ m) : + a ≡ b [ZMOD m] := +by convert h.mul_left'; rwa int.mul_div_cancel' end modeq @@ -143,6 +184,11 @@ theorem modeq_one : a ≡ b [ZMOD 1] := modeq_of_dvd (one_dvd _) lemma modeq_sub (a b : ℤ) : a ≡ b [ZMOD a - b] := (modeq_of_dvd dvd_rfl).symm +@[simp] lemma modeq_zero_iff : a ≡ b [ZMOD 0] ↔ a = b := by rw [modeq, mod_zero, mod_zero] + +@[simp] lemma add_modeq_left : n + a ≡ a [ZMOD n] := modeq.symm $ modeq_iff_dvd.2 $ by simp +@[simp] lemma add_modeq_right : a + n ≡ a [ZMOD n] := modeq.symm $ modeq_iff_dvd.2 $ by simp + lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℤ} (hmn : m.nat_abs.coprime n.nat_abs) : a ≡ b [ZMOD m] ∧ a ≡ b [ZMOD n] ↔ (a ≡ b [ZMOD m * n]) := ⟨λ h, begin @@ -152,7 +198,7 @@ lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℤ} (hmn : m.nat_abs.coprime n.n refine hmn.mul_dvd_of_dvd_of_dvd _ _; rw [← coe_nat_dvd, nat_abs_dvd, dvd_nat_abs]; tauto end, -λ h, ⟨h.of_modeq_mul_right _, h.of_modeq_mul_left _⟩⟩ +λ h, ⟨h.of_mul_right _, h.of_mul_left _⟩⟩ lemma gcd_a_modeq (a b : ℕ) : (a : ℤ) * nat.gcd_a a b ≡ nat.gcd a b [ZMOD b] := by { rw [← add_zero ((a : ℤ) * _), nat.gcd_eq_gcd_ab], @@ -163,6 +209,9 @@ calc a + n*c ≡ b + n*c [ZMOD n] : ha.add_right _ ... ≡ b + 0 [ZMOD n] : (dvd_mul_right _ _).modeq_zero_int.add_left _ ... ≡ b [ZMOD n] : by rw add_zero +theorem modeq_add_fac_self {a t n : ℤ} : a + n * t ≡ a [ZMOD n] := +modeq_add_fac _ modeq.rfl + lemma mod_coprime {a b : ℕ} (hab : nat.coprime a b) : ∃ y : ℤ, a * y ≡ 1 [ZMOD b] := ⟨ nat.gcd_a a b, have hgcd : nat.gcd a b = 1, from nat.coprime.gcd_eq_one hab, @@ -183,9 +232,9 @@ let ⟨z, hz1, hz2, hz3⟩ := exists_unique_equiv a hb in @[simp] lemma mod_mul_right_mod (a b c : ℤ) : a % (b * c) % b = a % b := -(mod_modeq _ _).of_modeq_mul_right _ +(mod_modeq _ _).of_mul_right _ @[simp] lemma mod_mul_left_mod (a b c : ℤ) : a % (b * c) % c = a % c := -(mod_modeq _ _).of_modeq_mul_left _ +(mod_modeq _ _).of_mul_left _ end int diff --git a/src/data/int/nat_prime.lean b/src/data/int/nat_prime.lean index ad6fae2fe0bd1..c49b3c2905724 100644 --- a/src/data/int/nat_prime.lean +++ b/src/data/int/nat_prime.lean @@ -4,9 +4,12 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Kevin Lacker, Bryan Gin-ge Chen -/ import data.nat.prime -import data.int.basic + /-! # Lemmas about nat.prime using `int`s + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open nat @@ -17,4 +20,23 @@ lemma not_prime_of_int_mul {a b : ℤ} {c : ℕ} (ha : 1 < a.nat_abs) (hb : 1 < b.nat_abs) (hc : a*b = (c : ℤ)) : ¬ nat.prime c := not_prime_mul' (nat_abs_mul_nat_abs_eq hc) ha hb +lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : nat.prime p) {m n : ℤ} {k l : ℕ} + (hpm : ↑(p ^ k) ∣ m) + (hpn : ↑(p ^ l) ∣ n) (hpmn : ↑(p ^ (k+l+1)) ∣ m*n) : ↑(p ^ (k+1)) ∣ m ∨ ↑(p ^ (l+1)) ∣ n := +have hpm' : p ^ k ∣ m.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpm, +have hpn' : p ^ l ∣ n.nat_abs, from int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpn, +have hpmn' : (p ^ (k+l+1)) ∣ m.nat_abs*n.nat_abs, + by rw ←int.nat_abs_mul; apply (int.coe_nat_dvd.1 $ int.dvd_nat_abs.2 hpmn), +let hsd := nat.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hpm' hpn' hpmn' in +hsd.elim + (λ hsd1, or.inl begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd1 end) + (λ hsd2, or.inr begin apply int.dvd_nat_abs.1, apply int.coe_nat_dvd.2 hsd2 end) + +lemma prime.dvd_nat_abs_of_coe_dvd_sq {p : ℕ} (hp : p.prime) (k : ℤ) (h : ↑p ∣ k ^ 2) : + p ∣ k.nat_abs := +begin + apply @nat.prime.dvd_of_dvd_pow _ _ 2 hp, + rwa [sq, ← nat_abs_mul, ← coe_nat_dvd_left, ← sq] +end + end int diff --git a/src/data/int/order.lean b/src/data/int/order.lean deleted file mode 100644 index c486c6d445021..0000000000000 --- a/src/data/int/order.lean +++ /dev/null @@ -1,92 +0,0 @@ -/- -Copyright (c) 2021 Floris van Doorn. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Floris van Doorn --/ -import order.conditionally_complete_lattice -import data.int.least_greatest - -/-! -## `ℤ` forms a conditionally complete linear order - -The integers form a conditionally complete linear order. --/ - -open int -open_locale classical -noncomputable theory - -instance : conditionally_complete_linear_order ℤ := -{ Sup := λ s, if h : s.nonempty ∧ bdd_above s then - greatest_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0, - Inf := λ s, if h : s.nonempty ∧ bdd_below s then - least_of_bdd (classical.some h.2) (classical.some_spec h.2) h.1 else 0, - le_cSup := begin - intros s n hs hns, - have : s.nonempty ∧ bdd_above s := ⟨⟨n, hns⟩, hs⟩, - rw [dif_pos this], - exact (greatest_of_bdd _ _ _).2.2 n hns - end, - cSup_le := begin - intros s n hs hns, - have : s.nonempty ∧ bdd_above s := ⟨hs, ⟨n, hns⟩⟩, - rw [dif_pos this], - exact hns (greatest_of_bdd _ (classical.some_spec this.2) _).2.1 - end, - cInf_le := begin - intros s n hs hns, - have : s.nonempty ∧ bdd_below s := ⟨⟨n, hns⟩, hs⟩, - rw [dif_pos this], - exact (least_of_bdd _ _ _).2.2 n hns - end, - le_cInf := begin - intros s n hs hns, - have : s.nonempty ∧ bdd_below s := ⟨hs, ⟨n, hns⟩⟩, - rw [dif_pos this], - exact hns (least_of_bdd _ (classical.some_spec this.2) _).2.1 - end, - .. int.linear_order, ..linear_order.to_lattice } - -namespace int - -lemma cSup_eq_greatest_of_bdd {s : set ℤ} [decidable_pred (∈ s)] - (b : ℤ) (Hb : ∀ z ∈ s, z ≤ b) (Hinh : ∃ z : ℤ, z ∈ s) : - Sup s = greatest_of_bdd b Hb Hinh := -begin - convert dif_pos _ using 1, - { convert coe_greatest_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_above s)) _ }, - { exact ⟨Hinh, b, Hb⟩, } -end - -@[simp] -lemma cSup_empty : Sup (∅ : set ℤ) = 0 := dif_neg (by simp) - -lemma cSup_of_not_bdd_above {s : set ℤ} (h : ¬ bdd_above s) : Sup s = 0 := dif_neg (by simp [h]) - -lemma cInf_eq_least_of_bdd {s : set ℤ} [decidable_pred (∈ s)] - (b : ℤ) (Hb : ∀ z ∈ s, b ≤ z) (Hinh : ∃ z : ℤ, z ∈ s) : - Inf s = least_of_bdd b Hb Hinh := -begin - convert dif_pos _ using 1, - { convert coe_least_of_bdd_eq _ (classical.some_spec (⟨b, Hb⟩ : bdd_below s)) _ }, - { exact ⟨Hinh, b, Hb⟩, } -end - -@[simp] -lemma cInf_empty : Inf (∅ : set ℤ) = 0 := dif_neg (by simp) - -lemma cInf_of_not_bdd_below {s : set ℤ} (h : ¬ bdd_below s) : Inf s = 0 := dif_neg (by simp [h]) - -lemma cSup_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_above s) : Sup s ∈ s := -begin - convert (greatest_of_bdd _ (classical.some_spec h2) h1).2.1, - exact dif_pos ⟨h1, h2⟩, -end - -lemma cInf_mem {s : set ℤ} (h1 : s.nonempty) (h2 : bdd_below s) : Inf s ∈ s := -begin - convert (least_of_bdd _ (classical.some_spec h2) h1).2.1, - exact dif_pos ⟨h1, h2⟩, -end - -end int diff --git a/src/data/int/order/basic.lean b/src/data/int/order/basic.lean new file mode 100644 index 0000000000000..2b426b0dd1aaa --- /dev/null +++ b/src/data/int/order/basic.lean @@ -0,0 +1,649 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.int.basic +import data.int.cast.basic +import algebra.ring.divisibility +import algebra.order.group.abs +import algebra.order.ring.char_zero +import tactic.assert_exists + +/-! +# Order instances on the integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains: +* instances on `ℤ`. The stronger one is `int.linear_ordered_comm_ring`. +* basic lemmas about integers that involve order properties. + +## Recursors + +* `int.rec`: Sign disjunction. Something is true/defined on `ℤ` if it's true/defined for nonnegative + and for negative values. (Defined in core Lean 3) +* `int.induction_on`: Simple growing induction on positive numbers, plus simple decreasing induction + on negative numbers. Note that this recursor is currently only `Prop`-valued. +* `int.induction_on'`: Simple growing induction for numbers greater than `b`, plus simple decreasing + induction on numbers less than `b`. +-/ + +open nat + +namespace int + +instance : linear_ordered_comm_ring ℤ := +{ add_le_add_left := @int.add_le_add_left, + mul_pos := @int.mul_pos, + zero_le_one := le_of_lt int.zero_lt_one, + .. int.comm_ring, .. int.linear_order, .. int.nontrivial } + +/-! ### Extra instances to short-circuit type class resolution +-/ +instance : ordered_comm_ring ℤ := strict_ordered_comm_ring.to_ordered_comm_ring' +instance : ordered_ring ℤ := strict_ordered_ring.to_ordered_ring' +instance : linear_ordered_add_comm_group ℤ := by apply_instance + +end int + + +namespace int + +theorem abs_eq_nat_abs : ∀ a : ℤ, |a| = nat_abs a +| (n : ℕ) := abs_of_nonneg $ coe_zero_le _ +| -[1+ n] := abs_of_nonpos $ le_of_lt $ neg_succ_lt_zero _ + +@[simp, norm_cast] lemma coe_nat_abs (n : ℤ) : (n.nat_abs : ℤ) = |n| := n.abs_eq_nat_abs.symm + +lemma _root_.nat.cast_nat_abs {α : Type*} [add_group_with_one α] (n : ℤ) : (n.nat_abs : α) = ↑|n| := +by rw [←int.coe_nat_abs, int.cast_coe_nat] + +theorem nat_abs_abs (a : ℤ) : nat_abs (|a|) = nat_abs a := +by rw [abs_eq_nat_abs]; refl + +theorem sign_mul_abs (a : ℤ) : sign a * |a| = a := +by rw [abs_eq_nat_abs, sign_mul_nat_abs] + +theorem coe_nat_eq_zero {n : ℕ} : (n : ℤ) = 0 ↔ n = 0 := nat.cast_eq_zero + +theorem coe_nat_ne_zero {n : ℕ} : (n : ℤ) ≠ 0 ↔ n ≠ 0 := by simp + +lemma coe_nat_ne_zero_iff_pos {n : ℕ} : (n : ℤ) ≠ 0 ↔ 0 < n := +⟨λ h, nat.pos_of_ne_zero (coe_nat_ne_zero.1 h), +λ h, (ne_of_lt (coe_nat_lt.2 h)).symm⟩ + +@[norm_cast] lemma abs_coe_nat (n : ℕ) : |(n : ℤ)| = n := abs_of_nonneg (coe_nat_nonneg n) + +theorem sign_add_eq_of_sign_eq : ∀ {m n : ℤ}, m.sign = n.sign → (m + n).sign = n.sign := +begin + have : (1 : ℤ) ≠ -1 := dec_trivial, + rintro ((_ | m) | m) ((_ | n) | n); + simp [this, this.symm], + rw int.sign_eq_one_iff_pos, + apply int.add_pos; + { exact zero_lt_one.trans_le (le_add_of_nonneg_left $ coe_zero_le _) } +end + +/-! ### succ and pred -/ + +theorem lt_succ_self (a : ℤ) : a < succ a := +lt_add_of_pos_right _ zero_lt_one + +theorem pred_self_lt (a : ℤ) : pred a < a := +sub_lt_self _ zero_lt_one + +theorem lt_add_one_iff {a b : ℤ} : a < b + 1 ↔ a ≤ b := +add_le_add_iff_right _ + +lemma le_add_one {a b : ℤ} (h : a ≤ b) : a ≤ b + 1 := +le_of_lt (int.lt_add_one_iff.mpr h) + +theorem sub_one_lt_iff {a b : ℤ} : a - 1 < b ↔ a ≤ b := +sub_lt_iff_lt_add.trans lt_add_one_iff + +theorem le_sub_one_iff {a b : ℤ} : a ≤ b - 1 ↔ a < b := +le_sub_iff_add_le + +@[simp] lemma abs_lt_one_iff {a : ℤ} : |a| < 1 ↔ a = 0 := +⟨λ a0, let ⟨hn, hp⟩ := abs_lt.mp a0 in (le_of_lt_add_one (by exact hp)).antisymm hn, + λ a0, (abs_eq_zero.mpr a0).le.trans_lt zero_lt_one⟩ + +lemma abs_le_one_iff {a : ℤ} : |a| ≤ 1 ↔ a = 0 ∨ a = 1 ∨ a = -1 := +by rw [le_iff_lt_or_eq, abs_lt_one_iff, abs_eq (zero_le_one' ℤ)] + +lemma one_le_abs {z : ℤ} (h₀: z ≠ 0) : 1 ≤ |z| := +add_one_le_iff.mpr (abs_pos.mpr h₀) + +/-- Inductively define a function on `ℤ` by defining it at `b`, for the `succ` of a number greater +than `b`, and the `pred` of a number less than `b`. -/ +@[elab_as_eliminator] +protected def induction_on' {C : ℤ → Sort*} (z : ℤ) (b : ℤ) + (H0 : C b) (Hs : ∀ k, b ≤ k → C k → C (k + 1)) (Hp : ∀ k ≤ b, C k → C (k - 1)) : C z := +begin + -- Note that we use `convert` here where possible as we are constructing data, and this reduces + -- the number of times `eq.mpr` appears in the term. + rw ←sub_add_cancel z b, + induction (z - b) with n n, + { induction n with n ih, + { convert H0 using 1, + rw [of_nat_zero, zero_add] }, + convert Hs _ (le_add_of_nonneg_left (of_nat_nonneg _)) ih using 1, + rw [of_nat_succ, add_assoc, add_comm 1 b, ←add_assoc] }, + { induction n with n ih, + { convert Hp _ le_rfl H0 using 1, + rw [neg_succ_of_nat_eq, ←of_nat_eq_coe, of_nat_zero, zero_add, neg_add_eq_sub] }, + { convert Hp _ (le_of_lt (add_lt_of_neg_of_le (neg_succ_lt_zero _) le_rfl)) ih using 1, + rw [neg_succ_of_nat_coe', nat.succ_eq_add_one, ←neg_succ_of_nat_coe, sub_add_eq_add_sub] } } +end + +/-- See `int.induction_on'` for an induction in both directions. -/ +protected lemma le_induction {P : ℤ → Prop} {m : ℤ} (h0 : P m) + (h1 : ∀ (n : ℤ), m ≤ n → P n → P (n + 1)) (n : ℤ) : + m ≤ n → P n := +begin + apply int.induction_on' n m, + { intro _, exact h0, }, + { intros k hle hi _, exact h1 k hle (hi hle), }, + { intros _ hle _ hle', + exfalso, + exact lt_irrefl k (le_sub_one_iff.mp (hle.trans hle')), }, +end + +/-- See `int.induction_on'` for an induction in both directions. -/ +protected lemma le_induction_down {P : ℤ → Prop} {m : ℤ} (h0 : P m) + (h1 : ∀ (n : ℤ), n ≤ m → P n → P (n - 1)) (n : ℤ) : + n ≤ m → P n := +begin + apply int.induction_on' n m, + { intro _, exact h0, }, + { intros _ hle _ hle', + exfalso, + exact lt_irrefl k (add_one_le_iff.mp (hle'.trans hle)), }, + { intros k hle hi _, + exact h1 k hle (hi hle), }, +end + +/-! ### nat abs -/ + +variables {a b : ℤ} {n : ℕ} + +attribute [simp] nat_abs nat_abs_of_nat nat_abs_zero nat_abs_one + +@[simp] lemma nat_abs_dvd_iff_dvd {a b : ℤ} : a.nat_abs ∣ b.nat_abs ↔ a ∣ b := +begin + refine ⟨_, λ ⟨k, hk⟩, ⟨k.nat_abs, hk.symm ▸ nat_abs_mul a k⟩⟩, + rintro ⟨k, hk⟩, + rw [←nat_abs_of_nat k, ←nat_abs_mul, nat_abs_eq_nat_abs_iff, neg_mul_eq_mul_neg] at hk, + cases hk; exact ⟨_, hk⟩ +end + +/-! ### `/` -/ + +protected theorem div_nonpos {a b : ℤ} (Ha : 0 ≤ a) (Hb : b ≤ 0) : a / b ≤ 0 := +nonpos_of_neg_nonneg $ by rw [← int.div_neg]; exact int.div_nonneg Ha (neg_nonneg_of_nonpos Hb) + +theorem div_eq_zero_of_lt_abs {a b : ℤ} (H1 : 0 ≤ a) (H2 : a < |b|) : a / b = 0 := +match b, |b|, abs_eq_nat_abs b, H2 with +| (n : ℕ), ._, rfl, H2 := div_eq_zero_of_lt H1 H2 +| -[1+ n], ._, rfl, H2 := neg_injective $ by rw [← int.div_neg]; exact div_eq_zero_of_lt H1 H2 +end + +protected theorem add_mul_div_right (a b : ℤ) {c : ℤ} (H : c ≠ 0) : + (a + b * c) / c = a / c + b := +have ∀ {k n : ℕ} {a : ℤ}, (a + n * k.succ) / k.succ = a / k.succ + n, from +λ k n a, match a with +| (m : ℕ) := congr_arg of_nat $ nat.add_mul_div_right _ _ k.succ_pos +| -[1+ m] := show ((n * k.succ:ℕ) - m.succ : ℤ) / k.succ = + n - (m / k.succ + 1 : ℕ), begin + cases lt_or_ge m (n*k.succ) with h h, + { rw [← int.coe_nat_sub h, + ← int.coe_nat_sub ((nat.div_lt_iff_lt_mul k.succ_pos).2 h)], + apply congr_arg of_nat, + rw [mul_comm, nat.mul_sub_div], rwa mul_comm }, + { change (↑(n * nat.succ k) - (m + 1) : ℤ) / ↑(nat.succ k) = + ↑n - ((m / nat.succ k : ℕ) + 1), + rw [← sub_sub, ← sub_sub, ← neg_sub (m:ℤ), ← neg_sub _ (n:ℤ), + ← int.coe_nat_sub h, + ← int.coe_nat_sub ((nat.le_div_iff_mul_le k.succ_pos).2 h), + ← neg_succ_of_nat_coe', ← neg_succ_of_nat_coe'], + { apply congr_arg neg_succ_of_nat, + rw [mul_comm, nat.sub_mul_div], rwa mul_comm } } + end +end, +have ∀ {a b c : ℤ}, 0 < c → (a + b * c) / c = a / c + b, from +λ a b c H, match c, eq_succ_of_zero_lt H, b with +| ._, ⟨k, rfl⟩, (n : ℕ) := this +| ._, ⟨k, rfl⟩, -[1+ n] := + show (a - n.succ * k.succ) / k.succ = (a / k.succ) - n.succ, from + eq_sub_of_add_eq $ by rw [← this, sub_add_cancel] +end, +match lt_trichotomy c 0 with +| or.inl hlt := neg_inj.1 $ by rw [← int.div_neg, neg_add, ← int.div_neg, ← neg_mul_neg]; + apply this (neg_pos_of_neg hlt) +| or.inr (or.inl heq) := absurd heq H +| or.inr (or.inr hgt) := this hgt +end + +protected theorem add_mul_div_left (a : ℤ) {b : ℤ} (c : ℤ) (H : b ≠ 0) : + (a + b * c) / b = a / b + c := +by rw [mul_comm, int.add_mul_div_right _ _ H] + +@[simp] protected theorem mul_div_cancel (a : ℤ) {b : ℤ} (H : b ≠ 0) : a * b / b = a := +by have := int.add_mul_div_right 0 a H; + rwa [zero_add, int.zero_div, zero_add] at this + +@[simp] protected theorem mul_div_cancel_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : a * b / a = b := +by rw [mul_comm, int.mul_div_cancel _ H] + +@[simp] protected theorem div_self {a : ℤ} (H : a ≠ 0) : a / a = 1 := +by have := int.mul_div_cancel 1 H; rwa one_mul at this + +local attribute [simp] int.zero_div int.div_zero + +protected theorem add_div_of_dvd_right {a b c : ℤ} (H : c ∣ b) : + (a + b) / c = a / c + b / c := +begin + by_cases h1 : c = 0, + { simp [h1] }, + cases H with k hk, + rw hk, + change c ≠ 0 at h1, + rw [mul_comm c k, int.add_mul_div_right _ _ h1, ←zero_add (k * c), int.add_mul_div_right _ _ h1, + int.zero_div, zero_add] +end + +protected theorem add_div_of_dvd_left {a b c : ℤ} (H : c ∣ a) : + (a + b) / c = a / c + b / c := +by rw [add_comm, int.add_div_of_dvd_right H, add_comm] + +/-! ### mod -/ + +@[simp] theorem mod_abs (a b : ℤ) : a % (|b|) = a % b := +abs_by_cases (λ i, a % i = a % b) rfl (mod_neg _ _) + +theorem mod_nonneg : ∀ (a : ℤ) {b : ℤ}, b ≠ 0 → 0 ≤ a % b +| (m : ℕ) n H := coe_zero_le _ +| -[1+ m] n H := + sub_nonneg_of_le $ coe_nat_le_coe_nat_of_le $ nat.mod_lt _ (nat_abs_pos_of_ne_zero H) + +theorem mod_lt_of_pos (a : ℤ) {b : ℤ} (H : 0 < b) : a % b < b := +match a, b, eq_succ_of_zero_lt H with +| (m : ℕ), ._, ⟨n, rfl⟩ := coe_nat_lt_coe_nat_of_lt (nat.mod_lt _ (nat.succ_pos _)) +| -[1+ m], ._, ⟨n, rfl⟩ := sub_lt_self _ (coe_nat_lt_coe_nat_of_lt $ nat.succ_pos _) +end + +theorem mod_lt (a : ℤ) {b : ℤ} (H : b ≠ 0) : a % b < |b| := +by rw [← mod_abs]; exact mod_lt_of_pos _ (abs_pos.2 H) + +@[simp] theorem add_mul_mod_self {a b c : ℤ} : (a + b * c) % c = a % c := +if cz : c = 0 then by rw [cz, mul_zero, add_zero] else +by rw [mod_def, mod_def, int.add_mul_div_right _ _ cz, + mul_add, mul_comm, add_sub_add_right_eq_sub] + +@[simp] theorem add_mul_mod_self_left (a b c : ℤ) : (a + b * c) % b = a % b := +by rw [mul_comm, add_mul_mod_self] + +@[simp] theorem add_mod_self {a b : ℤ} : (a + b) % b = a % b := +by have := add_mul_mod_self_left a b 1; rwa mul_one at this + +@[simp] theorem add_mod_self_left {a b : ℤ} : (a + b) % a = b % a := +by rw [add_comm, add_mod_self] + +@[simp] theorem mod_add_mod (m n k : ℤ) : (m % n + k) % n = (m + k) % n := +by have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm; + rwa [add_right_comm, mod_add_div] at this + +@[simp] theorem add_mod_mod (m n k : ℤ) : (m + n % k) % k = (m + n) % k := +by rw [add_comm, mod_add_mod, add_comm] + +lemma add_mod (a b n : ℤ) : (a + b) % n = ((a % n) + (b % n)) % n := +by rw [add_mod_mod, mod_add_mod] + +theorem add_mod_eq_add_mod_right {m n k : ℤ} (i : ℤ) (H : m % n = k % n) : + (m + i) % n = (k + i) % n := +by rw [← mod_add_mod, ← mod_add_mod k, H] + +theorem add_mod_eq_add_mod_left {m n k : ℤ} (i : ℤ) (H : m % n = k % n) : + (i + m) % n = (i + k) % n := +by rw [add_comm, add_mod_eq_add_mod_right _ H, add_comm] + +theorem mod_add_cancel_right {m n k : ℤ} (i) : (m + i) % n = (k + i) % n ↔ + m % n = k % n := +⟨λ H, by have := add_mod_eq_add_mod_right (-i) H; + rwa [add_neg_cancel_right, add_neg_cancel_right] at this, + add_mod_eq_add_mod_right _⟩ + +theorem mod_add_cancel_left {m n k i : ℤ} : + (i + m) % n = (i + k) % n ↔ m % n = k % n := +by rw [add_comm, add_comm i, mod_add_cancel_right] + +theorem mod_sub_cancel_right {m n k : ℤ} (i) : (m - i) % n = (k - i) % n ↔ + m % n = k % n := +mod_add_cancel_right _ + +@[simp] theorem mul_mod_left (a b : ℤ) : (a * b) % b = 0 := +by rw [← zero_add (a * b), add_mul_mod_self, zero_mod] + +@[simp] theorem mul_mod_right (a b : ℤ) : (a * b) % a = 0 := +by rw [mul_comm, mul_mod_left] + +lemma mul_mod (a b n : ℤ) : (a * b) % n = ((a % n) * (b % n)) % n := +begin + conv_lhs + { rw [←mod_add_div a n, ←mod_add_div' b n, right_distrib, left_distrib, left_distrib, + mul_assoc, mul_assoc, ←left_distrib n _ _, add_mul_mod_self_left, ← mul_assoc, + add_mul_mod_self] } +end + +local attribute [simp] -- Will be generalized to Euclidean domains. +theorem mod_self {a : ℤ} : a % a = 0 := +by have := mul_mod_left 1 a; rwa one_mul at this + +@[simp] theorem mod_mod_of_dvd (n : ℤ) {m k : ℤ} (h : m ∣ k) : n % k % m = n % m := +begin + conv { to_rhs, rw ←mod_add_div n k }, + rcases h with ⟨t, rfl⟩, rw [mul_assoc, add_mul_mod_self_left] +end + +@[simp] theorem mod_mod (a b : ℤ) : a % b % b = a % b := +by conv {to_rhs, rw [← mod_add_div a b, add_mul_mod_self_left]} + +lemma sub_mod (a b n : ℤ) : (a - b) % n = ((a % n) - (b % n)) % n := +begin + apply (mod_add_cancel_right b).mp, + rw [sub_add_cancel, ← add_mod_mod, sub_add_cancel, mod_mod] +end + +/-- See also `int.div_mod_equiv` for a similar statement as an `equiv`. -/ +protected theorem div_mod_unique {a b r q : ℤ} (h : 0 < b) : + a / b = q ∧ a % b = r ↔ r + b * q = a ∧ 0 ≤ r ∧ r < b := +begin + split, + { rintro ⟨rfl, rfl⟩, + exact ⟨mod_add_div a b, mod_nonneg _ h.ne.symm, mod_lt_of_pos _ h⟩, }, + { rintro ⟨rfl, hz, hb⟩, + split, + { rw [int.add_mul_div_left r q (ne_of_gt h), div_eq_zero_of_lt hz hb], + simp, }, + { rw [add_mul_mod_self_left, mod_eq_of_lt hz hb] } }, +end + +local attribute [simp] int.zero_mod + +theorem mod_eq_mod_iff_mod_sub_eq_zero {m n k : ℤ} : m % n = k % n ↔ (m - k) % n = 0 := +(mod_sub_cancel_right k).symm.trans $ by simp + +@[simp] lemma neg_mod_two (i : ℤ) : (-i) % 2 = i % 2 := +begin + apply int.mod_eq_mod_iff_mod_sub_eq_zero.mpr, + convert int.mul_mod_right 2 (-i), + simp only [two_mul, sub_eq_add_neg] +end + +/-! ### properties of `/` and `%` -/ + +theorem lt_div_add_one_mul_self (a : ℤ) {b : ℤ} (H : 0 < b) : a < (a / b + 1) * b := +by { rw [add_mul, one_mul, mul_comm, ← sub_lt_iff_lt_add', ← mod_def], + exact mod_lt_of_pos _ H } + +theorem abs_div_le_abs : ∀ (a b : ℤ), |a / b| ≤ |a| := +suffices ∀ (a : ℤ) (n : ℕ), |a / n| ≤ |a|, from +λ a b, match b, eq_coe_or_neg b with +| ._, ⟨n, or.inl rfl⟩ := this _ _ +| ._, ⟨n, or.inr rfl⟩ := by rw [int.div_neg, abs_neg]; apply this +end, +λ a n, by rw [abs_eq_nat_abs, abs_eq_nat_abs]; exact +coe_nat_le_coe_nat_of_le (match a, n with +| (m : ℕ), n := nat.div_le_self _ _ +| -[1+ m], 0 := nat.zero_le _ +| -[1+ m], n+1 := nat.succ_le_succ (nat.div_le_self _ _) +end) + +theorem div_le_self {a : ℤ} (b : ℤ) (Ha : 0 ≤ a) : a / b ≤ a := +by have := le_trans (le_abs_self _) (abs_div_le_abs a b); + rwa [abs_of_nonneg Ha] at this + +lemma mod_two_eq_zero_or_one (n : ℤ) : n % 2 = 0 ∨ n % 2 = 1 := +have h : n % 2 < 2 := abs_of_nonneg (show 0 ≤ (2 : ℤ), from dec_trivial) ▸ int.mod_lt _ dec_trivial, +have h₁ : 0 ≤ n % 2 := int.mod_nonneg _ dec_trivial, +match (n % 2), h, h₁ with +| (0 : ℕ) := λ _ _, or.inl rfl +| (1 : ℕ) := λ _ _, or.inr rfl +| (k + 2 : ℕ) := λ h _, absurd h dec_trivial +| -[1+ a] := λ _ h₁, absurd h₁ dec_trivial +end + +/-! ### dvd -/ + +theorem dvd_of_mod_eq_zero {a b : ℤ} (H : b % a = 0) : a ∣ b := +⟨b / a, (mul_div_cancel_of_mod_eq_zero H).symm⟩ + +theorem mod_eq_zero_of_dvd : ∀ {a b : ℤ}, a ∣ b → b % a = 0 +| a ._ ⟨c, rfl⟩ := mul_mod_right _ _ + +theorem dvd_iff_mod_eq_zero (a b : ℤ) : a ∣ b ↔ b % a = 0 := +⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩ + +/-- If `a % b = c` then `b` divides `a - c`. -/ +lemma dvd_sub_of_mod_eq {a b c : ℤ} (h : a % b = c) : b ∣ a - c := +begin + have hx : a % b % b = c % b, { rw h }, + rw [mod_mod, ←mod_sub_cancel_right c, sub_self, zero_mod] at hx, + exact dvd_of_mod_eq_zero hx +end + +theorem nat_abs_dvd {a b : ℤ} : (a.nat_abs : ℤ) ∣ b ↔ a ∣ b := +(nat_abs_eq a).elim (λ e, by rw ← e) (λ e, by rw [← neg_dvd, ← e]) + +theorem dvd_nat_abs {a b : ℤ} : a ∣ b.nat_abs ↔ a ∣ b := +(nat_abs_eq b).elim (λ e, by rw ← e) (λ e, by rw [← dvd_neg, ← e]) + +instance decidable_dvd : @decidable_rel ℤ (∣) := +assume a n, decidable_of_decidable_of_iff (by apply_instance) (dvd_iff_mod_eq_zero _ _).symm + +protected theorem div_mul_cancel {a b : ℤ} (H : b ∣ a) : a / b * b = a := +div_mul_cancel_of_mod_eq_zero (mod_eq_zero_of_dvd H) + +protected theorem mul_div_cancel' {a b : ℤ} (H : a ∣ b) : a * (b / a) = b := +by rw [mul_comm, int.div_mul_cancel H] + +theorem div_dvd_div : ∀ {a b c : ℤ} (H1 : a ∣ b) (H2 : b ∣ c), b / a ∣ c / a +| a ._ ._ ⟨b, rfl⟩ ⟨c, rfl⟩ := if az : a = 0 then by simp [az] else + by rw [int.mul_div_cancel_left _ az, mul_assoc, int.mul_div_cancel_left _ az]; + apply dvd_mul_right + +protected theorem eq_mul_of_div_eq_right {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) : + a = b * c := +by rw [← H2, int.mul_div_cancel' H1] + +protected theorem div_eq_of_eq_mul_right {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = b * c) : + a / b = c := +by rw [H2, int.mul_div_cancel_left _ H1] + +protected theorem eq_div_of_mul_eq_right {a b c : ℤ} (H1 : a ≠ 0) (H2 : a * b = c) : + b = c / a := +eq.symm $ int.div_eq_of_eq_mul_right H1 H2.symm + +protected theorem div_eq_iff_eq_mul_right {a b c : ℤ} (H : b ≠ 0) (H' : b ∣ a) : + a / b = c ↔ a = b * c := +⟨int.eq_mul_of_div_eq_right H', int.div_eq_of_eq_mul_right H⟩ + +protected theorem div_eq_iff_eq_mul_left {a b c : ℤ} (H : b ≠ 0) (H' : b ∣ a) : + a / b = c ↔ a = c * b := +by rw mul_comm; exact int.div_eq_iff_eq_mul_right H H' + +protected theorem eq_mul_of_div_eq_left {a b c : ℤ} (H1 : b ∣ a) (H2 : a / b = c) : + a = c * b := +by rw [mul_comm, int.eq_mul_of_div_eq_right H1 H2] + +protected theorem div_eq_of_eq_mul_left {a b c : ℤ} (H1 : b ≠ 0) (H2 : a = c * b) : + a / b = c := +int.div_eq_of_eq_mul_right H1 (by rw [mul_comm, H2]) + +protected lemma eq_zero_of_div_eq_zero {d n : ℤ} (h : d ∣ n) (H : n / d = 0) : n = 0 := +by rw [← int.mul_div_cancel' h, H, mul_zero] + +@[simp] +protected lemma div_left_inj {a b d : ℤ} (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b := +begin + refine ⟨λ h, _, congr_arg _⟩, + rw [←int.mul_div_cancel' hda, ←int.mul_div_cancel' hdb, h], +end + +lemma abs_sign_of_nonzero {z : ℤ} (hz : z ≠ 0) : |z.sign| = 1 := +by rw [abs_eq_nat_abs, nat_abs_sign_of_nonzero hz, int.coe_nat_one] + +/-- If `n > 0` then `m` is not divisible by `n` iff it is between `n * k` and `n * (k + 1)` + for some `k`. -/ +lemma exists_lt_and_lt_iff_not_dvd (m : ℤ) {n : ℤ} (hn : 0 < n) : + (∃ k, n * k < m ∧ m < n * (k + 1)) ↔ ¬ n ∣ m := +begin + split, + { rintro ⟨k, h1k, h2k⟩ ⟨l, rfl⟩, rw [mul_lt_mul_left hn] at h1k h2k, + rw [lt_add_one_iff, ← not_lt] at h2k, exact h2k h1k }, + { intro h, rw [dvd_iff_mod_eq_zero, ← ne.def] at h, + have := (mod_nonneg m hn.ne.symm).lt_of_ne h.symm, + simp only [← mod_add_div m n] {single_pass := tt}, + refine ⟨m / n, lt_add_of_pos_left _ this, _⟩, + rw [add_comm _ (1 : ℤ), left_distrib, mul_one], exact add_lt_add_right (mod_lt_of_pos _ hn) _ } +end + +local attribute [simp] int.div_zero + +protected theorem mul_div_assoc (a : ℤ) : ∀ {b c : ℤ}, c ∣ b → (a * b) / c = a * (b / c) +| ._ c ⟨d, rfl⟩ := if cz : c = 0 then by simp [cz] else + by rw [mul_left_comm, int.mul_div_cancel_left _ cz, int.mul_div_cancel_left _ cz] + +protected theorem mul_div_assoc' (b : ℤ) {a c : ℤ} (h : c ∣ a) : a * b / c = a / c * b := +by rw [mul_comm, int.mul_div_assoc _ h, mul_comm] + +theorem neg_div_of_dvd : ∀ {a b : ℤ} (H : b ∣ a), -a / b = -(a / b) +| ._ b ⟨c, rfl⟩ := if bz : b = 0 then by simp [bz] else + by rw [neg_mul_eq_mul_neg, int.mul_div_cancel_left _ bz, int.mul_div_cancel_left _ bz] + +lemma sub_div_of_dvd (a : ℤ) {b c : ℤ} (hcb : c ∣ b) : (a - b) / c = a / c - b / c := +begin + rw [sub_eq_add_neg, sub_eq_add_neg, int.add_div_of_dvd_right hcb.neg_right], + congr, + exact neg_div_of_dvd hcb, +end + +lemma sub_div_of_dvd_sub {a b c : ℤ} (hcab : c ∣ (a - b)) : (a - b) / c = a / c - b / c := +by rw [eq_sub_iff_add_eq, ← int.add_div_of_dvd_left hcab, sub_add_cancel] + +protected theorem sign_eq_div_abs (a : ℤ) : sign a = a / |a| := +if az : a = 0 then by simp [az] else +(int.div_eq_of_eq_mul_left (mt abs_eq_zero.1 az) + (sign_mul_abs _).symm).symm + +/-! ### `/` and ordering -/ + +protected theorem div_mul_le (a : ℤ) {b : ℤ} (H : b ≠ 0) : a / b * b ≤ a := +le_of_sub_nonneg $ by rw [mul_comm, ← mod_def]; apply mod_nonneg _ H + +protected theorem div_le_of_le_mul {a b c : ℤ} (H : 0 < c) (H' : a ≤ b * c) : a / c ≤ b := +le_of_mul_le_mul_right (le_trans (int.div_mul_le _ (ne_of_gt H)) H') H + +protected theorem mul_lt_of_lt_div {a b c : ℤ} (H : 0 < c) (H3 : a < b / c) : a * c < b := +lt_of_not_ge $ mt (int.div_le_of_le_mul H) (not_le_of_gt H3) + +protected theorem mul_le_of_le_div {a b c : ℤ} (H1 : 0 < c) (H2 : a ≤ b / c) : a * c ≤ b := +le_trans (mul_le_mul_of_nonneg_right H2 (le_of_lt H1)) (int.div_mul_le _ (ne_of_gt H1)) + +protected theorem le_div_of_mul_le {a b c : ℤ} (H1 : 0 < c) (H2 : a * c ≤ b) : a ≤ b / c := +le_of_lt_add_one $ lt_of_mul_lt_mul_right + (lt_of_le_of_lt H2 (lt_div_add_one_mul_self _ H1)) (le_of_lt H1) + +protected theorem le_div_iff_mul_le {a b c : ℤ} (H : 0 < c) : a ≤ b / c ↔ a * c ≤ b := +⟨int.mul_le_of_le_div H, int.le_div_of_mul_le H⟩ + +protected theorem div_le_div {a b c : ℤ} (H : 0 < c) (H' : a ≤ b) : a / c ≤ b / c := +int.le_div_of_mul_le H (le_trans (int.div_mul_le _ (ne_of_gt H)) H') + +protected theorem div_lt_of_lt_mul {a b c : ℤ} (H : 0 < c) (H' : a < b * c) : a / c < b := +lt_of_not_ge $ mt (int.mul_le_of_le_div H) (not_le_of_gt H') + +protected theorem lt_mul_of_div_lt {a b c : ℤ} (H1 : 0 < c) (H2 : a / c < b) : a < b * c := +lt_of_not_ge $ mt (int.le_div_of_mul_le H1) (not_le_of_gt H2) + +protected theorem div_lt_iff_lt_mul {a b c : ℤ} (H : 0 < c) : a / c < b ↔ a < b * c := +⟨int.lt_mul_of_div_lt H, int.div_lt_of_lt_mul H⟩ + +protected theorem le_mul_of_div_le {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ a) (H3 : a / b ≤ c) : + a ≤ c * b := +by rw [← int.div_mul_cancel H2]; exact mul_le_mul_of_nonneg_right H3 H1 + +protected theorem lt_div_of_mul_lt {a b c : ℤ} (H1 : 0 ≤ b) (H2 : b ∣ c) (H3 : a * b < c) : + a < c / b := +lt_of_not_ge $ mt (int.le_mul_of_div_le H1 H2) (not_le_of_gt H3) + +protected theorem lt_div_iff_mul_lt {a b : ℤ} (c : ℤ) (H : 0 < c) (H' : c ∣ b) : + a < b / c ↔ a * c < b := +⟨int.mul_lt_of_lt_div H, int.lt_div_of_mul_lt (le_of_lt H) H'⟩ + +theorem div_pos_of_pos_of_dvd {a b : ℤ} (H1 : 0 < a) (H2 : 0 ≤ b) (H3 : b ∣ a) : 0 < a / b := +int.lt_div_of_mul_lt H2 H3 (by rwa zero_mul) + +lemma nat_abs_eq_of_dvd_dvd {s t : ℤ} (hst : s ∣ t) (hts : t ∣ s) : nat_abs s = nat_abs t := +nat.dvd_antisymm (nat_abs_dvd_iff_dvd.mpr hst) (nat_abs_dvd_iff_dvd.mpr hts) + +theorem div_eq_div_of_mul_eq_mul {a b c d : ℤ} (H2 : d ∣ c) (H3 : b ≠ 0) + (H4 : d ≠ 0) (H5 : a * d = b * c) : + a / b = c / d := +int.div_eq_of_eq_mul_right H3 $ +by rw [← int.mul_div_assoc _ H2]; exact +(int.div_eq_of_eq_mul_left H4 H5.symm).symm + +lemma div_dvd_of_dvd {s t : ℤ} (hst : s ∣ t) : (t / s) ∣ t := +begin + rcases eq_or_ne s 0 with rfl | hs, + { simpa using hst }, + rcases hst with ⟨c, hc⟩, + simp [hc, int.mul_div_cancel_left _ hs], +end + +/-! ### to_nat -/ + +@[simp] theorem to_nat_le {a : ℤ} {n : ℕ} : to_nat a ≤ n ↔ a ≤ n := +by rw [(coe_nat_le_coe_nat_iff _ _).symm, to_nat_eq_max, max_le_iff]; + exact and_iff_left (coe_zero_le _) + +@[simp] theorem lt_to_nat {n : ℕ} {a : ℤ} : n < to_nat a ↔ (n : ℤ) < a := +le_iff_le_iff_lt_iff_lt.1 to_nat_le + +@[simp] +lemma coe_nat_nonpos_iff {n : ℕ} : (n : ℤ) ≤ 0 ↔ n = 0 := +⟨ λ h, le_antisymm (int.coe_nat_le.mp (h.trans int.coe_nat_zero.le)) n.zero_le, + λ h, (coe_nat_eq_zero.mpr h).le⟩ + +theorem to_nat_le_to_nat {a b : ℤ} (h : a ≤ b) : to_nat a ≤ to_nat b := +by rw to_nat_le; exact le_trans h (le_to_nat b) + +theorem to_nat_lt_to_nat {a b : ℤ} (hb : 0 < b) : to_nat a < to_nat b ↔ a < b := +⟨λ h, begin cases a, exact lt_to_nat.1 h, exact lt_trans (neg_succ_of_nat_lt_zero a) hb, end, + λ h, begin rw lt_to_nat, cases a, exact h, exact hb end⟩ + +theorem lt_of_to_nat_lt {a b : ℤ} (h : to_nat a < to_nat b) : a < b := +(to_nat_lt_to_nat $ lt_to_nat.1 $ lt_of_le_of_lt (nat.zero_le _) h).1 h + +@[simp] +lemma to_nat_pred_coe_of_pos {i : ℤ} (h : 0 < i) : ((i.to_nat - 1 : ℕ) : ℤ) = i - 1 := +by simp [h, le_of_lt h] with push_cast + +@[simp] +lemma to_nat_eq_zero : ∀ {n : ℤ}, n.to_nat = 0 ↔ n ≤ 0 +| (n : ℕ) := calc _ ↔ (n = 0) : ⟨(to_nat_coe_nat n).symm.trans, (to_nat_coe_nat n).trans⟩ + ... ↔ _ : coe_nat_nonpos_iff.symm +| -[1+ n] := show ((-((n : ℤ) + 1)).to_nat = 0) ↔ (-(n + 1) : ℤ) ≤ 0, from +calc _ ↔ true : ⟨λ _, trivial, λ h, to_nat_neg_nat _⟩ + ... ↔ _ : ⟨λ h, neg_nonpos_of_nonneg (coe_zero_le _), λ _, trivial⟩ + +@[simp] lemma to_nat_sub_of_le {a b : ℤ} (h : b ≤ a) : (to_nat (a - b) : ℤ) = a - b := +int.to_nat_of_nonneg (sub_nonneg_of_le h) + +end int + +-- We should need only a minimal development of sets in order to get here. +assert_not_exists set.range diff --git a/src/data/int/order/lemmas.lean b/src/data/int/order/lemmas.lean new file mode 100644 index 0000000000000..9a3e5142a6891 --- /dev/null +++ b/src/data/int/order/lemmas.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ +import data.int.order.basic +import algebra.group_with_zero.divisibility +import algebra.order.ring.abs + +/-! +# Further lemmas about the integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +The distinction between this file and `data.int.order.basic` is not particularly clear. +They are separated by now to minimize the porting requirements for tactics during the transition to +mathlib4. After `data.rat.order` has been ported, please feel free to reorganize these two files. +-/ + +open nat + + +namespace int + + +/-! ### nat abs -/ + +variables {a b : ℤ} {n : ℕ} + +lemma nat_abs_eq_iff_mul_self_eq {a b : ℤ} : a.nat_abs = b.nat_abs ↔ a * a = b * b := +begin + rw [← abs_eq_iff_mul_self_eq, abs_eq_nat_abs, abs_eq_nat_abs], + exact int.coe_nat_inj'.symm +end + +lemma eq_nat_abs_iff_mul_eq_zero : a.nat_abs = n ↔ (a - n) * (a + n) = 0 := +by rw [nat_abs_eq_iff, mul_eq_zero, sub_eq_zero, add_eq_zero_iff_eq_neg] + +lemma nat_abs_lt_iff_mul_self_lt {a b : ℤ} : a.nat_abs < b.nat_abs ↔ a * a < b * b := +begin + rw [← abs_lt_iff_mul_self_lt, abs_eq_nat_abs, abs_eq_nat_abs], + exact int.coe_nat_lt.symm +end + +lemma nat_abs_le_iff_mul_self_le {a b : ℤ} : a.nat_abs ≤ b.nat_abs ↔ a * a ≤ b * b := +begin + rw [← abs_le_iff_mul_self_le, abs_eq_nat_abs, abs_eq_nat_abs], + exact int.coe_nat_le.symm +end + +lemma dvd_div_of_mul_dvd {a b c : ℤ} (h : a * b ∣ c) : b ∣ c / a := +begin + rcases eq_or_ne a 0 with rfl | ha, + { simp only [int.div_zero, dvd_zero] }, + rcases h with ⟨d, rfl⟩, + refine ⟨d, _⟩, + rw [mul_assoc, int.mul_div_cancel_left _ ha], +end + +/-! ### units -/ + +lemma eq_zero_of_abs_lt_dvd {m x : ℤ} (h1 : m ∣ x) (h2 : | x | < m) : x = 0 := +begin + by_cases hm : m = 0, { subst m, exact zero_dvd_iff.mp h1, }, + rcases h1 with ⟨d, rfl⟩, + apply mul_eq_zero_of_right, + rw [←abs_lt_one_iff, ←mul_lt_iff_lt_one_right (abs_pos.mpr hm), ←abs_mul], + exact lt_of_lt_of_le h2 (le_abs_self m), +end + +end int diff --git a/src/data/int/order/units.lean b/src/data/int/order/units.lean new file mode 100644 index 0000000000000..d9970503fa589 --- /dev/null +++ b/src/data/int/order/units.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ + +import data.int.order.basic +import data.int.units +import algebra.group_power.order + +/-! +# Lemmas about units in `ℤ`, which interact with the order structure. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +namespace int + +lemma is_unit_iff_abs_eq {x : ℤ} : is_unit x ↔ abs x = 1 := +by rw [is_unit_iff_nat_abs_eq, abs_eq_nat_abs, ←int.coe_nat_one, coe_nat_inj'] + +lemma is_unit_sq {a : ℤ} (ha : is_unit a) : a ^ 2 = 1 := +by rw [sq, is_unit_mul_self ha] + +@[simp] lemma units_sq (u : ℤˣ) : u ^ 2 = 1 := +by rw [units.ext_iff, units.coe_pow, units.coe_one, is_unit_sq u.is_unit] + +alias units_sq ← units_pow_two + +@[simp] lemma units_mul_self (u : ℤˣ) : u * u = 1 := +by rw [←sq, units_sq] + +@[simp] lemma units_inv_eq_self (u : ℤˣ) : u⁻¹ = u := +by rw [inv_eq_iff_mul_eq_one, units_mul_self] + +-- `units.coe_mul` is a "wrong turn" for the simplifier, this undoes it and simplifies further +@[simp] lemma units_coe_mul_self (u : ℤˣ) : (u * u : ℤ) = 1 := +by rw [←units.coe_mul, units_mul_self, units.coe_one] + +@[simp] lemma neg_one_pow_ne_zero {n : ℕ} : (-1 : ℤ)^n ≠ 0 := +pow_ne_zero _ (abs_pos.mp (by simp)) + +lemma sq_eq_one_of_sq_lt_four {x : ℤ} (h1 : x ^ 2 < 4) (h2 : x ≠ 0) : x ^ 2 = 1 := +sq_eq_one_iff.mpr ((abs_eq (zero_le_one' ℤ)).mp (le_antisymm (lt_add_one_iff.mp + (abs_lt_of_sq_lt_sq h1 zero_le_two)) (sub_one_lt_iff.mp (abs_pos.mpr h2)))) + +lemma sq_eq_one_of_sq_le_three {x : ℤ} (h1 : x ^ 2 ≤ 3) (h2 : x ≠ 0) : x ^ 2 = 1 := +sq_eq_one_of_sq_lt_four (lt_of_le_of_lt h1 (lt_add_one 3)) h2 + +lemma units_pow_eq_pow_mod_two (u : ℤˣ) (n : ℕ) : u ^ n = u ^ (n % 2) := +by conv {to_lhs, rw ← nat.mod_add_div n 2}; rw [pow_add, pow_mul, units_sq, one_pow, mul_one] + +end int diff --git a/src/data/int/parity.lean b/src/data/int/parity.lean index 476c033387961..945b5cec31bad 100644 --- a/src/data/int/parity.lean +++ b/src/data/int/parity.lean @@ -8,6 +8,9 @@ import data.nat.parity /-! # Parity of integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains theorems about the `even` and `odd` predicates on the integers. ## Tags @@ -160,8 +163,8 @@ by simp [even_iff_two_dvd, dvd_nat_abs, coe_nat_dvd_left.symm] @[simp] theorem nat_abs_odd : odd n.nat_abs ↔ odd n := by rw [odd_iff_not_even, nat.odd_iff_not_even, nat_abs_even] -alias nat_abs_even ↔ _ even.nat_abs -alias nat_abs_odd ↔ _ odd.nat_abs +alias nat_abs_even ↔ _ _root_.even.nat_abs +alias nat_abs_odd ↔ _ _root_.odd.nat_abs attribute [protected] even.nat_abs odd.nat_abs diff --git a/src/data/int/range.lean b/src/data/int/range.lean index 4476fc56abc9e..9bde57f55dfcd 100644 --- a/src/data/int/range.lean +++ b/src/data/int/range.lean @@ -3,12 +3,15 @@ Copyright (c) 2018 Kenny Lau. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Kenny Lau -/ -import data.int.basic import data.list.range +import data.int.order.basic /-! # Intervals in ℤ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines integer ranges. `range m n` is the set of integers greater than `m` and strictly less than `n`. @@ -19,15 +22,13 @@ This could be unified with `data.list.intervals`. See the TODOs there. namespace int -local attribute [semireducible] int.nonneg - /-- List enumerating `[m, n)`. This is the ℤ variant of `list.Ico`. -/ def range (m n : ℤ) : list ℤ := (list.range (to_nat (n-m))).map $ λ r, m+r theorem mem_range_iff {m n r : ℤ} : r ∈ range m n ↔ m ≤ r ∧ r < n := ⟨λ H, let ⟨s, h1, h2⟩ := list.mem_map.1 H in h2 ▸ - ⟨le_add_of_nonneg_right trivial, + ⟨le_add_of_nonneg_right (coe_zero_le s), add_lt_of_lt_sub_left $ match n-m, h1 with | (k:ℕ), h1 := by rwa [list.mem_range, to_nat_coe_nat, ← coe_nat_lt] at h1 end⟩, diff --git a/src/data/int/sqrt.lean b/src/data/int/sqrt.lean index 829aa955bb9d2..72aaef66385da 100644 --- a/src/data/int/sqrt.lean +++ b/src/data/int/sqrt.lean @@ -8,6 +8,9 @@ import data.nat.sqrt /-! # Square root of integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the square root function on integers. `int.sqrt z` is the greatest integer `r` such that `r * r ≤ z`. If `z ≤ 0`, then `int.sqrt z = 0`. -/ diff --git a/src/data/int/succ_pred.lean b/src/data/int/succ_pred.lean index 1e8cf596bda21..1d65823913dbf 100644 --- a/src/data/int/succ_pred.lean +++ b/src/data/int/succ_pred.lean @@ -3,12 +3,15 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ -import data.int.basic +import data.int.order.basic import data.nat.succ_pred /-! # Successors and predecessors of integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we show that `ℤ` is both an archimedean `succ_order` and an archimedean `pred_order`. -/ @@ -32,6 +35,8 @@ instance : pred_order ℤ := @[simp] lemma succ_eq_succ : order.succ = succ := rfl @[simp] lemma pred_eq_pred : order.pred = pred := rfl +lemma pos_iff_one_le {a : ℤ} : 0 < a ↔ 1 ≤ a := order.succ_le_iff.symm + lemma succ_iterate (a : ℤ) : ∀ n, succ^[n] a = a + n | 0 := (add_zero a).symm | (n + 1) := by { rw [function.iterate_succ', int.coe_nat_succ, ←add_assoc], @@ -53,6 +58,12 @@ instance : is_pred_archimedean ℤ := protected lemma covby_iff_succ_eq {m n : ℤ} : m ⋖ n ↔ m + 1 = n := succ_eq_iff_covby.symm +@[simp] lemma sub_one_covby (z : ℤ) : z - 1 ⋖ z := +by rw [int.covby_iff_succ_eq, sub_add_cancel] + +@[simp] lemma covby_add_one (z : ℤ) : z ⋖ z + 1 := +int.covby_iff_succ_eq.mpr rfl + end int @[simp, norm_cast] lemma nat.cast_int_covby_iff {a b : ℕ} : (a : ℤ) ⋖ b ↔ a ⋖ b := diff --git a/src/data/int/units.lean b/src/data/int/units.lean new file mode 100644 index 0000000000000..741d16d48802f --- /dev/null +++ b/src/data/int/units.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2016 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad +-/ + +import data.nat.units +import data.int.basic +import algebra.ring.units + +/-! +# Lemmas about units in `ℤ`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +namespace int + +/-! ### units -/ + +@[simp] theorem units_nat_abs (u : ℤˣ) : nat_abs u = 1 := +units.ext_iff.1 $ nat.units_eq_one ⟨nat_abs u, nat_abs ↑u⁻¹, + by rw [← nat_abs_mul, units.mul_inv]; refl, + by rw [← nat_abs_mul, units.inv_mul]; refl⟩ + +theorem units_eq_one_or (u : ℤˣ) : u = 1 ∨ u = -1 := +by simpa only [units.ext_iff, units_nat_abs] using nat_abs_eq u + +lemma is_unit_eq_one_or {a : ℤ} : is_unit a → a = 1 ∨ a = -1 +| ⟨x, hx⟩ := hx ▸ (units_eq_one_or _).imp (congr_arg coe) (congr_arg coe) + +lemma is_unit_iff {a : ℤ} : is_unit a ↔ a = 1 ∨ a = -1 := +begin + refine ⟨λ h, is_unit_eq_one_or h, λ h, _⟩, + rcases h with rfl | rfl, + { exact is_unit_one }, + { exact is_unit_one.neg } +end + +lemma is_unit_eq_or_eq_neg {a b : ℤ} (ha : is_unit a) (hb : is_unit b) : a = b ∨ a = -b := +begin + rcases is_unit_eq_one_or hb with rfl | rfl, + { exact is_unit_eq_one_or ha }, + { rwa [or_comm, neg_neg, ←is_unit_iff] }, +end + +lemma eq_one_or_neg_one_of_mul_eq_one {z w : ℤ} (h : z * w = 1) : z = 1 ∨ z = -1 := +is_unit_iff.mp (is_unit_of_mul_eq_one z w h) + +lemma eq_one_or_neg_one_of_mul_eq_one' {z w : ℤ} (h : z * w = 1) : + (z = 1 ∧ w = 1) ∨ (z = -1 ∧ w = -1) := +begin + have h' : w * z = 1 := (mul_comm z w) ▸ h, + rcases eq_one_or_neg_one_of_mul_eq_one h with rfl | rfl; + rcases eq_one_or_neg_one_of_mul_eq_one h' with rfl | rfl; + tauto, +end + +theorem eq_of_mul_eq_one {z w : ℤ} (h : z * w = 1) : z = w := +(eq_one_or_neg_one_of_mul_eq_one' h).elim (λ h, h.1.trans h.2.symm) (λ h, h.1.trans h.2.symm) + +lemma mul_eq_one_iff_eq_one_or_neg_one {z w : ℤ} : + z * w = 1 ↔ z = 1 ∧ w = 1 ∨ z = -1 ∧ w = -1 := +begin + refine ⟨eq_one_or_neg_one_of_mul_eq_one', λ h, or.elim h (λ H, _) (λ H, _)⟩; + rcases H with ⟨rfl, rfl⟩; + refl, +end + +lemma eq_one_or_neg_one_of_mul_eq_neg_one' {z w : ℤ} (h : z * w = -1) : + z = 1 ∧ w = -1 ∨ z = -1 ∧ w = 1 := +begin + rcases is_unit_eq_one_or (is_unit.mul_iff.mp (int.is_unit_iff.mpr (or.inr h))).1 with rfl | rfl, + { exact or.inl ⟨rfl, one_mul w ▸ h⟩, }, + { exact or.inr ⟨rfl, neg_inj.mp (neg_one_mul w ▸ h)⟩, } +end + +lemma mul_eq_neg_one_iff_eq_one_or_neg_one {z w : ℤ} : + z * w = -1 ↔ z = 1 ∧ w = -1 ∨ z = -1 ∧ w = 1 := +begin + refine ⟨eq_one_or_neg_one_of_mul_eq_neg_one', λ h, or.elim h (λ H, _) (λ H, _)⟩; + rcases H with ⟨rfl, rfl⟩; + refl, +end + +theorem is_unit_iff_nat_abs_eq {n : ℤ} : is_unit n ↔ n.nat_abs = 1 := +by simp [nat_abs_eq_iff, is_unit_iff, nat.cast_zero] + +alias is_unit_iff_nat_abs_eq ↔ is_unit.nat_abs_eq _ + +@[norm_cast] +lemma of_nat_is_unit {n : ℕ} : is_unit (n : ℤ) ↔ is_unit n := +by rw [nat.is_unit_iff, is_unit_iff_nat_abs_eq, nat_abs_of_nat] + +lemma is_unit_mul_self {a : ℤ} (ha : is_unit a) : a * a = 1 := +(is_unit_eq_one_or ha).elim (λ h, h.symm ▸ rfl) (λ h, h.symm ▸ rfl) + +lemma is_unit_add_is_unit_eq_is_unit_add_is_unit {a b c d : ℤ} + (ha : is_unit a) (hb : is_unit b) (hc : is_unit c) (hd : is_unit d) : + a + b = c + d ↔ a = c ∧ b = d ∨ a = d ∧ b = c := +begin + rw is_unit_iff at ha hb hc hd, + cases ha; cases hb; cases hc; cases hd; + subst ha; subst hb; subst hc; subst hd; + tidy, +end + +lemma eq_one_or_neg_one_of_mul_eq_neg_one {z w : ℤ} (h : z * w = -1) : z = 1 ∨ z = -1 := +or.elim (eq_one_or_neg_one_of_mul_eq_neg_one' h) (λ H, or.inl H.1) (λ H, or.inr H.1) + +end int diff --git a/src/data/is_R_or_C/basic.lean b/src/data/is_R_or_C/basic.lean new file mode 100644 index 0000000000000..71714a3f5cf1c --- /dev/null +++ b/src/data/is_R_or_C/basic.lean @@ -0,0 +1,674 @@ +/- +Copyright (c) 2020 Frédéric Dupuis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Frédéric Dupuis +-/ +import data.real.sqrt +import analysis.normed_space.star.basic +import analysis.normed_space.continuous_linear_map + +/-! +# `is_R_or_C`: a typeclass for ℝ or ℂ + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the typeclass `is_R_or_C` intended to have only two instances: +ℝ and ℂ. It is meant for definitions and theorems which hold for both the real and the complex case, +and in particular when the real case follows directly from the complex case by setting `re` to `id`, +`im` to zero and so on. Its API follows closely that of ℂ. + +Applications include defining inner products and Hilbert spaces for both the real and +complex case. One typically produces the definitions and proof for an arbitrary field of this +typeclass, which basically amounts to doing the complex case, and the two cases then fall out +immediately from the two instances of the class. + +The instance for `ℝ` is registered in this file. +The instance for `ℂ` is declared in `analysis.complex.basic`. + +## Implementation notes + +The coercion from reals into an `is_R_or_C` field is done by registering `algebra_map ℝ K` as +a `has_coe_t`. For this to work, we must proceed carefully to avoid problems involving circular +coercions in the case `K=ℝ`; in particular, we cannot use the plain `has_coe` and must set +priorities carefully. This problem was already solved for `ℕ`, and we copy the solution detailed +in `data/nat/cast`. See also Note [coercion into rings] for more details. + +In addition, several lemmas need to be set at priority 900 to make sure that they do not override +their counterparts in `complex.lean` (which causes linter errors). + +A few lemmas requiring heavier imports are in `data.is_R_or_C.lemmas`. +-/ + +open_locale big_operators + +section + +local notation `𝓚` := algebra_map ℝ _ +open_locale complex_conjugate + +/-- +This typeclass captures properties shared by ℝ and ℂ, with an API that closely matches that of ℂ. +-/ +class is_R_or_C (K : Type*) + extends densely_normed_field K, star_ring K, normed_algebra ℝ K, complete_space K := +(re : K →+ ℝ) +(im : K →+ ℝ) +(I : K) -- Meant to be set to 0 for K=ℝ +(I_re_ax : re I = 0) +(I_mul_I_ax : I = 0 ∨ I * I = -1) +(re_add_im_ax : ∀ (z : K), 𝓚 (re z) + 𝓚 (im z) * I = z) +(of_real_re_ax : ∀ r : ℝ, re (𝓚 r) = r) +(of_real_im_ax : ∀ r : ℝ, im (𝓚 r) = 0) +(mul_re_ax : ∀ z w : K, re (z * w) = re z * re w - im z * im w) +(mul_im_ax : ∀ z w : K, im (z * w) = re z * im w + im z * re w) +(conj_re_ax : ∀ z : K, re (conj z) = re z) +(conj_im_ax : ∀ z : K, im (conj z) = -(im z)) +(conj_I_ax : conj I = -I) +(norm_sq_eq_def_ax : ∀ (z : K), ‖z‖^2 = (re z) * (re z) + (im z) * (im z)) +(mul_im_I_ax : ∀ (z : K), (im z) * im I = im z) + +end + +variables {K E : Type*} [is_R_or_C K] + +namespace is_R_or_C + +open_locale complex_conjugate + +/- The priority must be set at 900 to ensure that coercions are tried in the right order. +See Note [coercion into rings], or `data/nat/cast.lean` for more details. -/ +@[priority 900] noncomputable instance algebra_map_coe : has_coe_t ℝ K := ⟨algebra_map ℝ K⟩ + +lemma of_real_alg (x : ℝ) : (x : K) = x • (1 : K) := +algebra.algebra_map_eq_smul_one x + +lemma real_smul_eq_coe_mul (r : ℝ) (z : K) : r • z = (r : K) * z := +algebra.smul_def r z + +lemma real_smul_eq_coe_smul [add_comm_group E] [module K E] [module ℝ E] [is_scalar_tower ℝ K E] + (r : ℝ) (x : E) : r • x = (r : K) • x := +by rw [is_R_or_C.of_real_alg, smul_one_smul] + +lemma algebra_map_eq_of_real : ⇑(algebra_map ℝ K) = coe := rfl + +@[simp, is_R_or_C_simps] lemma re_add_im (z : K) : ((re z) : K) + (im z) * I = z := +is_R_or_C.re_add_im_ax z +@[simp, norm_cast, is_R_or_C_simps] lemma of_real_re : ∀ r : ℝ, re (r : K) = r := +is_R_or_C.of_real_re_ax +@[simp, norm_cast, is_R_or_C_simps] lemma of_real_im : ∀ r : ℝ, im (r : K) = 0 := +is_R_or_C.of_real_im_ax +@[simp, is_R_or_C_simps] lemma mul_re : ∀ z w : K, re (z * w) = re z * re w - im z * im w := +is_R_or_C.mul_re_ax +@[simp, is_R_or_C_simps] lemma mul_im : ∀ z w : K, im (z * w) = re z * im w + im z * re w := +is_R_or_C.mul_im_ax + +theorem ext_iff {z w : K} : z = w ↔ re z = re w ∧ im z = im w := +⟨λ h, h ▸ ⟨rfl, rfl⟩, λ ⟨h₁, h₂⟩, re_add_im z ▸ re_add_im w ▸ h₁ ▸ h₂ ▸ rfl⟩ + +theorem ext {z w : K} (hre : re z = re w) (him : im z = im w) : z = w := +ext_iff.2 ⟨hre, him⟩ + +@[norm_cast] lemma of_real_zero : ((0 : ℝ) : K) = 0 := algebra_map.coe_zero + +@[is_R_or_C_simps] lemma zero_re' : re (0 : K) = (0 : ℝ) := map_zero re + +@[norm_cast] lemma of_real_one : ((1 : ℝ) : K) = 1 := map_one (algebra_map ℝ K) +@[simp, is_R_or_C_simps] lemma one_re : re (1 : K) = 1 := by rw [← of_real_one, of_real_re] +@[simp, is_R_or_C_simps] lemma one_im : im (1 : K) = 0 := by rw [← of_real_one, of_real_im] + +theorem of_real_injective : function.injective (coe : ℝ → K) := (algebra_map ℝ K).injective +@[norm_cast] theorem of_real_inj {z w : ℝ} : (z : K) = (w : K) ↔ z = w := algebra_map.coe_inj + +@[simp, is_R_or_C_simps] lemma bit0_re (z : K) : re (bit0 z) = bit0 (re z) := map_bit0 _ _ + +@[simp, is_R_or_C_simps] lemma bit1_re (z : K) : re (bit1 z) = bit1 (re z) := +by simp only [bit1, map_add, bit0_re, one_re] + +@[simp, is_R_or_C_simps] lemma bit0_im (z : K) : im (bit0 z) = bit0 (im z) := map_bit0 _ _ + +@[simp, is_R_or_C_simps] lemma bit1_im (z : K) : im (bit1 z) = bit0 (im z) := +by simp only [bit1, map_add, bit0_im, one_im, add_zero] + +theorem of_real_eq_zero {x : ℝ} : (x : K) = 0 ↔ x = 0 := algebra_map.lift_map_eq_zero_iff x +theorem of_real_ne_zero {x : ℝ} : (x : K) ≠ 0 ↔ x ≠ 0 := of_real_eq_zero.not + +@[simp, is_R_or_C_simps, norm_cast, priority 900] +lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : K) = r + s := algebra_map.coe_add _ _ + +@[simp, is_R_or_C_simps, norm_cast, priority 900] +lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : K) = bit0 (r : K) := of_real_add _ _ + +@[simp, is_R_or_C_simps, norm_cast, priority 900] +lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : K) = bit1 (r : K) := +map_bit1 (algebra_map ℝ K) r + +@[simp, norm_cast, is_R_or_C_simps, priority 900] +lemma of_real_neg (r : ℝ) : ((-r : ℝ) : K) = -r := algebra_map.coe_neg r + +@[simp, norm_cast, is_R_or_C_simps, priority 900] +lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : K) = r - s := map_sub (algebra_map ℝ K) r s + +@[simp, is_R_or_C_simps, norm_cast, priority 900] +lemma of_real_sum {α : Type*} (s : finset α) (f : α → ℝ) : + ((∑ i in s, f i : ℝ) : K) = ∑ i in s, (f i : K) := +map_sum (algebra_map ℝ K) _ _ + +@[simp, is_R_or_C_simps, norm_cast] lemma of_real_finsupp_sum + {α M : Type*} [has_zero M] (f : α →₀ M) (g : α → M → ℝ) : + ((f.sum (λ a b, g a b) : ℝ) : K) = f.sum (λ a b, ((g a b) : K)) := +map_finsupp_sum (algebra_map ℝ K) f g + +@[simp, norm_cast, is_R_or_C_simps, priority 900] +lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : K) = r * s := algebra_map.coe_mul _ _ + +@[simp, norm_cast, is_R_or_C_simps, priority 900] +lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : K) = r ^ n := map_pow (algebra_map ℝ K) r n + +@[simp, is_R_or_C_simps, norm_cast, priority 900] +lemma of_real_prod {α : Type*} (s : finset α) (f : α → ℝ) : + ((∏ i in s, f i : ℝ) : K) = ∏ i in s, (f i : K) := +ring_hom.map_prod _ _ _ + +@[simp, is_R_or_C_simps, norm_cast] lemma of_real_finsupp_prod + {α M : Type*} [has_zero M] (f : α →₀ M) (g : α → M → ℝ) : + ((f.prod (λ a b, g a b) : ℝ) : K) = f.prod (λ a b, ((g a b) : K)) := +ring_hom.map_finsupp_prod _ f g + +@[simp, norm_cast, is_R_or_C_simps] +lemma real_smul_of_real (r x : ℝ) : r • (x : K) = (r : K) * (x : K) := real_smul_eq_coe_mul _ _ + +@[is_R_or_C_simps] lemma of_real_mul_re (r : ℝ) (z : K) : re (↑r * z) = r * re z := +by simp only [mul_re, of_real_im, zero_mul, of_real_re, sub_zero] + +@[is_R_or_C_simps] lemma of_real_mul_im (r : ℝ) (z : K) : im (↑r * z) = r * (im z) := +by simp only [add_zero, of_real_im, zero_mul, of_real_re, mul_im] + +@[is_R_or_C_simps] lemma smul_re (r : ℝ) (z : K) : re (r • z) = r * (re z) := +by rw [real_smul_eq_coe_mul, of_real_mul_re] + +@[is_R_or_C_simps] lemma smul_im (r : ℝ) (z : K) : im (r • z) = r * (im z) := +by rw [real_smul_eq_coe_mul, of_real_mul_im] + +@[simp, norm_cast, is_R_or_C_simps] lemma norm_of_real (r : ℝ) : ‖(r : K)‖ = |r| := +norm_algebra_map' K r + +/-! ### Characteristic zero -/ + +/-- ℝ and ℂ are both of characteristic zero. -/ +@[priority 100] -- see Note [lower instance priority] +instance char_zero_R_or_C : char_zero K := +(ring_hom.char_zero_iff (algebra_map ℝ K).injective).1 infer_instance + +/-! ### The imaginary unit, `I` -/ + +/-- The imaginary unit. -/ +@[simp, is_R_or_C_simps] lemma I_re : re (I : K) = 0 := I_re_ax +@[simp, is_R_or_C_simps] lemma I_im (z : K) : im z * im (I : K) = im z := mul_im_I_ax z +@[simp, is_R_or_C_simps] lemma I_im' (z : K) : im (I : K) * im z = im z := +by rw [mul_comm, I_im _] + +@[simp, is_R_or_C_simps] lemma I_mul_re (z : K) : re (I * z) = - im z := +by simp only [I_re, zero_sub, I_im', zero_mul, mul_re] + +lemma I_mul_I : (I : K) = 0 ∨ (I : K) * I = -1 := I_mul_I_ax + +@[simp, is_R_or_C_simps] lemma conj_re (z : K) : re (conj z) = re z := is_R_or_C.conj_re_ax z +@[simp, is_R_or_C_simps] lemma conj_im (z : K) : im (conj z) = -(im z) := is_R_or_C.conj_im_ax z +@[simp, is_R_or_C_simps] lemma conj_I : conj (I : K) = -I := is_R_or_C.conj_I_ax +@[simp, is_R_or_C_simps] lemma conj_of_real (r : ℝ) : conj (r : K) = (r : K) := +by { rw ext_iff, simp only [of_real_im, conj_im, eq_self_iff_true, conj_re, and_self, neg_zero] } + + +@[simp, is_R_or_C_simps] lemma conj_bit0 (z : K) : conj (bit0 z) = bit0 (conj z) := map_bit0 _ _ +@[simp, is_R_or_C_simps] lemma conj_bit1 (z : K) : conj (bit1 z) = bit1 (conj z) := map_bit1 _ _ + +@[simp, is_R_or_C_simps] lemma conj_neg_I : conj (-I) = (I : K) := +by rw [map_neg, conj_I, neg_neg] + +lemma conj_eq_re_sub_im (z : K) : conj z = re z - im z * I := +(congr_arg conj (re_add_im z).symm).trans $ by rw [map_add, map_mul, conj_I, conj_of_real, + conj_of_real, mul_neg, sub_eq_add_neg] + +theorem sub_conj (z : K) : z - conj z = 2 * im z * I := +begin + nth_rewrite 0 [← re_add_im z], + rw [conj_eq_re_sub_im, add_sub_sub_cancel, ← two_mul, mul_assoc] +end + +@[is_R_or_C_simps] lemma conj_smul (r : ℝ) (z : K) : conj (r • z) = r • conj z := +by rw [conj_eq_re_sub_im, conj_eq_re_sub_im, smul_re, smul_im, of_real_mul, of_real_mul, + real_smul_eq_coe_mul, mul_sub, mul_assoc] + +theorem add_conj (z : K) : z + conj z = 2 * re z := +calc z + conj z = re z + im z * I + (re z - im z * I) : by rw [re_add_im, conj_eq_re_sub_im] +... = 2 * re z : by rw [add_add_sub_cancel, two_mul] + +theorem re_eq_add_conj (z : K) : ↑(re z) = (z + conj z) / 2 := +by rw [add_conj, mul_div_cancel_left ((re z):K) two_ne_zero] + +theorem im_eq_conj_sub (z : K) : ↑(im z) = I * (conj z - z) / 2 := +by rw [← neg_inj, ← of_real_neg, ← I_mul_re, re_eq_add_conj, map_mul, conj_I, ← neg_div, ← mul_neg, + neg_sub, mul_sub, neg_mul, sub_eq_add_neg] + +/-- There are several equivalent ways to say that a number `z` is in fact a real number. -/ +theorem is_real_tfae (z : K) : + tfae [conj z = z, ∃ r : ℝ, (r : K) = z, ↑(re z) = z, im z = 0] := +begin + tfae_have : 1 → 4, + { intro h, + rw [← @of_real_inj K, im_eq_conj_sub, h, sub_self, mul_zero, zero_div, of_real_zero] }, + tfae_have : 4 → 3, + { intro h, + conv_rhs { rw [← re_add_im z, h, of_real_zero, zero_mul, add_zero] } }, + tfae_have : 3 → 2, from λ h, ⟨_, h⟩, + tfae_have : 2 → 1, from λ ⟨r, hr⟩, hr ▸ conj_of_real _, + tfae_finish +end + +lemma conj_eq_iff_real {z : K} : conj z = z ↔ ∃ r : ℝ, z = (r : K) := +((is_real_tfae z).out 0 1).trans $ by simp only [eq_comm] + +lemma conj_eq_iff_re {z : K} : conj z = z ↔ ((re z) : K) = z := +(is_real_tfae z).out 0 2 + +lemma conj_eq_iff_im {z : K} : conj z = z ↔ im z = 0 := (is_real_tfae z).out 0 3 + +@[simp] lemma star_def : (has_star.star : K → K) = conj := rfl + +variables (K) +/-- Conjugation as a ring equivalence. This is used to convert the inner product into a +sesquilinear product. -/ +abbreviation conj_to_ring_equiv : K ≃+* Kᵐᵒᵖ := star_ring_equiv + +variables {K} + +/-- The norm squared function. -/ +def norm_sq : K →*₀ ℝ := +{ to_fun := λ z, re z * re z + im z * im z, + map_zero' := by simp only [add_zero, mul_zero, map_zero], + map_one' := by simp only [one_im, add_zero, mul_one, one_re, mul_zero], + map_mul' := λ z w, by { simp only [mul_im, mul_re], ring } } + +lemma norm_sq_apply (z : K) : norm_sq z = re z * re z + im z * im z := rfl + +lemma norm_sq_eq_def {z : K} : ‖z‖^2 = re z * re z + im z * im z := norm_sq_eq_def_ax z +lemma norm_sq_eq_def' (z : K) : norm_sq z = ‖z‖^2 := norm_sq_eq_def.symm + +@[is_R_or_C_simps] lemma norm_sq_zero : norm_sq (0 : K) = 0 := norm_sq.map_zero +@[is_R_or_C_simps] lemma norm_sq_one : norm_sq (1 : K) = 1 := norm_sq.map_one + +lemma norm_sq_nonneg (z : K) : 0 ≤ norm_sq z := +add_nonneg (mul_self_nonneg _) (mul_self_nonneg _) + +@[simp, is_R_or_C_simps] lemma norm_sq_eq_zero {z : K} : norm_sq z = 0 ↔ z = 0 := +by { rw [norm_sq_eq_def'], simp [sq] } + +@[simp, is_R_or_C_simps] lemma norm_sq_pos {z : K} : 0 < norm_sq z ↔ z ≠ 0 := +by rw [lt_iff_le_and_ne, ne, eq_comm]; simp [norm_sq_nonneg] + +@[simp, is_R_or_C_simps] lemma norm_sq_neg (z : K) : norm_sq (-z) = norm_sq z := +by simp only [norm_sq_eq_def', norm_neg] + +@[simp, is_R_or_C_simps] lemma norm_sq_conj (z : K) : norm_sq (conj z) = norm_sq z := +by simp only [norm_sq_apply, neg_mul, mul_neg, neg_neg] with is_R_or_C_simps + +@[simp, is_R_or_C_simps] lemma norm_sq_mul (z w : K) : norm_sq (z * w) = norm_sq z * norm_sq w := +norm_sq.map_mul z w + +lemma norm_sq_add (z w : K) : + norm_sq (z + w) = norm_sq z + norm_sq w + 2 * (re (z * conj w)) := +by { simp only [norm_sq_apply, map_add, mul_neg, sub_neg_eq_add] with is_R_or_C_simps, ring } + +lemma re_sq_le_norm_sq (z : K) : re z * re z ≤ norm_sq z := +le_add_of_nonneg_right (mul_self_nonneg _) + +lemma im_sq_le_norm_sq (z : K) : im z * im z ≤ norm_sq z := +le_add_of_nonneg_left (mul_self_nonneg _) + +theorem mul_conj (z : K) : z * conj z = ((norm_sq z) : K) := +by simp only [map_add, add_zero, ext_iff, add_left_inj, mul_eq_mul_left_iff, zero_mul, add_comm, + true_or, eq_self_iff_true, mul_neg, add_right_neg, zero_add, norm_sq_apply, mul_comm, + and_self, neg_neg, mul_zero, sub_eq_neg_add, neg_zero] with is_R_or_C_simps + +lemma conj_mul (x : K) : conj x * x = ((norm_sq x) : K) := by rw [mul_comm, mul_conj] + +lemma norm_sq_sub (z w : K) : norm_sq (z - w) = norm_sq z + norm_sq w - 2 * re (z * conj w) := +by simp only [norm_sq_add, sub_eq_add_neg, ring_equiv.map_neg, mul_neg, + norm_sq_neg, map_neg] + +lemma sqrt_norm_sq_eq_norm {z : K} : real.sqrt (norm_sq z) = ‖z‖ := +by rw [norm_sq_eq_def', real.sqrt_sq (norm_nonneg _)] + +/-! ### Inversion -/ + +@[simp, norm_cast, is_R_or_C_simps, priority 900] +lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : K) = r⁻¹ := map_inv₀ (algebra_map ℝ K) r + +theorem inv_def (z : K) : z⁻¹ = conj z * ((‖z‖^2)⁻¹:ℝ) := +begin + rcases eq_or_ne z 0 with (rfl | h₀), + { simp }, + { apply inv_eq_of_mul_eq_one_right, + rw [← mul_assoc, mul_conj, of_real_inv, ← norm_sq_eq_def', mul_inv_cancel], + rwa [of_real_ne_zero, ne.def, norm_sq_eq_zero] } +end + +@[simp, is_R_or_C_simps] lemma inv_re (z : K) : re (z⁻¹) = re z / norm_sq z := +by rw [inv_def, norm_sq_eq_def', mul_comm, of_real_mul_re, conj_re, div_eq_inv_mul] + +@[simp, is_R_or_C_simps] lemma inv_im (z : K) : im (z⁻¹) = -im z / norm_sq z := +by rw [inv_def, norm_sq_eq_def', mul_comm, of_real_mul_im, conj_im, div_eq_inv_mul] + +lemma div_re (z w : K) : re (z / w) = re z * re w / norm_sq w + im z * im w / norm_sq w := +by simp only [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, neg_mul, + mul_neg, neg_neg, map_neg] with is_R_or_C_simps + +lemma div_im (z w : K) : im (z / w) = im z * re w / norm_sq w - re z * im w / norm_sq w := +by simp only [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm, neg_mul, + mul_neg, map_neg] with is_R_or_C_simps + +@[simp, is_R_or_C_simps] +lemma conj_inv (x : K) : conj (x⁻¹) = (conj x)⁻¹ := star_inv' _ + +@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_div (r s : ℝ) : + ((r / s : ℝ) : K) = r / s := +map_div₀ (algebra_map ℝ K) r s + +lemma div_re_of_real {z : K} {r : ℝ} : re (z / r) = re z / r := +by rw [div_eq_inv_mul, div_eq_inv_mul, ← of_real_inv, of_real_mul_re] + +@[simp, norm_cast, is_R_or_C_simps, priority 900] lemma of_real_zpow (r : ℝ) (n : ℤ) : + ((r ^ n : ℝ) : K) = r ^ n := +map_zpow₀ (algebra_map ℝ K) r n + +lemma I_mul_I_of_nonzero : (I : K) ≠ 0 → (I : K) * I = -1 := I_mul_I_ax.resolve_left + +@[simp, is_R_or_C_simps] lemma inv_I : (I : K)⁻¹ = -I := +begin + by_cases h : (I : K) = 0, + { simp [h] }, + { field_simp [I_mul_I_of_nonzero h] } +end + +@[simp, is_R_or_C_simps] lemma div_I (z : K) : z / I = -(z * I) := +by rw [div_eq_mul_inv, inv_I, mul_neg] + +@[simp, is_R_or_C_simps] lemma norm_sq_inv (z : K) : norm_sq z⁻¹ = (norm_sq z)⁻¹ := +map_inv₀ (@norm_sq K _) z + +@[simp, is_R_or_C_simps] lemma norm_sq_div (z w : K) : norm_sq (z / w) = norm_sq z / norm_sq w := +map_div₀ (@norm_sq K _) z w + +@[simp, is_R_or_C_simps] lemma norm_conj {z : K} : ‖conj z‖ = ‖z‖ := +by simp only [← sqrt_norm_sq_eq_norm, norm_sq_conj] + +@[priority 100] instance : cstar_ring K := +{ norm_star_mul_self := λ x, (norm_mul _ _).trans $ congr_arg (* ‖x‖) norm_conj } + +/-! ### Cast lemmas -/ + +@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_nat_cast (n : ℕ) : + ((n : ℝ) : K) = n := +map_nat_cast (algebra_map ℝ K) n + +@[simp, is_R_or_C_simps, norm_cast] lemma nat_cast_re (n : ℕ) : re (n : K) = n := +by rw [← of_real_nat_cast, of_real_re] + +@[simp, is_R_or_C_simps, norm_cast] lemma nat_cast_im (n : ℕ) : im (n : K) = 0 := +by rw [← of_real_nat_cast, of_real_im] + +@[simp, is_R_or_C_simps, norm_cast, priority 900] +lemma of_real_int_cast (n : ℤ) : ((n : ℝ) : K) = n := map_int_cast (algebra_map ℝ K) n + +@[simp, is_R_or_C_simps, norm_cast] lemma int_cast_re (n : ℤ) : re (n : K) = n := +by rw [← of_real_int_cast, of_real_re] + +@[simp, is_R_or_C_simps, norm_cast] lemma int_cast_im (n : ℤ) : im (n : K) = 0 := +by rw [← of_real_int_cast, of_real_im] + +@[simp, is_R_or_C_simps, norm_cast, priority 900] theorem of_real_rat_cast (n : ℚ) : + ((n : ℝ) : K) = n := +map_rat_cast (algebra_map ℝ K) n + +@[simp, is_R_or_C_simps, norm_cast] lemma rat_cast_re (q : ℚ) : re (q : K) = q := +by rw [← of_real_rat_cast, of_real_re] + +@[simp, is_R_or_C_simps, norm_cast] lemma rat_cast_im (q : ℚ) : im (q : K) = 0 := +by rw [← of_real_rat_cast, of_real_im] + +/-! ### Norm -/ + +lemma norm_of_nonneg {r : ℝ} (h : 0 ≤ r) : ‖(r : K)‖ = r := +(norm_of_real _).trans (abs_of_nonneg h) + +@[simp, priority 900, is_R_or_C_simps, norm_cast] +lemma norm_nat_cast (n : ℕ) : ‖(n : K)‖ = n := +by { rw [← of_real_nat_cast], exact norm_of_nonneg (nat.cast_nonneg n) } + +lemma mul_self_norm (z : K) : ‖z‖ * ‖z‖ = norm_sq z := +by rw [norm_sq_eq_def', sq] + +attribute [is_R_or_C_simps] norm_zero norm_one norm_eq_zero abs_norm norm_inv norm_div + +@[simp, priority 900, is_R_or_C_simps] lemma norm_two : ‖(2 : K)‖ = 2 := +by rw [← nat.cast_two, norm_nat_cast, nat.cast_two] + +lemma abs_re_le_norm (z : K) : |re z| ≤ ‖z‖ := +by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg (re z)) (norm_nonneg _), + abs_mul_abs_self, mul_self_norm]; + apply re_sq_le_norm_sq + +lemma abs_im_le_norm (z : K) : |im z| ≤ ‖z‖ := +by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg (im z)) (norm_nonneg _), + abs_mul_abs_self, mul_self_norm]; + apply im_sq_le_norm_sq + +lemma norm_re_le_norm (z : K) : ‖re z‖ ≤ ‖z‖ := abs_re_le_norm z +lemma norm_im_le_norm (z : K) : ‖im z‖ ≤ ‖z‖ := abs_im_le_norm z + +lemma re_le_norm (z : K) : re z ≤ ‖z‖ := (abs_le.1 (abs_re_le_norm z)).2 +lemma im_le_norm (z : K) : im z ≤ ‖z‖ := (abs_le.1 (abs_im_le_norm _)).2 + +lemma im_eq_zero_of_le {a : K} (h : ‖a‖ ≤ re a) : im a = 0 := +by simpa only [mul_self_norm a, norm_sq_apply, self_eq_add_right, mul_self_eq_zero] + using congr_arg (λ z, z * z) ((re_le_norm a).antisymm h) + +lemma re_eq_self_of_le {a : K} (h : ‖a‖ ≤ re a) : (re a : K) = a := +by rw [(is_real_tfae a).out 2 3, im_eq_zero_of_le h] + +open is_absolute_value + +lemma abs_re_div_norm_le_one (z : K) : |re z / ‖z‖| ≤ 1 := +begin + rw [abs_div, abs_norm], + exact div_le_one_of_le (abs_re_le_norm _) (norm_nonneg _) +end + +lemma abs_im_div_norm_le_one (z : K) : |im z / ‖z‖| ≤ 1 := +begin + rw [abs_div, abs_norm], + exact div_le_one_of_le (abs_im_le_norm _) (norm_nonneg _) +end + +lemma norm_I_of_ne_zero (hI : (I : K) ≠ 0) : ‖(I : K)‖ = 1 := +begin + rw [← mul_self_inj_of_nonneg (norm_nonneg I) zero_le_one, one_mul, ← norm_mul, + I_mul_I_of_nonzero hI, norm_neg, norm_one], +end + +lemma re_eq_norm_of_mul_conj (x : K) : re (x * conj x) = ‖x * conj x‖ := +by rw [mul_conj, of_real_re, norm_of_real, abs_of_nonneg (norm_sq_nonneg _)] + +lemma norm_sq_re_add_conj (x : K) : (‖x + conj x‖)^2 = (re (x + conj x))^2 := +by rw [add_conj, norm_mul, norm_two, norm_of_real, two_mul (re x : K), map_add, of_real_re, + ← two_mul, mul_pow, mul_pow, sq_abs] + +lemma norm_sq_re_conj_add (x : K) : (‖conj x + x‖)^2 = (re (conj x + x))^2 := +by rw [add_comm, norm_sq_re_add_conj] + +/-! ### Cauchy sequences -/ + +theorem is_cau_seq_re (f : cau_seq K norm) : is_cau_seq abs (λ n, re (f n)) := +λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij, +lt_of_le_of_lt (by simpa only [map_sub] using abs_re_le_norm (f j - f i)) (H _ ij) + +theorem is_cau_seq_im (f : cau_seq K norm) : is_cau_seq abs (λ n, im (f n)) := +λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij, +lt_of_le_of_lt (by simpa only [map_sub] using abs_im_le_norm (f j - f i)) (H _ ij) + +/-- The real part of a K Cauchy sequence, as a real Cauchy sequence. -/ +noncomputable def cau_seq_re (f : cau_seq K norm) : cau_seq ℝ abs := +⟨_, is_cau_seq_re f⟩ + +/-- The imaginary part of a K Cauchy sequence, as a real Cauchy sequence. -/ +noncomputable def cau_seq_im (f : cau_seq K norm) : cau_seq ℝ abs := +⟨_, is_cau_seq_im f⟩ + +lemma is_cau_seq_norm {f : ℕ → K} (hf : is_cau_seq norm f) : + is_cau_seq abs (norm ∘ f) := +λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in +⟨i, λ j hj, lt_of_le_of_lt (abs_norm_sub_norm_le _ _) (hi j hj)⟩ + +end is_R_or_C + + +section instances + +noncomputable instance real.is_R_or_C : is_R_or_C ℝ := +{ re := add_monoid_hom.id ℝ, + im := 0, + I := 0, + I_re_ax := by simp only [add_monoid_hom.map_zero], + I_mul_I_ax := or.intro_left _ rfl, + re_add_im_ax := λ z, by simp only [add_zero, mul_zero, algebra.id.map_eq_id, ring_hom.id_apply, + add_monoid_hom.id_apply], + of_real_re_ax := λ r, by simp only [add_monoid_hom.id_apply, algebra.id.map_eq_self], + of_real_im_ax := λ r, by simp only [add_monoid_hom.zero_apply], + mul_re_ax := λ z w, + by simp only [sub_zero, mul_zero, add_monoid_hom.zero_apply, add_monoid_hom.id_apply], + mul_im_ax := λ z w, by simp only [add_zero, zero_mul, mul_zero, add_monoid_hom.zero_apply], + conj_re_ax := λ z, by simp only [star_ring_end_apply, star_id_of_comm], + conj_im_ax := λ z, by simp only [neg_zero, add_monoid_hom.zero_apply], + conj_I_ax := by simp only [ring_hom.map_zero, neg_zero], + norm_sq_eq_def_ax := λ z, by simp only [sq, real.norm_eq_abs, ←abs_mul, abs_mul_self z, add_zero, + mul_zero, add_monoid_hom.zero_apply, add_monoid_hom.id_apply], + mul_im_I_ax := λ z, by simp only [mul_zero, add_monoid_hom.zero_apply], + .. real.densely_normed_field, .. real.metric_space } + +end instances + +namespace is_R_or_C + +open_locale complex_conjugate + +section cleanup_lemmas + +local notation `reR` := @is_R_or_C.re ℝ _ +local notation `imR` := @is_R_or_C.im ℝ _ +local notation `IR` := @is_R_or_C.I ℝ _ +local notation `norm_sqR` := @is_R_or_C.norm_sq ℝ _ + +@[simp, is_R_or_C_simps] lemma re_to_real {x : ℝ} : reR x = x := rfl +@[simp, is_R_or_C_simps] lemma im_to_real {x : ℝ} : imR x = 0 := rfl +@[simp, is_R_or_C_simps] lemma conj_to_real {x : ℝ} : conj x = x := rfl +@[simp, is_R_or_C_simps] lemma I_to_real : IR = 0 := rfl +@[simp, is_R_or_C_simps] lemma norm_sq_to_real {x : ℝ} : norm_sq x = x*x := +by simp [is_R_or_C.norm_sq] + +@[simp] lemma coe_real_eq_id : @coe ℝ ℝ _ = id := rfl + +end cleanup_lemmas + +section linear_maps + +/-- The real part in a `is_R_or_C` field, as a linear map. -/ +def re_lm : K →ₗ[ℝ] ℝ := +{ map_smul' := smul_re, .. re } + +@[simp, is_R_or_C_simps] lemma re_lm_coe : (re_lm : K → ℝ) = re := rfl + +/-- The real part in a `is_R_or_C` field, as a continuous linear map. -/ +noncomputable def re_clm : K →L[ℝ] ℝ := +linear_map.mk_continuous re_lm 1 $ λ x, by { rw [one_mul], exact abs_re_le_norm x } + +@[simp, is_R_or_C_simps, norm_cast] lemma re_clm_coe : ((re_clm : K →L[ℝ] ℝ) : + K →ₗ[ℝ] ℝ) = re_lm := rfl + +@[simp, is_R_or_C_simps] lemma re_clm_apply : ((re_clm : K →L[ℝ] ℝ) : K → ℝ) = re := rfl + +@[continuity] lemma continuous_re : continuous (re : K → ℝ) := re_clm.continuous + +/-- The imaginary part in a `is_R_or_C` field, as a linear map. -/ +def im_lm : K →ₗ[ℝ] ℝ := +{ map_smul' := smul_im, .. im } + +@[simp, is_R_or_C_simps] lemma im_lm_coe : (im_lm : K → ℝ) = im := rfl + +/-- The imaginary part in a `is_R_or_C` field, as a continuous linear map. -/ +noncomputable def im_clm : K →L[ℝ] ℝ := +linear_map.mk_continuous im_lm 1 $ fun x, by { rw [one_mul], exact abs_im_le_norm x } + +@[simp, is_R_or_C_simps, norm_cast] lemma im_clm_coe : ((im_clm : K →L[ℝ] ℝ) : + K →ₗ[ℝ] ℝ) = im_lm := rfl + +@[simp, is_R_or_C_simps] lemma im_clm_apply : ((im_clm : K →L[ℝ] ℝ) : K → ℝ) = im := rfl + +@[continuity] lemma continuous_im : continuous (im : K → ℝ) := im_clm.continuous + +/-- Conjugate as an `ℝ`-algebra equivalence -/ +def conj_ae : K ≃ₐ[ℝ] K := +{ inv_fun := conj, + left_inv := conj_conj, + right_inv := conj_conj, + commutes' := conj_of_real, + .. conj } + +@[simp, is_R_or_C_simps] lemma conj_ae_coe : (conj_ae : K → K) = conj := rfl + +/-- Conjugate as a linear isometry -/ +noncomputable def conj_lie : K ≃ₗᵢ[ℝ] K := +⟨conj_ae.to_linear_equiv, λ _, norm_conj⟩ + +@[simp, is_R_or_C_simps] lemma conj_lie_apply : (conj_lie : K → K) = conj := rfl + +/-- Conjugate as a continuous linear equivalence -/ +noncomputable def conj_cle : K ≃L[ℝ] K := @conj_lie K _ + +@[simp, is_R_or_C_simps] lemma conj_cle_coe : + (@conj_cle K _).to_linear_equiv = conj_ae.to_linear_equiv := rfl + +@[simp, is_R_or_C_simps] lemma conj_cle_apply : (conj_cle : K → K) = conj := rfl + +@[priority 100] +instance : has_continuous_star K := ⟨conj_lie.continuous⟩ + +@[continuity] lemma continuous_conj : continuous (conj : K → K) := continuous_star + +/-- The `ℝ → K` coercion, as a linear map -/ +noncomputable def of_real_am : ℝ →ₐ[ℝ] K := algebra.of_id ℝ K + +@[simp, is_R_or_C_simps] lemma of_real_am_coe : (of_real_am : ℝ → K) = coe := rfl + +/-- The ℝ → K coercion, as a linear isometry -/ +noncomputable def of_real_li : ℝ →ₗᵢ[ℝ] K := +{ to_linear_map := of_real_am.to_linear_map, norm_map' := norm_of_real } + +@[simp, is_R_or_C_simps] lemma of_real_li_apply : (of_real_li : ℝ → K) = coe := rfl + +/-- The `ℝ → K` coercion, as a continuous linear map -/ +noncomputable def of_real_clm : ℝ →L[ℝ] K := of_real_li.to_continuous_linear_map + +@[simp, is_R_or_C_simps] lemma of_real_clm_coe : + ((@of_real_clm K _) : ℝ →ₗ[ℝ] K) = of_real_am.to_linear_map := rfl + +@[simp, is_R_or_C_simps] lemma of_real_clm_apply : (of_real_clm : ℝ → K) = coe := rfl + +@[continuity] lemma continuous_of_real : continuous (coe : ℝ → K) := of_real_li.continuous + +@[continuity] lemma continuous_norm_sq : continuous (norm_sq : K → ℝ) := +(continuous_re.mul continuous_re).add (continuous_im.mul continuous_im) + +end linear_maps + +end is_R_or_C diff --git a/src/data/is_R_or_C/lemmas.lean b/src/data/is_R_or_C/lemmas.lean new file mode 100644 index 0000000000000..93d976cb3acab --- /dev/null +++ b/src/data/is_R_or_C/lemmas.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2020 Frédéric Dupuis. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Frédéric Dupuis +-/ +import analysis.normed_space.finite_dimension +import field_theory.tower +import data.is_R_or_C.basic + +/-! # Further lemmas about `is_R_or_C` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +variables {K E : Type*} [is_R_or_C K] + +namespace polynomial + +open_locale polynomial + +lemma of_real_eval (p : ℝ[X]) (x : ℝ) : (p.eval x : K) = aeval ↑x p := +(@aeval_algebra_map_apply_eq_algebra_map_eval ℝ K _ _ _ x p).symm + +end polynomial + +namespace finite_dimensional + +open_locale classical +open is_R_or_C + +/-- This instance generates a type-class problem with a metavariable `?m` that should satisfy +`is_R_or_C ?m`. Since this can only be satisfied by `ℝ` or `ℂ`, this does not cause problems. -/ +library_note "is_R_or_C instance" + +/-- An `is_R_or_C` field is finite-dimensional over `ℝ`, since it is spanned by `{1, I}`. -/ +@[nolint dangerous_instance] instance is_R_or_C_to_real : finite_dimensional ℝ K := +⟨⟨{1, I}, + begin + rw eq_top_iff, + intros a _, + rw [finset.coe_insert, finset.coe_singleton, submodule.mem_span_insert], + refine ⟨re a, (im a) • I, _, _⟩, + { rw submodule.mem_span_singleton, + use im a }, + simp [re_add_im a, algebra.smul_def, algebra_map_eq_of_real] + end⟩⟩ + +variables (K E) [normed_add_comm_group E] [normed_space K E] + +/-- A finite dimensional vector space over an `is_R_or_C` is a proper metric space. + +This is not an instance because it would cause a search for `finite_dimensional ?x E` before +`is_R_or_C ?x`. -/ +lemma proper_is_R_or_C [finite_dimensional K E] : proper_space E := +begin + letI : normed_space ℝ E := restrict_scalars.normed_space ℝ K E, + letI : finite_dimensional ℝ E := finite_dimensional.trans ℝ K E, + apply_instance +end + +variable {E} + +instance is_R_or_C.proper_space_submodule (S : submodule K E) [finite_dimensional K ↥S] : + proper_space S := +proper_is_R_or_C K S + +end finite_dimensional + +namespace is_R_or_C + +@[simp, is_R_or_C_simps] lemma re_clm_norm : ‖(re_clm : K →L[ℝ] ℝ)‖ = 1 := +begin + apply le_antisymm (linear_map.mk_continuous_norm_le _ zero_le_one _), + convert continuous_linear_map.ratio_le_op_norm _ (1 : K), + { simp }, + { apply_instance } +end + +@[simp, is_R_or_C_simps] lemma conj_cle_norm : ‖(@conj_cle K _ : K →L[ℝ] K)‖ = 1 := +(@conj_lie K _).to_linear_isometry.norm_to_continuous_linear_map + +@[simp, is_R_or_C_simps] lemma of_real_clm_norm : ‖(of_real_clm : ℝ →L[ℝ] K)‖ = 1 := +linear_isometry.norm_to_continuous_linear_map of_real_li + +end is_R_or_C diff --git a/src/data/json.lean b/src/data/json.lean new file mode 100644 index 0000000000000..b504379d36475 --- /dev/null +++ b/src/data/json.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import tactic.core + +/-! +# Json serialization typeclass + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides helpers for serializing primitive types to json. + +`@[derive non_null_json_serializable]` will make any structure json serializable; for instance, +```lean +@[derive non_null_json_serializable] +structure my_struct := +(success : bool) +(verbose : ℕ := 0) +(extras : option string := none) +``` +can parse `{"success": true}` as `my_struct.mk true 0 none`, and reserializing give +`{"success": true, "verbose": 0, "extras": null}`. + +## Main definitions + +* `json_serializable`: a typeclass for objects which serialize to json +* `json_serializable.to_json x`: convert `x` to json +* `json_serializable.of_json α j`: read `j` in as an `α` +-/ + +open exceptional + +meta instance : has_orelse exceptional := +{ orelse := λ α f g, match f with + | success x := success x + | exception msg := g + end } + +/-- A class to indicate that a type is json serializable -/ +meta class json_serializable (α : Type) := +(to_json : α → json) +(of_json [] : json → exceptional α) + +/-- A class for types which never serialize to null -/ +meta class non_null_json_serializable (α : Type) extends json_serializable α + +export json_serializable (to_json of_json) + +/-- Describe the type of a json value -/ +meta def json.typename : json → string +| (json.of_string _) := "string" +| (json.of_int _) := "number" +| (json.of_float _) := "number" +| (json.of_bool _) := "bool" +| json.null := "null" +| (json.object _) := "object" +| (json.array _) := "array" + +/-! ### Primitive types -/ + +meta instance : non_null_json_serializable string := +{ to_json := json.of_string, + of_json := λ j, do + json.of_string s ← success j | exception (λ _, format!"string expected, got {j.typename}"), + pure s } + +meta instance : non_null_json_serializable ℤ := +{ to_json := λ z, json.of_int z, + of_json := λ j, do + json.of_int z ← success j | do + { json.of_float f ← success j | exception (λ _, format!"number expected, got {j.typename}"), + exception (λ _, format!"number must be integral") }, + pure z } + +meta instance : non_null_json_serializable native.float := +{ to_json := λ f, json.of_float f, + of_json := λ j, do + json.of_int z ← success j | do + { json.of_float f ← success j | exception (λ _, format!"number expected, got {j.typename}"), + pure f }, + pure z } + +meta instance : non_null_json_serializable bool := +{ to_json := λ b, json.of_bool b, + of_json := λ j, do + json.of_bool b ← success j | exception (λ _, format!"boolean expected, got {j.typename}"), + pure b } + +meta instance : json_serializable punit := +{ to_json := λ u, json.null, + of_json := λ j, do + json.null ← success j | exception (λ _, format!"null expected, got {j.typename}"), + pure () } + +meta instance {α} [json_serializable α] : non_null_json_serializable (list α) := +{ to_json := λ l, json.array (l.map to_json), + of_json := λ j, do + json.array l ← success j | exception (λ _, format!"array expected, got {j.typename}"), + l.mmap (of_json α) } + +meta instance {α} [json_serializable α] : non_null_json_serializable (rbmap string α) := +{ to_json := λ m, json.object (m.to_list.map $ λ x, (x.1, to_json x.2)), + of_json := λ j, do + json.object l ← success j | exception (λ _, format!"object expected, got {j.typename}"), + l ← l.mmap (λ x : string × json, do x2 ← of_json α x.2, pure (x.1, x2)), + l.mfoldl (λ m x, do + none ← pure (m.find x.1) | exception (λ _, format!"duplicate key {x.1}"), + pure (m.insert x.1 x.2)) (mk_rbmap _ _) } + +/-! ### Basic coercions -/ + +meta instance : non_null_json_serializable ℕ := +{ to_json := λ n, to_json (n : ℤ), + of_json := λ j, do + int.of_nat n ← of_json ℤ j | exception (λ _, format!"must be non-negative"), + pure n } + +meta instance {n : ℕ} : non_null_json_serializable (fin n) := +{ to_json := λ i, to_json i.val, + of_json := λ j, do + i ← of_json ℕ j, + if h : i < n then + pure ⟨i, h⟩ + else + exception (λ _, format!"must be less than {n}") } + +meta instance {α : Type} [json_serializable α] (p : α → Prop) [decidable_pred p] : + json_serializable (subtype p) := +{ to_json := λ x, to_json (x : α), + of_json := λ j, do + i ← of_json α j, + if h : p i then + pure (subtype.mk i h) + else + exception (λ _, format!"condition does not hold") } + +meta instance {α : Type} [non_null_json_serializable α] (p : α → Prop) [decidable_pred p] : + non_null_json_serializable (subtype p) := {} + +/-- Note this only makes sense on types which do not themselves serialize to `null` -/ +meta instance {α} [non_null_json_serializable α] : json_serializable (option α) := +{ to_json := option.elim json.null to_json, + of_json := λ j, do (of_json punit j >> pure none) <|> (some <$> of_json α j)} + +open tactic expr + +/-- Flatten a list of (p)exprs into a (p)expr forming a list of type `list t`. -/ +meta def list.to_expr {elab : bool} (t : expr elab) (l : level) : list (expr elab) → expr elab +| [] := expr.app (expr.const `list.nil [l]) t +| (x :: xs) := (((expr.const `list.cons [l]).app t).app x).app xs.to_expr + +/-- Begin parsing fields -/ +meta def json_serializable.field_starter (j : json) : exceptional (list (string × json)) := +do + json.object p ← pure j | exception (λ _, format!"object expected, got {j.typename}"), + pure p + +/-- Check a field exists and is unique -/ +meta def json_serializable.field_get (l : list (string × json)) (s : string) : + exceptional (option json × list (string × json)) := +let (p, n) := l.partition (λ x, prod.fst x = s) in +match p with +| [] := pure (none, n) +| [x] := pure (some x.2, n) +| x :: xs := exception (λ _, format!"duplicate {s} field") +end + +/-- Check no fields remain -/ +meta def json_serializable.field_terminator (l : list (string × json)) : exceptional unit := +do [] ← pure l | exception (λ _, format!"unexpected fields {l.map prod.fst}"), pure () + +/-- ``((c_name, c_fun), [(p_name, p_fun), ...]) ← get_constructor_and_projections `(struct n)`` +gets the names and partial invocations of the constructor and projections of a structure -/ +meta def get_constructor_and_projections (t : expr) : + tactic (name × (name × expr) × list (name × expr)):= +do + (const I ls, args) ← pure (get_app_fn_args t), + env ← get_env, + [ctor] ← pure (env.constructors_of I), + ctor ← do + { d ← get_decl ctor, + let a := @expr.const tt ctor $ d.univ_params.map level.param, + pure (ctor, a.mk_app args) }, + ctor_type ← infer_type ctor.2, + tt ← pure ctor_type.is_pi | pure (I, ctor, []), + some fields ← pure (env.structure_fields I) | fail!"Not a structure", + projs ← fields.mmap $ λ f, do + { d ← get_decl (I ++ f), + let a := @expr.const tt (I ++ f) $ d.univ_params.map level.param, + pure (f, a.mk_app args) }, + pure (I, ctor, projs) + +/-- Generate an expression that builds a term of type `t` (which is itself a parametrization of +the structure `struct_name`) using the expressions resolving to parsed fields in `vars` and the +expressions resolving to unparsed `option json` objects in `js`. This can handled +dependently-typed and defaulted (via `:=` which for structures is not the same as `opt_param`) +fields. -/ +meta def of_json_helper (struct_name : name) (t : expr) : + Π (vars : list (name × pexpr)) (js : list (name × option expr)), tactic expr +| vars [] := do + -- allow this partial constructor if `to_expr` allows it + let struct := pexpr.mk_structure_instance + ⟨some struct_name, vars.map prod.fst, vars.map prod.snd, []⟩, + to_expr ``(pure %%struct : exceptional %%t) +| vars ((fname, some fj) :: js) := do + -- data fields + u ← mk_meta_univ, + ft : expr ← mk_meta_var (expr.sort u), + f_binder ← mk_local' fname binder_info.default ft, + let new_vars := vars.concat (fname, to_pexpr f_binder), + with_field ← of_json_helper new_vars js >>= tactic.lambdas [f_binder], + without_field ← of_json_helper vars js <|> + to_expr ``(exception $ λ o, format!"field {%%`(fname)} is required" : exceptional %%t), + to_expr ``(option.mmap (of_json _) %%fj + >>= option.elim %%without_field %%with_field : exceptional %%t) +| vars ((fname, none) :: js) := + -- try a default value + of_json_helper vars js <|> do + { -- otherwise, use decidability + u ← mk_meta_univ, + ft ← mk_meta_var (expr.sort u), + f_binder ← mk_local' fname binder_info.default ft, + let new_vars := vars.concat (fname, to_pexpr f_binder), + with_field ← of_json_helper new_vars js >>= tactic.lambdas [f_binder], + to_expr ``(dite _ %%with_field (λ _, exception $ λ _, format!"condition does not hold")) } + +/-- A derive handler to serialize structures by their fields. + +For the following structure: +```lean +structure has_default : Type := +(x : ℕ := 2) +(y : fin x.succ := 3 * fin.of_nat x) +(z : ℕ := 3) +``` +this generates an `of_json` parser along the lines of + +```lean +meta def has_default.of_json (j : json) : exceptional (has_default) := +do + p ← json_serializable.field_starter j, + (f_y, p) ← json_serializable.field_get p "y", + (f_z, p) ← json_serializable.field_get p "z", + f_y.mmap (of_json _) >>= option.elim + (f_z.mmap (of_json _) >>= option.elim + (pure {has_default.}) + (λ z, pure {has_default. z := z}) + ) + (λ y, f_z.mmap (of_json _) >>= option.elim + (pure {has_default.}) + (λ z, pure {has_default. y := y, z := z}) + ) +``` +-/ +@[derive_handler, priority 2000] meta def non_null_json_serializable_handler : derive_handler := +instance_derive_handler ``non_null_json_serializable $ do + intros, + `(non_null_json_serializable %%e) ← target >>= whnf, + (struct_name, (ctor_name, ctor), fields) ← get_constructor_and_projections e, + refine ``(@non_null_json_serializable.mk %%e ⟨λ x, json.object _, + λ j, json_serializable.field_starter j >>= _ + ⟩), + -- the forward direction + x ← get_local `x, + (projs : list (option expr)) ← fields.mmap (λ ⟨f, a⟩, do + let x_e := a.app x, + t ← infer_type x_e, + s ← infer_type t, + expr.sort (level.succ u) ← pure s | pure (none : option expr), + level.zero ← pure u | fail!"Only Type 0 is supported", + j ← tactic.mk_app `json_serializable.to_json [x_e], + pure (some `((%%`(f.to_string), %%j) : string × json)) + ), + tactic.exact (projs.reduce_option.to_expr `(string × json) level.zero), + + -- the reverse direction + get_local `j >>= tactic.clear, + -- check fields are present + json_fields ← fields.mmap (λ ⟨f, e⟩, do + t ← infer_type e, + s ← infer_type t, + expr.sort (level.succ u) ← pure s | pure (f, none), -- do nothing for prop fields + refine ``(λ p, json_serializable.field_get p %%`(f.to_string) >>= _), + tactic.applyc `prod.rec, + get_local `p >>= tactic.clear, + jf ← tactic.intro (`field ++ f), + pure (f, some jf)), + refine ``(λ p, json_serializable.field_terminator p >> _), + get_local `p >>= tactic.clear, + ctor ← of_json_helper struct_name e [] json_fields, + exact ctor diff --git a/src/data/lazy_list.lean b/src/data/lazy_list.lean index 624f166a6daa9..77c3684dea281 100644 --- a/src/data/lazy_list.lean +++ b/src/data/lazy_list.lean @@ -3,11 +3,13 @@ Copyright (c) 2017 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura -/ -import tactic.lint /-! # Lazy lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The type `lazy_list α` is a lazy list with elements of type `α`. In the VM, these are potentially infinite lists where all elements after the first are computed on-demand. diff --git a/src/data/lazy_list/basic.lean b/src/data/lazy_list/basic.lean index 2ffe03b984210..4b6762f43bc70 100644 --- a/src/data/lazy_list/basic.lean +++ b/src/data/lazy_list/basic.lean @@ -10,6 +10,9 @@ import data.lazy_list /-! ## Definitions on lazy lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains various definitions and proofs on lazy lists. TODO: move the `lazy_list.lean` file from core to mathlib. diff --git a/src/data/list/alist.lean b/src/data/list/alist.lean index 37ca52e6a9c6c..79b6778ecb5a8 100644 --- a/src/data/list/alist.lean +++ b/src/data/list/alist.lean @@ -8,6 +8,9 @@ import data.list.sigma /-! # Association Lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines association lists. An association list is a list where every element consists of a key and a value, and no two entries have the same key. The type of the value is allowed to be dependent on the type of the key. @@ -84,7 +87,7 @@ instance : has_emptyc (alist β) := ⟨⟨[], nodupkeys_nil⟩⟩ instance : inhabited (alist β) := ⟨∅⟩ -theorem not_mem_empty (a : α) : a ∉ (∅ : alist β) := +@[simp] theorem not_mem_empty (a : α) : a ∉ (∅ : alist β) := not_mem_nil a @[simp] theorem empty_entries : (∅ : alist β).entries = [] := rfl @@ -122,6 +125,10 @@ theorem lookup_eq_none {a : α} {s : alist β} : lookup a s = none ↔ a ∉ s := lookup_eq_none +theorem mem_lookup_iff {a : α} {b : β a} {s : alist β} : + b ∈ lookup a s ↔ sigma.mk a b ∈ s.entries := +mem_lookup_iff s.nodupkeys + theorem perm_lookup {a : α} {s₁ s₂ : alist β} (p : s₁.entries ~ s₂.entries) : s₁.lookup a = s₂.lookup a := perm_lookup _ s₁.nodupkeys s₂.nodupkeys p @@ -198,6 +205,13 @@ theorem insert_entries_of_neg {a} {b : β a} {s : alist β} (h : a ∉ s) : (insert a b s).entries = ⟨a, b⟩ :: s.entries := by rw [insert_entries, kerase_of_not_mem_keys h] +-- Todo: rename to `insert_of_not_mem`. +theorem insert_of_neg {a} {b : β a} {s : alist β} (h : a ∉ s) : + insert a b s = ⟨⟨a, b⟩ :: s.entries, nodupkeys_cons.2 ⟨h, s.2⟩⟩ := +ext $ insert_entries_of_neg h + +@[simp] theorem insert_empty (a) (b : β a) : insert a b ∅ = singleton a b := rfl + @[simp] theorem mem_insert {a a'} {b' : β a'} (s : alist β) : a ∈ insert a' b' s ↔ a = a' ∨ a ∈ s := mem_keys_kinsert @@ -241,6 +255,50 @@ ext $ by simp only [alist.insert_entries, list.kerase_cons_eq, and_self, alist.s theorem to_alist_cons (a : α) (b : β a) (xs : list (sigma β)) : list.to_alist (⟨a,b⟩ :: xs) = insert a b xs.to_alist := rfl +theorem mk_cons_eq_insert (c : sigma β) (l : list (sigma β)) (h : (c :: l).nodupkeys) : + (⟨c :: l, h⟩ : alist β) = insert c.1 c.2 ⟨l, nodupkeys_of_nodupkeys_cons h⟩ := +by simpa [insert] using (kerase_of_not_mem_keys $ not_mem_keys_of_nodupkeys_cons h).symm + +/-- Recursion on an `alist`, using `insert`. Use as `induction l using alist.insert_rec`. -/ +@[elab_as_eliminator] def insert_rec {C : alist β → Sort*} (H0 : C ∅) + (IH : Π (a : α) (b : β a) (l : alist β) (h : a ∉ l), C l → C (l.insert a b)) : Π l : alist β, C l +| ⟨[], _⟩ := H0 +| ⟨c :: l, h⟩ := begin + rw mk_cons_eq_insert, + refine IH _ _ _ _ (insert_rec _), + exact not_mem_keys_of_nodupkeys_cons h +end + +-- Test that the `induction` tactic works on `insert_rec`. +example (l : alist β) : true := by induction l using alist.insert_rec; trivial + +@[simp] theorem insert_rec_empty {C : alist β → Sort*} (H0 : C ∅) + (IH : Π (a : α) (b : β a) (l : alist β) (h : a ∉ l), C l → C (l.insert a b)) : + @insert_rec α β _ C H0 IH ∅ = H0 := +by { change @insert_rec α β _ C H0 IH ⟨[], _⟩ = H0, rw insert_rec } + +theorem insert_rec_insert {C : alist β → Sort*} (H0 : C ∅) + (IH : Π (a : α) (b : β a) (l : alist β) (h : a ∉ l), C l → C (l.insert a b)) + {c : sigma β} {l : alist β} (h : c.1 ∉ l) : + @insert_rec α β _ C H0 IH (l.insert c.1 c.2) = IH c.1 c.2 l h (@insert_rec α β _ C H0 IH l) := +begin + cases l with l hl, + suffices : @insert_rec α β _ C H0 IH ⟨c :: l, nodupkeys_cons.2 ⟨h, hl⟩⟩ == + IH c.1 c.2 ⟨l, hl⟩ h (@insert_rec α β _ C H0 IH ⟨l, hl⟩), + { cases c, + apply eq_of_heq, + convert this; + rw insert_of_neg h }, + rw insert_rec, + apply cast_heq +end + +theorem recursion_insert_mk {C : alist β → Sort*} (H0 : C ∅) + (IH : Π (a : α) (b : β a) (l : alist β) (h : a ∉ l), C l → C (l.insert a b)) + {a : α} (b : β a) {l : alist β} (h : a ∉ l) : + @insert_rec α β _ C H0 IH (l.insert a b) = IH a b l h (@insert_rec α β _ C H0 IH l) := +@insert_rec_insert α β _ C H0 IH ⟨a, b⟩ l h + /-! ### extract -/ /-- Erase a key from the map, and return the corresponding value, if found. -/ diff --git a/src/data/list/basic.lean b/src/data/list/basic.lean index 3e1788223b2b8..ce40ca44d44af 100644 --- a/src/data/list/basic.lean +++ b/src/data/list/basic.lean @@ -3,23 +3,27 @@ Copyright (c) 2014 Parikshit Khanna. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro -/ -import data.nat.basic +import data.nat.order.basic /-! # Basic properties of lists + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open function nat (hiding one_pos) +assert_not_exists set.range + namespace list universes u v w x -variables {ι : Type*} {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} +variables {ι : Type*} {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} {l₁ l₂ : list α} attribute [inline] list.head --- TODO[gh-6025]: make this an instance once safe to do so /-- There is only one list of an empty type -/ -def unique_of_is_empty [is_empty α] : unique (list α) := +instance unique_of_is_empty [is_empty α] : unique (list α) := { uniq := λ l, match l with | [] := rfl | (a :: l) := is_empty_elim a @@ -54,6 +58,13 @@ assume l₁ l₂, assume Pe, tail_eq_of_cons_eq Pe theorem cons_inj (a : α) {l l' : list α} : a::l = a::l' ↔ l = l' := cons_injective.eq_iff +theorem cons_eq_cons {a b : α} {l l' : list α} : a::l = b::l' ↔ a = b ∧ l = l' := +⟨list.cons.inj, λ h, h.1 ▸ h.2 ▸ rfl⟩ + +lemma singleton_injective : injective (λ a : α, [a]) := λ a b h, (cons_eq_cons.1 h).1 + +lemma singleton_inj {a b : α} : [a] = [b] ↔ a = b := singleton_injective.eq_iff + theorem exists_cons_of_ne_nil {l : list α} (h : l ≠ nil) : ∃ b L, l = b :: L := by { induction l with c l', contradiction, use [c,l'], } @@ -125,7 +136,7 @@ begin exacts [or.inl $ (congr_arg f hc.symm).trans h, or.inr ⟨c, hc, h⟩] } } end -alias mem_map ↔ list.exists_of_mem_map _ +alias mem_map ↔ exists_of_mem_map _ theorem mem_map_of_mem (f : α → β) {a : α} {l : list α} (h : a ∈ l) : f a ∈ map f l := mem_map.2 ⟨a, h, rfl⟩ @@ -134,6 +145,15 @@ theorem mem_map_of_injective {f : α → β} (H : injective f) {a : α} {l : lis f a ∈ map f l ↔ a ∈ l := ⟨λ m, let ⟨a', m', e⟩ := exists_of_mem_map m in H e ▸ m', mem_map_of_mem _⟩ +@[simp] lemma _root_.function.involutive.exists_mem_and_apply_eq_iff {f : α → α} + (hf : function.involutive f) (x : α) (l : list α) : + (∃ (y : α), y ∈ l ∧ f y = x) ↔ f x ∈ l := +⟨by { rintro ⟨y, h, rfl⟩, rwa hf y }, λ h, ⟨f x, h, hf _⟩⟩ + +theorem mem_map_of_involutive {f : α → α} (hf : involutive f) {a : α} {l : list α} : + a ∈ map f l ↔ f a ∈ l := +by rw [mem_map, hf.exists_mem_and_apply_eq_iff] + lemma forall_mem_map_iff {f : α → β} {l : list α} {P : β → Prop} : (∀ i ∈ l.map f, P i) ↔ ∀ j ∈ l, P (f j) := begin @@ -185,30 +205,6 @@ lemma map_bind (g : β → list γ) (f : α → β) : | [] := rfl | (a::l) := by simp only [cons_bind, map_cons, map_bind l] -lemma range_map (f : α → β) : set.range (map f) = {l | ∀ x ∈ l, x ∈ set.range f} := -begin - refine set.subset.antisymm (set.range_subset_iff.2 $ - λ l, forall_mem_map_iff.2 $ λ y _, set.mem_range_self _) (λ l hl, _), - induction l with a l ihl, { exact ⟨[], rfl⟩ }, - rcases ihl (λ x hx, hl x $ subset_cons _ _ hx) with ⟨l, rfl⟩, - rcases hl a (mem_cons_self _ _) with ⟨a, rfl⟩, - exact ⟨a :: l, map_cons _ _ _⟩ -end - -lemma range_map_coe (s : set α) : set.range (map (coe : s → α)) = {l | ∀ x ∈ l, x ∈ s} := -by rw [range_map, subtype.range_coe] - -/-- If each element of a list can be lifted to some type, then the whole list can be lifted to this -type. -/ -instance [h : can_lift α β] : can_lift (list α) (list β) := -{ coe := list.map h.coe, - cond := λ l, ∀ x ∈ l, can_lift.cond β x, - prf := λ l H, - begin - rw [← set.mem_range, range_map], - exact λ a ha, can_lift.prf a (H a ha), - end} - /-! ### length -/ theorem length_eq_zero {l : list α} : length l = 0 ↔ l = [] := @@ -263,6 +259,8 @@ lemma length_eq_two {l : list α} : l.length = 2 ↔ ∃ a b, l = [a, b] := lemma length_eq_three {l : list α} : l.length = 3 ↔ ∃ a b c, l = [a, b, c] := ⟨match l with [a, b, c], _ := ⟨a, b, c, rfl⟩ end, λ ⟨a, b, c, e⟩, e.symm ▸ rfl⟩ +alias length_le_of_sublist ← sublist.length_le + /-! ### set-theoretic notation of lists -/ lemma empty_eq : (∅ : list α) = [] := by refl @@ -320,6 +318,8 @@ iff.intro or_exists_of_exists_mem_cons /-! ### list subset -/ +instance : is_trans (list α) (⊆) := ⟨λ _ _ _, list.subset.trans⟩ + theorem subset_def {l₁ l₂ : list α} : l₁ ⊆ l₂ ↔ ∀ ⦃a : α⦄, a ∈ l₁ → a ∈ l₂ := iff.rfl theorem subset_append_of_subset_left (l l₁ l₂ : list α) : l ⊆ l₁ → l ⊆ l₁++l₂ := @@ -450,13 +450,13 @@ append_inj_right h rfl theorem append_right_cancel {s₁ s₂ t : list α} (h : s₁ ++ t = s₂ ++ t) : s₁ = s₂ := append_inj_left' h rfl -theorem append_right_injective (s : list α) : function.injective (λ t, s ++ t) := +theorem append_right_injective (s : list α) : injective (λ t, s ++ t) := λ t₁ t₂, append_left_cancel theorem append_right_inj {t₁ t₂ : list α} (s) : s ++ t₁ = s ++ t₂ ↔ t₁ = t₂ := (append_right_injective s).eq_iff -theorem append_left_injective (t : list α) : function.injective (λ s, s ++ t) := +theorem append_left_injective (t : list α) : injective (λ s, s ++ t) := λ s₁ s₂, append_right_cancel theorem append_left_inj {s₁ s₂ : list α} (t) : s₁ ++ t = s₂ ++ t ↔ s₁ = s₂ := @@ -473,70 +473,72 @@ begin apply nat.le_add_right end -/-! ### repeat -/ +/-! ### replicate -/ + +@[simp] theorem replicate_zero (a : α) : replicate 0 a = [] := rfl +@[simp] theorem replicate_succ (a : α) (n) : replicate (n + 1) a = a :: replicate n a := rfl +theorem replicate_one (a : α) : replicate 1 a = [a] := rfl -@[simp] theorem repeat_succ (a : α) (n) : repeat a (n + 1) = a :: repeat a n := rfl +@[simp] theorem length_replicate : ∀ n (a : α), length (replicate n a) = n +| 0 a := rfl +| (n + 1) a := congr_arg nat.succ (length_replicate n a) -theorem mem_repeat {a b : α} : ∀ {n}, b ∈ repeat a n ↔ n ≠ 0 ∧ b = a +theorem mem_replicate {a b : α} : ∀ {n}, b ∈ replicate n a ↔ n ≠ 0 ∧ b = a | 0 := by simp -| (n + 1) := by simp [mem_repeat] +| (n + 1) := by simp [mem_replicate] -theorem eq_of_mem_repeat {a b : α} {n} (h : b ∈ repeat a n) : b = a := -(mem_repeat.1 h).2 +theorem eq_of_mem_replicate {a b : α} {n} (h : b ∈ replicate n a) : b = a := +(mem_replicate.1 h).2 -theorem eq_repeat_of_mem {a : α} : ∀ {l : list α}, (∀ b ∈ l, b = a) → l = repeat a l.length -| [] H := rfl -| (b::l) H := by cases forall_mem_cons.1 H with H₁ H₂; - unfold length repeat; congr; [exact H₁, exact eq_repeat_of_mem H₂] +theorem eq_replicate_length {a : α} : ∀ {l : list α}, l = replicate l.length a ↔ ∀ b ∈ l, b = a +| [] := by simp +| (b :: l) := by simp [eq_replicate_length] -theorem eq_repeat' {a : α} {l : list α} : l = repeat a l.length ↔ ∀ b ∈ l, b = a := -⟨λ h, h.symm ▸ λ b, eq_of_mem_repeat, eq_repeat_of_mem⟩ +alias eq_replicate_length ↔ _ eq_replicate_of_mem -theorem eq_repeat {a : α} {n} {l : list α} : l = repeat a n ↔ length l = n ∧ ∀ b ∈ l, b = a := -⟨λ h, h.symm ▸ ⟨length_repeat _ _, λ b, eq_of_mem_repeat⟩, - λ ⟨e, al⟩, e ▸ eq_repeat_of_mem al⟩ +theorem eq_replicate {a : α} {n} {l : list α} : l = replicate n a ↔ length l = n ∧ ∀ b ∈ l, b = a := +⟨λ h, h.symm ▸ ⟨length_replicate _ _, λ b, eq_of_mem_replicate⟩, + λ ⟨e, al⟩, e ▸ eq_replicate_of_mem al⟩ -theorem repeat_add (a : α) (m n) : repeat a (m + n) = repeat a m ++ repeat a n := -by induction m; simp only [*, zero_add, succ_add, repeat]; split; refl +theorem replicate_add (m n) (a : α) : replicate (m + n) a = replicate m a ++ replicate n a := +by induction m; simp only [*, zero_add, succ_add, replicate]; refl -theorem repeat_subset_singleton (a : α) (n) : repeat a n ⊆ [a] := -λ b h, mem_singleton.2 (eq_of_mem_repeat h) +theorem replicate_succ' (n) (a : α) : replicate (n + 1) a = replicate n a ++ [a] := +replicate_add n 1 a -@[simp] theorem map_const (l : list α) (b : β) : map (function.const α b) l = repeat b l.length := -by induction l; [refl, simp only [*, map]]; split; refl +theorem replicate_subset_singleton (n) (a : α) : replicate n a ⊆ [a] := +λ b h, mem_singleton.2 (eq_of_mem_replicate h) -theorem eq_of_mem_map_const {b₁ b₂ : β} {l : list α} (h : b₁ ∈ map (function.const α b₂) l) : - b₁ = b₂ := -by rw map_const at h; exact eq_of_mem_repeat h +lemma subset_singleton_iff {a : α} {L : list α} : L ⊆ [a] ↔ ∃ n, L = replicate n a := +by simp only [eq_replicate, subset_def, mem_singleton, exists_eq_left'] -@[simp] theorem map_repeat (f : α → β) (a : α) (n) : map f (repeat a n) = repeat (f a) n := -by induction n; [refl, simp only [*, repeat, map]]; split; refl +@[simp] theorem map_replicate (f : α → β) (n a) : map f (replicate n a) = replicate n (f a) := +by induction n; [refl, simp only [*, replicate, map]]; split; refl -@[simp] theorem tail_repeat (a : α) (n) : tail (repeat a n) = repeat a n.pred := +@[simp] theorem tail_replicate (n) (a : α) : tail (replicate n a) = replicate (n - 1) a := by cases n; refl -@[simp] theorem join_repeat_nil (n : ℕ) : join (repeat [] n) = @nil α := -by induction n; [refl, simp only [*, repeat, join, append_nil]] +@[simp] theorem join_replicate_nil (n : ℕ) : join (replicate n []) = @nil α := +by induction n; [refl, simp only [*, replicate, join, append_nil]] -lemma repeat_left_injective {n : ℕ} (hn : n ≠ 0) : - function.injective (λ a : α, repeat a n) := -λ a b h, (eq_repeat.1 h).2 _ $ mem_repeat.2 ⟨hn, rfl⟩ +lemma replicate_right_injective {n : ℕ} (hn : n ≠ 0) : injective (replicate n : α → list α) := +λ _ _ h, (eq_replicate.1 h).2 _ $ mem_replicate.2 ⟨hn, rfl⟩ -lemma repeat_left_inj {a b : α} {n : ℕ} (hn : n ≠ 0) : - repeat a n = repeat b n ↔ a = b := -(repeat_left_injective hn).eq_iff +lemma replicate_right_inj {a b : α} {n : ℕ} (hn : n ≠ 0) : + replicate n a = replicate n b ↔ a = b := +(replicate_right_injective hn).eq_iff -@[simp] lemma repeat_left_inj' {a b : α} : - ∀ {n}, repeat a n = repeat b n ↔ n = 0 ∨ a = b +@[simp] lemma replicate_right_inj' {a b : α} : + ∀ {n}, replicate n a = replicate n b ↔ n = 0 ∨ a = b | 0 := by simp -| (n + 1) := (repeat_left_inj n.succ_ne_zero).trans $ by simp only [n.succ_ne_zero, false_or] +| (n + 1) := (replicate_right_inj n.succ_ne_zero).trans $ by simp only [n.succ_ne_zero, false_or] -lemma repeat_right_injective (a : α) : function.injective (repeat a) := -function.left_inverse.injective (length_repeat a) +lemma replicate_left_injective (a : α) : injective (λ n, replicate n a) := +left_inverse.injective (λ n, length_replicate n a) -@[simp] lemma repeat_right_inj {a : α} {n m : ℕ} : - repeat a n = repeat a m ↔ n = m := -(repeat_right_injective a).eq_iff +@[simp] lemma replicate_left_inj {a : α} {n m : ℕ} : + replicate n a = replicate m a ↔ n = m := +(replicate_left_injective a).eq_iff /-! ### pure -/ @@ -630,11 +632,10 @@ by rw [concat_eq_append, reverse_append, reverse_singleton, singleton_append] @[simp] theorem reverse_reverse (l : list α) : reverse (reverse l) = l := by induction l; [refl, simp only [*, reverse_cons, reverse_append]]; refl -@[simp] theorem reverse_involutive : involutive (@reverse α) := -λ l, reverse_reverse l - -@[simp] theorem reverse_injective : injective (@reverse α) := -reverse_involutive.injective +@[simp] theorem reverse_involutive : involutive (@reverse α) := reverse_reverse +@[simp] theorem reverse_injective : injective (@reverse α) := reverse_involutive.injective +theorem reverse_surjective : surjective (@reverse α) := reverse_involutive.surjective +theorem reverse_bijective : bijective (@reverse α) := reverse_involutive.bijective @[simp] theorem reverse_inj {l₁ l₂ : list α} : reverse l₁ = reverse l₂ ↔ l₁ = l₂ := reverse_injective.eq_iff @@ -663,9 +664,9 @@ by simp only [reverse_core_eq, map_append, map_reverse] by induction l; [refl, simp only [*, reverse_cons, mem_append, mem_singleton, mem_cons_iff, not_mem_nil, false_or, or_false, or_comm]] -@[simp] theorem reverse_repeat (a : α) (n) : reverse (repeat a n) = repeat a n := -eq_repeat.2 ⟨by simp only [length_reverse, length_repeat], - λ b h, eq_of_mem_repeat (mem_reverse.1 h)⟩ +@[simp] theorem reverse_replicate (n) (a : α) : reverse (replicate n a) = replicate n a := +eq_replicate.2 ⟨by rw [length_reverse, length_replicate], + λ b h, eq_of_mem_replicate (mem_reverse.1 h)⟩ /-! ### empty -/ @@ -732,13 +733,11 @@ theorem last_mem : ∀ {l : list α} (h : l ≠ []), last l h ∈ l | [a] h := or.inl rfl | (a::b::l) h := or.inr $ by { rw [last_cons_cons], exact last_mem (cons_ne_nil b l) } -lemma last_repeat_succ (a m : ℕ) : - (repeat a m.succ).last (ne_nil_of_length_eq_succ - (show (repeat a m.succ).length = m.succ, by rw length_repeat)) = a := +lemma last_replicate_succ (m : ℕ) (a : α) : + (replicate (m + 1) a).last (ne_nil_of_length_eq_succ (length_replicate (m + 1) a)) = a := begin - induction m with k IH, - { simp }, - { simpa only [repeat_succ, last] } + simp only [replicate_succ'], + exact last_append_singleton _ end /-! ### last' -/ @@ -812,9 +811,20 @@ by { cases l₂, { contradiction, }, { rw list.last'_append_cons, exact h } } theorem head_eq_head' [inhabited α] (l : list α) : head l = (head' l).iget := by cases l; refl -theorem mem_of_mem_head' {x : α} : ∀ {l : list α}, x ∈ l.head' → x ∈ l +theorem surjective_head [inhabited α] : surjective (@head α _) := λ x, ⟨[x], rfl⟩ + +theorem surjective_head' : surjective (@head' α) := option.forall.2 ⟨⟨[], rfl⟩, λ x, ⟨[x], rfl⟩⟩ + +theorem surjective_tail : surjective (@tail α) +| [] := ⟨[], rfl⟩ +| (a :: l) := ⟨a :: a :: l, rfl⟩ + +lemma eq_cons_of_mem_head' {x : α} : ∀ {l : list α}, x ∈ l.head' → l = x::tail l | [] h := (option.not_mem_none _ h).elim -| (a::l) h := by { simp only [head', option.mem_def] at h, exact h ▸ or.inl rfl } +| (a::l) h := by { simp only [head', option.mem_def] at h, exact h ▸ rfl } + +theorem mem_of_mem_head' {x : α} {l : list α} (h : x ∈ l.head') : x ∈ l := +(eq_cons_of_mem_head' h).symm ▸ mem_cons_self _ _ @[simp] theorem head_cons [inhabited α] (a : α) (l : list α) : head (a::l) = a := rfl @@ -891,7 +901,7 @@ begin split_ifs, { simp [nth_le, h] }, cases l, - { rw [length_singleton, nat.lt_one_iff] at hl, contradiction }, + { rw [length_singleton, lt_succ_iff, nonpos_iff_eq_zero] at hl, contradiction }, cases n, { contradiction }, refl @@ -1056,23 +1066,27 @@ eq_nil_of_subset_nil $ s.subset @[simp] theorem sublist_nil_iff_eq_nil {l : list α} : l <+ [] ↔ l = [] := ⟨eq_nil_of_sublist_nil, λ H, H ▸ sublist.refl _⟩ -@[simp] theorem repeat_sublist_repeat (a : α) {m n} : repeat a m <+ repeat a n ↔ m ≤ n := -⟨λ h, by simpa only [length_repeat] using length_le_of_sublist h, - λ h, by induction h; [refl, simp only [*, repeat_succ, sublist.cons]] ⟩ +@[simp] theorem replicate_sublist_replicate (a : α) {m n} : + replicate m a <+ replicate n a ↔ m ≤ n := +⟨λ h, by simpa only [length_replicate] using h.length_le, + λ h, by induction h; [refl, simp only [*, replicate_succ, sublist.cons]] ⟩ -theorem eq_of_sublist_of_length_eq : ∀ {l₁ l₂ : list α}, l₁ <+ l₂ → length l₁ = length l₂ → l₁ = l₂ +lemma sublist_replicate_iff {l : list α} {a : α} {n : ℕ} : + l <+ replicate n a ↔ ∃ k ≤ n, l = replicate k a := +⟨λ h, ⟨l.length, h.length_le.trans (length_replicate _ _).le, eq_replicate_length.mpr $ + λ b hb, eq_of_mem_replicate (h.subset hb)⟩, + by { rintro ⟨k, h, rfl⟩, exact (replicate_sublist_replicate _).mpr h }⟩ + +theorem sublist.eq_of_length : ∀ {l₁ l₂ : list α}, l₁ <+ l₂ → length l₁ = length l₂ → l₁ = l₂ | ._ ._ sublist.slnil h := rfl -| ._ ._ (sublist.cons l₁ l₂ a s) h := - absurd (length_le_of_sublist s) $ not_le_of_gt $ by rw h; apply lt_succ_self +| ._ ._ (sublist.cons l₁ l₂ a s) h := by cases s.length_le.not_lt (by rw h; apply lt_succ_self) | ._ ._ (sublist.cons2 l₁ l₂ a s) h := - by rw [length, length] at h; injection h with h; rw eq_of_sublist_of_length_eq s h + by rw [length, length] at h; injection h with h; rw s.eq_of_length h -theorem eq_of_sublist_of_length_le {l₁ l₂ : list α} (s : l₁ <+ l₂) (h : length l₂ ≤ length l₁) : - l₁ = l₂ := -eq_of_sublist_of_length_eq s (le_antisymm (length_le_of_sublist s) h) +theorem sublist.eq_of_length_le (s : l₁ <+ l₂) (h : length l₂ ≤ length l₁) : l₁ = l₂ := +s.eq_of_length $ s.length_le.antisymm h -theorem sublist.antisymm {l₁ l₂ : list α} (s₁ : l₁ <+ l₂) (s₂ : l₂ <+ l₁) : l₁ = l₂ := -eq_of_sublist_of_length_le s₁ (length_le_of_sublist s₂) +lemma sublist.antisymm (s₁ : l₁ <+ l₂) (s₂ : l₂ <+ l₁) : l₁ = l₂ := s₁.eq_of_length_le s₂.length_le instance decidable_sublist [decidable_eq α] : ∀ (l₁ l₂ : list α), decidable (l₁ <+ l₂) | [] l₂ := is_true $ nil_sublist _ @@ -1132,6 +1146,26 @@ theorem index_of_lt_length {a} {l : list α} : index_of a l < length l ↔ a ∈ ⟨λh, decidable.by_contradiction $ λ al, ne_of_lt h $ index_of_eq_length.2 al, λal, lt_of_le_of_ne index_of_le_length $ λ h, index_of_eq_length.1 h al⟩ +theorem index_of_append_of_mem {a : α} (h : a ∈ l₁) : + index_of a (l₁ ++ l₂) = index_of a l₁ := +begin + induction l₁ with d₁ t₁ ih, + { exfalso, exact not_mem_nil a h }, + rw list.cons_append, + by_cases hh : a = d₁, + { iterate 2 { rw index_of_cons_eq _ hh } }, + rw [index_of_cons_ne _ hh, index_of_cons_ne _ hh, ih (mem_of_ne_of_mem hh h)], +end + +theorem index_of_append_of_not_mem {a : α} (h : a ∉ l₁) : + index_of a (l₁ ++ l₂) = l₁.length + index_of a l₂ := +begin + induction l₁ with d₁ t₁ ih, + { rw [list.nil_append, list.length, zero_add] }, + rw [list.cons_append, index_of_cons_ne _ (ne_of_not_mem_cons h), + list.length, ih (not_mem_of_not_mem_cons h), nat.succ_add], +end + end index_of /-! ### nth element -/ @@ -1149,6 +1183,8 @@ theorem nth_len_le : ∀ {l : list α} {n}, length l ≤ n → nth l n = none | [] n h := rfl | (a :: l) (n+1) h := nth_len_le (le_of_succ_le_succ h) +@[simp] theorem nth_length (l : list α) : l.nth l.length = none := nth_len_le le_rfl + theorem nth_eq_some {l : list α} {n a} : nth l n = some a ↔ ∃ h, nth_le l n h = a := ⟨λ e, have h : n < length l, from lt_of_not_ge $ λ hn, @@ -1234,7 +1270,7 @@ by { congr, exact h} @[simp] lemma nth_le_singleton (a : α) {n : ℕ} (hn : n < 1) : nth_le [a] n hn = a := -have hn0 : n = 0 := le_zero_iff.1 (le_of_lt_succ hn), +have hn0 : n = 0 := nat.eq_zero_of_le_zero (le_of_lt_succ hn), by subst hn0; refl lemma nth_le_zero [inhabited α] {L : list α} (h : 0 < L.length) : @@ -1266,9 +1302,9 @@ lemma nth_le_append_right : ∀ {l₁ l₂ : list α} {n : ℕ} (h₁ : l₁.len rw nth_le_append_right (nat.lt_succ_iff.mp h₁), end -@[simp] lemma nth_le_repeat (a : α) {n m : ℕ} (h : m < (list.repeat a n).length) : - (list.repeat a n).nth_le m h = a := -eq_of_mem_repeat (nth_le_mem _ _ _) +@[simp] lemma nth_le_replicate (a : α) {n m : ℕ} (h : m < (list.replicate n a).length) : + (list.replicate n a).nth_le m h = a := +eq_of_mem_replicate (nth_le_mem _ _ _) lemma nth_append {l₁ l₂ : list α} {n : ℕ} (hn : n < l₁.length) : (l₁ ++ l₂).nth n = l₁.nth n := @@ -1293,6 +1329,10 @@ lemma last_eq_nth_le : ∀ (l : list α) (h : l ≠ []), | (a :: b :: l) h := by { rw [last_cons, last_eq_nth_le (b :: l)], refl, exact cons_ne_nil b l } +lemma nth_le_length_sub_one {l : list α} (h : l.length - 1 < l.length) : + l.nth_le (l.length - 1) h = l.last (by { rintro rfl, exact nat.lt_irrefl 0 h }) := +(last_eq_nth_le l _).symm + @[simp] lemma nth_concat_length : ∀ (l : list α) (a : α), (l ++ [a]).nth l.length = some a | [] a := rfl | (b::l) a := by rw [cons_append, length_cons, nth, nth_concat_length] @@ -1305,6 +1345,17 @@ begin simp [h] end +lemma take_one_drop_eq_of_lt_length {l : list α} {n : ℕ} (h : n < l.length) : + (l.drop n).take 1 = [l.nth_le n h] := +begin + induction l with x l ih generalizing n, + { cases h }, + { by_cases h₁ : l = [], + { subst h₁, rw nth_le_singleton, simp [lt_succ_iff] at h, subst h, simp }, + have h₂ := h, rw [length_cons, nat.lt_succ_iff, le_iff_eq_or_lt] at h₂, + cases n, { simp }, rw [drop, nth_le], apply ih }, +end + @[ext] theorem ext : ∀ {l₁ l₂ : list α}, (∀n, nth l₁ n = nth l₂ n) → l₁ = l₂ | [] [] h := rfl @@ -1382,6 +1433,12 @@ begin exact eq_bot_iff.mpr (nat.lt_succ_iff.mp h₂) end +lemma nth_le_eq_iff {l : list α} {n : ℕ} {x : α} {h} : l.nth_le n h = x ↔ l.nth n = some x := +by { rw nth_eq_some, tauto } + +lemma some_nth_le_eq {l : list α} {n : ℕ} {h} : some (l.nth_le n h) = l.nth n := +by { symmetry, rw nth_eq_some, tauto } + lemma modify_nth_tail_modify_nth_tail {f g : list α → list α} (m : ℕ) : ∀n (l:list α), (l.modify_nth_tail f n).modify_nth_tail g (m + n) = l.modify_nth_tail (λl, (f l).modify_nth_tail g m) n @@ -1394,7 +1451,7 @@ lemma modify_nth_tail_modify_nth_tail_le (l.modify_nth_tail f n).modify_nth_tail g m = l.modify_nth_tail (λl, (f l).modify_nth_tail g (m - n)) n := begin - rcases le_iff_exists_add.1 h with ⟨m, rfl⟩, + rcases exists_add_of_le h with ⟨m, rfl⟩, rw [add_tsub_cancel_left, add_comm, modify_nth_tail_modify_nth_tail] end @@ -1555,31 +1612,7 @@ lemma mem_insert_nth {a b : α} : ∀ {n : ℕ} {l : list α} (hi : n ≤ l.leng | (n+1) [] h := (nat.not_succ_le_zero _ h).elim | (n+1) (a'::as) h := begin dsimp [list.insert_nth], - erw [list.mem_cons_iff, mem_insert_nth (nat.le_of_succ_le_succ h), list.mem_cons_iff, - ← or.assoc, or_comm (a = a'), or.assoc] -end - -lemma inj_on_insert_nth_index_of_not_mem (l : list α) (x : α) (hx : x ∉ l) : - set.inj_on (λ k, insert_nth k x l) {n | n ≤ l.length} := -begin - induction l with hd tl IH, - { intros n hn m hm h, - simp only [set.mem_singleton_iff, set.set_of_eq_eq_singleton, length, nonpos_iff_eq_zero] - at hn hm, - simp [hn, hm] }, - { intros n hn m hm h, - simp only [length, set.mem_set_of_eq] at hn hm, - simp only [mem_cons_iff, not_or_distrib] at hx, - cases n; - cases m, - { refl }, - { simpa [hx.left] using h }, - { simpa [ne.symm hx.left] using h }, - { simp only [true_and, eq_self_iff_true, insert_nth_succ_cons] at h, - rw nat.succ_inj', - refine IH hx.right _ _ h, - { simpa [nat.succ_le_succ_iff] using hn }, - { simpa [nat.succ_le_succ_iff] using hm } } } + erw [mem_insert_nth (nat.le_of_succ_le_succ h), ← or.assoc, or_comm (a = a'), or.assoc] end lemma insert_nth_of_length_lt (l : list α) (x : α) (n : ℕ) (h : l.length < n) : @@ -1755,13 +1788,26 @@ by { induction as, { refl }, { simp! [*, apply_ite (map f)] } } lemma last_map (f : α → β) {l : list α} (hl : l ≠ []) : (l.map f).last (mt eq_nil_of_map_eq_nil hl) = f (l.last hl) := begin - induction l with l_ih l_tl l_ih, + induction l with l_hd l_tl l_ih, { apply (hl rfl).elim }, { cases l_tl, { simp }, { simpa using l_ih } } end +lemma map_eq_replicate_iff {l : list α} {f : α → β} {b : β} : + l.map f = replicate l.length b ↔ (∀ x ∈ l, f x = b) := +by simp [eq_replicate] + +@[simp] theorem map_const (l : list α) (b : β) : map (const α b) l = replicate l.length b := +map_eq_replicate_iff.mpr (λ x _, rfl) + +-- Not a `simp` lemma because `function.const` is reducible in Lean 3 +theorem map_const' (l : list α) (b : β) : map (λ _, b) l = replicate l.length b := map_const l b + +theorem eq_of_mem_map_const {b₁ b₂ : β} {l : list α} (h : b₁ ∈ map (const α b₂) l) : b₁ = b₂ := +by rw map_const at h; exact eq_of_mem_replicate h + /-! ### map₂ -/ theorem nil_map₂ (f : α → β → γ) (l : list β) : map₂ f [] l = [] := @@ -1814,10 +1860,10 @@ theorem take_take : ∀ (n m) (l : list α), take n (take m l) = take (min n m) | (succ n) (succ m) nil := by simp only [take_nil] | (succ n) (succ m) (a::l) := by simp only [take, min_succ_succ, take_take n m l]; split; refl -theorem take_repeat (a : α) : ∀ (n m : ℕ), take n (repeat a m) = repeat a (min n m) +theorem take_replicate (a : α) : ∀ (n m : ℕ), take n (replicate m a) = replicate (min n m) a | n 0 := by simp | 0 m := by simp -| (succ n) (succ m) := by simp [min_succ_succ, take_repeat] +| (succ n) (succ m) := by simp [min_succ_succ, take_replicate] lemma map_take {α β : Type*} (f : α → β) : ∀ (L : list α) (i : ℕ), (L.take i).map f = (L.map f).take i @@ -1887,6 +1933,31 @@ end l.take k = [] ↔ l = [] ∨ k = 0 := by { cases l; cases k; simp [nat.succ_ne_zero] } +lemma take_eq_take : ∀ {l : list α} {m n : ℕ}, + l.take m = l.take n ↔ min m l.length = min n l.length +| [] m n := by simp +| (x :: xs) 0 0 := by simp +| (x :: xs) (m + 1) 0 := by simp +| (x :: xs) 0 (n + 1) := by simp [@eq_comm ℕ 0] +| (x :: xs) (m + 1) (n + 1) := by simp [nat.min_succ_succ, take_eq_take] + +lemma take_add (l : list α) (m n : ℕ) : + l.take (m + n) = l.take m ++ (l.drop m).take n := +begin + convert_to + take (m + n) (take m l ++ drop m l) = + take m l ++ take n (drop m l), + { rw take_append_drop }, + rw [take_append_eq_append_take, take_all_of_le, append_right_inj], swap, + { transitivity m, + { apply length_take_le }, + { simp }}, + simp only [take_eq_take, length_take, length_drop], + generalize : l.length = k, by_cases h : m ≤ k, + { simp [min_eq_left_iff.mpr h] }, + { push_neg at h, simp [nat.sub_eq_zero_of_le (le_of_lt h)] }, +end + lemma init_eq_take (l : list α) : l.init = l.take l.length.pred := begin cases l with x l, @@ -1976,6 +2047,16 @@ theorem drop_eq_nth_le_cons : ∀ {n} {l : list α} h, calc l.drop l.length = (l ++ []).drop l.length : by simp ... = [] : drop_left _ _ +lemma drop_length_cons {l : list α} (h : l ≠ []) (a : α) : + (a :: l).drop l.length = [l.last h] := +begin + induction l with y l ih generalizing a, + { cases h rfl }, + { simp only [drop, length], + by_cases h₁ : l = [], { simp [h₁] }, + rw last_cons h₁, exact ih h₁ y }, +end + /-- Dropping the elements up to `n` in `l₁ ++ l₂` is the same as dropping the elements up to `n` in `l₁`, dropping the elements up to `n - l₁.length` in `l₂`, and appending them. -/ lemma drop_append_eq_append_drop {l₁ l₂ : list α} {n : ℕ} : @@ -2102,7 +2183,7 @@ variable [inhabited α] | 0 l := rfl | (n+1) l := congr_arg succ (take'_length _ _) -@[simp] theorem take'_nil : ∀ n, take' n (@nil α) = repeat default n +@[simp] theorem take'_nil : ∀ n, take' n (@nil α) = replicate n default | 0 := rfl | (n+1) := congr_arg (cons _) (take'_nil _) @@ -2177,9 +2258,6 @@ foldl_fixed' (λ _, rfl) @[simp] theorem foldr_fixed {b : β} : Π l : list α, foldr (λ a b, b) b l = b := foldr_fixed' (λ _, rfl) -@[simp] theorem foldl_combinator_K {a : α} : Π l : list β, foldl combinator.K a l = a := -foldl_fixed - @[simp] theorem foldl_join (f : α → β → α) : ∀ (a : α) (L : list (list β)), foldl f a (join L) = foldl (foldl f) a L | a [] := rfl @@ -2436,8 +2514,8 @@ end foldl_eq_foldlr' section variables {op : α → α → α} [ha : is_associative α op] [hc : is_commutative α op] -local notation a * b := op a b -local notation l <*> a := foldl op a l +local notation (name := op) a ` * ` b := op a b +local notation (name := foldl) l ` <*> ` a := foldl op a l include ha @@ -2638,6 +2716,8 @@ end split_at_on with the same elements but in the type `{x // x ∈ l}`. -/ def attach (l : list α) : list {x // x ∈ l} := pmap subtype.mk l (λ a, id) +@[simp] lemma attach_nil : ([] : list α).attach = [] := rfl + theorem sizeof_lt_sizeof_of_mem [has_sizeof α] {x : α} {l : list α} (hx : x ∈ l) : sizeof x < sizeof l := begin @@ -2651,9 +2731,13 @@ end by induction l; [refl, simp only [*, pmap, map]]; split; refl theorem pmap_congr {p q : α → Prop} {f : Π a, p a → β} {g : Π a, q a → β} - (l : list α) {H₁ H₂} (h : ∀ a h₁ h₂, f a h₁ = g a h₂) : + (l : list α) {H₁ H₂} (h : ∀ (a ∈ l) h₁ h₂, f a h₁ = g a h₂) : pmap f l H₁ = pmap g l H₂ := -by induction l with _ _ ih; [refl, rw [pmap, pmap, h, ih]] +begin + induction l with _ _ ih, + { refl, }, + { rw [pmap, pmap, h _ (mem_cons_self _ _), ih (λ a ha, h a (mem_cons_of_mem _ ha))], }, +end theorem map_pmap {p : α → Prop} (g : β → γ) (f : Π a, p a → β) (l H) : map g (pmap f l H) = pmap (λ a h, g (f a h)) l H := @@ -2665,10 +2749,18 @@ by induction l; [refl, simp only [*, pmap, map]]; split; refl theorem pmap_eq_map_attach {p : α → Prop} (f : Π a, p a → β) (l H) : pmap f l H = l.attach.map (λ x, f x.1 (H _ x.2)) := -by rw [attach, map_pmap]; exact pmap_congr l (λ a h₁ h₂, rfl) +by rw [attach, map_pmap]; exact pmap_congr l (λ _ _ _ _, rfl) + +@[simp] lemma attach_map_coe' (l : list α) (f : α → β) : l.attach.map (λ i, f i) = l.map f := +by rw [attach, map_pmap]; exact (pmap_eq_map _ _ _ _) -theorem attach_map_val (l : list α) : l.attach.map subtype.val = l := -by rw [attach, map_pmap]; exact (pmap_eq_map _ _ _ _).trans (map_id l) +lemma attach_map_val' (l : list α) (f : α → β) : l.attach.map (λ i, f i.val) = l.map f := +attach_map_coe' _ _ + +@[simp] lemma attach_map_coe (l : list α) : l.attach.map (coe : _ → α) = l := +(attach_map_coe' _ _).trans l.map_id + +lemma attach_map_val (l : list α) : l.attach.map subtype.val = l := attach_map_coe _ @[simp] theorem mem_attach (l : list α) : ∀ x, x ∈ l.attach | ⟨a, h⟩ := by have := mem_map.1 (by rw [attach_map_val]; exact h); @@ -2722,6 +2814,23 @@ begin { simpa [hl] } } end +lemma pmap_append {p : ι → Prop} (f : Π (a : ι), p a → α) (l₁ l₂ : list ι) + (h : ∀ a ∈ l₁ ++ l₂, p a) : + (l₁ ++ l₂).pmap f h = l₁.pmap f (λ a ha, h a (mem_append_left l₂ ha)) ++ + l₂.pmap f (λ a ha, h a (mem_append_right l₁ ha)) := +begin + induction l₁ with _ _ ih, + { refl, }, + { dsimp only [pmap, cons_append], + rw ih, } +end + +lemma pmap_append' {α β : Type*} {p : α → Prop} (f : Π (a : α), p a → β) (l₁ l₂ : list α) + (h₁ : ∀ a ∈ l₁, p a) (h₂ : ∀ a ∈ l₂, p a) : + (l₁ ++ l₂).pmap f (λ a ha, (list.mem_append.1 ha).elim (h₁ a) (h₂ a)) = + l₁.pmap f h₁ ++ l₂.pmap f h₂ := +pmap_append f l₁ l₂ _ + /-! ### find -/ section find @@ -2904,6 +3013,14 @@ end @[simp] theorem filter_map_some (l : list α) : filter_map some l = l := by rw filter_map_eq_map; apply map_id +theorem map_filter_map_some_eq_filter_map_is_some (f : α → option β) (l : list α) : + (l.filter_map f).map some = (l.map f).filter (λ b, b.is_some) := +begin + induction l with x xs ih, + { simp }, + { cases h : f x; rw [list.filter_map_cons, h]; simp [h, ih] }, +end + @[simp] theorem mem_filter_map (f : α → option β) (l : list α) {b : β} : b ∈ filter_map f l ↔ ∃ a, a ∈ l ∧ f a = some b := begin @@ -2919,11 +3036,30 @@ begin or_and_distrib_right, exists_or_distrib, this, exists_eq_left] } end +@[simp] theorem filter_map_join (f : α → option β) (L : list (list α)) : + filter_map f (join L) = join (map (filter_map f) L) := +begin + induction L with hd tl ih, + { refl }, + { rw [map, join, join, filter_map_append, ih] }, +end + theorem map_filter_map_of_inv (f : α → option β) (g : β → α) (H : ∀ x : α, (f x).map g = some x) (l : list α) : map g (filter_map f l) = l := by simp only [map_filter_map, H, filter_map_some] +theorem length_filter_le (p : α → Prop) [decidable_pred p] (l : list α) : + (l.filter p).length ≤ l.length := +(list.filter_sublist _).length_le + +theorem length_filter_map_le (f : α → option β) (l : list α) : + (list.filter_map f l).length ≤ l.length := +begin + rw [← list.length_map some, list.map_filter_map_some_eq_filter_map_is_some, ← list.length_map f], + apply list.length_filter_le, +end + theorem sublist.filter_map (f : α → option β) {l₁ l₂ : list α} (s : l₁ <+ l₂) : filter_map f l₁ <+ filter_map f l₂ := by induction s with l₁ l₂ a s IH l₁ l₂ a s IH; @@ -3081,14 +3217,13 @@ begin { exact iff_of_true rfl (forall_mem_nil _) }, rw forall_mem_cons, by_cases p a, { rw [filter_cons_of_pos _ h, cons_inj, ih, and_iff_right h] }, - { rw [filter_cons_of_neg _ h], - refine iff_of_false _ (mt and.left h), intro e, - have := filter_sublist l, rw e at this, - exact not_lt_of_ge (length_le_of_sublist this) (lt_succ_self _) } + { refine iff_of_false (λ hl, h $ of_mem_filter (_ : a ∈ filter p (a :: l))) (mt and.left h), + rw hl, + exact mem_cons_self _ _ } end theorem filter_length_eq_length {l} : (filter p l).length = l.length ↔ ∀ a ∈ l, p a := -iff.trans ⟨eq_of_sublist_of_length_eq l.filter_sublist, congr_arg list.length⟩ filter_eq_self +iff.trans ⟨l.filter_sublist.eq_of_length, congr_arg list.length⟩ filter_eq_self theorem filter_eq_nil {l} : filter p l = [] ↔ ∀ a ∈ l, ¬p a := by simp only [eq_nil_iff_forall_not_mem, mem_filter, not_and] @@ -3117,12 +3252,35 @@ theorem map_filter (f : β → α) (l : list β) : filter p (map f l) = map f (filter (p ∘ f) l) := by rw [← filter_map_eq_map, filter_filter_map, filter_map_filter]; refl +lemma map_filter' {f : α → β} (hf : injective f) (l : list α) + [decidable_pred (λ b, ∃ a, p a ∧ f a = b)] : + (l.filter p).map f = (l.map f).filter (λ b, ∃ a, p a ∧ f a = b) := +by simp [(∘), map_filter, hf.eq_iff] + +lemma filter_attach' (l : list α) (p : {a // a ∈ l} → Prop) [decidable_eq α] [decidable_pred p] : + l.attach.filter p = (l.filter $ λ x, ∃ h, p ⟨x, h⟩).attach.map + (subtype.map id $ λ x hx, let ⟨h, _⟩ := of_mem_filter hx in h) := +begin + classical, + refine map_injective_iff.2 subtype.coe_injective _, + simp [(∘), map_filter' _ subtype.coe_injective], +end + +@[simp] lemma filter_attach (l : list α) (p : α → Prop) [decidable_pred p] : + l.attach.filter (λ x, p ↑x) = (l.filter p).attach.map (subtype.map id $ λ _, mem_of_mem_filter) := +map_injective_iff.2 subtype.coe_injective $ by + simp_rw [map_map, (∘), subtype.map, subtype.coe_mk, id.def, ←map_filter, attach_map_coe] + @[simp] theorem filter_filter (q) [decidable_pred q] : ∀ l, filter p (filter q l) = filter (λ a, p a ∧ q a) l | [] := rfl | (a :: l) := by by_cases hp : p a; by_cases hq : q a; simp only [hp, hq, filter, if_true, if_false, true_and, false_and, filter_filter l, eq_self_iff_true] +lemma filter_comm (q) [decidable_pred q] (l : list α) : + filter p (filter q l) = filter q (filter p l) := +by simp [and_comm] + @[simp] lemma filter_true {h : decidable_pred (λ a : α, true)} (l : list α) : @filter α (λ _, true) h l = l := by convert filter_eq_self.2 (λ _ _, trivial) @@ -3143,6 +3301,70 @@ by convert filter_eq_nil.2 (λ _ _, id) take_while_append_drop l] else by rw [take_while, drop_while, if_neg pa, if_neg pa, nil_append] +lemma drop_while_nth_le_zero_not (l : list α) (hl : 0 < (l.drop_while p).length) : + ¬ p ((l.drop_while p).nth_le 0 hl) := +begin + induction l with hd tl IH, + { cases hl }, + { simp only [drop_while], + split_ifs with hp, + { exact IH _ }, + { simpa using hp } } +end + +variables {p} {l : list α} + +@[simp] lemma drop_while_eq_nil_iff : drop_while p l = [] ↔ ∀ x ∈ l, p x := +begin + induction l with x xs IH, + { simp [drop_while] }, + { by_cases hp : p x; + simp [hp, drop_while, IH] } +end + +@[simp] lemma take_while_eq_self_iff : take_while p l = l ↔ ∀ x ∈ l, p x := +begin + induction l with x xs IH, + { simp [take_while] }, + { by_cases hp : p x; + simp [hp, take_while, IH] } +end + +@[simp] lemma take_while_eq_nil_iff : + take_while p l = [] ↔ ∀ (hl : 0 < l.length), ¬ p (l.nth_le 0 hl) := +begin + induction l with x xs IH, + { simp }, + { by_cases hp : p x; + simp [hp, take_while, IH] } +end + +lemma mem_take_while_imp {x : α} (hx : x ∈ take_while p l) : p x := +begin + induction l with hd tl IH, + { simpa [take_while] using hx }, + { simp only [take_while] at hx, + split_ifs at hx, + { rw mem_cons_iff at hx, + rcases hx with rfl|hx, + { exact h }, + { exact IH hx } }, + { simpa using hx } } +end + +lemma take_while_take_while (p q : α → Prop) [decidable_pred p] [decidable_pred q] (l : list α) : + take_while p (take_while q l) = take_while (λ a, p a ∧ q a) l := +begin + induction l with hd tl IH, + { simp [take_while] }, + { by_cases hp : p hd; + by_cases hq : q hd; + simp [take_while, hp, hq, IH] } +end + +lemma take_while_idem : take_while p (take_while p l) = take_while p l := +by simp_rw [take_while_take_while, and_self] + end filter /-! ### erasep -/ @@ -3468,6 +3690,80 @@ begin { simp [hmem] } } end +@[simp] lemma enum_nil : enum ([] : list α) = [] := rfl +@[simp] lemma enum_from_nil (n : ℕ) : enum_from n ([] : list α) = [] := rfl + +@[simp] lemma enum_from_cons (x : α) (xs : list α) (n : ℕ) : + enum_from n (x :: xs) = (n, x) :: enum_from (n + 1) xs := rfl +@[simp] lemma enum_cons (x : α) (xs : list α) : + enum (x :: xs) = (0, x) :: enum_from 1 xs := rfl +@[simp] lemma enum_from_singleton (x : α) (n : ℕ) : + enum_from n [x] = [(n, x)] := rfl +@[simp] lemma enum_singleton (x : α) : + enum [x] = [(0, x)] := rfl + +lemma enum_from_append (xs ys : list α) (n : ℕ) : + enum_from n (xs ++ ys) = enum_from n xs ++ enum_from (n + xs.length) ys := +begin + induction xs with x xs IH generalizing ys n, + { simp }, + { rw [cons_append, enum_from_cons, IH, ←cons_append, ←enum_from_cons, + length, add_right_comm, add_assoc] } +end + +lemma enum_append (xs ys : list α) : + enum (xs ++ ys) = enum xs ++ enum_from xs.length ys := +by simp [enum, enum_from_append] + +lemma map_fst_add_enum_from_eq_enum_from (l : list α) (n k : ℕ) : + map (prod.map (+ n) id) (enum_from k l) = enum_from (n + k) l := +begin + induction l with hd tl IH generalizing n k, + { simp [enum_from] }, + { simp only [enum_from, map, zero_add, prod.map_mk, id.def, + eq_self_iff_true, true_and], + simp [IH, add_comm n k, add_assoc, add_left_comm] } +end + +lemma map_fst_add_enum_eq_enum_from (l : list α) (n : ℕ) : + map (prod.map (+ n) id) (enum l) = enum_from n l := +map_fst_add_enum_from_eq_enum_from l _ _ + +lemma enum_from_cons' (n : ℕ) (x : α) (xs : list α) : + enum_from n (x :: xs) = (n, x) :: (enum_from n xs).map (prod.map nat.succ id) := +by rw [enum_from_cons, add_comm, ←map_fst_add_enum_from_eq_enum_from] + +lemma enum_cons' (x : α) (xs : list α) : + enum (x :: xs) = (0, x) :: (enum xs).map (prod.map nat.succ id) := +enum_from_cons' _ _ _ + +lemma enum_from_map (n : ℕ) (l : list α) (f : α → β) : + enum_from n (l.map f) = (enum_from n l).map (prod.map id f) := +begin + induction l with hd tl IH, + { refl }, + { rw [map_cons, enum_from_cons', enum_from_cons', map_cons, map_map, IH, map_map], + refl, }, +end + +lemma enum_map (l : list α) (f : α → β) : (l.map f).enum = l.enum.map (prod.map id f) := +enum_from_map _ _ _ + +lemma nth_le_enum_from (l : list α) (n i : ℕ) + (hi' : i < (l.enum_from n).length) + (hi : i < l.length := by simpa [length_enum_from] using hi') : + (l.enum_from n).nth_le i hi' = (n + i, l.nth_le i hi) := +begin + rw [←option.some_inj, ←nth_le_nth], + simp [enum_from_nth, nth_le_nth hi] +end + +lemma nth_le_enum (l : list α) (i : ℕ) + (hi' : i < l.enum.length) + (hi : i < l.length := by simpa [length_enum] using hi') : + l.enum.nth_le i hi' = (i, l.nth_le i hi) := +by { convert nth_le_enum_from _ _ _ hi', exact (zero_add _).symm } + section choose variables (p : α → Prop) [decidable_pred p] (l : list α) @@ -3784,6 +4080,15 @@ attribute [to_additive] alternating_prod -- `list.alternating_sum` /-! ### Miscellaneous lemmas -/ +lemma last_reverse {l : list α} (hl : l.reverse ≠ []) + (hl' : 0 < l.length := by { contrapose! hl, simpa [length_eq_zero] using hl }) : + l.reverse.last hl = l.nth_le 0 hl' := +begin + rw [last_eq_nth_le, nth_le_reverse'], + { simp, }, + { simpa using hl' } +end + theorem ilast'_mem : ∀ a l, @ilast' α a l ∈ a :: l | a [] := or.inl rfl | a (b::l) := or.inr (ilast'_mem b l) @@ -3832,9 +4137,113 @@ begin { cases j; unfold_wf, refl, transitivity, apply xs_ih, simp }, }, - unfold_wf, apply zero_lt_one_add, }, + unfold_wf, }, { unfold_wf, apply xs_ih _ _ h, apply lt_of_succ_lt_succ hi, } }, end +/-! ### nthd and inth -/ + +section nthd + +variables (l : list α) (x : α) (xs : list α) (d : α) (n : ℕ) + +@[simp] lemma nthd_nil : nthd [] n d = d := rfl + +@[simp] lemma nthd_cons_zero : nthd (x::xs) 0 d = x := rfl + +@[simp] lemma nthd_cons_succ : nthd (x::xs) (n + 1) d = nthd xs n d := rfl + +lemma nthd_eq_nth_le {n : ℕ} (hn : n < l.length) : l.nthd n d = l.nth_le n hn := +begin + induction l with hd tl IH generalizing n, + { exact absurd hn (not_lt_of_ge (nat.zero_le _)) }, + { cases n, + { exact nthd_cons_zero _ _ _ }, + { exact IH _ } } +end + +lemma nthd_eq_default {n : ℕ} (hn : l.length ≤ n) : l.nthd n d = d := +begin + induction l with hd tl IH generalizing n, + { exact nthd_nil _ _ }, + { cases n, + { refine absurd (nat.zero_lt_succ _) (not_lt_of_ge hn) }, + { exact IH (nat.le_of_succ_le_succ hn) } } +end + +/-- An empty list can always be decidably checked for the presence of an element. +Not an instance because it would clash with `decidable_eq α`. -/ +def decidable_nthd_nil_ne {α} (a : α) : decidable_pred + (λ (i : ℕ), nthd ([] : list α) i a ≠ a) := λ i, is_false $ λ H, H (nthd_nil _ _) + +@[simp] lemma nthd_singleton_default_eq (n : ℕ) : [d].nthd n d = d := +by { cases n; simp } + +@[simp] lemma nthd_replicate_default_eq (r n : ℕ) : (replicate r d).nthd n d = d := +begin + induction r with r IH generalizing n, + { simp }, + { cases n; + simp [IH] } +end + +lemma nthd_append (l l' : list α) (d : α) (n : ℕ) (h : n < l.length) + (h' : n < (l ++ l').length := h.trans_le ((length_append l l').symm ▸ le_self_add)) : + (l ++ l').nthd n d = l.nthd n d := +by rw [nthd_eq_nth_le _ _ h', nth_le_append h' h, nthd_eq_nth_le] + +lemma nthd_append_right (l l' : list α) (d : α) (n : ℕ) (h : l.length ≤ n) : + (l ++ l').nthd n d = l'.nthd (n - l.length) d := +begin + cases lt_or_le _ _ with h' h', + { rw [nthd_eq_nth_le _ _ h', nth_le_append_right h h', nthd_eq_nth_le] }, + { rw [nthd_eq_default _ _ h', nthd_eq_default], + rwa [le_tsub_iff_left h, ←length_append] } +end + +lemma nthd_eq_get_or_else_nth (n : ℕ) : + l.nthd n d = (l.nth n).get_or_else d := +begin + cases lt_or_le _ _ with h h, + { rw [nthd_eq_nth_le _ _ h, nth_le_nth h, option.get_or_else_some] }, + { rw [nthd_eq_default _ _ h, nth_eq_none_iff.mpr h, option.get_or_else_none] } +end + +end nthd + +section inth + +variables [inhabited α] (l : list α) (x : α) (xs : list α) (n : ℕ) + +@[simp] lemma inth_nil : inth ([] : list α) n = default := rfl + +@[simp] lemma inth_cons_zero : inth (x::xs) 0 = x := rfl + +@[simp] lemma inth_cons_succ : inth (x::xs) (n + 1) = inth xs n := rfl + +lemma inth_eq_nth_le {n : ℕ} (hn : n < l.length) : l.inth n = l.nth_le n hn := nthd_eq_nth_le _ _ _ + +lemma inth_eq_default {n : ℕ} (hn : l.length ≤ n) : l.inth n = default := nthd_eq_default _ _ hn + +lemma nthd_default_eq_inth : l.nthd n default = l.inth n := rfl + +lemma inth_append (l l' : list α) (n : ℕ) (h : n < l.length) + (h' : n < (l ++ l').length := h.trans_le ((length_append l l').symm ▸ le_self_add)) : + (l ++ l').inth n = l.inth n := +nthd_append _ _ _ _ h h' + +lemma inth_append_right (l l' : list α) (n : ℕ) (h : l.length ≤ n) : + (l ++ l').inth n = l'.inth (n - l.length) := +nthd_append_right _ _ _ _ h + +lemma inth_eq_iget_nth (n : ℕ) : + l.inth n = (l.nth n).iget := +by rw [←nthd_default_eq_inth, nthd_eq_get_or_else_nth, option.get_or_else_default_eq_iget] + +lemma inth_zero_eq_head : l.inth 0 = l.head := +by { cases l; refl, } + +end inth + end list diff --git a/src/data/list/big_operators.lean b/src/data/list/big_operators.lean deleted file mode 100644 index 5703dd132e3a1..0000000000000 --- a/src/data/list/big_operators.lean +++ /dev/null @@ -1,617 +0,0 @@ -/- -Copyright (c) 2017 Johannes Hölzl. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best --/ -import algebra.group_power -import data.list.forall2 - -/-! -# Sums and products from lists - -This file provides basic results about `list.prod`, `list.sum`, which calculate the product and sum -of elements of a list and `list.alternating_prod`, `list.alternating_sum`, their alternating -counterparts. These are defined in [`data.list.defs`](./defs). --/ - -variables {ι α M N P M₀ G R : Type*} - -namespace list -section monoid -variables [monoid M] [monoid N] [monoid P] {l l₁ l₂ : list M} {a : M} - -@[simp, to_additive] -lemma prod_nil : ([] : list M).prod = 1 := rfl - -@[to_additive] -lemma prod_singleton : [a].prod = a := one_mul a - -@[simp, to_additive] -lemma prod_cons : (a :: l).prod = a * l.prod := -calc (a :: l).prod = foldl (*) (a * 1) l : by simp only [list.prod, foldl_cons, one_mul, mul_one] - ... = _ : foldl_assoc - -@[simp, to_additive] -lemma prod_append : (l₁ ++ l₂).prod = l₁.prod * l₂.prod := -calc (l₁ ++ l₂).prod = foldl (*) (foldl (*) 1 l₁ * 1) l₂ : by simp [list.prod] - ... = l₁.prod * l₂.prod : foldl_assoc - -@[to_additive] -lemma prod_concat : (l.concat a).prod = l.prod * a := -by rw [concat_eq_append, prod_append, prod_singleton] - -@[simp, to_additive] -lemma prod_join {l : list (list M)} : l.join.prod = (l.map list.prod).prod := -by induction l; [refl, simp only [*, list.join, map, prod_append, prod_cons]] - -@[to_additive] -lemma prod_eq_foldr : l.prod = foldr (*) 1 l := -list.rec_on l rfl $ λ a l ihl, by rw [prod_cons, foldr_cons, ihl] - -@[simp, priority 500, to_additive] -theorem prod_repeat (a : M) (n : ℕ) : (repeat a n).prod = a ^ n := -begin - induction n with n ih, - { rw pow_zero, refl }, - { rw [list.repeat_succ, list.prod_cons, ih, pow_succ] } -end - -@[to_additive sum_eq_card_nsmul] -lemma prod_eq_pow_card (l : list M) (m : M) (h : ∀ (x ∈ l), x = m) : - l.prod = m ^ l.length := -by rw [← prod_repeat, ← list.eq_repeat.mpr ⟨rfl, h⟩] - -@[to_additive] -lemma prod_hom_rel (l : list ι) {r : M → N → Prop} {f : ι → M} {g : ι → N} (h₁ : r 1 1) - (h₂ : ∀ ⦃i a b⦄, r a b → r (f i * a) (g i * b)) : - r (l.map f).prod (l.map g).prod := -list.rec_on l h₁ (λ a l hl, by simp only [map_cons, prod_cons, h₂ hl]) - -@[to_additive] -lemma prod_hom (l : list M) {F : Type*} [monoid_hom_class F M N] (f : F) : - (l.map f).prod = f l.prod := -by { simp only [prod, foldl_map, ← map_one f], - exact l.foldl_hom _ _ _ 1 (map_mul f) } - -@[to_additive] -lemma prod_hom₂ (l : list ι) (f : M → N → P) - (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → M) (f₂ : ι → N) : - (l.map $ λ i, f (f₁ i) (f₂ i)).prod = f (l.map f₁).prod (l.map f₂).prod := -begin - simp only [prod, foldl_map], - convert l.foldl_hom₂ (λ a b, f a b) _ _ _ _ _ (λ a b i, _), - { exact hf'.symm }, - { exact hf _ _ _ _ } -end - -@[simp, to_additive] -lemma prod_map_mul {α : Type*} [comm_monoid α] {l : list ι} {f g : ι → α} : - (l.map $ λ i, f i * g i).prod = (l.map f).prod * (l.map g).prod := -l.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _ - -@[to_additive] -lemma prod_map_hom (L : list ι) (f : ι → M) {G : Type*} [monoid_hom_class G M N] (g : G) : - (L.map (g ∘ f)).prod = g ((L.map f).prod) := -by rw [← prod_hom, map_map] - -@[to_additive] -lemma prod_is_unit : Π {L : list M} (u : ∀ m ∈ L, is_unit m), is_unit L.prod -| [] _ := by simp -| (h :: t) u := -begin - simp only [list.prod_cons], - exact is_unit.mul (u h (mem_cons_self h t)) (prod_is_unit (λ m mt, u m (mem_cons_of_mem h mt))) -end - -@[simp, to_additive] -lemma prod_take_mul_prod_drop : - ∀ (L : list M) (i : ℕ), (L.take i).prod * (L.drop i).prod = L.prod -| [] i := by simp -| L 0 := by simp -| (h :: t) (n+1) := by { dsimp, rw [prod_cons, prod_cons, mul_assoc, prod_take_mul_prod_drop] } - -@[simp, to_additive] -lemma prod_take_succ : - ∀ (L : list M) (i : ℕ) (p), (L.take (i + 1)).prod = (L.take i).prod * L.nth_le i p -| [] i p := by cases p -| (h :: t) 0 _ := by simp -| (h :: t) (n+1) _ := by { dsimp, rw [prod_cons, prod_cons, prod_take_succ, mul_assoc] } - -/-- A list with product not one must have positive length. -/ -@[to_additive "A list with sum not zero must have positive length."] -lemma length_pos_of_prod_ne_one (L : list M) (h : L.prod ≠ 1) : 0 < L.length := -by { cases L, { contrapose h, simp }, { simp } } - -/-- A list with product greater than one must have positive length. -/ -@[to_additive length_pos_of_sum_pos "A list with positive sum must have positive length."] -lemma length_pos_of_one_lt_prod [preorder M] (L : list M) (h : 1 < L.prod) : - 0 < L.length := -length_pos_of_prod_ne_one L h.ne' - -/-- A list with product less than one must have positive length. -/ -@[to_additive "A list with negative sum must have positive length."] -lemma length_pos_of_prod_lt_one [preorder M] (L : list M) (h : L.prod < 1) : - 0 < L.length := -length_pos_of_prod_ne_one L h.ne - -@[to_additive] -lemma prod_update_nth : ∀ (L : list M) (n : ℕ) (a : M), - (L.update_nth n a).prod = - (L.take n).prod * (if n < L.length then a else 1) * (L.drop (n + 1)).prod -| (x :: xs) 0 a := by simp [update_nth] -| (x :: xs) (i+1) a := by simp [update_nth, prod_update_nth xs i a, mul_assoc] -| [] _ _ := by simp [update_nth, (nat.zero_le _).not_lt] - -open mul_opposite - -/-- We'd like to state this as `L.head * L.tail.prod = L.prod`, but because `L.head` relies on an -inhabited instance to return a garbage value on the empty list, this is not possible. -Instead, we write the statement in terms of `(L.nth 0).get_or_else 1`. --/ -@[to_additive "We'd like to state this as `L.head + L.tail.sum = L.sum`, but because `L.head` -relies on an inhabited instance to return a garbage value on the empty list, this is not possible. -Instead, we write the statement in terms of `(L.nth 0).get_or_else 0`."] -lemma nth_zero_mul_tail_prod (l : list M) : (l.nth 0).get_or_else 1 * l.tail.prod = l.prod := -by cases l; simp - -/-- Same as `nth_zero_mul_tail_prod`, but avoiding the `list.head` garbage complication by requiring -the list to be nonempty. -/ -@[to_additive "Same as `nth_zero_add_tail_sum`, but avoiding the `list.head` garbage complication -by requiring the list to be nonempty."] -lemma head_mul_tail_prod_of_ne_nil [inhabited M] (l : list M) (h : l ≠ []) : - l.head * l.tail.prod = l.prod := -by cases l; [contradiction, simp] - -@[to_additive] -lemma _root_.commute.list_prod_right (l : list M) (y : M) (h : ∀ (x ∈ l), commute y x) : - commute y l.prod := -begin - induction l with z l IH, - { simp }, - { rw list.ball_cons at h, - rw list.prod_cons, - exact commute.mul_right h.1 (IH h.2), } -end - -@[to_additive] -lemma _root_.commute.list_prod_left (l : list M) (y : M) (h : ∀ (x ∈ l), commute x y) : - commute l.prod y := -(commute.list_prod_right _ _ $ λ x hx, (h _ hx).symm).symm - -lemma _root_.commute.list_sum_right [non_unital_non_assoc_semiring R] (a : R) (l : list R) - (h : ∀ b ∈ l, commute a b) : - commute a l.sum := -begin - induction l with x xs ih, - { exact commute.zero_right _, }, - { rw sum_cons, - exact (h _ $ mem_cons_self _ _).add_right (ih $ λ j hj, h _ $ mem_cons_of_mem _ hj) } -end - -lemma _root_.commute.list_sum_left [non_unital_non_assoc_semiring R] (b : R) (l : list R) - (h : ∀ a ∈ l, commute a b) : - commute l.sum b := -(commute.list_sum_right _ _ $ λ x hx, (h _ hx).symm).symm - -@[to_additive sum_le_sum] lemma forall₂.prod_le_prod' [preorder M] - [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] - {l₁ l₂ : list M} (h : forall₂ (≤) l₁ l₂) : l₁.prod ≤ l₂.prod := -begin - induction h with a b la lb hab ih ih', - { refl }, - { simpa only [prod_cons] using mul_le_mul' hab ih' } -end - -/-- If `l₁` is a sublist of `l₂` and all elements of `l₂` are greater than or equal to one, then -`l₁.prod ≤ l₂.prod`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 1 ≤ a` instead -of `∀ a ∈ l₂, 1 ≤ a` but this lemma is not yet in `mathlib`. -/ -@[to_additive sum_le_sum "If `l₁` is a sublist of `l₂` and all elements of `l₂` are nonnegative, -then `l₁.sum ≤ l₂.sum`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 0 ≤ a` instead -of `∀ a ∈ l₂, 0 ≤ a` but this lemma is not yet in `mathlib`."] -lemma sublist.prod_le_prod' [preorder M] [covariant_class M M (function.swap (*)) (≤)] - [covariant_class M M (*) (≤)] {l₁ l₂ : list M} (h : l₁ <+ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) : - l₁.prod ≤ l₂.prod := -begin - induction h, { refl }, - case cons : l₁ l₂ a ih ih' - { simp only [prod_cons, forall_mem_cons] at h₁ ⊢, - exact (ih' h₁.2).trans (le_mul_of_one_le_left' h₁.1) }, - case cons2 : l₁ l₂ a ih ih' - { simp only [prod_cons, forall_mem_cons] at h₁ ⊢, - exact mul_le_mul_left' (ih' h₁.2) _ } -end - -@[to_additive sum_le_sum] lemma sublist_forall₂.prod_le_prod' [preorder M] - [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] - {l₁ l₂ : list M} (h : sublist_forall₂ (≤) l₁ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) : - l₁.prod ≤ l₂.prod := -let ⟨l, hall, hsub⟩ := sublist_forall₂_iff.1 h -in hall.prod_le_prod'.trans $ hsub.prod_le_prod' h₁ - -@[to_additive sum_le_sum] lemma prod_le_prod' [preorder M] - [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] - {l : list ι} {f g : ι → M} (h : ∀ i ∈ l, f i ≤ g i) : - (l.map f).prod ≤ (l.map g).prod := -forall₂.prod_le_prod' $ by simpa - -@[to_additive sum_lt_sum] lemma prod_lt_prod' - [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)] - [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)] - {l : list ι} (f g : ι → M) (h₁ : ∀ i ∈ l, f i ≤ g i) (h₂ : ∃ i ∈ l, f i < g i) : - (l.map f).prod < (l.map g).prod := -begin - induction l with i l ihl, { rcases h₂ with ⟨_, ⟨⟩, _⟩ }, - simp only [ball_cons, bex_cons, map_cons, prod_cons] at h₁ h₂ ⊢, - cases h₂, - exacts [mul_lt_mul_of_lt_of_le h₂ (prod_le_prod' h₁.2), - mul_lt_mul_of_le_of_lt h₁.1 $ ihl h₁.2 h₂] -end - -@[to_additive] lemma prod_lt_prod_of_ne_nil - [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)] - [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)] - {l : list ι} (hl : l ≠ []) (f g : ι → M) (hlt : ∀ i ∈ l, f i < g i) : - (l.map f).prod < (l.map g).prod := -prod_lt_prod' f g (λ i hi, (hlt i hi).le) $ (exists_mem_of_ne_nil l hl).imp $ λ i hi, ⟨hi, hlt i hi⟩ - -@[to_additive sum_le_card_nsmul] -lemma prod_le_pow_card [preorder M] - [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] - (l : list M) (n : M) (h : ∀ (x ∈ l), x ≤ n) : - l.prod ≤ n ^ l.length := -by simpa only [map_id'', map_const, prod_repeat] using prod_le_prod' h - -@[to_additive card_nsmul_le_sum] -lemma pow_card_le_prod [preorder M] - [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] - (l : list M) (n : M) (h : ∀ (x ∈ l), n ≤ x) : - n ^ l.length ≤ l.prod := -@prod_le_pow_card Mᵒᵈ _ _ _ _ l n h - -@[to_additive exists_lt_of_sum_lt] lemma exists_lt_of_prod_lt' [linear_order M] - [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] {l : list ι} - (f g : ι → M) (h : (l.map f).prod < (l.map g).prod) : - ∃ i ∈ l, f i < g i := -by { contrapose! h, exact prod_le_prod' h } - -@[to_additive exists_le_of_sum_le] -lemma exists_le_of_prod_le' [linear_order M] [covariant_class M M (*) (<)] - [covariant_class M M (*) (≤)] [covariant_class M M (function.swap (*)) (<)] - [covariant_class M M (function.swap (*)) (≤)] {l : list ι} (hl : l ≠ []) - (f g : ι → M) (h : (l.map f).prod ≤ (l.map g).prod) : - ∃ x ∈ l, f x ≤ g x := -by { contrapose! h, exact prod_lt_prod_of_ne_nil hl _ _ h } - -@[to_additive sum_nonneg] -lemma one_le_prod_of_one_le [preorder M] [covariant_class M M (*) (≤)] {l : list M} - (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) : - 1 ≤ l.prod := -begin - -- We don't use `pow_card_le_prod` to avoid assumption - -- [covariant_class M M (function.swap (*)) (≤)] - induction l with hd tl ih, { refl }, - rw prod_cons, - exact one_le_mul (hl₁ hd (mem_cons_self hd tl)) (ih (λ x h, hl₁ x (mem_cons_of_mem hd h))) -end - -end monoid - -section monoid_with_zero - -variables [monoid_with_zero M₀] - -/-- If zero is an element of a list `L`, then `list.prod L = 0`. If the domain is a nontrivial -monoid with zero with no divisors, then this implication becomes an `iff`, see -`list.prod_eq_zero_iff`. -/ -lemma prod_eq_zero {L : list M₀} (h : (0 : M₀) ∈ L) : L.prod = 0 := -begin - induction L with a L ihL, - { exact absurd h (not_mem_nil _) }, - { rw prod_cons, - cases (mem_cons_iff _ _ _).1 h with ha hL, - exacts [mul_eq_zero_of_left ha.symm _, mul_eq_zero_of_right _ (ihL hL)] } -end - -/-- Product of elements of a list `L` equals zero if and only if `0 ∈ L`. See also -`list.prod_eq_zero` for an implication that needs weaker typeclass assumptions. -/ -@[simp] lemma prod_eq_zero_iff [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} : - L.prod = 0 ↔ (0 : M₀) ∈ L := -begin - induction L with a L ihL, - { simp }, - { rw [prod_cons, mul_eq_zero, ihL, mem_cons_iff, eq_comm] } -end - -lemma prod_ne_zero [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} (hL : (0 : M₀) ∉ L) : - L.prod ≠ 0 := -mt prod_eq_zero_iff.1 hL - -end monoid_with_zero - -section group -variables [group G] - -/-- This is the `list.prod` version of `mul_inv_rev` -/ -@[to_additive "This is the `list.sum` version of `add_neg_rev`"] -lemma prod_inv_reverse : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).reverse.prod -| [] := by simp -| (x :: xs) := by simp [prod_inv_reverse xs] - -/-- A non-commutative variant of `list.prod_reverse` -/ -@[to_additive "A non-commutative variant of `list.sum_reverse`"] -lemma prod_reverse_noncomm : ∀ (L : list G), L.reverse.prod = (L.map (λ x, x⁻¹)).prod⁻¹ := -by simp [prod_inv_reverse] - -/-- Counterpart to `list.prod_take_succ` when we have an inverse operation -/ -@[simp, to_additive /-"Counterpart to `list.sum_take_succ` when we have an negation operation"-/] -lemma prod_drop_succ : - ∀ (L : list G) (i : ℕ) (p), (L.drop (i + 1)).prod = (L.nth_le i p)⁻¹ * (L.drop i).prod -| [] i p := false.elim (nat.not_lt_zero _ p) -| (x :: xs) 0 p := by simp -| (x :: xs) (i + 1) p := prod_drop_succ xs i _ - -end group - -section comm_group -variables [comm_group G] - -/-- This is the `list.prod` version of `mul_inv` -/ -@[to_additive "This is the `list.sum` version of `add_neg`"] -lemma prod_inv : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).prod -| [] := by simp -| (x :: xs) := by simp [mul_comm, prod_inv xs] - -/-- Alternative version of `list.prod_update_nth` when the list is over a group -/ -@[to_additive /-"Alternative version of `list.sum_update_nth` when the list is over a group"-/] -lemma prod_update_nth' (L : list G) (n : ℕ) (a : G) : - (L.update_nth n a).prod = - L.prod * (if hn : n < L.length then (L.nth_le n hn)⁻¹ * a else 1) := -begin - refine (prod_update_nth L n a).trans _, - split_ifs with hn hn, - { rw [mul_comm _ a, mul_assoc a, prod_drop_succ L n hn, mul_comm _ (drop n L).prod, - ← mul_assoc (take n L).prod, prod_take_mul_prod_drop, mul_comm a, mul_assoc] }, - { simp only [take_all_of_le (le_of_not_lt hn), prod_nil, mul_one, - drop_eq_nil_of_le ((le_of_not_lt hn).trans n.le_succ)] } -end - -end comm_group - -@[to_additive] -lemma eq_of_prod_take_eq [left_cancel_monoid M] {L L' : list M} (h : L.length = L'.length) - (h' : ∀ i ≤ L.length, (L.take i).prod = (L'.take i).prod) : L = L' := -begin - apply ext_le h (λ i h₁ h₂, _), - have : (L.take (i + 1)).prod = (L'.take (i + 1)).prod := h' _ (nat.succ_le_of_lt h₁), - rw [prod_take_succ L i h₁, prod_take_succ L' i h₂, h' i (le_of_lt h₁)] at this, - convert mul_left_cancel this -end - -@[to_additive] -lemma monotone_prod_take [canonically_ordered_monoid M] (L : list M) : - monotone (λ i, (L.take i).prod) := -begin - apply monotone_nat_of_le_succ (λ n, _), - cases lt_or_le n L.length with h h, - { rw prod_take_succ _ _ h, - exact le_self_mul }, - { simp [take_all_of_le h, take_all_of_le (le_trans h (nat.le_succ _))] } -end - -@[to_additive sum_pos] -lemma one_lt_prod_of_one_lt [ordered_comm_monoid M] : - ∀ (l : list M) (hl : ∀ x ∈ l, (1 : M) < x) (hl₂ : l ≠ []), 1 < l.prod -| [] _ h := (h rfl).elim -| [b] h _ := by simpa using h -| (a :: b :: l) hl₁ hl₂ := -begin - simp only [forall_eq_or_imp, list.mem_cons_iff _ a] at hl₁, - rw list.prod_cons, - apply one_lt_mul_of_lt_of_le' hl₁.1, - apply le_of_lt ((b :: l).one_lt_prod_of_one_lt hl₁.2 (l.cons_ne_nil b)), -end - -@[to_additive] -lemma single_le_prod [ordered_comm_monoid M] {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) : - ∀ x ∈ l, x ≤ l.prod := -begin - induction l, - { simp }, - simp_rw [prod_cons, forall_mem_cons] at ⊢ hl₁, - split, - { exact le_mul_of_one_le_right' (one_le_prod_of_one_le hl₁.2) }, - { exact λ x H, le_mul_of_one_le_of_le hl₁.1 (l_ih hl₁.right x H) }, -end - -@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero] -lemma all_one_of_le_one_le_of_prod_eq_one [ordered_comm_monoid M] - {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) (hl₂ : l.prod = 1) {x : M} (hx : x ∈ l) : - x = 1 := -le_antisymm (hl₂ ▸ single_le_prod hl₁ _ hx) (hl₁ x hx) - -@[to_additive] lemma prod_eq_one_iff [canonically_ordered_monoid M] (l : list M) : - l.prod = 1 ↔ ∀ x ∈ l, x = (1 : M) := -⟨all_one_of_le_one_le_of_prod_eq_one (λ _ _, one_le _), - λ h, by rw [eq_repeat.2 ⟨rfl, h⟩, prod_repeat, one_pow]⟩ - -/-- If all elements in a list are bounded below by `1`, then the length of the list is bounded -by the sum of the elements. -/ -lemma length_le_sum_of_one_le (L : list ℕ) (h : ∀ i ∈ L, 1 ≤ i) : L.length ≤ L.sum := -begin - induction L with j L IH h, { simp }, - rw [sum_cons, length, add_comm], - exact add_le_add (h _ (set.mem_insert _ _)) (IH (λ i hi, h i (set.mem_union_right _ hi))) -end - --- TODO: develop theory of tropical rings -lemma sum_le_foldr_max [add_monoid M] [add_monoid N] [linear_order N] (f : M → N) - (h0 : f 0 ≤ 0) (hadd : ∀ x y, f (x + y) ≤ max (f x) (f y)) (l : list M) : - f l.sum ≤ (l.map f).foldr max 0 := -begin - induction l with hd tl IH, - { simpa using h0 }, - simp only [list.sum_cons, list.foldr_map, list.foldr] at IH ⊢, - exact (hadd _ _).trans (max_le_max le_rfl IH) -end - -@[simp, to_additive] -lemma prod_erase [decidable_eq M] [comm_monoid M] {a} : - ∀ {l : list M}, a ∈ l → a * (l.erase a).prod = l.prod -| (b :: l) h := - begin - obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h, - { simp only [list.erase, if_pos, prod_cons] }, - { simp only [list.erase, if_neg (mt eq.symm ne), prod_cons, prod_erase h, mul_left_comm a b] } - end - -lemma dvd_prod [comm_monoid M] {a} {l : list M} (ha : a ∈ l) : a ∣ l.prod := -let ⟨s, t, h⟩ := mem_split ha in -by { rw [h, prod_append, prod_cons, mul_left_comm], exact dvd_mul_right _ _ } - -@[simp] lemma sum_const_nat (m n : ℕ) : sum (list.repeat m n) = m * n := -by induction n; [refl, simp only [*, repeat_succ, sum_cons, nat.mul_succ, add_comm]] - -lemma dvd_sum [semiring R] {a} {l : list R} (h : ∀ x ∈ l, a ∣ x) : a ∣ l.sum := -begin - induction l with x l ih, - { exact dvd_zero _ }, - { rw [list.sum_cons], - exact dvd_add (h _ (mem_cons_self _ _)) (ih (λ x hx, h x (mem_cons_of_mem _ hx))) } -end - -/-- The product of a list of positive natural numbers is positive, -and likewise for any nontrivial ordered semiring. -/ -lemma prod_pos [ordered_semiring R] [nontrivial R] (l : list R) (h : ∀ a ∈ l, (0 : R) < a) : - 0 < l.prod := -begin - induction l with a l ih, - { simp }, - { rw prod_cons, - exact mul_pos (h _ $ mem_cons_self _ _) (ih $ λ a ha, h a $ mem_cons_of_mem _ ha) } -end - -/-! -Several lemmas about sum/head/tail for `list ℕ`. -These are hard to generalize well, as they rely on the fact that `default ℕ = 0`. -If desired, we could add a class stating that `default = 0`. --/ - -/-- This relies on `default ℕ = 0`. -/ -lemma head_add_tail_sum (L : list ℕ) : L.head + L.tail.sum = L.sum := -by { cases L, { simp, refl }, { simp } } - -/-- This relies on `default ℕ = 0`. -/ -lemma head_le_sum (L : list ℕ) : L.head ≤ L.sum := nat.le.intro (head_add_tail_sum L) - -/-- This relies on `default ℕ = 0`. -/ -lemma tail_sum (L : list ℕ) : L.tail.sum = L.sum - L.head := -by rw [← head_add_tail_sum L, add_comm, add_tsub_cancel_right] - -section alternating -section -variables [has_one α] [has_mul α] [has_inv α] - -@[simp, to_additive] lemma alternating_prod_nil : alternating_prod ([] : list α) = 1 := rfl -@[simp, to_additive] lemma alternating_prod_singleton (a : α) : alternating_prod [a] = a := rfl - -@[to_additive] lemma alternating_prod_cons_cons' (a b : α) (l : list α) : - alternating_prod (a :: b :: l) = a * b⁻¹ * alternating_prod l := rfl - -end - -@[to_additive] lemma alternating_prod_cons_cons [div_inv_monoid α] (a b : α) (l : list α) : - alternating_prod (a :: b :: l) = a / b * alternating_prod l := -by rw [div_eq_mul_inv, alternating_prod_cons_cons'] - -variables [comm_group α] - -@[to_additive] lemma alternating_prod_cons' : - ∀ (a : α) (l : list α), alternating_prod (a :: l) = a * (alternating_prod l)⁻¹ -| a [] := by rw [alternating_prod_nil, one_inv, mul_one, alternating_prod_singleton] -| a (b :: l) := -by rw [alternating_prod_cons_cons', alternating_prod_cons' b l, mul_inv, inv_inv, mul_assoc] - -@[simp, to_additive] lemma alternating_prod_cons (a : α) (l : list α) : - alternating_prod (a :: l) = a / alternating_prod l := -by rw [div_eq_mul_inv, alternating_prod_cons'] - -@[to_additive] -lemma alternating_prod_append : ∀ l₁ l₂ : list α, - alternating_prod (l₁ ++ l₂) = alternating_prod l₁ * alternating_prod l₂ ^ (-1 : ℤ) ^ length l₁ -| [] l₂ := by simp -| (a :: l₁) l₂ := by simp_rw [cons_append, alternating_prod_cons, alternating_prod_append, - length_cons, pow_succ, neg_mul, one_mul, zpow_neg, ←div_eq_mul_inv, div_div] - -@[to_additive] -lemma alternating_prod_reverse : - ∀ l : list α, alternating_prod (reverse l) = alternating_prod l ^ (-1 : ℤ) ^ (length l + 1) -| [] := by simp only [alternating_prod_nil, one_zpow, reverse_nil] -| (a :: l) := -begin - simp_rw [reverse_cons, alternating_prod_append, alternating_prod_reverse, - alternating_prod_singleton, alternating_prod_cons, length_reverse, length, pow_succ, neg_mul, - one_mul, zpow_neg, inv_inv], - rw [mul_comm, ←div_eq_mul_inv, div_zpow], -end - -end alternating - -lemma sum_map_mul_left [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) : - (L.map (λ b, r * f b)).sum = r * (L.map f).sum := -sum_map_hom L f $ add_monoid_hom.mul_left r - -lemma sum_map_mul_right [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) : - (L.map (λ b, f b * r)).sum = (L.map f).sum * r := -sum_map_hom L f $ add_monoid_hom.mul_right r - -end list - -namespace mul_opposite - -open list -variables [monoid M] - -lemma op_list_prod : ∀ (l : list M), op (l.prod) = (l.map op).reverse.prod -| [] := rfl -| (x :: xs) := by rw [list.prod_cons, list.map_cons, list.reverse_cons', list.prod_concat, op_mul, - op_list_prod] - -lemma _root_.mul_opposite.unop_list_prod (l : list Mᵐᵒᵖ) : - (l.prod).unop = (l.map unop).reverse.prod := -by rw [← op_inj, op_unop, mul_opposite.op_list_prod, map_reverse, map_map, reverse_reverse, - op_comp_unop, map_id] - -end mul_opposite - -section monoid_hom - -variables [monoid M] [monoid N] - -@[to_additive] -lemma map_list_prod {F : Type*} [monoid_hom_class F M N] (f : F) - (l : list M) : f l.prod = (l.map f).prod := -(l.prod_hom f).symm - -/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. -/ -lemma unop_map_list_prod {F : Type*} [monoid_hom_class F M Nᵐᵒᵖ] (f : F) (l : list M) : - (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod := -by rw [map_list_prod f l, mul_opposite.unop_list_prod, list.map_map] - -namespace monoid_hom - -/-- Deprecated, use `_root_.map_list_prod` instead. -/ -@[to_additive "Deprecated, use `_root_.map_list_sum` instead."] -protected lemma map_list_prod (f : M →* N) (l : list M) : - f l.prod = (l.map f).prod := -map_list_prod f l - -/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. - -Deprecated, use `_root_.unop_map_list_prod` instead. -/ -protected lemma unop_map_list_prod (f : M →* Nᵐᵒᵖ) (l : list M) : - (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod := -unop_map_list_prod f l - -end monoid_hom - -end monoid_hom diff --git a/src/data/list/big_operators/basic.lean b/src/data/list/big_operators/basic.lean new file mode 100644 index 0000000000000..4e6925515baf0 --- /dev/null +++ b/src/data/list/big_operators/basic.lean @@ -0,0 +1,580 @@ +/- +Copyright (c) 2017 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best +-/ +import data.int.order.basic +import data.list.forall2 + +/-! +# Sums and products from lists + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides basic results about `list.prod`, `list.sum`, which calculate the product and sum +of elements of a list and `list.alternating_prod`, `list.alternating_sum`, their alternating +counterparts. These are defined in [`data.list.defs`](./defs). +-/ + +variables {ι α M N P M₀ G R : Type*} + +namespace list +section monoid +variables [monoid M] [monoid N] [monoid P] {l l₁ l₂ : list M} {a : M} + +@[simp, to_additive] +lemma prod_nil : ([] : list M).prod = 1 := rfl + +@[to_additive] +lemma prod_singleton : [a].prod = a := one_mul a + +@[simp, to_additive] +lemma prod_cons : (a :: l).prod = a * l.prod := +calc (a :: l).prod = foldl (*) (a * 1) l : by simp only [list.prod, foldl_cons, one_mul, mul_one] + ... = _ : foldl_assoc + +@[simp, to_additive] +lemma prod_append : (l₁ ++ l₂).prod = l₁.prod * l₂.prod := +calc (l₁ ++ l₂).prod = foldl (*) (foldl (*) 1 l₁ * 1) l₂ : by simp [list.prod] + ... = l₁.prod * l₂.prod : foldl_assoc + +@[to_additive] +lemma prod_concat : (l.concat a).prod = l.prod * a := +by rw [concat_eq_append, prod_append, prod_singleton] + +@[simp, to_additive] +lemma prod_join {l : list (list M)} : l.join.prod = (l.map list.prod).prod := +by induction l; [refl, simp only [*, list.join, map, prod_append, prod_cons]] + +@[to_additive] +lemma prod_eq_foldr : l.prod = foldr (*) 1 l := +list.rec_on l rfl $ λ a l ihl, by rw [prod_cons, foldr_cons, ihl] + +@[simp, priority 500, to_additive] +theorem prod_replicate (n : ℕ) (a : M) : (replicate n a).prod = a ^ n := +begin + induction n with n ih, + { rw pow_zero, refl }, + { rw [list.replicate_succ, list.prod_cons, ih, pow_succ] } +end + +@[to_additive sum_eq_card_nsmul] +lemma prod_eq_pow_card (l : list M) (m : M) (h : ∀ (x ∈ l), x = m) : + l.prod = m ^ l.length := +by rw [← prod_replicate, ← eq_replicate_length.2 h] + +@[to_additive] +lemma prod_hom_rel (l : list ι) {r : M → N → Prop} {f : ι → M} {g : ι → N} (h₁ : r 1 1) + (h₂ : ∀ ⦃i a b⦄, r a b → r (f i * a) (g i * b)) : + r (l.map f).prod (l.map g).prod := +list.rec_on l h₁ (λ a l hl, by simp only [map_cons, prod_cons, h₂ hl]) + +@[to_additive] +lemma prod_hom (l : list M) {F : Type*} [monoid_hom_class F M N] (f : F) : + (l.map f).prod = f l.prod := +by { simp only [prod, foldl_map, ← map_one f], + exact l.foldl_hom _ _ _ 1 (map_mul f) } + +@[to_additive] +lemma prod_hom₂ (l : list ι) (f : M → N → P) + (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → M) (f₂ : ι → N) : + (l.map $ λ i, f (f₁ i) (f₂ i)).prod = f (l.map f₁).prod (l.map f₂).prod := +begin + simp only [prod, foldl_map], + convert l.foldl_hom₂ (λ a b, f a b) _ _ _ _ _ (λ a b i, _), + { exact hf'.symm }, + { exact hf _ _ _ _ } +end + +@[simp, to_additive] +lemma prod_map_mul {α : Type*} [comm_monoid α] {l : list ι} {f g : ι → α} : + (l.map $ λ i, f i * g i).prod = (l.map f).prod * (l.map g).prod := +l.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _ + +@[simp] +lemma prod_map_neg {α} [comm_monoid α] [has_distrib_neg α] (l : list α) : + (l.map has_neg.neg).prod = (-1) ^ l.length * l.prod := +by simpa only [id, neg_mul, one_mul, map_const', prod_replicate, map_id] + using @prod_map_mul α α _ l (λ _, -1) id + +@[to_additive] +lemma prod_map_hom (L : list ι) (f : ι → M) {G : Type*} [monoid_hom_class G M N] (g : G) : + (L.map (g ∘ f)).prod = g ((L.map f).prod) := +by rw [← prod_hom, map_map] + +@[to_additive] +lemma prod_is_unit : Π {L : list M} (u : ∀ m ∈ L, is_unit m), is_unit L.prod +| [] _ := by simp +| (h :: t) u := +begin + simp only [list.prod_cons], + exact is_unit.mul (u h (mem_cons_self h t)) (prod_is_unit (λ m mt, u m (mem_cons_of_mem h mt))) +end + +@[to_additive] +lemma prod_is_unit_iff {α : Type*} [comm_monoid α] {L : list α} : + is_unit L.prod ↔ ∀ m ∈ L, is_unit m := +begin + refine ⟨λ h, _, prod_is_unit⟩, + induction L with m L ih, + { exact λ m' h', false.elim (not_mem_nil m' h'), }, + rw [prod_cons, is_unit.mul_iff] at h, + exact λ m' h', or.elim (eq_or_mem_of_mem_cons h') (λ H, H.substr h.1) (λ H, ih h.2 _ H), +end + +@[simp, to_additive] +lemma prod_take_mul_prod_drop : + ∀ (L : list M) (i : ℕ), (L.take i).prod * (L.drop i).prod = L.prod +| [] i := by simp [nat.zero_le] +| L 0 := by simp +| (h :: t) (n+1) := by { dsimp, rw [prod_cons, prod_cons, mul_assoc, prod_take_mul_prod_drop] } + +@[simp, to_additive] +lemma prod_take_succ : + ∀ (L : list M) (i : ℕ) (p), (L.take (i + 1)).prod = (L.take i).prod * L.nth_le i p +| [] i p := by cases p +| (h :: t) 0 _ := by simp +| (h :: t) (n+1) _ := by { dsimp, rw [prod_cons, prod_cons, prod_take_succ, mul_assoc] } + +/-- A list with product not one must have positive length. -/ +@[to_additive "A list with sum not zero must have positive length."] +lemma length_pos_of_prod_ne_one (L : list M) (h : L.prod ≠ 1) : 0 < L.length := +by { cases L, { contrapose h, simp }, { simp } } + +/-- A list with product greater than one must have positive length. -/ +@[to_additive length_pos_of_sum_pos "A list with positive sum must have positive length."] +lemma length_pos_of_one_lt_prod [preorder M] (L : list M) (h : 1 < L.prod) : + 0 < L.length := +length_pos_of_prod_ne_one L h.ne' + +/-- A list with product less than one must have positive length. -/ +@[to_additive "A list with negative sum must have positive length."] +lemma length_pos_of_prod_lt_one [preorder M] (L : list M) (h : L.prod < 1) : + 0 < L.length := +length_pos_of_prod_ne_one L h.ne + +@[to_additive] +lemma prod_update_nth : ∀ (L : list M) (n : ℕ) (a : M), + (L.update_nth n a).prod = + (L.take n).prod * (if n < L.length then a else 1) * (L.drop (n + 1)).prod +| (x :: xs) 0 a := by simp [update_nth] +| (x :: xs) (i+1) a := by simp [update_nth, prod_update_nth xs i a, mul_assoc] +| [] _ _ := by simp [update_nth, (nat.zero_le _).not_lt, nat.zero_le] + +open mul_opposite + +/-- We'd like to state this as `L.head * L.tail.prod = L.prod`, but because `L.head` relies on an +inhabited instance to return a garbage value on the empty list, this is not possible. +Instead, we write the statement in terms of `(L.nth 0).get_or_else 1`. +-/ +@[to_additive "We'd like to state this as `L.head + L.tail.sum = L.sum`, but because `L.head` +relies on an inhabited instance to return a garbage value on the empty list, this is not possible. +Instead, we write the statement in terms of `(L.nth 0).get_or_else 0`."] +lemma nth_zero_mul_tail_prod (l : list M) : (l.nth 0).get_or_else 1 * l.tail.prod = l.prod := +by cases l; simp + +/-- Same as `nth_zero_mul_tail_prod`, but avoiding the `list.head` garbage complication by requiring +the list to be nonempty. -/ +@[to_additive "Same as `nth_zero_add_tail_sum`, but avoiding the `list.head` garbage complication +by requiring the list to be nonempty."] +lemma head_mul_tail_prod_of_ne_nil [inhabited M] (l : list M) (h : l ≠ []) : + l.head * l.tail.prod = l.prod := +by cases l; [contradiction, simp] + +@[to_additive] +lemma _root_.commute.list_prod_right (l : list M) (y : M) (h : ∀ (x ∈ l), commute y x) : + commute y l.prod := +begin + induction l with z l IH, + { simp }, + { rw list.ball_cons at h, + rw list.prod_cons, + exact commute.mul_right h.1 (IH h.2), } +end + +@[to_additive] +lemma _root_.commute.list_prod_left (l : list M) (y : M) (h : ∀ (x ∈ l), commute x y) : + commute l.prod y := +(commute.list_prod_right _ _ $ λ x hx, (h _ hx).symm).symm + +@[to_additive sum_le_sum] lemma forall₂.prod_le_prod' [preorder M] + [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] + {l₁ l₂ : list M} (h : forall₂ (≤) l₁ l₂) : l₁.prod ≤ l₂.prod := +begin + induction h with a b la lb hab ih ih', + { refl }, + { simpa only [prod_cons] using mul_le_mul' hab ih' } +end + +/-- If `l₁` is a sublist of `l₂` and all elements of `l₂` are greater than or equal to one, then +`l₁.prod ≤ l₂.prod`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 1 ≤ a` instead +of `∀ a ∈ l₂, 1 ≤ a` but this lemma is not yet in `mathlib`. -/ +@[to_additive sum_le_sum "If `l₁` is a sublist of `l₂` and all elements of `l₂` are nonnegative, +then `l₁.sum ≤ l₂.sum`. One can prove a stronger version assuming `∀ a ∈ l₂.diff l₁, 0 ≤ a` instead +of `∀ a ∈ l₂, 0 ≤ a` but this lemma is not yet in `mathlib`."] +lemma sublist.prod_le_prod' [preorder M] [covariant_class M M (function.swap (*)) (≤)] + [covariant_class M M (*) (≤)] {l₁ l₂ : list M} (h : l₁ <+ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) : + l₁.prod ≤ l₂.prod := +begin + induction h, { refl }, + case cons : l₁ l₂ a ih ih' + { simp only [prod_cons, forall_mem_cons] at h₁ ⊢, + exact (ih' h₁.2).trans (le_mul_of_one_le_left' h₁.1) }, + case cons2 : l₁ l₂ a ih ih' + { simp only [prod_cons, forall_mem_cons] at h₁ ⊢, + exact mul_le_mul_left' (ih' h₁.2) _ } +end + +@[to_additive sum_le_sum] lemma sublist_forall₂.prod_le_prod' [preorder M] + [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] + {l₁ l₂ : list M} (h : sublist_forall₂ (≤) l₁ l₂) (h₁ : ∀ a ∈ l₂, (1 : M) ≤ a) : + l₁.prod ≤ l₂.prod := +let ⟨l, hall, hsub⟩ := sublist_forall₂_iff.1 h +in hall.prod_le_prod'.trans $ hsub.prod_le_prod' h₁ + +@[to_additive sum_le_sum] lemma prod_le_prod' [preorder M] + [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] + {l : list ι} {f g : ι → M} (h : ∀ i ∈ l, f i ≤ g i) : + (l.map f).prod ≤ (l.map g).prod := +forall₂.prod_le_prod' $ by simpa + +@[to_additive sum_lt_sum] lemma prod_lt_prod' + [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)] + [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)] + {l : list ι} (f g : ι → M) (h₁ : ∀ i ∈ l, f i ≤ g i) (h₂ : ∃ i ∈ l, f i < g i) : + (l.map f).prod < (l.map g).prod := +begin + induction l with i l ihl, { rcases h₂ with ⟨_, ⟨⟩, _⟩ }, + simp only [ball_cons, bex_cons, map_cons, prod_cons] at h₁ h₂ ⊢, + cases h₂, + exacts [mul_lt_mul_of_lt_of_le h₂ (prod_le_prod' h₁.2), + mul_lt_mul_of_le_of_lt h₁.1 $ ihl h₁.2 h₂] +end + +@[to_additive] lemma prod_lt_prod_of_ne_nil + [preorder M] [covariant_class M M (*) (<)] [covariant_class M M (*) (≤)] + [covariant_class M M (function.swap (*)) (<)] [covariant_class M M (function.swap (*)) (≤)] + {l : list ι} (hl : l ≠ []) (f g : ι → M) (hlt : ∀ i ∈ l, f i < g i) : + (l.map f).prod < (l.map g).prod := +prod_lt_prod' f g (λ i hi, (hlt i hi).le) $ (exists_mem_of_ne_nil l hl).imp $ λ i hi, ⟨hi, hlt i hi⟩ + +@[to_additive sum_le_card_nsmul] +lemma prod_le_pow_card [preorder M] + [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] + (l : list M) (n : M) (h : ∀ (x ∈ l), x ≤ n) : + l.prod ≤ n ^ l.length := +by simpa only [map_id'', map_const, prod_replicate] using prod_le_prod' h + +@[to_additive exists_lt_of_sum_lt] lemma exists_lt_of_prod_lt' [linear_order M] + [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] {l : list ι} + (f g : ι → M) (h : (l.map f).prod < (l.map g).prod) : + ∃ i ∈ l, f i < g i := +by { contrapose! h, exact prod_le_prod' h } + +@[to_additive exists_le_of_sum_le] +lemma exists_le_of_prod_le' [linear_order M] [covariant_class M M (*) (<)] + [covariant_class M M (*) (≤)] [covariant_class M M (function.swap (*)) (<)] + [covariant_class M M (function.swap (*)) (≤)] {l : list ι} (hl : l ≠ []) + (f g : ι → M) (h : (l.map f).prod ≤ (l.map g).prod) : + ∃ x ∈ l, f x ≤ g x := +by { contrapose! h, exact prod_lt_prod_of_ne_nil hl _ _ h } + +@[to_additive sum_nonneg] +lemma one_le_prod_of_one_le [preorder M] [covariant_class M M (*) (≤)] {l : list M} + (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) : + 1 ≤ l.prod := +begin + -- We don't use `pow_card_le_prod` to avoid assumption + -- [covariant_class M M (function.swap (*)) (≤)] + induction l with hd tl ih, { refl }, + rw prod_cons, + exact one_le_mul (hl₁ hd (mem_cons_self hd tl)) (ih (λ x h, hl₁ x (mem_cons_of_mem hd h))) +end + +end monoid + +section monoid_with_zero + +variables [monoid_with_zero M₀] + +/-- If zero is an element of a list `L`, then `list.prod L = 0`. If the domain is a nontrivial +monoid with zero with no divisors, then this implication becomes an `iff`, see +`list.prod_eq_zero_iff`. -/ +lemma prod_eq_zero {L : list M₀} (h : (0 : M₀) ∈ L) : L.prod = 0 := +begin + induction L with a L ihL, + { exact absurd h (not_mem_nil _) }, + { rw prod_cons, + cases (mem_cons_iff _ _ _).1 h with ha hL, + exacts [mul_eq_zero_of_left ha.symm _, mul_eq_zero_of_right _ (ihL hL)] } +end + +/-- Product of elements of a list `L` equals zero if and only if `0 ∈ L`. See also +`list.prod_eq_zero` for an implication that needs weaker typeclass assumptions. -/ +@[simp] lemma prod_eq_zero_iff [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} : + L.prod = 0 ↔ (0 : M₀) ∈ L := +begin + induction L with a L ihL, + { simp }, + { rw [prod_cons, mul_eq_zero, ihL, mem_cons_iff, eq_comm] } +end + +lemma prod_ne_zero [nontrivial M₀] [no_zero_divisors M₀] {L : list M₀} (hL : (0 : M₀) ∉ L) : + L.prod ≠ 0 := +mt prod_eq_zero_iff.1 hL + +end monoid_with_zero + +section group +variables [group G] + +/-- This is the `list.prod` version of `mul_inv_rev` -/ +@[to_additive "This is the `list.sum` version of `add_neg_rev`"] +lemma prod_inv_reverse : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).reverse.prod +| [] := by simp +| (x :: xs) := by simp [prod_inv_reverse xs] + +/-- A non-commutative variant of `list.prod_reverse` -/ +@[to_additive "A non-commutative variant of `list.sum_reverse`"] +lemma prod_reverse_noncomm : ∀ (L : list G), L.reverse.prod = (L.map (λ x, x⁻¹)).prod⁻¹ := +by simp [prod_inv_reverse] + +/-- Counterpart to `list.prod_take_succ` when we have an inverse operation -/ +@[simp, to_additive /-"Counterpart to `list.sum_take_succ` when we have an negation operation"-/] +lemma prod_drop_succ : + ∀ (L : list G) (i : ℕ) (p), (L.drop (i + 1)).prod = (L.nth_le i p)⁻¹ * (L.drop i).prod +| [] i p := false.elim (nat.not_lt_zero _ p) +| (x :: xs) 0 p := by simp +| (x :: xs) (i + 1) p := prod_drop_succ xs i _ + +end group + +section comm_group +variables [comm_group G] + +/-- This is the `list.prod` version of `mul_inv` -/ +@[to_additive "This is the `list.sum` version of `add_neg`"] +lemma prod_inv : ∀ (L : list G), L.prod⁻¹ = (L.map (λ x, x⁻¹)).prod +| [] := by simp +| (x :: xs) := by simp [mul_comm, prod_inv xs] + +/-- Alternative version of `list.prod_update_nth` when the list is over a group -/ +@[to_additive /-"Alternative version of `list.sum_update_nth` when the list is over a group"-/] +lemma prod_update_nth' (L : list G) (n : ℕ) (a : G) : + (L.update_nth n a).prod = + L.prod * (if hn : n < L.length then (L.nth_le n hn)⁻¹ * a else 1) := +begin + refine (prod_update_nth L n a).trans _, + split_ifs with hn hn, + { rw [mul_comm _ a, mul_assoc a, prod_drop_succ L n hn, mul_comm _ (drop n L).prod, + ← mul_assoc (take n L).prod, prod_take_mul_prod_drop, mul_comm a, mul_assoc] }, + { simp only [take_all_of_le (le_of_not_lt hn), prod_nil, mul_one, + drop_eq_nil_of_le ((le_of_not_lt hn).trans n.le_succ)] } +end + +end comm_group + +@[to_additive] +lemma eq_of_prod_take_eq [left_cancel_monoid M] {L L' : list M} (h : L.length = L'.length) + (h' : ∀ i ≤ L.length, (L.take i).prod = (L'.take i).prod) : L = L' := +begin + apply ext_le h (λ i h₁ h₂, _), + have : (L.take (i + 1)).prod = (L'.take (i + 1)).prod := h' _ (nat.succ_le_of_lt h₁), + rw [prod_take_succ L i h₁, prod_take_succ L' i h₂, h' i (le_of_lt h₁)] at this, + convert mul_left_cancel this +end + +@[to_additive] +lemma monotone_prod_take [canonically_ordered_monoid M] (L : list M) : + monotone (λ i, (L.take i).prod) := +begin + apply monotone_nat_of_le_succ (λ n, _), + cases lt_or_le n L.length with h h, + { rw prod_take_succ _ _ h, + exact le_self_mul }, + { simp [take_all_of_le h, take_all_of_le (le_trans h (nat.le_succ _))] } +end + +@[to_additive sum_pos] +lemma one_lt_prod_of_one_lt [ordered_comm_monoid M] : + ∀ (l : list M) (hl : ∀ x ∈ l, (1 : M) < x) (hl₂ : l ≠ []), 1 < l.prod +| [] _ h := (h rfl).elim +| [b] h _ := by simpa using h +| (a :: b :: l) hl₁ hl₂ := +begin + simp only [forall_eq_or_imp, list.mem_cons_iff _ a] at hl₁, + rw list.prod_cons, + apply one_lt_mul_of_lt_of_le' hl₁.1, + apply le_of_lt ((b :: l).one_lt_prod_of_one_lt hl₁.2 (l.cons_ne_nil b)), +end + +@[to_additive] +lemma single_le_prod [ordered_comm_monoid M] {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) : + ∀ x ∈ l, x ≤ l.prod := +begin + induction l, + { simp }, + simp_rw [prod_cons, forall_mem_cons] at ⊢ hl₁, + split, + { exact le_mul_of_one_le_right' (one_le_prod_of_one_le hl₁.2) }, + { exact λ x H, le_mul_of_one_le_of_le hl₁.1 (l_ih hl₁.right x H) }, +end + +@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero] +lemma all_one_of_le_one_le_of_prod_eq_one [ordered_comm_monoid M] + {l : list M} (hl₁ : ∀ x ∈ l, (1 : M) ≤ x) (hl₂ : l.prod = 1) {x : M} (hx : x ∈ l) : + x = 1 := +le_antisymm (hl₂ ▸ single_le_prod hl₁ _ hx) (hl₁ x hx) + +/-- Slightly more general version of `list.prod_eq_one_iff` for a non-ordered `monoid` -/ +@[to_additive "Slightly more general version of `list.sum_eq_zero_iff` + for a non-ordered `add_monoid`"] +lemma prod_eq_one [monoid M] {l : list M} (hl : ∀ (x ∈ l), x = (1 : M)) : l.prod = 1 := +begin + induction l with i l hil, + { refl }, + rw [list.prod_cons, hil (λ x hx, hl _ (mem_cons_of_mem i hx)), hl _ (mem_cons_self i l), one_mul] +end + +@[to_additive] +lemma exists_mem_ne_one_of_prod_ne_one [monoid M] {l : list M} (h : l.prod ≠ 1) : + ∃ (x ∈ l), x ≠ (1 : M) := +by simpa only [not_forall] using mt prod_eq_one h + +-- TODO: develop theory of tropical rings +lemma sum_le_foldr_max [add_monoid M] [add_monoid N] [linear_order N] (f : M → N) + (h0 : f 0 ≤ 0) (hadd : ∀ x y, f (x + y) ≤ max (f x) (f y)) (l : list M) : + f l.sum ≤ (l.map f).foldr max 0 := +begin + induction l with hd tl IH, + { simpa using h0 }, + simp only [list.sum_cons, list.foldr_map, list.foldr] at IH ⊢, + exact (hadd _ _).trans (max_le_max le_rfl IH) +end + +@[simp, to_additive] +lemma prod_erase [decidable_eq M] [comm_monoid M] {a} : + ∀ {l : list M}, a ∈ l → a * (l.erase a).prod = l.prod +| (b :: l) h := + begin + obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h, + { simp only [list.erase, if_pos, prod_cons] }, + { simp only [list.erase, if_neg (mt eq.symm ne), prod_cons, prod_erase h, mul_left_comm a b] } + end + +@[simp, to_additive] +lemma prod_map_erase [decidable_eq ι] [comm_monoid M] (f : ι → M) {a} : + ∀ {l : list ι}, a ∈ l → f a * ((l.erase a).map f).prod = (l.map f).prod +| (b :: l) h := + begin + obtain rfl | ⟨ne, h⟩ := decidable.list.eq_or_ne_mem_of_mem h, + { simp only [map, erase_cons_head, prod_cons] }, + { simp only [map, erase_cons_tail _ ne.symm, prod_cons, prod_map_erase h, + mul_left_comm (f a) (f b)], } + end + +lemma sum_const_nat (m n : ℕ) : sum (replicate m n) = m * n := +by rw [sum_replicate, smul_eq_mul] + +/-- The product of a list of positive natural numbers is positive, +and likewise for any nontrivial ordered semiring. -/ +lemma prod_pos [strict_ordered_semiring R] (l : list R) (h : ∀ a ∈ l, (0 : R) < a) : 0 < l.prod := +begin + induction l with a l ih, + { simp }, + { rw prod_cons, + exact mul_pos (h _ $ mem_cons_self _ _) (ih $ λ a ha, h a $ mem_cons_of_mem _ ha) } +end + +/-- A variant of `list.prod_pos` for `canonically_ordered_comm_semiring`. -/ +@[simp] +lemma _root_.canonically_ordered_comm_semiring.list_prod_pos + {α : Type*} [canonically_ordered_comm_semiring α] [nontrivial α] : + Π {l : list α}, 0 < l.prod ↔ (∀ x ∈ l, (0 : α) < x) +| [] := ⟨λ h x hx, hx.elim, λ _, zero_lt_one⟩ +| (x :: xs) := by simp_rw [prod_cons, mem_cons_iff, forall_eq_or_imp, + canonically_ordered_comm_semiring.mul_pos, + _root_.canonically_ordered_comm_semiring.list_prod_pos] + +/-! +Several lemmas about sum/head/tail for `list ℕ`. +These are hard to generalize well, as they rely on the fact that `default ℕ = 0`. +If desired, we could add a class stating that `default = 0`. +-/ + +/-- This relies on `default ℕ = 0`. -/ +lemma head_add_tail_sum (L : list ℕ) : L.head + L.tail.sum = L.sum := +by { cases L, { simp, refl }, { simp } } + +/-- This relies on `default ℕ = 0`. -/ +lemma head_le_sum (L : list ℕ) : L.head ≤ L.sum := nat.le.intro (head_add_tail_sum L) + +/-- This relies on `default ℕ = 0`. -/ +lemma tail_sum (L : list ℕ) : L.tail.sum = L.sum - L.head := +by rw [← head_add_tail_sum L, add_comm, add_tsub_cancel_right] + +section alternating +section +variables [has_one α] [has_mul α] [has_inv α] + +@[simp, to_additive] lemma alternating_prod_nil : alternating_prod ([] : list α) = 1 := rfl +@[simp, to_additive] lemma alternating_prod_singleton (a : α) : alternating_prod [a] = a := rfl + +@[to_additive] lemma alternating_prod_cons_cons' (a b : α) (l : list α) : + alternating_prod (a :: b :: l) = a * b⁻¹ * alternating_prod l := rfl + +end + +@[to_additive] lemma alternating_prod_cons_cons [div_inv_monoid α] (a b : α) (l : list α) : + alternating_prod (a :: b :: l) = a / b * alternating_prod l := +by rw [div_eq_mul_inv, alternating_prod_cons_cons'] + +variables [comm_group α] + +@[to_additive] lemma alternating_prod_cons' : + ∀ (a : α) (l : list α), alternating_prod (a :: l) = a * (alternating_prod l)⁻¹ +| a [] := by rw [alternating_prod_nil, inv_one, mul_one, alternating_prod_singleton] +| a (b :: l) := +by rw [alternating_prod_cons_cons', alternating_prod_cons' b l, mul_inv, inv_inv, mul_assoc] + +@[simp, to_additive] lemma alternating_prod_cons (a : α) (l : list α) : + alternating_prod (a :: l) = a / alternating_prod l := +by rw [div_eq_mul_inv, alternating_prod_cons'] + +end alternating + +lemma sum_nat_mod (l : list ℕ) (n : ℕ) : l.sum % n = (l.map (% n)).sum % n := +by induction l; simp [nat.add_mod, *] + +lemma prod_nat_mod (l : list ℕ) (n : ℕ) : l.prod % n = (l.map (% n)).prod % n := +by induction l; simp [nat.mul_mod, *] + +lemma sum_int_mod (l : list ℤ) (n : ℤ) : l.sum % n = (l.map (% n)).sum % n := +by induction l; simp [int.add_mod, *] + +lemma prod_int_mod (l : list ℤ) (n : ℤ) : l.prod % n = (l.map (% n)).prod % n := +by induction l; simp [int.mul_mod, *] + +end list + +section monoid_hom + +variables [monoid M] [monoid N] + +@[to_additive] +lemma map_list_prod {F : Type*} [monoid_hom_class F M N] (f : F) + (l : list M) : f l.prod = (l.map f).prod := +(l.prod_hom f).symm + +namespace monoid_hom + +/-- Deprecated, use `_root_.map_list_prod` instead. -/ +@[to_additive "Deprecated, use `_root_.map_list_sum` instead."] +protected lemma map_list_prod (f : M →* N) (l : list M) : + f l.prod = (l.map f).prod := +map_list_prod f l + +end monoid_hom + +end monoid_hom diff --git a/src/data/list/big_operators/lemmas.lean b/src/data/list/big_operators/lemmas.lean new file mode 100644 index 0000000000000..5cb2b62d1593f --- /dev/null +++ b/src/data/list/big_operators/lemmas.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2017 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl, Floris van Doorn, Sébastien Gouëzel, Alex J. Best +-/ +import data.list.big_operators.basic +import algebra.group.opposite +import algebra.group_power.basic +import algebra.group_with_zero.commute +import algebra.group_with_zero.divisibility +import algebra.order.with_zero +import algebra.ring.basic +import algebra.ring.divisibility +import algebra.ring.commute +import data.int.units +import data.set.basic + +/-! # Lemmas about `list.sum` and `list.prod` requiring extra algebra imports + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +open mul_opposite list + +variables {ι α M N P M₀ G R : Type*} + +namespace commute + +lemma list_sum_right [non_unital_non_assoc_semiring R] (a : R) (l : list R) + (h : ∀ b ∈ l, commute a b) : + commute a l.sum := +begin + induction l with x xs ih, + { exact commute.zero_right _, }, + { rw list.sum_cons, + exact (h _ $ mem_cons_self _ _).add_right (ih $ λ j hj, h _ $ mem_cons_of_mem _ hj) } +end + +lemma list_sum_left [non_unital_non_assoc_semiring R] (b : R) (l : list R) + (h : ∀ a ∈ l, commute a b) : + commute l.sum b := +(commute.list_sum_right _ _ $ λ x hx, (h _ hx).symm).symm + +end commute + +namespace list + +@[to_additive card_nsmul_le_sum] +lemma pow_card_le_prod [monoid M] [preorder M] + [covariant_class M M (function.swap (*)) (≤)] [covariant_class M M (*) (≤)] + (l : list M) (n : M) (h : ∀ (x ∈ l), n ≤ x) : + n ^ l.length ≤ l.prod := +@prod_le_pow_card Mᵒᵈ _ _ _ _ l n h + +@[to_additive] lemma prod_eq_one_iff [canonically_ordered_monoid M] (l : list M) : + l.prod = 1 ↔ ∀ x ∈ l, x = (1 : M) := +⟨all_one_of_le_one_le_of_prod_eq_one (λ _ _, one_le _), + λ h, by rw [eq_replicate.2 ⟨rfl, h⟩, prod_replicate, one_pow]⟩ + +/-- If a product of integers is `-1`, then at least one factor must be `-1`. -/ +lemma neg_one_mem_of_prod_eq_neg_one {l : list ℤ} (h : l.prod = -1) : (-1 : ℤ) ∈ l := +begin + obtain ⟨x, h₁, h₂⟩ := exists_mem_ne_one_of_prod_ne_one (ne_of_eq_of_ne h dec_trivial), + exact or.resolve_left (int.is_unit_iff.mp (prod_is_unit_iff.mp + (h.symm ▸ is_unit.neg is_unit_one : is_unit l.prod) x h₁)) h₂ ▸ h₁, +end + +/-- If all elements in a list are bounded below by `1`, then the length of the list is bounded +by the sum of the elements. -/ +lemma length_le_sum_of_one_le (L : list ℕ) (h : ∀ i ∈ L, 1 ≤ i) : L.length ≤ L.sum := +begin + induction L with j L IH h, { simp }, + rw [sum_cons, length, add_comm], + exact add_le_add (h _ (set.mem_insert _ _)) (IH (λ i hi, h i (set.mem_union_right _ hi))) +end + +lemma dvd_prod [comm_monoid M] {a} {l : list M} (ha : a ∈ l) : a ∣ l.prod := +let ⟨s, t, h⟩ := mem_split ha in +by { rw [h, prod_append, prod_cons, mul_left_comm], exact dvd_mul_right _ _ } + +lemma dvd_sum [semiring R] {a} {l : list R} (h : ∀ x ∈ l, a ∣ x) : a ∣ l.sum := +begin + induction l with x l ih, + { exact dvd_zero _ }, + { rw [list.sum_cons], + exact dvd_add (h _ (mem_cons_self _ _)) (ih (λ x hx, h x (mem_cons_of_mem _ hx))) } +end + +section alternating +variables [comm_group α] + +@[to_additive] +lemma alternating_prod_append : ∀ l₁ l₂ : list α, + alternating_prod (l₁ ++ l₂) = alternating_prod l₁ * alternating_prod l₂ ^ (-1 : ℤ) ^ length l₁ +| [] l₂ := by simp +| (a :: l₁) l₂ := by simp_rw [cons_append, alternating_prod_cons, alternating_prod_append, + length_cons, pow_succ, neg_mul, one_mul, zpow_neg, ←div_eq_mul_inv, div_div] + +@[to_additive] +lemma alternating_prod_reverse : + ∀ l : list α, alternating_prod (reverse l) = alternating_prod l ^ (-1 : ℤ) ^ (length l + 1) +| [] := by simp only [alternating_prod_nil, one_zpow, reverse_nil] +| (a :: l) := +begin + simp_rw [reverse_cons, alternating_prod_append, alternating_prod_reverse, + alternating_prod_singleton, alternating_prod_cons, length_reverse, length, pow_succ, neg_mul, + one_mul, zpow_neg, inv_inv], + rw [mul_comm, ←div_eq_mul_inv, div_zpow], +end + +end alternating + +lemma sum_map_mul_left [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) : + (L.map (λ b, r * f b)).sum = r * (L.map f).sum := +sum_map_hom L f $ add_monoid_hom.mul_left r + +lemma sum_map_mul_right [non_unital_non_assoc_semiring R] (L : list ι) (f : ι → R) (r : R) : + (L.map (λ b, f b * r)).sum = (L.map f).sum * r := +sum_map_hom L f $ add_monoid_hom.mul_right r + +end list + +namespace mul_opposite + +open list +variables [monoid M] + +lemma op_list_prod : ∀ (l : list M), op (l.prod) = (l.map op).reverse.prod +| [] := rfl +| (x :: xs) := by rw [list.prod_cons, list.map_cons, list.reverse_cons', list.prod_concat, op_mul, + op_list_prod] + +lemma _root_.mul_opposite.unop_list_prod (l : list Mᵐᵒᵖ) : + (l.prod).unop = (l.map unop).reverse.prod := +by rw [← op_inj, op_unop, mul_opposite.op_list_prod, map_reverse, map_map, reverse_reverse, + op_comp_unop, map_id] + +end mul_opposite + +section monoid_hom + +variables [monoid M] [monoid N] + +/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. -/ +lemma unop_map_list_prod {F : Type*} [monoid_hom_class F M Nᵐᵒᵖ] (f : F) (l : list M) : + (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod := +by rw [map_list_prod f l, mul_opposite.unop_list_prod, list.map_map] + +namespace monoid_hom + +/-- A morphism into the opposite monoid acts on the product by acting on the reversed elements. + +Deprecated, use `_root_.unop_map_list_prod` instead. -/ +protected lemma unop_map_list_prod (f : M →* Nᵐᵒᵖ) (l : list M) : + (f l.prod).unop = (l.map (mul_opposite.unop ∘ f)).reverse.prod := +unop_map_list_prod f l + +end monoid_hom +end monoid_hom diff --git a/src/data/list/chain.lean b/src/data/list/chain.lean index e676fc4b39dc1..5396aecfe3b4e 100644 --- a/src/data/list/chain.lean +++ b/src/data/list/chain.lean @@ -9,6 +9,9 @@ import logic.relation /-! # Relation chain +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides basic results about `list.chain` (definition in `data.list.defs`). A list `[a₂, ..., aₙ]` is a `chain` starting at `a₁` with respect to the relation `r` if `r a₁ a₂` and `r a₂ a₃` and ... and `r aₙ₋₁ aₙ`. We write it `chain r a₁ [a₂, ..., aₙ]`. @@ -68,6 +71,16 @@ simp only [*, nil_append, cons_append, chain.nil, chain_cons, and_true, and_asso chain R a (l₁ ++ b :: c :: l₂) ↔ chain R a (l₁ ++ [b]) ∧ R b c ∧ chain R c l₂ := by rw [chain_split, chain_cons] +theorem chain_iff_forall₂ : + ∀ {a : α} {l : list α}, chain R a l ↔ l = [] ∨ forall₂ R (a :: init l) l +| a [] := by simp +| a [b] := by simp [init] +| a (b :: c :: l) := by simp [@chain_iff_forall₂ b] + +theorem chain_append_singleton_iff_forall₂ : + chain R a (l ++ [b]) ↔ forall₂ R (a :: l) (l ++ [b]) := +by simp [chain_iff_forall₂, init] + theorem chain_map (f : β → α) {b : β} {l : list β} : chain R (f b) (map f l) ↔ chain (λ a b : β, R (f a) (f b)) b l := by induction l generalizing b; simp only [map, chain.nil, chain_cons, *] @@ -113,23 +126,23 @@ begin exact chain_cons.2 ⟨r.1, IH r'⟩ end -protected lemma chain.pairwise (tr : transitive R) : +protected lemma chain.pairwise [is_trans α R] : ∀ {a : α} {l : list α}, chain R a l → pairwise R (a :: l) | a [] chain.nil := pairwise_singleton _ _ | a _ (@chain.cons _ _ _ b l h hb) := hb.pairwise.cons begin simp only [mem_cons_iff, forall_eq_or_imp, h, true_and], - exact λ c hc, tr h (rel_of_pairwise_cons hb.pairwise hc), + exact λ c hc, trans h (rel_of_pairwise_cons hb.pairwise hc), end -theorem chain_iff_pairwise (tr : transitive R) {a : α} {l : list α} : +theorem chain_iff_pairwise [is_trans α R] {a : α} {l : list α} : chain R a l ↔ pairwise R (a :: l) := -⟨chain.pairwise tr, pairwise.chain⟩ +⟨chain.pairwise, pairwise.chain⟩ protected lemma chain.sublist [is_trans α R] (hl : l₂.chain R a) (h : l₁ <+ l₂) : l₁.chain R a := -by { rw chain_iff_pairwise (transitive_of_trans R) at ⊢ hl, exact hl.sublist (h.cons_cons a) } +by { rw chain_iff_pairwise at ⊢ hl, exact hl.sublist (h.cons_cons a) } protected lemma chain.rel [is_trans α R] (hl : l.chain R a) (hb : b ∈ l) : R a b := -by { rw chain_iff_pairwise (transitive_of_trans R) at hl, exact rel_of_pairwise_cons hl hb } +by { rw chain_iff_pairwise at hl, exact rel_of_pairwise_cons hl hb } theorem chain_iff_nth_le {R} : ∀ {a : α} {l : list α}, chain R a l ↔ (∀ h : 0 < length l, R a (nth_le l 0 h)) ∧ (∀ i (h : i < length l - 1), @@ -177,6 +190,12 @@ theorem chain'.iff_mem : ∀ {l : list α}, chain' R l ↔ chain' (λ x y, x ∈ @[simp] theorem chain'_cons {x y l} : chain' R (x :: y :: l) ↔ R x y ∧ chain' R (y :: l) := chain_cons +theorem chain'_is_infix : ∀ l : list α, chain' (λ x y, [x, y] <:+: l) l +| [] := chain'_nil +| [a] := chain'_singleton _ +| (a::b::l) := chain'_cons.2 ⟨⟨[], l, by simp⟩, + (chain'_is_infix (b::l)).imp $ λ x y h, h.trans ⟨[a], [], by simp⟩⟩ + theorem chain'_split {a : α} : ∀ {l₁ l₂ : list α}, chain' R (l₁ ++ a :: l₂) ↔ chain' R (l₁ ++ [a]) ∧ chain' R (a :: l₂) | [] l₂ := (and_iff_right (chain'_singleton a)).symm @@ -204,13 +223,13 @@ theorem pairwise.chain' : ∀ {l : list α}, pairwise R l → chain' R l | [] _ := trivial | (a :: l) h := pairwise.chain h -theorem chain'_iff_pairwise (tr : transitive R) : ∀ {l : list α}, +theorem chain'_iff_pairwise [is_trans α R] : ∀ {l : list α}, chain' R l ↔ pairwise R l | [] := (iff_true_intro pairwise.nil).symm -| (a :: l) := chain_iff_pairwise tr +| (a :: l) := chain_iff_pairwise protected lemma chain'.sublist [is_trans α R] (hl : l₂.chain' R) (h : l₁ <+ l₂) : l₁.chain' R := -by { rw chain'_iff_pairwise (transitive_of_trans R) at ⊢ hl, exact hl.sublist h } +by { rw chain'_iff_pairwise at ⊢ hl, exact hl.sublist h } theorem chain'.cons {x y l} (h₁ : R x y) (h₂ : chain' R (y :: l)) : chain' R (x :: y :: l) := @@ -235,23 +254,29 @@ theorem chain'.cons' {x} : theorem chain'_cons' {x l} : chain' R (x :: l) ↔ (∀ y ∈ head' l, R x y) ∧ chain' R l := ⟨λ h, ⟨h.rel_head', h.tail⟩, λ ⟨h₁, h₂⟩, h₂.cons' h₁⟩ -theorem chain'.drop : ∀ (n) {l} (h : chain' R l), chain' R (drop n l) -| 0 _ h := h -| _ [] _ := by {rw drop_nil, exact chain'_nil} -| (n + 1) [a] _ := by {unfold drop, rw drop_nil, exact chain'_nil} -| (n + 1) (a :: b :: l) h := chain'.drop n (chain'_cons'.mp h).right - -theorem chain'.append : ∀ {l₁ l₂ : list α} (h₁ : chain' R l₁) (h₂ : chain' R l₂) - (h : ∀ (x ∈ l₁.last') (y ∈ l₂.head'), R x y), - chain' R (l₁ ++ l₂) -| [] l₂ h₁ h₂ h := h₂ -| [a] l₂ h₁ h₂ h := h₂.cons' $ h _ rfl -| (a :: b :: l) l₂ h₁ h₂ h := - begin - simp only [last'] at h, - have : chain' R (b :: l) := h₁.tail, - exact (this.append h₂ h).cons h₁.rel_head - end +theorem chain'_append : ∀ {l₁ l₂ : list α}, + chain' R (l₁ ++ l₂) ↔ chain' R l₁ ∧ chain' R l₂ ∧ ∀ (x ∈ l₁.last') (y ∈ l₂.head'), R x y +| [] l := by simp +| [a] l := by simp [chain'_cons', and_comm] +| (a :: b :: l₁) l₂ := by rw [cons_append, cons_append, chain'_cons, chain'_cons, ← cons_append, + chain'_append, last', and.assoc] + +theorem chain'.append (h₁ : chain' R l₁) (h₂ : chain' R l₂) + (h : ∀ (x ∈ l₁.last') (y ∈ l₂.head'), R x y) : + chain' R (l₁ ++ l₂) := +chain'_append.2 ⟨h₁, h₂, h⟩ + +theorem chain'.left_of_append (h : chain' R (l₁ ++ l₂)) : chain' R l₁ := (chain'_append.1 h).1 +theorem chain'.right_of_append (h : chain' R (l₁ ++ l₂)) : chain' R l₂ := (chain'_append.1 h).2.1 + +theorem chain'.infix (h : chain' R l) (h' : l₁ <:+: l) : chain' R l₁ := +by { rcases h' with ⟨l₂, l₃, rfl⟩, exact h.left_of_append.right_of_append } + +theorem chain'.suffix (h : chain' R l) (h' : l₁ <:+ l) : chain' R l₁ := h.infix h'.is_infix +theorem chain'.prefix (h : chain' R l) (h' : l₁ <+: l) : chain' R l₁ := h.infix h'.is_infix +theorem chain'.drop (h : chain' R l) (n : ℕ) : chain' R (drop n l) := h.suffix (drop_suffix _ _) +theorem chain'.init (h : chain' R l) : chain' R l.init := h.prefix l.init_prefix +theorem chain'.take (h : chain' R l) (n : ℕ) : chain' R (take n l) := h.prefix (take_prefix _ _) theorem chain'_pair {x y} : chain' R [x, y] ↔ R x y := by simp only [chain'_singleton, chain'_cons, and_true] @@ -273,34 +298,19 @@ theorem chain'_iff_nth_le {R} : ∀ {l : list α}, | [a] := by simp | (a :: b :: t) := begin - rw [chain'_cons, chain'_iff_nth_le], - split, - { rintro ⟨R, h⟩ i w, - cases i, - { exact R, }, - { convert h i _ using 1, - simp only [succ_eq_add_one, add_succ_sub_one, add_zero, length, add_lt_add_iff_right] at w, - simpa using w, } }, - { rintro h, split, - { apply h 0, simp, }, - { intros i w, convert h (i+1) _ using 1, - simp only [add_zero, length, add_succ_sub_one] at w, - simpa using w, } }, + rw [← and_forall_succ, chain'_cons, chain'_iff_nth_le], + simp only [length, nth_le, add_tsub_cancel_right, add_lt_add_iff_right, tsub_pos_iff_lt, + one_lt_succ_succ, true_implies_iff], + refl, end /-- If `l₁ l₂` and `l₃` are lists and `l₁ ++ l₂` and `l₂ ++ l₃` both satisfy `chain' R`, then so does `l₁ ++ l₂ ++ l₃` provided `l₂ ≠ []` -/ -lemma chain'.append_overlap : ∀ {l₁ l₂ l₃ : list α} - (h₁ : chain' R (l₁ ++ l₂)) (h₂ : chain' R (l₂ ++ l₃)) (hn : l₂ ≠ []), - chain' R (l₁ ++ l₂ ++ l₃) -| [] l₂ l₃ h₁ h₂ hn := h₂ -| l₁ [] l₃ h₁ h₂ hn := (hn rfl).elim -| [a] (b :: l₂) l₃ h₁ h₂ hn := by { simp at *, tauto } -| (a :: b :: l₁) (c :: l₂) l₃ h₁ h₂ hn := begin - simp only [cons_append, chain'_cons] at h₁ h₂ ⊢, - simp only [← cons_append] at h₁ h₂ ⊢, - exact ⟨h₁.1, chain'.append_overlap h₁.2 h₂ (cons_ne_nil _ _)⟩ -end +lemma chain'.append_overlap {l₁ l₂ l₃ : list α} + (h₁ : chain' R (l₁ ++ l₂)) (h₂ : chain' R (l₂ ++ l₃)) (hn : l₂ ≠ []) : + chain' R (l₁ ++ l₂ ++ l₃) := +h₁.append h₂.right_of_append $ + by simpa only [last'_append_of_ne_nil _ hn] using (chain'_append.1 h₂).2.2 /-- If `a` and `b` are related by the reflexive transitive closure of `r`, then there is a `r`-chain diff --git a/src/data/list/count.lean b/src/data/list/count.lean index e918fc3ef6aa9..25d72187efa05 100644 --- a/src/data/list/count.lean +++ b/src/data/list/count.lean @@ -3,11 +3,14 @@ Copyright (c) 2014 Parikshit Khanna. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro -/ -import data.list.big_operators +import data.list.big_operators.basic /-! # Counting in lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic properties of `list.countp` and `list.count`, which count the number of elements of a list satisfying a predicate and equal to a given element respectively. Their definitions can be found in [`data.list.defs`](./defs). @@ -20,7 +23,7 @@ variables {α β : Type*} {l l₁ l₂ : list α} namespace list section countp -variables (p : α → Prop) [decidable_pred p] +variables (p q : α → Prop) [decidable_pred p] [decidable_pred q] @[simp] lemma countp_nil : countp p [] = 0 := rfl @@ -30,6 +33,9 @@ if_pos pa @[simp] lemma countp_cons_of_neg {a : α} (l) (pa : ¬ p a) : countp p (a::l) = countp p l := if_neg pa +lemma countp_cons (a : α) (l) : countp p (a :: l) = countp p l + ite (p a) 1 0 := +by { by_cases h : p a; simp [h] } + lemma length_eq_countp_add_countp (l) : length l = countp p l + countp (λ a, ¬p a) l := by induction l with x h ih; [refl, by_cases p x]; [simp only [countp_cons_of_pos _ _ h, countp_cons_of_neg (λ a, ¬p a) _ (decidable.not_not.2 h), @@ -42,15 +48,22 @@ by induction l with x l ih; [refl, by_cases (p x)]; simp only [countp_cons_of_neg _ _ h, ih, filter_cons_of_neg _ h]]; refl lemma countp_le_length : countp p l ≤ l.length := -by simpa only [countp_eq_length_filter] using length_le_of_sublist (filter_sublist _) +by simpa only [countp_eq_length_filter] using length_filter_le _ _ @[simp] lemma countp_append (l₁ l₂) : countp p (l₁ ++ l₂) = countp p l₁ + countp p l₂ := by simp only [countp_eq_length_filter, filter_append, length_append] +lemma countp_join : ∀ l : list (list α), countp p l.join = (l.map (countp p)).sum +| [] := rfl +| (a :: l) := by rw [join, countp_append, map_cons, sum_cons, countp_join] + lemma countp_pos {l} : 0 < countp p l ↔ ∃ a ∈ l, p a := by simp only [countp_eq_length_filter, length_pos_iff_exists_mem, mem_filter, exists_prop] -lemma countp_eq_length {l} : countp p l = l.length ↔ ∀ a ∈ l, p a := +@[simp] theorem countp_eq_zero {l} : countp p l = 0 ↔ ∀ a ∈ l, ¬ p a := +by { rw [← not_iff_not, ← ne.def, ← pos_iff_ne_zero, countp_pos], simp } + +@[simp] lemma countp_eq_length {l} : countp p l = l.length ↔ ∀ a ∈ l, p a := by rw [countp_eq_length_filter, filter_length_eq_length] lemma length_filter_lt_length_iff_exists (l) : length (filter p l) < length l ↔ ∃ x ∈ l, ¬p x := @@ -59,15 +72,35 @@ by rw [length_eq_countp_add_countp p l, ← countp_pos, countp_eq_length_filter, lemma sublist.countp_le (s : l₁ <+ l₂) : countp p l₁ ≤ countp p l₂ := by simpa only [countp_eq_length_filter] using length_le_of_sublist (s.filter p) -@[simp] lemma countp_filter {q} [decidable_pred q] (l : list α) : - countp p (filter q l) = countp (λ a, p a ∧ q a) l := +@[simp] lemma countp_filter (l : list α) : countp p (filter q l) = countp (λ a, p a ∧ q a) l := by simp only [countp_eq_length_filter, filter_filter] -@[simp] lemma countp_true : l.countp (λ _, true) = l.length := -by simp [countp_eq_length_filter] +@[simp] lemma countp_true : l.countp (λ _, true) = l.length := by simp -@[simp] lemma countp_false : l.countp (λ _, false) = 0 := -by simp [countp_eq_length_filter] +@[simp] lemma countp_false : l.countp (λ _, false) = 0 := by simp + +@[simp] lemma countp_map (p : β → Prop) [decidable_pred p] (f : α → β) : + ∀ l, countp p (map f l) = countp (p ∘ f) l +| [] := rfl +| (a::l) := by rw [map_cons, countp_cons, countp_cons, countp_map] + +@[simp] lemma countp_attach (l : list α) : l.attach.countp (λ a, p ↑a) = l.countp p := +by rw [←countp_map, attach_map_coe] + +variables {p q} + +lemma countp_mono_left (h : ∀ x ∈ l, p x → q x) : countp p l ≤ countp q l := +begin + induction l with a l ihl, { refl }, + rw [forall_mem_cons] at h, cases h with ha hl, + rw [countp_cons, countp_cons], + refine add_le_add (ihl hl) _, + split_ifs; try { simp only [le_rfl, zero_le] }, + exact absurd (ha ‹_›) ‹_› +end + +lemma countp_congr (h : ∀ x ∈ l, p x ↔ q x) : countp p l = countp q l := +le_antisymm (countp_mono_left $ λ x hx, (h x hx).1) (countp_mono_left $ λ x hx, (h x hx).2) end countp @@ -85,7 +118,7 @@ lemma count_cons' (a b : α) (l : list α) : count a (b :: l) = count a l + (if a = b then 1 else 0) := begin rw count_cons, split_ifs; refl end -@[simp] lemma count_cons_self (a : α) (l : list α) : count a (a::l) = succ (count a l) := if_pos rfl +@[simp] lemma count_cons_self (a : α) (l : list α) : count a (a::l) = count a l + 1 := if_pos rfl @[simp, priority 990] lemma count_cons_of_ne {a b : α} (h : a ≠ b) (l : list α) : count a (b::l) = count a l := if_neg h @@ -109,6 +142,9 @@ lemma count_singleton' (a b : α) : count a [b] = ite (a = b) 1 0 := rfl @[simp] lemma count_append (a : α) : ∀ l₁ l₂, count a (l₁ ++ l₂) = count a l₁ + count a l₂ := countp_append _ +lemma count_join (l : list (list α)) (a : α) : l.join.count a = (l.map (count a)).sum := +countp_join _ _ + lemma count_concat (a : α) (l : list α) : count a (concat l a) = succ (count a l) := by simp [-add_comm] @@ -125,25 +161,36 @@ decidable.by_contradiction $ λ h', h $ count_pos.1 (nat.pos_of_ne_zero h') lemma not_mem_of_count_eq_zero {a : α} {l : list α} (h : count a l = 0) : a ∉ l := λ h', (count_pos.2 h').ne' h -lemma count_eq_length {a : α} {l} : count a l = l.length ↔ ∀ b ∈ l, a = b := -by rw [count, countp_eq_length] +@[simp] lemma count_eq_zero {a : α} {l} : count a l = 0 ↔ a ∉ l := +⟨not_mem_of_count_eq_zero, count_eq_zero_of_not_mem⟩ -@[simp] lemma count_repeat (a : α) (n : ℕ) : count a (repeat a n) = n := -by rw [count, countp_eq_length_filter, filter_eq_self.2, length_repeat]; - exact λ b m, (eq_of_mem_repeat m).symm +@[simp] lemma count_eq_length {a : α} {l} : count a l = l.length ↔ ∀ b ∈ l, a = b := +countp_eq_length _ -lemma le_count_iff_repeat_sublist {a : α} {l : list α} {n : ℕ} : - n ≤ count a l ↔ repeat a n <+ l := -⟨λ h, ((repeat_sublist_repeat a).2 h).trans $ - have filter (eq a) l = repeat a (count a l), from eq_repeat.2 - ⟨by simp only [count, countp_eq_length_filter], λ b m, (of_mem_filter m).symm⟩, - by rw ← this; apply filter_sublist, - λ h, by simpa only [count_repeat] using h.count_le a⟩ +@[simp] lemma count_replicate_self (a : α) (n : ℕ) : count a (replicate n a) = n := +by rw [count, countp_eq_length_filter, filter_eq_self.2, length_replicate]; + exact λ b m, (eq_of_mem_replicate m).symm -lemma repeat_count_eq_of_count_eq_length {a : α} {l : list α} (h : count a l = length l) : - repeat a (count a l) = l := -eq_of_sublist_of_length_eq (le_count_iff_repeat_sublist.mp (le_refl (count a l))) - (eq.trans (length_repeat a (count a l)) h) +lemma count_replicate (a b : α) (n : ℕ) : count a (replicate n b) = if a = b then n else 0 := +begin + split_ifs with h, + exacts [h ▸ count_replicate_self _ _, count_eq_zero_of_not_mem $ mt eq_of_mem_replicate h] +end + +theorem filter_eq (l : list α) (a : α) : l.filter (eq a) = replicate (count a l) a := +by simp [eq_replicate, count, countp_eq_length_filter, @eq_comm _ _ a] + +theorem filter_eq' (l : list α) (a : α) : l.filter (λ x, x = a) = replicate (count a l) a := +by simp only [filter_eq, @eq_comm _ _ a] + +lemma le_count_iff_replicate_sublist {a : α} {l : list α} {n : ℕ} : + n ≤ count a l ↔ replicate n a <+ l := +⟨λ h, ((replicate_sublist_replicate a).2 h).trans $ filter_eq l a ▸ filter_sublist _, + λ h, by simpa only [count_replicate_self] using h.count_le a⟩ + +lemma replicate_count_eq_of_count_eq_length {a : α} {l : list α} (h : count a l = length l) : + replicate (count a l) a = l := +(le_count_iff_replicate_sublist.mp le_rfl).eq_of_length $ (length_replicate (count a l) a).trans h @[simp] lemma count_filter {p} [decidable_pred p] {a} {l : list α} (h : p a) : count a (filter p l) = count a l := @@ -151,53 +198,62 @@ by simp only [count, countp_filter, show (λ b, a = b ∧ p b) = eq a, by { ext lemma count_bind {α β} [decidable_eq β] (l : list α) (f : α → list β) (x : β) : count x (l.bind f) = sum (map (count x ∘ f) l) := -begin - induction l with hd tl IH, - { simp }, - { simpa } -end +by rw [list.bind, count_join, map_map] + +@[simp] lemma count_attach (a : {x // x ∈ l}) : l.attach.count a = l.count a := +eq.trans (countp_congr $ λ _ _, subtype.ext_iff) $ countp_attach _ _ @[simp] lemma count_map_of_injective {α β} [decidable_eq α] [decidable_eq β] (l : list α) (f : α → β) (hf : function.injective f) (x : α) : count (f x) (map f l) = count x l := -begin - induction l with y l IH generalizing x, - { simp }, - { simp [map_cons, count_cons', IH, hf.eq_iff] } -end +by simp only [count, countp_map, (∘), hf.eq_iff] lemma count_le_count_map [decidable_eq β] (l : list α) (f : α → β) (x : α) : count x l ≤ count (f x) (map f l) := begin - induction l with a as IH, { simp }, - rcases eq_or_ne x a with rfl | hxa, - { simp [succ_le_succ IH] }, - { simp [hxa, le_add_right IH, count_cons'] } + rw [count, count, countp_map], + exact countp_mono_left (λ y hyl, congr_arg f), end -@[simp] lemma count_erase_self (a : α) : - ∀ (s : list α), count a (list.erase s a) = pred (count a s) +lemma count_erase (a b : α) : ∀ l : list α, count a (l.erase b) = count a l - ite (a = b) 1 0 | [] := by simp -| (h :: t) := +| (c :: l) := begin - rw erase_cons, - by_cases p : h = a, - { rw [if_pos p, count_cons', if_pos p.symm], simp }, - { rw [if_neg p, count_cons', count_cons', if_neg (λ x : a = h, p x.symm), count_erase_self], - simp } + rw [erase_cons], + by_cases hc : c = b, + { rw [if_pos hc, hc, count_cons', nat.add_sub_cancel] }, + { rw [if_neg hc, count_cons', count_cons', count_erase], + by_cases ha : a = b, + { rw [← ha, eq_comm] at hc, + rw [if_pos ha, if_neg hc, add_zero, add_zero] }, + { rw [if_neg ha, tsub_zero, tsub_zero] } } end -@[simp] lemma count_erase_of_ne {a b : α} (ab : a ≠ b) : - ∀ (s : list α), count a (list.erase s b) = count a s -| [] := by simp -| (x :: xs) := +@[simp] lemma count_erase_self (a : α) (l : list α) : count a (list.erase l a) = count a l - 1 := +by rw [count_erase, if_pos rfl] + +@[simp] lemma count_erase_of_ne {a b : α} (ab : a ≠ b) (l : list α) : + count a (l.erase b) = count a l := +by rw [count_erase, if_neg ab, tsub_zero] + +@[to_additive] +lemma prod_map_eq_pow_single [monoid β] {l : list α} (a : α) (f : α → β) + (hf : ∀ a' ≠ a, a' ∈ l → f a' = 1) : (l.map f).prod = (f a) ^ (l.count a) := begin - rw erase_cons, - split_ifs with h, - { rw [count_cons', h, if_neg ab], simp }, - { rw [count_cons', count_cons', count_erase_of_ne] } + induction l with a' as h generalizing a, + { rw [map_nil, prod_nil, count_nil, pow_zero] }, + { specialize h a (λ a' ha' hfa', hf a' ha' (mem_cons_of_mem _ hfa')), + rw [list.map_cons, list.prod_cons, count_cons, h], + split_ifs with ha', + { rw [ha', pow_succ] }, + { rw [hf a' (ne.symm ha') (list.mem_cons_self a' as), one_mul] } } end +@[to_additive] +lemma prod_eq_pow_single [monoid α] {l : list α} (a : α) + (h : ∀ a' ≠ a, a' ∈ l → a' = 1) : l.prod = a ^ (l.count a) := +trans (by rw [map_id'']) (prod_map_eq_pow_single a id h) + end count end list diff --git a/src/data/list/cycle.lean b/src/data/list/cycle.lean index 259637ee19d64..80d88fab41dfc 100644 --- a/src/data/list/cycle.lean +++ b/src/data/list/cycle.lean @@ -10,6 +10,9 @@ import data.list.rotate /-! # Cycles of a list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Lists have an equivalence relation of whether they are rotational permutations of one another. This relation is defined as `is_rotated`. @@ -17,8 +20,8 @@ Based on this, we define the quotient of lists by the rotation relation, called We also define a representation of concrete cycles, available when viewing them in a goal state or via `#eval`, when over representatble types. For example, the cycle `(2 1 4 3)` will be shown -as `c[1, 4, 3, 2]`. The representation of the cycle sorts the elements by the string value of the -underlying element. This representation also supports cycles that can contain duplicates. +as `c[2, 1, 4, 3]`. Two equal cycles may be printed differently if their internal representation +is different. -/ @@ -623,6 +626,10 @@ rfl @[simp] lemma map_eq_nil {β : Type*} (f : α → β) (s : cycle α) : map f s = nil ↔ s = nil := quotient.induction_on' s (by simp) +@[simp] lemma mem_map {β : Type*} {f : α → β} {b : β} {s : cycle α} : + b ∈ s.map f ↔ ∃ a, a ∈ s ∧ f a = b := +quotient.induction_on' s (by simp) + /-- The `multiset` of lists that can make the cycle. -/ def lists (s : cycle α) : multiset (list α) := quotient.lift_on' s @@ -728,12 +735,12 @@ end decidable /-- We define a representation of concrete cycles, available when viewing them in a goal state or -via `#eval`, when over representatble types. For example, the cycle `(2 1 4 3)` will be shown -as `c[1, 4, 3, 2]`. The representation of the cycle sorts the elements by the string value of the -underlying element. This representation also supports cycles that can contain duplicates. +via `#eval`, when over representable types. For example, the cycle `(2 1 4 3)` will be shown +as `c[2, 1, 4, 3]`. Two equal cycles may be printed differently if their internal representation +is different. -/ -instance [has_repr α] : has_repr (cycle α) := -⟨λ s, "c[" ++ string.intercalate ", " ((s.map repr).lists.sort (≤)).head ++ "]"⟩ +meta instance [has_repr α] : has_repr (cycle α) := +⟨λ s, "c[" ++ string.intercalate ", " ((s.map repr).lists.unquot).head ++ "]"⟩ /-- `chain R s` means that `R` holds between adjacent elements of `s`. @@ -792,8 +799,25 @@ quotient.induction_on' s $ λ l, begin refl end +theorem chain_range_succ (r : ℕ → ℕ → Prop) (n : ℕ) : + chain r (list.range n.succ) ↔ r n 0 ∧ ∀ m < n, r m m.succ := +by rw [range_succ, ←coe_cons_eq_coe_append, chain_coe_cons, ←range_succ, chain_range_succ] + variables {r : α → α → Prop} {s : cycle α} +theorem chain.imp {r₁ r₂ : α → α → Prop} (H : ∀ a b, r₁ a b → r₂ a b) (p : chain r₁ s) : + chain r₂ s := +begin + induction s using cycle.induction_on, + { triv }, + { rw chain_coe_cons at ⊢ p, + exact p.imp H } +end + +/-- As a function from a relation to a predicate, `chain` is monotonic. -/ +theorem chain_mono : monotone (chain : (α → α → Prop) → cycle α → Prop) := +λ a b hab s, chain.imp hab + theorem chain_of_pairwise : (∀ (a ∈ s) (b ∈ s), r a b) → chain r s := begin induction s using cycle.induction_on with a l _, @@ -817,25 +841,36 @@ begin exact hs b (Hl hb) a Ha } end -theorem chain_iff_pairwise (hr : transitive r) : chain r s ↔ ∀ (a ∈ s) (b ∈ s), r a b := +theorem chain_iff_pairwise [is_trans α r] : chain r s ↔ ∀ (a ∈ s) (b ∈ s), r a b := ⟨begin induction s using cycle.induction_on with a l _, exact λ _ b hb, hb.elim, intros hs b hb c hc, - rw [cycle.chain_coe_cons, chain_iff_pairwise hr] at hs, + rw [cycle.chain_coe_cons, chain_iff_pairwise] at hs, simp only [pairwise_append, pairwise_cons, mem_append, mem_singleton, list.not_mem_nil, - forall_false_left, implies_true_iff, pairwise.nil, forall_eq, true_and] at hs, + is_empty.forall_iff, implies_true_iff, pairwise.nil, forall_eq, true_and] at hs, simp only [mem_coe_iff, mem_cons_iff] at hb hc, rcases hb with rfl | hb; rcases hc with rfl | hc, { exact hs.1 c (or.inr rfl) }, { exact hs.1 c (or.inl hc) }, { exact hs.2.2 b hb }, - { exact hr (hs.2.2 b hb) (hs.1 c (or.inl hc)) } + { exact trans (hs.2.2 b hb) (hs.1 c (or.inl hc)) } end, cycle.chain_of_pairwise⟩ -theorem forall_eq_of_chain (hr : transitive r) (hr' : anti_symmetric r) +theorem chain.eq_nil_of_irrefl [is_trans α r] [is_irrefl α r] (h : chain r s) : s = nil := +begin + induction s using cycle.induction_on with a l _ h, + { refl }, + { have ha := mem_cons_self a l, + exact (irrefl_of r a $ chain_iff_pairwise.1 h a ha a ha).elim } +end + +theorem chain.eq_nil_of_well_founded [is_well_founded α r] (h : chain r s) : s = nil := +chain.eq_nil_of_irrefl $ h.imp $ λ _ _, relation.trans_gen.single + +theorem forall_eq_of_chain [is_trans α r] [is_antisymm α r] (hs : chain r s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) : a = b := -by { rw chain_iff_pairwise hr at hs, exact hr' (hs a ha b hb) (hs b hb a ha) } +by { rw chain_iff_pairwise at hs, exact antisymm (hs a ha b hb) (hs b hb a ha) } end cycle diff --git a/src/data/list/dedup.lean b/src/data/list/dedup.lean index f8c65923d023b..4b42facffb4c6 100644 --- a/src/data/list/dedup.lean +++ b/src/data/list/dedup.lean @@ -8,6 +8,9 @@ import data.list.nodup /-! # Erasure of duplicates in a list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic results about `list.dedup` (definition in `data.list.defs`). `dedup l` returns `l` without its duplicates. It keeps the earliest (that is, rightmost) occurrence of each. @@ -35,7 +38,7 @@ pw_filter_cons_of_pos $ by simpa only [forall_mem_ne] using h @[simp] theorem mem_dedup {a : α} {l : list α} : a ∈ dedup l ↔ a ∈ l := by simpa only [dedup, forall_mem_ne, not_not] using not_congr (@forall_mem_pw_filter α (≠) _ - (λ x y z xz, not_and_distrib.1 $ mt (and.rec eq.trans) xz) a l) + (λ x y z xz, not_and_distrib.1 $ mt (λ h, eq.trans h.1 h.2) xz) a l) @[simp] theorem dedup_cons_of_mem {a : α} {l : list α} (h : a ∈ l) : dedup (a :: l) = dedup l := @@ -54,8 +57,45 @@ theorem subset_dedup (l : list α) : l ⊆ dedup l := theorem nodup_dedup : ∀ l : list α, nodup (dedup l) := pairwise_pw_filter +theorem head_dedup [inhabited α] (l : list α) : + l.dedup.head = if l.head ∈ l.tail then l.tail.dedup.head else l.head := +match l with +| [] := rfl +| (a :: l) := by { by_cases ha : a ∈ l; simp [ha, list.dedup_cons_of_mem] } +end + +theorem tail_dedup [inhabited α] (l : list α) : + l.dedup.tail = if l.head ∈ l.tail then l.tail.dedup.tail else l.tail.dedup := +match l with +| [] := rfl +| (a :: l) := by { by_cases ha : a ∈ l; simp [ha, list.dedup_cons_of_mem] } +end + theorem dedup_eq_self {l : list α} : dedup l = l ↔ nodup l := pw_filter_eq_self +theorem dedup_eq_cons (l : list α) (a : α) (l' : list α) : + l.dedup = a :: l' ↔ a ∈ l ∧ a ∉ l' ∧ l.dedup.tail = l' := +begin + refine ⟨λ h, _, λ h, _⟩, + { refine ⟨mem_dedup.1 (h.symm ▸ mem_cons_self _ _), λ ha, _, by rw [h, tail_cons]⟩, + have : count a l.dedup ≤ 1 := nodup_iff_count_le_one.1 (nodup_dedup l) a, + rw [h, count_cons_self, add_le_iff_nonpos_left] at this, + exact (not_le_of_lt (count_pos.2 ha) this) }, + { have := @cons_head_tail α ⟨a⟩ _ (ne_nil_of_mem (mem_dedup.2 h.1)), + have hal : a ∈ l.dedup := mem_dedup.2 h.1, + rw [← this, mem_cons_iff, or_iff_not_imp_right] at hal, + exact this ▸ h.2.2.symm ▸ (cons_eq_cons.2 ⟨(hal (h.2.2.symm ▸ h.2.1)).symm, rfl⟩) } +end + +@[simp] theorem dedup_eq_nil (l : list α) : l.dedup = [] ↔ l = [] := +begin + induction l with a l hl, + { exact iff.rfl }, + { by_cases h : a ∈ l, + { simp only [list.dedup_cons_of_mem h, hl, list.ne_nil_of_mem h] }, + { simp only [list.dedup_cons_of_not_mem h, list.cons_ne_nil] } } +end + protected lemma nodup.dedup {l : list α} (h : l.nodup) : l.dedup = l := list.dedup_eq_self.2 h @@ -71,4 +111,41 @@ begin rw [dedup_cons_of_not_mem' h, insert_of_not_mem h]] end +lemma replicate_dedup {x : α} : ∀ {k}, k ≠ 0 → (replicate k x).dedup = [x] +| 0 h := (h rfl).elim +| 1 _ := rfl +| (n+2) _ := by rw [replicate_succ, dedup_cons_of_mem (mem_replicate.2 ⟨n.succ_ne_zero, rfl⟩), + replicate_dedup n.succ_ne_zero] + +lemma count_dedup (l : list α) (a : α) : + l.dedup.count a = if a ∈ l then 1 else 0 := +by simp_rw [count_eq_of_nodup $ nodup_dedup l, mem_dedup] + +/-- Summing the count of `x` over a list filtered by some `p` is just `countp` applied to `p` -/ +lemma sum_map_count_dedup_filter_eq_countp (p : α → Prop) [decidable_pred p] + (l : list α) : ((l.dedup.filter p).map $ λ x, l.count x).sum = l.countp p := +begin + induction l with a as h, + { simp }, + { simp_rw [list.countp_cons, list.count_cons', list.sum_map_add], + congr' 1, + { refine trans _ h, + by_cases ha : a ∈ as, + { simp [dedup_cons_of_mem ha] }, + { simp only [dedup_cons_of_not_mem ha, list.filter], + split_ifs with hp; simp [list.map_cons, list.sum_cons, + list.count_eq_zero.2 ha, zero_add] } }, + { by_cases hp : p a, + { refine trans (sum_map_eq_nsmul_single a _ (λ _ h _, by simp [h])) _, + simp [hp, count_dedup] }, + { refine trans (list.sum_eq_zero $ λ n hn, _) (by simp [hp]), + obtain ⟨a', ha'⟩ := list.mem_map.1 hn, + simp only [(λ h, hp (h ▸ (list.mem_filter.1 ha'.1).2) : a' ≠ a), if_false] at ha', + exact ha'.2.symm } } }, +end + +lemma sum_map_count_dedup_eq_length (l : list α) : + (l.dedup.map $ λ x, l.count x).sum = l.length := +by simpa using sum_map_count_dedup_filter_eq_countp (λ _, true) l + end list diff --git a/src/data/list/default.lean b/src/data/list/default.lean deleted file mode 100644 index aeda587b9cf86..0000000000000 --- a/src/data/list/default.lean +++ /dev/null @@ -1,28 +0,0 @@ -/- -Copyright (c) 2014 Microsoft Corporation. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad --/ -import data.list.alist -import data.list.basic -import data.list.chain -import data.list.defs -import data.list.dedup -import data.list.forall2 -import data.list.func -import data.list.intervals -import data.list.lattice -import data.list.min_max -import data.list.indexes -import data.list.nat_antidiagonal -import data.list.nodup -import data.list.of_fn -import data.list.pairwise -import data.list.perm -import data.list.range -import data.list.rotate -import data.list.sections -import data.list.sigma -import data.list.sort -import data.list.tfae -import data.list.zip diff --git a/src/data/list/defs.lean b/src/data/list/defs.lean index 183faff24693a..dc8523993350e 100644 --- a/src/data/list/defs.lean +++ b/src/data/list/defs.lean @@ -3,15 +3,16 @@ Copyright (c) 2014 Parikshit Khanna. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Parikshit Khanna, Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Mario Carneiro -/ -import data.option.defs import logic.basic import tactic.cache import data.rbmap.basic import data.rbtree.default_lt - /-! ## Definitions on lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains various definitions on lists. It does not contain proofs about these definitions, those are contained in other files in `data/list` -/ @@ -24,6 +25,11 @@ variables {α β γ δ ε ζ : Type*} instance [decidable_eq α] : has_sdiff (list α) := ⟨ list.diff ⟩ +/-- Create a list of `n` copies of `a`. Same as `function.swap list.repeat`. -/ +@[simp] def replicate : ℕ → α → list α +| 0 _ := [] +| (succ n) a := a :: replicate n a + /-- Split a list at an index. split_at 2 [a, b, c] = ([a, b], [c]) -/ @@ -68,9 +74,16 @@ it returns `none` otherwise -/ def to_array (l : list α) : array l.length α := {data := λ v, l.nth_le v.1 v.2} +/-- "default" `nth` function: returns `d` instead of `none` in the case + that the index is out of bounds. -/ +def nthd : Π (l : list α) (n : ℕ) (d : α), α +| [] _ d := d +| (x::xs) 0 d := x +| (x::xs) (n + 1) d := nthd xs n d + /-- "inhabited" `nth` function: returns `default` instead of `none` in the case that the index is out of bounds. -/ -@[simp] def inth [h : inhabited α] (l : list α) (n : nat) : α := (nth l n).iget +def inth [h : inhabited α] (l : list α) (n : nat) : α := nthd l n default /-- Apply a function to the nth tail of `l`. Returns the input without using `f` if the index is larger than the length of the list. @@ -233,23 +246,23 @@ mall id end /-- Auxiliary definition for `foldl_with_index`. -/ -def foldl_with_index_aux (f : ℕ → α → β → α) : ℕ → α → list β → α +def foldl_with_index_aux {α : Sort*} {β : Type*} (f : ℕ → α → β → α) : ℕ → α → list β → α | _ a [] := a | i a (b :: l) := foldl_with_index_aux (i + 1) (f i a b) l /-- Fold a list from left to right as with `foldl`, but the combining function also receives each element's index. -/ -def foldl_with_index (f : ℕ → α → β → α) (a : α) (l : list β) : α := +def foldl_with_index {α : Sort*} {β : Type*} (f : ℕ → α → β → α) (a : α) (l : list β) : α := foldl_with_index_aux f 0 a l /-- Auxiliary definition for `foldr_with_index`. -/ -def foldr_with_index_aux (f : ℕ → α → β → β) : ℕ → β → list α → β +def foldr_with_index_aux {α : Type*} {β : Sort*} (f : ℕ → α → β → β) : ℕ → β → list α → β | _ b [] := b | i b (a :: l) := f i a (foldr_with_index_aux (i + 1) b l) /-- Fold a list from right to left as with `foldr`, but the combining function also receives each element's index. -/ -def foldr_with_index (f : ℕ → α → β → β) (b : β) (l : list α) : β := +def foldr_with_index {α : Type*} {β : Sort*} (f : ℕ → α → β → β) (b : β) (l : list α) : β := foldr_with_index_aux f 0 b l /-- `find_indexes p l` is the list of indexes of elements of `l` that satisfy `p`. -/ @@ -533,6 +546,9 @@ def revzip (l : list α) : list (α × α) := zip l l.reverse def product (l₁ : list α) (l₂ : list β) : list (α × β) := l₁.bind $ λ a, l₂.map $ prod.mk a +/- This notation binds more strongly than (pre)images, unions and intersections. -/ +infixr (name := list.product) ` ×ˢ `:82 := list.product + /-- `sigma l₁ l₂` is the list of dependent pairs `(a, b)` where `a ∈ l₁` and `b ∈ l₂ a`. sigma [1, 2] (λ_, [(5 : ℕ), 6]) = [(1, 5), (1, 6), (2, 5), (2, 6)] -/ @@ -634,7 +650,7 @@ def nodup : list α → Prop := pairwise (≠) instance nodup_decidable [decidable_eq α] : ∀ l : list α, decidable (nodup l) := list.decidable_pairwise -/-- `dedup l` removes duplicates from `l` (taking only the first occurrence). +/-- `dedup l` removes duplicates from `l` (taking only the last occurrence). Defined as `pw_filter (≠)`. dedup [1, 0, 2, 2, 1] = [0, 2, 1] -/ @@ -1010,6 +1026,15 @@ def zip_with5 (f : α → β → γ → δ → ε → ζ) : list α → list β | (x::xs) (y::ys) (z::zs) (u::us) (v::vs) := f x y z u v :: zip_with5 xs ys zs us vs | _ _ _ _ _ := [] +/-- Given a starting list `old`, a list of booleans and a replacement list `new`, +read the items in `old` in succession and either replace them with the next element of `new` or +not, according as to whether the corresponding boolean is `tt` or `ff`. -/ +def replace_if : list α → list bool → list α → list α +| l _ [] := l +| [] _ _ := [] +| l [] _ := l +| (n::ns) (tf::bs) e@(c::cs) := if tf then c :: ns.replace_if bs cs else n :: ns.replace_if bs e + /-- An auxiliary function for `list.map_with_prefix_suffix`. -/ def map_with_prefix_suffix_aux {α β} (f : list α → α → list α → β) : list α → list α → list β | prev [] := [] diff --git a/src/data/list/destutter.lean b/src/data/list/destutter.lean index 8a761a809ea43..b6a7de18ec97b 100644 --- a/src/data/list/destutter.lean +++ b/src/data/list/destutter.lean @@ -8,6 +8,9 @@ import data.list.chain /-! # Destuttering of Lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves theorems about `list.destutter` (in `data.list.defs`), which greedily removes all non-related items that are adjacent in a list, e.g. `[2, 2, 3, 3, 2].destutter (≠) = [2, 3, 2]`. Note that we make no guarantees of being the longest sublist with this property; e.g., diff --git a/src/data/list/duplicate.lean b/src/data/list/duplicate.lean index 638c67ce66c5f..e142708891e1e 100644 --- a/src/data/list/duplicate.lean +++ b/src/data/list/duplicate.lean @@ -8,6 +8,9 @@ import data.list.nodup /-! # List duplicates +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `list.duplicate x l : Prop` is an inductive property that holds when `x` is a duplicate in `l` @@ -126,7 +129,7 @@ lemma duplicate.not_nodup (h : x ∈+ l) : ¬ nodup l := λ H, nodup_iff_forall_not_duplicate.mp H _ h lemma duplicate_iff_two_le_count [decidable_eq α] : (x ∈+ l) ↔ 2 ≤ count x l := -by simp [duplicate_iff_sublist, le_count_iff_repeat_sublist] +by simp [duplicate_iff_sublist, le_count_iff_replicate_sublist] instance decidable_duplicate [decidable_eq α] (x : α) : ∀ (l : list α), decidable (x ∈+ l) | [] := is_false (not_duplicate_nil x) diff --git a/src/data/list/fin_range.lean b/src/data/list/fin_range.lean new file mode 100644 index 0000000000000..cf9423b635b5f --- /dev/null +++ b/src/data/list/fin_range.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2018 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Kenny Lau, Scott Morrison +-/ +import data.list.of_fn +import data.list.perm + +/-! +# Lists of elements of `fin n` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file develops some results on `fin_range n`. +-/ + +universe u + +namespace list +variables {α : Type u} + +@[simp] lemma map_coe_fin_range (n : ℕ) : (fin_range n).map coe = list.range n := +begin + simp_rw [fin_range, map_pmap, fin.coe_mk, pmap_eq_map], + exact list.map_id _ +end + +lemma fin_range_succ_eq_map (n : ℕ) : + fin_range n.succ = 0 :: (fin_range n).map fin.succ := +begin + apply map_injective_iff.mpr fin.coe_injective, + rw [map_cons, map_coe_fin_range, range_succ_eq_map, fin.coe_zero, ←map_coe_fin_range, map_map, + map_map, function.comp, function.comp], + congr' 2 with x, + exact (fin.coe_succ _).symm, +end + +@[simp] lemma map_nth_le (l : list α) : + (fin_range l.length).map (λ n, l.nth_le n n.2) = l := +ext_le (by rw [length_map, length_fin_range]) $ λ n _ h, +by { rw ← nth_le_map_rev, congr, { rw nth_le_fin_range, refl }, { rw length_fin_range, exact h } } + +theorem of_fn_eq_pmap {α n} {f : fin n → α} : + of_fn f = pmap (λ i hi, f ⟨i, hi⟩) (range n) (λ _, mem_range.1) := +by rw [pmap_eq_map_attach]; from ext_le (by simp) + (λ i hi1 hi2, by { simp at hi1, simp [nth_le_of_fn f ⟨i, hi1⟩, -subtype.val_eq_coe] }) + +theorem of_fn_id (n) : of_fn id = fin_range n := of_fn_eq_pmap + +theorem of_fn_eq_map {α n} {f : fin n → α} : + of_fn f = (fin_range n).map f := +by rw [← of_fn_id, map_of_fn, function.right_id] + +theorem nodup_of_fn_of_injective {α n} {f : fin n → α} (hf : function.injective f) : + nodup (of_fn f) := +by { rw of_fn_eq_pmap, exact (nodup_range n).pmap (λ _ _ _ _ H, fin.veq_of_eq $ hf H) } + +theorem nodup_of_fn {α n} {f : fin n → α} : + nodup (of_fn f) ↔ function.injective f := +begin + refine ⟨_, nodup_of_fn_of_injective⟩, + refine fin.cons_induction _ (λ n x₀ xs ih, _) f, + { intro h, + exact function.injective_of_subsingleton _ }, + { intro h, + rw fin.cons_injective_iff, + simp_rw [of_fn_succ, fin.cons_succ, nodup_cons, fin.cons_zero, mem_of_fn] at h, + exact h.imp_right ih } +end + +end list + +open list + +lemma equiv.perm.map_fin_range_perm {n : ℕ} (σ : equiv.perm (fin n)) : + map σ (fin_range n) ~ fin_range n := +begin + rw [perm_ext ((nodup_fin_range n).map σ.injective) $ nodup_fin_range n], + simpa only [mem_map, mem_fin_range, true_and, iff_true] using σ.surjective +end + +/-- The list obtained from a permutation of a tuple `f` is permutation equivalent to +the list obtained from `f`. -/ +lemma equiv.perm.of_fn_comp_perm {n : ℕ} {α : Type u} (σ : equiv.perm (fin n)) (f : fin n → α) : + of_fn (f ∘ σ) ~ of_fn f := +begin + rw [of_fn_eq_map, of_fn_eq_map, ←map_map], + exact σ.map_fin_range_perm.map f, +end diff --git a/src/data/list/forall2.lean b/src/data/list/forall2.lean index 335a7149238ab..ad1040cbe08a9 100644 --- a/src/data/list/forall2.lean +++ b/src/data/list/forall2.lean @@ -8,43 +8,47 @@ import data.list.infix /-! # Double universal quantification on a list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides an API for `list.forall₂` (definition in `data.list.defs`). -`forall₂ r l₁ l₂` means that `∀ a ∈ l₁, ∀ b ∈ l₂, r a b`, where `l₁`, `l₂` are lists. +`forall₂ R l₁ l₂` means that `l₁` and `l₂` have the same length, and whenever `a` is the nth element +of `l₁`, and `b` is the nth element of `l₂`, then `R a b` is satisfied. -/ open nat function namespace list -variables {α β γ δ : Type*} {r : α → β → Prop} {p : γ → δ → Prop} +variables {α β γ δ : Type*} {R S : α → β → Prop} {P : γ → δ → Prop} {Rₐ : α → α → Prop} open relator mk_iff_of_inductive_prop list.forall₂ list.forall₂_iff -@[simp] theorem forall₂_cons {R : α → β → Prop} {a b l₁ l₂} : +@[simp] theorem forall₂_cons {a b l₁ l₂} : forall₂ R (a :: l₁) (b :: l₂) ↔ R a b ∧ forall₂ R l₁ l₂ := ⟨λ h, by cases h with h₁ h₂; split; assumption, λ ⟨h₁, h₂⟩, forall₂.cons h₁ h₂⟩ -theorem forall₂.imp {R S : α → β → Prop} +theorem forall₂.imp (H : ∀ a b, R a b → S a b) {l₁ l₂} (h : forall₂ R l₁ l₂) : forall₂ S l₁ l₂ := by induction h; constructor; solve_by_elim -lemma forall₂.mp {r q s : α → β → Prop} (h : ∀ a b, r a b → q a b → s a b) : - ∀ {l₁ l₂}, forall₂ r l₁ l₂ → forall₂ q l₁ l₂ → forall₂ s l₁ l₂ +lemma forall₂.mp {Q : α → β → Prop} (h : ∀ a b, Q a b → R a b → S a b) : + ∀ {l₁ l₂}, forall₂ Q l₁ l₂ → forall₂ R l₁ l₂ → forall₂ S l₁ l₂ | [] [] forall₂.nil forall₂.nil := forall₂.nil | (a :: l₁) (b :: l₂) (forall₂.cons hr hrs) (forall₂.cons hq hqs) := forall₂.cons (h a b hr hq) (forall₂.mp hrs hqs) -lemma forall₂.flip : ∀ {a b}, forall₂ (flip r) b a → forall₂ r a b +lemma forall₂.flip : ∀ {a b}, forall₂ (flip R) b a → forall₂ R a b | _ _ forall₂.nil := forall₂.nil | (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := forall₂.cons h₁ h₂.flip -@[simp] lemma forall₂_same {r : α → α → Prop} : ∀ {l : list α}, forall₂ r l l ↔ ∀ x ∈ l, r x x +@[simp] lemma forall₂_same : ∀ {l : list α}, forall₂ Rₐ l l ↔ ∀ x ∈ l, Rₐ x x | [] := by simp | (a :: l) := by simp [@forall₂_same l] -lemma forall₂_refl {r} [is_refl α r] (l : list α) : forall₂ r l l := +lemma forall₂_refl [is_refl α Rₐ] (l : list α) : forall₂ Rₐ l l := forall₂_same.2 $ λ a h, refl _ @[simp] lemma forall₂_eq_eq_eq : forall₂ ((=) : α → α → Prop) = (=) := @@ -55,74 +59,92 @@ begin { rintro rfl, exact forall₂_refl _ } end -@[simp, priority 900] lemma forall₂_nil_left_iff {l} : forall₂ r nil l ↔ l = nil := +@[simp, priority 900] lemma forall₂_nil_left_iff {l} : forall₂ R nil l ↔ l = nil := ⟨λ H, by cases H; refl, by rintro rfl; exact forall₂.nil⟩ -@[simp, priority 900] lemma forall₂_nil_right_iff {l} : forall₂ r l nil ↔ l = nil := +@[simp, priority 900] lemma forall₂_nil_right_iff {l} : forall₂ R l nil ↔ l = nil := ⟨λ H, by cases H; refl, by rintro rfl; exact forall₂.nil⟩ lemma forall₂_cons_left_iff {a l u} : - forall₂ r (a :: l) u ↔ (∃b u', r a b ∧ forall₂ r l u' ∧ u = b :: u') := + forall₂ R (a :: l) u ↔ (∃b u', R a b ∧ forall₂ R l u' ∧ u = b :: u') := iff.intro (λ h, match u, h with (b :: u'), forall₂.cons h₁ h₂ := ⟨b, u', h₁, h₂, rfl⟩ end) (λ h, match u, h with _, ⟨b, u', h₁, h₂, rfl⟩ := forall₂.cons h₁ h₂ end) lemma forall₂_cons_right_iff {b l u} : - forall₂ r u (b :: l) ↔ (∃a u', r a b ∧ forall₂ r u' l ∧ u = a :: u') := + forall₂ R u (b :: l) ↔ (∃a u', R a b ∧ forall₂ R u' l ∧ u = a :: u') := iff.intro (λ h, match u, h with (b :: u'), forall₂.cons h₁ h₂ := ⟨b, u', h₁, h₂, rfl⟩ end) (λ h, match u, h with _, ⟨b, u', h₁, h₂, rfl⟩ := forall₂.cons h₁ h₂ end) -lemma forall₂_and_left {r : α → β → Prop} {p : α → Prop} : - ∀ l u, forall₂ (λa b, p a ∧ r a b) l u ↔ (∀ a∈l, p a) ∧ forall₂ r l u +lemma forall₂_and_left {p : α → Prop} : + ∀ l u, forall₂ (λa b, p a ∧ R a b) l u ↔ (∀ a∈l, p a) ∧ forall₂ R l u | [] u := by simp only [forall₂_nil_left_iff, forall_prop_of_false (not_mem_nil _), imp_true_iff, true_and] | (a :: l) u := by simp only [forall₂_and_left l, forall₂_cons_left_iff, forall_mem_cons, and_assoc, and_comm, and.left_comm, exists_and_distrib_left.symm] @[simp] lemma forall₂_map_left_iff {f : γ → α} : - ∀ {l u}, forall₂ r (map f l) u ↔ forall₂ (λc b, r (f c) b) l u + ∀ {l u}, forall₂ R (map f l) u ↔ forall₂ (λc b, R (f c) b) l u | [] _ := by simp only [map, forall₂_nil_left_iff] | (a :: l) _ := by simp only [map, forall₂_cons_left_iff, forall₂_map_left_iff] @[simp] lemma forall₂_map_right_iff {f : γ → β} : - ∀ {l u}, forall₂ r l (map f u) ↔ forall₂ (λa c, r a (f c)) l u + ∀ {l u}, forall₂ R l (map f u) ↔ forall₂ (λa c, R a (f c)) l u | _ [] := by simp only [map, forall₂_nil_right_iff] | _ (b :: u) := by simp only [map, forall₂_cons_right_iff, forall₂_map_right_iff] -lemma left_unique_forall₂' (hr : left_unique r) : - ∀ {a b c}, forall₂ r a c → forall₂ r b c → a = b +lemma left_unique_forall₂' (hr : left_unique R) : + ∀ {a b c}, forall₂ R a c → forall₂ R b c → a = b | a₀ nil a₁ forall₂.nil forall₂.nil := rfl | (a₀ :: l₀) (b :: l) (a₁ :: l₁) (forall₂.cons ha₀ h₀) (forall₂.cons ha₁ h₁) := hr ha₀ ha₁ ▸ left_unique_forall₂' h₀ h₁ ▸ rfl -lemma _root_.relator.left_unique.forall₂ (hr : left_unique r) : left_unique (forall₂ r) := +lemma _root_.relator.left_unique.forall₂ (hr : left_unique R) : left_unique (forall₂ R) := @left_unique_forall₂' _ _ _ hr -lemma right_unique_forall₂' (hr : right_unique r) : ∀ {a b c}, forall₂ r a b → forall₂ r a c → b = c +lemma right_unique_forall₂' (hr : right_unique R) : ∀ {a b c}, forall₂ R a b → forall₂ R a c → b = c | nil a₀ a₁ forall₂.nil forall₂.nil := rfl | (b :: l) (a₀ :: l₀) (a₁ :: l₁) (forall₂.cons ha₀ h₀) (forall₂.cons ha₁ h₁) := hr ha₀ ha₁ ▸ right_unique_forall₂' h₀ h₁ ▸ rfl -lemma _root_.relator.right_unique.forall₂ (hr : right_unique r) : right_unique (forall₂ r) := +lemma _root_.relator.right_unique.forall₂ (hr : right_unique R) : right_unique (forall₂ R) := @right_unique_forall₂' _ _ _ hr -lemma _root_.relator.bi_unique.forall₂ (hr : bi_unique r) : bi_unique (forall₂ r) := +lemma _root_.relator.bi_unique.forall₂ (hr : bi_unique R) : bi_unique (forall₂ R) := ⟨hr.left.forall₂, hr.right.forall₂⟩ -theorem forall₂_length_eq {R : α → β → Prop} : +theorem forall₂.length_eq : ∀ {l₁ l₂}, forall₂ R l₁ l₂ → length l₁ = length l₂ | _ _ forall₂.nil := rfl -| _ _ (forall₂.cons h₁ h₂) := congr_arg succ (forall₂_length_eq h₂) - -theorem forall₂_zip {R : α → β → Prop} : +| _ _ (forall₂.cons h₁ h₂) := congr_arg succ (forall₂.length_eq h₂) + +theorem forall₂.nth_le : + ∀ {x : list α} {y : list β} (h : forall₂ R x y) ⦃i : ℕ⦄ (hx : i < x.length) (hy : i < y.length), + R (x.nth_le i hx) (y.nth_le i hy) +| (a₁ :: l₁) (a₂ :: l₂) (forall₂.cons ha hl) 0 hx hy := ha +| (a₁ :: l₁) (a₂ :: l₂) (forall₂.cons ha hl) (succ i) hx hy := hl.nth_le _ _ + +lemma forall₂_of_length_eq_of_nth_le : ∀ {x : list α} {y : list β}, + x.length = y.length → (∀ i h₁ h₂, R (x.nth_le i h₁) (y.nth_le i h₂)) → forall₂ R x y +| [] [] hl h := forall₂.nil +| (a₁ :: l₁) (a₂ :: l₂) hl h := forall₂.cons + (h 0 (nat.zero_lt_succ _) (nat.zero_lt_succ _)) + (forall₂_of_length_eq_of_nth_le (succ.inj hl) ( + λ i h₁ h₂, h i.succ (succ_lt_succ h₁) (succ_lt_succ h₂))) + +theorem forall₂_iff_nth_le {l₁ : list α} {l₂ : list β} : + forall₂ R l₁ l₂ ↔ l₁.length = l₂.length ∧ ∀ i h₁ h₂, R (l₁.nth_le i h₁) (l₂.nth_le i h₂) := +⟨λ h, ⟨h.length_eq, h.nth_le⟩, and.rec forall₂_of_length_eq_of_nth_le⟩ + +theorem forall₂_zip : ∀ {l₁ l₂}, forall₂ R l₁ l₂ → ∀ {a b}, (a, b) ∈ zip l₁ l₂ → R a b | _ _ (forall₂.cons h₁ h₂) x y (or.inl rfl) := h₁ | _ _ (forall₂.cons h₁ h₂) x y (or.inr h₃) := forall₂_zip h₂ h₃ -theorem forall₂_iff_zip {R : α → β → Prop} {l₁ l₂} : forall₂ R l₁ l₂ ↔ +theorem forall₂_iff_zip {l₁ l₂} : forall₂ R l₁ l₂ ↔ length l₁ = length l₂ ∧ ∀ {a b}, (a, b) ∈ zip l₁ l₂ → R a b := -⟨λ h, ⟨forall₂_length_eq h, @forall₂_zip _ _ _ _ _ h⟩, +⟨λ h, ⟨forall₂.length_eq h, @forall₂_zip _ _ _ _ _ h⟩, λ h, begin cases h with h₁ h₂, induction l₁ with a l₁ IH generalizing l₂, @@ -131,43 +153,43 @@ theorem forall₂_iff_zip {R : α → β → Prop} {l₁ l₂} : forall₂ R l exact forall₂.cons (h₂ $ or.inl rfl) (IH h₁ $ λ a b h, h₂ $ or.inr h) } end⟩ -theorem forall₂_take {R : α → β → Prop} : +theorem forall₂_take : ∀ n {l₁ l₂}, forall₂ R l₁ l₂ → forall₂ R (take n l₁) (take n l₂) | 0 _ _ _ := by simp only [forall₂.nil, take] | (n+1) _ _ (forall₂.nil) := by simp only [forall₂.nil, take] | (n+1) _ _ (forall₂.cons h₁ h₂) := by simp [and.intro h₁ h₂, forall₂_take n] -theorem forall₂_drop {R : α → β → Prop} : +theorem forall₂_drop : ∀ n {l₁ l₂}, forall₂ R l₁ l₂ → forall₂ R (drop n l₁) (drop n l₂) | 0 _ _ h := by simp only [drop, h] | (n+1) _ _ (forall₂.nil) := by simp only [forall₂.nil, drop] | (n+1) _ _ (forall₂.cons h₁ h₂) := by simp [and.intro h₁ h₂, forall₂_drop n] -theorem forall₂_take_append {R : α → β → Prop} (l : list α) (l₁ : list β) (l₂ : list β) +theorem forall₂_take_append (l : list α) (l₁ : list β) (l₂ : list β) (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (list.take (length l₁) l) l₁ := have h': forall₂ R (take (length l₁) l) (take (length l₁) (l₁ ++ l₂)), from forall₂_take (length l₁) h, by rwa [take_left] at h' -theorem forall₂_drop_append {R : α → β → Prop} (l : list α) (l₁ : list β) (l₂ : list β) +theorem forall₂_drop_append (l : list α) (l₁ : list β) (l₂ : list β) (h : forall₂ R l (l₁ ++ l₂)) : forall₂ R (list.drop (length l₁) l) l₂ := have h': forall₂ R (drop (length l₁) l) (drop (length l₁) (l₁ ++ l₂)), from forall₂_drop (length l₁) h, by rwa [drop_left] at h' -lemma rel_mem (hr : bi_unique r) : (r ⇒ forall₂ r ⇒ iff) (∈) (∈) +lemma rel_mem (hr : bi_unique R) : (R ⇒ forall₂ R ⇒ iff) (∈) (∈) | a b h [] [] forall₂.nil := by simp only [not_mem_nil] | a b h (a' :: as) (b' :: bs) (forall₂.cons h₁ h₂) := rel_or (rel_eq hr h h₁) (rel_mem h h₂) -lemma rel_map : ((r ⇒ p) ⇒ forall₂ r ⇒ forall₂ p) map map +lemma rel_map : ((R ⇒ P) ⇒ forall₂ R ⇒ forall₂ P) map map | f g h [] [] forall₂.nil := forall₂.nil | f g h (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := forall₂.cons (h h₁) (rel_map @h h₂) -lemma rel_append : (forall₂ r ⇒ forall₂ r ⇒ forall₂ r) append append +lemma rel_append : (forall₂ R ⇒ forall₂ R ⇒ forall₂ R) append append | [] [] h l₁ l₂ hl := hl | (a :: as) (b :: bs) (forall₂.cons h₁ h₂) l₁ l₂ hl := forall₂.cons h₁ (rel_append h₂ hl) -lemma rel_reverse : (forall₂ r ⇒ forall₂ r) reverse reverse +lemma rel_reverse : (forall₂ R ⇒ forall₂ R) reverse reverse | [] [] forall₂.nil := forall₂.nil | (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := begin simp only [reverse_cons], @@ -175,29 +197,29 @@ lemma rel_reverse : (forall₂ r ⇒ forall₂ r) reverse reverse end @[simp] -lemma forall₂_reverse_iff {l₁ l₂} : forall₂ r (reverse l₁) (reverse l₂) ↔ forall₂ r l₁ l₂ := +lemma forall₂_reverse_iff {l₁ l₂} : forall₂ R (reverse l₁) (reverse l₂) ↔ forall₂ R l₁ l₂ := iff.intro (λ h, by { rw [← reverse_reverse l₁, ← reverse_reverse l₂], exact rel_reverse h }) (λ h, rel_reverse h) -lemma rel_join : (forall₂ (forall₂ r) ⇒ forall₂ r) join join +lemma rel_join : (forall₂ (forall₂ R) ⇒ forall₂ R) join join | [] [] forall₂.nil := forall₂.nil | (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := rel_append h₁ (rel_join h₂) -lemma rel_bind : (forall₂ r ⇒ (r ⇒ forall₂ p) ⇒ forall₂ p) list.bind list.bind := +lemma rel_bind : (forall₂ R ⇒ (R ⇒ forall₂ P) ⇒ forall₂ P) list.bind list.bind := λ a b h₁ f g h₂, rel_join (rel_map @h₂ h₁) -lemma rel_foldl : ((p ⇒ r ⇒ p) ⇒ p ⇒ forall₂ r ⇒ p) foldl foldl +lemma rel_foldl : ((P ⇒ R ⇒ P) ⇒ P ⇒ forall₂ R ⇒ P) foldl foldl | f g hfg _ _ h _ _ forall₂.nil := h | f g hfg x y hxy _ _ (forall₂.cons hab hs) := rel_foldl @hfg (hfg hxy hab) hs -lemma rel_foldr : ((r ⇒ p ⇒ p) ⇒ p ⇒ forall₂ r ⇒ p) foldr foldr +lemma rel_foldr : ((R ⇒ P ⇒ P) ⇒ P ⇒ forall₂ R ⇒ P) foldr foldr | f g hfg _ _ h _ _ forall₂.nil := h | f g hfg x y hxy _ _ (forall₂.cons hab hs) := hfg hab (rel_foldr @hfg hxy hs) lemma rel_filter {p : α → Prop} {q : β → Prop} [decidable_pred p] [decidable_pred q] - (hpq : (r ⇒ (↔)) p q) : - (forall₂ r ⇒ forall₂ r) (filter p) (filter q) + (hpq : (R ⇒ (↔)) p q) : + (forall₂ R ⇒ forall₂ R) (filter p) (filter q) | _ _ forall₂.nil := forall₂.nil | (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := begin @@ -209,7 +231,7 @@ lemma rel_filter {p : α → Prop} {q : β → Prop} [decidable_pred p] [decidab simp only [filter_cons_of_neg _ h, filter_cons_of_neg _ this, rel_filter h₂], }, end -lemma rel_filter_map : ((r ⇒ option.rel p) ⇒ forall₂ r ⇒ forall₂ p) filter_map filter_map +lemma rel_filter_map : ((R ⇒ option.rel P) ⇒ forall₂ R ⇒ forall₂ P) filter_map filter_map | f g hfg _ _ forall₂.nil := forall₂.nil | f g hfg (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := by rw [filter_map_cons, filter_map_cons]; @@ -220,19 +242,19 @@ lemma rel_filter_map : ((r ⇒ option.rel p) ⇒ forall₂ r ⇒ forall₂ p) fi @[to_additive] lemma rel_prod [monoid α] [monoid β] - (h : r 1 1) (hf : (r ⇒ r ⇒ r) (*) (*)) : (forall₂ r ⇒ r) prod prod := + (h : R 1 1) (hf : (R ⇒ R ⇒ R) (*) (*)) : (forall₂ R ⇒ R) prod prod := rel_foldl hf h -/-- Given a relation `r`, `sublist_forall₂ r l₁ l₂` indicates that there is a sublist of `l₂` such +/-- Given a relation `R`, `sublist_forall₂ r l₁ l₂` indicates that there is a sublist of `l₂` such that `forall₂ r l₁ l₂`. -/ -inductive sublist_forall₂ (r : α → β → Prop) : list α → list β → Prop +inductive sublist_forall₂ (R : α → β → Prop) : list α → list β → Prop | nil {l} : sublist_forall₂ [] l -| cons {a₁ a₂ l₁ l₂} : r a₁ a₂ → sublist_forall₂ l₁ l₂ → +| cons {a₁ a₂ l₁ l₂} : R a₁ a₂ → sublist_forall₂ l₁ l₂ → sublist_forall₂ (a₁ :: l₁) (a₂ :: l₂) | cons_right {a l₁ l₂} : sublist_forall₂ l₁ l₂ → sublist_forall₂ l₁ (a :: l₂) lemma sublist_forall₂_iff {l₁ : list α} {l₂ : list β} : - sublist_forall₂ r l₁ l₂ ↔ ∃ l, forall₂ r l₁ l ∧ l <+ l₂ := + sublist_forall₂ R l₁ l₂ ↔ ∃ l, forall₂ R l₁ l ∧ l <+ l₂ := begin split; intro h, { induction h with _ a b l1 l2 rab rll ih b l1 l2 hl ih, @@ -251,14 +273,12 @@ begin exact sublist_forall₂.cons hr (ih hl) } } end -variable {ra : α → α → Prop} - -instance sublist_forall₂.is_refl [is_refl α ra] : - is_refl (list α) (sublist_forall₂ ra) := +instance sublist_forall₂.is_refl [is_refl α Rₐ] : + is_refl (list α) (sublist_forall₂ Rₐ) := ⟨λ l, sublist_forall₂_iff.2 ⟨l, forall₂_refl l, sublist.refl l⟩⟩ -instance sublist_forall₂.is_trans [is_trans α ra] : - is_trans (list α) (sublist_forall₂ ra) := +instance sublist_forall₂.is_trans [is_trans α Rₐ] : + is_trans (list α) (sublist_forall₂ Rₐ) := ⟨λ a b c, begin revert a b, induction c with _ _ ih, @@ -275,12 +295,12 @@ instance sublist_forall₂.is_trans [is_trans α ra] : { exact sublist_forall₂.cons_right (ih _ _ h1 btc), } } end⟩ -lemma sublist.sublist_forall₂ {l₁ l₂ : list α} (h : l₁ <+ l₂) (r : α → α → Prop) [is_refl α r] : - sublist_forall₂ r l₁ l₂ := +lemma sublist.sublist_forall₂ {l₁ l₂ : list α} (h : l₁ <+ l₂) [is_refl α Rₐ] : + sublist_forall₂ Rₐ l₁ l₂ := sublist_forall₂_iff.2 ⟨l₁, forall₂_refl l₁, h⟩ -lemma tail_sublist_forall₂_self [is_refl α ra] (l : list α) : - sublist_forall₂ ra l.tail l := -l.tail_sublist.sublist_forall₂ ra +lemma tail_sublist_forall₂_self [is_refl α Rₐ] (l : list α) : + sublist_forall₂ Rₐ l.tail l := +l.tail_sublist.sublist_forall₂ end list diff --git a/src/data/list/func.lean b/src/data/list/func.lean index acc07aa763c6d..b43eda69369a4 100644 --- a/src/data/list/func.lean +++ b/src/data/list/func.lean @@ -3,11 +3,14 @@ Copyright (c) 2019 Seul Baek. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Seul Baek -/ -import data.nat.basic +import data.nat.order.basic /-! # Lists as Functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Definitions for using lists as finite representations of finitely-supported functions with domain ℕ. @@ -50,7 +53,8 @@ elements | (h::as) (k+1) := h::(set as k) | [] (k+1) := default::(set ([] : list α) k) -localized "notation as ` {` m ` ↦ ` a `}` := list.func.set a as m" in list.func +localized "notation (name := list.func.set) + as ` {` m ` ↦ ` a `}` := list.func.set a as m" in list.func /-- Get element of a list by index. If the index is out of range, return the default element -/ @[simp] def get : ℕ → list α → α @@ -350,7 +354,7 @@ by {apply get_pointwise, apply sub_zero} (sub xs ys).length = max xs.length ys.length := @length_pointwise α α α ⟨0⟩ ⟨0⟩ _ _ _ -@[simp] lemma nil_sub {α : Type} [add_group α] +@[simp] lemma nil_sub {α : Type*} [add_group α] (as : list α) : sub [] as = neg as := begin rw [sub, nil_pointwise], @@ -358,7 +362,7 @@ begin rw [zero_sub] end -@[simp] lemma sub_nil {α : Type} [add_group α] +@[simp] lemma sub_nil {α : Type*} [add_group α] (as : list α) : sub as [] = as := begin rw [sub, pointwise_nil], diff --git a/src/data/list/indexes.lean b/src/data/list/indexes.lean index f8aa55881c805..f8264c39876d8 100644 --- a/src/data/list/indexes.lean +++ b/src/data/list/indexes.lean @@ -3,11 +3,15 @@ Copyright (c) 2020 Jannis Limperg. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jannis Limperg -/ +import data.list.of_fn import data.list.range /-! # Lemmas about list.*_with_index functions. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Some specification lemmas for `list.map_with_index`, `list.mmap_with_index`, `list.foldl_with_index` and `list.foldr_with_index`. -/ @@ -49,6 +53,14 @@ end by simp [map_with_index_eq_enum_map, enum_eq_zip_range, map_uncurry_zip_eq_zip_with, range_succ_eq_map, zip_with_map_left] +lemma map_with_index_append {α} (K L : list α) (f : ℕ → α → β) : + (K ++ L).map_with_index f = K.map_with_index f ++ L.map_with_index (λ i a, f (i + K.length) a) := +begin + induction K with a J IH generalizing f, + { simp }, + { simp [IH (λ i, f (i+1)), add_assoc], } +end + @[simp] lemma length_map_with_index {α β} (l : list α) (f : ℕ → α → β) : (l.map_with_index f).length = l.length := begin diff --git a/src/data/list/infix.lean b/src/data/list/infix.lean index 77d71611c4aec..89bb5ba243d14 100644 --- a/src/data/list/infix.lean +++ b/src/data/list/infix.lean @@ -8,6 +8,9 @@ import data.list.basic /-! # Prefixes, subfixes, infixes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves properties about * `list.prefix`: `l₁` is a prefix of `l₂` if `l₂` starts with `l₁`. * `list.subfix`: `l₁` is a subfix of `l₂` if `l₂` ends with `l₁`. @@ -79,8 +82,20 @@ lemma infix_concat : l₁ <:+: l₂ → l₁ <:+: concat l₂ a := protected lemma is_infix.sublist : l₁ <:+: l₂ → l₁ <+ l₂ := λ ⟨s, t, h⟩, by { rw [← h], exact (sublist_append_right _ _).trans (sublist_append_left _ _) } -protected lemma is_prefix.sublist (h : l₁ <+: l₂) : l₁ <+ l₂ := h.is_infix.sublist -protected lemma is_suffix.sublist (h : l₁ <:+ l₂) : l₁ <+ l₂ := h.is_infix.sublist +protected lemma is_infix.subset (hl : l₁ <:+: l₂) : l₁ ⊆ l₂ := +hl.sublist.subset + +protected lemma is_prefix.sublist (h : l₁ <+: l₂) : l₁ <+ l₂ := +h.is_infix.sublist + +protected lemma is_prefix.subset (hl : l₁ <+: l₂) : l₁ ⊆ l₂ := +hl.sublist.subset + +protected lemma is_suffix.sublist (h : l₁ <:+ l₂) : l₁ <+ l₂ := +h.is_infix.sublist + +protected lemma is_suffix.subset (hl : l₁ <:+ l₂) : l₁ ⊆ l₂ := +hl.sublist.subset @[simp] lemma reverse_suffix : reverse l₁ <:+ reverse l₂ ↔ l₁ <+: l₂ := ⟨λ ⟨r, e⟩, ⟨reverse r, @@ -97,20 +112,20 @@ by rw ← reverse_suffix; simp only [reverse_reverse] λ ⟨s, t, e⟩, ⟨reverse t, reverse s, by rw [append_assoc, ← reverse_append, ← reverse_append, e]⟩⟩ -alias reverse_prefix ↔ _ list.is_suffix.reverse -alias reverse_suffix ↔ _ list.is_prefix.reverse -alias reverse_infix ↔ _ list.is_infix.reverse +alias reverse_prefix ↔ _ is_suffix.reverse +alias reverse_suffix ↔ _ is_prefix.reverse +alias reverse_infix ↔ _ is_infix.reverse -lemma is_infix.length_le (h : l₁ <:+: l₂) : l₁.length ≤ l₂.length := length_le_of_sublist h.sublist -lemma is_prefix.length_le (h : l₁ <+: l₂) : l₁.length ≤ l₂.length := length_le_of_sublist h.sublist -lemma is_suffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length := length_le_of_sublist h.sublist +lemma is_infix.length_le (h : l₁ <:+: l₂) : l₁.length ≤ l₂.length := h.sublist.length_le +lemma is_prefix.length_le (h : l₁ <+: l₂) : l₁.length ≤ l₂.length := h.sublist.length_le +lemma is_suffix.length_le (h : l₁ <:+ l₂) : l₁.length ≤ l₂.length := h.sublist.length_le lemma eq_nil_of_infix_nil (h : l <:+: []) : l = [] := eq_nil_of_sublist_nil h.sublist @[simp] lemma infix_nil_iff : l <:+: [] ↔ l = [] := ⟨λ h, eq_nil_of_sublist_nil h.sublist, λ h, h ▸ infix_rfl⟩ -alias infix_nil_iff ↔ list.eq_nil_of_infix_nil _ +alias infix_nil_iff ↔ eq_nil_of_infix_nil _ @[simp] lemma prefix_nil_iff : l <+: [] ↔ l = [] := ⟨λ h, eq_nil_of_infix_nil h.is_infix, λ h, h ▸ prefix_rfl⟩ @@ -118,21 +133,21 @@ alias infix_nil_iff ↔ list.eq_nil_of_infix_nil _ @[simp] lemma suffix_nil_iff : l <:+ [] ↔ l = [] := ⟨λ h, eq_nil_of_infix_nil h.is_infix, λ h, h ▸ suffix_rfl⟩ -alias prefix_nil_iff ↔ list.eq_nil_of_prefix_nil _ -alias suffix_nil_iff ↔ list.eq_nil_of_suffix_nil _ +alias prefix_nil_iff ↔ eq_nil_of_prefix_nil _ +alias suffix_nil_iff ↔ eq_nil_of_suffix_nil _ lemma infix_iff_prefix_suffix (l₁ l₂ : list α) : l₁ <:+: l₂ ↔ ∃ t, l₁ <+: t ∧ t <:+ l₂ := ⟨λ ⟨s, t, e⟩, ⟨l₁ ++ t, ⟨_, rfl⟩, by rw [← e, append_assoc]; exact ⟨_, rfl⟩⟩, λ ⟨._, ⟨t, rfl⟩, s, e⟩, ⟨s, t, by rw append_assoc; exact e⟩⟩ lemma eq_of_infix_of_length_eq (h : l₁ <:+: l₂) : l₁.length = l₂.length → l₁ = l₂ := -eq_of_sublist_of_length_eq h.sublist +h.sublist.eq_of_length lemma eq_of_prefix_of_length_eq (h : l₁ <+: l₂) : l₁.length = l₂.length → l₁ = l₂ := -eq_of_sublist_of_length_eq h.sublist +h.sublist.eq_of_length lemma eq_of_suffix_of_length_eq (h : l₁ <:+ l₂) : l₁.length = l₂.length → l₁ = l₂ := -eq_of_sublist_of_length_eq h.sublist +h.sublist.eq_of_length lemma prefix_of_prefix_length_le : ∀ {l₁ l₂ l₃ : list α}, l₁ <+: l₃ → l₂ <+: l₃ → length l₁ ≤ length l₂ → l₁ <+: l₂ @@ -200,6 +215,23 @@ lemma drop_subset (n) (l : list α) : drop n l ⊆ l := (drop_sublist n l).subse lemma mem_of_mem_take (h : a ∈ l.take n) : a ∈ l := take_subset n l h lemma mem_of_mem_drop (h : a ∈ l.drop n) : a ∈ l := drop_subset n l h +lemma slice_sublist (n m : ℕ) (l : list α) : l.slice n m <+ l := +begin + rw list.slice_eq, + conv_rhs {rw ←list.take_append_drop n l}, + rw [list.append_sublist_append_left, add_comm, list.drop_add], + exact list.drop_sublist _ _, +end +lemma slice_subset (n m : ℕ) (l : list α) : l.slice n m ⊆ l := (slice_sublist n m l).subset +lemma mem_of_mem_slice {n m : ℕ} {l : list α} {a : α} (h : a ∈ l.slice n m) : a ∈ l := +slice_subset n m l h + +lemma take_while_prefix (p : α → Prop) [decidable_pred p] : l.take_while p <+: l := +⟨l.drop_while p, take_while_append_drop p l⟩ + +lemma drop_while_suffix (p : α → Prop) [decidable_pred p] : l.drop_while p <:+ l := +⟨l.take_while p, take_while_append_drop p l⟩ + lemma init_prefix : ∀ (l : list α), l.init <+: l | [] := ⟨nil, by rw [init, list.append_nil]⟩ | (a :: l) := ⟨_, init_append_last (cons_ne_nil a l)⟩ @@ -241,7 +273,7 @@ instance decidable_prefix [decidable_eq α] : ∀ (l₁ l₂ : list α), decidab -- Alternatively, use mem_tails instance decidable_suffix [decidable_eq α] : ∀ (l₁ l₂ : list α), decidable (l₁ <:+ l₂) | [] l₂ := is_true ⟨l₂, append_nil _⟩ -| (a :: l₁) [] := is_false $ mt (length_le_of_sublist ∘ is_suffix.sublist) dec_trivial +| (a :: l₁) [] := is_false $ mt (sublist.length_le ∘ is_suffix.sublist) dec_trivial | l₁ (b :: l₂) := decidable_of_decidable_of_iff (@or.decidable _ _ _ (l₁.decidable_suffix l₂)) suffix_cons_iff.symm @@ -493,4 +525,8 @@ congr_arg _ $ insert_of_mem h congr_arg _ $ insert_of_not_mem h end insert + +lemma mem_of_mem_suffix (hx : a ∈ l₁) (hl : l₁ <:+ l₂) : a ∈ l₂ := +hl.subset hx + end list diff --git a/src/data/list/intervals.lean b/src/data/list/intervals.lean index 0ece01cfaa3ef..0e6984b4b3ccd 100644 --- a/src/data/list/intervals.lean +++ b/src/data/list/intervals.lean @@ -9,6 +9,9 @@ import data.list.range /-! # Intervals in ℕ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines intervals of naturals. `list.Ico m n` is the list of integers greater than `m` and strictly less than `n`. diff --git a/src/data/list/join.lean b/src/data/list/join.lean index ce40ff0e8c20c..eaeca717c8225 100644 --- a/src/data/list/join.lean +++ b/src/data/list/join.lean @@ -1,13 +1,16 @@ /- Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Sébastien Gouëzel, Floris van Doorn, Mario Carneiro +Authors: Sébastien Gouëzel, Floris van Doorn, Mario Carneiro, Martin Dvorak -/ -import data.list.big_operators +import data.list.big_operators.basic /-! # Join of a list of lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic properties of `list.join`, which concatenates a list of lists. It is defined in [`data.list.defs`](./defs). -/ @@ -18,7 +21,8 @@ namespace list attribute [simp] join -@[simp] lemma join_nil : [([] : list α)].join = [] := rfl +@[simp] lemma join_singleton (l : list α) : [l].join = l := +by rw [join, join, append_nil] @[simp] lemma join_eq_nil : ∀ {L : list (list α)}, join L = [] ↔ ∀ l ∈ L, l = [] | [] := iff_of_true rfl (forall_mem_nil _) @@ -27,6 +31,9 @@ attribute [simp] join @[simp] lemma join_append (L₁ L₂ : list (list α)) : join (L₁ ++ L₂) = join L₁ ++ join L₂ := by induction L₁; [refl, simp only [*, join, cons_append, append_assoc]] +lemma join_concat (L : list (list α)) (l : list α) : join (L.concat l) = join L ++ l := +by simp + @[simp] lemma join_filter_empty_eq_ff [decidable_pred (λ l : list α, l.empty = ff)] : ∀ {L : list (list α)}, join (L.filter (λ l, l.empty = ff)) = L.join | [] := rfl @@ -136,4 +143,36 @@ begin rw [← drop_take_succ_join_eq_nth_le, ← drop_take_succ_join_eq_nth_le, join_eq, length_eq] } end +lemma join_drop_length_sub_one {L : list (list α)} (h : L ≠ []) : + (L.drop (L.length - 1)).join = L.last h := +begin + induction L using list.reverse_rec_on, + { cases h rfl }, + { simp }, +end + +/-- We can rebracket `x ++ (l₁ ++ x) ++ (l₂ ++ x) ++ ... ++ (lₙ ++ x)` to +`(x ++ l₁) ++ (x ++ l₂) ++ ... ++ (x ++ lₙ) ++ x` where `L = [l₁, l₂, ..., lₙ]`. -/ +lemma append_join_map_append (L : list (list α)) (x : list α) : + x ++ (list.map (λ l, l ++ x) L).join = (list.map (λ l, x ++ l) L).join ++ x := +begin + induction L, + { rw [map_nil, join, append_nil, map_nil, join, nil_append] }, + { rw [map_cons, join, map_cons, join, append_assoc, L_ih, append_assoc, append_assoc] }, +end + +/-- Reversing a join is the same as reversing the order of parts and reversing all parts. -/ +lemma reverse_join (L : list (list α)) : + L.join.reverse = (list.map list.reverse L).reverse.join := +begin + induction L, + { refl }, + { rw [join, reverse_append, L_ih, map_cons, reverse_cons', join_concat] }, +end + +/-- Joining a reverse is the same as reversing all parts and reversing the joined result. -/ +lemma join_reverse (L : list (list α)) : + L.reverse.join = (list.map list.reverse L).join.reverse := +by simpa [reverse_reverse] using congr_arg list.reverse (reverse_join L.reverse) + end list diff --git a/src/data/list/lattice.lean b/src/data/list/lattice.lean index 5cc1b81d6474a..63d95e20fa561 100644 --- a/src/data/list/lattice.lean +++ b/src/data/list/lattice.lean @@ -6,10 +6,14 @@ Scott Morrison -/ import data.list.count import data.list.infix +import algebra.order.monoid.min_max /-! # Lattice structure of lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This files prove basic properties about `list.disjoint`, `list.union`, `list.inter` and `list.bag_inter`, which are defined in core Lean and `data.list.defs`. @@ -239,30 +243,25 @@ end ∀ {l₁ l₂ : list α}, count a (l₁.bag_inter l₂) = min (count a l₁) (count a l₂) | [] l₂ := by simp | l₁ [] := by simp -| (h₁ :: l₁) (h₂ :: l₂) := +| (b :: l₁) l₂ := begin - simp only [list.bag_inter, list.mem_cons_iff], - by_cases p₁ : h₂ = h₁; by_cases p₂ : h₁ = a, - { simp only [p₁, p₂, count_bag_inter, min_succ_succ, erase_cons_head, if_true, mem_cons_iff, - count_cons_self, true_or, eq_self_iff_true] }, - { simp only [p₁, ne.symm p₂, count_bag_inter, count_cons, erase_cons_head, if_true, mem_cons_iff, - true_or, eq_self_iff_true, if_false] }, - { rw p₂ at p₁, - by_cases p₃ : a ∈ l₂, - { simp only [p₁, ne.symm p₁, p₂, p₃, erase_cons, count_bag_inter, eq.symm (min_succ_succ _ _), - succ_pred_eq_of_pos (count_pos.2 p₃), if_true, mem_cons_iff, false_or, - count_cons_self, eq_self_iff_true, if_false, ne.def, not_false_iff, - count_erase_self, list.count_cons_of_ne] }, - { simp [ne.symm p₁, p₂, p₃] } }, - { by_cases p₄ : h₁ ∈ l₂; simp only [ne.symm p₁, ne.symm p₂, p₄, count_bag_inter, if_true, - if_false, mem_cons_iff, false_or, eq_self_iff_true, ne.def, not_false_iff,count_erase_of_ne, - count_cons_of_ne] } + by_cases hb : b ∈ l₂, + { rw [cons_bag_inter_of_pos _ hb, count_cons', count_cons', count_bag_inter, count_erase, + ← min_add_add_right], + by_cases ab : a = b, + { rw [if_pos ab, tsub_add_cancel_of_le], + rwa [succ_le_iff, count_pos, ab] }, + { rw [if_neg ab, tsub_zero, add_zero, add_zero] } }, + { rw [cons_bag_inter_of_neg _ hb, count_bag_inter], + by_cases ab : a = b, + { rw [← ab] at hb, rw [count_eq_zero.2 hb, min_zero, min_zero] }, + { rw [count_cons_of_ne ab] } }, end lemma bag_inter_sublist_left : ∀ l₁ l₂ : list α, l₁.bag_inter l₂ <+ l₁ -| [] l₂ := by simp [nil_sublist] +| [] l₂ := by simp | (b :: l₁) l₂ := begin - by_cases b ∈ l₂; simp [h], + by_cases b ∈ l₂; simp only [h, cons_bag_inter_of_pos, cons_bag_inter_of_neg, not_false_iff], { exact (bag_inter_sublist_left _ _).cons_cons _ }, { apply sublist_cons_of_sublist, apply bag_inter_sublist_left } end diff --git a/src/data/list/lemmas.lean b/src/data/list/lemmas.lean new file mode 100644 index 0000000000000..fc3df77ce584f --- /dev/null +++ b/src/data/list/lemmas.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2021 Yakov Pechersky. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yakov Pechersky, Yury Kudryashov +-/ +import data.set.function +import data.list.basic + +/-! # Some lemmas about lists involving sets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Split out from `data.list.basic` to reduce its dependencies. +-/ + +open list + +variables {α β γ : Type*} + +namespace list + +lemma inj_on_insert_nth_index_of_not_mem (l : list α) (x : α) (hx : x ∉ l) : + set.inj_on (λ k, insert_nth k x l) {n | n ≤ l.length} := +begin + induction l with hd tl IH, + { intros n hn m hm h, + simp only [set.mem_singleton_iff, set.set_of_eq_eq_singleton, length, nonpos_iff_eq_zero] + at hn hm, + simp [hn, hm] }, + { intros n hn m hm h, + simp only [length, set.mem_set_of_eq] at hn hm, + simp only [mem_cons_iff, not_or_distrib] at hx, + cases n; + cases m, + { refl }, + { simpa [hx.left] using h }, + { simpa [ne.symm hx.left] using h }, + { simp only [true_and, eq_self_iff_true, insert_nth_succ_cons] at h, + rw nat.succ_inj', + refine IH hx.right _ _ h, + { simpa [nat.succ_le_succ_iff] using hn }, + { simpa [nat.succ_le_succ_iff] using hm } } } +end + +lemma foldr_range_subset_of_range_subset {f : β → α → α} {g : γ → α → α} + (hfg : set.range f ⊆ set.range g) (a : α) : + set.range (foldr f a) ⊆ set.range (foldr g a) := +begin + rintro _ ⟨l, rfl⟩, + induction l with b l H, + { exact ⟨[], rfl⟩ }, + { cases hfg (set.mem_range_self b) with c hgf, + cases H with m hgf', + rw [foldr_cons, ←hgf, ←hgf'], + exact ⟨c :: m, rfl⟩ } +end + +lemma foldl_range_subset_of_range_subset {f : α → β → α} {g : α → γ → α} + (hfg : set.range (λ a c, f c a) ⊆ set.range (λ b c, g c b)) (a : α) : + set.range (foldl f a) ⊆ set.range (foldl g a) := +begin + change set.range (λ l, _) ⊆ set.range (λ l, _), + simp_rw ←foldr_reverse at hfg ⊢, + simp_rw [set.range_comp _ list.reverse, reverse_involutive.bijective.surjective.range_eq, + set.image_univ], + exact foldr_range_subset_of_range_subset hfg a, +end + +lemma foldr_range_eq_of_range_eq {f : β → α → α} {g : γ → α → α} (hfg : set.range f = set.range g) + (a : α) : + set.range (foldr f a) = set.range (foldr g a) := +(foldr_range_subset_of_range_subset hfg.le a).antisymm (foldr_range_subset_of_range_subset hfg.ge a) + +lemma foldl_range_eq_of_range_eq {f : α → β → α} {g : α → γ → α} + (hfg : set.range (λ a c, f c a) = set.range (λ b c, g c b)) (a : α) : + set.range (foldl f a) = set.range (foldl g a) := +(foldl_range_subset_of_range_subset hfg.le a).antisymm (foldl_range_subset_of_range_subset hfg.ge a) + +end list diff --git a/src/data/list/lex.lean b/src/data/list/lex.lean index 94c94d83bb149..3a0c574b37557 100644 --- a/src/data/list/lex.lean +++ b/src/data/list/lex.lean @@ -8,6 +8,9 @@ import order.rel_classes /-! # Lexicographic ordering of lists. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The lexicographic order on `list α` is defined by `L < M` iff * `[] < (a :: L)` for any `a` and `L`, * `(a :: L) < (b :: M)` where `a < b`, or @@ -18,8 +21,9 @@ The lexicographic order on `list α` is defined by `L < M` iff Related files are: * `data.finset.colex`: Colexicographic order on finite sets. * `data.psigma.order`: Lexicographic order on `Σ' i, α i`. +* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`. * `data.sigma.order`: Lexicographic order on `Σ i, α i`. -* `order.lexicographic`: Lexicographic order on `α × β`. +* `data.prod.lex`: Lexicographic order on `α × β`. -/ namespace list @@ -92,7 +96,7 @@ instance is_asymm (r : α → α → Prop) end⟩ instance is_strict_total_order (r : α → α → Prop) - [is_strict_total_order' α r] : is_strict_total_order' (list α) (lex r) := + [is_strict_total_order α r] : is_strict_total_order (list α) (lex r) := {..is_strict_weak_order_of_is_order_connected} instance decidable_rel [decidable_eq α] (r : α → α → Prop) @@ -105,7 +109,7 @@ instance decidable_rel [decidable_eq α] (r : α → α → Prop) { rcases h with h | ⟨rfl, h⟩, { exact lex.rel h }, { exact lex.cons h } }, - { rcases h with _|⟨_,_,_,h⟩|⟨_,_,_,_,h⟩, + { rcases h with _ | h | h, { exact or.inr ⟨rfl, h⟩ }, { exact or.inl h } } end @@ -156,7 +160,7 @@ theorem nil_lt_cons [has_lt α] (a : α) (l : list α) : [] < a :: l := lex.nil instance [linear_order α] : linear_order (list α) := -linear_order_of_STO' (lex (<)) +linear_order_of_STO (lex (<)) --Note: this overrides an instance in core lean instance has_le' [linear_order α] : has_le (list α) := diff --git a/src/data/list/min_max.lean b/src/data/list/min_max.lean index c79f23e5b76c8..734c8f1320542 100644 --- a/src/data/list/min_max.lean +++ b/src/data/list/min_max.lean @@ -1,12 +1,16 @@ /- Copyright (c) 2019 Minchao Wu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Minchao Wu, Chris Hughes +Authors: Minchao Wu, Chris Hughes, Mantas Bakšys -/ import data.list.basic + /-! # Minimum and maximum of lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions The main definitions are `argmax`, `argmin`, `minimum` and `maximum` for lists. @@ -18,134 +22,139 @@ The main definitions are `argmax`, `argmin`, `minimum` and `maximum` for lists. `minimum l` returns an `with_top α`, the smallest element of `l` for nonempty lists, and `⊤` for `[]` -/ -namespace list -variables {α : Type*} {β : Type*} [linear_order β] - -/-- Auxiliary definition to define `argmax` -/ -def argmax₂ (f : α → β) (a : option α) (b : α) : option α := -option.cases_on a (some b) (λ c, if f b ≤ f c then some c else some b) - -/-- `argmax f l` returns `some a`, where `a` of `l` that maximises `f a`. If there are `a b` such -that `f a = f b`, it returns whichever of `a` or `b` comes first in the list. -`argmax f []` = none` -/ -def argmax (f : α → β) (l : list α) : option α := -l.foldl (argmax₂ f) none - -/-- `argmin f l` returns `some a`, where `a` of `l` that minimises `f a`. If there are `a b` such -that `f a = f b`, it returns whichever of `a` or `b` comes first in the list. -`argmin f []` = none` -/ -def argmin (f : α → β) (l : list α) := @argmax _ βᵒᵈ _ f l - -@[simp] lemma argmax_two_self (f : α → β) (a : α) : argmax₂ f (some a) a = a := -if_pos le_rfl -@[simp] lemma argmax_nil (f : α → β) : argmax f [] = none := rfl +namespace list -@[simp] lemma argmin_nil (f : α → β) : argmin f [] = none := rfl +variables {α β : Type*} -@[simp] lemma argmax_singleton {f : α → β} {a : α} : argmax f [a] = some a := rfl +section arg_aux +variables (r : α → α → Prop) [decidable_rel r] {l : list α} {o : option α} {a m : α} -@[simp] lemma argmin_singleton {f : α → β} {a : α} : argmin f [a] = a := rfl +/-- Auxiliary definition for `argmax` and `argmin`. -/ +def arg_aux (a : option α) (b : α) : option α := +option.cases_on a (some b) $ λ c, if r b c then some b else some c -@[simp] lemma foldl_argmax₂_eq_none {f : α → β} {l : list α} {o : option α} : - l.foldl (argmax₂ f) o = none ↔ l = [] ∧ o = none := +@[simp] lemma foldl_arg_aux_eq_none : + l.foldl (arg_aux r) o = none ↔ l = [] ∧ o = none := list.reverse_rec_on l (by simp) $ - (assume tl hd, by simp [argmax₂]; - cases foldl (argmax₂ f) o tl; simp; try {split_ifs}; simp) - -private theorem le_of_foldl_argmax₂ {f : α → β} {l} : Π {a m : α} {o : option α}, a ∈ l → - m ∈ foldl (argmax₂ f) o l → f a ≤ f m := -list.reverse_rec_on l - (λ _ _ _ h, absurd h $ not_mem_nil _) - begin - intros tl _ ih _ _ _ h ho, - rw [foldl_append, foldl_cons, foldl_nil, argmax₂] at ho, - cases hf : foldl (argmax₂ f) o tl, - { rw [hf] at ho, - rw [foldl_argmax₂_eq_none] at hf, - simp [hf.1, hf.2, *] at * }, - rw [hf, option.mem_def] at ho, - dsimp only at ho, - cases mem_append.1 h with h h, - { refine le_trans (ih h hf) _, - have := @le_of_lt _ _ (f val) (f m), - split_ifs at ho; - simp * at * }, - { split_ifs at ho; - simp * at * } - end + (assume tl hd, by simp [arg_aux]; + cases foldl (arg_aux r) o tl; simp; try {split_ifs}; simp) -private theorem foldl_argmax₂_mem (f : α → β) (l) : Π (a m : α), - m ∈ foldl (argmax₂ f) (some a) l → m ∈ a :: l := +private lemma foldl_arg_aux_mem (l) : Π (a m : α), + m ∈ foldl (arg_aux r) (some a) l → m ∈ a :: l := list.reverse_rec_on l (by simp [eq_comm]) begin assume tl hd ih a m, - simp only [foldl_append, foldl_cons, foldl_nil, argmax₂], - cases hf : foldl (argmax₂ f) (some a) tl, + simp only [foldl_append, foldl_cons, foldl_nil, arg_aux], + cases hf : foldl (arg_aux r) (some a) tl, { simp {contextual := tt} }, { dsimp only, split_ifs, + { simp {contextual := tt} }, { -- `finish [ih _ _ hf]` closes this goal rcases ih _ _ hf with rfl | H, { simp only [mem_cons_iff, mem_append, mem_singleton, option.mem_def], tauto }, { apply λ hm, or.inr (list.mem_append.mpr $ or.inl _), - exact (option.mem_some_iff.mp hm ▸ H)} }, - { simp {contextual := tt} } } + exact (option.mem_some_iff.mp hm ▸ H)} } } end -theorem argmax_mem {f : α → β} : Π {l : list α} {m : α}, m ∈ argmax f l → m ∈ l -| [] m := by simp -| (hd::tl) m := by simpa [argmax, argmax₂] using foldl_argmax₂_mem f tl hd m +@[simp] lemma arg_aux_self (hr₀ : irreflexive r) (a : α) : arg_aux r (some a) a = a := +if_neg $ hr₀ _ + +lemma not_of_mem_foldl_arg_aux (hr₀ : irreflexive r) (hr₁ : transitive r) : + Π {a m : α} {o : option α}, a ∈ l → m ∈ foldl (arg_aux r) o l → ¬ r a m := +begin + induction l using list.reverse_rec_on with tl a ih, + { exact λ _ _ _ h, absurd h $ not_mem_nil _ }, + intros b m o hb ho, + rw [foldl_append, foldl_cons, foldl_nil, arg_aux] at ho, + cases hf : foldl (arg_aux r) o tl with c, + { rw [hf] at ho, + rw [foldl_arg_aux_eq_none] at hf, + simp [hf.1, hf.2, *, hr₀ _] at * }, + rw [hf, option.mem_def] at ho, + dsimp only at ho, + split_ifs at ho with hac hac; cases mem_append.1 hb with h h; subst ho, + { exact λ hba, ih h hf (hr₁ hba hac) }, + { simp [*, hr₀ _] at * }, + { exact ih h hf }, + { simp * at * } +end + +end arg_aux + +section preorder +variables [preorder β] [@decidable_rel β (<)] {f : α → β} {l : list α} {o : option α} {a m : α} + +/-- `argmax f l` returns `some a`, where `f a` is maximal among the elements of `l`, in the sense +that there is no `b ∈ l` with `f a < f b`. If `a`, `b` are such that `f a = f b`, it returns +whichever of `a` or `b` comes first in the list. `argmax f []` = none`. -/ +def argmax (f : α → β) (l : list α) : option α := l.foldl (arg_aux $ λ b c, f c < f b) none -theorem argmin_mem {f : α → β} : Π {l : list α} {m : α}, m ∈ argmin f l → m ∈ l := -@argmax_mem _ βᵒᵈ _ _ +/-- `argmin f l` returns `some a`, where `f a` is minimal among the elements of `l`, in the sense +that there is no `b ∈ l` with `f b < f a`. If `a`, `b` are such that `f a = f b`, it returns +whichever of `a` or `b` comes first in the list. `argmin f []` = none`. -/ +def argmin (f : α → β) (l : list α) := l.foldl (arg_aux $ λ b c, f b < f c) none -@[simp] theorem argmax_eq_none {f : α → β} {l : list α} : l.argmax f = none ↔ l = [] := -by simp [argmax] +@[simp] lemma argmax_nil (f : α → β) : argmax f [] = none := rfl +@[simp] lemma argmin_nil (f : α → β) : argmin f [] = none := rfl -@[simp] theorem argmin_eq_none {f : α → β} {l : list α} : l.argmin f = none ↔ l = [] := -@argmax_eq_none _ βᵒᵈ _ _ _ +@[simp] lemma argmax_singleton {f : α → β} {a : α} : argmax f [a] = a := rfl +@[simp] lemma argmin_singleton {f : α → β} {a : α} : argmin f [a] = a := rfl -theorem le_argmax_of_mem {f : α → β} {a m : α} {l : list α} : a ∈ l → m ∈ argmax f l → f a ≤ f m := -le_of_foldl_argmax₂ +lemma not_lt_of_mem_argmax : a ∈ l → m ∈ argmax f l → ¬ f m < f a := +not_of_mem_foldl_arg_aux _ (λ _ , lt_irrefl _) $ λ _ _ _, gt_trans -theorem argmin_le_of_mem {f : α → β} {a m : α} {l : list α} : a ∈ l → m ∈ argmin f l → f m ≤ f a:= -@le_argmax_of_mem _ βᵒᵈ _ _ _ _ _ +lemma not_lt_of_mem_argmin : a ∈ l → m ∈ argmin f l → ¬ f a < f m := +not_of_mem_foldl_arg_aux _ (λ _ , lt_irrefl _) $ λ _ _ _, lt_trans theorem argmax_concat (f : α → β) (a : α) (l : list α) : argmax f (l ++ [a]) = - option.cases_on (argmax f l) (some a) (λ c, if f a ≤ f c then some c else some a) := -by rw [argmax, argmax]; simp [argmax₂] + option.cases_on (argmax f l) (some a) (λ c, if f c < f a then some a else some c) := +by rw [argmax, argmax]; simp [arg_aux] theorem argmin_concat (f : α → β) (a : α) (l : list α) : argmin f (l ++ [a]) = - option.cases_on (argmin f l) (some a) (λ c, if f c ≤ f a then some c else some a) := -@argmax_concat _ βᵒᵈ _ _ _ _ + option.cases_on (argmin f l) (some a) (λ c, if f a < f c then some a else some c) := +@argmax_concat _ βᵒᵈ _ _ _ _ _ + +theorem argmax_mem : Π {l : list α} {m : α}, m ∈ argmax f l → m ∈ l +| [] m := by simp +| (hd::tl) m := by simpa [argmax, arg_aux] using foldl_arg_aux_mem _ tl hd m + +theorem argmin_mem : Π {l : list α} {m : α}, m ∈ argmin f l → m ∈ l := @argmax_mem _ βᵒᵈ _ _ _ + +@[simp] theorem argmax_eq_none : l.argmax f = none ↔ l = [] := by simp [argmax] +@[simp] theorem argmin_eq_none : l.argmin f = none ↔ l = [] := @argmax_eq_none _ βᵒᵈ _ _ _ _ + +end preorder + +section linear_order +variables [linear_order β] {f : α → β} {l : list α} {o : option α} {a m : α} + +theorem le_of_mem_argmax : a ∈ l → m ∈ argmax f l → f a ≤ f m := +λ ha hm, le_of_not_lt $ not_lt_of_mem_argmax ha hm + +theorem le_of_mem_argmin : a ∈ l → m ∈ argmin f l → f m ≤ f a := @le_of_mem_argmax _ βᵒᵈ _ _ _ _ _ theorem argmax_cons (f : α → β) (a : α) (l : list α) : argmax f (a :: l) = - option.cases_on (argmax f l) (some a) (λ c, if f c ≤ f a then some a else some c) := -list.reverse_rec_on l rfl $ - assume hd tl ih, begin + option.cases_on (argmax f l) (some a) (λ c, if f a < f c then some c else some a) := +list.reverse_rec_on l rfl $ λ hd tl ih, begin rw [← cons_append, argmax_concat, ih, argmax_concat], cases h : argmax f hd with m, { simp [h] }, - { simp [h], dsimp, - by_cases ham : f m ≤ f a, - { rw if_pos ham, dsimp, - by_cases htlm : f tl ≤ f m, - { rw if_pos htlm, dsimp, - rw [if_pos (le_trans htlm ham), if_pos ham] }, - { rw if_neg htlm } }, - { rw if_neg ham, dsimp, - by_cases htlm : f tl ≤ f m, - { rw if_pos htlm, dsimp, - rw if_neg ham }, - { rw if_neg htlm, dsimp, - rw [if_neg (not_le_of_gt (lt_trans (lt_of_not_ge ham) (lt_of_not_ge htlm)))] } } } + dsimp, + rw [←apply_ite, ←apply_ite], + dsimp, + split_ifs; try { refl }, + { exact absurd (lt_trans ‹f a < f m› ‹_›) ‹_› }, + { cases (‹f a < f tl›.lt_or_lt _).elim ‹_› ‹_› } end theorem argmin_cons (f : α → β) (a : α) (l : list α) : argmin f (a :: l) = - option.cases_on (argmin f l) (some a) (λ c, if f a ≤ f c then some a else some c) := -@argmax_cons _ βᵒᵈ _ _ _ _ + option.cases_on (argmin f l) (some a) (λ c, if f c < f a then some c else some a) := +by convert @argmax_cons _ βᵒᵈ _ _ _ _ -theorem index_of_argmax [decidable_eq α] {f : α → β} : Π {l : list α} {m : α}, m ∈ argmax f l → +variables [decidable_eq α] + +theorem index_of_argmax : Π {l : list α} {m : α}, m ∈ argmax f l → ∀ {a}, a ∈ l → f m ≤ f a → l.index_of m ≤ l.index_of a | [] m _ _ _ _ := by simp | (hd::tl) m hm a ha ham := begin @@ -153,50 +162,53 @@ theorem index_of_argmax [decidable_eq α] {f : α → β} : Π {l : list α} {m cases h : argmax f tl, { rw h at hm, simp * at * }, - { rw h at hm, - dsimp only at hm, - cases ha with hahd hatl, - { clear index_of_argmax, - subst hahd, - split_ifs at hm, - { subst hm }, - { subst hm, contradiction } }, - { have := index_of_argmax h hatl, clear index_of_argmax, - split_ifs at *; - refl <|> exact nat.zero_le _ <|> simp [*, nat.succ_le_succ_iff, -not_le] at * } } + rw h at hm, + dsimp only at hm, + obtain rfl | ha := ha; split_ifs at hm; subst hm, + { cases not_le_of_lt ‹_› ‹_› }, + { rw [if_neg, if_neg], + exact nat.succ_le_succ (index_of_argmax h ha ham), + { exact ne_of_apply_ne f (lt_of_lt_of_le ‹_› ‹_›).ne' }, + { exact ne_of_apply_ne _ ‹f hd < f val›.ne' } }, + { rw if_pos rfl, + exact bot_le } end -theorem index_of_argmin [decidable_eq α] {f : α → β} : Π {l : list α} {m : α}, m ∈ argmin f l → +theorem index_of_argmin : Π {l : list α} {m : α}, m ∈ argmin f l → ∀ {a}, a ∈ l → f a ≤ f m → l.index_of m ≤ l.index_of a := @index_of_argmax _ βᵒᵈ _ _ _ -theorem mem_argmax_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} : +theorem mem_argmax_iff : m ∈ argmax f l ↔ m ∈ l ∧ (∀ a ∈ l, f a ≤ f m) ∧ - (∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a) := -⟨λ hm, ⟨argmax_mem hm, λ a ha, le_argmax_of_mem ha hm, λ _, index_of_argmax hm⟩, + ∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a := +⟨λ hm, ⟨argmax_mem hm, λ a ha, le_of_mem_argmax ha hm, λ _, index_of_argmax hm⟩, begin rintros ⟨hml, ham, hma⟩, cases harg : argmax f l with n, { simp * at * }, - { have := le_antisymm (hma n (argmax_mem harg) (le_argmax_of_mem hml harg)) + { have := le_antisymm (hma n (argmax_mem harg) (le_of_mem_argmax hml harg)) (index_of_argmax harg hml (ham _ (argmax_mem harg))), rw [(index_of_inj hml (argmax_mem harg)).1 this, option.mem_def] } end⟩ -theorem argmax_eq_some_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} : +theorem argmax_eq_some_iff : argmax f l = some m ↔ m ∈ l ∧ (∀ a ∈ l, f a ≤ f m) ∧ - (∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a) := mem_argmax_iff + ∀ a ∈ l, f m ≤ f a → l.index_of m ≤ l.index_of a := mem_argmax_iff -theorem mem_argmin_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} : +theorem mem_argmin_iff : m ∈ argmin f l ↔ m ∈ l ∧ (∀ a ∈ l, f m ≤ f a) ∧ - (∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a) := + ∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a := @mem_argmax_iff _ βᵒᵈ _ _ _ _ _ -theorem argmin_eq_some_iff [decidable_eq α] {f : α → β} {m : α} {l : list α} : +theorem argmin_eq_some_iff : argmin f l = some m ↔ m ∈ l ∧ (∀ a ∈ l, f m ≤ f a) ∧ - (∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a) := mem_argmin_iff + ∀ a ∈ l, f a ≤ f m → l.index_of m ≤ l.index_of a := mem_argmin_iff + +end linear_order -variable [linear_order α] +section maximum_minimum +section preorder +variables [preorder α] [@decidable_rel α (<)] {l : list α} {a m : α} /-- `maximum l` returns an `with_bot α`, the largest element of `l` for nonempty lists, and `⊥` for `[]` -/ @@ -222,32 +234,41 @@ theorem minimum_mem {l : list α} {m : α} : (minimum l : with_bot α) = m → m @[simp] theorem minimum_eq_none {l : list α} : l.minimum = none ↔ l = [] := argmin_eq_none -theorem le_maximum_of_mem {a m : α} {l : list α} : a ∈ l → (maximum l : with_bot α) = m → a ≤ m := -le_argmax_of_mem +lemma not_lt_maximum_of_mem : a ∈ l → (maximum l : with_bot α) = m → ¬ m < a := not_lt_of_mem_argmax +lemma minimum_not_lt_of_mem : a ∈ l → (minimum l : with_top α) = m → ¬ a < m := not_lt_of_mem_argmin -theorem minimum_le_of_mem {a m : α} {l : list α} : a ∈ l → (minimum l : with_top α) = m → m ≤ a := -argmin_le_of_mem +theorem not_lt_maximum_of_mem' (ha : a ∈ l) : ¬ maximum l < (a : with_bot α) := +begin + cases h : l.maximum, + { simp * at * }, + { simp_rw [with_bot.some_eq_coe, with_bot.coe_lt_coe, not_lt_maximum_of_mem ha h, not_false_iff] } +end -theorem le_maximum_of_mem' {a : α} {l : list α} (ha : a ∈ l) : (a : with_bot α) ≤ maximum l := -option.cases_on (maximum l) (λ _ h, absurd ha ((h rfl).symm ▸ not_mem_nil _)) - (λ m hm _, with_bot.coe_le_coe.2 $ hm _ rfl) - (λ m, @le_maximum_of_mem _ _ _ m _ ha) - (@maximum_eq_none _ _ l).1 +theorem not_lt_minimum_of_mem' (ha : a ∈ l) : ¬ (a : with_top α) < minimum l := +@not_lt_maximum_of_mem' αᵒᵈ _ _ _ _ ha -theorem le_minimum_of_mem' {a : α} {l : list α} (ha : a ∈ l) : minimum l ≤ (a : with_top α) := -@le_maximum_of_mem' αᵒᵈ _ _ _ ha +end preorder + +section linear_order +variables [linear_order α] {l : list α} {a m : α} theorem maximum_concat (a : α) (l : list α) : maximum (l ++ [a]) = max (maximum l) a := begin - rw max_comm, simp only [maximum, argmax_concat, id], cases h : argmax id l, - { rw [max_eq_left], refl, exact bot_le }, - change (coe : α → with_bot α) with some, - rw [max_comm], - simp [max_def] + { exact (max_eq_right bot_le).symm }, + { simp [option.coe_def, max_def_lt], } end +lemma le_maximum_of_mem : a ∈ l → (maximum l : with_bot α) = m → a ≤ m := le_of_mem_argmax +lemma minimum_le_of_mem : a ∈ l → (minimum l : with_top α) = m → m ≤ a := le_of_mem_argmin + +lemma le_maximum_of_mem' (ha : a ∈ l) : (a : with_bot α) ≤ maximum l := +le_of_not_lt $ not_lt_maximum_of_mem' ha + +lemma le_minimum_of_mem' (ha : a ∈ l) : minimum l ≤ (a : with_top α) := +@le_maximum_of_mem' αᵒᵈ _ _ _ ha + theorem minimum_concat (a : α) (l : list α) : minimum (l ++ [a]) = min (minimum l) a := @maximum_concat αᵒᵈ _ _ _ @@ -258,8 +279,7 @@ list.reverse_rec_on l (by simp [@max_eq_left (with_bot α) _ _ _ bot_le]) theorem minimum_cons (a : α) (l : list α) : minimum (a :: l) = min a (minimum l) := @maximum_cons αᵒᵈ _ _ _ -theorem maximum_eq_coe_iff {m : α} {l : list α} : - maximum l = m ↔ m ∈ l ∧ (∀ a ∈ l, a ≤ m) := +lemma maximum_eq_coe_iff : maximum l = m ↔ m ∈ l ∧ ∀ a ∈ l, a ≤ m := begin unfold_coes, simp only [maximum, argmax_eq_some_iff, id], @@ -270,54 +290,61 @@ begin rw [le_antisymm hma (h.2 a hal)] } end -theorem minimum_eq_coe_iff {m : α} {l : list α} : - minimum l = m ↔ m ∈ l ∧ (∀ a ∈ l, m ≤ a) := +lemma minimum_eq_coe_iff : minimum l = m ↔ m ∈ l ∧ ∀ a ∈ l, m ≤ a := @maximum_eq_coe_iff αᵒᵈ _ _ _ -section fold +end linear_order +end maximum_minimum -variables {M : Type*} [canonically_linear_ordered_add_monoid M] +section fold +variables [linear_order α] -/-! Note: since there is no typeclass typeclass dual -to `canonically_linear_ordered_add_monoid α` we cannot express these lemmas generally for -`minimum`; instead we are limited to doing so on `αᵒᵈ`. -/ +section order_bot +variables [order_bot α] {l : list α} -lemma maximum_eq_coe_foldr_max_of_ne_nil (l : list M) (h : l ≠ []) : - l.maximum = (l.foldr max ⊥ : M) := +@[simp] lemma foldr_max_of_ne_nil (h : l ≠ []) : ↑(l.foldr max ⊥) = l.maximum := begin induction l with hd tl IH, { contradiction }, { rw [maximum_cons, foldr, with_bot.coe_max], by_cases h : tl = [], - { simp [h, -with_top.coe_zero] }, + { simp [h] }, { simp [IH h] } } end -lemma minimum_eq_coe_foldr_min_of_ne_nil (l : list Mᵒᵈ) (h : l ≠ []) : - l.minimum = (l.foldr min ⊤ : Mᵒᵈ) := -maximum_eq_coe_foldr_max_of_ne_nil l h - -lemma maximum_nat_eq_coe_foldr_max_of_ne_nil (l : list ℕ) (h : l ≠ []) : - l.maximum = (l.foldr max 0 : ℕ) := -maximum_eq_coe_foldr_max_of_ne_nil l h - -lemma max_le_of_forall_le (l : list M) (n : M) (h : ∀ (x ∈ l), x ≤ n) : - l.foldr max ⊥ ≤ n := +lemma max_le_of_forall_le (l : list α) (a : α) (h : ∀ x ∈ l, x ≤ a) : l.foldr max ⊥ ≤ a := begin induction l with y l IH, { simp }, - { specialize IH (λ x hx, h x (mem_cons_of_mem _ hx)), - have hy : y ≤ n := h y (mem_cons_self _ _), - simpa [hy] using IH } + { simpa [h y (mem_cons_self _ _)] using IH (λ x hx, h x $ mem_cons_of_mem _ hx) } +end + +lemma le_max_of_le {l : list α} {a x : α} (hx : x ∈ l) (h : a ≤ x) : + a ≤ l.foldr max ⊥ := +begin + induction l with y l IH, + { exact absurd hx (not_mem_nil _), }, + { obtain rfl | hl := hx, + simp only [foldr, foldr_cons], + { exact le_max_of_le_left h, }, + { exact le_max_of_le_right (IH hl) }} end -lemma le_min_of_le_forall (l : list Mᵒᵈ) (n : Mᵒᵈ) (h : ∀ (x ∈ l), n ≤ x) : n ≤ l.foldr min ⊤ := -max_le_of_forall_le l n h +end order_bot -lemma max_nat_le_of_forall_le (l : list ℕ) (n : ℕ) (h : ∀ (x ∈ l), x ≤ n) : - l.foldr max 0 ≤ n := -max_le_of_forall_le l n h +section order_top +variables [order_top α] {l : list α} -end fold +@[simp] lemma foldr_min_of_ne_nil (h : l ≠ []) : ↑(l.foldr min ⊤) = l.minimum := +@foldr_max_of_ne_nil αᵒᵈ _ _ _ h +lemma le_min_of_forall_le (l : list α) (a : α) (h : ∀ x ∈ l, a ≤ x) : a ≤ l.foldr min ⊤ := +@max_le_of_forall_le αᵒᵈ _ _ _ _ h + +lemma min_le_of_le (l : list α) (a : α) {x : α} (hx : x ∈ l) (h : x ≤ a) : + l.foldr min ⊤ ≤ a := +@le_max_of_le αᵒᵈ _ _ _ _ _ hx h + +end order_top +end fold end list diff --git a/src/data/list/nat_antidiagonal.lean b/src/data/list/nat_antidiagonal.lean index 0ec67b3cdc549..c33f04c354aba 100644 --- a/src/data/list/nat_antidiagonal.lean +++ b/src/data/list/nat_antidiagonal.lean @@ -3,11 +3,15 @@ Copyright (c) 2019 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin -/ +import data.list.nodup import data.list.range /-! # Antidiagonals in ℕ × ℕ as lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the antidiagonals of ℕ × ℕ as lists: the `n`-th antidiagonal is the list of pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more generally for sums going from `0` to `n`. diff --git a/src/data/list/nodup.lean b/src/data/list/nodup.lean index ec4766e578d31..3b323391f18c2 100644 --- a/src/data/list/nodup.lean +++ b/src/data/list/nodup.lean @@ -6,10 +6,14 @@ Authors: Mario Carneiro, Kenny Lau import data.list.lattice import data.list.pairwise import data.list.forall2 +import data.set.pairwise.basic /-! # Lists with no duplicates +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `list.nodup` is defined in `data/list/defs`. In this file we prove various properties of this predicate. -/ @@ -18,7 +22,7 @@ universes u v open nat function -variables {α : Type u} {β : Type v} {l l₁ l₂ : list α} {a b : α} +variables {α : Type u} {β : Type v} {l l₁ l₂ : list α} {r : α → α → Prop} {a b : α} namespace list @@ -69,11 +73,25 @@ pairwise_iff_nth_le.trans .resolve_right (λ h', H _ _ h₁ h' h.symm), λ H i j h₁ h₂ h, ne_of_lt h₂ (H _ _ _ _ h)⟩ -theorem nodup.nth_le_inj_iff {α : Type*} {l : list α} (h : nodup l) +theorem nodup.nth_le_inj_iff {l : list α} (h : nodup l) {i j : ℕ} (hi : i < l.length) (hj : j < l.length) : l.nth_le i hi = l.nth_le j hj ↔ i = j := ⟨nodup_iff_nth_le_inj.mp h _ _ _ _, by simp {contextual := tt}⟩ +lemma nodup_iff_nth_ne_nth {l : list α} : + l.nodup ↔ ∀ (i j : ℕ), i < j → j < l.length → l.nth i ≠ l.nth j := +begin + rw nodup_iff_nth_le_inj, + simp only [nth_le_eq_iff, some_nth_le_eq], + split; rintro h i j h₁ h₂, + { exact mt (h i j (h₁.trans h₂) h₂) (ne_of_lt h₁) }, + { intro h₃, + by_contra h₄, + cases lt_or_gt_of_ne h₄ with h₅ h₅, + { exact h i j h₅ h₂ h₃ }, + { exact h j i h₅ h₁ h₃.symm }}, +end + lemma nodup.ne_singleton_iff {l : list α} (h : nodup l) (x : α) : l ≠ [x] ↔ l = [] ∨ ∃ y ∈ l, y ≠ x := begin @@ -107,20 +125,28 @@ index_of_nth_le $ index_of_lt_length.2 $ nth_le_mem _ _ _ theorem nodup_iff_count_le_one [decidable_eq α] {l : list α} : nodup l ↔ ∀ a, count a l ≤ 1 := nodup_iff_sublist.trans $ forall_congr $ λ a, -have [a, a] <+ l ↔ 1 < count a l, from (@le_count_iff_repeat_sublist _ _ a l 2).symm, +have [a, a] <+ l ↔ 1 < count a l, from (@le_count_iff_replicate_sublist _ _ a l 2).symm, (not_congr this).trans not_lt -theorem nodup_repeat (a : α) : ∀ {n : ℕ}, nodup (repeat a n) ↔ n ≤ 1 +theorem nodup_replicate (a : α) : ∀ {n : ℕ}, nodup (replicate n a) ↔ n ≤ 1 | 0 := by simp [nat.zero_le] | 1 := by simp | (n+2) := iff_of_false - (λ H, nodup_iff_sublist.1 H a ((repeat_sublist_repeat _).2 (nat.le_add_left 2 n))) + (λ H, nodup_iff_sublist.1 H a ((replicate_sublist_replicate _).2 (nat.le_add_left 2 n))) (not_le_of_lt $ nat.le_add_left 2 n) @[simp] theorem count_eq_one_of_mem [decidable_eq α] {a : α} {l : list α} (d : nodup l) (h : a ∈ l) : count a l = 1 := le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h) +lemma count_eq_of_nodup [decidable_eq α] {a : α} {l : list α} + (d : nodup l) : count a l = if a ∈ l then 1 else 0 := +begin + split_ifs with h, + { exact count_eq_one_of_mem d h }, + { exact count_eq_zero_of_not_mem h }, +end + lemma nodup.of_append_left : nodup (l₁ ++ l₂) → nodup l₁ := nodup.sublist (sublist_append_left l₁ l₂) @@ -177,7 +203,7 @@ theorem nodup_map_iff {f : α → β} {l : list α} (hf : injective f) : nodup ( ⟨λ h, attach_map_val l ▸ h.map (λ a b, subtype.eq), λ h, nodup.of_map subtype.val ((attach_map_val l).symm ▸ h)⟩ -alias nodup_attach ↔ list.nodup.of_attach list.nodup.attach +alias nodup_attach ↔ nodup.of_attach nodup.attach attribute [protected] nodup.attach @@ -266,22 +292,6 @@ end lemma nodup.inter [decidable_eq α] (l₂ : list α) : nodup l₁ → nodup (l₁ ∩ l₂) := nodup.filter _ -@[simp] theorem nodup_sublists {l : list α} : nodup (sublists l) ↔ nodup l := -⟨λ h, (h.sublist (map_ret_sublist_sublists _)).of_map _, - λ h, (pairwise_sublists h).imp (λ _ _ h, mt reverse_inj.2 h.to_ne)⟩ - -@[simp] theorem nodup_sublists' {l : list α} : nodup (sublists' l) ↔ nodup l := -by rw [sublists'_eq_sublists, nodup_map_iff reverse_injective, - nodup_sublists, nodup_reverse] - -alias nodup_sublists ↔ list.nodup.of_sublists list.nodup.sublists -alias nodup_sublists' ↔ list.nodup.of_sublists' list.nodup.sublists' - -attribute [protected] nodup.sublists nodup.sublists' - -lemma nodup_sublists_len (n : ℕ) (h : nodup l) : (sublists_len n l).nodup := -h.sublists'.sublist $ sublists_len_sublist_sublists' _ _ - lemma nodup.diff_eq_filter [decidable_eq α] : ∀ {l₁ l₂ : list α} (hl₁ : l₁.nodup), l₁.diff l₂ = l₁.filter (∉ l₂) | l₁ [] hl₁ := by simp @@ -330,6 +340,18 @@ lemma nodup.pairwise_of_set_pairwise {l : list α} {r : α → α → Prop} (hl : l.nodup) (h : {x | x ∈ l}.pairwise r) : l.pairwise r := hl.pairwise_of_forall_ne h +@[simp] lemma nodup.pairwise_coe [is_symm α r] (hl : l.nodup) : + {a | a ∈ l}.pairwise r ↔ l.pairwise r := +begin + induction l with a l ih, + { simp }, + rw list.nodup_cons at hl, + have : ∀ b ∈ l, ¬a = b → r a b ↔ r a b := + λ b hb, imp_iff_right (ne_of_mem_of_not_mem hb hl.1).symm, + simp [set.set_of_or, set.pairwise_insert_of_symmetric (@symm_of _ r _), ih hl.2, and_comm, + forall₂_congr this], +end + end list theorem option.to_list_nodup {α} : ∀ o : option α, o.to_list.nodup diff --git a/src/data/list/nodup_equiv_fin.lean b/src/data/list/nodup_equiv_fin.lean index f423ffcf37b06..9ea0ba982d781 100644 --- a/src/data/list/nodup_equiv_fin.lean +++ b/src/data/list/nodup_equiv_fin.lean @@ -10,6 +10,9 @@ import data.list.duplicate /-! # Equivalence between `fin (length l)` and elements of a list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a list `l`, * if `l` has no duplicates, then `list.nodup.nth_le_equiv` is the equivalence between @@ -201,7 +204,7 @@ lemma duplicate_iff_exists_distinct_nth_le {l : list α} {x : α} : x = l.nth_le n hn ∧ x = l.nth_le m hm := begin classical, - rw [duplicate_iff_two_le_count, le_count_iff_repeat_sublist, + rw [duplicate_iff_two_le_count, le_count_iff_replicate_sublist, sublist_iff_exists_fin_order_embedding_nth_le_eq], split, { rintro ⟨f, hf⟩, @@ -214,7 +217,7 @@ begin { simp }, { simp [hnm] }, { simp }, - { simp only [nat.lt_succ_iff, nat.succ_le_succ_iff, repeat, length, nonpos_iff_eq_zero] + { simp only [nat.lt_succ_iff, nat.succ_le_succ_iff, replicate, length, nonpos_iff_eq_zero] at hi hj, simp [hi, hj] } }, { rintros ⟨⟨_|i⟩, hi⟩, diff --git a/src/data/list/of_fn.lean b/src/data/list/of_fn.lean index 6e1e9563a30fd..d5164175aef1f 100644 --- a/src/data/list/of_fn.lean +++ b/src/data/list/of_fn.lean @@ -3,22 +3,28 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.fin.basic -import data.list.basic +import data.fin.tuple.basic +import data.list.join +import data.list.pairwise /-! # Lists from functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Theorems and lemmas for dealing with `list.of_fn`, which converts a function on `fin n` to a list of length `n`. -## Main Definitions +## Main Statements -The main definitions pertain to lists generated using `of_fn` +The main statements pertain to lists generated using `of_fn` - `list.length_of_fn`, which tells us the length of such a list - `list.nth_of_fn`, which tells us the nth element of such a list - `list.array_eq_of_fn`, which interprets the list form of an array as such a list. +- `list.equiv_sigma_tuple`, which is an `equiv` between lists and the functions that generate them + via `list.of_fn`. -/ universes u @@ -76,6 +82,14 @@ begin simp only [d_array.rev_iterate_aux, of_fn_aux, IH] end +@[congr] +theorem of_fn_congr {m n : ℕ} (h : m = n) (f : fin m → α) : + of_fn f = of_fn (λ i : fin n, f (fin.cast h.symm i)) := +begin + subst h, + simp_rw [fin.cast_refl, order_iso.refl_apply], +end + /-- `of_fn` on an empty domain is the empty list. -/ @[simp] theorem of_fn_zero (f : fin 0 → α) : of_fn f = [] := rfl @@ -88,6 +102,63 @@ begin rw [of_fn_aux, IH], refl end +theorem of_fn_succ' {n} (f : fin (succ n) → α) : + of_fn f = (of_fn (λ i, f i.cast_succ)).concat (f (fin.last _)) := +begin + induction n with n IH, + { rw [of_fn_zero, concat_nil, of_fn_succ, of_fn_zero], refl }, + { rw [of_fn_succ, IH, of_fn_succ, concat_cons, fin.cast_succ_zero], + congr' 3, + simp_rw [fin.cast_succ_fin_succ], } +end + +@[simp] lemma of_fn_eq_nil_iff {n : ℕ} {f : fin n → α} : + of_fn f = [] ↔ n = 0 := +by cases n; simp only [of_fn_zero, of_fn_succ, eq_self_iff_true, nat.succ_ne_zero] + +lemma last_of_fn {n : ℕ} (f : fin n → α) (h : of_fn f ≠ []) + (hn : n - 1 < n := nat.pred_lt $ of_fn_eq_nil_iff.not.mp h) : + last (of_fn f) h = f ⟨n - 1, hn⟩ := +by simp [last_eq_nth_le] + +lemma last_of_fn_succ {n : ℕ} (f : fin n.succ → α) + (h : of_fn f ≠ [] := mt of_fn_eq_nil_iff.mp (nat.succ_ne_zero _)) : + last (of_fn f) h = f (fin.last _) := +last_of_fn f h + +/-- Note this matches the convention of `list.of_fn_succ'`, putting the `fin m` elements first. -/ +theorem of_fn_add {m n} (f : fin (m + n) → α) : + list.of_fn f = list.of_fn (λ i, f (fin.cast_add n i)) ++ list.of_fn (λ j, f (fin.nat_add m j)) := +begin + induction n with n IH, + { rw [of_fn_zero, append_nil, fin.cast_add_zero, fin.cast_refl], refl }, + { rw [of_fn_succ', of_fn_succ', IH, append_concat], refl, }, +end + +@[simp] theorem of_fn_fin_append {m n} (a : fin m → α) (b : fin n → α) : + list.of_fn (fin.append a b) = list.of_fn a ++ list.of_fn b := +by simp_rw [of_fn_add, fin.append_left, fin.append_right] + +/-- This breaks a list of `m*n` items into `m` groups each containing `n` elements. -/ +theorem of_fn_mul {m n} (f : fin (m * n) → α) : + list.of_fn f = list.join (list.of_fn $ λ i : fin m, list.of_fn $ λ j : fin n, + f ⟨i * n + j, + calc ↑i * n + j < (i + 1) *n : (add_lt_add_left j.prop _).trans_eq (add_one_mul _ _).symm + ... ≤ _ : nat.mul_le_mul_right _ i.prop⟩) := +begin + induction m with m IH, + { simp_rw [of_fn_zero, zero_mul, of_fn_zero, join], }, + { simp_rw [of_fn_succ', succ_mul, join_concat, of_fn_add, IH], refl, }, +end + +/-- This breaks a list of `m*n` items into `n` groups each containing `m` elements. -/ +theorem of_fn_mul' {m n} (f : fin (m * n) → α) : + list.of_fn f = list.join (list.of_fn $ λ i : fin n, list.of_fn $ λ j : fin m, + f ⟨m * i + j, + calc m * i + j < m * (i + 1) : (add_lt_add_left j.prop _).trans_eq (mul_add_one _ _).symm + ... ≤ _ : nat.mul_le_mul_left _ i.prop⟩) := +by simp_rw [mul_comm m n, mul_comm m, of_fn_mul, fin.cast_mk] + theorem of_fn_nth_le : ∀ l : list α, of_fn (λ i, nth_le l i i.2) = l | [] := rfl | (a::l) := by { rw of_fn_succ, congr, simp only [fin.coe_succ], exact of_fn_nth_le l } @@ -106,7 +177,59 @@ end by simp only [mem_of_fn, set.forall_range_iff] @[simp] lemma of_fn_const (n : ℕ) (c : α) : - of_fn (λ i : fin n, c) = repeat c n := + of_fn (λ i : fin n, c) = replicate n c := nat.rec_on n (by simp) $ λ n ihn, by simp [ihn] +@[simp] theorem of_fn_fin_repeat {m} (a : fin m → α) (n : ℕ) : + list.of_fn (fin.repeat n a) = (list.replicate n (list.of_fn a)).join := +by simp_rw [of_fn_mul, ←of_fn_const, fin.repeat, fin.mod_nat, fin.coe_mk, + add_comm, nat.add_mul_mod_self_right, nat.mod_eq_of_lt (fin.is_lt _), fin.eta] + +@[simp] lemma pairwise_of_fn {R : α → α → Prop} {n} {f : fin n → α} : + (of_fn f).pairwise R ↔ ∀ ⦃i j⦄, i < j → R (f i) (f j) := +by { simp only [pairwise_iff_nth_le, fin.forall_iff, length_of_fn, nth_le_of_fn', fin.mk_lt_mk], + exact ⟨λ h i hi j hj hij, h _ _ hj hij, λ h i j hj hij, h _ (hij.trans hj) _ hj hij⟩ } + +/-- Lists are equivalent to the sigma type of tuples of a given length. -/ +@[simps] +def equiv_sigma_tuple : list α ≃ Σ n, fin n → α := +{ to_fun := λ l, ⟨l.length, λ i, l.nth_le ↑i i.2⟩, + inv_fun := λ f, list.of_fn f.2, + left_inv := list.of_fn_nth_le, + right_inv := λ ⟨n, f⟩, fin.sigma_eq_of_eq_comp_cast (length_of_fn _) $ funext $ λ i, + nth_le_of_fn' f i.prop } + +/-- A recursor for lists that expands a list into a function mapping to its elements. + +This can be used with `induction l using list.of_fn_rec`. -/ +@[elab_as_eliminator] +def of_fn_rec {C : list α → Sort*} (h : Π n (f : fin n → α), C (list.of_fn f)) (l : list α) : C l := +cast (congr_arg _ l.of_fn_nth_le) $ h l.length (λ i, l.nth_le ↑i i.2) + +@[simp] +lemma of_fn_rec_of_fn {C : list α → Sort*} (h : Π n (f : fin n → α), C (list.of_fn f)) + {n : ℕ} (f : fin n → α) : @of_fn_rec _ C h (list.of_fn f) = h _ f := +equiv_sigma_tuple.right_inverse_symm.cast_eq (λ s, h s.1 s.2) ⟨n, f⟩ + +lemma exists_iff_exists_tuple {P : list α → Prop} : + (∃ l : list α, P l) ↔ ∃ n (f : fin n → α), P (list.of_fn f) := +equiv_sigma_tuple.symm.surjective.exists.trans sigma.exists + +lemma forall_iff_forall_tuple {P : list α → Prop} : + (∀ l : list α, P l) ↔ ∀ n (f : fin n → α), P (list.of_fn f) := +equiv_sigma_tuple.symm.surjective.forall.trans sigma.forall + +/-- `fin.sigma_eq_iff_eq_comp_cast` may be useful to work with the RHS of this expression. -/ +lemma of_fn_inj' {m n : ℕ} {f : fin m → α} {g : fin n → α} : + of_fn f = of_fn g ↔ (⟨m, f⟩ : Σ n, fin n → α) = ⟨n, g⟩ := +iff.symm $ equiv_sigma_tuple.symm.injective.eq_iff.symm + +/-- Note we can only state this when the two functions are indexed by defeq `n`. -/ +lemma of_fn_injective {n : ℕ} : function.injective (of_fn : (fin n → α) → list α) := +λ f g h, eq_of_heq $ by injection of_fn_inj'.mp h + +/-- A special case of `list.of_fn_inj'` for when the two functions are indexed by defeq `n`. -/ +@[simp] lemma of_fn_inj {n : ℕ} {f g : fin n → α} : of_fn f = of_fn g ↔ f = g := +of_fn_injective.eq_iff + end list diff --git a/src/data/list/pairwise.lean b/src/data/list/pairwise.lean index 97f027b5ae803..b186482bb8485 100644 --- a/src/data/list/pairwise.lean +++ b/src/data/list/pairwise.lean @@ -5,12 +5,15 @@ Authors: Mario Carneiro -/ import data.list.count import data.list.lex -import data.list.sublists -import data.set.pairwise +import logic.pairwise +import logic.relation /-! # Pairwise relations on a list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides basic results about `list.pairwise` and `list.pw_filter` (definitions are in `data.list.defs`). `pairwise r [a 0, ..., a (n - 1)]` means `∀ i j, i < j → r (a i) (a j)`. For example, @@ -310,27 +313,10 @@ theorem pairwise_iff_nth_le {R} : ∀ {l : list α}, exact H _ _ (succ_lt_succ h) (succ_pos _) } end -theorem pairwise.sublists' {R} : ∀ {l : list α}, pairwise R l → - pairwise (lex (swap R)) (sublists' l) -| _ pairwise.nil := pairwise_singleton _ _ -| _ (@pairwise.cons _ _ a l H₁ H₂) := - begin - simp only [sublists'_cons, pairwise_append, pairwise_map, mem_sublists', mem_map, - exists_imp_distrib, and_imp], - refine ⟨H₂.sublists', H₂.sublists'.imp (λ l₁ l₂, lex.cons), _⟩, - rintro l₁ sl₁ x l₂ sl₂ rfl, - cases l₁ with b l₁, {constructor}, - exact lex.rel (H₁ _ $ sl₁.subset $ mem_cons_self _ _) - end - -theorem pairwise_sublists {R} {l : list α} (H : pairwise R l) : - pairwise (λ l₁ l₂, lex R (reverse l₁) (reverse l₂)) (sublists l) := -by { have := (pairwise_reverse.2 H).sublists', rwa [sublists'_reverse, pairwise_map] at this } - -lemma pairwise_repeat {α : Type*} {r : α → α → Prop} {x : α} (hx : r x x) : - ∀ (n : ℕ), pairwise r (repeat x n) +lemma pairwise_replicate {α : Type*} {r : α → α → Prop} {x : α} (hx : r x x) : + ∀ (n : ℕ), pairwise r (replicate n x) | 0 := by simp -| (n+1) := by simp [hx, mem_repeat, pairwise_repeat n] +| (n+1) := by simp [hx, mem_replicate, pairwise_replicate n] /-! ### Pairwise filtering -/ @@ -388,7 +374,7 @@ theorem pw_filter_eq_self {l : list α} : pw_filter R l = l ↔ pairwise R l := rw [pw_filter_cons_of_pos (ball.imp_left (pw_filter_subset l) al), IH p], end⟩ -alias pw_filter_eq_self ↔ _ list.pairwise.pw_filter +alias pw_filter_eq_self ↔ _ pairwise.pw_filter attribute [protected] pairwise.pw_filter diff --git a/src/data/list/palindrome.lean b/src/data/list/palindrome.lean index e38cc03ddc2d8..74d22c24122dd 100644 --- a/src/data/list/palindrome.lean +++ b/src/data/list/palindrome.lean @@ -9,6 +9,9 @@ import data.list.basic /-! # Palindromes +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This module defines *palindromes*, lists which are equal to their reverse. The main result is the `palindrome` inductive type, and its associated `palindrome.rec_on` induction diff --git a/src/data/list/perm.lean b/src/data/list/perm.lean index 0c0893e884aab..22c3396410970 100644 --- a/src/data/list/perm.lean +++ b/src/data/list/perm.lean @@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ import data.list.dedup -import data.list.lattice import data.list.permutation -import data.list.zip -import logic.relation +import data.list.range +import data.nat.factorial.basic /-! # List Permutations +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file introduces the `list.perm` relation, which is true if two lists are permutations of one another. @@ -37,7 +39,7 @@ inductive perm : list α → list α → Prop open perm (swap) -infix ` ~ `:50 := perm +infix (name := list.perm) ` ~ `:50 := perm @[refl] protected theorem perm.refl : ∀ (l : list α), l ~ l | [] := perm.nil @@ -80,6 +82,12 @@ theorem perm.subset {l₁ l₂ : list α} (p : l₁ ~ l₂) : l₁ ⊆ l₂ := theorem perm.mem_iff {a : α} {l₁ l₂ : list α} (h : l₁ ~ l₂) : a ∈ l₁ ↔ a ∈ l₂ := iff.intro (λ m, h.subset m) (λ m, h.symm.subset m) +lemma perm.subset_congr_left {l₁ l₂ l₃ : list α} (h : l₁ ~ l₂) : l₁ ⊆ l₃ ↔ l₂ ⊆ l₃ := +⟨h.symm.subset.trans, h.subset.trans⟩ + +lemma perm.subset_congr_right {l₁ l₂ l₃ : list α} (h : l₁ ~ l₂) : l₃ ⊆ l₁ ↔ l₃ ⊆ l₂ := +⟨λ h', h'.trans h.subset, λ h', h'.trans h.symm.subset⟩ + theorem perm.append_right {l₁ l₂ : list α} (t₁ : list α) (p : l₁ ~ l₂) : l₁++t₁ ~ l₂++t₁ := perm.rec_on p (perm.refl ([] ++ t₁)) @@ -145,26 +153,24 @@ theorem perm_cons_append_cons {l l₁ l₂ : list α} (a : α) (p : l ~ l₁++l a::l ~ l₁++(a::l₂) := (p.cons a).trans perm_middle.symm -@[simp] theorem perm_repeat {a : α} {n : ℕ} {l : list α} : l ~ repeat a n ↔ l = repeat a n := -⟨λ p, (eq_repeat.2 - ⟨p.length_eq.trans $ length_repeat _ _, - λ b m, eq_of_mem_repeat $ p.subset m⟩), - λ h, h ▸ perm.refl _⟩ +@[simp] theorem perm_replicate {n : ℕ} {a : α} {l : list α} : + l ~ replicate n a ↔ l = replicate n a := +⟨λ p, eq_replicate.2 + ⟨p.length_eq.trans $ length_replicate _ _, λ b m, eq_of_mem_replicate $ p.subset m⟩, + λ h, h ▸ perm.refl _⟩ -@[simp] theorem repeat_perm {a : α} {n : ℕ} {l : list α} : repeat a n ~ l ↔ repeat a n = l := -(perm_comm.trans perm_repeat).trans eq_comm +@[simp] theorem replicate_perm {n : ℕ} {a : α} {l : list α} : + replicate n a ~ l ↔ replicate n a = l := +(perm_comm.trans perm_replicate).trans eq_comm @[simp] theorem perm_singleton {a : α} {l : list α} : l ~ [a] ↔ l = [a] := -@perm_repeat α a 1 l +@perm_replicate α 1 a l @[simp] theorem singleton_perm {a : α} {l : list α} : [a] ~ l ↔ [a] = l := -@repeat_perm α a 1 l +@replicate_perm α 1 a l -theorem perm.eq_singleton {a : α} {l : list α} (p : l ~ [a]) : l = [a] := -perm_singleton.1 p - -theorem perm.singleton_eq {a : α} {l : list α} (p : [a] ~ l) : [a] = l := -p.symm.eq_singleton.symm +alias perm_singleton ↔ perm.eq_singleton _ +alias singleton_perm ↔ perm.singleton_eq _ theorem singleton_perm_singleton {a b : α} : [a] ~ [b] ↔ a = b := by simp @@ -215,6 +221,19 @@ theorem perm.filter (p : α → Prop) [decidable_pred p] {l₁ l₂ : list α} (s : l₁ ~ l₂) : filter p l₁ ~ filter p l₂ := by rw ← filter_map_eq_filter; apply s.filter_map _ +theorem filter_append_perm (p : α → Prop) [decidable_pred p] + (l : list α) : filter p l ++ filter (λ x, ¬ p x) l ~ l := +begin + induction l with x l ih, + { refl }, + { by_cases h : p x, + { simp only [h, filter_cons_of_pos, filter_cons_of_neg, not_true, not_false_iff, cons_append], + exact ih.cons x }, + { simp only [h, filter_cons_of_neg, not_false_iff, filter_cons_of_pos], + refine perm.trans _ (ih.cons x), + exact perm_append_comm.trans (perm_append_comm.cons _), } } +end + theorem exists_perm_sublist {l₁ l₂ l₂' : list α} (s : l₁ <+ l₂) (p : l₂ ~ l₂') : ∃ l₁' ~ l₁, l₁' <+ l₂' := begin @@ -338,12 +357,10 @@ theorem perm.subperm {l₁ l₂ : list α} (p : l₁ ~ l₂) : l₁ <+~ l₂ := let ⟨l₁', p₁, s₁⟩ := p₂.subperm_left.2 s in ⟨l₁', p₁, s₁.trans s₂⟩ theorem subperm.length_le {l₁ l₂ : list α} : l₁ <+~ l₂ → length l₁ ≤ length l₂ -| ⟨l, p, s⟩ := p.length_eq ▸ length_le_of_sublist s +| ⟨l, p, s⟩ := p.length_eq ▸ s.length_le theorem subperm.perm_of_length_le {l₁ l₂ : list α} : l₁ <+~ l₂ → length l₂ ≤ length l₁ → l₁ ~ l₂ -| ⟨l, p, s⟩ h := - suffices l = l₂, from this ▸ p.symm, - eq_of_sublist_of_length_le s $ p.symm.length_eq ▸ h +| ⟨l, p, s⟩ h := (s.eq_of_length_le $ p.symm.length_eq ▸ h) ▸ p.symm theorem subperm.antisymm {l₁ l₂ : list α} (h₁ : l₁ <+~ l₂) (h₂ : l₂ <+~ l₁) : l₁ ~ l₂ := h₁.perm_of_length_le h₂.length_le @@ -378,6 +395,22 @@ theorem subperm.countp_le (p : α → Prop) [decidable_pred p] {l₁ l₂ : list α} : l₁ <+~ l₂ → countp p l₁ ≤ countp p l₂ | ⟨l, p', s⟩ := p'.countp_eq p ▸ s.countp_le p +theorem perm.countp_congr (s : l₁ ~ l₂) {p p' : α → Prop} [decidable_pred p] [decidable_pred p'] + (hp : ∀ x ∈ l₁, p x ↔ p' x) : l₁.countp p = l₂.countp p' := +begin + rw ← s.countp_eq p', + clear s, + induction l₁ with y s hs, + { refl }, + { simp only [mem_cons_iff, forall_eq_or_imp] at hp, + simp only [countp_cons, hs hp.2, hp.1], }, +end + +theorem countp_eq_countp_filter_add + (l : list α) (p q : α → Prop) [decidable_pred p] [decidable_pred q] : + l.countp p = (l.filter q).countp p + (l.filter (λ a, ¬ q a)).countp p := +by { rw [← countp_append], exact perm.countp_eq _ (filter_append_perm _ _).symm } + theorem perm.count_eq [decidable_eq α] {l₁ l₂ : list α} (p : l₁ ~ l₂) (a) : count a l₁ = count a l₂ := p.countp_eq _ @@ -427,8 +460,8 @@ end section variables {op : α → α → α} [is_associative α op] [is_commutative α op] -local notation a * b := op a b -local notation l <*> a := foldl op a l +local notation (name := op) a ` * ` b := op a b +local notation (name := foldl) l ` <*> ` a := foldl op a l lemma perm.fold_op_eq {l₁ l₂ : list α} {a : α} (h : l₁ ~ l₂) : l₁ <*> a = l₂ <*> a := h.foldl_eq (right_comm _ is_commutative.comm is_associative.assoc) _ @@ -437,13 +470,13 @@ end section comm_monoid /-- If elements of a list commute with each other, then their product does not -depend on the order of elements-/ -@[to_additive] -lemma perm.prod_eq' [monoid α] {l₁ l₂ : list α} (h : l₁ ~ l₂) - (hc : l₁.pairwise (λ x y, x * y = y * x)) : +depend on the order of elements. -/ +@[to_additive "If elements of a list additively commute with each other, then their sum does not +depend on the order of elements."] +lemma perm.prod_eq' [monoid α] {l₁ l₂ : list α} (h : l₁ ~ l₂) (hc : l₁.pairwise commute) : l₁.prod = l₂.prod := h.foldl_eq' (pairwise.forall_of_forall (λ x y h z, (h z).symm) (λ x hx z, rfl) $ - hc.imp $ λ x y h z, by simp only [mul_assoc, h]) _ + hc.imp $ λ x y h z, by simp only [mul_assoc, h.eq]) _ variable [comm_monoid α] @@ -517,7 +550,7 @@ theorem subperm_cons (a : α) {l₁ l₂ : list α} : a::l₁ <+~ a::l₂ ↔ l { exact ⟨u, p.cons_inv, s'⟩ } end, λ ⟨l, p, s⟩, ⟨a::l, p.cons a, s.cons2 _ _ _⟩⟩ -alias subperm_cons ↔ list.subperm.of_cons list.subperm.cons +alias subperm_cons ↔ subperm.of_cons subperm.cons attribute [protected] subperm.cons @@ -561,7 +594,7 @@ theorem subperm.exists_of_length_lt {l₁ l₂ : list α} : { cases h }, { cases lt_or_eq_of_le (nat.le_of_lt_succ h : length l₁ ≤ length l₂) with h h, { exact (IH h).imp (λ a s, s.trans (sublist_cons _ _).subperm) }, - { exact ⟨a, eq_of_sublist_of_length_eq s h ▸ subperm.refl _⟩ } }, + { exact ⟨a, s.eq_of_length h ▸ subperm.refl _⟩ } }, { exact (IH $ nat.lt_of_succ_lt_succ h).imp (λ a s, (swap _ _ _).subperm_right.1 $ (subperm_cons _).2 s) } end @@ -704,6 +737,16 @@ theorem perm_iff_count {l₁ l₂ : list α} : l₁ ~ l₂ ↔ ∀ a, count a l by_cases b = a; simp [h] at H ⊢; assumption } end⟩ +theorem perm_replicate_append_replicate {l : list α} {a b : α} {m n : ℕ} (h : a ≠ b) : + l ~ replicate m a ++ replicate n b ↔ count a l = m ∧ count b l = n ∧ l ⊆ [a, b] := +begin + rw [perm_iff_count, ← decidable.and_forall_ne a, ← decidable.and_forall_ne b], + suffices : l ⊆ [a, b] ↔ ∀ c, c ≠ b → c ≠ a → c ∉ l, + { simp [count_replicate, h, h.symm, this] { contextual := tt } }, + simp_rw [ne.def, ← and_imp, ← not_or_distrib, decidable.not_imp_not, subset_def, mem_cons_iff, + not_mem_nil, or_false, or_comm], +end + lemma subperm.cons_right {α : Type*} {l l' : list α} (x : α) (h : l <+~ l') : l <+~ x :: l' := h.trans (sublist_cons x l').subperm @@ -739,6 +782,9 @@ begin convert (subperm_append_right _).mpr nil_subperm using 1 end +instance decidable_subperm : decidable_rel ((<+~) : list α → list α → Prop) := +λ l₁ l₂, decidable_of_iff _ list.subperm_ext_iff.symm + @[simp] lemma subperm_singleton_iff {α} {l : list α} {a : α} : [a] <+~ l ↔ a ∈ l := ⟨λ ⟨s, hla, h⟩, by rwa [perm_singleton.mp hla, singleton_sublist] at h, λ h, ⟨[a], perm.refl _, singleton_sublist.mpr h⟩⟩ @@ -862,21 +908,37 @@ suffices ∀ {l₁ l₂}, l₁ ~ l₂ → pairwise R l₁ → pairwise R l₂, f exact h _ (p'.symm.subset m) } end +lemma pairwise.perm {R : α → α → Prop} {l l' : list α} (hR : l.pairwise R) + (hl : l ~ l') (hsymm : symmetric R) : l'.pairwise R := +(hl.pairwise_iff hsymm).mp hR + +lemma perm.pairwise {R : α → α → Prop} {l l' : list α} + (hl : l ~ l') (hR : l.pairwise R) (hsymm : symmetric R) : l'.pairwise R := +hR.perm hl hsymm + theorem perm.nodup_iff {l₁ l₂ : list α} : l₁ ~ l₂ → (nodup l₁ ↔ nodup l₂) := perm.pairwise_iff $ @ne.symm α +theorem perm.join {l₁ l₂ : list (list α)} (h : l₁ ~ l₂) : l₁.join ~ l₂.join := +perm.rec_on h + (perm.refl _) + (λ x xs₁ xs₂ hxs ih, ih.append_left x) + (λ x₁ x₂ xs, by simpa only [join, append_assoc] using perm_append_comm.append_right _) + (λ xs₁ xs₂ xs₃ h₁₂ h₂₃, perm.trans) + theorem perm.bind_right {l₁ l₂ : list α} (f : α → list β) (p : l₁ ~ l₂) : l₁.bind f ~ l₂.bind f := -begin - induction p with a l₁ l₂ p IH a b l l₁ l₂ l₃ p₁ p₂ IH₁ IH₂, {simp}, - { simp, exact IH.append_left _ }, - { simp, rw [← append_assoc, ← append_assoc], exact perm_append_comm.append_right _ }, - { exact IH₁.trans IH₂ } -end +(p.map _).join + +lemma perm.join_congr : + ∀ {l₁ l₂ : list (list α)} (h : list.forall₂ (~) l₁ l₂), l₁.join ~ l₂.join +| _ _ forall₂.nil := perm.refl _ +| (a :: as) (b :: bs) (forall₂.cons h₁ h₂) := h₁.append (perm.join_congr h₂) -theorem perm.bind_left (l : list α) {f g : α → list β} (h : ∀ a, f a ~ g a) : +theorem perm.bind_left (l : list α) {f g : α → list β} (h : ∀ a ∈ l, f a ~ g a) : l.bind f ~ l.bind g := -by induction l with a l IH; simp; exact (h a).append IH +perm.join_congr $ + by rwa [list.forall₂_map_right_iff,list.forall₂_map_left_iff, list.forall₂_same] theorem bind_append_perm (l : list α) (f g : α → list β) : l.bind f ++ l.bind g ~ l.bind (λ x, f x ++ g x) := @@ -887,65 +949,22 @@ begin exact perm_append_comm.append_right _ end +theorem map_append_bind_perm (l : list α) (f : α → β) (g : α → list β) : + l.map f ++ l.bind g ~ l.bind (λ x, f x :: g x) := +by simpa [←map_eq_bind] using bind_append_perm l (λ x, [f x]) g + theorem perm.product_right {l₁ l₂ : list α} (t₁ : list β) (p : l₁ ~ l₂) : product l₁ t₁ ~ product l₂ t₁ := p.bind_right _ theorem perm.product_left (l : list α) {t₁ t₂ : list β} (p : t₁ ~ t₂) : product l t₁ ~ product l t₂ := -perm.bind_left _ $ λ a, p.map _ +perm.bind_left _ $ λ a ha, p.map _ @[congr] theorem perm.product {l₁ l₂ : list α} {t₁ t₂ : list β} (p₁ : l₁ ~ l₂) (p₂ : t₁ ~ t₂) : product l₁ t₁ ~ product l₂ t₂ := (p₁.product_right t₁).trans (p₂.product_left l₂) -theorem sublists_cons_perm_append (a : α) (l : list α) : - sublists (a :: l) ~ sublists l ++ map (cons a) (sublists l) := -begin - simp only [sublists, sublists_aux_cons_cons, cons_append, perm_cons], - refine (perm.cons _ _).trans perm_middle.symm, - induction sublists_aux l cons with b l IH; simp, - exact (IH.cons _).trans perm_middle.symm -end - -theorem sublists_perm_sublists' : ∀ l : list α, sublists l ~ sublists' l -| [] := perm.refl _ -| (a::l) := let IH := sublists_perm_sublists' l in - by rw sublists'_cons; exact - (sublists_cons_perm_append _ _).trans (IH.append (IH.map _)) - -theorem revzip_sublists (l : list α) : - ∀ l₁ l₂, (l₁, l₂) ∈ revzip l.sublists → l₁ ++ l₂ ~ l := -begin - rw revzip, - apply list.reverse_rec_on l, - { intros l₁ l₂ h, simp at h, simp [h] }, - { intros l a IH l₁ l₂ h, - rw [sublists_concat, reverse_append, zip_append, ← map_reverse, - zip_map_right, zip_map_left] at h; [skip, {simp}], - simp only [prod.mk.inj_iff, mem_map, mem_append, prod.map_mk, prod.exists] at h, - rcases h with ⟨l₁, l₂', h, rfl, rfl⟩ | ⟨l₁', l₂, h, rfl, rfl⟩, - { rw ← append_assoc, - exact (IH _ _ h).append_right _ }, - { rw append_assoc, - apply (perm_append_comm.append_left _).trans, - rw ← append_assoc, - exact (IH _ _ h).append_right _ } } -end - -theorem revzip_sublists' (l : list α) : - ∀ l₁ l₂, (l₁, l₂) ∈ revzip l.sublists' → l₁ ++ l₂ ~ l := -begin - rw revzip, - induction l with a l IH; intros l₁ l₂ h, - { simp at h, simp [h] }, - { rw [sublists'_cons, reverse_append, zip_append, ← map_reverse, - zip_map_right, zip_map_left] at h; [simp at h, simp], - rcases h with ⟨l₁, l₂', h, rfl, rfl⟩ | ⟨l₁', h, rfl⟩, - { exact perm_middle.trans ((IH _ _ h).cons _) }, - { exact (IH _ _ h).cons _ } } -end - theorem perm_lookmap (f : α → option α) {l₁ l₂ : list α} (H : pairwise (λ a b, ∀ (c ∈ f a) (d ∈ f b), a = b ∧ c = d) l₁) (p : l₁ ~ l₂) : lookmap f l₁ ~ lookmap f l₂ := @@ -1153,7 +1172,10 @@ begin induction p with a s t p IH a b l s t u p₁ p₂ IH₁ IH₂, {simp}, { simp only [permutations'], exact IH.bind_right _ }, { simp only [permutations'], - rw [bind_assoc, bind_assoc], apply perm.bind_left, apply perm_permutations'_aux_comm }, + rw [bind_assoc, bind_assoc], + apply perm.bind_left, + intros l' hl', + apply perm_permutations'_aux_comm }, { exact IH₁.trans IH₂ } end diff --git a/src/data/list/permutation.lean b/src/data/list/permutation.lean index 982f019d7cae1..d42d45bd24b58 100644 --- a/src/data/list/permutation.lean +++ b/src/data/list/permutation.lean @@ -8,6 +8,9 @@ import data.list.join /-! # Permutations of a list +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove properties about `list.permutations`, a list of all permutations of a list. It is defined in `data.list.defs`. diff --git a/src/data/list/prime.lean b/src/data/list/prime.lean index 9fa1305b4c410..191bd08aa6ba3 100644 --- a/src/data/list/prime.lean +++ b/src/data/list/prime.lean @@ -5,12 +5,15 @@ Authors: Johannes Hölzl, Jens Wagemaker, Anne Baanen -/ import algebra.associated -import data.list.big_operators +import data.list.big_operators.lemmas import data.list.perm /-! # Products of lists of prime elements. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains some theorems relating `prime` and products of `list`s. -/ diff --git a/src/data/list/prod_sigma.lean b/src/data/list/prod_sigma.lean index db8d50049aacb..da1eba10681bc 100644 --- a/src/data/list/prod_sigma.lean +++ b/src/data/list/prod_sigma.lean @@ -3,11 +3,14 @@ Copyright (c) 2015 Leonardo de Moura. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Mario Carneiro -/ -import data.list.big_operators +import data.list.big_operators.basic /-! # Lists in product and sigma types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic properties of `list.product` and `list.sigma`, which are list constructions living in `prod` and `sigma` types respectively. Their definitions can be found in [`data.list.defs`](./defs). Beware, this is not about `list.prod`, the multiplicative product. diff --git a/src/data/list/range.lean b/src/data/list/range.lean index 72c37812849f8..94e3d326fd7bd 100644 --- a/src/data/list/range.lean +++ b/src/data/list/range.lean @@ -4,17 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Kenny Lau, Scott Morrison -/ import data.list.chain -import data.list.nodup -import data.list.of_fn import data.list.zip /-! # Ranges of naturals as lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file shows basic results about `list.iota`, `list.range`, `list.range'` (all defined in `data.list.defs`) and defines `list.fin_range`. `fin_range n` is the list of elements of `fin n`. -`iota n = [1, ..., n]` and `range n = [0, ..., n - 1]` are basic list constructions used for +`iota n = [n, n - 1, ..., 1]` and `range n = [0, ..., n - 1]` are basic list constructions used for tactics. `range' a b = [a, ..., a + b - 1]` is there to help prove properties about them. Actual maths should use `list.Ico` instead. -/ @@ -66,7 +67,7 @@ theorem chain_lt_range' (s n : ℕ) : chain (<) s (range' (s+1) n) := theorem pairwise_lt_range' : ∀ s n : ℕ, pairwise (<) (range' s n) | s 0 := pairwise.nil -| s (n+1) := (chain_iff_pairwise (by exact λ a b c, lt_trans)).1 (chain_lt_range' s n) +| s (n+1) := chain_iff_pairwise.1 (chain_lt_range' s n) theorem nodup_range' (s n : ℕ) : nodup (range' s n) := (pairwise_lt_range' s n).imp (λ a b, ne_of_lt) @@ -77,7 +78,7 @@ theorem nodup_range' (s n : ℕ) : nodup (range' s n) := by rw [add_right_comm, range'_append] theorem range'_sublist_right {s m n : ℕ} : range' s m <+ range' s n ↔ m ≤ n := -⟨λ h, by simpa only [length_range'] using length_le_of_sublist h, +⟨λ h, by simpa only [length_range'] using h.length_le, λ h, by rw [← tsub_add_cancel_of_le h, ← range'_append]; apply sublist_append_left⟩ theorem range'_subset_right {s m n : ℕ} : range' s m ⊆ range' s n ↔ m ≤ n := @@ -122,6 +123,9 @@ by rw [← length_eq_zero, length_range] theorem pairwise_lt_range (n : ℕ) : pairwise (<) (range n) := by simp only [range_eq_range', pairwise_lt_range'] +theorem pairwise_le_range (n : ℕ) : pairwise (≤) (range n) := +pairwise.imp (@le_of_lt ℕ _) (pairwise_lt_range _) + theorem nodup_range (n : ℕ) : nodup (range n) := by simp only [range_eq_range', nodup_range'] @@ -184,7 +188,7 @@ theorem pairwise_gt_iota (n : ℕ) : pairwise (>) (iota n) := by simp only [iota_eq_reverse_range', pairwise_reverse, pairwise_lt_range'] theorem nodup_iota (n : ℕ) : nodup (iota n) := -by simp only [iota_eq_reverse_range', nodup_reverse, nodup_range'] +(pairwise_gt_iota n).imp (λ a b, ne_of_gt) theorem mem_iota {m n : ℕ} : m ∈ iota n ↔ 1 ≤ m ∧ m ≤ n := by simp only [iota_eq_reverse_range', mem_reverse, mem_range', add_comm, lt_succ_iff] @@ -199,17 +203,17 @@ theorem reverse_range' : ∀ s n : ℕ, nil_append, eq_self_iff_true, true_and, map_map] using reverse_range' s n -/-- All elements of `fin n`, from `0` to `n-1`. -/ +/-- All elements of `fin n`, from `0` to `n-1`. The corresponding finset is `finset.univ`. -/ def fin_range (n : ℕ) : list (fin n) := (range n).pmap fin.mk (λ _, list.mem_range.1) @[simp] lemma fin_range_zero : fin_range 0 = [] := rfl @[simp] lemma mem_fin_range {n : ℕ} (a : fin n) : a ∈ fin_range n := -mem_pmap.2 ⟨a.1, mem_range.2 a.2, fin.eta _ _⟩ +mem_pmap.2 ⟨a.1, mem_range.2 a.2, by { cases a, refl, }⟩ lemma nodup_fin_range (n : ℕ) : (fin_range n).nodup := -(nodup_range _).pmap $ λ _ _ _ _, fin.veq_of_eq +pairwise.pmap (nodup_range n) _ $ λ _ _ _ _, @fin.ne_of_vne _ ⟨_, _⟩ ⟨_, _⟩ @[simp] lemma length_fin_range (n : ℕ) : (fin_range n).length = n := by rw [fin_range, length_pmap, length_range] @@ -217,22 +221,6 @@ by rw [fin_range, length_pmap, length_range] @[simp] lemma fin_range_eq_nil {n : ℕ} : fin_range n = [] ↔ n = 0 := by rw [← length_eq_zero, length_fin_range] -@[simp] lemma map_coe_fin_range (n : ℕ) : (fin_range n).map coe = list.range n := -begin - simp_rw [fin_range, map_pmap, fin.mk, subtype.coe_mk, pmap_eq_map], - exact list.map_id _ -end - -lemma fin_range_succ_eq_map (n : ℕ) : - fin_range n.succ = 0 :: (fin_range n).map fin.succ := -begin - apply map_injective_iff.mpr subtype.coe_injective, - rw [map_cons, map_coe_fin_range, range_succ_eq_map, fin.coe_zero, ←map_coe_fin_range, map_map, - map_map, function.comp, function.comp], - congr' 2 with x, - exact (fin.coe_succ _).symm, -end - @[to_additive] theorem prod_range_succ {α : Type u} [monoid α] (f : ℕ → α) (n : ℕ) : ((range n.succ).map f).prod = ((range n).map f).prod * f n := @@ -280,21 +268,6 @@ option.some.inj $ by rw [← nth_le_nth _, nth_range (by simpa using H)] @[simp] lemma nth_le_fin_range {n : ℕ} {i : ℕ} (h) : (fin_range n).nth_le i h = ⟨i, length_fin_range n ▸ h⟩ := -by simp only [fin_range, nth_le_range, nth_le_pmap, fin.mk_eq_subtype_mk] - -theorem of_fn_eq_pmap {α n} {f : fin n → α} : - of_fn f = pmap (λ i hi, f ⟨i, hi⟩) (range n) (λ _, mem_range.1) := -by rw [pmap_eq_map_attach]; from ext_le (by simp) - (λ i hi1 hi2, by { simp at hi1, simp [nth_le_of_fn f ⟨i, hi1⟩, -subtype.val_eq_coe] }) - -theorem of_fn_id (n) : of_fn id = fin_range n := of_fn_eq_pmap - -theorem of_fn_eq_map {α n} {f : fin n → α} : - of_fn f = (fin_range n).map f := -by rw [← of_fn_id, map_of_fn, function.right_id] - -theorem nodup_of_fn {α n} {f : fin n → α} (hf : function.injective f) : - nodup (of_fn f) := -by { rw of_fn_eq_pmap, exact (nodup_range n).pmap (λ _ _ _ _ H, fin.veq_of_eq $ hf H) } +by simp only [fin_range, nth_le_range, nth_le_pmap] end list diff --git a/src/data/list/rdrop.lean b/src/data/list/rdrop.lean new file mode 100644 index 0000000000000..836372335cadc --- /dev/null +++ b/src/data/list/rdrop.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2022 Yakov Pechersky. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yakov Pechersky +-/ + +import data.list.basic +import data.list.infix + +/-! + +# Dropping or taking from lists on the right + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Taking or removing element from the tail end of a list + +## Main defintions + +- `rdrop n`: drop `n : ℕ` elements from the tail +- `rtake n`: take `n : ℕ` elements from the tail +- `drop_while p`: remove all the elements that satisfy a decidable `p : α → Prop` from the tail of + a list until hitting the first non-satisfying element +- `take_while p`: take all the elements that satisfy a decidable `p : α → Prop` from the tail of + a list until hitting the first non-satisfying element + +## Implementation detail + +The two predicate-based methods operate by performing the regular "from-left" operation on +`list.reverse`, followed by another `list.reverse`, so they are not the most performant. +The other two rely on `list.length l` so they still traverse the list twice. One could construct +another function that takes a `L : ℕ` and use `L - n`. Under a proof condition that +`L = l.length`, the function would do the right thing. + +-/ + +variables {α : Type*} (p : α → Prop) [decidable_pred p] (l : list α) (n : ℕ) + +namespace list + +/-- Drop `n` elements from the tail end of a list. -/ +def rdrop : list α := l.take (l.length - n) + +@[simp] lemma rdrop_nil : rdrop ([] : list α) n = [] := by simp [rdrop] +@[simp] lemma rdrop_zero : rdrop l 0 = l := by simp [rdrop] + +lemma rdrop_eq_reverse_drop_reverse : l.rdrop n = reverse (l.reverse.drop n) := +begin + rw rdrop, + induction l using list.reverse_rec_on with xs x IH generalizing n, + { simp }, + { cases n, + { simp [take_append] }, + { simp [take_append_eq_append_take, IH] } } +end + +@[simp] lemma rdrop_concat_succ (x : α) : rdrop (l ++ [x]) (n + 1) = rdrop l n := +by simp [rdrop_eq_reverse_drop_reverse] + +/-- Take `n` elements from the tail end of a list. -/ +def rtake : list α := l.drop (l.length - n) + +@[simp] lemma rtake_nil : rtake ([] : list α) n = [] := by simp [rtake] +@[simp] lemma rtake_zero : rtake l 0 = [] := by simp [rtake] + +lemma rtake_eq_reverse_take_reverse : l.rtake n = reverse (l.reverse.take n) := +begin + rw rtake, + induction l using list.reverse_rec_on with xs x IH generalizing n, + { simp }, + { cases n, + { simp }, + { simp [drop_append_eq_append_drop, IH] } } +end + +@[simp] lemma rtake_concat_succ (x : α) : rtake (l ++ [x]) (n + 1) = rtake l n ++ [x] := +by simp [rtake_eq_reverse_take_reverse] + +/-- Drop elements from the tail end of a list that satisfy `p : α → Prop`. +Implemented naively via `list.reverse` -/ +def rdrop_while : list α := reverse (l.reverse.drop_while p) + +@[simp] lemma rdrop_while_nil : rdrop_while p ([] : list α) = [] := +by simp [rdrop_while, drop_while] +lemma rdrop_while_concat (x : α) : + rdrop_while p (l ++ [x]) = if p x then rdrop_while p l else l ++ [x] := +begin + simp only [rdrop_while, drop_while, reverse_append, reverse_singleton, singleton_append], + split_ifs with h h; + simp [h] +end +@[simp] lemma rdrop_while_concat_pos (x : α) (h : p x) : + rdrop_while p (l ++ [x]) = rdrop_while p l := +by rw [rdrop_while_concat, if_pos h] +@[simp] lemma rdrop_while_concat_neg (x : α) (h : ¬ p x) : + rdrop_while p (l ++ [x]) = l ++ [x] := +by rw [rdrop_while_concat, if_neg h] + +lemma rdrop_while_singleton (x : α) : + rdrop_while p [x] = if p x then [] else [x] := +by rw [←nil_append [x], rdrop_while_concat, rdrop_while_nil] + +lemma rdrop_while_last_not (hl : (l.rdrop_while p) ≠ []): + ¬ p ((rdrop_while p l).last hl) := +begin + simp_rw rdrop_while, + rw last_reverse, + exact drop_while_nth_le_zero_not _ _ _ +end + +lemma rdrop_while_prefix : l.rdrop_while p <+: l := +begin + rw [←reverse_suffix, rdrop_while, reverse_reverse], + exact drop_while_suffix _ +end + +variables {p} {l} + +@[simp] lemma rdrop_while_eq_nil_iff : rdrop_while p l = [] ↔ ∀ x ∈ l, p x := +by simp [rdrop_while] + +-- it is in this file because it requires `list.infix` +@[simp] lemma drop_while_eq_self_iff : + drop_while p l = l ↔ ∀ (hl : 0 < l.length), ¬ p (l.nth_le 0 hl) := +begin + induction l with hd tl IH, + { simp }, + { rw drop_while, + split_ifs, + { simp only [h, length, nth_le, nat.succ_pos', not_true, forall_true_left, iff_false], + intro H, + refine (cons_ne_self hd tl) (sublist.antisymm _ (sublist_cons _ _)), + rw ←H, + exact (drop_while_suffix _).sublist }, + { simp [h] } } +end + +@[simp] lemma rdrop_while_eq_self_iff : rdrop_while p l = l ↔ ∀ (hl : l ≠ []), ¬ p (l.last hl) := +begin + simp only [rdrop_while, reverse_eq_iff, length_reverse, ne.def, drop_while_eq_self_iff, + last_eq_nth_le, ←length_eq_zero, pos_iff_ne_zero], + refine forall_congr _, + intro h, + rw [nth_le_reverse'], + { simp }, + { rw [←ne.def, ←pos_iff_ne_zero] at h, + simp [tsub_lt_iff_right (nat.succ_le_of_lt h)] } +end + +variables (p) (l) + +lemma drop_while_idempotent : drop_while p (drop_while p l) = drop_while p l := +drop_while_eq_self_iff.mpr (drop_while_nth_le_zero_not _ _) + +lemma rdrop_while_idempotent : rdrop_while p (rdrop_while p l) = rdrop_while p l := +rdrop_while_eq_self_iff.mpr (rdrop_while_last_not _ _) + +/-- Take elements from the tail end of a list that satisfy `p : α → Prop`. +Implemented naively via `list.reverse` -/ +def rtake_while : list α := reverse (l.reverse.take_while p) + +@[simp] lemma rtake_while_nil : rtake_while p ([] : list α) = [] := +by simp [rtake_while, take_while] +lemma rtake_while_concat (x : α) : + rtake_while p (l ++ [x]) = if p x then rtake_while p l ++ [x] else [] := +begin + simp only [rtake_while, take_while, reverse_append, reverse_singleton, singleton_append], + split_ifs with h h; + simp [h] +end +@[simp] lemma rtake_while_concat_pos (x : α) (h : p x) : + rtake_while p (l ++ [x]) = rtake_while p l ++ [x] := +by rw [rtake_while_concat, if_pos h] +@[simp] lemma rtake_while_concat_neg (x : α) (h : ¬ p x) : + rtake_while p (l ++ [x]) = [] := +by rw [rtake_while_concat, if_neg h] + +lemma rtake_while_suffix : l.rtake_while p <:+ l := +begin + rw [←reverse_prefix, rtake_while, reverse_reverse], + exact take_while_prefix _ +end + +variables {p} {l} + +@[simp] lemma rtake_while_eq_self_iff : rtake_while p l = l ↔ ∀ x ∈ l, p x := +by simp [rtake_while, reverse_eq_iff] + +@[simp] lemma rtake_while_eq_nil_iff : rtake_while p l = [] ↔ ∀ (hl : l ≠ []), ¬ p (l.last hl) := +begin + induction l using list.reverse_rec_on; + simp [rtake_while] +end + +lemma mem_rtake_while_imp {x : α} (hx : x ∈ rtake_while p l) : p x := +begin + suffices : x ∈ take_while p l.reverse, + { exact mem_take_while_imp this }, + rwa [←mem_reverse, ←rtake_while] +end + +variables (p) (l) + +lemma rtake_while_idempotent : rtake_while p (rtake_while p l) = rtake_while p l := +rtake_while_eq_self_iff.mpr (λ _, mem_rtake_while_imp) + +end list diff --git a/src/data/list/rotate.lean b/src/data/list/rotate.lean index b1ba189819b28..451bd4a8fef11 100644 --- a/src/data/list/rotate.lean +++ b/src/data/list/rotate.lean @@ -9,6 +9,9 @@ import data.list.range /-! # List rotation +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves basic results about `list.rotate`, the list rotation. ## Main declarations @@ -24,7 +27,7 @@ rotated, rotation, permutation, cycle universe u variables {α : Type u} -open nat +open nat function namespace list @@ -99,6 +102,10 @@ by rw [rotate_eq_rotate', rotate_eq_rotate', rotate'_cons_succ] @[simp] lemma length_rotate (l : list α) (n : ℕ) : (l.rotate n).length = l.length := by rw [rotate_eq_rotate', length_rotate'] +lemma rotate_replicate (a : α) (n : ℕ) (k : ℕ) : (replicate n a).rotate k = replicate n a := +eq_replicate.2 ⟨by rw [length_rotate, length_replicate], + λ b hb, eq_of_mem_replicate $ mem_rotate.1 hb⟩ + lemma rotate_eq_drop_append_take {l : list α} {n : ℕ} : n ≤ l.length → l.rotate n = l.drop n ++ l.take n := by rw rotate_eq_rotate'; exact rotate'_eq_drop_append_take @@ -165,23 +172,7 @@ by rw [eq_comm, rotate_eq_nil_iff, eq_comm] @[simp] lemma rotate_singleton (x : α) (n : ℕ) : [x].rotate n = [x] := -begin - induction n with n hn, - { simp }, - { rwa [rotate_cons_succ] } -end - -@[simp] lemma rotate_eq_singleton_iff {l : list α} {n : ℕ} {x : α} : l.rotate n = [x] ↔ l = [x] := -begin - induction n with n hn generalizing l, - { simp }, - { cases l with hd tl, - { simp }, - { simp [rotate_cons_succ, hn, append_eq_cons_iff, and_comm] } } -end - -@[simp] lemma singleton_eq_rotate_iff {l : list α} {n : ℕ} {x : α} : [x] = l.rotate n ↔ [x] = l := -by rw [eq_comm, rotate_eq_singleton_iff, eq_comm] +rotate_replicate x 1 n lemma zip_with_rotate_distrib {α β γ : Type*} (f : α → β → γ) (l : list α) (l' : list β) (n : ℕ) (h : l.length = l'.length) : @@ -241,18 +232,42 @@ begin simpa [mod_eq_of_lt hm, tsub_add_cancel_of_le hn'.le] using nat.mod_eq_of_lt hk } end +lemma nth_rotate {l : list α} {n m : ℕ} (hml : m < l.length) : + (l.rotate n).nth m = l.nth ((m + n) % l.length) := +begin + rw [nth_le_nth, nth_le_nth (nat.mod_lt _ _), nth_le_rotate], + rwa [length_rotate] +end + +lemma head'_rotate {l : list α} {n : ℕ} (h : n < l.length) : + head' (l.rotate n) = l.nth n := +by rw [← nth_zero, nth_rotate (n.zero_le.trans_lt h), zero_add, nat.mod_eq_of_lt h] + +lemma rotate_eq_self_iff_eq_replicate [hα : nonempty α] : + ∀ {l : list α}, (∀ n, l.rotate n = l) ↔ ∃ a, l = replicate l.length a +| [] := by simp +| (a :: l) := ⟨λ h, ⟨a, ext_le (length_replicate _ _).symm $ λ n h₁ h₂, + begin + inhabit α, + rw [nth_le_replicate, ← option.some_inj, ← nth_le_nth, ← head'_rotate h₁, h, head'] + end⟩, λ ⟨b, hb⟩ n, by rw [hb, rotate_replicate]⟩ + +lemma rotate_one_eq_self_iff_eq_replicate [nonempty α] {l : list α} : + l.rotate 1 = l ↔ ∃ a : α, l = list.replicate l.length a := +⟨λ h, rotate_eq_self_iff_eq_replicate.mp (λ n, nat.rec l.rotate_zero + (λ n hn, by rwa [nat.succ_eq_add_one, ←l.rotate_rotate, hn]) n), + λ h, rotate_eq_self_iff_eq_replicate.mpr h 1⟩ + lemma rotate_injective (n : ℕ) : function.injective (λ l : list α, l.rotate n) := begin - rintros l l' (h : l.rotate n = l'.rotate n), - have hle : l.length = l'.length := (l.length_rotate n).symm.trans (h.symm ▸ l'.length_rotate n), - rw [rotate_eq_drop_append_take_mod, rotate_eq_drop_append_take_mod] at h, - obtain ⟨hd, ht⟩ := append_inj h _, - { rw [←take_append_drop _ l, ht, hd, take_append_drop] }, - { rw [length_drop, length_drop, hle] } + rintro l₁ l₂ (h : l₁.rotate n = l₂.rotate n), + have : length l₁ = length l₂, by simpa only [length_rotate] using congr_arg length h, + refine ext_le this (λ k h₁ h₂, _), + rw [← nth_le_rotate' l₁ n, ← nth_le_rotate' l₂ n], + congr' 1; simp only [h, this] end --- possibly easier to find in doc-gen, otherwise not that useful. -lemma rotate_eq_rotate {l l' : list α} {n : ℕ} : +@[simp] lemma rotate_eq_rotate {l l' : list α} {n : ℕ} : l.rotate n = l'.rotate n ↔ l = l' := (rotate_injective n).eq_iff @@ -268,6 +283,12 @@ begin exact (nat.mod_lt _ hl).le } } end +@[simp] lemma rotate_eq_singleton_iff {l : list α} {n : ℕ} {x : α} : l.rotate n = [x] ↔ l = [x] := +by rw [rotate_eq_iff, rotate_singleton] + +@[simp] lemma singleton_eq_rotate_iff {l : list α} {n : ℕ} {x : α} : [x] = l.rotate n ↔ [x] = l := +by rw [eq_comm, rotate_eq_singleton_iff, eq_comm] + lemma reverse_rotate (l : list α) (n : ℕ) : (l.rotate n).reverse = l.reverse.rotate (l.length - (n % l.length)) := begin diff --git a/src/data/list/sections.lean b/src/data/list/sections.lean index eea26f06244f2..6ee2bb5893c57 100644 --- a/src/data/list/sections.lean +++ b/src/data/list/sections.lean @@ -8,6 +8,9 @@ import data.list.forall2 /-! # List sections +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves some stuff about `list.sections` (definition in `data.list.defs`). A section of a list of lists `[l₁, ..., lₙ]` is a list whose `i`-th element comes from the `i`-th list. -/ @@ -31,7 +34,7 @@ begin end theorem mem_sections_length {L : list (list α)} {f} (h : f ∈ sections L) : length f = length L := -forall₂_length_eq (mem_sections.1 h) +(mem_sections.1 h).length_eq lemma rel_sections {r : α → β → Prop} : (forall₂ (forall₂ r) ⇒ forall₂ (forall₂ r)) sections sections diff --git a/src/data/list/sigma.lean b/src/data/list/sigma.lean index 55082854cef6f..b24f8564ce41a 100644 --- a/src/data/list/sigma.lean +++ b/src/data/list/sigma.lean @@ -9,6 +9,9 @@ import data.list.perm /-! # Utilities for lists of sigmas +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file includes several ways of interacting with `list (sigma β)`, treated as a key-value store. If `α : Type*` and `β : α → Type*`, then we regard `s : sigma β` as having key `s.1 : α` and value @@ -77,6 +80,12 @@ nodupkeys_iff_pairwise.1 h nodupkeys (s::l) ↔ s.1 ∉ l.keys ∧ nodupkeys l := by simp [keys, nodupkeys] +theorem not_mem_keys_of_nodupkeys_cons {s : sigma β} {l : list (sigma β)} (h : nodupkeys (s :: l)) : + s.1 ∉ l.keys := (nodupkeys_cons.1 h).1 + +theorem nodupkeys_of_nodupkeys_cons {s : sigma β} {l : list (sigma β)} (h : nodupkeys (s :: l)) : + nodupkeys l := (nodupkeys_cons.1 h).2 + theorem nodupkeys.eq_of_fst_eq {l : list (sigma β)} (nd : nodupkeys l) {s s' : sigma β} (h : s ∈ l) (h' : s' ∈ l) : s.1 = s'.1 → s = s' := @@ -262,7 +271,7 @@ theorem lookup_all_sublist (a : α) : theorem lookup_all_length_le_one (a : α) {l : list (sigma β)} (h : l.nodupkeys) : length (lookup_all a l) ≤ 1 := by have := nodup.sublist ((lookup_all_sublist a l).map _) h; - rw map_map at this; rwa [← nodup_repeat, ← map_const _ a] + rw map_map at this; rwa [← nodup_replicate, ← map_const _ a] theorem lookup_all_eq_lookup (a : α) {l : list (sigma β)} (h : l.nodupkeys) : lookup_all a l = (lookup a l).to_list := @@ -303,7 +312,7 @@ begin { subst a', exact ⟨rfl, heq_of_eq $ nd.eq_of_mk_mem h h'⟩ }, { refl } }, { rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, dsimp [option.guard], split_ifs, - { subst a₁, rintro ⟨⟩, simp }, { rintro ⟨⟩ } }, + { exact id }, { rintro ⟨⟩ } }, end theorem keys_kreplace (a : α) (b : β a) : ∀ l : list (sigma β), diff --git a/src/data/list/sort.lean b/src/data/list/sort.lean index 4a5e7e1ab8070..914259bc948b3 100644 --- a/src/data/list/sort.lean +++ b/src/data/list/sort.lean @@ -3,11 +3,15 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Jeremy Avigad -/ +import data.list.of_fn import data.list.perm /-! # Sorting algorithms on lists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms: `list.insertion_sort` and `list.merge_sort`, and prove their correctness. @@ -66,8 +70,8 @@ begin have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m, antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _)) (h₁ _ (by simp [m])), - rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2, - (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2]; + rw [(@eq_replicate _ a (length u₂ + 1) (a::u₂)).2, + (@eq_replicate _ a (length u₂ + 1) (u₂++[a])).2]; split; simp [iff_true_intro this, or_comm] } end @@ -104,6 +108,23 @@ end end sorted +section monotone + +variables {n : ℕ} {α : Type uu} [preorder α] {f : fin n → α} + +/-- A tuple is monotone if and only if the list obtained from it is sorted. -/ +lemma monotone_iff_of_fn_sorted : monotone f ↔ (of_fn f).sorted (≤) := +begin + simp_rw [sorted, pairwise_iff_nth_le, length_of_fn, nth_le_of_fn', monotone_iff_forall_lt], + exact ⟨λ h i j hj hij, h $ fin.mk_lt_mk.mpr hij, λ h ⟨i, _⟩ ⟨j, hj⟩ hij, h i j hj hij⟩, +end + +/-- The list obtained from a monotone tuple is sorted. -/ +lemma monotone.of_fn_sorted (h : monotone f) : (of_fn f).sorted (≤) := +monotone_iff_of_fn_sorted.1 h + +end monotone + section sort variables {α : Type uu} (r : α → α → Prop) [decidable_rel r] local infix ` ≼ ` : 50 := r diff --git a/src/data/list/sublists.lean b/src/data/list/sublists.lean index b8cae59009627..d70adc5c082ee 100644 --- a/src/data/list/sublists.lean +++ b/src/data/list/sublists.lean @@ -3,11 +3,14 @@ Copyright (c) 2019 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.list.basic import data.nat.choose.basic +import data.list.perm /-! # sublists +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `list.sublists` gives a list of all (not necessarily contiguous) sublists of a list. This file contains basic results on this function. @@ -282,4 +285,114 @@ end length_of_sublists_len h⟩, λ ⟨h₁, h₂⟩, h₂ ▸ mem_sublists_len_self h₁⟩ +lemma sublists_len_of_length_lt {n} {l : list α} (h : l.length < n) : sublists_len n l = [] := +eq_nil_iff_forall_not_mem.mpr $ λ x, mem_sublists_len.not.mpr $ λ ⟨hs, hl⟩, + (h.trans_eq hl.symm).not_le (sublist.length_le hs) + +@[simp] lemma sublists_len_length : ∀ (l : list α), sublists_len l.length l = [l] +| [] := rfl +| (a::l) := by rw [length, sublists_len_succ_cons, sublists_len_length, map_singleton, + sublists_len_of_length_lt (lt_succ_self _), nil_append] + +open function + +theorem pairwise.sublists' {R} : ∀ {l : list α}, pairwise R l → + pairwise (lex (swap R)) (sublists' l) +| _ pairwise.nil := pairwise_singleton _ _ +| _ (@pairwise.cons _ _ a l H₁ H₂) := + begin + simp only [sublists'_cons, pairwise_append, pairwise_map, mem_sublists', mem_map, + exists_imp_distrib, and_imp], + refine ⟨H₂.sublists', H₂.sublists'.imp (λ l₁ l₂, lex.cons), _⟩, + rintro l₁ sl₁ x l₂ sl₂ rfl, + cases l₁ with b l₁, {constructor}, + exact lex.rel (H₁ _ $ sl₁.subset $ mem_cons_self _ _) + end + +theorem pairwise_sublists {R} {l : list α} (H : pairwise R l) : + pairwise (λ l₁ l₂, lex R (reverse l₁) (reverse l₂)) (sublists l) := +by { have := (pairwise_reverse.2 H).sublists', rwa [sublists'_reverse, pairwise_map] at this } + +@[simp] theorem nodup_sublists {l : list α} : nodup (sublists l) ↔ nodup l := +⟨λ h, (h.sublist (map_ret_sublist_sublists _)).of_map _, + λ h, (pairwise_sublists h).imp (λ _ _ h, mt reverse_inj.2 h.to_ne)⟩ + +@[simp] theorem nodup_sublists' {l : list α} : nodup (sublists' l) ↔ nodup l := +by rw [sublists'_eq_sublists, nodup_map_iff reverse_injective, + nodup_sublists, nodup_reverse] + +alias nodup_sublists ↔ nodup.of_sublists nodup.sublists +alias nodup_sublists' ↔ nodup.of_sublists' nodup.sublists' + +attribute [protected] nodup.sublists nodup.sublists' + +lemma nodup_sublists_len (n : ℕ) {l : list α} (h : nodup l) : (sublists_len n l).nodup := +h.sublists'.sublist $ sublists_len_sublist_sublists' _ _ + + +theorem sublists_cons_perm_append (a : α) (l : list α) : + sublists (a :: l) ~ sublists l ++ map (cons a) (sublists l) := +begin + simp only [sublists, sublists_aux_cons_cons, cons_append, perm_cons], + refine (perm.cons _ _).trans perm_middle.symm, + induction sublists_aux l cons with b l IH; simp, + exact (IH.cons _).trans perm_middle.symm +end + +theorem sublists_perm_sublists' : ∀ l : list α, sublists l ~ sublists' l +| [] := perm.refl _ +| (a::l) := let IH := sublists_perm_sublists' l in + by rw sublists'_cons; exact + (sublists_cons_perm_append _ _).trans (IH.append (IH.map _)) + +theorem revzip_sublists (l : list α) : + ∀ l₁ l₂, (l₁, l₂) ∈ revzip l.sublists → l₁ ++ l₂ ~ l := +begin + rw revzip, + apply list.reverse_rec_on l, + { intros l₁ l₂ h, simp at h, simp [h] }, + { intros l a IH l₁ l₂ h, + rw [sublists_concat, reverse_append, zip_append, ← map_reverse, + zip_map_right, zip_map_left] at h; [skip, {simp}], + simp only [prod.mk.inj_iff, mem_map, mem_append, prod.map_mk, prod.exists] at h, + rcases h with ⟨l₁, l₂', h, rfl, rfl⟩ | ⟨l₁', l₂, h, rfl, rfl⟩, + { rw ← append_assoc, + exact (IH _ _ h).append_right _ }, + { rw append_assoc, + apply (perm_append_comm.append_left _).trans, + rw ← append_assoc, + exact (IH _ _ h).append_right _ } } +end + +theorem revzip_sublists' (l : list α) : + ∀ l₁ l₂, (l₁, l₂) ∈ revzip l.sublists' → l₁ ++ l₂ ~ l := +begin + rw revzip, + induction l with a l IH; intros l₁ l₂ h, + { simp at h, simp [h] }, + { rw [sublists'_cons, reverse_append, zip_append, ← map_reverse, + zip_map_right, zip_map_left] at h; [simp at h, simp], + rcases h with ⟨l₁, l₂', h, rfl, rfl⟩ | ⟨l₁', h, rfl⟩, + { exact perm_middle.trans ((IH _ _ h).cons _) }, + { exact (IH _ _ h).cons _ } } +end + +lemma range_bind_sublists_len_perm {α : Type*} (l : list α) : + (list.range (l.length + 1)).bind (λ n, sublists_len n l) ~ sublists' l := +begin + induction l with h tl, + { simp [range_succ] }, + { simp_rw [range_succ_eq_map, length, cons_bind, map_bind, sublists_len_succ_cons, + sublists'_cons, list.sublists_len_zero, list.singleton_append], + refine ((bind_append_perm (range (tl.length + 1)) _ _).symm.cons _).trans _, + simp_rw [←list.bind_map, ←cons_append], + rw [←list.singleton_append, ←list.sublists_len_zero tl], + refine perm.append _ (l_ih.map _), + rw [list.range_succ, append_bind, bind_singleton, + sublists_len_of_length_lt (nat.lt_succ_self _), append_nil, + ←list.map_bind (λ n, sublists_len n tl) nat.succ, ←cons_bind 0 _ (λ n, sublists_len n tl), + ←range_succ_eq_map], + exact l_ih } +end + end list diff --git a/src/data/list/tfae.lean b/src/data/list/tfae.lean index c6838bb452d29..28cd9ad514de8 100644 --- a/src/data/list/tfae.lean +++ b/src/data/list/tfae.lean @@ -8,6 +8,9 @@ import data.list.basic /-! # The Following Are Equivalent +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file allows to state that all propositions in a list are equivalent. It is used by `tactic.tfae`. `tfae l` means `∀ x ∈ l, ∀ y ∈ l, x ↔ y`. This is equivalent to `pairwise (↔) l`. diff --git a/src/data/list/to_finsupp.lean b/src/data/list/to_finsupp.lean new file mode 100644 index 0000000000000..be6a39ccf4be5 --- /dev/null +++ b/src/data/list/to_finsupp.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2022 Yakov Pechersky. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yakov Pechersky +-/ + +import data.finsupp.basic + +/-! + +# Lists as finsupp + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +# Main definitions + +- `list.to_finsupp`: Interpret a list as a finitely supported function, where the indexing type +is `ℕ`, and the values are either the elements of the list (accessing by indexing) or `0` outside +of the list. + +# Main theorems + +- `list.to_finsupp_eq_sum_map_enum_single`: A `l : list M` over `M` an `add_monoid`, +when interpreted as a finitely supported function, is equal to the sum of `finsupp.single` +produced by mapping over `list.enum l`. + +## Implementation details + +The functions defined here rely on a decidability predicate that each element in the list +can be decidably determined to be not equal to zero or that one can decide one is out of the +bounds of a list. For concretely defined lists that are made up of elements of decidable terms, +this holds. More work will be needed to support lists over non-dec-eq types like `ℝ`, where the +elements are beyond the dec-eq terms of casted values from `ℕ, ℤ, ℚ`. + +-/ + +namespace list + +variables {M : Type*} [has_zero M] (l : list M) + [decidable_pred (λ i, nthd l i 0 ≠ 0)] (n : ℕ) + +/-- Indexing into a `l : list M`, as a finitely-supported function, +where the support are all the indices within the length of the list +that index to a non-zero value. Indices beyond the end of the list are sent to 0. + +This is a computable version of the `finsupp.on_finset` construction. +-/ +def to_finsupp : ℕ →₀ M := +{ to_fun := λ i, nthd l i 0, + support := (finset.range l.length).filter (λ i, nthd l i 0 ≠ 0), + mem_support_to_fun := λ n, begin + simp only [ne.def, finset.mem_filter, finset.mem_range, and_iff_right_iff_imp], + contrapose!, + exact nthd_eq_default _ _ + end } + +@[norm_cast] lemma coe_to_finsupp : (l.to_finsupp : ℕ → M) = λ i, l.nthd i 0 := rfl +@[simp, norm_cast] lemma to_finsupp_apply (i : ℕ) : + (l.to_finsupp : ℕ → M) i = l.nthd i 0 := rfl + +lemma to_finsupp_support : + l.to_finsupp.support = (finset.range l.length).filter (λ i, nthd l i 0 ≠ 0) := +rfl + +lemma to_finsupp_apply_lt (hn : n < l.length) : + l.to_finsupp n = l.nth_le n hn := +nthd_eq_nth_le _ _ _ + +lemma to_finsupp_apply_le (hn : l.length ≤ n) : + l.to_finsupp n = 0 := +nthd_eq_default _ _ hn + +@[simp] lemma to_finsupp_nil [decidable_pred (λ i, nthd ([] : list M) i 0 ≠ 0)] : + to_finsupp ([] : list M) = 0 := +by { ext, simp } + +lemma to_finsupp_singleton (x : M) + [decidable_pred (λ i, nthd [x] i 0 ≠ 0)] : + to_finsupp [x] = finsupp.single 0 x := +begin + ext ⟨_|i⟩; + simp [finsupp.single_apply, (nat.zero_lt_succ _).ne] +end + +@[simp] lemma to_finsupp_cons_apply_zero (x : M) (xs : list M) + [decidable_pred (λ i, nthd (x :: xs) i 0 ≠ 0)] : + (x :: xs).to_finsupp 0 = x := rfl + +@[simp] lemma to_finsupp_cons_apply_succ (x : M) (xs : list M) (n : ℕ) + [decidable_pred (λ i, nthd (x :: xs) i 0 ≠ 0)] + [decidable_pred (λ i, nthd xs i 0 ≠ 0)] : + (x :: xs).to_finsupp n.succ = xs.to_finsupp n := rfl + +lemma to_finsupp_cons_eq_single_add_emb_domain + {R : Type*} [add_zero_class R] (x : R) (xs : list R) + [decidable_pred (λ i, nthd (x :: xs) i 0 ≠ 0)] + [decidable_pred (λ i, nthd xs i 0 ≠ 0)] : + to_finsupp (x :: xs) = finsupp.single 0 x + + (to_finsupp xs).emb_domain ⟨nat.succ, nat.succ_injective⟩ := +begin + ext (_|i), + { simp only [nat.nat_zero_eq_zero, to_finsupp_cons_apply_zero, finsupp.coe_add, + pi.add_apply, finsupp.single_eq_same], + rw finsupp.emb_domain_notin_range, + { exact (add_zero _).symm }, + { simp } }, + { simp only [to_finsupp_cons_apply_succ, finsupp.coe_add, pi.add_apply], + have hi : i.succ = (⟨nat.succ, nat.succ_injective⟩ : ℕ ↪ ℕ) i := rfl, + rw [finsupp.single_apply_eq_zero.mpr, zero_add, hi, finsupp.emb_domain_apply], + simp } +end + +lemma to_finsupp_concat_eq_to_finsupp_add_single + {R : Type*} [add_zero_class R] (x : R) (xs : list R) + [decidable_pred (λ i, nthd (xs ++ [x]) i 0 ≠ 0)] + [decidable_pred (λ i, nthd xs i 0 ≠ 0)] : + to_finsupp (xs ++ [x]) = to_finsupp xs + finsupp.single xs.length x := +begin + ext i, + simp only [finsupp.coe_add, pi.add_apply, finsupp.single_apply], + rcases lt_trichotomy xs.length i with hi|rfl|hi, + { rw [to_finsupp_apply_le _ _ hi.le, to_finsupp_apply_le, + if_neg hi.ne, add_zero], + simpa using nat.succ_le_of_lt hi }, + { rw [to_finsupp_apply_lt, to_finsupp_apply_le _ _ le_rfl, + if_pos rfl, zero_add, nth_le_append_right le_rfl], + { simp }, + { simp } }, + { rw [to_finsupp_apply_lt _ _ hi, to_finsupp_apply_lt, if_neg hi.ne', add_zero, + nth_le_append], + simpa using nat.lt_succ_of_lt hi } +end + +lemma to_finsupp_eq_sum_map_enum_single {R : Type*} [add_monoid R] (l : list R) + [decidable_pred (λ i, nthd l i 0 ≠ 0)] : + to_finsupp l = (l.enum.map (λ (nr : ℕ × R), finsupp.single nr.1 nr.2)).sum := +begin + unfreezingI { induction l using list.reverse_rec_on with xs x IH }, + { convert to_finsupp_nil }, + { simp only [enum_append, map, enum_from_singleton, map_append, sum_append, sum_cons, + sum_nil, add_zero], + classical, + convert to_finsupp_concat_eq_to_finsupp_add_single _ _, + exact IH.symm } +end + +end list diff --git a/src/data/list/zip.lean b/src/data/list/zip.lean index aa1d3a29adf37..1528725e6a2b3 100644 --- a/src/data/list/zip.lean +++ b/src/data/list/zip.lean @@ -3,11 +3,15 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Kenny Lau -/ -import data.list.big_operators +import data.list.big_operators.basic +import algebra.order.monoid.min_max /-! # zip & unzip +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides results about `list.zip_with`, `list.zip` and `list.unzip` (definitions are in core Lean). `zip_with f l₁ l₂` applies `f : α → β → γ` pointwise to a list `l₁ : list α` and `l₂ : list β`. It @@ -23,7 +27,7 @@ universe u open nat namespace list -variables {α : Type u} {β γ δ : Type*} +variables {α : Type u} {β γ δ ε : Type*} @[simp] theorem zip_with_cons_cons (f : α → β → γ) (a : α) (b : β) (l₁ : list α) (l₂ : list β) : zip_with f (a :: l₁) (b :: l₂) = f a b :: zip_with f l₁ l₂ := rfl @@ -62,6 +66,13 @@ zip_with_nil_right _ l length (zip l₁ l₂) = min (length l₁) (length l₂) := length_zip_with _ +theorem all₂_zip_with {f : α → β → γ} {p : γ → Prop} : + ∀ {l₁ : list α} {l₂ : list β} (h : length l₁ = length l₂), + all₂ p (zip_with f l₁ l₂) ↔ forall₂ (λ x y, p (f x y)) l₁ l₂ +| [] [] _ := by simp +| (a :: l₁) (b :: l₂) h := + by { simp only [length_cons, add_left_inj] at h, simp [all₂_zip_with h] } + lemma lt_length_left_of_zip_with {f : α → β → γ} {i : ℕ} {l : list α} {l' : list β} (h : i < (zip_with f l l').length) : i < l.length := @@ -205,19 +216,70 @@ by { rw ←zip_map', congr, exact map_id _ } lemma map_prod_right_eq_zip {l : list α} (f : α → β) : l.map (λ x, (f x, x)) = (l.map f).zip l := by { rw ←zip_map', congr, exact map_id _ } -lemma zip_with_comm (f : α → α → β) (comm : ∀ (x y : α), f x y = f y x) - (l l' : list α) : - zip_with f l l' = zip_with f l' l := +lemma zip_with_comm (f : α → β → γ) : ∀ (la : list α) (lb : list β), + zip_with f la lb = zip_with (λ b a, f a b) lb la +| [] _ := (list.zip_with_nil_right _ _).symm +| (a :: as) [] := rfl +| (a :: as) (b :: bs) := congr_arg _ (zip_with_comm as bs) + +@[congr] +lemma zip_with_congr (f g : α → β → γ) (la : list α) (lb : list β) + (h : list.forall₂ (λ a b, f a b = g a b) la lb) : + zip_with f la lb = zip_with g la lb := begin - induction l with hd tl hl generalizing l', - { simp }, - { cases l', - { simp }, - { simp [comm, hl] } } + induction h with a b as bs hfg habs ih, + { refl }, + { exact congr_arg2 _ hfg ih } end +lemma zip_with_comm_of_comm (f : α → α → β) (comm : ∀ (x y : α), f x y = f y x) (l l' : list α) : + zip_with f l l' = zip_with f l' l := +by { rw zip_with_comm, simp only [comm] } + +@[simp] +lemma zip_with_same (f : α → α → δ) : ∀ (l : list α), zip_with f l l = l.map (λ a, f a a) +| [] := rfl +| (x :: xs) := congr_arg _ (zip_with_same xs) + +lemma zip_with_zip_with_left (f : δ → γ → ε) (g : α → β → δ) : + ∀ (la : list α) (lb : list β) (lc : list γ), + zip_with f (zip_with g la lb) lc = zip_with3 (λ a b c, f (g a b) c) la lb lc +| [] _ _ := rfl +| (a :: as) [] _ := rfl +| (a :: as) (b :: bs) [] := rfl +| (a :: as) (b :: bs) (c :: cs) := congr_arg (cons _) $ zip_with_zip_with_left as bs cs + +lemma zip_with_zip_with_right (f : α → δ → ε) (g : β → γ → δ) : + ∀ (la : list α) (lb : list β) (lc : list γ), + zip_with f la (zip_with g lb lc) = zip_with3 (λ a b c, f a (g b c)) la lb lc +| [] _ _ := rfl +| (a :: as) [] _ := rfl +| (a :: as) (b :: bs) [] := rfl +| (a :: as) (b :: bs) (c :: cs) := congr_arg (cons _) $ zip_with_zip_with_right as bs cs + +@[simp] +lemma zip_with3_same_left (f : α → α → β → γ) : ∀ (la : list α) (lb : list β), + zip_with3 f la la lb = zip_with (λ a b, f a a b) la lb +| [] _ := rfl +| (a :: as) [] := rfl +| (a :: as) (b :: bs) := congr_arg (cons _) $ zip_with3_same_left as bs + +@[simp] +lemma zip_with3_same_mid (f : α → β → α → γ) : ∀ (la : list α) (lb : list β), + zip_with3 f la lb la = zip_with (λ a b, f a b a) la lb +| [] _ := rfl +| (a :: as) [] := rfl +| (a :: as) (b :: bs) := congr_arg (cons _) $ zip_with3_same_mid as bs + +@[simp] +lemma zip_with3_same_right (f : α → β → β → γ) : ∀ (la : list α) (lb : list β), + zip_with3 f la lb lb = zip_with (λ a b, f a b b) la lb +| [] _ := rfl +| (a :: as) [] := rfl +| (a :: as) (b :: bs) := congr_arg (cons _) $ zip_with3_same_right as bs + instance (f : α → α → β) [is_symm_op α β f] : is_symm_op (list α) (list β) (zip_with f) := -⟨zip_with_comm f is_symm_op.symm_op⟩ +⟨zip_with_comm_of_comm f is_symm_op.symm_op⟩ @[simp] theorem length_revzip (l : list α) : length (revzip l) = length l := by simp only [revzip, length_zip, length_reverse, min_self] @@ -388,8 +450,8 @@ variables [comm_monoid α] @[to_additive] lemma prod_mul_prod_eq_prod_zip_with_mul_prod_drop : ∀ (L L' : list α), L.prod * L'.prod = (zip_with (*) L L').prod * (L.drop L'.length).prod * (L'.drop L.length).prod -| [] ys := by simp -| xs [] := by simp +| [] ys := by simp [nat.zero_le] +| xs [] := by simp [nat.zero_le] | (x :: xs) (y :: ys) := begin simp only [drop, length, zip_with_cons_cons, prod_cons], rw [mul_assoc x, mul_comm xs.prod, mul_assoc y, mul_comm ys.prod, diff --git a/src/data/matrix/auto.lean b/src/data/matrix/auto.lean new file mode 100644 index 0000000000000..0d75a92737462 --- /dev/null +++ b/src/data/matrix/auto.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.expr +import data.matrix.reflection + +/-! # Automatically generated lemmas for working with concrete matrices + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains "magic" lemmas which autogenerate to the correct size of matrix. For instance, +`matrix.of_mul_of_fin` can be used as: +```lean +example {α} [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) : + !![a₁₁, a₁₂; + a₂₁, a₂₂] ⬝ !![b₁₁, b₁₂; + b₂₁, b₂₂] = !![a₁₁ * b₁₁ + a₁₂ * b₂₁, a₁₁ * b₁₂ + a₁₂ * b₂₂; + a₂₁ * b₁₁ + a₂₂ * b₂₁, a₂₁ * b₁₂ + a₂₂ * b₂₂] := +begin + rw of_mul_of_fin, +end +``` + +## Main results + +* `matrix.fin_eta` +* `matrix.of_mul_of_fin` + +-/ + +/-- Like `list.mmap` but for a vector. -/ +def fin.mmap {α} {n : ℕ} {m : Type* → Type*} [monad m] (f : fin n → m α) : m (fin n → α) := +vector.nth <$> vector.mmap f ⟨list.fin_range n, list.length_fin_range _⟩ + +namespace matrix + +section fin_eta + +/-- Prove a statement of the form `∀ A : matrix m n α, A = !![A 0 0, ...]`. +Returns the type of this statement and its proof. -/ +meta def fin_eta.prove (m n : ℕ) : tactic (expr × expr) := +do + u ← tactic.mk_meta_univ, + α ← tactic.mk_local' `α binder_info.implicit (expr.sort u.succ), + A ← tactic.mk_local' `A binder_info.default + (expr.const `matrix [level.zero, level.zero, u] `(fin %%`(m)) `(fin %%`(n)) α), + let entries := λ (i : fin m) (j : fin n), A `(i) `(j), + let entry_vals := pi_fin.to_pexpr (λ i, pi_fin.to_pexpr (λ j, to_pexpr $ entries i j)), + let A_eta := (``(@matrix.of (fin %%`(m)) (fin %%`(n)) _).app entry_vals), + A_eq ← tactic.to_expr ``(%%A = %%A_eta), + t ← tactic.pis [α, A] A_eq, + ((), pr) ← tactic.solve_aux t `[intros α A, exact (matrix.eta_expand_eq A).symm], + pure (t, pr) + +/-- Helper tactic used as an `auto_param` for `matrix.fin_eta` -/ +meta def fin_eta.derive : tactic unit := +do + target@`(%%A' = %%A_eta) ← tactic.target, + (expr.const `matrix ls, [`(fin %%m), `(fin %%n), α]) + ← expr.get_app_fn_args <$> tactic.infer_type A', + some (m, n) ← pure (prod.mk <$> m.to_nat <*> n.to_nat) | + fail!"Dimensions {m} {n} are not numerals", + (t,pr) ← matrix.fin_eta.prove m n, + + tactic.unify target (t.instantiate_pis [α, A']), + tactic.exact (pr α A') + +/-- This lemma expands `A` into `!![A 0 0, ...]`. -/ +theorem fin_eta {α} {m n : ℕ} + (A : matrix (fin m) (fin n) α) {«!![A 0 0, ...]» : matrix (fin m) (fin n) α} + (h : A = «!![A 0 0, ...]» . matrix.fin_eta.derive) : A = «!![A 0 0, ...]» := h + +example : true := +begin + let B : matrix (fin 20) (fin 20) ℕ := 0, + have := matrix.fin_eta B, -- 400 coefficients, but very fast + have : B = B, by rw this, + trivial, +end + +end fin_eta + +section of_mul_of_fin + +/-- Choose a name suffix for a matrix index -/ +private def name_suffix {m n : ℕ} : fin m → fin n → string := +let chars := "₀₁₂₃₄₅₆₇₈₉".data in +if h : m ≤ 10 ∧ n ≤ 10 +then (λ i j, [chars.nth_le i (i.prop.trans_le h.1), chars.nth_le j (j.prop.trans_le h.2)].as_string) +else (λ i j, "_" ++ to_string i ++ "_" ++ to_string j) + +/-- `pi_fin.to_pexpr` but for matrices -/ +meta def fin_to_pexpr {m n : ℕ} (A : matrix (fin m) (fin n) pexpr) : pexpr := +``(@matrix.of (fin %%`(m)) (fin %%`(n)) _).app $ + pi_fin.to_pexpr (λ i : fin m, pi_fin.to_pexpr (λ j : fin n, A i j)) + +/-- This statement is defeq to `of_mul_of_fin`, but syntactically worse-/ +theorem of_mul_of_fin_aux (l m n : ℕ) ⦃α⦄ [has_mul α] [add_comm_monoid α] : + «forall» $ λ A : matrix (fin l) (fin m) α, + «forall» $ λ B : matrix (fin m) (fin n) α, + A.mul B = A.mulᵣ B := +by simp_rw [forall_iff, mulᵣ_eq, eq_self_iff_true, forall_const] + +/-- Prove a statement of the form +``` +∀ α [has_mul α] [add_comm_monoid α] (a₁₁ ... aₗₘ b₁₁ ... bₘₙ : α), + !![a₁₁ ⋱ aₗₘ] ⬝ !![b₁₁ ⋱ bₘₙ] = !![⋱] +``` +Returns the type of this statement and its proof. -/ +meta def of_mul_of_fin.prove (l m n : ℕ) : tactic (expr × expr) := +do + -- create all the binders, one for each coefficient + u ← tactic.mk_meta_univ, + α ← tactic.mk_local' `α binder_info.implicit (expr.sort u.succ), + has_mul_α ← tactic.mk_app `has_mul [α] >>= tactic.mk_local' `_inst_1 binder_info.inst_implicit, + add_comm_monoid_α ← + tactic.mk_app `add_comm_monoid [α] >>= tactic.mk_local' `_inst_2 binder_info.inst_implicit, + a ← (fin.mmap $ λ i : fin l, fin.mmap $ λ j : fin m, + tactic.mk_local' ((`a).append_suffix (name_suffix i j)) binder_info.default α), + b ← (fin.mmap $ λ i : fin m, fin.mmap $ λ j : fin n, + tactic.mk_local' ((`b).append_suffix (name_suffix i j)) binder_info.default α), + let a_flat := (list.fin_range l).bind (λ i, (list.fin_range m).map $ λ j, a i j), + let b_flat := (list.fin_range m).bind (λ i, (list.fin_range n).map $ λ j, b i j), + let args := [α, has_mul_α, add_comm_monoid_α] ++ a_flat ++ b_flat, + + -- build the matrices out of the coefficients + let A := matrix.fin_to_pexpr (matrix.map a to_pexpr), + let B := matrix.fin_to_pexpr (matrix.map b to_pexpr), + -- get an instance cache holding all the instances needed for matrix multiplication. There must + -- be a better way to do this. + t ← tactic.mk_instance_cache α, + has_add_α ← tactic.mk_app `has_add [α] >>= (λ t, prod.snd <$> @tactic.solve_aux unit t (do + { tmp2 ← tactic.pose `_inst_2' none add_comm_monoid_α, + tactic.reset_instance_cache, + tactic.apply_instance })), + has_zero_α ← tactic.mk_app `has_zero [α] >>= (λ t, prod.snd <$> @tactic.solve_aux unit t (do + { tmp2 ← tactic.pose `_inst_2' none add_comm_monoid_α, + tactic.reset_instance_cache, + tactic.apply_instance })), + let t := {inst := [ + (`has_mul, has_mul_α), + (`has_add, has_add_α), + (`has_zero, has_zero_α), + (`add_comm_monoid, add_comm_monoid_α)].foldl (λ n x, n.insert x.1 x.2) t.inst, + ..t}, + + -- clever trick: create algebraic instances on `expr` so that we can use `matrix.mul` or + -- `matrix.mulᵣ` to build the expression we want to end up with. It doesn't matter which we pick, + -- but the typeclasses are easier to create for the latter. + (t, has_mul_αe) ← expr.has_mul t, + (t, has_add_αe) ← expr.has_add t, + (t, has_zero_αe) ← expr.has_zero t, + let ab := @matrix.mulᵣ _ _ _ _ has_mul_αe has_add_αe has_zero_αe a b, + let AB := matrix.fin_to_pexpr (matrix.map ab to_pexpr), + + -- State and prove the equality, noting the RHS is defeq to `mulᵣ A B`. + A_eq ← tactic.to_expr ``(@matrix.mul _ _ _ _ _ %%has_mul_α %%add_comm_monoid_α %%A %%B = %%AB), + t ← tactic.pis args A_eq, + let pr := (expr.const `matrix.of_mul_of_fin_aux [u]).mk_app [`(l), `(m), `(n)], + -- This seems to create a metavariable then assign it, which ensures `pr` carries the right type. + ((), pr) ← tactic.solve_aux t $ tactic.exact pr, + + pure (t, pr) + +open_locale matrix + + +/-- Helper tactic used as an `auto_param` for `matrix.of_mul_of_fin` -/ +meta def of_mul_of_fin.derive : tactic unit := +do + target@`(@matrix.mul (fin %%l) (fin %%m) (fin %%n) %%α %%_ %%i1 %%i2 %%A %%B = %%AB) + ← tactic.target, + some (l, m, n) ← pure (prod.mk <$> l.to_nat <*> (prod.mk <$> m.to_nat <*> n.to_nat)) | + fail!"Dimensions {l}, {m} {n} are not numerals", + (t,pr) ← of_mul_of_fin.prove l m n, + tactic.apply (pr α i1 i2) {}, + tactic.done + -- TODO: should we be extracting the coefficients manually so we can do a full invocation as + -- something like: + -- tactic.unify target (t.instantiate_pis [α, A']), + -- tactic.exact (pr α A') + +/-- This lemma assumes that `a_coeffs` and `b_coeffs` refer to expressions of the form +`![![x₀₀, x₀₁], ![x₁₀, x₁₁]]`. It then uses an `auto_param` to populate `ab_coeffs` with an +expression of the same form, containing the appropriate expressions in terms of `+`, `*`, `aᵢⱼ`, +and `bⱼₖ`. -/ +theorem of_mul_of_fin {α} [has_mul α] [add_comm_monoid α] {l m n : ℕ} + {a_coeffs : fin l → fin m → α} + {b_coeffs : fin m → fin n → α} + {ab_coeffs : fin l → fin n → α} + (h : of a_coeffs ⬝ of b_coeffs = of ab_coeffs . of_mul_of_fin.derive) : + of a_coeffs ⬝ of b_coeffs = of ab_coeffs := h + +end of_mul_of_fin + +end matrix diff --git a/src/data/matrix/basic.lean b/src/data/matrix/basic.lean index 6b32afe45ee3c..d681d732fc588 100644 --- a/src/data/matrix/basic.lean +++ b/src/data/matrix/basic.lean @@ -3,21 +3,30 @@ Copyright (c) 2018 Ellen Arlt. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Ellen Arlt, Blair Shi, Sean Leather, Mario Carneiro, Johan Commelin, Lu-Ming Zhang -/ -import algebra.algebra.basic + +import algebra.algebra.pi import algebra.big_operators.pi import algebra.big_operators.ring +import algebra.big_operators.ring_equiv import algebra.module.linear_map import algebra.module.pi -import algebra.ring.equiv +import algebra.star.big_operators import algebra.star.module import algebra.star.pi -import data.fintype.card +import data.fintype.big_operators /-! # Matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines basic properties of matrices. +Matrices with rows indexed by `m`, columns indexed by `n`, and entries of type `α` are represented +with `matrix m n α`. For the typical approach of counting rows and columns, +`matrix (fin m) (fin n) α` can be used. + ## Notation The locale `matrix` gives the following notation: @@ -27,6 +36,13 @@ The locale `matrix` gives the following notation: * `ᵀ` for `matrix.transpose` * `ᴴ` for `matrix.conj_transpose` +## Implementation notes + +For convenience, `matrix m n α` is defined as `m → n → α`, as this allows elements of the matrix +to be accessed with `A i j`. However, it is not advisable to _construct_ matrices using terms of the +form `λ i j, _` or even `(λ i j, _ : matrix m n α)`, as these are not recognized by lean as having +the right type. Instead, `matrix.of` should be used. + ## TODO Under various conditions, multiplication of infinite matrices makes sense. @@ -36,7 +52,7 @@ universes u u' v w open_locale big_operators -/-- `matrix m n` is the type of matrices whose rows are indexed by `m` +/-- `matrix m n R` is the type of matrices with entries in `R`, whose rows are indexed by `m` and whose columns are indexed by `n`. -/ def matrix (m : Type u) (n : Type u') (α : Type v) : Type (max u u' v) := m → n → α @@ -57,6 +73,25 @@ ext_iff.mp end ext +/-- Cast a function into a matrix. + +The two sides of the equivalence are definitionally equal types. We want to use an explicit cast +to distinguish the types because `matrix` has different instances to pi types (such as `pi.has_mul`, +which performs elementwise multiplication, vs `matrix.has_mul`). + +If you are defining a matrix, in terms of its entries, use `of (λ i j, _)`. The +purpose of this approach is to ensure that terms of th +e form `(λ i j, _) * (λ i j, _)` do not +appear, as the type of `*` can be misleading. + +Porting note: In Lean 3, it is also safe to use pattern matching in a definition as `| i j := _`, +which can only be unfolded when fully-applied. leanprover/lean4#2042 means this does not +(currently) work in Lean 4. +-/ +def of : (m → n → α) ≃ matrix m n α := equiv.refl _ +@[simp] lemma of_apply (f : m → n → α) (i j) : of f i j = f i j := rfl +@[simp] lemma of_symm_apply (f : matrix m n α) (i j) : of.symm f i j = f i j := rfl + /-- `M.map f` is the matrix obtained by applying `f` to each entry of the matrix `M`. This is available in bundled forms as: @@ -70,7 +105,7 @@ This is available in bundled forms as: * `ring_equiv.map_matrix` * `alg_equiv.map_matrix` -/ -def map (M : matrix m n α) (f : α → β) : matrix m n β := λ i j, f (M i j) +def map (M : matrix m n α) (f : α → β) : matrix m n β := of (λ i j, f (M i j)) @[simp] lemma map_apply {M : matrix m n α} {f : α → β} {i : m} {j : n} : @@ -90,24 +125,35 @@ lemma map_injective {f : α → β} (hf : function.injective f) : λ M N h, ext $ λ i j, hf $ ext_iff.mpr h i j /-- The transpose of a matrix. -/ -def transpose (M : matrix m n α) : matrix n m α -| x y := M y x +def transpose (M : matrix m n α) : matrix n m α := +of $ λ x y, M y x -localized "postfix `ᵀ`:1500 := matrix.transpose" in matrix +-- TODO: set as an equation lemma for `transpose`, see mathlib4#3024 +@[simp] lemma transpose_apply (M : matrix m n α) (i j) : + transpose M i j = M j i := rfl + +localized "postfix (name := matrix.transpose) `ᵀ`:1500 := matrix.transpose" in matrix /-- The conjugate transpose of a matrix defined in term of `star`. -/ def conj_transpose [has_star α] (M : matrix m n α) : matrix n m α := M.transpose.map star -localized "postfix `ᴴ`:1500 := matrix.conj_transpose" in matrix +localized "postfix (name := matrix.conj_transpose) `ᴴ`:1500 := matrix.conj_transpose" in matrix /-- `matrix.col u` is the column matrix whose entries are given by `u`. -/ -def col (w : m → α) : matrix m unit α -| x y := w x +def col (w : m → α) : matrix m unit α := +of $ λ x y, w x + +-- TODO: set as an equation lemma for `col`, see mathlib4#3024 +@[simp] lemma col_apply (w : m → α) (i j) : + col w i j = w i := rfl /-- `matrix.row u` is the row matrix whose entries are given by `u`. -/ -def row (v : n → α) : matrix unit n α -| x y := v y +def row (v : n → α) : matrix unit n α := +of $ λ x y, v y + +-- TODO: set as an equation lemma for `row`, see mathlib4#3024 +@[simp] lemma row_apply (v : n → α) (i j) : row v i j = v j := rfl instance [inhabited α] : inhabited (matrix m n α) := pi.inhabited _ instance [has_add α] : has_add (matrix m n α) := pi.has_add @@ -126,12 +172,12 @@ instance [subsingleton α] : subsingleton (matrix m n α) := pi.subsingleton instance [nonempty m] [nonempty n] [nontrivial α] : nontrivial (matrix m n α) := function.nontrivial -instance [has_scalar R α] : has_scalar R (matrix m n α) := pi.has_scalar -instance [has_scalar R α] [has_scalar S α] [smul_comm_class R S α] : +instance [has_smul R α] : has_smul R (matrix m n α) := pi.has_smul +instance [has_smul R α] [has_smul S α] [smul_comm_class R S α] : smul_comm_class R S (matrix m n α) := pi.smul_comm_class -instance [has_scalar R S] [has_scalar R α] [has_scalar S α] [is_scalar_tower R S α] : +instance [has_smul R S] [has_smul R α] [has_smul S α] [is_scalar_tower R S α] : is_scalar_tower R S (matrix m n α) := pi.is_scalar_tower -instance [has_scalar R α] [has_scalar Rᵐᵒᵖ α] [is_central_scalar R α] : +instance [has_smul R α] [has_smul Rᵐᵒᵖ α] [is_central_scalar R α] : is_central_scalar R (matrix m n α) := pi.is_central_scalar instance [monoid R] [mul_action R α] : mul_action R (matrix m n α) := pi.mul_action _ @@ -140,6 +186,13 @@ instance [monoid R] [add_monoid α] [distrib_mul_action R α] : instance [semiring R] [add_comm_monoid α] [module R α] : module R (matrix m n α) := pi.module _ _ _ +/-! simp-normal form pulls `of` to the outside. -/ +@[simp] lemma of_zero [has_zero α] : of (0 : m → n → α) = 0 := rfl +@[simp] lemma of_add_of [has_add α] (f g : m → n → α) : of f + of g = of (f + g) := rfl +@[simp] lemma of_sub_of [has_sub α] (f g : m → n → α) : of f - of g = of (f - g) := rfl +@[simp] lemma neg_of [has_neg α] (f : m → n → α) : -of f = of (-f) := rfl +@[simp] lemma smul_of [has_smul R α] (r : R) (f : m → n → α) : r • of f = of (r • f) := rfl + @[simp] protected lemma map_zero [has_zero α] [has_zero β] (f : α → β) (h : f 0 = 0) : (0 : matrix m n α).map f = 0 := by { ext, simp [h], } @@ -154,25 +207,25 @@ protected lemma map_sub [has_sub α] [has_sub β] (f : α → β) (M N : matrix m n α) : (M - N).map f = M.map f - N.map f := ext $ λ _ _, hf _ _ -lemma map_smul [has_scalar R α] [has_scalar R β] (f : α → β) (r : R) +lemma map_smul [has_smul R α] [has_smul R β] (f : α → β) (r : R) (hf : ∀ a, f (r • a) = r • f a) (M : matrix m n α) : (r • M).map f = r • (M.map f) := ext $ λ _ _, hf _ -/-- The scalar action via `has_mul.to_has_scalar` is transformed by the same map as the elements +/-- The scalar action via `has_mul.to_has_smul` is transformed by the same map as the elements of the matrix, when `f` preserves multiplication. -/ lemma map_smul' [has_mul α] [has_mul β] (f : α → β) (r : α) (A : matrix n n α) (hf : ∀ a₁ a₂, f (a₁ * a₂) = f a₁ * f a₂) : (r • A).map f = f r • A.map f := ext $ λ _ _, hf _ _ -/-- The scalar action via `has_mul.to_has_opposite_scalar` is transformed by the same map as the +/-- The scalar action via `has_mul.to_has_opposite_smul` is transformed by the same map as the elements of the matrix, when `f` preserves multiplication. -/ lemma map_op_smul' [has_mul α] [has_mul β] (f : α → β) (r : α) (A : matrix n n α) (hf : ∀ a₁ a₂, f (a₁ * a₂) = f a₁ * f a₂) : (mul_opposite.op r • A).map f = mul_opposite.op (f r) • A.map f := ext $ λ _ _, hf _ _ -lemma _root_.is_smul_regular.matrix [has_scalar R S] {k : R} (hk : is_smul_regular S k) : +lemma _root_.is_smul_regular.matrix [has_smul R S] {k : R} (hk : is_smul_regular S k) : is_smul_regular (matrix m n S) k := is_smul_regular.pi $ λ _, is_smul_regular.pi $ λ _, hk @@ -180,12 +233,10 @@ lemma _root_.is_left_regular.matrix [has_mul α] {k : α} (hk : is_left_regular is_smul_regular (matrix m n α) k := hk.is_smul_regular.matrix --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_empty_left [is_empty m] : subsingleton (matrix m n α) := +instance subsingleton_of_empty_left [is_empty m] : subsingleton (matrix m n α) := ⟨λ M N, by { ext, exact is_empty_elim i }⟩ --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_empty_right [is_empty n] : subsingleton (matrix m n α) := +instance subsingleton_of_empty_right [is_empty n] : subsingleton (matrix m n α) := ⟨λ M N, by { ext, exact is_empty_elim j }⟩ end matrix @@ -206,8 +257,12 @@ Note that bundled versions exist as: * `matrix.diagonal_ring_hom` * `matrix.diagonal_alg_hom` -/ -def diagonal [has_zero α] (d : n → α) : matrix n n α -| i j := if i = j then d i else 0 +def diagonal [has_zero α] (d : n → α) : matrix n n α := +of $ λ i j, if i = j then d i else 0 + +-- TODO: set as an equation lemma for `diagonal`, see mathlib4#3024 +lemma diagonal_apply [has_zero α] (d : n → α) (i j) : diagonal d i j = if i = j then d i else 0 := +rfl @[simp] theorem diagonal_apply_eq [has_zero α] (d : n → α) (i : n) : (diagonal d) i i = d i := by simp [diagonal] @@ -218,6 +273,11 @@ by simp [diagonal] theorem diagonal_apply_ne' [has_zero α] (d : n → α) {i j : n} (h : j ≠ i) : (diagonal d) i j = 0 := diagonal_apply_ne d h.symm +@[simp] theorem diagonal_eq_diagonal_iff [has_zero α] {d₁ d₂ : n → α} : + diagonal d₁ = diagonal d₂ ↔ ∀ i, d₁ i = d₂ i := +⟨λ h i, by simpa using congr_arg (λ m : matrix n n α, m i i) h, + λ h, by rw show d₁ = d₂, from funext h⟩ + lemma diagonal_injective [has_zero α] : function.injective (diagonal : (n → α) → matrix n n α) := λ d₁ d₂ h, funext $ λ i, by simpa using matrix.ext_iff.mpr h i i @@ -264,7 +324,7 @@ variables {n α R} @[simp] lemma diagonal_map [has_zero α] [has_zero β] {f : α → β} (h : f 0 = 0) {d : n → α} : (diagonal d).map f = diagonal (λ m, f (d m)) := -by { ext, simp only [diagonal, map_apply], split_ifs; simp [h], } +by { ext, simp only [diagonal_apply, map_apply], split_ifs; simp [h], } @[simp] lemma diagonal_conj_transpose [add_monoid α] [star_add_monoid α] (v : n → α) : (diagonal v)ᴴ = diagonal (star v) := @@ -343,7 +403,7 @@ funext $ @diagonal_apply_eq _ _ _ _ a @[simp] theorem diag_neg [has_neg α] (A : matrix n n α) : diag (-A) = -diag A := rfl -@[simp] theorem diag_smul [has_scalar R α] (r : R) (A : matrix n n α) : diag (r • A) = r • diag A := +@[simp] theorem diag_smul [has_smul R α] (r : R) (A : matrix n n α) : diag (r • A) = r • diag A := rfl @[simp] theorem diag_one [decidable_eq n] [has_zero α] [has_one α] : diag (1 : matrix n n α) = 1 := @@ -389,17 +449,17 @@ end diag section dot_product -variable [fintype m] +variables [fintype m] [fintype n] /-- `dot_product v w` is the sum of the entrywise products `v i * w i` -/ def dot_product [has_mul α] [add_comm_monoid α] (v w : m → α) : α := ∑ i, v i * w i -/- The precedence of 72 comes immediately after ` • ` for `has_scalar.smul`, +/- The precedence of 72 comes immediately after ` • ` for `has_smul.smul`, so that `r₁ • a ⬝ᵥ r₂ • b` is parsed as `(r₁ • a) ⬝ᵥ (r₂ • b)` here. -/ -localized "infix ` ⬝ᵥ `:72 := matrix.dot_product" in matrix +localized "infix (name := matrix.dot_product) ` ⬝ᵥ `:72 := matrix.dot_product" in matrix -lemma dot_product_assoc [fintype n] [non_unital_semiring α] (u : m → α) (w : n → α) +lemma dot_product_assoc [non_unital_semiring α] (u : m → α) (w : n → α) (v : matrix m n α) : (λ j, u ⬝ᵥ (λ i, v i j)) ⬝ᵥ w = u ⬝ᵥ (λ i, (v i) ⬝ᵥ w) := by simpa [dot_product, finset.mul_sum, finset.sum_mul, mul_assoc] using finset.sum_comm @@ -412,8 +472,16 @@ by simp_rw [dot_product, mul_comm] v ⬝ᵥ w = v ⟨⟩ * w ⟨⟩ := by simp [dot_product] +section mul_one_class +variables [mul_one_class α] [add_comm_monoid α] + +lemma dot_product_one (v : n → α) : v ⬝ᵥ 1 = ∑ i, v i := by simp [(⬝ᵥ)] +lemma one_dot_product (v : n → α) : 1 ⬝ᵥ v = ∑ i, v i := by simp [(⬝ᵥ)] + +end mul_one_class + section non_unital_non_assoc_semiring -variables [non_unital_non_assoc_semiring α] (u v w : m → α) +variables [non_unital_non_assoc_semiring α] (u v w : m → α) (x y : n → α) @[simp] lemma dot_product_zero : v ⬝ᵥ 0 = 0 := by simp [dot_product] @@ -429,6 +497,23 @@ by simp [dot_product, add_mul, finset.sum_add_distrib] @[simp] lemma dot_product_add : u ⬝ᵥ (v + w) = u ⬝ᵥ v + u ⬝ᵥ w := by simp [dot_product, mul_add, finset.sum_add_distrib] +@[simp] lemma sum_elim_dot_product_sum_elim : + (sum.elim u x) ⬝ᵥ (sum.elim v y) = u ⬝ᵥ v + x ⬝ᵥ y := +by simp [dot_product] + +/-- Permuting a vector on the left of a dot product can be transferred to the right. -/ +@[simp] lemma comp_equiv_symm_dot_product (e : m ≃ n) : (u ∘ e.symm) ⬝ᵥ x = u ⬝ᵥ (x ∘ e) := +(e.sum_comp _).symm.trans $ finset.sum_congr rfl $ λ _ _, + by simp only [function.comp, equiv.symm_apply_apply] + +/-- Permuting a vector on the right of a dot product can be transferred to the left. -/ +@[simp] lemma dot_product_comp_equiv_symm (e : n ≃ m) : u ⬝ᵥ (x ∘ e.symm) = (u ∘ e) ⬝ᵥ x := +by simpa only [equiv.symm_symm] using (comp_equiv_symm_dot_product u x e.symm).symm + +/-- Permuting vectors on both sides of a dot product is a no-op. -/ +@[simp] lemma comp_equiv_dot_product_comp_equiv (e : m ≃ n) : (x ∘ e) ⬝ᵥ (y ∘ e) = x ⬝ᵥ y := +by simp only [←dot_product_comp_equiv_symm, function.comp, equiv.apply_symm_apply] + end non_unital_non_assoc_semiring section non_unital_non_assoc_semiring_decidable @@ -456,6 +541,14 @@ by convert finset.sum_eq_single i (λ j _, this j) _ using 1; simp end non_unital_non_assoc_semiring_decidable +section non_assoc_semiring +variables [non_assoc_semiring α] + +@[simp] lemma one_dot_product_one : (1 : n → α) ⬝ᵥ 1 = fintype.card n := +by simp [dot_product, fintype.card] + +end non_assoc_semiring + section non_unital_non_assoc_ring variables [non_unital_non_assoc_ring α] (u v w : m → α) @@ -509,7 +602,7 @@ protected def mul [fintype m] [has_mul α] [add_comm_monoid α] (M : matrix l m α) (N : matrix m n α) : matrix l n α := λ i k, (λ j, M i j) ⬝ᵥ (λ j, N j k) -localized "infixl ` ⬝ `:75 := matrix.mul" in matrix +localized "infixl (name := matrix.mul) ` ⬝ `:75 := matrix.mul" in matrix theorem mul_apply [fintype m] [has_mul α] [add_comm_monoid α] {M : matrix l m α} {N : matrix m n α} {i k} : (M ⬝ N) i k = ∑ j, M i j * N j k := rfl @@ -532,6 +625,18 @@ lemma sum_apply [add_comm_monoid α] (i : m) (j : n) (∑ c in s, g c) i j = ∑ c in s, g c i j := (congr_fun (s.sum_apply i g) j).trans (s.sum_apply j _) +lemma two_mul_expl {R : Type*} [comm_ring R] (A B : matrix (fin 2) (fin 2) R) : + (A * B) 0 0 = A 0 0 * B 0 0 + A 0 1 * B 1 0 ∧ + (A * B) 0 1 = A 0 0 * B 0 1 + A 0 1 * B 1 1 ∧ + (A * B) 1 0 = A 1 0 * B 0 0 + A 1 1 * B 1 0 ∧ + (A * B) 1 1 = A 1 0 * B 0 1 + A 1 1 * B 1 1 := +begin + split, work_on_goal 2 {split}, work_on_goal 3 {split}, + all_goals {simp only [matrix.mul_eq_mul], + rw [matrix.mul_apply, finset.sum_fin_eq_sum_range, finset.sum_range_succ, finset.sum_range_succ], + simp}, +end + section add_comm_monoid variables [add_comm_monoid α] [has_mul α] @@ -644,6 +749,9 @@ instance [fintype n] [decidable_eq n] : non_assoc_semiring (matrix n n α) := { one := 1, one_mul := matrix.one_mul, mul_one := matrix.mul_one, + nat_cast := λ n, diagonal (λ _, n), + nat_cast_zero := by ext; simp [nat.cast], + nat_cast_succ := λ n, by ext; by_cases i = j; simp [nat.cast, *], .. matrix.non_unital_non_assoc_semiring } @[simp] @@ -724,7 +832,7 @@ lemma diagonal_pow [fintype n] [decidable_eq n] (v : n → α) (k : ℕ) : (map_pow (diagonal_ring_hom n α) v k).symm @[simp] lemma mul_mul_left [fintype n] (M : matrix m n α) (N : matrix n o α) (a : α) : - (λ i j, a * M i j) ⬝ N = a • (M ⬝ N) := + of (λ i j, a * M i j) ⬝ N = a • (M ⬝ N) := smul_mul a M N /-- @@ -772,7 +880,7 @@ lemma smul_eq_mul_diagonal [decidable_eq n] (M : matrix m n α) (a : α) : by { ext, simp [mul_comm] } @[simp] lemma mul_mul_right (M : matrix m n α) (N : matrix n o α) (a : α) : - M ⬝ (λ i j, a * N i j) = a • (M ⬝ N) := + M ⬝ of (λ i j, a * N i j) = a • (M ⬝ N) := mul_smul M a N lemma scalar.commute [decidable_eq n] (r : α) (M : matrix n n α) : commute (scalar n r) M := @@ -1056,8 +1164,13 @@ namespace matrix /-- For two vectors `w` and `v`, `vec_mul_vec w v i j` is defined to be `w i * v j`. Put another way, `vec_mul_vec w v` is exactly `col w ⬝ row v`. -/ -def vec_mul_vec [has_mul α] (w : m → α) (v : n → α) : matrix m n α -| x y := w x * v y +def vec_mul_vec [has_mul α] (w : m → α) (v : n → α) : matrix m n α := +of $ λ x y, w x * v y + +-- TODO: set as an equation lemma for `vec_mul_vec`, see mathlib4#3024 +lemma vec_mul_vec_apply [has_mul α] (w : m → α) (v : n → α) (i j) : + vec_mul_vec w v i j = w i * v j := +rfl lemma vec_mul_vec_eq [has_mul α] [add_comm_monoid α] (w : m → α) (v : n → α) : vec_mul_vec w v = (col w) ⬝ (row v) := @@ -1142,23 +1255,81 @@ lemma mul_vec_smul [fintype n] [monoid R] [non_unital_non_assoc_semiring S] [dis M.mul_vec (b • v) = b • M.mul_vec v := by { ext i, simp only [mul_vec, dot_product, finset.smul_sum, pi.smul_apply, mul_smul_comm] } +@[simp] lemma mul_vec_single [fintype n] [decidable_eq n] [non_unital_non_assoc_semiring R] + (M : matrix m n R) (j : n) (x : R) : + M.mul_vec (pi.single j x) = (λ i, M i j * x) := +funext $ λ i, dot_product_single _ _ _ + +@[simp] lemma single_vec_mul [fintype m] [decidable_eq m] [non_unital_non_assoc_semiring R] + (M : matrix m n R) (i : m) (x : R) : + vec_mul (pi.single i x) M = (λ j, x * M i j) := +funext $ λ i, single_dot_product _ _ _ + +@[simp] lemma diagonal_mul_vec_single [fintype n] [decidable_eq n] [non_unital_non_assoc_semiring R] + (v : n → R) (j : n) (x : R) : + (diagonal v).mul_vec (pi.single j x) = pi.single j (v j * x) := +begin + ext i, + rw mul_vec_diagonal, + exact pi.apply_single (λ i x, v i * x) (λ i, mul_zero _) j x i, +end + +@[simp] lemma single_vec_mul_diagonal [fintype n] [decidable_eq n] [non_unital_non_assoc_semiring R] + (v : n → R) (j : n) (x : R) : + vec_mul (pi.single j x) (diagonal v) = pi.single j (x * v j) := +begin + ext i, + rw vec_mul_diagonal, + exact pi.apply_single (λ i x, x * v i) (λ i, zero_mul _) j x i, +end + end non_unital_non_assoc_semiring section non_unital_semiring -variables [non_unital_semiring α] [fintype n] +variables [non_unital_semiring α] -@[simp] lemma vec_mul_vec_mul [fintype m] (v : m → α) (M : matrix m n α) (N : matrix n o α) : +@[simp] lemma vec_mul_vec_mul [fintype n] [fintype m] + (v : m → α) (M : matrix m n α) (N : matrix n o α) : vec_mul (vec_mul v M) N = vec_mul v (M ⬝ N) := by { ext, apply dot_product_assoc } -@[simp] lemma mul_vec_mul_vec [fintype o] (v : o → α) (M : matrix m n α) (N : matrix n o α) : +@[simp] lemma mul_vec_mul_vec [fintype n] [fintype o] + (v : o → α) (M : matrix m n α) (N : matrix n o α) : mul_vec M (mul_vec N v) = mul_vec (M ⬝ N) v := by { ext, symmetry, apply dot_product_assoc } +lemma star_mul_vec [fintype n] [star_ring α] (M : matrix m n α) (v : n → α) : + star (M.mul_vec v) = vec_mul (star v) (Mᴴ) := +funext $ λ i, (star_dot_product_star _ _).symm + +lemma star_vec_mul [fintype m] [star_ring α] (M : matrix m n α) (v : m → α) : + star (M.vec_mul v) = (Mᴴ).mul_vec (star v) := +funext $ λ i, (star_dot_product_star _ _).symm + +lemma mul_vec_conj_transpose [fintype m] [star_ring α] (A : matrix m n α) (x : m → α) : + mul_vec Aᴴ x = star (vec_mul (star x) A) := +funext $ λ i, star_dot_product _ _ + +lemma vec_mul_conj_transpose [fintype n] [star_ring α] (A : matrix m n α) (x : n → α) : + vec_mul x Aᴴ = star (mul_vec A (star x)) := +funext $ λ i, dot_product_star _ _ + +lemma mul_mul_apply [fintype n] (A B C : matrix n n α) (i j : n) : + (A ⬝ B ⬝ C) i j = A i ⬝ᵥ (B.mul_vec (Cᵀ j)) := +by { rw matrix.mul_assoc, simpa only [mul_apply, dot_product, mul_vec] } + end non_unital_semiring section non_assoc_semiring -variables [fintype m] [decidable_eq m] [non_assoc_semiring α] +variables [non_assoc_semiring α] + +lemma mul_vec_one [fintype n] (A : matrix m n α) : mul_vec A 1 = λ i, ∑ j, A i j := +by ext; simp [mul_vec, dot_product] + +lemma vec_one_mul [fintype m] (A : matrix m n α) : vec_mul 1 A = λ j, ∑ i, A i j := +by ext; simp [vec_mul, dot_product] + +variables [fintype m] [fintype n] [decidable_eq m] @[simp] lemma one_mul_vec (v : m → α) : mul_vec 1 v = v := by { ext, rw [←diagonal_one, mul_vec_diagonal, one_mul] } @@ -1183,15 +1354,19 @@ by { ext, apply neg_dot_product } lemma mul_vec_neg [fintype n] (v : n → α) (A : matrix m n α) : mul_vec A (-v) = - mul_vec A v := by { ext, apply dot_product_neg } -end non_unital_non_assoc_ring +lemma sub_mul_vec [fintype n] (A B : matrix m n α) (x : n → α) : + mul_vec (A - B) x = mul_vec A x - mul_vec B x := +by simp [sub_eq_add_neg, add_mul_vec, neg_mul_vec] -section comm_semiring +lemma vec_mul_sub [fintype m] (A B : matrix m n α) (x : m → α) : + vec_mul x (A - B) = vec_mul x A - vec_mul x B := +by simp [sub_eq_add_neg, vec_mul_add, vec_mul_neg] -variables [comm_semiring α] +end non_unital_non_assoc_ring -lemma mul_vec_smul_assoc [fintype n] (A : matrix m n α) (b : n → α) (a : α) : - A.mul_vec (a • b) = a • (A.mul_vec b) := -by { ext, apply dot_product_smul } +section non_unital_comm_semiring + +variables [non_unital_comm_semiring α] lemma mul_vec_transpose [fintype m] (A : matrix m n α) (x : m → α) : mul_vec Aᵀ x = vec_mul x A := @@ -1201,19 +1376,30 @@ lemma vec_mul_transpose [fintype n] (A : matrix m n α) (x : n → α) : vec_mul x Aᵀ = mul_vec A x := by { ext, apply dot_product_comm } +lemma mul_vec_vec_mul [fintype n] [fintype o] (A : matrix m n α) (B : matrix o n α) (x : o → α) : + mul_vec A (vec_mul x B) = mul_vec (A ⬝ Bᵀ) x := +by rw [← mul_vec_mul_vec, mul_vec_transpose] + +lemma vec_mul_mul_vec [fintype m] [fintype n] (A : matrix m n α) (B : matrix m o α) (x : n → α) : + vec_mul (mul_vec A x) B = vec_mul x (Aᵀ ⬝ B) := +by rw [← vec_mul_vec_mul, vec_mul_transpose] + +end non_unital_comm_semiring + +section comm_semiring + +variables [comm_semiring α] + +lemma mul_vec_smul_assoc [fintype n] (A : matrix m n α) (b : n → α) (a : α) : + A.mul_vec (a • b) = a • (A.mul_vec b) := +by { ext, apply dot_product_smul } + end comm_semiring section transpose open_locale matrix -/-- - Tell `simp` what the entries are in a transposed matrix. - - Compare with `mul_apply`, `diagonal_apply_eq`, etc. --/ -@[simp] lemma transpose_apply (M : matrix m n α) (i j) : M.transpose j i = M i j := rfl - @[simp] lemma transpose_transpose (M : matrix m n α) : Mᵀᵀ = M := by ext; refl @@ -1224,7 +1410,7 @@ by ext i j; refl @[simp] lemma transpose_one [decidable_eq n] [has_zero α] [has_one α] : (1 : matrix n n α)ᵀ = 1 := begin ext i j, - unfold has_one.one transpose, + rw [transpose_apply, ←diagonal_one], by_cases i = j, { simp only [h, diagonal_apply_eq] }, { simp only [diagonal_apply_ne _ h, diagonal_apply_ne' _ h] } @@ -1245,7 +1431,7 @@ begin apply dot_product_comm end -@[simp] lemma transpose_smul {R : Type*} [has_scalar R α] (c : R) (M : matrix m n α) : +@[simp] lemma transpose_smul {R : Type*} [has_smul R α] (c : R) (M : matrix m n α) : (c • M)ᵀ = c • Mᵀ := by { ext i j, refl } @@ -1256,6 +1442,8 @@ by ext i j; refl lemma transpose_map {f : α → β} {M : matrix m n α} : Mᵀ.map f = (M.map f)ᵀ := by { ext, refl } +variables (m n α) + /-- `matrix.transpose` as an `add_equiv` -/ @[simps apply] def transpose_add_equiv [has_add α] : matrix m n α ≃+ matrix n m α := @@ -1266,19 +1454,33 @@ def transpose_add_equiv [has_add α] : matrix m n α ≃+ matrix n m α := map_add' := transpose_add } @[simp] lemma transpose_add_equiv_symm [has_add α] : - (transpose_add_equiv : matrix m n α ≃+ matrix n m α).symm = transpose_add_equiv := rfl + (transpose_add_equiv m n α).symm = transpose_add_equiv n m α := rfl + +variables {m n α} lemma transpose_list_sum [add_monoid α] (l : list (matrix m n α)) : l.sumᵀ = (l.map transpose).sum := -(transpose_add_equiv : matrix m n α ≃+ matrix n m α).to_add_monoid_hom.map_list_sum l +(transpose_add_equiv m n α).to_add_monoid_hom.map_list_sum l lemma transpose_multiset_sum [add_comm_monoid α] (s : multiset (matrix m n α)) : s.sumᵀ = (s.map transpose).sum := -(transpose_add_equiv : matrix m n α ≃+ matrix n m α).to_add_monoid_hom.map_multiset_sum s +(transpose_add_equiv m n α).to_add_monoid_hom.map_multiset_sum s lemma transpose_sum [add_comm_monoid α] {ι : Type*} (s : finset ι) (M : ι → matrix m n α) : (∑ i in s, M i)ᵀ = ∑ i in s, (M i)ᵀ := -(transpose_add_equiv : matrix m n α ≃+ matrix n m α).to_add_monoid_hom.map_sum _ s +(transpose_add_equiv m n α).to_add_monoid_hom.map_sum _ s + +variables (m n R α) + +/-- `matrix.transpose` as a `linear_map` -/ +@[simps apply] +def transpose_linear_equiv [semiring R] [add_comm_monoid α] [module R α] : + matrix m n α ≃ₗ[R] matrix n m α := { map_smul' := transpose_smul, ..transpose_add_equiv m n α} + +@[simp] lemma transpose_linear_equiv_symm [semiring R] [add_comm_monoid α] [module R α] : + (transpose_linear_equiv m n R α).symm = transpose_linear_equiv n m R α := rfl + +variables {m n R α} variables (m α) @@ -1290,7 +1492,9 @@ def transpose_ring_equiv [add_comm_monoid α] [comm_semigroup α] [fintype m] : inv_fun := λ M, M.unopᵀ, map_mul' := λ M N, (congr_arg mul_opposite.op (transpose_mul M N)).trans (mul_opposite.op_mul _ _), - ..transpose_add_equiv.trans mul_opposite.op_add_equiv } + left_inv := λ M, transpose_transpose M, + right_inv := λ M, mul_opposite.unop_injective $ transpose_transpose M.unop, + ..(transpose_add_equiv m m α).trans mul_opposite.op_add_equiv } variables {m α} @@ -1302,6 +1506,20 @@ lemma transpose_list_prod [comm_semiring α] [fintype m] [decidable_eq m] (l : l l.prodᵀ = (l.map transpose).reverse.prod := (transpose_ring_equiv m α).unop_map_list_prod l +variables (R m α) + +/-- `matrix.transpose` as an `alg_equiv` to the opposite ring -/ +@[simps] +def transpose_alg_equiv [comm_semiring R] [comm_semiring α] [fintype m] [decidable_eq m] + [algebra R α] : matrix m m α ≃ₐ[R] (matrix m m α)ᵐᵒᵖ := +{ to_fun := λ M, mul_opposite.op (Mᵀ), + commutes' := λ r, by simp only [algebra_map_eq_diagonal, diagonal_transpose, + mul_opposite.algebra_map_apply], + ..(transpose_add_equiv m m α).trans mul_opposite.op_add_equiv, + ..transpose_ring_equiv m α } + +variables {R m α} + end transpose section conj_transpose @@ -1347,13 +1565,13 @@ variants which this lemma would not apply to: * `matrix.conj_transpose_rat_smul` * `matrix.conj_transpose_rat_cast_smul` -/ -@[simp] lemma conj_transpose_smul [has_star R] [has_star α] [has_scalar R α] [star_module R α] +@[simp] lemma conj_transpose_smul [has_star R] [has_star α] [has_smul R α] [star_module R α] (c : R) (M : matrix m n α) : (c • M)ᴴ = star c • Mᴴ := matrix.ext $ λ i j, star_smul _ _ @[simp] lemma conj_transpose_smul_non_comm [has_star R] [has_star α] - [has_scalar R α] [has_scalar Rᵐᵒᵖ α] (c : R) (M : matrix m n α) + [has_smul R α] [has_smul Rᵐᵒᵖ α] (c : R) (M : matrix m n α) (h : ∀ (r : R) (a : α), star (r • a) = mul_opposite.op (star r) • star a) : (c • M)ᴴ = mul_opposite.op (star c) • Mᴴ := matrix.ext $ by simp [h] @@ -1378,7 +1596,7 @@ matrix.ext $ by simp [star_add_monoid α] [module R α] (c : ℤ) (M : matrix m n α) : ((c : R) • M)ᴴ = (c : R) • Mᴴ := matrix.ext $ by simp -@[simp] lemma conj_transpose_inv_nat_cast_smul [division_ring R] [add_comm_group α] +@[simp] lemma conj_transpose_inv_nat_cast_smul [division_semiring R] [add_comm_monoid α] [star_add_monoid α] [module R α] (c : ℕ) (M : matrix m n α) : ((c : R)⁻¹ • M)ᴴ = (c : R)⁻¹ • Mᴴ := matrix.ext $ by simp @@ -1402,6 +1620,13 @@ matrix.ext $ by simp [mul_apply] (- M)ᴴ = - Mᴴ := matrix.ext $ by simp +lemma conj_transpose_map [has_star α] [has_star β] {A : matrix m n α} (f : α → β) + (hf : function.semiconj f star star) : + Aᴴ.map f = (A.map f)ᴴ := +matrix.ext $ λ i j, hf _ + +variables (m n α) + /-- `matrix.conj_transpose` as an `add_equiv` -/ @[simps apply] def conj_transpose_add_equiv [add_monoid α] [star_add_monoid α] : matrix m n α ≃+ matrix n m α := @@ -1412,21 +1637,37 @@ def conj_transpose_add_equiv [add_monoid α] [star_add_monoid α] : matrix m n map_add' := conj_transpose_add } @[simp] lemma conj_transpose_add_equiv_symm [add_monoid α] [star_add_monoid α] : - (conj_transpose_add_equiv : matrix m n α ≃+ matrix n m α).symm = conj_transpose_add_equiv := rfl + (conj_transpose_add_equiv m n α).symm = conj_transpose_add_equiv n m α := rfl + +variables {m n α} lemma conj_transpose_list_sum [add_monoid α] [star_add_monoid α] (l : list (matrix m n α)) : l.sumᴴ = (l.map conj_transpose).sum := -(conj_transpose_add_equiv : matrix m n α ≃+ matrix n m α).to_add_monoid_hom.map_list_sum l +(conj_transpose_add_equiv m n α).to_add_monoid_hom.map_list_sum l lemma conj_transpose_multiset_sum [add_comm_monoid α] [star_add_monoid α] (s : multiset (matrix m n α)) : s.sumᴴ = (s.map conj_transpose).sum := -(conj_transpose_add_equiv : matrix m n α ≃+ matrix n m α).to_add_monoid_hom.map_multiset_sum s +(conj_transpose_add_equiv m n α).to_add_monoid_hom.map_multiset_sum s lemma conj_transpose_sum [add_comm_monoid α] [star_add_monoid α] {ι : Type*} (s : finset ι) (M : ι → matrix m n α) : (∑ i in s, M i)ᴴ = ∑ i in s, (M i)ᴴ := -(conj_transpose_add_equiv : matrix m n α ≃+ matrix n m α).to_add_monoid_hom.map_sum _ s +(conj_transpose_add_equiv m n α).to_add_monoid_hom.map_sum _ s + +variables (m n R α) + +/-- `matrix.conj_transpose` as a `linear_map` -/ +@[simps apply] +def conj_transpose_linear_equiv [comm_semiring R] [star_ring R] [add_comm_monoid α] + [star_add_monoid α] [module R α] [star_module R α] : matrix m n α ≃ₗ⋆[R] matrix n m α := +{ map_smul' := conj_transpose_smul, ..conj_transpose_add_equiv m n α} + +@[simp] lemma conj_transpose_linear_equiv_symm [comm_semiring R] [star_ring R] [add_comm_monoid α] + [star_add_monoid α] [module R α] [star_module R α] : + (conj_transpose_linear_equiv m n R α).symm = conj_transpose_linear_equiv n m R α := rfl + +variables {m n R α} variables (m α) @@ -1438,7 +1679,7 @@ def conj_transpose_ring_equiv [semiring α] [star_ring α] [fintype m] : inv_fun := λ M, M.unopᴴ, map_mul' := λ M N, (congr_arg mul_opposite.op (conj_transpose_mul M N)).trans (mul_opposite.op_mul _ _), - ..conj_transpose_add_equiv.trans mul_opposite.op_add_equiv } + ..(conj_transpose_add_equiv m m α).trans mul_opposite.op_add_equiv } variables {m α} @@ -1471,8 +1712,12 @@ instance [has_involutive_star α] : has_involutive_star (matrix n n α) := instance [add_monoid α] [star_add_monoid α] : star_add_monoid (matrix n n α) := { star_add := conj_transpose_add } +instance [has_star α] [has_star β] [has_smul α β] [star_module α β] : + star_module α (matrix n n β) := +{ star_smul := conj_transpose_smul } + /-- When `α` is a `*`-(semi)ring, `matrix.has_star` is also a `*`-(semi)ring. -/ -instance [fintype n] [semiring α] [star_ring α] : star_ring (matrix n n α) := +instance [fintype n] [non_unital_semiring α] [star_ring α] : star_ring (matrix n n α) := { star_add := conj_transpose_add, star_mul := conj_transpose_mul, } @@ -1483,146 +1728,161 @@ lemma star_mul [fintype n] [non_unital_semiring α] [star_ring α] (M N : matrix end star /-- Given maps `(r_reindex : l → m)` and `(c_reindex : o → n)` reindexing the rows and columns of -a matrix `M : matrix m n α`, the matrix `M.minor r_reindex c_reindex : matrix l o α` is defined -by `(M.minor r_reindex c_reindex) i j = M (r_reindex i) (c_reindex j)` for `(i,j) : l × o`. +a matrix `M : matrix m n α`, the matrix `M.submatrix r_reindex c_reindex : matrix l o α` is defined +by `(M.submatrix r_reindex c_reindex) i j = M (r_reindex i) (c_reindex j)` for `(i,j) : l × o`. Note that the total number of row and columns does not have to be preserved. -/ -def minor (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) : matrix l o α := -λ i j, A (r_reindex i) (c_reindex j) +def submatrix (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) : matrix l o α := +of $ λ i j, A (r_reindex i) (c_reindex j) -@[simp] lemma minor_apply (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) (i j) : - A.minor r_reindex c_reindex i j = A (r_reindex i) (c_reindex j) := rfl +@[simp] lemma submatrix_apply (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) (i j) : + A.submatrix r_reindex c_reindex i j = A (r_reindex i) (c_reindex j) := rfl -@[simp] lemma minor_id_id (A : matrix m n α) : - A.minor id id = A := +@[simp] lemma submatrix_id_id (A : matrix m n α) : + A.submatrix id id = A := ext $ λ _ _, rfl -@[simp] lemma minor_minor {l₂ o₂ : Type*} (A : matrix m n α) +@[simp] lemma submatrix_submatrix {l₂ o₂ : Type*} (A : matrix m n α) (r₁ : l → m) (c₁ : o → n) (r₂ : l₂ → l) (c₂ : o₂ → o) : - (A.minor r₁ c₁).minor r₂ c₂ = A.minor (r₁ ∘ r₂) (c₁ ∘ c₂) := + (A.submatrix r₁ c₁).submatrix r₂ c₂ = A.submatrix (r₁ ∘ r₂) (c₁ ∘ c₂) := ext $ λ _ _, rfl -@[simp] lemma transpose_minor (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) : - (A.minor r_reindex c_reindex)ᵀ = Aᵀ.minor c_reindex r_reindex := +@[simp] lemma transpose_submatrix (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) : + (A.submatrix r_reindex c_reindex)ᵀ = Aᵀ.submatrix c_reindex r_reindex := ext $ λ _ _, rfl -@[simp] lemma conj_transpose_minor +@[simp] lemma conj_transpose_submatrix [has_star α] (A : matrix m n α) (r_reindex : l → m) (c_reindex : o → n) : - (A.minor r_reindex c_reindex)ᴴ = Aᴴ.minor c_reindex r_reindex := + (A.submatrix r_reindex c_reindex)ᴴ = Aᴴ.submatrix c_reindex r_reindex := ext $ λ _ _, rfl -lemma minor_add [has_add α] (A B : matrix m n α) : - ((A + B).minor : (l → m) → (o → n) → matrix l o α) = A.minor + B.minor := rfl +lemma submatrix_add [has_add α] (A B : matrix m n α) : + ((A + B).submatrix : (l → m) → (o → n) → matrix l o α) = A.submatrix + B.submatrix := rfl -lemma minor_neg [has_neg α] (A : matrix m n α) : - ((-A).minor : (l → m) → (o → n) → matrix l o α) = -A.minor := rfl +lemma submatrix_neg [has_neg α] (A : matrix m n α) : + ((-A).submatrix : (l → m) → (o → n) → matrix l o α) = -A.submatrix := rfl -lemma minor_sub [has_sub α] (A B : matrix m n α) : - ((A - B).minor : (l → m) → (o → n) → matrix l o α) = A.minor - B.minor := rfl +lemma submatrix_sub [has_sub α] (A B : matrix m n α) : + ((A - B).submatrix : (l → m) → (o → n) → matrix l o α) = A.submatrix - B.submatrix := rfl -@[simp] lemma minor_zero [has_zero α] : - ((0 : matrix m n α).minor : (l → m) → (o → n) → matrix l o α) = 0 := rfl +@[simp] lemma submatrix_zero [has_zero α] : + ((0 : matrix m n α).submatrix : (l → m) → (o → n) → matrix l o α) = 0 := rfl -lemma minor_smul {R : Type*} [has_scalar R α] (r : R) (A : matrix m n α) : - ((r • A : matrix m n α).minor : (l → m) → (o → n) → matrix l o α) = r • A.minor := rfl +lemma submatrix_smul {R : Type*} [has_smul R α] (r : R) (A : matrix m n α) : + ((r • A : matrix m n α).submatrix : (l → m) → (o → n) → matrix l o α) = r • A.submatrix := rfl -lemma minor_map (f : α → β) (e₁ : l → m) (e₂ : o → n) (A : matrix m n α) : - (A.map f).minor e₁ e₂ = (A.minor e₁ e₂).map f := rfl +lemma submatrix_map (f : α → β) (e₁ : l → m) (e₂ : o → n) (A : matrix m n α) : + (A.map f).submatrix e₁ e₂ = (A.submatrix e₁ e₂).map f := rfl /-- Given a `(m × m)` diagonal matrix defined by a map `d : m → α`, if the reindexing map `e` is injective, then the resulting matrix is again diagonal. -/ -lemma minor_diagonal [has_zero α] [decidable_eq m] [decidable_eq l] (d : m → α) (e : l → m) +lemma submatrix_diagonal [has_zero α] [decidable_eq m] [decidable_eq l] (d : m → α) (e : l → m) (he : function.injective e) : - (diagonal d).minor e e = diagonal (d ∘ e) := + (diagonal d).submatrix e e = diagonal (d ∘ e) := ext $ λ i j, begin - rw minor_apply, + rw submatrix_apply, by_cases h : i = j, { rw [h, diagonal_apply_eq, diagonal_apply_eq], }, { rw [diagonal_apply_ne _ h, diagonal_apply_ne _ (he.ne h)], }, end -lemma minor_one [has_zero α] [has_one α] [decidable_eq m] [decidable_eq l] (e : l → m) +lemma submatrix_one [has_zero α] [has_one α] [decidable_eq m] [decidable_eq l] (e : l → m) (he : function.injective e) : - (1 : matrix m m α).minor e e = 1 := -minor_diagonal _ e he + (1 : matrix m m α).submatrix e e = 1 := +submatrix_diagonal _ e he -lemma minor_mul [fintype n] [fintype o] [has_mul α] [add_comm_monoid α] {p q : Type*} +lemma submatrix_mul [fintype n] [fintype o] [has_mul α] [add_comm_monoid α] {p q : Type*} (M : matrix m n α) (N : matrix n p α) (e₁ : l → m) (e₂ : o → n) (e₃ : q → p) (he₂ : function.bijective e₂) : - (M ⬝ N).minor e₁ e₃ = (M.minor e₁ e₂) ⬝ (N.minor e₂ e₃) := + (M ⬝ N).submatrix e₁ e₃ = (M.submatrix e₁ e₂) ⬝ (N.submatrix e₂ e₃) := ext $ λ _ _, (he₂.sum_comp _).symm -lemma diag_minor (A : matrix m m α) (e : l → m) : diag (A.minor e e) = A.diag ∘ e := rfl +lemma diag_submatrix (A : matrix m m α) (e : l → m) : diag (A.submatrix e e) = A.diag ∘ e := rfl -/-! `simp` lemmas for `matrix.minor`s interaction with `matrix.diagonal`, `1`, and `matrix.mul` for -when the mappings are bundled. -/ +/-! `simp` lemmas for `matrix.submatrix`s interaction with `matrix.diagonal`, `1`, and `matrix.mul` +for when the mappings are bundled. -/ @[simp] -lemma minor_diagonal_embedding [has_zero α] [decidable_eq m] [decidable_eq l] (d : m → α) +lemma submatrix_diagonal_embedding [has_zero α] [decidable_eq m] [decidable_eq l] (d : m → α) (e : l ↪ m) : - (diagonal d).minor e e = diagonal (d ∘ e) := -minor_diagonal d e e.injective + (diagonal d).submatrix e e = diagonal (d ∘ e) := +submatrix_diagonal d e e.injective @[simp] -lemma minor_diagonal_equiv [has_zero α] [decidable_eq m] [decidable_eq l] (d : m → α) +lemma submatrix_diagonal_equiv [has_zero α] [decidable_eq m] [decidable_eq l] (d : m → α) (e : l ≃ m) : - (diagonal d).minor e e = diagonal (d ∘ e) := -minor_diagonal d e e.injective + (diagonal d).submatrix e e = diagonal (d ∘ e) := +submatrix_diagonal d e e.injective @[simp] -lemma minor_one_embedding [has_zero α] [has_one α] [decidable_eq m] [decidable_eq l] (e : l ↪ m) : - (1 : matrix m m α).minor e e = 1 := -minor_one e e.injective +lemma submatrix_one_embedding + [has_zero α] [has_one α] [decidable_eq m] [decidable_eq l] (e : l ↪ m) : + (1 : matrix m m α).submatrix e e = 1 := +submatrix_one e e.injective @[simp] -lemma minor_one_equiv [has_zero α] [has_one α] [decidable_eq m] [decidable_eq l] (e : l ≃ m) : - (1 : matrix m m α).minor e e = 1 := -minor_one e e.injective +lemma submatrix_one_equiv [has_zero α] [has_one α] [decidable_eq m] [decidable_eq l] (e : l ≃ m) : + (1 : matrix m m α).submatrix e e = 1 := +submatrix_one e e.injective @[simp] -lemma minor_mul_equiv [fintype n] [fintype o] [add_comm_monoid α] [has_mul α] {p q : Type*} +lemma submatrix_mul_equiv [fintype n] [fintype o] [add_comm_monoid α] [has_mul α] {p q : Type*} (M : matrix m n α) (N : matrix n p α) (e₁ : l → m) (e₂ : o ≃ n) (e₃ : q → p) : - (M.minor e₁ e₂) ⬝ (N.minor e₂ e₃) = (M ⬝ N).minor e₁ e₃ := -(minor_mul M N e₁ e₂ e₃ e₂.bijective).symm + (M.submatrix e₁ e₂) ⬝ (N.submatrix e₂ e₃) = (M ⬝ N).submatrix e₁ e₃ := +(submatrix_mul M N e₁ e₂ e₃ e₂.bijective).symm + +lemma submatrix_mul_vec_equiv [fintype n] [fintype o] [non_unital_non_assoc_semiring α] + (M : matrix m n α) (v : o → α) (e₁ : l → m) (e₂ : o ≃ n) : + (M.submatrix e₁ e₂).mul_vec v = M.mul_vec (v ∘ e₂.symm) ∘ e₁ := +funext $ λ i, eq.symm (dot_product_comp_equiv_symm _ _ _) + +lemma submatrix_vec_mul_equiv [fintype l] [fintype m] [non_unital_non_assoc_semiring α] + (M : matrix m n α) (v : l → α) (e₁ : l ≃ m) (e₂ : o → n) : + vec_mul v (M.submatrix e₁ e₂) = vec_mul (v ∘ e₁.symm) M ∘ e₂ := +funext $ λ i, eq.symm (comp_equiv_symm_dot_product _ _ _) -lemma mul_minor_one [fintype n] [fintype o] [non_assoc_semiring α] [decidable_eq o] (e₁ : n ≃ o) +lemma mul_submatrix_one [fintype n] [finite o] [non_assoc_semiring α] [decidable_eq o] (e₁ : n ≃ o) (e₂ : l → o) (M : matrix m n α) : - M ⬝ (1 : matrix o o α).minor e₁ e₂ = minor M id (e₁.symm ∘ e₂) := + M ⬝ (1 : matrix o o α).submatrix e₁ e₂ = submatrix M id (e₁.symm ∘ e₂) := begin - let A := M.minor id e₁.symm, - have : M = A.minor id e₁, - { simp only [minor_minor, function.comp.right_id, minor_id_id, equiv.symm_comp_self], }, - rw [this, minor_mul_equiv], - simp only [matrix.mul_one, minor_minor, function.comp.right_id, minor_id_id, + casesI nonempty_fintype o, + let A := M.submatrix id e₁.symm, + have : M = A.submatrix id e₁, + { simp only [submatrix_submatrix, function.comp.right_id, submatrix_id_id, + equiv.symm_comp_self], }, + rw [this, submatrix_mul_equiv], + simp only [matrix.mul_one, submatrix_submatrix, function.comp.right_id, submatrix_id_id, equiv.symm_comp_self], end -lemma one_minor_mul [fintype m] [fintype o] [non_assoc_semiring α] [decidable_eq o] (e₁ : l → o) +lemma one_submatrix_mul [fintype m] [finite o] [non_assoc_semiring α] [decidable_eq o] (e₁ : l → o) (e₂ : m ≃ o) (M : matrix m n α) : - ((1 : matrix o o α).minor e₁ e₂).mul M = minor M (e₂.symm ∘ e₁) id := + ((1 : matrix o o α).submatrix e₁ e₂).mul M = submatrix M (e₂.symm ∘ e₁) id := begin - let A := M.minor e₂.symm id, - have : M = A.minor e₂ id, - { simp only [minor_minor, function.comp.right_id, minor_id_id, equiv.symm_comp_self], }, - rw [this, minor_mul_equiv], - simp only [matrix.one_mul, minor_minor, function.comp.right_id, minor_id_id, + casesI nonempty_fintype o, + let A := M.submatrix e₂.symm id, + have : M = A.submatrix e₂ id, + { simp only [submatrix_submatrix, function.comp.right_id, submatrix_id_id, + equiv.symm_comp_self], }, + rw [this, submatrix_mul_equiv], + simp only [matrix.one_mul, submatrix_submatrix, function.comp.right_id, submatrix_id_id, equiv.symm_comp_self], end /-- The natural map that reindexes a matrix's rows and columns with equivalent types is an equivalence. -/ def reindex (eₘ : m ≃ l) (eₙ : n ≃ o) : matrix m n α ≃ matrix l o α := -{ to_fun := λ M, M.minor eₘ.symm eₙ.symm, - inv_fun := λ M, M.minor eₘ eₙ, +{ to_fun := λ M, M.submatrix eₘ.symm eₙ.symm, + inv_fun := λ M, M.submatrix eₘ eₙ, left_inv := λ M, by simp, right_inv := λ M, by simp, } @[simp] lemma reindex_apply (eₘ : m ≃ l) (eₙ : n ≃ o) (M : matrix m n α) : - reindex eₘ eₙ M = M.minor eₘ.symm eₙ.symm := + reindex eₘ eₙ M = M.submatrix eₘ.symm eₙ.symm := rfl @[simp] lemma reindex_refl_refl (A : matrix m n α) : reindex (equiv.refl _) (equiv.refl _) A = A := -A.minor_id_id +A.submatrix_id_id @[simp] lemma reindex_symm (eₘ : m ≃ l) (eₙ : n ≃ o) : (reindex eₘ eₙ).symm = (reindex eₘ.symm eₙ.symm : matrix l o α ≃ _) := @@ -1631,7 +1891,7 @@ rfl @[simp] lemma reindex_trans {l₂ o₂ : Type*} (eₘ : m ≃ l) (eₙ : n ≃ o) (eₘ₂ : l ≃ l₂) (eₙ₂ : o ≃ o₂) : (reindex eₘ eₙ).trans (reindex eₘ₂ eₙ₂) = (reindex (eₘ.trans eₘ₂) (eₙ.trans eₙ₂) : matrix m n α ≃ _) := -equiv.ext $ λ A, (A.minor_minor eₘ.symm eₙ.symm eₘ₂.symm eₙ₂.symm : _) +equiv.ext $ λ A, (A.submatrix_submatrix eₘ.symm eₙ.symm eₘ₂.symm eₙ₂.symm : _) lemma transpose_reindex (eₘ : m ≃ l) (eₙ : n ≃ o) (M : matrix m n α) : (reindex eₘ eₙ M)ᵀ = (reindex eₙ eₘ Mᵀ) := @@ -1642,30 +1902,30 @@ lemma conj_transpose_reindex [has_star α] (eₘ : m ≃ l) (eₙ : n ≃ o) (M rfl @[simp] -lemma minor_mul_transpose_minor [fintype m] [fintype n] [add_comm_monoid α] [has_mul α] +lemma submatrix_mul_transpose_submatrix [fintype m] [fintype n] [add_comm_monoid α] [has_mul α] (e : m ≃ n) (M : matrix m n α) : - (M.minor id e) ⬝ (Mᵀ).minor e id = M ⬝ Mᵀ := -by rw [minor_mul_equiv, minor_id_id] + (M.submatrix id e) ⬝ (Mᵀ).submatrix e id = M ⬝ Mᵀ := +by rw [submatrix_mul_equiv, submatrix_id_id] /-- The left `n × l` part of a `n × (l+r)` matrix. -/ @[reducible] def sub_left {m l r : nat} (A : matrix (fin m) (fin (l + r)) α) : matrix (fin m) (fin l) α := -minor A id (fin.cast_add r) +submatrix A id (fin.cast_add r) /-- The right `n × r` part of a `n × (l+r)` matrix. -/ @[reducible] def sub_right {m l r : nat} (A : matrix (fin m) (fin (l + r)) α) : matrix (fin m) (fin r) α := -minor A id (fin.nat_add l) +submatrix A id (fin.nat_add l) /-- The top `u × n` part of a `(u+d) × n` matrix. -/ @[reducible] def sub_up {d u n : nat} (A : matrix (fin (u + d)) (fin n) α) : matrix (fin u) (fin n) α := -minor A (fin.cast_add d) id +submatrix A (fin.cast_add d) id /-- The bottom `d × n` part of a `(u+d) × n` matrix. -/ @[reducible] def sub_down {d u n : nat} (A : matrix (fin (u + d)) (fin n) α) : matrix (fin d) (fin n) α := -minor A (fin.nat_add u) id +submatrix A (fin.nat_add u) id /-- The top-right `u × r` part of a `(u+d) × (l+r)` matrix. -/ @[reducible] @@ -1700,15 +1960,12 @@ Simplification lemmas for `matrix.row` and `matrix.col`. open_locale matrix @[simp] lemma col_add [has_add α] (v w : m → α) : col (v + w) = col v + col w := by { ext, refl } -@[simp] lemma col_smul [has_scalar R α] (x : R) (v : m → α) : col (x • v) = x • col v := +@[simp] lemma col_smul [has_smul R α] (x : R) (v : m → α) : col (x • v) = x • col v := by { ext, refl } @[simp] lemma row_add [has_add α] (v w : m → α) : row (v + w) = row v + row w := by { ext, refl } -@[simp] lemma row_smul [has_scalar R α] (x : R) (v : m → α) : row (x • v) = x • row v := +@[simp] lemma row_smul [has_smul R α] (x : R) (v : m → α) : row (x • v) = x • row v := by { ext, refl } -@[simp] lemma col_apply (v : m → α) (i j) : matrix.col v i j = v i := rfl -@[simp] lemma row_apply (v : m → α) (i j) : matrix.row v i j = v j := rfl - @[simp] lemma transpose_col (v : m → α) : (matrix.col v)ᵀ = matrix.row v := by { ext, refl } @[simp] @@ -1739,11 +1996,11 @@ section update /-- Update, i.e. replace the `i`th row of matrix `A` with the values in `b`. -/ def update_row [decidable_eq m] (M : matrix m n α) (i : m) (b : n → α) : matrix m n α := -function.update M i b +of $ function.update M i b /-- Update, i.e. replace the `j`th column of matrix `A` with the values in `b`. -/ def update_column [decidable_eq n] (M : matrix m n α) (j : n) (b : m → α) : matrix m n α := -λ i, function.update (M i) j (b i) +of $ λ i, function.update (M i) j (b i) variables {M : matrix m n α} {i : m} {j : n} {b : n → α} {c : m → α} @@ -1777,7 +2034,7 @@ end @[simp] lemma update_column_subsingleton [subsingleton n] (A : matrix m n R) (i : n) (b : m → R) : - A.update_column i b = (col b).minor id (function.const n ()) := + A.update_column i b = (col b).submatrix id (function.const n ()) := begin ext x y, simp [update_column_apply, subsingleton.elim i y] @@ -1785,7 +2042,7 @@ end @[simp] lemma update_row_subsingleton [subsingleton m] (A : matrix m n R) (i : m) (b : n → R) : - A.update_row i b = (row b).minor (function.const m ()) id := + A.update_row i b = (row b).submatrix (function.const m ()) id := begin ext x y, simp [update_column_apply, subsingleton.elim i x] @@ -1866,6 +2123,54 @@ lemma diagonal_update_row_single [decidable_eq n] [has_zero α] (v : n → α) ( (diagonal v).update_row i (pi.single i x) = diagonal (function.update v i x) := by rw [←diagonal_transpose, update_row_transpose, diagonal_update_column_single, diagonal_transpose] +/-! Updating rows and columns commutes in the obvious way with reindexing the matrix. -/ + +lemma update_row_submatrix_equiv [decidable_eq l] [decidable_eq m] + (A : matrix m n α) (i : l) (r : o → α) (e : l ≃ m) (f : o ≃ n) : + update_row (A.submatrix e f) i r = (A.update_row (e i) (λ j, r (f.symm j))).submatrix e f := +begin + ext i' j, + simp only [submatrix_apply, update_row_apply, equiv.apply_eq_iff_eq, equiv.symm_apply_apply], +end + +lemma submatrix_update_row_equiv [decidable_eq l] [decidable_eq m] + (A : matrix m n α) (i : m) (r : n → α) (e : l ≃ m) (f : o ≃ n) : + (A.update_row i r).submatrix e f = update_row (A.submatrix e f) (e.symm i) (λ i, r (f i)) := +eq.trans (by simp_rw equiv.apply_symm_apply) (update_row_submatrix_equiv A _ _ e f).symm + +lemma update_column_submatrix_equiv [decidable_eq o] [decidable_eq n] + (A : matrix m n α) (j : o) (c : l → α) (e : l ≃ m) (f : o ≃ n) : + update_column (A.submatrix e f) j c = (A.update_column (f j) (λ i, c (e.symm i))).submatrix e f := +by simpa only [←transpose_submatrix, update_row_transpose] using + congr_arg transpose (update_row_submatrix_equiv Aᵀ j c f e) + +lemma submatrix_update_column_equiv [decidable_eq o] [decidable_eq n] + (A : matrix m n α) (j : n) (c : m → α) (e : l ≃ m) (f : o ≃ n) : + (A.update_column j c).submatrix e f = update_column (A.submatrix e f) (f.symm j) (λ i, c (e i)) := +eq.trans (by simp_rw equiv.apply_symm_apply) (update_column_submatrix_equiv A _ _ e f).symm + +/-! `reindex` versions of the above `submatrix` lemmas for convenience. -/ + +lemma update_row_reindex [decidable_eq l] [decidable_eq m] + (A : matrix m n α) (i : l) (r : o → α) (e : m ≃ l) (f : n ≃ o) : + update_row (reindex e f A) i r = reindex e f (A.update_row (e.symm i) (λ j, r (f j))) := +update_row_submatrix_equiv _ _ _ _ _ + +lemma reindex_update_row [decidable_eq l] [decidable_eq m] + (A : matrix m n α) (i : m) (r : n → α) (e : m ≃ l) (f : n ≃ o) : + reindex e f (A.update_row i r) = update_row (reindex e f A) (e i) (λ i, r (f.symm i)) := +submatrix_update_row_equiv _ _ _ _ _ + +lemma update_column_reindex [decidable_eq o] [decidable_eq n] + (A : matrix m n α) (j : o) (c : l → α) (e : m ≃ l) (f : n ≃ o) : + update_column (reindex e f A) j c = reindex e f (A.update_column (f.symm j) (λ i, c (e i))) := +update_column_submatrix_equiv _ _ _ _ _ + +lemma reindex_update_column [decidable_eq o] [decidable_eq n] + (A : matrix m n α) (j : n) (c : m → α) (e : m ≃ l) (f : n ≃ o) : + reindex e f (A.update_column j c) = update_column (reindex e f A) (f j) (λ i, c (e.symm i)) := +submatrix_update_column_equiv _ _ _ _ _ + end update end matrix @@ -1874,7 +2179,7 @@ namespace ring_hom variables [fintype n] [non_assoc_semiring α] [non_assoc_semiring β] lemma map_matrix_mul (M : matrix m n α) (N : matrix n o α) (i : m) (j : o) (f : α →+* β) : - f (matrix.mul M N i j) = matrix.mul (λ i j, f (M i j)) (λ i j, f (N i j)) i j := + f (matrix.mul M N i j) = matrix.mul (M.map f) (N.map f) i j := by simp [matrix.mul_apply, ring_hom.map_sum] lemma map_dot_product [non_assoc_semiring R] [non_assoc_semiring S] (f : R →+* S) (v w : n → R) : diff --git a/src/data/matrix/basis.lean b/src/data/matrix/basis.lean index cb40e55b8f0b4..276ed52bb3a49 100644 --- a/src/data/matrix/basis.lean +++ b/src/data/matrix/basis.lean @@ -9,6 +9,9 @@ import linear_algebra.matrix.trace /-! # Matrices with a single non-zero element. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides `matrix.std_basis_matrix`. The matrix `matrix.std_basis_matrix i j c` has `c` at position `(i, j)`, and zeroes elsewhere. -/ diff --git a/src/data/matrix/block.lean b/src/data/matrix/block.lean index 108c572f023d6..34a97c6775854 100644 --- a/src/data/matrix/block.lean +++ b/src/data/matrix/block.lean @@ -8,6 +8,9 @@ import data.matrix.basic /-! # Block Matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `matrix.from_blocks`: build a block matrix out of 4 blocks @@ -24,10 +27,14 @@ import data.matrix.basic variables {l m n o p q : Type*} {m' n' p' : o → Type*} variables {R : Type*} {S : Type*} {α : Type*} {β : Type*} -open_locale matrix +open_locale big_operators matrix namespace matrix +lemma dot_product_block [fintype m] [fintype n] [has_mul α] [add_comm_monoid α] (v w : m ⊕ n → α) : + v ⬝ᵥ w = v ∘ sum.inl ⬝ᵥ w ∘ sum.inl + v ∘ sum.inr ⬝ᵥ w ∘ sum.inr := +fintype.sum_sum_type _ + section block_matrices /-- We can form a single large matrix by flattening smaller 'block' matrices of compatible @@ -35,8 +42,8 @@ dimensions. -/ @[pp_nodot] def from_blocks (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) : matrix (n ⊕ o) (l ⊕ m) α := -sum.elim (λ i, sum.elim (A i) (B i)) - (λ i, sum.elim (C i) (D i)) +of $ sum.elim (λ i, sum.elim (A i) (B i)) + (λ i, sum.elim (C i) (D i)) @[simp] lemma from_blocks_apply₁₁ (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (i : n) (j : l) : @@ -61,22 +68,22 @@ rfl /-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding "top left" submatrix. -/ def to_blocks₁₁ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix n l α := -λ i j, M (sum.inl i) (sum.inl j) +of $ λ i j, M (sum.inl i) (sum.inl j) /-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding "top right" submatrix. -/ def to_blocks₁₂ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix n m α := -λ i j, M (sum.inl i) (sum.inr j) +of $ λ i j, M (sum.inl i) (sum.inr j) /-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding "bottom left" submatrix. -/ def to_blocks₂₁ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix o l α := -λ i j, M (sum.inr i) (sum.inl j) +of $ λ i j, M (sum.inr i) (sum.inl j) /-- Given a matrix whose row and column indexes are sum types, we can extract the corresponding "bottom right" submatrix. -/ def to_blocks₂₂ (M : matrix (n ⊕ o) (l ⊕ m) α) : matrix o m α := -λ i j, M (sum.inr i) (sum.inr j) +of $ λ i j, M (sum.inr i) (sum.inr j) lemma from_blocks_to_blocks (M : matrix (n ⊕ o) (l ⊕ m) α) : from_blocks M.to_blocks₁₁ M.to_blocks₁₂ M.to_blocks₂₁ M.to_blocks₂₂ = M := @@ -104,6 +111,19 @@ rfl (from_blocks A B C D).to_blocks₂₂ = D := rfl +/-- Two block matrices are equal if their blocks are equal. -/ +lemma ext_iff_blocks {A B : matrix (n ⊕ o) (l ⊕ m) α} : + A = B ↔ A.to_blocks₁₁ = B.to_blocks₁₁ ∧ A.to_blocks₁₂ = B.to_blocks₁₂ ∧ + A.to_blocks₂₁ = B.to_blocks₂₁ ∧ A.to_blocks₂₂ = B.to_blocks₂₂ := +⟨λ h, h ▸ ⟨rfl, rfl, rfl, rfl⟩, λ ⟨h₁₁, h₁₂, h₂₁, h₂₂⟩, + by rw [←from_blocks_to_blocks A, ←from_blocks_to_blocks B, h₁₁, h₁₂, h₂₁, h₂₂]⟩ + +@[simp] lemma from_blocks_inj + {A : matrix n l α} {B : matrix n m α} {C : matrix o l α} {D : matrix o m α} + {A' : matrix n l α} {B' : matrix n m α} {C' : matrix o l α} {D' : matrix o m α} : + from_blocks A B C D = from_blocks A' B' C' D' ↔ A = A' ∧ B = B' ∧ C = C' ∧ D = D' := +ext_iff_blocks + lemma from_blocks_map (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (f : α → β) : (from_blocks A B C D).map f = from_blocks (A.map f) (B.map f) (C.map f) (D.map f) := @@ -125,6 +145,21 @@ begin simp only [conj_transpose, from_blocks_transpose, from_blocks_map] end +@[simp] lemma from_blocks_submatrix_sum_swap_left + (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (f : p → l ⊕ m) : + (from_blocks A B C D).submatrix sum.swap f = (from_blocks C D A B).submatrix id f := +by { ext i j, cases i; dsimp; cases f j; refl } + +@[simp] lemma from_blocks_submatrix_sum_swap_right + (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (f : p → n ⊕ o) : + (from_blocks A B C D).submatrix f sum.swap = (from_blocks B A D C).submatrix f id := +by { ext i j, cases j; dsimp; cases f i; refl } + +lemma from_blocks_submatrix_sum_swap_sum_swap {l m n o α : Type*} + (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) : + (from_blocks A B C D).submatrix sum.swap sum.swap = from_blocks D C B A := +by simp + /-- A 2x2 block matrix is block diagonal if the blocks outside of the diagonal vanish -/ def is_two_block_diagonal [has_zero α] (A : matrix (n ⊕ o) (l ⊕ m) α) : Prop := to_blocks₁₂ A = 0 ∧ to_blocks₂₁ A = 0 @@ -132,42 +167,45 @@ to_blocks₁₂ A = 0 ∧ to_blocks₂₁ A = 0 /-- Let `p` pick out certain rows and `q` pick out certain columns of a matrix `M`. Then `to_block M p q` is the corresponding block matrix. -/ def to_block (M : matrix m n α) (p : m → Prop) (q : n → Prop) : - matrix {a // p a} {a // q a} α := M.minor coe coe + matrix {a // p a} {a // q a} α := M.submatrix coe coe @[simp] lemma to_block_apply (M : matrix m n α) (p : m → Prop) (q : n → Prop) (i : {a // p a}) (j : {a // q a}) : to_block M p q i j = M ↑i ↑j := rfl -/-- Let `b` map rows and columns of a square matrix `M` to blocks. Then - `to_square_block M b k` is the block `k` matrix. -/ -def to_square_block (M : matrix m m α) {n : nat} (b : m → fin n) (k : fin n) : - matrix {a // b a = k} {a // b a = k} α := M.minor coe coe - -@[simp] lemma to_square_block_def (M : matrix m m α) {n : nat} (b : m → fin n) (k : fin n) : - to_square_block M b k = λ i j, M ↑i ↑j := rfl - -/-- Alternate version with `b : m → nat`. Let `b` map rows and columns of a square matrix `M` to - blocks. Then `to_square_block' M b k` is the block `k` matrix. -/ -def to_square_block' (M : matrix m m α) (b : m → nat) (k : nat) : - matrix {a // b a = k} {a // b a = k} α := M.minor coe coe - -@[simp] lemma to_square_block_def' (M : matrix m m α) (b : m → nat) (k : nat) : - to_square_block' M b k = λ i j, M ↑i ↑j := rfl - /-- Let `p` pick out certain rows and columns of a square matrix `M`. Then `to_square_block_prop M p` is the corresponding block matrix. -/ -def to_square_block_prop (M : matrix m m α) (p : m → Prop) : - matrix {a // p a} {a // p a} α := M.minor coe coe +def to_square_block_prop (M : matrix m m α) (p : m → Prop) : matrix {a // p a} {a // p a} α := +to_block M _ _ -@[simp] lemma to_square_block_prop_def (M : matrix m m α) (p : m → Prop) : +lemma to_square_block_prop_def (M : matrix m m α) (p : m → Prop) : to_square_block_prop M p = λ i j, M ↑i ↑j := rfl -lemma from_blocks_smul [has_scalar R α] +/-- Let `b` map rows and columns of a square matrix `M` to blocks. Then + `to_square_block M b k` is the block `k` matrix. -/ +def to_square_block (M : matrix m m α) (b : m → β) (k : β) : + matrix {a // b a = k} {a // b a = k} α := to_square_block_prop M _ + +lemma to_square_block_def (M : matrix m m α) (b : m → β) (k : β) : + to_square_block M b k = λ i j, M ↑i ↑j := rfl + +lemma from_blocks_smul [has_smul R α] (x : R) (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) : x • (from_blocks A B C D) = from_blocks (x • A) (x • B) (x • C) (x • D) := begin ext i j, rcases i; rcases j; simp [from_blocks], end +lemma from_blocks_neg [has_neg R] + (A : matrix n l R) (B : matrix n m R) (C : matrix o l R) (D : matrix o m R) : + - (from_blocks A B C D) = from_blocks (-A) (-B) (-C) (-D) := +begin + ext i j, cases i; cases j; simp [from_blocks], +end + +@[simp] lemma from_blocks_zero [has_zero α] : + from_blocks (0 : matrix n l α) 0 0 (0 : matrix o m α) = 0 := +by { ext i j, rcases i; rcases j; refl } + lemma from_blocks_add [has_add α] (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (A' : matrix n l α) (B' : matrix n m α) (C' : matrix o l α) (D' : matrix o m α) : @@ -187,21 +225,69 @@ lemma from_blocks_multiply [fintype l] [fintype m] [non_unital_non_assoc_semirin begin ext i j, rcases i; rcases j; simp only [from_blocks, mul_apply, fintype.sum_sum_type, sum.elim_inl, sum.elim_inr, - pi.add_apply], + pi.add_apply, of_apply], end +lemma from_blocks_mul_vec [fintype l] [fintype m] [non_unital_non_assoc_semiring α] + (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (x : l ⊕ m → α) : + mul_vec (from_blocks A B C D) x = + sum.elim (mul_vec A (x ∘ sum.inl) + mul_vec B (x ∘ sum.inr)) + (mul_vec C (x ∘ sum.inl) + mul_vec D (x ∘ sum.inr)) := +by { ext i, cases i; simp [mul_vec, dot_product] } + +lemma vec_mul_from_blocks [fintype n] [fintype o] [non_unital_non_assoc_semiring α] + (A : matrix n l α) (B : matrix n m α) (C : matrix o l α) (D : matrix o m α) (x : n ⊕ o → α) : + vec_mul x (from_blocks A B C D) = + sum.elim (vec_mul (x ∘ sum.inl) A + vec_mul (x ∘ sum.inr) C) + (vec_mul (x ∘ sum.inl) B + vec_mul (x ∘ sum.inr) D) := +by { ext i, cases i; simp [vec_mul, dot_product] } + variables [decidable_eq l] [decidable_eq m] -@[simp] lemma from_blocks_diagonal [has_zero α] (d₁ : l → α) (d₂ : m → α) : +section has_zero +variables [has_zero α] + +lemma to_block_diagonal_self (d : m → α) (p : m → Prop) : + matrix.to_block (diagonal d) p p = diagonal (λ i : subtype p, d ↑i) := +begin + ext i j, + by_cases i = j, + { simp [h] }, + { simp [has_one.one, h, λ h', h $ subtype.ext h'], } +end + +lemma to_block_diagonal_disjoint (d : m → α) {p q : m → Prop} (hpq : disjoint p q) : + matrix.to_block (diagonal d) p q = 0 := +begin + ext ⟨i, hi⟩ ⟨j, hj⟩, + have : i ≠ j, from λ heq, hpq.le_bot i ⟨hi, heq.symm ▸ hj⟩, + simp [diagonal_apply_ne d this] +end + +@[simp] lemma from_blocks_diagonal (d₁ : l → α) (d₂ : m → α) : from_blocks (diagonal d₁) 0 0 (diagonal d₂) = diagonal (sum.elim d₁ d₂) := begin ext i j, rcases i; rcases j; simp [diagonal], end -@[simp] lemma from_blocks_one [has_zero α] [has_one α] : +end has_zero + +section has_zero_has_one +variables [has_zero α] [has_one α] + +@[simp] lemma from_blocks_one : from_blocks (1 : matrix l l α) 0 0 (1 : matrix m m α) = 1 := by { ext i j, rcases i; rcases j; simp [one_apply] } +@[simp] lemma to_block_one_self (p : m → Prop) : matrix.to_block (1 : matrix m m α) p p = 1 := +to_block_diagonal_self _ p + +lemma to_block_one_disjoint {p q : m → Prop} (hpq : disjoint p q) : + matrix.to_block (1 : matrix m m α) p q = 0 := +to_block_diagonal_disjoint _ hpq + +end has_zero_has_one + end block_matrices section block_diagonal @@ -216,8 +302,13 @@ the diagonal and zero elsewhere. See also `matrix.block_diagonal'` if the matrices may not have the same size everywhere. -/ -def block_diagonal (M : o → matrix m n α) : matrix (m × o) (n × o) α -| ⟨i, k⟩ ⟨j, k'⟩ := if k = k' then M k i j else 0 +def block_diagonal (M : o → matrix m n α) : matrix (m × o) (n × o) α := +of $ (λ ⟨i, k⟩ ⟨j, k'⟩, if k = k' then M k i j else 0 : m × o → n × o → α) + +-- TODO: set as an equation lemma for `block_diagonal`, see mathlib4#3024 +lemma block_diagonal_apply' (M : o → matrix m n α) (i k j k') : + block_diagonal M ⟨i, k⟩ ⟨j, k'⟩ = if k = k' then M k i j else 0 := +rfl lemma block_diagonal_apply (M : o → matrix m n α) (ik jk) : block_diagonal M ik jk = if ik.2 = jk.2 then M ik.2 ik.1 jk.1 else 0 := @@ -266,7 +357,7 @@ by { ext, simp [block_diagonal_apply] } block_diagonal (λ k, diagonal (d k)) = diagonal (λ ik, d ik.2 ik.1) := begin ext ⟨i, k⟩ ⟨j, k'⟩, - simp only [block_diagonal_apply, diagonal, prod.mk.inj_iff, ← ite_and], + simp only [block_diagonal_apply, diagonal_apply, prod.mk.inj_iff, ← ite_and], congr' 1, rw and_comm, end @@ -342,8 +433,12 @@ section block_diag /-- Extract a block from the diagonal of a block diagonal matrix. This is the block form of `matrix.diag`, and the left-inverse of `matrix.block_diagonal`. -/ -def block_diag (M : matrix (m × o) (n × o) α) (k : o) : matrix m n α -| i j := M (i, k) (j, k) +def block_diag (M : matrix (m × o) (n × o) α) (k : o) : matrix m n α := +of $ λ i j, M (i, k) (j, k) + +-- TODO: set as an equation lemma for `block_diag`, see mathlib4#3024 +lemma block_diag_apply (M : matrix (m × o) (n × o) α) (k : o) (i j) : + block_diag M k i j = M (i, k) (j, k) := rfl lemma block_diag_map (M : matrix (m × o) (n × o) α) (f : α → β) : block_diag (M.map f) = λ k, (block_diag M k).map f := @@ -369,14 +464,22 @@ rfl block_diag (diagonal d) k = diagonal (λ i, d (i, k)) := ext $ λ i j, begin obtain rfl | hij := decidable.eq_or_ne i j, - { rw [block_diag, diagonal_apply_eq, diagonal_apply_eq] }, - { rw [block_diag, diagonal_apply_ne _ hij, diagonal_apply_ne _ (mt _ hij)], + { rw [block_diag_apply, diagonal_apply_eq, diagonal_apply_eq] }, + { rw [block_diag_apply, diagonal_apply_ne _ hij, diagonal_apply_ne _ (mt _ hij)], exact prod.fst_eq_iff.mpr }, end @[simp] lemma block_diag_block_diagonal [decidable_eq o] (M : o → matrix m n α) : block_diag (block_diagonal M) = M := -funext $ λ k, ext $ λ i j, block_diagonal_apply_eq _ _ _ _ +funext $ λ k, ext $ λ i j, block_diagonal_apply_eq M i j _ + +lemma block_diagonal_injective [decidable_eq o] : + function.injective (block_diagonal : (o → matrix m n α) → matrix _ _ α) := +function.left_inverse.injective block_diag_block_diagonal + +@[simp] lemma block_diagonal_inj [decidable_eq o] {M N : o → matrix m n α} : + block_diagonal M = block_diagonal N ↔ M = N := +block_diagonal_injective.eq_iff @[simp] lemma block_diag_one [decidable_eq o] [decidable_eq m] [has_one α] : block_diag (1 : matrix (m × o) (m × o) α) = 1 := @@ -424,15 +527,22 @@ variables [has_zero α] [has_zero β] and zero elsewhere. This is the dependently-typed version of `matrix.block_diagonal`. -/ -def block_diagonal' (M : Π i, matrix (m' i) (n' i) α) : matrix (Σ i, m' i) (Σ i, n' i) α -| ⟨k, i⟩ ⟨k', j⟩ := if h : k = k' then M k i (cast (congr_arg n' h.symm) j) else 0 +def block_diagonal' (M : Π i, matrix (m' i) (n' i) α) : matrix (Σ i, m' i) (Σ i, n' i) α := +of $ (λ ⟨k, i⟩ ⟨k', j⟩, if h : k = k' then M k i (cast (congr_arg n' h.symm) j) else 0 : + (Σ i, m' i) → (Σ i, n' i) → α) + +-- TODO: set as an equation lemma for `block_diagonal'`, see mathlib4#3024 +lemma block_diagonal'_apply' (M : Π i, matrix (m' i) (n' i) α) (k i k' j) : + block_diagonal' M ⟨k, i⟩ ⟨k', j⟩ = + if h : k = k' then M k i (cast (congr_arg n' h.symm) j) else 0 := +rfl lemma block_diagonal'_eq_block_diagonal (M : o → matrix m n α) {k k'} (i j) : block_diagonal M (i, k) (j, k') = block_diagonal' M ⟨k, i⟩ ⟨k', j⟩ := rfl -lemma block_diagonal'_minor_eq_block_diagonal (M : o → matrix m n α) : - (block_diagonal' M).minor (prod.to_sigma ∘ prod.swap) (prod.to_sigma ∘ prod.swap) = +lemma block_diagonal'_submatrix_eq_block_diagonal (M : o → matrix m n α) : + (block_diagonal' M).submatrix (prod.to_sigma ∘ prod.swap) (prod.to_sigma ∘ prod.swap) = block_diagonal M := matrix.ext $ λ ⟨k, i⟩ ⟨k', j⟩, rfl @@ -563,8 +673,12 @@ section block_diag' /-- Extract a block from the diagonal of a block diagonal matrix. This is the block form of `matrix.diag`, and the left-inverse of `matrix.block_diagonal'`. -/ -def block_diag' (M : matrix (Σ i, m' i) (Σ i, n' i) α) (k : o) : matrix (m' k) (n' k) α -| i j := M ⟨k, i⟩ ⟨k, j⟩ +def block_diag' (M : matrix (Σ i, m' i) (Σ i, n' i) α) (k : o) : matrix (m' k) (n' k) α := +of $ λ i j, M ⟨k, i⟩ ⟨k, j⟩ + +-- TODO: set as an equation lemma for `block_diag'`, see mathlib4#3024 +lemma block_diag'_apply (M : matrix (Σ i, m' i) (Σ i, n' i) α) (k : o) (i j) : + block_diag' M k i j = M ⟨k, i⟩ ⟨k, j⟩ := rfl lemma block_diag'_map (M : matrix (Σ i, m' i) (Σ i, n' i) α) (f : α → β) : block_diag' (M.map f) = λ k, (block_diag' M k).map f := @@ -591,14 +705,22 @@ rfl block_diag' (diagonal d) k = diagonal (λ i, d ⟨k, i⟩) := ext $ λ i j, begin obtain rfl | hij := decidable.eq_or_ne i j, - { rw [block_diag', diagonal_apply_eq, diagonal_apply_eq] }, - { rw [block_diag', diagonal_apply_ne _ hij, diagonal_apply_ne _ (mt (λ h, _) hij)], + { rw [block_diag'_apply, diagonal_apply_eq, diagonal_apply_eq] }, + { rw [block_diag'_apply, diagonal_apply_ne _ hij, diagonal_apply_ne _ (mt (λ h, _) hij)], cases h, refl }, end @[simp] lemma block_diag'_block_diagonal' [decidable_eq o] (M : Π i, matrix (m' i) (n' i) α) : block_diag' (block_diagonal' M) = M := -funext $ λ k, ext $ λ i j, block_diagonal'_apply_eq _ _ _ _ +funext $ λ k, ext $ λ i j, block_diagonal'_apply_eq M _ _ _ + +lemma block_diagonal'_injective [decidable_eq o] : + function.injective (block_diagonal' : (Π i, matrix (m' i) (n' i) α) → matrix _ _ α) := +function.left_inverse.injective block_diag'_block_diagonal' + +@[simp] lemma block_diagonal'_inj [decidable_eq o] {M N : Π i, matrix (m' i) (n' i) α} : + block_diagonal' M = block_diagonal' N ↔ M = N := +block_diagonal'_injective.eq_iff @[simp] lemma block_diag'_one [decidable_eq o] [Π i, decidable_eq (m' i)] [has_one α] : block_diag' (1 : matrix (Σ i, m' i) (Σ i, m' i) α) = 1 := @@ -634,4 +756,31 @@ rfl end block_diag' +section +variables [comm_ring R] + +lemma to_block_mul_eq_mul {m n k : Type*} [fintype n] (p : m → Prop) (q : k → Prop) + (A : matrix m n R) (B : matrix n k R) : + (A ⬝ B).to_block p q = A.to_block p ⊤ ⬝ B.to_block ⊤ q := +begin + ext i k, + simp only [to_block_apply, mul_apply], + rw finset.sum_subtype, + simp [has_top.top, complete_lattice.top, bounded_order.top], +end + +lemma to_block_mul_eq_add + {m n k : Type*} [fintype n] (p : m → Prop) (q : n → Prop) [decidable_pred q] (r : k → Prop) + (A : matrix m n R) (B : matrix n k R) : + (A ⬝ B).to_block p r = + A.to_block p q ⬝ B.to_block q r + A.to_block p (λ i, ¬ q i) ⬝ B.to_block (λ i, ¬ q i) r := +begin + classical, + ext i k, + simp only [to_block_apply, mul_apply, pi.add_apply], + convert (fintype.sum_subtype_add_sum_subtype q (λ x, A ↑i x * B x ↑k)).symm +end + +end + end matrix diff --git a/src/data/matrix/char_p.lean b/src/data/matrix/char_p.lean index 49e8e4e21776e..85e4b06549949 100644 --- a/src/data/matrix/char_p.lean +++ b/src/data/matrix/char_p.lean @@ -7,6 +7,9 @@ import data.matrix.basic import algebra.char_p.basic /-! # Matrices in prime characteristic + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ open matrix diff --git a/src/data/matrix/dmatrix.lean b/src/data/matrix/dmatrix.lean index dba9388a84365..4a80dde055876 100644 --- a/src/data/matrix/dmatrix.lean +++ b/src/data/matrix/dmatrix.lean @@ -3,10 +3,14 @@ Copyright (c) 2021 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison -/ +import algebra.group.pi import data.fintype.basic /-! # Matrices + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u u' v w z @@ -53,7 +57,7 @@ by { ext, simp, } def transpose (M : dmatrix m n α) : dmatrix n m (λ j i, α i j) | x y := M y x -localized "postfix `ᵀ`:1500 := dmatrix.transpose" in dmatrix +localized "postfix (name := dmatrix.transpose) `ᵀ`:1500 := dmatrix.transpose" in dmatrix /-- `dmatrix.col u` is the column matrix whose entries are given by `u`. -/ def col {α : m → Type v} (w : Π i, α i) : dmatrix m unit (λ i j, α i) @@ -104,12 +108,10 @@ lemma map_sub [∀ i j, add_group (α i j)] {β : m → n → Type w} [∀ i j, (M - N).map (λ i j, @f i j) = M.map (λ i j, @f i j) - N.map (λ i j, @f i j) := by { ext, simp } --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_empty_left [is_empty m] : subsingleton (dmatrix m n α) := +instance subsingleton_of_empty_left [is_empty m] : subsingleton (dmatrix m n α) := ⟨λ M N, by { ext, exact is_empty_elim i }⟩ --- TODO[gh-6025]: make this an instance once safe to do so -lemma subsingleton_of_empty_right [is_empty n] : subsingleton (dmatrix m n α) := +instance subsingleton_of_empty_right [is_empty n] : subsingleton (dmatrix m n α) := ⟨λ M N, by { ext, exact is_empty_elim j }⟩ end dmatrix diff --git a/src/data/matrix/dual_number.lean b/src/data/matrix/dual_number.lean new file mode 100644 index 0000000000000..3f9e9c3ad10e4 --- /dev/null +++ b/src/data/matrix/dual_number.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.dual_number +import data.matrix.basic + +/-! +# Matrices of dual numbers are isomorphic to dual numbers over matrices + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Showing this for the more general case of `triv_sq_zero_ext R M` would require an action between +`matrix n n R` and `matrix n n M`, which would risk causing diamonds. +-/ + +variables {R n : Type} [comm_semiring R] [fintype n] [decidable_eq n] + +open matrix triv_sq_zero_ext + +/-- Matrices over dual numbers and dual numbers over matrices are isomorphic. -/ +@[simps] +def matrix.dual_number_equiv : matrix n n (dual_number R) ≃ₐ[R] dual_number (matrix n n R) := +{ to_fun := λ A, ⟨of (λ i j, (A i j).fst), of (λ i j, (A i j).snd)⟩, + inv_fun := λ d, of (λ i j, (d.fst i j, d.snd i j)), + left_inv := λ A, matrix.ext $ λ i j, triv_sq_zero_ext.ext rfl rfl, + right_inv := λ d, triv_sq_zero_ext.ext (matrix.ext $ λ i j, rfl) (matrix.ext $ λ i j, rfl), + map_mul' := λ A B, begin + ext; dsimp [mul_apply], + { simp_rw [fst_sum, fst_mul] }, + { simp_rw [snd_sum, snd_mul, smul_eq_mul, op_smul_eq_mul, finset.sum_add_distrib] }, + end, + map_add' := λ A B, triv_sq_zero_ext.ext rfl rfl, + commutes' := λ r, begin + simp_rw [algebra_map_eq_inl', algebra_map_eq_diagonal, pi.algebra_map_def, + algebra.id.map_eq_self, algebra_map_eq_inl, ←diagonal_map (inl_zero R), map_apply, + fst_inl, snd_inl], + refl, + end } diff --git a/src/data/matrix/hadamard.lean b/src/data/matrix/hadamard.lean index 2985d309e17d2..d8ca3ffc18d91 100644 --- a/src/data/matrix/hadamard.lean +++ b/src/data/matrix/hadamard.lean @@ -8,6 +8,9 @@ import linear_algebra.matrix.trace /-! # Hadamard product of matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the Hadamard product `matrix.hadamard` and contains basic properties about them. @@ -37,11 +40,14 @@ open_locale matrix big_operators /-- `matrix.hadamard` defines the Hadamard product, which is the pointwise product of two matrices of the same size.-/ -@[simp] -def hadamard [has_mul α] (A : matrix m n α) (B : matrix m n α) : matrix m n α -| i j := A i j * B i j +def hadamard [has_mul α] (A : matrix m n α) (B : matrix m n α) : matrix m n α := +of $ λ i j, A i j * B i j -localized "infix ` ⊙ `:100 := matrix.hadamard" in matrix +-- TODO: set as an equation lemma for `hadamard`, see mathlib4#3024 +@[simp] +lemma hadamard_apply [has_mul α] (A : matrix m n α) (B : matrix m n α) (i j) : + hadamard A B i j = A i j * B i j := rfl +localized "infix (name := matrix.hadamard) ` ⊙ `:100 := matrix.hadamard" in matrix section basic_properties @@ -65,11 +71,11 @@ ext $ λ _ _, right_distrib _ _ _ /- scalar multiplication -/ section scalar -@[simp] lemma smul_hadamard [has_mul α] [has_scalar R α] [is_scalar_tower R α α] (k : R) : +@[simp] lemma smul_hadamard [has_mul α] [has_smul R α] [is_scalar_tower R α α] (k : R) : (k • A) ⊙ B = k • A ⊙ B := ext $ λ _ _, smul_mul_assoc _ _ _ -@[simp] lemma hadamard_smul [has_mul α] [has_scalar R α] [smul_comm_class R α α] (k : R): +@[simp] lemma hadamard_smul [has_mul α] [has_smul R α] [smul_comm_class R α α] (k : R): A ⊙ (k • B) = k • A ⊙ B := ext $ λ _ _, mul_smul_comm _ _ _ diff --git a/src/data/matrix/invertible.lean b/src/data/matrix/invertible.lean new file mode 100644 index 0000000000000..b7ab93f0e6d2f --- /dev/null +++ b/src/data/matrix/invertible.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2023 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.invertible +import data.matrix.basic + +/-! # Extra lemmas about invertible matrices + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Many of the `invertible` lemmas are about `*`; this restates them to be about `⬝`. + +For lemmas about the matrix inverse in terms of the determinant and adjugate, see `matrix.has_inv` +in `linear_algebra/matrix/nonsingular_inverse.lean`. +-/ + +open_locale matrix + +variables {m n : Type*} {α : Type*} +variables [fintype n] [decidable_eq n] [semiring α] + +namespace matrix + +/-- A copy of `inv_of_mul_self` using `⬝` not `*`. -/ +protected lemma inv_of_mul_self (A : matrix n n α) [invertible A] : ⅟A ⬝ A = 1 := inv_of_mul_self A + +/-- A copy of `mul_inv_of_self` using `⬝` not `*`. -/ +protected lemma mul_inv_of_self (A : matrix n n α) [invertible A] : A ⬝ ⅟A = 1 := mul_inv_of_self A + +/-- A copy of `inv_of_mul_self_assoc` using `⬝` not `*`. -/ +protected lemma inv_of_mul_self_assoc (A : matrix n n α) (B : matrix n m α) [invertible A] : + ⅟A ⬝ (A ⬝ B) = B := +by rw [←matrix.mul_assoc, matrix.inv_of_mul_self, matrix.one_mul] + +/-- A copy of `mul_inv_of_self_assoc` using `⬝` not `*`. -/ +protected lemma mul_inv_of_self_assoc (A : matrix n n α) (B : matrix n m α) [invertible A] : + A ⬝ (⅟A ⬝ B) = B := +by rw [←matrix.mul_assoc, matrix.mul_inv_of_self, matrix.one_mul] + +/-- A copy of `mul_inv_of_mul_self_cancel` using `⬝` not `*`. -/ +protected lemma mul_inv_of_mul_self_cancel (A : matrix m n α) (B : matrix n n α) + [invertible B] : A ⬝ ⅟B ⬝ B = A := +by rw [matrix.mul_assoc, matrix.inv_of_mul_self, matrix.mul_one] + +/-- A copy of `mul_mul_inv_of_self_cancel` using `⬝` not `*`. -/ +protected lemma mul_mul_inv_of_self_cancel (A : matrix m n α) (B : matrix n n α) + [invertible B] : A ⬝ B ⬝ ⅟B = A := +by rw [matrix.mul_assoc, matrix.mul_inv_of_self, matrix.mul_one] + +/-- A copy of `invertible_mul` using `⬝` not `*`. -/ +@[reducible] protected def invertible_mul (A B : matrix n n α) [invertible A] [invertible B] : + invertible (A ⬝ B) := +{ inv_of := ⅟B ⬝ ⅟A, ..invertible_mul _ _ } + +/-- A copy of `invertible.mul` using `⬝` not `*`.-/ +@[reducible] def _root_.invertible.matrix_mul {A B : matrix n n α} + (ha : invertible A) (hb : invertible B) : invertible (A ⬝ B) := +invertible_mul _ _ + +protected lemma inv_of_mul {A B : matrix n n α} [invertible A] [invertible B] [invertible (A ⬝ B)] : + ⅟(A ⬝ B) = ⅟B ⬝ ⅟A := inv_of_mul _ _ + +/-- A copy of `invertible_of_invertible_mul` using `⬝` not `*`. -/ +@[reducible] protected def invertible_of_invertible_mul (a b : matrix n n α) + [invertible a] [invertible (a ⬝ b)] : invertible b := +{ inv_of := ⅟(a ⬝ b) ⬝ a, + ..invertible_of_invertible_mul a b } + +/-- A copy of `invertible_of_mul_invertible` using `⬝` not `*`. -/ +@[reducible] protected def invertible_of_mul_invertible (a b : matrix n n α) + [invertible (a ⬝ b)] [invertible b] : invertible a := +{ inv_of := b ⬝ ⅟(a ⬝ b), + ..invertible_of_mul_invertible a b } + +end matrix + +/-- A copy of `invertible.mul_left` using `⬝` not `*`. -/ +@[reducible] def invertible.matrix_mul_left + {a : matrix n n α} (ha : invertible a) (b : matrix n n α) : invertible b ≃ invertible (a ⬝ b) := +{ to_fun := λ hb, by exactI matrix.invertible_mul a b, + inv_fun := λ hab, by exactI matrix.invertible_of_invertible_mul a _, + left_inv := λ hb, subsingleton.elim _ _, + right_inv := λ hab, subsingleton.elim _ _, } + +/-- A copy of `invertible.mul_right` using `⬝` not `*`. -/ +@[reducible] def invertible.matrix_mul_right + (a : matrix n n α) {b : matrix n n α} (ha : invertible b) : invertible a ≃ invertible (a ⬝ b) := +{ to_fun := λ hb, by exactI matrix.invertible_mul a b, + inv_fun := λ hab, by exactI matrix.invertible_of_mul_invertible _ b, + left_inv := λ hb, subsingleton.elim _ _, + right_inv := λ hab, subsingleton.elim _ _, } diff --git a/src/data/matrix/kronecker.lean b/src/data/matrix/kronecker.lean index 2a4669071a85c..761a437a69959 100644 --- a/src/data/matrix/kronecker.lean +++ b/src/data/matrix/kronecker.lean @@ -5,12 +5,18 @@ Authors: Filippo A. E. Nuccio, Eric Wieser -/ import data.matrix.basic +import data.matrix.block +import linear_algebra.matrix.determinant +import linear_algebra.matrix.nonsingular_inverse import linear_algebra.tensor_product import ring_theory.tensor_product /-! # Kronecker product of matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This defines the [Kronecker product](https://en.wikipedia.org/wiki/Kronecker_product). ## Main definitions @@ -49,9 +55,14 @@ variables {l m n p : Type*} {q r : Type*} {l' m' n' p' : Type*} section kronecker_map /-- Produce a matrix with `f` applied to every pair of elements from `A` and `B`. -/ -@[simp] def kronecker_map (f : α → β → γ) (A : matrix l m α) (B : matrix n p β) : - matrix (l × n) (m × p) γ -| i j := f (A i.1 j.1) (B i.2 j.2) +def kronecker_map (f : α → β → γ) (A : matrix l m α) (B : matrix n p β) : + matrix (l × n) (m × p) γ := +of $ λ (i : l × n) (j : m × p), f (A i.1 j.1) (B i.2 j.2) + +-- TODO: set as an equation lemma for `kronecker_map`, see mathlib4#3024 +@[simp] +lemma kronecker_map_apply (f : α → β → γ) (A : matrix l m α) (B : matrix n p β) (i j) : + kronecker_map f A B i j = f (A i.1 j.1) (B i.2 j.2) := rfl lemma kronecker_map_transpose (f : α → β → γ) (A : matrix l m α) (B : matrix n p β) : @@ -95,12 +106,12 @@ lemma kronecker_map_add_right [has_add β] [has_add γ] (f : α → β → γ) kronecker_map f A (B₁ + B₂) = kronecker_map f A B₁ + kronecker_map f A B₂ := ext $ λ i j, hf _ _ _ -lemma kronecker_map_smul_left [has_scalar R α] [has_scalar R γ] (f : α → β → γ) +lemma kronecker_map_smul_left [has_smul R α] [has_smul R γ] (f : α → β → γ) (r : R) (hf : ∀ a b, f (r • a) b = r • f a b) (A : matrix l m α) (B : matrix n p β) : kronecker_map f (r • A) B = r • kronecker_map f A B := ext $ λ i j, hf _ _ -lemma kronecker_map_smul_right [has_scalar R β] [has_scalar R γ] (f : α → β → γ) +lemma kronecker_map_smul_right [has_smul R β] [has_smul R γ] (f : α → β → γ) (r : R) (hf : ∀ a b, f a (r • b) = r • f a b) (A : matrix l m α) (B : matrix n p β) : kronecker_map f A (r • B) = r • kronecker_map f A B := ext $ λ i j, hf _ _ @@ -114,6 +125,24 @@ begin simp [diagonal, apply_ite f, ite_and, ite_apply, apply_ite (f (a i₁)), hf₁, hf₂], end +lemma kronecker_map_diagonal_right [has_zero β] [has_zero γ] [decidable_eq n] + (f : α → β → γ) (hf : ∀ a, f a 0 = 0) (A : matrix l m α) (b : n → β): + kronecker_map f A (diagonal b) = block_diagonal (λ i, A.map (λ a, f a (b i))) := +begin + ext ⟨i₁, i₂⟩ ⟨j₁, j₂⟩, + simp [diagonal, block_diagonal, apply_ite (f (A i₁ j₁)), hf], +end + +lemma kronecker_map_diagonal_left [has_zero α] [has_zero γ] [decidable_eq l] + (f : α → β → γ) (hf : ∀ b, f 0 b = 0) (a : l → α) (B : matrix m n β) : + kronecker_map f (diagonal a) B = + matrix.reindex (equiv.prod_comm _ _) (equiv.prod_comm _ _) + (block_diagonal (λ i, B.map (λ b, f (a i) b))) := +begin + ext ⟨i₁, i₂⟩ ⟨j₁, j₂⟩, + simp [diagonal, block_diagonal, apply_ite f, ite_apply, hf], +end + @[simp] lemma kronecker_map_one_one [has_zero α] [has_zero β] [has_zero γ] [has_one α] [has_one β] [has_one γ] [decidable_eq m] [decidable_eq n] (f : α → β → γ) (hf₁ : ∀ b, f 0 b = 0) (hf₂ : ∀ a, f a 0 = 0) (hf₃ : f 1 1 = 1) : @@ -178,18 +207,53 @@ lemma kronecker_map_bilinear_mul_mul [comm_semiring R] begin ext ⟨i, i'⟩ ⟨j, j'⟩, simp only [kronecker_map_bilinear_apply_apply, mul_apply, ← finset.univ_product_univ, - finset.sum_product, kronecker_map], + finset.sum_product, kronecker_map_apply], simp_rw [f.map_sum, linear_map.sum_apply, linear_map.map_sum, h_comm], end +/-- `trace` distributes over `matrix.kronecker_map_bilinear`. + +This is primarily used with `R = ℕ` to prove `matrix.trace_kronecker`. -/ +lemma trace_kronecker_map_bilinear [comm_semiring R] + [fintype m] [fintype n] [add_comm_monoid α] [add_comm_monoid β] [add_comm_monoid γ] + [module R α] [module R β] [module R γ] + (f : α →ₗ[R] β →ₗ[R] γ) (A : matrix m m α) (B : matrix n n β) : + trace (kronecker_map_bilinear f A B) = f (trace A) (trace B) := +by simp_rw [matrix.trace, matrix.diag, kronecker_map_bilinear_apply_apply, + linear_map.map_sum₂, map_sum, ←finset.univ_product_univ, finset.sum_product, kronecker_map_apply] + +/-- `determinant` of `matrix.kronecker_map_bilinear`. + +This is primarily used with `R = ℕ` to prove `matrix.det_kronecker`. -/ +lemma det_kronecker_map_bilinear [comm_semiring R] + [fintype m] [fintype n] [decidable_eq m] [decidable_eq n] [comm_ring α] + [comm_ring β] [comm_ring γ] + [module R α] [module R β] [module R γ] + (f : α →ₗ[R] β →ₗ[R] γ) (h_comm : ∀ a b a' b', f (a * b) (a' * b') = f a a' * f b b') + (A : matrix m m α) (B : matrix n n β) : + det (kronecker_map_bilinear f A B) = + det (A.map (λ a, f a 1)) ^ fintype.card n * det (B.map (λ b, f 1 b)) ^ fintype.card m := +calc det (kronecker_map_bilinear f A B) + = det (kronecker_map_bilinear f A 1 ⬝ kronecker_map_bilinear f 1 B) + : by rw [←kronecker_map_bilinear_mul_mul f h_comm, matrix.mul_one, matrix.one_mul] +... = det (block_diagonal (λ _, A.map (λ a, f a 1))) + * det (block_diagonal (λ _, B.map (λ b, f 1 b))) + : begin + rw [det_mul, ←diagonal_one, ←diagonal_one, + kronecker_map_bilinear_apply_apply, kronecker_map_diagonal_right _ (λ _, _), + kronecker_map_bilinear_apply_apply, kronecker_map_diagonal_left _ (λ _, _), + det_reindex_self], + { exact linear_map.map_zero₂ _ _ }, + { exact map_zero _ }, + end +... = _ : by simp_rw [det_block_diagonal, finset.prod_const, finset.card_univ] + end kronecker_map /-! ### Specialization to `matrix.kronecker_map (*)` -/ section kronecker -variables (R) - open_locale matrix /-- The Kronecker product. This is just a shorthand for `kronecker_map (*)`. Prefer the notation @@ -197,7 +261,8 @@ open_locale matrix @[simp] def kronecker [has_mul α] : matrix l m α → matrix n p α → matrix (l × n) (m × p) α := kronecker_map (*) -localized "infix ` ⊗ₖ `:100 := matrix.kronecker_map (*)" in kronecker +localized "infix (name := matrix.kronecker_map.mul) + ` ⊗ₖ `:100 := matrix.kronecker_map (*)" in kronecker @[simp] lemma kronecker_apply [has_mul α] (A : matrix l m α) (B : matrix n p α) (i₁ i₂ j₁ j₂) : @@ -206,7 +271,7 @@ lemma kronecker_apply [has_mul α] (A : matrix l m α) (B : matrix n p α) (i₁ /-- `matrix.kronecker` as a bilinear map. -/ def kronecker_bilinear [comm_semiring R] [semiring α] [algebra R α] : matrix l m α →ₗ[R] matrix n p α →ₗ[R] matrix (l × n) (m × p) α := -kronecker_map_bilinear (algebra.lmul R α).to_linear_map +kronecker_map_bilinear (algebra.lmul R α) /-! What follows is a copy, in order, of every `matrix.kronecker_map` lemma above that has hypotheses which can be filled by properties of `*`. -/ @@ -241,10 +306,29 @@ lemma diagonal_kronecker_diagonal [mul_zero_class α] (diagonal a) ⊗ₖ (diagonal b) = diagonal (λ mn, (a mn.1) * (b mn.2)) := kronecker_map_diagonal_diagonal _ zero_mul mul_zero _ _ +lemma kronecker_diagonal [mul_zero_class α] [decidable_eq n] (A : matrix l m α) (b : n → α): + A ⊗ₖ diagonal b = block_diagonal (λ i, mul_opposite.op (b i) • A) := +kronecker_map_diagonal_right _ mul_zero _ _ + +lemma diagonal_kronecker [mul_zero_class α] [decidable_eq l](a : l → α) (B : matrix m n α) : + diagonal a ⊗ₖ B = + matrix.reindex (equiv.prod_comm _ _) (equiv.prod_comm _ _) (block_diagonal (λ i, a i • B)) := +kronecker_map_diagonal_left _ zero_mul _ _ + @[simp] lemma one_kronecker_one [mul_zero_one_class α] [decidable_eq m] [decidable_eq n] : (1 : matrix m m α) ⊗ₖ (1 : matrix n n α) = 1 := kronecker_map_one_one _ zero_mul mul_zero (one_mul _) +lemma kronecker_one [mul_zero_one_class α] [decidable_eq n] (A : matrix l m α) : + A ⊗ₖ (1 : matrix n n α) = block_diagonal (λ i, A) := +(kronecker_diagonal _ _).trans $ congr_arg _ $ funext $ λ _, matrix.ext $ λ _ _, mul_one _ + +lemma one_kronecker [mul_zero_one_class α] [decidable_eq l] (B : matrix m n α) : + (1 : matrix l l α) ⊗ₖ B = + matrix.reindex (equiv.prod_comm _ _) (equiv.prod_comm _ _) (block_diagonal (λ i, B)) := +(diagonal_kronecker _ _).trans $ + congr_arg _ $ congr_arg _ $ funext $ λ _, matrix.ext $ λ _ _, one_mul _ + lemma mul_kronecker_mul [fintype m] [fintype m'] [comm_semiring α] (A : matrix l m α) (B : matrix m n α) (A' : matrix l' m' α) (B' : matrix m' n' α) : (A ⬝ B) ⊗ₖ (A' ⬝ B') = (A ⊗ₖ A') ⬝ (B ⊗ₖ B') := @@ -255,6 +339,49 @@ kronecker_map_bilinear_mul_mul (algebra.lmul ℕ α).to_linear_map mul_mul_mul_c A ⊗ₖ (B ⊗ₖ C) := kronecker_map_assoc₁ _ _ _ _ A B C mul_assoc +lemma trace_kronecker [fintype m] [fintype n] [semiring α] + (A : matrix m m α) (B : matrix n n α) : + trace (A ⊗ₖ B) = trace A * trace B := +trace_kronecker_map_bilinear (algebra.lmul ℕ α).to_linear_map _ _ + +lemma det_kronecker [fintype m] [fintype n] [decidable_eq m] [decidable_eq n] [comm_ring R] + (A : matrix m m R) (B : matrix n n R) : + det (A ⊗ₖ B) = det A ^ fintype.card n * det B ^ fintype.card m := +begin + refine + (det_kronecker_map_bilinear (algebra.lmul ℕ R).to_linear_map mul_mul_mul_comm _ _).trans _, + congr' 3, + { ext i j, exact mul_one _}, + { ext i j, exact one_mul _}, +end + +lemma inv_kronecker [fintype m] [fintype n] [decidable_eq m] [decidable_eq n] [comm_ring R] + (A : matrix m m R) (B : matrix n n R) : + (A ⊗ₖ B)⁻¹ = A⁻¹ ⊗ₖ B⁻¹ := +begin + -- handle the special cases where either matrix is not invertible + by_cases hA : is_unit A.det, swap, + { casesI is_empty_or_nonempty n, + { exact subsingleton.elim _ _ }, + have hAB : ¬is_unit (A ⊗ₖ B).det, + { refine mt (λ hAB, _) hA, + rw det_kronecker at hAB, + exact (is_unit_pow_iff fintype.card_ne_zero).mp (is_unit_of_mul_is_unit_left hAB) }, + rw [nonsing_inv_apply_not_is_unit _ hA, zero_kronecker, nonsing_inv_apply_not_is_unit _ hAB] }, + by_cases hB : is_unit B.det, swap, + { casesI is_empty_or_nonempty m, + { exact subsingleton.elim _ _ }, + have hAB : ¬is_unit (A ⊗ₖ B).det, + { refine mt (λ hAB, _) hB, + rw det_kronecker at hAB, + exact (is_unit_pow_iff fintype.card_ne_zero).mp (is_unit_of_mul_is_unit_right hAB) }, + rw [nonsing_inv_apply_not_is_unit _ hB, kronecker_zero, + nonsing_inv_apply_not_is_unit _ hAB] }, + -- otherwise follows trivially from `mul_kronecker_mul` + { apply inv_eq_right_inv, + rw [←mul_kronecker_mul, ←one_kronecker_one, mul_nonsing_inv _ hA, mul_nonsing_inv _ hB] }, +end + end kronecker /-! ### Specialization to `matrix.kronecker_map (⊗ₜ)` -/ @@ -276,10 +403,10 @@ Prefer the notation `⊗ₖₜ` rather than this definition. -/ matrix l m α → matrix n p β → matrix (l × n) (m × p) (α ⊗[R] β) := kronecker_map (⊗ₜ) -localized "infix ` ⊗ₖₜ `:100 := matrix.kronecker_map (⊗ₜ)" in kronecker -localized - "notation x ` ⊗ₖₜ[`:100 R `] `:0 y:100 := matrix.kronecker_map (tensor_product.tmul R) x y" - in kronecker +localized "infix (name := matrix.kronecker_map.tmul) + ` ⊗ₖₜ `:100 := matrix.kronecker_map (⊗ₜ)" in kronecker +localized "notation (name := matrix.kronecker_map.tmul') + x ` ⊗ₖₜ[`:100 R `] `:0 y:100 := matrix.kronecker_map (tensor_product.tmul R) x y" in kronecker @[simp] lemma kronecker_tmul_apply (A : matrix l m α) (B : matrix n p β) (i₁ i₂ j₁ j₂) : @@ -323,19 +450,34 @@ lemma diagonal_kronecker_tmul_diagonal (diagonal a) ⊗ₖₜ[R] (diagonal b) = diagonal (λ mn, a mn.1 ⊗ₜ b mn.2) := kronecker_map_diagonal_diagonal _ (zero_tmul _) (tmul_zero _) _ _ +lemma kronecker_tmul_diagonal [decidable_eq n] (A : matrix l m α) (b : n → α): + A ⊗ₖₜ[R] (diagonal b) = block_diagonal (λ i, A.map (λ a, a ⊗ₜ[R] b i)) := +kronecker_map_diagonal_right _ (tmul_zero _) _ _ + +lemma diagonal_kronecker_tmul [decidable_eq l](a : l → α) (B : matrix m n α) : + diagonal a ⊗ₖₜ[R] B = + matrix.reindex (equiv.prod_comm _ _) (equiv.prod_comm _ _) + (block_diagonal (λ i, B.map (λ b, a i ⊗ₜ[R] b))) := +kronecker_map_diagonal_left _ (zero_tmul _) _ _ + @[simp] lemma kronecker_tmul_assoc (A : matrix l m α) (B : matrix n p β) (C : matrix q r γ) : reindex (equiv.prod_assoc l n q) (equiv.prod_assoc m p r) (((A ⊗ₖₜ[R] B) ⊗ₖₜ[R] C).map (tensor_product.assoc _ _ _ _)) = A ⊗ₖₜ[R] (B ⊗ₖₜ[R] C) := ext $ λ i j, assoc_tmul _ _ _ +lemma trace_kronecker_tmul [fintype m] [fintype n] (A : matrix m m α) (B : matrix n n β) : + trace (A ⊗ₖₜ[R] B) = trace A ⊗ₜ[R] trace B := +trace_kronecker_map_bilinear (tensor_product.mk R α β) _ _ + end module section algebra -variables [comm_semiring R] [semiring α] [semiring β] [algebra R α] [algebra R β] - open_locale kronecker open algebra.tensor_product +section semiring +variables [comm_semiring R] [semiring α] [semiring β] [algebra R α] [algebra R β] + @[simp] lemma one_kronecker_tmul_one [decidable_eq m] [decidable_eq n] : (1 : matrix m m α) ⊗ₖₜ[R] (1 : matrix n n α) = 1 := kronecker_map_one_one _ (zero_tmul _) (tmul_zero _) rfl @@ -345,6 +487,25 @@ lemma mul_kronecker_tmul_mul [fintype m] [fintype m'] (A ⬝ B) ⊗ₖₜ[R] (A' ⬝ B') = (A ⊗ₖₜ A') ⬝ (B ⊗ₖₜ B') := kronecker_map_bilinear_mul_mul (tensor_product.mk R α β) tmul_mul_tmul A B A' B' +end semiring + +section comm_ring +variables [comm_ring R] [comm_ring α] [comm_ring β] [algebra R α] [algebra R β] + +lemma det_kronecker_tmul [fintype m] [fintype n] [decidable_eq m] [decidable_eq n] + (A : matrix m m α) (B : matrix n n β) : + det (A ⊗ₖₜ[R] B) = (det A ^ fintype.card n) ⊗ₜ[R] (det B ^ fintype.card m) := +begin + refine + (det_kronecker_map_bilinear (tensor_product.mk R α β) tmul_mul_tmul _ _).trans _, + simp only [mk_apply, ←include_left_apply, ←include_right_apply] {eta := ff}, + simp only [←alg_hom.map_matrix_apply, ←alg_hom.map_det], + simp only [include_left_apply, include_right_apply, tmul_pow, tmul_mul_tmul, + one_pow, _root_.mul_one, _root_.one_mul], +end + +end comm_ring + end algebra -- insert lemmas specific to `kronecker_tmul` below this line diff --git a/src/data/matrix/notation.lean b/src/data/matrix/notation.lean index d6d5bf6659a7d..f82cd6f7c1009 100644 --- a/src/data/matrix/notation.lean +++ b/src/data/matrix/notation.lean @@ -1,7 +1,7 @@ /- Copyright (c) 2020 Anne Baanen. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Anne Baanen +Authors: Anne Baanen, Eric Wieser -/ import data.matrix.basic import data.fin.vec_notation @@ -11,10 +11,17 @@ import algebra.big_operators.fin /-! # Matrix and vector notation +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file includes `simp` lemmas for applying operations in `data.matrix.basic` to values built out of the matrix notation `![a, b] = vec_cons a (vec_cons b vec_empty)` defined in `data.fin.vec_notation`. +This also provides the new notation `!![a, b; c, d] = matrix.of ![![a, b], ![c, d]]`. +This notation also works for empty matrices; `!![,,,] : matrix (fin 0) (fin 3)` and +`!![;;;] : matrix (fin 3) (fin 0)`. + ## Implementation notes The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`. @@ -24,8 +31,12 @@ already appears in the input. ## Notations -We reuse notation `![a, b]` for `vec_cons a (vec_cons b vec_empty)`. It is a localized notation in -the `matrix` locale. +This file provide notation `!![a, b; c, d]` for matrices, which corresponds to +`matrix.of ![![a, b], ![c, d]]`. +A parser for `a, b; c, d`-style strings is provided as `matrix.entry_parser`, while +`matrix.notation` provides the hook for the `!!` notation. +Note that in lean 3 the pretty-printer will not show `!!` notation, instead showing the version +with `of ![![...]]`. ## Examples @@ -39,22 +50,88 @@ variables {α : Type u} {o n m : ℕ} {m' n' o' : Type*} open_locale matrix +/-- Matrices can be reflected whenever their entries can. We insert an `@id (matrix m' n' α)` to +prevent immediate decay to a function. -/ +meta instance matrix.reflect [reflected_univ.{u}] [reflected_univ.{u_1}] [reflected_univ.{u_2}] + [reflected _ α] [reflected _ m'] [reflected _ n'] + [h : has_reflect (m' → n' → α)] : has_reflect (matrix m' n' α) := +λ m, (by reflect_name : reflected _ @id.{(max u_1 u_2 u) + 1}).subst₂ + ((by reflect_name : reflected _ @matrix.{u_1 u_2 u}).subst₃ `(_) `(_) `(_)) $ + by { dunfold matrix, exact h m } + +section parser +open lean +open lean.parser +open interactive +open interactive.types + +/-- Parse the entries of a matrix -/ +meta def entry_parser {α : Type} (p : parser α) : + parser (Σ m n, fin m → fin n → α) := +do + -- a list of lists if the matrix has at least one row, or the number of columns if the matrix has + -- zero rows. + let p : parser (list (list α) ⊕ ℕ) := + (sum.inl <$> ( + (pure [] <* tk ";").repeat_at_least 1 <|> -- empty rows + (sep_by_trailing (tk ";") $ sep_by_trailing (tk ",") p)) <|> + (sum.inr <$> list.length <$> many (tk ","))), -- empty columns + which ← p, + match which with + | (sum.inl l) := do + h :: tl ← pure l, + let n := h.length, + l : list (vector α n) ← l.mmap (λ row, + if h : row.length = n then + pure (⟨row, h⟩ : vector α n) + else + interaction_monad.fail "Rows must be of equal length"), + pure ⟨l.length, n, λ i j, (l.nth_le _ i.prop).nth j⟩ + | (sum.inr n) := + pure ⟨0, n, fin_zero_elim⟩ + end + +-- Lean can't find this instance without some help. We only need it available in `Type 0`, and it is +-- a massive amount of effort to make it universe-polymorphic. +@[instance] meta def sigma_sigma_fin_matrix_has_reflect {α : Type} + [has_reflect α] [reflected _ α] : + has_reflect (Σ (m n : ℕ), fin m → fin n → α) := +@sigma.reflect.{0 0} _ _ ℕ (λ m, Σ n, fin m → fin n → α) _ _ _ $ λ i, + @sigma.reflect.{0 0} _ _ ℕ _ _ _ _ (λ j, infer_instance) + +/-- `!![a, b; c, d]` notation for matrices indexed by `fin m` and `fin n`. See the module docstring +for details. -/ +@[user_notation] +meta def «notation» (_ : parse $ tk "!![") + (val : parse (entry_parser (parser.pexpr 1) <* tk "]")) : parser pexpr := +do + let ⟨m, n, entries⟩ := val, + let entry_vals := pi_fin.to_pexpr (pi_fin.to_pexpr ∘ entries), + pure (``(@matrix.of (fin %%`(m)) (fin %%`(n)) _).app entry_vals) + +end parser + +variables (a b : ℕ) + /-- Use `![...]` notation for displaying a `fin`-indexed matrix, for example: ``` -#eval ![![1, 2], ![3, 4]] + ![![3, 4], ![5, 6]] -- ![![4, 6], ![8, 10]] +#eval !![1, 2; 3, 4] + !![3, 4; 5, 6] -- !![4, 6; 8, 10] ``` -/ -instance [has_repr α] : has_repr (matrix (fin m) (fin n) α) := pi_fin.has_repr +instance [has_repr α] : has_repr (matrix (fin m) (fin n) α) := +{ repr := λ f, + "!![" ++ (string.intercalate "; " $ (list.fin_range m).map $ λ i, + string.intercalate ", " $ (list.fin_range n).map (λ j, repr (f i j))) ++ "]" } -@[simp] lemma cons_val' (v : n' → α) (B : matrix (fin m) n' α) (i j) : +@[simp] lemma cons_val' (v : n' → α) (B : fin m → n' → α) (i j) : vec_cons v B i j = vec_cons (v j) (λ i, B i j) i := by { refine fin.cases _ _ i; simp } -@[simp] lemma head_val' (B : matrix (fin m.succ) n' α) (j : n') : +@[simp] lemma head_val' (B : fin m.succ → n' → α) (j : n') : vec_head (λ i, B i j) = vec_head B j := rfl -@[simp] lemma tail_val' (B : matrix (fin m.succ) n' α) (j : n') : +@[simp] lemma tail_val' (B : fin m.succ → n' → α) (j : n') : vec_tail (λ i, B i j) = λ i, vec_tail B i j := by { ext, simp [vec_tail] } @@ -99,19 +176,21 @@ end col_row section transpose -@[simp] lemma transpose_empty_rows (A : matrix m' (fin 0) α) : Aᵀ = ![] := empty_eq _ +@[simp] lemma transpose_empty_rows (A : matrix m' (fin 0) α) : Aᵀ = of ![] := empty_eq _ -@[simp] lemma transpose_empty_cols : (![] : matrix (fin 0) m' α)ᵀ = λ i, ![] := +@[simp] lemma transpose_empty_cols (A : matrix (fin 0) m' α) : Aᵀ = of (λ i, ![]) := funext (λ i, empty_eq _) @[simp] lemma cons_transpose (v : n' → α) (A : matrix (fin m) n' α) : - (vec_cons v A)ᵀ = λ i, vec_cons (v i) (Aᵀ i) := + (of (vec_cons v A))ᵀ = of (λ i, vec_cons (v i) (Aᵀ i)) := by { ext i j, refine fin.cases _ _ j; simp } -@[simp] lemma head_transpose (A : matrix m' (fin n.succ) α) : vec_head (Aᵀ) = vec_head ∘ A := +@[simp] lemma head_transpose (A : matrix m' (fin n.succ) α) : + vec_head (of.symm Aᵀ) = vec_head ∘ (of.symm A) := rfl -@[simp] lemma tail_transpose (A : matrix m' (fin n.succ) α) : vec_tail (Aᵀ) = (vec_tail ∘ A)ᵀ := +@[simp] lemma tail_transpose (A : matrix m' (fin n.succ) α) : + vec_tail (of.symm Aᵀ) = (vec_tail ∘ A)ᵀ := by { ext i j, refl } end transpose @@ -121,7 +200,7 @@ section mul variables [semiring α] @[simp] lemma empty_mul [fintype n'] (A : matrix (fin 0) n' α) (B : matrix n' o' α) : - A ⬝ B = ![] := + A ⬝ B = of ![] := empty_eq _ @[simp] lemma empty_mul_empty (A : matrix m' (fin 0) α) (B : matrix (fin 0) o' α) : @@ -129,16 +208,16 @@ empty_eq _ rfl @[simp] lemma mul_empty [fintype n'] (A : matrix m' n' α) (B : matrix n' (fin 0) α) : - A ⬝ B = λ _, ![] := + A ⬝ B = of (λ _, ![]) := funext (λ _, empty_eq _) lemma mul_val_succ [fintype n'] (A : matrix (fin m.succ) n' α) (B : matrix n' o' α) (i : fin m) (j : o') : - (A ⬝ B) i.succ j = (vec_tail A ⬝ B) i j := rfl + (A ⬝ B) i.succ j = (of (vec_tail (of.symm A)) ⬝ B) i j := rfl -@[simp] lemma cons_mul [fintype n'] (v : n' → α) (A : matrix (fin m) n' α) (B : matrix n' o' α) : - vec_cons v A ⬝ B = vec_cons (vec_mul v B) (A ⬝ B) := -by { ext i j, refine fin.cases _ _ i, { refl }, simp [mul_val_succ] } +@[simp] lemma cons_mul [fintype n'] (v : n' → α) (A : fin m → n' → α) (B : matrix n' o' α) : + of (vec_cons v A) ⬝ B = of (vec_cons (vec_mul v B) (of.symm (of A ⬝ B))) := +by { ext i j, refine fin.cases _ _ i, { refl }, simp [mul_val_succ], } end mul @@ -154,14 +233,18 @@ rfl vec_mul v B = ![] := empty_eq _ -@[simp] lemma cons_vec_mul (x : α) (v : fin n → α) (B : matrix (fin n.succ) o' α) : - vec_mul (vec_cons x v) B = x • (vec_head B) + vec_mul v (vec_tail B) := +@[simp] lemma cons_vec_mul (x : α) (v : fin n → α) (B : fin n.succ → o' → α) : + vec_mul (vec_cons x v) (of B) = x • (vec_head B) + vec_mul v (of $ vec_tail B) := by { ext i, simp [vec_mul] } -@[simp] lemma vec_mul_cons (v : fin n.succ → α) (w : o' → α) (B : matrix (fin n) o' α) : - vec_mul v (vec_cons w B) = vec_head v • w + vec_mul (vec_tail v) B := +@[simp] lemma vec_mul_cons (v : fin n.succ → α) (w : o' → α) (B : fin n → o' → α) : + vec_mul v (of $ vec_cons w B) = vec_head v • w + vec_mul (vec_tail v) (of B) := by { ext i, simp [vec_mul] } +@[simp] lemma cons_vec_mul_cons (x : α) (v : fin n → α) (w : o' → α) (B : fin n → o' → α) : + vec_mul (vec_cons x v) (of $ vec_cons w B) = x • w + vec_mul v (of B) := +by simp + end vec_mul section mul_vec @@ -177,12 +260,12 @@ empty_eq _ rfl @[simp] lemma cons_mul_vec [fintype n'] (v : n' → α) (A : fin m → n' → α) (w : n' → α) : - mul_vec (vec_cons v A) w = vec_cons (dot_product v w) (mul_vec A w) := + mul_vec (of $ vec_cons v A) w = vec_cons (dot_product v w) (mul_vec (of A) w) := by { ext i, refine fin.cases _ _ i; simp [mul_vec] } @[simp] lemma mul_vec_cons {α} [comm_semiring α] (A : m' → (fin n.succ) → α) (x : α) (v : fin n → α) : - mul_vec A (vec_cons x v) = (x • vec_head ∘ A) + mul_vec (vec_tail ∘ A) v := + mul_vec (of A) (vec_cons x v) = (x • vec_head ∘ A) + mul_vec (of (vec_tail ∘ A)) v := by { ext i, simp [mul_vec, mul_comm] } end mul_vec @@ -205,7 +288,7 @@ by { ext i, refine fin.cases _ _ i; simp [vec_mul_vec] } @[simp] lemma vec_mul_vec_cons (v : m' → α) (x : α) (w : fin n → α) : vec_mul_vec v (vec_cons x w) = λ i, v i • vec_cons x w := -by { ext i j, rw [vec_mul_vec, pi.smul_apply, smul_eq_mul] } +by { ext i j, rw [vec_mul_vec_apply, pi.smul_apply, smul_eq_mul] } end vec_mul_vec @@ -215,23 +298,35 @@ variables [semiring α] @[simp] lemma smul_mat_empty {m' : Type*} (x : α) (A : fin 0 → m' → α) : x • A = ![] := empty_eq _ -@[simp] lemma smul_mat_cons (x : α) (v : n' → α) (A : matrix (fin m) n' α) : +@[simp] lemma smul_mat_cons (x : α) (v : n' → α) (A : fin m → n' → α) : x • vec_cons v A = vec_cons (x • v) (x • A) := by { ext i, refine fin.cases _ _ i; simp } end smul -section minor +section submatrix -@[simp] lemma minor_empty (A : matrix m' n' α) (row : fin 0 → m') (col : o' → n') : - minor A row col = ![] := +@[simp] lemma submatrix_empty (A : matrix m' n' α) (row : fin 0 → m') (col : o' → n') : + submatrix A row col = ![] := empty_eq _ -@[simp] lemma minor_cons_row (A : matrix m' n' α) (i : m') (row : fin m → m') (col : o' → n') : - minor A (vec_cons i row) col = vec_cons (λ j, A i (col j)) (minor A row col) := -by { ext i j, refine fin.cases _ _ i; simp [minor] } +@[simp] lemma submatrix_cons_row (A : matrix m' n' α) (i : m') (row : fin m → m') (col : o' → n') : + submatrix A (vec_cons i row) col = vec_cons (λ j, A i (col j)) (submatrix A row col) := +by { ext i j, refine fin.cases _ _ i; simp [submatrix] } + +/-- Updating a row then removing it is the same as removing it. -/ +@[simp] lemma submatrix_update_row_succ_above (A : matrix (fin m.succ) n' α) + (v : n' → α) (f : o' → n') (i : fin m.succ) : + (A.update_row i v).submatrix i.succ_above f = A.submatrix i.succ_above f := +ext $ λ r s, (congr_fun (update_row_ne (fin.succ_above_ne i r) : _ = A _) (f s) : _) -end minor +/-- Updating a column then removing it is the same as removing it. -/ +@[simp] lemma submatrix_update_column_succ_above (A : matrix m' (fin n.succ) α) + (v : m' → α) (f : o' → m') (i : fin n.succ) : + (A.update_column i v).submatrix f i.succ_above = A.submatrix f i.succ_above := +ext $ λ r s, update_column_ne (fin.succ_above_ne i s) + +end submatrix section vec2_and_vec3 @@ -239,19 +334,28 @@ section one variables [has_zero α] [has_one α] -lemma one_fin_two : (1 : matrix (fin 2) (fin 2) α) = ![![1, 0], ![0, 1]] := +lemma one_fin_two : (1 : matrix (fin 2) (fin 2) α) = !![1, 0; 0, 1] := by { ext i j, fin_cases i; fin_cases j; refl } -lemma one_fin_three : (1 : matrix (fin 3) (fin 3) α) = ![![1, 0, 0], ![0, 1, 0], ![0, 0, 1]] := +lemma one_fin_three : (1 : matrix (fin 3) (fin 3) α) = !![1, 0, 0; 0, 1, 0; 0, 0, 1] := by { ext i j, fin_cases i; fin_cases j; refl } end one +lemma eta_fin_two (A : matrix (fin 2) (fin 2) α) : A = !![A 0 0, A 0 1; A 1 0, A 1 1] := +by { ext i j, fin_cases i; fin_cases j; refl } + +lemma eta_fin_three (A : matrix (fin 3) (fin 3) α) : + A = !![A 0 0, A 0 1, A 0 2; + A 1 0, A 1 1, A 1 2; + A 2 0, A 2 1, A 2 2] := +by { ext i j, fin_cases i; fin_cases j; refl } + lemma mul_fin_two [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) : - ![![a₁₁, a₁₂], - ![a₂₁, a₂₂]] ⬝ ![![b₁₁, b₁₂], - ![b₂₁, b₂₂]] = ![![a₁₁ * b₁₁ + a₁₂ * b₂₁, a₁₁ * b₁₂ + a₁₂ * b₂₂], - ![a₂₁ * b₁₁ + a₂₂ * b₂₁, a₂₁ * b₁₂ + a₂₂ * b₂₂]] := + !![a₁₁, a₁₂; + a₂₁, a₂₂] ⬝ !![b₁₁, b₁₂; + b₂₁, b₂₂] = !![a₁₁ * b₁₁ + a₁₂ * b₂₁, a₁₁ * b₁₂ + a₁₂ * b₂₂; + a₂₁ * b₁₁ + a₂₂ * b₂₁, a₂₁ * b₁₂ + a₂₂ * b₂₂] := begin ext i j, fin_cases i; fin_cases j; simp [matrix.mul, dot_product, fin.sum_univ_succ] @@ -259,14 +363,14 @@ end lemma mul_fin_three [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₁₃ a₂₁ a₂₂ a₂₃ a₃₁ a₃₂ a₃₃ b₁₁ b₁₂ b₁₃ b₂₁ b₂₂ b₂₃ b₃₁ b₃₂ b₃₃ : α) : - ![![a₁₁, a₁₂, a₁₃], - ![a₂₁, a₂₂, a₂₃], - ![a₃₁, a₃₂, a₃₃]] ⬝ ![![b₁₁, b₁₂, b₁₃], - ![b₂₁, b₂₂, b₂₃], - ![b₃₁, b₃₂, b₃₃]] = - ![![a₁₁*b₁₁ + a₁₂*b₂₁ + a₁₃*b₃₁, a₁₁*b₁₂ + a₁₂*b₂₂ + a₁₃*b₃₂, a₁₁*b₁₃ + a₁₂*b₂₃ + a₁₃*b₃₃], - ![a₂₁*b₁₁ + a₂₂*b₂₁ + a₂₃*b₃₁, a₂₁*b₁₂ + a₂₂*b₂₂ + a₂₃*b₃₂, a₂₁*b₁₃ + a₂₂*b₂₃ + a₂₃*b₃₃], - ![a₃₁*b₁₁ + a₃₂*b₂₁ + a₃₃*b₃₁, a₃₁*b₁₂ + a₃₂*b₂₂ + a₃₃*b₃₂, a₃₁*b₁₃ + a₃₂*b₂₃ + a₃₃*b₃₃]] := + !![a₁₁, a₁₂, a₁₃; + a₂₁, a₂₂, a₂₃; + a₃₁, a₃₂, a₃₃] ⬝ !![b₁₁, b₁₂, b₁₃; + b₂₁, b₂₂, b₂₃; + b₃₁, b₃₂, b₃₃] = + !![a₁₁*b₁₁ + a₁₂*b₂₁ + a₁₃*b₃₁, a₁₁*b₁₂ + a₁₂*b₂₂ + a₁₃*b₃₂, a₁₁*b₁₃ + a₁₂*b₂₃ + a₁₃*b₃₃; + a₂₁*b₁₁ + a₂₂*b₂₁ + a₂₃*b₃₁, a₂₁*b₁₂ + a₂₂*b₂₂ + a₂₃*b₃₂, a₂₁*b₁₃ + a₂₂*b₂₃ + a₂₃*b₃₃; + a₃₁*b₁₁ + a₃₂*b₂₁ + a₃₃*b₃₁, a₃₁*b₁₂ + a₃₂*b₂₂ + a₃₃*b₃₂, a₃₁*b₁₃ + a₃₂*b₂₃ + a₃₃*b₃₃] := begin ext i j, fin_cases i; fin_cases j; simp [matrix.mul, dot_product, fin.sum_univ_succ, ←add_assoc], @@ -288,11 +392,11 @@ lemma vec3_add [has_add α] (a₀ a₁ a₂ b₀ b₁ b₂ : α) : ![a₀, a₁, a₂] + ![b₀, b₁, b₂] = ![a₀ + b₀, a₁ + b₁, a₂ + b₂] := by rw [cons_add_cons, cons_add_cons, cons_add_cons, empty_add_empty] -lemma smul_vec2 {R : Type*} [has_scalar R α] (x : R) (a₀ a₁ : α) : +lemma smul_vec2 {R : Type*} [has_smul R α] (x : R) (a₀ a₁ : α) : x • ![a₀, a₁] = ![x • a₀, x • a₁] := by rw [smul_cons, smul_cons, smul_empty] -lemma smul_vec3 {R : Type*} [has_scalar R α] (x : R) (a₀ a₁ a₂ : α) : +lemma smul_vec3 {R : Type*} [has_smul R α] (x : R) (a₀ a₁ a₂ : α) : x • ![a₀, a₁, a₂] = ![x • a₀, x • a₁, x • a₂] := by rw [smul_cons, smul_cons, smul_cons, smul_empty] diff --git a/src/data/matrix/pequiv.lean b/src/data/matrix/pequiv.lean index 9e602fb011eac..5aa86acc0a02b 100644 --- a/src/data/matrix/pequiv.lean +++ b/src/data/matrix/pequiv.lean @@ -9,6 +9,9 @@ import data.pequiv /-! # partial equivalences for matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Using partial equivalences to represent matrices. This file introduces the function `pequiv.to_matrix`, which returns a matrix containing ones and zeros. For any partial equivalence `f`, `f.to_matrix i j = 1 ↔ f i = some j`. @@ -44,8 +47,13 @@ open_locale matrix /-- `to_matrix` returns a matrix containing ones and zeros. `f.to_matrix i j` is `1` if `f i = some j` and `0` otherwise -/ -def to_matrix [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) : matrix m n α -| i j := if j ∈ f i then 1 else 0 +def to_matrix [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) : matrix m n α := +of $ λ i j, if j ∈ f i then (1 : α) else 0 + +-- TODO: set as an equation lemma for `to_matrix`, see mathlib4#3024 +@[simp] +lemma to_matrix_apply [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) (i j) : + to_matrix f i j = if j ∈ f i then (1 : α) else 0 := rfl lemma mul_matrix_apply [fintype m] [decidable_eq m] [semiring α] (f : l ≃. m) (M : matrix m n α) (i j) : (f.to_matrix ⬝ M) i j = option.cases_on (f i) 0 (λ fi, M fi j) := @@ -59,11 +67,11 @@ end lemma to_matrix_symm [decidable_eq m] [decidable_eq n] [has_zero α] [has_one α] (f : m ≃. n) : (f.symm.to_matrix : matrix n m α) = f.to_matrixᵀ := -by ext; simp only [transpose, mem_iff_mem f, to_matrix]; congr +by ext; simp only [transpose, mem_iff_mem f, to_matrix_apply]; congr @[simp] lemma to_matrix_refl [decidable_eq n] [has_zero α] [has_one α] : ((pequiv.refl n).to_matrix : matrix n n α) = 1 := -by ext; simp [to_matrix, one_apply]; congr +by ext; simp [to_matrix_apply, one_apply]; congr lemma matrix_mul_apply [fintype m] [semiring α] [decidable_eq n] (M : matrix l m α) (f : m ≃. n) (i j) : (M ⬝ f.to_matrix) i j = option.cases_on (f.symm j) 0 (λ fj, M i fj) := @@ -81,6 +89,11 @@ lemma to_pequiv_mul_matrix [fintype m] [decidable_eq m] [semiring α] (f : m ≃ (M : matrix m n α) : (f.to_pequiv.to_matrix ⬝ M) = λ i, M (f i) := by { ext i j, rw [mul_matrix_apply, equiv.to_pequiv_apply] } +lemma mul_to_pequiv_to_matrix {m n α : Type*} [fintype n] [decidable_eq n] [semiring α] + (f : n ≃ n) (M : matrix m n α) : (M ⬝ f.to_pequiv.to_matrix) = M.submatrix id (f.symm) := +matrix.ext $ λ i j, by rw [pequiv.matrix_mul_apply, ←equiv.to_pequiv_symm, + equiv.to_pequiv_apply, matrix.submatrix_apply, id.def] + lemma to_matrix_trans [fintype m] [decidable_eq m] [decidable_eq n] [semiring α] (f : l ≃. m) (g : m ≃. n) : ((f.trans g).to_matrix : matrix l n α) = f.to_matrix ⬝ g.to_matrix := begin @@ -99,7 +112,7 @@ begin classical, assume f g, refine not_imp_not.1 _, - simp only [matrix.ext_iff.symm, to_matrix, pequiv.ext_iff, + simp only [matrix.ext_iff.symm, to_matrix_apply, pequiv.ext_iff, not_forall, exists_imp_distrib], assume i hi, use i, @@ -119,7 +132,7 @@ lemma to_matrix_swap [decidable_eq n] [ring α] (i j : n) : begin ext, dsimp [to_matrix, single, equiv.swap_apply_def, equiv.to_pequiv, one_apply], - split_ifs; simp * at * + split_ifs; {simp * at *} <|> { exfalso, assumption }, end @[simp] lemma single_mul_single [fintype n] [decidable_eq k] [decidable_eq m] [decidable_eq n] diff --git a/src/data/matrix/rank.lean b/src/data/matrix/rank.lean index 9e03e4559ebb7..abf18493118dc 100644 --- a/src/data/matrix/rank.lean +++ b/src/data/matrix/rank.lean @@ -1,14 +1,21 @@ /- Copyright (c) 2021 Johan Commelin. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johan Commelin +Authors: Johan Commelin, Eric Wieer -/ import linear_algebra.free_module.finite.rank +import linear_algebra.matrix.to_lin +import linear_algebra.finite_dimensional +import linear_algebra.matrix.dot_product +import data.complex.module /-! # Rank of matrices +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The rank of a matrix `A` is defined to be the rank of range of the linear map corresponding to `A`. This definition does not depend on the choice of basis, see `matrix.rank_eq_finrank_range_to_lin`. @@ -18,8 +25,9 @@ This definition does not depend on the choice of basis, see `matrix.rank_eq_finr ## TODO -* Show that `matrix.rank` is equal to the row-rank and column-rank -* Generalize away from fields +* Do a better job of generalizing over `ℚ`, `ℝ`, and `ℂ` in `matrix.rank_transpose` and + `matrix.rank_conj_transpose`. See + [this Zulip thread](https://leanprover.zulipchat.com/#narrow/stream/116395-maths/topic/row.20rank.20equals.20column.20rank/near/350462992). -/ @@ -29,77 +37,236 @@ namespace matrix open finite_dimensional -variables {m n o K : Type*} [m_fin : fintype m] [fintype n] [fintype o] -variables [decidable_eq n] [decidable_eq o] [field K] -variables (A : matrix m n K) +variables {l m n o R : Type*} [m_fin : fintype m] [fintype n] [fintype o] + +section comm_ring +variables [comm_ring R] /-- The rank of a matrix is the rank of its image. -/ -noncomputable def rank : ℕ := finrank K A.to_lin'.range +noncomputable def rank (A : matrix m n R) : ℕ := finrank R A.mul_vec_lin.range -@[simp] lemma rank_one : rank (1 : matrix n n K) = fintype.card n := -by rw [rank, to_lin'_one, linear_map.range_id, finrank_top, module.free.finrank_pi] +@[simp] lemma rank_one [strong_rank_condition R] [decidable_eq n] : + rank (1 : matrix n n R) = fintype.card n := +by rw [rank, mul_vec_lin_one, linear_map.range_id, finrank_top, finrank_pi] -@[simp] lemma rank_zero : rank (0 : matrix n n K) = 0 := -by rw [rank, linear_equiv.map_zero, linear_map.range_zero, finrank_bot] +@[simp] lemma rank_zero [nontrivial R] : rank (0 : matrix m n R) = 0 := +by rw [rank, mul_vec_lin_zero, linear_map.range_zero, finrank_bot] -lemma rank_le_card_width : A.rank ≤ fintype.card n := +lemma rank_le_card_width [strong_rank_condition R] (A : matrix m n R) : A.rank ≤ fintype.card n := begin - convert nat.le_of_add_le_left (A.to_lin'.finrank_range_add_finrank_ker).le, - exact (module.free.finrank_pi K).symm, + haveI : module.finite R (n → R) := module.finite.pi, + haveI : module.free R (n → R) := module.free.pi _ _, + exact A.mul_vec_lin.finrank_range_le.trans_eq (finrank_pi _) end -lemma rank_le_width {m n : ℕ} (A : matrix (fin m) (fin n) K) : A.rank ≤ n := +lemma rank_le_width [strong_rank_condition R] {m n : ℕ} (A : matrix (fin m) (fin n) R) : + A.rank ≤ n := A.rank_le_card_width.trans $ (fintype.card_fin n).le -lemma rank_mul_le (B : matrix n o K) : (A ⬝ B).rank ≤ A.rank := +lemma rank_mul_le_left [strong_rank_condition R] (A : matrix m n R) (B : matrix n o R) : + (A ⬝ B).rank ≤ A.rank := begin - refine linear_map.finrank_le_finrank_of_injective (submodule.of_le_injective _), - rw [to_lin'_mul], - exact linear_map.range_comp_le_range _ _, + rw [rank, rank, mul_vec_lin_mul], + exact cardinal.to_nat_le_of_le_of_lt_aleph_0 + (rank_lt_aleph_0 _ _) (linear_map.rank_comp_le_left _ _), end -lemma rank_unit (A : (matrix n n K)ˣ) : - (A : matrix n n K).rank = fintype.card n := +include m_fin + +lemma rank_mul_le_right [strong_rank_condition R] (A : matrix l m R) (B : matrix m n R) : + (A ⬝ B).rank ≤ B.rank := +begin + rw [rank, rank, mul_vec_lin_mul], + exact finrank_le_finrank_of_rank_le_rank + (linear_map.lift_rank_comp_le_right _ _) (rank_lt_aleph_0 _ _), +end + +omit m_fin + +lemma rank_mul_le [strong_rank_condition R] (A : matrix m n R) (B : matrix n o R) : + (A ⬝ B).rank ≤ min A.rank B.rank := +le_min (rank_mul_le_left _ _) (rank_mul_le_right _ _) + +lemma rank_unit [strong_rank_condition R] [decidable_eq n] (A : (matrix n n R)ˣ) : + (A : matrix n n R).rank = fintype.card n := begin refine le_antisymm (rank_le_card_width A) _, - have := rank_mul_le (A : matrix n n K) (↑A⁻¹ : matrix n n K), + have := rank_mul_le_left (A : matrix n n R) (↑A⁻¹ : matrix n n R), rwa [← mul_eq_mul, ← units.coe_mul, mul_inv_self, units.coe_one, rank_one] at this, end -lemma rank_of_is_unit (A : matrix n n K) (h : is_unit A) : +lemma rank_of_is_unit [strong_rank_condition R] [decidable_eq n] (A : matrix n n R) + (h : is_unit A) : A.rank = fintype.card n := by { obtain ⟨A, rfl⟩ := h, exact rank_unit A } +/-- Taking a subset of the rows and permuting the columns reduces the rank. -/ +lemma rank_submatrix_le [strong_rank_condition R] [fintype m] (f : n → m) (e : n ≃ m) + (A : matrix m m R) : + rank (A.submatrix f e) ≤ rank A := +begin + rw [rank, rank, mul_vec_lin_submatrix, linear_map.range_comp, linear_map.range_comp, + (show linear_map.fun_left R R e.symm = linear_equiv.fun_congr_left R R e.symm, from rfl), + linear_equiv.range, submodule.map_top], + exact submodule.finrank_map_le _ _, +end + +lemma rank_reindex [fintype m] (e₁ e₂ : m ≃ n) (A : matrix m m R) : + rank (reindex e₁ e₂ A) = rank A := +by rw [rank, rank, mul_vec_lin_reindex, linear_map.range_comp, linear_map.range_comp, + linear_equiv.range, submodule.map_top, linear_equiv.finrank_map_eq] + +@[simp] lemma rank_submatrix [fintype m] (A : matrix m m R) (e₁ e₂ : n ≃ m) : + rank (A.submatrix e₁ e₂) = rank A := +by simpa only [reindex_apply] using rank_reindex e₁.symm e₂.symm A + include m_fin -lemma rank_eq_finrank_range_to_lin +lemma rank_eq_finrank_range_to_lin [decidable_eq n] {M₁ M₂ : Type*} [add_comm_group M₁] [add_comm_group M₂] - [module K M₁] [module K M₂] (v₁ : basis m K M₁) (v₂ : basis n K M₂) : - A.rank = finrank K (to_lin v₂ v₁ A).range := + [module R M₁] [module R M₂] (A : matrix m n R) (v₁ : basis m R M₁) (v₂ : basis n R M₂) : + A.rank = finrank R (to_lin v₂ v₁ A).range := begin - let e₁ := (pi.basis_fun K m).equiv v₁ (equiv.refl _), - let e₂ := (pi.basis_fun K n).equiv v₂ (equiv.refl _), - have range_e₂ : (e₂ : (n → K) →ₗ[K] M₂).range = ⊤, + let e₁ := (pi.basis_fun R m).equiv v₁ (equiv.refl _), + let e₂ := (pi.basis_fun R n).equiv v₂ (equiv.refl _), + have range_e₂ : (e₂ : (n → R) →ₗ[R] M₂).range = ⊤, { rw linear_map.range_eq_top, exact e₂.surjective }, refine linear_equiv.finrank_eq (e₁.of_submodules _ _ _), rw [← linear_map.range_comp, ← linear_map.range_comp_of_range_eq_top (to_lin v₂ v₁ A) range_e₂], congr' 1, apply linear_map.pi_ext', rintro i, apply linear_map.ext_ring, - have aux₁ := to_lin_self (pi.basis_fun K n) (pi.basis_fun K m) A i, - have aux₂ := basis.equiv_apply (pi.basis_fun K n) i v₂, - rw [to_lin_eq_to_lin'] at aux₁, + have aux₁ := to_lin_self (pi.basis_fun R n) (pi.basis_fun R m) A i, + have aux₂ := basis.equiv_apply (pi.basis_fun R n) i v₂, + rw [to_lin_eq_to_lin', to_lin'_apply'] at aux₁, rw [pi.basis_fun_apply, linear_map.coe_std_basis] at aux₁ aux₂, simp only [linear_map.comp_apply, e₁, e₂, linear_equiv.coe_coe, equiv.refl_apply, aux₁, aux₂, linear_map.coe_single, to_lin_self, linear_equiv.map_sum, linear_equiv.map_smul, basis.equiv_apply], end -lemma rank_le_card_height : A.rank ≤ fintype.card m := -(submodule.finrank_le _).trans (module.free.finrank_pi K).le +lemma rank_le_card_height [strong_rank_condition R] (A : matrix m n R) : + A.rank ≤ fintype.card m := +begin + haveI : module.finite R (m → R) := module.finite.pi, + haveI : module.free R (m → R) := module.free.pi _ _, + exact (submodule.finrank_le _).trans (finrank_pi R).le +end omit m_fin -lemma rank_le_height {m n : ℕ} (A : matrix (fin m) (fin n) K) : A.rank ≤ m := +lemma rank_le_height [strong_rank_condition R] {m n : ℕ} (A : matrix (fin m) (fin n) R) : + A.rank ≤ m := A.rank_le_card_height.trans $ (fintype.card_fin m).le +/-- The rank of a matrix is the rank of the space spanned by its columns. -/ +lemma rank_eq_finrank_span_cols (A : matrix m n R) : + A.rank = finrank R (submodule.span R (set.range Aᵀ)) := +by rw [rank, matrix.range_mul_vec_lin] + +end comm_ring + +/-! ### Lemmas about transpose and conjugate transpose + +This section contains lemmas about the rank of `matrix.transpose` and `matrix.conj_transpose`. + +Unfortunately the proofs are essentially duplicated between the two; `ℚ` is a linearly-ordered ring +but can't be a star-ordered ring, while `ℂ` is star-ordered (with `open_locale complex_order`) but +not linearly ordered. For now we don't prove the transpose case for `ℂ`. + +TODO: the lemmas `matrix.rank_transpose` and `matrix.rank_conj_transpose` current follow a short +proof that is a simple consequence of `matrix.rank_transpose_mul_self` and +`matrix.rank_conj_transpose_mul_self`. This proof pulls in unecessary assumptions on `R`, and should +be replaced with a proof that uses Gaussian reduction or argues via linear combinations. +-/ + +section star_ordered_field +variables [fintype m] [field R] [partial_order R] [star_ordered_ring R] + +lemma ker_mul_vec_lin_conj_transpose_mul_self (A : matrix m n R) : + linear_map.ker (Aᴴ ⬝ A).mul_vec_lin = linear_map.ker (mul_vec_lin A):= +begin + ext x, + simp only [linear_map.mem_ker, mul_vec_lin_apply, ←mul_vec_mul_vec], + split, + { intro h, + replace h := congr_arg (dot_product (star x)) h, + rwa [dot_product_mul_vec, dot_product_zero, vec_mul_conj_transpose, star_star, + dot_product_star_self_eq_zero] at h }, + { intro h, rw [h, mul_vec_zero] }, +end + +lemma rank_conj_transpose_mul_self (A : matrix m n R) : + (Aᴴ ⬝ A).rank = A.rank := +begin + dunfold rank, + refine add_left_injective (finrank R (A.mul_vec_lin).ker) _, + dsimp only, + rw [linear_map.finrank_range_add_finrank_ker, + ←((Aᴴ ⬝ A).mul_vec_lin).finrank_range_add_finrank_ker], + congr' 1, + rw ker_mul_vec_lin_conj_transpose_mul_self, +end + +-- this follows the proof here https://math.stackexchange.com/a/81903/1896 +/-- TODO: prove this in greater generality. -/ +@[simp] lemma rank_conj_transpose (A : matrix m n R) : Aᴴ.rank = A.rank := +le_antisymm + (((rank_conj_transpose_mul_self _).symm.trans_le $ rank_mul_le_left _ _).trans_eq $ + congr_arg _ $ conj_transpose_conj_transpose _) + ((rank_conj_transpose_mul_self _).symm.trans_le $ rank_mul_le_left _ _) + +@[simp] lemma rank_self_mul_conj_transpose (A : matrix m n R) : (A ⬝ Aᴴ).rank = A.rank := +by simpa only [rank_conj_transpose, conj_transpose_conj_transpose] + using rank_conj_transpose_mul_self Aᴴ + +end star_ordered_field + +section linear_ordered_field +variables [fintype m] [linear_ordered_field R] + +lemma ker_mul_vec_lin_transpose_mul_self (A : matrix m n R) : + linear_map.ker (Aᵀ ⬝ A).mul_vec_lin = linear_map.ker (mul_vec_lin A):= +begin + ext x, + simp only [linear_map.mem_ker, mul_vec_lin_apply, ←mul_vec_mul_vec], + split, + { intro h, + replace h := congr_arg (dot_product x) h, + rwa [dot_product_mul_vec, dot_product_zero, vec_mul_transpose, + dot_product_self_eq_zero] at h }, + { intro h, rw [h, mul_vec_zero] }, +end + +lemma rank_transpose_mul_self (A : matrix m n R) : (Aᵀ ⬝ A).rank = A.rank := +begin + dunfold rank, + refine add_left_injective (finrank R (A.mul_vec_lin).ker) _, + dsimp only, + rw [linear_map.finrank_range_add_finrank_ker, + ←((Aᵀ ⬝ A).mul_vec_lin).finrank_range_add_finrank_ker], + congr' 1, + rw ker_mul_vec_lin_transpose_mul_self, +end + +/-- TODO: prove this in greater generality. -/ +@[simp] lemma rank_transpose (A : matrix m n R) : Aᵀ.rank = A.rank := +le_antisymm + ((rank_transpose_mul_self _).symm.trans_le $ rank_mul_le_left _ _) + ((rank_transpose_mul_self _).symm.trans_le $ rank_mul_le_left _ _) + +@[simp] lemma rank_self_mul_transpose (A : matrix m n R) : (A ⬝ Aᵀ).rank = A.rank := +by simpa only [rank_transpose, transpose_transpose] using rank_transpose_mul_self Aᵀ + +end linear_ordered_field + +/-- The rank of a matrix is the rank of the space spanned by its rows. + +TODO: prove this in a generality that works for `ℂ` too, not just `ℚ` and `ℝ`. -/ +lemma rank_eq_finrank_span_row [linear_ordered_field R] [finite m] (A : matrix m n R) : + A.rank = finrank R (submodule.span R (set.range A)) := +begin + casesI nonempty_fintype m, + rw [←rank_transpose, rank_eq_finrank_span_cols, transpose_transpose] +end + end matrix diff --git a/src/data/matrix/reflection.lean b/src/data/matrix/reflection.lean new file mode 100644 index 0000000000000..690bed1a0d04a --- /dev/null +++ b/src/data/matrix/reflection.lean @@ -0,0 +1,243 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import data.matrix.notation +import data.matrix.basic +import data.fin.tuple.reflection + +/-! +# Lemmas for concrete matrices `matrix (fin m) (fin n) α` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains alternative definitions of common operators on matrices that expand +definitionally to the expected expression when evaluated on `!![]` notation. + +This allows "proof by reflection", where we prove `A = !![A 0 0, A 0 1; A 1 0, A 1 1]` by defining +`matrix.eta_expand A` to be equal to the RHS definitionally, and then prove that +`A = eta_expand A`. + +The definitions in this file should normally not be used directly; the intent is for the +corresponding `*_eq` lemmas to be used in a place where they are definitionally unfolded. + +## Main definitionss + +* `matrix.transposeᵣ` +* `matrix.dot_productᵣ` +* `matrix.mulᵣ` +* `matrix.mul_vecᵣ` +* `matrix.vec_mulᵣ` +* `matrix.eta_expand` + +-/ + +open_locale matrix + +namespace matrix +variables {l m n : ℕ} {α β : Type*} + +/-- `∀` with better defeq for `∀ x : matrix (fin m) (fin n) α, P x`. -/ +def «forall» : Π {m n} (P : (matrix (fin m) (fin n) α) → Prop), Prop +| 0 n P := P (of ![]) +| (m + 1) n P := fin_vec.forall $ λ r, «forall» (λ A, P (of (matrix.vec_cons r A))) + +/-- +This can be use to prove +```lean +example (P : matrix (fin 2) (fin 3) α → Prop) : + (∀ x, P x) ↔ ∀ a b c d e f, P !![a, b, c; d, e, f] := +(forall_iff _).symm +``` +-/ +lemma forall_iff : Π {m n} (P : (matrix (fin m) (fin n) α) → Prop), «forall» P ↔ ∀ x, P x +| 0 n P := iff.symm fin.forall_fin_zero_pi +| (m + 1) n P := begin + simp only [«forall», fin_vec.forall_iff, forall_iff], + exact iff.symm fin.forall_fin_succ_pi, +end + +example (P : matrix (fin 2) (fin 3) α → Prop) : + (∀ x, P x) ↔ ∀ a b c d e f, P !![a, b, c; d, e, f] := +(forall_iff _).symm + +/--`∃` with better defeq for `∃ x : matrix (fin m) (fin n) α, P x`. -/ +def «exists» : Π {m n} (P : (matrix (fin m) (fin n) α) → Prop), Prop +| 0 n P := P (of ![]) +| (m + 1) n P := fin_vec.exists $ λ r, «exists» (λ A, P (of (matrix.vec_cons r A))) + +/-- +This can be use to prove +```lean +example (P : matrix (fin 2) (fin 3) α → Prop) : + (∃ x, P x) ↔ ∃ a b c d e f, P !![a, b, c; d, e, f] := +(exists_iff _).symm +``` +-/ +lemma exists_iff : Π {m n} (P : (matrix (fin m) (fin n) α) → Prop), «exists» P ↔ ∃ x, P x +| 0 n P := iff.symm fin.exists_fin_zero_pi +| (m + 1) n P := begin + simp only [«exists», fin_vec.exists_iff, exists_iff], + exact iff.symm fin.exists_fin_succ_pi, +end + +example (P : matrix (fin 2) (fin 3) α → Prop) : + (∃ x, P x) ↔ ∃ a b c d e f, P !![a, b, c; d, e, f] := +(exists_iff _).symm + +/-- `matrix.tranpose` with better defeq for `fin` -/ +def transposeᵣ : Π {m n}, matrix (fin m) (fin n) α → matrix (fin n) (fin m) α +| _ 0 A := of ![] +| m (n + 1) A := of $ vec_cons (fin_vec.map (λ v : fin _ → α, v 0) A) + (transposeᵣ (A.submatrix id fin.succ)) + +/-- This can be used to prove +```lean +example (a b c d : α) : transpose !![a, b; c, d] = !![a, c; b, d] := (transposeᵣ_eq _).symm +``` +-/ +@[simp] +lemma transposeᵣ_eq : Π {m n} (A : matrix (fin m) (fin n) α), + transposeᵣ A = transpose A +| _ 0 A := subsingleton.elim _ _ +| m (n + 1) A := matrix.ext $ λ i j, begin + simp_rw [transposeᵣ, transposeᵣ_eq], + refine i.cases _ (λ i, _), + { dsimp, rw fin_vec.map_eq }, + { simp only [of_apply, matrix.cons_val_succ], refl }, +end + +example (a b c d : α) : transpose !![a, b; c, d] = !![a, c; b, d] := (transposeᵣ_eq _).symm + +/-- `matrix.dot_product` with better defeq for `fin` -/ +def dot_productᵣ [has_mul α] [has_add α] [has_zero α] {m} (a b : fin m → α) : α := +fin_vec.sum $ fin_vec.seq (fin_vec.map (*) a) b + +/-- This can be used to prove +```lean +example (a b c d : α) [has_mul α] [add_comm_monoid α] : + dot_product ![a, b] ![c, d] = a * c + b * d := +(dot_productᵣ_eq _ _).symm +``` +-/ +@[simp] +lemma dot_productᵣ_eq [has_mul α] [add_comm_monoid α] {m} (a b : fin m → α) : + dot_productᵣ a b = dot_product a b := +by simp_rw [dot_productᵣ, dot_product, fin_vec.sum_eq, fin_vec.seq_eq, fin_vec.map_eq] + +example (a b c d : α) [has_mul α] [add_comm_monoid α] : + dot_product ![a, b] ![c, d] = a * c + b * d := +(dot_productᵣ_eq _ _).symm + +/-- `matrix.mul` with better defeq for `fin` -/ +def mulᵣ [has_mul α] [has_add α] [has_zero α] + (A : matrix (fin l) (fin m) α) (B : matrix (fin m) (fin n) α) : + matrix (fin l) (fin n) α := +of $ fin_vec.map (λ v₁, fin_vec.map (λ v₂, dot_productᵣ v₁ v₂) Bᵀ) A + +/-- This can be used to prove +```lean +example [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) : + !![a₁₁, a₁₂; + a₂₁, a₂₂] ⬝ !![b₁₁, b₁₂; + b₂₁, b₂₂] = + !![a₁₁*b₁₁ + a₁₂*b₂₁, a₁₁*b₁₂ + a₁₂*b₂₂; + a₂₁*b₁₁ + a₂₂*b₂₁, a₂₁*b₁₂ + a₂₂*b₂₂] := +(mulᵣ_eq _ _).symm +``` +-/ +@[simp] +lemma mulᵣ_eq [has_mul α] [add_comm_monoid α] + (A : matrix (fin l) (fin m) α) (B : matrix (fin m) (fin n) α) : + mulᵣ A B = A.mul B := +begin + simp [mulᵣ, function.comp, matrix.mul, matrix.transpose], + refl, +end + +example [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) : + !![a₁₁, a₁₂; + a₂₁, a₂₂].mul !![b₁₁, b₁₂; + b₂₁, b₂₂] = + !![a₁₁*b₁₁ + a₁₂*b₂₁, a₁₁*b₁₂ + a₁₂*b₂₂; + a₂₁*b₁₁ + a₂₂*b₂₁, a₂₁*b₁₂ + a₂₂*b₂₂] := +(mulᵣ_eq _ _).symm + +/-- `matrix.mul_vec` with better defeq for `fin` -/ +def mul_vecᵣ [has_mul α] [has_add α] [has_zero α] (A : matrix (fin l) (fin m) α) (v : fin m → α) : + fin l → α := +fin_vec.map (λ a, dot_productᵣ a v) A + +/-- This can be used to prove +```lean +example [non_unital_non_assoc_semiring α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁ b₂ : α) : + !![a₁₁, a₁₂; + a₂₁, a₂₂].mul_vec ![b₁, b₂] = ![a₁₁*b₁ + a₁₂*b₂, a₂₁*b₁ + a₂₂*b₂] := +(mul_vecᵣ_eq _ _).symm +``` +-/ +@[simp] +lemma mul_vecᵣ_eq [non_unital_non_assoc_semiring α] + (A : matrix (fin l) (fin m) α) (v : fin m → α) : + mul_vecᵣ A v = A.mul_vec v := +begin + simp [mul_vecᵣ, function.comp], + refl, +end + +example [non_unital_non_assoc_semiring α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁ b₂ : α) : + !![a₁₁, a₁₂; + a₂₁, a₂₂].mul_vec ![b₁, b₂] = ![a₁₁*b₁ + a₁₂*b₂, a₂₁*b₁ + a₂₂*b₂] := +(mul_vecᵣ_eq _ _).symm + +/-- `matrix.vec_mul` with better defeq for `fin` -/ +def vec_mulᵣ [has_mul α] [has_add α] [has_zero α] (v : fin l → α) (A : matrix (fin l) (fin m) α): + fin m → α := +fin_vec.map (λ a, dot_productᵣ v a) Aᵀ + +/-- This can be used to prove +```lean +example [non_unital_non_assoc_semiring α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁ b₂ : α) : + vec_mul ![b₁, b₂] !![a₁₁, a₁₂; + a₂₁, a₂₂] = ![b₁*a₁₁ + b₂*a₂₁, b₁*a₁₂ + b₂*a₂₂] := +(vec_mulᵣ_eq _ _).symm +``` +-/ +@[simp] +lemma vec_mulᵣ_eq [non_unital_non_assoc_semiring α] + (v : fin l → α) (A : matrix (fin l) (fin m) α) : + vec_mulᵣ v A = vec_mul v A := +begin + simp [vec_mulᵣ, function.comp], + refl, +end + +example [non_unital_non_assoc_semiring α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁ b₂ : α) : + vec_mul ![b₁, b₂] !![a₁₁, a₁₂; + a₂₁, a₂₂] = ![b₁*a₁₁ + b₂*a₂₁, b₁*a₁₂ + b₂*a₂₂] := +(vec_mulᵣ_eq _ _).symm + +/-- Expand `A` to `!![A 0 0, ...; ..., A m n]` -/ +def eta_expand {m n} (A : matrix (fin m) (fin n) α) : matrix (fin m) (fin n) α := +matrix.of (fin_vec.eta_expand (λ i, fin_vec.eta_expand (λ j, A i j))) + +/-- This can be used to prove +```lean +example (A : matrix (fin 2) (fin 2) α) : + A = !![A 0 0, A 0 1; + A 1 0, A 1 1] := +(eta_expand_eq _).symm +``` +-/ +lemma eta_expand_eq {m n} (A : matrix (fin m) (fin n) α) : + eta_expand A = A := +by simp_rw [eta_expand, fin_vec.eta_expand_eq, matrix.of, equiv.refl_apply] + +example (A : matrix (fin 2) (fin 2) α) : + A = !![A 0 0, A 0 1; + A 1 0, A 1 1] := +(eta_expand_eq _).symm + +end matrix diff --git a/src/data/mllist.lean b/src/data/mllist.lean index 8fa1b232225cf..be391cfbe0076 100644 --- a/src/data/mllist.lean +++ b/src/data/mllist.lean @@ -7,6 +7,9 @@ import data.option.defs /-! # Monadic lazy lists. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + An alternative construction of lazy lists (see also `data.lazy_list`), with "lazyness" controlled by an arbitrary monad. diff --git a/src/data/multiset/antidiagonal.lean b/src/data/multiset/antidiagonal.lean index ad9f28add138d..3a376862c720f 100644 --- a/src/data/multiset/antidiagonal.lean +++ b/src/data/multiset/antidiagonal.lean @@ -3,12 +3,14 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.multiset.bind import data.multiset.powerset /-! # The antidiagonal on a multiset. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The antidiagonal of a multiset `s` consists of all pairs `(t₁, t₂)` such that `t₁ + t₂ = s`. These pairs are counted with multiplicities. -/ @@ -67,10 +69,23 @@ quotient.induction_on s $ λ l, begin {congr; simp}, {simp} end +theorem antidiagonal_eq_map_powerset [decidable_eq α] (s : multiset α) : + s.antidiagonal = s.powerset.map (λ t, (s - t, t)) := +begin + induction s using multiset.induction_on with a s hs, + { simp only [antidiagonal_zero, powerset_zero, zero_tsub, map_singleton] }, + { simp_rw [antidiagonal_cons, powerset_cons, map_add, hs, map_map, function.comp, prod.map_mk, + id.def, sub_cons, erase_cons_head], + rw add_comm, + congr' 1, + refine multiset.map_congr rfl (λ x hx, _), + rw cons_sub_of_le _ (mem_powerset.mp hx) } +end + @[simp] theorem card_antidiagonal (s : multiset α) : card (antidiagonal s) = 2 ^ card s := by have := card_powerset s; - rwa [← antidiagonal_map_fst, card_map] at this + rwa [← antidiagonal_map_fst, card_map] at this lemma prod_map_add [comm_semiring β] {s : multiset α} {f g : α → β} : prod (s.map (λa, f a + g a)) = diff --git a/src/data/multiset/basic.lean b/src/data/multiset/basic.lean index 7b15c442460d7..99873f8d0abe7 100644 --- a/src/data/multiset/basic.lean +++ b/src/data/multiset/basic.lean @@ -3,17 +3,20 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.bool.all_any +import data.set.list import data.list.perm /-! # Multisets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. These are implemented as the quotient of a list by permutations. ## Notation We define the global infix notation `::ₘ` for `multiset.cons`. -/ -open list subtype nat +open function list nat subtype variables {α : Type*} {β : Type*} {γ : Type*} @@ -53,12 +56,15 @@ instance : has_zero (multiset α) := ⟨multiset.zero⟩ instance : has_emptyc (multiset α) := ⟨0⟩ instance inhabited_multiset : inhabited (multiset α) := ⟨0⟩ -@[simp] theorem coe_nil_eq_zero : (@nil α : multiset α) = 0 := rfl +@[simp] theorem coe_nil : (@nil α : multiset α) = 0 := rfl @[simp] theorem empty_eq_zero : (∅ : multiset α) = 0 := rfl @[simp] theorem coe_eq_zero (l : list α) : (l : multiset α) = 0 ↔ l = [] := iff.trans coe_eq_coe perm_nil +lemma coe_eq_zero_iff_empty (l : list α) : (l : multiset α) = 0 ↔ l.empty := +iff.trans (coe_eq_zero l) (empty_iff_eq_nil).symm + /-! ### `multiset.cons` -/ /-- `cons a s` is the multiset which contains `s` plus one more @@ -77,8 +83,6 @@ instance : has_insert α (multiset α) := ⟨cons⟩ @[simp] theorem cons_coe (a : α) (l : list α) : (a ::ₘ l : multiset α) = (a::l : list α) := rfl -theorem singleton_coe (a : α) : (a ::ₘ 0 : multiset α) = ([a] : list α) := rfl - @[simp] theorem cons_inj_left {a b : α} (s : multiset α) : a ::ₘ s = b ::ₘ s ↔ a = b := ⟨quot.induction_on s $ λ l e, @@ -218,7 +222,35 @@ end end mem +/-! ### Singleton -/ + +instance : has_singleton α (multiset α) := ⟨λ a, a ::ₘ 0⟩ + +instance : is_lawful_singleton α (multiset α) := ⟨λ a, rfl⟩ + +@[simp] theorem cons_zero (a : α) : a ::ₘ 0 = {a} := rfl + +@[simp, norm_cast] theorem coe_singleton (a : α) : ([a] : multiset α) = {a} := rfl + +@[simp] theorem mem_singleton {a b : α} : b ∈ ({a} : multiset α) ↔ b = a := +by simp only [←cons_zero, mem_cons, iff_self, or_false, not_mem_zero] + +theorem mem_singleton_self (a : α) : a ∈ ({a} : multiset α) := +by { rw ←cons_zero, exact mem_cons_self _ _ } + +@[simp] theorem singleton_inj {a b : α} : ({a} : multiset α) = {b} ↔ a = b := +by { simp_rw [←cons_zero], exact cons_inj_left _ } + +@[simp, norm_cast] lemma coe_eq_singleton {l : list α} {a : α} : (l : multiset α) = {a} ↔ l = [a] := +by rw [←coe_singleton, coe_eq_coe, list.perm_singleton] + +@[simp] lemma singleton_eq_cons_iff {a b : α} (m : multiset α) : {a} = b ::ₘ m ↔ a = b ∧ m = 0 := +by { rw [←cons_zero, cons_eq_cons], simp [eq_comm] } + +theorem pair_comm (x y : α) : ({x, y} : multiset α) = {y, x} := cons_swap x y 0 + /-! ### `multiset.subset` -/ + section subset /-- `s ⊆ t` is the lift of the list subset relation. It means that any @@ -262,28 +294,38 @@ theorem subset_zero {s : multiset α} : s ⊆ 0 ↔ s = 0 := ⟨eq_zero_of_subset_zero, λ xeq, xeq.symm ▸ subset.refl 0⟩ lemma induction_on' {p : multiset α → Prop} (S : multiset α) - (h₁ : p ∅) (h₂ : ∀ {a s}, a ∈ S → s ⊆ S → p s → p (insert a s)) : p S := + (h₁ : p 0) (h₂ : ∀ {a s}, a ∈ S → s ⊆ S → p s → p (insert a s)) : p S := @multiset.induction_on α (λ T, T ⊆ S → p T) S (λ _, h₁) (λ a s hps hs, let ⟨hS, sS⟩ := cons_subset.1 hs in h₂ hS sS (hps sS)) (subset.refl S) end subset +/-! ### `multiset.to_list` -/ + section to_list /-- Produces a list of the elements in the multiset using choice. -/ -@[reducible] noncomputable def to_list {α : Type*} (s : multiset α) := -classical.some (quotient.exists_rep s) - -@[simp] lemma to_list_zero {α : Type*} : (multiset.to_list 0 : list α) = [] := -(multiset.coe_eq_zero _).1 (classical.some_spec (quotient.exists_rep multiset.zero)) +noncomputable def to_list (s : multiset α) := s.out' @[simp, norm_cast] -lemma coe_to_list {α : Type*} (s : multiset α) : (s.to_list : multiset α) = s := -classical.some_spec (quotient.exists_rep _) +lemma coe_to_list (s : multiset α) : (s.to_list : multiset α) = s := s.out_eq' -@[simp] -lemma mem_to_list {α : Type*} (a : α) (s : multiset α) : a ∈ s.to_list ↔ a ∈ s := -by rw [←multiset.mem_coe, multiset.coe_to_list] +@[simp] lemma to_list_eq_nil {s : multiset α} : s.to_list = [] ↔ s = 0 := +by rw [← coe_eq_zero, coe_to_list] + +@[simp] lemma empty_to_list {s : multiset α} : s.to_list.empty ↔ s = 0 := +empty_iff_eq_nil.trans to_list_eq_nil + +@[simp] lemma to_list_zero : (multiset.to_list 0 : list α) = [] := to_list_eq_nil.mpr rfl + +@[simp] lemma mem_to_list {a : α} {s : multiset α} : a ∈ s.to_list ↔ a ∈ s := +by rw [← mem_coe, coe_to_list] + +@[simp] lemma to_list_eq_singleton_iff {a : α} {m : multiset α} : m.to_list = [a] ↔ m = {a} := +by rw [←perm_singleton, ←coe_eq_coe, coe_to_list, coe_singleton] + +@[simp] lemma to_list_singleton (a : α) : ({a} : multiset α).to_list = [a] := +multiset.to_list_eq_singleton_iff.2 rfl end to_list @@ -301,12 +343,15 @@ instance : partial_order (multiset α) := le_trans := by rintros ⟨l₁⟩ ⟨l₂⟩ ⟨l₃⟩; exact @subperm.trans _ _ _ _, le_antisymm := by rintros ⟨l₁⟩ ⟨l₂⟩ h₁ h₂; exact quot.sound (subperm.antisymm h₁ h₂) } +instance decidable_le [decidable_eq α] : decidable_rel ((≤) : multiset α → multiset α → Prop) := +λ s t, quotient.rec_on_subsingleton₂ s t list.decidable_subperm + section variables {s t : multiset α} {a : α} lemma subset_of_le : s ≤ t → s ⊆ t := quotient.induction_on₂ s t $ λ l₁ l₂, subperm.subset -alias subset_of_le ← multiset.le.subset +alias subset_of_le ← le.subset lemma mem_of_le (h : s ≤ t) : a ∈ s → a ∈ t := mem_of_subset (subset_of_le h) @@ -323,7 +368,12 @@ quotient.induction_on₂ s t (λ l₁ l₂ ⟨l, p, s⟩, theorem zero_le (s : multiset α) : 0 ≤ s := quot.induction_on s $ λ l, (nil_sublist l).subperm -lemma le_zero : s ≤ 0 ↔ s = 0 := ⟨λ h, le_antisymm h (zero_le _), le_of_eq⟩ +instance : order_bot (multiset α) := ⟨0, zero_le⟩ + +/-- This is a `rfl` and `simp` version of `bot_eq_zero`. -/ +@[simp] theorem bot_eq_zero : (⊥ : multiset α) = 0 := rfl + +lemma le_zero : s ≤ 0 ↔ s = 0 := le_bot_iff theorem lt_cons_self (s : multiset α) (a : α) : s < a ::ₘ s := quot.induction_on s $ λ l, @@ -352,24 +402,6 @@ begin ((sublist_or_mem_of_sublist s).resolve_right m₁).subperm) end -end - -/-! ### Singleton -/ -instance : has_singleton α (multiset α) := ⟨λ a, a ::ₘ 0⟩ - -instance : is_lawful_singleton α (multiset α) := ⟨λ a, rfl⟩ - -theorem singleton_eq_cons (a : α) : singleton a = a ::ₘ 0 := rfl - -@[simp] theorem mem_singleton {a b : α} : b ∈ ({a} : multiset α) ↔ b = a := -by simp only [singleton_eq_cons, mem_cons, iff_self, or_false, not_mem_zero] - -theorem mem_singleton_self (a : α) : a ∈ ({a} : multiset α) := -by { rw singleton_eq_cons, exact mem_cons_self _ _ } - -theorem singleton_inj {a b : α} : ({a} : multiset α) = {b} ↔ a = b := -by { simp_rw [singleton_eq_cons], exact cons_inj_left _ } - @[simp] theorem singleton_ne_zero (a : α) : ({a} : multiset α) ≠ 0 := ne_of_gt (lt_cons_self _ _) @@ -377,6 +409,8 @@ ne_of_gt (lt_cons_self _ _) ⟨λ h, mem_of_le h (mem_singleton_self _), λ h, let ⟨t, e⟩ := exists_cons_of_mem h in e.symm ▸ cons_le_cons _ (zero_le _)⟩ +end + /-! ### Additive monoid -/ /-- The sum of two multisets is the lift of the list append operation. @@ -390,32 +424,27 @@ instance : has_add (multiset α) := ⟨multiset.add⟩ @[simp] theorem coe_add (s t : list α) : (s + t : multiset α) = (s ++ t : list α) := rfl -protected theorem add_comm (s t : multiset α) : s + t = t + s := -quotient.induction_on₂ s t $ λ l₁ l₂, quot.sound perm_append_comm - -protected theorem zero_add (s : multiset α) : 0 + s = s := -quot.induction_on s $ λ l, rfl - -theorem singleton_add (a : α) (s : multiset α) : {a} + s = a ::ₘ s := rfl +@[simp] theorem singleton_add (a : α) (s : multiset α) : {a} + s = a ::ₘ s := rfl -protected theorem add_le_add_left (s) {t u : multiset α} : s + t ≤ s + u ↔ t ≤ u := +private theorem add_le_add_iff_left' {s t u : multiset α} : s + t ≤ s + u ↔ t ≤ u := quotient.induction_on₃ s t u $ λ l₁ l₂ l₃, subperm_append_left _ -protected theorem add_left_cancel (s) {t u : multiset α} (h : s + t = s + u) : t = u := -le_antisymm ((multiset.add_le_add_left _).1 (le_of_eq h)) - ((multiset.add_le_add_left _).1 (le_of_eq h.symm)) +instance : covariant_class (multiset α) (multiset α) (+) (≤) := +⟨λ s t u, add_le_add_iff_left'.2⟩ + +instance : contravariant_class (multiset α) (multiset α) (+) (≤) := +⟨λ s t u, add_le_add_iff_left'.1⟩ instance : ordered_cancel_add_comm_monoid (multiset α) := { zero := 0, add := (+), - add_comm := multiset.add_comm, + add_comm := λ s t, quotient.induction_on₂ s t $ λ l₁ l₂, quot.sound perm_append_comm, add_assoc := λ s₁ s₂ s₃, quotient.induction_on₃ s₁ s₂ s₃ $ λ l₁ l₂ l₃, congr_arg coe $ append_assoc l₁ l₂ l₃, - zero_add := multiset.zero_add, - add_zero := λ s, by rw [multiset.add_comm, multiset.zero_add], - add_left_cancel := multiset.add_left_cancel, - add_le_add_left := λ s₁ s₂ h s₃, (multiset.add_le_add_left _).2 h, - le_of_add_le_add_left := λ s₁ s₂ s₃, (multiset.add_le_add_left _).1, + zero_add := λ s, quot.induction_on s $ λ l, rfl, + add_zero := λ s, quotient.induction_on s $ λ l, congr_arg coe $ append_nil l, + add_le_add_left := λ s₁ s₂, add_le_add_left, + le_of_add_le_add_left := λ s₁ s₂ s₃, le_of_add_le_add_left, ..@multiset.partial_order α } theorem le_add_right (s t : multiset α) : s ≤ s + t := @@ -428,12 +457,10 @@ theorem le_iff_exists_add {s t : multiset α} : s ≤ t ↔ ∃ u, t = s + u := let ⟨l, p⟩ := s.exists_perm_append in ⟨l, quot.sound p⟩, λ ⟨u, e⟩, e.symm ▸ le_add_right _ _⟩ -instance : order_bot (multiset α) := -{ bot := 0, - bot_le := multiset.zero_le } - instance : canonically_ordered_add_monoid (multiset α) := -{ le_iff_exists_add := @le_iff_exists_add _, +{ le_self_add := le_add_right, + exists_add_of_le := λ a b h, le_induction_on h $ λ l₁ l₂ s, + let ⟨l, p⟩ := s.exists_perm_append in ⟨l, quot.sound p⟩, ..multiset.order_bot, ..multiset.ordered_cancel_add_comm_monoid } @@ -478,6 +505,9 @@ def card : multiset α →+ ℕ := @[simp] theorem coe_card (l : list α) : card (l : multiset α) = length l := rfl +@[simp] theorem length_to_list (s : multiset α) : s.to_list.length = s.card := +by rw [← coe_card, coe_to_list] + @[simp] theorem card_zero : @card α 0 = 0 := rfl theorem card_add (s t : multiset α) : card (s + t) = card s + card t := @@ -491,7 +521,7 @@ by rw [card.map_nsmul s n, nat.nsmul_eq_mul] quot.induction_on s $ λ l, rfl @[simp] theorem card_singleton (a : α) : card ({a} : multiset α) = 1 := -by simp only [singleton_eq_cons, card_zero, eq_self_iff_true, zero_add, card_cons] +by simp only [←cons_zero, card_zero, eq_self_iff_true, zero_add, card_cons] lemma card_pair (a b : α) : ({a, b} : multiset α).card = 2 := by rw [insert_eq_cons, card_cons, card_singleton] @@ -502,12 +532,12 @@ theorem card_eq_one {s : multiset α} : card s = 1 ↔ ∃ a, s = {a} := λ ⟨a, e⟩, e.symm ▸ rfl⟩ theorem card_le_of_le {s t : multiset α} (h : s ≤ t) : card s ≤ card t := -le_induction_on h $ λ l₁ l₂, length_le_of_sublist +le_induction_on h $ λ l₁ l₂, sublist.length_le @[mono] theorem card_mono : monotone (@card α) := λ a b, card_le_of_le theorem eq_of_le_of_card_le {s t : multiset α} (h : s ≤ t) : card t ≤ card s → s = t := -le_induction_on h $ λ l₁ l₂ s h₂, congr_arg coe $ eq_of_sublist_of_length_le s h₂ +le_induction_on h $ λ l₁ l₂ s h₂, congr_arg coe $ s.eq_of_length_le h₂ theorem card_lt_of_lt {s t : multiset α} (h : s < t) : card s < card t := lt_of_not_ge $ λ h₂, ne_of_lt h $ eq_of_le_of_card_le (le_of_lt h) h₂ @@ -589,61 +619,92 @@ by { dunfold strong_downward_induction_on, rw strong_downward_induction } lemma well_founded_lt : well_founded ((<) : multiset α → multiset α → Prop) := subrelation.wf (λ _ _, multiset.card_lt_of_lt) (measure_wf multiset.card) -/-! ### `multiset.repeat` -/ +instance is_well_founded_lt : _root_.well_founded_lt (multiset α) := ⟨well_founded_lt⟩ -/-- `repeat a n` is the multiset containing only `a` with multiplicity `n`. -/ -def repeat (a : α) (n : ℕ) : multiset α := repeat a n +/-! ### `multiset.replicate` -/ -@[simp] lemma repeat_zero (a : α) : repeat a 0 = 0 := rfl +/-- `replicate n a` is the multiset containing only `a` with multiplicity `n`. -/ +def replicate (n : ℕ) (a : α) : multiset α := replicate n a -@[simp] lemma repeat_succ (a : α) (n) : repeat a (n+1) = a ::ₘ repeat a n := by simp [repeat] +lemma coe_replicate (n : ℕ) (a : α) : (list.replicate n a : multiset α) = replicate n a := rfl -@[simp] lemma repeat_one (a : α) : repeat a 1 = {a} := -by simp only [repeat_succ, singleton_eq_cons, eq_self_iff_true, repeat_zero, cons_inj_right] +@[simp] lemma replicate_zero (a : α) : replicate 0 a = 0 := rfl +@[simp] lemma replicate_succ (a : α) (n) : replicate (n + 1) a = a ::ₘ replicate n a := rfl -@[simp] lemma card_repeat : ∀ (a : α) n, card (repeat a n) = n := length_repeat +lemma replicate_add (m n : ℕ) (a : α) : replicate (m + n) a = replicate m a + replicate n a := +congr_arg _ $ list.replicate_add _ _ _ -lemma mem_repeat {a b : α} {n : ℕ} : b ∈ repeat a n ↔ n ≠ 0 ∧ b = a := mem_repeat +/-- `multiset.replicate` as an `add_monoid_hom`. -/ +@[simps] def replicate_add_monoid_hom (a : α) : ℕ →+ multiset α := +{ to_fun := λ n, replicate n a, + map_zero' := replicate_zero a, + map_add' := λ _ _, replicate_add _ _ a } -theorem eq_of_mem_repeat {a b : α} {n} : b ∈ repeat a n → b = a := eq_of_mem_repeat +lemma replicate_one (a : α) : replicate 1 a = {a} := rfl -theorem eq_repeat' {a : α} {s : multiset α} : s = repeat a s.card ↔ ∀ b ∈ s, b = a := -quot.induction_on s $ λ l, iff.trans ⟨λ h, - (perm_repeat.1 $ (quotient.exact h)), congr_arg coe⟩ eq_repeat' +@[simp] lemma card_replicate : ∀ n (a : α), card (replicate n a) = n := length_replicate + +lemma mem_replicate {a b : α} {n : ℕ} : b ∈ replicate n a ↔ n ≠ 0 ∧ b = a := mem_replicate + +theorem eq_of_mem_replicate {a b : α} {n} : b ∈ replicate n a → b = a := eq_of_mem_replicate + +theorem eq_replicate_card {a : α} {s : multiset α} : s = replicate s.card a ↔ ∀ b ∈ s, b = a := +quot.induction_on s $ λ l, coe_eq_coe.trans $ perm_replicate.trans eq_replicate_length -theorem eq_repeat_of_mem {a : α} {s : multiset α} : (∀ b ∈ s, b = a) → s = repeat a s.card := -eq_repeat'.2 +alias eq_replicate_card ↔ _ eq_replicate_of_mem -theorem eq_repeat {a : α} {n} {s : multiset α} : s = repeat a n ↔ card s = n ∧ ∀ b ∈ s, b = a := -⟨λ h, h.symm ▸ ⟨card_repeat _ _, λ b, eq_of_mem_repeat⟩, - λ ⟨e, al⟩, e ▸ eq_repeat_of_mem al⟩ +theorem eq_replicate {a : α} {n} {s : multiset α} : + s = replicate n a ↔ card s = n ∧ ∀ b ∈ s, b = a := +⟨λ h, h.symm ▸ ⟨card_replicate _ _, λ b, eq_of_mem_replicate⟩, + λ ⟨e, al⟩, e ▸ eq_replicate_of_mem al⟩ -lemma repeat_left_injective {n : ℕ} (hn : n ≠ 0) : function.injective (λ a : α, repeat a n) := -λ a b h, (eq_repeat.1 h).2 _ $ mem_repeat.2 ⟨hn, rfl⟩ +lemma replicate_right_injective {n : ℕ} (hn : n ≠ 0) : + function.injective (replicate n : α → multiset α) := +λ a b h, (eq_replicate.1 h).2 _ $ mem_replicate.2 ⟨hn, rfl⟩ -@[simp] lemma repeat_left_inj {a b : α} {n : ℕ} (h : n ≠ 0) : repeat a n = repeat b n ↔ a = b := -(repeat_left_injective h).eq_iff +@[simp] lemma replicate_right_inj {a b : α} {n : ℕ} (h : n ≠ 0) : + replicate n a = replicate n b ↔ a = b := +(replicate_right_injective h).eq_iff -theorem repeat_injective (a : α) : function.injective (repeat a) := -λ m n h, by rw [← (eq_repeat.1 h).1, card_repeat] +theorem replicate_left_injective (a : α) : function.injective (λ n, replicate n a) := +λ m n h, by rw [← (eq_replicate.1 h).1, card_replicate] -theorem repeat_subset_singleton : ∀ (a : α) n, repeat a n ⊆ {a} := repeat_subset_singleton +theorem replicate_subset_singleton : ∀ n (a : α), replicate n a ⊆ {a} := replicate_subset_singleton -theorem repeat_le_coe {a : α} {n} {l : list α} : repeat a n ≤ l ↔ list.repeat a n <+ l := -⟨λ ⟨l', p, s⟩, (perm_repeat.1 p) ▸ s, sublist.subperm⟩ +theorem replicate_le_coe {a : α} {n} {l : list α} : + replicate n a ≤ l ↔ list.replicate n a <+ l := +⟨λ ⟨l', p, s⟩, (perm_replicate.1 p) ▸ s, sublist.subperm⟩ -theorem nsmul_singleton (a : α) (n) : n • ({a} : multiset α) = repeat a n := +theorem nsmul_singleton (a : α) (n) : n • ({a} : multiset α) = replicate n a := begin - refine eq_repeat.mpr ⟨_, λ b hb, mem_singleton.mp (mem_of_mem_nsmul hb)⟩, + refine eq_replicate.mpr ⟨_, λ b hb, mem_singleton.mp (mem_of_mem_nsmul hb)⟩, rw [card_nsmul, card_singleton, mul_one] end -lemma nsmul_repeat {a : α} (n m : ℕ) : n • (repeat a m) = repeat a (n * m) := +lemma nsmul_replicate {a : α} (n m : ℕ) : n • replicate m a = replicate (n * m) a := +((replicate_add_monoid_hom a).map_nsmul _ _).symm + +lemma replicate_le_replicate (a : α) {k n : ℕ} : + replicate k a ≤ replicate n a ↔ k ≤ n := +replicate_le_coe.trans $ list.replicate_sublist_replicate _ + +lemma le_replicate_iff {m : multiset α} {a : α} {n : ℕ} : + m ≤ replicate n a ↔ ∃ (k ≤ n), m = replicate k a := +⟨λ h, ⟨m.card, (card_mono h).trans_eq (card_replicate _ _), eq_replicate_card.2 $ + λ b hb, eq_of_mem_replicate $ subset_of_le h hb⟩, + λ ⟨k, hkn, hm⟩, hm.symm ▸ (replicate_le_replicate _).2 hkn⟩ + +lemma lt_replicate_succ {m : multiset α} {x : α} {n : ℕ} : + m < replicate (n + 1) x ↔ m ≤ replicate n x := begin - rw eq_repeat, + rw lt_iff_cons_le, split, - { rw [card_nsmul, card_repeat] }, - { exact λ b hb, eq_of_mem_repeat (mem_of_mem_nsmul hb) }, + { rintros ⟨x', hx'⟩, + have := eq_of_mem_replicate (mem_of_le hx' (mem_cons_self _ _)), + rwa [this, replicate_succ, cons_le_cons_iff] at hx' }, + { intro h, + rw replicate_succ, + exact ⟨x, cons_le_cons _ h⟩ } end /-! ### Erasing one copy of an element -/ @@ -669,6 +730,8 @@ theorem erase_cons_tail {a b : α} (s : multiset α) (h : b ≠ a) : (b ::ₘ s).erase a = b ::ₘ s.erase a := quot.induction_on s $ λ l, congr_arg coe $ erase_cons_tail l h +@[simp] theorem erase_singleton (a : α) : ({a} : multiset α).erase a = 0 := erase_cons_head a 0 + @[simp, priority 980] theorem erase_of_not_mem {a : α} {s : multiset α} : a ∉ s → s.erase a = s := quot.induction_on s $ λ l h, congr_arg coe $ erase_of_not_mem h @@ -681,6 +744,14 @@ theorem le_cons_erase (s : multiset α) (a : α) : s ≤ a ::ₘ s.erase a := if h : a ∈ s then le_of_eq (cons_erase h).symm else by rw erase_of_not_mem h; apply le_cons_self +lemma add_singleton_eq_iff {s t : multiset α} {a : α} : + s + {a} = t ↔ a ∈ t ∧ s = t.erase a := +begin + rw [add_comm, singleton_add], split, + { rintro rfl, exact ⟨s.mem_cons_self a, (s.erase_cons_head a).symm⟩ }, + { rintro ⟨h, rfl⟩, exact cons_erase h }, +end + theorem erase_add_left_pos {a : α} {s : multiset α} (t) : a ∈ s → (s + t).erase a = s.erase a + t := quotient.induction_on₂ s t $ λ l₁ l₂ h, congr_arg coe $ erase_append_left l₂ h @@ -789,18 +860,18 @@ by { ext, simp } @[simp] theorem map_singleton (f : α → β) (a : α) : ({a} : multiset α).map f = {f a} := rfl -theorem map_repeat (f : α → β) (a : α) (k : ℕ) : (repeat a k).map f = repeat (f a) k := by -{ induction k, simp, simpa } +@[simp] theorem map_replicate (f : α → β) (a : α) (k : ℕ) : + (replicate k a).map f = replicate k (f a) := +by simp only [← coe_replicate, coe_map, map_replicate] @[simp] theorem map_add (f : α → β) (s t) : map f (s + t) = map f s + map f t := quotient.induction_on₂ s t $ λ l₁ l₂, congr_arg coe $ map_append _ _ _ /-- If each element of `s : multiset α` can be lifted to `β`, then `s` can be lifted to `multiset β`. -/ -instance [can_lift α β] : can_lift (multiset α) (multiset β) := -{ cond := λ s, ∀ x ∈ s, can_lift.cond β x, - coe := map can_lift.coe, - prf := by { rintro ⟨l⟩ hl, lift l to list β using hl, exact ⟨l, coe_map _ _⟩ } } +instance can_lift (c) (p) [can_lift α β c p] : + can_lift (multiset α) (multiset β) (map c) (λ s, ∀ x ∈ s, p x) := +{ prf := by { rintro ⟨l⟩ hl, lift l to list β using hl, exact ⟨l, coe_map _ _⟩ } } /-- `multiset.map` as an `add_monoid_hom`. -/ def map_add_monoid_hom (f : α → β) : multiset α →+ multiset β := @@ -840,6 +911,22 @@ begin simp } end +lemma map_eq_cons [decidable_eq α] (f : α → β) (s : multiset α) (t : multiset β) (b : β) : + (∃ a ∈ s, f a = b ∧ (s.erase a).map f = t) ↔ s.map f = b ::ₘ t := +begin + split, + { rintro ⟨a, ha, rfl, rfl⟩, + rw [←map_cons, multiset.cons_erase ha] }, + { intro h, + have : b ∈ s.map f, + { rw h, exact mem_cons_self _ _ }, + obtain ⟨a, h1, rfl⟩ := mem_map.mp this, + obtain ⟨u, rfl⟩ := exists_cons_of_mem h1, + rw [map_cons, cons_inj_right] at h, + refine ⟨a, mem_cons_self _ _, rfl, _⟩, + rw [multiset.erase_cons_head, h] } +end + theorem mem_map_of_injective {f : α → β} (H : function.injective f) {a : α} {s : multiset α} : f a ∈ map f s ↔ a ∈ s := quot.induction_on s $ λ l, mem_map_of_injective H @@ -853,12 +940,16 @@ quot.induction_on s $ λ l, congr_arg coe $ map_id _ @[simp] lemma map_id' (s : multiset α) : map (λx, x) s = s := map_id s -@[simp] theorem map_const (s : multiset α) (b : β) : map (function.const α b) s = repeat b s.card := +@[simp] theorem map_const (s : multiset α) (b : β) : + map (function.const α b) s = replicate s.card b := quot.induction_on s $ λ l, congr_arg coe $ map_const _ _ +-- Not a `simp` lemma because `function.const` is reducibel in Lean 3 +theorem map_const' (s : multiset α) (b : β) : map (λ _, b) s = replicate s.card b := map_const s b + theorem eq_of_mem_map_const {b₁ b₂ : β} {l : list α} (h : b₁ ∈ map (function.const α b₂) l) : b₁ = b₂ := -eq_of_mem_repeat $ by rwa map_const at h +eq_of_mem_replicate $ by rwa map_const at h @[simp] theorem map_le_map {f : α → β} {s t : multiset α} (h : s ≤ t) : map f s ≤ map f t := le_induction_on h $ λ l₁ l₂ h, (h.map f).subperm @@ -887,6 +978,17 @@ begin { rw [s.erase_cons_tail hxy, map_cons, map_cons, (s.map f).erase_cons_tail (hf.ne hxy), ih] } end +lemma map_surjective_of_surjective {f : α → β} (hf : function.surjective f) : + function.surjective (map f) := +begin + intro s, + induction s using multiset.induction_on with x s ih, + { exact ⟨0, map_zero _⟩ }, + { obtain ⟨y, rfl⟩ := hf x, + obtain ⟨t, rfl⟩ := ih, + exact ⟨y ::ₘ t, map_cons _ _ _⟩ } +end + /-! ### `multiset.fold` -/ /-- `foldl f H b s` is the lift of the list operation `foldl f b l`, @@ -1017,20 +1119,28 @@ theorem pmap_eq_map (p : α → Prop) (f : α → β) (s : multiset α) : quot.induction_on s $ λ l H, congr_arg coe $ pmap_eq_map p f l H theorem pmap_congr {p q : α → Prop} {f : Π a, p a → β} {g : Π a, q a → β} - (s : multiset α) {H₁ H₂} (h : ∀ a h₁ h₂, f a h₁ = g a h₂) : - pmap f s H₁ = pmap g s H₂ := -quot.induction_on s (λ l H₁ H₂, congr_arg coe $ pmap_congr l h) H₁ H₂ + (s : multiset α) {H₁ H₂} : + (∀ (a ∈ s) h₁ h₂, f a h₁ = g a h₂) → pmap f s H₁ = pmap g s H₂ := +quot.induction_on s (λ l H₁ H₂ h, congr_arg coe $ pmap_congr l h) H₁ H₂ theorem map_pmap {p : α → Prop} (g : β → γ) (f : Π a, p a → β) (s) : ∀ H, map g (pmap f s H) = pmap (λ a h, g (f a h)) s H := quot.induction_on s $ λ l H, congr_arg coe $ map_pmap g f l H theorem pmap_eq_map_attach {p : α → Prop} (f : Π a, p a → β) - (s) : ∀ H, pmap f s H = s.attach.map (λ x, f x.1 (H _ x.2)) := + (s) : ∀ H, pmap f s H = s.attach.map (λ x, f x (H _ x.prop)) := quot.induction_on s $ λ l H, congr_arg coe $ pmap_eq_map_attach f l H -theorem attach_map_val (s : multiset α) : s.attach.map subtype.val = s := -quot.induction_on s $ λ l, congr_arg coe $ attach_map_val l +@[simp] lemma attach_map_coe' (s : multiset α) (f : α → β) : s.attach.map (λ i, f i) = s.map f := +quot.induction_on s $ λ l, congr_arg coe $ attach_map_coe' l f + +lemma attach_map_val' (s : multiset α) (f : α → β) : s.attach.map (λ i, f i.val) = s.map f := +attach_map_coe' _ _ + +@[simp] lemma attach_map_coe (s : multiset α) : s.attach.map (coe : _ → α) = s := +(attach_map_coe' _ _).trans s.map_id + +lemma attach_map_val (s : multiset α) : s.attach.map subtype.val = s := attach_map_coe _ @[simp] theorem mem_attach (s : multiset α) : ∀ x, x ∈ s.attach := quot.induction_on s $ λ l, mem_attach _ @@ -1050,36 +1160,36 @@ quot.induction_on s (λ l H, length_pmap) H lemma attach_cons (a : α) (m : multiset α) : (a ::ₘ m).attach = ⟨a, mem_cons_self a m⟩ ::ₘ (m.attach.map $ λp, ⟨p.1, mem_cons_of_mem p.2⟩) := quotient.induction_on m $ assume l, congr_arg coe $ congr_arg (list.cons _) $ - by rw [list.map_pmap]; exact list.pmap_congr _ (assume a' h₁ h₂, subtype.eq rfl) + by rw [list.map_pmap]; exact list.pmap_congr _ (λ _ _ _ _, subtype.eq rfl) section decidable_pi_exists variables {m : multiset α} /-- If `p` is a decidable predicate, so is the predicate that all elements of a multiset satisfy `p`. -/ -protected def decidable_forall_multiset {p : α → Prop} [hp : ∀a, decidable (p a)] : - decidable (∀a∈m, p a) := -quotient.rec_on_subsingleton m (λl, decidable_of_iff (∀a∈l, p a) $ by simp) +protected def decidable_forall_multiset {p : α → Prop} [hp : ∀ a, decidable (p a)] : + decidable (∀ a ∈ m, p a) := +quotient.rec_on_subsingleton m (λl, decidable_of_iff (∀a ∈ l, p a) $ by simp) -instance decidable_dforall_multiset {p : Πa∈m, Prop} [hp : ∀a (h : a ∈ m), decidable (p a h)] : - decidable (∀a (h : a ∈ m), p a h) := +instance decidable_dforall_multiset {p : Π a ∈ m, Prop} [hp : ∀ a (h : a ∈ m), decidable (p a h)] : + decidable (∀ a (h : a ∈ m), p a h) := decidable_of_decidable_of_iff (@multiset.decidable_forall_multiset {a // a ∈ m} m.attach (λa, p a.1 a.2) _) (iff.intro (assume h a ha, h ⟨a, ha⟩ (mem_attach _ _)) (assume h ⟨a, ha⟩ _, h _ _)) /-- decidable equality for functions whose domain is bounded by multisets -/ -instance decidable_eq_pi_multiset {β : α → Type*} [h : ∀a, decidable_eq (β a)] : - decidable_eq (Πa∈m, β a) := -assume f g, decidable_of_iff (∀a (h : a ∈ m), f a h = g a h) (by simp [function.funext_iff]) +instance decidable_eq_pi_multiset {β : α → Type*} [h : ∀ a, decidable_eq (β a)] : + decidable_eq (Π a ∈ m, β a) := +assume f g, decidable_of_iff (∀ a (h : a ∈ m), f a h = g a h) (by simp [function.funext_iff]) /-- If `p` is a decidable predicate, so is the existence of an element in a multiset satisfying `p`. -/ -def decidable_exists_multiset {p : α → Prop} [decidable_pred p] : +protected def decidable_exists_multiset {p : α → Prop} [decidable_pred p] : decidable (∃ x ∈ m, p x) := -quotient.rec_on_subsingleton m list.decidable_exists_mem +quotient.rec_on_subsingleton m (λl, decidable_of_iff (∃ a ∈ l, p a) $ by simp) -instance decidable_dexists_multiset {p : Πa∈m, Prop} [hp : ∀a (h : a ∈ m), decidable (p a h)] : - decidable (∃a (h : a ∈ m), p a h) := +instance decidable_dexists_multiset {p : Π a ∈ m, Prop} [hp : ∀ a (h : a ∈ m), decidable (p a h)] : + decidable (∃ a (h : a ∈ m), p a h) := decidable_of_decidable_of_iff (@multiset.decidable_exists_multiset {a // a ∈ m} m.attach (λa, p a.1 a.2) _) (iff.intro (λ ⟨⟨a, ha₁⟩, _, ha₂⟩, ⟨a, ha₁, ha₂⟩) @@ -1119,6 +1229,10 @@ multiset.induction_on t (by simp [multiset.sub_zero]) instance : has_ordered_sub (multiset α) := ⟨λ n m k, multiset.sub_le_iff_le_add⟩ +lemma cons_sub_of_le (a : α) {s t : multiset α} (h : t ≤ s) : + a ::ₘ s - t = a ::ₘ (s - t) := +by rw [←singleton_add, ←singleton_add, add_tsub_assoc_of_le h] + theorem sub_eq_fold_erase (s t : multiset α) : s - t = foldl erase erase_comm s t := quotient.induction_on₂ s t $ λ l₁ l₂, show ↑(l₁.diff l₂) = foldl erase erase_comm ↑l₁ ↑l₂, @@ -1355,7 +1469,7 @@ mem_filter.2 ⟨m, h⟩ theorem filter_eq_self {s} : filter p s = s ↔ ∀ a ∈ s, p a := quot.induction_on s $ λ l, iff.trans ⟨λ h, - eq_of_sublist_of_length_eq (filter_sublist _) (@congr_arg _ _ _ _ card h), + (filter_sublist _).eq_of_length (@congr_arg _ _ _ _ card h), congr_arg coe⟩ filter_eq_self theorem filter_eq_nil {s} : filter p s = 0 ↔ ∀ a ∈ s, ¬p a := @@ -1375,6 +1489,10 @@ begin { rw [filter_cons_of_neg _ h, zero_add] }, end +lemma filter_singleton {a : α} (p : α → Prop) [decidable_pred p] : + filter p {a} = if p a then {a} else ∅ := +by simp only [singleton, filter_cons, filter_zero, add_zero, empty_eq_zero] + lemma filter_nsmul (s : multiset α) (n : ℕ) : filter p (n • s) = n • filter p s := begin @@ -1425,6 +1543,10 @@ le_antisymm (le_inter filter p (filter q s) = filter (λ a, p a ∧ q a) s := quot.induction_on s $ λ l, congr_arg coe $ filter_filter p q l +lemma filter_comm (q) [decidable_pred q] (s : multiset α) : + filter p (filter q s) = filter q (filter p s) := +by simp [and_comm] + theorem filter_add_filter (q) [decidable_pred q] (s : multiset α) : filter p s + filter q s = filter (λ a, p a ∨ q a) s + filter (λ a, p a ∧ q a) s := multiset.induction_on s rfl $ λ a s IH, @@ -1438,6 +1560,11 @@ theorem map_filter (f : β → α) (s : multiset β) : filter p (map f s) = map f (filter (p ∘ f) s) := quot.induction_on s (λ l, by simp [map_filter]) +lemma map_filter' {f : α → β} (hf : injective f) (s : multiset α) + [decidable_pred (λ b, ∃ a, p a ∧ f a = b)] : + (s.filter p).map f = (s.map f).filter (λ b, ∃ a, p a ∧ f a = b) := +by simp [(∘), map_filter, hf.eq_iff] + /-! ### Simultaneously filter and map elements of a multiset -/ /-- `filter_map f s` is a combination filter/map operation on `s`. @@ -1528,17 +1655,23 @@ quot.induction_on s $ countp_cons_of_neg p variable (p) theorem countp_cons (b : α) (s) : countp p (b ::ₘ s) = countp p s + (if p b then 1 else 0) := -begin - split_ifs with h; - simp only [h, multiset.countp_cons_of_pos, add_zero, multiset.countp_cons_of_neg, not_false_iff], -end +quot.induction_on s $ by simp [list.countp_cons] theorem countp_eq_card_filter (s) : countp p s = card (filter p s) := -quot.induction_on s $ λ l, countp_eq_length_filter _ _ +quot.induction_on s $ λ l, l.countp_eq_length_filter p + +theorem countp_le_card (s) : countp p s ≤ card s := +quot.induction_on s $ λ l, countp_le_length p @[simp] theorem countp_add (s t) : countp p (s + t) = countp p s + countp p t := by simp [countp_eq_card_filter] +@[simp] theorem countp_nsmul (s) (n : ℕ) : countp p (n • s) = n * countp p s := +by induction n; simp [*, succ_nsmul', succ_mul, zero_nsmul] + +theorem card_eq_countp_add_countp (s) : card s = countp p s + countp (λ x, ¬ p x) s := +quot.induction_on s $ λ l, by simp [l.length_eq_countp_add_countp p] + /-- `countp p`, the number of elements of a multiset satisfying `p`, promoted to an `add_monoid_hom`. -/ def countp_add_monoid_hom : multiset α →+ ℕ := @@ -1560,6 +1693,17 @@ by simpa [countp_eq_card_filter] using card_le_of_le (filter_le_filter p h) countp p (filter q s) = countp (λ a, p a ∧ q a) s := by simp [countp_eq_card_filter] +theorem countp_eq_countp_filter_add + (s) (p q : α → Prop) [decidable_pred p] [decidable_pred q] : + countp p s = (filter q s).countp p + (filter (λ a, ¬ q a) s).countp p := +quot.induction_on s $ λ l, l.countp_eq_countp_filter_add _ _ + +@[simp] lemma countp_true {s : multiset α} : countp (λ _, true) s = card s := +quot.induction_on s $ λ l, list.countp_true + +@[simp] lemma countp_false {s : multiset α} : countp (λ _, false) s = 0 := +quot.induction_on s $ λ l, list.countp_false + theorem countp_map (f : α → β) (s : multiset α) (p : β → Prop) [decidable_pred p] : countp p (map f s) = (s.filter (λ a, p (f a))).card := begin @@ -1569,20 +1713,46 @@ begin card_singleton, add_comm] }, end +@[simp] lemma countp_attach (s : multiset α) : s.attach.countp (λ a, p ↑a) = s.countp p := +quotient.induction_on s $ λ l, begin + simp only [quot_mk_to_coe, coe_countp], + rw [quot_mk_to_coe, coe_attach, coe_countp], + exact list.countp_attach _ _, +end + +@[simp] lemma filter_attach (m : multiset α) (p : α → Prop) [decidable_pred p] : + (m.attach.filter (λ x, p ↑x)) = + (m.filter p).attach.map (subtype.map id $ λ _, multiset.mem_of_mem_filter) := +quotient.induction_on m $ λ l, congr_arg coe (list.filter_attach l p) + variable {p} theorem countp_pos {s} : 0 < countp p s ↔ ∃ a ∈ s, p a := -by simp [countp_eq_card_filter, card_pos_iff_exists_mem] +quot.induction_on s $ λ l, list.countp_pos p + +theorem countp_eq_zero {s} : countp p s = 0 ↔ ∀ a ∈ s, ¬ p a := +quot.induction_on s $ λ l, list.countp_eq_zero p + +theorem countp_eq_card {s} : countp p s = card s ↔ ∀ a ∈ s, p a := +quot.induction_on s $ λ l, list.countp_eq_length p theorem countp_pos_of_mem {s a} (h : a ∈ s) (pa : p a) : 0 < countp p s := countp_pos.2 ⟨_, h, pa⟩ +theorem countp_congr {s s' : multiset α} (hs : s = s') + {p p' : α → Prop} [decidable_pred p] [decidable_pred p'] + (hp : ∀ x ∈ s, p x ↔ p' x) : s.countp p = s'.countp p' := +quot.induction_on₂ s s' (λ l l' hs hp, begin + simp only [quot_mk_to_coe'', coe_eq_coe] at hs, + exact hs.countp_congr hp, +end) hs hp + end /-! ### Multiplicity of an element -/ section -variable [decidable_eq α] +variables [decidable_eq α] {s : multiset α} /-- `count a s` is the multiplicity of `a` in `s`. -/ def count (a : α) : multiset α → ℕ := countp (eq a) @@ -1598,6 +1768,9 @@ countp_cons_of_pos _ rfl theorem count_cons_of_ne {a b : α} (h : a ≠ b) (s : multiset α) : count a (b ::ₘ s) = count a s := countp_cons_of_neg _ h +theorem count_le_card (a : α) (s) : count a s ≤ card s := +countp_le_card _ _ + theorem count_le_of_le (a : α) {s t} : s ≤ t → count a s ≤ count a t := countp_le_of_le _ @@ -1606,13 +1779,13 @@ count_le_of_le _ (le_cons_self _ _) theorem count_cons (a b : α) (s : multiset α) : count a (b ::ₘ s) = count a s + (if a = b then 1 else 0) := -by by_cases h : a = b; simp [h] +countp_cons _ _ _ -@[simp] theorem count_singleton_self (a : α) : count a ({a} : multiset α) = 1 := -by simp only [count_cons_self, singleton_eq_cons, eq_self_iff_true, count_zero] +theorem count_singleton_self (a : α) : count a ({a} : multiset α) = 1 := +count_eq_one_of_mem (nodup_singleton a) $ mem_singleton_self a theorem count_singleton (a b : α) : count a ({b} : multiset α) = if a = b then 1 else 0 := -by simp only [count_cons, singleton_eq_cons, count_zero, zero_add] +by simp only [count_cons, ←cons_zero, count_zero, zero_add] @[simp] theorem count_add (a : α) : ∀ s t, count a (s + t) = count a s + count a t := countp_add _ @@ -1626,6 +1799,9 @@ def count_add_monoid_hom (a : α) : multiset α →+ ℕ := countp_add_monoid_ho @[simp] theorem count_nsmul (a : α) (n s) : count a (n • s) = n * count a s := by induction n; simp [*, succ_nsmul', succ_mul, zero_nsmul] +@[simp] lemma count_attach (a : {x // x ∈ s}) : s.attach.count a = s.count a := +eq.trans (countp_congr rfl $ λ _ _, subtype.ext_iff) $ countp_attach _ _ + theorem count_pos {a : α} {s : multiset α} : 0 < count a s ↔ a ∈ s := by simp [count, countp_pos] @@ -1642,34 +1818,23 @@ iff_not_comm.1 $ count_pos.symm.trans pos_iff_ne_zero theorem count_ne_zero {a : α} {s : multiset α} : count a s ≠ 0 ↔ a ∈ s := by simp [ne.def, count_eq_zero] -@[simp] theorem count_repeat_self (a : α) (n : ℕ) : count a (repeat a n) = n := -by simp [repeat] +theorem count_eq_card {a : α} {s} : count a s = card s ↔ ∀ (x ∈ s), a = x := +countp_eq_card -theorem count_repeat (a b : α) (n : ℕ) : - count a (repeat b n) = if (a = b) then n else 0 := -begin - split_ifs with h₁, - { rw [h₁, count_repeat_self] }, - { rw [count_eq_zero], - apply mt eq_of_mem_repeat h₁ }, -end +@[simp] theorem count_replicate_self (a : α) (n : ℕ) : count a (replicate n a) = n := +count_replicate_self _ _ + +theorem count_replicate (a b : α) (n : ℕ) : + count a (replicate n b) = if (a = b) then n else 0 := +count_replicate _ _ _ @[simp] theorem count_erase_self (a : α) (s : multiset α) : count a (erase s a) = pred (count a s) := -begin - by_cases a ∈ s, - { rw [(by rw cons_erase h : count a s = count a (a ::ₘ erase s a)), - count_cons_self]; refl }, - { rw [erase_of_not_mem h, count_eq_zero.2 h]; refl } -end +quotient.induction_on s $ count_erase_self a @[simp, priority 980] theorem count_erase_of_ne {a b : α} (ab : a ≠ b) (s : multiset α) : count a (erase s b) = count a s := -begin - by_cases b ∈ s, - { rw [← count_cons_of_ne ab, cons_erase h] }, - { rw [erase_of_not_mem h] } -end +quotient.induction_on s $ count_erase_of_ne ab @[simp] theorem count_sub (a : α) (s t : multiset α) : count a (s - t) = count a s - count a t := begin @@ -1691,8 +1856,9 @@ begin rw [← count_add, sub_add_inter, count_sub, tsub_add_min], end -theorem le_count_iff_repeat_le {a : α} {s : multiset α} {n : ℕ} : n ≤ count a s ↔ repeat a n ≤ s := -quot.induction_on s $ λ l, le_count_iff_repeat_sublist.trans repeat_le_coe.symm +theorem le_count_iff_replicate_le {a : α} {s : multiset α} {n : ℕ} : + n ≤ count a s ↔ replicate n a ≤ s := +quot.induction_on s $ λ l, le_count_iff_replicate_sublist.trans replicate_le_coe.symm @[simp] theorem count_filter_of_pos {p} [decidable_pred p] {a} {s : multiset α} (h : p a) : count a (filter p s) = count a s := @@ -1731,16 +1897,6 @@ instance : distrib_lattice (multiset α) := multiset.count_inter, multiset.sup_eq_union, multiset.count_union, multiset.inf_eq_inter], ..multiset.lattice } -theorem repeat_inf (s : multiset α) (a : α) (n : ℕ) : - (repeat a n) ⊓ s = repeat a (min (s.count a) n) := -begin - ext x, - rw [inf_eq_inter, count_inter, count_repeat, count_repeat], - by_cases x = a, - simp only [min_comm, h, if_true, eq_self_iff_true], - simp only [h, if_false, zero_min], -end - theorem count_map {α β : Type*} (f : α → β) (s : multiset α) [decidable_eq β] (b : β) : count b (map f s) = (s.filter (λ a, b = f a)).card := countp_map _ _ _ @@ -1753,8 +1909,8 @@ begin suffices : (filter (λ (a : α), f x = f a) s).count x = card (filter (λ (a : α), f x = f a) s), { rw [count, countp_map, ← this], exact count_filter_of_pos rfl }, - { rw eq_repeat.2 ⟨rfl, λ b hb, eq_comm.1 ((hf H (mem_filter.1 hb).left) (mem_filter.1 hb).right)⟩, - simp only [count_repeat, eq_self_iff_true, if_true, card_repeat]}, + { rw [eq_replicate_card.2 (λ b hb, ((hf H (mem_filter.1 hb).left) (mem_filter.1 hb).2).symm), + count_replicate_self, card_replicate] } end /-- `multiset.map f` preserves `count` if `f` is injective -/ @@ -1769,32 +1925,35 @@ begin contradiction } end -lemma filter_eq' (s : multiset α) (b : α) : s.filter (= b) = repeat b (count b s) := -begin - ext a, - rw [count_repeat, count_filter], - exact if_ctx_congr iff.rfl (λ h, congr_arg _ h) (λ h, rfl), -end +lemma filter_eq' (s : multiset α) (b : α) : s.filter (= b) = replicate (count b s) b := +quotient.induction_on s $ λ l, congr_arg coe $ filter_eq' l b -lemma filter_eq (s : multiset α) (b : α) : s.filter (eq b) = repeat b (count b s) := +lemma filter_eq (s : multiset α) (b : α) : s.filter (eq b) = replicate (count b s) b := by simp_rw [←filter_eq', eq_comm] -@[simp] lemma repeat_inter (x : α) (n : ℕ) (s : multiset α) : - repeat x n ∩ s = repeat x (min n (s.count x)) := +@[simp] lemma replicate_inter (n : ℕ) (x : α) (s : multiset α) : + replicate n x ∩ s = replicate (min n (s.count x)) x := begin - refine le_antisymm _ _, - { simp only [le_iff_count, count_inter, count_repeat], - intro a, - split_ifs with h, - { rw h }, - { rw [nat.zero_min] } }, - simp only [le_inter_iff, ← le_count_iff_repeat_le, count_inter, count_repeat_self], + ext y, + rw [count_inter, count_replicate, count_replicate], + by_cases y = x, + { simp only [h, if_pos rfl] }, + { simp only [h, if_false, zero_min] } end -@[simp] lemma inter_repeat (s : multiset α) (x : α) (n : ℕ) : - s ∩ repeat x n = repeat x (min (s.count x) n) := -by rw [inter_comm, repeat_inter, min_comm] +@[simp] lemma inter_replicate (s : multiset α) (x : α) (n : ℕ) : + s ∩ replicate n x = replicate (min (s.count x) n) x := +by rw [inter_comm, replicate_inter, min_comm] + +end +@[ext] +lemma add_hom_ext [add_zero_class β] ⦃f g : multiset α →+ β⦄ (h : ∀ x, f {x} = g {x}) : f = g := +begin + ext s, + induction s using multiset.induction_on with a s ih, + { simp only [_root_.map_zero] }, + { simp only [←singleton_add, _root_.map_add, ih, h] } end section embedding @@ -1985,18 +2144,40 @@ begin { simpa using hc } } end -lemma rel_repeat_left {m : multiset α} {a : α} {r : α → α → Prop} {n : ℕ} : - (repeat a n).rel r m ↔ m.card = n ∧ ∀ x, x ∈ m → r a x := -⟨λ h, ⟨(card_eq_card_of_rel h).symm.trans (card_repeat _ _), λ x hx, begin +lemma rel_replicate_left {m : multiset α} {a : α} {r : α → α → Prop} {n : ℕ} : + (replicate n a).rel r m ↔ m.card = n ∧ ∀ x, x ∈ m → r a x := +⟨λ h, ⟨(card_eq_card_of_rel h).symm.trans (card_replicate _ _), λ x hx, begin obtain ⟨b, hb1, hb2⟩ := exists_mem_of_rel_of_mem (rel_flip.2 h) hx, - rwa eq_of_mem_repeat hb1 at hb2, + rwa eq_of_mem_replicate hb1 at hb2, end⟩, - λ h, rel_of_forall (λ x y hx hy, (eq_of_mem_repeat hx).symm ▸ (h.2 _ hy)) - (eq.trans (card_repeat _ _) h.1.symm)⟩ + λ h, rel_of_forall (λ x y hx hy, (eq_of_mem_replicate hx).symm ▸ (h.2 _ hy)) + (eq.trans (card_replicate _ _) h.1.symm)⟩ + +lemma rel_replicate_right {m : multiset α} {a : α} {r : α → α → Prop} {n : ℕ} : + m.rel r (replicate n a) ↔ m.card = n ∧ ∀ x, x ∈ m → r x a := +rel_flip.trans rel_replicate_left + +lemma rel.trans (r : α → α → Prop) [is_trans α r] {s t u : multiset α} + (r1 : rel r s t) (r2 : rel r t u) : + rel r s u := +begin + induction t using multiset.induction_on with x t ih generalizing s u, + { rw [rel_zero_right.mp r1, rel_zero_left.mp r2, rel_zero_left] }, + { obtain ⟨a, as, ha1, ha2, rfl⟩ := rel_cons_right.mp r1, + obtain ⟨b, bs, hb1, hb2, rfl⟩ := rel_cons_left.mp r2, + exact multiset.rel.cons (trans ha1 hb1) (ih ha2 hb2) } +end -lemma rel_repeat_right {m : multiset α} {a : α} {r : α → α → Prop} {n : ℕ} : - m.rel r (repeat a n) ↔ m.card = n ∧ ∀ x, x ∈ m → r x a := -by { rw [← rel_flip], exact rel_repeat_left } +lemma rel.countp_eq (r : α → α → Prop) [is_trans α r] [is_symm α r] {s t : multiset α} (x : α) + [decidable_pred (r x)] (h : rel r s t) : + countp (r x) s = countp (r x) t := +begin + induction s using multiset.induction_on with y s ih generalizing t, + { rw rel_zero_left.mp h, }, + { obtain ⟨b, bs, hb1, hb2, rfl⟩ := rel_cons_left.mp h, + rw [countp_cons, countp_cons, ih hb2], + exact congr_arg _ (if_congr ⟨λ h, trans h hb1, λ h, trans h (symm hb1)⟩ rfl rfl) }, +end end rel @@ -2010,6 +2191,19 @@ theorem map_injective {f : α → β} (hf : function.injective f) : function.injective (multiset.map f) := assume x y, (map_eq_map hf).1 +lemma filter_attach' (s : multiset α) (p : {a // a ∈ s} → Prop) [decidable_eq α] + [decidable_pred p] : + s.attach.filter p = + (s.filter $ λ x, ∃ h, p ⟨x, h⟩).attach.map (subtype.map id $ λ x hx, + let ⟨h, _⟩ := of_mem_filter hx in h) := +begin + classical, + refine multiset.map_injective subtype.coe_injective _, + simp only [function.comp, map_filter' _ subtype.coe_injective, subtype.exists, coe_mk, + exists_and_distrib_right, exists_eq_right, attach_map_coe, map_map, map_coe, id.def], + rw attach_map_coe, +end + end map section quot @@ -2115,12 +2309,26 @@ list. -/ def pairwise (r : α → α → Prop) (m : multiset α) : Prop := ∃l:list α, m = l ∧ l.pairwise r +@[simp] lemma pairwise_zero (r : α → α → Prop) : + multiset.pairwise r 0 := ⟨[], rfl, list.pairwise.nil⟩ + +lemma pairwise_coe_iff {r : α → α → Prop} {l : list α} : + multiset.pairwise r l ↔ ∃ l' : list α, l ~ l' ∧ l'.pairwise r := +exists_congr $ by simp + lemma pairwise_coe_iff_pairwise {r : α → α → Prop} (hr : symmetric r) {l : list α} : multiset.pairwise r l ↔ l.pairwise r := iff.intro (assume ⟨l', eq, h⟩, ((quotient.exact eq).pairwise_iff hr).2 h) (assume h, ⟨l, rfl, h⟩) +lemma map_set_pairwise {f : α → β} {r : β → β → Prop} {m : multiset α} + (h : {a | a ∈ m}.pairwise $ λ a₁ a₂, r (f a₁) (f a₂)) : {b | b ∈ m.map f}.pairwise r := +λ b₁ h₁ b₂ h₂ hn, begin + obtain ⟨⟨a₁, H₁, rfl⟩, a₂, H₂, rfl⟩ := ⟨multiset.mem_map.1 h₁, multiset.mem_map.1 h₂⟩, + exact h H₁ H₂ (mt (congr_arg f) hn), +end + end multiset namespace multiset diff --git a/src/data/multiset/bind.lean b/src/data/multiset/bind.lean index d791df03ce116..57946c5c01ecb 100644 --- a/src/data/multiset/bind.lean +++ b/src/data/multiset/bind.lean @@ -3,11 +3,14 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import algebra.big_operators.multiset +import algebra.big_operators.multiset.basic /-! # Bind operation for multisets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a few basic operations on `multiset`, notably the monadic bind. ## Main declarations @@ -131,6 +134,19 @@ multiset.induction_on m (by simp) ( by simp) lemma count_bind [decidable_eq α] {m : multiset β} {f : β → multiset α} {a : α} : count a (bind m f) = sum (m.map $ λ b, count a $ f b) := count_sum +lemma le_bind {α β : Type*} {f : α → multiset β} (S : multiset α) {x : α} (hx : x ∈ S) : + f x ≤ S.bind f := +begin + classical, + rw le_iff_count, intro a, + rw count_bind, apply le_sum_of_mem, + rw mem_map, exact ⟨x, hx, rfl⟩ +end + +@[simp] theorem attach_bind_coe (s : multiset α) (f : α → multiset β) : + s.attach.bind (λ i, f i) = s.bind f := +congr_arg join $ attach_map_coe' _ _ + end bind /-! ### Product of two multisets -/ @@ -138,36 +154,35 @@ end bind section product variables (a : α) (b : β) (s : multiset α) (t : multiset β) -/-- The multiplicity of `(a, b)` in `s.product t` is +/-- The multiplicity of `(a, b)` in `s ×ˢ t` is the product of the multiplicity of `a` in `s` and `b` in `t`. -/ def product (s : multiset α) (t : multiset β) : multiset (α × β) := s.bind $ λ a, t.map $ prod.mk a +/- This notation binds more strongly than (pre)images, unions and intersections. -/ +infixr (name := multiset.product) ` ×ˢ `:82 := multiset.product + @[simp] lemma coe_product (l₁ : list α) (l₂ : list β) : @product α β l₁ l₂ = l₁.product l₂ := by { rw [product, list.product, ←coe_bind], simp } @[simp] lemma zero_product : @product α β 0 t = 0 := rfl ---TODO: Add `product_zero` - -@[simp] lemma cons_product : (a ::ₘ s).product t = map (prod.mk a) t + s.product t := -by simp [product] +@[simp] lemma cons_product : (a ::ₘ s) ×ˢ t = map (prod.mk a) t + s ×ˢ t := by simp [product] +@[simp] lemma product_zero : s ×ˢ (0 : multiset β) = 0 := by simp [product] +@[simp] lemma product_cons : s ×ˢ (b ::ₘ t) = s.map (λ a, (a, b)) + s ×ˢ t := by simp [product] -@[simp] lemma product_singleton : ({a} : multiset α).product ({b} : multiset β) = {(a, b)} := +@[simp] lemma product_singleton : ({a} : multiset α) ×ˢ ({b} : multiset β) = {(a, b)} := by simp only [product, bind_singleton, map_singleton] -@[simp] lemma add_product (s t : multiset α) (u : multiset β) : - (s + t).product u = s.product u + product t u := +@[simp] lemma add_product (s t : multiset α) (u : multiset β) : (s + t) ×ˢ u = s ×ˢ u + t ×ˢ u := by simp [product] -@[simp] lemma product_add (s : multiset α) : ∀ t u : multiset β, - s.product (t + u) = s.product t + s.product u := +@[simp] lemma product_add (s : multiset α) : ∀ t u : multiset β, s ×ˢ (t + u) = s ×ˢ t + s ×ˢ u := multiset.induction_on s (λ t u, rfl) $ λ a s IH t u, by rw [cons_product, IH]; simp; cc @[simp] lemma mem_product {s t} : ∀ {p : α × β}, p ∈ @product α β s t ↔ p.1 ∈ s ∧ p.2 ∈ t | (a, b) := by simp [product, and.left_comm] -@[simp] lemma card_product : (s.product t).card = s.card * t.card := -by simp [product, repeat, (∘), mul_comm] +@[simp] lemma card_product : (s ×ˢ t).card = s.card * t.card := by simp [product] end product diff --git a/src/data/multiset/dedup.lean b/src/data/multiset/dedup.lean index 961582de44493..d08a5ab927d5b 100644 --- a/src/data/multiset/dedup.lean +++ b/src/data/multiset/dedup.lean @@ -7,6 +7,9 @@ import data.multiset.nodup /-! # Erasing duplicates in a multiset. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -58,9 +61,19 @@ theorem dedup_eq_self {s : multiset α} : dedup s = s ↔ nodup s := ⟨λ e, e ▸ nodup_dedup s, quot.induction_on s $ λ l h, congr_arg coe h.dedup⟩ -alias dedup_eq_self ↔ _ multiset.nodup.dedup +alias dedup_eq_self ↔ _ nodup.dedup + +lemma count_dedup (m : multiset α) (a : α) : + m.dedup.count a = if a ∈ m then 1 else 0 := +quot.induction_on m $ λ l, count_dedup _ _ -alias dedup_eq_self ↔ _ multiset.nodup.dedup +@[simp] lemma dedup_idempotent {m : multiset α} : + m.dedup.dedup = m.dedup := +quot.induction_on m $ λ l, @congr_arg _ _ _ _ coe dedup_idempotent + +@[simp] lemma dedup_bind_dedup [decidable_eq β] (m : multiset α) (f : α → multiset β) : + (m.dedup.bind f).dedup = (m.bind f).dedup := +by { ext x, simp_rw [count_dedup, mem_bind, mem_dedup], } theorem dedup_eq_zero {s : multiset α} : dedup s = 0 ↔ s = 0 := ⟨λ h, eq_zero_of_subset_zero $ h ▸ subset_dedup _, @@ -73,6 +86,9 @@ theorem le_dedup {s t : multiset α} : s ≤ dedup t ↔ s ≤ t ∧ nodup s := ⟨λ h, ⟨le_trans h (dedup_le _), nodup_of_le h (nodup_dedup _)⟩, λ ⟨l, d⟩, (le_iff_subset d).2 $ subset.trans (subset_of_le l) (subset_dedup _)⟩ +theorem le_dedup_self {s : multiset α} : s ≤ dedup s ↔ nodup s := +by rw [le_dedup, and_iff_right le_rfl] + theorem dedup_ext {s t : multiset α} : dedup s = dedup t ↔ ∀ a, a ∈ s ↔ a ∈ t := by simp [nodup.ext] diff --git a/src/data/multiset/default.lean b/src/data/multiset/default.lean deleted file mode 100644 index e73adf88fc396..0000000000000 --- a/src/data/multiset/default.lean +++ /dev/null @@ -1,14 +0,0 @@ -import data.multiset.antidiagonal -import data.multiset.basic -import data.multiset.dedup -import data.multiset.finset_ops -import data.multiset.fold -import data.multiset.functor -import data.multiset.lattice -import data.multiset.locally_finite -import data.multiset.nat_antidiagonal -import data.multiset.nodup -import data.multiset.pi -import data.multiset.powerset -import data.multiset.sections -import data.multiset.sort diff --git a/src/data/multiset/finset_ops.lean b/src/data/multiset/finset_ops.lean index e8e5a03ff8a3d..1935e66db4a65 100644 --- a/src/data/multiset/finset_ops.lean +++ b/src/data/multiset/finset_ops.lean @@ -8,6 +8,9 @@ import data.multiset.dedup /-! # Preparations for defining operations on `finset`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The operations here ignore multiplicities, and preparatory for defining the corresponding operations on `finset`. -/ @@ -207,3 +210,7 @@ theorem ndinter_eq_zero_iff_disjoint {s t : multiset α} : ndinter s t = 0 ↔ d by rw ← subset_zero; simp [subset_iff, disjoint] end multiset + +-- Assert that we define `finset` without the material on the set lattice. +-- Note that we cannot put this in `data.finset.basic` because we proved relevant lemmas there. +assert_not_exists set.sInter diff --git a/src/data/multiset/fintype.lean b/src/data/multiset/fintype.lean new file mode 100644 index 0000000000000..01ef958860e01 --- /dev/null +++ b/src/data/multiset/fintype.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2022 Kyle Miller. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller +-/ +import algebra.big_operators.basic +import data.fintype.card +import data.prod.lex + +/-! +# Multiset coercion to type + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This module defines a `has_coe_to_sort` instance for multisets and gives it a `fintype` instance. +It also defines `multiset.to_enum_finset`, which is another way to enumerate the elements of +a multiset. These coercions and definitions make it easier to sum over multisets using existing +`finset` theory. + +## Main definitions + +* A coercion from `m : multiset α` to a `Type*`. For `x : m`, then there is a coercion `↑x : α`, + and `x.2` is a term of `fin (m.count x)`. The second component is what ensures each term appears + with the correct multiplicity. Note that this coercion requires `decidable_eq α` due to + `multiset.count`. +* `multiset.to_enum_finset` is a `finset` version of this. +* `multiset.coe_embedding` is the embedding `m ↪ α × ℕ`, whose first component is the coercion + and whose second component enumerates elements with multiplicity. +* `multiset.coe_equiv` is the equivalence `m ≃ m.to_enum_finset`. + +## Tags + +multiset enumeration +-/ + +open_locale big_operators + +variables {α : Type*} [decidable_eq α] {m : multiset α} + +/-- Auxiliary definition for the `has_coe_to_sort` instance. This prevents the `has_coe m α` +instance from inadverently applying to other sigma types. One should not use this definition +directly. -/ +@[nolint has_nonempty_instance] +def multiset.to_type (m : multiset α) : Type* := Σ (x : α), fin (m.count x) + +/-- Create a type that has the same number of elements as the multiset. +Terms of this type are triples `⟨x, ⟨i, h⟩⟩` where `x : α`, `i : ℕ`, and `h : i < m.count x`. +This way repeated elements of a multiset appear multiple times with different values of `i`. -/ +instance : has_coe_to_sort (multiset α) Type* := ⟨multiset.to_type⟩ + +@[simp] lemma multiset.coe_sort_eq : m.to_type = m := rfl + +/-- Constructor for terms of the coercion of `m` to a type. +This helps Lean pick up the correct instances. -/ +@[reducible, pattern] def multiset.mk_to_type (m : multiset α) (x : α) (i : fin (m.count x)) : m := +⟨x, i⟩ + +/-- As a convenience, there is a coercion from `m : Type*` to `α` by projecting onto the first +component. -/ +instance multiset.has_coe_to_sort.has_coe : has_coe m α := ⟨λ x, x.1⟩ + +@[simp] lemma multiset.fst_coe_eq_coe {x : m} : x.1 = x := rfl + +@[simp] lemma multiset.coe_eq {x y : m} : (x : α) = (y : α) ↔ x.1 = y.1 := +by { cases x, cases y, refl } + +@[simp] lemma multiset.coe_mk {x : α} {i : fin (m.count x)} : ↑(m.mk_to_type x i) = x := rfl + +@[simp] lemma multiset.coe_mem {x : m} : ↑x ∈ m := multiset.count_pos.mp (pos_of_gt x.2.2) + +@[simp] protected lemma multiset.forall_coe (p : m → Prop) : + (∀ (x : m), p x) ↔ ∀ (x : α) (i : fin (m.count x)), p ⟨x, i⟩ := sigma.forall + +@[simp] protected lemma multiset.exists_coe (p : m → Prop) : + (∃ (x : m), p x) ↔ ∃ (x : α) (i : fin (m.count x)), p ⟨x, i⟩ := sigma.exists + +instance : fintype {p : α × ℕ | p.2 < m.count p.1} := +fintype.of_finset +(m.to_finset.bUnion (λ x, (finset.range (m.count x)).map ⟨prod.mk x, prod.mk.inj_left x⟩)) +begin + rintro ⟨x, i⟩, + simp only [finset.mem_bUnion, multiset.mem_to_finset, finset.mem_map, finset.mem_range, + function.embedding.coe_fn_mk, prod.mk.inj_iff, exists_prop, exists_eq_right_right, + set.mem_set_of_eq, and_iff_right_iff_imp], + exact λ h, multiset.count_pos.mp (pos_of_gt h), +end + +/-- Construct a finset whose elements enumerate the elements of the multiset `m`. +The `ℕ` component is used to differentiate between equal elements: if `x` appears `n` times +then `(x, 0)`, ..., and `(x, n-1)` appear in the `finset`. -/ +def multiset.to_enum_finset (m : multiset α) : finset (α × ℕ) := +{p : α × ℕ | p.2 < m.count p.1}.to_finset + +@[simp] lemma multiset.mem_to_enum_finset (m : multiset α) (p : α × ℕ) : + p ∈ m.to_enum_finset ↔ p.2 < m.count p.1 := +set.mem_to_finset + +lemma multiset.mem_of_mem_to_enum_finset {p : α × ℕ} (h : p ∈ m.to_enum_finset) : p.1 ∈ m := +multiset.count_pos.mp $ pos_of_gt $ (m.mem_to_enum_finset p).mp h + +@[mono] +lemma multiset.to_enum_finset_mono {m₁ m₂ : multiset α} + (h : m₁ ≤ m₂) : m₁.to_enum_finset ⊆ m₂.to_enum_finset := +begin + intro p, + simp only [multiset.mem_to_enum_finset], + exact gt_of_ge_of_gt (multiset.le_iff_count.mp h p.1), +end + +@[simp] lemma multiset.to_enum_finset_subset_iff {m₁ m₂ : multiset α} : + m₁.to_enum_finset ⊆ m₂.to_enum_finset ↔ m₁ ≤ m₂ := +begin + refine ⟨λ h, _, multiset.to_enum_finset_mono⟩, + rw multiset.le_iff_count, + intro x, + by_cases hx : x ∈ m₁, + { apply nat.le_of_pred_lt, + have : (x, m₁.count x - 1) ∈ m₁.to_enum_finset, + { rw multiset.mem_to_enum_finset, + exact nat.pred_lt (ne_of_gt (multiset.count_pos.mpr hx)), }, + simpa only [multiset.mem_to_enum_finset] using h this, }, + { simp [hx] }, +end + +/-- The embedding from a multiset into `α × ℕ` where the second coordinate enumerates repeats. + +If you are looking for the function `m → α`, that would be plain `coe`. -/ +@[simps] +def multiset.coe_embedding (m : multiset α) : + m ↪ α × ℕ := +{ to_fun := λ x, (x, x.2), + inj' := begin + rintro ⟨x, i, hi⟩ ⟨y, j, hj⟩, + simp only [prod.mk.inj_iff, sigma.mk.inj_iff, and_imp, multiset.coe_eq, fin.coe_mk], + rintro rfl rfl, + exact ⟨rfl, heq.rfl⟩ + end } + +/-- Another way to coerce a `multiset` to a type is to go through `m.to_enum_finset` and coerce +that `finset` to a type. -/ +@[simps] +def multiset.coe_equiv (m : multiset α) : + m ≃ m.to_enum_finset := +{ to_fun := λ x, ⟨m.coe_embedding x, by { rw multiset.mem_to_enum_finset, exact x.2.2 }⟩, + inv_fun := λ x, ⟨x.1.1, x.1.2, by { rw ← multiset.mem_to_enum_finset, exact x.2 }⟩, + left_inv := by { rintro ⟨x, i, h⟩, refl }, + right_inv := by {rintro ⟨⟨x, i⟩, h⟩, refl } } + +@[simp] lemma multiset.to_embedding_coe_equiv_trans (m : multiset α) : + m.coe_equiv.to_embedding.trans (function.embedding.subtype _) = m.coe_embedding := +by ext; simp + +instance multiset.fintype_coe : fintype m := +fintype.of_equiv m.to_enum_finset m.coe_equiv.symm + +lemma multiset.map_univ_coe_embedding (m : multiset α) : + (finset.univ : finset m).map m.coe_embedding = m.to_enum_finset := +by { ext ⟨x, i⟩, simp only [fin.exists_iff, finset.mem_map, finset.mem_univ, + multiset.coe_embedding_apply, prod.mk.inj_iff, exists_true_left, multiset.exists_coe, + multiset.coe_mk, fin.coe_mk, exists_prop, exists_eq_right_right, exists_eq_right, + multiset.mem_to_enum_finset, iff_self, true_and] } + +lemma multiset.to_enum_finset_filter_eq (m : multiset α) (x : α) : + m.to_enum_finset.filter (λ p, x = p.1) = + (finset.range (m.count x)).map ⟨prod.mk x, prod.mk.inj_left x⟩ := +begin + ext ⟨y, i⟩, + simp only [eq_comm, finset.mem_filter, multiset.mem_to_enum_finset, finset.mem_map, + finset.mem_range, function.embedding.coe_fn_mk, prod.mk.inj_iff, exists_prop, + exists_eq_right_right', and.congr_left_iff], + rintro rfl, + refl, +end + +@[simp] lemma multiset.map_to_enum_finset_fst (m : multiset α) : + m.to_enum_finset.val.map prod.fst = m := +begin + ext x, + simp only [multiset.count_map, ← finset.filter_val, multiset.to_enum_finset_filter_eq, + finset.map_val, finset.range_val, multiset.card_map, multiset.card_range], +end + +@[simp] lemma multiset.image_to_enum_finset_fst (m : multiset α) : + m.to_enum_finset.image prod.fst = m.to_finset := +by rw [finset.image, multiset.map_to_enum_finset_fst] + +@[simp] lemma multiset.map_univ_coe (m : multiset α) : + (finset.univ : finset m).val.map coe = m := +begin + have := m.map_to_enum_finset_fst, + rw ← m.map_univ_coe_embedding at this, + simpa only [finset.map_val, multiset.coe_embedding_apply, multiset.map_map, function.comp_app] + using this, +end + +@[simp] lemma multiset.map_univ {β : Type*} (m : multiset α) (f : α → β) : + (finset.univ : finset m).val.map (λ x, f x) = m.map f := +by rw [← multiset.map_map, multiset.map_univ_coe] + +@[simp] lemma multiset.card_to_enum_finset (m : multiset α) : m.to_enum_finset.card = m.card := +begin + change multiset.card _ = _, + convert_to (m.to_enum_finset.val.map prod.fst).card = _, + { rw multiset.card_map }, + { rw m.map_to_enum_finset_fst } +end + +@[simp] lemma multiset.card_coe (m : multiset α) : fintype.card m = m.card := +by { rw fintype.card_congr m.coe_equiv, simp } + +@[to_additive] +lemma multiset.prod_eq_prod_coe [comm_monoid α] (m : multiset α) : m.prod = ∏ (x : m), x := +by { congr, simp } + +@[to_additive] +lemma multiset.prod_eq_prod_to_enum_finset [comm_monoid α] (m : multiset α) : + m.prod = ∏ x in m.to_enum_finset, x.1 := +by { congr, simp } + +@[to_additive] +lemma multiset.prod_to_enum_finset {β : Type*} [comm_monoid β] (m : multiset α) (f : α → ℕ → β) : + ∏ x in m.to_enum_finset, f x.1 x.2 = ∏ (x : m), f x x.2 := +begin + rw fintype.prod_equiv m.coe_equiv (λ x, f x x.2) (λ x, f x.1.1 x.1.2), + { rw ← m.to_enum_finset.prod_coe_sort (λ x, f x.1 x.2), + simp, }, + { simp } +end diff --git a/src/data/multiset/fold.lean b/src/data/multiset/fold.lean index 33a0279a5e87c..fe0fcbbc3e600 100644 --- a/src/data/multiset/fold.lean +++ b/src/data/multiset/fold.lean @@ -8,6 +8,9 @@ import data.list.min_max /-! # The fold operation for a commutative associative operation over a multiset. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -16,7 +19,7 @@ variables {α β : Type*} /-! ### fold -/ section fold variables (op : α → α → α) [hc : is_commutative α op] [ha : is_associative α op] -local notation a * b := op a b +local notation (name := op) a ` * ` b := op a b include hc ha /-- `fold op b s` folds a commutative associative operation `op` over @@ -55,6 +58,14 @@ multiset.induction_on s₂ (by rw [add_zero, fold_zero, ← fold_cons'_right, ← fold_cons_right op]) (by simp {contextual := tt}; cc) +theorem fold_bind {ι : Type*} (s : multiset ι) (t : ι → multiset α) (b : ι → α) (b₀ : α) : + (s.bind t).fold op ((s.map b).fold op b₀) = (s.map (λ i, (t i).fold op (b i))).fold op b₀ := +begin + induction s using multiset.induction_on with a ha ih, + { rw [zero_bind, map_zero, map_zero, fold_zero] }, + { rw [cons_bind, map_cons, map_cons, fold_cons_left, fold_cons_left, fold_add, ih] }, +end + theorem fold_singleton (b a : α) : ({a} : multiset α).fold op b = a * b := foldr_singleton _ _ _ _ theorem fold_distrib {f g : β → α} (u₁ u₂ : α) (s : multiset β) : diff --git a/src/data/multiset/functor.lean b/src/data/multiset/functor.lean index 835d378df932c..eac8ae74d286b 100644 --- a/src/data/multiset/functor.lean +++ b/src/data/multiset/functor.lean @@ -9,6 +9,9 @@ import control.traversable.instances /-! # Functoriality of `multiset`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ universes u diff --git a/src/data/multiset/interval.lean b/src/data/multiset/interval.lean new file mode 100644 index 0000000000000..8e36ee02b2efb --- /dev/null +++ b/src/data/multiset/interval.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import data.finset.locally_finite +import data.dfinsupp.interval +import data.dfinsupp.multiset +import data.nat.interval + +/-! +# Finite intervals of multisets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides the `locally_finite_order` instance for `multiset α` and calculates the +cardinality of its finite intervals. + +## Implementation notes + +We implement the intervals via the intervals on `dfinsupp`, rather than via filtering +`multiset.powerset`; this is because `(multiset.replicate n x).powerset` has `2^n` entries not `n+1` +entries as it contains duplicates. We do not go via `finsupp` as this would be noncomputable, and +multisets are typically used computationally. + +-/ + +open finset dfinsupp function +open_locale big_operators pointwise + +variables {α : Type*} + +namespace multiset +variables [decidable_eq α] (s t : multiset α) + +instance : locally_finite_order (multiset α) := +locally_finite_order.of_Icc (multiset α) + (λ s t, (finset.Icc s.to_dfinsupp t.to_dfinsupp).map + (multiset.equiv_dfinsupp.to_equiv.symm.to_embedding)) + (λ s t x, by simp) + +lemma Icc_eq : + finset.Icc s t = + (finset.Icc s.to_dfinsupp t.to_dfinsupp).map + (multiset.equiv_dfinsupp.to_equiv.symm.to_embedding) := rfl + +lemma uIcc_eq : + uIcc s t = + (uIcc s.to_dfinsupp t.to_dfinsupp).map + (multiset.equiv_dfinsupp.to_equiv.symm.to_embedding) := +(Icc_eq _ _).trans $ by simp [uIcc] + +lemma card_Icc : + (finset.Icc s t).card = ∏ i in s.to_finset ∪ t.to_finset, (t.count i + 1 - s.count i) := +by simp_rw [Icc_eq, finset.card_map, dfinsupp.card_Icc, nat.card_Icc, multiset.to_dfinsupp_apply, + to_dfinsupp_support] + +lemma card_Ico : + (finset.Ico s t).card = ∏ i in s.to_finset ∪ t.to_finset, (t.count i + 1 - s.count i) - 1 := +by rw [card_Ico_eq_card_Icc_sub_one, card_Icc] + +lemma card_Ioc : + (finset.Ioc s t).card = ∏ i in s.to_finset ∪ t.to_finset, (t.count i + 1 - s.count i) - 1 := +by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc] + +lemma card_Ioo : + (finset.Ioo s t).card = ∏ i in s.to_finset ∪ t.to_finset, (t.count i + 1 - s.count i) - 2 := +by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc] + +lemma card_uIcc : + (uIcc s t).card = ∏ i in s.to_finset ∪ t.to_finset, ((t.count i - s.count i : ℤ).nat_abs + 1) := +by simp_rw [uIcc_eq, finset.card_map, dfinsupp.card_uIcc, nat.card_uIcc, multiset.to_dfinsupp_apply, + to_dfinsupp_support] + +lemma card_Iic : + (finset.Iic s).card = ∏ i in s.to_finset, (s.count i + 1) := +by simp_rw [Iic_eq_Icc, card_Icc, bot_eq_zero, to_finset_zero, empty_union, count_zero, tsub_zero] + +end multiset diff --git a/src/data/multiset/lattice.lean b/src/data/multiset/lattice.lean index 6522818600dee..5e575d279b753 100644 --- a/src/data/multiset/lattice.lean +++ b/src/data/multiset/lattice.lean @@ -8,6 +8,9 @@ import data.multiset.fold /-! # Lattice operations on multisets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -21,6 +24,8 @@ variables [semilattice_sup α] [order_bot α] /-- Supremum of a multiset: `sup {a, b, c} = a ⊔ b ⊔ c` -/ def sup (s : multiset α) : α := s.fold (⊔) ⊥ +@[simp] lemma sup_coe (l : list α) : sup (l : multiset α) = l.foldr (⊔) ⊥ := rfl + @[simp] lemma sup_zero : (0 : multiset α).sup = ⊥ := fold_zero _ _ @@ -34,7 +39,7 @@ sup_bot_eq @[simp] lemma sup_add (s₁ s₂ : multiset α) : (s₁ + s₂).sup = s₁.sup ⊔ s₂.sup := eq.trans (by simp [sup]) (fold_add _ _ _ _ _) -lemma sup_le {s : multiset α} {a : α} : s.sup ≤ a ↔ (∀b ∈ s, b ≤ a) := +@[simp] lemma sup_le {s : multiset α} {a : α} : s.sup ≤ a ↔ (∀b ∈ s, b ≤ a) := multiset.induction_on s (by simp) (by simp [or_imp_distrib, forall_and_distrib] {contextual := tt}) @@ -80,6 +85,8 @@ variables [semilattice_inf α] [order_top α] /-- Infimum of a multiset: `inf {a, b, c} = a ⊓ b ⊓ c` -/ def inf (s : multiset α) : α := s.fold (⊓) ⊤ +@[simp] lemma inf_coe (l : list α) : inf (l : multiset α) = l.foldr (⊓) ⊤ := rfl + @[simp] lemma inf_zero : (0 : multiset α).inf = ⊤ := fold_zero _ _ diff --git a/src/data/multiset/locally_finite.lean b/src/data/multiset/locally_finite.lean index 26e077299a60e..78d3b6f2d0a1d 100644 --- a/src/data/multiset/locally_finite.lean +++ b/src/data/multiset/locally_finite.lean @@ -8,8 +8,13 @@ import data.finset.locally_finite /-! # Intervals as multisets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides basic results about all the `multiset.Ixx`, which are defined in `order.locally_finite`. + +Note that intervals of multisets themselves (`multiset.locally_finite_order`) are defined elsewhere. -/ variables {α : Type*} @@ -35,9 +40,9 @@ by rw [Ioc, finset.val_eq_zero, finset.Ioc_eq_empty_iff] @[simp] lemma Ioo_eq_zero_iff [densely_ordered α] : Ioo a b = 0 ↔ ¬a < b := by rw [Ioo, finset.val_eq_zero, finset.Ioo_eq_empty_iff] -alias Icc_eq_zero_iff ↔ _ multiset.Icc_eq_zero -alias Ico_eq_zero_iff ↔ _ multiset.Ico_eq_zero -alias Ioc_eq_zero_iff ↔ _ multiset.Ioc_eq_zero +alias Icc_eq_zero_iff ↔ _ Icc_eq_zero +alias Ico_eq_zero_iff ↔ _ Ico_eq_zero +alias Ioc_eq_zero_iff ↔ _ Ioc_eq_zero @[simp] lemma Ioo_eq_zero (h : ¬a < b) : Ioo a b = 0 := eq_zero_iff_forall_not_mem.2 $ λ x hx, h ((mem_Ioo.1 hx).1.trans (mem_Ioo.1 hx).2) diff --git a/src/data/multiset/nat_antidiagonal.lean b/src/data/multiset/nat_antidiagonal.lean index 40ca75f930169..9b41c72960a56 100644 --- a/src/data/multiset/nat_antidiagonal.lean +++ b/src/data/multiset/nat_antidiagonal.lean @@ -9,6 +9,9 @@ import data.list.nat_antidiagonal /-! # Antidiagonals in ℕ × ℕ as multisets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the antidiagonals of ℕ × ℕ as multisets: the `n`-th antidiagonal is the multiset of pairs `(i, j)` such that `i + j = n`. This is useful for polynomial multiplication and more generally for sums going from `0` to `n`. diff --git a/src/data/multiset/nodup.lean b/src/data/multiset/nodup.lean index b144be5a3ed90..40ed28dae0c47 100644 --- a/src/data/multiset/nodup.lean +++ b/src/data/multiset/nodup.lean @@ -3,12 +3,15 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import data.list.nodup import data.multiset.bind -import data.multiset.powerset import data.multiset.range /-! # The `nodup` predicate for multisets without duplicate elements. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -32,7 +35,7 @@ quot.induction_on s $ λ l, nodup_cons lemma nodup.cons (m : a ∉ s) (n : nodup s) : nodup (a ::ₘ s) := nodup_cons.2 ⟨m, n⟩ -theorem nodup_singleton : ∀ a : α, nodup ({a} : multiset α) := nodup_singleton +@[simp] theorem nodup_singleton : ∀ a : α, nodup ({a} : multiset α) := nodup_singleton lemma nodup.of_cons (h : nodup (a ::ₘ s)) : nodup s := (nodup_cons.1 h).2 @@ -45,7 +48,7 @@ theorem not_nodup_pair : ∀ a : α, ¬ nodup (a ::ₘ a ::ₘ 0) := not_nodup_p theorem nodup_iff_le {s : multiset α} : nodup s ↔ ∀ a : α, ¬ a ::ₘ a ::ₘ 0 ≤ s := quot.induction_on s $ λ l, nodup_iff_sublist.trans $ forall_congr $ λ a, -not_congr (@repeat_le_coe _ a 2 _).symm + (@replicate_le_coe _ a 2 _).symm.not lemma nodup_iff_ne_cons_cons {s : multiset α} : s.nodup ↔ ∀ a t, s ≠ a ::ₘ a ::ₘ t := nodup_iff_le.trans @@ -60,6 +63,14 @@ quot.induction_on s $ λ l, nodup_iff_count_le_one (d : nodup s) (h : a ∈ s) : count a s = 1 := le_antisymm (nodup_iff_count_le_one.1 d a) (count_pos.2 h) +lemma count_eq_of_nodup [decidable_eq α] {a : α} {s : multiset α} + (d : nodup s) : count a s = if a ∈ s then 1 else 0 := +begin + split_ifs with h, + { exact count_eq_one_of_mem d h }, + { exact count_eq_zero_of_not_mem h }, +end + lemma nodup_iff_pairwise {α} {s : multiset α} : nodup s ↔ pairwise (≠) s := quotient.induction_on s $ λ l, (pairwise_coe_iff_pairwise (by exact λ a b, ne.symm)).symm @@ -153,19 +164,6 @@ nodup_of_le $ inter_le_right _ _ λ ⟨h₁, h₂⟩, nodup_iff_count_le_one.2 $ λ a, by rw [count_union]; exact max_le (nodup_iff_count_le_one.1 h₁ a) (nodup_iff_count_le_one.1 h₂ a)⟩ -@[simp] theorem nodup_powerset {s : multiset α} : nodup (powerset s) ↔ nodup s := -⟨λ h, (nodup_of_le (map_single_le_powerset _) h).of_map _, - quotient.induction_on s $ λ l h, - by simp; refine (nodup_sublists'.2 h).map_on _ ; exact - λ x sx y sy e, - (h.sublist_ext (mem_sublists'.1 sx) (mem_sublists'.1 sy)).1 - (quotient.exact e)⟩ - -alias nodup_powerset ↔ multiset.nodup.of_powerset multiset.nodup.powerset - -protected lemma nodup.powerset_len {n : ℕ} (h : nodup s) : nodup (powerset_len n s) := -nodup_of_le (powerset_len_le_powerset _ _) (nodup_powerset.2 h) - @[simp] lemma nodup_bind {s : multiset α} {t : α → multiset β} : nodup (bind s t) ↔ ((∀a∈s, nodup (t a)) ∧ (s.pairwise (λa b, disjoint (t a) (t b)))) := have h₁ : ∀a, ∃l:list β, t a = l, from @@ -197,14 +195,14 @@ lemma map_eq_map_of_bij_of_nodup (f : α → γ) (g : β → γ) {s : multiset (i_inj : ∀a₁ a₂ ha₁ ha₂, i a₁ ha₁ = i a₂ ha₂ → a₁ = a₂) (i_surj : ∀b∈t, ∃a ha, b = i a ha) : s.map f = t.map g := -have t = s.attach.map (λ x, i x.1 x.2), +have t = s.attach.map (λ x, i x x.2), from (ht.ext $ (nodup_attach.2 hs).map $ - show injective (λ x : {x // x ∈ s}, i x.1 x.2), from λ x y hxy, - subtype.eq $ i_inj x.1 y.1 x.2 y.2 hxy).2 + show injective (λ x : {x // x ∈ s}, i x x.2), from λ x y hxy, + subtype.ext $ i_inj x y x.2 y.2 hxy).2 (λ x, by simp only [mem_map, true_and, subtype.exists, eq_comm, mem_attach]; exact ⟨i_surj _, λ ⟨y, hy⟩, hy.snd.symm ▸ hi _ _⟩), -calc s.map f = s.pmap (λ x _, f x) (λ _, id) : by rw [pmap_eq_map] -... = s.attach.map (λ x, f x.1) : by rw [pmap_eq_map_attach] +calc s.map f = s.pmap (λ x _, f x) (λ _, id) : by rw [pmap_eq_map] +... = s.attach.map (λ x, f x) : by rw [pmap_eq_map_attach] ... = t.map g : by rw [this, multiset.map_map]; exact map_congr rfl (λ x _, h _ _) end multiset diff --git a/src/data/multiset/pi.lean b/src/data/multiset/pi.lean index 13e166c86da7c..916174981c99f 100644 --- a/src/data/multiset/pi.lean +++ b/src/data/multiset/pi.lean @@ -7,6 +7,9 @@ import data.multiset.nodup /-! # The cartesian product of multisets + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -17,9 +20,9 @@ open function /-- Given `δ : α → Type*`, `pi.empty δ` is the trivial dependent function out of the empty multiset. -/ -def pi.empty (δ : α → Type*) : (Πa∈(0:multiset α), δ a) . +def pi.empty (δ : α → Sort*) : (Πa∈(0:multiset α), δ a) . -variables [decidable_eq α] {δ : α → Type*} +variables [decidable_eq α] {β : α → Type*} {δ : α → Sort*} /-- Given `δ : α → Type*`, a multiset `m` and a term `a`, as well as a term `b : δ a` and a function `f` such that `f a' : δ a'` for all `a'` in `m`, `pi.cons m a b f` is a function `g` such @@ -47,9 +50,28 @@ begin all_goals { simp [*, pi.cons_same, pi.cons_ne] }, end +@[simp] +lemma pi.cons_eta {m : multiset α} {a : α} (f : Π a' ∈ a ::ₘ m, δ a') : + pi.cons m a (f _ (mem_cons_self _ _)) (λ a' ha', f a' (mem_cons_of_mem ha')) = f := +begin + ext a' h', + by_cases a' = a, + { subst h, rw [pi.cons_same] }, + { rw [pi.cons_ne _ h] } +end + +lemma pi.cons_injective {a : α} {b : δ a} {s : multiset α} (hs : a ∉ s) : + function.injective (pi.cons s a b) := +assume f₁ f₂ eq, funext $ assume a', funext $ assume h', +have ne : a ≠ a', from assume h, hs $ h.symm ▸ h', +have a' ∈ a ::ₘ s, from mem_cons_of_mem h', +calc f₁ a' h' = pi.cons s a b f₁ a' this : by rw [pi.cons_ne this ne.symm] + ... = pi.cons s a b f₂ a' this : by rw [eq] + ... = f₂ a' h' : by rw [pi.cons_ne this ne.symm] + /-- `pi m t` constructs the Cartesian product over `t` indexed by `m`. -/ -def pi (m : multiset α) (t : Πa, multiset (δ a)) : multiset (Πa∈m, δ a) := -m.rec_on {pi.empty δ} (λa m (p : multiset (Πa∈m, δ a)), (t a).bind $ λb, p.map $ pi.cons m a b) +def pi (m : multiset α) (t : Πa, multiset (β a)) : multiset (Πa∈m, β a) := +m.rec_on {pi.empty β} (λa m (p : multiset (Πa∈m, β a)), (t a).bind $ λb, p.map $ pi.cons m a b) begin intros a a' m n, by_cases eq : a = a', @@ -64,26 +86,17 @@ begin exact pi.cons_swap eq } end -@[simp] lemma pi_zero (t : Πa, multiset (δ a)) : pi 0 t = {pi.empty δ} := rfl +@[simp] lemma pi_zero (t : Πa, multiset (β a)) : pi 0 t = {pi.empty β} := rfl -@[simp] lemma pi_cons (m : multiset α) (t : Πa, multiset (δ a)) (a : α) : +@[simp] lemma pi_cons (m : multiset α) (t : Πa, multiset (β a)) (a : α) : pi (a ::ₘ m) t = ((t a).bind $ λb, (pi m t).map $ pi.cons m a b) := rec_on_cons a m -lemma pi_cons_injective {a : α} {b : δ a} {s : multiset α} (hs : a ∉ s) : - function.injective (pi.cons s a b) := -assume f₁ f₂ eq, funext $ assume a', funext $ assume h', -have ne : a ≠ a', from assume h, hs $ h.symm ▸ h', -have a' ∈ a ::ₘ s, from mem_cons_of_mem h', -calc f₁ a' h' = pi.cons s a b f₁ a' this : by rw [pi.cons_ne this ne.symm] - ... = pi.cons s a b f₂ a' this : by rw [eq] - ... = f₂ a' h' : by rw [pi.cons_ne this ne.symm] - -lemma card_pi (m : multiset α) (t : Πa, multiset (δ a)) : +lemma card_pi (m : multiset α) (t : Πa, multiset (β a)) : card (pi m t) = prod (m.map $ λa, card (t a)) := multiset.induction_on m (by simp) (by simp [mul_comm] {contextual := tt}) -protected lemma nodup.pi {s : multiset α} {t : Π a, multiset (δ a)} : +protected lemma nodup.pi {s : multiset α} {t : Π a, multiset (β a)} : nodup s → (∀a∈s, nodup (t a)) → nodup (pi s t) := multiset.induction_on s (assume _ _, nodup_singleton _) begin @@ -91,7 +104,7 @@ begin have has : a ∉ s, by simp at hs; exact hs.1, have hs : nodup s, by simp at hs; exact hs.2, simp, - refine ⟨λ b hb, (ih hs $ λ a' h', ht a' $ mem_cons_of_mem h').map (pi_cons_injective has), _⟩, + refine ⟨λ b hb, (ih hs $ λ a' h', ht a' $ mem_cons_of_mem h').map (pi.cons_injective has), _⟩, refine (ht a $ mem_cons_self _ _).pairwise _, from assume b₁ hb₁ b₂ hb₂ neb, disjoint_map_map.2 (assume f hf g hg eq, have pi.cons s a b₁ f a (mem_cons_self _ _) = pi.cons s a b₂ g a (mem_cons_self _ _), @@ -99,22 +112,12 @@ begin neb $ show b₁ = b₂, by rwa [pi.cons_same, pi.cons_same] at this) end -@[simp] -lemma pi.cons_ext {m : multiset α} {a : α} (f : Π a' ∈ a ::ₘ m, δ a') : - pi.cons m a (f _ (mem_cons_self _ _)) (λ a' ha', f a' (mem_cons_of_mem ha')) = f := -begin - ext a' h', - by_cases a' = a, - { subst h, rw [pi.cons_same] }, - { rw [pi.cons_ne _ h] } -end - -lemma mem_pi (m : multiset α) (t : Πa, multiset (δ a)) : - ∀f:Πa∈m, δ a, (f ∈ pi m t) ↔ (∀a (h : a ∈ m), f a h ∈ t a) := +lemma mem_pi (m : multiset α) (t : Πa, multiset (β a)) : + ∀f:Πa∈m, β a, (f ∈ pi m t) ↔ (∀a (h : a ∈ m), f a h ∈ t a) := begin intro f, induction m using multiset.induction_on with a m ih, - { simpa using show f = pi.empty δ, by funext a ha; exact ha.elim }, + { simpa using show f = pi.empty β, by funext a ha; exact ha.elim }, simp_rw [pi_cons, mem_bind, mem_map, ih], split, { rintro ⟨b, hb, f', hf', rfl⟩ a' ha', @@ -123,7 +126,7 @@ begin { rw [pi.cons_ne _ h], apply hf' } }, { intro hf, refine ⟨_, hf a (mem_cons_self _ _), _, λ a ha, hf a (mem_cons_of_mem ha), _⟩, - rw pi.cons_ext } + rw pi.cons_eta } end end pi diff --git a/src/data/multiset/powerset.lean b/src/data/multiset/powerset.lean index f712941507367..57a11693a72e8 100644 --- a/src/data/multiset/powerset.lean +++ b/src/data/multiset/powerset.lean @@ -3,10 +3,14 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ -import data.multiset.basic +import data.list.sublists +import data.multiset.nodup /-! # The powerset of a multiset + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -253,4 +257,32 @@ begin { cases n; simp [ih, map_comp_cons], }, end +lemma pairwise_disjoint_powerset_len (s : multiset α) : + _root_.pairwise (λ i j, multiset.disjoint (s.powerset_len i) (s.powerset_len j)) := +λ i j h x hi hj, h (eq.trans (multiset.mem_powerset_len.mp hi).right.symm + (multiset.mem_powerset_len.mp hj).right) + +lemma bind_powerset_len {α : Type*} (S : multiset α) : + bind (multiset.range (S.card + 1)) (λ k, S.powerset_len k) = S.powerset := +begin + induction S using quotient.induction_on, + simp_rw [quot_mk_to_coe, powerset_coe', powerset_len_coe, ←coe_range, coe_bind, ←list.bind_map, + coe_card], + exact coe_eq_coe.mpr ((list.range_bind_sublists_len_perm S).map _), +end + +@[simp] theorem nodup_powerset {s : multiset α} : nodup (powerset s) ↔ nodup s := +⟨λ h, (nodup_of_le (map_single_le_powerset _) h).of_map _, + quotient.induction_on s $ λ l h, + by simp; refine (nodup_sublists'.2 h).map_on _ ; exact + λ x sx y sy e, + (h.sublist_ext (mem_sublists'.1 sx) (mem_sublists'.1 sy)).1 + (quotient.exact e)⟩ + +alias nodup_powerset ↔ nodup.of_powerset nodup.powerset + +protected lemma nodup.powerset_len {n : ℕ} {s : multiset α} (h : nodup s) : + nodup (powerset_len n s) := +nodup_of_le (powerset_len_le_powerset _ _) (nodup_powerset.2 h) + end multiset diff --git a/src/data/multiset/range.lean b/src/data/multiset/range.lean index a074ad5a805e0..b9959669106ca 100644 --- a/src/data/multiset/range.lean +++ b/src/data/multiset/range.lean @@ -6,7 +6,10 @@ Authors: Mario Carneiro import data.multiset.basic import data.list.range -/-! # `multiset.range n` gives `{0, 1, ..., n-1}` as a multiset. -/ +/-! # `multiset.range n` gives `{0, 1, ..., n-1}` as a multiset. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ open list nat @@ -18,6 +21,8 @@ namespace multiset that is, the set `{0, 1, ..., n-1}`. -/ def range (n : ℕ) : multiset ℕ := range n +theorem coe_range (n : ℕ) : ↑(list.range n) = range n := rfl + @[simp] theorem range_zero : range 0 = 0 := rfl @[simp] theorem range_succ (n : ℕ) : range (succ n) = n ::ₘ range n := diff --git a/src/data/multiset/sections.lean b/src/data/multiset/sections.lean index cad402b544edc..6f873a4ca2f40 100644 --- a/src/data/multiset/sections.lean +++ b/src/data/multiset/sections.lean @@ -7,6 +7,9 @@ import data.multiset.bind /-! # Sections of a multiset + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset diff --git a/src/data/multiset/sort.lean b/src/data/multiset/sort.lean index df8ecbe0d9e4b..d5a682e912ad3 100644 --- a/src/data/multiset/sort.lean +++ b/src/data/multiset/sort.lean @@ -5,10 +5,12 @@ Authors: Mario Carneiro -/ import data.list.sort import data.multiset.basic -import data.string.basic /-! # Construct a sorted list from a multiset. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace multiset @@ -50,7 +52,8 @@ list.merge_sort_singleton r a end sort -instance [has_repr α] : has_repr (multiset α) := -⟨λ s, "{" ++ string.intercalate ", " ((s.map repr).sort (≤)) ++ "}"⟩ +-- TODO: use a sort order if available, gh-18166 +meta instance [has_repr α] : has_repr (multiset α) := +⟨λ s, "{" ++ string.intercalate ", " (s.unquot.map repr) ++ "}"⟩ end multiset diff --git a/src/data/multiset/sum.lean b/src/data/multiset/sum.lean index d7c4224f96294..60d03036e5958 100644 --- a/src/data/multiset/sum.lean +++ b/src/data/multiset/sum.lean @@ -8,6 +8,9 @@ import data.multiset.nodup /-! # Disjoint sum of multisets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the disjoint sum of two multisets as `multiset (α ⊕ β)`. Beware not to confuse with the `multiset.sum` operation which computes the additive sum. diff --git a/src/data/mv_polynomial/basic.lean b/src/data/mv_polynomial/basic.lean index eff152a5f063b..8dac8e5c459bb 100644 --- a/src/data/mv_polynomial/basic.lean +++ b/src/data/mv_polynomial/basic.lean @@ -4,14 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro -/ -import ring_theory.adjoin.basic +import algebra.algebra.tower +import algebra.monoid_algebra.support import data.finsupp.antidiagonal -import algebra.monoid_algebra.basic import order.symm_diff +import ring_theory.adjoin.basic /-! # Multivariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines polynomial rings over a base ring (or even semiring), with variables from a general type `σ` (which could be infinite). @@ -28,39 +32,27 @@ corresponding to the terms in `σ`, and coefficients in `R`. In the definitions below, we use the following notation: + `σ : Type*` (indexing the variables) - + `R : Type*` `[comm_semiring R]` (the coefficients) - + `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set. -This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s` - + This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s` + `a : R` - + `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians - + `p : mv_polynomial σ R` ### Definitions * `mv_polynomial σ R` : the type of polynomials with variables of type `σ` and coefficients in the commutative semiring `R` - * `monomial s a` : the monomial which mathematically would be denoted `a * X^s` - * `C a` : the constant polynomial with value `a` - * `X i` : the degree one monomial corresponding to i; mathematically this might be denoted `Xᵢ`. - * `coeff s p` : the coefficient of `s` in `p`. - * `eval₂ (f : R → S₁) (g : σ → S₁) p` : given a semiring homomorphism from `R` to another semiring `S₁`, and a map `σ → S₁`, evaluates `p` at this valuation, returning a term of type `S₁`. Note that `eval₂` can be made using `eval` and `map` (see below), and it has been suggested that sticking to `eval` and `map` might make the code less brittle. - * `eval (g : σ → R) p` : given a map `σ → R`, evaluates `p` at this valuation, returning a term of type `R` - * `map (f : R → S₁) p` : returns the multivariate polynomial obtained from `p` by the change of coefficient semiring corresponding to `f` @@ -80,7 +72,7 @@ polynomial, multivariate polynomial, multivariable polynomial noncomputable theory -open_locale classical big_operators +open_locale big_operators open set function finsupp add_monoid_algebra open_locale big_operators @@ -101,37 +93,53 @@ section instances instance decidable_eq_mv_polynomial [comm_semiring R] [decidable_eq σ] [decidable_eq R] : decidable_eq (mv_polynomial σ R) := finsupp.decidable_eq + instance [comm_semiring R] : comm_semiring (mv_polynomial σ R) := add_monoid_algebra.comm_semiring + instance [comm_semiring R] : inhabited (mv_polynomial σ R) := ⟨0⟩ + instance [monoid R] [comm_semiring S₁] [distrib_mul_action R S₁] : distrib_mul_action R (mv_polynomial σ S₁) := add_monoid_algebra.distrib_mul_action -instance [monoid R] [comm_semiring S₁] [distrib_mul_action R S₁] [has_faithful_scalar R S₁] : - has_faithful_scalar R (mv_polynomial σ S₁) := -add_monoid_algebra.has_faithful_scalar + +instance [comm_semiring S₁] [smul_zero_class R S₁] : smul_zero_class R (mv_polynomial σ S₁) := +add_monoid_algebra.smul_zero_class + +instance [comm_semiring S₁] [smul_zero_class R S₁] [has_faithful_smul R S₁] : + has_faithful_smul R (mv_polynomial σ S₁) := +add_monoid_algebra.has_faithful_smul + instance [semiring R] [comm_semiring S₁] [module R S₁] : module R (mv_polynomial σ S₁) := add_monoid_algebra.module -instance [monoid R] [monoid S₁] [comm_semiring S₂] - [has_scalar R S₁] [distrib_mul_action R S₂] [distrib_mul_action S₁ S₂] [is_scalar_tower R S₁ S₂] : + +instance [comm_semiring S₂] + [has_smul R S₁] [smul_zero_class R S₂] [smul_zero_class S₁ S₂] [is_scalar_tower R S₁ S₂] : is_scalar_tower R S₁ (mv_polynomial σ S₂) := add_monoid_algebra.is_scalar_tower -instance [monoid R] [monoid S₁][comm_semiring S₂] - [distrib_mul_action R S₂] [distrib_mul_action S₁ S₂] [smul_comm_class R S₁ S₂] : + +instance [comm_semiring S₂] + [smul_zero_class R S₂] [smul_zero_class S₁ S₂] [smul_comm_class R S₁ S₂] : smul_comm_class R S₁ (mv_polynomial σ S₂) := add_monoid_algebra.smul_comm_class -instance [monoid R] [comm_semiring S₁] [distrib_mul_action R S₁] [distrib_mul_action Rᵐᵒᵖ S₁] + +instance [comm_semiring S₁] [smul_zero_class R S₁] [smul_zero_class Rᵐᵒᵖ S₁] [is_central_scalar R S₁] : is_central_scalar R (mv_polynomial σ S₁) := add_monoid_algebra.is_central_scalar + instance [comm_semiring R] [comm_semiring S₁] [algebra R S₁] : algebra R (mv_polynomial σ S₁) := add_monoid_algebra.algebra --- Register with high priority to avoid timeout in `data.mv_polynomial.pderiv` -instance is_scalar_tower' [comm_semiring R] [comm_semiring S₁] [algebra R S₁] : + +instance is_scalar_tower_right [comm_semiring S₁] [distrib_smul R S₁] [is_scalar_tower R S₁ S₁] : is_scalar_tower R (mv_polynomial σ S₁) (mv_polynomial σ S₁) := -is_scalar_tower.right --- TODO[gh-6025]: make this an instance once safe to do so +add_monoid_algebra.is_scalar_tower_self _ + +instance smul_comm_class_right [comm_semiring S₁] [distrib_smul R S₁] [smul_comm_class R S₁ S₁] : + smul_comm_class R (mv_polynomial σ S₁) (mv_polynomial σ S₁) := +add_monoid_algebra.smul_comm_class_self _ + /-- If `R` is a subsingleton, then `mv_polynomial σ R` has a unique element -/ -protected def unique [comm_semiring R] [subsingleton R] : unique (mv_polynomial σ R) := +instance unique [comm_semiring R] [subsingleton R] : unique (mv_polynomial σ R) := add_monoid_algebra.unique end instances @@ -156,6 +164,14 @@ variables {R σ} /-- `X n` is the degree `1` monomial $X_n$. -/ def X (n : σ) : mv_polynomial σ R := monomial (single n 1) 1 +lemma monomial_left_injective {r : R} (hr : r ≠ 0) : + function.injective (λ s : σ →₀ ℕ, monomial s r) := +finsupp.single_left_injective hr + +@[simp] lemma monomial_left_inj {s t : σ →₀ ℕ} {r : R} (hr : r ≠ 0) : + monomial s r = monomial t r ↔ s = t := +finsupp.single_left_inj hr + lemma C_apply : (C a : mv_polynomial σ R) = monomial 0 a := rfl @[simp] lemma C_0 : C 0 = (0 : mv_polynomial σ R) := by simp [C_apply, monomial] @@ -165,7 +181,7 @@ lemma C_apply : (C a : mv_polynomial σ R) = monomial 0 a := rfl lemma C_mul_monomial : C a * monomial s a' = monomial s (a * a') := by simp [C_apply, monomial, single_mul_single] -@[simp] lemma C_add : (C (a + a') : mv_polynomial σ R) = C a + C a' := single_add +@[simp] lemma C_add : (C (a + a') : mv_polynomial σ R) = C a + C a' := single_add _ _ _ @[simp] lemma C_mul : (C (a * a') : mv_polynomial σ R) = C a * C a' := C_mul_monomial.symm @@ -195,8 +211,7 @@ instance infinite_of_nonempty (σ : Type*) (R : Type*) [nonempty σ] [comm_semir [nontrivial R] : infinite (mv_polynomial σ R) := infinite.of_injective ((λ s : σ →₀ ℕ, monomial s 1) ∘ single (classical.arbitrary σ)) $ - function.injective.comp - (λ m n, (finsupp.single_left_inj one_ne_zero).mp) (finsupp.single_injective _) + (monomial_left_injective one_ne_zero).comp (finsupp.single_injective _) lemma C_eq_coe_nat (n : ℕ) : (C ↑n : mv_polynomial σ R) = n := by induction n; simp [nat.succ_eq_add_one, *] @@ -209,6 +224,15 @@ lemma smul_eq_C_mul (p : mv_polynomial σ R) (a : R) : a • p = C a * p := C_mu lemma C_eq_smul_one : (C a : mv_polynomial σ R) = a • 1 := by rw [← C_mul', mul_one] +lemma smul_monomial {S₁ : Type*} [smul_zero_class S₁ R] (r : S₁) : + r • monomial s a = monomial s (r • a) := finsupp.smul_single _ _ _ + +lemma X_injective [nontrivial R] : function.injective (X : σ → mv_polynomial σ R) := +(monomial_left_injective one_ne_zero).comp (finsupp.single_left_injective one_ne_zero) + +@[simp] lemma X_inj [nontrivial R] (m n : σ) : X m = (X n : mv_polynomial σ R) ↔ m = n := +X_injective.eq_iff + lemma monomial_pow : monomial s a ^ e = monomial (e • s) (a ^ e) := add_monoid_algebra.single_pow e @@ -227,8 +251,7 @@ variables {σ R} @[simp] lemma monomial_one_hom_apply : monomial_one_hom R σ s = (monomial s 1 : mv_polynomial σ R) := rfl -lemma X_pow_eq_monomial : X n ^ e = monomial (single n e) (1 : R) := -by simp [X, monomial_pow] +lemma X_pow_eq_monomial : X n ^ e = monomial (single n e) (1 : R) := by simp [X, monomial_pow] lemma monomial_add_single : monomial (s + single n e) a = (monomial s a * X n ^ e) := by rw [X_pow_eq_monomial, monomial_mul, mul_one] @@ -236,12 +259,13 @@ by rw [X_pow_eq_monomial, monomial_mul, mul_one] lemma monomial_single_add : monomial (single n e + s) a = (X n ^ e * monomial s a) := by rw [X_pow_eq_monomial, monomial_mul, one_mul] -lemma monomial_eq_C_mul_X {s : σ} {a : R} {n : ℕ} : - monomial (single s n) a = C a * (X s)^n := +lemma C_mul_X_pow_eq_monomial {s : σ} {a : R} {n : ℕ} : C a * X s ^ n = monomial (single s n) a := by rw [← zero_add (single s n), monomial_add_single, C_apply] -@[simp] lemma monomial_zero {s : σ →₀ ℕ} : monomial s (0 : R) = 0 := -single_zero +lemma C_mul_X_eq_monomial {s : σ} {a : R} : C a * X s = monomial (single s 1) a := +by rw [← C_mul_X_pow_eq_monomial, pow_one] + +@[simp] lemma monomial_zero {s : σ →₀ ℕ} : monomial s (0 : R) = 0 := single_zero _ @[simp] lemma monomial_zero' : (monomial (0 : σ →₀ ℕ) : R → mv_polynomial σ R) = C := rfl @@ -396,18 +420,22 @@ by convert rfl lemma support_monomial_subset : (monomial s a).support ⊆ {s} := support_single_subset -lemma support_add : (p + q).support ⊆ p.support ∪ q.support := finsupp.support_add +lemma support_add [decidable_eq σ] : (p + q).support ⊆ p.support ∪ q.support := finsupp.support_add lemma support_X [nontrivial R] : (X n : mv_polynomial σ R).support = {single n 1} := -by rw [X, support_monomial, if_neg]; exact one_ne_zero +by classical; rw [X, support_monomial, if_neg]; exact one_ne_zero lemma support_X_pow [nontrivial R] (s : σ) (n : ℕ) : (X s ^ n : mv_polynomial σ R).support = {finsupp.single s n} := -by rw [X_pow_eq_monomial, support_monomial, if_neg (@one_ne_zero R _ _)] +by classical; rw [X_pow_eq_monomial, support_monomial, if_neg (one_ne_zero' R)] @[simp] lemma support_zero : (0 : mv_polynomial σ R).support = ∅ := rfl -lemma support_sum {α : Type*} {s : finset α} {f : α → mv_polynomial σ R} : +lemma support_smul {S₁ : Type*} [smul_zero_class S₁ R] {a : S₁} {f : mv_polynomial σ R} : + (a • f).support ⊆ f.support := +finsupp.support_smul + +lemma support_sum {α : Type*} [decidable_eq σ] {s : finset α} {f : α → mv_polynomial σ R} : (∑ x in s, f x).support ⊆ s.bUnion (λ x, (f x).support) := finsupp.support_finset_sum end support @@ -430,7 +458,7 @@ lemma sum_def {A} [add_comm_monoid A] {p : mv_polynomial σ R} {b : (σ →₀ p.sum b = ∑ m in p.support, b m (p.coeff m) := by simp [support, finsupp.sum, coeff] -lemma support_mul (p q : mv_polynomial σ R) : +lemma support_mul [decidable_eq σ] (p q : mv_polynomial σ R) : (p * q).support ⊆ p.support.bUnion (λ a, q.support.bUnion $ λ b, {a + b}) := by convert add_monoid_algebra.support_mul p q; ext; convert iff.rfl @@ -444,7 +472,7 @@ lemma ext_iff (p q : mv_polynomial σ R) : @[simp] lemma coeff_add (m : σ →₀ ℕ) (p q : mv_polynomial σ R) : coeff m (p + q) = coeff m p + coeff m q := add_apply p q m -@[simp] lemma coeff_smul {S₁ : Type*} [monoid S₁] [distrib_mul_action S₁ R] +@[simp] lemma coeff_smul {S₁ : Type*} [smul_zero_class S₁ R] (m : σ →₀ ℕ) (c : S₁) (p : mv_polynomial σ R) : coeff m (c • p) = c • coeff m p := smul_apply c p m @@ -462,7 +490,7 @@ single_eq_of_ne (λ h, by cases single_eq_zero.1 h) lemma coeff_sum {X : Type*} (s : finset X) (f : X → mv_polynomial σ R) (m : σ →₀ ℕ) : coeff m (∑ x in s, f x) = ∑ x in s, coeff m (f x) := -(coeff_add_monoid_hom _).map_sum _ s +(@coeff_add_monoid_hom R σ _ _).map_sum _ s lemma monic_monomial_eq (m) : monomial m (1:R) = (m.prod $ λn e, X n ^ e : mv_polynomial σ R) := by simp [monomial_eq] @@ -500,11 +528,12 @@ by rw [← coeff_X_pow, pow_one] @[simp] lemma coeff_X (i : σ) : coeff (single i 1) (X i : mv_polynomial σ R) = 1 := -by rw [coeff_X', if_pos rfl] +by classical; rw [coeff_X', if_pos rfl] @[simp] lemma coeff_C_mul (m) (a : R) (p : mv_polynomial σ R) : coeff m (C a * p) = a * coeff m p := begin + classical, rw [mul_def, sum_C], { simp [sum_def, coeff_sum] {contextual := tt} }, simp @@ -538,6 +567,10 @@ add_monoid_algebra.support_mul_single p _ (by simp) _ (X s * p).support = p.support.map (add_left_embedding (single s 1)) := add_monoid_algebra.support_single_mul p _ (by simp) _ +@[simp] lemma support_smul_eq {S₁ : Type*} [semiring S₁] [module S₁ R] [no_zero_smul_divisors S₁ R] + {a : S₁} (h : a ≠ 0) (p : mv_polynomial σ R) : (a • p).support = p.support := +finsupp.support_smul_eq h + lemma support_sdiff_support_subset_support_add [decidable_eq σ] (p q : mv_polynomial σ R) : p.support \ q.support ⊆ (p + q).support := begin @@ -560,6 +593,7 @@ end lemma coeff_mul_monomial' (m) (s : σ →₀ ℕ) (r : R) (p : mv_polynomial σ R) : coeff m (p * monomial s r) = if s ≤ m then coeff (m - s) p * r else 0 := begin + classical, obtain rfl | hr := eq_or_ne r 0, { simp only [monomial_zero, coeff_zero, mul_zero, if_t_t], }, haveI : nontrivial R := nontrivial_of_ne _ _ hr, @@ -607,6 +641,9 @@ lemma ne_zero_iff {p : mv_polynomial σ R} : p ≠ 0 ↔ ∃ d, coeff d p ≠ 0 := by { rw [ne.def, eq_zero_iff], push_neg, } +@[simp] lemma support_eq_empty {p : mv_polynomial σ R} : p.support = ∅ ↔ p = 0 := +finsupp.support_eq_empty + lemma exists_coeff_ne_zero {p : mv_polynomial σ R} (h : p ≠ 0) : ∃ d, coeff d p ≠ 0 := ne_zero_iff.mp h @@ -646,15 +683,19 @@ def constant_coeff : mv_polynomial σ R →+* R := lemma constant_coeff_eq : (constant_coeff : mv_polynomial σ R → R) = coeff 0 := rfl -@[simp] -lemma constant_coeff_C (r : R) : - constant_coeff (C r : mv_polynomial σ R) = r := +variables (σ) +@[simp] lemma constant_coeff_C (r : R) : constant_coeff (C r : mv_polynomial σ R) = r := by simp [constant_coeff_eq] +variables {σ} -@[simp] -lemma constant_coeff_X (i : σ) : - constant_coeff (X i : mv_polynomial σ R) = 0 := +variables (R) +@[simp] lemma constant_coeff_X (i : σ) : constant_coeff (X i : mv_polynomial σ R) = 0 := by simp [constant_coeff_eq] +variables {R} + +@[simp] lemma constant_coeff_smul {R : Type*} [smul_zero_class R S₁] + (a : R) (f : mv_polynomial σ S₁) : + constant_coeff (a • f) = a • constant_coeff f := rfl lemma constant_coeff_monomial [decidable_eq σ] (d : σ →₀ ℕ) (r : R) : constant_coeff (monomial d r) = if d = 0 then r else 0 := @@ -664,7 +705,7 @@ variables (σ R) @[simp] lemma constant_coeff_comp_C : constant_coeff.comp (C : R →+* mv_polynomial σ R) = ring_hom.id R := -by { ext, apply constant_coeff_C } +by { ext x, exact constant_coeff_C σ x } @[simp] lemma constant_coeff_comp_algebra_map : constant_coeff.comp (algebra_map R (mv_polynomial σ R)) = ring_hom.id R := @@ -706,9 +747,12 @@ finsupp.sum_zero_index section @[simp] lemma eval₂_add : (p + q).eval₂ f g = p.eval₂ f g + q.eval₂ f g := -finsupp.sum_add_index - (by simp [f.map_zero]) - (by simp [add_mul, f.map_add]) +begin + classical, + exact finsupp.sum_add_index + (by simp [f.map_zero]) + (by simp [add_mul, f.map_add]) +end @[simp] lemma eval₂_monomial : (monomial s a).eval₂ f g = f a * s.prod (λn e, g n ^ e) := finsupp.sum_single_index (by simp [f.map_zero]) @@ -725,6 +769,7 @@ by simp [eval₂_monomial, f.map_one, X, prod_single_index, pow_one] lemma eval₂_mul_monomial : ∀{s a}, (p * monomial s a).eval₂ f g = p.eval₂ f g * f a * s.prod (λn e, g n ^ e) := begin + classical, apply mv_polynomial.induction_on p, { assume a' s a, simp [C_mul_monomial, eval₂_monomial, f.map_mul] }, @@ -879,6 +924,22 @@ begin congr' with a, simp end +@[simp] +theorem eval₂_id (p : mv_polynomial σ R) (g : σ → R) : eval₂ (ring_hom.id _) g p = eval g p := + rfl + +theorem eval_eval₂ {τ : Type*} (f : R →+* mv_polynomial τ S₁) (g : σ → mv_polynomial τ S₁) + (p : mv_polynomial σ R) (x : τ → S₁) : + eval x (eval₂ f g p) = eval₂ ((eval x).comp f) (λ s, eval x (g s)) p := +begin + apply induction_on p, + { simp, }, + { intros p q hp hq, + simp [hp, hq] }, + { intros p n hp, + simp [hp] } +end + end eval section map @@ -942,6 +1003,7 @@ end lemma coeff_map (p : mv_polynomial σ R) : ∀ (m : σ →₀ ℕ), coeff m (map f p) = f (coeff m p) := begin + classical, apply mv_polynomial.induction_on p; clear p, { intros r m, rw [map_C], simp only [coeff_C], split_ifs, {refl}, rw f.map_zero }, { intros p q hp hq m, simp only [hp, hq, (map f).map_add, coeff_add], rw f.map_add }, @@ -1080,6 +1142,9 @@ section aeval variables [algebra R S₁] [comm_semiring S₂] variables (f : σ → S₁) +lemma algebra_map_apply (r : R) : + algebra_map R (mv_polynomial σ S₁) r = C (algebra_map R S₁ r) := rfl + /-- A map `σ → S₁` where `S₁` is an algebra over `R` generates an `R`-algebra homomorphism from multivariate polynomials over `σ` to `S₁`. -/ def aeval : mv_polynomial σ R →ₐ[R] S₁ := @@ -1099,6 +1164,12 @@ theorem aeval_unique (φ : mv_polynomial σ R →ₐ[R] S₁) : φ = aeval (φ ∘ X) := by { ext i, simp } +lemma aeval_X_left : aeval X = alg_hom.id R (mv_polynomial σ R) := +(aeval_unique (alg_hom.id R _)).symm + +lemma aeval_X_left_apply (p : mv_polynomial σ R) : aeval X p = p := +alg_hom.congr_fun aeval_X_left p + lemma comp_aeval {B : Type*} [comm_semiring B] [algebra R B] (φ : S₁ →ₐ[R] B) : φ.comp (aeval f) = aeval (λ i, φ (f i)) := @@ -1109,26 +1180,44 @@ by { ext i, simp } φ (aeval g p) = (eval₂_hom (φ.comp (algebra_map R S₁)) (λ i, φ (g i)) p) := by { rw ← comp_eval₂_hom, refl } -@[simp] lemma eval₂_hom_zero (f : R →+* S₂) (p : mv_polynomial σ R) : +@[simp] lemma eval₂_hom_zero (f : R →+* S₂) : + eval₂_hom f (0 : σ → S₂) = f.comp constant_coeff := +by { ext; simp } + +@[simp] lemma eval₂_hom_zero' (f : R →+* S₂) : + eval₂_hom f (λ _, 0 : σ → S₂) = f.comp constant_coeff := +eval₂_hom_zero f + +lemma eval₂_hom_zero_apply (f : R →+* S₂) (p : mv_polynomial σ R) : eval₂_hom f (0 : σ → S₂) p = f (constant_coeff p) := -begin - suffices : eval₂_hom f (0 : σ → S₂) = f.comp constant_coeff, - from ring_hom.congr_fun this p, - ext; simp -end +ring_hom.congr_fun (eval₂_hom_zero f) p -@[simp] lemma eval₂_hom_zero' (f : R →+* S₂) (p : mv_polynomial σ R) : +lemma eval₂_hom_zero'_apply (f : R →+* S₂) (p : mv_polynomial σ R) : eval₂_hom f (λ _, 0 : σ → S₂) p = f (constant_coeff p) := -eval₂_hom_zero f p +eval₂_hom_zero_apply f p + +@[simp] lemma eval₂_zero_apply (f : R →+* S₂) (p : mv_polynomial σ R) : + eval₂ f (0 : σ → S₂) p = f (constant_coeff p) := +eval₂_hom_zero_apply _ _ + +@[simp] lemma eval₂_zero'_apply (f : R →+* S₂) (p : mv_polynomial σ R) : + eval₂ f (λ _, 0 : σ → S₂) p = f (constant_coeff p) := +eval₂_zero_apply f p @[simp] lemma aeval_zero (p : mv_polynomial σ R) : aeval (0 : σ → S₁) p = algebra_map _ _ (constant_coeff p) := -eval₂_hom_zero (algebra_map R S₁) p +eval₂_hom_zero_apply (algebra_map R S₁) p @[simp] lemma aeval_zero' (p : mv_polynomial σ R) : aeval (λ _, 0 : σ → S₁) p = algebra_map _ _ (constant_coeff p) := aeval_zero p +@[simp] lemma eval_zero : eval (0 : σ → R) = constant_coeff := +eval₂_hom_zero _ + +@[simp] lemma eval_zero' : eval (λ _, 0 : σ → R) = constant_coeff := +eval₂_hom_zero _ + lemma aeval_monomial (g : σ → S₁) (d : σ →₀ ℕ) (r : R) : aeval g (monomial d r) = algebra_map _ _ r * d.prod (λ i k, g i ^ k) := eval₂_hom_monomial _ _ _ _ @@ -1218,6 +1307,44 @@ by { ext, simp only [aeval_X, aeval_tower_X] } end aeval_tower +section eval_mem + +variables {S subS : Type*} [comm_semiring S] [set_like subS S] [subsemiring_class subS S] + +theorem eval₂_mem {f : R →+* S} + {p : mv_polynomial σ R} {s : subS} + (hs : ∀ i ∈ p.support, f (p.coeff i) ∈ s) {v : σ → S} (hv : ∀ i, v i ∈ s) : + mv_polynomial.eval₂ f v p ∈ s := +begin + classical, + replace hs : ∀ i, f (p.coeff i) ∈ s, + { intro i, + by_cases hi : i ∈ p.support, + { exact hs i hi }, + { rw [mv_polynomial.not_mem_support_iff.1 hi, f.map_zero], + exact zero_mem s } }, + induction p using mv_polynomial.induction_on''' with a a b f ha hb0 ih generalizing hs, + { simpa using hs 0 }, + rw [eval₂_add, eval₂_monomial], + refine add_mem (mul_mem _ $ prod_mem $ λ i hi, pow_mem (hv _) _) (ih $ λ i, _), + { simpa only [coeff_add, coeff_monomial, if_pos rfl, + mv_polynomial.not_mem_support_iff.1 ha, add_zero] using hs a }, + have := hs i, + rw [coeff_add, coeff_monomial] at this, + split_ifs at this with h h, + { subst h, + rw [mv_polynomial.not_mem_support_iff.1 ha, map_zero], + exact zero_mem _ }, + { rwa zero_add at this } +end + +theorem eval_mem {p : mv_polynomial σ S} {s : subS} + (hs : ∀ i ∈ p.support, p.coeff i ∈ s) {v : σ → S} (hv : ∀ i, v i ∈ s) : + mv_polynomial.eval v p ∈ s := +eval₂_mem hs hv + +end eval_mem + end comm_semiring end mv_polynomial diff --git a/src/data/mv_polynomial/cardinal.lean b/src/data/mv_polynomial/cardinal.lean index d923f8ba7c137..cedd2ff85a034 100644 --- a/src/data/mv_polynomial/cardinal.lean +++ b/src/data/mv_polynomial/cardinal.lean @@ -1,102 +1,60 @@ /- -Copyright (c) 2021 Chris Hughes. All rights reserved. +Copyright (c) 2021 Chris Hughes, Junyan Xu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes +Authors: Chris Hughes, Junyan Xu -/ -import data.W.cardinal -import data.mv_polynomial.basic +import data.finsupp.fintype +import data.mv_polynomial.equiv +import set_theory.cardinal.ordinal /-! -# Cardinality of Polynomial Ring +# Cardinality of Multivariate Polynomial Ring + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. The main result in this file is `mv_polynomial.cardinal_mk_le_max`, which says that the cardinality of `mv_polynomial σ R` is bounded above by the maximum of `#R`, `#σ` -and `ω`. - +and `ℵ₀`. -/ -universes u -/- -The definitions `mv_polynomial_fun` and `arity` are motivated by defining the following -inductive type as a `W_type` in order to be able to use theorems about the cardinality -of `W_type`. +universes u v -inductive mv_polynomial_term (σ R : Type u) : Type u -| of_ring : R → mv_polynomial_term -| X : σ → mv_polynomial_term -| add : mv_polynomial_term → mv_polynomial_term → mv_polynomial_term -| mul : mv_polynomial_term → mv_polynomial_term → mv_polynomial_term - -`W_type (arity σ R)` is isomorphic to the above type. --/ open cardinal open_locale cardinal -/-- A type used to prove theorems about the cardinality of `mv_polynomial σ R`. The -`W_type (arity σ R)` has a constant for every element of `R` and `σ` and two binary functions. -/ -private def mv_polynomial_fun (σ R : Type u) : Type u := -R ⊕ σ ⊕ ulift.{u} bool - -variables (σ R : Type u) -/-- A function used to prove theorems about the cardinality of `mv_polynomial σ R`. - The type ``W_type (arity σ R)` has a constant for every element of `R` and `σ` and two binary - functions. -/ -private def arity : mv_polynomial_fun σ R → Type u -| (sum.inl _) := pempty -| (sum.inr (sum.inl _)) := pempty -| (sum.inr (sum.inr ⟨ff⟩)) := ulift bool -| (sum.inr (sum.inr ⟨tt⟩)) := ulift bool - -private def arity_fintype (x : mv_polynomial_fun σ R) : fintype (arity σ R x) := -by rcases x with x | x | ⟨_ | _⟩; dsimp [arity]; apply_instance +namespace mv_polynomial -local attribute [instance] arity_fintype +section two_universes -variables {σ R} +variables {σ : Type u} {R : Type v} [comm_semiring R] -variables [comm_semiring R] +@[simp] lemma cardinal_mk_eq_max_lift [nonempty σ] [nontrivial R] : + #(mv_polynomial σ R) = max (max (cardinal.lift.{u} $ #R) $ cardinal.lift.{v} $ #σ) ℵ₀ := +(mk_finsupp_lift_of_infinite _ R).trans $ +by rw [mk_finsupp_nat, max_assoc, lift_max, lift_aleph_0, max_comm] -/-- The surjection from `W_type (arity σ R)` into `mv_polynomial σ R`. -/ -private noncomputable def to_mv_polynomial : - W_type (arity σ R) → mv_polynomial σ R -| ⟨sum.inl r, _⟩ := mv_polynomial.C r -| ⟨sum.inr (sum.inl i), _⟩ := mv_polynomial.X i -| ⟨sum.inr (sum.inr ⟨ff⟩), f⟩ := - to_mv_polynomial (f (ulift.up tt)) * to_mv_polynomial (f (ulift.up ff)) -| ⟨sum.inr (sum.inr ⟨tt⟩), f⟩ := - to_mv_polynomial (f (ulift.up tt)) + to_mv_polynomial (f (ulift.up ff)) +@[simp] lemma cardinal_mk_eq_lift [is_empty σ] : #(mv_polynomial σ R) = cardinal.lift.{u} (#R) := +((is_empty_ring_equiv R σ).to_equiv.trans equiv.ulift.{u}.symm).cardinal_eq -private lemma to_mv_polynomial_surjective : function.surjective (@to_mv_polynomial σ R _) := +lemma cardinal_lift_mk_le_max {σ : Type u} {R : Type v} [comm_semiring R] : + #(mv_polynomial σ R) ≤ max (max (cardinal.lift.{u} $ #R) $ cardinal.lift.{v} $ #σ) ℵ₀ := begin - intro p, - induction p using mv_polynomial.induction_on with x p₁ p₂ ih₁ ih₂ p i ih, - { exact ⟨W_type.mk (sum.inl x) pempty.elim, rfl⟩ }, - { rcases ih₁ with ⟨w₁, rfl⟩, - rcases ih₂ with ⟨w₂, rfl⟩, - exact ⟨W_type.mk (sum.inr (sum.inr ⟨tt⟩)) (λ x, cond x.down w₁ w₂), - by simp [to_mv_polynomial]⟩ }, - { rcases ih with ⟨w, rfl⟩, - exact ⟨W_type.mk (sum.inr (sum.inr ⟨ff⟩)) (λ x, cond x.down w (W_type.mk - (sum.inr (sum.inl i)) pempty.elim)), by simp [to_mv_polynomial]⟩ } + casesI subsingleton_or_nontrivial R, + { exact (mk_eq_one _).trans_le (le_max_of_le_right one_le_aleph_0) }, + casesI is_empty_or_nonempty σ, + { exact cardinal_mk_eq_lift.trans_le (le_max_of_le_left $ le_max_left _ _) }, + { exact cardinal_mk_eq_max_lift.le }, end -private lemma cardinal_mv_polynomial_fun_le : #(mv_polynomial_fun σ R) ≤ max (max (#R) (#σ)) ω := -calc #(mv_polynomial_fun σ R) = #R + #σ + #(ulift bool) : - by dsimp [mv_polynomial_fun]; simp only [← add_def, add_assoc, cardinal.mk_ulift] -... ≤ max (max (#R + #σ) (#(ulift bool))) ω : add_le_max _ _ -... ≤ max (max (max (max (#R) (#σ)) ω) (#(ulift bool))) ω : - max_le_max (max_le_max (add_le_max _ _) le_rfl) le_rfl -... ≤ _ : by simp only [max_comm omega.{u}, max_assoc, max_left_comm omega.{u}, max_self, - max_eq_left (lt_omega_of_fintype (ulift.{u} bool)).le] +end two_universes -namespace mv_polynomial +variables {σ R : Type u} [comm_semiring R] + +lemma cardinal_mk_eq_max [nonempty σ] [nontrivial R] : + #(mv_polynomial σ R) = max (max (#R) (#σ)) ℵ₀ := by simp /-- The cardinality of the multivariate polynomial ring, `mv_polynomial σ R` is at most the maximum -of `#R`, `#σ` and `ω` -/ -lemma cardinal_mk_le_max {σ R : Type u} [comm_semiring R] : - #(mv_polynomial σ R) ≤ max (max (#R) (#σ)) ω := -calc #(mv_polynomial σ R) ≤ #(W_type (arity σ R)) : - cardinal.mk_le_of_surjective to_mv_polynomial_surjective -... ≤ max (#(mv_polynomial_fun σ R)) ω : W_type.cardinal_mk_le_max_omega_of_fintype -... ≤ _ : max_le_max cardinal_mv_polynomial_fun_le le_rfl -... ≤ _ : by simp only [max_assoc, max_self] +of `#R`, `#σ` and `ℵ₀` -/ +lemma cardinal_mk_le_max : #(mv_polynomial σ R) ≤ max (max (#R) (#σ)) ℵ₀ := +cardinal_lift_mk_le_max.trans $ by rw [lift_id, lift_id] end mv_polynomial diff --git a/src/data/mv_polynomial/comap.lean b/src/data/mv_polynomial/comap.lean index a532cd8918d99..7dcbdb07d6f48 100644 --- a/src/data/mv_polynomial/comap.lean +++ b/src/data/mv_polynomial/comap.lean @@ -9,6 +9,9 @@ import data.mv_polynomial.rename /-! # `comap` operation on `mv_polynomial` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the `comap` function on `mv_polynomial`. `mv_polynomial.comap` is a low-tech example of a map of "algebraic varieties," modulo the fact that diff --git a/src/data/mv_polynomial/comm_ring.lean b/src/data/mv_polynomial/comm_ring.lean index 346653a0c0e6b..3d8107b69fca1 100644 --- a/src/data/mv_polynomial/comm_ring.lean +++ b/src/data/mv_polynomial/comm_ring.lean @@ -9,6 +9,9 @@ import data.mv_polynomial.variables /-! # Multivariate polynomials over a ring +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Many results about polynomials hold when the coefficient ring is a commutative semiring. Some stronger results can be derived when we assume this semiring is a ring. @@ -35,8 +38,6 @@ This will give rise to a monomial in `mv_polynomial σ R` which mathematicians m noncomputable theory -open_locale classical big_operators - open set function finsupp add_monoid_algebra open_locale big_operators @@ -67,7 +68,8 @@ variables (σ a a') @[simp] lemma support_neg : (- p).support = p.support := finsupp.support_neg p -lemma support_sub (p q : mv_polynomial σ R) : (p - q).support ⊆ p.support ∪ q.support := +lemma support_sub [decidable_eq σ] (p q : mv_polynomial σ R) : + (p - q).support ⊆ p.support ∪ q.support := finsupp.support_sub variables {σ} (p) @@ -77,9 +79,9 @@ section degrees lemma degrees_neg (p : mv_polynomial σ R) : (- p).degrees = p.degrees := by rw [degrees, support_neg]; refl -lemma degrees_sub (p q : mv_polynomial σ R) : +lemma degrees_sub [decidable_eq σ] (p q : mv_polynomial σ R) : (p - q).degrees ≤ p.degrees ⊔ q.degrees := -by simpa only [sub_eq_add_neg] using le_trans (degrees_add p (-q)) (by rw degrees_neg) +by classical; simpa only [sub_eq_add_neg, degrees_neg] using degrees_add p (-q) end degrees @@ -90,13 +92,14 @@ variables (p q) @[simp] lemma vars_neg : (-p).vars = p.vars := by simp [vars, degrees_neg] -lemma vars_sub_subset : (p - q).vars ⊆ p.vars ∪ q.vars := +lemma vars_sub_subset [decidable_eq σ] : (p - q).vars ⊆ p.vars ∪ q.vars := by convert vars_add_subset p (-q) using 2; simp [sub_eq_add_neg] variables {p q} @[simp] -lemma vars_sub_of_disjoint (hpq : disjoint p.vars q.vars) : (p - q).vars = p.vars ∪ q.vars := +lemma vars_sub_of_disjoint [decidable_eq σ] (hpq : disjoint p.vars q.vars) : + (p - q).vars = p.vars ∪ q.vars := begin rw ←vars_neg q at hpq, convert vars_add_of_disjoint hpq using 2; @@ -116,7 +119,7 @@ variables (f : R →+* S) (g : σ → S) @[simp] lemma eval₂_neg : (-p).eval₂ f g = -(p.eval₂ f g) := (eval₂_hom f g).map_neg _ lemma hom_C (f : mv_polynomial σ ℤ →+* S) (n : ℤ) : f (C n) = (n : S) := -(f.comp C).eq_int_cast n +eq_int_cast (f.comp C) n /-- A ring homomorphism f : Z[X_1, X_2, ...] → R is determined by the evaluations f(X_1), f(X_2), ... -/ @@ -124,7 +127,7 @@ is determined by the evaluations f(X_1), f(X_2), ... -/ (f : mv_polynomial R ℤ →+* S) (x : mv_polynomial R ℤ) : eval₂ c (f ∘ X) x = f x := mv_polynomial.induction_on x -(λ n, by { rw [hom_C f, eval₂_C], exact c.eq_int_cast n }) +(λ n, by { rw [hom_C f, eval₂_C], exact eq_int_cast c n }) (λ p q hp hq, by { rw [eval₂_add, hp, hq], exact (f.map_add _ _).symm }) (λ p n hp, by { rw [eval₂_mul, eval₂_X, hp], exact (f.map_mul _ _).symm }) @@ -145,6 +148,7 @@ lemma degree_of_sub_lt {x : σ} {f g : mv_polynomial σ R} {k : ℕ} (h : 0 < k) (hg : ∀ (m : σ →₀ ℕ), m ∈ g.support → (k ≤ m x) → coeff m f = coeff m g) : degree_of x (f - g) < k := begin + classical, rw degree_of_lt_iff h, intros m hm, by_contra hc, @@ -166,9 +170,12 @@ by simp only [total_degree, support_neg] lemma total_degree_sub (a b : mv_polynomial σ R) : (a - b).total_degree ≤ max a.total_degree b.total_degree := -calc (a - b).total_degree = (a + -b).total_degree : by rw sub_eq_add_neg - ... ≤ max a.total_degree (-b).total_degree : total_degree_add a (-b) - ... = max a.total_degree b.total_degree : by rw total_degree_neg +begin + classical, + calc (a - b).total_degree = (a + -b).total_degree : by rw sub_eq_add_neg + ... ≤ max a.total_degree (-b).total_degree : total_degree_add a (-b) + ... = max a.total_degree b.total_degree : by rw total_degree_neg +end end total_degree diff --git a/src/data/mv_polynomial/counit.lean b/src/data/mv_polynomial/counit.lean index 8488c8ff2b482..85b80de52a887 100644 --- a/src/data/mv_polynomial/counit.lean +++ b/src/data/mv_polynomial/counit.lean @@ -9,6 +9,9 @@ import data.mv_polynomial.basic /-! ## Counit morphisms for multivariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + One may consider the ring of multivariate polynomials `mv_polynomial A R` with coefficients in `R` and variables indexed by `A`. If `A` is not just a type, but an algebra over `R`, then there is a natural surjective algebra homomorphism `mv_polynomial A R →ₐ[R] A` diff --git a/src/data/mv_polynomial/default.lean b/src/data/mv_polynomial/default.lean deleted file mode 100644 index e90a087f351d3..0000000000000 --- a/src/data/mv_polynomial/default.lean +++ /dev/null @@ -1,4 +0,0 @@ -import data.mv_polynomial.basic -import data.mv_polynomial.variables -import data.mv_polynomial.rename -import data.mv_polynomial.comm_ring diff --git a/src/data/mv_polynomial/derivation.lean b/src/data/mv_polynomial/derivation.lean index 161fbbc4fd518..8302eef772b37 100644 --- a/src/data/mv_polynomial/derivation.lean +++ b/src/data/mv_polynomial/derivation.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yury Kudryashov -/ import data.mv_polynomial.supported -import ring_theory.derivation +import ring_theory.derivation.basic /-! # Derivations of multivariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove that a derivation of `mv_polynomial σ R` is determined by its values on all monomials `mv_polynomial.X i`. We also provide a constructor `mv_polynomial.mk_derivation` that builds a derivation from its values on `X i`s and a linear equivalence @@ -110,7 +113,7 @@ def mk_derivation (f : σ → A) : derivation R (mv_polynomial σ R) A := leibniz' := (leibniz_iff_X (mk_derivationₗ R f) (mk_derivationₗ_C _ 1)).2 $ λ s i, begin simp only [mk_derivationₗ_monomial, X, monomial_mul, one_smul, one_mul], - rw [finsupp.sum_add_index]; + rw [finsupp.sum_add_index']; [skip, by simp, by { intros, simp only [nat.cast_add, (monomial _).map_add, add_smul] }], rw [finsupp.sum_single_index, finsupp.sum_single_index]; [skip, by simp, by simp], rw [tsub_self, add_tsub_cancel_right, nat.cast_one, ← C_apply, C_1, one_smul, diff --git a/src/data/mv_polynomial/division.lean b/src/data/mv_polynomial/division.lean new file mode 100644 index 0000000000000..5784eda1e59b6 --- /dev/null +++ b/src/data/mv_polynomial/division.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2022 Eric Wieser. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Eric Wieser +-/ +import algebra.monoid_algebra.division +import data.mv_polynomial.basic + +/-! +# Division of `mv_polynomial` by monomials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `mv_polynomial.div_monomial x s`: divides `x` by the monomial `mv_polynomial.monomial 1 s` +* `mv_polynomial.mod_monomial x s`: the remainder upon dividing `x` by the monomial + `mv_polynomial.monomial 1 s`. + +## Main results + +* `mv_polynomial.div_monomial_add_mod_monomial`, `mv_polynomial.mod_monomial_add_div_monomial`: + `div_monomial` and `mod_monomial` are well-behaved as quotient and remainder operators. + +## Implementation notes + +Where possible, the results in this file should be first proved in the generality of +`add_monoid_algebra`, and then the versions specialized to `mv_polynomial` proved in terms of these. + +-/ + + +variables {σ R : Type*} [comm_semiring R] + +namespace mv_polynomial + +section copied_declarations +/-! Please ensure the declarations in this section are direct translations of `add_monoid_algebra` +results. -/ + +/-- Divide by `monomial 1 s`, discarding terms not divisible by this. -/ +noncomputable def div_monomial (p : mv_polynomial σ R) (s : σ →₀ ℕ) : mv_polynomial σ R := +add_monoid_algebra.div_of p s + +local infix ` /ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := div_monomial + +@[simp] lemma coeff_div_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R) (s' : σ →₀ ℕ) : + coeff s' (x /ᵐᵒⁿᵒᵐⁱᵃˡ s) = coeff (s + s') x := rfl + +@[simp] lemma support_div_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R) : + (x /ᵐᵒⁿᵒᵐⁱᵃˡ s).support = x.support.preimage _ ((add_right_injective s).inj_on _) := rfl + +@[simp] lemma zero_div_monomial (s : σ →₀ ℕ) : (0 : mv_polynomial σ R) /ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 := +add_monoid_algebra.zero_div_of _ + +lemma div_monomial_zero (x : mv_polynomial σ R) : x /ᵐᵒⁿᵒᵐⁱᵃˡ 0 = x := +x.div_of_zero + +lemma add_div_monomial (x y : mv_polynomial σ R) (s : σ →₀ ℕ) : + (x + y) /ᵐᵒⁿᵒᵐⁱᵃˡ s = x /ᵐᵒⁿᵒᵐⁱᵃˡ s + y /ᵐᵒⁿᵒᵐⁱᵃˡ s := +map_add _ _ _ + +lemma div_monomial_add (a b : σ →₀ ℕ) (x : mv_polynomial σ R) : + x /ᵐᵒⁿᵒᵐⁱᵃˡ (a + b) = (x /ᵐᵒⁿᵒᵐⁱᵃˡ a) /ᵐᵒⁿᵒᵐⁱᵃˡ b := +x.div_of_add _ _ + +@[simp] lemma div_monomial_monomial_mul (a : σ →₀ ℕ) (x : mv_polynomial σ R) : + (monomial a 1 * x) /ᵐᵒⁿᵒᵐⁱᵃˡ a = x := +x.of'_mul_div_of _ + +@[simp] lemma div_monomial_mul_monomial (a : σ →₀ ℕ) (x : mv_polynomial σ R) : + (x * monomial a 1) /ᵐᵒⁿᵒᵐⁱᵃˡ a = x := +x.mul_of'_div_of _ + +@[simp] lemma div_monomial_monomial (a : σ →₀ ℕ) : + (monomial a 1) /ᵐᵒⁿᵒᵐⁱᵃˡ a = (1 : mv_polynomial σ R) := +add_monoid_algebra.of'_div_of _ + +/-- The remainder upon division by `monomial 1 s`. -/ +noncomputable def mod_monomial (x : mv_polynomial σ R) (s : σ →₀ ℕ) : mv_polynomial σ R := +x.mod_of s + +local infix ` %ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := mod_monomial + +@[simp] lemma coeff_mod_monomial_of_not_le {s' s : σ →₀ ℕ} (x : mv_polynomial σ R) (h : ¬s ≤ s') : + coeff s' (x %ᵐᵒⁿᵒᵐⁱᵃˡ s) = coeff s' x := +x.mod_of_apply_of_not_exists_add s s' begin + rintro ⟨d, rfl⟩, + exact h le_self_add, +end + +@[simp] lemma coeff_mod_monomial_of_le {s' s : σ →₀ ℕ} (x : mv_polynomial σ R) (h : s ≤ s') : + coeff s' (x %ᵐᵒⁿᵒᵐⁱᵃˡ s) = 0 := +x.mod_of_apply_of_exists_add _ _ $ exists_add_of_le h + +@[simp] lemma monomial_mul_mod_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R) : + (monomial s 1 * x) %ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 := +x.of'_mul_mod_of _ + +@[simp] lemma mul_monomial_mod_monomial (s : σ →₀ ℕ) (x : mv_polynomial σ R): + (x * monomial s 1) %ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 := +x.mul_of'_mod_of _ + +@[simp] lemma monomial_mod_monomial (s : σ →₀ ℕ) : (monomial s (1 : R)) %ᵐᵒⁿᵒᵐⁱᵃˡ s = 0 := +add_monoid_algebra.of'_mod_of _ + +lemma div_monomial_add_mod_monomial (x : mv_polynomial σ R) (s : σ →₀ ℕ) : + monomial s 1 * (x /ᵐᵒⁿᵒᵐⁱᵃˡ s) + x %ᵐᵒⁿᵒᵐⁱᵃˡ s = x := +add_monoid_algebra.div_of_add_mod_of x s + +lemma mod_monomial_add_div_monomial (x : mv_polynomial σ R) (s : σ →₀ ℕ) : + x %ᵐᵒⁿᵒᵐⁱᵃˡ s + monomial s 1 * (x /ᵐᵒⁿᵒᵐⁱᵃˡ s) = x := +add_monoid_algebra.mod_of_add_div_of x s + +lemma monomial_one_dvd_iff_mod_monomial_eq_zero {i : σ →₀ ℕ} {x : mv_polynomial σ R} : + monomial i (1 : R) ∣ x ↔ x %ᵐᵒⁿᵒᵐⁱᵃˡ i = 0 := +add_monoid_algebra.of'_dvd_iff_mod_of_eq_zero + +end copied_declarations + + +section X_lemmas + +local infix ` /ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := div_monomial +local infix ` %ᵐᵒⁿᵒᵐⁱᵃˡ `:70 := mod_monomial + +@[simp] lemma X_mul_div_monomial (i : σ) (x : mv_polynomial σ R) : + (X i * x) /ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = x := +div_monomial_monomial_mul _ _ + +@[simp] lemma X_div_monomial (i : σ) : + (X i : mv_polynomial σ R) /ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = 1 := +(div_monomial_monomial (finsupp.single i 1)) + +@[simp] lemma mul_X_div_monomial (x : mv_polynomial σ R) (i : σ) : + (x * X i) /ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = x := +div_monomial_mul_monomial _ _ + +@[simp] lemma X_mul_mod_monomial (i : σ) (x : mv_polynomial σ R) : + (X i * x) %ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = 0 := +monomial_mul_mod_monomial _ _ + +@[simp] lemma mul_X_mod_monomial (x : mv_polynomial σ R) (i : σ) : + (x * X i) %ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = 0 := +mul_monomial_mod_monomial _ _ + +@[simp] lemma mod_monomial_X (i : σ) : + (X i : mv_polynomial σ R) %ᵐᵒⁿᵒᵐⁱᵃˡ (finsupp.single i 1) = 0 := +monomial_mod_monomial _ + +lemma div_monomial_add_mod_monomial_single (x : mv_polynomial σ R) (i : σ) : + X i * (x /ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1) + x %ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1 = x := +div_monomial_add_mod_monomial _ _ + +lemma mod_monomial_add_div_monomial_single (x : mv_polynomial σ R) (i : σ) : + x %ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1 + X i * (x /ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1) = x := +mod_monomial_add_div_monomial _ _ + +lemma X_dvd_iff_mod_monomial_eq_zero {i : σ} {x : mv_polynomial σ R} : + X i ∣ x ↔ x %ᵐᵒⁿᵒᵐⁱᵃˡ finsupp.single i 1 = 0 := +monomial_one_dvd_iff_mod_monomial_eq_zero + +end X_lemmas + +/-! ### Some results about dvd (`∣`) on `monomial` and `X` -/ + +lemma monomial_dvd_monomial {r s : R} {i j : σ →₀ ℕ} : + monomial i r ∣ monomial j s ↔ (s = 0 ∨ i ≤ j) ∧ r ∣ s := +begin + split, + { rintro ⟨x, hx⟩, + rw mv_polynomial.ext_iff at hx, + have hj := hx j, + have hi := hx i, + classical, + simp_rw [coeff_monomial, if_pos] at hj hi, + simp_rw [coeff_monomial_mul', if_pos] at hi hj, + split_ifs at hi hj with hi hi, + { exact ⟨or.inr hi, _, hj⟩ }, + { exact ⟨or.inl hj, hj.symm ▸ dvd_zero _⟩ } }, + { rintro ⟨h | hij, d, rfl⟩, + { simp_rw [h, monomial_zero, dvd_zero] }, + { refine ⟨monomial (j - i) d, _⟩, + rw [monomial_mul, add_tsub_cancel_of_le hij] } } +end + +@[simp] lemma monomial_one_dvd_monomial_one [nontrivial R] {i j : σ →₀ ℕ} : + monomial i (1 : R) ∣ monomial j 1 ↔ i ≤ j := +begin + rw monomial_dvd_monomial, + simp_rw [one_ne_zero, false_or, dvd_rfl, and_true], +end + +@[simp] lemma X_dvd_X [nontrivial R] {i j : σ} : + (X i : mv_polynomial σ R) ∣ (X j : mv_polynomial σ R) ↔ i = j := +begin + refine monomial_one_dvd_monomial_one.trans _, + simp_rw [finsupp.single_le_iff, nat.one_le_iff_ne_zero, finsupp.single_apply_ne_zero, + ne.def, one_ne_zero, not_false_iff, and_true], +end + +@[simp] lemma X_dvd_monomial {i : σ} {j : σ →₀ ℕ} {r : R} : + (X i : mv_polynomial σ R) ∣ monomial j r ↔ (r = 0 ∨ j i ≠ 0) := +begin + refine monomial_dvd_monomial.trans _, + simp_rw [one_dvd, and_true, finsupp.single_le_iff, nat.one_le_iff_ne_zero], +end + +end mv_polynomial diff --git a/src/data/mv_polynomial/equiv.lean b/src/data/mv_polynomial/equiv.lean index 76e328ca13d5e..6fc617c5ad0fe 100644 --- a/src/data/mv_polynomial/equiv.lean +++ b/src/data/mv_polynomial/equiv.lean @@ -6,7 +6,6 @@ Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro import data.mv_polynomial.rename import data.polynomial.algebra_map -import data.polynomial.lifts import data.mv_polynomial.variables import data.finsupp.fin import logic.equiv.fin @@ -16,6 +15,9 @@ import algebra.big_operators.fin /-! # Equivalences between polynomial rings +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file establishes a number of equivalences between polynomial rings, based on equivalences between the underlying types. @@ -44,7 +46,7 @@ equivalence, isomorphism, morphism, ring hom, hom noncomputable theory -open_locale classical big_operators polynomial +open_locale big_operators polynomial open set function finsupp add_monoid_algebra @@ -459,8 +461,8 @@ lemma degree_fin_succ_equiv {f : mv_polynomial (fin (n + 1)) R} (h : f ≠ 0) : begin have h' : (fin_succ_equiv R n f).support.sup (λ x , x) = degree_of 0 f, { rw [degree_of_eq_sup, fin_succ_equiv_support f, finset.sup_image] }, - rw [polynomial.degree, ← h', finset.coe_sup_of_nonempty (support_fin_succ_equiv_nonempty h)], - congr, + rw [polynomial.degree, ← h', finset.coe_sup_of_nonempty (support_fin_succ_equiv_nonempty h), + finset.max_eq_sup_coe], end lemma nat_degree_fin_succ_equiv (f : mv_polynomial (fin (n + 1)) R) : diff --git a/src/data/mv_polynomial/expand.lean b/src/data/mv_polynomial/expand.lean index ab49cf584889e..13a0bac69cb50 100644 --- a/src/data/mv_polynomial/expand.lean +++ b/src/data/mv_polynomial/expand.lean @@ -8,6 +8,9 @@ import data.mv_polynomial.monad /-! ## Expand multivariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given a multivariate polynomial `φ`, one may replace every occurence of `X i` by `X i ^ n`, for some natural number `n`. This operation is called `mv_polynomial.expand` and it is an algebra homomorphism. diff --git a/src/data/mv_polynomial/funext.lean b/src/data/mv_polynomial/funext.lean index ed08c70b9336c..cf1dea8a56763 100644 --- a/src/data/mv_polynomial/funext.lean +++ b/src/data/mv_polynomial/funext.lean @@ -6,10 +6,14 @@ Authors: Johan Commelin import data.polynomial.ring_division import data.mv_polynomial.rename import ring_theory.polynomial.basic +import data.mv_polynomial.polynomial /-! ## Function extensionality for multivariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we show that two multivariate polynomials over an infinite integral domain are equal if they are equal upon evaluating them on an arbitrary assignment of the variables. @@ -27,41 +31,17 @@ variables {R : Type*} [comm_ring R] [is_domain R] [infinite R] private lemma funext_fin {n : ℕ} {p : mv_polynomial (fin n) R} (h : ∀ x : fin n → R, eval x p = 0) : p = 0 := begin - unfreezingI { induction n with n ih generalizing R }, - { let e := (mv_polynomial.is_empty_ring_equiv R (fin 0)), - apply e.injective, - rw ring_equiv.map_zero, - convert h fin_zero_elim, - suffices : (eval₂_hom (ring_hom.id _) (is_empty.elim' fin.is_empty)) p = - (eval fin_zero_elim : mv_polynomial (fin 0) R →+* R) p, - { rw [← this], - simp only [coe_eval₂_hom, is_empty_ring_equiv_apply, - ring_equiv.trans_apply, aeval_eq_eval₂_hom], - congr }, - exact eval₂_hom_congr rfl (subsingleton.elim _ _) rfl }, - { let e := (fin_succ_equiv R n).to_ring_equiv, - apply e.injective, - simp only [ring_equiv.map_zero], - apply polynomial.funext, - intro q, + induction n with n ih, + { apply (mv_polynomial.is_empty_ring_equiv R (fin 0)).injective, + rw [ring_equiv.map_zero], + convert h _, }, + { apply (fin_succ_equiv R n).injective, + simp only [alg_equiv.map_zero], + refine polynomial.funext (λ q, _), rw [polynomial.eval_zero], - apply ih, swap, { apply_instance }, - intro x, - dsimp [e], - rw [fin_succ_equiv_apply], - calc _ = eval _ p : _ - ... = 0 : h _, - { intro i, exact fin.cases (eval x q) x i }, - apply induction_on p, - { intro r, - simp only [eval_C, polynomial.eval_C, ring_hom.coe_comp, eval₂_hom_C], }, - { intros, simp only [*, ring_hom.map_add, polynomial.eval_add] }, - { intros φ i hφ, simp only [*, eval_X, polynomial.eval_mul, ring_hom.map_mul, eval₂_hom_X'], - congr' 1, - by_cases hi : i = 0, - { subst hi, simp only [polynomial.eval_X, fin.cases_zero] }, - { rw [← fin.succ_pred i hi], simp only [eval_X, polynomial.eval_C, fin.cases_succ] } }, - { apply_instance, }, }, + apply ih (λ x, _), + calc _ = _ : eval_polynomial_eval_fin_succ_equiv p _ _ + ... = 0 : h _, } end /-- Two multivariate polynomials over an infinite integral domain are equal diff --git a/src/data/mv_polynomial/invertible.lean b/src/data/mv_polynomial/invertible.lean index cae1d3c1874bf..5d1e6419a1c00 100644 --- a/src/data/mv_polynomial/invertible.lean +++ b/src/data/mv_polynomial/invertible.lean @@ -10,6 +10,9 @@ import ring_theory.algebra_tower /-! # Invertible polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file is a stub containing some basic facts about invertible elements in the ring of polynomials. -/ diff --git a/src/data/mv_polynomial/monad.lean b/src/data/mv_polynomial/monad.lean index b681972fda45b..ca12e69353d15 100644 --- a/src/data/mv_polynomial/monad.lean +++ b/src/data/mv_polynomial/monad.lean @@ -3,13 +3,16 @@ Copyright (c) 2020 Johan Commelin, Robert Y. Lewis. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johan Commelin, Robert Y. Lewis -/ - import data.mv_polynomial.rename +import data.mv_polynomial.variables /-! # Monad operations on `mv_polynomial` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines two monadic operations on `mv_polynomial`. Given `p : mv_polynomial σ R`, * `mv_polynomial.bind₁` and `mv_polynomial.join₁` operate on the variable type `σ`. @@ -133,12 +136,6 @@ eval₂_hom_X' f X i lemma bind₁_X_left : bind₁ (X : σ → mv_polynomial σ R) = alg_hom.id R _ := by { ext1 i, simp } -lemma aeval_X_left : aeval (X : σ → mv_polynomial σ R) = alg_hom.id R _ := -by rw [aeval_eq_bind₁, bind₁_X_left] - -lemma aeval_X_left_apply (φ : mv_polynomial σ R) : aeval X φ = φ := -by rw [aeval_eq_bind₁, bind₁_X_left, alg_hom.id_apply] - variable (f : σ → mv_polynomial τ R) @[simp] @@ -290,6 +287,44 @@ lemma bind₂_monomial_one (f : R →+* mv_polynomial σ S) (d : σ →₀ ℕ) bind₂ f (monomial d 1) = monomial d 1 := by rw [bind₂_monomial, f.map_one, one_mul] +section + +lemma vars_bind₁ [decidable_eq τ] (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) : + (bind₁ f φ).vars ⊆ φ.vars.bUnion (λ i, (f i).vars) := +begin + calc (bind₁ f φ).vars + = (φ.support.sum (λ (x : σ →₀ ℕ), (bind₁ f) (monomial x (coeff x φ)))).vars : + by { rw [← alg_hom.map_sum, ← φ.as_sum], } + ... ≤ φ.support.bUnion (λ (i : σ →₀ ℕ), ((bind₁ f) (monomial i (coeff i φ))).vars) : + vars_sum_subset _ _ + ... = φ.support.bUnion (λ (d : σ →₀ ℕ), (C (coeff d φ) * ∏ i in d.support, f i ^ d i).vars) : + by simp only [bind₁_monomial] + ... ≤ φ.support.bUnion (λ (d : σ →₀ ℕ), d.support.bUnion (λ i, (f i).vars)) : _ -- proof below + ... ≤ φ.vars.bUnion (λ (i : σ), (f i).vars) : _, -- proof below + { apply finset.bUnion_mono, + intros d hd, + calc (C (coeff d φ) * ∏ (i : σ) in d.support, f i ^ d i).vars + ≤ (C (coeff d φ)).vars ∪ (∏ (i : σ) in d.support, f i ^ d i).vars : vars_mul _ _ + ... ≤ (∏ (i : σ) in d.support, f i ^ d i).vars : + by simp only [finset.empty_union, vars_C, finset.le_iff_subset, finset.subset.refl] + ... ≤ d.support.bUnion (λ (i : σ), (f i ^ d i).vars) : vars_prod _ + ... ≤ d.support.bUnion (λ (i : σ), (f i).vars) : _, + apply finset.bUnion_mono, + intros i hi, + apply vars_pow, }, + { intro j, + simp_rw finset.mem_bUnion, + rintro ⟨d, hd, ⟨i, hi, hj⟩⟩, + exact ⟨i, (mem_vars _).mpr ⟨d, hd, hi⟩, hj⟩ } +end +end + +lemma mem_vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) {j : τ} + (h : j ∈ (bind₁ f φ).vars) : + ∃ (i : σ), i ∈ φ.vars ∧ j ∈ (f i).vars := +by classical; simpa only [exists_prop, finset.mem_bUnion, mem_support_iff, ne.def] + using vars_bind₁ f φ h + instance monad : monad (λ σ, mv_polynomial σ R) := { map := λ α β f p, rename f p, pure := λ _, X, diff --git a/src/data/mv_polynomial/pderiv.lean b/src/data/mv_polynomial/pderiv.lean index 4cd9c1e640697..25f20db06a227 100644 --- a/src/data/mv_polynomial/pderiv.lean +++ b/src/data/mv_polynomial/pderiv.lean @@ -10,6 +10,9 @@ import data.mv_polynomial.derivation /-! # Partial derivatives of polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the notion of the formal *partial derivative* of a polynomial, the derivative with respect to a single variable. This derivative is not connected to the notion of derivative from analysis. @@ -47,7 +50,7 @@ namespace mv_polynomial open set function finsupp add_monoid_algebra -open_locale classical big_operators +open_locale big_operators variables {R : Type u} {σ : Type v} {a a' a₁ a₂ : R} {s : σ →₀ ℕ} @@ -57,12 +60,16 @@ variables {R} [comm_semiring R] /-- `pderiv i p` is the partial derivative of `p` with respect to `i` -/ def pderiv (i : σ) : derivation R (mv_polynomial σ R) (mv_polynomial σ R) := -mk_derivation R $ pi.single i 1 +by letI := classical.dec_eq σ; exact (mk_derivation R $ pi.single i 1) + +lemma pderiv_def [decidable_eq σ] (i : σ) : pderiv i = mk_derivation R (pi.single i 1) := +by convert rfl @[simp] lemma pderiv_monomial {i : σ} : pderiv i (monomial s a) = monomial (s - single i 1) (a * (s i)) := begin - simp only [pderiv, mk_derivation_monomial, finsupp.smul_sum, smul_eq_mul, + classical, + simp only [pderiv_def, mk_derivation_monomial, finsupp.smul_sum, smul_eq_mul, ← smul_mul_assoc, ← (monomial _).map_smul], refine (finset.sum_eq_single i (λ j hj hne, _) (λ hi, _)).trans _, { simp [pi.single_eq_of_ne hne] }, @@ -74,14 +81,15 @@ lemma pderiv_C {i : σ} : pderiv i (C a) = 0 := derivation_C _ _ lemma pderiv_one {i : σ} : pderiv i (1 : mv_polynomial σ R) = 0 := pderiv_C -@[simp] lemma pderiv_X [d : decidable_eq σ] (i j : σ) : - pderiv i (X j : mv_polynomial σ R) = @pi.single σ _ d _ i 1 j := -(mk_derivation_X _ _ _).trans (by congr) +@[simp] lemma pderiv_X [decidable_eq σ] (i j : σ) : + pderiv i (X j : mv_polynomial σ R) = @pi.single _ _ _ _ i 1 j := +by rw [pderiv_def, mk_derivation_X] -@[simp] lemma pderiv_X_self (i : σ) : pderiv i (X i : mv_polynomial σ R) = 1 := by simp +@[simp] lemma pderiv_X_self (i : σ) : pderiv i (X i : mv_polynomial σ R) = 1 := +by classical; simp @[simp] lemma pderiv_X_of_ne {i j : σ} (h : j ≠ i) : pderiv i (X j : mv_polynomial σ R) = 0 := -by simp [h] +by classical; simp [h] lemma pderiv_eq_zero_of_not_mem_vars {i : σ} {f : mv_polynomial σ R} (h : i ∉ f.vars) : pderiv i f = 0 := diff --git a/src/data/mv_polynomial/polynomial.lean b/src/data/mv_polynomial/polynomial.lean new file mode 100644 index 0000000000000..bbe843c6ba862 --- /dev/null +++ b/src/data/mv_polynomial/polynomial.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2023 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison +-/ +import data.mv_polynomial.equiv +import data.polynomial.eval + +/-! +# Some lemmas relating polynomials and multivariable polynomials. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +namespace mv_polynomial + +variables {R S : Type*} [comm_semiring R] [comm_semiring S] {σ : Type*} + +theorem polynomial_eval_eval₂ + (f : R →+* polynomial S) (g : σ → polynomial S) (p : mv_polynomial σ R) (x : S) : + polynomial.eval x (mv_polynomial.eval₂ f g p) = + mv_polynomial.eval₂ ((polynomial.eval_ring_hom x).comp f) (λ s, polynomial.eval x (g s)) p := +begin + apply mv_polynomial.induction_on p, + { simp }, + { intros p q hp hq, + simp [hp, hq], }, + { intros p n hp, + simp [hp], }, +end + +theorem eval_polynomial_eval_fin_succ_equiv {n : ℕ} + (f : mv_polynomial (fin (n + 1)) R) (q : mv_polynomial (fin n) R) (x : fin n → R) : + (eval x) (polynomial.eval q (fin_succ_equiv R n f)) = + eval (show fin (n+1) → R, from @fin.cases _ (λ _, R) (eval x q) x) f := +begin + simp only [fin_succ_equiv_apply, coe_eval₂_hom, eval_eval₂, polynomial_eval_eval₂], + have : (eval x).comp ((polynomial.eval_ring_hom q).comp (polynomial.C.comp C)) = ring_hom.id _, + { ext, simp, }, + simp only [this, eval₂_id], + congr, + funext i, + refine fin.cases (by simp) (by simp) i, +end + +end mv_polynomial diff --git a/src/data/mv_polynomial/rename.lean b/src/data/mv_polynomial/rename.lean index d4239c2e5f58b..95a4074a22682 100644 --- a/src/data/mv_polynomial/rename.lean +++ b/src/data/mv_polynomial/rename.lean @@ -9,6 +9,9 @@ import data.mv_polynomial.basic /-! # Renaming variables of polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file establishes the `rename` operation on multivariate polynomials, which modifies the set of variables. @@ -38,7 +41,7 @@ This will give rise to a monomial in `mv_polynomial σ R` which mathematicians m noncomputable theory -open_locale classical big_operators +open_locale big_operators open set function finsupp add_monoid_algebra open_locale big_operators @@ -182,6 +185,7 @@ end theorem exists_finset_rename (p : mv_polynomial σ R) : ∃ (s : finset σ) (q : mv_polynomial {x // x ∈ s} R), p = rename coe q := begin + classical, apply induction_on p, { intro r, exact ⟨∅, C r, by rw rename_C⟩ }, { rintro p q ⟨s, p, rfl⟩ ⟨t, q, rfl⟩, @@ -238,6 +242,7 @@ section coeff lemma coeff_rename_map_domain (f : σ → τ) (hf : injective f) (φ : mv_polynomial σ R) (d : σ →₀ ℕ) : (rename f φ).coeff (d.map_domain f) = φ.coeff d := begin + classical, apply induction_on' φ, { intros u r, rw [rename_monomial, coeff_monomial, coeff_monomial], @@ -249,6 +254,7 @@ lemma coeff_rename_eq_zero (f : σ → τ) (φ : mv_polynomial σ R) (d : τ → (h : ∀ u : σ →₀ ℕ, u.map_domain f = d → φ.coeff u = 0) : (rename f φ).coeff d = 0 := begin + classical, rw [rename_eq, ← not_mem_support_iff], intro H, replace H := map_domain_support H, @@ -277,7 +283,8 @@ end coeff section support -lemma support_rename_of_injective {p : mv_polynomial σ R} {f : σ → τ} (h : function.injective f) : +lemma support_rename_of_injective {p : mv_polynomial σ R} {f : σ → τ} [decidable_eq τ] + (h : function.injective f) : (rename f p).support = finset.image (map_domain f) p.support := begin rw rename_eq, diff --git a/src/data/mv_polynomial/supported.lean b/src/data/mv_polynomial/supported.lean index 74a8397d4e531..e1f5a2998ad54 100644 --- a/src/data/mv_polynomial/supported.lean +++ b/src/data/mv_polynomial/supported.lean @@ -8,6 +8,9 @@ import data.mv_polynomial.variables /-! # Polynomials supported by a set of variables +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains the definition and lemmas about `mv_polynomial.supported`. ## Main definitions @@ -35,7 +38,6 @@ algebra.adjoin R (X '' s) variables {σ R} -open_locale classical open algebra lemma supported_eq_range_rename (s : set σ) : @@ -64,6 +66,7 @@ variables {s t : set σ} lemma mem_supported : p ∈ (supported R s) ↔ ↑p.vars ⊆ s := begin + classical, rw [supported_eq_range_rename, alg_hom.mem_range], split, { rintros ⟨p, rfl⟩, diff --git a/src/data/mv_polynomial/variables.lean b/src/data/mv_polynomial/variables.lean index 69faa0d35d8e0..9fd1ca013972e 100644 --- a/src/data/mv_polynomial/variables.lean +++ b/src/data/mv_polynomial/variables.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro -/ import algebra.big_operators.order -import data.mv_polynomial.monad +import data.mv_polynomial.rename /-! # Degrees and variables of polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file establishes many results about the degree and variable sets of a multivariate polynomial. The *variable set* of a polynomial $P \in R[X]$ is a `finset` containing each $x \in X$ @@ -55,8 +58,6 @@ This will give rise to a monomial in `mv_polynomial σ R` which mathematicians m noncomputable theory -open_locale classical big_operators - open set function finsupp add_monoid_algebra open_locale big_operators @@ -80,11 +81,15 @@ The maximal degrees of each variable in a multi-variable polynomial, expressed a (For example, `degrees (x^2 * y + y^3)` would be `{x, x, y, y, y}`.) -/ def degrees (p : mv_polynomial σ R) : multiset σ := -p.support.sup (λs:σ →₀ ℕ, s.to_multiset) +by letI := classical.dec_eq σ; exact p.support.sup (λs:σ →₀ ℕ, s.to_multiset) + +lemma degrees_def [decidable_eq σ] (p : mv_polynomial σ R) : + p.degrees = p.support.sup (λs:σ →₀ ℕ, s.to_multiset) := by convert rfl lemma degrees_monomial (s : σ →₀ ℕ) (a : R) : degrees (monomial s a) ≤ s.to_multiset := -finset.sup_le $ assume t h, begin + classical, + refine (finset.sup_le $ assume t h, _), have := finsupp.support_single_subset h, rw [finset.mem_singleton] at this, rw this @@ -92,8 +97,11 @@ end lemma degrees_monomial_eq (s : σ →₀ ℕ) (a : R) (ha : a ≠ 0) : degrees (monomial s a) = s.to_multiset := -le_antisymm (degrees_monomial s a) $ finset.le_sup $ - by rw [support_monomial, if_neg ha, finset.mem_singleton] +begin + classical, + refine (le_antisymm (degrees_monomial s a) $ finset.le_sup $ _), + rw [support_monomial, if_neg ha, finset.mem_singleton] +end lemma degrees_C (a : R) : degrees (C a : mv_polynomial σ R) = 0 := multiset.le_zero.1 $ degrees_monomial _ _ @@ -109,8 +117,11 @@ by { rw ← C_0, exact degrees_C 0 } @[simp] lemma degrees_one : degrees (1 : mv_polynomial σ R) = 0 := degrees_C 1 -lemma degrees_add (p q : mv_polynomial σ R) : (p + q).degrees ≤ p.degrees ⊔ q.degrees := +lemma degrees_add [decidable_eq σ] (p q : mv_polynomial σ R) : + (p + q).degrees ≤ p.degrees ⊔ q.degrees := begin + classical, + simp_rw degrees_def, refine finset.sup_le (assume b hb, _), have := finsupp.support_add hb, rw finset.mem_union at this, cases this, @@ -118,9 +129,10 @@ begin { exact le_sup_of_le_right (finset.le_sup this) }, end -lemma degrees_sum {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) : +lemma degrees_sum {ι : Type*} [decidable_eq σ] (s : finset ι) (f : ι → mv_polynomial σ R) : (∑ i in s, f i).degrees ≤ s.sup (λi, (f i).degrees) := begin + classical, refine s.induction _ _, { simp only [finset.sum_empty, finset.sup_empty, degrees_zero], exact le_rfl }, { assume i s his ih, @@ -130,6 +142,7 @@ end lemma degrees_mul (p q : mv_polynomial σ R) : (p * q).degrees ≤ p.degrees + q.degrees := begin + classical, refine finset.sup_le (assume b hb, _), have := support_mul p q hb, simp only [finset.mem_bUnion, finset.mem_singleton] at this, @@ -141,6 +154,7 @@ end lemma degrees_prod {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) : (∏ i in s, f i).degrees ≤ ∑ i in s, (f i).degrees := begin + classical, refine s.induction _ _, { simp only [finset.prod_empty, finset.sum_empty, degrees_one] }, { assume i s his ih, @@ -162,6 +176,7 @@ by simp only [degrees, multiset.mem_sup, ← mem_support_iff, lemma le_degrees_add {p q : mv_polynomial σ R} (h : p.degrees.disjoint q.degrees) : p.degrees ≤ (p + q).degrees := begin + classical, apply finset.sup_le, intros d hd, rw multiset.disjoint_iff_ne at h, @@ -183,7 +198,7 @@ begin all_goals { rw mem_degrees, refine ⟨d, _, hj⟩, assumption } } end -lemma degrees_add_of_disjoint +lemma degrees_add_of_disjoint [decidable_eq σ] {p q : mv_polynomial σ R} (h : multiset.disjoint p.degrees q.degrees) : (p + q).degrees = p.degrees ∪ q.degrees := begin @@ -206,6 +221,7 @@ end lemma degrees_rename (f : σ → τ) (φ : mv_polynomial σ R) : (rename f φ).degrees ⊆ (φ.degrees.map f) := begin + classical, intros i, rw [mem_degrees, multiset.mem_map], rintro ⟨d, hd, hi⟩, @@ -227,6 +243,7 @@ by simp only [degrees, mv_polynomial.support_map_of_injective _ hf] lemma degrees_rename_of_injective {p : mv_polynomial σ R} {f : σ → τ} (h : function.injective f) : degrees (rename f p) = (degrees p).map f := begin + classical, simp only [degrees, multiset.map_finset_sup p.support finsupp.to_multiset f h, support_rename_of_injective h, finset.sup_image], refine finset.sup_congr rfl (λ x hx, _), @@ -240,19 +257,23 @@ section vars /-! ### `vars` -/ /-- `vars p` is the set of variables appearing in the polynomial `p` -/ -def vars (p : mv_polynomial σ R) : finset σ := p.degrees.to_finset +def vars (p : mv_polynomial σ R) : finset σ := +by letI := classical.dec_eq σ; exact p.degrees.to_finset + +lemma vars_def [decidable_eq σ] (p : mv_polynomial σ R) : p.vars = p.degrees.to_finset := +by convert rfl @[simp] lemma vars_0 : (0 : mv_polynomial σ R).vars = ∅ := -by rw [vars, degrees_zero, multiset.to_finset_zero] +by classical; rw [vars_def, degrees_zero, multiset.to_finset_zero] @[simp] lemma vars_monomial (h : r ≠ 0) : (monomial s r).vars = s.support := -by rw [vars, degrees_monomial_eq _ _ h, finsupp.to_finset_to_multiset] +by classical; rw [vars_def, degrees_monomial_eq _ _ h, finsupp.to_finset_to_multiset] @[simp] lemma vars_C : (C r : mv_polynomial σ R).vars = ∅ := -by rw [vars, degrees_C, multiset.to_finset_zero] +by classical; rw [vars_def, degrees_C, multiset.to_finset_zero] @[simp] lemma vars_X [nontrivial R] : (X n : mv_polynomial σ R).vars = {n} := -by rw [X, vars_monomial (@one_ne_zero R _ _), finsupp.support_single_ne_zero (one_ne_zero : 1 ≠ 0)] +by rw [X, vars_monomial (one_ne_zero' R), finsupp.support_single_ne_zero _ (one_ne_zero' ℕ)] lemma mem_vars (i : σ) : i ∈ p.vars ↔ ∃ (d : σ →₀ ℕ) (H : d ∈ p.support), i ∈ d.support := @@ -263,10 +284,11 @@ lemma mem_support_not_mem_vars_zero {f : mv_polynomial σ R} {x : σ →₀ ℕ} (H : x ∈ f.support) {v : σ} (h : v ∉ vars f) : x v = 0 := begin - rw [vars, multiset.mem_to_finset] at h, + letI := classical.dec_eq σ, + rw [vars_def, multiset.mem_to_finset] at h, rw ← finsupp.not_mem_support_iff, contrapose! h, - unfold degrees, + rw degrees_def, rw (show f.support = insert x f.support, from eq.symm $ finset.insert_eq_of_mem H), rw finset.sup_insert, simp only [multiset.mem_union, multiset.sup_eq_union], @@ -274,7 +296,7 @@ begin rwa [←to_finset_to_multiset, multiset.mem_to_finset] at h, end -lemma vars_add_subset (p q : mv_polynomial σ R) : +lemma vars_add_subset [decidable_eq σ] (p q : mv_polynomial σ R) : (p + q).vars ⊆ p.vars ∪ q.vars := begin intros x hx, @@ -282,19 +304,19 @@ begin simpa using multiset.mem_of_le (degrees_add _ _) hx, end -lemma vars_add_of_disjoint (h : disjoint p.vars q.vars) : +lemma vars_add_of_disjoint [decidable_eq σ] (h : disjoint p.vars q.vars) : (p + q).vars = p.vars ∪ q.vars := begin apply finset.subset.antisymm (vars_add_subset p q), intros x hx, - simp only [vars, multiset.disjoint_to_finset] at h hx ⊢, + simp only [vars_def, multiset.disjoint_to_finset] at h hx ⊢, rw [degrees_add_of_disjoint h, multiset.to_finset_union], exact hx end section mul -lemma vars_mul (φ ψ : mv_polynomial σ R) : (φ * ψ).vars ⊆ φ.vars ∪ ψ.vars := +lemma vars_mul [decidable_eq σ] (φ ψ : mv_polynomial σ R) : (φ * ψ).vars ⊆ φ.vars ∪ ψ.vars := begin intro i, simp only [mem_vars, finset.mem_union], @@ -318,6 +340,8 @@ vars_C lemma vars_pow (φ : mv_polynomial σ R) (n : ℕ) : (φ ^ n).vars ⊆ φ.vars := begin + classical, + simp_rw vars_def, induction n with n ih, { simp }, { rw pow_succ, @@ -329,9 +353,10 @@ end The variables of the product of a family of polynomials are a subset of the union of the sets of variables of each polynomial. -/ -lemma vars_prod {ι : Type*} {s : finset ι} (f : ι → mv_polynomial σ R) : +lemma vars_prod {ι : Type*} [decidable_eq σ] {s : finset ι} (f : ι → mv_polynomial σ R) : (∏ i in s, f i).vars ⊆ s.bUnion (λ i, (f i).vars) := begin + classical, apply s.induction_on, { simp }, { intros a s hs hsub, @@ -361,9 +386,10 @@ section sum variables {ι : Type*} (t : finset ι) (φ : ι → mv_polynomial σ R) -lemma vars_sum_subset : +lemma vars_sum_subset [decidable_eq σ] : (∑ i in t, φ i).vars ⊆ finset.bUnion t (λ i, (φ i).vars) := begin + classical, apply t.induction_on, { simp }, { intros a s has hsum, @@ -373,9 +399,10 @@ begin assumption } end -lemma vars_sum_of_disjoint (h : pairwise $ disjoint on (λ i, (φ i).vars)) : +lemma vars_sum_of_disjoint [decidable_eq σ] (h : pairwise $ disjoint on (λ i, (φ i).vars)) : (∑ i in t, φ i).vars = finset.bUnion t (λ i, (φ i).vars) := begin + classical, apply t.induction_on, { simp }, { intros a s has hsum, @@ -386,7 +413,7 @@ begin intros v hv v2 hv2, rw finset.mem_bUnion at hv2, rcases hv2 with ⟨i, his, hi⟩, - refine h a i _ _ hv _ hi, + refine h _ _ hv _ hi, rintro rfl, contradiction } end @@ -408,9 +435,9 @@ by simp [vars, degrees_map_of_injective _ hf] lemma vars_monomial_single (i : σ) {e : ℕ} {r : R} (he : e ≠ 0) (hr : r ≠ 0) : (monomial (finsupp.single i e) r).vars = {i} := -by rw [vars_monomial hr, finsupp.support_single_ne_zero he] +by rw [vars_monomial hr, finsupp.support_single_ne_zero _ he] -lemma vars_eq_support_bUnion_support : p.vars = p.support.bUnion finsupp.support := +lemma vars_eq_support_bUnion_support [decidable_eq σ] : p.vars = p.support.bUnion finsupp.support := by { ext i, rw [mem_vars, finset.mem_bUnion] } end map @@ -422,12 +449,18 @@ section degree_of /-! ### `degree_of` -/ /-- `degree_of n p` gives the highest power of X_n that appears in `p` -/ -def degree_of (n : σ) (p : mv_polynomial σ R) : ℕ := p.degrees.count n +def degree_of (n : σ) (p : mv_polynomial σ R) : ℕ := +by letI := classical.dec_eq σ; exact p.degrees.count n + +lemma degree_of_def [decidable_eq σ] (n : σ) (p : mv_polynomial σ R) : + p.degree_of n = p.degrees.count n := +by convert rfl lemma degree_of_eq_sup (n : σ) (f : mv_polynomial σ R) : degree_of n f = f.support.sup (λ m, m n) := begin - rw [degree_of, degrees, multiset.count_finset_sup], + classical, + rw [degree_of_def, degrees_def, multiset.count_finset_sup], congr, ext, simp, @@ -444,7 +477,7 @@ by simp only [degree_of, degrees_zero, multiset.count_zero] @[simp] lemma degree_of_C (a : R) (x : σ): degree_of x (C a : mv_polynomial σ R) = 0 := by simp [degree_of, degrees_C] -lemma degree_of_X (i j : σ) [nontrivial R] : +lemma degree_of_X [decidable_eq σ] (i j : σ) [nontrivial R] : degree_of i (X j : mv_polynomial σ R) = if i = j then 1 else 0 := begin by_cases c : i = j, @@ -455,7 +488,8 @@ end lemma degree_of_add_le (n : σ) (f g : mv_polynomial σ R) : degree_of n (f + g) ≤ max (degree_of n f) (degree_of n g) := begin - repeat {rw degree_of}, + classical, + repeat {rw degree_of_def}, apply (multiset.count_le_of_le n (degrees_add f g)).trans, dsimp, rw multiset.count_union, @@ -472,7 +506,8 @@ end lemma degree_of_mul_le (i : σ) (f g: mv_polynomial σ R) : degree_of i (f * g) ≤ degree_of i f + degree_of i g := begin - repeat {rw degree_of}, + classical, + repeat {rw degree_of_def}, convert multiset.count_le_of_le i (degrees_mul f g), rw multiset.count_add, end @@ -480,21 +515,22 @@ end lemma degree_of_mul_X_ne {i j : σ} (f : mv_polynomial σ R) (h : i ≠ j) : degree_of i (f * X j) = degree_of i f := begin + classical, repeat {rw degree_of_eq_sup i}, rw support_mul_X, simp only [finset.sup_map], congr, ext, - simp only [ single, nat.one_ne_zero, add_right_eq_self, add_right_embedding_apply, coe_mk, - pi.add_apply, comp_app, ite_eq_right_iff, coe_add ], - cc, + simp only [single, nat.one_ne_zero, add_right_eq_self, add_right_embedding_apply, coe_mk, + pi.add_apply, comp_app, ite_eq_right_iff, finsupp.coe_add, pi.single_eq_of_ne h], end /- TODO in the following we have equality iff f ≠ 0 -/ lemma degree_of_mul_X_eq (j : σ) (f : mv_polynomial σ R) : degree_of j (f * X j) ≤ degree_of j f + 1 := begin - repeat {rw degree_of}, + classical, + repeat {rw degree_of_def}, apply (multiset.count_le_of_le j (degrees_mul f (X j))).trans, simp only [multiset.count_add, add_le_add_iff_left], convert multiset.count_le_of_le j (degrees_X' j), @@ -503,8 +539,8 @@ end lemma degree_of_rename_of_injective {p : mv_polynomial σ R} {f : σ → τ} (h : function.injective f) (i : σ) : degree_of (f i) (rename f p) = degree_of i p := -by simp only [degree_of, degrees_rename_of_injective h, - multiset.count_map_eq_count' f (p.degrees) h] +by classical; simp only [degree_of_def, degrees_rename_of_injective h, + multiset.count_map_eq_count' f (p.degrees) h] end degree_of @@ -526,6 +562,7 @@ end lemma total_degree_le_degrees_card (p : mv_polynomial σ R) : p.total_degree ≤ p.degrees.card := begin + classical, rw [total_degree_eq], exact finset.sup_le (assume s hs, multiset.card_le_of_le $ finset.le_sup hs) end @@ -555,8 +592,9 @@ end lemma total_degree_add (a b : mv_polynomial σ R) : (a + b).total_degree ≤ max a.total_degree b.total_degree := finset.sup_le $ assume n hn, - have _ := finsupp.support_add hn, begin + classical, + have := finsupp.support_add hn, rw finset.mem_union at this, cases this, { exact le_max_of_le_left (finset.le_sup this) }, @@ -593,8 +631,9 @@ by rw [add_comm, total_degree_add_eq_left_of_total_degree_lt h] lemma total_degree_mul (a b : mv_polynomial σ R) : (a * b).total_degree ≤ a.total_degree + b.total_degree := finset.sup_le $ assume n hn, - have _ := add_monoid_algebra.support_mul a b hn, begin + classical, + have := add_monoid_algebra.support_mul a b hn, simp only [finset.mem_bUnion, finset.mem_singleton] at this, rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩, rw [finsupp.sum_add_index'], @@ -603,6 +642,11 @@ finset.sup_le $ assume n hn, { assume a b₁ b₂, refl } end +lemma total_degree_smul_le [comm_semiring S] [distrib_mul_action R S] (a : R) + (f : mv_polynomial σ S) : + (a • f).total_degree ≤ f.total_degree := +finset.sup_mono support_smul + lemma total_degree_pow (a : mv_polynomial σ R) (n : ℕ) : (a ^ n).total_degree ≤ n * a.total_degree := begin @@ -616,7 +660,7 @@ end @[simp] lemma total_degree_monomial (s : σ →₀ ℕ) {c : R} (hc : c ≠ 0) : (monomial s c : mv_polynomial σ R).total_degree = s.sum (λ _ e, e) := -by simp [total_degree, support_monomial, if_neg hc] +by classical; simp [total_degree, support_monomial, if_neg hc] @[simp] lemma total_degree_X_pow [nontrivial R] (s : σ) (n : ℕ) : (X s ^ n : mv_polynomial σ R).total_degree = n := @@ -686,6 +730,7 @@ finset.sup_le $ assume b, begin assume h, rw rename_eq at h, + classical, have h' := finsupp.map_domain_support h, rw finset.mem_image at h', rcases h' with ⟨s, hs, rfl⟩, @@ -769,7 +814,7 @@ lemma exists_rename_eq_of_vars_subset_range (p : mv_polynomial σ R) (f : τ → σ) (hfi : injective f) (hf : ↑p.vars ⊆ set.range f) : ∃ q : mv_polynomial τ R, rename f q = p := -⟨bind₁ (λ i : σ, option.elim (partial_inv f i) 0 X) p, +⟨aeval (λ i : σ, option.elim 0 X $ partial_inv f i) p, begin show (rename f).to_ring_hom.comp _ p = ring_hom.id _ p, refine hom_congr_vars _ _ _, @@ -781,41 +826,7 @@ lemma exists_rename_eq_of_vars_subset_range { refl } end⟩ -lemma vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) : - (bind₁ f φ).vars ⊆ φ.vars.bUnion (λ i, (f i).vars) := -begin - calc (bind₁ f φ).vars - = (φ.support.sum (λ (x : σ →₀ ℕ), (bind₁ f) (monomial x (coeff x φ)))).vars : - by { rw [← alg_hom.map_sum, ← φ.as_sum], } - ... ≤ φ.support.bUnion (λ (i : σ →₀ ℕ), ((bind₁ f) (monomial i (coeff i φ))).vars) : - vars_sum_subset _ _ - ... = φ.support.bUnion (λ (d : σ →₀ ℕ), (C (coeff d φ) * ∏ i in d.support, f i ^ d i).vars) : - by simp only [bind₁_monomial] - ... ≤ φ.support.bUnion (λ (d : σ →₀ ℕ), d.support.bUnion (λ i, (f i).vars)) : _ -- proof below - ... ≤ φ.vars.bUnion (λ (i : σ), (f i).vars) : _, -- proof below - { apply finset.bUnion_mono, - intros d hd, - calc (C (coeff d φ) * ∏ (i : σ) in d.support, f i ^ d i).vars - ≤ (C (coeff d φ)).vars ∪ (∏ (i : σ) in d.support, f i ^ d i).vars : vars_mul _ _ - ... ≤ (∏ (i : σ) in d.support, f i ^ d i).vars : - by simp only [finset.empty_union, vars_C, finset.le_iff_subset, finset.subset.refl] - ... ≤ d.support.bUnion (λ (i : σ), (f i ^ d i).vars) : vars_prod _ - ... ≤ d.support.bUnion (λ (i : σ), (f i).vars) : _, - apply finset.bUnion_mono, - intros i hi, - apply vars_pow, }, - { intro j, - simp_rw finset.mem_bUnion, - rintro ⟨d, hd, ⟨i, hi, hj⟩⟩, - exact ⟨i, (mem_vars _).mpr ⟨d, hd, hi⟩, hj⟩ } -end - -lemma mem_vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) {j : τ} - (h : j ∈ (bind₁ f φ).vars) : - ∃ (i : σ), i ∈ φ.vars ∧ j ∈ (f i).vars := -by simpa only [exists_prop, finset.mem_bUnion, mem_support_iff, ne.def] using vars_bind₁ f φ h - -lemma vars_rename (f : σ → τ) (φ : mv_polynomial σ R) : +lemma vars_rename [decidable_eq τ] (f : σ → τ) (φ : mv_polynomial σ R) : (rename f φ).vars ⊆ (φ.vars.image f) := begin intros i hi, @@ -825,7 +836,7 @@ end lemma mem_vars_rename (f : σ → τ) (φ : mv_polynomial σ R) {j : τ} (h : j ∈ (rename f φ).vars) : ∃ (i : σ), i ∈ φ.vars ∧ f i = j := -by simpa only [exists_prop, finset.mem_image] using vars_rename f φ h +by classical; simpa only [exists_prop, finset.mem_image] using vars_rename f φ h end eval_vars diff --git a/src/data/nat/basic.lean b/src/data/nat/basic.lean index 739da4899d94f..21a13844f3805 100644 --- a/src/data/nat/basic.lean +++ b/src/data/nat/basic.lean @@ -3,11 +3,16 @@ Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights r Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import algebra.order.ring +import order.basic +import algebra.group_with_zero.basic +import algebra.ring.defs /-! # Basic operations on the natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains: - instances on the natural numbers - some basic lemmas about natural numbers @@ -18,6 +23,12 @@ This file contains: * `strong_rec'`: recursion based on strong inequalities - decidability instances on predicates about the natural numbers +Many theorems that used to live in this file have been moved to `data.nat.order`, +so that this file requires fewer imports. +For each section here there is a corresponding section in that file with additional results. +It may be possible to move some of these results here, by tweaking their proofs. + + -/ universes u v @@ -27,7 +38,7 @@ universes u v instance : nontrivial ℕ := ⟨⟨0, 1, nat.zero_ne_one⟩⟩ -instance : comm_semiring nat := +instance : comm_semiring ℕ := { add := nat.add, add_assoc := nat.add_assoc, zero := nat.zero, @@ -44,89 +55,33 @@ instance : comm_semiring nat := zero_mul := nat.zero_mul, mul_zero := nat.mul_zero, mul_comm := nat.mul_comm, + nat_cast := λ n, n, + nat_cast_zero := rfl, + nat_cast_succ := λ n, rfl, nsmul := λ m n, m * n, nsmul_zero' := nat.zero_mul, nsmul_succ' := λ n x, by rw [nat.succ_eq_add_one, nat.add_comm, nat.right_distrib, nat.one_mul] } -instance : linear_ordered_semiring nat := -{ add_left_cancel := @nat.add_left_cancel, - lt := nat.lt, - add_le_add_left := @nat.add_le_add_left, - le_of_add_le_add_left := @nat.le_of_add_le_add_left, - zero_le_one := nat.le_of_lt (nat.zero_lt_succ 0), - mul_lt_mul_of_pos_left := @nat.mul_lt_mul_of_pos_left, - mul_lt_mul_of_pos_right := @nat.mul_lt_mul_of_pos_right, - decidable_eq := nat.decidable_eq, - exists_pair_ne := ⟨0, 1, ne_of_lt nat.zero_lt_one⟩, - ..nat.comm_semiring, ..nat.linear_order } - --- all the fields are already included in the linear_ordered_semiring instance -instance : linear_ordered_cancel_add_comm_monoid ℕ := -{ add_left_cancel := @nat.add_left_cancel, - ..nat.linear_ordered_semiring } - -instance : linear_ordered_comm_monoid_with_zero ℕ := -{ mul_le_mul_left := λ a b h c, nat.mul_le_mul_left c h, - ..nat.linear_ordered_semiring, - ..(infer_instance : comm_monoid_with_zero ℕ)} - -instance : ordered_comm_semiring ℕ := { .. nat.comm_semiring, .. nat.linear_ordered_semiring } - -/-! Extra instances to short-circuit type class resolution -/ -instance : add_comm_monoid nat := by apply_instance -instance : add_monoid nat := by apply_instance -instance : monoid nat := by apply_instance -instance : comm_monoid nat := by apply_instance -instance : comm_semigroup nat := by apply_instance -instance : semigroup nat := by apply_instance -instance : add_comm_semigroup nat := by apply_instance -instance : add_semigroup nat := by apply_instance -instance : distrib nat := by apply_instance -instance : semiring nat := by apply_instance -instance : ordered_semiring nat := by apply_instance - -instance nat.order_bot : order_bot ℕ := -{ bot := 0, bot_le := nat.zero_le } - -instance : canonically_ordered_comm_semiring ℕ := -{ le_iff_exists_add := λ a b, ⟨λ h, let ⟨c, hc⟩ := nat.le.dest h in ⟨c, hc.symm⟩, - λ ⟨c, hc⟩, hc.symm ▸ nat.le_add_right _ _⟩, - eq_zero_or_eq_zero_of_mul_eq_zero := λ a b, nat.eq_zero_of_mul_eq_zero, - .. nat.nontrivial, - .. nat.order_bot, - .. (infer_instance : ordered_add_comm_monoid ℕ), - .. (infer_instance : linear_ordered_semiring ℕ), - .. (infer_instance : comm_semiring ℕ) } - -instance : canonically_linear_ordered_add_monoid ℕ := -{ .. (infer_instance : canonically_ordered_add_monoid ℕ), - .. nat.linear_order } - -instance nat.subtype.order_bot (s : set ℕ) [decidable_pred (∈ s)] [h : nonempty s] : - order_bot s := -{ bot := ⟨nat.find (nonempty_subtype.1 h), nat.find_spec (nonempty_subtype.1 h)⟩, - bot_le := λ x, nat.find_min' _ x.2 } - -instance nat.subtype.semilattice_sup (s : set ℕ) : - semilattice_sup s := -{ ..subtype.linear_order s, - ..linear_order.to_lattice } - -lemma nat.subtype.coe_bot {s : set ℕ} [decidable_pred (∈ s)] - [h : nonempty s] : ((⊥ : s) : ℕ) = nat.find (nonempty_subtype.1 h) := rfl +/-! Extra instances to short-circuit type class resolution and ensure computability -/ -protected lemma nat.nsmul_eq_mul (m n : ℕ) : m • n = m * n := rfl +instance : add_comm_monoid ℕ := infer_instance +instance : add_monoid ℕ := infer_instance +instance : monoid ℕ := infer_instance +instance : comm_monoid ℕ := infer_instance +instance : comm_semigroup ℕ := infer_instance +instance : semigroup ℕ := infer_instance +instance : add_comm_semigroup ℕ := infer_instance +instance : add_semigroup ℕ := infer_instance +instance : distrib ℕ := infer_instance +instance : semiring ℕ := infer_instance -theorem nat.eq_of_mul_eq_mul_right {n m k : ℕ} (Hm : 0 < m) (H : n * m = k * m) : n = k := -by rw [mul_comm n m, mul_comm k m] at H; exact nat.eq_of_mul_eq_mul_left Hm H +protected lemma nat.nsmul_eq_mul (m n : ℕ) : m • n = m * n := rfl instance nat.cancel_comm_monoid_with_zero : cancel_comm_monoid_with_zero ℕ := { mul_left_cancel_of_ne_zero := λ _ _ _ h1 h2, nat.eq_of_mul_eq_mul_left (nat.pos_of_ne_zero h1) h2, - mul_right_cancel_of_ne_zero := - λ _ _ _ h1 h2, nat.eq_of_mul_eq_mul_right (nat.pos_of_ne_zero h1) h2, - .. (infer_instance : comm_monoid_with_zero ℕ) } + .. nat.comm_semiring } attribute [simp] nat.not_lt_zero nat.succ_ne_zero nat.succ_ne_self nat.zero_ne_one nat.one_ne_zero @@ -134,157 +89,23 @@ attribute [simp] nat.not_lt_zero nat.succ_ne_zero nat.succ_ne_self nat.bit0_ne_one nat.one_ne_bit0 nat.bit0_ne_bit1 nat.bit1_ne_bit0 -/-! -Inject some simple facts into the type class system. -This `fact` should not be confused with the factorial function `nat.fact`! --/ -section facts - -instance succ_pos'' (n : ℕ) : fact (0 < n.succ) := ⟨n.succ_pos⟩ - -instance pos_of_one_lt (n : ℕ) [h : fact (1 < n)] : fact (0 < n) := -⟨lt_trans zero_lt_one h.1⟩ - -end facts - variables {m n k : ℕ} namespace nat /-! -### Recursion and `set.range` +### Recursion and `forall`/`exists` -/ -section set - -open set - -theorem zero_union_range_succ : {0} ∪ range succ = univ := -by { ext n, cases n; simp } - -variables {α : Type*} - -theorem range_of_succ (f : ℕ → α) : {f 0} ∪ range (f ∘ succ) = range f := -by rw [← image_singleton, range_comp, ← image_union, zero_union_range_succ, image_univ] - -theorem range_rec {α : Type*} (x : α) (f : ℕ → α → α) : - (set.range (λ n, nat.rec x f n) : set α) = - {x} ∪ set.range (λ n, nat.rec (f 0 x) (f ∘ succ) n) := -begin - convert (range_of_succ _).symm, - ext n, - induction n with n ihn, - { refl }, - { dsimp at ihn ⊢, - rw ihn } -end - -theorem range_cases_on {α : Type*} (x : α) (f : ℕ → α) : - (set.range (λ n, nat.cases_on n x f) : set α) = {x} ∪ set.range f := -(range_of_succ _).symm - -end set - -/-! ### The units of the natural numbers as a `monoid` and `add_monoid` -/ - -theorem units_eq_one (u : ℕˣ) : u = 1 := -units.ext $ nat.eq_one_of_dvd_one ⟨u.inv, u.val_inv.symm⟩ - -theorem add_units_eq_zero (u : add_units ℕ) : u = 0 := -add_units.ext $ (nat.eq_zero_of_add_eq_zero u.val_neg).1 - -@[simp] protected theorem is_unit_iff {n : ℕ} : is_unit n ↔ n = 1 := -iff.intro - (λ ⟨u, hu⟩, match n, u, hu, nat.units_eq_one u with _, _, rfl, rfl := rfl end) - (λ h, h.symm ▸ ⟨1, rfl⟩) - -instance unique_units : unique ℕˣ := -{ default := 1, uniq := nat.units_eq_one } - -instance unique_add_units : unique (add_units ℕ) := -{ default := 0, uniq := nat.add_units_eq_zero } - -/-! ### Equalities and inequalities involving zero and one -/ - -lemma one_le_iff_ne_zero {n : ℕ} : 1 ≤ n ↔ n ≠ 0 := -(show 1 ≤ n ↔ 0 < n, from iff.rfl).trans pos_iff_ne_zero +@[simp] lemma and_forall_succ {p : ℕ → Prop} : (p 0 ∧ ∀ n, p (n + 1)) ↔ ∀ n, p n := +⟨λ h n, nat.cases_on n h.1 h.2, λ h, ⟨h _, λ n, h _⟩⟩ -lemma one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1 -| 0 := dec_trivial -| 1 := dec_trivial -| (n+2) := dec_trivial - -protected theorem mul_ne_zero {n m : ℕ} (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0 -| nm := (eq_zero_of_mul_eq_zero nm).elim n0 m0 - -@[simp] protected theorem mul_eq_zero {a b : ℕ} : a * b = 0 ↔ a = 0 ∨ b = 0 := -iff.intro eq_zero_of_mul_eq_zero (by simp [or_imp_distrib] {contextual := tt}) - -@[simp] protected theorem zero_eq_mul {a b : ℕ} : 0 = a * b ↔ a = 0 ∨ b = 0 := -by rw [eq_comm, nat.mul_eq_zero] - -lemma eq_zero_of_double_le {a : ℕ} (h : 2 * a ≤ a) : a = 0 := -add_right_eq_self.mp $ le_antisymm ((two_mul a).symm.trans_le h) le_add_self - -lemma eq_zero_of_mul_le {a b : ℕ} (hb : 2 ≤ b) (h : b * a ≤ a) : a = 0 := -eq_zero_of_double_le $ le_trans (nat.mul_le_mul_right _ hb) h - -theorem le_zero_iff {i : ℕ} : i ≤ 0 ↔ i = 0 := -⟨nat.eq_zero_of_le_zero, λ h, h ▸ le_refl i⟩ - -lemma zero_max {m : ℕ} : max 0 m = m := -max_eq_right (zero_le _) - -@[simp] lemma min_eq_zero_iff {m n : ℕ} : min m n = 0 ↔ m = 0 ∨ n = 0 := -begin - split, - { intro h, - cases le_total n m with H H, - { simpa [H] using or.inr h }, - { simpa [H] using or.inl h } }, - { rintro (rfl|rfl); - simp } -end - -@[simp] lemma max_eq_zero_iff {m n : ℕ} : max m n = 0 ↔ m = 0 ∧ n = 0 := -begin - split, - { intro h, - cases le_total n m with H H, - { simp only [H, max_eq_left] at h, - exact ⟨h, le_antisymm (H.trans h.le) (zero_le _)⟩ }, - { simp only [H, max_eq_right] at h, - exact ⟨le_antisymm (H.trans h.le) (zero_le _), h⟩ } }, - { rintro ⟨rfl, rfl⟩, - simp } -end - -lemma add_eq_max_iff {n m : ℕ} : - n + m = max n m ↔ n = 0 ∨ m = 0 := -begin - rw ←min_eq_zero_iff, - cases le_total n m with H H; - simp [H] -end - -lemma add_eq_min_iff {n m : ℕ} : - n + m = min n m ↔ n = 0 ∧ m = 0 := -begin - rw ←max_eq_zero_iff, - cases le_total n m with H H; - simp [H] -end - -lemma one_le_of_lt {n m : ℕ} (h : n < m) : 1 ≤ m := -lt_of_le_of_lt (nat.zero_le _) h - -theorem eq_one_of_mul_eq_one_right {m n : ℕ} (H : m * n = 1) : m = 1 := -eq_one_of_dvd_one ⟨n, H.symm⟩ - -theorem eq_one_of_mul_eq_one_left {m n : ℕ} (H : m * n = 1) : n = 1 := -eq_one_of_mul_eq_one_right (by rwa mul_comm) +@[simp] lemma or_exists_succ {p : ℕ → Prop} : (p 0 ∨ ∃ n, p (n + 1)) ↔ ∃ n, p n := +⟨λ h, h.elim (λ h0, ⟨0, h0⟩) (λ ⟨n, hn⟩, ⟨n + 1, hn⟩), + by { rintro ⟨(_|n), hn⟩, exacts [or.inl hn, or.inr ⟨n, hn⟩]}⟩ /-! ### `succ` -/ + lemma _root_.has_lt.lt.nat_succ_le {n m : ℕ} (h : n < m) : succ n ≤ m := succ_le_of_lt h lemma succ_eq_one_add (n : ℕ) : n.succ = 1 + n := @@ -315,10 +136,6 @@ succ_ne_succ.mpr n.succ_ne_zero @[simp] lemma one_lt_succ_succ (n : ℕ) : 1 < n.succ.succ := succ_lt_succ $ succ_pos n -lemma two_le_iff : ∀ n, 2 ≤ n ↔ n ≠ 0 ∧ n ≠ 1 -| 0 := by simp -| 1 := by simp -| (n+2) := by simp theorem succ_le_succ_iff {m n : ℕ} : succ m ≤ succ n ↔ m ≤ n := ⟨le_of_succ_le_succ, succ_le_succ⟩ @@ -366,12 +183,9 @@ H.lt_or_eq_dec.imp le_of_lt_succ id lemma succ_lt_succ_iff {m n : ℕ} : succ m < succ n ↔ m < n := ⟨lt_of_succ_lt_succ, succ_lt_succ⟩ -@[simp] lemma lt_one_iff {n : ℕ} : n < 1 ↔ n = 0 := -lt_succ_iff.trans le_zero_iff - lemma div_le_iff_le_mul_add_pred {m n k : ℕ} (n0 : 0 < n) : m / n ≤ k ↔ m ≤ n * k + (n - 1) := begin - rw [← lt_succ_iff, div_lt_iff_lt_mul _ _ n0, succ_mul, mul_comm], + rw [← lt_succ_iff, div_lt_iff_lt_mul n0, succ_mul, mul_comm], cases n, {cases n0}, exact lt_succ_iff, end @@ -382,15 +196,10 @@ lemma two_lt_of_ne : ∀ {n}, n ≠ 0 → n ≠ 1 → n ≠ 2 → 2 < n | 2 _ _ h := (h rfl).elim | (n+3) _ _ _ := dec_trivial -theorem forall_lt_succ {P : ℕ → Prop} {n : ℕ} : (∀ m < n.succ, P m) ↔ (∀ m < n, P m) ∧ P n := -⟨λ H, ⟨λ m hm, H m (lt_succ_iff.2 hm.le), H n (lt_succ_self n)⟩, begin - rintro ⟨H, hn⟩ m hm, - rcases eq_or_lt_of_le (lt_succ_iff.1 hm) with rfl | hmn, - { exact hn }, - { exact H m hmn } -end⟩ +theorem forall_lt_succ {P : ℕ → Prop} {n : ℕ} : (∀ m < n + 1, P m) ↔ (∀ m < n, P m) ∧ P n := +by simp only [lt_succ_iff, decidable.le_iff_eq_or_lt, forall_eq_or_imp, and.comm] -theorem exists_lt_succ {P : ℕ → Prop} {n : ℕ} : (∃ m < n.succ, P m) ↔ (∃ m < n, P m) ∨ P n := +theorem exists_lt_succ {P : ℕ → Prop} {n : ℕ} : (∃ m < n + 1, P m) ↔ (∃ m < n, P m) ∨ P n := by { rw ←not_iff_not, push_neg, exact forall_lt_succ } /-! ### `add` -/ @@ -401,76 +210,14 @@ by { rw ←not_iff_not, push_neg, exact forall_lt_succ } @[simp] theorem add_def {a b : ℕ} : nat.add a b = a + b := rfl @[simp] theorem mul_def {a b : ℕ} : nat.mul a b = a * b := rfl -lemma exists_eq_add_of_le : ∀ {m n : ℕ}, m ≤ n → ∃ k : ℕ, n = m + k -| 0 0 h := ⟨0, by simp⟩ -| 0 (n+1) h := ⟨n+1, by simp⟩ -| (m+1) (n+1) h := - let ⟨k, hk⟩ := exists_eq_add_of_le (nat.le_of_succ_le_succ h) in - ⟨k, by simp [hk, add_comm, add_left_comm]⟩ - -lemma exists_eq_add_of_lt : ∀ {m n : ℕ}, m < n → ∃ k : ℕ, n = m + k + 1 -| 0 0 h := false.elim $ lt_irrefl _ h -| 0 (n+1) h := ⟨n, by simp⟩ -| (m+1) (n+1) h := let ⟨k, hk⟩ := exists_eq_add_of_le (nat.le_of_succ_le_succ h) in - ⟨k, by simp [hk]⟩ - -theorem add_pos_left {m : ℕ} (h : 0 < m) (n : ℕ) : 0 < m + n := -calc - m + n > 0 + n : nat.add_lt_add_right h n - ... = n : nat.zero_add n - ... ≥ 0 : zero_le n - -theorem add_pos_right (m : ℕ) {n : ℕ} (h : 0 < n) : 0 < m + n := -begin rw add_comm, exact add_pos_left h m end - -theorem add_pos_iff_pos_or_pos (m n : ℕ) : 0 < m + n ↔ 0 < m ∨ 0 < n := -iff.intro - begin - intro h, - cases m with m, - {simp [zero_add] at h, exact or.inr h}, - exact or.inl (succ_pos _) - end - begin - intro h, cases h with mpos npos, - { apply add_pos_left mpos }, - apply add_pos_right _ npos - end - -lemma add_eq_one_iff : ∀ {a b : ℕ}, a + b = 1 ↔ (a = 0 ∧ b = 1) ∨ (a = 1 ∧ b = 0) -| 0 0 := dec_trivial -| 1 0 := dec_trivial -| (a+2) _ := by rw add_right_comm; exact dec_trivial -| _ (b+1) := by rw [← add_assoc]; simp only [nat.succ_inj', nat.succ_ne_zero]; simp - -theorem le_add_one_iff {i j : ℕ} : i ≤ j + 1 ↔ (i ≤ j ∨ i = j + 1) := -⟨λ h, - match nat.eq_or_lt_of_le h with - | or.inl h := or.inr h - | or.inr h := or.inl $ nat.le_of_succ_le_succ h - end, - or.rec (λ h, le_trans h $ nat.le_add_right _ _) le_of_eq⟩ - -lemma le_and_le_add_one_iff {x a : ℕ} : - a ≤ x ∧ x ≤ a + 1 ↔ x = a ∨ x = a + 1 := -begin - rw [le_add_one_iff, and_or_distrib_left, ←le_antisymm_iff, eq_comm, and_iff_right_of_imp], - rintro rfl, - exact a.le_succ, -end - -lemma add_succ_lt_add {a b c d : ℕ} (hab : a < b) (hcd : c < d) : a + c + 1 < b + d := -begin - rw add_assoc, - exact add_lt_add_of_lt_of_le hab (nat.succ_le_iff.2 hcd) -end +lemma exists_eq_add_of_le (h : m ≤ n) : ∃ k : ℕ, n = m + k := +⟨n - m, (nat.add_sub_of_le h).symm⟩ --- TODO: generalize to some ordered add_monoids, based on #6145 -lemma le_of_add_le_left {a b c : ℕ} (h : a + b ≤ c) : a ≤ c := -by { refine le_trans _ h, simp } +lemma exists_eq_add_of_le' (h : m ≤ n) : ∃ k : ℕ, n = k + m := +⟨n - m, (nat.sub_add_cancel h).symm⟩ -lemma le_of_add_le_right {a b c : ℕ} (h : a + b ≤ c) : b ≤ c := -by { refine le_trans _ h, simp } +lemma exists_eq_add_of_lt (h : m < n) : ∃ k : ℕ, n = m + k + 1 := +⟨n - (m + 1), by rw [add_right_comm, nat.add_sub_of_le h]⟩ /-! ### `pred` -/ @@ -505,110 +252,21 @@ end @[simp] lemma pred_one_add (n : ℕ) : pred (1 + n) = n := by rw [add_comm, add_one, pred_succ] -lemma pred_le_iff {n m : ℕ} : pred n ≤ m ↔ n ≤ succ m := -⟨le_succ_of_pred_le, by { cases n, { exact λ h, zero_le m }, exact le_of_succ_le_succ }⟩ - -/-! ### `sub` - -Most lemmas come from the `has_ordered_sub` instance on `ℕ`. -/ - -instance : has_ordered_sub ℕ := -begin - constructor, - intros m n k, - induction n with n ih generalizing k, - { simp }, - { simp only [sub_succ, add_succ, succ_add, ih, pred_le_iff] } -end - -lemma lt_pred_iff {n m : ℕ} : n < pred m ↔ succ n < m := -show n < m - 1 ↔ n + 1 < m, from lt_tsub_iff_right - -lemma lt_of_lt_pred {a b : ℕ} (h : a < b - 1) : a < b := -lt_of_succ_lt (lt_pred_iff.1 h) - -lemma le_or_le_of_add_eq_add_pred {a b c d : ℕ} (h : c + d = a + b - 1) : a ≤ c ∨ b ≤ d := -begin - cases le_or_lt a c with h' h'; [left, right], - { exact h', }, - { replace h' := add_lt_add_right h' d, rw h at h', - cases b.eq_zero_or_pos with hb hb, { rw hb, exact zero_le d, }, - rw [a.add_sub_assoc hb, add_lt_add_iff_left] at h', - exact nat.le_of_pred_lt h', }, -end - -/-- A version of `nat.sub_succ` in the form `_ - 1` instead of `nat.pred _`. -/ -lemma sub_succ' (a b : ℕ) : a - b.succ = a - b - 1 := rfl - /-! ### `mul` -/ -lemma succ_mul_pos (m : ℕ) (hn : 0 < n) : 0 < (succ m) * n := -mul_pos (succ_pos m) hn - -theorem mul_self_le_mul_self {n m : ℕ} (h : n ≤ m) : n * n ≤ m * m := -decidable.mul_le_mul h h (zero_le _) (zero_le _) - -theorem mul_self_lt_mul_self : Π {n m : ℕ}, n < m → n * n < m * m -| 0 m h := mul_pos h h -| (succ n) m h := decidable.mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _) - -theorem mul_self_le_mul_self_iff {n m : ℕ} : n ≤ m ↔ n * n ≤ m * m := -⟨mul_self_le_mul_self, le_imp_le_of_lt_imp_lt mul_self_lt_mul_self⟩ - -theorem mul_self_lt_mul_self_iff {n m : ℕ} : n < m ↔ n * n < m * m := -le_iff_le_iff_lt_iff_lt.1 mul_self_le_mul_self_iff - -theorem le_mul_self : Π (n : ℕ), n ≤ n * n -| 0 := le_rfl -| (n+1) := let t := nat.mul_le_mul_left (n+1) (succ_pos n) in by simp at t; exact t - -lemma le_mul_of_pos_left {m n : ℕ} (h : 0 < n) : m ≤ n * m := -begin - conv {to_lhs, rw [← one_mul(m)]}, - exact decidable.mul_le_mul_of_nonneg_right h.nat_succ_le dec_trivial, -end - -lemma le_mul_of_pos_right {m n : ℕ} (h : 0 < n) : m ≤ m * n := -begin - conv {to_lhs, rw [← mul_one(m)]}, - exact decidable.mul_le_mul_of_nonneg_left h.nat_succ_le dec_trivial, -end theorem two_mul_ne_two_mul_add_one {n m} : 2 * n ≠ 2 * m + 1 := mt (congr_arg (%2)) (by { rw [add_comm, add_mul_mod_self_left, mul_mod_right, mod_eq_of_lt]; simp }) -lemma mul_eq_one_iff : ∀ {a b : ℕ}, a * b = 1 ↔ a = 1 ∧ b = 1 -| 0 0 := dec_trivial -| 0 1 := dec_trivial -| 1 0 := dec_trivial -| (a+2) 0 := by simp -| 0 (b+2) := by simp -| (a+1) (b+1) := ⟨ - λ h, by simp only [add_mul, mul_add, mul_add, one_mul, mul_one, - (add_assoc _ _ _).symm, nat.succ_inj', add_eq_zero_iff] at h; simp [h.1.2, h.2], - λ h, by simp only [h, mul_one]⟩ - -protected theorem mul_left_inj {a b c : ℕ} (ha : 0 < a) : b * a = c * a ↔ b = c := -⟨nat.eq_of_mul_eq_mul_right ha, λ e, e ▸ rfl⟩ - -protected theorem mul_right_inj {a b c : ℕ} (ha : 0 < a) : a * b = a * c ↔ b = c := -⟨nat.eq_of_mul_eq_mul_left ha, λ e, e ▸ rfl⟩ - -lemma mul_left_injective {a : ℕ} (ha : 0 < a) : function.injective (λ x, x * a) := -λ _ _, eq_of_mul_eq_mul_right ha - -lemma mul_right_injective {a : ℕ} (ha : 0 < a) : function.injective (λ x, a * x) := -λ _ _, nat.eq_of_mul_eq_mul_left ha - lemma mul_ne_mul_left {a b c : ℕ} (ha : 0 < a) : b * a ≠ c * a ↔ b ≠ c := -(mul_left_injective ha).ne_iff +(mul_left_injective₀ ha.ne').ne_iff lemma mul_ne_mul_right {a b c : ℕ} (ha : 0 < a) : a * b ≠ a * c ↔ b ≠ c := -(mul_right_injective ha).ne_iff +(mul_right_injective₀ ha.ne').ne_iff lemma mul_right_eq_self_iff {a b : ℕ} (ha : 0 < a) : a * b = a ↔ b = 1 := suffices a * b = a * 1 ↔ b = 1, by rwa mul_one at this, -nat.mul_right_inj ha +mul_right_inj' ha.ne' lemma mul_left_eq_self_iff {a b : ℕ} (hb : 0 < b) : a * b = b ↔ a = 1 := by rw [mul_comm, nat.mul_right_eq_self_iff hb] @@ -616,15 +274,6 @@ by rw [mul_comm, nat.mul_right_eq_self_iff hb] lemma lt_succ_iff_lt_or_eq {n i : ℕ} : n < i.succ ↔ (n < i ∨ n = i) := lt_succ_iff.trans decidable.le_iff_lt_or_eq -theorem mul_self_inj {n m : ℕ} : n * n = m * m ↔ n = m := -le_antisymm_iff.trans (le_antisymm_iff.trans - (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)).symm - -lemma le_add_pred_of_pos (n : ℕ) {i : ℕ} (hi : i ≠ 0) : n ≤ i + (n - 1) := -begin - refine le_trans _ (add_tsub_le_assoc), - simp [add_comm, nat.add_sub_assoc, one_le_iff_ne_zero.2 hi] -end /-! ### Recursion and induction principles @@ -652,7 +301,7 @@ def le_rec_on {C : ℕ → Sort u} {n : ℕ} : Π {m : ℕ}, n ≤ m → (Π {k} theorem le_rec_on_self {C : ℕ → Sort u} {n} {h : n ≤ n} {next} (x : C n) : (le_rec_on h next x : C n) = x := -by cases n; unfold le_rec_on or.by_cases; rw [dif_neg n.not_succ_le_self, dif_pos rfl] +by cases n; unfold le_rec_on or.by_cases; rw [dif_neg n.not_succ_le_self] theorem le_rec_on_succ {C : ℕ → Sort u} {n m} (h1 : n ≤ m) {h2 : n ≤ m+1} {next} (x : C n) : (le_rec_on h2 @next x : C (m+1)) = next (le_rec_on h1 @next x : C m) := @@ -747,6 +396,27 @@ lemma decreasing_induction_succ_left {P : ℕ → Sort*} (h : ∀n, P (n+1) → by { rw [subsingleton.elim mn (le_trans (le_succ m) smn), decreasing_induction_trans, decreasing_induction_succ'] } +/-- Given `P : ℕ → ℕ → Sort*`, if for all `a b : ℕ` we can extend `P` from the rectangle +strictly below `(a,b)` to `P a b`, then we have `P n m` for all `n m : ℕ`. +Note that for non-`Prop` output it is preferable to use the equation compiler directly if possible, +since this produces equation lemmas. -/ +@[elab_as_eliminator] +def strong_sub_recursion {P : ℕ → ℕ → Sort*} + (H : ∀ a b, (∀ x y, x < a → y < b → P x y) → P a b) : Π (n m : ℕ), P n m +| n m := H n m (λ x y hx hy, strong_sub_recursion x y) + +/-- Given `P : ℕ → ℕ → Sort*`, if we have `P i 0` and `P 0 i` for all `i : ℕ`, +and for any `x y : ℕ` we can extend `P` from `(x,y+1)` and `(x+1,y)` to `(x+1,y+1)` +then we have `P n m` for all `n m : ℕ`. +Note that for non-`Prop` output it is preferable to use the equation compiler directly if possible, +since this produces equation lemmas. -/ +@[elab_as_eliminator] +def pincer_recursion {P : ℕ → ℕ → Sort*} (Ha0 : ∀ a : ℕ, P a 0) (H0b : ∀ b : ℕ, P 0 b) + (H : ∀ x y : ℕ, P x y.succ → P x.succ y → P x.succ y.succ) : ∀ (n m : ℕ), P n m +| a 0 := Ha0 a +| 0 b := H0b b +| (nat.succ a) (nat.succ b) := H _ _ (pincer_recursion _ _) (pincer_recursion _ _) + /-- Recursion starting at a non-zero number: given a map `C k → C (k+1)` for each `k ≥ n`, there is a map from `C n` to each `C m`, `n ≤ m`. -/ @[elab_as_eliminator] @@ -771,50 +441,22 @@ begin { intros h hP, exact hP } end -/-- A subset of `ℕ` containing `b : ℕ` and closed under `nat.succ` contains every `n ≥ b`. -/ -lemma set_induction_bounded {b : ℕ} {S : set ℕ} (hb : b ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S) - {n : ℕ} (hbn : b ≤ n) : n ∈ S := -@le_rec_on (λ n, n ∈ S) b n hbn h_ind hb - -/-- A subset of `ℕ` containing zero and closed under `nat.succ` contains all of `ℕ`. -/ -lemma set_induction {S : set ℕ} (hb : 0 ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S) (n : ℕ) : n ∈ S := -set_induction_bounded hb h_ind (zero_le n) - -lemma set_eq_univ {S : set ℕ} : S = set.univ ↔ 0 ∈ S ∧ ∀ k : ℕ, k ∈ S → k + 1 ∈ S := -⟨by rintro rfl; simp, λ ⟨h0, hs⟩, set.eq_univ_of_forall (set_induction h0 hs)⟩ - /-! ### `div` -/ attribute [simp] nat.div_self -protected lemma div_le_of_le_mul' {m n : ℕ} {k} (h : m ≤ k * n) : m / k ≤ n := -(nat.eq_zero_or_pos k).elim - (λ k0, by rw [k0, nat.div_zero]; apply zero_le) - (λ k0, (_root_.mul_le_mul_left k0).1 $ - calc k * (m / k) - ≤ m % k + k * (m / k) : nat.le_add_left _ _ - ... = m : mod_add_div _ _ - ... ≤ k * n : h) - -protected lemma div_le_self' (m n : ℕ) : m / n ≤ m := -(nat.eq_zero_or_pos n).elim - (λ n0, by rw [n0, nat.div_zero]; apply zero_le) - (λ n0, nat.div_le_of_le_mul' $ calc - m = 1 * m : (one_mul _).symm - ... ≤ n * m : nat.mul_le_mul_right _ n0) - /-- A version of `nat.div_lt_self` using successors, rather than additional hypotheses. -/ lemma div_lt_self' (n b : ℕ) : (n+1)/(b+2) < n+1 := nat.div_lt_self (nat.succ_pos n) (nat.succ_lt_succ (nat.succ_pos _)) theorem le_div_iff_mul_le' {x y : ℕ} {k : ℕ} (k0 : 0 < k) : x ≤ y / k ↔ x * k ≤ y := -le_div_iff_mul_le x y k0 +le_div_iff_mul_le k0 theorem div_lt_iff_lt_mul' {x y : ℕ} {k : ℕ} (k0 : 0 < k) : x / k < y ↔ x < y * k := lt_iff_lt_of_le_iff_le $ le_div_iff_mul_le' k0 lemma one_le_div_iff {a b : ℕ} (hb : 0 < b) : 1 ≤ a / b ↔ b ≤ a := -by rw [le_div_iff_mul_le _ _ hb, one_mul] +by rw [le_div_iff_mul_le hb, one_mul] lemma div_lt_one_iff {a b : ℕ} (hb : 0 < b) : a / b < 1 ↔ a < b := lt_iff_lt_of_le_iff_le $ one_le_div_iff hb @@ -832,43 +474,14 @@ nat.pos_of_ne_zero (λ h, lt_irrefl a ... < b : nat.mod_lt a hb ... ≤ a : hba)) -protected lemma div_lt_of_lt_mul {m n k : ℕ} (h : m < n * k) : m / n < k := -lt_of_mul_lt_mul_left - (calc n * (m / n) ≤ m % n + n * (m / n) : nat.le_add_left _ _ - ... = m : mod_add_div _ _ - ... < n * k : h) - (nat.zero_le n) - lemma lt_mul_of_div_lt {a b c : ℕ} (h : a / c < b) (w : 0 < c) : a < b * c := -lt_of_not_ge $ not_le_of_gt h ∘ (nat.le_div_iff_mul_le _ _ w).2 - -protected lemma div_eq_zero_iff {a b : ℕ} (hb : 0 < b) : a / b = 0 ↔ a < b := -⟨λ h, by rw [← mod_add_div a b, h, mul_zero, add_zero]; exact mod_lt _ hb, - λ h, by rw [← nat.mul_right_inj hb, ← @add_left_cancel_iff _ _ (a % b), mod_add_div, - mod_eq_of_lt h, mul_zero, add_zero]⟩ - -protected lemma div_eq_zero {a b : ℕ} (hb : a < b) : a / b = 0 := -(nat.div_eq_zero_iff $ (zero_le a).trans_lt hb).mpr hb - -lemma eq_zero_of_le_div {a b : ℕ} (hb : 2 ≤ b) (h : a ≤ a / b) : a = 0 := -eq_zero_of_mul_le hb $ - by rw mul_comm; exact (nat.le_div_iff_mul_le' (lt_of_lt_of_le dec_trivial hb)).1 h +lt_of_not_ge $ not_le_of_gt h ∘ (nat.le_div_iff_mul_le w).2 lemma mul_div_le_mul_div_assoc (a b c : ℕ) : a * (b / c) ≤ (a * b) / c := if hc0 : c = 0 then by simp [hc0] -else (nat.le_div_iff_mul_le _ _ (nat.pos_of_ne_zero hc0)).2 +else (nat.le_div_iff_mul_le (nat.pos_of_ne_zero hc0)).2 (by rw [mul_assoc]; exact nat.mul_le_mul_left _ (nat.div_mul_le_self _ _)) -lemma div_mul_div_le_div (a b c : ℕ) : ((a / c) * b) / a ≤ b / c := -if ha0 : a = 0 then by simp [ha0] -else calc a / c * b / a ≤ b * a / c / a : - nat.div_le_div_right (by rw [mul_comm]; - exact mul_div_le_mul_div_assoc _ _ _) - ... = b / c : by rw [nat.div_div_eq_div_mul, mul_comm b, mul_comm c, - nat.mul_div_mul _ _ (nat.pos_of_ne_zero ha0)] - -lemma eq_zero_of_le_half {a : ℕ} (h : a ≤ a / 2) : a = 0 := -eq_zero_of_le_div le_rfl h protected theorem eq_mul_of_div_eq_right {a b c : ℕ} (H1 : b ∣ a) (H2 : a / b = c) : a = b * c := @@ -886,6 +499,7 @@ protected theorem eq_mul_of_div_eq_left {a b c : ℕ} (H1 : b ∣ a) (H2 : a / b a = c * b := by rw [mul_comm, nat.eq_mul_of_div_eq_right H1 H2] + protected theorem mul_div_cancel_left' {a b : ℕ} (Hd : a ∣ b) : a * (b / a) = b := by rw [mul_comm,nat.div_mul_cancel Hd] @@ -897,24 +511,29 @@ by rw [mul_comm, mul_comm b, a.mul_div_mul_left b hc] lemma lt_div_mul_add {a b : ℕ} (hb : 0 < b) : a < a/b*b + b := begin - rw [←nat.succ_mul, ←nat.div_lt_iff_lt_mul _ _ hb], + rw [←nat.succ_mul, ←nat.div_lt_iff_lt_mul hb], exact nat.lt_succ_self _, end -lemma div_eq_iff_eq_of_dvd_dvd {n x y : ℕ} (hn : n ≠ 0) (hx : x ∣ n) (hy : y ∣ n) : - n / x = n / y ↔ x = y := +@[simp] +protected lemma div_left_inj {a b d : ℕ} (hda : d ∣ a) (hdb : d ∣ b) : a / d = b / d ↔ a = b := begin - split, - { intros h, - rw ←mul_right_inj' hn, - apply nat.eq_mul_of_div_eq_left (dvd_mul_of_dvd_left hy x), - rw [eq_comm, mul_comm, nat.mul_div_assoc _ hy], - exact nat.eq_mul_of_div_eq_right hx h }, - { intros h, rw h }, + refine ⟨λ h, _, congr_arg _⟩, + rw [←nat.mul_div_cancel' hda, ←nat.mul_div_cancel' hdb, h], end /-! ### `mod`, `dvd` -/ + +lemma mod_eq_iff_lt {a b : ℕ} (h : b ≠ 0) : a % b = a ↔ a < b := +begin + cases b, contradiction, + exact ⟨λ h, h.ge.trans_lt (mod_lt _ (succ_pos _)), mod_eq_of_lt⟩, +end + +@[simp] lemma mod_succ_eq_iff_lt {a b : ℕ} : a % b.succ = a ↔ a < b.succ := +mod_eq_iff_lt (succ_ne_zero _) + lemma div_add_mod (m k : ℕ) : k * (m / k) + m % k = m := (nat.add_comm _ _).trans (mod_add_div _ _) @@ -924,130 +543,24 @@ by { rw mul_comm, exact mod_add_div _ _ } lemma div_add_mod' (m k : ℕ) : (m / k) * k + m % k = m := by { rw mul_comm, exact div_add_mod _ _ } +/-- See also `nat.div_mod_equiv` for a similar statement as an `equiv`. -/ protected theorem div_mod_unique {n k m d : ℕ} (h : 0 < k) : n / k = d ∧ n % k = m ↔ m + k * d = n ∧ m < k := ⟨λ ⟨e₁, e₂⟩, e₁ ▸ e₂ ▸ ⟨mod_add_div _ _, mod_lt _ h⟩, λ ⟨h₁, h₂⟩, h₁ ▸ by rw [add_mul_div_left _ _ h, add_mul_mod_self_left]; simp [div_eq_of_lt, mod_eq_of_lt, h₂]⟩ -lemma two_mul_odd_div_two {n : ℕ} (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 := -by conv {to_rhs, rw [← nat.mod_add_div n 2, hn, add_tsub_cancel_left]} - -lemma div_dvd_of_dvd {a b : ℕ} (h : b ∣ a) : (a / b) ∣ a := -⟨b, (nat.div_mul_cancel h).symm⟩ - -protected lemma div_div_self : ∀ {a b : ℕ}, b ∣ a → 0 < a → a / (a / b) = b -| a 0 h₁ h₂ := by rw [eq_zero_of_zero_dvd h₁, nat.div_zero, nat.div_zero] -| 0 b h₁ h₂ := absurd h₂ dec_trivial -| (a+1) (b+1) h₁ h₂ := -(nat.mul_left_inj (nat.div_pos (le_of_dvd (succ_pos a) h₁) (succ_pos b))).1 $ - by rw [nat.div_mul_cancel (div_dvd_of_dvd h₁), nat.mul_div_cancel' h₁] - -lemma mod_mul_right_div_self (a b c : ℕ) : a % (b * c) / b = (a / b) % c := -begin - rcases nat.eq_zero_or_pos b with rfl|hb, { simp }, - rcases nat.eq_zero_or_pos c with rfl|hc, { simp }, - conv_rhs { rw ← mod_add_div a (b * c) }, - rw [mul_assoc, nat.add_mul_div_left _ _ hb, add_mul_mod_self_left, - mod_eq_of_lt (nat.div_lt_of_lt_mul (mod_lt _ (mul_pos hb hc)))] -end - -lemma mod_mul_left_div_self (a b c : ℕ) : a % (c * b) / b = (a / b) % c := -by rw [mul_comm c, mod_mul_right_div_self] - -@[simp] protected theorem dvd_one {n : ℕ} : n ∣ 1 ↔ n = 1 := -⟨eq_one_of_dvd_one, λ e, e.symm ▸ dvd_rfl⟩ - protected theorem dvd_add_left {k m n : ℕ} (h : k ∣ n) : k ∣ m + n ↔ k ∣ m := (nat.dvd_add_iff_left h).symm protected theorem dvd_add_right {k m n : ℕ} (h : k ∣ m) : k ∣ m + n ↔ k ∣ n := (nat.dvd_add_iff_right h).symm -@[simp] protected theorem not_two_dvd_bit1 (n : ℕ) : ¬ 2 ∣ bit1 n := -by { rw [bit1, nat.dvd_add_right two_dvd_bit0, nat.dvd_one], cc } - -/-- A natural number `m` divides the sum `m + n` if and only if `m` divides `n`.-/ -@[simp] protected lemma dvd_add_self_left {m n : ℕ} : - m ∣ m + n ↔ m ∣ n := -nat.dvd_add_right (dvd_refl m) - -/-- A natural number `m` divides the sum `n + m` if and only if `m` divides `n`.-/ -@[simp] protected lemma dvd_add_self_right {m n : ℕ} : - m ∣ n + m ↔ m ∣ n := -nat.dvd_add_left (dvd_refl m) - --- TODO: update `nat.dvd_sub` in core -lemma dvd_sub' {k m n : ℕ} (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := -begin - cases le_total n m with H H, - { exact dvd_sub H h₁ h₂ }, - { rw tsub_eq_zero_iff_le.mpr H, - exact dvd_zero k }, -end - -lemma not_dvd_of_pos_of_lt {a b : ℕ} (h1 : 0 < b) (h2 : b < a) : ¬ a ∣ b := -begin - rintros ⟨c, rfl⟩, - rcases nat.eq_zero_or_pos c with (rfl | hc), - { exact lt_irrefl 0 h1 }, - { exact not_lt.2 (le_mul_of_pos_right hc) h2 }, -end - protected theorem mul_dvd_mul_iff_left {a b c : ℕ} (ha : 0 < a) : a * b ∣ a * c ↔ b ∣ c := -exists_congr $ λ d, by rw [mul_assoc, nat.mul_right_inj ha] +exists_congr $ λ d, by rw [mul_assoc, mul_right_inj' ha.ne'] protected theorem mul_dvd_mul_iff_right {a b c : ℕ} (hc : 0 < c) : a * c ∣ b * c ↔ a ∣ b := -exists_congr $ λ d, by rw [mul_right_comm, nat.mul_left_inj hc] - -lemma succ_div : ∀ (a b : ℕ), (a + 1) / b = - a / b + if b ∣ a + 1 then 1 else 0 -| a 0 := by simp -| 0 1 := by simp -| 0 (b+2) := have hb2 : b + 2 > 1, from dec_trivial, - by simp [ne_of_gt hb2, div_eq_of_lt hb2] -| (a+1) (b+1) := begin - rw [nat.div_def], conv_rhs { rw nat.div_def }, - by_cases hb_eq_a : b = a + 1, - { simp [hb_eq_a, le_refl] }, - by_cases hb_le_a1 : b ≤ a + 1, - { have hb_le_a : b ≤ a, from le_of_lt_succ (lt_of_le_of_ne hb_le_a1 hb_eq_a), - have h₁ : (0 < b + 1 ∧ b + 1 ≤ a + 1 + 1), - from ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a1⟩, - have h₂ : (0 < b + 1 ∧ b + 1 ≤ a + 1), - from ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a⟩, - have dvd_iff : b + 1 ∣ a - b + 1 ↔ b + 1 ∣ a + 1 + 1, - { rw [nat.dvd_add_iff_left (dvd_refl (b + 1)), - ← add_tsub_add_eq_tsub_right a 1 b, add_comm (_ - _), add_assoc, - tsub_add_cancel_of_le (succ_le_succ hb_le_a), add_comm 1] }, - have wf : a - b < a + 1, from lt_succ_of_le tsub_le_self, - rw [if_pos h₁, if_pos h₂, add_tsub_add_eq_tsub_right, ← tsub_add_eq_add_tsub hb_le_a, - by exact have _ := wf, succ_div (a - b), - add_tsub_add_eq_tsub_right], - simp [dvd_iff, succ_eq_add_one, add_comm 1, add_assoc] }, - { have hba : ¬ b ≤ a, - from not_le_of_gt (lt_trans (lt_succ_self a) (lt_of_not_ge hb_le_a1)), - have hb_dvd_a : ¬ b + 1 ∣ a + 2, - from λ h, hb_le_a1 (le_of_succ_le_succ (le_of_dvd (succ_pos _) h)), - simp [hba, hb_le_a1, hb_dvd_a], } -end - -lemma succ_div_of_dvd {a b : ℕ} (hba : b ∣ a + 1) : - (a + 1) / b = a / b + 1 := -by rw [succ_div, if_pos hba] - -lemma succ_div_of_not_dvd {a b : ℕ} (hba : ¬ b ∣ a + 1) : - (a + 1) / b = a / b := -by rw [succ_div, if_neg hba, add_zero] - -lemma dvd_iff_div_mul_eq (n d : ℕ) : d ∣ n ↔ n / d * d = n := -⟨λ h, nat.div_mul_cancel h, λ h, dvd.intro_left (n / d) h⟩ - -lemma dvd_iff_le_div_mul (n d : ℕ) : d ∣ n ↔ n ≤ n / d * d := -((dvd_iff_div_mul_eq _ _).trans le_antisymm_iff).trans (and_iff_right (div_mul_le_self n d)) - -lemma dvd_iff_dvd_dvd (n d : ℕ) : d ∣ n ↔ ∀ k : ℕ, k ∣ d → k ∣ n := -⟨λ h k hkd, dvd_trans hkd h, λ h, h _ dvd_rfl⟩ +exists_congr $ λ d, by rw [mul_right_comm, mul_left_inj' hc.ne'] @[simp] theorem mod_mod_of_dvd (n : nat) {m k : nat} (h : m ∣ k) : n % k % m = n % m := begin @@ -1060,16 +573,6 @@ end (λ n0, by simp [n0]) (λ npos, mod_eq_of_lt (mod_lt _ npos)) -/-- If `a` and `b` are equal mod `c`, `a - b` is zero mod `c`. -/ -lemma sub_mod_eq_zero_of_mod_eq {a b c : ℕ} (h : a % c = b % c) : (a - b) % c = 0 := -by rw [←nat.mod_add_div a c, ←nat.mod_add_div b c, ←h, tsub_add_eq_tsub_tsub, add_tsub_cancel_left, - ←mul_tsub, nat.mul_mod_right] - -@[simp] lemma one_mod (n : ℕ) : 1 % (n + 2) = 1 := nat.mod_eq_of_lt (add_lt_add_right n.succ_pos 1) - -lemma dvd_sub_mod (k : ℕ) : n ∣ (k - (k % n)) := -⟨k / n, tsub_eq_of_eq_add_rev (nat.mod_add_div k n).symm⟩ - @[simp] theorem mod_add_mod (m n k : ℕ) : (m % n + k) % n = (m + k) % n := by have := (add_mul_mod_self_left (m % n + k) n (m / n)).symm; rwa [add_right_comm, mod_add_div] at this @@ -1088,18 +591,6 @@ theorem add_mod_eq_add_mod_left {m n k : ℕ} (i : ℕ) (H : m % n = k % n) : (i + m) % n = (i + k) % n := by rw [add_comm, add_mod_eq_add_mod_right _ H, add_comm] -lemma add_mod_eq_ite {a b n : ℕ} : - (a + b) % n = if n ≤ a % n + b % n then a % n + b % n - n else a % n + b % n := -begin - cases n, { simp }, - rw nat.add_mod, - split_ifs with h, - { rw [nat.mod_eq_sub_mod h, nat.mod_eq_of_lt], - exact (tsub_lt_iff_right h).mpr - (nat.add_lt_add (a.mod_lt n.zero_lt_succ) (b.mod_lt n.zero_lt_succ)) }, - { exact nat.mod_eq_of_lt (lt_of_not_ge h) } -end - lemma mul_mod (a b n : ℕ) : (a * b) % n = ((a % n) * (b % n)) % n := begin conv_lhs @@ -1108,16 +599,6 @@ begin add_mul_mod_self_right] } end -lemma dvd_div_of_mul_dvd {a b c : ℕ} (h : a * b ∣ c) : b ∣ c / a := -if ha : a = 0 then - by simp [ha] -else - have ha : 0 < a, from nat.pos_of_ne_zero ha, - have h1 : ∃ d, c = a * b * d, from h, - let ⟨d, hd⟩ := h1 in - have h2 : c / a = b * d, from nat.div_eq_of_eq_mul_right ha (by simpa [mul_assoc] using hd), - show ∃ d, c / a = b * d, from ⟨d, h2⟩ - lemma mul_dvd_of_dvd_div {a b c : ℕ} (hab : c ∣ b) (h : a ∣ b / c) : c * a ∣ b := have h1 : ∃ d, b / c = a * d, from h, have h2 : ∃ e, b = c * e, from hab, @@ -1126,87 +607,19 @@ have h3 : b = a * d * c, from nat.eq_mul_of_div_eq_left hab hd, show ∃ d, b = c * a * d, from ⟨d, by cc⟩ -@[simp] lemma dvd_div_iff {a b c : ℕ} (hbc : c ∣ b) : a ∣ b / c ↔ c * a ∣ b := -⟨λ h, mul_dvd_of_dvd_div hbc h, λ h, dvd_div_of_mul_dvd h⟩ - -lemma div_mul_div_comm {a b c d : ℕ} (hab : b ∣ a) (hcd : d ∣ c) : - (a / b) * (c / d) = (a * c) / (b * d) := -have exi1 : ∃ x, a = b * x, from hab, -have exi2 : ∃ y, c = d * y, from hcd, -if hb : b = 0 then by simp [hb] -else have 0 < b, from nat.pos_of_ne_zero hb, -if hd : d = 0 then by simp [hd] -else have 0 < d, from nat.pos_of_ne_zero hd, -begin - cases exi1 with x hx, cases exi2 with y hy, - rw [hx, hy, nat.mul_div_cancel_left, nat.mul_div_cancel_left], - symmetry, - apply nat.div_eq_of_eq_mul_left, - apply mul_pos, - repeat {assumption}, - cc -end - -@[simp] -lemma div_div_div_eq_div : ∀ {a b c : ℕ} (dvd : b ∣ a) (dvd2 : a ∣ c), (c / (a / b)) / b = c / a -| 0 _ := by simp -| (a + 1) 0 := λ _ dvd _, by simpa using dvd -| (a + 1) (c + 1) := -have a_split : a + 1 ≠ 0 := succ_ne_zero a, -have c_split : c + 1 ≠ 0 := succ_ne_zero c, -λ b dvd dvd2, -begin - rcases dvd2 with ⟨k, rfl⟩, - rcases dvd with ⟨k2, pr⟩, - have k2_nonzero : k2 ≠ 0 := λ k2_zero, by simpa [k2_zero] using pr, - rw [nat.mul_div_cancel_left k (nat.pos_of_ne_zero a_split), pr, - nat.mul_div_cancel_left k2 (nat.pos_of_ne_zero c_split), nat.mul_comm ((c + 1) * k2) k, - ←nat.mul_assoc k (c + 1) k2, nat.mul_div_cancel _ (nat.pos_of_ne_zero k2_nonzero), - nat.mul_div_cancel _ (nat.pos_of_ne_zero c_split)], -end - lemma eq_of_dvd_of_div_eq_one {a b : ℕ} (w : a ∣ b) (h : b / a = 1) : a = b := by rw [←nat.div_mul_cancel w, h, one_mul] lemma eq_zero_of_dvd_of_div_eq_zero {a b : ℕ} (w : a ∣ b) (h : b / a = 0) : b = 0 := by rw [←nat.div_mul_cancel w, h, zero_mul] -/-- If a small natural number is divisible by a larger natural number, -the small number is zero. -/ -lemma eq_zero_of_dvd_of_lt {a b : ℕ} (w : a ∣ b) (h : b < a) : b = 0 := -nat.eq_zero_of_dvd_of_div_eq_zero w - ((nat.div_eq_zero_iff (lt_of_le_of_lt (zero_le b) h)).elim_right h) - lemma div_le_div_left {a b c : ℕ} (h₁ : c ≤ b) (h₂ : 0 < c) : a / b ≤ a / c := -(nat.le_div_iff_mul_le _ _ h₂).2 $ +(nat.le_div_iff_mul_le h₂).2 $ le_trans (nat.mul_le_mul_left _ h₁) (div_mul_le_self _ _) -lemma div_eq_self {a b : ℕ} : a / b = a ↔ a = 0 ∨ b = 1 := -begin - split, - { intro, - cases b, - { simp * at * }, - { cases b, - { right, refl }, - { left, - have : a / (b + 2) ≤ a / 2 := div_le_div_left (by simp) dec_trivial, - refine eq_zero_of_le_half _, - simp * at * } } }, - { rintros (rfl|rfl); simp } -end - lemma lt_iff_le_pred : ∀ {m n : ℕ}, 0 < n → (m < n ↔ m ≤ n - 1) | m (n+1) _ := lt_succ_iff -lemma div_eq_sub_mod_div {m n : ℕ} : m / n = (m - m % n) / n := -begin - by_cases n0 : n = 0, - { rw [n0, nat.div_zero, nat.div_zero] }, - { rw [← mod_add_div m n] { occs := occurrences.pos [2] }, - rw [add_tsub_cancel_left, mul_div_right _ (nat.pos_of_ne_zero n0)] } -end - lemma mul_div_le (m n : ℕ) : n * (m / n) ≤ m := begin cases nat.eq_zero_or_pos n with n0 h, @@ -1220,42 +633,19 @@ begin exact lt_succ_self _ end -@[simp] lemma mod_div_self (m n : ℕ) : m % n / n = 0 := -begin - cases n, - { exact (m % 0).div_zero }, - { exact nat.div_eq_zero (m.mod_lt n.succ_pos) } -end - -/-- `m` is not divisible by `n` iff it is between `n * k` and `n * (k + 1)` for some `k`. -/ -lemma exists_lt_and_lt_iff_not_dvd (m : ℕ) {n : ℕ} (hn : 0 < n) : - (∃ k, n * k < m ∧ m < n * (k + 1)) ↔ ¬ n ∣ m := -begin - split, - { rintro ⟨k, h1k, h2k⟩ ⟨l, rfl⟩, rw [mul_lt_mul_left hn] at h1k h2k, - rw [lt_succ_iff, ← not_lt] at h2k, exact h2k h1k }, - { intro h, rw [dvd_iff_mod_eq_zero, ← ne.def, ← pos_iff_ne_zero] at h, - simp only [← mod_add_div m n] {single_pass := tt}, - refine ⟨m / n, lt_add_of_pos_left _ h, _⟩, - rw [add_comm _ 1, left_distrib, mul_one], exact add_lt_add_right (mod_lt _ hn) _ } -end - -/-- Two natural numbers are equal if and only if the have the same multiples. -/ -lemma dvd_right_iff_eq {m n : ℕ} : (∀ a : ℕ, m ∣ a ↔ n ∣ a) ↔ m = n := -⟨λ h, dvd_antisymm ((h _).mpr dvd_rfl) ((h _).mp dvd_rfl), λ h n, by rw h⟩ +lemma mul_add_mod (a b c : ℕ) : (a * b + c) % b = c % b := +by simp [nat.add_mod] -/-- Two natural numbers are equal if and only if the have the same divisors. -/ -lemma dvd_left_iff_eq {m n : ℕ} : (∀ a : ℕ, a ∣ m ↔ a ∣ n) ↔ m = n := -⟨λ h, dvd_antisymm ((h _).mp dvd_rfl) ((h _).mpr dvd_rfl), λ h n, by rw h⟩ +lemma mul_add_mod_of_lt {a b c : ℕ} (h : c < b) : (a * b + c) % b = c := +by rw [nat.mul_add_mod, nat.mod_eq_of_lt h] -/-- `dvd` is injective in the left argument -/ -lemma dvd_left_injective : function.injective ((∣) : ℕ → ℕ → Prop) := -λ m n h, dvd_right_iff_eq.mp $ λ a, iff_of_eq (congr_fun h a) +lemma pred_eq_self_iff {n : ℕ} : n.pred = n ↔ n = 0 := +by { cases n; simp [(nat.succ_ne_self _).symm] } /-! ### `find` -/ section find -variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q] +variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q] lemma find_eq_iff (h : ∃ n : ℕ, p n) : nat.find h = m ↔ p m ∧ ∀ n < m, ¬ p n := begin @@ -1280,9 +670,6 @@ by simp only [← succ_le_iff, le_find_iff, succ_le_succ_iff] @[simp] lemma find_eq_zero (h : ∃ n : ℕ, p n) : nat.find h = 0 ↔ p 0 := by simp [find_eq_iff] -@[simp] lemma find_pos (h : ∃ n : ℕ, p n) : 0 < nat.find h ↔ ¬ p 0 := -by rw [pos_iff_ne_zero, ne, nat.find_eq_zero] - theorem find_mono (h : ∀ n, q n → p n) {hp : ∃ n, p n} {hq : ∃ n, q n} : nat.find hp ≤ nat.find hq := nat.find_min' _ (h _ (nat.find_spec hq)) @@ -1290,19 +677,6 @@ nat.find_min' _ (h _ (nat.find_spec hq)) lemma find_le {h : ∃ n, p n} (hn : p n) : nat.find h ≤ n := (nat.find_le_iff _ _).2 ⟨n, le_rfl, hn⟩ -lemma find_add {hₘ : ∃ m, p (m + n)} {hₙ : ∃ n, p n} (hn : n ≤ nat.find hₙ) : - nat.find hₘ + n = nat.find hₙ := -begin - refine ((le_find_iff _ _).2 (λ m hm hpm, hm.not_le _)).antisymm _, - { have hnm : n ≤ m := hn.trans (find_le hpm), - refine add_le_of_le_tsub_right_of_le hnm (find_le _), - rwa tsub_add_cancel_of_le hnm }, - { rw ←tsub_le_iff_right, - refine (le_find_iff _ _).2 (λ m hm hpm, hm.not_le _), - rw tsub_le_iff_right, - exact find_le hpm } -end - lemma find_comp_succ (h₁ : ∃ n, p n) (h₂ : ∃ n, p (n + 1)) (h0 : ¬ p 0) : nat.find h₁ = nat.find h₂ + 1 := begin @@ -1337,184 +711,8 @@ lemma find_greatest_succ (n : ℕ) : nat.find_greatest P (b + 1) = nat.find_greatest P b := by simp [nat.find_greatest, h] -lemma find_greatest_eq_iff : - nat.find_greatest P b = m ↔ m ≤ b ∧ (m ≠ 0 → P m) ∧ (∀ ⦃n⦄, m < n → n ≤ b → ¬P n) := -begin - induction b with b ihb generalizing m, - { rw [eq_comm, iff.comm], - simp only [nonpos_iff_eq_zero, ne.def, and_iff_left_iff_imp, find_greatest_zero], - rintro rfl, - exact ⟨λ h, (h rfl).elim, λ n hlt heq, (hlt.ne heq.symm).elim⟩ }, - { by_cases hb : P (b + 1), - { rw [find_greatest_eq hb], split, - { rintro rfl, - exact ⟨le_rfl, λ _, hb, λ n hlt hle, (hlt.not_le hle).elim⟩ }, - { rintros ⟨hle, h0, hm⟩, - rcases decidable.eq_or_lt_of_le hle with rfl|hlt, - exacts [rfl, (hm hlt le_rfl hb).elim] } }, - { rw [find_greatest_of_not hb, ihb], - split, - { rintros ⟨hle, hP, hm⟩, - refine ⟨hle.trans b.le_succ, hP, λ n hlt hle, _⟩, - rcases decidable.eq_or_lt_of_le hle with rfl|hlt', - exacts [hb, hm hlt $ lt_succ_iff.1 hlt'] }, - { rintros ⟨hle, hP, hm⟩, - refine ⟨lt_succ_iff.1 (hle.lt_of_ne _), hP, λ n hlt hle, hm hlt (hle.trans b.le_succ)⟩, - rintro rfl, - exact hb (hP b.succ_ne_zero) } } } -end - -lemma find_greatest_eq_zero_iff : nat.find_greatest P b = 0 ↔ ∀ ⦃n⦄, 0 < n → n ≤ b → ¬P n := -by simp [find_greatest_eq_iff] - -lemma find_greatest_spec (hmb : m ≤ b) (hm : P m) : P (nat.find_greatest P b) := -begin - by_cases h : nat.find_greatest P b = 0, - { cases m, { rwa h }, - exact ((find_greatest_eq_zero_iff.1 h) m.zero_lt_succ hmb hm).elim }, - { exact (find_greatest_eq_iff.1 rfl).2.1 h } -end - -lemma find_greatest_le (n : ℕ) : nat.find_greatest P n ≤ n := (find_greatest_eq_iff.1 rfl).1 - -lemma le_find_greatest (hmb : m ≤ b) (hm : P m) : m ≤ nat.find_greatest P b := -le_of_not_lt $ λ hlt, (find_greatest_eq_iff.1 rfl).2.2 hlt hmb hm - -lemma find_greatest_mono_right (P : ℕ → Prop) [decidable_pred P] : monotone (nat.find_greatest P) := -begin - refine monotone_nat_of_le_succ (λ n, _), - rw [find_greatest_succ], - split_ifs, - { exact (find_greatest_le n).trans (le_succ _) }, - { refl } -end - -lemma find_greatest_mono_left [decidable_pred Q] (hPQ : P ≤ Q) : - nat.find_greatest P ≤ nat.find_greatest Q := -begin - intro n, - induction n with n hn, - { refl }, - by_cases P (n + 1), - { rw [find_greatest_eq h, find_greatest_eq (hPQ _ h)] }, - { rw find_greatest_of_not h, - exact hn.trans (nat.find_greatest_mono_right _ $ le_succ _) } -end - -lemma find_greatest_mono {a b : ℕ} [decidable_pred Q] (hPQ : P ≤ Q) (hab : a ≤ b) : - nat.find_greatest P a ≤ nat.find_greatest Q b := -(nat.find_greatest_mono_right _ hab).trans $ find_greatest_mono_left hPQ _ - -lemma find_greatest_is_greatest (hk : nat.find_greatest P b < k) (hkb : k ≤ b) : ¬ P k := -(find_greatest_eq_iff.1 rfl).2.2 hk hkb - -lemma find_greatest_of_ne_zero (h : nat.find_greatest P b = m) (h0 : m ≠ 0) : P m := -(find_greatest_eq_iff.1 h).2.1 h0 - end find_greatest -/-! ### `bodd_div2` and `bodd` -/ - -@[simp] theorem bodd_div2_eq (n : ℕ) : bodd_div2 n = (bodd n, div2 n) := -by unfold bodd div2; cases bodd_div2 n; refl - -@[simp] lemma bodd_bit0 (n) : bodd (bit0 n) = ff := bodd_bit ff n -@[simp] lemma bodd_bit1 (n) : bodd (bit1 n) = tt := bodd_bit tt n - -@[simp] lemma div2_bit0 (n) : div2 (bit0 n) = n := div2_bit ff n -@[simp] lemma div2_bit1 (n) : div2 (bit1 n) = n := div2_bit tt n - -/-! ### `bit0` and `bit1` -/ - --- There is no need to prove `bit0_eq_zero : bit0 n = 0 ↔ n = 0` --- as this is true for any `[semiring R] [no_zero_divisors R] [char_zero R]` - --- However the lemmas `bit0_eq_bit0`, `bit1_eq_bit1`, `bit1_eq_one`, `one_eq_bit1` --- need `[ring R] [no_zero_divisors R] [char_zero R]` in general, --- so we prove `ℕ` specialized versions here. -@[simp] lemma bit0_eq_bit0 {m n : ℕ} : bit0 m = bit0 n ↔ m = n := -⟨nat.bit0_inj, λ h, by subst h⟩ - -@[simp] lemma bit1_eq_bit1 {m n : ℕ} : bit1 m = bit1 n ↔ m = n := -⟨nat.bit1_inj, λ h, by subst h⟩ - -@[simp] lemma bit1_eq_one {n : ℕ} : bit1 n = 1 ↔ n = 0 := -⟨@nat.bit1_inj n 0, λ h, by subst h⟩ -@[simp] lemma one_eq_bit1 {n : ℕ} : 1 = bit1 n ↔ n = 0 := -⟨λ h, (@nat.bit1_inj 0 n h).symm, λ h, by subst h⟩ - -protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m := -add_le_add h h - -protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m := -succ_le_succ (add_le_add h h) - -theorem bit_le : ∀ (b : bool) {n m : ℕ}, n ≤ m → bit b n ≤ bit b m -| tt n m h := nat.bit1_le h -| ff n m h := nat.bit0_le h - -theorem bit_ne_zero (b) {n} (h : n ≠ 0) : bit b n ≠ 0 := -by cases b; [exact nat.bit0_ne_zero h, exact nat.bit1_ne_zero _] - -theorem bit0_le_bit : ∀ (b) {m n : ℕ}, m ≤ n → bit0 m ≤ bit b n -| tt m n h := le_of_lt $ nat.bit0_lt_bit1 h -| ff m n h := nat.bit0_le h - -theorem bit_le_bit1 : ∀ (b) {m n : ℕ}, m ≤ n → bit b m ≤ bit1 n -| ff m n h := le_of_lt $ nat.bit0_lt_bit1 h -| tt m n h := nat.bit1_le h - -theorem bit_lt_bit0 : ∀ (b) {n m : ℕ}, n < m → bit b n < bit0 m -| tt n m h := nat.bit1_lt_bit0 h -| ff n m h := nat.bit0_lt h - -theorem bit_lt_bit (a b) {n m : ℕ} (h : n < m) : bit a n < bit b m := -lt_of_lt_of_le (bit_lt_bit0 _ h) (bit0_le_bit _ le_rfl) - -@[simp] lemma bit0_le_bit1_iff : bit0 k ≤ bit1 n ↔ k ≤ n := -⟨λ h, by rwa [← nat.lt_succ_iff, n.bit1_eq_succ_bit0, ← n.bit0_succ_eq, - bit0_lt_bit0, nat.lt_succ_iff] at h, λ h, le_of_lt (nat.bit0_lt_bit1 h)⟩ - -@[simp] lemma bit0_lt_bit1_iff : bit0 k < bit1 n ↔ k ≤ n := -⟨λ h, bit0_le_bit1_iff.1 (le_of_lt h), nat.bit0_lt_bit1⟩ - -@[simp] lemma bit1_le_bit0_iff : bit1 k ≤ bit0 n ↔ k < n := -⟨λ h, by rwa [k.bit1_eq_succ_bit0, succ_le_iff, bit0_lt_bit0] at h, - λ h, le_of_lt (nat.bit1_lt_bit0 h)⟩ - -@[simp] lemma bit1_lt_bit0_iff : bit1 k < bit0 n ↔ k < n := -⟨λ h, bit1_le_bit0_iff.1 (le_of_lt h), nat.bit1_lt_bit0⟩ - -@[simp] lemma one_le_bit0_iff : 1 ≤ bit0 n ↔ 0 < n := -by { convert bit1_le_bit0_iff, refl, } - -@[simp] lemma one_lt_bit0_iff : 1 < bit0 n ↔ 1 ≤ n := -by { convert bit1_lt_bit0_iff, refl, } - -@[simp] lemma bit_le_bit_iff : ∀ {b : bool}, bit b k ≤ bit b n ↔ k ≤ n -| ff := bit0_le_bit0 -| tt := bit1_le_bit1 - -@[simp] lemma bit_lt_bit_iff : ∀ {b : bool}, bit b k < bit b n ↔ k < n -| ff := bit0_lt_bit0 -| tt := bit1_lt_bit1 - -@[simp] lemma bit_le_bit1_iff : ∀ {b : bool}, bit b k ≤ bit1 n ↔ k ≤ n -| ff := bit0_le_bit1_iff -| tt := bit1_le_bit1 - -@[simp] lemma bit0_mod_two : bit0 n % 2 = 0 := by { rw nat.mod_two_of_bodd, simp } - -@[simp] lemma bit1_mod_two : bit1 n % 2 = 1 := by { rw nat.mod_two_of_bodd, simp } - -lemma pos_of_bit0_pos {n : ℕ} (h : 0 < bit0 n) : 0 < n := -by { cases n, cases h, apply succ_pos, } - -/-- Define a function on `ℕ` depending on parity of the argument. -/ -@[elab_as_eliminator] -def bit_cases {C : ℕ → Sort u} (H : Π b n, C (bit b n)) (n : ℕ) : C n := -eq.rec_on n.bit_decomp (H (bodd n) (div2 n)) - /-! ### decidability of predicates -/ instance decidable_ball_lt (n : nat) (P : Π k < n, Prop) : @@ -1540,18 +738,6 @@ instance decidable_ball_le (n : ℕ) (P : Π k ≤ n, Prop) decidable_of_iff (∀ k (h : k < succ n), P k (le_of_lt_succ h)) ⟨λ a k h, a k (lt_succ_of_le h), λ a k h, a k _⟩ -instance decidable_lo_hi (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : - decidable (∀x, lo ≤ x → x < hi → P x) := -decidable_of_iff (∀ x < hi - lo, P (lo + x)) -⟨λal x hl hh, by { have := al (x - lo) ((tsub_lt_tsub_iff_right hl).mpr hh), - rwa [add_tsub_cancel_of_le hl] at this, }, -λal x h, al _ (nat.le_add_right _ _) (lt_tsub_iff_left.mp h)⟩ - -instance decidable_lo_hi_le (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : - decidable (∀x, lo ≤ x → x ≤ hi → P x) := -decidable_of_iff (∀x, lo ≤ x → x < hi + 1 → P x) $ -ball_congr $ λ x hl, imp_congr lt_succ_iff iff.rfl - instance decidable_exists_lt {P : ℕ → Prop} [h : decidable_pred P] : decidable_pred (λ n, ∃ (m : ℕ), m < n ∧ P m) | 0 := is_false (by simp) diff --git a/src/data/nat/bits.lean b/src/data/nat/bits.lean new file mode 100644 index 0000000000000..662a5a507bef0 --- /dev/null +++ b/src/data/nat/bits.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2022 Praneeth Kolichala. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Praneeth Kolichala +-/ +import data.nat.basic + +/-! +# Additional properties of binary recursion on `nat` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file documents additional properties of binary recursion, +which allows us to more easily work with operations which do depend +on the number of leading zeros in the binary representation of `n`. +For example, we can more easily work with `nat.bits` and `nat.size`. + +See also: `nat.bitwise`, `nat.pow` (for various lemmas about `size` and `shiftl`/`shiftr`), +and `nat.digits`. +-/ + +namespace nat + +universe u +variables {n : ℕ} + +/-! ### `bodd_div2` and `bodd` -/ + +@[simp] theorem bodd_div2_eq (n : ℕ) : bodd_div2 n = (bodd n, div2 n) := +by unfold bodd div2; cases bodd_div2 n; refl + +@[simp] lemma bodd_bit0 (n) : bodd (bit0 n) = ff := bodd_bit ff n +@[simp] lemma bodd_bit1 (n) : bodd (bit1 n) = tt := bodd_bit tt n + +@[simp] lemma div2_bit0 (n) : div2 (bit0 n) = n := div2_bit ff n +@[simp] lemma div2_bit1 (n) : div2 (bit1 n) = n := div2_bit tt n + +/-! ### `bit0` and `bit1` -/ + +-- There is no need to prove `bit0_eq_zero : bit0 n = 0 ↔ n = 0` +-- as this is true for any `[semiring R] [no_zero_divisors R] [char_zero R]` + +-- However the lemmas `bit0_eq_bit0`, `bit1_eq_bit1`, `bit1_eq_one`, `one_eq_bit1` +-- need `[ring R] [no_zero_divisors R] [char_zero R]` in general, +-- so we prove `ℕ` specialized versions here. +@[simp] lemma bit0_eq_bit0 {m n : ℕ} : bit0 m = bit0 n ↔ m = n := +⟨nat.bit0_inj, λ h, by subst h⟩ + +@[simp] lemma bit1_eq_bit1 {m n : ℕ} : bit1 m = bit1 n ↔ m = n := +⟨nat.bit1_inj, λ h, by subst h⟩ + +@[simp] lemma bit1_eq_one {n : ℕ} : bit1 n = 1 ↔ n = 0 := +⟨@nat.bit1_inj n 0, λ h, by subst h⟩ +@[simp] lemma one_eq_bit1 {n : ℕ} : 1 = bit1 n ↔ n = 0 := +⟨λ h, (@nat.bit1_inj 0 n h).symm, λ h, by subst h⟩ + +theorem bit_add : ∀ (b : bool) (n m : ℕ), bit b (n + m) = bit ff n + bit b m +| tt := bit1_add +| ff := bit0_add + +theorem bit_add' : ∀ (b : bool) (n m : ℕ), bit b (n + m) = bit b n + bit ff m +| tt := bit1_add' +| ff := bit0_add + +theorem bit_ne_zero (b) {n} (h : n ≠ 0) : bit b n ≠ 0 := +by cases b; [exact nat.bit0_ne_zero h, exact nat.bit1_ne_zero _] + +lemma bit0_mod_two : bit0 n % 2 = 0 := by { rw nat.mod_two_of_bodd, simp } + +lemma bit1_mod_two : bit1 n % 2 = 1 := by { rw nat.mod_two_of_bodd, simp } + +lemma pos_of_bit0_pos {n : ℕ} (h : 0 < bit0 n) : 0 < n := +by { cases n, cases h, apply succ_pos, } + +@[simp] lemma bit_cases_on_bit {C : ℕ → Sort u} (H : Π b n, C (bit b n)) (b : bool) (n : ℕ) : + bit_cases_on (bit b n) H = H b n := +eq_of_heq $ (eq_rec_heq _ _).trans $ by rw [bodd_bit, div2_bit] + +@[simp] lemma bit_cases_on_bit0 {C : ℕ → Sort u} (H : Π b n, C (bit b n)) (n : ℕ) : + bit_cases_on (bit0 n) H = H ff n := +bit_cases_on_bit H ff n + +@[simp] lemma bit_cases_on_bit1 {C : ℕ → Sort u} (H : Π b n, C (bit b n)) (n : ℕ) : + bit_cases_on (bit1 n) H = H tt n := +bit_cases_on_bit H tt n + +lemma bit_cases_on_injective {C : ℕ → Sort u} : + function.injective (λ H : Π b n, C (bit b n), λ n, bit_cases_on n H) := +begin + intros H₁ H₂ h, + ext b n, + simpa only [bit_cases_on_bit] using congr_fun h (bit b n) +end + +@[simp] lemma bit_cases_on_inj {C : ℕ → Sort u} (H₁ H₂ : Π b n, C (bit b n)) : + (λ n, bit_cases_on n H₁) = (λ n, bit_cases_on n H₂) ↔ H₁ = H₂ := +bit_cases_on_injective.eq_iff + +protected lemma bit0_eq_zero {n : ℕ} : bit0 n = 0 ↔ n = 0 := +⟨nat.eq_zero_of_add_eq_zero_left, λ h, by simp [h]⟩ + +lemma bit_eq_zero_iff {n : ℕ} {b : bool} : bit b n = 0 ↔ n = 0 ∧ b = ff := +by { split, { cases b; simp [nat.bit, nat.bit0_eq_zero], }, rintro ⟨rfl, rfl⟩, refl, } + +/-- The same as binary_rec_eq, but that one unfortunately requires `f` to be the identity when + appending `ff` to `0`. Here, we allow you to explicitly say that that case is not happening, i.e. + supplying `n = 0 → b = tt`. -/ +lemma binary_rec_eq' {C : ℕ → Sort*} {z : C 0} {f : ∀ b n, C n → C (bit b n)} + (b n) (h : f ff 0 z = z ∨ (n = 0 → b = tt)) : + binary_rec z f (bit b n) = f b n (binary_rec z f n) := +begin + rw [binary_rec], + split_ifs with h', + { rcases bit_eq_zero_iff.mp h' with ⟨rfl, rfl⟩, + rw binary_rec_zero, + simp only [imp_false, or_false, eq_self_iff_true, not_true] at h, + exact h.symm }, + { generalize_proofs e, revert e, + rw [bodd_bit, div2_bit], + intros, refl, } +end + +/-- The same as `binary_rec`, but the induction step can assume that if `n=0`, + the bit being appended is `tt`-/ +@[elab_as_eliminator] +def binary_rec' {C : ℕ → Sort*} (z : C 0) (f : ∀ b n, (n = 0 → b = tt) → C n → C (bit b n)) : + ∀ n, C n := +binary_rec z (λ b n ih, if h : n = 0 → b = tt then f b n h ih else + by { convert z, rw bit_eq_zero_iff, simpa using h, }) + +/-- The same as `binary_rec`, but special casing both 0 and 1 as base cases -/ +@[elab_as_eliminator] +def binary_rec_from_one {C : ℕ → Sort*} (z₀ : C 0) (z₁ : C 1) + (f : ∀ b n, n ≠ 0 → C n → C (bit b n)) : ∀ n, C n := +binary_rec' z₀ (λ b n h ih, if h' : n = 0 then by { rw [h', h h'], exact z₁ } else f b n h' ih) + +@[simp] lemma zero_bits : bits 0 = [] := by simp [nat.bits] + +@[simp] lemma bits_append_bit (n : ℕ) (b : bool) (hn : n = 0 → b = tt) : + (bit b n).bits = b :: n.bits := +by { rw [nat.bits, binary_rec_eq'], simpa, } + +@[simp] lemma bit0_bits (n : ℕ) (hn : n ≠ 0) : (bit0 n).bits = ff :: n.bits := +bits_append_bit n ff (λ hn', absurd hn' hn) + +@[simp] lemma bit1_bits (n : ℕ) : (bit1 n).bits = tt :: n.bits := +bits_append_bit n tt (λ _, rfl) + +@[simp] lemma one_bits : nat.bits 1 = [tt] := by { convert bit1_bits 0, simp, } + +-- TODO Find somewhere this can live. +-- example : bits 3423 = [tt, tt, tt, tt, tt, ff, tt, ff, tt, ff, tt, tt] := by norm_num + +lemma bodd_eq_bits_head (n : ℕ) : n.bodd = n.bits.head := +begin + induction n using nat.binary_rec' with b n h ih, { simp, }, + simp [bodd_bit, bits_append_bit _ _ h], +end + +lemma div2_bits_eq_tail (n : ℕ) : n.div2.bits = n.bits.tail := +begin + induction n using nat.binary_rec' with b n h ih, { simp, }, + simp [div2_bit, bits_append_bit _ _ h], +end + +end nat diff --git a/src/data/nat/bitwise.lean b/src/data/nat/bitwise.lean index 71488ae19e2d0..54358c6ec377d 100644 --- a/src/data/nat/bitwise.lean +++ b/src/data/nat/bitwise.lean @@ -3,11 +3,16 @@ Copyright (c) 2020 Markus Himmel. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Markus Himmel -/ +import data.list.basic +import data.nat.bits import tactic.linarith /-! # Bitwise operations on natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In the first half of this file, we provide theorems for reasoning about natural numbers from their bitwise properties. In the second half of this file, we show properties of the bitwise operations `lor`, `land` and `lxor`, which are defined in core. @@ -38,7 +43,7 @@ namespace nat @[simp] lemma bit_tt : bit tt = bit1 := rfl @[simp] lemma bit_eq_zero {n : ℕ} {b : bool} : n.bit b = 0 ↔ n = 0 ∧ b = ff := -by { cases b; norm_num [bit0_eq_zero, nat.bit1_ne_zero] } +by { cases b; simp [nat.bit0_eq_zero, nat.bit1_ne_zero] } lemma zero_of_test_bit_eq_ff {n : ℕ} (h : ∀ i, test_bit n i = ff) : n = 0 := begin @@ -51,6 +56,16 @@ end @[simp] lemma zero_test_bit (i : ℕ) : test_bit 0 i = ff := by simp [test_bit] +/-- The ith bit is the ith element of `n.bits`. -/ +lemma test_bit_eq_inth (n i : ℕ) : n.test_bit i = n.bits.inth i := +begin + induction i with i ih generalizing n, + { simp [test_bit, shiftr, bodd_eq_bits_head, list.inth_zero_eq_head], }, + conv_lhs { rw ← bit_decomp n, }, + rw [test_bit_succ, ih n.div2, div2_bits_eq_tail], + cases n.bits; simp, +end + /-- Bitwise extensionality: Two numbers agree if they agree at every bit position. -/ lemma eq_of_test_bit_eq {n m : ℕ} (h : ∀ i, test_bit n i = test_bit m i) : n = m := begin @@ -167,17 +182,32 @@ lemma lor_assoc (n m k : ℕ) : lor (lor n m) k = lor n (lor m k) := by bitwise_ @[simp] lemma lxor_self (n : ℕ) : lxor n n = 0 := zero_of_test_bit_eq_ff $ λ i, by simp -lemma lxor_right_inj {n m m' : ℕ} (h : lxor n m = lxor n m') : m = m' := -calc m = lxor n (lxor n m') : by simp [←lxor_assoc, ←h] - ... = m' : by simp [←lxor_assoc] +-- These lemmas match `mul_inv_cancel_right` and `mul_inv_cancel_left`. + +lemma lxor_cancel_right (n m : ℕ) : lxor (lxor m n) n = m := +by rw [lxor_assoc, lxor_self, lxor_zero] + +lemma lxor_cancel_left (n m : ℕ) : lxor n (lxor n m) = m := +by rw [←lxor_assoc, lxor_self, zero_lxor] -lemma lxor_left_inj {n n' m : ℕ} (h : lxor n m = lxor n' m) : n = n' := -by { rw [lxor_comm n m, lxor_comm n' m] at h, exact lxor_right_inj h } +lemma lxor_right_injective {n : ℕ} : function.injective (lxor n) := +λ m m' h, by rw [←lxor_cancel_left n m, ←lxor_cancel_left n m', h] -lemma lxor_eq_zero {n m : ℕ} : lxor n m = 0 ↔ n = m := -⟨by { rw ←lxor_self m, exact lxor_left_inj }, by { rintro rfl, exact lxor_self _ }⟩ +lemma lxor_left_injective {n : ℕ} : function.injective (λ m, lxor m n) := +λ m m' (h : lxor m n = lxor m' n), by rw [←lxor_cancel_right n m, ←lxor_cancel_right n m', h] -lemma lxor_trichotomy {a b c : ℕ} (h : lxor a (lxor b c) ≠ 0) : +@[simp] lemma lxor_right_inj {n m m' : ℕ} : lxor n m = lxor n m' ↔ m = m' := +lxor_right_injective.eq_iff + +@[simp] lemma lxor_left_inj {n m m' : ℕ} : lxor m n = lxor m' n ↔ m = m' := +lxor_left_injective.eq_iff + +@[simp] lemma lxor_eq_zero {n m : ℕ} : lxor n m = 0 ↔ n = m := +by rw [←lxor_self n, lxor_right_inj, eq_comm] + +lemma lxor_ne_zero {n m : ℕ} : lxor n m ≠ 0 ↔ n ≠ m := lxor_eq_zero.not + +lemma lxor_trichotomy {a b c : ℕ} (h : a ≠ lxor b c) : lxor b c < a ∨ lxor a c < b ∨ lxor a b < c := begin set v := lxor a (lxor b c) with hv, @@ -194,7 +224,7 @@ begin -- If `i` is the position of the most significant bit of `v`, then at least one of `a`, `b`, `c` -- has a one bit at position `i`. - obtain ⟨i, ⟨hi, hi'⟩⟩ := exists_most_significant_bit h, + obtain ⟨i, ⟨hi, hi'⟩⟩ := exists_most_significant_bit (lxor_ne_zero.2 h), have : test_bit a i = tt ∨ test_bit b i = tt ∨ test_bit c i = tt, { contrapose! hi, simp only [eq_ff_eq_not_eq_tt, ne, test_bit_lxor] at ⊢ hi, @@ -207,4 +237,7 @@ begin exact lt_of_test_bit i (by simp [h, hi]) h (λ j hj, by simp [hi' _ hj]) end +lemma lt_lxor_cases {a b c : ℕ} (h : a < lxor b c) : lxor a c < b ∨ lxor a b < c := +(or_iff_right $ λ h', (h.asymm h').elim).1 $ lxor_trichotomy h.ne + end nat diff --git a/src/data/nat/cast.lean b/src/data/nat/cast.lean deleted file mode 100644 index e9cd6999cfd12..0000000000000 --- a/src/data/nat/cast.lean +++ /dev/null @@ -1,414 +0,0 @@ -/- -Copyright (c) 2014 Mario Carneiro. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Mario Carneiro --/ -import algebra.order.field -import data.nat.basic - -/-! -# Cast of naturals - -This file defines the *canonical* homomorphism from the natural numbers into a type `α` with `0`, -`1` and `+` (typically an `add_monoid` with one). - -## Main declarations - -* `cast`: Canonical homomorphism `ℕ → α` where `α` has a `0`, `1` and `+`. -* `bin_cast`: Binary representation version of `cast`. -* `cast_add_monoid_hom`: `cast` bundled as an `add_monoid_hom`. -* `cast_ring_hom`: `cast` bundled as a `ring_hom`. - -## Implementation note - -Setting up the coercions priorities is tricky. See Note [coercion into rings]. --/ - -namespace nat -variables {α : Type*} - -section -variables [has_zero α] [has_one α] [has_add α] - -/-- Canonical homomorphism from `ℕ` to a type `α` with `0`, `1` and `+`. -/ -protected def cast : ℕ → α -| 0 := 0 -| (n+1) := cast n + 1 - -/-- Computationally friendlier cast than `nat.cast`, using binary representation. -/ -protected def bin_cast (n : ℕ) : α := -@nat.binary_rec (λ _, α) 0 (λ odd k a, cond odd (a + a + 1) (a + a)) n - -/-- -Coercions such as `nat.cast_coe` that go from a concrete structure such as -`ℕ` to an arbitrary ring `α` should be set up as follows: -```lean -@[priority 900] instance : has_coe_t ℕ α := ⟨...⟩ -``` - -It needs to be `has_coe_t` instead of `has_coe` because otherwise type-class -inference would loop when constructing the transitive coercion `ℕ → ℕ → ℕ → ...`. -The reduced priority is necessary so that it doesn't conflict with instances -such as `has_coe_t α (option α)`. - -For this to work, we reduce the priority of the `coe_base` and `coe_trans` -instances because we want the instances for `has_coe_t` to be tried in the -following order: - - 1. `has_coe_t` instances declared in mathlib (such as `has_coe_t α (with_top α)`, etc.) - 2. `coe_base`, which contains instances such as `has_coe (fin n) n` - 3. `nat.cast_coe : has_coe_t ℕ α` etc. - 4. `coe_trans` - -If `coe_trans` is tried first, then `nat.cast_coe` doesn't get a chance to apply. --/ -library_note "coercion into rings" -attribute [instance, priority 950] coe_base -attribute [instance, priority 500] coe_trans - --- see note [coercion into rings] -@[priority 900] instance cast_coe : has_coe_t ℕ α := ⟨nat.cast⟩ - -@[simp, norm_cast] theorem cast_zero : ((0 : ℕ) : α) = 0 := rfl - -theorem cast_add_one (n : ℕ) : ((n + 1 : ℕ) : α) = n + 1 := rfl - -@[simp, norm_cast, priority 500] -theorem cast_succ (n : ℕ) : ((succ n : ℕ) : α) = n + 1 := rfl - -@[simp, norm_cast] theorem cast_ite (P : Prop) [decidable P] (m n : ℕ) : - (((ite P m n) : ℕ) : α) = ite P (m : α) (n : α) := -by { split_ifs; refl, } - -end - -@[simp, norm_cast] theorem cast_one [add_zero_class α] [has_one α] : ((1 : ℕ) : α) = 1 := zero_add _ - -@[simp, norm_cast] theorem cast_add [add_monoid α] [has_one α] (m) : ∀ n, ((m + n : ℕ) : α) = m + n -| 0 := (add_zero _).symm -| (n+1) := show ((m + n : ℕ) : α) + 1 = m + (n + 1), by rw [cast_add n, add_assoc] - -@[simp] lemma bin_cast_eq [add_monoid α] [has_one α] (n : ℕ) : - (nat.bin_cast n : α) = ((n : ℕ) : α) := -begin - rw nat.bin_cast, - apply binary_rec _ _ n, - { rw [binary_rec_zero, cast_zero] }, - { intros b k h, - rw [binary_rec_eq, h], - { cases b; simp [bit, bit0, bit1] }, - { simp } }, -end - -/-- `coe : ℕ → α` as an `add_monoid_hom`. -/ -def cast_add_monoid_hom (α : Type*) [add_monoid α] [has_one α] : ℕ →+ α := -{ to_fun := coe, - map_add' := cast_add, - map_zero' := cast_zero } - -@[simp] lemma coe_cast_add_monoid_hom [add_monoid α] [has_one α] : - (cast_add_monoid_hom α : ℕ → α) = coe := rfl - -@[simp, norm_cast] theorem cast_bit0 [add_monoid α] [has_one α] (n : ℕ) : - ((bit0 n : ℕ) : α) = bit0 n := cast_add _ _ - -@[simp, norm_cast] theorem cast_bit1 [add_monoid α] [has_one α] (n : ℕ) : - ((bit1 n : ℕ) : α) = bit1 n := -by rw [bit1, cast_add_one, cast_bit0]; refl - -lemma cast_two {α : Type*} [add_zero_class α] [has_one α] : ((2 : ℕ) : α) = 2 := -by rw [cast_add_one, cast_one, bit0] - -@[simp, norm_cast] theorem cast_pred [add_group α] [has_one α] : - ∀ {n}, 0 < n → ((n - 1 : ℕ) : α) = n - 1 -| (n+1) h := (add_sub_cancel (n:α) 1).symm - -@[simp, norm_cast] theorem cast_sub [add_group α] [has_one α] {m n} (h : m ≤ n) : - ((n - m : ℕ) : α) = n - m := -eq_sub_of_add_eq $ by rw [← cast_add, tsub_add_cancel_of_le h] - -@[simp, norm_cast] theorem cast_mul [non_assoc_semiring α] (m) : ∀ n, ((m * n : ℕ) : α) = m * n -| 0 := (mul_zero _).symm -| (n+1) := (cast_add _ _).trans $ -show ((m * n : ℕ) : α) + m = m * (n + 1), by rw [cast_mul n, left_distrib, mul_one] - -@[simp] theorem cast_div [field α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) : - ((m / n : ℕ) : α) = m / n := -begin - rcases n_dvd with ⟨k, rfl⟩, - have : n ≠ 0, {rintro rfl, simpa using n_nonzero}, - rw [nat.mul_div_cancel_left _ this.bot_lt, cast_mul, mul_div_cancel_left _ n_nonzero], -end - -/-- `coe : ℕ → α` as a `ring_hom` -/ -def cast_ring_hom (α : Type*) [non_assoc_semiring α] : ℕ →+* α := -{ to_fun := coe, - map_one' := cast_one, - map_mul' := cast_mul, - .. cast_add_monoid_hom α } - -@[simp] lemma coe_cast_ring_hom [non_assoc_semiring α] : (cast_ring_hom α : ℕ → α) = coe := rfl - -lemma cast_commute [non_assoc_semiring α] (n : ℕ) (x : α) : commute ↑n x := -nat.rec_on n (commute.zero_left x) $ λ n ihn, ihn.add_left $ commute.one_left x - -lemma cast_comm [non_assoc_semiring α] (n : ℕ) (x : α) : (n : α) * x = x * n := -(cast_commute n x).eq - -lemma commute_cast [non_assoc_semiring α] (x : α) (n : ℕ) : commute x n := -(n.cast_commute x).symm - -section - -variables [ordered_semiring α] - -@[simp] theorem cast_nonneg : ∀ n : ℕ, 0 ≤ (n : α) -| 0 := le_rfl -| (n+1) := add_nonneg (cast_nonneg n) zero_le_one - -@[mono] theorem mono_cast : monotone (coe : ℕ → α) := -λ m n h, let ⟨k, hk⟩ := le_iff_exists_add.1 h in by simp [hk] - -variable [nontrivial α] - -theorem strict_mono_cast : strict_mono (coe : ℕ → α) := -λ m n h, nat.le_induction (lt_add_of_pos_right _ zero_lt_one) - (λ n _ h, lt_add_of_lt_of_pos' h zero_lt_one) _ h - -@[simp, norm_cast] theorem cast_le {m n : ℕ} : - (m : α) ≤ n ↔ m ≤ n := -strict_mono_cast.le_iff_le - -@[simp, norm_cast, mono] theorem cast_lt {m n : ℕ} : (m : α) < n ↔ m < n := -strict_mono_cast.lt_iff_lt - -@[simp] theorem cast_pos {n : ℕ} : (0 : α) < n ↔ 0 < n := -by rw [← cast_zero, cast_lt] - -lemma cast_add_one_pos (n : ℕ) : 0 < (n : α) + 1 := - add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one - -@[simp, norm_cast] theorem one_lt_cast {n : ℕ} : 1 < (n : α) ↔ 1 < n := -by rw [← cast_one, cast_lt] - -@[simp, norm_cast] theorem one_le_cast {n : ℕ} : 1 ≤ (n : α) ↔ 1 ≤ n := -by rw [← cast_one, cast_le] - -@[simp, norm_cast] theorem cast_lt_one {n : ℕ} : (n : α) < 1 ↔ n = 0 := -by rw [← cast_one, cast_lt, lt_succ_iff, le_zero_iff] - -@[simp, norm_cast] theorem cast_le_one {n : ℕ} : (n : α) ≤ 1 ↔ n ≤ 1 := -by rw [← cast_one, cast_le] - -end - -@[simp, norm_cast] theorem cast_min [linear_ordered_semiring α] {a b : ℕ} : - (↑(min a b) : α) = min a b := -(@mono_cast α _).map_min - -@[simp, norm_cast] theorem cast_max [linear_ordered_semiring α] {a b : ℕ} : - (↑(max a b) : α) = max a b := -(@mono_cast α _).map_max - -@[simp, norm_cast] theorem abs_cast [linear_ordered_ring α] (a : ℕ) : - |(a : α)| = a := -abs_of_nonneg (cast_nonneg a) - -lemma coe_nat_dvd [semiring α] {m n : ℕ} (h : m ∣ n) : (m : α) ∣ (n : α) := -(nat.cast_ring_hom α).map_dvd h - -alias coe_nat_dvd ← has_dvd.dvd.nat_cast - -section linear_ordered_field -variables [linear_ordered_field α] - -/-- Natural division is always less than division in the field. -/ -lemma cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n := -begin - cases n, - { rw [cast_zero, div_zero, nat.div_zero, cast_zero] }, - rwa [le_div_iff, ←nat.cast_mul], - exact nat.cast_le.2 (nat.div_mul_le_self m n.succ), - { exact nat.cast_pos.2 n.succ_pos } -end - -lemma inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ := -inv_pos.2 $ add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one - -lemma one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) := -by { rw one_div, exact inv_pos_of_nat } - -lemma one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) := -by { refine one_div_le_one_div_of_le _ _, exact nat.cast_add_one_pos _, simpa } - -lemma one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) := -by { refine one_div_lt_one_div_of_lt _ _, exact nat.cast_add_one_pos _, simpa } - -end linear_ordered_field - -end nat - -namespace prod - -variables {α : Type*} {β : Type*} [has_zero α] [has_one α] [has_add α] - [has_zero β] [has_one β] [has_add β] - -@[simp] lemma fst_nat_cast (n : ℕ) : (n : α × β).fst = n := -by induction n; simp * - -@[simp] lemma snd_nat_cast (n : ℕ) : (n : α × β).snd = n := -by induction n; simp * - -end prod - -section add_monoid_hom_class - -variables {A B F : Type*} [add_zero_class A] [add_monoid B] [has_one B] - -lemma ext_nat' [add_monoid_hom_class F ℕ A] (f g : F) (h : f 1 = g 1) : f = g := -fun_like.ext f g $ begin - apply nat.rec, - { simp only [nat.nat_zero_eq_zero, map_zero] }, - simp [nat.succ_eq_add_one, h] {contextual := tt} -end - -@[ext] lemma add_monoid_hom.ext_nat : ∀ {f g : ℕ →+ A}, ∀ h : f 1 = g 1, f = g := ext_nat' - -variable [has_one A] - --- these versions are primed so that the `ring_hom_class` versions aren't -lemma eq_nat_cast' [add_monoid_hom_class F ℕ A] (f : F) (h1 : f 1 = 1) : - ∀ n : ℕ, f n = n -| 0 := by simp -| (n+1) := by rw [map_add, h1, eq_nat_cast' n, nat.cast_add_one] - -lemma map_nat_cast' {A} [add_monoid A] [has_one A] [add_monoid_hom_class F A B] - (f : F) (h : f 1 = 1) : ∀ (n : ℕ), f n = n -| 0 := by simp -| (n+1) := by rw [nat.cast_add, map_add, nat.cast_add, map_nat_cast', nat.cast_one, h, nat.cast_one] - -end add_monoid_hom_class - -section monoid_with_zero_hom_class - -variables {A F : Type*} [mul_zero_one_class A] - -/-- If two `monoid_with_zero_hom`s agree on the positive naturals they are equal. -/ -theorem ext_nat'' [monoid_with_zero_hom_class F ℕ A] (f g : F) - (h_pos : ∀ {n : ℕ}, 0 < n → f n = g n) : f = g := -begin - apply fun_like.ext, - rintro (_|n), - { simp }, - exact h_pos n.succ_pos -end - -@[ext] theorem monoid_with_zero_hom.ext_nat : - ∀ {f g : ℕ →*₀ A}, (∀ {n : ℕ}, 0 < n → f n = g n) → f = g := ext_nat'' - -end monoid_with_zero_hom_class - -section ring_hom_class - -variables {R S F : Type*} [non_assoc_semiring R] [non_assoc_semiring S] - -@[simp] lemma eq_nat_cast [ring_hom_class F ℕ R] (f : F) : ∀ n, f n = n := -eq_nat_cast' f $ map_one f - -@[simp] lemma map_nat_cast [ring_hom_class F R S] (f : F) : ∀ n : ℕ, f (n : R) = n := -map_nat_cast' f $ map_one f - -lemma ext_nat [ring_hom_class F ℕ R] (f g : F) : f = g := -ext_nat' f g $ by simp only [map_one] - -end ring_hom_class - -namespace ring_hom - -/-- This is primed to match `ring_hom.eq_int_cast'`. -/ -lemma eq_nat_cast' {R} [non_assoc_semiring R] (f : ℕ →+* R) : f = nat.cast_ring_hom R := -ring_hom.ext $ eq_nat_cast f - -end ring_hom - -@[simp, norm_cast] theorem nat.cast_id (n : ℕ) : ↑n = n := -(eq_nat_cast (ring_hom.id ℕ) n).symm - -@[simp] lemma nat.cast_ring_hom_nat : nat.cast_ring_hom ℕ = ring_hom.id ℕ := -((ring_hom.id ℕ).eq_nat_cast').symm - -@[simp] theorem nat.cast_with_bot : ∀ (n : ℕ), - @coe ℕ (with_bot ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n -| 0 := rfl -| (n+1) := by rw [with_bot.coe_add, nat.cast_add, nat.cast_with_bot n]; refl - --- I don't think `ring_hom_class` is good here, because of the `subsingleton` TC slowness -instance nat.unique_ring_hom {R : Type*} [non_assoc_semiring R] : unique (ℕ →+* R) := -{ default := nat.cast_ring_hom R, uniq := ring_hom.eq_nat_cast' } - -namespace mul_opposite - -variables {α : Type*} [has_zero α] [has_one α] [has_add α] - -@[simp, norm_cast] lemma op_nat_cast : ∀ n : ℕ, op (n : α) = n -| 0 := rfl -| (n + 1) := congr_arg (+ (1 : αᵐᵒᵖ)) $ op_nat_cast n - -@[simp, norm_cast] lemma unop_nat_cast : ∀ n : ℕ, unop (n : αᵐᵒᵖ) = n -| 0 := rfl -| (n + 1) := congr_arg (+ (1 : α)) $ unop_nat_cast n - -end mul_opposite - -namespace with_top -variables {α : Type*} - -variables [has_zero α] [has_one α] [has_add α] - -@[simp, norm_cast] lemma coe_nat : ∀ (n : ℕ), ((n : α) : with_top α) = n -| 0 := rfl -| (n+1) := by { push_cast, rw [coe_nat n] } - -@[simp] lemma nat_ne_top (n : nat) : (n : with_top α) ≠ ⊤ := -by { rw [←coe_nat n], apply coe_ne_top } - -@[simp] lemma top_ne_nat (n : nat) : (⊤ : with_top α) ≠ n := -by { rw [←coe_nat n], apply top_ne_coe } - -lemma add_one_le_of_lt {i n : with_top ℕ} (h : i < n) : i + 1 ≤ n := -begin - cases n, { exact le_top }, - cases i, { exact (not_le_of_lt h le_top).elim }, - exact with_top.coe_le_coe.2 (with_top.coe_lt_coe.1 h) -end - -lemma one_le_iff_pos {n : with_top ℕ} : 1 ≤ n ↔ 0 < n := -⟨lt_of_lt_of_le (coe_lt_coe.mpr zero_lt_one), - λ h, by simpa only [zero_add] using add_one_le_of_lt h⟩ - -@[elab_as_eliminator] -lemma nat_induction {P : with_top ℕ → Prop} (a : with_top ℕ) - (h0 : P 0) (hsuc : ∀n:ℕ, P n → P n.succ) (htop : (∀n : ℕ, P n) → P ⊤) : P a := -begin - have A : ∀n:ℕ, P n := λ n, nat.rec_on n h0 hsuc, - cases a, - { exact htop A }, - { exact A a } -end - -end with_top - -namespace pi - -variables {α β : Type*} - -lemma nat_apply [has_zero β] [has_one β] [has_add β] : - ∀ (n : ℕ) (a : α), (n : α → β) a = n -| 0 a := rfl -| (n+1) a := by rw [nat.cast_succ, nat.cast_succ, add_apply, nat_apply, one_apply] - -@[simp] lemma coe_nat [has_zero β] [has_one β] [has_add β] (n : ℕ) : - (n : α → β) = λ _, n := -by { ext, rw pi.nat_apply } - -end pi diff --git a/src/data/nat/cast/basic.lean b/src/data/nat/cast/basic.lean new file mode 100644 index 0000000000000..1f06d0878e807 --- /dev/null +++ b/src/data/nat/cast/basic.lean @@ -0,0 +1,268 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import algebra.char_zero.defs +import algebra.group_with_zero.commute +import algebra.hom.ring +import algebra.order.group.abs +import algebra.ring.commute +import data.nat.order.basic +import algebra.group.opposite + +/-! +# Cast of natural numbers (additional theorems) + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file proves additional properties about the *canonical* homomorphism from +the natural numbers into an additive monoid with a one (`nat.cast`). + +## Main declarations + +* `cast_add_monoid_hom`: `cast` bundled as an `add_monoid_hom`. +* `cast_ring_hom`: `cast` bundled as a `ring_hom`. +-/ + +variables {α β : Type*} + +namespace nat + +/-- `coe : ℕ → α` as an `add_monoid_hom`. -/ +def cast_add_monoid_hom (α : Type*) [add_monoid_with_one α] : ℕ →+ α := +{ to_fun := coe, + map_add' := cast_add, + map_zero' := cast_zero } + +@[simp] lemma coe_cast_add_monoid_hom [add_monoid_with_one α] : + (cast_add_monoid_hom α : ℕ → α) = coe := rfl + +@[simp, norm_cast] theorem cast_mul [non_assoc_semiring α] (m n : ℕ) : + ((m * n : ℕ) : α) = m * n := +by induction n; simp [mul_succ, mul_add, *] + +/-- `coe : ℕ → α` as a `ring_hom` -/ +def cast_ring_hom (α : Type*) [non_assoc_semiring α] : ℕ →+* α := +{ to_fun := coe, + map_one' := cast_one, + map_mul' := cast_mul, + .. cast_add_monoid_hom α } + +@[simp] lemma coe_cast_ring_hom [non_assoc_semiring α] : (cast_ring_hom α : ℕ → α) = coe := rfl + +lemma cast_commute [non_assoc_semiring α] (n : ℕ) (x : α) : commute ↑n x := +nat.rec_on n (by rw [cast_zero]; exact commute.zero_left x) $ +λ n ihn, by rw [cast_succ]; exact ihn.add_left (commute.one_left x) + +lemma cast_comm [non_assoc_semiring α] (n : ℕ) (x : α) : (n : α) * x = x * n := +(cast_commute n x).eq + +lemma commute_cast [non_assoc_semiring α] (x : α) (n : ℕ) : commute x n := +(n.cast_commute x).symm + +section ordered_semiring +variables [ordered_semiring α] + +@[mono] theorem mono_cast : monotone (coe : ℕ → α) := +monotone_nat_of_le_succ $ λ n, by rw [nat.cast_succ]; exact le_add_of_nonneg_right zero_le_one + +@[simp] theorem cast_nonneg (n : ℕ) : 0 ≤ (n : α) := +@nat.cast_zero α _ ▸ mono_cast (nat.zero_le n) + +section nontrivial +variable [nontrivial α] + +lemma cast_add_one_pos (n : ℕ) : 0 < (n : α) + 1 := +zero_lt_one.trans_le $ le_add_of_nonneg_left n.cast_nonneg + +@[simp] lemma cast_pos {n : ℕ} : (0 : α) < n ↔ 0 < n := by cases n; simp [cast_add_one_pos] + +end nontrivial + +variables [char_zero α] {m n : ℕ} + +lemma strict_mono_cast : strict_mono (coe : ℕ → α) := +mono_cast.strict_mono_of_injective cast_injective + +/-- `coe : ℕ → α` as an `order_embedding` -/ +@[simps { fully_applied := ff }] def cast_order_embedding : ℕ ↪o α := +order_embedding.of_strict_mono coe nat.strict_mono_cast + +@[simp, norm_cast] lemma cast_le : (m : α) ≤ n ↔ m ≤ n := strict_mono_cast.le_iff_le +@[simp, norm_cast, mono] lemma cast_lt : (m : α) < n ↔ m < n := strict_mono_cast.lt_iff_lt + +@[simp, norm_cast] lemma one_lt_cast : 1 < (n : α) ↔ 1 < n := by rw [←cast_one, cast_lt] +@[simp, norm_cast] lemma one_le_cast : 1 ≤ (n : α) ↔ 1 ≤ n := by rw [←cast_one, cast_le] + +@[simp, norm_cast] lemma cast_lt_one : (n : α) < 1 ↔ n = 0 := +by rw [←cast_one, cast_lt, lt_succ_iff, ←bot_eq_zero, le_bot_iff] + +@[simp, norm_cast] lemma cast_le_one : (n : α) ≤ 1 ↔ n ≤ 1 := by rw [←cast_one, cast_le] + +end ordered_semiring + +/-- A version of `nat.cast_sub` that works for `ℝ≥0` and `ℚ≥0`. Note that this proof doesn't work +for `ℕ∞` and `ℝ≥0∞`, so we use type-specific lemmas for these types. -/ +@[simp, norm_cast] lemma cast_tsub [canonically_ordered_comm_semiring α] [has_sub α] + [has_ordered_sub α] [contravariant_class α α (+) (≤)] (m n : ℕ) : + ↑(m - n) = (m - n : α) := +begin + cases le_total m n with h h, + { rw [tsub_eq_zero_of_le h, cast_zero, tsub_eq_zero_of_le], + exact mono_cast h }, + { rcases le_iff_exists_add'.mp h with ⟨m, rfl⟩, + rw [add_tsub_cancel_right, cast_add, add_tsub_cancel_right] } +end + +@[simp, norm_cast] theorem cast_min [linear_ordered_semiring α] {a b : ℕ} : + (↑(min a b) : α) = min a b := +(@mono_cast α _).map_min + +@[simp, norm_cast] theorem cast_max [linear_ordered_semiring α] {a b : ℕ} : + (↑(max a b) : α) = max a b := +(@mono_cast α _).map_max + +@[simp, norm_cast] theorem abs_cast [linear_ordered_ring α] (a : ℕ) : + |(a : α)| = a := +abs_of_nonneg (cast_nonneg a) + +lemma coe_nat_dvd [semiring α] {m n : ℕ} (h : m ∣ n) : (m : α) ∣ (n : α) := +map_dvd (nat.cast_ring_hom α) h + +alias coe_nat_dvd ← _root_.has_dvd.dvd.nat_cast + +end nat + +section add_monoid_hom_class + +variables {A B F : Type*} [add_monoid_with_one B] + +lemma ext_nat' [add_monoid A] [add_monoid_hom_class F ℕ A] (f g : F) (h : f 1 = g 1) : f = g := +fun_like.ext f g $ begin + apply nat.rec, + { simp only [nat.nat_zero_eq_zero, map_zero] }, + simp [nat.succ_eq_add_one, h] {contextual := tt} +end + +@[ext] lemma add_monoid_hom.ext_nat [add_monoid A] : ∀ {f g : ℕ →+ A}, ∀ h : f 1 = g 1, f = g := +ext_nat' + +variable [add_monoid_with_one A] + +-- these versions are primed so that the `ring_hom_class` versions aren't +lemma eq_nat_cast' [add_monoid_hom_class F ℕ A] (f : F) (h1 : f 1 = 1) : + ∀ n : ℕ, f n = n +| 0 := by simp +| (n+1) := by rw [map_add, h1, eq_nat_cast' n, nat.cast_add_one] + +lemma map_nat_cast' {A} [add_monoid_with_one A] [add_monoid_hom_class F A B] + (f : F) (h : f 1 = 1) : ∀ (n : ℕ), f n = n +| 0 := by simp +| (n+1) := by rw [nat.cast_add, map_add, nat.cast_add, map_nat_cast', nat.cast_one, h, nat.cast_one] + +end add_monoid_hom_class + +section monoid_with_zero_hom_class + +variables {A F : Type*} [mul_zero_one_class A] + +/-- If two `monoid_with_zero_hom`s agree on the positive naturals they are equal. -/ +theorem ext_nat'' [monoid_with_zero_hom_class F ℕ A] (f g : F) + (h_pos : ∀ {n : ℕ}, 0 < n → f n = g n) : f = g := +begin + apply fun_like.ext, + rintro (_|n), + { simp }, + exact h_pos n.succ_pos +end + +@[ext] theorem monoid_with_zero_hom.ext_nat : + ∀ {f g : ℕ →*₀ A}, (∀ {n : ℕ}, 0 < n → f n = g n) → f = g := ext_nat'' + +end monoid_with_zero_hom_class + +section ring_hom_class + +variables {R S F : Type*} [non_assoc_semiring R] [non_assoc_semiring S] + +@[simp] lemma eq_nat_cast [ring_hom_class F ℕ R] (f : F) : ∀ n, f n = n := +eq_nat_cast' f $ map_one f + +@[simp] lemma map_nat_cast [ring_hom_class F R S] (f : F) : ∀ n : ℕ, f (n : R) = n := +map_nat_cast' f $ map_one f + +lemma ext_nat [ring_hom_class F ℕ R] (f g : F) : f = g := +ext_nat' f g $ by simp only [map_one] + +lemma ne_zero.nat_of_injective {n : ℕ} [h : ne_zero (n : R)] + [ring_hom_class F R S] {f : F} (hf : function.injective f) : ne_zero (n : S) := +⟨λ h, (ne_zero.nat_cast_ne n R) $ hf $ by simpa only [map_nat_cast, map_zero]⟩ + +lemma ne_zero.nat_of_ne_zero {R S} [semiring R] [semiring S] {F} [ring_hom_class F R S] (f : F) + {n : ℕ} [hn : ne_zero (n : S)] : ne_zero (n : R) := +by { apply ne_zero.of_map f, simp only [map_nat_cast, hn] } + +end ring_hom_class + +namespace ring_hom + +/-- This is primed to match `eq_int_cast'`. -/ +lemma eq_nat_cast' {R} [non_assoc_semiring R] (f : ℕ →+* R) : f = nat.cast_ring_hom R := +ring_hom.ext $ eq_nat_cast f + +end ring_hom + +@[simp, norm_cast] theorem nat.cast_id (n : ℕ) : ↑n = n := +rfl + +@[simp] lemma nat.cast_ring_hom_nat : nat.cast_ring_hom ℕ = ring_hom.id ℕ := rfl + +-- I don't think `ring_hom_class` is good here, because of the `subsingleton` TC slowness +instance nat.unique_ring_hom {R : Type*} [non_assoc_semiring R] : unique (ℕ →+* R) := +{ default := nat.cast_ring_hom R, uniq := ring_hom.eq_nat_cast' } + +namespace pi +variables {π : α → Type*} [Π a, has_nat_cast (π a)] + +instance : has_nat_cast (Π a, π a) := +by refine_struct { .. }; tactic.pi_instance_derive_field + +lemma nat_apply (n : ℕ) (a : α) : (n : Π a, π a) a = n := rfl + +@[simp] lemma coe_nat (n : ℕ) : (n : Π a, π a) = λ _, n := rfl + +end pi + +lemma sum.elim_nat_cast_nat_cast {α β γ : Type*} [has_nat_cast γ] (n : ℕ) : + sum.elim (n : α → γ) (n : β → γ) = n := +@sum.elim_lam_const_lam_const α β γ n + +namespace pi +variables {π : α → Type*} [Π a, add_monoid_with_one (π a)] + +instance : add_monoid_with_one (Π a, π a) := +by refine_struct { .. }; tactic.pi_instance_derive_field + +end pi + +/-! ### Order dual -/ + +open order_dual + +instance [h : has_nat_cast α] : has_nat_cast αᵒᵈ := h +instance [h : add_monoid_with_one α] : add_monoid_with_one αᵒᵈ := h +instance [h : add_comm_monoid_with_one α] : add_comm_monoid_with_one αᵒᵈ := h + +@[simp] lemma to_dual_nat_cast [has_nat_cast α] (n : ℕ) : to_dual (n : α) = n := rfl +@[simp] lemma of_dual_nat_cast [has_nat_cast α] (n : ℕ) : (of_dual n : α) = n := rfl + +/-! ### Lexicographic order -/ + +instance [h : has_nat_cast α] : has_nat_cast (lex α) := h +instance [h : add_monoid_with_one α] : add_monoid_with_one (lex α) := h +instance [h : add_comm_monoid_with_one α] : add_comm_monoid_with_one (lex α) := h + +@[simp] lemma to_lex_nat_cast [has_nat_cast α] (n : ℕ) : to_lex (n : α) = n := rfl +@[simp] lemma of_lex_nat_cast [has_nat_cast α] (n : ℕ) : (of_lex n : α) = n := rfl diff --git a/src/data/nat/cast/defs.lean b/src/data/nat/cast/defs.lean new file mode 100644 index 0000000000000..d508ddac3e2da --- /dev/null +++ b/src/data/nat/cast/defs.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Gabriel Ebner +-/ +import algebra.group.defs +import algebra.ne_zero + +/-! +# Cast of natural numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the *canonical* homomorphism from the natural numbers into an +`add_monoid` with a one. In additive monoids with one, there exists a unique +such homomorphism and we store it in the `nat_cast : ℕ → R` field. + +Preferentially, the homomorphism is written as a coercion. + +## Main declarations + +* `add_monoid_with_one`: Type class for `nat.cast`. +* `nat.cast`: Canonical homomorphism `ℕ → R`. +-/ + +universes u +set_option old_structure_cmd true + +/-- The numeral `((0+1)+⋯)+1`. -/ +protected def nat.unary_cast {R : Type u} [has_one R] [has_zero R] [has_add R] : ℕ → R +| 0 := 0 +| (n + 1) := nat.unary_cast n + 1 + +/-- +Type class for the canonical homomorphism `ℕ → R`. +-/ +@[protect_proj] +class has_nat_cast (R : Type u) := +(nat_cast : ℕ → R) + +/-- +An `add_monoid_with_one` is an `add_monoid` with a `1`. +It also contains data for the unique homomorphism `ℕ → R`. +-/ +@[protect_proj, ancestor has_nat_cast add_monoid has_one] +class add_monoid_with_one (R : Type u) extends has_nat_cast R, add_monoid R, has_one R := +(nat_cast := nat.unary_cast) +(nat_cast_zero : nat_cast 0 = (0 : R) . control_laws_tac) +(nat_cast_succ : ∀ n, nat_cast (n + 1) = (nat_cast n + 1 : R) . control_laws_tac) + +/-- Canonical homomorphism from `ℕ` to a additive monoid `R` with a `1`. -/ +protected def nat.cast {R : Type u} [has_nat_cast R] : ℕ → R := has_nat_cast.nat_cast + +/-- An `add_comm_monoid_with_one` is an `add_monoid_with_one` satisfying `a + b = b + a`. -/ +@[protect_proj, ancestor add_monoid_with_one add_comm_monoid] +class add_comm_monoid_with_one (R : Type*) extends add_monoid_with_one R, add_comm_monoid R + +section +variables {R : Type*} [add_monoid_with_one R] + +/-- +Coercions such as `nat.cast_coe` that go from a concrete structure such as +`ℕ` to an arbitrary ring `R` should be set up as follows: +```lean +@[priority 900] instance : has_coe_t ℕ R := ⟨...⟩ +``` + +It needs to be `has_coe_t` instead of `has_coe` because otherwise type-class +inference would loop when constructing the transitive coercion `ℕ → ℕ → ℕ → ...`. +The reduced priority is necessary so that it doesn't conflict with instances +such as `has_coe_t R (option R)`. + +For this to work, we reduce the priority of the `coe_base` and `coe_trans` +instances because we want the instances for `has_coe_t` to be tried in the +following order: + + 1. `has_coe_t` instances declared in mathlib (such as `has_coe_t R (with_top R)`, etc.) + 2. `coe_base`, which contains instances such as `has_coe (fin n) n` + 3. `nat.cast_coe : has_coe_t ℕ R` etc. + 4. `coe_trans` + +If `coe_trans` is tried first, then `nat.cast_coe` doesn't get a chance to apply. +-/ +library_note "coercion into rings" +attribute [instance, priority 950] coe_base +attribute [instance, priority 500] coe_trans + +namespace nat + +-- see note [coercion into rings] +@[priority 900] instance cast_coe {R} [has_nat_cast R] : has_coe_t ℕ R := ⟨nat.cast⟩ + +@[simp, norm_cast] theorem cast_zero : ((0 : ℕ) : R) = 0 := add_monoid_with_one.nat_cast_zero + +-- Lemmas about nat.succ need to get a low priority, so that they are tried last. +-- This is because `nat.succ _` matches `1`, `3`, `x+1`, etc. +-- Rewriting would then produce really wrong terms. +@[simp, norm_cast, priority 500] +theorem cast_succ (n : ℕ) : ((succ n : ℕ) : R) = n + 1 := add_monoid_with_one.nat_cast_succ _ + +theorem cast_add_one (n : ℕ) : ((n + 1 : ℕ) : R) = n + 1 := cast_succ _ + +@[simp, norm_cast] theorem cast_ite (P : Prop) [decidable P] (m n : ℕ) : + (((ite P m n) : ℕ) : R) = ite P (m : R) (n : R) := +by { split_ifs; refl, } + +end nat + +end + +namespace nat +variables {R : Type*} + +@[simp, norm_cast] theorem cast_one [add_monoid_with_one R] : ((1 : ℕ) : R) = 1 := +by rw [cast_succ, cast_zero, zero_add] + +@[simp, norm_cast] theorem cast_add [add_monoid_with_one R] (m n : ℕ) : ((m + n : ℕ) : R) = m + n := +by induction n; simp [add_succ, add_assoc, nat.add_zero, *] + +/-- Computationally friendlier cast than `nat.unary_cast`, using binary representation. -/ +protected def bin_cast [has_zero R] [has_one R] [has_add R] (n : ℕ) : R := +@nat.binary_rec (λ _, R) 0 (λ odd k a, cond odd (a + a + 1) (a + a)) n + +@[simp] lemma bin_cast_eq [add_monoid_with_one R] (n : ℕ) : (nat.bin_cast n : R) = ((n : ℕ) : R) := +begin + rw nat.bin_cast, + apply binary_rec _ _ n, + { rw [binary_rec_zero, cast_zero] }, + { intros b k h, + rw [binary_rec_eq, h], + { cases b; simp [bit, bit0, bit1] }, + { simp } }, +end + +@[simp, norm_cast] theorem cast_bit0 [add_monoid_with_one R] (n : ℕ) : + ((bit0 n : ℕ) : R) = bit0 n := cast_add _ _ + +@[simp, norm_cast] theorem cast_bit1 [add_monoid_with_one R] (n : ℕ) : + ((bit1 n : ℕ) : R) = bit1 n := +by rw [bit1, cast_add_one, cast_bit0]; refl + +lemma cast_two [add_monoid_with_one R] : ((2 : ℕ) : R) = 2 := +by rw [cast_add_one, cast_one, bit0] + +attribute [simp, norm_cast] int.nat_abs_of_nat + +end nat + +/-- `add_monoid_with_one` implementation using unary recursion. -/ +@[reducible] protected def add_monoid_with_one.unary {R : Type*} [add_monoid R] [has_one R] : + add_monoid_with_one R := +{ .. ‹has_one R›, .. ‹add_monoid R› } + +/-- `add_monoid_with_one` implementation using binary recursion. -/ +@[reducible] protected def add_monoid_with_one.binary {R : Type*} [add_monoid R] [has_one R] : + add_monoid_with_one R := +{ nat_cast := nat.bin_cast, + nat_cast_zero := by simp [nat.bin_cast, nat.cast], + nat_cast_succ := λ n, begin + simp only [nat.cast], + letI : add_monoid_with_one R := add_monoid_with_one.unary, + erw [nat.bin_cast_eq, nat.bin_cast_eq, nat.cast_succ], + refl, + end, + .. ‹has_one R›, .. ‹add_monoid R› } + +namespace ne_zero + +lemma nat_cast_ne (n : ℕ) (R) [add_monoid_with_one R] [h : ne_zero (n : R)] : + (n : R) ≠ 0 := h.out + +lemma of_ne_zero_coe (R) [add_monoid_with_one R] {n : ℕ} [h : ne_zero (n : R)] : ne_zero n := +⟨by {casesI h, rintro rfl, by simpa using h}⟩ + +lemma pos_of_ne_zero_coe (R) [add_monoid_with_one R] {n : ℕ} [ne_zero (n : R)] : 0 < n := +nat.pos_of_ne_zero (of_ne_zero_coe R).out + +end ne_zero diff --git a/src/data/nat/cast/field.lean b/src/data/nat/cast/field.lean new file mode 100644 index 0000000000000..5bae4899761ee --- /dev/null +++ b/src/data/nat/cast/field.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Yaël Dillies, Patrick Stevens +-/ +import algebra.order.field.basic +import algebra.order.ring.char_zero +import data.nat.cast.basic + +/-! +# Cast of naturals into fields + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file concerns the canonical homomorphism `ℕ → F`, where `F` is a field. + +## Main results + + * `nat.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n` + * `nat.cast_div_le`: in all cases, `↑(m / n) ≤ ↑m / ↑ n` +-/ + +namespace nat + +variables {α : Type*} + +@[simp] theorem cast_div [division_semiring α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) : + ((m / n : ℕ) : α) = m / n := +begin + rcases n_dvd with ⟨k, rfl⟩, + have : n ≠ 0, {rintro rfl, simpa using n_nonzero}, + rw [nat.mul_div_cancel_left _ this.bot_lt, mul_comm n k, cast_mul, mul_div_cancel _ n_nonzero], +end + +lemma cast_div_div_div_cancel_right [division_semiring α] [char_zero α] {m n d : ℕ} + (hn : d ∣ n) (hm : d ∣ m) : + (↑(m / d) : α) / (↑(n / d) : α) = (m : α) / n := +begin + rcases eq_or_ne d 0 with rfl | hd, { simp [zero_dvd_iff.mp hm], }, + replace hd : (d : α) ≠ 0, { norm_cast, assumption, }, + simp [hd, hm, hn, div_div_div_cancel_right _ hd], +end + +section linear_ordered_semifield +variables [linear_ordered_semifield α] + +/-- Natural division is always less than division in the field. -/ +lemma cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n := +begin + cases n, + { rw [cast_zero, div_zero, nat.div_zero, cast_zero] }, + rwa [le_div_iff, ←nat.cast_mul], + exact nat.cast_le.2 (nat.div_mul_le_self m n.succ), + { exact nat.cast_pos.2 n.succ_pos } +end + +lemma inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ := +inv_pos.2 $ add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one + +lemma one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) := +by { rw one_div, exact inv_pos_of_nat } + +lemma one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) := +by { refine one_div_le_one_div_of_le _ _, exact nat.cast_add_one_pos _, simpa } + +lemma one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) := +by { refine one_div_lt_one_div_of_lt _ _, exact nat.cast_add_one_pos _, simpa } + +end linear_ordered_semifield +end nat diff --git a/src/data/nat/cast/prod.lean b/src/data/nat/cast/prod.lean new file mode 100644 index 0000000000000..22e22e1a188af --- /dev/null +++ b/src/data/nat/cast/prod.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import data.nat.cast.basic +import algebra.group.prod + +/-! +# The product of two `add_monoid_with_one`s. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +variables {α β : Type*} + +namespace prod +variables [add_monoid_with_one α] [add_monoid_with_one β] + +instance : add_monoid_with_one (α × β) := +{ nat_cast := λ n, (n, n), + nat_cast_zero := congr_arg2 prod.mk nat.cast_zero nat.cast_zero, + nat_cast_succ := λ n, congr_arg2 prod.mk (nat.cast_succ _) (nat.cast_succ _), + .. prod.add_monoid, .. prod.has_one } + +@[simp] lemma fst_nat_cast (n : ℕ) : (n : α × β).fst = n := +by induction n; simp * + +@[simp] lemma snd_nat_cast (n : ℕ) : (n : α × β).snd = n := +by induction n; simp * + +end prod diff --git a/src/data/nat/cast/with_top.lean b/src/data/nat/cast/with_top.lean new file mode 100644 index 0000000000000..f80b27a9a9405 --- /dev/null +++ b/src/data/nat/cast/with_top.lean @@ -0,0 +1,23 @@ +/- +Copyright (c) 2014 Mario Carneiro. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro +-/ +import algebra.order.monoid.with_top +import data.nat.basic + +/-! +# Lemma about the coercion `ℕ → with_bot ℕ`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +An orphaned lemma about casting from `ℕ` to `with_bot ℕ`, +exiled here to minimize imports to `data.rat.order` for porting purposes. +-/ + +theorem nat.cast_with_top (n : ℕ) : + @coe ℕ (with_top ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n := rfl + +theorem nat.cast_with_bot (n : ℕ) : + @coe ℕ (with_bot ℕ) (@coe_to_lift _ _ nat.cast_coe) n = n := rfl diff --git a/src/data/nat/choose/basic.lean b/src/data/nat/choose/basic.lean index a331b51a3af7b..51c05e27848b5 100644 --- a/src/data/nat/choose/basic.lean +++ b/src/data/nat/choose/basic.lean @@ -1,13 +1,16 @@ /- Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes, Bhavik Mehta +Authors: Chris Hughes, Bhavik Mehta, Stuart Presnell -/ import data.nat.factorial.basic /-! # Binomial coefficients +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines binomial coefficients and proves simple lemmas (i.e. those not requiring more imports). @@ -21,7 +24,17 @@ requiring more imports). * `nat.desc_factorial_eq_factorial_mul_choose`: Relates binomial coefficients to the descending factorial. This is used to prove `nat.choose_le_pow` and variants. We provide similar statements for the ascending factorial. +* `nat.multichoose`: whereas `choose` counts combinations, `multichoose` counts multicombinations. +The fact that this is indeed the correct counting function for multisets is proved in +`sym.card_sym_eq_multichoose` in `data/sym/card`. +* `nat.multichoose_eq` : a proof that `multichoose n k = (n + k - 1).choose k`. +This is central to the "stars and bars" technique in informal mathematics, where we switch between +counting multisets of size `k` over an alphabet of size `n` to counting strings of `k` elements +("stars") separated by `n-1` dividers ("bars"). See `data/sym/card` for more detail. + +## Tags +binomial coefficient, combination, multicombination, stars and bars -/ open_locale nat @@ -114,9 +127,8 @@ end lemma choose_mul {n k s : ℕ} (hkn : k ≤ n) (hsk : s ≤ k) : n.choose k * k.choose s = n.choose s * (n - s).choose (k - s) := begin - have h : 0 < (n - k)! * (k - s)! * s! := - mul_pos (mul_pos (factorial_pos _) (factorial_pos _)) (factorial_pos _), - refine eq_of_mul_eq_mul_right h _, + have h : (n - k)! * (k - s)! * s! ≠ 0, by apply_rules [mul_ne_zero, factorial_ne_zero], + refine mul_right_cancel₀ h _, calc n.choose k * k.choose s * ((n - k)! * (k - s)! * s!) = n.choose k * (k.choose s * s! * (k - s)!) * (n - k)! @@ -287,4 +299,65 @@ lemma choose_le_choose {a b : ℕ} (c : ℕ) (h : a ≤ b) : choose a c ≤ choo lemma choose_mono (b : ℕ) : monotone (λ a, choose a b) := λ _ _, choose_le_choose b +/-! #### Multichoose + +Whereas `choose n k` is the number of subsets of cardinality `k` from a type of cardinality `n`, +`multichoose n k` is the number of multisets of cardinality `k` from a type of cardinality `n`. + +Alternatively, whereas `choose n k` counts the number of combinations, +i.e. ways to select `k` items (up to permutation) from `n` items without replacement, +`multichoose n k` counts the number of multicombinations, +i.e. ways to select `k` items (up to permutation) from `n` items with replacement. + +Note that `multichoose` is *not* the multinomial coefficient, although it can be computed +in terms of multinomial coefficients. For details see https://mathworld.wolfram.com/Multichoose.html + +TODO: Prove that `choose (-n) k = (-1)^k * multichoose n k`, +where `choose` is the generalized binomial coefficient. + + +-/ + +/-- +`multichoose n k` is the number of multisets of cardinality `k` from a type of cardinality `n`. -/ +def multichoose : ℕ → ℕ → ℕ +| _ 0 := 1 +| 0 (k + 1) := 0 +| (n + 1) (k + 1) := multichoose n (k + 1) + multichoose (n + 1) k + +@[simp] lemma multichoose_zero_right (n : ℕ) : multichoose n 0 = 1 := +by { cases n; simp [multichoose] } + +@[simp] lemma multichoose_zero_succ (k : ℕ) : multichoose 0 (k + 1) = 0 := by simp [multichoose] + +lemma multichoose_succ_succ (n k : ℕ) : + multichoose (n + 1) (k + 1) = multichoose n (k + 1) + multichoose (n + 1) k := +by simp [multichoose] + +@[simp] lemma multichoose_one (k : ℕ) : multichoose 1 k = 1 := +begin + induction k with k IH, { simp }, + simp [multichoose_succ_succ 0 k, IH], +end + +@[simp] lemma multichoose_two (k : ℕ) : multichoose 2 k = k + 1 := +begin + induction k with k IH, { simp }, + simp [multichoose_succ_succ 1 k, IH], + rw add_comm, +end + +@[simp] lemma multichoose_one_right (n : ℕ) : multichoose n 1 = n := +begin + induction n with n IH, { simp }, + simp [multichoose_succ_succ n 0, IH], +end + +lemma multichoose_eq : ∀ (n k : ℕ), multichoose n k = (n + k - 1).choose k +| _ 0 := by simp +| 0 (k+1) := by simp +| (n+1) (k+1) := by + { rw [multichoose_succ_succ, add_comm, nat.succ_add_sub_one, ←add_assoc, nat.choose_succ_succ], + simp [multichoose_eq] } + end nat diff --git a/src/data/nat/choose/bounds.lean b/src/data/nat/choose/bounds.lean index 7ecb3999ac693..3d9e5a32dd778 100644 --- a/src/data/nat/choose/bounds.lean +++ b/src/data/nat/choose/bounds.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Eric Rodriguez -/ -import data.nat.choose.basic -import data.nat.cast import algebra.group_power.lemmas +import algebra.order.field.basic +import data.nat.choose.basic /-! # Inequalities for binomial coefficients +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves exponential bounds on binomial coefficients. We might want to add here the bounds `n^r/r^r ≤ n.choose r ≤ e^r n^r/r^r` in the future. @@ -22,7 +25,7 @@ bounds `n^r/r^r ≤ n.choose r ≤ e^r n^r/r^r` in the future. open_locale nat -variables {α : Type*} [linear_ordered_field α] +variables {α : Type*} [linear_ordered_semifield α] namespace nat diff --git a/src/data/nat/choose/cast.lean b/src/data/nat/choose/cast.lean index 935edef67ccf4..d89a3b10422c1 100644 --- a/src/data/nat/choose/cast.lean +++ b/src/data/nat/choose/cast.lean @@ -9,6 +9,9 @@ import data.nat.factorial.cast /-! # Cast of binomial coefficients +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file allows calculating the binomial coefficient `a.choose b` as an element of a division ring of characteristic `0`. -/ @@ -39,6 +42,6 @@ by rw [eq_div_iff_mul_eq (nat.cast_ne_zero.2 b.factorial_ne_zero : (b! : K) ≠ lemma cast_choose_two (a : ℕ) : (a.choose 2 : K) = a * (a - 1) / 2 := by rw [←cast_desc_factorial_two, desc_factorial_eq_factorial_mul_choose, factorial_two, mul_comm, - cast_mul, cast_two, eq_div_iff_mul_eq (two_ne_zero' : (2 : K) ≠ 0)] + cast_mul, cast_two, eq_div_iff_mul_eq (two_ne_zero : (2 : K) ≠ 0)] end nat diff --git a/src/data/nat/choose/central.lean b/src/data/nat/choose/central.lean index 9cd4bf6c27000..c6755734d8394 100644 --- a/src/data/nat/choose/central.lean +++ b/src/data/nat/choose/central.lean @@ -4,17 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Patrick Stevens, Thomas Browning -/ -import data.nat.prime import data.nat.choose.basic -import data.nat.choose.sum -import data.nat.multiplicity -import number_theory.padics.padic_norm -import tactic.norm_num import tactic.linarith /-! # Central binomial coefficients +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves properties of the central binomial coefficients (that is, `nat.choose (2 * n) n`). ## Main definition and results @@ -24,12 +22,8 @@ This file proves properties of the central binomial coefficients (that is, `nat. coefficients. * `nat.four_pow_lt_mul_central_binom`: an exponential lower bound on the central binomial coefficient. -* `nat.multiplicity_central_binom_le`: a logarithmic upper bound on the multiplicity of a prime in - the central binomial coefficient. -* `nat.multiplicity_central_binom_of_large_le_one`: sufficiently large primes appear at most once - in the factorisation of the central binomial coefficient. -* `nat.multiplicity_central_binom_of_large_eq_zero`: sufficiently large primes less than n do not - appear in the factorisation of the central binomial coefficient. +* `succ_dvd_central_binom`: The result that `n+1 ∣ n.central_binom`, ensuring that the explicit + definition of the Catalan numbers is integer-valued. -/ namespace nat @@ -78,7 +72,7 @@ calc (n + 1) * (2 * (n + 1)).choose (n + 1) = (2 * n + 2).choose (n + 1) * (n + /-- An exponential lower bound on the central binomial coefficient. This bound is of interest because it appears in -[Tochiori's refinement of Erdős's proof of Bertrand's postulate](https://en.wikipedia.org/w/index.php?title=Proof_of_Bertrand%27s_postulate&oldid=859165151#Proof_by_Shigenori_Tochiori). +[Tochiori's refinement of Erdős's proof of Bertrand's postulate](tochiori_bertrand). -/ lemma four_pow_lt_mul_central_binom (n : ℕ) (n_big : 4 ≤ n) : 4 ^ n < n * central_binom n := begin @@ -88,14 +82,14 @@ begin { norm_num [central_binom, choose] }, obtain ⟨n, rfl⟩ : ∃ m, n = m + 1 := nat.exists_eq_succ_of_ne_zero (zero_lt_four.trans hn).ne', calc 4 ^ (n + 1) < 4 * (n * central_binom n) : - (mul_lt_mul_left zero_lt_four).mpr (IH n n.lt_succ_self (nat.le_of_lt_succ hn)) + (mul_lt_mul_left $ zero_lt_four' ℕ).mpr (IH n n.lt_succ_self (nat.le_of_lt_succ hn)) ... ≤ 2 * (2 * n + 1) * central_binom n : by { rw ← mul_assoc, linarith } ... = (n + 1) * central_binom (n + 1) : (succ_mul_central_binom_succ n).symm, end /-- An exponential lower bound on the central binomial coefficient. -This bound is weaker than `four_pow_n_lt_n_mul_central_binom`, but it is of historical interest +This bound is weaker than `nat.four_pow_lt_mul_central_binom`, but it is of historical interest because it appears in Erdős's proof of Bertrand's postulate. -/ lemma four_pow_le_two_mul_self_mul_central_binom : ∀ (n : ℕ) (n_pos : 0 < n), @@ -108,100 +102,30 @@ lemma four_pow_le_two_mul_self_mul_central_binom : ∀ (n : ℕ) (n_pos : 0 < n) calc 4 ^ n ≤ n * central_binom n : (four_pow_lt_mul_central_binom _ le_add_self).le ... ≤ 2 * n * central_binom n : by { rw [mul_assoc], refine le_mul_of_pos_left zero_lt_two } -variables {p n : ℕ} - -/-- -A logarithmic upper bound on the multiplicity of a prime in the central binomial coefficient. --/ -lemma padic_val_nat_central_binom_le (hp : p.prime) : - padic_val_nat p (central_binom n) ≤ log p (2 * n) := +lemma two_dvd_central_binom_succ (n : ℕ) : 2 ∣ central_binom (n + 1) := begin - rw @padic_val_nat_def _ ⟨hp⟩ _ (central_binom_pos n), - unfold central_binom, - have two_n_sub : 2 * n - n = n, by rw [two_mul n, nat.add_sub_cancel n n], - simp only [nat.prime.multiplicity_choose hp (le_mul_of_pos_left zero_lt_two) (lt_add_one _), - two_n_sub, ←two_mul, enat.get_coe', finset.filter_congr_decidable], - calc _ ≤ (finset.Ico 1 (log p (2 * n) + 1)).card : finset.card_filter_le _ _ - ... = (log p (2 * n) + 1) - 1 : nat.card_Ico _ _, + use (n+1+n).choose n, + rw [central_binom_eq_two_mul_choose, two_mul, ← add_assoc, choose_succ_succ, choose_symm_add, + ← two_mul], end -/-- -Sufficiently large primes appear only to multiplicity 0 or 1 in the central binomial coefficient. --/ -lemma padic_val_nat_central_binom_of_large_le_one (hp : p.prime) (p_large : 2 * n < p ^ 2) : - (padic_val_nat p (central_binom n)) ≤ 1 := +lemma two_dvd_central_binom_of_one_le {n : ℕ} (h : 0 < n) : 2 ∣ central_binom n := begin - have log_weak_bound : log p (2 * n) ≤ 2, - { calc log p (2 * n) ≤ log p (p ^ 2) : log_mono_right (le_of_lt p_large) - ... = 2 : log_pow hp.one_lt 2, }, - - have log_bound : log p (2 * n) ≤ 1, - { cases le_or_lt (log p (2 * n)) 1 with log_le lt_log, - { exact log_le, }, - { have v : log p (2 * n) = 2 := by linarith, - cases le_or_lt p (2 * n) with h h, - { exfalso, - rw [log_of_one_lt_of_le hp.one_lt h, succ_inj', log_eq_one_iff] at v, - have bad : p ^ 2 ≤ 2 * n, - { rw pow_two, - exact (nat.le_div_iff_mul_le _ _ (prime.pos hp)).1 v.2.2, }, - exact lt_irrefl _ (lt_of_le_of_lt bad p_large), }, - { rw log_of_lt h, - exact zero_le 1, }, }, }, - - exact le_trans (padic_val_nat_central_binom_le hp) log_bound, + rw ← nat.succ_pred_eq_of_pos h, + exact two_dvd_central_binom_succ n.pred, end -/-- -Sufficiently large primes less than `n` do not appear in the factorisation of `central_binom n`. --/ -lemma padic_val_nat_central_binom_of_large_eq_zero - (hp : p.prime) (n_big : 2 < n) (p_le_n : p ≤ n) (big : 2 * n < 3 * p) : - padic_val_nat p (central_binom n) = 0 := +/-- A crucial lemma to ensure that Catalan numbers can be defined via their explicit formula + `catalan n = n.central_binom / (n + 1)`. -/ +lemma succ_dvd_central_binom (n : ℕ) : (n + 1) ∣ n.central_binom := begin - rw @padic_val_nat_def _ ⟨hp⟩ _ (central_binom_pos n), - unfold central_binom, - have two_n_sub : 2 * n - n = n, by rw [two_mul n, nat.add_sub_cancel n n], - simp only [nat.prime.multiplicity_choose hp (le_mul_of_pos_left zero_lt_two) (lt_add_one _), - two_n_sub, ←two_mul, finset.card_eq_zero, enat.get_coe', finset.filter_congr_decidable], - clear two_n_sub, - - have three_lt_p : 3 ≤ p := by linarith, - have p_pos : 0 < p := nat.prime.pos hp, - - apply finset.filter_false_of_mem, - intros i i_in_interval, - rw finset.mem_Ico at i_in_interval, - refine not_le.mpr _, - - rcases lt_trichotomy 1 i with H|rfl|H, - { have two_le_i : 2 ≤ i := nat.succ_le_of_lt H, - have two_n_lt_pow_p_i : 2 * n < p ^ i, - { calc 2 * n < 3 * p : big - ... ≤ p * p : (mul_le_mul_right p_pos).2 three_lt_p - ... = p ^ 2 : (sq _).symm - ... ≤ p ^ i : nat.pow_le_pow_of_le_right p_pos two_le_i, }, - have n_mod : n % p ^ i = n, - { apply nat.mod_eq_of_lt, - calc n ≤ n + n : nat.le.intro rfl - ... = 2 * n : (two_mul n).symm - ... < p ^ i : two_n_lt_pow_p_i, }, - rw n_mod, - exact two_n_lt_pow_p_i, }, - - { rw [pow_one], - suffices h23 : 2 * (p * (n / p)) + 2 * (n % p) < 2 * (p * (n / p)) + p, - { exact (add_lt_add_iff_left (2 * (p * (n / p)))).mp h23, }, - have n_big : 1 ≤ (n / p) := (nat.le_div_iff_mul_le' p_pos).2 (trans (one_mul _).le p_le_n), - rw [←mul_add, nat.div_add_mod], - calc 2 * n < 3 * p : big - ... = 2 * p + p : nat.succ_mul _ _ - ... ≤ 2 * (p * (n / p)) + p : add_le_add_right ((mul_le_mul_left zero_lt_two).mpr - $ ((le_mul_iff_one_le_right p_pos).mpr n_big)) _ }, - - { have i_zero: i = 0 := nat.le_zero_iff.mp (nat.le_of_lt_succ H), - rw [i_zero, pow_zero, nat.mod_one, mul_zero], - exact zero_lt_one, }, + have h_s : (n+1).coprime (2*n+1), + { rw [two_mul,add_assoc, coprime_add_self_right, coprime_self_add_left], + exact coprime_one_left n }, + apply h_s.dvd_of_dvd_mul_left, + apply dvd_of_mul_dvd_mul_left zero_lt_two, + rw [← mul_assoc, ← succ_mul_central_binom_succ, mul_comm], + exact mul_dvd_mul_left _ (two_dvd_central_binom_succ n), end end nat diff --git a/src/data/nat/choose/default.lean b/src/data/nat/choose/default.lean deleted file mode 100644 index c8003fa521f64..0000000000000 --- a/src/data/nat/choose/default.lean +++ /dev/null @@ -1,3 +0,0 @@ -import data.nat.choose.dvd -import data.nat.choose.cast -import data.nat.choose.sum diff --git a/src/data/nat/choose/dvd.lean b/src/data/nat/choose/dvd.lean index 61dc0c6023377..3adae6d9f24aa 100644 --- a/src/data/nat/choose/dvd.lean +++ b/src/data/nat/choose/dvd.lean @@ -8,6 +8,9 @@ import data.nat.prime /-! # Divisibility properties of binomial coefficients + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ namespace nat @@ -16,26 +19,23 @@ open_locale nat namespace prime -lemma dvd_choose_add {p a b : ℕ} (hap : a < p) (hbp : b < p) (h : p ≤ a + b) - (hp : prime p) : p ∣ choose (a + b) a := -have h₁ : p ∣ (a + b)!, from hp.dvd_factorial.2 h, -have h₂ : ¬p ∣ a!, from mt hp.dvd_factorial.1 (not_le_of_gt hap), -have h₃ : ¬p ∣ b!, from mt hp.dvd_factorial.1 (not_le_of_gt hbp), -by - rw [← choose_mul_factorial_mul_factorial (le.intro rfl), mul_assoc, hp.dvd_mul, hp.dvd_mul, - add_tsub_cancel_left a b] at h₁; - exact h₁.resolve_right (not_or_distrib.2 ⟨h₂, h₃⟩) - -lemma dvd_choose_self {p k : ℕ} (hk : 0 < k) (hkp : k < p) (hp : prime p) : - p ∣ choose p k := +lemma dvd_choose_add {p a b : ℕ} (hp : prime p) (hap : a < p) (hbp : b < p) (h : p ≤ a + b) : + p ∣ choose (a + b) a := begin - have r : k + (p - k) = p, - by rw [← add_tsub_assoc_of_le (nat.le_of_lt hkp) k, add_tsub_cancel_left], - have e : p ∣ choose (k + (p - k)) k, - by exact dvd_choose_add hkp (nat.sub_lt (hk.trans hkp) hk) (by rw r) hp, - rwa r at e, + have h₁ : p ∣ (a + b)!, from hp.dvd_factorial.2 h, + rw [← add_choose_mul_factorial_mul_factorial, ← choose_symm_add, hp.dvd_mul, hp.dvd_mul, + hp.dvd_factorial, hp.dvd_factorial] at h₁, + exact (h₁.resolve_right hbp.not_le).resolve_right hap.not_le end +lemma dvd_choose {p a b : ℕ} (hp : prime p) (ha : a < p) (hab : b - a < p) (h : p ≤ b) : + p ∣ choose b a := +have a + (b - a) = b := nat.add_sub_of_le (ha.le.trans h), +this ▸ hp.dvd_choose_add ha hab (this.symm ▸ h) + +lemma dvd_choose_self {p k : ℕ} (hp : prime p) (hk : k ≠ 0) (hkp : k < p) : p ∣ choose p k := +hp.dvd_choose hkp (nat.sub_lt ((zero_le _).trans_lt hkp) hk.bot_lt) le_rfl + end prime end nat diff --git a/src/data/nat/choose/factorization.lean b/src/data/nat/choose/factorization.lean new file mode 100644 index 0000000000000..35268691fd3dd --- /dev/null +++ b/src/data/nat/choose/factorization.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2022 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey, Patrick Stevens, Thomas Browning +-/ + +import data.nat.choose.central +import data.nat.factorization.basic +import data.nat.multiplicity + +/-! +# Factorization of Binomial Coefficients + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains a few results on the multiplicity of prime factors within certain size +bounds in binomial coefficients. These include: + +* `nat.factorization_choose_le_log`: a logarithmic upper bound on the multiplicity of a prime in + a binomial coefficient. +* `nat.factorization_choose_le_one`: Primes above `sqrt n` appear at most once + in the factorization of `n` choose `k`. +* `nat.factorization_central_binom_of_two_mul_self_lt_three_mul`: Primes from `2 * n / 3` to `n` +do not appear in the factorization of the `n`th central binomial coefficient. +* `nat.factorization_choose_eq_zero_of_lt`: Primes greater than `n` do not + appear in the factorization of `n` choose `k`. + +These results appear in the [Erdős proof of Bertrand's postulate](aigner1999proofs). +-/ + +open_locale big_operators + +namespace nat + +variables {p n k : ℕ} + +/-- +A logarithmic upper bound on the multiplicity of a prime in a binomial coefficient. +-/ +lemma factorization_choose_le_log : (choose n k).factorization p ≤ log p n := +begin + by_cases h : (choose n k).factorization p = 0, { simp [h] }, + have hp : p.prime := not.imp_symm (choose n k).factorization_eq_zero_of_non_prime h, + have hkn : k ≤ n, { refine le_of_not_lt (λ hnk, h _), simp [choose_eq_zero_of_lt hnk] }, + rw [factorization_def _ hp, @padic_val_nat_def _ ⟨hp⟩ _ (choose_pos hkn)], + simp only [hp.multiplicity_choose hkn (lt_add_one _), part_enat.get_coe], + refine (finset.card_filter_le _ _).trans (le_of_eq (nat.card_Ico _ _)), +end + +/-- +A `pow` form of `nat.factorization_choose_le` +-/ +lemma pow_factorization_choose_le (hn : 0 < n) : p ^ (choose n k).factorization p ≤ n := +pow_le_of_le_log hn.ne' factorization_choose_le_log + +/-- +Primes greater than about `sqrt n` appear only to multiplicity 0 or 1 in the binomial coefficient. +-/ +lemma factorization_choose_le_one (p_large : n < p ^ 2) : (choose n k).factorization p ≤ 1 := +begin + apply factorization_choose_le_log.trans, + rcases eq_or_ne n 0 with rfl | hn0, { simp }, + exact lt_succ_iff.1 (log_lt_of_lt_pow hn0 p_large), +end + +lemma factorization_choose_of_lt_three_mul + (hp' : p ≠ 2) (hk : p ≤ k) (hk' : p ≤ n - k) (hn : n < 3 * p) : + (choose n k).factorization p = 0 := +begin + cases em' p.prime with hp hp, + { exact factorization_eq_zero_of_non_prime (choose n k) hp }, + cases lt_or_le n k with hnk hkn, + { simp [choose_eq_zero_of_lt hnk] }, + rw [factorization_def _ hp, @padic_val_nat_def _ ⟨hp⟩ _ (choose_pos hkn)], + simp only [hp.multiplicity_choose hkn (lt_add_one _), part_enat.get_coe, + finset.card_eq_zero, finset.filter_eq_empty_iff, not_le], + intros i hi, + rcases eq_or_lt_of_le (finset.mem_Ico.mp hi).1 with rfl | hi, + { rw [pow_one, ←add_lt_add_iff_left (2 * p), ←succ_mul, two_mul, add_add_add_comm], + exact lt_of_le_of_lt (add_le_add + (add_le_add_right (le_mul_of_one_le_right' ((one_le_div_iff hp.pos).mpr hk)) (k % p)) + (add_le_add_right (le_mul_of_one_le_right' ((one_le_div_iff hp.pos).mpr hk')) ((n - k) % p))) + (by rwa [div_add_mod, div_add_mod, add_tsub_cancel_of_le hkn]) }, + { replace hn : n < p ^ i, + { calc n < 3 * p : hn + ... ≤ p * p : mul_le_mul_right' (lt_of_le_of_ne hp.two_le hp'.symm) p + ... = p ^ 2 : (sq p).symm + ... ≤ p ^ i : pow_le_pow hp.one_lt.le hi }, + rwa [mod_eq_of_lt (lt_of_le_of_lt hkn hn), mod_eq_of_lt (lt_of_le_of_lt tsub_le_self hn), + add_tsub_cancel_of_le hkn] }, +end + +/-- +Primes greater than about `2 * n / 3` and less than `n` do not appear in the factorization of +`central_binom n`. +-/ +lemma factorization_central_binom_of_two_mul_self_lt_three_mul + (n_big : 2 < n) (p_le_n : p ≤ n) (big : 2 * n < 3 * p) : + (central_binom n).factorization p = 0 := +begin + refine factorization_choose_of_lt_three_mul _ p_le_n (p_le_n.trans _) big, + { rintro rfl, linarith }, + { rw [two_mul, add_tsub_cancel_left] }, +end + +lemma factorization_factorial_eq_zero_of_lt (h : n < p) : + (factorial n).factorization p = 0 := +begin + induction n with n hn, { simp }, + rw [factorial_succ, factorization_mul n.succ_ne_zero n.factorial_ne_zero, finsupp.coe_add, + pi.add_apply, hn (lt_of_succ_lt h), add_zero, factorization_eq_zero_of_lt h], +end + +lemma factorization_choose_eq_zero_of_lt (h : n < p) : + (choose n k).factorization p = 0 := +begin + by_cases hnk : n < k, { simp [choose_eq_zero_of_lt hnk] }, + rw [choose_eq_factorial_div_factorial (le_of_not_lt hnk), + factorization_div (factorial_mul_factorial_dvd_factorial (le_of_not_lt hnk)), + finsupp.coe_tsub, pi.sub_apply, factorization_factorial_eq_zero_of_lt h, zero_tsub], +end + +/-- +If a prime `p` has positive multiplicity in the `n`th central binomial coefficient, +`p` is no more than `2 * n` +-/ +lemma factorization_central_binom_eq_zero_of_two_mul_lt (h : 2 * n < p) : + (central_binom n).factorization p = 0 := +factorization_choose_eq_zero_of_lt h + +/-- +Contrapositive form of `nat.factorization_central_binom_eq_zero_of_two_mul_lt` +-/ +lemma le_two_mul_of_factorization_central_binom_pos + (h_pos : 0 < (central_binom n).factorization p) : p ≤ 2 * n := +le_of_not_lt (pos_iff_ne_zero.mp h_pos ∘ factorization_central_binom_eq_zero_of_two_mul_lt) + +/-- A binomial coefficient is the product of its prime factors, which are at most `n`. -/ +lemma prod_pow_factorization_choose (n k : ℕ) (hkn : k ≤ n) : + ∏ p in (finset.range (n + 1)), + p ^ ((nat.choose n k).factorization p) + = choose n k := +begin + nth_rewrite_rhs 0 ←factorization_prod_pow_eq_self (choose_pos hkn).ne', + rw eq_comm, + apply finset.prod_subset, + { intros p hp, + rw finset.mem_range, + contrapose! hp, + rw [finsupp.mem_support_iff, not_not, factorization_choose_eq_zero_of_lt hp] }, + { intros p _ h2, simp [not_not.1 (mt finsupp.mem_support_iff.2 h2)] }, +end + +/-- The `n`th central binomial coefficient is the product of its prime factors, which are +at most `2n`. -/ +lemma prod_pow_factorization_central_binom (n : ℕ) : + ∏ p in (finset.range (2 * n + 1)), + p ^ ((central_binom n).factorization p) + = central_binom n := +begin + apply prod_pow_factorization_choose, + linarith, +end + +end nat diff --git a/src/data/nat/choose/multinomial.lean b/src/data/nat/choose/multinomial.lean new file mode 100644 index 0000000000000..e3fb99386cb6c --- /dev/null +++ b/src/data/nat/choose/multinomial.lean @@ -0,0 +1,240 @@ +/- +Copyright (c) 2022 Pim Otte. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller, Pim Otte +-/ + +import algebra.big_operators.fin +import data.nat.choose.sum +import data.nat.factorial.big_operators +import data.fin.vec_notation +import data.finset.sym +import data.finsupp.multiset + + +/-! +# Multinomial + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the multinomial coefficient and several small lemma's for manipulating it. + +## Main declarations + +- `nat.multinomial`: the multinomial coefficient + +## Main results + +- `finest.sum_pow`: The expansion of `(s.sum x) ^ n` using multinomial coefficients + +-/ + +open_locale big_operators nat +open_locale big_operators + +namespace nat + +variables {α : Type*} (s : finset α) (f : α → ℕ) {a b : α} (n : ℕ) + +/-- The multinomial coefficient. Gives the number of strings consisting of symbols +from `s`, where `c ∈ s` appears with multiplicity `f c`. + +Defined as `(∑ i in s, f i)! / ∏ i in s, (f i)!`. +-/ +def multinomial : ℕ := (∑ i in s, f i)! / ∏ i in s, (f i)! + +lemma multinomial_pos : 0 < multinomial s f := nat.div_pos + (le_of_dvd (factorial_pos _) (prod_factorial_dvd_factorial_sum s f)) (prod_factorial_pos s f) + +lemma multinomial_spec : (∏ i in s, (f i)!) * multinomial s f = (∑ i in s, f i)! := +nat.mul_div_cancel' (prod_factorial_dvd_factorial_sum s f) + +@[simp] lemma multinomial_nil : multinomial ∅ f = 1 := rfl + +@[simp] lemma multinomial_singleton : multinomial {a} f = 1 := +by simp [multinomial, nat.div_self (factorial_pos (f a))] + +@[simp] lemma multinomial_insert_one [decidable_eq α] (h : a ∉ s) (h₁ : f a = 1) : + multinomial (insert a s) f = (s.sum f).succ * multinomial s f := +begin + simp only [multinomial, one_mul, factorial], + rw [finset.sum_insert h, finset.prod_insert h, h₁, add_comm, ←succ_eq_add_one, factorial_succ], + simp only [factorial_one, one_mul, function.comp_app, factorial], + rw nat.mul_div_assoc _ (prod_factorial_dvd_factorial_sum _ _), +end + +lemma multinomial_insert [decidable_eq α] (h : a ∉ s) : + multinomial (insert a s) f = (f a + s.sum f).choose (f a) * multinomial s f := +begin + rw choose_eq_factorial_div_factorial (le.intro rfl), + simp only [multinomial, nat.add_sub_cancel_left, finset.sum_insert h, finset.prod_insert h, + function.comp_app], + rw [div_mul_div_comm ((f a).factorial_mul_factorial_dvd_factorial_add (s.sum f)) + (prod_factorial_dvd_factorial_sum _ _), mul_comm (f a)! (s.sum f)!, mul_assoc, + mul_comm _ (s.sum f)!, nat.mul_div_mul _ _ (factorial_pos _)], +end + +lemma multinomial_congr {f g : α → ℕ} (h : ∀ a ∈ s, f a = g a) : + multinomial s f = multinomial s g := +begin + simp only [multinomial], congr' 1, + { rw finset.sum_congr rfl h }, + { exact finset.prod_congr rfl (λ a ha, by rw h a ha) }, +end + +/-! ### Connection to binomial coefficients + +When `nat.multinomial` is applied to a `finset` of two elements `{a, b}`, the +result a binomial coefficient. We use `binomial` in the names of lemmas that +involves `nat.multinomial {a, b}`. +-/ + +lemma binomial_eq [decidable_eq α] (h : a ≠ b) : + multinomial {a, b} f = (f a + f b)! / ((f a)! * (f b)!) := +by simp [multinomial, finset.sum_pair h, finset.prod_pair h] + +lemma binomial_eq_choose [decidable_eq α] (h : a ≠ b) : + multinomial {a, b} f = (f a + f b).choose (f a) := +by simp [binomial_eq _ h, choose_eq_factorial_div_factorial (nat.le_add_right _ _)] + +lemma binomial_spec [decidable_eq α] (hab : a ≠ b) : + (f a)! * (f b)! * multinomial {a, b} f = (f a + f b)! := +by simpa [finset.sum_pair hab, finset.prod_pair hab] using multinomial_spec {a, b} f + +@[simp] lemma binomial_one [decidable_eq α] (h : a ≠ b) (h₁ : f a = 1) : + multinomial {a, b} f = (f b).succ := +by simp [multinomial_insert_one {b} f (finset.not_mem_singleton.mpr h) h₁] + +lemma binomial_succ_succ [decidable_eq α] (h : a ≠ b) : + multinomial {a, b} ((f.update a (f a).succ).update b (f b).succ) = + multinomial {a, b} (f.update a (f a).succ) + + multinomial {a, b} (f.update b (f b).succ) := +begin + simp only [binomial_eq_choose, function.update_apply, function.update_noteq, + succ_add, add_succ, choose_succ_succ, h, ne.def, not_false_iff, function.update_same], + rw if_neg h.symm, + ring, +end + +lemma succ_mul_binomial [decidable_eq α] (h : a ≠ b) : + (f a + f b).succ * multinomial {a, b} f = + (f a).succ * multinomial {a, b} (f.update a (f a).succ) := +begin + rw [binomial_eq_choose _ h, binomial_eq_choose _ h, mul_comm (f a).succ, + function.update_same, function.update_noteq (ne_comm.mp h)], + convert succ_mul_choose_eq (f a + f b) (f a), + exact succ_add (f a) (f b), +end + +/-! ### Simple cases -/ + +lemma multinomial_univ_two (a b : ℕ) : multinomial finset.univ ![a, b] = (a + b)! / (a! * b!) := +by simp [multinomial, fin.sum_univ_two, fin.prod_univ_two] + +lemma multinomial_univ_three (a b c : ℕ) : multinomial finset.univ ![a, b, c] = + (a + b + c)! / (a! * b! * c!) := +by simp [multinomial, fin.sum_univ_three, fin.prod_univ_three] + +end nat + +/-! ### Alternative definitions -/ + +namespace finsupp + +variables {α : Type*} + +/-- Alternative multinomial definition based on a finsupp, using the support + for the big operations +-/ +def multinomial (f : α →₀ ℕ) : ℕ := (f.sum $ λ _, id)! / f.prod (λ _ n, n!) + +lemma multinomial_eq (f : α →₀ ℕ) : f.multinomial = nat.multinomial f.support f := rfl + +lemma multinomial_update (a : α) (f : α →₀ ℕ) : + f.multinomial = (f.sum $ λ _, id).choose (f a) * (f.update a 0).multinomial := +begin + simp only [multinomial_eq], + classical, + by_cases a ∈ f.support, + { rw [← finset.insert_erase h, nat.multinomial_insert _ f (finset.not_mem_erase a _), + finset.add_sum_erase _ f h, support_update_zero], congr' 1, + exact nat.multinomial_congr _ + (λ _ h, (function.update_noteq (finset.mem_erase.1 h).1 0 f).symm) }, + rw not_mem_support_iff at h, + rw [h, nat.choose_zero_right, one_mul, ← h, update_self], +end + +end finsupp + +namespace multiset + +variables {α : Type*} + +/-- Alternative definition of multinomial based on `multiset` delegating to the + finsupp definition +-/ +noncomputable def multinomial (m : multiset α) : ℕ := m.to_finsupp.multinomial + +lemma multinomial_filter_ne [decidable_eq α] (a : α) (m : multiset α) : + m.multinomial = m.card.choose (m.count a) * (m.filter ((≠) a)).multinomial := +begin + dsimp only [multinomial], + convert finsupp.multinomial_update a _, + { rw [← finsupp.card_to_multiset, m.to_finsupp_to_multiset] }, + { ext1 a', rw [to_finsupp_apply, count_filter, finsupp.coe_update], + split_ifs, + { rw [function.update_noteq h.symm, to_finsupp_apply] }, + { rw [not_ne_iff.1 h, function.update_same] } }, +end + +end multiset + +namespace finset + +/-! ### Multinomial theorem -/ + +variables {α : Type*} [decidable_eq α] (s : finset α) {R : Type*} + +/-- + The multinomial theorem + + Proof is by induction on the number of summands. +-/ +theorem sum_pow_of_commute [semiring R] (x : α → R) + (hc : (s : set α).pairwise $ λ i j, commute (x i) (x j)) : + ∀ n, (s.sum x) ^ n = + ∑ k : s.sym n, k.1.1.multinomial * (k.1.1.map $ x).noncomm_prod + (multiset.map_set_pairwise $ hc.mono $ mem_sym_iff.1 k.2) := +begin + induction s using finset.induction with a s ha ih, + { rw sum_empty, + rintro (_ | n), + { rw [pow_zero, fintype.sum_subsingleton], + swap, { exact ⟨0, or.inl rfl⟩ }, + convert (one_mul _).symm, apply nat.cast_one }, + { rw [pow_succ, zero_mul], + apply (fintype.sum_empty _).symm, + rw sym_empty, apply_instance } }, + intro n, specialize ih (hc.mono $ s.subset_insert a), + rw [sum_insert ha, (commute.sum_right s _ _ $ λ b hb, _).add_pow, sum_range], swap, + { exact hc (mem_insert_self a s) (mem_insert_of_mem hb) (ne_of_mem_of_not_mem hb ha).symm }, + simp_rw [ih, mul_sum, sum_mul, sum_sigma', univ_sigma_univ], + refine (fintype.sum_equiv (sym_insert_equiv ha) _ _ $ λ m, _).symm, + rw [m.1.1.multinomial_filter_ne a], + conv in (m.1.1.map _) { rw [← m.1.1.filter_add_not ((=) a), multiset.map_add] }, + simp_rw [multiset.noncomm_prod_add, m.1.1.filter_eq, multiset.map_replicate, m.1.2], + rw [multiset.noncomm_prod_eq_pow_card _ _ _ (λ _, multiset.eq_of_mem_replicate)], + rw [multiset.card_replicate, nat.cast_mul, mul_assoc, nat.cast_comm], + congr' 1, simp_rw [← mul_assoc, nat.cast_comm], refl, +end + +theorem sum_pow [comm_semiring R] (x : α → R) (n : ℕ) : + (s.sum x) ^ n = ∑ k in s.sym n, k.val.multinomial * (k.val.map x).prod := +begin + conv_rhs { rw ← sum_coe_sort }, + convert sum_pow_of_commute s x (λ _ _ _ _ _, mul_comm _ _) n, + ext1, rw multiset.noncomm_prod_eq_prod, refl, +end + +end finset diff --git a/src/data/nat/choose/sum.lean b/src/data/nat/choose/sum.lean index aa8d25b8f6352..2304080d66257 100644 --- a/src/data/nat/choose/sum.lean +++ b/src/data/nat/choose/sum.lean @@ -13,6 +13,9 @@ import algebra.big_operators.nat_antidiagonal /-! # Sums of binomial coefficients +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file includes variants of the binomial theorem and other results on sums of binomial coefficients. Theorems whose proofs depend on such sums may also go in this file for import reasons. @@ -31,7 +34,7 @@ variables [semiring R] {x y : R} (h : commute x y) (n : ℕ) include h -/-- A version of the **binomial theorem** for noncommutative semirings. -/ +/-- A version of the **binomial theorem** for commuting elements in noncommutative semirings. -/ theorem add_pow : (x + y) ^ n = ∑ m in range (n + 1), x ^ m * y ^ (n - m) * choose n m := begin @@ -93,7 +96,7 @@ lemma sum_range_choose_halfway (m : nat) : have ∑ i in range (m + 1), choose (2 * m + 1) (2 * m + 1 - i) = ∑ i in range (m + 1), choose (2 * m + 1) i, from sum_congr rfl $ λ i hi, choose_symm $ by linarith [mem_range.1 hi], -(nat.mul_right_inj zero_lt_two).1 $ +mul_right_injective₀ two_ne_zero $ calc 2 * (∑ i in range (m + 1), choose (2 * m + 1) i) = (∑ i in range (m + 1), choose (2 * m + 1) i) + ∑ i in range (m + 1), choose (2 * m + 1) (2 * m + 1 - i) : @@ -135,7 +138,7 @@ theorem int.alternating_sum_range_choose {n : ℕ} : begin cases n, { simp }, have h := add_pow (-1 : ℤ) 1 n.succ, - simp only [one_pow, mul_one, add_left_neg, int.nat_cast_eq_coe_nat] at h, + simp only [one_pow, mul_one, add_left_neg] at h, rw [← h, zero_pow (nat.succ_pos n), if_neg (nat.succ_ne_zero n)], end @@ -164,10 +167,7 @@ theorem sum_powerset_neg_one_pow_card {α : Type*} [decidable_eq α] {x : finset ∑ m in x.powerset, (-1 : ℤ) ^ m.card = if x = ∅ then 1 else 0 := begin rw sum_powerset_apply_card, - simp only [nsmul_eq_mul', ← card_eq_zero], - convert int.alternating_sum_range_choose, - ext, - simp, + simp only [nsmul_eq_mul', ← card_eq_zero, int.alternating_sum_range_choose] end theorem sum_powerset_neg_one_pow_card_of_nonempty {α : Type*} {x : finset α} diff --git a/src/data/nat/choose/vandermonde.lean b/src/data/nat/choose/vandermonde.lean index b9c0db02e3147..909280a1c668b 100644 --- a/src/data/nat/choose/vandermonde.lean +++ b/src/data/nat/choose/vandermonde.lean @@ -11,6 +11,9 @@ import data.nat.choose.basic # Vandermonde's identity +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we prove Vandermonde's identity (`nat.add_choose_eq`): `(m + n).choose k = ∑ (ij : ℕ × ℕ) in antidiagonal k, m.choose ij.1 * n.choose ij.2` diff --git a/src/data/nat/count.lean b/src/data/nat/count.lean index d7649b4a53427..3ec1de6d907b2 100644 --- a/src/data/nat/count.lean +++ b/src/data/nat/count.lean @@ -3,13 +3,15 @@ Copyright (c) 2021 Vladimir Goryachev. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Vladimir Goryachev, Kyle Miller, Scott Morrison, Eric Rodriguez -/ -import data.list.basic -import data.nat.prime -import set_theory.cardinal.finite +import set_theory.cardinal.basic +import tactic.ring /-! # Counting on ℕ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the `count` function, which gives, for any predicate on the natural numbers, "how many numbers under `k` satisfy this predicate?". We then prove several expected lemmas about `count`, relating it to the cardinality of other @@ -58,12 +60,13 @@ monotone_nat_of_le_succ $ λ n, by by_cases h : p n; simp [count_succ, h] lemma count_add (a b : ℕ) : count p (a + b) = count p a + count (λ k, p (a + k)) b := begin have : disjoint ((range a).filter p) (((range b).map $ add_left_embedding a).filter p), - { intros x hx, - simp_rw [inf_eq_inter, mem_inter, mem_filter, mem_map, mem_range] at hx, - obtain ⟨⟨hx, _⟩, ⟨c, _, rfl⟩, _⟩ := hx, + { apply disjoint_filter_filter, + rw finset.disjoint_left, + simp_rw [mem_map, mem_range, add_left_embedding_apply], + rintro x hx ⟨c, _, rfl⟩, exact (self_le_add_right _ _).not_lt hx }, simp_rw [count_eq_card_filter_range, range_add, filter_union, card_disjoint_union this, - map_filter, add_left_embedding, card_map], refl, + filter_map, add_left_embedding, card_map], refl, end lemma count_add' (a b : ℕ) : count p (a + b) = count (λ k, p (k + b)) a + count p b := @@ -102,9 +105,9 @@ lemma count_strict_mono {m n : ℕ} (hm : p m) (hmn : m < n) : count p m < count lemma count_injective {m n : ℕ} (hm : p m) (hn : p n) (heq : count p m = count p n) : m = n := begin - by_contra, + by_contra' h : m ≠ n, wlog hmn : m < n, - { exact ne.lt_or_lt h }, + { exact this hn hm heq.symm h.symm (h.lt_or_lt.resolve_left hmn) }, { simpa [heq] using count_strict_mono hm hmn } end diff --git a/src/data/nat/digits.lean b/src/data/nat/digits.lean index 7cb64d196fd37..a69c1ce229fe6 100644 --- a/src/data/nat/digits.lean +++ b/src/data/nat/digits.lean @@ -4,16 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Shing Tak Lam, Mario Carneiro -/ import data.int.modeq +import data.nat.bits import data.nat.log -import data.nat.parity import data.list.indexes import data.list.palindrome +import algebra.parity import tactic.interval_cases import tactic.linarith /-! # Digits of a natural number +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This provides a basic API for extracting the digits of a natural number in a given base, and reconstructing numbers from their digits. @@ -33,7 +37,7 @@ def digits_aux_0 : ℕ → list ℕ | (n+1) := [n+1] /-- (Impl.) An auxiliary definition for `digits`, to help get the desired definitional unfolding. -/ -def digits_aux_1 (n : ℕ) : list ℕ := list.repeat 1 n +def digits_aux_1 (n : ℕ) : list ℕ := list.replicate n 1 /-- (Impl.) An auxiliary definition for `digits`, to help get the desired definitional unfolding. -/ def digits_aux (b : ℕ) (h : 2 ≤ b) : ℕ → list ℕ @@ -60,7 +64,7 @@ In any base, we have `of_digits b L = L.foldr (λ x y, x + b * y) 0`. * For any `2 ≤ b`, we have `l < b` for any `l ∈ digits b n`, and the last digit is not zero. This uniquely specifies the behaviour of `digits b`. -* For `b = 1`, we define `digits 1 n = list.repeat 1 n`. +* For `b = 1`, we define `digits 1 n = list.replicate n 1`. * For `b = 0`, we define `digits 0 n = [n]`, except `digits 0 0 = []`. Note this differs from the existing `nat.to_digits` in core, which is used for printing numerals. @@ -78,11 +82,11 @@ by rcases b with _|⟨_|⟨_⟩⟩; simp [digits, digits_aux_0, digits_aux_1] @[simp] lemma digits_zero_succ (n : ℕ) : digits 0 (n.succ) = [n+1] := rfl -theorem digits_zero_succ' : ∀ {n : ℕ} (w : 0 < n), digits 0 n = [n] -| 0 h := absurd h dec_trivial +theorem digits_zero_succ' : ∀ {n : ℕ}, n ≠ 0 → digits 0 n = [n] +| 0 h := (h rfl).elim | (n+1) _ := rfl -@[simp] lemma digits_one (n : ℕ) : digits 1 n = list.repeat 1 n := rfl +@[simp] lemma digits_one (n : ℕ) : digits 1 n = list.replicate n 1 := rfl @[simp] lemma digits_one_succ (n : ℕ) : digits 1 (n + 1) = 1 :: digits 1 n := rfl @@ -90,40 +94,31 @@ theorem digits_zero_succ' : ∀ {n : ℕ} (w : 0 < n), digits 0 n = [n] digits (b+2) (n+1) = (((n+1) % (b+2)) :: digits (b+2) ((n+1) / (b+2))) := by { rw [digits, digits_aux_def], exact succ_pos n } -theorem digits_def' : ∀ {b : ℕ} (h : 2 ≤ b) {n : ℕ} (w : 0 < n), +theorem digits_def' : ∀ {b : ℕ} (h : 1 < b) {n : ℕ} (w : 0 < n), digits b n = n % b :: digits b (n/b) | 0 h := absurd h dec_trivial | 1 h := absurd h dec_trivial | (b+2) h := digits_aux_def _ _ -@[simp] -lemma digits_of_lt (b x : ℕ) (w₁ : 0 < x) (w₂ : x < b) : digits b x = [x] := +@[simp] lemma digits_of_lt (b x : ℕ) (hx : x ≠ 0) (hxb : x < b) : digits b x = [x] := begin - cases b, - { cases w₂ }, - { cases b, - { interval_cases x, }, - { cases x, - { cases w₁, }, - { rw [digits_add_two_add_one, nat.div_eq_of_lt w₂, digits_zero, nat.mod_eq_of_lt w₂] } } } + rcases exists_eq_succ_of_ne_zero hx with ⟨x, rfl⟩, + rcases exists_eq_add_of_le' ((nat.le_add_left 1 x).trans_lt hxb) with ⟨b, rfl⟩, + rw [digits_add_two_add_one, div_eq_of_lt hxb, digits_zero, mod_eq_of_lt hxb] end -lemma digits_add (b : ℕ) (h : 2 ≤ b) (x y : ℕ) (w : x < b) (w' : 0 < x ∨ 0 < y) : +lemma digits_add (b : ℕ) (h : 1 < b) (x y : ℕ) (hxb : x < b) (hxy : x ≠ 0 ∨ y ≠ 0) : digits b (x + b * y) = x :: digits b y := begin - cases b, - { cases h, }, - { cases b, - { norm_num at h, }, - { cases y, - { norm_num at w', - simp [w, w'], }, - dsimp [digits], - rw digits_aux_def, - { congr, - { simp [nat.add_mod, nat.mod_eq_of_lt w], }, - { simp [mul_comm (b+2), nat.add_mul_div_right, nat.div_eq_of_lt w], } }, - { apply nat.succ_pos, }, }, }, + rcases exists_eq_add_of_le' h with ⟨b, rfl : _ = _ + 2⟩, + cases y, + { simp [hxb, hxy.resolve_right (absurd rfl)] }, + dsimp [digits], + rw digits_aux_def, + { congr, + { simp [nat.add_mod, mod_eq_of_lt hxb], }, + { simp [add_mul_div_left, div_eq_of_lt hxb] } }, + { apply nat.succ_pos } end /-- @@ -188,7 +183,7 @@ end ((of_digits b L : ℕ) : α) = of_digits (b : α) L := begin induction L with d L ih, - { refl, }, + { simp [of_digits], }, { dsimp [of_digits], push_cast, rw ih, } end @@ -197,24 +192,17 @@ end begin induction L with d L ih, { refl, }, - { dsimp [of_digits], push_cast, rw ih, } + { dsimp [of_digits], push_cast } end -lemma digits_zero_of_eq_zero {b : ℕ} (h : 1 ≤ b) {L : list ℕ} (w : of_digits b L = 0) : - ∀ l ∈ L, l = 0 := -begin - induction L with d L ih, - { intros l m, - cases m, }, - { intros l m, - dsimp [of_digits] at w, - rcases m with ⟨rfl⟩, - { convert nat.eq_zero_of_add_eq_zero_right w, simp, }, - { exact ih ((nat.mul_right_inj h).mp (nat.eq_zero_of_add_eq_zero_left w)) _ m, }, } -end +lemma digits_zero_of_eq_zero {b : ℕ} (h : b ≠ 0) : + ∀ {L : list ℕ} (h0 : of_digits b L = 0) (l ∈ L), l = 0 +| (a :: L) h0 l (or.inl rfl) := nat.eq_zero_of_add_eq_zero_right h0 +| (a :: L) h0 l (or.inr hL) := + digits_zero_of_eq_zero (mul_right_injective₀ h (nat.eq_zero_of_add_eq_zero_left h0)) _ hL lemma digits_of_digits - (b : ℕ) (h : 2 ≤ b) (L : list ℕ) + (b : ℕ) (h : 1 < b) (L : list ℕ) (w₁ : ∀ l ∈ L, l < b) (w₂ : ∀ (h : L ≠ []), L.last h ≠ 0) : digits b (of_digits b L) = L := begin @@ -224,25 +212,20 @@ begin replace w₂ := w₂ (by simp), rw digits_add b h, { rw ih, - { simp, }, { intros l m, apply w₁, exact list.mem_cons_of_mem _ m, }, { intro h, { rw [list.last_cons h] at w₂, convert w₂, }}}, - { convert w₁ d (list.mem_cons_self _ _), simp, }, + { exact w₁ d (list.mem_cons_self _ _) }, { by_cases h' : L = [], { rcases h' with rfl, - simp at w₂, left, - apply nat.pos_of_ne_zero, - convert w₂, simp, }, + simpa using w₂ }, { right, - apply nat.pos_of_ne_zero, contrapose! w₂, - apply digits_zero_of_eq_zero _ w₂, - { rw list.last_cons h', - exact list.last_mem h', }, - { exact le_of_lt h, }, }, }, }, + refine digits_zero_of_eq_zero h.ne_bot w₂ _ _, + rw list.last_cons h', + exact list.last_mem h' } } } end lemma of_digits_digits (b n : ℕ) : of_digits b (digits b n) = n := @@ -264,7 +247,7 @@ begin { simp only [nat.succ_eq_add_one, digits_add_two_add_one], dsimp [of_digits], rw h _ (nat.div_lt_self' n b), - rw [nat.cast_id, nat.mod_add_div], }, }, }, + rw [nat.mod_add_div], }, }, }, end lemma of_digits_one (L : list ℕ) : of_digits 1 L = L.sum := @@ -294,7 +277,7 @@ end lemma digits_ne_nil_iff_ne_zero {b n : ℕ} : digits b n ≠ [] ↔ n ≠ 0 := not_congr digits_eq_nil_iff_eq_zero -lemma digits_eq_cons_digits_div {b n : ℕ} (h : 2 ≤ b) (w : 0 < n) : +lemma digits_eq_cons_digits_div {b n : ℕ} (h : 1 < b) (w : n ≠ 0) : digits b n = ((n % b) :: digits b (n / b)) := begin rcases b with _|_|b, @@ -305,12 +288,12 @@ begin simp, end -lemma digits_last {b : ℕ} (m : ℕ) (h : 2 ≤ b) (p q) : +lemma digits_last {b : ℕ} (m : ℕ) (h : 1 < b) (p q) : (digits b m).last p = (digits b (m/b)).last q := begin by_cases hm : m = 0, { simp [hm], }, - simp only [digits_eq_cons_digits_div h (nat.pos_of_ne_zero hm)], + simp only [digits_eq_cons_digits_div h hm], rw list.last_cons, end @@ -321,21 +304,20 @@ function.left_inverse.injective (of_digits_digits b) b.digits n = b.digits m ↔ n = m := (digits.injective b).eq_iff -lemma digits_len (b n : ℕ) (hb : 2 ≤ b) (hn : 0 < n) : +lemma digits_len (b n : ℕ) (hb : 1 < b) (hn : n ≠ 0) : (b.digits n).length = b.log n + 1 := begin induction n using nat.strong_induction_on with n IH, rw [digits_eq_cons_digits_div hb hn, list.length], - cases (n / b).eq_zero_or_pos with h h, - { have posb : 0 < b := zero_lt_two.trans_le hb, - simp [h, log_eq_zero_iff, ←nat.div_eq_zero_iff posb] }, + by_cases h : n / b = 0, + { have hb0 : b ≠ 0 := (nat.succ_le_iff.1 hb).ne_bot, + simp [h, log_eq_zero_iff, ← nat.div_eq_zero_iff hb0.bot_lt] }, { have hb' : 1 < b := one_lt_two.trans_le hb, - have : n / b < n := div_lt_self hn hb', + have : n / b < n := div_lt_self (nat.pos_of_ne_zero hn) hb', rw [IH _ this h, log_div_base, tsub_add_cancel_of_le], - rw [succ_le_iff], - refine log_pos hb' _, + refine nat.succ_le_of_lt (log_pos hb' _), contrapose! h, - rw div_eq_of_lt h } + exact div_eq_of_lt h } end lemma last_digit_ne_zero (b : ℕ) {m : ℕ} (hm : m ≠ 0) : @@ -346,17 +328,14 @@ begin { cases hm rfl }, { simp } }, { cases m, { cases hm rfl }, - simp_rw [digits_one, list.last_repeat_succ 1 m], - norm_num }, + simpa only [digits_one, list.last_replicate_succ m 1] using one_ne_zero }, revert hm, apply nat.strong_induction_on m, intros n IH hn, - have hnpos : 0 < n := nat.pos_of_ne_zero hn, by_cases hnb : n < b + 2, - { simp_rw [digits_of_lt b.succ.succ n hnpos hnb], - exact pos_iff_ne_zero.mp hnpos }, + { simpa only [digits_of_lt (b + 2) n hn hnb] }, { rw digits_last n (show 2 ≤ b + 2, from dec_trivial), - refine IH _ (nat.div_lt_self hnpos dec_trivial) _, + refine IH _ (nat.div_lt_self hn.bot_lt dec_trivial) _, { rw ←pos_iff_ne_zero, exact nat.div_pos (le_of_not_lt hnb) dec_trivial } }, end @@ -375,7 +354,7 @@ begin end /-- The digits in the base b expansion of n are all less than b, if b ≥ 2 -/ -lemma digits_lt_base {b m d : ℕ} (hb : 2 ≤ b) (hd : d ∈ digits b m) : d < b := +lemma digits_lt_base {b m d : ℕ} (hb : 1 < b) (hd : d ∈ digits b m) : d < b := begin rcases b with _ | _ | b; try {linarith}, exact digits_lt_base' hd, @@ -397,8 +376,8 @@ begin exact hl hd (list.mem_cons_self _ _) } end -/-- an n-digit number in base b is less than b^n if b ≥ 2 -/ -lemma of_digits_lt_base_pow_length {b : ℕ} {l : list ℕ} (hb : 2 ≤ b) (hl : ∀ x ∈ l, x < b) : +/-- an n-digit number in base b is less than b^n if b > 1 -/ +lemma of_digits_lt_base_pow_length {b : ℕ} {l : list ℕ} (hb : 1 < b) (hl : ∀ x ∈ l, x < b) : of_digits b l < b^l.length := begin rcases b with _ | _ | b; try { linarith }, @@ -413,7 +392,7 @@ begin end /-- Any number m is less than b^(number of digits in the base b representation of m) -/ -lemma lt_base_pow_length_digits {b m : ℕ} (hb : 2 ≤ b) : m < b^(digits b m).length := +lemma lt_base_pow_length_digits {b m : ℕ} (hb : 1 < b) : m < b^(digits b m).length := begin rcases b with _ | _ | b; try { linarith }, exact lt_base_pow_length_digits', @@ -425,13 +404,10 @@ by rw [of_digits_append, of_digits_digits, of_digits_digits] lemma digits_len_le_digits_len_succ (b n : ℕ) : (digits b n).length ≤ (digits b (n + 1)).length := begin - rcases n.eq_zero_or_pos with rfl|hn, + rcases decidable.eq_or_ne n 0 with rfl|hn, { simp }, - cases lt_or_le b 2 with hb hb, - { rcases b with _|_|b, - { simp [digits_zero_succ', hn] }, - { simp, }, - { simpa [succ_lt_succ_iff] using hb } }, + cases le_or_lt b 1 with hb hb, + { interval_cases b; simp [digits_zero_succ', hn] }, simpa [digits_len, hb, hn] using log_mono_right (le_succ _) end @@ -466,12 +442,27 @@ end Any non-zero natural number `m` is greater than b^((number of digits in the base b representation of m) - 1) -/ -lemma base_pow_length_digits_le (b m : ℕ) (hb : 2 ≤ b): m ≠ 0 → b ^ ((digits b m).length) ≤ b * m := +lemma base_pow_length_digits_le (b m : ℕ) (hb : 1 < b): m ≠ 0 → b ^ ((digits b m).length) ≤ b * m := begin rcases b with _ | _ | b; try { linarith }, exact base_pow_length_digits_le' b m, end +/-! ### Binary -/ +lemma digits_two_eq_bits (n : ℕ) : digits 2 n = n.bits.map (λ b, cond b 1 0) := +begin + induction n using nat.binary_rec_from_one with b n h ih, + { simp, }, + { simp, }, + rw bits_append_bit _ _ (λ hn, absurd hn h), + cases b, + { rw digits_def' one_lt_two, + { simpa [nat.bit, nat.bit0_val n], }, + { simpa [pos_iff_ne_zero, bit_eq_zero_iff], }, }, + { simpa [nat.bit, nat.bit1_val n, add_comm, digits_add 2 one_lt_two 1 n] }, +end + + /-! ### Modular Arithmetic -/ -- This is really a theorem about polynomials. @@ -551,7 +542,6 @@ lemma of_digits_neg_one : Π (L : list ℕ), | (a :: b :: t) := begin simp only [of_digits, list.alternating_sum, list.map_cons, of_digits_neg_one t], - push_cast, ring, end @@ -614,8 +604,8 @@ theorem digits_succ (b n m r l) (e : r + b * m = n) (hr : r < b) - (h : nat.digits b m = l ∧ 2 ≤ b ∧ 0 < m) : - nat.digits b n = r :: l ∧ 2 ≤ b ∧ 0 < n := + (h : nat.digits b m = l ∧ 1 < b ∧ 0 < m) : + nat.digits b n = r :: l ∧ 1 < b ∧ 0 < n := begin rcases h with ⟨h, b2, m0⟩, have b0 : 0 < b := by linarith, @@ -627,12 +617,12 @@ end theorem digits_one (b n) (n0 : 0 < n) (nb : n < b) : - nat.digits b n = [n] ∧ 2 ≤ b ∧ 0 < n := + nat.digits b n = [n] ∧ 1 < b ∧ 0 < n := begin - have b2 : 2 ≤ b := by linarith, + have b2 : 1 < b := by linarith, refine ⟨_, b2, n0⟩, rw [nat.digits_def' b2 n0, nat.mod_eq_of_lt nb, - (nat.div_eq_zero_iff (by linarith : 0 < b)).2 nb, nat.digits_zero], + (nat.div_eq_zero_iff ((zero_le n).trans_lt nb)).2 nb, nat.digits_zero], end open tactic @@ -670,13 +660,12 @@ example : nat.digits 10 123 = [3,2,1] := by norm_num if n = 0 then return (`([] : list ℕ), `(nat.digits_zero %%eb)) else if b = 0 then do ic ← mk_instance_cache `(ℕ), - (_, pn0) ← norm_num.prove_pos ic en, + (_, pn0) ← norm_num.prove_ne_zero' ic en, return (`([%%en] : list ℕ), `(@nat.digits_zero_succ' %%en %%pn0)) else if b = 1 then do ic ← mk_instance_cache `(ℕ), - (_, pn0) ← norm_num.prove_pos ic en, - s ← simp_lemmas.add_simp simp_lemmas.mk `list.repeat, - (rhs, p2, _) ← simplify s [] `(list.repeat 1 %%en), + s ← simp_lemmas.add_simp simp_lemmas.mk `list.replicate, + (rhs, p2, _) ← simplify s [] `(list.replicate %%en 1), p ← mk_eq_trans `(nat.digits_one %%en) p2, return (rhs, p) else do diff --git a/src/data/nat/dist.lean b/src/data/nat/dist.lean index c6eacfc725510..318fa77a2ba14 100644 --- a/src/data/nat/dist.lean +++ b/src/data/nat/dist.lean @@ -3,12 +3,15 @@ Copyright (c) 2014 Floris van Doorn. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Floris van Doorn, Jeremy Avigad -/ -import data.nat.basic +import data.nat.order.basic /-! # Distance function on ℕ -This file defines a simple distance function on naturals from truncated substraction. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines a simple distance function on naturals from truncated subtraction. -/ namespace nat diff --git a/src/data/nat/enat.lean b/src/data/nat/enat.lean deleted file mode 100644 index fa07a63f87ae4..0000000000000 --- a/src/data/nat/enat.lean +++ /dev/null @@ -1,530 +0,0 @@ -/- -Copyright (c) 2018 Chris Hughes. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes --/ -import algebra.hom.equiv -import data.part -import tactic.norm_num - -/-! -# Natural numbers with infinity - -The natural numbers and an extra `top` element `⊤`. - -## Main definitions - -The following instances are defined: - -* `ordered_add_comm_monoid enat` -* `canonically_ordered_add_monoid enat` - -There is no additive analogue of `monoid_with_zero`; if there were then `enat` could -be an `add_monoid_with_top`. - -* `to_with_top` : the map from `enat` to `with_top ℕ`, with theorems that it plays well -with `+` and `≤`. - -* `with_top_add_equiv : enat ≃+ with_top ℕ` -* `with_top_order_iso : enat ≃o with_top ℕ` - -## Implementation details - -`enat` is defined to be `part ℕ`. - -`+` and `≤` are defined on `enat`, but there is an issue with `*` because it's not -clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous -so there is no `-` defined on `enat`. - -Before the `open_locale classical` line, various proofs are made with decidability assumptions. -This can cause issues -- see for example the non-simp lemma `to_with_top_zero` proved by `rfl`, -followed by `@[simp] lemma to_with_top_zero'` whose proof uses `convert`. - - -## Tags - -enat, with_top ℕ --/ -open part (hiding some) - -/-- Type of natural numbers with infinity (`⊤`) -/ -def enat : Type := part ℕ - -namespace enat - -/-- The computable embedding `ℕ → enat`. - -This coincides with the coercion `coe : ℕ → enat`, see `enat.some_eq_coe`. -However, `coe` is noncomputable so `some` is preferable when computability is a concern. -/ -def some : ℕ → enat := part.some - -instance : has_zero enat := ⟨some 0⟩ -instance : inhabited enat := ⟨0⟩ -instance : has_one enat := ⟨some 1⟩ -instance : has_add enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, get x h.1 + get y h.2⟩⟩ - -instance (n : ℕ) : decidable (some n).dom := is_true trivial - -lemma some_eq_coe (n : ℕ) : some n = n := -begin - induction n with n ih, { refl }, - apply part.ext', - { show true ↔ ((n : enat).dom ∧ true), rw [← ih, and_true], exact iff.rfl }, - { intros h H, show n.succ = (n : enat).get H.1 + 1, - rw [nat.cast_succ] at H, revert H, simp only [← ih], intro, refl }, -end - -@[simp] lemma coe_inj {x y : ℕ} : (x : enat) = y ↔ x = y := -by simpa only [← some_eq_coe] using part.some_inj - -@[simp] lemma dom_some (x : ℕ) : (some x).dom := trivial - -@[simp] lemma dom_coe (x : ℕ) : (x : enat).dom := by rw [← some_eq_coe]; trivial - -instance : add_comm_monoid enat := -{ add := (+), - zero := (0), - add_comm := λ x y, part.ext' and.comm (λ _ _, add_comm _ _), - zero_add := λ x, part.ext' (true_and _) (λ _ _, zero_add _), - add_zero := λ x, part.ext' (and_true _) (λ _ _, add_zero _), - add_assoc := λ x y z, part.ext' and.assoc (λ _ _, add_assoc _ _ _) } - -instance : has_le enat := ⟨λ x y, ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy⟩ -instance : has_top enat := ⟨none⟩ -instance : has_bot enat := ⟨0⟩ -instance : has_sup enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, x.get h.1 ⊔ y.get h.2⟩⟩ - -lemma le_def (x y : enat) : x ≤ y ↔ ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy := -iff.rfl - -@[elab_as_eliminator] protected lemma cases_on' {P : enat → Prop} : - ∀ a : enat, P ⊤ → (∀ n : ℕ, P (some n)) → P a := -part.induction_on - -@[elab_as_eliminator] protected lemma cases_on {P : enat → Prop} : - ∀ a : enat, P ⊤ → (∀ n : ℕ, P n) → P a := -by { simp only [← some_eq_coe], exact enat.cases_on' } - -@[simp] lemma top_add (x : enat) : ⊤ + x = ⊤ := -part.ext' (false_and _) (λ h, h.left.elim) - -@[simp] lemma add_top (x : enat) : x + ⊤ = ⊤ := -by rw [add_comm, top_add] - -@[simp] lemma coe_get {x : enat} (h : x.dom) : (x.get h : enat) = x := -by { rw [← some_eq_coe], exact part.ext' (iff_of_true trivial h) (λ _ _, rfl) } - -@[simp, norm_cast] lemma get_coe' (x : ℕ) (h : (x : enat).dom) : get (x : enat) h = x := -by rw [← coe_inj, coe_get] - -lemma get_coe {x : ℕ} : get (x : enat) (dom_coe x) = x := get_coe' _ _ - -lemma coe_add_get {x : ℕ} {y : enat} (h : ((x : enat) + y).dom) : - get ((x : enat) + y) h = x + get y h.2 := -by { simp only [← some_eq_coe] at h ⊢, refl } - -@[simp] lemma get_add {x y : enat} (h : (x + y).dom) : - get (x + y) h = x.get h.1 + y.get h.2 := rfl - -@[simp] lemma get_zero (h : (0 : enat).dom) : (0 : enat).get h = 0 := rfl - -@[simp] lemma get_one (h : (1 : enat).dom) : (1 : enat).get h = 1 := rfl - -lemma get_eq_iff_eq_some {a : enat} {ha : a.dom} {b : ℕ} : - a.get ha = b ↔ a = some b := get_eq_iff_eq_some - -lemma get_eq_iff_eq_coe {a : enat} {ha : a.dom} {b : ℕ} : - a.get ha = b ↔ a = b := by rw [get_eq_iff_eq_some, some_eq_coe] - -lemma dom_of_le_of_dom {x y : enat} : x ≤ y → y.dom → x.dom := λ ⟨h, _⟩, h - -lemma dom_of_le_some {x : enat} {y : ℕ} (h : x ≤ some y) : x.dom := dom_of_le_of_dom h trivial - -lemma dom_of_le_coe {x : enat} {y : ℕ} (h : x ≤ y) : x.dom := -by { rw [← some_eq_coe] at h, exact dom_of_le_some h } - -instance decidable_le (x y : enat) [decidable x.dom] [decidable y.dom] : decidable (x ≤ y) := -if hx : x.dom -then decidable_of_decidable_of_iff - (show decidable (∀ (hy : (y : enat).dom), x.get hx ≤ (y : enat).get hy), - from forall_prop_decidable _) $ - by { dsimp [(≤)], simp only [hx, exists_prop_of_true, forall_true_iff] } -else if hy : y.dom -then is_false $ λ h, hx $ dom_of_le_of_dom h hy -else is_true ⟨λ h, (hy h).elim, λ h, (hy h).elim⟩ - -/-- The coercion `ℕ → enat` preserves `0` and addition. -/ -def coe_hom : ℕ →+ enat := ⟨coe, nat.cast_zero, nat.cast_add⟩ - -@[simp] lemma coe_coe_hom : ⇑coe_hom = coe := rfl - -instance : partial_order enat := -{ le := (≤), - le_refl := λ x, ⟨id, λ _, le_rfl⟩, - le_trans := λ x y z ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩, - ⟨hxy₁ ∘ hyz₁, λ _, le_trans (hxy₂ _) (hyz₂ _)⟩, - le_antisymm := λ x y ⟨hxy₁, hxy₂⟩ ⟨hyx₁, hyx₂⟩, part.ext' ⟨hyx₁, hxy₁⟩ - (λ _ _, le_antisymm (hxy₂ _) (hyx₂ _)) } - -lemma lt_def (x y : enat) : x < y ↔ ∃ (hx : x.dom), ∀ (hy : y.dom), x.get hx < y.get hy := -begin - rw [lt_iff_le_not_le, le_def, le_def, not_exists], - split, - { rintro ⟨⟨hyx, H⟩, h⟩, - by_cases hx : x.dom, - { use hx, intro hy, - specialize H hy, specialize h (λ _, hy), - rw not_forall at h, cases h with hx' h, - rw not_le at h, exact h }, - { specialize h (λ hx', (hx hx').elim), - rw not_forall at h, cases h with hx' h, - exact (hx hx').elim } }, - { rintro ⟨hx, H⟩, exact ⟨⟨λ _, hx, λ hy, (H hy).le⟩, λ hxy h, not_lt_of_le (h _) (H _)⟩ } -end - -@[simp, norm_cast] lemma coe_le_coe {x y : ℕ} : (x : enat) ≤ y ↔ x ≤ y := -by { rw [← some_eq_coe, ← some_eq_coe], exact ⟨λ ⟨_, h⟩, h trivial, λ h, ⟨λ _, trivial, λ _, h⟩⟩ } - -@[simp, norm_cast] lemma coe_lt_coe {x y : ℕ} : (x : enat) < y ↔ x < y := -by rw [lt_iff_le_not_le, lt_iff_le_not_le, coe_le_coe, coe_le_coe] - -@[simp] lemma get_le_get {x y : enat} {hx : x.dom} {hy : y.dom} : - x.get hx ≤ y.get hy ↔ x ≤ y := -by conv { to_lhs, rw [← coe_le_coe, coe_get, coe_get]} - -lemma le_coe_iff (x : enat) (n : ℕ) : x ≤ n ↔ ∃ h : x.dom, x.get h ≤ n := -begin - rw [← some_eq_coe], - show (∃ (h : true → x.dom), _) ↔ ∃ h : x.dom, x.get h ≤ n, - simp only [forall_prop_of_true, some_eq_coe, dom_coe, get_coe'] -end - -lemma lt_coe_iff (x : enat) (n : ℕ) : x < n ↔ ∃ h : x.dom, x.get h < n := -by simp only [lt_def, forall_prop_of_true, get_coe', dom_coe] - -lemma coe_le_iff (n : ℕ) (x : enat) : (n : enat) ≤ x ↔ ∀ h : x.dom, n ≤ x.get h := -begin - rw [← some_eq_coe], - simp only [le_def, exists_prop_of_true, dom_some, forall_true_iff], - refl, -end - -lemma coe_lt_iff (n : ℕ) (x : enat) : (n : enat) < x ↔ ∀ h : x.dom, n < x.get h := -begin - rw [← some_eq_coe], - simp only [lt_def, exists_prop_of_true, dom_some, forall_true_iff], - refl, -end - -protected lemma zero_lt_one : (0 : enat) < 1 := -by { norm_cast, norm_num } - -instance semilattice_sup : semilattice_sup enat := -{ sup := (⊔), - le_sup_left := λ _ _, ⟨and.left, λ _, le_sup_left⟩, - le_sup_right := λ _ _, ⟨and.right, λ _, le_sup_right⟩, - sup_le := λ x y z ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩, ⟨λ hz, ⟨hx₁ hz, hy₁ hz⟩, - λ _, sup_le (hx₂ _) (hy₂ _)⟩, - ..enat.partial_order } - -instance order_bot : order_bot enat := -{ bot := (⊥), - bot_le := λ _, ⟨λ _, trivial, λ _, nat.zero_le _⟩ } - -instance order_top : order_top enat := -{ top := (⊤), - le_top := λ x, ⟨λ h, false.elim h, λ hy, false.elim hy⟩ } - -lemma dom_of_lt {x y : enat} : x < y → x.dom := -enat.cases_on x not_top_lt $ λ _ _, dom_coe _ - -lemma top_eq_none : (⊤ : enat) = none := rfl - -@[simp] lemma coe_lt_top (x : ℕ) : (x : enat) < ⊤ := -ne.lt_top (λ h, absurd (congr_arg dom h) $ by simpa only [dom_coe] using true_ne_false) - -@[simp] lemma coe_ne_top (x : ℕ) : (x : enat) ≠ ⊤ := ne_of_lt (coe_lt_top x) - -lemma ne_top_iff {x : enat} : x ≠ ⊤ ↔ ∃ (n : ℕ), x = n := -by simpa only [← some_eq_coe] using part.ne_none_iff - -lemma ne_top_iff_dom {x : enat} : x ≠ ⊤ ↔ x.dom := -by classical; exact not_iff_comm.1 part.eq_none_iff'.symm - -lemma ne_top_of_lt {x y : enat} (h : x < y) : x ≠ ⊤ := -ne_of_lt $ lt_of_lt_of_le h le_top - -lemma eq_top_iff_forall_lt (x : enat) : x = ⊤ ↔ ∀ n : ℕ, (n : enat) < x := -begin - split, - { rintro rfl n, exact coe_lt_top _ }, - { contrapose!, rw ne_top_iff, rintro ⟨n, rfl⟩, exact ⟨n, irrefl _⟩ } -end - -lemma eq_top_iff_forall_le (x : enat) : x = ⊤ ↔ ∀ n : ℕ, (n : enat) ≤ x := -(eq_top_iff_forall_lt x).trans -⟨λ h n, (h n).le, λ h n, lt_of_lt_of_le (coe_lt_coe.mpr n.lt_succ_self) (h (n + 1))⟩ - -lemma pos_iff_one_le {x : enat} : 0 < x ↔ 1 ≤ x := -enat.cases_on x (by simp only [iff_true, le_top, coe_lt_top, ← @nat.cast_zero enat]) $ - λ n, by { rw [← nat.cast_zero, ← nat.cast_one, enat.coe_lt_coe, enat.coe_le_coe], refl } - -instance : is_total enat (≤) := -{ total := λ x y, enat.cases_on x - (or.inr le_top) (enat.cases_on y (λ _, or.inl le_top) - (λ x y, (le_total x y).elim (or.inr ∘ coe_le_coe.2) - (or.inl ∘ coe_le_coe.2))) } - -noncomputable instance : linear_order enat := -{ le_total := is_total.total, - decidable_le := classical.dec_rel _, - max := (⊔), - max_def := @sup_eq_max_default _ _ (id _) _, - ..enat.partial_order } - -instance : bounded_order enat := -{ ..enat.order_top, - ..enat.order_bot } - -noncomputable instance : lattice enat := -{ inf := min, - inf_le_left := min_le_left, - inf_le_right := min_le_right, - le_inf := λ _ _ _, le_min, - ..enat.semilattice_sup } - -instance : ordered_add_comm_monoid enat := -{ add_le_add_left := λ a b ⟨h₁, h₂⟩ c, - enat.cases_on c (by simp) - (λ c, ⟨λ h, and.intro (dom_coe _) (h₁ h.2), - λ h, by simpa only [coe_add_get] using add_le_add_left (h₂ _) c⟩), - ..enat.linear_order, - ..enat.add_comm_monoid } - -instance : canonically_ordered_add_monoid enat := -{ le_iff_exists_add := λ a b, enat.cases_on b - (iff_of_true le_top ⟨⊤, (add_top _).symm⟩) - (λ b, enat.cases_on a - (iff_of_false (not_le_of_gt (coe_lt_top _)) - (not_exists.2 (λ x, ne_of_lt (by rw [top_add]; exact coe_lt_top _)))) - (λ a, ⟨λ h, ⟨(b - a : ℕ), - by rw [← nat.cast_add, coe_inj, add_comm, tsub_add_cancel_of_le (coe_le_coe.1 h)]⟩, - (λ ⟨c, hc⟩, enat.cases_on c - (λ hc, hc.symm ▸ show (a : enat) ≤ a + ⊤, by rw [add_top]; exact le_top) - (λ c (hc : (b : enat) = a + c), - coe_le_coe.2 (by rw [← nat.cast_add, coe_inj] at hc; - rw hc; exact nat.le_add_right _ _)) hc)⟩)), - ..enat.semilattice_sup, - ..enat.order_bot, - ..enat.ordered_add_comm_monoid } - -protected lemma add_lt_add_right {x y z : enat} (h : x < y) (hz : z ≠ ⊤) : x + z < y + z := -begin - rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩, - rcases ne_top_iff.mp hz with ⟨k, rfl⟩, - induction y using enat.cases_on with n, - { rw [top_add], apply_mod_cast coe_lt_top }, - norm_cast at h, apply_mod_cast add_lt_add_right h -end - -protected lemma add_lt_add_iff_right {x y z : enat} (hz : z ≠ ⊤) : x + z < y + z ↔ x < y := -⟨lt_of_add_lt_add_right, λ h, enat.add_lt_add_right h hz⟩ - -protected lemma add_lt_add_iff_left {x y z : enat} (hz : z ≠ ⊤) : z + x < z + y ↔ x < y := -by rw [add_comm z, add_comm z, enat.add_lt_add_iff_right hz] - -protected lemma lt_add_iff_pos_right {x y : enat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y := -by { conv_rhs { rw [← enat.add_lt_add_iff_left hx] }, rw [add_zero] } - -lemma lt_add_one {x : enat} (hx : x ≠ ⊤) : x < x + 1 := -by { rw [enat.lt_add_iff_pos_right hx], norm_cast, norm_num } - -lemma le_of_lt_add_one {x y : enat} (h : x < y + 1) : x ≤ y := -begin - induction y using enat.cases_on with n, apply le_top, - rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩, - apply_mod_cast nat.le_of_lt_succ, apply_mod_cast h -end - -lemma add_one_le_of_lt {x y : enat} (h : x < y) : x + 1 ≤ y := -begin - induction y using enat.cases_on with n, apply le_top, - rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩, - apply_mod_cast nat.succ_le_of_lt, apply_mod_cast h -end - -lemma add_one_le_iff_lt {x y : enat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y := -begin - split, swap, exact add_one_le_of_lt, - intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩, - induction y using enat.cases_on with n, apply coe_lt_top, - apply_mod_cast nat.lt_of_succ_le, apply_mod_cast h -end - -lemma lt_add_one_iff_lt {x y : enat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y := -begin - split, exact le_of_lt_add_one, - intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩, - induction y using enat.cases_on with n, { rw [top_add], apply coe_lt_top }, - apply_mod_cast nat.lt_succ_of_le, apply_mod_cast h -end - -lemma add_eq_top_iff {a b : enat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := -by apply enat.cases_on a; apply enat.cases_on b; - simp; simp only [(nat.cast_add _ _).symm, enat.coe_ne_top]; simp - -protected lemma add_right_cancel_iff {a b c : enat} (hc : c ≠ ⊤) : a + c = b + c ↔ a = b := -begin - rcases ne_top_iff.1 hc with ⟨c, rfl⟩, - apply enat.cases_on a; apply enat.cases_on b; - simp [add_eq_top_iff, coe_ne_top, @eq_comm _ (⊤ : enat)]; - simp only [(nat.cast_add _ _).symm, add_left_cancel_iff, enat.coe_inj, add_comm]; - tauto -end - -protected lemma add_left_cancel_iff {a b c : enat} (ha : a ≠ ⊤) : a + b = a + c ↔ b = c := -by rw [add_comm a, add_comm a, enat.add_right_cancel_iff ha] - -section with_top - -/-- Computably converts an `enat` to a `with_top ℕ`. -/ -def to_with_top (x : enat) [decidable x.dom] : with_top ℕ := x.to_option - -lemma to_with_top_top : to_with_top ⊤ = ⊤ := rfl - -@[simp] lemma to_with_top_top' {h : decidable (⊤ : enat).dom} : to_with_top ⊤ = ⊤ := -by convert to_with_top_top - -lemma to_with_top_zero : to_with_top 0 = 0 := rfl - -@[simp] lemma to_with_top_zero' {h : decidable (0 : enat).dom} : to_with_top 0 = 0 := -by convert to_with_top_zero - -lemma to_with_top_some (n : ℕ) : to_with_top (some n) = n := rfl - -lemma to_with_top_coe (n : ℕ) {_ : decidable (n : enat).dom} : to_with_top n = n := -by simp only [← some_eq_coe, ← to_with_top_some] - -@[simp] lemma to_with_top_coe' (n : ℕ) {h : decidable (n : enat).dom} : - to_with_top (n : enat) = n := -by convert to_with_top_coe n - -@[simp] lemma to_with_top_le {x y : enat} : Π [decidable x.dom] - [decidable y.dom], by exactI to_with_top x ≤ to_with_top y ↔ x ≤ y := -enat.cases_on y (by simp) (enat.cases_on x (by simp) (by intros; simp)) - -@[simp] lemma to_with_top_lt {x y : enat} [decidable x.dom] [decidable y.dom] : - to_with_top x < to_with_top y ↔ x < y := -lt_iff_lt_of_le_iff_le to_with_top_le - -end with_top - -section with_top_equiv - -open_locale classical - -@[simp] lemma to_with_top_add {x y : enat} : to_with_top (x + y) = to_with_top x + to_with_top y := -by apply enat.cases_on y; apply enat.cases_on x; simp [← nat.cast_add, ← with_top.coe_add] - -/-- `equiv` between `enat` and `with_top ℕ` (for the order isomorphism see `with_top_order_iso`). -/ -noncomputable def with_top_equiv : enat ≃ with_top ℕ := -{ to_fun := λ x, to_with_top x, - inv_fun := λ x, match x with (option.some n) := coe n | none := ⊤ end, - left_inv := λ x, by apply enat.cases_on x; intros; simp; refl, - right_inv := λ x, by cases x; simp [with_top_equiv._match_1]; refl } - -@[simp] lemma with_top_equiv_top : with_top_equiv ⊤ = ⊤ := -to_with_top_top' - -@[simp] lemma with_top_equiv_coe (n : nat) : with_top_equiv n = n := -to_with_top_coe' _ - -@[simp] lemma with_top_equiv_zero : with_top_equiv 0 = 0 := -by simpa only [nat.cast_zero] using with_top_equiv_coe 0 - -@[simp] lemma with_top_equiv_le {x y : enat} : with_top_equiv x ≤ with_top_equiv y ↔ x ≤ y := -to_with_top_le - -@[simp] lemma with_top_equiv_lt {x y : enat} : with_top_equiv x < with_top_equiv y ↔ x < y := -to_with_top_lt - -/-- `to_with_top` induces an order isomorphism between `enat` and `with_top ℕ`. -/ -noncomputable def with_top_order_iso : enat ≃o with_top ℕ := -{ map_rel_iff' := λ _ _, with_top_equiv_le, - .. with_top_equiv} - -@[simp] lemma with_top_equiv_symm_top : with_top_equiv.symm ⊤ = ⊤ := -rfl - -@[simp] lemma with_top_equiv_symm_coe (n : nat) : with_top_equiv.symm n = n := -rfl - -@[simp] lemma with_top_equiv_symm_zero : with_top_equiv.symm 0 = 0 := -rfl - -@[simp] lemma with_top_equiv_symm_le {x y : with_top ℕ} : - with_top_equiv.symm x ≤ with_top_equiv.symm y ↔ x ≤ y := -by rw ← with_top_equiv_le; simp - -@[simp] lemma with_top_equiv_symm_lt {x y : with_top ℕ} : - with_top_equiv.symm x < with_top_equiv.symm y ↔ x < y := -by rw ← with_top_equiv_lt; simp - -/-- `to_with_top` induces an additive monoid isomorphism between `enat` and `with_top ℕ`. -/ -noncomputable def with_top_add_equiv : enat ≃+ with_top ℕ := -{ map_add' := λ x y, by simp only [with_top_equiv]; convert to_with_top_add, - ..with_top_equiv} - -end with_top_equiv - -lemma lt_wf : well_founded ((<) : enat → enat → Prop) := -show well_founded (λ a b : enat, a < b), -by haveI := classical.dec; simp only [to_with_top_lt.symm] {eta := ff}; - exact inv_image.wf _ (with_top.well_founded_lt nat.lt_wf) - -instance : has_well_founded enat := ⟨(<), lt_wf⟩ - -section find - -variables (P : ℕ → Prop) [decidable_pred P] - -/-- The smallest `enat` satisfying a (decidable) predicate `P : ℕ → Prop` -/ -def find : enat := ⟨∃ n, P n, nat.find⟩ - -@[simp] lemma find_get (h : (find P).dom) : (find P).get h = nat.find h := rfl - -lemma find_dom (h : ∃ n, P n) : (find P).dom := h - -lemma lt_find (n : ℕ) (h : ∀ m ≤ n, ¬P m) : (n : enat) < find P := -begin - rw coe_lt_iff, intro h', rw find_get, - have := @nat.find_spec P _ h', - contrapose! this, - exact h _ this -end - -lemma lt_find_iff (n : ℕ) : (n : enat) < find P ↔ (∀ m ≤ n, ¬P m) := -begin - refine ⟨_, lt_find P n⟩, - intros h m hm, - by_cases H : (find P).dom, - { apply nat.find_min H, rw coe_lt_iff at h, specialize h H, exact lt_of_le_of_lt hm h }, - { exact not_exists.mp H m } -end - -lemma find_le (n : ℕ) (h : P n) : find P ≤ n := -by { rw le_coe_iff, refine ⟨⟨_, h⟩, @nat.find_min' P _ _ _ h⟩ } - -lemma find_eq_top_iff : find P = ⊤ ↔ ∀ n, ¬P n := -(eq_top_iff_forall_lt _).trans -⟨λ h n, (lt_find_iff P n).mp (h n) _ le_rfl, λ h n, lt_find P n $ λ _ _, h _⟩ - -end find - -noncomputable instance : linear_ordered_add_comm_monoid_with_top enat := -{ top_add' := top_add, - .. enat.linear_order, - .. enat.ordered_add_comm_monoid, - .. enat.order_top } - -end enat diff --git a/src/data/nat/even_odd_rec.lean b/src/data/nat/even_odd_rec.lean new file mode 100644 index 0000000000000..cb861068866c7 --- /dev/null +++ b/src/data/nat/even_odd_rec.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2022 Stuart Presnell. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Stuart Presnell +-/ + +import data.nat.basic + +/-! # A recursion principle based on even and odd numbers. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +namespace nat + +/-- Recursion principle on even and odd numbers: if we have `P 0`, and for all `i : ℕ` we can +extend from `P i` to both `P (2 * i)` and `P (2 * i + 1)`, then we have `P n` for all `n : ℕ`. +This is nothing more than a wrapper around `nat.binary_rec`, to avoid having to switch to +dealing with `bit0` and `bit1`. -/ +@[elab_as_eliminator] +def even_odd_rec {P : ℕ → Sort*} (h0 : P 0) + (h_even : ∀ n (ih : P n), P (2 * n)) + (h_odd : ∀ n (ih : P n), P (2 * n + 1)) (n : ℕ) : P n := +begin + refine @binary_rec P h0 (λ b i hi, _) n, + cases b, + { simpa [bit, bit0_val i] using h_even i hi }, + { simpa [bit, bit1_val i] using h_odd i hi }, +end + +@[simp] lemma even_odd_rec_zero (P : ℕ → Sort*) (h0 : P 0) + (h_even : ∀ i, P i → P (2 * i)) (h_odd : ∀ i, P i → P (2 * i + 1)) : + @even_odd_rec _ h0 h_even h_odd 0 = h0 := binary_rec_zero _ _ + +@[simp] lemma even_odd_rec_even (n : ℕ) (P : ℕ → Sort*) (h0 : P 0) + (h_even : ∀ i, P i → P (2 * i)) (h_odd : ∀ i, P i → P (2 * i + 1)) + (H : h_even 0 h0 = h0) : + @even_odd_rec _ h0 h_even h_odd (2 * n) = h_even n (even_odd_rec h0 h_even h_odd n) := +begin + convert binary_rec_eq _ ff n, + { exact (bit0_eq_two_mul _).symm }, + { exact (bit0_eq_two_mul _).symm }, + { apply heq_of_cast_eq, refl }, + { exact H } +end + +@[simp] lemma even_odd_rec_odd (n : ℕ) (P : ℕ → Sort*) (h0 : P 0) + (h_even : ∀ i, P i → P (2 * i)) (h_odd : ∀ i, P i → P (2 * i + 1)) + (H : h_even 0 h0 = h0) : + @even_odd_rec _ h0 h_even h_odd (2 * n + 1) = h_odd n (even_odd_rec h0 h_even h_odd n) := +begin + convert binary_rec_eq _ tt n, + { exact (bit0_eq_two_mul _).symm }, + { exact (bit0_eq_two_mul _).symm }, + { apply heq_of_cast_eq, refl }, + { exact H } +end + +end nat diff --git a/src/data/nat/factorial/basic.lean b/src/data/nat/factorial/basic.lean index 9e577b6247914..ba3c8d0b388f9 100644 --- a/src/data/nat/factorial/basic.lean +++ b/src/data/nat/factorial/basic.lean @@ -9,6 +9,9 @@ import data.nat.pow /-! # Factorial and variants +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the factorial, along with the ascending and descending variants. ## Main declarations @@ -26,7 +29,7 @@ namespace nat | 0 := 1 | (succ n) := succ n * factorial n -localized "notation n `!`:10000 := nat.factorial n" in nat +localized "notation (name := nat.factorial) n `!`:10000 := nat.factorial n" in nat section factorial @@ -90,7 +93,7 @@ factorial_lt one_pos lemma factorial_eq_one : n! = 1 ↔ n ≤ 1 := begin - refine ⟨λ h, _, by rintro (_ | ⟨_, _ | _⟩); refl⟩, + refine ⟨λ h, _, by rintro (_ | _ | _); refl⟩, rw [← not_lt, ← one_lt_factorial, h], apply lt_irrefl end @@ -141,11 +144,11 @@ end lemma add_factorial_succ_le_factorial_add_succ (i : ℕ) (n : ℕ) : i + (n + 1)! ≤ (i + (n + 1))! := begin - obtain i2 | (_ | ⟨_, i0⟩) := le_or_lt 2 i, + obtain i2 | _ | i0 := le_or_lt 2 i, { exact (n.add_factorial_succ_lt_factorial_add_succ i2).le }, { rw [←add_assoc, factorial_succ (1 + n), add_mul, one_mul, add_comm 1 n], exact (add_le_add_iff_right _).mpr (one_le_mul (nat.le_add_left 1 n) (n + 1).factorial_pos) }, - rw [nat.le_zero_iff.mp (nat.succ_le_succ_iff.mp i0), zero_add, zero_add] + rw [le_zero_iff.mp (nat.succ_le_succ_iff.mp i0), zero_add, zero_add] end lemma add_factorial_le_factorial_add (i : ℕ) {n : ℕ} (n1 : 1 ≤ n) : @@ -237,7 +240,7 @@ end lemma pow_lt_asc_factorial (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → (n + 1)^k < n.asc_factorial k | 0 := by rintro ⟨⟩ -| 1 := by rintro (_ | ⟨_, ⟨⟩⟩) +| 1 := by rintro (_ | ⟨⟨⟩⟩) | (k + 2) := λ _, pow_lt_asc_factorial' n k lemma asc_factorial_le_pow_add (n : ℕ) : ∀ (k : ℕ), n.asc_factorial k ≤ (n + k)^k @@ -250,7 +253,7 @@ end lemma asc_factorial_lt_pow_add (n : ℕ) : ∀ {k : ℕ}, 2 ≤ k → n.asc_factorial k < (n + k)^k | 0 := by rintro ⟨⟩ -| 1 := by rintro (_ | ⟨_, ⟨⟩⟩) +| 1 := by rintro (_ | ⟨⟨⟩⟩) | (k + 2) := λ _, begin rw [asc_factorial_succ, pow_succ], refine nat.mul_lt_mul' le_rfl ((asc_factorial_le_pow_add n _).trans_lt @@ -308,7 +311,7 @@ lemma desc_factorial_self : ∀ n : ℕ, n.desc_factorial n = n! exact λ h _, h, end -alias nat.desc_factorial_eq_zero_iff_lt ↔ _ nat.desc_factorial_of_lt +alias desc_factorial_eq_zero_iff_lt ↔ _ desc_factorial_of_lt lemma add_desc_factorial_eq_asc_factorial (n : ℕ) : ∀ k : ℕ, (n + k).desc_factorial k = n.asc_factorial k @@ -359,7 +362,7 @@ end lemma pow_sub_lt_desc_factorial {n : ℕ} : ∀ {k : ℕ}, 2 ≤ k → k ≤ n → (n + 1 - k)^k < n.desc_factorial k | 0 := by rintro ⟨⟩ -| 1 := by rintro (_ | ⟨_, ⟨⟩⟩) +| 1 := by rintro (_ | ⟨⟨⟩⟩) | (k + 2) := λ _ h, by { rw succ_sub_succ, exact pow_sub_lt_desc_factorial' h } lemma desc_factorial_le_pow (n : ℕ) : ∀ (k : ℕ), n.desc_factorial k ≤ n^k @@ -371,7 +374,7 @@ end lemma desc_factorial_lt_pow {n : ℕ} (hn : 1 ≤ n) : ∀ {k : ℕ}, 2 ≤ k → n.desc_factorial k < n^k | 0 := by rintro ⟨⟩ -| 1 := by rintro (_ | ⟨_, ⟨⟩⟩) +| 1 := by rintro (_ | ⟨⟨⟩⟩) | (k + 2) := λ _, begin rw [desc_factorial_succ, pow_succ', mul_comm], exact nat.mul_lt_mul' (desc_factorial_le_pow _ _) (tsub_lt_self hn k.zero_lt_succ) diff --git a/src/data/nat/factorial/big_operators.lean b/src/data/nat/factorial/big_operators.lean new file mode 100644 index 0000000000000..e31c5f242280b --- /dev/null +++ b/src/data/nat/factorial/big_operators.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2022 Pim Otte. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kyle Miller, Pim Otte +-/ +import data.nat.factorial.basic +import algebra.big_operators.order + +/-! +# Factorial with big operators + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains some lemmas on factorials in combination with big operators. + +While in terms of semantics they could be in the `basic.lean` file, importing +`algebra.big_operators.basic` leads to a cyclic import. + +-/ + +open_locale nat big_operators + +namespace nat + +variables {α : Type*} (s : finset α) (f : α → ℕ) + +lemma prod_factorial_pos : 0 < ∏ i in s, (f i)! := +finset.prod_pos (λ i _, factorial_pos (f i)) + +lemma prod_factorial_dvd_factorial_sum : (∏ i in s, (f i)!) ∣ (∑ i in s, f i)! := +begin + classical, + induction s using finset.induction with a' s' has ih, + { simp only [finset.sum_empty, finset.prod_empty, factorial], }, + { simp only [finset.prod_insert has, finset.sum_insert has], + refine dvd_trans (mul_dvd_mul_left ((f a')!) ih) _, + apply nat.factorial_mul_factorial_dvd_factorial_add, }, +end + +end nat diff --git a/src/data/nat/factorial/cast.lean b/src/data/nat/factorial/cast.lean index 27a4a241076ad..73fbff0a63894 100644 --- a/src/data/nat/factorial/cast.lean +++ b/src/data/nat/factorial/cast.lean @@ -8,11 +8,14 @@ import ring_theory.polynomial.pochhammer /-! # Cast of factorials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file allows calculating factorials (including ascending and descending ones) as elements of a semiring. -This is particularly crucial for `nat.desc_factorial` as substraction on `ℕ` does **not** correspond -to substraction on a general semiring. For example, we can't rely on existing cast lemmas to prove +This is particularly crucial for `nat.desc_factorial` as subtraction on `ℕ` does **not** correspond +to subtraction on a general semiring. For example, we can't rely on existing cast lemmas to prove `↑(a.desc_factorial 2) = ↑a * (↑a - 1)`. We must use the fact that, whenever `↑(a - 1)` is not equal to `↑a - 1`, the other factor is `0` anyway. -/ @@ -52,7 +55,7 @@ end semiring section ring variables [ring S] (a b : ℕ) -/-- Convenience lemma. The `a - 1` is not using truncated substraction, as opposed to the definition +/-- Convenience lemma. The `a - 1` is not using truncated subtraction, as opposed to the definition of `nat.desc_factorial` as a natural. -/ lemma cast_desc_factorial_two : (a.desc_factorial 2 : S) = a * (a - 1) := diff --git a/src/data/nat/factorial/double_factorial.lean b/src/data/nat/factorial/double_factorial.lean new file mode 100644 index 0000000000000..5964c0ef8dd6a --- /dev/null +++ b/src/data/nat/factorial/double_factorial.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2023 Jake Levinson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jake Levinson +-/ +import data.nat.factorial.basic +import algebra.big_operators.order +import tactic.ring +/-! +# Double factorials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the double factorial, + `n‼ := n * (n - 2) * (n - 4) * ...`. + +## Main declarations + +* `nat.double_factorial`: The double factorial. +-/ + +open_locale nat +namespace nat + +/-- `nat.double_factorial n` is the double factorial of `n`. -/ +@[simp] def double_factorial : ℕ → ℕ +| 0 := 1 +| 1 := 1 +| (k + 2) := (k + 2) * double_factorial k + +-- This notation is `\!!` not two !'s +localized "notation (name := nat.double_factorial) n `‼`:10000 := nat.double_factorial n" in nat + +lemma double_factorial_add_two (n : ℕ) : (n + 2)‼ = (n + 2) * n‼ := rfl + +lemma double_factorial_add_one (n : ℕ) : (n + 1)‼ = (n + 1) * (n - 1)‼ := by { cases n; refl } + +lemma factorial_eq_mul_double_factorial : ∀ (n : ℕ), (n + 1)! = (n + 1)‼ * n‼ +| 0 := rfl +| (k + 1) := begin + rw [double_factorial_add_two, factorial, factorial_eq_mul_double_factorial, + mul_comm _ (k‼), mul_assoc] +end + +lemma double_factorial_two_mul : + ∀ (n : ℕ), (2 * n)‼ = 2^n * n! +| 0 := rfl +| (n + 1) := begin + rw [mul_add, mul_one, double_factorial_add_two, factorial, pow_succ, + double_factorial_two_mul, succ_eq_add_one], + ring, +end + +open_locale big_operators + +lemma double_factorial_eq_prod_even : + ∀ (n : ℕ), (2 * n)‼ = ∏ i in finset.range n, (2 * (i + 1)) +| 0 := rfl +| (n + 1) := begin + rw [finset.prod_range_succ, ← double_factorial_eq_prod_even, mul_comm (2 * n)‼, + (by ring : 2 * (n + 1) = 2 * n + 2)], + refl, +end + +lemma double_factorial_eq_prod_odd : + ∀ (n : ℕ), (2 * n + 1)‼ = ∏ i in finset.range n, (2 * (i + 1) + 1) +| 0 := rfl +| (n + 1) := begin + rw [finset.prod_range_succ, ← double_factorial_eq_prod_odd, mul_comm (2 * n + 1)‼, + (by ring : 2 * (n + 1) + 1 = (2 * n + 1) + 2)], + refl, +end + +end nat diff --git a/src/data/nat/factorization.lean b/src/data/nat/factorization.lean deleted file mode 100644 index 89dc6eea89007..0000000000000 --- a/src/data/nat/factorization.lean +++ /dev/null @@ -1,492 +0,0 @@ -/- -Copyright (c) 2021 Stuart Presnell. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Stuart Presnell --/ -import data.nat.prime -import data.finsupp.multiset -import algebra.big_operators.finsupp -import tactic.linarith -import tactic.interval_cases - -/-! -# Prime factorizations - - `n.factorization` is the finitely supported function `ℕ →₀ ℕ` - mapping each prime factor of `n` to its multiplicity in `n`. For example, since 2000 = 2^4 * 5^3, - * `factorization 2000 2` is 4 - * `factorization 2000 5` is 3 - * `factorization 2000 k` is 0 for all other `k : ℕ`. - -## TODO - -* As discussed in this Zulip thread: -https://leanprover.zulipchat.com/#narrow/stream/217875/topic/Multiplicity.20in.20the.20naturals -We have lots of disparate ways of talking about the multiplicity of a prime -in a natural number, including `factors.count`, `padic_val_nat`, `multiplicity`, -and the material in `data/pnat/factors`. Move some of this material to this file, -prove results about the relationships between these definitions, -and (where appropriate) choose a uniform canonical way of expressing these ideas. - -* Moreover, the results here should be generalised to an arbitrary unique factorization monoid -with a normalization function, and then deduplicated. The basics of this have been started in -`ring_theory/unique_factorization_domain`. - -* Extend the inductions to any `normalization_monoid` with unique factorization. - --/ - -open nat finset list finsupp -open_locale big_operators - -namespace nat - -/-- `n.factorization` is the finitely supported function `ℕ →₀ ℕ` - mapping each prime factor of `n` to its multiplicity in `n`. -/ -noncomputable def factorization (n : ℕ) : ℕ →₀ ℕ := (n.factors : multiset ℕ).to_finsupp - -/-! ### Basic facts about factorization -/ - -@[simp] lemma factorization_prod_pow_eq_self {n : ℕ} (hn : n ≠ 0) : n.factorization.prod pow = n := -begin - simp only [←prod_to_multiset, factorization, multiset.coe_prod, multiset.to_finsupp_to_multiset], - exact prod_factors hn, -end - -/-- We can write both `n.factorization p` and `n.factors.count p` to represent the power -of `p` in the factorization of `n`: we declare the former to be the simp-normal form. -However, since `factorization` is a finsupp it's noncomputable. This theorem can also -be used in reverse to compute values of `factorization n p` when required. -/ -@[simp] lemma factors_count_eq {n p : ℕ} : n.factors.count p = n.factorization p := -by simp [factorization] - -lemma eq_of_factorization_eq {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) - (h : ∀ p : ℕ, a.factorization p = b.factorization p) : a = b := -eq_of_perm_factors ha hb (by simpa only [list.perm_iff_count, factors_count_eq] using h) - -/-- Every nonzero natural number has a unique prime factorization -/ -lemma factorization_inj : set.inj_on factorization { x : ℕ | x ≠ 0 } := -λ a ha b hb h, eq_of_factorization_eq ha hb (λ p, by simp [h]) - -@[simp] lemma factorization_zero : factorization 0 = 0 := -by simp [factorization] - -@[simp] lemma factorization_one : factorization 1 = 0 := -by simp [factorization] - -/-- The support of `n.factorization` is exactly `n.factors.to_finset` -/ -@[simp] lemma support_factorization {n : ℕ} : n.factorization.support = n.factors.to_finset := -by simpa [factorization, multiset.to_finsupp_support] - -lemma factor_iff_mem_factorization {n p : ℕ} : p ∈ n.factorization.support ↔ p ∈ n.factors := -by simp only [support_factorization, list.mem_to_finset] - -lemma prime_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : p.prime := -prime_of_mem_factors (factor_iff_mem_factorization.mp hp) - -lemma pos_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : 0 < p := -prime.pos (prime_of_mem_factorization hp) - -lemma le_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ≤ n := -le_of_mem_factors (factor_iff_mem_factorization.mp h) - -lemma factorization_eq_zero_of_non_prime (n : ℕ) {p : ℕ} (hp : ¬p.prime) : n.factorization p = 0 := -not_mem_support_iff.1 (mt prime_of_mem_factorization hp) - -lemma dvd_of_factorization_pos {n p : ℕ} (hn : n.factorization p ≠ 0) : p ∣ n := -dvd_of_mem_factors (factor_iff_mem_factorization.1 (mem_support_iff.2 hn)) - -lemma prime.factorization_pos_of_dvd {n p : ℕ} (hp : p.prime) (hn : n ≠ 0) (h : p ∣ n) : - 0 < n.factorization p := -by rwa [←factors_count_eq, count_pos, mem_factors_iff_dvd hn hp] - -/-- The only numbers with empty prime factorization are `0` and `1` -/ -lemma factorization_eq_zero_iff (n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1 := -by simp [factorization, add_equiv.map_eq_zero_iff, multiset.coe_eq_zero] - -/-- For nonzero `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/ -@[simp] lemma factorization_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : - (a * b).factorization = a.factorization + b.factorization := -by { ext p, simp only [add_apply, ←factors_count_eq, - perm_iff_count.mp (perm_factors_mul ha hb) p, count_append] } - -lemma factorization_mul_support {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : - (a * b).factorization.support = a.factorization.support ∪ b.factorization.support := -begin - ext q, - simp only [finset.mem_union, factor_iff_mem_factorization], - exact mem_factors_mul ha hb -end - -/-- For any `p`, the power of `p` in `n^k` is `k` times the power in `n` -/ -@[simp] lemma factorization_pow (n k : ℕ) : - factorization (n^k) = k • n.factorization := -begin - induction k with k ih, { simp }, - rcases eq_or_ne n 0 with rfl | hn, { simp }, - rw [pow_succ, factorization_mul hn (pow_ne_zero _ hn), ih, succ_eq_one_add, add_smul, one_smul], -end - -/-- The only prime factor of prime `p` is `p` itself, with multiplicity `1` -/ -@[simp] lemma prime.factorization {p : ℕ} (hp : prime p) : - p.factorization = single p 1 := -begin - ext q, - rw [←factors_count_eq, factors_prime hp, single_apply, count_singleton', if_congr eq_comm]; - refl, -end - -/-- For prime `p` the only prime factor of `p^k` is `p` with multiplicity `k` -/ -lemma prime.factorization_pow {p k : ℕ} (hp : prime p) : - factorization (p ^ k) = single p k := -by simp [hp] - -/-- If the factorization of `n` contains just one number `p` then `n` is a power of `p` -/ -lemma eq_pow_of_factorization_eq_single {n p k : ℕ} (hn : n ≠ 0) - (h : n.factorization = finsupp.single p k) : n = p ^ k := -by { rw [←nat.factorization_prod_pow_eq_self hn, h], simp } - -/-- If a product over `n.factorization` doesn't use the multiplicities of the prime factors -then it's equal to the corresponding product over `n.factors.to_finset` -/ -lemma prod_factorization_eq_prod_factors {n : ℕ} {β : Type*} [comm_monoid β] (f : ℕ → β) : - n.factorization.prod (λ p k, f p) = ∏ p in n.factors.to_finset, (f p) := -by { apply prod_congr support_factorization, simp } - -/-- For any `p : ℕ` and any function `g : α → ℕ` that's non-zero on `S : finset α`, -the power of `p` in `S.prod g` equals the sum over `x ∈ S` of the powers of `p` in `g x`. -Generalises `factorization_mul`, which is the special case where `S.card = 2` and `g = id`. -/ -lemma factorization_prod {α : Type*} {S : finset α} {g : α → ℕ} (hS : ∀ x ∈ S, g x ≠ 0) : - (S.prod g).factorization = S.sum (λ x, (g x).factorization) := -begin - classical, - ext p, - apply finset.induction_on' S, { simp }, - { intros x T hxS hTS hxT IH, - have hT : T.prod g ≠ 0 := prod_ne_zero_iff.mpr (λ x hx, hS x (hTS hx)), - simp [prod_insert hxT, sum_insert hxT, ←IH, factorization_mul (hS x hxS) hT] } -end - -/-! ### Equivalence between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/ - -/-- Any finsupp `f : ℕ →₀ ℕ` whose support is in the primes is equal to the factorization of -the product `∏ (a : ℕ) in f.support, a ^ f a`. -/ -lemma prod_pow_factorization_eq_self {f : ℕ →₀ ℕ} (hf : ∀ (p : ℕ), p ∈ f.support → prime p) : - (f.prod pow).factorization = f := -begin - have h : ∀ x : ℕ, x ∈ f.support → x ^ f x ≠ 0 := λ p hp, pow_ne_zero _ (prime.ne_zero (hf p hp)), - simp only [finsupp.prod, factorization_prod h], - nth_rewrite_rhs 0 (sum_single f).symm, - exact sum_congr rfl (λ p hp, prime.factorization_pow (hf p hp)), -end - -lemma eq_factorization_iff {n : ℕ} {f : ℕ →₀ ℕ} (hn : n ≠ 0) (hf : ∀ p ∈ f.support, prime p) : - f = n.factorization ↔ f.prod pow = n := -⟨λ h, by rw [h, factorization_prod_pow_eq_self hn], - λ h, by rw [←h, prod_pow_factorization_eq_self hf]⟩ - -/-- The equiv between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/ -noncomputable -def factorization_equiv : ℕ+ ≃ {f : ℕ →₀ ℕ | ∀ p ∈ f.support, prime p} := -{ to_fun := λ ⟨n, hn⟩, ⟨n.factorization, λ _, prime_of_mem_factorization⟩, - inv_fun := λ ⟨f, hf⟩, ⟨f.prod pow, - prod_pow_pos_of_zero_not_mem_support (λ H, not_prime_zero (hf 0 H))⟩, - left_inv := λ ⟨x, hx⟩, subtype.ext $ factorization_prod_pow_eq_self hx.ne.symm, - right_inv := λ ⟨f, hf⟩, subtype.ext $ prod_pow_factorization_eq_self hf } - -lemma factorization_equiv_apply (n : ℕ+) : (factorization_equiv n).1 = n.1.factorization := -by { cases n, refl } - -lemma factorization_equiv_inv_apply {f : ℕ →₀ ℕ} (hf : ∀ p ∈ f.support, prime p) : - (factorization_equiv.symm ⟨f, hf⟩).1 = f.prod pow := rfl - -/-! ### Factorization and divisibility -/ - -lemma dvd_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ∣ n := -begin - rcases eq_or_ne n 0 with rfl | hn, { simp }, - simp [←mem_factors_iff_dvd hn (prime_of_mem_factorization h), factor_iff_mem_factorization.mp h], -end - -lemma pow_factorization_dvd (n p : ℕ) : p ^ n.factorization p ∣ n := -begin - by_cases hp : p.prime, swap, { simp [factorization_eq_zero_of_non_prime n hp] }, - rw ←factors_count_eq, - apply dvd_of_factors_subperm (pow_ne_zero _ hp.ne_zero), - rw [hp.factors_pow, list.subperm_ext_iff], - intros q hq, - simp [list.eq_of_mem_repeat hq], -end - -lemma pow_succ_factorization_not_dvd {n p : ℕ} (hn : n ≠ 0) (hp : p.prime) : - ¬ p ^ (n.factorization p + 1) ∣ n := -begin - intro h, - have := factors_sublist_of_dvd h hn, - rw [hp.factors_pow, ←le_count_iff_repeat_sublist, factors_count_eq] at this, - linarith -end - -lemma factorization_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) : - d.factorization ≤ n.factorization ↔ d ∣ n := -begin - split, - { intro hdn, - set K := n.factorization - d.factorization with hK, - use K.prod pow, - rw [←factorization_prod_pow_eq_self hn, ←factorization_prod_pow_eq_self hd, - ←finsupp.prod_add_index' pow_zero pow_add, hK, add_tsub_cancel_of_le hdn] }, - { rintro ⟨c, rfl⟩, rw factorization_mul hd (right_ne_zero_of_mul hn), simp }, -end - -lemma factorization_le_factorization_mul_left {a b : ℕ} (hb : b ≠ 0) : - a.factorization ≤ (a * b).factorization := -begin - rcases eq_or_ne a 0 with rfl | ha, { simp }, - rw [factorization_le_iff_dvd ha $ mul_ne_zero ha hb], - exact dvd.intro b rfl -end - -lemma factorization_le_factorization_mul_right {a b : ℕ} (ha : a ≠ 0) : - b.factorization ≤ (a * b).factorization := -by { rw mul_comm, apply factorization_le_factorization_mul_left ha } - -lemma prime.pow_dvd_iff_le_factorization {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) : - p ^ k ∣ n ↔ k ≤ n.factorization p := -by rw [←factorization_le_iff_dvd (pow_pos pp.pos k).ne' hn, pp.factorization_pow, single_le_iff] - -lemma prime.pow_dvd_iff_dvd_pow_factorization {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) : - p ^ k ∣ n ↔ p ^ k ∣ p ^ n.factorization p := -by rw [pow_dvd_pow_iff_le_right pp.one_lt, pp.pow_dvd_iff_le_factorization hn] - -lemma prime.dvd_iff_one_le_factorization {p n : ℕ} (pp : prime p) (hn : n ≠ 0) : - p ∣ n ↔ 1 ≤ n.factorization p := -iff.trans (by simp) (pp.pow_dvd_iff_le_factorization hn) - -lemma exists_factorization_lt_of_lt {a b : ℕ} (ha : a ≠ 0) (hab : a < b) : - ∃ p : ℕ, a.factorization p < b.factorization p := -begin - have hb : b ≠ 0 := (ha.bot_lt.trans hab).ne', - contrapose! hab, - rw [←finsupp.le_def, factorization_le_iff_dvd hb ha] at hab, - exact le_of_dvd ha.bot_lt hab, -end - -@[simp] lemma factorization_div {d n : ℕ} (h : d ∣ n) : - (n / d).factorization = n.factorization - d.factorization := -begin - rcases eq_or_ne d 0 with rfl | hd, { simp [zero_dvd_iff.mp h] }, - rcases eq_or_ne n 0 with rfl | hn, { simp }, - apply add_left_injective d.factorization, - simp only, - rw [tsub_add_cancel_of_le $ (nat.factorization_le_iff_dvd hd hn).mpr h, - ←nat.factorization_mul (nat.div_pos (nat.le_of_dvd hn.bot_lt h) hd.bot_lt).ne' hd, - nat.div_mul_cancel h], -end - -lemma dvd_iff_div_factorization_eq_tsub {d n : ℕ} (hd : d ≠ 0) (hdn : d ≤ n) : - d ∣ n ↔ (n / d).factorization = n.factorization - d.factorization := -begin - refine ⟨factorization_div, _⟩, - rcases eq_or_lt_of_le hdn with rfl | hd_lt_n, { simp }, - have h1 : n / d ≠ 0 := λ H, nat.lt_asymm hd_lt_n ((nat.div_eq_zero_iff hd.bot_lt).mp H), - intros h, - rw dvd_iff_le_div_mul n d, - by_contra h2, - cases (exists_factorization_lt_of_lt (mul_ne_zero h1 hd) (not_le.mp h2)) with p hp, - rwa [factorization_mul h1 hd, add_apply, ←lt_tsub_iff_right, h, tsub_apply, - lt_self_iff_false] at hp -end - -lemma dvd_iff_prime_pow_dvd_dvd (n d : ℕ) : - d ∣ n ↔ ∀ p k : ℕ, prime p → p ^ k ∣ d → p ^ k ∣ n := -begin - rcases eq_or_ne n 0 with rfl | hn, { simp }, - rcases eq_or_ne d 0 with rfl | hd, - { simp only [zero_dvd_iff, hn, false_iff, not_forall], - refine ⟨2, n, prime_two, ⟨dvd_zero _, _⟩⟩, - apply mt (le_of_dvd hn.bot_lt) (not_le.mpr (lt_two_pow n)) }, - refine ⟨λ h p k _ hpkd, dvd_trans hpkd h, _⟩, - rw [←factorization_le_iff_dvd hd hn, finsupp.le_def], - intros h p, - by_cases pp : prime p, swap, { simp [factorization_eq_zero_of_non_prime d pp] }, - rw ←pp.pow_dvd_iff_le_factorization hn, - exact h p _ pp (pow_factorization_dvd _ _) -end - -lemma prod_prime_factors_dvd (n : ℕ) : (∏ (p : ℕ) in n.factors.to_finset, p) ∣ n := -begin - by_cases hn : n = 0, { subst hn, simp }, - simpa [prod_factors hn] using multiset.to_finset_prod_dvd_prod (n.factors : multiset ℕ), -end - -lemma factorization_gcd {a b : ℕ} (ha_pos : a ≠ 0) (hb_pos : b ≠ 0) : - (gcd a b).factorization = a.factorization ⊓ b.factorization := -begin - let dfac := a.factorization ⊓ b.factorization, - let d := dfac.prod pow, - have dfac_prime : ∀ (p : ℕ), p ∈ dfac.support → prime p, - { intros p hp, - have : p ∈ a.factors ∧ p ∈ b.factors := by simpa using hp, - exact prime_of_mem_factors this.1 }, - have h1 : d.factorization = dfac := prod_pow_factorization_eq_self dfac_prime, - have hd_pos : d ≠ 0 := (factorization_equiv.inv_fun ⟨dfac, dfac_prime⟩).2.ne.symm, - suffices : d = (gcd a b), { rwa ←this }, - apply gcd_greatest, - { rw [←factorization_le_iff_dvd hd_pos ha_pos, h1], exact inf_le_left }, - { rw [←factorization_le_iff_dvd hd_pos hb_pos, h1], exact inf_le_right }, - { intros e hea heb, - rcases decidable.eq_or_ne e 0 with rfl | he_pos, - { simp only [zero_dvd_iff] at hea, contradiction, }, - have hea' := (factorization_le_iff_dvd he_pos ha_pos).mpr hea, - have heb' := (factorization_le_iff_dvd he_pos hb_pos).mpr heb, - simp [←factorization_le_iff_dvd he_pos hd_pos, h1, hea', heb'] }, -end - -/-! ### Factorization and coprimes -/ - -/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/ -lemma factorization_mul_apply_of_coprime {p a b : ℕ} (hab : coprime a b) : - (a * b).factorization p = a.factorization p + b.factorization p := -by simp only [←factors_count_eq, perm_iff_count.mp (perm_factors_mul_of_coprime hab), count_append] - -/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/ -lemma factorization_mul_of_coprime {a b : ℕ} (hab : coprime a b) : - (a * b).factorization = a.factorization + b.factorization := -begin - ext q, - simp only [finsupp.coe_add, add_apply, ←factors_count_eq, factorization_mul_apply_of_coprime hab], -end - -/-- If `p` is a prime factor of `a` then the power of `p` in `a` is the same that in `a * b`, -for any `b` coprime to `a`. -/ -lemma factorization_eq_of_coprime_left {p a b : ℕ} (hab : coprime a b) (hpa : p ∈ a.factors) : - (a * b).factorization p = a.factorization p := -begin - rw [factorization_mul_apply_of_coprime hab, ←factors_count_eq, ←factors_count_eq], - simpa only [count_eq_zero_of_not_mem (coprime_factors_disjoint hab hpa)], -end - -/-- If `p` is a prime factor of `b` then the power of `p` in `b` is the same that in `a * b`, -for any `a` coprime to `b`. -/ -lemma factorization_eq_of_coprime_right {p a b : ℕ} (hab : coprime a b) (hpb : p ∈ b.factors) : - (a * b).factorization p = b.factorization p := -by { rw mul_comm, exact factorization_eq_of_coprime_left (coprime_comm.mp hab) hpb } - -/-- The prime factorizations of coprime `a` and `b` are disjoint -/ -lemma factorization_disjoint_of_coprime {a b : ℕ} (hab : coprime a b) : - disjoint a.factorization.support b.factorization.support := -by simpa only [support_factorization] - using disjoint_to_finset_iff_disjoint.mpr (coprime_factors_disjoint hab) - -/-- For coprime `a` and `b` the prime factorization `a * b` is the union of those of `a` and `b` -/ -lemma factorization_mul_support_of_coprime {a b : ℕ} (hab : coprime a b) : - (a * b).factorization.support = a.factorization.support ∪ b.factorization.support := -begin - rw factorization_mul_of_coprime hab, - exact support_add_eq (factorization_disjoint_of_coprime hab), -end - -/-! ### Induction principles involving factorizations -/ - -/-- Given `P 0, P 1` and a way to extend `P a` to `P (p ^ n * a)` for prime `p` not dividing `a`, -we can define `P` for all natural numbers. -/ -@[elab_as_eliminator] -def rec_on_prime_pow {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1) - (h : ∀ a p n : ℕ, p.prime → ¬ p ∣ a → 0 < n → P a → P (p ^ n * a)) : ∀ (a : ℕ), P a := -λ a, nat.strong_rec_on a $ λ n, - match n with - | 0 := λ _, h0 - | 1 := λ _, h1 - | (k+2) := λ hk, begin - let p := (k + 2).min_fac, - have hp : prime p := min_fac_prime (succ_succ_ne_one k), - -- the awkward `let` stuff here is because `factorization` is noncomputable (finsupp); - -- we get around this by using the computable `factors.count`, and rewriting when we want - -- to use the `factorization` API - let t := (k+2).factors.count p, - have ht : t = (k+2).factorization p := factors_count_eq, - have hpt : p ^ t ∣ k + 2 := by { rw ht, exact pow_factorization_dvd _ _ }, - have htp : 0 < t := - by { rw ht, exact hp.factorization_pos_of_dvd (nat.succ_ne_zero _) (min_fac_dvd _) }, - convert h ((k + 2) / p ^ t) p t hp _ _ _, - { rw nat.mul_div_cancel' hpt, }, - { rw [nat.dvd_div_iff hpt, ←pow_succ', ht], - exact pow_succ_factorization_not_dvd (k + 1).succ_ne_zero hp }, - { exact htp }, - { apply hk _ (nat.div_lt_of_lt_mul _), - simp [lt_mul_iff_one_lt_left nat.succ_pos', one_lt_pow_iff htp.ne, hp.one_lt] }, - end - end - -/-- Given `P 0`, `P 1`, and `P (p ^ n)` for positive prime powers, and a way to extend `P a` and -`P b` to `P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/ -@[elab_as_eliminator] -def rec_on_pos_prime_pos_coprime {P : ℕ → Sort*} (hp : ∀ p n : ℕ, prime p → 0 < n → P (p ^ n)) - (h0 : P 0) (h1 : P 1) (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) : - ∀ a, P a := -rec_on_prime_pow h0 h1 $ -begin - intros a p n hp' hpa hn hPa, - by_cases ha1 : a = 1, - { rw [ha1, mul_one], - exact hp p n hp' hn }, - refine h (p^n) a ((hp'.one_lt).trans_le (le_self_pow (prime.one_lt hp').le (succ_le_iff.mpr hn))) - _ _ (hp _ _ hp' hn) hPa, - { refine lt_of_not_ge (λ (h : a ≤ 1), _), - interval_cases a, - { simpa only [dvd_zero, not_true] using hpa }, - { contradiction } }, - simpa [hn, prime.coprime_iff_not_dvd hp'], -end - -/-- Given `P 0`, `P (p ^ n)` for all prime powers, and a way to extend `P a` and `P b` to -`P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/ -@[elab_as_eliminator] -def rec_on_prime_coprime {P : ℕ → Sort*} (h0 : P 0) (hp : ∀ p n : ℕ, prime p → P (p ^ n)) - (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) : ∀ a, P a := -rec_on_pos_prime_pos_coprime (λ p n h _, hp p n h) h0 (hp 2 0 prime_two) h - -/-- Given `P 0`, `P 1`, `P p` for all primes, and a way to extend `P a` and `P b` to -`P (a * b)`, we can define `P` for all natural numbers. -/ -@[elab_as_eliminator] -def rec_on_mul {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1) - (hp : ∀ p, prime p → P p) (h : ∀ a b, P a → P b → P (a * b)) : ∀ a, P a := -let hp : ∀ p n : ℕ, prime p → P (p ^ n) := - λ p n hp', match n with - | 0 := h1 - | (n+1) := by exact h _ _ (hp p hp') (_match _) - end in -rec_on_prime_coprime h0 hp $ λ a b _ _ _, h a b - -/-- For any multiplicative function `f` with `f 1 = 1` and any `n ≠ 0`, -we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/ -lemma multiplicative_factorization {β : Type*} [comm_monoid β] (f : ℕ → β) - (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf : f 1 = 1) : - ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) := -begin - apply' nat.rec_on_pos_prime_pos_coprime, - { intros p k hp hk hpk, simp [prime.factorization_pow hp, finsupp.prod_single_index _, hf] }, - { simp }, - { rintros -, rw [factorization_one, hf], simp }, - { intros a b _ _ hab ha hb hab_pos, - rw [h_mult a b hab, ha (left_ne_zero_of_mul hab_pos), hb (right_ne_zero_of_mul hab_pos), - factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint], - convert (factorization_disjoint_of_coprime hab) }, -end - -/-- For any multiplicative function `f` with `f 1 = 1` and `f 0 = 1`, -we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/ -lemma multiplicative_factorization' {β : Type*} [comm_monoid β] (f : ℕ → β) - (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf0 : f 0 = 1) (hf1 : f 1 = 1) : - ∀ {n : ℕ}, f n = n.factorization.prod (λ p k, f (p ^ k)) := -begin - apply' nat.rec_on_pos_prime_pos_coprime, - { intros p k hp hk, simp only [hp.factorization_pow], rw prod_single_index _, simp [hf1] }, - { simp [hf0] }, - { rw [factorization_one, hf1], simp }, - { intros a b _ _ hab ha hb, - rw [h_mult a b hab, ha, hb, factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint], - convert (factorization_disjoint_of_coprime hab) }, -end - -end nat diff --git a/src/data/nat/factorization/basic.lean b/src/data/nat/factorization/basic.lean new file mode 100644 index 0000000000000..492f64d1295d4 --- /dev/null +++ b/src/data/nat/factorization/basic.lean @@ -0,0 +1,860 @@ +/- +Copyright (c) 2021 Stuart Presnell. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Stuart Presnell +-/ +import algebra.big_operators.finsupp +import data.finsupp.multiset +import data.nat.prime_fin +import number_theory.padics.padic_val +import data.nat.interval +import tactic.interval_cases + +/-! +# Prime factorizations + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + + `n.factorization` is the finitely supported function `ℕ →₀ ℕ` + mapping each prime factor of `n` to its multiplicity in `n`. For example, since 2000 = 2^4 * 5^3, + * `factorization 2000 2` is 4 + * `factorization 2000 5` is 3 + * `factorization 2000 k` is 0 for all other `k : ℕ`. + +## TODO + +* As discussed in this Zulip thread: +https://leanprover.zulipchat.com/#narrow/stream/217875/topic/Multiplicity.20in.20the.20naturals +We have lots of disparate ways of talking about the multiplicity of a prime +in a natural number, including `factors.count`, `padic_val_nat`, `multiplicity`, +and the material in `data/pnat/factors`. Move some of this material to this file, +prove results about the relationships between these definitions, +and (where appropriate) choose a uniform canonical way of expressing these ideas. + +* Moreover, the results here should be generalised to an arbitrary unique factorization monoid +with a normalization function, and then deduplicated. The basics of this have been started in +`ring_theory/unique_factorization_domain`. + +* Extend the inductions to any `normalization_monoid` with unique factorization. + +-/ + +open nat finset list finsupp +open_locale big_operators + +namespace nat + +/-- `n.factorization` is the finitely supported function `ℕ →₀ ℕ` + mapping each prime factor of `n` to its multiplicity in `n`. -/ +def factorization (n : ℕ) : ℕ →₀ ℕ := +{ support := n.factors.to_finset, + to_fun := λ p, if p.prime then padic_val_nat p n else 0, + mem_support_to_fun := + begin + rcases eq_or_ne n 0 with rfl | hn0, { simp }, + simp only [mem_factors hn0, mem_to_finset, ne.def, ite_eq_right_iff, not_forall, + exists_prop, and.congr_right_iff], + rintro p hp, + haveI := fact_iff.mpr hp, + exact dvd_iff_padic_val_nat_ne_zero hn0, + end } + +lemma factorization_def (n : ℕ) {p : ℕ} (pp : p.prime) : n.factorization p = padic_val_nat p n := +by simpa [factorization] using absurd pp + +/-- We can write both `n.factorization p` and `n.factors.count p` to represent the power +of `p` in the factorization of `n`: we declare the former to be the simp-normal form. -/ +@[simp] lemma factors_count_eq {n p : ℕ} : n.factors.count p = n.factorization p := +begin + rcases n.eq_zero_or_pos with rfl | hn0, { simp [factorization] }, + by_cases pp : p.prime, swap, + { rw count_eq_zero_of_not_mem (mt prime_of_mem_factors pp), simp [factorization, pp] }, + simp only [factorization, coe_mk, pp, if_true], + rw [←part_enat.coe_inj, padic_val_nat_def' pp.ne_one hn0, + unique_factorization_monoid.multiplicity_eq_count_normalized_factors pp hn0.ne'], + simp [factors_eq], +end + +lemma factorization_eq_factors_multiset (n : ℕ) : + n.factorization = (n.factors : multiset ℕ).to_finsupp := +by { ext p, simp } + +lemma multiplicity_eq_factorization {n p : ℕ} (pp : p.prime) (hn : n ≠ 0) : + multiplicity p n = n.factorization p := +by simp [factorization, pp, (padic_val_nat_def' pp.ne_one hn.bot_lt)] + +/-! ### Basic facts about factorization -/ + +@[simp] lemma factorization_prod_pow_eq_self {n : ℕ} (hn : n ≠ 0) : n.factorization.prod pow = n := +begin + rw factorization_eq_factors_multiset n, + simp only [←prod_to_multiset, factorization, multiset.coe_prod, multiset.to_finsupp_to_multiset], + exact prod_factors hn, +end + +lemma eq_of_factorization_eq {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) + (h : ∀ p : ℕ, a.factorization p = b.factorization p) : a = b := +eq_of_perm_factors ha hb (by simpa only [list.perm_iff_count, factors_count_eq] using h) + +/-- Every nonzero natural number has a unique prime factorization -/ +lemma factorization_inj : set.inj_on factorization { x : ℕ | x ≠ 0 } := +λ a ha b hb h, eq_of_factorization_eq ha hb (λ p, by simp [h]) + +@[simp] lemma factorization_zero : factorization 0 = 0 := +by simpa [factorization] + +@[simp] lemma factorization_one : factorization 1 = 0 := +by simpa [factorization] + +/-- The support of `n.factorization` is exactly `n.factors.to_finset` -/ +@[simp] lemma support_factorization {n : ℕ} : n.factorization.support = n.factors.to_finset := +by simp [factorization] + +lemma factor_iff_mem_factorization {n p : ℕ} : p ∈ n.factorization.support ↔ p ∈ n.factors := +by simp only [support_factorization, list.mem_to_finset] + +lemma prime_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : p.prime := +prime_of_mem_factors (factor_iff_mem_factorization.mp hp) + +lemma pos_of_mem_factorization {n p : ℕ} (hp : p ∈ n.factorization.support) : 0 < p := +prime.pos (prime_of_mem_factorization hp) + +lemma le_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ≤ n := +le_of_mem_factors (factor_iff_mem_factorization.mp h) + +/-! ## Lemmas characterising when `n.factorization p = 0` -/ + +lemma factorization_eq_zero_iff (n p : ℕ) : + n.factorization p = 0 ↔ ¬p.prime ∨ ¬p ∣ n ∨ n = 0 := +begin + rw [←not_mem_support_iff, support_factorization, mem_to_finset], + rcases eq_or_ne n 0 with rfl | hn, + { simp }, + { simp [hn, nat.mem_factors, not_and_distrib] }, +end + +@[simp] +lemma factorization_eq_zero_of_non_prime (n : ℕ) {p : ℕ} (hp : ¬p.prime) : n.factorization p = 0 := +by simp [factorization_eq_zero_iff, hp] + +lemma factorization_eq_zero_of_not_dvd {n p : ℕ} (h : ¬ p ∣ n) : n.factorization p = 0 := +by simp [factorization_eq_zero_iff, h] + +lemma factorization_eq_zero_of_lt {n p : ℕ} (h : n < p) : n.factorization p = 0 := +finsupp.not_mem_support_iff.mp (mt le_of_mem_factorization (not_le_of_lt h)) + +@[simp] lemma factorization_zero_right (n : ℕ) : n.factorization 0 = 0 := +factorization_eq_zero_of_non_prime _ not_prime_zero + +@[simp] lemma factorization_one_right (n : ℕ) : n.factorization 1 = 0 := +factorization_eq_zero_of_non_prime _ not_prime_one + +lemma dvd_of_factorization_pos {n p : ℕ} (hn : n.factorization p ≠ 0) : p ∣ n := +dvd_of_mem_factors (factor_iff_mem_factorization.1 (mem_support_iff.2 hn)) + +lemma prime.factorization_pos_of_dvd {n p : ℕ} (hp : p.prime) (hn : n ≠ 0) (h : p ∣ n) : + 0 < n.factorization p := +by rwa [←factors_count_eq, count_pos, mem_factors_iff_dvd hn hp] + +lemma factorization_eq_zero_of_remainder {p r : ℕ} (i : ℕ) (hr : ¬ p ∣ r) : + (p * i + r).factorization p = 0 := +by { apply factorization_eq_zero_of_not_dvd, rwa ←nat.dvd_add_iff_right (dvd.intro i rfl) } + +lemma factorization_eq_zero_iff_remainder {p r : ℕ} (i : ℕ) (pp : p.prime) (hr0 : r ≠ 0) : + (¬ p ∣ r) ↔ (p * i + r).factorization p = 0 := +begin + refine ⟨factorization_eq_zero_of_remainder i, λ h, _⟩, + rw factorization_eq_zero_iff at h, + contrapose! h, + refine ⟨pp, _, _⟩, + { rwa ←nat.dvd_add_iff_right ((dvd.intro i rfl)) }, + { contrapose! hr0, exact (_root_.add_eq_zero_iff.mp hr0).2 }, +end + +/-- The only numbers with empty prime factorization are `0` and `1` -/ +lemma factorization_eq_zero_iff' (n : ℕ) : n.factorization = 0 ↔ n = 0 ∨ n = 1 := +begin + rw factorization_eq_factors_multiset n, + simp [factorization, add_equiv.map_eq_zero_iff, multiset.coe_eq_zero], +end + +/-! ## Lemmas about factorizations of products and powers -/ + +/-- For nonzero `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/ +@[simp] lemma factorization_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : + (a * b).factorization = a.factorization + b.factorization := +by { ext p, simp only [add_apply, ←factors_count_eq, + perm_iff_count.mp (perm_factors_mul ha hb) p, count_append] } + +lemma factorization_mul_support {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : + (a * b).factorization.support = a.factorization.support ∪ b.factorization.support := +begin + ext q, + simp only [finset.mem_union, factor_iff_mem_factorization], + exact mem_factors_mul ha hb +end + +/-- If a product over `n.factorization` doesn't use the multiplicities of the prime factors +then it's equal to the corresponding product over `n.factors.to_finset` -/ +lemma prod_factorization_eq_prod_factors {n : ℕ} {β : Type*} [comm_monoid β] (f : ℕ → β) : + n.factorization.prod (λ p k, f p) = ∏ p in n.factors.to_finset, (f p) := +by { apply prod_congr support_factorization, simp } + +/-- For any `p : ℕ` and any function `g : α → ℕ` that's non-zero on `S : finset α`, +the power of `p` in `S.prod g` equals the sum over `x ∈ S` of the powers of `p` in `g x`. +Generalises `factorization_mul`, which is the special case where `S.card = 2` and `g = id`. -/ +lemma factorization_prod {α : Type*} {S : finset α} {g : α → ℕ} (hS : ∀ x ∈ S, g x ≠ 0) : + (S.prod g).factorization = S.sum (λ x, (g x).factorization) := +begin + classical, + ext p, + apply finset.induction_on' S, { simp }, + { intros x T hxS hTS hxT IH, + have hT : T.prod g ≠ 0 := prod_ne_zero_iff.mpr (λ x hx, hS x (hTS hx)), + simp [prod_insert hxT, sum_insert hxT, ←IH, factorization_mul (hS x hxS) hT] } +end + +/-- For any `p`, the power of `p` in `n^k` is `k` times the power in `n` -/ +@[simp] lemma factorization_pow (n k : ℕ) : + factorization (n^k) = k • n.factorization := +begin + induction k with k ih, { simp }, + rcases eq_or_ne n 0 with rfl | hn, { simp }, + rw [pow_succ, factorization_mul hn (pow_ne_zero _ hn), ih, succ_eq_one_add, add_smul, one_smul], +end + +/-! ## Lemmas about factorizations of primes and prime powers -/ + +/-- The only prime factor of prime `p` is `p` itself, with multiplicity `1` -/ +@[simp] lemma prime.factorization {p : ℕ} (hp : prime p) : + p.factorization = single p 1 := +begin + ext q, + rw [←factors_count_eq, factors_prime hp, single_apply, count_singleton', if_congr eq_comm]; + refl, +end + +/-- The multiplicity of prime `p` in `p` is `1` -/ +@[simp] lemma prime.factorization_self {p : ℕ} (hp : prime p) : p.factorization p = 1 := +by simp [hp] + +/-- For prime `p` the only prime factor of `p^k` is `p` with multiplicity `k` -/ +lemma prime.factorization_pow {p k : ℕ} (hp : prime p) : + factorization (p ^ k) = single p k := +by simp [hp] + +/-- If the factorization of `n` contains just one number `p` then `n` is a power of `p` -/ +lemma eq_pow_of_factorization_eq_single {n p k : ℕ} (hn : n ≠ 0) + (h : n.factorization = finsupp.single p k) : n = p ^ k := +by { rw [←nat.factorization_prod_pow_eq_self hn, h], simp } + +/-- The only prime factor of prime `p` is `p` itself. -/ +lemma prime.eq_of_factorization_pos {p q : ℕ} (hp : prime p) (h : p.factorization q ≠ 0) : + p = q := +by simpa [hp.factorization, single_apply] using h + +/-! ### Equivalence between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/ + +/-- Any finsupp `f : ℕ →₀ ℕ` whose support is in the primes is equal to the factorization of +the product `∏ (a : ℕ) in f.support, a ^ f a`. -/ +lemma prod_pow_factorization_eq_self {f : ℕ →₀ ℕ} (hf : ∀ (p : ℕ), p ∈ f.support → prime p) : + (f.prod pow).factorization = f := +begin + have h : ∀ x : ℕ, x ∈ f.support → x ^ f x ≠ 0 := λ p hp, pow_ne_zero _ (prime.ne_zero (hf p hp)), + simp only [finsupp.prod, factorization_prod h], + nth_rewrite_rhs 0 (sum_single f).symm, + exact sum_congr rfl (λ p hp, prime.factorization_pow (hf p hp)), +end + +lemma eq_factorization_iff {n : ℕ} {f : ℕ →₀ ℕ} (hn : n ≠ 0) (hf : ∀ p ∈ f.support, prime p) : + f = n.factorization ↔ f.prod pow = n := +⟨λ h, by rw [h, factorization_prod_pow_eq_self hn], + λ h, by rw [←h, prod_pow_factorization_eq_self hf]⟩ + +/-- The equiv between `ℕ+` and `ℕ →₀ ℕ` with support in the primes. -/ +def factorization_equiv : ℕ+ ≃ {f : ℕ →₀ ℕ | ∀ p ∈ f.support, prime p} := +{ to_fun := λ ⟨n, hn⟩, ⟨n.factorization, λ _, prime_of_mem_factorization⟩, + inv_fun := λ ⟨f, hf⟩, ⟨f.prod pow, + prod_pow_pos_of_zero_not_mem_support (λ H, not_prime_zero (hf 0 H))⟩, + left_inv := λ ⟨x, hx⟩, subtype.ext $ factorization_prod_pow_eq_self hx.ne.symm, + right_inv := λ ⟨f, hf⟩, subtype.ext $ prod_pow_factorization_eq_self hf } + +lemma factorization_equiv_apply (n : ℕ+) : (factorization_equiv n).1 = n.1.factorization := +by { cases n, refl } + +lemma factorization_equiv_inv_apply {f : ℕ →₀ ℕ} (hf : ∀ p ∈ f.support, prime p) : + (factorization_equiv.symm ⟨f, hf⟩).1 = f.prod pow := rfl + +/-! ### Generalisation of the "even part" and "odd part" of a natural number + +We introduce the notations `ord_proj[p] n` for the largest power of the prime `p` that +divides `n` and `ord_compl[p] n` for the complementary part. The `ord` naming comes from +the $p$-adic order/valuation of a number, and `proj` and `compl` are for the projection and +complementary projection. The term `n.factorization p` is the $p$-adic order itself. +For example, `ord_proj[2] n` is the even part of `n` and `ord_compl[2] n` is the odd part. -/ + +notation `ord_proj[` p `] ` n:max := p ^ (nat.factorization n p) +notation `ord_compl[` p `] ` n:max := n / ord_proj[p] n + +@[simp] lemma ord_proj_of_not_prime (n p : ℕ) (hp : ¬ p.prime) : ord_proj[p] n = 1 := +by simp [factorization_eq_zero_of_non_prime n hp] + +@[simp] lemma ord_compl_of_not_prime (n p : ℕ) (hp : ¬ p.prime) : ord_compl[p] n = n := +by simp [factorization_eq_zero_of_non_prime n hp] + +lemma ord_proj_dvd (n p : ℕ) : ord_proj[p] n ∣ n := +begin + by_cases hp : p.prime, swap, { simp [hp] }, + rw ←factors_count_eq, + apply dvd_of_factors_subperm (pow_ne_zero _ hp.ne_zero), + rw [hp.factors_pow, list.subperm_ext_iff], + intros q hq, + simp [list.eq_of_mem_replicate hq], +end + +lemma ord_compl_dvd (n p : ℕ) : ord_compl[p] n ∣ n := +div_dvd_of_dvd (ord_proj_dvd n p) + +lemma ord_proj_pos (n p : ℕ) : 0 < ord_proj[p] n := +begin + by_cases pp : p.prime, + { simp [pow_pos pp.pos] }, + { simp [pp] }, +end + +lemma ord_proj_le {n : ℕ} (p : ℕ) (hn : n ≠ 0) : ord_proj[p] n ≤ n := +le_of_dvd hn.bot_lt (nat.ord_proj_dvd n p) + +lemma ord_compl_pos {n : ℕ} (p : ℕ) (hn : n ≠ 0) : 0 < ord_compl[p] n := +begin + cases em' p.prime with pp pp, + { simpa [nat.factorization_eq_zero_of_non_prime n pp] using hn.bot_lt }, + exact nat.div_pos (ord_proj_le p hn) (ord_proj_pos n p), +end + +lemma ord_compl_le (n p : ℕ) : ord_compl[p] n ≤ n := +nat.div_le_self _ _ + +lemma ord_proj_mul_ord_compl_eq_self (n p : ℕ) : ord_proj[p] n * ord_compl[p] n = n := +nat.mul_div_cancel' (ord_proj_dvd n p) + +lemma ord_proj_mul {a b : ℕ} (p : ℕ) (ha : a ≠ 0) (hb : b ≠ 0): + ord_proj[p] (a * b) = ord_proj[p] a * ord_proj[p] b := +by simp [factorization_mul ha hb, pow_add] + +lemma ord_compl_mul (a b p : ℕ) : + ord_compl[p] (a * b) = ord_compl[p] a * ord_compl[p] b := +begin + rcases eq_or_ne a 0 with rfl | ha, { simp }, + rcases eq_or_ne b 0 with rfl | hb, { simp }, + simp only [ord_proj_mul p ha hb], + rw (mul_div_mul_comm_of_dvd_dvd (ord_proj_dvd a p) (ord_proj_dvd b p)), +end + +/-! ### Factorization and divisibility -/ + +lemma dvd_of_mem_factorization {n p : ℕ} (h : p ∈ n.factorization.support) : p ∣ n := +begin + rcases eq_or_ne n 0 with rfl | hn, { simp }, + simp [←mem_factors_iff_dvd hn (prime_of_mem_factorization h), factor_iff_mem_factorization.mp h], +end + +/-- A crude upper bound on `n.factorization p` -/ +lemma factorization_lt {n : ℕ} (p : ℕ) (hn : n ≠ 0) : n.factorization p < n := +begin + by_cases pp : p.prime, swap, { simp [factorization_eq_zero_of_non_prime n pp], exact hn.bot_lt }, + rw ←pow_lt_iff_lt_right pp.two_le, + apply lt_of_le_of_lt (ord_proj_le p hn), + exact lt_of_lt_of_le (lt_two_pow n) (pow_le_pow_of_le_left (by linarith) pp.two_le n), +end + +/-- An upper bound on `n.factorization p` -/ +lemma factorization_le_of_le_pow {n p b : ℕ} (hb : n ≤ p ^ b) : n.factorization p ≤ b := +begin + rcases eq_or_ne n 0 with rfl | hn, { simp }, + by_cases pp : p.prime, + { exact (pow_le_iff_le_right pp.two_le).1 (le_trans (ord_proj_le p hn) hb) }, + { simp [factorization_eq_zero_of_non_prime n pp] } +end + +lemma factorization_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) : + d.factorization ≤ n.factorization ↔ d ∣ n := +begin + split, + { intro hdn, + set K := n.factorization - d.factorization with hK, + use K.prod pow, + rw [←factorization_prod_pow_eq_self hn, ←factorization_prod_pow_eq_self hd, + ←finsupp.prod_add_index' pow_zero pow_add, hK, add_tsub_cancel_of_le hdn] }, + { rintro ⟨c, rfl⟩, rw factorization_mul hd (right_ne_zero_of_mul hn), simp }, +end + +lemma factorization_prime_le_iff_dvd {d n : ℕ} (hd : d ≠ 0) (hn : n ≠ 0) : + (∀ p : ℕ, p.prime → d.factorization p ≤ n.factorization p) ↔ d ∣ n := +begin + rw ← factorization_le_iff_dvd hd hn, + refine ⟨λ h p, (em p.prime).elim (h p) (λ hp, _), λ h p _, h p⟩, + simp_rw factorization_eq_zero_of_non_prime _ hp, +end + +lemma pow_succ_factorization_not_dvd {n p : ℕ} (hn : n ≠ 0) (hp : p.prime) : + ¬ p ^ (n.factorization p + 1) ∣ n := +begin + intro h, + rw ←factorization_le_iff_dvd (pow_pos hp.pos _).ne' hn at h, + simpa [hp.factorization] using h p, +end + +lemma factorization_le_factorization_mul_left {a b : ℕ} (hb : b ≠ 0) : + a.factorization ≤ (a * b).factorization := +begin + rcases eq_or_ne a 0 with rfl | ha, { simp }, + rw [factorization_le_iff_dvd ha $ mul_ne_zero ha hb], + exact dvd.intro b rfl +end + +lemma factorization_le_factorization_mul_right {a b : ℕ} (ha : a ≠ 0) : + b.factorization ≤ (a * b).factorization := +by { rw mul_comm, apply factorization_le_factorization_mul_left ha } + +lemma prime.pow_dvd_iff_le_factorization {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) : + p ^ k ∣ n ↔ k ≤ n.factorization p := +by rw [←factorization_le_iff_dvd (pow_pos pp.pos k).ne' hn, pp.factorization_pow, single_le_iff] + +lemma prime.pow_dvd_iff_dvd_ord_proj {p k n : ℕ} (pp : prime p) (hn : n ≠ 0) : + p ^ k ∣ n ↔ p ^ k ∣ ord_proj[p] n := +by rw [pow_dvd_pow_iff_le_right pp.one_lt, pp.pow_dvd_iff_le_factorization hn] + +lemma prime.dvd_iff_one_le_factorization {p n : ℕ} (pp : prime p) (hn : n ≠ 0) : + p ∣ n ↔ 1 ≤ n.factorization p := +iff.trans (by simp) (pp.pow_dvd_iff_le_factorization hn) + +lemma exists_factorization_lt_of_lt {a b : ℕ} (ha : a ≠ 0) (hab : a < b) : + ∃ p : ℕ, a.factorization p < b.factorization p := +begin + have hb : b ≠ 0 := (ha.bot_lt.trans hab).ne', + contrapose! hab, + rw [←finsupp.le_def, factorization_le_iff_dvd hb ha] at hab, + exact le_of_dvd ha.bot_lt hab, +end + +@[simp] lemma factorization_div {d n : ℕ} (h : d ∣ n) : + (n / d).factorization = n.factorization - d.factorization := +begin + rcases eq_or_ne d 0 with rfl | hd, { simp [zero_dvd_iff.mp h] }, + rcases eq_or_ne n 0 with rfl | hn, { simp }, + apply add_left_injective d.factorization, + simp only, + rw [tsub_add_cancel_of_le $ (nat.factorization_le_iff_dvd hd hn).mpr h, + ←nat.factorization_mul (nat.div_pos (nat.le_of_dvd hn.bot_lt h) hd.bot_lt).ne' hd, + nat.div_mul_cancel h], +end + +lemma dvd_ord_proj_of_dvd {n p : ℕ} (hn : n ≠ 0) (pp : p.prime) (h : p ∣ n) : + p ∣ ord_proj[p] n := +dvd_pow_self p (prime.factorization_pos_of_dvd pp hn h).ne' + +lemma not_dvd_ord_compl {n p : ℕ} (hp : prime p) (hn : n ≠ 0) : + ¬p ∣ ord_compl[p] n := +begin + rw [nat.prime.dvd_iff_one_le_factorization hp (ord_compl_pos p hn).ne'], + rw [nat.factorization_div (nat.ord_proj_dvd n p)], + simp [hp.factorization], +end + +lemma coprime_ord_compl {n p : ℕ} (hp : prime p) (hn : n ≠ 0) : + coprime p (ord_compl[p] n) := +(or_iff_left (not_dvd_ord_compl hp hn)).mp $ coprime_or_dvd_of_prime hp _ + +lemma factorization_ord_compl (n p : ℕ) : + (ord_compl[p] n).factorization = n.factorization.erase p := +begin + rcases eq_or_ne n 0 with rfl | hn, { simp }, + by_cases pp : p.prime, swap, { simp [pp] }, + ext q, + rcases eq_or_ne q p with rfl | hqp, + { simp only [finsupp.erase_same, factorization_eq_zero_iff, not_dvd_ord_compl pp hn], + simp }, + { rw [finsupp.erase_ne hqp, factorization_div (ord_proj_dvd n p)], + simp [pp.factorization, hqp.symm] }, +end + +-- `ord_compl[p] n` is the largest divisor of `n` not divisible by `p`. +lemma dvd_ord_compl_of_dvd_not_dvd {p d n : ℕ} (hdn : d ∣ n) (hpd : ¬ p ∣ d) : + d ∣ ord_compl[p] n := +begin + rcases eq_or_ne n 0 with rfl | hn0, { simp }, + rcases eq_or_ne d 0 with rfl | hd0, { simp at hpd, cases hpd }, + rw [←(factorization_le_iff_dvd hd0 (ord_compl_pos p hn0).ne'), factorization_ord_compl], + intro q, + rcases eq_or_ne q p with rfl | hqp, + { simp [factorization_eq_zero_iff, hpd] }, + { simp [hqp, (factorization_le_iff_dvd hd0 hn0).2 hdn q] }, +end + +/-- If `n` is a nonzero natural number and `p ≠ 1`, then there are natural numbers `e` +and `n'` such that `n'` is not divisible by `p` and `n = p^e * n'`. -/ +lemma exists_eq_pow_mul_and_not_dvd {n : ℕ} (hn : n ≠ 0) (p : ℕ) (hp : p ≠ 1) : + ∃ e n' : ℕ, ¬ p ∣ n' ∧ n = p ^ e * n' := +let ⟨a', h₁, h₂⟩ := multiplicity.exists_eq_pow_mul_and_not_dvd + (multiplicity.finite_nat_iff.mpr ⟨hp, nat.pos_of_ne_zero hn⟩) in +⟨_, a', h₂, h₁⟩ + +lemma dvd_iff_div_factorization_eq_tsub {d n : ℕ} (hd : d ≠ 0) (hdn : d ≤ n) : + d ∣ n ↔ (n / d).factorization = n.factorization - d.factorization := +begin + refine ⟨factorization_div, _⟩, + rcases eq_or_lt_of_le hdn with rfl | hd_lt_n, { simp }, + have h1 : n / d ≠ 0 := λ H, nat.lt_asymm hd_lt_n ((nat.div_eq_zero_iff hd.bot_lt).mp H), + intros h, + rw dvd_iff_le_div_mul n d, + by_contra h2, + cases (exists_factorization_lt_of_lt (mul_ne_zero h1 hd) (not_le.mp h2)) with p hp, + rwa [factorization_mul h1 hd, add_apply, ←lt_tsub_iff_right, h, tsub_apply, + lt_self_iff_false] at hp +end + +lemma ord_proj_dvd_ord_proj_of_dvd {a b : ℕ} (hb0 : b ≠ 0) (hab : a ∣ b) (p : ℕ) : + ord_proj[p] a ∣ ord_proj[p] b := +begin + rcases em' p.prime with pp | pp, { simp [pp] }, + rcases eq_or_ne a 0 with rfl | ha0, { simp }, + rw pow_dvd_pow_iff_le_right pp.one_lt, + exact (factorization_le_iff_dvd ha0 hb0).2 hab p, +end + +lemma ord_proj_dvd_ord_proj_iff_dvd {a b : ℕ} (ha0 : a ≠ 0) (hb0 : b ≠ 0) : + (∀ p : ℕ, ord_proj[p] a ∣ ord_proj[p] b) ↔ (a ∣ b) := +begin + refine ⟨λ h, _, λ hab p, ord_proj_dvd_ord_proj_of_dvd hb0 hab p⟩, + rw ←factorization_le_iff_dvd ha0 hb0, + intro q, + rcases le_or_lt q 1 with hq_le | hq1, { interval_cases q; simp }, + exact (pow_dvd_pow_iff_le_right hq1).1 (h q), +end + +lemma ord_compl_dvd_ord_compl_of_dvd {a b : ℕ} (hab : a ∣ b) (p : ℕ) : + ord_compl[p] a ∣ ord_compl[p] b := +begin + rcases em' p.prime with pp | pp, { simp [pp, hab] }, + rcases eq_or_ne b 0 with rfl | hb0, { simp }, + rcases eq_or_ne a 0 with rfl | ha0, { cases hb0 (zero_dvd_iff.1 hab) }, + have ha := (nat.div_pos (ord_proj_le p ha0) (ord_proj_pos a p)).ne', + have hb := (nat.div_pos (ord_proj_le p hb0) (ord_proj_pos b p)).ne', + rw [←factorization_le_iff_dvd ha hb, factorization_ord_compl a p, factorization_ord_compl b p], + intro q, + rcases eq_or_ne q p with rfl | hqp, { simp }, + simp_rw erase_ne hqp, + exact (factorization_le_iff_dvd ha0 hb0).2 hab q, +end + +lemma ord_compl_dvd_ord_compl_iff_dvd (a b : ℕ) : + (∀ p : ℕ, ord_compl[p] a ∣ ord_compl[p] b) ↔ (a ∣ b) := +begin + refine ⟨λ h, _, λ hab p, ord_compl_dvd_ord_compl_of_dvd hab p⟩, + rcases eq_or_ne b 0 with rfl | hb0, { simp }, + by_cases pa : a.prime, swap, { simpa [pa] using h a }, + by_cases pb : b.prime, swap, { simpa [pb] using h b }, + rw prime_dvd_prime_iff_eq pa pb, + by_contradiction hab, + apply pa.ne_one, + rw [←nat.dvd_one, ←nat.mul_dvd_mul_iff_left hb0.bot_lt, mul_one], + simpa [prime.factorization_self pb, prime.factorization pa, hab] using h b, +end + +lemma dvd_iff_prime_pow_dvd_dvd (n d : ℕ) : + d ∣ n ↔ ∀ p k : ℕ, prime p → p ^ k ∣ d → p ^ k ∣ n := +begin + rcases eq_or_ne n 0 with rfl | hn, { simp }, + rcases eq_or_ne d 0 with rfl | hd, + { simp only [zero_dvd_iff, hn, false_iff, not_forall], + exact ⟨2, n, prime_two, dvd_zero _, mt (le_of_dvd hn.bot_lt) (lt_two_pow n).not_le⟩ }, + refine ⟨λ h p k _ hpkd, dvd_trans hpkd h, _⟩, + rw [←factorization_prime_le_iff_dvd hd hn], + intros h p pp, + simp_rw ←pp.pow_dvd_iff_le_factorization hn, + exact h p _ pp (ord_proj_dvd _ _) +end + +lemma prod_prime_factors_dvd (n : ℕ) : (∏ (p : ℕ) in n.factors.to_finset, p) ∣ n := +begin + by_cases hn : n = 0, { subst hn, simp }, + simpa [prod_factors hn] using multiset.to_finset_prod_dvd_prod (n.factors : multiset ℕ), +end + +lemma factorization_gcd {a b : ℕ} (ha_pos : a ≠ 0) (hb_pos : b ≠ 0) : + (gcd a b).factorization = a.factorization ⊓ b.factorization := +begin + let dfac := a.factorization ⊓ b.factorization, + let d := dfac.prod pow, + have dfac_prime : ∀ (p : ℕ), p ∈ dfac.support → prime p, + { intros p hp, + have : p ∈ a.factors ∧ p ∈ b.factors := by simpa using hp, + exact prime_of_mem_factors this.1 }, + have h1 : d.factorization = dfac := prod_pow_factorization_eq_self dfac_prime, + have hd_pos : d ≠ 0 := (factorization_equiv.inv_fun ⟨dfac, dfac_prime⟩).2.ne.symm, + suffices : d = (gcd a b), { rwa ←this }, + apply gcd_greatest, + { rw [←factorization_le_iff_dvd hd_pos ha_pos, h1], exact inf_le_left }, + { rw [←factorization_le_iff_dvd hd_pos hb_pos, h1], exact inf_le_right }, + { intros e hea heb, + rcases decidable.eq_or_ne e 0 with rfl | he_pos, + { simp only [zero_dvd_iff] at hea, contradiction, }, + have hea' := (factorization_le_iff_dvd he_pos ha_pos).mpr hea, + have heb' := (factorization_le_iff_dvd he_pos hb_pos).mpr heb, + simp [←factorization_le_iff_dvd he_pos hd_pos, h1, hea', heb'] }, +end + +lemma factorization_lcm {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : + (a.lcm b).factorization = a.factorization ⊔ b.factorization := +begin + rw [← add_right_inj (a.gcd b).factorization, + ← factorization_mul (mt gcd_eq_zero_iff.1 $ λ h, ha h.1) (lcm_ne_zero ha hb), + gcd_mul_lcm, factorization_gcd ha hb, factorization_mul ha hb], + ext1, exact (min_add_max _ _).symm, +end + +@[to_additive sum_factors_gcd_add_sum_factors_mul] +lemma prod_factors_gcd_mul_prod_factors_mul {β : Type*} [comm_monoid β] (m n : ℕ) (f : ℕ → β) : + (m.gcd n).factors.to_finset.prod f * (m * n).factors.to_finset.prod f + = m.factors.to_finset.prod f * n.factors.to_finset.prod f := +begin + rcases eq_or_ne n 0 with rfl | hm0, { simp }, + rcases eq_or_ne m 0 with rfl | hn0, { simp }, + rw [←@finset.prod_union_inter _ _ m.factors.to_finset n.factors.to_finset, mul_comm], + congr, + { apply factors_mul_to_finset; assumption }, + { simp only [←support_factorization, factorization_gcd hn0 hm0, finsupp.support_inf] }, +end + +lemma set_of_pow_dvd_eq_Icc_factorization {n p : ℕ} (pp : p.prime) (hn : n ≠ 0) : + {i : ℕ | i ≠ 0 ∧ p ^ i ∣ n} = set.Icc 1 (n.factorization p) := +by { ext, simp [lt_succ_iff, one_le_iff_ne_zero, pp.pow_dvd_iff_le_factorization hn] } + +/-- The set of positive powers of prime `p` that divide `n` is exactly the set of +positive natural numbers up to `n.factorization p`. -/ +lemma Icc_factorization_eq_pow_dvd (n : ℕ) {p : ℕ} (pp : prime p) : + Icc 1 ((n.factorization) p) = (Ico 1 n).filter (λ (i : ℕ), p ^ i ∣ n) := +begin + rcases eq_or_ne n 0 with rfl | hn, { simp }, + ext x, + simp only [mem_Icc, finset.mem_filter, mem_Ico, and_assoc, and.congr_right_iff, + pp.pow_dvd_iff_le_factorization hn, iff_and_self], + exact λ H1 H2, lt_of_le_of_lt H2 (factorization_lt p hn), +end + +lemma factorization_eq_card_pow_dvd (n : ℕ) {p : ℕ} (pp : p.prime) : + n.factorization p = ((Ico 1 n).filter (λ i, p ^ i ∣ n)).card := +by simp [←Icc_factorization_eq_pow_dvd n pp] + +lemma Ico_filter_pow_dvd_eq {n p b : ℕ} (pp : p.prime) (hn : n ≠ 0) (hb : n ≤ p ^ b): + (Ico 1 n).filter (λ i, p ^ i ∣ n) = (Icc 1 b).filter (λ i, p ^ i ∣ n) := +begin + ext x, + simp only [finset.mem_filter, mem_Ico, mem_Icc, and.congr_left_iff, and.congr_right_iff], + rintro h1 -, + simp [lt_of_pow_dvd_right hn pp.two_le h1, + (pow_le_iff_le_right pp.two_le).1 ((le_of_dvd hn.bot_lt h1).trans hb)], +end + +/-! ### Factorization and coprimes -/ + +/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/ +lemma factorization_mul_apply_of_coprime {p a b : ℕ} (hab : coprime a b) : + (a * b).factorization p = a.factorization p + b.factorization p := +by simp only [←factors_count_eq, perm_iff_count.mp (perm_factors_mul_of_coprime hab), count_append] + +/-- For coprime `a` and `b`, the power of `p` in `a * b` is the sum of the powers in `a` and `b` -/ +lemma factorization_mul_of_coprime {a b : ℕ} (hab : coprime a b) : + (a * b).factorization = a.factorization + b.factorization := +begin + ext q, + simp only [finsupp.coe_add, add_apply, ←factors_count_eq, factorization_mul_apply_of_coprime hab], +end + +/-- If `p` is a prime factor of `a` then the power of `p` in `a` is the same that in `a * b`, +for any `b` coprime to `a`. -/ +lemma factorization_eq_of_coprime_left {p a b : ℕ} (hab : coprime a b) (hpa : p ∈ a.factors) : + (a * b).factorization p = a.factorization p := +begin + rw [factorization_mul_apply_of_coprime hab, ←factors_count_eq, ←factors_count_eq], + simpa only [count_eq_zero_of_not_mem (coprime_factors_disjoint hab hpa)], +end + +/-- If `p` is a prime factor of `b` then the power of `p` in `b` is the same that in `a * b`, +for any `a` coprime to `b`. -/ +lemma factorization_eq_of_coprime_right {p a b : ℕ} (hab : coprime a b) (hpb : p ∈ b.factors) : + (a * b).factorization p = b.factorization p := +by { rw mul_comm, exact factorization_eq_of_coprime_left (coprime_comm.mp hab) hpb } + +/-- The prime factorizations of coprime `a` and `b` are disjoint -/ +lemma factorization_disjoint_of_coprime {a b : ℕ} (hab : coprime a b) : + disjoint a.factorization.support b.factorization.support := +by simpa only [support_factorization] + using disjoint_to_finset_iff_disjoint.mpr (coprime_factors_disjoint hab) + +/-- For coprime `a` and `b` the prime factorization `a * b` is the union of those of `a` and `b` -/ +lemma factorization_mul_support_of_coprime {a b : ℕ} (hab : coprime a b) : + (a * b).factorization.support = a.factorization.support ∪ b.factorization.support := +begin + rw factorization_mul_of_coprime hab, + exact support_add_eq (factorization_disjoint_of_coprime hab), +end + +/-! ### Induction principles involving factorizations -/ + +/-- Given `P 0, P 1` and a way to extend `P a` to `P (p ^ n * a)` for prime `p` not dividing `a`, +we can define `P` for all natural numbers. -/ +@[elab_as_eliminator] +def rec_on_prime_pow {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1) + (h : ∀ a p n : ℕ, p.prime → ¬ p ∣ a → 0 < n → P a → P (p ^ n * a)) : ∀ (a : ℕ), P a := +λ a, nat.strong_rec_on a $ λ n, + match n with + | 0 := λ _, h0 + | 1 := λ _, h1 + | (k+2) := λ hk, begin + let p := (k + 2).min_fac, + have hp : prime p := min_fac_prime (succ_succ_ne_one k), + -- the awkward `let` stuff here is because `factorization` is noncomputable (finsupp); + -- we get around this by using the computable `factors.count`, and rewriting when we want + -- to use the `factorization` API + let t := (k+2).factors.count p, + have ht : t = (k+2).factorization p := factors_count_eq, + have hpt : p ^ t ∣ k + 2 := by { rw ht, exact ord_proj_dvd _ _ }, + have htp : 0 < t := + by { rw ht, exact hp.factorization_pos_of_dvd (nat.succ_ne_zero _) (min_fac_dvd _) }, + convert h ((k + 2) / p ^ t) p t hp _ _ _, + { rw nat.mul_div_cancel' hpt, }, + { rw [nat.dvd_div_iff hpt, ←pow_succ', ht], + exact pow_succ_factorization_not_dvd (k + 1).succ_ne_zero hp }, + { exact htp }, + { apply hk _ (nat.div_lt_of_lt_mul _), + simp [lt_mul_iff_one_lt_left nat.succ_pos', one_lt_pow_iff htp.ne, hp.one_lt] }, + end + end + +/-- Given `P 0`, `P 1`, and `P (p ^ n)` for positive prime powers, and a way to extend `P a` and +`P b` to `P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/ +@[elab_as_eliminator] +def rec_on_pos_prime_pos_coprime {P : ℕ → Sort*} (hp : ∀ p n : ℕ, prime p → 0 < n → P (p ^ n)) + (h0 : P 0) (h1 : P 1) (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) : + ∀ a, P a := +rec_on_prime_pow h0 h1 $ +begin + intros a p n hp' hpa hn hPa, + by_cases ha1 : a = 1, + { rw [ha1, mul_one], + exact hp p n hp' hn }, + refine h (p^n) a ((hp'.one_lt).trans_le (le_self_pow hn.ne' _)) _ _ (hp _ _ hp' hn) hPa, + { contrapose! hpa, + simp [lt_one_iff.1 (lt_of_le_of_ne hpa ha1)] }, + simpa [hn, prime.coprime_iff_not_dvd hp'], +end + +/-- Given `P 0`, `P (p ^ n)` for all prime powers, and a way to extend `P a` and `P b` to +`P (a * b)` when `a, b` are positive coprime, we can define `P` for all natural numbers. -/ +@[elab_as_eliminator] +def rec_on_prime_coprime {P : ℕ → Sort*} (h0 : P 0) (hp : ∀ p n : ℕ, prime p → P (p ^ n)) + (h : ∀ a b, 1 < a → 1 < b → coprime a b → P a → P b → P (a * b)) : ∀ a, P a := +rec_on_pos_prime_pos_coprime (λ p n h _, hp p n h) h0 (hp 2 0 prime_two) h + +/-- Given `P 0`, `P 1`, `P p` for all primes, and a way to extend `P a` and `P b` to +`P (a * b)`, we can define `P` for all natural numbers. -/ +@[elab_as_eliminator] +def rec_on_mul {P : ℕ → Sort*} (h0 : P 0) (h1 : P 1) + (hp : ∀ p, prime p → P p) (h : ∀ a b, P a → P b → P (a * b)) : ∀ a, P a := +let hp : ∀ p n : ℕ, prime p → P (p ^ n) := + λ p n hp', match n with + | 0 := h1 + | (n+1) := by exact h _ _ (hp p hp') (_match _) + end in +rec_on_prime_coprime h0 hp $ λ a b _ _ _, h a b + +/-- For any multiplicative function `f` with `f 1 = 1` and any `n ≠ 0`, +we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/ +lemma multiplicative_factorization {β : Type*} [comm_monoid β] (f : ℕ → β) + (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf : f 1 = 1) : + ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) := +begin + apply' nat.rec_on_pos_prime_pos_coprime, + { intros p k hp hk hpk, simp [prime.factorization_pow hp, finsupp.prod_single_index _, hf] }, + { simp }, + { rintros -, rw [factorization_one, hf], simp }, + { intros a b _ _ hab ha hb hab_pos, + rw [h_mult a b hab, ha (left_ne_zero_of_mul hab_pos), hb (right_ne_zero_of_mul hab_pos), + factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint], + convert (factorization_disjoint_of_coprime hab) }, +end + +/-- For any multiplicative function `f` with `f 1 = 1` and `f 0 = 1`, +we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/ +lemma multiplicative_factorization' {β : Type*} [comm_monoid β] (f : ℕ → β) + (h_mult : ∀ x y : ℕ, coprime x y → f (x * y) = f x * f y) (hf0 : f 0 = 1) (hf1 : f 1 = 1) : + ∀ {n : ℕ}, f n = n.factorization.prod (λ p k, f (p ^ k)) := +begin + apply' nat.rec_on_pos_prime_pos_coprime, + { intros p k hp hk, simp only [hp.factorization_pow], rw prod_single_index _, simp [hf1] }, + { simp [hf0] }, + { rw [factorization_one, hf1], simp }, + { intros a b _ _ hab ha hb, + rw [h_mult a b hab, ha, hb, factorization_mul_of_coprime hab, ←prod_add_index_of_disjoint], + convert (factorization_disjoint_of_coprime hab) }, +end + +/-- Two positive naturals are equal if their prime padic valuations are equal -/ +lemma eq_iff_prime_padic_val_nat_eq (a b : ℕ) (ha : a ≠ 0) (hb : b ≠ 0) : + a = b ↔ (∀ p : ℕ, p.prime → padic_val_nat p a = padic_val_nat p b) := +begin + split, + { rintros rfl, simp }, + { intro h, + refine eq_of_factorization_eq ha hb (λ p, _), + by_cases pp : p.prime, + { simp [factorization_def, pp, h p pp] }, + { simp [factorization_eq_zero_of_non_prime, pp] } }, +end + +lemma prod_pow_prime_padic_val_nat (n : nat) (hn : n ≠ 0) (m : nat) (pr : n < m) : + ∏ p in finset.filter nat.prime (finset.range m), p ^ (padic_val_nat p n) = n := +begin + nth_rewrite_rhs 0 ←factorization_prod_pow_eq_self hn, + rw eq_comm, + apply finset.prod_subset_one_on_sdiff, + { exact λ p hp, finset.mem_filter.mpr + ⟨finset.mem_range.mpr (gt_of_gt_of_ge pr (le_of_mem_factorization hp)), + prime_of_mem_factorization hp⟩ }, + { intros p hp, + cases finset.mem_sdiff.mp hp with hp1 hp2, + rw ←factorization_def n (finset.mem_filter.mp hp1).2, + simp [finsupp.not_mem_support_iff.mp hp2] }, + { intros p hp, + simp [factorization_def n (prime_of_mem_factorization hp)] } +end + +/-! ### Lemmas about factorizations of particular functions -/ + +-- TODO: Port lemmas from `data/nat/multiplicity` to here, re-written in terms of `factorization` + +/-- Exactly `n / p` naturals in `[1, n]` are multiples of `p`. -/ +lemma card_multiples (n p : ℕ) : card ((finset.range n).filter (λ e, p ∣ e + 1)) = n / p := +begin + induction n with n hn, { simp }, + simp [nat.succ_div, add_ite, add_zero, finset.range_succ, filter_insert, apply_ite card, + card_insert_of_not_mem, hn], +end + +/-- Exactly `n / p` naturals in `(0, n]` are multiples of `p`. -/ +lemma Ioc_filter_dvd_card_eq_div (n p : ℕ) : + ((Ioc 0 n).filter (λ x, p ∣ x)).card = n / p := +begin + induction n with n IH, { simp }, + -- TODO: Golf away `h1` after Yaël PRs a lemma asserting this + have h1 : Ioc 0 n.succ = insert n.succ (Ioc 0 n), + { rcases n.eq_zero_or_pos with rfl | hn, { simp }, + simp_rw [←Ico_succ_succ, Ico_insert_right (succ_le_succ hn.le), Ico_succ_right] }, + simp [nat.succ_div, add_ite, add_zero, h1, filter_insert, apply_ite card, + card_insert_eq_ite, IH, finset.mem_filter, mem_Ioc, not_le.2 (lt_add_one n)], +end + +end nat diff --git a/src/data/nat/factorization/prime_pow.lean b/src/data/nat/factorization/prime_pow.lean new file mode 100644 index 0000000000000..ab2df778bbb15 --- /dev/null +++ b/src/data/nat/factorization/prime_pow.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2022 Bhavik Mehta. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bhavik Mehta +-/ +import algebra.is_prime_pow +import data.nat.factorization.basic + +/-! +# Prime powers and factorizations + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file deals with factorizations of prime powers. +-/ + +variables {R : Type*} [comm_monoid_with_zero R] (n p : R) (k : ℕ) + +lemma is_prime_pow.min_fac_pow_factorization_eq {n : ℕ} (hn : is_prime_pow n) : + n.min_fac ^ n.factorization n.min_fac = n := +begin + obtain ⟨p, k, hp, hk, rfl⟩ := hn, + rw ←nat.prime_iff at hp, + rw [hp.pow_min_fac hk.ne', hp.factorization_pow, finsupp.single_eq_same], +end + +lemma is_prime_pow_of_min_fac_pow_factorization_eq {n : ℕ} + (h : n.min_fac ^ n.factorization n.min_fac = n) (hn : n ≠ 1) : + is_prime_pow n := +begin + rcases eq_or_ne n 0 with rfl | hn', + { simpa using h }, + refine ⟨_, _, (nat.min_fac_prime hn).prime, _, h⟩, + rw [pos_iff_ne_zero, ←finsupp.mem_support_iff, nat.factor_iff_mem_factorization, + nat.mem_factors_iff_dvd hn' (nat.min_fac_prime hn)], + apply nat.min_fac_dvd +end + +lemma is_prime_pow_iff_min_fac_pow_factorization_eq {n : ℕ} (hn : n ≠ 1) : + is_prime_pow n ↔ n.min_fac ^ n.factorization n.min_fac = n := +⟨λ h, h.min_fac_pow_factorization_eq, λ h, is_prime_pow_of_min_fac_pow_factorization_eq h hn⟩ + +lemma is_prime_pow_iff_factorization_eq_single {n : ℕ} : + is_prime_pow n ↔ ∃ p k : ℕ, 0 < k ∧ n.factorization = finsupp.single p k := +begin + rw is_prime_pow_nat_iff, + refine exists₂_congr (λ p k, _), + split, + { rintros ⟨hp, hk, hn⟩, + exact ⟨hk, by rw [←hn, nat.prime.factorization_pow hp]⟩ }, + { rintros ⟨hk, hn⟩, + have hn0 : n ≠ 0, + { rintro rfl, + simpa only [finsupp.single_eq_zero, eq_comm, nat.factorization_zero, hk.ne'] using hn }, + rw nat.eq_pow_of_factorization_eq_single hn0 hn, + exact ⟨nat.prime_of_mem_factorization + (by simp [hn, hk.ne'] : p ∈ n.factorization.support), hk, rfl⟩ } +end + +lemma is_prime_pow_iff_card_support_factorization_eq_one {n : ℕ} : + is_prime_pow n ↔ n.factorization.support.card = 1 := +by simp_rw [is_prime_pow_iff_factorization_eq_single, finsupp.card_support_eq_one', exists_prop, + pos_iff_ne_zero] + +lemma is_prime_pow.exists_ord_compl_eq_one {n : ℕ} (h : is_prime_pow n) : + ∃ p : ℕ, p.prime ∧ ord_compl[p] n = 1 := +begin + rcases eq_or_ne n 0 with rfl | hn0, { cases not_is_prime_pow_zero h }, + rcases is_prime_pow_iff_factorization_eq_single.mp h with ⟨p, k, hk0, h1⟩, + rcases em' p.prime with pp | pp, + { refine absurd _ hk0.ne', simp [←nat.factorization_eq_zero_of_non_prime n pp, h1] }, + refine ⟨p, pp, _⟩, + refine nat.eq_of_factorization_eq (nat.ord_compl_pos p hn0).ne' (by simp) (λ q, _), + rw [nat.factorization_ord_compl n p, h1], + simp, +end + +lemma exists_ord_compl_eq_one_iff_is_prime_pow {n : ℕ} (hn : n ≠ 1) : + is_prime_pow n ↔ ∃ p : ℕ, p.prime ∧ ord_compl[p] n = 1 := +begin + refine ⟨λ h, is_prime_pow.exists_ord_compl_eq_one h, λ h, _⟩, + rcases h with ⟨p, pp, h⟩, + rw is_prime_pow_nat_iff, + rw [←nat.eq_of_dvd_of_div_eq_one (nat.ord_proj_dvd n p) h] at ⊢ hn, + refine ⟨p, n.factorization p, pp, _, by simp⟩, + contrapose! hn, + simp [le_zero_iff.1 hn], +end + +/-- An equivalent definition for prime powers: `n` is a prime power iff there is a unique prime +dividing it. -/ +lemma is_prime_pow_iff_unique_prime_dvd {n : ℕ} : + is_prime_pow n ↔ ∃! p : ℕ, p.prime ∧ p ∣ n := +begin + rw is_prime_pow_nat_iff, + split, + { rintro ⟨p, k, hp, hk, rfl⟩, + refine ⟨p, ⟨hp, dvd_pow_self _ hk.ne'⟩, _⟩, + rintro q ⟨hq, hq'⟩, + exact (nat.prime_dvd_prime_iff_eq hq hp).1 (hq.dvd_of_dvd_pow hq') }, + rintro ⟨p, ⟨hp, hn⟩, hq⟩, + rcases eq_or_ne n 0 with rfl | hn₀, + { cases (hq 2 ⟨nat.prime_two, dvd_zero 2⟩).trans (hq 3 ⟨nat.prime_three, dvd_zero 3⟩).symm }, + refine ⟨p, n.factorization p, hp, hp.factorization_pos_of_dvd hn₀ hn, _⟩, + simp only [and_imp] at hq, + apply nat.dvd_antisymm (nat.ord_proj_dvd _ _), + -- We need to show n ∣ p ^ n.factorization p + apply nat.dvd_of_factors_subperm hn₀, + rw [hp.factors_pow, list.subperm_ext_iff], + intros q hq', + rw nat.mem_factors hn₀ at hq', + cases hq _ hq'.1 hq'.2, + simp, +end + +lemma is_prime_pow_pow_iff {n k : ℕ} (hk : k ≠ 0) : + is_prime_pow (n ^ k) ↔ is_prime_pow n := +begin + simp only [is_prime_pow_iff_unique_prime_dvd], + apply exists_unique_congr, + simp only [and.congr_right_iff], + intros p hp, + exact ⟨hp.dvd_of_dvd_pow, λ t, t.trans (dvd_pow_self _ hk)⟩, +end + +lemma nat.coprime.is_prime_pow_dvd_mul {n a b : ℕ} (hab : nat.coprime a b) (hn : is_prime_pow n) : + n ∣ a * b ↔ n ∣ a ∨ n ∣ b := +begin + rcases eq_or_ne a 0 with rfl | ha, + { simp only [nat.coprime_zero_left] at hab, + simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, + rcases eq_or_ne b 0 with rfl | hb, + { simp only [nat.coprime_zero_right] at hab, + simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, + refine ⟨_, λ h, or.elim h (λ i, i.trans (dvd_mul_right _ _)) (λ i, i.trans (dvd_mul_left _ _))⟩, + obtain ⟨p, k, hp, hk, rfl⟩ := (is_prime_pow_nat_iff _).1 hn, + simp only [hp.pow_dvd_iff_le_factorization (mul_ne_zero ha hb), + nat.factorization_mul ha hb, hp.pow_dvd_iff_le_factorization ha, + hp.pow_dvd_iff_le_factorization hb, pi.add_apply, finsupp.coe_add], + have : a.factorization p = 0 ∨ b.factorization p = 0, + { rw [←finsupp.not_mem_support_iff, ←finsupp.not_mem_support_iff, ←not_and_distrib, + ←finset.mem_inter], + exact λ t, (nat.factorization_disjoint_of_coprime hab).le_bot t }, + cases this; + simp [this, imp_or_distrib], +end + +lemma nat.mul_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) : + (a * b).divisors.filter is_prime_pow = (a.divisors ∪ b.divisors).filter is_prime_pow := +begin + rcases eq_or_ne a 0 with rfl | ha, + { simp only [nat.coprime_zero_left] at hab, + simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, + rcases eq_or_ne b 0 with rfl | hb, + { simp only [nat.coprime_zero_right] at hab, + simp [hab, finset.filter_singleton, not_is_prime_pow_one] }, + ext n, + simp only [ha, hb, finset.mem_union, finset.mem_filter, nat.mul_eq_zero, and_true, ne.def, + and.congr_left_iff, not_false_iff, nat.mem_divisors, or_self], + apply hab.is_prime_pow_dvd_mul, +end diff --git a/src/data/nat/factors.lean b/src/data/nat/factors.lean new file mode 100644 index 0000000000000..6d880604fac04 --- /dev/null +++ b/src/data/nat/factors.lean @@ -0,0 +1,289 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ +import data.nat.prime +import data.list.prime +import data.list.sort +import tactic.nth_rewrite + +/-! +# Prime numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file deals with the factors of natural numbers. + +## Important declarations + +- `nat.factors n`: the prime factorization of `n` +- `nat.factors_unique`: uniqueness of the prime factorisation + +-/ + +open bool subtype +open_locale nat + +namespace nat + +/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/ +def factors : ℕ → list ℕ +| 0 := [] +| 1 := [] +| n@(k+2) := + let m := min_fac n in have n / m < n := factors_lemma, + m :: factors (n / m) + +@[simp] lemma factors_zero : factors 0 = [] := by rw factors +@[simp] lemma factors_one : factors 1 = [] := by rw factors + +lemma prime_of_mem_factors : ∀ {n p}, p ∈ factors n → prime p +| 0 := by simp +| 1 := by simp +| n@(k+2) := λ p h, + let m := min_fac n in have n / m < n := factors_lemma, + have h₁ : p = m ∨ p ∈ (factors (n / m)) := + (list.mem_cons_iff _ _ _).1 (by rwa [factors] at h), + or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial) + prime_of_mem_factors + +lemma pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p := +prime.pos (prime_of_mem_factors h) + +lemma prod_factors : ∀ {n}, n ≠ 0 → list.prod (factors n) = n +| 0 := by simp +| 1 := by simp +| n@(k+2) := λ h, + let m := min_fac n in have n / m < n := factors_lemma, + show (factors n).prod = n, from + have h₁ : n / m ≠ 0 := λ h, + have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h, + by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this, + by rw [factors, list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)] + +lemma factors_prime {p : ℕ} (hp : nat.prime p) : p.factors = [p] := +begin + have : p = (p - 2) + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl, + rw [this, nat.factors], + simp only [eq.symm this], + have : nat.min_fac p = p := (nat.prime_def_min_fac.mp hp).2, + split, + { exact this, }, + { simp only [this, nat.factors, nat.div_self (nat.prime.pos hp)], }, +end + +lemma factors_chain : ∀ {n a}, (∀ p, prime p → p ∣ n → a ≤ p) → list.chain (≤) a (factors n) +| 0 := λ a h, by simp +| 1 := λ a h, by simp +| n@(k+2) := λ a h, + let m := min_fac n in have n / m < n := factors_lemma, + begin + rw factors, + refine list.chain.cons ((le_min_fac.2 h).resolve_left dec_trivial) (factors_chain _), + exact λ p pp d, min_fac_le_of_dvd pp.two_le (d.trans $ div_dvd_of_dvd $ min_fac_dvd _), + end + +lemma factors_chain_2 (n) : list.chain (≤) 2 (factors n) := factors_chain $ λ p pp _, pp.two_le + +lemma factors_chain' (n) : list.chain' (≤) (factors n) := +@list.chain'.tail _ _ (_::_) (factors_chain_2 _) + +lemma factors_sorted (n : ℕ) : list.sorted (≤) (factors n) := +list.chain'_iff_pairwise.1 (factors_chain' _) + +/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/ +lemma factors_add_two (n : ℕ) : + factors (n+2) = min_fac (n+2) :: factors ((n+2) / min_fac (n+2)) := +by rw factors + +@[simp] +lemma factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 := +begin + split; intro h, + { rcases n with (_ | _ | n), + { exact or.inl rfl }, + { exact or.inr rfl }, + { rw factors at h, injection h }, }, + { rcases h with (rfl | rfl), + { exact factors_zero }, + { exact factors_one }, } +end + +lemma eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) : a = b := +by simpa [prod_factors ha, prod_factors hb] using list.perm.prod_eq h + +section +open list + +lemma mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : prime p) : p ∈ factors n ↔ p ∣ n := +⟨λ h, prod_factors hn ▸ list.dvd_prod h, + λ h, mem_list_primes_of_dvd_prod + (prime_iff.mp hp) + (λ p h, prime_iff.mp (prime_of_mem_factors h)) + ((prod_factors hn).symm ▸ h)⟩ + +lemma dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n := +begin + rcases n.eq_zero_or_pos with rfl | hn, + { exact dvd_zero p }, + { rwa ←mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h) } +end + +lemma mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ prime p ∧ p ∣ n := +⟨λ h, ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩, + λ ⟨hprime, hdvd⟩, (mem_factors_iff_dvd hn hprime).mpr hdvd⟩ + +lemma le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n := +begin + rcases n.eq_zero_or_pos with rfl | hn, + { rw factors_zero at h, cases h }, + { exact le_of_dvd hn (dvd_of_mem_factors h) }, +end + +/-- **Fundamental theorem of arithmetic**-/ +lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) : + l ~ factors n := +begin + refine perm_of_prod_eq_prod _ _ _, + { rw h₁, + refine (prod_factors _).symm, + rintro rfl, + rw prod_eq_zero_iff at h₁, + exact prime.ne_zero (h₂ 0 h₁) rfl }, + { simp_rw ←prime_iff, exact h₂ }, + { simp_rw ←prime_iff, exact (λ p, prime_of_mem_factors) }, +end + +lemma prime.factors_pow {p : ℕ} (hp : p.prime) (n : ℕ) : + (p ^ n).factors = list.replicate n p := +begin + symmetry, + rw ← list.replicate_perm, + apply nat.factors_unique (list.prod_replicate n p), + intros q hq, + rwa eq_of_mem_replicate hq, +end + +lemma eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0) + (h : ∀ {d}, nat.prime d → d ∣ n → d = p) : + n = p ^ n.factors.length := +begin + set k := n.factors.length, + rw [← prod_factors hpos, ← prod_replicate k p, + eq_replicate_of_mem (λ d hd, h (prime_of_mem_factors hd) (dvd_of_mem_factors hd))], +end + +/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/ +lemma perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : + (a * b).factors ~ a.factors ++ b.factors := +begin + refine (factors_unique _ _).symm, + { rw [list.prod_append, prod_factors ha, prod_factors hb] }, + { intros p hp, + rw list.mem_append at hp, + cases hp; + exact prime_of_mem_factors hp }, +end + +/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/ +lemma perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) : + (a * b).factors ~ a.factors ++ b.factors := +begin + rcases a.eq_zero_or_pos with rfl | ha, + { simp [(coprime_zero_left _).mp hab] }, + rcases b.eq_zero_or_pos with rfl | hb, + { simp [(coprime_zero_right _).mp hab] }, + exact perm_factors_mul ha.ne' hb.ne', +end + +lemma factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors := +begin + cases n, + { rw zero_mul }, + apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _), + rw (perm_factors_mul n.succ_ne_zero h).subperm_left, + exact (sublist_append_left _ _).subperm, +end + +lemma factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors := +begin + obtain ⟨a, rfl⟩ := h, + exact factors_sublist_right (right_ne_zero_of_mul h'), +end + +lemma factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors := +(factors_sublist_right h).subset + +lemma factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors := +(factors_sublist_of_dvd h h').subset + +lemma dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b := +begin + rcases b.eq_zero_or_pos with rfl | hb, + { exact dvd_zero _ }, + rcases a with (_|_|a), + { exact (ha rfl).elim }, + { exact one_dvd _ }, + use (b.factors.diff a.succ.succ.factors).prod, + nth_rewrite 0 ←nat.prod_factors ha, + rw [←list.prod_append, + list.perm.prod_eq $ list.subperm_append_diff_self_of_count_le $ list.subperm_ext_iff.mp h, + nat.prod_factors hb.ne'] +end + +end + +lemma mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} : + p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors := +begin + rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ←and_or_distrib_left], + simpa only [and.congr_right_iff] using prime.dvd_mul +end + +/-- The sets of factors of coprime `a` and `b` are disjoint -/ +lemma coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) : list.disjoint a.factors b.factors := +begin + intros q hqa hqb, + apply not_prime_one, + rw ←(eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)), + exact prime_of_mem_factors hqa +end + +lemma mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ): + p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors := +begin + rcases a.eq_zero_or_pos with rfl | ha, + { simp [(coprime_zero_left _).mp hab] }, + rcases b.eq_zero_or_pos with rfl | hb, + { simp [(coprime_zero_right _).mp hab] }, + rw [mem_factors_mul ha.ne' hb.ne', list.mem_union] +end + +open list + +/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/ +lemma mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a*b).factors := +begin + rcases eq_or_ne a 0 with rfl | ha, + { simpa using hpa }, + apply (mem_factors_mul ha hb).2 (or.inl hpa), +end + +/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/ +lemma mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) : p ∈ (a*b).factors := +by { rw mul_comm, exact mem_factors_mul_left hpb ha } + +lemma eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) : + (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, nat.prime p ∧ p ∣ n ∧ odd p := +(eq_or_ne n 0).elim + (λ hn, (or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩)) + (λ hn, or_iff_not_imp_right.mpr + (λ H, ⟨n.factors.length, eq_prime_pow_of_unique_prime_dvd hn + (λ p hprime hdvd, hprime.eq_two_or_odd'.resolve_right + (λ hodd, H ⟨p, hprime, hdvd, hodd⟩))⟩)) + +end nat + +assert_not_exists multiset diff --git a/src/data/nat/fib.lean b/src/data/nat/fib.lean index 6f8ba43ef369d..9c562beb94455 100644 --- a/src/data/nat/fib.lean +++ b/src/data/nat/fib.lean @@ -3,16 +3,20 @@ Copyright (c) 2019 Kevin Kappelmann. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Kevin Kappelmann, Kyle Miller, Mario Carneiro -/ -import data.nat.gcd +import data.nat.gcd.basic import logic.function.iterate import data.finset.nat_antidiagonal import algebra.big_operators.basic import tactic.ring import tactic.zify +import tactic.wlog /-! # The Fibonacci Sequence +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Summary Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`. @@ -77,7 +81,7 @@ by rw [fib_add_two, add_tsub_cancel_right] lemma fib_lt_fib_succ {n : ℕ} (hn : 2 ≤ n) : fib n < fib (n + 1) := begin - rcases le_iff_exists_add.1 hn with ⟨n, rfl⟩, + rcases exists_add_of_le hn with ⟨n, rfl⟩, rw [← tsub_pos_iff_lt, add_comm 2, fib_add_two_sub_fib_add_one], apply fib_pos (succ_pos n), end @@ -218,15 +222,13 @@ lemma gcd_fib_add_mul_self (m n : ℕ) : ∀ k, gcd (fib m) (fib (n + k * m)) = see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/ lemma fib_gcd (m n : ℕ) : fib (gcd m n) = gcd (fib m) (fib n) := begin - wlog h : m ≤ n using [n m, m n], - exact le_total m n, - { apply gcd.induction m n, - { simp }, - intros m n mpos h, - rw ← gcd_rec m n at h, - conv_rhs { rw ← mod_add_div' n m }, - rwa [gcd_fib_add_mul_self m (n % m) (n / m), gcd_comm (fib m) _] }, - rwa [gcd_comm, gcd_comm (fib m)] + wlog h : m ≤ n, { simpa only [gcd_comm] using this _ _ (le_of_not_le h) }, + apply gcd.induction m n, + { simp }, + intros m n mpos h, + rw ← gcd_rec m n at h, + conv_rhs { rw ← mod_add_div' n m }, + rwa [gcd_fib_add_mul_self m (n % m) (n / m), gcd_comm (fib m) _] end lemma fib_dvd (m n : ℕ) (h : m ∣ n) : fib m ∣ fib n := diff --git a/src/data/nat/gcd.lean b/src/data/nat/gcd.lean deleted file mode 100644 index 9cedc4bc7a558..0000000000000 --- a/src/data/nat/gcd.lean +++ /dev/null @@ -1,590 +0,0 @@ -/- -Copyright (c) 2014 Jeremy Avigad. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jeremy Avigad, Leonardo de Moura --/ -import algebra.group_power.order -import algebra.big_operators.basic - -/-! -# Definitions and properties of `gcd`, `lcm`, and `coprime` - --/ - -namespace nat - -/-! ### `gcd` -/ - -theorem gcd_dvd (m n : ℕ) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := -gcd.induction m n - (λn, by rw gcd_zero_left; exact ⟨dvd_zero n, dvd_refl n⟩) - (λm n npos, by rw ←gcd_rec; exact λ ⟨IH₁, IH₂⟩, ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩) - -theorem gcd_dvd_left (m n : ℕ) : gcd m n ∣ m := (gcd_dvd m n).left - -theorem gcd_dvd_right (m n : ℕ) : gcd m n ∣ n := (gcd_dvd m n).right - -theorem gcd_le_left {m} (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h $ gcd_dvd_left m n - -theorem gcd_le_right (m) {n} (h : 0 < n) : gcd m n ≤ n := le_of_dvd h $ gcd_dvd_right m n - -theorem dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n := -gcd.induction m n (λn _ kn, by rw gcd_zero_left; exact kn) - (λn m mpos IH H1 H2, by rw gcd_rec; exact IH ((dvd_mod_iff H1).2 H2) H1) - -theorem dvd_gcd_iff {m n k : ℕ} : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n := -iff.intro (λ h, ⟨h.trans (gcd_dvd m n).left, h.trans (gcd_dvd m n).right⟩) - (λ h, dvd_gcd h.left h.right) - -theorem gcd_comm (m n : ℕ) : gcd m n = gcd n m := -dvd_antisymm - (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n)) - (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m)) - -theorem gcd_eq_left_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd m n = m := -⟨λ h, by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left], - λ h, h ▸ gcd_dvd_right m n⟩ - -theorem gcd_eq_right_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd n m = m := -by rw gcd_comm; apply gcd_eq_left_iff_dvd - -theorem gcd_assoc (m n k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) := -dvd_antisymm - (dvd_gcd - ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n)) - (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n)) - (gcd_dvd_right (gcd m n) k))) - (dvd_gcd - (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k))) - ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k))) - -@[simp] theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 := -eq.trans (gcd_comm n 1) $ gcd_one_left n - -theorem gcd_mul_left (m n k : ℕ) : gcd (m * n) (m * k) = m * gcd n k := -gcd.induction n k - (λk, by repeat {rw mul_zero <|> rw gcd_zero_left}) - (λk n H IH, by rwa [←mul_mod_mul_left, ←gcd_rec, ←gcd_rec] at IH) - -theorem gcd_mul_right (m n k : ℕ) : gcd (m * n) (k * n) = gcd m k * n := -by rw [mul_comm m n, mul_comm k n, mul_comm (gcd m k) n, gcd_mul_left] - -theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : 0 < m) : 0 < gcd m n := -pos_of_dvd_of_pos (gcd_dvd_left m n) mpos - -theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : 0 < n) : 0 < gcd m n := -pos_of_dvd_of_pos (gcd_dvd_right m n) npos - -theorem eq_zero_of_gcd_eq_zero_left {m n : ℕ} (H : gcd m n = 0) : m = 0 := -or.elim (nat.eq_zero_or_pos m) id - (assume H1 : 0 < m, absurd (eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1))) - -theorem eq_zero_of_gcd_eq_zero_right {m n : ℕ} (H : gcd m n = 0) : n = 0 := -by rw gcd_comm at H; exact eq_zero_of_gcd_eq_zero_left H - -@[simp] theorem gcd_eq_zero_iff {i j : ℕ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := -begin - split, - { intro h, - exact ⟨eq_zero_of_gcd_eq_zero_left h, eq_zero_of_gcd_eq_zero_right h⟩, }, - { rintro ⟨rfl, rfl⟩, - exact nat.gcd_zero_right 0 } -end - -theorem gcd_div {m n k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) : - gcd (m / k) (n / k) = gcd m n / k := -or.elim (nat.eq_zero_or_pos k) - (λk0, by rw [k0, nat.div_zero, nat.div_zero, nat.div_zero, gcd_zero_right]) - (λH3, nat.eq_of_mul_eq_mul_right H3 $ by rw [ - nat.div_mul_cancel (dvd_gcd H1 H2), ←gcd_mul_right, - nat.div_mul_cancel H1, nat.div_mul_cancel H2]) - -theorem gcd_greatest {a b d : ℕ} (hda : d ∣ a) (hdb : d ∣ b) - (hd : ∀ e : ℕ, e ∣ a → e ∣ b → e ∣ d) : d = a.gcd b := -(dvd_antisymm (hd _ (gcd_dvd_left a b) (gcd_dvd_right a b)) (dvd_gcd hda hdb)).symm - -theorem gcd_dvd_gcd_of_dvd_left {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd m n ∣ gcd k n := -dvd_gcd ((gcd_dvd_left m n).trans H) (gcd_dvd_right m n) - -theorem gcd_dvd_gcd_of_dvd_right {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd n m ∣ gcd n k := -dvd_gcd (gcd_dvd_left n m) ((gcd_dvd_right n m).trans H) - -theorem gcd_dvd_gcd_mul_left (m n k : ℕ) : gcd m n ∣ gcd (k * m) n := -gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _) - -theorem gcd_dvd_gcd_mul_right (m n k : ℕ) : gcd m n ∣ gcd (m * k) n := -gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _) - -theorem gcd_dvd_gcd_mul_left_right (m n k : ℕ) : gcd m n ∣ gcd m (k * n) := -gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _) - -theorem gcd_dvd_gcd_mul_right_right (m n k : ℕ) : gcd m n ∣ gcd m (n * k) := -gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _) - -theorem gcd_eq_left {m n : ℕ} (H : m ∣ n) : gcd m n = m := -dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd dvd_rfl H) - -theorem gcd_eq_right {m n : ℕ} (H : n ∣ m) : gcd m n = n := -by rw [gcd_comm, gcd_eq_left H] - --- Lemmas where one argument is a multiple of the other - -@[simp] lemma gcd_mul_left_left (m n : ℕ) : gcd (m * n) n = n := -dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (dvd_mul_left _ _) dvd_rfl) - -@[simp] lemma gcd_mul_left_right (m n : ℕ) : gcd n (m * n) = n := -by rw [gcd_comm, gcd_mul_left_left] - -@[simp] lemma gcd_mul_right_left (m n : ℕ) : gcd (n * m) n = n := -by rw [mul_comm, gcd_mul_left_left] - -@[simp] lemma gcd_mul_right_right (m n : ℕ) : gcd n (n * m) = n := -by rw [gcd_comm, gcd_mul_right_left] - --- Lemmas for repeated application of `gcd` - -@[simp] lemma gcd_gcd_self_right_left (m n : ℕ) : gcd m (gcd m n) = gcd m n := -dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (gcd_dvd_left _ _) dvd_rfl) - -@[simp] lemma gcd_gcd_self_right_right (m n : ℕ) : gcd m (gcd n m) = gcd n m := -by rw [gcd_comm n m, gcd_gcd_self_right_left] - -@[simp] lemma gcd_gcd_self_left_right (m n : ℕ) : gcd (gcd n m) m = gcd n m := -by rw [gcd_comm, gcd_gcd_self_right_right] - -@[simp] lemma gcd_gcd_self_left_left (m n : ℕ) : gcd (gcd m n) m = gcd m n := -by rw [gcd_comm m n, gcd_gcd_self_left_right] - --- Lemmas where one argument consists of addition of a multiple of the other - -@[simp] lemma gcd_add_mul_right_right (m n k : ℕ) : gcd m (n + k * m) = gcd m n := -by simp [gcd_rec m (n + k * m), gcd_rec m n] - -@[simp] lemma gcd_add_mul_left_right (m n k : ℕ) : gcd m (n + m * k) = gcd m n := -by simp [gcd_rec m (n + m * k), gcd_rec m n] - -@[simp] lemma gcd_mul_right_add_right (m n k : ℕ) : gcd m (k * m + n) = gcd m n := -by simp [add_comm _ n] - -@[simp] lemma gcd_mul_left_add_right (m n k : ℕ) : gcd m (m * k + n) = gcd m n := -by simp [add_comm _ n] - -@[simp] lemma gcd_add_mul_right_left (m n k : ℕ) : gcd (m + k * n) n = gcd m n := -by rw [gcd_comm, gcd_add_mul_right_right, gcd_comm] - -@[simp] lemma gcd_add_mul_left_left (m n k : ℕ) : gcd (m + n * k) n = gcd m n := -by rw [gcd_comm, gcd_add_mul_left_right, gcd_comm] - -@[simp] lemma gcd_mul_right_add_left (m n k : ℕ) : gcd (k * n + m) n = gcd m n := -by rw [gcd_comm, gcd_mul_right_add_right, gcd_comm] - -@[simp] lemma gcd_mul_left_add_left (m n k : ℕ) : gcd (n * k + m) n = gcd m n := -by rw [gcd_comm, gcd_mul_left_add_right, gcd_comm] - --- Lemmas where one argument consists of an addition of the other - -@[simp] lemma gcd_add_self_right (m n : ℕ) : gcd m (n + m) = gcd m n := -eq.trans (by rw one_mul) (gcd_add_mul_right_right m n 1) - -@[simp] lemma gcd_add_self_left (m n : ℕ) : gcd (m + n) n = gcd m n := -by rw [gcd_comm, gcd_add_self_right, gcd_comm] - -@[simp] lemma gcd_self_add_left (m n : ℕ) : gcd (m + n) m = gcd n m := -by rw [add_comm, gcd_add_self_left] - -@[simp] lemma gcd_self_add_right (m n : ℕ) : gcd m (m + n) = gcd m n := -by rw [add_comm, gcd_add_self_right] - -/-! ### `lcm` -/ - -theorem lcm_comm (m n : ℕ) : lcm m n = lcm n m := -by delta lcm; rw [mul_comm, gcd_comm] - -@[simp] -theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 := -by delta lcm; rw [zero_mul, nat.zero_div] - -@[simp] -theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 := lcm_comm 0 m ▸ lcm_zero_left m - -@[simp] -theorem lcm_one_left (m : ℕ) : lcm 1 m = m := -by delta lcm; rw [one_mul, gcd_one_left, nat.div_one] - -@[simp] -theorem lcm_one_right (m : ℕ) : lcm m 1 = m := lcm_comm 1 m ▸ lcm_one_left m - -@[simp] -theorem lcm_self (m : ℕ) : lcm m m = m := -or.elim (nat.eq_zero_or_pos m) - (λh, by rw [h, lcm_zero_left]) - (λh, by delta lcm; rw [gcd_self, nat.mul_div_cancel _ h]) - -theorem dvd_lcm_left (m n : ℕ) : m ∣ lcm m n := -dvd.intro (n / gcd m n) (nat.mul_div_assoc _ $ gcd_dvd_right m n).symm - -theorem dvd_lcm_right (m n : ℕ) : n ∣ lcm m n := -lcm_comm n m ▸ dvd_lcm_left n m - -theorem gcd_mul_lcm (m n : ℕ) : gcd m n * lcm m n = m * n := -by delta lcm; rw [nat.mul_div_cancel' ((gcd_dvd_left m n).trans (dvd_mul_right m n))] - -theorem lcm_dvd {m n k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k := -or.elim (nat.eq_zero_or_pos k) - (λh, by rw h; exact dvd_zero _) - (λkpos, dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) $ - by rw [gcd_mul_lcm, ←gcd_mul_right, mul_comm n k]; - exact dvd_gcd (mul_dvd_mul_left _ H2) (mul_dvd_mul_right H1 _)) - -theorem lcm_dvd_mul (m n : ℕ) : lcm m n ∣ m * n := -lcm_dvd (dvd_mul_right _ _) (dvd_mul_left _ _) - -lemma lcm_dvd_iff {m n k : ℕ} : lcm m n ∣ k ↔ m ∣ k ∧ n ∣ k := -⟨λ h, ⟨(dvd_lcm_left _ _).trans h, (dvd_lcm_right _ _).trans h⟩, - and_imp.2 lcm_dvd⟩ - -theorem lcm_assoc (m n k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) := -dvd_antisymm - (lcm_dvd - (lcm_dvd (dvd_lcm_left m (lcm n k)) ((dvd_lcm_left n k).trans (dvd_lcm_right m (lcm n k)))) - ((dvd_lcm_right n k).trans (dvd_lcm_right m (lcm n k)))) - (lcm_dvd - ((dvd_lcm_left m n).trans (dvd_lcm_left (lcm m n) k)) - (lcm_dvd ((dvd_lcm_right m n).trans (dvd_lcm_left (lcm m n) k)) - (dvd_lcm_right (lcm m n) k))) - -theorem lcm_ne_zero {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := -by { intro h, simpa [h, hm, hn] using gcd_mul_lcm m n, } - -/-! -### `coprime` - -See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.coprime m n`. --/ - -instance (m n : ℕ) : decidable (coprime m n) := by unfold coprime; apply_instance - -theorem coprime_iff_gcd_eq_one {m n : ℕ} : coprime m n ↔ gcd m n = 1 := iff.rfl - -theorem coprime.gcd_eq_one {m n : ℕ} (h : coprime m n) : gcd m n = 1 := h - -theorem coprime.lcm_eq_mul {m n : ℕ} (h : coprime m n) : lcm m n = m * n := -by rw [←one_mul (lcm m n), ←h.gcd_eq_one, gcd_mul_lcm] - -theorem coprime.symm {m n : ℕ} : coprime n m → coprime m n := (gcd_comm m n).trans - -theorem coprime_comm {m n : ℕ} : coprime n m ↔ coprime m n := ⟨coprime.symm, coprime.symm⟩ - -theorem coprime.dvd_of_dvd_mul_right {m n k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m := -let t := dvd_gcd (dvd_mul_left k m) H2 in -by rwa [gcd_mul_left, H1.gcd_eq_one, mul_one] at t - -theorem coprime.dvd_of_dvd_mul_left {m n k : ℕ} (H1 : coprime k m) (H2 : k ∣ m * n) : k ∣ n := -by rw mul_comm at H2; exact H1.dvd_of_dvd_mul_right H2 - -theorem coprime.dvd_mul_right {m n k : ℕ} (H : coprime k n) : k ∣ m * n ↔ k ∣ m := -⟨H.dvd_of_dvd_mul_right, λ h, dvd_mul_of_dvd_left h n⟩ - -theorem coprime.dvd_mul_left {m n k : ℕ} (H : coprime k m) : k ∣ m * n ↔ k ∣ n := -⟨H.dvd_of_dvd_mul_left, λ h, dvd_mul_of_dvd_right h m⟩ - -theorem coprime.gcd_mul_left_cancel {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) : - gcd (k * m) n = gcd m n := -have H1 : coprime (gcd (k * m) n) k, -by rw [coprime, gcd_assoc, H.symm.gcd_eq_one, gcd_one_right], -dvd_antisymm - (dvd_gcd (H1.dvd_of_dvd_mul_left (gcd_dvd_left _ _)) (gcd_dvd_right _ _)) - (gcd_dvd_gcd_mul_left _ _ _) - -theorem coprime.gcd_mul_right_cancel (m : ℕ) {k n : ℕ} (H : coprime k n) : - gcd (m * k) n = gcd m n := -by rw [mul_comm m k, H.gcd_mul_left_cancel m] - -theorem coprime.gcd_mul_left_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) : - gcd m (k * n) = gcd m n := -by rw [gcd_comm m n, gcd_comm m (k * n), H.gcd_mul_left_cancel n] - -theorem coprime.gcd_mul_right_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) : - gcd m (n * k) = gcd m n := -by rw [mul_comm n k, H.gcd_mul_left_cancel_right n] - -theorem coprime_div_gcd_div_gcd {m n : ℕ} (H : 0 < gcd m n) : - coprime (m / gcd m n) (n / gcd m n) := -by rw [coprime_iff_gcd_eq_one, gcd_div (gcd_dvd_left m n) (gcd_dvd_right m n), nat.div_self H] - -theorem not_coprime_of_dvd_of_dvd {m n d : ℕ} (dgt1 : 1 < d) (Hm : d ∣ m) (Hn : d ∣ n) : - ¬ coprime m n := -λ co, not_lt_of_ge (le_of_dvd zero_lt_one $ by rw [←co.gcd_eq_one]; exact dvd_gcd Hm Hn) dgt1 - -theorem exists_coprime {m n : ℕ} (H : 0 < gcd m n) : - ∃ m' n', coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n := -⟨_, _, coprime_div_gcd_div_gcd H, - (nat.div_mul_cancel (gcd_dvd_left m n)).symm, - (nat.div_mul_cancel (gcd_dvd_right m n)).symm⟩ - -theorem exists_coprime' {m n : ℕ} (H : 0 < gcd m n) : - ∃ g m' n', 0 < g ∧ coprime m' n' ∧ m = m' * g ∧ n = n' * g := -let ⟨m', n', h⟩ := exists_coprime H in ⟨_, m', n', H, h⟩ - -@[simp] theorem coprime_add_self_right {m n : ℕ} : coprime m (n + m) ↔ coprime m n := -by rw [coprime, coprime, gcd_add_self_right] - -@[simp] theorem coprime_self_add_right {m n : ℕ} : coprime m (m + n) ↔ coprime m n := -by rw [add_comm, coprime_add_self_right] - -@[simp] theorem coprime_add_self_left {m n : ℕ} : coprime (m + n) n ↔ coprime m n := -by rw [coprime, coprime, gcd_add_self_left] - -@[simp] theorem coprime_self_add_left {m n : ℕ} : coprime (m + n) m ↔ coprime n m := -by rw [coprime, coprime, gcd_self_add_left] - -@[simp] lemma coprime_add_mul_right_right (m n k : ℕ) : coprime m (n + k * m) ↔ coprime m n := -by rw [coprime, coprime, gcd_add_mul_right_right] - -@[simp] lemma coprime_add_mul_left_right (m n k : ℕ) : coprime m (n + m * k) ↔ coprime m n := -by rw [coprime, coprime, gcd_add_mul_left_right] - -@[simp] lemma coprime_mul_right_add_right (m n k : ℕ) : coprime m (k * m + n) ↔ coprime m n := -by rw [coprime, coprime, gcd_mul_right_add_right] - -@[simp] lemma coprime_mul_left_add_right (m n k : ℕ) : coprime m (m * k + n) ↔ coprime m n := -by rw [coprime, coprime, gcd_mul_left_add_right] - -@[simp] lemma coprime_add_mul_right_left (m n k : ℕ) : coprime (m + k * n) n ↔ coprime m n := -by rw [coprime, coprime, gcd_add_mul_right_left] - -@[simp] lemma coprime_add_mul_left_left (m n k : ℕ) : coprime (m + n * k) n ↔ coprime m n := -by rw [coprime, coprime, gcd_add_mul_left_left] - -@[simp] lemma coprime_mul_right_add_left (m n k : ℕ) : coprime (k * n + m) n ↔ coprime m n := -by rw [coprime, coprime, gcd_mul_right_add_left] - -@[simp] lemma coprime_mul_left_add_left (m n k : ℕ) : coprime (n * k + m) n ↔ coprime m n := -by rw [coprime, coprime, gcd_mul_left_add_left] - -theorem coprime.mul {m n k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k := -(H1.gcd_mul_left_cancel n).trans H2 - -theorem coprime.mul_right {k m n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) := -(H1.symm.mul H2.symm).symm - -theorem coprime.coprime_dvd_left {m k n : ℕ} (H1 : m ∣ k) (H2 : coprime k n) : coprime m n := -eq_one_of_dvd_one (by delta coprime at H2; rw ← H2; exact gcd_dvd_gcd_of_dvd_left _ H1) - -theorem coprime.coprime_dvd_right {m k n : ℕ} (H1 : n ∣ m) (H2 : coprime k m) : coprime k n := -(H2.symm.coprime_dvd_left H1).symm - -theorem coprime.coprime_mul_left {k m n : ℕ} (H : coprime (k * m) n) : coprime m n := -H.coprime_dvd_left (dvd_mul_left _ _) - -theorem coprime.coprime_mul_right {k m n : ℕ} (H : coprime (m * k) n) : coprime m n := -H.coprime_dvd_left (dvd_mul_right _ _) - -theorem coprime.coprime_mul_left_right {k m n : ℕ} (H : coprime m (k * n)) : coprime m n := -H.coprime_dvd_right (dvd_mul_left _ _) - -theorem coprime.coprime_mul_right_right {k m n : ℕ} (H : coprime m (n * k)) : coprime m n := -H.coprime_dvd_right (dvd_mul_right _ _) - -theorem coprime.coprime_div_left {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ m) : - coprime (m / a) n := -begin - by_cases a_split : (a = 0), - { subst a_split, - rw zero_dvd_iff at dvd, - simpa [dvd] using cmn, }, - { rcases dvd with ⟨k, rfl⟩, - rw nat.mul_div_cancel_left _ (nat.pos_of_ne_zero a_split), - exact coprime.coprime_mul_left cmn, }, -end - -theorem coprime.coprime_div_right {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ n) : - coprime m (n / a) := -(coprime.coprime_div_left cmn.symm dvd).symm - -lemma coprime_mul_iff_left {k m n : ℕ} : coprime (m * n) k ↔ coprime m k ∧ coprime n k := -⟨λ h, ⟨coprime.coprime_mul_right h, coprime.coprime_mul_left h⟩, - λ ⟨h, _⟩, by rwa [coprime_iff_gcd_eq_one, coprime.gcd_mul_left_cancel n h]⟩ - -lemma coprime_mul_iff_right {k m n : ℕ} : coprime k (m * n) ↔ coprime k m ∧ coprime k n := -by simpa only [coprime_comm] using coprime_mul_iff_left - -lemma coprime.gcd_left (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) n := -hmn.coprime_dvd_left $ gcd_dvd_right k m - -lemma coprime.gcd_right (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime m (gcd k n) := -hmn.coprime_dvd_right $ gcd_dvd_right k n - -lemma coprime.gcd_both (k l : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) (gcd l n) := -(hmn.gcd_left k).gcd_right l - -lemma coprime.mul_dvd_of_dvd_of_dvd {a n m : ℕ} (hmn : coprime m n) - (hm : m ∣ a) (hn : n ∣ a) : m * n ∣ a := -let ⟨k, hk⟩ := hm in hk.symm ▸ mul_dvd_mul_left _ (hmn.symm.dvd_of_dvd_mul_left (hk ▸ hn)) - -theorem coprime_one_left : ∀ n, coprime 1 n := gcd_one_left - -theorem coprime_one_right : ∀ n, coprime n 1 := gcd_one_right - -theorem coprime.pow_left {m k : ℕ} (n : ℕ) (H1 : coprime m k) : coprime (m ^ n) k := -nat.rec_on n (coprime_one_left _) (λn IH, H1.mul IH) - -theorem coprime.pow_right {m k : ℕ} (n : ℕ) (H1 : coprime k m) : coprime k (m ^ n) := -(H1.symm.pow_left n).symm - -theorem coprime.pow {k l : ℕ} (m n : ℕ) (H1 : coprime k l) : coprime (k ^ m) (l ^ n) := -(H1.pow_left _).pow_right _ - -@[simp] lemma coprime_pow_left_iff {n : ℕ} (hn : 0 < n) (a b : ℕ) : - nat.coprime (a ^ n) b ↔ nat.coprime a b := -begin - obtain ⟨n, rfl⟩ := exists_eq_succ_of_ne_zero hn.ne', - rw [pow_succ, nat.coprime_mul_iff_left], - exact ⟨and.left, λ hab, ⟨hab, hab.pow_left _⟩⟩ -end - -@[simp] lemma coprime_pow_right_iff {n : ℕ} (hn : 0 < n) (a b : ℕ) : - nat.coprime a (b ^ n) ↔ nat.coprime a b := -by rw [nat.coprime_comm, coprime_pow_left_iff hn, nat.coprime_comm] - -theorem coprime.eq_one_of_dvd {k m : ℕ} (H : coprime k m) (d : k ∣ m) : k = 1 := -by rw [← H.gcd_eq_one, gcd_eq_left d] - -@[simp] theorem coprime_zero_left (n : ℕ) : coprime 0 n ↔ n = 1 := -by simp [coprime] - -@[simp] theorem coprime_zero_right (n : ℕ) : coprime n 0 ↔ n = 1 := -by simp [coprime] - -theorem not_coprime_zero_zero : ¬ coprime 0 0 := by simp - -@[simp] theorem coprime_one_left_iff (n : ℕ) : coprime 1 n ↔ true := -by simp [coprime] - -@[simp] theorem coprime_one_right_iff (n : ℕ) : coprime n 1 ↔ true := -by simp [coprime] - -@[simp] theorem coprime_self (n : ℕ) : coprime n n ↔ n = 1 := -by simp [coprime] - -lemma gcd_mul_of_coprime_of_dvd {a b c : ℕ} (hac : coprime a c) (b_dvd_c : b ∣ c) : - gcd (a * b) c = b := -begin - rcases exists_eq_mul_left_of_dvd b_dvd_c with ⟨d, rfl⟩, - rw [gcd_mul_right], - convert one_mul b, - exact coprime.coprime_mul_right_right hac, -end - -section big_operators - -open_locale big_operators - -/-- See `is_coprime.prod_left` for the corresponding lemma about `is_coprime` -/ -lemma coprime_prod_left - {ι : Type*} {x : ℕ} {s : ι → ℕ} {t : finset ι} : - (∀ (i : ι), i ∈ t → coprime (s i) x) → coprime (∏ (i : ι) in t, s i) x := -finset.prod_induction s (λ y, y.coprime x) (λ a b, coprime.mul) (by simp) - -/-- See `is_coprime.prod_right` for the corresponding lemma about `is_coprime` -/ -lemma coprime_prod_right - {ι : Type*} {x : ℕ} {s : ι → ℕ} {t : finset ι} : - (∀ (i : ι), i ∈ t → coprime x (s i)) → coprime x (∏ (i : ι) in t, s i) := -finset.prod_induction s (λ y, x.coprime y) (λ a b, coprime.mul_right) (by simp) - -end big_operators - -lemma coprime.eq_of_mul_eq_zero {m n : ℕ} (h : m.coprime n) (hmn : m * n = 0) : - m = 0 ∧ n = 1 ∨ m = 1 ∧ n = 0 := -(nat.eq_zero_of_mul_eq_zero hmn).imp - (λ hm, ⟨hm, n.coprime_zero_left.mp $ hm ▸ h⟩) - (λ hn, ⟨m.coprime_zero_left.mp $ hn ▸ h.symm, hn⟩) - -/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. -/ -def prod_dvd_and_dvd_of_dvd_prod {m n k : ℕ} (H : k ∣ m * n) : - { d : {m' // m' ∣ m} × {n' // n' ∣ n} // k = d.1 * d.2 } := -begin -cases h0 : (gcd k m), -case nat.zero -{ obtain rfl : k = 0 := eq_zero_of_gcd_eq_zero_left h0, - obtain rfl : m = 0 := eq_zero_of_gcd_eq_zero_right h0, - exact ⟨⟨⟨0, dvd_refl 0⟩, ⟨n, dvd_refl n⟩⟩, (zero_mul n).symm⟩ }, -case nat.succ : tmp -{ have hpos : 0 < gcd k m := h0.symm ▸ nat.zero_lt_succ _; clear h0 tmp, - have hd : gcd k m * (k / gcd k m) = k := (nat.mul_div_cancel' (gcd_dvd_left k m)), - refine ⟨⟨⟨gcd k m, gcd_dvd_right k m⟩, ⟨k / gcd k m, _⟩⟩, hd.symm⟩, - apply dvd_of_mul_dvd_mul_left hpos, - rw [hd, ← gcd_mul_right], - exact dvd_gcd (dvd_mul_right _ _) H } -end - -theorem gcd_mul_dvd_mul_gcd (k m n : ℕ) : gcd k (m * n) ∣ gcd k m * gcd k n := -begin -rcases (prod_dvd_and_dvd_of_dvd_prod $ gcd_dvd_right k (m * n)) with ⟨⟨⟨m', hm'⟩, ⟨n', hn'⟩⟩, h⟩, -replace h : gcd k (m * n) = m' * n' := h, -rw h, -have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _, -apply mul_dvd_mul, - { have hm'k : m' ∣ k := (dvd_mul_right m' n').trans hm'n', - exact dvd_gcd hm'k hm' }, - { have hn'k : n' ∣ k := (dvd_mul_left n' m').trans hm'n', - exact dvd_gcd hn'k hn' } -end - -theorem coprime.gcd_mul (k : ℕ) {m n : ℕ} (h : coprime m n) : gcd k (m * n) = gcd k m * gcd k n := -dvd_antisymm - (gcd_mul_dvd_mul_gcd k m n) - ((h.gcd_both k k).mul_dvd_of_dvd_of_dvd - (gcd_dvd_gcd_mul_right_right _ _ _) - (gcd_dvd_gcd_mul_left_right _ _ _)) - -theorem pow_dvd_pow_iff {a b n : ℕ} (n0 : 0 < n) : a ^ n ∣ b ^ n ↔ a ∣ b := -begin - refine ⟨λ h, _, λ h, pow_dvd_pow_of_dvd h _⟩, - cases nat.eq_zero_or_pos (gcd a b) with g0 g0, - { simp [eq_zero_of_gcd_eq_zero_right g0] }, - rcases exists_coprime' g0 with ⟨g, a', b', g0', co, rfl, rfl⟩, - rw [mul_pow, mul_pow] at h, - replace h := dvd_of_mul_dvd_mul_right (pow_pos g0' _) h, - have := pow_dvd_pow a' n0, - rw [pow_one, (co.pow n n).eq_one_of_dvd h] at this, - simp [eq_one_of_dvd_one this] -end - -lemma gcd_mul_gcd_of_coprime_of_mul_eq_mul {a b c d : ℕ} (cop : c.coprime d) (h : a * b = c * d) : - a.gcd c * b.gcd c = c := -begin - apply dvd_antisymm, - { apply nat.coprime.dvd_of_dvd_mul_right (nat.coprime.mul (cop.gcd_left _) (cop.gcd_left _)), - rw ← h, - apply mul_dvd_mul (gcd_dvd _ _).1 (gcd_dvd _ _).1 }, - { rw [gcd_comm a _, gcd_comm b _], - transitivity c.gcd (a * b), - rw [h, gcd_mul_right_right d c], - apply gcd_mul_dvd_mul_gcd } -end - -/-- If `k:ℕ` divides coprime `a` and `b` then `k = 1` -/ -lemma eq_one_of_dvd_coprimes {a b k : ℕ} (h_ab_coprime : coprime a b) - (hka : k ∣ a) (hkb : k ∣ b) : k = 1 := -begin - rw coprime_iff_gcd_eq_one at h_ab_coprime, - have h1 := dvd_gcd hka hkb, - rw h_ab_coprime at h1, - exact nat.dvd_one.mp h1, -end - -lemma coprime.mul_add_mul_ne_mul {m n a b : ℕ} (cop : coprime m n) (ha : a ≠ 0) (hb : b ≠ 0) : - a * m + b * n ≠ m * n := -begin - intro h, - obtain ⟨x, rfl⟩ : n ∣ a := cop.symm.dvd_of_dvd_mul_right - ((nat.dvd_add_iff_left (dvd_mul_left n b)).mpr ((congr_arg _ h).mpr (dvd_mul_left n m))), - obtain ⟨y, rfl⟩ : m ∣ b := cop.dvd_of_dvd_mul_right - ((nat.dvd_add_iff_right (dvd_mul_left m (n*x))).mpr ((congr_arg _ h).mpr (dvd_mul_right m n))), - rw [mul_comm, mul_ne_zero_iff, ←one_le_iff_ne_zero] at ha hb, - refine mul_ne_zero hb.2 ha.2 (eq_zero_of_mul_eq_self_left (ne_of_gt (add_le_add ha.1 hb.1)) _), - rw [← mul_assoc, ← h, add_mul, add_mul, mul_comm _ n, ←mul_assoc, mul_comm y] -end - -end nat diff --git a/src/data/nat/gcd/basic.lean b/src/data/nat/gcd/basic.lean new file mode 100644 index 0000000000000..1755c5bc55313 --- /dev/null +++ b/src/data/nat/gcd/basic.lean @@ -0,0 +1,601 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura +-/ +import algebra.group_power.basic +import algebra.group_with_zero.divisibility +import data.nat.order.lemmas + +/-! +# Definitions and properties of `nat.gcd`, `nat.lcm`, and `nat.coprime` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +Generalizations of these are provided in a later file as `gcd_monoid.gcd` and +`gcd_monoid.lcm`. + +Note that the global `is_coprime` is not a straightforward generalization of `nat.coprime`, see +`nat.is_coprime_iff_coprime` for the connection between the two. + +-/ + +namespace nat + +/-! ### `gcd` -/ + +theorem gcd_dvd (m n : ℕ) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := +gcd.induction m n + (λn, by rw gcd_zero_left; exact ⟨dvd_zero n, dvd_refl n⟩) + (λm n npos, by rw ←gcd_rec; exact λ ⟨IH₁, IH₂⟩, ⟨IH₂, (dvd_mod_iff IH₂).1 IH₁⟩) + +theorem gcd_dvd_left (m n : ℕ) : gcd m n ∣ m := (gcd_dvd m n).left + +theorem gcd_dvd_right (m n : ℕ) : gcd m n ∣ n := (gcd_dvd m n).right + +theorem gcd_le_left {m} (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h $ gcd_dvd_left m n + +theorem gcd_le_right (m) {n} (h : 0 < n) : gcd m n ≤ n := le_of_dvd h $ gcd_dvd_right m n + +theorem dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n := +gcd.induction m n (λn _ kn, by rw gcd_zero_left; exact kn) + (λn m mpos IH H1 H2, by rw gcd_rec; exact IH ((dvd_mod_iff H1).2 H2) H1) + +theorem dvd_gcd_iff {m n k : ℕ} : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n := +iff.intro (λ h, ⟨h.trans (gcd_dvd m n).left, h.trans (gcd_dvd m n).right⟩) + (λ h, dvd_gcd h.left h.right) + +theorem gcd_comm (m n : ℕ) : gcd m n = gcd n m := +dvd_antisymm + (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n)) + (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m)) + +theorem gcd_eq_left_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd m n = m := +⟨λ h, by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left], + λ h, h ▸ gcd_dvd_right m n⟩ + +theorem gcd_eq_right_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd n m = m := +by rw gcd_comm; apply gcd_eq_left_iff_dvd + +theorem gcd_assoc (m n k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) := +dvd_antisymm + (dvd_gcd + ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_left m n)) + (dvd_gcd ((gcd_dvd_left (gcd m n) k).trans (gcd_dvd_right m n)) + (gcd_dvd_right (gcd m n) k))) + (dvd_gcd + (dvd_gcd (gcd_dvd_left m (gcd n k)) ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_left n k))) + ((gcd_dvd_right m (gcd n k)).trans (gcd_dvd_right n k))) + +@[simp] theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 := +eq.trans (gcd_comm n 1) $ gcd_one_left n + +theorem gcd_mul_left (m n k : ℕ) : gcd (m * n) (m * k) = m * gcd n k := +gcd.induction n k + (λk, by repeat {rw mul_zero <|> rw gcd_zero_left}) + (λk n H IH, by rwa [←mul_mod_mul_left, ←gcd_rec, ←gcd_rec] at IH) + +theorem gcd_mul_right (m n k : ℕ) : gcd (m * n) (k * n) = gcd m k * n := +by rw [mul_comm m n, mul_comm k n, mul_comm (gcd m k) n, gcd_mul_left] + +theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : 0 < m) : 0 < gcd m n := +pos_of_dvd_of_pos (gcd_dvd_left m n) mpos + +theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : 0 < n) : 0 < gcd m n := +pos_of_dvd_of_pos (gcd_dvd_right m n) npos + +theorem eq_zero_of_gcd_eq_zero_left {m n : ℕ} (H : gcd m n = 0) : m = 0 := +or.elim (nat.eq_zero_or_pos m) id + (assume H1 : 0 < m, absurd (eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1))) + +theorem eq_zero_of_gcd_eq_zero_right {m n : ℕ} (H : gcd m n = 0) : n = 0 := +by rw gcd_comm at H; exact eq_zero_of_gcd_eq_zero_left H + +@[simp] theorem gcd_eq_zero_iff {i j : ℕ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := +begin + split, + { intro h, + exact ⟨eq_zero_of_gcd_eq_zero_left h, eq_zero_of_gcd_eq_zero_right h⟩, }, + { rintro ⟨rfl, rfl⟩, + exact nat.gcd_zero_right 0 } +end + +theorem gcd_div {m n k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) : + gcd (m / k) (n / k) = gcd m n / k := +(decidable.eq_or_ne k 0).elim + (λk0, by rw [k0, nat.div_zero, nat.div_zero, nat.div_zero, gcd_zero_right]) + (λH3, mul_right_cancel₀ H3 $ by rw [ + nat.div_mul_cancel (dvd_gcd H1 H2), ←gcd_mul_right, + nat.div_mul_cancel H1, nat.div_mul_cancel H2]) + +theorem gcd_greatest {a b d : ℕ} (hda : d ∣ a) (hdb : d ∣ b) + (hd : ∀ e : ℕ, e ∣ a → e ∣ b → e ∣ d) : d = a.gcd b := +(dvd_antisymm (hd _ (gcd_dvd_left a b) (gcd_dvd_right a b)) (dvd_gcd hda hdb)).symm + +theorem gcd_dvd_gcd_of_dvd_left {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd m n ∣ gcd k n := +dvd_gcd ((gcd_dvd_left m n).trans H) (gcd_dvd_right m n) + +theorem gcd_dvd_gcd_of_dvd_right {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd n m ∣ gcd n k := +dvd_gcd (gcd_dvd_left n m) ((gcd_dvd_right n m).trans H) + +theorem gcd_dvd_gcd_mul_left (m n k : ℕ) : gcd m n ∣ gcd (k * m) n := +gcd_dvd_gcd_of_dvd_left _ (dvd_mul_left _ _) + +theorem gcd_dvd_gcd_mul_right (m n k : ℕ) : gcd m n ∣ gcd (m * k) n := +gcd_dvd_gcd_of_dvd_left _ (dvd_mul_right _ _) + +theorem gcd_dvd_gcd_mul_left_right (m n k : ℕ) : gcd m n ∣ gcd m (k * n) := +gcd_dvd_gcd_of_dvd_right _ (dvd_mul_left _ _) + +theorem gcd_dvd_gcd_mul_right_right (m n k : ℕ) : gcd m n ∣ gcd m (n * k) := +gcd_dvd_gcd_of_dvd_right _ (dvd_mul_right _ _) + +theorem gcd_eq_left {m n : ℕ} (H : m ∣ n) : gcd m n = m := +dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd dvd_rfl H) + +theorem gcd_eq_right {m n : ℕ} (H : n ∣ m) : gcd m n = n := +by rw [gcd_comm, gcd_eq_left H] + +-- Lemmas where one argument is a multiple of the other + +@[simp] lemma gcd_mul_left_left (m n : ℕ) : gcd (m * n) n = n := +dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (dvd_mul_left _ _) dvd_rfl) + +@[simp] lemma gcd_mul_left_right (m n : ℕ) : gcd n (m * n) = n := +by rw [gcd_comm, gcd_mul_left_left] + +@[simp] lemma gcd_mul_right_left (m n : ℕ) : gcd (n * m) n = n := +by rw [mul_comm, gcd_mul_left_left] + +@[simp] lemma gcd_mul_right_right (m n : ℕ) : gcd n (n * m) = n := +by rw [gcd_comm, gcd_mul_right_left] + +-- Lemmas for repeated application of `gcd` + +@[simp] lemma gcd_gcd_self_right_left (m n : ℕ) : gcd m (gcd m n) = gcd m n := +dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (gcd_dvd_left _ _) dvd_rfl) + +@[simp] lemma gcd_gcd_self_right_right (m n : ℕ) : gcd m (gcd n m) = gcd n m := +by rw [gcd_comm n m, gcd_gcd_self_right_left] + +@[simp] lemma gcd_gcd_self_left_right (m n : ℕ) : gcd (gcd n m) m = gcd n m := +by rw [gcd_comm, gcd_gcd_self_right_right] + +@[simp] lemma gcd_gcd_self_left_left (m n : ℕ) : gcd (gcd m n) m = gcd m n := +by rw [gcd_comm m n, gcd_gcd_self_left_right] + +-- Lemmas where one argument consists of addition of a multiple of the other + +@[simp] lemma gcd_add_mul_right_right (m n k : ℕ) : gcd m (n + k * m) = gcd m n := +by simp [gcd_rec m (n + k * m), gcd_rec m n] + +@[simp] lemma gcd_add_mul_left_right (m n k : ℕ) : gcd m (n + m * k) = gcd m n := +by simp [gcd_rec m (n + m * k), gcd_rec m n] + +@[simp] lemma gcd_mul_right_add_right (m n k : ℕ) : gcd m (k * m + n) = gcd m n := +by simp [add_comm _ n] + +@[simp] lemma gcd_mul_left_add_right (m n k : ℕ) : gcd m (m * k + n) = gcd m n := +by simp [add_comm _ n] + +@[simp] lemma gcd_add_mul_right_left (m n k : ℕ) : gcd (m + k * n) n = gcd m n := +by rw [gcd_comm, gcd_add_mul_right_right, gcd_comm] + +@[simp] lemma gcd_add_mul_left_left (m n k : ℕ) : gcd (m + n * k) n = gcd m n := +by rw [gcd_comm, gcd_add_mul_left_right, gcd_comm] + +@[simp] lemma gcd_mul_right_add_left (m n k : ℕ) : gcd (k * n + m) n = gcd m n := +by rw [gcd_comm, gcd_mul_right_add_right, gcd_comm] + +@[simp] lemma gcd_mul_left_add_left (m n k : ℕ) : gcd (n * k + m) n = gcd m n := +by rw [gcd_comm, gcd_mul_left_add_right, gcd_comm] + +-- Lemmas where one argument consists of an addition of the other + +@[simp] lemma gcd_add_self_right (m n : ℕ) : gcd m (n + m) = gcd m n := +eq.trans (by rw one_mul) (gcd_add_mul_right_right m n 1) + +@[simp] lemma gcd_add_self_left (m n : ℕ) : gcd (m + n) n = gcd m n := +by rw [gcd_comm, gcd_add_self_right, gcd_comm] + +@[simp] lemma gcd_self_add_left (m n : ℕ) : gcd (m + n) m = gcd n m := +by rw [add_comm, gcd_add_self_left] + +@[simp] lemma gcd_self_add_right (m n : ℕ) : gcd m (m + n) = gcd m n := +by rw [add_comm, gcd_add_self_right] + +/-! ### `lcm` -/ + +theorem lcm_comm (m n : ℕ) : lcm m n = lcm n m := +by delta lcm; rw [mul_comm, gcd_comm] + +@[simp] +theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 := +by delta lcm; rw [zero_mul, nat.zero_div] + +@[simp] +theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 := lcm_comm 0 m ▸ lcm_zero_left m + +@[simp] +theorem lcm_one_left (m : ℕ) : lcm 1 m = m := +by delta lcm; rw [one_mul, gcd_one_left, nat.div_one] + +@[simp] +theorem lcm_one_right (m : ℕ) : lcm m 1 = m := lcm_comm 1 m ▸ lcm_one_left m + +@[simp] +theorem lcm_self (m : ℕ) : lcm m m = m := +or.elim (nat.eq_zero_or_pos m) + (λh, by rw [h, lcm_zero_left]) + (λh, by delta lcm; rw [gcd_self, nat.mul_div_cancel _ h]) + +theorem dvd_lcm_left (m n : ℕ) : m ∣ lcm m n := +dvd.intro (n / gcd m n) (nat.mul_div_assoc _ $ gcd_dvd_right m n).symm + +theorem dvd_lcm_right (m n : ℕ) : n ∣ lcm m n := +lcm_comm n m ▸ dvd_lcm_left n m + +theorem gcd_mul_lcm (m n : ℕ) : gcd m n * lcm m n = m * n := +by delta lcm; rw [nat.mul_div_cancel' ((gcd_dvd_left m n).trans (dvd_mul_right m n))] + +theorem lcm_dvd {m n k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k := +or.elim (nat.eq_zero_or_pos k) + (λh, by rw h; exact dvd_zero _) + (λkpos, dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) $ + by rw [gcd_mul_lcm, ←gcd_mul_right, mul_comm n k]; + exact dvd_gcd (mul_dvd_mul_left _ H2) (mul_dvd_mul_right H1 _)) + +theorem lcm_dvd_mul (m n : ℕ) : lcm m n ∣ m * n := +lcm_dvd (dvd_mul_right _ _) (dvd_mul_left _ _) + +lemma lcm_dvd_iff {m n k : ℕ} : lcm m n ∣ k ↔ m ∣ k ∧ n ∣ k := +⟨λ h, ⟨(dvd_lcm_left _ _).trans h, (dvd_lcm_right _ _).trans h⟩, + and_imp.2 lcm_dvd⟩ + +theorem lcm_assoc (m n k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) := +dvd_antisymm + (lcm_dvd + (lcm_dvd (dvd_lcm_left m (lcm n k)) ((dvd_lcm_left n k).trans (dvd_lcm_right m (lcm n k)))) + ((dvd_lcm_right n k).trans (dvd_lcm_right m (lcm n k)))) + (lcm_dvd + ((dvd_lcm_left m n).trans (dvd_lcm_left (lcm m n) k)) + (lcm_dvd ((dvd_lcm_right m n).trans (dvd_lcm_left (lcm m n) k)) + (dvd_lcm_right (lcm m n) k))) + +theorem lcm_ne_zero {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := +by { intro h, simpa [h, hm, hn] using gcd_mul_lcm m n, } + +lemma lcm_pos {m n : ℕ} : 0 < m → 0 < n → 0 < m.lcm n := +by { simp_rw pos_iff_ne_zero, exact lcm_ne_zero } + +/-! +### `coprime` + +See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.coprime m n`. +-/ + +instance (m n : ℕ) : decidable (coprime m n) := by unfold coprime; apply_instance + +theorem coprime_iff_gcd_eq_one {m n : ℕ} : coprime m n ↔ gcd m n = 1 := iff.rfl + +theorem coprime.gcd_eq_one {m n : ℕ} (h : coprime m n) : gcd m n = 1 := h + +theorem coprime.lcm_eq_mul {m n : ℕ} (h : coprime m n) : lcm m n = m * n := +by rw [←one_mul (lcm m n), ←h.gcd_eq_one, gcd_mul_lcm] + +theorem coprime.symm {m n : ℕ} : coprime n m → coprime m n := (gcd_comm m n).trans + +theorem coprime_comm {m n : ℕ} : coprime n m ↔ coprime m n := ⟨coprime.symm, coprime.symm⟩ + +theorem coprime.symmetric : symmetric coprime := λ m n, coprime.symm + +theorem coprime.dvd_of_dvd_mul_right {m n k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m := +let t := dvd_gcd (dvd_mul_left k m) H2 in +by rwa [gcd_mul_left, H1.gcd_eq_one, mul_one] at t + +theorem coprime.dvd_of_dvd_mul_left {m n k : ℕ} (H1 : coprime k m) (H2 : k ∣ m * n) : k ∣ n := +by rw mul_comm at H2; exact H1.dvd_of_dvd_mul_right H2 + +theorem coprime.dvd_mul_right {m n k : ℕ} (H : coprime k n) : k ∣ m * n ↔ k ∣ m := +⟨H.dvd_of_dvd_mul_right, λ h, dvd_mul_of_dvd_left h n⟩ + +theorem coprime.dvd_mul_left {m n k : ℕ} (H : coprime k m) : k ∣ m * n ↔ k ∣ n := +⟨H.dvd_of_dvd_mul_left, λ h, dvd_mul_of_dvd_right h m⟩ + +theorem coprime.gcd_mul_left_cancel {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) : + gcd (k * m) n = gcd m n := +have H1 : coprime (gcd (k * m) n) k, +by rw [coprime, gcd_assoc, H.symm.gcd_eq_one, gcd_one_right], +dvd_antisymm + (dvd_gcd (H1.dvd_of_dvd_mul_left (gcd_dvd_left _ _)) (gcd_dvd_right _ _)) + (gcd_dvd_gcd_mul_left _ _ _) + +theorem coprime.gcd_mul_right_cancel (m : ℕ) {k n : ℕ} (H : coprime k n) : + gcd (m * k) n = gcd m n := +by rw [mul_comm m k, H.gcd_mul_left_cancel m] + +theorem coprime.gcd_mul_left_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) : + gcd m (k * n) = gcd m n := +by rw [gcd_comm m n, gcd_comm m (k * n), H.gcd_mul_left_cancel n] + +theorem coprime.gcd_mul_right_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) : + gcd m (n * k) = gcd m n := +by rw [mul_comm n k, H.gcd_mul_left_cancel_right n] + +theorem coprime_div_gcd_div_gcd {m n : ℕ} (H : 0 < gcd m n) : + coprime (m / gcd m n) (n / gcd m n) := +by rw [coprime_iff_gcd_eq_one, gcd_div (gcd_dvd_left m n) (gcd_dvd_right m n), nat.div_self H] + +theorem not_coprime_of_dvd_of_dvd {m n d : ℕ} (dgt1 : 1 < d) (Hm : d ∣ m) (Hn : d ∣ n) : + ¬ coprime m n := +λ co, not_lt_of_ge (le_of_dvd zero_lt_one $ by rw [←co.gcd_eq_one]; exact dvd_gcd Hm Hn) dgt1 + +theorem exists_coprime {m n : ℕ} (H : 0 < gcd m n) : + ∃ m' n', coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n := +⟨_, _, coprime_div_gcd_div_gcd H, + (nat.div_mul_cancel (gcd_dvd_left m n)).symm, + (nat.div_mul_cancel (gcd_dvd_right m n)).symm⟩ + +theorem exists_coprime' {m n : ℕ} (H : 0 < gcd m n) : + ∃ g m' n', 0 < g ∧ coprime m' n' ∧ m = m' * g ∧ n = n' * g := +let ⟨m', n', h⟩ := exists_coprime H in ⟨_, m', n', H, h⟩ + +@[simp] theorem coprime_add_self_right {m n : ℕ} : coprime m (n + m) ↔ coprime m n := +by rw [coprime, coprime, gcd_add_self_right] + +@[simp] theorem coprime_self_add_right {m n : ℕ} : coprime m (m + n) ↔ coprime m n := +by rw [add_comm, coprime_add_self_right] + +@[simp] theorem coprime_add_self_left {m n : ℕ} : coprime (m + n) n ↔ coprime m n := +by rw [coprime, coprime, gcd_add_self_left] + +@[simp] theorem coprime_self_add_left {m n : ℕ} : coprime (m + n) m ↔ coprime n m := +by rw [coprime, coprime, gcd_self_add_left] + +@[simp] lemma coprime_add_mul_right_right (m n k : ℕ) : coprime m (n + k * m) ↔ coprime m n := +by rw [coprime, coprime, gcd_add_mul_right_right] + +@[simp] lemma coprime_add_mul_left_right (m n k : ℕ) : coprime m (n + m * k) ↔ coprime m n := +by rw [coprime, coprime, gcd_add_mul_left_right] + +@[simp] lemma coprime_mul_right_add_right (m n k : ℕ) : coprime m (k * m + n) ↔ coprime m n := +by rw [coprime, coprime, gcd_mul_right_add_right] + +@[simp] lemma coprime_mul_left_add_right (m n k : ℕ) : coprime m (m * k + n) ↔ coprime m n := +by rw [coprime, coprime, gcd_mul_left_add_right] + +@[simp] lemma coprime_add_mul_right_left (m n k : ℕ) : coprime (m + k * n) n ↔ coprime m n := +by rw [coprime, coprime, gcd_add_mul_right_left] + +@[simp] lemma coprime_add_mul_left_left (m n k : ℕ) : coprime (m + n * k) n ↔ coprime m n := +by rw [coprime, coprime, gcd_add_mul_left_left] + +@[simp] lemma coprime_mul_right_add_left (m n k : ℕ) : coprime (k * n + m) n ↔ coprime m n := +by rw [coprime, coprime, gcd_mul_right_add_left] + +@[simp] lemma coprime_mul_left_add_left (m n k : ℕ) : coprime (n * k + m) n ↔ coprime m n := +by rw [coprime, coprime, gcd_mul_left_add_left] + +theorem coprime.mul {m n k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k := +(H1.gcd_mul_left_cancel n).trans H2 + +theorem coprime.mul_right {k m n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) := +(H1.symm.mul H2.symm).symm + +theorem coprime.coprime_dvd_left {m k n : ℕ} (H1 : m ∣ k) (H2 : coprime k n) : coprime m n := +eq_one_of_dvd_one (by delta coprime at H2; rw ← H2; exact gcd_dvd_gcd_of_dvd_left _ H1) + +theorem coprime.coprime_dvd_right {m k n : ℕ} (H1 : n ∣ m) (H2 : coprime k m) : coprime k n := +(H2.symm.coprime_dvd_left H1).symm + +theorem coprime.coprime_mul_left {k m n : ℕ} (H : coprime (k * m) n) : coprime m n := +H.coprime_dvd_left (dvd_mul_left _ _) + +theorem coprime.coprime_mul_right {k m n : ℕ} (H : coprime (m * k) n) : coprime m n := +H.coprime_dvd_left (dvd_mul_right _ _) + +theorem coprime.coprime_mul_left_right {k m n : ℕ} (H : coprime m (k * n)) : coprime m n := +H.coprime_dvd_right (dvd_mul_left _ _) + +theorem coprime.coprime_mul_right_right {k m n : ℕ} (H : coprime m (n * k)) : coprime m n := +H.coprime_dvd_right (dvd_mul_right _ _) + +theorem coprime.coprime_div_left {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ m) : + coprime (m / a) n := +begin + by_cases a_split : (a = 0), + { subst a_split, + rw zero_dvd_iff at dvd, + simpa [dvd] using cmn, }, + { rcases dvd with ⟨k, rfl⟩, + rw nat.mul_div_cancel_left _ (nat.pos_of_ne_zero a_split), + exact coprime.coprime_mul_left cmn, }, +end + +theorem coprime.coprime_div_right {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ n) : + coprime m (n / a) := +(coprime.coprime_div_left cmn.symm dvd).symm + +lemma coprime_mul_iff_left {k m n : ℕ} : coprime (m * n) k ↔ coprime m k ∧ coprime n k := +⟨λ h, ⟨coprime.coprime_mul_right h, coprime.coprime_mul_left h⟩, + λ ⟨h, _⟩, by rwa [coprime_iff_gcd_eq_one, coprime.gcd_mul_left_cancel n h]⟩ + +lemma coprime_mul_iff_right {k m n : ℕ} : coprime k (m * n) ↔ coprime k m ∧ coprime k n := +by simpa only [coprime_comm] using coprime_mul_iff_left + +lemma coprime.gcd_left (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) n := +hmn.coprime_dvd_left $ gcd_dvd_right k m + +lemma coprime.gcd_right (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime m (gcd k n) := +hmn.coprime_dvd_right $ gcd_dvd_right k n + +lemma coprime.gcd_both (k l : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) (gcd l n) := +(hmn.gcd_left k).gcd_right l + +lemma coprime.mul_dvd_of_dvd_of_dvd {a n m : ℕ} (hmn : coprime m n) + (hm : m ∣ a) (hn : n ∣ a) : m * n ∣ a := +let ⟨k, hk⟩ := hm in hk.symm ▸ mul_dvd_mul_left _ (hmn.symm.dvd_of_dvd_mul_left (hk ▸ hn)) + +theorem coprime_one_left : ∀ n, coprime 1 n := gcd_one_left + +theorem coprime_one_right : ∀ n, coprime n 1 := gcd_one_right + +theorem coprime.pow_left {m k : ℕ} (n : ℕ) (H1 : coprime m k) : coprime (m ^ n) k := +nat.rec_on n (coprime_one_left _) (λn IH, H1.mul IH) + +theorem coprime.pow_right {m k : ℕ} (n : ℕ) (H1 : coprime k m) : coprime k (m ^ n) := +(H1.symm.pow_left n).symm + +theorem coprime.pow {k l : ℕ} (m n : ℕ) (H1 : coprime k l) : coprime (k ^ m) (l ^ n) := +(H1.pow_left _).pow_right _ + +@[simp] lemma coprime_pow_left_iff {n : ℕ} (hn : 0 < n) (a b : ℕ) : + nat.coprime (a ^ n) b ↔ nat.coprime a b := +begin + obtain ⟨n, rfl⟩ := exists_eq_succ_of_ne_zero hn.ne', + rw [pow_succ, nat.coprime_mul_iff_left], + exact ⟨and.left, λ hab, ⟨hab, hab.pow_left _⟩⟩ +end + +@[simp] lemma coprime_pow_right_iff {n : ℕ} (hn : 0 < n) (a b : ℕ) : + nat.coprime a (b ^ n) ↔ nat.coprime a b := +by rw [nat.coprime_comm, coprime_pow_left_iff hn, nat.coprime_comm] + +theorem coprime.eq_one_of_dvd {k m : ℕ} (H : coprime k m) (d : k ∣ m) : k = 1 := +by rw [← H.gcd_eq_one, gcd_eq_left d] + +@[simp] theorem coprime_zero_left (n : ℕ) : coprime 0 n ↔ n = 1 := +by simp [coprime] + +@[simp] theorem coprime_zero_right (n : ℕ) : coprime n 0 ↔ n = 1 := +by simp [coprime] + +theorem not_coprime_zero_zero : ¬ coprime 0 0 := by simp + +@[simp] theorem coprime_one_left_iff (n : ℕ) : coprime 1 n ↔ true := +by simp [coprime] + +@[simp] theorem coprime_one_right_iff (n : ℕ) : coprime n 1 ↔ true := +by simp [coprime] + +@[simp] theorem coprime_self (n : ℕ) : coprime n n ↔ n = 1 := +by simp [coprime] + +lemma gcd_mul_of_coprime_of_dvd {a b c : ℕ} (hac : coprime a c) (b_dvd_c : b ∣ c) : + gcd (a * b) c = b := +begin + rcases exists_eq_mul_left_of_dvd b_dvd_c with ⟨d, rfl⟩, + rw [gcd_mul_right], + convert one_mul b, + exact coprime.coprime_mul_right_right hac, +end + +lemma coprime.eq_of_mul_eq_zero {m n : ℕ} (h : m.coprime n) (hmn : m * n = 0) : + m = 0 ∧ n = 1 ∨ m = 1 ∧ n = 0 := +(nat.eq_zero_of_mul_eq_zero hmn).imp + (λ hm, ⟨hm, n.coprime_zero_left.mp $ hm ▸ h⟩) + (λ hn, ⟨m.coprime_zero_left.mp $ hn ▸ h.symm, hn⟩) + +/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. + +See `exists_dvd_and_dvd_of_dvd_mul` for the more general but less constructive version for other +`gcd_monoid`s. -/ +def prod_dvd_and_dvd_of_dvd_prod {m n k : ℕ} (H : k ∣ m * n) : + { d : {m' // m' ∣ m} × {n' // n' ∣ n} // k = d.1 * d.2 } := +begin + cases h0 : (gcd k m), + case nat.zero + { obtain rfl : k = 0 := eq_zero_of_gcd_eq_zero_left h0, + obtain rfl : m = 0 := eq_zero_of_gcd_eq_zero_right h0, + exact ⟨⟨⟨0, dvd_refl 0⟩, ⟨n, dvd_refl n⟩⟩, (zero_mul n).symm⟩ }, + case nat.succ : tmp + { have hpos : 0 < gcd k m := h0.symm ▸ nat.zero_lt_succ _; clear h0 tmp, + have hd : gcd k m * (k / gcd k m) = k := (nat.mul_div_cancel' (gcd_dvd_left k m)), + refine ⟨⟨⟨gcd k m, gcd_dvd_right k m⟩, ⟨k / gcd k m, _⟩⟩, hd.symm⟩, + apply dvd_of_mul_dvd_mul_left hpos, + rw [hd, ← gcd_mul_right], + exact dvd_gcd (dvd_mul_right _ _) H } +end + +lemma dvd_mul {x m n : ℕ} : + x ∣ (m * n) ↔ ∃ y z, y ∣ m ∧ z ∣ n ∧ y * z = x := +begin + split, + { intro h, + obtain ⟨⟨⟨y, hy⟩, ⟨z, hz⟩⟩, rfl⟩ := prod_dvd_and_dvd_of_dvd_prod h, + exact ⟨y, z, hy, hz, rfl⟩, }, + { rintro ⟨y, z, hy, hz, rfl⟩, + exact mul_dvd_mul hy hz }, +end + +theorem gcd_mul_dvd_mul_gcd (k m n : ℕ) : gcd k (m * n) ∣ gcd k m * gcd k n := +begin + rcases (prod_dvd_and_dvd_of_dvd_prod $ gcd_dvd_right k (m * n)) with ⟨⟨⟨m', hm'⟩, ⟨n', hn'⟩⟩, h⟩, + replace h : gcd k (m * n) = m' * n' := h, + rw h, + have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _, + apply mul_dvd_mul, + { have hm'k : m' ∣ k := (dvd_mul_right m' n').trans hm'n', + exact dvd_gcd hm'k hm' }, + { have hn'k : n' ∣ k := (dvd_mul_left n' m').trans hm'n', + exact dvd_gcd hn'k hn' } +end + +theorem coprime.gcd_mul (k : ℕ) {m n : ℕ} (h : coprime m n) : gcd k (m * n) = gcd k m * gcd k n := +dvd_antisymm + (gcd_mul_dvd_mul_gcd k m n) + ((h.gcd_both k k).mul_dvd_of_dvd_of_dvd + (gcd_dvd_gcd_mul_right_right _ _ _) + (gcd_dvd_gcd_mul_left_right _ _ _)) + +theorem pow_dvd_pow_iff {a b n : ℕ} (n0 : 0 < n) : a ^ n ∣ b ^ n ↔ a ∣ b := +begin + refine ⟨λ h, _, λ h, pow_dvd_pow_of_dvd h _⟩, + cases nat.eq_zero_or_pos (gcd a b) with g0 g0, + { simp [eq_zero_of_gcd_eq_zero_right g0] }, + rcases exists_coprime' g0 with ⟨g, a', b', g0', co, rfl, rfl⟩, + rw [mul_pow, mul_pow] at h, + replace h := dvd_of_mul_dvd_mul_right (pow_pos g0' _) h, + have := pow_dvd_pow a' n0, + rw [pow_one, (co.pow n n).eq_one_of_dvd h] at this, + simp [eq_one_of_dvd_one this] +end + +lemma gcd_mul_gcd_of_coprime_of_mul_eq_mul {a b c d : ℕ} (cop : c.coprime d) (h : a * b = c * d) : + a.gcd c * b.gcd c = c := +begin + apply dvd_antisymm, + { apply nat.coprime.dvd_of_dvd_mul_right (nat.coprime.mul (cop.gcd_left _) (cop.gcd_left _)), + rw ← h, + apply mul_dvd_mul (gcd_dvd _ _).1 (gcd_dvd _ _).1 }, + { rw [gcd_comm a _, gcd_comm b _], + transitivity c.gcd (a * b), + rw [h, gcd_mul_right_right d c], + apply gcd_mul_dvd_mul_gcd } +end + +/-- If `k:ℕ` divides coprime `a` and `b` then `k = 1` -/ +lemma eq_one_of_dvd_coprimes {a b k : ℕ} (h_ab_coprime : coprime a b) + (hka : k ∣ a) (hkb : k ∣ b) : k = 1 := +begin + rw coprime_iff_gcd_eq_one at h_ab_coprime, + have h1 := dvd_gcd hka hkb, + rw h_ab_coprime at h1, + exact nat.dvd_one.mp h1, +end + +lemma coprime.mul_add_mul_ne_mul {m n a b : ℕ} (cop : coprime m n) (ha : a ≠ 0) (hb : b ≠ 0) : + a * m + b * n ≠ m * n := +begin + intro h, + obtain ⟨x, rfl⟩ : n ∣ a := cop.symm.dvd_of_dvd_mul_right + ((nat.dvd_add_iff_left (dvd_mul_left n b)).mpr ((congr_arg _ h).mpr (dvd_mul_left n m))), + obtain ⟨y, rfl⟩ : m ∣ b := cop.dvd_of_dvd_mul_right + ((nat.dvd_add_iff_right (dvd_mul_left m (n*x))).mpr ((congr_arg _ h).mpr (dvd_mul_right m n))), + rw [mul_comm, mul_ne_zero_iff, ←one_le_iff_ne_zero] at ha hb, + refine mul_ne_zero hb.2 ha.2 (eq_zero_of_mul_eq_self_left (ne_of_gt (add_le_add ha.1 hb.1)) _), + rw [← mul_assoc, ← h, add_mul, add_mul, mul_comm _ n, ←mul_assoc, mul_comm y] +end + +end nat diff --git a/src/data/nat/gcd/big_operators.lean b/src/data/nat/gcd/big_operators.lean new file mode 100644 index 0000000000000..3628d43b45b99 --- /dev/null +++ b/src/data/nat/gcd/big_operators.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2014 Jeremy Avigad. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Jeremy Avigad, Leonardo de Moura +-/ +import data.nat.gcd.basic +import algebra.big_operators.basic + +/-! # Lemmas about coprimality with big products. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +These lemmas are kept separate from `data.nat.gcd.basic` in order to minimize imports. +-/ + +namespace nat + +open_locale big_operators + +/-- See `is_coprime.prod_left` for the corresponding lemma about `is_coprime` -/ +lemma coprime_prod_left + {ι : Type*} {x : ℕ} {s : ι → ℕ} {t : finset ι} : + (∀ (i : ι), i ∈ t → coprime (s i) x) → coprime (∏ (i : ι) in t, s i) x := +finset.prod_induction s (λ y, y.coprime x) (λ a b, coprime.mul) (by simp) + +/-- See `is_coprime.prod_right` for the corresponding lemma about `is_coprime` -/ +lemma coprime_prod_right + {ι : Type*} {x : ℕ} {s : ι → ℕ} {t : finset ι} : + (∀ (i : ι), i ∈ t → coprime x (s i)) → coprime x (∏ (i : ι) in t, s i) := +finset.prod_induction s (λ y, x.coprime y) (λ a b, coprime.mul_right) (by simp) + +end nat diff --git a/src/data/nat/hyperoperation.lean b/src/data/nat/hyperoperation.lean new file mode 100644 index 0000000000000..739603bb2df95 --- /dev/null +++ b/src/data/nat/hyperoperation.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2023 Mark Andrew Gerads. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mark Andrew Gerads, Junyan Xu, Eric Wieser +-/ +import tactic.ring +import data.nat.parity + +/-! +# Hyperoperation sequence + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the Hyperoperation sequence. +`hyperoperation 0 m k = k + 1` +`hyperoperation 1 m k = m + k` +`hyperoperation 2 m k = m * k` +`hyperoperation 3 m k = m ^ k` +`hyperoperation (n + 3) m 0 = 1` +`hyperoperation (n + 1) m (k + 1) = hyperoperation n m (hyperoperation (n + 1) m k)` + +## References + +* + +## Tags + +hyperoperation +-/ + +/-- +Implementation of the hyperoperation sequence +where `hyperoperation n m k` is the `n`th hyperoperation between `m` and `k`. +-/ +def hyperoperation : ℕ → ℕ → ℕ → ℕ +| 0 _ k := k + 1 +| 1 m 0 := m +| 2 _ 0 := 0 +| (n + 3) _ 0 := 1 +| (n + 1) m (k + 1) := hyperoperation n m (hyperoperation (n + 1) m k) + +-- Basic hyperoperation lemmas + +@[simp] lemma hyperoperation_zero (m : ℕ) : hyperoperation 0 m = nat.succ := +funext $ λ k, by rw [hyperoperation, nat.succ_eq_add_one] + +lemma hyperoperation_ge_three_eq_one (n m : ℕ) : hyperoperation (n + 3) m 0 = 1 := +by rw hyperoperation + +lemma hyperoperation_recursion (n m k : ℕ) : + hyperoperation (n + 1) m (k + 1) = hyperoperation n m (hyperoperation (n + 1) m k) := +by obtain (_|_|_) := n; rw hyperoperation + +-- Interesting hyperoperation lemmas + +@[simp] lemma hyperoperation_one : hyperoperation 1 = (+) := +begin + ext m k, + induction k with bn bih, + { rw [nat_add_zero m, hyperoperation], }, + { rw [hyperoperation_recursion, bih, hyperoperation_zero], + exact nat.add_assoc m bn 1, }, +end + +@[simp] lemma hyperoperation_two : hyperoperation 2 = (*) := +begin + ext m k, + induction k with bn bih, + { rw hyperoperation, + exact (nat.mul_zero m).symm, }, + { rw [hyperoperation_recursion, hyperoperation_one, bih], + ring, }, +end + +@[simp] lemma hyperoperation_three : hyperoperation 3 = (^) := +begin + ext m k, + induction k with bn bih, + { rw hyperoperation_ge_three_eq_one, + exact (pow_zero m).symm, }, + { rw [hyperoperation_recursion, hyperoperation_two, bih], + exact (pow_succ m bn).symm, }, +end + +lemma hyperoperation_ge_two_eq_self (n m : ℕ) : hyperoperation (n + 2) m 1 = m := +begin + induction n with nn nih, + { rw hyperoperation_two, + ring, }, + { rw [hyperoperation_recursion, hyperoperation_ge_three_eq_one, nih], }, +end + +lemma hyperoperation_two_two_eq_four (n : ℕ) : hyperoperation (n + 1) 2 2 = 4 := +begin + induction n with nn nih, + { rw hyperoperation_one, }, + { rw [hyperoperation_recursion, hyperoperation_ge_two_eq_self, nih], }, +end + +lemma hyperoperation_ge_three_one (n : ℕ) : ∀ (k : ℕ), hyperoperation (n + 3) 1 k = 1 := +begin + induction n with nn nih, + { intros k, + rw [hyperoperation_three, one_pow], }, + { intros k, + cases k, + { rw hyperoperation_ge_three_eq_one, }, + { rw [hyperoperation_recursion, nih], }, }, +end + +lemma hyperoperation_ge_four_zero (n k : ℕ) : + hyperoperation (n + 4) 0 k = if (even k) then 1 else 0 := +begin + induction k with kk kih, + { rw hyperoperation_ge_three_eq_one, + simp only [even_zero, if_true], }, + { rw hyperoperation_recursion, + rw kih, + simp_rw nat.even_add_one, + split_ifs, + { exact hyperoperation_ge_two_eq_self (n + 1) 0, }, + { exact hyperoperation_ge_three_eq_one n 0, }, }, +end diff --git a/src/data/nat/interval.lean b/src/data/nat/interval.lean index 4c78cfffd66ed..a7efc2bf8d370 100644 --- a/src/data/nat/interval.lean +++ b/src/data/nat/interval.lean @@ -8,6 +8,9 @@ import data.finset.locally_finite /-! # Finite intervals of naturals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves that `ℕ` is a `locally_finite_order` and calculates the cardinality of its intervals as finsets and fintypes. @@ -20,26 +23,26 @@ and subsequently be moved upstream to `data.finset.locally_finite`. open finset nat instance : locally_finite_order ℕ := -{ finset_Icc := λ a b, (list.range' a (b + 1 - a)).to_finset, - finset_Ico := λ a b, (list.range' a (b - a)).to_finset, - finset_Ioc := λ a b, (list.range' (a + 1) (b - a)).to_finset, - finset_Ioo := λ a b, (list.range' (a + 1) (b - a - 1)).to_finset, +{ finset_Icc := λ a b, ⟨list.range' a (b + 1 - a), list.nodup_range' _ _⟩, + finset_Ico := λ a b, ⟨list.range' a (b - a), list.nodup_range' _ _⟩, + finset_Ioc := λ a b, ⟨list.range' (a + 1) (b - a), list.nodup_range' _ _⟩, + finset_Ioo := λ a b, ⟨list.range' (a + 1) (b - a - 1), list.nodup_range' _ _⟩, finset_mem_Icc := λ a b x, begin - rw [list.mem_to_finset, list.mem_range'], + rw [finset.mem_mk, multiset.mem_coe, list.mem_range'], cases le_or_lt a b, { rw [add_tsub_cancel_of_le (nat.lt_succ_of_le h).le, nat.lt_succ_iff] }, { rw [tsub_eq_zero_iff_le.2 (succ_le_of_lt h), add_zero], exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2)) } end, finset_mem_Ico := λ a b x, begin - rw [list.mem_to_finset, list.mem_range'], + rw [finset.mem_mk, multiset.mem_coe, list.mem_range'], cases le_or_lt a b, { rw [add_tsub_cancel_of_le h] }, { rw [tsub_eq_zero_iff_le.2 h.le, add_zero], exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.trans hx.2.le)) } end, finset_mem_Ioc := λ a b x, begin - rw [list.mem_to_finset, list.mem_range'], + rw [finset.mem_mk, multiset.mem_coe, list.mem_range'], cases le_or_lt a b, { rw [←succ_sub_succ, add_tsub_cancel_of_le (succ_le_succ h), nat.lt_succ_iff, nat.succ_le_iff] }, @@ -47,7 +50,7 @@ instance : locally_finite_order ℕ := exact iff_of_false (λ hx, hx.2.not_le hx.1) (λ hx, h.not_le (hx.1.le.trans hx.2)) } end, finset_mem_Ioo := λ a b x, begin - rw [list.mem_to_finset, list.mem_range', ← tsub_add_eq_tsub_tsub], + rw [finset.mem_mk, multiset.mem_coe, list.mem_range', ← tsub_add_eq_tsub_tsub], cases le_or_lt (a + 1) b, { rw [add_tsub_cancel_of_le h, nat.succ_le_iff] }, { rw [tsub_eq_zero_iff_le.2 h.le, add_zero], @@ -58,10 +61,12 @@ variables (a b c : ℕ) namespace nat -lemma Icc_eq_range' : Icc a b = (list.range' a (b + 1 - a)).to_finset := rfl -lemma Ico_eq_range' : Ico a b = (list.range' a (b - a)).to_finset := rfl -lemma Ioc_eq_range' : Ioc a b = (list.range' (a + 1) (b - a)).to_finset := rfl -lemma Ioo_eq_range' : Ioo a b = (list.range' (a + 1) (b - a - 1)).to_finset := rfl +lemma Icc_eq_range' : Icc a b = ⟨list.range' a (b + 1 - a), list.nodup_range' _ _⟩ := rfl +lemma Ico_eq_range' : Ico a b = ⟨list.range' a (b - a), list.nodup_range' _ _⟩ := rfl +lemma Ioc_eq_range' : Ioc a b = ⟨list.range' (a + 1) (b - a), list.nodup_range' _ _⟩ := rfl +lemma Ioo_eq_range' : Ioo a b = ⟨list.range' (a + 1) (b - a - 1), list.nodup_range' _ _⟩ := rfl +lemma uIcc_eq_range' : + uIcc a b = ⟨list.range' (min a b) (max a b + 1 - min a b), list.nodup_range' _ _⟩ := rfl lemma Iio_eq_range : Iio = range := by { ext b x, rw [mem_Iio, mem_range] } @@ -69,20 +74,26 @@ lemma Iio_eq_range : Iio = range := by { ext b x, rw [mem_Iio, mem_range] } lemma _root_.finset.range_eq_Ico : range = Ico 0 := Ico_zero_eq_range.symm -@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a := -by rw [Icc_eq_range', list.card_to_finset, (list.nodup_range' _ _).dedup, list.length_range'] - -@[simp] lemma card_Ico : (Ico a b).card = b - a := -by rw [Ico_eq_range', list.card_to_finset, (list.nodup_range' _ _).dedup, list.length_range'] +@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a := list.length_range' _ _ +@[simp] lemma card_Ico : (Ico a b).card = b - a := list.length_range' _ _ +@[simp] lemma card_Ioc : (Ioc a b).card = b - a := list.length_range' _ _ +@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 := list.length_range' _ _ -@[simp] lemma card_Ioc : (Ioc a b).card = b - a := -by rw [Ioc_eq_range', list.card_to_finset, (list.nodup_range' _ _).dedup, list.length_range'] +@[simp] lemma card_uIcc : (uIcc a b).card = (b - a : ℤ).nat_abs + 1 := +begin + refine (card_Icc _ _).trans (int.coe_nat_inj _), + rw [sup_eq_max, inf_eq_min, int.coe_nat_sub], + { rw [add_comm, int.coe_nat_add, add_sub_assoc], + norm_cast, + push_cast, + rw [max_sub_min_eq_abs, add_comm] }, + { exact min_le_max.trans le_self_add } +end -@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 := -by rw [Ioo_eq_range', list.card_to_finset, (list.nodup_range' _ _).dedup, list.length_range'] +@[simp] lemma card_Iic : (Iic b).card = b + 1 := +by rw [Iic_eq_Icc, card_Icc, bot_eq_zero, tsub_zero] -@[simp] lemma card_Iic : (Iic b).card = b + 1 := by rw [Iic, card_Icc, bot_eq_zero, tsub_zero] -@[simp] lemma card_Iio : (Iio b).card = b := by rw [Iio, card_Ico, bot_eq_zero, tsub_zero] +@[simp] lemma card_Iio : (Iio b).card = b := by rw [Iio_eq_Ico, card_Ico, bot_eq_zero, tsub_zero] @[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a := by rw [fintype.card_of_finset, card_Icc] @@ -262,3 +273,42 @@ begin end end finset + +section induction + +variables {P : ℕ → Prop} (h : ∀ n, P (n + 1) → P n) + +include h + +lemma nat.decreasing_induction_of_not_bdd_above (hP : ¬ bdd_above {x | P x}) (n : ℕ) : P n := +let ⟨m, hm, hl⟩ := not_bdd_above_iff.1 hP n in decreasing_induction h hl.le hm + +lemma nat.decreasing_induction_of_infinite (hP : {x | P x}.infinite) (n : ℕ) : P n := +nat.decreasing_induction_of_not_bdd_above h (mt bdd_above.finite hP) n + +lemma nat.cauchy_induction' (seed : ℕ) (hs : P seed) + (hi : ∀ x, seed ≤ x → P x → ∃ y, x < y ∧ P y) (n : ℕ) : P n := +begin + apply nat.decreasing_induction_of_infinite h (λ hf, _), + obtain ⟨m, hP, hm⟩ := hf.exists_maximal_wrt id _ ⟨seed, hs⟩, + obtain ⟨y, hl, hy⟩ := hi m (le_of_not_lt $ λ hl, hl.ne $ hm seed hs hl.le) hP, + exact hl.ne (hm y hy hl.le), +end + +lemma nat.cauchy_induction (seed : ℕ) (hs : P seed) (f : ℕ → ℕ) + (hf : ∀ x, seed ≤ x → P x → x < f x ∧ P (f x)) (n : ℕ) : P n := +seed.cauchy_induction' h hs (λ x hl hx, ⟨f x, hf x hl hx⟩) n + +lemma nat.cauchy_induction_mul (k seed : ℕ) (hk : 1 < k) (hs : P seed.succ) + (hm : ∀ x, seed < x → P x → P (k * x)) (n : ℕ) : P n := +begin + apply nat.cauchy_induction h _ hs ((*) k) (λ x hl hP, ⟨_, hm x hl hP⟩), + convert (mul_lt_mul_right $ seed.succ_pos.trans_le hl).2 hk, + rw one_mul, +end + +lemma nat.cauchy_induction_two_mul (seed : ℕ) (hs : P seed.succ) + (hm : ∀ x, seed < x → P x → P (2 * x)) (n : ℕ) : P n := +nat.cauchy_induction_mul h 2 seed one_lt_two hs hm n + +end induction diff --git a/src/data/nat/lattice.lean b/src/data/nat/lattice.lean index 2e0578ba30d21..61ff4e7e97e7e 100644 --- a/src/data/nat/lattice.lean +++ b/src/data/nat/lattice.lean @@ -3,16 +3,18 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Johannes Hölzl, Floris van Doorn, Gabriel Ebner, Yury Kudryashov -/ -import data.nat.enat -import order.conditionally_complete_lattice +import data.nat.interval +import order.conditionally_complete_lattice.finset /-! # Conditionally complete linear order structure on `ℕ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we * define a `conditionally_complete_linear_order_bot` structure on `ℕ`; -* define a `complete_linear_order` structure on `enat`; * prove a few lemmas about `supr`/`infi`/`set.Union`/`set.Inter` and natural numbers. -/ @@ -36,20 +38,22 @@ lemma Sup_def {s : set ℕ} (h : ∃n, ∀a∈s, a ≤ n) : dif_pos _ lemma _root_.set.infinite.nat.Sup_eq_zero {s : set ℕ} (h : s.infinite) : Sup s = 0 := -dif_neg $ λ ⟨n, hn⟩, let ⟨k, hks, hk⟩ := h.exists_nat_lt n in (hn k hks).not_lt hk +dif_neg $ λ ⟨n, hn⟩, let ⟨k, hks, hk⟩ := h.exists_gt n in (hn k hks).not_lt hk @[simp] lemma Inf_eq_zero {s : set ℕ} : Inf s = 0 ↔ 0 ∈ s ∨ s = ∅ := begin cases eq_empty_or_nonempty s, { subst h, simp only [or_true, eq_self_iff_true, iff_true, Inf, has_Inf.Inf, - mem_empty_eq, exists_false, dif_neg, not_false_iff] }, - { have := ne_empty_iff_nonempty.mpr h, - simp only [this, or_false, nat.Inf_def, h, nat.find_eq_zero] } + mem_empty_iff_false, exists_false, dif_neg, not_false_iff] }, + { simp only [h.ne_empty, or_false, nat.Inf_def, h, nat.find_eq_zero] } end @[simp] lemma Inf_empty : Inf ∅ = 0 := by { rw Inf_eq_zero, right, refl } +@[simp] lemma infi_of_empty {ι : Sort*} [is_empty ι] (f : ι → ℕ) : infi f = 0 := +by rw [infi_of_empty', Inf_empty] + lemma Inf_mem {s : set ℕ} (h : s.nonempty) : Inf s ∈ s := by { rw [nat.Inf_def h], exact nat.find_spec h } @@ -103,7 +107,7 @@ noncomputable instance : conditionally_complete_linear_order_bot ℕ := cInf_le := assume s a hb ha, by rw [Inf_def ⟨a, ha⟩]; exact nat.find_min' _ ha, cSup_empty := begin - simp only [Sup_def, set.mem_empty_eq, forall_const, forall_prop_of_false, not_false_iff, + simp only [Sup_def, set.mem_empty_iff_false, forall_const, forall_prop_of_false, not_false_iff, exists_const], apply bot_unique (nat.find_min' _ _), trivial @@ -111,6 +115,9 @@ noncomputable instance : conditionally_complete_linear_order_bot ℕ := .. (infer_instance : order_bot ℕ), .. (linear_order.to_lattice : lattice ℕ), .. (infer_instance : linear_order ℕ) } +lemma Sup_mem {s : set ℕ} (h₁ : s.nonempty) (h₂ : bdd_above s) : Sup s ∈ s := +let ⟨k, hk⟩ := h₂ in h₁.cSup_mem ((finite_le_nat k).subset hk) + lemma Inf_add {n : ℕ} {p : ℕ → Prop} (hn : n ≤ Inf {m | p m}) : Inf {m | p (m + n)} + n = Inf {m | p m} := begin @@ -178,19 +185,3 @@ lemma bInter_lt_succ' (u : ℕ → set α) (n : ℕ) : (⋂ k < n + 1, u k) = u nat.infi_lt_succ' u n end set - -namespace enat -open_locale classical - -noncomputable instance : complete_linear_order enat := -{ inf := (⊓), - sup := (⊔), - top := ⊤, - bot := ⊥, - le := (≤), - lt := (<), - .. enat.lattice, - .. with_top_order_iso.symm.to_galois_insertion.lift_complete_lattice, - .. enat.linear_order, } - -end enat diff --git a/src/data/nat/log.lean b/src/data/nat/log.lean index 1d4a5049bf512..97c2d88aa2d8f 100644 --- a/src/data/nat/log.lean +++ b/src/data/nat/log.lean @@ -9,6 +9,9 @@ import tactic.by_contra /-! # Natural number logarithms +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines two `ℕ`-valued analogs of the logarithm of `n` with base `b`: * `log b n`: Lower logarithm, or floor **log**. Greatest `k` such that `b^k ≤ n`. * `clog b n`: Upper logarithm, or **c**eil **log**. Least `k` such that `n ≤ b^k`. @@ -31,175 +34,162 @@ such that `b^k ≤ n`, so if `b^k = n`, it returns exactly `k`. -/ log (n / b) + 1 else 0 -private lemma log_eq_zero_aux {b n : ℕ} (hnb : n < b ∨ b ≤ 1) : log b n = 0 := +@[simp] lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 := begin - rw [or_iff_not_and_not, not_lt, not_le] at hnb, - rw [log, ←ite_not, if_pos hnb] + rw [log, ite_eq_right_iff], + simp only [nat.succ_ne_zero, imp_false, decidable.not_and_distrib, not_le, not_lt] end lemma log_of_lt {b n : ℕ} (hb : n < b) : log b n = 0 := -log_eq_zero_aux (or.inl hb) +log_eq_zero_iff.2 (or.inl hb) lemma log_of_left_le_one {b : ℕ} (hb : b ≤ 1) (n) : log b n = 0 := -log_eq_zero_aux (or.inr hb) - -lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 := -by { rw log, exact if_pos ⟨hn, h⟩ } - -lemma log_eq_zero_iff {b n : ℕ} : log b n = 0 ↔ n < b ∨ b ≤ 1 := -⟨λ h_log, begin - by_contra' h, - have := log_of_one_lt_of_le h.2 h.1, - rw h_log at this, - exact succ_ne_zero _ this.symm -end, log_eq_zero_aux⟩ - -lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n := --- This is best possible: if b = 2, n = 5, then 1 < b and b ≤ n but n > b * b. -begin - refine ⟨λ h_log, _, _⟩, - { have bound : 1 < b ∧ b ≤ n, - { contrapose h_log, - rw [not_and_distrib, not_lt, not_le, or_comm, ←log_eq_zero_iff] at h_log, - rw h_log, - exact nat.zero_ne_one, }, - cases bound with one_lt_b b_le_n, - refine ⟨_, one_lt_b, b_le_n⟩, - rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj', - log_eq_zero_iff, nat.div_lt_iff_lt_mul _ _ (lt_trans zero_lt_one one_lt_b)] at h_log, - exact h_log.resolve_right (λ b_small, lt_irrefl _ (lt_of_lt_of_le one_lt_b b_small)), }, - { rintros ⟨h, one_lt_b, b_le_n⟩, - rw [log_of_one_lt_of_le one_lt_b b_le_n, succ_inj', - log_eq_zero_iff, nat.div_lt_iff_lt_mul _ _ (lt_trans zero_lt_one one_lt_b)], - exact or.inl h, }, -end +log_eq_zero_iff.2 (or.inr hb) -@[simp] lemma log_zero_left : ∀ n, log 0 n = 0 := -log_of_left_le_one zero_le_one +@[simp] lemma log_pos_iff {b n : ℕ} : 0 < log b n ↔ b ≤ n ∧ 1 < b := +by rw [pos_iff_ne_zero, ne.def, log_eq_zero_iff, not_or_distrib, not_lt, not_le] -@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 := -by { rw log, cases b; refl } +lemma log_pos {b n : ℕ} (hb : 1 < b) (hbn : b ≤ n) : 0 < log b n := log_pos_iff.2 ⟨hbn, hb⟩ -@[simp] lemma log_one_left : ∀ n, log 1 n = 0 := -log_of_left_le_one le_rfl +lemma log_of_one_lt_of_le {b n : ℕ} (h : 1 < b) (hn : b ≤ n) : log b n = log b (n / b) + 1 := +by { rw log, exact if_pos ⟨hn, h⟩ } -@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 := -if h : b ≤ 1 then - log_of_left_le_one h 1 -else - log_of_lt (not_le.mp h) +@[simp] lemma log_zero_left : ∀ n, log 0 n = 0 := log_of_left_le_one zero_le_one +@[simp] lemma log_zero_right (b : ℕ) : log b 0 = 0 := log_eq_zero_iff.2 (le_total 1 b) +@[simp] lemma log_one_left : ∀ n, log 1 n = 0 := log_of_left_le_one le_rfl +@[simp] lemma log_one_right (b : ℕ) : log b 1 = 0 := log_eq_zero_iff.2 (lt_or_le _ _) -/-- `pow b` and `log b` (almost) form a Galois connection. -/ -lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) : b ^ x ≤ y ↔ x ≤ log b y := +/-- `pow b` and `log b` (almost) form a Galois connection. See also `nat.pow_le_of_le_log` and +`nat.le_log_of_pow_le` for individual implications under weaker assumptions. -/ +lemma pow_le_iff_le_log {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : b ^ x ≤ y ↔ x ≤ log b y := begin induction y using nat.strong_induction_on with y ih generalizing x, cases x, - { exact iff_of_true hy (zero_le _) }, + { exact iff_of_true hy.bot_lt (zero_le _) }, rw log, split_ifs, { have b_pos : 0 < b := zero_le_one.trans_lt hb, - rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy hb) - (nat.div_pos h.1 b_pos), le_div_iff_mul_le _ _ b_pos, pow_succ'] }, - { refine iff_of_false (λ hby, h ⟨le_trans _ hby, hb⟩) (not_succ_le_zero _), - convert pow_mono hb.le (zero_lt_succ x), - exact (pow_one b).symm } + rw [succ_eq_add_one, add_le_add_iff_right, ←ih (y / b) (div_lt_self hy.bot_lt hb) + (nat.div_pos h.1 b_pos).ne', le_div_iff_mul_le b_pos, pow_succ'] }, + { exact iff_of_false (λ hby, h ⟨(le_self_pow x.succ_ne_zero _).trans hby, hb⟩) + (not_succ_le_zero _) } end -lemma lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : 0 < y) : y < b ^ x ↔ log b y < x := +lemma lt_pow_iff_log_lt {b : ℕ} (hb : 1 < b) {x y : ℕ} (hy : y ≠ 0) : y < b ^ x ↔ log b y < x := lt_iff_lt_of_le_iff_le (pow_le_iff_le_log hb hy) -lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x := -eq_of_forall_le_iff $ λ z, -by { rw ←pow_le_iff_le_log hb (pow_pos (zero_lt_one.trans hb) _), - exact (pow_right_strict_mono hb).le_iff_le } - -lemma log_pos {b n : ℕ} (hb : 1 < b) (hn : b ≤ n) : 0 < log b n := -by { rwa [←succ_le_iff, ←pow_le_iff_le_log hb (hb.le.trans hn), pow_one] } +lemma pow_le_of_le_log {b x y : ℕ} (hy : y ≠ 0) (h : x ≤ log b y) : b ^ x ≤ y := +begin + refine (le_or_lt b 1).elim (λ hb, _) (λ hb, (pow_le_iff_le_log hb hy).2 h), + rw [log_of_left_le_one hb, nonpos_iff_eq_zero] at h, + rwa [h, pow_zero, one_le_iff_ne_zero] +end -lemma log_mul_base (b n : ℕ) (hb : 1 < b) (hn : 0 < n) : log b (n * b) = log b n + 1 := -eq_of_forall_le_iff $ λ z, +lemma le_log_of_pow_le {b x y : ℕ} (hb : 1 < b) (h : b ^ x ≤ y) : x ≤ log b y := begin - cases z, - { simp }, - have : 0 < b := zero_lt_one.trans hb, - rw [←pow_le_iff_le_log hb, pow_succ', (strict_mono_mul_right_of_pos this).le_iff_le, - pow_le_iff_le_log hb hn, nat.succ_le_succ_iff], - simp [hn, this] + rcases ne_or_eq y 0 with hy | rfl, + exacts [(pow_le_iff_le_log hb hy).1 h, (h.not_lt (pow_pos (zero_lt_one.trans hb) _)).elim] end +lemma pow_log_le_self (b : ℕ) {x : ℕ} (hx : x ≠ 0) : b ^ log b x ≤ x := +pow_le_of_le_log hx le_rfl + +lemma log_lt_of_lt_pow {b x y : ℕ} (hy : y ≠ 0) : y < b ^ x → log b y < x := +lt_imp_lt_of_le_imp_le (pow_le_of_le_log hy) + +lemma lt_pow_of_log_lt {b x y : ℕ} (hb : 1 < b) : log b y < x → y < b ^ x := +lt_imp_lt_of_le_imp_le (le_log_of_pow_le hb) + lemma lt_pow_succ_log_self {b : ℕ} (hb : 1 < b) (x : ℕ) : x < b ^ (log b x).succ := +lt_pow_of_log_lt hb (lt_succ_self _) + +lemma log_eq_iff {b m n : ℕ} (h : m ≠ 0 ∨ 1 < b ∧ n ≠ 0) : + log b n = m ↔ b ^ m ≤ n ∧ n < b ^ (m + 1) := begin - cases x.eq_zero_or_pos with hx hx, - { simp only [hx, log_zero_right, pow_one], - exact pos_of_gt hb }, - rw [←not_le, pow_le_iff_le_log hb hx, not_le], - exact lt_succ_self _, + rcases em (1 < b ∧ n ≠ 0) with ⟨hb, hn⟩|hbn, + { rw [le_antisymm_iff, ← lt_succ_iff, ← pow_le_iff_le_log, ← lt_pow_iff_log_lt, and.comm]; + assumption }, + { have hm : m ≠ 0, from h.resolve_right hbn, + rw [not_and_distrib, not_lt, ne.def, not_not] at hbn, + rcases hbn with hb|rfl, + { simpa only [log_of_left_le_one hb, hm.symm, false_iff, not_and, not_lt] + using le_trans (pow_le_pow_of_le_one' hb m.le_succ) }, + { simpa only [log_zero_right, hm.symm, false_iff, not_and, not_lt, le_zero_iff, pow_succ] + using mul_eq_zero_of_right _ } } end -lemma pow_log_le_self {b : ℕ} (hb : 1 < b) {x : ℕ} (hx : 0 < x) : b ^ log b x ≤ x := -(pow_le_iff_le_log hb hx).2 le_rfl +lemma log_eq_of_pow_le_of_lt_pow {b m n : ℕ} (h₁ : b ^ m ≤ n) (h₂ : n < b ^ (m + 1)) : + log b n = m := +begin + rcases eq_or_ne m 0 with rfl | hm, + { rw [pow_one] at h₂, exact log_of_lt h₂ }, + { exact (log_eq_iff (or.inl hm)).2 ⟨h₁, h₂⟩ } +end -@[mono] lemma log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m := +lemma log_pow {b : ℕ} (hb : 1 < b) (x : ℕ) : log b (b ^ x) = x := +log_eq_of_pow_le_of_lt_pow le_rfl (pow_lt_pow hb x.lt_succ_self) + +lemma log_eq_one_iff' {b n : ℕ} : log b n = 1 ↔ b ≤ n ∧ n < b * b:= +by rw [log_eq_iff (or.inl one_ne_zero), pow_add, pow_one] + +lemma log_eq_one_iff {b n : ℕ} : log b n = 1 ↔ n < b * b ∧ 1 < b ∧ b ≤ n := +log_eq_one_iff'.trans ⟨λ h, ⟨h.2, lt_mul_self_iff.1 (h.1.trans_lt h.2), h.1⟩, λ h, ⟨h.2.2, h.1⟩⟩ + +lemma log_mul_base {b n : ℕ} (hb : 1 < b) (hn : n ≠ 0) : log b (n * b) = log b n + 1 := begin + apply log_eq_of_pow_le_of_lt_pow; rw [pow_succ'], + exacts [mul_le_mul_right' (pow_log_le_self _ hn) _, + (mul_lt_mul_right (zero_lt_one.trans hb)).2 (lt_pow_succ_log_self hb _)] +end + +lemma pow_log_le_add_one (b : ℕ) : ∀ x, b ^ log b x ≤ x + 1 +| 0 := by rw [log_zero_right, pow_zero] +| (x + 1) := (pow_log_le_self b x.succ_ne_zero).trans (x + 1).le_succ + +lemma log_monotone {b : ℕ} : monotone (log b) := +begin + refine monotone_nat_of_le_succ (λ n, _), cases le_or_lt b 1 with hb hb, { rw log_of_left_le_one hb, exact zero_le _ }, - { cases nat.eq_zero_or_pos n with hn hn, - { rw [hn, log_zero_right], exact zero_le _ }, - { rw ←pow_le_iff_le_log hb (hn.trans_le h), - exact (pow_log_le_self hb hn).trans h } } + { exact le_log_of_pow_le hb (pow_log_le_add_one _ _) } end +@[mono] lemma log_mono_right {b n m : ℕ} (h : n ≤ m) : log b n ≤ log b m := +log_monotone h + @[mono] lemma log_anti_left {b c n : ℕ} (hc : 1 < c) (hb : c ≤ b) : log b n ≤ log c n := begin - cases n, { rw [log_zero_right, log_zero_right] }, - rw ←pow_le_iff_le_log hc (zero_lt_succ n), - calc c ^ log b n.succ ≤ b ^ log b n.succ : pow_le_pow_of_le_left - (zero_lt_one.trans hc).le hb _ - ... ≤ n.succ : pow_log_le_self (hc.trans_le hb) - (zero_lt_succ n) + rcases eq_or_ne n 0 with rfl | hn, { rw [log_zero_right, log_zero_right] }, + apply le_log_of_pow_le hc, + calc c ^ log b n ≤ b ^ log b n : pow_le_pow_of_le_left' hb _ + ... ≤ n : pow_log_le_self _ hn end -lemma log_monotone {b : ℕ} : monotone (log b) := -λ x y, log_mono_right - lemma log_antitone_left {n : ℕ} : antitone_on (λ b, log b n) (set.Ioi 1) := λ _ hc _ _ hb, log_anti_left (set.mem_Iio.1 hc) hb -@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n := -eq_of_forall_le_iff (λ z, ⟨λ h, h.trans (log_monotone (div_mul_le_self _ _)), λ h, begin - rcases b with _|_|b, - { rwa log_zero_left at * }, - { rwa log_one_left at * }, - rcases n.zero_le.eq_or_lt with rfl|hn, - { rwa [nat.zero_div, zero_mul] }, - cases le_or_lt b.succ.succ n with hb hb, - { cases z, - { apply zero_le }, - rw [←pow_le_iff_le_log, pow_succ'] at h ⊢, - { rwa [(strict_mono_mul_right_of_pos nat.succ_pos').le_iff_le, - nat.le_div_iff_mul_le _ _ nat.succ_pos'] }, - all_goals { simp [hn, nat.div_pos hb nat.succ_pos'] } }, - { simpa [div_eq_of_lt, hb, log_of_lt] using h } -end⟩) - @[simp] lemma log_div_base (b n : ℕ) : log b (n / b) = log b n - 1 := begin + cases le_or_lt b 1 with hb hb, + { rw [log_of_left_le_one hb, log_of_left_le_one hb, nat.zero_sub] }, cases lt_or_le n b with h h, { rw [div_eq_of_lt h, log_of_lt h, log_zero_right] }, - rcases n.zero_le.eq_or_lt with rfl|hn, - { rw [nat.zero_div, log_zero_right] }, - rcases b with _|_|b, - { rw [log_zero_left, log_zero_left] }, - { rw [log_one_left, log_one_left] }, - rw [←succ_inj', ←succ_inj'], - simp_rw succ_eq_add_one, - rw [nat.sub_add_cancel, ←log_mul_base]; - { simp [succ_le_iff, log_pos, h, nat.div_pos] }, + rw [log_of_one_lt_of_le hb h, add_tsub_cancel_right] +end + +@[simp] lemma log_div_mul_self (b n : ℕ) : log b (n / b * b) = log b n := +begin + cases le_or_lt b 1 with hb hb, + { rw [log_of_left_le_one hb, log_of_left_le_one hb] }, + cases lt_or_le n b with h h, + { rw [div_eq_of_lt h, zero_mul, log_zero_right, log_of_lt h] }, + rw [log_mul_base hb (nat.div_pos h (zero_le_one.trans_lt hb)).ne', log_div_base, + tsub_add_cancel_of_le (succ_le_iff.2 $ log_pos hb h)] end private lemma add_pred_div_lt {b n : ℕ} (hb : 1 < b) (hn : 2 ≤ n) : (n + b - 1) / b < n := begin - rw [div_lt_iff_lt_mul _ _ (zero_lt_one.trans hb), ←succ_le_iff, ←pred_eq_sub_one, + rw [div_lt_iff_lt_mul (zero_lt_one.trans hb), ←succ_le_iff, ←pred_eq_sub_one, succ_pred_eq_of_pos (add_pos (zero_lt_one.trans hn) (zero_lt_one.trans hb))], exact add_le_mul hn hb, end @@ -244,7 +234,7 @@ lemma clog_eq_one {b n : ℕ} (hn : 2 ≤ n) (h : n ≤ b) : clog b n = 1 := begin rw [clog_of_two_le (hn.trans h) hn, clog_of_right_le_one], have n_pos : 0 < n := zero_lt_two.trans_le hn, - rw [←lt_succ_iff, nat.div_lt_iff_lt_mul _ _ (n_pos.trans_le h), ←succ_le_iff, + rw [←lt_succ_iff, nat.div_lt_iff_lt_mul (n_pos.trans_le h), ←succ_le_iff, ←pred_eq_sub_one, succ_pred_eq_of_pos (add_pos n_pos (n_pos.trans_le h)), succ_mul, one_mul], exact add_le_add_right h _, end @@ -315,7 +305,7 @@ begin cases n, { rw log_zero_right, exact zero_le _}, - exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self hb $ succ_pos _).trans $ + exact (pow_right_strict_mono hb).le_iff_le.1 ((pow_log_le_self b n.succ_ne_zero).trans $ le_pow_clog hb _), end diff --git a/src/data/nat/modeq.lean b/src/data/nat/modeq.lean index d77d291e3d6dd..3ac75bbcc4506 100644 --- a/src/data/nat/modeq.lean +++ b/src/data/nat/modeq.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import data.int.gcd -import data.list.rotate import tactic.abel /-! # Congruences modulo a natural number +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the equivalence relation `a ≡ b [MOD n]` on the natural numbers, and proves basic properties about it such as the Chinese Remainder Theorem `modeq_and_modeq_iff_modeq_mul`. @@ -39,6 +41,8 @@ namespace modeq protected theorem rfl : a ≡ a [MOD n] := modeq.refl _ +instance : is_refl _ (modeq n) := ⟨modeq.refl⟩ + @[symm] protected theorem symm : a ≡ b [MOD n] → b ≡ a [MOD n] := eq.symm @[trans] protected theorem trans : a ≡ b [MOD n] → b ≡ c [MOD n] → a ≡ c [MOD n] := eq.trans @@ -57,8 +61,7 @@ theorem modeq_iff_dvd : a ≡ b [MOD n] ↔ (n:ℤ) ∣ b - a := by rw [modeq, eq_comm, ← int.coe_nat_inj', int.coe_nat_mod, int.coe_nat_mod, int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero] -protected theorem modeq.dvd : a ≡ b [MOD n] → (n:ℤ) ∣ b - a := modeq_iff_dvd.1 -theorem modeq_of_dvd : (n:ℤ) ∣ b - a → a ≡ b [MOD n] := modeq_iff_dvd.2 +alias modeq_iff_dvd ↔ modeq.dvd modeq_of_dvd /-- A variant of `modeq_iff_dvd` with `nat` divisibility -/ theorem modeq_iff_dvd' (h : a ≤ b) : a ≡ b [MOD n] ↔ n ∣ b - a := @@ -68,14 +71,14 @@ theorem mod_modeq (a n) : a % n ≡ a [MOD n] := mod_mod _ _ namespace modeq -protected theorem modeq_of_dvd (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] := +protected theorem of_dvd (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] := modeq_of_dvd ((int.coe_nat_dvd.2 d).trans h.dvd) protected theorem mul_left' (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD (c * n)] := by unfold modeq at *; rw [mul_mod_mul_left, mul_mod_mul_left, h] protected theorem mul_left (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD n] := -(h.mul_left' _ ).modeq_of_dvd (dvd_mul_left _ _) +(h.mul_left' _ ).of_dvd (dvd_mul_left _ _) protected theorem mul_right' (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD (n * c)] := by rw [mul_comm a, mul_comm b, mul_comm n]; exact h.mul_left' c @@ -95,7 +98,7 @@ end protected theorem add (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a + c ≡ b + d [MOD n] := begin - rw [modeq_iff_dvd, int.coe_nat_add, int.coe_nat_add, add_sub_comm], + rw [modeq_iff_dvd, int.coe_nat_add, int.coe_nat_add, add_sub_add_comm], exact dvd_add h₁.dvd h₂.dvd, end @@ -109,7 +112,7 @@ protected theorem add_left_cancel (h₁ : a ≡ b [MOD n]) (h₂ : a + c ≡ b + c ≡ d [MOD n] := begin simp only [modeq_iff_dvd, int.coe_nat_add] at *, - rw add_sub_comm at h₂, + rw add_sub_add_comm at h₂, convert _root_.dvd_sub h₂ h₁ using 1, rw add_sub_cancel', end @@ -124,6 +127,9 @@ by { rw [add_comm a, add_comm b] at h₂, exact h₁.add_left_cancel h₂ } protected theorem add_right_cancel' (c : ℕ) (h : a + c ≡ b + c [MOD n]) : a ≡ b [MOD n] := modeq.rfl.add_right_cancel h +/-- Cancel left multiplication on both sides of the `≡` and in the modulus. + +For cancelling left multiplication in the modulus, see `nat.modeq.of_mul_left`. -/ protected theorem mul_left_cancel' {a b c m : ℕ} (hc : c ≠ 0) : c * a ≡ c * b [MOD c * m] → a ≡ b [MOD m] := by simp [modeq_iff_dvd, ←mul_sub, mul_dvd_mul_iff_left (by simp [hc] : (c : ℤ) ≠ 0)] @@ -132,6 +138,9 @@ protected theorem mul_left_cancel_iff' {a b c m : ℕ} (hc : c ≠ 0) : c * a ≡ c * b [MOD c * m] ↔ a ≡ b [MOD m] := ⟨modeq.mul_left_cancel' hc, modeq.mul_left' _⟩ +/-- Cancel right multiplication on both sides of the `≡` and in the modulus. + +For cancelling right multiplication in the modulus, see `nat.modeq.of_mul_right`. -/ protected theorem mul_right_cancel' {a b c m : ℕ} (hc : c ≠ 0) : a * c ≡ b * c [MOD m * c] → a ≡ b [MOD m] := by simp [modeq_iff_dvd, ←sub_mul, mul_dvd_mul_iff_right (by simp [hc] : (c : ℤ) ≠ 0)] @@ -140,26 +149,31 @@ protected theorem mul_right_cancel_iff' {a b c m : ℕ} (hc : c ≠ 0) : a * c ≡ b * c [MOD m * c] ↔ a ≡ b [MOD m] := ⟨modeq.mul_right_cancel' hc, modeq.mul_right' _⟩ -theorem of_modeq_mul_left (m : ℕ) (h : a ≡ b [MOD m * n]) : a ≡ b [MOD n] := +/-- Cancel left multiplication in the modulus. + +For cancelling left multiplication on both sides of the `≡`, see `nat.modeq.mul_left_cancel'`. -/ +theorem of_mul_left (m : ℕ) (h : a ≡ b [MOD m * n]) : a ≡ b [MOD n] := by { rw [modeq_iff_dvd] at *, exact (dvd_mul_left (n : ℤ) (m : ℤ)).trans h } -theorem of_modeq_mul_right (m : ℕ) : a ≡ b [MOD n * m] → a ≡ b [MOD n] := -mul_comm m n ▸ of_modeq_mul_left _ +/-- Cancel right multiplication in the modulus. + +For cancelling right multiplication on both sides of the `≡`, see `nat.modeq.mul_right_cancel'`. -/ +theorem of_mul_right (m : ℕ) : a ≡ b [MOD n * m] → a ≡ b [MOD n] := mul_comm m n ▸ of_mul_left _ + +lemma of_div (h : a / c ≡ b / c [MOD m / c]) (ha : c ∣ a) (ha : c ∣ b) (ha : c ∣ m) : + a ≡ b [MOD m] := +by convert h.mul_left' c; rwa nat.mul_div_cancel' end modeq -theorem modeq_one : a ≡ b [MOD 1] := modeq_of_dvd (one_dvd _) +lemma modeq_sub (h : b ≤ a) : a ≡ b [MOD a - b] := (modeq_of_dvd $ by rw [int.coe_nat_sub h]).symm -lemma modeq_sub (h : b ≤ a) : a ≡ b [MOD a - b] := -(modeq_of_dvd $ by rw [int.coe_nat_sub h]).symm +lemma modeq_one : a ≡ b [MOD 1] := modeq_of_dvd $ one_dvd _ -@[simp] lemma modeq_zero_iff {a b : ℕ} : a ≡ b [MOD 0] ↔ a = b := -by rw [nat.modeq, nat.mod_zero, nat.mod_zero] +@[simp] lemma modeq_zero_iff : a ≡ b [MOD 0] ↔ a = b := by rw [modeq, mod_zero, mod_zero] -@[simp] lemma add_modeq_left {a n : ℕ} : n + a ≡ a [MOD n] := -by rw [nat.modeq, nat.add_mod_left] -@[simp] lemma add_modeq_right {a n : ℕ} : a + n ≡ a [MOD n] := -by rw [nat.modeq, nat.add_mod_right] +@[simp] lemma add_modeq_left : n + a ≡ a [MOD n] := by rw [modeq, add_mod_left] +@[simp] lemma add_modeq_right : a + n ≡ a [MOD n] := by rw [modeq, add_mod_right] namespace modeq @@ -170,33 +184,36 @@ lemma le_of_lt_add (h1 : a ≡ b [MOD m]) (h2 : a < b + m) : a ≤ b := lemma add_le_of_lt (h1 : a ≡ b [MOD m]) (h2 : a < b) : a + m ≤ b := le_of_lt_add (add_modeq_right.trans h1) (add_lt_add_right h2 m) -lemma dvd_iff_of_modeq_of_dvd {a b d m : ℕ} (h : a ≡ b [MOD m]) (hdm : d ∣ m) : - d ∣ a ↔ d ∣ b := +lemma dvd_iff (h : a ≡ b [MOD m]) (hdm : d ∣ m) : d ∣ a ↔ d ∣ b := begin simp only [←modeq_zero_iff_dvd], - replace h := h.modeq_of_dvd hdm, + replace h := h.of_dvd hdm, exact ⟨h.symm.trans, h.trans⟩, end -lemma gcd_eq_of_modeq {a b m : ℕ} (h : a ≡ b [MOD m]) : gcd a m = gcd b m := +lemma gcd_eq (h : a ≡ b [MOD m]) : gcd a m = gcd b m := begin have h1 := gcd_dvd_right a m, have h2 := gcd_dvd_right b m, exact dvd_antisymm - (dvd_gcd ((dvd_iff_of_modeq_of_dvd h h1).mp (gcd_dvd_left a m)) h1) - (dvd_gcd ((dvd_iff_of_modeq_of_dvd h h2).mpr (gcd_dvd_left b m)) h2), + (dvd_gcd ((h.dvd_iff h1).mp (gcd_dvd_left a m)) h1) + (dvd_gcd ((h.dvd_iff h2).mpr (gcd_dvd_left b m)) h2), end -lemma eq_of_modeq_of_abs_lt {a b m : ℕ} (h : a ≡ b [MOD m]) (h2 : | (b:ℤ) - a | < m) : a = b := +lemma eq_of_abs_lt (h : a ≡ b [MOD m]) (h2 : |(b - a : ℤ)| < m) : a = b := begin apply int.coe_nat_inj, rw [eq_comm, ←sub_eq_zero], exact int.eq_zero_of_abs_lt_dvd (modeq_iff_dvd.mp h) h2, end +lemma eq_of_lt_of_lt (h : a ≡ b [MOD m]) (ha : a < m) (hb : b < m) : a = b := +h.eq_of_abs_lt $ abs_sub_lt_iff.2 + ⟨(sub_le_self _ $ int.coe_nat_nonneg _).trans_lt $ cast_lt.2 hb, + (sub_le_self _ $ int.coe_nat_nonneg _).trans_lt $ cast_lt.2 ha⟩ + /-- To cancel a common factor `c` from a `modeq` we must divide the modulus `m` by `gcd m c` -/ -lemma modeq_cancel_left_div_gcd {a b c m : ℕ} (hm : 0 < m) (h : c * a ≡ c * b [MOD m]) : - a ≡ b [MOD m / gcd m c] := +lemma cancel_left_div_gcd (hm : 0 < m) (h : c * a ≡ c * b [MOD m]) : a ≡ b [MOD m / gcd m c] := begin let d := gcd m c, have hmd := gcd_dvd_left m c, @@ -213,40 +230,33 @@ begin nat.div_self (gcd_pos_of_pos_left c hm)] }, end -lemma modeq_cancel_right_div_gcd {a b c m : ℕ} (hm : 0 < m) (h : a * c ≡ b * c [MOD m]) : - a ≡ b [MOD m / gcd m c] := -by { apply modeq_cancel_left_div_gcd hm, simpa [mul_comm] using h } +lemma cancel_right_div_gcd (hm : 0 < m) (h : a * c ≡ b * c [MOD m]) : a ≡ b [MOD m / gcd m c] := +by { apply cancel_left_div_gcd hm, simpa [mul_comm] using h } -lemma modeq_cancel_left_div_gcd' {a b c d m : ℕ} (hm : 0 < m) (hcd : c ≡ d [MOD m]) - (h : c * a ≡ d * b [MOD m]) : +lemma cancel_left_div_gcd' (hm : 0 < m) (hcd : c ≡ d [MOD m]) (h : c * a ≡ d * b [MOD m]) : a ≡ b [MOD m / gcd m c] := -modeq_cancel_left_div_gcd hm (h.trans (modeq.mul_right b hcd).symm) +(h.trans (modeq.mul_right b hcd).symm).cancel_left_div_gcd hm -lemma modeq_cancel_right_div_gcd' {a b c d m : ℕ} (hm : 0 < m) (hcd : c ≡ d [MOD m]) - (h : a * c ≡ b * d [MOD m]) : +lemma cancel_right_div_gcd' (hm : 0 < m) (hcd : c ≡ d [MOD m]) (h : a * c ≡ b * d [MOD m]) : a ≡ b [MOD m / gcd m c] := -by { apply modeq_cancel_left_div_gcd' hm hcd, simpa [mul_comm] using h } +hcd.cancel_left_div_gcd' hm $ by simpa [mul_comm] using h /-- A common factor that's coprime with the modulus can be cancelled from a `modeq` -/ -lemma modeq_cancel_left_of_coprime {a b c m : ℕ} (hmc : gcd m c = 1) (h : c * a ≡ c * b [MOD m]) : - a ≡ b [MOD m] := +lemma cancel_left_of_coprime (hmc : gcd m c = 1) (h : c * a ≡ c * b [MOD m]) : a ≡ b [MOD m] := begin rcases m.eq_zero_or_pos with rfl | hm, { simp only [gcd_zero_left] at hmc, simp only [gcd_zero_left, hmc, one_mul, modeq_zero_iff] at h, subst h }, - simpa [hmc] using modeq_cancel_left_div_gcd hm h + simpa [hmc] using h.cancel_left_div_gcd hm end /-- A common factor that's coprime with the modulus can be cancelled from a `modeq` -/ -lemma modeq_cancel_right_of_coprime {a b c m : ℕ} (hmc : gcd m c = 1) (h : a * c ≡ b * c [MOD m]) : - a ≡ b [MOD m] := -by { apply modeq_cancel_left_of_coprime hmc, simpa [mul_comm] using h } +lemma cancel_right_of_coprime (hmc : gcd m c = 1) (h : a * c ≡ b * c [MOD m]) : a ≡ b [MOD m] := +cancel_left_of_coprime hmc $ by simpa [mul_comm] using h end modeq -local attribute [semireducible] int.nonneg - /-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/ def chinese_remainder' (h : a ≡ b [MOD gcd n m]) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} := if hn : n = 0 then ⟨a, begin rw [hn, gcd_zero_left] at h, split, refl, exact h end⟩ else @@ -304,28 +314,28 @@ lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℕ} (hmn : coprime m n) : rw [nat.modeq_iff_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd], exact hmn.mul_dvd_of_dvd_of_dvd h.1 h.2 end, -λ h, ⟨h.of_modeq_mul_right _, h.of_modeq_mul_left _⟩⟩ +λ h, ⟨h.of_mul_right _, h.of_mul_left _⟩⟩ lemma coprime_of_mul_modeq_one (b : ℕ) {a n : ℕ} (h : a * b ≡ 1 [MOD n]) : coprime a n := -nat.coprime_of_dvd' (λ k kp ⟨ka, hka⟩ ⟨kb, hkb⟩, int.coe_nat_dvd.1 begin - rw [hka, hkb, modeq_iff_dvd] at h, - cases h with z hz, - rw [sub_eq_iff_eq_add] at hz, - rw [hz, int.coe_nat_mul, mul_assoc, mul_assoc, int.coe_nat_mul, ← mul_add], - exact dvd_mul_right _ _, -end) +begin + obtain ⟨g, hh⟩ := nat.gcd_dvd_right a n, + rw [nat.coprime_iff_gcd_eq_one, ← nat.dvd_one, ← nat.modeq_zero_iff_dvd], + calc 1 ≡ a * b [MOD a.gcd n] : nat.modeq.of_mul_right g (hh.subst h).symm + ... ≡ 0 * b [MOD a.gcd n] : (nat.modeq_zero_iff_dvd.mpr (nat.gcd_dvd_left _ _)).mul_right b + ... = 0 : by rw zero_mul, +end @[simp] lemma mod_mul_right_mod (a b c : ℕ) : a % (b * c) % b = a % b := -(mod_modeq _ _).of_modeq_mul_right _ +(mod_modeq _ _).of_mul_right _ @[simp] lemma mod_mul_left_mod (a b c : ℕ) : a % (b * c) % c = a % c := -(mod_modeq _ _).of_modeq_mul_left _ +(mod_modeq _ _).of_mul_left _ lemma div_mod_eq_mod_mul_div (a b c : ℕ) : a / b % c = a % (b * c) / b := if hb0 : b = 0 then by simp [hb0] -else by rw [← @add_right_cancel_iff _ _ (c * (a / b / c)), mod_add_div, nat.div_div_eq_div_mul, - ← nat.mul_right_inj (nat.pos_of_ne_zero hb0),← @add_left_cancel_iff _ _ (a % b), mod_add_div, - mul_add, ← @add_left_cancel_iff _ _ (a % (b * c) % b), add_left_comm, +else by rw [← @add_right_cancel_iff _ _ _ (c * (a / b / c)), mod_add_div, nat.div_div_eq_div_mul, + ← mul_right_inj' hb0, ← @add_left_cancel_iff _ _ _ (a % b), mod_add_div, + mul_add, ← @add_left_cancel_iff _ _ _ (a % (b * c) % b), add_left_comm, ← add_assoc (a % (b * c) % b), mod_add_div, ← mul_assoc, mod_add_div, mod_mul_right_mod] lemma add_mod_add_ite (a b c : ℕ) : @@ -342,7 +352,7 @@ else exact add_lt_add (nat.mod_lt _ (nat.pos_of_ne_zero hc0)) (nat.mod_lt _ (nat.pos_of_ne_zero hc0))), have h0 : 0 < (a % c + b % c) / c, from nat.div_pos h (nat.pos_of_ne_zero hc0), - rw [← @add_right_cancel_iff _ _ (c * ((a % c + b % c) / c)), add_comm _ c, add_assoc, + rw [← @add_right_cancel_iff _ _ _ (c * ((a % c + b % c) / c)), add_comm _ c, add_assoc, mod_add_div, le_antisymm (le_of_lt_succ h2) h0, mul_one, add_comm] }, { rw [nat.mod_eq_of_lt (lt_of_not_ge h), add_zero] } end @@ -358,7 +368,7 @@ by rw [← add_mod_add_ite, if_pos hc] lemma add_div {a b c : ℕ} (hc0 : 0 < c) : (a + b) / c = a / c + b / c + if c ≤ a % c + b % c then 1 else 0 := begin - rw [← nat.mul_right_inj hc0, ← @add_left_cancel_iff _ _ ((a + b) % c + a % c + b % c)], + rw [← mul_right_inj' hc0.ne', ← @add_left_cancel_iff _ _ _ ((a + b) % c + a % c + b % c)], suffices : (a + b) % c + c * ((a + b) / c) + a % c + b % c = a % c + c * (a / c) + (b % c + c * (b / c)) + c * (if c ≤ a % c + b % c then 1 else 0) + (a + b) % c, @@ -405,76 +415,23 @@ lemma odd_mul_odd_div_two {m n : ℕ} (hm1 : m % 2 = 1) (hn1 : n % 2 = 1) : (m * n) / 2 = m * (n / 2) + m / 2 := have hm0 : 0 < m := nat.pos_of_ne_zero (λ h, by simp * at *), have hn0 : 0 < n := nat.pos_of_ne_zero (λ h, by simp * at *), -(nat.mul_right_inj zero_lt_two).1 $ +mul_right_injective₀ two_ne_zero $ by rw [mul_add, two_mul_odd_div_two hm1, mul_left_comm, two_mul_odd_div_two hn1, two_mul_odd_div_two (nat.odd_mul_odd hm1 hn1), mul_tsub, mul_one, ← add_tsub_assoc_of_le (succ_le_of_lt hm0), tsub_add_cancel_of_le (le_mul_of_one_le_right (nat.zero_le _) hn0)] lemma odd_of_mod_four_eq_one {n : ℕ} : n % 4 = 1 → n % 2 = 1 := -by simpa [modeq, show 2 * 2 = 4, by norm_num] using @modeq.of_modeq_mul_left 2 n 1 2 +by simpa [modeq, show 2 * 2 = 4, by norm_num] using @modeq.of_mul_left 2 n 1 2 lemma odd_of_mod_four_eq_three {n : ℕ} : n % 4 = 3 → n % 2 = 1 := by simpa [modeq, show 2 * 2 = 4, by norm_num, show 3 % 4 = 3, by norm_num] - using @modeq.of_modeq_mul_left 2 n 3 2 + using @modeq.of_mul_left 2 n 3 2 -end nat +/-- A natural number is odd iff it has residue `1` or `3` mod `4`-/ +lemma odd_mod_four_iff {n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3 := +have help : ∀ (m : ℕ), m < 4 → m % 2 = 1 → m = 1 ∨ m = 3 := dec_trivial, +⟨λ hn, help (n % 4) (mod_lt n (by norm_num)) $ (mod_mod_of_dvd n (by norm_num : 2 ∣ 4)).trans hn, + λ h, or.dcases_on h odd_of_mod_four_eq_one odd_of_mod_four_eq_three⟩ -namespace list -variable {α : Type*} - -lemma nth_rotate : ∀ {l : list α} {n m : ℕ} (hml : m < l.length), - (l.rotate n).nth m = l.nth ((m + n) % l.length) -| [] n m hml := (nat.not_lt_zero _ hml).elim -| l 0 m hml := by simp [nat.mod_eq_of_lt hml] -| (a::l) (n+1) m hml := -have h₃ : m < list.length (l ++ [a]), by simpa using hml, -(lt_or_eq_of_le (nat.le_of_lt_succ $ nat.mod_lt (m + n) - (lt_of_le_of_lt (nat.zero_le _) hml))).elim -(λ hml', - have h₁ : (m + (n + 1)) % ((a :: l : list α).length) = - (m + n) % ((a :: l : list α).length) + 1, - from calc (m + (n + 1)) % (l.length + 1) = - ((m + n) % (l.length + 1) + 1) % (l.length + 1) : - add_assoc m n 1 ▸ nat.modeq.add_right 1 (nat.mod_mod _ _).symm - ... = (m + n) % (l.length + 1) + 1 : nat.mod_eq_of_lt (nat.succ_lt_succ hml'), - have h₂ : (m + n) % (l ++ [a]).length < l.length, by simpa [nat.add_one] using hml', - by rw [list.rotate_cons_succ, nth_rotate h₃, list.nth_append h₂, h₁, list.nth]; simp) -(λ hml', - have h₁ : (m + (n + 1)) % (l.length + 1) = 0, - from calc (m + (n + 1)) % (l.length + 1) = (l.length + 1) % (l.length + 1) : - add_assoc m n 1 ▸ nat.modeq.add_right 1 - (hml'.trans (nat.mod_eq_of_lt (nat.lt_succ_self _)).symm) - ... = 0 : by simp, - by rw [list.length, list.rotate_cons_succ, nth_rotate h₃, list.length_append, - list.length_cons, list.length, zero_add, hml', h₁, list.nth_concat_length]; refl) - -lemma rotate_eq_self_iff_eq_repeat [hα : nonempty α] : ∀ {l : list α}, - (∀ n, l.rotate n = l) ↔ ∃ a, l = list.repeat a l.length -| [] := ⟨λ h, nonempty.elim hα (λ a, ⟨a, by simp⟩), by simp⟩ -| (a::l) := -⟨λ h, ⟨a, list.ext_le (by simp) $ λ n hn h₁, - begin - rw [← option.some_inj, ← list.nth_le_nth], - conv {to_lhs, rw ← h ((list.length (a :: l)) - n)}, - rw [nth_rotate hn, add_tsub_cancel_of_le (le_of_lt hn), - nat.mod_self, nth_le_repeat], refl - end⟩, - λ ⟨a, ha⟩ n, ha.symm ▸ list.ext_le (by simp) - (λ m hm h, - have hm' : (m + n) % (list.repeat a (list.length (a :: l))).length < list.length (a :: l), - by rw list.length_repeat; exact nat.mod_lt _ (nat.succ_pos _), - by rw [nth_le_repeat, ← option.some_inj, ← list.nth_le_nth, nth_rotate h, list.nth_le_nth, - nth_le_repeat]; simp * at *)⟩ - -lemma rotate_repeat (a : α) (n : ℕ) (k : ℕ) : - (list.repeat a n).rotate k = list.repeat a n := -let h : nonempty α := ⟨a⟩ in by exactI rotate_eq_self_iff_eq_repeat.mpr ⟨a, by rw length_repeat⟩ k - -lemma rotate_one_eq_self_iff_eq_repeat [nonempty α] {l : list α} : - l.rotate 1 = l ↔ ∃ a : α, l = list.repeat a l.length := -⟨λ h, rotate_eq_self_iff_eq_repeat.mp (λ n, nat.rec l.rotate_zero - (λ n hn, by rwa [nat.succ_eq_add_one, ←l.rotate_rotate, hn]) n), - λ h, rotate_eq_self_iff_eq_repeat.mpr h 1⟩ - -end list +end nat diff --git a/src/data/nat/multiplicity.lean b/src/data/nat/multiplicity.lean index 916ba94714d98..f54f1afac1c5b 100644 --- a/src/data/nat/multiplicity.lean +++ b/src/data/nat/multiplicity.lean @@ -8,11 +8,15 @@ import algebra.geom_sum import data.nat.bitwise import data.nat.log import data.nat.parity -import ring_theory.int.basic +import data.nat.prime +import ring_theory.multiplicity /-! # Natural number multiplicity +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas about the multiplicity function (the maximum prime power dividing a number) when applied to naturals, in particular calculating it for factorials and binomial coefficients. @@ -56,35 +60,34 @@ calc ... = ↑((finset.Ico 1 b).filter (λ i, m ^ i ∣ n)).card : congr_arg coe $ congr_arg card $ finset.ext $ λ i, begin - rw [mem_filter, mem_Ico, mem_Ico, lt_succ_iff, ←@enat.coe_le_coe i, enat.coe_get, + rw [mem_filter, mem_Ico, mem_Ico, lt_succ_iff, ←@part_enat.coe_le_coe i, part_enat.coe_get, ←pow_dvd_iff_le_multiplicity, and.right_comm], - refine (and_iff_left_of_imp (λ h, _)).symm, + refine (and_iff_left_of_imp (λ h, lt_of_le_of_lt _ hb)).symm, cases m, { rw [zero_pow, zero_dvd_iff] at h, - exact (hn.ne' h.2).elim, - { exact h.1 } }, - exact ((pow_le_iff_le_log (succ_lt_succ $ nat.pos_of_ne_zero $ succ_ne_succ.1 hm) hn).1 $ - le_of_dvd hn h.2).trans_lt hb, + exacts [(hn.ne' h.2).elim, h.1] }, + exact le_log_of_pow_le (one_lt_iff_ne_zero_and_ne_one.2 ⟨m.succ_ne_zero, hm⟩) + (le_of_dvd hn h.2) end namespace prime lemma multiplicity_one {p : ℕ} (hp : p.prime) : multiplicity p 1 = 0 := -multiplicity.one_right (prime_iff.mp hp).not_unit +multiplicity.one_right hp.prime.not_unit lemma multiplicity_mul {p m n : ℕ} (hp : p.prime) : multiplicity p (m * n) = multiplicity p m + multiplicity p n := -multiplicity.mul $ prime_iff.mp hp +multiplicity.mul hp.prime lemma multiplicity_pow {p m n : ℕ} (hp : p.prime) : multiplicity p (m ^ n) = n • (multiplicity p m) := -multiplicity.pow $ prime_iff.mp hp +multiplicity.pow hp.prime lemma multiplicity_self {p : ℕ} (hp : p.prime) : multiplicity p p = 1 := -multiplicity_self (prime_iff.mp hp).not_unit hp.ne_zero +multiplicity_self hp.prime.not_unit hp.ne_zero lemma multiplicity_pow_self {p n : ℕ} (hp : p.prime) : multiplicity p (p ^ n) = n := -multiplicity_pow_self hp.ne_zero (prime_iff.mp hp).not_unit n +multiplicity_pow_self hp.ne_zero hp.prime.not_unit n /-- **Legendre's Theorem** @@ -109,7 +112,7 @@ lemma multiplicity_factorial {p : ℕ} (hp : p.prime) : lemma multiplicity_factorial_mul_succ {n p : ℕ} (hp : p.prime) : multiplicity p (p * (n + 1))! = multiplicity p (p * n)! + multiplicity p (n + 1) + 1 := begin - have hp' := prime_iff.mp hp, + have hp' := hp.prime, have h0 : 2 ≤ p := hp.two_le, have h1 : 1 ≤ p * n + 1 := nat.le_add_left _ _, have h2 : p * n + 1 ≤ p * (n + 1), linarith, @@ -119,14 +122,15 @@ begin exact ⟨hp.ne_one, factorial_pos _⟩ }, revert hm, have h4 : ∀ m ∈ Ico (p * n + 1) (p * (n + 1)), multiplicity p m = 0, - { intros m hm, apply multiplicity_eq_zero_of_not_dvd, - rw [← exists_lt_and_lt_iff_not_dvd _ (pos_iff_ne_zero.mpr hp.ne_zero)], rw [mem_Ico] at hm, + { intros m hm, + rw [multiplicity_eq_zero, ← not_dvd_iff_between_consec_multiples _ hp.pos], + rw [mem_Ico] at hm, exact ⟨n, lt_of_succ_le hm.1, hm.2⟩ }, simp_rw [← prod_Ico_id_eq_factorial, multiplicity.finset.prod hp', ← sum_Ico_consecutive _ h1 h3, add_assoc], intro h, - rw [enat.add_left_cancel_iff h, sum_Ico_succ_top h2, multiplicity.mul hp', + rw [part_enat.add_left_cancel_iff h, sum_Ico_succ_top h2, multiplicity.mul hp', hp.multiplicity_self, sum_congr rfl h4, sum_const_zero, zero_add, - add_comm (1 : enat)] + add_comm (1 : part_enat)] end /-- The multiplicity of `p` in `(p * n)!` is `n` more than that of `n!`. -/ @@ -135,7 +139,7 @@ lemma multiplicity_factorial_mul {n p : ℕ} (hp : p.prime) : begin induction n with n ih, { simp }, - { simp only [succ_eq_add_one, multiplicity.mul, hp, prime_iff.mp hp, ih, + { simp only [succ_eq_add_one, multiplicity.mul, hp, hp.prime, ih, multiplicity_factorial_mul_succ, ←add_assoc, nat.cast_one, nat.cast_add, factorial_succ], congr' 1, rw [add_comm, add_assoc] } @@ -145,12 +149,12 @@ end This sum is expressed over the set `Ico 1 b` where `b` is any bound greater than `log p n` -/ lemma pow_dvd_factorial_iff {p : ℕ} {n r b : ℕ} (hp : p.prime) (hbn : log p n < b) : p ^ r ∣ n! ↔ r ≤ ∑ i in Ico 1 b, n / p ^ i := -by rw [← enat.coe_le_coe, ← hp.multiplicity_factorial hbn, ← pow_dvd_iff_le_multiplicity] +by rw [← part_enat.coe_le_coe, ← hp.multiplicity_factorial hbn, ← pow_dvd_iff_le_multiplicity] lemma multiplicity_factorial_le_div_pred {p : ℕ} (hp : p.prime) (n : ℕ) : multiplicity p n! ≤ (n/(p - 1) : ℕ) := begin - rw [hp.multiplicity_factorial (lt_succ_self _), enat.coe_le_coe], + rw [hp.multiplicity_factorial (lt_succ_self _), part_enat.coe_le_coe], exact nat.geom_sum_Ico_le hp.two_le _ _, end @@ -183,39 +187,29 @@ have h₁ : multiplicity p (choose n k) + multiplicity p (k! * (n - k)!) = multiplicity_choose_aux hp hkn], simp [add_comm], end, -(enat.add_right_cancel_iff - (enat.ne_top_iff_dom.2 $ +(part_enat.add_right_cancel_iff + (part_enat.ne_top_iff_dom.2 $ by exact finite_nat_iff.2 ⟨ne_of_gt hp.one_lt, mul_pos (factorial_pos k) (factorial_pos (n - k))⟩)).1 h₁ /-- A lower bound on the multiplicity of `p` in `choose n k`. -/ -lemma multiplicity_le_multiplicity_choose_add {p : ℕ} (hp : p.prime) (n k : ℕ) : - multiplicity p n ≤ multiplicity p (choose n k) + multiplicity p k := -if hkn : n < k then by simp [choose_eq_zero_of_lt hkn] -else if hk0 : k = 0 then by simp [hk0] -else if hn0 : n = 0 then by cases k; simp [hn0, *] at * -else begin - rw [multiplicity_choose hp (le_of_not_gt hkn) (lt_succ_self _), - multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) (nat.pos_of_ne_zero hk0) - (lt_succ_of_le (log_mono_right (le_of_not_gt hkn))), - multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) (nat.pos_of_ne_zero hn0) (lt_succ_self _), - ← nat.cast_add, enat.coe_le_coe], - calc ((Ico 1 (log p n).succ).filter (λ i, p ^ i ∣ n)).card - ≤ ((Ico 1 (log p n).succ).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i) ∪ - (Ico 1 (log p n).succ).filter (λ i, p ^ i ∣ k) ).card : - card_le_of_subset $ λ i, begin - have := @le_mod_add_mod_of_dvd_add_of_not_dvd k (n - k) (p ^ i), - simp [add_tsub_cancel_of_le (le_of_not_gt hkn)] at * {contextual := tt}, - tauto - end - ... ≤ ((Ico 1 (log p n).succ).filter (λ i, p ^ i ≤ k % p ^ i + (n - k) % p ^ i)).card + - ((Ico 1 (log p n).succ).filter (λ i, p ^ i ∣ k)).card : - card_union_le _ _ +lemma multiplicity_le_multiplicity_choose_add {p : ℕ} (hp : p.prime) : ∀ (n k : ℕ), + multiplicity p n ≤ multiplicity p (choose n k) + multiplicity p k +| _ 0 := by simp +| 0 (_+1) := by simp +| (n+1) (k+1) := +begin + rw ← hp.multiplicity_mul, + refine multiplicity_le_multiplicity_of_dvd_right _, + rw [← succ_mul_choose_eq], + exact dvd_mul_right _ _ end -lemma multiplicity_choose_prime_pow {p n k : ℕ} (hp : p.prime) - (hkn : k ≤ p ^ n) (hk0 : 0 < k) : +variables {p n k : ℕ} + +lemma multiplicity_choose_prime_pow_add_multiplicity (hp : p.prime) (hkn : k ≤ p ^ n) + (hk0 : k ≠ 0) : multiplicity p (choose (p ^ n) k) + multiplicity p k = n := le_antisymm (have hdisj : disjoint @@ -225,9 +219,9 @@ le_antisymm {contextual := tt}, begin rw [multiplicity_choose hp hkn (lt_succ_self _), - multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) hk0 + multiplicity_eq_card_pow_dvd (ne_of_gt hp.one_lt) hk0.bot_lt (lt_succ_of_le (log_mono_right hkn)), - ← nat.cast_add, enat.coe_le_coe, log_pow hp.one_lt, + ← nat.cast_add, part_enat.coe_le_coe, log_pow hp.one_lt, ← card_disjoint_union hdisj, filter_union_right], have filter_le_Ico := (Ico 1 n.succ).card_filter_le _, rwa card_Ico 1 n.succ at filter_le_Ico, @@ -235,26 +229,44 @@ le_antisymm (by rw [← hp.multiplicity_pow_self]; exact multiplicity_le_multiplicity_choose_add hp _ _) +lemma multiplicity_choose_prime_pow {p n k : ℕ} (hp : p.prime) (hkn : k ≤ p ^ n) (hk0 : k ≠ 0) : + multiplicity p (choose (p ^ n) k) = + ↑(n - (multiplicity p k).get (finite_nat_iff.2 ⟨hp.ne_one, hk0.bot_lt⟩)) := +part_enat.eq_coe_sub_of_add_eq_coe $ multiplicity_choose_prime_pow_add_multiplicity hp hkn hk0 + +lemma dvd_choose_pow (hp : prime p) (hk : k ≠ 0) (hkp : k ≠ p ^ n) : p ∣ (p ^ n).choose k := +begin + obtain hkp | hkp := hkp.symm.lt_or_lt, + { simp [choose_eq_zero_of_lt hkp] }, + refine multiplicity_ne_zero.1 (λ h, hkp.not_le $ nat.le_of_dvd hk.bot_lt _), + have H := hp.multiplicity_choose_prime_pow_add_multiplicity hkp.le hk, + rw [h, zero_add, eq_coe_iff] at H, + exact H.1, +end + +lemma dvd_choose_pow_iff (hp : prime p) : p ∣ (p ^ n).choose k ↔ k ≠ 0 ∧ k ≠ p ^ n := +by refine ⟨λ h, ⟨_, _⟩, λ h, dvd_choose_pow hp h.1 h.2⟩; rintro rfl; simpa [hp.ne_one] using h + end prime lemma multiplicity_two_factorial_lt : ∀ {n : ℕ} (h : n ≠ 0), multiplicity 2 n! < n := begin - have h2 := prime_iff.mp prime_two, + have h2 := prime_two.prime, refine binary_rec _ _, { contradiction }, { intros b n ih h, by_cases hn : n = 0, - { subst hn, simp at h, simp [h, one_right h2.not_unit, enat.zero_lt_one] }, + { subst hn, simp at h, simp [h, one_right h2.not_unit] }, have : multiplicity 2 (2 * n)! < (2 * n : ℕ), { rw [prime_two.multiplicity_factorial_mul], - refine (enat.add_lt_add_right (ih hn) (enat.coe_ne_top _)).trans_le _, + refine (part_enat.add_lt_add_right (ih hn) (part_enat.coe_ne_top _)).trans_le _, rw [two_mul], norm_cast }, cases b, { simpa [bit0_eq_two_mul n] }, { suffices : multiplicity 2 (2 * n + 1) + multiplicity 2 (2 * n)! < ↑(2 * n) + 1, { simpa [succ_eq_add_one, multiplicity.mul, h2, prime_two, nat.bit1_eq_succ_bit0, bit0_eq_two_mul n] }, - rw [multiplicity_eq_zero_of_not_dvd (two_not_dvd_two_mul_add_one n), zero_add], + rw [multiplicity_eq_zero.2 (two_not_dvd_two_mul_add_one n), zero_add], refine this.trans _, exact_mod_cast lt_succ_self _ }} end diff --git a/src/data/nat/nth.lean b/src/data/nat/nth.lean index 9bc9a72418d12..42541ced019d3 100644 --- a/src/data/nat/nth.lean +++ b/src/data/nat/nth.lean @@ -4,24 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies, Vladimir Goryachev, Kyle Miller, Scott Morrison, Eric Rodriguez -/ import data.nat.count +import data.set.intervals.monotone import order.order_iso_nat /-! # The `n`th Number Satisfying a Predicate +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a function for "what is the `n`th number that satisifies a given predicate `p`", and provides lemmas that deal with this function and its connection to `nat.count`. ## Main definitions -* `nth p n`: The `n`-th natural `k` (zero-indexed) such that `p k`. If there is no - such natural (that is, `p` is true for at most `n` naturals), then `nth p n = 0`. +* `nat.nth p n`: The `n`-th natural `k` (zero-indexed) such that `p k`. If there is no + such natural (that is, `p` is true for at most `n` naturals), then `nat.nth p n = 0`. ## Main results * `nat.nth_set_card`: For a fintely-often true `p`, gives the cardinality of the set of numbers satisfying `p` above particular values of `nth p` -* `nat.count_nth_gc`: Establishes a Galois connection between `nth p` and `count p`. +* `nat.count_nth_gc`: Establishes a Galois connection between `nat.nth p` and `nat.count p`. * `nat.nth_eq_order_iso_of_nat`: For an infinitely-ofter true predicate, `nth` agrees with the order-isomorphism of the subtype to the natural numbers. @@ -40,365 +44,335 @@ variable (p : ℕ → Prop) /-- Find the `n`-th natural number satisfying `p` (indexed from `0`, so `nth p 0` is the first natural number satisfying `p`), or `0` if there is no such number. See also `subtype.order_iso_of_nat` for the order isomorphism with ℕ when `p` is infinitely often true. -/ -noncomputable def nth : ℕ → ℕ -| n := Inf { i : ℕ | p i ∧ ∀ k < n, nth k < i } +noncomputable def nth (p : ℕ → Prop) (n : ℕ) : ℕ := +by classical; exact + if h : set.finite (set_of p) then (h.to_finset.sort (≤)).nthd n 0 + else @nat.subtype.order_iso_of_nat (set_of p) (set.infinite.to_subtype h) n -lemma nth_zero : nth p 0 = Inf { i : ℕ | p i } := by { rw nth, simp } +variable {p} -@[simp] lemma nth_zero_of_zero (h : p 0) : nth p 0 = 0 := -by simp [nth_zero, h] +/-! +### Lemmas about `nat.nth` on a finite set +-/ -lemma nth_zero_of_exists [decidable_pred p] (h : ∃ n, p n) : nth p 0 = nat.find h := -by { rw [nth_zero], convert nat.Inf_def h } +theorem nth_of_card_le (hf : (set_of p).finite) {n : ℕ} (hn : hf.to_finset.card ≤ n) : + nth p n = 0 := +by { rw [nth, dif_pos hf, list.nthd_eq_default], rwa [finset.length_sort] } -lemma nth_set_card_aux {n : ℕ} (hp : (set_of p).finite) - (hp' : {i : ℕ | p i ∧ ∀ t < n, nth p t < i}.finite) (hle : n ≤ hp.to_finset.card) : - hp'.to_finset.card = hp.to_finset.card - n := -begin - unfreezingI { induction n with k hk }, - { congr, - simp only [forall_false_left, nat.not_lt_zero, forall_const, and_true] }, - have hp'': {i : ℕ | p i ∧ ∀ t, t < k → nth p t < i}.finite, - { refine hp.subset (λ x hx, _), - rw set.mem_set_of_eq at hx, - exact hx.left }, - have hle' := nat.sub_pos_of_lt hle, - specialize hk hp'' (k.le_succ.trans hle), - rw [nat.sub_succ', ←hk], - convert_to (finset.erase hp''.to_finset (nth p k)).card = _, - { congr, - ext a, - simp only [set.finite.mem_to_finset, ne.def, set.mem_set_of_eq, finset.mem_erase], - refine ⟨λ ⟨hp, hlt⟩, - ⟨(hlt _ (lt_add_one k)).ne', ⟨hp, λ n hn, hlt n (hn.trans_le k.le_succ)⟩⟩, _⟩, - rintro ⟨hak : _ ≠ _, hp, hlt⟩, - refine ⟨hp, λ n hn, _⟩, - rw lt_succ_iff at hn, - obtain hnk | rfl := hn.lt_or_eq, - { exact hlt _ hnk }, - { refine lt_of_le_of_ne _ (ne.symm hak), - rw nth, - apply nat.Inf_le, - simpa [hp] using hlt } }, - apply finset.card_erase_of_mem, - rw [nth, set.finite.mem_to_finset], - apply Inf_mem, - rwa [←set.finite.to_finset.nonempty hp'', ←finset.card_pos, hk], -end +theorem nth_eq_nthd_sort (h : (set_of p).finite) (n : ℕ) : + nth p n = (h.to_finset.sort (≤)).nthd n 0 := +dif_pos h -lemma nth_set_card {n : ℕ} (hp : (set_of p).finite) - (hp' : {i : ℕ | p i ∧ ∀ k < n, nth p k < i}.finite) : - hp'.to_finset.card = hp.to_finset.card - n := -begin - obtain hn | hn := le_or_lt n hp.to_finset.card, - { exact nth_set_card_aux p hp _ hn }, - rw nat.sub_eq_zero_of_le hn.le, - simp only [finset.card_eq_zero, set.finite_to_finset_eq_empty_iff, ←set.subset_empty_iff], - convert_to _ ⊆ {i : ℕ | p i ∧ ∀ (k : ℕ), k < hp.to_finset.card → nth p k < i}, - { symmetry, - rw [←set.finite_to_finset_eq_empty_iff, ←finset.card_eq_zero, - ←nat.sub_self hp.to_finset.card], - { apply nth_set_card_aux p hp _ le_rfl }, - { exact hp.subset (λ x hx, hx.1) } }, - exact λ x hx, ⟨hx.1, λ k hk, hx.2 _ (hk.trans hn)⟩, -end +theorem nth_eq_order_emb_of_fin (hf : (set_of p).finite) {n : ℕ} (hn : n < hf.to_finset.card) : + nth p n = hf.to_finset.order_emb_of_fin rfl ⟨n, hn⟩ := +by { rw [nth_eq_nthd_sort hf, finset.order_emb_of_fin_apply, list.nthd_eq_nth_le], refl } -lemma nth_set_nonempty_of_lt_card {n : ℕ} (hp : (set_of p).finite) (hlt: n < hp.to_finset.card) : - {i : ℕ | p i ∧ ∀ k < n, nth p k < i}.nonempty := +theorem nth_strict_mono_on (hf : (set_of p).finite) : + strict_mono_on (nth p) (set.Iio hf.to_finset.card) := begin - have hp': {i : ℕ | p i ∧ ∀ (k : ℕ), k < n → nth p k < i}.finite, - { exact hp.subset (λ x hx, hx.1) }, - rw [←hp'^.to_finset.nonempty, ←finset.card_pos, nth_set_card p hp], - exact nat.sub_pos_of_lt hlt, + rintro m (hm : m < _) n (hn : n < _) h, + simp only [nth_eq_order_emb_of_fin, *], + exact order_embedding.strict_mono _ h end -lemma nth_mem_of_lt_card_finite_aux (n : ℕ) (hp : (set_of p).finite) (hlt : n < hp.to_finset.card) : - nth p n ∈ {i : ℕ | p i ∧ ∀ k < n, nth p k < i} := +theorem nth_lt_nth_of_lt_card (hf : (set_of p).finite) {m n : ℕ} (h : m < n) + (hn : n < hf.to_finset.card) : nth p m < nth p n := +nth_strict_mono_on hf (h.trans hn) hn h + +theorem nth_le_nth_of_lt_card (hf : (set_of p).finite) {m n : ℕ} (h : m ≤ n) + (hn : n < hf.to_finset.card) : nth p m ≤ nth p n := +(nth_strict_mono_on hf).monotone_on (h.trans_lt hn) hn h + +theorem lt_of_nth_lt_nth_of_lt_card (hf : (set_of p).finite) {m n : ℕ} (h : nth p m < nth p n) + (hm : m < hf.to_finset.card) : m < n := +not_le.1 $ λ hle, h.not_le $ nth_le_nth_of_lt_card hf hle hm + +theorem le_of_nth_le_nth_of_lt_card (hf : (set_of p).finite) {m n : ℕ} (h : nth p m ≤ nth p n) + (hm : m < hf.to_finset.card) : m ≤ n := +not_lt.1 $ λ hlt, h.not_lt $ nth_lt_nth_of_lt_card hf hlt hm + +theorem nth_inj_on (hf : (set_of p).finite) : (set.Iio hf.to_finset.card).inj_on (nth p) := +(nth_strict_mono_on hf).inj_on + +theorem range_nth_of_finite (hf : (set_of p).finite) : set.range (nth p) = insert 0 (set_of p) := +by simpa only [← nth_eq_nthd_sort hf, mem_sort, set.finite.mem_to_finset] + using set.range_list_nthd (hf.to_finset.sort (≤)) 0 + +@[simp] theorem image_nth_Iio_card (hf : (set_of p).finite) : + nth p '' set.Iio hf.to_finset.card = set_of p := +calc nth p '' set.Iio hf.to_finset.card = set.range (hf.to_finset.order_emb_of_fin rfl) : + by ext x; simp only [set.mem_image, set.mem_range, fin.exists_iff, + ← nth_eq_order_emb_of_fin hf, set.mem_Iio, exists_prop] +... = set_of p : by rw [range_order_emb_of_fin, set.finite.coe_to_finset] + +lemma nth_mem_of_lt_card {n : ℕ} (hf : (set_of p).finite) (hlt : n < hf.to_finset.card) : + p (nth p n) := +(image_nth_Iio_card hf).subset $ set.mem_image_of_mem _ hlt + +theorem exists_lt_card_finite_nth_eq (hf : (set_of p).finite) {x} (h : p x) : + ∃ n, n < hf.to_finset.card ∧ nth p n = x := +by rwa [← @set.mem_set_of_eq _ _ p, ← image_nth_Iio_card hf] at h + +/-! +### Lemmas about `nat.nth` on an infinite set +-/ + +/-- When `s` is an infinite set, `nth` agrees with `nat.subtype.order_iso_of_nat`. -/ +theorem nth_apply_eq_order_iso_of_nat (hf : (set_of p).infinite) (n : ℕ) : + nth p n = @nat.subtype.order_iso_of_nat (set_of p) hf.to_subtype n := +by rw [nth, dif_neg hf] + +/-- When `s` is an infinite set, `nth` agrees with `nat.subtype.order_iso_of_nat`. -/ +theorem nth_eq_order_iso_of_nat (hf : (set_of p).infinite) : + nth p = coe ∘ @nat.subtype.order_iso_of_nat (set_of p) hf.to_subtype := +funext $ nth_apply_eq_order_iso_of_nat hf + +lemma nth_strict_mono (hf : (set_of p).infinite) : strict_mono (nth p) := begin - rw nth, - apply Inf_mem, - exact nth_set_nonempty_of_lt_card _ _ hlt, + rw [nth_eq_order_iso_of_nat hf], + exact (subtype.strict_mono_coe _).comp (order_iso.strict_mono _) end -lemma nth_mem_of_lt_card_finite {n : ℕ} (hp : (set_of p).finite) (hlt : n < hp.to_finset.card) : - p (nth p n) := (nth_mem_of_lt_card_finite_aux p n hp hlt).1 +lemma nth_injective (hf : (set_of p).infinite) : function.injective (nth p) := +(nth_strict_mono hf).injective -lemma nth_strict_mono_of_finite {m n : ℕ} (hp : (set_of p).finite) - (hlt : n < hp.to_finset.card) (hmn : m < n) : nth p m < nth p n := -(nth_mem_of_lt_card_finite_aux p _ hp hlt).2 _ hmn +lemma nth_monotone (hf : (set_of p).infinite) : monotone (nth p) := +(nth_strict_mono hf).monotone -lemma nth_mem_of_infinite_aux (hp : (set_of p).infinite) (n : ℕ) : - nth p n ∈ { i : ℕ | p i ∧ ∀ k < n, nth p k < i } := +lemma nth_lt_nth (hf : (set_of p).infinite) {k n} : nth p k < nth p n ↔ k < n := +(nth_strict_mono hf).lt_iff_lt + +lemma nth_le_nth (hf : (set_of p).infinite) {k n} : nth p k ≤ nth p n ↔ k ≤ n := +(nth_strict_mono hf).le_iff_le + +lemma range_nth_of_infinite (hf : (set_of p).infinite) : set.range (nth p) = set_of p := begin - rw nth, - apply Inf_mem, - let s : set ℕ := ⋃ (k < n), { i : ℕ | nth p k ≥ i }, - convert_to ((set_of p) \ s).nonempty, - { ext i, - simp }, - refine (hp.diff $ (set.finite_lt_nat _).bUnion _).nonempty, - exact λ k h, set.finite_le_nat _, + rw [nth_eq_order_iso_of_nat hf], + haveI := hf.to_subtype, + exact nat.subtype.coe_comp_of_nat_range end -lemma nth_mem_of_infinite (hp : (set_of p).infinite) (n : ℕ) : p (nth p n) := -(nth_mem_of_infinite_aux p hp n).1 +theorem nth_mem_of_infinite (hf : (set_of p).infinite) (n : ℕ) : p (nth p n) := +set.range_subset_iff.1 (range_nth_of_infinite hf).le n + +/-! +### Lemmas that work for finite and infinite sets +-/ -lemma nth_strict_mono (hp : (set_of p).infinite) : strict_mono (nth p) := -λ a b, (nth_mem_of_infinite_aux p hp b).2 _ +theorem exists_lt_card_nth_eq {x} (h : p x) : + ∃ n, (∀ hf : (set_of p).finite, n < hf.to_finset.card) ∧ nth p n = x := +begin + refine (set_of p).finite_or_infinite.elim (λ hf, _) (λ hf, _), + { rcases exists_lt_card_finite_nth_eq hf h with ⟨n, hn, hx⟩, + exact ⟨n, λ hf', hn, hx⟩ }, + { rw [← @set.mem_set_of_eq _ _ p, ← range_nth_of_infinite hf] at h, + rcases h with ⟨n, hx⟩, + exact ⟨n, λ hf', absurd hf' hf, hx⟩ } +end -lemma nth_injective_of_infinite (hp : (set_of p).infinite) : function.injective (nth p) := +theorem subset_range_nth : set_of p ⊆ set.range (nth p) := +λ x (hx : p x), let ⟨n, _, hn⟩ := exists_lt_card_nth_eq hx in ⟨n, hn⟩ + +theorem range_nth_subset : set.range (nth p) ⊆ insert 0 (set_of p) := +(set_of p).finite_or_infinite.elim (λ h, (range_nth_of_finite h).subset) + (λ h, (range_nth_of_infinite h).trans_subset (set.subset_insert _ _)) + +theorem nth_mem (n : ℕ) (h : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : p (nth p n) := +(set_of p).finite_or_infinite.elim (λ hf, nth_mem_of_lt_card hf (h hf)) + (λ h, nth_mem_of_infinite h n) + +theorem nth_lt_nth' {m n : ℕ} (hlt : m < n) (h : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : + nth p m < nth p n := +(set_of p).finite_or_infinite.elim (λ hf, nth_lt_nth_of_lt_card hf hlt (h _)) + (λ hf, (nth_lt_nth hf).2 hlt) + +theorem nth_le_nth' {m n : ℕ} (hle : m ≤ n) (h : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : + nth p m ≤ nth p n := +(set_of p).finite_or_infinite.elim (λ hf, nth_le_nth_of_lt_card hf hle (h _)) + (λ hf, (nth_le_nth hf).2 hle) + +theorem le_nth {n : ℕ} (h : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : n ≤ nth p n := +(set_of p).finite_or_infinite.elim + (λ hf, ((nth_strict_mono_on hf).mono $ set.Iic_subset_Iio.2 (h _)).Iic_id_le _ le_rfl) + (λ hf, (nth_strict_mono hf).id_le _) + +theorem is_least_nth {n} (h : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : + is_least { i | p i ∧ ∀ k < n, nth p k < i } (nth p n) := +⟨⟨nth_mem n h, λ k hk, nth_lt_nth' hk h⟩, λ x hx, let ⟨k, hk, hkx⟩ := exists_lt_card_nth_eq hx.1 + in (lt_or_le k n).elim (λ hlt, absurd hkx (hx.2 _ hlt).ne) (λ hle, hkx ▸ nth_le_nth' hle hk)⟩ + +theorem is_least_nth_of_lt_card {n : ℕ} (hf : (set_of p).finite) (hn : n < hf.to_finset.card) : + is_least { i | p i ∧ ∀ k < n, nth p k < i } (nth p n) := +is_least_nth $ λ _, hn + +theorem is_least_nth_of_infinite (hf : (set_of p).infinite) (n : ℕ) : + is_least { i | p i ∧ ∀ k < n, nth p k < i } (nth p n) := +is_least_nth $ λ h, absurd h hf + +/-- An alternative recursive definition of `nat.nth`: `nat.nth s n` is the infimum of `x ∈ s` such +that `nat.nth s k < x` for all `k < n`, if this set is nonempty. We do not assume that the set is +nonempty because we use the same "garbage value" `0` both for `Inf` on `ℕ` and for `nat.nth s n` for +`n ≥ card s`. -/ +lemma nth_eq_Inf (p : ℕ → Prop) (n : ℕ) : nth p n = Inf {x | p x ∧ ∀ k < n, nth p k < x} := begin - intros m n h, - wlog h' : m ≤ n, - rw le_iff_lt_or_eq at h', - obtain (h' | rfl) := h', - { simpa [h] using nth_strict_mono p hp h' }, - { refl }, + by_cases hn : ∀ hf : (set_of p).finite, n < hf.to_finset.card, + { exact (is_least_nth hn).cInf_eq.symm }, + { push_neg at hn, + rcases hn with ⟨hf, hn⟩, + rw [nth_of_card_le _ hn], + refine ((congr_arg Inf $ set.eq_empty_of_forall_not_mem $ λ k hk, _).trans Inf_empty).symm, + rcases exists_lt_card_nth_eq hk.1 with ⟨k, hlt, rfl⟩, + exact (hk.2 _ ((hlt hf).trans_le hn)).false } end -lemma nth_monotone (hp : (set_of p).infinite) : monotone (nth p) := -(nth_strict_mono p hp).monotone +lemma nth_zero : nth p 0 = Inf (set_of p) := by { rw nth_eq_Inf, simp } -lemma nth_mono_of_finite {a b : ℕ} (hp : (set_of p).finite) (hb : b < hp.to_finset.card) - (hab : a ≤ b) : nth p a ≤ nth p b := +@[simp] lemma nth_zero_of_zero (h : p 0) : nth p 0 = 0 := by simp [nth_zero, h] + +lemma nth_zero_of_exists [decidable_pred p] (h : ∃ n, p n) : nth p 0 = nat.find h := +by { rw [nth_zero], convert nat.Inf_def h } + +lemma nth_eq_zero {n} : + nth p n = 0 ↔ p 0 ∧ n = 0 ∨ ∃ hf : (set_of p).finite, hf.to_finset.card ≤ n := begin - obtain rfl | h := hab.eq_or_lt, - { exact le_rfl }, - { exact (nth_strict_mono_of_finite p hp hb h).le } + refine ⟨λ h, _, _⟩, + { simp only [or_iff_not_imp_right, not_exists, not_le], + exact λ hn, ⟨h ▸ nth_mem _ hn, nonpos_iff_eq_zero.1 $ h ▸ le_nth hn⟩ }, + { rintro (⟨h₀, rfl⟩ | ⟨hf, hle⟩), + exacts [nth_zero_of_zero h₀, nth_of_card_le hf hle] } end -lemma le_nth_of_lt_nth_succ_finite {k a : ℕ} (hp : (set_of p).finite) - (hlt : k.succ < hp.to_finset.card) (h : a < nth p k.succ) (ha : p a) : - a ≤ nth p k := +lemma nth_eq_zero_mono (h₀ : ¬p 0) {a b : ℕ} (hab : a ≤ b) (ha : nth p a = 0) : + nth p b = 0 := begin - by_contra' hak, - refine h.not_le _, - rw nth, - apply nat.Inf_le, - refine ⟨ha, λ n hn, lt_of_le_of_lt _ hak⟩, - exact nth_mono_of_finite p hp (k.le_succ.trans_lt hlt) (le_of_lt_succ hn), + simp only [nth_eq_zero, h₀, false_and, false_or] at ha ⊢, + exact ha.imp (λ hf hle, hle.trans hab) end -lemma le_nth_of_lt_nth_succ_infinite {k a : ℕ} (hp : (set_of p).infinite) - (h : a < nth p k.succ) (ha : p a) : +lemma le_nth_of_lt_nth_succ {k a : ℕ} (h : a < nth p (k + 1)) (ha : p a) : a ≤ nth p k := begin - by_contra' hak, - refine h.not_le _, - rw nth, - apply nat.Inf_le, - exact ⟨ha, λ n hn, (nth_monotone p hp (le_of_lt_succ hn)).trans_lt hak⟩, + cases (set_of p).finite_or_infinite with hf hf, + { rcases exists_lt_card_finite_nth_eq hf ha with ⟨n, hn, rfl⟩, + cases lt_or_le (k + 1) hf.to_finset.card with hk hk, + { rwa [(nth_strict_mono_on hf).lt_iff_lt hn hk, lt_succ_iff, + ← (nth_strict_mono_on hf).le_iff_le hn (k.lt_succ_self.trans hk)] at h }, + { rw [nth_of_card_le _ hk] at h, + exact absurd h (zero_le _).not_lt } }, + { rcases subset_range_nth ha with ⟨n, rfl⟩, + rwa [nth_lt_nth hf, lt_succ_iff, ← nth_le_nth hf] at h } end section count -variables [decidable_pred p] +variables (p) [decidable_pred p] @[simp] lemma count_nth_zero : count p (nth p 0) = 0 := begin - rw [count_eq_card_filter_range, finset.card_eq_zero, nth_zero], - ext a, - simp_rw [not_mem_empty, mem_filter, mem_range, iff_false], - rintro ⟨ha, hp⟩, - exact ha.not_le (nat.Inf_le hp), + rw [count_eq_card_filter_range, card_eq_zero, filter_eq_empty_iff, nth_zero], + exact λ n h₁ h₂, (mem_range.1 h₁).not_le (nat.Inf_le h₂) end -lemma filter_range_nth_eq_insert_of_finite (hp : (set_of p).finite) {k : ℕ} - (hlt : k.succ < hp.to_finset.card) : - finset.filter p (finset.range (nth p k.succ)) = - insert (nth p k) (finset.filter p (finset.range (nth p k))) := +lemma filter_range_nth_subset_insert (k : ℕ) : + (range (nth p (k + 1))).filter p ⊆ insert (nth p k) ((range (nth p k)).filter p) := begin - ext a, - simp_rw [mem_insert, mem_filter, mem_range], - split, - { rintro ⟨ha, hpa⟩, - refine or_iff_not_imp_left.mpr (λ h, ⟨lt_of_le_of_ne _ h, hpa⟩), - exact le_nth_of_lt_nth_succ_finite p hp hlt ha hpa }, - { rintro (ha | ⟨ha, hpa⟩), - { rw ha, - refine ⟨nth_strict_mono_of_finite p hp hlt (lt_add_one _), _⟩, - apply nth_mem_of_lt_card_finite p hp, - exact (k.le_succ).trans_lt hlt }, - refine ⟨ha.trans _, hpa⟩, - exact nth_strict_mono_of_finite p hp hlt (lt_add_one _) } + intros a ha, + simp only [mem_insert, mem_filter, mem_range] at ha ⊢, + exact (le_nth_of_lt_nth_succ ha.1 ha.2).eq_or_lt.imp_right (λ h, ⟨h, ha.2⟩) end -lemma count_nth_of_lt_card_finite {n : ℕ} (hp : (set_of p).finite) - (hlt : n < hp.to_finset.card) : count p (nth p n) = n := +variable {p} + +lemma filter_range_nth_eq_insert {k : ℕ} + (hlt : ∀ hf : (set_of p).finite, k + 1 < hf.to_finset.card) : + (range (nth p (k + 1))).filter p = insert (nth p k) ((range (nth p k)).filter p) := begin - induction n with k hk, - { exact count_nth_zero _ }, - { rw [count_eq_card_filter_range, filter_range_nth_eq_insert_of_finite p hp hlt, - finset.card_insert_of_not_mem, ←count_eq_card_filter_range, hk (lt_of_succ_lt hlt)], - simp, }, + refine (filter_range_nth_subset_insert p k).antisymm (λ a ha, _), + simp only [mem_insert, mem_filter, mem_range] at ha ⊢, + have : nth p k < nth p (k + 1) := nth_lt_nth' k.lt_succ_self hlt, + rcases ha with (rfl | ⟨hlt, hpa⟩), + { exact ⟨this, nth_mem _ (λ hf, k.lt_succ_self.trans (hlt hf))⟩ }, + { exact ⟨hlt.trans this, hpa⟩ }, end +lemma filter_range_nth_eq_insert_of_finite (hf : (set_of p).finite) {k : ℕ} + (hlt : k + 1 < hf.to_finset.card) : + (range (nth p (k + 1))).filter p = insert (nth p k) ((range (nth p k)).filter p) := +filter_range_nth_eq_insert $ λ _, hlt + lemma filter_range_nth_eq_insert_of_infinite (hp : (set_of p).infinite) (k : ℕ) : - (finset.range (nth p k.succ)).filter p = insert (nth p k) ((finset.range (nth p k)).filter p) := -begin - ext a, - simp_rw [mem_insert, mem_filter, mem_range], - split, - { rintro ⟨ha, hpa⟩, - rw nth at ha, - refine or_iff_not_imp_left.mpr (λ hne, ⟨(le_of_not_lt $ λ h, _).lt_of_ne hne, hpa⟩), - exact ha.not_le (nat.Inf_le ⟨hpa, λ b hb, (nth_monotone p hp (le_of_lt_succ hb)).trans_lt h⟩) }, - { rintro (rfl | ⟨ha, hpa⟩), - { exact ⟨nth_strict_mono p hp (lt_succ_self k), nth_mem_of_infinite p hp _⟩ }, - { exact ⟨ha.trans (nth_strict_mono p hp (lt_succ_self k)), hpa⟩ } } -end + (range (nth p (k + 1))).filter p = insert (nth p k) ((range (nth p k)).filter p) := +filter_range_nth_eq_insert $ λ hf, absurd hf hp -lemma count_nth_of_infinite (hp : (set_of p).infinite) (n : ℕ) : count p (nth p n) = n := +lemma count_nth {n : ℕ} (hn : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : + count p (nth p n) = n := begin - induction n with k hk, + induction n with k ihk, { exact count_nth_zero _ }, - { rw [count_eq_card_filter_range, filter_range_nth_eq_insert_of_infinite p hp, - finset.card_insert_of_not_mem, ←count_eq_card_filter_range, hk], - simp, }, + { rw [count_eq_card_filter_range, filter_range_nth_eq_insert hn, card_insert_of_not_mem, + ←count_eq_card_filter_range, ihk (λ hf, lt_of_succ_lt (hn hf))], + simp } end +lemma count_nth_of_lt_card_finite {n : ℕ} (hp : (set_of p).finite) + (hlt : n < hp.to_finset.card) : count p (nth p n) = n := +count_nth $ λ _, hlt + +lemma count_nth_of_infinite (hp : (set_of p).infinite) (n : ℕ) : count p (nth p n) = n := +count_nth $ λ hf, absurd hf hp + +lemma count_nth_succ {n : ℕ} (hn : ∀ hf : (set_of p).finite, n < hf.to_finset.card) : + count p (nth p n + 1) = n + 1 := +by rw [count_succ, count_nth hn, if_pos (nth_mem _ hn)] + @[simp] lemma nth_count {n : ℕ} (hpn : p n) : nth p (count p n) = n := -begin - obtain hp | hp := em (set_of p).finite, - { refine count_injective _ hpn _, - { apply nth_mem_of_lt_card_finite p hp, - exact count_lt_card hp hpn }, - { exact count_nth_of_lt_card_finite _ _ (count_lt_card hp hpn) } }, - { apply count_injective (nth_mem_of_infinite _ hp _) hpn, - apply count_nth_of_infinite p hp } -end +have ∀ hf : (set_of p).finite, count p n < hf.to_finset.card, + from λ hf, count_lt_card hf hpn, +count_injective (nth_mem _ this) hpn (count_nth this) -lemma nth_count_eq_Inf {n : ℕ} : nth p (count p n) = Inf {i : ℕ | p i ∧ n ≤ i} := +lemma nth_lt_of_lt_count {n k : ℕ} (h : k < count p n) : nth p k < n := begin - rw nth, - congr, - ext a, - simp only [set.mem_set_of_eq, and.congr_right_iff], - intro hpa, - refine ⟨λ h, _, λ hn k hk, lt_of_lt_of_le _ hn⟩, - { by_contra ha, - simp only [not_le] at ha, - have hn : nth p (count p a) < a := h _ (count_strict_mono hpa ha), - rwa [nth_count p hpa, lt_self_iff_false] at hn }, - { apply (count_monotone p).reflect_lt, - convert hk, - obtain hp | hp : (set_of p).finite ∨ (set_of p).infinite := em (set_of p).finite, - { rw count_nth_of_lt_card_finite _ hp, - exact hk.trans ((count_monotone _ hn).trans_lt (count_lt_card hp hpa)) }, - { apply count_nth_of_infinite p hp } } + refine (count_monotone p).reflect_lt _, + rwa [count_nth], + exact λ hf, h.trans_le (count_le_card hf n) end -lemma nth_count_le (hp : (set_of p).infinite) (n : ℕ) : n ≤ nth p (count p n) := -begin - rw nth_count_eq_Inf, - suffices h : Inf {i : ℕ | p i ∧ n ≤ i} ∈ {i : ℕ | p i ∧ n ≤ i}, - { exact h.2 }, - apply Inf_mem, - obtain ⟨m, hp, hn⟩ := hp.exists_nat_lt n, - exact ⟨m, hp, hn.le⟩ -end +lemma le_nth_of_count_le {n k : ℕ} (h : n ≤ nth p k) : count p n ≤ k := +not_lt.1 $ λ hlt, h.not_lt $ nth_lt_of_lt_count hlt -lemma count_nth_gc (hp : (set_of p).infinite) : galois_connection (count p) (nth p) := +variable (p) + +lemma nth_count_eq_Inf (n : ℕ) : nth p (count p n) = Inf {i : ℕ | p i ∧ n ≤ i} := begin - rintro x y, - rw [nth, le_cInf_iff ⟨0, λ _ _, nat.zero_le _⟩ ⟨nth p y, nth_mem_of_infinite_aux p hp y⟩], - dsimp, - refine ⟨_, λ h, _⟩, - { rintro hy n ⟨hn, h⟩, - obtain hy' | rfl := hy.lt_or_eq, - { exact (nth_count_le p hp x).trans (h (count p x) hy').le }, - { specialize h (count p n), - replace hn : nth p (count p n) = n := nth_count _ hn, - replace h : count p x ≤ count p n := by rwa [hn, lt_self_iff_false, imp_false, not_lt] at h, - refine (nth_count_le p hp x).trans _, - rw ← hn, - exact nth_monotone p hp h }, }, - { rw ←count_nth_of_infinite p hp y, - exact count_monotone _ (h (nth p y) ⟨nth_mem_of_infinite p hp y, - λ k hk, nth_strict_mono p hp hk⟩) } + refine (nth_eq_Inf _ _).trans (congr_arg Inf _), + refine set.ext (λ a, and_congr_right $ λ hpa, _), + refine ⟨λ h, not_lt.1 (λ ha, _), λ hn k hk, lt_of_lt_of_le (nth_lt_of_lt_count hk) hn⟩, + have hn : nth p (count p a) < a := h _ (count_strict_mono hpa ha), + rwa [nth_count hpa, lt_self_iff_false] at hn end -lemma count_le_iff_le_nth (hp : (set_of p).infinite) {a b : ℕ} : - count p a ≤ b ↔ a ≤ nth p b := count_nth_gc p hp _ _ +variable {p} -lemma lt_nth_iff_count_lt (hp : (set_of p).infinite) {a b : ℕ} : - a < count p b ↔ nth p a < b := lt_iff_lt_of_le_iff_le $ count_le_iff_le_nth p hp +lemma le_nth_count' {n : ℕ} (hpn : ∃ k, p k ∧ n ≤ k) : n ≤ nth p (count p n) := +(le_cInf hpn $ λ k, and.right).trans (nth_count_eq_Inf p n).ge -lemma nth_lt_of_lt_count (n k : ℕ) (h : k < count p n) : nth p k < n := -begin - obtain hp | hp := em (set_of p).finite, - { refine (count_monotone p).reflect_lt _, - rwa count_nth_of_lt_card_finite p hp, - refine h.trans_le _, - rw count_eq_card_filter_range, - exact finset.card_le_of_subset (λ x hx, hp.mem_to_finset.2 (mem_filter.1 hx).2) }, - { rwa ← lt_nth_iff_count_lt _ hp } -end +lemma le_nth_count (hp : (set_of p).infinite) (n : ℕ) : n ≤ nth p (count p n) := +let ⟨m, hp, hn⟩ := hp.exists_gt n in le_nth_count' ⟨m, hp, hn.le⟩ -lemma le_nth_of_count_le (n k : ℕ) (h: n ≤ nth p k) : count p n ≤ k := -begin - by_contra hc, - apply not_lt.mpr h, - apply nth_lt_of_lt_count, - simpa using hc -end +/-- If a predicate `p : ℕ → Prop` is true for infinitely many numbers, then `nat.count p` and +`nat.nth p` form a Galois insertion. -/ +noncomputable def gi_count_nth (hp : (set_of p).infinite) : galois_insertion (count p) (nth p) := +galois_insertion.monotone_intro (nth_monotone hp) (count_monotone p) + (le_nth_count hp) (count_nth_of_infinite hp) -end count +lemma gc_count_nth (hp : (set_of p).infinite) : galois_connection (count p) (nth p) := +(gi_count_nth hp).gc -lemma nth_zero_of_nth_zero (h₀ : ¬p 0) {a b : ℕ} (hab : a ≤ b) (ha : nth p a = 0) : - nth p b = 0 := -begin - rw [nth, Inf_eq_zero] at ⊢ ha, - cases ha, - { exact (h₀ ha.1).elim }, - { refine or.inr (set.eq_empty_of_subset_empty $ λ x hx, _), - rw ←ha, - exact ⟨hx.1, λ k hk, hx.2 k $ hk.trans_le hab⟩ } -end +lemma count_le_iff_le_nth (hp : (set_of p).infinite) {a b : ℕ} : + count p a ≤ b ↔ a ≤ nth p b := gc_count_nth hp _ _ -/-- When `p` is true infinitely often, `nth` agrees with `nat.subtype.order_iso_of_nat`. -/ -lemma nth_eq_order_iso_of_nat [decidable_pred p] (i : infinite (set_of p)) (n : ℕ) : - nth p n = nat.subtype.order_iso_of_nat (set_of p) n := -begin - have hi := set.infinite_coe_iff.mp i, - induction n with k hk; - simp only [subtype.order_iso_of_nat_apply, subtype.of_nat, nat_zero_eq_zero], - { rw [nat.subtype.coe_bot, nth_zero_of_exists], }, - { simp only [nat.subtype.succ, set.mem_set_of_eq, subtype.coe_mk, subtype.val_eq_coe], - rw [subtype.order_iso_of_nat_apply] at hk, - set b := nth p k.succ - nth p k - 1 with hb, - replace hb : p (↑(subtype.of_nat (set_of p) k) + b + 1), - { rw [hb, ←hk, tsub_right_comm], - have hn11: nth p k.succ - 1 + 1 = nth p k.succ, - { rw tsub_add_cancel_iff_le, - exact succ_le_of_lt (pos_of_gt (nth_strict_mono p hi (lt_add_one k))), }, - rw add_tsub_cancel_of_le, - { rw hn11, - apply nth_mem_of_infinite p hi }, - { rw [← lt_succ_iff, ← nat.add_one, hn11], - apply nth_strict_mono p hi, - exact lt_add_one k } }, - have H : (∃ n: ℕ , p (↑(subtype.of_nat (set_of p) k) + n + 1)) := ⟨b, hb⟩, - set t := nat.find H with ht, - obtain ⟨hp, hmin⟩ := (nat.find_eq_iff _).mp ht, - rw [←ht, ←hk] at hp hmin ⊢, - rw [nth, Inf_def ⟨_, nth_mem_of_infinite_aux p hi k.succ⟩, nat.find_eq_iff], - refine ⟨⟨by convert hp, λ r hr, _⟩, λ n hn, _⟩, - { rw lt_succ_iff at ⊢ hr, - exact (nth_monotone p hi hr).trans (by simp) }, - simp only [exists_prop, not_and, not_lt, set.mem_set_of_eq, not_forall], - refine λ hpn, ⟨k, lt_add_one k, _⟩, - by_contra' hlt, - replace hn : n - nth p k - 1 < t, - { rw tsub_lt_iff_left, - { rw tsub_lt_iff_left hlt.le, - convert hn using 1, - ac_refl }, - exact le_tsub_of_add_le_left (succ_le_of_lt hlt) }, - refine hmin (n - nth p k - 1) hn _, - convert hpn, - have hn11 : n - 1 + 1 = n := nat.sub_add_cancel (pos_of_gt hlt), - rwa [tsub_right_comm, add_tsub_cancel_of_le], - rwa [←hn11, lt_succ_iff] at hlt }, -end +lemma lt_nth_iff_count_lt (hp : (set_of p).infinite) {a b : ℕ} : + a < count p b ↔ nth p a < b := (gc_count_nth hp).lt_iff_lt + +end count end nat diff --git a/src/data/nat/order/basic.lean b/src/data/nat/order/basic.lean new file mode 100644 index 0000000000000..c0913019067e2 --- /dev/null +++ b/src/data/nat/order/basic.lean @@ -0,0 +1,658 @@ +/- +Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ +import algebra.order.ring.canonical +import data.nat.basic + +/-! +# The natural numbers as a linearly ordered commutative semiring + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We also have a variety of lemmas which have been deferred from `data.nat.basic` because it is +easier to prove them with this ordered semiring instance available. + +You may find that some theorems can be moved back to `data.nat.basic` by modifying their proofs. +-/ + +universes u v + +/-! ### instances -/ + +instance nat.order_bot : order_bot ℕ := +{ bot := 0, bot_le := nat.zero_le } + +instance : linear_ordered_comm_semiring ℕ := +{ lt := nat.lt, + add_le_add_left := @nat.add_le_add_left, + le_of_add_le_add_left := @nat.le_of_add_le_add_left, + zero_le_one := nat.le_of_lt (nat.zero_lt_succ 0), + mul_lt_mul_of_pos_left := @nat.mul_lt_mul_of_pos_left, + mul_lt_mul_of_pos_right := @nat.mul_lt_mul_of_pos_right, + decidable_eq := nat.decidable_eq, + exists_pair_ne := ⟨0, 1, ne_of_lt nat.zero_lt_one⟩, + ..nat.comm_semiring, ..nat.linear_order } + +instance : linear_ordered_comm_monoid_with_zero ℕ := +{ mul_le_mul_left := λ a b h c, nat.mul_le_mul_left c h, + ..nat.linear_ordered_comm_semiring, + ..(infer_instance : comm_monoid_with_zero ℕ)} + +/-! Extra instances to short-circuit type class resolution and ensure computability -/ +-- Not using `infer_instance` avoids `classical.choice` in the following two +instance : linear_ordered_semiring ℕ := infer_instance +instance : strict_ordered_semiring ℕ := infer_instance +instance : strict_ordered_comm_semiring ℕ := infer_instance +instance : ordered_semiring ℕ := strict_ordered_semiring.to_ordered_semiring' +instance : ordered_comm_semiring ℕ := strict_ordered_comm_semiring.to_ordered_comm_semiring' + +instance : linear_ordered_cancel_add_comm_monoid ℕ := infer_instance + +instance : canonically_ordered_comm_semiring ℕ := +{ exists_add_of_le := λ a b h, (nat.le.dest h).imp $ λ _, eq.symm, + le_self_add := nat.le_add_right, + eq_zero_or_eq_zero_of_mul_eq_zero := λ a b, nat.eq_zero_of_mul_eq_zero, + .. nat.nontrivial, + .. nat.order_bot, + .. (infer_instance : ordered_add_comm_monoid ℕ), + .. (infer_instance : linear_ordered_semiring ℕ), + .. (infer_instance : comm_semiring ℕ) } + +instance : canonically_linear_ordered_add_monoid ℕ := +{ .. (infer_instance : canonically_ordered_add_monoid ℕ), + .. nat.linear_order } + +variables {a b m n k l : ℕ} +namespace nat + +/-! ### Equalities and inequalities involving zero and one -/ + +lemma one_le_iff_ne_zero : 1 ≤ n ↔ n ≠ 0 := +(show 1 ≤ n ↔ 0 < n, from iff.rfl).trans pos_iff_ne_zero + +lemma one_lt_iff_ne_zero_and_ne_one : ∀ {n : ℕ}, 1 < n ↔ n ≠ 0 ∧ n ≠ 1 +| 0 := dec_trivial +| 1 := dec_trivial +| (n+2) := dec_trivial + +protected theorem mul_ne_zero (n0 : n ≠ 0) (m0 : m ≠ 0) : n * m ≠ 0 +| nm := (eq_zero_of_mul_eq_zero nm).elim n0 m0 + +@[simp] protected theorem mul_eq_zero : m * n = 0 ↔ m = 0 ∨ n = 0 := +iff.intro eq_zero_of_mul_eq_zero (by simp [or_imp_distrib] {contextual := tt}) + +@[simp] protected theorem zero_eq_mul : 0 = m * n ↔ m = 0 ∨ n = 0 := +by rw [eq_comm, nat.mul_eq_zero] + +lemma eq_zero_of_double_le (h : 2 * n ≤ n) : n = 0 := +add_right_eq_self.mp $ le_antisymm ((two_mul n).symm.trans_le h) le_add_self + +lemma eq_zero_of_mul_le (hb : 2 ≤ n) (h : n * m ≤ m) : m = 0 := +eq_zero_of_double_le $ le_trans (nat.mul_le_mul_right _ hb) h + +lemma zero_max : max 0 n = n := max_eq_right (zero_le _) + +@[simp] lemma min_eq_zero_iff : min m n = 0 ↔ m = 0 ∨ n = 0 := min_eq_bot +@[simp] lemma max_eq_zero_iff : max m n = 0 ↔ m = 0 ∧ n = 0 := max_eq_bot + +lemma add_eq_max_iff : m + n = max m n ↔ m = 0 ∨ n = 0 := +begin + rw ←min_eq_zero_iff, + cases le_total m n with H H; + simp [H] +end + +lemma add_eq_min_iff : m + n = min m n ↔ m = 0 ∧ n = 0 := +begin + rw ←max_eq_zero_iff, + cases le_total m n with H H; + simp [H] +end + +lemma one_le_of_lt (h : n < m) : 1 ≤ m := lt_of_le_of_lt (nat.zero_le _) h + +theorem eq_one_of_mul_eq_one_right (H : m * n = 1) : m = 1 := eq_one_of_dvd_one ⟨n, H.symm⟩ + +theorem eq_one_of_mul_eq_one_left (H : m * n = 1) : n = 1 := +eq_one_of_mul_eq_one_right (by rwa mul_comm) + +/-! ### `succ` -/ + +lemma two_le_iff : ∀ n, 2 ≤ n ↔ n ≠ 0 ∧ n ≠ 1 +| 0 := by simp +| 1 := by simp +| (n+2) := by simp + +@[simp] lemma lt_one_iff {n : ℕ} : n < 1 ↔ n = 0 := +lt_succ_iff.trans nonpos_iff_eq_zero + +/-! ### `add` -/ + +theorem add_pos_left {m : ℕ} (h : 0 < m) (n : ℕ) : 0 < m + n := +calc + m + n > 0 + n : nat.add_lt_add_right h n + ... = n : nat.zero_add n + ... ≥ 0 : zero_le n + +theorem add_pos_right (m : ℕ) {n : ℕ} (h : 0 < n) : 0 < m + n := +begin rw add_comm, exact add_pos_left h m end + +theorem add_pos_iff_pos_or_pos (m n : ℕ) : 0 < m + n ↔ 0 < m ∨ 0 < n := +iff.intro + begin + intro h, + cases m with m, + {simp [zero_add] at h, exact or.inr h}, + exact or.inl (succ_pos _) + end + begin + intro h, cases h with mpos npos, + { apply add_pos_left mpos }, + apply add_pos_right _ npos + end + +lemma add_eq_one_iff : m + n = 1 ↔ m = 0 ∧ n = 1 ∨ m = 1 ∧ n = 0 := +by cases n; simp [succ_eq_add_one, ← add_assoc, succ_inj'] + +lemma add_eq_two_iff : m + n = 2 ↔ m = 0 ∧ n = 2 ∨ m = 1 ∧ n = 1 ∨ m = 2 ∧ n = 0 := +by cases n; simp [(succ_ne_zero 1).symm, succ_eq_add_one, ← add_assoc, succ_inj', add_eq_one_iff] + +lemma add_eq_three_iff : + m + n = 3 ↔ m = 0 ∧ n = 3 ∨ m = 1 ∧ n = 2 ∨ m = 2 ∧ n = 1 ∨ m = 3 ∧ n = 0 := +by cases n; simp [(succ_ne_zero 1).symm, succ_eq_add_one, ← add_assoc, succ_inj', add_eq_two_iff] + +theorem le_add_one_iff : m ≤ n + 1 ↔ m ≤ n ∨ m = n + 1 := +⟨λ h, + match nat.eq_or_lt_of_le h with + | or.inl h := or.inr h + | or.inr h := or.inl $ nat.le_of_succ_le_succ h + end, + or.rec (λ h, le_trans h $ nat.le_add_right _ _) le_of_eq⟩ + +lemma le_and_le_add_one_iff : n ≤ m ∧ m ≤ n + 1 ↔ m = n ∨ m = n + 1 := +begin + rw [le_add_one_iff, and_or_distrib_left, ←le_antisymm_iff, eq_comm, and_iff_right_of_imp], + rintro rfl, + exact n.le_succ +end + +lemma add_succ_lt_add (hab : m < n) (hcd : k < l) : m + k + 1 < n + l := +begin + rw add_assoc, + exact add_lt_add_of_lt_of_le hab (nat.succ_le_iff.2 hcd) +end + +/-! ### `pred` -/ + +lemma pred_le_iff : pred m ≤ n ↔ m ≤ succ n := +⟨le_succ_of_pred_le, by { cases m, { exact λ _, zero_le n }, exact le_of_succ_le_succ }⟩ + +/-! ### `sub` + +Most lemmas come from the `has_ordered_sub` instance on `ℕ`. -/ + +instance : has_ordered_sub ℕ := +begin + constructor, + intros m n k, + induction n with n ih generalizing k, + { simp }, + { simp only [sub_succ, add_succ, succ_add, ih, pred_le_iff] } +end + +lemma lt_pred_iff : n < pred m ↔ succ n < m := show n < m - 1 ↔ n + 1 < m, from lt_tsub_iff_right + +lemma lt_of_lt_pred (h : m < n - 1) : m < n := lt_of_succ_lt (lt_pred_iff.1 h) + +lemma le_or_le_of_add_eq_add_pred (h : k + l = m + n - 1) : m ≤ k ∨ n ≤ l := +begin + cases le_or_lt m k with h' h'; [left, right], + { exact h' }, + { replace h' := add_lt_add_right h' l, rw h at h', + cases n.eq_zero_or_pos with hn hn, { rw hn, exact zero_le l }, + rw [m.add_sub_assoc hn, add_lt_add_iff_left] at h', + exact nat.le_of_pred_lt h' }, +end + +/-- A version of `nat.sub_succ` in the form `_ - 1` instead of `nat.pred _`. -/ +lemma sub_succ' (m n : ℕ) : m - n.succ = m - n - 1 := rfl + +/-! ### `mul` -/ + +lemma succ_mul_pos (m : ℕ) (hn : 0 < n) : 0 < (succ m) * n := mul_pos (succ_pos m) hn + +theorem mul_self_le_mul_self (h : m ≤ n) : m * m ≤ n * n := mul_le_mul h h (zero_le _) (zero_le _) + +theorem mul_self_lt_mul_self : Π {m n : ℕ}, m < n → m * m < n * n +| 0 n h := mul_pos h h +| (succ m) n h := mul_lt_mul h (le_of_lt h) (succ_pos _) (zero_le _) + +theorem mul_self_le_mul_self_iff : m ≤ n ↔ m * m ≤ n * n := +⟨mul_self_le_mul_self, le_imp_le_of_lt_imp_lt mul_self_lt_mul_self⟩ + +theorem mul_self_lt_mul_self_iff : m < n ↔ m * m < n * n := +le_iff_le_iff_lt_iff_lt.1 mul_self_le_mul_self_iff + +theorem le_mul_self : Π (n : ℕ), n ≤ n * n +| 0 := le_rfl +| (n+1) := by simp + +lemma le_mul_of_pos_left (h : 0 < n) : m ≤ n * m := +begin + conv {to_lhs, rw [← one_mul(m)]}, + exact mul_le_mul_of_nonneg_right h.nat_succ_le dec_trivial, +end + +lemma le_mul_of_pos_right (h : 0 < n) : m ≤ m * n := +begin + conv {to_lhs, rw [← mul_one(m)]}, + exact mul_le_mul_of_nonneg_left h.nat_succ_le dec_trivial, +end + +theorem mul_self_inj : m * m = n * n ↔ m = n := +le_antisymm_iff.trans (le_antisymm_iff.trans + (and_congr mul_self_le_mul_self_iff mul_self_le_mul_self_iff)).symm + +lemma le_add_pred_of_pos (n : ℕ) {i : ℕ} (hi : i ≠ 0) : n ≤ i + (n - 1) := +begin + refine le_trans _ (add_tsub_le_assoc), + simp [add_comm, nat.add_sub_assoc, one_le_iff_ne_zero.2 hi] +end + +@[simp] theorem lt_mul_self_iff : ∀ {n : ℕ}, n < n * n ↔ 1 < n +| 0 := iff_of_false (lt_irrefl _) zero_le_one.not_lt +| (n + 1) := lt_mul_iff_one_lt_left n.succ_pos + +lemma add_sub_one_le_mul (hm : m ≠ 0) (hn : n ≠ 0) : m + n - 1 ≤ m * n := +begin + cases m, + { cases hm rfl }, + { rw [succ_add, succ_sub_one, succ_mul], + exact add_le_add_right (le_mul_of_one_le_right' $ pos_iff_ne_zero.2 hn) _ } +end + +/-! +### Recursion and induction principles + +This section is here due to dependencies -- the lemmas here require some of the lemmas +proved above, and some of the results in later sections depend on the definitions in this section. +-/ + +/-- Given a predicate on two naturals `P : ℕ → ℕ → Prop`, `P a b` is true for all `a < b` if +`P (a + 1) (a + 1)` is true for all `a`, `P 0 (b + 1)` is true for all `b` and for all +`a < b`, `P (a + 1) b` is true and `P a (b + 1)` is true implies `P (a + 1) (b + 1)` is true. -/ +@[elab_as_eliminator] +lemma diag_induction (P : ℕ → ℕ → Prop) (ha : ∀ a, P (a + 1) (a + 1)) (hb : ∀ b, P 0 (b + 1)) + (hd : ∀ a b, a < b → P (a + 1) b → P a (b + 1) → P (a + 1) (b + 1)) : + ∀ a b, a < b → P a b +| 0 (b + 1) h := hb _ +| (a + 1) (b + 1) h := +begin + apply hd _ _ ((add_lt_add_iff_right _).1 h), + { have : a + 1 = b ∨ a + 1 < b, + { rwa [← le_iff_eq_or_lt, ← nat.lt_succ_iff] }, + rcases this with rfl | _, + { exact ha _ }, + apply diag_induction (a + 1) b this }, + apply diag_induction a (b + 1), + apply lt_of_le_of_lt (nat.le_succ _) h, +end +using_well_founded { rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ p, p.1 + p.2.1)⟩] } + +/-- A subset of `ℕ` containing `k : ℕ` and closed under `nat.succ` contains every `n ≥ k`. -/ +lemma set_induction_bounded {S : set ℕ} (hk : k ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S) + (hnk : k ≤ n) : n ∈ S := +@le_rec_on (λ n, n ∈ S) k n hnk h_ind hk + +/-- A subset of `ℕ` containing zero and closed under `nat.succ` contains all of `ℕ`. -/ +lemma set_induction {S : set ℕ} (hb : 0 ∈ S) (h_ind: ∀ k : ℕ, k ∈ S → k + 1 ∈ S) (n : ℕ) : n ∈ S := +set_induction_bounded hb h_ind (zero_le n) + +/-! ### `div` -/ + +protected lemma div_le_of_le_mul' (h : m ≤ k * n) : m / k ≤ n := +(nat.eq_zero_or_pos k).elim + (λ k0, by rw [k0, nat.div_zero]; apply zero_le) + (λ k0, (mul_le_mul_left k0).1 $ + calc k * (m / k) + ≤ m % k + k * (m / k) : nat.le_add_left _ _ + ... = m : mod_add_div _ _ + ... ≤ k * n : h) + +protected lemma div_le_self' (m n : ℕ) : m / n ≤ m := +(nat.eq_zero_or_pos n).elim + (λ n0, by rw [n0, nat.div_zero]; apply zero_le) + (λ n0, nat.div_le_of_le_mul' $ calc + m = 1 * m : (one_mul _).symm + ... ≤ n * m : nat.mul_le_mul_right _ n0) + +protected lemma div_lt_of_lt_mul (h : m < n * k) : m / n < k := +lt_of_mul_lt_mul_left + (calc n * (m / n) ≤ m % n + n * (m / n) : nat.le_add_left _ _ + ... = m : mod_add_div _ _ + ... < n * k : h) + (nat.zero_le n) + +lemma eq_zero_of_le_div (hn : 2 ≤ n) (h : m ≤ m / n) : m = 0 := +eq_zero_of_mul_le hn $ + by rw mul_comm; exact (nat.le_div_iff_mul_le' (lt_of_lt_of_le dec_trivial hn)).1 h + +lemma div_mul_div_le_div (m n k : ℕ) : ((m / k) * n) / m ≤ n / k := +if hm0 : m = 0 then by simp [hm0] +else calc m / k * n / m ≤ n * m / k / m : + nat.div_le_div_right (by rw [mul_comm]; + exact mul_div_le_mul_div_assoc _ _ _) + ... = n / k : by rw [nat.div_div_eq_div_mul, mul_comm n, mul_comm k, + nat.mul_div_mul _ _ (nat.pos_of_ne_zero hm0)] + +lemma eq_zero_of_le_half (h : n ≤ n / 2) : n = 0 := eq_zero_of_le_div le_rfl h + +lemma mul_div_mul_comm_of_dvd_dvd (hmk : k ∣ m) (hnl : l ∣ n) : m * n / (k * l) = m / k * (n / l) := +begin + rcases k.eq_zero_or_pos with rfl | hk0, { simp }, + rcases l.eq_zero_or_pos with rfl | hl0, { simp }, + obtain ⟨_, rfl⟩ := hmk, + obtain ⟨_, rfl⟩ := hnl, + rw [mul_mul_mul_comm, nat.mul_div_cancel_left _ hk0, nat.mul_div_cancel_left _ hl0, + nat.mul_div_cancel_left _ (mul_pos hk0 hl0)] +end + +lemma le_half_of_half_lt_sub {a b : ℕ} (h : a / 2 < a - b) : b ≤ a / 2 := +begin + rw nat.le_div_iff_mul_le two_pos, + rw [nat.div_lt_iff_lt_mul two_pos, nat.mul_sub_right_distrib, lt_tsub_iff_right, + mul_two a] at h, + exact le_of_lt (nat.lt_of_add_lt_add_left h) +end + +lemma half_le_of_sub_le_half {a b : ℕ} (h : a - b ≤ a / 2) : a / 2 ≤ b := +begin + rw [nat.le_div_iff_mul_le two_pos, nat.mul_sub_right_distrib, tsub_le_iff_right, + mul_two, add_le_add_iff_left] at h, + rw [← nat.mul_div_left b two_pos], + exact nat.div_le_div_right h, +end + +/-! ### `mod`, `dvd` -/ + +lemma two_mul_odd_div_two (hn : n % 2 = 1) : 2 * (n / 2) = n - 1 := +by conv {to_rhs, rw [← nat.mod_add_div n 2, hn, add_tsub_cancel_left]} + +lemma div_dvd_of_dvd (h : n ∣ m) : (m / n) ∣ m := ⟨n, (nat.div_mul_cancel h).symm⟩ + +protected lemma div_div_self (h : n ∣ m) (hm : m ≠ 0) : m / (m / n) = n := +begin + rcases h with ⟨_, rfl⟩, + rw mul_ne_zero_iff at hm, + rw [mul_div_right _ (nat.pos_of_ne_zero hm.1), mul_div_left _ (nat.pos_of_ne_zero hm.2)] +end + +lemma mod_mul_right_div_self (m n k : ℕ) : m % (n * k) / n = (m / n) % k := +begin + rcases nat.eq_zero_or_pos n with rfl|hn, { simp }, + rcases nat.eq_zero_or_pos k with rfl|hk, { simp }, + conv_rhs { rw ← mod_add_div m (n * k) }, + rw [mul_assoc, add_mul_div_left _ _ hn, add_mul_mod_self_left, + mod_eq_of_lt (nat.div_lt_of_lt_mul (mod_lt _ (mul_pos hn hk)))] +end + +lemma mod_mul_left_div_self (m n k : ℕ) : m % (k * n) / n = (m / n) % k := +by rw [mul_comm k, mod_mul_right_div_self] + +lemma not_dvd_of_pos_of_lt (h1 : 0 < n) (h2 : n < m) : ¬ m ∣ n := +begin + rintros ⟨k, rfl⟩, + rcases nat.eq_zero_or_pos k with (rfl | hk), + { exact lt_irrefl 0 h1 }, + { exact not_lt.2 (le_mul_of_pos_right hk) h2 }, +end + +/-- If `m` and `n` are equal mod `k`, `m - n` is zero mod `k`. -/ +lemma sub_mod_eq_zero_of_mod_eq (h : m % k = n % k) : (m - n) % k = 0 := +by rw [←nat.mod_add_div m k, ←nat.mod_add_div n k, ←h, tsub_add_eq_tsub_tsub, add_tsub_cancel_left, + ←mul_tsub, nat.mul_mod_right] + +@[simp] lemma one_mod (n : ℕ) : 1 % (n + 2) = 1 := nat.mod_eq_of_lt (add_lt_add_right n.succ_pos 1) + +lemma dvd_sub_mod (k : ℕ) : n ∣ (k - (k % n)) := +⟨k / n, tsub_eq_of_eq_add_rev (nat.mod_add_div k n).symm⟩ + +lemma add_mod_eq_ite : + (m + n) % k = if k ≤ m % k + n % k then m % k + n % k - k else m % k + n % k := +begin + cases k, { simp }, + rw nat.add_mod, + split_ifs with h, + { rw [nat.mod_eq_sub_mod h, nat.mod_eq_of_lt], + exact (tsub_lt_iff_right h).mpr + (nat.add_lt_add (m.mod_lt k.zero_lt_succ) (n.mod_lt k.zero_lt_succ)) }, + { exact nat.mod_eq_of_lt (lt_of_not_ge h) } +end + +lemma div_mul_div_comm (hmn : n ∣ m) (hkl : l ∣ k) : (m / n) * (k / l) = (m * k) / (n * l) := +have exi1 : ∃ x, m = n * x, from hmn, +have exi2 : ∃ y, k = l * y, from hkl, +if hn : n = 0 then by simp [hn] +else have 0 < n, from nat.pos_of_ne_zero hn, +if hl : l = 0 then by simp [hl] +else have 0 < l, from nat.pos_of_ne_zero hl, +begin + cases exi1 with x hx, cases exi2 with y hy, + rw [hx, hy, nat.mul_div_cancel_left, nat.mul_div_cancel_left], + symmetry, + apply nat.div_eq_of_eq_mul_left, + apply mul_pos, + repeat {assumption}, + cc +end + +lemma div_eq_self : m / n = m ↔ m = 0 ∨ n = 1 := +begin + split, + { intro, + cases n, + { simp * at * }, + { cases n, + { right, refl }, + { left, + have : m / (n + 2) ≤ m / 2 := div_le_div_left (by simp) dec_trivial, + refine eq_zero_of_le_half _, + simp * at * } } }, + { rintros (rfl|rfl); simp } +end + +lemma div_eq_sub_mod_div : m / n = (m - m % n) / n := +begin + by_cases n0 : n = 0, + { rw [n0, nat.div_zero, nat.div_zero] }, + { rw [← mod_add_div m n] { occs := occurrences.pos [2] }, + rw [add_tsub_cancel_left, mul_div_right _ (nat.pos_of_ne_zero n0)] } +end + +/-- `m` is not divisible by `n` if it is between `n * k` and `n * (k + 1)` for some `k`. -/ +lemma not_dvd_of_between_consec_multiples (h1 : n * k < m) (h2 : m < n * (k + 1)) : ¬ n ∣ m := +begin + rintro ⟨d, rfl⟩, + exact monotone.ne_of_lt_of_lt_nat (covariant.monotone_of_const n) k h1 h2 d rfl +end + +/-! ### `find` -/ +section find + +variables {p q : ℕ → Prop} [decidable_pred p] [decidable_pred q] + +@[simp] lemma find_pos (h : ∃ n : ℕ, p n) : 0 < nat.find h ↔ ¬ p 0 := +by rw [pos_iff_ne_zero, ne, nat.find_eq_zero] + +lemma find_add {hₘ : ∃ m, p (m + n)} {hₙ : ∃ n, p n} (hn : n ≤ nat.find hₙ) : + nat.find hₘ + n = nat.find hₙ := +begin + refine ((le_find_iff _ _).2 (λ m hm hpm, hm.not_le _)).antisymm _, + { have hnm : n ≤ m := hn.trans (find_le hpm), + refine add_le_of_le_tsub_right_of_le hnm (find_le _), + rwa tsub_add_cancel_of_le hnm }, + { rw ←tsub_le_iff_right, + refine (le_find_iff _ _).2 (λ m hm hpm, hm.not_le _), + rw tsub_le_iff_right, + exact find_le hpm } +end + +end find + +/-! ### `find_greatest` -/ + +section find_greatest + +variables {P Q : ℕ → Prop} [decidable_pred P] + +lemma find_greatest_eq_iff : + nat.find_greatest P k = m ↔ m ≤ k ∧ (m ≠ 0 → P m) ∧ (∀ ⦃n⦄, m < n → n ≤ k → ¬P n) := +begin + induction k with k ihk generalizing m, + { rw [eq_comm, iff.comm], + simp only [nonpos_iff_eq_zero, ne.def, and_iff_left_iff_imp, find_greatest_zero], + rintro rfl, + exact ⟨λ h, (h rfl).elim, λ n hlt heq, (hlt.ne heq.symm).elim⟩ }, + { by_cases hk : P (k + 1), + { rw [find_greatest_eq hk], split, + { rintro rfl, + exact ⟨le_rfl, λ _, hk, λ n hlt hle, (hlt.not_le hle).elim⟩ }, + { rintros ⟨hle, h0, hm⟩, + rcases decidable.eq_or_lt_of_le hle with rfl|hlt, + exacts [rfl, (hm hlt le_rfl hk).elim] } }, + { rw [find_greatest_of_not hk, ihk], + split, + { rintros ⟨hle, hP, hm⟩, + refine ⟨hle.trans k.le_succ, hP, λ n hlt hle, _⟩, + rcases decidable.eq_or_lt_of_le hle with rfl|hlt', + exacts [hk, hm hlt $ lt_succ_iff.1 hlt'] }, + { rintros ⟨hle, hP, hm⟩, + refine ⟨lt_succ_iff.1 (hle.lt_of_ne _), hP, λ n hlt hle, hm hlt (hle.trans k.le_succ)⟩, + rintro rfl, + exact hk (hP k.succ_ne_zero) } } } +end + +lemma find_greatest_eq_zero_iff : nat.find_greatest P k = 0 ↔ ∀ ⦃n⦄, 0 < n → n ≤ k → ¬P n := +by simp [find_greatest_eq_iff] + +lemma find_greatest_spec (hmb : m ≤ n) (hm : P m) : P (nat.find_greatest P n) := +begin + by_cases h : nat.find_greatest P n = 0, + { cases m, { rwa h }, + exact ((find_greatest_eq_zero_iff.1 h) m.zero_lt_succ hmb hm).elim }, + { exact (find_greatest_eq_iff.1 rfl).2.1 h } +end + +lemma find_greatest_le (n : ℕ) : nat.find_greatest P n ≤ n := (find_greatest_eq_iff.1 rfl).1 + +lemma le_find_greatest (hmb : m ≤ n) (hm : P m) : m ≤ nat.find_greatest P n := +le_of_not_lt $ λ hlt, (find_greatest_eq_iff.1 rfl).2.2 hlt hmb hm + +lemma find_greatest_mono_right (P : ℕ → Prop) [decidable_pred P] : monotone (nat.find_greatest P) := +begin + refine monotone_nat_of_le_succ (λ n, _), + rw [find_greatest_succ], + split_ifs, + { exact (find_greatest_le n).trans (le_succ _) }, + { refl } +end + +lemma find_greatest_mono_left [decidable_pred Q] (hPQ : P ≤ Q) : + nat.find_greatest P ≤ nat.find_greatest Q := +begin + intro n, + induction n with n hn, + { refl }, + by_cases P (n + 1), + { rw [find_greatest_eq h, find_greatest_eq (hPQ _ h)] }, + { rw find_greatest_of_not h, + exact hn.trans (nat.find_greatest_mono_right _ $ le_succ _) } +end + +lemma find_greatest_mono [decidable_pred Q] (hPQ : P ≤ Q) (hmn : m ≤ n) : + nat.find_greatest P m ≤ nat.find_greatest Q n := +(nat.find_greatest_mono_right _ hmn).trans $ find_greatest_mono_left hPQ _ + +lemma find_greatest_is_greatest (hk : nat.find_greatest P n < k) (hkb : k ≤ n) : ¬ P k := +(find_greatest_eq_iff.1 rfl).2.2 hk hkb + +lemma find_greatest_of_ne_zero (h : nat.find_greatest P n = m) (h0 : m ≠ 0) : P m := +(find_greatest_eq_iff.1 h).2.1 h0 + +end find_greatest + +/-! ### `bit0` and `bit1` -/ + +protected theorem bit0_le {n m : ℕ} (h : n ≤ m) : bit0 n ≤ bit0 m := add_le_add h h + +protected theorem bit1_le {n m : ℕ} (h : n ≤ m) : bit1 n ≤ bit1 m := succ_le_succ (add_le_add h h) + +theorem bit_le : ∀ (b : bool) {m n : ℕ}, m ≤ n → bit b m ≤ bit b n +| tt _ _ h := nat.bit1_le h +| ff _ _ h := nat.bit0_le h + +theorem bit0_le_bit : ∀ (b) {m n : ℕ}, m ≤ n → bit0 m ≤ bit b n +| tt _ _ h := le_of_lt $ nat.bit0_lt_bit1 h +| ff _ _ h := nat.bit0_le h + +theorem bit_le_bit1 : ∀ (b) {m n : ℕ}, m ≤ n → bit b m ≤ bit1 n +| ff _ _ h := le_of_lt $ nat.bit0_lt_bit1 h +| tt _ _ h := nat.bit1_le h + +theorem bit_lt_bit0 : ∀ (b) {m n : ℕ}, m < n → bit b m < bit0 n +| tt _ _ h := nat.bit1_lt_bit0 h +| ff _ _ h := nat.bit0_lt h + +theorem bit_lt_bit (a b) (h : m < n) : bit a m < bit b n := +lt_of_lt_of_le (bit_lt_bit0 _ h) (bit0_le_bit _ le_rfl) + +@[simp] lemma bit0_le_bit1_iff : bit0 m ≤ bit1 n ↔ m ≤ n := +⟨λ h, by rwa [← nat.lt_succ_iff, n.bit1_eq_succ_bit0, ← n.bit0_succ_eq, + bit0_lt_bit0, nat.lt_succ_iff] at h, λ h, le_of_lt (nat.bit0_lt_bit1 h)⟩ + +@[simp] lemma bit0_lt_bit1_iff : bit0 m < bit1 n ↔ m ≤ n := +⟨λ h, bit0_le_bit1_iff.1 (le_of_lt h), nat.bit0_lt_bit1⟩ + +@[simp] lemma bit1_le_bit0_iff : bit1 m ≤ bit0 n ↔ m < n := +⟨λ h, by rwa [m.bit1_eq_succ_bit0, succ_le_iff, bit0_lt_bit0] at h, + λ h, le_of_lt (nat.bit1_lt_bit0 h)⟩ + +@[simp] lemma bit1_lt_bit0_iff : bit1 m < bit0 n ↔ m < n := +⟨λ h, bit1_le_bit0_iff.1 (le_of_lt h), nat.bit1_lt_bit0⟩ + +@[simp] lemma one_le_bit0_iff : 1 ≤ bit0 n ↔ 0 < n := +by { convert bit1_le_bit0_iff, refl, } + +@[simp] lemma one_lt_bit0_iff : 1 < bit0 n ↔ 1 ≤ n := +by { convert bit1_lt_bit0_iff, refl, } + +@[simp] lemma bit_le_bit_iff : ∀ {b : bool}, bit b m ≤ bit b n ↔ m ≤ n +| ff := bit0_le_bit0 +| tt := bit1_le_bit1 + +@[simp] lemma bit_lt_bit_iff : ∀ {b : bool}, bit b m < bit b n ↔ m < n +| ff := bit0_lt_bit0 +| tt := bit1_lt_bit1 + +@[simp] lemma bit_le_bit1_iff : ∀ {b : bool}, bit b m ≤ bit1 n ↔ m ≤ n +| ff := bit0_le_bit1_iff +| tt := bit1_le_bit1 + +/-! ### decidability of predicates -/ + +instance decidable_lo_hi (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : + decidable (∀x, lo ≤ x → x < hi → P x) := +decidable_of_iff (∀ x < hi - lo, P (lo + x)) +⟨λal x hl hh, by { have := al (x - lo) ((tsub_lt_tsub_iff_right hl).mpr hh), + rwa [add_tsub_cancel_of_le hl] at this, }, +λal x h, al _ (nat.le_add_right _ _) (lt_tsub_iff_left.mp h)⟩ + +instance decidable_lo_hi_le (lo hi : ℕ) (P : ℕ → Prop) [H : decidable_pred P] : + decidable (∀x, lo ≤ x → x ≤ hi → P x) := +decidable_of_iff (∀x, lo ≤ x → x < hi + 1 → P x) $ +ball_congr $ λ x hl, imp_congr lt_succ_iff iff.rfl + +end nat diff --git a/src/data/nat/order/lemmas.lean b/src/data/nat/order/lemmas.lean new file mode 100644 index 0000000000000..84cddcf68ccce --- /dev/null +++ b/src/data/nat/order/lemmas.lean @@ -0,0 +1,225 @@ +/- +Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ +import data.nat.order.basic +import data.nat.units +import data.set.basic +import algebra.ring.divisibility +import algebra.group_with_zero.divisibility + +/-! +# Further lemmas about the natural numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The distinction between this file and `data.nat.order.basic` is not particularly clear. +They are separated by now to minimize the porting requirements for tactics during the transition to +mathlib4. After `data.rat.order` has been ported, please feel free to reorganize these two files. +-/ + +universes u v + +variables {a b m n k : ℕ} +namespace nat + +/-! ### Sets -/ + +instance subtype.order_bot (s : set ℕ) [decidable_pred (∈ s)] [h : nonempty s] : + order_bot s := +{ bot := ⟨nat.find (nonempty_subtype.1 h), nat.find_spec (nonempty_subtype.1 h)⟩, + bot_le := λ x, nat.find_min' _ x.2 } + +instance subtype.semilattice_sup (s : set ℕ) : + semilattice_sup s := +{ ..subtype.linear_order s, + ..linear_order.to_lattice } + +lemma subtype.coe_bot {s : set ℕ} [decidable_pred (∈ s)] + [h : nonempty s] : ((⊥ : s) : ℕ) = nat.find (nonempty_subtype.1 h) := rfl + +lemma set_eq_univ {S : set ℕ} : S = set.univ ↔ 0 ∈ S ∧ ∀ k : ℕ, k ∈ S → k + 1 ∈ S := +⟨by rintro rfl; simp, λ ⟨h0, hs⟩, set.eq_univ_of_forall (set_induction h0 hs)⟩ + +/-! ### `div` -/ + +protected lemma lt_div_iff_mul_lt {n d : ℕ} (hnd : d ∣ n) (a : ℕ) : a < n / d ↔ d * a < n := +begin + rcases d.eq_zero_or_pos with rfl | hd0, { simp [zero_dvd_iff.mp hnd] }, + rw [←mul_lt_mul_left hd0, ←nat.eq_mul_of_div_eq_right hnd rfl], +end + +lemma div_eq_iff_eq_of_dvd_dvd {n x y : ℕ} (hn : n ≠ 0) (hx : x ∣ n) (hy : y ∣ n) : + n / x = n / y ↔ x = y := +begin + split, + { intros h, + rw ←mul_right_inj' hn, + apply nat.eq_mul_of_div_eq_left (dvd_mul_of_dvd_left hy x), + rw [eq_comm, mul_comm, nat.mul_div_assoc _ hy], + exact nat.eq_mul_of_div_eq_right hx h }, + { intros h, rw h }, +end + +protected lemma div_eq_zero_iff {a b : ℕ} (hb : 0 < b) : a / b = 0 ↔ a < b := +⟨λ h, by rw [← mod_add_div a b, h, mul_zero, add_zero]; exact mod_lt _ hb, + λ h, by rw [← mul_right_inj' hb.ne', ← @add_left_cancel_iff _ _ _ (a % b), mod_add_div, + mod_eq_of_lt h, mul_zero, add_zero]⟩ + +protected lemma div_eq_zero {a b : ℕ} (hb : a < b) : a / b = 0 := +(nat.div_eq_zero_iff $ (zero_le a).trans_lt hb).mpr hb + +/-! ### `mod`, `dvd` -/ + +@[simp] protected theorem dvd_one {n : ℕ} : n ∣ 1 ↔ n = 1 := +⟨eq_one_of_dvd_one, λ e, e.symm ▸ dvd_rfl⟩ + +@[simp] protected theorem not_two_dvd_bit1 (n : ℕ) : ¬ 2 ∣ bit1 n := +by { rw [bit1, nat.dvd_add_right two_dvd_bit0, nat.dvd_one], cc } + +/-- A natural number `m` divides the sum `m + n` if and only if `m` divides `n`.-/ +@[simp] protected lemma dvd_add_self_left {m n : ℕ} : + m ∣ m + n ↔ m ∣ n := +nat.dvd_add_right (dvd_refl m) + +/-- A natural number `m` divides the sum `n + m` if and only if `m` divides `n`.-/ +@[simp] protected lemma dvd_add_self_right {m n : ℕ} : + m ∣ n + m ↔ m ∣ n := +nat.dvd_add_left (dvd_refl m) + +-- TODO: update `nat.dvd_sub` in core +lemma dvd_sub' {k m n : ℕ} (h₁ : k ∣ m) (h₂ : k ∣ n) : k ∣ m - n := +begin + cases le_total n m with H H, + { exact dvd_sub H h₁ h₂ }, + { rw tsub_eq_zero_iff_le.mpr H, + exact dvd_zero k }, +end + +lemma succ_div : ∀ (a b : ℕ), (a + 1) / b = + a / b + if b ∣ a + 1 then 1 else 0 +| a 0 := by simp +| 0 1 := by simp +| 0 (b+2) := have hb2 : b + 2 > 1, from dec_trivial, + by simp [ne_of_gt hb2, div_eq_of_lt hb2] +| (a+1) (b+1) := begin + rw [nat.div_def], conv_rhs { rw nat.div_def }, + by_cases hb_eq_a : b = a + 1, + { simp [hb_eq_a, le_refl] }, + by_cases hb_le_a1 : b ≤ a + 1, + { have hb_le_a : b ≤ a, from le_of_lt_succ (lt_of_le_of_ne hb_le_a1 hb_eq_a), + have h₁ : (0 < b + 1 ∧ b + 1 ≤ a + 1 + 1), + from ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a1⟩, + have h₂ : (0 < b + 1 ∧ b + 1 ≤ a + 1), + from ⟨succ_pos _, (add_le_add_iff_right _).2 hb_le_a⟩, + have dvd_iff : b + 1 ∣ a - b + 1 ↔ b + 1 ∣ a + 1 + 1, + { rw [nat.dvd_add_iff_left (dvd_refl (b + 1)), + ← add_tsub_add_eq_tsub_right a 1 b, add_comm (_ - _), add_assoc, + tsub_add_cancel_of_le (succ_le_succ hb_le_a), add_comm 1] }, + have wf : a - b < a + 1, from lt_succ_of_le tsub_le_self, + rw [if_pos h₁, if_pos h₂, add_tsub_add_eq_tsub_right, ← tsub_add_eq_add_tsub hb_le_a, + by exact have _ := wf, succ_div (a - b), + add_tsub_add_eq_tsub_right], + simp [dvd_iff, succ_eq_add_one, add_comm 1, add_assoc] }, + { have hba : ¬ b ≤ a, + from not_le_of_gt (lt_trans (lt_succ_self a) (lt_of_not_ge hb_le_a1)), + have hb_dvd_a : ¬ b + 1 ∣ a + 2, + from λ h, hb_le_a1 (le_of_succ_le_succ (le_of_dvd (succ_pos _) h)), + simp [hba, hb_le_a1, hb_dvd_a], } +end + +lemma succ_div_of_dvd {a b : ℕ} (hba : b ∣ a + 1) : + (a + 1) / b = a / b + 1 := +by rw [succ_div, if_pos hba] + +lemma succ_div_of_not_dvd {a b : ℕ} (hba : ¬ b ∣ a + 1) : + (a + 1) / b = a / b := +by rw [succ_div, if_neg hba, add_zero] + +lemma dvd_iff_div_mul_eq (n d : ℕ) : d ∣ n ↔ n / d * d = n := +⟨λ h, nat.div_mul_cancel h, λ h, dvd.intro_left (n / d) h⟩ + +lemma dvd_iff_le_div_mul (n d : ℕ) : d ∣ n ↔ n ≤ n / d * d := +((dvd_iff_div_mul_eq _ _).trans le_antisymm_iff).trans (and_iff_right (div_mul_le_self n d)) + +lemma dvd_iff_dvd_dvd (n d : ℕ) : d ∣ n ↔ ∀ k : ℕ, k ∣ d → k ∣ n := +⟨λ h k hkd, dvd_trans hkd h, λ h, h _ dvd_rfl⟩ + +lemma dvd_div_of_mul_dvd {a b c : ℕ} (h : a * b ∣ c) : b ∣ c / a := +if ha : a = 0 then + by simp [ha] +else + have ha : 0 < a, from nat.pos_of_ne_zero ha, + have h1 : ∃ d, c = a * b * d, from h, + let ⟨d, hd⟩ := h1 in + have h2 : c / a = b * d, from nat.div_eq_of_eq_mul_right ha (by simpa [mul_assoc] using hd), + show ∃ d, c / a = b * d, from ⟨d, h2⟩ + +@[simp] lemma dvd_div_iff {a b c : ℕ} (hbc : c ∣ b) : a ∣ b / c ↔ c * a ∣ b := +⟨λ h, mul_dvd_of_dvd_div hbc h, λ h, dvd_div_of_mul_dvd h⟩ + +@[simp] +lemma div_div_div_eq_div : ∀ {a b c : ℕ} (dvd : b ∣ a) (dvd2 : a ∣ c), (c / (a / b)) / b = c / a +| 0 _ := by simp +| (a + 1) 0 := λ _ dvd _, by simpa using dvd +| (a + 1) (c + 1) := +have a_split : a + 1 ≠ 0 := succ_ne_zero a, +have c_split : c + 1 ≠ 0 := succ_ne_zero c, +λ b dvd dvd2, +begin + rcases dvd2 with ⟨k, rfl⟩, + rcases dvd with ⟨k2, pr⟩, + have k2_nonzero : k2 ≠ 0 := λ k2_zero, by simpa [k2_zero] using pr, + rw [nat.mul_div_cancel_left k (nat.pos_of_ne_zero a_split), pr, + nat.mul_div_cancel_left k2 (nat.pos_of_ne_zero c_split), nat.mul_comm ((c + 1) * k2) k, + ←nat.mul_assoc k (c + 1) k2, nat.mul_div_cancel _ (nat.pos_of_ne_zero k2_nonzero), + nat.mul_div_cancel _ (nat.pos_of_ne_zero c_split)], +end + +/-- If a small natural number is divisible by a larger natural number, +the small number is zero. -/ +lemma eq_zero_of_dvd_of_lt {a b : ℕ} (w : a ∣ b) (h : b < a) : b = 0 := +nat.eq_zero_of_dvd_of_div_eq_zero w + ((nat.div_eq_zero_iff (lt_of_le_of_lt (zero_le b) h)).elim_right h) + +lemma le_of_lt_add_of_dvd (h : a < b + n) : n ∣ a → n ∣ b → a ≤ b := +begin + rintro ⟨a, rfl⟩ ⟨b, rfl⟩, + rw ←mul_add_one at h, + exact mul_le_mul_left' (lt_succ_iff.1 $ lt_of_mul_lt_mul_left h bot_le) _, +end + +@[simp] lemma mod_div_self (m n : ℕ) : m % n / n = 0 := +begin + cases n, + { exact (m % 0).div_zero }, + { exact nat.div_eq_zero (m.mod_lt n.succ_pos) } +end + +/-- `n` is not divisible by `a` iff it is between `a * k` and `a * (k + 1)` for some `k`. -/ +lemma not_dvd_iff_between_consec_multiples (n : ℕ) {a : ℕ} (ha : 0 < a) : + (∃ k : ℕ, a * k < n ∧ n < a * (k + 1)) ↔ ¬ a ∣ n := +begin + refine ⟨λ ⟨k, hk1, hk2⟩, not_dvd_of_between_consec_multiples hk1 hk2, + λ han, ⟨n/a, ⟨lt_of_le_of_ne (mul_div_le n a) _, lt_mul_div_succ _ ha⟩⟩⟩, + exact mt (dvd.intro (n/a)) han, +end + +/-- Two natural numbers are equal if and only if they have the same multiples. -/ +lemma dvd_right_iff_eq {m n : ℕ} : (∀ a : ℕ, m ∣ a ↔ n ∣ a) ↔ m = n := +⟨λ h, dvd_antisymm ((h _).mpr dvd_rfl) ((h _).mp dvd_rfl), λ h n, by rw h⟩ + +/-- Two natural numbers are equal if and only if they have the same divisors. -/ +lemma dvd_left_iff_eq {m n : ℕ} : (∀ a : ℕ, a ∣ m ↔ a ∣ n) ↔ m = n := +⟨λ h, dvd_antisymm ((h _).mp dvd_rfl) ((h _).mpr dvd_rfl), λ h n, by rw h⟩ + +/-- `dvd` is injective in the left argument -/ +lemma dvd_left_injective : function.injective ((∣) : ℕ → ℕ → Prop) := +λ m n h, dvd_right_iff_eq.mp $ λ a, iff_of_eq (congr_fun h a) + +lemma div_lt_div_of_lt_of_dvd {a b d : ℕ} (hdb : d ∣ b) (h : a < b) : a / d < b / d := +by { rw nat.lt_div_iff_mul_lt hdb, exact lt_of_le_of_lt (mul_div_le a d) h } + +end nat diff --git a/src/data/nat/pairing.lean b/src/data/nat/pairing.lean index 3b61b8826f839..0dad86e65afa3 100644 --- a/src/data/nat/pairing.lean +++ b/src/data/nat/pairing.lean @@ -5,10 +5,15 @@ Authors: Leonardo de Moura, Mario Carneiro -/ import data.nat.sqrt import data.set.lattice +import algebra.group.prod +import algebra.order.monoid.min_max /-! # Naturals pairing function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a pairing function for the naturals as follows: ```text 0 1 4 9 16 @@ -129,6 +134,32 @@ begin exact le_trans h₁ (nat.le_add_left _ _) } end +theorem mkpair_lt_max_add_one_sq (m n : ℕ) : mkpair m n < (max m n + 1) ^ 2 := +begin + rw [mkpair, add_sq, mul_one, two_mul, sq, add_assoc, add_assoc], + cases lt_or_le m n, + { rw [if_pos h, max_eq_right h.le, add_lt_add_iff_left, add_assoc], + exact h.trans_le (self_le_add_right n _) }, + { rw [if_neg h.not_lt, max_eq_left h, add_lt_add_iff_left, add_assoc, add_lt_add_iff_left], + exact lt_succ_of_le h } +end + +theorem max_sq_add_min_le_mkpair (m n : ℕ) : max m n ^ 2 + min m n ≤ mkpair m n := +begin + rw mkpair, + cases lt_or_le m n, + { rw [if_pos h, max_eq_right h.le, min_eq_left h.le, sq], }, + { rw [if_neg h.not_lt, max_eq_left h, min_eq_right h, sq, add_assoc, add_le_add_iff_left], + exact le_add_self } +end + +theorem add_le_mkpair (m n : ℕ) : m + n ≤ mkpair m n := +(max_sq_add_min_le_mkpair _ _).trans' $ + by { rw [sq, ←min_add_max, add_comm, add_le_add_iff_right], exact le_mul_self _ } + +theorem unpair_add_le (n : ℕ) : (unpair n).1 + (unpair n).2 ≤ n := +(add_le_mkpair _ _).trans_eq (mkpair_unpair _) + end nat open nat diff --git a/src/data/nat/parity.lean b/src/data/nat/parity.lean index 193b5d089bca7..5ec996b4dfb0b 100644 --- a/src/data/nat/parity.lean +++ b/src/data/nat/parity.lean @@ -9,6 +9,9 @@ import algebra.parity /-! # Parity of natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains theorems about the `even` and `odd` predicates on the natural numbers. ## Tags @@ -72,16 +75,21 @@ begin one_ne_zero, and_self] }, end -lemma odd_gt_zero (h : odd n) : 0 < n := -by { obtain ⟨k, rfl⟩ := h, exact succ_pos' } - @[simp] theorem two_dvd_ne_zero : ¬ 2 ∣ n ↔ n % 2 = 1 := even_iff_two_dvd.symm.not.trans not_even_iff instance : decidable_pred (even : ℕ → Prop) := λ n, decidable_of_iff _ even_iff.symm instance : decidable_pred (odd : ℕ → Prop) := λ n, decidable_of_iff _ odd_iff_not_even.symm -mk_simp_attribute parity_simps "Simp attribute for lemmas about `even`" +theorem mod_two_add_add_odd_mod_two (m : ℕ) {n : ℕ} (hn : odd n) : m % 2 + (m + n) % 2 = 1 := +(even_or_odd m).elim (λ hm, by rw [even_iff.1 hm, odd_iff.1 (hm.add_odd hn)]) $ + λ hm, by rw [odd_iff.1 hm, even_iff.1 (hm.add_odd hn)] + +@[simp] theorem mod_two_add_succ_mod_two (m : ℕ) : m % 2 + (m + 1) % 2 = 1 := +mod_two_add_add_odd_mod_two m odd_one + +@[simp] theorem succ_mod_two_add_mod_two (m : ℕ) : (m + 1) % 2 + m % 2 = 1 := +by rw [add_comm, mod_two_add_succ_mod_two] @[simp] theorem not_even_one : ¬ even 1 := by rw even_iff; norm_num @@ -95,6 +103,9 @@ by cases mod_two_eq_zero_or_one m with h₁ h₁; theorem even_add' : even (m + n) ↔ (odd m ↔ odd n) := by rw [even_add, even_iff_not_odd, even_iff_not_odd, not_iff_not] +@[parity_simps] theorem even_add_one : even (n + 1) ↔ ¬ even n := +by simp [even_add] + @[simp] theorem not_even_bit1 (n : ℕ) : ¬ even (bit1 n) := by simp [bit1] with parity_simps @@ -118,9 +129,6 @@ theorem odd.sub_odd (hm : odd m) (hn : odd n) : even (m - n) := (λ h, by simp only [even_sub' h, *]) (λ h, by simp only [tsub_eq_zero_iff_le.mpr h, even_zero]) -@[parity_simps] theorem even_succ : even (succ n) ↔ ¬ even n := -by rw [succ_eq_add_one, even_add]; simp [not_even_one] - @[parity_simps] theorem even_mul : even (m * n) ↔ even m ∨ even n := by cases mod_two_eq_zero_or_one m with h₁ h₁; cases mod_two_eq_zero_or_one n with h₂ h₂; @@ -183,13 +191,10 @@ begin apply even_mul_succ_self } end -lemma even_sub_one_of_prime_ne_two {p : ℕ} (hp : prime p) (hodd : p ≠ 2) : even (p - 1) := -odd.sub_odd (odd_iff.2 $ hp.eq_two_or_odd.resolve_left hodd) (odd_iff.2 rfl) - lemma two_mul_div_two_of_even : even n → 2 * (n / 2) = n := λ h, nat.mul_div_cancel_left' (even_iff_two_dvd.mp h) -lemma div_two_mul_two_of_even : even n → n / 2 * 2 = n := --nat.div_mul_cancel +lemma div_two_mul_two_of_even : even n → n / 2 * 2 = n := λ h, nat.div_mul_cancel (even_iff_two_dvd.mp h) lemma two_mul_div_two_add_one_of_odd (h : odd n) : 2 * (n / 2) + 1 = n := @@ -201,6 +206,31 @@ by { convert nat.div_add_mod' n 2, rw odd_iff.mp h } lemma one_add_div_two_mul_two_of_odd (h : odd n) : 1 + n / 2 * 2 = n := by { rw add_comm, convert nat.div_add_mod' n 2, rw odd_iff.mp h } +lemma bit0_div_two : bit0 n / 2 = n := +by rw [←nat.bit0_eq_bit0, bit0_eq_two_mul, two_mul_div_two_of_even (even_bit0 n)] + +lemma bit1_div_two : bit1 n / 2 = n := +by rw [←nat.bit1_eq_bit1, bit1, bit0_eq_two_mul, nat.two_mul_div_two_add_one_of_odd (odd_bit1 n)] + +@[simp] lemma bit0_div_bit0 : bit0 n / bit0 m = n / m := +by rw [bit0_eq_two_mul m, ←nat.div_div_eq_div_mul, bit0_div_two] + +@[simp] lemma bit1_div_bit0 : bit1 n / bit0 m = n / m := +by rw [bit0_eq_two_mul, ←nat.div_div_eq_div_mul, bit1_div_two] + +@[simp] lemma bit0_mod_bit0 : bit0 n % bit0 m = bit0 (n % m) := +by rw [bit0_eq_two_mul n, bit0_eq_two_mul m, bit0_eq_two_mul (n % m), nat.mul_mod_mul_left] + +@[simp] lemma bit1_mod_bit0 : bit1 n % bit0 m = bit1 (n % m) := +begin + have h₁ := congr_arg bit1 (nat.div_add_mod n m), + -- `∀ m n : ℕ, bit0 m * n = bit0 (m * n)` seems to be missing... + rw [bit1_add, bit0_eq_two_mul, ← mul_assoc, ← bit0_eq_two_mul] at h₁, + have h₂ := nat.div_add_mod (bit1 n) (bit0 m), + rw [bit1_div_bit0] at h₂, + exact add_left_cancel (h₂.trans h₁.symm), +end + -- Here are examples of how `parity_simps` can be used with `nat`. example (m n : ℕ) (h : even m) : ¬ even (n + 3) ↔ even (m^2 + m + n) := @@ -213,8 +243,62 @@ end nat open nat +namespace function +namespace involutive + +variables {α : Type*} {f : α → α} {n : ℕ} + +theorem iterate_bit0 (hf : involutive f) (n : ℕ) : f^[bit0 n] = id := +by rw [bit0, ← two_mul, iterate_mul, involutive_iff_iter_2_eq_id.1 hf, iterate_id] + +theorem iterate_bit1 (hf : involutive f) (n : ℕ) : f^[bit1 n] = f := +by rw [bit1, iterate_succ, hf.iterate_bit0, comp.left_id] + +theorem iterate_even (hf : involutive f) (hn : even n) : f^[n] = id := +let ⟨m, hm⟩ := hn in hm.symm ▸ hf.iterate_bit0 m + +theorem iterate_odd (hf : involutive f) (hn : odd n) : f^[n] = f := +let ⟨m, hm⟩ := odd_iff_exists_bit1.mp hn in hm.symm ▸ hf.iterate_bit1 m + +theorem iterate_eq_self (hf : involutive f) (hne : f ≠ id) : f^[n] = f ↔ odd n := +⟨λ H, odd_iff_not_even.2 $ λ hn, hne $ by rwa [hf.iterate_even hn, eq_comm] at H, hf.iterate_odd⟩ + +theorem iterate_eq_id (hf : involutive f) (hne : f ≠ id) : f^[n] = id ↔ even n := +⟨λ H, even_iff_not_odd.2 $ λ hn, hne $ by rwa [hf.iterate_odd hn] at H, hf.iterate_even⟩ + +end involutive +end function + variables {R : Type*} [monoid R] [has_distrib_neg R] {n : ℕ} lemma neg_one_pow_eq_one_iff_even (h : (-1 : R) ≠ 1) : (-1 : R) ^ n = 1 ↔ even n := ⟨λ h', of_not_not $ λ hn, h $ (odd.neg_one_pow $ odd_iff_not_even.mpr hn).symm.trans h', even.neg_one_pow⟩ + +/-- If `a` is even, then `n` is odd iff `n % a` is odd. -/ +lemma odd.mod_even_iff {n a : ℕ} (ha : even a) : odd (n % a) ↔ odd n := +((even_sub' $ mod_le n a).mp $ even_iff_two_dvd.mpr $ (even_iff_two_dvd.mp ha).trans $ + dvd_sub_mod n).symm + +/-- If `a` is even, then `n` is even iff `n % a` is even. -/ +lemma even.mod_even_iff {n a : ℕ} (ha : even a) : even (n % a) ↔ even n := +((even_sub $ mod_le n a).mp $ even_iff_two_dvd.mpr $ (even_iff_two_dvd.mp ha).trans $ + dvd_sub_mod n).symm + +/-- If `n` is odd and `a` is even, then `n % a` is odd. -/ +lemma odd.mod_even {n a : ℕ} (hn : odd n) (ha : even a) : odd (n % a) := +(odd.mod_even_iff ha).mpr hn + +/-- If `n` is even and `a` is even, then `n % a` is even. -/ +lemma even.mod_even {n a : ℕ} (hn : even n) (ha : even a) : even (n % a) := +(even.mod_even_iff ha).mpr hn + +theorem odd.of_dvd_nat {m n : ℕ} (hn : odd n) (hm : m ∣ n) : odd m := +odd_iff_not_even.2 $ mt hm.even (odd_iff_not_even.1 hn) + +/-- `2` is not a factor of an odd natural number. -/ +theorem odd.ne_two_of_dvd_nat {m n : ℕ} (hn : odd n) (hm : m ∣ n) : m ≠ 2 := +begin + rintro rfl, + exact absurd (hn.of_dvd_nat hm) dec_trivial +end diff --git a/src/data/nat/part_enat.lean b/src/data/nat/part_enat.lean new file mode 100644 index 0000000000000..599f44cb6f70e --- /dev/null +++ b/src/data/nat/part_enat.lean @@ -0,0 +1,573 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes +-/ +import algebra.hom.equiv.basic +import data.part +import data.enat.lattice +import tactic.norm_num + +/-! +# Natural numbers with infinity + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The natural numbers and an extra `top` element `⊤`. This implementation uses `part ℕ` as an +implementation. Use `ℕ∞` instead unless you care about computability. + +## Main definitions + +The following instances are defined: + +* `ordered_add_comm_monoid part_enat` +* `canonically_ordered_add_monoid part_enat` +* `complete_linear_order part_enat` + +There is no additive analogue of `monoid_with_zero`; if there were then `part_enat` could +be an `add_monoid_with_top`. + +* `to_with_top` : the map from `part_enat` to `ℕ∞`, with theorems that it plays well +with `+` and `≤`. + +* `with_top_add_equiv : part_enat ≃+ ℕ∞` +* `with_top_order_iso : part_enat ≃o ℕ∞` + +## Implementation details + +`part_enat` is defined to be `part ℕ`. + +`+` and `≤` are defined on `part_enat`, but there is an issue with `*` because it's not +clear what `0 * ⊤` should be. `mul` is hence left undefined. Similarly `⊤ - ⊤` is ambiguous +so there is no `-` defined on `part_enat`. + +Before the `open_locale classical` line, various proofs are made with decidability assumptions. +This can cause issues -- see for example the non-simp lemma `to_with_top_zero` proved by `rfl`, +followed by `@[simp] lemma to_with_top_zero'` whose proof uses `convert`. + + +## Tags + +part_enat, ℕ∞ +-/ +open part (hiding some) + +/-- Type of natural numbers with infinity (`⊤`) -/ +def part_enat : Type := part ℕ + +namespace part_enat + +/-- The computable embedding `ℕ → part_enat`. + +This coincides with the coercion `coe : ℕ → part_enat`, see `part_enat.some_eq_coe`. +However, `coe` is noncomputable so `some` is preferable when computability is a concern. -/ +def some : ℕ → part_enat := part.some + +instance : has_zero part_enat := ⟨some 0⟩ +instance : inhabited part_enat := ⟨0⟩ +instance : has_one part_enat := ⟨some 1⟩ +instance : has_add part_enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, get x h.1 + get y h.2⟩⟩ + +instance (n : ℕ) : decidable (some n).dom := is_true trivial + +@[simp] lemma dom_some (x : ℕ) : (some x).dom := trivial + +instance : add_comm_monoid part_enat := +{ add := (+), + zero := (0), + add_comm := λ x y, part.ext' and.comm (λ _ _, add_comm _ _), + zero_add := λ x, part.ext' (true_and _) (λ _ _, zero_add _), + add_zero := λ x, part.ext' (and_true _) (λ _ _, add_zero _), + add_assoc := λ x y z, part.ext' and.assoc (λ _ _, add_assoc _ _ _) } + +instance : add_comm_monoid_with_one part_enat := +{ one := 1, + nat_cast := some, + nat_cast_zero := rfl, + nat_cast_succ := λ _, part.ext' (true_and _).symm (λ _ _, rfl), + .. part_enat.add_comm_monoid } + +lemma some_eq_coe (n : ℕ) : some n = n := rfl + +@[simp, norm_cast] lemma coe_inj {x y : ℕ} : (x : part_enat) = y ↔ x = y := part.some_inj + +@[simp] lemma dom_coe (x : ℕ) : (x : part_enat).dom := trivial + +instance : can_lift part_enat ℕ coe dom := ⟨λ n hn, ⟨n.get hn, part.some_get _⟩⟩ + +instance : has_le part_enat := ⟨λ x y, ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy⟩ +instance : has_top part_enat := ⟨none⟩ +instance : has_bot part_enat := ⟨0⟩ +instance : has_sup part_enat := ⟨λ x y, ⟨x.dom ∧ y.dom, λ h, x.get h.1 ⊔ y.get h.2⟩⟩ + +lemma le_def (x y : part_enat) : + x ≤ y ↔ ∃ h : y.dom → x.dom, ∀ hy : y.dom, x.get (h hy) ≤ y.get hy := +iff.rfl + +@[elab_as_eliminator] protected lemma cases_on' {P : part_enat → Prop} : + ∀ a : part_enat, P ⊤ → (∀ n : ℕ, P (some n)) → P a := +part.induction_on + +@[elab_as_eliminator] protected lemma cases_on {P : part_enat → Prop} : + ∀ a : part_enat, P ⊤ → (∀ n : ℕ, P n) → P a := +by { simp only [← some_eq_coe], exact part_enat.cases_on' } + +@[simp] lemma top_add (x : part_enat) : ⊤ + x = ⊤ := +part.ext' (false_and _) (λ h, h.left.elim) + +@[simp] lemma add_top (x : part_enat) : x + ⊤ = ⊤ := +by rw [add_comm, top_add] + +@[simp] lemma coe_get {x : part_enat} (h : x.dom) : (x.get h : part_enat) = x := +by { rw [← some_eq_coe], exact part.ext' (iff_of_true trivial h) (λ _ _, rfl) } + +@[simp, norm_cast] lemma get_coe' (x : ℕ) (h : (x : part_enat).dom) : get (x : part_enat) h = x := +by rw [← coe_inj, coe_get] + +lemma get_coe {x : ℕ} : get (x : part_enat) (dom_coe x) = x := get_coe' _ _ + +lemma coe_add_get {x : ℕ} {y : part_enat} (h : ((x : part_enat) + y).dom) : + get ((x : part_enat) + y) h = x + get y h.2 := +by { simp only [← some_eq_coe] at h ⊢, refl } + +@[simp] lemma get_add {x y : part_enat} (h : (x + y).dom) : + get (x + y) h = x.get h.1 + y.get h.2 := rfl + +@[simp] lemma get_zero (h : (0 : part_enat).dom) : (0 : part_enat).get h = 0 := rfl + +@[simp] lemma get_one (h : (1 : part_enat).dom) : (1 : part_enat).get h = 1 := rfl + +lemma get_eq_iff_eq_some {a : part_enat} {ha : a.dom} {b : ℕ} : + a.get ha = b ↔ a = some b := get_eq_iff_eq_some + +lemma get_eq_iff_eq_coe {a : part_enat} {ha : a.dom} {b : ℕ} : + a.get ha = b ↔ a = b := by rw [get_eq_iff_eq_some, some_eq_coe] + +lemma dom_of_le_of_dom {x y : part_enat} : x ≤ y → y.dom → x.dom := λ ⟨h, _⟩, h + +lemma dom_of_le_some {x : part_enat} {y : ℕ} (h : x ≤ some y) : x.dom := dom_of_le_of_dom h trivial + +lemma dom_of_le_coe {x : part_enat} {y : ℕ} (h : x ≤ y) : x.dom := +by { rw [← some_eq_coe] at h, exact dom_of_le_some h } + +instance decidable_le (x y : part_enat) [decidable x.dom] [decidable y.dom] : decidable (x ≤ y) := +if hx : x.dom +then decidable_of_decidable_of_iff + (show decidable (∀ (hy : (y : part_enat).dom), x.get hx ≤ (y : part_enat).get hy), + from forall_prop_decidable _) $ + by { dsimp [(≤)], simp only [hx, exists_prop_of_true, forall_true_iff] } +else if hy : y.dom +then is_false $ λ h, hx $ dom_of_le_of_dom h hy +else is_true ⟨λ h, (hy h).elim, λ h, (hy h).elim⟩ + +/-- The coercion `ℕ → part_enat` preserves `0` and addition. -/ +def coe_hom : ℕ →+ part_enat := ⟨coe, nat.cast_zero, nat.cast_add⟩ + +@[simp] lemma coe_coe_hom : ⇑coe_hom = coe := rfl + +instance : partial_order part_enat := +{ le := (≤), + le_refl := λ x, ⟨id, λ _, le_rfl⟩, + le_trans := λ x y z ⟨hxy₁, hxy₂⟩ ⟨hyz₁, hyz₂⟩, + ⟨hxy₁ ∘ hyz₁, λ _, le_trans (hxy₂ _) (hyz₂ _)⟩, + le_antisymm := λ x y ⟨hxy₁, hxy₂⟩ ⟨hyx₁, hyx₂⟩, part.ext' ⟨hyx₁, hxy₁⟩ + (λ _ _, le_antisymm (hxy₂ _) (hyx₂ _)) } + +lemma lt_def (x y : part_enat) : x < y ↔ ∃ (hx : x.dom), ∀ (hy : y.dom), x.get hx < y.get hy := +begin + rw [lt_iff_le_not_le, le_def, le_def, not_exists], + split, + { rintro ⟨⟨hyx, H⟩, h⟩, + by_cases hx : x.dom, + { use hx, intro hy, + specialize H hy, specialize h (λ _, hy), + rw not_forall at h, cases h with hx' h, + rw not_le at h, exact h }, + { specialize h (λ hx', (hx hx').elim), + rw not_forall at h, cases h with hx' h, + exact (hx hx').elim } }, + { rintro ⟨hx, H⟩, exact ⟨⟨λ _, hx, λ hy, (H hy).le⟩, λ hxy h, not_lt_of_le (h _) (H _)⟩ } +end + +@[simp, norm_cast] lemma coe_le_coe {x y : ℕ} : (x : part_enat) ≤ y ↔ x ≤ y := +by { rw [← some_eq_coe, ← some_eq_coe], exact ⟨λ ⟨_, h⟩, h trivial, λ h, ⟨λ _, trivial, λ _, h⟩⟩ } + +@[simp, norm_cast] lemma coe_lt_coe {x y : ℕ} : (x : part_enat) < y ↔ x < y := +by rw [lt_iff_le_not_le, lt_iff_le_not_le, coe_le_coe, coe_le_coe] + +@[simp] lemma get_le_get {x y : part_enat} {hx : x.dom} {hy : y.dom} : + x.get hx ≤ y.get hy ↔ x ≤ y := +by conv { to_lhs, rw [← coe_le_coe, coe_get, coe_get]} + +lemma le_coe_iff (x : part_enat) (n : ℕ) : x ≤ n ↔ ∃ h : x.dom, x.get h ≤ n := +begin + rw [← some_eq_coe], + show (∃ (h : true → x.dom), _) ↔ ∃ h : x.dom, x.get h ≤ n, + simp only [forall_prop_of_true, some_eq_coe, dom_coe, get_coe'] +end + +lemma lt_coe_iff (x : part_enat) (n : ℕ) : x < n ↔ ∃ h : x.dom, x.get h < n := +by simp only [lt_def, forall_prop_of_true, get_coe', dom_coe] + +lemma coe_le_iff (n : ℕ) (x : part_enat) : (n : part_enat) ≤ x ↔ ∀ h : x.dom, n ≤ x.get h := +begin + rw [← some_eq_coe], + simp only [le_def, exists_prop_of_true, dom_some, forall_true_iff], + refl, +end + +lemma coe_lt_iff (n : ℕ) (x : part_enat) : (n : part_enat) < x ↔ ∀ h : x.dom, n < x.get h := +begin + rw [← some_eq_coe], + simp only [lt_def, exists_prop_of_true, dom_some, forall_true_iff], + refl, +end + +instance ne_zero.one : ne_zero (1 : part_enat) := ⟨coe_inj.not.mpr dec_trivial⟩ + +instance semilattice_sup : semilattice_sup part_enat := +{ sup := (⊔), + le_sup_left := λ _ _, ⟨and.left, λ _, le_sup_left⟩, + le_sup_right := λ _ _, ⟨and.right, λ _, le_sup_right⟩, + sup_le := λ x y z ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩, ⟨λ hz, ⟨hx₁ hz, hy₁ hz⟩, + λ _, sup_le (hx₂ _) (hy₂ _)⟩, + ..part_enat.partial_order } + +instance order_bot : order_bot part_enat := +{ bot := (⊥), + bot_le := λ _, ⟨λ _, trivial, λ _, nat.zero_le _⟩ } + +instance order_top : order_top part_enat := +{ top := (⊤), + le_top := λ x, ⟨λ h, false.elim h, λ hy, false.elim hy⟩ } + +lemma eq_zero_iff {x : part_enat} : x = 0 ↔ x ≤ 0 := eq_bot_iff +lemma ne_zero_iff {x : part_enat} : x ≠ 0 ↔ ⊥ < x := bot_lt_iff_ne_bot.symm + +lemma dom_of_lt {x y : part_enat} : x < y → x.dom := +part_enat.cases_on x not_top_lt $ λ _ _, dom_coe _ + +lemma top_eq_none : (⊤ : part_enat) = none := rfl + +@[simp] lemma coe_lt_top (x : ℕ) : (x : part_enat) < ⊤ := +ne.lt_top (λ h, absurd (congr_arg dom h) $ by simpa only [dom_coe] using true_ne_false) + +@[simp] lemma coe_ne_top (x : ℕ) : (x : part_enat) ≠ ⊤ := ne_of_lt (coe_lt_top x) + +lemma not_is_max_coe (x : ℕ) : ¬ is_max (x : part_enat) := +not_is_max_of_lt (coe_lt_top x) + +lemma ne_top_iff {x : part_enat} : x ≠ ⊤ ↔ ∃ (n : ℕ), x = n := +by simpa only [← some_eq_coe] using part.ne_none_iff + +lemma ne_top_iff_dom {x : part_enat} : x ≠ ⊤ ↔ x.dom := +by classical; exact not_iff_comm.1 part.eq_none_iff'.symm + +lemma not_dom_iff_eq_top {x : part_enat} : ¬ x.dom ↔ x = ⊤ := +iff.not_left ne_top_iff_dom.symm + +lemma ne_top_of_lt {x y : part_enat} (h : x < y) : x ≠ ⊤ := +ne_of_lt $ lt_of_lt_of_le h le_top + +lemma eq_top_iff_forall_lt (x : part_enat) : x = ⊤ ↔ ∀ n : ℕ, (n : part_enat) < x := +begin + split, + { rintro rfl n, exact coe_lt_top _ }, + { contrapose!, rw ne_top_iff, rintro ⟨n, rfl⟩, exact ⟨n, irrefl _⟩ } +end + +lemma eq_top_iff_forall_le (x : part_enat) : x = ⊤ ↔ ∀ n : ℕ, (n : part_enat) ≤ x := +(eq_top_iff_forall_lt x).trans +⟨λ h n, (h n).le, λ h n, lt_of_lt_of_le (coe_lt_coe.mpr n.lt_succ_self) (h (n + 1))⟩ + +lemma pos_iff_one_le {x : part_enat} : 0 < x ↔ 1 ≤ x := +part_enat.cases_on x (by simp only [iff_true, le_top, coe_lt_top, ← @nat.cast_zero part_enat]) $ + λ n, by { rw [← nat.cast_zero, ← nat.cast_one, part_enat.coe_lt_coe, part_enat.coe_le_coe], refl } + +instance : is_total part_enat (≤) := +{ total := λ x y, part_enat.cases_on x + (or.inr le_top) (part_enat.cases_on y (λ _, or.inl le_top) + (λ x y, (le_total x y).elim (or.inr ∘ coe_le_coe.2) + (or.inl ∘ coe_le_coe.2))) } + +noncomputable instance : linear_order part_enat := +{ le_total := is_total.total, + decidable_le := classical.dec_rel _, + max := (⊔), + max_def := @sup_eq_max_default _ _ (id _) _, + ..part_enat.partial_order } + +instance : bounded_order part_enat := +{ ..part_enat.order_top, + ..part_enat.order_bot } + +noncomputable instance : lattice part_enat := +{ inf := min, + inf_le_left := min_le_left, + inf_le_right := min_le_right, + le_inf := λ _ _ _, le_min, + ..part_enat.semilattice_sup } + +instance : ordered_add_comm_monoid part_enat := +{ add_le_add_left := λ a b ⟨h₁, h₂⟩ c, + part_enat.cases_on c (by simp) + (λ c, ⟨λ h, and.intro (dom_coe _) (h₁ h.2), + λ h, by simpa only [coe_add_get] using add_le_add_left (h₂ _) c⟩), + ..part_enat.linear_order, + ..part_enat.add_comm_monoid } + +instance : canonically_ordered_add_monoid part_enat := +{ le_self_add := λ a b, part_enat.cases_on b (le_top.trans_eq (add_top _).symm) $ + λ b, part_enat.cases_on a (top_add _).ge $ + λ a, (coe_le_coe.2 le_self_add).trans_eq (nat.cast_add _ _), + exists_add_of_le := λ a b, part_enat.cases_on b (λ _, ⟨⊤, (add_top _).symm⟩) $ + λ b, part_enat.cases_on a (λ h, ((coe_lt_top _).not_le h).elim) $ λ a h, ⟨(b - a : ℕ), + by rw [←nat.cast_add, coe_inj, add_comm, tsub_add_cancel_of_le (coe_le_coe.1 h)]⟩, + ..part_enat.semilattice_sup, + ..part_enat.order_bot, + ..part_enat.ordered_add_comm_monoid } + +lemma eq_coe_sub_of_add_eq_coe {x y : part_enat} {n : ℕ} (h : x + y = n) : + x = ↑(n - y.get (dom_of_le_coe ((le_add_left le_rfl).trans_eq h))) := +begin + lift x to ℕ using dom_of_le_coe ((le_add_right le_rfl).trans_eq h), + lift y to ℕ using dom_of_le_coe ((le_add_left le_rfl).trans_eq h), + rw [← nat.cast_add, coe_inj] at h, + rw [get_coe, coe_inj, eq_tsub_of_add_eq h] +end + +protected lemma add_lt_add_right {x y z : part_enat} (h : x < y) (hz : z ≠ ⊤) : x + z < y + z := +begin + rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩, + rcases ne_top_iff.mp hz with ⟨k, rfl⟩, + induction y using part_enat.cases_on with n, + { rw [top_add], apply_mod_cast coe_lt_top }, + norm_cast at h, apply_mod_cast add_lt_add_right h +end + +protected lemma add_lt_add_iff_right {x y z : part_enat} (hz : z ≠ ⊤) : x + z < y + z ↔ x < y := +⟨lt_of_add_lt_add_right, λ h, part_enat.add_lt_add_right h hz⟩ + +protected lemma add_lt_add_iff_left {x y z : part_enat} (hz : z ≠ ⊤) : z + x < z + y ↔ x < y := +by rw [add_comm z, add_comm z, part_enat.add_lt_add_iff_right hz] + +protected lemma lt_add_iff_pos_right {x y : part_enat} (hx : x ≠ ⊤) : x < x + y ↔ 0 < y := +by { conv_rhs { rw [← part_enat.add_lt_add_iff_left hx] }, rw [add_zero] } + +lemma lt_add_one {x : part_enat} (hx : x ≠ ⊤) : x < x + 1 := +by { rw [part_enat.lt_add_iff_pos_right hx], norm_cast, norm_num } + +lemma le_of_lt_add_one {x y : part_enat} (h : x < y + 1) : x ≤ y := +begin + induction y using part_enat.cases_on with n, apply le_top, + rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩, + apply_mod_cast nat.le_of_lt_succ, apply_mod_cast h +end + +lemma add_one_le_of_lt {x y : part_enat} (h : x < y) : x + 1 ≤ y := +begin + induction y using part_enat.cases_on with n, apply le_top, + rcases ne_top_iff.mp (ne_top_of_lt h) with ⟨m, rfl⟩, + apply_mod_cast nat.succ_le_of_lt, apply_mod_cast h +end + +lemma add_one_le_iff_lt {x y : part_enat} (hx : x ≠ ⊤) : x + 1 ≤ y ↔ x < y := +begin + split, swap, exact add_one_le_of_lt, + intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩, + induction y using part_enat.cases_on with n, apply coe_lt_top, + apply_mod_cast nat.lt_of_succ_le, apply_mod_cast h +end + +lemma coe_succ_le_iff {n : ℕ} {e : part_enat} : ↑n.succ ≤ e ↔ ↑n < e:= +by rw [nat.succ_eq_add_one n, nat.cast_add, nat.cast_one, add_one_le_iff_lt (coe_ne_top n)] + +lemma lt_add_one_iff_lt {x y : part_enat} (hx : x ≠ ⊤) : x < y + 1 ↔ x ≤ y := +begin + split, exact le_of_lt_add_one, + intro h, rcases ne_top_iff.mp hx with ⟨m, rfl⟩, + induction y using part_enat.cases_on with n, { rw [top_add], apply coe_lt_top }, + apply_mod_cast nat.lt_succ_of_le, apply_mod_cast h +end + +lemma lt_coe_succ_iff_le {x : part_enat} {n : ℕ} (hx : x ≠ ⊤) : x < n.succ ↔ x ≤ n := +by rw [nat.succ_eq_add_one n, nat.cast_add, nat.cast_one, lt_add_one_iff_lt hx] + +lemma add_eq_top_iff {a b : part_enat} : a + b = ⊤ ↔ a = ⊤ ∨ b = ⊤ := +by apply part_enat.cases_on a; apply part_enat.cases_on b; + simp; simp only [(nat.cast_add _ _).symm, part_enat.coe_ne_top]; simp + +protected lemma add_right_cancel_iff {a b c : part_enat} (hc : c ≠ ⊤) : a + c = b + c ↔ a = b := +begin + rcases ne_top_iff.1 hc with ⟨c, rfl⟩, + apply part_enat.cases_on a; apply part_enat.cases_on b; + simp [add_eq_top_iff, coe_ne_top, @eq_comm _ (⊤ : part_enat)]; + simp only [(nat.cast_add _ _).symm, add_left_cancel_iff, part_enat.coe_inj, add_comm]; + tauto +end + +protected lemma add_left_cancel_iff {a b c : part_enat} (ha : a ≠ ⊤) : a + b = a + c ↔ b = c := +by rw [add_comm a, add_comm a, part_enat.add_right_cancel_iff ha] + +section with_top + +/-- Computably converts an `part_enat` to a `ℕ∞`. -/ +def to_with_top (x : part_enat) [decidable x.dom] : ℕ∞ := x.to_option + +lemma to_with_top_top : to_with_top ⊤ = ⊤ := rfl + +@[simp] lemma to_with_top_top' {h : decidable (⊤ : part_enat).dom} : to_with_top ⊤ = ⊤ := +by convert to_with_top_top + +lemma to_with_top_zero : to_with_top 0 = 0 := rfl + +@[simp] lemma to_with_top_zero' {h : decidable (0 : part_enat).dom} : to_with_top 0 = 0 := +by convert to_with_top_zero + +lemma to_with_top_some (n : ℕ) : to_with_top (some n) = n := rfl + +lemma to_with_top_coe (n : ℕ) {_ : decidable (n : part_enat).dom} : to_with_top n = n := +by simp only [← some_eq_coe, ← to_with_top_some] + +@[simp] lemma to_with_top_coe' (n : ℕ) {h : decidable (n : part_enat).dom} : + to_with_top (n : part_enat) = n := +by convert to_with_top_coe n + +@[simp] lemma to_with_top_le {x y : part_enat} : Π [decidable x.dom] + [decidable y.dom], by exactI to_with_top x ≤ to_with_top y ↔ x ≤ y := +part_enat.cases_on y (by simp) (part_enat.cases_on x (by simp) (by intros; simp)) + +@[simp] lemma to_with_top_lt {x y : part_enat} [decidable x.dom] [decidable y.dom] : + to_with_top x < to_with_top y ↔ x < y := +lt_iff_lt_of_le_iff_le to_with_top_le + +end with_top + +section with_top_equiv + +open_locale classical + +@[simp] lemma to_with_top_add {x y : part_enat} : + to_with_top (x + y) = to_with_top x + to_with_top y := +by apply part_enat.cases_on y; apply part_enat.cases_on x; simp [← nat.cast_add, ← enat.coe_add] + +/-- `equiv` between `part_enat` and `ℕ∞` (for the order isomorphism see +`with_top_order_iso`). -/ +noncomputable def with_top_equiv : part_enat ≃ ℕ∞ := +{ to_fun := λ x, to_with_top x, + inv_fun := λ x, match x with (option.some n) := coe n | none := ⊤ end, + left_inv := λ x, by apply part_enat.cases_on x; intros; simp; refl, + right_inv := λ x, by cases x; simp [with_top_equiv._match_1]; refl } + +@[simp] lemma with_top_equiv_top : with_top_equiv ⊤ = ⊤ := +to_with_top_top' + +@[simp] lemma with_top_equiv_coe (n : nat) : with_top_equiv n = n := +to_with_top_coe' _ + +@[simp] lemma with_top_equiv_zero : with_top_equiv 0 = 0 := +by simpa only [nat.cast_zero] using with_top_equiv_coe 0 + +@[simp] lemma with_top_equiv_le {x y : part_enat} : with_top_equiv x ≤ with_top_equiv y ↔ x ≤ y := +to_with_top_le + +@[simp] lemma with_top_equiv_lt {x y : part_enat} : with_top_equiv x < with_top_equiv y ↔ x < y := +to_with_top_lt + +/-- `to_with_top` induces an order isomorphism between `part_enat` and `ℕ∞`. -/ +noncomputable def with_top_order_iso : part_enat ≃o ℕ∞ := +{ map_rel_iff' := λ _ _, with_top_equiv_le, + .. with_top_equiv} + +@[simp] lemma with_top_equiv_symm_top : with_top_equiv.symm ⊤ = ⊤ := +rfl + +@[simp] lemma with_top_equiv_symm_coe (n : nat) : with_top_equiv.symm n = n := +rfl + +@[simp] lemma with_top_equiv_symm_zero : with_top_equiv.symm 0 = 0 := +rfl + +@[simp] lemma with_top_equiv_symm_le {x y : ℕ∞} : + with_top_equiv.symm x ≤ with_top_equiv.symm y ↔ x ≤ y := +by rw ← with_top_equiv_le; simp + +@[simp] lemma with_top_equiv_symm_lt {x y : ℕ∞} : + with_top_equiv.symm x < with_top_equiv.symm y ↔ x < y := +by rw ← with_top_equiv_lt; simp + +/-- `to_with_top` induces an additive monoid isomorphism between `part_enat` and `ℕ∞`. -/ +noncomputable def with_top_add_equiv : part_enat ≃+ ℕ∞ := +{ map_add' := λ x y, by simp only [with_top_equiv]; convert to_with_top_add, + ..with_top_equiv} + +end with_top_equiv + +lemma lt_wf : @well_founded part_enat (<) := +begin + classical, + change well_founded (λ a b : part_enat, a < b), + simp_rw ←to_with_top_lt, + exact inv_image.wf _ (with_top.well_founded_lt nat.lt_wf) +end + +instance : well_founded_lt part_enat := ⟨lt_wf⟩ +instance : is_well_order part_enat (<) := { } +instance : has_well_founded part_enat := ⟨(<), lt_wf⟩ + +section find + +variables (P : ℕ → Prop) [decidable_pred P] + +/-- The smallest `part_enat` satisfying a (decidable) predicate `P : ℕ → Prop` -/ +def find : part_enat := ⟨∃ n, P n, nat.find⟩ + +@[simp] lemma find_get (h : (find P).dom) : (find P).get h = nat.find h := rfl + +lemma find_dom (h : ∃ n, P n) : (find P).dom := h + +lemma lt_find (n : ℕ) (h : ∀ m ≤ n, ¬P m) : (n : part_enat) < find P := +begin + rw coe_lt_iff, intro h', rw find_get, + have := @nat.find_spec P _ h', + contrapose! this, + exact h _ this +end + +lemma lt_find_iff (n : ℕ) : (n : part_enat) < find P ↔ (∀ m ≤ n, ¬P m) := +begin + refine ⟨_, lt_find P n⟩, + intros h m hm, + by_cases H : (find P).dom, + { apply nat.find_min H, rw coe_lt_iff at h, specialize h H, exact lt_of_le_of_lt hm h }, + { exact not_exists.mp H m } +end + +lemma find_le (n : ℕ) (h : P n) : find P ≤ n := +by { rw le_coe_iff, refine ⟨⟨_, h⟩, @nat.find_min' P _ _ _ h⟩ } + +lemma find_eq_top_iff : find P = ⊤ ↔ ∀ n, ¬P n := +(eq_top_iff_forall_lt _).trans +⟨λ h n, (lt_find_iff P n).mp (h n) _ le_rfl, λ h n, lt_find P n $ λ _ _, h _⟩ + +end find + +noncomputable instance : linear_ordered_add_comm_monoid_with_top part_enat := +{ top_add' := top_add, + .. part_enat.linear_order, + .. part_enat.ordered_add_comm_monoid, + .. part_enat.order_top } + +noncomputable instance : complete_linear_order part_enat := +{ inf := (⊓), + sup := (⊔), + top := ⊤, + bot := ⊥, + le := (≤), + lt := (<), + .. part_enat.lattice, + .. with_top_order_iso.symm.to_galois_insertion.lift_complete_lattice, + .. part_enat.linear_order, } + +end part_enat diff --git a/src/data/nat/periodic.lean b/src/data/nat/periodic.lean index a5a14e738006c..48eba2c749525 100644 --- a/src/data/nat/periodic.lean +++ b/src/data/nat/periodic.lean @@ -10,6 +10,9 @@ import data.nat.interval /-! # Periodic Functions on ℕ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file identifies a few functions on `ℕ` which are periodic, and also proves a lemma about periodic predicates which helps determine their cardinality when filtering intervals over them. -/ @@ -40,7 +43,7 @@ lemma filter_multiset_Ico_card_eq_of_periodic (n a : ℕ) (p : ℕ → Prop) [de (pp : periodic p a) : (filter p (Ico n (n+a))).card = a.count p := begin - rw [count_eq_card_filter_range, finset.card, finset.filter_val, finset.range_coe, + rw [count_eq_card_filter_range, finset.card, finset.filter_val, finset.range_val, ←multiset_Ico_map_mod n, ←map_count_true_eq_filter_card, ←map_count_true_eq_filter_card, map_map, function.comp], simp only [pp.map_mod_nat], diff --git a/src/data/nat/pow.lean b/src/data/nat/pow.lean index d8201c1f32127..4b2ac6720c4e6 100644 --- a/src/data/nat/pow.lean +++ b/src/data/nat/pow.lean @@ -7,6 +7,9 @@ import algebra.group_power.order /-! # `nat.pow` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Results on the power operation on natural numbers. -/ @@ -32,6 +35,10 @@ pow_lt_pow H h lemma pow_lt_pow_succ {p : ℕ} (h : 1 < p) (n : ℕ) : p^n < p^(n+1) := pow_lt_pow_of_lt_right h n.lt_succ_self +lemma le_self_pow {n : ℕ} (hn : n ≠ 0) : ∀ m : ℕ, m ≤ m ^ n +| 0 := zero_le _ +| (m + 1) := _root_.le_self_pow dec_trivial hn + lemma lt_pow_self {p : ℕ} (h : 1 < p) : ∀ n : ℕ, n < p ^ n | 0 := by simp [zero_lt_one] | (n+1) := calc @@ -111,7 +118,7 @@ strict_mono.injective (pow_left_strict_mono k) theorem sq_sub_sq (a b : ℕ) : a ^ 2 - b ^ 2 = (a + b) * (a - b) := by { rw [sq, sq], exact nat.mul_self_sub_mul_self_eq a b } -alias nat.sq_sub_sq ← nat.pow_two_sub_pow_two +alias sq_sub_sq ← pow_two_sub_pow_two /-! ### `pow` and `mod` / `dvd` -/ @@ -133,7 +140,7 @@ begin cases lt_or_ge p (b^succ w) with h₁ h₁, -- base case: p < b^succ w { have h₂ : p / b < b^w, - { rw [div_lt_iff_lt_mul p _ b_pos], + { rw [div_lt_iff_lt_mul b_pos], simpa [pow_succ'] using h₁ }, rw [mod_eq_of_lt h₁, mod_eq_of_lt h₂], simp [div_add_mod] }, @@ -150,7 +157,7 @@ begin rw [sub_mul_mod _ _ _ h₁, sub_mul_div _ _ _ h₁], -- Cancel subtraction inside mod b^w have p_b_ge : b^w ≤ p / b, - { rw [le_div_iff_mul_le _ _ b_pos, mul_comm], + { rw [le_div_iff_mul_le b_pos, mul_comm], exact h₁ }, rw [eq.symm (mod_eq_sub_mod p_b_ge)] } end @@ -194,127 +201,10 @@ by rw ←pow_one p; exact pow_dvd_of_le_of_pow_dvd hk hpk lemma pow_div {x m n : ℕ} (h : n ≤ m) (hx : 0 < x) : x ^ m / x ^ n = x ^ (m - n) := by rw [nat.div_eq_iff_eq_mul_left (pow_pos hx n) (pow_dvd_pow _ h), pow_sub_mul_pow _ h] -/-! ### `shiftl` and `shiftr` -/ - -lemma shiftl_eq_mul_pow (m) : ∀ n, shiftl m n = m * 2 ^ n -| 0 := (nat.mul_one _).symm -| (k+1) := show bit0 (shiftl m k) = m * (2 * 2 ^ k), - by rw [bit0_val, shiftl_eq_mul_pow, mul_left_comm, mul_comm 2] - -lemma shiftl'_tt_eq_mul_pow (m) : ∀ n, shiftl' tt m n + 1 = (m + 1) * 2 ^ n -| 0 := by simp [shiftl, shiftl', pow_zero, nat.one_mul] -| (k+1) := +lemma lt_of_pow_dvd_right {p i n : ℕ} (hn : n ≠ 0) (hp : 2 ≤ p) (h : p ^ i ∣ n) : i < n := begin - change bit1 (shiftl' tt m k) + 1 = (m + 1) * (2 * 2 ^ k), - rw bit1_val, - change 2 * (shiftl' tt m k + 1) = _, - rw [shiftl'_tt_eq_mul_pow, mul_left_comm, mul_comm 2], + rw ←pow_lt_iff_lt_right hp, + exact lt_of_le_of_lt (le_of_dvd hn.bot_lt h) (lt_pow_self (succ_le_iff.mp hp) n), end -lemma one_shiftl (n) : shiftl 1 n = 2 ^ n := -(shiftl_eq_mul_pow _ _).trans (nat.one_mul _) - -@[simp] lemma zero_shiftl (n) : shiftl 0 n = 0 := -(shiftl_eq_mul_pow _ _).trans (nat.zero_mul _) - -lemma shiftr_eq_div_pow (m) : ∀ n, shiftr m n = m / 2 ^ n -| 0 := (nat.div_one _).symm -| (k+1) := (congr_arg div2 (shiftr_eq_div_pow k)).trans $ - by rw [div2_val, nat.div_div_eq_div_mul, mul_comm]; refl - -@[simp] lemma zero_shiftr (n) : shiftr 0 n = 0 := -(shiftr_eq_div_pow _ _).trans (nat.zero_div _) - -theorem shiftl'_ne_zero_left (b) {m} (h : m ≠ 0) (n) : shiftl' b m n ≠ 0 := -by induction n; simp [shiftl', bit_ne_zero, *] - -theorem shiftl'_tt_ne_zero (m) : ∀ {n} (h : n ≠ 0), shiftl' tt m n ≠ 0 -| 0 h := absurd rfl h -| (succ n) _ := nat.bit1_ne_zero _ - -/-! ### `size` -/ - -@[simp] theorem size_zero : size 0 = 0 := by simp [size] - -@[simp] theorem size_bit {b n} (h : bit b n ≠ 0) : size (bit b n) = succ (size n) := -begin - rw size, - conv { to_lhs, rw [binary_rec], simp [h] }, - rw div2_bit, -end - -@[simp] theorem size_bit0 {n} (h : n ≠ 0) : size (bit0 n) = succ (size n) := -@size_bit ff n (nat.bit0_ne_zero h) - -@[simp] theorem size_bit1 (n) : size (bit1 n) = succ (size n) := -@size_bit tt n (nat.bit1_ne_zero n) - -@[simp] theorem size_one : size 1 = 1 := -show size (bit1 0) = 1, by rw [size_bit1, size_zero] - -@[simp] theorem size_shiftl' {b m n} (h : shiftl' b m n ≠ 0) : - size (shiftl' b m n) = size m + n := -begin - induction n with n IH; simp [shiftl'] at h ⊢, - rw [size_bit h, nat.add_succ], - by_cases s0 : shiftl' b m n = 0; [skip, rw [IH s0]], - rw s0 at h ⊢, - cases b, {exact absurd rfl h}, - have : shiftl' tt m n + 1 = 1 := congr_arg (+1) s0, - rw [shiftl'_tt_eq_mul_pow] at this, - obtain rfl := succ.inj (eq_one_of_dvd_one ⟨_, this.symm⟩), - rw one_mul at this, - obtain rfl : n = 0 := nat.eq_zero_of_le_zero (le_of_not_gt $ λ hn, - ne_of_gt (pow_lt_pow_of_lt_right dec_trivial hn) this), - refl -end - -@[simp] theorem size_shiftl {m} (h : m ≠ 0) (n) : - size (shiftl m n) = size m + n := -size_shiftl' (shiftl'_ne_zero_left _ h _) - -theorem lt_size_self (n : ℕ) : n < 2^size n := -begin - rw [← one_shiftl], - have : ∀ {n}, n = 0 → n < shiftl 1 (size n), { simp }, - apply binary_rec _ _ n, {apply this rfl}, - intros b n IH, - by_cases bit b n = 0, {apply this h}, - rw [size_bit h, shiftl_succ], - exact bit_lt_bit0 _ IH -end - -theorem size_le {m n : ℕ} : size m ≤ n ↔ m < 2^n := -⟨λ h, lt_of_lt_of_le (lt_size_self _) (pow_le_pow_of_le_right dec_trivial h), -begin - rw [← one_shiftl], revert n, - apply binary_rec _ _ m, - { intros n h, simp }, - { intros b m IH n h, - by_cases e : bit b m = 0, { simp [e] }, - rw [size_bit e], - cases n with n, - { exact e.elim (nat.eq_zero_of_le_zero (le_of_lt_succ h)) }, - { apply succ_le_succ (IH _), - apply lt_imp_lt_of_le_imp_le (λ h', bit0_le_bit _ h') h } } -end⟩ - -theorem lt_size {m n : ℕ} : m < size n ↔ 2^m ≤ n := -by rw [← not_lt, decidable.iff_not_comm, not_lt, size_le] - -theorem size_pos {n : ℕ} : 0 < size n ↔ 0 < n := -by rw lt_size; refl - -theorem size_eq_zero {n : ℕ} : size n = 0 ↔ n = 0 := -by have := @size_pos n; simp [pos_iff_ne_zero] at this; - exact decidable.not_iff_not.1 this - -theorem size_pow {n : ℕ} : size (2^n) = n+1 := -le_antisymm - (size_le.2 $ pow_lt_pow_of_lt_right dec_trivial (lt_succ_self _)) - (lt_size.2 $ le_rfl) - -theorem size_le_size {m n : ℕ} (h : m ≤ n) : size m ≤ size n := -size_le.2 $ lt_of_le_of_lt h (lt_size_self _) - end nat diff --git a/src/data/nat/prime.lean b/src/data/nat/prime.lean index ea7845c9b5f43..ff09a91d35dd7 100644 --- a/src/data/nat/prime.lean +++ b/src/data/nat/prime.lean @@ -3,17 +3,23 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro -/ -import data.list.prime -import data.list.sort -import data.nat.gcd -import data.nat.sqrt_norm_num -import data.set.finite -import tactic.wlog + +import algebra.associated import algebra.parity +import data.int.dvd.basic +import data.int.units +import data.nat.factorial.basic +import data.nat.gcd.basic +import data.nat.sqrt +import order.bounds.basic +import tactic.by_contra /-! # Prime numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file deals with prime numbers: natural numbers `p ≥ 2` whose only divisors are `p` and `1`. ## Important declarations @@ -22,11 +28,10 @@ This file deals with prime numbers: natural numbers `p ≥ 2` whose only divisor - `nat.primes`: the subtype of natural numbers that are prime - `nat.min_fac n`: the minimal prime factor of a natural number `n ≠ 1` - `nat.exists_infinite_primes`: Euclid's theorem that there exist infinitely many prime numbers. - This also appears as `nat.not_bdd_above_set_of_prime` and `nat.infinite_set_of_prime`. -- `nat.factors n`: the prime factorization of `n` -- `nat.factors_unique`: uniqueness of the prime factorisation -* `nat.prime_iff`: `nat.prime` coincides with the general definition of `prime` -* `nat.irreducible_iff_prime`: a non-unit natural number is only divisible by `1` iff it is prime + This also appears as `nat.not_bdd_above_set_of_prime` and `nat.infinite_set_of_prime` (the latter + in `data.nat.prime_fin`). +- `nat.prime_iff`: `nat.prime` coincides with the general definition of `prime` +- `nat.irreducible_iff_prime`: a non-unit natural number is only divisible by `1` iff it is prime -/ @@ -35,7 +40,7 @@ open_locale nat namespace nat -/-- `prime p` means that `p` is a prime number, that is, a natural number +/-- `nat.prime p` means that `p` is a prime number, that is, a natural number at least 2 whose only divisors are `p` and `1`. -/ @[pp_nodot] def prime (p : ℕ) := _root_.irreducible p @@ -82,7 +87,7 @@ begin simp only [nat.is_unit_iff], apply or.imp_right _ (h.2 a _), { rintro rfl, - rw [←nat.mul_right_inj (pos_of_gt h1), ←hab, mul_one] }, + rw [← mul_right_inj' (pos_of_gt h1).ne', ←hab, mul_one] }, { rw hab, exact dvd_mul_right _ _ } end @@ -143,6 +148,15 @@ def decidable_prime_1 (p : ℕ) : decidable (prime p) := decidable_of_iff' _ prime_def_lt' theorem prime_two : prime 2 := dec_trivial +theorem prime_three : prime 3 := dec_trivial + +lemma prime.five_le_of_ne_two_of_ne_three {p : ℕ} (hp : p.prime) (h_two : p ≠ 2) (h_three : p ≠ 3) : + 5 ≤ p := +begin + by_contra' h, + revert h_two h_three hp, + dec_trivial! +end end @@ -391,6 +405,14 @@ theorem exists_dvd_of_not_prime2 {n : ℕ} (n2 : 2 ≤ n) (np : ¬ prime n) : theorem exists_prime_and_dvd {n : ℕ} (hn : n ≠ 1) : ∃ p, prime p ∧ p ∣ n := ⟨min_fac n, min_fac_prime hn, min_fac_dvd _⟩ +theorem dvd_of_forall_prime_mul_dvd {a b : ℕ} + (hdvd : ∀ p : ℕ, p.prime → p ∣ a → p * a ∣ b) : a ∣ b := +begin + obtain rfl | ha := eq_or_ne a 1, { apply one_dvd }, + obtain ⟨p, hp⟩ := exists_prime_and_dvd ha, + exact trans (dvd_mul_left a p) (hdvd p hp.1 hp.2), +end + /-- Euclid's theorem on the **infinitude of primes**. Here given in the form: for every `n`, there exists a prime number `p ≥ n`. -/ theorem exists_infinite_primes (n : ℕ) : ∃ p, n ≤ p ∧ prime p := @@ -412,10 +434,6 @@ begin exact ⟨p, hp, hi⟩, end -/-- A version of `nat.exists_infinite_primes` using the `set.infinite` predicate. -/ -lemma infinite_set_of_prime : {p | prime p}.infinite := -set.infinite_of_not_bdd_above not_bdd_above_set_of_prime - lemma prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = 2 ∨ p % 2 = 1 := p.mod_two_eq_zero_or_one.imp_left (λ h, ((hp.eq_one_or_self_of_dvd 2 (dvd_of_mod_eq_zero h)).resolve_left dec_trivial).symm) @@ -423,6 +441,15 @@ p.mod_two_eq_zero_or_one.imp_left lemma prime.eq_two_or_odd' {p : ℕ} (hp : prime p) : p = 2 ∨ odd p := or.imp_right (λ h, ⟨p / 2, (div_add_mod p 2).symm.trans (congr_arg _ h)⟩) hp.eq_two_or_odd +lemma prime.even_iff {p : ℕ} (hp : prime p) : even p ↔ p = 2 := +by rw [even_iff_two_dvd, prime_dvd_prime_iff_eq prime_two hp, eq_comm] + +lemma prime.odd_of_ne_two {p : ℕ} (hp : p.prime) (h_two : p ≠ 2) : odd p := +hp.eq_two_or_odd'.resolve_left h_two + +lemma prime.even_sub_one {p : ℕ} (hp : p.prime) (h2 : p ≠ 2) : even (p - 1) := +let ⟨n, hn⟩ := hp.odd_of_ne_two h2 in ⟨n, by rw [hn, nat.add_sub_cancel, two_mul]⟩ + /-- A prime `p` satisfies `p % 2 = 1` if and only if `p ≠ 2`. -/ lemma prime.mod_two_eq_one_iff_ne_two {p : ℕ} [fact p.prime] : p % 2 = 1 ↔ p ≠ 2 := begin @@ -447,92 +474,6 @@ coprime_of_dvd $ λk kp km kn, not_le_of_gt kp.one_lt $ le_of_dvd zero_lt_one $ theorem factors_lemma {k} : (k+2) / min_fac (k+2) < k+2 := div_lt_self dec_trivial (min_fac_prime dec_trivial).one_lt -/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/ -def factors : ℕ → list ℕ -| 0 := [] -| 1 := [] -| n@(k+2) := - let m := min_fac n in have n / m < n := factors_lemma, - m :: factors (n / m) - -@[simp] lemma factors_zero : factors 0 = [] := by rw factors -@[simp] lemma factors_one : factors 1 = [] := by rw factors - -lemma prime_of_mem_factors : ∀ {n p}, p ∈ factors n → prime p -| 0 := by simp -| 1 := by simp -| n@(k+2) := λ p h, - let m := min_fac n in have n / m < n := factors_lemma, - have h₁ : p = m ∨ p ∈ (factors (n / m)) := - (list.mem_cons_iff _ _ _).1 (by rwa [factors] at h), - or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial) - prime_of_mem_factors - -lemma pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p := -prime.pos (prime_of_mem_factors h) - -lemma prod_factors : ∀ {n}, n ≠ 0 → list.prod (factors n) = n -| 0 := by simp -| 1 := by simp -| n@(k+2) := λ h, - let m := min_fac n in have n / m < n := factors_lemma, - show (factors n).prod = n, from - have h₁ : n / m ≠ 0 := λ h, - have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h, - by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this, - by rw [factors, list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)] - -lemma factors_prime {p : ℕ} (hp : nat.prime p) : p.factors = [p] := -begin - have : p = (p - 2) + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl, - rw [this, nat.factors], - simp only [eq.symm this], - have : nat.min_fac p = p := (nat.prime_def_min_fac.mp hp).2, - split, - { exact this, }, - { simp only [this, nat.factors, nat.div_self (nat.prime.pos hp)], }, -end - -lemma factors_chain : ∀ {n a}, (∀ p, prime p → p ∣ n → a ≤ p) → list.chain (≤) a (factors n) -| 0 := λ a h, by simp -| 1 := λ a h, by simp -| n@(k+2) := λ a h, - let m := min_fac n in have n / m < n := factors_lemma, - begin - rw factors, - refine list.chain.cons ((le_min_fac.2 h).resolve_left dec_trivial) (factors_chain _), - exact λ p pp d, min_fac_le_of_dvd pp.two_le (d.trans $ div_dvd_of_dvd $ min_fac_dvd _), - end - -lemma factors_chain_2 (n) : list.chain (≤) 2 (factors n) := factors_chain $ λ p pp _, pp.two_le - -lemma factors_chain' (n) : list.chain' (≤) (factors n) := -@list.chain'.tail _ _ (_::_) (factors_chain_2 _) - -lemma factors_sorted (n : ℕ) : list.sorted (≤) (factors n) := -(list.chain'_iff_pairwise (@le_trans _ _)).1 (factors_chain' _) - -/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/ -lemma factors_add_two (n : ℕ) : - factors (n+2) = min_fac (n+2) :: factors ((n+2) / min_fac (n+2)) := -by rw factors - -@[simp] -lemma factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 := -begin - split; intro h, - { rcases n with (_ | _ | n), - { exact or.inl rfl }, - { exact or.inr rfl }, - { rw factors at h, injection h }, }, - { rcases h with (rfl | rfl), - { exact factors_zero }, - { exact factors_one }, } -end - -lemma eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) : a = b := -by simpa [prod_factors ha, prod_factors hb] using list.perm.prod_eq h - theorem prime.coprime_iff_not_dvd {p n : ℕ} (pp : prime p) : coprime p n ↔ ¬ p ∣ n := ⟨λ co d, pp.not_dvd_one $ co.dvd_of_dvd_mul_left (by simp [d]), λ nd, coprime_of_dvd $ λ m m2 mp, ((prime_dvd_prime_iff_eq m2 pp).1 mp).symm ▸ nd⟩ @@ -565,8 +506,10 @@ mt pp.dvd_mul.1 $ by simp [Hm, Hn] theorem prime_iff {p : ℕ} : p.prime ↔ _root_.prime p := ⟨λ h, ⟨h.ne_zero, h.not_unit, λ a b, h.dvd_mul.mp⟩, prime.irreducible⟩ -theorem irreducible_iff_prime {p : ℕ} : irreducible p ↔ _root_.prime p := -by rw [←prime_iff, prime] +alias prime_iff ↔ prime.prime _root_.prime.nat_prime +attribute [protected, nolint dup_namespace] prime.prime + +theorem irreducible_iff_prime {p : ℕ} : irreducible p ↔ _root_.prime p := prime_iff theorem prime.dvd_of_dvd_pow {p m n : ℕ} (pp : prime p) (h : p ∣ m^n) : p ∣ m := begin @@ -614,15 +557,22 @@ lemma prime.mul_eq_prime_sq_iff {x y p : ℕ} (hp : p.prime) (hx : x ≠ 1) (hy x * y = p ^ 2 ↔ x = p ∧ y = p := ⟨λ h, have pdvdxy : p ∣ x * y, by rw h; simp [sq], begin - wlog := hp.dvd_mul.1 pdvdxy using x y, - cases case with a ha, + -- Could be `wlog := hp.dvd_mul.1 pdvdxy using x y`, but that imports more than we want. + suffices : ∀ (x' y' : ℕ), x' ≠ 1 → y' ≠ 1 → x' * y' = p ^ 2 → p ∣ x' → x' = p ∧ y' = p, + { obtain hx|hy := hp.dvd_mul.1 pdvdxy; + [skip, rw and_comm]; + [skip, rw mul_comm at h pdvdxy]; + apply this; + assumption }, + clear_dependent x y, + rintros x y hx hy h ⟨a, ha⟩, have hap : a ∣ p, from ⟨y, by rwa [ha, sq, - mul_assoc, nat.mul_right_inj hp.pos, eq_comm] at h⟩, + mul_assoc, mul_right_inj' hp.ne_zero, eq_comm] at h⟩, exact ((nat.dvd_prime hp).1 hap).elim - (λ _, by clear_aux_decl; simp [*, sq, nat.mul_right_inj hp.pos] at * + (λ _, by clear_aux_decl; simp [*, sq, mul_right_inj' hp.ne_zero] at * {contextual := tt}) (λ _, by clear_aux_decl; simp [*, sq, mul_comm, mul_assoc, - nat.mul_right_inj hp.pos, nat.mul_right_eq_self_iff hp.pos] at * + mul_right_inj' hp.ne_zero, nat.mul_right_eq_self_iff hp.pos] at * {contextual := tt}) end, λ ⟨h₁, h₂⟩, h₁.symm ▸ h₂.symm ▸ (sq _).symm⟩ @@ -692,127 +642,6 @@ end lemma eq_one_iff_not_exists_prime_dvd {n : ℕ} : n = 1 ↔ ∀ p : ℕ, p.prime → ¬p ∣ n := by simpa using not_iff_not.mpr ne_one_iff_exists_prime_dvd -section -open list - -lemma mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : prime p) : p ∈ factors n ↔ p ∣ n := -⟨λ h, prod_factors hn ▸ list.dvd_prod h, - λ h, mem_list_primes_of_dvd_prod - (prime_iff.mp hp) - (λ p h, prime_iff.mp (prime_of_mem_factors h)) - ((prod_factors hn).symm ▸ h)⟩ - -lemma dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n := -begin - rcases n.eq_zero_or_pos with rfl | hn, - { exact dvd_zero p }, - { rwa ←mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h) } -end - -lemma mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ prime p ∧ p ∣ n := -⟨λ h, ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩, - λ ⟨hprime, hdvd⟩, (mem_factors_iff_dvd hn hprime).mpr hdvd⟩ - -lemma le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n := -begin - rcases n.eq_zero_or_pos with rfl | hn, - { rw factors_zero at h, cases h }, - { exact le_of_dvd hn (dvd_of_mem_factors h) }, -end - -/-- **Fundamental theorem of arithmetic**-/ -lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) : - l ~ factors n := -begin - refine perm_of_prod_eq_prod _ _ _, - { rw h₁, - refine (prod_factors _).symm, - rintro rfl, - rw prod_eq_zero_iff at h₁, - exact prime.ne_zero (h₂ 0 h₁) rfl }, - { simp_rw ←prime_iff, exact h₂ }, - { simp_rw ←prime_iff, exact (λ p, prime_of_mem_factors) }, -end - -lemma prime.factors_pow {p : ℕ} (hp : p.prime) (n : ℕ) : - (p ^ n).factors = list.repeat p n := -begin - symmetry, - rw ← list.repeat_perm, - apply nat.factors_unique (list.prod_repeat p n), - intros q hq, - rwa eq_of_mem_repeat hq, -end - -lemma eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0) - (h : ∀ {d}, nat.prime d → d ∣ n → d = p) : - n = p ^ n.factors.length := -begin - set k := n.factors.length, - rw [←prod_factors hpos, ←prod_repeat p k, - eq_repeat_of_mem (λ d hd, h (prime_of_mem_factors hd) (dvd_of_mem_factors hd))], -end - -/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/ -lemma perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : - (a * b).factors ~ a.factors ++ b.factors := -begin - refine (factors_unique _ _).symm, - { rw [list.prod_append, prod_factors ha, prod_factors hb] }, - { intros p hp, - rw list.mem_append at hp, - cases hp; - exact prime_of_mem_factors hp }, -end - -/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/ -lemma perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) : - (a * b).factors ~ a.factors ++ b.factors := -begin - rcases a.eq_zero_or_pos with rfl | ha, - { simp [(coprime_zero_left _).mp hab] }, - rcases b.eq_zero_or_pos with rfl | hb, - { simp [(coprime_zero_right _).mp hab] }, - exact perm_factors_mul ha.ne' hb.ne', -end - -lemma factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors := -begin - cases n, - { rw zero_mul }, - apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _), - rw (perm_factors_mul n.succ_ne_zero h).subperm_left, - exact (sublist_append_left _ _).subperm, -end - -lemma factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors := -begin - obtain ⟨a, rfl⟩ := h, - exact factors_sublist_right (right_ne_zero_of_mul h'), -end - -lemma factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors := -(factors_sublist_right h).subset - -lemma factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors := -(factors_sublist_of_dvd h h').subset - -lemma dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b := -begin - rcases b.eq_zero_or_pos with rfl | hb, - { exact dvd_zero _ }, - rcases a with (_|_|a), - { exact (ha rfl).elim }, - { exact one_dvd _ }, - use (b.factors.diff a.succ.succ.factors).prod, - nth_rewrite 0 ←nat.prod_factors ha, - rw [←list.prod_append, - list.perm.prod_eq $ list.subperm_append_diff_self_of_count_le $ list.subperm_ext_iff.mp h, - nat.prod_factors hb.ne'] -end - -end - lemma succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : prime p) {m n k l : ℕ} (hpm : p ^ k ∣ m) (hpn : p ^ l ∣ n) (hpmn : p ^ (k+l+1) ∣ m*n) : p ^ (k+1) ∣ m ∨ p ^ (l+1) ∣ n := @@ -844,363 +673,29 @@ instance inhabited_primes : inhabited primes := ⟨⟨2, prime_two⟩⟩ instance coe_nat : has_coe nat.primes ℕ := ⟨subtype.val⟩ -theorem coe_nat_inj (p q : nat.primes) : (p : ℕ) = (q : ℕ) → p = q := -λ h, subtype.eq h +theorem coe_nat_injective : function.injective (coe : nat.primes → ℕ) := +subtype.coe_injective + +theorem coe_nat_inj (p q : nat.primes) : (p : ℕ) = (q : ℕ) ↔ p = q := +subtype.ext_iff.symm end primes -instance monoid.prime_pow {α : Type*} [monoid α] : has_pow α primes := ⟨λ x p, x^p.val⟩ +instance monoid.prime_pow {α : Type*} [monoid α] : has_pow α primes := ⟨λ x p, x^(p : ℕ)⟩ end nat -/-! ### Primality prover -/ - -open norm_num - -namespace tactic -namespace norm_num - -lemma is_prime_helper (n : ℕ) - (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n := -nat.prime_def_min_fac.2 ⟨h₁, h₂⟩ - -lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 := -by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]] - -/-- A predicate representing partial progress in a proof of `min_fac`. -/ -def min_fac_helper (n k : ℕ) : Prop := -0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n) - -theorem min_fac_helper.n_pos {n k : ℕ} (h : min_fac_helper n k) : 0 < n := -pos_iff_ne_zero.2 $ λ e, -by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2 - -lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k := -begin - rw bit0_eq_two_mul, - refine (λ e, absurd ((nat.dvd_add_iff_right _).2 - (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _))) _); simp -end - -lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 := -begin - refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩, - rw nat.succ_le_iff, - refine lt_of_le_of_ne (nat.min_fac_pos _) (λ e, nat.not_prime_one _), - rw e, - exact nat.min_fac_prime (nat.bit1_lt h).ne', -end - -lemma min_fac_helper_1 {n k k' : ℕ} (e : k + 1 = k') - (np : nat.min_fac (bit1 n) ≠ bit1 k) - (h : min_fac_helper n k) : min_fac_helper n k' := -begin - rw ← e, - refine ⟨nat.succ_pos _, - (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _) - min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩, - { rw add_right_comm, exact h.2 }, - { rw add_right_comm, exact np.symm } -end - -lemma min_fac_helper_2 (n k k' : ℕ) (e : k + 1 = k') - (np : ¬ nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' := -begin - refine min_fac_helper_1 e _ h, - intro e₁, rw ← e₁ at np, - exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos) -end - -lemma min_fac_helper_3 (n k k' c : ℕ) (e : k + 1 = k') - (nc : bit1 n % bit1 k = c) (c0 : 0 < c) - (h : min_fac_helper n k) : min_fac_helper n k' := -begin - refine min_fac_helper_1 e _ h, - refine mt _ (ne_of_gt c0), intro e₁, - rw [← nc, ← nat.dvd_iff_mod_eq_zero, ← e₁], - apply nat.min_fac_dvd -end - -lemma min_fac_helper_4 (n k : ℕ) (hd : bit1 n % bit1 k = 0) - (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k := -by { rw ← nat.dvd_iff_mod_eq_zero at hd, - exact le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2 } - -lemma min_fac_helper_5 (n k k' : ℕ) (e : bit1 k * bit1 k = k') - (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n := -begin - refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2 - ⟨nat.bit1_lt h.n_pos, _⟩)).2, - rw ← e at hd, - intros m m2 hm md, - have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm), - rw nat.le_sqrt at this, - exact not_le_of_lt hd this -end - -/-- Given `e` a natural numeral and `d : nat` a factor of it, return `⊢ ¬ prime e`. -/ -meta def prove_non_prime (e : expr) (n d₁ : ℕ) : tactic expr := -do let e₁ := reflect d₁, - c ← mk_instance_cache `(nat), - (c, p₁) ← prove_lt_nat c `(1) e₁, - let d₂ := n / d₁, let e₂ := reflect d₂, - (c, e', p) ← prove_mul_nat c e₁ e₂, - guard (e' =ₐ e), - (c, p₂) ← prove_lt_nat c `(1) e₂, - return $ `(@nat.not_prime_mul').mk_app [e₁, e₂, e, p, p₁, p₂] - -/-- Given `a`,`a1 := bit1 a`, `n1` the value of `a1`, `b` and `p : min_fac_helper a b`, - returns `(c, ⊢ min_fac a1 = c)`. -/ -meta def prove_min_fac_aux (a a1 : expr) (n1 : ℕ) : - instance_cache → expr → expr → tactic (instance_cache × expr × expr) -| ic b p := do - k ← b.to_nat, - let k1 := bit1 k, - let b1 := `(bit1:ℕ→ℕ).mk_app [b], - if n1 < k1*k1 then do - (ic, e', p₁) ← prove_mul_nat ic b1 b1, - (ic, p₂) ← prove_lt_nat ic a1 e', - return (ic, a1, `(min_fac_helper_5).mk_app [a, b, e', p₁, p₂, p]) - else let d := k1.min_fac in - if to_bool (d < k1) then do - let k' := k+1, let e' := reflect k', - (ic, p₁) ← prove_succ ic b e', - p₂ ← prove_non_prime b1 k1 d, - prove_min_fac_aux ic e' $ `(min_fac_helper_2).mk_app [a, b, e', p₁, p₂, p] - else do - let nc := n1 % k1, - (ic, c, pc) ← prove_div_mod ic a1 b1 tt, - if nc = 0 then - return (ic, b1, `(min_fac_helper_4).mk_app [a, b, pc, p]) - else do - (ic, p₀) ← prove_pos ic c, - let k' := k+1, let e' := reflect k', - (ic, p₁) ← prove_succ ic b e', - prove_min_fac_aux ic e' $ `(min_fac_helper_3).mk_app [a, b, e', c, p₁, pc, p₀, p] - -/-- Given `a` a natural numeral, returns `(b, ⊢ min_fac a = b)`. -/ -meta def prove_min_fac (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) := -match match_numeral e with -| match_numeral_result.zero := return (ic, `(2:ℕ), `(nat.min_fac_zero)) -| match_numeral_result.one := return (ic, `(1:ℕ), `(nat.min_fac_one)) -| match_numeral_result.bit0 e := return (ic, `(2), `(min_fac_bit0).mk_app [e]) -| match_numeral_result.bit1 e := do - n ← e.to_nat, - c ← mk_instance_cache `(nat), - (c, p) ← prove_pos c e, - let a1 := `(bit1:ℕ→ℕ).mk_app [e], - prove_min_fac_aux e a1 (bit1 n) c `(1) (`(min_fac_helper_0).mk_app [e, p]) -| _ := failed -end - -/-- A partial proof of `factors`. Asserts that `l` is a sorted list of primes, lower bounded by a -prime `p`, which multiplies to `n`. -/ -def factors_helper (n p : ℕ) (l : list ℕ) : Prop := -p.prime → list.chain (≤) p l ∧ (∀ a ∈ l, nat.prime a) ∧ list.prod l = n - -lemma factors_helper_nil (a : ℕ) : factors_helper 1 a [] := -λ pa, ⟨list.chain.nil, by rintro _ ⟨⟩, list.prod_nil⟩ - -lemma factors_helper_cons' (n m a b : ℕ) (l : list ℕ) - (h₁ : b * m = n) (h₂ : a ≤ b) (h₃ : nat.min_fac b = b) - (H : factors_helper m b l) : factors_helper n a (b :: l) := -λ pa, - have pb : b.prime, from nat.prime_def_min_fac.2 ⟨le_trans pa.two_le h₂, h₃⟩, - let ⟨f₁, f₂, f₃⟩ := H pb in - ⟨list.chain.cons h₂ f₁, λ c h, h.elim (λ e, e.symm ▸ pb) (f₂ _), - by rw [list.prod_cons, f₃, h₁]⟩ - -lemma factors_helper_cons (n m a b : ℕ) (l : list ℕ) - (h₁ : b * m = n) (h₂ : a < b) (h₃ : nat.min_fac b = b) - (H : factors_helper m b l) : factors_helper n a (b :: l) := -factors_helper_cons' _ _ _ _ _ h₁ h₂.le h₃ H - -lemma factors_helper_sn (n a : ℕ) (h₁ : a < n) (h₂ : nat.min_fac n = n) : factors_helper n a [n] := -factors_helper_cons _ _ _ _ _ (mul_one _) h₁ h₂ (factors_helper_nil _) - -lemma factors_helper_same (n m a : ℕ) (l : list ℕ) (h : a * m = n) - (H : factors_helper m a l) : factors_helper n a (a :: l) := -λ pa, factors_helper_cons' _ _ _ _ _ h le_rfl (nat.prime_def_min_fac.1 pa).2 H pa - -lemma factors_helper_same_sn (a : ℕ) : factors_helper a a [a] := -factors_helper_same _ _ _ _ (mul_one _) (factors_helper_nil _) - -lemma factors_helper_end (n : ℕ) (l : list ℕ) (H : factors_helper n 2 l) : nat.factors n = l := -let ⟨h₁, h₂, h₃⟩ := H nat.prime_two in -have _, from (list.chain'_iff_pairwise (@le_trans _ _)).1 (@list.chain'.tail _ _ (_::_) h₁), -(list.eq_of_perm_of_sorted (nat.factors_unique h₃ h₂) this (nat.factors_sorted _)).symm - -/-- Given `n` and `a` natural numerals, returns `(l, ⊢ factors_helper n a l)`. -/ -meta def prove_factors_aux : - instance_cache → expr → expr → ℕ → ℕ → tactic (instance_cache × expr × expr) -| c en ea n a := - let b := n.min_fac in - if b < n then do - let m := n / b, - (c, em) ← c.of_nat m, - if b = a then do - (c, _, p₁) ← prove_mul_nat c ea em, - (c, l, p₂) ← prove_factors_aux c em ea m a, - pure (c, `(%%ea::%%l:list ℕ), `(factors_helper_same).mk_app [en, em, ea, l, p₁, p₂]) - else do - (c, eb) ← c.of_nat b, - (c, _, p₁) ← prove_mul_nat c eb em, - (c, p₂) ← prove_lt_nat c ea eb, - (c, _, p₃) ← prove_min_fac c eb, - (c, l, p₄) ← prove_factors_aux c em eb m b, - pure (c, `(%%eb::%%l : list ℕ), - `(factors_helper_cons).mk_app [en, em, ea, eb, l, p₁, p₂, p₃, p₄]) - else if b = a then - pure (c, `([%%ea] : list ℕ), `(factors_helper_same_sn).mk_app [ea]) - else do - (c, p₁) ← prove_lt_nat c ea en, - (c, _, p₂) ← prove_min_fac c en, - pure (c, `([%%en] : list ℕ), `(factors_helper_sn).mk_app [en, ea, p₁, p₂]) - -/-- Evaluates the `prime` and `min_fac` functions. -/ -@[norm_num] meta def eval_prime : expr → tactic (expr × expr) -| `(nat.prime %%e) := do - n ← e.to_nat, - match n with - | 0 := false_intro `(nat.not_prime_zero) - | 1 := false_intro `(nat.not_prime_one) - | _ := let d₁ := n.min_fac in - if d₁ < n then prove_non_prime e n d₁ >>= false_intro - else do - let e₁ := reflect d₁, - c ← mk_instance_cache `(ℕ), - (c, p₁) ← prove_lt_nat c `(1) e₁, - (c, e₁, p) ← prove_min_fac c e, - true_intro $ `(is_prime_helper).mk_app [e, p₁, p] - end -| `(nat.min_fac %%e) := do - ic ← mk_instance_cache `(ℕ), - prod.snd <$> prove_min_fac ic e -| `(nat.factors %%e) := do - n ← e.to_nat, - match n with - | 0 := pure (`(@list.nil ℕ), `(nat.factors_zero)) - | 1 := pure (`(@list.nil ℕ), `(nat.factors_one)) - | _ := do - c ← mk_instance_cache `(ℕ), - (c, l, p) ← prove_factors_aux c e `(2) n 2, - pure (l, `(factors_helper_end).mk_app [e, l, p]) - end -| _ := failed - -end norm_num -end tactic - namespace nat -theorem prime_three : prime 3 := by norm_num - instance fact_prime_two : fact (prime 2) := ⟨prime_two⟩ instance fact_prime_three : fact (prime 3) := ⟨prime_three⟩ end nat - -namespace nat - -lemma mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} : - p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors := -begin - rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ←and_or_distrib_left], - simpa only [and.congr_right_iff] using prime.dvd_mul -end - -/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/ -lemma factors_mul_to_finset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : - (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset := -(list.to_finset.ext $ λ x, (mem_factors_mul ha hb).trans list.mem_union.symm).trans $ - list.to_finset_union _ _ - -lemma pow_succ_factors_to_finset (n k : ℕ) : - (n^(k+1)).factors.to_finset = n.factors.to_finset := -begin - rcases eq_or_ne n 0 with rfl | hn, - { simp }, - induction k with k ih, - { simp }, - rw [pow_succ, factors_mul_to_finset hn (pow_ne_zero _ hn), ih, finset.union_idempotent] -end - -lemma pow_factors_to_finset (n : ℕ) {k : ℕ} (hk : k ≠ 0) : - (n^k).factors.to_finset = n.factors.to_finset := -begin - cases k, - { simpa using hk }, - rw pow_succ_factors_to_finset -end - -/-- The only prime divisor of positive prime power `p^k` is `p` itself -/ -lemma prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : prime p) : - (p^k).factors.to_finset = {p} := -by simp [pow_factors_to_finset p hk, factors_prime hp] - -/-- The sets of factors of coprime `a` and `b` are disjoint -/ -lemma coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) : list.disjoint a.factors b.factors := -begin - intros q hqa hqb, - apply not_prime_one, - rw ←(eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)), - exact prime_of_mem_factors hqa -end - -lemma mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ): - p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors := -begin - rcases a.eq_zero_or_pos with rfl | ha, - { simp [(coprime_zero_left _).mp hab] }, - rcases b.eq_zero_or_pos with rfl | hb, - { simp [(coprime_zero_right _).mp hab] }, - rw [mem_factors_mul ha.ne' hb.ne', list.mem_union] -end - -lemma factors_mul_to_finset_of_coprime {a b : ℕ} (hab : coprime a b) : - (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset := -(list.to_finset.ext $ mem_factors_mul_of_coprime hab).trans $ list.to_finset_union _ _ - -open list - -/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/ -lemma mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a*b).factors := -begin - rcases eq_or_ne a 0 with rfl | ha, - { simpa using hpa }, - apply (mem_factors_mul ha hb).2 (or.inl hpa), -end - -/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/ -lemma mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) : p ∈ (a*b).factors := -by { rw mul_comm, exact mem_factors_mul_left hpb ha } - -lemma eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) : - (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, nat.prime p ∧ p ∣ n ∧ odd p := -(eq_or_ne n 0).elim - (λ hn, (or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩)) - (λ hn, or_iff_not_imp_right.mpr - (λ H, ⟨n.factors.length, eq_prime_pow_of_unique_prime_dvd hn - (λ p hprime hdvd, hprime.eq_two_or_odd'.resolve_right - (λ hodd, H ⟨p, hprime, hdvd, hodd⟩))⟩)) - -end nat - namespace int lemma prime_two : prime (2 : ℤ) := nat.prime_iff_prime_int.mp nat.prime_two lemma prime_three : prime (3 : ℤ) := nat.prime_iff_prime_int.mp nat.prime_three end int -section -open finset -/-- Exactly `n / p` naturals in `[1, n]` are multiples of `p`. -/ -lemma card_multiples (n p : ℕ) : card ((range n).filter (λ e, p ∣ e + 1)) = n / p := -begin - induction n with n hn, - { rw [nat.zero_div, range_zero, filter_empty, card_empty] }, - { rw [nat.succ_div, add_ite, add_zero, range_succ, filter_insert, apply_ite card, - card_insert_of_not_mem (mem_filter.not.mpr (not_and_of_not_left _ not_mem_range_self)), hn] } -end -end +assert_not_exists multiset diff --git a/src/data/nat/prime_fin.lean b/src/data/nat/prime_fin.lean new file mode 100644 index 0000000000000..9fe7a9f7ef4e1 --- /dev/null +++ b/src/data/nat/prime_fin.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ + +import data.nat.factors +import data.set.finite + +/-! +# Prime numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains some results about prime numbers which depend on finiteness of sets. +-/ + +namespace nat + +/-- A version of `nat.exists_infinite_primes` using the `set.infinite` predicate. -/ +lemma infinite_set_of_prime : {p | prime p}.infinite := +set.infinite_of_not_bdd_above not_bdd_above_set_of_prime + +/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/ +lemma factors_mul_to_finset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) : + (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset := +(list.to_finset.ext $ λ x, (mem_factors_mul ha hb).trans list.mem_union.symm).trans $ + list.to_finset_union _ _ + +lemma pow_succ_factors_to_finset (n k : ℕ) : + (n^(k+1)).factors.to_finset = n.factors.to_finset := +begin + rcases eq_or_ne n 0 with rfl | hn, + { simp }, + induction k with k ih, + { simp }, + rw [pow_succ, factors_mul_to_finset hn (pow_ne_zero _ hn), ih, finset.union_idempotent] +end + +lemma pow_factors_to_finset (n : ℕ) {k : ℕ} (hk : k ≠ 0) : + (n^k).factors.to_finset = n.factors.to_finset := +begin + cases k, + { simpa using hk }, + rw pow_succ_factors_to_finset +end + +/-- The only prime divisor of positive prime power `p^k` is `p` itself -/ +lemma prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : prime p) : + (p^k).factors.to_finset = {p} := +by simp [pow_factors_to_finset p hk, factors_prime hp] + +lemma factors_mul_to_finset_of_coprime {a b : ℕ} (hab : coprime a b) : + (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset := +(list.to_finset.ext $ mem_factors_mul_of_coprime hab).trans $ list.to_finset_union _ _ + +end nat diff --git a/src/data/nat/prime_norm_num.lean b/src/data/nat/prime_norm_num.lean new file mode 100644 index 0000000000000..664fd3f285cb9 --- /dev/null +++ b/src/data/nat/prime_norm_num.lean @@ -0,0 +1,254 @@ +/- +Copyright (c) 2015 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ +import data.nat.factors +import data.nat.prime +import tactic.norm_num + +/-! +# Primality prover + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file provides a `norm_num` extention to prove that natural numbers are prime. + +-/ + +namespace tactic +namespace norm_num + +lemma is_prime_helper (n : ℕ) + (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n := +nat.prime_def_min_fac.2 ⟨h₁, h₂⟩ + +lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 := +by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]] + +/-- A predicate representing partial progress in a proof of `min_fac`. -/ +def min_fac_helper (n k : ℕ) : Prop := +0 < k ∧ bit1 k ≤ nat.min_fac (bit1 n) + +theorem min_fac_helper.n_pos {n k : ℕ} (h : min_fac_helper n k) : 0 < n := +pos_iff_ne_zero.2 $ λ e, +by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2 + +lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k := +begin + rw bit0_eq_two_mul, + refine (λ e, absurd ((nat.dvd_add_iff_right _).2 + (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _))) _); simp +end + +lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 := +begin + refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩, + rw nat.succ_le_iff, + refine lt_of_le_of_ne (nat.min_fac_pos _) (λ e, nat.not_prime_one _), + rw e, + exact nat.min_fac_prime (nat.bit1_lt h).ne', +end + +lemma min_fac_helper_1 {n k k' : ℕ} (e : k + 1 = k') + (np : nat.min_fac (bit1 n) ≠ bit1 k) + (h : min_fac_helper n k) : min_fac_helper n k' := +begin + rw ← e, + refine ⟨nat.succ_pos _, + (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _) + min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩, + { rw add_right_comm, exact h.2 }, + { rw add_right_comm, exact np.symm } +end + +lemma min_fac_helper_2 (n k k' : ℕ) (e : k + 1 = k') + (np : ¬ nat.prime (bit1 k)) (h : min_fac_helper n k) : min_fac_helper n k' := +begin + refine min_fac_helper_1 e _ h, + intro e₁, rw ← e₁ at np, + exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos) +end + +lemma min_fac_helper_3 (n k k' c : ℕ) (e : k + 1 = k') + (nc : bit1 n % bit1 k = c) (c0 : 0 < c) + (h : min_fac_helper n k) : min_fac_helper n k' := +begin + refine min_fac_helper_1 e _ h, + refine mt _ (ne_of_gt c0), intro e₁, + rw [← nc, ← nat.dvd_iff_mod_eq_zero, ← e₁], + apply nat.min_fac_dvd +end + +lemma min_fac_helper_4 (n k : ℕ) (hd : bit1 n % bit1 k = 0) + (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 k := +by { rw ← nat.dvd_iff_mod_eq_zero at hd, + exact le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2 } + +lemma min_fac_helper_5 (n k k' : ℕ) (e : bit1 k * bit1 k = k') + (hd : bit1 n < k') (h : min_fac_helper n k) : nat.min_fac (bit1 n) = bit1 n := +begin + refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2 + ⟨nat.bit1_lt h.n_pos, _⟩)).2, + rw ← e at hd, + intros m m2 hm md, + have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm), + rw nat.le_sqrt at this, + exact not_le_of_lt hd this +end + +open _root_.norm_num + +/-- Given `e` a natural numeral and `d : nat` a factor of it, return `⊢ ¬ prime e`. -/ +meta def prove_non_prime (e : expr) (n d₁ : ℕ) : tactic expr := +do let e₁ := reflect d₁, + c ← mk_instance_cache `(nat), + (c, p₁) ← prove_lt_nat c `(1) e₁, + let d₂ := n / d₁, let e₂ := reflect d₂, + (c, e', p) ← prove_mul_nat c e₁ e₂, + guard (e' =ₐ e), + (c, p₂) ← prove_lt_nat c `(1) e₂, + return $ `(@nat.not_prime_mul').mk_app [e₁, e₂, e, p, p₁, p₂] + +/-- Given `a`,`a1 := bit1 a`, `n1` the value of `a1`, `b` and `p : min_fac_helper a b`, + returns `(c, ⊢ min_fac a1 = c)`. -/ +meta def prove_min_fac_aux (a a1 : expr) (n1 : ℕ) : + instance_cache → expr → expr → tactic (instance_cache × expr × expr) +| ic b p := do + k ← b.to_nat, + let k1 := bit1 k, + let b1 := `(bit1:ℕ→ℕ).mk_app [b], + if n1 < k1*k1 then do + (ic, e', p₁) ← prove_mul_nat ic b1 b1, + (ic, p₂) ← prove_lt_nat ic a1 e', + return (ic, a1, `(min_fac_helper_5).mk_app [a, b, e', p₁, p₂, p]) + else let d := k1.min_fac in + if to_bool (d < k1) then do + let k' := k+1, let e' := reflect k', + (ic, p₁) ← prove_succ ic b e', + p₂ ← prove_non_prime b1 k1 d, + prove_min_fac_aux ic e' $ `(min_fac_helper_2).mk_app [a, b, e', p₁, p₂, p] + else do + let nc := n1 % k1, + (ic, c, pc) ← prove_div_mod ic a1 b1 tt, + if nc = 0 then + return (ic, b1, `(min_fac_helper_4).mk_app [a, b, pc, p]) + else do + (ic, p₀) ← prove_pos ic c, + let k' := k+1, let e' := reflect k', + (ic, p₁) ← prove_succ ic b e', + prove_min_fac_aux ic e' $ `(min_fac_helper_3).mk_app [a, b, e', c, p₁, pc, p₀, p] + +/-- Given `a` a natural numeral, returns `(b, ⊢ min_fac a = b)`. -/ +meta def prove_min_fac (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) := +match match_numeral e with +| match_numeral_result.zero := return (ic, `(2:ℕ), `(nat.min_fac_zero)) +| match_numeral_result.one := return (ic, `(1:ℕ), `(nat.min_fac_one)) +| match_numeral_result.bit0 e := return (ic, `(2), `(min_fac_bit0).mk_app [e]) +| match_numeral_result.bit1 e := do + n ← e.to_nat, + c ← mk_instance_cache `(nat), + (c, p) ← prove_pos c e, + let a1 := `(bit1:ℕ→ℕ).mk_app [e], + prove_min_fac_aux e a1 (bit1 n) c `(1) (`(min_fac_helper_0).mk_app [e, p]) +| _ := failed +end + +/-- A partial proof of `factors`. Asserts that `l` is a sorted list of primes, lower bounded by a +prime `p`, which multiplies to `n`. -/ +def factors_helper (n p : ℕ) (l : list ℕ) : Prop := +p.prime → list.chain (≤) p l ∧ (∀ a ∈ l, nat.prime a) ∧ list.prod l = n + +lemma factors_helper_nil (a : ℕ) : factors_helper 1 a [] := +λ pa, ⟨list.chain.nil, by rintro _ ⟨⟩, list.prod_nil⟩ + +lemma factors_helper_cons' (n m a b : ℕ) (l : list ℕ) + (h₁ : b * m = n) (h₂ : a ≤ b) (h₃ : nat.min_fac b = b) + (H : factors_helper m b l) : factors_helper n a (b :: l) := +λ pa, + have pb : b.prime, from nat.prime_def_min_fac.2 ⟨le_trans pa.two_le h₂, h₃⟩, + let ⟨f₁, f₂, f₃⟩ := H pb in + ⟨list.chain.cons h₂ f₁, λ c h, h.elim (λ e, e.symm ▸ pb) (f₂ _), + by rw [list.prod_cons, f₃, h₁]⟩ + +lemma factors_helper_cons (n m a b : ℕ) (l : list ℕ) + (h₁ : b * m = n) (h₂ : a < b) (h₃ : nat.min_fac b = b) + (H : factors_helper m b l) : factors_helper n a (b :: l) := +factors_helper_cons' _ _ _ _ _ h₁ h₂.le h₃ H + +lemma factors_helper_sn (n a : ℕ) (h₁ : a < n) (h₂ : nat.min_fac n = n) : factors_helper n a [n] := +factors_helper_cons _ _ _ _ _ (mul_one _) h₁ h₂ (factors_helper_nil _) + +lemma factors_helper_same (n m a : ℕ) (l : list ℕ) (h : a * m = n) + (H : factors_helper m a l) : factors_helper n a (a :: l) := +λ pa, factors_helper_cons' _ _ _ _ _ h le_rfl (nat.prime_def_min_fac.1 pa).2 H pa + +lemma factors_helper_same_sn (a : ℕ) : factors_helper a a [a] := +factors_helper_same _ _ _ _ (mul_one _) (factors_helper_nil _) + +lemma factors_helper_end (n : ℕ) (l : list ℕ) (H : factors_helper n 2 l) : nat.factors n = l := +let ⟨h₁, h₂, h₃⟩ := H nat.prime_two in +have _, from list.chain'_iff_pairwise.1 (@list.chain'.tail _ _ (_::_) h₁), +(list.eq_of_perm_of_sorted (nat.factors_unique h₃ h₂) this (nat.factors_sorted _)).symm + +/-- Given `n` and `a` natural numerals, returns `(l, ⊢ factors_helper n a l)`. -/ +meta def prove_factors_aux : + instance_cache → expr → expr → ℕ → ℕ → tactic (instance_cache × expr × expr) +| c en ea n a := + let b := n.min_fac in + if b < n then do + let m := n / b, + (c, em) ← c.of_nat m, + if b = a then do + (c, _, p₁) ← prove_mul_nat c ea em, + (c, l, p₂) ← prove_factors_aux c em ea m a, + pure (c, `(%%ea::%%l:list ℕ), `(factors_helper_same).mk_app [en, em, ea, l, p₁, p₂]) + else do + (c, eb) ← c.of_nat b, + (c, _, p₁) ← prove_mul_nat c eb em, + (c, p₂) ← prove_lt_nat c ea eb, + (c, _, p₃) ← prove_min_fac c eb, + (c, l, p₄) ← prove_factors_aux c em eb m b, + pure (c, `(%%eb::%%l : list ℕ), + `(factors_helper_cons).mk_app [en, em, ea, eb, l, p₁, p₂, p₃, p₄]) + else if b = a then + pure (c, `([%%ea] : list ℕ), `(factors_helper_same_sn).mk_app [ea]) + else do + (c, p₁) ← prove_lt_nat c ea en, + (c, _, p₂) ← prove_min_fac c en, + pure (c, `([%%en] : list ℕ), `(factors_helper_sn).mk_app [en, ea, p₁, p₂]) + +/-- Evaluates the `prime` and `min_fac` functions. -/ +@[norm_num] meta def eval_prime : expr → tactic (expr × expr) +| `(nat.prime %%e) := do + n ← e.to_nat, + match n with + | 0 := false_intro `(nat.not_prime_zero) + | 1 := false_intro `(nat.not_prime_one) + | _ := let d₁ := n.min_fac in + if d₁ < n then prove_non_prime e n d₁ >>= false_intro + else do + let e₁ := reflect d₁, + c ← mk_instance_cache `(ℕ), + (c, p₁) ← prove_lt_nat c `(1) e₁, + (c, e₁, p) ← prove_min_fac c e, + true_intro $ `(is_prime_helper).mk_app [e, p₁, p] + end +| `(nat.min_fac %%e) := do + ic ← mk_instance_cache `(ℕ), + prod.snd <$> prove_min_fac ic e +| `(nat.factors %%e) := do + n ← e.to_nat, + match n with + | 0 := pure (`(@list.nil ℕ), `(nat.factors_zero)) + | 1 := pure (`(@list.nil ℕ), `(nat.factors_one)) + | _ := do + c ← mk_instance_cache `(ℕ), + (c, l, p) ← prove_factors_aux c e `(2) n 2, + pure (l, `(factors_helper_end).mk_app [e, l, p]) + end +| _ := failed + +end norm_num +end tactic diff --git a/src/data/nat/psub.lean b/src/data/nat/psub.lean index f9b9d539694dc..325e5b6f66deb 100644 --- a/src/data/nat/psub.lean +++ b/src/data/nat/psub.lean @@ -3,10 +3,14 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import data.option.basic import data.nat.basic /-! # Partial predecessor and partial subtraction on the natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The usual definition of natural number subtraction (`nat.sub`) returns 0 as a "garbage value" for `a - b` when `a < b`. Similarly, `nat.pred 0` is defined to be `0`. The functions in this file wrap the result in an `option` type instead: @@ -69,7 +73,7 @@ theorem ppred_eq_pred {n} (h : 0 < n) : ppred n = some (pred n) := ppred_eq_some.2 $ succ_pred_eq_of_pos h theorem psub_eq_sub {m n} (h : n ≤ m) : psub m n = some (m - n) := -psub_eq_some.2 $ tsub_add_cancel_of_le h +psub_eq_some.2 $ nat.sub_add_cancel h theorem psub_add (m n k) : psub m (n + k) = do x ← psub m n, psub x k := by induction k; simp [*, add_succ, bind_assoc] diff --git a/src/data/nat/set.lean b/src/data/nat/set.lean new file mode 100644 index 0000000000000..eab9bf116b1ce --- /dev/null +++ b/src/data/nat/set.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2020 Yury Kudryashov. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yury Kudryashov +-/ + +import data.set.image + +/-! +### Recursion on the natural numbers and `set.range` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +-/ + +namespace nat +section set + +open set + +theorem zero_union_range_succ : {0} ∪ range succ = univ := +by { ext n, cases n; simp } + +@[simp] protected lemma range_succ : range succ = {i | 0 < i} := +by ext (_ | i); simp [succ_pos, succ_ne_zero] + +variables {α : Type*} + +theorem range_of_succ (f : ℕ → α) : {f 0} ∪ range (f ∘ succ) = range f := +by rw [← image_singleton, range_comp, ← image_union, zero_union_range_succ, image_univ] + +theorem range_rec {α : Type*} (x : α) (f : ℕ → α → α) : + (set.range (λ n, nat.rec x f n) : set α) = + {x} ∪ set.range (λ n, nat.rec (f 0 x) (f ∘ succ) n) := +begin + convert (range_of_succ _).symm, + ext n, + induction n with n ihn, + { refl }, + { dsimp at ihn ⊢, + rw ihn } +end + +theorem range_cases_on {α : Type*} (x : α) (f : ℕ → α) : + (set.range (λ n, nat.cases_on n x f) : set α) = {x} ∪ set.range f := +(range_of_succ _).symm + +end set +end nat diff --git a/src/data/nat/size.lean b/src/data/nat/size.lean new file mode 100644 index 0000000000000..56ba762a64894 --- /dev/null +++ b/src/data/nat/size.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ +import data.nat.pow +import data.nat.bits + +/-! +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Lemmas about `size`. -/ + +namespace nat + +/-! ### `shiftl` and `shiftr` -/ + +lemma shiftl_eq_mul_pow (m) : ∀ n, shiftl m n = m * 2 ^ n +| 0 := (nat.mul_one _).symm +| (k+1) := show bit0 (shiftl m k) = m * (2 * 2 ^ k), + by rw [bit0_val, shiftl_eq_mul_pow, mul_left_comm, mul_comm 2] + +lemma shiftl'_tt_eq_mul_pow (m) : ∀ n, shiftl' tt m n + 1 = (m + 1) * 2 ^ n +| 0 := by simp [shiftl, shiftl', pow_zero, nat.one_mul] +| (k+1) := +begin + change bit1 (shiftl' tt m k) + 1 = (m + 1) * (2 * 2 ^ k), + rw bit1_val, + change 2 * (shiftl' tt m k + 1) = _, + rw [shiftl'_tt_eq_mul_pow, mul_left_comm, mul_comm 2], +end + +lemma one_shiftl (n) : shiftl 1 n = 2 ^ n := +(shiftl_eq_mul_pow _ _).trans (nat.one_mul _) + +@[simp] lemma zero_shiftl (n) : shiftl 0 n = 0 := +(shiftl_eq_mul_pow _ _).trans (nat.zero_mul _) + +lemma shiftr_eq_div_pow (m) : ∀ n, shiftr m n = m / 2 ^ n +| 0 := (nat.div_one _).symm +| (k+1) := (congr_arg div2 (shiftr_eq_div_pow k)).trans $ + by rw [div2_val, nat.div_div_eq_div_mul, mul_comm]; refl + +@[simp] lemma zero_shiftr (n) : shiftr 0 n = 0 := +(shiftr_eq_div_pow _ _).trans (nat.zero_div _) + +theorem shiftl'_ne_zero_left (b) {m} (h : m ≠ 0) (n) : shiftl' b m n ≠ 0 := +by induction n; simp [bit_ne_zero, shiftl', *] + +theorem shiftl'_tt_ne_zero (m) : ∀ {n} (h : n ≠ 0), shiftl' tt m n ≠ 0 +| 0 h := absurd rfl h +| (succ n) _ := nat.bit1_ne_zero _ + +/-! ### `size` -/ + +@[simp] theorem size_zero : size 0 = 0 := by simp [size] + +@[simp] theorem size_bit {b n} (h : bit b n ≠ 0) : size (bit b n) = succ (size n) := +begin + rw size, + conv { to_lhs, rw [binary_rec], simp [h] }, + rw div2_bit, +end + +@[simp] theorem size_bit0 {n} (h : n ≠ 0) : size (bit0 n) = succ (size n) := +@size_bit ff n (nat.bit0_ne_zero h) + +@[simp] theorem size_bit1 (n) : size (bit1 n) = succ (size n) := +@size_bit tt n (nat.bit1_ne_zero n) + +@[simp] theorem size_one : size 1 = 1 := +show size (bit1 0) = 1, by rw [size_bit1, size_zero] + +@[simp] theorem size_shiftl' {b m n} (h : shiftl' b m n ≠ 0) : + size (shiftl' b m n) = size m + n := +begin + induction n with n IH; simp [shiftl'] at h ⊢, + rw [size_bit h, nat.add_succ], + by_cases s0 : shiftl' b m n = 0; [skip, rw [IH s0]], + rw s0 at h ⊢, + cases b, {exact absurd rfl h}, + have : shiftl' tt m n + 1 = 1 := congr_arg (+1) s0, + rw [shiftl'_tt_eq_mul_pow] at this, + obtain rfl := succ.inj (eq_one_of_dvd_one ⟨_, this.symm⟩), + rw one_mul at this, + obtain rfl : n = 0 := nat.eq_zero_of_le_zero (le_of_not_gt $ λ hn, + ne_of_gt (pow_lt_pow_of_lt_right dec_trivial hn) this), + refl +end + +@[simp] theorem size_shiftl {m} (h : m ≠ 0) (n) : + size (shiftl m n) = size m + n := +size_shiftl' (shiftl'_ne_zero_left _ h _) + +theorem lt_size_self (n : ℕ) : n < 2^size n := +begin + rw [← one_shiftl], + have : ∀ {n}, n = 0 → n < shiftl 1 (size n), { simp }, + apply binary_rec _ _ n, {apply this rfl}, + intros b n IH, + by_cases bit b n = 0, {apply this h}, + rw [size_bit h, shiftl_succ], + exact bit_lt_bit0 _ IH +end + +theorem size_le {m n : ℕ} : size m ≤ n ↔ m < 2^n := +⟨λ h, lt_of_lt_of_le (lt_size_self _) (pow_le_pow_of_le_right dec_trivial h), +begin + rw [← one_shiftl], revert n, + apply binary_rec _ _ m, + { intros n h, simp }, + { intros b m IH n h, + by_cases e : bit b m = 0, { simp [e] }, + rw [size_bit e], + cases n with n, + { exact e.elim (nat.eq_zero_of_le_zero (le_of_lt_succ h)) }, + { apply succ_le_succ (IH _), + apply lt_imp_lt_of_le_imp_le (λ h', bit0_le_bit _ h') h } } +end⟩ + +theorem lt_size {m n : ℕ} : m < size n ↔ 2^m ≤ n := +by rw [← not_lt, decidable.iff_not_comm, not_lt, size_le] + +theorem size_pos {n : ℕ} : 0 < size n ↔ 0 < n := +by rw lt_size; refl + +theorem size_eq_zero {n : ℕ} : size n = 0 ↔ n = 0 := +by have := @size_pos n; simp [pos_iff_ne_zero] at this; + exact decidable.not_iff_not.1 this + +theorem size_pow {n : ℕ} : size (2^n) = n+1 := +le_antisymm + (size_le.2 $ pow_lt_pow_of_lt_right dec_trivial (lt_succ_self _)) + (lt_size.2 $ le_rfl) + +theorem size_le_size {m n : ℕ} (h : m ≤ n) : size m ≤ size n := +size_le.2 $ lt_of_le_of_lt h (lt_size_self _) + +lemma size_eq_bits_len (n : ℕ) : n.bits.length = n.size := +begin + induction n using nat.binary_rec' with b n h ih, { simp, }, + rw [size_bit, bits_append_bit _ _ h], + { simp [ih], }, + { simpa [bit_eq_zero_iff], } +end + +end nat diff --git a/src/data/nat/sqrt.lean b/src/data/nat/sqrt.lean index 3df252d2a0672..d9ec06da13855 100644 --- a/src/data/nat/sqrt.lean +++ b/src/data/nat/sqrt.lean @@ -3,11 +3,15 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Leonardo de Moura, Johannes Hölzl, Mario Carneiro -/ -import data.int.basic +import data.int.order.basic +import data.nat.size /-! # Square root of natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines an efficient binary implementation of the square root function that returns the unique `r` such that `r * r ≤ n < (r + 1) * (r + 1)`. It takes advantage of the binary representation by replacing the multiplication by 2 appearing in diff --git a/src/data/nat/sqrt_norm_num.lean b/src/data/nat/sqrt_norm_num.lean index 8f63384879b02..4ae37dded19f0 100644 --- a/src/data/nat/sqrt_norm_num.lean +++ b/src/data/nat/sqrt_norm_num.lean @@ -8,6 +8,9 @@ import data.nat.sqrt /-! ### `norm_num` plugin for `sqrt` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The `norm_num` plugin evaluates `sqrt` by bounding it between consecutive integers. -/ diff --git a/src/data/nat/squarefree.lean b/src/data/nat/squarefree.lean new file mode 100644 index 0000000000000..55c412691488f --- /dev/null +++ b/src/data/nat/squarefree.lean @@ -0,0 +1,533 @@ +/- +Copyright (c) 2020 Aaron Anderson. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Aaron Anderson +-/ +import algebra.squarefree +import data.nat.factorization.prime_pow +import data.nat.prime_norm_num +import ring_theory.int.basic + +/-! +# Lemmas about squarefreeness of natural numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. +A number is squarefree when it is not divisible by any squares except the squares of units. + +## Main Results + - `nat.squarefree_iff_nodup_factors`: A positive natural number `x` is squarefree iff + the list `factors x` has no duplicate factors. + +## Tags +squarefree, multiplicity + +-/ + +namespace nat + +lemma squarefree_iff_nodup_factors {n : ℕ} (h0 : n ≠ 0) : + squarefree n ↔ n.factors.nodup := +begin + rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors h0, nat.factors_eq], + simp, +end + +theorem squarefree_iff_prime_squarefree {n : ℕ} : squarefree n ↔ ∀ x, prime x → ¬ x * x ∣ n := +squarefree_iff_irreducible_sq_not_dvd_of_exists_irreducible ⟨_, prime_two⟩ + +lemma squarefree.factorization_le_one {n : ℕ} (p : ℕ) (hn : squarefree n) : + n.factorization p ≤ 1 := +begin + rcases eq_or_ne n 0 with rfl | hn', + { simp }, + rw [multiplicity.squarefree_iff_multiplicity_le_one] at hn, + by_cases hp : p.prime, + { have := hn p, + simp only [multiplicity_eq_factorization hp hn', nat.is_unit_iff, hp.ne_one, or_false] at this, + exact_mod_cast this }, + { rw factorization_eq_zero_of_non_prime _ hp, + exact zero_le_one } +end + +lemma squarefree_of_factorization_le_one {n : ℕ} (hn : n ≠ 0) (hn' : ∀ p, n.factorization p ≤ 1) : + squarefree n := +begin + rw [squarefree_iff_nodup_factors hn, list.nodup_iff_count_le_one], + intro a, + rw factors_count_eq, + apply hn', +end + +lemma squarefree_iff_factorization_le_one {n : ℕ} (hn : n ≠ 0) : + squarefree n ↔ ∀ p, n.factorization p ≤ 1 := +⟨λ p hn, squarefree.factorization_le_one hn p, squarefree_of_factorization_le_one hn⟩ + +lemma squarefree.ext_iff {n m : ℕ} (hn : squarefree n) (hm : squarefree m) : + n = m ↔ ∀ p, prime p → (p ∣ n ↔ p ∣ m) := +begin + refine ⟨by { rintro rfl, simp }, λ h, eq_of_factorization_eq hn.ne_zero hm.ne_zero (λ p, _)⟩, + by_cases hp : p.prime, + { have h₁ := h _ hp, + rw [←not_iff_not, hp.dvd_iff_one_le_factorization hn.ne_zero, not_le, lt_one_iff, + hp.dvd_iff_one_le_factorization hm.ne_zero, not_le, lt_one_iff] at h₁, + have h₂ := squarefree.factorization_le_one p hn, + have h₃ := squarefree.factorization_le_one p hm, + rw [nat.le_add_one_iff, le_zero_iff] at h₂ h₃, + cases h₂, + { rwa [h₂, eq_comm, ←h₁] }, + { rw [h₂, h₃.resolve_left], + rw [←h₁, h₂], + simp only [nat.one_ne_zero, not_false_iff] } }, + rw [factorization_eq_zero_of_non_prime _ hp, factorization_eq_zero_of_non_prime _ hp], +end + +lemma squarefree_pow_iff {n k : ℕ} (hn : n ≠ 1) (hk : k ≠ 0) : + squarefree (n ^ k) ↔ squarefree n ∧ k = 1 := +begin + refine ⟨λ h, _, by { rintro ⟨hn, rfl⟩, simpa }⟩, + rcases eq_or_ne n 0 with rfl | hn₀, + { simpa [zero_pow hk.bot_lt] using h }, + refine ⟨h.squarefree_of_dvd (dvd_pow_self _ hk), by_contradiction $ λ h₁, _⟩, + have : 2 ≤ k := k.two_le_iff.mpr ⟨hk, h₁⟩, + apply hn (nat.is_unit_iff.1 (h _ _)), + rw ←sq, + exact pow_dvd_pow _ this +end + +lemma squarefree_and_prime_pow_iff_prime {n : ℕ} : + squarefree n ∧ is_prime_pow n ↔ prime n := +begin + refine iff.symm ⟨λ hn, ⟨hn.squarefree, hn.is_prime_pow⟩, _⟩, + rw is_prime_pow_nat_iff, + rintro ⟨h, p, k, hp, hk, rfl⟩, + rw squarefree_pow_iff hp.ne_one hk.ne' at h, + rwa [h.2, pow_one], +end + +/-- Assuming that `n` has no factors less than `k`, returns the smallest prime `p` such that + `p^2 ∣ n`. -/ +def min_sq_fac_aux : ℕ → ℕ → option ℕ +| n k := + if h : n < k * k then none else + have nat.sqrt n + 2 - (k + 2) < nat.sqrt n + 2 - k, + by { rw nat.add_sub_add_right, exact nat.min_fac_lemma n k h }, + if k ∣ n then + let n' := n / k in + have nat.sqrt n' + 2 - (k + 2) < nat.sqrt n + 2 - k, from + lt_of_le_of_lt (nat.sub_le_sub_right + (nat.add_le_add_right (nat.sqrt_le_sqrt $ nat.div_le_self _ _) _) _) this, + if k ∣ n' then some k else min_sq_fac_aux n' (k + 2) + else min_sq_fac_aux n (k + 2) +using_well_founded {rel_tac := + λ _ _, `[exact ⟨_, measure_wf (λ ⟨n, k⟩, nat.sqrt n + 2 - k)⟩]} + +/-- Returns the smallest prime factor `p` of `n` such that `p^2 ∣ n`, or `none` if there is no + such `p` (that is, `n` is squarefree). See also `squarefree_iff_min_sq_fac`. -/ +def min_sq_fac (n : ℕ) : option ℕ := +if 2 ∣ n then + let n' := n / 2 in + if 2 ∣ n' then some 2 else min_sq_fac_aux n' 3 +else min_sq_fac_aux n 3 + +/-- The correctness property of the return value of `min_sq_fac`. + * If `none`, then `n` is squarefree; + * If `some d`, then `d` is a minimal square factor of `n` -/ +def min_sq_fac_prop (n : ℕ) : option ℕ → Prop +| none := squarefree n +| (some d) := prime d ∧ d * d ∣ n ∧ ∀ p, prime p → p * p ∣ n → d ≤ p + +theorem min_sq_fac_prop_div (n) {k} (pk : prime k) (dk : k ∣ n) (dkk : ¬ k * k ∣ n) + {o} (H : min_sq_fac_prop (n / k) o) : min_sq_fac_prop n o := +begin + have : ∀ p, prime p → p*p ∣ n → k*(p*p) ∣ n := λ p pp dp, + have _ := (coprime_primes pk pp).2 (λ e, by { subst e, contradiction }), + (coprime_mul_iff_right.2 ⟨this, this⟩).mul_dvd_of_dvd_of_dvd dk dp, + cases o with d, + { rw [min_sq_fac_prop, squarefree_iff_prime_squarefree] at H ⊢, + exact λ p pp dp, H p pp ((dvd_div_iff dk).2 (this _ pp dp)) }, + { obtain ⟨H1, H2, H3⟩ := H, + simp only [dvd_div_iff dk] at H2 H3, + exact ⟨H1, dvd_trans (dvd_mul_left _ _) H2, λ p pp dp, H3 _ pp (this _ pp dp)⟩ } +end + +theorem min_sq_fac_aux_has_prop : ∀ {n : ℕ} k, 0 < n → ∀ i, k = 2*i+3 → + (∀ m, prime m → m ∣ n → k ≤ m) → min_sq_fac_prop n (min_sq_fac_aux n k) +| n k := λ n0 i e ih, begin + rw min_sq_fac_aux, + by_cases h : n < k*k; simp [h], + { refine squarefree_iff_prime_squarefree.2 (λ p pp d, _), + have := ih p pp (dvd_trans ⟨_, rfl⟩ d), + have := nat.mul_le_mul this this, + exact not_le_of_lt h (le_trans this (le_of_dvd n0 d)) }, + have k2 : 2 ≤ k, { subst e, exact dec_trivial }, + have k0 : 0 < k := lt_of_lt_of_le dec_trivial k2, + have IH : ∀ n', n' ∣ n → ¬ k ∣ n' → min_sq_fac_prop n' (n'.min_sq_fac_aux (k + 2)), + { intros n' nd' nk, + have hn' := le_of_dvd n0 nd', + refine + have nat.sqrt n' - k < nat.sqrt n + 2 - k, from + lt_of_le_of_lt (nat.sub_le_sub_right (nat.sqrt_le_sqrt hn') _) (nat.min_fac_lemma n k h), + @min_sq_fac_aux_has_prop n' (k+2) (pos_of_dvd_of_pos nd' n0) + (i+1) (by simp [e, left_distrib]) (λ m m2 d, _), + cases nat.eq_or_lt_of_le (ih m m2 (dvd_trans d nd')) with me ml, + { subst me, contradiction }, + apply (nat.eq_or_lt_of_le ml).resolve_left, intro me, + rw [← me, e] at d, change 2 * (i + 2) ∣ n' at d, + have := ih _ prime_two (dvd_trans (dvd_of_mul_right_dvd d) nd'), + rw e at this, exact absurd this dec_trivial }, + have pk : k ∣ n → prime k, + { refine λ dk, prime_def_min_fac.2 ⟨k2, le_antisymm (min_fac_le k0) _⟩, + exact ih _ (min_fac_prime (ne_of_gt k2)) (dvd_trans (min_fac_dvd _) dk) }, + split_ifs with dk dkk, + { exact ⟨pk dk, (nat.dvd_div_iff dk).1 dkk, λ p pp d, ih p pp (dvd_trans ⟨_, rfl⟩ d)⟩ }, + { specialize IH (n/k) (div_dvd_of_dvd dk) dkk, + exact min_sq_fac_prop_div _ (pk dk) dk (mt (nat.dvd_div_iff dk).2 dkk) IH }, + { exact IH n (dvd_refl _) dk } +end +using_well_founded {rel_tac := + λ _ _, `[exact ⟨_, measure_wf (λ ⟨n, k⟩, nat.sqrt n + 2 - k)⟩]} + +theorem min_sq_fac_has_prop (n : ℕ) : min_sq_fac_prop n (min_sq_fac n) := +begin + dunfold min_sq_fac, split_ifs with d2 d4, + { exact ⟨prime_two, (dvd_div_iff d2).1 d4, λ p pp _, pp.two_le⟩ }, + { cases nat.eq_zero_or_pos n with n0 n0, { subst n0, cases d4 dec_trivial }, + refine min_sq_fac_prop_div _ prime_two d2 (mt (dvd_div_iff d2).2 d4) _, + refine min_sq_fac_aux_has_prop 3 (nat.div_pos (le_of_dvd n0 d2) dec_trivial) 0 rfl _, + refine λ p pp dp, succ_le_of_lt (lt_of_le_of_ne pp.two_le _), + rintro rfl, contradiction }, + { cases nat.eq_zero_or_pos n with n0 n0, { subst n0, cases d2 dec_trivial }, + refine min_sq_fac_aux_has_prop _ n0 0 rfl _, + refine λ p pp dp, succ_le_of_lt (lt_of_le_of_ne pp.two_le _), + rintro rfl, contradiction }, +end + +theorem min_sq_fac_prime {n d : ℕ} (h : n.min_sq_fac = some d) : prime d := +by { have := min_sq_fac_has_prop n, rw h at this, exact this.1 } + +theorem min_sq_fac_dvd {n d : ℕ} (h : n.min_sq_fac = some d) : d * d ∣ n := +by { have := min_sq_fac_has_prop n, rw h at this, exact this.2.1 } + +theorem min_sq_fac_le_of_dvd {n d : ℕ} (h : n.min_sq_fac = some d) + {m} (m2 : 2 ≤ m) (md : m * m ∣ n) : d ≤ m := +begin + have := min_sq_fac_has_prop n, rw h at this, + have fd := min_fac_dvd m, + exact le_trans + (this.2.2 _ (min_fac_prime $ ne_of_gt m2) (dvd_trans (mul_dvd_mul fd fd) md)) + (min_fac_le $ lt_of_lt_of_le dec_trivial m2), +end + +lemma squarefree_iff_min_sq_fac {n : ℕ} : + squarefree n ↔ n.min_sq_fac = none := +begin + have := min_sq_fac_has_prop n, + split; intro H, + { cases n.min_sq_fac with d, {refl}, + cases squarefree_iff_prime_squarefree.1 H _ this.1 this.2.1 }, + { rwa H at this } +end + +instance : decidable_pred (squarefree : ℕ → Prop) := +λ n, decidable_of_iff' _ squarefree_iff_min_sq_fac + +theorem squarefree_two : squarefree 2 := by rw squarefree_iff_nodup_factors; norm_num + +open unique_factorization_monoid + +lemma divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) : + (n.divisors.filter squarefree).val = + (unique_factorization_monoid.normalized_factors n).to_finset.powerset.val.map + (λ x, x.val.prod) := +begin + rw (finset.nodup _).ext ((finset.nodup _).map_on _), + { intro a, + simp only [multiset.mem_filter, id.def, multiset.mem_map, finset.filter_val, ← finset.mem_def, + mem_divisors], + split, + { rintro ⟨⟨an, h0⟩, hsq⟩, + use (unique_factorization_monoid.normalized_factors a).to_finset, + simp only [id.def, finset.mem_powerset], + rcases an with ⟨b, rfl⟩, + rw mul_ne_zero_iff at h0, + rw unique_factorization_monoid.squarefree_iff_nodup_normalized_factors h0.1 at hsq, + rw [multiset.to_finset_subset, multiset.to_finset_val, hsq.dedup, ← associated_iff_eq, + normalized_factors_mul h0.1 h0.2], + exact ⟨multiset.subset_of_le (multiset.le_add_right _ _), normalized_factors_prod h0.1⟩ }, + { rintro ⟨s, hs, rfl⟩, + rw [finset.mem_powerset, ← finset.val_le_iff, multiset.to_finset_val] at hs, + have hs0 : s.val.prod ≠ 0, + { rw [ne.def, multiset.prod_eq_zero_iff], + simp only [exists_prop, id.def, exists_eq_right], + intro con, + apply not_irreducible_zero (irreducible_of_normalized_factor 0 + (multiset.mem_dedup.1 (multiset.mem_of_le hs con))) }, + rw (normalized_factors_prod h0).symm.dvd_iff_dvd_right, + refine ⟨⟨multiset.prod_dvd_prod_of_le (le_trans hs (multiset.dedup_le _)), h0⟩, _⟩, + have h := unique_factorization_monoid.factors_unique irreducible_of_normalized_factor + (λ x hx, irreducible_of_normalized_factor x (multiset.mem_of_le + (le_trans hs (multiset.dedup_le _)) hx)) (normalized_factors_prod hs0), + rw [associated_eq_eq, multiset.rel_eq] at h, + rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors hs0, h], + apply s.nodup } }, + { intros x hx y hy h, + rw [← finset.val_inj, ← multiset.rel_eq, ← associated_eq_eq], + rw [← finset.mem_def, finset.mem_powerset] at hx hy, + apply unique_factorization_monoid.factors_unique _ _ (associated_iff_eq.2 h), + { intros z hz, + apply irreducible_of_normalized_factor z, + rw ← multiset.mem_to_finset, + apply hx hz }, + { intros z hz, + apply irreducible_of_normalized_factor z, + rw ← multiset.mem_to_finset, + apply hy hz } } +end + +open_locale big_operators + +lemma sum_divisors_filter_squarefree {n : ℕ} (h0 : n ≠ 0) + {α : Type*} [add_comm_monoid α] {f : ℕ → α} : + ∑ i in (n.divisors.filter squarefree), f i = + ∑ i in (unique_factorization_monoid.normalized_factors n).to_finset.powerset, f (i.val.prod) := +by rw [finset.sum_eq_multiset_sum, divisors_filter_squarefree h0, multiset.map_map, + finset.sum_eq_multiset_sum] + +lemma sq_mul_squarefree_of_pos {n : ℕ} (hn : 0 < n) : + ∃ a b : ℕ, 0 < a ∧ 0 < b ∧ b ^ 2 * a = n ∧ squarefree a := +begin + let S := {s ∈ finset.range (n + 1) | s ∣ n ∧ ∃ x, s = x ^ 2}, + have hSne : S.nonempty, + { use 1, + have h1 : 0 < n ∧ ∃ (x : ℕ), 1 = x ^ 2 := ⟨hn, ⟨1, (one_pow 2).symm⟩⟩, + simpa [S] }, + let s := finset.max' S hSne, + have hs : s ∈ S := finset.max'_mem S hSne, + simp only [finset.sep_def, S, finset.mem_filter, finset.mem_range] at hs, + obtain ⟨hsn1, ⟨a, hsa⟩, ⟨b, hsb⟩⟩ := hs, + rw hsa at hn, + obtain ⟨hlts, hlta⟩ := canonically_ordered_comm_semiring.mul_pos.mp hn, + rw hsb at hsa hn hlts, + refine ⟨a, b, hlta, (pow_pos_iff zero_lt_two).mp hlts, hsa.symm, _⟩, + rintro x ⟨y, hy⟩, + rw nat.is_unit_iff, + by_contra hx, + refine lt_le_antisymm _ (finset.le_max' S ((b * x) ^ 2) _), + { simp_rw [S, hsa, finset.sep_def, finset.mem_filter, finset.mem_range], + refine ⟨lt_succ_iff.mpr (le_of_dvd hn _), _, ⟨b * x, rfl⟩⟩; use y; rw hy; ring }, + { convert lt_mul_of_one_lt_right hlts + (one_lt_pow 2 x zero_lt_two (one_lt_iff_ne_zero_and_ne_one.mpr ⟨λ h, by simp * at *, hx⟩)), + rw mul_pow }, +end + +lemma sq_mul_squarefree_of_pos' {n : ℕ} (h : 0 < n) : + ∃ a b : ℕ, (b + 1) ^ 2 * (a + 1) = n ∧ squarefree (a + 1) := +begin + obtain ⟨a₁, b₁, ha₁, hb₁, hab₁, hab₂⟩ := sq_mul_squarefree_of_pos h, + refine ⟨a₁.pred, b₁.pred, _, _⟩; + simpa only [add_one, succ_pred_eq_of_pos, ha₁, hb₁], +end + +lemma sq_mul_squarefree (n : ℕ) : ∃ a b : ℕ, b ^ 2 * a = n ∧ squarefree a := +begin + cases n, + { exact ⟨1, 0, (by simp), squarefree_one⟩ }, + { obtain ⟨a, b, -, -, h₁, h₂⟩ := sq_mul_squarefree_of_pos (succ_pos n), + exact ⟨a, b, h₁, h₂⟩ }, +end + +/-- `squarefree` is multiplicative. Note that the → direction does not require `hmn` +and generalizes to arbitrary commutative monoids. See `squarefree.of_mul_left` and +`squarefree.of_mul_right` above for auxiliary lemmas. -/ +lemma squarefree_mul {m n : ℕ} (hmn : m.coprime n) : + squarefree (m * n) ↔ squarefree m ∧ squarefree n := +begin + simp only [squarefree_iff_prime_squarefree, ←sq, ←forall_and_distrib], + refine ball_congr (λ p hp, _), + simp only [hmn.is_prime_pow_dvd_mul (hp.is_prime_pow.pow two_ne_zero), not_or_distrib], +end + +end nat + +/-! ### Square-free prover -/ + +open norm_num + +namespace tactic +namespace norm_num + +/-- A predicate representing partial progress in a proof of `squarefree`. -/ +def squarefree_helper (n k : ℕ) : Prop := +0 < k → (∀ m, nat.prime m → m ∣ bit1 n → bit1 k ≤ m) → squarefree (bit1 n) + +lemma squarefree_bit10 (n : ℕ) (h : squarefree_helper n 1) : + squarefree (bit0 (bit1 n)) := +begin + refine @nat.min_sq_fac_prop_div _ _ nat.prime_two two_dvd_bit0 _ none _, + { rw [bit0_eq_two_mul (bit1 n), mul_dvd_mul_iff_left (two_ne_zero' ℕ)], + exact nat.not_two_dvd_bit1 _ }, + { rw [bit0_eq_two_mul, nat.mul_div_right _ (dec_trivial:0<2)], + refine h dec_trivial (λ p pp dp, nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)), + rintro rfl, exact nat.not_two_dvd_bit1 _ dp } +end + +lemma squarefree_bit1 (n : ℕ) (h : squarefree_helper n 1) : + squarefree (bit1 n) := +begin + refine h dec_trivial (λ p pp dp, nat.succ_le_of_lt (lt_of_le_of_ne pp.two_le _)), + rintro rfl, exact nat.not_two_dvd_bit1 _ dp +end + +lemma squarefree_helper_0 {k} (k0 : 0 < k) + {p : ℕ} (pp : nat.prime p) (h : bit1 k ≤ p) : bit1 (k + 1) ≤ p ∨ bit1 k = p := +begin + rcases lt_or_eq_of_le h with (hp:_+1≤_) | hp, + { rw [bit1, bit0_eq_two_mul] at hp, change 2*(_+1) ≤ _ at hp, + rw [bit1, bit0_eq_two_mul], + refine or.inl (lt_of_le_of_ne hp _), unfreezingI { rintro rfl }, + exact nat.not_prime_mul dec_trivial (lt_add_of_pos_left _ k0) pp }, + { exact or.inr hp } +end + +lemma squarefree_helper_1 (n k k' : ℕ) (e : k + 1 = k') + (hk : nat.prime (bit1 k) → ¬ bit1 k ∣ bit1 n) + (H : squarefree_helper n k') : squarefree_helper n k := +λ k0 ih, begin + subst e, + refine H (nat.succ_pos _) (λ p pp dp, _), + refine (squarefree_helper_0 k0 pp (ih p pp dp)).resolve_right (λ hp, _), + subst hp, cases hk pp dp +end + +lemma squarefree_helper_2 (n k k' c : ℕ) (e : k + 1 = k') + (hc : bit1 n % bit1 k = c) (c0 : 0 < c) + (h : squarefree_helper n k') : squarefree_helper n k := +begin + refine squarefree_helper_1 _ _ _ e (λ _, _) h, + refine mt _ (ne_of_gt c0), intro e₁, + rwa [← hc, ← nat.dvd_iff_mod_eq_zero], +end + +lemma squarefree_helper_3 (n n' k k' c : ℕ) (e : k + 1 = k') + (hn' : bit1 n' * bit1 k = bit1 n) + (hc : bit1 n' % bit1 k = c) (c0 : 0 < c) + (H : squarefree_helper n' k') : squarefree_helper n k := +λ k0 ih, begin + subst e, + have k0' : 0 < bit1 k := bit1_pos (nat.zero_le _), + have dn' : bit1 n' ∣ bit1 n := ⟨_, hn'.symm⟩, + have dk : bit1 k ∣ bit1 n := ⟨_, ((mul_comm _ _).trans hn').symm⟩, + have : bit1 n / bit1 k = bit1 n', + { rw [← hn', nat.mul_div_cancel _ k0'] }, + have k2 : 2 ≤ bit1 k := nat.succ_le_succ (bit0_pos k0), + have pk : (bit1 k).prime, + { refine nat.prime_def_min_fac.2 ⟨k2, le_antisymm (nat.min_fac_le k0') _⟩, + exact ih _ (nat.min_fac_prime (ne_of_gt k2)) (dvd_trans (nat.min_fac_dvd _) dk) }, + have dkk' : ¬ bit1 k ∣ bit1 n', {rw [nat.dvd_iff_mod_eq_zero, hc], exact ne_of_gt c0}, + have dkk : ¬ bit1 k * bit1 k ∣ bit1 n, {rwa [← nat.dvd_div_iff dk, this]}, + refine @nat.min_sq_fac_prop_div _ _ pk dk dkk none _, + rw this, refine H (nat.succ_pos _) (λ p pp dp, _), + refine (squarefree_helper_0 k0 pp (ih p pp $ dvd_trans dp dn')).resolve_right (λ e, _), + subst e, contradiction +end + +lemma squarefree_helper_4 (n k k' : ℕ) (e : bit1 k * bit1 k = k') + (hd : bit1 n < k') : squarefree_helper n k := +begin + cases nat.eq_zero_or_pos n with h h, + { subst n, exact λ _ _, squarefree_one }, + subst e, + refine λ k0 ih, irreducible.squarefree (nat.prime_def_le_sqrt.2 ⟨bit1_lt_bit1.2 h, _⟩), + intros m m2 hm md, + obtain ⟨p, pp, hp⟩ := nat.exists_prime_and_dvd (ne_of_gt m2), + have := (ih p pp (dvd_trans hp md)).trans + (le_trans (nat.le_of_dvd (lt_of_lt_of_le dec_trivial m2) hp) hm), + rw nat.le_sqrt at this, + exact not_le_of_lt hd this +end + +lemma not_squarefree_mul (a aa b n : ℕ) (ha : a * a = aa) (hb : aa * b = n) + (h₁ : 1 < a) : ¬ squarefree n := +by { rw [← hb, ← ha], exact λ H, ne_of_gt h₁ (nat.is_unit_iff.1 $ H _ ⟨_, rfl⟩) } + +/-- Given `e` a natural numeral and `a : nat` with `a^2 ∣ n`, return `⊢ ¬ squarefree e`. -/ +meta def prove_non_squarefree (e : expr) (n a : ℕ) : tactic expr := do + let ea := reflect a, + let eaa := reflect (a*a), + c ← mk_instance_cache `(nat), + (c, p₁) ← prove_lt_nat c `(1) ea, + let b := n / (a*a), let eb := reflect b, + (c, eaa, pa) ← prove_mul_nat c ea ea, + (c, e', pb) ← prove_mul_nat c eaa eb, + guard (e' =ₐ e), + return $ `(@not_squarefree_mul).mk_app [ea, eaa, eb, e, pa, pb, p₁] + +/-- Given `en`,`en1 := bit1 en`, `n1` the value of `en1`, `ek`, + returns `⊢ squarefree_helper en ek`. -/ +meta def prove_squarefree_aux : ∀ (ic : instance_cache) (en en1 : expr) (n1 : ℕ) + (ek : expr) (k : ℕ), tactic expr +| ic en en1 n1 ek k := do + let k1 := bit1 k, + let ek1 := `(bit1:ℕ→ℕ).mk_app [ek], + if n1 < k1*k1 then do + (ic, ek', p₁) ← prove_mul_nat ic ek1 ek1, + (ic, p₂) ← prove_lt_nat ic en1 ek', + pure $ `(squarefree_helper_4).mk_app [en, ek, ek', p₁, p₂] + else do + let c := n1 % k1, + let k' := k+1, let ek' := reflect k', + (ic, p₁) ← prove_succ ic ek ek', + if c = 0 then do + let n1' := n1 / k1, + let n' := n1' / 2, let en' := reflect n', + let en1' := `(bit1:ℕ→ℕ).mk_app [en'], + (ic, _, pn') ← prove_mul_nat ic en1' ek1, + let c := n1' % k1, + guard (c ≠ 0), + (ic, ec, pc) ← prove_div_mod ic en1' ek1 tt, + (ic, p₀) ← prove_pos ic ec, + p₂ ← prove_squarefree_aux ic en' en1' n1' ek' k', + pure $ `(squarefree_helper_3).mk_app [en, en', ek, ek', ec, p₁, pn', pc, p₀, p₂] + else do + (ic, ec, pc) ← prove_div_mod ic en1 ek1 tt, + (ic, p₀) ← prove_pos ic ec, + p₂ ← prove_squarefree_aux ic en en1 n1 ek' k', + pure $ `(squarefree_helper_2).mk_app [en, ek, ek', ec, p₁, pc, p₀, p₂] + +/-- Given `n > 0` a squarefree natural numeral, returns `⊢ squarefree n`. -/ +meta def prove_squarefree (en : expr) (n : ℕ) : tactic expr := +match match_numeral en with +| match_numeral_result.one := pure `(@squarefree_one ℕ _) +| match_numeral_result.bit0 en1 := match match_numeral en1 with + | match_numeral_result.one := pure `(nat.squarefree_two) + | match_numeral_result.bit1 en := do + ic ← mk_instance_cache `(ℕ), + p ← prove_squarefree_aux ic en en1 (n / 2) `(1:ℕ) 1, + pure $ `(squarefree_bit10).mk_app [en, p] + | _ := failed + end +| match_numeral_result.bit1 en' := do + ic ← mk_instance_cache `(ℕ), + p ← prove_squarefree_aux ic en' en n `(1:ℕ) 1, + pure $ `(squarefree_bit1).mk_app [en', p] +| _ := failed +end + +/-- Evaluates the `squarefree` predicate on naturals. -/ +@[norm_num] meta def eval_squarefree : expr → tactic (expr × expr) +| `(@squarefree ℕ %%inst %%e) := do + is_def_eq inst `(nat.monoid), + n ← e.to_nat, + match n with + | 0 := false_intro `(@not_squarefree_zero ℕ _ _) + | 1 := true_intro `(@squarefree_one ℕ _) + | _ := match n.min_sq_fac with + | some d := prove_non_squarefree e n d >>= false_intro + | none := prove_squarefree e n >>= true_intro + end + end +| _ := failed + +end norm_num +end tactic diff --git a/src/data/nat/succ_pred.lean b/src/data/nat/succ_pred.lean index 47ef60b006391..676901cd3b4b4 100644 --- a/src/data/nat/succ_pred.lean +++ b/src/data/nat/succ_pred.lean @@ -3,11 +3,15 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ +import data.fin.basic import order.succ_pred.basic /-! # Successors and predecessors of naturals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we show that `ℕ` is both an archimedean `succ_order` and an archimedean `pred_order`. -/ diff --git a/src/data/nat/totient.lean b/src/data/nat/totient.lean index 0896597ca2290..bd601d3273d33 100644 --- a/src/data/nat/totient.lean +++ b/src/data/nat/totient.lean @@ -3,16 +3,17 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes -/ -import algebra.big_operators.basic -import data.nat.prime -import data.zmod.basic -import ring_theory.multiplicity -import data.nat.periodic import algebra.char_p.two +import data.nat.factorization.basic +import data.nat.periodic +import data.zmod.basic /-! # Euler's totient function +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines [Euler's totient function](https://en.wikipedia.org/wiki/Euler's_totient_function) `nat.totient n` which counts the number of naturals less than `n` that are coprime with `n`. We prove the divisor sum formula, namely that `n` equals `φ` summed over the divisors of `n`. See @@ -29,7 +30,7 @@ namespace nat coprime with `n`. -/ def totient (n : ℕ) : ℕ := ((range n).filter n.coprime).card -localized "notation `φ` := nat.totient" in nat +localized "notation (name := nat.totient) `φ` := nat.totient" in nat @[simp] theorem totient_zero : φ 0 = 0 := rfl @@ -38,6 +39,17 @@ by simp [totient] lemma totient_eq_card_coprime (n : ℕ) : φ n = ((range n).filter n.coprime).card := rfl +/-- A characterisation of `nat.totient` that avoids `finset`. -/ +lemma totient_eq_card_lt_and_coprime (n : ℕ) : φ n = nat.card {m | m < n ∧ n.coprime m} := +begin + let e : {m | m < n ∧ n.coprime m} ≃ finset.filter n.coprime (finset.range n) := + { to_fun := λ m, ⟨m, by simpa only [finset.mem_filter, finset.mem_range] using m.property⟩, + inv_fun := λ m, ⟨m, by simpa only [finset.mem_filter, finset.mem_range] using m.property⟩, + left_inv := λ m, by simp only [subtype.coe_mk, subtype.coe_eta], + right_inv := λ m, by simp only [subtype.coe_mk, subtype.coe_eta] }, + rw [totient_eq_card_coprime, card_congr e, card_eq_fintype_card, fintype.card_coe], +end + lemma totient_le (n : ℕ) : φ n ≤ n := ((range n).card_filter_le _).trans_eq (card_range n) @@ -91,27 +103,22 @@ open zmod /-- Note this takes an explicit `fintype ((zmod n)ˣ)` argument to avoid trouble with instance diamonds. -/ -@[simp] lemma _root_.zmod.card_units_eq_totient (n : ℕ) [fact (0 < n)] [fintype ((zmod n)ˣ)] : +@[simp] lemma _root_.zmod.card_units_eq_totient (n : ℕ) [ne_zero n] [fintype ((zmod n)ˣ)] : fintype.card ((zmod n)ˣ) = φ n := calc fintype.card ((zmod n)ˣ) = fintype.card {x : zmod n // x.val.coprime n} : fintype.card_congr zmod.units_equiv_coprime ... = φ n : begin - apply finset.card_congr (λ (a : {x : zmod n // x.val.coprime n}) _, a.1.val), - { intro a, simp [(a : zmod n).val_lt, a.prop.symm] {contextual := tt} }, - { intros _ _ _ _ h, rw subtype.ext_iff_val, apply val_injective, exact h, }, - { intros b hb, - rw [finset.mem_filter, finset.mem_range] at hb, - refine ⟨⟨b, _⟩, finset.mem_univ _, _⟩, - { let u := unit_of_coprime b hb.2.symm, - exact val_coe_unit_coprime u }, - { show zmod.val (b : zmod n) = b, - rw [val_nat_cast, nat.mod_eq_of_lt hb.1], } } + unfreezingI { obtain ⟨m, rfl⟩ : ∃ m, n = m + 1 := exists_eq_succ_of_ne_zero ne_zero.out }, + simp only [totient, finset.card_eq_sum_ones, fintype.card_subtype, finset.sum_filter, + ← fin.sum_univ_eq_sum_range, @nat.coprime_comm (m + 1)], + refl end lemma totient_even {n : ℕ} (hn : 2 < n) : even n.totient := begin haveI : fact (1 < n) := ⟨one_lt_two.trans hn⟩, + haveI : ne_zero n := ne_zero.of_gt hn, suffices : 2 = order_of (-1 : (zmod n)ˣ), { rw [← zmod.card_units_eq_totient, even_iff_two_dvd, this], exact order_of_dvd_card_univ }, rw [←order_of_units, units.coe_neg_one, order_of_neg_one, ring_char.eq (zmod n) n, if_neg hn.ne'], @@ -123,61 +130,53 @@ if hmn0 : m * n = 0 simp only [totient_zero, mul_zero, zero_mul, h] else begin - haveI : fact (0 < (m * n)) := ⟨nat.pos_of_ne_zero hmn0⟩, - haveI : fact (0 < m) := ⟨nat.pos_of_ne_zero $ left_ne_zero_of_mul hmn0⟩, - haveI : fact (0 < n) := ⟨nat.pos_of_ne_zero $ right_ne_zero_of_mul hmn0⟩, + haveI : ne_zero (m * n) := ⟨hmn0⟩, + haveI : ne_zero m := ⟨left_ne_zero_of_mul hmn0⟩, + haveI : ne_zero n := ⟨right_ne_zero_of_mul hmn0⟩, simp only [← zmod.card_units_eq_totient], rw [fintype.card_congr (units.map_equiv (zmod.chinese_remainder h).to_mul_equiv).to_equiv, fintype.card_congr (@mul_equiv.prod_units (zmod m) (zmod n) _ _).to_equiv, fintype.card_prod] end -lemma sum_totient (n : ℕ) : ∑ m in (range n.succ).filter (∣ n), φ m = n := -if hn0 : n = 0 then by simp [hn0] -else -calc ∑ m in (range n.succ).filter (∣ n), φ m - = ∑ d in (range n.succ).filter (∣ n), ((range (n / d)).filter (λ m, gcd (n / d) m = 1)).card : - eq.symm $ sum_bij (λ d _, n / d) - (λ d hd, mem_filter.2 ⟨mem_range.2 $ lt_succ_of_le $ nat.div_le_self _ _, - by conv {to_rhs, rw ← nat.mul_div_cancel' (mem_filter.1 hd).2}; simp⟩) - (λ _ _, rfl) - (λ a b ha hb h, - have ha : a * (n / a) = n, from nat.mul_div_cancel' (mem_filter.1 ha).2, - have 0 < (n / a), from nat.pos_of_ne_zero (λ h, by simp [*, lt_irrefl] at *), - by rw [← nat.mul_left_inj this, ha, h, nat.mul_div_cancel' (mem_filter.1 hb).2]) - (λ b hb, - have hb : b < n.succ ∧ b ∣ n, by simpa [-range_succ] using hb, - have hbn : (n / b) ∣ n, from ⟨b, by rw nat.div_mul_cancel hb.2⟩, - have hnb0 : (n / b) ≠ 0, from λ h, by simpa [h, ne.symm hn0] using nat.div_mul_cancel hbn, - ⟨n / b, mem_filter.2 ⟨mem_range.2 $ lt_succ_of_le $ nat.div_le_self _ _, hbn⟩, - by rw [← nat.mul_left_inj (nat.pos_of_ne_zero hnb0), - nat.mul_div_cancel' hb.2, nat.div_mul_cancel hbn]⟩) -... = ∑ d in (range n.succ).filter (∣ n), ((range n).filter (λ m, gcd n m = d)).card : - sum_congr rfl (λ d hd, - have hd : d ∣ n, from (mem_filter.1 hd).2, - have hd0 : 0 < d, from nat.pos_of_ne_zero (λ h, hn0 (eq_zero_of_zero_dvd $ h ▸ hd)), - card_congr (λ m hm, d * m) - (λ m hm, have hm : m < n / d ∧ gcd (n / d) m = 1, by simpa using hm, - mem_filter.2 ⟨mem_range.2 $ nat.mul_div_cancel' hd ▸ - (mul_lt_mul_left hd0).2 hm.1, - by rw [← nat.mul_div_cancel' hd, gcd_mul_left, hm.2, mul_one]⟩) - (λ a b ha hb h, (nat.mul_right_inj hd0).1 h) - (λ b hb, have hb : b < n ∧ gcd n b = d, by simpa using hb, - ⟨b / d, mem_filter.2 ⟨mem_range.2 - ((mul_lt_mul_left (show 0 < d, from hb.2 ▸ hb.2.symm ▸ hd0)).1 - (by rw [← hb.2, nat.mul_div_cancel' (gcd_dvd_left _ _), - nat.mul_div_cancel' (gcd_dvd_right _ _)]; exact hb.1)), - hb.2 ▸ coprime_div_gcd_div_gcd (hb.2.symm ▸ hd0)⟩, - hb.2 ▸ nat.mul_div_cancel' (gcd_dvd_right _ _)⟩)) -... = ((filter (∣ n) (range n.succ)).bUnion (λ d, (range n).filter (λ m, gcd n m = d))).card : - (card_bUnion (by intros; apply disjoint_filter.2; cc)).symm -... = (range n).card : - congr_arg card (finset.ext (λ m, ⟨by simp, - λ hm, have h : m < n, from mem_range.1 hm, - mem_bUnion.2 ⟨gcd n m, mem_filter.2 - ⟨mem_range.2 (lt_succ_of_le (le_of_dvd (lt_of_le_of_lt (zero_le _) h) - (gcd_dvd_left _ _))), gcd_dvd_left _ _⟩, mem_filter.2 ⟨hm, rfl⟩⟩⟩)) -... = n : card_range _ +/-- For `d ∣ n`, the totient of `n/d` equals the number of values `k < n` such that `gcd n k = d` -/ +lemma totient_div_of_dvd {n d : ℕ} (hnd : d ∣ n) : + φ (n/d) = (filter (λ (k : ℕ), n.gcd k = d) (range n)).card := +begin + rcases d.eq_zero_or_pos with rfl | hd0, { simp [eq_zero_of_zero_dvd hnd] }, + rcases hnd with ⟨x, rfl⟩, + rw nat.mul_div_cancel_left x hd0, + apply finset.card_congr (λ k _, d * k), + { simp only [mem_filter, mem_range, and_imp, coprime], + refine λ a ha1 ha2, ⟨(mul_lt_mul_left hd0).2 ha1, _⟩, + rw [gcd_mul_left, ha2, mul_one] }, + { simp [hd0.ne'] }, + { simp only [mem_filter, mem_range, exists_prop, and_imp], + refine λ b hb1 hb2, _, + have : d ∣ b, { rw ←hb2, apply gcd_dvd_right }, + rcases this with ⟨q, rfl⟩, + refine ⟨q, ⟨⟨(mul_lt_mul_left hd0).1 hb1, _⟩, rfl⟩⟩, + rwa [gcd_mul_left, mul_right_eq_self_iff hd0] at hb2 }, +end + +lemma sum_totient (n : ℕ) : n.divisors.sum φ = n := +begin + rcases n.eq_zero_or_pos with rfl | hn, { simp }, + rw ←sum_div_divisors n φ, + have : n = ∑ (d : ℕ) in n.divisors, (filter (λ (k : ℕ), n.gcd k = d) (range n)).card, + { nth_rewrite_lhs 0 ←card_range n, + refine card_eq_sum_card_fiberwise (λ x hx, mem_divisors.2 ⟨_, hn.ne'⟩), + apply gcd_dvd_left }, + nth_rewrite_rhs 0 this, + exact sum_congr rfl (λ x hx, totient_div_of_dvd (dvd_of_mem_divisors hx)), +end + +lemma sum_totient' (n : ℕ) : ∑ m in (range n.succ).filter (∣ n), φ m = n := +begin + convert sum_totient _ using 1, + simp only [nat.divisors, sum_filter, range_eq_Ico], + rw sum_eq_sum_Ico_succ_bot; simp +end /-- When `p` is prime, then the totient of `p ^ (n + 1)` is `p ^ n * (p - 1)` -/ lemma totient_prime_pow_succ {p : ℕ} (hp : p.prime) (n : ℕ) : @@ -200,8 +199,8 @@ calc φ (p ^ (n + 1)) exact h b (lt_of_mul_lt_mul_left ha (zero_le _)) (mul_comm _ _) } end ... = _ : -have h1 : set.inj_on (* p) (range (p ^ n)), - from λ x _ y _, (nat.mul_left_inj hp.pos).1, +have h1 : function.injective (* p), + from mul_left_injective₀ hp.ne_zero, have h2 : (range (p ^ n)).image (* p) ⊆ range (p ^ (n + 1)), from λ a, begin simp only [mem_image, mem_range, exists_imp_distrib], @@ -210,7 +209,7 @@ have h2 : (range (p ^ n)).image (* p) ⊆ range (p ^ (n + 1)), exact (mul_lt_mul_right hp.pos).2 h end, begin - rw [card_sdiff h2, card_image_of_inj_on h1, card_range, + rw [card_sdiff h2, card_image_of_inj_on (h1.inj_on _), card_range, card_range, ← one_mul (p ^ n), pow_succ, ← tsub_mul, one_mul, mul_comm] end @@ -224,21 +223,6 @@ by rcases exists_eq_succ_of_ne_zero (pos_iff_ne_zero.1 hn) with ⟨m, rfl⟩; lemma totient_prime {p : ℕ} (hp : p.prime) : φ p = p - 1 := by rw [← pow_one p, totient_prime_pow hp]; simp -lemma totient_mul_of_prime_of_dvd {p n : ℕ} (hp : p.prime) (h : p ∣ n) : - (p * n).totient = p * n.totient := -begin - by_cases hzero : n = 0, - { simp [hzero] }, - { have hfin := (multiplicity.finite_nat_iff.2 ⟨hp.ne_one, zero_lt_iff.2 hzero⟩), - have h0 : 0 < (multiplicity p n).get hfin := multiplicity.pos_of_dvd hfin h, - obtain ⟨m, hm, hndiv⟩ := multiplicity.exists_eq_pow_mul_and_not_dvd hfin, - rw [hm, ← mul_assoc, ← pow_succ, nat.totient_mul (coprime_comm.mp (hp.coprime_pow_of_not_dvd - hndiv)), nat.totient_mul (coprime_comm.mp (hp.coprime_pow_of_not_dvd hndiv)), ← mul_assoc], - congr, - rw [ ← succ_pred_eq_of_pos h0, totient_prime_pow_succ hp, totient_prime_pow_succ hp, - succ_pred_eq_of_pos h0, ← mul_assoc p, ← pow_succ, ← succ_pred_eq_of_pos h0, nat.pred_succ] } -end - lemma totient_eq_iff_prime {p : ℕ} (hp : 0 < p) : p.totient = p - 1 ↔ p.prime := begin refine ⟨λ h, _, totient_prime⟩, @@ -257,7 +241,7 @@ end lemma card_units_zmod_lt_sub_one {p : ℕ} (hp : 1 < p) [fintype ((zmod p)ˣ)] : fintype.card ((zmod p)ˣ) ≤ p - 1 := begin - haveI : fact (0 < p) := ⟨zero_lt_one.trans hp⟩, + haveI : ne_zero p := ⟨(pos_of_gt hp).ne'⟩, rw zmod.card_units_eq_totient p, exact nat.le_pred_of_lt (nat.totient_lt p hp), end @@ -265,14 +249,13 @@ end lemma prime_iff_card_units (p : ℕ) [fintype ((zmod p)ˣ)] : p.prime ↔ fintype.card ((zmod p)ˣ) = p - 1 := begin - by_cases hp : p = 0, + casesI eq_zero_or_ne_zero p with hp hp, { substI hp, simp only [zmod, not_prime_zero, false_iff, zero_tsub], -- the substI created an non-defeq but subsingleton instance diamond; resolve it suffices : fintype.card ℤˣ ≠ 0, { convert this }, simp }, - haveI : fact (0 < p) := ⟨nat.pos_of_ne_zero hp⟩, - rw [zmod.card_units_eq_totient, nat.totient_eq_iff_prime (fact.out (0 < p))], + rw [zmod.card_units_eq_totient, nat.totient_eq_iff_prime $ ne_zero.pos p], end @[simp] lemma totient_two : φ 2 = 1 := @@ -335,11 +318,64 @@ begin { rw [←cast_prod, cast_ne_zero, ←zero_lt_iff, ←prod_factorization_eq_prod_factors], exact prod_pos (λ p hp, pos_of_mem_factorization hp) }, simp only [totient_eq_div_factors_mul n, prod_prime_factors_dvd n, cast_mul, cast_prod, - cast_div_char_zero, mul_comm_div', mul_right_inj' hn', div_eq_iff hpQ, ←prod_mul_distrib], + cast_div_char_zero, mul_comm_div, mul_right_inj' hn', div_eq_iff hpQ, ←prod_mul_distrib], refine prod_congr rfl (λ p hp, _), have hp := pos_of_mem_factors (list.mem_to_finset.mp hp), have hp' : (p : ℚ) ≠ 0 := cast_ne_zero.mpr hp.ne.symm, rw [sub_mul, one_mul, mul_comm, mul_inv_cancel hp', cast_pred hp], end +lemma totient_gcd_mul_totient_mul (a b : ℕ) : φ (a.gcd b) * φ (a * b) = φ a * φ b * (a.gcd b) := +begin + have shuffle : ∀ a1 a2 b1 b2 c1 c2 : ℕ, b1 ∣ a1 → b2 ∣ a2 → + (a1/b1 * c1) * (a2/b2 * c2) = (a1*a2)/(b1*b2) * (c1*c2), + { intros a1 a2 b1 b2 c1 c2 h1 h2, + calc + (a1/b1 * c1) * (a2/b2 * c2) = ((a1/b1) * (a2/b2)) * (c1*c2) : by apply mul_mul_mul_comm + ... = (a1*a2)/(b1*b2) * (c1*c2) : by { congr' 1, exact div_mul_div_comm h1 h2 } }, + simp only [totient_eq_div_factors_mul], + rw [shuffle, shuffle], + rotate, repeat { apply prod_prime_factors_dvd }, + { simp only [prod_factors_gcd_mul_prod_factors_mul], + rw [eq_comm, mul_comm, ←mul_assoc, ←nat.mul_div_assoc], + exact mul_dvd_mul (prod_prime_factors_dvd a) (prod_prime_factors_dvd b) } +end + +lemma totient_super_multiplicative (a b : ℕ) : φ a * φ b ≤ φ (a * b) := +begin + let d := a.gcd b, + rcases (zero_le a).eq_or_lt with rfl | ha0, { simp }, + have hd0 : 0 < d, from nat.gcd_pos_of_pos_left _ ha0, + rw [←mul_le_mul_right hd0, ←totient_gcd_mul_totient_mul a b, mul_comm], + apply mul_le_mul_left' (nat.totient_le d), +end + +lemma totient_dvd_of_dvd {a b : ℕ} (h : a ∣ b) : φ a ∣ φ b := +begin + rcases eq_or_ne a 0 with rfl | ha0, { simp [zero_dvd_iff.1 h] }, + rcases eq_or_ne b 0 with rfl | hb0, { simp }, + have hab' : a.factorization.support ⊆ b.factorization.support, + { intro p, + simp only [support_factorization, list.mem_to_finset], + apply factors_subset_of_dvd h hb0 }, + rw [totient_eq_prod_factorization ha0, totient_eq_prod_factorization hb0], + refine finsupp.prod_dvd_prod_of_subset_of_dvd hab' (λ p hp, mul_dvd_mul _ dvd_rfl), + exact pow_dvd_pow p (tsub_le_tsub_right ((factorization_le_iff_dvd ha0 hb0).2 h p) 1), +end + +lemma totient_mul_of_prime_of_dvd {p n : ℕ} (hp : p.prime) (h : p ∣ n) : + (p * n).totient = p * n.totient := +begin + have h1 := totient_gcd_mul_totient_mul p n, + rw [(gcd_eq_left h), mul_assoc] at h1, + simpa [(totient_pos hp.pos).ne', mul_comm] using h1, +end + +lemma totient_mul_of_prime_of_not_dvd {p n : ℕ} (hp : p.prime) (h : ¬ p ∣ n) : + (p * n).totient = (p - 1) * n.totient := +begin + rw [totient_mul _, totient_prime hp], + simpa [h] using coprime_or_dvd_of_prime hp n, +end + end nat diff --git a/src/data/nat/units.lean b/src/data/nat/units.lean new file mode 100644 index 0000000000000..5b2818a4c7816 --- /dev/null +++ b/src/data/nat/units.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2014 Floris van Doorn (c) 2016 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Floris van Doorn, Leonardo de Moura, Jeremy Avigad, Mario Carneiro +-/ +import data.nat.basic +import algebra.group.units + +/-! # The units of the natural numbers as a `monoid` and `add_monoid` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4.-/ + +namespace nat + +theorem units_eq_one (u : ℕˣ) : u = 1 := +units.ext $ nat.eq_one_of_dvd_one ⟨u.inv, u.val_inv.symm⟩ + +theorem add_units_eq_zero (u : add_units ℕ) : u = 0 := +add_units.ext $ (nat.eq_zero_of_add_eq_zero u.val_neg).1 + +@[simp] protected theorem is_unit_iff {n : ℕ} : is_unit n ↔ n = 1 := +iff.intro + (λ ⟨u, hu⟩, match n, u, hu, nat.units_eq_one u with _, _, rfl, rfl := rfl end) + (λ h, h.symm ▸ ⟨1, rfl⟩) + +instance unique_units : unique ℕˣ := +{ default := 1, uniq := nat.units_eq_one } + +instance unique_add_units : unique (add_units ℕ) := +{ default := 0, uniq := nat.add_units_eq_zero } + +end nat diff --git a/src/data/nat/upto.lean b/src/data/nat/upto.lean index 13391db98aa32..b25775774a18e 100644 --- a/src/data/nat/upto.lean +++ b/src/data/nat/upto.lean @@ -3,11 +3,14 @@ Copyright (c) 2020 Simon Hudon. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon -/ -import data.nat.basic +import data.nat.order.basic /-! # `nat.upto` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + `nat.upto p`, with `p` a predicate on `ℕ`, is a subtype of elements `n : ℕ` such that no value (strictly) below `n` satisfies `p`. diff --git a/src/data/nat/with_bot.lean b/src/data/nat/with_bot.lean index 46172cf2b3647..cf242a21faec8 100644 --- a/src/data/nat/with_bot.lean +++ b/src/data/nat/with_bot.lean @@ -3,42 +3,64 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes -/ -import data.nat.basic -import algebra.order.group +import data.nat.order.basic +import algebra.order.monoid.with_top + /-! # `with_bot ℕ` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Lemmas about the type of natural numbers with a bottom element adjoined. -/ + namespace nat -lemma with_bot.add_eq_zero_iff : ∀ {n m : with_bot ℕ}, n + m = 0 ↔ n = 0 ∧ m = 0 -| none m := iff_of_false dec_trivial (λ h, absurd h.1 dec_trivial) -| n none := iff_of_false (by cases n; exact dec_trivial) - (λ h, absurd h.2 dec_trivial) -| (some n) (some m) := show (n + m : with_bot ℕ) = (0 : ℕ) ↔ (n : with_bot ℕ) = (0 : ℕ) ∧ - (m : with_bot ℕ) = (0 : ℕ), - by rw [← with_bot.coe_add, with_bot.coe_eq_coe, with_bot.coe_eq_coe, - with_bot.coe_eq_coe, add_eq_zero_iff' (nat.zero_le _) (nat.zero_le _)] - -lemma with_bot.add_eq_one_iff : ∀ {n m : with_bot ℕ}, n + m = 1 ↔ (n = 0 ∧ m = 1) ∨ (n = 1 ∧ m = 0) -| none none := dec_trivial -| none (some m) := dec_trivial -| (some n) none := iff_of_false dec_trivial (λ h, h.elim (λ h, absurd h.2 dec_trivial) - (λ h, absurd h.2 dec_trivial)) -| (some n) (some 0) := by erw [with_bot.coe_eq_coe, with_bot.coe_eq_coe, with_bot.coe_eq_coe, - with_bot.coe_eq_coe]; simp -| (some n) (some (m + 1)) := by erw [with_bot.coe_eq_coe, with_bot.coe_eq_coe, with_bot.coe_eq_coe, - with_bot.coe_eq_coe, with_bot.coe_eq_coe]; simp [nat.add_succ, nat.succ_inj', nat.succ_ne_zero] - -@[simp] lemma with_bot.coe_nonneg {n : ℕ} : 0 ≤ (n : with_bot ℕ) := -by rw [← with_bot.coe_zero, with_bot.coe_le_coe]; exact nat.zero_le _ - -@[simp] lemma with_bot.lt_zero_iff (n : with_bot ℕ) : n < 0 ↔ n = ⊥ := -option.cases_on n dec_trivial (λ n, iff_of_false - (by simp [with_bot.some_eq_coe]) (λ h, option.no_confusion h)) - -lemma with_bot.one_le_iff_zero_lt {x : with_bot ℕ} : 1 ≤ x ↔ 0 < x := +namespace with_bot + +lemma add_eq_zero_iff {n m : with_bot ℕ} : n + m = 0 ↔ n = 0 ∧ m = 0 := +begin + rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩, + any_goals { tautology }, + repeat { erw [with_bot.coe_eq_coe] }, + exact add_eq_zero_iff +end + +lemma add_eq_one_iff {n m : with_bot ℕ} : n + m = 1 ↔ n = 0 ∧ m = 1 ∨ n = 1 ∧ m = 0 := +begin + rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩, + any_goals { tautology }, + repeat { erw [with_bot.coe_eq_coe] }, + exact add_eq_one_iff +end + +lemma add_eq_two_iff {n m : with_bot ℕ} : + n + m = 2 ↔ n = 0 ∧ m = 2 ∨ n = 1 ∧ m = 1 ∨ n = 2 ∧ m = 0 := +begin + rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩, + any_goals { tautology }, + repeat { erw [with_bot.coe_eq_coe] }, + exact add_eq_two_iff +end + +lemma add_eq_three_iff {n m : with_bot ℕ} : + n + m = 3 ↔ n = 0 ∧ m = 3 ∨ n = 1 ∧ m = 2 ∨ n = 2 ∧ m = 1 ∨ n = 3 ∧ m = 0 := +begin + rcases ⟨n, m⟩ with ⟨_ | _, _ | _⟩, + any_goals { tautology }, + repeat { erw [with_bot.coe_eq_coe] }, + exact add_eq_three_iff +end + +lemma coe_nonneg {n : ℕ} : 0 ≤ (n : with_bot ℕ) := +by { rw [← with_bot.coe_zero, with_bot.coe_le_coe], exact nat.zero_le _ } + +@[simp] lemma lt_zero_iff (n : with_bot ℕ) : n < 0 ↔ n = ⊥ := +option.cases_on n dec_trivial $ λ n, iff_of_false + (by simp [with_bot.some_eq_coe, coe_nonneg]) (λ h, option.no_confusion h) + +lemma one_le_iff_zero_lt {x : with_bot ℕ} : 1 ≤ x ↔ 0 < x := begin refine ⟨λ h, lt_of_lt_of_le (with_bot.coe_lt_coe.mpr zero_lt_one) h, λ h, _⟩, induction x using with_bot.rec_bot_coe, @@ -46,7 +68,15 @@ begin { exact with_bot.coe_le_coe.mpr (nat.succ_le_iff.mpr (with_bot.coe_lt_coe.mp h)) } end -lemma with_bot.lt_one_iff_le_zero {x : with_bot ℕ} : x < 1 ↔ x ≤ 0 := -not_iff_not.mp (by simpa using with_bot.one_le_iff_zero_lt) +lemma lt_one_iff_le_zero {x : with_bot ℕ} : x < 1 ↔ x ≤ 0 := +not_iff_not.mp (by simpa using one_le_iff_zero_lt) + +lemma add_one_le_of_lt {n m : with_bot ℕ} (h : n < m) : n + 1 ≤ m := +begin + cases n, { exact bot_le }, + cases m, exacts [(not_lt_bot h).elim, with_bot.some_le_some.2 (with_bot.some_lt_some.1 h)], +end + +end with_bot end nat diff --git a/src/data/num/basic.lean b/src/data/num/basic.lean index 884bc8eb4b8aa..91816b9d58233 100644 --- a/src/data/num/basic.lean +++ b/src/data/num/basic.lean @@ -7,6 +7,9 @@ Authors: Leonardo de Moura, Mario Carneiro /-! # Binary representation of integers using inductive types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Note: Unlike in Coq, where this representation is preferred because of the reliance on kernel reduction, in Lean this representation is discouraged in favor of the "Peano" natural numbers `nat`, and the purpose of this diff --git a/src/data/num/bitwise.lean b/src/data/num/bitwise.lean index 7f3d7c9324e8f..4ea3eb1ed0eb4 100644 --- a/src/data/num/bitwise.lean +++ b/src/data/num/bitwise.lean @@ -9,6 +9,9 @@ import data.bitvec.core /-! # Bitwise operations using binary representation of integers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Definitions * bitwise operations for `pos_num` and `num`, @@ -193,7 +196,7 @@ The `snum` representation uses a bit string, essentially a list of 0 (`ff`) and and the negation of the MSB is sign-extended to all higher bits. -/ namespace nzsnum - notation a :: b := bit a b + notation (name := nznum.bit) a :: b := bit a b /-- Sign of a `nzsnum`. -/ def sign : nzsnum → bool @@ -237,14 +240,14 @@ namespace snum @[pattern] def not : snum → snum | (zero z) := zero (bnot z) | (nz p) := ~p - prefix ~ := not + prefix (name := snum.not) ~ := not /-- Add a bit at the end of a `snum`. This mimics `nzsnum.bit`. -/ @[pattern] def bit : bool → snum → snum | b (zero z) := if b = z then zero b else msb b | b (nz p) := p.bit b - notation a :: b := bit a b + notation (name := snum.bit) a :: b := bit a b /-- Add an inactive bit at the end of a `snum`. This mimics `znum.bit0`. -/ def bit0 : snum → snum := bit ff @@ -339,7 +342,7 @@ protected def add (a b : snum) : snum := cadd a b ff instance : has_add snum := ⟨snum.add⟩ -/-- Substract two `snum`s. -/ +/-- subtract two `snum`s. -/ protected def sub (a b : snum) : snum := a + -b instance : has_sub snum := ⟨snum.sub⟩ diff --git a/src/data/num/lemmas.lean b/src/data/num/lemmas.lean index f212e34464e38..0829d392077b4 100644 --- a/src/data/num/lemmas.lean +++ b/src/data/num/lemmas.lean @@ -5,11 +5,15 @@ Authors: Mario Carneiro -/ import data.num.bitwise import data.int.char_zero -import data.nat.gcd +import data.nat.gcd.basic import data.nat.psub +import data.nat.size /-! # Properties of the binary representation of integers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. -/ local attribute [simp] add_assoc @@ -25,16 +29,16 @@ variables {α : Type*} @[simp, norm_cast] theorem cast_bit1 [has_one α] [has_add α] (n : pos_num) : (n.bit1 : α) = _root_.bit1 n := rfl -@[simp, norm_cast] theorem cast_to_nat [add_monoid α] [has_one α] : +@[simp, norm_cast] theorem cast_to_nat [add_monoid_with_one α] : ∀ n : pos_num, ((n : ℕ) : α) = n | 1 := nat.cast_one | (bit0 p) := (nat.cast_bit0 _).trans $ congr_arg _root_.bit0 p.cast_to_nat | (bit1 p) := (nat.cast_bit1 _).trans $ congr_arg _root_.bit1 p.cast_to_nat @[simp, norm_cast] theorem to_nat_to_int (n : pos_num) : ((n : ℕ) : ℤ) = n := -by rw [← int.nat_cast_eq_coe_nat, cast_to_nat] +cast_to_nat _ -@[simp, norm_cast] theorem cast_to_int [add_group α] [has_one α] (n : pos_num) : +@[simp, norm_cast] theorem cast_to_int [add_group_with_one α] (n : pos_num) : ((n : ℤ) : α) = n := by rw [← to_nat_to_int, int.cast_coe_nat, cast_to_nat] @@ -160,11 +164,6 @@ theorem add_succ : ∀ (m n : num), m + succ n = succ (m + n) by rw [pos_num.add_one, add_zero]; refl | (pos p) (pos q) := congr_arg pos (pos_num.add_succ _ _) -@[simp, norm_cast] theorem add_of_nat (m) : ∀ n, ((m + n : ℕ) : num) = m + n -| 0 := (add_zero _).symm -| (n+1) := show ((m + n : ℕ) + 1 : num) = m + (↑ n + 1), - by rw [add_one, add_one, add_succ, add_of_nat] - theorem bit0_of_bit0 : ∀ n : num, bit0 n = n.bit0 | 0 := rfl | (pos p) := congr_arg pos p.bit0_of_bit0 @@ -173,6 +172,33 @@ theorem bit1_of_bit1 : ∀ n : num, bit1 n = n.bit1 | 0 := rfl | (pos p) := congr_arg pos p.bit1_of_bit1 +@[simp] lemma of_nat'_zero : num.of_nat' 0 = 0 := +by simp [num.of_nat'] + +lemma of_nat'_bit (b n) : of_nat' (nat.bit b n) = cond b num.bit1 num.bit0 (of_nat' n) := +nat.binary_rec_eq rfl _ _ + +@[simp] lemma of_nat'_one : num.of_nat' 1 = 1 := +by erw [of_nat'_bit tt 0, cond, of_nat'_zero]; refl + +lemma bit1_succ : ∀ n : num, n.bit1.succ = n.succ.bit0 +| 0 := rfl +| (pos n) := rfl + +lemma of_nat'_succ : ∀ {n}, of_nat' (n + 1) = of_nat' n + 1 := +nat.binary_rec (by simp; refl) $ λ b n ih, +begin + cases b, + { erw [of_nat'_bit tt n, of_nat'_bit], + simp only [← bit1_of_bit1, ← bit0_of_bit0, cond, _root_.bit1] }, + { erw [show n.bit tt + 1 = (n + 1).bit ff, by simp [nat.bit, _root_.bit1, _root_.bit0]; cc, + of_nat'_bit, of_nat'_bit, ih], + simp only [cond, add_one, bit1_succ], }, +end + +@[simp] theorem add_of_nat' (m n) : num.of_nat' (m + n) = num.of_nat' m + num.of_nat' n := +by induction n; simp [nat.add_zero, of_nat'_succ, add_zero, nat.add_succ, add_one, add_succ, *] + @[simp, norm_cast] theorem cast_zero [has_zero α] [has_one α] [has_add α] : ((0 : num) : α) = 0 := rfl @@ -191,28 +217,10 @@ theorem succ'_to_nat : ∀ n, (succ' n : ℕ) = n + 1 theorem succ_to_nat (n) : (succ n : ℕ) = n + 1 := succ'_to_nat n -@[simp, norm_cast] theorem cast_to_nat [add_monoid α] [has_one α] : ∀ n : num, ((n : ℕ) : α) = n +@[simp, norm_cast] theorem cast_to_nat [add_monoid_with_one α] : ∀ n : num, ((n : ℕ) : α) = n | 0 := nat.cast_zero | (pos p) := p.cast_to_nat -@[simp, norm_cast] theorem to_nat_to_int (n : num) : ((n : ℕ) : ℤ) = n := -by rw [← int.nat_cast_eq_coe_nat, cast_to_nat] - -@[simp, norm_cast] theorem cast_to_int [add_group α] [has_one α] (n : num) : ((n : ℤ) : α) = n := -by rw [← to_nat_to_int, int.cast_coe_nat, cast_to_nat] - -@[norm_cast] -theorem to_of_nat : Π (n : ℕ), ((n : num) : ℕ) = n -| 0 := rfl -| (n+1) := by rw [nat.cast_add_one, add_one, succ_to_nat, to_of_nat] - -@[simp, norm_cast] -theorem of_nat_cast [add_monoid α] [has_one α] (n : ℕ) : ((n : num) : α) = n := -by rw [← cast_to_nat, to_of_nat] - -@[norm_cast] theorem of_nat_inj {m n : ℕ} : (m : num) = n ↔ m = n := -⟨λ h, function.left_inverse.injective to_of_nat h, congr_arg _⟩ - @[norm_cast] theorem add_to_nat : ∀ m n, ((m + n : num) : ℕ) = m + n | 0 0 := rfl @@ -251,26 +259,21 @@ by rw ← not_lt; exact not_congr lt_to_nat end num namespace pos_num -@[simp] theorem of_to_nat : Π (n : pos_num), ((n : ℕ) : num) = num.pos n -| 1 := rfl -| (bit0 p) := - show ↑(p + p : ℕ) = num.pos p.bit0, - by rw [num.add_of_nat, of_to_nat]; - exact congr_arg num.pos p.bit0_of_bit0 -| (bit1 p) := - show ((p + p : ℕ) : num) + 1 = num.pos p.bit1, - by rw [num.add_of_nat, of_to_nat]; - exact congr_arg num.pos p.bit1_of_bit1 + +@[simp] theorem of_to_nat' : Π (n : pos_num), num.of_nat' (n : ℕ) = num.pos n +| 1 := by erw [@num.of_nat'_bit tt 0, num.of_nat'_zero]; refl +| (bit0 p) := by erw [@num.of_nat'_bit ff, of_to_nat']; refl +| (bit1 p) := by erw [@num.of_nat'_bit tt, of_to_nat']; refl end pos_num namespace num -@[simp, norm_cast] theorem of_to_nat : Π (n : num), ((n : ℕ) : num) = n -| 0 := rfl -| (pos p) := p.of_to_nat +@[simp, norm_cast] theorem of_to_nat' : Π (n : num), num.of_nat' (n : ℕ) = n +| 0 := of_nat'_zero +| (pos p) := p.of_to_nat' @[norm_cast] theorem to_nat_inj {m n : num} : (m : ℕ) = n ↔ m = n := -⟨λ h, function.left_inverse.injective of_to_nat h, congr_arg _⟩ +⟨λ h, function.left_inverse.injective of_to_nat' h, congr_arg _⟩ /-- This tactic tries to turn an (in)equality about `num`s to one about `nat`s by rewriting. @@ -295,21 +298,33 @@ example (n : num) (m : num) : n ≤ n + m := by num.transfer -/ meta def transfer : tactic unit := `[intros, transfer_rw, try {simp}] -instance : comm_semiring num := -by refine_struct -{ add := (+), - zero := 0, +instance : add_monoid num := +{ add := (+), + zero := 0, zero_add := zero_add, add_zero := add_zero, - mul := (*), - one := 1, - nsmul := @nsmul_rec num ⟨0⟩ ⟨(+)⟩, - npow := @npow_rec num ⟨1⟩ ⟨(*)⟩ }; -try { intros, refl }; try { transfer }; simp [mul_add, mul_left_comm, mul_comm, add_comm] + add_assoc := by transfer } + +instance : add_monoid_with_one num := +{ nat_cast := num.of_nat', + one := 1, + nat_cast_zero := of_nat'_zero, + nat_cast_succ := λ _, of_nat'_succ, + .. num.add_monoid } + +instance : comm_semiring num := +by refine_struct +{ mul := (*), + one := 1, + add := (+), + zero := 0, + npow := @npow_rec num ⟨1⟩ ⟨(*)⟩, + .. num.add_monoid, .. num.add_monoid_with_one }; +try { intros, refl }; try { transfer }; +simp [add_comm, mul_add, add_mul, mul_assoc, mul_comm, mul_left_comm] instance : ordered_cancel_add_comm_monoid num := -{ add_left_cancel := by {intros a b c, transfer_rw, apply add_left_cancel}, - lt := (<), +{ lt := (<), lt_iff_le_not_le := by {intros a b, transfer_rw, apply lt_iff_le_not_le}, le := (≤), le_refl := by transfer, @@ -331,6 +346,28 @@ instance : linear_ordered_semiring num := exists_pair_ne := ⟨0, 1, dec_trivial⟩, ..num.comm_semiring, ..num.ordered_cancel_add_comm_monoid } +@[simp, norm_cast] theorem add_of_nat (m n) : ((m + n : ℕ) : num) = m + n := +add_of_nat' _ _ + +@[simp, norm_cast] theorem to_nat_to_int (n : num) : ((n : ℕ) : ℤ) = n := +cast_to_nat _ + +@[simp, norm_cast] theorem cast_to_int {α} [add_group_with_one α] (n : num) : ((n : ℤ) : α) = n := +by rw [← to_nat_to_int, int.cast_coe_nat, cast_to_nat] + +theorem to_of_nat : Π (n : ℕ), ((n : num) : ℕ) = n +| 0 := by rw [nat.cast_zero, cast_zero] +| (n+1) := by rw [nat.cast_succ, add_one, succ_to_nat, to_of_nat] + +@[simp, norm_cast] +theorem of_nat_cast {α} [add_monoid_with_one α] (n : ℕ) : ((n : num) : α) = n := +by rw [← cast_to_nat, to_of_nat] + +@[simp, norm_cast] theorem of_nat_inj {m n : ℕ} : (m : num) = n ↔ m = n := +⟨λ h, function.left_inverse.injective to_of_nat h, congr_arg _⟩ + +@[simp, norm_cast] theorem of_to_nat : Π (n : num), ((n : ℕ) : num) = n := of_to_nat' + @[norm_cast] theorem dvd_to_nat (m n : num) : (m : ℕ) ∣ n ↔ m ∣ n := ⟨λ ⟨k, e⟩, ⟨k, by rw [← of_to_nat n, e]; simp⟩, @@ -342,6 +379,8 @@ namespace pos_num variables {α : Type*} open num +@[simp, norm_cast] theorem of_to_nat : Π (n : pos_num), ((n : ℕ) : num) = num.pos n := of_to_nat' + @[norm_cast] theorem to_nat_inj {m n : pos_num} : (m : ℕ) = n ↔ m = n := ⟨λ h, num.pos.inj $ by rw [← pos_num.of_to_nat, ← pos_num.of_to_nat, h], congr_arg _⟩ @@ -444,15 +483,15 @@ theorem bit_to_nat (b n) : (bit b n : ℕ) = nat.bit b n := by cases b; refl @[simp, norm_cast] -theorem cast_add [add_monoid α] [has_one α] (m n) : ((m + n : pos_num) : α) = m + n := +theorem cast_add [add_monoid_with_one α] (m n) : ((m + n : pos_num) : α) = m + n := by rw [← cast_to_nat, add_to_nat, nat.cast_add, cast_to_nat, cast_to_nat] @[simp, norm_cast, priority 500] -theorem cast_succ [add_monoid α] [has_one α] (n : pos_num) : (succ n : α) = n + 1 := +theorem cast_succ [add_monoid_with_one α] (n : pos_num) : (succ n : α) = n + 1 := by rw [← add_one, cast_add, cast_one] @[simp, norm_cast] -theorem cast_inj [add_monoid α] [has_one α] [char_zero α] {m n : pos_num} : (m:α) = n ↔ m = n := +theorem cast_inj [add_monoid_with_one α] [char_zero α] {m n : pos_num} : (m:α) = n ↔ m = n := by rw [← cast_to_nat m, ← cast_to_nat n, nat.cast_inj, to_nat_inj] @[simp] @@ -492,10 +531,10 @@ open pos_num theorem bit_to_nat (b n) : (bit b n : ℕ) = nat.bit b n := by cases b; cases n; refl -theorem cast_succ' [add_monoid α] [has_one α] (n) : (succ' n : α) = n + 1 := +theorem cast_succ' [add_monoid_with_one α] (n) : (succ' n : α) = n + 1 := by rw [← pos_num.cast_to_nat, succ'_to_nat, nat.cast_add_one, cast_to_nat] -theorem cast_succ [add_monoid α] [has_one α] (n) : (succ n : α) = n + 1 := cast_succ' n +theorem cast_succ [add_monoid_with_one α] (n) : (succ n : α) = n + 1 := cast_succ' n @[simp, norm_cast] theorem cast_add [semiring α] (m n) : ((m + n : num) : α) = m + n := by rw [← cast_to_nat, add_to_nat, nat.cast_add, cast_to_nat, cast_to_nat] @@ -523,9 +562,6 @@ theorem size_eq_nat_size : ∀ n, (size n : ℕ) = nat_size n theorem nat_size_to_nat (n) : nat_size n = nat.size n := by rw [← size_eq_nat_size, size_to_nat] -@[simp] theorem of_nat'_zero : num.of_nat' 0 = 0 := -by simp [num.of_nat'] - @[simp, priority 999] theorem of_nat'_eq : ∀ n, num.of_nat' n = n := nat.binary_rec (by simp) $ λ b n IH, begin rw of_nat' at IH ⊢, @@ -767,11 +803,6 @@ by cases n; try {refl}; rw [succ, num.zneg_to_znum_neg]; refl theorem zneg_pred (n : znum) : -n.pred = (-n).succ := by rw [← zneg_zneg (succ (-n)), zneg_succ, zneg_zneg] -@[simp, norm_cast] theorem neg_of_int : ∀ n, ((-n : ℤ) : znum) = -n -| (n+1:ℕ) := rfl -| 0 := rfl -| -[1+n] := (zneg_zneg _).symm - @[simp] theorem abs_to_nat : ∀ n, (abs n : ℕ) = int.nat_abs n | 0 := rfl | (pos p) := congr_arg int.nat_abs p.to_nat_to_int @@ -782,8 +813,8 @@ by rw [← zneg_zneg (succ (-n)), zneg_succ, zneg_zneg] | 0 := rfl | (num.pos p) := rfl -@[simp, norm_cast] theorem cast_to_int [add_group α] [has_one α] : ∀ n : znum, ((n : ℤ) : α) = n -| 0 := rfl +@[simp, norm_cast] theorem cast_to_int [add_group_with_one α] : ∀ n : znum, ((n : ℤ) : α) = n +| 0 := by rw [cast_zero, cast_zero, int.cast_zero] | (pos p) := by rw [cast_pos, cast_pos, pos_num.cast_to_int] | (neg p) := by rw [cast_neg, cast_neg, int.cast_neg, pos_num.cast_to_int] @@ -798,14 +829,14 @@ theorem bit1_of_bit1 : ∀ n : znum, _root_.bit1 n = n.bit1 | (neg a) := show pos_num.sub' 1 (_root_.bit0 a) = _, by rw [pos_num.one_sub', a.bit0_of_bit0]; refl -@[simp, norm_cast] theorem cast_bit0 [add_group α] [has_one α] : +@[simp, norm_cast] theorem cast_bit0 [add_group_with_one α] : ∀ n : znum, (n.bit0 : α) = bit0 n | 0 := (add_zero _).symm | (pos p) := by rw [znum.bit0, cast_pos, cast_pos]; refl | (neg p) := by rw [znum.bit0, cast_neg, cast_neg, pos_num.cast_bit0, _root_.bit0, _root_.bit0, neg_add_rev] -@[simp, norm_cast] theorem cast_bit1 [add_group α] [has_one α] : +@[simp, norm_cast] theorem cast_bit1 [add_group_with_one α] : ∀ n : znum, (n.bit1 : α) = bit1 n | 0 := by simp [znum.bit1, _root_.bit1, _root_.bit0] | (pos p) := by rw [znum.bit1, cast_pos, cast_pos]; refl @@ -821,7 +852,7 @@ theorem bit1_of_bit1 : ∀ n : znum, _root_.bit1 n = n.bit1 simpa [_root_.bit1, _root_.bit0, -add_comm] }, end -@[simp] theorem cast_bitm1 [add_group α] [has_one α] +@[simp] theorem cast_bitm1 [add_group_with_one α] (n : znum) : (n.bitm1 : α) = bit0 n - 1 := begin conv { to_lhs, rw ← zneg_zneg n }, @@ -850,7 +881,7 @@ theorem cast_to_znum : ∀ n : pos_num, (n : znum) = znum.pos n local attribute [-simp] int.add_neg_one -theorem cast_sub' [add_group α] [has_one α] : ∀ m n : pos_num, (sub' m n : α) = m - n +theorem cast_sub' [add_group_with_one α] : ∀ m n : pos_num, (sub' m n : α) = m - n | a 1 := by rw [sub'_one, num.cast_to_znum, ← num.cast_to_nat, pred'_to_nat, ← nat.sub_one]; simp [pos_num.cast_pos] @@ -891,19 +922,36 @@ end pos_num namespace num variables {α : Type*} -@[simp] theorem cast_sub' [add_group α] [has_one α] : ∀ m n : num, (sub' m n : α) = m - n +@[simp] theorem cast_sub' [add_group_with_one α] : ∀ m n : num, (sub' m n : α) = m - n | 0 0 := (sub_zero _).symm | (pos a) 0 := (sub_zero _).symm | 0 (pos b) := (zero_sub _).symm | (pos a) (pos b) := pos_num.cast_sub' _ _ -@[simp] theorem of_nat_to_znum : ∀ n : ℕ, to_znum n = n -| 0 := rfl -| (n+1) := by rw [nat.cast_add_one, nat.cast_add_one, - znum.add_one, add_one, ← of_nat_to_znum]; cases (n:num); refl +theorem to_znum_succ : ∀ n : num, n.succ.to_znum = n.to_znum.succ +| 0 := rfl +| (pos n) := rfl -@[simp] theorem of_nat_to_znum_neg (n : ℕ) : to_znum_neg n = -n := -by rw [← of_nat_to_znum, zneg_to_znum] +theorem to_znum_neg_succ : ∀ n : num, n.succ.to_znum_neg = n.to_znum_neg.pred +| 0 := rfl +| (pos n) := rfl + +@[simp] theorem pred_succ : ∀ n : znum, n.pred.succ = n +| 0 := rfl +| (znum.neg p) := show to_znum_neg (pos p).succ'.pred' = _, by rw [pos_num.pred'_succ']; refl +| (znum.pos p) := by rw [znum.pred, ← to_znum_succ, num.succ, pos_num.succ'_pred', to_znum] + +theorem succ_of_int' : ∀ n, znum.of_int' (n + 1) = znum.of_int' n + 1 +| (n : ℕ) := by erw [znum.of_int', znum.of_int', num.of_nat'_succ, + num.add_one, to_znum_succ, znum.add_one] +| -[1+ 0] := by erw [znum.of_int', znum.of_int', of_nat'_succ, of_nat'_zero]; refl +| -[1+ n+1] := by erw [znum.of_int', znum.of_int', @num.of_nat'_succ (n+1), num.add_one, + to_znum_neg_succ, @of_nat'_succ n, num.add_one, znum.add_one, pred_succ] + +theorem of_int'_to_znum : ∀ n : ℕ, to_znum n = znum.of_int' n +| 0 := rfl +| (n+1) := by rw [nat.cast_succ, num.add_one, to_znum_succ, of_int'_to_znum, nat.cast_succ, + succ_of_int', znum.add_one] theorem mem_of_znum' : ∀ {m : num} {n : znum}, m ∈ of_znum' n ↔ n = to_znum m | 0 0 := ⟨λ _, rfl, λ _, rfl⟩ @@ -924,7 +972,7 @@ theorem of_znum'_to_nat : ∀ (n : znum), coe <$> of_znum' n = int.to_nat' n | (znum.neg p) := congr_arg (λ x, int.to_nat (-x)) $ show ((p.pred' + 1 : ℕ) : ℤ) = p, by rw ← succ'_to_nat; simp -@[simp] theorem cast_of_znum [add_group α] [has_one α] (n : znum) : +@[simp] theorem cast_of_znum [add_group_with_one α] (n : znum) : (of_znum n : α) = int.to_nat n := by rw [← cast_to_nat, of_znum_to_nat] @@ -937,7 +985,7 @@ end num namespace znum variables {α : Type*} -@[simp, norm_cast] theorem cast_add [add_group α] [has_one α] : ∀ m n, ((m + n : znum) : α) = m + n +@[simp, norm_cast] theorem cast_add [add_group_with_one α] : ∀ m n, ((m + n : znum) : α) = m + n | 0 a := by cases a; exact (_root_.zero_add _).symm | b 0 := by cases b; exact (_root_.add_zero _).symm | (pos a) (pos b) := pos_num.cast_add _ _ @@ -946,11 +994,11 @@ variables {α : Type*} have (↑b + -↑a : α) = -↑a + ↑b, by rw [← pos_num.cast_to_int a, ← pos_num.cast_to_int b, ← int.cast_neg, ← int.cast_add (-a)]; simp [add_comm], (pos_num.cast_sub' _ _).trans $ (sub_eq_add_neg _ _).trans this -| (neg a) (neg b) := show -(↑(a + b) : α) = -a + -b, by rw [ - pos_num.cast_add, neg_eq_iff_neg_eq, neg_add_rev, neg_neg, neg_neg, - ← pos_num.cast_to_int a, ← pos_num.cast_to_int b, ← int.cast_add]; simp [add_comm] +| (neg a) (neg b) := show -(↑(a + b) : α) = -a + -b, by rw [ + pos_num.cast_add, neg_eq_iff_eq_neg, neg_add_rev, neg_neg, neg_neg, + ← pos_num.cast_to_int a, ← pos_num.cast_to_int b, ← int.cast_add, ← int.cast_add, add_comm] -@[simp] theorem cast_succ [add_group α] [has_one α] (n) : ((succ n : znum) : α) = n + 1 := +@[simp] theorem cast_succ [add_group_with_one α] (n) : ((succ n : znum) : α) = n + 1 := by rw [← add_one, cast_add, cast_one] @[simp, norm_cast] theorem mul_to_int : ∀ m n, ((m * n : znum) : ℤ) = m * n @@ -964,35 +1012,19 @@ by rw [← add_one, cast_add, cast_one] theorem cast_mul [ring α] (m n) : ((m * n : znum) : α) = m * n := by rw [← cast_to_int, mul_to_int, int.cast_mul, cast_to_int, cast_to_int] -@[simp, norm_cast] theorem of_to_int : Π (n : znum), ((n : ℤ) : znum) = n -| 0 := rfl -| (pos a) := by rw [cast_pos, ← pos_num.cast_to_nat, - int.cast_coe_nat', ← num.of_nat_to_znum, pos_num.of_to_nat]; refl -| (neg a) := by rw [cast_neg, neg_of_int, ← pos_num.cast_to_nat, - int.cast_coe_nat', ← num.of_nat_to_znum_neg, pos_num.of_to_nat]; refl +theorem of_int'_neg : ∀ n : ℤ, of_int' (-n) = -of_int' n +| -[1+ n] := show of_int' (n + 1 : ℕ) = _, by simp only [of_int', num.zneg_to_znum_neg] +| 0 := show num.to_znum _ = -num.to_znum _, by rw [num.of_nat'_zero]; refl +| (n+1 : ℕ) := show num.to_znum_neg _ = -num.to_znum _, by rw [num.zneg_to_znum]; refl -@[norm_cast] -theorem to_of_int : Π (n : ℤ), ((n : znum) : ℤ) = n -| (n : ℕ) := by rw [int.cast_coe_nat, - ← num.of_nat_to_znum, num.cast_to_znum, ← num.cast_to_nat, - int.nat_cast_eq_coe_nat, num.to_of_nat] -| -[1+ n] := by rw [int.cast_neg_succ_of_nat, cast_zneg, - add_one, cast_succ, int.neg_succ_of_nat_eq, - ← num.of_nat_to_znum, num.cast_to_znum, ← num.cast_to_nat, - int.nat_cast_eq_coe_nat, num.to_of_nat] +theorem of_to_int' : ∀ (n : znum), znum.of_int' n = n +| 0 := by erw [of_int', num.of_nat'_zero, num.to_znum] +| (pos a) := by rw [cast_pos, ← pos_num.cast_to_nat, ← num.of_int'_to_znum, pos_num.of_to_nat]; refl +| (neg a) := by rw [cast_neg, of_int'_neg, ← pos_num.cast_to_nat, ← num.of_int'_to_znum, + pos_num.of_to_nat]; refl theorem to_int_inj {m n : znum} : (m : ℤ) = n ↔ m = n := -⟨λ h, function.left_inverse.injective of_to_int h, congr_arg _⟩ - -@[simp, norm_cast] theorem of_int_cast [add_group α] [has_one α] (n : ℤ) : ((n : znum) : α) = n := -by rw [← cast_to_int, to_of_int] - -@[simp, norm_cast] theorem of_nat_cast [add_group α] [has_one α] (n : ℕ) : ((n : znum) : α) = n := -of_int_cast n - -@[simp] theorem of_int'_eq : ∀ n, znum.of_int' n = n -| (n : ℕ) := to_int_inj.1 $ by simp [znum.of_int'] -| -[1+ n] := to_int_inj.1 $ by simp [znum.of_int'] +⟨λ h, function.left_inverse.injective of_to_int' h, congr_arg _⟩ theorem cmp_to_int : ∀ (m n), (ordering.cases_on (cmp m n) ((m:ℤ) < n) (m = n) ((n:ℤ) < m) : Prop) | 0 0 := rfl @@ -1087,6 +1119,14 @@ instance : add_comm_group znum := neg := has_neg.neg, add_left_neg := by transfer } +instance : add_monoid_with_one znum := +{ one := 1, + nat_cast := λ n, znum.of_int' n, + nat_cast_zero := show (num.of_nat' 0).to_znum = 0, by rw num.of_nat'_zero; refl, + nat_cast_succ := λ n, show (num.of_nat' (n+1)).to_znum = (num.of_nat' n).to_znum + 1, + by rw [num.of_nat'_succ, num.add_one, num.to_znum_succ, znum.add_one], + .. znum.add_comm_group } + instance : linear_ordered_comm_ring znum := { mul := (*), mul_assoc := by transfer, @@ -1100,7 +1140,41 @@ instance : linear_ordered_comm_ring znum := add_le_add_left := by {intros a b h c, revert h, transfer_rw, exact λ h, add_le_add_left h c}, mul_pos := λ a b, show 0 < a → 0 < b → 0 < a * b, by {transfer_rw, apply mul_pos}, zero_le_one := dec_trivial, - ..znum.linear_order, ..znum.add_comm_group } + ..znum.linear_order, ..znum.add_comm_group, ..znum.add_monoid_with_one } + +@[simp, norm_cast] theorem cast_sub [ring α] (m n) : ((m - n : znum) : α) = m - n := +by simp [sub_eq_neg_add] + +@[simp, norm_cast] theorem neg_of_int : ∀ n, ((-n : ℤ) : znum) = -n +| (n+1:ℕ) := rfl +| 0 := by rw [int.cast_neg, int.cast_zero] +| -[1+n] := (zneg_zneg _).symm + +@[simp] theorem of_int'_eq : ∀ n : ℤ, znum.of_int' n = n +| (n : ℕ) := rfl +| -[1+ n] := begin + show num.to_znum_neg (n+1 : ℕ) = -(n+1 : ℕ), + rw [← neg_inj, neg_neg, nat.cast_succ, num.add_one, num.zneg_to_znum_neg, num.to_znum_succ, + nat.cast_succ, znum.add_one], + refl +end + +@[simp] theorem of_nat_to_znum (n : ℕ) : num.to_znum n = n := rfl + +@[simp, norm_cast] theorem of_to_int (n : znum) : ((n : ℤ) : znum) = n := +by rw [← of_int'_eq, of_to_int'] + +theorem to_of_int (n : ℤ) : ((n : znum) : ℤ) = n := +int.induction_on' n 0 (by simp) (by simp) (by simp) + +@[simp] theorem of_nat_to_znum_neg (n : ℕ) : num.to_znum_neg n = -n := +by rw [← of_nat_to_znum, num.zneg_to_znum] + +@[simp, norm_cast] theorem of_int_cast [add_group_with_one α] (n : ℤ) : ((n : znum) : α) = n := +by rw [← cast_to_int, to_of_int] + +@[simp, norm_cast] theorem of_nat_cast [add_group_with_one α] (n : ℕ) : ((n : znum) : α) = n := +by rw [← int.cast_coe_nat, of_int_cast, int.cast_coe_nat] @[simp, norm_cast] theorem dvd_to_int (m n : znum) : (m : ℤ) ∣ n ↔ m ∣ n := ⟨λ ⟨k, e⟩, ⟨k, by rw [← of_to_int n, e]; simp⟩, @@ -1149,7 +1223,7 @@ begin cases divmod d n with q r, simp only [divmod] at IH ⊢, apply divmod_to_nat_aux; simp, { rw [_root_.bit1, _root_.bit1, add_right_comm, - bit0_eq_two_mul ↑n, ← IH.1, + bit0_eq_two_mul (n : ℕ), ← IH.1, mul_add, ← bit0_eq_two_mul, mul_left_comm, ← bit0_eq_two_mul] }, { rw ← bit0_eq_two_mul, @@ -1157,7 +1231,7 @@ begin { unfold divmod, cases divmod d n with q r, simp only [divmod] at IH ⊢, apply divmod_to_nat_aux; simp, - { rw [bit0_eq_two_mul ↑n, ← IH.1, + { rw [bit0_eq_two_mul (n : ℕ), ← IH.1, mul_add, ← bit0_eq_two_mul, mul_left_comm, ← bit0_eq_two_mul] }, { rw ← bit0_eq_two_mul, @@ -1212,7 +1286,7 @@ theorem gcd_to_nat_aux : ∀ {n} {a b : num}, refine add_le_add_left (nat.mul_le_mul_left _ (le_trans (le_of_lt (nat.mod_lt _ (pos_num.cast_pos _))) _)) _, suffices : 1 ≤ _, simpa using nat.mul_le_mul_left (pos a) this, - rw [nat.le_div_iff_mul_le _ _ a.cast_pos, one_mul], + rw [nat.le_div_iff_mul_le a.cast_pos, one_mul], exact le_to_nat.2 ab end diff --git a/src/data/num/prime.lean b/src/data/num/prime.lean index 08ee6312966d1..f996feac90da0 100644 --- a/src/data/num/prime.lean +++ b/src/data/num/prime.lean @@ -10,6 +10,9 @@ import tactic.ring /-! # Primality for binary natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines versions of `nat.min_fac` and `nat.prime` for `num` and `pos_num`. As with other `num` definitions, they are not intended for general use (`nat` should be used instead of `num` in most cases) but they can be used in contexts where kernel computation is required, such as proofs diff --git a/src/data/opposite.lean b/src/data/opposite.lean index 356e4876a73d8..f74f353803b89 100644 --- a/src/data/opposite.lean +++ b/src/data/opposite.lean @@ -3,11 +3,14 @@ Copyright (c) 2018 Scott Morrison. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Scott Morrison, Reid Barton, Simon Hudon, Kenny Lau -/ -import logic.equiv.basic +import logic.equiv.defs /-! # Opposites +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define a type synonym `opposite α := α`, denoted by `αᵒᵖ` and two synonyms for the identity map, `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`. If `α` is a category, then `αᵒᵖ` is the opposite category, with all arrows reversed. @@ -58,14 +61,16 @@ def unop : αᵒᵖ → α := id lemma op_injective : function.injective (op : α → αᵒᵖ) := λ _ _, id lemma unop_injective : function.injective (unop : αᵒᵖ → α) := λ _ _, id -@[simp] lemma op_inj_iff (x y : α) : op x = op y ↔ x = y := iff.rfl -@[simp] lemma unop_inj_iff (x y : αᵒᵖ) : unop x = unop y ↔ x = y := iff.rfl - @[simp] lemma op_unop (x : αᵒᵖ) : op (unop x) = x := rfl @[simp] lemma unop_op (x : α) : unop (op x) = x := rfl attribute [irreducible] opposite +-- We could prove these by `iff.rfl`, but that would make these eligible for `dsimp`. That would be +-- a bad idea because `opposite` is irreducible. +@[simp] lemma op_inj_iff (x y : α) : op x = op y ↔ x = y := op_injective.eq_iff +@[simp] lemma unop_inj_iff (x y : αᵒᵖ) : unop x = unop y ↔ x = y := unop_injective.eq_iff + /-- The type-level equivalence between a type and its opposite. -/ def equiv_to_opposite : α ≃ αᵒᵖ := { to_fun := op, diff --git a/src/data/option/basic.lean b/src/data/option/basic.lean index a126f5365a51b..84e4edeb92f0f 100644 --- a/src/data/option/basic.lean +++ b/src/data/option/basic.lean @@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import logic.is_empty +import control.traversable.basic import tactic.basic -import logic.relator /-! # Option of a type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file develops the basic theory of option types. If `α` is a type, then `option α` can be understood as the type with one more element than `α`. @@ -32,11 +35,13 @@ along with a term `a : α` if the value is `true`. -/ namespace option -variables {α : Type*} {β : Type*} {γ : Type*} +variables {α β γ δ : Type*} lemma coe_def : (coe : α → option α) = some := rfl +lemma some_eq_coe (a : α) : some a = a := rfl lemma some_ne_none (x : α) : some x ≠ none := λ h, option.no_confusion h +@[simp] lemma coe_ne_none (a : α) : (a : option α) ≠ none . protected lemma «forall» {p : option α → Prop} : (∀ x, p x) ↔ p none ∧ ∀ x, p (some x) := ⟨λ h, ⟨h _, λ x, h _⟩, λ h x, option.cases_on x h.1 h.2⟩ @@ -88,6 +93,8 @@ theorem map_injective {f : α → β} (Hf : function.injective f) : function.inj | none none H := rfl | (some a₁) (some a₂) H := by rw Hf (option.some.inj H) +@[simp] theorem map_comp_some (f : α → β) : option.map f ∘ some = some ∘ f := rfl + @[ext] theorem ext : ∀ {o₁ o₂ : option α}, (∀ a, a ∈ o₁ ↔ a ∈ o₂) → o₁ = o₂ | none none H := rfl | (some a) o H := ((H _).1 rfl).symm @@ -108,6 +115,9 @@ theorem eq_none_iff_forall_not_mem {o : option α} : @[simp] theorem bind_some : ∀ x : option α, x >>= some = x := @bind_pure α option _ _ +@[simp] theorem bind_some' : ∀ x : option α, x.bind some = x := +bind_some + @[simp] theorem bind_eq_some {α β} {x : option α} {f : α → option β} {b : β} : x >>= f = some b ↔ ∃ a, x = some a ∧ f a = some b := by cases x; simp @@ -179,16 +189,29 @@ by { cases x; simp only [map_none, map_some, eq_self_iff_true] } x.map f = none ↔ x = none := by { cases x; simp only [map_none', map_some', eq_self_iff_true] } +/-- `option.map` as a function between functions is injective. -/ +theorem map_injective' : function.injective (@option.map α β) := +λ f g h, funext $ λ x, some_injective _ $ by simp only [← map_some', h] + +@[simp] theorem map_inj {f g : α → β} : option.map f = option.map g ↔ f = g := +map_injective'.eq_iff + lemma map_congr {f g : α → β} {x : option α} (h : ∀ a ∈ x, f a = g a) : option.map f x = option.map g x := by { cases x; simp only [map_none', map_some', h, mem_def] } -@[simp] theorem map_id' : option.map (@id α) = id := map_id +attribute [simp] map_id + +@[simp] theorem map_eq_id {f : α → α} : option.map f = id ↔ f = id := map_injective'.eq_iff' map_id @[simp] lemma map_map (h : β → γ) (g : α → β) (x : option α) : option.map h (option.map g x) = option.map (h ∘ g) x := by { cases x; simp only [map_none', map_some'] } +lemma map_comm {f₁ : α → β} {f₂ : α → γ} {g₁ : β → δ} {g₂ : γ → δ} (h : g₁ ∘ f₁ = g₂ ∘ f₂) (a : α) : + (option.map f₁ a).map g₁ = (option.map f₂ a).map g₂ := +by rw [map_map, h, ←map_map] + lemma comp_map (h : β → γ) (g : α → β) (x : option α) : option.map (h ∘ g) x = option.map h (option.map g x) := (map_map _ _ _).symm @@ -196,9 +219,19 @@ lemma comp_map (h : β → γ) (g : α → β) (x : option α) : option.map g ∘ option.map f = option.map (g ∘ f) := by { ext x, rw comp_map } -lemma mem_map_of_mem {α β : Type*} {a : α} {x : option α} (g : α → β) (h : a ∈ x) : g a ∈ x.map g := +lemma mem_map_of_mem {a : α} {x : option α} (g : α → β) (h : a ∈ x) : g a ∈ x.map g := mem_def.mpr ((mem_def.mp h).symm ▸ map_some') +lemma mem_map {f : α → β} {y : β} {o : option α} : y ∈ o.map f ↔ ∃ x ∈ o, f x = y := by simp + +lemma forall_mem_map {f : α → β} {o : option α} {p : β → Prop} : + (∀ y ∈ o.map f, p y) ↔ ∀ x ∈ o, p (f x) := +by simp + +lemma exists_mem_map {f : α → β} {o : option α} {p : β → Prop} : + (∃ y ∈ o.map f, p y) ↔ ∃ x ∈ o, p (f x) := +by simp + lemma bind_map_comm {α β} {x : option (option α) } {f : α → β} : x >>= option.map f = x.map (option.map f) >>= id := by { cases x; simp } @@ -382,6 +415,9 @@ theorem iget_mem [inhabited α] : ∀ {o : option α}, is_some o → o.iget ∈ theorem iget_of_mem [inhabited α] {a : α} : ∀ {o : option α}, a ∈ o → o.iget = a | _ rfl := rfl +lemma get_or_else_default_eq_iget [inhabited α] (o : option α) : o.get_or_else default = o.iget := +by cases o; refl + @[simp] theorem guard_eq_some {p : α → Prop} [decidable_pred p] {a b : α} : guard p a = some b ↔ a = b ∧ p a := by by_cases p a; simp [option.guard, h]; intro; contradiction @@ -490,11 +526,7 @@ rfl @[simp] lemma to_list_none (α : Type*) : (none : option α).to_list = [] := rfl ---TODO: Swap arguments to `option.elim` so that it is exactly `option.cons` -/-- Functions from `option` can be combined similarly to `vector.cons`. -/ -def cons (a : β) (f : α → β) : option α → β := λ o, o.elim a f - -@[simp] lemma cons_none_some (f : option α → β) : cons (f none) (f ∘ some) = f := +@[simp] lemma elim_none_some (f : option α → β) : option.elim (f none) (f ∘ some) = f := funext $ λ o, by cases o; refl end option diff --git a/src/data/option/defs.lean b/src/data/option/defs.lean index 347cf0f73a34e..535df54ee80b6 100644 --- a/src/data/option/defs.lean +++ b/src/data/option/defs.lean @@ -7,6 +7,9 @@ Authors: Mario Carneiro /-! # Extra definitions on `option` +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines more operations involving `option α`. Lemmas about them are located in other files under `data.option.`. Other basic operations on `option` are defined in the core library. @@ -18,10 +21,10 @@ variables {α : Type*} {β : Type*} attribute [inline] option.is_some option.is_none -/-- An elimination principle for `option`. It is a nondependent version of `option.rec_on`. -/ -@[simp] protected def elim : option α → β → (α → β) → β -| (some x) y f := f x -| none y f := y +/-- An elimination principle for `option`. It is a nondependent version of `option.rec`. -/ +@[simp] protected def elim (b : β) (f : α → β) : option α → β +| (some a) := f a +| none := b instance has_mem : has_mem α (option α) := ⟨λ a b, b = some a⟩ @@ -161,12 +164,12 @@ def {u v w} mmap {m : Type u → Type v} [monad m] {α : Type w} {β : Type u} ( (o : option α) : m (option β) := (o.map f).maybe /-- A monadic analogue of `option.elim`. -/ -def melim {α β : Type*} {m : Type* → Type*} [monad m] (x : m (option α)) (y : m β) (z : α → m β) : +def melim {α β : Type*} {m : Type* → Type*} [monad m] (y : m β) (z : α → m β) (x : m (option α)) : m β := -x >>= λ o, option.elim o y z +x >>= option.elim y z /-- A monadic analogue of `option.get_or_else`. -/ def mget_or_else {α : Type*} {m : Type* → Type*} [monad m] (x : m (option α)) (y : m α) : m α := -melim x y pure +melim y pure x end option diff --git a/src/data/option/n_ary.lean b/src/data/option/n_ary.lean new file mode 100644 index 0000000000000..87dc806f4a2a8 --- /dev/null +++ b/src/data/option/n_ary.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2022 Yaël Dillies. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yaël Dillies +-/ +import data.option.basic + +/-! +# Binary map of options + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the binary map of `option`. This is mostly useful to define pointwise operations +on intervals. + +## Main declarations + +* `option.map₂`: Binary map of options. + +## Notes + +This file is very similar to `data.set.n_ary`, `data.finset.n_ary` and `order.filter.n_ary`. Please +keep them in sync. + +We do not define `option.map₃` as its only purpose so far would be to prove properties of +`option.map₂` and casing already fulfills this task. +-/ + +open function + +namespace option +variables {α α' β β' γ γ' δ δ' ε ε' : Type*} {f : α → β → γ} {a : option α} {b : option β} + {c : option γ} + +/-- The image of a binary function `f : α → β → γ` as a function `option α → option β → option γ`. +Mathematically this should be thought of as the image of the corresponding function `α × β → γ`. -/ +def map₂ (f : α → β → γ) (a : option α) (b : option β) : option γ := a.bind $ λ a, b.map $ f a + +/-- `option.map₂` in terms of monadic operations. Note that this can't be taken as the definition +because of the lack of universe polymorphism. -/ +lemma map₂_def {α β γ : Type*} (f : α → β → γ) (a : option α) (b : option β) : + map₂ f a b = f <$> a <*> b := by cases a; refl + +@[simp] lemma map₂_some_some (f : α → β → γ) (a : α) (b : β) : + map₂ f (some a) (some b) = some (f a b) := +rfl + +lemma map₂_coe_coe (f : α → β → γ) (a : α) (b : β) : map₂ f a b = f a b := rfl +@[simp] lemma map₂_none_left (f : α → β → γ) (b : option β) : map₂ f none b = none := rfl +@[simp] lemma map₂_none_right (f : α → β → γ) (a : option α) : map₂ f a none = none := +by cases a; refl +@[simp] lemma map₂_coe_left (f : α → β → γ) (a : α) (b : option β) : + map₂ f a b = b.map (λ b, f a b) := rfl +@[simp] lemma map₂_coe_right (f : α → β → γ) (a : option α) (b : β) : + map₂ f a b = a.map (λ a, f a b) := rfl + +@[simp] lemma mem_map₂_iff {c : γ} : c ∈ map₂ f a b ↔ ∃ a' b', a' ∈ a ∧ b' ∈ b ∧ f a' b' = c := +by simp [map₂] + +@[simp] lemma map₂_eq_none_iff : map₂ f a b = none ↔ a = none ∨ b = none := +by cases a; cases b; simp + +lemma map₂_swap (f : α → β → γ) (a : option α) (b : option β) : + map₂ f a b = map₂ (λ a b, f b a) b a := +by cases a; cases b; refl + +lemma map_map₂ (f : α → β → γ) (g : γ → δ) : (map₂ f a b).map g = map₂ (λ a b, g (f a b)) a b := +by cases a; cases b; refl + +lemma map₂_map_left (f : γ → β → δ) (g : α → γ) : + map₂ f (a.map g) b = map₂ (λ a b, f (g a) b) a b := +by cases a; refl + +lemma map₂_map_right (f : α → γ → δ) (g : β → γ) : + map₂ f a (b.map g) = map₂ (λ a b, f a (g b)) a b := +by cases b; refl + +@[simp] lemma map₂_curry (f : α × β → γ) (a : option α) (b : option β) : + map₂ (curry f) a b = option.map f (map₂ prod.mk a b) := (map_map₂ _ _).symm + +@[simp] lemma map_uncurry (f : α → β → γ) (x : option (α × β)) : + x.map (uncurry f) = map₂ f (x.map prod.fst) (x.map prod.snd) := by cases x; refl + +/-! +### Algebraic replacement rules + +A collection of lemmas to transfer associativity, commutativity, distributivity, ... of operations +to the associativity, commutativity, distributivity, ... of `option.map₂` of those operations. +The proof pattern is `map₂_lemma operation_lemma`. For example, `map₂_comm mul_comm` proves that +`map₂ (*) a b = map₂ (*) g f` in a `comm_semigroup`. +-/ + +lemma map₂_assoc {f : δ → γ → ε} {g : α → β → δ} {f' : α → ε' → ε} {g' : β → γ → ε'} + (h_assoc : ∀ a b c, f (g a b) c = f' a (g' b c)) : + map₂ f (map₂ g a b) c = map₂ f' a (map₂ g' b c) := +by cases a; cases b; cases c; simp [h_assoc] + +lemma map₂_comm {g : β → α → γ} (h_comm : ∀ a b, f a b = g b a) : map₂ f a b = map₂ g b a := +by cases a; cases b; simp [h_comm] + +lemma map₂_left_comm {f : α → δ → ε} {g : β → γ → δ} {f' : α → γ → δ'} {g' : β → δ' → ε} + (h_left_comm : ∀ a b c, f a (g b c) = g' b (f' a c)) : + map₂ f a (map₂ g b c) = map₂ g' b (map₂ f' a c) := +by cases a; cases b; cases c; simp [h_left_comm] + +lemma map₂_right_comm {f : δ → γ → ε} {g : α → β → δ} {f' : α → γ → δ'} {g' : δ' → β → ε} + (h_right_comm : ∀ a b c, f (g a b) c = g' (f' a c) b) : + map₂ f (map₂ g a b) c = map₂ g' (map₂ f' a c) b := +by cases a; cases b; cases c; simp [h_right_comm] + +lemma map_map₂_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'} + (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) : + (map₂ f a b).map g = map₂ f' (a.map g₁) (b.map g₂) := +by cases a; cases b; simp [h_distrib] + +/-! +The following symmetric restatement are needed because unification has a hard time figuring all the +functions if you symmetrize on the spot. This is also how the other n-ary APIs do it. +-/ + +/-- Symmetric statement to `option.map₂_map_left_comm`. -/ +lemma map_map₂_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'} + (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) : + (map₂ f a b).map g = map₂ f' (a.map g') b := +by cases a; cases b; simp [h_distrib] + +/-- Symmetric statement to `option.map_map₂_right_comm`. -/ +lemma map_map₂_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'} + (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) : + (map₂ f a b).map g = map₂ f' a (b.map g') := +by cases a; cases b; simp [h_distrib] + +/-- Symmetric statement to `option.map_map₂_distrib_left`. -/ +lemma map₂_map_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ} + (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) : + map₂ f (a.map g) b = (map₂ f' a b).map g' := +by cases a; cases b; simp [h_left_comm] + +/-- Symmetric statement to `option.map_map₂_distrib_right`. -/ +lemma map_map₂_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ} + (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) : + map₂ f a (b.map g) = (map₂ f' a b).map g' := +by cases a; cases b; simp [h_right_comm] + +lemma map_map₂_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'} + (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) : + (map₂ f a b).map g = map₂ f' (b.map g₁) (a.map g₂) := +by cases a; cases b; simp [h_antidistrib] + +/-- Symmetric statement to `option.map₂_map_left_anticomm`. -/ +lemma map_map₂_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'} + (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) : + (map₂ f a b).map g = map₂ f' (b.map g') a := +by cases a; cases b; simp [h_antidistrib] + +/-- Symmetric statement to `option.map_map₂_right_anticomm`. -/ +lemma map_map₂_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'} + (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) : + (map₂ f a b).map g = map₂ f' b (a.map g') := +by cases a; cases b; simp [h_antidistrib] + +/-- Symmetric statement to `option.map_map₂_antidistrib_left`. -/ +lemma map₂_map_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ} + (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) : + map₂ f (a.map g) b = (map₂ f' b a).map g' := +by cases a; cases b; simp [h_left_anticomm] + +/-- Symmetric statement to `option.map_map₂_antidistrib_right`. -/ +lemma map_map₂_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ} + (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) : + map₂ f a (b.map g) = (map₂ f' b a).map g' := +by cases a; cases b; simp [h_right_anticomm] + +/-- If `a` is a left identity for a binary operation `f`, then `some a` is a left identity for +`option.map₂ f`. -/ +lemma map₂_left_identity {f : α → β → β} {a : α} (h : ∀ b, f a b = b) (o : option β) : + map₂ f (some a) o = o := +by { cases o, exacts [rfl, congr_arg some (h _)] } + +/-- If `b` is a right identity for a binary operation `f`, then `some b` is a right identity for +`option.map₂ f`. -/ +lemma map₂_right_identity {f : α → β → α} {b : β} (h : ∀ a, f a b = a) (o : option α) : + map₂ f o (some b) = o := +by simp [h, map₂] + +end option diff --git a/src/data/ordmap/ordnode.lean b/src/data/ordmap/ordnode.lean index 899fe54c74d88..66d7d2e99ca78 100644 --- a/src/data/ordmap/ordnode.lean +++ b/src/data/ordmap/ordnode.lean @@ -3,12 +3,16 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ +import order.compare import data.list.defs import data.nat.psub /-! # Ordered sets +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines a data structure for ordered sets, supporting a variety of useful operations including insertion and deletion, logarithmic time lookup, set operations, folds, diff --git a/src/data/ordmap/ordset.lean b/src/data/ordmap/ordset.lean index b0aacf4dd1846..c466dcbbc1b55 100644 --- a/src/data/ordmap/ordset.lean +++ b/src/data/ordmap/ordset.lean @@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro -/ import data.ordmap.ordnode -import algebra.order.ring +import algebra.order.ring.defs import data.nat.dist import tactic.linarith /-! # Verification of the `ordnode α` datatype +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves the correctness of the operations in `data.ordmap.ordnode`. The public facing version is the type `ordset α`, which is a wrapper around `ordnode α` which includes the correctness invariant of the type, and it exposes @@ -543,9 +546,10 @@ theorem dual_insert [preorder α] [is_total α (≤)] [@decidable_rel α (≤)] ∀ t : ordnode α, dual (ordnode.insert x t) = @ordnode.insert αᵒᵈ _ _ x (dual t) | nil := rfl | (node _ l y r) := begin - rw [ordnode.insert, dual, ordnode.insert, order_dual.cmp_le_flip, ← cmp_le_swap x y], + have : @cmp_le αᵒᵈ _ _ x y = cmp_le y x := rfl, + rw [ordnode.insert, dual, ordnode.insert, this, ← cmp_le_swap x y], cases cmp_le x y; - simp [ordering.swap, ordnode.insert, dual_balance_l, dual_balance_r, dual_insert] + simp [ordering.swap, ordnode.insert, dual_balance_l, dual_balance_r, dual_insert] end /-! ### `balance` properties -/ @@ -565,7 +569,7 @@ begin { have : size rrl = 0 ∧ size rrr = 0, { have := balanced_sz_zero.1 hr.1.symm, rwa [size, sr.2.2.1, nat.succ_le_succ_iff, - nat.le_zero_iff, add_eq_zero_iff] at this }, + le_zero_iff, add_eq_zero_iff] at this }, cases sr.2.2.2.1.size_eq_zero.1 this.1, cases sr.2.2.2.2.size_eq_zero.1 this.2, obtain rfl : rrs = 1 := sr.2.2.1, @@ -574,7 +578,7 @@ begin { have : size rll = 0 ∧ size rlr = 0, { have := balanced_sz_zero.1 hr.1, rwa [size, sr.2.1.1, nat.succ_le_succ_iff, - nat.le_zero_iff, add_eq_zero_iff] at this }, + le_zero_iff, add_eq_zero_iff] at this }, cases sr.2.1.2.1.size_eq_zero.1 this.1, cases sr.2.1.2.2.size_eq_zero.1 this.2, obtain rfl : rls = 1 := sr.2.1.1, @@ -595,7 +599,7 @@ begin { have : size lrl = 0 ∧ size lrr = 0, { have := balanced_sz_zero.1 hl.1.symm, rwa [size, sl.2.2.1, nat.succ_le_succ_iff, - nat.le_zero_iff, add_eq_zero_iff] at this }, + le_zero_iff, add_eq_zero_iff] at this }, cases sl.2.2.2.1.size_eq_zero.1 this.1, cases sl.2.2.2.2.size_eq_zero.1 this.2, obtain rfl : lrs = 1 := sl.2.2.1, @@ -604,7 +608,7 @@ begin { have : size lll = 0 ∧ size llr = 0, { have := balanced_sz_zero.1 hl.1, rwa [size, sl.2.1.1, nat.succ_le_succ_iff, - nat.le_zero_iff, add_eq_zero_iff] at this }, + le_zero_iff, add_eq_zero_iff] at this }, cases sl.2.1.2.1.size_eq_zero.1 this.1, cases sl.2.1.2.2.size_eq_zero.1 this.2, obtain rfl : lls = 1 := sl.2.1.1, @@ -659,7 +663,7 @@ begin { have : size rl = 0 ∧ size rr = 0, { have := H1 rfl, rwa [size, sr.1, nat.succ_le_succ_iff, - nat.le_zero_iff, add_eq_zero_iff] at this }, + le_zero_iff, add_eq_zero_iff] at this }, cases sr.2.1.size_eq_zero.1 this.1, cases sr.2.2.size_eq_zero.1 this.2, rw sr.eq_node', refl }, @@ -1032,13 +1036,13 @@ begin rw [l1, r1], cases size ml; cases size mr, { exact dec_trivial }, - { rw zero_add at mm, rcases mm with _|⟨_,⟨⟩⟩, + { rw zero_add at mm, rcases mm with _|⟨⟨⟩⟩, exact dec_trivial }, - { rcases mm with _|⟨_,⟨⟩⟩, exact dec_trivial }, - { rw nat.succ_add at mm, rcases mm with _|⟨_,⟨⟩⟩ } }, + { rcases mm with _|⟨⟨⟩⟩, exact dec_trivial }, + { rw nat.succ_add at mm, rcases mm with _|⟨⟨⟩⟩ } }, rcases hm.3.1.resolve_left mm with ⟨mm₁, mm₂⟩, cases nat.eq_zero_or_pos (size ml) with ml0 ml0, - { rw [ml0, mul_zero, nat.le_zero_iff] at mm₂, + { rw [ml0, mul_zero, le_zero_iff] at mm₂, rw [ml0, mm₂] at mm, cases mm dec_trivial }, have : 2 * size l ≤ size ml + size mr + 1, { have := nat.mul_le_mul_left _ lr₁, @@ -1115,9 +1119,9 @@ begin { exact le_trans hb₂ (nat.mul_le_mul_left _ $ le_trans (nat.le_add_left _ _) (nat.le_add_right _ _)) } }, { cases nat.eq_zero_or_pos (size rl) with rl0 rl0, - { rw [rl0, not_lt, nat.le_zero_iff, nat.mul_eq_zero] at h, + { rw [rl0, not_lt, le_zero_iff, nat.mul_eq_zero] at h, replace h := h.resolve_left dec_trivial, - rw [rl0, h, nat.le_zero_iff, nat.mul_eq_zero] at H2, + rw [rl0, h, le_zero_iff, nat.mul_eq_zero] at H2, rw [hr.2.size_eq, rl0, h, H2.resolve_left dec_trivial] at H1, cases H1 dec_trivial }, refine hl.node4_l hr.left hr.right rl0 _, diff --git a/src/data/part.lean b/src/data/part.lean index b3c27269773cf..bd31d73beec2b 100644 --- a/src/data/part.lean +++ b/src/data/part.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Jeremy Avigad, Simon Hudon -/ import data.set.basic -import logic.equiv.basic +import logic.equiv.defs /-! # Partial values of a type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `part α`, the partial values of a type. `o : part α` carries a proposition `o.dom`, its domain, along with a function `get : o.dom → α`, its @@ -20,8 +23,9 @@ for some `a : α`, while the domain of `o : part α` doesn't have to be decidabl translate back and forth between a partial value with a decidable domain and an option, and `option α` and `part α` are classically equivalent. In general, `part α` is bigger than `option α`. -In current mathlib, `part ℕ`, aka `enat`, is used to move decidability of the order to decidability -of `enat.find` (which is the smallest natural satisfying a predicate, or `∞` if there's none). +In current mathlib, `part ℕ`, aka `part_enat`, is used to move decidability of the order to +decidability of `part_enat.find` (which is the smallest natural satisfying a predicate, or `∞` if +there's none). ## Main declarations @@ -66,6 +70,14 @@ variables {α : Type*} {β : Type*} {γ : Type*} def to_option (o : part α) [decidable o.dom] : option α := if h : dom o then some (o.get h) else none +@[simp] lemma to_option_is_some (o : part α) [decidable o.dom] : + o.to_option.is_some ↔ o.dom := +by by_cases o.dom; simp [h, part.to_option] + +@[simp] lemma to_option_is_none (o : part α) [decidable o.dom] : + o.to_option.is_none ↔ ¬o.dom := +by by_cases o.dom; simp [h, part.to_option] + /-- `part` extensionality -/ theorem ext' : ∀ {o p : part α} (H1 : o.dom ↔ p.dom) @@ -349,7 +361,7 @@ begin cases h' : f h, simp only [h', h, true_and, iff_self, exists_prop_of_true, eq_iff_iff], apply function.hfunext, - { simp only [h,h',exists_prop_of_true] }, + { simp only [h, h', exists_prop_of_true] }, { cc } end diff --git a/src/data/pequiv.lean b/src/data/pequiv.lean index 972107c78cf59..bb10920cf8b6c 100644 --- a/src/data/pequiv.lean +++ b/src/data/pequiv.lean @@ -9,6 +9,9 @@ import data.set.basic # Partial Equivalences +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file, we define partial equivalences `pequiv`, which are a bijection between a subset of `α` and a subset of `β`. Notationally, a `pequiv` is denoted by "`≃.`" (note that the full stop is part of the notation). The way we store these internally is with two functions `f : α → option β` and @@ -53,30 +56,22 @@ namespace pequiv variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} open function option -instance : has_coe_to_fun (α ≃. β) (λ _, α → option β) := ⟨to_fun⟩ +instance fun_like : fun_like (α ≃. β) α (λ _, option β) := +{ coe := to_fun, + coe_injective' := + begin + rintro ⟨f₁, f₂, hf⟩ ⟨g₁, g₂, hg⟩ (rfl : f₁ = g₁), + congr' with y x, + simp only [hf, hg] + end } @[simp] lemma coe_mk_apply (f₁ : α → option β) (f₂ : β → option α) (h) (x : α) : (pequiv.mk f₁ f₂ h : α → option β) x = f₁ x := rfl -@[ext] lemma ext : ∀ {f g : α ≃. β} (h : ∀ x, f x = g x), f = g -| ⟨f₁, f₂, hf⟩ ⟨g₁, g₂, hg⟩ h := -have h : f₁ = g₁, from funext h, -have ∀ b, f₂ b = g₂ b, - begin - subst h, - assume b, - have hf := λ a, hf a b, - have hg := λ a, hg a b, - cases h : g₂ b with a, - { simp only [h, option.not_mem_none, false_iff] at hg, - simp only [hg, iff_false] at hf, - rwa [option.eq_none_iff_forall_not_mem] }, - { rw [← option.mem_def, hf, ← hg, h, option.mem_def] } - end, -by simp [*, funext_iff] +@[ext] lemma ext {f g : α ≃. β} (h : ∀ x, f x = g x) : f = g := +fun_like.ext f g h -lemma ext_iff {f g : α ≃. β} : f = g ↔ ∀ x, f x = g x := -⟨congr_fun ∘ congr_arg _, ext⟩ +lemma ext_iff {f g : α ≃. β} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff /-- The identity map as a partial equivalence. -/ @[refl] protected def refl (α : Type*) : α ≃. α := @@ -144,7 +139,7 @@ has_left_inverse.injective classical, cases hfx : f x, { have : x = a₂, from not_imp_comm.1 (h x) (hfx.symm ▸ by simp), simp [this] }, - { simp only [hfx], rw [(eq_some_iff f).2 hfx], refl } + { dsimp only, rw [(eq_some_iff f).2 hfx], refl } end⟩ /-- If the domain of a `pequiv` is all of `α`, its forward direction is injective. -/ @@ -177,10 +172,10 @@ lemma mem_of_set_iff {s : set α} [decidable_pred (∈ s)] {a b : α} : begin dsimp [of_set], split_ifs, - { simp only [iff_self_and, option.mem_def, eq_comm], + { simp only [iff_self_and, eq_comm], rintro rfl, exact h, }, - { simp only [false_iff, not_and, option.not_mem_none], + { simp only [false_iff, not_and], rintro rfl, exact h, } end diff --git a/src/data/pfun.lean b/src/data/pfun.lean index 01b830c0d31c4..588dcd7a2adbb 100644 --- a/src/data/pfun.lean +++ b/src/data/pfun.lean @@ -9,6 +9,9 @@ import data.rel /-! # Partial functions +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines partial functions. Partial functions are like functions, except they can also be "undefined" on some inputs. We define them as functions `α → part β`. @@ -58,7 +61,7 @@ def pfun (α β : Type*) := α → part β infixr ` →. `:25 := pfun namespace pfun -variables {α β γ δ : Type*} +variables {α β γ δ ε ι : Type*} instance : inhabited (α →. β) := ⟨λ a, part.none⟩ @@ -68,6 +71,9 @@ def dom (f : α →. β) : set α := {a | (f a).dom} @[simp] lemma mem_dom (f : α →. β) (x : α) : x ∈ dom f ↔ ∃ y, y ∈ f x := by simp [dom, part.dom_iff_mem] +@[simp] lemma dom_mk (p : α → Prop) (f : Π a, p a → β) : pfun.dom (λ x, ⟨p x, f x⟩) = {x | p x} := +rfl + theorem dom_eq (f : α →. β) : dom f = {x | ∃ y, y ∈ f x} := set.ext (mem_dom f) @@ -234,11 +240,11 @@ theorem mem_fix_iff {f : α →. β ⊕ α} {a : α} {b : β} : end⟩ /-- If advancing one step from `a` leads to `b : β`, then `f.fix a = b` -/ -theorem fix_stop {f : α →. β ⊕ α} (a : α) {b : β} (hb : sum.inl b ∈ f a) : b ∈ f.fix a := +theorem fix_stop {f : α →. β ⊕ α} {b : β} {a : α} (hb : sum.inl b ∈ f a) : b ∈ f.fix a := by { rw [pfun.mem_fix_iff], exact or.inl hb, } /-- If advancing one step from `a` on `f` leads to `a' : α`, then `f.fix a = f.fix a'` -/ -theorem fix_fwd {f : α →. β ⊕ α} (a a' : α) (ha' : sum.inr a' ∈ f a) : +theorem fix_fwd_eq {f : α →. β ⊕ α} {a a' : α} (ha' : sum.inr a' ∈ f a) : f.fix a = f.fix a' := begin ext b, split, @@ -246,38 +252,55 @@ begin { intro h, rw pfun.mem_fix_iff, right, use a', exact ⟨ha', h⟩, } end +theorem fix_fwd {f : α →. β ⊕ α} {b : β} {a a' : α} (hb : b ∈ f.fix a) (ha' : sum.inr a' ∈ f a) : + b ∈ f.fix a' := +by rwa [← fix_fwd_eq ha'] + /-- A recursion principle for `pfun.fix`. -/ -@[elab_as_eliminator] def fix_induction - {f : α →. β ⊕ α} {b : β} {C : α → Sort*} {a : α} (h : b ∈ f.fix a) - (H : ∀ a', b ∈ f.fix a' → - (∀ a'', sum.inr a'' ∈ f a' → C a'') → C a') : C a := +@[elab_as_eliminator] +def fix_induction {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} (h : b ∈ f.fix a) + (H : ∀ a', b ∈ f.fix a' → (∀ a'', sum.inr a'' ∈ f a' → C a'') → C a') : C a := begin - replace h := part.mem_assert_iff.1 h, - have := h.snd, revert this, - induction h.fst with a ha IH, intro h₂, - have fb : b ∈ f.fix a := (part.mem_assert_iff.2 ⟨⟨_, ha⟩, h₂⟩), - refine H a fb (λ a'' fa'', _), - have ha'' : b ∈ f.fix a'' := by rwa fix_fwd _ _ fa'' at fb, - have := (part.mem_assert_iff.1 ha'').snd, - exact IH _ fa'' ⟨ha _ fa'', this⟩ this, + have h₂ := (part.mem_assert_iff.1 h).snd, generalize_proofs h₁ at h₂, clear h, + induction h₁ with a ha IH, + have h : b ∈ f.fix a := part.mem_assert_iff.2 ⟨⟨a, ha⟩, h₂⟩, + exact H a h (λ a' fa', IH a' fa' ((part.mem_assert_iff.1 (fix_fwd h fa')).snd)), end +lemma fix_induction_spec {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} (h : b ∈ f.fix a) + (H : ∀ a', b ∈ f.fix a' → (∀ a'', sum.inr a'' ∈ f a' → C a'') → C a') : + @fix_induction _ _ C _ _ _ h H = H a h (λ a' h', fix_induction (fix_fwd h h') H) := +by { unfold fix_induction, generalize_proofs ha, induction ha, refl, } + /-- Another induction lemma for `b ∈ f.fix a` which allows one to prove a predicate `P` holds for `a` given that `f a` inherits `P` from `a` and `P` holds for preimages of `b`. -/ @[elab_as_eliminator] -def fix_induction' - (f : α →. β ⊕ α) (b : β) {C : α → Sort*} {a : α} (h : b ∈ f.fix a) +def fix_induction' {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} (h : b ∈ f.fix a) (hbase : ∀ a_final : α, sum.inl b ∈ f a_final → C a_final) (hind : ∀ a₀ a₁ : α, b ∈ f.fix a₁ → sum.inr a₁ ∈ f a₀ → C a₁ → C a₀) : C a := begin refine fix_induction h (λ a' h ih, _), cases e : (f a').get (dom_of_mem_fix h) with b' a''; replace e : _ ∈ f a' := ⟨_, e⟩, - { apply hbase, convert e, exact part.mem_unique h (fix_stop _ e), }, - { refine hind _ _ _ e (ih _ e), rwa fix_fwd _ _ e at h, }, + { apply hbase, convert e, exact part.mem_unique h (fix_stop e), }, + { exact hind _ _ (fix_fwd h e) e (ih _ e), }, end +lemma fix_induction'_stop {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a : α} + (h : b ∈ f.fix a) (fa : sum.inl b ∈ f a) + (hbase : ∀ a_final : α, sum.inl b ∈ f a_final → C a_final) + (hind : ∀ a₀ a₁ : α, b ∈ f.fix a₁ → sum.inr a₁ ∈ f a₀ → C a₁ → C a₀) : + @fix_induction' _ _ C _ _ _ h hbase hind = hbase a fa := +by { unfold fix_induction', rw [fix_induction_spec], simp [part.get_eq_of_mem fa], } + +lemma fix_induction'_fwd {C : α → Sort*} {f : α →. β ⊕ α} {b : β} {a a' : α} + (h : b ∈ f.fix a) (h' : b ∈ f.fix a') (fa : sum.inr a' ∈ f a) + (hbase : ∀ a_final : α, sum.inl b ∈ f a_final → C a_final) + (hind : ∀ a₀ a₁ : α, b ∈ f.fix a₁ → sum.inr a₁ ∈ f a₀ → C a₁ → C a₀) : + @fix_induction' _ _ C _ _ _ h hbase hind = hind a a' h' fa (fix_induction' h' hbase hind) := +by { unfold fix_induction', rw [fix_induction_spec], simpa [part.get_eq_of_mem fa], } + variables (f : α →. β) /-- Image of a set under a partial function. -/ @@ -319,6 +342,9 @@ rel.preimage_union _ s t lemma preimage_univ : f.preimage set.univ = f.dom := by ext; simp [mem_preimage, mem_dom] +lemma coe_preimage (f : α → β) (s : set β) : (f : α →. β).preimage s = f ⁻¹' s := +by ext; simp + /-- Core of a set `s : set β` with respect to a partial function `f : α →. β`. Set of all `a : α` such that `f a ∈ s`, if `f a` is defined. -/ def core (s : set β) : set α := f.graph'.core s @@ -448,4 +474,58 @@ ext $ λ _ _, by simp only [comp_apply, part.bind_comp] lemma coe_comp (g : β → γ) (f : α → β) : ((g ∘ f : α → γ) : α →. γ) = (g : β →. γ).comp f := ext $ λ _ _, by simp only [coe_val, comp_apply, part.bind_some] +/-- Product of partial functions. -/ +def prod_lift (f : α →. β) (g : α →. γ) : α →. β × γ := +λ x, ⟨(f x).dom ∧ (g x).dom, λ h, ((f x).get h.1, (g x).get h.2)⟩ + +@[simp] lemma dom_prod_lift (f : α →. β) (g : α →. γ) : + (f.prod_lift g).dom = {x | (f x).dom ∧ (g x).dom} := rfl + +lemma get_prod_lift (f : α →. β) (g : α →. γ) (x : α) (h) : + (f.prod_lift g x).get h = ((f x).get h.1, (g x).get h.2) := rfl + +@[simp] lemma prod_lift_apply (f : α →. β) (g : α →. γ) (x : α) : + f.prod_lift g x = ⟨(f x).dom ∧ (g x).dom, λ h, ((f x).get h.1, (g x).get h.2)⟩ := rfl + +lemma mem_prod_lift {f : α →. β} {g : α →. γ} {x : α} {y : β × γ} : + y ∈ f.prod_lift g x ↔ y.1 ∈ f x ∧ y.2 ∈ g x := +begin + transitivity ∃ hp hq, (f x).get hp = y.1 ∧ (g x).get hq = y.2, + { simp only [prod_lift, part.mem_mk_iff, and.exists, prod.ext_iff] }, + { simpa only [exists_and_distrib_left, exists_and_distrib_right] } +end + +/-- Product of partial functions. -/ +def prod_map (f : α →. γ) (g : β →. δ) : α × β →. γ × δ := +λ x, ⟨(f x.1).dom ∧ (g x.2).dom, λ h, ((f x.1).get h.1, (g x.2).get h.2)⟩ + +@[simp] lemma dom_prod_map (f : α →. γ) (g : β →. δ) : + (f.prod_map g).dom = {x | (f x.1).dom ∧ (g x.2).dom} := rfl + +lemma get_prod_map (f : α →. γ) (g : β →. δ) (x : α × β) (h) : + (f.prod_map g x).get h = ((f x.1).get h.1, (g x.2).get h.2) := rfl + +@[simp] lemma prod_map_apply (f : α →. γ) (g : β →. δ) (x : α × β) : + f.prod_map g x = ⟨(f x.1).dom ∧ (g x.2).dom, λ h, ((f x.1).get h.1, (g x.2).get h.2)⟩ := rfl + +lemma mem_prod_map {f : α →. γ} {g : β →. δ} {x : α × β} {y : γ × δ} : + y ∈ f.prod_map g x ↔ y.1 ∈ f x.1 ∧ y.2 ∈ g x.2 := +begin + transitivity ∃ hp hq, (f x.1).get hp = y.1 ∧ (g x.2).get hq = y.2, + { simp only [prod_map, part.mem_mk_iff, and.exists, prod.ext_iff] }, + { simpa only [exists_and_distrib_left, exists_and_distrib_right] } +end + +@[simp] lemma prod_lift_fst_comp_snd_comp (f : α →. γ) (g : β →. δ) : + prod_lift (f.comp ((prod.fst : α × β → α) : α × β →. α)) + (g.comp ((prod.snd : α × β → β) : α × β →. β)) = prod_map f g := +ext $ λ a, by simp + +@[simp] lemma prod_map_id_id : (pfun.id α).prod_map (pfun.id β) = pfun.id _ := +ext $ λ _ _, by simp [eq_comm] + +@[simp] lemma prod_map_comp_comp (f₁ : α →. β) (f₂ : β →. γ) (g₁ : δ →. ε) (g₂ : ε →. ι) : + (f₂.comp f₁).prod_map (g₂.comp g₁) = (f₂.prod_map g₂).comp (f₁.prod_map g₁) := +ext $ λ _ _, by tidy + end pfun diff --git a/src/data/pfunctor/multivariate/M.lean b/src/data/pfunctor/multivariate/M.lean index ede48f428f644..b74d0ef8d645a 100644 --- a/src/data/pfunctor/multivariate/M.lean +++ b/src/data/pfunctor/multivariate/M.lean @@ -9,6 +9,9 @@ import data.pfunctor.univariate.M /-! # The M construction as a multivariate polynomial functor. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + M types are potentially infinite tree-like structures. They are defined as the greatest fixpoint of a polynomial functor. diff --git a/src/data/pfunctor/multivariate/W.lean b/src/data/pfunctor/multivariate/W.lean index dbb2b2165b607..59dc86e7a3cd6 100644 --- a/src/data/pfunctor/multivariate/W.lean +++ b/src/data/pfunctor/multivariate/W.lean @@ -8,6 +8,9 @@ import data.pfunctor.multivariate.basic /-! # The W construction as a multivariate polynomial functor. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + W types are well-founded tree-like structures. They are defined as the least fixpoint of a polynomial functor. @@ -114,7 +117,7 @@ def Wp : mvpfunctor n := { A := P.last.W, B := P.W_path } /-- W-type of `P` -/ -@[nolint has_inhabited_instance] +@[nolint has_nonempty_instance] def W (α : typevec n) : Type* := P.Wp.obj α instance mvfunctor_W : mvfunctor P.W := by delta mvpfunctor.W; apply_instance diff --git a/src/data/pfunctor/multivariate/basic.lean b/src/data/pfunctor/multivariate/basic.lean index 823037162e2cb..3a4a950f74b7b 100644 --- a/src/data/pfunctor/multivariate/basic.lean +++ b/src/data/pfunctor/multivariate/basic.lean @@ -9,6 +9,9 @@ import data.pfunctor.univariate.basic /-! # Multivariate polynomial functors. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Multivariate polynomial functors are used for defining M-types and W-types. They map a type vector `α` to the type `Σ a : A, B a ⟹ α`, with `A : Type` and `B : A → typevec n`. They interact well with Lean's inductive definitions because @@ -37,7 +40,7 @@ def map {α β : typevec n} (f : α ⟹ β) : P.obj α → P.obj β := λ ⟨a, g⟩, ⟨a, typevec.comp f g⟩ instance : inhabited (mvpfunctor n) := -⟨ ⟨default, λ _, default⟩ ⟩ +⟨⟨default, default⟩⟩ instance obj.inhabited {α : typevec n} [inhabited P.A] [Π i, inhabited (α i)] : inhabited (P.obj α) := diff --git a/src/data/pfunctor/univariate/M.lean b/src/data/pfunctor/univariate/M.lean index cdcedad8b350e..3090f1d746cf8 100644 --- a/src/data/pfunctor/univariate/M.lean +++ b/src/data/pfunctor/univariate/M.lean @@ -8,6 +8,9 @@ import data.pfunctor.univariate.basic /-! # M-types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + M types are potentially infinite tree-like structures. They are defined as the greatest fixpoint of a polynomial functor. -/ @@ -170,7 +173,7 @@ lemma M.default_consistent [inhabited F.A] : | (succ n) := agree.intro _ _ $ λ _, M.default_consistent n instance M.inhabited [inhabited F.A] : inhabited (M F) := -⟨ { approx := λ n, default, +⟨ { approx := default, consistent := M.default_consistent _ } ⟩ instance M_intl.inhabited [inhabited F.A] : inhabited (M_intl F) := @@ -295,7 +298,9 @@ begin { rw [← head_succ' n,h,head'], apply x.consistent }, revert ch, rw h', intros, congr, { ext a, dsimp only [children], - h_generalize! hh : a == a'', + generalize hh : cast _ a = a'', + rw cast_eq_iff_heq at hh, + revert a'', rw h, intros, cases hh, refl }, end @@ -388,7 +393,7 @@ lemma is_path_cons {xs : path F} {a a'} {f : F.B a → M F} {i : F.B a'} : is_path (⟨a',i⟩ :: xs) (M.mk ⟨a,f⟩) → a = a' := begin generalize h : (M.mk ⟨a,f⟩) = x, - rintro (_ | ⟨_, _, _, _, _, rfl, _⟩), + rintro (_ | ⟨_, _, _, _, rfl, _⟩), cases mk_inj h, refl end @@ -397,7 +402,7 @@ lemma is_path_cons' {xs : path F} {a} {f : F.B a → M F} {i : F.B a} : is_path (⟨a,i⟩ :: xs) (M.mk ⟨a,f⟩) → is_path xs (f i) := begin generalize h : (M.mk ⟨a,f⟩) = x, - rintro (_ | ⟨_, _, _, _, _, rfl, hp⟩), + rintro (_ | ⟨_, _, _, _, rfl, hp⟩), cases mk_inj h, exact hp end diff --git a/src/data/pfunctor/univariate/basic.lean b/src/data/pfunctor/univariate/basic.lean index fb0e3efaa3844..f969ae2c868ff 100644 --- a/src/data/pfunctor/univariate/basic.lean +++ b/src/data/pfunctor/univariate/basic.lean @@ -8,6 +8,9 @@ import data.W.basic /-! # Polynomial functors +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines polynomial functors and the W-type construction as a polynomial functor. (For the M-type construction, see pfunctor/M.lean.) @@ -41,8 +44,7 @@ def obj (α : Type*) := Σ x : P.A, P.B x → α def map {α β : Type*} (f : α → β) : P.obj α → P.obj β := λ ⟨a, g⟩, ⟨a, f ∘ g⟩ -instance obj.inhabited [inhabited P.A] [inhabited α] : inhabited (P.obj α) := -⟨ ⟨ default, λ _, default ⟩ ⟩ +instance obj.inhabited [inhabited P.A] [inhabited α] : inhabited (P.obj α) := ⟨⟨default, default⟩⟩ instance : functor P.obj := {map := @map P} protected theorem map_eq {α β : Type*} (f : α → β) (a : P.A) (g : P.B a → α) : @@ -66,7 +68,7 @@ def W := _root_.W_type P.B /- inhabitants of W types is awkward to encode as an instance assumption because there needs to be a value `a : P.A` such that `P.B a` is empty to yield a finite tree -/ -attribute [nolint has_inhabited_instance] W +attribute [nolint has_nonempty_instance] W variables {P} /-- root element of a W tree -/ @@ -99,7 +101,7 @@ one part of `x` or is invalid, if `i.1 ≠ x.1` -/ def Idx := Σ x : P.A, P.B x instance Idx.inhabited [inhabited P.A] [inhabited (P.B default)] : inhabited P.Idx := -⟨ ⟨default, default⟩ ⟩ +⟨⟨default, default⟩⟩ variables {P} diff --git a/src/data/pfunctor/univariate/default.lean b/src/data/pfunctor/univariate/default.lean deleted file mode 100644 index 157e8d4adb6cd..0000000000000 --- a/src/data/pfunctor/univariate/default.lean +++ /dev/null @@ -1,2 +0,0 @@ -import data.pfunctor.univariate.basic -import data.pfunctor.univariate.M diff --git a/src/data/pi/algebra.lean b/src/data/pi/algebra.lean index 367eb56bcbbca..e3b8a2e710add 100644 --- a/src/data/pi/algebra.lean +++ b/src/data/pi/algebra.lean @@ -3,15 +3,21 @@ Copyright (c) 2020 Eric Wieser. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Simon Hudon, Patrick Massot, Eric Wieser -/ -import tactic.split_ifs -import tactic.simpa -import tactic.congr -import algebra.group.to_additive -import data.prod +import tactic.to_additive +import algebra.group.defs import logic.unique +import tactic.congr +import tactic.simpa +import tactic.split_ifs +import data.sum.basic +import data.prod.basic + /-! # Instances and theorems on pi types +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file provides basic definitions and notation instances for Pi types. Instances of more sophisticated classes are defined in `pi.lean` files elsewhere. @@ -28,7 +34,7 @@ variables (x y : Π i, f i) (i : I) namespace pi -/-! `1`, `0`, `+`, `*`, `-`, `⁻¹`, and `/` are defined pointwise. -/ +/-! `1`, `0`, `+`, `*`, `+ᵥ`, `•`, `^`, `-`, `⁻¹`, and `/` are defined pointwise. -/ @[to_additive] instance has_one [∀ i, has_one $ f i] : has_one (Π i : I, f i) := @@ -57,6 +63,38 @@ instance has_mul [∀ i, has_mul $ f i] : @[to_additive] lemma mul_comp [has_mul γ] (x y : β → γ) (z : α → β) : (x * y) ∘ z = x ∘ z * y ∘ z := rfl +@[to_additive pi.has_vadd] instance has_smul [Π i, has_smul α $ f i] : has_smul α (Π i : I, f i) := +⟨λ s x, λ i, s • (x i)⟩ + +@[simp, to_additive] lemma smul_apply [Π i, has_smul α $ f i] (s : α) (x : Π i, f i) (i : I) : + (s • x) i = s • x i := rfl + +@[to_additive] lemma smul_def [Π i, has_smul α $ f i] (s : α) (x : Π i, f i) : + s • x = λ i, s • x i := rfl + +@[simp, to_additive] +lemma smul_const [has_smul α β] (a : α) (b : β) : a • const I b = const I (a • b) := rfl + +@[to_additive] +lemma smul_comp [has_smul α γ] (a : α) (x : β → γ) (y : I → β) : (a • x) ∘ y = a • (x ∘ y) := rfl + +@[to_additive pi.has_smul] +instance has_pow [Π i, has_pow (f i) β] : has_pow (Π i, f i) β := +⟨λ x b i, (x i) ^ b⟩ + +@[simp, to_additive pi.smul_apply, to_additive_reorder 5] +lemma pow_apply [Π i, has_pow (f i) β] (x : Π i, f i) (b : β) (i : I) : (x ^ b) i = (x i) ^ b := rfl + +@[to_additive pi.smul_def, to_additive_reorder 5] +lemma pow_def [Π i, has_pow (f i) β] (x : Π i, f i) (b : β) : x ^ b = λ i, (x i) ^ b := rfl + +-- `to_additive` generates bad output if we take `has_pow α β`. +@[simp, to_additive smul_const, to_additive_reorder 5] +lemma const_pow [has_pow β α] (b : β) (a : α) : const I b ^ a = const I (b ^ a) := rfl + +@[to_additive smul_comp, to_additive_reorder 6] +lemma pow_comp [has_pow γ α] (x : β → γ) (a : α) (y : I → β) : (x ^ a) ∘ y = (x ∘ y) ^ a := rfl + @[simp] lemma bit0_apply [Π i, has_add $ f i] : (bit0 x) i = bit0 (x i) := rfl @[simp] lemma bit1_apply [Π i, has_add $ f i] [Π i, has_one $ f i] : (bit1 x) i = bit1 (x i) := rfl @@ -224,3 +262,38 @@ lemma subsingleton.pi_mul_single_eq {α : Type*} [decidable_eq I] [subsingleton (i : I) (x : α) : pi.mul_single i x = λ _, x := funext $ λ j, by rw [subsingleton.elim j i, pi.mul_single_eq_same] + +namespace sum +variables (a a' : α → γ) (b b' : β → γ) + +@[simp, to_additive] +lemma elim_one_one [has_one γ] : + sum.elim (1 : α → γ) (1 : β → γ) = 1 := +sum.elim_const_const 1 + +@[simp, to_additive] +lemma elim_mul_single_one [decidable_eq α] [decidable_eq β] [has_one γ] (i : α) (c : γ) : + sum.elim (pi.mul_single i c) (1 : β → γ) = pi.mul_single (sum.inl i) c := +by simp only [pi.mul_single, sum.elim_update_left, elim_one_one] + +@[simp, to_additive] +lemma elim_one_mul_single [decidable_eq α] [decidable_eq β] [has_one γ] (i : β) (c : γ) : + sum.elim (1 : α → γ) (pi.mul_single i c) = pi.mul_single (sum.inr i) c := +by simp only [pi.mul_single, sum.elim_update_right, elim_one_one] + +@[to_additive] +lemma elim_inv_inv [has_inv γ] : + sum.elim a⁻¹ b⁻¹ = (sum.elim a b)⁻¹ := +(sum.comp_elim has_inv.inv a b).symm + +@[to_additive] +lemma elim_mul_mul [has_mul γ] : + sum.elim (a * a') (b * b') = sum.elim a b * sum.elim a' b' := +by { ext x, cases x; refl } + +@[to_additive] +lemma elim_div_div [has_div γ] : + sum.elim (a / a') (b / b') = sum.elim a b / sum.elim a' b' := +by { ext x, cases x; refl } + +end sum diff --git a/src/data/pi/interval.lean b/src/data/pi/interval.lean index 4b4aace20a8b4..812b52ef97122 100644 --- a/src/data/pi/interval.lean +++ b/src/data/pi/interval.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ import data.finset.locally_finite -import data.fintype.card +import data.fintype.big_operators /-! # Intervals in a pi type +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file shows that (dependent) functions to locally finite orders equipped with the pointwise order are locally finite and calculates the cardinality of their intervals. -/ @@ -16,27 +19,73 @@ order are locally finite and calculates the cardinality of their intervals. open finset fintype open_locale big_operators -variables {ι : Type*} {α : ι → Type*} [decidable_eq ι] [fintype ι] [Π i, decidable_eq (α i)] - [Π i, partial_order (α i)] [Π i, locally_finite_order (α i)] +variables {ι : Type*} {α : ι → Type*} [fintype ι] [decidable_eq ι] [Π i, decidable_eq (α i)] namespace pi +section partial_order +variables [Π i, partial_order (α i)] + +section locally_finite_order +variables [Π i, locally_finite_order (α i)] instance : locally_finite_order (Π i, α i) := locally_finite_order.of_Icc _ (λ a b, pi_finset $ λ i, Icc (a i) (b i)) - (λ a b x, by { simp_rw [mem_pi_finset, mem_Icc], exact forall_and_distrib }) + (λ a b x, by simp_rw [mem_pi_finset, mem_Icc, le_def, forall_and_distrib]) variables (a b : Π i, α i) +lemma Icc_eq : Icc a b = pi_finset (λ i, Icc (a i) (b i)) := rfl + lemma card_Icc : (Icc a b).card = ∏ i, (Icc (a i) (b i)).card := card_pi_finset _ -lemma card_Ico : (Ico a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 := +lemma card_Ico : (Ico a b).card = ∏ i, (Icc (a i) (b i)).card - 1 := by rw [card_Ico_eq_card_Icc_sub_one, card_Icc] -lemma card_Ioc : (Ioc a b).card = (∏ i, (Icc (a i) (b i)).card) - 1 := +lemma card_Ioc : (Ioc a b).card = ∏ i, (Icc (a i) (b i)).card - 1 := by rw [card_Ioc_eq_card_Icc_sub_one, card_Icc] -lemma card_Ioo : (Ioo a b).card = (∏ i, (Icc (a i) (b i)).card) - 2 := +lemma card_Ioo : (Ioo a b).card = ∏ i, (Icc (a i) (b i)).card - 2 := by rw [card_Ioo_eq_card_Icc_sub_two, card_Icc] +end locally_finite_order + +section locally_finite_order_bot +variables [Π i, locally_finite_order_bot (α i)] (b : Π i, α i) + +instance : locally_finite_order_bot (Π i, α i) := +locally_finite_order_top.of_Iic _ + (λ b, pi_finset $ λ i, Iic (b i)) + (λ b x, by simp_rw [mem_pi_finset, mem_Iic, le_def]) + +lemma card_Iic : (Iic b).card = ∏ i, (Iic (b i)).card := card_pi_finset _ + +lemma card_Iio : (Iio b).card = ∏ i, (Iic (b i)).card - 1 := +by rw [card_Iio_eq_card_Iic_sub_one, card_Iic] + +end locally_finite_order_bot + +section locally_finite_order_top +variables [Π i, locally_finite_order_top (α i)] (a : Π i, α i) + +instance : locally_finite_order_top (Π i, α i) := +locally_finite_order_top.of_Ici _ + (λ a, pi_finset $ λ i, Ici (a i)) + (λ a x, by simp_rw [mem_pi_finset, mem_Ici, le_def]) + +lemma card_Ici : (Ici a).card = ∏ i, (Ici (a i)).card := card_pi_finset _ + +lemma card_Ioi : (Ioi a).card = ∏ i, (Ici (a i)).card - 1 := +by rw [card_Ioi_eq_card_Ici_sub_one, card_Ici] + +end locally_finite_order_top +end partial_order + +section lattice +variables [Π i, lattice (α i)] [Π i, locally_finite_order (α i)] (a b : Π i, α i) + +lemma uIcc_eq : uIcc a b = pi_finset (λ i, uIcc (a i) (b i)) := rfl +lemma card_uIcc : (uIcc a b).card = ∏ i, (uIcc (a i) (b i)).card := card_Icc _ _ + +end lattice end pi diff --git a/src/data/pi/lex.lean b/src/data/pi/lex.lean index 2fbb3c7cc74f6..a6f2d78919bc6 100644 --- a/src/data/pi/lex.lean +++ b/src/data/pi/lex.lean @@ -5,35 +5,81 @@ Authors: Chris Hughes -/ import order.well_founded import algebra.group.pi -import order.min_max +import algebra.order.group.defs /-! # Lexicographic order on Pi types -This file defines the lexicographic relation for Pi types of partial orders and linear orders. We -also provide a `pilex` analog of `pi.ordered_comm_group` (see `algebra.order.pi`). +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the lexicographic order for Pi types. `a` is less than `b` if `a i = b i` for all +`i` up to some point `k`, and `a k < b k`. + +## Notation + +* `Πₗ i, α i`: Pi type equipped with the lexicographic order. Type synonym of `Π i, α i`. + +## See also + +Related files are: +* `data.finset.colex`: Colexicographic order on finite sets. +* `data.list.lex`: Lexicographic order on lists. +* `data.sigma.order`: Lexicographic order on `Σₗ i, α i`. +* `data.psigma.order`: Lexicographic order on `Σₗ' i, α i`. +* `data.prod.lex`: Lexicographic order on `α × β`. -/ variables {ι : Type*} {β : ι → Type*} (r : ι → ι → Prop) (s : Π {i}, β i → β i → Prop) +namespace pi + +instance {α : Type*} : Π [inhabited α], inhabited (lex α) := id + /-- The lexicographic relation on `Π i : ι, β i`, where `ι` is ordered by `r`, and each `β i` is ordered by `s`. -/ -def pi.lex (x y : Π i, β i) : Prop := +protected def lex (x y : Π i, β i) : Prop := ∃ i, (∀ j, r j i → x j = y j) ∧ s (x i) (y i) -/-- The cartesian product of an indexed family, equipped with the lexicographic order. -/ -def pilex (α : Type*) (β : α → Type*) : Type* := Π a, β a +/- This unfortunately results in a type that isn't delta-reduced, so we keep the notation out of the +basic API, just in case -/ +notation `Πₗ` binders `, ` r:(scoped p, lex (Π i, p i)) := r + +@[simp] lemma to_lex_apply (x : Π i, β i) (i : ι) : to_lex x i = x i := rfl +@[simp] lemma of_lex_apply (x : lex (Π i, β i)) (i : ι) : of_lex x i = x i := rfl -instance [has_lt ι] [∀ a, has_lt (β a)] : has_lt (pilex ι β) := -{ lt := pi.lex (<) (λ _, (<)) } +lemma lex_lt_of_lt_of_preorder [Π i, preorder (β i)] {r} (hwf : well_founded r) + {x y : Π i, β i} (hlt : x < y) : ∃ i, (∀ j, r j i → x j ≤ y j ∧ y j ≤ x j) ∧ x i < y i := +let h' := pi.lt_def.1 hlt, ⟨i, hi, hl⟩ := hwf.has_min _ h'.2 in + ⟨i, λ j hj, ⟨h'.1 j, not_not.1 $ λ h, hl j (lt_of_le_not_le (h'.1 j) h) hj⟩, hi⟩ -instance [∀ a, inhabited (β a)] : inhabited (pilex ι β) := -by unfold pilex; apply_instance +lemma lex_lt_of_lt [Π i, partial_order (β i)] {r} (hwf : well_founded r) + {x y : Π i, β i} (hlt : x < y) : pi.lex r (λ i, (<)) x y := +by { simp_rw [pi.lex, le_antisymm_iff], exact lex_lt_of_lt_of_preorder hwf hlt } -instance pilex.is_strict_order [linear_order ι] [∀ a, partial_order (β a)] : - is_strict_order (pilex ι β) (<) := +lemma is_trichotomous_lex [∀ i, is_trichotomous (β i) s] (wf : well_founded r) : + is_trichotomous (Π i, β i) (pi.lex r @s) := +{ trichotomous := λ a b, + begin + cases eq_or_ne a b with hab hab, + { exact or.inr (or.inl hab) }, + { rw function.ne_iff at hab, + let i := wf.min _ hab, + have hri : ∀ j, r j i → a j = b j, + { intro j, rw ← not_imp_not, + exact λ h', wf.not_lt_min _ _ h' }, + have hne : a i ≠ b i, from wf.min_mem _ hab, + cases trichotomous_of s (a i) (b i) with hi hi, + exacts [or.inl ⟨i, hri, hi⟩, + or.inr $ or.inr $ ⟨i, λ j hj, (hri j hj).symm, hi.resolve_left hne⟩] }, + end } + +instance [has_lt ι] [Π a, has_lt (β a)] : has_lt (lex (Π i, β i)) := ⟨pi.lex (<) (λ _, (<))⟩ + +instance lex.is_strict_order [linear_order ι] [∀ a, partial_order (β a)] : + is_strict_order (lex (Π i, β i)) (<) := { irrefl := λ a ⟨k, hk₁, hk₂⟩, lt_irrefl (a k) hk₂, trans := begin @@ -44,49 +90,124 @@ instance pilex.is_strict_order [linear_order ι] [∀ a, partial_order (β a)] : ⟨N₂, λ j hj, (lt_N₁ _ (hj.trans H)).trans (lt_N₂ _ hj), (lt_N₁ _ H).symm ▸ b_lt_c⟩] end } -instance [linear_order ι] [∀ a, partial_order (β a)] : partial_order (pilex ι β) := +instance [linear_order ι] [Π a, partial_order (β a)] : partial_order (lex (Π i, β i)) := partial_order_of_SO (<) -protected lemma pilex.is_strict_total_order' [linear_order ι] - (wf : well_founded ((<) : ι → ι → Prop)) [∀ a, linear_order (β a)] : - is_strict_total_order' (pilex ι β) (<) := -{ trichotomous := λ a b, - begin - by_cases h : ∃ i, a i ≠ b i, - { let i := wf.min _ h, - have hlt_i : ∀ j < i, a j = b j, - { intro j, rw ← not_imp_not, - exact λ h', wf.not_lt_min _ _ h' }, - have : a i ≠ b i, from wf.min_mem _ h, - exact this.lt_or_lt.imp (λ h, ⟨i, hlt_i, h⟩) - (λ h, or.inr ⟨i, λ j hj, (hlt_i j hj).symm, h⟩) }, - { push_neg at h, exact or.inr (or.inl (funext h)) } - end } +/-- `Πₗ i, α i` is a linear order if the original order is well-founded. -/ +noncomputable instance [linear_order ι] [is_well_order ι (<)] [∀ a, linear_order (β a)] : + linear_order (lex (Π i, β i)) := +@linear_order_of_STO (Πₗ i, β i) (<) + { to_is_trichotomous := is_trichotomous_lex _ _ is_well_founded.wf } (classical.dec_rel _) + +section partial_order +variables [linear_order ι] [is_well_order ι (<)] [Π i, partial_order (β i)] {x y : Π i, β i} {i : ι} + {a b : β i} + +open function + +lemma to_lex_monotone : monotone (@to_lex (Π i, β i)) := +λ a b h, or_iff_not_imp_left.2 $ λ hne, + let ⟨i, hi, hl⟩ := is_well_founded.wf.has_min {i | a i ≠ b i} (function.ne_iff.1 hne) in + ⟨i, λ j hj, by { contrapose! hl, exact ⟨j, hl, hj⟩ }, (h i).lt_of_ne hi⟩ + +lemma to_lex_strict_mono : strict_mono (@to_lex (Π i, β i)) := +λ a b h, let ⟨i, hi, hl⟩ := is_well_founded.wf.has_min {i | a i ≠ b i} (function.ne_iff.1 h.ne) in + ⟨i, λ j hj, by { contrapose! hl, exact ⟨j, hl, hj⟩ }, (h.le i).lt_of_ne hi⟩ -/-- `pilex` is a linear order if the original order is well-founded. -This cannot be an instance, since it depends on the well-foundedness of `<`. -/ -protected noncomputable def pilex.linear_order [linear_order ι] - (wf : well_founded ((<) : ι → ι → Prop)) [∀ a, linear_order (β a)] : - linear_order (pilex ι β) := -@linear_order_of_STO' (pilex ι β) (<) (pilex.is_strict_total_order' wf) (classical.dec_rel _) +@[simp] lemma lt_to_lex_update_self_iff : to_lex x < to_lex (update x i a) ↔ x i < a := +begin + refine ⟨_, λ h, to_lex_strict_mono $ lt_update_self_iff.2 h⟩, + rintro ⟨j, hj, h⟩, + dsimp at h, + obtain rfl : j = i, + { by_contra H, + rw update_noteq H at h, + exact h.false }, + { rwa update_same at h } +end -lemma pilex.le_of_forall_le [linear_order ι] - (wf : well_founded ((<) : ι → ι → Prop)) [∀ a, linear_order (β a)] {a b : pilex ι β} - (h : ∀ i, a i ≤ b i) : a ≤ b := +@[simp] lemma to_lex_update_lt_self_iff : to_lex (update x i a) < to_lex x ↔ a < x i := begin - letI : linear_order (pilex ι β) := pilex.linear_order wf, - exact le_of_not_lt (λ ⟨i, hi⟩, (h i).not_lt hi.2) + refine ⟨_, λ h, to_lex_strict_mono $ update_lt_self_iff.2 h⟩, + rintro ⟨j, hj, h⟩, + dsimp at h, + obtain rfl : j = i, + { by_contra H, + rw update_noteq H at h, + exact h.false }, + { rwa update_same at h } end +@[simp] lemma le_to_lex_update_self_iff : to_lex x ≤ to_lex (update x i a) ↔ x i ≤ a := +by simp_rw [le_iff_lt_or_eq, lt_to_lex_update_self_iff, to_lex_inj, eq_update_self_iff] + +@[simp] lemma to_lex_update_le_self_iff : to_lex (update x i a) ≤ to_lex x ↔ a ≤ x i := +by simp_rw [le_iff_lt_or_eq, to_lex_update_lt_self_iff, to_lex_inj, update_eq_self_iff] + +end partial_order + +instance [linear_order ι] [is_well_order ι (<)] [Π a, partial_order (β a)] + [Π a, order_bot (β a)] : order_bot (lex (Π a, β a)) := +{ bot := to_lex ⊥, + bot_le := λ f, to_lex_monotone bot_le } + +instance [linear_order ι] [is_well_order ι (<)] [Π a, partial_order (β a)] + [Π a, order_top (β a)] : order_top (lex (Π a, β a)) := +{ top := to_lex ⊤, + le_top := λ f, to_lex_monotone le_top } + +instance [linear_order ι] [is_well_order ι (<)] [Π a, partial_order (β a)] + [Π a, bounded_order (β a)] : bounded_order (lex (Π a, β a)) := +{ .. pi.lex.order_bot, .. pi.lex.order_top } + +instance [preorder ι] [Π i, has_lt (β i)] [Π i, densely_ordered (β i)] : + densely_ordered (lex (Π i, β i)) := +⟨begin + rintro _ _ ⟨i, h, hi⟩, + obtain ⟨a, ha₁, ha₂⟩ := exists_between hi, + classical, + refine ⟨a₂.update _ a, ⟨i, λ j hj, _, _⟩, i, λ j hj, _, _⟩, + rw h j hj, + iterate 2 { { rw a₂.update_noteq hj.ne a }, { rwa a₂.update_same i a } }, +end⟩ + +lemma lex.no_max_order' [preorder ι] [Π i, has_lt (β i)] (i : ι) [no_max_order (β i)] : + no_max_order (lex (Π i, β i)) := +⟨λ a, begin + classical, + obtain ⟨b, hb⟩ := exists_gt (a i), + exact ⟨a.update i b, i, λ j hj, (a.update_noteq hj.ne b).symm, by rwa a.update_same i b⟩ +end⟩ + +instance [linear_order ι] [is_well_order ι (<)] [nonempty ι] [Π i, partial_order (β i)] + [Π i, no_max_order (β i)] : + no_max_order (lex (Π i, β i)) := +⟨λ a, let ⟨b, hb⟩ := exists_gt (of_lex a) in ⟨_, to_lex_strict_mono hb⟩⟩ + +instance [linear_order ι] [is_well_order ι (<)] [nonempty ι] [Π i, partial_order (β i)] + [Π i, no_min_order (β i)] : + no_min_order (lex (Π i, β i)) := +⟨λ a, let ⟨b, hb⟩ := exists_lt (of_lex a) in ⟨_, to_lex_strict_mono hb⟩⟩ + --we might want the analog of `pi.ordered_cancel_comm_monoid` as well in the future @[to_additive] -instance [linear_order ι] [∀ a, ordered_comm_group (β a)] : - ordered_comm_group (pilex ι β) := +instance lex.ordered_comm_group [linear_order ι] [∀ a, ordered_comm_group (β a)] : + ordered_comm_group (lex (Π i, β i)) := { mul_le_mul_left := λ x y hxy z, hxy.elim (λ hxyz, hxyz ▸ le_rfl) (λ ⟨i, hi⟩, or.inr ⟨i, λ j hji, show z j * x j = z j * y j, by rw hi.1 j hji, mul_lt_mul_left' hi.2 _⟩), - ..pilex.partial_order, + ..pi.lex.partial_order, ..pi.comm_group } + +/-- If we swap two strictly decreasing values in a function, then the result is lexicographically +smaller than the original function. -/ +lemma lex_desc {α} [preorder ι] [decidable_eq ι] [preorder α] {f : ι → α} {i j : ι} + (h₁ : i < j) (h₂ : f j < f i) : + to_lex (f ∘ equiv.swap i j) < to_lex f := +⟨i, λ k hik, congr_arg f (equiv.swap_apply_of_ne_of_ne hik.ne (hik.trans h₁).ne), + by simpa only [pi.to_lex_apply, function.comp_app, equiv.swap_apply_left] using h₂⟩ + +end pi diff --git a/src/data/pnat/basic.lean b/src/data/pnat/basic.lean index e67d52cbb6f8c..fdbc7a7551636 100644 --- a/src/data/pnat/basic.lean +++ b/src/data/pnat/basic.lean @@ -3,57 +3,67 @@ Copyright (c) 2017 Microsoft Corporation. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Mario Carneiro, Neil Strickland -/ -import data.nat.basic +import data.pnat.defs +import data.nat.bits +import data.nat.order.basic +import data.set.basic +import algebra.group_with_zero.divisibility +import algebra.order.positive.ring /-! # The positive natural numbers -This file defines the type `ℕ+` or `pnat`, the subtype of natural numbers that are positive. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file develops the type `ℕ+` or `pnat`, the subtype of natural numbers that are positive. +It is defined in `data.pnat.defs`, but most of the development is deferred to here so +that `data.pnat.defs` can have very few imports. -/ -/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype, - and the VM representation of `ℕ+` is the same as `ℕ` because the proof - is not stored. -/ -def pnat := {n : ℕ // 0 < n} -notation `ℕ+` := pnat +attribute [derive [add_left_cancel_semigroup, add_right_cancel_semigroup, add_comm_semigroup, + linear_ordered_cancel_comm_monoid, has_add, has_mul, distrib]] pnat -instance coe_pnat_nat : has_coe ℕ+ ℕ := ⟨subtype.val⟩ -instance : has_repr ℕ+ := ⟨λ n, repr n.1⟩ +namespace pnat -/-- Predecessor of a `ℕ+`, as a `ℕ`. -/ -def pnat.nat_pred (i : ℕ+) : ℕ := i - 1 +instance : is_well_order ℕ+ (<) := { } -@[simp] lemma pnat.one_add_nat_pred (n : ℕ+) : 1 + n.nat_pred = n := -by rw [pnat.nat_pred, add_tsub_cancel_iff_le.mpr $ show 1 ≤ (n : ℕ), from n.2] +@[simp] lemma one_add_nat_pred (n : ℕ+) : 1 + n.nat_pred = n := +by rw [nat_pred, add_tsub_cancel_iff_le.mpr $ show 1 ≤ (n : ℕ), from n.2] -@[simp] lemma pnat.nat_pred_add_one (n : ℕ+) : n.nat_pred + 1 = n := +@[simp] lemma nat_pred_add_one (n : ℕ+) : n.nat_pred + 1 = n := (add_comm _ _).trans n.one_add_nat_pred -@[simp] lemma pnat.nat_pred_eq_pred {n : ℕ} (h : 0 < n) : -pnat.nat_pred (⟨n, h⟩ : ℕ+) = n.pred := rfl +@[mono] lemma nat_pred_strict_mono : strict_mono nat_pred := λ m n h, nat.pred_lt_pred m.2.ne' h +@[mono] lemma nat_pred_monotone : monotone nat_pred := nat_pred_strict_mono.monotone +lemma nat_pred_injective : function.injective nat_pred := nat_pred_strict_mono.injective + +@[simp] lemma nat_pred_lt_nat_pred {m n : ℕ+} : m.nat_pred < n.nat_pred ↔ m < n := +nat_pred_strict_mono.lt_iff_lt + +@[simp] lemma nat_pred_le_nat_pred {m n : ℕ+} : m.nat_pred ≤ n.nat_pred ↔ m ≤ n := +nat_pred_strict_mono.le_iff_le + +@[simp] lemma nat_pred_inj {m n : ℕ+} : m.nat_pred = n.nat_pred ↔ m = n := nat_pred_injective.eq_iff + +end pnat namespace nat -/-- Convert a natural number to a positive natural number. The - positivity assumption is inferred by `dec_trivial`. -/ -def to_pnat (n : ℕ) (h : 0 < n . tactic.exact_dec_trivial) : ℕ+ := ⟨n, h⟩ +@[mono] theorem succ_pnat_strict_mono : strict_mono succ_pnat := λ m n, nat.succ_lt_succ -/-- Write a successor as an element of `ℕ+`. -/ -def succ_pnat (n : ℕ) : ℕ+ := ⟨succ n, succ_pos n⟩ +@[mono] theorem succ_pnat_mono : monotone succ_pnat := succ_pnat_strict_mono.monotone -@[simp] theorem succ_pnat_coe (n : ℕ) : (succ_pnat n : ℕ) = succ n := rfl +@[simp] theorem succ_pnat_lt_succ_pnat {m n : ℕ} : m.succ_pnat < n.succ_pnat ↔ m < n := +succ_pnat_strict_mono.lt_iff_lt -theorem succ_pnat_inj {n m : ℕ} : succ_pnat n = succ_pnat m → n = m := -λ h, by { let h' := congr_arg (coe : ℕ+ → ℕ) h, exact nat.succ.inj h' } +@[simp] theorem succ_pnat_le_succ_pnat {m n : ℕ} : m.succ_pnat ≤ n.succ_pnat ↔ m ≤ n := +succ_pnat_strict_mono.le_iff_le -/-- Convert a natural number to a pnat. `n+1` is mapped to itself, - and `0` becomes `1`. -/ -def to_pnat' (n : ℕ) : ℕ+ := succ_pnat (pred n) +theorem succ_pnat_injective : function.injective succ_pnat := succ_pnat_strict_mono.injective -@[simp] theorem to_pnat'_coe : ∀ (n : ℕ), - ((to_pnat' n) : ℕ) = ite (0 < n) n 1 -| 0 := rfl -| (m + 1) := by {rw [if_pos (succ_pos m)], refl} +@[simp] theorem succ_pnat_inj {n m : ℕ} : succ_pnat n = succ_pnat m ↔ n = m := +succ_pnat_injective.eq_iff end nat @@ -67,66 +77,34 @@ open nat subtraction, division and powers. -/ -instance : decidable_eq ℕ+ := λ (a b : ℕ+), by apply_instance - -instance : linear_order ℕ+ := -subtype.linear_order _ - -@[simp] lemma mk_le_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) : - (⟨n, hn⟩ : ℕ+) ≤ ⟨k, hk⟩ ↔ n ≤ k := iff.rfl - -@[simp] lemma mk_lt_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) : - (⟨n, hn⟩ : ℕ+) < ⟨k, hk⟩ ↔ n < k := iff.rfl - -@[simp, norm_cast] lemma coe_le_coe (n k : ℕ+) : (n : ℕ) ≤ k ↔ n ≤ k := iff.rfl - -@[simp, norm_cast] lemma coe_lt_coe (n k : ℕ+) : (n : ℕ) < k ↔ n < k := iff.rfl - -@[simp] theorem pos (n : ℕ+) : 0 < (n : ℕ) := n.2 - --- see note [fact non_instances] -lemma fact_pos (n : ℕ+) : fact (0 < ↑n) := ⟨n.pos⟩ +@[simp, norm_cast] lemma coe_inj {m n : ℕ+} : (m : ℕ) = n ↔ m = n := set_coe.ext_iff -theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n := subtype.eq - -@[simp] lemma coe_inj {m n : ℕ+} : (m : ℕ) = n ↔ m = n := set_coe.ext_iff - -lemma coe_injective : function.injective (coe : ℕ+ → ℕ) := subtype.coe_injective - -@[simp] theorem mk_coe (n h) : ((⟨n, h⟩ : ℕ+) : ℕ) = n := rfl - -instance : has_add ℕ+ := ⟨λ a b, ⟨(a + b : ℕ), add_pos a.pos b.pos⟩⟩ - -instance : add_comm_semigroup ℕ+ := coe_injective.add_comm_semigroup coe (λ _ _, rfl) - -@[simp] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl +@[simp, norm_cast] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl /-- `pnat.coe` promoted to an `add_hom`, that is, a morphism which preserves addition. -/ def coe_add_hom : add_hom ℕ+ ℕ := { to_fun := coe, map_add' := add_coe } -instance : add_left_cancel_semigroup ℕ+ := -coe_injective.add_left_cancel_semigroup coe (λ _ _, rfl) - -instance : add_right_cancel_semigroup ℕ+ := -coe_injective.add_right_cancel_semigroup coe (λ _ _, rfl) +instance : covariant_class ℕ+ ℕ+ (+) (≤) := positive.covariant_class_add_le +instance : covariant_class ℕ+ ℕ+ (+) (<) := positive.covariant_class_add_lt +instance : contravariant_class ℕ+ ℕ+ (+) (≤) := positive.contravariant_class_add_le +instance : contravariant_class ℕ+ ℕ+ (+) (<) := positive.contravariant_class_add_lt -@[priority 10] -instance : covariant_class ℕ+ ℕ+ ((+)) (≤) := -⟨by { rintro ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, simp [←pnat.coe_le_coe] }⟩ +/-- An equivalence between `ℕ+` and `ℕ` given by `pnat.nat_pred` and `nat.succ_pnat`. -/ +@[simps { fully_applied := ff }] def _root_.equiv.pnat_equiv_nat : ℕ+ ≃ ℕ := +{ to_fun := pnat.nat_pred, + inv_fun := nat.succ_pnat, + left_inv := succ_pnat_nat_pred, + right_inv := nat.nat_pred_succ_pnat } -@[simp] theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 := n.2.ne' +/-- The order isomorphism between ℕ and ℕ+ given by `succ`. -/ +@[simps apply { fully_applied := ff }] def _root_.order_iso.pnat_iso_nat : ℕ+ ≃o ℕ := +{ to_equiv := equiv.pnat_equiv_nat, + map_rel_iff' := λ _ _, nat_pred_le_nat_pred } -theorem to_pnat'_coe {n : ℕ} : 0 < n → (n.to_pnat' : ℕ) = n := succ_pred_eq_of_pos - -@[simp] theorem coe_to_pnat' (n : ℕ+) : (n : ℕ).to_pnat' = n := eq (to_pnat'_coe n.pos) - -instance : has_mul ℕ+ := ⟨λ m n, ⟨m.1 * n.1, mul_pos m.2 n.2⟩⟩ -instance : has_one ℕ+ := ⟨succ_pnat 0⟩ -instance : has_pow ℕ+ ℕ := ⟨λ x n, ⟨x ^ n, pow_pos x.2 n⟩⟩ - -instance : comm_monoid ℕ+ := coe_injective.comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) +@[simp] lemma _root_.order_iso.pnat_iso_nat_symm_apply : + ⇑order_iso.pnat_iso_nat.symm = nat.succ_pnat := rfl theorem lt_add_one_iff : ∀ {a b : ℕ+}, a < b + 1 ↔ a ≤ b := λ a b, nat.lt_add_one_iff @@ -134,20 +112,13 @@ theorem lt_add_one_iff : ∀ {a b : ℕ+}, a < b + 1 ↔ a ≤ b := theorem add_one_le_iff : ∀ {a b : ℕ+}, a + 1 ≤ b ↔ a < b := λ a b, nat.add_one_le_iff -@[simp] lemma one_le (n : ℕ+) : (1 : ℕ+) ≤ n := n.2 - -@[simp] lemma not_lt_one (n : ℕ+) : ¬ n < 1 := not_lt_of_le n.one_le - instance : order_bot ℕ+ := { bot := 1, bot_le := λ a, a.property } @[simp] lemma bot_eq_one : (⊥ : ℕ+) = 1 := rfl -instance : inhabited ℕ+ := ⟨1⟩ - -- Some lemmas that rewrite `pnat.mk n h`, for `n` an explicit numeral, into explicit numerals. -@[simp] lemma mk_one {h} : (⟨1, h⟩ : ℕ+) = (1 : ℕ+) := rfl @[simp] lemma mk_bit0 (n) {h} : (⟨bit0 n, h⟩ : ℕ+) = (bit0 ⟨n, pos_of_bit0_pos h⟩ : ℕ+) := rfl @[simp] lemma mk_bit1 (n) {h} {k} : (⟨bit1 n, h⟩ : ℕ+) = (bit1 ⟨n, k⟩ : ℕ+) := rfl @@ -167,8 +138,7 @@ iff.rfl @[simp] lemma bit1_le_bit1 (n m : ℕ+) : (bit1 n) ≤ (bit1 m) ↔ (bit1 (n : ℕ)) ≤ (bit1 (m : ℕ)) := iff.rfl -@[simp] theorem one_coe : ((1 : ℕ+) : ℕ) = 1 := rfl -@[simp] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl +@[simp, norm_cast] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl /-- `pnat.coe` promoted to a `monoid_hom`. -/ def coe_monoid_hom : ℕ+ →* ℕ := @@ -178,45 +148,18 @@ def coe_monoid_hom : ℕ+ →* ℕ := @[simp] lemma coe_coe_monoid_hom : (coe_monoid_hom : ℕ+ → ℕ) = coe := rfl -@[simp] -lemma coe_eq_one_iff {m : ℕ+} : -(m : ℕ) = 1 ↔ m = 1 := by { split; intro h; try { apply pnat.eq}; rw h; simp } +@[simp] lemma le_one_iff {n : ℕ+} : n ≤ 1 ↔ n = 1 := le_bot_iff -@[simp] lemma le_one_iff {n : ℕ+} : - n ≤ 1 ↔ n = 1 := -begin - rcases n with ⟨_|n, hn⟩, - { exact absurd hn (lt_irrefl _) }, - { simp [←pnat.coe_le_coe, subtype.ext_iff, nat.succ_le_succ_iff, nat.succ_inj'], } -end - -lemma lt_add_left (n m : ℕ+) : n < m + n := -begin - rcases m with ⟨_|m, hm⟩, - { exact absurd hm (lt_irrefl _) }, - { simp [←pnat.coe_lt_coe] } -end +lemma lt_add_left (n m : ℕ+) : n < m + n := lt_add_of_pos_left _ m.2 -lemma lt_add_right (n m : ℕ+) : n < n + m := -(lt_add_left n m).trans_le (add_comm _ _).le +lemma lt_add_right (n m : ℕ+) : n < n + m := (lt_add_left n m).trans_eq (add_comm _ _) -@[simp] lemma coe_bit0 (a : ℕ+) : ((bit0 a : ℕ+) : ℕ) = bit0 (a : ℕ) := rfl -@[simp] lemma coe_bit1 (a : ℕ+) : ((bit1 a : ℕ+) : ℕ) = bit1 (a : ℕ) := rfl +@[simp, norm_cast] lemma coe_bit0 (a : ℕ+) : ((bit0 a : ℕ+) : ℕ) = bit0 (a : ℕ) := rfl +@[simp, norm_cast] lemma coe_bit1 (a : ℕ+) : ((bit1 a : ℕ+) : ℕ) = bit1 (a : ℕ) := rfl -@[simp] theorem pow_coe (m : ℕ+) (n : ℕ) : ((m ^ n : ℕ+) : ℕ) = (m : ℕ) ^ n := +@[simp, norm_cast] theorem pow_coe (m : ℕ+) (n : ℕ) : ((m ^ n : ℕ+) : ℕ) = (m : ℕ) ^ n := rfl -instance : ordered_cancel_comm_monoid ℕ+ := -{ mul_le_mul_left := by { intros, apply nat.mul_le_mul_left, assumption }, - le_of_mul_le_mul_left := by { intros a b c h, apply nat.le_of_mul_le_mul_left h a.property, }, - mul_left_cancel := λ a b c h, by - { replace h := congr_arg (coe : ℕ+ → ℕ) h, - exact eq ((nat.mul_right_inj a.pos).mp h)}, - .. pnat.comm_monoid, - .. pnat.linear_order } - -instance : distrib ℕ+ := coe_injective.distrib coe (λ _ _, rfl) (λ _ _, rfl) - /-- Subtraction a - b is defined in the obvious way when a > b, and by a - b = 1 if a ≤ b. -/ @@ -234,13 +177,6 @@ theorem add_sub_of_lt {a b : ℕ+} : a < b → a + (b - a) = b := λ h, eq $ by { rw [add_coe, sub_coe, if_pos h], exact add_tsub_cancel_of_le h.le } -instance : has_well_founded ℕ+ := ⟨(<), measure_wf coe⟩ - -/-- Strong induction on `ℕ+`. -/ -def strong_induction_on {p : ℕ+ → Sort*} : ∀ (n : ℕ+) (h : ∀ k, (∀ m, m < k → p m) → p k), p n -| n := λ IH, IH _ (λ a h, strong_induction_on a IH) -using_well_founded { dec_tac := `[assumption] } - /-- If `n : ℕ+` is different from `1`, then it is the successor of some `k : ℕ+`. -/ lemma exists_eq_succ_of_ne_one : ∀ {n : ℕ+} (h1 : n ≠ 1), ∃ (k : ℕ+), n = k + 1 | ⟨1, _⟩ h1 := false.elim $ h1 rfl @@ -278,17 +214,6 @@ end @pnat.rec_on (n + 1) p p1 hp = hp n (@pnat.rec_on n p p1 hp) := by { cases n with n h, cases n; [exact absurd h dec_trivial, refl] } -/-- We define `m % k` and `m / k` in the same way as for `ℕ` - except that when `m = n * k` we take `m % k = k` and - `m / k = n - 1`. This ensures that `m % k` is always positive - and `m = (m % k) + k * (m / k)` in all cases. Later we - define a function `div_exact` which gives the usual `m / k` - in the case where `k` divides `m`. --/ -def mod_div_aux : ℕ+ → ℕ → ℕ → ℕ+ × ℕ -| k 0 q := ⟨k, q.pred⟩ -| k (r + 1) q := ⟨⟨r + 1, nat.succ_pos r⟩, q⟩ - lemma mod_div_aux_spec : ∀ (k : ℕ+) (r q : ℕ) (h : ¬ (r = 0 ∧ q = 0)), (((mod_div_aux k r q).1 : ℕ) + k * (mod_div_aux k r q).2 = (r + k * q)) | k 0 0 h := (h ⟨rfl, rfl⟩).elim @@ -297,27 +222,6 @@ lemma mod_div_aux_spec : ∀ (k : ℕ+) (r q : ℕ) (h : ¬ (r = 0 ∧ q = 0)), rw [nat.pred_succ, nat.mul_succ, zero_add, add_comm]} | k (r + 1) q h := rfl -/-- `mod_div m k = (m % k, m / k)`. - We define `m % k` and `m / k` in the same way as for `ℕ` - except that when `m = n * k` we take `m % k = k` and - `m / k = n - 1`. This ensures that `m % k` is always positive - and `m = (m % k) + k * (m / k)` in all cases. Later we - define a function `div_exact` which gives the usual `m / k` - in the case where `k` divides `m`. --/ -def mod_div (m k : ℕ+) : ℕ+ × ℕ := mod_div_aux k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ)) - -/-- We define `m % k` in the same way as for `ℕ` - except that when `m = n * k` we take `m % k = k` This ensures that `m % k` is always positive. --/ -def mod (m k : ℕ+) : ℕ+ := (mod_div m k).1 - -/-- We define `m / k` in the same way as for `ℕ` except that when `m = n * k` we take - `m / k = n - 1`. This ensures that `m = (m % k) + k * (m / k)` in all cases. Later we - define a function `div_exact` which gives the usual `m / k` in the case where `k` divides `m`. --/ -def div (m k : ℕ+) : ℕ := (mod_div m k).2 - theorem mod_add_div (m k : ℕ+) : ((mod m k) + k * (div m k) : ℕ) = m := begin let h₀ := nat.mod_add_div (m : ℕ) (k : ℕ), @@ -337,24 +241,6 @@ by { rw mul_comm, exact mod_add_div _ _ } lemma div_add_mod' (m k : ℕ+) : ((div m k) * k + mod m k : ℕ) = m := by { rw mul_comm, exact div_add_mod _ _ } -theorem mod_coe (m k : ℕ+) : - ((mod m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) (k : ℕ) ((m : ℕ) % (k : ℕ)) := -begin - dsimp [mod, mod_div], - cases (m : ℕ) % (k : ℕ), - { rw [if_pos rfl], refl }, - { rw [if_neg n.succ_ne_zero], refl } -end - -theorem div_coe (m k : ℕ+) : - ((div m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) ((m : ℕ) / (k : ℕ)).pred ((m : ℕ) / (k : ℕ)) := -begin - dsimp [div, mod_div], - cases (m : ℕ) % (k : ℕ), - { rw [if_pos rfl], refl }, - { rw [if_neg n.succ_ne_zero], refl } -end - theorem mod_le (m k : ℕ+) : mod m k ≤ m ∧ mod m k ≤ k := begin change ((mod m k) : ℕ) ≤ (m : ℕ) ∧ ((mod m k) : ℕ) ≤ (k : ℕ), @@ -391,10 +277,6 @@ end lemma le_of_dvd {m n : ℕ+} : m ∣ n → m ≤ n := by { rw dvd_iff', intro h, rw ← h, apply (mod_le n m).left } -/-- If `h : k | m`, then `k * (div_exact m k) = m`. Note that this is not equal to `m / k`. -/ -def div_exact (m k : ℕ+) : ℕ+ := - ⟨(div m k).succ, nat.succ_pos _⟩ - theorem mul_div_exact {m k : ℕ+} (h : k ∣ m) : k * (div_exact m k) = m := begin apply eq, rw [mul_coe], @@ -417,15 +299,3 @@ begin end end pnat - -section can_lift - -instance nat.can_lift_pnat : can_lift ℕ ℕ+ := -⟨coe, λ n, 0 < n, λ n hn, ⟨nat.to_pnat' n, pnat.to_pnat'_coe hn⟩⟩ - -instance int.can_lift_pnat : can_lift ℤ ℕ+ := -⟨coe, λ n, 0 < n, λ n hn, ⟨nat.to_pnat' (int.nat_abs n), - by rw [coe_coe, nat.to_pnat'_coe, if_pos (int.nat_abs_pos_of_ne_zero hn.ne'), - int.nat_abs_of_nonneg hn.le]⟩⟩ - -end can_lift diff --git a/src/data/pnat/defs.lean b/src/data/pnat/defs.lean new file mode 100644 index 0000000000000..f08cf158710d0 --- /dev/null +++ b/src/data/pnat/defs.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2017 Microsoft Corporation. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Mario Carneiro, Neil Strickland +-/ +import order.basic +import algebra.ne_zero + +/-! +# The positive natural numbers + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains the definitions, and basic results. +Most algebraic facts are deferred to `data.pnat.basic`, as they need more imports. +-/ + +/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype, + and the VM representation of `ℕ+` is the same as `ℕ` because the proof + is not stored. -/ +@[derive [decidable_eq, linear_order]] +def pnat := {n : ℕ // 0 < n} +notation `ℕ+` := pnat + +instance : has_one ℕ+ := ⟨⟨1, nat.zero_lt_one⟩⟩ + +instance coe_pnat_nat : has_coe ℕ+ ℕ := ⟨subtype.val⟩ +instance : has_repr ℕ+ := ⟨λ n, repr n.1⟩ + +namespace pnat + +@[simp] theorem mk_coe (n h) : ((⟨n, h⟩ : ℕ+) : ℕ) = n := rfl + +/-- Predecessor of a `ℕ+`, as a `ℕ`. -/ +def nat_pred (i : ℕ+) : ℕ := i - 1 + +@[simp] lemma nat_pred_eq_pred {n : ℕ} (h : 0 < n) : nat_pred (⟨n, h⟩ : ℕ+) = n.pred := rfl + +end pnat + +namespace nat + +/-- Convert a natural number to a positive natural number. The + positivity assumption is inferred by `dec_trivial`. -/ +def to_pnat (n : ℕ) (h : 0 < n . tactic.exact_dec_trivial) : ℕ+ := ⟨n, h⟩ + +/-- Write a successor as an element of `ℕ+`. -/ +def succ_pnat (n : ℕ) : ℕ+ := ⟨succ n, succ_pos n⟩ + +@[simp] theorem succ_pnat_coe (n : ℕ) : (succ_pnat n : ℕ) = succ n := rfl + +@[simp] theorem nat_pred_succ_pnat (n : ℕ) : n.succ_pnat.nat_pred = n := rfl + +@[simp] theorem _root_.pnat.succ_pnat_nat_pred (n : ℕ+) : n.nat_pred.succ_pnat = n := +subtype.eq $ succ_pred_eq_of_pos n.2 + +/-- Convert a natural number to a pnat. `n+1` is mapped to itself, + and `0` becomes `1`. -/ +def to_pnat' (n : ℕ) : ℕ+ := succ_pnat (pred n) + +@[simp] theorem to_pnat'_coe : ∀ (n : ℕ), + ((to_pnat' n) : ℕ) = ite (0 < n) n 1 +| 0 := rfl +| (m + 1) := by {rw [if_pos (succ_pos m)], refl} + +end nat + +namespace pnat + +open nat + +/-- We now define a long list of structures on ℕ+ induced by + similar structures on ℕ. Most of these behave in a completely + obvious way, but there are a few things to be said about + subtraction, division and powers. +-/ + +@[simp] lemma mk_le_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) : + (⟨n, hn⟩ : ℕ+) ≤ ⟨k, hk⟩ ↔ n ≤ k := iff.rfl + +@[simp] lemma mk_lt_mk (n k : ℕ) (hn : 0 < n) (hk : 0 < k) : + (⟨n, hn⟩ : ℕ+) < ⟨k, hk⟩ ↔ n < k := iff.rfl + +@[simp, norm_cast] lemma coe_le_coe (n k : ℕ+) : (n : ℕ) ≤ k ↔ n ≤ k := iff.rfl + +@[simp, norm_cast] lemma coe_lt_coe (n k : ℕ+) : (n : ℕ) < k ↔ n < k := iff.rfl + +@[simp] theorem pos (n : ℕ+) : 0 < (n : ℕ) := n.2 + +theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n := subtype.eq + +lemma coe_injective : function.injective (coe : ℕ+ → ℕ) := subtype.coe_injective + +@[simp] theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 := n.2.ne' + +instance _root_.ne_zero.pnat {a : ℕ+} : _root_.ne_zero (a : ℕ) := ⟨a.ne_zero⟩ + +theorem to_pnat'_coe {n : ℕ} : 0 < n → (n.to_pnat' : ℕ) = n := succ_pred_eq_of_pos + +@[simp] theorem coe_to_pnat' (n : ℕ+) : (n : ℕ).to_pnat' = n := eq (to_pnat'_coe n.pos) + +@[simp] lemma one_le (n : ℕ+) : (1 : ℕ+) ≤ n := n.2 + +@[simp] lemma not_lt_one (n : ℕ+) : ¬ n < 1 := not_lt_of_le n.one_le + +instance : inhabited ℕ+ := ⟨1⟩ + +-- Some lemmas that rewrite `pnat.mk n h`, for `n` an explicit numeral, into explicit numerals. +@[simp] lemma mk_one {h} : (⟨1, h⟩ : ℕ+) = (1 : ℕ+) := rfl + +@[norm_cast] theorem one_coe : ((1 : ℕ+) : ℕ) = 1 := rfl + +@[simp, norm_cast] lemma coe_eq_one_iff {m : ℕ+} : (m : ℕ) = 1 ↔ m = 1 := +subtype.coe_injective.eq_iff' one_coe + +instance : has_well_founded ℕ+ := ⟨(<), measure_wf coe⟩ + +/-- Strong induction on `ℕ+`. -/ +def strong_induction_on {p : ℕ+ → Sort*} : ∀ (n : ℕ+) (h : ∀ k, (∀ m, m < k → p m) → p k), p n +| n := λ IH, IH _ (λ a h, strong_induction_on a IH) +using_well_founded { dec_tac := `[assumption] } + +/-- We define `m % k` and `m / k` in the same way as for `ℕ` + except that when `m = n * k` we take `m % k = k` and + `m / k = n - 1`. This ensures that `m % k` is always positive + and `m = (m % k) + k * (m / k)` in all cases. Later we + define a function `div_exact` which gives the usual `m / k` + in the case where `k` divides `m`. +-/ +def mod_div_aux : ℕ+ → ℕ → ℕ → ℕ+ × ℕ +| k 0 q := ⟨k, q.pred⟩ +| k (r + 1) q := ⟨⟨r + 1, nat.succ_pos r⟩, q⟩ + +/-- `mod_div m k = (m % k, m / k)`. + We define `m % k` and `m / k` in the same way as for `ℕ` + except that when `m = n * k` we take `m % k = k` and + `m / k = n - 1`. This ensures that `m % k` is always positive + and `m = (m % k) + k * (m / k)` in all cases. Later we + define a function `div_exact` which gives the usual `m / k` + in the case where `k` divides `m`. +-/ +def mod_div (m k : ℕ+) : ℕ+ × ℕ := mod_div_aux k ((m : ℕ) % (k : ℕ)) ((m : ℕ) / (k : ℕ)) + +/-- We define `m % k` in the same way as for `ℕ` + except that when `m = n * k` we take `m % k = k` This ensures that `m % k` is always positive. +-/ +def mod (m k : ℕ+) : ℕ+ := (mod_div m k).1 + +/-- We define `m / k` in the same way as for `ℕ` except that when `m = n * k` we take + `m / k = n - 1`. This ensures that `m = (m % k) + k * (m / k)` in all cases. Later we + define a function `div_exact` which gives the usual `m / k` in the case where `k` divides `m`. +-/ +def div (m k : ℕ+) : ℕ := (mod_div m k).2 + +theorem mod_coe (m k : ℕ+) : + ((mod m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) (k : ℕ) ((m : ℕ) % (k : ℕ)) := +begin + dsimp [mod, mod_div], + cases (m : ℕ) % (k : ℕ), + { rw [if_pos rfl], refl }, + { rw [if_neg n.succ_ne_zero], refl } +end + +theorem div_coe (m k : ℕ+) : + ((div m k) : ℕ) = ite ((m : ℕ) % (k : ℕ) = 0) ((m : ℕ) / (k : ℕ)).pred ((m : ℕ) / (k : ℕ)) := +begin + dsimp [div, mod_div], + cases (m : ℕ) % (k : ℕ), + { rw [if_pos rfl], refl }, + { rw [if_neg n.succ_ne_zero], refl } +end + +/-- If `h : k | m`, then `k * (div_exact m k) = m`. Note that this is not equal to `m / k`. -/ +def div_exact (m k : ℕ+) : ℕ+ := + ⟨(div m k).succ, nat.succ_pos _⟩ + +end pnat + +section can_lift + +instance nat.can_lift_pnat : can_lift ℕ ℕ+ coe ((<) 0) := +⟨λ n hn, ⟨nat.to_pnat' n, pnat.to_pnat'_coe hn⟩⟩ + +instance int.can_lift_pnat : can_lift ℤ ℕ+ coe ((<) 0) := +⟨λ n hn, ⟨nat.to_pnat' (int.nat_abs n), + by rw [coe_coe, nat.to_pnat'_coe, if_pos (int.nat_abs_pos_of_ne_zero hn.ne'), + int.nat_abs_of_nonneg hn.le]⟩⟩ + +end can_lift diff --git a/src/data/pnat/factors.lean b/src/data/pnat/factors.lean index 25049173cd3ec..805954aae0c34 100644 --- a/src/data/pnat/factors.lean +++ b/src/data/pnat/factors.lean @@ -3,12 +3,18 @@ Copyright (c) 2019 Neil Strickland. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Neil Strickland -/ + +import algebra.big_operators.multiset.basic import data.pnat.prime +import data.nat.factors import data.multiset.sort /-! # Prime factors of nonzero naturals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines the factorization of a nonzero natural number `n` as a multiset of primes, the multiplicity of `p` in this factors multiset being the p-adic valuation of `n`. @@ -21,12 +27,15 @@ the multiplicity of `p` in this factors multiset being the p-adic valuation of ` /-- The type of multisets of prime numbers. Unique factorization gives an equivalence between this set and ℕ+, as we will formalize below. -/ - @[derive [inhabited, has_repr, canonically_ordered_add_monoid, distrib_lattice, +@[derive [inhabited, canonically_ordered_add_monoid, distrib_lattice, semilattice_sup, order_bot, has_sub, has_ordered_sub]] def prime_multiset := multiset nat.primes namespace prime_multiset +-- `@[derive]` doesn't work for `meta` instances +meta instance : has_repr prime_multiset := by delta prime_multiset; apply_instance + /-- The multiset consisting of a single prime -/ def of_prime (p : nat.primes) : prime_multiset := ({p} : multiset nat.primes) @@ -55,7 +64,7 @@ def coe_nat_monoid_hom : prime_multiset →+ multiset ℕ := (coe_nat_monoid_hom : prime_multiset → multiset ℕ) = coe := rfl theorem coe_nat_injective : function.injective (coe : prime_multiset → multiset ℕ) := -multiset.map_injective nat.primes.coe_nat_inj +multiset.map_injective nat.primes.coe_nat_injective theorem coe_nat_of_prime (p : nat.primes) : ((of_prime p) : multiset ℕ) = {p} := rfl @@ -81,10 +90,10 @@ def coe_pnat_monoid_hom : prime_multiset →+ multiset ℕ+ := (coe_pnat_monoid_hom : prime_multiset → multiset ℕ+) = coe := rfl theorem coe_pnat_injective : function.injective (coe : prime_multiset → multiset ℕ+) := -multiset.map_injective nat.primes.coe_pnat_inj +multiset.map_injective nat.primes.coe_pnat_injective theorem coe_pnat_of_prime (p : nat.primes) : -((of_prime p) : multiset ℕ+) = {(p : ℕ+)} := rfl + ((of_prime p) : multiset ℕ+) = {(p : ℕ+)} := rfl theorem coe_pnat_prime (v : prime_multiset) (p : ℕ+) (h : p ∈ (v : multiset ℕ+)) : p.prime := @@ -339,14 +348,14 @@ theorem count_factor_multiset (m : ℕ+) (p : nat.primes) (k : ℕ) : (p : ℕ+) ^ k ∣ m ↔ k ≤ m.factor_multiset.count p := begin intros, - rw [multiset.le_count_iff_repeat_le], + rw [multiset.le_count_iff_replicate_le], rw [← factor_multiset_le_iff, factor_multiset_pow, factor_multiset_of_prime], congr' 2, - apply multiset.eq_repeat.mpr, + apply multiset.eq_replicate.mpr, split, { rw [multiset.card_nsmul, prime_multiset.card_of_prime, mul_one] }, { intros q h, rw [prime_multiset.of_prime, multiset.nsmul_singleton _ k] at h, - exact multiset.eq_of_mem_repeat h } + exact multiset.eq_of_mem_replicate h } end end pnat diff --git a/src/data/pnat/find.lean b/src/data/pnat/find.lean index a1828db9d89eb..80ba4eafd2f56 100644 --- a/src/data/pnat/find.lean +++ b/src/data/pnat/find.lean @@ -8,6 +8,9 @@ import data.pnat.basic /-! # Explicit least witnesses to existentials on positive natural numbers +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Implemented via calling out to `nat.find`. -/ diff --git a/src/data/pnat/interval.lean b/src/data/pnat/interval.lean index 937de50f0455c..4b6737613cc9f 100644 --- a/src/data/pnat/interval.lean +++ b/src/data/pnat/interval.lean @@ -4,16 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yaël Dillies -/ import data.nat.interval -import data.pnat.basic +import data.pnat.defs /-! # Finite intervals of positive naturals +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file proves that `ℕ+` is a `locally_finite_order` and calculates the cardinality of its intervals as finsets and fintypes. -/ -open finset pnat +open finset function pnat instance : locally_finite_order ℕ+ := subtype.locally_finite_order _ @@ -24,19 +27,23 @@ lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).subtype (λ (n : ℕ), lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl +lemma uIcc_eq_finset_subtype : uIcc a b = (uIcc (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl -lemma map_subtype_embedding_Icc : (Icc a b).map (function.embedding.subtype _) = Icc (a : ℕ) b := +lemma map_subtype_embedding_Icc : (Icc a b).map (embedding.subtype _) = Icc a b := map_subtype_embedding_Icc _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx) -lemma map_subtype_embedding_Ico : (Ico a b).map (function.embedding.subtype _) = Ico (a : ℕ) b := +lemma map_subtype_embedding_Ico : (Ico a b).map (embedding.subtype _) = Ico a b := map_subtype_embedding_Ico _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx) -lemma map_subtype_embedding_Ioc : (Ioc a b).map (function.embedding.subtype _) = Ioc (a : ℕ) b := +lemma map_subtype_embedding_Ioc : (Ioc a b).map (embedding.subtype _) = Ioc a b := map_subtype_embedding_Ioc _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx) -lemma map_subtype_embedding_Ioo : (Ioo a b).map (function.embedding.subtype _) = Ioo (a : ℕ) b := +lemma map_subtype_embedding_Ioo : (Ioo a b).map (embedding.subtype _) = Ioo a b := map_subtype_embedding_Ioo _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx) +lemma map_subtype_embedding_uIcc : (uIcc a b).map (embedding.subtype _) = uIcc a b := +map_subtype_embedding_Icc _ _ + @[simp] lemma card_Icc : (Icc a b).card = b + 1 - a := by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map] @@ -49,6 +56,9 @@ by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map] @[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 := by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map] +@[simp] lemma card_uIcc : (uIcc a b).card = (b - a : ℤ).nat_abs + 1 := +by rw [coe_coe, coe_coe, ←nat.card_uIcc, ←map_subtype_embedding_uIcc, card_map] + @[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a := by rw [←card_Icc, fintype.card_of_finset] @@ -61,4 +71,7 @@ by rw [←card_Ioc, fintype.card_of_finset] @[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 := by rw [←card_Ioo, fintype.card_of_finset] +@[simp] lemma card_fintype_uIcc : fintype.card (set.uIcc a b) = (b - a : ℤ).nat_abs + 1 := +by rw [←card_uIcc, fintype.card_of_finset] + end pnat diff --git a/src/data/pnat/prime.lean b/src/data/pnat/prime.lean index fcd0e6f6fe8c1..4db050a84b83c 100644 --- a/src/data/pnat/prime.lean +++ b/src/data/pnat/prime.lean @@ -9,6 +9,9 @@ import data.pnat.basic /-! # Primality and GCD on pnat +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file extends the theory of `ℕ+` with `gcd`, `lcm` and `prime` functions, analogous to those on `nat`. -/ @@ -16,14 +19,14 @@ This file extends the theory of `ℕ+` with `gcd`, `lcm` and `prime` functions, namespace nat.primes instance coe_pnat : has_coe nat.primes ℕ+ := ⟨λ p, ⟨(p : ℕ), p.property.pos⟩⟩ -theorem coe_pnat_nat (p : nat.primes) : ((p : ℕ+) : ℕ) = p := rfl -theorem coe_pnat_inj (p q : nat.primes) : (p : ℕ+) = (q : ℕ+) → p = q := λ h, -begin - replace h : ((p : ℕ+) : ℕ) = ((q : ℕ+) : ℕ) := congr_arg subtype.val h, - rw [coe_pnat_nat, coe_pnat_nat] at h, - exact subtype.eq h, -end +@[norm_cast] theorem coe_pnat_nat (p : nat.primes) : ((p : ℕ+) : ℕ) = p := rfl + +theorem coe_pnat_injective : function.injective (coe : nat.primes → ℕ+) := +λ p q h, subtype.ext (congr_arg subtype.val h : _) + +@[norm_cast] theorem coe_pnat_inj (p q : nat.primes) : (p : ℕ+) = (q : ℕ+) ↔ p = q := +coe_pnat_injective.eq_iff end nat.primes @@ -43,9 +46,9 @@ def lcm (n m : ℕ+) : ℕ+ := rw [← gcd_mul_lcm (n : ℕ) (m : ℕ), mul_comm] at h, exact pos_of_dvd_of_pos (dvd.intro (nat.gcd (n : ℕ) (m : ℕ)) rfl) h }⟩ -@[simp] theorem gcd_coe (n m : ℕ+) : ((gcd n m) : ℕ) = nat.gcd n m := rfl +@[simp, norm_cast] theorem gcd_coe (n m : ℕ+) : ((gcd n m) : ℕ) = nat.gcd n m := rfl -@[simp] theorem lcm_coe (n m : ℕ+) : ((lcm n m) : ℕ) = nat.lcm n m := rfl +@[simp, norm_cast] theorem lcm_coe (n m : ℕ+) : ((lcm n m) : ℕ) = nat.lcm n m := rfl theorem gcd_dvd_left (n m : ℕ+) : (gcd n m) ∣ n := dvd_iff.2 (nat.gcd_dvd_left (n : ℕ) (m : ℕ)) @@ -107,7 +110,7 @@ section coprime /-- Two pnats are coprime if their gcd is 1. -/ def coprime (m n : ℕ+) : Prop := m.gcd n = 1 -@[simp] +@[simp, norm_cast] lemma coprime_coe {m n : ℕ+} : nat.coprime ↑m ↑n ↔ m.coprime n := by { unfold coprime, unfold nat.coprime, rw ← coe_inj, simp } diff --git a/src/data/pnat/xgcd.lean b/src/data/pnat/xgcd.lean index c12bd5ca12848..eadc47c825a89 100644 --- a/src/data/pnat/xgcd.lean +++ b/src/data/pnat/xgcd.lean @@ -9,6 +9,9 @@ import data.pnat.prime /-! # Euclidean algorithm for ℕ +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file sets up a version of the Euclidean algorithm that only works with natural numbers. Given `0 < a, b`, it computes the unique `(w, x, y, z, d)` such that the following identities hold: * `a = (w + x) d` @@ -108,8 +111,7 @@ end def is_reduced : Prop := u.ap = u.bp def is_reduced' : Prop := u.a = u.b -theorem is_reduced_iff : u.is_reduced ↔ u.is_reduced' := -⟨ congr_arg succ_pnat, succ_pnat_inj ⟩ +theorem is_reduced_iff : u.is_reduced ↔ u.is_reduced' := succ_pnat_inj.symm def flip : xgcd_type := { wp := u.zp, x := u.y, y := u.x, zp := u.wp, ap := u.bp, bp := u.ap } diff --git a/src/data/polynomial/algebra_map.lean b/src/data/polynomial/algebra_map.lean index e91fee5d30a3a..d746a42084401 100644 --- a/src/data/polynomial/algebra_map.lean +++ b/src/data/polynomial/algebra_map.lean @@ -3,13 +3,17 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ +import algebra.algebra.pi import ring_theory.adjoin.basic import data.polynomial.eval /-! # Theory of univariate polynomials -We show that `polynomial A` is an R-algebra when `A` is an R-algebra. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +We show that `A[X]` is an R-algebra when `A` is an R-algebra. We promote `eval₂` to an algebra hom in `aeval`. -/ @@ -28,7 +32,7 @@ variables [comm_semiring R] {p q r : R[X]} variables [semiring A] [algebra R A] /-- Note that this instance also provides `algebra R R[X]`. -/ -instance algebra_of_algebra : algebra R (polynomial A) := +instance algebra_of_algebra : algebra R A[X] := { smul_def' := λ r p, to_finsupp_injective $ begin dsimp only [ring_hom.to_fun_eq_coe, ring_hom.comp_apply], rw [to_finsupp_smul, to_finsupp_mul, to_finsupp_C], @@ -42,15 +46,15 @@ instance algebra_of_algebra : algebra R (polynomial A) := to_ring_hom := C.comp (algebra_map R A) } lemma algebra_map_apply (r : R) : - algebra_map R (polynomial A) r = C (algebra_map R A r) := + algebra_map R A[X] r = C (algebra_map R A r) := rfl @[simp] lemma to_finsupp_algebra_map (r : R) : - (algebra_map R (polynomial A) r).to_finsupp = algebra_map R _ r := + (algebra_map R A[X] r).to_finsupp = algebra_map R _ r := show to_finsupp (C (algebra_map _ _ r)) = _, by { rw to_finsupp_C, refl } lemma of_finsupp_algebra_map (r : R) : - (⟨algebra_map R _ r⟩ : A[X]) = algebra_map R (polynomial A) r := + (⟨algebra_map R _ r⟩ : A[X]) = algebra_map R A[X] r := to_finsupp_injective (to_finsupp_algebra_map _).symm /-- @@ -66,19 +70,19 @@ rfl variables {R} /-- - Extensionality lemma for algebra maps out of `polynomial A'` over a smaller base ring than `A'` + Extensionality lemma for algebra maps out of `A'[X]` over a smaller base ring than `A'` -/ @[ext] lemma alg_hom_ext' [algebra R A'] [algebra R B'] {f g : A'[X] →ₐ[R] B'} - (h₁ : f.comp (is_scalar_tower.to_alg_hom R A' (polynomial A')) = - g.comp (is_scalar_tower.to_alg_hom R A' (polynomial A'))) + (h₁ : f.comp (is_scalar_tower.to_alg_hom R A' A'[X]) = + g.comp (is_scalar_tower.to_alg_hom R A' A'[X])) (h₂ : f X = g X) : f = g := alg_hom.coe_ring_hom_injective (polynomial.ring_hom_ext' (congr_arg alg_hom.to_ring_hom h₁) h₂) variable (R) -/-- Algebra isomorphism between `polynomial R` and `add_monoid_algebra R ℕ`. This is just an +/-- Algebra isomorphism between `R[X]` and `add_monoid_algebra R ℕ`. This is just an implementation detail, but it can be useful to transfer results from `finsupp` to polynomials. -/ @[simps] def to_finsupp_iso_alg : R[X] ≃ₐ[R] add_monoid_algebra R ℕ := @@ -91,7 +95,7 @@ def to_finsupp_iso_alg : R[X] ≃ₐ[R] add_monoid_algebra R ℕ := variable {R} -instance [nontrivial A] : nontrivial (subalgebra R (polynomial A)) := +instance [nontrivial A] : nontrivial (subalgebra R A[X]) := ⟨⟨⊥, ⊤, begin rw [ne.def, set_like.ext_iff, not_forall], refine ⟨X, _⟩, @@ -110,7 +114,7 @@ lemma alg_hom_eval₂_algebra_map f (eval₂ (algebra_map R A) a p) = eval₂ (algebra_map R B) (f a) p := begin dsimp [eval₂, sum], - simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast, + simp only [f.map_sum, f.map_mul, f.map_pow, eq_int_cast, map_int_cast, alg_hom.commutes], end @@ -119,9 +123,9 @@ lemma eval₂_algebra_map_X {R A : Type*} [comm_semiring R] [semiring A] [algebr (p : R[X]) (f : R[X] →ₐ[R] A) : eval₂ (algebra_map R A) (f X) p = f p := begin - conv_rhs { rw [←polynomial.sum_C_mul_X_eq p], }, + conv_rhs { rw [←polynomial.sum_C_mul_X_pow_eq p], }, dsimp [eval₂, sum], - simp only [f.map_sum, f.map_mul, f.map_pow, ring_hom.eq_int_cast, ring_hom.map_int_cast], + simp only [f.map_sum, f.map_mul, f.map_pow, eq_int_cast, map_int_cast], simp [polynomial.C_eq_algebra_map], end @@ -160,7 +164,7 @@ variables {R A} begin refine top_unique (λ p hp, _), set S := algebra.adjoin R ({X} : set R[X]), - rw [← sum_monomial_eq p], simp only [monomial_eq_smul_X, sum], + rw [← sum_monomial_eq p], simp only [← smul_X_eq_monomial, sum], exact S.sum_mem (λ n hn, S.smul_mem (S.pow_mem (algebra.subset_adjoin rfl) _) _) end @@ -204,42 +208,42 @@ lemma aeval_comp {A : Type*} [comm_semiring A] [algebra R A] (x : A) : aeval x (p.comp q) = (aeval (aeval x q) p) := eval₂_comp (algebra_map R A) -@[simp] lemma aeval_map {A : Type*} [comm_semiring A] [algebra R A] [algebra A B] - [is_scalar_tower R A B] (b : B) (p : R[X]) : - aeval b (p.map (algebra_map R A)) = aeval b p := -by rw [aeval_def, eval₂_map, ←is_scalar_tower.algebra_map_eq, ←aeval_def] - theorem aeval_alg_hom (f : A →ₐ[R] B) (x : A) : aeval (f x) = f.comp (aeval x) := alg_hom_ext $ by simp only [aeval_X, alg_hom.comp_apply] @[simp] theorem aeval_X_left : aeval (X : R[X]) = alg_hom.id R R[X] := alg_hom_ext $ aeval_X X +theorem aeval_X_left_apply (p : R[X]) : aeval X p = p := +alg_hom.congr_fun (@aeval_X_left R _) p + theorem eval_unique (φ : R[X] →ₐ[R] A) (p) : φ p = eval₂ (algebra_map R A) (φ X) p := by rw [← aeval_def, aeval_alg_hom, aeval_X_left, alg_hom.comp_id] -theorem aeval_alg_hom_apply (f : A →ₐ[R] B) (x : A) (p : R[X]) : +theorem aeval_alg_hom_apply {F : Type*} [alg_hom_class F R A B] (f : F) (x : A) (p : R[X]) : aeval (f x) p = f (aeval x p) := -alg_hom.ext_iff.1 (aeval_alg_hom f x) p +begin + refine polynomial.induction_on p (by simp) (λ p q hp hq, _) (by simp), + rw [map_add, hp, hq, ← map_add, ← map_add] +end theorem aeval_alg_equiv (f : A ≃ₐ[R] B) (x : A) : aeval (f x) = (f : A →ₐ[R] B).comp (aeval x) := aeval_alg_hom (f : A →ₐ[R] B) x -theorem aeval_alg_equiv_apply (f : A ≃ₐ[R] B) (x : A) (p : R[X]) : - aeval (f x) p = f (aeval x p) := -aeval_alg_hom_apply (f : A →ₐ[R] B) x p - -lemma aeval_algebra_map_apply (x : R) (p : R[X]) : +lemma aeval_algebra_map_apply_eq_algebra_map_eval (x : R) (p : R[X]) : aeval (algebra_map R A x) p = algebra_map R A (p.eval x) := aeval_alg_hom_apply (algebra.of_id R A) x p -@[simp] lemma coe_aeval_eq_eval (r : R) : - (aeval r : R[X] → R) = eval r := rfl +@[simp] lemma coe_aeval_eq_eval (r : R) : (aeval r : R[X] → R) = eval r := rfl + +@[simp] lemma coe_aeval_eq_eval_ring_hom (x : R) : + ((aeval x : R[X] →ₐ[R] R) : R[X] →+* R) = eval_ring_hom x := +rfl @[simp] lemma aeval_fn_apply {X : Type*} (g : R[X]) (f : X → R) (x : X) : ((aeval f) g) x = aeval (f x) g := -(aeval_alg_hom_apply (pi.eval_alg_hom _ _ x) f g).symm +(aeval_alg_hom_apply (pi.eval_alg_hom R (λ _, R) x) f g).symm @[norm_cast] lemma aeval_subalgebra_coe (g : R[X]) {A : Type*} [semiring A] [algebra R A] (s : subalgebra R A) (f : s) : @@ -253,6 +257,22 @@ lemma coeff_zero_eq_aeval_zero' (p : R[X]) : algebra_map R A (p.coeff 0) = aeval (0 : A) p := by simp [aeval_def] +lemma map_aeval_eq_aeval_map {S T U : Type*} [comm_semiring S] [comm_semiring T] [semiring U] + [algebra R S] [algebra T U] {φ : R →+* T} {ψ : S →+* U} + (h : (algebra_map T U).comp φ = ψ.comp (algebra_map R S)) (p : R[X]) (a : S) : + ψ (aeval a p) = aeval (ψ a) (p.map φ) := +begin + conv_rhs {rw [aeval_def, ← eval_map]}, + rw [map_map, h, ← map_map, eval_map, eval₂_at_apply, aeval_def, eval_map], +end + +lemma aeval_eq_zero_of_dvd_aeval_eq_zero [comm_semiring S] [comm_semiring T] [algebra S T] + {p q : S[X]} (h₁ : p ∣ q) {a : T} (h₂ : aeval a p = 0) : aeval a q = 0 := +begin + rw [aeval_def, ← eval_map] at h₂ ⊢, + exact eval_eq_zero_of_dvd_of_eval_eq_zero (polynomial.map_dvd (algebra_map S T) h₁) h₂, +end + variable (R) theorem _root_.algebra.adjoin_singleton_eq_range_aeval (x : A) : @@ -261,9 +281,9 @@ by rw [← algebra.map_top, ← adjoin_X, alg_hom.map_adjoin, set.image_singleto variable {R} -section comm_semiring +section semiring -variables [comm_semiring S] {f : R →+* S} +variables [semiring S] {f : R →+* S} lemma aeval_eq_sum_range [algebra R S] {p : R[X]} (x : S) : aeval x p = ∑ i in finset.range (p.nat_degree + 1), p.coeff i • x ^ i := @@ -286,11 +306,15 @@ lemma is_root_of_aeval_algebra_map_eq_zero [algebra R S] {p : R[X]} {r : R} (hr : aeval (algebra_map R S r) p = 0) : p.is_root r := is_root_of_eval₂_map_eq_zero inj hr +end semiring + +section comm_semiring + section aeval_tower -variables [algebra S R] [algebra S A'] [algebra S B'] +variables [comm_semiring S] [algebra S R] [algebra S A'] [algebra S B'] -/-- Version of `aeval` for defining algebra homs out of `polynomial R` over a smaller base ring +/-- Version of `aeval` for defining algebra homs out of `R[X]` over a smaller base ring than `R`. -/ def aeval_tower (f : R →ₐ[S] A') (x : A') : R[X] →ₐ[S] A' := { commutes' := λ r, by simp [algebra_map_apply], @@ -375,7 +399,7 @@ begin have bound := calc (p * (X - C r)).nat_degree ≤ p.nat_degree + (X - C r).nat_degree : nat_degree_mul_le - ... ≤ p.nat_degree + 1 : add_le_add_left nat_degree_X_sub_C_le _ + ... ≤ p.nat_degree + 1 : add_le_add_left (nat_degree_X_sub_C_le _) _ ... < p.nat_degree + 2 : lt_add_one _, rw sum_over_range' _ _ (p.nat_degree + 2) bound, swap, @@ -388,7 +412,7 @@ begin end theorem not_is_unit_X_sub_C [nontrivial R] (r : R) : ¬ is_unit (X - C r) := -λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $ by erw [← eval_mul_X_sub_C, hgf, eval_one] +λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, zero_ne_one' R $ by erw [← eval_mul_X_sub_C, hgf, eval_one] end ring diff --git a/src/data/polynomial/basic.lean b/src/data/polynomial/basic.lean index 365d9a8183f45..09b1dd24f7c12 100644 --- a/src/data/polynomial/basic.lean +++ b/src/data/polynomial/basic.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ import algebra.monoid_algebra.basic +import data.finset.sort /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file defines `polynomial R`, the type of univariate polynomials over the semiring `R`, builds a semiring structure on it, and gives basic definitions that are expanded in other files in this directory. @@ -32,7 +36,7 @@ the polynomials. For instance, Polynomials are defined using `add_monoid_algebra R ℕ`, where `R` is a semiring. The variable `X` commutes with every polynomial `p`: lemma `X_mul` proves the identity -`X * p = `p * X`. The relationship to `add_monoid_algebra R ℕ` is through a structure +`X * p = p * X`. The relationship to `add_monoid_algebra R ℕ` is through a structure to make polynomials irreducible from the point of view of the kernel. Most operations are irreducible since Lean can not compute anyway with `add_monoid_algebra`. There are two exceptions that we make semireducible: @@ -40,7 +44,7 @@ exceptions that we make semireducible: * The scalar action, to permit typeclass search to unfold it to resolve potential instance diamonds. -The raw implementation of the equivalence between `polynomial R` and `add_monoid_algebra R ℕ` is +The raw implementation of the equivalence between `R[X]` and `add_monoid_algebra R ℕ` is done through `of_finsupp` and `to_finsupp` (or, equivalently, `rcases p` when `p` is a polynomial gives an element `q` of `add_monoid_algebra R ℕ`, and conversely `⟨q⟩` gives back `p`). The equivalence is also registered as a ring equiv in `polynomial.to_finsupp_iso`. These should @@ -56,8 +60,9 @@ The embedding from `R` is called `C`. -/ structure polynomial (R : Type*) [semiring R] := of_finsupp :: (to_finsupp : add_monoid_algebra R ℕ) -localized "notation R`[X]`:9000 := polynomial R" in polynomial -open finsupp add_monoid_algebra +localized "notation (name := polynomial) R`[X]`:9000 := polynomial R" in polynomial + +open add_monoid_algebra finsupp function open_locale big_operators polynomial namespace polynomial @@ -75,16 +80,16 @@ lemma exists_iff_exists_finsupp (P : R[X] → Prop) : (∃ p, P p) ↔ ∃ (q : add_monoid_algebra R ℕ), P ⟨q⟩ := ⟨λ ⟨⟨p⟩, hp⟩, ⟨p, hp⟩, λ ⟨q, hq⟩, ⟨⟨q⟩, hq⟩ ⟩ +@[simp] lemma eta (f : R[X]) : polynomial.of_finsupp f.to_finsupp = f := by cases f; refl + /-! ### Conversions to and from `add_monoid_algebra` -Since `polynomial R` is not defeq to `add_monoid_algebra R ℕ`, but instead is a structure wrapping +Since `R[X]` is not defeq to `add_monoid_algebra R ℕ`, but instead is a structure wrapping it, we have to copy across all the arithmetic operators manually, along with the lemmas about how they unfold around `polynomial.of_finsupp` and `polynomial.to_finsupp`. -/ section add_monoid_algebra -/-- The function version of `monomial`. Use `monomial` instead of this one. -/ -@[irreducible] def monomial_fun (n : ℕ) (a : R) : R[X] := ⟨finsupp.single n a⟩ @[irreducible] private def add : R[X] → R[X] → R[X] | ⟨a⟩ ⟨b⟩ := ⟨a + b⟩ @[irreducible] private def neg {R : Type u} [ring R] : R[X] → R[X] @@ -93,25 +98,19 @@ section add_monoid_algebra | ⟨a⟩ ⟨b⟩ := ⟨a * b⟩ instance : has_zero R[X] := ⟨⟨0⟩⟩ -instance : has_one R[X] := ⟨monomial_fun 0 (1 : R)⟩ +instance : has_one R[X] := ⟨⟨1⟩⟩ instance : has_add R[X] := ⟨add⟩ instance {R : Type u} [ring R] : has_neg R[X] := ⟨neg⟩ instance {R : Type u} [ring R] : has_sub R[X] := ⟨λ a b, a + -b⟩ instance : has_mul R[X] := ⟨mul⟩ -instance {S : Type*} [monoid S] [distrib_mul_action S R] : has_scalar S R[X] := -⟨λ r p, ⟨r • p.to_finsupp⟩⟩ +instance {S : Type*} [smul_zero_class S R] : smul_zero_class S R[X] := +{ smul := λ r p, ⟨r • p.to_finsupp⟩, + smul_zero := λ a, congr_arg of_finsupp (smul_zero a) } @[priority 1] -- to avoid a bug in the `ring` tactic instance has_pow : has_pow R[X] ℕ := { pow := λ p n, npow_rec n p } -@[simp] lemma of_finsupp_zero : (⟨0⟩ : R[X]) = 0 := -rfl - -@[simp] lemma of_finsupp_one : (⟨1⟩ : R[X]) = 1 := -begin - change (⟨1⟩ : R[X]) = monomial_fun 0 (1 : R), - rw [monomial_fun], - refl -end +@[simp] lemma of_finsupp_zero : (⟨0⟩ : R[X]) = 0 := rfl +@[simp] lemma of_finsupp_one : (⟨1⟩ : R[X]) = 1 := rfl @[simp] lemma of_finsupp_add {a b} : (⟨a + b⟩ : R[X]) = ⟨a⟩ + ⟨b⟩ := show _ = add _ _, by rw add @[simp] lemma of_finsupp_neg {R : Type u} [ring R] {a} : (⟨-a⟩ : R[X]) = -⟨a⟩ := @@ -119,7 +118,7 @@ show _ = neg _, by rw neg @[simp] lemma of_finsupp_sub {R : Type u} [ring R] {a b} : (⟨a - b⟩ : R[X]) = ⟨a⟩ - ⟨b⟩ := by { rw [sub_eq_add_neg, of_finsupp_add, of_finsupp_neg], refl } @[simp] lemma of_finsupp_mul (a b) : (⟨a * b⟩ : R[X]) = ⟨a⟩ * ⟨b⟩ := show _ = mul _ _, by rw mul -@[simp] lemma of_finsupp_smul {S : Type*} [monoid S] [distrib_mul_action S R] (a : S) (b) : +@[simp] lemma of_finsupp_smul {S : Type*} [smul_zero_class S R] (a : S) (b) : (⟨a • b⟩ : R[X]) = (a • ⟨b⟩ : R[X]) := rfl @[simp] lemma of_finsupp_pow (a) (n : ℕ) : (⟨a ^ n⟩ : R[X]) = ⟨a⟩ ^ n := begin @@ -133,12 +132,7 @@ end @[simp] lemma to_finsupp_zero : (0 : R[X]).to_finsupp = 0 := rfl -@[simp] lemma to_finsupp_one : (1 : R[X]).to_finsupp = 1 := -begin - change to_finsupp (monomial_fun _ _) = _, - rw monomial_fun, - refl, -end +@[simp] lemma to_finsupp_one : (1 : R[X]).to_finsupp = 1 := rfl @[simp] lemma to_finsupp_add (a b : R[X]) : (a + b).to_finsupp = a.to_finsupp + b.to_finsupp := by { cases a, cases b, rw ←of_finsupp_add } @@ -149,7 +143,7 @@ by { cases a, rw ←of_finsupp_neg } by { rw [sub_eq_add_neg, ←to_finsupp_neg, ←to_finsupp_add], refl } @[simp] lemma to_finsupp_mul (a b : R[X]) : (a * b).to_finsupp = a.to_finsupp * b.to_finsupp := by { cases a, cases b, rw ←of_finsupp_mul } -@[simp] lemma to_finsupp_smul {S : Type*} [monoid S] [distrib_mul_action S R] (a : S) (b : R[X]) : +@[simp] lemma to_finsupp_smul {S : Type*} [smul_zero_class S R] (a : S) (b : R[X]) : (a • b).to_finsupp = a • b.to_finsupp := rfl @[simp] lemma to_finsupp_pow (a : R[X]) (n : ℕ) : (a ^ n).to_finsupp = a.to_finsupp ^ n := by { cases a, rw ←of_finsupp_pow } @@ -182,32 +176,43 @@ by rw [←of_finsupp_one, of_finsupp_inj] instance : inhabited R[X] := ⟨0⟩ +instance : has_nat_cast R[X] := ⟨λ n, polynomial.of_finsupp n⟩ + instance : semiring R[X] := function.injective.semiring to_finsupp to_finsupp_injective to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul - (λ _ _, to_finsupp_smul _ _) to_finsupp_pow + (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl) + +instance {S} [distrib_smul S R] : distrib_smul S R[X] := +function.injective.distrib_smul ⟨to_finsupp, to_finsupp_zero, to_finsupp_add⟩ +to_finsupp_injective to_finsupp_smul instance {S} [monoid S] [distrib_mul_action S R] : distrib_mul_action S R[X] := function.injective.distrib_mul_action ⟨to_finsupp, to_finsupp_zero, to_finsupp_add⟩ to_finsupp_injective to_finsupp_smul -instance {S} [monoid S] [distrib_mul_action S R] [has_faithful_scalar S R] : - has_faithful_scalar S R[X] := +instance {S} [smul_zero_class S R] [has_faithful_smul S R] : + has_faithful_smul S R[X] := { eq_of_smul_eq_smul := λ s₁ s₂ h, eq_of_smul_eq_smul $ λ a : ℕ →₀ R, congr_arg to_finsupp (h ⟨a⟩) } instance {S} [semiring S] [module S R] : module S R[X] := function.injective.module _ ⟨to_finsupp, to_finsupp_zero, to_finsupp_add⟩ to_finsupp_injective to_finsupp_smul -instance {S₁ S₂} [monoid S₁] [monoid S₂] [distrib_mul_action S₁ R] [distrib_mul_action S₂ R] +instance {S₁ S₂} [smul_zero_class S₁ R] [smul_zero_class S₂ R] [smul_comm_class S₁ S₂ R] : smul_comm_class S₁ S₂ R[X] := ⟨by { rintros _ _ ⟨⟩, simp_rw [←of_finsupp_smul, smul_comm] }⟩ -instance {S₁ S₂} [has_scalar S₁ S₂] [monoid S₁] [monoid S₂] [distrib_mul_action S₁ R] - [distrib_mul_action S₂ R] [is_scalar_tower S₁ S₂ R] : is_scalar_tower S₁ S₂ R[X] := +instance {S₁ S₂} [has_smul S₁ S₂] [smul_zero_class S₁ R] [smul_zero_class S₂ R] + [is_scalar_tower S₁ S₂ R] : is_scalar_tower S₁ S₂ R[X] := ⟨by { rintros _ _ ⟨⟩, simp_rw [←of_finsupp_smul, smul_assoc] }⟩ -instance {S} [monoid S] [distrib_mul_action S R] [distrib_mul_action Sᵐᵒᵖ R] +instance is_scalar_tower_right {α K : Type*} [semiring K] [distrib_smul α K] + [is_scalar_tower α K K] : is_scalar_tower α K[X] K[X] := +⟨by rintros _ ⟨⟩ ⟨⟩; + simp_rw [smul_eq_mul, ← of_finsupp_smul, ← of_finsupp_mul, ← of_finsupp_smul, smul_mul_assoc]⟩ + +instance {S} [smul_zero_class S R] [smul_zero_class Sᵐᵒᵖ R] [is_central_scalar S R] : is_central_scalar S R[X] := ⟨by { rintros _ ⟨⟩, simp_rw [←of_finsupp_smul, op_smul_eq_smul] }⟩ @@ -261,17 +266,17 @@ by simp /-- `monomial s a` is the monomial `a * X^s` -/ def monomial (n : ℕ) : R →ₗ[R] R[X] := -{ to_fun := monomial_fun n, - map_add' := by simp [monomial_fun], - map_smul' := by simp [monomial_fun, ←of_finsupp_smul] } +{ to_fun := λ t, ⟨finsupp.single n t⟩, + map_add' := by simp, + map_smul' := by simp [←of_finsupp_smul] } @[simp] lemma to_finsupp_monomial (n : ℕ) (r : R) : (monomial n r).to_finsupp = finsupp.single n r := -by simp [monomial, monomial_fun] +by simp [monomial] @[simp] lemma of_finsupp_single (n : ℕ) (r : R) : (⟨finsupp.single n r⟩ : R[X]) = monomial n r := -by simp [monomial, monomial_fun] +by simp [monomial] @[simp] lemma monomial_zero_right (n : ℕ) : @@ -300,17 +305,13 @@ begin { simp [pow_succ, ih, monomial_mul_monomial, nat.succ_eq_add_one, mul_add, add_comm] }, end -lemma smul_monomial {S} [monoid S] [distrib_mul_action S R] (a : S) (n : ℕ) (b : R) : +lemma smul_monomial {S} [smul_zero_class S R] (a : S) (n : ℕ) (b : R) : a • monomial n b = monomial n (a • b) := to_finsupp_injective $ by simp lemma monomial_injective (n : ℕ) : function.injective (monomial n : R → R[X]) := -begin - convert (to_finsupp_iso R).symm.injective.comp (single_injective n), - ext, - simp -end +(to_finsupp_iso R).symm.injective.comp (single_injective n) @[simp] lemma monomial_eq_zero_iff (t : R) (n : ℕ) : monomial n t = 0 ↔ t = 0 := @@ -335,8 +336,7 @@ def C : R →+* R[X] := @[simp] lemma monomial_zero_left (a : R) : monomial 0 a = C a := rfl -@[simp] lemma to_finsupp_C (a : R) : (C a).to_finsupp = single 0 a := -by rw [←monomial_zero_left, to_finsupp_monomial] +@[simp] lemma to_finsupp_C (a : R) : (C a).to_finsupp = single 0 a := rfl lemma C_0 : C (0 : R) = 0 := by simp @@ -346,7 +346,7 @@ lemma C_mul : C (a * b) = C a * C b := C.map_mul a b lemma C_add : C (a + b) = C a + C b := C.map_add a b -@[simp] lemma smul_C {S} [monoid S] [distrib_mul_action S R] (s : S) (r : R) : +@[simp] lemma smul_C {S} [smul_zero_class S R] (s : S) (r : R) : s • C r = C (s • r) := smul_monomial _ _ r @@ -378,6 +378,8 @@ begin { rw [pow_succ, ←ih, ←monomial_one_one_eq_X, monomial_mul_monomial, add_comm, one_mul], } end +@[simp] lemma to_finsupp_X : X.to_finsupp = finsupp.single 1 (1 : R) := rfl + /-- `X` commutes with everything, even when the coefficients are noncommutative. -/ lemma X_mul : X * p = p * X := begin @@ -385,7 +387,6 @@ begin simp only [X, ←of_finsupp_single, ←of_finsupp_mul, linear_map.coe_mk], ext, simp [add_monoid_algebra.mul_apply, sum_single_index, add_comm], - congr; ext; congr, end lemma X_pow_mul {n : ℕ} : X^n * p = p * X^n := @@ -445,6 +446,13 @@ by rw [X_pow_mul, monomial_mul_X_pow] @[simp] def coeff : R[X] → ℕ → R | ⟨p⟩ := p +lemma coeff_injective : injective (coeff : R[X] → ℕ → R) := +by { rintro ⟨p⟩ ⟨q⟩, simp only [coeff, fun_like.coe_fn_eq, imp_self] } + +@[simp] lemma coeff_inj : p.coeff = q.coeff ↔ p = q := coeff_injective.eq_iff + +lemma to_finsupp_apply (f : R[X]) (i) : f.to_finsupp i = f.coeff i := by cases f; refl + lemma coeff_monomial : coeff (monomial n a) m = if n = m then a else 0 := by { simp only [←of_finsupp_single, coeff, linear_map.coe_mk], rw finsupp.single_apply } @@ -479,23 +487,36 @@ by { convert coeff_monomial using 2, simp [eq_comm], } lemma coeff_C_ne_zero (h : n ≠ 0) : (C a).coeff n = 0 := by rw [coeff_C, if_neg h] -theorem nontrivial.of_polynomial_ne (h : p ≠ q) : nontrivial R := -nontrivial_of_ne 0 1 $ λ h01, h $ - by rw [← mul_one p, ← mul_one q, ← C_1, ← h01, C_0, mul_zero, mul_zero] +lemma C_mul_X_pow_eq_monomial : ∀ {n : ℕ}, C a * X ^ n = monomial n a +| 0 := mul_one _ +| (n+1) := by rw [pow_succ', ←mul_assoc, C_mul_X_pow_eq_monomial, X, monomial_mul_monomial, mul_one] -lemma monomial_eq_C_mul_X : ∀{n}, monomial n a = C a * X^n -| 0 := (mul_one _).symm -| (n+1) := - calc monomial (n + 1) a = monomial n a * X : by { rw [X, monomial_mul_monomial, mul_one], } - ... = (C a * X^n) * X : by rw [monomial_eq_C_mul_X] - ... = C a * X^(n+1) : by simp only [pow_add, mul_assoc, pow_one] +@[simp] lemma to_finsupp_C_mul_X_pow (a : R) (n : ℕ) : + (C a * X ^ n).to_finsupp = finsupp.single n a := +by rw [C_mul_X_pow_eq_monomial, to_finsupp_monomial] -@[simp] lemma C_inj : C a = C b ↔ a = b := -⟨λ h, coeff_C_zero.symm.trans (h.symm ▸ coeff_C_zero), congr_arg C⟩ +lemma C_mul_X_eq_monomial : C a * X = monomial 1 a := by rw [← C_mul_X_pow_eq_monomial, pow_one] -@[simp] lemma C_eq_zero : C a = 0 ↔ a = 0 := -calc C a = 0 ↔ C a = C 0 : by rw C_0 - ... ↔ a = 0 : C_inj +@[simp] lemma to_finsupp_C_mul_X (a : R) : (C a * X).to_finsupp = finsupp.single 1 a := +by rw [C_mul_X_eq_monomial, to_finsupp_monomial] + +lemma C_injective : injective (C : R → R[X]) := monomial_injective 0 + +@[simp] lemma C_inj : C a = C b ↔ a = b := C_injective.eq_iff +@[simp] lemma C_eq_zero : C a = 0 ↔ a = 0 := C_injective.eq_iff' (map_zero C) + +lemma C_ne_zero : C a ≠ 0 ↔ a ≠ 0 := C_eq_zero.not + +lemma subsingleton_iff_subsingleton : + subsingleton R[X] ↔ subsingleton R := +⟨@injective.subsingleton _ _ _ C_injective, by { introI, apply_instance } ⟩ + +theorem nontrivial.of_polynomial_ne (h : p ≠ q) : nontrivial R := +(subsingleton_or_nontrivial R).resolve_left $ λ hI, h $ by exactI subsingleton.elim _ _ + +lemma forall_eq_iff_forall_eq : + (∀ f g : R[X], f = g) ↔ (∀ a b : R, a = b) := +by simpa only [← subsingleton_iff] using subsingleton_iff_subsingleton theorem ext_iff {p q : R[X]} : p = q ↔ ∀ n, coeff p n = coeff q n := by { rcases p, rcases q, simp [coeff, finsupp.ext_iff] } @@ -535,46 +556,80 @@ linear_map.to_add_monoid_hom_injective $ add_hom_ext $ λ n, linear_map.congr_fu lemma eq_zero_of_eq_zero (h : (0 : R) = (1 : R)) (p : R[X]) : p = 0 := by rw [←one_smul R p, ←h, zero_smul] -lemma support_monomial (n) (a : R) (H : a ≠ 0) : (monomial n a).support = singleton n := -by rw [←of_finsupp_single, support, finsupp.support_single_ne_zero H] +section fewnomials + +lemma support_monomial (n) {a : R} (H : a ≠ 0) : (monomial n a).support = singleton n := +by rw [←of_finsupp_single, support, finsupp.support_single_ne_zero _ H] lemma support_monomial' (n) (a : R) : (monomial n a).support ⊆ singleton n := by { rw [←of_finsupp_single, support], exact finsupp.support_single_subset } -lemma X_pow_eq_monomial (n) : X ^ n = monomial n (1:R) := +lemma support_C_mul_X {c : R} (h : c ≠ 0) : (C c * X).support = singleton 1 := +by rw [C_mul_X_eq_monomial, support_monomial 1 h] + +lemma support_C_mul_X' (c : R) : (C c * X).support ⊆ singleton 1 := +by simpa only [C_mul_X_eq_monomial] using support_monomial' 1 c + +lemma support_C_mul_X_pow (n : ℕ) {c : R} (h : c ≠ 0) : (C c * X ^ n).support = singleton n := +by rw [C_mul_X_pow_eq_monomial, support_monomial n h] + +lemma support_C_mul_X_pow' (n : ℕ) (c : R) : (C c * X ^ n).support ⊆ singleton n := +by simpa only [C_mul_X_pow_eq_monomial] using support_monomial' n c + +open finset + +lemma support_binomial' (k m : ℕ) (x y : R) : (C x * X ^ k + C y * X ^ m).support ⊆ {k, m} := +support_add.trans (union_subset ((support_C_mul_X_pow' k x).trans + (singleton_subset_iff.mpr (mem_insert_self k {m}))) ((support_C_mul_X_pow' m y).trans + (singleton_subset_iff.mpr (mem_insert_of_mem (mem_singleton_self m))))) + +lemma support_trinomial' (k m n : ℕ) (x y z : R) : + (C x * X ^ k + C y * X ^ m + C z * X ^ n).support ⊆ {k, m, n} := +support_add.trans (union_subset (support_add.trans (union_subset ((support_C_mul_X_pow' k x).trans + (singleton_subset_iff.mpr (mem_insert_self k {m, n}))) ((support_C_mul_X_pow' m y).trans + (singleton_subset_iff.mpr (mem_insert_of_mem (mem_insert_self m {n})))))) + ((support_C_mul_X_pow' n z).trans (singleton_subset_iff.mpr + (mem_insert_of_mem (mem_insert_of_mem (mem_singleton_self n)))))) + +end fewnomials + +lemma X_pow_eq_monomial (n) : X ^ n = monomial n (1 : R) := begin induction n with n hn, { rw [pow_zero, monomial_zero_one] }, { rw [pow_succ', hn, X, monomial_mul_monomial, one_mul] }, end -lemma monomial_eq_smul_X {n} : monomial n (a : R) = a • X^n := -calc monomial n a = monomial n (a * 1) : by simp - ... = a • monomial n 1 : by rw [smul_monomial, smul_eq_mul] - ... = a • X^n : by rw X_pow_eq_monomial +@[simp] lemma to_finsupp_X_pow (n : ℕ) : (X ^ n).to_finsupp = finsupp.single n (1 : R) := +by rw [X_pow_eq_monomial, to_finsupp_monomial] -lemma support_X_pow (H : ¬ (1:R) = 0) (n : ℕ) : (X^n : R[X]).support = singleton n := +lemma smul_X_eq_monomial {n} : a • X ^ n = monomial n (a : R) := +by rw [X_pow_eq_monomial, smul_monomial, smul_eq_mul, mul_one] + +lemma support_X_pow (H : ¬(1 : R) = 0) (n : ℕ) : (X ^ n : R[X]).support = singleton n := begin - convert support_monomial n 1 H, + convert support_monomial n H, exact X_pow_eq_monomial n, end -lemma support_X_empty (H : (1:R)=0) : (X : R[X]).support = ∅ := -begin - rw [X, H, monomial_zero_right, support_zero], -end +lemma support_X_empty (H : (1 : R) = 0) : (X : R[X]).support = ∅ := +by rw [X, H, monomial_zero_right, support_zero] -lemma support_X (H : ¬ (1 : R) = 0) : (X : R[X]).support = singleton 1 := -begin - rw [← pow_one X, support_X_pow H 1], -end +lemma support_X (H : ¬(1 : R) = 0) : (X : R[X]).support = singleton 1 := +by rw [← pow_one X, support_X_pow H 1] -lemma monomial_left_inj {R : Type*} [semiring R] {a : R} (ha : a ≠ 0) {i j : ℕ} : - (monomial i a) = (monomial j a) ↔ i = j := +lemma monomial_left_inj {a : R} (ha : a ≠ 0) {i j : ℕ} : (monomial i a) = (monomial j a) ↔ i = j := by simp_rw [←of_finsupp_single, finsupp.single_left_inj ha] -lemma nat_cast_mul {R : Type*} [semiring R] (n : ℕ) (p : R[X]) : - (n : R[X]) * p = n • p := +lemma binomial_eq_binomial {k l m n : ℕ} {u v : R} (hu : u ≠ 0) (hv : v ≠ 0) : + C u * X ^ k + C v * X ^ l = C u * X ^ m + C v * X ^ n ↔ + (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u + v = 0 ∧ k = l ∧ m = n) := +begin + simp_rw [C_mul_X_pow_eq_monomial, ←to_finsupp_inj, to_finsupp_add, to_finsupp_monomial], + exact finsupp.single_add_single_eq_single_add_single hu hv, +end + +lemma nat_cast_mul (n : ℕ) (p : R[X]) : (n : R[X]) * p = n • p := (nsmul_eq_mul _ _).symm /-- Summing the values of a function applied to the coefficients of a polynomial -/ @@ -649,6 +704,12 @@ begin simpa [sum, support, coeff] using finsupp.sum_smul_index hf, end +lemma sum_monomial_eq : ∀ p : R[X], p.sum (λ n a, monomial n a) = p +| ⟨p⟩ := (of_finsupp_sum _ _).symm.trans (congr_arg _ $ finsupp.sum_single _) + +lemma sum_C_mul_X_pow_eq (p : R[X]) : p.sum (λ n a, C a * X ^ n) = p := +by simp_rw [C_mul_X_pow_eq_monomial, sum_monomial_eq] + /-- `erase p n` is the polynomial `p` in which the `X^n` term has been erased. -/ @[irreducible] definition erase (n : ℕ) : R[X] → R[X] | ⟨p⟩ := ⟨p.erase n⟩ @@ -695,7 +756,7 @@ by simp [coeff_erase, h] section update -/-- Replace the coefficient of a `p : polynomial p` at a given degree `n : ℕ` +/-- Replace the coefficient of a `p : R[X]` at a given degree `n : ℕ` by a given value `a : R`. If `a = 0`, this is equal to `p.erase n` If `p.nat_degree < n` and `a ≠ 0`, this increases the degree to `n`. -/ def update (p : R[X]) (n : ℕ) (a : R) : @@ -728,7 +789,7 @@ by { ext, rw [coeff_update_apply, coeff_erase] } lemma support_update (p : R[X]) (n : ℕ) (a : R) [decidable (a = 0)] : support (p.update n a) = if a = 0 then p.support.erase n else insert n p.support := -by { cases p, simp only [support, update, support_update], congr } +by { classical, cases p, simp only [support, update, support_update], congr } lemma support_update_zero (p : R[X]) (n : ℕ) : support (p.update n 0) = p.support.erase n := @@ -748,17 +809,19 @@ variables [comm_semiring R] instance : comm_semiring R[X] := function.injective.comm_semiring to_finsupp to_finsupp_injective to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul - (λ _ _, to_finsupp_smul _ _) to_finsupp_pow + (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl) end comm_semiring section ring variables [ring R] +instance : has_int_cast R[X] := ⟨λ n, of_finsupp n⟩ + instance : ring R[X] := function.injective.ring to_finsupp to_finsupp_injective to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul to_finsupp_neg to_finsupp_sub - (λ _ _, to_finsupp_smul _ _) (λ _ _, to_finsupp_smul _ _) to_finsupp_pow + (λ _ _, to_finsupp_smul _ _) (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl) (λ _, rfl) @[simp] lemma coeff_neg (p : R[X]) (n : ℕ) : coeff (-p) n = -coeff p n := by { rcases p, rw [←of_finsupp_neg, coeff, coeff, finsupp.neg_apply] } @@ -773,16 +836,14 @@ by rw [eq_neg_iff_add_eq_zero, ←monomial_add, neg_add_self, monomial_zero_righ @[simp] lemma support_neg {p : R[X]} : (-p).support = p.support := by { rcases p, rw [←of_finsupp_neg, support, support, finsupp.support_neg] } -@[simp] -lemma C_eq_int_cast (n : ℤ) : C (n : R) = n := -(C : R →+* _).map_int_cast n +@[simp] lemma C_eq_int_cast (n : ℤ) : C (n : R) = n := map_int_cast C n end ring instance [comm_ring R] : comm_ring R[X] := function.injective.comm_ring to_finsupp to_finsupp_injective to_finsupp_zero to_finsupp_one to_finsupp_add to_finsupp_mul to_finsupp_neg to_finsupp_sub - (λ _ _, to_finsupp_smul _ _) (λ _ _, to_finsupp_smul _ _) to_finsupp_pow + (λ _ _, to_finsupp_smul _ _) (λ _ _, to_finsupp_smul _ _) to_finsupp_pow (λ _, rfl) (λ _, rfl) section nonzero_semiring @@ -800,6 +861,15 @@ mt (congr_arg (λ p, coeff p 1)) (by simp) end nonzero_semiring +section division_ring + +variables [division_ring R] + +lemma rat_smul_eq_C_mul (a : ℚ) (f : R[X]) : a • f = polynomial.C ↑a * f := +by rw [←rat.smul_one_eq_coe, ←polynomial.smul_C, C_1, smul_one_mul] + +end division_ring + @[simp] lemma nontrivial_iff [semiring R] : nontrivial R[X] ↔ nontrivial R := ⟨λ h, let ⟨r, s, hrs⟩ := @exists_pair_ne _ h in nontrivial.of_polynomial_ne hrs, λ h, @polynomial.nontrivial _ _ h⟩ diff --git a/src/data/polynomial/cancel_leads.lean b/src/data/polynomial/cancel_leads.lean index 377db80acaa79..4275643fba7da 100644 --- a/src/data/polynomial/cancel_leads.lean +++ b/src/data/polynomial/cancel_leads.lean @@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Aaron Anderson -/ import data.polynomial.degree.definitions - +import tactic.compute_degree +import data.polynomial.degree.lemmas /-! # Cancel the leading terms of two polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Definition * `cancel_leads p q`: the polynomial formed by multiplying `p` and `q` by monomials so that they @@ -23,7 +27,7 @@ open_locale polynomial variables {R : Type*} -section comm_ring +section ring variables [ring R] (p q : R[X]) /-- `cancel_leads p q` is formed by multiplying `p` and `q` by monomials so that they @@ -36,19 +40,9 @@ variables {p q} @[simp] lemma neg_cancel_leads : - p.cancel_leads q = q.cancel_leads p := neg_sub _ _ -end comm_ring - -section comm_ring -variables [comm_ring R] {p q : R[X]} - -lemma dvd_cancel_leads_of_dvd_of_dvd {r : R[X]} (pq : p ∣ q) (pr : p ∣ r) : - p ∣ q.cancel_leads r := -dvd_sub (pr.trans (dvd.intro_left _ rfl)) (pq.trans (dvd.intro_left _ rfl)) - -end comm_ring - -lemma nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree [comm_ring R] [is_domain R] - {p q : R[X]} (h : p.nat_degree ≤ q.nat_degree) (hq : 0 < q.nat_degree) : +lemma nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree_of_comm + (comm : p.leading_coeff * q.leading_coeff = q.leading_coeff * p.leading_coeff) + (h : p.nat_degree ≤ q.nat_degree) (hq : 0 < q.nat_degree) : (p.cancel_leads q).nat_degree < q.nat_degree := begin by_cases hp : p = 0, @@ -57,26 +51,32 @@ begin rw [cancel_leads, sub_eq_add_neg, tsub_eq_zero_iff_le.mpr h, pow_zero, mul_one], by_cases h0 : C p.leading_coeff * q + -(C q.leading_coeff * X ^ (q.nat_degree - p.nat_degree) * p) = 0, - { convert hq, - simp only [h0, nat_degree_zero], }, - have hq0 : ¬ q = 0, - { contrapose! hq, - simp [hq] }, + { exact (le_of_eq (by simp only [h0, nat_degree_zero])).trans_lt hq }, apply lt_of_le_of_ne, - { rw [← with_bot.coe_le_coe, ← degree_eq_nat_degree h0, ← degree_eq_nat_degree hq0], - apply le_trans (degree_add_le _ _), - rw ← leading_coeff_eq_zero at hp hq0, - simp only [max_le_iff, degree_C hp, degree_C hq0, le_refl q.degree, true_and, nat.cast_with_bot, - nsmul_one, degree_neg, degree_mul, zero_add, degree_X, degree_pow], - rw leading_coeff_eq_zero at hp hq0, - rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq0, ← with_bot.coe_add, with_bot.coe_le_coe, - tsub_add_cancel_of_le h], }, + { compute_degree_le, + repeat { rwa nat.sub_add_cancel } }, { contrapose! h0, - rw [← leading_coeff_eq_zero, leading_coeff, h0, mul_assoc, mul_comm _ p, + rw [← leading_coeff_eq_zero, leading_coeff, h0, mul_assoc, X_pow_mul, ← tsub_add_cancel_of_le h, add_comm _ p.nat_degree], simp only [coeff_mul_X_pow, coeff_neg, coeff_C_mul, add_tsub_cancel_left, coeff_add], - rw [add_comm p.nat_degree, tsub_add_cancel_of_le h, ← leading_coeff, ← leading_coeff, - mul_comm _ q.leading_coeff, ← sub_eq_add_neg, ← mul_sub, sub_self, mul_zero] } + rw [add_comm p.nat_degree, tsub_add_cancel_of_le h, ← leading_coeff, ← leading_coeff, comm, + add_right_neg] } end +end ring + +section comm_ring +variables [comm_ring R] {p q : R[X]} + +lemma dvd_cancel_leads_of_dvd_of_dvd {r : R[X]} (pq : p ∣ q) (pr : p ∣ r) : + p ∣ q.cancel_leads r := +dvd_sub (pr.trans (dvd.intro_left _ rfl)) (pq.trans (dvd.intro_left _ rfl)) + +lemma nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree + (h : p.nat_degree ≤ q.nat_degree) (hq : 0 < q.nat_degree) : + (p.cancel_leads q).nat_degree < q.nat_degree := +nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree_of_comm (mul_comm _ _) h hq + +end comm_ring + end polynomial diff --git a/src/data/polynomial/cardinal.lean b/src/data/polynomial/cardinal.lean index 25880dfa7c6ed..a398efb2fb04b 100644 --- a/src/data/polynomial/cardinal.lean +++ b/src/data/polynomial/cardinal.lean @@ -1,15 +1,18 @@ /- -Copyright (c) 2021 Chris Hughes. All rights reserved. +Copyright (c) 2021 Chris Hughes, Junyan Xu. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Chris Hughes +Authors: Chris Hughes, Junyan Xu -/ -import data.mv_polynomial.cardinal -import data.mv_polynomial.equiv +import data.polynomial.basic +import set_theory.cardinal.ordinal /-! # Cardinality of Polynomial Ring -The reuslt in this file is that the cardinality of `polynomial R` is at most the maximum -of `#R` and `ω`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +The reuslt in this file is that the cardinality of `R[X]` is at most the maximum +of `#R` and `ℵ₀`. -/ universe u @@ -18,10 +21,15 @@ open cardinal namespace polynomial -lemma cardinal_mk_le_max {R : Type u} [comm_semiring R] : #R[X] ≤ max (#R) ω := -calc #R[X] = #(mv_polynomial punit.{u + 1} R) : - cardinal.eq.2 ⟨(mv_polynomial.punit_alg_equiv.{u u} R).to_equiv.symm⟩ -... ≤ _ : mv_polynomial.cardinal_mk_le_max -... ≤ _ : by rw [max_assoc, max_eq_right (lt_omega_of_fintype punit).le] +@[simp] lemma cardinal_mk_eq_max {R : Type u} [semiring R] [nontrivial R] : #R[X] = max (#R) ℵ₀ := +(to_finsupp_iso R).to_equiv.cardinal_eq.trans $ + by { rw [add_monoid_algebra, mk_finsupp_lift_of_infinite, lift_uzero, max_comm], refl } + +lemma cardinal_mk_le_max {R : Type u} [semiring R] : #R[X] ≤ max (#R) ℵ₀ := +begin + casesI subsingleton_or_nontrivial R, + { exact (mk_eq_one _).trans_le (le_max_of_le_right one_le_aleph_0) }, + { exact cardinal_mk_eq_max.le }, +end end polynomial diff --git a/src/data/polynomial/coeff.lean b/src/data/polynomial/coeff.lean index 191bb26c1daf1..517a60b716ae3 100644 --- a/src/data/polynomial/coeff.lean +++ b/src/data/polynomial/coeff.lean @@ -11,6 +11,9 @@ import data.nat.choose.sum /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The theorems include formulas for computing coefficients, such as `coeff_add`, `coeff_sum`, `coeff_mul` @@ -36,7 +39,9 @@ coeff_monomial lemma coeff_add (p q : R[X]) (n : ℕ) : coeff (p + q) n = coeff p n + coeff q n := by { rcases p, rcases q, simp_rw [←of_finsupp_add, coeff], exact finsupp.add_apply _ _ _ } -@[simp] lemma coeff_smul [monoid S] [distrib_mul_action S R] (r : S) (p : R[X]) (n : ℕ) : +@[simp] lemma coeff_bit0 (p : R[X]) (n : ℕ) : coeff (bit0 p) n = bit0 (coeff p n) := by simp [bit0] + +@[simp] lemma coeff_smul [smul_zero_class S R] (r : S) (p : R[X]) (n : ℕ) : coeff (r • p) n = r • coeff p n := by { rcases p, simp_rw [←of_finsupp_smul, coeff], exact finsupp.smul_apply _ _ _ } @@ -52,7 +57,7 @@ end /-- `polynomial.sum` as a linear map. -/ @[simps] def lsum {R A M : Type*} [semiring R] [semiring A] [add_comm_monoid M] [module R A] [module R M] (f : ℕ → A →ₗ[R] M) : - polynomial A →ₗ[R] M := + A[X] →ₗ[R] M := { to_fun := λ p, p.sum (λ n r, f n r), map_add' := λ p q, sum_add_index p q _ (λ n, (f n).map_zero) (λ n _ _, (f n).map_add _ _), map_smul' := λ c p, @@ -94,15 +99,24 @@ end @[simp] lemma mul_coeff_zero (p q : R[X]) : coeff (p * q) 0 = coeff p 0 * coeff q 0 := by simp [coeff_mul] -lemma coeff_mul_X_zero (p : R[X]) : coeff (p * X) 0 = 0 := -by simp +/-- `constant_coeff p` returns the constant term of the polynomial `p`, + defined as `coeff p 0`. This is a ring homomorphism. -/ +@[simps] def constant_coeff : R[X] →+* R := +{ to_fun := λ p, coeff p 0, + map_one' := coeff_one_zero, + map_mul' := mul_coeff_zero, + map_zero' := coeff_zero 0, + map_add' := λ p q, coeff_add p q 0 } + +lemma is_unit_C {x : R} : is_unit (C x) ↔ is_unit x := +⟨λ h, (congr_arg is_unit coeff_C_zero).mp (h.map $ @constant_coeff R _), λ h, h.map C⟩ -lemma coeff_X_mul_zero (p : R[X]) : coeff (X * p) 0 = 0 := -by simp +lemma coeff_mul_X_zero (p : R[X]) : coeff (p * X) 0 = 0 := by simp -lemma coeff_C_mul_X_pow (x : R) (k n : ℕ) : - coeff (C x * X^k : R[X]) n = if n = k then x else 0 := -by { rw [← monomial_eq_C_mul_X, coeff_monomial], congr' 1, simp [eq_comm] } +lemma coeff_X_mul_zero (p : R[X]) : coeff (X * p) 0 = 0 := by simp + +lemma coeff_C_mul_X_pow (x : R) (k n : ℕ) : coeff (C x * X ^ k : R[X]) n = if n = k then x else 0 := +by { rw [C_mul_X_pow_eq_monomial, coeff_monomial], congr' 1, simp [eq_comm] } lemma coeff_C_mul_X (x : R) (n : ℕ) : coeff (C x * X : R[X]) n = if n = 1 then x else 0 := by rw [← pow_one X, coeff_C_mul_X_pow] @@ -134,6 +148,41 @@ lemma coeff_X_pow_self (n : ℕ) : coeff (X^n : R[X]) n = 1 := by simp [coeff_X_pow] +section fewnomials + +open finset + +lemma support_binomial {k m : ℕ} (hkm : k ≠ m) {x y : R} (hx : x ≠ 0) (hy : y ≠ 0) : + (C x * X ^ k + C y * X ^ m).support = {k, m} := +begin + apply subset_antisymm (support_binomial' k m x y), + simp_rw [insert_subset, singleton_subset_iff, mem_support_iff, coeff_add, coeff_C_mul, + coeff_X_pow_self, mul_one, coeff_X_pow, if_neg hkm, if_neg hkm.symm, + mul_zero, zero_add, add_zero, ne.def, hx, hy, and_self, not_false_iff], +end + +lemma support_trinomial {k m n : ℕ} (hkm : k < m) (hmn : m < n) {x y z : R} (hx : x ≠ 0) + (hy : y ≠ 0) (hz : z ≠ 0) : (C x * X ^ k + C y * X ^ m + C z * X ^ n).support = {k, m, n} := +begin + apply subset_antisymm (support_trinomial' k m n x y z), + simp_rw [insert_subset, singleton_subset_iff, mem_support_iff, coeff_add, coeff_C_mul, + coeff_X_pow_self, mul_one, coeff_X_pow, if_neg hkm.ne, if_neg hkm.ne', if_neg hmn.ne, + if_neg hmn.ne', if_neg (hkm.trans hmn).ne, if_neg (hkm.trans hmn).ne', + mul_zero, add_zero, zero_add, ne.def, hx, hy, hz, and_self, not_false_iff], +end + +lemma card_support_binomial {k m : ℕ} (h : k ≠ m) {x y : R} (hx : x ≠ 0) (hy : y ≠ 0) : + (C x * X ^ k + C y * X ^ m).support.card = 2 := +by rw [support_binomial h hx hy, card_insert_of_not_mem (mt mem_singleton.mp h), card_singleton] + +lemma card_support_trinomial {k m n : ℕ} (hkm : k < m) (hmn : m < n) {x y z : R} (hx : x ≠ 0) + (hy : y ≠ 0) (hz : z ≠ 0) : (C x * X ^ k + C y * X ^ m + C z * X ^ n).support.card = 3 := +by rw [support_trinomial hkm hmn hx hy hz, card_insert_of_not_mem + (mt mem_insert.mp (not_or hkm.ne (mt mem_singleton.mp (hkm.trans hmn).ne))), + card_insert_of_not_mem (mt mem_singleton.mp hmn.ne), card_singleton] + +end fewnomials + @[simp] theorem coeff_mul_X_pow (p : R[X]) (n d : ℕ) : coeff (p * polynomial.X ^ n) (d + n) = coeff p d := @@ -156,8 +205,7 @@ begin { rw [← tsub_add_cancel_of_le h, coeff_mul_X_pow, add_tsub_cancel_right] }, { refine (coeff_mul _ _ _).trans (finset.sum_eq_zero (λ x hx, _)), rw [coeff_X_pow, if_neg, mul_zero], - exact ne_of_lt (lt_of_le_of_lt (nat.le_of_add_le_right - (le_of_eq (finset.nat.mem_antidiagonal.mp hx))) (not_le.mp h)) }, + exact ((le_of_add_le_right (finset.nat.mem_antidiagonal.mp hx).le).trans_lt $ not_le.mp h).ne } end lemma coeff_X_pow_mul' (p : R[X]) (n d : ℕ) : @@ -171,6 +219,24 @@ by simpa only [pow_one] using coeff_mul_X_pow p 1 n @[simp] theorem coeff_X_mul (p : R[X]) (n : ℕ) : coeff (X * p) (n + 1) = coeff p n := by rw [(commute_X p).eq, coeff_mul_X] +theorem coeff_mul_monomial (p : R[X]) (n d : ℕ) (r : R) : + coeff (p * monomial n r) (d + n) = coeff p d * r := +by rw [← C_mul_X_pow_eq_monomial, ←X_pow_mul, ←mul_assoc, coeff_mul_C, coeff_mul_X_pow] + +theorem coeff_monomial_mul (p : R[X]) (n d : ℕ) (r : R) : + coeff (monomial n r * p) (d + n) = r * coeff p d := +by rw [← C_mul_X_pow_eq_monomial, mul_assoc, coeff_C_mul, X_pow_mul, coeff_mul_X_pow] + +-- This can already be proved by `simp`. +theorem coeff_mul_monomial_zero (p : R[X]) (d : ℕ) (r : R) : + coeff (p * monomial 0 r) d = coeff p d * r := +coeff_mul_monomial p 0 d r + +-- This can already be proved by `simp`. +theorem coeff_monomial_zero_mul (p : R[X]) (d : ℕ) (r : R) : + coeff (monomial 0 r * p) d = r * coeff p d := +coeff_monomial_mul p 0 d r + theorem mul_X_pow_eq_zero {p : R[X]} {n : ℕ} (H : p * X ^ n = 0) : p = 0 := ext $ λ k, (coeff_mul_X_pow p n k).symm.trans $ ext_iff.1 H (k+n) @@ -186,15 +252,6 @@ end lemma mul_X_injective : function.injective (λ P : R[X], X * P) := pow_one (X : R[X]) ▸ mul_X_pow_injective 1 -lemma C_mul_X_pow_eq_monomial (c : R) (n : ℕ) : C c * X^n = monomial n c := -by { ext1, rw [monomial_eq_smul_X, coeff_smul, coeff_C_mul, smul_eq_mul] } - -lemma support_mul_X_pow (c : R) (n : ℕ) (H : c ≠ 0) : (C c * X^n).support = singleton n := -by rw [C_mul_X_pow_eq_monomial, support_monomial n c H] - -lemma support_C_mul_X_pow' {c : R} {n : ℕ} : (C c * X^n).support ⊆ singleton n := -by { rw [C_mul_X_pow_eq_monomial], exact support_monomial' n c } - lemma coeff_X_add_C_pow (r : R) (n k : ℕ) : ((X + C r) ^ n).coeff k = r ^ (n - k) * (n.choose k : R) := begin diff --git a/src/data/polynomial/default.lean b/src/data/polynomial/default.lean deleted file mode 100644 index 05858af734dd8..0000000000000 --- a/src/data/polynomial/default.lean +++ /dev/null @@ -1,5 +0,0 @@ -import data.polynomial.algebra_map -import data.polynomial.field_division -import data.polynomial.derivative -import data.polynomial.identities -import data.polynomial.integral_normalization diff --git a/src/data/polynomial/degree/card_pow_degree.lean b/src/data/polynomial/degree/card_pow_degree.lean index d5838fe31283f..0115d6a5f1e2b 100644 --- a/src/data/polynomial/degree/card_pow_degree.lean +++ b/src/data/polynomial/degree/card_pow_degree.lean @@ -9,6 +9,9 @@ import data.polynomial.field_division /-! # Absolute value on polynomials over a finite field. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `Fq` be a finite field of cardinality `q`, then the map sending a polynomial `p` to `q ^ degree p` (where `q ^ degree 0 = 0`) is an absolute value. diff --git a/src/data/polynomial/degree/default.lean b/src/data/polynomial/degree/default.lean deleted file mode 100644 index 049cf1a50ebf9..0000000000000 --- a/src/data/polynomial/degree/default.lean +++ /dev/null @@ -1 +0,0 @@ -import data.polynomial.degree.lemmas diff --git a/src/data/polynomial/degree/definitions.lean b/src/data/polynomial/degree/definitions.lean index 60e1e96c701cf..895f51d0483e2 100644 --- a/src/data/polynomial/degree/definitions.lean +++ b/src/data/polynomial/degree/definitions.lean @@ -3,13 +3,17 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ +import data.fintype.big_operators import data.nat.with_bot -import data.polynomial.induction import data.polynomial.monomial +import data.polynomial.coeff /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The definitions include `degree`, `monic`, `leading_coeff` @@ -34,7 +38,7 @@ variables [semiring R] {p q r : R[X]} /-- `degree p` is the degree of the polynomial `p`, i.e. the largest `X`-exponent in `p`. `degree p = some n` when `p ≠ 0` and `n` is the highest power of `X` that appears in `p`, otherwise `degree 0 = ⊥`. -/ -def degree (p : R[X]) : with_bot ℕ := p.support.sup some +def degree (p : R[X]) : with_bot ℕ := p.support.max lemma degree_lt_wf : well_founded (λp q : R[X], degree p < degree q) := inv_image.wf degree (with_bot.well_founded_lt nat.lt_wf) @@ -42,7 +46,7 @@ inv_image.wf degree (with_bot.well_founded_lt nat.lt_wf) instance : has_well_founded R[X] := ⟨_, degree_lt_wf⟩ /-- `nat_degree p` forces `degree p` to ℕ, by defining nat_degree 0 = 0. -/ -def nat_degree (p : R[X]) : ℕ := (degree p).get_or_else 0 +def nat_degree (p : R[X]) : ℕ := (degree p).unbot' 0 /-- `leading_coeff p` gives the coefficient of the highest power of `X` in `p`-/ def leading_coeff (p : R[X]) : R := coeff p (nat_degree p) @@ -70,8 +74,7 @@ lemma monic.coeff_nat_degree {p : R[X]} (hp : p.monic) : p.coeff p.nat_degree = @[simp] lemma coeff_nat_degree : coeff p (nat_degree p) = leading_coeff p := rfl lemma degree_eq_bot : degree p = ⊥ ↔ p = 0 := -⟨λ h, by rw [degree, ← max_eq_sup_with_bot] at h; - exact support_eq_empty.1 (max_eq_none.1 h), +⟨λ h, support_eq_empty.1 (finset.max_eq_bot.1 h), λ h, h.symm ▸ rfl⟩ @[nontriviality] lemma degree_of_subsingleton [subsingleton R] : degree p = ⊥ := @@ -107,7 +110,7 @@ option.some_inj.1 $ show (nat_degree p : with_bot ℕ) = n, by rwa [← degree_eq_nat_degree hp0] @[simp] lemma degree_le_nat_degree : degree p ≤ nat_degree p := -with_bot.gi_get_or_else_bot.gc.le_u_l _ +with_bot.gi_unbot'_bot.gc.le_u_l _ lemma nat_degree_eq_of_degree_eq [semiring S] {q : S[X]} (h : degree p = degree q) : nat_degree p = nat_degree q := @@ -128,6 +131,14 @@ lemma le_nat_degree_of_mem_supp (a : ℕ) : a ∈ p.support → a ≤ nat_degree p:= le_nat_degree_of_ne_zero ∘ mem_support_iff.mp +lemma degree_eq_of_le_of_coeff_ne_zero (pn : p.degree ≤ n) (p1 : p.coeff n ≠ 0) : + p.degree = n := +pn.antisymm (le_degree_of_ne_zero p1) + +lemma nat_degree_eq_of_le_of_coeff_ne_zero (pn : p.nat_degree ≤ n) (p1 : p.coeff n ≠ 0) : + p.nat_degree = n := +pn.antisymm (le_nat_degree_of_ne_zero p1) + lemma degree_mono [semiring S] {f : R[X]} {g : S[X]} (h : f.support ⊆ g.support) : f.degree ≤ g.degree := finset.sup_mono h @@ -146,23 +157,31 @@ end lemma degree_ne_of_nat_degree_ne {n : ℕ} : p.nat_degree ≠ n → degree p ≠ n := -mt $ λ h, by rw [nat_degree, h, option.get_or_else_coe] +mt $ λ h, by rw [nat_degree, h, with_bot.unbot'_coe] theorem nat_degree_le_iff_degree_le {n : ℕ} : nat_degree p ≤ n ↔ degree p ≤ n := -with_bot.get_or_else_bot_le_iff +with_bot.unbot'_bot_le_iff lemma nat_degree_lt_iff_degree_lt (hp : p ≠ 0) : p.nat_degree < n ↔ p.degree < ↑n := -with_bot.get_or_else_bot_lt_iff $ degree_eq_bot.not.mpr hp +with_bot.unbot'_lt_iff $ degree_eq_bot.not.mpr hp -alias polynomial.nat_degree_le_iff_degree_le ↔ .. +alias nat_degree_le_iff_degree_le ↔ .. lemma nat_degree_le_nat_degree [semiring S] {q : S[X]} (hpq : p.degree ≤ q.degree) : p.nat_degree ≤ q.nat_degree := -with_bot.gi_get_or_else_bot.gc.monotone_l hpq +with_bot.gi_unbot'_bot.gc.monotone_l hpq + +lemma nat_degree_lt_nat_degree {p q : R[X]} (hp : p ≠ 0) (hpq : p.degree < q.degree) : + p.nat_degree < q.nat_degree := +begin + by_cases hq : q = 0, { exact (not_lt_bot $ hq.subst hpq).elim }, + rwa [degree_eq_nat_degree hp, degree_eq_nat_degree hq, with_bot.coe_lt_coe] at hpq +end @[simp] lemma degree_C (ha : a ≠ 0) : degree (C a) = (0 : with_bot ℕ) := -by { rw [degree, ← monomial_zero_left, support_monomial 0 _ ha, sup_singleton], refl } +by rw [degree, ← monomial_zero_left, support_monomial 0 ha, max_eq_sup_coe, sup_singleton, + with_bot.coe_zero] lemma degree_C_le : degree (C a) ≤ 0 := begin @@ -191,10 +210,10 @@ end by simp only [←C_eq_nat_cast, nat_degree_C] @[simp] lemma degree_monomial (n : ℕ) (ha : a ≠ 0) : degree (monomial n a) = n := -by rw [degree, support_monomial _ _ ha]; refl +by rw [degree, support_monomial n ha]; refl @[simp] lemma degree_C_mul_X_pow (n : ℕ) (ha : a ≠ 0) : degree (C a * X ^ n) = n := -by rw [← monomial_eq_C_mul_X, degree_monomial n ha] +by rw [C_mul_X_pow_eq_monomial, degree_monomial n ha] lemma degree_C_mul_X (ha : a ≠ 0) : degree (C a * X) = 1 := by simpa only [pow_one] using degree_C_mul_X_pow 1 ha @@ -214,7 +233,7 @@ nat_degree_eq_of_degree_eq_some (degree_C_mul_X_pow n ha) @[simp] lemma nat_degree_C_mul_X (a : R) (ha : a ≠ 0) : nat_degree (C a * X) = 1 := by simpa only [pow_one] using nat_degree_C_mul_X_pow 1 a ha -@[simp] lemma nat_degree_monomial [decidable_eq R] (i : ℕ) (r : R) : +@[simp] lemma nat_degree_monomial [decidable_eq R] (i : ℕ) (r : R) : nat_degree (monomial i r) = if r = 0 then 0 else i := begin split_ifs with hr, @@ -222,6 +241,17 @@ begin { rw [← C_mul_X_pow_eq_monomial, nat_degree_C_mul_X_pow i r hr] } end +lemma nat_degree_monomial_le (a : R) {m : ℕ} : (monomial m a).nat_degree ≤ m := +begin + rw polynomial.nat_degree_monomial, + split_ifs, + exacts [nat.zero_le _, rfl.le], +end + +lemma nat_degree_monomial_eq (i : ℕ) {r : R} (r0 : r ≠ 0) : + (monomial i r).nat_degree = i := +eq.trans (nat_degree_monomial _ _) (if_neg r0) + lemma coeff_eq_zero_of_degree_lt (h : degree p < n) : coeff p n = 0 := not_not.1 (mt le_degree_of_ne_zero (not_le_of_gt h)) @@ -234,6 +264,20 @@ begin { rwa [degree_eq_nat_degree hp, with_bot.coe_lt_coe] } end +lemma ext_iff_nat_degree_le {p q : R[X]} {n : ℕ} (hp : p.nat_degree ≤ n) (hq : q.nat_degree ≤ n) : + p = q ↔ (∀ i ≤ n, p.coeff i = q.coeff i) := +begin + refine iff.trans polynomial.ext_iff _, + refine forall_congr (λ i, ⟨λ h _, h, λ h, _⟩), + refine (le_or_lt i n).elim h (λ k, _), + refine (coeff_eq_zero_of_nat_degree_lt (hp.trans_lt k)).trans + (coeff_eq_zero_of_nat_degree_lt (hq.trans_lt k)).symm, +end + +lemma ext_iff_degree_le {p q : R[X]} {n : ℕ} (hp : p.degree ≤ n) (hq : q.degree ≤ n) : + p = q ↔ (∀ i ≤ n, p.coeff i = q.coeff i) := +ext_iff_nat_degree_le (nat_degree_le_of_degree_le hp) (nat_degree_le_of_degree_le hq) + @[simp] lemma coeff_nat_degree_succ_eq_zero {p : R[X]} : p.coeff (p.nat_degree + 1) = 0 := coeff_eq_zero_of_nat_degree_lt (lt_add_one _) @@ -313,12 +357,15 @@ ext (λ n, nat.cases_on n (by simp) lemma eq_X_add_C_of_degree_eq_one (h : degree p = 1) : p = C (p.leading_coeff) * X + C (p.coeff 0) := (eq_X_add_C_of_degree_le_one (show degree p ≤ 1, from h ▸ le_rfl)).trans - (by simp [leading_coeff, nat_degree_eq_of_degree_eq_some h]) + (by simp only [leading_coeff, nat_degree_eq_of_degree_eq_some h]) lemma eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) : p = C (p.coeff 1) * X + C (p.coeff 0) := eq_X_add_C_of_degree_le_one $ degree_le_of_nat_degree_le h +lemma monic.eq_X_add_C (hm : p.monic) (hnd : p.nat_degree = 1) : p = X + C (p.coeff 0) := +by rw [←one_mul X, ←C_1, ←hm.coeff_nat_degree, hnd, ←eq_X_add_C_of_nat_degree_le_one hnd.le] + lemma exists_eq_X_add_C_of_nat_degree_le_one (h : nat_degree p ≤ 1) : ∃ a b, p = C a * X + C b := ⟨p.coeff 1, p.coeff 0, eq_X_add_C_of_nat_degree_le_one h⟩ @@ -332,19 +379,13 @@ degree_monomial_le _ _ lemma nat_degree_X_le : (X : R[X]).nat_degree ≤ 1 := nat_degree_le_of_degree_le degree_X_le -lemma support_C_mul_X_pow (c : R) (n : ℕ) : (C c * X ^ n).support ⊆ singleton n := -begin - rw [C_mul_X_pow_eq_monomial], - exact support_monomial' _ _ -end - lemma mem_support_C_mul_X_pow {n a : ℕ} {c : R} (h : a ∈ (C c * X ^ n).support) : a = n := -mem_singleton.1 $ support_C_mul_X_pow _ _ h +mem_singleton.1 $ support_C_mul_X_pow' n c h lemma card_support_C_mul_X_pow_le_one {c : R} {n : ℕ} : (C c * X ^ n).support.card ≤ 1 := begin rw ← card_singleton n, - apply card_le_of_subset (support_C_mul_X_pow c n), + apply card_le_of_subset (support_C_mul_X_pow' n c), end lemma card_supp_le_succ_nat_degree (p : R[X]) : p.support.card ≤ p.nat_degree + 1 := @@ -360,13 +401,6 @@ le_degree_of_ne_zero ∘ mem_support_iff.mp lemma nonempty_support_iff : p.support.nonempty ↔ p ≠ 0 := by rw [ne.def, nonempty_iff_ne_empty, ne.def, ← support_eq_empty] -lemma support_C_mul_X_pow_nonzero {c : R} {n : ℕ} (h : c ≠ 0) : - (C c * X ^ n).support = singleton n := -begin - rw [C_mul_X_pow_eq_monomial], - exact support_monomial _ _ h -end - end semiring section nonzero_semiring @@ -397,7 +431,10 @@ by unfold degree; rw support_neg by simp [nat_degree] @[simp] lemma nat_degree_int_cast (n : ℤ) : nat_degree (n : R[X]) = 0 := -by simp only [←C_eq_int_cast, nat_degree_C] +by rw [←C_eq_int_cast, nat_degree_C] + +@[simp] lemma leading_coeff_neg (p : R[X]) : (-p).leading_coeff = -p.leading_coeff := +by rw [leading_coeff, leading_coeff, nat_degree_neg, coeff_neg] end ring @@ -562,12 +599,11 @@ end lemma degree_update_le (p : R[X]) (n : ℕ) (a : R) : degree (p.update n a) ≤ max (degree p) n := begin - simp only [degree, coeff_update_apply, le_max_iff, finset.sup_le_iff, mem_support_iff], - intros b hb, - split_ifs at hb with h, - { subst b, - exact or.inr le_rfl }, - { exact or.inl (le_degree_of_ne_zero hb) } + rw [degree, support_update], + split_ifs, + { exact (finset.max_mono (erase_subset _ _)).trans (le_max_left _ _) }, + { rw [max_insert, max_comm], + exact le_rfl }, end lemma degree_sum_le (s : finset ι) (f : ι → R[X]) : @@ -581,7 +617,7 @@ finset.induction_on s (by simp only [sum_empty, sup_empty, degree_zero, le_refl] lemma degree_mul_le (p q : R[X]) : degree (p * q) ≤ degree p + degree q := calc degree (p * q) ≤ (p.support).sup (λi, degree (sum q (λj a, C (coeff p i * a) * X ^ (i + j)))) : begin - simp only [monomial_eq_C_mul_X.symm], + simp only [← C_mul_X_pow_eq_monomial.symm], convert degree_sum_le _ _, exact mul_eq_sum_sum end @@ -640,6 +676,18 @@ lemma monic.ne_zero_of_ne (h : (0:R) ≠ 1) {p : R[X]} (hp : p.monic) : p ≠ 0 := by { nontriviality R, exact hp.ne_zero } +lemma monic_of_nat_degree_le_of_coeff_eq_one (n : ℕ) (pn : p.nat_degree ≤ n) (p1 : p.coeff n = 1) : + monic p := +begin + nontriviality, + refine (congr_arg _ $ nat_degree_eq_of_le_of_coeff_ne_zero pn _).trans p1, + exact ne_of_eq_of_ne p1 one_ne_zero, +end + +lemma monic_of_degree_le_of_coeff_eq_one (n : ℕ) (pn : p.degree ≤ n) (p1 : p.coeff n = 1) : + monic p := +monic_of_nat_degree_le_of_coeff_eq_one n (nat_degree_le_of_degree_le pn) p1 + lemma monic.ne_zero_of_polynomial_ne {r} (hp : monic p) (hne : q ≠ r) : p ≠ 0 := by { haveI := nontrivial.of_polynomial_ne hne, exact hp.ne_zero } @@ -819,38 +867,23 @@ begin exact coeff_mul_degree_add_degree _ _ } } end -lemma subsingleton_of_monic_zero (h : monic (0 : R[X])) : - (∀ p q : R[X], p = q) ∧ (∀ a b : R, a = b) := -by rw [monic.def, leading_coeff_zero] at h; - exact ⟨λ p q, by rw [← mul_one p, ← mul_one q, ← C_1, ← h, C_0, mul_zero, mul_zero], - λ a b, by rw [← mul_one a, ← mul_one b, ← h, mul_zero, mul_zero]⟩ - -lemma zero_le_degree_iff {p : R[X]} : 0 ≤ degree p ↔ p ≠ 0 := -by rw [ne.def, ← degree_eq_bot]; - cases degree p; exact dec_trivial - -lemma degree_nonneg_iff_ne_zero : 0 ≤ degree p ↔ p ≠ 0 := -⟨λ h0p hp0, absurd h0p (by rw [hp0, degree_zero]; exact dec_trivial), - λ hp0, le_of_not_gt (λ h, by simp [gt, degree_eq_bot, *] at *)⟩ +lemma zero_le_degree_iff : 0 ≤ degree p ↔ p ≠ 0 := +by rw [← not_lt, nat.with_bot.lt_zero_iff, degree_eq_bot] lemma nat_degree_eq_zero_iff_degree_le_zero : p.nat_degree = 0 ↔ p.degree ≤ 0 := by rw [← nonpos_iff_eq_zero, nat_degree_le_iff_degree_le, with_bot.coe_zero] theorem degree_le_iff_coeff_zero (f : R[X]) (n : with_bot ℕ) : degree f ≤ n ↔ ∀ m : ℕ, n < m → coeff f m = 0 := -⟨λ (H : finset.sup (f.support) some ≤ n) m (Hm : n < (m : with_bot ℕ)), decidable.of_not_not $ λ H4, - have H1 : m ∉ f.support, - from λ H2, not_lt_of_ge ((finset.sup_le_iff.1 H) m H2 : ((m : with_bot ℕ) ≤ n)) Hm, - H1 $ mem_support_iff.2 H4, -λ H, finset.sup_le $ λ b Hb, decidable.of_not_not $ λ Hn, - mem_support_iff.1 Hb $ H b $ lt_of_not_ge Hn⟩ +by simp only [degree, finset.max, finset.sup_le_iff, mem_support_iff, ne.def, ← not_le, + not_imp_comm] theorem degree_lt_iff_coeff_zero (f : R[X]) (n : ℕ) : degree f < n ↔ ∀ m : ℕ, n ≤ m → coeff f m = 0 := begin refine ⟨λ hf m hm, coeff_eq_zero_of_degree_lt (lt_of_lt_of_le hf (with_bot.coe_le_coe.2 hm)), _⟩, simp only [degree, finset.sup_lt_iff (with_bot.bot_lt_coe n), mem_support_iff, - with_bot.some_eq_coe, with_bot.coe_lt_coe, ← @not_le ℕ], + with_bot.some_eq_coe, with_bot.coe_lt_coe, ← @not_le ℕ, max_eq_sup_coe], exact λ h m, mt (h m), end @@ -882,7 +915,7 @@ lemma eq_C_of_nat_degree_eq_zero (h : nat_degree p = 0) : p = C (coeff p 0) := eq_C_of_nat_degree_le_zero h.le lemma ne_zero_of_coe_le_degree (hdeg : ↑n ≤ p.degree) : p ≠ 0 := -by rw ← degree_nonneg_iff_ne_zero; exact trans (by exact_mod_cast n.zero_le) hdeg +zero_le_degree_iff.mp $ (with_bot.coe_le_coe.mpr n.zero_le).trans hdeg lemma le_nat_degree_of_coe_le_degree (hdeg : ↑n ≤ p.degree) : n ≤ p.nat_degree := @@ -890,21 +923,8 @@ with_bot.coe_le_coe.mp ((degree_eq_nat_degree $ ne_zero_of_coe_le_degree hdeg) lemma degree_sum_fin_lt {n : ℕ} (f : fin n → R) : degree (∑ i : fin n, C (f i) * X ^ (i : ℕ)) < n := -begin - haveI : is_commutative (with_bot ℕ) max := ⟨max_comm⟩, - haveI : is_associative (with_bot ℕ) max := ⟨max_assoc⟩, - calc (∑ i, C (f i) * X ^ (i : ℕ)).degree - ≤ finset.univ.fold (⊔) ⊥ (λ i, (C (f i) * X ^ (i : ℕ)).degree) : degree_sum_le _ _ - ... = finset.univ.fold max ⊥ (λ i, (C (f i) * X ^ (i : ℕ)).degree) : rfl - ... < n : (finset.fold_max_lt (n : with_bot ℕ)).mpr ⟨with_bot.bot_lt_coe _, _⟩, - - rintros ⟨i, hi⟩ -, - calc (C (f ⟨i, hi⟩) * X ^ i).degree - ≤ (C _).degree + (X ^ i).degree : degree_mul_le _ _ - ... ≤ 0 + i : add_le_add degree_C_le (degree_X_pow_le i) - ... = i : zero_add _ - ... < n : with_bot.some_lt_some.mpr hi, -end +(degree_sum_le _ _).trans_lt $ (finset.sup_lt_iff $ with_bot.bot_lt_coe n).2 $ + λ k hk, (degree_C_mul_X_pow_le _ _).trans_lt $ with_bot.coe_lt_coe.2 k.is_lt lemma degree_linear_le : degree (C a * X + C b) ≤ 1 := degree_add_le_of_degree_le (degree_C_mul_X_le _) $ le_trans degree_C_le nat.with_bot.coe_nonneg @@ -989,18 +1009,25 @@ by rw [add_assoc, add_assoc, ← add_assoc (C b * X ^ 2), add_comm, leading_coef end semiring - section nontrivial_semiring variables [semiring R] [nontrivial R] {p q : R[X]} @[simp] lemma degree_X_pow (n : ℕ) : degree ((X : R[X]) ^ n) = n := -by rw [X_pow_eq_monomial, degree_monomial _ (@one_ne_zero R _ _)] +by rw [X_pow_eq_monomial, degree_monomial _ (one_ne_zero' R)] @[simp] lemma nat_degree_X_pow (n : ℕ) : nat_degree ((X : R[X]) ^ n) = n := nat_degree_eq_of_degree_eq_some (degree_X_pow n) +/- This lemma explicitly does not require the `nontrivial R` assumption. -/ +lemma nat_degree_X_pow_le {R : Type*} [semiring R] (n : ℕ) : + (X ^ n : R[X]).nat_degree ≤ n := +begin + nontriviality R, + rwa polynomial.nat_degree_X_pow, +end + theorem not_is_unit_X : ¬ is_unit (X : R[X]) := -λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, @zero_ne_one R _ _ $ +λ ⟨⟨_, g, hfg, hgf⟩, rfl⟩, zero_ne_one' R $ by { change g * monomial 1 1 = 1 at hgf, rw [← coeff_one_zero, ← hgf], simp } @[simp] lemma degree_mul_X : degree (p * X) = degree p + 1 := by simp [monic_X.degree_mul] @@ -1014,7 +1041,10 @@ section ring variables [ring R] {p q : R[X]} lemma degree_sub_le (p q : R[X]) : degree (p - q) ≤ max (degree p) (degree q) := -by simpa only [sub_eq_add_neg, degree_neg q] using degree_add_le p (-q) +by simpa only [degree_neg q] using degree_add_le p (-q) + +lemma nat_degree_sub_le (p q : R[X]) : nat_degree (p - q) ≤ max (nat_degree p) (nat_degree q) := +by simpa only [← nat_degree_neg q] using nat_degree_add_le p (-q) lemma degree_sub_lt (hd : degree p = degree q) (hp0 : p ≠ 0) (hlc : leading_coeff p = leading_coeff q) : @@ -1031,10 +1061,11 @@ calc degree (p - q) = degree (erase (nat_degree q) p + -erase (nat_degree q) q) : degree_neg (erase (nat_degree q) q) ▸ degree_add_le _ _ ... < degree p : max_lt_iff.2 ⟨hd' ▸ degree_erase_lt hp0, hd.symm ▸ degree_erase_lt hq0⟩ +lemma degree_X_sub_C_le (r : R) : (X - C r).degree ≤ 1 := +(degree_sub_le _ _).trans (max_le degree_X_le (degree_C_le.trans zero_le_one)) -lemma nat_degree_X_sub_C_le {r : R} : (X - C r).nat_degree ≤ 1 := -nat_degree_le_iff_degree_le.2 $ le_trans (degree_sub_le _ _) $ max_le degree_X_le $ -le_trans degree_C_le $ with_bot.coe_le_coe.2 zero_le_one +lemma nat_degree_X_sub_C_le (r : R) : (X - C r).nat_degree ≤ 1 := +nat_degree_le_iff_degree_le.2 $ degree_X_sub_C_le r lemma degree_sub_eq_left_of_degree_lt (h : degree q < degree p) : degree (p - q) = degree p := by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_left_of_degree_lt h] } @@ -1042,6 +1073,14 @@ by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_left_of_degree_ lemma degree_sub_eq_right_of_degree_lt (h : degree p < degree q) : degree (p - q) = degree q := by { rw ← degree_neg q at h, rw [sub_eq_add_neg, degree_add_eq_right_of_degree_lt h, degree_neg] } +lemma nat_degree_sub_eq_left_of_nat_degree_lt (h : nat_degree q < nat_degree p) : + nat_degree (p - q) = nat_degree p := +nat_degree_eq_of_degree_eq (degree_sub_eq_left_of_degree_lt (degree_lt_degree h)) + +lemma nat_degree_sub_eq_right_of_nat_degree_lt (h : nat_degree p < nat_degree q) : + nat_degree (p - q) = nat_degree q := +nat_degree_eq_of_degree_eq (degree_sub_eq_right_of_degree_lt (degree_lt_degree h)) + end ring section nonzero_ring @@ -1070,9 +1109,7 @@ end lemma degree_X_pow_add_C {n : ℕ} (hn : 0 < n) (a : R) : degree ((X : R[X]) ^ n + C a) = n := have degree (C a) < degree ((X : R[X]) ^ n), - from calc degree (C a) ≤ 0 : degree_C_le - ... < degree ((X : R[X]) ^ n) : by rwa [degree_X_pow]; - exact with_bot.coe_lt_coe.2 hn, + from degree_C_le.trans_lt $ by rwa [degree_X_pow, with_bot.coe_pos], by rw [degree_add_eq_left_of_degree_lt this, degree_X_pow] lemma X_pow_add_C_ne_zero {n : ℕ} (hn : 0 < n) (a : R) : @@ -1095,6 +1132,12 @@ begin { exact nat_degree_eq_of_degree_eq_some (degree_X_pow_add_C (pos_iff_ne_zero.mpr hn) r) }, end +lemma X_pow_add_C_ne_one {n : ℕ} (hn : 0 < n) (a : R) : (X : R[X]) ^ n + C a ≠ 1 := +λ h, hn.ne' $ by simpa only [nat_degree_X_pow_add_C, nat_degree_one] using congr_arg nat_degree h + +theorem X_add_C_ne_one (r : R) : X + C r ≠ 1 := +pow_one (X : R[X]) ▸ X_pow_add_C_ne_one zero_lt_one r + end semiring end nonzero_ring diff --git a/src/data/polynomial/degree/lemmas.lean b/src/data/polynomial/degree/lemmas.lean index 020dcbdd03bff..260b20daee6a5 100644 --- a/src/data/polynomial/degree/lemmas.lean +++ b/src/data/polynomial/degree/lemmas.lean @@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ import data.polynomial.eval -import tactic.interval_cases /-! # Theory of degrees of polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Some of the main results include - `nat_degree_comp_le` : The degree of the composition is at most the product of degrees @@ -34,7 +36,7 @@ else with_bot.coe_le_coe.1 $ calc ↑(nat_degree (p.comp q)) = degree (p.comp q) : (degree_eq_nat_degree h0).symm ... = _ : congr_arg degree comp_eq_sum_left ... ≤ _ : degree_sum_le _ _ - ... ≤ _ : sup_le (λ n hn, + ... ≤ _ : finset.sup_le (λ n hn, calc degree (C (coeff p n) * q ^ n) ≤ degree (C (coeff p n)) + degree (q ^ n) : degree_mul_le _ _ ... ≤ nat_degree (C (coeff p n)) + n • (degree q) : @@ -61,6 +63,22 @@ lemma nat_degree_le_iff_coeff_eq_zero : p.nat_degree ≤ n ↔ ∀ N : ℕ, n < N → p.coeff N = 0 := by simp_rw [nat_degree_le_iff_degree_le, degree_le_iff_coeff_zero, with_bot.coe_lt_coe] +lemma nat_degree_add_le_iff_left {n : ℕ} (p q : R[X]) (qn : q.nat_degree ≤ n) : + (p + q).nat_degree ≤ n ↔ p.nat_degree ≤ n := +begin + refine ⟨λ h, _, λ h, nat_degree_add_le_of_degree_le h qn⟩, + refine nat_degree_le_iff_coeff_eq_zero.mpr (λ m hm, _), + convert nat_degree_le_iff_coeff_eq_zero.mp h m hm using 1, + rw [coeff_add, nat_degree_le_iff_coeff_eq_zero.mp qn _ hm, add_zero], +end + +lemma nat_degree_add_le_iff_right {n : ℕ} (p q : R[X]) (pn : p.nat_degree ≤ n) : + (p + q).nat_degree ≤ n ↔ q.nat_degree ≤ n := +begin + rw add_comm, + exact nat_degree_add_le_iff_left _ _ pn, +end + lemma nat_degree_C_mul_le (a : R) (f : R[X]) : (C a * f).nat_degree ≤ f.nat_degree := calc @@ -123,6 +141,38 @@ lemma nat_degree_lt_coeff_mul (h : p.nat_degree + q.nat_degree < m + n) : (p * q).coeff (m + n) = 0 := coeff_eq_zero_of_nat_degree_lt (nat_degree_mul_le.trans_lt h) +lemma coeff_mul_of_nat_degree_le (pm : p.nat_degree ≤ m) (qn : q.nat_degree ≤ n) : + (p * q).coeff (m + n) = p.coeff m * q.coeff n := +begin + rcases eq_or_lt_of_le pm with rfl | hm; + rcases eq_or_lt_of_le qn with rfl | hn, + { exact nat_degree_add_coeff_mul _ _ }, + { rw [coeff_eq_zero_of_nat_degree_lt hn, mul_zero], + exact nat_degree_lt_coeff_mul (add_lt_add_left hn _) }, + { rw [coeff_eq_zero_of_nat_degree_lt hm, zero_mul], + exact nat_degree_lt_coeff_mul (add_lt_add_right hm _) }, + { rw [coeff_eq_zero_of_nat_degree_lt hn, mul_zero], + exact nat_degree_lt_coeff_mul (add_lt_add hm hn) }, +end + +lemma coeff_pow_of_nat_degree_le (pn : p.nat_degree ≤ n) : + (p ^ m).coeff (n * m) = (p.coeff n) ^ m := +begin + induction m with m hm, + { simp }, + { rw [pow_succ', pow_succ', ← hm, nat.mul_succ, coeff_mul_of_nat_degree_le _ pn], + refine nat_degree_pow_le.trans (le_trans _ (mul_comm _ _).le), + exact mul_le_mul_of_nonneg_left pn m.zero_le } +end + +lemma coeff_add_eq_left_of_lt (qn : q.nat_degree < n) : + (p + q).coeff n = p.coeff n := +(coeff_add _ _ _).trans $ (congr_arg _ $ coeff_eq_zero_of_nat_degree_lt $ qn).trans $ add_zero _ + +lemma coeff_add_eq_right_of_lt (pn : p.nat_degree < n) : + (p + q).coeff n = q.coeff n := +by { rw add_comm, exact coeff_add_eq_left_of_lt pn } + lemma degree_sum_eq_of_disjoint (f : S → R[X]) (s : finset S) (h : set.pairwise { i | i ∈ s ∧ f i ≠ 0 } (ne on (degree ∘ f))) : degree (s.sum f) = s.sup (λ i, degree (f i)) := @@ -182,6 +232,12 @@ begin simp [H x hx] } end +lemma nat_degree_bit0 (a : R[X]) : (bit0 a).nat_degree ≤ a.nat_degree := +(nat_degree_add_le _ _).trans (max_self _).le + +lemma nat_degree_bit1 (a : R[X]) : (bit1 a).nat_degree ≤ a.nat_degree := +(nat_degree_add_le _ _).trans (by simp [nat_degree_bit0]) + variables [semiring S] lemma nat_degree_pos_of_eval₂_root {p : R[X]} (hp : p ≠ 0) (f : R →+* S) @@ -210,6 +266,37 @@ end end degree end semiring +section ring + +variables [ring R] {p q : R[X]} + +lemma nat_degree_sub : (p - q).nat_degree = (q - p).nat_degree := +by rw [← nat_degree_neg, neg_sub] + +lemma nat_degree_sub_le_iff_left (qn : q.nat_degree ≤ n) : + (p - q).nat_degree ≤ n ↔ p.nat_degree ≤ n := +begin + rw ← nat_degree_neg at qn, + rw [sub_eq_add_neg, nat_degree_add_le_iff_left _ _ qn], +end + +lemma nat_degree_sub_le_iff_right (pn : p.nat_degree ≤ n) : + (p - q).nat_degree ≤ n ↔ q.nat_degree ≤ n := +by rwa [nat_degree_sub, nat_degree_sub_le_iff_left] + +lemma coeff_sub_eq_left_of_lt (dg : q.nat_degree < n) : + (p - q).coeff n = p.coeff n := +begin + rw ← nat_degree_neg at dg, + rw [sub_eq_add_neg, coeff_add_eq_left_of_lt dg], +end + +lemma coeff_sub_eq_neg_right_of_lt (df : p.nat_degree < n) : + (p - q).coeff n = - q.coeff n := +by rwa [sub_eq_add_neg, coeff_add_eq_right_of_lt, coeff_neg] + +end ring + section no_zero_divisors variables [semiring R] [no_zero_divisors R] {p q : R[X]} @@ -240,6 +327,14 @@ begin ne_zero_of_nat_degree_gt (nat.pos_of_ne_zero q0), pow_ne_zero, ne.def, not_false_iff] } end +@[simp] theorem nat_degree_iterate_comp (k : ℕ) : + (p.comp^[k] q).nat_degree = p.nat_degree ^ k * q.nat_degree := +begin + induction k with k IH, + { simp }, + { rw [function.iterate_succ_apply', nat_degree_comp, IH, pow_succ, mul_assoc] } +end + lemma leading_coeff_comp (hq : nat_degree q ≠ 0) : leading_coeff (p.comp q) = leading_coeff p * leading_coeff q ^ nat_degree p := by rw [← coeff_comp_degree_mul_degree hq, ← nat_degree_comp, coeff_nat_degree] diff --git a/src/data/polynomial/degree/trailing_degree.lean b/src/data/polynomial/degree/trailing_degree.lean index 8a9e87a396e93..b78c13868af37 100644 --- a/src/data/polynomial/degree/trailing_degree.lean +++ b/src/data/polynomial/degree/trailing_degree.lean @@ -3,11 +3,15 @@ Copyright (c) 2020 Damiano Testa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Damiano Testa -/ +import data.enat.basic import data.polynomial.degree.definitions /-! # Trailing degree of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `trailing_degree p`: the multiplicity of `X` in the polynomial `p` @@ -35,7 +39,7 @@ variables [semiring R] {p q r : R[X]} `trailing_degree p = some n` when `p ≠ 0` and `n` is the smallest power of `X` that appears in `p`, otherwise `trailing_degree 0 = ⊤`. -/ -def trailing_degree (p : R[X]) : with_top ℕ := p.support.inf some +def trailing_degree (p : R[X]) : ℕ∞ := p.support.min lemma trailing_degree_lt_wf : well_founded (λp q : R[X], trailing_degree p < trailing_degree q) := @@ -66,15 +70,13 @@ by unfold trailing_monic; apply_instance @[simp] lemma nat_trailing_degree_zero : nat_trailing_degree (0 : R[X]) = 0 := rfl lemma trailing_degree_eq_top : trailing_degree p = ⊤ ↔ p = 0 := -⟨λ h, by rw [trailing_degree, ← min_eq_inf_with_top] at h; - exact support_eq_empty.1 (min_eq_none.1 h), -λ h, by simp [h]⟩ +⟨λ h, support_eq_empty.1 (finset.min_eq_top.1 h), λ h, by simp [h]⟩ lemma trailing_degree_eq_nat_trailing_degree (hp : p ≠ 0) : - trailing_degree p = (nat_trailing_degree p : with_top ℕ) := + trailing_degree p = (nat_trailing_degree p : ℕ∞) := let ⟨n, hn⟩ := not_forall.1 (mt option.eq_none_iff_forall_not_mem.2 (mt trailing_degree_eq_top.1 hp)) in -have hn : trailing_degree p = some n := not_not.1 hn, +have hn : trailing_degree p = n := not_not.1 hn, by rw [nat_trailing_degree, hn]; refl lemma trailing_degree_eq_iff_nat_trailing_degree_eq {p : R[X]} {n : ℕ} (hp : p ≠ 0) : @@ -94,7 +96,7 @@ end lemma nat_trailing_degree_eq_of_trailing_degree_eq_some {p : R[X]} {n : ℕ} (h : trailing_degree p = n) : nat_trailing_degree p = n := have hp0 : p ≠ 0, from λ hp0, by rw hp0 at h; exact option.no_confusion h, -option.some_inj.1 $ show (nat_trailing_degree p : with_top ℕ) = n, +option.some_inj.1 $ show (nat_trailing_degree p : ℕ∞) = n, by rwa [← trailing_degree_eq_nat_trailing_degree hp0] @[simp] lemma nat_trailing_degree_le_trailing_degree : @@ -111,8 +113,8 @@ nat_trailing_degree p = nat_trailing_degree q := by unfold nat_trailing_degree; rw h lemma le_trailing_degree_of_ne_zero (h : coeff p n ≠ 0) : trailing_degree p ≤ n := -show @has_le.le (with_top ℕ) _ (p.support.inf some : with_top ℕ) (some n : with_top ℕ), -from finset.inf_le (mem_support_iff.2 h) +show @has_le.le ℕ∞ _ p.support.min n, +from min_le (mem_support_iff.2 h) lemma nat_trailing_degree_le_of_ne_zero (h : coeff p n ≠ 0) : nat_trailing_degree p ≤ n := begin @@ -134,7 +136,7 @@ lemma trailing_degree_ne_of_nat_trailing_degree_ne {n : ℕ} : mt $ λ h, by rw [nat_trailing_degree, h, option.get_or_else_coe] theorem nat_trailing_degree_le_of_trailing_degree_le {n : ℕ} {hp : p ≠ 0} - (H : (n : with_top ℕ) ≤ trailing_degree p) : n ≤ nat_trailing_degree p := + (H : (n : ℕ∞) ≤ trailing_degree p) : n ≤ nat_trailing_degree p := begin rw trailing_degree_eq_nat_trailing_degree hp at H, exact with_top.coe_le_coe.mp H, @@ -150,7 +152,7 @@ begin end @[simp] lemma trailing_degree_monomial (ha : a ≠ 0) : trailing_degree (monomial n a) = n := -by rw [trailing_degree, support_monomial _ _ ha, inf_singleton, with_top.some_eq_coe] +by rw [trailing_degree, support_monomial n ha, min_singleton] lemma nat_trailing_degree_monomial (ha : a ≠ 0) : nat_trailing_degree (monomial n a) = n := by rw [nat_trailing_degree, trailing_degree_monomial ha]; refl @@ -161,13 +163,13 @@ if ha : a = 0 then by simp [ha] else (nat_trailing_degree_monomial ha).le lemma le_trailing_degree_monomial : ↑n ≤ trailing_degree (monomial n a) := if ha : a = 0 then by simp [ha] else (trailing_degree_monomial ha).ge -@[simp] lemma trailing_degree_C (ha : a ≠ 0) : trailing_degree (C a) = (0 : with_top ℕ) := +@[simp] lemma trailing_degree_C (ha : a ≠ 0) : trailing_degree (C a) = (0 : ℕ∞) := trailing_degree_monomial ha -lemma le_trailing_degree_C : (0 : with_top ℕ) ≤ trailing_degree (C a) := +lemma le_trailing_degree_C : (0 : ℕ∞) ≤ trailing_degree (C a) := le_trailing_degree_monomial -lemma trailing_degree_one_le : (0 : with_top ℕ) ≤ trailing_degree (1 : R[X]) := +lemma trailing_degree_one_le : (0 : ℕ∞) ≤ trailing_degree (1 : R[X]) := by rw [← C_1]; exact le_trailing_degree_C @[simp] lemma nat_trailing_degree_C (a : R) : nat_trailing_degree (C a) = 0 := @@ -184,10 +186,10 @@ by simp only [←C_eq_nat_cast, nat_trailing_degree_C] by rw [C_mul_X_pow_eq_monomial, trailing_degree_monomial ha] lemma le_trailing_degree_C_mul_X_pow (n : ℕ) (a : R) : - (n : with_top ℕ) ≤ trailing_degree (C a * X ^ n) := + (n : ℕ∞) ≤ trailing_degree (C a * X ^ n) := by { rw C_mul_X_pow_eq_monomial, exact le_trailing_degree_monomial } -lemma coeff_eq_zero_of_trailing_degree_lt (h : (n : with_top ℕ) < trailing_degree p) : +lemma coeff_eq_zero_of_trailing_degree_lt (h : (n : ℕ∞) < trailing_degree p) : coeff p n = 0 := not_not.1 (mt le_trailing_degree_of_ne_zero (not_le_of_gt h)) @@ -202,15 +204,15 @@ begin end @[simp] lemma coeff_nat_trailing_degree_pred_eq_zero {p : R[X]} - {hp : (0 : with_top ℕ) < nat_trailing_degree p} : p.coeff (p.nat_trailing_degree - 1) = 0 := + {hp : (0 : ℕ∞) < nat_trailing_degree p} : p.coeff (p.nat_trailing_degree - 1) = 0 := coeff_eq_zero_of_lt_nat_trailing_degree $ nat.sub_lt ((with_top.zero_lt_coe (nat_trailing_degree p)).mp hp) nat.one_pos theorem le_trailing_degree_X_pow (n : ℕ) : - (n : with_top ℕ) ≤ trailing_degree (X^n : R[X]) := + (n : ℕ∞) ≤ trailing_degree (X^n : R[X]) := by simpa only [C_1, one_mul] using le_trailing_degree_C_mul_X_pow n (1:R) -theorem le_trailing_degree_X : (1 : with_top ℕ) ≤ trailing_degree (X : R[X]) := +theorem le_trailing_degree_X : (1 : ℕ∞) ≤ trailing_degree (X : R[X]) := le_trailing_degree_monomial lemma nat_trailing_degree_X_le : (X : R[X]).nat_trailing_degree ≤ 1 := @@ -242,6 +244,13 @@ begin exact mem_support_iff.mpr (trailing_coeff_nonzero_iff_nonzero.mpr h), }, end +lemma le_nat_trailing_degree (hp : p ≠ 0) (hn : ∀ m < n, p.coeff m = 0) : + n ≤ p.nat_trailing_degree := +begin + rw nat_trailing_degree_eq_support_min' hp, + exact finset.le_min' _ _ _ (λ m hm, not_lt.1 $ λ hmn, mem_support_iff.1 hm $ hn _ hmn), +end + lemma nat_trailing_degree_le_nat_degree (p : R[X]) : p.nat_trailing_degree ≤ p.nat_degree := begin @@ -265,12 +274,77 @@ begin exact (le_tsub_iff_right key).mp (nat_trailing_degree_le_of_ne_zero hy) }, end +lemma le_trailing_degree_mul : p.trailing_degree + q.trailing_degree ≤ (p * q).trailing_degree := +begin + refine finset.le_min (λ n hn, _), + rw [mem_support_iff, coeff_mul] at hn, + obtain ⟨⟨i, j⟩, hij, hpq⟩ := exists_ne_zero_of_sum_ne_zero hn, + refine (add_le_add (min_le (mem_support_iff.mpr (left_ne_zero_of_mul hpq))) + (min_le (mem_support_iff.mpr (right_ne_zero_of_mul hpq)))).trans (le_of_eq _), + rwa [← with_top.coe_add, with_top.coe_eq_coe, ←nat.mem_antidiagonal], +end + +lemma le_nat_trailing_degree_mul (h : p * q ≠ 0) : + p.nat_trailing_degree + q.nat_trailing_degree ≤ (p * q).nat_trailing_degree := +begin + have hp : p ≠ 0 := λ hp, h (by rw [hp, zero_mul]), + have hq : q ≠ 0 := λ hq, h (by rw [hq, mul_zero]), + rw [←with_top.coe_le_coe, with_top.coe_add, ←trailing_degree_eq_nat_trailing_degree hp, + ←trailing_degree_eq_nat_trailing_degree hq, ←trailing_degree_eq_nat_trailing_degree h], + exact le_trailing_degree_mul, +end + +lemma coeff_mul_nat_trailing_degree_add_nat_trailing_degree : + (p * q).coeff (p.nat_trailing_degree + q.nat_trailing_degree) = + p.trailing_coeff * q.trailing_coeff := +begin + rw coeff_mul, + refine finset.sum_eq_single (p.nat_trailing_degree, q.nat_trailing_degree) _ + (λ h, (h (nat.mem_antidiagonal.mpr rfl)).elim), + rintro ⟨i, j⟩ h₁ h₂, + rw nat.mem_antidiagonal at h₁, + by_cases hi : i < p.nat_trailing_degree, + { rw [coeff_eq_zero_of_lt_nat_trailing_degree hi, zero_mul] }, + by_cases hj : j < q.nat_trailing_degree, + { rw [coeff_eq_zero_of_lt_nat_trailing_degree hj, mul_zero] }, + rw not_lt at hi hj, + refine (h₂ (prod.ext_iff.mpr _).symm).elim, + exact (add_eq_add_iff_eq_and_eq hi hj).mp h₁.symm, +end + +lemma trailing_degree_mul' (h : p.trailing_coeff * q.trailing_coeff ≠ 0) : + (p * q).trailing_degree = p.trailing_degree + q.trailing_degree := +begin + have hp : p ≠ 0 := λ hp, h (by rw [hp, trailing_coeff_zero, zero_mul]), + have hq : q ≠ 0 := λ hq, h (by rw [hq, trailing_coeff_zero, mul_zero]), + refine le_antisymm _ le_trailing_degree_mul, + rw [trailing_degree_eq_nat_trailing_degree hp, trailing_degree_eq_nat_trailing_degree hq, + ← enat.coe_add], + apply le_trailing_degree_of_ne_zero, + rwa coeff_mul_nat_trailing_degree_add_nat_trailing_degree, +end + +lemma nat_trailing_degree_mul' (h : p.trailing_coeff * q.trailing_coeff ≠ 0) : + (p * q).nat_trailing_degree = p.nat_trailing_degree + q.nat_trailing_degree := +begin + have hp : p ≠ 0 := λ hp, h (by rw [hp, trailing_coeff_zero, zero_mul]), + have hq : q ≠ 0 := λ hq, h (by rw [hq, trailing_coeff_zero, mul_zero]), + apply nat_trailing_degree_eq_of_trailing_degree_eq_some, + rw [trailing_degree_mul' h, with_top.coe_add, + ←trailing_degree_eq_nat_trailing_degree hp, ←trailing_degree_eq_nat_trailing_degree hq], +end + +lemma nat_trailing_degree_mul [no_zero_divisors R] (hp : p ≠ 0) (hq : q ≠ 0) : + (p * q).nat_trailing_degree = p.nat_trailing_degree + q.nat_trailing_degree := +nat_trailing_degree_mul' (mul_ne_zero (mt trailing_coeff_eq_zero.mp hp) + (mt trailing_coeff_eq_zero.mp hq)) + end semiring section nonzero_semiring variables [semiring R] [nontrivial R] {p q : R[X]} -@[simp] lemma trailing_degree_one : trailing_degree (1 : R[X]) = (0 : with_top ℕ) := +@[simp] lemma trailing_degree_one : trailing_degree (1 : R[X]) = (0 : ℕ∞) := trailing_degree_C one_ne_zero @[simp] lemma trailing_degree_X : trailing_degree (X : R[X]) = 1 := @@ -321,7 +395,7 @@ lemma coeff_nat_trailing_degree_eq_zero_of_trailing_degree_lt coeff q (nat_trailing_degree p) = 0 := coeff_eq_zero_of_trailing_degree_lt $ nat_trailing_degree_le_trailing_degree.trans_lt h -lemma ne_zero_of_trailing_degree_lt {n : with_top ℕ} (h : trailing_degree p < n) : p ≠ 0 := +lemma ne_zero_of_trailing_degree_lt {n : ℕ∞} (h : trailing_degree p < n) : p ≠ 0 := λ h₀, h.not_le (by simp [h₀]) end semiring diff --git a/src/data/polynomial/denoms_clearable.lean b/src/data/polynomial/denoms_clearable.lean index bf5a0d881afeb..39db6d8a3f533 100644 --- a/src/data/polynomial/denoms_clearable.lean +++ b/src/data/polynomial/denoms_clearable.lean @@ -9,6 +9,9 @@ import data.polynomial.eval /-! # Denominators of evaluation of polynomials at ratios +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Let `i : R → K` be a homomorphism of semirings. Assume that `K` is commutative. If `a` and `b` are elements of `R` such that `i b ∈ K` is invertible, then for any polynomial `f ∈ R[X]` the "mathematical" expression `b ^ f.nat_degree * f (a / b) ∈ K` is in diff --git a/src/data/polynomial/derivative.lean b/src/data/polynomial/derivative.lean index e965a9a62c093..7f8bccce59b7f 100644 --- a/src/data/polynomial/derivative.lean +++ b/src/data/polynomial/derivative.lean @@ -9,6 +9,9 @@ import data.polynomial.eval /-! # The derivative map on polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main definitions * `polynomial.derivative`: The formal derivative of polynomials, expressed as a linear map. @@ -72,13 +75,21 @@ end lemma derivative_monomial (a : R) (n : ℕ) : derivative (monomial n a) = monomial (n - 1) (a * n) := by { rw [derivative_apply, sum_monomial_index, C_mul_X_pow_eq_monomial], simp } -lemma derivative_C_mul_X_pow (a : R) (n : ℕ) : derivative (C a * X ^ n) = C (a * n) * X^(n - 1) := +lemma derivative_C_mul_X (a : R) : derivative (C a * X) = C a := +by simpa only [C_mul_X_eq_monomial, derivative_monomial, nat.cast_one, mul_one] + +lemma derivative_C_mul_X_pow (a : R) (n : ℕ) : derivative (C a * X ^ n) = C (a * n) * X ^ (n - 1) := by rw [C_mul_X_pow_eq_monomial, C_mul_X_pow_eq_monomial, derivative_monomial] -@[simp] lemma derivative_X_pow (n : ℕ) : - derivative (X ^ n : R[X]) = (n : R[X]) * X ^ (n - 1) := +lemma derivative_C_mul_X_sq (a : R) : derivative (C a * X ^ 2) = C (a * 2) * X := +by rw [derivative_C_mul_X_pow, nat.cast_two, pow_one] + +@[simp] lemma derivative_X_pow (n : ℕ) : derivative (X ^ n : R[X]) = C ↑n * X ^ (n - 1) := by convert derivative_C_mul_X_pow (1 : R) n; simp +@[simp] lemma derivative_X_sq : derivative (X ^ 2 : R[X]) = C 2 * X := +by rw [derivative_X_pow, nat.cast_two, pow_one] + @[simp] lemma derivative_C {a : R} : derivative (C a) = 0 := by simp [derivative_apply] @@ -97,10 +108,12 @@ by simp [bit0] @[simp] lemma derivative_bit1 {a : R[X]} : derivative (bit1 a) = bit0 (derivative a) := by simp [bit1] -@[simp] lemma derivative_add {f g : R[X]} : - derivative (f + g) = derivative f + derivative g := +@[simp] lemma derivative_add {f g : R[X]} : derivative (f + g) = derivative f + derivative g := derivative.map_add f g +@[simp] lemma derivative_X_add_C (c : R) : (X + C c).derivative = 1 := +by rw [derivative_add, derivative_X, derivative_C, add_zero] + @[simp] lemma iterate_derivative_add {f g : R[X]} {k : ℕ} : derivative^[k] (f + g) = (derivative^[k] f) + (derivative^[k] g) := derivative.to_add_monoid_hom.iterate_map_add _ _ _ @@ -158,7 +171,7 @@ begin { exact nat.le_pred_of_lt (nat_degree_derivative_lt p0) } end -@[simp] lemma derivative_cast_nat {n : ℕ} : derivative (n : R[X]) = 0 := +@[simp] lemma derivative_nat_cast {n : ℕ} : derivative (n : R[X]) = 0 := begin rw ← map_nat_cast C n, exact derivative_C, @@ -177,7 +190,16 @@ begin exact ih _ this (this.trans_le $ nat.le_of_lt_succ hx) rfl end -theorem nat_degree_eq_zero_of_derivative_eq_zero [no_zero_divisors R] [char_zero R] {f : R[X]} +@[simp] lemma iterate_derivative_C {k} (h : 0 < k) : (derivative^[k] (C a : R[X])) = 0 := +iterate_derivative_eq_zero $ (nat_degree_C _).trans_lt h + +@[simp] lemma iterate_derivative_one {k} (h : 0 < k) : (derivative^[k] (1 : R[X])) = 0 := +iterate_derivative_C h + +@[simp] lemma iterate_derivative_X {k} (h : 1 < k) : (derivative^[k] (X : R[X])) = 0 := +iterate_derivative_eq_zero $ nat_degree_X_le.trans_lt h + +theorem nat_degree_eq_zero_of_derivative_eq_zero [no_zero_smul_divisors ℕ R] {f : R[X]} (h : f.derivative = 0) : f.nat_degree = 0 := begin rcases eq_or_ne f 0 with rfl | hf, @@ -189,22 +211,26 @@ begin have hm : m + 1 = f.nat_degree := tsub_add_cancel_of_le f_nat_degree_pos, have h2 := coeff_derivative f m, rw polynomial.ext_iff at h, - rw [h m, coeff_zero, zero_eq_mul] at h2, - replace h2 := h2.resolve_right (λ h2, by norm_cast at h2), + rw [h m, coeff_zero, ← nat.cast_add_one, ← nsmul_eq_mul', eq_comm, smul_eq_zero] at h2, + replace h2 := h2.resolve_left m.succ_ne_zero, rw [hm, ←leading_coeff, leading_coeff_eq_zero] at h2, exact hf h2 end +theorem eq_C_of_derivative_eq_zero [no_zero_smul_divisors ℕ R] {f : R[X]} (h : f.derivative = 0) : + f = C (f.coeff 0) := +eq_C_of_nat_degree_eq_zero $ nat_degree_eq_zero_of_derivative_eq_zero h + @[simp] lemma derivative_mul {f g : R[X]} : derivative (f * g) = derivative f * g + f * derivative g := -calc derivative (f * g) = f.sum (λn a, g.sum (λm b, (n + m) • (C (a * b) * X^((n + m) - 1)))) : +calc derivative (f * g) = f.sum (λ n a, g.sum (λ m b, (n + m) • (C (a * b) * X ^ ((n + m) - 1)))) : begin rw mul_eq_sum_sum, transitivity, exact derivative_sum, transitivity, { apply finset.sum_congr rfl, assume x hx, exact derivative_sum }, apply finset.sum_congr rfl, assume n hn, apply finset.sum_congr rfl, assume m hm, transitivity, - { apply congr_arg, exact monomial_eq_C_mul_X }, + { exact congr_arg _ C_mul_X_pow_eq_monomial.symm }, dsimp, rw [← smul_mul_assoc, smul_C, nsmul_eq_mul'], exact derivative_C_mul_X_pow _ _ end ... = f.sum (λn a, g.sum (λm b, @@ -216,34 +242,220 @@ calc derivative (f * g) = f.sum (λn a, g.sum (λm b, (n + m) • (C (a * b) * X ... = derivative f * g + f * derivative g : begin conv { to_rhs, congr, - { rw [← sum_C_mul_X_eq g] }, - { rw [← sum_C_mul_X_eq f] } }, + { rw [← sum_C_mul_X_pow_eq g] }, + { rw [← sum_C_mul_X_pow_eq f] } }, simp only [sum, sum_add_distrib, finset.mul_sum, finset.sum_mul, derivative_apply], simp_rw [← smul_mul_assoc, smul_C, nsmul_eq_mul'], end +lemma derivative_eval (p : R[X]) (x : R) : + p.derivative.eval x = p.sum (λ n a, (a * n) * x ^ (n-1)) := +by simp_rw [derivative_apply, eval_sum, eval_mul_X_pow, eval_C] + +@[simp] +theorem derivative_map [semiring S] (p : R[X]) (f : R →+* S) : + (p.map f).derivative = p.derivative.map f := +begin + let n := max p.nat_degree ((map f p).nat_degree), + rw [derivative_apply, derivative_apply], + rw [sum_over_range' _ _ (n + 1) ((le_max_left _ _).trans_lt (lt_add_one _))], + rw [sum_over_range' _ _ (n + 1) ((le_max_right _ _).trans_lt (lt_add_one _))], + simp only [polynomial.map_sum, polynomial.map_mul, polynomial.map_C, map_mul, coeff_map, + map_nat_cast, polynomial.map_nat_cast, polynomial.map_pow, map_X], + all_goals { intro n, rw [zero_mul, C_0, zero_mul], } +end + +@[simp] +theorem iterate_derivative_map [semiring S] (p : R[X]) (f : R →+* S) (k : ℕ): + polynomial.derivative^[k] (p.map f) = (polynomial.derivative^[k] p).map f := +begin + induction k with k ih generalizing p, + { simp, }, + { simp only [ih, function.iterate_succ, polynomial.derivative_map, function.comp_app], }, +end + +lemma derivative_nat_cast_mul {n : ℕ} {f : R[X]} : + (↑n * f).derivative = n * f.derivative := +by simp + +@[simp] lemma iterate_derivative_nat_cast_mul {n k : ℕ} {f : R[X]} : + derivative^[k] (n * f) = n * (derivative^[k] f) := +by induction k with k ih generalizing f; simp* + +lemma mem_support_derivative [no_zero_smul_divisors ℕ R] + (p : R[X]) (n : ℕ) : + n ∈ (derivative p).support ↔ n + 1 ∈ p.support := +suffices ¬p.coeff (n + 1) * (n + 1 : ℕ) = 0 ↔ coeff p (n + 1) ≠ 0, + by simpa only [mem_support_iff, coeff_derivative, ne.def, nat.cast_succ], +by { rw [← nsmul_eq_mul', smul_eq_zero], simp only [nat.succ_ne_zero, false_or] } + +@[simp] lemma degree_derivative_eq [no_zero_smul_divisors ℕ R] + (p : R[X]) (hp : 0 < nat_degree p) : + degree (derivative p) = (nat_degree p - 1 : ℕ) := +begin + have h0 : p ≠ 0, + { contrapose! hp, + simp [hp] }, + apply le_antisymm, + { rw derivative_apply, + apply le_trans (degree_sum_le _ _) (finset.sup_le (λ n hn, _)), + apply le_trans (degree_C_mul_X_pow_le _ _) (with_bot.coe_le_coe.2 (tsub_le_tsub_right _ _)), + apply le_nat_degree_of_mem_supp _ hn }, + { refine le_sup _, + rw [mem_support_derivative, tsub_add_cancel_of_le, mem_support_iff], + { show ¬ leading_coeff p = 0, + rw [leading_coeff_eq_zero], + assume h, rw [h, nat_degree_zero] at hp, + exact lt_irrefl 0 (lt_of_le_of_lt (zero_le _) hp), }, + exact hp } +end + +lemma coeff_iterate_derivative_as_prod_Ico {k} (p : R[X]) : + ∀ m : ℕ, (derivative^[k] p).coeff m = (∏ i in Ico m.succ (m + k.succ), i) • (p.coeff (m + k)) := +begin + induction k with k ih, + { simp only [add_zero, forall_const, one_smul, Ico_self, eq_self_iff_true, + function.iterate_zero_apply, prod_empty] }, + { intro m, rw [function.iterate_succ_apply', coeff_derivative, ih (m+1), ← nat.cast_add_one, + ← nsmul_eq_mul', smul_smul, mul_comm], + apply congr_arg2, + { have set_eq : (Ico m.succ (m + k.succ.succ)) = (Ico (m + 1).succ (m + 1 + k.succ)) ∪ {m+1}, + { simp_rw [← nat.Ico_succ_singleton, union_comm, nat.succ_eq_add_one, add_comm (k + 1), + add_assoc], + rw [Ico_union_Ico_eq_Ico]; simp_rw [add_le_add_iff_left, le_add_self], }, + rw [set_eq, prod_union, prod_singleton], + { rw [disjoint_singleton_right, mem_Ico], + exact λ h, (nat.lt_succ_self _).not_le h.1 } }, + { exact congr_arg _ (nat.succ_add m k) } }, +end + +lemma coeff_iterate_derivative_as_prod_range {k} (p : R[X]) : + ∀ m : ℕ, (derivative^[k] p).coeff m = (∏ i in range k, (m + k - i)) • p.coeff (m + k) := +begin + induction k with k ih, + { simp }, + intro m, + calc (derivative^[k + 1] p).coeff m + = (∏ i in range k, (m + k.succ - i)) • p.coeff (m + k.succ) * (m + 1) : + by rw [function.iterate_succ_apply', coeff_derivative, ih m.succ, nat.succ_add, nat.add_succ] + ... = ((∏ i in range k, (m + k.succ - i)) * (m + 1)) • p.coeff (m + k.succ) : + by rw [← nat.cast_add_one, ← nsmul_eq_mul', smul_smul, mul_comm] + ... = (∏ i in range k.succ, (m + k.succ - i)) • p.coeff (m + k.succ) : + by rw [prod_range_succ, add_tsub_assoc_of_le k.le_succ, nat.succ_sub le_rfl, tsub_self] +end + +lemma iterate_derivative_mul {n} (p q : R[X]) : + derivative^[n] (p * q) = + ∑ k in range n.succ, + n.choose k • ((derivative^[n - k] p) * (derivative^[k] q)) := +begin + induction n with n IH, + { simp }, + + calc derivative^[n + 1] (p * q) + = (∑ (k : ℕ) in range n.succ, + (n.choose k) • ((derivative^[n - k] p) * (derivative^[k] q))).derivative : + by rw [function.iterate_succ_apply', IH] + ... = ∑ (k : ℕ) in range n.succ, + (n.choose k) • ((derivative^[n - k + 1] p) * (derivative^[k] q)) + + ∑ (k : ℕ) in range n.succ, + (n.choose k) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) : + by simp_rw [derivative_sum, derivative_smul, derivative_mul, function.iterate_succ_apply', + smul_add, sum_add_distrib] + ... = (∑ (k : ℕ) in range n.succ, + (n.choose k.succ) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) + + 1 • ((derivative^[n + 1] p) * (derivative^[0] q))) + + ∑ (k : ℕ) in range n.succ, + (n.choose k) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) : _ + ... = ∑ (k : ℕ) in range n.succ, + (n.choose k) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) + + ∑ (k : ℕ) in range n.succ, + (n.choose k.succ) • ((derivative^[n - k] p) * (derivative^[k + 1] q)) + + 1 • ((derivative^[n + 1] p) * (derivative^[0] q)) : + by rw [add_comm, add_assoc] + ... = ∑ (i : ℕ) in range n.succ, + ((n+1).choose (i+1)) • ((derivative^[n + 1 - (i + 1)] p) * (derivative^[i + 1] q)) + + 1 • ((derivative^[n + 1] p) * (derivative^[0] q)) : + by simp_rw [nat.choose_succ_succ, nat.succ_sub_succ, add_smul, sum_add_distrib] + ... = ∑ (k : ℕ) in range n.succ.succ, + (n.succ.choose k) • (derivative^[n.succ - k] p * (derivative^[k] q)) : + by rw [sum_range_succ' _ n.succ, nat.choose_zero_right, tsub_zero], + + congr, + refine (sum_range_succ' _ _).trans (congr_arg2 (+) _ _), + { rw [sum_range_succ, nat.choose_succ_self, zero_smul, add_zero], + refine sum_congr rfl (λ k hk, _), + rw mem_range at hk, + congr, + rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hk), nat.succ_sub_succ] }, + { rw [nat.choose_zero_right, tsub_zero] }, +end + end semiring section comm_semiring variables [comm_semiring R] -lemma derivative_eval (p : R[X]) (x : R) : - p.derivative.eval x = p.sum (λ n a, (a * n)*x^(n-1)) := -by simp only [derivative_apply, eval_sum, eval_pow, eval_C, eval_X, eval_nat_cast, eval_mul] - theorem derivative_pow_succ (p : R[X]) (n : ℕ) : - (p ^ (n + 1)).derivative = (n + 1) * (p ^ n) * p.derivative := -nat.rec_on n (by rw [pow_one, nat.cast_zero, zero_add, one_mul, pow_zero, one_mul]) $ λ n ih, -by rw [pow_succ', derivative_mul, ih, mul_right_comm, ← add_mul, - add_mul (n.succ : R[X]), one_mul, pow_succ', mul_assoc, n.cast_succ] + (p ^ (n + 1)).derivative = C ↑(n + 1) * (p ^ n) * p.derivative := +nat.rec_on n (by rw [pow_one, nat.cast_one, C_1, one_mul, pow_zero, one_mul]) $ λ n ih, +by rw [pow_succ', derivative_mul, ih, nat.add_one, mul_right_comm, nat.cast_add n.succ, C_add, + add_mul, add_mul, pow_succ', ← mul_assoc, nat.cast_one, C_1, one_mul] theorem derivative_pow (p : R[X]) (n : ℕ) : - (p ^ n).derivative = n * (p ^ (n - 1)) * p.derivative := -nat.cases_on n (by rw [pow_zero, derivative_one, nat.cast_zero, zero_mul, zero_mul]) $ λ n, + (p ^ n).derivative = C ↑n * (p ^ (n - 1)) * p.derivative := +nat.cases_on n (by rw [pow_zero, derivative_one, nat.cast_zero, C_0, zero_mul, zero_mul]) $ λ n, by rw [p.derivative_pow_succ n, n.succ_sub_one, n.cast_succ] -lemma derivative_comp (p q : R[X]) : - (p.comp q).derivative = q.derivative * p.derivative.comp q := +theorem derivative_sq (p : R[X]) : (p ^ 2).derivative = C 2 * p * p.derivative := +by rw [derivative_pow_succ, nat.cast_two, pow_one] + +theorem dvd_iterate_derivative_pow (f : R[X]) (n : ℕ) {m : ℕ} (c : R) (hm : m ≠ 0) : + (n : R) ∣ eval c (derivative^[m] (f ^ n)) := +begin + obtain ⟨m, rfl⟩ := nat.exists_eq_succ_of_ne_zero hm, + rw [function.iterate_succ_apply, derivative_pow, mul_assoc, C_eq_nat_cast, + iterate_derivative_nat_cast_mul, eval_mul, eval_nat_cast], + exact dvd_mul_right _ _, +end + +lemma iterate_derivative_X_pow_eq_nat_cast_mul (n k : ℕ) : + (derivative^[k] (X ^ n : R[X])) = ↑(nat.desc_factorial n k) * X ^ (n - k) := +begin + induction k with k ih, + { rw [function.iterate_zero_apply, tsub_zero, nat.desc_factorial_zero, nat.cast_one, one_mul] }, + { rw [function.iterate_succ_apply', ih, derivative_nat_cast_mul, derivative_X_pow, C_eq_nat_cast, + nat.succ_eq_add_one, nat.desc_factorial_succ, nat.sub_sub, nat.cast_mul, ←mul_assoc, + mul_comm ↑(nat.desc_factorial _ _)] }, +end + +lemma iterate_derivative_X_pow_eq_C_mul (n k : ℕ) : + (derivative^[k] (X ^ n : R[X])) = C ↑(nat.desc_factorial n k) * X ^ (n - k) := +by rw [iterate_derivative_X_pow_eq_nat_cast_mul n k, C_eq_nat_cast] + +lemma iterate_derivative_X_pow_eq_smul (n : ℕ) (k : ℕ) : + (derivative^[k] (X ^ n : R[X])) = (nat.desc_factorial n k : R) • X ^ (n - k) := +by rw [iterate_derivative_X_pow_eq_C_mul n k, smul_eq_C_mul] + +lemma derivative_X_add_C_pow (c : R) (m : ℕ) : + ((X + C c) ^ m).derivative = C ↑m * (X + C c) ^ (m - 1) := +by rw [derivative_pow, derivative_X_add_C, mul_one] + +lemma derivative_X_add_C_sq (c : R) : ((X + C c) ^ 2).derivative = C 2 * (X + C c) := +by rw [derivative_sq, derivative_X_add_C, mul_one] + +lemma iterate_derivative_X_add_pow (n k : ℕ) (c : R) : derivative^[k] ((X + C c) ^ n) = + ↑(∏ i in finset.range k, (n - i)) * (X + C c) ^ (n - k) := +begin + induction k with k IH, + { rw [function.iterate_zero_apply, finset.range_zero, finset.prod_empty, nat.cast_one, one_mul, + tsub_zero] }, + { simp only [function.iterate_succ_apply', IH, derivative_mul, zero_mul, derivative_nat_cast, + zero_add, finset.prod_range_succ, C_eq_nat_cast, nat.sub_sub, ←mul_assoc, + derivative_X_add_C_pow, nat.succ_eq_add_one, nat.cast_mul] }, +end + +lemma derivative_comp (p q : R[X]) : (p.comp q).derivative = q.derivative * p.derivative.comp q := begin apply polynomial.induction_on' p, { intros p₁ p₂ h₁ h₂, simp [h₁, h₂, mul_add], }, @@ -255,28 +467,6 @@ begin simp only [mul_assoc], } end -@[simp] -theorem derivative_map [comm_semiring S] (p : R[X]) (f : R →+* S) : - (p.map f).derivative = p.derivative.map f := -polynomial.induction_on p - (λ r, by rw [map_C, derivative_C, derivative_C, polynomial.map_zero]) - (λ p q ihp ihq, by rw [polynomial.map_add, derivative_add, ihp, ihq, derivative_add, - polynomial.map_add]) - (λ n r ih, by rw [polynomial.map_mul, polynomial.map_C, polynomial.map_pow, polynomial.map_X, - derivative_mul, derivative_pow_succ, derivative_C, zero_mul, zero_add, derivative_X, mul_one, - derivative_mul, derivative_pow_succ, derivative_C, zero_mul, zero_add, derivative_X, mul_one, - polynomial.map_mul, polynomial.map_C, polynomial.map_mul, polynomial.map_pow, - polynomial.map_add, polynomial.map_nat_cast, polynomial.map_one, polynomial.map_X]) - -@[simp] -theorem iterate_derivative_map [comm_semiring S] (p : R[X]) (f : R →+* S) (k : ℕ): - polynomial.derivative^[k] (p.map f) = (polynomial.derivative^[k] p).map f := -begin - induction k with k ih generalizing p, - { simp, }, - { simp [ih], }, -end - /-- Chain rule for formal derivative of polynomials. -/ theorem derivative_eval₂_C (p q : R[X]) : (p.eval₂ C q).derivative = p.derivative.eval₂ C q * q.derivative := @@ -305,10 +495,6 @@ begin { simp [hij] } end -@[simp] lemma iterate_derivative_cast_nat_mul {n k : ℕ} {f : R[X]} : - derivative^[k] (n * f) = n * (derivative^[k] f) := -by induction k with k ih generalizing f; simp* - end comm_semiring section ring @@ -322,26 +508,42 @@ linear_map.map_neg derivative f derivative^[k] (-f) = - (derivative^[k] f) := (@derivative R _).to_add_monoid_hom.iterate_map_neg _ _ -@[simp] lemma derivative_sub {f g : R[X]} : - derivative (f - g) = derivative f - derivative g := +@[simp] lemma derivative_sub {f g : R[X]} : derivative (f - g) = derivative f - derivative g := linear_map.map_sub derivative f g +@[simp] lemma derivative_X_sub_C (c : R) : (X - C c).derivative = 1 := +by rw [derivative_sub, derivative_X, derivative_C, sub_zero] + @[simp] lemma iterate_derivative_sub {k : ℕ} {f g : R[X]} : derivative^[k] (f - g) = (derivative^[k] f) - (derivative^[k] g) := by induction k with k ih generalizing f g; simp* +@[simp] lemma derivative_int_cast {n : ℤ} : derivative (n : R[X]) = 0 := +begin + rw ← C_eq_int_cast n, + exact derivative_C, +end + +lemma derivative_int_cast_mul {n : ℤ} {f : R[X]} : + (↑n * f).derivative = n * f.derivative := +by simp + +@[simp] lemma iterate_derivative_int_cast_mul {n : ℤ} {k : ℕ} {f : R[X]} : + derivative^[k] (↑n * f) = n * (derivative^[k] f) := +by induction k with k ih generalizing f; simp* + end ring section comm_ring variables [comm_ring R] lemma derivative_comp_one_sub_X (p : R[X]) : - (p.comp (1-X)).derivative = -p.derivative.comp (1-X) := + (p.comp (1 - X)).derivative = -p.derivative.comp (1 - X) := by simp [derivative_comp] @[simp] lemma iterate_derivative_comp_one_sub_X (p : R[X]) (k : ℕ) : - derivative^[k] (p.comp (1-X)) = (-1)^k * (derivative^[k] p).comp (1-X) := + derivative^[k] (p.comp (1 - X)) = (-1) ^ k * (derivative^[k] p).comp (1 - X) := begin induction k with k ih generalizing p, { simp, }, @@ -356,38 +558,19 @@ begin simpa using (eval_ring_hom r).map_multiset_prod (multiset.map (λ a, X - C a) (S.erase r)), end -end comm_ring - -section no_zero_divisors -variables [ring R] [no_zero_divisors R] +lemma derivative_X_sub_C_pow (c : R) (m : ℕ) : + ((X - C c) ^ m).derivative = C ↑m * (X - C c) ^ (m - 1) := +by rw [derivative_pow, derivative_X_sub_C, mul_one] -lemma mem_support_derivative [char_zero R] (p : R[X]) (n : ℕ) : - n ∈ (derivative p).support ↔ n + 1 ∈ p.support := -suffices (¬(coeff p (n + 1) = 0 ∨ ((n + 1:ℕ) : R) = 0)) ↔ coeff p (n + 1) ≠ 0, - by simpa only [mem_support_iff, coeff_derivative, ne.def, mul_eq_zero], -by { rw [nat.cast_eq_zero], simp only [nat.succ_ne_zero, or_false] } +lemma derivative_X_sub_C_sq (c : R) : ((X - C c) ^ 2).derivative = C 2 * (X - C c) := +by rw [derivative_sq, derivative_X_sub_C, mul_one] -@[simp] lemma degree_derivative_eq [char_zero R] (p : R[X]) (hp : 0 < nat_degree p) : - degree (derivative p) = (nat_degree p - 1 : ℕ) := -begin - have h0 : p ≠ 0, - { contrapose! hp, - simp [hp] }, - apply le_antisymm, - { rw derivative_apply, - apply le_trans (degree_sum_le _ _) (sup_le (λ n hn, _)), - apply le_trans (degree_C_mul_X_pow_le _ _) (with_bot.coe_le_coe.2 (tsub_le_tsub_right _ _)), - apply le_nat_degree_of_mem_supp _ hn }, - { refine le_sup _, - rw [mem_support_derivative, tsub_add_cancel_of_le, mem_support_iff], - { show ¬ leading_coeff p = 0, - rw [leading_coeff_eq_zero], - assume h, rw [h, nat_degree_zero] at hp, - exact lt_irrefl 0 (lt_of_le_of_lt (zero_le _) hp), }, - exact hp } -end +lemma iterate_derivative_X_sub_pow (n k : ℕ) (c : R) : + (derivative^[k] ((X - C c) ^ n)) = (↑(∏ i in finset.range k, (n - i))) * (X - C c) ^ (n - k) := +by simp_rw [sub_eq_add_neg, ←C_neg, iterate_derivative_X_add_pow] -end no_zero_divisors +end comm_ring end derivative + end polynomial diff --git a/src/data/polynomial/div.lean b/src/data/polynomial/div.lean index d00f41b8ff398..414337e97976b 100644 --- a/src/data/polynomial/div.lean +++ b/src/data/polynomial/div.lean @@ -3,6 +3,7 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ +import data.polynomial.algebra_map import data.polynomial.inductions import data.polynomial.monic import ring_theory.multiplicity @@ -10,6 +11,9 @@ import ring_theory.multiplicity /-! # Division of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The main defs are `div_by_monic` and `mod_by_monic`. The compatibility between these is given by `mod_by_monic_add_div`. We also define `root_multiplicity`. @@ -26,10 +30,25 @@ variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ section comm_semiring variables [comm_semiring R] -theorem X_dvd_iff {α : Type u} [comm_semiring α] {f : α[X]} : X ∣ f ↔ f.coeff 0 = 0 := +theorem X_dvd_iff {f : R[X]} : X ∣ f ↔ f.coeff 0 = 0 := ⟨λ ⟨g, hfg⟩, by rw [hfg, mul_comm, coeff_mul_X_zero], λ hf, ⟨f.div_X, by rw [mul_comm, ← add_zero (f.div_X * X), ← C_0, ← hf, div_X_mul_X_add]⟩⟩ +theorem X_pow_dvd_iff {f : R[X]} {n : ℕ} : + X^n ∣ f ↔ ∀ d < n, f.coeff d = 0 := +⟨λ ⟨g, hgf⟩ d hd, by simp only [hgf, coeff_X_pow_mul', ite_eq_right_iff, not_le_of_lt hd, + is_empty.forall_iff], λ hd, +begin + induction n with n hn, + { simp only [pow_zero, one_dvd] }, + { obtain ⟨g, hgf⟩ := hn (λ d : ℕ, λ H : d < n, hd _ (nat.lt_succ_of_lt H)), + have := coeff_X_pow_mul g n 0, + rw [zero_add, ← hgf, hd n (nat.lt_succ_self n)] at this, + obtain ⟨k, hgk⟩ := polynomial.X_dvd_iff.mpr this.symm, + use k, + rwa [pow_succ, mul_comm X _, mul_assoc, ← hgk]}, +end⟩ + end comm_semiring @@ -150,12 +169,12 @@ begin end @[simp] lemma mod_by_monic_zero (p : R[X]) : p %ₘ 0 = p := -if h : monic (0 : R[X]) then (subsingleton_of_monic_zero h).1 _ _ else -by unfold mod_by_monic div_mod_by_monic_aux; rw dif_neg h +if h : monic (0 : R[X]) then by { haveI := monic_zero_iff_subsingleton.mp h, simp } +else by unfold mod_by_monic div_mod_by_monic_aux; rw dif_neg h @[simp] lemma div_by_monic_zero (p : R[X]) : p /ₘ 0 = 0 := -if h : monic (0 : R[X]) then (subsingleton_of_monic_zero h).1 _ _ else -by unfold div_by_monic div_mod_by_monic_aux; rw dif_neg h +if h : monic (0 : R[X]) then by { haveI := monic_zero_iff_subsingleton.mp h, simp } +else by unfold div_by_monic div_mod_by_monic_aux; rw dif_neg h lemma div_by_monic_eq_of_not_monic (p : R[X]) (hq : ¬monic q) : p /ₘ q = 0 := dif_neg hq @@ -376,11 +395,26 @@ lemma mul_div_by_monic_eq_iff_is_root : (X - C a) * (p /ₘ (X - C a)) = p ↔ i by conv {to_rhs, rw ← mod_by_monic_add_div p (monic_X_sub_C a)}; rw [mod_by_monic_X_sub_C_eq_C_eval, h, C_0, zero_add]⟩ -lemma dvd_iff_is_root : (X - C a) ∣ p ↔ is_root p a := +lemma dvd_iff_is_root : X - C a ∣ p ↔ is_root p a := ⟨λ h, by rwa [← dvd_iff_mod_by_monic_eq_zero (monic_X_sub_C _), mod_by_monic_X_sub_C_eq_C_eval, ← C_0, C_inj] at h, λ h, ⟨(p /ₘ (X - C a)), by rw mul_div_by_monic_eq_iff_is_root.2 h⟩⟩ +lemma X_sub_C_dvd_sub_C_eval : X - C a ∣ p - C (p.eval a) := +by rw [dvd_iff_is_root, is_root, eval_sub, eval_C, sub_self] + +lemma mem_span_C_X_sub_C_X_sub_C_iff_eval_eval_eq_zero {b : R[X]} {P : R[X][X]} : + P ∈ (ideal.span {C (X - C a), X - C b} : ideal R[X][X]) ↔ (P.eval b).eval a = 0 := +begin + rw [ideal.mem_span_pair], + split; intro h, + { rcases h with ⟨_, _, rfl⟩, + simp only [eval_C, eval_X, eval_add, eval_sub, eval_mul, add_zero, mul_zero, sub_self] }, + { cases dvd_iff_is_root.mpr h with p hp, + cases @X_sub_C_dvd_sub_C_eval _ b _ P with q hq, + exact ⟨C p, q, by rw [mul_comm, mul_comm q, eq_add_of_sub_eq' hq, hp, C_mul]⟩ } +end + lemma mod_by_monic_X (p : R[X]) : p %ₘ X = C (p.eval 0) := by rw [← mod_by_monic_X_sub_C_eq_C_eval, C_0, sub_zero] @@ -405,6 +439,14 @@ begin simp [dvd_iff_is_root] end +lemma mul_div_mod_by_monic_cancel_left (p : R[X]) {q : R[X]} (hmo : q.monic) : q * p /ₘ q = p := +begin + nontriviality R, + refine (div_mod_by_monic_unique _ 0 hmo ⟨by rw [zero_add], _⟩).1, + rw [degree_zero], + exact ne.bot_lt (λ h, hmo.ne_zero (degree_eq_bot.1 h)) +end + variable (R) lemma not_is_field : ¬ is_field R[X] := @@ -422,11 +464,14 @@ end variable {R} +lemma ker_eval_ring_hom (x : R) : (eval_ring_hom x).ker = ideal.span {X - C x} := +by { ext y, simpa only [ideal.mem_span_singleton, dvd_iff_is_root] } + section multiplicity /-- An algorithm for deciding polynomial divisibility. -The algorithm is "compute `p %ₘ q` and compare to `0`". ` +The algorithm is "compute `p %ₘ q` and compare to `0`". See `polynomial.mod_by_monic` for the algorithm that computes `%ₘ`. - -/ +-/ def decidable_dvd_monic (p : R[X]) (hq : monic q) : decidable (q ∣ p) := decidable_of_iff (p %ₘ q = 0) (dvd_iff_mod_by_monic_eq_zero hq) @@ -442,7 +487,7 @@ begin end /-- The largest power of `X - C a` which divides `p`. -This is computable via the divisibility algorithm `decidable_dvd_monic`. -/ +This is computable via the divisibility algorithm `polynomial.decidable_dvd_monic`. -/ def root_multiplicity (a : R) (p : R[X]) : ℕ := if h0 : p = 0 then 0 else let I : decidable_pred (λ n : ℕ, ¬(X - C a) ^ (n + 1) ∣ p) := @@ -457,30 +502,25 @@ by simp [multiplicity, root_multiplicity, part.dom]; @[simp] lemma root_multiplicity_zero {x : R} : root_multiplicity x 0 = 0 := dif_pos rfl +@[simp] lemma root_multiplicity_eq_zero_iff {p : R[X]} {x : R} : + root_multiplicity x p = 0 ↔ (is_root p x → p = 0) := +by simp only [root_multiplicity_eq_multiplicity, dite_eq_left_iff, part_enat.get_eq_iff_eq_coe, + nat.cast_zero, multiplicity.multiplicity_eq_zero, dvd_iff_is_root, not_imp_not] + lemma root_multiplicity_eq_zero {p : R[X]} {x : R} (h : ¬ is_root p x) : root_multiplicity x p = 0 := -begin - rw root_multiplicity_eq_multiplicity, - split_ifs, { refl }, - rw [← enat.coe_inj, enat.coe_get, multiplicity.multiplicity_eq_zero_of_not_dvd, nat.cast_zero], - intro hdvd, - exact h (dvd_iff_is_root.mp hdvd) -end +root_multiplicity_eq_zero_iff.2 (λ h', (h h').elim) + +@[simp] lemma root_multiplicity_pos' {p : R[X]} {x : R} : + 0 < root_multiplicity x p ↔ p ≠ 0 ∧ is_root p x := +by rw [pos_iff_ne_zero, ne.def, root_multiplicity_eq_zero_iff, not_imp, and.comm] lemma root_multiplicity_pos {p : R[X]} (hp : p ≠ 0) {x : R} : 0 < root_multiplicity x p ↔ is_root p x := -begin - rw [← dvd_iff_is_root, root_multiplicity_eq_multiplicity, dif_neg hp, - ← enat.coe_lt_coe, enat.coe_get], - exact multiplicity.dvd_iff_multiplicity_pos -end +root_multiplicity_pos'.trans (and_iff_right hp) @[simp] lemma root_multiplicity_C (r a : R) : root_multiplicity a (C r) = 0 := -begin - rcases eq_or_ne r 0 with rfl|hr, - { simp }, - { exact root_multiplicity_eq_zero (not_is_root_C _ _ hr) } -end +by simp only [root_multiplicity_eq_zero_iff, is_root, eval_C, C_eq_zero, imp_self] lemma pow_root_multiplicity_dvd (p : R[X]) (a : R) : (X - C a) ^ root_multiplicity a p ∣ p := diff --git a/src/data/polynomial/erase_lead.lean b/src/data/polynomial/erase_lead.lean index 079a759d76fbd..0b6b93a170f37 100644 --- a/src/data/polynomial/erase_lead.lean +++ b/src/data/polynomial/erase_lead.lean @@ -3,11 +3,15 @@ Copyright (c) 2020 Damiano Testa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Damiano Testa -/ +import algebra.big_operators.fin import data.polynomial.degree.definitions /-! # Erase the leading term of a univariate polynomial +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Definition * `erase_lead f`: the polynomial `f - leading term of f` @@ -53,13 +57,7 @@ by simp only [erase_lead, erase_zero] @[simp] lemma erase_lead_add_monomial_nat_degree_leading_coeff (f : R[X]) : f.erase_lead + monomial f.nat_degree f.leading_coeff = f := -begin - ext i, - simp only [erase_lead_coeff, coeff_monomial, coeff_add, @eq_comm _ _ i], - split_ifs with h, - { subst i, simp only [leading_coeff, zero_add] }, - { exact add_zero _ } -end +(add_comm _ _).trans (f.monomial_add_erase _) @[simp] lemma erase_lead_add_C_mul_X_pow (f : R[X]) : f.erase_lead + (C f.leading_coeff) * X ^ f.nat_degree = f := @@ -75,17 +73,24 @@ by rw [C_mul_X_pow_eq_monomial, self_sub_monomial_nat_degree_leading_coeff] lemma erase_lead_ne_zero (f0 : 2 ≤ f.support.card) : erase_lead f ≠ 0 := begin - rw [ne.def, ← card_support_eq_zero, erase_lead_support], + rw [ne, ← card_support_eq_zero, erase_lead_support], exact (zero_lt_one.trans_le $ (tsub_le_tsub_right f0 1).trans finset.pred_card_le_card_erase).ne.symm end -@[simp] lemma nat_degree_not_mem_erase_lead_support : f.nat_degree ∉ (erase_lead f).support := -by simp [not_mem_support_iff] +lemma lt_nat_degree_of_mem_erase_lead_support {a : ℕ} (h : a ∈ (erase_lead f).support) : + a < f.nat_degree := +begin + rw [erase_lead_support, mem_erase] at h, + exact (le_nat_degree_of_mem_supp a h.2).lt_of_ne h.1, +end lemma ne_nat_degree_of_mem_erase_lead_support {a : ℕ} (h : a ∈ (erase_lead f).support) : a ≠ f.nat_degree := -by { rintro rfl, exact nat_degree_not_mem_erase_lead_support h } +(lt_nat_degree_of_mem_erase_lead_support h).ne + +lemma nat_degree_not_mem_erase_lead_support : f.nat_degree ∉ (erase_lead f).support := +λ h, ne_nat_degree_of_mem_erase_lead_support h rfl lemma erase_lead_support_card_lt (h : f ≠ 0) : (erase_lead f).support.card < f.support.card := begin @@ -149,14 +154,7 @@ begin exact nd (nat_degree_add_eq_right_of_nat_degree_lt pq) } end -lemma erase_lead_degree_le : (erase_lead f).degree ≤ f.degree := -begin - rw degree_le_iff_coeff_zero, - intros i hi, - rw erase_lead_coeff, - split_ifs with h, { refl }, - apply coeff_eq_zero_of_degree_lt hi -end +lemma erase_lead_degree_le : (erase_lead f).degree ≤ f.degree := f.degree_erase_le _ lemma erase_lead_nat_degree_le_aux : (erase_lead f).nat_degree ≤ f.nat_degree := nat_degree_le_nat_degree erase_lead_degree_le @@ -240,7 +238,7 @@ lemma mono_map_nat_degree_eq {S F : Type*} [semiring S] begin refine induction_with_nat_degree_le (λ p, _ = fu _) p.nat_degree (by simp [fu0]) _ _ _ rfl.le, { intros n r r0 np, - rw [nat_degree_C_mul_X_pow _ _ r0, ← monomial_eq_C_mul_X, φ_mon_nat _ _ r0] }, + rw [nat_degree_C_mul_X_pow _ _ r0, C_mul_X_pow_eq_monomial, φ_mon_nat _ _ r0] }, { intros f g fg gp fk gk, rw [nat_degree_add_eq_right_of_nat_degree_lt fg, _root_.map_add], by_cases FG : k ≤ f.nat_degree, @@ -266,4 +264,102 @@ lemma map_nat_degree_eq_nat_degree {S F : Type*} [semiring S] (φ p).nat_degree = p.nat_degree := (map_nat_degree_eq_sub (λ f h, (nat.not_lt_zero _ h).elim) (by simpa)).trans p.nat_degree.sub_zero +open_locale big_operators + +lemma card_support_eq' {n : ℕ} (k : fin n → ℕ) (x : fin n → R) (hk : function.injective k) + (hx : ∀ i, x i ≠ 0) : (∑ i, C (x i) * X ^ k i).support.card = n := +begin + suffices : (∑ i, C (x i) * X ^ k i).support = image k univ, + { rw [this, univ.card_image_of_injective hk, card_fin] }, + simp_rw [finset.ext_iff, mem_support_iff, finset_sum_coeff, coeff_C_mul_X_pow, + mem_image, mem_univ, exists_true_left], + refine λ i, ⟨λ h, _, _⟩, + { obtain ⟨j, hj, h⟩ := exists_ne_zero_of_sum_ne_zero h, + exact ⟨j, (ite_ne_right_iff.mp h).1.symm⟩ }, + { rintros ⟨j, rfl⟩, + rw [sum_eq_single_of_mem j (mem_univ j), if_pos rfl], + { exact hx j }, + { exact λ m hm hmj, if_neg (λ h, hmj.symm (hk h)) } }, +end + +lemma card_support_eq {n : ℕ} : f.support.card = n ↔ ∃ (k : fin n → ℕ) (x : fin n → R) + (hk : strict_mono k) (hx : ∀ i, x i ≠ 0), f = ∑ i, C (x i) * X ^ k i := +begin + refine ⟨_, λ ⟨k, x, hk, hx, hf⟩, hf.symm ▸ card_support_eq' k x hk.injective hx⟩, + induction n with n hn generalizing f, + { exact λ hf, ⟨0, 0, is_empty_elim, is_empty_elim, card_support_eq_zero.mp hf⟩ }, + { intro h, + obtain ⟨k, x, hk, hx, hf⟩ := hn (erase_lead_card_support' h), + have H : ¬ ∃ k : fin n, k.cast_succ = fin.last n, + { rintros ⟨i, hi⟩, + exact (i.cast_succ_lt_last).ne hi }, + refine ⟨function.extend fin.cast_succ k (λ _, f.nat_degree), + function.extend fin.cast_succ x (λ _, f.leading_coeff), _, _, _⟩, + { intros i j hij, + have hi : i ∈ set.range (fin.cast_succ : fin n ↪o fin (n + 1)), + { rw [fin.range_cast_succ, set.mem_def], + exact lt_of_lt_of_le hij (nat.lt_succ_iff.mp j.2) }, + obtain ⟨i, rfl⟩ := hi, + rw fin.cast_succ.injective.extend_apply, + by_cases hj : ∃ j₀, fin.cast_succ j₀ = j, + { obtain ⟨j, rfl⟩ := hj, + rwa [fin.cast_succ.injective.extend_apply, hk.lt_iff_lt, + ←fin.cast_succ_lt_cast_succ_iff] }, + { rw [function.extend_apply' _ _ _ hj], + apply lt_nat_degree_of_mem_erase_lead_support, + rw [mem_support_iff, hf, finset_sum_coeff], + rw [sum_eq_single, coeff_C_mul, coeff_X_pow_self, mul_one], + { exact hx i }, + { intros j hj hji, + rw [coeff_C_mul, coeff_X_pow, if_neg (hk.injective.ne hji.symm), mul_zero] }, + { exact λ hi, (hi (mem_univ i)).elim } } }, + { intro i, + by_cases hi : ∃ i₀, fin.cast_succ i₀ = i, + { obtain ⟨i, rfl⟩ := hi, + rw fin.cast_succ.injective.extend_apply, + exact hx i }, + { rw [function.extend_apply' _ _ _ hi, ne, leading_coeff_eq_zero, + ←card_support_eq_zero, h], + exact n.succ_ne_zero } }, + { rw fin.sum_univ_cast_succ, + simp only [fin.cast_succ.injective.extend_apply], + rw [←hf, function.extend_apply', function.extend_apply', erase_lead_add_C_mul_X_pow], + all_goals { exact H } } }, +end + +lemma card_support_eq_one : f.support.card = 1 ↔ ∃ (k : ℕ) (x : R) (hx : x ≠ 0), f = C x * X ^ k := +begin + refine ⟨λ h, _, _⟩, + { obtain ⟨k, x, hk, hx, rfl⟩ := card_support_eq.mp h, + exact ⟨k 0, x 0, hx 0, fin.sum_univ_one _⟩ }, + { rintros ⟨k, x, hx, rfl⟩, + rw [support_C_mul_X_pow k hx, card_singleton] }, +end + +lemma card_support_eq_two : f.support.card = 2 ↔ ∃ (k m : ℕ) (hkm : k < m) + (x y : R) (hx : x ≠ 0) (hy : y ≠ 0), f = C x * X ^ k + C y * X ^ m := +begin + refine ⟨λ h, _, _⟩, + { obtain ⟨k, x, hk, hx, rfl⟩ := card_support_eq.mp h, + refine ⟨k 0, k 1, hk (by exact nat.zero_lt_one), x 0, x 1, hx 0, hx 1, _⟩, + rw [fin.sum_univ_cast_succ, fin.sum_univ_one], + refl }, + { rintros ⟨k, m, hkm, x, y, hx, hy, rfl⟩, + exact card_support_binomial hkm.ne hx hy }, +end + +lemma card_support_eq_three : f.support.card = 3 ↔ + ∃ (k m n : ℕ) (hkm : k < m) (hmn : m < n) (x y z : R) (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0), + f = C x * X ^ k + C y * X ^ m + C z * X ^ n := +begin + refine ⟨λ h, _, _⟩, + { obtain ⟨k, x, hk, hx, rfl⟩ := card_support_eq.mp h, + refine ⟨k 0, k 1, k 2, hk (by exact nat.zero_lt_one), hk (by exact nat.lt_succ_self 1), + x 0, x 1, x 2, hx 0, hx 1, hx 2, _⟩, + rw [fin.sum_univ_cast_succ, fin.sum_univ_cast_succ, fin.sum_univ_one], + refl }, + { rintros ⟨k, m, n, hkm, hmn, x, y, z, hx, hy, hz, rfl⟩, + exact card_support_trinomial hkm hmn hx hy hz }, +end + end polynomial diff --git a/src/data/polynomial/eval.lean b/src/data/polynomial/eval.lean index 21ccdc0c6cbe9..c583a720f61b6 100644 --- a/src/data/polynomial/eval.lean +++ b/src/data/polynomial/eval.lean @@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ import data.polynomial.degree.definitions -import algebra.geom_sum +import data.polynomial.induction /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The main defs here are `eval₂`, `eval`, and `map`. We give several lemmas about their interaction with each other and with module operations. -/ @@ -31,10 +34,11 @@ variables (f : R →+* S) (x : S) /-- Evaluate a polynomial `p` given a ring hom `f` from the scalar ring to the target and a value `x` for the variable in the target -/ -def eval₂ (p : R[X]) : S := +@[irreducible] def eval₂ (p : R[X]) : S := p.sum (λ e a, f a * x ^ e) -lemma eval₂_eq_sum {f : R →+* S} {x : S} : p.eval₂ f x = p.sum (λ e a, f a * x ^ e) := rfl +lemma eval₂_eq_sum {f : R →+* S} {x : S} : p.eval₂ f x = p.sum (λ e a, f a * x ^ e) := +by rw eval₂ lemma eval₂_congr {R S : Type*} [semiring R] [semiring S] {f g : R →+* S} {s t : S} {φ ψ : R[X]} : @@ -66,7 +70,7 @@ begin end @[simp] lemma eval₂_add : (p + q).eval₂ f x = p.eval₂ f x + q.eval₂ f x := -by { apply sum_add_index; simp [add_mul] } +by { simp only [eval₂_eq_sum], apply sum_add_index; simp [add_mul] } @[simp] lemma eval₂_one : (1 : R[X]).eval₂ f x = 1 := by rw [← C_1, eval₂_C, f.map_one] @@ -88,10 +92,10 @@ end @[simp] lemma eval₂_C_X : eval₂ C X p = p := polynomial.induction_on' p (λ p q hp hq, by simp [hp, hq]) - (λ n x, by rw [eval₂_monomial, monomial_eq_smul_X, C_mul']) + (λ n x, by rw [eval₂_monomial, ← smul_X_eq_monomial, C_mul']) /-- `eval₂_add_monoid_hom (f : R →+* S) (x : S)` is the `add_monoid_hom` from -`polynomial R` to `S` obtained by evaluating the pushforward of `p` along `f` at `x`. -/ +`R[X]` to `S` obtained by evaluating the pushforward of `p` along `f` at `x`. -/ @[simps] def eval₂_add_monoid_hom : R[X] →+ S := { to_fun := eval₂ f x, map_zero' := eval₂_zero _ _, @@ -256,7 +260,7 @@ variables {x : R} def eval : R → R[X] → R := eval₂ (ring_hom.id _) lemma eval_eq_sum : p.eval x = p.sum (λ e a, a * x ^ e) := -rfl +by { rw [eval, eval₂_eq_sum], refl } lemma eval_eq_sum_range {p : R[X]} (x : R) : p.eval x = ∑ i in finset.range (p.nat_degree + 1), p.coeff i * x ^ i := @@ -320,6 +324,24 @@ begin simp only [mul_assoc, C_mul_monomial, eval_monomial], } end +/-- A reformulation of the expansion of (1 + y)^d: +$$(d + 1) (1 + y)^d - (d + 1)y^d = \sum_{i = 0}^d {d + 1 \choose i} \cdot i \cdot y^{i - 1}.$$ +-/ +lemma eval_monomial_one_add_sub [comm_ring S] (d : ℕ) (y : S) : + eval (1 + y) (monomial d (d + 1 : S)) - eval y (monomial d (d + 1 : S)) = + ∑ (x_1 : ℕ) in range (d + 1), ↑((d + 1).choose x_1) * (↑x_1 * y ^ (x_1 - 1)) := +begin + have cast_succ : (d + 1 : S) = ((d.succ : ℕ) : S), + { simp only [nat.cast_succ], }, + rw [cast_succ, eval_monomial, eval_monomial, add_comm, add_pow], + conv_lhs { congr, congr, skip, apply_congr, skip, rw [one_pow, mul_one, mul_comm], }, + rw [sum_range_succ, mul_add, nat.choose_self, nat.cast_one, one_mul, add_sub_cancel, mul_sum, + sum_range_succ', nat.cast_zero, zero_mul, mul_zero, add_zero], + apply sum_congr rfl (λ y hy, _), + rw [←mul_assoc, ←mul_assoc, ←nat.cast_mul, nat.succ_mul_choose_eq, + nat.cast_mul, nat.add_sub_cancel], +end + /-- `polynomial.eval` as linear map -/ @[simps] def leval {R : Type*} [semiring R] (r : R) : R[X] →ₗ[R] R := { to_fun := λ f, f.eval r, @@ -362,22 +384,25 @@ instance [decidable_eq R] : decidable (is_root p a) := by unfold is_root; apply_ lemma is_root.eq_zero (h : is_root p x) : eval x p = 0 := h -lemma coeff_zero_eq_eval_zero (p : R[X]) : - coeff p 0 = p.eval 0 := +lemma coeff_zero_eq_eval_zero (p : R[X]) : coeff p 0 = p.eval 0 := calc coeff p 0 = coeff p 0 * 0 ^ 0 : by simp -... = p.eval 0 : eq.symm $ - finset.sum_eq_single _ (λ b _ hb, by simp [zero_pow (nat.pos_of_ne_zero hb)]) (by simp) +... = p.eval 0 : + begin + symmetry, + rw [eval_eq_sum], + exact finset.sum_eq_single _ (λ b _ hb, by simp [zero_pow (nat.pos_of_ne_zero hb)]) (by simp) + end -lemma zero_is_root_of_coeff_zero_eq_zero {p : R[X]} (hp : p.coeff 0 = 0) : - is_root p 0 := +lemma zero_is_root_of_coeff_zero_eq_zero {p : R[X]} (hp : p.coeff 0 = 0) : is_root p 0 := by rwa coeff_zero_eq_eval_zero at hp lemma is_root.dvd {R : Type*} [comm_semiring R] {p q : R[X]} {x : R} (h : p.is_root x) (hpq : p ∣ q) : q.is_root x := by rwa [is_root, eval, eval₂_eq_zero_of_dvd_of_eval₂_eq_zero _ _ hpq] -lemma not_is_root_C (r a : R) (hr : r ≠ 0) : ¬ is_root (C r) a := -by simpa using hr +lemma not_is_root_C (r a : R) (hr : r ≠ 0) : ¬ is_root (C r) a := by simpa using hr + +lemma eval_surjective (x : R) : function.surjective $ eval x := λ y, ⟨C y, eval_C⟩ end eval @@ -387,40 +412,33 @@ section comp def comp (p q : R[X]) : R[X] := p.eval₂ C q lemma comp_eq_sum_left : p.comp q = p.sum (λ e a, C a * q ^ e) := -rfl +by rw [comp, eval₂_eq_sum] @[simp] lemma comp_X : p.comp X = p := begin - simp only [comp, eval₂, ← monomial_eq_C_mul_X], - exact sum_monomial_eq _, + simp only [comp, eval₂, C_mul_X_pow_eq_monomial], + exact sum_monomial_eq _ end @[simp] lemma X_comp : X.comp p = p := eval₂_X _ _ -@[simp] lemma comp_C : p.comp (C a) = C (p.eval a) := -by simp [comp, (C : R →+* _).map_sum] +@[simp] lemma comp_C : p.comp (C a) = C (p.eval a) := by simp [comp, (C : R →+* _).map_sum] @[simp] lemma C_comp : (C a).comp p = C a := eval₂_C _ _ -@[simp] lemma nat_cast_comp {n : ℕ} : (n : R[X]).comp p = n := -by rw [←C_eq_nat_cast, C_comp] +@[simp] lemma nat_cast_comp {n : ℕ} : (n : R[X]).comp p = n := by rw [←C_eq_nat_cast, C_comp] -@[simp] lemma comp_zero : p.comp (0 : R[X]) = C (p.eval 0) := -by rw [← C_0, comp_C] +@[simp] lemma comp_zero : p.comp (0 : R[X]) = C (p.eval 0) := by rw [← C_0, comp_C] -@[simp] lemma zero_comp : comp (0 : R[X]) p = 0 := -by rw [← C_0, C_comp] +@[simp] lemma zero_comp : comp (0 : R[X]) p = 0 := by rw [← C_0, C_comp] -@[simp] lemma comp_one : p.comp 1 = C (p.eval 1) := -by rw [← C_1, comp_C] +@[simp] lemma comp_one : p.comp 1 = C (p.eval 1) := by rw [← C_1, comp_C] -@[simp] lemma one_comp : comp (1 : R[X]) p = 1 := -by rw [← C_1, C_comp] +@[simp] lemma one_comp : comp (1 : R[X]) p = 1 := by rw [← C_1, C_comp] @[simp] lemma add_comp : (p + q).comp r = p.comp r + q.comp r := eval₂_add _ _ -@[simp] lemma monomial_comp (n : ℕ) : (monomial n a).comp p = C a * p^n := -eval₂_monomial _ _ +@[simp] lemma monomial_comp (n : ℕ) : (monomial n a).comp p = C a * p^n := eval₂_monomial _ _ @[simp] lemma mul_X_comp : (p * X).comp r = p.comp r * r := begin @@ -456,10 +474,6 @@ by rw [←C_eq_nat_cast, C_mul_comp, C_eq_nat_cast] @[simp] lemma mul_comp {R : Type*} [comm_semiring R] (p q r : R[X]) : (p * q).comp r = p.comp r * q.comp r := eval₂_mul _ _ -lemma prod_comp {R : Type*} [comm_semiring R] (s : multiset R[X]) (p : R[X]) : - s.prod.comp p = (s.map (λ q : R[X], q.comp p)).prod := -(s.prod_hom (monoid_hom.mk (λ q : R[X], q.comp p) one_comp (λ q r, mul_comp q r p))).symm - @[simp] lemma pow_comp {R : Type*} [comm_semiring R] (p q : R[X]) (n : ℕ) : (p^n).comp q = (p.comp q)^n := ((monoid_hom.mk (λ r : R[X], r.comp q)) one_comp (λ r s, mul_comp r s q)).map_pow p n @@ -512,7 +526,7 @@ def map : R[X] → S[X] := eval₂ (C.comp f) X @[simp] lemma map_monomial {n a} : (monomial n a).map f = monomial n (f a) := begin dsimp only [map], - rw [eval₂_monomial, monomial_eq_C_mul_X], refl, + rw [eval₂_monomial, ← C_mul_X_pow_eq_monomial], refl, end @[simp] protected lemma map_zero : (0 : R[X]).map f = 0 := eval₂_zero _ _ @@ -524,7 +538,7 @@ end @[simp] protected lemma map_mul : (p * q).map f = p.map f * q.map f := by { rw [map, eval₂_mul_noncomm], exact λ k, (commute_X _).symm } -@[simp] lemma map_smul (r : R) : (r • p).map f = f r • p.map f := +@[simp] protected lemma map_smul (r : R) : (r • p).map f = f r • p.map f := by rw [map, eval₂_smul, ring_hom.comp_apply, C_mul'] /-- `polynomial.map` as a `ring_hom`. -/ @@ -547,11 +561,21 @@ def map_ring_hom (f : R →+* S) : R[X] →+* S[X] := @[simp] protected theorem map_nat_cast (n : ℕ) : (n : R[X]).map f = n := map_nat_cast (map_ring_hom f) n +@[simp] protected lemma map_bit0 : (bit0 p).map f = bit0 (p.map f) := +map_bit0 (map_ring_hom f) p + +@[simp] protected lemma map_bit1 : (bit1 p).map f = bit1 (p.map f) := +map_bit1 (map_ring_hom f) p + +--TODO rename to `map_dvd_map` +lemma map_dvd (f : R →+* S) {x y : R[X]} : x ∣ y → x.map f ∣ y.map f := +(map_ring_hom f).map_dvd + @[simp] lemma coeff_map (n : ℕ) : coeff (p.map f) n = f (coeff p n) := begin rw [map, eval₂, coeff_sum, sum], - conv_rhs { rw [← sum_C_mul_X_eq p, coeff_sum, sum, ring_hom.map_sum], }, + conv_rhs { rw [← sum_C_mul_X_pow_eq p, coeff_sum, sum, ring_hom.map_sum], }, refine finset.sum_congr rfl (λ x hx, _), simp [function.comp, coeff_C_mul_X_pow, f.map_mul], split_ifs; simp [f.map_zero], @@ -599,6 +623,12 @@ nat_degree_le_nat_degree (degree_map_le f p) variables {f} +protected lemma map_eq_zero_iff (hf : function.injective f) : p.map f = 0 ↔ p = 0 := +map_eq_zero_iff (map_ring_hom f) (map_injective f hf) + +protected lemma map_ne_zero_iff (hf : function.injective f) : p.map f ≠ 0 ↔ p ≠ 0 := +(polynomial.map_eq_zero_iff hf).not + lemma map_monic_eq_zero_iff (hp : p.monic) : p.map f = 0 ↔ ∀ x, f x = 0 := ⟨ λ hfp x, calc f x = f x * f p.leading_coeff : by simp only [mul_one, hp.leading_coeff, f.map_one] ... = f x * (p.map f).coeff p.nat_degree : congr_arg _ (coeff_map _ _).symm @@ -710,18 +740,16 @@ lemma eval_int_cast_map {R S : Type*} [ring R] [ring S] begin apply polynomial.induction_on' p, { intros p q hp hq, simp only [hp, hq, polynomial.map_add, ring_hom.map_add, eval_add] }, - { intros n r, simp only [f.map_int_cast, eval_monomial, map_monomial, f.map_pow, f.map_mul] } + { intros n r, simp only [map_int_cast, eval_monomial, map_monomial, map_pow, map_mul] } end end map /-! -After having set up the basic theory of `eval₂`, `eval`, `comp`, and `map`, -we make `eval₂` irreducible. +we have made `eval₂` irreducible from the start. -Perhaps we can make the others irreducible too? +Perhaps we can make also `eval`, `comp`, and `map` irreducible too? -/ -attribute [irreducible] polynomial.eval₂ section hom_eval₂ @@ -755,6 +783,15 @@ lemma eval₂_comp {x : S} : eval₂ f x (p.comp q) = eval₂ f (eval₂ f x q) p := by rw [comp, p.as_sum_range]; simp [eval₂_finset_sum, eval₂_pow] +@[simp] +lemma iterate_comp_eval₂ (k : ℕ) (t : S) : + eval₂ f t (p.comp^[k] q) = ((λ x, eval₂ f x p)^[k] (eval₂ f t q)) := +begin + induction k with k IH, + { simp }, + { rw [function.iterate_succ_apply', function.iterate_succ_apply', eval₂_comp, IH] } +end + end section @@ -762,11 +799,14 @@ variables [comm_semiring R] {p q : R[X]} {x : R} [comm_semiring S] (f : R →+* @[simp] lemma eval_mul : (p * q).eval x = p.eval x * q.eval x := eval₂_mul _ _ -/-- `eval r`, regarded as a ring homomorphism from `polynomial R` to `R`. -/ +/-- `eval r`, regarded as a ring homomorphism from `R[X]` to `R`. -/ def eval_ring_hom : R → R[X] →+* R := eval₂_ring_hom (ring_hom.id _) @[simp] lemma coe_eval_ring_hom (r : R) : ((eval_ring_hom r) : R[X] → R) = eval r := rfl +lemma eval_ring_hom_zero : eval_ring_hom 0 = constant_coeff := +fun_like.ext _ _ $ λ p, p.coeff_zero_eq_eval_zero.symm + @[simp] lemma eval_pow (n : ℕ) : (p ^ n).eval x = p.eval x ^ n := eval₂_pow _ _ _ @[simp] @@ -777,10 +817,19 @@ begin { intros n a, simp, } end -/-- `comp p`, regarded as a ring homomorphism from `polynomial R` to itself. -/ +@[simp] +lemma iterate_comp_eval : ∀ (k : ℕ) (t : R), + (p.comp^[k] q).eval t = ((λ x, p.eval x)^[k] (q.eval t)) := +iterate_comp_eval₂ _ + +/-- `comp p`, regarded as a ring homomorphism from `R[X]` to itself. -/ def comp_ring_hom : R[X] → R[X] →+* R[X] := eval₂_ring_hom C +@[simp] lemma coe_comp_ring_hom (q : R[X]) : (comp_ring_hom q : R[X] → R[X]) = λ p, comp p q := rfl + +lemma coe_comp_ring_hom_apply (p q : R[X]) : (comp_ring_hom q : R[X] → R[X]) p = comp p q := rfl + lemma root_mul_left_of_is_root (p : R[X]) {q : R[X]} : is_root q a → is_root (p * q) a := λ H, by rw [is_root, eval_mul, is_root.def.1 H, mul_zero] @@ -818,6 +867,18 @@ lemma eval_prod {ι : Type*} (s : finset ι) (p : ι → R[X]) (x : R) : eval x (∏ j in s, p j) = ∏ j in s, eval x (p j) := (eval_ring_hom x).map_prod _ _ +lemma list_prod_comp (l : list R[X]) (q : R[X]) : + l.prod.comp q = (l.map (λ p : R[X], p.comp q)).prod := +map_list_prod (comp_ring_hom q) _ + +lemma multiset_prod_comp (s : multiset R[X]) (q : R[X]) : + s.prod.comp q = (s.map (λ p : R[X], p.comp q)).prod := +map_multiset_prod (comp_ring_hom q) _ + +lemma prod_comp {ι : Type*} (s : finset ι) (p : ι → R[X]) (q : R[X]) : + (∏ j in s, p j).comp q = ∏ j in s, (p j).comp q := +map_prod (comp_ring_hom q) _ _ + lemma is_root_prod {R} [comm_ring R] [is_domain R] {ι : Type*} (s : finset ι) (p : ι → R[X]) (x : R) : is_root (∏ j in s, p j) x ↔ ∃ i ∈ s, is_root (p i) x := @@ -830,8 +891,9 @@ lemma eval_eq_zero_of_dvd_of_eval_eq_zero : p ∣ q → eval x p = 0 → eval x eval₂_eq_zero_of_dvd_of_eval₂_eq_zero _ _ @[simp] -lemma eval_geom_sum {R} [comm_semiring R] {n : ℕ} {x : R} : eval x (geom_sum X n) = geom_sum x n := -by simp [geom_sum_def, eval_finset_sum] +lemma eval_geom_sum {R} [comm_semiring R] {n : ℕ} {x : R} : + eval x (∑ i in range n, X ^ i) = ∑ i in range n, x ^ i := +by simp [eval_finset_sum] end @@ -839,11 +901,7 @@ end eval section map ---TODO rename to `map_dvd_map` -lemma map_dvd {R S} [semiring R] [comm_semiring S] (f : R →+* S) {x y : R[X]} : - x ∣ y → x.map f ∣ y.map f := eval₂_dvd _ _ - -lemma support_map_subset [semiring R] [comm_semiring S] (f : R →+* S) (p : R[X]) : +lemma support_map_subset [semiring R] [semiring S] (f : R →+* S) (p : R[X]) : (map f p).support ⊆ p.support := begin intros x, @@ -851,6 +909,12 @@ begin simp { contextual := tt }, end +lemma support_map_of_injective [semiring R] [semiring S] + (p : R[X]) {f : R →+* S} (hf : function.injective f) : + (map f p).support = p.support := +by simp_rw [finset.ext_iff, mem_support_iff, coeff_map, + ←map_zero f, hf.ne_iff, iff_self, forall_const] + variables [comm_semiring R] [comm_semiring S] (f : R →+* S) protected lemma map_multiset_prod (m : multiset R[X]) : m.prod.map f = (m.map $ map f).prod := @@ -891,9 +955,8 @@ lemma C_sub : C (a - b) = C a - C b := ring_hom.map_sub C a b (-p).map f = -(p.map f) := (map_ring_hom f).map_neg p -@[simp] lemma map_int_cast {S} [ring S] (f : R →+* S) (n : ℤ) : - map f ↑n = ↑n := -(map_ring_hom f).map_int_cast n +@[simp] lemma map_int_cast {S} [ring S] (f : R →+* S) (n : ℤ) : map f ↑n = ↑n := +map_int_cast (map_ring_hom f) n @[simp] lemma eval_int_cast {n : ℤ} {x : R} : (n : R[X]).eval x = n := by simp only [←C_eq_int_cast, eval_C] diff --git a/src/data/polynomial/expand.lean b/src/data/polynomial/expand.lean index c5d4f12bd692d..8df70d7d9590a 100644 --- a/src/data/polynomial/expand.lean +++ b/src/data/polynomial/expand.lean @@ -9,6 +9,16 @@ import tactic.ring_exp /-! # Expand a polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`. + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +## Main definitions + +* `polynomial.expand R p f`: expand the polynomial `f` with coefficients in a + commutative semiring `R` by a factor of p, so `expand R p (∑ aₙ xⁿ)` is `∑ aₙ xⁿᵖ`. +* `polynomial.contract p f`: the opposite of `expand`, so it sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. + -/ universes u v w @@ -37,7 +47,7 @@ by { dsimp [expand, eval₂], refl, } @[simp] lemma expand_C (r : R) : expand R p (C r) = C r := eval₂_C _ _ @[simp] lemma expand_X : expand R p X = X ^ p := eval₂_X _ _ @[simp] lemma expand_monomial (r : R) : expand R p (monomial q r) = monomial (q * p) r := -by simp_rw [monomial_eq_smul_X, alg_hom.map_smul, alg_hom.map_pow, expand_X, mul_comm, pow_mul] +by simp_rw [← smul_X_eq_monomial, alg_hom.map_smul, alg_hom.map_pow, expand_X, mul_comm, pow_mul] theorem expand_expand (f : R[X]) : expand R p (expand R q f) = expand R (p * q) f := polynomial.induction_on f (λ r, by simp_rw expand_C) @@ -63,7 +73,7 @@ by rw [function.iterate_succ_apply', pow_succ, expand_mul, ih] theorem derivative_expand (f : R[X]) : (expand R p f).derivative = expand R p f.derivative * (p * X ^ (p - 1)) := -by rw [coe_expand, derivative_eval₂_C, derivative_pow, derivative_X, mul_one] +by rw [coe_expand, derivative_eval₂_C, derivative_pow, C_eq_nat_cast, derivative_X, mul_one] theorem coeff_expand {p : ℕ} (hp : 0 < p) (f : R[X]) (n : ℕ) : (expand R p f).coeff n = if p ∣ n then f.coeff (n / p) else 0 := @@ -85,12 +95,19 @@ by rw [coeff_expand hp, if_pos (dvd_mul_left _ _), nat.mul_div_cancel _ hp] (expand R p f).coeff (p * n) = f.coeff n := by rw [mul_comm, coeff_expand_mul hp] +/-- Expansion is injective. -/ +lemma expand_injective {n : ℕ} (hn : 0 < n) : function.injective (expand R n) := +λ g g' H, ext $ λ k, by rw [← coeff_expand_mul hn, H, coeff_expand_mul hn] + theorem expand_inj {p : ℕ} (hp : 0 < p) {f g : R[X]} : expand R p f = expand R p g ↔ f = g := -⟨λ H, ext $ λ n, by rw [← coeff_expand_mul hp, H, coeff_expand_mul hp], congr_arg _⟩ +(expand_injective hp).eq_iff theorem expand_eq_zero {p : ℕ} (hp : 0 < p) {f : R[X]} : expand R p f = 0 ↔ f = 0 := -by rw [← (expand R p).map_zero, expand_inj hp, alg_hom.map_zero] +(expand_injective hp).eq_iff' (map_zero _) + +theorem expand_ne_zero {p : ℕ} (hp : 0 < p) {f : R[X]} : expand R p f ≠ 0 ↔ f ≠ 0 := +(expand_eq_zero hp).not theorem expand_eq_C {p : ℕ} (hp : 0 < p) {f : R[X]} {r : R} : expand R p f = C r ↔ f = C r := @@ -130,23 +147,6 @@ begin split_ifs; simp, end -/-- Expansion is injective. -/ -lemma expand_injective {n : ℕ} (hn : 0 < n) : - function.injective (expand R n) := -λ g g' h, begin - ext, - have h' : (expand R n g).coeff (n * n_1) = (expand R n g').coeff (n * n_1) := - begin - apply polynomial.ext_iff.1, - exact h, - end, - - rw [polynomial.coeff_expand hn g (n * n_1), polynomial.coeff_expand hn g' (n * n_1)] at h', - simp only [if_true, dvd_mul_right] at h', - rw (nat.mul_div_right n_1 hn) at h', - exact h', -end - @[simp] lemma expand_eval (p : ℕ) (P : R[X]) (r : R) : eval r (expand R p P) = eval (r ^ p) P := begin @@ -154,6 +154,14 @@ begin rw [alg_hom.map_add, eval_add, eval_add, hf, hg] end +@[simp] +lemma expand_aeval {A : Type*} [semiring A] [algebra R A] (p : ℕ) (P : R[X]) (r : A) : + aeval r (expand R p P) = aeval (r ^ p) P := +begin + refine polynomial.induction_on P (λ a, by simp) (λ f g hf hg, _) (λ n a h, by simp), + rw [alg_hom.map_add, aeval_add, aeval_add, hf, hg] +end + /-- The opposite of `expand`: sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. -/ noncomputable def contract (p : ℕ) (f : R[X]) : R[X] := ∑ n in range (f.nat_degree + 1), monomial n (f.coeff (n * p)) @@ -204,7 +212,7 @@ theorem expand_char (f : R[X]) : map (frobenius R p) (expand R p f) = f ^ p := begin refine f.induction_on' (λ a b ha hb, _) (λ n a, _), { rw [alg_hom.map_add, polynomial.map_add, ha, hb, add_pow_char], }, - { rw [expand_monomial, map_monomial, monomial_eq_C_mul_X, monomial_eq_C_mul_X, + { rw [expand_monomial, map_monomial, ← C_mul_X_pow_eq_monomial, ← C_mul_X_pow_eq_monomial, mul_pow, ← C.map_pow, frobenius_def], ring_exp } end @@ -240,7 +248,7 @@ variable {R} theorem of_irreducible_expand {p : ℕ} (hp : p ≠ 0) {f : R[X]} (hf : irreducible (expand R p f)) : irreducible f := -@@of_irreducible_map _ _ _ (is_local_ring_hom_expand R hp.bot_lt) hf +let _ := is_local_ring_hom_expand R hp.bot_lt in by exactI of_irreducible_map ↑(expand R p) hf theorem of_irreducible_expand_pow {p : ℕ} (hp : p ≠ 0) {f : R[X]} {n : ℕ} : irreducible (expand R (p ^ n) f) → irreducible f := diff --git a/src/data/polynomial/field_division.lean b/src/data/polynomial/field_division.lean index b793ce51295c5..ea42eea04f17c 100644 --- a/src/data/polynomial/field_division.lean +++ b/src/data/polynomial/field_division.lean @@ -3,16 +3,16 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ -import algebra.gcd_monoid.basic import data.polynomial.derivative import data.polynomial.ring_division -import data.set.pairwise -import ring_theory.coprime.lemmas import ring_theory.euclidean_domain /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file starts looking like the ring theory of $ R[X] $ -/ @@ -27,25 +27,6 @@ variables {R : Type u} {S : Type v} {k : Type y} {A : Type z} {a b : R} {n : ℕ section is_domain variables [comm_ring R] [is_domain R] -lemma prod_multiset_root_eq_finset_root {p : R[X]} : - (multiset.map (λ (a : R), X - C a) p.roots).prod = - ∏ a in p.roots.to_finset, (X - C a) ^ root_multiplicity a p := -by simp only [count_roots, finset.prod_multiset_map_count] - -lemma roots_C_mul (p : R[X]) {a : R} (hzero : a ≠ 0) : (C a * p).roots = p.roots := -begin - by_cases hpzero : p = 0, - { simp only [hpzero, mul_zero] }, - rw multiset.ext, - intro b, - have prodzero : C a * p ≠ 0, - { simp only [hpzero, or_false, ne.def, mul_eq_zero, C_eq_zero, hzero, not_false_iff] }, - rw [count_roots, count_roots, root_multiplicity_mul prodzero], - have mulzero : root_multiplicity b (C a) = 0, - { simp only [hzero, root_multiplicity_eq_zero, eval_C, is_root.def, not_false_iff] }, - simp only [mulzero, zero_add] -end - lemma derivative_root_multiplicity_of_root [char_zero R] {p : R[X]} {t : R} (hpt : p.is_root t) : p.derivative.root_multiplicity t = p.root_multiplicity t - 1 := begin @@ -58,12 +39,12 @@ begin have hn : n + 1 = _ := tsub_add_cancel_of_le ((root_multiplicity_pos hp).mpr hpt), rw ←hn, set q := p /ₘ (X - C t) ^ (n + 1) with hq, - convert_to root_multiplicity t ((X - C t) ^ n * (derivative q * (X - C t) + q * ↑(n + 1))) = n, + convert_to root_multiplicity t ((X - C t) ^ n * (derivative q * (X - C t) + q * C ↑(n + 1))) = n, { congr, rw [mul_add, mul_left_comm $ (X - C t) ^ n, ←pow_succ'], congr' 1, rw [mul_left_comm $ (X - C t) ^ n, mul_comm $ (X - C t) ^ n] }, - have h : (derivative q * (X - C t) + q * ↑(n + 1)).eval t ≠ 0, + have h : (derivative q * (X - C t) + q * C ↑(n + 1)).eval t ≠ 0, { suffices : eval t q * ↑(n + 1) ≠ 0, { simpa }, refine mul_ne_zero _ (nat.cast_ne_zero.mpr n.succ_ne_zero), @@ -147,9 +128,8 @@ have h₁ : (leading_coeff q)⁻¹ ≠ 0 := inv_ne_zero (mt leading_coeff_eq_zero.1 h), by rw [degree_mul, degree_C h₁, add_zero] -@[simp] lemma map_eq_zero [semiring S] [nontrivial S] (f : R →+* S) : - p.map f = 0 ↔ p = 0 := -by simp only [polynomial.ext_iff, f.map_eq_zero, coeff_map, coeff_zero] +@[simp] lemma map_eq_zero [semiring S] [nontrivial S] (f : R →+* S) : p.map f = 0 ↔ p = 0 := +by simp only [polynomial.ext_iff, map_eq_zero, coeff_map, coeff_zero] lemma map_ne_zero [semiring S] [nontrivial S] {f : R →+* S} (hp : p ≠ 0) : p.map f ≠ 0 := mt (map_eq_zero f).1 hp @@ -170,20 +150,6 @@ lemma is_unit_iff_degree_eq_zero : is_unit p ↔ degree p = 0 := rw [← C_mul, _root_.mul_inv_cancel hc, C_1] end⟩⟩ -theorem irreducible_of_monic {p : R[X]} (hp1 : p.monic) (hp2 : p ≠ 1) : - irreducible p ↔ (∀ f g : R[X], f.monic → g.monic → f * g = p → f = 1 ∨ g = 1) := -⟨λ hp3 f g hf hg hfg, or.cases_on (hp3.is_unit_or_is_unit hfg.symm) - (assume huf : is_unit f, or.inl $ eq_one_of_is_unit_of_monic hf huf) - (assume hug : is_unit g, or.inr $ eq_one_of_is_unit_of_monic hg hug), -λ hp3, ⟨mt (eq_one_of_is_unit_of_monic hp1) hp2, λ f g hp, -have hf : f ≠ 0, from λ hf, by { rw [hp, hf, zero_mul] at hp1, exact not_monic_zero hp1 }, -have hg : g ≠ 0, from λ hg, by { rw [hp, hg, mul_zero] at hp1, exact not_monic_zero hp1 }, -or.imp (λ hf, is_unit_of_mul_eq_one _ _ hf) (λ hg, is_unit_of_mul_eq_one _ _ hg) $ -hp3 (f * C f.leading_coeff⁻¹) (g * C g.leading_coeff⁻¹) - (monic_mul_leading_coeff_inv hf) (monic_mul_leading_coeff_inv hg) $ -by rw [mul_assoc, mul_left_comm _ g, ← mul_assoc, ← C_mul, ← mul_inv₀, ← leading_coeff_mul, - ← hp, monic.def.1 hp1, inv_one, C_1, mul_one]⟩⟩ - /-- Division of polynomials. See `polynomial.div_by_monic` for more details.-/ def div (p q : R[X]) := C (leading_coeff q)⁻¹ * (p /ₘ (q * C (leading_coeff q)⁻¹)) @@ -300,12 +266,12 @@ lemma map_div [field k] (f : R →+* k) : if hq0 : q = 0 then by simp [hq0] else by rw [div_def, div_def, polynomial.map_mul, map_div_by_monic f (monic_mul_leading_coeff_inv hq0)]; - simp [f.map_inv, coeff_map f] + simp [coeff_map f] lemma map_mod [field k] (f : R →+* k) : (p % q).map f = p.map f % q.map f := if hq0 : q = 0 then by simp [hq0] -else by rw [mod_def, mod_def, leading_coeff_map f, ← f.map_inv, ← map_C f, +else by rw [mod_def, mod_def, leading_coeff_map f, ← map_inv₀ f, ← map_C f, ← polynomial.map_mul f, map_mod_by_monic f (monic_mul_leading_coeff_inv hq0)] section @@ -347,36 +313,32 @@ theorem is_coprime_map [field k] (f : R →+* k) : is_coprime (p.map f) (q.map f) ↔ is_coprime p q := by rw [← euclidean_domain.gcd_is_unit_iff, ← euclidean_domain.gcd_is_unit_iff, gcd_map, is_unit_map] -lemma mem_roots_map [field k] {f : R →+* k} {x : k} (hp : p ≠ 0) : +lemma mem_roots_map [comm_ring k] [is_domain k] {f : R →+* k} {x : k} (hp : p ≠ 0) : x ∈ (p.map f).roots ↔ p.eval₂ f x = 0 := -begin - rw mem_roots (show p.map f ≠ 0, by exact map_ne_zero hp), - dsimp only [is_root], - rw polynomial.eval_map, -end +by rw [mem_roots (map_ne_zero hp), is_root, polynomial.eval_map]; apply_instance -lemma mem_root_set [field k] [algebra R k] {x : k} (hp : p ≠ 0) : - x ∈ p.root_set k ↔ aeval x p = 0 := -iff.trans multiset.mem_to_finset (mem_roots_map hp) +lemma root_set_monomial [comm_ring S] [is_domain S] [algebra R S] + {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (monomial n a).root_set S = {0} := +by rw [root_set, map_monomial, roots_monomial ((_root_.map_ne_zero (algebra_map R S)).2 ha), + multiset.to_finset_nsmul _ _ hn, multiset.to_finset_singleton, finset.coe_singleton] -lemma root_set_C_mul_X_pow {R S : Type*} [field R] [field S] [algebra R S] +lemma root_set_C_mul_X_pow [comm_ring S] [is_domain S] [algebra R S] {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (C a * X ^ n).root_set S = {0} := -begin - ext x, - rw [set.mem_singleton_iff, mem_root_set, aeval_mul, aeval_C, aeval_X_pow, mul_eq_zero], - { simp_rw [ring_hom.map_eq_zero, pow_eq_zero_iff (nat.pos_of_ne_zero hn), or_iff_right_iff_imp], - exact λ ha', (ha ha').elim }, - { exact mul_ne_zero (mt C_eq_zero.mp ha) (pow_ne_zero n X_ne_zero) }, -end - -lemma root_set_monomial {R S : Type*} [field R] [field S] [algebra R S] - {n : ℕ} (hn : n ≠ 0) {a : R} (ha : a ≠ 0) : (monomial n a).root_set S = {0} := -by rw [←C_mul_X_pow_eq_monomial, root_set_C_mul_X_pow hn ha] +by rw [C_mul_X_pow_eq_monomial, root_set_monomial hn ha] -lemma root_set_X_pow {R S : Type*} [field R] [field S] [algebra R S] +lemma root_set_X_pow [comm_ring S] [is_domain S] [algebra R S] {n : ℕ} (hn : n ≠ 0) : (X ^ n : R[X]).root_set S = {0} := by { rw [←one_mul (X ^ n : R[X]), ←C_1, root_set_C_mul_X_pow hn], exact one_ne_zero } +lemma root_set_prod [comm_ring S] [is_domain S] [algebra R S] + {ι : Type*} (f : ι → R[X]) (s : finset ι) (h : s.prod f ≠ 0) : + (s.prod f).root_set S = ⋃ (i ∈ s), (f i).root_set S := +begin + simp only [root_set, ←finset.mem_coe], + rw [polynomial.map_prod, roots_prod, finset.bind_to_finset, s.val_to_finset, finset.coe_bUnion], + rwa [←polynomial.map_prod, ne, map_eq_zero], +end + lemma exists_root_of_degree_eq_one (h : degree p = 1) : ∃ x, is_root p x := ⟨-(p.coeff 0 / p.coeff 1), have p.coeff 1 ≠ 0, @@ -418,7 +380,7 @@ lemma div_C_mul : p / (C a * q) = C a⁻¹ * (p / q) := begin by_cases ha : a = 0, { simp [ha] }, - simp only [div_def, leading_coeff_mul, mul_inv₀, + simp only [div_def, leading_coeff_mul, mul_inv, leading_coeff_C, C.map_mul, mul_assoc], congr' 3, rw [mul_left_comm q, ← mul_assoc, ← C.map_mul, mul_inv_cancel ha, @@ -447,7 +409,7 @@ if H : x = 0 then by rw [H, polynomial.map_zero, zero_dvd_iff, zero_dvd_iff, map else by rw [← normalize_dvd_iff, ← @normalize_dvd_iff R[X], normalize_apply, normalize_apply, coe_norm_unit_of_ne_zero H, coe_norm_unit_of_ne_zero (mt (map_eq_zero f).1 H), - leading_coeff_map, ← f.map_inv, ← map_C, ← polynomial.map_mul, + leading_coeff_map, ← map_inv₀ f, ← map_C, ← polynomial.map_mul, map_dvd_map _ f.injective (monic_mul_leading_coeff_inv H)] lemma degree_normalize : degree (normalize p) = degree p := by simp @@ -469,14 +431,6 @@ theorem degree_pos_of_irreducible (hp : irreducible p) : 0 < p.degree := lt_of_not_ge $ λ hp0, have _ := eq_C_of_degree_le_zero hp0, not_irreducible_C (p.coeff 0) $ this ▸ hp -theorem pairwise_coprime_X_sub {α : Type u} [field α] {I : Type v} - {s : I → α} (H : function.injective s) : - pairwise (is_coprime on (λ i : I, polynomial.X - polynomial.C (s i))) := -λ i j hij, have h : s j - s i ≠ 0, from sub_ne_zero_of_ne $ function.injective.ne H hij.symm, -⟨polynomial.C (s j - s i)⁻¹, -polynomial.C (s j - s i)⁻¹, -by rw [neg_mul, ← sub_eq_add_neg, ← mul_sub, sub_sub_sub_cancel_left, - ← polynomial.C_sub, ← polynomial.C_mul, inv_mul_cancel h, polynomial.C_1]⟩ - /-- If `f` is a polynomial over a field, and `a : K` satisfies `f' a ≠ 0`, then `f / (X - a)` is coprime with `X - a`. Note that we do not assume `f a = 0`, because `f / (X - a) = (f - f a) / (X - a)`. -/ @@ -498,20 +452,5 @@ begin rw [← C_inj, this, C_0], end -/-- The product `∏ (X - a)` for `a` inside the multiset `p.roots` divides `p`. -/ -lemma prod_multiset_X_sub_C_dvd (p : R[X]) : - (multiset.map (λ (a : R), X - C a) p.roots).prod ∣ p := -begin - rw prod_multiset_root_eq_finset_root, - have hcoprime : pairwise (is_coprime on λ (a : R), polynomial.X - C (id a)) := - pairwise_coprime_X_sub function.injective_id, - have H : pairwise (is_coprime on λ (a : R), (polynomial.X - C (id a)) ^ (root_multiplicity a p)), - { intros a b hdiff, exact (hcoprime a b hdiff).pow }, - apply finset.prod_dvd_of_coprime (H.set_pairwise (↑(multiset.to_finset p.roots) : set R)), - intros a h, - rw multiset.mem_to_finset at h, - exact pow_root_multiplicity_dvd p a -end - end field end polynomial diff --git a/src/data/polynomial/hasse_deriv.lean b/src/data/polynomial/hasse_deriv.lean index 5f3aa05c42f83..6c237af6ae053 100644 --- a/src/data/polynomial/hasse_deriv.lean +++ b/src/data/polynomial/hasse_deriv.lean @@ -7,12 +7,14 @@ Authors: Johan Commelin import algebra.polynomial.big_operators import data.nat.choose.cast import data.nat.choose.vandermonde -import data.polynomial.degree.lemmas import data.polynomial.derivative /-! # Hasse derivative of polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`. It is a variant of the usual derivative, and satisfies `k! * (hasse_deriv k f) = derivative^[k] f`. The main benefit is that is gives an atomic way of talking about expressions such as @@ -87,7 +89,7 @@ begin end lemma hasse_deriv_one' : hasse_deriv 1 f = derivative f := -by simp only [hasse_deriv_apply, derivative_apply, monomial_eq_C_mul_X, nat.choose_one_right, +by simp only [hasse_deriv_apply, derivative_apply, ← C_mul_X_pow_eq_monomial, nat.choose_one_right, (nat.cast_commute _ _).eq] @[simp] lemma hasse_deriv_one : @hasse_deriv R _ 1 = derivative := @@ -159,7 +161,7 @@ begin { push_neg at hil, rw [← tsub_lt_iff_right hil] at hikl, rw [choose_eq_zero_of_lt hikl , zero_mul], }, }, push_neg at hikl, apply @cast_injective ℚ, - have h1 : l ≤ i := nat.le_of_add_le_right hikl, + have h1 : l ≤ i := le_of_add_le_right hikl, have h2 : k ≤ i - l := le_tsub_of_add_le_right hikl, have h3 : k ≤ k + l := le_self_add, have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero }, diff --git a/src/data/polynomial/identities.lean b/src/data/polynomial/identities.lean index 7e7de1cafdd7b..93d50ba61afbe 100644 --- a/src/data/polynomial/identities.lean +++ b/src/data/polynomial/identities.lean @@ -10,6 +10,9 @@ import tactic.ring_exp /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The main def is `binom_expansion`. -/ @@ -94,7 +97,7 @@ def pow_sub_pow_factor (x y : R) : Π (i : ℕ), {z : R // x^i - y^i = z * (x - begin cases @pow_sub_pow_factor (k+1) with z hz, existsi z*x + y^(k+1), - linear_combination (hz, x) { normalization_tactic := `[ring_exp] } + linear_combination x * hz with { normalization_tactic := `[ring_exp] } end /-- diff --git a/src/data/polynomial/induction.lean b/src/data/polynomial/induction.lean index b1c9de63a0e8b..1e3bc53228020 100644 --- a/src/data/polynomial/induction.lean +++ b/src/data/polynomial/induction.lean @@ -3,12 +3,19 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ -import data.polynomial.coeff +import ring_theory.ideal.basic +import data.polynomial.basic /-! -# Theory of univariate polynomials +# Induction on polynomials -The main results are `induction_on` and `as_sum`. +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file contains lemmas dealing with different flavours of induction on polynomials. +See also `data/polynomial/inductions.lean` (with an `s`!). + +The main result is `polynomial.induction_on`. -/ noncomputable theory @@ -24,17 +31,6 @@ variables {R : Type u} {S : Type v} {T : Type w} {ι : Type x} {k : Type y} {A : section semiring variables [semiring R] {p q r : R[X]} -lemma sum_C_mul_X_eq (p : R[X]) : p.sum (λn a, C a * X^n) = p := -begin - ext n, - simp only [polynomial.sum, X_pow_eq_monomial, coeff_monomial, mul_one, finset_sum_coeff, - C_mul_monomial, not_not, mem_support_iff, finset.sum_ite_eq', ite_eq_left_iff], - exact λ h, h.symm -end - -lemma sum_monomial_eq (p : R[X]) : p.sum (λn a, monomial n a) = p := -by simp only [monomial_eq_C_mul_X, sum_C_mul_X_eq] - @[elab_as_eliminator] protected lemma induction_on {M : R[X] → Prop} (p : R[X]) (h_C : ∀a, M (C a)) (h_add : ∀p q, M p → M q → M (p + q)) @@ -50,7 +46,7 @@ begin { apply finset.induction, { convert h_C 0, exact C_0.symm }, { assume n s ns ih, rw sum_insert ns, exact h_add _ _ A ih, } }, - rw [← sum_C_mul_X_eq p, polynomial.sum], + rw [← sum_C_mul_X_pow_eq p, polynomial.sum], exact B _ end @@ -64,61 +60,35 @@ and it holds for monomials. (h_monomial : ∀(n : ℕ) (a : R), M (monomial n a)) : M p := polynomial.induction_on p (h_monomial 0) h_add -(λ n a h, by { rw ← monomial_eq_C_mul_X at ⊢, exact h_monomial _ _ }) - -section coeff - -theorem coeff_mul_monomial (p : R[X]) (n d : ℕ) (r : R) : - coeff (p * monomial n r) (d + n) = coeff p d * r := -by rw [monomial_eq_C_mul_X, ←X_pow_mul, ←mul_assoc, coeff_mul_C, coeff_mul_X_pow] - -theorem coeff_monomial_mul (p : R[X]) (n d : ℕ) (r : R) : - coeff (monomial n r * p) (d + n) = r * coeff p d := -by rw [monomial_eq_C_mul_X, mul_assoc, coeff_C_mul, X_pow_mul, coeff_mul_X_pow] - --- This can already be proved by `simp`. -theorem coeff_mul_monomial_zero (p : R[X]) (d : ℕ) (r : R) : - coeff (p * monomial 0 r) d = coeff p d * r := -coeff_mul_monomial p 0 d r - --- This can already be proved by `simp`. -theorem coeff_monomial_zero_mul (p : R[X]) (d : ℕ) (r : R) : - coeff (monomial 0 r * p) d = r * coeff p d := -coeff_monomial_mul p 0 d r - -end coeff +(λ n a h, by { rw C_mul_X_pow_eq_monomial at ⊢, exact h_monomial _ _ }) open submodule polynomial set -variables {f : R[X]} {I : submodule R[X] R[X]} +variables {f : R[X]} {I : ideal R[X]} -/-- If the coefficients of a polynomial belong to n ideal contains the submodule span of the -coefficients of a polynomial. -/ -lemma span_le_of_coeff_mem_C_inverse (cf : ∀ (i : ℕ), f.coeff i ∈ (C ⁻¹' I.carrier)) : - (span R[X] {g | ∃ i, g = C (f.coeff i)}) ≤ I := +/-- If the coefficients of a polynomial belong to an ideal, then that ideal contains +the ideal spanned by the coefficients of the polynomial. -/ +lemma span_le_of_C_coeff_mem (cf : ∀ (i : ℕ), C (f.coeff i) ∈ I) : + ideal.span {g | ∃ i, g = C (f.coeff i)} ≤ I := begin - refine bInter_subset_of_mem _, - rintros _ ⟨i, rfl⟩, - exact set_like.mem_coe.mpr (cf i), + simp only [@eq_comm _ _ (C _)] {single_pass := tt}, + exact (ideal.span_le.trans range_subset_iff).mpr cf, end -lemma mem_span_C_coeff : - f ∈ span R[X] {g : R[X] | ∃ i : ℕ, g = (C (coeff f i))} := +lemma mem_span_C_coeff : f ∈ ideal.span {g : R[X] | ∃ i : ℕ, g = C (coeff f i)} := begin - let p := span R[X] {g : R[X] | ∃ i : ℕ, g = (C (coeff f i))}, - nth_rewrite 0 (sum_C_mul_X_eq f).symm, + let p := ideal.span {g : R[X] | ∃ i : ℕ, g = C (coeff f i)}, + nth_rewrite 0 (sum_C_mul_X_pow_eq f).symm, refine submodule.sum_mem _ (λ n hn, _), dsimp, have : C (coeff f n) ∈ p, by { apply subset_span, simp }, have : (monomial n (1 : R)) • C (coeff f n) ∈ p := p.smul_mem _ this, convert this using 1, simp only [monomial_mul_C, one_mul, smul_eq_mul], - rw monomial_eq_C_mul_X, + rw ← C_mul_X_pow_eq_monomial, end -lemma exists_coeff_not_mem_C_inverse : - f ∉ I → ∃ i : ℕ , coeff f i ∉ (C ⁻¹' I.carrier) := -imp_of_not_imp_not _ _ - (λ cf, not_not.mpr ((span_le_of_coeff_mem_C_inverse (not_exists_not.mp cf)) mem_span_C_coeff)) +lemma exists_C_coeff_not_mem : f ∉ I → ∃ i : ℕ, C (coeff f i) ∉ I := +not.imp_symm $ λ cf, span_le_of_C_coeff_mem (not_exists_not.mp cf) mem_span_C_coeff end semiring diff --git a/src/data/polynomial/inductions.lean b/src/data/polynomial/inductions.lean index 22d2f03d1b60c..abc02313996b3 100644 --- a/src/data/polynomial/inductions.lean +++ b/src/data/polynomial/inductions.lean @@ -3,12 +3,17 @@ Copyright (c) 2021 Damiano Testa. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Damiano Testa, Jens Wagemaker -/ +import algebra.monoid_algebra.division import data.nat.interval import data.polynomial.degree.definitions +import data.polynomial.induction /-! # Induction on polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file contains lemmas dealing with different flavours of induction on polynomials. -/ @@ -27,21 +32,16 @@ variables [semiring R] {p q : R[X]} /-- `div_X p` returns a polynomial `q` such that `q * X + C (p.coeff 0) = p`. It can be used in a semiring where the usual division algorithm is not possible -/ def div_X (p : R[X]) : R[X] := -∑ n in Ico 0 p.nat_degree, monomial n (p.coeff (n + 1)) +⟨add_monoid_algebra.div_of p.to_finsupp 1⟩ @[simp] lemma coeff_div_X : (div_X p).coeff n = p.coeff (n+1) := -begin - simp only [div_X, coeff_monomial, true_and, finset_sum_coeff, not_lt, - mem_Ico, zero_le, finset.sum_ite_eq', ite_eq_left_iff], - intro h, - rw coeff_eq_zero_of_nat_degree_lt (nat.lt_succ_of_le h) -end +by { rw [add_comm], cases p, refl } lemma div_X_mul_X_add (p : R[X]) : div_X p * X + C (p.coeff 0) = p := ext $ by rintro ⟨_|_⟩; simp [coeff_C, nat.succ_ne_zero, coeff_mul_X] @[simp] lemma div_X_C (a : R) : div_X (C a) = 0 := -ext $ λ n, by simp [div_X, coeff_C]; simp [coeff] +ext $ λ n, by simp [coeff_div_X, coeff_C, finsupp.single_eq_of_ne _] lemma div_X_eq_zero_iff : div_X p = 0 ↔ p = C (p.coeff 0) := ⟨λ h, by simpa [eq_comm, h] using div_X_mul_X_add p, diff --git a/src/data/polynomial/integral_normalization.lean b/src/data/polynomial/integral_normalization.lean index 21b207a18e9b4..d0cbeceb1a948 100644 --- a/src/data/polynomial/integral_normalization.lean +++ b/src/data/polynomial/integral_normalization.lean @@ -10,6 +10,9 @@ import data.polynomial.monic /-! # Theory of monic polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We define `integral_normalization`, which relate arbitrary polynomials to monic ones. -/ diff --git a/src/data/polynomial/iterated_deriv.lean b/src/data/polynomial/iterated_deriv.lean deleted file mode 100644 index 2ec5217cc9e83..0000000000000 --- a/src/data/polynomial/iterated_deriv.lean +++ /dev/null @@ -1,207 +0,0 @@ -/- -Copyright (c) 2020 Jujian Zhang. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Jujian Zhang --/ - -import data.nat.interval -import data.polynomial.derivative -import tactic.linarith - -/-! -# Theory of iterated derivative -We define and prove some lemmas about iterated (formal) derivative for polynomials over a semiring. --/ - -noncomputable theory - -open finset nat polynomial -open_locale big_operators polynomial - -namespace polynomial -universes u -variable {R : Type u} - -section semiring - -variables [semiring R] (r : R) (f p q : R[X]) (n k : ℕ) - -/-- `iterated_deriv f n` is the `n`-th formal derivative of the polynomial `f` -/ -def iterated_deriv : R[X] := derivative ^[n] f - -@[simp] lemma iterated_deriv_zero_right : iterated_deriv f 0 = f := rfl - -lemma iterated_deriv_succ : iterated_deriv f (n + 1) = (iterated_deriv f n).derivative := -by rw [iterated_deriv, iterated_deriv, function.iterate_succ'] - -@[simp] lemma iterated_deriv_zero_left : iterated_deriv (0 : R[X]) n = 0 := -begin - induction n with n hn, - { exact iterated_deriv_zero_right _ }, - { rw [iterated_deriv_succ, hn, derivative_zero] }, -end - -@[simp] lemma iterated_deriv_add : - iterated_deriv (p + q) n = iterated_deriv p n + iterated_deriv q n := -begin - induction n with n ih, - { simp only [iterated_deriv_zero_right], }, - { simp only [iterated_deriv_succ, ih, derivative_add] } -end - -@[simp] lemma iterated_deriv_smul {S : Type*} [monoid S] - [distrib_mul_action S R] [is_scalar_tower S R R] - (s : S) : iterated_deriv (s • p) n = s • iterated_deriv p n := -begin - induction n with n ih, - { simp only [iterated_deriv_zero_right] }, - { simp only [iterated_deriv_succ, ih, derivative_smul] } -end - -@[simp] lemma iterated_deriv_X_zero : iterated_deriv (X : R[X]) 0 = X := -by simp only [iterated_deriv_zero_right] - -@[simp] lemma iterated_deriv_X_one : iterated_deriv (X : R[X]) 1 = 1 := -by simp only [iterated_deriv, derivative_X, function.iterate_one] - -@[simp] lemma iterated_deriv_X (h : 1 < n) : iterated_deriv (X : R[X]) n = 0 := -begin - induction n with n ih, - { exfalso, exact nat.not_lt_zero 1 h }, - { simp only [iterated_deriv_succ], - by_cases H : n = 1, - { rw H, simp only [iterated_deriv_X_one, derivative_one] }, - { replace h : 1 < n := array.push_back_idx h (ne.symm H), - rw ih h, simp only [derivative_zero] } } -end - - -@[simp] lemma iterated_deriv_C_zero : iterated_deriv (C r) 0 = C r := -by simp only [iterated_deriv_zero_right] - -@[simp] lemma iterated_deriv_C (h : 0 < n) : iterated_deriv (C r) n = 0 := -begin - induction n with n ih, - { exfalso, exact nat.lt_asymm h h }, - { by_cases H : n = 0, - { rw [iterated_deriv_succ, H], simp only [iterated_deriv_C_zero, derivative_C] }, - { replace h : 0 < n := nat.pos_of_ne_zero H, - rw [iterated_deriv_succ, ih h], simp only [derivative_zero] } } -end - -@[simp] lemma iterated_deriv_one_zero : iterated_deriv (1 : R[X]) 0 = 1 := -by simp only [iterated_deriv_zero_right] - -@[simp] lemma iterated_deriv_one : 0 < n → iterated_deriv (1 : R[X]) n = 0 := λ h, -begin - have eq1 : (1 : R[X]) = C 1 := by simp only [ring_hom.map_one], - rw eq1, exact iterated_deriv_C _ _ h, -end - -lemma coeff_iterated_deriv_as_prod_Ico : - ∀ m : ℕ, (iterated_deriv f k).coeff m = (∏ i in Ico m.succ (m + k.succ), i) • (f.coeff (m+k)) := -begin - induction k with k ih, - { simp only [add_zero, forall_const, one_smul, Ico_self, eq_self_iff_true, - iterated_deriv_zero_right, prod_empty] }, - { intro m, rw [iterated_deriv_succ, coeff_derivative, ih (m+1), ← nat.cast_add_one, - ← nsmul_eq_mul', smul_smul, mul_comm], - apply congr_arg2, - { have set_eq : (Ico m.succ (m + k.succ.succ)) = (Ico (m + 1).succ (m + 1 + k.succ)) ∪ {m+1}, - { simp_rw [← Ico_succ_singleton, union_comm, succ_eq_add_one, add_comm (k + 1), add_assoc], - rw [Ico_union_Ico_eq_Ico]; simp_rw [add_le_add_iff_left, le_add_self], }, - rw [set_eq, prod_union, prod_singleton], - { rw [disjoint_singleton_right, mem_Ico], - exact λ h, (nat.lt_succ_self _).not_le h.1 } }, - { exact congr_arg _ (succ_add m k) } }, -end - -lemma coeff_iterated_deriv_as_prod_range : - ∀ m : ℕ, (iterated_deriv f k).coeff m = (∏ i in range k, (m + k - i)) • f.coeff (m + k) := -begin - induction k with k ih, - { simp }, - intro m, - calc (f.iterated_deriv k.succ).coeff m - = (∏ i in range k, (m + k.succ - i)) • f.coeff (m + k.succ) * (m + 1) : - by rw [iterated_deriv_succ, coeff_derivative, ih m.succ, succ_add, add_succ] - ... = ((∏ i in range k, (m + k.succ - i)) * (m + 1)) • f.coeff (m + k.succ) : - by rw [← nat.cast_add_one, ← nsmul_eq_mul', smul_smul, mul_comm] - ... = (∏ i in range k.succ, (m + k.succ - i)) • f.coeff (m + k.succ) : - by rw [prod_range_succ, add_tsub_assoc_of_le k.le_succ, succ_sub le_rfl, tsub_self] -end - -lemma iterated_deriv_eq_zero_of_nat_degree_lt (h : f.nat_degree < n) : iterated_deriv f n = 0 := -begin - ext m, - rw [coeff_iterated_deriv_as_prod_range, coeff_zero, coeff_eq_zero_of_nat_degree_lt, smul_zero], - linarith -end - -lemma iterated_deriv_mul : - iterated_deriv (p * q) n = - ∑ k in range n.succ, - n.choose k • (iterated_deriv p (n - k) * iterated_deriv q k) := -begin - induction n with n IH, - { simp }, - - calc (p * q).iterated_deriv n.succ - = (∑ (k : ℕ) in range n.succ, - (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv k)).derivative : - by rw [iterated_deriv_succ, IH] - ... = ∑ (k : ℕ) in range n.succ, - (n.choose k) • (p.iterated_deriv (n - k + 1) * q.iterated_deriv k) + - ∑ (k : ℕ) in range n.succ, - (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) : - by simp_rw [derivative_sum, derivative_smul, derivative_mul, iterated_deriv_succ, smul_add, - sum_add_distrib] - ... = (∑ (k : ℕ) in range n.succ, - (n.choose k.succ) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) + - 1 • (p.iterated_deriv n.succ * q.iterated_deriv 0)) + - ∑ (k : ℕ) in range n.succ, - (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) : _ - ... = ∑ (k : ℕ) in range n.succ, - (n.choose k) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) + - ∑ (k : ℕ) in range n.succ, - (n.choose k.succ) • (p.iterated_deriv (n - k) * q.iterated_deriv (k + 1)) + - 1 • (p.iterated_deriv n.succ * q.iterated_deriv 0) : - by rw [add_comm, add_assoc] - ... = ∑ (i : ℕ) in range n.succ, - ((n+1).choose (i+1)) • (p.iterated_deriv (n + 1 - (i+1)) * q.iterated_deriv (i+1)) + - 1 • (p.iterated_deriv n.succ * q.iterated_deriv 0) : - by simp_rw [choose_succ_succ, succ_sub_succ, add_smul, sum_add_distrib] - ... = ∑ (k : ℕ) in range n.succ.succ, - (n.succ.choose k) • (p.iterated_deriv (n.succ - k) * q.iterated_deriv k) : - by rw [sum_range_succ' _ n.succ, choose_zero_right, tsub_zero], - - congr, - refine (sum_range_succ' _ _).trans (congr_arg2 (+) _ _), - { rw [sum_range_succ, nat.choose_succ_self, zero_smul, add_zero], - refine sum_congr rfl (λ k hk, _), - rw mem_range at hk, - congr, - rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hk), nat.succ_sub_succ] }, - { rw [choose_zero_right, tsub_zero] }, -end - -end semiring - -section ring -variables [ring R] (p q : R[X]) (n : ℕ) - -@[simp] lemma iterated_deriv_neg : iterated_deriv (-p) n = - iterated_deriv p n := -begin - induction n with n ih, - { simp only [iterated_deriv_zero_right] }, - { simp only [iterated_deriv_succ, ih, derivative_neg] } -end - -@[simp] lemma iterated_deriv_sub : - iterated_deriv (p - q) n = iterated_deriv p n - iterated_deriv q n := -by rw [sub_eq_add_neg, iterated_deriv_add, iterated_deriv_neg, ←sub_eq_add_neg] - - -end ring - -end polynomial diff --git a/src/data/polynomial/laurent.lean b/src/data/polynomial/laurent.lean index 62ada63f0225d..d89c24a6a75f0 100644 --- a/src/data/polynomial/laurent.lean +++ b/src/data/polynomial/laurent.lean @@ -5,9 +5,13 @@ Authors: Damiano Testa -/ import data.polynomial.algebra_map +import ring_theory.localization.basic /-! # Laurent polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We introduce Laurent polynomials over a semiring `R`. Mathematically, they are expressions of the form $$ @@ -34,7 +38,7 @@ This choice differs from the current irreducible design of `polynomial`, that in the implementation via `finsupp`s. It is closer to the original definition of polynomials. As a consequence, `laurent_polynomial` plays well with polynomials, but there is a little roughness -in establishing the API, since the `finsupp` implementation of `polynomial R` is well-shielded. +in establishing the API, since the `finsupp` implementation of `R[X]` is well-shielded. Unlike the case of polynomials, I felt that the exponent notation was not too easy to use, as only natural exponents would be allowed. Moreover, in the end, it seems likely that we should aim to @@ -45,10 +49,27 @@ I made a *heavy* use of `simp` lemmas, aiming to bring Laurent polynomials to th Any comments or suggestions for improvements is greatly appreciated! ## Future work -Lots is missing! I would certainly like to show that `R[T;T⁻¹]` is the localization of `R[X]` -inverting `X`. This should be mostly in place, given `exists_T_pow` (which is part of PR #13415). -(Riccardo) giving a morphism (as `R`-alg, so in the commutative case) -from `R[T,T⁻¹]` to `S` is the same as choosing a unit of `S`. +Lots is missing! +-- (Riccardo) add inclusion into Laurent series. +-- (Riccardo) giving a morphism (as `R`-alg, so in the commutative case) + from `R[T,T⁻¹]` to `S` is the same as choosing a unit of `S`. +-- A "better" definition of `trunc` would be as an `R`-linear map. This works: +-- ``` +-- def trunc : R[T;T⁻¹] →[R] R[X] := +-- begin +-- refine (_ : add_monoid_algebra R ℕ →[R] R[X]).comp _, +-- { exact ⟨(to_finsupp_iso R).symm, by simp⟩ }, +-- { refine ⟨λ r, comap_domain _ r (set.inj_on_of_injective (λ a b ab, int.of_nat.inj ab) _), _⟩, +-- exact λ r f, comap_domain_smul _ _ _ } +-- end +-- ``` +-- but it would make sense to bundle the maps better, for a smoother user experience. +-- I (DT) did not have the strength to embark on this (possibly short!) journey, after getting to +-- this stage of the Laurent process! +-- This would likely involve adding a `comap_domain` analogue of +-- `add_monoid_algebra.map_domain_alg_hom` and an `R`-linear version of +-- `polynomial.to_finsupp_iso`. +-- Add `degree, int_degree, int_trailing_degree, leading_coeff, trailing_coeff,...`. -/ open_locale polynomial big_operators @@ -128,9 +149,12 @@ lemma T_zero : (T 0 : R[T;T⁻¹]) = 1 := rfl lemma T_add (m n : ℤ) : (T (m + n) : R[T;T⁻¹]) = T m * T n := by { convert single_mul_single.symm, simp [T] } +lemma T_sub (m n : ℤ) : (T (m - n) : R[T;T⁻¹]) = T m * T (-n) := +by rw [← T_add, sub_eq_add_neg] + @[simp] lemma T_pow (m : ℤ) (n : ℕ) : (T m ^ n : R[T;T⁻¹]) = T (n * m) := -by rw [T, T, single_pow n, one_pow, nsmul_eq_mul, int.nat_cast_eq_coe_nat] +by rw [T, T, single_pow n, one_pow, nsmul_eq_mul] /-- The `simp` version of `mul_assoc`, in the presence of `T`'s. -/ @[simp] @@ -151,19 +175,17 @@ show map_domain coe (monomial n r).to_finsupp = (C r * T n : R[T;T⁻¹]), by rw [to_finsupp_monomial, map_domain_single, single_eq_C_mul_T] @[simp] -lemma _root_.polynomial.to_laurent_C (r : R) : - (polynomial.C r).to_laurent = C r := +lemma _root_.polynomial.to_laurent_C (r : R) : (polynomial.C r).to_laurent = C r := begin convert polynomial.to_laurent_C_mul_T 0 r, simp only [int.coe_nat_zero, T_zero, mul_one], end @[simp] -lemma _root_.polynomial.to_laurent_X : - (polynomial.X.to_laurent : R[T;T⁻¹]) = T 1 := +lemma _root_.polynomial.to_laurent_X : (polynomial.X.to_laurent : R[T;T⁻¹]) = T 1 := begin have : (polynomial.X : R[X]) = monomial 1 1, - { simp [monomial_eq_C_mul_X] }, + { simp [← C_mul_X_pow_eq_monomial] }, simp [this, polynomial.to_laurent_C_mul_T], end @@ -171,13 +193,12 @@ end map_one polynomial.to_laurent @[simp] -lemma _root_.polynomial.to_laurent_C_mul_eq (r : R) (f : R[X]): +lemma _root_.polynomial.to_laurent_C_mul_eq (r : R) (f : R[X]) : (polynomial.C r * f).to_laurent = C r * f.to_laurent := by simp only [_root_.map_mul, polynomial.to_laurent_C] @[simp] -lemma _root_.polynomial.to_laurent_X_pow (n : ℕ) : - (X ^ n : R[X]).to_laurent = T n := +lemma _root_.polynomial.to_laurent_X_pow (n : ℕ) : (X ^ n : R[X]).to_laurent = T n := by simp only [map_pow, polynomial.to_laurent_X, T_pow, mul_one] @[simp] @@ -196,6 +217,303 @@ lemma inv_of_T (n : ℤ) : ⅟ (T n : R[T;T⁻¹]) = T (- n) := rfl lemma is_unit_T (n : ℤ) : is_unit (T n : R[T;T⁻¹]) := is_unit_of_invertible _ +@[elab_as_eliminator] protected lemma induction_on {M : R[T;T⁻¹] → Prop} (p : R[T;T⁻¹]) + (h_C : ∀ a, M (C a)) + (h_add : ∀ {p q}, M p → M q → M (p + q)) + (h_C_mul_T : ∀ (n : ℕ) (a : R), M (C a * T n) → M (C a * T (n + 1))) + (h_C_mul_T_Z : ∀ (n : ℕ) (a : R), M (C a * T (- n)) → M (C a * T (- n - 1))) : + M p := +begin + have A : ∀ {n : ℤ} {a : R}, M (C a * T n), + { assume n a, + apply n.induction_on, + { simpa only [T_zero, mul_one] using h_C a }, + { exact λ m, h_C_mul_T m a }, + { exact λ m, h_C_mul_T_Z m a } }, + have B : ∀ (s : finset ℤ), M (s.sum (λ (n : ℤ), C (p.to_fun n) * T n)), + { apply finset.induction, + { convert h_C 0, simp only [finset.sum_empty, _root_.map_zero] }, + { assume n s ns ih, rw finset.sum_insert ns, exact h_add A ih } }, + convert B p.support, + ext a, + simp_rw [← single_eq_C_mul_T, finset.sum_apply', single_apply, finset.sum_ite_eq'], + split_ifs with h h, + { refl }, + { exact finsupp.not_mem_support_iff.mp h } +end + +/-- To prove something about Laurent polynomials, it suffices to show that +* the condition is closed under taking sums, and +* it holds for monomials. +-/ +@[elab_as_eliminator] protected lemma induction_on' {M : R[T;T⁻¹] → Prop} (p : R[T;T⁻¹]) + (h_add : ∀p q, M p → M q → M (p + q)) + (h_C_mul_T : ∀(n : ℤ) (a : R), M (C a * T n)) : + M p := +begin + refine p.induction_on (λ a, _) h_add _ _; + try { exact λ n f _, h_C_mul_T _ f }, + convert h_C_mul_T 0 a, + exact (mul_one _).symm, +end + +lemma commute_T (n : ℤ) (f : R[T;T⁻¹]) : commute (T n) f := +f.induction_on' (λ p q Tp Tq, commute.add_right Tp Tq) $ λ m a, +show T n * _ = _, by +{ rw [T, T, ← single_eq_C, single_mul_single, single_mul_single, single_mul_single], + simp [add_comm] } + +@[simp] +lemma T_mul (n : ℤ) (f : R[T;T⁻¹]) : T n * f = f * T n := +(commute_T n f).eq + +/-- `trunc : R[T;T⁻¹] →+ R[X]` maps a Laurent polynomial `f` to the polynomial whose terms of +nonnegative degree coincide with the ones of `f`. The terms of negative degree of `f` "vanish". +`trunc` is a left-inverse to `polynomial.to_laurent`. -/ +def trunc : R[T;T⁻¹] →+ R[X] := +((to_finsupp_iso R).symm.to_add_monoid_hom).comp $ + comap_domain.add_monoid_hom $ λ a b, int.of_nat.inj + +@[simp] +lemma trunc_C_mul_T (n : ℤ) (r : R) : trunc (C r * T n) = ite (0 ≤ n) (monomial n.to_nat r) 0 := +begin + apply (to_finsupp_iso R).injective, + rw [← single_eq_C_mul_T, trunc, add_monoid_hom.coe_comp, function.comp_app, + comap_domain.add_monoid_hom_apply, to_finsupp_iso_apply], + by_cases n0 : 0 ≤ n, + { lift n to ℕ using n0, + erw [comap_domain_single, to_finsupp_iso_symm_apply], + simp only [int.coe_nat_nonneg, int.to_nat_coe_nat, if_true, to_finsupp_iso_apply, + to_finsupp_monomial] }, + { lift (- n) to ℕ using (neg_pos.mpr (not_le.mp n0)).le with m, + rw [to_finsupp_iso_apply, to_finsupp_inj, if_neg n0], + erw to_finsupp_iso_symm_apply, + ext a, + have := ((not_le.mp n0).trans_le (int.coe_zero_le a)).ne', + simp only [coeff, comap_domain_apply, int.of_nat_eq_coe, coeff_zero, single_apply_eq_zero, this, + is_empty.forall_iff] } +end + +@[simp] lemma left_inverse_trunc_to_laurent : + function.left_inverse (trunc : R[T;T⁻¹] → R[X]) polynomial.to_laurent := +begin + refine λ f, f.induction_on' _ _, + { exact λ f g hf hg, by simp only [hf, hg, _root_.map_add] }, + { exact λ n r, by simp only [polynomial.to_laurent_C_mul_T, trunc_C_mul_T, int.coe_nat_nonneg, + int.to_nat_coe_nat, if_true] } +end + +@[simp] lemma _root_.polynomial.trunc_to_laurent (f : R[X]) : trunc f.to_laurent = f := +left_inverse_trunc_to_laurent _ + +lemma _root_.polynomial.to_laurent_injective : + function.injective (polynomial.to_laurent : R[X] → R[T;T⁻¹]) := +left_inverse_trunc_to_laurent.injective + +@[simp] lemma _root_.polynomial.to_laurent_inj (f g : R[X]) : + f.to_laurent = g.to_laurent ↔ f = g := +⟨λ h, polynomial.to_laurent_injective h, congr_arg _⟩ + +lemma _root_.polynomial.to_laurent_ne_zero {f : R[X]} : + f ≠ 0 ↔ f.to_laurent ≠ 0 := +(map_ne_zero_iff _ (by exact polynomial.to_laurent_injective)).symm + +lemma exists_T_pow (f : R[T;T⁻¹]) : + ∃ (n : ℕ) (f' : R[X]), f'.to_laurent = f * T n := +begin + apply f.induction_on' _ (λ n a, _); clear f, + { rintros f g ⟨m, fn, hf⟩ ⟨n, gn, hg⟩, + refine ⟨m + n, fn * X ^ n + gn * X ^ m, _⟩, + simp only [hf, hg, add_mul, add_comm (n : ℤ), map_add, map_mul, polynomial.to_laurent_X_pow, + mul_T_assoc, int.coe_nat_add] }, + { cases n with n n, + { exact ⟨0, polynomial.C a * X ^ n, by simp⟩ }, + { refine ⟨n + 1, polynomial.C a, _⟩, + simp only [int.neg_succ_of_nat_eq, polynomial.to_laurent_C, int.coe_nat_succ, mul_T_assoc, + add_left_neg, T_zero, mul_one] } } +end + +/-- This is a version of `exists_T_pow` stated as an induction principle. -/ +@[elab_as_eliminator] lemma induction_on_mul_T {Q : R[T;T⁻¹] → Prop} (f : R[T;T⁻¹]) + (Qf : ∀ {f : R[X]} {n : ℕ}, Q (f.to_laurent * T (- n))) : + Q f := +begin + rcases f.exists_T_pow with ⟨n, f', hf⟩, + rw [← mul_one f, ← T_zero, ← nat.cast_zero, ← nat.sub_self n, nat.cast_sub rfl.le, T_sub, + ← mul_assoc, ← hf], + exact Qf, +end + +/-- Suppose that `Q` is a statement about Laurent polynomials such that +* `Q` is true on *ordinary* polynomials; +* `Q (f * T)` implies `Q f`; +it follow that `Q` is true on all Laurent polynomials. -/ +lemma reduce_to_polynomial_of_mul_T (f : R[T;T⁻¹]) {Q : R[T;T⁻¹] → Prop} + (Qf : ∀ (f : R[X]), Q f.to_laurent) + (QT : ∀ f, Q (f * T 1) → Q f) : + Q f := +begin + induction f using laurent_polynomial.induction_on_mul_T with f n, + induction n with n hn, + { simpa only [int.coe_nat_zero, neg_zero, T_zero, mul_one] using Qf _ }, + { convert QT _ _, + simpa using hn } +end + +section support + +lemma support_C_mul_T (a : R) (n : ℤ) : (C a * T n).support ⊆ {n} := +by simpa only [← single_eq_C_mul_T] using support_single_subset + +lemma support_C_mul_T_of_ne_zero {a : R} (a0 : a ≠ 0) (n : ℤ) : (C a * T n).support = {n} := +begin + rw ← single_eq_C_mul_T, + exact support_single_ne_zero _ a0, +end + +/-- The support of a polynomial `f` is a finset in `ℕ`. The lemma `to_laurent_support f` +shows that the support of `f.to_laurent` is the same finset, but viewed in `ℤ` under the natural +inclusion `ℕ ↪ ℤ`. -/ +lemma to_laurent_support (f : R[X]) : + f.to_laurent.support = f.support.map nat.cast_embedding := +begin + generalize' hd : f.support = s, + revert f, + refine finset.induction_on s _ _; clear s, + { simp only [polynomial.support_eq_empty, map_zero, finsupp.support_zero, eq_self_iff_true, + implies_true_iff, finset.map_empty] {contextual := tt} }, + { intros a s as hf f fs, + have : (erase a f).to_laurent.support = s.map nat.cast_embedding := hf (f.erase a) (by simp only + [fs, finset.erase_eq_of_not_mem as, polynomial.support_erase, finset.erase_insert_eq_erase]), + rw [← monomial_add_erase f a, finset.map_insert, ← this, map_add, + polynomial.to_laurent_C_mul_T, support_add_eq, finset.insert_eq], + { congr, + exact support_C_mul_T_of_ne_zero (polynomial.mem_support_iff.mp (by simp [fs])) _ }, + { rw this, + exact disjoint.mono_left (support_C_mul_T _ _) (by simpa) } } +end + +end support + +section degrees + +/-- The degree of a Laurent polynomial takes values in `with_bot ℤ`. +If `f : R[T;T⁻¹]` is a Laurent polynomial, then `f.degree` is the maximum of its support of `f`, +or `⊥`, if `f = 0`. -/ +def degree (f : R[T;T⁻¹]) : with_bot ℤ := f.support.max + +@[simp] lemma degree_zero : degree (0 : R[T;T⁻¹]) = ⊥ := rfl + +@[simp] lemma degree_eq_bot_iff {f : R[T;T⁻¹]} : f.degree = ⊥ ↔ f = 0 := +begin + refine ⟨λ h, _, λ h, by rw [h, degree_zero]⟩, + rw [degree, finset.max_eq_sup_with_bot] at h, + ext n, + refine not_not.mp (λ f0, _), + simp_rw [finset.sup_eq_bot_iff, finsupp.mem_support_iff, ne.def, with_bot.coe_ne_bot] at h, + exact h n f0, +end + +section exact_degrees + +open_locale classical + +@[simp] lemma degree_C_mul_T (n : ℤ) (a : R) (a0 : a ≠ 0) : (C a * T n).degree = n := +begin + rw degree, + convert finset.max_singleton, + refine support_eq_singleton.mpr _, + simp only [← single_eq_C_mul_T, single_eq_same, a0, ne.def, not_false_iff, eq_self_iff_true, + and_self], +end + +lemma degree_C_mul_T_ite (n : ℤ) (a : R) : (C a * T n).degree = ite (a = 0) ⊥ n := +by split_ifs with h h; + simp only [h, map_zero, zero_mul, degree_zero, degree_C_mul_T, ne.def, not_false_iff] + +@[simp] lemma degree_T [nontrivial R] (n : ℤ) : (T n : R[T;T⁻¹]).degree = n := +begin + rw [← one_mul (T n), ← map_one C], + exact degree_C_mul_T n 1 (one_ne_zero : (1 : R) ≠ 0), +end + +lemma degree_C {a : R} (a0 : a ≠ 0) : (C a).degree = 0 := +begin + rw [← mul_one (C a), ← T_zero], + exact degree_C_mul_T 0 a a0 +end + +lemma degree_C_ite (a : R) : (C a).degree = ite (a = 0) ⊥ 0 := +by split_ifs with h h; + simp only [h, map_zero, degree_zero, degree_C, ne.def, not_false_iff] + +end exact_degrees + +section degree_bounds + +lemma degree_C_mul_T_le (n : ℤ) (a : R) : (C a * T n).degree ≤ n := +begin + by_cases a0 : a = 0, + { simp only [a0, map_zero, zero_mul, degree_zero, bot_le] }, + { exact (degree_C_mul_T n a a0).le } +end + +lemma degree_T_le (n : ℤ) : (T n : R[T;T⁻¹]).degree ≤ n := +(le_of_eq (by rw [map_one, one_mul])).trans (degree_C_mul_T_le n (1 : R)) + +lemma degree_C_le (a : R) : (C a).degree ≤ 0 := +(le_of_eq (by rw [T_zero, mul_one])).trans (degree_C_mul_T_le 0 a) + +end degree_bounds + +end degrees + +instance : module R[X] R[T;T⁻¹] := +module.comp_hom _ polynomial.to_laurent + +instance (R : Type*) [semiring R] : is_scalar_tower R[X] R[X] R[T;T⁻¹] := +{ smul_assoc := λ x y z, by simp only [has_smul.smul, has_smul.comp.smul, map_mul, mul_assoc] } + end semiring +section comm_semiring +variable [comm_semiring R] + +instance algebra_polynomial (R : Type*) [comm_semiring R] : algebra R[X] R[T;T⁻¹] := +{ commutes' := λ f l, by simp [mul_comm], + smul_def' := λ f l, rfl, + .. polynomial.to_laurent } + +lemma algebra_map_X_pow (n : ℕ) : algebra_map R[X] R[T;T⁻¹] (X ^ n) = T n := +polynomial.to_laurent_X_pow n + +@[simp] +lemma algebra_map_eq_to_laurent (f : R[X]) : algebra_map R[X] R[T;T⁻¹] f = f.to_laurent := +rfl + +lemma is_localization : is_localization (submonoid.closure ({X} : set R[X])) R[T;T⁻¹] := +{ map_units := λ t, begin + cases t with t ht, + rcases submonoid.mem_closure_singleton.mp ht with ⟨n, rfl⟩, + simp only [is_unit_T n, set_like.coe_mk, algebra_map_eq_to_laurent, polynomial.to_laurent_X_pow] + end, + surj := λ f, begin + induction f using laurent_polynomial.induction_on_mul_T with f n, + have := (submonoid.closure ({X} : set R[X])).pow_mem submonoid.mem_closure_singleton_self n, + refine ⟨(f, ⟨_, this⟩), _⟩, + simp only [set_like.coe_mk, algebra_map_eq_to_laurent, polynomial.to_laurent_X_pow, mul_T_assoc, + add_left_neg, T_zero, mul_one], + end, + eq_iff_exists := λ f g, begin + rw [algebra_map_eq_to_laurent, algebra_map_eq_to_laurent, polynomial.to_laurent_inj], + refine ⟨_, _⟩, + { rintro rfl, + exact ⟨1, rfl⟩ }, + { rintro ⟨⟨h, hX⟩, h⟩, + rcases submonoid.mem_closure_singleton.mp hX with ⟨n, rfl⟩, + exact mul_X_pow_injective n h } + end } + +end comm_semiring + end laurent_polynomial diff --git a/src/data/polynomial/lifts.lean b/src/data/polynomial/lifts.lean index 52a3a3b89f079..1b6ea296def3c 100644 --- a/src/data/polynomial/lifts.lean +++ b/src/data/polynomial/lifts.lean @@ -9,8 +9,11 @@ import data.polynomial.monic /-! # Polynomials that lift +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Given semirings `R` and `S` with a morphism `f : R →+* S`, we define a subsemiring `lifts` of -`polynomial S` by the image of `ring_hom.of (map f)`. +`S[X]` by the image of `ring_hom.of (map f)`. Then, we prove that a polynomial that lifts can always be lifted to a polynomial of the same degree and that a monic polynomial that lifts can be lifted to a monic polynomial (of the same degree). @@ -140,7 +143,7 @@ begin { intro habs, simp only [habs, ring_hom.map_zero] at hcoeff, exact hzero hcoeff.symm }, - repeat {rw monomial_eq_C_mul_X}, + repeat {rw ← C_mul_X_pow_eq_monomial}, simp only [hzero, hqzero, ne.def, not_false_iff, degree_C_mul_X_pow], end @@ -167,7 +170,7 @@ begin obtain ⟨lead, hlead⟩ := monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)), have deg_lead : lead.degree = p.nat_degree, - { rw [hlead.2, monomial_eq_C_mul_X, degree_C_mul_X_pow p.nat_degree lead_zero] }, + { rw [hlead.2, ← C_mul_X_pow_eq_monomial, degree_C_mul_X_pow p.nat_degree lead_zero] }, rw hdeg at deg_erase, obtain ⟨erase, herase⟩ := hn p.erase_lead.nat_degree deg_erase (erase_mem_lifts p.nat_degree hlifts) (refl p.erase_lead.nat_degree), @@ -209,6 +212,16 @@ begin { rw [degree_add_eq_right_of_degree_lt hdeg, degree_X_pow, degree_eq_nat_degree hp.ne_zero] } end +lemma lifts_and_nat_degree_eq_and_monic {p : S[X]} (hlifts : p ∈ lifts f) + (hp : p.monic) : ∃ (q : R[X]), map f q = p ∧ q.nat_degree = p.nat_degree ∧ q.monic := +begin + casesI subsingleton_or_nontrivial S with hR hR, + { obtain (rfl : p = 1) := subsingleton.elim _ _, + refine ⟨1, subsingleton.elim _ _, by simp, by simp⟩ }, + obtain ⟨p', h₁, h₂, h₃⟩ := lifts_and_degree_eq_and_monic hlifts hp, + exact ⟨p', h₁, nat_degree_eq_of_degree_eq h₂, h₃⟩ +end + end monic end semiring @@ -231,7 +244,7 @@ section algebra variables {R : Type u} [comm_semiring R] {S : Type v} [semiring S] [algebra R S] -/-- The map `polynomial R → S[X]` as an algebra homomorphism. -/ +/-- The map `R[X] → S[X]` as an algebra homomorphism. -/ def map_alg (R : Type u) [comm_semiring R] (S : Type v) [semiring S] [algebra R S] : R[X] →ₐ[R] S[X] := @aeval _ S[X] _ _ _ (X : S[X]) diff --git a/src/data/polynomial/mirror.lean b/src/data/polynomial/mirror.lean index 80ef0a75e5483..16b41f1eea6b0 100644 --- a/src/data/polynomial/mirror.lean +++ b/src/data/polynomial/mirror.lean @@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Thomas Browning -/ +import algebra.big_operators.nat_antidiagonal import data.polynomial.ring_division /-! # "Mirror" of a univariate polynomial +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is divisible by `X`. @@ -27,9 +31,9 @@ divisible by `X`. namespace polynomial open_locale polynomial -variables {R : Type*} [semiring R] (p : R[X]) +section semiring -section mirror +variables {R : Type*} [semiring R] (p q : R[X]) /-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/ noncomputable def mirror := p.reverse * X ^ p.nat_trailing_degree @@ -42,8 +46,8 @@ begin by_cases ha : a = 0, { rw [ha, monomial_zero_right, mirror_zero] }, { rw [mirror, reverse, nat_degree_monomial n a, if_neg ha, nat_trailing_degree_monomial ha, - ←C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n), - tsub_self, pow_zero, mul_one] }, + ← C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n), tsub_self, pow_zero, + mul_one] }, end lemma mirror_C (a : R) : (C a).mirror = C a := @@ -117,18 +121,68 @@ lemma mirror_mirror : p.mirror.mirror = p := polynomial.ext (λ n, by rw [coeff_mirror, coeff_mirror, mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol]) -lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 := +variables {p q} + +lemma mirror_involutive : function.involutive (mirror : R[X] → R[X]) := +mirror_mirror + +lemma mirror_eq_iff : p.mirror = q ↔ p = q.mirror := +mirror_involutive.eq_iff + +@[simp] lemma mirror_inj : p.mirror = q.mirror ↔ p = q := +mirror_involutive.injective.eq_iff + +@[simp] lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 := ⟨λ h, by rw [←p.mirror_mirror, h, mirror_zero], λ h, by rw [h, mirror_zero]⟩ -lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff := +variables (p q) + +@[simp] lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff := by rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror, rev_at_le (nat.le_add_left _ _), add_tsub_cancel_right] -lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff := +@[simp] lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff := by rw [←p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror] -lemma mirror_mul_of_domain {R : Type*} [ring R] [is_domain R] (p q : R[X]) : - (p * q).mirror = p.mirror * q.mirror := +lemma coeff_mul_mirror : + (p * p.mirror).coeff (p.nat_degree + p.nat_trailing_degree) = p.sum (λ n, (^ 2)) := +begin + rw [coeff_mul, finset.nat.sum_antidiagonal_eq_sum_range_succ_mk], + refine (finset.sum_congr rfl (λ n hn, _)).trans (p.sum_eq_of_subset (λ n, (^ 2)) + (λ n, zero_pow zero_lt_two) _ (λ n hn, finset.mem_range_succ_iff.mpr + ((le_nat_degree_of_mem_supp n hn).trans (nat.le_add_right _ _)))).symm, + rw [coeff_mirror, ←rev_at_le (finset.mem_range_succ_iff.mp hn), rev_at_invol, ←sq], +end + +variables [no_zero_divisors R] + +lemma nat_degree_mul_mirror : (p * p.mirror).nat_degree = 2 * p.nat_degree := +begin + by_cases hp : p = 0, + { rw [hp, zero_mul, nat_degree_zero, mul_zero] }, + rw [nat_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_degree, two_mul], +end + +lemma nat_trailing_degree_mul_mirror : + (p * p.mirror).nat_trailing_degree = 2 * p.nat_trailing_degree := +begin + by_cases hp : p = 0, + { rw [hp, zero_mul, nat_trailing_degree_zero, mul_zero] }, + rw [nat_trailing_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_trailing_degree, two_mul], +end + +end semiring + +section ring + +variables {R : Type*} [ring R] (p q : R[X]) + +lemma mirror_neg : (-p).mirror = -(p.mirror) := +by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul] + +variables [no_zero_divisors R] + +lemma mirror_mul_of_domain : (p * q).mirror = p.mirror * q.mirror := begin by_cases hp : p = 0, { rw [hp, zero_mul, mirror_zero, zero_mul] }, @@ -140,15 +194,16 @@ begin repeat { rw [mul_assoc], }, end -lemma mirror_smul {R : Type*} [ring R] [is_domain R] (p : R[X]) (a : R) : - (a • p).mirror = a • p.mirror := +lemma mirror_smul (a : R) : (a • p).mirror = a • p.mirror := by rw [←C_mul', ←C_mul', mirror_mul_of_domain, mirror_C] -lemma mirror_neg {R : Type*} [ring R] (p : R[X]) : (-p).mirror = -(p.mirror) := -by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul] +end ring + +section comm_ring + +variables {R : Type*} [comm_ring R] [no_zero_divisors R] {f : R[X]} -lemma irreducible_of_mirror {R : Type*} [comm_ring R] [is_domain R] {f : R[X]} - (h1 : ¬ is_unit f) +lemma irreducible_of_mirror (h1 : ¬ is_unit f) (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror) (h3 : ∀ g, g ∣ f → g ∣ f.mirror → is_unit g) : irreducible f := begin @@ -173,11 +228,11 @@ begin have hk := h2 k key, rcases hk with hk | hk | hk | hk, { exact or.inr (h3 h h_dvd_f (by rwa ← hk)) }, - { exact or.inr (h3 h h_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, mirror_neg, dvd_neg])) }, + { exact or.inr (h3 h h_dvd_f (by rwa [← neg_eq_iff_eq_neg.mpr hk, mirror_neg, dvd_neg])) }, { exact or.inl (h3 g g_dvd_f (by rwa ← hk)) }, - { exact or.inl (h3 g g_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, dvd_neg])) } }, + { exact or.inl (h3 g g_dvd_f (by rwa [← neg_eq_iff_eq_neg.mpr hk, dvd_neg])) } }, end -end mirror +end comm_ring end polynomial diff --git a/src/data/polynomial/module.lean b/src/data/polynomial/module.lean new file mode 100644 index 0000000000000..d9e8cc96046d1 --- /dev/null +++ b/src/data/polynomial/module.lean @@ -0,0 +1,302 @@ +/- +Copyright (c) 2022 Andrew Yang. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Andrew Yang +-/ + +import ring_theory.finite_type + +/-! +# Polynomial module + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +In this file, we define the polynomial module for an `R`-module `M`, i.e. the `R[X]`-module `M[X]`. + +This is defined as an type alias `polynomial_module R M := ℕ →₀ M`, since there might be different +module structures on `ℕ →₀ M` of interest. See the docstring of `polynomial_module` for details. + +-/ + +universes u v + +open polynomial +open_locale polynomial big_operators + +variables (R M : Type*) [comm_ring R] [add_comm_group M] [module R M] (I : ideal R) + +include R + +/-- +The `R[X]`-module `M[X]` for an `R`-module `M`. +This is isomorphic (as an `R`-module) to `M[X]` when `M` is a ring. + +We require all the module instances `module S (polynomial_module R M)` to factor through `R` except +`module R[X] (polynomial_module R M)`. +In this constraint, we have the following instances for example : +- `R` acts on `polynomial_module R R[X]` +- `R[X]` acts on `polynomial_module R R[X]` as `R[Y]` acting on `R[X][Y]` +- `R` acts on `polynomial_module R[X] R[X]` +- `R[X]` acts on `polynomial_module R[X] R[X]` as `R[X]` acting on `R[X][Y]` +- `R[X][X]` acts on `polynomial_module R[X] R[X]` as `R[X][Y]` acting on itself + +This is also the reason why `R` is included in the alias, or else there will be two different +instances of `module R[X] (polynomial_module R[X])`. + +See https://leanprover.zulipchat.com/#narrow/stream/144837-PR-reviews/topic/.2315065.20polynomial.20modules +for the full discussion. +-/ +@[derive add_comm_group, derive inhabited, nolint unused_arguments] +def polynomial_module := ℕ →₀ M + +omit R + +variables {M} +variables {S : Type*} [comm_semiring S] [algebra S R] [module S M] [is_scalar_tower S R M] + +namespace polynomial_module + +/-- This is required to have the `is_scalar_tower S R M` instance to avoid diamonds. -/ +@[nolint unused_arguments] +noncomputable +instance : module S (polynomial_module R M) := +finsupp.module ℕ M + +instance : has_coe_to_fun (polynomial_module R M) (λ _, ℕ → M) := +finsupp.has_coe_to_fun + +/-- The monomial `m * x ^ i`. This is defeq to `finsupp.single_add_hom`, and is redefined here +so that it has the desired type signature. -/ +noncomputable +def single (i : ℕ) : M →+ polynomial_module R M := +finsupp.single_add_hom i + +lemma single_apply (i : ℕ) (m : M) (n : ℕ) : single R i m n = ite (i = n) m 0 := +finsupp.single_apply + +/-- `polynomial_module.single` as a linear map. -/ +noncomputable +def lsingle (i : ℕ) : M →ₗ[R] polynomial_module R M := +finsupp.lsingle i + +lemma lsingle_apply (i : ℕ) (m : M) (n : ℕ) : lsingle R i m n = ite (i = n) m 0 := +finsupp.single_apply + +lemma single_smul (i : ℕ) (r : R) (m : M) : single R i (r • m) = r • (single R i m) := +(lsingle R i).map_smul r m + +variable {R} + +lemma induction_linear {P : polynomial_module R M → Prop} (f : polynomial_module R M) + (h0 : P 0) (hadd : ∀ f g, P f → P g → P (f + g)) (hsingle : ∀ a b, P (single R a b)) : P f := +finsupp.induction_linear f h0 hadd hsingle + +@[semireducible] noncomputable +instance polynomial_module : module R[X] (polynomial_module R M) := +module_polynomial_of_endo (finsupp.lmap_domain _ _ nat.succ) + +instance (M : Type u) [add_comm_group M] [module R M] [module S M] [is_scalar_tower S R M] : + is_scalar_tower S R (polynomial_module R M) := +finsupp.is_scalar_tower _ _ + +instance is_scalar_tower' (M : Type u) [add_comm_group M] [module R M] [module S M] + [is_scalar_tower S R M] : + is_scalar_tower S R[X] (polynomial_module R M) := +begin + haveI : is_scalar_tower R R[X] (polynomial_module R M) := + module_polynomial_of_endo.is_scalar_tower _, + constructor, + intros x y z, + rw [← @is_scalar_tower.algebra_map_smul S R, ← @is_scalar_tower.algebra_map_smul S R, + smul_assoc], +end + +@[simp] +lemma monomial_smul_single (i : ℕ) (r : R) (j : ℕ) (m : M) : + monomial i r • single R j m = single R (i + j) (r • m) := +begin + simp only [linear_map.mul_apply, polynomial.aeval_monomial, linear_map.pow_apply, + module.algebra_map_End_apply, module_polynomial_of_endo_smul_def], + induction i generalizing r j m, + { simp [single] }, + { rw [function.iterate_succ, function.comp_app, nat.succ_eq_add_one, add_assoc, ← i_ih], + congr' 2, + ext a, + dsimp [single], + rw [finsupp.map_domain_single, nat.succ_eq_one_add] } +end + +@[simp] +lemma monomial_smul_apply (i : ℕ) (r : R) (g : polynomial_module R M) (n : ℕ) : + (monomial i r • g) n = ite (i ≤ n) (r • g (n - i)) 0 := +begin + induction g using polynomial_module.induction_linear with p q hp hq, + { simp only [smul_zero, finsupp.zero_apply, if_t_t] }, + { simp only [smul_add, finsupp.add_apply, hp, hq], + split_ifs, exacts [rfl, zero_add 0] }, + { rw [monomial_smul_single, single_apply, single_apply, smul_ite, smul_zero, ← ite_and], + congr, + rw eq_iff_iff, + split, + { rintro rfl, simp }, + { rintro ⟨e, rfl⟩, rw [add_comm, tsub_add_cancel_of_le e] } } +end + +@[simp] +lemma smul_single_apply (i : ℕ) (f : R[X]) (m : M) (n : ℕ) : + (f • single R i m) n = ite (i ≤ n) (f.coeff (n - i) • m) 0 := +begin + induction f using polynomial.induction_on' with p q hp hq, + { rw [add_smul, finsupp.add_apply, hp, hq, coeff_add, add_smul], + split_ifs, exacts [rfl, zero_add 0] }, + { rw [monomial_smul_single, single_apply, coeff_monomial, ite_smul, zero_smul], + by_cases h : i ≤ n, + { simp_rw [eq_tsub_iff_add_eq_of_le h, if_pos h] }, + { rw [if_neg h, ite_eq_right_iff], intro e, exfalso, linarith } } +end + +lemma smul_apply (f : R[X]) (g : polynomial_module R M) (n : ℕ) : + (f • g) n = ∑ x in finset.nat.antidiagonal n, f.coeff x.1 • g x.2 := +begin + induction f using polynomial.induction_on' with p q hp hq, + { rw [add_smul, finsupp.add_apply, hp, hq, ← finset.sum_add_distrib], + congr', + ext, + rw [coeff_add, add_smul] }, + { rw [finset.nat.sum_antidiagonal_eq_sum_range_succ (λ i j, (monomial f_n f_a).coeff i • g j), + monomial_smul_apply], + dsimp [monomial], + simp_rw [finsupp.single_smul, finsupp.single_apply], + rw finset.sum_ite_eq, + simp [nat.lt_succ_iff] } +end + +/-- `polynomial_module R R` is isomorphic to `R[X]` as an `R[X]` module. -/ +noncomputable +def equiv_polynomial_self : polynomial_module R R ≃ₗ[R[X]] R[X] := +{ map_smul' := λ r x, begin + induction r using polynomial.induction_on' with _ _ _ _ n p, + { simp only [add_smul, map_add, ring_equiv.to_fun_eq_coe, *] at * }, + { ext i, + dsimp, + rw [monomial_smul_apply, ← polynomial.C_mul_X_pow_eq_monomial, mul_assoc, + polynomial.coeff_C_mul, polynomial.coeff_X_pow_mul', mul_ite, mul_zero], + simp } + end, + ..(polynomial.to_finsupp_iso R).symm } + +/-- `polynomial_module R S` is isomorphic to `S[X]` as an `R` module. -/ +noncomputable +def equiv_polynomial {S : Type*} [comm_ring S] [algebra R S] : + polynomial_module R S ≃ₗ[R] S[X] := +{ map_smul' := λ r x, rfl, ..(polynomial.to_finsupp_iso S).symm } + +variables (R' : Type*) {M' : Type*} [comm_ring R'] [add_comm_group M'] [module R' M'] +variables [algebra R R'] [module R M'] [is_scalar_tower R R' M'] + +/-- The image of a polynomial under a linear map. -/ +noncomputable +def map (f : M →ₗ[R] M') : polynomial_module R M →ₗ[R] polynomial_module R' M' := +finsupp.map_range.linear_map f + +@[simp] +lemma map_single (f : M →ₗ[R] M') (i : ℕ) (m : M) : + map R' f (single R i m) = single R' i (f m) := +finsupp.map_range_single + +lemma map_smul (f : M →ₗ[R] M') (p : R[X]) (q : polynomial_module R M) : + map R' f (p • q) = p.map (algebra_map R R') • map R' f q := +begin + apply induction_linear q, + { rw [smul_zero, map_zero, smul_zero] }, + { intros f g e₁ e₂, rw [smul_add, map_add, e₁, e₂, map_add, smul_add] }, + intros i m, + apply polynomial.induction_on' p, + { intros p q e₁ e₂, rw [add_smul, map_add, e₁, e₂, polynomial.map_add, add_smul] }, + { intros j s, + rw [monomial_smul_single, map_single, polynomial.map_monomial, map_single, + monomial_smul_single, f.map_smul, algebra_map_smul] } +end + +/-- Evaulate a polynomial `p : polynomial_module R M` at `r : R`. -/ +@[simps (lemmas_only)] +def eval (r : R) : polynomial_module R M →ₗ[R] M := +{ to_fun := λ p, p.sum (λ i m, r ^ i • m), + map_add' := λ x y, finsupp.sum_add_index' (λ _, smul_zero _) (λ _ _ _, smul_add _ _ _), + map_smul' := λ s m, begin + refine (finsupp.sum_smul_index' _).trans _, + { exact λ i, smul_zero _ }, + { simp_rw [← smul_comm s, ← finsupp.smul_sum], refl } + end } + +@[simp] +lemma eval_single (r : R) (i : ℕ) (m : M) : eval r (single R i m) = r ^ i • m := +finsupp.sum_single_index (smul_zero _) + +@[simp] +lemma eval_lsingle (r : R) (i : ℕ) (m : M) : eval r (lsingle R i m) = r ^ i • m := +eval_single r i m + +lemma eval_smul (p : R[X]) (q : polynomial_module R M) (r : R) : + eval r (p • q) = p.eval r • eval r q := +begin + apply induction_linear q, + { rw [smul_zero, map_zero, smul_zero] }, + { intros f g e₁ e₂, rw [smul_add, map_add, e₁, e₂, map_add, smul_add] }, + intros i m, + apply polynomial.induction_on' p, + { intros p q e₁ e₂, rw [add_smul, map_add, polynomial.eval_add, e₁, e₂, add_smul] }, + { intros j s, + rw [monomial_smul_single, eval_single, polynomial.eval_monomial, eval_single, + smul_comm, ← smul_smul, pow_add, mul_smul] } +end + +@[simp] +lemma eval_map (f : M →ₗ[R] M') (q : polynomial_module R M) (r : R) : + eval (algebra_map R R' r) (map R' f q) = f (eval r q) := +begin + apply induction_linear q, + { simp_rw map_zero }, + { intros f g e₁ e₂, simp_rw [map_add, e₁, e₂] }, + { intros i m, + rw [map_single, eval_single, eval_single, f.map_smul, ← map_pow, algebra_map_smul] } +end + +@[simp] +lemma eval_map' (f : M →ₗ[R] M) (q : polynomial_module R M) (r : R) : + eval r (map R f q) = f (eval r q) := +eval_map R f q r + +/-- `comp p q` is the composition of `p : R[X]` and `q : M[X]` as `q(p(x))`. -/ +@[simps] noncomputable +def comp (p : R[X]) : polynomial_module R M →ₗ[R] polynomial_module R M := +((eval p).restrict_scalars R).comp (map R[X] (lsingle R 0)) + +lemma comp_single (p : R[X]) (i : ℕ) (m : M) : comp p (single R i m) = p ^ i • single R 0 m := +begin + rw comp_apply, + erw [map_single, eval_single], + refl +end + +lemma comp_eval (p : R[X]) (q : polynomial_module R M) (r : R) : + eval r (comp p q) = eval (p.eval r) q := +begin + rw ← linear_map.comp_apply, + apply induction_linear q, + { rw [map_zero, map_zero] }, + { intros _ _ e₁ e₂, rw [map_add, map_add, e₁, e₂] }, + { intros i m, + rw [linear_map.comp_apply, comp_single, eval_single, eval_smul, eval_single, pow_zero, + one_smul, polynomial.eval_pow] } +end + +lemma comp_smul (p p' : R[X]) (q : polynomial_module R M) : + comp p (p' • q) = p'.comp p • comp p q := +begin + rw [comp_apply, map_smul, eval_smul, polynomial.comp, polynomial.eval_map, comp_apply], + refl +end + +end polynomial_module diff --git a/src/data/polynomial/monic.lean b/src/data/polynomial/monic.lean index 360d21a747eba..e04a1006eb560 100644 --- a/src/data/polynomial/monic.lean +++ b/src/data/polynomial/monic.lean @@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker -/ import data.polynomial.reverse -import algebra.associated import algebra.regular.smul /-! # Theory of monic polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + We give several tools for proving that polynomials are monic, e.g. `monic.mul`, `monic.map`, `monic.pow`. -/ @@ -26,6 +28,17 @@ variables {R : Type u} {S : Type v} {a b : R} {m n : ℕ} {ι : Type y} section semiring variables [semiring R] {p q r : R[X]} +lemma monic_zero_iff_subsingleton : monic (0 : R[X]) ↔ subsingleton R := +subsingleton_iff_zero_eq_one + +lemma not_monic_zero_iff : ¬ monic (0 : R[X]) ↔ (0 : R) ≠ 1 := +(monic_zero_iff_subsingleton.trans subsingleton_iff_zero_eq_one.symm).not + +lemma monic_zero_iff_subsingleton' : + monic (0 : R[X]) ↔ (∀ f g : R[X], f = g) ∧ (∀ a b : R, a = b) := +polynomial.monic_zero_iff_subsingleton.trans ⟨by { introI, simp }, + λ h, subsingleton_iff.mpr h.2⟩ + lemma monic.as_sum (hp : p.monic) : p = X^(p.nat_degree) + (∑ i in range p.nat_degree, C (p.coeff i) * X^i) := begin @@ -115,7 +128,7 @@ end namespace monic @[simp] -lemma nat_degree_eq_zero_iff_eq_one {p : R[X]} (hp : p.monic) : +lemma nat_degree_eq_zero_iff_eq_one (hp : p.monic) : p.nat_degree = 0 ↔ p = 1 := begin split; intro h, @@ -127,11 +140,11 @@ begin end @[simp] -lemma degree_le_zero_iff_eq_one {p : R[X]} (hp : p.monic) : +lemma degree_le_zero_iff_eq_one (hp : p.monic) : p.degree ≤ 0 ↔ p = 1 := by rw [←hp.nat_degree_eq_zero_iff_eq_one, nat_degree_eq_zero_iff_degree_le_zero] -lemma nat_degree_mul {p q : R[X]} (hp : p.monic) (hq : q.monic) : +lemma nat_degree_mul (hp : p.monic) (hq : q.monic) : (p * q).nat_degree = p.nat_degree + q.nat_degree := begin nontriviality R, @@ -139,7 +152,7 @@ begin simp [hp.leading_coeff, hq.leading_coeff] end -lemma degree_mul_comm {p : R[X]} (hp : p.monic) (q : R[X]) : +lemma degree_mul_comm (hp : p.monic) (q : R[X]) : (p * q).degree = (q * p).degree := begin by_cases h : q = 0, @@ -149,14 +162,14 @@ begin { rwa [hp.leading_coeff, one_mul, leading_coeff_ne_zero] } end -lemma nat_degree_mul' {p q : R[X]} (hp : p.monic) (hq : q ≠ 0) : +lemma nat_degree_mul' (hp : p.monic) (hq : q ≠ 0) : (p * q).nat_degree = p.nat_degree + q.nat_degree := begin rw [nat_degree_mul', add_comm], simpa [hp.leading_coeff, leading_coeff_ne_zero] end -lemma nat_degree_mul_comm {p : R[X]} (hp : p.monic) (q : R[X]) : +lemma nat_degree_mul_comm (hp : p.monic) (q : R[X]) : (p * q).nat_degree = (q * p).nat_degree := begin by_cases h : q = 0, @@ -165,7 +178,19 @@ begin simpa [hp.leading_coeff, leading_coeff_ne_zero] end -lemma next_coeff_mul {p q : R[X]} (hp : monic p) (hq : monic q) : +lemma not_dvd_of_nat_degree_lt (hp : monic p) + (h0 : q ≠ 0) (hl : nat_degree q < nat_degree p) : ¬ p ∣ q := +begin + rintro ⟨r, rfl⟩, + rw [hp.nat_degree_mul' $ right_ne_zero_of_mul h0] at hl, + exact hl.not_le (nat.le_add_right _ _) +end + +lemma not_dvd_of_degree_lt (hp : monic p) + (h0 : q ≠ 0) (hl : degree q < degree p) : ¬ p ∣ q := +monic.not_dvd_of_nat_degree_lt hp h0 $ nat_degree_lt_nat_degree h0 hl + +lemma next_coeff_mul (hp : monic p) (hq : monic q) : next_coeff (p * q) = next_coeff p + next_coeff q := begin nontriviality, @@ -203,6 +228,18 @@ end monic ((X + C r) ^ n).nat_degree = n := by rw [(monic_X_add_C r).nat_degree_pow, nat_degree_X_add_C, mul_one] +lemma monic.eq_one_of_is_unit (hm : monic p) (hpu : is_unit p) : p = 1 := +begin + nontriviality R, + obtain ⟨q, h⟩ := hpu.exists_right_inv, + have := hm.nat_degree_mul' (right_ne_zero_of_mul_eq_one h), + rw [h, nat_degree_one, eq_comm, add_eq_zero_iff] at this, + exact hm.nat_degree_eq_zero_iff_eq_one.mp this.1, +end + +lemma monic.is_unit_iff (hm : p.monic) : is_unit p ↔ p = 1 := +⟨hm.eq_one_of_is_unit, λ h, h.symm ▸ is_unit_one⟩ + end semiring section comm_semiring @@ -223,37 +260,6 @@ lemma monic_prod_of_monic (s : finset ι) (f : ι → R[X]) (hs : ∀ i ∈ s, m monic (∏ i in s, f i) := monic_multiset_prod_of_monic s.1 f hs -lemma is_unit_C {x : R} : is_unit (C x) ↔ is_unit x := -begin - rw [is_unit_iff_dvd_one, is_unit_iff_dvd_one], - split, - { rintros ⟨g, hg⟩, - replace hg := congr_arg (eval 0) hg, - rw [eval_one, eval_mul, eval_C] at hg, - exact ⟨g.eval 0, hg⟩ }, - { rintros ⟨y, hy⟩, - exact ⟨C y, by rw [← C_mul, ← hy, C_1]⟩ } -end - -lemma eq_one_of_is_unit_of_monic (hm : monic p) (hpu : is_unit p) : p = 1 := -have degree p ≤ 0, - from calc degree p ≤ degree (1 : R[X]) : - let ⟨u, hu⟩ := is_unit_iff_dvd_one.1 hpu in - if hu0 : u = 0 - then begin - rw [hu0, mul_zero] at hu, - rw [← mul_one p, hu, mul_zero], - simp - end - else have p.leading_coeff * u.leading_coeff ≠ 0, - by rw [hm.leading_coeff, one_mul, ne.def, leading_coeff_eq_zero]; - exact hu0, - by rw [hu, degree_mul' this]; - exact le_add_of_nonneg_right (degree_nonneg_iff_ne_zero.2 hu0) - ... ≤ 0 : degree_one_le, -by rw [eq_C_of_degree_le_zero this, ← nat_degree_eq_zero_iff_degree_le_zero.2 this, - ← leading_coeff, hm.leading_coeff, C_1] - lemma monic.next_coeff_multiset_prod (t : multiset ι) (f : ι → R[X]) (h : ∀ i ∈ t, monic (f i)) : next_coeff (t.map f).prod = (t.map (λ i, next_coeff (f i))).sum := @@ -279,7 +285,7 @@ section semiring variables [semiring R] @[simp] -lemma monic.nat_degree_map [semiring S] [nontrivial S] {P : polynomial R} (hmo : P.monic) +lemma monic.nat_degree_map [semiring S] [nontrivial S] {P : R[X]} (hmo : P.monic) (f : R →+* S) : (P.map f).nat_degree = P.nat_degree := begin refine le_antisymm (nat_degree_map_le _ _) (le_nat_degree_of_ne_zero _), @@ -288,7 +294,7 @@ begin end @[simp] -lemma monic.degree_map [semiring S] [nontrivial S] {P : polynomial R} (hmo : P.monic) +lemma monic.degree_map [semiring S] [nontrivial S] {P : R[X]} (hmo : P.monic) (f : R →+* S) : (P.map f).degree = P.degree := begin by_cases hP : P = 0, @@ -343,6 +349,9 @@ begin rw [← leading_coeff_of_injective hf, hp.leading_coeff, f.map_one] end +theorem _root_.function.injective.monic_map_iff {p : R[X]} : p.monic ↔ (p.map f).monic := +⟨monic.map _, polynomial.monic_of_injective hf⟩ + end injective end semiring @@ -371,9 +380,7 @@ begin rcases eq_or_ne n 0 with rfl | hn, { simpa using h }, apply hn, - rwa [← @nat_degree_X_pow_sub_C _ _ _ n (1 : R), - eq_one_of_is_unit_of_monic (monic_X_pow_sub_C (1 : R) hn), - nat_degree_one] + rw [←@nat_degree_one R, ←(monic_X_pow_sub_C _ hn).eq_one_of_is_unit h, nat_degree_X_pow_sub_C], end lemma monic.sub_of_left {p q : R[X]} (hp : monic p) (hpq : degree q < degree p) : @@ -392,7 +399,7 @@ section nonzero_semiring variables [semiring R] [nontrivial R] {p q : R[X]} @[simp] lemma not_monic_zero : ¬monic (0 : R[X]) := -by simpa only [monic, leading_coeff_zero] using (zero_ne_one : (0 : R) ≠ 1) +not_monic_zero_iff.mp zero_ne_one end nonzero_semiring diff --git a/src/data/polynomial/monomial.lean b/src/data/polynomial/monomial.lean index eb8f32669e6bb..27bbac66f924d 100644 --- a/src/data/polynomial/monomial.lean +++ b/src/data/polynomial/monomial.lean @@ -8,6 +8,9 @@ import data.polynomial.basic /-! # Univariate monomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + Preparatory lemmas for degree_basic. -/ diff --git a/src/data/polynomial/partial_fractions.lean b/src/data/polynomial/partial_fractions.lean new file mode 100644 index 0000000000000..b364b375da840 --- /dev/null +++ b/src/data/polynomial/partial_fractions.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) Sidharth Hariharan. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Kevin Buzzard, Sidharth Hariharan +-/ +import data.polynomial.div +import data.zmod.basic +import logic.function.basic +import ring_theory.localization.fraction_ring +import tactic.field_simp +import tactic.linear_combination + +/-! + +# Partial fractions + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +These results were formalised by the Xena Project, at the suggestion +of Patrick Massot. + + +# The main theorem + +* `div_eq_quo_add_sum_rem_div`: General partial fraction decomposition theorem for polynomials over + an integral domain R : + If f, g₁, g₂, ..., gₙ ∈ R[X] and the gᵢs are all monic and pairwise coprime, then ∃ q, r₁, ..., rₙ + ∈ R[X] such that f / g₁g₂...gₙ = q + r₁/g₁ + ... + rₙ/gₙ and for all i, deg(rᵢ) < deg(gᵢ). + +* The result is formalized here in slightly more generality, using finsets. That is, if ι is an + arbitrary index type, g denotes a map from ι to R[X], and if s is an arbitrary finite subset of ι, + with g i monic for all i ∈ s and for all i,j ∈ s, i ≠ j → g i is coprime to g j, then we have + ∃ q ∈ R[X] , r : ι → R[X] such that ∀ i ∈ s, deg(r i) < deg(g i) and + f / ∏ g i = q + ∑ (r i) / (g i), where the product and sum are over s. + +* The proof is done by proving the two-denominator case and then performing finset induction for an + arbitrary (finite) number of denominators. + +## Scope for Expansion + +* Proving uniqueness of the decomposition + +-/ + + +variables (R : Type) [comm_ring R] [is_domain R] + +open_locale polynomial + +open polynomial + +variables (K : Type) [field K] [algebra R[X] K] [is_fraction_ring R[X] K] + +section two_denominators + +/-- +Let R be an integral domain and f, g₁, g₂ ∈ R[X]. Let g₁ and g₂ be monic and coprime. +Then, ∃ q, r₁, r₂ ∈ R[X] such that f / g₁g₂ = q + r₁/g₁ + r₂/g₂ and deg(r₁) < deg(g₁) and +deg(r₂) < deg(g₂). +-/ +lemma div_eq_quo_add_rem_div_add_rem_div (f : R[X]) {g₁ g₂ : R[X]} + (hg₁ : g₁.monic) (hg₂ : g₂.monic) (hcoprime : is_coprime g₁ g₂) : + ∃ q r₁ r₂ : R[X], r₁.degree < g₁.degree ∧ r₂.degree < g₂.degree ∧ + (↑f : K) / (↑g₁ * ↑g₂) = ↑q + ↑r₁ / ↑g₁ + ↑r₂ / ↑g₂ := +begin + rcases hcoprime with ⟨c, d, hcd⟩, + refine ⟨(f * d) /ₘ g₁ + (f * c) /ₘ g₂, (f * d) %ₘ g₁, (f * c) %ₘ g₂, + (degree_mod_by_monic_lt _ hg₁), (degree_mod_by_monic_lt _ hg₂), _⟩, + have hg₁' : (↑g₁ : K) ≠ 0, + { norm_cast, exact hg₁.ne_zero_of_ne zero_ne_one, }, + have hg₂' : (↑g₂ : K) ≠ 0, + { norm_cast, exact hg₂.ne_zero_of_ne zero_ne_one, }, + have hfc := mod_by_monic_add_div (f * c) hg₂, + have hfd := mod_by_monic_add_div (f * d) hg₁, + field_simp, + norm_cast, + linear_combination (-1) * f * hcd + (-1) * g₁ * hfc + (-1) * g₂ * hfd, +end + +end two_denominators + +section n_denominators + +open_locale big_operators classical + +/-- +Let R be an integral domain and f ∈ R[X]. Let s be a finite index set. +Then, a fraction of the form f / ∏ (g i) can be rewritten as q + ∑ (r i) / (g i), where +deg(r i) < deg(g i), provided that the g i are monic and pairwise coprime. +-/ +lemma div_eq_quo_add_sum_rem_div (f : R[X]) {ι : Type*} {g : ι → R[X]} {s : finset ι} + (hg : ∀ i ∈ s, (g i).monic) + (hcop : set.pairwise ↑s (λ i j, is_coprime (g i) (g j))) : + ∃ (q : R[X]) (r : ι → R[X]), (∀ i ∈ s, (r i).degree < (g i).degree) ∧ + (↑f : K) / ∏ i in s, ↑(g i) = ↑q + ∑ i in s, ↑(r i) / ↑(g i) := +begin + induction s using finset.induction_on with a b hab Hind f generalizing f, + { refine ⟨f, (λ (i : ι), (0 : R[X])), λ i, _, by simp⟩, + rintro ⟨⟩, }, + obtain ⟨q₀, r₁, r₂, hdeg₁, hdeg₂, (hf : (↑f : K) / _ = _)⟩ := + div_eq_quo_add_rem_div_add_rem_div R K f + (_ : monic (g a)) + (_ : monic ∏ (i : ι) in b, (g i)) + _, + { obtain ⟨q, r, hrdeg, IH⟩ := Hind (λ i hi, hg i (finset.mem_insert_of_mem hi)) + (set.pairwise.mono ( finset.coe_subset.2 $ λ i hi, finset.mem_insert_of_mem hi) hcop) r₂, + refine ⟨q₀ + q, λ i, if i = a then r₁ else r i, _, _⟩, + { intro i, + split_ifs with h1, + { cases h1, + intro _, + exact hdeg₁, }, + { intro hi, + exact hrdeg i (finset.mem_of_mem_insert_of_ne hi h1), }, }, + norm_cast at ⊢ hf IH, + rw [finset.prod_insert hab, hf, IH, finset.sum_insert hab, if_pos rfl], + transitivity (↑(q₀ + q : R[X]) : K) + (↑r₁ / ↑(g a) + ∑ (i : ι) in b, ↑(r i) / ↑(g i)), + { push_cast, ring, }, + congr' 2, + refine finset.sum_congr rfl (λ x hxb, _), + rw if_neg, + rintro rfl, + exact hab hxb }, + { exact hg a (b.mem_insert_self a), }, + { exact monic_prod_of_monic _ _ (λ i hi, hg i (finset.mem_insert_of_mem hi)), }, + { refine is_coprime.prod_right (λ i hi, hcop (finset.mem_coe.2 (b.mem_insert_self a)) + (finset.mem_coe.2 (finset.mem_insert_of_mem hi)) _), + rintro rfl, + exact hab hi, }, +end + +end n_denominators diff --git a/src/data/polynomial/reverse.lean b/src/data/polynomial/reverse.lean index 38373d31395af..037c15d2c939e 100644 --- a/src/data/polynomial/reverse.lean +++ b/src/data/polynomial/reverse.lean @@ -10,6 +10,9 @@ import data.polynomial.eval /-! # Reverse of a univariate polynomial +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + The main definition is `reverse`. Applying `reverse` to a polynomial `f : R[X]` produces the polynomial with a reversed list of coefficients, equivalent to `X^f.nat_degree * f(1/X)`. @@ -88,11 +91,11 @@ noncomputable def reflect (N : ℕ) : R[X] → R[X] | ⟨f⟩ := ⟨finsupp.emb_domain (rev_at N) f⟩ lemma reflect_support (N : ℕ) (f : R[X]) : - (reflect N f).support = image (rev_at N) f.support := + (reflect N f).support = finset.image (rev_at N) f.support := begin rcases f, ext1, - rw [reflect, mem_image, support, support, support_emb_domain, mem_map], + simp only [reflect, support_of_finsupp, support_emb_domain, finset.mem_map, finset.mem_image], end @[simp] lemma coeff_reflect (N : ℕ) (f : R[X]) (i : ℕ) : @@ -265,7 +268,7 @@ lemma reverse_nat_trailing_degree (f : R[X]) : f.reverse.nat_trailing_degree = begin by_cases hf : f = 0, { rw [hf, reverse_zero, nat_trailing_degree_zero] }, - { rw ← nat.le_zero_iff, + { rw ← le_zero_iff, apply nat_trailing_degree_le_of_ne_zero, rw [coeff_zero_reverse], exact mt leading_coeff_eq_zero.mp hf }, diff --git a/src/data/polynomial/ring_division.lean b/src/data/polynomial/ring_division.lean index 8943000d89706..a9c8a85e0f496 100644 --- a/src/data/polynomial/ring_division.lean +++ b/src/data/polynomial/ring_division.lean @@ -3,25 +3,43 @@ Copyright (c) 2018 Chris Hughes. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker, Johan Commelin -/ +import algebra.char_zero.infinite import data.polynomial.algebra_map import data.polynomial.degree.lemmas import data.polynomial.div +import ring_theory.localization.fraction_ring +import algebra.polynomial.big_operators /-! # Theory of univariate polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + This file starts looking like the ring theory of $ R[X] $ +## Main definitions + +* `polynomial.roots p`: The multiset containing all the roots of `p`, including their + multiplicities. +* `polynomial.root_set p E`: The set of distinct roots of `p` in an algebra `E`. + +## Main statements + +* `polynomial.C_leading_coeff_mul_prod_multiset_X_sub_C`: If a polynomial has as many roots as its + degree, it can be written as the product of its leading coefficient with `∏ (X - a)` where `a` + ranges through its roots. + -/ noncomputable theory -open_locale classical polynomial +open_locale polynomial open finset namespace polynomial universes u v w z -variables {R : Type u} {S : Type v} {T : Type w} {A : Type z} {a b : R} {n : ℕ} +variables {R : Type u} {S : Type v} {T : Type w} {a b : R} {n : ℕ} section comm_ring variables [comm_ring R] {p q : R[X]} @@ -110,8 +128,20 @@ by rw [← with_bot.coe_eq_coe, ← degree_eq_nat_degree (mul_ne_zero hp hq), with_bot.coe_add, ← degree_eq_nat_degree hp, ← degree_eq_nat_degree hq, degree_mul] +lemma trailing_degree_mul : (p * q).trailing_degree = p.trailing_degree + q.trailing_degree := +begin + by_cases hp : p = 0, + { rw [hp, zero_mul, trailing_degree_zero, top_add] }, + by_cases hq : q = 0, + { rw [hq, mul_zero, trailing_degree_zero, add_top] }, + rw [trailing_degree_eq_nat_trailing_degree hp, trailing_degree_eq_nat_trailing_degree hq, + trailing_degree_eq_nat_trailing_degree (mul_ne_zero hp hq), + nat_trailing_degree_mul hp hq, with_top.coe_add], +end + @[simp] lemma nat_degree_pow (p : R[X]) (n : ℕ) : nat_degree (p ^ n) = n * nat_degree p := +by classical; exact if hp0 : p = 0 then if hn0 : n = 0 then by simp [hp0, hn0] else by rw [hp0, zero_pow (nat.pos_of_ne_zero hn0)]; simp @@ -119,6 +149,7 @@ else nat_degree_pow' (by rw [← leading_coeff_pow, ne.def, leading_coeff_eq_zero]; exact pow_ne_zero _ hp0) lemma degree_le_mul_left (p : R[X]) (hq : q ≠ 0) : degree p ≤ degree (p * q) := +by classical; exact if hp : p = 0 then by simp only [hp, zero_mul, le_refl] else by rw [degree_mul, degree_eq_nat_degree hp, degree_eq_nat_degree hq]; @@ -131,8 +162,42 @@ begin rw [nat_degree_mul h2.1 h2.2], exact nat.le_add_right _ _ end +lemma degree_le_of_dvd {p q : R[X]} (h1 : p ∣ q) (h2 : q ≠ 0) : degree p ≤ degree q := +begin + rcases h1 with ⟨q, rfl⟩, rw mul_ne_zero_iff at h2, + exact degree_le_mul_left p h2.2, +end + +lemma eq_zero_of_dvd_of_degree_lt {p q : R[X]} (h₁ : p ∣ q) (h₂ : degree q < degree p) : + q = 0 := +begin + by_contradiction hc, + exact (lt_iff_not_ge _ _ ).mp h₂ (degree_le_of_dvd h₁ hc), +end + +lemma eq_zero_of_dvd_of_nat_degree_lt {p q : R[X]} (h₁ : p ∣ q) (h₂ : nat_degree q < nat_degree p) : + q = 0 := +begin + by_contradiction hc, + exact (lt_iff_not_ge _ _ ).mp h₂ (nat_degree_le_of_dvd h₁ hc), +end + +theorem not_dvd_of_degree_lt {p q : R[X]} (h0 : q ≠ 0) + (hl : q.degree < p.degree) : ¬ p ∣ q := +begin + by_contra hcontra, + exact h0 (eq_zero_of_dvd_of_degree_lt hcontra hl), +end + +theorem not_dvd_of_nat_degree_lt {p q : R[X]} (h0 : q ≠ 0) + (hl : q.nat_degree < p.nat_degree) : ¬ p ∣ q := +begin + by_contra hcontra, + exact h0 (eq_zero_of_dvd_of_nat_degree_lt hcontra hl), +end + /-- This lemma is useful for working with the `int_degree` of a rational function. -/ -lemma nat_degree_sub_eq_of_prod_eq {p₁ p₂ q₁ q₂ : polynomial R} (hp₁ : p₁ ≠ 0) (hq₁ : q₁ ≠ 0) +lemma nat_degree_sub_eq_of_prod_eq {p₁ p₂ q₁ q₂ : R[X]} (hp₁ : p₁ ≠ 0) (hq₁ : q₁ ≠ 0) (hp₂ : p₂ ≠ 0) (hq₂ : q₂ ≠ 0) (h_eq : p₁ * q₂ = p₂ * q₁) : (p₁.nat_degree : ℤ) - q₁.nat_degree = (p₂.nat_degree : ℤ) - q₂.nat_degree := begin @@ -141,11 +206,116 @@ begin rw [← nat_degree_mul hp₁ hq₂, ← nat_degree_mul hp₂ hq₁, h_eq] end +lemma nat_degree_eq_zero_of_is_unit (h : is_unit p) : nat_degree p = 0 := +begin + nontriviality R, + obtain ⟨q, hq⟩ := h.exists_right_inv, + have := nat_degree_mul (left_ne_zero_of_mul_eq_one hq) (right_ne_zero_of_mul_eq_one hq), + rw [hq, nat_degree_one, eq_comm, add_eq_zero_iff] at this, + exact this.1, +end + +lemma degree_eq_zero_of_is_unit [nontrivial R] (h : is_unit p) : degree p = 0 := +(nat_degree_eq_zero_iff_degree_le_zero.mp $ nat_degree_eq_zero_of_is_unit h).antisymm + (zero_le_degree_iff.mpr h.ne_zero) + +@[simp] lemma degree_coe_units [nontrivial R] (u : R[X]ˣ) : degree (u : R[X]) = 0 := +degree_eq_zero_of_is_unit ⟨u, rfl⟩ + +theorem is_unit_iff : is_unit p ↔ ∃ r : R, is_unit r ∧ C r = p := +⟨λ hp, ⟨p.coeff 0, let h := eq_C_of_nat_degree_eq_zero (nat_degree_eq_zero_of_is_unit hp) in + ⟨is_unit_C.1 (h ▸ hp), h.symm⟩⟩, λ ⟨r, hr, hrp⟩, hrp ▸ is_unit_C.2 hr⟩ + +variables [char_zero R] + +@[simp] lemma degree_bit0_eq (p : R[X]) : degree (bit0 p) = degree p := +by rw [bit0_eq_two_mul, degree_mul, (by simp : (2 : R[X]) = C 2), + @polynomial.degree_C R _ _ two_ne_zero, zero_add] + +@[simp] lemma nat_degree_bit0_eq (p : R[X]) : nat_degree (bit0 p) = nat_degree p := +nat_degree_eq_of_degree_eq $ degree_bit0_eq p + +@[simp] +lemma nat_degree_bit1_eq (p : R[X]) : nat_degree (bit1 p) = nat_degree p := +begin + rw bit1, + apply le_antisymm, + convert nat_degree_add_le _ _, + { simp, }, + by_cases h : p.nat_degree = 0, + { simp [h], }, + apply le_nat_degree_of_ne_zero, + intro hh, + apply h, + simp [*, coeff_one, if_neg (ne.symm h)] at *, +end + +lemma degree_bit1_eq {p : R[X]} (hp : 0 < degree p) : degree (bit1 p) = degree p := +begin + rw [bit1, degree_add_eq_left_of_degree_lt, degree_bit0_eq], + rwa [degree_one, degree_bit0_eq] +end + end no_zero_divisors section no_zero_divisors variables [comm_semiring R] [no_zero_divisors R] {p q : R[X]} +lemma irreducible_of_monic (hp : p.monic) (hp1 : p ≠ 1) : + irreducible p ↔ ∀ f g : R[X], f.monic → g.monic → f * g = p → f = 1 ∨ g = 1 := +begin + refine ⟨λ h f g hf hg hp, (h.2 f g hp.symm).imp hf.eq_one_of_is_unit hg.eq_one_of_is_unit, + λ h, ⟨hp1 ∘ hp.eq_one_of_is_unit, λ f g hfg, (h (g * C f.leading_coeff) (f * C g.leading_coeff) + _ _ _).symm.imp (is_unit_of_mul_eq_one f _) (is_unit_of_mul_eq_one g _)⟩⟩, + { rwa [monic, leading_coeff_mul, leading_coeff_C, ←leading_coeff_mul, mul_comm, ←hfg, ←monic] }, + { rwa [monic, leading_coeff_mul, leading_coeff_C, ←leading_coeff_mul, ←hfg, ←monic] }, + { rw [mul_mul_mul_comm, ←C_mul, ←leading_coeff_mul, ←hfg, hp.leading_coeff, C_1, mul_one, + mul_comm, ←hfg] }, +end + +lemma monic.irreducible_iff_nat_degree (hp : p.monic) : irreducible p ↔ + p ≠ 1 ∧ ∀ f g : R[X], f.monic → g.monic → f * g = p → f.nat_degree = 0 ∨ g.nat_degree = 0 := +begin + by_cases hp1 : p = 1, { simp [hp1] }, + rw [irreducible_of_monic hp hp1, and_iff_right hp1], + refine forall₄_congr (λ a b ha hb, _), + rw [ha.nat_degree_eq_zero_iff_eq_one, hb.nat_degree_eq_zero_iff_eq_one], +end + +lemma monic.irreducible_iff_nat_degree' (hp : p.monic) : irreducible p ↔ p ≠ 1 ∧ + ∀ f g : R[X], f.monic → g.monic → f * g = p → g.nat_degree ∉ Ioc 0 (p.nat_degree / 2) := +begin + simp_rw [hp.irreducible_iff_nat_degree, mem_Ioc, nat.le_div_iff_mul_le zero_lt_two, mul_two], + apply and_congr_right', + split; intros h f g hf hg he; subst he, + { rw [hf.nat_degree_mul hg, add_le_add_iff_right], + exact λ ha, (h f g hf hg rfl).elim (ha.1.trans_le ha.2).ne' ha.1.ne' }, + { simp_rw [hf.nat_degree_mul hg, pos_iff_ne_zero] at h, + contrapose! h, + obtain hl|hl := le_total f.nat_degree g.nat_degree, + { exact ⟨g, f, hg, hf, mul_comm g f, h.1, add_le_add_left hl _⟩ }, + { exact ⟨f, g, hf, hg, rfl, h.2, add_le_add_right hl _⟩ } }, +end + +lemma monic.not_irreducible_iff_exists_add_mul_eq_coeff (hm : p.monic) (hnd : p.nat_degree = 2) : + ¬ irreducible p ↔ ∃ c₁ c₂, p.coeff 0 = c₁ * c₂ ∧ p.coeff 1 = c₁ + c₂ := +begin + casesI subsingleton_or_nontrivial R, + { simpa only [nat_degree_of_subsingleton] using hnd }, + rw [hm.irreducible_iff_nat_degree', and_iff_right, hnd], + push_neg, split, + { rintros ⟨a, b, ha, hb, rfl, hdb|⟨⟨⟩⟩⟩, + have hda := hnd, rw [ha.nat_degree_mul hb, hdb] at hda, + use [a.coeff 0, b.coeff 0, mul_coeff_zero a b], + simpa only [next_coeff, hnd, add_right_cancel hda, hdb] using ha.next_coeff_mul hb }, + { rintros ⟨c₁, c₂, hmul, hadd⟩, + refine ⟨X + C c₁, X + C c₂, monic_X_add_C _, monic_X_add_C _, _, or.inl $ nat_degree_X_add_C _⟩, + rw [p.as_sum_range_C_mul_X_pow, hnd, finset.sum_range_succ, finset.sum_range_succ, + finset.sum_range_one, ← hnd, hm.coeff_nat_degree, hnd, hmul, hadd, C_mul, C_add, C_1], + ring }, + { rintro rfl, simpa only [nat_degree_one] using hnd }, +end + lemma root_mul : is_root (p * q) a ↔ is_root p a ∨ is_root q a := by simp_rw [is_root, eval_mul, mul_eq_zero] @@ -158,43 +328,48 @@ section ring variables [ring R] [is_domain R] {p q : R[X]} instance : is_domain R[X] := -{ ..polynomial.no_zero_divisors, - ..polynomial.nontrivial, } +no_zero_divisors.to_is_domain _ + +end ring + +section comm_ring +variable [comm_ring R] -lemma nat_trailing_degree_mul (hp : p ≠ 0) (hq : q ≠ 0) : - (p * q).nat_trailing_degree = p.nat_trailing_degree + q.nat_trailing_degree := +/-- The multiplicity of `a` as root of a nonzero polynomial `p` is at least `n` iff + `(X - a) ^ n` divides `p`. -/ +lemma le_root_multiplicity_iff {p : R[X]} (p0 : p ≠ 0) {a : R} {n : ℕ} : + n ≤ root_multiplicity a p ↔ (X - C a) ^ n ∣ p := begin - simp only [←tsub_eq_of_eq_add_rev (nat_degree_eq_reverse_nat_degree_add_nat_trailing_degree _)], - rw [reverse_mul_of_domain, nat_degree_mul hp hq, nat_degree_mul (mt reverse_eq_zero.mp hp) - (mt reverse_eq_zero.mp hq), reverse_nat_degree, reverse_nat_degree, tsub_add_eq_tsub_tsub, - nat.add_comm, add_tsub_assoc_of_le (nat.sub_le _ _), add_comm, - add_tsub_assoc_of_le (nat.sub_le _ _)], + classical, + simp_rw [root_multiplicity, dif_neg p0, nat.le_find_iff, not_not], + refine ⟨λ h, _, λ h m hm, (pow_dvd_pow _ hm).trans h⟩, + cases n, { rw pow_zero, apply one_dvd }, { exact h n n.lt_succ_self }, end -end ring +lemma root_multiplicity_le_iff {p : R[X]} (p0 : p ≠ 0) (a : R) (n : ℕ) : + root_multiplicity a p ≤ n ↔ ¬ (X - C a) ^ (n + 1) ∣ p := +by rw [← (le_root_multiplicity_iff p0).not, not_le, nat.lt_add_one_iff] -section comm_ring -variables [comm_ring R] [is_domain R] {p q : R[X]} +lemma pow_root_multiplicity_not_dvd {p : R[X]} (p0 : p ≠ 0) (a : R) : + ¬ (X - C a) ^ (root_multiplicity a p + 1) ∣ p := +by rw [← root_multiplicity_le_iff p0] + +/-- The multiplicity of `p + q` is at least the minimum of the multiplicities. -/ +lemma root_multiplicity_add {p q : R[X]} (a : R) (hzero : p + q ≠ 0) : + min (root_multiplicity a p) (root_multiplicity a q) ≤ root_multiplicity a (p + q) := +begin + rw le_root_multiplicity_iff hzero, + have hdivp : (X - C a) ^ root_multiplicity a p ∣ p := pow_root_multiplicity_dvd p a, + have hdivq : (X - C a) ^ root_multiplicity a q ∣ q := pow_root_multiplicity_dvd q a, + exact min_pow_dvd_add hdivp hdivq +end + +variables [is_domain R] {p q : R[X]} section roots open multiset -lemma degree_eq_zero_of_is_unit (h : is_unit p) : degree p = 0 := -let ⟨q, hq⟩ := is_unit_iff_dvd_one.1 h in -have hp0 : p ≠ 0, from λ hp0, by simpa [hp0] using hq, -have hq0 : q ≠ 0, from λ hp0, by simpa [hp0] using hq, -have nat_degree (1 : R[X]) = nat_degree (p * q), - from congr_arg _ hq, -by rw [nat_degree_one, nat_degree_mul hp0 hq0, eq_comm, - _root_.add_eq_zero_iff, ← with_bot.coe_eq_coe, - ← degree_eq_nat_degree hp0] at this; - exact this.1 - -@[simp] lemma degree_coe_units (u : R[X]ˣ) : - degree (u : R[X]) = 0 := -degree_eq_zero_of_is_unit ⟨u, rfl⟩ - theorem prime_X_sub_C (r : R) : prime (X - C r) := ⟨X_sub_C_ne_zero r, not_is_unit_X_sub_C r, λ _ _, by { simp_rw [dvd_iff_is_root, is_root.def, eval_mul, mul_eq_zero], exact id }⟩ @@ -222,15 +397,16 @@ theorem eq_of_monic_of_associated (hp : p.monic) (hq : q.monic) (hpq : associate begin obtain ⟨u, hu⟩ := hpq, unfold monic at hp hq, - rw eq_C_of_degree_le_zero (le_of_eq $ degree_coe_units _) at hu, + rw eq_C_of_degree_le_zero (degree_coe_units _).le at hu, rw [← hu, leading_coeff_mul, hp, one_mul, leading_coeff_C] at hq, rwa [hq, C_1, mul_one] at hu, - apply_instance, + all_goals { apply_instance }, end lemma root_multiplicity_mul {p q : R[X]} {x : R} (hpq : p * q ≠ 0) : root_multiplicity x (p * q) = root_multiplicity x p + root_multiplicity x q := begin + classical, have hp : p ≠ 0 := left_ne_zero_of_mul hpq, have hq : q ≠ 0 := right_ne_zero_of_mul hpq, rw [root_multiplicity_eq_multiplicity (p * q), dif_neg hpq, @@ -241,10 +417,10 @@ end lemma root_multiplicity_X_sub_C_self {x : R} : root_multiplicity x (X - C x) = 1 := -by rw [root_multiplicity_eq_multiplicity, dif_neg (X_sub_C_ne_zero x), +by classical; rw [root_multiplicity_eq_multiplicity, dif_neg (X_sub_C_ne_zero x), multiplicity.get_multiplicity_self] -lemma root_multiplicity_X_sub_C {x y : R} : +lemma root_multiplicity_X_sub_C {x y : R} [decidable_eq R] : root_multiplicity x (X - C y) = if x = y then 1 else 0 := begin split_ifs with hxy, @@ -264,28 +440,7 @@ begin simp only [root_multiplicity_mul hzero, root_multiplicity_X_sub_C_self, hn, nat.one_add] end -/-- If `(X - a) ^ n` divides a polynomial `p` then the multiplicity of `a` as root of `p` is at -least `n`. -/ -lemma root_multiplicity_of_dvd {p : R[X]} {a : R} {n : ℕ} - (hzero : p ≠ 0) (h : (X - C a) ^ n ∣ p) : n ≤ root_multiplicity a p := -begin - obtain ⟨q, hq⟩ := exists_eq_mul_right_of_dvd h, - rw hq at hzero, - simp only [hq, root_multiplicity_mul hzero, root_multiplicity_X_sub_C_pow, - ge_iff_le, _root_.zero_le, le_add_iff_nonneg_right], -end - -/-- The multiplicity of `p + q` is at least the minimum of the multiplicities. -/ -lemma root_multiplicity_add {p q : R[X]} (a : R) (hzero : p + q ≠ 0) : - min (root_multiplicity a p) (root_multiplicity a q) ≤ root_multiplicity a (p + q) := -begin - refine root_multiplicity_of_dvd hzero _, - have hdivp : (X - C a) ^ root_multiplicity a p ∣ p := pow_root_multiplicity_dvd p a, - have hdivq : (X - C a) ^ root_multiplicity a q ∣ q := pow_root_multiplicity_dvd q a, - exact min_pow_dvd_add hdivp hdivq -end - -lemma exists_multiset_roots : ∀ {p : R[X]} (hp : p ≠ 0), +lemma exists_multiset_roots [decidable_eq R] : ∀ {p : R[X]} (hp : p ≠ 0), ∃ s : multiset R, (s.card : with_bot ℕ) ≤ degree p ∧ ∀ a, s.count a = root_multiplicity a p | p := λ hp, by haveI := classical.prop_decidable (∃ x, is_root p x); exact if h : ∃ x, is_root p x @@ -328,13 +483,24 @@ using_well_founded {dec_tac := tactic.assumption} /-- `roots p` noncomputably gives a multiset containing all the roots of `p`, including their multiplicities. -/ noncomputable def roots (p : R[X]) : multiset R := -if h : p = 0 then ∅ else classical.some (exists_multiset_roots h) +by haveI := classical.dec_eq R; haveI := classical.dec (p = 0); exact + if h : p = 0 then ∅ else classical.some (exists_multiset_roots h) + +lemma roots_def [decidable_eq R] (p : R[X]) [decidable (p = 0)] : + p.roots = if h : p = 0 then ∅ else classical.some (exists_multiset_roots h) := +begin + unfreezingI + { obtain rfl := subsingleton.elim ‹_› (classical.dec_eq R), + obtain rfl := subsingleton.elim ‹_› (classical.dec (p = 0)),}, + refl, +end @[simp] lemma roots_zero : (0 : R[X]).roots = 0 := -dif_pos rfl +by apply dif_pos rfl lemma card_roots (hp0 : p ≠ 0) : ((roots p).card : with_bot ℕ) ≤ degree p := begin + classical, unfold roots, rw dif_neg hp0, exact (classical.some_spec (exists_multiset_roots hp0)).1 @@ -358,41 +524,44 @@ lemma card_roots_sub_C' {p : R[X]} {a : R} (hp0 : 0 < degree p) : with_bot.coe_le_coe.1 (le_trans (card_roots_sub_C hp0) (le_of_eq $ degree_eq_nat_degree (λ h, by simp [*, lt_irrefl] at *))) -@[simp] lemma count_roots (p : R[X]) : p.roots.count a = root_multiplicity a p := +@[simp] lemma count_roots [decidable_eq R] (p : R[X]) : p.roots.count a = root_multiplicity a p := begin + classical, by_cases hp : p = 0, { simp [hp], }, - rw [roots, dif_neg hp], - exact (classical.some_spec (exists_multiset_roots hp)).2 a + rw [roots_def, dif_neg hp], + exact (classical.some_spec (exists_multiset_roots hp)).2 a, end -@[simp] lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a := -by rw [← count_pos, count_roots p, root_multiplicity_pos hp] +@[simp] lemma mem_roots' : a ∈ p.roots ↔ p ≠ 0 ∧ is_root p a := +by classical; rw [← count_pos, count_roots p, root_multiplicity_pos'] + +lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a := mem_roots'.trans $ and_iff_right hp + +lemma ne_zero_of_mem_roots (h : a ∈ p.roots) : p ≠ 0 := (mem_roots'.1 h).1 + +lemma is_root_of_mem_roots (h : a ∈ p.roots) : is_root p a := (mem_roots'.1 h).2 theorem card_le_degree_of_subset_roots {p : R[X]} {Z : finset R} (h : Z.val ⊆ p.roots) : Z.card ≤ p.nat_degree := (multiset.card_le_of_le (finset.val_le_iff_val_subset.2 h)).trans (polynomial.card_roots' p) -lemma eq_zero_of_infinite_is_root - (p : R[X]) (h : set.infinite {x | is_root p x}) : p = 0 := -begin - by_contradiction hp, - apply h, - convert p.roots.to_finset.finite_to_set using 1, - ext1 r, - simp only [mem_roots hp, multiset.mem_to_finset, set.mem_set_of_eq, finset.mem_coe] -end +lemma finite_set_of_is_root {p : R[X]} (hp : p ≠ 0) : set.finite {x | is_root p x} := +by classical; simpa only [← finset.set_of_mem, mem_to_finset, mem_roots hp] + using p.roots.to_finset.finite_to_set + +lemma eq_zero_of_infinite_is_root (p : R[X]) (h : set.infinite {x | is_root p x}) : p = 0 := +not_imp_comm.mp finite_set_of_is_root h lemma exists_max_root [linear_order R] (p : R[X]) (hp : p ≠ 0) : ∃ x₀, ∀ x, p.is_root x → x ≤ x₀ := -set.exists_upper_bound_image _ _ $ not_not.mp (mt (eq_zero_of_infinite_is_root p) hp) +set.exists_upper_bound_image _ _ $ finite_set_of_is_root hp lemma exists_min_root [linear_order R] (p : R[X]) (hp : p ≠ 0) : ∃ x₀, ∀ x, p.is_root x → x₀ ≤ x := -set.exists_lower_bound_image _ _ $ not_not.mp (mt (eq_zero_of_infinite_is_root p) hp) +set.exists_lower_bound_image _ _ $ finite_set_of_is_root hp -lemma eq_of_infinite_eval_eq {R : Type*} [comm_ring R] [is_domain R] - (p q : R[X]) (h : set.infinite {x | eval x p = eval x q}) : p = q := +lemma eq_of_infinite_eval_eq (p q : R[X]) (h : set.infinite {x | eval x p = eval x q}) : p = q := begin rw [← sub_eq_zero], apply eq_zero_of_infinite_is_root, @@ -400,9 +569,9 @@ begin end lemma roots_mul {p q : R[X]} (hpq : p * q ≠ 0) : (p * q).roots = p.roots + q.roots := -multiset.ext.mpr $ λ r, +by classical; exact (multiset.ext.mpr $ λ r, by rw [count_add, count_roots, count_roots, - count_roots, root_multiplicity_mul hpq] + count_roots, root_multiplicity_mul hpq]) lemma roots.le_of_dvd (h : q ≠ 0) : p ∣ q → roots p ≤ roots q := begin @@ -410,34 +579,36 @@ begin exact multiset.le_iff_exists_add.mpr ⟨k.roots, roots_mul h⟩ end -@[simp] lemma mem_roots_sub_C {p : R[X]} {a x : R} (hp0 : 0 < degree p) : +lemma mem_roots_sub_C' {p : R[X]} {a x : R} : + x ∈ (p - C a).roots ↔ p ≠ C a ∧ p.eval x = a := +by rw [mem_roots', is_root.def, sub_ne_zero, eval_sub, sub_eq_zero, eval_C] + +lemma mem_roots_sub_C {p : R[X]} {a x : R} (hp0 : 0 < degree p) : x ∈ (p - C a).roots ↔ p.eval x = a := -(mem_roots (show p - C a ≠ 0, from mt sub_eq_zero.1 $ λ h, - not_le_of_gt hp0 $ h.symm ▸ degree_C_le)).trans - (by rw [is_root.def, eval_sub, eval_C, sub_eq_zero]) +mem_roots_sub_C'.trans $ and_iff_right $ λ hp, hp0.not_le $ hp.symm ▸ degree_C_le @[simp] lemma roots_X_sub_C (r : R) : roots (X - C r) = {r} := begin + classical, ext s, - rw [count_roots, root_multiplicity_X_sub_C], - split_ifs with h, - { rw [h, count_singleton_self] }, - { rw [singleton_eq_cons, count_cons_of_ne h, count_zero] } + rw [count_roots, root_multiplicity_X_sub_C, count_singleton], end +@[simp] lemma roots_X : roots (X : R[X]) = {0} := by rw [← roots_X_sub_C, C_0, sub_zero] + @[simp] lemma roots_C (x : R) : (C x).roots = 0 := -if H : x = 0 then by rw [H, C_0, roots_zero] else multiset.ext.mpr $ λ r, +by classical; exact if H : x = 0 then by rw [H, C_0, roots_zero] else multiset.ext.mpr $ λ r, by rw [count_roots, count_zero, root_multiplicity_eq_zero (not_is_root_C _ _ H)] @[simp] lemma roots_one : (1 : R[X]).roots = ∅ := roots_C 1 -lemma roots_smul_nonzero (p : R[X]) {r : R} (hr : r ≠ 0) : - (r • p).roots = p.roots := -begin - by_cases hp : p = 0; - simp [smul_eq_C_mul, roots_mul, hr, hp] -end +@[simp] lemma roots_C_mul (p : R[X]) (ha : a ≠ 0) : (C a * p).roots = p.roots := +by by_cases hp : p = 0; simp only [roots_mul, *, ne.def, mul_eq_zero, C_eq_zero, or_self, + not_false_iff, roots_C, zero_add, mul_zero] + +@[simp] lemma roots_smul_nonzero (p : R[X]) (ha : a ≠ 0) : (a • p).roots = p.roots := +by rw [smul_eq_C_mul, roots_C_mul _ ha] lemma roots_list_prod (L : list R[X]) : ((0 : R[X]) ∉ L) → L.prod.roots = (L : multiset R[X]).bind roots := @@ -450,7 +621,7 @@ end lemma roots_multiset_prod (m : multiset R[X]) : (0 : R[X]) ∉ m → m.prod.roots = m.bind roots := -by { rcases m with ⟨L⟩, simpa only [coe_prod, quot_mk_to_coe''] using roots_list_prod L } +by { rcases m with ⟨L⟩, simpa only [multiset.coe_prod, quot_mk_to_coe''] using roots_list_prod L } lemma roots_prod {ι : Type*} (f : ι → R[X]) (s : finset ι) : s.prod f ≠ 0 → (s.prod f).roots = s.val.bind (λ i, roots (f i)) := @@ -459,11 +630,46 @@ begin simpa [multiset.prod_eq_zero_iff, bind_map] using roots_multiset_prod (m.map f) end +@[simp] lemma roots_pow (p : R[X]) (n : ℕ) : (p ^ n).roots = n • p.roots := +begin + induction n with n ihn, + { rw [pow_zero, roots_one, zero_smul, empty_eq_zero] }, + { rcases eq_or_ne p 0 with rfl | hp, + { rw [zero_pow n.succ_pos, roots_zero, smul_zero] }, + { rw [pow_succ', roots_mul (mul_ne_zero (pow_ne_zero _ hp) hp), ihn, nat.succ_eq_add_one, + add_smul, one_smul] } } +end + +lemma roots_X_pow (n : ℕ) : (X ^ n : R[X]).roots = n • {0} := by rw [roots_pow, roots_X] + +lemma roots_C_mul_X_pow (ha : a ≠ 0) (n : ℕ) : (C a * X ^ n).roots = n • {0} := +by rw [roots_C_mul _ ha, roots_X_pow] + +@[simp] lemma roots_monomial (ha : a ≠ 0) (n : ℕ) : (monomial n a).roots = n • {0} := +by rw [← C_mul_X_pow_eq_monomial, roots_C_mul_X_pow ha] + lemma roots_prod_X_sub_C (s : finset R) : (s.prod (λ a, X - C a)).roots = s.val := (roots_prod (λ a, X - C a) s (prod_ne_zero_iff.mpr (λ a _, X_sub_C_ne_zero a))).trans (by simp_rw [roots_X_sub_C, multiset.bind_singleton, multiset.map_id']) +@[simp] lemma roots_multiset_prod_X_sub_C (s : multiset R) : + (s.map (λ a, X - C a)).prod.roots = s := +begin + rw [roots_multiset_prod, multiset.bind_map], + { simp_rw [roots_X_sub_C, multiset.bind_singleton, multiset.map_id'] }, + { rw [multiset.mem_map], rintro ⟨a, -, h⟩, exact X_sub_C_ne_zero a h }, +end + +@[simp] lemma nat_degree_multiset_prod_X_sub_C_eq_card (s : multiset R): + (s.map (λ a, X - C a)).prod.nat_degree = s.card := +begin + rw [nat_degree_multiset_prod_of_monic, multiset.map_map], + { simp only [(∘), nat_degree_X_sub_C, multiset.map_const, multiset.sum_replicate, smul_eq_mul, + mul_one] }, + { exact multiset.forall_mem_map_iff.2 (λ a _, monic_X_sub_C a) }, +end + lemma card_roots_X_pow_sub_C {n : ℕ} (hn : 0 < n) (a : R) : (roots ((X : R[X]) ^ n - C a)).card ≤ n := with_bot.coe_le_coe.1 $ @@ -471,47 +677,6 @@ calc ((roots ((X : R[X]) ^ n - C a)).card : with_bot ℕ) ≤ degree ((X : R[X]) ^ n - C a) : card_roots (X_pow_sub_C_ne_zero hn a) ... = n : degree_X_pow_sub_C hn a -lemma le_root_multiplicity_map {K L : Type*} [comm_ring K] - [comm_ring L] {p : K[X]} {f : K →+* L} (hf : function.injective f) (a : K) : - root_multiplicity a p ≤ root_multiplicity (f a) (map f p) := -begin - by_cases hp0 : p = 0, { simp only [hp0, root_multiplicity_zero, polynomial.map_zero], }, - have hmap : map f p ≠ 0, { simpa only [polynomial.map_zero] using (map_injective f hf).ne hp0, }, - rw [root_multiplicity, root_multiplicity, dif_neg hp0, dif_neg hmap], - simp only [not_not, nat.lt_find_iff, nat.le_find_iff], - intros m hm, - have := ring_hom.map_dvd (map_ring_hom f) (hm m le_rfl), - simpa only [coe_map_ring_hom, map_pow, map_sub, map_X, map_C], -end - -lemma count_map_roots {K L : Type*} [comm_ring K] [is_domain K] - [comm_ring L] {p : K[X]} {f : K →+* L} (hf : function.injective f) - (a : L) : - count a (multiset.map f p.roots) ≤ root_multiplicity a (map f p) := -begin - by_cases h : ∃ t, f t = a, - { rcases h with ⟨h_w, rfl⟩, - rw [multiset.count_map_eq_count' f _ hf, count_roots], - exact le_root_multiplicity_map hf h_w }, - { suffices : multiset.count a (multiset.map f p.roots) = 0, - { rw this, exact zero_le _, }, - rw [multiset.count_map, multiset.card_eq_zero, multiset.filter_eq_nil], - rintro k hk rfl, - exact h ⟨k, rfl⟩, }, -end - -lemma roots_map_of_injective_card_eq_total_degree {K L : Type*} [comm_ring K] [is_domain K] - [comm_ring L] [is_domain L] {p : K[X]} {f : K →+* L} (hf : function.injective f) - (hroots : p.roots.card = p.nat_degree) : - multiset.map f p.roots = (map f p).roots := -begin - by_cases hp0 : p = 0, { simp only [hp0, roots_zero, multiset.map_zero, polynomial.map_zero], }, - have hmap : map f p ≠ 0, { simpa only [polynomial.map_zero] using (map_injective f hf).ne hp0, }, - apply multiset.eq_of_le_of_card_le, - { simpa only [multiset.le_iff_count, count_roots] using count_map_roots hf }, - { simpa only [multiset.card_map, hroots] using (card_roots' _).trans (nat_degree_map_le f p) }, -end - section nth_roots /-- `nth_roots n a` noncomputably returns the solutions to `x ^ n = a`-/ @@ -528,18 +693,24 @@ by simp only [empty_eq_zero, pow_zero, nth_roots, ← C_1, ← C_sub, roots_C] lemma card_nth_roots (n : ℕ) (a : R) : (nth_roots n a).card ≤ n := -if hn : n = 0 -then if h : (X : R[X]) ^ n - C a = 0 - then by simp only [nat.zero_le, nth_roots, roots, h, dif_pos rfl, empty_eq_zero, card_zero] +by classical; exactI +if hn : n = 0 then + if h : (X : R[X]) ^ n - C a = 0 then + by simp only [nat.zero_le, nth_roots, roots, h, dif_pos rfl, empty_eq_zero, multiset.card_zero] else with_bot.coe_le_coe.1 (le_trans (card_roots h) (by { rw [hn, pow_zero, ← C_1, ← ring_hom.map_sub ], exact degree_C_le })) else by rw [← with_bot.coe_le_coe, ← degree_X_pow_sub_C (nat.pos_of_ne_zero hn) a]; exact card_roots (X_pow_sub_C_ne_zero (nat.pos_of_ne_zero hn) a) +@[simp] +lemma nth_roots_two_eq_zero_iff {r : R} : nth_roots 2 r = 0 ↔ ¬ is_square r := +by simp_rw [is_square_iff_exists_sq, eq_zero_iff_forall_not_mem, + mem_nth_roots (by norm_num : 0 < 2), ← not_exists, eq_comm] + /-- The multiset `nth_roots ↑n (1 : R)` as a finset. -/ def nth_roots_finset (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : finset R := -multiset.to_finset (nth_roots n (1 : R)) +by haveI := classical.dec_eq R; exact multiset.to_finset (nth_roots n (1 : R)) @[simp] lemma mem_nth_roots_finset {n : ℕ} (h : 0 < n) {x : R} : x ∈ nth_roots_finset n R ↔ x ^ (n : ℕ) = 1 := @@ -605,19 +776,19 @@ variables [comm_ring T] If you have a non-separable polynomial, use `polynomial.roots` for the multiset where multiple roots have the appropriate multiplicity. -/ def root_set (p : T[X]) (S) [comm_ring S] [is_domain S] [algebra T S] : set S := -(p.map (algebra_map T S)).roots.to_finset +by haveI := classical.dec_eq S; exact (p.map (algebra_map T S)).roots.to_finset -lemma root_set_def (p : T[X]) (S) [comm_ring S] [is_domain S] [algebra T S] : +lemma root_set_def (p : T[X]) (S) [comm_ring S] [is_domain S] [algebra T S] [decidable_eq S] : p.root_set S = (p.map (algebra_map T S)).roots.to_finset := -rfl - -@[simp] lemma root_set_zero (S) [comm_ring S] [is_domain S] [algebra T S] : - (0 : T[X]).root_set S = ∅ := -by rw [root_set_def, polynomial.map_zero, roots_zero, to_finset_zero, finset.coe_empty] +by convert rfl @[simp] lemma root_set_C [comm_ring S] [is_domain S] [algebra T S] (a : T) : (C a).root_set S = ∅ := -by rw [root_set_def, map_C, roots_C, multiset.to_finset_zero, finset.coe_empty] +by classical; rw [root_set_def, map_C, roots_C, multiset.to_finset_zero, finset.coe_empty] + +@[simp] lemma root_set_zero (S) [comm_ring S] [is_domain S] [algebra T S] : + (0 : T[X]).root_set S = ∅ := +by rw [← C_0, root_set_C] instance root_set_fintype (p : T[X]) (S : Type*) [comm_ring S] [is_domain S] [algebra T S] : fintype (p.root_set S) := @@ -625,31 +796,68 @@ finset_coe.fintype _ lemma root_set_finite (p : T[X]) (S : Type*) [comm_ring S] [is_domain S] [algebra T S] : (p.root_set S).finite := -⟨polynomial.root_set_fintype p S⟩ +set.to_finite _ + +/-- The set of roots of all polynomials of bounded degree and having coefficients in a finite set +is finite. -/ +lemma bUnion_roots_finite {R S : Type*} [semiring R] [comm_ring S] [is_domain S] [decidable_eq S] + (m : R →+* S) (d : ℕ) {U : set R} (h : U.finite) : + (⋃ (f : R[X]) (hf : f.nat_degree ≤ d ∧ ∀ i, (f.coeff i) ∈ U), + ((f.map m).roots.to_finset : set S)).finite := +set.finite.bUnion begin + -- We prove that the set of polynomials under consideration is finite because its + -- image by the injective map `π` is finite + let π : R[X] → fin (d+1) → R := λ f i, f.coeff i, + refine ((set.finite.pi $ λ e, h).subset $ _).of_finite_image (_ : set.inj_on π _), + { exact set.image_subset_iff.2 (λ f hf i _, hf.2 i) }, + { refine λ x hx y hy hxy, (ext_iff_nat_degree_le hx.1 hy.1).2 (λ i hi, _), + exact id congr_fun hxy ⟨i, nat.lt_succ_of_le hi⟩ }, +end $ λ i hi, finset.finite_to_set _ + +theorem mem_root_set' {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] [algebra T S] {a : S} : + a ∈ p.root_set S ↔ p.map (algebra_map T S) ≠ 0 ∧ aeval a p = 0 := +by rw [root_set, finset.mem_coe, mem_to_finset, mem_roots', is_root.def, ← eval₂_eq_eval_map, + aeval_def] + +theorem mem_root_set {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] [algebra T S] + [no_zero_smul_divisors T S] {a : S} : a ∈ p.root_set S ↔ p ≠ 0 ∧ aeval a p = 0 := +by rw [mem_root_set', (map_injective _ + (no_zero_smul_divisors.algebra_map_injective T S)).ne_iff' (polynomial.map_zero _)] + +theorem mem_root_set_of_ne {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] [algebra T S] + [no_zero_smul_divisors T S] (hp : p ≠ 0) {a : S} : a ∈ p.root_set S ↔ aeval a p = 0 := +mem_root_set.trans $ and_iff_right hp + +lemma root_set_maps_to' {p : T[X]} {S S'} [comm_ring S] [is_domain S] [algebra T S] + [comm_ring S'] [is_domain S'] [algebra T S'] + (hp : p.map (algebra_map T S') = 0 → p.map (algebra_map T S) = 0) + (f : S →ₐ[T] S') : (p.root_set S).maps_to f (p.root_set S') := +λ x hx, begin + rw [mem_root_set'] at hx ⊢, + rw [aeval_alg_hom, alg_hom.comp_apply, hx.2, _root_.map_zero], + exact ⟨mt hp hx.1, rfl⟩ +end -theorem mem_root_set_iff' {p : T[X]} {S : Type*} [comm_ring S] [is_domain S] - [algebra T S] (hp : p.map (algebra_map T S) ≠ 0) (a : S) : - a ∈ p.root_set S ↔ (p.map (algebra_map T S)).eval a = 0 := -by { change a ∈ multiset.to_finset _ ↔ _, rw [mem_to_finset, mem_roots hp], refl } +lemma ne_zero_of_mem_root_set {p : T[X]} [comm_ring S] [is_domain S] [algebra T S] {a : S} + (h : a ∈ p.root_set S) : p ≠ 0 := +λ hf, by rwa [hf, root_set_zero] at h -theorem mem_root_set_iff {p : T[X]} (hp : p ≠ 0) {S : Type*} [comm_ring S] [is_domain S] - [algebra T S] [no_zero_smul_divisors T S] (a : S) : a ∈ p.root_set S ↔ aeval a p = 0 := +lemma aeval_eq_zero_of_mem_root_set {p : T[X]} [comm_ring S] [is_domain S] [algebra T S] + {a : S} (hx : a ∈ p.root_set S) : aeval a p = 0 := +(mem_root_set'.1 hx).2 + +lemma root_set_maps_to {p : T[X]} {S S'} [comm_ring S] [is_domain S] [algebra T S] + [comm_ring S'] [is_domain S'] [algebra T S'] [no_zero_smul_divisors T S'] (f : S →ₐ[T] S') : + (p.root_set S).maps_to f (p.root_set S') := begin - rw [mem_root_set_iff', ←eval₂_eq_eval_map], - { refl }, - intro h, - rw ←polynomial.map_zero (algebra_map T S) at h, - exact hp (map_injective _ (no_zero_smul_divisors.algebra_map_injective T S) h) + refine root_set_maps_to' (λ h₀, _) f, + obtain rfl : p = 0 := map_injective _ + (no_zero_smul_divisors.algebra_map_injective T S') (by rwa [polynomial.map_zero]), + exact polynomial.map_zero _ end end roots -theorem is_unit_iff {f : R[X]} : is_unit f ↔ ∃ r : R, is_unit r ∧ C r = f := -⟨λ hf, ⟨f.coeff 0, - is_unit_C.1 $ eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf) ▸ hf, - (eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf)).symm⟩, -λ ⟨r, hr, hrf⟩, hrf ▸ is_unit_C.2 hr⟩ - lemma coeff_coe_units_zero_ne_zero (u : R[X]ˣ) : coeff (u : R[X]) 0 ≠ 0 := begin @@ -696,43 +904,191 @@ begin rwa [degree_X_sub_C, nat.with_bot.one_le_iff_zero_lt] end -lemma eq_of_monic_of_dvd_of_nat_degree_le (hp : p.monic) (hq : q.monic) (hdiv : p ∣ q) - (hdeg : q.nat_degree ≤ p.nat_degree) : q = p := +lemma eq_leading_coeff_mul_of_monic_of_dvd_of_nat_degree_le {R} [comm_ring R] + {p q : R[X]} (hp : p.monic) (hdiv : p ∣ q) + (hdeg : q.nat_degree ≤ p.nat_degree) : q = C q.leading_coeff * p := begin obtain ⟨r, hr⟩ := hdiv, - have rzero : r ≠ 0, - { intro h, - simpa [h, monic.ne_zero hq] using hr }, - rw [hr, nat_degree_mul (monic.ne_zero hp) rzero] at hdeg, - have hdegeq : p.nat_degree + r.nat_degree = p.nat_degree, - { suffices hdegle : p.nat_degree ≤ p.nat_degree + r.nat_degree, - { exact le_antisymm hdeg hdegle }, - exact nat.le.intro rfl }, - replace hdegeq := eq_C_of_nat_degree_eq_zero (((@add_right_inj _ _ p.nat_degree) _ 0).1 hdegeq), - suffices hlead : 1 = r.leading_coeff, - { have hcoeff := leading_coeff_C (r.coeff 0), - rw [← hdegeq, ← hlead] at hcoeff, - rw [← hcoeff, C_1] at hdegeq, - rwa [hdegeq, mul_one] at hr }, - have hprod : q.leading_coeff = p.leading_coeff * r.leading_coeff, - { simp only [hr, leading_coeff_mul] }, - rwa [monic.leading_coeff hp, monic.leading_coeff hq, one_mul] at hprod + obtain (rfl|hq) := eq_or_ne q 0, {simp}, + have rzero : r ≠ 0 := λ h, by simpa [h, hq] using hr, + rw [hr, nat_degree_mul'] at hdeg, swap, + { rw [hp.leading_coeff, one_mul, leading_coeff_ne_zero], exact rzero }, + rw [mul_comm, @eq_C_of_nat_degree_eq_zero _ _ r] at hr, + { convert hr, convert leading_coeff_C _ using 1, rw [hr, leading_coeff_mul_monic hp] }, + { exact (add_right_inj _).1 (le_antisymm hdeg $ nat.le.intro rfl) }, +end + +lemma eq_of_monic_of_dvd_of_nat_degree_le {R} [comm_ring R] + {p q : R[X]} (hp : p.monic) (hq : q.monic) (hdiv : p ∣ q) + (hdeg : q.nat_degree ≤ p.nat_degree) : q = p := +begin + convert eq_leading_coeff_mul_of_monic_of_dvd_of_nat_degree_le hp hdiv hdeg, + rw [hq.leading_coeff, C_1, one_mul], end +lemma is_coprime_X_sub_C_of_is_unit_sub {R} [comm_ring R] {a b : R} + (h : is_unit (a - b)) : is_coprime (X - C a) (X - C b) := +⟨-C h.unit⁻¹.val, C h.unit⁻¹.val, by { rw [neg_mul_comm, ← left_distrib, neg_add_eq_sub, + sub_sub_sub_cancel_left, ← C_sub, ← C_mul], convert C_1, exact h.coe_inv_mul }⟩ + +theorem pairwise_coprime_X_sub_C {K} [field K] {I : Type v} {s : I → K} + (H : function.injective s) : pairwise (is_coprime on (λ i : I, X - C (s i))) := +λ i j hij, is_coprime_X_sub_C_of_is_unit_sub (sub_ne_zero_of_ne $ H.ne hij).is_unit + +lemma monic_prod_multiset_X_sub_C : monic (p.roots.map (λ a, X - C a)).prod := +monic_multiset_prod_of_monic _ _ (λ a _, monic_X_sub_C a) + +lemma prod_multiset_root_eq_finset_root [decidable_eq R] : + (p.roots.map (λ a, X - C a)).prod = + p.roots.to_finset.prod (λ a, (X - C a) ^ root_multiplicity a p) := +by simp only [count_roots, finset.prod_multiset_map_count] + +/-- The product `∏ (X - a)` for `a` inside the multiset `p.roots` divides `p`. -/ +lemma prod_multiset_X_sub_C_dvd (p : R[X]) : (p.roots.map (λ a, X - C a)).prod ∣ p := +begin + classical, + rw ← map_dvd_map _ (is_fraction_ring.injective R $ fraction_ring R) monic_prod_multiset_X_sub_C, + rw [prod_multiset_root_eq_finset_root, polynomial.map_prod], + refine finset.prod_dvd_of_coprime (λ a _ b _ h, _) (λ a _, _), + { simp_rw [polynomial.map_pow, polynomial.map_sub, map_C, map_X], + exact (pairwise_coprime_X_sub_C (is_fraction_ring.injective R $ fraction_ring R) h).pow }, + { exact polynomial.map_dvd _ (pow_root_multiplicity_dvd p a) }, +end + +/-- A Galois connection. -/ +lemma _root_.multiset.prod_X_sub_C_dvd_iff_le_roots {p : R[X]} (hp : p ≠ 0) (s : multiset R) : + (s.map (λ a, X - C a)).prod ∣ p ↔ s ≤ p.roots := +by classical; exact +⟨λ h, multiset.le_iff_count.2 $ λ r, begin + rw [count_roots, le_root_multiplicity_iff hp, ← multiset.prod_replicate, + ← multiset.map_replicate (λ a, X - C a), ← multiset.filter_eq], + exact (multiset.prod_dvd_prod_of_le $ multiset.map_le_map $ s.filter_le _).trans h, +end, λ h, (multiset.prod_dvd_prod_of_le $ multiset.map_le_map h).trans p.prod_multiset_X_sub_C_dvd⟩ + +lemma exists_prod_multiset_X_sub_C_mul (p : R[X]) : ∃ q, + (p.roots.map (λ a, X - C a)).prod * q = p ∧ + p.roots.card + q.nat_degree = p.nat_degree ∧ + q.roots = 0 := +begin + obtain ⟨q, he⟩ := p.prod_multiset_X_sub_C_dvd, + use [q, he.symm], + obtain (rfl|hq) := eq_or_ne q 0, + { rw mul_zero at he, subst he, simp }, + split, + { conv_rhs { rw he }, + rw [monic_prod_multiset_X_sub_C.nat_degree_mul' hq, nat_degree_multiset_prod_X_sub_C_eq_card] }, + { replace he := congr_arg roots he.symm, + rw [roots_mul, roots_multiset_prod_X_sub_C] at he, + exacts [add_right_eq_self.1 he, mul_ne_zero monic_prod_multiset_X_sub_C.ne_zero hq] }, +end + +/-- A polynomial `p` that has as many roots as its degree +can be written `p = p.leading_coeff * ∏(X - a)`, for `a` in `p.roots`. -/ +lemma C_leading_coeff_mul_prod_multiset_X_sub_C (hroots : p.roots.card = p.nat_degree) : + C p.leading_coeff * (p.roots.map (λ a, X - C a)).prod = p := +(eq_leading_coeff_mul_of_monic_of_dvd_of_nat_degree_le monic_prod_multiset_X_sub_C + p.prod_multiset_X_sub_C_dvd ((nat_degree_multiset_prod_X_sub_C_eq_card _).trans hroots).ge).symm + +/-- A monic polynomial `p` that has as many roots as its degree +can be written `p = ∏(X - a)`, for `a` in `p.roots`. -/ +lemma prod_multiset_X_sub_C_of_monic_of_roots_card_eq + (hp : p.monic) (hroots : p.roots.card = p.nat_degree) : + (p.roots.map (λ a, X - C a)).prod = p := +by { convert C_leading_coeff_mul_prod_multiset_X_sub_C hroots, rw [hp.leading_coeff, C_1, one_mul] } + end comm_ring +section +variables {A B : Type*} [comm_ring A] [comm_ring B] + +lemma le_root_multiplicity_map {p : A[X]} {f : A →+* B} (hmap : map f p ≠ 0) (a : A) : + root_multiplicity a p ≤ root_multiplicity (f a) (p.map f) := +begin + rw [le_root_multiplicity_iff hmap], + refine trans _ ((map_ring_hom f).map_dvd (pow_root_multiplicity_dvd p a)), + rw [map_pow, map_sub, coe_map_ring_hom, map_X, map_C], +end + +lemma eq_root_multiplicity_map {p : A[X]} {f : A →+* B} (hf : function.injective f) + (a : A) : root_multiplicity a p = root_multiplicity (f a) (p.map f) := +begin + by_cases hp0 : p = 0, { simp only [hp0, root_multiplicity_zero, polynomial.map_zero], }, + apply le_antisymm (le_root_multiplicity_map ((polynomial.map_ne_zero_iff hf).mpr hp0) a), + rw [le_root_multiplicity_iff hp0, ← map_dvd_map f hf ((monic_X_sub_C a).pow _), + polynomial.map_pow, polynomial.map_sub, map_X, map_C], + apply pow_root_multiplicity_dvd, +end + +lemma count_map_roots [is_domain A] [decidable_eq B] {p : A[X]} {f : A →+* B} (hmap : map f p ≠ 0) + (b : B) : + (p.roots.map f).count b ≤ root_multiplicity b (p.map f) := +begin + rw [le_root_multiplicity_iff hmap, ← multiset.prod_replicate, + ← multiset.map_replicate (λ a, X - C a)], + rw ← multiset.filter_eq, + refine (multiset.prod_dvd_prod_of_le $ multiset.map_le_map $ multiset.filter_le _ _).trans _, + convert polynomial.map_dvd _ p.prod_multiset_X_sub_C_dvd, + simp only [polynomial.map_multiset_prod, multiset.map_map], + congr, ext1, + simp only [function.comp_app, polynomial.map_sub, map_X, map_C], +end + +lemma count_map_roots_of_injective [is_domain A] [decidable_eq B] (p : A[X]) {f : A →+* B} + (hf : function.injective f) (b : B) : + (p.roots.map f).count b ≤ root_multiplicity b (p.map f) := +begin + by_cases hp0 : p = 0, + { simp only [hp0, roots_zero, multiset.map_zero, + multiset.count_zero, polynomial.map_zero, root_multiplicity_zero] }, + { exact count_map_roots ((polynomial.map_ne_zero_iff hf).mpr hp0) b }, +end + +lemma map_roots_le [is_domain A] [is_domain B] {p : A[X]} {f : A →+* B} (h : p.map f ≠ 0) : + p.roots.map f ≤ (p.map f).roots := +by classical; exact + (multiset.le_iff_count.2 $ λ b, by { rw count_roots, apply count_map_roots h }) + +lemma map_roots_le_of_injective [is_domain A] [is_domain B] (p : A[X]) + {f : A →+* B} (hf : function.injective f) : + p.roots.map f ≤ (p.map f).roots := +begin + by_cases hp0 : p = 0, { simp only [hp0, roots_zero, multiset.map_zero, polynomial.map_zero], }, + exact map_roots_le ((polynomial.map_ne_zero_iff hf).mpr hp0), +end + +lemma card_roots_le_map [is_domain A] [is_domain B] {p : A[X]} {f : A →+* B} (h : p.map f ≠ 0) : + p.roots.card ≤ (p.map f).roots.card := +by { rw ← p.roots.card_map f, exact multiset.card_le_of_le (map_roots_le h) } + +lemma card_roots_le_map_of_injective [is_domain A] [is_domain B] {p : A[X]} {f : A →+* B} + (hf : function.injective f) : p.roots.card ≤ (p.map f).roots.card := +begin + by_cases hp0 : p = 0, { simp only [hp0, roots_zero, polynomial.map_zero, multiset.card_zero], }, + exact card_roots_le_map ((polynomial.map_ne_zero_iff hf).mpr hp0), +end + +lemma roots_map_of_injective_of_card_eq_nat_degree [is_domain A] [is_domain B] {p : A[X]} + {f : A →+* B} (hf : function.injective f) (hroots : p.roots.card = p.nat_degree) : + p.roots.map f = (p.map f).roots := +begin + apply multiset.eq_of_le_of_card_le (map_roots_le_of_injective p hf), + simpa only [multiset.card_map, hroots] using (card_roots' _).trans (nat_degree_map_le f p), +end + +end + section variables [semiring R] [comm_ring S] [is_domain S] (φ : R →+* S) lemma is_unit_of_is_unit_leading_coeff_of_is_unit_map - (f : R[X]) (hf : is_unit (leading_coeff f)) (H : is_unit (map φ f)) : + {f : R[X]} (hf : is_unit f.leading_coeff) (H : is_unit (map φ f)) : is_unit f := begin have dz := degree_eq_zero_of_is_unit H, rw degree_map_eq_of_leading_coeff_ne_zero at dz, { rw eq_C_of_degree_eq_zero dz, - refine is_unit.map (C : R →+* R[X]) _, + refine is_unit.map C _, convert hf, rw (degree_eq_iff_nat_degree_eq _).1 dz, rintro rfl, @@ -758,27 +1114,14 @@ lemma monic.irreducible_of_irreducible_map (f : R[X]) (h_mon : monic f) (h_irr : irreducible (map φ f)) : irreducible f := begin - fsplit, - { intro h, - exact h_irr.not_unit (is_unit.map (map_ring_hom φ) h), }, - { intros a b h, - - have q := (leading_coeff_mul a b).symm, - rw ←h at q, - dsimp [monic] at h_mon, - rw h_mon at q, - have au : is_unit a.leading_coeff := is_unit_of_mul_eq_one _ _ q, - rw mul_comm at q, - have bu : is_unit b.leading_coeff := is_unit_of_mul_eq_one _ _ q, - clear q h_mon, - - have h' := congr_arg (map φ) h, - simp only [polynomial.map_mul] at h', - cases h_irr.is_unit_or_is_unit h' with w w, - { left, - exact is_unit_of_is_unit_leading_coeff_of_is_unit_map _ _ au w, }, - { right, - exact is_unit_of_is_unit_leading_coeff_of_is_unit_map _ _ bu w, }, } + refine ⟨h_irr.not_unit ∘ is_unit.map (map_ring_hom φ), λ a b h, _⟩, + dsimp [monic] at h_mon, + have q := (leading_coeff_mul a b).symm, + rw [←h, h_mon] at q, + refine (h_irr.is_unit_or_is_unit $ (congr_arg (map φ) h).trans (polynomial.map_mul φ)).imp _ _; + apply is_unit_of_is_unit_leading_coeff_of_is_unit_map; + apply is_unit_of_mul_eq_one, + { exact q }, { rw mul_comm, exact q }, end end diff --git a/src/data/polynomial/splits.lean b/src/data/polynomial/splits.lean new file mode 100644 index 0000000000000..e833cce8ec92d --- /dev/null +++ b/src/data/polynomial/splits.lean @@ -0,0 +1,425 @@ +/- +Copyright (c) 2018 Chris Hughes. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Chris Hughes +-/ +import data.list.prime +import data.polynomial.field_division +import data.polynomial.lifts + +/-! +# Split polynomials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +A polynomial `f : K[X]` splits over a field extension `L` of `K` if it is zero or all of its +irreducible factors over `L` have degree `1`. + +## Main definitions + +* `polynomial.splits i f`: A predicate on a homomorphism `i : K →+* L` from a commutative ring to a + field and a polynomial `f` saying that `f.map i` is zero or all of its irreducible factors over + `L` have degree `1`. + +## Main statements + +* `lift_of_splits`: If `K` and `L` are field extensions of a field `F` and for some finite subset + `S` of `K`, the minimal polynomial of every `x ∈ K` splits as a polynomial with coefficients in + `L`, then `algebra.adjoin F S` embeds into `L`. + +-/ + +noncomputable theory +open_locale classical big_operators polynomial + +universes u v w + +variables {F : Type u} {K : Type v} {L : Type w} + +namespace polynomial + +open polynomial + +section splits + +section comm_ring +variables [comm_ring K] [field L] [field F] +variables (i : K →+* L) + +/-- A polynomial `splits` iff it is zero or all of its irreducible factors have `degree` 1. -/ +def splits (f : K[X]) : Prop := +f.map i = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1 + +@[simp] lemma splits_zero : splits i (0 : K[X]) := or.inl (polynomial.map_zero i) + +lemma splits_of_map_eq_C {f : K[X]} {a : L} (h : f.map i = C a) : splits i f := +if ha : a = 0 then or.inl (h.trans (ha.symm ▸ C_0)) +else or.inr $ λ g hg ⟨p, hp⟩, absurd hg.1 $ not_not.2 $ is_unit_iff_degree_eq_zero.2 $ +begin + have := congr_arg degree hp, + rw [h, degree_C ha, degree_mul, @eq_comm (with_bot ℕ) 0, nat.with_bot.add_eq_zero_iff] at this, + exact this.1, +end + +@[simp] lemma splits_C (a : K) : splits i (C a) := splits_of_map_eq_C i (map_C i) + +lemma splits_of_map_degree_eq_one {f : K[X]} (hf : degree (f.map i) = 1) : splits i f := +or.inr $ λ g hg ⟨p, hp⟩, + by have := congr_arg degree hp; + simp [nat.with_bot.add_eq_one_iff, hf, @eq_comm (with_bot ℕ) 1, + mt is_unit_iff_degree_eq_zero.2 hg.1] at this; + clear _fun_match; tauto + +lemma splits_of_degree_le_one {f : K[X]} (hf : degree f ≤ 1) : splits i f := +if hif : degree (f.map i) ≤ 0 then splits_of_map_eq_C i (degree_le_zero_iff.mp hif) +else begin + push_neg at hif, + rw [← order.succ_le_iff, ← with_bot.coe_zero, with_bot.succ_coe, nat.succ_eq_succ] at hif, + exact splits_of_map_degree_eq_one i (le_antisymm ((degree_map_le i _).trans hf) hif), +end + +lemma splits_of_degree_eq_one {f : K[X]} (hf : degree f = 1) : splits i f := +splits_of_degree_le_one i hf.le + +lemma splits_of_nat_degree_le_one {f : K[X]} (hf : nat_degree f ≤ 1) : splits i f := +splits_of_degree_le_one i (degree_le_of_nat_degree_le hf) + +lemma splits_of_nat_degree_eq_one {f : K[X]} (hf : nat_degree f = 1) : splits i f := +splits_of_nat_degree_le_one i (le_of_eq hf) + +lemma splits_mul {f g : K[X]} (hf : splits i f) (hg : splits i g) : splits i (f * g) := +if h : (f * g).map i = 0 then or.inl h +else or.inr $ λ p hp hpf, ((principal_ideal_ring.irreducible_iff_prime.1 hp).2.2 _ _ + (show p ∣ map i f * map i g, by convert hpf; rw polynomial.map_mul)).elim + (hf.resolve_left (λ hf, by simpa [hf] using h) hp) + (hg.resolve_left (λ hg, by simpa [hg] using h) hp) + +lemma splits_of_splits_mul' {f g : K[X]} (hfg : (f * g).map i ≠ 0) (h : splits i (f * g)) : + splits i f ∧ splits i g := +⟨or.inr $ λ g hgi hg, or.resolve_left h hfg hgi + (by rw polynomial.map_mul; exact hg.trans (dvd_mul_right _ _)), + or.inr $ λ g hgi hg, or.resolve_left h hfg hgi + (by rw polynomial.map_mul; exact hg.trans (dvd_mul_left _ _))⟩ + +lemma splits_map_iff (j : L →+* F) {f : K[X]} : + splits j (f.map i) ↔ splits (j.comp i) f := +by simp [splits, polynomial.map_map] + +theorem splits_one : splits i 1 := +splits_C i 1 + +theorem splits_of_is_unit [is_domain K] {u : K[X]} (hu : is_unit u) : u.splits i := +(is_unit_iff.mp hu).some_spec.2 ▸ splits_C _ _ + +theorem splits_X_sub_C {x : K} : (X - C x).splits i := +splits_of_degree_le_one _ $ degree_X_sub_C_le _ + +theorem splits_X : X.splits i := +splits_of_degree_le_one _ degree_X_le + +theorem splits_prod {ι : Type u} {s : ι → K[X]} {t : finset ι} : + (∀ j ∈ t, (s j).splits i) → (∏ x in t, s x).splits i := +begin + refine finset.induction_on t (λ _, splits_one i) (λ a t hat ih ht, _), + rw finset.forall_mem_insert at ht, rw finset.prod_insert hat, + exact splits_mul i ht.1 (ih ht.2) +end + +lemma splits_pow {f : K[X]} (hf : f.splits i) (n : ℕ) : (f ^ n).splits i := +begin + rw [←finset.card_range n, ←finset.prod_const], + exact splits_prod i (λ j hj, hf), +end + +lemma splits_X_pow (n : ℕ) : (X ^ n).splits i := splits_pow i (splits_X i) n + +theorem splits_id_iff_splits {f : K[X]} : + (f.map i).splits (ring_hom.id L) ↔ f.splits i := +by rw [splits_map_iff, ring_hom.id_comp] + +lemma exists_root_of_splits' {f : K[X]} (hs : splits i f) (hf0 : degree (f.map i) ≠ 0) : + ∃ x, eval₂ i x f = 0 := +if hf0' : f.map i = 0 then by simp [eval₂_eq_eval_map, hf0'] +else + let ⟨g, hg⟩ := wf_dvd_monoid.exists_irreducible_factor + (show ¬ is_unit (f.map i), from mt is_unit_iff_degree_eq_zero.1 hf0) hf0' in + let ⟨x, hx⟩ := exists_root_of_degree_eq_one (hs.resolve_left hf0' hg.1 hg.2) in + let ⟨i, hi⟩ := hg.2 in + ⟨x, by rw [← eval_map, hi, eval_mul, show _ = _, from hx, zero_mul]⟩ + +lemma roots_ne_zero_of_splits' {f : K[X]} (hs : splits i f) (hf0 : nat_degree (f.map i) ≠ 0) : + (f.map i).roots ≠ 0 := +let ⟨x, hx⟩ := exists_root_of_splits' i hs (λ h, hf0 $ nat_degree_eq_of_degree_eq_some h) in +λ h, by { rw ← eval_map at hx, + cases h.subst ((mem_roots _).2 hx), exact ne_zero_of_nat_degree_gt (nat.pos_of_ne_zero hf0) } + +/-- Pick a root of a polynomial that splits. See `root_of_splits` for polynomials over a field +which has simpler assumptions. -/ +def root_of_splits' {f : K[X]} (hf : f.splits i) (hfd : (f.map i).degree ≠ 0) : L := +classical.some $ exists_root_of_splits' i hf hfd + +theorem map_root_of_splits' {f : K[X]} (hf : f.splits i) (hfd) : + f.eval₂ i (root_of_splits' i hf hfd) = 0 := +classical.some_spec $ exists_root_of_splits' i hf hfd + +lemma nat_degree_eq_card_roots' {p : K[X]} {i : K →+* L} + (hsplit : splits i p) : (p.map i).nat_degree = (p.map i).roots.card := +begin + by_cases hp : p.map i = 0, + { rw [hp, nat_degree_zero, roots_zero, multiset.card_zero] }, + obtain ⟨q, he, hd, hr⟩ := exists_prod_multiset_X_sub_C_mul (p.map i), + rw [← splits_id_iff_splits, ← he] at hsplit, + rw ← he at hp, + have hq : q ≠ 0 := λ h, hp (by rw [h, mul_zero]), + rw [← hd, add_right_eq_self], + by_contra, + have h' : (map (ring_hom.id L) q).nat_degree ≠ 0, { simp [h], }, + have := roots_ne_zero_of_splits' (ring_hom.id L) (splits_of_splits_mul' _ _ hsplit).2 h', + { rw map_id at this, exact this hr }, + { rw [map_id], exact mul_ne_zero monic_prod_multiset_X_sub_C.ne_zero hq }, +end + +lemma degree_eq_card_roots' {p : K[X]} {i : K →+* L} (p_ne_zero : p.map i ≠ 0) + (hsplit : splits i p) : (p.map i).degree = (p.map i).roots.card := +by rw [degree_eq_nat_degree p_ne_zero, nat_degree_eq_card_roots' hsplit] + +end comm_ring + +variables [field K] [field L] [field F] +variables (i : K →+* L) + +/-- This lemma is for polynomials over a field. -/ +lemma splits_iff (f : K[X]) : + splits i f ↔ f = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1 := +by rw [splits, map_eq_zero] + +/-- This lemma is for polynomials over a field. -/ +lemma splits.def {i : K →+* L} {f : K[X]} (h : splits i f) : + f = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1 := +(splits_iff i f).mp h + +lemma splits_of_splits_mul {f g : K[X]} (hfg : f * g ≠ 0) (h : splits i (f * g)) : + splits i f ∧ splits i g := +splits_of_splits_mul' i (map_ne_zero hfg) h + +lemma splits_of_splits_of_dvd {f g : K[X]} (hf0 : f ≠ 0) (hf : splits i f) (hgf : g ∣ f) : + splits i g := +by { obtain ⟨f, rfl⟩ := hgf, exact (splits_of_splits_mul i hf0 hf).1 } + +lemma splits_of_splits_gcd_left {f g : K[X]} (hf0 : f ≠ 0) (hf : splits i f) : + splits i (euclidean_domain.gcd f g) := +polynomial.splits_of_splits_of_dvd i hf0 hf (euclidean_domain.gcd_dvd_left f g) + +lemma splits_of_splits_gcd_right {f g : K[X]} (hg0 : g ≠ 0) (hg : splits i g) : + splits i (euclidean_domain.gcd f g) := +polynomial.splits_of_splits_of_dvd i hg0 hg (euclidean_domain.gcd_dvd_right f g) + +theorem splits_mul_iff {f g : K[X]} (hf : f ≠ 0) (hg : g ≠ 0) : + (f * g).splits i ↔ f.splits i ∧ g.splits i := +⟨splits_of_splits_mul i (mul_ne_zero hf hg), λ ⟨hfs, hgs⟩, splits_mul i hfs hgs⟩ + +theorem splits_prod_iff {ι : Type u} {s : ι → K[X]} {t : finset ι} : + (∀ j ∈ t, s j ≠ 0) → ((∏ x in t, s x).splits i ↔ ∀ j ∈ t, (s j).splits i) := +begin + refine finset.induction_on t (λ _, ⟨λ _ _ h, h.elim, λ _, splits_one i⟩) (λ a t hat ih ht, _), + rw finset.forall_mem_insert at ht ⊢, + rw [finset.prod_insert hat, splits_mul_iff i ht.1 (finset.prod_ne_zero_iff.2 ht.2), ih ht.2] +end + +lemma degree_eq_one_of_irreducible_of_splits {p : K[X]} + (hp : irreducible p) (hp_splits : splits (ring_hom.id K) p) : + p.degree = 1 := +begin + rcases hp_splits, + { exfalso, simp * at *, }, + { apply hp_splits hp, simp } +end + +lemma exists_root_of_splits {f : K[X]} (hs : splits i f) (hf0 : degree f ≠ 0) : + ∃ x, eval₂ i x f = 0 := +exists_root_of_splits' i hs ((f.degree_map i).symm ▸ hf0) + +lemma roots_ne_zero_of_splits {f : K[X]} (hs : splits i f) (hf0 : nat_degree f ≠ 0) : + (f.map i).roots ≠ 0 := +roots_ne_zero_of_splits' i hs (ne_of_eq_of_ne (nat_degree_map i) hf0) + +/-- Pick a root of a polynomial that splits. This version is for polynomials over a field and has +simpler assumptions. -/ +def root_of_splits {f : K[X]} (hf : f.splits i) (hfd : f.degree ≠ 0) : L := +root_of_splits' i hf ((f.degree_map i).symm ▸ hfd) + +/-- `root_of_splits'` is definitionally equal to `root_of_splits`. -/ +lemma root_of_splits'_eq_root_of_splits {f : K[X]} (hf : f.splits i) (hfd) : + root_of_splits' i hf hfd = root_of_splits i hf (f.degree_map i ▸ hfd) := rfl + +theorem map_root_of_splits {f : K[X]} (hf : f.splits i) (hfd) : + f.eval₂ i (root_of_splits i hf hfd) = 0 := +map_root_of_splits' i hf (ne_of_eq_of_ne (degree_map f i) hfd) + +lemma nat_degree_eq_card_roots {p : K[X]} {i : K →+* L} + (hsplit : splits i p) : p.nat_degree = (p.map i).roots.card := +(nat_degree_map i).symm.trans $ nat_degree_eq_card_roots' hsplit + +lemma degree_eq_card_roots {p : K[X]} {i : K →+* L} (p_ne_zero : p ≠ 0) + (hsplit : splits i p) : p.degree = (p.map i).roots.card := +by rw [degree_eq_nat_degree p_ne_zero, nat_degree_eq_card_roots hsplit] + +theorem roots_map {f : K[X]} (hf : f.splits $ ring_hom.id K) : + (f.map i).roots = f.roots.map i := +(roots_map_of_injective_of_card_eq_nat_degree i.injective $ + by { convert (nat_degree_eq_card_roots hf).symm, rw map_id }).symm + +lemma image_root_set [algebra F K] [algebra F L] {p : F[X]} (h : p.splits (algebra_map F K)) + (f : K →ₐ[F] L) : f '' p.root_set K = p.root_set L := +begin + classical, + rw [root_set, ←finset.coe_image, ←multiset.to_finset_map, ←f.coe_to_ring_hom, ←roots_map ↑f + ((splits_id_iff_splits (algebra_map F K)).mpr h), map_map, f.comp_algebra_map, ←root_set], +end + +lemma adjoin_root_set_eq_range [algebra F K] [algebra F L] {p : F[X]} + (h : p.splits (algebra_map F K)) (f : K →ₐ[F] L) : + algebra.adjoin F (p.root_set L) = f.range ↔ algebra.adjoin F (p.root_set K) = ⊤ := +begin + rw [←image_root_set h f, algebra.adjoin_image, ←algebra.map_top], + exact (subalgebra.map_injective f.to_ring_hom.injective).eq_iff, +end + +lemma eq_prod_roots_of_splits {p : K[X]} {i : K →+* L} (hsplit : splits i p) : + p.map i = C (i p.leading_coeff) * ((p.map i).roots.map (λ a, X - C a)).prod := +begin + rw ← leading_coeff_map, symmetry, + apply C_leading_coeff_mul_prod_multiset_X_sub_C, + rw nat_degree_map, exact (nat_degree_eq_card_roots hsplit).symm, +end + +lemma eq_prod_roots_of_splits_id {p : K[X]} + (hsplit : splits (ring_hom.id K) p) : + p = C p.leading_coeff * (p.roots.map (λ a, X - C a)).prod := +by simpa using eq_prod_roots_of_splits hsplit + +lemma eq_prod_roots_of_monic_of_splits_id {p : K[X]} + (m : monic p) (hsplit : splits (ring_hom.id K) p) : + p = (p.roots.map (λ a, X - C a)).prod := +begin + convert eq_prod_roots_of_splits_id hsplit, + simp [m], +end + +lemma eq_X_sub_C_of_splits_of_single_root {x : K} {h : K[X]} (h_splits : splits i h) + (h_roots : (h.map i).roots = {i x}) : h = C h.leading_coeff * (X - C x) := +begin + apply polynomial.map_injective _ i.injective, + rw [eq_prod_roots_of_splits h_splits, h_roots], + simp, +end + +theorem mem_lift_of_splits_of_roots_mem_range (R : Type*) [comm_ring R] [algebra R K] {f : K[X]} + (hs : f.splits (ring_hom.id K)) (hm : f.monic) + (hr : ∀ a ∈ f.roots, a ∈ (algebra_map R K).range) : f ∈ polynomial.lifts (algebra_map R K) := +begin + rw [eq_prod_roots_of_monic_of_splits_id hm hs, lifts_iff_lifts_ring], + refine subring.multiset_prod_mem _ _ (λ P hP, _), + obtain ⟨b, hb, rfl⟩ := multiset.mem_map.1 hP, + exact subring.sub_mem _ (X_mem_lifts _) (C'_mem_lifts (hr _ hb)) +end + +section UFD + +local attribute [instance, priority 10] principal_ideal_ring.to_unique_factorization_monoid +local infix ` ~ᵤ ` : 50 := associated + +open unique_factorization_monoid associates + +lemma splits_of_exists_multiset {f : K[X]} {s : multiset L} + (hs : f.map i = C (i f.leading_coeff) * (s.map (λ a : L, X - C a)).prod) : + splits i f := +if hf0 : f = 0 then hf0.symm ▸ splits_zero i +else or.inr $ λ p hp hdp, begin + rw irreducible_iff_prime at hp, + rw [hs, ← multiset.prod_to_list] at hdp, + obtain (hd|hd) := hp.2.2 _ _ hdp, + { refine (hp.2.1 $ is_unit_of_dvd_unit hd _).elim, + exact is_unit_C.2 ((leading_coeff_ne_zero.2 hf0).is_unit.map i) }, + { obtain ⟨q, hq, hd⟩ := hp.dvd_prod_iff.1 hd, + obtain ⟨a, ha, rfl⟩ := multiset.mem_map.1 (multiset.mem_to_list.1 hq), + rw degree_eq_degree_of_associated ((hp.dvd_prime_iff_associated $ prime_X_sub_C a).1 hd), + exact degree_X_sub_C a }, +end + +lemma splits_of_splits_id {f : K[X]} : splits (ring_hom.id K) f → splits i f := +unique_factorization_monoid.induction_on_prime f (λ _, splits_zero _) + (λ _ hu _, splits_of_degree_le_one _ + ((is_unit_iff_degree_eq_zero.1 hu).symm ▸ dec_trivial)) + (λ a p ha0 hp ih hfi, splits_mul _ + (splits_of_degree_eq_one _ + ((splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).1.def.resolve_left + hp.1 hp.irreducible (by rw map_id))) + (ih (splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).2)) + +end UFD + +lemma splits_iff_exists_multiset {f : K[X]} : splits i f ↔ + ∃ (s : multiset L), f.map i = C (i f.leading_coeff) * (s.map (λ a : L, X - C a)).prod := +⟨λ hf, ⟨(f.map i).roots, eq_prod_roots_of_splits hf⟩, λ ⟨s, hs⟩, splits_of_exists_multiset i hs⟩ + +lemma splits_comp_of_splits (j : L →+* F) {f : K[X]} + (h : splits i f) : splits (j.comp i) f := +begin + change i with ((ring_hom.id _).comp i) at h, + rw [← splits_map_iff], + rw [← splits_map_iff i] at h, + exact splits_of_splits_id _ h +end + +/-- A polynomial splits if and only if it has as many roots as its degree. -/ +lemma splits_iff_card_roots {p : K[X]} : + splits (ring_hom.id K) p ↔ p.roots.card = p.nat_degree := +begin + split, + { intro H, rw [nat_degree_eq_card_roots H, map_id] }, + { intro hroots, + rw splits_iff_exists_multiset (ring_hom.id K), + use p.roots, + simp only [ring_hom.id_apply, map_id], + exact (C_leading_coeff_mul_prod_multiset_X_sub_C hroots).symm }, +end + +lemma aeval_root_derivative_of_splits [algebra K L] {P : K[X]} (hmo : P.monic) + (hP : P.splits (algebra_map K L)) {r : L} (hr : r ∈ (P.map (algebra_map K L)).roots) : + aeval r P.derivative = (((P.map $ algebra_map K L).roots.erase r).map (λ a, r - a)).prod := +begin + replace hmo := hmo.map (algebra_map K L), + replace hP := (splits_id_iff_splits (algebra_map K L)).2 hP, + rw [aeval_def, ← eval_map, ← derivative_map], + nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP], + rw [eval_multiset_prod_X_sub_C_derivative hr] +end + +/-- If `P` is a monic polynomial that splits, then `coeff P 0` equals the product of the roots. -/ +lemma prod_roots_eq_coeff_zero_of_monic_of_split {P : K[X]} (hmo : P.monic) + (hP : P.splits (ring_hom.id K)) : coeff P 0 = (-1) ^ P.nat_degree * P.roots.prod := +begin + nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP], + rw [coeff_zero_eq_eval_zero, eval_multiset_prod, multiset.map_map], + simp_rw [function.comp_app, eval_sub, eval_X, zero_sub, eval_C], + conv_lhs { congr, congr, funext, + rw [neg_eq_neg_one_mul] }, + rw [multiset.prod_map_mul, multiset.map_const, multiset.prod_replicate, multiset.map_id', + splits_iff_card_roots.1 hP] +end + +/-- If `P` is a monic polynomial that splits, then `P.next_coeff` equals the sum of the roots. -/ +lemma sum_roots_eq_next_coeff_of_monic_of_split {P : K[X]} (hmo : P.monic) + (hP : P.splits (ring_hom.id K)) : P.next_coeff = - P.roots.sum := +begin + nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP], + rw [monic.next_coeff_multiset_prod _ _ (λ a ha, _)], + { simp_rw [next_coeff_X_sub_C, multiset.sum_map_neg'] }, + { exact monic_X_sub_C a } +end + +end splits + +end polynomial diff --git a/src/data/polynomial/taylor.lean b/src/data/polynomial/taylor.lean index 1fd7131492a7b..8cea6165daa56 100644 --- a/src/data/polynomial/taylor.lean +++ b/src/data/polynomial/taylor.lean @@ -6,10 +6,14 @@ Authors: Johan Commelin import data.polynomial.algebra_map import data.polynomial.hasse_deriv +import data.polynomial.degree.lemmas /-! # Taylor expansions of polynomials +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + ## Main declarations * `polynomial.taylor`: the Taylor expansion of the polynomial `f` at `r` diff --git a/src/data/polynomial/unit_trinomial.lean b/src/data/polynomial/unit_trinomial.lean new file mode 100644 index 0000000000000..0a3957e21121e --- /dev/null +++ b/src/data/polynomial/unit_trinomial.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2022 Thomas Browning. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Thomas Browning +-/ + +import analysis.complex.polynomial +import data.polynomial.mirror + +/-! +# Unit Trinomials + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines irreducible trinomials and proves an irreducibility criterion. + +## Main definitions + +- `polynomial.is_unit_trinomial` + +## Main results + +- `polynomial.irreducible_of_coprime`: An irreducibility criterion for unit trinomials. + +-/ + +namespace polynomial +open_locale polynomial + +open finset + +section semiring + +variables {R : Type*} [semiring R] (k m n : ℕ) (u v w : R) + +/-- Shorthand for a trinomial -/ +noncomputable def trinomial := C u * X ^ k + C v * X ^ m + C w * X ^ n + +lemma trinomial_def : trinomial k m n u v w = C u * X ^ k + C v * X ^ m + C w * X ^ n := rfl + +variables {k m n u v w} + +lemma trinomial_leading_coeff' (hkm : k < m) (hmn : m < n) : + (trinomial k m n u v w).coeff n = w := +by rw [trinomial_def, coeff_add, coeff_add, coeff_C_mul_X_pow, coeff_C_mul_X_pow, + coeff_C_mul_X_pow, if_neg (hkm.trans hmn).ne', if_neg hmn.ne', if_pos rfl, zero_add, zero_add] + +lemma trinomial_middle_coeff (hkm : k < m) (hmn : m < n) : + (trinomial k m n u v w).coeff m = v := +by rw [trinomial_def, coeff_add, coeff_add, coeff_C_mul_X_pow, coeff_C_mul_X_pow, + coeff_C_mul_X_pow, if_neg hkm.ne', if_pos rfl, if_neg hmn.ne, zero_add, add_zero] + +lemma trinomial_trailing_coeff' (hkm : k < m) (hmn : m < n) : + (trinomial k m n u v w).coeff k = u := +by rw [trinomial_def, coeff_add, coeff_add, coeff_C_mul_X_pow, coeff_C_mul_X_pow, + coeff_C_mul_X_pow, if_pos rfl, if_neg hkm.ne, if_neg (hkm.trans hmn).ne, add_zero, add_zero] + +lemma trinomial_nat_degree (hkm : k < m) (hmn : m < n) (hw : w ≠ 0) : + (trinomial k m n u v w).nat_degree = n := +begin + refine nat_degree_eq_of_degree_eq_some ((finset.sup_le $ λ i h, _).antisymm $ + le_degree_of_ne_zero $ by rwa trinomial_leading_coeff' hkm hmn), + replace h := support_trinomial' k m n u v w h, + rw [mem_insert, mem_insert, mem_singleton] at h, + rcases h with rfl | rfl | rfl, + { exact with_bot.coe_le_coe.mpr (hkm.trans hmn).le }, + { exact with_bot.coe_le_coe.mpr hmn.le }, + { exact le_rfl }, +end + +lemma trinomial_nat_trailing_degree (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) : + (trinomial k m n u v w).nat_trailing_degree = k := +begin + refine nat_trailing_degree_eq_of_trailing_degree_eq_some ((finset.le_inf $ λ i h, _).antisymm $ + le_trailing_degree_of_ne_zero $ by rwa trinomial_trailing_coeff' hkm hmn).symm, + replace h := support_trinomial' k m n u v w h, + rw [mem_insert, mem_insert, mem_singleton] at h, + rcases h with rfl | rfl | rfl, + { exact le_rfl }, + { exact with_top.coe_le_coe.mpr hkm.le }, + { exact with_top.coe_le_coe.mpr (hkm.trans hmn).le }, +end + +lemma trinomial_leading_coeff (hkm : k < m) (hmn : m < n) (hw : w ≠ 0) : + (trinomial k m n u v w).leading_coeff = w := +by rw [leading_coeff, trinomial_nat_degree hkm hmn hw, trinomial_leading_coeff' hkm hmn] + +lemma trinomial_trailing_coeff (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) : + (trinomial k m n u v w).trailing_coeff = u := +by rw [trailing_coeff, trinomial_nat_trailing_degree hkm hmn hu, trinomial_trailing_coeff' hkm hmn] + +lemma trinomial_monic (hkm : k < m) (hmn : m < n) : (trinomial k m n u v 1).monic := +begin + casesI subsingleton_or_nontrivial R with h h, + { apply subsingleton.elim }, + { exact trinomial_leading_coeff hkm hmn one_ne_zero }, +end + +lemma trinomial_mirror (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) (hw : w ≠ 0) : + (trinomial k m n u v w).mirror = trinomial k (n - m + k) n w v u := +by rw [mirror, trinomial_nat_trailing_degree hkm hmn hu, reverse, trinomial_nat_degree hkm hmn hw, + trinomial_def, reflect_add, reflect_add, reflect_C_mul_X_pow, reflect_C_mul_X_pow, + reflect_C_mul_X_pow, rev_at_le (hkm.trans hmn).le, rev_at_le hmn.le, rev_at_le le_rfl, + add_mul, add_mul, mul_assoc, mul_assoc, mul_assoc, ←pow_add, ←pow_add, ←pow_add, + nat.sub_add_cancel (hkm.trans hmn).le, nat.sub_self, zero_add, add_comm, add_comm (C u * X ^ n), + ←add_assoc, ←trinomial_def] + +lemma trinomial_support (hkm : k < m) (hmn : m < n) (hu : u ≠ 0) (hv : v ≠ 0) (hw : w ≠ 0) : + (trinomial k m n u v w).support = {k, m, n} := +support_trinomial hkm hmn hu hv hw + +end semiring + +variables (p q : ℤ[X]) + +/-- A unit trinomial is a trinomial with unit coefficients. -/ +def is_unit_trinomial := ∃ {k m n : ℕ} (hkm : k < m) (hmn : m < n) {u v w : units ℤ}, + p = trinomial k m n u v w + +variables {p q} + +namespace is_unit_trinomial + +lemma not_is_unit (hp : p.is_unit_trinomial) : ¬ is_unit p := +begin + obtain ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩ := hp, + exact λ h, ne_zero_of_lt hmn ((trinomial_nat_degree hkm hmn w.ne_zero).symm.trans + (nat_degree_eq_of_degree_eq_some (degree_eq_zero_of_is_unit h))), +end + +lemma card_support_eq_three (hp : p.is_unit_trinomial) : p.support.card = 3 := +begin + obtain ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩ := hp, + exact card_support_trinomial hkm hmn u.ne_zero v.ne_zero w.ne_zero, +end + +lemma ne_zero (hp : p.is_unit_trinomial) : p ≠ 0 := +begin + rintro rfl, + exact nat.zero_ne_bit1 1 hp.card_support_eq_three, +end + +lemma coeff_is_unit (hp : p.is_unit_trinomial) {k : ℕ} (hk : k ∈ p.support) : + is_unit (p.coeff k) := +begin + obtain ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩ := hp, + have := support_trinomial' k m n ↑u ↑v ↑w hk, + rw [mem_insert, mem_insert, mem_singleton] at this, + rcases this with rfl | rfl | rfl, + { refine ⟨u, by rw trinomial_trailing_coeff' hkm hmn⟩ }, + { refine ⟨v, by rw trinomial_middle_coeff hkm hmn⟩ }, + { refine ⟨w, by rw trinomial_leading_coeff' hkm hmn⟩ }, +end + +lemma leading_coeff_is_unit (hp : p.is_unit_trinomial) : is_unit p.leading_coeff := +hp.coeff_is_unit (nat_degree_mem_support_of_nonzero hp.ne_zero) + +lemma trailing_coeff_is_unit (hp : p.is_unit_trinomial) : is_unit p.trailing_coeff := +hp.coeff_is_unit (nat_trailing_degree_mem_support_of_nonzero hp.ne_zero) + +end is_unit_trinomial + +lemma is_unit_trinomial_iff : + p.is_unit_trinomial ↔ p.support.card = 3 ∧ ∀ k ∈ p.support, is_unit (p.coeff k) := +begin + refine ⟨λ hp, ⟨hp.card_support_eq_three, λ k, hp.coeff_is_unit⟩, λ hp, _⟩, + obtain ⟨k, m, n, hkm, hmn, x, y, z, hx, hy, hz, rfl⟩ := card_support_eq_three.mp hp.1, + rw [support_trinomial hkm hmn hx hy hz] at hp, + replace hx := hp.2 k (mem_insert_self k {m, n}), + replace hy := hp.2 m (mem_insert_of_mem (mem_insert_self m {n})), + replace hz := hp.2 n (mem_insert_of_mem (mem_insert_of_mem (mem_singleton_self n))), + simp_rw [coeff_add, coeff_C_mul, coeff_X_pow_self, mul_one, coeff_X_pow] at hx hy hz, + rw [if_neg hkm.ne, if_neg (hkm.trans hmn).ne] at hx, + rw [if_neg hkm.ne', if_neg hmn.ne] at hy, + rw [if_neg (hkm.trans hmn).ne', if_neg hmn.ne'] at hz, + simp_rw [mul_zero, zero_add, add_zero] at hx hy hz, + exact ⟨k, m, n, hkm, hmn, hx.unit, hy.unit, hz.unit, rfl⟩, +end + +lemma is_unit_trinomial_iff' : p.is_unit_trinomial ↔ (p * p.mirror).coeff + (((p * p.mirror).nat_degree + (p * p.mirror).nat_trailing_degree) / 2) = 3 := +begin + rw [nat_degree_mul_mirror, nat_trailing_degree_mul_mirror, ←mul_add, + nat.mul_div_right _ zero_lt_two, coeff_mul_mirror], + refine ⟨_, λ hp, _⟩, + { rintros ⟨k, m, n, hkm, hmn, u, v, w, rfl⟩, + rw [sum_def, trinomial_support hkm hmn u.ne_zero v.ne_zero w.ne_zero, + sum_insert (mt mem_insert.mp (not_or hkm.ne (mt mem_singleton.mp (hkm.trans hmn).ne))), + sum_insert (mt mem_singleton.mp hmn.ne), sum_singleton, trinomial_leading_coeff' hkm hmn, + trinomial_middle_coeff hkm hmn, trinomial_trailing_coeff' hkm hmn], + simp_rw [←units.coe_pow, int.units_sq, units.coe_one, ←add_assoc, bit1, bit0] }, + { have key : ∀ k ∈ p.support, (p.coeff k) ^ 2 = 1 := + λ k hk, int.sq_eq_one_of_sq_le_three ((single_le_sum + (λ k hk, sq_nonneg (p.coeff k)) hk).trans hp.le) (mem_support_iff.mp hk), + refine is_unit_trinomial_iff.mpr ⟨_, λ k hk, is_unit_of_pow_eq_one (key k hk) two_ne_zero⟩, + rw [sum_def, sum_congr rfl key, sum_const, nat.smul_one_eq_coe] at hp, + exact nat.cast_injective hp }, +end + +lemma is_unit_trinomial_iff'' (h : p * p.mirror = q * q.mirror) : + p.is_unit_trinomial ↔ q.is_unit_trinomial := +by rw [is_unit_trinomial_iff', is_unit_trinomial_iff', h] + +namespace is_unit_trinomial + +lemma irreducible_aux1 {k m n : ℕ} (hkm : k < m) (hmn : m < n) (u v w : units ℤ) + (hp : p = trinomial k m n u v w) : + C ↑v * (C ↑u * X ^ (m + n) + C ↑w * X ^ (n - m + k + n)) = + ⟨finsupp.filter (set.Ioo (k + n) (n + n)) (p * p.mirror).to_finsupp⟩ := +begin + have key : n - m + k < n := by rwa [←lt_tsub_iff_right, tsub_lt_tsub_iff_left_of_le hmn.le], + rw [hp, trinomial_mirror hkm hmn u.ne_zero w.ne_zero], + simp_rw [trinomial_def, C_mul_X_pow_eq_monomial, add_mul, mul_add, monomial_mul_monomial, + to_finsupp_add, to_finsupp_monomial, finsupp.filter_add], + rw [finsupp.filter_single_of_neg, finsupp.filter_single_of_neg, finsupp.filter_single_of_neg, + finsupp.filter_single_of_neg, finsupp.filter_single_of_neg, finsupp.filter_single_of_pos, + finsupp.filter_single_of_neg, finsupp.filter_single_of_pos, finsupp.filter_single_of_neg], + { simp only [add_zero, zero_add, of_finsupp_add, of_finsupp_single], + rw [C_mul_monomial, C_mul_monomial, mul_comm ↑v ↑w, add_comm (n - m + k) n] }, + { exact λ h, h.2.ne rfl }, + { refine ⟨_, add_lt_add_left key n⟩, + rwa [add_comm, add_lt_add_iff_left, lt_add_iff_pos_left, tsub_pos_iff_lt] }, + { exact λ h, h.1.ne (add_comm k n) }, + { exact ⟨add_lt_add_right hkm n, add_lt_add_right hmn n⟩ }, + { rw [←add_assoc, add_tsub_cancel_of_le hmn.le, add_comm], + exact λ h, h.1.ne rfl }, + { intro h, + have := h.1, + rw [add_comm, add_lt_add_iff_right] at this, + exact asymm this hmn }, + { exact λ h, h.1.ne rfl }, + { exact λ h, asymm ((add_lt_add_iff_left k).mp h.1) key }, + { exact λ h, asymm ((add_lt_add_iff_left k).mp h.1) (hkm.trans hmn) }, +end + +lemma irreducible_aux2 {k m m' n : ℕ} + (hkm : k < m) (hmn : m < n) (hkm' : k < m') (hmn' : m' < n) + (u v w : units ℤ) + (hp : p = trinomial k m n u v w) (hq : q = trinomial k m' n u v w) + (h : p * p.mirror = q * q.mirror) : + q = p ∨ q = p.mirror := +begin + let f : ℤ[X] → ℤ[X] := + λ p, ⟨finsupp.filter (set.Ioo (k + n) (n + n)) p.to_finsupp⟩, + replace h := congr_arg f h, + replace h := (irreducible_aux1 hkm hmn u v w hp).trans h, + replace h := h.trans (irreducible_aux1 hkm' hmn' u v w hq).symm, + rw (is_unit_C.mpr v.is_unit).mul_right_inj at h, + rw binomial_eq_binomial u.ne_zero w.ne_zero at h, + simp only [add_left_inj, units.eq_iff] at h, + rcases h with ⟨rfl, -⟩ | ⟨rfl, rfl, h⟩ | ⟨-, hm, hm'⟩, + { exact or.inl (hq.trans hp.symm) }, + { refine or.inr _, + rw [←trinomial_mirror hkm' hmn' u.ne_zero u.ne_zero, eq_comm, mirror_eq_iff] at hp, + exact hq.trans hp }, + { suffices : m = m', + { rw this at hp, + exact or.inl (hq.trans hp.symm) }, + rw [tsub_add_eq_add_tsub hmn.le, eq_tsub_iff_add_eq_of_le, ←two_mul] at hm, + rw [tsub_add_eq_add_tsub hmn'.le, eq_tsub_iff_add_eq_of_le, ←two_mul] at hm', + exact mul_left_cancel₀ two_ne_zero (hm.trans hm'.symm), + exact hmn'.le.trans (nat.le_add_right n k), + exact hmn.le.trans (nat.le_add_right n k) }, +end + +lemma irreducible_aux3 {k m m' n : ℕ} + (hkm : k < m) (hmn : m < n) (hkm' : k < m') (hmn' : m' < n) (u v w x z : units ℤ) + (hp : p = trinomial k m n u v w) (hq : q = trinomial k m' n x v z) + (h : p * p.mirror = q * q.mirror) : + q = p ∨ q = p.mirror := +begin + have hmul := congr_arg leading_coeff h, + rw [leading_coeff_mul, leading_coeff_mul, mirror_leading_coeff, mirror_leading_coeff, hp, hq, + trinomial_leading_coeff hkm hmn w.ne_zero, trinomial_leading_coeff hkm' hmn' z.ne_zero, + trinomial_trailing_coeff hkm hmn u.ne_zero, + trinomial_trailing_coeff hkm' hmn' x.ne_zero] at hmul, + + have hadd := congr_arg (eval 1) h, + rw [eval_mul, eval_mul, mirror_eval_one, mirror_eval_one, ←sq, ←sq, hp, hq] at hadd, + simp only [eval_add, eval_C_mul, eval_pow, eval_X, one_pow, mul_one, trinomial_def] at hadd, + rw [add_assoc, add_assoc, add_comm ↑u, add_comm ↑x, add_assoc, add_assoc] at hadd, + simp only [add_sq', add_assoc, add_right_inj, ←units.coe_pow, int.units_sq] at hadd, + rw [mul_assoc, hmul, ←mul_assoc, add_right_inj, + mul_right_inj' (show 2 * (v : ℤ) ≠ 0, from mul_ne_zero two_ne_zero v.ne_zero)] at hadd, + replace hadd := (int.is_unit_add_is_unit_eq_is_unit_add_is_unit w.is_unit u.is_unit + z.is_unit x.is_unit).mp hadd, + simp only [units.eq_iff] at hadd, + + rcases hadd with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩, + { exact irreducible_aux2 hkm hmn hkm' hmn' u v w hp hq h }, + { rw [←mirror_inj, trinomial_mirror hkm' hmn' w.ne_zero u.ne_zero] at hq, + rw [mul_comm q, ←q.mirror_mirror, q.mirror.mirror_mirror] at h, + rw [←mirror_inj, or_comm, ←mirror_eq_iff], + exact irreducible_aux2 hkm hmn (lt_add_of_pos_left k (tsub_pos_of_lt hmn')) + ((lt_tsub_iff_right).mp ((tsub_lt_tsub_iff_left_of_le hmn'.le).mpr hkm')) u v w hp hq h }, +end + +lemma irreducible_of_coprime (hp : p.is_unit_trinomial) + (h : ∀ q : ℤ[X], q ∣ p → q ∣ p.mirror → is_unit q) : + irreducible p := +begin + refine irreducible_of_mirror hp.not_is_unit (λ q hpq, _) h, + have hq : is_unit_trinomial q := (is_unit_trinomial_iff'' hpq).mp hp, + obtain ⟨k, m, n, hkm, hmn, u, v, w, hp⟩ := hp, + obtain ⟨k', m', n', hkm', hmn', x, y, z, hq⟩ := hq, + have hk : k = k', + { rw [←mul_right_inj' (show 2 ≠ 0, from two_ne_zero), + ←trinomial_nat_trailing_degree hkm hmn u.ne_zero, ←hp, ←nat_trailing_degree_mul_mirror, hpq, + nat_trailing_degree_mul_mirror, hq, trinomial_nat_trailing_degree hkm' hmn' x.ne_zero] }, + have hn : n = n', + { rw [←mul_right_inj' (show 2 ≠ 0, from two_ne_zero), + ←trinomial_nat_degree hkm hmn w.ne_zero, ←hp, ←nat_degree_mul_mirror, hpq, + nat_degree_mul_mirror, hq, trinomial_nat_degree hkm' hmn' z.ne_zero] }, + subst hk, + subst hn, + rcases eq_or_eq_neg_of_sq_eq_sq ↑y ↑v + ((int.is_unit_sq y.is_unit).trans (int.is_unit_sq v.is_unit).symm) with h1 | h1, + { rw h1 at *, + rcases irreducible_aux3 hkm hmn hkm' hmn' u v w x z hp hq hpq with h2 | h2, + { exact or.inl h2 }, + { exact or.inr (or.inr (or.inl h2)) } }, + { rw h1 at *, + rw trinomial_def at hp, + rw [←neg_inj, neg_add, neg_add, ←neg_mul, ←neg_mul, ←neg_mul, ←C_neg, ←C_neg, ←C_neg] at hp, + rw [←neg_mul_neg, ←mirror_neg] at hpq, + rcases irreducible_aux3 hkm hmn hkm' hmn' (-u) (-v) (-w) x z hp hq hpq with rfl | rfl, + { exact or.inr (or.inl rfl) }, + { exact or.inr (or.inr (or.inr p.mirror_neg)) } }, +end + +/-- A unit trinomial is irreducible if it is coprime with its mirror -/ +lemma irreducible_of_is_coprime (hp : p.is_unit_trinomial) (h : is_coprime p p.mirror) : + irreducible p := +irreducible_of_coprime hp (λ q, h.is_unit_of_dvd') + +/-- A unit trinomial is irreducible if it has no complex roots in common with its mirror -/ +lemma irreducible_of_coprime' (hp : is_unit_trinomial p) + (h : ∀ z : ℂ, ¬ (aeval z p = 0 ∧ aeval z (mirror p) = 0)) : irreducible p := +begin + refine hp.irreducible_of_coprime (λ q hq hq', _), + suffices : ¬ (0 < q.nat_degree), + { rcases hq with ⟨p, rfl⟩, + replace hp := hp.leading_coeff_is_unit, + rw leading_coeff_mul at hp, + replace hp := is_unit_of_mul_is_unit_left hp, + rw [not_lt, le_zero_iff] at this, + rwa [eq_C_of_nat_degree_eq_zero this, is_unit_C, ←this] }, + intro hq'', + rw nat_degree_pos_iff_degree_pos at hq'', + rw ← degree_map_eq_of_injective (algebra_map ℤ ℂ).injective_int at hq'', + cases complex.exists_root hq'' with z hz, + rw [is_root, eval_map, ←aeval_def] at hz, + refine h z ⟨_, _⟩, + { cases hq with g' hg', + rw [hg', aeval_mul, hz, zero_mul] }, + { cases hq' with g' hg', + rw [hg', aeval_mul, hz, zero_mul] }, +end + +-- TODO: Develop more theory (e.g., it suffices to check that `aeval z p ≠ 0` for `z = 0` +-- and `z` a root of unity) + +end is_unit_trinomial + +end polynomial diff --git a/src/data/prod.lean b/src/data/prod.lean deleted file mode 100644 index 9ccfa0badfa8f..0000000000000 --- a/src/data/prod.lean +++ /dev/null @@ -1,217 +0,0 @@ -/- -Copyright (c) 2017 Johannes Hölzl. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Johannes Hölzl --/ -import tactic.basic - -/-! -# Extra facts about `prod` - -This file defines `prod.swap : α × β → β × α` and proves various simple lemmas about `prod`. --/ - -variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} - -@[simp] lemma prod_map (f : α → γ) (g : β → δ) (p : α × β) : prod.map f g p = (f p.1, g p.2) := rfl - -namespace prod - -@[simp] theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ (∀ a b, p (a, b)) := -⟨assume h a b, h (a, b), assume h ⟨a, b⟩, h a b⟩ - -@[simp] theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ (∃ a b, p (a, b)) := -⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩ - -theorem forall' {p : α → β → Prop} : (∀ x : α × β, p x.1 x.2) ↔ ∀ a b, p a b := -prod.forall - -theorem exists' {p : α → β → Prop} : (∃ x : α × β, p x.1 x.2) ↔ ∃ a b, p a b := -prod.exists - -@[simp] lemma snd_comp_mk (x : α) : prod.snd ∘ (prod.mk x : β → α × β) = id := rfl - -@[simp] lemma fst_comp_mk (x : α) : prod.fst ∘ (prod.mk x : β → α × β) = function.const β x := rfl - -@[simp] lemma map_mk (f : α → γ) (g : β → δ) (a : α) (b : β) : map f g (a, b) = (f a, g b) := rfl - -lemma map_fst (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).1 = f (p.1) := rfl - -lemma map_snd (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).2 = g (p.2) := rfl - -lemma map_fst' (f : α → γ) (g : β → δ) : (prod.fst ∘ map f g) = f ∘ prod.fst := -funext $ map_fst f g - -lemma map_snd' (f : α → γ) (g : β → δ) : (prod.snd ∘ map f g) = g ∘ prod.snd := -funext $ map_snd f g - -/-- -Composing a `prod.map` with another `prod.map` is equal to -a single `prod.map` of composed functions. --/ -lemma map_comp_map {ε ζ : Type*} - (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) : - prod.map g g' ∘ prod.map f f' = prod.map (g ∘ f) (g' ∘ f') := -rfl - -/-- -Composing a `prod.map` with another `prod.map` is equal to -a single `prod.map` of composed functions, fully applied. --/ -lemma map_map {ε ζ : Type*} - (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) : - prod.map g g' (prod.map f f' x) = prod.map (g ∘ f) (g' ∘ f') x := -rfl - -@[simp] theorem mk.inj_iff {a₁ a₂ : α} {b₁ b₂ : β} : (a₁, b₁) = (a₂, b₂) ↔ (a₁ = a₂ ∧ b₁ = b₂) := -⟨prod.mk.inj, by cc⟩ - -lemma mk.inj_left {α β : Type*} (a : α) : - function.injective (prod.mk a : β → α × β) := -by { intros b₁ b₂ h, simpa only [true_and, prod.mk.inj_iff, eq_self_iff_true] using h } - -lemma mk.inj_right {α β : Type*} (b : β) : - function.injective (λ a, prod.mk a b : α → α × β) := -by { intros b₁ b₂ h, by simpa only [and_true, eq_self_iff_true, mk.inj_iff] using h } - -lemma ext_iff {p q : α × β} : p = q ↔ p.1 = q.1 ∧ p.2 = q.2 := -by rw [← @mk.eta _ _ p, ← @mk.eta _ _ q, mk.inj_iff] - -@[ext] -lemma ext {α β} {p q : α × β} (h₁ : p.1 = q.1) (h₂ : p.2 = q.2) : p = q := -ext_iff.2 ⟨h₁, h₂⟩ - -lemma map_def {f : α → γ} {g : β → δ} : prod.map f g = λ (p : α × β), (f p.1, g p.2) := -funext (λ p, ext (map_fst f g p) (map_snd f g p)) - -lemma id_prod : (λ (p : α × α), (p.1, p.2)) = id := -funext $ λ ⟨a, b⟩, rfl - -lemma fst_surjective [h : nonempty β] : function.surjective (@fst α β) := -λ x, h.elim $ λ y, ⟨⟨x, y⟩, rfl⟩ - -lemma snd_surjective [h : nonempty α] : function.surjective (@snd α β) := -λ y, h.elim $ λ x, ⟨⟨x, y⟩, rfl⟩ - -lemma fst_injective [subsingleton β] : function.injective (@fst α β) := -λ x y h, ext h (subsingleton.elim _ _) - -lemma snd_injective [subsingleton α] : function.injective (@snd α β) := -λ x y h, ext (subsingleton.elim _ _) h - -/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/ -def swap : α × β → β × α := λp, (p.2, p.1) - -@[simp] lemma swap_swap : ∀ x : α × β, swap (swap x) = x -| ⟨a, b⟩ := rfl - -@[simp] lemma fst_swap {p : α × β} : (swap p).1 = p.2 := rfl - -@[simp] lemma snd_swap {p : α × β} : (swap p).2 = p.1 := rfl - -@[simp] lemma swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) := rfl - -@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α × β) := -funext swap_swap - -@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap := -swap_swap - -@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap := -swap_swap - -lemma swap_injective : function.injective (@swap α β) := -swap_left_inverse.injective - -lemma swap_surjective : function.surjective (@swap α β) := -swap_left_inverse.surjective - -lemma swap_bijective : function.bijective (@swap α β) := -⟨swap_injective, swap_surjective⟩ - -@[simp] lemma swap_inj {p q : α × β} : swap p = swap q ↔ p = q := swap_injective.eq_iff - -lemma eq_iff_fst_eq_snd_eq : ∀{p q : α × β}, p = q ↔ (p.1 = q.1 ∧ p.2 = q.2) -| ⟨p₁, p₂⟩ ⟨q₁, q₂⟩ := by simp - -lemma fst_eq_iff : ∀ {p : α × β} {x : α}, p.1 = x ↔ p = (x, p.2) -| ⟨a, b⟩ x := by simp - -lemma snd_eq_iff : ∀ {p : α × β} {x : β}, p.2 = x ↔ p = (p.1, x) -| ⟨a, b⟩ x := by simp - -theorem lex_def (r : α → α → Prop) (s : β → β → Prop) - {p q : α × β} : prod.lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 := -⟨λ h, by cases h; simp *, - λ h, match p, q, h with - | (a, b), (c, d), or.inl h := lex.left _ _ h - | (a, b), (c, d), or.inr ⟨e, h⟩ := - by change a = c at e; subst e; exact lex.right _ h - end⟩ - -instance lex.decidable [decidable_eq α] - (r : α → α → Prop) (s : β → β → Prop) [decidable_rel r] [decidable_rel s] : - decidable_rel (prod.lex r s) := -λ p q, decidable_of_decidable_of_iff (by apply_instance) (lex_def r s).symm - -@[refl] lemma lex.refl_left (r : α → α → Prop) (s : β → β → Prop) [is_refl α r] : - ∀ x, prod.lex r s x x -| (x₁, x₂) := lex.left _ _ (refl _) - -instance is_refl_left {r : α → α → Prop} {s : β → β → Prop} [is_refl α r] : - is_refl (α × β) (lex r s) := -⟨lex.refl_left _ _⟩ - -@[refl] lemma lex.refl_right (r : α → α → Prop) (s : β → β → Prop) [is_refl β s] : - ∀ x, prod.lex r s x x -| (x₁, x₂) := lex.right _ (refl _) - -instance is_refl_right {r : α → α → Prop} {s : β → β → Prop} [is_refl β s] : - is_refl (α × β) (lex r s) := -⟨lex.refl_right _ _⟩ - -@[trans] lemma lex.trans {r : α → α → Prop} {s : β → β → Prop} [is_trans α r] [is_trans β s] : - ∀ {x y z : α × β}, prod.lex r s x y → prod.lex r s y z → prod.lex r s x z -| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.left _ _ hxy₁) (lex.left _ _ hyz₁) := - lex.left _ _ (trans hxy₁ hyz₁) -| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.left _ _ hxy₁) (lex.right _ hyz₂) := lex.left _ _ hxy₁ -| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.right _ _) (lex.left _ _ hyz₁) := lex.left _ _ hyz₁ -| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.right _ hxy₂) (lex.right _ hyz₂) := lex.right _ (trans hxy₂ hyz₂) - -instance {r : α → α → Prop} {s : β → β → Prop} [is_trans α r] [is_trans β s] : - is_trans (α × β) (lex r s) := -⟨λ _ _ _, lex.trans⟩ - -instance {r : α → α → Prop} {s : β → β → Prop} [is_strict_order α r] [is_antisymm β s] : - is_antisymm (α × β) (lex r s) := -⟨λ x₁ x₂ h₁₂ h₂₁, match x₁, x₂, h₁₂, h₂₁ with - | (a₁, b₁), (a₂, b₂), lex.left _ _ hr₁, lex.left _ _ hr₂ := (irrefl a₁ (trans hr₁ hr₂)).elim - | (a₁, b₁), (a₂, b₂), lex.left _ _ hr₁, lex.right _ _ := (irrefl _ hr₁).elim - | (a₁, b₁), (a₂, b₂), lex.right _ _, lex.left _ _ hr₂ := (irrefl _ hr₂).elim - | (a₁, b₁), (a₂, b₂), lex.right _ hs₁, lex.right _ hs₂ := antisymm hs₁ hs₂ ▸ rfl -end⟩ - -instance is_total_left {r : α → α → Prop} {s : β → β → Prop} [is_total α r] : - is_total (α × β) (lex r s) := -⟨λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, (is_total.total a₁ a₂).imp (lex.left _ _) (lex.left _ _)⟩ - -instance is_total_right {r : α → α → Prop} {s : β → β → Prop} [is_trichotomous α r] [is_total β s] : - is_total (α × β) (lex r s) := -⟨λ ⟨i, a⟩ ⟨j, b⟩, begin - obtain hij | rfl | hji := trichotomous_of r i j, - { exact or.inl (lex.left _ _ hij) }, - { exact (total_of (s) a b).imp (lex.right _) (lex.right _), }, - { exact or.inr (lex.left _ _ hji) } -end⟩ - -end prod - -open function - -lemma function.injective.prod_map {f : α → γ} {g : β → δ} (hf : injective f) (hg : injective g) : - injective (prod.map f g) := -λ x y h, prod.ext (hf (prod.ext_iff.1 h).1) (hg $ (prod.ext_iff.1 h).2) - -lemma function.surjective.prod_map {f : α → γ} {g : β → δ} (hf : surjective f) (hg : surjective g) : - surjective (prod.map f g) := -λ p, let ⟨x, hx⟩ := hf p.1 in let ⟨y, hy⟩ := hg p.2 in ⟨(x, y), prod.ext hx hy⟩ diff --git a/src/data/prod/basic.lean b/src/data/prod/basic.lean new file mode 100644 index 0000000000000..eb8f6034c7058 --- /dev/null +++ b/src/data/prod/basic.lean @@ -0,0 +1,319 @@ +/- +Copyright (c) 2017 Johannes Hölzl. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Johannes Hölzl +-/ +import tactic.basic +import logic.function.basic + +/-! +# Extra facts about `prod` + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines `prod.swap : α × β → β × α` and proves various simple lemmas about `prod`. +-/ + +variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} + +@[simp] lemma prod_map (f : α → γ) (g : β → δ) (p : α × β) : prod.map f g p = (f p.1, g p.2) := rfl + +namespace prod + +@[simp] theorem «forall» {p : α × β → Prop} : (∀ x, p x) ↔ (∀ a b, p (a, b)) := +⟨assume h a b, h (a, b), assume h ⟨a, b⟩, h a b⟩ + +@[simp] theorem «exists» {p : α × β → Prop} : (∃ x, p x) ↔ (∃ a b, p (a, b)) := +⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩ + +theorem forall' {p : α → β → Prop} : (∀ x : α × β, p x.1 x.2) ↔ ∀ a b, p a b := +prod.forall + +theorem exists' {p : α → β → Prop} : (∃ x : α × β, p x.1 x.2) ↔ ∃ a b, p a b := +prod.exists + +@[simp] lemma snd_comp_mk (x : α) : prod.snd ∘ (prod.mk x : β → α × β) = id := rfl + +@[simp] lemma fst_comp_mk (x : α) : prod.fst ∘ (prod.mk x : β → α × β) = function.const β x := rfl + +@[simp, mfld_simps] lemma map_mk (f : α → γ) (g : β → δ) (a : α) (b : β) : + map f g (a, b) = (f a, g b) := +rfl + +lemma map_fst (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).1 = f (p.1) := rfl + +lemma map_snd (f : α → γ) (g : β → δ) (p : α × β) : (map f g p).2 = g (p.2) := rfl + +lemma map_fst' (f : α → γ) (g : β → δ) : (prod.fst ∘ map f g) = f ∘ prod.fst := +funext $ map_fst f g + +lemma map_snd' (f : α → γ) (g : β → δ) : (prod.snd ∘ map f g) = g ∘ prod.snd := +funext $ map_snd f g + +/-- +Composing a `prod.map` with another `prod.map` is equal to +a single `prod.map` of composed functions. +-/ +lemma map_comp_map {ε ζ : Type*} + (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) : + prod.map g g' ∘ prod.map f f' = prod.map (g ∘ f) (g' ∘ f') := +rfl + +/-- +Composing a `prod.map` with another `prod.map` is equal to +a single `prod.map` of composed functions, fully applied. +-/ +lemma map_map {ε ζ : Type*} + (f : α → β) (f' : γ → δ) (g : β → ε) (g' : δ → ζ) (x : α × γ) : + prod.map g g' (prod.map f f' x) = prod.map (g ∘ f) (g' ∘ f') x := +rfl + +variables {a a₁ a₂ : α} {b b₁ b₂ : β} + +@[simp] lemma mk.inj_iff : (a₁, b₁) = (a₂, b₂) ↔ a₁ = a₂ ∧ b₁ = b₂ := ⟨prod.mk.inj, by cc⟩ + +lemma mk.inj_left {α β : Type*} (a : α) : + function.injective (prod.mk a : β → α × β) := +by { intros b₁ b₂ h, simpa only [true_and, prod.mk.inj_iff, eq_self_iff_true] using h } + +lemma mk.inj_right {α β : Type*} (b : β) : + function.injective (λ a, prod.mk a b : α → α × β) := +by { intros b₁ b₂ h, by simpa only [and_true, eq_self_iff_true, mk.inj_iff] using h } + +lemma mk_inj_left : (a, b₁) = (a, b₂) ↔ b₁ = b₂ := (mk.inj_left _).eq_iff +lemma mk_inj_right : (a₁, b) = (a₂, b) ↔ a₁ = a₂ := (mk.inj_right _).eq_iff + +lemma ext_iff {p q : α × β} : p = q ↔ p.1 = q.1 ∧ p.2 = q.2 := +by rw [← @mk.eta _ _ p, ← @mk.eta _ _ q, mk.inj_iff] + +@[ext] +lemma ext {α β} {p q : α × β} (h₁ : p.1 = q.1) (h₂ : p.2 = q.2) : p = q := +ext_iff.2 ⟨h₁, h₂⟩ + +lemma map_def {f : α → γ} {g : β → δ} : prod.map f g = λ (p : α × β), (f p.1, g p.2) := +funext (λ p, ext (map_fst f g p) (map_snd f g p)) + +lemma id_prod : (λ (p : α × β), (p.1, p.2)) = id := +funext $ λ ⟨a, b⟩, rfl + +@[simp] lemma map_id : (prod.map (@id α) (@id β)) = id := +id_prod + +lemma fst_surjective [h : nonempty β] : function.surjective (@fst α β) := +λ x, h.elim $ λ y, ⟨⟨x, y⟩, rfl⟩ + +lemma snd_surjective [h : nonempty α] : function.surjective (@snd α β) := +λ y, h.elim $ λ x, ⟨⟨x, y⟩, rfl⟩ + +lemma fst_injective [subsingleton β] : function.injective (@fst α β) := +λ x y h, ext h (subsingleton.elim _ _) + +lemma snd_injective [subsingleton α] : function.injective (@snd α β) := +λ x y h, ext (subsingleton.elim _ _) h + +/-- Swap the factors of a product. `swap (a, b) = (b, a)` -/ +def swap : α × β → β × α := λp, (p.2, p.1) + +@[simp] lemma swap_swap : ∀ x : α × β, swap (swap x) = x +| ⟨a, b⟩ := rfl + +@[simp] lemma fst_swap {p : α × β} : (swap p).1 = p.2 := rfl + +@[simp] lemma snd_swap {p : α × β} : (swap p).2 = p.1 := rfl + +@[simp] lemma swap_prod_mk {a : α} {b : β} : swap (a, b) = (b, a) := rfl + +@[simp] lemma swap_swap_eq : swap ∘ swap = @id (α × β) := +funext swap_swap + +@[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap := +swap_swap + +@[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap := +swap_swap + +lemma swap_injective : function.injective (@swap α β) := +swap_left_inverse.injective + +lemma swap_surjective : function.surjective (@swap α β) := +swap_left_inverse.surjective + +lemma swap_bijective : function.bijective (@swap α β) := +⟨swap_injective, swap_surjective⟩ + +@[simp] lemma swap_inj {p q : α × β} : swap p = swap q ↔ p = q := swap_injective.eq_iff + +lemma eq_iff_fst_eq_snd_eq : ∀{p q : α × β}, p = q ↔ (p.1 = q.1 ∧ p.2 = q.2) +| ⟨p₁, p₂⟩ ⟨q₁, q₂⟩ := by simp + +lemma fst_eq_iff : ∀ {p : α × β} {x : α}, p.1 = x ↔ p = (x, p.2) +| ⟨a, b⟩ x := by simp + +lemma snd_eq_iff : ∀ {p : α × β} {x : β}, p.2 = x ↔ p = (p.1, x) +| ⟨a, b⟩ x := by simp + +variables {r : α → α → Prop} {s : β → β → Prop} {x y : α × β} + +theorem lex_def (r : α → α → Prop) (s : β → β → Prop) + {p q : α × β} : prod.lex r s p q ↔ r p.1 q.1 ∨ p.1 = q.1 ∧ s p.2 q.2 := +⟨λ h, by cases h; simp *, + λ h, match p, q, h with + | (a, b), (c, d), or.inl h := lex.left _ _ h + | (a, b), (c, d), or.inr ⟨e, h⟩ := + by change a = c at e; subst e; exact lex.right _ h + end⟩ + +lemma lex_iff : lex r s x y ↔ r x.1 y.1 ∨ x.1 = y.1 ∧ s x.2 y.2 := lex_def _ _ + +instance lex.decidable [decidable_eq α] + (r : α → α → Prop) (s : β → β → Prop) [decidable_rel r] [decidable_rel s] : + decidable_rel (prod.lex r s) := +λ p q, decidable_of_decidable_of_iff (by apply_instance) (lex_def r s).symm + +@[refl] lemma lex.refl_left (r : α → α → Prop) (s : β → β → Prop) [is_refl α r] : + ∀ x, prod.lex r s x x +| (x₁, x₂) := lex.left _ _ (refl _) + +instance is_refl_left {r : α → α → Prop} {s : β → β → Prop} [is_refl α r] : + is_refl (α × β) (lex r s) := +⟨lex.refl_left _ _⟩ + +@[refl] lemma lex.refl_right (r : α → α → Prop) (s : β → β → Prop) [is_refl β s] : + ∀ x, prod.lex r s x x +| (x₁, x₂) := lex.right _ (refl _) + +instance is_refl_right {r : α → α → Prop} {s : β → β → Prop} [is_refl β s] : + is_refl (α × β) (lex r s) := +⟨lex.refl_right _ _⟩ + +instance is_irrefl [is_irrefl α r] [is_irrefl β s] : is_irrefl (α × β) (lex r s) := +⟨by rintro ⟨i, a⟩ (⟨_, _, h⟩ | ⟨_, h⟩); exact irrefl _ h⟩ + +@[trans] lemma lex.trans {r : α → α → Prop} {s : β → β → Prop} [is_trans α r] [is_trans β s] : + ∀ {x y z : α × β}, prod.lex r s x y → prod.lex r s y z → prod.lex r s x z +| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.left _ _ hxy₁) (lex.left _ _ hyz₁) := + lex.left _ _ (trans hxy₁ hyz₁) +| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.left _ _ hxy₁) (lex.right _ hyz₂) := lex.left _ _ hxy₁ +| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.right _ _) (lex.left _ _ hyz₁) := lex.left _ _ hyz₁ +| (x₁, x₂) (y₁, y₂) (z₁, z₂) (lex.right _ hxy₂) (lex.right _ hyz₂) := lex.right _ (trans hxy₂ hyz₂) + +instance {r : α → α → Prop} {s : β → β → Prop} [is_trans α r] [is_trans β s] : + is_trans (α × β) (lex r s) := +⟨λ _ _ _, lex.trans⟩ + +instance {r : α → α → Prop} {s : β → β → Prop} [is_strict_order α r] [is_antisymm β s] : + is_antisymm (α × β) (lex r s) := +⟨λ x₁ x₂ h₁₂ h₂₁, match x₁, x₂, h₁₂, h₂₁ with + | (a₁, b₁), (a₂, b₂), lex.left _ _ hr₁, lex.left _ _ hr₂ := (irrefl a₁ (trans hr₁ hr₂)).elim + | (a₁, b₁), (a₂, b₂), lex.left _ _ hr₁, lex.right _ _ := (irrefl _ hr₁).elim + | (a₁, b₁), (a₂, b₂), lex.right _ _, lex.left _ _ hr₂ := (irrefl _ hr₂).elim + | (a₁, b₁), (a₂, b₂), lex.right _ hs₁, lex.right _ hs₂ := antisymm hs₁ hs₂ ▸ rfl +end⟩ + +instance is_total_left {r : α → α → Prop} {s : β → β → Prop} [is_total α r] : + is_total (α × β) (lex r s) := +⟨λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, (is_total.total a₁ a₂).imp (lex.left _ _) (lex.left _ _)⟩ + +instance is_total_right {r : α → α → Prop} {s : β → β → Prop} [is_trichotomous α r] [is_total β s] : + is_total (α × β) (lex r s) := +⟨λ ⟨i, a⟩ ⟨j, b⟩, begin + obtain hij | rfl | hji := trichotomous_of r i j, + { exact or.inl (lex.left _ _ hij) }, + { exact (total_of (s) a b).imp (lex.right _) (lex.right _), }, + { exact or.inr (lex.left _ _ hji) } +end⟩ + +instance is_trichotomous [is_trichotomous α r] [is_trichotomous β s] : + is_trichotomous (α × β) (lex r s) := +⟨λ ⟨i, a⟩ ⟨j, b⟩, begin + obtain hij | rfl | hji := trichotomous_of r i j, + { exact or.inl (lex.left _ _ hij) }, + { exact (trichotomous_of s a b).imp3 (lex.right _) (congr_arg _) (lex.right _) }, + { exact or.inr (or.inr $ lex.left _ _ hji) } +end⟩ + +end prod + +open prod + +namespace function +variables {f : α → γ} {g : β → δ} {f₁ : α → β} {g₁ : γ → δ} {f₂ : β → α} {g₂ : δ → γ} + +lemma injective.prod_map (hf : injective f) (hg : injective g) : injective (map f g) := +λ x y h, ext (hf (ext_iff.1 h).1) (hg $ (ext_iff.1 h).2) + +lemma surjective.prod_map (hf : surjective f) (hg : surjective g) : surjective (map f g) := +λ p, let ⟨x, hx⟩ := hf p.1 in let ⟨y, hy⟩ := hg p.2 in ⟨(x, y), prod.ext hx hy⟩ + +lemma bijective.prod_map (hf : bijective f) (hg : bijective g) : bijective (map f g) := +⟨hf.1.prod_map hg.1, hf.2.prod_map hg.2⟩ + +lemma left_inverse.prod_map (hf : left_inverse f₁ f₂) (hg : left_inverse g₁ g₂) : + left_inverse (map f₁ g₁) (map f₂ g₂) := +λ a, by rw [prod.map_map, hf.comp_eq_id, hg.comp_eq_id, map_id, id] + +lemma right_inverse.prod_map : + right_inverse f₁ f₂ → right_inverse g₁ g₂ → right_inverse (map f₁ g₁) (map f₂ g₂) := +left_inverse.prod_map + +lemma involutive.prod_map {f : α → α} {g : β → β} : + involutive f → involutive g → involutive (map f g) := +left_inverse.prod_map + +end function + +namespace prod +open function + +@[simp] lemma map_injective [nonempty α] [nonempty β] {f : α → γ} {g : β → δ} : + injective (map f g) ↔ injective f ∧ injective g := +⟨λ h, ⟨λ a₁ a₂ ha, begin + inhabit β, + injection @h (a₁, default) (a₂, default) (congr_arg (λ c : γ, prod.mk c (g default)) ha : _), +end, λ b₁ b₂ hb, begin + inhabit α, + injection @h (default, b₁) (default, b₂) (congr_arg (prod.mk (f default)) hb : _), +end⟩, λ h, h.1.prod_map h.2⟩ + +@[simp] lemma map_surjective [nonempty γ] [nonempty δ] {f : α → γ} {g : β → δ} : + surjective (map f g) ↔ surjective f ∧ surjective g := +⟨λ h, ⟨λ c, begin + inhabit δ, + obtain ⟨⟨a, b⟩, h⟩ := h (c, default), + exact ⟨a, congr_arg prod.fst h⟩, +end, λ d, begin + inhabit γ, + obtain ⟨⟨a, b⟩, h⟩ := h (default, d), + exact ⟨b, congr_arg prod.snd h⟩, +end⟩, λ h, h.1.prod_map h.2⟩ + +@[simp] lemma map_bijective [nonempty α] [nonempty β] {f : α → γ} {g : β → δ} : + bijective (map f g) ↔ bijective f ∧ bijective g := +begin + haveI := nonempty.map f ‹_›, + haveI := nonempty.map g ‹_›, + exact (map_injective.and map_surjective).trans (and_and_and_comm _ _ _ _) +end + +@[simp] lemma map_left_inverse [nonempty β] [nonempty δ] + {f₁ : α → β} {g₁ : γ → δ} {f₂ : β → α} {g₂ : δ → γ} : + left_inverse (map f₁ g₁) (map f₂ g₂) ↔ left_inverse f₁ f₂ ∧ left_inverse g₁ g₂ := +⟨λ h, ⟨λ b, begin + inhabit δ, + exact congr_arg prod.fst (h (b, default)), +end, λ d, begin + inhabit β, + exact congr_arg prod.snd (h (default, d)), +end⟩, λ h, h.1.prod_map h.2⟩ + +@[simp] lemma map_right_inverse [nonempty α] [nonempty γ] + {f₁ : α → β} {g₁ : γ → δ} {f₂ : β → α} {g₂ : δ → γ} : + right_inverse (map f₁ g₁) (map f₂ g₂) ↔ right_inverse f₁ f₂ ∧ right_inverse g₁ g₂ := +map_left_inverse + +@[simp] lemma map_involutive [nonempty α] [nonempty β] {f : α → α} {g : β → β} : + involutive (map f g) ↔ involutive f ∧ involutive g := +map_left_inverse + +end prod diff --git a/src/data/prod/lex.lean b/src/data/prod/lex.lean new file mode 100644 index 0000000000000..af22f85079807 --- /dev/null +++ b/src/data/prod/lex.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2019 Scott Morrison. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Scott Morrison, Minchao Wu +-/ +import order.bounded_order + +/-! +# Lexicographic order + +> THIS FILE IS SYNCHRONIZED WITH MATHLIB4. +> Any changes to this file require a corresponding PR to mathlib4. + +This file defines the lexicographic relation for pairs of orders, partial orders and linear orders. + +## Main declarations + +* `prod.lex.
order`: Instances lifting the orders on `α` and `β` to `α ×ₗ β`.
+
+## Notation
+
+* `α ×ₗ β`: `α × β` equipped with the lexicographic order
+
+## See also
+
+Related files are:
+* `data.finset.colex`: Colexicographic order on finite sets.
+* `data.list.lex`: Lexicographic order on lists.
+* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`.
+* `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
+* `data.sigma.order`: Lexicographic order on `Σ i, α i`.
+-/
+
+variables {α β γ : Type*}
+
+namespace prod.lex
+
+notation α ` ×ₗ `:35 β:34 := lex (prod α β)
+
+meta instance [has_to_format α] [has_to_format β] : has_to_format (α ×ₗ β) :=
+prod.has_to_format
+
+instance decidable_eq (α β : Type*) [decidable_eq α] [decidable_eq β] : decidable_eq (α ×ₗ β) :=
+prod.decidable_eq
+
+instance inhabited (α β : Type*) [inhabited α] [inhabited β] : inhabited (α ×ₗ β) :=
+prod.inhabited
+
+/-- Dictionary / lexicographic ordering on pairs.  -/
+instance has_le (α β : Type*) [has_lt α] [has_le β] : has_le (α ×ₗ β) :=
+{ le := prod.lex (<) (≤) }
+
+instance has_lt (α β : Type*) [has_lt α] [has_lt β] : has_lt (α ×ₗ β) :=
+{ lt := prod.lex (<) (<) }
+
+lemma le_iff [has_lt α] [has_le β] (a b : α × β) :
+  to_lex a ≤ to_lex b ↔ a.1 < b.1 ∨ a.1 = b.1 ∧ a.2 ≤ b.2 := prod.lex_def (<) (≤)
+
+lemma lt_iff [has_lt α] [has_lt β] (a b : α × β) :
+  to_lex a < to_lex b ↔ a.1 < b.1 ∨ a.1 = b.1 ∧ a.2 < b.2 := prod.lex_def (<) (<)
+
+/-- Dictionary / lexicographic preorder for pairs. -/
+instance preorder (α β : Type*) [preorder α] [preorder β] : preorder (α ×ₗ β) :=
+{ le_refl := refl_of $ prod.lex _ _,
+  le_trans := λ _ _ _, trans_of $ prod.lex _ _,
+  lt_iff_le_not_le := λ x₁ x₂, match x₁, x₂ with
+  | to_lex (a₁, b₁), to_lex (a₂, b₂) := begin
+      split,
+      { rintro (⟨_, _, hlt⟩ | ⟨_, hlt⟩),
+        { split,
+          { left, assumption },
+          { rintro ⟨⟩,
+            { apply lt_asymm hlt, assumption },
+            { apply lt_irrefl _ hlt } } },
+        { split,
+          { right, rw lt_iff_le_not_le at hlt, exact hlt.1 },
+          { rintro ⟨⟩,
+            { apply lt_irrefl a₁, assumption },
+            { rw lt_iff_le_not_le at hlt, apply hlt.2, assumption } } } },
+      { rintros ⟨⟨⟩, h₂r⟩,
+        { left, assumption },
+        { right, rw lt_iff_le_not_le, split,
+          { assumption },
+          { intro h, apply h₂r, right, exact h } } }
+    end
+  end,
+  .. prod.lex.has_le α β,
+  .. prod.lex.has_lt α β }
+
+section preorder
+variables [partial_order α] [preorder β]
+
+lemma to_lex_mono : monotone (to_lex : α × β → α ×ₗ β) :=
+begin
+  rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ ⟨ha, hb⟩,
+  obtain rfl | ha : a₁ = a₂ ∨ _ := ha.eq_or_lt,
+  { exact right _ hb },
+  { exact left _ _ ha }
+end
+
+lemma to_lex_strict_mono : strict_mono (to_lex : α × β → α ×ₗ β) :=
+begin
+  rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h,
+  obtain rfl | ha : a₁ = a₂ ∨ _ := h.le.1.eq_or_lt,
+  { exact right _ (prod.mk_lt_mk_iff_right.1 h) },
+  { exact left _ _ ha }
+end
+
+end preorder
+
+/-- Dictionary / lexicographic partial_order for pairs. -/
+instance partial_order (α β : Type*) [partial_order α] [partial_order β] : partial_order (α ×ₗ β) :=
+{ le_antisymm := by
+  { haveI : is_strict_order α (<) := { irrefl := lt_irrefl, trans := λ _ _ _, lt_trans },
+    haveI : is_antisymm β (≤) := ⟨λ _ _, le_antisymm⟩,
+    exact @antisymm _ (prod.lex _ _) _, },
+  .. prod.lex.preorder α β }
+
+/-- Dictionary / lexicographic linear_order for pairs. -/
+instance linear_order (α β : Type*) [linear_order α] [linear_order β] : linear_order (α ×ₗ β) :=
+{ le_total := total_of (prod.lex _ _),
+  decidable_le := prod.lex.decidable _ _,
+  decidable_lt := prod.lex.decidable _ _,
+  decidable_eq := lex.decidable_eq _ _,
+  .. prod.lex.partial_order α β }
+
+instance order_bot [partial_order α] [preorder β] [order_bot α] [order_bot β] :
+  order_bot (α ×ₗ β) :=
+{ bot := to_lex ⊥,
+  bot_le := λ a, to_lex_mono bot_le }
+
+instance order_top [partial_order α] [preorder β] [order_top α] [order_top β] :
+  order_top (α ×ₗ β) :=
+{ top := to_lex ⊤,
+  le_top := λ a, to_lex_mono le_top }
+
+instance bounded_order [partial_order α] [preorder β] [bounded_order α] [bounded_order β] :
+  bounded_order (α ×ₗ β) :=
+{ ..lex.order_bot, ..lex.order_top }
+
+instance [preorder α] [preorder β] [densely_ordered α] [densely_ordered β] :
+  densely_ordered (α ×ₗ β) :=
+⟨begin
+  rintro _ _ (@⟨a₁, b₁, a₂, b₂, h⟩ | @⟨a, b₁, b₂, h⟩),
+  { obtain ⟨c, h₁, h₂⟩ := exists_between h,
+    exact ⟨(c, b₁), left _ _ h₁, left _ _ h₂⟩ },
+  { obtain ⟨c, h₁, h₂⟩ := exists_between h,
+    exact ⟨(a, c), right _ h₁, right _ h₂⟩ }
+end⟩
+
+instance no_max_order_of_left [preorder α] [preorder β] [no_max_order α] : no_max_order (α ×ₗ β) :=
+⟨by { rintro ⟨a, b⟩, obtain ⟨c, h⟩ := exists_gt a, exact ⟨⟨c, b⟩, left _ _ h⟩ }⟩
+
+instance no_min_order_of_left [preorder α] [preorder β] [no_min_order α] : no_min_order (α ×ₗ β) :=
+⟨by { rintro ⟨a, b⟩, obtain ⟨c, h⟩ := exists_lt a, exact ⟨⟨c, b⟩, left _ _ h⟩ }⟩
+
+instance no_max_order_of_right [preorder α] [preorder β] [no_max_order β] : no_max_order (α ×ₗ β) :=
+⟨by { rintro ⟨a, b⟩, obtain ⟨c, h⟩ := exists_gt b, exact ⟨⟨a, c⟩, right _ h⟩ }⟩
+
+instance no_min_order_of_right [preorder α] [preorder β] [no_min_order β] : no_min_order (α ×ₗ β) :=
+⟨by { rintro ⟨a, b⟩, obtain ⟨c, h⟩ := exists_lt b, exact ⟨⟨a, c⟩, right _ h⟩ }⟩
+
+end prod.lex
diff --git a/src/data/pprod.lean b/src/data/prod/pprod.lean
similarity index 92%
rename from src/data/pprod.lean
rename to src/data/prod/pprod.lean
index 2f91209ec7404..5b1e7f7bfb09f 100644
--- a/src/data/pprod.lean
+++ b/src/data/prod/pprod.lean
@@ -7,6 +7,9 @@ import logic.basic
 
 /-!
 # Extra facts about `pprod`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 open function
diff --git a/src/data/tprod.lean b/src/data/prod/tprod.lean
similarity index 96%
rename from src/data/tprod.lean
rename to src/data/prod/tprod.lean
index a653cb6bcb69c..65718a6766ea0 100644
--- a/src/data/tprod.lean
+++ b/src/data/prod/tprod.lean
@@ -8,6 +8,9 @@ import data.list.nodup
 /-!
 # Finite products of types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the product of types over a list. For `l : list ι` and `α : ι → Type*` we define
 `list.tprod α l = l.foldr (λ i β, α i × β) punit`.
 This type should not be used if `Π i, α i` or `Π i ∈ l, α i` can be used instead
@@ -57,7 +60,7 @@ protected def mk : ∀ (l : list ι) (f : Π i, α i), tprod α l
 | (i :: is) := λ f, (f i, mk is f)
 
 instance [∀ i, inhabited (α i)] : inhabited (tprod α l) :=
-⟨tprod.mk l (λ _, default)⟩
+⟨tprod.mk l default⟩
 
 @[simp] lemma fst_mk (i : ι) (l : list ι) (f : Π i, α i) : (tprod.mk (i::l) f).1 = f i := rfl
 
@@ -141,7 +144,7 @@ end
 lemma elim_preimage_pi [decidable_eq ι] {l : list ι} (hnd : l.nodup) (h : ∀ i, i ∈ l)
   (t : Π i, set (α i)) : tprod.elim' h ⁻¹' pi univ t = set.tprod l t :=
 begin
-  have : { i | i ∈ l} = univ, { ext i, simp [h] },
+  have : { i | i ∈ l } = univ, { ext i, simp [h] },
   rw [← this, ← mk_preimage_tprod, preimage_preimage],
   convert preimage_id, simp [tprod.mk_elim hnd h, id_def]
 end
diff --git a/src/data/psigma/order.lean b/src/data/psigma/order.lean
index f55e5422d27df..d148bc589dbbc 100644
--- a/src/data/psigma/order.lean
+++ b/src/data/psigma/order.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison, Minchao Wu
 -/
 import data.sigma.lex
-import order.lexicographic
+import order.bounded_order
 
 /-!
 # Lexicographic order on a sigma type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the lexicographic order on `Σₗ' i, α i`. `a` is less than `b` if its summand is
 strictly less than the summand of `b` or they are in the same summand and `a` is less than `b`
 there.
@@ -22,8 +25,9 @@ there.
 Related files are:
 * `data.finset.colex`: Colexicographic order on finite sets.
 * `data.list.lex`: Lexicographic order on lists.
+* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`.
 * `data.sigma.order`: Lexicographic order on `Σₗ i, α i`. Basically a twin of this file.
-* `order.lexicographic`: Lexicographic order on `α × β`.
+* `data.prod.lex`: Lexicographic order on `α × β`.
 
 ## TODO
 
@@ -39,19 +43,19 @@ namespace psigma
 
 notation `Σₗ'` binders `, ` r:(scoped p, _root_.lex (psigma p)) := r
 
+namespace lex
+
 /-- The lexicographical `≤` on a sigma type. -/
-instance lex.has_le [has_lt ι] [Π i, has_le (α i)] : has_le (Σₗ' i, α i) :=
-{ le := lex (<) (λ i, (≤)) }
+instance has_le [has_lt ι] [Π i, has_le (α i)] : has_le (Σₗ' i, α i) := ⟨lex (<) (λ i, (≤))⟩
 
 /-- The lexicographical `<` on a sigma type. -/
-instance lex.has_lt [has_lt ι] [Π i, has_lt (α i)] : has_lt (Σₗ' i, α i) :=
-{ lt := lex (<) (λ i, (<)) }
+instance has_lt [has_lt ι] [Π i, has_lt (α i)] : has_lt (Σₗ' i, α i) := ⟨lex (<) (λ i, (<))⟩
 
-instance lex.preorder [preorder ι] [Π i, preorder (α i)] : preorder (Σₗ' i, α i) :=
+instance preorder [preorder ι] [Π i, preorder (α i)] : preorder (Σₗ' i, α i) :=
 { le_refl := λ ⟨i, a⟩, lex.right _ le_rfl,
   le_trans :=
   begin
-    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ ⟨a₃, b₃⟩ ⟨h₁l, h₁r⟩ ⟨h₂l, h₂r⟩,
+    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ ⟨a₃, b₃⟩ ⟨h₁r⟩ ⟨h₂r⟩,
     { left, apply lt_trans, repeat { assumption } },
     { left, assumption },
     { left, assumption },
@@ -60,13 +64,13 @@ instance lex.preorder [preorder ι] [Π i, preorder (α i)] : preorder (Σₗ' i
   lt_iff_le_not_le :=
   begin
     refine λ a b, ⟨λ hab, ⟨hab.mono_right (λ i a b, le_of_lt), _⟩, _⟩,
-    { rintro (⟨j, i, b, a, hji⟩ | ⟨i, b, a, hba⟩);
-        obtain (⟨_, _, _, _, hij⟩ | ⟨_, _, _, hab⟩) := hab,
+    { rintro (⟨i, a, hji⟩ | ⟨i, hba⟩);
+        obtain (⟨_, _, hij⟩ | ⟨_, hab⟩) := hab,
       { exact hij.not_lt hji },
       { exact lt_irrefl _ hji },
       { exact lt_irrefl _ hij },
       { exact hab.not_le hba } },
-    { rintro ⟨⟨i, j, a, b, hij⟩ |⟨i, a, b, hab⟩, hba⟩,
+    { rintro ⟨⟨j, b, hij⟩ | ⟨i, hab⟩, hba⟩,
       { exact lex.left _ _ hij },
       { exact lex.right _ (hab.lt_of_not_le $ λ h, hba $ lex.right _ h) } }
   end,
@@ -74,12 +78,11 @@ instance lex.preorder [preorder ι] [Π i, preorder (α i)] : preorder (Σₗ' i
   .. lex.has_lt }
 
 /-- Dictionary / lexicographic partial_order for dependent pairs. -/
-instance lex.partial_order [partial_order ι] [Π i, partial_order (α i)] :
+instance partial_order [partial_order ι] [Π i, partial_order (α i)] :
   partial_order (Σₗ' i, α i) :=
 { le_antisymm :=
   begin
-    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩
-      (⟨_, _, _, _, hlt₁⟩ | ⟨_, _, _, hlt₁⟩) (⟨_, _, _, _, hlt₂⟩ | ⟨_, _, _, hlt₂⟩),
+    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ (⟨_, _, hlt₁⟩ | ⟨_, hlt₁⟩) (⟨_, _, hlt₂⟩ | ⟨_, hlt₂⟩),
     { exact (lt_irrefl a₁ $ hlt₁.trans hlt₂).elim },
     { exact (lt_irrefl a₁ hlt₁).elim },
     { exact (lt_irrefl a₁ hlt₂).elim },
@@ -88,7 +91,7 @@ instance lex.partial_order [partial_order ι] [Π i, partial_order (α i)] :
   .. lex.preorder }
 
 /-- Dictionary / lexicographic linear_order for pairs. -/
-instance lex.linear_order [linear_order ι] [Π i, linear_order (α i)] : linear_order (Σₗ' i, α i) :=
+instance linear_order [linear_order ι] [Π i, linear_order (α i)] : linear_order (Σₗ' i, α i) :=
 { le_total :=
   begin
   rintro ⟨i, a⟩ ⟨j, b⟩,
@@ -104,4 +107,93 @@ instance lex.linear_order [linear_order ι] [Π i, linear_order (α i)] : linear
   decidable_lt := lex.decidable _ _,
   .. lex.partial_order }
 
+/-- The lexicographical linear order on a sigma type. -/
+instance order_bot [partial_order ι] [order_bot ι] [Π i, preorder (α i)] [order_bot (α ⊥)] :
+  order_bot (Σₗ' i, α i) :=
+{ bot := ⟨⊥, ⊥⟩,
+  bot_le := λ ⟨a, b⟩, begin
+    obtain rfl | ha := eq_bot_or_bot_lt a,
+    { exact lex.right _ bot_le },
+    { exact lex.left _ _ ha }
+  end }
+
+/-- The lexicographical linear order on a sigma type. -/
+instance order_top [partial_order ι] [order_top ι] [Π i, preorder (α i)] [order_top (α ⊤)] :
+  order_top (Σₗ' i, α i) :=
+{ top := ⟨⊤, ⊤⟩,
+  le_top := λ ⟨a, b⟩, begin
+    obtain rfl | ha := eq_top_or_lt_top a,
+    { exact lex.right _ le_top },
+    { exact lex.left _ _ ha }
+  end }
+
+/-- The lexicographical linear order on a sigma type. -/
+instance bounded_order [partial_order ι] [bounded_order ι] [Π i, preorder (α i)]
+  [order_bot (α ⊥)] [order_top (α ⊤)] :
+  bounded_order (Σₗ' i, α i) :=
+{ .. lex.order_bot, .. lex.order_top }
+
+instance densely_ordered [preorder ι] [densely_ordered ι] [Π i, nonempty (α i)]
+  [Π i, preorder (α i)] [Π i, densely_ordered (α i)] :
+  densely_ordered (Σₗ' i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | @⟨_, _, b, h⟩),
+  { obtain ⟨k, hi, hj⟩ := exists_between h,
+    obtain ⟨c⟩ : nonempty (α k) := infer_instance,
+    exact ⟨⟨k, c⟩, left _ _ hi, left _ _ hj⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h,
+    exact ⟨⟨i, c⟩, right _ ha, right _ hb⟩ }
+end⟩
+
+instance densely_ordered_of_no_max_order [preorder ι] [Π i, preorder (α i)]
+  [Π i, densely_ordered (α i)] [Π i, no_max_order (α i)] :
+  densely_ordered (Σₗ' i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | @⟨_, _, b, h⟩),
+  { obtain ⟨c, ha⟩ := exists_gt a,
+    exact ⟨⟨i, c⟩, right _ ha, left _ _ h⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h,
+    exact ⟨⟨i, c⟩, right _ ha, right _ hb⟩ }
+end⟩
+
+instance densely_ordered_of_no_min_order [preorder ι] [Π i, preorder (α i)]
+  [Π i, densely_ordered (α i)] [Π i, no_min_order (α i)] :
+  densely_ordered (Σₗ' i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | @⟨_, _, b, h⟩),
+  { obtain ⟨c, hb⟩ := exists_lt b,
+    exact ⟨⟨j, c⟩, left _ _ h, right _ hb⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h,
+    exact ⟨⟨i, c⟩, right _ ha, right _ hb⟩ }
+end⟩
+
+instance no_max_order_of_nonempty [preorder ι] [Π i, preorder (α i)] [no_max_order ι]
+  [Π i, nonempty (α i)] :
+  no_max_order (Σₗ' i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩,
+  obtain ⟨j, h⟩ := exists_gt i,
+  obtain ⟨b⟩ : nonempty (α j) := infer_instance,
+  exact ⟨⟨j, b⟩, left _ _ h⟩
+end⟩
+
+instance no_min_order_of_nonempty [preorder ι] [Π i, preorder (α i)] [no_max_order ι]
+  [Π i, nonempty (α i)] :
+  no_max_order (Σₗ' i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩,
+  obtain ⟨j, h⟩ := exists_gt i,
+  obtain ⟨b⟩ : nonempty (α j) := infer_instance,
+  exact ⟨⟨j, b⟩, left _ _ h⟩
+end⟩
+
+instance no_max_order [preorder ι] [Π i, preorder (α i)] [Π i, no_max_order (α i)] :
+  no_max_order (Σₗ' i, α i) :=
+⟨by { rintro ⟨i, a⟩, obtain ⟨b, h⟩ := exists_gt a, exact ⟨⟨i, b⟩, right _ h⟩ }⟩
+
+instance no_min_order [preorder ι] [Π i, preorder (α i)] [Π i, no_min_order (α i)] :
+  no_min_order (Σₗ' i, α i) :=
+⟨by { rintro ⟨i, a⟩, obtain ⟨b, h⟩ := exists_lt a, exact ⟨⟨i, b⟩, right _ h⟩ }⟩
+
+end lex
 end psigma
diff --git a/src/data/qpf/multivariate/basic.lean b/src/data/qpf/multivariate/basic.lean
index 6b47237bf5943..3aba3258e6ac9 100644
--- a/src/data/qpf/multivariate/basic.lean
+++ b/src/data/qpf/multivariate/basic.lean
@@ -8,6 +8,9 @@ import data.pfunctor.multivariate.basic
 /-!
 # Multivariate quotients of polynomial functors.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Basic definition of multivariate QPF. QPFs form a compositional framework
 for defining inductive and coinductive types, their quotients and nesting.
 
diff --git a/src/data/qpf/multivariate/constructions/cofix.lean b/src/data/qpf/multivariate/constructions/cofix.lean
index b82c606ffc231..93bc6f9098c1e 100644
--- a/src/data/qpf/multivariate/constructions/cofix.lean
+++ b/src/data/qpf/multivariate/constructions/cofix.lean
@@ -12,6 +12,9 @@ import data.qpf.multivariate.basic
 /-!
 # The final co-algebra of a multivariate qpf is again a qpf.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For a `(n+1)`-ary QPF `F (α₀,..,αₙ)`, we take the least fixed point of `F` with
 regards to its last argument `αₙ`. The result is a `n`-ary functor: `fix F (α₀,..,αₙ₋₁)`.
 Making `fix F` into a functor allows us to take the fixed point, compose with other functors
@@ -20,17 +23,17 @@ and take a fixed point again.
 ## Main definitions
 
  * `cofix.mk`     - constructor
- * `cofix.dest    - destructor
+ * `cofix.dest`   - destructor
  * `cofix.corec`  - corecursor: useful for formulating infinite, productive computations
  * `cofix.bisim`  - bisimulation: proof technique to show the equality of possibly infinite values
                     of `cofix F α`
 
 ## Implementation notes
 
-For `F` a QPF`, we define `cofix F α` in terms of the M-type of the polynomial functor `P` of `F`.
+For `F` a QPF, we define `cofix F α` in terms of the M-type of the polynomial functor `P` of `F`.
 We define the relation `Mcongr` and take its quotient as the definition of `cofix F α`.
 
-`Mcongr` is taken as the weakest bisimulation on M-type.  See
+`Mcongr` is taken as the weakest bisimulation on M-type. See
 [avigad-carneiro-hudon2019] for more details.
 
 ## Reference
@@ -423,7 +426,7 @@ do e ← to_expr e,
    R ← pose `R none ex,
    refine ``(cofix.bisim₂ %%R _ _ _ ⟨_,rfl,rfl⟩),
    let f (a b : name) : name := if a = `_ then b else a,
-   let ids := (ids ++ list.repeat `_ 5).zip_with f [`a,`b,`x,`Ha,`Hb],
+   let ids := (ids ++ list.replicate 5 `_).zip_with f [`a,`b,`x,`Ha,`Hb],
    (ids₀,w::ids₁) ← pure $ list.split_at 2 ids,
    intro_lst ids₀,
    h ← intro1,
diff --git a/src/data/qpf/multivariate/constructions/comp.lean b/src/data/qpf/multivariate/constructions/comp.lean
index 00e56d65ee4c5..2d5b9260590d3 100644
--- a/src/data/qpf/multivariate/constructions/comp.lean
+++ b/src/data/qpf/multivariate/constructions/comp.lean
@@ -10,6 +10,9 @@ import data.qpf.multivariate.basic
 /-!
 # The composition of QPFs is itself a QPF
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define composition between one `n`-ary functor and `n` `m`-ary functors
 and show that it preserves the QPF structure
 -/
diff --git a/src/data/qpf/multivariate/constructions/const.lean b/src/data/qpf/multivariate/constructions/const.lean
index 113adf4a31bb3..f3c9b395698d4 100644
--- a/src/data/qpf/multivariate/constructions/const.lean
+++ b/src/data/qpf/multivariate/constructions/const.lean
@@ -10,6 +10,9 @@ import data.qpf.multivariate.basic
 /-!
 # Constant functors are QPFs
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Constant functors map every type vectors to the same target type. This
 is a useful device for constructing data types from more basic types
 that are not actually functorial. For instance `const n nat` makes
diff --git a/src/data/qpf/multivariate/constructions/fix.lean b/src/data/qpf/multivariate/constructions/fix.lean
index 2d6733aa52772..2c1c33ceed19e 100644
--- a/src/data/qpf/multivariate/constructions/fix.lean
+++ b/src/data/qpf/multivariate/constructions/fix.lean
@@ -9,6 +9,9 @@ import data.qpf.multivariate.basic
 /-!
 # The initial algebra of a multivariate qpf is again a qpf.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For a `(n+1)`-ary QPF `F (α₀,..,αₙ)`, we take the least fixed point of `F` with
 regards to its last argument `αₙ`. The result is a `n`-ary functor: `fix F (α₀,..,αₙ₋₁)`.
 Making `fix F` into a functor allows us to take the fixed point, compose with other functors
@@ -184,7 +187,7 @@ fix F a b = F a b (fix F a b)
 def fix {n : ℕ} (F : typevec (n+1) → Type*) [mvfunctor F] [q : mvqpf F] (α : typevec n) :=
 quotient (W_setoid α : setoid (q.P.W α))
 
-attribute [nolint has_inhabited_instance] fix
+attribute [nolint has_nonempty_instance] fix
 
 /-- `fix F` is a functor -/
 def fix.map {α β : typevec n} (g : α ⟹ β) : fix F α → fix F β :=
diff --git a/src/data/qpf/multivariate/constructions/prj.lean b/src/data/qpf/multivariate/constructions/prj.lean
index e27a1be1f8700..959e3d1617b7c 100644
--- a/src/data/qpf/multivariate/constructions/prj.lean
+++ b/src/data/qpf/multivariate/constructions/prj.lean
@@ -8,6 +8,9 @@ import control.functor.multivariate
 import data.qpf.multivariate.basic
 
 /-!
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Projection functors are QPFs. The `n`-ary projection functors on `i` is an `n`-ary
 functor `F` such that `F (α₀..αᵢ₋₁, αᵢ, αᵢ₊₁..αₙ₋₁) = αᵢ`
 -/
diff --git a/src/data/qpf/multivariate/constructions/quot.lean b/src/data/qpf/multivariate/constructions/quot.lean
index d85cbbf011d42..0869d40073f28 100644
--- a/src/data/qpf/multivariate/constructions/quot.lean
+++ b/src/data/qpf/multivariate/constructions/quot.lean
@@ -9,6 +9,9 @@ import data.qpf.multivariate.basic
 /-!
 # The quotient of QPF is itself a QPF
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The quotients are here defined using a surjective function and
 its right inverse. They are very similar to the `abs` and `repr`
 functions found in the definition of `mvqpf`
diff --git a/src/data/qpf/multivariate/constructions/sigma.lean b/src/data/qpf/multivariate/constructions/sigma.lean
index 98bc5f1c1ace7..462edb0482310 100644
--- a/src/data/qpf/multivariate/constructions/sigma.lean
+++ b/src/data/qpf/multivariate/constructions/sigma.lean
@@ -9,6 +9,9 @@ import data.qpf.multivariate.basic
 
 /-!
 # Dependent product and sum of QPFs are QPFs
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 universes u
@@ -30,10 +33,10 @@ def pi (v : typevec.{u} n) : Type.{u} :=
 Π α : A, F α v
 
 instance sigma.inhabited {α} [inhabited A] [inhabited (F default α)] : inhabited (sigma F α) :=
-⟨ ⟨default, default⟩ ⟩
+⟨⟨default, default⟩⟩
 
 instance pi.inhabited {α} [Π a, inhabited (F a α)] : inhabited (pi F α) :=
-⟨ λ a, default ⟩
+⟨λ a, default⟩
 
 variables [Π α, mvfunctor $ F α]
 
@@ -86,7 +89,7 @@ protected def abs ⦃α⦄ : (pi.P F).obj α → pi F α
 /-- representation function for dependent products -/
 protected def repr ⦃α⦄ : pi F α → (pi.P F).obj α
 | f :=
-  ⟨ λ a, (mvqpf.repr (f a)).1, λ i a, (@mvqpf.repr _ _ _ (_inst_2 _) _ (f _)).2 _ a.2 ⟩
+  ⟨ λ a, (mvqpf.repr (f a)).1, λ i a, (mvqpf.repr (f _)).2 _ a.2 ⟩
 
 instance : mvqpf (pi F) :=
 { P := pi.P F,
diff --git a/src/data/qpf/multivariate/default.lean b/src/data/qpf/multivariate/default.lean
deleted file mode 100644
index 60fe082964167..0000000000000
--- a/src/data/qpf/multivariate/default.lean
+++ /dev/null
@@ -1,9 +0,0 @@
-
-import data.qpf.multivariate.basic
-import data.qpf.multivariate.constructions.fix
-import data.qpf.multivariate.constructions.cofix
-import data.qpf.multivariate.constructions.comp
-import data.qpf.multivariate.constructions.quot
-import data.qpf.multivariate.constructions.prj
-import data.qpf.multivariate.constructions.const
-import data.qpf.multivariate.constructions.sigma
diff --git a/src/data/qpf/univariate/basic.lean b/src/data/qpf/univariate/basic.lean
index 271577b624e48..0d83b3146acdb 100644
--- a/src/data/qpf/univariate/basic.lean
+++ b/src/data/qpf/univariate/basic.lean
@@ -9,6 +9,9 @@ import data.pfunctor.univariate.M
 
 # Quotients of Polynomial Functors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We assume the following:
 
 `P`   : a polynomial functor
@@ -213,7 +216,7 @@ def W_setoid : setoid q.P.W :=
 local attribute [instance] W_setoid
 
 /-- inductive type defined as initial algebra of a Quotient of Polynomial Functor -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def fix (F : Type u → Type u) [functor F] [q : qpf F] := quotient (W_setoid : setoid q.P.W)
 
 /-- recursor of a type defined by a qpf -/
diff --git a/src/data/quot.lean b/src/data/quot.lean
index 6f32e7c9e1e52..fac3f392436ed 100644
--- a/src/data/quot.lean
+++ b/src/data/quot.lean
@@ -8,6 +8,9 @@ import logic.relator
 /-!
 # Quotient types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This module extends the core library's treatment of quotient types (`init.data.quot`).
 
 ## Tags
@@ -17,6 +20,8 @@ quotient
 
 variables {α : Sort*} {β : Sort*}
 
+open function
+
 namespace setoid
 
 lemma ext {α : Sort*} :
@@ -29,7 +34,7 @@ end setoid
 
 namespace quot
 variables {ra : α → α → Prop} {rb : β → β → Prop} {φ : quot ra → quot rb → Sort*}
-local notation `⟦`:max a `⟧` := quot.mk _ a
+local notation (name := mk) `⟦`:max a `⟧` := quot.mk _ a
 
 instance (r : α → α → Prop) [inhabited α] : inhabited (quot r) := ⟨⟦default⟧⟩
 
@@ -69,12 +74,16 @@ variables {γ : Sort*} {r : α → α → Prop} {s : β → β → Prop}
 
 /-- **Alias** of `quot.lift_beta`. -/
 lemma lift_mk (f : α → γ) (h : ∀ a₁ a₂, r a₁ a₂ → f a₁ = f a₂) (a : α) :
-  quot.lift f h (quot.mk r a) = f a := quot.lift_beta f h a
+  quot.lift f h (quot.mk r a) = f a := rfl
 
 @[simp]
 lemma lift_on_mk (a : α) (f : α → γ) (h : ∀ a₁ a₂, r a₁ a₂ → f a₁ = f a₂) :
   quot.lift_on (quot.mk r a) f h = f a := rfl
 
+@[simp] lemma surjective_lift {f : α → γ} (h : ∀ a₁ a₂, r a₁ a₂ → f a₁ = f a₂) :
+  surjective (lift f h) ↔ surjective f :=
+⟨λ hf, hf.comp quot.exists_rep, λ hf y, let ⟨x, hx⟩ := hf y in ⟨quot.mk _ x, hx⟩⟩
+
 /-- Descends a function `f : α → β → γ` to quotients of `α` and `β`. -/
 attribute [reducible, elab_as_eliminator]
 protected def lift₂
@@ -174,6 +183,11 @@ instance (s : setoid α) [inhabited α] : inhabited (quotient s) := ⟨⟦defaul
 instance (s : setoid α) [subsingleton α] : subsingleton (quotient s) :=
 quot.subsingleton
 
+instance {α : Type*} [setoid α] : is_equiv α (≈) :=
+{ refl := setoid.refl,
+  symm := λ a b, setoid.symm,
+  trans := λ a b c, setoid.trans }
+
 /-- Induction on two `quotient` arguments `a` and `b`, result type depends on `⟦a⟧` and `⟦b⟧`. -/
 protected def hrec_on₂ (qa : quotient sa) (qb : quotient sb) (f : Π a b, φ ⟦a⟧ ⟦b⟧)
   (c : ∀ a₁ b₁ a₂ b₂, a₁ ≈ a₂ → b₁ ≈ b₂ → f a₁ b₁ == f a₂ b₂) : φ qa qb :=
@@ -263,12 +277,11 @@ rfl
   quotient.lift_on₂ (quotient.mk x) (quotient.mk y) f h = f x y := rfl
 
 /-- `quot.mk r` is a surjective function. -/
-lemma surjective_quot_mk (r : α → α → Prop) : function.surjective (quot.mk r) :=
-quot.exists_rep
+lemma surjective_quot_mk (r : α → α → Prop) : surjective (quot.mk r) := quot.exists_rep
 
 /-- `quotient.mk` is a surjective function. -/
 lemma surjective_quotient_mk (α : Sort*) [s : setoid α] :
-  function.surjective (quotient.mk : α → quotient s) :=
+  surjective (quotient.mk : α → quotient s) :=
 quot.exists_rep
 
 /-- Choose an element of the equivalence class using the axiom of choice.
@@ -310,7 +323,7 @@ end
   x.out ≈ y.out ↔ x = y :=
 by rw [← quotient.eq_mk_iff_out, quotient.out_eq]
 
-lemma quotient.out_injective {s : setoid α} : function.injective (@quotient.out α s) :=
+lemma quotient.out_injective {s : setoid α} : injective (@quotient.out α s) :=
 λ a b h, quotient.out_equiv_out.1 $ h ▸ setoid.refl _
 
 @[simp] lemma quotient.out_inj {s : setoid α} {x y : quotient s} :
@@ -352,15 +365,21 @@ lemma nonempty_quotient_iff (s : setoid α) : nonempty (quotient s) ↔ nonempty
 
 /-! ### Truncation -/
 
+theorem true_equivalence : @equivalence α (λ _ _, true) :=
+⟨λ _, trivial, λ _ _ _, trivial, λ _ _ _ _ _, trivial⟩
+
+/-- Always-true relation as a `setoid`.
+
+Note that in later files the preferred spelling is `⊤ : setoid α`. -/
+def true_setoid : setoid α :=
+⟨_, true_equivalence⟩
+
 /-- `trunc α` is the quotient of `α` by the always-true relation. This
   is related to the propositional truncation in HoTT, and is similar
   in effect to `nonempty α`, but unlike `nonempty α`, `trunc α` is data,
   so the VM representation is the same as `α`, and so this can be used to
   maintain computability. -/
-def {u} trunc (α : Sort u) : Sort u := @quot α (λ _ _, true)
-
-theorem true_equivalence : @equivalence α (λ _ _, true) :=
-⟨λ _, trivial, λ _ _ _, trivial, λ _ _ _ _ _, trivial⟩
+def {u} trunc (α : Sort u) : Sort u := @quotient α true_setoid
 
 namespace trunc
 
@@ -460,7 +479,7 @@ instance argument. -/
 protected def mk' (a : α) : quotient s₁ := quot.mk s₁.1 a
 
 /-- `quotient.mk'` is a surjective function. -/
-lemma surjective_quotient_mk' : function.surjective (quotient.mk' : α → quotient s₁) :=
+lemma surjective_quotient_mk' : surjective (quotient.mk' : α → quotient s₁) :=
 quot.exists_rep
 
 /-- A version of `quotient.lift_on` taking `{s : setoid α}` as an implicit argument instead of an
@@ -473,6 +492,10 @@ protected def lift_on' (q : quotient s₁) (f : α → φ)
 protected lemma lift_on'_mk' (f : α → φ) (h) (x : α) :
   quotient.lift_on' (@quotient.mk' _ s₁ x) f h = f x := rfl
 
+@[simp] lemma surjective_lift_on' {f : α → φ} (h : ∀ a b, @setoid.r α s₁ a b → f a = f b) :
+  surjective (λ x, quotient.lift_on' x f h) ↔ surjective f :=
+quot.surjective_lift _
+
 /-- A version of `quotient.lift_on₂` taking `{s₁ : setoid α} {s₂ : setoid β}` as implicit arguments
 instead of instance arguments. -/
 @[elab_as_eliminator, reducible]
diff --git a/src/data/rat/basic.lean b/src/data/rat/basic.lean
index 520e4e6214389..c251ff288ed30 100644
--- a/src/data/rat/basic.lean
+++ b/src/data/rat/basic.lean
@@ -3,812 +3,52 @@ Copyright (c) 2019 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
-import algebra.euclidean_domain
-import data.int.cast
-import data.nat.gcd
-import logic.encodable.basic
+import algebra.field.defs
+import data.rat.defs
 
 /-!
-# Basics for the Rational Numbers
+# Field Structure on the Rational Numbers
 
-## Summary
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-We define a rational number `q` as a structure `{ num, denom, pos, cop }`, where
-- `num` is the numerator of `q`,
-- `denom` is the denominator of `q`,
-- `pos` is a proof that `denom > 0`, and
-- `cop` is a proof `num` and `denom` are coprime.
+## Summary
 
-We then define the expected (discrete) field structure on `ℚ` and prove basic lemmas about it.
-Moreoever, we provide the expected casts from `ℕ` and `ℤ` into `ℚ`, i.e. `(↑n : ℚ) = n / 1`.
+We put the (discrete) field structure on the type `ℚ` of rational numbers that
+was defined in `data.rat.defs`.
 
 ## Main Definitions
 
-- `rat` is the structure encoding `ℚ`.
-- `rat.mk n d` constructs a rational number `q = n / d` from `n d : ℤ`.
+- `rat.field` is the field structure on `ℚ`.
 
-## Notations
+## Implementation notes
 
-- `/.` is infix notation for `rat.mk`.
+We have to define the field structure in a separate file to avoid cyclic imports:
+the `field` class contains a map from `ℚ` (see `field`'s docstring for the rationale),
+so we have a dependency `rat.field → field → rat` that is reflected in the import
+hierarchy `data.rat.basic → algebra.field.basic → data.rat.defs`.
 
 ## Tags
 
 rat, rationals, field, ℚ, numerator, denominator, num, denom
 -/
 
-/-- `rat`, or `ℚ`, is the type of rational numbers. It is defined
-  as the set of pairs ⟨n, d⟩ of integers such that `d` is positive and `n` and
-  `d` are coprime. This representation is preferred to the quotient
-  because without periodic reduction, the numerator and denominator can grow
-  exponentially (for example, adding 1/2 to itself repeatedly). -/
-structure rat := mk' ::
-(num : ℤ)
-(denom : ℕ)
-(pos : 0 < denom)
-(cop : num.nat_abs.coprime denom)
-notation `ℚ` := rat
-
 namespace rat
 
-/-- String representation of a rational numbers, used in `has_repr`, `has_to_string`, and
-`has_to_format` instances. -/
-protected def repr : ℚ → string
-| ⟨n, d, _, _⟩ := if d = 1 then _root_.repr n else
-  _root_.repr n ++ "/" ++ _root_.repr d
-
-instance : has_repr ℚ := ⟨rat.repr⟩
-instance : has_to_string ℚ := ⟨rat.repr⟩
-meta instance : has_to_format ℚ := ⟨coe ∘ rat.repr⟩
-
-instance : encodable ℚ := encodable.of_equiv (Σ n : ℤ, {d : ℕ // 0 < d ∧ n.nat_abs.coprime d})
-  ⟨λ ⟨a, b, c, d⟩, ⟨a, b, c, d⟩, λ⟨a, b, c, d⟩, ⟨a, b, c, d⟩,
-   λ ⟨a, b, c, d⟩, rfl, λ⟨a, b, c, d⟩, rfl⟩
-
-/-- Embed an integer as a rational number -/
-def of_int (n : ℤ) : ℚ :=
-⟨n, 1, nat.one_pos, nat.coprime_one_right _⟩
-
-instance : has_zero ℚ := ⟨of_int 0⟩
-instance : has_one ℚ := ⟨of_int 1⟩
-instance : inhabited ℚ := ⟨0⟩
-
-lemma ext_iff {p q : ℚ} : p = q ↔ p.num = q.num ∧ p.denom = q.denom :=
-by { cases p, cases q, simp }
-
-@[ext] lemma ext {p q : ℚ} (hn : p.num = q.num) (hd : p.denom = q.denom) : p = q :=
-rat.ext_iff.mpr ⟨hn, hd⟩
-
-/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ+` (not necessarily coprime) -/
-def mk_pnat (n : ℤ) : ℕ+ → ℚ | ⟨d, dpos⟩ :=
-let n' := n.nat_abs, g := n'.gcd d in
-⟨n / g, d / g, begin
-  apply (nat.le_div_iff_mul_le _ _ (nat.gcd_pos_of_pos_right _ dpos)).2,
-  rw one_mul, exact nat.le_of_dvd dpos (nat.gcd_dvd_right _ _)
-end, begin
-  have : int.nat_abs (n / ↑g) = n' / g,
-  { cases int.nat_abs_eq n with e e; rw e, { refl },
-    rw [int.neg_div_of_dvd, int.nat_abs_neg], { refl },
-    exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) },
-  rw this,
-  exact nat.coprime_div_gcd_div_gcd (nat.gcd_pos_of_pos_right _ dpos)
-end⟩
-
-/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ`. In the case `d = 0`, we
-  define `n / 0 = 0` by convention. -/
-def mk_nat (n : ℤ) (d : ℕ) : ℚ :=
-if d0 : d = 0 then 0 else mk_pnat n ⟨d, nat.pos_of_ne_zero d0⟩
-
-/-- Form the quotient `n / d` where `n d : ℤ`. -/
-def mk : ℤ → ℤ → ℚ
-| n (d : ℕ) := mk_nat n d
-| n -[1+ d] := mk_pnat (-n) d.succ_pnat
-
-localized "infix ` /. `:70 := rat.mk" in rat
-
-theorem mk_pnat_eq (n d h) : mk_pnat n ⟨d, h⟩ = n /. d :=
-by change n /. d with dite _ _ _; simp [ne_of_gt h]
-
-theorem mk_nat_eq (n d) : mk_nat n d = n /. d := rfl
-
-@[simp] theorem mk_zero (n) : n /. 0 = 0 := rfl
-
-@[simp] theorem zero_mk_pnat (n) : mk_pnat 0 n = 0 :=
-begin
-  cases n with n npos,
-  simp only [mk_pnat, int.nat_abs_zero, nat.div_self npos, nat.gcd_zero_left, int.zero_div],
-  refl
-end
-
-@[simp] theorem zero_mk_nat (n) : mk_nat 0 n = 0 :=
-by by_cases n = 0; simp [*, mk_nat]
-
-@[simp] theorem zero_mk (n) : 0 /. n = 0 :=
-by cases n; simp [mk]
-
-private lemma gcd_abs_dvd_left {a b} : (nat.gcd (int.nat_abs a) b : ℤ) ∣ a :=
-int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ nat.gcd_dvd_left (int.nat_abs a) b
-
-@[simp] theorem mk_eq_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b = 0 ↔ a = 0 :=
-begin
-  refine ⟨λ h, _, by { rintro rfl, simp }⟩,
-  have : ∀ {a b}, mk_pnat a b = 0 → a = 0,
-  { rintro a ⟨b, h⟩ e,
-    injection e with e,
-    apply int.eq_mul_of_div_eq_right gcd_abs_dvd_left e },
-  cases b with b; simp only [mk, mk_nat, int.of_nat_eq_coe, dite_eq_left_iff] at h,
-  { simp only [mt (congr_arg int.of_nat) b0, not_false_iff, forall_true_left] at h,
-    exact this h },
-  { apply neg_injective, simp [this h] }
-end
-
-theorem mk_ne_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b ≠ 0 ↔ a ≠ 0 :=
-(mk_eq_zero b0).not
-
-theorem mk_eq : ∀ {a b c d : ℤ} (hb : b ≠ 0) (hd : d ≠ 0),
-  a /. b = c /. d ↔ a * d = c * b :=
-suffices ∀ a b c d hb hd, mk_pnat a ⟨b, hb⟩ = mk_pnat c ⟨d, hd⟩ ↔ a * d = c * b,
-begin
-  intros, cases b with b b; simp [mk, mk_nat, nat.succ_pnat],
-  simp [mt (congr_arg int.of_nat) hb],
-  all_goals
-  { cases d with d d; simp [mk, mk_nat, nat.succ_pnat],
-    simp [mt (congr_arg int.of_nat) hd],
-    all_goals { rw this, try {refl} } },
-  { change a * ↑(d.succ) = -c * ↑b ↔ a * -(d.succ) = c * b,
-    constructor; intro h; apply neg_injective; simpa [left_distrib, neg_add_eq_iff_eq_add,
-      eq_neg_iff_add_eq_zero, neg_eq_iff_add_eq_zero] using h },
-  { change -a * ↑d = c * b.succ ↔ a * d = c * -b.succ,
-    constructor; intro h; apply neg_injective; simpa [left_distrib, eq_comm] using h },
-  { change -a * d.succ = -c * b.succ ↔ a * -d.succ = c * -b.succ,
-    simp [left_distrib, sub_eq_add_neg], cc }
-end,
-begin
-  intros, simp [mk_pnat], constructor; intro h,
-  { cases h with ha hb,
-    have ha,
-    { have dv := @gcd_abs_dvd_left,
-      have := int.eq_mul_of_div_eq_right dv ha,
-      rw ← int.mul_div_assoc _ dv at this,
-      exact int.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
-    have hb,
-    { have dv := λ {a b}, nat.gcd_dvd_right (int.nat_abs a) b,
-      have := nat.eq_mul_of_div_eq_right dv hb,
-      rw ← nat.mul_div_assoc _ dv at this,
-      exact nat.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
-    have m0 : (a.nat_abs.gcd b * c.nat_abs.gcd d : ℤ) ≠ 0,
-    { refine int.coe_nat_ne_zero.2 (ne_of_gt _),
-      apply mul_pos; apply nat.gcd_pos_of_pos_right; assumption },
-    apply mul_right_cancel₀ m0,
-    simpa [mul_comm, mul_left_comm] using
-      congr (congr_arg (*) ha.symm) (congr_arg coe hb) },
-  { suffices : ∀ a c, a * d = c * b →
-      a / a.gcd b = c / c.gcd d ∧ b / a.gcd b = d / c.gcd d,
-    { cases this a.nat_abs c.nat_abs
-        (by simpa [int.nat_abs_mul] using congr_arg int.nat_abs h) with h₁ h₂,
-      have hs := congr_arg int.sign h,
-      simp [int.sign_eq_one_of_pos (int.coe_nat_lt.2 hb),
-            int.sign_eq_one_of_pos (int.coe_nat_lt.2 hd)] at hs,
-      conv in a { rw ← int.sign_mul_nat_abs a },
-      conv in c { rw ← int.sign_mul_nat_abs c },
-      rw [int.mul_div_assoc, int.mul_div_assoc],
-      exact ⟨congr (congr_arg (*) hs) (congr_arg coe h₁), h₂⟩,
-      all_goals { exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) } },
-    intros a c h,
-    suffices bd : b / a.gcd b = d / c.gcd d,
-    { refine ⟨_, bd⟩,
-      apply nat.eq_of_mul_eq_mul_left hb,
-      rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _), mul_comm,
-          nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), bd,
-          ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), h, mul_comm,
-          nat.mul_div_assoc _ (nat.gcd_dvd_left _ _)] },
-    suffices : ∀ {a c : ℕ} (b>0) (d>0),
-      a * d = c * b → b / a.gcd b ≤ d / c.gcd d,
-    { exact le_antisymm (this _ hb _ hd h) (this _ hd _ hb h.symm) },
-    intros a c b hb d hd h,
-    have gb0 := nat.gcd_pos_of_pos_right a hb,
-    have gd0 := nat.gcd_pos_of_pos_right c hd,
-    apply nat.le_of_dvd,
-    apply (nat.le_div_iff_mul_le _ _ gd0).2,
-    simp, apply nat.le_of_dvd hd (nat.gcd_dvd_right _ _),
-    apply (nat.coprime_div_gcd_div_gcd gb0).symm.dvd_of_dvd_mul_left,
-    refine ⟨c / c.gcd d, _⟩,
-    rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
-        ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _)],
-    apply congr_arg (/ c.gcd d),
-    rw [mul_comm, ← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
-        mul_comm, h, nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), mul_comm] }
-end
-
-@[simp] theorem div_mk_div_cancel_left {a b c : ℤ} (c0 : c ≠ 0) :
-  (a * c) /. (b * c) = a /. b :=
-begin
-  by_cases b0 : b = 0, { subst b0, simp },
-  apply (mk_eq (mul_ne_zero b0 c0) b0).2, simp [mul_comm, mul_assoc]
-end
-
-@[simp] theorem num_denom : ∀ {a : ℚ}, a.num /. a.denom = a
-| ⟨n, d, h, (c:_=1)⟩ := show mk_nat n d = _,
-  by simp [mk_nat, ne_of_gt h, mk_pnat, c]
-
-theorem num_denom' {n d h c} : (⟨n, d, h, c⟩ : ℚ) = n /. d := num_denom.symm
-
-theorem of_int_eq_mk (z : ℤ) : of_int z = z /. 1 := num_denom'
-
-/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
-numbers of the form `n /. d` with `0 < d` and coprime `n`, `d`. -/
-@[elab_as_eliminator] def {u} num_denom_cases_on {C : ℚ → Sort u}
-   : ∀ (a : ℚ) (H : ∀ n d, 0 < d → (int.nat_abs n).coprime d → C (n /. d)), C a
-| ⟨n, d, h, c⟩ H := by rw num_denom'; exact H n d h c
-
-/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
-numbers of the form `n /. d` with `d ≠ 0`. -/
-@[elab_as_eliminator] def {u} num_denom_cases_on' {C : ℚ → Sort u}
-   (a : ℚ) (H : ∀ (n:ℤ) (d:ℕ), d ≠ 0 → C (n /. d)) : C a :=
-num_denom_cases_on a $ λ n d h c, H n d h.ne'
-
-theorem num_dvd (a) {b : ℤ} (b0 : b ≠ 0) : (a /. b).num ∣ a :=
-begin
-  cases e : a /. b with n d h c,
-  rw [rat.num_denom', rat.mk_eq b0
-    (ne_of_gt (int.coe_nat_pos.2 h))] at e,
-  refine (int.nat_abs_dvd.1 $ int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $
-    c.dvd_of_dvd_mul_right _),
-  have := congr_arg int.nat_abs e,
-  simp only [int.nat_abs_mul, int.nat_abs_of_nat] at this, simp [this]
-end
-
-theorem denom_dvd (a b : ℤ) : ((a /. b).denom : ℤ) ∣ b :=
-begin
-  by_cases b0 : b = 0, {simp [b0]},
-  cases e : a /. b with n d h c,
-  rw [num_denom', mk_eq b0 (ne_of_gt (int.coe_nat_pos.2 h))] at e,
-  refine (int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ c.symm.dvd_of_dvd_mul_left _),
-  rw [← int.nat_abs_mul, ← int.coe_nat_dvd, int.dvd_nat_abs, ← e], simp
-end
-
-/-- Addition of rational numbers. Use `(+)` instead. -/
-protected def add : ℚ → ℚ → ℚ
-| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * d₂ + n₂ * d₁) ⟨d₁ * d₂, mul_pos h₁ h₂⟩
-
-instance : has_add ℚ := ⟨rat.add⟩
-
-theorem lift_binop_eq (f : ℚ → ℚ → ℚ) (f₁ : ℤ → ℤ → ℤ → ℤ → ℤ) (f₂ : ℤ → ℤ → ℤ → ℤ → ℤ)
-  (fv : ∀ {n₁ d₁ h₁ c₁ n₂ d₂ h₂ c₂},
-    f ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ = f₁ n₁ d₁ n₂ d₂ /. f₂ n₁ d₁ n₂ d₂)
-  (f0 : ∀ {n₁ d₁ n₂ d₂} (d₁0 : d₁ ≠ 0) (d₂0 : d₂ ≠ 0), f₂ n₁ d₁ n₂ d₂ ≠ 0)
-  (a b c d : ℤ) (b0 : b ≠ 0) (d0 : d ≠ 0)
-  (H : ∀ {n₁ d₁ n₂ d₂} (h₁ : a * d₁ = n₁ * b) (h₂ : c * d₂ = n₂ * d),
-       f₁ n₁ d₁ n₂ d₂ * f₂ a b c d = f₁ a b c d * f₂ n₁ d₁ n₂ d₂) :
-  f (a /. b) (c /. d) = f₁ a b c d /. f₂ a b c d :=
-begin
-  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
-  generalize hc : c /. d = x, cases x with n₂ d₂ h₂ c₂, rw num_denom' at hc,
-  rw fv,
-  have d₁0 := ne_of_gt (int.coe_nat_lt.2 h₁),
-  have d₂0 := ne_of_gt (int.coe_nat_lt.2 h₂),
-  exact (mk_eq (f0 d₁0 d₂0) (f0 b0 d0)).2 (H ((mk_eq b0 d₁0).1 ha) ((mk_eq d0 d₂0).1 hc))
-end
-
-@[simp] theorem add_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
-  a /. b + c /. d = (a * d + c * b) /. (b * d) :=
-begin
-  apply lift_binop_eq rat.add; intros; try {assumption},
-  { apply mk_pnat_eq },
-  { apply mul_ne_zero d₁0 d₂0 },
-  calc (n₁ * d₂ + n₂ * d₁) * (b * d) =
-          (n₁ * b) * d₂ * d + (n₂ * d) * (d₁ * b) : by simp [mul_add, mul_comm, mul_left_comm]
-    ... = (a * d₁) * d₂ * d + (c * d₂) * (d₁ * b) : by rw [h₁, h₂]
-    ... = (a * d + c * b) * (d₁ * d₂)             : by simp [mul_add, mul_comm, mul_left_comm]
-end
-
-/-- Negation of rational numbers. Use `-r` instead. -/
-protected def neg (r : ℚ) : ℚ :=
-⟨-r.num, r.denom, r.pos, by simp [r.cop]⟩
-
-instance : has_neg ℚ := ⟨rat.neg⟩
-
-@[simp] theorem neg_def {a b : ℤ} : -(a /. b) = -a /. b :=
-begin
-  by_cases b0 :  b = 0, { subst b0, simp, refl },
-  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
-  show rat.mk' _ _ _ _ = _, rw num_denom',
-  have d0 := ne_of_gt (int.coe_nat_lt.2 h₁),
-  apply (mk_eq d0 b0).2, have h₁ := (mk_eq b0 d0).1 ha,
-  simp only [neg_mul, congr_arg has_neg.neg h₁]
-end
-
-@[simp] lemma mk_neg_denom (n d : ℤ) : n /. -d = -n /. d :=
-begin
-  by_cases hd : d = 0;
-  simp [rat.mk_eq, hd]
-end
-
-/-- Multiplication of rational numbers. Use `(*)` instead. -/
-protected def mul : ℚ → ℚ → ℚ
-| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * n₂) ⟨d₁ * d₂, mul_pos h₁ h₂⟩
-
-instance : has_mul ℚ := ⟨rat.mul⟩
-
-@[simp] theorem mul_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
-  (a /. b) * (c /. d) = (a * c) /. (b * d) :=
-begin
-  apply lift_binop_eq rat.mul; intros; try {assumption},
-  { apply mk_pnat_eq },
-  { apply mul_ne_zero d₁0 d₂0 },
-  cc
-end
-
-/-- Inverse rational number. Use `r⁻¹` instead. -/
-protected def inv : ℚ → ℚ
-| ⟨(n+1:ℕ), d, h, c⟩ := ⟨d, n+1, n.succ_pos, c.symm⟩
-| ⟨0, d, h, c⟩ := 0
-| ⟨-[1+ n], d, h, c⟩ := ⟨-d, n+1, n.succ_pos, nat.coprime.symm $ by simp; exact c⟩
-
-instance : has_inv ℚ := ⟨rat.inv⟩
-
-@[simp] theorem inv_def {a b : ℤ} : (a /. b)⁻¹ = b /. a :=
-begin
-  by_cases a0 : a = 0, { subst a0, simp, refl },
-  by_cases b0 : b = 0, { subst b0, simp, refl },
-  generalize ha : a /. b = x, cases x with n d h c, rw num_denom' at ha,
-  refine eq.trans (_ : rat.inv ⟨n, d, h, c⟩ = d /. n) _,
-  { cases n with n; [cases n with n, skip],
-    { refl },
-    { change int.of_nat n.succ with (n+1:ℕ),
-      unfold rat.inv, rw num_denom' },
-    { unfold rat.inv, rw num_denom', refl } },
-  have n0 : n ≠ 0,
-  { rintro rfl,
-    rw [rat.zero_mk, mk_eq_zero b0] at ha,
-    exact a0 ha },
-  have d0 := ne_of_gt (int.coe_nat_lt.2 h),
-  have ha := (mk_eq b0 d0).1 ha,
-  apply (mk_eq n0 a0).2,
-  cc
-end
-
-variables (a b c : ℚ)
-
-protected theorem add_zero : a + 0 = a :=
-num_denom_cases_on' a $ λ n d h,
-by rw [← zero_mk d]; simp [h, -zero_mk]
-
-protected theorem zero_add : 0 + a = a :=
-num_denom_cases_on' a $ λ n d h,
-by rw [← zero_mk d]; simp [h, -zero_mk]
-
-protected theorem add_comm : a + b = b + a :=
-num_denom_cases_on' a $ λ n₁ d₁ h₁,
-num_denom_cases_on' b $ λ n₂ d₂ h₂,
-by simp [h₁, h₂]; cc
-
-protected theorem add_assoc : a + b + c = a + (b + c) :=
-num_denom_cases_on' a $ λ n₁ d₁ h₁,
-num_denom_cases_on' b $ λ n₂ d₂ h₂,
-num_denom_cases_on' c $ λ n₃ d₃ h₃,
-by simp [h₁, h₂, h₃, mul_ne_zero, mul_add, mul_comm, mul_left_comm, add_left_comm, add_assoc]
-
-protected theorem add_left_neg : -a + a = 0 :=
-num_denom_cases_on' a $ λ n d h,
-by simp [h]
-
-@[simp] lemma mk_zero_one : 0 /. 1 = 0 :=
-show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }
-
-@[simp] lemma mk_one_one : 1 /. 1 = 1 :=
-show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }
-
-@[simp] lemma mk_neg_one_one : (-1) /. 1 = -1 :=
-show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }
-
-protected theorem mul_one : a * 1 = a :=
-num_denom_cases_on' a $ λ n d h,
-by { rw ← mk_one_one, simp [h, -mk_one_one] }
-
-protected theorem one_mul : 1 * a = a :=
-num_denom_cases_on' a $ λ n d h,
-by { rw ← mk_one_one, simp [h, -mk_one_one] }
-
-protected theorem mul_comm : a * b = b * a :=
-num_denom_cases_on' a $ λ n₁ d₁ h₁,
-num_denom_cases_on' b $ λ n₂ d₂ h₂,
-by simp [h₁, h₂, mul_comm]
-
-protected theorem mul_assoc : a * b * c = a * (b * c) :=
-num_denom_cases_on' a $ λ n₁ d₁ h₁,
-num_denom_cases_on' b $ λ n₂ d₂ h₂,
-num_denom_cases_on' c $ λ n₃ d₃ h₃,
-by simp [h₁, h₂, h₃, mul_ne_zero, mul_comm, mul_left_comm]
-
-protected theorem add_mul : (a + b) * c = a * c + b * c :=
-num_denom_cases_on' a $ λ n₁ d₁ h₁,
-num_denom_cases_on' b $ λ n₂ d₂ h₂,
-num_denom_cases_on' c $ λ n₃ d₃ h₃,
-by simp [h₁, h₂, h₃, mul_ne_zero];
-   refine (div_mk_div_cancel_left (int.coe_nat_ne_zero.2 h₃)).symm.trans _;
-   simp [mul_add, mul_comm, mul_assoc, mul_left_comm]
-
-protected theorem mul_add : a * (b + c) = a * b + a * c :=
-by rw [rat.mul_comm, rat.add_mul, rat.mul_comm, rat.mul_comm c a]
-
-protected theorem zero_ne_one : 0 ≠ (1:ℚ) :=
-by { rw [ne_comm, ← mk_one_one, mk_ne_zero one_ne_zero], exact one_ne_zero }
-
-protected theorem mul_inv_cancel : a ≠ 0 → a * a⁻¹ = 1 :=
-num_denom_cases_on' a $ λ n d h a0,
-have n0 : n ≠ 0, from mt (by { rintro rfl, simp }) a0,
-by simpa [h, n0, mul_comm] using @div_mk_div_cancel_left 1 1 _ n0
-
-protected theorem inv_mul_cancel (h : a ≠ 0) : a⁻¹ * a = 1 :=
-eq.trans (rat.mul_comm _ _) (rat.mul_inv_cancel _ h)
-
-instance : decidable_eq ℚ := by tactic.mk_dec_eq_instance
-
 instance : field ℚ :=
 { zero             := 0,
-  add              := rat.add,
-  neg              := rat.neg,
+  add              := (+),
+  neg              := has_neg.neg,
   one              := 1,
-  mul              := rat.mul,
-  inv              := rat.inv,
-  zero_add         := rat.zero_add,
-  add_zero         := rat.add_zero,
-  add_comm         := rat.add_comm,
-  add_assoc        := rat.add_assoc,
-  add_left_neg     := rat.add_left_neg,
-  mul_one          := rat.mul_one,
-  one_mul          := rat.one_mul,
-  mul_comm         := rat.mul_comm,
-  mul_assoc        := rat.mul_assoc,
-  left_distrib     := rat.mul_add,
-  right_distrib    := rat.add_mul,
-  exists_pair_ne   := ⟨0, 1, rat.zero_ne_one⟩,
-  mul_inv_cancel   := rat.mul_inv_cancel,
-  inv_zero         := rfl }
+  mul              := (*),
+  inv              := has_inv.inv,
+  rat_cast         := id,
+  rat_cast_mk      := λ a b h1 h2, (num_div_denom _).symm,
+  qsmul            := (*),
+  .. rat.comm_ring,
+  .. rat.comm_group_with_zero}
 
 /- Extra instances to short-circuit type class resolution -/
 instance : division_ring ℚ      := by apply_instance
-instance : is_domain ℚ          := by apply_instance
--- TODO(Mario): this instance slows down data.real.basic
-instance : nontrivial ℚ         := by apply_instance
-instance : comm_ring ℚ          := by apply_instance
---instance : ring ℚ             := by apply_instance
-instance : comm_semiring ℚ      := by apply_instance
-instance : semiring ℚ           := by apply_instance
-instance : add_comm_group ℚ     := by apply_instance
-instance : add_group ℚ          := by apply_instance
-instance : add_comm_monoid ℚ    := by apply_instance
-instance : add_monoid ℚ         := by apply_instance
-instance : add_left_cancel_semigroup ℚ := by apply_instance
-instance : add_right_cancel_semigroup ℚ := by apply_instance
-instance : add_comm_semigroup ℚ := by apply_instance
-instance : add_semigroup ℚ      := by apply_instance
-instance : comm_monoid ℚ        := by apply_instance
-instance : monoid ℚ             := by apply_instance
-instance : comm_semigroup ℚ     := by apply_instance
-instance : semigroup ℚ          := by apply_instance
-
-theorem sub_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
-  a /. b - c /. d = (a * d - c * b) /. (b * d) :=
-by simp [b0, d0, sub_eq_add_neg]
-
-@[simp] lemma denom_neg_eq_denom (q : ℚ) : (-q).denom = q.denom := rfl
-
-@[simp] lemma num_neg_eq_neg_num (q : ℚ) : (-q).num = -(q.num) := rfl
-
-@[simp] lemma num_zero : rat.num 0 = 0 := rfl
-
-@[simp] lemma denom_zero : rat.denom 0 = 1 := rfl
-
-lemma zero_of_num_zero {q : ℚ} (hq : q.num = 0) : q = 0 :=
-have q = q.num /. q.denom, from num_denom.symm,
-by simpa [hq]
-
-lemma zero_iff_num_zero {q : ℚ} : q = 0 ↔ q.num = 0 :=
-⟨λ _, by simp *, zero_of_num_zero⟩
-
-lemma num_ne_zero_of_ne_zero {q : ℚ} (h : q ≠ 0) : q.num ≠ 0 :=
-assume : q.num = 0,
-h $ zero_of_num_zero this
-
-@[simp] lemma num_one : (1 : ℚ).num = 1 := rfl
-
-@[simp] lemma denom_one : (1 : ℚ).denom = 1 := rfl
-
-lemma denom_ne_zero (q : ℚ) : q.denom ≠ 0 :=
-ne_of_gt q.pos
-
-lemma eq_iff_mul_eq_mul {p q : ℚ} : p = q ↔ p.num * q.denom = q.num * p.denom :=
-begin
-  conv_lhs { rw [←(@num_denom p), ←(@num_denom q)] },
-  apply rat.mk_eq,
-  { exact_mod_cast p.denom_ne_zero },
-  { exact_mod_cast q.denom_ne_zero }
-end
-
-lemma mk_num_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : n ≠ 0 :=
-assume : n = 0,
-hq $ by simpa [this] using hqnd
-
-lemma mk_denom_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : d ≠ 0 :=
-assume : d = 0,
-hq $ by simpa [this] using hqnd
-
-lemma mk_ne_zero_of_ne_zero {n d : ℤ} (h : n ≠ 0) (hd : d ≠ 0) : n /. d ≠ 0 :=
-(mk_ne_zero hd).mpr h
-
-lemma mul_num_denom (q r : ℚ) : q * r = (q.num * r.num) /. ↑(q.denom * r.denom) :=
-have hq' : (↑q.denom : ℤ) ≠ 0, by have := denom_ne_zero q; simpa,
-have hr' : (↑r.denom : ℤ) ≠ 0, by have := denom_ne_zero r; simpa,
-suffices (q.num /. ↑q.denom) * (r.num /. ↑r.denom) = (q.num * r.num) /. ↑(q.denom * r.denom),
-  by simpa using this,
-by simp [mul_def hq' hr', -num_denom]
-
-lemma div_num_denom (q r : ℚ) : q / r = (q.num * r.denom) /. (q.denom * r.num) :=
-if hr : r.num = 0 then
-  have hr' : r = 0, from zero_of_num_zero hr,
-  by simp *
-else
-  calc q / r = q * r⁻¹ : div_eq_mul_inv q r
-         ... = (q.num /. q.denom) * (r.num /. r.denom)⁻¹ : by simp
-         ... = (q.num /. q.denom) * (r.denom /. r.num) : by rw inv_def
-         ... = (q.num * r.denom) /. (q.denom * r.num) : mul_def (by simpa using denom_ne_zero q) hr
-
-lemma num_denom_mk {q : ℚ} {n d : ℤ} (hd : d ≠ 0) (qdf : q = n /. d) :
-  ∃ c : ℤ, n = c * q.num ∧ d = c * q.denom :=
-begin
-  obtain rfl|hn := eq_or_ne n 0,
-  { simp [qdf] },
-  have : q.num * d = n * ↑(q.denom),
-  { refine (rat.mk_eq _ hd).mp _,
-    { exact int.coe_nat_ne_zero.mpr (rat.denom_ne_zero _) },
-    { rwa [num_denom] } },
-  have hqdn : q.num ∣ n,
-  { rw qdf, exact rat.num_dvd _ hd },
-  refine ⟨n / q.num, _, _⟩,
-  { rw int.div_mul_cancel hqdn },
-  { refine int.eq_mul_div_of_mul_eq_mul_of_dvd_left _ hqdn this,
-    rw qdf,
-    exact rat.num_ne_zero_of_ne_zero ((mk_ne_zero hd).mpr hn) }
-end
-
-theorem mk_pnat_num (n : ℤ) (d : ℕ+) :
-  (mk_pnat n d).num = n / nat.gcd n.nat_abs d :=
-by cases d; refl
-
-theorem mk_pnat_denom (n : ℤ) (d : ℕ+) :
-  (mk_pnat n d).denom = d / nat.gcd n.nat_abs d :=
-by cases d; refl
-
-lemma num_mk (n d : ℤ) :
-  (n /. d).num = d.sign * n / n.gcd d :=
-begin
-  rcases d with ((_ | _) | _),
-  { simp },
-  { simpa [←int.coe_nat_succ, int.sign_coe_nat_of_nonzero] },
-  { rw rat.mk,
-    simpa [rat.mk_pnat_num, int.neg_succ_of_nat_eq, ←int.coe_nat_succ,
-           int.sign_coe_nat_of_nonzero] }
-end
-
-lemma denom_mk (n d : ℤ) :
-  (n /. d).denom = if d = 0 then 1 else d.nat_abs / n.gcd d :=
-begin
-  rcases d with ((_ | _) | _),
-  { simp },
-  { simpa [←int.coe_nat_succ, int.sign_coe_nat_of_nonzero] },
-  { rw rat.mk,
-    simpa [rat.mk_pnat_denom, int.neg_succ_of_nat_eq, ←int.coe_nat_succ,
-           int.sign_coe_nat_of_nonzero] }
-end
-
-theorem mk_pnat_denom_dvd (n : ℤ) (d : ℕ+) :
-  (mk_pnat n d).denom ∣ d.1 :=
-begin
-  rw mk_pnat_denom,
-  apply nat.div_dvd_of_dvd,
-  apply nat.gcd_dvd_right
-end
-
-theorem add_denom_dvd (q₁ q₂ : ℚ) : (q₁ + q₂).denom ∣ q₁.denom * q₂.denom :=
-by { cases q₁, cases q₂, apply mk_pnat_denom_dvd }
-
-theorem mul_denom_dvd (q₁ q₂ : ℚ) : (q₁ * q₂).denom ∣ q₁.denom * q₂.denom :=
-by { cases q₁, cases q₂, apply mk_pnat_denom_dvd }
-
-theorem mul_num (q₁ q₂ : ℚ) : (q₁ * q₂).num =
-  (q₁.num * q₂.num) / nat.gcd (q₁.num * q₂.num).nat_abs (q₁.denom * q₂.denom) :=
-by cases q₁; cases q₂; refl
-
-theorem mul_denom (q₁ q₂ : ℚ) : (q₁ * q₂).denom =
-  (q₁.denom * q₂.denom) / nat.gcd (q₁.num * q₂.num).nat_abs (q₁.denom * q₂.denom) :=
-by cases q₁; cases q₂; refl
-
-theorem mul_self_num (q : ℚ) : (q * q).num = q.num * q.num :=
-by rw [mul_num, int.nat_abs_mul, nat.coprime.gcd_eq_one, int.coe_nat_one, int.div_one];
-exact (q.cop.mul_right q.cop).mul (q.cop.mul_right q.cop)
-
-theorem mul_self_denom (q : ℚ) : (q * q).denom = q.denom * q.denom :=
-by rw [rat.mul_denom, int.nat_abs_mul, nat.coprime.gcd_eq_one, nat.div_one];
-exact (q.cop.mul_right q.cop).mul (q.cop.mul_right q.cop)
-
-lemma add_num_denom (q r : ℚ) : q + r =
-  ((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ) :=
-have hqd : (q.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 q.3,
-have hrd : (r.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 r.3,
-by conv_lhs { rw [←@num_denom q, ←@num_denom r, rat.add_def hqd hrd] };
-  simp [mul_comm]
-
-section casts
-
-protected lemma add_mk (a b c : ℤ) : (a + b) /. c = a /. c + b /. c :=
-if h : c = 0 then by simp [h] else
-by { rw [add_def h h, mk_eq h (mul_ne_zero h h)], simp [add_mul, mul_assoc] }
-
-theorem coe_int_eq_mk : ∀ (z : ℤ), ↑z = z /. 1
-| (n : ℕ) := show (n:ℚ) = n /. 1,
-  by induction n with n IH n; simp [*, rat.add_mk]
-| -[1+ n] := show (-(n + 1) : ℚ) = -[1+ n] /. 1, begin
-  induction n with n IH, { rw ← of_int_eq_mk, simp, refl },
-  show -(n + 1 + 1 : ℚ) = -[1+ n.succ] /. 1,
-  rw [neg_add, IH, ← mk_neg_one_one],
-  simp [-mk_neg_one_one]
-end
-
-theorem mk_eq_div (n d : ℤ) : n /. d = ((n : ℚ) / d) :=
-begin
-  by_cases d0 : d = 0, {simp [d0, div_zero]},
-  simp [division_def, coe_int_eq_mk, mul_def one_ne_zero d0]
-end
-
-@[simp]
-theorem num_div_denom (r : ℚ) : (r.num / r.denom : ℚ) = r :=
-by rw [← int.cast_coe_nat, ← mk_eq_div, num_denom]
-
-lemma exists_eq_mul_div_num_and_eq_mul_div_denom (n : ℤ) {d : ℤ} (d_ne_zero : d ≠ 0) :
-  ∃ (c : ℤ), n = c * ((n : ℚ) / d).num ∧ (d : ℤ) = c * ((n : ℚ) / d).denom :=
-begin
-  have : ((n : ℚ) / d) = rat.mk n d, by rw [←rat.mk_eq_div],
-  exact rat.num_denom_mk d_ne_zero this
-end
-
-theorem coe_int_eq_of_int (z : ℤ) : ↑z = of_int z :=
-(coe_int_eq_mk z).trans (of_int_eq_mk z).symm
-
-@[simp, norm_cast] theorem coe_int_num (n : ℤ) : (n : ℚ).num = n :=
-by rw coe_int_eq_of_int; refl
-
-@[simp, norm_cast] theorem coe_int_denom (n : ℤ) : (n : ℚ).denom = 1 :=
-by rw coe_int_eq_of_int; refl
-
-lemma coe_int_num_of_denom_eq_one {q : ℚ} (hq : q.denom = 1) : ↑(q.num) = q :=
-by { conv_rhs { rw [←(@num_denom q), hq] }, rw [coe_int_eq_mk], refl }
-
-lemma denom_eq_one_iff (r : ℚ) : r.denom = 1 ↔ ↑r.num = r :=
-⟨rat.coe_int_num_of_denom_eq_one, λ h, h ▸ rat.coe_int_denom r.num⟩
-
-instance : can_lift ℚ ℤ :=
-⟨coe, λ q, q.denom = 1, λ q hq, ⟨q.num, coe_int_num_of_denom_eq_one hq⟩⟩
-
-theorem coe_nat_eq_mk (n : ℕ) : ↑n = n /. 1 :=
-by rw [← int.cast_coe_nat, coe_int_eq_mk]
-
-@[simp, norm_cast] theorem coe_nat_num (n : ℕ) : (n : ℚ).num = n :=
-by rw [← int.cast_coe_nat, coe_int_num]
-
-@[simp, norm_cast] theorem coe_nat_denom (n : ℕ) : (n : ℚ).denom = 1 :=
-by rw [← int.cast_coe_nat, coe_int_denom]
-
--- Will be subsumed by `int.coe_inj` after we have defined
--- `linear_ordered_field ℚ` (which implies characteristic zero).
-lemma coe_int_inj (m n : ℤ) : (m : ℚ) = n ↔ m = n :=
-⟨λ h, by simpa using congr_arg num h, congr_arg _⟩
-
-end casts
-
-lemma inv_def' {q : ℚ} : q⁻¹ = (q.denom : ℚ) / q.num :=
-by { conv_lhs { rw ←(@num_denom q) }, cases q, simp [div_num_denom] }
-
-@[simp] lemma mul_denom_eq_num {q : ℚ} : q * q.denom = q.num :=
-begin
-  suffices : mk (q.num) ↑(q.denom) * mk ↑(q.denom) 1 = mk (q.num) 1, by
-  { conv { for q [1] { rw ←(@num_denom q) }}, rwa [coe_int_eq_mk, coe_nat_eq_mk] },
-  have : (q.denom : ℤ) ≠ 0, from ne_of_gt (by exact_mod_cast q.pos),
-  rw [(rat.mul_def this one_ne_zero), (mul_comm (q.denom : ℤ) 1), (div_mk_div_cancel_left this)]
-end
-
-lemma denom_div_cast_eq_one_iff (m n : ℤ) (hn : n ≠ 0) :
-  ((m : ℚ) / n).denom = 1 ↔ n ∣ m :=
-begin
-  replace hn : (n:ℚ) ≠ 0, by rwa [ne.def, ← int.cast_zero, coe_int_inj],
-  split,
-  { intro h,
-    lift ((m : ℚ) / n) to ℤ using h with k hk,
-    use k,
-    rwa [eq_div_iff_mul_eq hn, ← int.cast_mul, mul_comm, eq_comm, coe_int_inj] at hk },
-  { rintros ⟨d, rfl⟩,
-    rw [int.cast_mul, mul_comm, mul_div_cancel _ hn, rat.coe_int_denom] }
-end
-
-lemma num_div_eq_of_coprime {a b : ℤ} (hb0 : 0 < b) (h : nat.coprime a.nat_abs b.nat_abs) :
-  (a / b : ℚ).num = a :=
-begin
-  lift b to ℕ using le_of_lt hb0,
-  norm_cast at hb0 h,
-  rw [← rat.mk_eq_div, ← rat.mk_pnat_eq a b hb0, rat.mk_pnat_num, pnat.mk_coe, h.gcd_eq_one,
-    int.coe_nat_one, int.div_one]
-end
-
-lemma denom_div_eq_of_coprime {a b : ℤ} (hb0 : 0 < b) (h : nat.coprime a.nat_abs b.nat_abs) :
-  ((a / b : ℚ).denom : ℤ) = b :=
-begin
-  lift b to ℕ using le_of_lt hb0,
-  norm_cast at hb0 h,
-  rw [← rat.mk_eq_div, ← rat.mk_pnat_eq a b hb0, rat.mk_pnat_denom, pnat.mk_coe, h.gcd_eq_one,
-    nat.div_one]
-end
-
-lemma div_int_inj {a b c d : ℤ} (hb0 : 0 < b) (hd0 : 0 < d)
-  (h1 : nat.coprime a.nat_abs b.nat_abs) (h2 : nat.coprime c.nat_abs d.nat_abs)
-  (h : (a : ℚ) / b = (c : ℚ) / d) : a = c ∧ b = d :=
-begin
-  apply and.intro,
-  { rw [← (num_div_eq_of_coprime hb0 h1), h, num_div_eq_of_coprime hd0 h2] },
-  { rw [← (denom_div_eq_of_coprime hb0 h1), h, denom_div_eq_of_coprime hd0 h2] }
-end
-
-@[norm_cast] lemma coe_int_div_self (n : ℤ) : ((n / n : ℤ) : ℚ) = n / n :=
-begin
-  by_cases hn : n = 0,
-  { subst hn, simp only [int.cast_zero, euclidean_domain.zero_div] },
-  { have : (n : ℚ) ≠ 0, { rwa ← coe_int_inj at hn },
-    simp only [int.div_self hn, int.cast_one, ne.def, not_false_iff, div_self this] }
-end
-
-@[norm_cast] lemma coe_nat_div_self (n : ℕ) : ((n / n : ℕ) : ℚ) = n / n :=
-coe_int_div_self n
-
-lemma coe_int_div (a b : ℤ) (h : b ∣ a) : ((a / b : ℤ) : ℚ) = a / b :=
-begin
-  rcases h with ⟨c, rfl⟩,
-  simp only [mul_comm b, int.mul_div_assoc c (dvd_refl b), int.cast_mul, mul_div_assoc,
-    coe_int_div_self]
-end
-
-lemma coe_nat_div (a b : ℕ) (h : b ∣ a) : ((a / b : ℕ) : ℚ) = a / b :=
-begin
-  rcases h with ⟨c, rfl⟩,
-  simp only [mul_comm b, nat.mul_div_assoc c (dvd_refl b), nat.cast_mul, mul_div_assoc,
-    coe_nat_div_self]
-end
-
-lemma inv_coe_int_num {a : ℤ} (ha0 : 0 < a) : (a : ℚ)⁻¹.num = 1 :=
-begin
-  rw [rat.inv_def', rat.coe_int_num, rat.coe_int_denom, nat.cast_one, ←int.cast_one],
-  apply num_div_eq_of_coprime ha0,
-  rw int.nat_abs_one,
-  exact nat.coprime_one_left _,
-end
-
-lemma inv_coe_nat_num {a : ℕ} (ha0 : 0 < a) : (a : ℚ)⁻¹.num = 1 :=
-inv_coe_int_num (by exact_mod_cast ha0 : 0 < (a : ℤ))
-
-lemma inv_coe_int_denom {a : ℤ} (ha0 : 0 < a) : ((a : ℚ)⁻¹.denom : ℤ) = a :=
-begin
-  rw [rat.inv_def', rat.coe_int_num, rat.coe_int_denom, nat.cast_one, ←int.cast_one],
-  apply denom_div_eq_of_coprime ha0,
-  rw int.nat_abs_one,
-  exact nat.coprime_one_left _,
-end
-
-lemma inv_coe_nat_denom {a : ℕ} (ha0 : 0 < a) : (a : ℚ)⁻¹.denom = a :=
-by exact_mod_cast inv_coe_int_denom (by exact_mod_cast ha0 : 0 < (a : ℤ))
-
-protected lemma «forall» {p : ℚ → Prop} : (∀ r, p r) ↔ ∀ a b : ℤ, p (a / b) :=
-⟨λ h _ _, h _,
-  λ h q, (show q = q.num / q.denom, from by simp [rat.div_num_denom]).symm ▸ (h q.1 q.2)⟩
-
-protected lemma «exists» {p : ℚ → Prop} : (∃ r, p r) ↔ ∃ a b : ℤ, p (a / b) :=
-⟨λ ⟨r, hr⟩, ⟨r.num, r.denom, by rwa [← mk_eq_div, num_denom]⟩, λ ⟨a, b, h⟩, ⟨_, h⟩⟩
 
 end rat
diff --git a/src/data/rat/big_operators.lean b/src/data/rat/big_operators.lean
new file mode 100644
index 0000000000000..faa9503277d6d
--- /dev/null
+++ b/src/data/rat/big_operators.lean
@@ -0,0 +1,51 @@
+/-
+Copyright (c) 2019 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import data.rat.cast
+import algebra.big_operators.basic
+
+/-! # Casting lemmas for rational numbers involving sums and products
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open_locale big_operators
+
+variables {ι α : Type*}
+
+namespace rat
+
+section with_div_ring
+variables [division_ring α] [char_zero α]
+
+@[simp, norm_cast] lemma cast_list_sum (s : list ℚ) : (↑(s.sum) : α) = (s.map coe).sum :=
+map_list_sum (rat.cast_hom α) _
+
+@[simp, norm_cast] lemma cast_multiset_sum (s : multiset ℚ) : (↑(s.sum) : α) = (s.map coe).sum :=
+map_multiset_sum (rat.cast_hom α) _
+
+@[simp, norm_cast] lemma cast_sum (s : finset ι) (f : ι → ℚ) :
+  (↑(∑ i in s, f i) : α) = ∑ i in s, f i :=
+map_sum (rat.cast_hom α) _ _
+
+@[simp, norm_cast] lemma cast_list_prod (s : list ℚ) : (↑(s.prod) : α) = (s.map coe).prod :=
+map_list_prod (rat.cast_hom α) _
+
+end with_div_ring
+
+section field
+variables [field α] [char_zero α]
+
+@[simp, norm_cast] lemma cast_multiset_prod (s : multiset ℚ) : (↑(s.prod) : α) = (s.map coe).prod :=
+map_multiset_prod (rat.cast_hom α) _
+
+@[simp, norm_cast] lemma cast_prod (s : finset ι) (f : ι → ℚ) :
+  (↑(∏ i in s, f i) : α) = ∏ i in s, f i :=
+map_prod (rat.cast_hom α) _ _
+
+end field
+
+end rat
diff --git a/src/data/rat/cast.lean b/src/data/rat/cast.lean
index b189dcb98467d..d4040ea4f3b16 100644
--- a/src/data/rat/cast.lean
+++ b/src/data/rat/cast.lean
@@ -4,12 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
 import data.rat.order
+import data.rat.lemmas
 import data.int.char_zero
+import algebra.group_with_zero.power
 import algebra.field.opposite
+import algebra.order.field.basic
 
 /-!
 # Casts for Rational Numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Summary
 
 We define the canonical injection from ℚ into an arbitrary division ring and prove various
@@ -24,7 +30,7 @@ casting lemmas showing the well-behavedness of this injection.
 rat, rationals, field, ℚ, numerator, denominator, num, denom, cast, coercion, casting
 -/
 
-variables {F α β : Type*}
+variables {F ι α β : Type*}
 
 namespace rat
 open_locale rat
@@ -32,31 +38,17 @@ open_locale rat
 section with_div_ring
 variable [division_ring α]
 
-/-- Construct the canonical injection from `ℚ` into an arbitrary
-  division ring. If the field has positive characteristic `p`,
-  we define `1 / p = 1 / 0 = 0` for consistency with our
-  division by zero convention. -/
--- see Note [coercion into rings]
-@[priority 900] instance cast_coe : has_coe_t ℚ α := ⟨λ r, r.1 / r.2⟩
-
-theorem cast_def (r : ℚ) : (r : α) = r.num / r.denom := rfl
-
-@[simp] theorem cast_of_int (n : ℤ) : (of_int n : α) = n :=
-show (n / (1:ℕ) : α) = n, by rw [nat.cast_one, div_one]
-
 @[simp, norm_cast] theorem cast_coe_int (n : ℤ) : ((n : ℚ) : α) = n :=
-by rw [coe_int_eq_of_int, cast_of_int]
+(cast_def _).trans $ show (n / (1:ℕ) : α) = n, by rw [nat.cast_one, div_one]
 
-@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℚ) : α) = n := cast_coe_int n
+@[simp, norm_cast] theorem cast_coe_nat (n : ℕ) : ((n : ℚ) : α) = n :=
+by rw [← int.cast_coe_nat, cast_coe_int, int.cast_coe_nat]
 
-@[simp, norm_cast] theorem cast_zero : ((0 : ℚ) : α) = 0 :=
-(cast_of_int _).trans int.cast_zero
-
-@[simp, norm_cast] theorem cast_one : ((1 : ℚ) : α) = 1 :=
-(cast_of_int _).trans int.cast_one
+@[simp, norm_cast] lemma cast_zero : ((0 : ℚ) : α) = 0 := (cast_coe_int _).trans int.cast_zero
+@[simp, norm_cast] lemma cast_one : ((1 : ℚ) : α) = 1 := (cast_coe_int _).trans int.cast_one
 
 theorem cast_commute (r : ℚ) (a : α) : commute ↑r a :=
-(r.1.cast_commute a).div_left (r.2.cast_commute a)
+by simpa only [cast_def] using (r.1.cast_commute a).div_left (r.2.cast_commute a)
 
 theorem cast_comm (r : ℚ) (a : α) : (r : α) * a = a * r :=
 (cast_commute r a).eq
@@ -73,33 +65,33 @@ begin
   { intro d0,
     have dd := denom_dvd a b,
     cases (show (d:ℤ) ∣ b, by rwa e at dd) with k ke,
-    have : (b:α) = (d:α) * (k:α), {rw [ke, int.cast_mul], refl},
+    have : (b:α) = (d:α) * (k:α), {rw [ke, int.cast_mul, int.cast_coe_nat]},
     rw [d0, zero_mul] at this, contradiction },
   rw [num_denom'] at e,
   have := congr_arg (coe : ℤ → α) ((mk_eq b0' $ ne_of_gt $ int.coe_nat_pos.2 h).1 e),
   rw [int.cast_mul, int.cast_mul, int.cast_coe_nat] at this,
-  symmetry, change (a / b : α) = n / d,
-  rw [div_eq_mul_inv, eq_div_iff_mul_eq d0, mul_assoc, (d.commute_cast _).eq,
+  symmetry,
+  rw [cast_def, div_eq_mul_inv, eq_div_iff_mul_eq d0, mul_assoc, (d.commute_cast _).eq,
       ← mul_assoc, this, mul_assoc, mul_inv_cancel b0, mul_one]
 end
 
 @[norm_cast] theorem cast_add_of_ne_zero : ∀ {m n : ℚ},
   (m.denom : α) ≠ 0 → (n.denom : α) ≠ 0 → ((m + n : ℚ) : α) = m + n
 | ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := λ (d₁0 : (d₁:α) ≠ 0) (d₂0 : (d₂:α) ≠ 0), begin
-  have d₁0' : (d₁:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₁0; exact d₁0 rfl),
-  have d₂0' : (d₂:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₂0; exact d₂0 rfl),
+  have d₁0' : (d₁:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₁0; exact d₁0 nat.cast_zero),
+  have d₂0' : (d₂:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₂0; exact d₂0 nat.cast_zero),
   rw [num_denom', num_denom', add_def d₁0' d₂0'],
   suffices : (n₁ * (d₂ * (d₂⁻¹ * d₁⁻¹)) +
     n₂ * (d₁ * d₂⁻¹) * d₁⁻¹ : α) = n₁ * d₁⁻¹ + n₂ * d₂⁻¹,
   { rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero, cast_mk_of_ne_zero],
-    { simpa [division_def, left_distrib, right_distrib, mul_inv_rev₀, d₁0, d₂0, mul_assoc] },
+    { simpa [division_def, left_distrib, right_distrib, mul_inv_rev, d₁0, d₂0, mul_assoc] },
     all_goals {simp [d₁0, d₂0]} },
   rw [← mul_assoc (d₂:α), mul_inv_cancel d₂0, one_mul,
       (nat.cast_commute _ _).eq], simp [d₁0, mul_assoc]
 end
 
 @[simp, norm_cast] theorem cast_neg : ∀ n, ((-n : ℚ) : α) = -n
-| ⟨n, d, h, c⟩ := show (↑-n / d : α) = -(n / d),
+| ⟨n, d, h, c⟩ := by simpa only [cast_def] using show (↑-n / d : α) = -(n / d),
   by rw [div_eq_mul_inv, div_eq_mul_inv, int.cast_neg, neg_mul_eq_neg_mul]
 
 @[norm_cast] theorem cast_sub_of_ne_zero {m n : ℚ}
@@ -110,12 +102,12 @@ by simp [sub_eq_add_neg, (cast_add_of_ne_zero m0 this)]
 @[norm_cast] theorem cast_mul_of_ne_zero : ∀ {m n : ℚ},
   (m.denom : α) ≠ 0 → (n.denom : α) ≠ 0 → ((m * n : ℚ) : α) = m * n
 | ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := λ (d₁0 : (d₁:α) ≠ 0) (d₂0 : (d₂:α) ≠ 0), begin
-  have d₁0' : (d₁:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₁0; exact d₁0 rfl),
-  have d₂0' : (d₂:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₂0; exact d₂0 rfl),
+  have d₁0' : (d₁:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₁0; exact d₁0 nat.cast_zero),
+  have d₂0' : (d₂:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d₂0; exact d₂0 nat.cast_zero),
   rw [num_denom', num_denom', mul_def d₁0' d₂0'],
   suffices : (n₁ * ((n₂ * d₂⁻¹) * d₁⁻¹) : α) = n₁ * (d₁⁻¹ * (n₂ * d₂⁻¹)),
   { rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero, cast_mk_of_ne_zero],
-    { simpa [division_def, mul_inv_rev₀, d₁0, d₂0, mul_assoc] },
+    { simpa [division_def, mul_inv_rev, d₁0, d₂0, mul_assoc] },
     all_goals {simp [d₁0, d₂0]} },
   rw [(d₁.commute_cast (_:α)).inv_right₀.eq]
 end
@@ -130,15 +122,15 @@ end
 @[simp] theorem cast_inv_int (n : ℤ) : ((n⁻¹ : ℚ) : α) = n⁻¹ :=
 begin
   cases n,
-  { exact cast_inv_nat _ },
+  { simp [cast_inv_nat] },
   { simp only [int.cast_neg_succ_of_nat, ← nat.cast_succ, cast_neg, inv_neg, cast_inv_nat] }
 end
 
 @[norm_cast] theorem cast_inv_of_ne_zero : ∀ {n : ℚ},
   (n.num : α) ≠ 0 → (n.denom : α) ≠ 0 → ((n⁻¹ : ℚ) : α) = n⁻¹
 | ⟨n, d, h, c⟩ := λ (n0 : (n:α) ≠ 0) (d0 : (d:α) ≠ 0), begin
-  have n0' : (n:ℤ) ≠ 0 := λ e, by rw e at n0; exact n0 rfl,
-  have d0' : (d:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d0; exact d0 rfl),
+  have n0' : (n:ℤ) ≠ 0 := λ e, by rw e at n0; exact n0 int.cast_zero,
+  have d0' : (d:ℤ) ≠ 0 := int.coe_nat_ne_zero.2 (λ e, by rw e at d0; exact d0 nat.cast_zero),
   rw [num_denom', inv_def],
   rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero, inv_div];
   simp [n0, d0]
@@ -166,7 +158,7 @@ by rw [division_def, cast_mul_of_ne_zero md (mt this nn), cast_inv_of_ne_zero nn
   rw [cast_mk_of_ne_zero, cast_mk_of_ne_zero] at h; simp [d₁0, d₂0] at h ⊢,
   rwa [eq_div_iff_mul_eq d₂a, division_def, mul_assoc, (d₁.cast_commute (d₂:α)).inv_left₀.eq,
     ← mul_assoc, ← division_def, eq_comm, eq_div_iff_mul_eq d₁a, eq_comm,
-    ← int.cast_coe_nat, ← int.cast_mul, ← int.cast_coe_nat, ← int.cast_mul,
+    ← int.cast_coe_nat d₁, ← int.cast_mul, ← int.cast_coe_nat d₂, ← int.cast_mul,
     int.cast_inj, ← mk_eq (int.coe_nat_ne_zero.2 d₁0) (int.coe_nat_ne_zero.2 d₂0)] at h
 end
 
@@ -199,140 +191,140 @@ cast_add _ _
   ((bit1 n : ℚ) : α) = bit1 n :=
 by rw [bit1, cast_add, cast_one, cast_bit0]; refl
 
-variable (α)
+variables (α) [char_zero α]
 
 /-- Coercion `ℚ → α` as a `ring_hom`. -/
-def cast_hom [char_zero α] : ℚ →+* α := ⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩
+def cast_hom : ℚ →+* α := ⟨coe, cast_one, cast_mul, cast_zero, cast_add⟩
 
 variable {α}
 
-@[simp] lemma coe_cast_hom [char_zero α] : ⇑(cast_hom α) = coe := rfl
-
-@[simp, norm_cast] theorem cast_inv [char_zero α] (n) : ((n⁻¹ : ℚ) : α) = n⁻¹ :=
-(cast_hom α).map_inv _
+@[simp] lemma coe_cast_hom : ⇑(cast_hom α) = coe := rfl
 
-@[simp, norm_cast] theorem cast_div [char_zero α] (m n) :
-  ((m / n : ℚ) : α) = m / n :=
-(cast_hom α).map_div _ _
+@[simp, norm_cast] theorem cast_inv (n) : ((n⁻¹ : ℚ) : α) = n⁻¹ := map_inv₀ (cast_hom α) _
+@[simp, norm_cast] theorem cast_div (m n) : ((m / n : ℚ) : α) = m / n := map_div₀ (cast_hom α) _ _
+@[simp, norm_cast] theorem cast_zpow (q : ℚ) (n : ℤ) : ((q ^ n : ℚ) : α) = q ^ n :=
+map_zpow₀ (cast_hom α) q n
 
-@[norm_cast] theorem cast_mk [char_zero α] (a b : ℤ) : ((a /. b) : α) = a / b :=
+@[norm_cast] theorem cast_mk (a b : ℤ) : ((a /. b) : α) = a / b :=
 by simp only [mk_eq_div, cast_div, cast_coe_int]
 
-@[simp, norm_cast] theorem cast_pow [char_zero α] (q) (k : ℕ) :
-  ((q ^ k : ℚ) : α) = q ^ k :=
+@[simp, norm_cast] theorem cast_pow (q) (k : ℕ) : ((q ^ k : ℚ) : α) = q ^ k :=
 (cast_hom α).map_pow q k
 
 end with_div_ring
 
-@[simp, norm_cast] theorem cast_nonneg [linear_ordered_field α] : ∀ {n : ℚ}, 0 ≤ (n : α) ↔ 0 ≤ n
-| ⟨n, d, h, c⟩ :=
-  by { rw [num_denom', cast_mk, mk_eq_div, div_nonneg_iff, div_nonneg_iff], norm_cast }
+section linear_ordered_field
 
-@[simp, norm_cast] theorem cast_le [linear_ordered_field α] {m n : ℚ} : (m : α) ≤ n ↔ m ≤ n :=
-by rw [← sub_nonneg, ← cast_sub, cast_nonneg, sub_nonneg]
+variables {K : Type*} [linear_ordered_field K]
 
-@[simp, norm_cast] theorem cast_lt [linear_ordered_field α] {m n : ℚ} : (m : α) < n ↔ m < n :=
-by simpa [-cast_le] using not_congr (@cast_le α _ n m)
+lemma cast_pos_of_pos {r : ℚ} (hr : 0 < r) : (0 : K) < r :=
+begin
+  rw [rat.cast_def],
+  exact div_pos (int.cast_pos.2 $ num_pos_iff_pos.2 hr) (nat.cast_pos.2 r.pos)
+end
 
-@[simp] theorem cast_nonpos [linear_ordered_field α] {n : ℚ} : (n : α) ≤ 0 ↔ n ≤ 0 :=
-by rw [← cast_zero, cast_le]
+@[mono] lemma cast_strict_mono : strict_mono (coe : ℚ → K) :=
+λ m n, by simpa only [sub_pos, cast_sub] using @cast_pos_of_pos K _ (n - m)
 
-@[simp] theorem cast_pos [linear_ordered_field α] {n : ℚ} : (0 : α) < n ↔ 0 < n :=
-by rw [← cast_zero, cast_lt]
+@[mono] lemma cast_mono : monotone (coe : ℚ → K) := cast_strict_mono.monotone
 
-@[simp] theorem cast_lt_zero [linear_ordered_field α] {n : ℚ} : (n : α) < 0 ↔ n < 0 :=
-by rw [← cast_zero, cast_lt]
+/-- Coercion from `ℚ` as an order embedding. -/
+@[simps] def cast_order_embedding : ℚ ↪o K := order_embedding.of_strict_mono coe cast_strict_mono
 
-@[simp, norm_cast] theorem cast_id : ∀ n : ℚ, ↑n = n
-| ⟨n, d, h, c⟩ := by rw [num_denom', cast_mk, mk_eq_div]
+@[simp, norm_cast] theorem cast_le {m n : ℚ} : (m : K) ≤ n ↔ m ≤ n := cast_order_embedding.le_iff_le
+@[simp, norm_cast] theorem cast_lt {m n : ℚ} : (m : K) < n ↔ m < n := cast_strict_mono.lt_iff_lt
 
-@[simp] lemma cast_hom_rat : cast_hom ℚ = ring_hom.id ℚ :=
-ring_hom.ext cast_id
+@[simp] theorem cast_nonneg {n : ℚ} : 0 ≤ (n : K) ↔ 0 ≤ n := by norm_cast
+@[simp] theorem cast_nonpos {n : ℚ} : (n : K) ≤ 0 ↔ n ≤ 0 := by norm_cast
+@[simp] theorem cast_pos {n : ℚ} : (0 : K) < n ↔ 0 < n := by norm_cast
+@[simp] theorem cast_lt_zero {n : ℚ} : (n : K) < 0 ↔ n < 0 := by norm_cast
 
-@[simp, norm_cast] theorem cast_min [linear_ordered_field α] {a b : ℚ} :
-  (↑(min a b) : α) = min a b :=
-by by_cases a ≤ b; simp [h, min_def]
+@[simp, norm_cast] theorem cast_min {a b : ℚ} : (↑(min a b) : K) = min a b :=
+(@cast_mono K _).map_min
 
-@[simp, norm_cast] theorem cast_max [linear_ordered_field α] {a b : ℚ} :
-  (↑(max a b) : α) = max a b :=
-by by_cases b ≤ a; simp [h, max_def]
+@[simp, norm_cast] theorem cast_max {a b : ℚ} : (↑(max a b) : K) = max a b :=
+(@cast_mono K _).map_max
 
-@[simp, norm_cast] theorem cast_abs [linear_ordered_field α] {q : ℚ} :
-  ((|q| : ℚ) : α) = |q| :=
-by simp [abs_eq_max_neg]
+@[simp, norm_cast] theorem cast_abs {q : ℚ} : ((|q| : ℚ) : K) = |q| := by simp [abs_eq_max_neg]
 
-end rat
+open set
 
-open rat ring_hom
+@[simp] lemma preimage_cast_Icc (a b : ℚ) : coe ⁻¹' (Icc (a : K) b) = Icc a b := by { ext x, simp }
+@[simp] lemma preimage_cast_Ico (a b : ℚ) : coe ⁻¹' (Ico (a : K) b) = Ico a b := by { ext x, simp }
+@[simp] lemma preimage_cast_Ioc (a b : ℚ) : coe ⁻¹' (Ioc (a : K) b) = Ioc a b := by { ext x, simp }
+@[simp] lemma preimage_cast_Ioo (a b : ℚ) : coe ⁻¹' (Ioo (a : K) b) = Ioo a b := by { ext x, simp }
+@[simp] lemma preimage_cast_Ici (a : ℚ) : coe ⁻¹' (Ici (a : K)) = Ici a := by { ext x, simp }
+@[simp] lemma preimage_cast_Iic (a : ℚ) : coe ⁻¹' (Iic (a : K)) = Iic a := by { ext x, simp }
+@[simp] lemma preimage_cast_Ioi (a : ℚ) : coe ⁻¹' (Ioi (a : K)) = Ioi a := by { ext x, simp }
+@[simp] lemma preimage_cast_Iio (a : ℚ) : coe ⁻¹' (Iio (a : K)) = Iio a := by { ext x, simp }
 
-lemma ring_hom.eq_rat_cast {k} [division_ring k] (f : ℚ →+* k) (r : ℚ) : f r = r :=
-calc f r = f (r.1 / r.2) : by rw [← int.cast_coe_nat, ← mk_eq_div, num_denom]
-     ... = f r.1 / f r.2 : f.map_div _ _
-     ... = r.1 / r.2     : by rw [map_nat_cast, map_int_cast]
+end linear_ordered_field
 
--- This seems to be true for a `[char_p k]` too because `k'` must have the same characteristic
--- but the proof would be much longer
-@[simp] lemma map_rat_cast [division_ring α] [division_ring β] [char_zero α] [ring_hom_class F α β]
-  (f : F) (q : ℚ) : f q = q :=
-((f : α →+* β).comp $ cast_hom α).eq_rat_cast q
+@[norm_cast] theorem cast_id (n : ℚ) : (↑n : ℚ) = n := by rw [cast_def, num_div_denom]
+@[simp] theorem cast_eq_id : (coe : ℚ → ℚ) = id := funext cast_id
+@[simp] lemma cast_hom_rat : cast_hom ℚ = ring_hom.id ℚ := ring_hom.ext cast_id
 
-lemma ring_hom.ext_rat {R : Type*} [semiring R] (f g : ℚ →+* R) : f = g :=
-begin
-  ext r,
-  refine rat.num_denom_cases_on' r _,
-  intros a b b0,
-  let φ : ℤ →+* R := f.comp (int.cast_ring_hom ℚ),
-  let ψ : ℤ →+* R := g.comp (int.cast_ring_hom ℚ),
-  rw [rat.mk_eq_div, int.cast_coe_nat],
-  have b0' : (b:ℚ) ≠ 0 := nat.cast_ne_zero.2 b0,
-  have : ∀ n : ℤ, f n = g n := λ n, show φ n = ψ n, by rw [φ.ext_int ψ],
-  calc f (a * b⁻¹)
-      = f a * f b⁻¹ * (g (b:ℤ) * g b⁻¹) :
-        by rw [int.cast_coe_nat, ← g.map_mul, mul_inv_cancel b0', g.map_one, mul_one, f.map_mul]
-  ... = g a * f b⁻¹ * (f (b:ℤ) * g b⁻¹) : by rw [this a, ← this b]
-  ... = g (a * b⁻¹) :
-        by rw [int.cast_coe_nat, mul_assoc, ← mul_assoc (f b⁻¹),
-              ← f.map_mul, inv_mul_cancel b0', f.map_one, one_mul, g.map_mul]
-end
+end rat
 
-instance rat.subsingleton_ring_hom {R : Type*} [semiring R] : subsingleton (ℚ →+* R) :=
-⟨ring_hom.ext_rat⟩
+open rat
+
+@[simp] lemma map_rat_cast [division_ring α] [division_ring β] [ring_hom_class F α β]
+  (f : F) (q : ℚ) : f q = q :=
+by rw [cast_def, map_div₀, map_int_cast, map_nat_cast, cast_def]
+
+@[simp] lemma eq_rat_cast {k} [division_ring k] [ring_hom_class F ℚ k] (f : F) (r : ℚ) : f r = r :=
+by rw [← map_rat_cast f, rat.cast_id]
 
 namespace monoid_with_zero_hom
 
-variables {M : Type*} [group_with_zero M]
+variables {M₀ : Type*} [monoid_with_zero M₀] [monoid_with_zero_hom_class F ℚ M₀] {f g : F}
+include M₀
+
+/-- If `f` and `g` agree on the integers then they are equal `φ`. -/
+theorem ext_rat' (h : ∀ m : ℤ, f m = g m) : f = g :=
+fun_like.ext f g $ λ r, by rw [← r.num_div_denom, div_eq_mul_inv, map_mul, map_mul, h,
+  ← int.cast_coe_nat, eq_on_inv₀ f g (h _)]
 
 /-- If `f` and `g` agree on the integers then they are equal `φ`.
 
 See note [partially-applied ext lemmas] for why `comp` is used here. -/
-@[ext]
-theorem ext_rat {f g : ℚ →*₀ M}
-  (same_on_int : f.comp (int.cast_ring_hom ℚ).to_monoid_with_zero_hom =
-    g.comp (int.cast_ring_hom ℚ).to_monoid_with_zero_hom) : f = g :=
-begin
-  have same_on_int' : ∀ k : ℤ, f k = g k := congr_fun same_on_int,
-  ext x,
-  rw [← @rat.num_denom x, rat.mk_eq_div, f.map_div, g.map_div,
-    same_on_int' x.num, same_on_int' x.denom],
-end
+@[ext] theorem ext_rat {f g : ℚ →*₀ M₀}
+  (h : f.comp (int.cast_ring_hom ℚ : ℤ →*₀ ℚ) = g.comp (int.cast_ring_hom ℚ)) : f = g :=
+ext_rat' $ congr_fun h
 
 /-- Positive integer values of a morphism `φ` and its value on `-1` completely determine `φ`. -/
-theorem ext_rat_on_pnat {f g : ℚ →*₀ M}
+theorem ext_rat_on_pnat
   (same_on_neg_one : f (-1) = g (-1)) (same_on_pnat : ∀ n : ℕ, 0 < n → f n = g n) : f = g :=
-ext_rat $ ext_int' (by simpa) ‹_›
+ext_rat' $ fun_like.congr_fun $ show (f : ℚ →*₀ M₀).comp (int.cast_ring_hom ℚ : ℤ →*₀ ℚ) =
+  (g : ℚ →*₀ M₀).comp (int.cast_ring_hom ℚ : ℤ →*₀ ℚ),
+  from ext_int' (by simpa) (by simpa)
 
 end monoid_with_zero_hom
 
-namespace mul_opposite
+/-- Any two ring homomorphisms from `ℚ` to a semiring are equal. If the codomain is a division ring,
+then this lemma follows from `eq_rat_cast`. -/
+lemma ring_hom.ext_rat {R : Type*} [semiring R] [ring_hom_class F ℚ R] (f g : F) : f = g :=
+monoid_with_zero_hom.ext_rat' $ ring_hom.congr_fun $
+  ((f : ℚ →+* R).comp (int.cast_ring_hom ℚ)).ext_int ((g : ℚ →+* R).comp (int.cast_ring_hom ℚ))
+
+instance rat.subsingleton_ring_hom {R : Type*} [semiring R] : subsingleton (ℚ →+* R) :=
+⟨ring_hom.ext_rat⟩
 
-variables [division_ring α]
+section smul
+
+namespace rat
 
-@[simp, norm_cast] lemma op_rat_cast (r : ℚ) : op (r : α) = (↑r : αᵐᵒᵖ) :=
-by rw [cast_def, div_eq_mul_inv, op_mul, op_inv, op_nat_cast, op_int_cast,
-    (commute.cast_int_right _ r.num).eq, cast_def, div_eq_mul_inv]
+variables {K : Type*} [division_ring K]
 
-@[simp, norm_cast] lemma unop_rat_cast (r : ℚ) : unop (r : αᵐᵒᵖ) = r :=
-by rw [cast_def, div_eq_mul_inv, unop_mul, unop_inv, unop_nat_cast, unop_int_cast,
-    (commute.cast_int_right _ r.num).eq, cast_def, div_eq_mul_inv]
+@[priority 100]
+instance distrib_smul  : distrib_smul ℚ K :=
+{ smul := (•),
+  smul_zero := λ a, by rw [smul_def, mul_zero],
+  smul_add := λ a x y, by simp only [smul_def, mul_add, cast_add] }
+
+instance is_scalar_tower_right : is_scalar_tower ℚ K K :=
+⟨λ a x y, by simp only [smul_def, smul_eq_mul, mul_assoc]⟩
+
+end rat
 
-end mul_opposite
+end smul
diff --git a/src/data/rat/default.lean b/src/data/rat/default.lean
deleted file mode 100644
index 8b8f15ad95b88..0000000000000
--- a/src/data/rat/default.lean
+++ /dev/null
@@ -1,9 +0,0 @@
-/-
-Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kevin Kappelmann
--/
-import data.rat.floor
-/-!
-# Default Imports to Work With Rational Numbers
--/
diff --git a/src/data/rat/defs.lean b/src/data/rat/defs.lean
new file mode 100644
index 0000000000000..e0b4580e5ecca
--- /dev/null
+++ b/src/data/rat/defs.lean
@@ -0,0 +1,592 @@
+/-
+Copyright (c) 2019 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import data.rat.init
+import data.int.cast.defs
+import data.int.dvd.basic
+import algebra.ring.regular
+import data.nat.gcd.basic
+import data.pnat.defs
+
+/-!
+# Basics for the Rational Numbers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Summary
+
+We define the integral domain structure on `ℚ` and prove basic lemmas about it.
+The definition of the field structure on `ℚ` will be done in `data.rat.basic` once the
+`field` class has been defined.
+
+## Main Definitions
+
+- `rat.mk n d` constructs a rational number `q = n / d` from `n d : ℤ`.
+
+## Notations
+
+- `/.` is infix notation for `rat.mk`.
+
+-/
+
+namespace rat
+
+/-- Embed an integer as a rational number. You should use the coercion `coe : ℤ → ℚ` instead. -/
+def of_int (n : ℤ) : ℚ :=
+⟨n, 1, nat.one_pos, nat.coprime_one_right _⟩
+
+instance : has_int_cast ℚ := ⟨of_int⟩
+
+@[simp] lemma of_int_eq_cast (n : ℤ) : of_int n = n := rfl
+@[simp, norm_cast] lemma coe_int_num (n : ℤ) : (n : ℚ).num = n := rfl
+@[simp, norm_cast] lemma coe_int_denom (n : ℤ) : (n : ℚ).denom = 1 := rfl
+
+instance : has_zero ℚ := ⟨(0 : ℤ)⟩
+instance : has_one ℚ := ⟨(1 : ℤ)⟩
+instance : inhabited ℚ := ⟨0⟩
+
+/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ+` (not necessarily coprime) -/
+def mk_pnat (n : ℤ) : ℕ+ → ℚ | ⟨d, dpos⟩ :=
+let n' := n.nat_abs, g := n'.gcd d in
+⟨n / g, d / g, begin
+  apply (nat.le_div_iff_mul_le (nat.gcd_pos_of_pos_right _ dpos)).2,
+  rw one_mul, exact nat.le_of_dvd dpos (nat.gcd_dvd_right _ _)
+end, begin
+  have : int.nat_abs (n / ↑g) = n' / g,
+  { cases int.nat_abs_eq n with e e; rw e, { refl },
+    rw [int.neg_div_of_dvd, int.nat_abs_neg], { refl },
+    exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) },
+  rw this,
+  exact nat.coprime_div_gcd_div_gcd (nat.gcd_pos_of_pos_right _ dpos)
+end⟩
+
+/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ`. In the case `d = 0`, we
+  define `n / 0 = 0` by convention. -/
+def mk_nat (n : ℤ) (d : ℕ) : ℚ :=
+if d0 : d = 0 then 0 else mk_pnat n ⟨d, nat.pos_of_ne_zero d0⟩
+
+/-- Form the quotient `n / d` where `n d : ℤ`. -/
+def mk : ℤ → ℤ → ℚ
+| n (d : ℕ) := mk_nat n d
+| n -[1+ d] := mk_pnat (-n) d.succ_pnat
+
+localized "infix (name := rat.mk) ` /. `:70 := rat.mk" in rat
+
+theorem mk_pnat_eq (n d h) : mk_pnat n ⟨d, h⟩ = n /. d :=
+by change n /. d with dite _ _ _; simp [ne_of_gt h]
+
+theorem mk_nat_eq (n d) : mk_nat n d = n /. d := rfl
+
+@[simp] theorem mk_zero (n) : n /. 0 = 0 := rfl
+
+@[simp] theorem zero_mk_pnat (n) : mk_pnat 0 n = 0 :=
+begin
+  cases n with n npos,
+  simp only [mk_pnat, int.nat_abs_zero, nat.div_self npos, nat.gcd_zero_left, int.zero_div],
+  refl
+end
+
+@[simp] theorem zero_mk_nat (n) : mk_nat 0 n = 0 :=
+by by_cases n = 0; simp [*, mk_nat]
+
+@[simp] theorem zero_mk (n) : 0 /. n = 0 :=
+by cases n; simp [mk]
+
+private lemma gcd_abs_dvd_left {a b} : (nat.gcd (int.nat_abs a) b : ℤ) ∣ a :=
+int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ nat.gcd_dvd_left (int.nat_abs a) b
+
+@[simp] theorem mk_eq_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b = 0 ↔ a = 0 :=
+begin
+  refine ⟨λ h, _, by { rintro rfl, simp }⟩,
+  have : ∀ {a b}, mk_pnat a b = 0 → a = 0,
+  { rintro a ⟨b, h⟩ e,
+    injection e with e,
+    apply int.eq_mul_of_div_eq_right gcd_abs_dvd_left e },
+  cases b with b; simp only [mk, mk_nat, int.of_nat_eq_coe, dite_eq_left_iff] at h,
+  { simp only [mt (congr_arg int.of_nat) b0, not_false_iff, forall_true_left] at h,
+    exact this h },
+  { apply neg_injective, simp [this h] }
+end
+
+theorem mk_ne_zero {a b : ℤ} (b0 : b ≠ 0) : a /. b ≠ 0 ↔ a ≠ 0 :=
+(mk_eq_zero b0).not
+
+theorem mk_eq : ∀ {a b c d : ℤ} (hb : b ≠ 0) (hd : d ≠ 0),
+  a /. b = c /. d ↔ a * d = c * b :=
+suffices ∀ a b c d hb hd, mk_pnat a ⟨b, hb⟩ = mk_pnat c ⟨d, hd⟩ ↔ a * d = c * b,
+begin
+  intros, cases b with b b; simp [mk, mk_nat, nat.succ_pnat],
+  simp [mt (congr_arg int.of_nat) hb],
+  all_goals
+  { cases d with d d; simp [mk, mk_nat, nat.succ_pnat],
+    simp [mt (congr_arg int.of_nat) hd],
+    all_goals { rw this, try {refl} } },
+  { change a * ↑(d.succ) = -c * ↑b ↔ a * -(d.succ) = c * b,
+    constructor; intro h; apply neg_injective; simpa [left_distrib, neg_add_eq_iff_eq_add,
+      eq_neg_iff_add_eq_zero, neg_eq_iff_add_eq_zero] using h },
+  { change -a * ↑d = c * b.succ ↔ a * d = c * -b.succ,
+    constructor; intro h; apply neg_injective; simpa [left_distrib, eq_comm] using h },
+  { change -a * d.succ = -c * b.succ ↔ a * -d.succ = c * -b.succ,
+    simp [left_distrib, sub_eq_add_neg], cc }
+end,
+begin
+  intros, simp [mk_pnat], constructor; intro h,
+  { cases h with ha hb,
+    have ha,
+    { have dv := @gcd_abs_dvd_left,
+      have := int.eq_mul_of_div_eq_right dv ha,
+      rw ← int.mul_div_assoc _ dv at this,
+      exact int.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
+    have hb,
+    { have dv := λ {a b}, nat.gcd_dvd_right (int.nat_abs a) b,
+      have := nat.eq_mul_of_div_eq_right dv hb,
+      rw ← nat.mul_div_assoc _ dv at this,
+      exact nat.eq_mul_of_div_eq_left (dv.mul_left _) this.symm },
+    have m0 : (a.nat_abs.gcd b * c.nat_abs.gcd d : ℤ) ≠ 0,
+    { refine int.coe_nat_ne_zero.2 (ne_of_gt _),
+      apply mul_pos; apply nat.gcd_pos_of_pos_right; assumption },
+    apply mul_right_cancel₀ m0,
+    simpa [mul_comm, mul_left_comm] using
+      congr (congr_arg (*) ha.symm) (congr_arg coe hb) },
+  { suffices : ∀ a c, a * d = c * b →
+      a / a.gcd b = c / c.gcd d ∧ b / a.gcd b = d / c.gcd d,
+    { cases this a.nat_abs c.nat_abs
+        (by simpa [int.nat_abs_mul] using congr_arg int.nat_abs h) with h₁ h₂,
+      have hs := congr_arg int.sign h,
+      simp [int.sign_eq_one_of_pos (int.coe_nat_lt.2 hb),
+            int.sign_eq_one_of_pos (int.coe_nat_lt.2 hd)] at hs,
+      conv in a { rw ← int.sign_mul_nat_abs a },
+      conv in c { rw ← int.sign_mul_nat_abs c },
+      rw [int.mul_div_assoc, int.mul_div_assoc],
+      exact ⟨congr (congr_arg (*) hs) (congr_arg coe h₁), h₂⟩,
+      all_goals { exact int.coe_nat_dvd.2 (nat.gcd_dvd_left _ _) } },
+    intros a c h,
+    suffices bd : b / a.gcd b = d / c.gcd d,
+    { refine ⟨mul_left_cancel₀ hb.ne' _, bd⟩,
+      rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _), mul_comm,
+          nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), bd,
+          ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), h, mul_comm,
+          nat.mul_div_assoc _ (nat.gcd_dvd_left _ _)] },
+    suffices : ∀ {a c : ℕ} (b>0) (d>0),
+      a * d = c * b → b / a.gcd b ≤ d / c.gcd d,
+    { exact le_antisymm (this _ hb _ hd h) (this _ hd _ hb h.symm) },
+    intros a c b hb d hd h,
+    have gb0 := nat.gcd_pos_of_pos_right a hb,
+    have gd0 := nat.gcd_pos_of_pos_right c hd,
+    apply nat.le_of_dvd,
+    apply (nat.le_div_iff_mul_le gd0).2,
+    simp, apply nat.le_of_dvd hd (nat.gcd_dvd_right _ _),
+    apply (nat.coprime_div_gcd_div_gcd gb0).symm.dvd_of_dvd_mul_left,
+    refine ⟨c / c.gcd d, _⟩,
+    rw [← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
+        ← nat.mul_div_assoc _ (nat.gcd_dvd_right _ _)],
+    apply congr_arg (/ c.gcd d),
+    rw [mul_comm, ← nat.mul_div_assoc _ (nat.gcd_dvd_left _ _),
+        mul_comm, h, nat.mul_div_assoc _ (nat.gcd_dvd_right _ _), mul_comm] }
+end
+
+@[simp] theorem div_mk_div_cancel_left {a b c : ℤ} (c0 : c ≠ 0) :
+  (a * c) /. (b * c) = a /. b :=
+begin
+  by_cases b0 : b = 0, { subst b0, simp },
+  apply (mk_eq (mul_ne_zero b0 c0) b0).2, simp [mul_comm, mul_assoc]
+end
+
+@[simp] theorem num_denom : ∀ {a : ℚ}, a.num /. a.denom = a
+| ⟨n, d, h, (c:_=1)⟩ := show mk_nat n d = _,
+  by simp [mk_nat, ne_of_gt h, mk_pnat, c]
+
+theorem num_denom' {n d h c} : (⟨n, d, h, c⟩ : ℚ) = n /. d := num_denom.symm
+
+lemma coe_int_eq_mk (z : ℤ) : (z : ℚ) = z /. 1 := num_denom'
+
+/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
+numbers of the form `n /. d` with `0 < d` and coprime `n`, `d`. -/
+@[elab_as_eliminator] def {u} num_denom_cases_on {C : ℚ → Sort u}
+   : ∀ (a : ℚ) (H : ∀ n d, 0 < d → (int.nat_abs n).coprime d → C (n /. d)), C a
+| ⟨n, d, h, c⟩ H := by rw num_denom'; exact H n d h c
+
+/-- Define a (dependent) function or prove `∀ r : ℚ, p r` by dealing with rational
+numbers of the form `n /. d` with `d ≠ 0`. -/
+@[elab_as_eliminator] def {u} num_denom_cases_on' {C : ℚ → Sort u}
+   (a : ℚ) (H : ∀ (n:ℤ) (d:ℕ), d ≠ 0 → C (n /. d)) : C a :=
+num_denom_cases_on a $ λ n d h c, H n d h.ne'
+
+/-- Addition of rational numbers. Use `(+)` instead. -/
+protected def add : ℚ → ℚ → ℚ
+| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * d₂ + n₂ * d₁) ⟨d₁ * d₂, mul_pos h₁ h₂⟩
+
+instance : has_add ℚ := ⟨rat.add⟩
+
+theorem lift_binop_eq (f : ℚ → ℚ → ℚ) (f₁ : ℤ → ℤ → ℤ → ℤ → ℤ) (f₂ : ℤ → ℤ → ℤ → ℤ → ℤ)
+  (fv : ∀ {n₁ d₁ h₁ c₁ n₂ d₂ h₂ c₂},
+    f ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ = f₁ n₁ d₁ n₂ d₂ /. f₂ n₁ d₁ n₂ d₂)
+  (f0 : ∀ {n₁ d₁ n₂ d₂} (d₁0 : d₁ ≠ 0) (d₂0 : d₂ ≠ 0), f₂ n₁ d₁ n₂ d₂ ≠ 0)
+  (a b c d : ℤ) (b0 : b ≠ 0) (d0 : d ≠ 0)
+  (H : ∀ {n₁ d₁ n₂ d₂} (h₁ : a * d₁ = n₁ * b) (h₂ : c * d₂ = n₂ * d),
+       f₁ n₁ d₁ n₂ d₂ * f₂ a b c d = f₁ a b c d * f₂ n₁ d₁ n₂ d₂) :
+  f (a /. b) (c /. d) = f₁ a b c d /. f₂ a b c d :=
+begin
+  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
+  generalize hc : c /. d = x, cases x with n₂ d₂ h₂ c₂, rw num_denom' at hc,
+  rw fv,
+  have d₁0 := ne_of_gt (int.coe_nat_lt.2 h₁),
+  have d₂0 := ne_of_gt (int.coe_nat_lt.2 h₂),
+  exact (mk_eq (f0 d₁0 d₂0) (f0 b0 d0)).2 (H ((mk_eq b0 d₁0).1 ha) ((mk_eq d0 d₂0).1 hc))
+end
+
+@[simp] theorem add_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
+  a /. b + c /. d = (a * d + c * b) /. (b * d) :=
+begin
+  apply lift_binop_eq rat.add; intros; try {assumption},
+  { apply mk_pnat_eq },
+  { apply mul_ne_zero d₁0 d₂0 },
+  calc (n₁ * d₂ + n₂ * d₁) * (b * d) =
+          (n₁ * b) * d₂ * d + (n₂ * d) * (d₁ * b) : by simp [mul_add, mul_comm, mul_left_comm]
+    ... = (a * d₁) * d₂ * d + (c * d₂) * (d₁ * b) : by rw [h₁, h₂]
+    ... = (a * d + c * b) * (d₁ * d₂)             : by simp [mul_add, mul_comm, mul_left_comm]
+end
+
+/-- Negation of rational numbers. Use `-r` instead. -/
+protected def neg (r : ℚ) : ℚ :=
+⟨-r.num, r.denom, r.pos, by simp [r.cop]⟩
+
+instance : has_neg ℚ := ⟨rat.neg⟩
+
+@[simp] theorem neg_def {a b : ℤ} : -(a /. b) = -a /. b :=
+begin
+  by_cases b0 :  b = 0, { subst b0, simp, refl },
+  generalize ha : a /. b = x, cases x with n₁ d₁ h₁ c₁, rw num_denom' at ha,
+  show rat.mk' _ _ _ _ = _, rw num_denom',
+  have d0 := ne_of_gt (int.coe_nat_lt.2 h₁),
+  apply (mk_eq d0 b0).2, have h₁ := (mk_eq b0 d0).1 ha,
+  simp only [neg_mul, congr_arg has_neg.neg h₁]
+end
+
+@[simp] lemma mk_neg_denom (n d : ℤ) : n /. -d = -n /. d :=
+begin
+  by_cases hd : d = 0;
+  simp [rat.mk_eq, hd]
+end
+
+/-- Multiplication of rational numbers. Use `(*)` instead. -/
+protected def mul : ℚ → ℚ → ℚ
+| ⟨n₁, d₁, h₁, c₁⟩ ⟨n₂, d₂, h₂, c₂⟩ := mk_pnat (n₁ * n₂) ⟨d₁ * d₂, mul_pos h₁ h₂⟩
+
+instance : has_mul ℚ := ⟨rat.mul⟩
+
+@[simp] theorem mul_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
+  (a /. b) * (c /. d) = (a * c) /. (b * d) :=
+begin
+  apply lift_binop_eq rat.mul; intros; try {assumption},
+  { apply mk_pnat_eq },
+  { apply mul_ne_zero d₁0 d₂0 },
+  cc
+end
+
+/-- Inverse rational number. Use `r⁻¹` instead. -/
+protected def inv : ℚ → ℚ
+| ⟨(n+1:ℕ), d, h, c⟩ := ⟨d, n+1, n.succ_pos, c.symm⟩
+| ⟨0, d, h, c⟩ := 0
+| ⟨-[1+ n], d, h, c⟩ := ⟨-d, n+1, n.succ_pos, nat.coprime.symm $ by simp; exact c⟩
+
+instance : has_inv ℚ := ⟨rat.inv⟩
+instance : has_div ℚ := ⟨λ a b, a * b⁻¹⟩
+
+@[simp] theorem inv_def {a b : ℤ} : (a /. b)⁻¹ = b /. a :=
+begin
+  by_cases a0 : a = 0, { subst a0, simp, refl },
+  by_cases b0 : b = 0, { subst b0, simp, refl },
+  generalize ha : a /. b = x, cases x with n d h c, rw num_denom' at ha,
+  refine eq.trans (_ : rat.inv ⟨n, d, h, c⟩ = d /. n) _,
+  { cases n with n; [cases n with n, skip],
+    { refl },
+    { change int.of_nat n.succ with (n+1:ℕ),
+      unfold rat.inv, rw num_denom' },
+    { unfold rat.inv, rw num_denom', refl } },
+  have n0 : n ≠ 0,
+  { rintro rfl,
+    rw [rat.zero_mk, mk_eq_zero b0] at ha,
+    exact a0 ha },
+  have d0 := ne_of_gt (int.coe_nat_lt.2 h),
+  have ha := (mk_eq b0 d0).1 ha,
+  apply (mk_eq n0 a0).2,
+  cc
+end
+
+variables (a b c : ℚ)
+
+protected theorem add_zero : a + 0 = a :=
+num_denom_cases_on' a $ λ n d h,
+by rw [← zero_mk d]; simp [h, -zero_mk]
+
+protected theorem zero_add : 0 + a = a :=
+num_denom_cases_on' a $ λ n d h,
+by rw [← zero_mk d]; simp [h, -zero_mk]
+
+protected theorem add_comm : a + b = b + a :=
+num_denom_cases_on' a $ λ n₁ d₁ h₁,
+num_denom_cases_on' b $ λ n₂ d₂ h₂,
+by simp [h₁, h₂]; cc
+
+protected theorem add_assoc : a + b + c = a + (b + c) :=
+num_denom_cases_on' a $ λ n₁ d₁ h₁,
+num_denom_cases_on' b $ λ n₂ d₂ h₂,
+num_denom_cases_on' c $ λ n₃ d₃ h₃,
+by simp [h₁, h₂, h₃, mul_ne_zero, mul_add, mul_comm, mul_left_comm, add_left_comm, add_assoc]
+
+protected theorem add_left_neg : -a + a = 0 :=
+num_denom_cases_on' a $ λ n d h,
+by simp [h]
+
+@[simp] lemma mk_zero_one : 0 /. 1 = 0 :=
+show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }
+
+@[simp] lemma mk_one_one : 1 /. 1 = 1 :=
+show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }
+
+@[simp] lemma mk_neg_one_one : (-1) /. 1 = -1 :=
+show mk_pnat _ _ = _, by { rw mk_pnat, simp, refl }
+
+protected theorem mul_one : a * 1 = a :=
+num_denom_cases_on' a $ λ n d h,
+by { rw ← mk_one_one, simp [h, -mk_one_one] }
+
+protected theorem one_mul : 1 * a = a :=
+num_denom_cases_on' a $ λ n d h,
+by { rw ← mk_one_one, simp [h, -mk_one_one] }
+
+protected theorem mul_comm : a * b = b * a :=
+num_denom_cases_on' a $ λ n₁ d₁ h₁,
+num_denom_cases_on' b $ λ n₂ d₂ h₂,
+by simp [h₁, h₂, mul_comm]
+
+protected theorem mul_assoc : a * b * c = a * (b * c) :=
+num_denom_cases_on' a $ λ n₁ d₁ h₁,
+num_denom_cases_on' b $ λ n₂ d₂ h₂,
+num_denom_cases_on' c $ λ n₃ d₃ h₃,
+by simp [h₁, h₂, h₃, mul_ne_zero, mul_comm, mul_left_comm]
+
+protected theorem add_mul : (a + b) * c = a * c + b * c :=
+num_denom_cases_on' a $ λ n₁ d₁ h₁,
+num_denom_cases_on' b $ λ n₂ d₂ h₂,
+num_denom_cases_on' c $ λ n₃ d₃ h₃,
+by simp [h₁, h₂, h₃, mul_ne_zero];
+   refine (div_mk_div_cancel_left (int.coe_nat_ne_zero.2 h₃)).symm.trans _;
+   simp [mul_add, mul_comm, mul_assoc, mul_left_comm]
+
+protected theorem mul_add : a * (b + c) = a * b + a * c :=
+by rw [rat.mul_comm, rat.add_mul, rat.mul_comm, rat.mul_comm c a]
+
+protected theorem zero_ne_one : 0 ≠ (1:ℚ) :=
+by { rw [ne_comm, ← mk_one_one, mk_ne_zero one_ne_zero], exact one_ne_zero }
+
+protected theorem mul_inv_cancel : a ≠ 0 → a * a⁻¹ = 1 :=
+num_denom_cases_on' a $ λ n d h a0,
+have n0 : n ≠ 0, from mt (by { rintro rfl, simp }) a0,
+by simpa [h, n0, mul_comm] using @div_mk_div_cancel_left 1 1 _ n0
+
+protected theorem inv_mul_cancel (h : a ≠ 0) : a⁻¹ * a = 1 :=
+eq.trans (rat.mul_comm _ _) (rat.mul_inv_cancel _ h)
+
+instance : decidable_eq ℚ := by tactic.mk_dec_eq_instance
+
+/-! At this point in the import hierarchy we have not defined the `field` typeclass.
+Instead we'll instantiate `comm_ring` and `comm_group_with_zero` at this point.
+The `rat.field` instance and any field-specific lemmas can be found in `data.rat.basic`.
+-/
+
+instance : comm_ring ℚ :=
+{ zero             := 0,
+  add              := (+),
+  neg              := has_neg.neg,
+  one              := 1,
+  mul              := (*),
+  zero_add         := rat.zero_add,
+  add_zero         := rat.add_zero,
+  add_comm         := rat.add_comm,
+  add_assoc        := rat.add_assoc,
+  add_left_neg     := rat.add_left_neg,
+  mul_one          := rat.mul_one,
+  one_mul          := rat.one_mul,
+  mul_comm         := rat.mul_comm,
+  mul_assoc        := rat.mul_assoc,
+  left_distrib     := rat.mul_add,
+  right_distrib    := rat.add_mul,
+  int_cast         := coe,
+  /- Important: We do not set `nat_cast := λ n, ((n : ℤ) : ℚ)` (even though it's defeq) as that
+  makes `int.cast_coe_nat` and `coe_coe` loop in `simp`. -/
+  nat_cast         := λ n, of_int n,
+  nat_cast_zero    := rfl,
+  nat_cast_succ    := λ n, by simp only [of_int_eq_cast, coe_int_eq_mk,
+    add_def one_ne_zero one_ne_zero, ← mk_one_one, nat.cast_add, nat.cast_one, mul_one] }
+
+instance : comm_group_with_zero ℚ :=
+{ zero := 0,
+  one := 1,
+  mul := (*),
+  inv := has_inv.inv,
+  div := (/),
+  exists_pair_ne   := ⟨0, 1, rat.zero_ne_one⟩,
+  inv_zero := rfl,
+  mul_inv_cancel := rat.mul_inv_cancel,
+  mul_zero := mul_zero,
+  zero_mul := zero_mul,
+  .. rat.comm_ring }
+
+instance : is_domain ℚ :=
+no_zero_divisors.to_is_domain _
+
+/- Extra instances to short-circuit type class resolution -/
+-- TODO(Mario): this instance slows down data.real.basic
+instance : nontrivial ℚ         := by apply_instance
+--instance : ring ℚ             := by apply_instance
+instance : comm_semiring ℚ      := by apply_instance
+instance : semiring ℚ           := by apply_instance
+instance : add_comm_group ℚ     := by apply_instance
+instance : add_group ℚ          := by apply_instance
+instance : add_comm_monoid ℚ    := by apply_instance
+instance : add_monoid ℚ         := by apply_instance
+instance : add_left_cancel_semigroup ℚ := by apply_instance
+instance : add_right_cancel_semigroup ℚ := by apply_instance
+instance : add_comm_semigroup ℚ := by apply_instance
+instance : add_semigroup ℚ      := by apply_instance
+instance : comm_monoid ℚ        := by apply_instance
+instance : monoid ℚ             := by apply_instance
+instance : comm_semigroup ℚ     := by apply_instance
+instance : semigroup ℚ          := by apply_instance
+
+lemma denom_ne_zero (q : ℚ) : q.denom ≠ 0 :=
+ne_of_gt q.pos
+
+lemma eq_iff_mul_eq_mul {p q : ℚ} : p = q ↔ p.num * q.denom = q.num * p.denom :=
+begin
+  conv { to_lhs, rw [← @num_denom p, ← @num_denom q] },
+  apply rat.mk_eq;
+  { rw [← nat.cast_zero, ne, int.coe_nat_eq_coe_nat_iff],
+    apply denom_ne_zero, },
+end
+
+
+theorem sub_def {a b c d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
+  a /. b - c /. d = (a * d - c * b) /. (b * d) :=
+by simp [b0, d0, sub_eq_add_neg]
+
+@[simp] lemma denom_neg_eq_denom (q : ℚ) : (-q).denom = q.denom := rfl
+
+@[simp] lemma num_neg_eq_neg_num (q : ℚ) : (-q).num = -(q.num) := rfl
+
+@[simp] lemma num_zero : rat.num 0 = 0 := rfl
+
+@[simp] lemma denom_zero : rat.denom 0 = 1 := rfl
+
+lemma zero_of_num_zero {q : ℚ} (hq : q.num = 0) : q = 0 :=
+have q = q.num /. q.denom, from num_denom.symm,
+by simpa [hq]
+
+lemma zero_iff_num_zero {q : ℚ} : q = 0 ↔ q.num = 0 :=
+⟨λ _, by simp *, zero_of_num_zero⟩
+
+lemma num_ne_zero_of_ne_zero {q : ℚ} (h : q ≠ 0) : q.num ≠ 0 :=
+assume : q.num = 0,
+h $ zero_of_num_zero this
+
+@[simp] lemma num_one : (1 : ℚ).num = 1 := rfl
+
+@[simp] lemma denom_one : (1 : ℚ).denom = 1 := rfl
+
+lemma mk_num_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : n ≠ 0 :=
+assume : n = 0,
+hq $ by simpa [this] using hqnd
+
+lemma mk_denom_ne_zero_of_ne_zero {q : ℚ} {n d : ℤ} (hq : q ≠ 0) (hqnd : q = n /. d) : d ≠ 0 :=
+assume : d = 0,
+hq $ by simpa [this] using hqnd
+
+lemma mk_ne_zero_of_ne_zero {n d : ℤ} (h : n ≠ 0) (hd : d ≠ 0) : n /. d ≠ 0 :=
+(mk_ne_zero hd).mpr h
+
+lemma mul_num_denom (q r : ℚ) : q * r = (q.num * r.num) /. ↑(q.denom * r.denom) :=
+have hq' : (↑q.denom : ℤ) ≠ 0, by have := denom_ne_zero q; simpa,
+have hr' : (↑r.denom : ℤ) ≠ 0, by have := denom_ne_zero r; simpa,
+suffices (q.num /. ↑q.denom) * (r.num /. ↑r.denom) = (q.num * r.num) /. ↑(q.denom * r.denom),
+  by simpa using this,
+by simp [mul_def hq' hr', -num_denom]
+
+lemma div_num_denom (q r : ℚ) : q / r = (q.num * r.denom) /. (q.denom * r.num) :=
+if hr : r.num = 0 then
+  have hr' : r = 0, from zero_of_num_zero hr,
+  by simp *
+else
+  calc q / r = q * r⁻¹ : div_eq_mul_inv q r
+         ... = (q.num /. q.denom) * (r.num /. r.denom)⁻¹ : by simp
+         ... = (q.num /. q.denom) * (r.denom /. r.num) : by rw inv_def
+         ... = (q.num * r.denom) /. (q.denom * r.num) : mul_def (by simpa using denom_ne_zero q) hr
+
+section casts
+
+protected lemma add_mk (a b c : ℤ) : (a + b) /. c = a /. c + b /. c :=
+if h : c = 0 then by simp [h] else
+by { rw [add_def h h, mk_eq h (mul_ne_zero h h)], simp [add_mul, mul_assoc] }
+
+theorem mk_eq_div (n d : ℤ) : n /. d = ((n : ℚ) / d) :=
+begin
+  by_cases d0 : d = 0, {simp [d0, div_zero]},
+  simp [division_def, coe_int_eq_mk, mul_def one_ne_zero d0]
+end
+
+lemma mk_mul_mk_cancel {x : ℤ} (hx : x ≠ 0) (n d : ℤ) : (n /. x) * (x /. d) = n /. d :=
+begin
+  by_cases hd : d = 0,
+  { rw hd,
+    simp},
+  rw [mul_def hx hd, mul_comm x, div_mk_div_cancel_left hx],
+end
+
+lemma mk_div_mk_cancel_left {x : ℤ} (hx : x ≠ 0) (n d : ℤ) : (n /. x) / (d /. x) = n /. d :=
+by rw [div_eq_mul_inv, inv_def, mk_mul_mk_cancel hx]
+
+lemma mk_div_mk_cancel_right {x : ℤ} (hx : x ≠ 0) (n d : ℤ) : (x /. n) / (x /. d) = d /. n :=
+by rw [div_eq_mul_inv, inv_def, mul_comm, mk_mul_mk_cancel hx]
+
+lemma coe_int_div_eq_mk {n d : ℤ} : (n : ℚ) / ↑d = n /. d :=
+begin
+  repeat {rw coe_int_eq_mk},
+  exact mk_div_mk_cancel_left one_ne_zero n d,
+end
+
+@[simp]
+theorem num_div_denom (r : ℚ) : (r.num / r.denom : ℚ) = r :=
+by rw [← int.cast_coe_nat, ← mk_eq_div, num_denom]
+
+lemma coe_int_num_of_denom_eq_one {q : ℚ} (hq : q.denom = 1) : ↑(q.num) = q :=
+by { conv_rhs { rw [←(@num_denom q), hq] }, rw [coe_int_eq_mk], refl }
+
+lemma denom_eq_one_iff (r : ℚ) : r.denom = 1 ↔ ↑r.num = r :=
+⟨rat.coe_int_num_of_denom_eq_one, λ h, h ▸ rat.coe_int_denom r.num⟩
+
+instance can_lift : can_lift ℚ ℤ coe (λ q, q.denom = 1) :=
+⟨λ q hq, ⟨q.num, coe_int_num_of_denom_eq_one hq⟩⟩
+
+theorem coe_nat_eq_mk (n : ℕ) : ↑n = n /. 1 :=
+by rw [← int.cast_coe_nat, coe_int_eq_mk]
+
+@[simp, norm_cast] theorem coe_nat_num (n : ℕ) : (n : ℚ).num = n :=
+by rw [← int.cast_coe_nat, coe_int_num]
+
+@[simp, norm_cast] theorem coe_nat_denom (n : ℕ) : (n : ℚ).denom = 1 :=
+by rw [← int.cast_coe_nat, coe_int_denom]
+
+-- Will be subsumed by `int.coe_inj` after we have defined
+-- `linear_ordered_field ℚ` (which implies characteristic zero).
+lemma coe_int_inj (m n : ℤ) : (m : ℚ) = n ↔ m = n := ⟨congr_arg num, congr_arg _⟩
+
+end casts
+
+end rat
+
+-- Guard against import creep.
+assert_not_exists field
diff --git a/src/data/rat/denumerable.lean b/src/data/rat/denumerable.lean
index b5fa8b12c17b8..6c0d6a97d7e8c 100644
--- a/src/data/rat/denumerable.lean
+++ b/src/data/rat/denumerable.lean
@@ -8,6 +8,9 @@ import set_theory.cardinal.basic
 /-!
 # Denumerability of ℚ
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves that ℚ is infinite, denumerable, and deduces that it has cardinality `omega`.
 -/
 
@@ -35,10 +38,6 @@ end
 
 end rat
 
-namespace cardinal
-
 open_locale cardinal
 
-@[simp] lemma mk_rat : #ℚ = ω := mk_denumerable ℚ
-
-end cardinal
+lemma cardinal.mk_rat : #ℚ = ℵ₀ := by simp
diff --git a/src/data/rat/encodable.lean b/src/data/rat/encodable.lean
new file mode 100644
index 0000000000000..7fa5ed6a34ab8
--- /dev/null
+++ b/src/data/rat/encodable.lean
@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2019 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import logic.encodable.basic
+import data.nat.gcd.basic
+import data.rat.init
+
+/-! # The rationals are `encodable`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+As a consequence we also get the instance `countable ℚ`.
+
+This is kept separate from `data.rat.defs` in order to minimize imports.
+-/
+
+namespace rat
+
+instance : encodable ℚ := encodable.of_equiv (Σ n : ℤ, {d : ℕ // 0 < d ∧ n.nat_abs.coprime d})
+  ⟨λ ⟨a, b, c, d⟩, ⟨a, b, c, d⟩, λ⟨a, b, c, d⟩, ⟨a, b, c, d⟩,
+   λ ⟨a, b, c, d⟩, rfl, λ⟨a, b, c, d⟩, rfl⟩
+
+end rat
diff --git a/src/data/rat/floor.lean b/src/data/rat/floor.lean
index 8bff93de4016e..28d4ce7a7e78b 100644
--- a/src/data/rat/floor.lean
+++ b/src/data/rat/floor.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Kevin Kappelmann
 -/
 import algebra.order.floor
+import algebra.euclidean_domain.instances
 import tactic.field_simp
 
 /-!
 # Floor Function for Rational Numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Summary
 
 We define the `floor` function and the `floor_ring` instance on `ℚ`. Some technical lemmas relating
@@ -22,6 +26,7 @@ rat, rationals, ℚ, floor
 open int
 
 namespace rat
+variables {α : Type*} [linear_ordered_field α] [floor_ring α]
 
 /-- `floor q` is the largest integer `z` such that `z ≤ q` -/
 protected def floor : ℚ → ℤ
@@ -45,23 +50,30 @@ protected lemma floor_def {q : ℚ} : ⌊q⌋ = q.num / q.denom := by { cases q,
 lemma floor_int_div_nat_eq_div {n : ℤ} {d : ℕ} : ⌊(↑n : ℚ) / (↑d : ℚ)⌋ = n / (↑d : ℤ) :=
 begin
   rw [rat.floor_def],
-  cases decidable.em (d = 0) with d_eq_zero d_ne_zero,
-  { simp [d_eq_zero] },
-  { set q := (n : ℚ) / d with q_eq,
-    obtain ⟨c, n_eq_c_mul_num, d_eq_c_mul_denom⟩ : ∃ c, n = c * q.num ∧ (d : ℤ) = c * q.denom, by
-    { rw q_eq,
-      exact_mod_cast (@rat.exists_eq_mul_div_num_and_eq_mul_div_denom n d
-        (by exact_mod_cast d_ne_zero)) },
-    suffices : q.num / q.denom = c * q.num / (c * q.denom),
-      by rwa [n_eq_c_mul_num, d_eq_c_mul_denom],
-    suffices : c > 0, by solve_by_elim [int.mul_div_mul_of_pos],
-    have q_denom_mul_c_pos : (0 : ℤ) < q.denom * c, by
-    { have : (d : ℤ) > 0, by exact_mod_cast (pos_iff_ne_zero.elim_right d_ne_zero),
-      rwa [d_eq_c_mul_denom, mul_comm] at this },
-    suffices : (0 : ℤ) ≤ q.denom, from pos_of_mul_pos_left q_denom_mul_c_pos this,
-    exact_mod_cast (le_of_lt q.pos) }
+  obtain rfl | hd := @eq_zero_or_pos _ _ d,
+  { simp },
+  set q := (n : ℚ) / d with q_eq,
+  obtain ⟨c, n_eq_c_mul_num, d_eq_c_mul_denom⟩ : ∃ c, n = c * q.num ∧ (d : ℤ) = c * q.denom, by
+  { rw q_eq,
+    exact_mod_cast @rat.exists_eq_mul_div_num_and_eq_mul_div_denom n d (by exact_mod_cast hd.ne') },
+  rw [n_eq_c_mul_num, d_eq_c_mul_denom],
+  refine (int.mul_div_mul_of_pos _ _ $ pos_of_mul_pos_left _ $ int.coe_nat_nonneg q.denom).symm,
+  rwa [←d_eq_c_mul_denom, int.coe_nat_pos],
 end
 
+@[simp, norm_cast] lemma floor_cast (x : ℚ) : ⌊(x : α)⌋ = ⌊x⌋ :=
+floor_eq_iff.2 (by exact_mod_cast floor_eq_iff.1 (eq.refl ⌊x⌋))
+
+@[simp, norm_cast] lemma ceil_cast (x : ℚ) : ⌈(x : α)⌉ = ⌈x⌉ :=
+by rw [←neg_inj, ←floor_neg, ←floor_neg, ← rat.cast_neg, rat.floor_cast]
+
+@[simp, norm_cast] lemma round_cast (x : ℚ) : round (x : α) = round x :=
+have ((x + 1 / 2 : ℚ) : α) = x + 1 / 2, by simp,
+by rw [round_eq, round_eq, ← this, floor_cast]
+
+@[simp, norm_cast] lemma cast_fract (x : ℚ) : (↑(fract x) : α) = fract x :=
+by simp only [fract, cast_sub, cast_coe_int, floor_cast]
+
 end rat
 
 
@@ -117,9 +129,8 @@ begin
     have : ((q.denom - q.num * ⌊q_inv⌋ : ℚ) / q.num).num = q.denom - q.num * ⌊q_inv⌋, by
     { suffices : ((q.denom : ℤ) - q.num * ⌊q_inv⌋).nat_abs.coprime q.num.nat_abs, by
         exact_mod_cast (rat.num_div_eq_of_coprime q_num_pos this),
-      have : (q.num.nat_abs : ℚ) = (q.num : ℚ), by exact_mod_cast q_num_abs_eq_q_num,
       have tmp := nat.coprime_sub_mul_floor_rat_div_of_coprime q.cop.symm,
-      simpa only [this, q_num_abs_eq_q_num] using tmp },
+      simpa only [nat.cast_nat_abs, abs_of_nonneg q_num_pos.le] using tmp },
     rwa this },
   -- to show the claim, start with the following inequality
   have q_inv_num_denom_ineq : q⁻¹.num - ⌊q⁻¹⌋ * q⁻¹.denom < q⁻¹.denom, by
diff --git a/src/data/rat/init.lean b/src/data/rat/init.lean
new file mode 100644
index 0000000000000..988264f5e30f5
--- /dev/null
+++ b/src/data/rat/init.lean
@@ -0,0 +1,74 @@
+/-
+Copyright (c) 2019 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import tactic.ext
+import logic.basic
+
+/-!
+# The definition of the Rational Numbers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Summary
+
+We define a rational number `q` as a structure `{ num, denom, pos, cop }`, where
+- `num` is the numerator of `q`,
+- `denom` is the denominator of `q`,
+- `pos` is a proof that `denom > 0`, and
+- `cop` is a proof `num` and `denom` are coprime.
+
+Basic constructions and results are set up in `data.rat.defs`.
+As we transition to Lean 4, these two files can probably be merged again,
+as so much of the needed material will be in Std4 anyway.
+
+For now, this split allows us to give the definitions of division rings and fields
+without significant theory imports.
+
+The definition of the field structure on `ℚ` will be done in `data.rat.basic` once the
+`field` class has been defined.
+
+## Main Definitions
+
+- `rat` is the structure encoding `ℚ`.
+
+## Notations
+
+## Tags
+
+rat, rationals, field, ℚ, numerator, denominator, num, denom
+-/
+
+/-- `rat`, or `ℚ`, is the type of rational numbers. It is defined
+  as the set of pairs ⟨n, d⟩ of integers such that `d` is positive and `n` and
+  `d` are coprime. This representation is preferred to the quotient
+  because without periodic reduction, the numerator and denominator can grow
+  exponentially (for example, adding 1/2 to itself repeatedly). -/
+structure rat := mk' ::
+(num : ℤ)
+(denom : ℕ)
+(pos : 0 < denom)
+(cop : num.nat_abs.coprime denom)
+notation `ℚ` := rat
+
+namespace rat
+
+/-- String representation of a rational numbers, used in `has_repr`, `has_to_string`, and
+`has_to_format` instances. -/
+protected def repr : ℚ → string
+| ⟨n, d, _, _⟩ := if d = 1 then _root_.repr n else
+  _root_.repr n ++ "/" ++ _root_.repr d
+
+instance : has_repr ℚ := ⟨rat.repr⟩
+instance : has_to_string ℚ := ⟨rat.repr⟩
+meta instance : has_to_format ℚ := ⟨coe ∘ rat.repr⟩
+
+lemma ext_iff {p q : ℚ} : p = q ↔ p.num = q.num ∧ p.denom = q.denom :=
+by { cases p, cases q, simp }
+
+@[ext] lemma ext {p q : ℚ} (hn : p.num = q.num) (hd : p.denom = q.denom) : p = q :=
+rat.ext_iff.mpr ⟨hn, hd⟩
+
+end rat
diff --git a/src/data/rat/lemmas.lean b/src/data/rat/lemmas.lean
new file mode 100644
index 0000000000000..ed1458d007002
--- /dev/null
+++ b/src/data/rat/lemmas.lean
@@ -0,0 +1,338 @@
+/-
+Copyright (c) 2019 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import data.rat.defs
+import data.int.cast.lemmas
+import data.int.div
+import algebra.group_with_zero.units.lemmas
+import tactic.nth_rewrite
+
+/-!
+# Further lemmas for the Rational Numbers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+namespace rat
+open_locale rat
+
+theorem num_dvd (a) {b : ℤ} (b0 : b ≠ 0) : (a /. b).num ∣ a :=
+begin
+  cases e : a /. b with n d h c,
+  rw [rat.num_denom', rat.mk_eq b0
+    (ne_of_gt (int.coe_nat_pos.2 h))] at e,
+  refine (int.nat_abs_dvd.1 $ int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $
+    c.dvd_of_dvd_mul_right _),
+  have := congr_arg int.nat_abs e,
+  simp only [int.nat_abs_mul, int.nat_abs_of_nat] at this, simp [this]
+end
+
+theorem denom_dvd (a b : ℤ) : ((a /. b).denom : ℤ) ∣ b :=
+begin
+  by_cases b0 : b = 0, {simp [b0]},
+  cases e : a /. b with n d h c,
+  rw [num_denom', mk_eq b0 (ne_of_gt (int.coe_nat_pos.2 h))] at e,
+  refine (int.dvd_nat_abs.1 $ int.coe_nat_dvd.2 $ c.symm.dvd_of_dvd_mul_left _),
+  rw [← int.nat_abs_mul, ← int.coe_nat_dvd, int.dvd_nat_abs, ← e], simp
+end
+
+lemma num_denom_mk {q : ℚ} {n d : ℤ} (hd : d ≠ 0) (qdf : q = n /. d) :
+  ∃ c : ℤ, n = c * q.num ∧ d = c * q.denom :=
+begin
+  obtain rfl|hn := eq_or_ne n 0,
+  { simp [qdf] },
+  have : q.num * d = n * ↑(q.denom),
+  { refine (rat.mk_eq _ hd).mp _,
+    { exact int.coe_nat_ne_zero.mpr (rat.denom_ne_zero _) },
+    { rwa [num_denom] } },
+  have hqdn : q.num ∣ n,
+  { rw qdf, exact rat.num_dvd _ hd },
+  refine ⟨n / q.num, _, _⟩,
+  { rw int.div_mul_cancel hqdn },
+  { refine int.eq_mul_div_of_mul_eq_mul_of_dvd_left _ hqdn this,
+    rw qdf,
+    exact rat.num_ne_zero_of_ne_zero ((mk_ne_zero hd).mpr hn) }
+end
+
+theorem mk_pnat_num (n : ℤ) (d : ℕ+) :
+  (mk_pnat n d).num = n / nat.gcd n.nat_abs d :=
+by cases d; refl
+
+theorem mk_pnat_denom (n : ℤ) (d : ℕ+) :
+  (mk_pnat n d).denom = d / nat.gcd n.nat_abs d :=
+by cases d; refl
+
+lemma num_mk (n d : ℤ) :
+  (n /. d).num = d.sign * n / n.gcd d :=
+begin
+  rcases d with ((_ | _) | _);
+    simp [rat.mk, mk_nat, mk_pnat, nat.succ_pnat, int.sign, int.gcd,
+      -nat.cast_succ, -int.coe_nat_succ, int.zero_div]
+end
+
+lemma denom_mk (n d : ℤ) :
+  (n /. d).denom = if d = 0 then 1 else d.nat_abs / n.gcd d :=
+begin
+  rcases d with ((_ | _) | _);
+  simp [rat.mk, mk_nat, mk_pnat, nat.succ_pnat, int.sign, int.gcd,
+    -nat.cast_succ, -int.coe_nat_succ]
+end
+
+theorem mk_pnat_denom_dvd (n : ℤ) (d : ℕ+) :
+  (mk_pnat n d).denom ∣ d.1 :=
+begin
+  rw mk_pnat_denom,
+  apply nat.div_dvd_of_dvd,
+  apply nat.gcd_dvd_right
+end
+
+theorem add_denom_dvd (q₁ q₂ : ℚ) : (q₁ + q₂).denom ∣ q₁.denom * q₂.denom :=
+by { cases q₁, cases q₂, apply mk_pnat_denom_dvd }
+
+theorem mul_denom_dvd (q₁ q₂ : ℚ) : (q₁ * q₂).denom ∣ q₁.denom * q₂.denom :=
+by { cases q₁, cases q₂, apply mk_pnat_denom_dvd }
+
+theorem mul_num (q₁ q₂ : ℚ) : (q₁ * q₂).num =
+  (q₁.num * q₂.num) / nat.gcd (q₁.num * q₂.num).nat_abs (q₁.denom * q₂.denom) :=
+by cases q₁; cases q₂; refl
+
+theorem mul_denom (q₁ q₂ : ℚ) : (q₁ * q₂).denom =
+  (q₁.denom * q₂.denom) / nat.gcd (q₁.num * q₂.num).nat_abs (q₁.denom * q₂.denom) :=
+by cases q₁; cases q₂; refl
+
+theorem mul_self_num (q : ℚ) : (q * q).num = q.num * q.num :=
+by rw [mul_num, int.nat_abs_mul, nat.coprime.gcd_eq_one, int.coe_nat_one, int.div_one];
+exact (q.cop.mul_right q.cop).mul (q.cop.mul_right q.cop)
+
+theorem mul_self_denom (q : ℚ) : (q * q).denom = q.denom * q.denom :=
+by rw [rat.mul_denom, int.nat_abs_mul, nat.coprime.gcd_eq_one, nat.div_one];
+exact (q.cop.mul_right q.cop).mul (q.cop.mul_right q.cop)
+
+lemma add_num_denom (q r : ℚ) : q + r =
+  ((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ) :=
+have hqd : (q.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 q.3,
+have hrd : (r.denom : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 r.3,
+by conv_lhs { rw [←@num_denom q, ←@num_denom r, rat.add_def hqd hrd] };
+  simp [mul_comm]
+
+section casts
+
+lemma exists_eq_mul_div_num_and_eq_mul_div_denom (n : ℤ) {d : ℤ} (d_ne_zero : d ≠ 0) :
+  ∃ (c : ℤ), n = c * ((n : ℚ) / d).num ∧ (d : ℤ) = c * ((n : ℚ) / d).denom :=
+begin
+  have : ((n : ℚ) / d) = rat.mk n d, by rw [←rat.mk_eq_div],
+  exact rat.num_denom_mk d_ne_zero this
+end
+
+lemma mul_num_denom' (q r : ℚ) :
+  (q * r).num * q.denom * r.denom = q.num * r.num * (q * r).denom :=
+begin
+  let s := (q.num * r.num) /. (q.denom * r.denom : ℤ),
+  have hs : (q.denom * r.denom : ℤ) ≠ 0 := int.coe_nat_ne_zero_iff_pos.mpr (mul_pos q.pos r.pos),
+  obtain ⟨c, ⟨c_mul_num, c_mul_denom⟩⟩ :=
+    exists_eq_mul_div_num_and_eq_mul_div_denom (q.num * r.num) hs,
+  rw [c_mul_num, mul_assoc, mul_comm],
+  nth_rewrite 0 c_mul_denom,
+  repeat {rw mul_assoc},
+  apply mul_eq_mul_left_iff.2,
+  rw or_iff_not_imp_right,
+  intro c_pos,
+  have h : _ = s := @mul_def q.num q.denom r.num r.denom
+    (int.coe_nat_ne_zero_iff_pos.mpr q.pos)
+    (int.coe_nat_ne_zero_iff_pos.mpr  r.pos),
+  rw [num_denom, num_denom] at h,
+  rw h,
+  rw mul_comm,
+  apply rat.eq_iff_mul_eq_mul.mp,
+  rw ←mk_eq_div,
+end
+
+lemma add_num_denom' (q r : ℚ) :
+  (q + r).num * q.denom * r.denom = (q.num * r.denom + r.num * q.denom) * (q + r).denom :=
+begin
+  let s := mk (q.num * r.denom + r.num * q.denom) (q.denom * r.denom : ℤ),
+  have hs : (q.denom * r.denom : ℤ) ≠ 0 := int.coe_nat_ne_zero_iff_pos.mpr (mul_pos q.pos r.pos),
+  obtain ⟨c, ⟨c_mul_num, c_mul_denom⟩⟩ := exists_eq_mul_div_num_and_eq_mul_div_denom
+    (q.num * r.denom + r.num * q.denom) hs,
+  rw [c_mul_num, mul_assoc, mul_comm],
+  nth_rewrite 0 c_mul_denom,
+  repeat {rw mul_assoc},
+  apply mul_eq_mul_left_iff.2,
+  rw or_iff_not_imp_right,
+  intro c_pos,
+  have h : _ = s := @add_def q.num q.denom r.num r.denom
+    (int.coe_nat_ne_zero_iff_pos.mpr q.pos)
+    (int.coe_nat_ne_zero_iff_pos.mpr  r.pos),
+  rw [num_denom, num_denom] at h,
+  rw h,
+  rw mul_comm,
+  apply rat.eq_iff_mul_eq_mul.mp,
+  rw ←mk_eq_div,
+end
+
+lemma substr_num_denom' (q r : ℚ) :
+  (q - r).num * q.denom * r.denom = (q.num * r.denom - r.num * q.denom) * (q - r).denom :=
+by rw [sub_eq_add_neg, sub_eq_add_neg, ←neg_mul, ←num_neg_eq_neg_num, ←denom_neg_eq_denom r,
+  add_num_denom' q (-r)]
+
+end casts
+
+lemma inv_def' {q : ℚ} : q⁻¹ = (q.denom : ℚ) / q.num :=
+by { conv_lhs { rw ←@num_denom q }, rw [inv_def, mk_eq_div, int.cast_coe_nat] }
+
+protected lemma inv_neg (q : ℚ) : (-q)⁻¹ = -q⁻¹ := by { rw ←@num_denom q, simp [-num_denom] }
+
+@[simp] lemma mul_denom_eq_num {q : ℚ} : q * q.denom = q.num :=
+begin
+  suffices : mk (q.num) ↑(q.denom) * mk ↑(q.denom) 1 = mk (q.num) 1, by
+  { conv { for q [1] { rw ←(@num_denom q) }}, rwa [coe_int_eq_mk, coe_nat_eq_mk] },
+  have : (q.denom : ℤ) ≠ 0, from ne_of_gt (by exact_mod_cast q.pos),
+  rw [(rat.mul_def this one_ne_zero), (mul_comm (q.denom : ℤ) 1), (div_mk_div_cancel_left this)]
+end
+
+lemma denom_div_cast_eq_one_iff (m n : ℤ) (hn : n ≠ 0) :
+  ((m : ℚ) / n).denom = 1 ↔ n ∣ m :=
+begin
+  replace hn : (n:ℚ) ≠ 0, by rwa [ne.def, ← int.cast_zero, coe_int_inj],
+  split,
+  { intro h,
+    lift ((m : ℚ) / n) to ℤ using h with k hk,
+    use k,
+    rwa [eq_div_iff_mul_eq hn, ← int.cast_mul, mul_comm, eq_comm, coe_int_inj] at hk },
+  { rintros ⟨d, rfl⟩,
+    rw [int.cast_mul, mul_comm, mul_div_cancel _ hn, rat.coe_int_denom] }
+end
+
+lemma num_div_eq_of_coprime {a b : ℤ} (hb0 : 0 < b) (h : nat.coprime a.nat_abs b.nat_abs) :
+  (a / b : ℚ).num = a :=
+begin
+  lift b to ℕ using le_of_lt hb0,
+  norm_cast at hb0 h,
+  rw [← rat.mk_eq_div, ← rat.mk_pnat_eq a b hb0, rat.mk_pnat_num, pnat.mk_coe, h.gcd_eq_one,
+    int.coe_nat_one, int.div_one]
+end
+
+lemma denom_div_eq_of_coprime {a b : ℤ} (hb0 : 0 < b) (h : nat.coprime a.nat_abs b.nat_abs) :
+  ((a / b : ℚ).denom : ℤ) = b :=
+begin
+  lift b to ℕ using le_of_lt hb0,
+  norm_cast at hb0 h,
+  rw [← rat.mk_eq_div, ← rat.mk_pnat_eq a b hb0, rat.mk_pnat_denom, pnat.mk_coe, h.gcd_eq_one,
+    nat.div_one]
+end
+
+lemma div_int_inj {a b c d : ℤ} (hb0 : 0 < b) (hd0 : 0 < d)
+  (h1 : nat.coprime a.nat_abs b.nat_abs) (h2 : nat.coprime c.nat_abs d.nat_abs)
+  (h : (a : ℚ) / b = (c : ℚ) / d) : a = c ∧ b = d :=
+begin
+  apply and.intro,
+  { rw [← (num_div_eq_of_coprime hb0 h1), h, num_div_eq_of_coprime hd0 h2] },
+  { rw [← (denom_div_eq_of_coprime hb0 h1), h, denom_div_eq_of_coprime hd0 h2] }
+end
+
+@[norm_cast] lemma coe_int_div_self (n : ℤ) : ((n / n : ℤ) : ℚ) = n / n :=
+begin
+  by_cases hn : n = 0,
+  { subst hn, simp only [int.cast_zero, int.zero_div, zero_div] },
+  { have : (n : ℚ) ≠ 0, { rwa ← coe_int_inj at hn },
+    simp only [int.div_self hn, int.cast_one, ne.def, not_false_iff, div_self this] }
+end
+
+@[norm_cast] lemma coe_nat_div_self (n : ℕ) : ((n / n : ℕ) : ℚ) = n / n :=
+coe_int_div_self n
+
+lemma coe_int_div (a b : ℤ) (h : b ∣ a) : ((a / b : ℤ) : ℚ) = a / b :=
+begin
+  rcases h with ⟨c, rfl⟩,
+  simp only [mul_comm b, int.mul_div_assoc c (dvd_refl b), int.cast_mul, mul_div_assoc,
+    coe_int_div_self]
+end
+
+lemma coe_nat_div (a b : ℕ) (h : b ∣ a) : ((a / b : ℕ) : ℚ) = a / b :=
+begin
+  rcases h with ⟨c, rfl⟩,
+  simp only [mul_comm b, nat.mul_div_assoc c (dvd_refl b), nat.cast_mul, mul_div_assoc,
+    coe_nat_div_self]
+end
+
+lemma inv_coe_int_num_of_pos {a : ℤ} (ha0 : 0 < a) : (a : ℚ)⁻¹.num = 1 :=
+begin
+  rw [rat.inv_def', rat.coe_int_num, rat.coe_int_denom, nat.cast_one, ←int.cast_one],
+  apply num_div_eq_of_coprime ha0,
+  rw int.nat_abs_one,
+  exact nat.coprime_one_left _,
+end
+
+lemma inv_coe_nat_num_of_pos {a : ℕ} (ha0 : 0 < a) : (a : ℚ)⁻¹.num = 1 :=
+inv_coe_int_num_of_pos (by exact_mod_cast ha0 : 0 < (a : ℤ))
+
+lemma inv_coe_int_denom_of_pos {a : ℤ} (ha0 : 0 < a) : ((a : ℚ)⁻¹.denom : ℤ) = a :=
+begin
+  rw [rat.inv_def', rat.coe_int_num, rat.coe_int_denom, nat.cast_one, ←int.cast_one],
+  apply denom_div_eq_of_coprime ha0,
+  rw int.nat_abs_one,
+  exact nat.coprime_one_left _,
+end
+
+lemma inv_coe_nat_denom_of_pos {a : ℕ} (ha0 : 0 < a) : (a : ℚ)⁻¹.denom = a :=
+begin
+  rw [← int.coe_nat_eq_coe_nat_iff, ← int.cast_coe_nat a, inv_coe_int_denom_of_pos],
+  rwa [← nat.cast_zero, nat.cast_lt]
+end
+
+@[simp] lemma inv_coe_int_num (a : ℤ) : (a : ℚ)⁻¹.num = int.sign a :=
+begin
+  induction a using int.induction_on;
+  simp [←int.neg_succ_of_nat_coe', int.neg_succ_of_nat_coe, -neg_add_rev, rat.inv_neg,
+        int.coe_nat_add_one_out, -nat.cast_succ, inv_coe_nat_num_of_pos, -int.cast_neg_succ_of_nat,
+        @eq_comm ℤ 1, int.sign_eq_one_of_pos]
+end
+
+@[simp] lemma inv_coe_nat_num (a : ℕ) : (a : ℚ)⁻¹.num = int.sign a :=
+inv_coe_int_num a
+
+@[simp] lemma inv_coe_int_denom (a : ℤ) : (a : ℚ)⁻¹.denom = if a = 0 then 1 else a.nat_abs :=
+begin
+  induction a using int.induction_on;
+  simp [←int.neg_succ_of_nat_coe', int.neg_succ_of_nat_coe, -neg_add_rev, rat.inv_neg,
+        int.coe_nat_add_one_out, -nat.cast_succ, inv_coe_nat_denom_of_pos,
+        -int.cast_neg_succ_of_nat]
+end
+
+@[simp] lemma inv_coe_nat_denom (a : ℕ) : (a : ℚ)⁻¹.denom = if a = 0 then 1 else a :=
+by simpa using inv_coe_int_denom a
+
+protected lemma «forall» {p : ℚ → Prop} : (∀ r, p r) ↔ ∀ a b : ℤ, p (a / b) :=
+⟨λ h _ _, h _,
+  λ h q, (show q = q.num / q.denom, from by simp [rat.div_num_denom]).symm ▸ (h q.1 q.2)⟩
+
+protected lemma «exists» {p : ℚ → Prop} : (∃ r, p r) ↔ ∃ a b : ℤ, p (a / b) :=
+⟨λ ⟨r, hr⟩, ⟨r.num, r.denom, by rwa [← mk_eq_div, num_denom]⟩, λ ⟨a, b, h⟩, ⟨_, h⟩⟩
+
+/-!
+### Denominator as `ℕ+`
+-/
+section pnat_denom
+
+/-- Denominator as `ℕ+`. -/
+def pnat_denom (x : ℚ) : ℕ+ := ⟨x.denom, x.pos⟩
+
+@[simp] lemma coe_pnat_denom (x : ℚ) : (x.pnat_denom : ℕ) = x.denom := rfl
+
+@[simp] lemma mk_pnat_pnat_denom_eq (x : ℚ) : mk_pnat x.num x.pnat_denom = x :=
+by rw [pnat_denom, mk_pnat_eq, num_denom]
+
+lemma pnat_denom_eq_iff_denom_eq {x : ℚ} {n : ℕ+} : x.pnat_denom = n ↔ x.denom = ↑n :=
+subtype.ext_iff
+
+@[simp] lemma pnat_denom_one : (1 : ℚ).pnat_denom = 1 := rfl
+
+@[simp] lemma pnat_denom_zero : (0 : ℚ).pnat_denom = 1 := rfl
+
+end pnat_denom
+
+end rat
diff --git a/src/data/rat/meta_defs.lean b/src/data/rat/meta_defs.lean
index abff0313e2258..fbd4c5ce8cb09 100644
--- a/src/data/rat/meta_defs.lean
+++ b/src/data/rat/meta_defs.lean
@@ -3,7 +3,7 @@ Copyright (c) 2019 Robert Y. Lewis . All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-import data.rat.basic
+import data.rat.defs
 import tactic.core
 
 /-!
@@ -42,15 +42,17 @@ meta def rat.mk_numeral (type has_zero has_one has_add has_neg has_div : expr) :
     let dene := denom.mk_numeral type has_zero has_one has_add in
     `(@has_div.div.{0} %%type %%has_div %%nume %%dene)
 
-/-- `rat.reflect q` represents the rational number `q` as a numeral expression of type `ℚ`. -/
-protected meta def rat.reflect : ℚ → expr :=
-rat.mk_numeral `(ℚ) `((by apply_instance : has_zero ℚ))
-         `((by apply_instance : has_one ℚ))`((by apply_instance : has_add ℚ))
-         `((by apply_instance : has_neg ℚ)) `(by apply_instance : has_div ℚ)
 
 section
+-- Note that here we are disabling the "safety" of reflected, to allow us to reuse `rat.mk_numeral`.
+-- The usual way to provide the required `reflected` instance would be via rewriting to prove that
+-- the expression we use here is equivalent.
 local attribute [semireducible] reflected
-meta instance : has_reflect ℚ := rat.reflect
+/-- `rat.reflect q` represents the rational number `q` as a numeral expression of type `ℚ`. -/
+meta instance rat.reflect : has_reflect ℚ :=
+rat.mk_numeral `(ℚ) `(by apply_instance : has_zero ℚ)
+  `(by apply_instance : has_one ℚ) `(by apply_instance : has_add ℚ)
+  `(by apply_instance : has_neg ℚ) `(by apply_instance : has_div ℚ)
 end
 
 /--
@@ -73,7 +75,7 @@ protected meta def expr.to_nonneg_rat : expr → option ℚ
   if c : m.coprime n then if h : 1 < n then
     return ⟨m, n, lt_trans zero_lt_one h, c⟩
   else none else none
-| e := do n ← e.to_nat, return (rat.of_int n)
+| e := do n ← e.to_nat, return n
 
 /-- Evaluates an expression as a rational number,
 if that expression represents a numeral, the quotient of two numerals,
diff --git a/src/data/rat/nnrat.lean b/src/data/rat/nnrat.lean
new file mode 100644
index 0000000000000..416382a3289a4
--- /dev/null
+++ b/src/data/rat/nnrat.lean
@@ -0,0 +1,303 @@
+/-
+Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies, Bhavik Mehta
+-/
+import algebra.algebra.basic
+import algebra.order.nonneg.field
+import algebra.order.nonneg.floor
+
+/-!
+# Nonnegative rationals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the nonnegative rationals as a subtype of `rat` and provides its algebraic order
+structure.
+
+We also define an instance `can_lift ℚ ℚ≥0`. This instance can be used by the `lift` tactic to
+replace `x : ℚ` and `hx : 0 ≤ x` in the proof context with `x : ℚ≥0` while replacing all occurences
+of `x` with `↑x`. This tactic also works for a function `f : α → ℚ` with a hypothesis
+`hf : ∀ x, 0 ≤ f x`.
+
+## Notation
+
+`ℚ≥0` is notation for `nnrat` in locale `nnrat`.
+-/
+
+open function
+open_locale big_operators
+
+/-- Nonnegative rational numbers. -/
+@[derive [canonically_ordered_comm_semiring, canonically_linear_ordered_semifield,
+  linear_ordered_comm_group_with_zero, has_sub, has_ordered_sub,
+  densely_ordered, archimedean, inhabited]]
+def nnrat := {q : ℚ // 0 ≤ q}
+
+localized "notation (name := nnrat) `ℚ≥0` := nnrat" in nnrat
+
+namespace nnrat
+variables {α : Type*} {p q : ℚ≥0}
+
+instance : has_coe ℚ≥0 ℚ := ⟨subtype.val⟩
+
+/- Simp lemma to put back `n.val` into the normal form given by the coercion. -/
+@[simp] lemma val_eq_coe (q : ℚ≥0) : q.val = q := rfl
+
+instance can_lift : can_lift ℚ ℚ≥0 coe (λ q, 0 ≤ q) :=
+{ prf := λ q hq, ⟨⟨q, hq⟩, rfl⟩ }
+
+@[ext] lemma ext : (p : ℚ) = (q : ℚ) → p = q := subtype.ext
+
+protected lemma coe_injective : injective (coe : ℚ≥0 → ℚ) := subtype.coe_injective
+
+@[simp, norm_cast] lemma coe_inj : (p : ℚ) = q ↔ p = q := subtype.coe_inj
+
+lemma ext_iff : p = q ↔ (p : ℚ) = q := subtype.ext_iff
+
+lemma ne_iff {x y : ℚ≥0} : (x : ℚ) ≠ (y : ℚ) ↔ x ≠ y := nnrat.coe_inj.not
+
+@[norm_cast] lemma coe_mk (q : ℚ) (hq) : ((⟨q, hq⟩ : ℚ≥0) : ℚ) = q := rfl
+
+/-- Reinterpret a rational number `q` as a non-negative rational number. Returns `0` if `q ≤ 0`. -/
+def _root_.rat.to_nnrat (q : ℚ) : ℚ≥0 := ⟨max q 0, le_max_right _ _⟩
+
+lemma _root_.rat.coe_to_nnrat (q : ℚ) (hq : 0 ≤ q) : (q.to_nnrat : ℚ) = q := max_eq_left hq
+
+lemma _root_.rat.le_coe_to_nnrat (q : ℚ) : q ≤ q.to_nnrat := le_max_left _ _
+
+open _root_.rat (to_nnrat)
+
+@[simp] lemma coe_nonneg (q : ℚ≥0) : (0 : ℚ) ≤ q := q.2
+
+@[simp, norm_cast] lemma coe_zero : ((0 : ℚ≥0) : ℚ) = 0 := rfl
+@[simp, norm_cast] lemma coe_one  : ((1 : ℚ≥0) : ℚ) = 1 := rfl
+@[simp, norm_cast] lemma coe_add (p q : ℚ≥0) : ((p + q : ℚ≥0) : ℚ) = p + q := rfl
+@[simp, norm_cast] lemma coe_mul (p q : ℚ≥0) : ((p * q : ℚ≥0) : ℚ) = p * q := rfl
+@[simp, norm_cast] lemma coe_inv (q : ℚ≥0) : ((q⁻¹ : ℚ≥0) : ℚ) = q⁻¹ := rfl
+@[simp, norm_cast] lemma coe_div (p q : ℚ≥0) : ((p / q : ℚ≥0) : ℚ) = p / q := rfl
+@[simp, norm_cast] lemma coe_bit0 (q : ℚ≥0) : ((bit0 q : ℚ≥0) : ℚ) = bit0 q := rfl
+@[simp, norm_cast] lemma coe_bit1 (q : ℚ≥0) : ((bit1 q : ℚ≥0) : ℚ) = bit1 q := rfl
+@[simp, norm_cast] lemma coe_sub (h : q ≤ p) : ((p - q : ℚ≥0) : ℚ) = p - q :=
+max_eq_left $ le_sub_comm.2 $ by simp [show (q : ℚ) ≤ p, from h]
+
+@[simp] lemma coe_eq_zero : (q : ℚ) = 0 ↔ q = 0 := by norm_cast
+lemma coe_ne_zero : (q : ℚ) ≠ 0 ↔ q ≠ 0 := coe_eq_zero.not
+
+@[simp, norm_cast] lemma coe_le_coe : (p : ℚ) ≤ q ↔ p ≤ q := iff.rfl
+@[simp, norm_cast] lemma coe_lt_coe : (p : ℚ) < q ↔ p < q := iff.rfl
+@[simp, norm_cast] lemma coe_pos : (0 : ℚ) < q ↔ 0 < q := iff.rfl
+
+lemma coe_mono : monotone (coe : ℚ≥0 → ℚ) := λ _ _, coe_le_coe.2
+
+lemma to_nnrat_mono : monotone to_nnrat := λ x y h, max_le_max h le_rfl
+
+@[simp] lemma to_nnrat_coe (q : ℚ≥0) : to_nnrat q = q := ext $ max_eq_left q.2
+
+@[simp] lemma to_nnrat_coe_nat (n : ℕ) : to_nnrat n = n :=
+ext $ by simp [rat.coe_to_nnrat]
+
+/-- `to_nnrat` and `coe : ℚ≥0 → ℚ` form a Galois insertion. -/
+protected def gi : galois_insertion to_nnrat coe :=
+galois_insertion.monotone_intro coe_mono to_nnrat_mono rat.le_coe_to_nnrat to_nnrat_coe
+
+/-- Coercion `ℚ≥0 → ℚ` as a `ring_hom`. -/
+def coe_hom : ℚ≥0 →+* ℚ := ⟨coe, coe_one, coe_mul, coe_zero, coe_add⟩
+
+@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : (↑(↑n : ℚ≥0) : ℚ) = n := map_nat_cast coe_hom n
+
+@[simp] lemma mk_coe_nat (n : ℕ) : @eq ℚ≥0 (⟨(n : ℚ), n.cast_nonneg⟩ : ℚ≥0) n :=
+ext (coe_nat_cast n).symm
+
+/-- The rational numbers are an algebra over the non-negative rationals. -/
+instance : algebra ℚ≥0 ℚ := coe_hom.to_algebra
+
+/-- A `mul_action` over `ℚ` restricts to a `mul_action` over `ℚ≥0`. -/
+instance [mul_action ℚ α] : mul_action ℚ≥0 α := mul_action.comp_hom α coe_hom.to_monoid_hom
+
+/-- A `distrib_mul_action` over `ℚ` restricts to a `distrib_mul_action` over `ℚ≥0`. -/
+instance [add_comm_monoid α] [distrib_mul_action ℚ α] : distrib_mul_action ℚ≥0 α :=
+distrib_mul_action.comp_hom α coe_hom.to_monoid_hom
+
+/-- A `module` over `ℚ` restricts to a `module` over `ℚ≥0`. -/
+instance [add_comm_monoid α] [module ℚ α] : module ℚ≥0 α := module.comp_hom α coe_hom
+
+@[simp] lemma coe_coe_hom : ⇑coe_hom = coe := rfl
+
+@[simp, norm_cast] lemma coe_indicator (s : set α) (f : α → ℚ≥0) (a : α) :
+  ((s.indicator f a : ℚ≥0) : ℚ) = s.indicator (λ x, f x) a :=
+(coe_hom : ℚ≥0 →+ ℚ).map_indicator _ _ _
+
+@[simp, norm_cast] lemma coe_pow (q : ℚ≥0) (n : ℕ) : (↑(q ^ n) : ℚ) = q ^ n := coe_hom.map_pow _ _
+
+@[norm_cast] lemma coe_list_sum (l : list ℚ≥0) : (l.sum : ℚ) = (l.map coe).sum :=
+coe_hom.map_list_sum _
+
+@[norm_cast] lemma coe_list_prod (l : list ℚ≥0) : (l.prod : ℚ) = (l.map coe).prod :=
+coe_hom.map_list_prod _
+
+@[norm_cast] lemma coe_multiset_sum (s : multiset ℚ≥0) : (s.sum : ℚ) = (s.map coe).sum :=
+coe_hom.map_multiset_sum _
+
+@[norm_cast] lemma coe_multiset_prod (s : multiset ℚ≥0) : (s.prod : ℚ) = (s.map coe).prod :=
+coe_hom.map_multiset_prod _
+
+@[norm_cast] lemma coe_sum {s : finset α} {f : α → ℚ≥0} : ↑(∑ a in s, f a) = ∑ a in s, (f a : ℚ) :=
+coe_hom.map_sum _ _
+
+lemma to_nnrat_sum_of_nonneg {s : finset α} {f : α → ℚ} (hf : ∀ a, a ∈ s → 0 ≤ f a) :
+  (∑ a in s, f a).to_nnrat = ∑ a in s, (f a).to_nnrat :=
+begin
+  rw [←coe_inj, coe_sum, rat.coe_to_nnrat _ (finset.sum_nonneg hf)],
+  exact finset.sum_congr rfl (λ x hxs, by rw rat.coe_to_nnrat _ (hf x hxs)),
+end
+
+@[norm_cast] lemma coe_prod {s : finset α} {f : α → ℚ≥0} : ↑(∏ a in s, f a) = ∏ a in s, (f a : ℚ) :=
+coe_hom.map_prod _ _
+
+lemma to_nnrat_prod_of_nonneg {s : finset α} {f : α → ℚ} (hf : ∀ a ∈ s, 0 ≤ f a) :
+  (∏ a in s, f a).to_nnrat = ∏ a in s, (f a).to_nnrat :=
+begin
+  rw [←coe_inj, coe_prod, rat.coe_to_nnrat _ (finset.prod_nonneg hf)],
+  exact finset.prod_congr rfl (λ x hxs, by rw rat.coe_to_nnrat _ (hf x hxs)),
+end
+
+@[norm_cast] lemma nsmul_coe (q : ℚ≥0) (n : ℕ) : ↑(n • q) = n • (q : ℚ) :=
+coe_hom.to_add_monoid_hom.map_nsmul _ _
+
+lemma bdd_above_coe {s : set ℚ≥0} : bdd_above (coe '' s : set ℚ) ↔ bdd_above s :=
+⟨λ ⟨b, hb⟩, ⟨to_nnrat b, λ ⟨y, hy⟩ hys, show y ≤ max b 0, from
+    (hb $ set.mem_image_of_mem _ hys).trans $ le_max_left _ _⟩,
+  λ ⟨b, hb⟩, ⟨b, λ y ⟨x, hx, eq⟩, eq ▸ hb hx⟩⟩
+
+lemma bdd_below_coe (s : set ℚ≥0) : bdd_below ((coe : ℚ≥0 → ℚ) '' s) := ⟨0, λ r ⟨q, _, h⟩, h ▸ q.2⟩
+
+@[simp, norm_cast] lemma coe_max (x y : ℚ≥0) : ((max x y : ℚ≥0) : ℚ) = max (x : ℚ) (y : ℚ) :=
+coe_mono.map_max
+
+@[simp, norm_cast] lemma coe_min (x y : ℚ≥0) : ((min x y : ℚ≥0) : ℚ) = min (x : ℚ) (y : ℚ) :=
+coe_mono.map_min
+
+lemma sub_def (p q : ℚ≥0) : p - q = to_nnrat (p - q) := rfl
+
+@[simp] lemma abs_coe (q : ℚ≥0) : |(q : ℚ)| = q := abs_of_nonneg q.2
+
+end nnrat
+
+open nnrat
+
+namespace rat
+variables {p q : ℚ}
+
+@[simp] lemma to_nnrat_zero : to_nnrat 0 = 0 := by simp [to_nnrat]; refl
+@[simp] lemma to_nnrat_one : to_nnrat 1 = 1 := by simp [to_nnrat, max_eq_left zero_le_one]
+
+@[simp] lemma to_nnrat_pos : 0 < to_nnrat q ↔ 0 < q := by simp [to_nnrat, ←coe_lt_coe]
+
+@[simp] lemma to_nnrat_eq_zero : to_nnrat q = 0 ↔ q ≤ 0 :=
+by simpa [-to_nnrat_pos] using (@to_nnrat_pos q).not
+
+alias to_nnrat_eq_zero ↔ _ to_nnrat_of_nonpos
+
+@[simp] lemma to_nnrat_le_to_nnrat_iff (hp : 0 ≤ p) : to_nnrat q ≤ to_nnrat p ↔ q ≤ p :=
+by simp [←coe_le_coe, to_nnrat, hp]
+
+@[simp] lemma to_nnrat_lt_to_nnrat_iff' : to_nnrat q < to_nnrat p ↔ q < p ∧ 0 < p :=
+by { simp [←coe_lt_coe, to_nnrat, lt_irrefl], exact lt_trans' }
+
+lemma to_nnrat_lt_to_nnrat_iff (h : 0 < p) : to_nnrat q < to_nnrat p ↔ q < p :=
+to_nnrat_lt_to_nnrat_iff'.trans (and_iff_left h)
+
+lemma to_nnrat_lt_to_nnrat_iff_of_nonneg (hq : 0 ≤ q) : to_nnrat q < to_nnrat p ↔ q < p :=
+to_nnrat_lt_to_nnrat_iff'.trans ⟨and.left, λ h, ⟨h, hq.trans_lt h⟩⟩
+
+@[simp] lemma to_nnrat_add (hq : 0 ≤ q) (hp : 0 ≤ p) : to_nnrat (q + p) = to_nnrat q + to_nnrat p :=
+nnrat.ext $ by simp [to_nnrat, hq, hp, add_nonneg]
+
+lemma to_nnrat_add_le : to_nnrat (q + p) ≤ to_nnrat q + to_nnrat p :=
+coe_le_coe.1 $ max_le (add_le_add (le_max_left _ _) (le_max_left _ _)) $ coe_nonneg _
+
+lemma to_nnrat_le_iff_le_coe {p : ℚ≥0} : to_nnrat q ≤ p ↔ q ≤ ↑p := nnrat.gi.gc q p
+
+lemma le_to_nnrat_iff_coe_le {q : ℚ≥0} (hp : 0 ≤ p) : q ≤ to_nnrat p ↔ ↑q ≤ p :=
+by rw [←coe_le_coe, rat.coe_to_nnrat p hp]
+
+lemma le_to_nnrat_iff_coe_le' {q : ℚ≥0} (hq : 0 < q) : q ≤ to_nnrat p ↔ ↑q ≤ p :=
+(le_or_lt 0 p).elim le_to_nnrat_iff_coe_le $ λ hp,
+  by simp only [(hp.trans_le q.coe_nonneg).not_le, to_nnrat_eq_zero.2 hp.le, hq.not_le]
+
+lemma to_nnrat_lt_iff_lt_coe {p : ℚ≥0} (hq : 0 ≤ q) : to_nnrat q < p ↔ q < ↑p :=
+by rw [←coe_lt_coe, rat.coe_to_nnrat q hq]
+
+lemma lt_to_nnrat_iff_coe_lt {q : ℚ≥0} : q < to_nnrat p ↔ ↑q < p := nnrat.gi.gc.lt_iff_lt
+
+@[simp] lemma to_nnrat_bit0 (hq : 0 ≤ q) : to_nnrat (bit0 q) = bit0 (to_nnrat q) :=
+to_nnrat_add hq hq
+
+@[simp] lemma to_nnrat_bit1 (hq : 0 ≤ q) : to_nnrat (bit1 q) = bit1 (to_nnrat q) :=
+(to_nnrat_add (by simp [hq]) zero_le_one).trans $ by simp [to_nnrat_one, bit1, hq]
+
+lemma to_nnrat_mul (hp : 0 ≤ p) : to_nnrat (p * q) = to_nnrat p * to_nnrat q :=
+begin
+  cases le_total 0 q with hq hq,
+  { ext; simp [to_nnrat, hp, hq, max_eq_left, mul_nonneg] },
+  { have hpq := mul_nonpos_of_nonneg_of_nonpos hp hq,
+    rw [to_nnrat_eq_zero.2 hq, to_nnrat_eq_zero.2 hpq, mul_zero] }
+end
+
+lemma to_nnrat_inv (q : ℚ) : to_nnrat q⁻¹ = (to_nnrat q)⁻¹ :=
+begin
+  obtain hq | hq := le_total q 0,
+  { rw [to_nnrat_eq_zero.mpr hq, inv_zero, to_nnrat_eq_zero.mpr (inv_nonpos.mpr hq)] },
+  { nth_rewrite 0 ←rat.coe_to_nnrat q hq,
+    rw [←coe_inv, to_nnrat_coe] }
+end
+
+lemma to_nnrat_div (hp : 0 ≤ p) : to_nnrat (p / q) = to_nnrat p / to_nnrat q :=
+by rw [div_eq_mul_inv, div_eq_mul_inv, ←to_nnrat_inv, ←to_nnrat_mul hp]
+
+lemma to_nnrat_div' (hq : 0 ≤ q) : to_nnrat (p / q) = to_nnrat p / to_nnrat q :=
+by rw [div_eq_inv_mul, div_eq_inv_mul, to_nnrat_mul (inv_nonneg.2 hq), to_nnrat_inv]
+
+end rat
+
+/-- The absolute value on `ℚ` as a map to `ℚ≥0`. -/
+@[pp_nodot] def rat.nnabs (x : ℚ) : ℚ≥0 := ⟨abs x, abs_nonneg x⟩
+
+@[norm_cast, simp] lemma rat.coe_nnabs (x : ℚ) : (rat.nnabs x : ℚ) = abs x := by simp [rat.nnabs]
+
+/-! ### Numerator and denominator -/
+
+namespace nnrat
+variables {p q : ℚ≥0}
+
+/-- The numerator of a nonnegative rational. -/
+def num (q : ℚ≥0) : ℕ := (q : ℚ).num.nat_abs
+
+/-- The denominator of a nonnegative rational. -/
+def denom (q : ℚ≥0) : ℕ := (q : ℚ).denom
+
+@[simp] lemma nat_abs_num_coe : (q : ℚ).num.nat_abs = q.num := rfl
+@[simp] lemma denom_coe : (q : ℚ).denom = q.denom := rfl
+
+lemma ext_num_denom (hn : p.num = q.num) (hd : p.denom = q.denom) : p = q :=
+ext $ rat.ext ((int.nat_abs_inj_of_nonneg_of_nonneg
+  (rat.num_nonneg_iff_zero_le.2 p.2) $ rat.num_nonneg_iff_zero_le.2 q.2).1 hn) hd
+
+lemma ext_num_denom_iff : p = q ↔ p.num = q.num ∧ p.denom = q.denom :=
+⟨by { rintro rfl, exact ⟨rfl, rfl⟩ }, λ h, ext_num_denom h.1 h.2⟩
+
+@[simp] lemma num_div_denom (q : ℚ≥0) : (q.num : ℚ≥0) / q.denom = q :=
+begin
+  ext1,
+  rw [coe_div, coe_nat_cast, coe_nat_cast, num, ←int.cast_coe_nat,
+    int.nat_abs_of_nonneg (rat.num_nonneg_iff_zero_le.2 q.prop)],
+  exact rat.num_div_denom q,
+end
+
+/-- A recursor for nonnegative rationals in terms of numerators and denominators. -/
+protected def rec {α : ℚ≥0 → Sort*} (h : Π m n : ℕ, α (m / n)) (q : ℚ≥0) : α q :=
+(num_div_denom _).rec (h _ _)
+
+end nnrat
diff --git a/src/data/rat/order.lean b/src/data/rat/order.lean
index 7e5b5842ec7c4..5024f984112f9 100644
--- a/src/data/rat/order.lean
+++ b/src/data/rat/order.lean
@@ -3,11 +3,17 @@ Copyright (c) 2019 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
+import algebra.order.field.defs
 import data.rat.basic
+import data.int.cast.lemmas
+import tactic.assert_exists
 
 /-!
 # Order for Rational Numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Summary
 
 We define the order on `ℚ`, prove that `ℚ` is a discrete, linearly ordered field, and define
@@ -36,9 +42,9 @@ begin
   have d0 := int.coe_nat_lt.2 h₁,
   have := (mk_eq (ne_of_gt h) (ne_of_gt d0)).1 ha,
   constructor; intro h₂,
-  { apply nonneg_of_mul_nonneg_right _ d0,
+  { apply nonneg_of_mul_nonneg_left _ d0,
     rw this, exact mul_nonneg h₂ (le_of_lt h) },
-  { apply nonneg_of_mul_nonneg_right _ h,
+  { apply nonneg_of_mul_nonneg_left _ h,
     rw ← this, exact mul_nonneg h₂ (int.coe_zero_le _) },
 end
 
@@ -101,8 +107,8 @@ protected theorem le_total : a ≤ b ∨ b ≤ a :=
 by have := rat.nonneg_total (b - a); rwa neg_sub at this
 
 protected theorem le_antisymm {a b : ℚ} (hab : a ≤ b) (hba : b ≤ a) : a = b :=
-by { have := eq_neg_of_add_eq_zero (rat.nonneg_antisymm hba $ by rwa [← sub_eq_add_neg, neg_sub]),
-   rwa neg_neg at this }
+by { have := eq_neg_of_add_eq_zero_left (rat.nonneg_antisymm hba $
+ by rwa [← sub_eq_add_neg, neg_sub]), rwa neg_neg at this }
 
 protected theorem le_trans {a b c : ℚ} (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c :=
 have rat.nonneg (b - a + (c - b)), from rat.nonneg_add hab hbc,
@@ -211,3 +217,13 @@ begin
 end
 
 end rat
+
+-- We make some assertions here about declarations that do not need to be in the import dependencies
+-- for this file, but have been in the past.
+assert_not_exists fintype
+assert_not_exists set.Icc
+assert_not_exists galois_connection
+-- These are less significant, but should not be relaxed until at least after port to Lean 4.
+assert_not_exists linear_ordered_comm_group_with_zero
+-- This one doesn't exist anywhere!
+-- assert_not_exists positive.add_comm_semigroup
diff --git a/src/data/rat/sqrt.lean b/src/data/rat/sqrt.lean
index 9839b5edfc4d2..82702e4ca6c03 100644
--- a/src/data/rat/sqrt.lean
+++ b/src/data/rat/sqrt.lean
@@ -5,10 +5,14 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 
 import data.rat.order
+import data.rat.lemmas
 import data.int.sqrt
 /-!
 # Square root on rational numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the square root function on rational numbers `rat.sqrt`
 and proves several theorems about it.
 
diff --git a/src/data/rat/star.lean b/src/data/rat/star.lean
new file mode 100644
index 0000000000000..3d999719221c8
--- /dev/null
+++ b/src/data/rat/star.lean
@@ -0,0 +1,53 @@
+/-
+Copyright (c) 2023 Jireh Loreaux. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jireh Loreaux
+-/
+
+import algebra.star.order
+import data.rat.lemmas
+import group_theory.submonoid.membership
+
+/-! # Star order structure on ℚ
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Here we put the trivial `star` operation on `ℚ` for convenience and show that it is a
+`star_ordered_ring`. In particular, this means that every element of `ℚ` is a sum of squares.
+-/
+
+namespace rat
+
+instance : star_ring ℚ :=
+{ star := id,
+  star_involutive := λ _, rfl,
+  star_mul := λ _ _, mul_comm _ _,
+  star_add := λ _ _, rfl }
+
+instance : has_trivial_star ℚ :=
+{ star_trivial := λ _, rfl }
+
+instance : star_ordered_ring ℚ :=
+star_ordered_ring.of_nonneg_iff (λ _ _, add_le_add_left) $ λ x,
+begin
+  refine ⟨λ hx, _, λ hx, add_submonoid.closure_induction hx
+    (by { rintro - ⟨s, rfl⟩, exact mul_self_nonneg s }) le_rfl (λ _ _, add_nonneg)⟩,
+  /- If `x = p / q`, then, since `0 ≤ x`, we have `p q : ℕ`, and `p / q` is the sum of `p * q`
+  copies of `(1 / q) ^ 2`, and so `x` lies in the `add_submonoid` generated by square elements.
+
+  Note: it's possible to rephrase this argument as `x = (p * q) • (1 / q) ^ 2`, but this would
+  be somewhat challenging without increasing import requirements. -/
+  suffices : (finset.range (x.num.nat_abs * x.denom)).sum
+    (function.const ℕ (rat.mk_pnat 1 ⟨x.denom, x.pos⟩ * rat.mk_pnat 1 ⟨x.denom, x.pos⟩)) = x,
+  { exact this ▸ sum_mem (λ n hn, add_submonoid.subset_closure ⟨_, rfl⟩) },
+  simp only [function.const_apply, finset.sum_const, finset.card_range, nsmul_eq_mul, mk_pnat_eq],
+  rw [←int.cast_coe_nat, int.coe_nat_mul, int.coe_nat_abs,
+    abs_of_nonneg (num_nonneg_iff_zero_le.mpr hx), int.cast_mul, int.cast_coe_nat],
+  simp only [int.cast_mul, int.cast_coe_nat, coe_int_eq_mk, coe_nat_eq_mk],
+  rw [mul_assoc, ←mul_assoc (mk (x.denom : ℤ) 1), mk_mul_mk_cancel one_ne_zero,
+    ←one_mul (x.denom : ℤ), div_mk_div_cancel_left (by simpa using x.pos.ne' : (x.denom : ℤ) ≠ 0),
+    one_mul, mk_one_one, one_mul, mk_mul_mk_cancel one_ne_zero, rat.num_denom],
+end
+
+end rat
diff --git a/src/data/rbmap/default.lean b/src/data/rbmap/default.lean
index c565e084d5c74..135919abb8558 100644
--- a/src/data/rbmap/default.lean
+++ b/src/data/rbmap/default.lean
@@ -3,8 +3,8 @@ Copyright (c) 2017 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
-import data.rbtree
 import data.rbmap.basic
+import data.rbtree.main
 
 universes u v
 
@@ -70,7 +70,7 @@ lemma eq_some_of_to_value_eq_some {e : option (α × β)} {v : β} :
   to_value e = some v → ∃ k, e = some (k, v) :=
 begin
   cases e with val; simp [to_value, false_implies_iff],
-  { cases val, simp, intro h, subst v, constructor, refl }
+  { cases val, simp }
 end
 
 lemma eq_none_of_to_value_eq_none {e : option (α × β)} : to_value e = none → e = none :=
diff --git a/src/data/rbtree/basic.lean b/src/data/rbtree/basic.lean
index a9b4f43579a2e..fe262dbc6d7a5 100644
--- a/src/data/rbtree/basic.lean
+++ b/src/data/rbtree/basic.lean
@@ -3,8 +3,9 @@ Copyright (c) 2017 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura
 -/
-import tactic.interactive
 import data.rbtree.init
+import logic.is_empty
+import tactic.interactive
 
 universe u
 
diff --git a/src/data/rbtree/default.lean b/src/data/rbtree/default.lean
deleted file mode 100644
index 3e4107221da67..0000000000000
--- a/src/data/rbtree/default.lean
+++ /dev/null
@@ -1,6 +0,0 @@
-/-
-Copyright (c) 2017 Microsoft Corporation. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Leonardo de Moura
--/
-import data.rbtree.main
diff --git a/src/data/rbtree/insert.lean b/src/data/rbtree/insert.lean
index 9103dd71a7b32..565f6f98c7eb8 100644
--- a/src/data/rbtree/insert.lean
+++ b/src/data/rbtree/insert.lean
@@ -149,20 +149,20 @@ lemma is_searchable_ins [decidable_rel lt] {t x} [is_strict_weak_order α lt] :
   ∀ {lo hi} (h : is_searchable lt t lo hi), lift lt lo (some x) → lift lt (some x) hi →
     is_searchable lt (ins lt t x) lo hi :=
 begin
-  with_cases { apply ins.induction lt t x; intros; simp! [*] at * {eta := ff};
-    is_searchable_tactic },
-  case is_red_lt hs₁ { apply ih h_hs₁, assumption, simp [*] },
-  case is_red_eq hs₁ { apply is_searchable_of_is_searchable_of_incomp hc, assumption },
-  case is_red_eq hs₂ { apply is_searchable_of_incomp_of_is_searchable hc, assumption },
-  case is_red_gt hs₂ { apply ih h_hs₂, cases hi; simp [*], assumption },
-  case is_black_lt_red { apply is_searchable_balance1_node, apply ih h_hs₁, assumption, simp [*],
+  apply ins.induction lt t x; intros; simp! [*] at * {eta := ff};
+    is_searchable_tactic,
+  { apply ih h_hs₁, assumption, simp [*] },
+  { apply is_searchable_of_is_searchable_of_incomp hc, assumption },
+  { apply is_searchable_of_incomp_of_is_searchable hc, assumption },
+  { apply ih h_hs₂, cases hi; simp [*], assumption },
+  { apply is_searchable_balance1_node, apply ih h_hs₁, assumption, simp [*],
     assumption },
-  case is_black_lt_not_red hs₁ { apply ih h_hs₁, assumption, simp [*] },
-  case is_black_eq hs₁ { apply is_searchable_of_is_searchable_of_incomp hc, assumption },
-  case is_black_eq hs₂ { apply is_searchable_of_incomp_of_is_searchable hc, assumption },
-  case is_black_gt_red { apply is_searchable_balance2_node, assumption, apply ih h_hs₂, simp [*],
+  { apply ih h_hs₁, assumption, simp [*] },
+  { apply is_searchable_of_is_searchable_of_incomp hc, assumption },
+  { apply is_searchable_of_incomp_of_is_searchable hc, assumption },
+  { apply is_searchable_balance2_node, assumption, apply ih h_hs₂, simp [*],
     assumption },
-  case is_black_gt_not_red hs₂ { apply ih h_hs₂, assumption, simp [*] }
+  { apply ih h_hs₂, assumption, simp [*] }
 end
 
 lemma is_searchable_mk_insert_result {c t} : is_searchable lt t none none →
@@ -188,7 +188,7 @@ parameters {α : Type u} (lt : α → α → Prop)
 
 local attribute [simp] mem balance1_node balance2_node
 
-local infix `∈` := mem lt
+local infix (name := mem) ` ∈ ` := mem lt
 
 lemma mem_balance1_node_of_mem_left {x s} (v) (t : rbnode α) : x ∈ s → x ∈ balance1_node s v t :=
 begin
@@ -251,36 +251,27 @@ end
 lemma mem_ins_of_incomp [decidable_rel lt] (t : rbnode α) {x y : α} :
   ∀ h : ¬ lt x y ∧ ¬ lt y x, x ∈ t.ins lt y :=
 begin
-  with_cases { apply ins.induction lt t y; intros; simp [ins, *] },
-  case is_black_lt_red { have := ih h, apply mem_balance1_node_of_mem_left, assumption },
-  case is_black_gt_red { have := ih h, apply mem_balance2_node_of_mem_left, assumption }
+  apply ins.induction lt t y; intros; simp [ins, *],
+  { have := ih h, apply mem_balance1_node_of_mem_left, assumption },
+  { have := ih h, apply mem_balance2_node_of_mem_left, assumption }
 end
 
 lemma mem_ins_of_mem [decidable_rel lt] [is_strict_weak_order α lt] {t : rbnode α} (z : α) :
   ∀ {x} (h : x ∈ t), x ∈ t.ins lt z :=
 begin
-  with_cases { apply ins.induction lt t z; intros; simp [ins, *] at *; try { contradiction };
-    blast_disjs },
-  case is_red_eq or.inr or.inl
+  apply ins.induction lt t z; intros; simp [ins, *] at *; try { contradiction };
+    blast_disjs,
+  any_goals { intros, simp [h], done },
+  any_goals { intros, simp [ih h], done },
   { have := incomp_trans_of lt h ⟨hc.2, hc.1⟩, simp [this] },
-  case is_black_lt_red or.inl
   { apply mem_balance1_node_of_mem_left, apply ih h },
-  case is_black_lt_red or.inr or.inl
   { apply mem_balance1_node_of_incomp, cases h, all_goals { simp [*, ins_ne_leaf lt a z] } },
-  case is_black_lt_red or.inr or.inr
   { apply mem_balance1_node_of_mem_right, assumption },
-  case is_black_eq or.inr or.inl
   { have := incomp_trans_of lt hc ⟨h.2, h.1⟩, simp [this] },
-  case is_black_gt_red or.inl
   { apply mem_balance2_node_of_mem_right, assumption },
-  case is_black_gt_red or.inr or.inl
   { have := ins_ne_leaf lt a z, apply mem_balance2_node_of_incomp, cases h, simp [*],
       apply ins_ne_leaf },
-  case is_black_gt_red or.inr or.inr
   { apply mem_balance2_node_of_mem_left, apply ih h },
-  -- remaining cases are easy
-  any_goals { intros, simp [h], done },
-  all_goals { intros, simp [ih h], done },
 end
 
 lemma mem_mk_insert_result {a t} (c) : mem lt a t → mem lt a (mk_insert_result c t) :=
@@ -315,26 +306,22 @@ begin
     simp [*] }
 end
 
-lemma equiv_or_mem_of_mem_ins [decidable_rel lt] [is_strict_weak_order α lt] {t : rbnode α} {x z} :
+lemma equiv_or_mem_of_mem_ins [decidable_rel lt] {t : rbnode α} {x z} :
   ∀ (h : x ∈ t.ins lt z), x ≈[lt] z ∨ x ∈ t :=
 begin
-  with_cases { apply ins.induction lt t z; intros; simp [ins, strict_weak_order.equiv, *] at *;
-    blast_disjs },
-  case is_black_lt_red
-   { have h' := of_mem_balance1_node lt h, blast_disjs,
-     have := ih h', blast_disjs,
-     all_goals { simp [h, *] } },
-  case is_black_gt_red
-   { have h' := of_mem_balance2_node lt h, blast_disjs,
-     have := ih h', blast_disjs,
-     all_goals { simp [h, *] }},
-  -- All other goals can be solved by the following tactics
+  apply ins.induction lt t z; intros; simp [ins, strict_weak_order.equiv, *] at *;
+    blast_disjs,
   any_goals { intros, simp [h] },
-  all_goals { intros, have ih := ih h, cases ih; simp [*], done },
+  any_goals { intros, have ih := ih h, cases ih; simp [*], done },
+  { have h' := of_mem_balance1_node lt h, blast_disjs,
+    have := ih h', blast_disjs,
+    all_goals { simp [h, *] } },
+  { have h' := of_mem_balance2_node lt h, blast_disjs,
+    have := ih h', blast_disjs,
+    all_goals { simp [h, *] }},
 end
 
-lemma equiv_or_mem_of_mem_insert [decidable_rel lt] [is_strict_weak_order α lt] {t : rbnode α}
-  {x z} :
+lemma equiv_or_mem_of_mem_insert [decidable_rel lt] {t : rbnode α} {x z} :
   ∀ (h : x ∈ t.insert lt z), x ≈[lt] z ∨ x ∈ t :=
 begin
   simp [insert], intros, apply equiv_or_mem_of_mem_ins, exact mem_of_mem_mk_insert_result lt h
@@ -489,13 +476,12 @@ lemma find_balance1_lt {l r t v x y lo hi}
                        (ht : is_searchable lt t (some y) hi)
                        : find lt (balance1 l v r y t) x = find lt (red_node l v r) x :=
 begin
-  with_cases { revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic },
-  case red_left : _ _ _ z r { apply weak_trichotomous lt z x; intros; simp [*] },
-  case red_right : l_left l_val l_right z r
-  { with_cases { apply weak_trichotomous lt z x; intro h' },
-    case is_lt  { have := trans_of lt (lo_lt_hi hr_hs₁) h', simp [*] },
-    case is_eqv { have : lt l_val x := lt_of_lt_of_incomp (lo_lt_hi hr_hs₁) h', simp [*] },
-    case is_gt  { apply weak_trichotomous lt l_val x; intros; simp [*] } }
+  revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic,
+  { apply weak_trichotomous lt y_1 x; intros; simp [*] },
+  { apply weak_trichotomous lt x_1 x; intro h',
+    { have := trans_of lt (lo_lt_hi hr_hs₁) h', simp [*] },
+    { have : lt y_1 x := lt_of_lt_of_incomp (lo_lt_hi hr_hs₁) h', simp [*] },
+    { apply weak_trichotomous lt y_1 x; intros; simp [*] } }
 end
 
 meta def ins_ne_leaf_tac := `[apply ins_ne_leaf]
@@ -518,10 +504,8 @@ lemma find_balance1_gt {l r t v x y lo hi}
                        (ht : is_searchable lt t (some y) hi)
                        : find lt (balance1 l v r y t) x = find lt t x :=
 begin
-  with_cases { revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic },
-  case red_left : _ _ _ z
+  revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic,
   { have := trans_of lt (lo_lt_hi hr) h, simp [*] },
-  case red_right : _ _ _ z
   { have := trans_of lt (lo_lt_hi hr_hs₂) h, simp [*] }
 end
 
@@ -542,12 +526,10 @@ lemma find_balance1_eqv {l r t v x y lo hi}
                         (ht : is_searchable lt t (some y) hi)
                         : find lt (balance1 l v r y t) x = some y :=
 begin
-  with_cases { revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic },
-  case red_left : _ _ _ z
-  { have : lt z x := lt_of_lt_of_incomp (lo_lt_hi hr) h.swap,
+  revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic,
+  { have : lt y_1 x := lt_of_lt_of_incomp (lo_lt_hi hr) h.swap,
     simp [*] },
-  case red_right : _ _ _ z
-  { have : lt z x := lt_of_lt_of_incomp (lo_lt_hi hr_hs₂) h.swap,
+  { have : lt x_1 x := lt_of_lt_of_incomp (lo_lt_hi hr_hs₂) h.swap,
     simp [*] }
 end
 
@@ -570,9 +552,9 @@ lemma find_balance2_lt {l v r t x y lo hi}
                        (ht : is_searchable lt t lo (some y))
                        : find lt (balance2 l v r y t) x = find lt t x :=
 begin
-  with_cases { revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic },
-  case red_left { have := trans h (lo_lt_hi hl_hs₁), simp [*] },
-  case red_right { have := trans h (lo_lt_hi hl), simp [*] }
+  revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic,
+  { have := trans h (lo_lt_hi hl_hs₁), simp [*] },
+  { have := trans h (lo_lt_hi hl), simp [*] }
 end
 
 lemma find_balance2_node_lt {s t x y lo hi}
@@ -593,14 +575,12 @@ lemma find_balance2_gt {l v r t x y lo hi}
                        (ht : is_searchable lt t lo (some y))
                        : find lt (balance2 l v r y t) x = find lt (red_node l v r) x :=
 begin
-  with_cases { revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic },
-  case red_left : _ val _ z
-  { with_cases { apply weak_trichotomous lt val x; intro h'; simp [*] },
-    case is_lt { apply weak_trichotomous lt z x; intros; simp [*] },
-    case is_eqv { have : lt x z := lt_of_incomp_of_lt h'.swap (lo_lt_hi hl_hs₂), simp [*] },
-    case is_gt  { have := trans h' (lo_lt_hi hl_hs₂), simp [*] } },
-  case red_right : _ val
-  { apply weak_trichotomous lt val x; intros; simp [*] }
+  revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic,
+  { apply weak_trichotomous lt x_1 x; intro h'; simp [*],
+    { apply weak_trichotomous lt y_1 x; intros; simp [*] },
+    { have : lt x _ := lt_of_incomp_of_lt h'.swap (lo_lt_hi hl_hs₂), simp [*] },
+    { have := trans h' (lo_lt_hi hl_hs₂), simp [*] } },
+  { apply weak_trichotomous lt y_1 x; intros; simp [*] }
 end
 
 lemma find_balance2_node_gt {s t x y lo hi}
@@ -622,9 +602,9 @@ lemma find_balance2_eqv {l v r t x y lo hi}
                         (ht : is_searchable lt t lo (some y))
                         : find lt (balance2 l v r y t) x = some y :=
 begin
-  with_cases { revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic },
-  case red_left { have := lt_of_incomp_of_lt h (lo_lt_hi hl_hs₁), simp [*] },
-  case red_right { have := lt_of_incomp_of_lt h (lo_lt_hi hl), simp [*] }
+  revert hl hr ht, apply balance.cases l v r; intros; simp [*]; is_searchable_tactic,
+  { have := lt_of_incomp_of_lt h (lo_lt_hi hl_hs₁), simp [*] },
+  { have := lt_of_incomp_of_lt h (lo_lt_hi hl), simp [*] }
 end
 
 lemma find_balance2_node_eqv {t s x y lo hi}
diff --git a/src/data/rbtree/main.lean b/src/data/rbtree/main.lean
index 605c3eef0f73a..8c49c3943b5a8 100644
--- a/src/data/rbtree/main.lean
+++ b/src/data/rbtree/main.lean
@@ -6,6 +6,7 @@ Authors: Leonardo de Moura
 import data.rbtree.find
 import data.rbtree.insert
 import data.rbtree.min_max
+import order.rel_classes
 
 universes u
 
@@ -65,8 +66,8 @@ variables [decidable_rel lt]
 
 lemma insert_ne_mk_rbtree (t : rbtree α lt) (a : α) : t.insert a ≠ mk_rbtree α lt :=
 begin
-  cases t with n p, simp [insert, mk_rbtree], intro h, injection h with h',
-  apply rbnode.insert_ne_leaf lt n a h'
+  cases t with n p,
+  simpa [insert, mk_rbtree] using rbnode.insert_ne_leaf lt n a
 end
 
 lemma find_correct [is_strict_weak_order α lt] (a : α) (t : rbtree α lt) :
@@ -177,11 +178,11 @@ lemma mem_insert_of_mem [is_strict_weak_order α lt] {a : α} {t : rbtree α lt}
   a ∈ t → a ∈ t.insert b :=
 begin cases t, apply rbnode.mem_insert_of_mem end
 
-lemma equiv_or_mem_of_mem_insert [is_strict_weak_order α lt] {a b : α} {t : rbtree α lt} :
+lemma equiv_or_mem_of_mem_insert {a b : α} {t : rbtree α lt} :
   a ∈ t.insert b → a ≈[lt] b ∨ a ∈ t :=
 begin cases t, apply rbnode.equiv_or_mem_of_mem_insert end
 
-lemma incomp_or_mem_of_mem_ins [is_strict_weak_order α lt] {a b : α} {t : rbtree α lt} :
+lemma incomp_or_mem_of_mem_ins {a b : α} {t : rbtree α lt} :
   a ∈ t.insert b → (¬ lt a b ∧ ¬ lt b a) ∨ a ∈ t :=
 equiv_or_mem_of_mem_insert
 
diff --git a/src/data/real/basic.lean b/src/data/real/basic.lean
index 67fcb79ca3e81..dbddb697e0b87 100644
--- a/src/data/real/basic.lean
+++ b/src/data/real/basic.lean
@@ -3,31 +3,44 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Floris van Doorn
 -/
-import algebra.module.basic
 import algebra.bounds
 import algebra.order.archimedean
 import algebra.star.basic
 import data.real.cau_seq_completion
-import order.conditionally_complete_lattice
 
 /-!
 # Real numbers from Cauchy sequences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `ℝ` as the type of equivalence classes of Cauchy sequences of rational numbers.
 This choice is motivated by how easy it is to prove that `ℝ` is a commutative ring, by simply
 lifting everything to `ℚ`.
 -/
 
+assert_not_exists finset
+assert_not_exists module
+assert_not_exists submonoid
+
 open_locale pointwise
 
 /-- The type `ℝ` of real numbers constructed as equivalence classes of Cauchy sequences of rational
 numbers. -/
 structure real := of_cauchy ::
-(cauchy : @cau_seq.completion.Cauchy ℚ _ _ _ abs _)
+(cauchy : cau_seq.completion.Cauchy (abs : ℚ → ℚ))
 notation `ℝ` := real
 
 attribute [pp_using_anonymous_constructor] real
 
+namespace cau_seq.completion
+
+-- this can't go in `data.real.cau_seq_completion` as the structure on `rat` isn't available
+@[simp] theorem of_rat_rat {abv : ℚ → ℚ} [is_absolute_value abv] (q : ℚ) :
+  of_rat (q : ℚ) = (q : @Cauchy _ _ _ _ abv _) := rfl
+
+end cau_seq.completion
+
 namespace real
 open cau_seq cau_seq.completion
 
@@ -40,7 +53,7 @@ lemma ext_cauchy {x y : real} : x.cauchy = y.cauchy → x = y :=
 ext_cauchy_iff.2
 
 /-- The real numbers are isomorphic to the quotient of Cauchy sequences on the rationals. -/
-def equiv_Cauchy : ℝ ≃ cau_seq.completion.Cauchy :=
+def equiv_Cauchy : ℝ ≃ cau_seq.completion.Cauchy abs :=
 ⟨real.cauchy, real.of_cauchy, λ ⟨_⟩, rfl, λ _, rfl⟩
 
 -- irreducible doesn't work for instances: https://github.com/leanprover-community/lean/issues/511
@@ -49,18 +62,24 @@ def equiv_Cauchy : ℝ ≃ cau_seq.completion.Cauchy :=
 @[irreducible] private def add : ℝ → ℝ → ℝ | ⟨a⟩ ⟨b⟩ := ⟨a + b⟩
 @[irreducible] private def neg : ℝ → ℝ | ⟨a⟩ := ⟨-a⟩
 @[irreducible] private def mul : ℝ → ℝ → ℝ | ⟨a⟩ ⟨b⟩ := ⟨a * b⟩
+@[irreducible] private noncomputable def inv' : ℝ → ℝ | ⟨a⟩ := ⟨a⁻¹⟩
 
 instance : has_zero ℝ := ⟨zero⟩
 instance : has_one ℝ := ⟨one⟩
 instance : has_add ℝ := ⟨add⟩
 instance : has_neg ℝ := ⟨neg⟩
 instance : has_mul ℝ := ⟨mul⟩
+instance : has_sub ℝ := ⟨λ a b, a + (-b)⟩
+noncomputable instance : has_inv ℝ := ⟨inv'⟩
 
 lemma of_cauchy_zero : (⟨0⟩ : ℝ) = 0 := show _ = zero, by rw zero
 lemma of_cauchy_one : (⟨1⟩ : ℝ) = 1 := show _ = one, by rw one
 lemma of_cauchy_add (a b) : (⟨a + b⟩ : ℝ) = ⟨a⟩ + ⟨b⟩ := show _ = add _ _, by rw add
 lemma of_cauchy_neg (a) : (⟨-a⟩ : ℝ) = -⟨a⟩ := show _ = neg _, by rw neg
+lemma of_cauchy_sub (a b) : (⟨a - b⟩ : ℝ) = ⟨a⟩ - ⟨b⟩ :=
+by { rw [sub_eq_add_neg, of_cauchy_add, of_cauchy_neg], refl }
 lemma of_cauchy_mul (a b) : (⟨a * b⟩ : ℝ) = ⟨a⟩ * ⟨b⟩ := show _ = mul _ _, by rw mul
+lemma of_cauchy_inv {f} : (⟨f⁻¹⟩ : ℝ) = ⟨f⟩⁻¹ := show _ = inv' _, by rw inv'
 
 lemma cauchy_zero : (0 : ℝ).cauchy = 0 := show zero.cauchy = 0, by rw zero
 lemma cauchy_one : (1 : ℝ).cauchy = 1 := show one.cauchy = 1, by rw one
@@ -70,6 +89,22 @@ lemma cauchy_neg : ∀ a, (-a : ℝ).cauchy = -a.cauchy
 | ⟨a⟩ := show (neg _).cauchy = _, by rw neg
 lemma cauchy_mul : ∀ a b, (a * b : ℝ).cauchy = a.cauchy * b.cauchy
 | ⟨a⟩ ⟨b⟩ := show (mul _ _).cauchy = _, by rw mul
+lemma cauchy_sub : ∀ a b, (a - b : ℝ).cauchy = a.cauchy - b.cauchy
+| ⟨a⟩ ⟨b⟩ := by { rw [sub_eq_add_neg, ←cauchy_neg, ←cauchy_add], refl }
+lemma cauchy_inv : ∀ f, (f⁻¹ : ℝ).cauchy = f.cauchy⁻¹
+| ⟨f⟩ := show (inv' _).cauchy = _, by rw inv'
+
+instance : has_nat_cast ℝ := { nat_cast := λ n, ⟨n⟩ }
+instance : has_int_cast ℝ := { int_cast := λ z, ⟨z⟩ }
+instance : has_rat_cast ℝ := { rat_cast := λ q, ⟨q⟩ }
+
+lemma of_cauchy_nat_cast (n : ℕ) : (⟨n⟩ : ℝ) = n := rfl
+lemma of_cauchy_int_cast (z : ℤ) : (⟨z⟩ : ℝ) = z := rfl
+lemma of_cauchy_rat_cast (q : ℚ) : (⟨q⟩ : ℝ) = q := rfl
+
+lemma cauchy_nat_cast (n : ℕ) : (n : ℝ).cauchy = n := rfl
+lemma cauchy_int_cast (z : ℤ) : (z : ℝ).cauchy = z := rfl
+lemma cauchy_rat_cast (q : ℚ) : (q : ℝ).cauchy = q := rfl
 
 instance : comm_ring ℝ :=
 begin
@@ -78,17 +113,29 @@ begin
                   mul   := (*),
                   add   := (+),
                   neg   := @has_neg.neg ℝ _,
-                  sub   := λ a b, a + (-b),
+                  sub   := @has_sub.sub ℝ _,
                   npow  := @npow_rec ℝ ⟨1⟩ ⟨(*)⟩,
                   nsmul := @nsmul_rec ℝ ⟨0⟩ ⟨(+)⟩,
-                  zsmul := @zsmul_rec ℝ ⟨0⟩ ⟨(+)⟩ ⟨@has_neg.neg ℝ _⟩ };
+                  zsmul := @zsmul_rec ℝ ⟨0⟩ ⟨(+)⟩ ⟨@has_neg.neg ℝ _⟩,
+                  ..real.has_nat_cast,
+                  ..real.has_int_cast, };
   repeat { rintro ⟨_⟩, };
   try { refl };
-  simp [← of_cauchy_zero, ← of_cauchy_one, ←of_cauchy_add, ←of_cauchy_neg, ←of_cauchy_mul];
+  simp [← of_cauchy_zero, ← of_cauchy_one, ←of_cauchy_add, ←of_cauchy_neg, ←of_cauchy_mul,
+    λ n, show @coe ℕ ℝ ⟨_⟩ n = ⟨n⟩, from rfl, has_nat_cast.nat_cast, has_int_cast.int_cast];
   apply add_assoc <|> apply add_comm <|> apply mul_assoc <|> apply mul_comm <|>
-    apply left_distrib <|> apply right_distrib <|> apply sub_eq_add_neg <|> skip
+    apply left_distrib <|> apply right_distrib <|> apply sub_eq_add_neg <|> skip,
 end
 
+/-- `real.equiv_Cauchy` as a ring equivalence. -/
+@[simps]
+def ring_equiv_Cauchy : ℝ ≃+* cau_seq.completion.Cauchy abs :=
+{ to_fun := cauchy,
+  inv_fun := of_cauchy,
+  map_add' := cauchy_add,
+  map_mul' := cauchy_mul,
+  ..equiv_Cauchy }
+
 /-! Extra instances to short-circuit type class resolution.
 
  These short-circuits have an additional property of ensuring that a computable path is found; if
@@ -111,23 +158,12 @@ instance : comm_monoid ℝ        := by apply_instance
 instance : monoid ℝ             := by apply_instance
 instance : comm_semigroup ℝ     := by apply_instance
 instance : semigroup ℝ          := by apply_instance
-instance : has_sub ℝ            := by apply_instance
-instance : module ℝ ℝ           := by apply_instance
 instance : inhabited ℝ          := ⟨0⟩
 
 /-- The real numbers are a `*`-ring, with the trivial `*`-structure. -/
 instance : star_ring ℝ          := star_ring_of_comm
 instance : has_trivial_star ℝ   := ⟨λ _, rfl⟩
 
-/-- Coercion `ℚ` → `ℝ` as a `ring_hom`. Note that this
-is `cau_seq.completion.of_rat`, not `rat.cast`. -/
-def of_rat : ℚ →+* ℝ :=
-by refine_struct { to_fun := of_cauchy ∘ of_rat };
-  simp [of_rat_one, of_rat_zero, of_rat_mul, of_rat_add,
-    of_cauchy_one, of_cauchy_zero, ← of_cauchy_mul, ← of_cauchy_add]
-
-lemma of_rat_apply (x : ℚ) : of_rat x = of_cauchy (cau_seq.completion.of_rat x) := rfl
-
 /-- Make a real number from a Cauchy sequence of rationals (by taking the equivalence class). -/
 def mk (x : cau_seq ℚ abs) : ℝ := ⟨cau_seq.completion.mk x⟩
 
@@ -195,14 +231,16 @@ instance : partial_order ℝ :=
 
 instance : preorder ℝ := by apply_instance
 
-theorem of_rat_lt {x y : ℚ} : of_rat x < of_rat y ↔ x < y :=
+theorem rat_cast_lt {x y : ℚ} : (x : ℝ) < (y : ℝ) ↔ x < y :=
 begin
   rw [mk_lt] {md := tactic.transparency.semireducible},
   exact const_lt
 end
 
 protected theorem zero_lt_one : (0 : ℝ) < 1 :=
-by convert of_rat_lt.2 zero_lt_one; simp
+by convert rat_cast_lt.2 zero_lt_one; simp [←of_cauchy_rat_cast, of_cauchy_one, of_cauchy_zero]
+
+protected lemma fact_zero_lt_one : fact ((0 : ℝ) < 1) := ⟨real.zero_lt_one⟩
 
 protected theorem mul_pos {a b : ℝ} : 0 < a → 0 < b → 0 < a * b :=
 begin
@@ -211,8 +249,9 @@ begin
   simpa only [mk_lt, mk_pos, ← mk_mul] using cau_seq.mul_pos
 end
 
-instance : ordered_comm_ring ℝ :=
-{ add_le_add_left :=
+instance : strict_ordered_comm_ring ℝ :=
+{ exists_pair_ne := ⟨0, 1, real.zero_lt_one.ne⟩,
+  add_le_add_left :=
   begin
     simp only [le_iff_eq_or_lt],
     rintros a b ⟨rfl, h⟩,
@@ -223,27 +262,83 @@ instance : ordered_comm_ring ℝ :=
   mul_pos     := @real.mul_pos,
   .. real.comm_ring, .. real.partial_order, .. real.semiring }
 
-instance : ordered_ring ℝ               := by apply_instance
-instance : ordered_semiring ℝ           := by apply_instance
-instance : ordered_add_comm_group ℝ     := by apply_instance
-instance : ordered_cancel_add_comm_monoid ℝ := by apply_instance
-instance : ordered_add_comm_monoid ℝ    := by apply_instance
-instance : nontrivial ℝ := ⟨⟨0, 1, ne_of_lt real.zero_lt_one⟩⟩
+instance : strict_ordered_ring ℝ            := infer_instance
+instance : strict_ordered_comm_semiring ℝ   := infer_instance
+instance : strict_ordered_semiring ℝ        := infer_instance
+instance : ordered_ring ℝ                   := infer_instance
+instance : ordered_semiring ℝ               := infer_instance
+instance : ordered_add_comm_group ℝ         := infer_instance
+instance : ordered_cancel_add_comm_monoid ℝ := infer_instance
+instance : ordered_add_comm_monoid ℝ        := infer_instance
+instance : nontrivial ℝ                     := infer_instance
+
+@[irreducible]
+private def sup : ℝ → ℝ → ℝ | ⟨x⟩ ⟨y⟩ :=
+⟨quotient.map₂ (⊔) (λ x₁ x₂ hx y₁ y₂ hy, sup_equiv_sup hx hy) x y⟩
+
+instance : has_sup ℝ := ⟨sup⟩
+
+lemma of_cauchy_sup (a b) : (⟨⟦a ⊔ b⟧⟩ : ℝ) = ⟨⟦a⟧⟩ ⊔ ⟨⟦b⟧⟩ := show _ = sup _ _, by { rw sup, refl }
+@[simp] lemma mk_sup (a b) : (mk (a ⊔ b) : ℝ) = mk a ⊔ mk b := of_cauchy_sup _ _
+
+@[irreducible]
+private def inf : ℝ → ℝ → ℝ | ⟨x⟩ ⟨y⟩ :=
+⟨quotient.map₂ (⊓) (λ x₁ x₂ hx y₁ y₂ hy, inf_equiv_inf hx hy) x y⟩
+
+instance : has_inf ℝ := ⟨inf⟩
+
+lemma of_cauchy_inf (a b) : (⟨⟦a ⊓ b⟧⟩ : ℝ) = ⟨⟦a⟧⟩ ⊓ ⟨⟦b⟧⟩ := show _ = inf _ _, by { rw inf, refl }
+@[simp] lemma mk_inf (a b) : (mk (a ⊓ b) : ℝ) = mk a ⊓ mk b := of_cauchy_inf _ _
+
+instance : distrib_lattice ℝ :=
+{ sup := (⊔),
+  le := (≤),
+  le_sup_left := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b, begin
+    rw [←mk_sup, mk_le],
+    exact cau_seq.le_sup_left,
+  end,
+  le_sup_right := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b, begin
+    rw [←mk_sup, mk_le],
+    exact cau_seq.le_sup_right,
+  end,
+  sup_le := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b c, real.ind_mk c $ λ c, begin
+    simp_rw [←mk_sup, mk_le],
+    exact cau_seq.sup_le,
+  end,
+  inf := (⊓),
+  inf_le_left := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b, begin
+    rw [←mk_inf, mk_le],
+    exact cau_seq.inf_le_left,
+  end,
+  inf_le_right := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b, begin
+    rw [←mk_inf, mk_le],
+    exact cau_seq.inf_le_right,
+  end,
+  le_inf := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b c, real.ind_mk c $ λ c, begin
+    simp_rw [←mk_inf, mk_le],
+    exact cau_seq.le_inf,
+  end,
+  le_sup_inf := λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b c, real.ind_mk c $ λ c, eq.le begin
+    simp only [←mk_sup, ←mk_inf],
+    exact congr_arg mk (cau_seq.sup_inf_distrib_left _ _ _).symm
+  end,
+  .. real.partial_order  }
+
+/- Extra instances to short-circuit type class resolution -/
+instance : lattice ℝ         := infer_instance
+instance : semilattice_inf ℝ := infer_instance
+instance : semilattice_sup ℝ := infer_instance
 
 open_locale classical
 
+instance : is_total ℝ (≤) :=
+⟨λ a, real.ind_mk a $ λ a b, real.ind_mk b $ λ b, by simpa using le_total a b⟩
+
 noncomputable instance : linear_order ℝ :=
-{ le_total := begin
-    intros a b,
-    induction a using real.ind_mk with a,
-    induction b using real.ind_mk with b,
-    simpa using le_total a b,
-  end,
-  decidable_le := by apply_instance,
-  .. real.partial_order }
+lattice.to_linear_order _
 
 noncomputable instance : linear_ordered_comm_ring ℝ :=
-{ .. real.nontrivial, .. real.ordered_ring, .. real.comm_ring, .. real.linear_order }
+{ .. real.nontrivial, .. real.strict_ordered_ring, .. real.comm_ring, .. real.linear_order }
 
 /- Extra instances to short-circuit type class resolution -/
 noncomputable instance : linear_ordered_ring ℝ        := by apply_instance
@@ -251,12 +346,6 @@ noncomputable instance : linear_ordered_semiring ℝ    := by apply_instance
 instance : is_domain ℝ :=
 { .. real.nontrivial, .. real.comm_ring, .. linear_ordered_ring.is_domain }
 
-@[irreducible] private noncomputable def inv' : ℝ → ℝ | ⟨a⟩ := ⟨a⁻¹⟩
-noncomputable instance : has_inv ℝ := ⟨inv'⟩
-lemma of_cauchy_inv {f} : (⟨f⁻¹⟩ : ℝ) = ⟨f⟩⁻¹ := show _ = inv' _, by rw inv'
-lemma cauchy_inv : ∀ f, (f⁻¹ : ℝ).cauchy = f.cauchy⁻¹
-| ⟨f⟩ := show (inv' _).cauchy = _, by rw inv'
-
 noncomputable instance : linear_ordered_field ℝ :=
 { inv := has_inv.inv,
   mul_inv_cancel := begin
@@ -266,27 +355,28 @@ noncomputable instance : linear_ordered_field ℝ :=
     exact cau_seq.completion.inv_mul_cancel h,
   end,
   inv_zero := by simp [← of_cauchy_zero, ←of_cauchy_inv],
-  ..real.linear_ordered_comm_ring, }
+  rat_cast := coe,
+  rat_cast_mk  := λ n d hd h2,
+    by rw [←of_cauchy_rat_cast, rat.cast_mk', of_cauchy_mul, of_cauchy_inv, of_cauchy_nat_cast,
+           of_cauchy_int_cast],
+  ..real.linear_ordered_comm_ring }
 
 /- Extra instances to short-circuit type class resolution -/
 
 noncomputable instance : linear_ordered_add_comm_group ℝ          := by apply_instance
 noncomputable instance field : field ℝ                            := by apply_instance
 noncomputable instance : division_ring ℝ                          := by apply_instance
-noncomputable instance : distrib_lattice ℝ                        := by apply_instance
-noncomputable instance : lattice ℝ                                := by apply_instance
-noncomputable instance : semilattice_inf ℝ                        := by apply_instance
-noncomputable instance : semilattice_sup ℝ                        := by apply_instance
-noncomputable instance : has_inf ℝ                                := by apply_instance
-noncomputable instance : has_sup ℝ                                := by apply_instance
 noncomputable instance decidable_lt (a b : ℝ) : decidable (a < b) := by apply_instance
 noncomputable instance decidable_le (a b : ℝ) : decidable (a ≤ b) := by apply_instance
 noncomputable instance decidable_eq (a b : ℝ) : decidable (a = b) := by apply_instance
 
-open rat
+/-- Show an underlying cauchy sequence for real numbers.
 
-@[simp] theorem of_rat_eq_cast : ∀ x : ℚ, of_rat x = x :=
-of_rat.eq_rat_cast
+The representative chosen is the one passed in the VM to `quot.mk`, so two cauchy sequences
+converging to the same number may be printed differently.
+-/
+meta instance : has_repr ℝ :=
+{ repr := λ r, "real.of_cauchy " ++ repr r.cauchy }
 
 theorem le_mk_of_forall_le {f : cau_seq ℚ abs} :
   (∃ i, ∀ j ≥ i, x ≤ f j) → x ≤ mk f :=
@@ -299,7 +389,6 @@ begin
   obtain ⟨i, H⟩ := exists_forall_ge_and h
     (exists_forall_ge_and hK (f.cauchy₃ $ half_pos K0)),
   apply not_lt_of_le (H _ le_rfl).1,
-  rw ← of_rat_eq_cast,
   rw [mk_lt] {md := tactic.transparency.semireducible},
   refine ⟨_, half_pos K0, i, λ j ij, _⟩,
   have := add_le_add (H _ ij).2.1
@@ -320,8 +409,8 @@ theorem mk_near_of_forall_near {f : cau_seq ℚ abs} {x : ℝ} {ε : ℝ}
 abs_sub_le_iff.2
   ⟨sub_le_iff_le_add'.2 $ mk_le_of_forall_le $
     H.imp $ λ i h j ij, sub_le_iff_le_add'.1 (abs_sub_le_iff.1 $ h j ij).1,
-  sub_le.1 $ le_mk_of_forall_le $
-    H.imp $ λ i h j ij, sub_le.1 (abs_sub_le_iff.1 $ h j ij).2⟩
+  sub_le_comm.1 $ le_mk_of_forall_le $
+    H.imp $ λ i h j ij, sub_le_comm.1 (abs_sub_le_iff.1 $ h j ij).2⟩
 
 instance : archimedean ℝ :=
 archimedean_iff_rat_le.2 $ λ x, real.ind_mk x $ λ f,
@@ -401,7 +490,7 @@ begin
     replace hK := hK.le.trans (nat.cast_le.2 nK),
     have n0 : 0 < n := nat.cast_pos.1 ((inv_pos.2 xz).trans_le hK),
     refine le_trans _ (hf₂ _ n0 _ xS).le,
-    rwa [le_sub, inv_le ((nat.cast_pos.2 n0):((_:ℝ) < _)) xz] },
+    rwa [le_sub_comm, inv_le ((nat.cast_pos.2 n0):((_:ℝ) < _)) xz] },
   { exact mk_le_of_forall_le ⟨1, λ n n1,
       let ⟨x, xS, hx⟩ := hf₁ _ n1 in le_trans hx (h xS)⟩ }
 end
@@ -484,6 +573,9 @@ end
 theorem Sup_of_not_bdd_above {s : set ℝ} (hs : ¬ bdd_above s) : Sup s = 0 :=
 dif_neg $ assume h, hs h.2
 
+lemma supr_of_not_bdd_above {α : Sort*} {f : α → ℝ} (hf : ¬ bdd_above (set.range f)) :
+  (⨆ i, f i) = 0 := Sup_of_not_bdd_above hf
+
 theorem Sup_univ : Sup (@set.univ ℝ) = 0 :=
 real.Sup_of_not_bdd_above $ λ ⟨x, h⟩, not_le_of_lt (lt_add_one _) $ h (set.mem_univ _)
 
@@ -491,12 +583,7 @@ real.Sup_of_not_bdd_above $ λ ⟨x, h⟩, not_le_of_lt (lt_add_one _) $ h (set.
 by simp [Inf_def, Sup_empty]
 
 lemma cinfi_empty {α : Sort*} [is_empty α] (f : α → ℝ) : (⨅ i, f i) = 0 :=
-begin
-  dsimp [infi],
-  convert real.Inf_empty,
-  rw set.range_eq_empty_iff,
-  apply_instance
-end
+by rw [infi_of_empty', Inf_empty]
 
 @[simp] lemma cinfi_const_zero {α : Sort*} : (⨅ i : α, (0:ℝ)) = 0 :=
 begin
@@ -508,9 +595,12 @@ end
 theorem Inf_of_not_bdd_below {s : set ℝ} (hs : ¬ bdd_below s) : Inf s = 0 :=
 neg_eq_zero.2 $ Sup_of_not_bdd_above $ mt bdd_above_neg.1 hs
 
+lemma infi_of_not_bdd_below  {α : Sort*} {f : α → ℝ} (hf : ¬ bdd_below (set.range f)) :
+  (⨅ i, f i) = 0 := Inf_of_not_bdd_below hf
+
 /--
 As `0` is the default value for `real.Sup` of the empty set or sets which are not bounded above, it
-suffices to show that `S` is bounded below by `0` to show that `0 ≤ Inf S`.
+suffices to show that `S` is bounded below by `0` to show that `0 ≤ Sup S`.
 -/
 lemma Sup_nonneg (S : set ℝ) (hS : ∀ x ∈ S, (0:ℝ) ≤ x) : 0 ≤ Sup S :=
 begin
@@ -520,15 +610,34 @@ begin
 end
 
 /--
-As `0` is the default value for `real.Sup` of the empty set, it suffices to show that `S` is
-bounded above by `0` to show that `Sup S ≤ 0`.
+As `0` is the default value for `real.Sup` of the empty set or sets which are not bounded above, it
+suffices to show that `f i` is nonnegative to show that `0 ≤ ⨆ i, f i`.
 -/
-lemma Sup_nonpos (S : set ℝ) (hS : ∀ x ∈ S, x ≤ (0:ℝ)) : Sup S ≤ 0 :=
+protected lemma supr_nonneg {ι : Sort*} {f : ι → ℝ} (hf : ∀ i, 0 ≤ f i) : 0 ≤ ⨆ i, f i :=
+Sup_nonneg _ $ set.forall_range_iff.2 hf
+
+/--
+As `0` is the default value for `real.Sup` of the empty set or sets which are not bounded above, it
+suffices to show that all elements of `S` are bounded by a nonnagative number to show that `Sup S`
+is bounded by this number.
+-/
+protected lemma Sup_le {S : set ℝ} {a : ℝ} (hS : ∀ x ∈ S, x ≤ a) (ha : 0 ≤ a) : Sup S ≤ a :=
 begin
   rcases S.eq_empty_or_nonempty with rfl | hS₂,
-  exacts [Sup_empty.le, cSup_le hS₂ hS],
+  exacts [Sup_empty.trans_le ha, cSup_le hS₂ hS],
 end
 
+protected lemma supr_le {ι : Sort*} {f : ι → ℝ} {a : ℝ} (hS : ∀ i, f i ≤ a) (ha : 0 ≤ a) :
+  (⨆ i, f i) ≤ a :=
+real.Sup_le (set.forall_range_iff.2 hS) ha
+
+/--
+As `0` is the default value for `real.Sup` of the empty set, it suffices to show that `S` is
+bounded above by `0` to show that `Sup S ≤ 0`.
+-/
+lemma Sup_nonpos (S : set ℝ) (hS : ∀ x ∈ S, x ≤ (0:ℝ)) : Sup S ≤ 0 :=
+real.Sup_le hS le_rfl
+
 /--
 As `0` is the default value for `real.Inf` of the empty set, it suffices to show that `S` is
 bounded below by `0` to show that `0 ≤ Inf S`.
diff --git a/src/data/real/cardinality.lean b/src/data/real/cardinality.lean
index d301d012069d2..189427b8ebc41 100644
--- a/src/data/real/cardinality.lean
+++ b/src/data/real/cardinality.lean
@@ -5,12 +5,15 @@ Authors: Floris van Doorn
 -/
 import analysis.specific_limits.basic
 import data.rat.denumerable
-import data.set.intervals.image_preimage
+import data.set.pointwise.interval
 import set_theory.cardinal.continuum
 
 /-!
 # The cardinality of the reals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file shows that the real numbers have cardinality continuum, i.e. `#ℝ = 𝔠`.
 
 We show that `#ℝ ≤ 𝔠` by noting that every real number is determined by a Cauchy-sequence of the
@@ -66,6 +69,10 @@ lemma cantor_function_aux_eq (h : f n = g n) :
   cantor_function_aux c f n = cantor_function_aux c g n :=
 by simp [cantor_function_aux, h]
 
+lemma cantor_function_aux_zero (f : ℕ → bool) :
+  cantor_function_aux c f 0 = cond (f 0) 1 0 :=
+by { cases h : f 0; simp [h] }
+
 lemma cantor_function_aux_succ (f : ℕ → bool) :
   (λ n, cantor_function_aux c f (n + 1)) = λ n, c * cantor_function_aux c (λ n, f (n + 1)) n :=
 by { ext n, cases h : f (n + 1); simp [h, pow_succ] }
@@ -122,9 +129,9 @@ begin
     { rw [cantor_function_succ _ (le_of_lt h1) h3, div_eq_mul_inv,
           ←tsum_geometric_of_lt_1 (le_of_lt h1) h3],
       apply zero_add },
-    { convert tsum_eq_single 0 _,
-      { apply_instance },
-      { intros n hn, cases n, contradiction, refl } } },
+    { refine (tsum_eq_single 0 _).trans _,
+      { intros n hn, cases n, contradiction, refl },
+      { exact cantor_function_aux_zero _ }, } },
   rw [cantor_function_succ f (le_of_lt h1) h3, cantor_function_succ g (le_of_lt h1) h3],
   rw [hn 0 $ zero_lt_succ n],
   apply add_lt_add_left, rw mul_lt_mul_left h1, exact ih (λ k hk, hn _ $ nat.succ_lt_succ hk) fn gn
@@ -153,9 +160,9 @@ begin
   apply le_antisymm,
   { rw real.equiv_Cauchy.cardinal_eq,
     apply mk_quotient_le.trans, apply (mk_subtype_le _).trans_eq,
-    rw [← power_def, mk_nat, mk_rat, omega_power_omega] },
+    rw [← power_def, mk_nat, mk_rat, aleph_0_power_aleph_0] },
   { convert mk_le_of_injective (cantor_function_injective _ _),
-    rw [←power_def, mk_bool, mk_nat, two_power_omega], exact 1 / 3, norm_num, norm_num }
+    rw [←power_def, mk_bool, mk_nat, two_power_aleph_0], exact 1 / 3, norm_num, norm_num }
 end
 
 /-- The cardinality of the reals, as a set. -/
@@ -163,8 +170,8 @@ lemma mk_univ_real : #(set.univ : set ℝ) = 𝔠 :=
 by rw [mk_univ, mk_real]
 
 /-- **Non-Denumerability of the Continuum**: The reals are not countable. -/
-lemma not_countable_real : ¬ countable (set.univ : set ℝ) :=
-by { rw [← mk_set_le_omega, not_le, mk_univ_real], apply cantor }
+lemma not_countable_real : ¬ (set.univ : set ℝ).countable :=
+by { rw [← le_aleph_0_iff_set_countable, not_le, mk_univ_real], apply cantor }
 
 /-- The cardinality of the interval (a, ∞). -/
 lemma mk_Ioi_real (a : ℝ) : #(Ioi a) = 𝔠 :=
@@ -183,7 +190,7 @@ begin
   refine add_lt_of_lt (cantor _).le _ h,
   refine add_lt_of_lt (cantor _).le (mk_image_le.trans_lt h) _,
   rw mk_singleton,
-  exact one_lt_omega.trans (cantor _)
+  exact one_lt_aleph_0.trans (cantor _)
 end
 
 /-- The cardinality of the interval [a, ∞). -/
diff --git a/src/data/real/cau_seq.lean b/src/data/real/cau_seq.lean
index a9f20aabf0666..de87799d093b0 100644
--- a/src/data/real/cau_seq.lean
+++ b/src/data/real/cau_seq.lean
@@ -3,12 +3,19 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
+import algebra.group_power.lemmas
 import algebra.order.absolute_value
-import algebra.big_operators.order
+import algebra.order.group.min_max
+import algebra.order.field.basic
+import algebra.ring.pi
+import group_theory.group_action.pi
 
 /-!
 # Cauchy sequences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A basic theory of Cauchy sequences, used in the construction of the reals and p-adic numbers. Where
 applicable, lemmas that will be reused in other contexts have been stated in extra generality.
 
@@ -26,10 +33,10 @@ This is a concrete implementation that is useful for simplicity and computabilit
 sequence, cauchy, abs val, absolute value
 -/
 
-open_locale big_operators
-
 open is_absolute_value
 
+variables {G α β : Type*}
+
 theorem exists_forall_ge_and {α} [linear_order α] {P Q : α → Prop} :
   (∃ i, ∀ j ≥ i, P j) → (∃ i, ∀ j ≥ i, Q j) →
   ∃ i, ∀ j ≥ i, P j ∧ Q j
@@ -37,8 +44,7 @@ theorem exists_forall_ge_and {α} [linear_order α] {P Q : α → Prop} :
   ⟨c, λ j hj, ⟨h₁ _ (le_trans ac hj), h₂ _ (le_trans bc hj)⟩⟩
 
 section
-variables {α : Type*} [linear_ordered_field α]
-  {β : Type*} [ring β] (abv : β → α) [is_absolute_value abv]
+variables [linear_ordered_field α] [ring β] (abv : β → α) [is_absolute_value abv]
 
 theorem rat_add_continuous_lemma
   {ε : α} (ε0 : 0 < ε) : ∃ δ > 0, ∀ {a₁ a₂ b₁ b₂ : β},
@@ -66,22 +72,20 @@ begin
 end
 
 theorem rat_inv_continuous_lemma
-  {β : Type*} [field β] (abv : β → α) [is_absolute_value abv]
+  {β : Type*} [division_ring β] (abv : β → α) [is_absolute_value abv]
   {ε K : α} (ε0 : 0 < ε) (K0 : 0 < K) :
   ∃ δ > 0, ∀ {a b : β}, K ≤ abv a → K ≤ abv b →
   abv (a - b) < δ → abv (a⁻¹ - b⁻¹) < ε :=
 begin
-  have KK := mul_pos K0 K0,
-  have εK := mul_pos ε0 KK,
-  refine ⟨_, εK, λ a b ha hb h, _⟩,
-  have a0 := lt_of_lt_of_le K0 ha,
-  have b0 := lt_of_lt_of_le K0 hb,
-  rw [inv_sub_inv ((abv_pos abv).1 a0) ((abv_pos abv).1 b0),
-      abv_div abv, abv_mul abv, mul_comm, abv_sub abv,
-      ← mul_div_cancel ε (ne_of_gt KK)],
-  exact div_lt_div h
-    (mul_le_mul hb ha (le_of_lt K0) (abv_nonneg abv _))
-    (le_of_lt $ mul_pos ε0 KK) KK
+  refine ⟨K * ε * K, mul_pos (mul_pos K0 ε0) K0, λ a b ha hb h, _⟩,
+  have a0 := K0.trans_le ha,
+  have b0 := K0.trans_le hb,
+  rw [inv_sub_inv' ((abv_pos abv).1 a0) ((abv_pos abv).1 b0), abv_mul abv, abv_mul abv,
+    abv_inv abv, abv_inv abv,  abv_sub abv],
+  refine lt_of_mul_lt_mul_left (lt_of_mul_lt_mul_right _ b0.le) a0.le,
+  rw [mul_assoc, inv_mul_cancel_right₀ b0.ne', ←mul_assoc, mul_inv_cancel a0.ne', one_mul],
+  refine h.trans_le _,
+  exact mul_le_mul (mul_le_mul ha le_rfl ε0.le a0.le) hb K0.le (mul_nonneg a0.le ε0.le),
 end
 end
 
@@ -91,8 +95,7 @@ def is_cau_seq {α : Type*} [linear_ordered_field α]
 ∀ ε > 0, ∃ i, ∀ j ≥ i, abv (f j - f i) < ε
 
 namespace is_cau_seq
-variables {α : Type*} [linear_ordered_field α]
-  {β : Type*} [ring β] {abv : β → α} [is_absolute_value abv] {f : ℕ → β}
+variables [linear_ordered_field α] [ring β] {abv : β → α} [is_absolute_value abv] {f g : ℕ → β}
 
 @[nolint ge_or_gt] -- see Note [nolint_ge]
 theorem cauchy₂ (hf : is_cau_seq abv f) {ε : α} (ε0 : 0 < ε) :
@@ -108,6 +111,12 @@ theorem cauchy₃ (hf : is_cau_seq abv f) {ε : α} (ε0 : 0 < ε) :
   ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - f j) < ε :=
 let ⟨i, H⟩ := hf.cauchy₂ ε0 in ⟨i, λ j ij k jk, H _ (le_trans ij jk) _ ij⟩
 
+lemma add (hf : is_cau_seq abv f) (hg : is_cau_seq abv g) : is_cau_seq abv (f + g) :=
+λ ε ε0,
+  let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abv ε0,
+      ⟨i, H⟩ := exists_forall_ge_and (hf.cauchy₃ δ0) (hg.cauchy₃ δ0) in
+  ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ le_rfl in Hδ (H₁ _ ij) (H₂ _ ij)⟩
+
 end is_cau_seq
 
 /-- `cau_seq β abv` is the type of `β`-valued Cauchy sequences, with respect to the absolute value
@@ -117,10 +126,10 @@ def cau_seq {α : Type*} [linear_ordered_field α]
 {f : ℕ → β // is_cau_seq abv f}
 
 namespace cau_seq
-variables {α : Type*} [linear_ordered_field α]
+variables [linear_ordered_field α]
 
 section ring
-variables {β : Type*} [ring β] {abv : β → α}
+variables [ring β] {abv : β → α}
 
 instance : has_coe_to_fun (cau_seq β abv) (λ _, ℕ → β) := ⟨subtype.val⟩
 
@@ -152,17 +161,17 @@ theorem cauchy₃ (f : cau_seq β abv) {ε} : 0 < ε →
 theorem bounded (f : cau_seq β abv) : ∃ r, ∀ i, abv (f i) < r :=
 begin
   cases f.cauchy zero_lt_one with i h,
-  let R := ∑ j in finset.range (i+1), abv (f j),
-  have : ∀ j ≤ i, abv (f j) ≤ R,
-  { intros j ij, change (λ j, abv (f j)) j ≤ R,
-    apply finset.single_le_sum,
-    { intros, apply abv_nonneg abv },
-    { rwa [finset.mem_range, nat.lt_succ_iff] } },
-  refine ⟨R + 1, λ j, _⟩,
+  set R : ℕ → α := @nat.rec (λ n, α) (abv (f 0)) (λ i c, max c (abv (f i.succ))) with hR,
+  have : ∀ i, ∀ j ≤ i, abv (f j) ≤ R i,
+  { refine nat.rec (by simp [hR]) _,
+    rintros i hi j (rfl | hj),
+    { simp },
+    exact (hi j hj).trans (le_max_left _ _) },
+  refine ⟨R i + 1, λ j, _⟩,
   cases lt_or_le j i with ij ij,
-  { exact lt_of_le_of_lt (this _ (le_of_lt ij)) (lt_add_one _) },
+  { exact lt_of_le_of_lt (this i _ (le_of_lt ij)) (lt_add_one _) },
   { have := lt_of_le_of_lt (abv_add abv _ _)
-      (add_lt_add_of_le_of_lt (this _ le_rfl) (h _ ij)),
+      (add_lt_add_of_le_of_lt (this i _ le_rfl) (h _ ij)),
     rw [add_sub, add_comm] at this, simpa }
 end
 
@@ -171,13 +180,10 @@ let ⟨r, h⟩ := f.bounded in
 ⟨max r (x+1), lt_of_lt_of_le (lt_add_one _) (le_max_right _ _),
   λ i, lt_of_lt_of_le (h i) (le_max_left _ _)⟩
 
-instance : has_add (cau_seq β abv) :=
-⟨λ f g, ⟨λ i, (f i + g i : β), λ ε ε0,
-  let ⟨δ, δ0, Hδ⟩ := rat_add_continuous_lemma abv ε0,
-      ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0) in
-  ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ le_rfl in Hδ (H₁ _ ij) (H₂ _ ij)⟩⟩⟩
+instance : has_add (cau_seq β abv) := ⟨λ f g, ⟨f + g, f.2.add g.2⟩⟩
 
-@[simp] theorem add_apply (f g : cau_seq β abv) (i : ℕ) : (f + g) i = f i + g i := rfl
+@[simp, norm_cast] lemma coe_add (f g : cau_seq β abv) : ⇑(f + g) = f + g := rfl
+@[simp, norm_cast] theorem add_apply (f g : cau_seq β abv) (i : ℕ) : (f + g) i = f i + g i := rfl
 
 variable (abv)
 
@@ -189,7 +195,8 @@ variable {abv}
 
 local notation `const` := const abv
 
-@[simp] theorem const_apply (x : β) (i : ℕ) : (const x : ℕ → β) i = x := rfl
+@[simp, norm_cast] lemma coe_const (x : β) : ⇑(const x) = function.const _ x := rfl
+@[simp, norm_cast] theorem const_apply (x : β) (i : ℕ) : (const x : ℕ → β) i = x := rfl
 
 theorem const_inj {x y : β} : (const x : cau_seq β abv) = const y ↔ x = y :=
 ⟨λ h, congr_arg (λ f:cau_seq β abv, (f:ℕ→β) 0) h, congr_arg _⟩
@@ -198,55 +205,85 @@ instance : has_zero (cau_seq β abv) := ⟨const 0⟩
 instance : has_one (cau_seq β abv) := ⟨const 1⟩
 instance : inhabited (cau_seq β abv) := ⟨0⟩
 
-@[simp] theorem zero_apply (i) : (0 : cau_seq β abv) i = 0 := rfl
-@[simp] theorem one_apply (i) : (1 : cau_seq β abv) i = 1 := rfl
-@[simp] theorem const_zero : const 0 = 0 := rfl
+@[simp, norm_cast] lemma coe_zero : ⇑(0 : cau_seq β abv) = 0 := rfl
+@[simp, norm_cast] lemma coe_one : ⇑(1 : cau_seq β abv) = 1 := rfl
+@[simp, norm_cast] lemma zero_apply (i) : (0 : cau_seq β abv) i = 0 := rfl
+@[simp, norm_cast] lemma one_apply (i) : (1 : cau_seq β abv) i = 1 := rfl
+@[simp] lemma const_zero : const 0 = 0 := rfl
+@[simp] lemma const_one : const 1 = 1 := rfl
 
 theorem const_add (x y : β) : const (x + y) = const x + const y :=
-ext $ λ i, rfl
+rfl
 
 instance : has_mul (cau_seq β abv) :=
-⟨λ f g, ⟨λ i, (f i * g i : β), λ ε ε0,
+⟨λ f g, ⟨f * g, λ ε ε0,
   let ⟨F, F0, hF⟩ := f.bounded' 0, ⟨G, G0, hG⟩ := g.bounded' 0,
       ⟨δ, δ0, Hδ⟩ := rat_mul_continuous_lemma abv ε0,
       ⟨i, H⟩ := exists_forall_ge_and (f.cauchy₃ δ0) (g.cauchy₃ δ0) in
   ⟨i, λ j ij, let ⟨H₁, H₂⟩ := H _ le_rfl in
     Hδ (hF j) (hG i) (H₁ _ ij) (H₂ _ ij)⟩⟩⟩
 
-@[simp] theorem mul_apply (f g : cau_seq β abv) (i : ℕ) : (f * g) i = f i * g i := rfl
+@[simp, norm_cast] lemma coe_mul (f g : cau_seq β abv) : ⇑(f * g) = f * g := rfl
+@[simp, norm_cast] theorem mul_apply (f g : cau_seq β abv) (i : ℕ) : (f * g) i = f i * g i := rfl
 
-theorem const_mul (x y : β) : const (x * y) = const x * const y :=
-ext $ λ i, rfl
+theorem const_mul (x y : β) : const (x * y) = const x * const y := rfl
 
 instance : has_neg (cau_seq β abv) :=
 ⟨λ f, of_eq (const (-1) * f) (λ x, -f x) (λ i, by simp)⟩
 
-@[simp] theorem neg_apply (f : cau_seq β abv) (i) : (-f) i = -f i := rfl
+@[simp, norm_cast] lemma coe_neg (f : cau_seq β abv) : ⇑(-f) = -f := rfl
+@[simp, norm_cast] theorem neg_apply (f : cau_seq β abv) (i) : (-f) i = -f i := rfl
 
-theorem const_neg (x : β) : const (-x) = -const x :=
-ext $ λ i, rfl
+theorem const_neg (x : β) : const (-x) = -const x := rfl
 
 instance : has_sub (cau_seq β abv) :=
 ⟨λ f g, of_eq (f + -g) (λ x, f x - g x) (λ i, by simp [sub_eq_add_neg])⟩
 
-@[simp] theorem sub_apply (f g : cau_seq β abv) (i : ℕ) : (f - g) i = f i - g i := rfl
+@[simp, norm_cast] lemma coe_sub (f g : cau_seq β abv) : ⇑(f - g) = f - g := rfl
+@[simp, norm_cast] theorem sub_apply (f g : cau_seq β abv) (i : ℕ) : (f - g) i = f i - g i := rfl
+
+theorem const_sub (x y : β) : const (x - y) = const x - const y := rfl
+
+section has_smul
+variables [has_smul G β] [is_scalar_tower G β β]
 
-theorem const_sub (x y : β) : const (x - y) = const x - const y :=
-ext $ λ i, rfl
+instance : has_smul G (cau_seq β abv) :=
+⟨λ a f, of_eq (const (a • 1) * f) (a • f) $ λ i, smul_one_mul _ _⟩
+
+@[simp, norm_cast] lemma coe_smul (a : G) (f : cau_seq β abv) : ⇑(a • f) = a • f := rfl
+@[simp, norm_cast] lemma smul_apply (a : G) (f : cau_seq β abv) (i : ℕ) : (a • f) i = a • f i := rfl
+lemma const_smul (a : G) (x : β) : const (a • x) = a • const x := rfl
+
+instance : is_scalar_tower G (cau_seq β abv) (cau_seq β abv) :=
+⟨λ a f g, subtype.ext $ smul_assoc a ⇑f ⇑g⟩
+
+end has_smul
+
+instance : add_group (cau_seq β abv) :=
+function.injective.add_group _ subtype.coe_injective
+  rfl coe_add coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _)
+
+instance : add_group_with_one (cau_seq β abv) :=
+{ one := 1,
+  nat_cast := λ n, const n,
+  nat_cast_zero := congr_arg const nat.cast_zero,
+  nat_cast_succ := λ n, congr_arg const (nat.cast_succ n),
+  int_cast := λ n, const n,
+  int_cast_of_nat := λ n, congr_arg const (int.cast_of_nat n),
+  int_cast_neg_succ_of_nat := λ n, congr_arg const (int.cast_neg_succ_of_nat n),
+  .. cau_seq.add_group }
+
+instance : has_pow (cau_seq β abv) ℕ :=
+⟨λ f n, of_eq (npow_rec n f) (λ i, f i ^ n) $ by induction n; simp [*, npow_rec, pow_succ]⟩
+
+@[simp, norm_cast] lemma coe_pow (f : cau_seq β abv) (n : ℕ) : ⇑(f ^ n) = f ^ n := rfl
+@[simp, norm_cast] lemma pow_apply (f : cau_seq β abv) (n i : ℕ) : (f ^ n) i = f i ^ n := rfl
+lemma const_pow (x : β) (n : ℕ) : const (x ^ n) = const x ^ n := rfl
 
 instance : ring (cau_seq β abv) :=
-by refine_struct
-     { neg := has_neg.neg,
-       add := (+),
-       zero := (0 : cau_seq β abv),
-       mul := (*),
-       one := 1,
-       sub := has_sub.sub,
-       npow := @npow_rec (cau_seq β abv) ⟨1⟩ ⟨(*)⟩,
-       nsmul := @nsmul_rec (cau_seq β abv) ⟨0⟩ ⟨(+)⟩,
-       zsmul := @zsmul_rec (cau_seq β abv) ⟨0⟩ ⟨(+)⟩ ⟨has_neg.neg⟩ };
-intros; try { refl }; apply ext;
-simp [mul_add, mul_assoc, add_mul, add_comm, add_left_comm, sub_eq_add_neg]
+function.injective.ring _ subtype.coe_injective
+  rfl rfl coe_add coe_mul coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _) coe_pow
+  (λ _, rfl) (λ _, rfl)
 
 instance {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv] :
   comm_ring (cau_seq β abv) :=
@@ -304,20 +341,14 @@ instance equiv : setoid (cau_seq β abv) :=
 
 lemma add_equiv_add {f1 f2 g1 g2 : cau_seq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
   f1 + g1 ≈ f2 + g2 :=
-begin
-  change lim_zero ((f1 + g1) - _),
-  convert add_lim_zero hf hg using 1,
-  simp only [sub_eq_add_neg, add_assoc],
-  rw add_comm (-f2), simp only [add_assoc],
-  congr' 2, simp
-end
+by simpa only [←add_sub_add_comm] using add_lim_zero hf hg
 
 lemma neg_equiv_neg {f g : cau_seq β abv} (hf : f ≈ g) : -f ≈ -g :=
-begin
-  have hf : lim_zero _ := neg_lim_zero hf,
-  show lim_zero (-f - -g),
-  convert hf using 1, simp
-end
+by simpa only [neg_sub'] using neg_lim_zero hf
+
+lemma sub_equiv_sub {f1 f2 g1 g2 : cau_seq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
+  f1 - g1 ≈ f2 - g2 :=
+by simpa only [sub_eq_add_neg] using add_equiv_add hf (neg_equiv_neg hg)
 
 theorem equiv_def₃ {f g : cau_seq β abv} (h : f ≈ g) {ε : α} (ε0 : 0 < ε) :
   ∃ i, ∀ j ≥ i, ∀ k ≥ j, abv (f k - g j) < ε :=
@@ -367,6 +398,11 @@ have lim_zero (f - 0), from hf,
 have lim_zero (g*f), from mul_lim_zero_right _ $ by simpa,
 show lim_zero (g*f - 0), by simpa
 
+lemma mul_equiv_zero' (g : cau_seq _ abv) {f : cau_seq _ abv} (hf : f ≈ 0) : f * g ≈ 0 :=
+have lim_zero (f - 0), from hf,
+have lim_zero (f*g), from mul_lim_zero_left _ $ by simpa,
+show lim_zero (f*g - 0), by simpa
+
 lemma mul_not_equiv_zero {f g : cau_seq _ abv} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : ¬ (f * g) ≈ 0 :=
 assume : lim_zero (f*g - 0),
 have hlz : lim_zero (f*g), by simpa,
@@ -392,18 +428,29 @@ end
 theorem const_equiv {x y : β} : const x ≈ const y ↔ x = y :=
 show lim_zero _ ↔ _, by rw [← const_sub, const_lim_zero, sub_eq_zero]
 
-end ring
+lemma mul_equiv_mul {f1 f2 g1 g2 : cau_seq β abv} (hf : f1 ≈ f2) (hg : g1 ≈ g2) :
+  f1 * g1 ≈ f2 * g2 :=
+by simpa only [mul_sub, sub_mul, sub_add_sub_cancel]
+  using add_lim_zero (mul_lim_zero_left g1 hf) (mul_lim_zero_right f2 hg)
 
-section comm_ring
-variables {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]
+lemma smul_equiv_smul [has_smul G β] [is_scalar_tower G β β] {f1 f2 : cau_seq β abv}
+  (c : G) (hf : f1 ≈ f2) :
+  c • f1 ≈ c • f2 :=
+by simpa [const_smul, smul_one_mul _ _]
+  using mul_equiv_mul (const_equiv.mpr $ eq.refl $ c • 1) hf
 
-lemma mul_equiv_zero' (g : cau_seq _ abv) {f : cau_seq _ abv} (hf : f ≈ 0) : f * g ≈ 0 :=
-by rw mul_comm; apply mul_equiv_zero _ hf
+lemma pow_equiv_pow {f1 f2 : cau_seq β abv} (hf : f1 ≈ f2) (n : ℕ) :
+  f1 ^ n ≈ f2 ^ n :=
+begin
+  induction n with n ih,
+  { simp only [pow_zero, setoid.refl] },
+  { simpa only [pow_succ] using mul_equiv_mul hf ih, },
+end
 
-end comm_ring
+end ring
 
 section is_domain
-variables {β : Type*} [ring β] [is_domain β] (abv : β → α) [is_absolute_value abv]
+variables [ring β] [is_domain β] (abv : β → α) [is_absolute_value abv]
 
 lemma one_not_equiv_zero : ¬ (const abv 1) ≈ (const abv 0) :=
 assume h,
@@ -419,8 +466,8 @@ absurd this one_ne_zero
 
 end is_domain
 
-section field
-variables {β : Type*} [field β] {abv : β → α} [is_absolute_value abv]
+section division_ring
+variables [division_ring β] {abv : β → α} [is_absolute_value abv]
 
 theorem inv_aux {f : cau_seq β abv} (hf : ¬ lim_zero f) :
   ∀ ε > 0, ∃ i, ∀ j ≥ i, abv ((f j)⁻¹ - (f i)⁻¹) < ε | ε ε0 :=
@@ -433,7 +480,8 @@ let ⟨K, K0, HK⟩ := abv_pos_of_not_lim_zero hf,
 the inverses of the values of `f`. -/
 def inv (f : cau_seq β abv) (hf : ¬ lim_zero f) : cau_seq β abv := ⟨_, inv_aux hf⟩
 
-@[simp] theorem inv_apply {f : cau_seq β abv} (hf i) : inv f hf i = (f i)⁻¹ := rfl
+@[simp, norm_cast] lemma coe_inv {f : cau_seq β abv} (hf) : ⇑(inv f hf) = f⁻¹ := rfl
+@[simp, norm_cast] theorem inv_apply {f : cau_seq β abv} (hf i) : inv f hf i = (f i)⁻¹ := rfl
 
 theorem inv_mul_cancel {f : cau_seq β abv} (hf) : inv f hf * f ≈ 1 :=
 λ ε ε0, let ⟨K, K0, i, H⟩ := abv_pos_of_not_lim_zero hf in
@@ -441,11 +489,16 @@ theorem inv_mul_cancel {f : cau_seq β abv} (hf) : inv f hf * f ≈ 1 :=
   by simpa [(abv_pos abv).1 (lt_of_lt_of_le K0 (H _ ij)),
     abv_zero abv] using ε0⟩
 
+theorem mul_inv_cancel {f : cau_seq β abv} (hf) : f * inv f hf ≈ 1 :=
+λ ε ε0, let ⟨K, K0, i, H⟩ := abv_pos_of_not_lim_zero hf in
+⟨i, λ j ij,
+  by simpa [(abv_pos abv).1 (lt_of_lt_of_le K0 (H _ ij)),
+    abv_zero abv] using ε0⟩
+
 theorem const_inv {x : β} (hx : x ≠ 0) :
-  const abv (x⁻¹) = inv (const abv x) (by rwa const_lim_zero) :=
-ext (assume n, by simp[inv_apply, const_apply])
+  const abv (x⁻¹) = inv (const abv x) (by rwa const_lim_zero) := rfl
 
-end field
+end division_ring
 
 section abs
 local notation `const` := const abs
@@ -587,6 +640,177 @@ theorem exists_lt (f : cau_seq α abs) : ∃ a : α, const a < f :=
 let ⟨a, h⟩ := (-f).exists_gt in ⟨-a, show pos _,
   by rwa [const_neg, sub_neg_eq_add, add_comm, ← sub_neg_eq_add]⟩
 
+-- so named to match `rat_add_continuous_lemma`
+theorem _root_.rat_sup_continuous_lemma {ε : α} {a₁ a₂ b₁ b₂ : α} :
+  abs (a₁ - b₁) < ε → abs (a₂ - b₂) < ε → abs (a₁ ⊔ a₂ - (b₁ ⊔ b₂)) < ε :=
+λ h₁ h₂, (abs_max_sub_max_le_max _ _ _ _).trans_lt (max_lt h₁ h₂)
+
+-- so named to match `rat_add_continuous_lemma`
+theorem _root_.rat_inf_continuous_lemma {ε : α} {a₁ a₂ b₁ b₂ : α} :
+  abs (a₁ - b₁) < ε → abs (a₂ - b₂) < ε → abs (a₁ ⊓ a₂ - (b₁ ⊓ b₂)) < ε :=
+λ h₁ h₂, (abs_min_sub_min_le_max _ _ _ _).trans_lt (max_lt h₁ h₂)
+
+instance : has_sup (cau_seq α abs) :=
+⟨λ f g, ⟨f ⊔ g, λ ε ε0,
+  (exists_forall_ge_and (f.cauchy₃ ε0) (g.cauchy₃ ε0)).imp $ λ i H j ij,
+    let ⟨H₁, H₂⟩ := H _ le_rfl in rat_sup_continuous_lemma (H₁ _ ij) (H₂ _ ij)⟩⟩
+
+instance : has_inf (cau_seq α abs) :=
+⟨λ f g, ⟨f ⊓ g, λ ε ε0,
+  (exists_forall_ge_and (f.cauchy₃ ε0) (g.cauchy₃ ε0)).imp $ λ i H j ij,
+    let ⟨H₁, H₂⟩ := H _ le_rfl in rat_inf_continuous_lemma (H₁ _ ij) (H₂ _ ij)⟩⟩
+
+@[simp, norm_cast] lemma coe_sup (f g : cau_seq α abs) : ⇑(f ⊔ g) = f ⊔ g := rfl
+
+@[simp, norm_cast] lemma coe_inf (f g : cau_seq α abs) : ⇑(f ⊓ g) = f ⊓ g := rfl
+
+theorem sup_lim_zero {f g : cau_seq α abs}
+  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f ⊔ g)
+| ε ε0 := (exists_forall_ge_and (hf _ ε0) (hg _ ε0)).imp $
+  λ i H j ij, let ⟨H₁, H₂⟩ := H _ ij in begin
+    rw abs_lt at H₁ H₂ ⊢,
+    exact ⟨lt_sup_iff.mpr (or.inl H₁.1), sup_lt_iff.mpr ⟨H₁.2, H₂.2⟩⟩
+  end
+
+theorem inf_lim_zero {f g : cau_seq α abs}
+  (hf : lim_zero f) (hg : lim_zero g) : lim_zero (f ⊓ g)
+| ε ε0 := (exists_forall_ge_and (hf _ ε0) (hg _ ε0)).imp $
+  λ i H j ij, let ⟨H₁, H₂⟩ := H _ ij in begin
+    rw abs_lt at H₁ H₂ ⊢,
+    exact ⟨lt_inf_iff.mpr ⟨H₁.1, H₂.1⟩, inf_lt_iff.mpr (or.inl H₁.2), ⟩
+  end
+
+lemma sup_equiv_sup {a₁ b₁ a₂ b₂ : cau_seq α abs} (ha : a₁ ≈ a₂) (hb : b₁ ≈ b₂) :
+  a₁ ⊔ b₁ ≈ a₂ ⊔ b₂ :=
+begin
+  intros ε ε0,
+  obtain ⟨ai, hai⟩ := ha ε ε0,
+  obtain ⟨bi, hbi⟩ := hb ε ε0,
+  exact ⟨ai ⊔ bi, λ i hi,
+    (abs_max_sub_max_le_max (a₁ i) (b₁ i) (a₂ i) (b₂ i)).trans_lt
+    (max_lt (hai i (sup_le_iff.mp hi).1) (hbi i (sup_le_iff.mp hi).2))⟩,
+end
+
+lemma inf_equiv_inf {a₁ b₁ a₂ b₂ : cau_seq α abs} (ha : a₁ ≈ a₂) (hb : b₁ ≈ b₂) :
+  a₁ ⊓ b₁ ≈ a₂ ⊓ b₂ :=
+begin
+  intros ε ε0,
+  obtain ⟨ai, hai⟩ := ha ε ε0,
+  obtain ⟨bi, hbi⟩ := hb ε ε0,
+  exact ⟨ai ⊔ bi, λ i hi,
+    (abs_min_sub_min_le_max (a₁ i) (b₁ i) (a₂ i) (b₂ i)).trans_lt
+    (max_lt (hai i (sup_le_iff.mp hi).1) (hbi i (sup_le_iff.mp hi).2))⟩,
+end
+
+protected lemma sup_lt {a b c : cau_seq α abs} (ha : a < c) (hb : b < c) : a ⊔ b < c :=
+begin
+  obtain ⟨⟨εa, εa0, ia, ha⟩, ⟨εb, εb0, ib, hb⟩⟩ := ⟨ha, hb⟩,
+  refine ⟨εa ⊓ εb, lt_inf_iff.mpr ⟨εa0, εb0⟩, ia ⊔ ib, λ i hi, _⟩,
+  have := min_le_min (ha _ (sup_le_iff.mp hi).1) (hb _ (sup_le_iff.mp hi).2),
+  exact this.trans_eq (min_sub_sub_left _ _ _)
+end
+
+protected lemma lt_inf {a b c : cau_seq α abs} (hb : a < b) (hc : a < c) : a < b ⊓ c :=
+begin
+  obtain ⟨⟨εb, εb0, ib, hb⟩, ⟨εc, εc0, ic, hc⟩⟩ := ⟨hb, hc⟩,
+  refine ⟨εb ⊓ εc, lt_inf_iff.mpr ⟨εb0, εc0⟩, ib ⊔ ic, λ i hi, _⟩,
+  have := min_le_min (hb _ (sup_le_iff.mp hi).1) (hc _ (sup_le_iff.mp hi).2),
+  exact this.trans_eq (min_sub_sub_right _ _ _),
+end
+
+@[simp] protected lemma sup_idem (a : cau_seq α abs) : a ⊔ a = a := subtype.ext sup_idem
+
+@[simp] protected lemma inf_idem (a : cau_seq α abs) : a ⊓ a = a := subtype.ext inf_idem
+
+protected lemma sup_comm (a b : cau_seq α abs) : a ⊔ b = b ⊔ a := subtype.ext sup_comm
+
+protected lemma inf_comm (a b : cau_seq α abs) : a ⊓ b = b ⊓ a := subtype.ext inf_comm
+
+protected lemma sup_eq_right {a b : cau_seq α abs} (h : a ≤ b) :
+  a ⊔ b ≈ b :=
+begin
+  obtain ⟨ε, ε0 : _ < _, i, h⟩ | h := h,
+  { intros _ _,
+    refine ⟨i, λ j hj, _⟩,
+    dsimp,
+    erw ←max_sub_sub_right,
+    rwa [sub_self, max_eq_right, abs_zero],
+    rw [sub_nonpos, ←sub_nonneg],
+    exact ε0.le.trans (h _ hj) },
+  { refine setoid.trans (sup_equiv_sup h (setoid.refl _)) _,
+    rw cau_seq.sup_idem,
+    exact setoid.refl _ },
+end
+
+protected lemma inf_eq_right {a b : cau_seq α abs} (h : b ≤ a) :
+  a ⊓ b ≈ b :=
+begin
+  obtain ⟨ε, ε0 : _ < _, i, h⟩ | h := h,
+  { intros _ _,
+    refine ⟨i, λ j hj, _⟩,
+    dsimp,
+    erw ←min_sub_sub_right,
+    rwa [sub_self, min_eq_right, abs_zero],
+    exact ε0.le.trans (h _ hj) },
+  { refine setoid.trans (inf_equiv_inf (setoid.symm h) (setoid.refl _)) _,
+    rw cau_seq.inf_idem,
+    exact setoid.refl _ },
+end
+
+protected lemma sup_eq_left {a b : cau_seq α abs} (h : b ≤ a) :
+  a ⊔ b ≈ a :=
+by simpa only [cau_seq.sup_comm] using cau_seq.sup_eq_right h
+
+protected lemma inf_eq_left {a b : cau_seq α abs} (h : a ≤ b) :
+  a ⊓ b ≈ a :=
+by simpa only [cau_seq.inf_comm] using cau_seq.inf_eq_right h
+
+protected lemma le_sup_left {a b : cau_seq α abs} : a ≤ a ⊔ b :=
+le_of_exists ⟨0, λ j hj, le_sup_left⟩
+
+protected lemma inf_le_left {a b : cau_seq α abs} : a ⊓ b ≤ a :=
+le_of_exists ⟨0, λ j hj, inf_le_left⟩
+
+protected lemma le_sup_right {a b : cau_seq α abs} : b ≤ a ⊔ b :=
+le_of_exists ⟨0, λ j hj, le_sup_right⟩
+
+protected lemma inf_le_right {a b : cau_seq α abs} : a ⊓ b ≤ b :=
+le_of_exists ⟨0, λ j hj, inf_le_right⟩
+
+protected lemma sup_le {a b c : cau_seq α abs} (ha : a ≤ c) (hb : b ≤ c) : a ⊔ b ≤ c :=
+begin
+  cases ha with ha ha,
+  { cases hb with hb hb,
+    { exact or.inl (cau_seq.sup_lt ha hb) },
+    { replace ha := le_of_le_of_eq ha.le (setoid.symm hb),
+      refine le_of_le_of_eq (or.inr _) hb,
+      exact cau_seq.sup_eq_right ha }, },
+  { replace hb := le_of_le_of_eq hb (setoid.symm ha),
+    refine le_of_le_of_eq (or.inr _) ha,
+    exact cau_seq.sup_eq_left hb }
+end
+
+protected lemma le_inf {a b c : cau_seq α abs} (hb : a ≤ b) (hc : a ≤ c) : a ≤ b ⊓ c :=
+begin
+  cases hb with hb hb,
+  { cases hc with hc hc,
+    { exact or.inl (cau_seq.lt_inf hb hc) },
+    { replace hb := le_of_eq_of_le (setoid.symm hc) hb.le,
+      refine le_of_eq_of_le hc (or.inr _),
+      exact setoid.symm (cau_seq.inf_eq_right hb) }, },
+  { replace hc := le_of_eq_of_le (setoid.symm hb) hc,
+    refine le_of_eq_of_le hb (or.inr _),
+    exact setoid.symm (cau_seq.inf_eq_left hc) }
+end
+
+/-! Note that `distrib_lattice (cau_seq α abs)` is not true because there is no `partial_order`. -/
+
+protected lemma sup_inf_distrib_left (a b c : cau_seq α abs) : a ⊔ (b ⊓ c) = (a ⊔ b) ⊓ (a ⊔ c) :=
+subtype.ext $ funext $ λ i, max_min_distrib_left
+
+protected lemma sup_inf_distrib_right (a b c : cau_seq α abs) : (a ⊓ b) ⊔ c = (a ⊔ c) ⊓ (b ⊔ c) :=
+subtype.ext $ funext $ λ i, max_min_distrib_right
+
 end abs
 
 end cau_seq
diff --git a/src/data/real/cau_seq_completion.lean b/src/data/real/cau_seq_completion.lean
index 39e5d9b1a5b31..6a4db83b80edc 100644
--- a/src/data/real/cau_seq_completion.lean
+++ b/src/data/real/cau_seq_completion.lean
@@ -8,7 +8,10 @@ import data.real.cau_seq
 /-!
 # Cauchy completion
 
-This file generalizes the Cauchy completion of `(ℚ, abs)` to the completion of a commutative ring
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file generalizes the Cauchy completion of `(ℚ, abs)` to the completion of a ring
 with absolute value.
 -/
 
@@ -16,97 +19,131 @@ namespace cau_seq.completion
 open cau_seq
 
 section
-parameters {α : Type*} [linear_ordered_field α]
-parameters {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]
+variables {α : Type*} [linear_ordered_field α]
+variables {β : Type*} [ring β] (abv : β → α) [is_absolute_value abv]
 
-/-- The Cauchy completion of a commutative ring with absolute value. -/
+/-- The Cauchy completion of a ring with absolute value. -/
 def Cauchy := @quotient (cau_seq _ abv) cau_seq.equiv
 
+variables {abv}
+
 /-- The map from Cauchy sequences into the Cauchy completion. -/
-def mk : cau_seq _ abv → Cauchy := quotient.mk
+def mk : cau_seq _ abv → Cauchy abv := quotient.mk
 
-@[simp] theorem mk_eq_mk (f) : @eq Cauchy ⟦f⟧ (mk f) := rfl
+@[simp] theorem mk_eq_mk (f) : @eq (Cauchy abv) ⟦f⟧ (mk f) := rfl
 
-theorem mk_eq {f g} : mk f = mk g ↔ f ≈ g := quotient.eq
+theorem mk_eq {f g : cau_seq _ abv} : mk f = mk g ↔ f ≈ g := quotient.eq
 
 /-- The map from the original ring into the Cauchy completion. -/
-def of_rat (x : β) : Cauchy := mk (const abv x)
+def of_rat (x : β) : Cauchy abv := mk (const abv x)
 
-instance : has_zero Cauchy := ⟨of_rat 0⟩
-instance : has_one Cauchy := ⟨of_rat 1⟩
-instance : inhabited Cauchy := ⟨0⟩
+instance : has_zero (Cauchy abv) := ⟨of_rat 0⟩
+instance : has_one (Cauchy abv) := ⟨of_rat 1⟩
+instance : inhabited (Cauchy abv) := ⟨0⟩
 
-theorem of_rat_zero : of_rat 0 = 0 := rfl
-theorem of_rat_one : of_rat 1 = 1 := rfl
+theorem of_rat_zero : (of_rat 0 : Cauchy abv) = 0 := rfl
+theorem of_rat_one : (of_rat 1 : Cauchy abv) = 1 := rfl
 
-@[simp] theorem mk_eq_zero {f} : mk f = 0 ↔ lim_zero f :=
+@[simp] theorem mk_eq_zero {f : cau_seq _ abv} : mk f = 0 ↔ lim_zero f :=
 by have : mk f = 0 ↔ lim_zero (f - 0) := quotient.eq;
    rwa sub_zero at this
 
-instance : has_add Cauchy :=
-⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f + g)) $
-  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $
-  by simpa [(≈), setoid.r, sub_eq_add_neg, add_comm, add_left_comm, add_assoc]
-    using add_lim_zero hf hg⟩
+instance : has_add (Cauchy abv) :=
+⟨quotient.map₂ (+) $ λ f₁ g₁ hf f₂ g₂ hg, add_equiv_add hf hg⟩
 
 @[simp] theorem mk_add (f g : cau_seq β abv) : mk f + mk g = mk (f + g) := rfl
 
-instance : has_neg Cauchy :=
-⟨λ x, quotient.lift_on x (λ f, mk (-f)) $
-  λ f₁ f₂ hf, quotient.sound $
-  by simpa [(≈), setoid.r] using neg_lim_zero hf⟩
+instance : has_neg (Cauchy abv) :=
+⟨quotient.map has_neg.neg $ λ f₁ f₂ hf, neg_equiv_neg hf⟩
 
 @[simp] theorem mk_neg (f : cau_seq β abv) : -mk f = mk (-f) := rfl
 
-instance : has_mul Cauchy :=
-⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f * g)) $
-  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $
-  by simpa [(≈), setoid.r, mul_add, mul_comm, add_assoc, sub_eq_add_neg] using
-    add_lim_zero (mul_lim_zero_right g₁ hf) (mul_lim_zero_right f₂ hg)⟩
+instance : has_mul (Cauchy abv) :=
+⟨quotient.map₂ (*) $ λ f₁ g₁ hf f₂ g₂ hg, mul_equiv_mul hf hg⟩
 
 @[simp] theorem mk_mul (f g : cau_seq β abv) : mk f * mk g = mk (f * g) := rfl
 
-instance : has_sub Cauchy :=
-⟨λ x y, quotient.lift_on₂ x y (λ f g, mk (f - g)) $
-  λ f₁ g₁ f₂ g₂ hf hg, quotient.sound $ show ((f₁ - g₁) - (f₂ - g₂)).lim_zero,
-    by simpa [sub_eq_add_neg, add_assoc, add_comm, add_left_comm] using sub_lim_zero hf hg⟩
+instance : has_sub (Cauchy abv) :=
+⟨quotient.map₂ has_sub.sub $ λ f₁ g₁ hf f₂ g₂ hg, sub_equiv_sub hf hg⟩
 
 @[simp] theorem mk_sub (f g : cau_seq β abv) : mk f - mk g = mk (f - g) := rfl
 
-theorem of_rat_add (x y : β) : of_rat (x + y) = of_rat x + of_rat y :=
+instance {γ : Type*} [has_smul γ β] [is_scalar_tower γ β β] : has_smul γ (Cauchy abv) :=
+⟨λ c, quotient.map ((•) c) $ λ f₁ g₁ hf, smul_equiv_smul _ hf⟩
+
+@[simp] theorem mk_smul  {γ : Type*} [has_smul γ β] [is_scalar_tower γ β β] (c : γ)
+  (f : cau_seq β abv) :
+  c • mk f = mk (c • f) := rfl
+
+instance : has_pow (Cauchy abv) ℕ :=
+⟨λ x n, quotient.map (^ n) (λ f₁ g₁ hf, pow_equiv_pow hf _) x⟩
+
+@[simp] theorem mk_pow (n : ℕ) (f : cau_seq β abv) : mk f ^ n = mk (f ^ n) := rfl
+
+instance : has_nat_cast (Cauchy abv) := ⟨λ n, mk n⟩
+instance : has_int_cast (Cauchy abv) := ⟨λ n, mk n⟩
+
+@[simp] theorem of_rat_nat_cast (n : ℕ) : (of_rat n : Cauchy abv) = n := rfl
+@[simp] theorem of_rat_int_cast (z : ℤ) : (of_rat z : Cauchy abv) = z := rfl
+
+theorem of_rat_add (x y : β) : of_rat (x + y) = (of_rat x + of_rat y : Cauchy abv) :=
 congr_arg mk (const_add _ _)
 
-theorem of_rat_neg (x : β) : of_rat (-x) = -of_rat x :=
+theorem of_rat_neg (x : β) : of_rat (-x) = (-of_rat x : Cauchy abv) :=
 congr_arg mk (const_neg _)
 
-theorem of_rat_mul (x y : β) : of_rat (x * y) = of_rat x * of_rat y :=
+theorem of_rat_mul (x y : β) : of_rat (x * y) = (of_rat x * of_rat y : Cauchy abv) :=
 congr_arg mk (const_mul _ _)
 
-private lemma zero_def : 0 = mk 0 := rfl
+private lemma zero_def : 0 = (mk 0 : Cauchy abv) := rfl
 
-private lemma one_def : 1 = mk 1 := rfl
+private lemma one_def : 1 = (mk 1 : Cauchy abv) := rfl
 
-instance : comm_ring Cauchy :=
-by refine { neg := has_neg.neg, sub := has_sub.sub, sub_eq_add_neg := _,
-    add := (+), zero := (0 : Cauchy), mul := (*), one := 1, nsmul := nsmul_rec, npow := npow_rec,
-    zsmul := zsmul_rec, .. }; try { intros; refl };
-{ repeat {refine λ a, quotient.induction_on a (λ _, _)},
-  simp [zero_def, one_def, mul_left_comm, mul_comm, mul_add, add_comm, add_left_comm,
-          sub_eq_add_neg] }
+instance : ring (Cauchy abv) :=
+function.surjective.ring mk (surjective_quotient_mk _)
+  zero_def.symm one_def.symm (λ _ _, (mk_add _ _).symm) (λ _ _, (mk_mul _ _).symm)
+  (λ _, (mk_neg _).symm) (λ _ _, (mk_sub _ _).symm)
+  (λ _ _, (mk_smul _ _).symm) (λ _ _, (mk_smul _ _).symm)
+  (λ _ _, (mk_pow _ _).symm) (λ _, rfl) (λ _, rfl)
 
-theorem of_rat_sub (x y : β) : of_rat (x - y) = of_rat x - of_rat y :=
+/-- `cau_seq.completion.of_rat` as a `ring_hom`  -/
+@[simps]
+def of_rat_ring_hom : β →+* Cauchy abv :=
+{ to_fun := of_rat,
+  map_zero' := of_rat_zero,
+  map_one' := of_rat_one,
+  map_add' := of_rat_add,
+  map_mul' := of_rat_mul, }
+
+theorem of_rat_sub (x y : β) : of_rat (x - y) = (of_rat x - of_rat y : Cauchy abv) :=
 congr_arg mk (const_sub _ _)
 
 end
 
+section
+variables {α : Type*} [linear_ordered_field α]
+variables {β : Type*} [comm_ring β] {abv : β → α} [is_absolute_value abv]
+
+instance : comm_ring (Cauchy abv) :=
+function.surjective.comm_ring mk (surjective_quotient_mk _)
+  zero_def.symm one_def.symm (λ _ _, (mk_add _ _).symm) (λ _ _, (mk_mul _ _).symm)
+  (λ _, (mk_neg _).symm) (λ _ _, (mk_sub _ _).symm)
+  (λ _ _, (mk_smul _ _).symm) (λ _ _, (mk_smul _ _).symm)
+  (λ _ _, (mk_pow _ _).symm) (λ _, rfl) (λ _, rfl)
+
+end
+
 open_locale classical
 section
 
-parameters {α : Type*} [linear_ordered_field α]
-parameters {β : Type*} [field β] {abv : β → α} [is_absolute_value abv]
-local notation `Cauchy` := @Cauchy _ _ _ _ abv _
+variables {α : Type*} [linear_ordered_field α]
+variables {β : Type*} [division_ring β] {abv : β → α} [is_absolute_value abv]
+
+instance : has_rat_cast (Cauchy abv) := ⟨λ q, of_rat q⟩
 
-noncomputable instance : has_inv Cauchy :=
+@[simp] theorem of_rat_rat_cast (q : ℚ) : of_rat (↑q : β) = (q : Cauchy abv) := rfl
+
+noncomputable instance : has_inv (Cauchy abv) :=
 ⟨λ x, quotient.lift_on x
   (λ f, mk $ if h : lim_zero f then 0 else inv f h) $
 λ f g fg, begin
@@ -116,13 +153,13 @@ noncomputable instance : has_inv Cauchy :=
   { have hg := mt this.2 hf, simp [hf, hg],
     have If : mk (inv f hf) * mk f = 1 := mk_eq.2 (inv_mul_cancel hf),
     have Ig : mk (inv g hg) * mk g = 1 := mk_eq.2 (inv_mul_cancel hg),
+    have Ig' : mk g * mk (inv g hg) = 1 := mk_eq.2 (mul_inv_cancel hg),
     rw [mk_eq.2 fg, ← Ig] at If,
-    rw mul_comm at Ig,
-    rw [← mul_one (mk (inv f hf)), ← Ig, ← mul_assoc, If,
-        mul_assoc, Ig, mul_one] }
+    rw [← mul_one (mk (inv f hf)), ← Ig', ← mul_assoc, If,
+        mul_assoc, Ig', mul_one] }
 end⟩
 
-@[simp] theorem inv_zero : (0 : Cauchy)⁻¹ = 0 :=
+@[simp] theorem inv_zero : (0 : Cauchy abv)⁻¹ = 0 :=
 congr_arg mk $ by rw dif_pos; [refl, exact zero_lim_zero]
 
 @[simp] theorem inv_mk {f} (hf) : (@mk α _ β _ abv _ f)⁻¹ = mk (inv f hf) :=
@@ -133,34 +170,61 @@ have lim_zero (1 - 0), from setoid.symm h,
 have lim_zero 1, by simpa,
 one_ne_zero $ const_lim_zero.1 this
 
-lemma zero_ne_one : (0 : Cauchy) ≠ 1 :=
+lemma zero_ne_one : (0 : Cauchy abv) ≠ 1 :=
 λ h, cau_seq_zero_ne_one $ mk_eq.1 h
 
-protected theorem inv_mul_cancel {x : Cauchy} : x ≠ 0 → x⁻¹ * x = 1 :=
+protected theorem inv_mul_cancel {x : Cauchy abv} : x ≠ 0 → x⁻¹ * x = 1 :=
 quotient.induction_on x $ λ f hf, begin
   simp at hf, simp [hf],
   exact quotient.sound (cau_seq.inv_mul_cancel hf)
 end
 
-/-- The Cauchy completion forms a field.
-See note [reducible non-instances]. -/
-@[reducible]
-noncomputable def field : field Cauchy :=
+protected theorem mul_inv_cancel {x : Cauchy abv} : x ≠ 0 → x * x⁻¹ = 1 :=
+quotient.induction_on x $ λ f hf, begin
+  simp at hf, simp [hf],
+  exact quotient.sound (cau_seq.mul_inv_cancel hf)
+end
+
+theorem of_rat_inv (x : β) : of_rat (x⁻¹) = ((of_rat x)⁻¹ : Cauchy abv) :=
+congr_arg mk $ by split_ifs with h; [simp [const_lim_zero.1 h], refl]
+
+/-- The Cauchy completion forms a division ring. -/
+noncomputable instance : division_ring (Cauchy abv) :=
 { inv              := has_inv.inv,
-  mul_inv_cancel   := λ x x0, by rw [mul_comm, cau_seq.completion.inv_mul_cancel x0],
+  mul_inv_cancel   := λ x, cau_seq.completion.mul_inv_cancel,
   exists_pair_ne   := ⟨0, 1, zero_ne_one⟩,
   inv_zero         := inv_zero,
-  .. Cauchy.comm_ring }
+  rat_cast := λ q, of_rat q,
+  rat_cast_mk := λ n d hd hnd,
+    by rw [rat.cast_mk', of_rat_mul, of_rat_int_cast, of_rat_inv, of_rat_nat_cast],
+  .. Cauchy.ring }
 
-local attribute [instance] field
+theorem of_rat_div (x y : β) : of_rat (x / y) = (of_rat x / of_rat y : Cauchy abv) :=
+by simp only [div_eq_mul_inv, of_rat_inv, of_rat_mul]
 
-theorem of_rat_inv (x : β) : of_rat (x⁻¹) = ((of_rat x)⁻¹ : Cauchy) :=
-congr_arg mk $ by split_ifs with h; [simp [const_lim_zero.1 h], refl]
+/-- Show the first 10 items of a representative of this equivalence class of cauchy sequences.
 
-theorem of_rat_div (x y : β) : of_rat (x / y) = (of_rat x / of_rat y : Cauchy) :=
-by simp only [div_eq_inv_mul, of_rat_inv, of_rat_mul]
+The representative chosen is the one passed in the VM to `quot.mk`, so two cauchy sequences
+converging to the same number may be printed differently.
+-/
+meta instance [has_repr β] : has_repr (Cauchy abv) :=
+{ repr := λ r,
+  let N := 10, seq := r.unquot in
+    "(sorry /- " ++ (", ".intercalate $ (list.range N).map $ repr ∘ seq) ++ ", ... -/)" }
 
 end
+
+section
+variables {α : Type*} [linear_ordered_field α]
+variables {β : Type*} [field β] {abv : β → α} [is_absolute_value abv]
+
+/-- The Cauchy completion forms a field. -/
+noncomputable instance : field (Cauchy abv) :=
+{ .. Cauchy.division_ring,
+  .. Cauchy.comm_ring }
+
+end
+
 end cau_seq.completion
 
 variables {α : Type*} [linear_ordered_field α]
@@ -204,7 +268,7 @@ lim_eq_of_equiv_const $ setoid.refl _
 
 lemma lim_add (f g : cau_seq β abv) : lim f + lim g = lim (f + g) :=
 eq_lim_of_const_equiv $ show lim_zero (const abv (lim f + lim g) - (f + g)),
-  by rw [const_add, add_sub_comm];
+  by rw [const_add, add_sub_add_comm];
   exact add_lim_zero (setoid.symm (equiv_lim f)) (setoid.symm (equiv_lim g))
 
 lemma lim_mul_lim (f g : cau_seq β abv) : lim f * lim g = lim (f * g) :=
diff --git a/src/data/real/conjugate_exponents.lean b/src/data/real/conjugate_exponents.lean
index c11da7181c8e2..11931ee0b8eba 100644
--- a/src/data/real/conjugate_exponents.lean
+++ b/src/data/real/conjugate_exponents.lean
@@ -8,6 +8,9 @@ import data.real.ennreal
 /-!
 # Real conjugate exponents
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 `p.is_conjugate_exponent q` registers the fact that the real numbers `p` and `q` are `> 1` and
 satisfy `1/p + 1/q = 1`. This property shows up often in analysis, especially when dealing with
 `L^p` spaces.
@@ -65,8 +68,8 @@ ne_of_gt (h.one_div_pos)
 lemma conj_eq : q = p/(p-1) :=
 begin
   have := h.inv_add_inv_conj,
-  rw [← eq_sub_iff_add_eq', one_div, inv_eq_iff_inv_eq] at this,
-  field_simp [← this, h.ne_zero]
+  rw [← eq_sub_iff_add_eq', one_div, inv_eq_iff_eq_inv] at this,
+  field_simp [this, h.ne_zero]
 end
 
 lemma conjugate_eq : conjugate_exponent p = q := h.conj_eq.symm
@@ -112,4 +115,8 @@ lemma is_conjugate_exponent_conjugate_exponent {p : ℝ} (h : 1 < p) :
   p.is_conjugate_exponent (conjugate_exponent p) :=
 (is_conjugate_exponent_iff h).2 rfl
 
+lemma is_conjugate_exponent_one_div {a b : ℝ} (ha : 0 < a) (hb : 0 < b) (hab : a + b = 1) :
+  (1 / a).is_conjugate_exponent (1 / b) :=
+⟨by { rw [lt_div_iff ha, one_mul], linarith }, by { simp_rw one_div_one_div, exact hab }⟩
+
 end real
diff --git a/src/data/real/enat_ennreal.lean b/src/data/real/enat_ennreal.lean
new file mode 100644
index 0000000000000..109cdc3c26827
--- /dev/null
+++ b/src/data/real/enat_ennreal.lean
@@ -0,0 +1,72 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import data.enat.basic
+import data.real.ennreal
+
+/-!
+# Coercion from `ℕ∞` to `ℝ≥0∞`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define a coercion from `ℕ∞` to `ℝ≥0∞` and prove some basic lemmas about this map.
+-/
+
+open_locale classical nnreal ennreal
+noncomputable theory
+
+namespace enat
+
+variables {m n : ℕ∞}
+
+instance has_coe_ennreal : has_coe_t ℕ∞ ℝ≥0∞ := ⟨with_top.map coe⟩
+
+@[simp] lemma map_coe_nnreal : with_top.map (coe : ℕ → ℝ≥0) = (coe : ℕ∞ → ℝ≥0∞) := rfl
+
+/-- Coercion `ℕ∞ → ℝ≥0∞` as an `order_embedding`. -/
+@[simps { fully_applied := ff }] def to_ennreal_order_embedding : ℕ∞ ↪o ℝ≥0∞ :=
+nat.cast_order_embedding.with_top_map
+
+/-- Coercion `ℕ∞ → ℝ≥0∞` as a ring homomorphism. -/
+@[simps { fully_applied := ff }] def to_ennreal_ring_hom : ℕ∞ →+* ℝ≥0∞ :=
+(nat.cast_ring_hom ℝ≥0).with_top_map nat.cast_injective
+
+@[simp, norm_cast] lemma coe_ennreal_top : ((⊤ : ℕ∞) : ℝ≥0∞) = ⊤ := rfl
+@[simp, norm_cast] lemma coe_ennreal_coe (n : ℕ) : ((n : ℕ∞) : ℝ≥0∞) = n := rfl
+
+@[simp, norm_cast] lemma coe_ennreal_le : (m : ℝ≥0∞) ≤ n ↔ m ≤ n :=
+to_ennreal_order_embedding.le_iff_le
+
+@[simp, norm_cast] lemma coe_ennreal_lt : (m : ℝ≥0∞) < n ↔ m < n :=
+to_ennreal_order_embedding.lt_iff_lt
+
+@[mono] lemma coe_ennreal_mono : monotone (coe : ℕ∞ → ℝ≥0∞) := to_ennreal_order_embedding.monotone
+
+@[mono] lemma coe_ennreal_strict_mono : strict_mono (coe : ℕ∞ → ℝ≥0∞) :=
+to_ennreal_order_embedding.strict_mono
+
+@[simp, norm_cast] lemma coe_ennreal_zero : ((0 : ℕ∞) : ℝ≥0∞) = 0 := map_zero to_ennreal_ring_hom
+
+@[simp] lemma coe_ennreal_add (m n : ℕ∞) : ↑(m + n) = (m + n : ℝ≥0∞) :=
+map_add to_ennreal_ring_hom m n
+
+@[simp] lemma coe_ennreal_one : ((1 : ℕ∞) : ℝ≥0∞) = 1 := map_one to_ennreal_ring_hom
+
+@[simp] lemma coe_ennreal_bit0 (n : ℕ∞) : ↑(bit0 n) = bit0 (n : ℝ≥0∞) := coe_ennreal_add n n
+
+@[simp] lemma coe_ennreal_bit1 (n : ℕ∞) : ↑(bit1 n) = bit1 (n : ℝ≥0∞) :=
+map_bit1 to_ennreal_ring_hom n
+
+@[simp] lemma coe_ennreal_mul (m n : ℕ∞) : ↑(m * n) = (m * n : ℝ≥0∞) :=
+map_mul to_ennreal_ring_hom m n
+
+@[simp] lemma coe_ennreal_min (m n : ℕ∞) : ↑(min m n) = (min m n : ℝ≥0∞) := coe_ennreal_mono.map_min
+@[simp] lemma coe_ennreal_max (m n : ℕ∞) : ↑(max m n) = (max m n : ℝ≥0∞) := coe_ennreal_mono.map_max
+
+@[simp] lemma coe_ennreal_sub (m n : ℕ∞) : ↑(m - n) = (m - n : ℝ≥0∞) :=
+with_top.map_sub nat.cast_tsub nat.cast_zero m n
+
+end enat
diff --git a/src/data/real/ennreal.lean b/src/data/real/ennreal.lean
index db0e3a5ab3140..b01dfe825be35 100644
--- a/src/data/real/ennreal.lean
+++ b/src/data/real/ennreal.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Yury Kudryashov
 -/
 import data.real.nnreal
+import algebra.order.sub.with_top
 
 /-!
 # Extended non-negative reals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `ennreal = ℝ≥0∞ := with_top ℝ≥0` to be the type of extended nonnegative real numbers,
 i.e., the interval `[0, +∞]`. This type is used as the codomain of a `measure_theory.measure`,
 and of the extended distance `edist` in a `emetric_space`.
@@ -75,14 +79,15 @@ variables {α : Type*} {β : Type*}
 /-- The extended nonnegative real numbers. This is usually denoted [0, ∞],
   and is relevant as the codomain of a measure. -/
 @[derive [
-  has_zero, add_comm_monoid,
+  has_zero, add_comm_monoid_with_one,
+  semilattice_sup, distrib_lattice, order_bot, bounded_order,
   canonically_ordered_comm_semiring, complete_linear_order, densely_ordered, nontrivial,
   canonically_linear_ordered_add_monoid, has_sub, has_ordered_sub,
-  linear_ordered_add_comm_monoid_with_top]]
+  linear_ordered_add_comm_monoid_with_top, char_zero]]
 def ennreal := with_top ℝ≥0
 
-localized "notation `ℝ≥0∞` := ennreal" in ennreal
-localized "notation `∞` := (⊤ : ennreal)" in ennreal
+localized "notation (name := ennreal) `ℝ≥0∞` := ennreal" in ennreal
+localized "notation (name := ennreal.top) `∞` := (⊤ : ennreal)" in ennreal
 
 namespace ennreal
 variables {a b c d : ℝ≥0∞} {r p q : ℝ≥0}
@@ -94,22 +99,28 @@ canonically_ordered_comm_semiring.to_covariant_mul_le
 instance covariant_class_add_le : covariant_class ℝ≥0∞ ℝ≥0∞ (+) (≤) :=
 ordered_add_comm_monoid.to_covariant_class_left ℝ≥0∞
 
+noncomputable instance : linear_ordered_comm_monoid_with_zero ℝ≥0∞ :=
+{ mul_le_mul_left := λ a b, mul_le_mul_left',
+  zero_le_one := zero_le 1,
+  .. ennreal.linear_ordered_add_comm_monoid_with_top,
+  .. (show comm_semiring ℝ≥0∞, from infer_instance) }
+
+instance : unique (add_units ℝ≥0∞) :=
+{ default := 0,
+  uniq := λ a, add_units.ext $ le_zero_iff.1 $ by { rw ←a.add_neg, exact le_self_add } }
+
 instance : inhabited ℝ≥0∞ := ⟨0⟩
 
 instance : has_coe ℝ≥0 ℝ≥0∞ := ⟨ option.some ⟩
 
-instance : can_lift ℝ≥0∞ ℝ≥0 :=
-{ coe := coe,
-  cond := λ r, r ≠ ∞,
-  prf := λ x hx, ⟨option.get $ option.ne_none_iff_is_some.1 hx, option.some_get _⟩ }
+instance can_lift : can_lift ℝ≥0∞ ℝ≥0 coe (λ r, r ≠ ∞) :=
+{ prf := λ x hx, ⟨option.get $ option.ne_none_iff_is_some.1 hx, option.some_get _⟩ }
 
 @[simp] lemma none_eq_top : (none : ℝ≥0∞) = ∞ := rfl
 @[simp] lemma some_eq_coe (a : ℝ≥0) : (some a : ℝ≥0∞) = (↑a : ℝ≥0∞) := rfl
 
 /-- `to_nnreal x` returns `x` if it is real, otherwise 0. -/
-protected def to_nnreal : ℝ≥0∞ → ℝ≥0
-| (some r) := r
-| none := 0
+protected def to_nnreal : ℝ≥0∞ → ℝ≥0 := with_top.untop' 0
 
 /-- `to_real x` returns `x` if it is real, `0` otherwise. -/
 protected def to_real (a : ℝ≥0∞) : real := coe (a.to_nnreal)
@@ -178,20 +189,46 @@ lemma to_nnreal_eq_zero_iff (x : ℝ≥0∞) : x.to_nnreal = 0 ↔ x = 0 ∨ x =
 ⟨begin
   cases x,
   { simp [none_eq_top] },
-  { have A : some (0:ℝ≥0) = (0:ℝ≥0∞) := rfl,
-    simp [ennreal.to_nnreal, A] {contextual := tt} }
+  { rintro (rfl : x = 0),
+    exact or.inl rfl },
 end,
-by intro h; cases h; simp [h]⟩
+by rintro (h | h); simp [h]⟩
 
 lemma to_real_eq_zero_iff (x : ℝ≥0∞) : x.to_real = 0 ↔ x = 0 ∨ x = ∞ :=
 by simp [ennreal.to_real, to_nnreal_eq_zero_iff]
 
+lemma to_nnreal_ne_zero : a.to_nnreal ≠ 0 ↔ a ≠ 0 ∧ a ≠ ∞ :=
+a.to_nnreal_eq_zero_iff.not.trans not_or_distrib
+
+lemma to_real_ne_zero : a.to_real ≠ 0 ↔ a ≠ 0 ∧ a ≠ ∞ :=
+a.to_real_eq_zero_iff.not.trans not_or_distrib
+
+lemma to_nnreal_eq_one_iff (x : ℝ≥0∞) : x.to_nnreal = 1 ↔ x = 1 :=
+begin
+  refine ⟨λ h, _, congr_arg _⟩,
+  cases x,
+  { exact false.elim (zero_ne_one $ ennreal.top_to_nnreal.symm.trans h) },
+  { exact congr_arg _ h }
+end
+
+lemma to_real_eq_one_iff (x : ℝ≥0∞) : x.to_real = 1 ↔ x = 1 :=
+by rw [ennreal.to_real, nnreal.coe_eq_one, ennreal.to_nnreal_eq_one_iff]
+
+lemma to_nnreal_ne_one : a.to_nnreal ≠ 1 ↔ a ≠ 1 := a.to_nnreal_eq_one_iff.not
+lemma to_real_ne_one : a.to_real ≠ 1 ↔ a ≠ 1 := a.to_real_eq_one_iff.not
+
 @[simp] lemma coe_ne_top : (r : ℝ≥0∞) ≠ ∞ := with_top.coe_ne_top
 @[simp] lemma top_ne_coe : ∞ ≠ (r : ℝ≥0∞) := with_top.top_ne_coe
 @[simp] lemma of_real_ne_top {r : ℝ} : ennreal.of_real r ≠ ∞ := by simp [ennreal.of_real]
 @[simp] lemma of_real_lt_top {r : ℝ} : ennreal.of_real r < ∞ := lt_top_iff_ne_top.2 of_real_ne_top
 @[simp] lemma top_ne_of_real {r : ℝ} : ∞ ≠ ennreal.of_real r := by simp [ennreal.of_real]
 
+@[simp] lemma of_real_to_real_eq_iff : ennreal.of_real a.to_real = a ↔ a ≠ ⊤ :=
+⟨λ h, by { rw ←h, exact of_real_ne_top }, of_real_to_real⟩
+
+@[simp] lemma to_real_of_real_eq_iff {a : ℝ} : (ennreal.of_real a).to_real = a ↔ 0 ≤ a :=
+⟨λ h, by { rw ←h, exact to_real_nonneg }, to_real_of_real⟩
+
 @[simp] lemma zero_ne_top : 0 ≠ ∞ := coe_ne_top
 @[simp] lemma top_ne_zero : ∞ ≠ 0 := top_ne_coe
 
@@ -207,11 +244,9 @@ lemma coe_mono : monotone (coe : ℝ≥0 → ℝ≥0∞) := λ _ _, coe_le_coe.2
 @[simp, norm_cast] lemma zero_eq_coe : 0 = (↑r : ℝ≥0∞) ↔ 0 = r := coe_eq_coe
 @[simp, norm_cast] lemma coe_eq_one : (↑r : ℝ≥0∞) = 1 ↔ r = 1 := coe_eq_coe
 @[simp, norm_cast] lemma one_eq_coe : 1 = (↑r : ℝ≥0∞) ↔ 1 = r := coe_eq_coe
-@[simp, norm_cast] lemma coe_nonneg : 0 ≤ (↑r : ℝ≥0∞) ↔ 0 ≤ r := coe_le_coe
 @[simp, norm_cast] lemma coe_pos : 0 < (↑r : ℝ≥0∞) ↔ 0 < r := coe_lt_coe
 lemma coe_ne_zero : (r : ℝ≥0∞) ≠ 0 ↔ r ≠ 0 := not_congr coe_eq_coe
 
-
 @[simp, norm_cast] lemma coe_add : ↑(r + p) = (r + p : ℝ≥0∞) := with_top.coe_add
 @[simp, norm_cast] lemma coe_mul : ↑(r * p) = (r * p : ℝ≥0∞) := with_top.coe_mul
 
@@ -219,22 +254,38 @@ lemma coe_ne_zero : (r : ℝ≥0∞) ≠ 0 ↔ r ≠ 0 := not_congr coe_eq_coe
 @[simp, norm_cast] lemma coe_bit1 : (↑(bit1 r) : ℝ≥0∞) = bit1 r := by simp [bit1]
 lemma coe_two : ((2:ℝ≥0) : ℝ≥0∞) = 2 := by norm_cast
 
-protected lemma zero_lt_one : 0 < (1 : ℝ≥0∞) :=
-  canonically_ordered_comm_semiring.zero_lt_one
+lemma to_nnreal_eq_to_nnreal_iff (x y : ℝ≥0∞) :
+  x.to_nnreal = y.to_nnreal ↔ x = y ∨ x = 0 ∧ y = ⊤ ∨ x = ⊤ ∧ y = 0 :=
+begin
+  cases x,
+  { simp only [@eq_comm ℝ≥0 _ y.to_nnreal, @eq_comm ℝ≥0∞ _ y, to_nnreal_eq_zero_iff,
+      none_eq_top, top_to_nnreal, top_ne_zero, false_and, eq_self_iff_true,
+        true_and, false_or, or_comm (y = ⊤)] },
+  { cases y; simp }
+end
+
+lemma to_real_eq_to_real_iff (x y : ℝ≥0∞) :
+  x.to_real = y.to_real ↔ x = y ∨ (x = 0 ∧ y = ⊤) ∨ (x = ⊤ ∧ y = 0) :=
+by simp only [ennreal.to_real, nnreal.coe_eq, to_nnreal_eq_to_nnreal_iff]
+
+lemma to_nnreal_eq_to_nnreal_iff' {x y : ℝ≥0∞} (hx : x ≠ ⊤) (hy : y ≠ ⊤) :
+  x.to_nnreal = y.to_nnreal ↔ x = y :=
+by simp only [ennreal.to_nnreal_eq_to_nnreal_iff x y, hx, hy, and_false, false_and, or_false]
+
+lemma to_real_eq_to_real_iff' {x y : ℝ≥0∞} (hx : x ≠ ⊤) (hy : y ≠ ⊤) :
+  x.to_real = y.to_real ↔ x = y :=
+by simp only [ennreal.to_real, nnreal.coe_eq, to_nnreal_eq_to_nnreal_iff' hx hy]
 
 @[simp] lemma one_lt_two : (1 : ℝ≥0∞) < 2 :=
-coe_one ▸ coe_two ▸ by exact_mod_cast (@one_lt_two ℕ _ _)
-lemma one_le_two : (1 : ℝ≥0∞) ≤ 2 := one_lt_two.le
-@[simp] lemma zero_lt_two : (0:ℝ≥0∞) < 2 := lt_trans ennreal.zero_lt_one one_lt_two
-lemma two_ne_zero : (2:ℝ≥0∞) ≠ 0 := (ne_of_lt zero_lt_two).symm
-lemma two_ne_top : (2:ℝ≥0∞) ≠ ∞ := coe_two ▸ coe_ne_top
+coe_one ▸ coe_two ▸ by exact_mod_cast (one_lt_two : 1 < 2)
+
+lemma two_ne_top : (2 : ℝ≥0∞) ≠ ∞ := coe_two ▸ coe_ne_top
 
 /-- `(1 : ℝ≥0∞) ≤ 1`, recorded as a `fact` for use with `Lp` spaces. -/
 instance _root_.fact_one_le_one_ennreal : fact ((1 : ℝ≥0∞) ≤ 1) := ⟨le_rfl⟩
 
 /-- `(1 : ℝ≥0∞) ≤ 2`, recorded as a `fact` for use with `Lp` spaces. -/
-instance _root_.fact_one_le_two_ennreal : fact ((1 : ℝ≥0∞) ≤ 2) :=
-⟨ennreal.coe_le_coe.2 (show (1 : ℝ≥0) ≤ 2, by norm_num)⟩
+instance _root_.fact_one_le_two_ennreal : fact ((1 : ℝ≥0∞) ≤ 2) := ⟨one_le_two⟩
 
 /-- `(1 : ℝ≥0∞) ≤ ∞`, recorded as a `fact` for use with `Lp` spaces. -/
 instance _root_.fact_one_le_top_ennreal : fact ((1 : ℝ≥0∞) ≤ ∞) := ⟨le_top⟩
@@ -268,15 +319,13 @@ lemma supr_ennreal {α : Type*} [complete_lattice α] {f : ℝ≥0∞ → α} :
   (⨆ n, f n) = (⨆ n : ℝ≥0, f n) ⊔ f ∞ :=
 @infi_ennreal αᵒᵈ _ _
 
-@[simp] lemma add_top : a + ∞ = ∞ := add_top _
-@[simp] lemma top_add : ∞ + a = ∞ := top_add _
-
 /-- Coercion `ℝ≥0 → ℝ≥0∞` as a `ring_hom`. -/
 def of_nnreal_hom : ℝ≥0 →+* ℝ≥0∞ :=
 ⟨coe, coe_one, λ _ _, coe_mul, coe_zero, λ _ _, coe_add⟩
 
 @[simp] lemma coe_of_nnreal_hom : ⇑of_nnreal_hom = coe := rfl
 
+-- TODO: generalize some of these (and subsequent lemmas about `smul`) to `with_top α`
 section actions
 
 /-- A `mul_action` over `ℝ≥0∞` restricts to a `mul_action` over `ℝ≥0`. -/
@@ -286,15 +335,15 @@ mul_action.comp_hom M of_nnreal_hom.to_monoid_hom
 lemma smul_def {M : Type*} [mul_action ℝ≥0∞ M] (c : ℝ≥0) (x : M) :
   c • x = (c : ℝ≥0∞) • x := rfl
 
-instance {M N : Type*} [mul_action ℝ≥0∞ M] [mul_action ℝ≥0∞ N] [has_scalar M N]
+instance {M N : Type*} [mul_action ℝ≥0∞ M] [mul_action ℝ≥0∞ N] [has_smul M N]
   [is_scalar_tower ℝ≥0∞ M N] : is_scalar_tower ℝ≥0 M N :=
 { smul_assoc := λ r, (smul_assoc (r : ℝ≥0∞) : _)}
 
-instance smul_comm_class_left {M N : Type*} [mul_action ℝ≥0∞ N] [has_scalar M N]
+instance smul_comm_class_left {M N : Type*} [mul_action ℝ≥0∞ N] [has_smul M N]
   [smul_comm_class ℝ≥0∞ M N] : smul_comm_class ℝ≥0 M N :=
 { smul_comm := λ r, (smul_comm (r : ℝ≥0∞) : _)}
 
-instance smul_comm_class_right {M N : Type*} [mul_action ℝ≥0∞ N] [has_scalar M N]
+instance smul_comm_class_right {M N : Type*} [mul_action ℝ≥0∞ N] [has_smul M N]
   [smul_comm_class M ℝ≥0∞ N] : smul_comm_class M ℝ≥0 N :=
 { smul_comm := λ m r, (smul_comm m (r : ℝ≥0∞) : _)}
 
@@ -315,10 +364,10 @@ noncomputable instance {A : Type*} [semiring A] [algebra ℝ≥0∞ A] : algebra
   to_ring_hom := ((algebra_map ℝ≥0∞ A).comp (of_nnreal_hom : ℝ≥0 →+* ℝ≥0∞)) }
 
 -- verify that the above produces instances we might care about
-noncomputable example : algebra ℝ≥0 ℝ≥0∞ := by apply_instance
-noncomputable example : distrib_mul_action ℝ≥0ˣ ℝ≥0∞ := by apply_instance
+noncomputable example : algebra ℝ≥0 ℝ≥0∞ := infer_instance
+noncomputable example : distrib_mul_action ℝ≥0ˣ ℝ≥0∞ := infer_instance
 
-lemma coe_smul {R} (r : R) (s : ℝ≥0) [has_scalar R ℝ≥0] [has_scalar R ℝ≥0∞]
+lemma coe_smul {R} (r : R) (s : ℝ≥0) [has_smul R ℝ≥0] [has_smul R ℝ≥0∞]
   [is_scalar_tower R ℝ≥0 ℝ≥0] [is_scalar_tower R ℝ≥0 ℝ≥0∞] :
   (↑(r • s) : ℝ≥0∞) = r • ↑s :=
 by rw [←smul_one_smul ℝ≥0 r (s: ℝ≥0∞), smul_def, smul_eq_mul, ←ennreal.coe_mul, smul_mul_assoc,
@@ -353,6 +402,14 @@ begin split_ifs, { simp [h] }, { exact with_top.top_mul h } end
 
 @[simp] lemma top_mul_top : ∞ * ∞ = ∞ := with_top.top_mul_top
 
+lemma smul_top {R} [has_zero R] [smul_with_zero R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+  [no_zero_smul_divisors R ℝ≥0∞] (c : R) :
+  c • ∞ = (if c = 0 then 0 else ∞) :=
+begin
+  rw [←smul_one_mul, mul_top],
+  simp_rw [smul_eq_zero, or_iff_left one_ne_zero],
+end
+
 lemma top_pow {n:ℕ} (h : 0 < n) : ∞^n = ∞ :=
 nat.le_induction (pow_one _) (λ m hm hm', by rw [pow_succ, hm', top_mul_top])
   _ (nat.succ_le_of_lt h)
@@ -453,21 +510,6 @@ end
   ↑(s.sup f) = s.sup (λ x, (f x : ℝ≥0∞)) :=
 finset.comp_sup_eq_sup_comp_of_is_total _ coe_mono rfl
 
-lemma pow_le_pow {n m : ℕ} (ha : 1 ≤ a) (h : n ≤ m) : a ^ n ≤ a ^ m :=
-begin
-  cases a,
-  { cases m,
-    { rw eq_bot_iff.mpr h,
-      exact le_rfl },
-    { rw [none_eq_top, top_pow (nat.succ_pos m)],
-      exact le_top } },
-  { rw [some_eq_coe, ← coe_pow, ← coe_pow, coe_le_coe],
-    exact pow_le_pow (by simpa using ha) h }
-end
-
-lemma one_le_pow_of_one_le (ha : 1 ≤ a) (n : ℕ) : 1 ≤ a ^ n :=
-by simpa using pow_le_pow ha (zero_le n)
-
 @[simp] lemma max_eq_zero_iff : max a b = 0 ↔ a = 0 ∧ b = 0 :=
 by simp only [nonpos_iff_eq_zero.symm, max_le_iff]
 
@@ -559,16 +601,11 @@ begin
   exact tsub_add_cancel_of_le ad.le
 end
 
-lemma coe_nat_lt_coe {n : ℕ} : (n : ℝ≥0∞) < r ↔ ↑n < r := ennreal.coe_nat n ▸ coe_lt_coe
-lemma coe_lt_coe_nat {n : ℕ} : (r : ℝ≥0∞) < n ↔ r < n := ennreal.coe_nat n ▸ coe_lt_coe
-@[simp, norm_cast] lemma coe_nat_lt_coe_nat {m n : ℕ} : (m : ℝ≥0∞) < n ↔ m < n :=
-ennreal.coe_nat n ▸ coe_nat_lt_coe.trans nat.cast_lt
-lemma coe_nat_ne_top {n : ℕ} : (n : ℝ≥0∞) ≠ ∞ := ennreal.coe_nat n ▸ coe_ne_top
-lemma coe_nat_mono : strict_mono (coe : ℕ → ℝ≥0∞) := λ _ _, coe_nat_lt_coe_nat.2
-@[simp, norm_cast] lemma coe_nat_le_coe_nat {m n : ℕ} : (m : ℝ≥0∞) ≤ n ↔ m ≤ n :=
-coe_nat_mono.le_iff_le
+@[simp, norm_cast] lemma coe_nat_lt_coe {n : ℕ} : (n : ℝ≥0∞) < r ↔ ↑n < r :=
+ennreal.coe_nat n ▸ coe_lt_coe
 
-instance : char_zero ℝ≥0∞ := ⟨coe_nat_mono.injective⟩
+@[simp, norm_cast] lemma coe_lt_coe_nat {n : ℕ} : (r : ℝ≥0∞) < n ↔ r < n :=
+ennreal.coe_nat n ▸ coe_lt_coe
 
 protected lemma exists_nat_gt {r : ℝ≥0∞} (h : r ≠ ∞) : ∃n:ℕ, r < n :=
 begin
@@ -577,6 +614,35 @@ begin
   exact ⟨n, coe_lt_coe_nat.2 hn⟩,
 end
 
+@[simp] lemma Union_Iio_coe_nat : (⋃ n : ℕ, Iio (n : ℝ≥0∞)) = {∞}ᶜ :=
+begin
+  ext x,
+  rw [mem_Union],
+  exact ⟨λ ⟨n, hn⟩, ne_top_of_lt hn, ennreal.exists_nat_gt⟩
+end
+
+@[simp] lemma Union_Iic_coe_nat : (⋃ n : ℕ, Iic (n : ℝ≥0∞)) = {∞}ᶜ :=
+subset.antisymm (Union_subset $ λ n x hx, ne_top_of_le_ne_top (nat_ne_top n) hx) $
+  Union_Iio_coe_nat ▸ Union_mono (λ n, Iio_subset_Iic_self)
+
+@[simp] lemma Union_Ioc_coe_nat : (⋃ n : ℕ, Ioc a n) = Ioi a \ {∞} :=
+by simp only [← Ioi_inter_Iic, ← inter_Union, Union_Iic_coe_nat, diff_eq]
+
+@[simp] lemma Union_Ioo_coe_nat : (⋃ n : ℕ, Ioo a n) = Ioi a \ {∞} :=
+by simp only [← Ioi_inter_Iio, ← inter_Union, Union_Iio_coe_nat, diff_eq]
+
+@[simp] lemma Union_Icc_coe_nat : (⋃ n : ℕ, Icc a n) = Ici a \ {∞} :=
+by simp only [← Ici_inter_Iic, ← inter_Union, Union_Iic_coe_nat, diff_eq]
+
+@[simp] lemma Union_Ico_coe_nat : (⋃ n : ℕ, Ico a n) = Ici a \ {∞} :=
+by simp only [← Ici_inter_Iio, ← inter_Union, Union_Iio_coe_nat, diff_eq]
+
+@[simp] lemma Inter_Ici_coe_nat : (⋂ n : ℕ, Ici (n : ℝ≥0∞)) = {∞} :=
+by simp only [← compl_Iio, ← compl_Union, Union_Iio_coe_nat, compl_compl]
+
+@[simp] lemma Inter_Ioi_coe_nat : (⋂ n : ℕ, Ioi (n : ℝ≥0∞)) = {∞} :=
+by simp only [← compl_Iic, ← compl_Union, Union_Iic_coe_nat, compl_compl]
+
 lemma add_lt_add (ac : a < c) (bd : b < d) : a + b < c + d :=
 begin
   lift a to ℝ≥0 using ne_top_of_lt ac,
@@ -613,8 +679,12 @@ section complete_lattice
 lemma coe_Sup {s : set ℝ≥0} : bdd_above s → (↑(Sup s) : ℝ≥0∞) = (⨆a∈s, ↑a) := with_top.coe_Sup
 lemma coe_Inf {s : set ℝ≥0} : s.nonempty → (↑(Inf s) : ℝ≥0∞) = (⨅a∈s, ↑a) := with_top.coe_Inf
 
-@[simp] lemma top_mem_upper_bounds {s : set ℝ≥0∞} : ∞ ∈ upper_bounds s :=
-assume x hx, le_top
+lemma coe_supr {ι : Sort*} {f : ι → ℝ≥0} (hf : bdd_above (range f)) :
+  (↑(supr f) : ℝ≥0∞) = ⨆a, ↑(f a) :=
+with_top.coe_supr _ hf
+@[norm_cast]
+lemma coe_infi {ι : Sort*} [nonempty ι] (f : ι → ℝ≥0) : (↑(infi f) : ℝ≥0∞) = (⨅ a, ↑(f a)) :=
+with_top.coe_infi f
 
 lemma coe_mem_upper_bounds {s : set ℝ≥0} :
   ↑r ∈ upper_bounds ((coe : ℝ≥0 → ℝ≥0∞) '' s) ↔ r ∈ upper_bounds s :=
@@ -624,9 +694,6 @@ end complete_lattice
 
 section mul
 
-@[mono] lemma mul_le_mul : a ≤ b → c ≤ d → a * c ≤ b * d :=
-mul_le_mul'
-
 @[mono] lemma mul_lt_mul (ac : a < c) (bd : b < d) : a * b < c * d :=
 begin
   rcases lt_iff_exists_nnreal_btwn.1 ac with ⟨a', aa', a'c⟩,
@@ -637,12 +704,14 @@ begin
   calc ↑(a * b) < ↑(a' * b') :
     coe_lt_coe.2 (mul_lt_mul' aa'.le bb' (zero_le _) ((zero_le a).trans_lt aa'))
   ... = ↑a' * ↑b' : coe_mul
-  ... ≤ c * d : mul_le_mul a'c.le b'd.le
+  ... ≤ c * d : mul_le_mul' a'c.le b'd.le
 end
 
-lemma mul_left_mono : monotone ((*) a) := λ b c, mul_le_mul (le_refl a)
+-- TODO: generalize to `covariant_class α α (*) (≤)`
+lemma mul_left_mono : monotone ((*) a) := λ b c, mul_le_mul' le_rfl
 
-lemma mul_right_mono : monotone (λ x, x * a) := λ b c h, mul_le_mul h (le_refl a)
+-- TODO: generalize to `covariant_class α α (swap (*)) (≤)`
+lemma mul_right_mono : monotone (λ x, x * a) := λ b c h, mul_le_mul' h le_rfl
 
 lemma pow_strict_mono {n : ℕ} (hn : n ≠ 0) : strict_mono (λ (x : ℝ≥0∞), x^n) :=
 begin
@@ -659,28 +728,30 @@ mul_right_mono.map_max
 lemma mul_max : a * max b c = max (a * b) (a * c) :=
 mul_left_mono.map_max
 
-lemma mul_eq_mul_left : a ≠ 0 → a ≠ ∞ → (a * b = a * c ↔ b = c) :=
+theorem mul_left_strictMono (h0 : a ≠ 0) (hinf : a ≠ ∞) : strict_mono ((*) a) :=
 begin
-  cases a; cases b; cases c;
-    simp [none_eq_top, some_eq_coe, mul_top, top_mul, -coe_mul, coe_mul.symm,
-      nnreal.mul_eq_mul_left] {contextual := tt},
+  lift a to ℝ≥0 using hinf,
+  rw [coe_ne_zero] at h0,
+  intros x y h,
+  contrapose! h,
+  simpa only [← mul_assoc, ← coe_mul, inv_mul_cancel h0, coe_one, one_mul]
+    using mul_le_mul_left' h (↑a⁻¹)
 end
 
+lemma mul_eq_mul_left (h₀ : a ≠ 0) (hinf : a ≠ ∞) : a * b = a * c ↔ b = c :=
+(mul_left_strictMono h₀ hinf).injective.eq_iff
+
 lemma mul_eq_mul_right : c ≠ 0 → c ≠ ∞ → (a * c = b * c ↔ a = b) :=
 mul_comm c a ▸ mul_comm c b ▸ mul_eq_mul_left
 
-lemma mul_le_mul_left : a ≠ 0 → a ≠ ∞ → (a * b ≤ a * c ↔ b ≤ c) :=
-begin
-  cases a; cases b; cases c;
-    simp [none_eq_top, some_eq_coe, mul_top, top_mul, -coe_mul, coe_mul.symm] {contextual := tt},
-  assume h, exact mul_le_mul_left (pos_iff_ne_zero.2 h)
-end
+lemma mul_le_mul_left (h₀ : a ≠ 0) (hinf : a ≠ ∞) : a * b ≤ a * c ↔ b ≤ c :=
+(mul_left_strictMono h₀ hinf).le_iff_le
 
 lemma mul_le_mul_right : c ≠ 0 → c ≠ ∞ → (a * c ≤ b * c ↔ a ≤ b) :=
 mul_comm c a ▸ mul_comm c b ▸ mul_le_mul_left
 
-lemma mul_lt_mul_left : a ≠ 0 → a ≠ ∞ → (a * b < a * c ↔ b < c) :=
-λ h0 ht, by simp only [mul_le_mul_left h0 ht, lt_iff_le_not_le]
+lemma mul_lt_mul_left (h₀ : a ≠ 0) (hinf : a ≠ ∞) : a * b < a * c ↔ b < c :=
+(mul_left_strictMono h₀ hinf).lt_iff_lt
 
 lemma mul_lt_mul_right : c ≠ 0 → c ≠ ∞ → (a * c < b * c ↔ a < b) :=
 mul_comm c a ▸ mul_comm c b ▸ mul_lt_mul_left
@@ -688,12 +759,13 @@ mul_comm c a ▸ mul_comm c b ▸ mul_lt_mul_left
 end mul
 
 section cancel
+
 /-- An element `a` is `add_le_cancellable` if `a + b ≤ a + c` implies `b ≤ c` for all `b` and `c`.
   This is true in `ℝ≥0∞` for all elements except `∞`. -/
 lemma add_le_cancellable_iff_ne {a : ℝ≥0∞} : add_le_cancellable a ↔ a ≠ ∞ :=
 begin
   split,
-  { rintro h rfl, refine ennreal.zero_lt_one.not_le (h _), simp, },
+  { rintro h rfl, refine zero_lt_one.not_le (h _), simp, },
   { rintro h b c hbc, apply ennreal.le_of_add_le_add_left h hbc }
 end
 
@@ -728,15 +800,15 @@ le_antisymm (le_Inf $ λ c, tsub_le_iff_right.mpr) $ Inf_le le_tsub_add
 
 /-- This is a special case of `with_top.coe_sub` in the `ennreal` namespace -/
 lemma coe_sub : (↑(r - p) : ℝ≥0∞) = ↑r - ↑p :=
-by simp
+with_top.coe_sub
 
 /-- This is a special case of `with_top.top_sub_coe` in the `ennreal` namespace -/
 lemma top_sub_coe : ∞ - ↑r = ∞ :=
-by simp
+with_top.top_sub_coe
 
 /-- This is a special case of `with_top.sub_top` in the `ennreal` namespace -/
 lemma sub_top : a - ∞ = 0 :=
-by simp
+with_top.sub_top
 
 lemma sub_eq_top_iff : a - b = ∞ ↔ a = ∞ ∧ b ≠ ∞ :=
 by { cases a; cases b; simp [← with_top.coe_sub] }
@@ -744,6 +816,9 @@ by { cases a; cases b; simp [← with_top.coe_sub] }
 lemma sub_ne_top (ha : a ≠ ∞) : a - b ≠ ∞ :=
 mt sub_eq_top_iff.mp $ mt and.left ha
 
+@[simp, norm_cast] lemma nat_cast_sub (m n : ℕ) : ↑(m - n) = (m - n : ℝ≥0∞) :=
+by rw [← coe_nat, nat.cast_tsub, coe_sub, coe_nat, coe_nat]
+
 protected lemma sub_eq_of_eq_add (hb : b ≠ ∞) : a = c + b → a - b = c :=
 (cancel_of_ne hb).tsub_eq_of_eq_add
 
@@ -771,12 +846,7 @@ begin
 end
 
 protected lemma lt_add_of_sub_lt_right (h : a ≠ ∞ ∨ c ≠ ∞) : a - c < b → a < b + c :=
-begin
-  obtain rfl | hc := eq_or_ne c ∞,
-  { rw [add_top, lt_top_iff_ne_top],
-    exact λ _, h.resolve_right (not_not.2 rfl) },
-  { exact (cancel_of_ne hc).lt_add_of_tsub_lt_right }
-end
+add_comm c b ▸ ennreal.lt_add_of_sub_lt_left h
 
 lemma le_sub_of_add_le_left (ha : a ≠ ∞) : a + b ≤ c → b ≤ c - a :=
 (cancel_of_ne ha).le_tsub_of_add_le_left
@@ -904,37 +974,29 @@ end interval
 
 section bit
 
-@[simp] lemma bit0_inj : bit0 a = bit0 b ↔ a = b :=
-⟨λh, begin
-  rcases (lt_trichotomy a b) with h₁| h₂| h₃,
-  { exact (absurd h (ne_of_lt (add_lt_add h₁ h₁))) },
-  { exact h₂ },
-  { exact (absurd h.symm (ne_of_lt (add_lt_add h₃ h₃))) }
-end,
-λh, congr_arg _ h⟩
+@[mono] lemma bit0_strict_mono : strict_mono (bit0 : ℝ≥0∞ → ℝ≥0∞) := λ a b h, add_lt_add h h
+lemma bit0_injective : function.injective (bit0 : ℝ≥0∞ → ℝ≥0∞) := bit0_strict_mono.injective
 
-@[simp] lemma bit0_eq_zero_iff : bit0 a = 0 ↔ a = 0 :=
-by simpa only [bit0_zero] using @bit0_inj a 0
+@[simp] lemma bit0_lt_bit0 : bit0 a < bit0 b ↔ a < b := bit0_strict_mono.lt_iff_lt
+@[simp, mono] lemma bit0_le_bit0 : bit0 a ≤ bit0 b ↔ a ≤ b := bit0_strict_mono.le_iff_le
+@[simp] lemma bit0_inj : bit0 a = bit0 b ↔ a = b := bit0_injective.eq_iff
 
-@[simp] lemma bit0_eq_top_iff : bit0 a = ∞ ↔ a = ∞ :=
-by rw [bit0, add_eq_top, or_self]
+@[simp] lemma bit0_eq_zero_iff : bit0 a = 0 ↔ a = 0 := bit0_injective.eq_iff' bit0_zero
+@[simp] lemma bit0_top : bit0 ∞ = ∞ := add_top _
+@[simp] lemma bit0_eq_top_iff : bit0 a = ∞ ↔ a = ∞ := bit0_injective.eq_iff' bit0_top
 
-@[simp] lemma bit1_inj : bit1 a = bit1 b ↔ a = b :=
-⟨λh, begin
-  unfold bit1 at h,
-  rwa [add_left_inj, bit0_inj] at h,
-  simp [lt_top_iff_ne_top]
-end,
-λh, congr_arg _ h⟩
+@[mono] lemma bit1_strict_mono : strict_mono (bit1 : ℝ≥0∞ → ℝ≥0∞) :=
+λ a b h, ennreal.add_lt_add_right one_ne_top (bit0_strict_mono h)
 
-@[simp] lemma bit1_ne_zero : bit1 a ≠ 0 :=
-by unfold bit1; simp
+lemma bit1_injective : function.injective (bit1 : ℝ≥0∞ → ℝ≥0∞) := bit1_strict_mono.injective
 
-@[simp] lemma bit1_eq_one_iff : bit1 a = 1 ↔ a = 0 :=
-by simpa only [bit1_zero] using @bit1_inj a 0
-
-@[simp] lemma bit1_eq_top_iff : bit1 a = ∞ ↔ a = ∞ :=
-by unfold bit1; rw add_eq_top; simp
+@[simp] lemma bit1_lt_bit1 : bit1 a < bit1 b ↔ a < b := bit1_strict_mono.lt_iff_lt
+@[simp, mono] lemma bit1_le_bit1 : bit1 a ≤ bit1 b ↔ a ≤ b := bit1_strict_mono.le_iff_le
+@[simp] lemma bit1_inj : bit1 a = bit1 b ↔ a = b := bit1_injective.eq_iff
+@[simp] lemma bit1_ne_zero : bit1 a ≠ 0 := by simp [bit1]
+@[simp] lemma bit1_top : bit1 ∞ = ∞ := by rw [bit1, bit0_top, top_add]
+@[simp] lemma bit1_eq_top_iff : bit1 a = ∞ ↔ a = ∞ := bit1_injective.eq_iff' bit1_top
+@[simp] lemma bit1_eq_one_iff : bit1 a = 1 ↔ a = 0 := bit1_injective.eq_iff' bit1_zero
 
 end bit
 
@@ -947,43 +1009,63 @@ instance : div_inv_monoid ℝ≥0∞ :=
 { inv := has_inv.inv,
   .. (infer_instance : monoid ℝ≥0∞) }
 
+protected lemma div_eq_inv_mul : a / b = b⁻¹ * a := by rw [div_eq_mul_inv, mul_comm]
+
 @[simp] lemma inv_zero : (0 : ℝ≥0∞)⁻¹ = ∞ :=
 show Inf {b : ℝ≥0∞ | 1 ≤ 0 * b} = ∞, by simp; refl
 
 @[simp] lemma inv_top : ∞⁻¹ = 0 :=
 bot_unique $ le_of_forall_le_of_dense $ λ a (h : a > 0), Inf_le $ by simp [*, ne_of_gt h, top_mul]
 
-@[simp, norm_cast] lemma coe_inv (hr : r ≠ 0) : (↑r⁻¹ : ℝ≥0∞) = (↑r)⁻¹ :=
-le_antisymm
-  (le_Inf $ assume b (hb : 1 ≤ ↑r * b), coe_le_iff.2 $
-    by rintros b rfl; rwa [← coe_mul, ← coe_one, coe_le_coe, ← nnreal.inv_le hr] at hb)
-  (Inf_le $ by simp; rw [← coe_mul, mul_inv_cancel hr]; exact le_refl 1)
-
 lemma coe_inv_le : (↑r⁻¹ : ℝ≥0∞) ≤ (↑r)⁻¹ :=
-if hr : r = 0 then by simp only [hr, inv_zero, coe_zero, le_top]
-else by simp only [coe_inv hr, le_refl]
+le_Inf $ assume b (hb : 1 ≤ ↑r * b), coe_le_iff.2 $
+  by { rintro b rfl, apply nnreal.inv_le_of_le_mul, rwa [← coe_mul, ← coe_one, coe_le_coe] at hb }
+
+@[simp, norm_cast] lemma coe_inv (hr : r ≠ 0) : (↑r⁻¹ : ℝ≥0∞) = (↑r)⁻¹ :=
+coe_inv_le.antisymm $ Inf_le $ le_of_eq $ by rw [← coe_mul, mul_inv_cancel hr, coe_one]
 
-@[norm_cast] lemma coe_inv_two : ((2⁻¹:ℝ≥0):ℝ≥0∞) = 2⁻¹ :=
-by rw [coe_inv (ne_of_gt _root_.zero_lt_two), coe_two]
+@[norm_cast] lemma coe_inv_two : ((2⁻¹ : ℝ≥0) : ℝ≥0∞) = 2⁻¹ :=
+by rw [coe_inv _root_.two_ne_zero, coe_two]
 
 @[simp, norm_cast] lemma coe_div (hr : r ≠ 0) : (↑(p / r) : ℝ≥0∞) = p / r :=
 by rw [div_eq_mul_inv, div_eq_mul_inv, coe_mul, coe_inv hr]
 
 lemma div_zero (h : a ≠ 0) : a / 0 = ∞ := by simp [div_eq_mul_inv, h]
 
-@[simp] lemma inv_one : (1:ℝ≥0∞)⁻¹ = 1 :=
-by simpa only [coe_inv one_ne_zero, coe_one] using coe_eq_coe.2 inv_one
-
-@[simp] lemma div_one {a : ℝ≥0∞} : a / 1 = a :=
-by rw [div_eq_mul_inv, inv_one, mul_one]
+instance : div_inv_one_monoid ℝ≥0∞ :=
+{ inv_one := by simpa only [coe_inv one_ne_zero, coe_one] using coe_eq_coe.2 inv_one,
+  ..ennreal.div_inv_monoid }
 
 protected lemma inv_pow {n : ℕ} : (a^n)⁻¹ = (a⁻¹)^n :=
 begin
-  by_cases a = 0; cases a; cases n; simp [*, none_eq_top, some_eq_coe,
-    zero_pow, top_pow, nat.zero_lt_succ] at *,
-  rw [← coe_inv h, ← coe_pow, ← coe_inv (pow_ne_zero _ h), ← inv_pow₀, coe_pow]
+  cases n, { simp only [pow_zero, inv_one] },
+  induction a using with_top.rec_top_coe, { simp [top_pow n.succ_pos] },
+  rcases eq_or_ne a 0 with rfl|ha, { simp [top_pow, zero_pow, n.succ_pos] },
+  rw [← coe_inv ha, ← coe_pow, ← coe_inv (pow_ne_zero _ ha), ← inv_pow, coe_pow]
+end
+
+protected lemma mul_inv_cancel (h0 : a ≠ 0) (ht : a ≠ ∞) : a * a⁻¹ = 1 :=
+begin
+  lift a to ℝ≥0 using ht,
+  norm_cast at *,
+  exact mul_inv_cancel h0
 end
 
+protected lemma inv_mul_cancel (h0 : a ≠ 0) (ht : a ≠ ∞) : a⁻¹ * a = 1 :=
+mul_comm a a⁻¹ ▸ ennreal.mul_inv_cancel h0 ht
+
+protected lemma div_mul_cancel (h0 : a ≠ 0) (hI : a ≠ ∞) : (b / a) * a = b :=
+by rw [div_eq_mul_inv, mul_assoc, ennreal.inv_mul_cancel h0 hI, mul_one]
+
+protected lemma mul_div_cancel' (h0 : a ≠ 0) (hI : a ≠ ∞) : a * (b / a) = b :=
+by rw [mul_comm, ennreal.div_mul_cancel h0 hI]
+
+protected lemma mul_comm_div : a / b * c = a * (c / b) :=
+by simp only [div_eq_mul_inv, mul_comm, mul_assoc]
+
+protected lemma mul_div_right_comm : a * b / c = a / c * b :=
+by simp only [div_eq_mul_inv, mul_comm, mul_assoc]
+
 instance : has_involutive_inv ℝ≥0∞ :=
 { inv := has_inv.inv,
   inv_inv := λ a, by
@@ -1000,18 +1082,23 @@ by { simp only [lt_top_iff_ne_top, inv_ne_top, pos_iff_ne_zero] }
 lemma div_lt_top {x y : ℝ≥0∞} (h1 : x ≠ ∞) (h2 : y ≠ 0) : x / y < ∞ :=
 mul_lt_top h1 (inv_ne_top.mpr h2)
 
-@[simp] lemma inv_eq_zero : a⁻¹ = 0 ↔ a = ∞ :=
+@[simp] protected lemma inv_eq_zero : a⁻¹ = 0 ↔ a = ∞ :=
 inv_top ▸ inv_inj
 
-lemma inv_ne_zero : a⁻¹ ≠ 0 ↔ a ≠ ∞ := by simp
+protected lemma inv_ne_zero : a⁻¹ ≠ 0 ↔ a ≠ ∞ := by simp
+
+protected lemma div_pos (ha : a ≠ 0) (hb : b ≠ ∞) : 0 < a / b :=
+ennreal.mul_pos ha $ ennreal.inv_ne_zero.2 hb
 
-lemma mul_inv {a b : ℝ≥0∞} (ha : a ≠ 0 ∨ b ≠ ∞) (hb : a ≠ ∞ ∨ b ≠ 0) :
+protected lemma mul_inv {a b : ℝ≥0∞} (ha : a ≠ 0 ∨ b ≠ ∞) (hb : a ≠ ∞ ∨ b ≠ 0) :
   (a * b)⁻¹ = a⁻¹ * b⁻¹ :=
 begin
   induction b using with_top.rec_top_coe,
-  { simp at ha, simp [ha], },
+  { replace ha : a ≠ 0 := ha.neg_resolve_right rfl,
+    simp [ha], },
   induction a using with_top.rec_top_coe,
-  { simp at hb, simp [hb] },
+  { replace hb : b ≠ 0 := coe_ne_zero.1 (hb.neg_resolve_left rfl),
+    simp [hb] },
   by_cases h'a : a = 0,
   { simp only [h'a, with_top.top_mul, ennreal.inv_zero, ennreal.coe_ne_top, zero_mul, ne.def,
                not_false_iff, ennreal.coe_zero, ennreal.inv_eq_zero] },
@@ -1019,69 +1106,67 @@ begin
   { simp only [h'b, ennreal.inv_zero, ennreal.coe_ne_top, with_top.mul_top, ne.def, not_false_iff,
                mul_zero, ennreal.coe_zero, ennreal.inv_eq_zero] },
   rw [← ennreal.coe_mul, ← ennreal.coe_inv, ← ennreal.coe_inv h'a, ← ennreal.coe_inv h'b,
-      ← ennreal.coe_mul, nnreal.mul_inv, mul_comm],
+      ← ennreal.coe_mul, mul_inv_rev, mul_comm],
   simp [h'a, h'b],
 end
 
-@[simp] lemma inv_pos : 0 < a⁻¹ ↔ a ≠ ∞ :=
-pos_iff_ne_zero.trans inv_ne_zero
+protected lemma mul_div_mul_left (a b : ℝ≥0∞) (hc : c ≠ 0) (hc' : c ≠ ⊤) :
+  c * a / (c * b) = a / b :=
+by rw [div_eq_mul_inv, div_eq_mul_inv, ennreal.mul_inv (or.inl hc) (or.inl hc'), mul_mul_mul_comm,
+  ennreal.mul_inv_cancel hc hc', one_mul]
+
+protected lemma mul_div_mul_right (a b : ℝ≥0∞) (hc : c ≠ 0) (hc' : c ≠ ⊤) :
+  a * c / (b * c) = a / b :=
+by rw [div_eq_mul_inv, div_eq_mul_inv, ennreal.mul_inv (or.inr hc') (or.inr hc), mul_mul_mul_comm,
+  ennreal.mul_inv_cancel hc hc', mul_one]
 
-@[simp] lemma inv_lt_inv : a⁻¹ < b⁻¹ ↔ b < a :=
+protected lemma sub_div (h : 0 < b → b < a → c ≠ 0) : (a - b) / c = a / c - b / c :=
+by { simp_rw div_eq_mul_inv, exact ennreal.sub_mul (by simpa using h) }
+
+@[simp] protected lemma inv_pos : 0 < a⁻¹ ↔ a ≠ ∞ := pos_iff_ne_zero.trans ennreal.inv_ne_zero
+
+lemma inv_strict_anti : strict_anti (has_inv.inv : ℝ≥0∞ → ℝ≥0∞) :=
 begin
-  cases a; cases b; simp only [some_eq_coe, none_eq_top, inv_top],
-  { simp only [lt_irrefl] },
-  { exact inv_pos.trans lt_top_iff_ne_top.symm },
-  { simp only [not_lt_zero, not_top_lt] },
-  { cases eq_or_lt_of_le (zero_le a) with ha ha,
-    { subst a, simp },
-    cases eq_or_lt_of_le (zero_le b) with hb hb,
-    { subst b, simp [pos_iff_ne_zero, lt_top_iff_ne_top, inv_ne_top] },
-    { rw [← coe_inv (ne_of_gt ha), ← coe_inv (ne_of_gt hb), coe_lt_coe, coe_lt_coe],
-      simp only [nnreal.coe_lt_coe.symm] at *,
-      exact inv_lt_inv ha hb } }
+  intros a b h,
+  lift a to ℝ≥0 using h.ne_top,
+  induction b using with_top.rec_top_coe, { simp },
+  rw [coe_lt_coe] at h,
+  rcases eq_or_ne a 0 with rfl|ha, { simp [h] },
+  rw [← coe_inv h.ne_bot, ← coe_inv ha, coe_lt_coe],
+  exact nnreal.inv_lt_inv ha h
 end
 
+@[simp] protected lemma inv_lt_inv : a⁻¹ < b⁻¹ ↔ b < a := inv_strict_anti.lt_iff_lt
+
 lemma inv_lt_iff_inv_lt : a⁻¹ < b ↔ b⁻¹ < a :=
-by simpa only [inv_inv] using @inv_lt_inv a b⁻¹
+by simpa only [inv_inv] using @ennreal.inv_lt_inv a b⁻¹
 
 lemma lt_inv_iff_lt_inv : a < b⁻¹ ↔ b < a⁻¹ :=
-by simpa only [inv_inv] using @inv_lt_inv a⁻¹ b
+by simpa only [inv_inv] using @ennreal.inv_lt_inv a⁻¹ b
 
 @[simp, priority 1100] -- higher than le_inv_iff_mul_le
-lemma inv_le_inv : a⁻¹ ≤ b⁻¹ ↔ b ≤ a :=
-by simp only [le_iff_lt_or_eq, inv_lt_inv, inv_inj, eq_comm]
+protected lemma inv_le_inv : a⁻¹ ≤ b⁻¹ ↔ b ≤ a := inv_strict_anti.le_iff_le
 
 lemma inv_le_iff_inv_le : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
-by simpa only [inv_inv] using @inv_le_inv a b⁻¹
+by simpa only [inv_inv] using @ennreal.inv_le_inv a b⁻¹
 
 lemma le_inv_iff_le_inv : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
-by simpa only [inv_inv] using @inv_le_inv a⁻¹ b
+by simpa only [inv_inv] using @ennreal.inv_le_inv a⁻¹ b
 
-@[simp] lemma inv_le_one : a⁻¹ ≤ 1 ↔ 1 ≤ a :=
-inv_le_iff_inv_le.trans $ by rw inv_one
-
-lemma one_le_inv : 1 ≤ a⁻¹ ↔ a ≤ 1 :=
-le_inv_iff_le_inv.trans $ by rw inv_one
-
-@[simp] lemma inv_lt_one : a⁻¹ < 1 ↔ 1 < a :=
-inv_lt_iff_inv_lt.trans $ by rw [inv_one]
+@[simp] protected lemma inv_le_one : a⁻¹ ≤ 1 ↔ 1 ≤ a := by rw [inv_le_iff_inv_le, inv_one]
+protected lemma one_le_inv : 1 ≤ a⁻¹ ↔ a ≤ 1 := by rw [le_inv_iff_le_inv, inv_one]
+@[simp] protected lemma inv_lt_one : a⁻¹ < 1 ↔ 1 < a := by rw [inv_lt_iff_inv_lt, inv_one]
+@[simp] protected lemma one_lt_inv : 1 < a⁻¹ ↔ a < 1 := by rw [lt_inv_iff_lt_inv, inv_one]
 
 /-- The inverse map `λ x, x⁻¹` is an order isomorphism between `ℝ≥0∞` and its `order_dual` -/
 @[simps apply]
 def _root_.order_iso.inv_ennreal : ℝ≥0∞ ≃o ℝ≥0∞ᵒᵈ :=
-{ to_fun := λ x, x⁻¹,
-  inv_fun := λ x, x⁻¹,
-  map_rel_iff' := λ a b, ennreal.inv_le_inv,
-  ..equiv.inv ℝ≥0∞ }
+{ map_rel_iff' := λ a b, ennreal.inv_le_inv,
+  to_equiv := (equiv.inv ℝ≥0∞).trans order_dual.to_dual }
 
 @[simp]
-lemma _root_.order_iso.inv_ennreal_symm_apply : order_iso.inv_ennreal.symm a = a⁻¹ := rfl
-
-lemma pow_le_pow_of_le_one {n m : ℕ} (ha : a ≤ 1) (h : n ≤ m) : a ^ m ≤ a ^ n :=
-begin
-  rw [←inv_inv a, ← ennreal.inv_pow, ← @ennreal.inv_pow a⁻¹, inv_le_inv],
-  exact pow_le_pow (one_le_inv.2 ha) h
-end
+lemma _root_.order_iso.inv_ennreal_symm_apply :
+  order_iso.inv_ennreal.symm a = (order_dual.of_dual a)⁻¹ := rfl
 
 @[simp] lemma div_top : a / ∞ = 0 := by rw [div_eq_mul_inv, inv_top, mul_zero]
 
@@ -1096,50 +1181,42 @@ top_div_of_ne_top h.ne
 lemma top_div : ∞ / a = if a = ∞ then 0 else ∞ :=
 by by_cases a = ∞; simp [top_div_of_ne_top, *]
 
-@[simp] lemma zero_div : 0 / a = 0 := zero_mul a⁻¹
+@[simp] protected lemma zero_div : 0 / a = 0 := zero_mul a⁻¹
 
 lemma div_eq_top : a / b = ∞ ↔ (a ≠ 0 ∧ b = 0) ∨ (a = ∞ ∧ b ≠ ∞) :=
 by simp [div_eq_mul_inv, ennreal.mul_eq_top]
 
-lemma le_div_iff_mul_le (h0 : b ≠ 0 ∨ c ≠ 0) (ht : b ≠ ∞ ∨ c ≠ ∞) :
+protected lemma le_div_iff_mul_le (h0 : b ≠ 0 ∨ c ≠ 0) (ht : b ≠ ∞ ∨ c ≠ ∞) :
   a ≤ c / b ↔ a * b ≤ c :=
 begin
-  cases b,
-  { simp at ht,
-    split,
-    { assume ha, simp at ha, simp [ha] },
-    { contrapose,
-      assume ha,
-      simp at ha,
-      have : a * ∞ = ∞, by simp [ennreal.mul_eq_top, ha],
-      simp [this, ht] } },
-  by_cases hb : b ≠ 0,
-  { have : (b : ℝ≥0∞) ≠ 0, by simp [hb],
-    rw [← ennreal.mul_le_mul_left this coe_ne_top],
-    suffices : ↑b * a ≤ (↑b * ↑b⁻¹) * c ↔ a * ↑b ≤ c,
-    { simpa [some_eq_coe, div_eq_mul_inv, hb, mul_left_comm, mul_comm, mul_assoc] },
-    rw [← coe_mul, mul_inv_cancel hb, coe_one, one_mul, mul_comm] },
-  { simp at hb,
-    simp [hb] at h0,
-    have : c / 0 = ∞, by simp [div_eq_top, h0],
-    simp [hb, this] }
-end
-
-lemma div_le_iff_le_mul (hb0 : b ≠ 0 ∨ c ≠ ∞) (hbt : b ≠ ∞ ∨ c ≠ 0) : a / b ≤ c ↔ a ≤ c * b :=
+  induction b using with_top.rec_top_coe,
+  { lift c to ℝ≥0 using ht.neg_resolve_left rfl,
+    rw [div_top, nonpos_iff_eq_zero, mul_top],
+    rcases eq_or_ne a 0 with rfl|ha; simp * },
+  rcases eq_or_ne b 0 with (rfl | hb),
+  { have hc : c ≠ 0, from h0.neg_resolve_left rfl,
+    simp [div_zero hc] },
+  { rw [← coe_ne_zero] at hb,
+    rw [← ennreal.mul_le_mul_right hb coe_ne_top, ennreal.div_mul_cancel hb coe_ne_top] },
+end
+
+protected lemma div_le_iff_le_mul (hb0 : b ≠ 0 ∨ c ≠ ∞) (hbt : b ≠ ∞ ∨ c ≠ 0) :
+  a / b ≤ c ↔ a ≤ c * b :=
 begin
   suffices : a * b⁻¹ ≤ c ↔ a ≤ c / b⁻¹, by simpa [div_eq_mul_inv],
-  refine (le_div_iff_mul_le _ _).symm; simpa
+  refine (ennreal.le_div_iff_mul_le _ _).symm; simpa
 end
 
-lemma lt_div_iff_mul_lt (hb0 : b ≠ 0 ∨ c ≠ ∞) (hbt : b ≠ ∞ ∨ c ≠ 0) : c < a / b ↔ c * b < a :=
-lt_iff_lt_of_le_iff_le (div_le_iff_le_mul hb0 hbt)
+protected lemma lt_div_iff_mul_lt (hb0 : b ≠ 0 ∨ c ≠ ∞) (hbt : b ≠ ∞ ∨ c ≠ 0) :
+  c < a / b ↔ c * b < a :=
+lt_iff_lt_of_le_iff_le (ennreal.div_le_iff_le_mul hb0 hbt)
 
 lemma div_le_of_le_mul (h : a ≤ b * c) : a / c ≤ b :=
 begin
   by_cases h0 : c = 0,
   { have : a = 0, by simpa [h0] using h, simp [*] },
   by_cases hinf : c = ∞, by simp [hinf],
-  exact (div_le_iff_le_mul (or.inl h0) (or.inl hinf)).2 h
+  exact (ennreal.div_le_iff_le_mul (or.inl h0) (or.inl hinf)).2 h
 end
 
 lemma div_le_of_le_mul' (h : a ≤ b * c) : a / b ≤ c :=
@@ -1147,11 +1224,8 @@ div_le_of_le_mul $ mul_comm b c ▸ h
 
 lemma mul_le_of_le_div (h : a ≤ b / c) : a * c ≤ b :=
 begin
-  rcases _root_.em (c = 0 ∧ b = 0 ∨ c = ∞ ∧ b = ∞) with (⟨rfl, rfl⟩|⟨rfl, rfl⟩)|H,
-  { rw [mul_zero], exact le_rfl },
-  { exact le_top },
-  { simp only [not_or_distrib, not_and_distrib] at H,
-    rwa ← le_div_iff_mul_le H.1 H.2 }
+  rw [← inv_inv c],
+  exact div_le_of_le_mul h,
 end
 
 lemma mul_le_of_le_div' (h : a ≤ b / c) : c * a ≤ b :=
@@ -1159,50 +1233,48 @@ mul_comm a c ▸ mul_le_of_le_div h
 
 protected lemma div_lt_iff (h0 : b ≠ 0 ∨ c ≠ 0) (ht : b ≠ ∞ ∨ c ≠ ∞) :
   c / b < a ↔ c < a * b :=
-lt_iff_lt_of_le_iff_le $ le_div_iff_mul_le h0 ht
+lt_iff_lt_of_le_iff_le $ ennreal.le_div_iff_mul_le h0 ht
 
 lemma mul_lt_of_lt_div (h : a < b / c) : a * c < b :=
 by { contrapose! h, exact ennreal.div_le_of_le_mul h }
 
 lemma mul_lt_of_lt_div' (h : a < b / c) : c * a < b := mul_comm a c ▸ mul_lt_of_lt_div h
 
-lemma inv_le_iff_le_mul : (b = ∞ → a ≠ 0) → (a = ∞ → b ≠ 0) → (a⁻¹ ≤ b ↔ 1 ≤ a * b) :=
+lemma inv_le_iff_le_mul (h₁ : b = ∞ → a ≠ 0) (h₂ : a = ∞ → b ≠ 0) : a⁻¹ ≤ b ↔ 1 ≤ a * b :=
 begin
-  cases a; cases b; simp [none_eq_top, some_eq_coe, mul_top, top_mul] {contextual := tt},
-  by_cases a = 0; simp [*, -coe_mul, coe_mul.symm, -coe_inv, (coe_inv _).symm, nnreal.inv_le]
+  rw [← one_div, ennreal.div_le_iff_le_mul, mul_comm],
+  exacts [or_not_of_imp h₁, not_or_of_imp h₂]
 end
 
 @[simp] lemma le_inv_iff_mul_le : a ≤ b⁻¹ ↔ a * b ≤ 1 :=
-begin
-  cases b, { by_cases a = 0; simp [*, none_eq_top, mul_top] },
-  by_cases b = 0; simp [*, some_eq_coe, le_div_iff_mul_le],
-  suffices : a ≤ 1 / b ↔ a * b ≤ 1, { simpa [div_eq_mul_inv, h] },
-  exact le_div_iff_mul_le (or.inl (mt coe_eq_coe.1 h)) (or.inl coe_ne_top)
-end
+by rw [← one_div, ennreal.le_div_iff_mul_le]; { right, simp }
 
-lemma div_le_div {a b c d : ℝ≥0∞} (hab : a ≤ b) (hdc : d ≤ c) : a / c ≤ b / d :=
-div_eq_mul_inv b d ▸ div_eq_mul_inv a c ▸ ennreal.mul_le_mul hab (ennreal.inv_le_inv.mpr hdc)
+protected lemma div_le_div (hab : a ≤ b) (hdc : d ≤ c) : a / c ≤ b / d :=
+div_eq_mul_inv b d ▸ div_eq_mul_inv a c ▸ mul_le_mul' hab (ennreal.inv_le_inv.mpr hdc)
 
-lemma mul_inv_cancel (h0 : a ≠ 0) (ht : a ≠ ∞) : a * a⁻¹ = 1 :=
-begin
-  lift a to ℝ≥0 using ht,
-  norm_cast at *,
-  exact mul_inv_cancel h0
-end
+protected lemma div_le_div_left (h : a ≤ b) (c : ℝ≥0∞) : c / b ≤ c / a :=
+ennreal.div_le_div le_rfl h
 
-lemma inv_mul_cancel (h0 : a ≠ 0) (ht : a ≠ ∞) : a⁻¹ * a = 1 :=
-mul_comm a a⁻¹ ▸ mul_inv_cancel h0 ht
+protected lemma div_le_div_right (h : a ≤ b) (c : ℝ≥0∞) : a / c ≤ b / c :=
+ennreal.div_le_div h le_rfl
 
-lemma eq_inv_of_mul_eq_one (h : a * b = 1) : a = b⁻¹ :=
+protected lemma eq_inv_of_mul_eq_one_left (h : a * b = 1) : a = b⁻¹ :=
 begin
-  rcases eq_or_ne b ∞ with rfl|hb,
-  { have : false, by simpa [left_ne_zero_of_mul_eq_one h] using h,
-    exact this.elim },
-  { rw [← mul_one a, ← mul_inv_cancel (right_ne_zero_of_mul_eq_one h) hb, ← mul_assoc, h, one_mul] }
+  rw [←mul_one a, ←ennreal.mul_inv_cancel (right_ne_zero_of_mul_eq_one h), ←mul_assoc, h, one_mul],
+  rintro rfl,
+  simpa [left_ne_zero_of_mul_eq_one h] using h,
 end
 
-lemma mul_le_iff_le_inv {a b r : ℝ≥0∞} (hr₀ : r ≠ 0) (hr₁ : r ≠ ∞) : (r * a ≤ b ↔ a ≤ r⁻¹ * b) :=
-by rw [← @ennreal.mul_le_mul_left _ a _ hr₀ hr₁, ← mul_assoc, mul_inv_cancel hr₀ hr₁, one_mul]
+lemma mul_le_iff_le_inv {a b r : ℝ≥0∞} (hr₀ : r ≠ 0) (hr₁ : r ≠ ∞) : r * a ≤ b ↔ a ≤ r⁻¹ * b :=
+by rw [←@ennreal.mul_le_mul_left _ a _ hr₀ hr₁, ←mul_assoc, ennreal.mul_inv_cancel hr₀ hr₁, one_mul]
+
+/-- A variant of `le_inv_smul_iff` that holds for `ennreal`. -/
+protected lemma le_inv_smul_iff {a b : ℝ≥0∞} {r : ℝ≥0} (hr₀ : r ≠ 0) : a ≤ r⁻¹ • b ↔ r • a ≤ b :=
+by simpa [hr₀, ennreal.smul_def] using (mul_le_iff_le_inv (coe_ne_zero.mpr hr₀) coe_ne_top).symm
+
+/-- A variant of `inv_smul_le_iff` that holds for `ennreal`. -/
+protected lemma inv_smul_le_iff {a b : ℝ≥0∞} {r : ℝ≥0} (hr₀ : r ≠ 0) : r⁻¹ • a ≤ b ↔ a ≤ r • b :=
+by simpa only [inv_inv] using (ennreal.le_inv_smul_iff (inv_ne_zero hr₀)).symm
 
 lemma le_of_forall_nnreal_lt {x y : ℝ≥0∞} (h : ∀ r : ℝ≥0, ↑r < x → ↑r ≤ y) : x ≤ y :=
 begin
@@ -1217,38 +1289,44 @@ le_of_forall_nnreal_lt $ λ r hr, (zero_le r).eq_or_lt.elim (λ h, h ▸ zero_le
 lemma eq_top_of_forall_nnreal_le {x : ℝ≥0∞} (h : ∀ r : ℝ≥0, ↑r ≤ x) : x = ∞ :=
 top_unique $ le_of_forall_nnreal_lt $ λ r hr, h r
 
-lemma add_div : (a + b) / c = a / c + b / c := right_distrib a b (c⁻¹)
+protected lemma add_div : (a + b) / c = a / c + b / c := right_distrib a b (c⁻¹)
 
-lemma div_add_div_same {a b c : ℝ≥0∞} : a / c + b / c = (a + b) / c :=
-eq.symm $ right_distrib a b (c⁻¹)
+protected lemma div_add_div_same {a b c : ℝ≥0∞} : a / c + b / c = (a + b) / c :=
+ennreal.add_div.symm
 
-lemma div_self (h0 : a ≠ 0) (hI : a ≠ ∞) : a / a = 1 :=
-mul_inv_cancel h0 hI
+protected lemma div_self (h0 : a ≠ 0) (hI : a ≠ ∞) : a / a = 1 :=
+ennreal.mul_inv_cancel h0 hI
 
-lemma mul_div_cancel (h0 : a ≠ 0) (hI : a ≠ ∞) : (b / a) * a = b :=
-by rw [div_eq_mul_inv, mul_assoc, inv_mul_cancel h0 hI, mul_one]
+lemma mul_div_le : a * (b / a) ≤ b := mul_le_of_le_div' le_rfl
 
-lemma mul_div_cancel' (h0 : a ≠ 0) (hI : a ≠ ∞) : a * (b / a) = b :=
-by rw [mul_comm, mul_div_cancel h0 hI]
+-- TODO: add this lemma for an `is_unit` in any `division_monoid`
+lemma eq_div_iff (ha : a ≠ 0) (ha' : a ≠ ∞) :
+  b = c / a ↔ a * b = c :=
+⟨λ h, by rw [h, ennreal.mul_div_cancel' ha ha'],
+ λ h, by rw [← h, mul_div_assoc, ennreal.mul_div_cancel' ha ha']⟩
 
-lemma mul_div_le : a * (b / a) ≤ b :=
+protected lemma div_eq_div_iff (ha : a ≠ 0) (ha' : a ≠ ∞) (hb : b ≠ 0) (hb' : b ≠ ∞) :
+  c / b = d / a ↔ a * c = b * d :=
 begin
-  by_cases h0 : a = 0, { simp [h0] },
-  by_cases hI : a = ∞, { simp [hI] },
-  rw mul_div_cancel' h0 hI, exact le_refl b
+  rw eq_div_iff ha ha',
+  conv_rhs { rw eq_comm },
+  rw [← eq_div_iff hb hb', mul_div_assoc, eq_comm],
 end
 
+lemma div_eq_one_iff {a b : ℝ≥0∞} (hb₀ : b ≠ 0) (hb₁ : b ≠ ∞) : a / b = 1 ↔ a = b :=
+⟨λ h, by rw [← (eq_div_iff hb₀ hb₁).mp h.symm, mul_one], λ h, h.symm ▸ ennreal.div_self hb₀ hb₁⟩
+
 lemma inv_two_add_inv_two : (2:ℝ≥0∞)⁻¹ + 2⁻¹ = 1 :=
-by rw [← two_mul, ← div_eq_mul_inv, div_self two_ne_zero two_ne_top]
+by rw [← two_mul, ← div_eq_mul_inv, ennreal.div_self two_ne_zero two_ne_top]
 
-lemma inv_three_add_inv_three : (3 : ℝ≥0∞)⁻¹ + 3⁻¹ +3⁻¹ = 1 :=
+lemma inv_three_add_inv_three : (3 : ℝ≥0∞)⁻¹ + 3⁻¹ + 3⁻¹ = 1 :=
 begin
   rw [show (3 : ℝ≥0∞)⁻¹ + 3⁻¹ + 3⁻¹ = 3 * 3⁻¹, by ring, ← div_eq_mul_inv, ennreal.div_self];
   simp,
 end
 
 @[simp]
-lemma add_halves (a : ℝ≥0∞) : a / 2 + a / 2 = a :=
+protected lemma add_halves (a : ℝ≥0∞) : a / 2 + a / 2 = a :=
 by rw [div_eq_mul_inv, ← mul_add, inv_two_add_inv_two, mul_one]
 
 @[simp]
@@ -1261,43 +1339,77 @@ by simp [div_eq_mul_inv]
 @[simp] lemma div_pos_iff : 0 < a / b ↔ a ≠ 0 ∧ b ≠ ∞ :=
 by simp [pos_iff_ne_zero, not_or_distrib]
 
-lemma half_pos {a : ℝ≥0∞} (h : a ≠ 0) : 0 < a / 2 :=
-by simp [h]
+protected lemma half_pos (h : a ≠ 0) : 0 < a / 2 := by simp [h]
 
-lemma one_half_lt_one : (2⁻¹:ℝ≥0∞) < 1 := inv_lt_one.2 $ one_lt_two
+protected lemma one_half_lt_one : (2⁻¹ : ℝ≥0∞) < 1 := ennreal.inv_lt_one.2 $ one_lt_two
 
-lemma half_lt_self {a : ℝ≥0∞} (hz : a ≠ 0) (ht : a ≠ ∞) : a / 2 < a :=
+protected lemma half_lt_self (hz : a ≠ 0) (ht : a ≠ ∞) : a / 2 < a :=
 begin
   lift a to ℝ≥0 using ht,
-  have h : (2 : ℝ≥0∞) = ((2 : ℝ≥0) : ℝ≥0∞), from rfl,
-  have h' : (2 : ℝ≥0) ≠ 0, from _root_.two_ne_zero',
-  rw [h, ← coe_div h', coe_lt_coe], -- `norm_cast` fails to apply `coe_div`
-  norm_cast at hz,
-  exact nnreal.half_lt_self hz
+  rw coe_ne_zero at hz,
+  rw [← coe_two, ← coe_div, coe_lt_coe],
+  exacts [nnreal.half_lt_self hz, two_ne_zero' _]
 end
 
-lemma half_le_self : a / 2 ≤ a := le_add_self.trans_eq (add_halves _)
+protected lemma half_le_self : a / 2 ≤ a := le_add_self.trans_eq $ ennreal.add_halves _
 
 lemma sub_half (h : a ≠ ∞) : a - a / 2 = a / 2 :=
 begin
   lift a to ℝ≥0 using h,
-  exact sub_eq_of_add_eq (mul_ne_top coe_ne_top $ by simp) (add_halves a)
+  exact sub_eq_of_add_eq (mul_ne_top coe_ne_top $ by simp) (ennreal.add_halves a)
 end
 
 @[simp] lemma one_sub_inv_two : (1:ℝ≥0∞) - 2⁻¹ = 2⁻¹ :=
 by simpa only [div_eq_mul_inv, one_mul] using sub_half one_ne_top
 
+/-- The birational order isomorphism between `ℝ≥0∞` and the unit interval `set.Iic (1 : ℝ≥0∞)`. -/
+@[simps apply_coe] def order_iso_Iic_one_birational : ℝ≥0∞ ≃o Iic (1 : ℝ≥0∞) :=
+begin
+  refine strict_mono.order_iso_of_right_inverse
+    (λ x, ⟨(x⁻¹ + 1)⁻¹, ennreal.inv_le_one.2 $ le_add_self⟩) (λ x y hxy, _) (λ x, (x⁻¹ - 1)⁻¹)
+    (λ x, subtype.ext _),
+  { simpa only [subtype.mk_lt_mk, ennreal.inv_lt_inv, ennreal.add_lt_add_iff_right one_ne_top] },
+  { have : (1 : ℝ≥0∞) ≤ x⁻¹, from ennreal.one_le_inv.2 x.2,
+    simp only [inv_inv, subtype.coe_mk, tsub_add_cancel_of_le this] }
+end
+
+@[simp] lemma order_iso_Iic_one_birational_symm_apply (x : Iic (1 : ℝ≥0∞)) :
+  order_iso_Iic_one_birational.symm x = (x⁻¹ - 1)⁻¹ :=
+rfl
+
+/-- Order isomorphism between an initial interval in `ℝ≥0∞` and an initial interval in `ℝ≥0`. -/
+@[simps apply_coe] def order_iso_Iic_coe (a : ℝ≥0) : Iic (a : ℝ≥0∞) ≃o Iic a :=
+order_iso.symm
+{ to_fun := λ x, ⟨x, coe_le_coe.2 x.2⟩,
+  inv_fun := λ x, ⟨ennreal.to_nnreal x, coe_le_coe.1 $ coe_to_nnreal_le_self.trans x.2⟩,
+  left_inv := λ x, subtype.ext $ to_nnreal_coe,
+  right_inv := λ x, subtype.ext $ coe_to_nnreal (ne_top_of_le_ne_top coe_ne_top x.2),
+  map_rel_iff' := λ x y, by simp only [equiv.coe_fn_mk, subtype.mk_le_mk, coe_coe, coe_le_coe,
+    subtype.coe_le_coe] }
+
+@[simp] lemma order_iso_Iic_coe_symm_apply_coe (a : ℝ≥0) (b : Iic a) :
+  ((order_iso_Iic_coe a).symm b : ℝ≥0∞) = b := rfl
+
+/-- An order isomorphism between the extended nonnegative real numbers and the unit interval. -/
+def order_iso_unit_interval_birational : ℝ≥0∞ ≃o Icc (0 : ℝ) 1 :=
+order_iso_Iic_one_birational.trans $ (order_iso_Iic_coe 1).trans $
+  (nnreal.order_iso_Icc_zero_coe 1).symm
+
+@[simp] lemma order_iso_unit_interval_birational_apply_coe (x : ℝ≥0∞) :
+  (order_iso_unit_interval_birational x : ℝ) = (x⁻¹ + 1)⁻¹.to_real :=
+rfl
+
 lemma exists_inv_nat_lt {a : ℝ≥0∞} (h : a ≠ 0) :
   ∃n:ℕ, (n:ℝ≥0∞)⁻¹ < a :=
-inv_inv a ▸ by simp only [inv_lt_inv, ennreal.exists_nat_gt (inv_ne_top.2 h)]
+inv_inv a ▸ by simp only [ennreal.inv_lt_inv, ennreal.exists_nat_gt (inv_ne_top.2 h)]
 
 lemma exists_nat_pos_mul_gt (ha : a ≠ 0) (hb : b ≠ ∞) :
   ∃ n > 0, b < (n : ℕ) * a :=
 begin
   have : b / a ≠ ∞, from mul_ne_top hb (inv_ne_top.2 ha),
   refine (ennreal.exists_nat_gt this).imp (λ n hn, _),
-  have : 0 < (n : ℝ≥0∞), from (zero_le _).trans_lt hn,
-  refine ⟨coe_nat_lt_coe_nat.1 this, _⟩,
+  have : 0 < (n : ℝ≥0∞), from lt_of_le_of_lt (zero_le _) hn,
+  refine ⟨nat.cast_pos.1 this, _⟩,
   rwa [← ennreal.div_lt_iff (or.inl ha) (or.inr hb)]
 end
 
@@ -1311,8 +1423,8 @@ begin
   rcases exists_nat_pos_mul_gt hb ha with ⟨n, npos, hn⟩,
   have : (n : ℝ≥0∞) ≠ 0 := nat.cast_ne_zero.2 npos.lt.ne',
   use [n, npos],
-  rwa [← one_mul b, ← inv_mul_cancel this coe_nat_ne_top,
-    mul_assoc, mul_lt_mul_left (inv_ne_zero.2 coe_nat_ne_top) (inv_ne_top.2 this)]
+  rwa [← one_mul b, ← ennreal.inv_mul_cancel this (nat_ne_top n), mul_assoc,
+    mul_lt_mul_left (ennreal.inv_ne_zero.2 $ nat_ne_top _) (inv_ne_top.2 this)]
 end
 
 lemma exists_nnreal_pos_mul_lt (ha : a ≠ ∞) (hb : b ≠ 0) :
@@ -1327,8 +1439,8 @@ lemma exists_inv_two_pow_lt (ha : a ≠ 0) :
   ∃ n : ℕ, 2⁻¹ ^ n < a :=
 begin
   rcases exists_inv_nat_lt ha with ⟨n, hn⟩,
-  simp only [← ennreal.inv_pow],
-  refine ⟨n, lt_trans (inv_lt_inv.2 _) hn⟩,
+  refine ⟨n, lt_trans _ hn⟩,
+  rw [← ennreal.inv_pow, ennreal.inv_lt_inv],
   norm_cast,
   exact n.lt_two_pow
 end
@@ -1346,7 +1458,7 @@ begin
   cases n,
   { exact ennreal.pow_pos ha.bot_lt n },
   { simp only [h'a, pow_eq_top_iff, zpow_neg_succ_of_nat, ne.def, not_false_iff,
-               inv_pos, false_and] }
+               ennreal.inv_pos, false_and] }
 end
 
 lemma zpow_lt_top (ha : a ≠ 0) (h'a : a ≠ ∞) (n : ℤ) : a ^ n < ∞ :=
@@ -1362,7 +1474,7 @@ lemma exists_mem_Ico_zpow
 begin
   lift x to ℝ≥0 using h'x,
   lift y to ℝ≥0 using h'y,
-  have A : y ≠ 0, by simpa only [ne.def, coe_eq_zero] using (ennreal.zero_lt_one.trans hy).ne',
+  have A : y ≠ 0, { simpa only [ne.def, coe_eq_zero] using (zero_lt_one.trans hy).ne' },
   obtain ⟨n, hn, h'n⟩ : ∃ n : ℤ, y ^ n ≤ x ∧ x < y ^ (n + 1),
   { refine nnreal.exists_mem_Ico_zpow _ (one_lt_coe_iff.1 hy),
     simpa only [ne.def, coe_eq_zero] using hx },
@@ -1377,7 +1489,7 @@ lemma exists_mem_Ioc_zpow
 begin
   lift x to ℝ≥0 using h'x,
   lift y to ℝ≥0 using h'y,
-  have A : y ≠ 0, by simpa only [ne.def, coe_eq_zero] using (ennreal.zero_lt_one.trans hy).ne',
+  have A : y ≠ 0, { simpa only [ne.def, coe_eq_zero] using (zero_lt_one.trans hy).ne' },
   obtain ⟨n, hn, h'n⟩ : ∃ n : ℤ, y ^ n < x ∧ x ≤ y ^ (n + 1),
   { refine nnreal.exists_mem_Ioc_zpow _ (one_lt_coe_iff.1 hy),
     simpa only [ne.def, coe_eq_zero] using hx },
@@ -1397,36 +1509,31 @@ begin
   { rintros ⟨n, hn, h'n⟩,
     split,
     { apply lt_of_lt_of_le _ hn,
-      exact ennreal.zpow_pos (ennreal.zero_lt_one.trans hy).ne' h'y _ },
+      exact ennreal.zpow_pos (zero_lt_one.trans hy).ne' h'y _ },
     { apply lt_trans h'n _,
-      exact ennreal.zpow_lt_top (ennreal.zero_lt_one.trans hy).ne' h'y _ } }
+      exact ennreal.zpow_lt_top (zero_lt_one.trans hy).ne' h'y _ } }
 end
 
 lemma zpow_le_of_le {x : ℝ≥0∞} (hx : 1 ≤ x) {a b : ℤ} (h : a ≤ b) : x ^ a ≤ x ^ b :=
 begin
   induction a with a a; induction b with b b,
-  { simp,
-    apply pow_le_pow hx,
-    apply int.le_of_coe_nat_le_coe_nat h },
-  { apply absurd h,
-    apply not_le_of_gt,
+  { simp only [int.of_nat_eq_coe, zpow_coe_nat],
+    exact pow_le_pow hx (int.le_of_coe_nat_le_coe_nat h), },
+  { apply absurd h (not_le_of_gt _),
     exact lt_of_lt_of_le (int.neg_succ_lt_zero _) (int.of_nat_nonneg _) },
   { simp only [zpow_neg_succ_of_nat, int.of_nat_eq_coe, zpow_coe_nat],
-    refine le_trans (inv_le_one.2 _) _;
-    apply ennreal.one_le_pow_of_one_le hx, },
-  { simp only [zpow_neg_succ_of_nat],
-    apply inv_le_inv.2,
-    { apply pow_le_pow hx,
-      have : -(↑(a+1) : ℤ) ≤ -(↑(b+1) : ℤ), from h,
-      have h' := le_of_neg_le_neg this,
-      apply int.le_of_coe_nat_le_coe_nat h' },
-    repeat { apply pow_pos (lt_of_lt_of_le zero_lt_one hx) } }
+    refine (ennreal.inv_le_one.2 _).trans _;
+    exact one_le_pow_of_one_le' hx _, },
+  { simp only [zpow_neg_succ_of_nat, ennreal.inv_le_inv],
+    apply pow_le_pow hx,
+    simpa only [←int.coe_nat_le_coe_nat_iff, neg_le_neg_iff, int.coe_nat_add, int.coe_nat_one,
+      int.neg_succ_of_nat_eq] using h }
 end
 
 lemma monotone_zpow {x : ℝ≥0∞} (hx : 1 ≤ x) : monotone ((^) x : ℤ → ℝ≥0∞) :=
 λ a b h, zpow_le_of_le hx h
 
-lemma zpow_add {x : ℝ≥0∞} (hx : x ≠ 0) (h'x : x ≠ ∞) (m n : ℤ) :
+protected lemma zpow_add {x : ℝ≥0∞} (hx : x ≠ 0) (h'x : x ≠ ∞) (m n : ℤ) :
   x ^ (m + n) = x ^ m * x ^ n :=
 begin
   lift x to ℝ≥0 using h'x,
@@ -1456,9 +1563,9 @@ end
 lemma le_to_real_sub {a b : ℝ≥0∞} (hb : b ≠ ∞) : a.to_real - b.to_real ≤ (a - b).to_real :=
 begin
   lift b to ℝ≥0 using hb,
-  cases a,
+  induction a using with_top.rec_top_coe,
   { simp },
-  { simp only [some_eq_coe, ←coe_sub, nnreal.sub_def, real.coe_to_nnreal', coe_to_real],
+  { simp only [←coe_sub, nnreal.sub_def, real.coe_to_nnreal', coe_to_real],
     exact le_max_left _ _ }
 end
 
@@ -1500,24 +1607,14 @@ by simpa [←ennreal.coe_le_coe, hb, (h.trans_lt hb.lt_top).ne]
 
 @[simp] lemma to_nnreal_le_to_nnreal (ha : a ≠ ∞) (hb : b ≠ ∞) :
   a.to_nnreal ≤ b.to_nnreal ↔ a ≤ b :=
-begin
-  refine ⟨_, to_nnreal_mono hb⟩,
-  { intro h,
-    have key := ennreal.coe_le_coe.mpr h,
-    rwa [coe_to_nnreal ha, coe_to_nnreal hb] at key, },
-end
+⟨λ h, by rwa [←coe_to_nnreal ha, ←coe_to_nnreal hb, coe_le_coe], to_nnreal_mono hb⟩
 
 lemma to_nnreal_strict_mono (hb : b ≠ ∞) (h : a < b) : a.to_nnreal < b.to_nnreal :=
 by simpa [←ennreal.coe_lt_coe, hb, (h.trans hb.lt_top).ne]
 
 @[simp] lemma to_nnreal_lt_to_nnreal (ha : a ≠ ∞) (hb : b ≠ ∞) :
   a.to_nnreal < b.to_nnreal ↔ a < b :=
-begin
-  refine ⟨_, to_nnreal_strict_mono hb⟩,
-  { intro h,
-    have key := ennreal.coe_lt_coe.mpr h,
-    rwa [coe_to_nnreal ha, coe_to_nnreal hb] at key, },
-end
+⟨λ h, by rwa [←coe_to_nnreal ha, ←coe_to_nnreal hb, coe_lt_coe], to_nnreal_strict_mono hb⟩
 
 lemma to_real_max (hr : a ≠ ∞) (hp : b ≠ ∞) :
   ennreal.to_real (max a b) = max (ennreal.to_real a) (ennreal.to_real b) :=
@@ -1525,12 +1622,20 @@ lemma to_real_max (hr : a ≠ ∞) (hp : b ≠ ∞) :
   (λ h, by simp only [h, (ennreal.to_real_le_to_real hr hp).2 h, max_eq_right])
   (λ h, by simp only [h, (ennreal.to_real_le_to_real hp hr).2 h, max_eq_left])
 
+lemma to_real_min {a b : ℝ≥0∞} (hr : a ≠ ∞) (hp : b ≠ ∞) :
+  ennreal.to_real (min a b) = min (ennreal.to_real a) (ennreal.to_real b) :=
+(le_total a b).elim
+  (λ h, by simp only [h, (ennreal.to_real_le_to_real hr hp).2 h, min_eq_left])
+  (λ h, by simp only [h, (ennreal.to_real_le_to_real hp hr).2 h, min_eq_right])
+
+lemma to_real_sup {a b : ℝ≥0∞}
+  : a ≠ ∞ → b ≠ ∞ → (a ⊔ b).to_real = a.to_real ⊔ b.to_real := to_real_max
+
+lemma to_real_inf {a b : ℝ≥0∞}
+  : a ≠ ∞ → b ≠ ∞ → (a ⊓ b).to_real = a.to_real ⊓ b.to_real := to_real_min
+
 lemma to_nnreal_pos_iff : 0 < a.to_nnreal ↔ (0 < a ∧ a < ∞) :=
-begin
-  cases a,
-  { simp [none_eq_top] },
-  { simp [some_eq_coe] }
-end
+by { induction a using with_top.rec_top_coe; simp }
 
 lemma to_nnreal_pos {a : ℝ≥0∞} (ha₀ : a ≠ 0) (ha_top : a ≠ ∞) : 0 < a.to_nnreal :=
 to_nnreal_pos_iff.mpr ⟨bot_lt_iff_ne_bot.mpr ha₀, lt_top_iff_ne_top.mpr ha_top⟩
@@ -1552,6 +1657,10 @@ lemma of_real_le_of_le_to_real {a : ℝ} {b : ℝ≥0∞} (h : a ≤ ennreal.to_
   ennreal.of_real p ≤ ennreal.of_real q ↔ p ≤ q :=
 by rw [ennreal.of_real, ennreal.of_real, coe_le_coe, real.to_nnreal_le_to_nnreal_iff h]
 
+@[simp] lemma of_real_eq_of_real_iff {p q : ℝ} (hp : 0 ≤ p) (hq : 0 ≤ q) :
+  ennreal.of_real p = ennreal.of_real q ↔ p = q :=
+by rw [ennreal.of_real, ennreal.of_real, coe_eq_coe, real.to_nnreal_eq_to_nnreal_iff hp hq]
+
 @[simp] lemma of_real_lt_of_real_iff {p q : ℝ} (h : 0 < q) :
   ennreal.of_real p < ennreal.of_real q ↔ p < q :=
 by rw [ennreal.of_real, ennreal.of_real, coe_lt_coe, real.to_nnreal_lt_to_nnreal_iff h]
@@ -1569,9 +1678,9 @@ by simp [ennreal.of_real]
 @[simp] lemma zero_eq_of_real {p : ℝ} : 0 = ennreal.of_real p ↔ p ≤ 0 :=
 eq_comm.trans of_real_eq_zero
 
-alias ennreal.of_real_eq_zero ↔ _ ennreal.of_real_of_nonpos
+alias of_real_eq_zero ↔ _ of_real_of_nonpos
 
-lemma of_real_sub (p : ℝ) (hq : 0 ≤ q) :
+lemma of_real_sub (p : ℝ) {q : ℝ} (hq : 0 ≤ q) :
   ennreal.of_real (p - q) = ennreal.of_real p - ennreal.of_real q :=
 begin
   obtain h | h := le_total p q,
@@ -1614,13 +1723,21 @@ begin
 end
 
 lemma of_real_mul {p q : ℝ} (hp : 0 ≤ p) :
-  ennreal.of_real (p * q) = (ennreal.of_real p) * (ennreal.of_real q) :=
-by { simp only [ennreal.of_real, coe_mul.symm, coe_eq_coe], exact real.to_nnreal_mul hp }
+  ennreal.of_real (p * q) = ennreal.of_real p * ennreal.of_real q :=
+by simp only [ennreal.of_real, ← coe_mul, real.to_nnreal_mul hp]
+
+lemma of_real_mul' {p q : ℝ} (hq : 0 ≤ q) :
+  ennreal.of_real (p * q) = ennreal.of_real p * ennreal.of_real q :=
+by rw [mul_comm, of_real_mul hq, mul_comm]
 
 lemma of_real_pow {p : ℝ} (hp : 0 ≤ p) (n : ℕ) :
   ennreal.of_real (p ^ n) = ennreal.of_real p ^ n :=
 by rw [of_real_eq_coe_nnreal hp, ← coe_pow, ← of_real_coe_nnreal, nnreal.coe_pow, nnreal.coe_mk]
 
+lemma of_real_nsmul {x : ℝ} {n : ℕ} :
+  ennreal.of_real (n • x) = n • ennreal.of_real x :=
+by simp only [nsmul_eq_mul, ← of_real_coe_nat n, ← of_real_mul n.cast_nonneg]
+
 lemma of_real_inv_of_pos {x : ℝ} (hx : 0 < x) :
   (ennreal.of_real x)⁻¹ = ennreal.of_real x⁻¹ :=
 by rw [ennreal.of_real, ennreal.of_real, ←@coe_inv (real.to_nnreal x) (by simp [hx]), coe_eq_coe,
@@ -1628,36 +1745,56 @@ by rw [ennreal.of_real, ennreal.of_real, ←@coe_inv (real.to_nnreal x) (by simp
 
 lemma of_real_div_of_pos {x y : ℝ} (hy : 0 < y) :
   ennreal.of_real (x / y) = ennreal.of_real x / ennreal.of_real y :=
-by rw [div_eq_inv_mul, div_eq_mul_inv, of_real_mul (inv_nonneg.2 hy.le), of_real_inv_of_pos hy,
-  mul_comm]
+by rw [div_eq_mul_inv, div_eq_mul_inv, of_real_mul' (inv_nonneg.2 hy.le), of_real_inv_of_pos hy]
 
-lemma to_real_of_real_mul (c : ℝ) (a : ℝ≥0∞) (h : 0 ≤ c) :
-  ennreal.to_real ((ennreal.of_real c) * a) = c * ennreal.to_real a :=
-begin
-  cases a,
-  { simp only [none_eq_top, ennreal.to_real, top_to_nnreal, nnreal.coe_zero, mul_zero, mul_top],
-    by_cases h' : c ≤ 0,
-    { rw [if_pos], { simp }, { convert of_real_zero, exact le_antisymm h' h } },
-    { rw [if_neg], refl, rw [of_real_eq_zero], assumption } },
-  { simp only [ennreal.to_real, ennreal.to_nnreal],
-    simp only [some_eq_coe, ennreal.of_real, coe_mul.symm, to_nnreal_coe, nnreal.coe_mul],
-    congr, apply real.coe_to_nnreal, exact h }
-end
+@[simp] lemma to_nnreal_mul {a b : ℝ≥0∞} : (a * b).to_nnreal = a.to_nnreal * b.to_nnreal :=
+with_top.untop'_zero_mul a b
 
-@[simp] lemma to_nnreal_mul_top (a : ℝ≥0∞) : ennreal.to_nnreal (a * ∞) = 0 :=
+lemma to_nnreal_mul_top (a : ℝ≥0∞) : ennreal.to_nnreal (a * ∞) = 0 := by simp
+lemma to_nnreal_top_mul (a : ℝ≥0∞) : ennreal.to_nnreal (∞ * a) = 0 := by simp
+
+@[simp] lemma smul_to_nnreal (a : ℝ≥0) (b : ℝ≥0∞) :
+  (a • b).to_nnreal = a * b.to_nnreal :=
 begin
-  by_cases h : a = 0,
-  { rw [h, zero_mul, zero_to_nnreal] },
-  { rw [mul_top, if_neg h, top_to_nnreal] }
+  change ((a : ℝ≥0∞) * b).to_nnreal = a * b.to_nnreal,
+  simp only [ennreal.to_nnreal_mul, ennreal.to_nnreal_coe],
 end
 
-@[simp] lemma to_nnreal_top_mul (a : ℝ≥0∞) : ennreal.to_nnreal (∞ * a) = 0 :=
-by rw [mul_comm, to_nnreal_mul_top]
+/-- `ennreal.to_nnreal` as a `monoid_hom`. -/
+def to_nnreal_hom : ℝ≥0∞ →* ℝ≥0 :=
+{ to_fun := ennreal.to_nnreal,
+  map_one' := to_nnreal_coe,
+  map_mul' := λ _ _, to_nnreal_mul }
+
+@[simp] lemma to_nnreal_pow (a : ℝ≥0∞) (n : ℕ) : (a ^ n).to_nnreal = a.to_nnreal ^ n :=
+to_nnreal_hom.map_pow a n
+
+@[simp] lemma to_nnreal_prod {ι : Type*} {s : finset ι} {f : ι → ℝ≥0∞} :
+  (∏ i in s, f i).to_nnreal = ∏ i in s, (f i).to_nnreal :=
+to_nnreal_hom.map_prod _ _
+
+/-- `ennreal.to_real` as a `monoid_hom`. -/
+def to_real_hom : ℝ≥0∞ →* ℝ :=
+(nnreal.to_real_hom : ℝ≥0 →* ℝ).comp to_nnreal_hom
+
+@[simp] lemma to_real_mul : (a * b).to_real = a.to_real * b.to_real :=
+to_real_hom.map_mul a b
+
+@[simp] lemma to_real_pow (a : ℝ≥0∞) (n : ℕ) : (a ^ n).to_real = a.to_real ^ n :=
+to_real_hom.map_pow a n
 
-@[simp] lemma to_real_mul_top (a : ℝ≥0∞) : ennreal.to_real (a * ∞) = 0 :=
-by rw [ennreal.to_real, to_nnreal_mul_top, nnreal.coe_zero]
+@[simp] lemma to_real_prod {ι : Type*} {s : finset ι} {f : ι → ℝ≥0∞} :
+  (∏ i in s, f i).to_real = ∏ i in s, (f i).to_real :=
+to_real_hom.map_prod _ _
+
+lemma to_real_of_real_mul (c : ℝ) (a : ℝ≥0∞) (h : 0 ≤ c) :
+  ennreal.to_real ((ennreal.of_real c) * a) = c * ennreal.to_real a :=
+by rw [ennreal.to_real_mul, ennreal.to_real_of_real h]
 
-@[simp] lemma to_real_top_mul (a : ℝ≥0∞) : ennreal.to_real (∞ * a) = 0 :=
+lemma to_real_mul_top (a : ℝ≥0∞) : ennreal.to_real (a * ∞) = 0 :=
+by rw [to_real_mul, top_to_real, mul_zero]
+
+lemma to_real_top_mul (a : ℝ≥0∞) : ennreal.to_real (∞ * a) = 0 :=
 by { rw mul_comm, exact to_real_mul_top _ }
 
 lemma to_real_eq_to_real (ha : a ≠ ∞) (hb : b ≠ ∞) :
@@ -1670,22 +1807,10 @@ end
 
 lemma to_real_smul (r : ℝ≥0) (s : ℝ≥0∞) :
   (r • s).to_real = r • s.to_real :=
-begin
-  induction s using with_top.rec_top_coe,
-  { rw [show r • ∞ = (r : ℝ≥0∞) * ∞, by refl],
-    simp only [ennreal.to_real_mul_top, ennreal.top_to_real, smul_zero] },
-  { rw [← coe_smul, ennreal.coe_to_real, ennreal.coe_to_real],
-    refl }
-end
+by { rw [ennreal.smul_def, smul_eq_mul, to_real_mul, coe_to_real], refl }
 
 protected lemma trichotomy (p : ℝ≥0∞) : p = 0 ∨ p = ∞ ∨ 0 < p.to_real :=
-begin
-  rcases eq_or_lt_of_le (bot_le : 0 ≤ p) with (rfl : 0 = p) | (hp : 0 < p),
-  { simp },
-  rcases eq_or_lt_of_le (le_top : p ≤ ⊤) with rfl | hp',
-  { simp },
-  simp [ennreal.to_real_pos_iff, hp, hp'],
-end
+by simpa only [or_iff_not_imp_left] using to_real_pos
 
 protected lemma trichotomy₂ {p q : ℝ≥0∞} (hpq : p ≤ q) :
   (p = 0 ∧ q = 0) ∨ (p = 0 ∧ q = ∞) ∨ (p = 0 ∧ 0 < q.to_real) ∨ (p = ∞ ∧ q = ∞)
@@ -1708,27 +1833,13 @@ begin
   exact this.imp_right (λ h, h.2)
 end
 
-/-- `ennreal.to_nnreal` as a `monoid_hom`. -/
-def to_nnreal_hom : ℝ≥0∞ →* ℝ≥0 :=
-{ to_fun := ennreal.to_nnreal,
-  map_one' := to_nnreal_coe,
-  map_mul' := by rintro (_|x) (_|y); simp only [← coe_mul, none_eq_top, some_eq_coe,
-    to_nnreal_top_mul, to_nnreal_mul_top, top_to_nnreal, mul_zero, zero_mul, to_nnreal_coe] }
-
-lemma to_nnreal_mul {a b : ℝ≥0∞}: (a * b).to_nnreal = a.to_nnreal * b.to_nnreal :=
-to_nnreal_hom.map_mul a b
-
-lemma to_nnreal_pow (a : ℝ≥0∞) (n : ℕ) : (a ^ n).to_nnreal = a.to_nnreal ^ n :=
-to_nnreal_hom.map_pow a n
-
-lemma to_nnreal_prod {ι : Type*} {s : finset ι} {f : ι → ℝ≥0∞} :
-  (∏ i in s, f i).to_nnreal = ∏ i in s, (f i).to_nnreal :=
-to_nnreal_hom.map_prod _ _
+lemma to_real_pos_iff_ne_top (p : ℝ≥0∞) [fact (1 ≤ p)] : 0 < p.to_real ↔ p ≠ ∞ :=
+⟨λ h hp, let this : (0 : ℝ) ≠ 0 := top_to_real ▸ (hp ▸ h.ne : 0 ≠ ∞.to_real) in this rfl,
+ λ h, zero_lt_one.trans_le (p.dichotomy.resolve_left h)⟩
 
 lemma to_nnreal_inv (a : ℝ≥0∞) : (a⁻¹).to_nnreal = (a.to_nnreal)⁻¹ :=
 begin
-  rcases eq_or_ne a ∞ with rfl|ha, { simp },
-  lift a to ℝ≥0 using ha,
+  induction a using with_top.rec_top_coe, { simp },
   rcases eq_or_ne a 0 with rfl|ha, { simp },
   rw [← coe_inv ha, to_nnreal_coe, to_nnreal_coe]
 end
@@ -1736,20 +1847,6 @@ end
 lemma to_nnreal_div (a b : ℝ≥0∞) : (a / b).to_nnreal = a.to_nnreal / b.to_nnreal :=
 by rw [div_eq_mul_inv, to_nnreal_mul, to_nnreal_inv, div_eq_mul_inv]
 
-/-- `ennreal.to_real` as a `monoid_hom`. -/
-def to_real_hom : ℝ≥0∞ →* ℝ :=
-(nnreal.to_real_hom : ℝ≥0 →* ℝ).comp to_nnreal_hom
-
-lemma to_real_mul : (a * b).to_real = a.to_real * b.to_real :=
-to_real_hom.map_mul a b
-
-lemma to_real_pow (a : ℝ≥0∞) (n : ℕ) : (a ^ n).to_real = a.to_real ^ n :=
-to_real_hom.map_pow a n
-
-lemma to_real_prod {ι : Type*} {s : finset ι} {f : ι → ℝ≥0∞} :
-  (∏ i in s, f i).to_real = ∏ i in s, (f i).to_real :=
-to_real_hom.map_prod _ _
-
 lemma to_real_inv (a : ℝ≥0∞) : (a⁻¹).to_real = (a.to_real)⁻¹ :=
 by { simp_rw ennreal.to_real, norm_cast, exact to_nnreal_inv a, }
 
@@ -1765,9 +1862,9 @@ end
 
 @[simp] lemma to_nnreal_bit0 {x : ℝ≥0∞} : (bit0 x).to_nnreal = bit0 (x.to_nnreal) :=
 begin
-  by_cases hx_top : x = ∞,
-  { simp [hx_top, bit0_eq_top_iff.mpr rfl], },
-  exact to_nnreal_add hx_top hx_top,
+  induction x using with_top.rec_top_coe,
+  { simp },
+  { exact to_nnreal_add coe_ne_top coe_ne_top }
 end
 
 @[simp] lemma to_nnreal_bit1 {x : ℝ≥0∞} (hx_top : x ≠ ∞) :
@@ -1781,19 +1878,64 @@ by simp [ennreal.to_real]
   (bit1 x).to_real = bit1 (x.to_real) :=
 by simp [ennreal.to_real, hx_top]
 
-@[simp] lemma of_real_bit0 {r : ℝ} (hr : 0 ≤ r) :
+@[simp] lemma of_real_bit0 (r : ℝ) :
   ennreal.of_real (bit0 r) = bit0 (ennreal.of_real r) :=
-of_real_add hr hr
+by simp [ennreal.of_real]
 
 @[simp] lemma of_real_bit1 {r : ℝ} (hr : 0 ≤ r) :
   ennreal.of_real (bit1 r) = bit1 (ennreal.of_real r) :=
-(of_real_add (by simp [hr]) zero_le_one).trans (by simp [real.to_nnreal_one, bit1, hr])
+(of_real_add (by simp [hr]) zero_le_one).trans (by simp [real.to_nnreal_one, bit1])
 
 end real
 
 section infi
 variables {ι : Sort*} {f g : ι → ℝ≥0∞}
 
+lemma to_nnreal_infi (hf : ∀ i, f i ≠ ∞) : (infi f).to_nnreal = ⨅ i, (f i).to_nnreal :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { rw [infi_of_empty, top_to_nnreal, nnreal.infi_empty] },
+  { lift f to ι → ℝ≥0 using hf,
+    simp_rw [← coe_infi, to_nnreal_coe] },
+end
+
+lemma to_nnreal_Inf (s : set ℝ≥0∞) (hs : ∀ r ∈ s, r ≠ ∞) :
+  (Inf s).to_nnreal = Inf (ennreal.to_nnreal '' s) :=
+begin
+  have hf : ∀ i, (coe : s → ℝ≥0∞) i ≠ ∞ := λ ⟨r, rs⟩, hs r rs,
+  simpa only [←Inf_range, ←Inf_image', subtype.range_coe_subtype] using to_nnreal_infi hf
+end
+
+lemma to_nnreal_supr (hf : ∀ i, f i ≠ ∞) : (supr f).to_nnreal = ⨆ i, (f i).to_nnreal :=
+begin
+  lift f to ι → ℝ≥0 using hf,
+  simp_rw to_nnreal_coe,
+  by_cases h : bdd_above (range f),
+  { rw [← coe_supr h, to_nnreal_coe] },
+  { rw [nnreal.supr_of_not_bdd_above h, (with_top.supr_coe_eq_top f).mpr h, top_to_nnreal] }
+end
+
+lemma to_nnreal_Sup (s : set ℝ≥0∞) (hs : ∀ r ∈ s, r ≠ ∞) :
+  (Sup s).to_nnreal = Sup (ennreal.to_nnreal '' s) :=
+begin
+  have hf : ∀ i, (coe : s → ℝ≥0∞) i ≠ ∞ := λ⟨r, rs⟩, hs r rs,
+  simpa only [←Sup_range, ←Sup_image', subtype.range_coe_subtype] using to_nnreal_supr hf
+end
+
+lemma to_real_infi (hf : ∀ i, f i ≠ ∞) : (infi f).to_real = ⨅ i, (f i).to_real :=
+by simp only [ennreal.to_real, to_nnreal_infi hf, nnreal.coe_infi]
+
+lemma to_real_Inf (s : set ℝ≥0∞) (hf : ∀ r ∈ s, r ≠ ∞) :
+  (Inf s).to_real = Inf (ennreal.to_real '' s) :=
+by simp only [ennreal.to_real, to_nnreal_Inf s hf, nnreal.coe_Inf, set.image_image]
+
+lemma to_real_supr (hf : ∀ i, f i ≠ ∞) : (supr f).to_real = ⨆ i, (f i).to_real :=
+by simp only [ennreal.to_real, to_nnreal_supr hf, nnreal.coe_supr]
+
+lemma to_real_Sup (s : set ℝ≥0∞) (hf : ∀ r ∈ s, r ≠ ∞) :
+  (Sup s).to_real = Sup (ennreal.to_real '' s) :=
+by simp only [ennreal.to_real, to_nnreal_Sup s hf, nnreal.coe_Sup, set.image_image]
+
 lemma infi_add : infi f + a = ⨅i, f i + a :=
 le_antisymm
   (le_infi $ assume i, add_le_add (infi_le _ _) $ le_rfl)
@@ -1829,13 +1971,16 @@ calc (⨅a, f a + g a) ≤ (⨅ a a', f a + g a') :
 lemma infi_sum {f : ι → α → ℝ≥0∞} {s : finset α} [nonempty ι]
   (h : ∀(t : finset α) (i j : ι), ∃k, ∀a∈t, f k a ≤ f i a ∧ f k a ≤ f j a) :
   (⨅i, ∑ a in s, f i a) = ∑ a in s, ⨅i, f i a :=
-finset.induction_on s (by simp) $ assume a s ha ih,
-  have ∀ (i j : ι), ∃ (k : ι), f k a + ∑ b in s, f k b ≤ f i a + ∑ b in s, f j b,
-    from assume i j,
-    let ⟨k, hk⟩ := h (insert a s) i j in
-    ⟨k, add_le_add (hk a (finset.mem_insert_self _ _)).left $ finset.sum_le_sum $
-      assume a ha, (hk _ $ finset.mem_insert_of_mem ha).right⟩,
-  by simp [ha, ih.symm, infi_add_infi this]
+begin
+  induction s using finset.induction_on with a s ha ih,
+  { simp },
+  have : ∀ (i j : ι), ∃ (k : ι), f k a + ∑ b in s, f k b ≤ f i a + ∑ b in s, f j b,
+  { intros i j,
+    obtain ⟨k, hk⟩ := h (insert a s) i j,
+    exact ⟨k, add_le_add (hk a (finset.mem_insert_self _ _)).left $ finset.sum_le_sum $
+      λ a ha, (hk _ $ finset.mem_insert_of_mem ha).right⟩ },
+  simp [ha, ih.symm, infi_add_infi this]
+end
 
 /-- If `x ≠ 0` and `x ≠ ∞`, then right multiplication by `x` maps infimum to infimum.
 See also `ennreal.infi_mul` that assumes `[nonempty ι]` but does not require `x ≠ 0`. -/
@@ -1843,8 +1988,8 @@ lemma infi_mul_of_ne {ι} {f : ι → ℝ≥0∞} {x : ℝ≥0∞} (h0 : x ≠ 0
   infi f * x = ⨅ i, f i * x :=
 le_antisymm
   mul_right_mono.map_infi_le
-  ((div_le_iff_le_mul (or.inl h0) $ or.inl h).mp $ le_infi $
-    λ i, (div_le_iff_le_mul (or.inl h0) $ or.inl h).mpr $ infi_le _ _)
+  ((ennreal.div_le_iff_le_mul (or.inl h0) $ or.inl h).mp $ le_infi $
+    λ i, (ennreal.div_le_iff_le_mul (or.inl h0) $ or.inl h).mpr $ infi_le _ _)
 
 /-- If `x ≠ ∞`, then right multiplication by `x` maps infimum over a nonempty type to infimum. See
 also `ennreal.infi_mul_of_ne` that assumes `x ≠ 0` but does not require `[nonempty ι]`. -/
@@ -1888,3 +2033,55 @@ lemma supr_coe_nat : (⨆n:ℕ, (n : ℝ≥0∞)) = ∞ :=
 end supr
 
 end ennreal
+
+namespace set
+namespace ord_connected
+
+variables {s : set ℝ} {t : set ℝ≥0} {u : set ℝ≥0∞}
+
+lemma preimage_coe_nnreal_ennreal (h : u.ord_connected) : (coe ⁻¹' u : set ℝ≥0).ord_connected :=
+h.preimage_mono ennreal.coe_mono
+
+lemma image_coe_nnreal_ennreal (h : t.ord_connected) : (coe '' t : set ℝ≥0∞).ord_connected :=
+begin
+  refine ⟨ball_image_iff.2 $ λ x hx, ball_image_iff.2 $ λ y hy z hz, _⟩,
+  rcases ennreal.le_coe_iff.1 hz.2 with ⟨z, rfl, hzy⟩,
+  exact mem_image_of_mem _ (h.out hx hy ⟨ennreal.coe_le_coe.1 hz.1, ennreal.coe_le_coe.1 hz.2⟩)
+end
+
+lemma preimage_ennreal_of_real (h : u.ord_connected) : (ennreal.of_real ⁻¹' u).ord_connected :=
+h.preimage_coe_nnreal_ennreal.preimage_real_to_nnreal
+
+lemma image_ennreal_of_real (h : s.ord_connected) : (ennreal.of_real '' s).ord_connected :=
+by simpa only [image_image] using h.image_real_to_nnreal.image_coe_nnreal_ennreal
+
+end ord_connected
+end set
+
+namespace tactic
+open positivity
+
+private lemma nnreal_coe_pos {r : ℝ≥0} : 0 < r → 0 < (r : ℝ≥0∞) := ennreal.coe_pos.2
+
+/-- Extension for the `positivity` tactic: cast from `ℝ≥0` to `ℝ≥0∞`. -/
+@[positivity]
+meta def positivity_coe_nnreal_ennreal : expr → tactic strictness
+| `(@coe _ _ %%inst %%a) := do
+  unify inst `(@coe_to_lift _ _ $ @coe_base _ _ ennreal.has_coe),
+  positive p ← core a, -- We already know `0 ≤ r` for all `r : ℝ≥0∞`
+  positive <$> mk_app ``nnreal_coe_pos [p]
+| e := pp e >>= fail ∘ format.bracket "The expression "
+         " is not of the form `(r : ℝ≥0∞)` for `r : ℝ≥0`"
+
+private lemma ennreal_of_real_pos {r : ℝ} : 0 < r → 0 < ennreal.of_real r := ennreal.of_real_pos.2
+
+/-- Extension for the `positivity` tactic: `ennreal.of_real` is positive if its input is. -/
+@[positivity]
+meta def positivity_ennreal_of_real : expr → tactic strictness
+| `(ennreal.of_real %%r) := do
+    positive p ← core r,
+    positive <$> mk_app ``ennreal_of_real_pos [p]
+-- This case is handled by `tactic.positivity_canon`
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` is not of the form `ennreal.of_real r`"
+
+end tactic
diff --git a/src/data/real/ereal.lean b/src/data/real/ereal.lean
index c1c818caae5b0..0e7f0f8f7d112 100644
--- a/src/data/real/ereal.lean
+++ b/src/data/real/ereal.lean
@@ -5,12 +5,16 @@ Authors: Kevin Buzzard
 -/
 import data.real.basic
 import data.real.ennreal
+import data.sign
 
 /-!
 # The extended reals [-∞, ∞].
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `ereal`, the real numbers together with a top and bottom element,
-referred to as ⊤ and ⊥. It is implemented as `with_top (with_bot ℝ)`
+referred to as ⊤ and ⊥. It is implemented as `with_bot (with_top ℝ)`
 
 Addition and multiplication are problematic in the presence of ±∞, but
 negation has a natural definition and satisfies the usual properties.
@@ -18,16 +22,19 @@ negation has a natural definition and satisfies the usual properties.
 An ad hoc addition is defined, for which `ereal` is an `add_comm_monoid`, and even an ordered one
 (if `a ≤ a'` and `b ≤ b'` then `a + b ≤ a' + b'`).
 Note however that addition is badly behaved at `(⊥, ⊤)` and `(⊤, ⊥)` so this can not be upgraded
-to a group structure. Our choice is that `⊥ + ⊤ = ⊤ + ⊥ = ⊤`.
+to a group structure. Our choice is that `⊥ + ⊤ = ⊤ + ⊥ = ⊥`, to make sure that the exponential
+and the logarithm between `ereal` and `ℝ≥0∞` respect the operations (notice that the
+convention `0 * ∞ = 0` on `ℝ≥0∞` is enforced by measure theory).
 
 An ad hoc subtraction is then defined by `x - y = x + (-y)`. It does not have nice properties,
 but it is sometimes convenient to have.
 
-An ad hoc multiplication is defined, for which `ereal` is a `comm_monoid_with_zero`.
-This does not distribute with addition, as `⊤ = ⊤ - ⊥ = 1*⊤ - 1*⊤ ≠ (1 - 1) * ⊤ = 0 * ⊤ = 0`.
+An ad hoc multiplication is defined, for which `ereal` is a `comm_monoid_with_zero`. We make the
+choice that `0 * x = x * 0 = 0` for any `x` (while the other cases are defined non-ambiguously).
+This does not distribute with addition, as `⊥ = ⊥ + ⊤ = 1*⊥ + (-1)*⊥ ≠ (1 - 1) * ⊥ = 0 * ⊥ = 0`.
 
 `ereal` is a `complete_linear_order`; this is deduced by type class inference from
-the fact that `with_top (with_bot L)` is a complete linear order if `L` is
+the fact that `with_bot (with_top L)` is a complete linear order if `L` is
 a conditionally complete linear order.
 
 Coercions from `ℝ` and from `ℝ≥0∞` are registered, and their basic properties are proved. The main
@@ -35,26 +42,23 @@ one is the real coercion, and is usually referred to just as `coe` (lemmas such
 `ereal.coe_add` deal with this coercion). The one from `ennreal` is usually called `coe_ennreal`
 in the `ereal` namespace.
 
+We define an absolute value `ereal.abs` from `ereal` to `ℝ≥0∞`. Two elements of `ereal` coincide
+if and only if they have the same absolute value and the same sign.
+
 ## Tags
 
 real, ereal, complete lattice
-
-## TODO
-
-abs : ereal → ℝ≥0∞
-
-In Isabelle they define + - * and / (making junk choices for things like -∞ + ∞)
-and then prove whatever bits of the ordered ring/field axioms still hold. They
-also do some limits stuff (liminf/limsup etc).
-See https://isabelle.in.tum.de/dist/library/HOL/HOL-Library/Extended_Real.html
 -/
 
+open function
 open_locale ennreal nnreal
 
+noncomputable theory
+
 /-- ereal : The type `[-∞, ∞]` -/
-@[derive [has_top, comm_monoid_with_zero,
-  has_Sup, has_Inf, complete_linear_order, linear_ordered_add_comm_monoid_with_top]]
-def ereal := with_top (with_bot ℝ)
+@[derive [has_bot, has_zero, has_one, nontrivial, add_monoid,
+  has_Sup, has_Inf, complete_linear_order, linear_ordered_add_comm_monoid, zero_le_one_class]]
+def ereal := with_bot (with_top ℝ)
 
 /-- The canonical inclusion froms reals to ereals. Do not use directly: as this is registered as
 a coercion, use the coercion instead. -/
@@ -62,19 +66,27 @@ def real.to_ereal : ℝ → ereal := some ∘ some
 
 namespace ereal
 
--- TODO: Provide explicitly, otherwise it is inferred noncomputably from `complete_linear_order`
-instance : has_bot ereal := ⟨some ⊥⟩
+-- things unify with `with_bot.decidable_lt` later if we we don't provide this explicitly.
+instance decidable_lt : decidable_rel ((<) : ereal → ereal → Prop) :=
+with_bot.decidable_lt
 
-@[simp] lemma bot_lt_top : (⊥ : ereal) < ⊤ := with_top.coe_lt_top _
-@[simp] lemma bot_ne_top : (⊥ : ereal) ≠ ⊤ := bot_lt_top.ne
+-- TODO: Provide explicitly, otherwise it is inferred noncomputably from `complete_linear_order`
+instance : has_top ereal := ⟨some ⊤⟩
 
 instance : has_coe ℝ ereal := ⟨real.to_ereal⟩
+
+lemma coe_strict_mono : strict_mono (coe : ℝ → ereal) :=
+with_bot.coe_strict_mono.comp with_top.coe_strict_mono
+
+lemma coe_injective : injective (coe : ℝ → ereal) := coe_strict_mono.injective
+
 @[simp, norm_cast] protected lemma coe_le_coe_iff {x y : ℝ} : (x : ereal) ≤ (y : ereal) ↔ x ≤ y :=
-by { unfold_coes, simp [real.to_ereal] }
+coe_strict_mono.le_iff_le
 @[simp, norm_cast] protected lemma coe_lt_coe_iff {x y : ℝ} : (x : ereal) < (y : ereal) ↔ x < y :=
-by { unfold_coes, simp [real.to_ereal] }
+coe_strict_mono.lt_iff_lt
 @[simp, norm_cast] protected lemma coe_eq_coe_iff {x y : ℝ} : (x : ereal) = (y : ereal) ↔ x = y :=
-by { unfold_coes, simp [real.to_ereal, option.some_inj] }
+coe_injective.eq_iff
+protected lemma coe_ne_coe_iff {x y : ℝ} : (x : ereal) ≠ (y : ereal) ↔ x ≠ y := coe_injective.ne_iff
 
 /-- The canonical map from nonnegative extended reals to extended reals -/
 def _root_.ennreal.to_ereal : ℝ≥0∞ → ereal
@@ -83,9 +95,11 @@ def _root_.ennreal.to_ereal : ℝ≥0∞ → ereal
 
 instance has_coe_ennreal : has_coe ℝ≥0∞ ereal := ⟨ennreal.to_ereal⟩
 
-instance : has_zero ereal := ⟨(0 : ℝ)⟩
 instance : inhabited ereal := ⟨0⟩
 
+@[simp, norm_cast] lemma coe_zero : ((0 : ℝ) : ereal) = 0 := rfl
+@[simp, norm_cast] lemma coe_one : ((1 : ℝ) : ereal) = 1 := rfl
+
 /-- A recursor for `ereal` in terms of the coercion.
 
 A typical invocation looks like `induction x using ereal.rec`. Note that using `induction`
@@ -99,12 +113,88 @@ protected def rec {C : ereal → Sort*} (h_bot : C ⊥) (h_real : Π a : ℝ, C
 | (a : ℝ) := h_real a
 | ⊤ := h_top
 
+/-- The multiplication on `ereal`. Our definition satisfies `0 * x = x * 0 = 0` for any `x`, and
+picks the only sensible value elsewhere. -/
+protected def mul : ereal → ereal → ereal
+| ⊥ ⊥ := ⊤
+| ⊥ ⊤ := ⊥
+| ⊥ (y : ℝ) := if 0 < y then ⊥ else if y = 0 then 0 else ⊤
+| ⊤ ⊥ := ⊥
+| ⊤ ⊤ := ⊤
+| ⊤ (y : ℝ) := if 0 < y then ⊤ else if y = 0 then 0 else ⊥
+| (x : ℝ) ⊤ := if 0 < x then ⊤ else if x = 0 then 0 else ⊥
+| (x : ℝ) ⊥ := if 0 < x then ⊥ else if x = 0 then 0 else ⊤
+| (x : ℝ) (y : ℝ) := (x * y : ℝ)
+
+instance : has_mul ereal := ⟨ereal.mul⟩
+
+/-- Induct on two ereals by performing case splits on the sign of one whenever the other is
+infinite. -/
+@[elab_as_eliminator]
+lemma induction₂ {P : ereal → ereal → Prop}
+  (top_top : P ⊤ ⊤)
+  (top_pos : ∀ x : ℝ, 0 < x → P ⊤ x)
+  (top_zero : P ⊤ 0)
+  (top_neg : ∀ x : ℝ, x < 0 → P ⊤ x)
+  (top_bot : P ⊤ ⊥)
+  (pos_top : ∀ x : ℝ, 0 < x → P x ⊤)
+  (pos_bot : ∀ x : ℝ, 0 < x → P x ⊥)
+  (zero_top : P 0 ⊤)
+  (coe_coe : ∀ x y : ℝ, P x y)
+  (zero_bot : P 0 ⊥)
+  (neg_top : ∀ x : ℝ, x < 0 → P x ⊤)
+  (neg_bot : ∀ x : ℝ, x < 0 → P x ⊥)
+  (bot_top : P ⊥ ⊤)
+  (bot_pos : ∀ x : ℝ, 0 < x → P ⊥ x)
+  (bot_zero : P ⊥ 0)
+  (bot_neg : ∀ x : ℝ, x < 0 → P ⊥ x)
+  (bot_bot : P ⊥ ⊥) :
+  ∀ x y, P x y
+| ⊥ ⊥ := bot_bot
+| ⊥ (y : ℝ) :=
+  by { rcases lt_trichotomy 0 y with hy|rfl|hy, exacts [bot_pos y hy, bot_zero, bot_neg y hy] }
+| ⊥ ⊤ := bot_top
+| (x : ℝ) ⊥ :=
+  by { rcases lt_trichotomy 0 x with hx|rfl|hx, exacts [pos_bot x hx, zero_bot, neg_bot x hx] }
+| (x : ℝ) (y : ℝ) := coe_coe _ _
+| (x : ℝ) ⊤ :=
+  by { rcases lt_trichotomy 0 x with hx|rfl|hx, exacts [pos_top x hx, zero_top, neg_top x hx] }
+| ⊤ ⊥ := top_bot
+| ⊤ (y : ℝ) :=
+  by { rcases lt_trichotomy 0 y with hy|rfl|hy, exacts [top_pos y hy, top_zero, top_neg y hy] }
+| ⊤ ⊤ := top_top
+
+/-! `ereal` with its multiplication is a `comm_monoid_with_zero`. However, the proof of
+associativity by hand is extremely painful (with 125 cases...). Instead, we will deduce it later
+on from the facts that the absolute value and the sign are multiplicative functions taking value
+in associative objects, and that they characterize an extended real number. For now, we only
+record more basic properties of multiplication.
+-/
+instance : mul_zero_one_class ereal :=
+{ one_mul := λ x, begin
+    induction x using ereal.rec;
+    { dsimp only [(*)], simp only [ereal.mul, ← ereal.coe_one, zero_lt_one, if_true, one_mul] },
+  end,
+  mul_one := λ x, begin
+    induction x using ereal.rec;
+    { dsimp only [(*)], simp only [ereal.mul, ← ereal.coe_one, zero_lt_one, if_true, mul_one] },
+  end,
+  zero_mul := λ x, begin
+    induction x using ereal.rec;
+    { simp only [(*)], simp only [ereal.mul, ← ereal.coe_zero, zero_lt_one, if_true, if_false,
+        lt_irrefl (0 : ℝ), eq_self_iff_true, zero_mul] },
+  end,
+  mul_zero := λ x, begin
+    induction x using ereal.rec;
+    { simp only [(*)], simp only [ereal.mul, ← ereal.coe_zero, zero_lt_one, if_true, if_false,
+        lt_irrefl (0 : ℝ), eq_self_iff_true, mul_zero] },
+  end,
+  ..ereal.has_mul, ..ereal.has_one, ..ereal.has_zero }
+
 /-! ### Real coercion -/
 
-instance : can_lift ereal ℝ :=
-{ coe := coe,
-  cond := λ r, r ≠ ⊤ ∧ r ≠ ⊥,
-  prf := λ x hx,
+instance can_lift : can_lift ereal ℝ coe (λ r, r ≠ ⊤ ∧ r ≠ ⊥) :=
+{ prf := λ x hx,
   begin
     induction x using ereal.rec,
     { simpa using hx },
@@ -124,16 +214,18 @@ def to_real : ereal → ℝ
 
 @[simp] lemma to_real_zero : to_real 0 = 0 := rfl
 
+@[simp] lemma to_real_one : to_real 1 = 1 := rfl
+
 @[simp] lemma to_real_coe (x : ℝ) : to_real (x : ereal) = x := rfl
 
-@[simp] lemma bot_lt_coe (x : ℝ) : (⊥ : ereal) < x :=
-by { apply with_top.coe_lt_coe.2, exact with_bot.bot_lt_coe _ }
+@[simp] lemma bot_lt_coe (x : ℝ) : (⊥ : ereal) < x := with_bot.bot_lt_coe _
 
 @[simp] lemma coe_ne_bot (x : ℝ) : (x : ereal) ≠ ⊥  := (bot_lt_coe x).ne'
 
 @[simp] lemma bot_ne_coe (x : ℝ) : (⊥ : ereal) ≠ x := (bot_lt_coe x).ne
 
-@[simp] lemma coe_lt_top (x : ℝ) : (x : ereal) < ⊤ := with_top.coe_lt_top _
+@[simp] lemma coe_lt_top (x : ℝ) : (x : ereal) < ⊤ :=
+by { apply with_bot.coe_lt_coe.2, exact with_top.coe_lt_top _ }
 
 @[simp] lemma coe_ne_top (x : ℝ) : (x : ereal) ≠ ⊤ := (coe_lt_top x).ne
 
@@ -151,19 +243,39 @@ by { apply with_top.coe_lt_coe.2, exact with_bot.bot_lt_coe _ }
 
 @[simp] lemma top_ne_zero : (⊤ : ereal) ≠ 0 := (coe_ne_top 0).symm
 
-@[simp, norm_cast] lemma coe_add (x y : ℝ) : ((x + y : ℝ) : ereal) = (x : ereal) + (y : ereal) :=
-rfl
+@[simp, norm_cast] lemma coe_add (x y : ℝ) : (↑(x + y) : ereal) = x + y := rfl
+@[simp, norm_cast] lemma coe_mul (x y : ℝ) : (↑(x * y) : ereal) = x * y := rfl
+@[norm_cast] lemma coe_nsmul (n : ℕ) (x : ℝ) : (↑(n • x) : ereal) = n • x :=
+map_nsmul (⟨coe, coe_zero, coe_add⟩ : ℝ →+ ereal) _ _
+
+@[simp, norm_cast] lemma coe_bit0 (x : ℝ) : (↑(bit0 x) : ereal) = bit0 x := rfl
+@[simp, norm_cast] lemma coe_bit1 (x : ℝ) : (↑(bit1 x) : ereal) = bit1 x := rfl
+
+@[simp, norm_cast] lemma coe_eq_zero {x : ℝ} : (x : ereal) = 0 ↔ x = 0 := ereal.coe_eq_coe_iff
+@[simp, norm_cast] lemma coe_eq_one {x : ℝ} : (x : ereal) = 1 ↔ x = 1 := ereal.coe_eq_coe_iff
+lemma coe_ne_zero {x : ℝ} : (x : ereal) ≠ 0 ↔ x ≠ 0 := ereal.coe_ne_coe_iff
+lemma coe_ne_one {x : ℝ} : (x : ereal) ≠ 1 ↔ x ≠ 1 := ereal.coe_ne_coe_iff
+
+@[simp, norm_cast] protected lemma coe_nonneg {x : ℝ} : (0 : ereal) ≤ x ↔ 0 ≤ x :=
+ereal.coe_le_coe_iff
+
+@[simp, norm_cast] protected lemma coe_nonpos {x : ℝ} : (x : ereal) ≤ 0 ↔ x ≤ 0 :=
+ereal.coe_le_coe_iff
 
-@[simp] lemma coe_zero : ((0 : ℝ) : ereal) = 0 := rfl
+@[simp, norm_cast] protected lemma coe_pos {x : ℝ} : (0 : ereal) < x ↔ 0 < x :=
+ereal.coe_lt_coe_iff
+
+@[simp, norm_cast] protected lemma coe_neg' {x : ℝ} : (x : ereal) < 0 ↔ x < 0 :=
+ereal.coe_lt_coe_iff
 
 lemma to_real_le_to_real {x y : ereal} (h : x ≤ y) (hx : x ≠ ⊥) (hy : y ≠ ⊤) :
   x.to_real ≤ y.to_real :=
 begin
   lift x to ℝ,
+  { simp [hx, (h.trans_lt (lt_top_iff_ne_top.2 hy)).ne], },
   lift y to ℝ,
-  { simpa using h },
   { simp [hy, ((bot_lt_iff_ne_bot.2 hx).trans_le h).ne'] },
-  { simp [hx, (h.trans_lt (lt_top_iff_ne_top.2 hy)).ne], },
+  simpa using h
 end
 
 lemma coe_to_real {x : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) : (x.to_real : ereal) = x :=
@@ -212,9 +324,15 @@ end
 | ⊤ := rfl
 | (some x) := rfl
 
+@[simp] lemma coe_ennreal_of_real {x : ℝ} :
+  (ennreal.of_real x : ereal) = max x 0 :=
+rfl
+
 lemma coe_nnreal_eq_coe_real (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) = (x : ℝ) := rfl
 
-@[simp] lemma coe_ennreal_top : ((⊤ : ℝ≥0∞) : ereal) = ⊤ := rfl
+@[simp, norm_cast] lemma coe_ennreal_zero : ((0 : ℝ≥0∞) : ereal) = 0 := rfl
+@[simp, norm_cast] lemma coe_ennreal_one : ((1 : ℝ≥0∞) : ereal) = 1 := rfl
+@[simp, norm_cast] lemma coe_ennreal_top : ((⊤ : ℝ≥0∞) : ereal) = ⊤ := rfl
 
 @[simp] lemma coe_ennreal_eq_top_iff : ∀ {x : ℝ≥0∞}, (x : ereal) = ⊤ ↔ x = ⊤
 | ⊤ := by simp
@@ -224,41 +342,82 @@ lemma coe_nnreal_ne_top (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) ≠ ⊤ := de
 
 @[simp] lemma coe_nnreal_lt_top (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) < ⊤ := dec_trivial
 
-@[simp, norm_cast] lemma coe_ennreal_le_coe_ennreal_iff : ∀ {x y : ℝ≥0∞},
-  (x : ereal) ≤ (y : ereal) ↔ x ≤ y
-| x ⊤ := by simp
-| ⊤ (some y) := by simp
-| (some x) (some y) := by simp [coe_nnreal_eq_coe_real]
-
-@[simp, norm_cast] lemma coe_ennreal_lt_coe_ennreal_iff : ∀ {x y : ℝ≥0∞},
-  (x : ereal) < (y : ereal) ↔ x < y
+lemma coe_ennreal_strict_mono : strict_mono (coe : ℝ≥0∞ → ereal)
 | ⊤ ⊤ := by simp
 | (some x) ⊤ := by simp
 | ⊤ (some y) := by simp
 | (some x) (some y) := by simp [coe_nnreal_eq_coe_real]
 
-@[simp, norm_cast] lemma coe_ennreal_eq_coe_ennreal_iff : ∀ {x y : ℝ≥0∞},
-  (x : ereal) = (y : ereal) ↔ x = y
-| ⊤ ⊤ := by simp
-| (some x) ⊤ := by simp
-| ⊤ (some y) := by simp [(coe_nnreal_lt_top y).ne']
-| (some x) (some y) := by simp [coe_nnreal_eq_coe_real]
+lemma coe_ennreal_injective : injective (coe : ℝ≥0∞ → ereal) := coe_ennreal_strict_mono.injective
+
+@[simp, norm_cast] lemma coe_ennreal_le_coe_ennreal_iff {x y : ℝ≥0∞} :
+  (x : ereal) ≤ (y : ereal) ↔ x ≤ y :=
+coe_ennreal_strict_mono.le_iff_le
+
+@[simp, norm_cast] lemma coe_ennreal_lt_coe_ennreal_iff {x y : ℝ≥0∞} :
+  (x : ereal) < (y : ereal) ↔ x < y :=
+coe_ennreal_strict_mono.lt_iff_lt
+
+@[simp, norm_cast] lemma coe_ennreal_eq_coe_ennreal_iff {x y : ℝ≥0∞} :
+  (x : ereal) = (y : ereal) ↔ x = y :=
+coe_ennreal_injective.eq_iff
+
+lemma coe_ennreal_ne_coe_ennreal_iff {x y : ℝ≥0∞} : (x : ereal) ≠ (y : ereal) ↔ x ≠ y :=
+coe_ennreal_injective.ne_iff
+
+@[simp, norm_cast] lemma coe_ennreal_eq_zero {x : ℝ≥0∞} : (x : ereal) = 0 ↔ x = 0 :=
+by rw [←coe_ennreal_eq_coe_ennreal_iff, coe_ennreal_zero]
+
+@[simp, norm_cast] lemma coe_ennreal_eq_one {x : ℝ≥0∞} : (x : ereal) = 1 ↔ x = 1 :=
+by rw [←coe_ennreal_eq_coe_ennreal_iff, coe_ennreal_one]
+
+@[norm_cast] lemma coe_ennreal_ne_zero {x : ℝ≥0∞} : (x : ereal) ≠ 0 ↔ x ≠ 0 :=
+coe_ennreal_eq_zero.not
+
+@[norm_cast] lemma coe_ennreal_ne_one {x : ℝ≥0∞} : (x : ereal) ≠ 1 ↔ x ≠ 1 := coe_ennreal_eq_one.not
 
 lemma coe_ennreal_nonneg (x : ℝ≥0∞) : (0 : ereal) ≤ x :=
 coe_ennreal_le_coe_ennreal_iff.2 (zero_le x)
 
+@[simp, norm_cast] lemma coe_ennreal_pos {x : ℝ≥0∞} : (0 : ereal) < x ↔ 0 < x :=
+by rw [←coe_ennreal_zero, coe_ennreal_lt_coe_ennreal_iff]
+
 @[simp] lemma bot_lt_coe_ennreal (x : ℝ≥0∞) : (⊥ : ereal) < x :=
 (bot_lt_coe 0).trans_le (coe_ennreal_nonneg _)
 
 @[simp] lemma coe_ennreal_ne_bot (x : ℝ≥0∞) : (x : ereal) ≠ ⊥ := (bot_lt_coe_ennreal x).ne'
 
-@[simp, norm_cast] lemma coe_ennreal_add : ∀ (x y : ennreal), ((x + y : ℝ≥0∞) : ereal) = x + y
-| ⊤ y := rfl
-| x ⊤ := by simp
-| (some x) (some y) := rfl
-
-@[simp] lemma coe_ennreal_zero : ((0 : ℝ≥0∞) : ereal) = 0 := rfl
-
+@[simp, norm_cast] lemma coe_ennreal_add (x y : ennreal) : ((x + y : ℝ≥0∞) : ereal) = x + y :=
+by cases x; cases y; refl
+
+@[simp, norm_cast] lemma coe_ennreal_mul : ∀ (x y : ℝ≥0∞), ((x * y : ℝ≥0∞) : ereal) = x * y
+| ⊤ ⊤ := rfl
+| ⊤ (y : ℝ≥0) := begin
+    rw ennreal.top_mul, split_ifs,
+    { simp only [h, coe_ennreal_zero, mul_zero] },
+    { have A : (0 : ℝ) < y,
+      { simp only [ennreal.coe_eq_zero] at h,
+        exact nnreal.coe_pos.2 (bot_lt_iff_ne_bot.2 h) },
+      simp only [coe_nnreal_eq_coe_real, coe_ennreal_top, (*), ereal.mul, A, if_true], }
+  end
+| (x : ℝ≥0) ⊤ := begin
+    rw ennreal.mul_top, split_ifs,
+    { simp only [h, coe_ennreal_zero, zero_mul] },
+    { have A : (0 : ℝ) < x,
+      { simp only [ennreal.coe_eq_zero] at h,
+        exact nnreal.coe_pos.2 (bot_lt_iff_ne_bot.2 h) },
+      simp only [coe_nnreal_eq_coe_real, coe_ennreal_top, (*), ereal.mul, A, if_true] }
+  end
+| (x : ℝ≥0) (y : ℝ≥0) := by simp only [← ennreal.coe_mul, coe_nnreal_eq_coe_real,
+    nnreal.coe_mul, ereal.coe_mul]
+
+@[norm_cast] lemma coe_ennreal_nsmul (n : ℕ) (x : ℝ≥0∞) : (↑(n • x) : ereal) = n • x :=
+map_nsmul (⟨coe, coe_ennreal_zero, coe_ennreal_add⟩ : ℝ≥0∞ →+ ereal) _ _
+
+@[simp, norm_cast] lemma coe_ennreal_bit0 (x : ℝ≥0∞) : (↑(bit0 x) : ereal) = bit0 x :=
+coe_ennreal_add _ _
+@[simp, norm_cast] lemma coe_ennreal_bit1 (x : ℝ≥0∞) : (↑(bit1 x) : ereal) = bit1 x :=
+by simp_rw [bit1, coe_ennreal_add, coe_ennreal_bit0, coe_ennreal_one]
 
 /-! ### Order -/
 
@@ -282,24 +441,24 @@ lemma lt_iff_exists_real_btwn {a b : ereal} :
  λ ⟨x, ax, xb⟩, ax.trans xb⟩
 
 /-- The set of numbers in `ereal` that are not equal to `±∞` is equivalent to `ℝ`. -/
-def ne_top_bot_equiv_real : ({⊥, ⊤} : set ereal).compl ≃ ℝ :=
+def ne_top_bot_equiv_real : ({⊥, ⊤}ᶜ : set ereal) ≃ ℝ :=
 { to_fun := λ x, ereal.to_real x,
   inv_fun := λ x, ⟨x, by simp⟩,
   left_inv := λ ⟨x, hx⟩, subtype.eq $ begin
     lift x to ℝ,
+    { simpa [not_or_distrib, and_comm] using hx },
     { simp },
-    { simpa [not_or_distrib, and_comm] using hx }
   end,
   right_inv := λ x, by simp }
 
 /-! ### Addition -/
 
-@[simp] lemma add_top (x : ereal) : x + ⊤ = ⊤ := add_top _
-@[simp] lemma top_add (x : ereal) : ⊤ + x = ⊤ := top_add _
+@[simp] lemma add_bot (x : ereal) : x + ⊥ = ⊥ := with_bot.add_bot _
+@[simp] lemma bot_add (x : ereal) : ⊥ + x = ⊥ := with_bot.bot_add _
 
-@[simp] lemma bot_add_bot : (⊥ : ereal) + ⊥ = ⊥ := rfl
-@[simp] lemma bot_add_coe (x : ℝ) : (⊥ : ereal) + x = ⊥ := rfl
-@[simp] lemma coe_add_bot (x : ℝ) : (x : ereal) + ⊥ = ⊥ := rfl
+@[simp] lemma top_add_top : (⊤ : ereal) + ⊤ = ⊤ := rfl
+@[simp] lemma top_add_coe (x : ℝ) : (⊤ : ereal) + x = ⊤ := rfl
+@[simp] lemma coe_add_top (x : ℝ) : (x : ereal) + ⊤ = ⊤ := rfl
 
 lemma to_real_add : ∀ {x y : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) (hy : y ≠ ⊤) (h'y : y ≠ ⊥),
   to_real (x + y) = to_real x + to_real y
@@ -313,11 +472,11 @@ lemma add_lt_add_right_coe {x y : ereal} (h : x < y) (z : ℝ) : x + z < y + z :
 begin
   induction x using ereal.rec; induction y using ereal.rec,
   { exact (lt_irrefl _ h).elim },
-  { simp only [bot_lt_coe, bot_add_coe, ← coe_add] },
+  { simp only [← coe_add, bot_add, bot_lt_coe] },
   { simp },
   { exact (lt_irrefl _ (h.trans (bot_lt_coe x))).elim },
   { norm_cast at h ⊢, exact add_lt_add_right h _ },
-  { simp only [← coe_add, top_add, coe_lt_top] },
+  { simp only [← coe_add, top_add_coe, coe_lt_top] },
   { exact (lt_irrefl _ (h.trans_le le_top)).elim },
   { exact (lt_irrefl _ (h.trans_le le_top)).elim },
   { exact (lt_irrefl _ (h.trans_le le_top)).elim },
@@ -338,21 +497,24 @@ by simpa [add_comm] using add_lt_add_right_coe h z
 
 lemma add_lt_add {x y z t : ereal} (h1 : x < y) (h2 : z < t) : x + z < y + t :=
 begin
-  induction y using ereal.rec,
-  { exact (lt_irrefl _ (bot_le.trans_lt h1)).elim },
-  { calc x + z ≤ y + z : add_le_add h1.le le_rfl
-    ... < y + t : add_lt_add_left_coe h2 _ },
-  { simp [lt_top_iff_ne_top, with_top.add_eq_top, h1.ne, (h2.trans_le le_top).ne] }
+  induction x using ereal.rec,
+  { simp [bot_lt_iff_ne_bot, h1.ne', (bot_le.trans_lt h2).ne'] },
+  { calc (x : ereal) + z < x + t : add_lt_add_left_coe h2 _
+    ... ≤ y + t : add_le_add h1.le le_rfl },
+  { exact (lt_irrefl _ (h1.trans_le le_top)).elim }
 end
 
-@[simp] lemma add_eq_top_iff {x y : ereal} : x + y = ⊤ ↔ x = ⊤ ∨ y = ⊤ :=
+@[simp] lemma add_eq_bot_iff {x y : ereal} : x + y = ⊥ ↔ x = ⊥ ∨ y = ⊥ :=
 begin
   induction x using ereal.rec; induction y using ereal.rec;
   simp [← ereal.coe_add],
 end
 
-@[simp] lemma add_lt_top_iff {x y : ereal} : x + y < ⊤ ↔ x < ⊤ ∧ y < ⊤ :=
-by simp [lt_top_iff_ne_top, not_or_distrib]
+@[simp] lemma bot_lt_add_iff {x y : ereal} : ⊥ < x + y ↔ ⊥ < x ∧ ⊥ < y :=
+by simp [bot_lt_iff_ne_bot, not_or_distrib]
+
+lemma add_lt_top {x y : ereal} (hx : x ≠ ⊤) (hy : y ≠ ⊤) : x + y < ⊤ :=
+by { rw ← ereal.top_add_top, exact ereal.add_lt_add hx.lt_top hy.lt_top }
 
 /-! ### Negation -/
 
@@ -364,11 +526,19 @@ protected def neg : ereal → ereal
 
 instance : has_neg ereal := ⟨ereal.neg⟩
 
+instance : sub_neg_zero_monoid ereal :=
+{ neg_zero := by { change ((-0 : ℝ) : ereal) = 0, simp },
+  ..ereal.add_monoid, ..ereal.has_neg }
+
 @[norm_cast] protected lemma neg_def (x : ℝ) : ((-x : ℝ) : ereal) = -x := rfl
 
 @[simp] lemma neg_top : - (⊤ : ereal) = ⊥ := rfl
 @[simp] lemma neg_bot : - (⊥ : ereal) = ⊤ := rfl
-@[simp] lemma neg_zero : - (0 : ereal) = 0 := by { change ((-0 : ℝ) : ereal) = 0, simp }
+
+@[simp, norm_cast] lemma coe_neg (x : ℝ) : (↑(-x) : ereal) = -x := rfl
+@[simp, norm_cast] lemma coe_sub (x y : ℝ) : (↑(x - y) : ereal) = x - y := rfl
+@[norm_cast] lemma coe_zsmul (n : ℤ) (x : ℝ) : (↑(n • x) : ereal) = n • x :=
+map_zsmul' (⟨coe, coe_zero, coe_add⟩ : ℝ →+ ereal) coe_neg _ _
 
 instance : has_involutive_neg ereal :=
 { neg := has_neg.neg,
@@ -383,23 +553,29 @@ instance : has_involutive_neg ereal :=
 | ⊥ := by simp
 | (x : ℝ) := rfl
 
-@[simp] lemma neg_eg_top_iff {x : ereal} : - x = ⊤ ↔ x = ⊥ :=
-by { rw neg_eq_iff_neg_eq, simp [eq_comm] }
+@[simp] lemma neg_eq_top_iff {x : ereal} : - x = ⊤ ↔ x = ⊥ :=
+neg_eq_iff_eq_neg
 
-@[simp] lemma neg_eg_bot_iff {x : ereal} : - x = ⊥ ↔ x = ⊤ :=
-by { rw neg_eq_iff_neg_eq, simp [eq_comm] }
+@[simp] lemma neg_eq_bot_iff {x : ereal} : - x = ⊥ ↔ x = ⊤ :=
+neg_eq_iff_eq_neg
 
-@[simp] lemma neg_eg_zero_iff {x : ereal} : - x = 0 ↔ x = 0 :=
-by { rw neg_eq_iff_neg_eq, simp [eq_comm] }
+@[simp] lemma neg_eq_zero_iff {x : ereal} : - x = 0 ↔ x = 0 :=
+by rw [neg_eq_iff_eq_neg, neg_zero]
 
 /-- if `-a ≤ b` then `-b ≤ a` on `ereal`. -/
-protected theorem neg_le_of_neg_le : ∀ {a b : ereal} (h : -a ≤ b), -b ≤ a
-| ⊥ ⊥ h := h
-| ⊥ (some b) h := by cases (top_le_iff.1 h)
-| ⊤ l h := le_top
-| (a : ℝ) ⊥ h := by cases (le_bot_iff.1 h)
-| l ⊤ h := bot_le
-| (a : ℝ) (b : ℝ) h := by { norm_cast at h ⊢, exact neg_le.mp h }
+protected theorem neg_le_of_neg_le {a b : ereal} (h : -a ≤ b) : -b ≤ a :=
+begin
+  induction a using ereal.rec; induction b using ereal.rec,
+  { exact h },
+  { simpa only [coe_ne_top, neg_bot, top_le_iff] using h },
+  { exact bot_le },
+  { simpa only [coe_ne_top, le_bot_iff] using h },
+  { norm_cast at h ⊢, exact neg_le.1 h },
+  { exact bot_le },
+  { exact le_top },
+  { exact le_top },
+  { exact le_top },
+end
 
 /-- `-a ≤ b ↔ -b ≤ a` on `ereal`. -/
 protected theorem neg_le {a b : ereal} : -a ≤ b ↔ -b ≤ a :=
@@ -412,8 +588,6 @@ by rwa [←neg_neg b, ereal.neg_le, neg_neg]
 @[simp] lemma neg_le_neg_iff {a b : ereal} : - a ≤ - b ↔ b ≤ a :=
 by conv_lhs { rw [ereal.neg_le, neg_neg] }
 
-@[simp, norm_cast] lemma coe_neg (x : ℝ) : ((- x : ℝ) : ereal) = - (x : ereal) := rfl
-
 /-- Negation as an order reversing isomorphism on `ereal`. -/
 def neg_order_iso : ereal ≃o erealᵒᵈ :=
 { to_fun := λ x, order_dual.to_dual (-x),
@@ -432,26 +606,20 @@ end
 lemma neg_lt_iff_neg_lt {a b : ereal} : -a < b ↔ -b < a :=
 ⟨λ h, ereal.neg_lt_of_neg_lt h, λ h, ereal.neg_lt_of_neg_lt h⟩
 
-/-! ### Subtraction -/
+/-!
+### Subtraction
 
-/-- Subtraction on `ereal`, defined by `x - y = x + (-y)`. Since addition is badly behaved at some
+Subtraction on `ereal` is defined by `x - y = x + (-y)`. Since addition is badly behaved at some
 points, so is subtraction. There is no standard algebraic typeclass involving subtraction that is
-registered on `ereal` because of this bad behavior. -/
-protected noncomputable def sub (x y : ereal) : ereal := x + (-y)
-
-noncomputable instance : has_sub ereal := ⟨ereal.sub⟩
-
-@[simp] lemma top_sub (x : ereal) : ⊤ - x = ⊤ := top_add x
-@[simp] lemma sub_bot (x : ereal) : x - ⊥ = ⊤ := add_top x
-
-@[simp] lemma bot_sub_top : (⊥ : ereal) - ⊤ = ⊥ := rfl
-@[simp] lemma bot_sub_coe (x : ℝ) : (⊥ : ereal) - x = ⊥ := rfl
-@[simp] lemma coe_sub_bot (x : ℝ) : (x : ereal) - ⊤ = ⊥ := rfl
+registered on `ereal`, beyond `sub_neg_zero_monoid`, because of this bad behavior.
+-/
 
-@[simp] lemma sub_zero (x : ereal) : x - 0 = x := by { change x + (-0) = x, simp }
-@[simp] lemma zero_sub (x : ereal) : 0 - x = - x := by { change 0 + (-x) = - x, simp }
+@[simp] lemma bot_sub (x : ereal) : ⊥ - x = ⊥ := bot_add x
+@[simp] lemma sub_top (x : ereal) : x - ⊤ = ⊥ := add_bot x
 
-lemma sub_eq_add_neg (x y : ereal) : x - y = x + -y := rfl
+@[simp] lemma top_sub_bot : (⊤ : ereal) - ⊥ = ⊤ := rfl
+@[simp] lemma top_sub_coe (x : ℝ) : (⊤ : ereal) - x = ⊤ := rfl
+@[simp] lemma coe_sub_bot (x : ℝ) : (x : ereal) - ⊥ = ⊤ := rfl
 
 lemma sub_le_sub {x y z t : ereal} (h : x ≤ y) (h' : t ≤ z) : x - z ≤ y - t :=
 add_le_add h (neg_le_neg_iff.2 h')
@@ -479,7 +647,7 @@ end
 lemma to_real_sub {x y : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) (hy : y ≠ ⊤) (h'y : y ≠ ⊥) :
   to_real (x - y) = to_real x - to_real y :=
 begin
-  rw [ereal.sub_eq_add_neg, to_real_add hx h'x, to_real_neg],
+  rw [sub_eq_add_neg, to_real_add hx h'x, to_real_neg],
   { refl },
   { simpa using hy },
   { simpa using h'y }
@@ -487,30 +655,341 @@ end
 
 /-! ### Multiplication -/
 
-@[simp] lemma coe_one : ((1 : ℝ) : ereal) = 1 := rfl
+protected lemma mul_comm (x y : ereal) : x * y = y * x :=
+begin
+  induction x using ereal.rec; induction y using ereal.rec; try { refl },
+  dsimp only [(*)],
+  simp only [ereal.mul, mul_comm],
+end
 
-@[simp, norm_cast] lemma coe_mul (x y : ℝ) : ((x * y : ℝ) : ereal) = (x : ereal) * (y : ereal) :=
-eq.trans (with_bot.coe_eq_coe.mpr with_bot.coe_mul) with_top.coe_mul
+@[simp] lemma top_mul_top : (⊤ : ereal) * ⊤ = ⊤ := rfl
+@[simp] lemma top_mul_bot : (⊤ : ereal) * ⊥ = ⊥ := rfl
+@[simp] lemma bot_mul_top : (⊥ : ereal) * ⊤ = ⊥ := rfl
+@[simp] lemma bot_mul_bot : (⊥ : ereal) * ⊥ = ⊤ := rfl
 
-@[simp] lemma mul_top (x : ereal) (h : x ≠ 0) : x * ⊤ = ⊤ := with_top.mul_top h
-@[simp] lemma top_mul (x : ereal) (h : x ≠ 0) : ⊤ * x = ⊤ := with_top.top_mul h
+lemma mul_top_of_pos {x : ereal} (h : 0 < x) : x * ⊤ = ⊤ :=
+begin
+  induction x using ereal.rec,
+  { simpa only [not_lt_bot] using h },
+  { simp only [has_mul.mul, ereal.mul, ereal.coe_pos.1 h, if_true] },
+  { refl }
+end
 
-@[simp] lemma bot_mul_bot : (⊥ : ereal) * ⊥ = ⊥ := rfl
-@[simp] lemma bot_mul_coe (x : ℝ) (h : x ≠ 0) : (⊥ : ereal) * x = ⊥ :=
-with_top.coe_mul.symm.trans $
-  with_bot.coe_eq_coe.mpr $ with_bot.bot_mul $ function.injective.ne (@option.some.inj _) h
-@[simp] lemma coe_mul_bot (x : ℝ) (h : x ≠ 0) : (x : ereal) * ⊥ = ⊥ :=
-with_top.coe_mul.symm.trans $
-  with_bot.coe_eq_coe.mpr $ with_bot.mul_bot $ function.injective.ne (@option.some.inj _) h
+lemma mul_top_of_neg {x : ereal} (h : x < 0) : x * ⊤ = ⊥ :=
+begin
+  induction x using ereal.rec,
+  { refl },
+  { simp only [ereal.coe_neg'] at h,
+    simp only [has_mul.mul, ereal.mul, not_lt.2 h.le, h.ne, if_false] },
+  { simpa only [not_top_lt] using h }
+end
 
-@[simp] lemma to_real_one : to_real 1 = 1 := rfl
+lemma top_mul_of_pos {x : ereal} (h : 0 < x) : ⊤ * x = ⊤ :=
+by { rw ereal.mul_comm, exact mul_top_of_pos h }
+
+lemma top_mul_of_neg {x : ereal} (h : x < 0) : ⊤ * x = ⊥ :=
+by { rw ereal.mul_comm, exact mul_top_of_neg h }
+
+lemma coe_mul_top_of_pos {x : ℝ} (h : 0 < x) : (x : ereal) * ⊤ = ⊤ :=
+mul_top_of_pos (ereal.coe_pos.2 h)
+
+lemma coe_mul_top_of_neg {x : ℝ} (h : x < 0) : (x : ereal) * ⊤ = ⊥ :=
+mul_top_of_neg (ereal.coe_neg'.2 h)
+
+lemma top_mul_coe_of_pos {x : ℝ} (h : 0 < x) : (⊤ : ereal) * x = ⊤ :=
+top_mul_of_pos (ereal.coe_pos.2 h)
+
+lemma top_mul_coe_of_neg {x : ℝ} (h : x < 0) : (⊤ : ereal) * x = ⊥ :=
+top_mul_of_neg (ereal.coe_neg'.2 h)
+
+lemma mul_bot_of_pos {x : ereal} (h : 0 < x) : x * ⊥ = ⊥ :=
+begin
+  induction x using ereal.rec,
+  { simpa only [not_lt_bot] using h },
+  { simp only [has_mul.mul, ereal.mul, ereal.coe_pos.1 h, if_true] },
+  { refl }
+end
+
+lemma mul_bot_of_neg {x : ereal} (h : x < 0) : x * ⊥ = ⊤ :=
+begin
+  induction x using ereal.rec,
+  { refl },
+  { simp only [ereal.coe_neg'] at h,
+    simp only [has_mul.mul, ereal.mul, not_lt.2 h.le, h.ne, if_false] },
+  { simpa only [not_top_lt] using h }
+end
+
+lemma bot_mul_of_pos {x : ereal} (h : 0 < x) : ⊥ * x = ⊥ :=
+by { rw ereal.mul_comm, exact mul_bot_of_pos h }
+
+lemma bot_mul_of_neg {x : ereal} (h : x < 0) : ⊥ * x = ⊤ :=
+by { rw ereal.mul_comm, exact mul_bot_of_neg h }
+
+lemma coe_mul_bot_of_pos {x : ℝ} (h : 0 < x) : (x : ereal) * ⊥ = ⊥ :=
+mul_bot_of_pos (ereal.coe_pos.2 h)
+
+lemma coe_mul_bot_of_neg {x : ℝ} (h : x < 0) : (x : ereal) * ⊥ = ⊤ :=
+mul_bot_of_neg (ereal.coe_neg'.2 h)
+
+lemma bot_mul_coe_of_pos {x : ℝ} (h : 0 < x) : (⊥ : ereal) * x = ⊥ :=
+bot_mul_of_pos (ereal.coe_pos.2 h)
+
+lemma bot_mul_coe_of_neg {x : ℝ} (h : x < 0) : (⊥ : ereal) * x = ⊤ :=
+bot_mul_of_neg (ereal.coe_neg'.2 h)
+
+lemma to_real_mul {x y : ereal} : to_real (x * y) = to_real x * to_real y :=
+begin
+  -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
+  with_cases
+  { apply @induction₂ (λ x y, to_real (x * y) = to_real x * to_real y) };
+    propagate_tags { try { dsimp only} },
+  case [top_zero, bot_zero, zero_top, zero_bot] { all_goals { simp only [zero_mul, mul_zero,
+                                                                         to_real_zero] } },
+  case coe_coe : x y { norm_cast },
+  case top_top { rw [top_mul_top, to_real_top, mul_zero] },
+  case top_bot { rw [top_mul_bot, to_real_top, to_real_bot, zero_mul] },
+  case bot_top { rw [bot_mul_top, to_real_bot, zero_mul] },
+  case bot_bot { rw [bot_mul_bot, to_real_top, to_real_bot, zero_mul] },
+  case pos_bot : x hx
+  { rw [to_real_bot, to_real_coe, coe_mul_bot_of_pos hx, to_real_bot, mul_zero] },
+  case neg_bot : x hx
+  { rw [to_real_bot, to_real_coe, coe_mul_bot_of_neg hx, to_real_top, mul_zero] },
+  case pos_top : x hx
+  { rw [to_real_top, to_real_coe, coe_mul_top_of_pos hx, to_real_top, mul_zero] },
+  case neg_top : x hx
+  { rw [to_real_top, to_real_coe, coe_mul_top_of_neg hx, to_real_bot, mul_zero] },
+  case top_pos : y hy
+  { rw [to_real_top, to_real_coe, top_mul_coe_of_pos hy, to_real_top, zero_mul] },
+  case top_neg : y hy
+  { rw [to_real_top, to_real_coe, top_mul_coe_of_neg hy, to_real_bot, zero_mul] },
+  case bot_pos : y hy
+  { rw [to_real_bot, to_real_coe, bot_mul_coe_of_pos hy, to_real_bot, zero_mul] },
+  case bot_neg : y hy
+  { rw [to_real_bot, to_real_coe, bot_mul_coe_of_neg hy, to_real_top, zero_mul] },
+end
+
+protected lemma neg_mul (x y : ereal) : -x * y = -(x * y) :=
+begin
+  -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
+  with_cases
+  { apply @induction₂ (λ x y, -x * y = -(x * y)) };
+    propagate_tags { try { dsimp only} },
+  case [top_top, bot_top, top_bot, bot_bot] { all_goals { refl } },
+  case [top_zero, bot_zero, zero_top, zero_bot]
+  { all_goals { simp only [zero_mul, mul_zero, neg_zero] } },
+  case coe_coe : x y { norm_cast, exact neg_mul _ _, },
+  case pos_bot : x hx
+  { rw [coe_mul_bot_of_pos hx, neg_bot, ← coe_neg, coe_mul_bot_of_neg (neg_neg_of_pos hx)] },
+  case neg_bot : x hx
+  { rw [coe_mul_bot_of_neg hx, neg_top, ← coe_neg, coe_mul_bot_of_pos (neg_pos_of_neg hx)] },
+  case pos_top : x hx
+  { rw [coe_mul_top_of_pos hx, neg_top, ← coe_neg, coe_mul_top_of_neg (neg_neg_of_pos hx)] },
+  case neg_top : x hx
+  { rw [coe_mul_top_of_neg hx, neg_bot, ← coe_neg, coe_mul_top_of_pos (neg_pos_of_neg hx)] },
+  case top_pos : y hy { rw [top_mul_coe_of_pos hy, neg_top, bot_mul_coe_of_pos hy] },
+  case top_neg : y hy { rw [top_mul_coe_of_neg hy, neg_top, neg_bot, bot_mul_coe_of_neg hy] },
+  case bot_pos : y hy { rw [bot_mul_coe_of_pos hy, neg_bot, top_mul_coe_of_pos hy] },
+  case bot_neg : y hy { rw [bot_mul_coe_of_neg hy, neg_bot, neg_top, top_mul_coe_of_neg hy] },
+end
+
+instance : has_distrib_neg ereal :=
+{ neg_mul := ereal.neg_mul,
+  mul_neg := λ x y, by { rw [x.mul_comm, x.mul_comm], exact y.neg_mul x, },
+  ..ereal.has_involutive_neg }
+
+/-! ### Absolute value -/
+
+/-- The absolute value from `ereal` to `ℝ≥0∞`, mapping `⊥` and `⊤` to `⊤` and
+a real `x` to `|x|`. -/
+protected def abs : ereal → ℝ≥0∞
+| ⊥ := ⊤
+| ⊤ := ⊤
+| (x : ℝ) := ennreal.of_real (|x|)
 
-lemma to_real_mul : ∀ {x y : ereal}, to_real (x * y) = to_real x * to_real y
-| ⊤ y := by by_cases hy : y = 0; simp [hy]
-| x ⊤ := by by_cases hx : x = 0; simp [hx]
-| (x : ℝ) (y : ℝ) := by simp [← ereal.coe_mul]
-| ⊥ (y : ℝ) := by by_cases hy : y = 0; simp [hy]
-| (x : ℝ) ⊥ := by by_cases hx : x = 0; simp [hx]
-| ⊥ ⊥ := by simp
+@[simp] lemma abs_top : (⊤ : ereal).abs = ⊤ := rfl
+@[simp] lemma abs_bot : (⊥ : ereal).abs = ⊤ := rfl
+
+lemma abs_def (x : ℝ) : (x : ereal).abs = ennreal.of_real (|x|) := rfl
+
+lemma abs_coe_lt_top (x : ℝ) : (x : ereal).abs < ⊤ :=
+ennreal.of_real_lt_top
+
+@[simp] lemma abs_eq_zero_iff {x : ereal} : x.abs = 0 ↔ x = 0 :=
+begin
+  induction x using ereal.rec,
+  { simp only [abs_bot, ennreal.top_ne_zero, bot_ne_zero] },
+  { simp only [ereal.abs, coe_eq_zero, ennreal.of_real_eq_zero, abs_nonpos_iff] },
+  { simp only [abs_top, ennreal.top_ne_zero, top_ne_zero] }
+end
+
+@[simp] lemma abs_zero : (0 : ereal).abs = 0 :=
+by rw [abs_eq_zero_iff]
+
+@[simp] lemma coe_abs (x : ℝ) : ((x : ereal).abs : ereal) = (|x| : ℝ) :=
+by rcases lt_trichotomy 0 x with hx | rfl | hx; simp [abs_def]
+
+@[simp] lemma abs_mul (x y : ereal) : (x * y).abs = x.abs * y.abs :=
+begin
+   -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
+  with_cases
+  { apply @induction₂ (λ x y, (x * y).abs = x.abs * y.abs) };
+    propagate_tags { try { dsimp only} },
+  case [top_top, bot_top, top_bot, bot_bot] { all_goals { refl } },
+  case [top_zero, bot_zero, zero_top, zero_bot] { all_goals { simp only [zero_mul, mul_zero,
+                                                                         abs_zero] } },
+  case coe_coe : x y { simp only [← coe_mul, ereal.abs, abs_mul,
+                                  ennreal.of_real_mul (abs_nonneg _)], },
+  case pos_bot : x hx { simp only [coe_mul_bot_of_pos hx, hx.ne', abs_bot, with_top.mul_top, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff] },
+  case neg_bot : x hx { simp only [coe_mul_bot_of_neg hx, hx.ne, abs_bot, with_top.mul_top, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
+  case pos_top : x hx { simp only [coe_mul_top_of_pos hx, hx.ne', with_top.mul_top, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
+  case neg_top : x hx { simp only [coe_mul_top_of_neg hx, hx.ne, abs_bot, with_top.mul_top, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
+  case top_pos : y hy { simp only [top_mul_coe_of_pos hy, hy.ne', with_top.top_mul, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
+  case top_neg : y hy { simp only [top_mul_coe_of_neg hy, hy.ne, abs_bot, with_top.top_mul, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
+  case bot_pos : y hy { simp only [bot_mul_coe_of_pos hy, hy.ne', abs_bot, with_top.top_mul, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff] },
+  case bot_neg : y hy { simp only [bot_mul_coe_of_neg hy, hy.ne, abs_bot, with_top.top_mul, ne.def,
+                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
+end
+
+/-! ### Sign -/
+
+@[simp] lemma sign_top : sign (⊤ : ereal) = 1 := rfl
+@[simp] lemma sign_bot : sign (⊥ : ereal) = -1 := rfl
+@[simp] lemma sign_coe (x : ℝ) : sign (x : ereal) = sign x :=
+by simp only [sign, order_hom.coe_fun_mk, ereal.coe_pos, ereal.coe_neg']
+
+@[simp] lemma sign_mul (x y : ereal) : sign (x * y) = sign x * sign y :=
+begin
+   -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
+  with_cases
+  { apply @induction₂ (λ x y, sign (x * y) = sign x * sign y) };
+    propagate_tags { try { dsimp only} },
+  case [top_top, bot_top, top_bot, bot_bot] { all_goals { refl } },
+  case [top_zero, bot_zero, zero_top, zero_bot] { all_goals { simp only [zero_mul, mul_zero,
+                                                                         sign_zero] } },
+  case coe_coe : x y { simp only [← coe_mul, sign_coe, sign_mul], },
+  case pos_bot : x hx { simp_rw [coe_mul_bot_of_pos hx, sign_coe, sign_pos hx, one_mul] },
+  case neg_bot : x hx { simp_rw [coe_mul_bot_of_neg hx, sign_coe, sign_neg hx, sign_top, sign_bot,
+                                 neg_one_mul, neg_neg] },
+  case pos_top : x hx { simp_rw [coe_mul_top_of_pos hx, sign_coe, sign_pos hx, one_mul] },
+  case neg_top : x hx { simp_rw [coe_mul_top_of_neg hx, sign_coe, sign_neg hx, sign_top, sign_bot,
+                                 mul_one] },
+  case top_pos : y hy { simp_rw [top_mul_coe_of_pos hy, sign_coe, sign_pos hy, mul_one] },
+  case top_neg : y hy { simp_rw [top_mul_coe_of_neg hy, sign_coe, sign_neg hy, sign_top, sign_bot,
+                                 one_mul] },
+  case bot_pos : y hy { simp_rw [bot_mul_coe_of_pos hy, sign_coe, sign_pos hy, mul_one] },
+  case bot_neg : y hy { simp_rw [bot_mul_coe_of_neg hy, sign_coe, sign_neg hy, sign_top, sign_bot,
+                                 neg_one_mul, neg_neg] },
+end
+
+lemma sign_mul_abs (x : ereal) :
+  (sign x * x.abs : ereal) = x :=
+begin
+  induction x using ereal.rec,
+  { simp },
+  { rcases lt_trichotomy 0 x with hx | rfl | hx,
+    { simp [sign_pos hx, abs_of_pos hx] },
+    { simp },
+    { simp [sign_neg hx, abs_of_neg hx] } },
+  { simp }
+end
+
+lemma sign_eq_and_abs_eq_iff_eq {x y : ereal} :
+  (x.abs = y.abs ∧ sign x = sign y) ↔ x = y :=
+begin
+  split,
+  { rintros ⟨habs, hsign⟩, rw [← x.sign_mul_abs, ← y.sign_mul_abs, habs, hsign] },
+  { rintros rfl, simp only [eq_self_iff_true, and_self] }
+end
+
+lemma le_iff_sign {x y : ereal} :
+  x ≤ y ↔ sign x < sign y ∨
+    sign x = sign_type.neg ∧ sign y = sign_type.neg ∧ y.abs ≤ x.abs ∨
+    sign x = sign_type.zero ∧ sign y = sign_type.zero ∨
+    sign x = sign_type.pos ∧ sign y = sign_type.pos ∧ x.abs ≤ y.abs :=
+begin
+  split,
+  { intro h,
+    rcases (sign.monotone h).lt_or_eq with hs | hs,
+    { exact or.inl hs },
+    { rw [← x.sign_mul_abs, ← y.sign_mul_abs] at h,
+      cases sign y; rw [hs] at *,
+      { simp },
+      { simp at ⊢ h, exact or.inl h },
+      { simpa using h, }, }, },
+  { rintros (h | h | h | h), { exact (sign.monotone.reflect_lt h).le, },
+    all_goals { rw [← x.sign_mul_abs, ← y.sign_mul_abs], simp [h] } }
+end
+
+instance : comm_monoid_with_zero ereal :=
+{ mul_assoc := λ x y z, begin
+    rw [← sign_eq_and_abs_eq_iff_eq],
+    simp only [mul_assoc, abs_mul, eq_self_iff_true, sign_mul, and_self],
+  end,
+  mul_comm := ereal.mul_comm,
+  ..ereal.has_mul, ..ereal.has_one, ..ereal.has_zero, ..ereal.mul_zero_one_class }
+
+instance : pos_mul_mono ereal :=
+pos_mul_mono_iff_covariant_pos.2 ⟨begin
+  rintros ⟨x, x0⟩ a b h, dsimp,
+  rcases le_iff_sign.mp h with h | h | h | h,
+  { rw [le_iff_sign], left, simp [sign_pos x0, h] },
+  all_goals { rw [← x.sign_mul_abs, ← a.sign_mul_abs, ← b.sign_mul_abs, sign_pos x0],
+    simp only [h], dsimp,
+    simp only [neg_mul, mul_neg, ereal.neg_le_neg_iff, one_mul, le_refl, zero_mul, mul_zero] },
+  all_goals { norm_cast, exact mul_le_mul_left' h.2.2 _, },
+end⟩
+instance : mul_pos_mono ereal := pos_mul_mono_iff_mul_pos_mono.1 ereal.pos_mul_mono
+instance : pos_mul_reflect_lt ereal := pos_mul_mono.to_pos_mul_reflect_lt
+instance : mul_pos_reflect_lt ereal := mul_pos_mono.to_mul_pos_reflect_lt
+
+@[simp, norm_cast] lemma coe_pow (x : ℝ) (n : ℕ) : (↑(x ^ n) : ereal) = x ^ n :=
+map_pow (⟨coe, coe_one, coe_mul⟩ : ℝ →* ereal) _ _
+
+@[simp, norm_cast] lemma coe_ennreal_pow (x : ℝ≥0∞) (n : ℕ) : (↑(x ^ n) : ereal) = x ^ n :=
+map_pow (⟨coe, coe_ennreal_one, coe_ennreal_mul⟩ : ℝ≥0∞ →* ereal) _ _
 
 end ereal
+
+namespace tactic
+open positivity
+
+private lemma ereal_coe_ne_zero {r : ℝ} : r ≠ 0 → (r : ereal) ≠ 0 := ereal.coe_ne_zero.2
+private lemma ereal_coe_nonneg {r : ℝ} : 0 ≤ r → 0 ≤ (r : ereal) := ereal.coe_nonneg.2
+private lemma ereal_coe_pos {r : ℝ} : 0 < r → 0 < (r : ereal) := ereal.coe_pos.2
+private lemma ereal_coe_ennreal_pos {r : ℝ≥0∞} : 0 < r → 0 < (r : ereal) := ereal.coe_ennreal_pos.2
+
+/-- Extension for the `positivity` tactic: cast from `ℝ` to `ereal`. -/
+@[positivity]
+meta def positivity_coe_real_ereal : expr → tactic strictness
+| `(@coe _ _ %%inst %%a) := do
+  unify inst `(@coe_to_lift _ _ $ @coe_base _ _ ereal.has_coe),
+  strictness_a ← core a,
+  match strictness_a with
+  | positive p := positive <$> mk_app ``ereal_coe_pos [p]
+  | nonnegative p := nonnegative <$> mk_mapp ``ereal_coe_nonneg [a, p]
+  | nonzero p := nonzero <$> mk_mapp ``ereal_coe_ne_zero [a, p]
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression "
+         " is not of the form `(r : ereal)` for `r : ℝ`"
+
+/-- Extension for the `positivity` tactic: cast from `ℝ≥0∞` to `ereal`. -/
+@[positivity]
+meta def positivity_coe_ennreal_ereal : expr → tactic strictness
+| `(@coe _ _ %%inst %%a) := do
+  unify inst `(@coe_to_lift _ _ $ @coe_base _ _ ereal.has_coe_ennreal),
+  strictness_a ← core a,
+  match strictness_a with
+  | positive p := positive <$> mk_app ``ereal_coe_ennreal_pos [p]
+  | _ := nonnegative <$> mk_mapp `ereal.coe_ennreal_nonneg [a]
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression "
+         " is not of the form `(r : ereal)` for `r : ℝ≥0∞`"
+
+end tactic
diff --git a/src/data/real/golden_ratio.lean b/src/data/real/golden_ratio.lean
index e3e6e5209b3ec..c5963b5fe0114 100644
--- a/src/data/real/golden_ratio.lean
+++ b/src/data/real/golden_ratio.lean
@@ -5,6 +5,7 @@ Authors: Anatole Dedecker, Alexey Soloyev, Junyan Xu
 -/
 import data.real.irrational
 import data.nat.fib
+import data.nat.prime_norm_num
 import data.fin.vec_notation
 import tactic.ring_exp
 import algebra.linear_recurrence
@@ -12,6 +13,9 @@ import algebra.linear_recurrence
 /-!
 # The golden ratio and its conjugate
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the golden ratio `φ := (1 + √5)/2` and its conjugate
 `ψ := (1 - √5)/2`, which are the two real roots of `X² - X - 1`.
 
@@ -21,6 +25,7 @@ Binet's formula.
 -/
 
 noncomputable theory
+open_locale polynomial
 
 /-- The golden ratio `φ := (1 + √5)/2`. -/
 @[reducible] def golden_ratio := (1 + real.sqrt 5)/2
@@ -28,8 +33,8 @@ noncomputable theory
 /-- The conjugate of the golden ratio `ψ := (1 - √5)/2`. -/
 @[reducible] def golden_conj := (1 - real.sqrt 5)/2
 
-localized "notation `φ` := golden_ratio" in real
-localized "notation `ψ` := golden_conj" in real
+localized "notation (name := golden_ratio) `φ` := golden_ratio" in real
+localized "notation (name := golden_conj) `ψ` := golden_conj" in real
 
 /-- The inverse of the golden ratio is the opposite of its conjugate. -/
 lemma inv_gold : φ⁻¹ = -ψ :=
@@ -43,7 +48,7 @@ end
 /-- The opposite of the golden ratio is the inverse of its conjugate. -/
 lemma inv_gold_conj : ψ⁻¹ = -φ :=
 begin
-  rw [inv_eq_iff_inv_eq, ← neg_inv, neg_eq_iff_neg_eq],
+  rw [inv_eq_iff_eq_inv, ← neg_inv, ← neg_eq_iff_eq_neg],
   exact inv_gold.symm,
 end
 
@@ -139,10 +144,10 @@ open polynomial
 
 /-- The characteristic polynomial of `fib_rec` is `X² - (X + 1)`. -/
 lemma fib_rec_char_poly_eq {β : Type*} [comm_ring β] :
-  fib_rec.char_poly = X^2 - (X + (1 : polynomial β)) :=
+  fib_rec.char_poly = X^2 - (X + (1 : β[X])) :=
 begin
   rw [fib_rec, linear_recurrence.char_poly],
-  simp [finset.sum_fin_eq_sum_range, finset.sum_range_succ', monomial_eq_smul_X]
+  simp [finset.sum_fin_eq_sum_range, finset.sum_range_succ', ← smul_X_eq_monomial]
 end
 
 end poly
diff --git a/src/data/real/hyperreal.lean b/src/data/real/hyperreal.lean
index c12906fec6491..fc7dcc328ccfb 100644
--- a/src/data/real/hyperreal.lean
+++ b/src/data/real/hyperreal.lean
@@ -8,10 +8,13 @@ import analysis.specific_limits.basic
 
 /-!
 # Construction of the hyperreal numbers as an ultraproduct of real sequences.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 open filter filter.germ
-open_locale topological_space classical
+open_locale topology classical
 
 /-- Hyperreal numbers on the ultrafilter extending the cofinite filter -/
 @[derive [linear_ordered_field, inhabited]]
@@ -23,12 +26,13 @@ notation `ℝ*` := hyperreal
 
 noncomputable instance : has_coe_t ℝ ℝ* := ⟨λ x, (↑x : germ _ _)⟩
 
-@[simp, norm_cast]
-lemma coe_eq_coe {x y : ℝ} : (x : ℝ*) = y ↔ x = y :=
-germ.const_inj
+@[simp, norm_cast] lemma coe_eq_coe {x y : ℝ} : (x : ℝ*) = y ↔ x = y := germ.const_inj
+lemma coe_ne_coe {x y : ℝ} : (x : ℝ*) ≠ y ↔ x ≠ y := coe_eq_coe.not
 
 @[simp, norm_cast] lemma coe_eq_zero {x : ℝ} : (x : ℝ*) = 0 ↔ x = 0 := coe_eq_coe
 @[simp, norm_cast] lemma coe_eq_one {x : ℝ} : (x : ℝ*) = 1 ↔ x = 1 := coe_eq_coe
+@[norm_cast] lemma coe_ne_zero {x : ℝ} : (x : ℝ*) ≠ 0 ↔ x ≠ 0 := coe_ne_coe
+@[norm_cast] lemma coe_ne_one {x : ℝ} : (x : ℝ*) ≠ 1 ↔ x ≠ 1 := coe_ne_coe
 
 @[simp, norm_cast] lemma coe_one : ↑(1 : ℝ) = (1 : ℝ*) := rfl
 @[simp, norm_cast] lemma coe_zero : ↑(0 : ℝ) = (0 : ℝ*) := rfl
@@ -41,15 +45,11 @@ germ.const_inj
 @[simp, norm_cast] lemma coe_div (x y : ℝ) : ↑(x / y) = (x / y : ℝ*) := rfl
 @[simp, norm_cast] lemma coe_sub (x y : ℝ) : ↑(x - y) = (x - y : ℝ*) := rfl
 
-@[simp, norm_cast] lemma coe_lt_coe {x y : ℝ} : (x : ℝ*) < y ↔ x < y := germ.const_lt
-@[simp, norm_cast] lemma coe_pos {x : ℝ} : 0 < (x : ℝ*) ↔ 0 < x :=
-coe_lt_coe
 @[simp, norm_cast] lemma coe_le_coe {x y : ℝ} : (x : ℝ*) ≤ y ↔ x ≤ y := germ.const_le_iff
-@[simp, norm_cast] lemma coe_abs (x : ℝ) : ((|x| : ℝ) : ℝ*) = |x| :=
-begin
-  convert const_abs x,
-  apply linear_order.to_lattice_eq_filter_germ_lattice,
-end
+@[simp, norm_cast] lemma coe_lt_coe {x y : ℝ} : (x : ℝ*) < y ↔ x < y := germ.const_lt_iff
+@[simp, norm_cast] lemma coe_nonneg {x : ℝ} : 0 ≤ (x : ℝ*) ↔ 0 ≤ x := coe_le_coe
+@[simp, norm_cast] lemma coe_pos {x : ℝ} : 0 < (x : ℝ*) ↔ 0 < x := coe_lt_coe
+@[simp, norm_cast] lemma coe_abs (x : ℝ) : ((|x| : ℝ) : ℝ*) = |x| := const_abs x
 @[simp, norm_cast] lemma coe_max (x y : ℝ) : ((max x y : ℝ) : ℝ*) = max x y := germ.const_max _ _
 @[simp, norm_cast] lemma coe_min (x y : ℝ) : ((min x y : ℝ) : ℝ*) = min x y := germ.const_min _ _
 
@@ -62,27 +62,21 @@ noncomputable def epsilon : ℝ* := of_seq $ λ n, n⁻¹
 /-- A sample infinite hyperreal-/
 noncomputable def omega : ℝ* := of_seq coe
 
-localized "notation `ε` := hyperreal.epsilon" in hyperreal
-localized "notation `ω` := hyperreal.omega" in hyperreal
-
-lemma epsilon_eq_inv_omega : ε = ω⁻¹ := rfl
+localized "notation (name := hyperreal.epsilon) `ε` := hyperreal.epsilon" in hyperreal
+localized "notation (name := hyperreal.omega) `ω` := hyperreal.omega" in hyperreal
 
-lemma inv_epsilon_eq_omega : ε⁻¹ = ω := @inv_inv _ _ ω
+@[simp] lemma inv_omega : ω⁻¹ = ε := rfl
+@[simp] lemma inv_epsilon : ε⁻¹ = ω := @inv_inv _ _ ω
 
-lemma epsilon_pos : 0 < ε :=
-suffices ∀ᶠ i in hyperfilter ℕ, (0 : ℝ) < (i : ℕ)⁻¹, by rwa lt_def,
-have h0' : {n : ℕ | ¬ 0 < n} = {0} :=
-by simp only [not_lt, (set.set_of_eq_eq_singleton).symm]; ext; exact nat.le_zero_iff,
-begin
-  simp only [inv_pos, nat.cast_pos],
-  exact mem_hyperfilter_of_finite_compl (by convert set.finite_singleton _),
+lemma omega_pos : 0 < ω := germ.coe_pos.2 $ mem_hyperfilter_of_finite_compl $ begin
+  convert set.finite_singleton 0,
+  simp [set.eq_singleton_iff_unique_mem],
 end
 
-lemma epsilon_ne_zero : ε ≠ 0 := ne_of_gt epsilon_pos
-
-lemma omega_pos : 0 < ω := by rw ←inv_epsilon_eq_omega; exact inv_pos.2 epsilon_pos
+lemma epsilon_pos : 0 < ε := inv_pos_of_pos omega_pos
 
-lemma omega_ne_zero : ω ≠ 0 := ne_of_gt omega_pos
+lemma epsilon_ne_zero : ε ≠ 0 := epsilon_pos.ne'
+lemma omega_ne_zero : ω ≠ 0 := omega_pos.ne'
 
 theorem epsilon_mul_omega : ε * ω = 1 := @inv_mul_cancel _ _ ω omega_ne_zero
 
@@ -687,7 +681,7 @@ lemma is_st_inv {x : ℝ*} {r : ℝ} (hi : ¬ infinitesimal x) : is_st x r → i
 have H : _ := exists_st_of_not_infinite $ not_imp_not.mpr (infinitesimal_iff_infinite_inv h).mpr hi,
 Exists.cases_on H $ λ s hs,
 have H' : is_st 1 (r * s) := mul_inv_cancel h ▸ is_st_mul hxr hs,
-have H'' : s = r⁻¹ := one_div r ▸ eq_one_div_of_mul_eq_one (eq_of_is_st_real H').symm,
+have H'' : s = r⁻¹ := one_div r ▸ eq_one_div_of_mul_eq_one_right (eq_of_is_st_real H').symm,
 H'' ▸ hs
 
 lemma st_inv (x : ℝ*) : st x⁻¹ = (st x)⁻¹ :=
@@ -785,7 +779,29 @@ lemma infinite_mul_of_not_infinitesimal_infinite {x y : ℝ*} :
   ¬ infinitesimal x → infinite y → infinite (x * y) :=
 λ hx hy, by rw [mul_comm]; exact infinite_mul_of_infinite_not_infinitesimal hy hx
 
-lemma infinite_mul_infinite {x y : ℝ*} : infinite x → infinite y → infinite (x * y) :=
+lemma infinite.mul {x y : ℝ*} : infinite x → infinite y → infinite (x * y) :=
 λ hx hy, infinite_mul_of_infinite_not_infinitesimal hx (not_infinitesimal_of_infinite hy)
 
 end hyperreal
+
+namespace tactic
+open positivity
+
+private lemma hyperreal_coe_ne_zero {r : ℝ} : r ≠ 0 → (r : ℝ*) ≠ 0 := hyperreal.coe_ne_zero.2
+private lemma hyperreal_coe_nonneg {r : ℝ} : 0 ≤ r → 0 ≤ (r : ℝ*) := hyperreal.coe_nonneg.2
+private lemma hyperreal_coe_pos {r : ℝ} : 0 < r → 0 < (r : ℝ*) := hyperreal.coe_pos.2
+
+/-- Extension for the `positivity` tactic: cast from `ℝ` to `ℝ*`. -/
+@[positivity]
+meta def positivity_coe_real_hyperreal : expr → tactic strictness
+| `(@coe _ _ %%inst %%a) := do
+  unify inst `(@coe_to_lift _ _ hyperreal.has_coe_t),
+  strictness_a ← core a,
+  match strictness_a with
+  | positive p := positive <$> mk_app ``hyperreal_coe_pos [p]
+  | nonnegative p := nonnegative <$> mk_app ``hyperreal_coe_nonneg [p]
+  | nonzero p := nonzero <$> mk_app ``hyperreal_coe_ne_zero [p]
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression " " is not of the form `(r : ℝ*)` for `r : ℝ`"
+
+end tactic
diff --git a/src/data/real/irrational.lean b/src/data/real/irrational.lean
index ce41461f9adef..fadcdd66a722a 100644
--- a/src/data/real/irrational.lean
+++ b/src/data/real/irrational.lean
@@ -7,11 +7,13 @@ import data.real.sqrt
 import tactic.interval_cases
 import ring_theory.algebraic
 import data.rat.sqrt
-import data.polynomial.eval
 import ring_theory.int.basic
 /-!
 # Irrational real numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define a predicate `irrational` on `ℝ`, prove that the `n`-th root of an integer
 number is irrational if it is not integer, and that `sqrt q` is irrational if and only if
 `rat.sqrt q * rat.sqrt q ≠ q ∧ 0 ≤ q`.
@@ -134,7 +136,7 @@ by { rw ← rat.cast_coe_int, exact h.ne_rat _ }
 
 theorem ne_nat (h : irrational x) (m : ℕ) : x ≠ m := h.ne_int m
 
-theorem ne_zero (h : irrational x) : x ≠ 0 := h.ne_nat 0
+theorem ne_zero (h : irrational x) : x ≠ 0 := by exact_mod_cast h.ne_nat 0
 
 theorem ne_one (h : irrational x) : x ≠ 1 := by simpa only [nat.cast_one] using h.ne_nat 1
 
@@ -352,7 +354,7 @@ theorem of_pow : ∀ n : ℕ, irrational (x^n) → irrational x
 | (n+1) := λ h, by { rw pow_succ at h, exact h.mul_cases.elim id (of_pow n) }
 
 theorem of_zpow : ∀ m : ℤ, irrational (x^m) → irrational x
-| (n:ℕ) := of_pow n
+| (n:ℕ) := λ h, by { rw zpow_coe_nat at h, exact h.of_pow _ }
 | -[1+n] := λ h, by { rw zpow_neg_succ_of_nat at h, exact h.of_inv.of_pow _ }
 
 end irrational
@@ -360,7 +362,9 @@ end irrational
 section polynomial
 
 open polynomial
-variables (x : ℝ) (p : polynomial ℤ)
+open_locale polynomial
+
+variables (x : ℝ) (p : ℤ[X])
 
 lemma one_lt_nat_degree_of_irrational_root (hx : irrational x) (p_nonzero : p ≠ 0)
   (x_is_root : aeval x p = 0) : 1 < p.nat_degree :=
diff --git a/src/data/real/nnreal.lean b/src/data/real/nnreal.lean
index 59946ac4fb2c4..47dba7306a2d2 100644
--- a/src/data/real/nnreal.lean
+++ b/src/data/real/nnreal.lean
@@ -3,15 +3,20 @@ Copyright (c) 2018 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
-import algebra.big_operators.ring
-import data.real.basic
-import algebra.indicator_function
 import algebra.algebra.basic
-import algebra.order.nonneg
+import algebra.order.field.canonical.basic
+import algebra.order.nonneg.field
+import algebra.order.nonneg.floor
+import data.real.pointwise
+import order.conditionally_complete_lattice.group
+import tactic.positivity
 
 /-!
 # Nonnegative real numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `nnreal` (notation: `ℝ≥0`) to be the type of non-negative real numbers,
 a.k.a. the interval `[0, ∞)`. We also define the following operations and structures on `ℝ≥0`:
 
@@ -51,14 +56,15 @@ open_locale classical big_operators
 
 /-- Nonnegative real numbers. -/
 @[derive [
-  ordered_semiring, comm_monoid_with_zero, -- to ensure these instance are computable
-  floor_semiring,
-  semilattice_inf, densely_ordered, order_bot,
-  canonically_linear_ordered_add_monoid, linear_ordered_comm_group_with_zero, archimedean,
+  strict_ordered_semiring, comm_monoid_with_zero, -- to ensure these instances are computable
+  floor_semiring, comm_semiring, semiring,
+  semilattice_inf, semilattice_sup,
+  distrib_lattice, densely_ordered, order_bot,
+  canonically_linear_ordered_semifield, linear_ordered_comm_group_with_zero, archimedean,
   linear_ordered_semiring, ordered_comm_semiring, canonically_ordered_comm_semiring,
   has_sub, has_ordered_sub, has_div, inhabited]]
 def nnreal := {r : ℝ // 0 ≤ r}
-localized "notation ` ℝ≥0 ` := nnreal" in nnreal
+localized "notation (name := nnreal) `ℝ≥0` := nnreal" in nnreal
 
 namespace nnreal
 
@@ -67,10 +73,7 @@ instance : has_coe ℝ≥0 ℝ := ⟨subtype.val⟩
 /- Simp lemma to put back `n.val` into the normal form given by the coercion. -/
 @[simp] lemma val_eq_coe (n : ℝ≥0) : n.val = n := rfl
 
-instance : can_lift ℝ ℝ≥0 :=
-{ coe := coe,
-  cond := λ r, 0 ≤ r,
-  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }
+instance can_lift : can_lift ℝ ℝ≥0 coe (λ r, 0 ≤ r) := subtype.can_lift _
 
 protected lemma eq {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) → n = m := subtype.eq
 
@@ -92,6 +95,9 @@ noncomputable def _root_.real.to_nnreal (r : ℝ) : ℝ≥0 := ⟨max r 0, le_ma
 lemma _root_.real.coe_to_nnreal (r : ℝ) (hr : 0 ≤ r) : (real.to_nnreal r : ℝ) = r :=
 max_eq_left hr
 
+lemma _root_.real.to_nnreal_of_nonneg {r : ℝ} (hr : 0 ≤ r) : r.to_nnreal = ⟨r, hr⟩ :=
+by simp_rw [real.to_nnreal, max_eq_left hr]
+
 lemma _root_.real.le_coe_to_nnreal (r : ℝ) : r ≤ real.to_nnreal r :=
 le_max_left r 0
 
@@ -122,12 +128,12 @@ protected lemma coe_inv (r : ℝ≥0) : ((r⁻¹ : ℝ≥0) : ℝ) = r⁻¹ := r
 protected lemma coe_div (r₁ r₂ : ℝ≥0) : ((r₁ / r₂ : ℝ≥0) : ℝ) = r₁ / r₂ := rfl
 @[simp, norm_cast] protected lemma coe_bit0 (r : ℝ≥0) : ((bit0 r : ℝ≥0) : ℝ) = bit0 r := rfl
 @[simp, norm_cast] protected lemma coe_bit1 (r : ℝ≥0) : ((bit1 r : ℝ≥0) : ℝ) = bit1 r := rfl
+protected lemma coe_two : ((2 : ℝ≥0) : ℝ) = 2 := rfl
 
 @[simp, norm_cast] protected lemma coe_sub {r₁ r₂ : ℝ≥0} (h : r₂ ≤ r₁) :
   ((r₁ - r₂ : ℝ≥0) : ℝ) = r₁ - r₂ :=
-max_eq_left $ le_sub.2 $ by simp [show (r₂ : ℝ) ≤ r₁, from h]
+max_eq_left $ le_sub_comm.2 $ by simp [show (r₂ : ℝ) ≤ r₁, from h]
 
--- TODO: setup semifield!
 @[simp, norm_cast] protected lemma coe_eq_zero (r : ℝ≥0) : ↑r = (0 : ℝ) ↔ r = 0 :=
 by rw [← nnreal.coe_zero, nnreal.coe_eq]
 
@@ -153,15 +159,15 @@ mul_action.comp_hom M to_real_hom.to_monoid_hom
 lemma smul_def {M : Type*} [mul_action ℝ M] (c : ℝ≥0) (x : M) :
   c • x = (c : ℝ) • x := rfl
 
-instance {M N : Type*} [mul_action ℝ M] [mul_action ℝ N] [has_scalar M N]
+instance {M N : Type*} [mul_action ℝ M] [mul_action ℝ N] [has_smul M N]
   [is_scalar_tower ℝ M N] : is_scalar_tower ℝ≥0 M N :=
 { smul_assoc := λ r, (smul_assoc (r : ℝ) : _)}
 
-instance smul_comm_class_left {M N : Type*} [mul_action ℝ N] [has_scalar M N]
+instance smul_comm_class_left {M N : Type*} [mul_action ℝ N] [has_smul M N]
   [smul_comm_class ℝ M N] : smul_comm_class ℝ≥0 M N :=
 { smul_comm := λ r, (smul_comm (r : ℝ) : _)}
 
-instance smul_comm_class_right {M N : Type*} [mul_action ℝ N] [has_scalar M N]
+instance smul_comm_class_right {M N : Type*} [mul_action ℝ N] [has_smul M N]
   [smul_comm_class M ℝ N] : smul_comm_class M ℝ≥0 N :=
 { smul_comm := λ m r, (smul_comm m (r : ℝ) : _)}
 
@@ -271,15 +277,15 @@ noncomputable def gi : galois_insertion real.to_nnreal coe :=
 galois_insertion.monotone_intro nnreal.coe_mono real.to_nnreal_mono
   real.le_coe_to_nnreal (λ _, real.to_nnreal_coe)
 
--- note that anything involving the (decidability of the) linear order, including `⊔`/`⊓` (min, max)
+-- note that anything involving the (decidability of the) linear order,
 -- will be noncomputable, everything else should not be.
 example : order_bot ℝ≥0 := by apply_instance
 example : partial_order ℝ≥0 := by apply_instance
 noncomputable example : canonically_linear_ordered_add_monoid ℝ≥0 := by apply_instance
 noncomputable example : linear_ordered_add_comm_monoid ℝ≥0 := by apply_instance
-noncomputable example : distrib_lattice ℝ≥0 := by apply_instance
-noncomputable example : semilattice_inf ℝ≥0 := by apply_instance
-noncomputable example : semilattice_sup ℝ≥0 := by apply_instance
+example : distrib_lattice ℝ≥0 := by apply_instance
+example : semilattice_inf ℝ≥0 := by apply_instance
+example : semilattice_sup ℝ≥0 := by apply_instance
 noncomputable example : linear_ordered_semiring ℝ≥0 := by apply_instance
 example : ordered_comm_semiring ℝ≥0 := by apply_instance
 noncomputable example : linear_ordered_comm_monoid  ℝ≥0 := by apply_instance
@@ -289,6 +295,16 @@ example : canonically_ordered_comm_semiring ℝ≥0 := by apply_instance
 example : densely_ordered ℝ≥0 := by apply_instance
 example : no_max_order ℝ≥0 := by apply_instance
 
+/-- If `a` is a nonnegative real number, then the closed interval `[0, a]` in `ℝ` is order
+isomorphic to the interval `set.Iic a`. -/
+@[simps apply_coe_coe] def order_iso_Icc_zero_coe (a : ℝ≥0) : set.Icc (0 : ℝ) a ≃o set.Iic a :=
+{ to_equiv := equiv.set.sep (set.Ici 0) (λ x, x ≤ a),
+  map_rel_iff' := λ x y, iff.rfl }
+
+@[simp] lemma order_iso_Icc_zero_coe_symm_apply_coe (a : ℝ≥0) (b : set.Iic a) :
+  ((order_iso_Icc_zero_coe a).symm b : ℝ) = b :=
+rfl
+
 -- note we need the `@` to make the `has_mem.mem` have a sensible type
 lemma coe_image {s : set ℝ≥0} : coe '' s = {x : ℝ | ∃ h : 0 ≤ x, @has_mem.mem (ℝ≥0) _ _ ⟨x, h⟩ s} :=
 subtype.coe_image
@@ -316,9 +332,19 @@ by rw [supr, supr, coe_Sup, set.range_comp]
 eq.symm $ @subset_Inf_of_within ℝ (set.Ici 0) _ ⟨(0 : ℝ≥0)⟩ s $
   real.Inf_nonneg _ $ λ y ⟨x, _, hy⟩, hy ▸ x.2
 
+@[simp] lemma Inf_empty : Inf (∅ : set ℝ≥0) = 0 :=
+by rw [← nnreal.coe_eq_zero, coe_Inf, set.image_empty, real.Inf_empty]
+
 @[norm_cast] lemma coe_infi {ι : Sort*} (s : ι → ℝ≥0) : (↑(⨅ i, s i) : ℝ) = ⨅ i, (s i) :=
 by rw [infi, infi, coe_Inf, set.range_comp]
 
+lemma le_infi_add_infi {ι ι' : Sort*} [nonempty ι] [nonempty ι'] {f : ι → ℝ≥0} {g : ι' → ℝ≥0}
+  {a : ℝ≥0} (h : ∀ i j, a ≤ f i + g j) : a ≤ (⨅ i, f i) + ⨅ j, g j :=
+begin
+  rw [← nnreal.coe_le_coe, nnreal.coe_add, coe_infi, coe_infi],
+  exact le_cinfi_add_cinfi h
+end
+
 example : archimedean ℝ≥0 := by apply_instance
 
 -- TODO: why are these three instances necessary? why aren't they inferred?
@@ -331,19 +357,9 @@ ordered_cancel_add_comm_monoid.to_contravariant_class_left ℝ≥0
 instance covariant_mul : covariant_class ℝ≥0 ℝ≥0 (*) (≤) :=
 ordered_comm_monoid.to_covariant_class_left ℝ≥0
 
+-- Why isn't `nnreal.contravariant_add` inferred?
 lemma le_of_forall_pos_le_add {a b : ℝ≥0} (h : ∀ε, 0 < ε → a ≤ b + ε) : a ≤ b :=
-le_of_forall_le_of_dense $ assume x hxb,
-begin
-  rcases le_iff_exists_add.1 (le_of_lt hxb) with ⟨ε, rfl⟩,
-  exact h _ ((lt_add_iff_pos_right b).1 hxb)
-end
-
--- TODO: generalize to some ordered add_monoids, based on #6145
-lemma le_of_add_le_left {a b c : ℝ≥0} (h : a + b ≤ c) : a ≤ c :=
-by { refine le_trans _ h, exact (le_add_iff_nonneg_right _).mpr zero_le' }
-
-lemma le_of_add_le_right {a b c : ℝ≥0} (h : a + b ≤ c) : b ≤ c :=
-by { refine le_trans _ h, exact (le_add_iff_nonneg_left _).mpr zero_le' }
+@le_of_forall_pos_le_add _ _ _ _ _ _ nnreal.contravariant_add _ _ h
 
 lemma lt_iff_exists_rat_btwn (a b : ℝ≥0) :
   a < b ↔ (∃q:ℚ, 0 ≤ q ∧ a < real.to_nnreal q ∧ real.to_nnreal q < b) :=
@@ -412,6 +428,10 @@ to_nnreal_eq_zero.2
   real.to_nnreal r ≤ real.to_nnreal p ↔ r ≤ p :=
 by simp [nnreal.coe_le_coe.symm, real.to_nnreal, hp]
 
+@[simp] lemma to_nnreal_eq_to_nnreal_iff {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
+  real.to_nnreal r = real.to_nnreal p ↔ r = p :=
+by simp [← nnreal.coe_eq, coe_to_nnreal, hr, hp]
+
 @[simp] lemma to_nnreal_lt_to_nnreal_iff' {r p : ℝ} :
   real.to_nnreal r < real.to_nnreal p ↔ r < p ∧ 0 < p :=
 nnreal.coe_lt_coe.symm.trans max_lt_max_left_iff
@@ -463,13 +483,21 @@ begin
       contradiction } }
 end
 
-@[simp] lemma to_nnreal_bit0 {r : ℝ} (hr : 0 ≤ r) :
-  real.to_nnreal (bit0 r) = bit0 (real.to_nnreal r) :=
-real.to_nnreal_add hr hr
+@[simp] lemma to_nnreal_bit0 (r : ℝ) : real.to_nnreal (bit0 r) = bit0 (real.to_nnreal r) :=
+begin
+  cases le_total r 0 with hr hr,
+  { rw [to_nnreal_of_nonpos hr, to_nnreal_of_nonpos, bit0_zero],
+    exact add_nonpos hr hr },
+  { exact to_nnreal_add hr hr }
+end
 
 @[simp] lemma to_nnreal_bit1 {r : ℝ} (hr : 0 ≤ r) :
   real.to_nnreal (bit1 r) = bit1 (real.to_nnreal r) :=
-(real.to_nnreal_add (by simp [hr]) zero_le_one).trans (by simp [to_nnreal_one, bit1, hr])
+(real.to_nnreal_add (by simp [hr]) zero_le_one).trans (by simp [bit1])
+
+lemma to_nnreal_pow {x : ℝ} (hx : 0 ≤ x) (n : ℕ) : (x ^ n).to_nnreal = (x.to_nnreal) ^ n :=
+by rw [← nnreal.coe_eq, nnreal.coe_pow, real.coe_to_nnreal _ (pow_nonneg hx _),
+  real.coe_to_nnreal x hx]
 
 end to_nnreal
 
@@ -482,11 +510,7 @@ namespace nnreal
 section mul
 
 lemma mul_eq_mul_left {a b c : ℝ≥0} (h : a ≠ 0) : (a * b = a * c ↔ b = c) :=
-begin
-  rw [← nnreal.eq_iff, ← nnreal.eq_iff, nnreal.coe_mul, nnreal.coe_mul], split,
-  { exact mul_left_cancel₀ (mt (@nnreal.eq_iff a 0).1 h) },
-  { assume h, rw [h] }
-end
+by rw [mul_eq_mul_left_iff, or_iff_left h]
 
 lemma _root_.real.to_nnreal_mul {p q : ℝ} (hp : 0 ≤ p) :
   real.to_nnreal (p * q) = real.to_nnreal p * real.to_nnreal q :=
@@ -544,10 +568,9 @@ lemma sub_def {r p : ℝ≥0} : r - p = real.to_nnreal (r - p) := rfl
 
 lemma coe_sub_def {r p : ℝ≥0} : ↑(r - p) = max (r - p : ℝ) 0 := rfl
 
-noncomputable example : has_ordered_sub ℝ≥0 := by apply_instance
+example : has_ordered_sub ℝ≥0 := by apply_instance
 
-lemma sub_div (a b c : ℝ≥0) : (a - b) / c = a / c - b / c :=
-by simp only [div_eq_mul_inv, tsub_mul]
+lemma sub_div (a b c : ℝ≥0) : (a - b) / c = a / c - b / c := tsub_div _ _ _
 
 end sub
 
@@ -555,17 +578,7 @@ section inv
 
 lemma sum_div {ι} (s : finset ι) (f : ι → ℝ≥0) (b : ℝ≥0) :
   (∑ i in s, f i) / b = ∑ i in s, (f i / b) :=
-by simp only [div_eq_mul_inv, finset.sum_mul]
-
-@[simp] lemma inv_pos {r : ℝ≥0} : 0 < r⁻¹ ↔ 0 < r :=
-by simp [pos_iff_ne_zero]
-
-lemma div_pos {r p : ℝ≥0} (hr : 0 < r) (hp : 0 < p) : 0 < r / p :=
-by simpa only [div_eq_mul_inv] using mul_pos hr (inv_pos.2 hp)
-
-protected lemma mul_inv {r p : ℝ≥0} : (r * p)⁻¹ = p⁻¹ * r⁻¹ := nnreal.eq $ mul_inv_rev₀ _ _
-
-lemma div_self_le (r : ℝ≥0) : r / r ≤ 1 := div_self_le_one (r : ℝ)
+finset.sum_div
 
 @[simp] lemma inv_le {r p : ℝ≥0} (h : r ≠ 0) : r⁻¹ ≤ p ↔ 1 ≤ r * p :=
 by rw [← mul_le_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h]
@@ -581,13 +594,11 @@ by rw [← mul_lt_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]
 
 lemma mul_le_iff_le_inv {a b r : ℝ≥0} (hr : r ≠ 0) : r * a ≤ b ↔ a ≤ r⁻¹ * b :=
 have 0 < r, from lt_of_le_of_ne (zero_le r) hr.symm,
-by rw [← @mul_le_mul_left _ _ a _ r this, ← mul_assoc, mul_inv_cancel hr, one_mul]
+by rw [← mul_le_mul_left (inv_pos.mpr this), ← mul_assoc, inv_mul_cancel hr, one_mul]
 
-lemma le_div_iff_mul_le {a b r : ℝ≥0} (hr : r ≠ 0) : a ≤ b / r ↔ a * r ≤ b :=
-by rw [div_eq_inv_mul, ← mul_le_iff_le_inv hr, mul_comm]
+lemma le_div_iff_mul_le {a b r : ℝ≥0} (hr : r ≠ 0) : a ≤ b / r ↔ a * r ≤ b := le_div_iff₀ hr
 
-lemma div_le_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ b * r :=
-@div_le_iff ℝ _ a r b $ pos_iff_ne_zero.2 hr
+lemma div_le_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ b * r := div_le_iff₀ hr
 
 lemma div_le_iff' {a b r : ℝ≥0} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ r * b :=
 @div_le_iff' ℝ _ a r b $ pos_iff_ne_zero.2 hr
@@ -635,8 +646,7 @@ end
 
 lemma div_le_div_left {a b c : ℝ≥0} (a0 : 0 < a) (b0 : 0 < b) (c0 : 0 < c) :
   a / b ≤ a / c ↔ c ≤ b :=
-by rw [nnreal.div_le_iff b0.ne.symm, div_mul_eq_mul_div, nnreal.le_div_iff_mul_le c0.ne.symm,
-  mul_le_mul_left a0]
+div_le_div_left a0 b0 c0
 
 lemma le_of_forall_lt_one_mul_le {x y : ℝ≥0} (h : ∀a<1, a * x ≤ y) : x ≤ y :=
 le_of_forall_ge_of_dense $ assume a ha,
@@ -646,19 +656,9 @@ le_of_forall_ge_of_dense $ assume a ha,
   have (a * x⁻¹) * x ≤ y, from h _ this,
   by rwa [mul_assoc, inv_mul_cancel hx, mul_one] at this
 
-lemma div_add_div_same (a b c : ℝ≥0) : a / c + b / c = (a + b) / c :=
-eq.symm $ right_distrib a b (c⁻¹)
+lemma half_le_self (a : ℝ≥0) : a / 2 ≤ a := half_le_self bot_le
 
-lemma half_pos {a : ℝ≥0} (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two
-
-lemma add_halves (a : ℝ≥0) : a / 2 + a / 2 = a := nnreal.eq (add_halves a)
-
-lemma half_lt_self {a : ℝ≥0} (h : a ≠ 0) : a / 2 < a :=
-by rw [← nnreal.coe_lt_coe, nnreal.coe_div]; exact
-half_lt_self (bot_lt_iff_ne_bot.2 h)
-
-lemma two_inv_lt_one : (2⁻¹:ℝ≥0) < 1 :=
-by simpa using half_lt_self zero_ne_one.symm
+lemma half_lt_self {a : ℝ≥0} (h : a ≠ 0) : a / 2 < a := half_lt_self h.bot_lt
 
 lemma div_lt_one_of_lt {a b : ℝ≥0} (h : a < b) : a / b < 1 :=
 begin
@@ -666,22 +666,6 @@ begin
   exact ne_of_gt (lt_of_le_of_lt (zero_le _) h)
 end
 
-@[field_simps] lemma div_add_div (a : ℝ≥0) {b : ℝ≥0} (c : ℝ≥0) {d : ℝ≥0}
-  (hb : b ≠ 0) (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) :=
-begin
-  rw ← nnreal.eq_iff,
-  simp only [nnreal.coe_add, nnreal.coe_div, nnreal.coe_mul],
-  exact div_add_div _ _ (coe_ne_zero.2 hb) (coe_ne_zero.2 hd)
-end
-
-@[field_simps] lemma add_div' (a b c : ℝ≥0) (hc : c ≠ 0) :
-  b + a / c = (b * c + a) / c :=
-by simpa using div_add_div b a one_ne_zero hc
-
-@[field_simps] lemma div_add' (a b c : ℝ≥0) (hc : c ≠ 0) :
-  a / c + b = (a + b * c) / c :=
-by rwa [add_comm, add_div', add_comm]
-
 lemma _root_.real.to_nnreal_inv {x : ℝ} :
   real.to_nnreal x⁻¹ = (real.to_nnreal x)⁻¹ :=
 begin
@@ -703,9 +687,6 @@ by rw [div_eq_inv_mul, div_eq_inv_mul, real.to_nnreal_mul (inv_nonneg.2 hy), rea
 lemma inv_lt_one_iff {x : ℝ≥0} (hx : x ≠ 0) : x⁻¹ < 1 ↔ 1 < x :=
 by rwa [← one_div, div_lt_iff hx, one_mul]
 
-lemma inv_lt_one {x : ℝ≥0} (hx : 1 < x) : x⁻¹ < 1 :=
-(inv_lt_one_iff (zero_lt_one.trans hx).ne').2 hx
-
 lemma zpow_pos {x : ℝ≥0} (hx : x ≠ 0) (n : ℤ) : 0 < x ^ n :=
 begin
   cases n,
@@ -713,24 +694,118 @@ begin
   { simp [pow_pos hx.bot_lt _] }
 end
 
-lemma inv_lt_inv_iff {x y : ℝ≥0} (hx : x ≠ 0) (hy : y ≠ 0) :
-  y⁻¹ < x⁻¹ ↔ x < y :=
-by rw [← one_div, div_lt_iff hy, ← div_eq_inv_mul, lt_div_iff hx, one_mul]
-
 lemma inv_lt_inv {x y : ℝ≥0} (hx : x ≠ 0) (h : x < y) : y⁻¹ < x⁻¹ :=
-(inv_lt_inv_iff hx ((bot_le.trans_lt h).ne')).2 h
+inv_lt_inv_of_lt hx.bot_lt h
 
 end inv
 
 @[simp] lemma abs_eq (x : ℝ≥0) : |(x : ℝ)| = x :=
 abs_of_nonneg x.property
 
+section csupr
+open set
+
+variables {ι : Sort*} {f : ι → ℝ≥0}
+
+lemma le_to_nnreal_of_coe_le {x : ℝ≥0} {y : ℝ} (h : ↑x ≤ y) : x ≤ y.to_nnreal :=
+(le_to_nnreal_iff_coe_le $ x.2.trans h).2 h
+
+lemma Sup_of_not_bdd_above {s : set ℝ≥0} (hs : ¬bdd_above s) : has_Sup.Sup s = 0 :=
+begin
+  rw [← bdd_above_coe] at hs,
+  rw [← nnreal.coe_eq, coe_Sup],
+  exact Sup_of_not_bdd_above hs,
+end
+
+lemma supr_of_not_bdd_above (hf : ¬ bdd_above (range f)) : (⨆ i, f i) = 0 :=
+Sup_of_not_bdd_above hf
+
+lemma infi_empty [is_empty ι] (f : ι → ℝ≥0) : (⨅ i, f i) = 0 :=
+by { rw [← nnreal.coe_eq, coe_infi], exact real.cinfi_empty _, }
+
+@[simp] lemma infi_const_zero {α : Sort*} : (⨅ i : α, (0 : ℝ≥0)) = 0 :=
+by { rw [← nnreal.coe_eq, coe_infi], exact real.cinfi_const_zero, }
+
+lemma infi_mul (f : ι → ℝ≥0) (a : ℝ≥0)  : infi f * a = ⨅ i, f i * a :=
+begin
+  rw [← nnreal.coe_eq, nnreal.coe_mul, coe_infi, coe_infi],
+  exact real.infi_mul_of_nonneg (nnreal.coe_nonneg _) _,
+end
+
+lemma mul_infi (f : ι → ℝ≥0) (a : ℝ≥0) : a * infi f = ⨅ i, a * f i :=
+by simpa only [mul_comm] using infi_mul f a
+
+lemma mul_supr (f : ι → ℝ≥0) (a : ℝ≥0) : a * (⨆ i, f i) = ⨆ i, a * f i :=
+begin
+  rw [← nnreal.coe_eq, nnreal.coe_mul, nnreal.coe_supr, nnreal.coe_supr],
+  exact real.mul_supr_of_nonneg (nnreal.coe_nonneg _) _,
+end
+
+lemma supr_mul (f : ι → ℝ≥0) (a : ℝ≥0) : (⨆ i, f i) * a = ⨆ i, f i * a :=
+by { rw [mul_comm, mul_supr], simp_rw [mul_comm] }
+
+lemma supr_div (f : ι → ℝ≥0) (a : ℝ≥0) : (⨆ i, f i) / a = ⨆ i, f i / a :=
+by simp only [div_eq_mul_inv, supr_mul]
+
+variable [nonempty ι]
+
+lemma le_mul_infi {a : ℝ≥0} {g : ℝ≥0} {h : ι → ℝ≥0} (H : ∀ j, a ≤ g * h j) : a ≤ g * infi h :=
+by { rw [mul_infi], exact le_cinfi H }
+
+lemma mul_supr_le {a : ℝ≥0} {g : ℝ≥0} {h : ι → ℝ≥0} (H : ∀ j, g * h j ≤ a) : g * supr h ≤ a :=
+by { rw [mul_supr], exact csupr_le H }
+
+lemma le_infi_mul {a : ℝ≥0} {g : ι → ℝ≥0} {h : ℝ≥0} (H : ∀ i, a ≤ g i * h) : a ≤ infi g * h :=
+by { rw infi_mul, exact le_cinfi H }
+
+lemma supr_mul_le {a : ℝ≥0} {g : ι → ℝ≥0} {h : ℝ≥0} (H : ∀ i, g i * h ≤ a) : supr g * h ≤ a :=
+by { rw supr_mul, exact csupr_le H }
+
+lemma le_infi_mul_infi {a : ℝ≥0} {g h : ι → ℝ≥0} (H : ∀ i j, a ≤ g i * h j) :
+  a ≤ infi g * infi h :=
+le_infi_mul  $ λ i, le_mul_infi $ H i
+
+lemma supr_mul_supr_le {a : ℝ≥0} {g h : ι → ℝ≥0} (H : ∀ i j, g i * h j ≤ a) :
+  supr g * supr h ≤ a :=
+supr_mul_le $ λ i, mul_supr_le $ H _
+
+end csupr
+
 end nnreal
 
+namespace set
+namespace ord_connected
+
+variables {s : set ℝ} {t : set ℝ≥0}
+
+lemma preimage_coe_nnreal_real (h : s.ord_connected) : (coe ⁻¹' s : set ℝ≥0).ord_connected :=
+h.preimage_mono nnreal.coe_mono
+
+lemma image_coe_nnreal_real (h : t.ord_connected) : (coe '' t : set ℝ).ord_connected :=
+⟨ball_image_iff.2 $ λ x hx, ball_image_iff.2 $ λ y hy z hz,
+  ⟨⟨z, x.2.trans hz.1⟩, h.out hx hy hz, rfl⟩⟩
+
+lemma image_real_to_nnreal (h : s.ord_connected) : (real.to_nnreal '' s).ord_connected :=
+begin
+  refine ⟨ball_image_iff.2 $ λ x hx, ball_image_iff.2 $ λ y hy z hz, _⟩,
+  cases le_total y 0 with hy₀ hy₀,
+  { rw [mem_Icc, real.to_nnreal_of_nonpos hy₀, nonpos_iff_eq_zero] at hz,
+    exact ⟨y, hy, (to_nnreal_of_nonpos hy₀).trans hz.2.symm⟩ },
+  { lift y to ℝ≥0 using hy₀,
+    rw [to_nnreal_coe] at hz,
+    exact ⟨z, h.out hx hy ⟨to_nnreal_le_iff_le_coe.1 hz.1, hz.2⟩, to_nnreal_coe⟩ }
+end
+
+lemma preimage_real_to_nnreal (h : t.ord_connected) : (real.to_nnreal ⁻¹' t).ord_connected :=
+h.preimage_mono real.to_nnreal_mono
+
+end ord_connected
+end set
+
 namespace real
 
 /-- The absolute value on `ℝ` as a map to `ℝ≥0`. -/
-@[pp_nodot] noncomputable def nnabs : ℝ →*₀ ℝ≥0 :=
+@[pp_nodot] def nnabs : ℝ →*₀ ℝ≥0 :=
 { to_fun := λ x, ⟨|x|, abs_nonneg x⟩,
   map_zero' := by { ext, simp },
   map_one' := by { ext, simp },
@@ -742,11 +817,35 @@ rfl
 @[simp] lemma nnabs_of_nonneg {x : ℝ} (h : 0 ≤ x) : nnabs x = to_nnreal x :=
 by { ext, simp [coe_to_nnreal x h, abs_of_nonneg h] }
 
+lemma nnabs_coe (x : ℝ≥0) : nnabs x = x := by simp
+
 lemma coe_to_nnreal_le (x : ℝ) : (to_nnreal x : ℝ) ≤ |x| :=
 max_le (le_abs_self _) (abs_nonneg _)
 
+@[simp] lemma to_nnreal_abs (x : ℝ) : |x|.to_nnreal = x.nnabs := nnreal.coe_injective $ by simp
+
 lemma cast_nat_abs_eq_nnabs_cast (n : ℤ) :
   (n.nat_abs : ℝ≥0) = nnabs n :=
 by { ext, rw [nnreal.coe_nat_cast, int.cast_nat_abs, real.coe_nnabs] }
 
 end real
+
+namespace tactic
+open positivity
+
+private lemma nnreal_coe_pos {r : ℝ≥0} : 0 < r → 0 < (r : ℝ) := nnreal.coe_pos.2
+
+/-- Extension for the `positivity` tactic: cast from `ℝ≥0` to `ℝ`. -/
+@[positivity]
+meta def positivity_coe_nnreal_real : expr → tactic strictness
+| `(@coe _ _ %%inst %%a) := do
+  unify inst `(@coe_to_lift _ _ $ @coe_base _ _ nnreal.real.has_coe),
+  strictness_a ← core a,
+  match strictness_a with
+  | positive p := positive <$> mk_app ``nnreal_coe_pos [p]
+  | _ := nonnegative <$> mk_app ``nnreal.coe_nonneg [a]
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression "
+         " is not of the form `(r : ℝ)` for `r : ℝ≥0`"
+
+end tactic
diff --git a/src/data/real/pi/bounds.lean b/src/data/real/pi/bounds.lean
index f8fa98b37528d..2a6c704d82b90 100644
--- a/src/data/real/pi/bounds.lean
+++ b/src/data/real/pi/bounds.lean
@@ -8,6 +8,9 @@ import analysis.special_functions.trigonometric.bounds
 /-!
 # Pi
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains lemmas which establish bounds on `real.pi`.
 Notably, these include `pi_gt_sqrt_two_add_series` and `pi_lt_sqrt_two_add_series`,
 which bound `π` using series;
@@ -47,14 +50,14 @@ begin
       norm_num },
     rw ← le_div_iff,
     refine le_trans ((div_le_div_right _).mpr pi_le_four) _, apply pow_pos, norm_num,
-    rw [pow_succ, pow_succ, ←mul_assoc, ←div_div_eq_div_mul],
+    rw [pow_succ, pow_succ, ←mul_assoc, ←div_div],
     convert le_rfl,
     all_goals { repeat {apply pow_pos}, norm_num }},
   apply lt_of_lt_of_le this (le_of_eq _), rw [add_mul], congr' 1,
   { rw [pow_succ _ (n+1), ←mul_assoc, div_mul_cancel, mul_comm], norm_num },
   rw [pow_succ, ←pow_mul, mul_comm n 2, pow_mul, show (2 : ℝ) ^ 2 = 4, by norm_num, pow_succ,
       pow_succ, ←mul_assoc (2 : ℝ), show (2 : ℝ) * 2 = 4, by norm_num, ←mul_assoc, div_mul_cancel,
-      mul_comm ((2 : ℝ) ^ n), ←div_div_eq_div_mul, div_mul_cancel],
+      mul_comm ((2 : ℝ) ^ n), ←div_div, div_mul_cancel],
   apply pow_ne_zero, norm_num, norm_num
 end
 
@@ -66,7 +69,7 @@ theorem pi_lower_bound_start (n : ℕ) {a}
 begin
   refine lt_of_le_of_lt _ (pi_gt_sqrt_two_add_series n), rw [mul_comm],
   refine (div_le_iff (pow_pos (by norm_num) _ : (0 : ℝ) < _)).mp (le_sqrt_of_sq_le _),
-  rwa [le_sub, show (0:ℝ) = (0:ℕ)/(1:ℕ), by rw [nat.cast_zero, zero_div]],
+  rwa [le_sub_comm, show (0:ℝ) = (0:ℕ)/(1:ℕ), by rw [nat.cast_zero, zero_div]],
 end
 
 lemma sqrt_two_add_series_step_up (c d : ℕ) {a b n : ℕ} {z : ℝ}
@@ -102,7 +105,7 @@ theorem pi_upper_bound_start (n : ℕ) {a}
   (h₂ : 1 / 4 ^ n ≤ a) : π < a :=
 begin
   refine lt_of_lt_of_le (pi_lt_sqrt_two_add_series n) _,
-  rw [← le_sub_iff_add_le, ← le_div_iff', sqrt_le_left, sub_le],
+  rw [← le_sub_iff_add_le, ← le_div_iff', sqrt_le_left, sub_le_comm],
   { rwa [nat.cast_zero, zero_div] at h },
   { exact div_nonneg (sub_nonneg.2 h₂) (pow_nonneg (le_of_lt zero_lt_two) _) },
   { exact pow_pos zero_lt_two _ }
diff --git a/src/data/real/pi/leibniz.lean b/src/data/real/pi/leibniz.lean
index adb643d477827..7d26a16f6aa2b 100644
--- a/src/data/real/pi/leibniz.lean
+++ b/src/data/real/pi/leibniz.lean
@@ -5,13 +5,16 @@ Authors: Benjamin Davidson
 -/
 import analysis.special_functions.trigonometric.arctan_deriv
 
-/-! ### Leibniz's Series for Pi -/
+/-! ### Leibniz's Series for Pi 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
 
 namespace real
 
 open filter set
-open_locale classical big_operators topological_space real
-local notation `|`x`|` := abs x
+open_locale classical big_operators topology real
+local notation (name := abs) `|`x`|` := abs x
 
 /-- This theorem establishes **Leibniz's series for `π`**: The alternating sum of the reciprocals
   of the odd numbers is `π/4`. Note that this is a conditionally rather than absolutely convergent
@@ -49,7 +52,7 @@ begin
     { ext k,
       simp only [nnreal.coe_nat_cast, function.comp_app, nnreal.coe_rpow],
       rw [← rpow_mul (nat.cast_nonneg k) ((-1)/(2*(k:ℝ)+1)) (2*(k:ℝ)+1),
-         @div_mul_cancel _ _ _ (2*(k:ℝ)+1)
+         @div_mul_cancel _ _ (2*(k:ℝ)+1) _
             (by { norm_cast, simp only [nat.succ_ne_zero, not_false_iff] }), rpow_neg_one k,
           sub_eq_add_neg] },
     { simp only [add_zero, add_right_neg] } },
@@ -68,7 +71,7 @@ begin
   -- We show that `U` is indeed in [0,1]
   have hU1 : (U:ℝ) ≤ 1,
   { by_cases hk : k = 0,
-    { simpa only [U, hk] using zero_rpow_le_one _ },
+    { simp [u, U, hk] },
     { exact rpow_le_one_of_one_le_of_nonpos (by { norm_cast, exact nat.succ_le_iff.mpr
         (nat.pos_of_ne_zero hk) }) (le_of_lt (@div_neg_of_neg_of_pos _ _ (-(1:ℝ)) (2*k+1)
           (neg_neg_iff_pos.mpr zero_lt_one) (by { norm_cast, exact nat.succ_pos' }))) } },
@@ -86,13 +89,13 @@ begin
         ring },
       { simp only [nat.add_succ_sub_one, add_zero, mul_one, id.def, nat.cast_bit0, nat.cast_add,
                   nat.cast_one, nat.cast_mul],
-        rw [← mul_assoc, @div_mul_cancel _ _ _ (2*(i:ℝ)+1) (by { norm_cast, linarith }),
+        rw [← mul_assoc, @div_mul_cancel _ _ (2*(i:ℝ)+1) _ (by { norm_cast, linarith }),
             pow_mul x 2 i, ← mul_pow (-1) (x^2) i],
         ring_nf } },
     convert (has_deriv_at_arctan x).sub (has_deriv_at.sum has_deriv_at_b),
     have g_sum :=
       @geom_sum_eq _ _ (-x^2) ((neg_nonpos.mpr (sq_nonneg x)).trans_lt zero_lt_one).ne k,
-    simp only [geom_sum, f'] at g_sum ⊢,
+    simp only [f'] at g_sum ⊢,
     rw [g_sum, ← neg_add' (x^2) 1, add_comm (x^2) 1, sub_eq_add_neg, neg_div', neg_div_neg_eq],
     ring },
   have hderiv1 : ∀ x ∈ Icc (U:ℝ) 1, has_deriv_within_at f (f' x) (Icc (U:ℝ) 1) x :=
diff --git a/src/data/real/pi/wallis.lean b/src/data/real/pi/wallis.lean
index 86f0095999940..8869286478aa2 100644
--- a/src/data/real/pi/wallis.lean
+++ b/src/data/real/pi/wallis.lean
@@ -5,80 +5,121 @@ Authors: Hanting Zhang
 -/
 import analysis.special_functions.integrals
 
-/-! ### The Wallis Product for Pi -/
+/-! # The Wallis formula for Pi
 
-namespace real
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file establishes the Wallis product for `π` (`real.tendsto_prod_pi_div_two`). Our proof is
+largely about analyzing the behaviour of the sequence `∫ x in 0..π, sin x ^ n` as `n → ∞`.
+See: https://en.wikipedia.org/wiki/Wallis_product
+
+The proof can be broken down into two pieces. The first step (carried out in
+`analysis.special_functions.integrals`) is to use repeated integration by parts to obtain an
+explicit formula for this integral, which is rational if `n` is odd and a rational multiple of `π`
+if `n` is even.
+
+The second step, carried out here, is to estimate the ratio
+`∫ (x : ℝ) in 0..π, sin x ^ (2 * k + 1) / ∫ (x : ℝ) in 0..π, sin x ^ (2 * k)` and prove that
+it converges to one using the squeeze theorem. The final product for `π` is obtained after some
+algebraic manipulation.
 
-open_locale real topological_space big_operators
+## Main statements
+
+* `real.wallis.W`: the product of the first `k` terms in Wallis' formula for `π`.
+* `real.wallis.W_eq_integral_sin_pow_div_integral_sin_pow`: express `W n` as a ratio of integrals.
+* `real.wallis.W_le` and `real.wallis.le_W`: upper and lower bounds for `W n`.
+* `real.tendsto_prod_pi_div_two`: the Wallis product formula.
+ -/
+
+open_locale real topology big_operators nat
 open filter finset interval_integral
 
-lemma integral_sin_pow_div_tendsto_one :
-  tendsto (λ k, (∫ x in 0..π, sin x ^ (2 * k + 1)) / ∫ x in 0..π, sin x ^ (2 * k)) at_top (𝓝 1) :=
+namespace real
+
+namespace wallis
+
+/-- The product of the first `k` terms in Wallis' formula for `π`. -/
+noncomputable def W (k : ℕ) : ℝ :=
+∏ i in range k, (2 * i + 2) / (2 * i + 1) * ((2 * i + 2) / (2 * i + 3))
+
+lemma W_succ (k : ℕ) :
+  W (k + 1) = W k * ((2 * k + 2) / (2 * k + 1) * ((2 * k + 2) / (2 * k + 3))) :=
+prod_range_succ _ _
+
+lemma W_pos (k : ℕ) : 0 < W k :=
 begin
-  have h₃ : ∀ n, (∫ x in 0..π, sin x ^ (2 * n + 1)) / ∫ x in 0..π, sin x ^ (2 * n) ≤ 1 :=
-    λ n, (div_le_one (integral_sin_pow_pos _)).mpr (integral_sin_pow_succ_le _),
-  have h₄ :
-    ∀ n, (∫ x in 0..π, sin x ^ (2 * n + 1)) / ∫ x in 0..π, sin x ^ (2 * n) ≥ 2 * n / (2 * n + 1),
-  { rintro ⟨n⟩,
-    { have : 0 ≤ (1 + 1) / π, exact div_nonneg (by norm_num) pi_pos.le,
-      simp [this] },
-    calc (∫ x in 0..π, sin x ^ (2 * n.succ + 1)) / ∫ x in 0..π, sin x ^ (2 * n.succ) ≥
-      (∫ x in 0..π, sin x ^ (2 * n.succ + 1)) / ∫ x in 0..π, sin x ^ (2 * n + 1) :
-      by { refine div_le_div (integral_sin_pow_pos _).le le_rfl (integral_sin_pow_pos _) _,
-        convert integral_sin_pow_succ_le (2 * n + 1) using 1 }
-    ... = 2 * ↑(n.succ) / (2 * ↑(n.succ) + 1) :
-      by { rw div_eq_iff (integral_sin_pow_pos (2 * n + 1)).ne',
-           convert integral_sin_pow (2 * n + 1), simp with field_simps, norm_cast } },
-  refine tendsto_of_tendsto_of_tendsto_of_le_of_le _ _ (λ n, (h₄ n).le) (λ n, (h₃ n)),
-  { refine metric.tendsto_at_top.mpr (λ ε hε, ⟨⌈1 / ε⌉₊, λ n hn, _⟩),
-    have h : (2:ℝ) * n / (2 * n + 1) - 1 = -1 / (2 * n + 1),
-    { conv_lhs { congr, skip, rw ← @div_self _ _ ((2:ℝ) * n + 1) (by { norm_cast, linarith }), },
-      rw [← sub_div, ← sub_sub, sub_self, zero_sub] },
-    have hpos : (0:ℝ) < 2 * n + 1, { norm_cast, norm_num },
-    rw [dist_eq, h, abs_div, abs_neg, abs_one, abs_of_pos hpos, one_div_lt hpos hε],
-    calc 1 / ε ≤ ⌈1 / ε⌉₊ : nat.le_ceil _
-          ... ≤ n : by exact_mod_cast hn.le
-          ... < 2 * n + 1 : by { norm_cast, linarith } },
-  { exact tendsto_const_nhds },
+  induction k with k hk,
+  { unfold W, simp },
+  { rw W_succ,
+    refine mul_pos hk (mul_pos (div_pos _ _) (div_pos _ _));
+    positivity }
 end
 
-/-- This theorem establishes the Wallis Product for `π`. Our proof is largely about analyzing
-  the behavior of the ratio of the integral of `sin x ^ n` as `n → ∞`.
-  See: https://en.wikipedia.org/wiki/Wallis_product
-
-  The proof can be broken down into two pieces.
-  (Pieces involving general properties of the integral of `sin x ^n` can be found
-  in `analysis.special_functions.integrals`.) First, we use integration by parts to obtain a
-  recursive formula for `∫ x in 0..π, sin x ^ (n + 2)` in terms of `∫ x in 0..π, sin x ^ n`.
-  From this we can obtain closed form products of `∫ x in 0..π, sin x ^ (2 * n)` and
-  `∫ x in 0..π, sin x ^ (2 * n + 1)` via induction. Next, we study the behavior of the ratio
-  `∫ (x : ℝ) in 0..π, sin x ^ (2 * k + 1)) / ∫ (x : ℝ) in 0..π, sin x ^ (2 * k)` and prove that
-  it converges to one using the squeeze theorem. The final product for `π` is obtained after some
-  algebraic manipulation. -/
-theorem tendsto_prod_pi_div_two :
-  tendsto (λ k, ∏ i in range k,
-    (((2:ℝ) * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3))) at_top (𝓝 (π/2)) :=
+lemma W_eq_factorial_ratio (n : ℕ) :
+  W n = (2 ^ (4 * n) * n! ^ 4) / ((2 * n)!^ 2 * (2 * n + 1)) :=
 begin
-  suffices h : tendsto (λ k, 2 / π  * ∏ i in range k,
-    (((2:ℝ) * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3))) at_top (𝓝 1),
-  { have := tendsto.const_mul (π / 2) h,
-    have h : π / 2 ≠ 0, norm_num [pi_ne_zero],
-    simp only [← mul_assoc, ← @inv_div _ _ π 2, mul_inv_cancel h, one_mul, mul_one] at this,
-    exact this },
-  have h : (λ (k : ℕ), (2:ℝ) / π * ∏ (i : ℕ) in range k,
-    ((2 * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3))) =
-  λ k, (2 * ∏ i in range k,
-    (2 * i + 2) / (2 * i + 3)) / (π * ∏ (i : ℕ) in range k, (2 * i + 1) / (2 * i + 2)),
-  { funext,
-    have h : ∏ (i : ℕ) in range k, ((2:ℝ) * ↑i + 2) / (2 * ↑i + 1) =
-      1 / (∏ (i : ℕ) in range k, (2 * ↑i + 1) / (2 * ↑i + 2)),
-    { rw [one_div, ← finset.prod_inv_distrib'],
-      refine prod_congr rfl (λ x hx, _),
-      field_simp },
-    rw [prod_mul_distrib, h],
-    field_simp },
-  simp only [h, ← integral_sin_pow_even, ← integral_sin_pow_odd],
-  exact integral_sin_pow_div_tendsto_one,
+  induction n with n IH,
+  { simp only [W, prod_range_zero, nat.factorial_zero, mul_zero, pow_zero, algebra_map.coe_one,
+      one_pow, mul_one, algebra_map.coe_zero, zero_add, div_self, ne.def, one_ne_zero,
+      not_false_iff] },
+  { unfold W at ⊢ IH,
+    rw [prod_range_succ, IH, _root_.div_mul_div_comm, _root_.div_mul_div_comm],
+    refine (div_eq_div_iff _ _).mpr _,
+    any_goals { exact ne_of_gt (by positivity) },
+    simp_rw [nat.mul_succ, nat.factorial_succ, pow_succ],
+    push_cast,
+    ring_nf }
 end
 
+lemma W_eq_integral_sin_pow_div_integral_sin_pow (k : ℕ) :
+  (π/2)⁻¹ * W k = (∫ (x : ℝ) in 0..π, sin x ^ (2 * k + 1)) / ∫ (x : ℝ) in 0..π, sin x ^ (2 * k) :=
+begin
+  rw [integral_sin_pow_even, integral_sin_pow_odd, mul_div_mul_comm, ←prod_div_distrib, inv_div],
+  simp_rw [div_div_div_comm, div_div_eq_mul_div, mul_div_assoc],
+  refl,
+end
+
+lemma W_le (k : ℕ) : W k ≤ π / 2 :=
+begin
+  rw [←div_le_one pi_div_two_pos, div_eq_inv_mul],
+  rw [W_eq_integral_sin_pow_div_integral_sin_pow, div_le_one (integral_sin_pow_pos _)],
+  apply integral_sin_pow_succ_le,
+end
+
+lemma le_W (k : ℕ) : ((2:ℝ) * k + 1) / (2 * k + 2) * (π / 2) ≤ W k :=
+begin
+  rw [←le_div_iff pi_div_two_pos, div_eq_inv_mul (W k) _],
+  rw [W_eq_integral_sin_pow_div_integral_sin_pow, le_div_iff (integral_sin_pow_pos _)],
+  convert integral_sin_pow_succ_le (2 * k + 1),
+  rw integral_sin_pow (2 * k),
+  simp only [sin_zero, zero_pow', ne.def, nat.succ_ne_zero, not_false_iff, zero_mul, sin_pi,
+    tsub_zero, nat.cast_mul, nat.cast_bit0, algebra_map.coe_one, zero_div, zero_add],
+end
+
+lemma tendsto_W_nhds_pi_div_two : tendsto W at_top (𝓝 $ π / 2) :=
+begin
+  refine tendsto_of_tendsto_of_tendsto_of_le_of_le _ tendsto_const_nhds le_W W_le,
+  have : 𝓝 (π / 2) = 𝓝 ((1 - 0) * (π / 2)), by rw [sub_zero, one_mul], rw this,
+  refine tendsto.mul _ tendsto_const_nhds,
+  have h : ∀ (n:ℕ), ((2:ℝ) * n + 1) / (2 * n + 2) = 1 - 1 / (2 * n + 2),
+  { intro n,
+    rw [sub_div' _ _ _ (ne_of_gt (add_pos_of_nonneg_of_pos
+      (mul_nonneg ((two_pos : 0 < (2:ℝ)).le) (nat.cast_nonneg _)) two_pos)), one_mul],
+    congr' 1, ring },
+  simp_rw h,
+  refine (tendsto_const_nhds.div_at_top _).const_sub _,
+  refine tendsto.at_top_add _ tendsto_const_nhds,
+  exact tendsto_coe_nat_at_top_at_top.const_mul_at_top two_pos
+end
+
+end wallis
+
 end real
+
+/-- Wallis' product formula for `π / 2`. -/
+theorem real.tendsto_prod_pi_div_two :
+  tendsto
+  (λ k, ∏ i in range k, (((2:ℝ) * i + 2) / (2 * i + 1)) * ((2 * i + 2) / (2 * i + 3)))
+  at_top (𝓝 (π/2)) :=
+real.wallis.tendsto_W_nhds_pi_div_two
diff --git a/src/data/real/pointwise.lean b/src/data/real/pointwise.lean
index ba7b6512dacc0..98e07256f07b9 100644
--- a/src/data/real/pointwise.lean
+++ b/src/data/real/pointwise.lean
@@ -9,6 +9,9 @@ import data.real.basic
 /-!
 # Pointwise operations on sets of reals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file relates `Inf (a • s)`/`Sup (a • s)` with `a • Inf s`/`a • Sup s` for `s : set ℝ`.
 
 From these, it relates `⨅ i, a • f i` / `⨆ i, a • f i` with `a • (⨅ i, f i)` / `a • (⨆ i, f i)`,
@@ -31,14 +34,14 @@ variables [mul_action_with_zero α ℝ] [ordered_smul α ℝ] {a : α}
 lemma real.Inf_smul_of_nonneg (ha : 0 ≤ a) (s : set ℝ) : Inf (a • s) = a • Inf s :=
 begin
   obtain rfl | hs := s.eq_empty_or_nonempty,
-  { rw [smul_set_empty, real.Inf_empty, smul_zero'] },
+  { rw [smul_set_empty, real.Inf_empty, smul_zero] },
   obtain rfl | ha' := ha.eq_or_lt,
   { rw [zero_smul_set hs, zero_smul],
     exact cInf_singleton 0 },
   by_cases bdd_below s,
   { exact ((order_iso.smul_left ℝ ha').map_cInf' hs h).symm },
   { rw [real.Inf_of_not_bdd_below (mt (bdd_below_smul_iff_of_pos ha').1 h),
-      real.Inf_of_not_bdd_below h, smul_zero'] }
+      real.Inf_of_not_bdd_below h, smul_zero] }
 end
 
 lemma real.smul_infi_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
@@ -48,14 +51,14 @@ lemma real.smul_infi_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
 lemma real.Sup_smul_of_nonneg (ha : 0 ≤ a) (s : set ℝ) : Sup (a • s) = a • Sup s :=
 begin
   obtain rfl | hs := s.eq_empty_or_nonempty,
-  { rw [smul_set_empty, real.Sup_empty, smul_zero'] },
+  { rw [smul_set_empty, real.Sup_empty, smul_zero] },
   obtain rfl | ha' := ha.eq_or_lt,
   { rw [zero_smul_set hs, zero_smul],
     exact cSup_singleton 0 },
   by_cases bdd_above s,
   { exact ((order_iso.smul_left ℝ ha').map_cSup' hs h).symm },
   { rw [real.Sup_of_not_bdd_above (mt (bdd_above_smul_iff_of_pos ha').1 h),
-      real.Sup_of_not_bdd_above h, smul_zero'] }
+      real.Sup_of_not_bdd_above h, smul_zero] }
 end
 
 lemma real.smul_supr_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
@@ -70,14 +73,14 @@ variables [module α ℝ] [ordered_smul α ℝ] {a : α}
 lemma real.Inf_smul_of_nonpos (ha : a ≤ 0) (s : set ℝ) : Inf (a • s) = a • Sup s :=
 begin
   obtain rfl | hs := s.eq_empty_or_nonempty,
-  { rw [smul_set_empty, real.Inf_empty, real.Sup_empty, smul_zero'] },
+  { rw [smul_set_empty, real.Inf_empty, real.Sup_empty, smul_zero] },
   obtain rfl | ha' := ha.eq_or_lt,
   { rw [zero_smul_set hs, zero_smul],
     exact cInf_singleton 0 },
   by_cases bdd_above s,
   { exact ((order_iso.smul_left_dual ℝ ha').map_cSup' hs h).symm },
   { rw [real.Inf_of_not_bdd_below (mt (bdd_below_smul_iff_of_neg ha').1 h),
-      real.Sup_of_not_bdd_above h, smul_zero'] }
+      real.Sup_of_not_bdd_above h, smul_zero] }
 end
 
 lemma real.smul_supr_of_nonpos (ha : a ≤ 0) (f : ι → ℝ) :
diff --git a/src/data/real/sign.lean b/src/data/real/sign.lean
index eca1c6d1892b1..34f156eb1119a 100644
--- a/src/data/real/sign.lean
+++ b/src/data/real/sign.lean
@@ -8,6 +8,9 @@ import data.real.basic
 /-!
 # Real sign function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file introduces and contains some results about `real.sign` which maps negative
 real numbers to -1, positive real numbers to 1, and 0 to 0.
 
diff --git a/src/data/real/sqrt.lean b/src/data/real/sqrt.lean
index 6b2e10cf95d46..c3ae85a902843 100644
--- a/src/data/real/sqrt.lean
+++ b/src/data/real/sqrt.lean
@@ -3,13 +3,17 @@ Copyright (c) 2020 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Floris van Doorn, Yury Kudryashov
 -/
+import algebra.star.order
 import topology.algebra.order.monotone_continuity
 import topology.instances.nnreal
-import tactic.norm_cast
+import tactic.positivity
 
 /-!
 # Square root of a real number
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define
 
 * `nnreal.sqrt` to be the square root of a nonnegative real number.
@@ -22,7 +26,7 @@ Then we prove some basic properties of these functions.
 We define `nnreal.sqrt` as the noncomputable inverse to the function `x ↦ x * x`. We use general
 theory of inverses of strictly monotone functions to prove that `nnreal.sqrt x` exists. As a side
 effect, `nnreal.sqrt` is a bundled `order_iso`, so for `nnreal` numbers we get continuity as well as
-theorems like `sqrt x ≤ y ↔ x * x ≤ y` for free.
+theorems like `sqrt x ≤ y ↔ x ≤ y * y` for free.
 
 Then we define `real.sqrt x` to be `nnreal.sqrt (real.to_nnreal x)`. We also define a Cauchy
 sequence `real.sqrt_aux (f : cau_seq ℚ abs)` which converges to `sqrt (mk f)` but do not prove (yet)
@@ -34,7 +38,7 @@ square root
 -/
 
 open set filter
-open_locale filter nnreal topological_space
+open_locale filter nnreal topology
 
 namespace nnreal
 
@@ -42,10 +46,7 @@ variables {x y : ℝ≥0}
 
 /-- Square root of a nonnegative real number. -/
 @[pp_nodot] noncomputable def sqrt : ℝ≥0 ≃o ℝ≥0 :=
-order_iso.symm $ strict_mono.order_iso_of_surjective (λ x, x * x)
-  (λ x y h, mul_self_lt_mul_self x.2 h) $
-  (continuous_id.mul continuous_id).surjective tendsto_mul_self_at_top $
-    by simp [order_bot.at_bot_eq]
+order_iso.symm $ pow_order_iso 2 two_ne_zero
 
 lemma sqrt_le_sqrt_iff : sqrt x ≤ sqrt y ↔ x ≤ y :=
 sqrt.le_iff_le
@@ -53,42 +54,34 @@ sqrt.le_iff_le
 lemma sqrt_lt_sqrt_iff : sqrt x < sqrt y ↔ x < y :=
 sqrt.lt_iff_lt
 
-lemma sqrt_eq_iff_sq_eq : sqrt x = y ↔ y * y = x :=
+lemma sqrt_eq_iff_sq_eq : sqrt x = y ↔ y ^ 2 = x :=
 sqrt.to_equiv.apply_eq_iff_eq_symm_apply.trans eq_comm
 
-lemma sqrt_le_iff : sqrt x ≤ y ↔ x ≤ y * y :=
+lemma sqrt_le_iff : sqrt x ≤ y ↔ x ≤ y ^ 2 :=
 sqrt.to_galois_connection _ _
 
-lemma le_sqrt_iff : x ≤ sqrt y ↔ x * x ≤ y :=
+lemma le_sqrt_iff : x ≤ sqrt y ↔ x ^ 2 ≤ y :=
 (sqrt.symm.to_galois_connection _ _).symm
 
 @[simp] lemma sqrt_eq_zero : sqrt x = 0 ↔ x = 0 :=
-sqrt_eq_iff_sq_eq.trans $ by rw [eq_comm, zero_mul]
+sqrt_eq_iff_sq_eq.trans $ by rw [eq_comm, sq, zero_mul]
 
 @[simp] lemma sqrt_zero : sqrt 0 = 0 := sqrt_eq_zero.2 rfl
-
-@[simp] lemma sqrt_one : sqrt 1 = 1 := sqrt_eq_iff_sq_eq.2 $ mul_one 1
-
-@[simp] lemma mul_self_sqrt (x : ℝ≥0) : sqrt x * sqrt x = x :=
-sqrt.symm_apply_apply x
-
-@[simp] lemma sqrt_mul_self (x : ℝ≥0) : sqrt (x * x) = x := sqrt.apply_symm_apply x
-
-@[simp] lemma sq_sqrt (x : ℝ≥0) : (sqrt x)^2 = x :=
-by rw [sq, mul_self_sqrt x]
-
-@[simp] lemma sqrt_sq (x : ℝ≥0) : sqrt (x^2) = x :=
-by rw [sq, sqrt_mul_self x]
+@[simp] lemma sqrt_one : sqrt 1 = 1 := sqrt_eq_iff_sq_eq.2 $ one_pow _
+@[simp] lemma sq_sqrt (x : ℝ≥0) : (sqrt x)^2 = x := sqrt.symm_apply_apply x
+@[simp] lemma mul_self_sqrt (x : ℝ≥0) : sqrt x * sqrt x = x := by rw [← sq, sq_sqrt]
+@[simp] lemma sqrt_sq (x : ℝ≥0) : sqrt (x^2) = x := sqrt.apply_symm_apply x
+@[simp] lemma sqrt_mul_self (x : ℝ≥0) : sqrt (x * x) = x := by rw [← sq, sqrt_sq x]
 
 lemma sqrt_mul (x y : ℝ≥0) : sqrt (x * y) = sqrt x * sqrt y :=
-by rw [sqrt_eq_iff_sq_eq, mul_mul_mul_comm, mul_self_sqrt, mul_self_sqrt]
+by rw [sqrt_eq_iff_sq_eq, mul_pow, sq_sqrt, sq_sqrt]
 
 /-- `nnreal.sqrt` as a `monoid_with_zero_hom`. -/
 noncomputable def sqrt_hom : ℝ≥0 →*₀ ℝ≥0 := ⟨sqrt, sqrt_zero, sqrt_one, sqrt_mul⟩
 
-lemma sqrt_inv (x : ℝ≥0) : sqrt (x⁻¹) = (sqrt x)⁻¹ := sqrt_hom.map_inv x
+lemma sqrt_inv (x : ℝ≥0) : sqrt (x⁻¹) = (sqrt x)⁻¹ := map_inv₀ sqrt_hom x
 
-lemma sqrt_div (x y : ℝ≥0) : sqrt (x / y) = sqrt x / sqrt y := sqrt_hom.map_div x y
+lemma sqrt_div (x y : ℝ≥0) : sqrt (x / y) = sqrt x / sqrt y := map_div₀ sqrt_hom x y
 
 lemma continuous_sqrt : continuous sqrt := sqrt.continuous
 
@@ -116,9 +109,8 @@ begin
   { exact this.imp (λ h e, ⟨x, x0, hx, e⟩) },
   apply of_near,
 
-  suffices : ∃ δ > 0, ∀ i, abs (↑(sqrt_aux f i) - x) < δ / 2 ^ i,
-  { rcases this with ⟨δ, δ0, hδ⟩,
-    intros }
+  rsuffices ⟨δ, δ0, hδ⟩ : ∃ δ > 0, ∀ i, abs (↑(sqrt_aux f i) - x) < δ / 2 ^ i,
+  { intros }
 end -/
 
 /-- The square root of a real number. This returns 0 for negative inputs. -/
@@ -214,7 +206,7 @@ theorem sqrt_lt_sqrt (hx : 0 ≤ x) (h : x < y) : sqrt x < sqrt y :=
 (sqrt_lt_sqrt_iff hx).2 h
 
 theorem sqrt_le_left (hy : 0 ≤ y) : sqrt x ≤ y ↔ x ≤ y ^ 2 :=
-by rw [sqrt, ← real.le_to_nnreal_iff_coe_le hy, nnreal.sqrt_le_iff, ← real.to_nnreal_mul hy,
+by rw [sqrt, ← real.le_to_nnreal_iff_coe_le hy, nnreal.sqrt_le_iff, sq, ← real.to_nnreal_mul hy,
   real.to_nnreal_le_to_nnreal_iff (mul_self_nonneg y), sq]
 
 theorem sqrt_le_iff : sqrt x ≤ y ↔ 0 ≤ y ∧ x ≤ y ^ 2 :=
@@ -272,6 +264,24 @@ by rw [← not_le, not_iff_not, sqrt_eq_zero']
 lt_iff_lt_of_le_iff_le (iff.trans
   (by simp [le_antisymm_iff, sqrt_nonneg]) sqrt_eq_zero')
 
+alias sqrt_pos ↔ _ sqrt_pos_of_pos
+
+section
+open tactic tactic.positivity
+
+/-- Extension for the `positivity` tactic: a square root is nonnegative, and is strictly positive if
+its input is. -/
+@[positivity]
+meta def _root_.tactic.positivity_sqrt : expr → tactic strictness
+| `(real.sqrt %%a) := do
+  (do -- if can prove `0 < a`, report positivity
+    positive pa ← core a,
+    positive <$> mk_app ``sqrt_pos_of_pos [pa]) <|>
+  nonnegative <$> mk_app ``sqrt_nonneg [a] -- else report nonnegativity
+| _ := failed
+
+end
+
 @[simp] theorem sqrt_mul (hx : 0 ≤ x) (y : ℝ) : sqrt (x * y) = sqrt x * sqrt y :=
 by simp_rw [sqrt, ← nnreal.coe_mul, nnreal.coe_eq, real.to_nnreal_mul hx, nnreal.sqrt_mul]
 
@@ -284,6 +294,9 @@ by rw [sqrt, real.to_nnreal_inv, nnreal.sqrt_inv, nnreal.coe_inv, sqrt]
 @[simp] theorem sqrt_div (hx : 0 ≤ x) (y : ℝ) : sqrt (x / y) = sqrt x / sqrt y :=
 by rw [division_def, sqrt_mul hx, sqrt_inv, division_def]
 
+@[simp] theorem sqrt_div' (x) {y : ℝ} (hy : 0 ≤ y) : sqrt (x / y) = sqrt x / sqrt y :=
+by rw [division_def, sqrt_mul' x (inv_nonneg.2 hy), sqrt_inv, division_def]
+
 @[simp] theorem div_sqrt : x / sqrt x = sqrt x :=
 begin
   cases le_or_lt x 0,
@@ -306,6 +319,10 @@ theorem neg_sqrt_lt_of_sq_lt (h : x^2 < y) : -sqrt y < x := (sq_lt.mp h).1
 
 theorem lt_sqrt_of_sq_lt (h : x^2 < y) : x < sqrt y := (sq_lt.mp h).2
 
+lemma lt_sq_of_sqrt_lt {x y : ℝ} (h : sqrt x < y) : x < y ^ 2 :=
+by { have hy := x.sqrt_nonneg.trans_lt h,
+  rwa [←sqrt_lt_sqrt_iff_of_pos (sq_pos_of_pos hy), sqrt_sq hy.le] }
+
 /-- The natural square root is at most the real square root -/
 lemma nat_sqrt_le_real_sqrt {a : ℕ} : ↑(nat.sqrt a) ≤ real.sqrt ↑a :=
 begin
@@ -324,11 +341,12 @@ begin
 end
 
 instance : star_ordered_ring ℝ :=
-{ nonneg_iff := λ r, by
-  { refine ⟨λ hr, ⟨sqrt r, show r = sqrt r * sqrt r, by rw [←sqrt_mul hr, sqrt_mul_self hr]⟩, _⟩,
-    rintros ⟨s, rfl⟩,
-    exact mul_self_nonneg s },
-  ..real.ordered_add_comm_group }
+star_ordered_ring.of_nonneg_iff' (λ _ _, add_le_add_left) $ λ r,
+begin
+  refine ⟨λ hr, ⟨sqrt r, show r = sqrt r * sqrt r, by rw [←sqrt_mul hr, sqrt_mul_self hr]⟩, _⟩,
+  rintros ⟨s, rfl⟩,
+  exact mul_self_nonneg s
+end
 
 end real
 
diff --git a/src/data/rel.lean b/src/data/rel.lean
index 5cecf7d511ef2..1c1b0f2186a25 100644
--- a/src/data/rel.lean
+++ b/src/data/rel.lean
@@ -3,11 +3,15 @@ Copyright (c) 2018 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad
 -/
+import order.complete_lattice
 import order.galois_connection
 
 /-!
 # Relations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines bundled relations. A relation between `α` and `β` is a function `α → β → Prop`.
 Relations are also known as set-valued functions, or partial multifunctions.
 
@@ -30,7 +34,7 @@ Relations are also known as set-valued functions, or partial multifunctions.
 
 variables {α β γ : Type*}
 
-/-- A relation on `α` and `β`, aka a set-valued function, aka a partial multifunction --/
+/-- A relation on `α` and `β`, aka a set-valued function, aka a partial multifunction -/
 @[derive complete_lattice, derive inhabited]
 def rel (α β : Type*) := α → β → Prop
 
@@ -62,7 +66,7 @@ lemma dom_inv : r.inv.dom = r.codom := by { ext x y, reflexivity}
 def comp (r : rel α β) (s : rel β γ) : rel α γ :=
 λ x z, ∃ y, r x y ∧ s y z
 
-local infixr ` ∘ ` := rel.comp
+local infixr (name := rel.comp) ` ∘ ` := rel.comp
 
 lemma comp_assoc (r : rel α β) (s : rel β γ) (t : rel γ δ) :
   (r ∘ s) ∘ t = r ∘ s ∘ t :=
@@ -111,7 +115,7 @@ by { ext x, simp [mem_image] }
 
 lemma image_comp (s : rel β γ) (t : set α) : image (r ∘ s) t = image s (image r t) :=
 begin
-  ext z, simp only [mem_image, comp], split,
+  ext z, simp only [mem_image], split,
   { rintros ⟨x, xt, y, rxy, syz⟩, exact ⟨y, ⟨x, xt, rxy⟩, syz⟩ },
   rintros ⟨y, ⟨x, xt, rxy⟩, syz⟩, exact ⟨x, xt, y, rxy, syz⟩
 end
diff --git a/src/data/semiquot.lean b/src/data/semiquot.lean
index 445adc1ef493c..50d0885522584 100644
--- a/src/data/semiquot.lean
+++ b/src/data/semiquot.lean
@@ -7,6 +7,9 @@ import data.set.lattice
 
 /-! # Semiquotients
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A data type for semiquotients, which are classically equivalent to
 nonempty sets, but are useful for programming; the idea is that
 a semiquotient set `S` represents some (particular but unknown)
diff --git a/src/data/seq/computation.lean b/src/data/seq/computation.lean
index 06bd8c3c01008..d55639fc39a9c 100644
--- a/src/data/seq/computation.lean
+++ b/src/data/seq/computation.lean
@@ -5,9 +5,8 @@ Authors: Mario Carneiro
 
 Coinductive formalization of unbounded computations.
 -/
-import tactic.basic
 import data.stream.init
-import logic.relator
+import tactic.basic
 
 open function
 universes u v w
@@ -22,21 +21,21 @@ coinductive computation (α : Type u) : Type u
   An element of `computation α` is an infinite sequence of `option α` such
   that if `f n = some a` for some `n` then it is constantly `some a` after that. -/
 def computation (α : Type u) : Type u :=
-{ f : stream (option α) // ∀ {n a}, f n = some a → f (n+1) = some a }
+{f : stream (option α) // ∀ {{n a}}, f n = some a → f (n + 1) = some a}
 
 namespace computation
 variables {α : Type u} {β : Type v} {γ : Type w}
 
 -- constructors
 /-- `return a` is the computation that immediately terminates with result `a`. -/
-def return (a : α) : computation α := ⟨stream.const (some a), λn a', id⟩
+def return (a : α) : computation α := ⟨stream.const (some a), λ n a', id⟩
 
 instance : has_coe_t α (computation α) := ⟨return⟩ -- note [use has_coe_t]
 
 /-- `think c` is the computation that delays for one "tick" and then performs
   computation `c`. -/
 def think (c : computation α) : computation α :=
-⟨none :: c.1, λn a h, by {cases n with n, contradiction, exact c.2 h}⟩
+⟨none :: c.1, λ n a h, by {cases n with n, contradiction, exact c.2 h}⟩
 
 /-- `thinkN c n` is the computation that delays for `n` ticks and then performs
   computation `c`. -/
@@ -53,11 +52,11 @@ def head (c : computation α) : option α := c.1.head
 /-- `tail c` is the remainder of computation, either `c` if `c = return a`
   or `c'` if `c = think c'`. -/
 def tail (c : computation α) : computation α :=
-⟨c.1.tail, λ n a, let t := c.2 in t⟩
+⟨c.1.tail, λ n a h, c.2 h⟩
 
 /-- `empty α` is the computation that never returns, an infinite sequence of
   `think`s. -/
-def empty (α) : computation α := ⟨stream.const none, λn a', id⟩
+def empty (α) : computation α := ⟨stream.const none, λ n a', id⟩
 
 instance : inhabited (computation α) := ⟨empty _⟩
 
@@ -128,7 +127,8 @@ by cases s with f al; apply subtype.eq; dsimp [tail, think]; rw [stream.tail_con
 theorem think_empty : empty α = think (empty α) :=
 destruct_eq_think destruct_empty
 
-def cases_on {C : computation α → Sort v} (s : computation α)
+/-- Recursion principle for computations, compare with `list.rec_on`. -/
+def rec_on {C : computation α → Sort v} (s : computation α)
   (h1 : ∀ a, C (return a)) (h2 : ∀ s, C (think s)) : C s := begin
   induction H : destruct s with v v,
   { rw destruct_eq_ret H, apply h1 },
@@ -147,7 +147,7 @@ def corec.F (f : β → α ⊕ β) : α ⊕ β → option α × (α ⊕ β)
   `corec f b = think (corec f b')`. -/
 def corec (f : β → α ⊕ β) (b : β) : computation α :=
 begin
-  refine ⟨stream.corec' (corec.F f) (sum.inr b), λn a' h, _⟩,
+  refine ⟨stream.corec' (corec.F f) (sum.inr b), λ n a' h, _⟩,
   rw stream.corec'_eq,
   change stream.corec' (corec.F f) (corec.F f (sum.inr b)).2 n = some a',
   revert h, generalize : sum.inr b = o, revert o,
@@ -203,16 +203,16 @@ section bisim
   theorem eq_of_bisim (bisim : is_bisimulation R) {s₁ s₂} (r : s₁ ~ s₂) : s₁ = s₂ :=
   begin
     apply subtype.eq,
-    apply stream.eq_of_bisim (λx y, ∃ s s' : computation α, s.1 = x ∧ s'.1 = y ∧ R s s'),
+    apply stream.eq_of_bisim (λ x y, ∃ s s' : computation α, s.1 = x ∧ s'.1 = y ∧ R s s'),
     dsimp [stream.is_bisimulation],
     intros t₁ t₂ e,
     exact match t₁, t₂, e with ._, ._, ⟨s, s', rfl, rfl, r⟩ :=
       suffices head s = head s' ∧ R (tail s) (tail s'), from
-      and.imp id (λr, ⟨tail s, tail s',
+      and.imp id (λ r, ⟨tail s, tail s',
         by cases s; refl, by cases s'; refl, r⟩) this,
       begin
         have := bisim r, revert r this,
-        apply cases_on s _ _; intros; apply cases_on s' _ _; intros; intros r this,
+        apply rec_on s _ _; intros; apply rec_on s' _ _; intros; intros r this,
         { constructor, dsimp at this, rw this, assumption },
         { rw [destruct_ret, destruct_think] at this,
           exact false.elim this },
@@ -441,7 +441,7 @@ theorem eq_thinkN {s : computation α} {a n} (h : results s a n) :
 begin
   revert s,
   induction n with n IH; intro s;
-  apply cases_on s (λ a', _) (λ s, _); intro h,
+  apply rec_on s (λ a', _) (λ s, _); intro h,
   { rw ←eq_of_ret_mem h.mem, refl },
   { cases of_results_think h with n h, cases h, contradiction },
   { have := h.len_unique (results_ret _), contradiction },
@@ -467,8 +467,8 @@ mem_rec_on (get_mem s) (h1 _) h2
 
 /-- Map a function on the result of a computation. -/
 def map (f : α → β) : computation α → computation β
-| ⟨s, al⟩ := ⟨s.map (λo, option.cases_on o none (some ∘ f)),
-λn b, begin
+| ⟨s, al⟩ := ⟨s.map (λ o, option.cases_on o none (some ∘ f)),
+λ n b, begin
   dsimp [stream.map, stream.nth],
   induction e : s n with a; intro h,
   { contradiction }, { rw [al e, ←h] }
@@ -506,12 +506,12 @@ def join (c : computation (computation α)) : computation α := c >>= id
 
 @[simp]
 theorem destruct_map (f : α → β) (s) : destruct (map f s) = lmap f (rmap (map f) (destruct s)) :=
-by apply s.cases_on; intro; simp
+by apply s.rec_on; intro; simp
 
 @[simp] theorem map_id : ∀ (s : computation α), map id s = s
 | ⟨f, al⟩ := begin
   apply subtype.eq; simp [map, function.comp],
-  have e : (@option.rec α (λ_, option α) none some) = id,
+  have e : (@option.rec α (λ _, option α) none some) = id,
   { ext ⟨⟩; refl },
   simp [e, stream.map_id]
 end
@@ -528,7 +528,7 @@ end
 @[simp] theorem ret_bind (a) (f : α → computation β) :
   bind (return a) f = f a :=
 begin
-  apply eq_of_bisim (λc₁ c₂,
+  apply eq_of_bisim (λ c₁ c₂,
          c₁ = bind (return a) f ∧ c₂ = f a ∨
          c₁ = corec (bind.F f) (sum.inr c₂)),
   { intros c₁ c₂ h,
@@ -550,13 +550,13 @@ destruct_eq_think $ by simp [bind, bind.F]
 
 @[simp] theorem bind_ret (f : α → β) (s) : bind s (return ∘ f) = map f s :=
 begin
-  apply eq_of_bisim (λc₁ c₂, c₁ = c₂ ∨
+  apply eq_of_bisim (λ c₁ c₂, c₁ = c₂ ∨
          ∃ s, c₁ = bind s (return ∘ f) ∧ c₂ = map f s),
   { intros c₁ c₂ h,
     exact match c₁, c₂, h with
     | _, _, or.inl (eq.refl c) := begin cases destruct c with b cb; simp end
     | _, _, or.inr ⟨s, rfl, rfl⟩ := begin
-      apply cases_on s; intros s; simp,
+      apply rec_on s; intros s; simp,
       exact or.inr ⟨s, rfl, rfl⟩
     end end },
   { exact or.inr ⟨s, rfl, rfl⟩ }
@@ -568,15 +568,15 @@ by rw bind_ret; change (λ x : α, x) with @id α; rw map_id
 @[simp] theorem bind_assoc (s : computation α) (f : α → computation β) (g : β → computation γ) :
   bind (bind s f) g = bind s (λ (x : α), bind (f x) g) :=
 begin
-  apply eq_of_bisim (λc₁ c₂, c₁ = c₂ ∨
+  apply eq_of_bisim (λ c₁ c₂, c₁ = c₂ ∨
          ∃ s, c₁ = bind (bind s f) g ∧ c₂ = bind s (λ (x : α), bind (f x) g)),
   { intros c₁ c₂ h,
     exact match c₁, c₂, h with
     | _, _, or.inl (eq.refl c) := by cases destruct c with b cb; simp
     | ._, ._, or.inr ⟨s, rfl, rfl⟩ := begin
-      apply cases_on s; intros s; simp,
+      apply rec_on s; intros s; simp,
       { generalize : f s = fs,
-        apply cases_on fs; intros t; simp,
+        apply rec_on fs; intros t; simp,
         { cases destruct (g t) with b cb; simp } },
       { exact or.inr ⟨s, rfl, rfl⟩ }
     end end },
@@ -619,7 +619,7 @@ theorem of_results_bind {s : computation α} {f : α → computation β} {b k} :
   ∃ a m n, results s a m ∧ results (f a) b n ∧ k = n + m :=
 begin
   induction k with n IH generalizing s;
-  apply cases_on s (λ a, _) (λ s', _); intro e,
+  apply rec_on s (λ a, _) (λ s', _); intro e,
   { simp [thinkN] at e, refine ⟨a, _, _, results_ret _, e, rfl⟩ },
   { have := congr_arg head (eq_thinkN e), contradiction },
   { simp at e, refine ⟨a, _, n+1, results_ret _, e, rfl⟩ },
@@ -678,7 +678,7 @@ theorem terminates_map_iff (f : α → β) (s : computation α) :
   the first one that gives a result. -/
 def orelse (c₁ c₂ : computation α) : computation α :=
 @computation.corec α (computation α × computation α)
-  (λ⟨c₁, c₂⟩, match destruct c₁ with
+  (λ ⟨c₁, c₂⟩, match destruct c₁ with
   | sum.inl a := sum.inl a
   | sum.inr c₁' := match destruct c₂ with
     | sum.inl a := sum.inl a
@@ -703,17 +703,17 @@ destruct_eq_think $ by unfold has_orelse.orelse; simp [orelse]
 
 @[simp] theorem empty_orelse (c) : (empty α <|> c) = c :=
 begin
-  apply eq_of_bisim (λc₁ c₂, (empty α <|> c₂) = c₁) _ rfl,
+  apply eq_of_bisim (λ c₁ c₂, (empty α <|> c₂) = c₁) _ rfl,
   intros s' s h, rw ←h,
-  apply cases_on s; intros s; rw think_empty; simp,
+  apply rec_on s; intros s; rw think_empty; simp,
   rw ←think_empty,
 end
 
 @[simp] theorem orelse_empty (c : computation α) : (c <|> empty α) = c :=
 begin
-  apply eq_of_bisim (λc₁ c₂, (c₂ <|> empty α) = c₁) _ rfl,
+  apply eq_of_bisim (λ c₁ c₂, (c₂ <|> empty α) = c₁) _ rfl,
   intros s' s h, rw ←h,
-  apply cases_on s; intros s; rw think_empty; simp,
+  apply rec_on s; intros s; rw think_empty; simp,
   rw←think_empty,
 end
 
@@ -723,20 +723,20 @@ def equiv (c₁ c₂ : computation α) : Prop := ∀ a, a ∈ c₁ ↔ a ∈ c
 
 infix ` ~ `:50 := equiv
 
-@[refl] theorem equiv.refl (s : computation α) : s ~ s := λ_, iff.rfl
+@[refl] theorem equiv.refl (s : computation α) : s ~ s := λ _, iff.rfl
 
 @[symm] theorem equiv.symm {s t : computation α} : s ~ t → t ~ s :=
-λh a, (h a).symm
+λ h a, (h a).symm
 
 @[trans] theorem equiv.trans {s t u : computation α} : s ~ t → t ~ u → s ~ u :=
-λh1 h2 a, (h1 a).trans (h2 a)
+λ h1 h2 a, (h1 a).trans (h2 a)
 
 theorem equiv.equivalence : equivalence (@equiv α) :=
 ⟨@equiv.refl _, @equiv.symm _, @equiv.trans _⟩
 
 theorem equiv_of_mem {s t : computation α} {a} (h1 : a ∈ s) (h2 : a ∈ t) : s ~ t :=
-λa', ⟨λma, by rw mem_unique ma h1; exact h2,
-      λma, by rw mem_unique ma h2; exact h1⟩
+λ a', ⟨λ ma, by rw mem_unique ma h1; exact h2,
+      λ ma, by rw mem_unique ma h2; exact h1⟩
 
 theorem terminates_congr {c₁ c₂ : computation α}
   (h : c₁ ~ c₂) : terminates c₁ ↔ terminates c₂ :=
@@ -744,7 +744,7 @@ by simp only [terminates_iff, exists_congr h]
 
 theorem promises_congr {c₁ c₂ : computation α}
   (h : c₁ ~ c₂) (a) : c₁ ~> a ↔ c₂ ~> a :=
-forall_congr (λa', imp_congr (h a') iff.rfl)
+forall_congr (λ a', imp_congr (h a') iff.rfl)
 
 theorem get_equiv {c₁ c₂ : computation α} (h : c₁ ~ c₂)
   [terminates c₁] [terminates c₂] : get c₁ = get c₂ :=
@@ -758,9 +758,9 @@ theorem thinkN_equiv (s : computation α) (n) : thinkN s n ~ s :=
 
 theorem bind_congr {s1 s2 : computation α} {f1 f2 : α → computation β}
   (h1 : s1 ~ s2) (h2 : ∀ a, f1 a ~ f2 a) : bind s1 f1 ~ bind s2 f2 :=
-λ b, ⟨λh, let ⟨a, ha, hb⟩ := exists_of_mem_bind h in
+λ b, ⟨λ h, let ⟨a, ha, hb⟩ := exists_of_mem_bind h in
         mem_bind ((h1 a).1 ha) ((h2 a b).1 hb),
-      λh, let ⟨a, ha, hb⟩ := exists_of_mem_bind h in
+      λ h, let ⟨a, ha, hb⟩ := exists_of_mem_bind h in
         mem_bind ((h1 a).2 ha) ((h2 a b).2 hb)⟩
 
 theorem equiv_ret_of_mem {s : computation α} {a} (h : a ∈ s) : s ~ return a :=
@@ -779,10 +779,10 @@ theorem lift_rel.swap (R : α → β → Prop) (ca : computation α) (cb : compu
 and_comm _ _
 
 theorem lift_eq_iff_equiv (c₁ c₂ : computation α) : lift_rel (=) c₁ c₂ ↔ c₁ ~ c₂ :=
-⟨λ⟨h1, h2⟩ a,
+⟨λ ⟨h1, h2⟩ a,
   ⟨λ a1, let ⟨b, b2, ab⟩ := h1 a1 in by rwa ab,
    λ a2, let ⟨b, b1, ab⟩ := h2 a2 in by rwa ←ab⟩,
-λe, ⟨λ a a1, ⟨a, (e _).1 a1, rfl⟩, λ a a2, ⟨a, (e _).2 a2, rfl⟩⟩⟩
+λ e, ⟨λ a a1, ⟨a, (e _).1 a1, rfl⟩, λ a a2, ⟨a, (e _).2 a2, rfl⟩⟩⟩
 
 theorem lift_rel.refl (R : α → α → Prop) (H : reflexive R) : reflexive (lift_rel R) :=
 λ s, ⟨λ a as, ⟨a, as, H a⟩, λ b bs, ⟨b, bs, H b⟩⟩
@@ -831,9 +831,9 @@ H.right h
 
 theorem lift_rel_def {R : α → β → Prop} {ca cb} : lift_rel R ca cb ↔
   (terminates ca ↔ terminates cb) ∧ ∀ {a b}, a ∈ ca → b ∈ cb → R a b :=
-⟨λh, ⟨terminates_of_lift_rel h, λ a b ma mb,
+⟨λ h, ⟨terminates_of_lift_rel h, λ a b ma mb,
   let ⟨b', mb', ab⟩ := h.left ma in by rwa mem_unique mb mb'⟩,
-λ⟨l, r⟩,
+λ ⟨l, r⟩,
  ⟨λ a ma, let ⟨⟨b, mb⟩⟩ := l.1 ⟨⟨_, ma⟩⟩ in ⟨b, mb, r ma mb⟩,
   λ b mb, let ⟨⟨a, ma⟩⟩ := l.2 ⟨⟨_, mb⟩⟩ in ⟨a, ma, r ma mb⟩⟩⟩
 
@@ -858,8 +858,8 @@ let ⟨l1, r1⟩ := h1 in
 
 @[simp] theorem lift_rel_return_left (R : α → β → Prop) (a : α) (cb : computation β) :
   lift_rel R (return a) cb ↔ ∃ {b}, b ∈ cb ∧ R a b :=
-⟨λ⟨l, r⟩, l (ret_mem _),
- λ⟨b, mb, ab⟩,
+⟨λ ⟨l, r⟩, l (ret_mem _),
+ λ ⟨b, mb, ab⟩,
   ⟨λ a' ma', by rw eq_of_ret_mem ma'; exact ⟨b, mb, ab⟩,
    λ b' mb', ⟨_, ret_mem _, by rw mem_unique mb' mb; exact ab⟩⟩⟩
 
@@ -870,13 +870,13 @@ by rw [lift_rel.swap, lift_rel_return_left]
 @[simp] theorem lift_rel_return (R : α → β → Prop) (a : α) (b : β) :
   lift_rel R (return a) (return b) ↔ R a b :=
 by rw [lift_rel_return_left]; exact
-⟨λ⟨b', mb', ab'⟩, by rwa eq_of_ret_mem mb' at ab',
- λab, ⟨_, ret_mem _, ab⟩⟩
+⟨λ ⟨b', mb', ab'⟩, by rwa eq_of_ret_mem mb' at ab',
+ λ ab, ⟨_, ret_mem _, ab⟩⟩
 
 @[simp] theorem lift_rel_think_left (R : α → β → Prop) (ca : computation α) (cb : computation β) :
   lift_rel R (think ca) cb ↔ lift_rel R ca cb :=
-and_congr (forall_congr $ λb, imp_congr ⟨of_think_mem, think_mem⟩ iff.rfl)
- (forall_congr $ λb, imp_congr iff.rfl $
+and_congr (forall_congr $ λ b, imp_congr ⟨of_think_mem, think_mem⟩ iff.rfl)
+ (forall_congr $ λ b, imp_congr iff.rfl $
     exists_congr $ λ b, and_congr ⟨of_think_mem, think_mem⟩ iff.rfl)
 
 @[simp] theorem lift_rel_think_right (R : α → β → Prop) (ca : computation α) (cb : computation β) :
@@ -920,7 +920,7 @@ attribute [simp] lift_rel_aux
   (C : computation α → computation β → Prop) (a cb) :
   lift_rel_aux R C (sum.inl a) (destruct cb) ↔ ∃ {b}, b ∈ cb ∧ R a b :=
 begin
-  apply cb.cases_on (λ b, _) (λ cb, _),
+  apply cb.rec_on (λ b, _) (λ cb, _),
   { exact ⟨λ h, ⟨_, ret_mem _, h⟩, λ ⟨b', mb, h⟩,
     by rw [mem_unique (ret_mem _) mb]; exact h⟩ },
   { rw [destruct_think],
@@ -944,7 +944,7 @@ begin
   revert cb, refine mem_rec_on ha _ (λ ca' IH, _);
   intros cb Hc; have h := H Hc,
   { simp at h, simp [h] },
-  { have h := H Hc, simp, revert h, apply cb.cases_on (λ b, _) (λ cb', _);
+  { have h := H Hc, simp, revert h, apply cb.rec_on (λ b, _) (λ cb', _);
     intro h; simp at h; simp [h], exact IH _ h }
 end
 
diff --git a/src/data/seq/parallel.lean b/src/data/seq/parallel.lean
index cb1a1ea565b58..38b38a046354b 100644
--- a/src/data/seq/parallel.lean
+++ b/src/data/seq/parallel.lean
@@ -14,11 +14,12 @@ import data.seq.wseq
 universes u v
 
 namespace computation
-open wseq
+open stream.wseq as wseq
+open stream.seq as seq
 variables {α : Type u} {β : Type v}
 
 def parallel.aux2 : list (computation α) → α ⊕ list (computation α) :=
-list.foldr (λc o, match o with
+list.foldr (λ c o, match o with
 | sum.inl a  := sum.inl a
 | sum.inr ls := rmap (λ c', c' :: ls) (destruct c)
 end) (sum.inr [])
@@ -26,7 +27,7 @@ end) (sum.inr [])
 def parallel.aux1 : list (computation α) × wseq (computation α) →
   α ⊕ list (computation α) × wseq (computation α)
 | (l, S) := rmap (λ l', match seq.destruct S with
-  | none := (l', nil)
+  | none := (l', seq.nil)
   | some (none, S') := (l', S')
   | some (some c, S') := (c::l', S')
   end) (parallel.aux2 l)
@@ -156,7 +157,7 @@ begin
     exact ⟨c, or.inl cl, ac⟩ },
   { induction e : seq.destruct S with a; rw e at h',
     { exact let ⟨d, o, ad⟩ := IH _ _ h',
-        ⟨c, cl, ac⟩ := this a ⟨d, o.resolve_right (not_mem_nil _), ad⟩ in
+        ⟨c, cl, ac⟩ := this a ⟨d, o.resolve_right (wseq.not_mem_nil _), ad⟩ in
       ⟨c, or.inl cl, ac⟩ },
     { cases a with o S', cases o with c; simp [parallel.aux1] at h';
       rcases IH _ _ h' with ⟨d, dl | dS', ad⟩,
@@ -187,7 +188,7 @@ begin
       cases list.foldr parallel.aux2._match_1 (sum.inr list.nil) l; simp [parallel.aux2],
       cases destruct c; simp },
     simp [parallel.aux1], rw this, cases parallel.aux2 l with a l'; simp,
-    apply S.cases_on _ (λ c S, _) (λ S, _); simp; simp [parallel.aux1];
+    apply S.rec_on _ (λ c S, _) (λ S, _); simp; simp [parallel.aux1];
     exact ⟨_, _, rfl, rfl⟩
   end end
 end
@@ -196,15 +197,15 @@ theorem parallel_empty (S : wseq (computation α)) (h : S.head ~> none) :
 parallel S = empty _ :=
 eq_empty_of_not_terminates $ λ ⟨⟨a, m⟩⟩,
 let ⟨c, cs, ac⟩ := exists_of_mem_parallel m,
-    ⟨n, nm⟩ := exists_nth_of_mem cs,
-    ⟨c', h'⟩ := head_some_of_nth_some nm in by injection h h'
+    ⟨n, nm⟩ := wseq.exists_nth_of_mem cs,
+    ⟨c', h'⟩ := wseq.head_some_of_nth_some nm in by injection h h'
 
 -- The reason this isn't trivial from exists_of_mem_parallel is because it eliminates to Sort
 def parallel_rec {S : wseq (computation α)} (C : α → Sort v)
   (H : ∀ s ∈ S, ∀ a ∈ s, C a) {a} (h : a ∈ parallel S) : C a :=
 begin
   let T : wseq (computation (α × computation α)) :=
-    S.map (λc, c.map (λ a, (a, c))),
+    S.map (λ c, c.map (λ a, (a, c))),
   have : S = T.map (map (λ c, c.1)),
   { rw [←wseq.map_comp], refine (wseq.map_id _).symm.trans (congr_arg (λ f, wseq.map f S) _),
     funext c, dsimp [id, function.comp], rw [←map_comp], exact (map_id _).symm },
@@ -243,11 +244,11 @@ theorem parallel_congr_lem {S T : wseq (computation α)} {a}
 theorem parallel_congr_left {S T : wseq (computation α)} {a}
   (h1 : ∀ s ∈ S, s ~> a) (H : S.lift_rel equiv T) : parallel S ~ parallel T :=
 let h2 := (parallel_congr_lem H).1 h1 in
-λ a', ⟨λh, by have aa := parallel_promises h1 h; rw ←aa; rw ←aa at h; exact
+λ a', ⟨λ h, by have aa := parallel_promises h1 h; rw ←aa; rw ←aa at h; exact
   let ⟨s, sS, as⟩ := exists_of_mem_parallel h,
       ⟨t, tT, st⟩ := wseq.exists_of_lift_rel_left H sS,
       aT := (st _).1 as in mem_parallel h2 tT aT,
-λh, by have aa := parallel_promises h2 h; rw ←aa; rw ←aa at h; exact
+λ h, by have aa := parallel_promises h2 h; rw ←aa; rw ←aa at h; exact
   let ⟨s, sS, as⟩ := exists_of_mem_parallel h,
       ⟨t, tT, st⟩ := wseq.exists_of_lift_rel_right H sS,
       aT := (st _).2 as in mem_parallel h1 tT aT⟩
diff --git a/src/data/seq/seq.lean b/src/data/seq/seq.lean
index 05f1631891f2a..182edc11ec884 100644
--- a/src/data/seq/seq.lean
+++ b/src/data/seq/seq.lean
@@ -3,11 +3,13 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
+import data.list.basic
 import data.lazy_list
 import data.nat.basic
 import data.stream.init
 import data.seq.computation
 
+namespace stream
 universes u v w
 
 /-
@@ -19,13 +21,13 @@ coinductive seq (α : Type u) : Type u
 /--
 A stream `s : option α` is a sequence if `s.nth n = none` implies `s.nth (n + 1) = none`.
 -/
-def stream.is_seq {α : Type u} (s : stream (option α)) : Prop :=
+def is_seq {α : Type u} (s : stream (option α)) : Prop :=
 ∀ {n : ℕ}, s n = none → s (n + 1) = none
 
 /-- `seq α` is the type of possibly infinite lists (referred here as sequences).
   It is encoded as an infinite stream of options such that if `f n = none`, then
   `f m = none` for all `m ≥ n`. -/
-def seq (α : Type u) : Type u := { f : stream (option α) // f.is_seq }
+def seq (α : Type u) : Type u := {f : stream (option α) // f.is_seq}
 
 /-- `seq1 α` is the type of nonempty sequences. -/
 def seq1 (α) := α × seq α
@@ -34,17 +36,42 @@ namespace seq
 variables {α : Type u} {β : Type v} {γ : Type w}
 
 /-- The empty sequence -/
-def nil : seq α := ⟨stream.const none, λn h, rfl⟩
+def nil : seq α := ⟨stream.const none, λ n h, rfl⟩
 
 instance : inhabited (seq α) := ⟨nil⟩
 
 /-- Prepend an element to a sequence -/
-def cons (a : α) : seq α → seq α
-| ⟨f, al⟩ := ⟨some a :: f, λn h, by {cases n with n, contradiction, exact al h}⟩
+def cons (a : α) (s : seq α) : seq α :=
+⟨some a :: s.1, begin
+  rintros (n | _) h,
+  { contradiction },
+  { exact s.2 h }
+end⟩
+
+@[simp] lemma val_cons (s : seq α) (x : α) : (cons x s).val = some x :: s.val := rfl
 
 /-- Get the nth element of a sequence (if it exists) -/
 def nth : seq α → ℕ → option α := subtype.val
 
+@[simp] theorem nth_mk (f hf) : @nth α ⟨f, hf⟩ = f := rfl
+
+@[simp] theorem nth_nil (n : ℕ) : (@nil α).nth n = none := rfl
+@[simp] theorem nth_cons_zero (a : α) (s : seq α) : (cons a s).nth 0 = some a := rfl
+@[simp] theorem nth_cons_succ (a : α) (s : seq α) (n : ℕ) : (cons a s).nth (n + 1) = s.nth n := rfl
+
+@[ext] protected lemma ext {s t : seq α} (h : ∀ n : ℕ, s.nth n = t.nth n) : s = t :=
+subtype.eq $ funext h
+
+lemma cons_injective2 : function.injective2 (cons : α → seq α → seq α) :=
+λ x y s t h, ⟨by rw [←option.some_inj, ←nth_cons_zero, h, nth_cons_zero],
+  seq.ext $ λ n, by simp_rw [←nth_cons_succ x s n, h, nth_cons_succ]⟩
+
+lemma cons_left_injective (s : seq α) : function.injective (λ x, cons x s) :=
+cons_injective2.left _
+
+lemma cons_right_injective (x : α) : function.injective (cons x) :=
+cons_injective2.right _
+
 /-- A sequence has terminated at position `n` if the value at position `n` equals `none`. -/
 def terminated_at (s : seq α) (n : ℕ) : Prop := s.nth n = none
 
@@ -55,6 +82,9 @@ decidable_of_iff' (s.nth n).is_none $ by unfold terminated_at; cases s.nth n; si
 /-- A sequence terminates if there is some position `n` at which it has terminated. -/
 def terminates (s : seq α) : Prop := ∃ (n : ℕ), s.terminated_at n
 
+theorem not_terminates_iff {s : seq α} : ¬ s.terminates ↔ ∀ n, (s.nth n).is_some :=
+by simp [terminates, terminated_at, ←ne.def, option.ne_none_iff_is_some]
+
 /-- Functorial action of the functor `option (α × _)` -/
 @[simp] def omap (f : β → γ) : option (α × β) → option (α × γ)
 | none          := none
@@ -64,23 +94,21 @@ def terminates (s : seq α) : Prop := ∃ (n : ℕ), s.terminated_at n
 def head (s : seq α) : option α := nth s 0
 
 /-- Get the tail of a sequence (or `nil` if the sequence is `nil`) -/
-def tail : seq α → seq α
-| ⟨f, al⟩ := ⟨f.tail, λ n, al⟩
+def tail (s : seq α) : seq α := ⟨s.1.tail, λ n, by { cases s with f al, exact al }⟩
 
+/-- member definition for `seq`-/
 protected def mem (a : α) (s : seq α) := some a ∈ s.1
 
 instance : has_mem α (seq α) :=
 ⟨seq.mem⟩
 
-theorem le_stable (s : seq α) {m n} (h : m ≤ n) :
-  s.nth m = none → s.nth n = none :=
-by {cases s with f al, induction h with n h IH, exacts [id, λ h2, al (IH h2)]}
+theorem le_stable (s : seq α) {m n} (h : m ≤ n) : s.nth m = none → s.nth n = none :=
+by { cases s with f al, induction h with n h IH, exacts [id, λ h2, al (IH h2)] }
 
 /-- If a sequence terminated at position `n`, it also terminated at `m ≥ n `. -/
-lemma terminated_stable (s : seq α) {m n : ℕ} (m_le_n : m ≤ n)
-(terminated_at_m : s.terminated_at m) :
+lemma terminated_stable : ∀ (s : seq α) {m n : ℕ}, m ≤ n → s.terminated_at m →
   s.terminated_at n :=
-le_stable s m_le_n terminated_at_m
+le_stable
 
 /--
 If `s.nth n = some aₙ` for some value `aₙ`, then there is also some value `aₘ` such
@@ -103,16 +131,15 @@ theorem mem_cons_of_mem (y : α) {a : α} : ∀ {s : seq α}, a ∈ s → a ∈
 | ⟨f, al⟩ := stream.mem_cons_of_mem (some y)
 
 theorem eq_or_mem_of_mem_cons {a b : α} : ∀ {s : seq α}, a ∈ cons b s → a = b ∨ a ∈ s
-| ⟨f, al⟩ h := (stream.eq_or_mem_of_mem_cons h).imp_left (λh, by injection h)
+| ⟨f, al⟩ h := (stream.eq_or_mem_of_mem_cons h).imp_left (λ h, by injection h)
 
 @[simp] theorem mem_cons_iff {a b : α} {s : seq α} : a ∈ cons b s ↔ a = b ∨ a ∈ s :=
-⟨eq_or_mem_of_mem_cons, λo, by cases o with e m;
-  [{rw e, apply mem_cons}, exact mem_cons_of_mem _ m]⟩
+⟨eq_or_mem_of_mem_cons, by rintro (rfl|m); [apply mem_cons, exact mem_cons_of_mem _ m]⟩
 
 /-- Destructor for a sequence, resulting in either `none` (for `nil`) or
   `some (a, s)` (for `cons a s`). -/
 def destruct (s : seq α) : option (seq1 α) :=
-(λa', (a', s.tail)) <$> nth s 0
+(λ a', (a', s.tail)) <$> nth s 0
 
 theorem destruct_eq_nil {s : seq α} : destruct s = none → s = nil :=
 begin
@@ -158,7 +185,10 @@ by rw [head_eq_destruct, destruct_cons]; refl
 @[simp] theorem tail_cons (a : α) (s) : tail (cons a s) = s :=
 by cases s with f al; apply subtype.eq; dsimp [tail, cons]; rw [stream.tail_cons]
 
-def cases_on {C : seq α → Sort v} (s : seq α)
+@[simp] theorem nth_tail (s : seq α) (n) : nth (tail s) n = nth s (n + 1) := rfl
+
+/-- Recursion principle for sequences, compare with `list.rec_on`. -/
+def rec_on {C : seq α → Sort v} (s : seq α)
   (h1 : C nil) (h2 : ∀ x s, C (cons x s)) : C s := begin
   induction H : destruct s with v v,
   { rw destruct_eq_nil H, apply h1 },
@@ -174,13 +204,14 @@ begin
     { apply destruct_eq_cons,
       unfold destruct nth functor.map, rw ←e, refl },
     rw TH, apply h1 _ _ (or.inl rfl) },
-  revert e, apply s.cases_on _ (λ b s', _); intro e,
+  revert e, apply s.rec_on _ (λ b s', _); intro e,
   { injection e },
   { have h_eq : (cons b s').val (nat.succ k) = s'.val k, { cases s'; refl },
     rw [h_eq] at e,
     apply h1 _ _ (or.inr (IH e)) }
 end
 
+/-- Corecursor over pairs of `option` values-/
 def corec.F (f : β → option (α × β)) : option β → option α × option β
 | none     := (none, none)
 | (some b) := match f b with none := (none, none) | some (a, b') := (some a, some b') end
@@ -189,7 +220,7 @@ def corec.F (f : β → option (α × β)) : option β → option α × option 
   of the sequence until `none` is obtained. -/
 def corec (f : β → option (α × β)) (b : β) : seq α :=
 begin
-  refine ⟨stream.corec' (corec.F f) (some b), λn h, _⟩,
+  refine ⟨stream.corec' (corec.F f) (some b), λ n h, _⟩,
   rw stream.corec'_eq,
   change stream.corec' (corec.F f) (corec.F f (some b)).2 n = none,
   revert h, generalize : some b = o, revert o,
@@ -219,44 +250,35 @@ begin
   dsimp [corec.F], rw h, refl
 end
 
-/-- Embed a list as a sequence -/
-def of_list (l : list α) : seq α :=
-⟨list.nth l, λn h, begin
-  induction l with a l IH generalizing n, refl,
-  dsimp [list.nth], cases n with n; dsimp [list.nth] at h,
-  { contradiction },
-  { apply IH _ h }
-end⟩
-
-instance coe_list : has_coe (list α) (seq α) := ⟨of_list⟩
-
 section bisim
   variable (R : seq α → seq α → Prop)
 
-  local infix ` ~ `:50 := R
+  local infix (name := R) ` ~ `:50 := R
 
+  /-- Bisimilarity relation over `option` of `seq1 α`-/
   def bisim_o : option (seq1 α) → option (seq1 α) → Prop
   | none          none            := true
   | (some (a, s)) (some (a', s')) := a = a' ∧ R s s'
   | _             _               := false
   attribute [simp] bisim_o
 
+  /-- a relation is bisimiar if it meets the `bisim_o` test-/
   def is_bisimulation := ∀ ⦃s₁ s₂⦄, s₁ ~ s₂ → bisim_o R (destruct s₁) (destruct s₂)
 
   -- If two streams are bisimilar, then they are equal
   theorem eq_of_bisim (bisim : is_bisimulation R) {s₁ s₂} (r : s₁ ~ s₂) : s₁ = s₂ :=
   begin
     apply subtype.eq,
-    apply stream.eq_of_bisim (λx y, ∃ s s' : seq α, s.1 = x ∧ s'.1 = y ∧ R s s'),
+    apply stream.eq_of_bisim (λ x y, ∃ s s' : seq α, s.1 = x ∧ s'.1 = y ∧ R s s'),
     dsimp [stream.is_bisimulation],
     intros t₁ t₂ e,
     exact match t₁, t₂, e with ._, ._, ⟨s, s', rfl, rfl, r⟩ :=
       suffices head s = head s' ∧ R (tail s) (tail s'), from
-      and.imp id (λr, ⟨tail s, tail s',
+      and.imp id (λ r, ⟨tail s, tail s',
         by cases s; refl, by cases s'; refl, r⟩) this,
       begin
         have := bisim r, revert r this,
-        apply cases_on s _ _; intros; apply cases_on s' _ _; intros; intros r this,
+        apply rec_on s _ _; intros; apply rec_on s' _ _; intros; intros r this,
         { constructor, refl, assumption },
         { rw [destruct_nil, destruct_cons] at this,
           exact false.elim this },
@@ -276,7 +298,7 @@ theorem coinduction : ∀ {s₁ s₂ : seq α}, head s₁ = head s₂ →
   (∀ (β : Type u) (fr : seq α → β),
     fr s₁ = fr s₂ → fr (tail s₁) = fr (tail s₂)) → s₁ = s₂
 | ⟨f₁, a₁⟩ ⟨f₂, a₂⟩ hh ht :=
-  subtype.eq (stream.coinduction hh (λ β fr, ht β (λs, fr s.1)))
+  subtype.eq (stream.coinduction hh (λ β fr, ht β (λ s, fr s.1)))
 
 theorem coinduction2 (s) (f g : seq α → seq β)
   (H : ∀ s, bisim_o (λ (s1 s2 : seq β), ∃ (s : seq α), s1 = f s ∧ s2 = g s)
@@ -288,9 +310,23 @@ begin
   rw [h1, h2], apply H
 end
 
+/-- Embed a list as a sequence -/
+def of_list (l : list α) : seq α :=
+⟨list.nth l, λ n h, begin
+  rw list.nth_eq_none_iff at h ⊢,
+  exact h.trans (nat.le_succ n)
+end⟩
+
+instance coe_list : has_coe (list α) (seq α) := ⟨of_list⟩
+
+@[simp] theorem of_list_nil : of_list [] = (nil : seq α) := rfl
+@[simp] theorem of_list_nth (l : list α) (n : ℕ) : (of_list l).nth n = l.nth n := rfl
+@[simp] theorem of_list_cons (a : α) (l : list α) : of_list (a :: l) = cons a (of_list l) :=
+by ext1 (_|n); refl
+
 /-- Embed an infinite stream as a sequence -/
 def of_stream (s : stream α) : seq α :=
-⟨s.map some, λn h, by contradiction⟩
+⟨s.map some, λ n h, by contradiction⟩
 
 instance coe_stream : has_coe (stream α) (seq α) := ⟨of_stream⟩
 
@@ -298,7 +334,7 @@ instance coe_stream : has_coe (stream α) (seq α) := ⟨of_stream⟩
   is non-meta, it will produce infinite sequences if used with
   cyclic `lazy_list`s created by meta constructions. -/
 def of_lazy_list : lazy_list α → seq α :=
-corec (λl, match l with
+corec (λ l, match l with
   | lazy_list.nil := none
   | lazy_list.cons a l' := some (a, l' ())
   end)
@@ -326,16 +362,16 @@ lemma nats_nth (n : ℕ) : nats.nth n = some n := rfl
 /-- Append two sequences. If `s₁` is infinite, then `s₁ ++ s₂ = s₁`,
   otherwise it puts `s₂` at the location of the `nil` in `s₁`. -/
 def append (s₁ s₂ : seq α) : seq α :=
-@corec α (seq α × seq α) (λ⟨s₁, s₂⟩,
+@corec α (seq α × seq α) (λ ⟨s₁, s₂⟩,
   match destruct s₁ with
-  | none := omap (λs₂, (nil, s₂)) (destruct s₂)
+  | none := omap (λ s₂, (nil, s₂)) (destruct s₂)
   | some (a, s₁') := some (a, s₁', s₂)
   end) (s₁, s₂)
 
 /-- Map a function over a sequence. -/
 def map (f : α → β) : seq α → seq β | ⟨s, al⟩ :=
 ⟨s.map (option.map f),
-λn, begin
+λ n, begin
   dsimp [stream.map, stream.nth],
   induction e : s n; intro,
   { rw al e, assumption }, { contradiction }
@@ -346,7 +382,7 @@ end⟩
   of an infinite sequence of `nil`, the first element is never
   generated.) -/
 def join : seq (seq1 α) → seq α :=
-corec (λS, match destruct S with
+corec (λ S, match destruct S with
   | none := none
   | some ((a, s), S') := some (a, match destruct s with
     | none := S'
@@ -380,83 +416,57 @@ def split_at : ℕ → seq α → list α × seq α
 section zip_with
 
 /-- Combine two sequences with a function -/
-def zip_with (f : α → β → γ) : seq α → seq β → seq γ
-| ⟨f₁, a₁⟩ ⟨f₂, a₂⟩ := ⟨λn,
-    match f₁ n, f₂ n with
-    | some a, some b := some (f a b)
-    | _, _ := none
-    end,
-  λn, begin
-    induction h1 : f₁ n,
-    { intro H, simp only [(a₁ h1)], refl },
-    induction h2 : f₂ n; dsimp [seq.zip_with._match_1]; intro H,
-    { rw (a₂ h2), cases f₁ (n + 1); refl },
-    { rw [h1, h2] at H, contradiction }
-  end⟩
+def zip_with (f : α → β → γ) (s₁ : seq α) (s₂ : seq β) : seq γ :=
+⟨λ n, option.map₂ f (s₁.nth n) (s₂.nth n), λ n hn,
+  option.map₂_eq_none_iff.2 $ (option.map₂_eq_none_iff.1 hn).imp s₁.2 s₂.2⟩
 
 variables {s : seq α} {s' : seq β} {n : ℕ}
 
-lemma zip_with_nth_some {a : α} {b : β} (s_nth_eq_some : s.nth n = some a)
-(s_nth_eq_some' : s'.nth n = some b) (f : α → β → γ) :
-  (zip_with f s s').nth n = some (f a b) :=
-begin
-  cases s with st,
-  have : st n = some a, from s_nth_eq_some,
-  cases s' with st',
-  have : st' n = some b, from s_nth_eq_some',
-  simp only [zip_with, seq.nth, *]
-end
-
-lemma zip_with_nth_none (s_nth_eq_none : s.nth n = none) (f : α → β → γ) :
-  (zip_with f s s').nth n = none :=
-begin
-  cases s with st,
-  have : st n = none, from s_nth_eq_none,
-  cases s' with st',
-  cases st'_nth_eq : st' n;
-  simp only [zip_with, seq.nth, *]
-end
-
-lemma zip_with_nth_none' (s'_nth_eq_none : s'.nth n = none) (f : α → β → γ) :
-  (zip_with f s s').nth n = none :=
-begin
-  cases s' with st',
-  have : st' n = none, from s'_nth_eq_none,
-  cases s with st,
-  cases st_nth_eq : st n;
-  simp only [zip_with, seq.nth, *]
-end
+@[simp] lemma nth_zip_with (f : α → β → γ) (s s' n) :
+  (zip_with f s s').nth n = option.map₂ f (s.nth n) (s'.nth n) :=
+rfl
 
 end zip_with
 
 /-- Pair two sequences into a sequence of pairs -/
 def zip : seq α → seq β → seq (α × β) := zip_with prod.mk
 
+lemma nth_zip (s : seq α) (t : seq β) (n : ℕ) :
+  nth (zip s t) n = option.map₂ prod.mk (nth s n) (nth t n) :=
+nth_zip_with _ _ _ _
+
 /-- Separate a sequence of pairs into two sequences -/
 def unzip (s : seq (α × β)) : seq α × seq β := (map prod.fst s, map prod.snd s)
 
+/-- Enumerate a sequence by tagging each element with its index. -/
+def enum (s : seq α) : seq (ℕ × α) := seq.zip nats s
+
+@[simp] lemma nth_enum (s : seq α) (n : ℕ) : nth (enum s) n = option.map (prod.mk n) (nth s n) :=
+nth_zip _ _ _
+
+@[simp] lemma enum_nil : enum (nil : seq α) = nil := rfl
+
 /-- Convert a sequence which is known to terminate into a list -/
-def to_list (s : seq α) (h : ∃ n, ¬ (nth s n).is_some) : list α :=
+def to_list (s : seq α) (h : s.terminates) : list α :=
 take (nat.find h) s
 
 /-- Convert a sequence which is known not to terminate into a stream -/
-def to_stream (s : seq α) (h : ∀ n, (nth s n).is_some) : stream α :=
-λn, option.get (h n)
+def to_stream (s : seq α) (h : ¬ s.terminates) : stream α :=
+λ n, option.get $ not_terminates_iff.1 h n
 
 /-- Convert a sequence into either a list or a stream depending on whether
   it is finite or infinite. (Without decidability of the infiniteness predicate,
   this is not constructively possible.) -/
-def to_list_or_stream (s : seq α) [decidable (∃ n, ¬ (nth s n).is_some)] :
-  list α ⊕ stream α :=
-if h : ∃ n, ¬ (nth s n).is_some
+def to_list_or_stream (s : seq α) [decidable s.terminates] : list α ⊕ stream α :=
+if h : s.terminates
 then sum.inl (to_list s h)
-else sum.inr (to_stream s (λn, decidable.by_contradiction (λ hn, h ⟨n, hn⟩)))
+else sum.inr (to_stream s h)
 
 @[simp] theorem nil_append (s : seq α) : append nil s = s :=
 begin
   apply coinduction2, intro s,
   dsimp [append], rw [corec_eq],
-  dsimp [append], apply cases_on s _ _,
+  dsimp [append], apply rec_on s _ _,
   { trivial },
   { intros x s,
     rw [destruct_cons], dsimp,
@@ -473,7 +483,7 @@ end
 @[simp] theorem append_nil (s : seq α) : append s nil = s :=
 begin
   apply coinduction2 s, intro s,
-  apply cases_on s _ _,
+  apply rec_on s _ _,
   { trivial },
   { intros x s,
     rw [cons_append, destruct_cons, destruct_cons], dsimp,
@@ -483,12 +493,12 @@ end
 @[simp] theorem append_assoc (s t u : seq α) :
   append (append s t) u = append s (append t u) :=
 begin
-  apply eq_of_bisim (λs1 s2, ∃ s t u,
+  apply eq_of_bisim (λ s1 s2, ∃ s t u,
     s1 = append (append s t) u ∧ s2 = append s (append t u)),
   { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, t, u, rfl, rfl⟩ := begin
-      apply cases_on s; simp,
-      { apply cases_on t; simp,
-        { apply cases_on u; simp,
+      apply rec_on s; simp,
+      { apply rec_on t; simp,
+        { apply rec_on u; simp,
           { intros x u, refine ⟨nil, nil, u, _, _⟩; simp } },
         { intros x t, refine ⟨nil, t, u, _, _⟩; simp } },
       { intros x s, exact ⟨s, t, u, rfl, rfl⟩ }
@@ -520,11 +530,11 @@ end
 
 @[simp] theorem map_append (f : α → β) (s t) : map f (append s t) = append (map f s) (map f t) :=
 begin
-  apply eq_of_bisim (λs1 s2, ∃ s t,
+  apply eq_of_bisim (λ s1 s2, ∃ s t,
     s1 = map f (append s t) ∧ s2 = append (map f s) (map f t)) _ ⟨s, t, rfl, rfl⟩,
   intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, t, rfl, rfl⟩ := begin
-    apply cases_on s; simp,
-    { apply cases_on t; simp,
+    apply rec_on s; simp,
+    { apply rec_on t; simp,
       { intros x t, refine ⟨nil, t, _, _⟩; simp } },
     { intros x s, refine ⟨s, t, rfl, rfl⟩ }
   end end
@@ -551,17 +561,17 @@ destruct_eq_cons $ by simp [join]
 @[simp, priority 990] theorem join_cons (a : α) (s S) :
   join (cons (a, s) S) = cons a (append s (join S)) :=
 begin
-  apply eq_of_bisim (λs1 s2, s1 = s2 ∨
+  apply eq_of_bisim (λ s1 s2, s1 = s2 ∨
     ∃ a s S, s1 = join (cons (a, s) S) ∧
       s2 = cons a (append s (join S))) _ (or.inr ⟨a, s, S, rfl, rfl⟩),
   intros s1 s2 h,
   exact match s1, s2, h with
   | _, _, (or.inl $ eq.refl s) := begin
-      apply cases_on s, { trivial },
+      apply rec_on s, { trivial },
       { intros x s, rw [destruct_cons], exact ⟨rfl, or.inl rfl⟩ }
     end
   | ._, ._, (or.inr ⟨a, s, S, rfl, rfl⟩) := begin
-      apply cases_on s,
+      apply rec_on s,
       { simp },
       { intros x s, simp, refine or.inr ⟨x, s, S, rfl, rfl⟩ }
     end
@@ -571,13 +581,13 @@ end
 @[simp] theorem join_append (S T : seq (seq1 α)) :
   join (append S T) = append (join S) (join T) :=
 begin
-  apply eq_of_bisim (λs1 s2, ∃ s S T,
+  apply eq_of_bisim (λ s1 s2, ∃ s S T,
     s1 = append s (join (append S T)) ∧
     s2 = append s (append (join S) (join T))),
   { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, S, T, rfl, rfl⟩ := begin
-      apply cases_on s; simp,
-      { apply cases_on S; simp,
-        { apply cases_on T, { simp },
+      apply rec_on s; simp,
+      { apply rec_on S; simp,
+        { apply rec_on T, { simp },
           { intros s T, cases s with a s; simp,
             refine ⟨s, nil, T, _, _⟩; simp } },
         { intros s S, cases s with a s; simp,
@@ -587,12 +597,6 @@ begin
   { refine ⟨nil, S, T, _, _⟩; simp }
 end
 
-@[simp] theorem of_list_nil : of_list [] = (nil : seq α) := rfl
-
-@[simp] theorem of_list_cons (a : α) (l) :
-  of_list (a :: l) = cons a (of_list l) :=
-by ext (_|n) : 2; simp [of_list, cons, stream.nth, stream.cons]
-
 @[simp] theorem of_stream_cons (a : α) (s) :
   of_stream (a :: s) = cons a (of_stream s) :=
 by apply subtype.eq; simp [of_stream, cons]; rw stream.map_cons
@@ -609,7 +613,7 @@ by induction l; simp [*, stream.nil_append_stream, stream.cons_append_stream]
   the possibility of infinite sequences (in which case the computation
   never returns anything). -/
 def to_list' {α} (s : seq α) : computation (list α) :=
-@computation.corec (list α) (list α × seq α) (λ⟨l, s⟩,
+@computation.corec (list α) (list α × seq α) (λ ⟨l, s⟩,
   match destruct s with
   | none         := sum.inl l.reverse
   | some (a, s') := sum.inr (a::l, s')
@@ -622,27 +626,6 @@ theorem dropn_add (s : seq α) (m) : ∀ n, drop s (m + n) = drop (drop s m) n
 theorem dropn_tail (s : seq α) (n) : drop (tail s) n = drop s (n + 1) :=
 by rw add_comm; symmetry; apply dropn_add
 
-theorem nth_tail : ∀ (s : seq α) n, nth (tail s) n = nth s (n + 1)
-| ⟨f, al⟩ n := rfl
-
-@[ext]
-protected lemma ext (s s': seq α) (hyp : ∀ (n : ℕ), s.nth n = s'.nth n) : s = s' :=
-begin
-  let ext := (λ (s s' : seq α), ∀ n, s.nth n = s'.nth n),
-  apply seq.eq_of_bisim ext _ hyp,
-  -- we have to show that ext is a bisimulation
-  clear hyp s s',
-  assume s s' (hyp : ext s s'),
-  unfold seq.destruct,
-  rw (hyp 0),
-  cases (s'.nth 0),
-  { simp [seq.bisim_o] }, -- option.none
-  { -- option.some
-    suffices : ext s.tail s'.tail, by simpa,
-    assume n,
-    simp only [seq.nth_tail _ n, (hyp $ n + 1)] }
-end
-
 @[simp] theorem head_dropn (s : seq α) (n) : head (drop s n) = nth s n :=
 begin
   induction n with n IH generalizing s, { refl },
@@ -662,7 +645,7 @@ begin
   generalize e : append s₁ s₂ = ss, intro h, revert s₁,
   apply mem_rec_on h _,
   intros b s' o s₁,
-  apply s₁.cases_on _ (λ c t₁, _); intros m e;
+  apply s₁.rec_on _ (λ c t₁, _); intros m e;
   have := congr_arg destruct e,
   { apply or.inr, simpa using m },
   { cases (show a = c ∨ a ∈ append t₁ s₂, by simpa using m) with e' m,
@@ -676,15 +659,24 @@ end
 theorem mem_append_left {s₁ s₂ : seq α} {a : α} (h : a ∈ s₁) : a ∈ append s₁ s₂ :=
 by apply mem_rec_on h; intros; simp [*]
 
+@[simp] lemma enum_cons (s : seq α) (x : α) :
+  enum (cons x s) = cons (0, x) (map (prod.map nat.succ id) (enum s)) :=
+begin
+  ext ⟨n⟩ : 1,
+  { simp, },
+  { simp only [nth_enum, nth_cons_succ, map_nth, option.map_map],
+    congr }
+end
+
 end seq
 
 namespace seq1
 variables {α : Type u} {β : Type v} {γ : Type w}
-open seq
+open stream.seq
 
 /-- Convert a `seq1` to a sequence. -/
 def to_seq : seq1 α → seq α
-| (a, s) := cons a s
+| (a, s) := seq.cons a s
 
 instance coe_seq : has_coe (seq1 α) (seq α) := ⟨to_seq⟩
 
@@ -698,13 +690,13 @@ theorem map_id : ∀ (s : seq1 α), map id s = s | ⟨a, s⟩ := by simp [map]
 def join : seq1 (seq1 α) → seq1 α
 | ((a, s), S) := match destruct s with
   | none := (a, seq.join S)
-  | some s' := (a, seq.join (cons s' S))
+  | some s' := (a, seq.join (seq.cons s' S))
   end
 
 @[simp] theorem join_nil (a : α) (S) : join ((a, nil), S) = (a, seq.join S) := rfl
 
 @[simp] theorem join_cons (a b : α) (s S) :
-  join ((a, cons b s), S) = (a, seq.join (cons (b, s) S)) :=
+  join ((a, seq.cons b s), S) = (a, seq.join (seq.cons (b, s) S)) :=
 by dsimp [join]; rw [destruct_cons]; refl
 
 /-- The `return` operator for the `seq1` monad,
@@ -721,11 +713,11 @@ def bind (s : seq1 α) (f : α → seq1 β) : seq1 β :=
 join (map f s)
 
 @[simp] theorem join_map_ret (s : seq α) : seq.join (seq.map ret s) = s :=
-by apply coinduction2 s; intro s; apply cases_on s; simp [ret]
+by apply coinduction2 s; intro s; apply rec_on s; simp [ret]
 
 @[simp] theorem bind_ret (f : α → β) : ∀ s, bind s (ret ∘ f) = map f s
 | ⟨a, s⟩ := begin
-  dsimp [bind, map], change (λx, ret (f x)) with (ret ∘ f),
+  dsimp [bind, map], change (λ x, ret (f x)) with (ret ∘ f),
   rw [map_comp], simp [function.comp, ret]
 end
 
@@ -733,18 +725,18 @@ end
 begin
   simp [ret, bind, map],
   cases f a with a s,
-  apply cases_on s; intros; simp
+  apply rec_on s; intros; simp
 end
 
 @[simp] theorem map_join' (f : α → β) (S) :
   seq.map f (seq.join S) = seq.join (seq.map (map f) S) :=
 begin
-  apply eq_of_bisim (λs1 s2,
-    ∃ s S, s1 = append s (seq.map f (seq.join S)) ∧
+  apply seq.eq_of_bisim (λ s1 s2,
+    ∃ s S, s1 = seq.append s (seq.map f (seq.join S)) ∧
       s2 = append s (seq.join (seq.map (map f) S))),
   { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, S, rfl, rfl⟩ := begin
-      apply cases_on s; simp,
-      { apply cases_on S; simp,
+      apply rec_on s; simp,
+      { apply rec_on S; simp,
         { intros x S, cases x with a s; simp [map],
           exact ⟨_, _, rfl, rfl⟩ } },
       { intros x s, refine ⟨s, S, rfl, rfl⟩ }
@@ -753,22 +745,22 @@ begin
 end
 
 @[simp] theorem map_join (f : α → β) : ∀ S, map f (join S) = join (map (map f) S)
-| ((a, s), S) := by apply cases_on s; intros; simp [map]
+| ((a, s), S) := by apply rec_on s; intros; simp [map]
 
 @[simp] theorem join_join (SS : seq (seq1 (seq1 α))) :
   seq.join (seq.join SS) = seq.join (seq.map join SS) :=
 begin
-  apply eq_of_bisim (λs1 s2,
+  apply seq.eq_of_bisim (λ s1 s2,
     ∃ s SS, s1 = seq.append s (seq.join (seq.join SS)) ∧
       s2 = seq.append s (seq.join (seq.map join SS))),
   { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, SS, rfl, rfl⟩ := begin
-      apply cases_on s; simp,
-      { apply cases_on SS; simp,
+      apply rec_on s; simp,
+      { apply rec_on SS; simp,
         { intros S SS, cases S with s S; cases s with x s; simp [map],
-          apply cases_on s; simp,
+          apply rec_on s; simp,
           { exact ⟨_, _, rfl, rfl⟩ },
           { intros x s,
-            refine ⟨cons x (append s (seq.join S)), SS, _, _⟩; simp } } },
+            refine ⟨seq.cons x (append s (seq.join S)), SS, _, _⟩; simp } } },
       { intros x s, exact ⟨s, SS, rfl, rfl⟩ }
     end end },
   { refine ⟨nil, SS, _, _⟩; simp }
@@ -784,8 +776,8 @@ begin
   rw [map_comp _ join],
   generalize : seq.map (map g ∘ f) s = SS,
   rcases map g (f a) with ⟨⟨a, s⟩, S⟩,
-  apply cases_on s; intros; apply cases_on S; intros; simp,
-  { cases x with x t, apply cases_on t; intros; simp },
+  apply rec_on s; intros; apply rec_on S; intros; simp,
+  { cases x with x t, apply rec_on t; intros; simp },
   { cases x_1 with y t; simp }
 end
 
@@ -801,3 +793,4 @@ instance : is_lawful_monad seq1 :=
   bind_assoc := @bind_assoc }
 
 end seq1
+end stream
diff --git a/src/data/seq/wseq.lean b/src/data/seq/wseq.lean
index b3a090a28752c..c55be3a1b2301 100644
--- a/src/data/seq/wseq.lean
+++ b/src/data/seq/wseq.lean
@@ -3,10 +3,10 @@ Copyright (c) 2017 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
-import data.dlist
 import data.list.basic
 import data.seq.seq
 
+namespace stream
 open function
 universes u v w
 
@@ -60,16 +60,19 @@ def think : wseq α → wseq α := seq.cons none
 /-- Destruct a weak sequence, to (eventually possibly) produce either
   `none` for `nil` or `some (a, s)` if an element is produced. -/
 def destruct : wseq α → computation (option (α × wseq α)) :=
-computation.corec (λs, match seq.destruct s with
+computation.corec (λ s, match seq.destruct s with
   | none              := sum.inl none
   | some (none, s')   := sum.inr s'
   | some (some a, s') := sum.inl (some (a, s'))
   end)
 
-def cases_on {C : wseq α → Sort v} (s : wseq α) (h1 : C nil)
+
+/-- Recursion principle for weak sequences, compare with `list.rec_on`. -/
+def rec_on {C : wseq α → Sort v} (s : wseq α) (h1 : C nil)
   (h2 : ∀ x s, C (cons x s)) (h3 : ∀ s, C (think s)) : C s :=
-seq.cases_on s h1 (λ o, option.cases_on o h3 h2)
+seq.rec_on s h1 (λ o, option.rec_on o h3 h2)
 
+/-- membership for weak sequences-/
 protected def mem (a : α) (s : wseq α) := seq.mem (some a) s
 
 instance : has_mem α (wseq α) :=
@@ -85,7 +88,7 @@ computation.map ((<$>) prod.fst) (destruct s)
 /-- Encode a computation yielding a weak sequence into additional
   `think` constructors in a weak sequence -/
 def flatten : computation (wseq α) → wseq α :=
-seq.corec (λc, match computation.destruct c with
+seq.corec (λ c, match computation.destruct c with
   | sum.inl s := seq.omap return (seq.destruct s)
   | sum.inr c' := some (none, c')
   end)
@@ -94,7 +97,7 @@ seq.corec (λc, match computation.destruct c with
   wrapper, unlike `head`, because `flatten` allows us to hide this
   in the construction of the weak sequence itself. -/
 def tail (s : wseq α) : wseq α :=
-flatten $ (λo, option.rec_on o nil prod.snd) <$> destruct s
+flatten $ (λ o, option.rec_on o nil prod.snd) <$> destruct s
 
 /-- drop the first `n` elements from `s`. -/
 def drop (s : wseq α) : ℕ → wseq α
@@ -107,7 +110,7 @@ def nth (s : wseq α) (n : ℕ) : computation (option α) := head (drop s n)
 
 /-- Convert `s` to a list (if it is finite and completes in finite time). -/
 def to_list (s : wseq α) : computation (list α) :=
-@computation.corec (list α) (list α × wseq α) (λ⟨l, s⟩,
+@computation.corec (list α) (list α × wseq α) (λ ⟨l, s⟩,
   match seq.destruct s with
   | none              := sum.inl l.reverse
   | some (none, s')   := sum.inr (l, s')
@@ -116,7 +119,7 @@ def to_list (s : wseq α) : computation (list α) :=
 
 /-- Get the length of `s` (if it is finite and completes in finite time). -/
 def length (s : wseq α) : computation ℕ :=
-@computation.corec ℕ (ℕ × wseq α) (λ⟨n, s⟩,
+@computation.corec ℕ (ℕ × wseq α) (λ ⟨n, s⟩,
   match seq.destruct s with
   | none              := sum.inl n
   | some (none, s')   := sum.inr (n, s')
@@ -148,7 +151,7 @@ instance head_terminates (s : wseq α) [productive s] :
 
 /-- Replace the `n`th element of `s` with `a`. -/
 def update_nth (s : wseq α) (n : ℕ) (a : α) : wseq α :=
-@seq.corec (option α) (ℕ × wseq α) (λ⟨n, s⟩,
+@seq.corec (option α) (ℕ × wseq α) (λ ⟨n, s⟩,
   match seq.destruct s, n with
   | none,               n     := none
   | some (none, s'),    n     := some (none, n, s')
@@ -159,7 +162,7 @@ def update_nth (s : wseq α) (n : ℕ) (a : α) : wseq α :=
 
 /-- Remove the `n`th element of `s`. -/
 def remove_nth (s : wseq α) (n : ℕ) : wseq α :=
-@seq.corec (option α) (ℕ × wseq α) (λ⟨n, s⟩,
+@seq.corec (option α) (ℕ × wseq α) (λ ⟨n, s⟩,
   match seq.destruct s, n with
   | none,               n     := none
   | some (none, s'),    n     := some (none, n, s')
@@ -170,7 +173,7 @@ def remove_nth (s : wseq α) (n : ℕ) : wseq α :=
 
 /-- Map the elements of `s` over `f`, removing any values that yield `none`. -/
 def filter_map (f : α → option β) : wseq α → wseq β :=
-seq.corec (λs, match seq.destruct s with
+seq.corec (λ s, match seq.destruct s with
   | none              := none
   | some (none, s')   := some (none, s')
   | some (some a, s') := some (f a, s')
@@ -178,7 +181,7 @@ seq.corec (λs, match seq.destruct s with
 
 /-- Select the elements of `s` that satisfy `p`. -/
 def filter (p : α → Prop) [decidable_pred p] : wseq α → wseq α :=
-filter_map (λa, if p a then some a else none)
+filter_map (λ a, if p a then some a else none)
 
 -- example of infinite list manipulations
 /-- Get the first element of `s` satisfying `p`. -/
@@ -187,7 +190,7 @@ head $ filter p s
 
 /-- Zip a function over two weak sequences -/
 def zip_with (f : α → β → γ) (s1 : wseq α) (s2 : wseq β) : wseq γ :=
-@seq.corec (option γ) (wseq α × wseq β) (λ⟨s1, s2⟩,
+@seq.corec (option γ) (wseq α × wseq β) (λ ⟨s1, s2⟩,
   match seq.destruct s1, seq.destruct s2 with
   | some (none, s1'),    some (none, s2')    := some (none, s1', s2')
   | some (some a1, s1'), some (none, s2')    := some (none, s1, s2')
@@ -217,7 +220,7 @@ def indexes_of [decidable_eq α] (a : α) : wseq α → wseq ℕ := find_indexes
 /-- `union s1 s2` is a weak sequence which interleaves `s1` and `s2` in
   some order (nondeterministically). -/
 def union (s1 s2 : wseq α) : wseq α :=
-@seq.corec (option α) (wseq α × wseq α) (λ⟨s1, s2⟩,
+@seq.corec (option α) (wseq α × wseq α) (λ ⟨s1, s2⟩,
   match seq.destruct s1, seq.destruct s2 with
   | none,                none                := none
   | some (a1, s1'),      none                := some (a1, s1', nil)
@@ -241,7 +244,7 @@ end
 
 /-- Get the first `n` elements of a weak sequence -/
 def take (s : wseq α) (n : ℕ) : wseq α :=
-@seq.corec (option α) (ℕ × wseq α) (λ⟨n, s⟩,
+@seq.corec (option α) (ℕ × wseq α) (λ ⟨n, s⟩,
   match n, seq.destruct s with
   | 0,   _                 := none
   | m+1, none              := none
@@ -252,7 +255,7 @@ def take (s : wseq α) (n : ℕ) : wseq α :=
 /-- Split the sequence at position `n` into a finite initial segment
   and the weak sequence tail -/
 def split_at (s : wseq α) (n : ℕ) : computation (list α × wseq α) :=
-@computation.corec (list α × wseq α) (ℕ × list α × wseq α) (λ⟨n, l, s⟩,
+@computation.corec (list α × wseq α) (ℕ × list α × wseq α) (λ ⟨n, l, s⟩,
   match n, seq.destruct s with
   | 0,   _                 := sum.inl (l.reverse, s)
   | m+1, none              := sum.inl (l.reverse, s)
@@ -262,7 +265,7 @@ def split_at (s : wseq α) (n : ℕ) : computation (list α × wseq α) :=
 
 /-- Returns `tt` if any element of `s` satisfies `p` -/
 def any (s : wseq α) (p : α → bool) : computation bool :=
-computation.corec (λs : wseq α,
+computation.corec (λ s : wseq α,
   match seq.destruct s with
   | none              := sum.inl ff
   | some (none, s')   := sum.inr s'
@@ -271,7 +274,7 @@ computation.corec (λs : wseq α,
 
 /-- Returns `tt` if every element of `s` satisfies `p` -/
 def all (s : wseq α) (p : α → bool) : computation bool :=
-computation.corec (λs : wseq α,
+computation.corec (λ s : wseq α,
   match seq.destruct s with
   | none              := sum.inl tt
   | some (none, s')   := sum.inr s'
@@ -282,7 +285,7 @@ computation.corec (λs : wseq α,
   of partial results. (There is no `scanr` because this would require
   working from the end of the sequence, which may not exist.) -/
 def scanl (f : α → β → α) (a : α) (s : wseq β) : wseq α :=
-cons a $ @seq.corec (option α) (α × wseq β) (λ⟨a, s⟩,
+cons a $ @seq.corec (option α) (α × wseq β) (λ ⟨a, s⟩,
   match seq.destruct s with
   | none              := none
   | some (none, s')   := some (none, a, s')
@@ -314,7 +317,7 @@ def map (f : α → β) : wseq α → wseq β := seq.map (option.map f)
 /-- Flatten a sequence of weak sequences. (Note that this allows
   empty sequences, unlike `seq.join`.) -/
 def join (S : wseq (wseq α)) : wseq α :=
-seq.join ((λo : option (wseq α), match o with
+seq.join ((λ o : option (wseq α), match o with
   | none := seq1.ret none
   | some s := (none, s)
   end) <$> S)
@@ -323,6 +326,7 @@ seq.join ((λo : option (wseq α), match o with
 def bind (s : wseq α) (f : α → wseq β) : wseq β :=
 join (map f s)
 
+/-- lift a relation to a relation over weak sequences -/
 @[simp] def lift_rel_o (R : α → β → Prop) (C : wseq α → wseq β → Prop) :
   option (α × wseq α) → option (β × wseq β) → Prop
 | none          none          := true
@@ -341,6 +345,7 @@ theorem lift_rel_o.imp_right (R : α → β → Prop) {C D : wseq α → wseq β
   (H : ∀ s t, C s t → D s t) {o p} : lift_rel_o R C o p → lift_rel_o R D o p :=
 lift_rel_o.imp (λ _ _, id) H
 
+/-- Definitino of bisimilarity for weak sequences-/
 @[simp] def bisim_o (R : wseq α → wseq α → Prop) :
   option (α × wseq α) → option (α × wseq α) → Prop := lift_rel_o (=) R
 
@@ -381,7 +386,7 @@ theorem lift_rel_destruct_iff {R : α → β → Prop} {s : wseq α} {t : wseq 
     intros s t, apply or.inl
   end⟩⟩
 
-infix ` ~ `:50 := equiv
+infix (name := equiv) ` ~ `:50 := equiv
 
 theorem destruct_congr {s t : wseq α} :
   s ~ t → computation.lift_rel (bisim_o (~)) (destruct s) (destruct t) :=
@@ -483,7 +488,7 @@ seq.destruct_cons _ _
 
 @[simp] theorem flatten_ret (s : wseq α) : flatten (return s) = s :=
 begin
-  refine seq.eq_of_bisim (λs1 s2, flatten (return s2) = s1) _ rfl,
+  refine seq.eq_of_bisim (λ s1 s2, flatten (return s2) = s1) _ rfl,
   intros s' s h, rw ←h, simp [flatten],
   cases seq.destruct s, { simp },
   { cases val with o s', simp }
@@ -495,12 +500,12 @@ seq.destruct_eq_cons $ by simp [flatten, think]
 @[simp]
 theorem destruct_flatten (c : computation (wseq α)) : destruct (flatten c) = c >>= destruct :=
 begin
-  refine computation.eq_of_bisim (λc1 c2, c1 = c2 ∨
+  refine computation.eq_of_bisim (λ c1 c2, c1 = c2 ∨
     ∃ c, c1 = destruct (flatten c) ∧ c2 = computation.bind c destruct) _ (or.inr ⟨c, rfl, rfl⟩),
   intros c1 c2 h, exact match c1, c2, h with
   | _, _, (or.inl $ eq.refl c) := by cases c.destruct; simp
   | _, _, (or.inr ⟨c, rfl, rfl⟩) := begin
-    apply c.cases_on (λa, _) (λc', _); repeat {simp},
+    apply c.rec_on (λ a, _) (λ c', _); repeat {simp},
     { cases (destruct a).destruct; simp },
     { exact or.inr ⟨c', rfl, rfl⟩ }
   end end
@@ -556,6 +561,7 @@ by { simp [think, join], unfold functor.map, simp [join, cons, append] }
 @[simp] theorem append_assoc (s t u : wseq α) :
   append (append s t) u = append s (append t u) := seq.append_assoc _ _ _
 
+/-- auxilary defintion of tail over weak sequences-/
 @[simp] def tail.aux : option (α × wseq α) → computation (option (α × wseq α))
 | none          := return none
 | (some (a, s)) := destruct s
@@ -568,6 +574,7 @@ begin
   apply (@pure_bind computation _ _ _ _ _ _).trans _; simp
 end
 
+/-- auxilary defintion of drop over weak sequences-/
 @[simp] def drop.aux : ℕ → option (α × wseq α) → computation (option (α × wseq α))
 | 0     := return
 | (n+1) := λ a, tail.aux a >>= drop.aux n
@@ -590,7 +597,7 @@ theorem head_terminates_of_head_tail_terminates (s : wseq α) [T : terminates (h
   simp [tail] at h,
   rcases exists_of_mem_bind h with ⟨s', h1, h2⟩,
   unfold functor.map at h1,
-  exact let ⟨t, h3, h4⟩ := exists_of_mem_map h1 in terminates_of_mem h3
+  exact let ⟨t, h3, h4⟩ := computation.exists_of_mem_map h1 in computation.terminates_of_mem h3
 end
 
 theorem destruct_some_of_destruct_tail_some {s : wseq α} {a}
@@ -598,7 +605,7 @@ theorem destruct_some_of_destruct_tail_some {s : wseq α} {a}
 begin
   unfold tail functor.map at h, simp at h,
   rcases exists_of_mem_bind h with ⟨t, tm, td⟩, clear h,
-  rcases exists_of_mem_map tm with ⟨t', ht', ht2⟩, clear tm,
+  rcases computation.exists_of_mem_map tm with ⟨t', ht', ht2⟩, clear tm,
   cases t' with t'; rw ←ht2 at td; simp at td,
   { have := mem_unique td (ret_mem _), contradiction },
   { exact ⟨_, ht'⟩ }
@@ -608,10 +615,10 @@ theorem head_some_of_head_tail_some {s : wseq α} {a}
   (h : some a ∈ head (tail s)) : ∃ a', some a' ∈ head s :=
 begin
   unfold head at h,
-  rcases exists_of_mem_map h with ⟨o, md, e⟩, clear h,
+  rcases computation.exists_of_mem_map h with ⟨o, md, e⟩, clear h,
   cases o with o; injection e with h', clear e h',
   cases destruct_some_of_destruct_tail_some md with a am,
-  exact ⟨_, mem_map ((<$>) (@prod.fst α (wseq α))) am⟩
+  exact ⟨_, computation.mem_map ((<$>) (@prod.fst α (wseq α))) am⟩
 end
 
 theorem head_some_of_nth_some {s : wseq α} {a n}
@@ -630,7 +637,7 @@ instance productive_dropn (s : wseq α) [productive s] (n) : productive (drop s
 /-- Given a productive weak sequence, we can collapse all the `think`s to
   produce a sequence. -/
 def to_seq (s : wseq α) [productive s] : seq α :=
-⟨λ n, (nth s n).get, λn h,
+⟨λ n, (nth s n).get, λ n h,
 begin
   cases e : computation.get (nth s (n + 1)), {assumption},
   have := mem_of_get_eq _ e,
@@ -677,7 +684,7 @@ theorem eq_or_mem_iff_mem {s : wseq α} {a a' s'} :
 begin
   generalize e : destruct s = c, intro h,
   revert s, apply computation.mem_rec_on h _ (λ c IH, _); intro s;
-  apply s.cases_on _ (λ x s, _) (λ s, _); intros m;
+  apply s.rec_on _ (λ x s, _) (λ s, _); intros m;
   have := congr_arg computation.destruct m; simp at this;
   cases this with i1 i2,
   { rw [i1, i2],
@@ -685,7 +692,7 @@ begin
     unfold cons has_mem.mem wseq.mem seq.mem seq.cons, simp,
     have h_a_eq_a' : a = a' ↔ some (some a) = some (some a'), {simp},
     rw [h_a_eq_a'],
-    refine ⟨stream.eq_or_mem_of_mem_cons, λo, _⟩,
+    refine ⟨stream.eq_or_mem_of_mem_cons, λ o, _⟩,
     { cases o with e m,
       { rw e, apply stream.mem_cons },
       { exact stream.mem_cons_of_mem _ m } } },
@@ -704,7 +711,7 @@ theorem mem_cons (s : wseq α) (a) : a ∈ cons a s :=
 theorem mem_of_mem_tail {s : wseq α} {a} : a ∈ tail s → a ∈ s :=
 begin
   intro h, have := h, cases h with n e, revert s, simp [stream.nth],
-  induction n with n IH; intro s; apply s.cases_on _ (λx s, _) (λ s, _);
+  induction n with n IH; intro s; apply s.rec_on _ (λ x s, _) (λ s, _);
     repeat{simp}; intros m e; injections,
   { exact or.inr m },
   { exact or.inr m },
@@ -718,7 +725,7 @@ theorem mem_of_mem_dropn {s : wseq α} {a} : ∀ {n}, a ∈ drop s n → a ∈ s
 theorem nth_mem {s : wseq α} {a n} : some a ∈ nth s n → a ∈ s :=
 begin
   revert s, induction n with n IH; intros s h,
-  { rcases exists_of_mem_map h with ⟨o, h1, h2⟩,
+  { rcases computation.exists_of_mem_map h with ⟨o, h1, h2⟩,
     cases o with o; injection h2 with h',
     cases o with a' s',
     exact (eq_or_mem_iff_mem h1).2 (or.inl h'.symm) },
@@ -741,7 +748,7 @@ theorem exists_dropn_of_mem {s : wseq α} {a} (h : a ∈ s) :
   ∃ n s', some (a, s') ∈ destruct (drop s n) :=
 let ⟨n, h⟩ := exists_nth_of_mem h in ⟨n, begin
   rcases (head_terminates_iff _).1 ⟨⟨_, h⟩⟩ with ⟨⟨o, om⟩⟩,
-  have := mem_unique (mem_map _ om) h,
+  have := computation.mem_unique (computation.mem_map _ om) h,
   cases o with o; injection this with i,
   cases o with a' s', dsimp at i,
   rw i at om, exact ⟨_, om⟩
@@ -764,9 +771,9 @@ end
 theorem exists_of_lift_rel_left {R : α → β → Prop} {s t}
   (H : lift_rel R s t) {a} (h : a ∈ s) : ∃ {b}, b ∈ t ∧ R a b :=
 let ⟨n, h⟩ := exists_nth_of_mem h,
-    ⟨some (._, s'), sd, rfl⟩ := exists_of_mem_map h,
+    ⟨some (._, s'), sd, rfl⟩ := computation.exists_of_mem_map h,
     ⟨some (b, t'), td, ⟨ab, _⟩⟩ := (lift_rel_dropn_destruct H n).left sd in
-⟨b, nth_mem (mem_map ((<$>) prod.fst.{v v}) td), ab⟩
+⟨b, nth_mem (computation.mem_map ((<$>) prod.fst.{v v}) td), ab⟩
 
 theorem exists_of_lift_rel_right {R : α → β → Prop} {s t}
   (H : lift_rel R s t) {b} (h : b ∈ t) : ∃ {a}, a ∈ s ∧ R a b :=
@@ -806,7 +813,7 @@ by unfold equiv; simp; exact h
 theorem think_equiv (s : wseq α) : think s ~ s :=
 by unfold equiv; simp; apply equiv.refl
 
-theorem think_congr {s t : wseq α} (a : α) (h : s ~ t) : think s ~ think t :=
+theorem think_congr {s t : wseq α} (h : s ~ t) : think s ~ think t :=
 by unfold equiv; simp; exact h
 
 theorem head_congr : ∀ {s t : wseq α}, s ~ t → head s ~ head t :=
@@ -819,11 +826,11 @@ begin
   cases destruct_congr h with l r,
   rcases l dsm with ⟨dt, dtm, dst⟩,
   cases ds with a; cases dt with b,
-  { apply mem_map _ dtm },
+  { apply computation.mem_map _ dtm },
   { cases b, cases dst },
   { cases a, cases dst },
   { cases a with a s', cases b with b t', rw dst.left,
-    exact @mem_map _ _ (@functor.map _ _ (α × wseq α) _ prod.fst)
+    exact @computation.mem_map _ _ (@functor.map _ _ (α × wseq α) _ prod.fst)
       _ (destruct t) dtm }
 end
 
@@ -877,33 +884,34 @@ by simp only [productive_iff]; exact
   forall_congr (λ n, terminates_congr $ nth_congr h _)
 
 theorem equiv.ext {s t : wseq α} (h : ∀ n, nth s n ~ nth t n) : s ~ t :=
-⟨λ s t, ∀ n, nth s n ~ nth t n, h, λs t h, begin
+⟨λ s t, ∀ n, nth s n ~ nth t n, h, λ s t h, begin
   refine lift_rel_def.2 ⟨_, _⟩,
   { rw [←head_terminates_iff, ←head_terminates_iff],
     exact terminates_congr (h 0) },
   { intros a b ma mb,
     cases a with a; cases b with b,
     { trivial },
-    { injection mem_unique (mem_map _ ma) ((h 0 _).2 (mem_map _ mb)) },
-    { injection mem_unique (mem_map _ ma) ((h 0 _).2 (mem_map _ mb)) },
+    { injection mem_unique (computation.mem_map _ ma) ((h 0 _).2 (computation.mem_map _ mb)) },
+    { injection mem_unique (computation.mem_map _ ma) ((h 0 _).2 (computation.mem_map _ mb)) },
     { cases a with a s', cases b with b t',
-      injection mem_unique (mem_map _ ma) ((h 0 _).2 (mem_map _ mb)) with ab,
+      injection mem_unique
+        (computation.mem_map _ ma) ((h 0 _).2 (computation.mem_map _ mb)) with ab,
       refine ⟨ab, λ n, _⟩,
-      refine (nth_congr (flatten_equiv (mem_map _ ma)) n).symm.trans
+      refine (nth_congr (flatten_equiv (computation.mem_map _ ma)) n).symm.trans
         ((_ : nth (tail s) n ~ nth (tail t) n).trans
-        (nth_congr (flatten_equiv (mem_map _ mb)) n)),
+        (nth_congr (flatten_equiv (computation.mem_map _ mb)) n)),
       rw [nth_tail, nth_tail], apply h } }
 end⟩
 
 theorem length_eq_map (s : wseq α) : length s = computation.map list.length (to_list s) :=
 begin
-  refine eq_of_bisim
+  refine computation.eq_of_bisim
     (λ c1 c2, ∃ (l : list α) (s : wseq α),
-      c1 = corec length._match_2 (l.length, s) ∧
-      c2 = computation.map list.length (corec to_list._match_2 (l, s)))
+      c1 = computation.corec length._match_2 (l.length, s) ∧
+      c2 = computation.map list.length (computation.corec to_list._match_2 (l, s)))
     _ ⟨[], s, rfl, rfl⟩,
   intros s1 s2 h, rcases h with ⟨l, s, h⟩, rw [h.left, h.right],
-  apply s.cases_on _ (λ a s, _) (λ s, _);
+  apply s.rec_on _ (λ a s, _) (λ s, _);
     repeat {simp [to_list, nil, cons, think, length]},
   { refine ⟨a::l, s, _, _⟩; simp },
   { refine ⟨l, s, _, _⟩; simp }
@@ -917,30 +925,30 @@ show seq.map some (seq.of_list (a :: l)) =
      seq.cons (some a) (seq.map some (seq.of_list l)), by simp
 
 @[simp] theorem to_list'_nil (l : list α) :
-  corec to_list._match_2 (l, nil) = return l.reverse :=
+  computation.corec to_list._match_2 (l, nil) = return l.reverse :=
 destruct_eq_ret rfl
 
 @[simp] theorem to_list'_cons (l : list α) (s : wseq α) (a : α) :
-  corec to_list._match_2 (l, cons a s) =
-  (corec to_list._match_2 (a::l, s)).think :=
+  computation.corec to_list._match_2 (l, cons a s) =
+  (computation.corec to_list._match_2 (a::l, s)).think :=
 destruct_eq_think $ by simp [to_list, cons]
 
 @[simp] theorem to_list'_think (l : list α) (s : wseq α) :
-  corec to_list._match_2 (l, think s) =
-  (corec to_list._match_2 (l, s)).think :=
+  computation.corec to_list._match_2 (l, think s) =
+  (computation.corec to_list._match_2 (l, s)).think :=
 destruct_eq_think $ by simp [to_list, think]
 
 theorem to_list'_map (l : list α) (s : wseq α) :
-  corec to_list._match_2 (l, s) =
+  computation.corec to_list._match_2 (l, s) =
   ((++) l.reverse) <$> to_list s :=
 begin
-  refine eq_of_bisim
+  refine computation.eq_of_bisim
     (λ c1 c2, ∃ (l' : list α) (s : wseq α),
-      c1 = corec to_list._match_2 (l' ++ l, s) ∧
-      c2 = computation.map ((++) l.reverse) (corec to_list._match_2 (l', s)))
+      c1 = computation.corec to_list._match_2 (l' ++ l, s) ∧
+      c2 = computation.map ((++) l.reverse) (computation.corec to_list._match_2 (l', s)))
     _ ⟨[], s, rfl, rfl⟩,
   intros s1 s2 h, rcases h with ⟨l', s, h⟩, rw [h.left, h.right],
-  apply s.cases_on _ (λ a s, _) (λ s, _);
+  apply s.rec_on _ (λ a s, _) (λ s, _);
     repeat {simp [to_list, nil, cons, think, length]},
   { refine ⟨a::l', s, _, _⟩; simp },
   { refine ⟨l', s, _, _⟩; simp }
@@ -954,7 +962,7 @@ destruct_eq_think $ by unfold to_list; simp; rw to_list'_map; simp; refl
 destruct_eq_ret rfl
 
 theorem to_list_of_list (l : list α) : l ∈ to_list (of_list l) :=
-by induction l with a l IH; simp [ret_mem]; exact think_mem (mem_map _ IH)
+by induction l with a l IH; simp [ret_mem]; exact think_mem (computation.mem_map _ IH)
 
 @[simp] theorem destruct_of_seq (s : seq α) :
   destruct (of_seq s) = return (s.head.map $ λ a, (a, of_seq s.tail)) :=
@@ -971,7 +979,7 @@ by simp [head]; cases seq.head s; refl
 
 @[simp] theorem tail_of_seq (s : seq α) : tail (of_seq s) = of_seq s.tail :=
 begin
-  simp [tail], apply s.cases_on _ (λ x s, _); simp [of_seq], {refl},
+  simp [tail], apply s.rec_on _ (λ x s, _); simp [of_seq], {refl},
   rw [seq.head_cons, seq.tail_cons], refl
 end
 
@@ -1028,7 +1036,7 @@ suffices ∀ ss : wseq α, a ∈ ss → ∀ s S, append s (join S) = ss →
   (this _ h nil S (by simp) (by simp [h])).resolve_left (not_mem_nil _),
 begin
   intros ss h, apply mem_rec_on h (λ b ss o, _) (λ ss IH, _); intros s S,
-  { refine s.cases_on (S.cases_on _ (λ s S, _) (λ S, _)) (λ b' s, _) (λ s, _);
+  { refine s.rec_on (S.rec_on _ (λ s S, _) (λ S, _)) (λ b' s, _) (λ s, _);
     intros ej m; simp at ej;
     have := congr_arg seq.destruct ej; simp at this;
     try {cases this}; try {contradiction},
@@ -1037,7 +1045,7 @@ begin
     cases o with e IH, { simp [e] },
     cases m with e m, { simp [e] },
     exact or.imp_left or.inr (IH _ _ rfl m) },
-  { refine s.cases_on (S.cases_on _ (λ s S, _) (λ S, _)) (λ b' s, _) (λ s, _);
+  { refine s.rec_on (S.rec_on _ (λ s S, _) (λ S, _)) (λ b' s, _) (λ s, _);
     intros ej m; simp at ej;
     have := congr_arg seq.destruct ej; simp at this;
     try { try {have := this.1}, contradiction }; subst ss,
@@ -1060,10 +1068,10 @@ let ⟨t, tm, bt⟩ := exists_of_mem_join h,
 theorem destruct_map (f : α → β) (s : wseq α) :
   destruct (map f s) = computation.map (option.map (prod.map f (map f))) (destruct s) :=
 begin
-  apply eq_of_bisim (λ c1 c2, ∃ s, c1 = destruct (map f s) ∧
+  apply computation.eq_of_bisim (λ c1 c2, ∃ s, c1 = destruct (map f s) ∧
     c2 = computation.map (option.map (prod.map f (map f))) (destruct s)),
   { intros c1 c2 h, cases h with s h, rw [h.left, h.right],
-    apply s.cases_on _ (λ a s, _) (λ s, _); simp,
+    apply s.rec_on _ (λ a s, _) (λ s, _); simp,
     exact ⟨s, rfl, rfl⟩ },
   { exact ⟨s, rfl, rfl⟩ }
 end
@@ -1088,6 +1096,7 @@ end end⟩
 theorem map_congr (f : α → β) {s t : wseq α} (h : s ~ t) : map f s ~ map f t :=
 lift_rel_map _ _ h (λ _ _, congr_arg _)
 
+/-- auxilary defintion of `destruct_append` over weak sequences-/
 @[simp] def destruct_append.aux (t : wseq α) :
   option (α × wseq α) → computation (option (α × wseq α))
 | none          := destruct t
@@ -1096,15 +1105,16 @@ lift_rel_map _ _ h (λ _ _, congr_arg _)
 theorem destruct_append (s t : wseq α) :
   destruct (append s t) = (destruct s).bind (destruct_append.aux t) :=
 begin
-  apply eq_of_bisim (λ c1 c2, ∃ s t, c1 = destruct (append s t) ∧
+  apply computation.eq_of_bisim (λ c1 c2, ∃ s t, c1 = destruct (append s t) ∧
     c2 = (destruct s).bind (destruct_append.aux t)) _ ⟨s, t, rfl, rfl⟩,
   intros c1 c2 h, rcases h with ⟨s, t, h⟩, rw [h.left, h.right],
-  apply s.cases_on _ (λ a s, _) (λ s, _); simp,
-  { apply t.cases_on _ (λ b t, _) (λ t, _); simp,
+  apply s.rec_on _ (λ a s, _) (λ s, _); simp,
+  { apply t.rec_on _ (λ b t, _) (λ t, _); simp,
     { refine ⟨nil, t, _, _⟩; simp } },
   { exact ⟨s, t, rfl, rfl⟩ }
 end
 
+/-- auxilary defintion of `destruct_join` over weak sequences-/
 @[simp] def destruct_join.aux : option (wseq α × wseq (wseq α)) → computation (option (α × wseq α))
 | none          := return none
 | (some (s, S)) := (destruct (append s (join S))).think
@@ -1112,12 +1122,12 @@ end
 theorem destruct_join (S : wseq (wseq α)) :
   destruct (join S) = (destruct S).bind destruct_join.aux :=
 begin
-  apply eq_of_bisim (λ c1 c2, c1 = c2 ∨ ∃ S, c1 = destruct (join S) ∧
+  apply computation.eq_of_bisim (λ c1 c2, c1 = c2 ∨ ∃ S, c1 = destruct (join S) ∧
     c2 = (destruct S).bind destruct_join.aux) _ (or.inr ⟨S, rfl, rfl⟩),
   intros c1 c2 h, exact match c1, c2, h with
   | _, _, (or.inl $ eq.refl c) := by cases c.destruct; simp
   | _, _, or.inr ⟨S, rfl, rfl⟩ := begin
-    apply S.cases_on _ (λ s S, _) (λ S, _); simp,
+    apply S.rec_on _ (λ s S, _) (λ S, _); simp,
     { refine or.inr ⟨S, rfl, rfl⟩ }
   end end
 end
@@ -1194,7 +1204,7 @@ theorem lift_rel_join (R : α → β → Prop) {S : wseq (wseq α)} {T : wseq (w
   s1 = append s (join S) ∧ s2 = append t (join T) ∧
   lift_rel R s t ∧ lift_rel (lift_rel R) S T,
   ⟨nil, nil, S, T, by simp, by simp, by simp, h⟩,
-λs1 s2 ⟨s, t, S, T, h1, h2, st, ST⟩, begin
+λ s1 s2 ⟨s, t, S, T, h1, h2, st, ST⟩, begin
   clear _fun_match _x,
   rw [h1, h2], rw [destruct_append, destruct_append],
   apply computation.lift_rel_bind _ _ (lift_rel_destruct st),
@@ -1243,7 +1253,7 @@ begin
       clear h _match,
       have : ∀ s, ∃ s' : wseq α, (map ret s).join.destruct = (map ret s').join.destruct ∧
         destruct s = s'.destruct, from λ s, ⟨s, rfl, rfl⟩,
-      apply s.cases_on _ (λ a s, _) (λ s, _); simp [ret, ret_mem, this, option.exists]
+      apply s.rec_on _ (λ a s, _) (λ s, _); simp [ret, ret_mem, this, option.exists]
     end end },
   { exact ⟨s, rfl, rfl⟩ }
 end
@@ -1263,9 +1273,9 @@ begin
   intros c1 c2 h,
   exact match c1, c2, h with ._, ._, ⟨s, S, T, rfl, rfl⟩ := begin
     clear _match h h,
-    apply wseq.cases_on s _ (λ a s, _) (λ s, _); simp,
-    { apply wseq.cases_on S _ (λ s S, _) (λ S, _); simp,
-      { apply wseq.cases_on T _ (λ s T, _) (λ T, _); simp,
+    apply wseq.rec_on s _ (λ a s, _) (λ s, _); simp,
+    { apply wseq.rec_on S _ (λ s S, _) (λ S, _); simp,
+      { apply wseq.rec_on T _ (λ s T, _) (λ T, _); simp,
         { refine ⟨s, nil, T, _, _⟩; simp },
         { refine ⟨nil, nil, T, _, _⟩; simp } },
       { exact ⟨s, S, T, rfl, rfl⟩ },
@@ -1277,7 +1287,7 @@ end
 
 @[simp] theorem bind_ret (f : α → β) (s) : bind s (ret ∘ f) ~ map f s :=
 begin
-  dsimp [bind], change (λx, ret (f x)) with (ret ∘ f),
+  dsimp [bind], change (λ x, ret (f x)) with (ret ∘ f),
   rw [map_comp], apply join_map_ret
 end
 
@@ -1287,13 +1297,13 @@ end
 @[simp] theorem map_join (f : α → β) (S) :
   map f (join S) = join (map (map f) S) :=
 begin
-  apply seq.eq_of_bisim (λs1 s2,
+  apply seq.eq_of_bisim (λ s1 s2,
     ∃ s S, s1 = append s (map f (join S)) ∧
       s2 = append s (join (map (map f) S))),
   { intros s1 s2 h,
     exact match s1, s2, h with ._, ._, ⟨s, S, rfl, rfl⟩ := begin
-      apply wseq.cases_on s _ (λ a s, _) (λ s, _); simp,
-      { apply wseq.cases_on S _ (λ s S, _) (λ S, _); simp,
+      apply wseq.rec_on s _ (λ a s, _) (λ s, _); simp,
+      { apply wseq.rec_on S _ (λ s S, _) (λ S, _); simp,
         { exact ⟨map f s, S, rfl, rfl⟩ },
         { refine ⟨nil, S, _, _⟩; simp } },
       { exact ⟨_, _, rfl, rfl⟩ },
@@ -1318,9 +1328,9 @@ begin
   intros c1 c2 h,
   exact match c1, c2, h with ._, ._, ⟨s, S, SS, rfl, rfl⟩ := begin
     clear _match h h,
-    apply wseq.cases_on s _ (λ a s, _) (λ s, _); simp,
-    { apply wseq.cases_on S _ (λ s S, _) (λ S, _); simp,
-      { apply wseq.cases_on SS _ (λ S SS, _) (λ SS, _); simp,
+    apply wseq.rec_on s _ (λ a s, _) (λ s, _); simp,
+    { apply wseq.rec_on S _ (λ s S, _) (λ S, _); simp,
+      { apply wseq.rec_on SS _ (λ S SS, _) (λ SS, _); simp,
         { refine ⟨nil, S, SS, _, _⟩; simp },
         { refine ⟨nil, nil, SS, _, _⟩; simp } },
       { exact ⟨s, S, SS, rfl, rfl⟩ },
@@ -1358,3 +1368,4 @@ instance : is_lawful_monad wseq :=
 -/
 
 end wseq
+end stream
diff --git a/src/data/set/Union_lift.lean b/src/data/set/Union_lift.lean
index c65156fc3296e..017854b0d7b2d 100644
--- a/src/data/set/Union_lift.lean
+++ b/src/data/set/Union_lift.lean
@@ -7,6 +7,9 @@ import data.set.lattice
 import order.directed
 /-!
 # Union lift
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines `set.Union_lift` to glue together functions defined on each of a collection of
 sets to make a function on the Union of those sets.
 
@@ -35,7 +38,7 @@ constants, unary functions, or binary functions are preserved. These lemmas are:
 directed union, directed supremum, glue, gluing
 -/
 
-variables {α ι β : Type*}
+variables {α : Type*} {ι β : Sort*}
 
 namespace set
 
diff --git a/src/data/set/accumulate.lean b/src/data/set/accumulate.lean
index 6e7eb323a9778..9e57338b44c66 100644
--- a/src/data/set/accumulate.lean
+++ b/src/data/set/accumulate.lean
@@ -7,6 +7,9 @@ import data.set.lattice
 /-!
 # Accumulate
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The function `accumulate` takes a set `s` and returns `⋃ y ≤ x, s y`.
 -/
 
diff --git a/src/data/set/basic.lean b/src/data/set/basic.lean
index 42e5bb1f8a96f..065bb077cb029 100644
--- a/src/data/set/basic.lean
+++ b/src/data/set/basic.lean
@@ -3,11 +3,15 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Leonardo de Moura
 -/
-import order.boolean_algebra
+import order.symm_diff
+import logic.function.iterate
 
 /-!
 # Basic properties of sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Sets in Lean are homogeneous; all their elements have the same type. Sets whose elements
 have type `X` are thus defined as `set X := X → Prop`. Note that this function need not
 be decidable. The definition is in the core library.
@@ -36,21 +40,14 @@ Definitions in the file:
 * `nonempty s : Prop` : the predicate `s ≠ ∅`. Note that this is the preferred way to express the
   fact that `s` has an element (see the Implementation Notes).
 
-* `preimage f t : set α` : the preimage f⁻¹(t) (written `f ⁻¹' t` in Lean) of a subset of β.
-
 * `subsingleton s : Prop` : the predicate saying that `s` has at most one element.
 
-* `range f : set β` : the image of `univ` under `f`.
-  Also works for `{p : Prop} (f : p → α)` (unlike `image`)
+* `nontrivial s : Prop` : the predicate saying that `s` has at least two distinct elements.
 
 * `inclusion s₁ s₂ : ↥s₁ → ↥s₂` : the map `↥s₁ → ↥s₂` induced by an inclusion `s₁ ⊆ s₂`.
 
 ## Notation
 
-* `f ⁻¹' t` for `preimage f t`
-
-* `f '' s` for `image f s`
-
 * `sᶜ` for the complement of `s`
 
 ## Implementation notes
@@ -62,8 +59,7 @@ the `s.nonempty` dot notation can be used.
 
 ## Tags
 
-set, sets, subset, subsets, image, preimage, pre-image, range, union, intersection, insert,
-singleton, complement, powerset
+set, sets, subset, subsets, union, intersection, insert, singleton, complement, powerset
 
 -/
 
@@ -73,61 +69,62 @@ open function
 
 universes u v w x
 
-run_cmd do e ← tactic.get_env,
-  tactic.set_env $ e.mk_protected `set.compl
-
 namespace set
 
-variable {α : Type*}
+variables {α : Type*} {s t : set α}
 
-instance : has_le (set α) := ⟨(⊆)⟩
-instance : has_lt (set α) := ⟨λ s t, s ≤ t ∧ ¬t ≤ s⟩  -- `⊂` is not defined until further down
+instance : has_le (set α) := ⟨λ s t, ∀ ⦃x⦄, x ∈ s → x ∈ t⟩
+instance : has_subset (set α) := ⟨(≤)⟩
 
 instance {α : Type*} : boolean_algebra (set α) :=
-{ sup := (∪),
+{ sup := λ s t, {x | x ∈ s ∨ x ∈ t},
   le  := (≤),
-  lt  := (<),
-  inf := (∩),
+  lt  := λ s t, s ⊆ t ∧ ¬t ⊆ s,
+  inf := λ s t, {x | x ∈ s ∧ x ∈ t},
   bot := ∅,
-  compl := set.compl,
+  compl := λ s, {x | x ∉ s},
   top := univ,
-  sdiff := (\),
+  sdiff := λ s t, {x | x ∈ s ∧ x ∉ t},
   .. (infer_instance : boolean_algebra (α → Prop)) }
 
+instance : has_ssubset (set α) := ⟨(<)⟩
+instance : has_union (set α) := ⟨(⊔)⟩
+instance : has_inter (set α) := ⟨(⊓)⟩
+
 @[simp] lemma top_eq_univ : (⊤ : set α) = univ := rfl
 @[simp] lemma bot_eq_empty : (⊥ : set α) = ∅ := rfl
 @[simp] lemma sup_eq_union : ((⊔) : set α → set α → set α) = (∪) := rfl
 @[simp] lemma inf_eq_inter : ((⊓) : set α → set α → set α) = (∩) := rfl
 @[simp] lemma le_eq_subset : ((≤) : set α → set α → Prop) = (⊆) := rfl
-/-! `set.lt_eq_ssubset` is defined further down -/
-@[simp] lemma compl_eq_compl : set.compl = (has_compl.compl : set α → set α) := rfl
+@[simp] lemma lt_eq_ssubset : ((<) : set α → set α → Prop) = (⊂) := rfl
+
+lemma le_iff_subset : s ≤ t ↔ s ⊆ t := iff.rfl
+lemma lt_iff_ssubset : s < t ↔ s ⊂ t := iff.rfl
+
+alias le_iff_subset ↔ _root_.has_le.le.subset _root_.has_subset.subset.le
+alias lt_iff_ssubset ↔ _root_.has_lt.lt.ssubset _root_.has_ssubset.ssubset.lt
 
 /-- Coercion from a set to the corresponding subtype. -/
 instance {α : Type u} : has_coe_to_sort (set α) (Type u) := ⟨λ s, {x // x ∈ s}⟩
 
 instance pi_set_coe.can_lift (ι : Type u) (α : Π i : ι, Type v) [ne : Π i, nonempty (α i)]
   (s : set ι) :
-  can_lift (Π i : s, α i) (Π i, α i) :=
-{ coe := λ f i, f i,
-  .. pi_subtype.can_lift ι α s }
+  can_lift (Π i : s, α i) (Π i, α i) (λ f i, f i) (λ _, true) :=
+pi_subtype.can_lift ι α s
 
 instance pi_set_coe.can_lift' (ι : Type u) (α : Type v) [ne : nonempty α] (s : set ι) :
-  can_lift (s → α) (ι → α) :=
+  can_lift (s → α) (ι → α) (λ f i, f i) (λ _, true) :=
 pi_set_coe.can_lift ι (λ _, α) s
 
-instance set_coe.can_lift (s : set α) : can_lift α s :=
-{ coe := coe,
-  cond := λ a, a ∈ s,
-  prf := λ a ha, ⟨⟨a, ha⟩, rfl⟩ }
-
 end set
 
 section set_coe
 
 variables {α : Type u}
 
-theorem set.set_coe_eq_subtype (s : set α) :
-  coe_sort.{(u+1) (u+2)} s = {x // x ∈ s} := rfl
+theorem set.coe_eq_subtype (s : set α) : ↥s = {x // x ∈ s} := rfl
+
+@[simp] theorem set.coe_set_of (p : α → Prop) : ↥{x | p x} = {x // p x} := rfl
 
 @[simp] theorem set_coe.forall {s : set α} {p : s → Prop} :
   (∀ x : s, p x) ↔ (∀ x (h : x ∈ s), p ⟨x, h⟩) :=
@@ -138,14 +135,14 @@ subtype.forall
 subtype.exists
 
 theorem set_coe.exists' {s : set α} {p : Π x, x ∈ s → Prop} :
-  (∃ x (h : x ∈ s), p x h) ↔ (∃ x : s, p x x.2)  :=
+  (∃ x (h : x ∈ s), p x h) ↔ (∃ x : s, p x x.2) :=
 (@set_coe.exists _ _ $ λ x, p x.1 x.2).symm
 
 theorem set_coe.forall' {s : set α} {p : Π x, x ∈ s → Prop} :
-  (∀ x (h : x ∈ s), p x h) ↔ (∀ x : s, p x x.2)  :=
+  (∀ x (h : x ∈ s), p x h) ↔ (∀ x : s, p x x.2) :=
 (@set_coe.forall _ _ $ λ x, p x.1 x.2).symm
 
-@[simp] theorem set_coe_cast : ∀ {s t : set α} (H' : s = t) (H : @eq (Type u) s t) (x : s),
+@[simp] theorem set_coe_cast : ∀ {s t : set α} (H' : s = t) (H : ↥s = ↥t) (x : s),
   cast H x = ⟨x.1, H' ▸ x.2⟩
 | s _ rfl _ ⟨x, h⟩ := rfl
 
@@ -161,12 +158,11 @@ end set_coe
 lemma subtype.mem {α : Type*} {s : set α} (p : s) : (p : α) ∈ s := p.prop
 
 /-- Duplicate of `eq.subset'`, which currently has elaboration problems. -/
-lemma eq.subset {α} {s t : set α} : s = t → s ⊆ t :=
-by { rintro rfl x hx, exact hx }
+lemma eq.subset {α} {s t : set α} : s = t → s ⊆ t := eq.subset'
 
 namespace set
 
-variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x} {a b : α} {s t : set α}
+variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x} {a b : α} {s s₁ s₂ t t₁ t₂ u : set α}
 
 instance : inhabited (set α) := ⟨∅⟩
 
@@ -185,8 +181,6 @@ by tauto
 
 /-! ### Lemmas about `mem` and `set_of` -/
 
-@[simp] theorem mem_set_of_eq {a : α} {p : α → Prop} : a ∈ {x | p x} = p a := rfl
-
 lemma mem_set_of {a : α} {p : α → Prop} : a ∈ {x | p x} ↔ p a := iff.rfl
 
 /-- If `h : a ∈ {x | p x}` then `h.out : p x`. These are definitionally equal, but this can
@@ -194,13 +188,13 @@ nevertheless be useful for various reasons, e.g. to apply further projection not
 argument to `simp`. -/
 lemma _root_.has_mem.mem.out {p : α → Prop} {a : α} (h : a ∈ {x | p x}) : p a := h
 
-theorem nmem_set_of_eq {a : α} {p : α → Prop} : a ∉ {x | p x} = ¬ p a := rfl
+theorem nmem_set_of_iff {a : α} {p : α → Prop} : a ∉ {x | p x} ↔ ¬ p a := iff.rfl
 
 @[simp] theorem set_of_mem_eq {s : set α} : {x | x ∈ s} = s := rfl
 
 theorem set_of_set {s : set α} : set_of s = s := rfl
 
-lemma set_of_app_iff {p : α → Prop} {x : α} : { x | p x } x ↔ p x := iff.rfl
+lemma set_of_app_iff {p : α → Prop} {x : α} : {x | p x} x ↔ p x := iff.rfl
 
 theorem mem_def {a : α} {s : set α} : a ∈ s ↔ s a := iff.rfl
 
@@ -209,16 +203,12 @@ lemma set_of_bijective : bijective (set_of : (α → Prop) → set α) := biject
 @[simp] theorem set_of_subset_set_of {p q : α → Prop} :
   {a | p a} ⊆ {a | q a} ↔ (∀a, p a → q a) := iff.rfl
 
-@[simp] lemma sep_set_of {p q : α → Prop} : {a ∈ {a | p a } | q a} = {a | p a ∧ q a} := rfl
-
 lemma set_of_and {p q : α → Prop} : {a | p a ∧ q a} = {a | p a} ∩ {a | q a} := rfl
 
 lemma set_of_or {p q : α → Prop} : {a | p a ∨ q a} = {a | p a} ∪ {a | q a} := rfl
 
 /-! ### Subset and strict subset relations -/
 
-instance : has_ssubset (set α) := ⟨(<)⟩
-
 instance : is_refl (set α) (⊆) := has_le.le.is_refl
 instance : is_trans (set α) (⊆) := has_le.le.is_trans
 instance : is_antisymm (set α) (⊆) := has_le.le.is_antisymm
@@ -255,18 +245,8 @@ mt $ mem_of_subset_of_mem h
 
 theorem not_subset : (¬ s ⊆ t) ↔ ∃a ∈ s, a ∉ t := by simp only [subset_def, not_forall]
 
-theorem nontrivial_mono {α : Type*} {s t : set α} (h₁ : s ⊆ t) (h₂ : nontrivial s) :
-  nontrivial t :=
-begin
-  rw nontrivial_iff at h₂ ⊢,
-  obtain ⟨⟨x, hx⟩, ⟨y, hy⟩, hxy⟩ := h₂,
-  exact ⟨⟨x, h₁ hx⟩, ⟨y, h₁ hy⟩, by simpa using hxy⟩,
-end
-
 /-! ### Definition of strict subsets `s ⊂ t` and basic properties. -/
 
-@[simp] lemma lt_eq_ssubset : ((<) : set α → set α → Prop) = (⊂) := rfl
-
 protected theorem eq_or_ssubset_of_subset (h : s ⊆ t) : s = t ∨ s ⊂ t :=
 eq_or_lt_of_le h
 
@@ -300,7 +280,9 @@ in theorem assumptions instead of `∃ x, x ∈ s` or `s ≠ ∅` as it gives ac
 to the dot notation. -/
 protected def nonempty (s : set α) : Prop := ∃ x, x ∈ s
 
-@[simp] lemma nonempty_coe_sort (s : set α) : nonempty ↥s ↔ s.nonempty := nonempty_subtype
+@[simp] lemma nonempty_coe_sort {s : set α} : nonempty ↥s ↔ s.nonempty := nonempty_subtype
+
+alias nonempty_coe_sort ↔ _ nonempty.coe_sort
 
 lemma nonempty_def : s.nonempty ↔ ∃ x, x ∈ s := iff.rfl
 
@@ -309,12 +291,6 @@ lemma nonempty_of_mem {x} (h : x ∈ s) : s.nonempty := ⟨x, h⟩
 theorem nonempty.not_subset_empty : s.nonempty → ¬(s ⊆ ∅)
 | ⟨x, hx⟩ hs := hs hx
 
-theorem nonempty.ne_empty : ∀ {s : set α}, s.nonempty → s ≠ ∅
-| _ ⟨x, hx⟩ rfl := hx
-
-@[simp] theorem not_nonempty_empty : ¬(∅ : set α).nonempty :=
-λ h, h.ne_empty rfl
-
 /-- Extract a witness from `s.nonempty`. This function might be used instead of case analysis
 on the argument. Note that it makes a proof depend on the `classical.choice` axiom. -/
 protected noncomputable def nonempty.some (h : s.nonempty) : α := classical.some h
@@ -343,11 +319,13 @@ lemma nonempty.left (h : (s ∩ t).nonempty) : s.nonempty := h.imp $ λ _, and.l
 
 lemma nonempty.right (h : (s ∩ t).nonempty) : t.nonempty := h.imp $ λ _, and.right
 
-lemma nonempty_inter_iff_exists_right : (s ∩ t).nonempty ↔ ∃ x : t, ↑x ∈ s :=
-⟨λ ⟨x, xs, xt⟩, ⟨⟨x, xt⟩, xs⟩, λ ⟨⟨x, xt⟩, xs⟩, ⟨x, xs, xt⟩⟩
+lemma inter_nonempty : (s ∩ t).nonempty ↔ ∃ x, x ∈ s ∧ x ∈ t := iff.rfl
 
-lemma nonempty_inter_iff_exists_left : (s ∩ t).nonempty ↔ ∃ x : s, ↑x ∈ t :=
-⟨λ ⟨x, xs, xt⟩, ⟨⟨x, xs⟩, xt⟩, λ ⟨⟨x, xt⟩, xs⟩, ⟨x, xt, xs⟩⟩
+lemma inter_nonempty_iff_exists_left : (s ∩ t).nonempty ↔ ∃ x ∈ s, x ∈ t :=
+by simp_rw [inter_nonempty, exists_prop]
+
+lemma inter_nonempty_iff_exists_right : (s ∩ t).nonempty ↔ ∃ x ∈ t, x ∈ s :=
+by simp_rw [inter_nonempty, exists_prop, and_comm]
 
 lemma nonempty_iff_univ_nonempty : nonempty α ↔ (univ : set α).nonempty :=
 ⟨λ ⟨x⟩, ⟨x, trivial⟩, λ ⟨x, _⟩, ⟨x⟩⟩
@@ -355,13 +333,11 @@ lemma nonempty_iff_univ_nonempty : nonempty α ↔ (univ : set α).nonempty :=
 @[simp] lemma univ_nonempty : ∀ [h : nonempty α], (univ : set α).nonempty
 | ⟨x⟩ := ⟨x, trivial⟩
 
-lemma nonempty.to_subtype (h : s.nonempty) : nonempty s :=
-nonempty_subtype.2 h
+lemma nonempty.to_subtype : s.nonempty → nonempty s := nonempty_subtype.2
+lemma nonempty.to_type : s.nonempty → nonempty α := λ ⟨x, hx⟩, ⟨x⟩
 
 instance [nonempty α] : nonempty (set.univ : set α) := set.univ_nonempty.to_subtype
 
-@[simp] lemma nonempty_insert (a : α) (s : set α) : (insert a s).nonempty := ⟨a, or.inl rfl⟩
-
 lemma nonempty_of_nonempty_subtype [nonempty s] : s.nonempty :=
 nonempty_subtype.mp ‹_›
 
@@ -369,7 +345,7 @@ nonempty_subtype.mp ‹_›
 
 theorem empty_def : (∅ : set α) = {x | false} := rfl
 
-@[simp] theorem mem_empty_eq (x : α) : x ∈ (∅ : set α) = false := rfl
+@[simp] theorem mem_empty_iff_false (x : α) : x ∈ (∅ : set α) ↔ false := iff.rfl
 
 @[simp] theorem set_of_false : {a : α | false} = ∅ := rfl
 
@@ -388,19 +364,25 @@ theorem eq_empty_of_is_empty [is_empty α] (s : set α) : s = ∅ :=
 eq_empty_of_subset_empty $ λ x hx, is_empty_elim x
 
 /-- There is exactly one set of a type that is empty. -/
--- TODO[gh-6025]: make this an instance once safe to do so
-def unique_empty [is_empty α] : unique (set α) :=
+instance unique_empty [is_empty α] : unique (set α) :=
 { default := ∅, uniq := eq_empty_of_is_empty }
 
+/-- See also `set.nonempty_iff_ne_empty`. -/
 lemma not_nonempty_iff_eq_empty {s : set α} : ¬s.nonempty ↔ s = ∅ :=
 by simp only [set.nonempty, eq_empty_iff_forall_not_mem, not_exists]
 
-lemma empty_not_nonempty : ¬(∅ : set α).nonempty := λ h, h.ne_empty rfl
+/-- See also `set.not_nonempty_iff_eq_empty`. -/
+lemma nonempty_iff_ne_empty : s.nonempty ↔ s ≠ ∅ := not_nonempty_iff_eq_empty.not_right
 
-theorem ne_empty_iff_nonempty : s ≠ ∅ ↔ s.nonempty := not_iff_comm.1 not_nonempty_iff_eq_empty
+alias nonempty_iff_ne_empty ↔ nonempty.ne_empty _
+
+@[simp] lemma not_nonempty_empty : ¬(∅ : set α).nonempty := λ ⟨x, hx⟩, hx
+
+@[simp] lemma is_empty_coe_sort {s : set α} : is_empty ↥s ↔ s = ∅ :=
+not_iff_not.1 $ by simpa using nonempty_iff_ne_empty
 
 lemma eq_empty_or_nonempty (s : set α) : s = ∅ ∨ s.nonempty :=
-or_iff_not_imp_left.2 ne_empty_iff_nonempty.1
+or_iff_not_imp_left.2 nonempty_iff_ne_empty.2
 
 theorem subset_eq_empty {s t : set α} (h : t ⊆ s) (e : s = ∅) : t = ∅ :=
 subset_empty_iff.1 $ e ▸ h
@@ -412,7 +394,9 @@ instance (α : Type u) : is_empty.{u+1} (∅ : set α) :=
 ⟨λ x, x.2⟩
 
 @[simp] lemma empty_ssubset : ∅ ⊂ s ↔ s.nonempty :=
-(@bot_lt_iff_ne_bot (set α) _ _ _).trans ne_empty_iff_nonempty
+(@bot_lt_iff_ne_bot (set α) _ _ _).trans nonempty_iff_ne_empty.symm
+
+alias empty_ssubset ↔ _ nonempty.empty_ssubset
 
 /-!
 
@@ -425,7 +409,7 @@ Mathematically it is the same as `α` but it has a different type.
 
 @[simp] theorem set_of_true : {x : α | true} = univ := rfl
 
-@[simp] theorem mem_univ (x : α) : x ∈ @univ α := trivial
+@[simp, mfld_simps] theorem mem_univ (x : α) : x ∈ @univ α := trivial
 
 @[simp] lemma univ_eq_empty_iff : (univ : set α) = ∅ ↔ is_empty α :=
 eq_empty_iff_forall_not_mem.trans ⟨λ H, ⟨λ x, H x trivial⟩, λ H x _, @is_empty.false α H x⟩
@@ -435,16 +419,18 @@ theorem empty_ne_univ [nonempty α] : (∅ : set α) ≠ univ :=
 
 @[simp] theorem subset_univ (s : set α) : s ⊆ univ := λ x H, trivial
 
-theorem univ_subset_iff {s : set α} : univ ⊆ s ↔ s = univ :=
-(subset.antisymm_iff.trans $ and_iff_right (subset_univ _)).symm
+theorem univ_subset_iff {s : set α} : univ ⊆ s ↔ s = univ := @top_le_iff _ _ _ s
 
-theorem eq_univ_of_univ_subset {s : set α} : univ ⊆ s → s = univ := univ_subset_iff.1
+alias univ_subset_iff ↔ eq_univ_of_univ_subset _
 
 theorem eq_univ_iff_forall {s : set α} : s = univ ↔ ∀ x, x ∈ s :=
-univ_subset_iff.symm.trans $ forall_congr $ λ x, imp_iff_right ⟨⟩
+univ_subset_iff.symm.trans $ forall_congr $ λ x, imp_iff_right trivial
 
 theorem eq_univ_of_forall {s : set α} : (∀ x, x ∈ s) → s = univ := eq_univ_iff_forall.2
 
+lemma nonempty.eq_univ [subsingleton α] : s.nonempty → s = univ :=
+by { rintro ⟨x, hx⟩, refine eq_univ_of_forall (λ y, by rwa subsingleton.elim y x) }
+
 lemma eq_univ_of_subset {s t : set α} (h : s ⊆ t) (hs : s = univ) : t = univ :=
 eq_univ_of_univ_subset $ hs ▸ h
 
@@ -461,6 +447,10 @@ by simp [subset_def]
 lemma univ_unique [unique α] : @set.univ α = {default} :=
 set.ext $ λ x, iff_of_true trivial $ subsingleton.elim x default
 
+lemma ssubset_univ_iff : s ⊂ univ ↔ s ≠ univ := lt_top_iff_ne_top
+
+instance nontrivial_of_nonempty [nonempty α] : nontrivial (set α) := ⟨⟨∅, univ, empty_ne_univ⟩⟩
+
 /-! ### Lemmas about union -/
 
 theorem union_def {s₁ s₂ : set α} : s₁ ∪ s₂ = {a | a ∈ s₁ ∨ a ∈ s₂} := rfl
@@ -475,9 +465,7 @@ theorem mem_union.elim {x : α} {a b : set α} {P : Prop}
     (H₁ : x ∈ a ∪ b) (H₂ : x ∈ a → P) (H₃ : x ∈ b → P) : P :=
 or.elim H₁ H₂ H₃
 
-theorem mem_union (x : α) (a b : set α) : x ∈ a ∪ b ↔ x ∈ a ∨ x ∈ b := iff.rfl
-
-@[simp] theorem mem_union_eq (x : α) (a b : set α) : x ∈ a ∪ b = (x ∈ a ∨ x ∈ b) := rfl
+@[simp] theorem mem_union (x : α) (a b : set α) : x ∈ a ∪ b ↔ (x ∈ a ∨ x ∈ b) := iff.rfl
 
 @[simp] theorem union_self (a : set α) : a ∪ a = a := ext $ λ x, or_self _
 
@@ -536,6 +524,12 @@ subset.trans h (subset_union_left t u)
 lemma subset_union_of_subset_right {s u : set α} (h : s ⊆ u) (t : set α) : s ⊆ t ∪ u :=
 subset.trans h (subset_union_right t u)
 
+lemma union_congr_left (ht : t ⊆ s ∪ u) (hu : u ⊆ s ∪ t) : s ∪ t = s ⊔ u := sup_congr_left ht hu
+lemma union_congr_right (hs : s ⊆ t ∪ u) (ht : t ⊆ s ∪ u) : s ∪ u = t ∪ u := sup_congr_right hs ht
+
+lemma union_eq_union_iff_left : s ∪ t = s ∪ u ↔ t ⊆ s ∪ u ∧ u ⊆ s ∪ t := sup_eq_sup_iff_left
+lemma union_eq_union_iff_right : s ∪ u = t ∪ u ↔ s ⊆ t ∪ u ∧ t ⊆ s ∪ u := sup_eq_sup_iff_right
+
 @[simp] theorem union_empty_iff {s t : set α} : s ∪ t = ∅ ↔ s = ∅ ∧ t = ∅ :=
 by simp only [← subset_empty_iff]; exact union_subset_iff
 
@@ -547,9 +541,8 @@ by simp only [← subset_empty_iff]; exact union_subset_iff
 
 theorem inter_def {s₁ s₂ : set α} : s₁ ∩ s₂ = {a | a ∈ s₁ ∧ a ∈ s₂} := rfl
 
-theorem mem_inter_iff (x : α) (a b : set α) : x ∈ a ∩ b ↔ x ∈ a ∧ x ∈ b := iff.rfl
-
-@[simp] theorem mem_inter_eq (x : α) (a b : set α) : x ∈ a ∩ b = (x ∈ a ∧ x ∈ b) := rfl
+@[simp, mfld_simps]
+theorem mem_inter_iff (x : α) (a b : set α) : x ∈ a ∩ b ↔ (x ∈ a ∧ x ∈ b) := iff.rfl
 
 theorem mem_inter {x : α} {a b : set α} (ha : x ∈ a) (hb : x ∈ b) : x ∈ a ∩ b := ⟨ha, hb⟩
 
@@ -577,7 +570,7 @@ ext $ λ x, and.left_comm
 theorem inter_right_comm (s₁ s₂ s₃ : set α) : (s₁ ∩ s₂) ∩ s₃ = (s₁ ∩ s₃) ∩ s₂ :=
 ext $ λ x, and.right_comm
 
-@[simp] theorem inter_subset_left (s t : set α) : s ∩ t ⊆ s := λ x, and.left
+@[simp, mfld_simps] theorem inter_subset_left (s t : set α) : s ∩ t ⊆ s := λ x, and.left
 
 @[simp] theorem inter_subset_right (s t : set α) : s ∩ t ⊆ t := λ x, and.right
 
@@ -598,9 +591,15 @@ inter_eq_left_iff_subset.mpr
 theorem inter_eq_self_of_subset_right {s t : set α} : t ⊆ s → s ∩ t = t :=
 inter_eq_right_iff_subset.mpr
 
-@[simp] theorem inter_univ (a : set α) : a ∩ univ = a := inf_top_eq
+lemma inter_congr_left (ht : s ∩ u ⊆ t) (hu : s ∩ t ⊆ u) : s ∩ t = s ∩ u := inf_congr_left ht hu
+lemma inter_congr_right (hs : t ∩ u ⊆ s) (ht : s ∩ u ⊆ t) : s ∩ u = t ∩ u := inf_congr_right hs ht
 
-@[simp] theorem univ_inter (a : set α) : univ ∩ a = a := top_inf_eq
+lemma inter_eq_inter_iff_left : s ∩ t = s ∩ u ↔ s ∩ u ⊆ t ∧ s ∩ t ⊆ u := inf_eq_inf_iff_left
+lemma inter_eq_inter_iff_right : s ∩ u = t ∩ u ↔ t ∩ u ⊆ s ∧ s ∩ u ⊆ t := inf_eq_inf_iff_right
+
+@[simp, mfld_simps] theorem inter_univ (a : set α) : a ∩ univ = a := inf_top_eq
+
+@[simp, mfld_simps] theorem univ_inter (a : set α) : univ ∩ a = a := top_inf_eq
 
 theorem inter_subset_inter {s₁ s₂ t₁ t₂ : set α}
   (h₁ : s₁ ⊆ t₁) (h₂ : s₂ ⊆ t₂) : s₁ ∩ s₂ ⊆ t₁ ∩ t₂ := λ x, and.imp (@h₁ _) (@h₂ _)
@@ -617,6 +616,10 @@ inter_eq_self_of_subset_right $ subset_union_left _ _
 theorem union_inter_cancel_right {s t : set α} : (s ∪ t) ∩ t = t :=
 inter_eq_self_of_subset_right $ subset_union_right _ _
 
+lemma inter_set_of_eq_sep (s : set α) (p : α → Prop) : s ∩ {a | p a} = {a ∈ s | p a} := rfl
+lemma set_of_inter_eq_sep (p : α → Prop) (s : set α) : {a | p a} ∩ s = {a ∈ s | p a} :=
+inter_comm _ _
+
 /-! ### Distributivity laws -/
 
 theorem inter_distrib_left (s t u : set α) : s ∩ (t ∪ u) = (s ∩ t) ∪ (s ∩ u) :=
@@ -639,6 +642,24 @@ sup_inf_right
 theorem inter_union_distrib_right {s t u : set α} : (s ∩ t) ∪ u = (s ∪ u) ∩ (t ∪ u) :=
 sup_inf_right
 
+lemma union_union_distrib_left (s t u : set α) : s ∪ (t ∪ u) = (s ∪ t) ∪ (s ∪ u) :=
+sup_sup_distrib_left _ _ _
+
+lemma union_union_distrib_right (s t u : set α) : (s ∪ t) ∪ u = (s ∪ u) ∪ (t ∪ u) :=
+sup_sup_distrib_right _ _ _
+
+lemma inter_inter_distrib_left (s t u : set α) : s ∩ (t ∩ u) = (s ∩ t) ∩ (s ∩ u) :=
+inf_inf_distrib_left _ _ _
+
+lemma inter_inter_distrib_right (s t u : set α) : (s ∩ t) ∩ u = (s ∩ u) ∩ (t ∩ u) :=
+inf_inf_distrib_right _ _ _
+
+lemma union_union_union_comm (s t u v : set α) : (s ∪ t) ∪ (u ∪ v) = (s ∪ u) ∪ (t ∪ v) :=
+sup_sup_sup_comm _ _ _ _
+
+lemma inter_inter_inter_comm (s t u v : set α) : (s ∩ t) ∩ (u ∩ v) = (s ∩ u) ∩ (t ∩ v) :=
+inf_inf_inf_comm _ _ _ _
+
 /-!
 ### Lemmas about `insert`
 
@@ -666,6 +687,10 @@ ext $ λ x, or_iff_right_of_imp $ λ e, e.symm ▸ h
 lemma ne_insert_of_not_mem {s : set α} (t : set α) {a : α} : a ∉ s → s ≠ insert a t :=
 mt $ λ e, e.symm ▸ mem_insert _ _
 
+@[simp] lemma insert_eq_self : insert a s = s ↔ a ∈ s := ⟨λ h, h ▸ mem_insert _ _, insert_eq_of_mem⟩
+
+lemma insert_ne_self : insert a s ≠ s ↔ a ∉ s := insert_eq_self.not
+
 theorem insert_subset : insert a s ⊆ t ↔ (a ∈ t ∧ s ⊆ t) :=
 by simp only [subset_def, or_imp_distrib, forall_and_distrib, forall_eq, mem_insert_iff]
 
@@ -678,6 +703,9 @@ begin
   exacts [(ha hx).elim, hxt]
 end
 
+theorem subset_insert_iff_of_not_mem (ha : a ∉ s) : s ⊆ insert a t ↔ s ⊆ t :=
+forall₂_congr $ λ b hb, or_iff_right $ ne_of_mem_of_not_mem hb ha
+
 theorem ssubset_iff_insert {s t : set α} : s ⊂ t ↔ ∃ a ∉ s, insert a s ⊆ t :=
 begin
   simp only [insert_subset, exists_and_distrib_right, ssubset_def, not_subset],
@@ -690,11 +718,14 @@ ssubset_iff_insert.2 ⟨a, h, subset.rfl⟩
 theorem insert_comm (a b : α) (s : set α) : insert a (insert b s) = insert b (insert a s) :=
 ext $ λ x, or.left_comm
 
+@[simp] lemma insert_idem (a : α) (s : set α) : insert a (insert a s) = insert a s :=
+insert_eq_of_mem $ mem_insert _ _
+
 theorem insert_union : insert a s ∪ t = insert a (s ∪ t) := ext $ λ x, or.assoc
 
 @[simp] theorem union_insert : s ∪ insert a t = insert a (s ∪ t) := ext $ λ x, or.left_comm
 
-theorem insert_nonempty (a : α) (s : set α) : (insert a s).nonempty := ⟨a, mem_insert a s⟩
+@[simp] theorem insert_nonempty (a : α) (s : set α) : (insert a s).nonempty := ⟨a, mem_insert a s⟩
 
 instance (a : α) (s : set α) : nonempty (insert a s : set α) := (insert_nonempty a s).to_subtype
 
@@ -748,15 +779,17 @@ theorem mem_singleton_of_eq {x y : α} (H : x = y) : x ∈ ({y} : set α) := H
 
 theorem insert_eq (x : α) (s : set α) : insert x s = ({x} : set α) ∪ s := rfl
 
-@[simp] theorem pair_eq_singleton (a : α) : ({a, a} : set α) = {a} := union_self _
-
-theorem pair_comm (a b : α) : ({a, b} : set α) = {b, a} := union_comm _ _
-
 @[simp] theorem singleton_nonempty (a : α) : ({a} : set α).nonempty :=
 ⟨a, rfl⟩
 
+@[simp] lemma singleton_ne_empty (a : α) : ({a} : set α) ≠ ∅ := (singleton_nonempty _).ne_empty
+
+@[simp] lemma empty_ssubset_singleton : (∅ : set α) ⊂ {a} := (singleton_nonempty _).empty_ssubset
+
 @[simp] theorem singleton_subset_iff {a : α} {s : set α} : {a} ⊆ s ↔ a ∈ s := forall_eq
 
+lemma singleton_subset_singleton : ({a} : set α) ⊆ {b} ↔ a = b := by simp
+
 theorem set_compr_eq_eq_singleton {a : α} : {b | b = a} = {a} := rfl
 
 @[simp] theorem singleton_union : {a} ∪ s = insert a s := rfl
@@ -764,7 +797,7 @@ theorem set_compr_eq_eq_singleton {a : α} : {b | b = a} = {a} := rfl
 @[simp] theorem union_singleton : s ∪ {a} = insert a s := union_comm _ _
 
 @[simp] theorem singleton_inter_nonempty : ({a} ∩ s).nonempty ↔ a ∈ s :=
-by simp only [set.nonempty, mem_inter_eq, mem_singleton_iff, exists_eq_left]
+by simp only [set.nonempty, mem_inter_iff, mem_singleton_iff, exists_eq_left]
 
 @[simp] theorem inter_singleton_nonempty : (s ∩ {a}).nonempty ↔ a ∈ s :=
 by rw [inter_comm, singleton_inter_nonempty]
@@ -776,7 +809,7 @@ not_nonempty_iff_eq_empty.symm.trans singleton_inter_nonempty.not
 by rw [inter_comm, singleton_inter_eq_empty]
 
 lemma nmem_singleton_empty {s : set α} : s ∉ ({∅} : set (set α)) ↔ s.nonempty :=
-ne_empty_iff_nonempty
+nonempty_iff_ne_empty.symm
 
 instance unique_singleton (a : α) : unique ↥({a} : set α) :=
 ⟨⟨⟨a, mem_singleton a⟩⟩, λ ⟨x, h⟩, subtype.eq h⟩
@@ -790,45 +823,70 @@ eq_singleton_iff_unique_mem.trans $ and_congr_left $ λ H, ⟨λ h', ⟨_, h'⟩
 -- while `simp` is capable of proving this, it is not capable of turning the LHS into the RHS.
 @[simp] lemma default_coe_singleton (x : α) : (default : ({x} : set α)) = ⟨x, rfl⟩ := rfl
 
+/-! ### Lemmas about pairs -/
+
+@[simp] theorem pair_eq_singleton (a : α) : ({a, a} : set α) = {a} := union_self _
+
+theorem pair_comm (a b : α) : ({a, b} : set α) = {b, a} := union_comm _ _
+
+lemma pair_eq_pair_iff {x y z w : α} :
+  ({x, y} : set α) = {z, w} ↔ x = z ∧ y = w ∨ x = w ∧ y = z :=
+begin
+  simp only [set.subset.antisymm_iff, set.insert_subset, set.mem_insert_iff, set.mem_singleton_iff,
+    set.singleton_subset_iff],
+  split,
+  { tauto! },
+  { rintro (⟨rfl,rfl⟩|⟨rfl,rfl⟩); simp }
+end
+
 /-! ### Lemmas about sets defined as `{x ∈ s | p x}`. -/
 
-theorem mem_sep {s : set α} {p : α → Prop} {x : α} (xs : x ∈ s) (px : p x) : x ∈ {x ∈ s | p x} :=
-⟨xs, px⟩
+section sep
+variables {p q : α → Prop} {x : α}
 
-@[simp] theorem sep_mem_eq {s t : set α} : {x ∈ s | x ∈ t} = s ∩ t := rfl
+theorem mem_sep (xs : x ∈ s) (px : p x) : x ∈ {x ∈ s | p x} := ⟨xs, px⟩
 
-@[simp] theorem mem_sep_eq {s : set α} {p : α → Prop} {x : α} :
-  x ∈ {x ∈ s | p x} = (x ∈ s ∧ p x) := rfl
+@[simp] theorem sep_mem_eq : {x ∈ s | x ∈ t} = s ∩ t := rfl
 
-theorem mem_sep_iff {s : set α} {p : α → Prop} {x : α} : x ∈ {x ∈ s | p x} ↔ x ∈ s ∧ p x :=
-iff.rfl
+@[simp] theorem mem_sep_iff : x ∈ {x ∈ s | p x} ↔ x ∈ s ∧ p x := iff.rfl
+
+theorem sep_ext_iff : {x ∈ s | p x} = {x ∈ s | q x} ↔ ∀ x ∈ s, (p x ↔ q x) :=
+by simp_rw [ext_iff, mem_sep_iff, and.congr_right_iff]
 
-theorem eq_sep_of_subset {s t : set α} (h : s ⊆ t) : s = {x ∈ t | x ∈ s} :=
-(inter_eq_self_of_subset_right h).symm
+theorem sep_eq_of_subset (h : s ⊆ t) : {x ∈ t | x ∈ s} = s :=
+inter_eq_self_of_subset_right h
 
 @[simp] theorem sep_subset (s : set α) (p : α → Prop) : {x ∈ s | p x} ⊆ s := λ x, and.left
 
-@[simp] lemma sep_empty (p : α → Prop) : {x ∈ (∅ : set α) | p x} = ∅ :=
-by { ext, exact false_and _ }
+@[simp] lemma sep_eq_self_iff_mem_true : {x ∈ s | p x} = s ↔ ∀ x ∈ s, p x :=
+by simp_rw [ext_iff, mem_sep_iff, and_iff_left_iff_imp]
 
-theorem forall_not_of_sep_empty {s : set α} {p : α → Prop} (H : {x ∈ s | p x} = ∅)
-  (x) : x ∈ s → ¬ p x := not_and.1 (eq_empty_iff_forall_not_mem.1 H x : _)
+@[simp] lemma sep_eq_empty_iff_mem_false : {x ∈ s | p x} = ∅ ↔ ∀ x ∈ s, ¬ p x :=
+by simp_rw [ext_iff, mem_sep_iff, mem_empty_iff_false, iff_false, not_and]
 
-@[simp] lemma sep_univ {α} {p : α → Prop} : {a ∈ (univ : set α) | p a} = {a | p a} := univ_inter _
+@[simp] lemma sep_true : {x ∈ s | true} = s := inter_univ s
 
-@[simp] lemma sep_true : {a ∈ s | true} = s :=
-by { ext, simp }
+@[simp] lemma sep_false : {x ∈ s | false} = ∅ := inter_empty s
 
-@[simp] lemma sep_false : {a ∈ s | false} = ∅ :=
-by { ext, simp }
+@[simp] lemma sep_empty (p : α → Prop) : {x ∈ (∅ : set α) | p x} = ∅ := empty_inter p
 
-lemma sep_inter_sep {p q : α → Prop} :
-  {x ∈ s | p x} ∩ {x ∈ s | q x} = {x ∈ s | p x ∧ q x} :=
-begin
-  ext,
-  simp_rw [mem_inter_iff, mem_sep_iff],
-  rw [and_and_and_comm, and_self],
-end
+@[simp] lemma sep_univ : {x ∈ (univ : set α) | p x} = {x | p x} := univ_inter p
+
+@[simp] lemma sep_union : {x ∈ s ∪ t | p x} = {x ∈ s | p x} ∪ {x ∈ t | p x} :=
+union_inter_distrib_right
+
+@[simp] lemma sep_inter : {x ∈ s ∩ t | p x} = {x ∈ s | p x} ∩ {x ∈ t | p x} :=
+inter_inter_distrib_right s t p
+
+@[simp] lemma sep_and : {x ∈ s | p x ∧ q x} = {x ∈ s | p x} ∩ {x ∈ s | q x} :=
+inter_inter_distrib_left s p q
+
+@[simp] lemma sep_or : {x ∈ s | p x ∨ q x} = {x ∈ s | p x} ∪ {x ∈ s | q x} :=
+inter_union_distrib_left
+
+@[simp] lemma sep_set_of : {x ∈ {y | p y} | q x} = {x | p x ∧ q x} := rfl
+
+end sep
 
 @[simp] lemma subset_singleton_iff {α : Type*} {s : set α} {x : α} : s ⊆ {x} ↔ ∀ y ∈ s, y = x :=
 iff.rfl
@@ -837,7 +895,7 @@ lemma subset_singleton_iff_eq {s : set α} {x : α} : s ⊆ {x} ↔ s = ∅ ∨
 begin
   obtain (rfl | hs) := s.eq_empty_or_nonempty,
   use ⟨λ _, or.inl rfl, λ _, empty_subset _⟩,
-  simp [eq_singleton_iff_nonempty_unique_mem, hs, ne_empty_iff_nonempty.2 hs],
+  simp [eq_singleton_iff_nonempty_unique_mem, hs, hs.ne_empty],
 end
 
 lemma nonempty.subset_singleton_iff (h : s.nonempty) : s ⊆ {a} ↔ s = {a} :=
@@ -847,13 +905,84 @@ lemma ssubset_singleton_iff {s : set α} {x : α} : s ⊂ {x} ↔ s = ∅ :=
 begin
   rw [ssubset_iff_subset_ne, subset_singleton_iff_eq, or_and_distrib_right, and_not_self, or_false,
     and_iff_left_iff_imp],
-  rintro rfl,
-  refine ne_comm.1 (ne_empty_iff_nonempty.2 (singleton_nonempty _)),
+  exact λ h, ne_of_eq_of_ne h (singleton_ne_empty _).symm,
 end
 
 lemma eq_empty_of_ssubset_singleton {s : set α} {x : α} (hs : s ⊂ {x}) : s = ∅ :=
 ssubset_singleton_iff.1 hs
 
+/-! ### Disjointness -/
+
+protected theorem disjoint_iff : disjoint s t ↔ s ∩ t ⊆ ∅ := disjoint_iff_inf_le
+
+theorem disjoint_iff_inter_eq_empty : disjoint s t ↔ s ∩ t = ∅ :=
+disjoint_iff
+
+lemma _root_.disjoint.inter_eq : disjoint s t → s ∩ t = ∅ := disjoint.eq_bot
+
+lemma disjoint_left : disjoint s t ↔ ∀ ⦃a⦄, a ∈ s → a ∉ t :=
+disjoint_iff_inf_le.trans $ forall_congr $ λ _, not_and
+lemma disjoint_right : disjoint s t ↔ ∀ ⦃a⦄, a ∈ t → a ∉ s := by rw [disjoint.comm, disjoint_left]
+
+lemma not_disjoint_iff : ¬disjoint s t ↔ ∃ x, x ∈ s ∧ x ∈ t :=
+set.disjoint_iff.not.trans $ not_forall.trans $ exists_congr $ λ x, not_not
+
+lemma not_disjoint_iff_nonempty_inter : ¬disjoint s t ↔ (s ∩ t).nonempty := not_disjoint_iff
+
+alias not_disjoint_iff_nonempty_inter ↔ _ nonempty.not_disjoint
+
+lemma disjoint_or_nonempty_inter (s t : set α) : disjoint s t ∨ (s ∩ t).nonempty :=
+(em _).imp_right not_disjoint_iff_nonempty_inter.mp
+
+lemma disjoint_iff_forall_ne : disjoint s t ↔ ∀ (x ∈ s) (y ∈ t), x ≠ y :=
+by simp only [ne.def, disjoint_left, @imp_not_comm _ (_ = _), forall_eq']
+
+lemma _root_.disjoint.ne_of_mem (h : disjoint s t) {x y} (hx : x ∈ s) (hy : y ∈ t) : x ≠ y :=
+disjoint_iff_forall_ne.mp h x hx y hy
+
+lemma disjoint_of_subset_left (hs : s₁ ⊆ s₂) (h : disjoint s₂ t) : disjoint s₁ t := h.mono_left hs
+lemma disjoint_of_subset_right (ht : t₁ ⊆ t₂) (h : disjoint s t₂) : disjoint s t₁ := h.mono_right ht
+
+lemma disjoint_of_subset (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) (h : disjoint s₂ t₂) : disjoint s₁ t₁ :=
+h.mono hs ht
+
+@[simp] lemma disjoint_union_left : disjoint (s ∪ t) u ↔ disjoint s u ∧ disjoint t u :=
+disjoint_sup_left
+
+@[simp] lemma disjoint_union_right : disjoint s (t ∪ u) ↔ disjoint s t ∧ disjoint s u :=
+disjoint_sup_right
+
+@[simp] lemma disjoint_empty (s : set α) : disjoint s ∅ := disjoint_bot_right
+@[simp] lemma empty_disjoint (s : set α) : disjoint ∅ s := disjoint_bot_left
+
+@[simp] lemma univ_disjoint : disjoint univ s ↔ s = ∅ := top_disjoint
+@[simp] lemma disjoint_univ : disjoint s univ ↔ s = ∅ := disjoint_top
+
+lemma disjoint_sdiff_left : disjoint (t \ s) s := disjoint_sdiff_self_left
+lemma disjoint_sdiff_right : disjoint s (t \ s) := disjoint_sdiff_self_right
+
+lemma diff_union_diff_cancel (hts : t ⊆ s) (hut : u ⊆ t) : s \ t ∪ t \ u = s \ u :=
+sdiff_sup_sdiff_cancel hts hut
+
+lemma diff_diff_eq_sdiff_union (h : u ⊆ s) : s \ (t \ u) = s \ t ∪ u := sdiff_sdiff_eq_sdiff_sup h
+
+@[simp] lemma disjoint_singleton_left : disjoint {a} s ↔ a ∉ s :=
+by simp [set.disjoint_iff, subset_def]; exact iff.rfl
+
+@[simp] lemma disjoint_singleton_right : disjoint s {a} ↔ a ∉ s :=
+disjoint.comm.trans disjoint_singleton_left
+
+@[simp] lemma disjoint_singleton : disjoint ({a} : set α) {b} ↔ a ≠ b :=
+by rw [disjoint_singleton_left, mem_singleton_iff]
+
+lemma subset_diff : s ⊆ t \ u ↔ s ⊆ t ∧ disjoint s u := le_iff_subset.symm.trans le_sdiff
+
+lemma inter_diff_distrib_left (s t u : set α) : s ∩ (t \ u) = (s ∩ t) \ (s ∩ u) :=
+inf_sdiff_distrib_left _ _ _
+
+lemma inter_diff_distrib_right (s t u : set α) : s \ t ∩ u = (s ∩ u) \ (t ∩ u) :=
+inf_sdiff_distrib_right _ _ _
+
 /-! ### Lemmas about complement -/
 
 lemma compl_def (s : set α) : sᶜ = {x | x ∉ s} := rfl
@@ -864,9 +993,7 @@ lemma compl_set_of {α} (p : α → Prop) : {a | p a}ᶜ = { a | ¬ p a } := rfl
 
 theorem not_mem_of_mem_compl {s : set α} {x : α} (h : x ∈ sᶜ) : x ∉ s := h
 
-@[simp] theorem mem_compl_eq (s : set α) (x : α) : x ∈ sᶜ = (x ∉ s) := rfl
-
-theorem mem_compl_iff (s : set α) (x : α) : x ∈ sᶜ ↔ x ∉ s := iff.rfl
+@[simp] theorem mem_compl_iff (s : set α) (x : α) : x ∈ sᶜ ↔ (x ∉ s) := iff.rfl
 
 lemma not_mem_compl_iff {x : α} : x ∉ sᶜ ↔ x ∈ s := not_not
 
@@ -886,21 +1013,14 @@ theorem compl_inter (s t : set α) : (s ∩ t)ᶜ = sᶜ ∪ tᶜ := compl_inf
 
 @[simp] lemma compl_univ_iff {s : set α} : sᶜ = univ ↔ s = ∅ := compl_eq_top
 
-lemma compl_ne_univ : sᶜ ≠ univ ↔ s.nonempty :=
-compl_univ_iff.not.trans ne_empty_iff_nonempty
+lemma compl_ne_univ : sᶜ ≠ univ ↔ s.nonempty := compl_univ_iff.not.trans nonempty_iff_ne_empty.symm
+lemma nonempty_compl : sᶜ.nonempty ↔ s ≠ univ := (ne_univ_iff_exists_not_mem s).symm
 
-lemma nonempty_compl {s : set α} : sᶜ.nonempty ↔ s ≠ univ :=
-ne_empty_iff_nonempty.symm.trans compl_empty_iff.not
+lemma mem_compl_singleton_iff {a x : α} : x ∈ ({a} : set α)ᶜ ↔ x ≠ a := iff.rfl
 
-lemma mem_compl_singleton_iff {a x : α} : x ∈ ({a} : set α)ᶜ ↔ x ≠ a :=
-mem_singleton_iff.not
+lemma compl_singleton_eq (a : α) : ({a} : set α)ᶜ = {x | x ≠ a} := rfl
 
-lemma compl_singleton_eq (a : α) : ({a} : set α)ᶜ = {x | x ≠ a} :=
-ext $ λ x, mem_compl_singleton_iff
-
-@[simp]
-lemma compl_ne_eq_singleton (a : α) : ({x | x ≠ a} : set α)ᶜ = {a} :=
-by { ext, simp, }
+@[simp] lemma compl_ne_eq_singleton (a : α) : ({x | x ≠ a} : set α)ᶜ = {a} := compl_compl _
 
 theorem union_eq_compl_compl_inter_compl (s t : set α) : s ∪ t = (sᶜ ∩ tᶜ)ᶜ :=
 ext $ λ x, or_iff_not_and_not
@@ -912,11 +1032,24 @@ ext $ λ x, and_iff_not_or_not
 
 @[simp] theorem compl_union_self (s : set α) : sᶜ ∪ s = univ := by rw [union_comm, union_compl_self]
 
-theorem compl_comp_compl : compl ∘ compl = @id (set α) := funext compl_compl
+lemma compl_subset_comm : sᶜ ⊆ t ↔ tᶜ ⊆ s := @compl_le_iff_compl_le _ s _ _
+lemma subset_compl_comm : s ⊆ tᶜ ↔ t ⊆ sᶜ := @le_compl_iff_le_compl _ _ _ t
+
+@[simp] lemma compl_subset_compl : sᶜ ⊆ tᶜ ↔ t ⊆ s := @compl_le_compl_iff_le (set α) _ _ _
+
+lemma subset_compl_iff_disjoint_left : s ⊆ tᶜ ↔ disjoint t s :=
+@le_compl_iff_disjoint_left (set α) _ _ _
 
-theorem compl_subset_comm {s t : set α} : sᶜ ⊆ t ↔ tᶜ ⊆ s := @compl_le_iff_compl_le _ s t _
+lemma subset_compl_iff_disjoint_right : s ⊆ tᶜ ↔ disjoint s t :=
+@le_compl_iff_disjoint_right (set α) _ _ _
 
-@[simp] lemma compl_subset_compl {s t : set α} : sᶜ ⊆ tᶜ ↔ t ⊆ s := @compl_le_compl_iff_le _ t s _
+lemma disjoint_compl_left_iff_subset : disjoint sᶜ t ↔ t ⊆ s := disjoint_compl_left_iff
+lemma disjoint_compl_right_iff_subset : disjoint s tᶜ ↔ s ⊆ t := disjoint_compl_right_iff
+
+alias subset_compl_iff_disjoint_right ↔ _ _root_.disjoint.subset_compl_right
+alias subset_compl_iff_disjoint_left ↔ _ _root_.disjoint.subset_compl_left
+alias disjoint_compl_left_iff_subset ↔ _ _root_.has_subset.subset.disjoint_compl_left
+alias disjoint_compl_right_iff_subset ↔ _ _root_.has_subset.subset.disjoint_compl_right
 
 theorem subset_union_compl_iff_inter_subset {s t u : set α} : s ⊆ t ∪ uᶜ ↔ s ∩ u ⊆ t :=
 (@is_compl_compl _ u _).le_sup_right_iff_inf_left_le
@@ -924,12 +1057,6 @@ theorem subset_union_compl_iff_inter_subset {s t u : set α} : s ⊆ t ∪ uᶜ
 theorem compl_subset_iff_union {s t : set α} : sᶜ ⊆ t ↔ s ∪ t = univ :=
 iff.symm $ eq_univ_iff_forall.trans $ forall_congr $ λ a, or_iff_not_imp_left
 
-theorem subset_compl_comm {s t : set α} : s ⊆ tᶜ ↔ t ⊆ sᶜ :=
-forall_congr $ λ a, imp_not_comm
-
-theorem subset_compl_iff_disjoint {s t : set α} : s ⊆ tᶜ ↔ s ∩ t = ∅ :=
-iff.trans (forall_congr $ λ a, and_imp.symm) subset_empty_iff
-
 @[simp] lemma subset_compl_singleton_iff {a : α} {s : set α} : s ⊆ {a}ᶜ ↔ a ∉ s :=
 subset_compl_comm.trans singleton_subset_iff
 
@@ -948,6 +1075,9 @@ theorem diff_eq (s t : set α) : s \ t = s ∩ tᶜ := rfl
 theorem mem_diff_of_mem {s t : set α} {x : α} (h1 : x ∈ s) (h2 : x ∉ t) : x ∈ s \ t :=
 ⟨h1, h2⟩
 
+lemma not_mem_diff_of_mem {s t : set α} {x : α} (hx : x ∈ t) : x ∉ s \ t :=
+λ h, h.2 hx
+
 theorem mem_of_mem_diff {s t : set α} {x : α} (h : x ∈ s \ t) : x ∈ s :=
 h.left
 
@@ -968,10 +1098,10 @@ theorem union_diff_cancel {s t : set α} (h : s ⊆ t) : s ∪ (t \ s) = t :=
 sup_sdiff_cancel_right h
 
 theorem union_diff_cancel_left {s t : set α} (h : s ∩ t ⊆ ∅) : (s ∪ t) \ s = t :=
-disjoint.sup_sdiff_cancel_left h
+disjoint.sup_sdiff_cancel_left $ disjoint_iff_inf_le.2 h
 
 theorem union_diff_cancel_right {s t : set α} (h : s ∩ t ⊆ ∅) : (s ∪ t) \ t = s :=
-disjoint.sup_sdiff_cancel_right h
+disjoint.sup_sdiff_cancel_right $ disjoint_iff_inf_le.2 h
 
 @[simp] theorem union_diff_left {s t : set α} : (s ∪ t) \ s = t \ s :=
 sup_sdiff_left_self
@@ -1101,31 +1231,32 @@ ext $ λ x, and_congr_right $ λ hx, or_iff_right $ ne_of_mem_of_not_mem hx h
 lemma insert_inter_of_not_mem (h : a ∉ t) : insert a s ∩ t = s ∩ t :=
 ext $ λ x, and_congr_left $ λ hx, or_iff_right $ ne_of_mem_of_not_mem hx h
 
-@[simp] theorem union_diff_self {s t : set α} : s ∪ (t \ s) = s ∪ t :=
-sup_sdiff_self_right
-
-@[simp] theorem diff_union_self {s t : set α} : (s \ t) ∪ t = s ∪ t :=
-sup_sdiff_self_left
+@[simp] lemma union_diff_self {s t : set α} : s ∪ (t \ s) = s ∪ t := sup_sdiff_self _ _
+@[simp] lemma diff_union_self {s t : set α} : (s \ t) ∪ t = s ∪ t := sdiff_sup_self _ _
 
 @[simp] theorem diff_inter_self {a b : set α} : (b \ a) ∩ a = ∅ :=
 inf_sdiff_self_left
 
 @[simp] theorem diff_inter_self_eq_diff {s t : set α} : s \ (t ∩ s) = s \ t :=
-sdiff_inf_self_right
-
-@[simp] theorem diff_self_inter {s t : set α} : s \ (s ∩ t) = s \ t :=
-sdiff_inf_self_left
+sdiff_inf_self_right _ _
 
-@[simp] theorem diff_eq_self {s t : set α} : s \ t = s ↔ t ∩ s ⊆ ∅ :=
-show s \ t = s ↔ t ⊓ s ≤ ⊥, from sdiff_eq_self_iff_disjoint
+@[simp] theorem diff_self_inter {s t : set α} : s \ (s ∩ t) = s \ t := sdiff_inf_self_left _ _
 
 @[simp] theorem diff_singleton_eq_self {a : α} {s : set α} (h : a ∉ s) : s \ {a} = s :=
-diff_eq_self.2 $ by simp [singleton_inter_eq_empty.2 h]
+sdiff_eq_self_iff_disjoint.2 $ by simp [h]
+
+@[simp] lemma diff_singleton_ssubset {s : set α} {a : α} : s \ {a} ⊂ s ↔ a ∈ s :=
+sdiff_le.lt_iff_ne.trans $ sdiff_eq_left.not.trans $ by simp
 
 @[simp] theorem insert_diff_singleton {a : α} {s : set α} :
   insert a (s \ {a}) = insert a s :=
 by simp [insert_eq, union_diff_self, -union_singleton, -singleton_union]
 
+lemma insert_diff_singleton_comm (hab : a ≠ b) (s : set α) :
+  insert a (s \ {b}) = insert a s \ {b} :=
+by simp_rw [←union_singleton, union_diff_distrib,
+  diff_singleton_eq_self (mem_singleton_iff.not.2 hab.symm)]
+
 @[simp] lemma diff_self {s : set α} : s \ s = ∅ := sdiff_self
 
 lemma diff_diff_right_self (s t : set α)  : s \ (s \ t) = s ∩ t := sdiff_sdiff_right_self
@@ -1136,21 +1267,50 @@ sdiff_sdiff_eq_self h
 lemma mem_diff_singleton {x y : α} {s : set α} : x ∈ s \ {y} ↔ (x ∈ s ∧ x ≠ y) :=
 iff.rfl
 
-lemma mem_diff_singleton_empty {s : set α} {t : set (set α)} :
-  s ∈ t \ {∅} ↔ (s ∈ t ∧ s.nonempty) :=
-mem_diff_singleton.trans $ iff.rfl.and ne_empty_iff_nonempty
+lemma mem_diff_singleton_empty {t : set (set α)} : s ∈ t \ {∅} ↔ s ∈ t ∧ s.nonempty :=
+mem_diff_singleton.trans $ and_congr_right' nonempty_iff_ne_empty.symm
 
 lemma union_eq_diff_union_diff_union_inter (s t : set α) :
   s ∪ t = (s \ t) ∪ (t \ s) ∪ (s ∩ t) :=
 sup_eq_sdiff_sup_sdiff_sup_inf
 
+/-! ### Symmetric difference -/
+
+lemma mem_symm_diff : a ∈ s ∆ t ↔ a ∈ s ∧ a ∉ t ∨ a ∈ t ∧ a ∉ s := iff.rfl
+
+protected lemma symm_diff_def (s t : set α) : s ∆ t = s \ t ∪ t \ s := rfl
+
+lemma symm_diff_subset_union : s ∆ t ⊆ s ∪ t := @symm_diff_le_sup (set α) _ _ _
+
+@[simp] lemma symm_diff_eq_empty : s ∆ t = ∅ ↔ s = t := symm_diff_eq_bot
+
+@[simp] lemma symm_diff_nonempty : (s ∆ t).nonempty ↔ s ≠ t :=
+nonempty_iff_ne_empty.trans symm_diff_eq_empty.not
+
+lemma inter_symm_diff_distrib_left (s t u : set α) : s ∩ t ∆ u = (s ∩ t) ∆ (s ∩ u) :=
+inf_symm_diff_distrib_left _ _ _
+
+lemma inter_symm_diff_distrib_right (s t u : set α) : s ∆ t ∩ u = (s ∩ u) ∆ (t ∩ u) :=
+inf_symm_diff_distrib_right _ _ _
+
+lemma subset_symm_diff_union_symm_diff_left (h : disjoint s t) : u ⊆ s ∆ u ∪ t ∆ u :=
+h.le_symm_diff_sup_symm_diff_left
+
+lemma subset_symm_diff_union_symm_diff_right (h : disjoint t u) : s ⊆ s ∆ t ∪ s ∆ u :=
+h.le_symm_diff_sup_symm_diff_right
+
 /-! ### Powerset -/
 
-theorem mem_powerset {x s : set α} (h : x ⊆ s) : x ∈ powerset s := h
+/-- `𝒫 s = set.powerset s` is the set of all subsets of `s`. -/
+def powerset (s : set α) : set (set α) := {t | t ⊆ s}
+
+prefix `𝒫`:100 := powerset
 
-theorem subset_of_mem_powerset {x s : set α} (h : x ∈ powerset s) : x ⊆ s := h
+theorem mem_powerset {x s : set α} (h : x ⊆ s) : x ∈ 𝒫 s := h
 
-@[simp] theorem mem_powerset_iff (x s : set α) : x ∈ powerset s ↔ x ⊆ s := iff.rfl
+theorem subset_of_mem_powerset {x s : set α} (h : x ∈ 𝒫 s) : x ⊆ s := h
+
+@[simp] theorem mem_powerset_iff (x s : set α) : x ∈ 𝒫 s ↔ x ⊆ s := iff.rfl
 
 theorem powerset_inter (s t : set α) : 𝒫 (s ∩ t) = 𝒫 s ∩ 𝒫 t :=
 ext $ λ u, subset_inter_iff
@@ -1170,6 +1330,44 @@ ext $ λ s, subset_empty_iff
 @[simp] theorem powerset_univ : 𝒫 (univ : set α) = univ :=
 eq_univ_of_forall subset_univ
 
+/-- The powerset of a singleton contains only `∅` and the singleton itself. -/
+theorem powerset_singleton (x : α) : 𝒫 ({x} : set α) = {∅, {x}} :=
+by { ext y, rw [mem_powerset_iff, subset_singleton_iff_eq, mem_insert_iff, mem_singleton_iff] }
+
+/-! ### Sets defined as an if-then-else -/
+
+lemma mem_dite_univ_right (p : Prop) [decidable p] (t : p → set α) (x : α) :
+  (x ∈ if h : p then t h else univ) ↔ (∀ h : p, x ∈ t h) :=
+by split_ifs; simp [h]
+
+@[simp] lemma mem_ite_univ_right (p : Prop) [decidable p] (t : set α) (x : α) :
+  x ∈ ite p t set.univ ↔ (p → x ∈ t) :=
+mem_dite_univ_right p (λ _, t) x
+
+lemma mem_dite_univ_left (p : Prop) [decidable p] (t : ¬ p → set α) (x : α) :
+  (x ∈ if h : p then univ else t h) ↔ (∀ h : ¬ p, x ∈ t h)  :=
+by split_ifs; simp [h]
+
+@[simp] lemma mem_ite_univ_left (p : Prop) [decidable p] (t : set α) (x : α) :
+  x ∈ ite p set.univ t ↔ (¬ p → x ∈ t) :=
+mem_dite_univ_left p (λ _, t) x
+
+lemma mem_dite_empty_right (p : Prop) [decidable p] (t : p → set α) (x : α) :
+  (x ∈ if h : p then t h else ∅) ↔ (∃ h : p, x ∈ t h) :=
+by split_ifs; simp [h]
+
+@[simp] lemma mem_ite_empty_right (p : Prop) [decidable p] (t : set α) (x : α) :
+  x ∈ ite p t ∅ ↔ p ∧ x ∈ t :=
+by split_ifs; simp [h]
+
+lemma mem_dite_empty_left (p : Prop) [decidable p] (t : ¬ p → set α) (x : α) :
+  (x ∈ if h : p then ∅ else t h) ↔ (∃ h : ¬ p, x ∈ t h) :=
+by split_ifs; simp [h]
+
+@[simp] lemma mem_ite_empty_left (p : Prop) [decidable p] (t : set α) (x : α) :
+  x ∈ ite p ∅ t ↔ ¬ p ∧ x ∈ t :=
+by split_ifs; simp [h]
+
 /-! ### If-then-else for sets -/
 
 /-- `ite` for sets: `set.ite t s s' ∩ t = s ∩ t`, `set.ite t s s' ∩ tᶜ = s' ∩ tᶜ`.
@@ -1218,7 +1416,7 @@ ite_same t (s ∩ s') ▸ ite_mono _ (inter_subset_left _ _) (inter_subset_right
 
 lemma ite_inter_inter (t s₁ s₂ s₁' s₂' : set α) :
   t.ite (s₁ ∩ s₂) (s₁' ∩ s₂') = t.ite s₁ s₁' ∩ t.ite s₂ s₂' :=
-by { ext x, simp only [set.ite, set.mem_inter_eq, set.mem_diff, set.mem_union_eq], itauto }
+by { ext x, simp only [set.ite, set.mem_inter_iff, set.mem_diff, set.mem_union], itauto }
 
 lemma ite_inter (t s₁ s₂ s : set α) :
   t.ite (s₁ ∩ s) (s₂ ∩ s) = t.ite s₁ s₂ ∩ s :=
@@ -1235,408 +1433,16 @@ begin
   by_cases hx : x ∈ t; simp [*, set.ite]
 end
 
-/-! ### Inverse image -/
-
-/-- The preimage of `s : set β` by `f : α → β`, written `f ⁻¹' s`,
-  is the set of `x : α` such that `f x ∈ s`. -/
-def preimage {α : Type u} {β : Type v} (f : α → β) (s : set β) : set α := {x | f x ∈ s}
-
-infix ` ⁻¹' `:80 := preimage
-
-section preimage
-variables {f : α → β} {g : β → γ}
-
-@[simp] theorem preimage_empty : f ⁻¹' ∅ = ∅ := rfl
-
-@[simp] theorem mem_preimage {s : set β} {a : α} : (a ∈ f ⁻¹' s) ↔ (f a ∈ s) := iff.rfl
-
-lemma preimage_congr {f g : α → β} {s : set β} (h : ∀ (x : α), f x = g x) : f ⁻¹' s = g ⁻¹' s :=
-by { congr' with x, apply_assumption }
-
-theorem preimage_mono {s t : set β} (h : s ⊆ t) : f ⁻¹' s ⊆ f ⁻¹' t :=
-assume x hx, h hx
-
-@[simp] theorem preimage_univ : f ⁻¹' univ = univ := rfl
-
-theorem subset_preimage_univ {s : set α} : s ⊆ f ⁻¹' univ := subset_univ _
-
-@[simp] theorem preimage_inter {s t : set β} : f ⁻¹' (s ∩ t) = f ⁻¹' s ∩ f ⁻¹' t := rfl
-
-@[simp] theorem preimage_union {s t : set β} : f ⁻¹' (s ∪ t) = f ⁻¹' s ∪ f ⁻¹' t := rfl
-
-@[simp] theorem preimage_compl {s : set β} : f ⁻¹' sᶜ = (f ⁻¹' s)ᶜ := rfl
-
-@[simp] theorem preimage_diff (f : α → β) (s t : set β) :
-  f ⁻¹' (s \ t) = f ⁻¹' s \ f ⁻¹' t := rfl
-
-@[simp] theorem preimage_ite (f : α → β) (s t₁ t₂ : set β) :
-  f ⁻¹' (s.ite t₁ t₂) = (f ⁻¹' s).ite (f ⁻¹' t₁) (f ⁻¹' t₂) :=
-rfl
-
-@[simp] theorem preimage_set_of_eq {p : α → Prop} {f : β → α} : f ⁻¹' {a | p a} = {a | p (f a)} :=
-rfl
-
-@[simp] theorem preimage_id {s : set α} : id ⁻¹' s = s := rfl
-
-@[simp] theorem preimage_id' {s : set α} : (λ x, x) ⁻¹' s = s := rfl
-
-@[simp] theorem preimage_const_of_mem {b : β} {s : set β} (h : b ∈ s) :
-  (λ (x : α), b) ⁻¹' s = univ :=
-eq_univ_of_forall $ λ x, h
-
-@[simp] theorem preimage_const_of_not_mem {b : β} {s : set β} (h : b ∉ s) :
-  (λ (x : α), b) ⁻¹' s = ∅ :=
-eq_empty_of_subset_empty $ λ x hx, h hx
-
-theorem preimage_const (b : β) (s : set β) [decidable (b ∈ s)] :
-  (λ (x : α), b) ⁻¹' s = if b ∈ s then univ else ∅ :=
-by { split_ifs with hb hb, exacts [preimage_const_of_mem hb, preimage_const_of_not_mem hb] }
-
-theorem preimage_comp {s : set γ} : (g ∘ f) ⁻¹' s = f ⁻¹' (g ⁻¹' s) := rfl
-
-lemma preimage_preimage {g : β → γ} {f : α → β} {s : set γ} :
-  f ⁻¹' (g ⁻¹' s) = (λ x, g (f x)) ⁻¹' s :=
-preimage_comp.symm
-
-theorem eq_preimage_subtype_val_iff {p : α → Prop} {s : set (subtype p)} {t : set α} :
-  s = subtype.val ⁻¹' t ↔ (∀x (h : p x), (⟨x, h⟩ : subtype p) ∈ s ↔ x ∈ t) :=
-⟨assume s_eq x h, by { rw [s_eq], simp },
- assume h, ext $ λ ⟨x, hx⟩, by simp [h]⟩
-
-lemma nonempty_of_nonempty_preimage {s : set β} {f : α → β} (hf : (f ⁻¹' s).nonempty) :
-  s.nonempty :=
-let ⟨x, hx⟩ := hf in ⟨f x, hx⟩
-
-end preimage
-
-/-! ### Image of a set under a function -/
-
-section image
-
-infix ` '' `:80 := image
-
-theorem mem_image_iff_bex {f : α → β} {s : set α} {y : β} :
-  y ∈ f '' s ↔ ∃ x (_ : x ∈ s), f x = y := bex_def.symm
-
-theorem mem_image_eq (f : α → β) (s : set α) (y: β) : y ∈ f '' s = ∃ x, x ∈ s ∧ f x = y := rfl
-
-@[simp] theorem mem_image (f : α → β) (s : set α) (y : β) :
-  y ∈ f '' s ↔ ∃ x, x ∈ s ∧ f x = y := iff.rfl
-
-lemma image_eta (f : α → β) : f '' s = (λ x, f x) '' s := rfl
-
-theorem mem_image_of_mem (f : α → β) {x : α} {a : set α} (h : x ∈ a) : f x ∈ f '' a :=
-⟨_, h, rfl⟩
-
-theorem _root_.function.injective.mem_set_image {f : α → β} (hf : injective f) {s : set α} {a : α} :
-  f a ∈ f '' s ↔ a ∈ s :=
-⟨λ ⟨b, hb, eq⟩, (hf eq) ▸ hb, mem_image_of_mem f⟩
-
-theorem ball_image_iff {f : α → β} {s : set α} {p : β → Prop} :
-  (∀ y ∈ f '' s, p y) ↔ (∀ x ∈ s, p (f x)) :=
-by simp
-
-theorem ball_image_of_ball {f : α → β} {s : set α} {p : β → Prop}
-  (h : ∀ x ∈ s, p (f x)) : ∀ y ∈ f '' s, p y :=
-ball_image_iff.2 h
-
-theorem bex_image_iff {f : α → β} {s : set α} {p : β → Prop} :
-  (∃ y ∈ f '' s, p y) ↔ (∃ x ∈ s, p (f x)) :=
-by simp
-
-theorem mem_image_elim {f : α → β} {s : set α} {C : β → Prop} (h : ∀ (x : α), x ∈ s → C (f x)) :
- ∀{y : β}, y ∈ f '' s → C y
-| ._ ⟨a, a_in, rfl⟩ := h a a_in
-
-theorem mem_image_elim_on {f : α → β} {s : set α} {C : β → Prop} {y : β} (h_y : y ∈ f '' s)
-  (h : ∀ (x : α), x ∈ s → C (f x)) : C y :=
-mem_image_elim h h_y
-
-@[congr] lemma image_congr {f g : α → β} {s : set α}
-  (h : ∀a∈s, f a = g a) : f '' s = g '' s :=
-by safe [ext_iff, iff_def]
-
-/-- A common special case of `image_congr` -/
-lemma image_congr' {f g : α → β} {s : set α} (h : ∀ (x : α), f x = g x) : f '' s = g '' s :=
-image_congr (λx _, h x)
-
-theorem image_comp (f : β → γ) (g : α → β) (a : set α) : (f ∘ g) '' a = f '' (g '' a) :=
-subset.antisymm
-  (ball_image_of_ball $ assume a ha, mem_image_of_mem _ $ mem_image_of_mem _ ha)
-  (ball_image_of_ball $ ball_image_of_ball $ assume a ha, mem_image_of_mem _ ha)
-
-/-- A variant of `image_comp`, useful for rewriting -/
-lemma image_image (g : β → γ) (f : α → β) (s : set α) : g '' (f '' s) = (λ x, g (f x)) '' s :=
-(image_comp g f s).symm
-
-lemma image_comm {β'} {f : β → γ} {g : α → β} {f' : α → β'} {g' : β' → γ}
-  (h_comm : ∀ a, f (g a) = g' (f' a)) :
-  (s.image g).image f = (s.image f').image g' :=
-by simp_rw [image_image, h_comm]
-
-/-- Image is monotone with respect to `⊆`. See `set.monotone_image` for the statement in
-terms of `≤`. -/
-theorem image_subset {a b : set α} (f : α → β) (h : a ⊆ b) : f '' a ⊆ f '' b :=
-by { simp only [subset_def, mem_image_eq], exact λ x, λ ⟨w, h1, h2⟩, ⟨w, h h1, h2⟩ }
-
-theorem image_union (f : α → β) (s t : set α) :
-  f '' (s ∪ t) = f '' s ∪ f '' t :=
-ext $ λ x, ⟨by rintro ⟨a, h|h, rfl⟩; [left, right]; exact ⟨_, h, rfl⟩,
-  by rintro (⟨a, h, rfl⟩ | ⟨a, h, rfl⟩); refine ⟨_, _, rfl⟩; [left, right]; exact h⟩
-
-@[simp] theorem image_empty (f : α → β) : f '' ∅ = ∅ := by { ext, simp }
-
-lemma image_inter_subset (f : α → β) (s t : set α) :
-  f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
-subset_inter (image_subset _ $ inter_subset_left _ _) (image_subset _ $ inter_subset_right _ _)
-
-theorem image_inter_on {f : α → β} {s t : set α} (h : ∀x∈t, ∀y∈s, f x = f y → x = y) :
-  f '' s ∩ f '' t = f '' (s ∩ t) :=
-subset.antisymm
-  (assume b ⟨⟨a₁, ha₁, h₁⟩, ⟨a₂, ha₂, h₂⟩⟩,
-    have a₂ = a₁, from h _ ha₂ _ ha₁ (by simp *),
-    ⟨a₁, ⟨ha₁, this ▸ ha₂⟩, h₁⟩)
-  (image_inter_subset _ _ _)
-
-theorem image_inter {f : α → β} {s t : set α} (H : injective f) :
-  f '' s ∩ f '' t = f '' (s ∩ t) :=
-image_inter_on (assume x _ y _ h, H h)
-
-theorem image_univ_of_surjective {ι : Type*} {f : ι → β} (H : surjective f) : f '' univ = univ :=
-eq_univ_of_forall $ by { simpa [image] }
-
-@[simp] theorem image_singleton {f : α → β} {a : α} : f '' {a} = {f a} :=
-by { ext, simp [image, eq_comm] }
-
-@[simp] theorem nonempty.image_const {s : set α} (hs : s.nonempty) (a : β) : (λ _, a) '' s = {a} :=
-ext $ λ x, ⟨λ ⟨y, _, h⟩, h ▸ mem_singleton _,
-  λ h, (eq_of_mem_singleton h).symm ▸ hs.imp (λ y hy, ⟨hy, rfl⟩)⟩
-
-@[simp] lemma image_eq_empty {α β} {f : α → β} {s : set α} : f '' s = ∅ ↔ s = ∅ :=
-by { simp only [eq_empty_iff_forall_not_mem],
-     exact ⟨λ H a ha, H _ ⟨_, ha, rfl⟩, λ H b ⟨_, ha, _⟩, H _ ha⟩ }
-
--- TODO(Jeremy): there is an issue with - t unfolding to compl t
-theorem mem_compl_image (t : set α) (S : set (set α)) :
-  t ∈ compl '' S ↔ tᶜ ∈ S :=
-begin
-  suffices : ∀ x, xᶜ = t ↔ tᶜ = x, { simp [this] },
-  intro x, split; { rintro rfl, simp }
-end
-
-/-- A variant of `image_id` -/
-@[simp] lemma image_id' (s : set α) : (λx, x) '' s = s := by { ext, simp }
-
-theorem image_id (s : set α) : id '' s = s := by simp
-
-theorem compl_compl_image (S : set (set α)) :
-  compl '' (compl '' S) = S :=
-by rw [← image_comp, compl_comp_compl, image_id]
-
-theorem image_insert_eq {f : α → β} {a : α} {s : set α} :
-  f '' (insert a s) = insert (f a) (f '' s) :=
-by { ext, simp [and_or_distrib_left, exists_or_distrib, eq_comm, or_comm, and_comm] }
-
-theorem image_pair (f : α → β) (a b : α) : f '' {a, b} = {f a, f b} :=
-by simp only [image_insert_eq, image_singleton]
-
-theorem image_subset_preimage_of_inverse {f : α → β} {g : β → α}
-  (I : left_inverse g f) (s : set α) : f '' s ⊆ g ⁻¹' s :=
-λ b ⟨a, h, e⟩, e ▸ ((I a).symm ▸ h : g (f a) ∈ s)
-
-theorem preimage_subset_image_of_inverse {f : α → β} {g : β → α}
-  (I : left_inverse g f) (s : set β) : f ⁻¹' s ⊆ g '' s :=
-λ b h, ⟨f b, h, I b⟩
-
-theorem image_eq_preimage_of_inverse {f : α → β} {g : β → α}
-  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
-  image f = preimage g :=
-funext $ λ s, subset.antisymm
-  (image_subset_preimage_of_inverse h₁ s)
-  (preimage_subset_image_of_inverse h₂ s)
-
-theorem mem_image_iff_of_inverse {f : α → β} {g : β → α} {b : β} {s : set α}
-  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
-  b ∈ f '' s ↔ g b ∈ s :=
-by rw image_eq_preimage_of_inverse h₁ h₂; refl
-
-theorem image_compl_subset {f : α → β} {s : set α} (H : injective f) : f '' sᶜ ⊆ (f '' s)ᶜ :=
-subset_compl_iff_disjoint.2 $ by simp [image_inter H]
-
-theorem subset_image_compl {f : α → β} {s : set α} (H : surjective f) : (f '' s)ᶜ ⊆ f '' sᶜ :=
-compl_subset_iff_union.2 $
-by { rw ← image_union, simp [image_univ_of_surjective H] }
-
-theorem image_compl_eq {f : α → β} {s : set α} (H : bijective f) : f '' sᶜ = (f '' s)ᶜ :=
-subset.antisymm (image_compl_subset H.1) (subset_image_compl H.2)
-
-theorem subset_image_diff (f : α → β) (s t : set α) :
-  f '' s \ f '' t ⊆ f '' (s \ t) :=
-begin
-  rw [diff_subset_iff, ← image_union, union_diff_self],
-  exact image_subset f (subset_union_right t s)
-end
-
-theorem image_diff {f : α → β} (hf : injective f) (s t : set α) :
-  f '' (s \ t) = f '' s \ f '' t :=
-subset.antisymm
-  (subset.trans (image_inter_subset _ _ _) $ inter_subset_inter_right _ $ image_compl_subset hf)
-  (subset_image_diff f s t)
-
-lemma nonempty.image (f : α → β) {s : set α} : s.nonempty → (f '' s).nonempty
-| ⟨x, hx⟩ := ⟨f x, mem_image_of_mem f hx⟩
-
-lemma nonempty.of_image {f : α → β} {s : set α} : (f '' s).nonempty → s.nonempty
-| ⟨y, x, hx, _⟩ := ⟨x, hx⟩
-
-@[simp] lemma nonempty_image_iff {f : α → β} {s : set α} :
-  (f '' s).nonempty ↔ s.nonempty :=
-⟨nonempty.of_image, λ h, h.image f⟩
-
-lemma nonempty.preimage {s : set β} (hs : s.nonempty) {f : α → β} (hf : surjective f) :
-  (f ⁻¹' s).nonempty :=
-let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf y in ⟨x, mem_preimage.2 $ hx.symm ▸ hy⟩
-
-instance (f : α → β) (s : set α) [nonempty s] : nonempty (f '' s) :=
-(set.nonempty.image f nonempty_of_nonempty_subtype).to_subtype
-
-/-- image and preimage are a Galois connection -/
-@[simp] theorem image_subset_iff {s : set α} {t : set β} {f : α → β} :
-  f '' s ⊆ t ↔ s ⊆ f ⁻¹' t :=
-ball_image_iff
-
-theorem image_preimage_subset (f : α → β) (s : set β) : f '' (f ⁻¹' s) ⊆ s :=
-image_subset_iff.2 subset.rfl
-
-theorem subset_preimage_image (f : α → β) (s : set α) :
-  s ⊆ f ⁻¹' (f '' s) :=
-λ x, mem_image_of_mem f
-
-theorem preimage_image_eq {f : α → β} (s : set α) (h : injective f) : f ⁻¹' (f '' s) = s :=
-subset.antisymm
-  (λ x ⟨y, hy, e⟩, h e ▸ hy)
-  (subset_preimage_image f s)
-
-theorem image_preimage_eq {f : α → β} (s : set β) (h : surjective f) : f '' (f ⁻¹' s) = s :=
-subset.antisymm
-  (image_preimage_subset f s)
-  (λ x hx, let ⟨y, e⟩ := h x in ⟨y, (e.symm ▸ hx : f y ∈ s), e⟩)
-
-lemma preimage_eq_preimage {f : β → α} (hf : surjective f) : f ⁻¹' s = f ⁻¹' t ↔ s = t :=
-iff.intro
-  (assume eq, by rw [← image_preimage_eq s hf, ← image_preimage_eq t hf, eq])
-  (assume eq, eq ▸ rfl)
-
-lemma image_inter_preimage (f : α → β) (s : set α) (t : set β) :
-  f '' (s ∩ f ⁻¹' t) = f '' s ∩ t :=
-begin
-  apply subset.antisymm,
-  { calc f '' (s ∩ f ⁻¹' t) ⊆ f '' s ∩ (f '' (f⁻¹' t)) : image_inter_subset _ _ _
-  ... ⊆ f '' s ∩ t : inter_subset_inter_right _ (image_preimage_subset f t) },
-  { rintros _ ⟨⟨x, h', rfl⟩, h⟩,
-    exact ⟨x, ⟨h', h⟩, rfl⟩ }
-end
-
-lemma image_preimage_inter (f : α → β) (s : set α) (t : set β) :
-  f '' (f ⁻¹' t ∩ s) = t ∩ f '' s :=
-by simp only [inter_comm, image_inter_preimage]
-
-@[simp] lemma image_inter_nonempty_iff {f : α → β} {s : set α} {t : set β} :
-  (f '' s ∩ t).nonempty ↔ (s ∩ f ⁻¹' t).nonempty :=
-by rw [←image_inter_preimage, nonempty_image_iff]
-
-lemma image_diff_preimage {f : α → β} {s : set α} {t : set β} : f '' (s \ f ⁻¹' t) = f '' s \ t :=
-by simp_rw [diff_eq, ← preimage_compl, image_inter_preimage]
-
-theorem compl_image : image (compl : set α → set α) = preimage compl :=
-image_eq_preimage_of_inverse compl_compl compl_compl
-
-theorem compl_image_set_of {p : set α → Prop} :
-  compl '' {s | p s} = {s | p sᶜ} :=
-congr_fun compl_image p
-
-theorem inter_preimage_subset (s : set α) (t : set β) (f : α → β) :
-  s ∩ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∩ t) :=
-λ x h, ⟨mem_image_of_mem _ h.left, h.right⟩
-
-theorem union_preimage_subset (s : set α) (t : set β) (f : α → β) :
-  s ∪ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∪ t) :=
-λ x h, or.elim h (λ l, or.inl $ mem_image_of_mem _ l) (λ r, or.inr r)
-
-theorem subset_image_union (f : α → β) (s : set α) (t : set β) :
-  f '' (s ∪ f ⁻¹' t) ⊆ f '' s ∪ t :=
-image_subset_iff.2 (union_preimage_subset _ _ _)
-
-lemma preimage_subset_iff {A : set α} {B : set β} {f : α → β} :
-  f⁻¹' B ⊆ A ↔ (∀ a : α, f a ∈ B → a ∈ A) := iff.rfl
-
-lemma image_eq_image {f : α → β} (hf : injective f) : f '' s = f '' t ↔ s = t :=
-iff.symm $ iff.intro (assume eq, eq ▸ rfl) $ assume eq,
-  by rw [← preimage_image_eq s hf, ← preimage_image_eq t hf, eq]
-
-lemma image_subset_image_iff {f : α → β} (hf : injective f) : f '' s ⊆ f '' t ↔ s ⊆ t :=
-begin
-  refine (iff.symm $ iff.intro (image_subset f) $ assume h, _),
-  rw [← preimage_image_eq s hf, ← preimage_image_eq t hf],
-  exact preimage_mono h
-end
-
-lemma prod_quotient_preimage_eq_image [s : setoid α] (g : quotient s → β) {h : α → β}
-  (Hh : h = g ∘ quotient.mk) (r : set (β × β)) :
-  {x : quotient s × quotient s | (g x.1, g x.2) ∈ r} =
-  (λ a : α × α, (⟦a.1⟧, ⟦a.2⟧)) '' ((λ a : α × α, (h a.1, h a.2)) ⁻¹' r) :=
-Hh.symm ▸ set.ext (λ ⟨a₁, a₂⟩, ⟨quotient.induction_on₂ a₁ a₂
-  (λ a₁ a₂ h, ⟨(a₁, a₂), h, rfl⟩),
-  λ ⟨⟨b₁, b₂⟩, h₁, h₂⟩, show (g a₁, g a₂) ∈ r, from
-  have h₃ : ⟦b₁⟧ = a₁ ∧ ⟦b₂⟧ = a₂ := prod.ext_iff.1 h₂,
-    h₃.1 ▸ h₃.2 ▸ h₁⟩)
-
-lemma exists_image_iff (f : α → β) (x : set α) (P : β → Prop) :
-  (∃ (a : f '' x), P a) ↔ ∃ (a : x), P (f a) :=
-⟨λ ⟨a, h⟩, ⟨⟨_, a.prop.some_spec.1⟩, a.prop.some_spec.2.symm ▸ h⟩,
-  λ ⟨a, h⟩, ⟨⟨_, _, a.prop, rfl⟩, h⟩⟩
-
-/-- Restriction of `f` to `s` factors through `s.image_factorization f : s → f '' s`. -/
-def image_factorization (f : α → β) (s : set α) : s → f '' s :=
-λ p, ⟨f p.1, mem_image_of_mem f p.2⟩
-
-lemma image_factorization_eq {f : α → β} {s : set α} :
-  subtype.val ∘ image_factorization f s = f ∘ subtype.val :=
-funext $ λ p, rfl
-
-lemma surjective_onto_image {f : α → β} {s : set α} :
-  surjective (image_factorization f s) :=
-λ ⟨_, ⟨a, ha, rfl⟩⟩, ⟨⟨a, ha⟩, rfl⟩
-
-/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
--/
-lemma image_perm {s : set α} {σ : equiv.perm α} (hs : {a : α | σ a ≠ a} ⊆ s) : σ '' s = s :=
-begin
-  ext i,
-  obtain hi | hi := eq_or_ne (σ i) i,
-  { refine ⟨_, λ h, ⟨i, h, hi⟩⟩,
-    rintro ⟨j, hj, h⟩,
-    rwa σ.injective (hi.trans h.symm) },
-  { refine iff_of_true ⟨σ.symm i, hs $ λ h, hi _, σ.apply_symm_apply _⟩ (hs hi),
-    convert congr_arg σ h; exact (σ.apply_symm_apply _).symm }
-end
-
-end image
-
 /-! ### Subsingleton -/
 
-/-- A set `s` is a `subsingleton`, if it has at most one element. -/
+/-- A set `s` is a `subsingleton` if it has at most one element. -/
 protected def subsingleton (s : set α) : Prop :=
 ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), x = y
 
-lemma subsingleton.mono (ht : t.subsingleton) (hst : s ⊆ t) : s.subsingleton :=
+lemma subsingleton.anti (ht : t.subsingleton) (hst : s ⊆ t) : s.subsingleton :=
 λ x hx y hy, ht (hst hx) (hst hy)
 
-lemma subsingleton.image (hs : s.subsingleton) (f : α → β) : (f '' s).subsingleton :=
-λ _ ⟨x, hx, Hx⟩ _ ⟨y, hy, Hy⟩, Hx ▸ Hy ▸ congr_arg f (hs hx hy)
-
-lemma subsingleton.eq_singleton_of_mem (hs : s.subsingleton) {x:α} (hx : x ∈ s) :
-  s = {x} :=
+lemma subsingleton.eq_singleton_of_mem (hs : s.subsingleton) {x:α} (hx : x ∈ s) : s = {x} :=
 ext $ λ y, ⟨λ hy, (hs hx hy) ▸ mem_singleton _, λ hy, (eq_of_mem_singleton hy).symm ▸ hx⟩
 
 @[simp] lemma subsingleton_empty : (∅ : set α).subsingleton := λ x, false.elim
@@ -1645,7 +1451,7 @@ ext $ λ y, ⟨λ hy, (hs hx hy) ▸ mem_singleton _, λ hy, (eq_of_mem_singleto
 λ x hx y hy, (eq_of_mem_singleton hx).symm ▸ (eq_of_mem_singleton hy).symm ▸ rfl
 
 lemma subsingleton_of_subset_singleton (h : s ⊆ {a}) : s.subsingleton :=
-subsingleton_singleton.mono h
+subsingleton_singleton.anti h
 
 lemma subsingleton_of_forall_eq (a : α) (h : ∀ b ∈ s, b = a) : s.subsingleton :=
 λ b hb c hc, (h _ hb).trans (h _ hc).symm
@@ -1671,7 +1477,7 @@ lemma subsingleton_of_univ_subsingleton (h : (univ : set α).subsingleton) : sub
 ⟨subsingleton_of_univ_subsingleton, λ h, @subsingleton_univ _ h⟩
 
 lemma subsingleton_of_subsingleton [subsingleton α] {s : set α} : set.subsingleton s :=
-subsingleton.mono subsingleton_univ (subset_univ s)
+subsingleton_univ.anti (subset_univ s)
 
 lemma subsingleton_is_top (α : Type*) [partial_order α] : set.subsingleton {x : α | is_top x} :=
 λ x hx y hy, hx.is_max.eq_of_le (hy x)
@@ -1685,12 +1491,10 @@ begin
   refine ⟨_, λ h, _⟩,
   { rintros ⟨a, rfl⟩,
     exact ⟨singleton_nonempty a, subsingleton_singleton⟩ },
-  { obtain ⟨a, ha⟩ := h.1,
-    exact ⟨a, eq_singleton_iff_unique_mem.mpr ⟨ha, λ b hb, h.2 hb ha⟩⟩ },
+  { exact h.2.eq_empty_or_singleton.resolve_left h.1.ne_empty },
 end
 
-/-- `s`, coerced to a type, is a subsingleton type if and only if `s`
-is a subsingleton set. -/
+/-- `s`, coerced to a type, is a subsingleton type if and only if `s` is a subsingleton set. -/
 @[simp, norm_cast] lemma subsingleton_coe (s : set α) : subsingleton s ↔ s.subsingleton :=
 begin
   split,
@@ -1699,354 +1503,218 @@ begin
   { exact λ h, subsingleton.intro (λ a b, set_coe.ext (h a.property b.property)) }
 end
 
+lemma subsingleton.coe_sort {s : set α} : s.subsingleton → subsingleton s := s.subsingleton_coe.2
+
 /-- The `coe_sort` of a set `s` in a subsingleton type is a subsingleton.
 For the corresponding result for `subtype`, see `subtype.subsingleton`. -/
 instance subsingleton_coe_of_subsingleton [subsingleton α] {s : set α} : subsingleton s :=
 by { rw [s.subsingleton_coe], exact subsingleton_of_subsingleton }
 
-/-- The preimage of a subsingleton under an injective map is a subsingleton. -/
-theorem subsingleton.preimage {s : set β} (hs : s.subsingleton) {f : α → β}
-  (hf : function.injective f) :
-  (f ⁻¹' s).subsingleton :=
-λ a ha b hb, hf $ hs ha hb
-
-/-- `s` is a subsingleton, if its image of an injective function is. -/
-theorem subsingleton_of_image {α β : Type*} {f : α → β} (hf : function.injective f)
-  (s : set α) (hs : (f '' s).subsingleton) : s.subsingleton :=
-(hs.preimage hf).mono $ subset_preimage_image _ _
-
-theorem univ_eq_true_false : univ = ({true, false} : set Prop) :=
-eq.symm $ eq_univ_of_forall $ classical.cases (by simp) (by simp)
-
-/-! ### Lemmas about range of a function. -/
-section range
-variables {f : ι → α}
-open function
-
-/-- Range of a function.
-
-This function is more flexible than `f '' univ`, as the image requires that the domain is in Type
-and not an arbitrary Sort. -/
-def range (f : ι → α) : set α := {x | ∃y, f y = x}
-
-@[simp] theorem mem_range {x : α} : x ∈ range f ↔ ∃ y, f y = x := iff.rfl
-
-@[simp] theorem mem_range_self (i : ι) : f i ∈ range f := ⟨i, rfl⟩
-
-theorem forall_range_iff {p : α → Prop} : (∀ a ∈ range f, p a) ↔ (∀ i, p (f i)) :=
-by simp
+/-! ### Nontrivial -/
 
-theorem forall_subtype_range_iff {p : range f → Prop} :
-  (∀ a : range f, p a) ↔ ∀ i, p ⟨f i, mem_range_self _⟩ :=
-⟨λ H i, H _, λ H ⟨y, i, hi⟩, by { subst hi, apply H }⟩
+/-- A set `s` is `nontrivial` if it has at least two distinct elements. -/
+protected def nontrivial (s : set α) : Prop := ∃ x y ∈ s, x ≠ y
 
-theorem exists_range_iff {p : α → Prop} : (∃ a ∈ range f, p a) ↔ (∃ i, p (f i)) :=
-by simp
+lemma nontrivial_of_mem_mem_ne {x y} (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y) : s.nontrivial :=
+⟨x, hx, y, hy, hxy⟩
 
-lemma exists_range_iff' {p : α → Prop} :
-  (∃ a, a ∈ range f ∧ p a) ↔ ∃ i, p (f i) :=
-by simpa only [exists_prop] using exists_range_iff
+/-- Extract witnesses from s.nontrivial. This function might be used instead of case analysis on the
+argument. Note that it makes a proof depend on the classical.choice axiom. -/
+protected noncomputable def nontrivial.some (hs : s.nontrivial) : α × α :=
+(hs.some, hs.some_spec.some_spec.some)
 
-lemma exists_subtype_range_iff {p : range f → Prop} :
-  (∃ a : range f, p a) ↔ ∃ i, p ⟨f i, mem_range_self _⟩ :=
-⟨λ ⟨⟨a, i, hi⟩, ha⟩, by { subst a, exact ⟨i, ha⟩}, λ ⟨i, hi⟩, ⟨_, hi⟩⟩
+protected lemma nontrivial.some_fst_mem (hs : s.nontrivial) : hs.some.fst ∈ s := hs.some_spec.some
 
-theorem range_iff_surjective : range f = univ ↔ surjective f :=
-eq_univ_iff_forall
+protected lemma nontrivial.some_snd_mem (hs : s.nontrivial) : hs.some.snd ∈ s :=
+hs.some_spec.some_spec.some_spec.some
 
-alias range_iff_surjective ↔ _ function.surjective.range_eq
+protected lemma nontrivial.some_fst_ne_some_snd (hs : s.nontrivial) : hs.some.fst ≠ hs.some.snd :=
+hs.some_spec.some_spec.some_spec.some_spec
 
-@[simp] theorem image_univ {f : α → β} : f '' univ = range f :=
-by { ext, simp [image, range] }
+lemma nontrivial.mono (hs : s.nontrivial) (hst : s ⊆ t) : t.nontrivial :=
+let ⟨x, hx, y, hy, hxy⟩ := hs in ⟨x, hst hx, y, hst hy, hxy⟩
 
-theorem image_subset_range (f : α → β) (s) : f '' s ⊆ range f :=
-by rw ← image_univ; exact image_subset _ (subset_univ _)
+lemma nontrivial_pair {x y} (hxy : x ≠ y) : ({x, y} : set α).nontrivial :=
+⟨x, mem_insert _ _, y, mem_insert_of_mem _ (mem_singleton _), hxy⟩
 
-theorem mem_range_of_mem_image (f : α → β) (s) {x : β} (h : x ∈ f '' s) : x ∈ range f :=
-image_subset_range f s h
+lemma nontrivial_of_pair_subset {x y} (hxy : x ≠ y) (h : {x, y} ⊆ s) : s.nontrivial :=
+(nontrivial_pair hxy).mono h
 
-lemma nonempty.preimage' {s : set β} (hs : s.nonempty) {f : α → β} (hf : s ⊆ set.range f) :
-  (f ⁻¹' s).nonempty :=
-let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf hy in ⟨x, set.mem_preimage.2 $ hx.symm ▸ hy⟩
+lemma nontrivial.pair_subset (hs : s.nontrivial) : ∃ x y (hab : x ≠ y), {x, y} ⊆ s :=
+let ⟨x, hx, y, hy, hxy⟩ := hs in ⟨x, y, hxy, insert_subset.2 ⟨hx, (singleton_subset_iff.2 hy)⟩⟩
 
-theorem range_comp (g : α → β) (f : ι → α) : range (g ∘ f) = g '' range f :=
-subset.antisymm
-  (forall_range_iff.mpr $ assume i, mem_image_of_mem g (mem_range_self _))
-  (ball_image_iff.mpr $ forall_range_iff.mpr mem_range_self)
+lemma nontrivial_iff_pair_subset : s.nontrivial ↔ ∃ x y (hxy : x ≠ y), {x, y} ⊆ s :=
+⟨nontrivial.pair_subset, λ H, let ⟨x, y, hxy, h⟩ := H in nontrivial_of_pair_subset hxy h⟩
 
-theorem range_subset_iff : range f ⊆ s ↔ ∀ y, f y ∈ s :=
-forall_range_iff
+lemma nontrivial_of_exists_ne {x} (hx : x ∈ s) (h : ∃ y ∈ s, y ≠ x) : s.nontrivial :=
+let ⟨y, hy, hyx⟩ := h in ⟨y, hy, x, hx, hyx⟩
 
-theorem range_eq_iff (f : α → β) (s : set β) :
-  range f = s ↔ (∀ a, f a ∈ s) ∧ ∀ b ∈ s, ∃ a, f a = b :=
-by { rw ←range_subset_iff, exact le_antisymm_iff }
-
-lemma range_comp_subset_range (f : α → β) (g : β → γ) : range (g ∘ f) ⊆ range g :=
-by rw range_comp; apply image_subset_range
-
-lemma range_nonempty_iff_nonempty : (range f).nonempty ↔ nonempty ι :=
-⟨λ ⟨y, x, hxy⟩, ⟨x⟩, λ ⟨x⟩, ⟨f x, mem_range_self x⟩⟩
-
-lemma range_nonempty [h : nonempty ι] (f : ι → α) : (range f).nonempty :=
-range_nonempty_iff_nonempty.2 h
-
-@[simp] lemma range_eq_empty_iff {f : ι → α} : range f = ∅ ↔ is_empty ι :=
-by rw [← not_nonempty_iff, ← range_nonempty_iff_nonempty, not_nonempty_iff_eq_empty]
-
-lemma range_eq_empty [is_empty ι] (f : ι → α) : range f = ∅ := range_eq_empty_iff.2 ‹_›
-
-instance [nonempty ι] (f : ι → α) : nonempty (range f) := (range_nonempty f).to_subtype
-
-@[simp] lemma image_union_image_compl_eq_range (f : α → β) :
-  (f '' s) ∪ (f '' sᶜ) = range f :=
-by rw [← image_union, ← image_univ, ← union_compl_self]
-
-theorem image_preimage_eq_inter_range {f : α → β} {t : set β} :
-  f '' (f ⁻¹' t) = t ∩ range f :=
-ext $ assume x, ⟨assume ⟨x, hx, heq⟩, heq ▸ ⟨hx, mem_range_self _⟩,
-  assume ⟨hx, ⟨y, h_eq⟩⟩, h_eq ▸ mem_image_of_mem f $
-    show y ∈ f ⁻¹' t, by simp [preimage, h_eq, hx]⟩
-
-lemma image_preimage_eq_of_subset {f : α → β} {s : set β} (hs : s ⊆ range f) :
-  f '' (f ⁻¹' s) = s :=
-by rw [image_preimage_eq_inter_range, inter_eq_self_of_subset_left hs]
-
-lemma image_preimage_eq_iff {f : α → β} {s : set β} : f '' (f ⁻¹' s) = s ↔ s ⊆ range f :=
-⟨by { intro h, rw [← h], apply image_subset_range }, image_preimage_eq_of_subset⟩
-
-lemma preimage_subset_preimage_iff {s t : set α} {f : β → α} (hs : s ⊆ range f) :
-  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
-begin
-  split,
-  { intros h x hx, rcases hs hx with ⟨y, rfl⟩, exact h hx },
-  intros h x, apply h
-end
-
-lemma preimage_eq_preimage' {s t : set α} {f : β → α} (hs : s ⊆ range f) (ht : t ⊆ range f) :
-  f ⁻¹' s = f ⁻¹' t ↔ s = t :=
+lemma nontrivial.exists_ne (hs : s.nontrivial) (z) : ∃ x ∈ s, x ≠ z :=
 begin
-  split,
-  { intro h, apply subset.antisymm, rw [←preimage_subset_preimage_iff hs, h],
-    rw [←preimage_subset_preimage_iff ht, h] },
-  rintro rfl, refl
+  by_contra H, push_neg at H,
+  rcases hs with ⟨x, hx, y, hy, hxy⟩,
+  rw [H x hx, H y hy] at hxy,
+  exact hxy rfl
 end
 
-@[simp] theorem preimage_inter_range {f : α → β} {s : set β} : f ⁻¹' (s ∩ range f) = f ⁻¹' s :=
-set.ext $ λ x, and_iff_left ⟨x, rfl⟩
-
-@[simp] theorem preimage_range_inter {f : α → β} {s : set β} : f ⁻¹' (range f ∩ s) = f ⁻¹' s :=
-by rw [inter_comm, preimage_inter_range]
-
-theorem preimage_image_preimage {f : α → β} {s : set β} :
-  f ⁻¹' (f '' (f ⁻¹' s)) = f ⁻¹' s :=
-by rw [image_preimage_eq_inter_range, preimage_inter_range]
-
-@[simp] theorem range_id : range (@id α) = univ := range_iff_surjective.2 surjective_id
-
-@[simp] theorem range_id' : range (λ (x : α), x) = univ := range_id
-
-@[simp] theorem _root_.prod.range_fst [nonempty β] : range (prod.fst : α × β → α) = univ :=
-prod.fst_surjective.range_eq
+lemma nontrivial_iff_exists_ne {x} (hx : x ∈ s) : s.nontrivial ↔ ∃ y ∈ s, y ≠ x :=
+⟨λ H, H.exists_ne _, nontrivial_of_exists_ne hx⟩
 
-@[simp] theorem _root_.prod.range_snd [nonempty α] : range (prod.snd : α × β → β) = univ :=
-prod.snd_surjective.range_eq
+lemma nontrivial_of_lt [preorder α] {x y} (hx : x ∈ s) (hy : y ∈ s) (hxy : x < y) : s.nontrivial :=
+⟨x, hx, y, hy, ne_of_lt hxy⟩
 
-@[simp] theorem range_eval {ι : Type*} {α : ι → Sort*} [Π i, nonempty (α i)] (i : ι) :
-  range (eval i : (Π i, α i) → α i) = univ :=
-(surjective_eval i).range_eq
+lemma nontrivial_of_exists_lt [preorder α] (H : ∃ x y ∈ s, x < y) : s.nontrivial :=
+let ⟨x, hx, y, hy, hxy⟩ := H in nontrivial_of_lt hx hy hxy
 
-theorem is_compl_range_inl_range_inr : is_compl (range $ @sum.inl α β) (range sum.inr) :=
-⟨by { rintro y ⟨⟨x₁, rfl⟩, ⟨x₂, _⟩⟩, cc },
-  by { rintro (x|y) -; [left, right]; exact mem_range_self _ }⟩
+lemma nontrivial.exists_lt [linear_order α] (hs : s.nontrivial) : ∃ x y ∈ s, x < y :=
+let ⟨x, hx, y, hy, hxy⟩ := hs in
+or.elim (lt_or_gt_of_ne hxy) (λ H, ⟨x, hx, y, hy, H⟩) (λ H, ⟨y, hy, x, hx, H⟩)
 
-@[simp] theorem range_inl_union_range_inr : range (sum.inl : α → α ⊕ β) ∪ range sum.inr = univ :=
-is_compl_range_inl_range_inr.sup_eq_top
+lemma nontrivial_iff_exists_lt [linear_order α] : s.nontrivial ↔ ∃ x y ∈ s, x < y :=
+⟨nontrivial.exists_lt, nontrivial_of_exists_lt⟩
 
-@[simp] theorem range_inl_inter_range_inr : range (sum.inl : α → α ⊕ β) ∩ range sum.inr = ∅ :=
-is_compl_range_inl_range_inr.inf_eq_bot
+protected lemma nontrivial.nonempty (hs : s.nontrivial) : s.nonempty :=
+let ⟨x, hx, _⟩ := hs in ⟨x, hx⟩
 
-@[simp] theorem range_inr_union_range_inl : range (sum.inr : β → α ⊕ β) ∪ range sum.inl = univ :=
-is_compl_range_inl_range_inr.symm.sup_eq_top
+protected lemma nontrivial.ne_empty (hs : s.nontrivial) : s ≠ ∅ := hs.nonempty.ne_empty
 
-@[simp] theorem range_inr_inter_range_inl : range (sum.inr : β → α ⊕ β) ∩ range sum.inl = ∅ :=
-is_compl_range_inl_range_inr.symm.inf_eq_bot
+lemma nontrivial.not_subset_empty (hs : s.nontrivial) : ¬ s ⊆ ∅ := hs.nonempty.not_subset_empty
 
-@[simp] theorem preimage_inl_image_inr (s : set β) : sum.inl ⁻¹' (@sum.inr α β '' s) = ∅ :=
-by { ext, simp }
+@[simp] lemma not_nontrivial_empty : ¬ (∅ : set α).nontrivial := λ h, h.ne_empty rfl
 
-@[simp] theorem preimage_inr_image_inl (s : set α) : sum.inr ⁻¹' (@sum.inl α β '' s) = ∅ :=
-by { ext, simp }
-
-@[simp] theorem preimage_inl_range_inr : sum.inl ⁻¹' range (sum.inr : β → α ⊕ β) = ∅ :=
-by rw [← image_univ, preimage_inl_image_inr]
-
-@[simp] theorem preimage_inr_range_inl : sum.inr ⁻¹' range (sum.inl : α → α ⊕ β) = ∅ :=
-by rw [← image_univ, preimage_inr_image_inl]
+@[simp] lemma not_nontrivial_singleton {x} : ¬ ({x} : set α).nontrivial :=
+λ H, begin
+  rw nontrivial_iff_exists_ne (mem_singleton x) at H,
+  exact let ⟨y, hy, hya⟩ := H in hya (mem_singleton_iff.1 hy)
+end
 
-@[simp] lemma compl_range_inl : (range (sum.inl : α → α ⊕ β))ᶜ = range (sum.inr : β → α ⊕ β) :=
-is_compl_range_inl_range_inr.compl_eq
+lemma nontrivial.ne_singleton {x} (hs : s.nontrivial) : s ≠ {x} :=
+λ H, by { rw H at hs, exact not_nontrivial_singleton hs }
 
-@[simp] lemma compl_range_inr : (range (sum.inr : β → α ⊕ β))ᶜ = range (sum.inl : α → α ⊕ β) :=
-is_compl_range_inl_range_inr.symm.compl_eq
+lemma nontrivial.not_subset_singleton {x} (hs : s.nontrivial) : ¬ s ⊆ {x} :=
+(not_congr subset_singleton_iff_eq).2 (not_or hs.ne_empty hs.ne_singleton)
 
-@[simp] theorem range_quot_mk (r : α → α → Prop) : range (quot.mk r) = univ :=
-(surjective_quot_mk r).range_eq
+lemma nontrivial_univ [nontrivial α] : (univ : set α).nontrivial :=
+let ⟨x, y, hxy⟩ := exists_pair_ne α in ⟨x, mem_univ _, y, mem_univ _, hxy⟩
 
-instance set.can_lift [can_lift α β] : can_lift (set α) (set β) :=
-{ coe := λ s, can_lift.coe '' s,
-  cond := λ s, ∀ x ∈ s, can_lift.cond β x,
-  prf := λ s hs, ⟨can_lift.coe ⁻¹' s, image_preimage_eq_of_subset $
-    λ x hx, can_lift.prf _ (hs x hx)⟩ }
+lemma nontrivial_of_univ_nontrivial (h : (univ : set α).nontrivial) : nontrivial α :=
+let ⟨x, _, y, _, hxy⟩ := h in ⟨⟨x, y, hxy⟩⟩
 
-@[simp] theorem quot_mk_range_eq [setoid α] : range (λx : α, ⟦x⟧) = univ :=
-range_iff_surjective.2 quot.exists_rep
+@[simp] lemma nontrivial_univ_iff : (univ : set α).nontrivial ↔ nontrivial α :=
+⟨nontrivial_of_univ_nontrivial, λ h, @nontrivial_univ _ h⟩
 
-lemma range_const_subset {c : α} : range (λ x : ι, c) ⊆ {c} :=
-range_subset_iff.2 $ λ x, rfl
+lemma nontrivial_of_nontrivial (hs : s.nontrivial) : nontrivial α :=
+let ⟨x, _, y, _, hxy⟩ := hs in ⟨⟨x, y, hxy⟩⟩
 
-@[simp] lemma range_const : ∀ [nonempty ι] {c : α}, range (λx:ι, c) = {c}
-| ⟨x⟩ c := subset.antisymm range_const_subset $
-  assume y hy, (mem_singleton_iff.1 hy).symm ▸ mem_range_self x
+/-- `s`, coerced to a type, is a nontrivial type if and only if `s` is a nontrivial set. -/
+@[simp, norm_cast] lemma nontrivial_coe_sort {s : set α} : nontrivial s ↔ s.nontrivial :=
+by simp_rw [← nontrivial_univ_iff, set.nontrivial, mem_univ,
+            exists_true_left, set_coe.exists, subtype.mk_eq_mk]
 
-lemma image_swap_eq_preimage_swap : image (@prod.swap α β) = preimage prod.swap :=
-image_eq_preimage_of_inverse prod.swap_left_inverse prod.swap_right_inverse
+alias nontrivial_coe_sort ↔ _ nontrivial.coe_sort
 
-theorem preimage_singleton_nonempty {f : α → β} {y : β} :
-  (f ⁻¹' {y}).nonempty ↔ y ∈ range f :=
-iff.rfl
+/-- A type with a set `s` whose `coe_sort` is a nontrivial type is nontrivial.
+For the corresponding result for `subtype`, see `subtype.nontrivial_iff_exists_ne`. -/
+lemma nontrivial_of_nontrivial_coe (hs : nontrivial s) : nontrivial α :=
+nontrivial_of_nontrivial $ nontrivial_coe_sort.1 hs
 
-theorem preimage_singleton_eq_empty {f : α → β} {y : β} :
-  f ⁻¹' {y} = ∅ ↔ y ∉ range f :=
-not_nonempty_iff_eq_empty.symm.trans preimage_singleton_nonempty.not
+theorem nontrivial_mono {α : Type*} {s t : set α} (hst : s ⊆ t) (hs : nontrivial s) :
+  nontrivial t := nontrivial.coe_sort $ (nontrivial_coe_sort.1 hs).mono hst
 
-lemma range_subset_singleton {f : ι → α} {x : α} : range f ⊆ {x} ↔ f = const ι x :=
-by simp [range_subset_iff, funext_iff, mem_singleton]
+@[simp] lemma not_subsingleton_iff : ¬ s.subsingleton ↔ s.nontrivial :=
+by simp_rw [set.subsingleton, set.nontrivial, not_forall]
 
-lemma image_compl_preimage {f : α → β} {s : set β} : f '' ((f ⁻¹' s)ᶜ) = range f \ s :=
-by rw [compl_eq_univ_diff, image_diff_preimage, image_univ]
-
-@[simp] theorem range_sigma_mk {β : α → Type*} (a : α) :
-  range (sigma.mk a : β a → Σ a, β a) = sigma.fst ⁻¹' {a} :=
-begin
-  apply subset.antisymm,
-  { rintros _ ⟨b, rfl⟩, simp },
-  { rintros ⟨x, y⟩ (rfl|_),
-    exact mem_range_self y }
-end
+@[simp] lemma not_nontrivial_iff : ¬ s.nontrivial ↔ s.subsingleton :=
+iff.not_left not_subsingleton_iff.symm
 
-/-- Any map `f : ι → β` factors through a map `range_factorization f : ι → range f`. -/
-def range_factorization (f : ι → β) : ι → range f :=
-λ i, ⟨f i, mem_range_self i⟩
+alias not_nontrivial_iff ↔ _ subsingleton.not_nontrivial
+alias not_subsingleton_iff ↔ _ nontrivial.not_subsingleton
 
-lemma range_factorization_eq {f : ι → β} :
-  subtype.val ∘ range_factorization f = f :=
-funext $ λ i, rfl
+protected lemma subsingleton_or_nontrivial (s : set α) : s.subsingleton ∨ s.nontrivial :=
+by simp [or_iff_not_imp_right]
 
-@[simp] lemma range_factorization_coe (f : ι → β) (a : ι) :
-  (range_factorization f a : β) = f a := rfl
+lemma eq_singleton_or_nontrivial (ha : a ∈ s) : s = {a} ∨ s.nontrivial :=
+by { rw ←subsingleton_iff_singleton ha, exact s.subsingleton_or_nontrivial }
 
-@[simp] lemma coe_comp_range_factorization (f : ι → β) : coe ∘ range_factorization f = f := rfl
+lemma nontrivial_iff_ne_singleton (ha : a ∈ s) : s.nontrivial ↔ s ≠ {a} :=
+⟨nontrivial.ne_singleton, (eq_singleton_or_nontrivial ha).resolve_left⟩
 
-lemma surjective_onto_range : surjective (range_factorization f) :=
-λ ⟨_, ⟨i, rfl⟩⟩, ⟨i, rfl⟩
+lemma nonempty.exists_eq_singleton_or_nontrivial : s.nonempty → (∃ a, s = {a}) ∨ s.nontrivial :=
+λ ⟨a, ha⟩, (eq_singleton_or_nontrivial ha).imp_left $ exists.intro a
 
-lemma image_eq_range (f : α → β) (s : set α) : f '' s = range (λ(x : s), f x) :=
-by { ext, split, rintro ⟨x, h1, h2⟩, exact ⟨⟨x, h1⟩, h2⟩, rintro ⟨⟨x, h1⟩, h2⟩, exact ⟨x, h1, h2⟩ }
+theorem univ_eq_true_false : univ = ({true, false} : set Prop) :=
+eq.symm $ eq_univ_of_forall $ classical.cases (by simp) (by simp)
 
-@[simp] lemma sum.elim_range {α β γ : Type*} (f : α → γ) (g : β → γ) :
-  range (sum.elim f g) = range f ∪ range g :=
-by simp [set.ext_iff, mem_range]
+section preorder
+variables [preorder α] [preorder β] {f : α → β}
 
-lemma range_ite_subset' {p : Prop} [decidable p] {f g : α → β} :
-  range (if p then f else g) ⊆ range f ∪ range g :=
-begin
-  by_cases h : p, {rw if_pos h, exact subset_union_left _ _},
-  {rw if_neg h, exact subset_union_right _ _}
-end
+lemma monotone_on_iff_monotone : monotone_on f s ↔ monotone (λ a : s, f a) :=
+by simp [monotone, monotone_on]
 
-lemma range_ite_subset {p : α → Prop} [decidable_pred p] {f g : α → β} :
-  range (λ x, if p x then f x else g x) ⊆ range f ∪ range g :=
-begin
-  rw range_subset_iff, intro x, by_cases h : p x,
-  simp [if_pos h, mem_union, mem_range_self],
-  simp [if_neg h, mem_union, mem_range_self]
-end
+lemma antitone_on_iff_antitone : antitone_on f s ↔ antitone (λ a : s, f a) :=
+by simp [antitone, antitone_on]
 
-@[simp] lemma preimage_range (f : α → β) : f ⁻¹' (range f) = univ :=
-eq_univ_of_forall mem_range_self
+lemma strict_mono_on_iff_strict_mono : strict_mono_on f s ↔ strict_mono (λ a : s, f a) :=
+by simp [strict_mono, strict_mono_on]
 
-/-- The range of a function from a `unique` type contains just the
-function applied to its single value. -/
-lemma range_unique [h : unique ι] : range f = {f default} :=
-begin
-  ext x,
-  rw mem_range,
-  split,
-  { rintros ⟨i, hi⟩,
-    rw h.uniq i at hi,
-    exact hi ▸ mem_singleton _ },
-  { exact λ h, ⟨default, h.symm⟩ }
-end
+lemma strict_anti_on_iff_strict_anti : strict_anti_on f s ↔ strict_anti (λ a : s, f a) :=
+by simp [strict_anti, strict_anti_on]
 
-lemma range_diff_image_subset (f : α → β) (s : set α) :
-  range f \ f '' s ⊆ f '' sᶜ :=
-λ y ⟨⟨x, h₁⟩, h₂⟩, ⟨x, λ h, h₂ ⟨x, h, h₁⟩, h₁⟩
+variables (f)
 
-lemma range_diff_image {f : α → β} (H : injective f) (s : set α) :
-  range f \ f '' s = f '' sᶜ :=
-subset.antisymm (range_diff_image_subset f s) $ λ y ⟨x, hx, hy⟩, hy ▸
-  ⟨mem_range_self _, λ ⟨x', hx', eq⟩, hx $ H eq ▸ hx'⟩
+/-! ### Monotonicity on singletons -/
 
-/-- We can use the axiom of choice to pick a preimage for every element of `range f`. -/
-noncomputable def range_splitting (f : α → β) : range f → α := λ x, x.2.some
+protected lemma subsingleton.monotone_on (h : s.subsingleton) :
+  monotone_on f s :=
+λ a ha b hb _, (congr_arg _ (h ha hb)).le
 
--- This can not be a `@[simp]` lemma because the head of the left hand side is a variable.
-lemma apply_range_splitting (f : α → β) (x : range f) : f (range_splitting f x) = x :=
-x.2.some_spec
+protected lemma subsingleton.antitone_on (h : s.subsingleton) :
+  antitone_on f s :=
+λ a ha b hb _, (congr_arg _ (h hb ha)).le
 
-attribute [irreducible] range_splitting
+protected lemma subsingleton.strict_mono_on (h : s.subsingleton) :
+  strict_mono_on f s :=
+λ a ha b hb hlt, (hlt.ne (h ha hb)).elim
 
-@[simp] lemma comp_range_splitting (f : α → β) : f ∘ range_splitting f = coe :=
-by { ext, simp only [function.comp_app], apply apply_range_splitting, }
+protected lemma subsingleton.strict_anti_on (h : s.subsingleton) :
+  strict_anti_on f s :=
+λ a ha b hb hlt, (hlt.ne (h ha hb)).elim
 
--- When `f` is injective, see also `equiv.of_injective`.
-lemma left_inverse_range_splitting (f : α → β) :
-  left_inverse (range_factorization f) (range_splitting f) :=
-λ x, by { ext, simp only [range_factorization_coe], apply apply_range_splitting, }
+@[simp] lemma monotone_on_singleton : monotone_on f {a} :=
+subsingleton_singleton.monotone_on f
 
-lemma range_splitting_injective (f : α → β) : injective (range_splitting f) :=
-(left_inverse_range_splitting f).injective
+@[simp] lemma antitone_on_singleton : antitone_on f {a} :=
+subsingleton_singleton.antitone_on f
 
-lemma right_inverse_range_splitting {f : α → β} (h : injective f) :
-  right_inverse (range_factorization f) (range_splitting f) :=
-(left_inverse_range_splitting f).right_inverse_of_injective $
-  λ x y hxy, h $ subtype.ext_iff.1 hxy
+@[simp] lemma strict_mono_on_singleton : strict_mono_on f {a} :=
+subsingleton_singleton.strict_mono_on f
 
-lemma preimage_range_splitting {f : α → β} (hf : injective f) :
-  preimage (range_splitting f) = image (range_factorization f) :=
-(image_eq_preimage_of_inverse (right_inverse_range_splitting hf)
-  (left_inverse_range_splitting f)).symm
+@[simp] lemma strict_anti_on_singleton : strict_anti_on f {a} :=
+subsingleton_singleton.strict_anti_on f
 
-lemma is_compl_range_some_none (α : Type*) :
-  is_compl (range (some : α → option α)) {none} :=
-⟨λ x ⟨⟨a, ha⟩, (hn : x = none)⟩, option.some_ne_none _ (ha.trans hn),
-  λ x hx, option.cases_on x (or.inr rfl) (λ x, or.inl $ mem_range_self _)⟩
+end preorder
 
-@[simp] lemma compl_range_some (α : Type*) :
-  (range (some : α → option α))ᶜ = {none} :=
-(is_compl_range_some_none α).compl_eq
+section linear_order
+variables [linear_order α] [linear_order β] {f : α → β}
 
-@[simp] lemma range_some_inter_none (α : Type*) : range (some : α → option α) ∩ {none} = ∅ :=
-(is_compl_range_some_none α).inf_eq_bot
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_on_not_antitone_on_iff_exists_le_le :
+  ¬ monotone_on f s ∧ ¬ antitone_on f s ↔ ∃ a b c ∈ s, a ≤ b ∧ b ≤ c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+by simp [monotone_on_iff_monotone, antitone_on_iff_antitone, and_assoc, exists_and_distrib_left,
+  not_monotone_not_antitone_iff_exists_le_le, @and.left_comm (_ ∈ s)]
 
-@[simp] lemma range_some_union_none (α : Type*) : range (some : α → option α) ∪ {none} = univ :=
-(is_compl_range_some_none α).sup_eq_top
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_on_not_antitone_on_iff_exists_lt_lt :
+  ¬ monotone_on f s ∧ ¬ antitone_on f s ↔ ∃ a b c ∈ s, a < b ∧ b < c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+by simp [monotone_on_iff_monotone, antitone_on_iff_antitone, and_assoc, exists_and_distrib_left,
+  not_monotone_not_antitone_iff_exists_lt_lt, @and.left_comm (_ ∈ s)]
 
-@[simp] lemma insert_none_range_some (α : Type*) :
-  insert none (range (some : α → option α)) = univ :=
-(is_compl_range_some_none α).symm.sup_eq_top
+end linear_order
 
-end range
 end set
 
 open set
@@ -2055,176 +1723,13 @@ namespace function
 
 variables {ι : Sort*} {α : Type*} {β : Type*} {f : α → β}
 
-lemma surjective.preimage_injective (hf : surjective f) : injective (preimage f) :=
-assume s t, (preimage_eq_preimage hf).1
-
-lemma injective.preimage_image (hf : injective f) (s : set α) : f ⁻¹' (f '' s) = s :=
-preimage_image_eq s hf
-
-lemma injective.preimage_surjective (hf : injective f) : surjective (preimage f) :=
-by { intro s, use f '' s, rw hf.preimage_image }
-
-lemma injective.subsingleton_image_iff (hf : injective f) {s : set α} :
-  (f '' s).subsingleton ↔ s.subsingleton :=
-⟨subsingleton_of_image hf s, λ h, h.image f⟩
-
-lemma surjective.image_preimage (hf : surjective f) (s : set β) : f '' (f ⁻¹' s) = s :=
-image_preimage_eq s hf
-
-lemma surjective.image_surjective (hf : surjective f) : surjective (image f) :=
-by { intro s, use f ⁻¹' s, rw hf.image_preimage }
-
-lemma surjective.nonempty_preimage (hf : surjective f) {s : set β} :
-  (f ⁻¹' s).nonempty ↔ s.nonempty :=
-by rw [← nonempty_image_iff, hf.image_preimage]
-
-lemma injective.image_injective (hf : injective f) : injective (image f) :=
-by { intros s t h, rw [←preimage_image_eq s hf, ←preimage_image_eq t hf, h] }
-
-lemma surjective.preimage_subset_preimage_iff {s t : set β} (hf : surjective f) :
-  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
-by { apply preimage_subset_preimage_iff, rw [hf.range_eq], apply subset_univ }
-
-lemma surjective.range_comp {ι' : Sort*} {f : ι → ι'} (hf : surjective f) (g : ι' → α) :
-  range (g ∘ f) = range g :=
-ext $ λ y, (@surjective.exists _ _ _ hf (λ x, g x = y)).symm
-
 lemma injective.nonempty_apply_iff {f : set α → set β} (hf : injective f)
   (h2 : f ∅ = ∅) {s : set α} : (f s).nonempty ↔ s.nonempty :=
-by rw [← ne_empty_iff_nonempty, ← h2, ← ne_empty_iff_nonempty, hf.ne_iff]
-
-lemma injective.mem_range_iff_exists_unique (hf : injective f) {b : β} :
-  b ∈ range f ↔ ∃! a, f a = b :=
-⟨λ ⟨a, h⟩, ⟨a, h, λ a' ha, hf (ha.trans h.symm)⟩, exists_unique.exists⟩
-
-lemma injective.exists_unique_of_mem_range (hf : injective f) {b : β} (hb : b ∈ range f) :
-  ∃! a, f a = b :=
-hf.mem_range_iff_exists_unique.mp hb
-
-theorem injective.compl_image_eq (hf : injective f) (s : set α) :
-  (f '' s)ᶜ = f '' sᶜ ∪ (range f)ᶜ :=
-begin
-  ext y,
-  rcases em (y ∈ range f) with ⟨x, rfl⟩|hx,
-  { simp [hf.eq_iff] },
-  { rw [mem_range, not_exists] at hx,
-    simp [hx] }
-end
-
-lemma left_inverse.image_image {g : β → α} (h : left_inverse g f) (s : set α) :
-  g '' (f '' s) = s :=
-by rw [← image_comp, h.comp_eq_id, image_id]
-
-lemma left_inverse.preimage_preimage {g : β → α} (h : left_inverse g f) (s : set α) :
-  f ⁻¹' (g ⁻¹' s) = s :=
-by rw [← preimage_comp, h.comp_eq_id, preimage_id]
+by rw [nonempty_iff_ne_empty, ← h2, nonempty_iff_ne_empty, hf.ne_iff]
 
 end function
 open function
 
-lemma option.injective_iff {α β} {f : option α → β} :
-  injective f ↔ injective (f ∘ some) ∧ f none ∉ range (f ∘ some) :=
-begin
-  simp only [mem_range, not_exists, (∘)],
-  refine ⟨λ hf, ⟨hf.comp (option.some_injective _), λ x, hf.ne $ option.some_ne_none _⟩, _⟩,
-  rintro ⟨h_some, h_none⟩ (_|a) (_|b) hab,
-  exacts [rfl, (h_none _ hab.symm).elim, (h_none _ hab).elim, congr_arg some (h_some hab)]
-end
-
-/-! ### Image and preimage on subtypes -/
-
-namespace subtype
-
-variable {α : Type*}
-
-lemma coe_image {p : α → Prop} {s : set (subtype p)} :
-  coe '' s = {x | ∃h : p x, (⟨x, h⟩ : subtype p) ∈ s} :=
-set.ext $ assume a,
-⟨assume ⟨⟨a', ha'⟩, in_s, h_eq⟩, h_eq ▸ ⟨ha', in_s⟩,
-  assume ⟨ha, in_s⟩, ⟨⟨a, ha⟩, in_s, rfl⟩⟩
-
-@[simp] lemma coe_image_of_subset {s t : set α} (h : t ⊆ s) : coe '' {x : ↥s | ↑x ∈ t} = t :=
-begin
-  ext x,
-  rw set.mem_image,
-  exact ⟨λ ⟨x', hx', hx⟩, hx ▸ hx', λ hx, ⟨⟨x, h hx⟩, hx, rfl⟩⟩,
-end
-
-lemma range_coe {s : set α} :
-  range (coe : s → α) = s :=
-by { rw ← set.image_univ, simp [-set.image_univ, coe_image] }
-
-/-- A variant of `range_coe`. Try to use `range_coe` if possible.
-  This version is useful when defining a new type that is defined as the subtype of something.
-  In that case, the coercion doesn't fire anymore. -/
-lemma range_val {s : set α} :
-  range (subtype.val : s → α) = s :=
-range_coe
-
-/-- We make this the simp lemma instead of `range_coe`. The reason is that if we write
-  for `s : set α` the function `coe : s → α`, then the inferred implicit arguments of `coe` are
-  `coe α (λ x, x ∈ s)`. -/
-@[simp] lemma range_coe_subtype {p : α → Prop} :
-  range (coe : subtype p → α) = {x | p x} :=
-range_coe
-
-@[simp] lemma coe_preimage_self (s : set α) : (coe : s → α) ⁻¹' s = univ :=
-by rw [← preimage_range (coe : s → α), range_coe]
-
-lemma range_val_subtype {p : α → Prop} :
-  range (subtype.val : subtype p → α) = {x | p x} :=
-range_coe
-
-theorem coe_image_subset (s : set α) (t : set s) : coe '' t ⊆ s :=
-λ x ⟨y, yt, yvaleq⟩, by rw ←yvaleq; exact y.property
-
-theorem coe_image_univ (s : set α) : (coe : s → α) '' set.univ = s :=
-image_univ.trans range_coe
-
-@[simp] theorem image_preimage_coe (s t : set α) :
-  (coe : s → α) '' (coe ⁻¹' t) = t ∩ s :=
-image_preimage_eq_inter_range.trans $ congr_arg _ range_coe
-
-theorem image_preimage_val (s t : set α) :
-  (subtype.val : s → α) '' (subtype.val ⁻¹' t) = t ∩ s :=
-image_preimage_coe s t
-
-theorem preimage_coe_eq_preimage_coe_iff {s t u : set α} :
-  ((coe : s → α) ⁻¹' t = coe ⁻¹' u) ↔ t ∩ s = u ∩ s :=
-by rw [← image_preimage_coe, ← image_preimage_coe, coe_injective.image_injective.eq_iff]
-
-@[simp] theorem preimage_coe_inter_self (s t : set α) :
-  (coe : s → α) ⁻¹' (t ∩ s) = coe ⁻¹' t :=
-by rw [preimage_coe_eq_preimage_coe_iff, inter_assoc, inter_self]
-
-theorem preimage_val_eq_preimage_val_iff (s t u : set α) :
-  ((subtype.val : s → α) ⁻¹' t = subtype.val ⁻¹' u) ↔ (t ∩ s = u ∩ s) :=
-preimage_coe_eq_preimage_coe_iff
-
-lemma exists_set_subtype {t : set α} (p : set α → Prop) :
-  (∃(s : set t), p (coe '' s)) ↔ ∃(s : set α), s ⊆ t ∧ p s :=
-begin
-  split,
-  { rintro ⟨s, hs⟩, refine ⟨coe '' s, _, hs⟩,
-    convert image_subset_range _ _, rw [range_coe] },
-  rintro ⟨s, hs₁, hs₂⟩, refine ⟨coe ⁻¹' s, _⟩,
-  rw [image_preimage_eq_of_subset], exact hs₂, rw [range_coe], exact hs₁
-end
-
-lemma preimage_coe_nonempty {s t : set α} : ((coe : s → α) ⁻¹' t).nonempty ↔ (s ∩ t).nonempty :=
-by rw [inter_comm, ← image_preimage_coe, nonempty_image_iff]
-
-lemma preimage_coe_eq_empty {s t : set α} : (coe : s → α) ⁻¹' t = ∅ ↔ s ∩ t = ∅ :=
-by simp only [← not_nonempty_iff_eq_empty, preimage_coe_nonempty]
-
-@[simp] lemma preimage_coe_compl (s : set α) : (coe : s → α) ⁻¹' sᶜ = ∅ :=
-preimage_coe_eq_empty.2 (inter_compl_self s)
-
-@[simp] lemma preimage_coe_compl' (s : set α) : (coe : sᶜ → α) ⁻¹' s = ∅ :=
-preimage_coe_eq_empty.2 (compl_inter_self s)
-
-end subtype
-
 namespace set
 
 /-! ### Lemmas about `inclusion`, the injection of subtypes induced by `⊆` -/
@@ -2238,6 +1743,8 @@ def inclusion (h : s ⊆ t) : s → t :=
 
 @[simp] lemma inclusion_self (x : s) : inclusion subset.rfl x = x := by { cases x, refl }
 
+lemma inclusion_eq_id (h : s ⊆ s) : inclusion h = id := funext inclusion_self
+
 @[simp] lemma inclusion_mk {h : s ⊆ t} (a : α) (ha : a ∈ s) : inclusion h ⟨a, ha⟩ = ⟨a, h ha⟩ := rfl
 
 lemma inclusion_right (h : s ⊆ t) (x : t) (m : (x : α) ∈ s) : inclusion h ⟨x, m⟩ = x :=
@@ -2247,324 +1754,25 @@ by { cases x, refl }
   inclusion htu (inclusion hst x) = inclusion (hst.trans htu) x :=
 by { cases x, refl }
 
+@[simp] lemma inclusion_comp_inclusion {α} {s t u : set α} (hst : s ⊆ t) (htu : t ⊆ u) :
+  inclusion htu ∘ inclusion hst = inclusion (hst.trans htu) :=
+funext (inclusion_inclusion hst htu)
+
 @[simp] lemma coe_inclusion (h : s ⊆ t) (x : s) : (inclusion h x : α) = (x : α) := rfl
 
 lemma inclusion_injective (h : s ⊆ t) : injective (inclusion h)
 | ⟨_, _⟩ ⟨_, _⟩ := subtype.ext_iff_val.2 ∘ subtype.ext_iff_val.1
 
-@[simp] lemma range_inclusion (h : s ⊆ t) : range (inclusion h) = {x : t | (x:α) ∈ s} :=
-by { ext ⟨x, hx⟩, simp [inclusion] }
-
 lemma eq_of_inclusion_surjective {s t : set α} {h : s ⊆ t}
   (h_surj : function.surjective (inclusion h)) : s = t :=
 begin
-  rw [← range_iff_surjective, range_inclusion, eq_univ_iff_forall] at h_surj,
-  exact set.subset.antisymm h (λ x hx, h_surj ⟨x, hx⟩)
+  refine set.subset.antisymm h (λ x hx, _),
+  obtain ⟨y, hy⟩ := h_surj ⟨x, hx⟩,
+  exact mem_of_eq_of_mem (congr_arg coe hy).symm y.prop,
 end
 
 end inclusion
 
-/-! ### Injectivity and surjectivity lemmas for image and preimage -/
-section image_preimage
-variables {α : Type u} {β : Type v} {f : α → β}
-@[simp]
-lemma preimage_injective : injective (preimage f) ↔ surjective f :=
-begin
-  refine ⟨λ h y, _, surjective.preimage_injective⟩,
-  obtain ⟨x, hx⟩ : (f ⁻¹' {y}).nonempty,
-  { rw [h.nonempty_apply_iff preimage_empty], apply singleton_nonempty },
-  exact ⟨x, hx⟩
-end
-
-@[simp]
-lemma preimage_surjective : surjective (preimage f) ↔ injective f :=
-begin
-  refine ⟨λ h x x' hx, _, injective.preimage_surjective⟩,
-  cases h {x} with s hs, have := mem_singleton x,
-  rwa [← hs, mem_preimage, hx, ← mem_preimage, hs, mem_singleton_iff, eq_comm] at this
-end
-
-@[simp] lemma image_surjective : surjective (image f) ↔ surjective f :=
-begin
-  refine ⟨λ h y, _, surjective.image_surjective⟩,
-  cases h {y} with s hs,
-  have := mem_singleton y, rw [← hs] at this, rcases this with ⟨x, h1x, h2x⟩,
-  exact ⟨x, h2x⟩
-end
-
-@[simp] lemma image_injective : injective (image f) ↔ injective f :=
-begin
-  refine ⟨λ h x x' hx, _, injective.image_injective⟩,
-  rw [← singleton_eq_singleton_iff], apply h,
-  rw [image_singleton, image_singleton, hx]
-end
-
-lemma preimage_eq_iff_eq_image {f : α → β} (hf : bijective f) {s t} :
-  f ⁻¹' s = t ↔ s = f '' t :=
-by rw [← image_eq_image hf.1, hf.2.image_preimage]
-
-lemma eq_preimage_iff_image_eq {f : α → β} (hf : bijective f) {s t} :
-  s = f ⁻¹' t ↔ f '' s = t :=
-by rw [← image_eq_image hf.1, hf.2.image_preimage]
-
-end image_preimage
-
-/-!
-### Images of binary and ternary functions
-
-This section is very similar to `order.filter.n_ary`. Please keep them in sync.
--/
-
-section n_ary_image
-
-variables {α α' β β' γ γ' δ δ' ε ε' : Type*} {f f' : α → β → γ} {g g' : α → β → γ → δ}
-variables {s s' : set α} {t t' : set β} {u u' : set γ} {a a' : α} {b b' : β} {c c' : γ} {d d' : δ}
-
-
-/-- The image of a binary function `f : α → β → γ` as a function `set α → set β → set γ`.
-  Mathematically this should be thought of as the image of the corresponding function `α × β → γ`.
--/
-def image2 (f : α → β → γ) (s : set α) (t : set β) : set γ :=
-{c | ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c }
-
-lemma mem_image2_eq : c ∈ image2 f s t = ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c := rfl
-
-@[simp] lemma mem_image2 : c ∈ image2 f s t ↔ ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c := iff.rfl
-
-lemma mem_image2_of_mem (h1 : a ∈ s) (h2 : b ∈ t) : f a b ∈ image2 f s t :=
-⟨a, b, h1, h2, rfl⟩
-
-lemma mem_image2_iff (hf : injective2 f) : f a b ∈ image2 f s t ↔ a ∈ s ∧ b ∈ t :=
-⟨ by { rintro ⟨a', b', ha', hb', h⟩, rcases hf h with ⟨rfl, rfl⟩, exact ⟨ha', hb'⟩ },
-  λ ⟨ha, hb⟩, mem_image2_of_mem ha hb⟩
-
-/-- image2 is monotone with respect to `⊆`. -/
-lemma image2_subset (hs : s ⊆ s') (ht : t ⊆ t') : image2 f s t ⊆ image2 f s' t' :=
-by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_image2_of_mem (hs ha) (ht hb) }
-
-lemma image2_subset_left (ht : t ⊆ t') : image2 f s t ⊆ image2 f s t' := image2_subset subset.rfl ht
-
-lemma image2_subset_right (hs : s ⊆ s') : image2 f s t ⊆ image2 f s' t :=
-image2_subset hs subset.rfl
-
-lemma image_subset_image2_left (hb : b ∈ t) : (λ a, f a b) '' s ⊆ image2 f s t :=
-ball_image_of_ball $ λ a ha, mem_image2_of_mem ha hb
-
-lemma image_subset_image2_right (ha : a ∈ s) : f a '' t ⊆ image2 f s t :=
-ball_image_of_ball $ λ b, mem_image2_of_mem ha
-
-lemma forall_image2_iff {p : γ → Prop} :
-  (∀ z ∈ image2 f s t, p z) ↔ ∀ (x ∈ s) (y ∈ t), p (f x y) :=
-⟨λ h x hx y hy, h _ ⟨x, y, hx, hy, rfl⟩, λ h z ⟨x, y, hx, hy, hz⟩, hz ▸ h x hx y hy⟩
-
-@[simp] lemma image2_subset_iff {u : set γ} :
-  image2 f s t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), f x y ∈ u :=
-forall_image2_iff
-
-lemma image2_union_left : image2 f (s ∪ s') t = image2 f s t ∪ image2 f s' t :=
-begin
-  ext c, split,
-  { rintros ⟨a, b, h1a|h2a, hb, rfl⟩;[left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
-  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, _, ‹_›, rfl⟩; simp [mem_union, *] }
-end
-
-lemma image2_union_right : image2 f s (t ∪ t') = image2 f s t ∪ image2 f s t' :=
-begin
-  ext c, split,
-  { rintros ⟨a, b, ha, h1b|h2b, rfl⟩;[left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
-  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, ‹_›, _, rfl⟩; simp [mem_union, *] }
-end
-
-@[simp] lemma image2_empty_left : image2 f ∅ t = ∅ := ext $ by simp
-@[simp] lemma image2_empty_right : image2 f s ∅ = ∅ := ext $ by simp
-
-lemma nonempty.image2 : s.nonempty → t.nonempty → (image2 f s t).nonempty :=
-λ ⟨a, ha⟩ ⟨b, hb⟩, ⟨_, mem_image2_of_mem ha hb⟩
-
-@[simp] lemma image2_nonempty_iff : (image2 f s t).nonempty ↔ s.nonempty ∧ t.nonempty :=
-⟨λ ⟨_, a, b, ha, hb, _⟩, ⟨⟨a, ha⟩, b, hb⟩, λ h, h.1.image2 h.2⟩
-
-lemma nonempty.of_image2_left (h : (image2 f s t).nonempty) : s.nonempty :=
-(image2_nonempty_iff.1 h).1
-
-lemma nonempty.of_image2_right (h : (image2 f s t).nonempty) : t.nonempty :=
-(image2_nonempty_iff.1 h).2
-
-@[simp] lemma image2_eq_empty_iff : image2 f s t = ∅ ↔ s = ∅ ∨ t = ∅ :=
-by simp_rw [←not_nonempty_iff_eq_empty, image2_nonempty_iff, not_and_distrib]
-
-lemma image2_inter_subset_left : image2 f (s ∩ s') t ⊆ image2 f s t ∩ image2 f s' t :=
-by { rintro _ ⟨a, b, ⟨h1a, h2a⟩, hb, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
-
-lemma image2_inter_subset_right : image2 f s (t ∩ t') ⊆ image2 f s t ∩ image2 f s t' :=
-by { rintro _ ⟨a, b, ha, ⟨h1b, h2b⟩, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
-
-@[simp] lemma image2_singleton_left : image2 f {a} t = f a '' t :=
-ext $ λ x, by simp
-
-@[simp] lemma image2_singleton_right : image2 f s {b} = (λ a, f a b) '' s :=
-ext $ λ x, by simp
-
-lemma image2_singleton : image2 f {a} {b} = {f a b} := by simp
-
-@[congr] lemma image2_congr (h : ∀ (a ∈ s) (b ∈ t), f a b = f' a b) :
-  image2 f s t = image2 f' s t :=
-by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨a, b, ha, hb, by rw h a ha b hb⟩ }
-
-/-- A common special case of `image2_congr` -/
-lemma image2_congr' (h : ∀ a b, f a b = f' a b) : image2 f s t = image2 f' s t :=
-image2_congr (λ a _ b _, h a b)
-
-/-- The image of a ternary function `f : α → β → γ → δ` as a function
-  `set α → set β → set γ → set δ`. Mathematically this should be thought of as the image of the
-  corresponding function `α × β × γ → δ`.
--/
-def image3 (g : α → β → γ → δ) (s : set α) (t : set β) (u : set γ) : set δ :=
-{d | ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d }
-
-@[simp] lemma mem_image3 : d ∈ image3 g s t u ↔ ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d :=
-iff.rfl
-
-lemma image3_mono (hs : s ⊆ s') (ht : t ⊆ t') (hu : u ⊆ u') : image3 g s t u ⊆ image3 g s' t' u' :=
-λ x, Exists₃.imp $ λ a b c ⟨ha, hb, hc, hx⟩, ⟨hs ha, ht hb, hu hc, hx⟩
-
-@[congr] lemma image3_congr (h : ∀ (a ∈ s) (b ∈ t) (c ∈ u), g a b c = g' a b c) :
-  image3 g s t u = image3 g' s t u :=
-by { ext x,
-     split; rintro ⟨a, b, c, ha, hb, hc, rfl⟩; exact ⟨a, b, c, ha, hb, hc, by rw h a ha b hb c hc⟩ }
-
-/-- A common special case of `image3_congr` -/
-lemma image3_congr' (h : ∀ a b c, g a b c = g' a b c) : image3 g s t u = image3 g' s t u :=
-image3_congr (λ a _ b _ c _, h a b c)
-
-lemma image2_image2_left (f : δ → γ → ε) (g : α → β → δ) :
-  image2 f (image2 g s t) u = image3 (λ a b c, f (g a b) c) s t u :=
-begin
-  ext, split,
-  { rintro ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
-  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩ }
-end
-
-lemma image2_image2_right (f : α → δ → ε) (g : β → γ → δ) :
-  image2 f s (image2 g t u) = image3 (λ a b c, f a (g b c)) s t u :=
-begin
-  ext, split,
-  { rintro ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
-  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩ }
-end
-
-lemma image_image2 (f : α → β → γ) (g : γ → δ) :
-  g '' image2 f s t = image2 (λ a b, g (f a b)) s t :=
-begin
-  ext, split,
-  { rintro ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
-  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩ }
-end
-
-lemma image2_image_left (f : γ → β → δ) (g : α → γ) :
-  image2 f (g '' s) t = image2 (λ a b, f (g a) b) s t :=
-begin
-  ext, split,
-  { rintro ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
-  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩ }
-end
-
-lemma image2_image_right (f : α → γ → δ) (g : β → γ) :
-  image2 f s (g '' t) = image2 (λ a b, f a (g b)) s t :=
-begin
-  ext, split,
-  { rintro ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
-  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩ }
-end
-
-lemma image2_swap (f : α → β → γ) (s : set α) (t : set β) :
-  image2 f s t = image2 (λ a b, f b a) t s :=
-by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨b, a, hb, ha, rfl⟩ }
-
-@[simp] lemma image2_left (h : t.nonempty) : image2 (λ x y, x) s t = s :=
-by simp [nonempty_def.mp h, ext_iff]
-
-@[simp] lemma image2_right (h : s.nonempty) : image2 (λ x y, y) s t = t :=
-by simp [nonempty_def.mp h, ext_iff]
-
-lemma image2_assoc {f : δ → γ → ε} {g : α → β → δ} {f' : α → ε' → ε} {g' : β → γ → ε'}
-  (h_assoc : ∀ a b c, f (g a b) c = f' a (g' b c)) :
-  image2 f (image2 g s t) u = image2 f' s (image2 g' t u) :=
-by simp only [image2_image2_left, image2_image2_right, h_assoc]
-
-lemma image2_comm {g : β → α → γ} (h_comm : ∀ a b, f a b = g b a) : image2 f s t = image2 g t s :=
-(image2_swap _ _ _).trans $ by simp_rw h_comm
-
-lemma image2_left_comm {f : α → δ → ε} {g : β → γ → δ} {f' : α → γ → δ'} {g' : β → δ' → ε}
-  (h_left_comm : ∀ a b c, f a (g b c) = g' b (f' a c)) :
-  image2 f s (image2 g t u) = image2 g' t (image2 f' s u) :=
-by { rw [image2_swap f', image2_swap f], exact image2_assoc (λ _ _ _, h_left_comm _ _ _) }
-
-lemma image2_right_comm {f : δ → γ → ε} {g : α → β → δ} {f' : α → γ → δ'} {g' : δ' → β → ε}
-  (h_right_comm : ∀ a b c, f (g a b) c = g' (f' a c) b) :
-  image2 f (image2 g s t) u = image2 g' (image2 f' s u) t :=
-by { rw [image2_swap g, image2_swap g'], exact image2_assoc (λ _ _ _, h_right_comm _ _ _) }
-
-lemma image_image2_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'}
-  (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) :
-  (image2 f s t).image g = image2 f' (s.image g₁) (t.image g₂) :=
-by simp_rw [image_image2, image2_image_left, image2_image_right, h_distrib]
-
-/-- Symmetric of `set.image2_image_left_comm`. -/
-lemma image_image2_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'}
-  (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) :
-  (image2 f s t).image g = image2 f' (s.image g') t :=
-(image_image2_distrib h_distrib).trans $ by rw image_id'
-
-/-- Symmetric of `set.image_image2_right_comm`. -/
-lemma image_image2_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'}
-  (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) :
-  (image2 f s t).image g = image2 f' s (t.image g') :=
-(image_image2_distrib h_distrib).trans $ by rw image_id'
-
-/-- Symmetric of `set.image_image2_distrib_left`. -/
-lemma image2_image_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ}
-  (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) :
-  image2 f (s.image g) t = (image2 f' s t).image g' :=
-(image_image2_distrib_left $ λ a b, (h_left_comm a b).symm).symm
-
-/-- Symmetric of `set.image_image2_distrib_right`. -/
-lemma image_image2_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ}
-  (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) :
-  image2 f s (t.image g) = (image2 f' s t).image g' :=
-(image_image2_distrib_right $ λ a b, (h_right_comm a b).symm).symm
-
-lemma image_image2_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'}
-  (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) :
-  (image2 f s t).image g = image2 f' (t.image g₁) (s.image g₂) :=
-by { rw image2_swap f, exact image_image2_distrib (λ _ _, h_antidistrib _ _) }
-
-/-- Symmetric of `set.image2_image_left_anticomm`. -/
-lemma image_image2_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'}
-  (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) :
-  (image2 f s t).image g = image2 f' (t.image g') s :=
-(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
-
-/-- Symmetric of `set.image_image2_right_anticomm`. -/
-lemma image_image2_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'}
-  (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) :
-  (image2 f s t).image g = image2 f' t (s.image g') :=
-(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
-
-/-- Symmetric of `set.image_image2_antidistrib_left`. -/
-lemma image2_image_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ}
-  (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) :
-  image2 f (s.image g) t = (image2 f' t s).image g' :=
-(image_image2_antidistrib_left $ λ a b, (h_left_anticomm b a).symm).symm
-
-/-- Symmetric of `set.image_image2_antidistrib_right`. -/
-lemma image_image2_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ}
-  (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) :
-  image2 f s (t.image g) = (image2 f' t s).image g' :=
-(image_image2_antidistrib_right $ λ a b, (h_right_anticomm b a).symm).symm
-
-end n_ary_image
-
 end set
 
 namespace subsingleton
@@ -2611,3 +1819,93 @@ instance decidable_set_of (p : α → Prop) [decidable (p a)] : decidable (a ∈
 by assumption
 
 end set
+
+/-! ### Monotone lemmas for sets -/
+
+section monotone
+variables {α β : Type*}
+
+theorem monotone.inter [preorder β] {f g : β → set α}
+  (hf : monotone f) (hg : monotone g) : monotone (λ x, f x ∩ g x) :=
+hf.inf hg
+
+theorem monotone_on.inter [preorder β] {f g : β → set α} {s : set β}
+  (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (λ x, f x ∩ g x) s :=
+hf.inf hg
+
+theorem antitone.inter [preorder β] {f g : β → set α}
+  (hf : antitone f) (hg : antitone g) : antitone (λ x, f x ∩ g x) :=
+hf.inf hg
+
+theorem antitone_on.inter [preorder β] {f g : β → set α} {s : set β}
+  (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (λ x, f x ∩ g x) s :=
+hf.inf hg
+
+theorem monotone.union [preorder β] {f g : β → set α}
+  (hf : monotone f) (hg : monotone g) : monotone (λ x, f x ∪ g x) :=
+hf.sup hg
+
+theorem monotone_on.union [preorder β] {f g : β → set α} {s : set β}
+  (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (λ x, f x ∪ g x) s :=
+hf.sup hg
+
+theorem antitone.union [preorder β] {f g : β → set α}
+  (hf : antitone f) (hg : antitone g) : antitone (λ x, f x ∪ g x) :=
+hf.sup hg
+
+theorem antitone_on.union [preorder β] {f g : β → set α} {s : set β}
+  (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (λ x, f x ∪ g x) s :=
+hf.sup hg
+
+namespace set
+
+theorem monotone_set_of [preorder α] {p : α → β → Prop}
+  (hp : ∀ b, monotone (λ a, p a b)) : monotone (λ a, {b | p a b}) :=
+λ a a' h b, hp b h
+
+theorem antitone_set_of [preorder α] {p : α → β → Prop}
+  (hp : ∀ b, antitone (λ a, p a b)) : antitone (λ a, {b | p a b}) :=
+λ a a' h b, hp b h
+
+/-- Quantifying over a set is antitone in the set -/
+lemma antitone_bforall {P : α → Prop} : antitone (λ s : set α, ∀ x ∈ s, P x) :=
+λ s t hst h x hx, h x $ hst hx
+
+end set
+
+end monotone
+
+/-! ### Disjoint sets -/
+
+variables {α β : Type*} {s t u : set α} {f : α → β}
+
+namespace disjoint
+
+theorem union_left (hs : disjoint s u) (ht : disjoint t u) : disjoint (s ∪ t) u :=
+hs.sup_left ht
+
+theorem union_right (ht : disjoint s t) (hu : disjoint s u) : disjoint s (t ∪ u) :=
+ht.sup_right hu
+
+lemma inter_left (u : set α) (h : disjoint s t) : disjoint (s ∩ u) t :=
+h.inf_left u
+
+lemma inter_left' (u : set α) (h : disjoint s t) : disjoint (u ∩ s) t :=
+h.inf_left' _
+
+lemma inter_right (u : set α) (h : disjoint s t) : disjoint s (t ∩ u) :=
+h.inf_right _
+
+lemma inter_right' (u : set α) (h : disjoint s t) : disjoint s (u ∩ t) :=
+h.inf_right' _
+
+lemma subset_left_of_subset_union (h : s ⊆ t ∪ u) (hac : disjoint s u) : s ⊆ t :=
+hac.left_le_of_le_sup_right h
+
+lemma subset_right_of_subset_union (h : s ⊆ t ∪ u) (hab : disjoint s t) : s ⊆ u :=
+hab.left_le_of_le_sup_left h
+
+end disjoint
+
+@[simp] lemma Prop.compl_singleton (p : Prop) : ({p}ᶜ : set Prop) = {¬ p} :=
+ext $ λ q, by simpa [@iff.comm q] using not_iff
diff --git a/src/data/set/bool_indicator.lean b/src/data/set/bool_indicator.lean
new file mode 100644
index 0000000000000..3a7718dc53a33
--- /dev/null
+++ b/src/data/set/bool_indicator.lean
@@ -0,0 +1,57 @@
+/-
+Copyright (c) 2022 Dagur Tómas Ásgeirsson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Dagur Tómas Ásgeirsson, Leonardo de Moura
+-/
+
+import data.set.image
+
+/-!
+# Indicator function valued in bool
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+See also `set.indicator` and `set.piecewise`.
+-/
+
+open bool
+
+namespace set
+variables {α : Type*} (s : set α)
+
+/-- `bool_indicator` maps `x` to `tt` if `x ∈ s`, else to `ff` -/
+noncomputable def bool_indicator (x : α) :=
+@ite _ (x ∈ s) (classical.prop_decidable _) tt ff
+
+lemma mem_iff_bool_indicator (x : α) : x ∈ s ↔ s.bool_indicator x = tt :=
+by { unfold bool_indicator, split_ifs ; tauto }
+
+lemma not_mem_iff_bool_indicator (x : α) : x ∉ s ↔ s.bool_indicator x = ff :=
+by { unfold bool_indicator, split_ifs ; tauto }
+
+lemma preimage_bool_indicator_tt : s.bool_indicator ⁻¹' {tt} = s :=
+ext (λ x, (s.mem_iff_bool_indicator x).symm)
+
+lemma preimage_bool_indicator_ff : s.bool_indicator ⁻¹' {ff} = sᶜ :=
+ext (λ x, (s.not_mem_iff_bool_indicator x).symm)
+
+open_locale classical
+
+lemma preimage_bool_indicator_eq_union (t : set bool) :
+  s.bool_indicator ⁻¹' t = (if tt ∈ t then s else ∅) ∪ (if ff ∈ t then sᶜ else ∅) :=
+begin
+  ext x,
+  dsimp [bool_indicator],
+  split_ifs ; tauto
+end
+
+lemma preimage_bool_indicator (t : set bool) :
+  s.bool_indicator ⁻¹' t = univ ∨ s.bool_indicator ⁻¹' t = s ∨
+  s.bool_indicator ⁻¹' t = sᶜ ∨ s.bool_indicator ⁻¹' t = ∅ :=
+begin
+  simp only [preimage_bool_indicator_eq_union],
+  split_ifs ; simp [s.union_compl_self]
+end
+
+end set
diff --git a/src/data/set/constructions.lean b/src/data/set/constructions.lean
index 541baeea6c11a..2c46bacbb68d9 100644
--- a/src/data/set/constructions.lean
+++ b/src/data/set/constructions.lean
@@ -8,6 +8,9 @@ import data.finset.basic
 /-!
 # Constructions involving sets of sets.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Finite Intersections
 
 We define a structure `has_finite_inter` which asserts that a set `S` of subsets of `α` is
@@ -24,24 +27,19 @@ set of subsets of `α` which is closed under finite intersections.
 variables {α : Type*} (S : set (set α))
 
 /-- A structure encapsulating the fact that a set of sets is closed under finite intersection. -/
-structure has_finite_inter :=
+structure has_finite_inter : Prop :=
 (univ_mem : set.univ ∈ S)
 (inter_mem : ∀ ⦃s⦄, s ∈ S → ∀ ⦃t⦄, t ∈ S → s ∩ t ∈ S)
 
 namespace has_finite_inter
 
--- Satisfying the inhabited linter...
-instance : inhabited (has_finite_inter ({set.univ} : set (set α))) :=
-⟨⟨by tauto, λ _ h1 _ h2, by simp [set.mem_singleton_iff.1 h1, set.mem_singleton_iff.1 h2]⟩⟩
-
 /-- The smallest set of sets containing `S` which is closed under finite intersections. -/
 inductive finite_inter_closure : set (set α)
 | basic {s} : s ∈ S → finite_inter_closure s
 | univ : finite_inter_closure set.univ
 | inter {s t} : finite_inter_closure s → finite_inter_closure t → finite_inter_closure (s ∩ t)
 
-/-- Defines `has_finite_inter` for `finite_inter_closure S`. -/
-def finite_inter_closure_has_finite_inter : has_finite_inter (finite_inter_closure S) :=
+lemma finite_inter_closure_has_finite_inter : has_finite_inter (finite_inter_closure S) :=
 { univ_mem := finite_inter_closure.univ,
   inter_mem := λ _ h _, finite_inter_closure.inter h }
 
diff --git a/src/data/set/countable.lean b/src/data/set/countable.lean
index 593b5da0df82f..87b99ae19018d 100644
--- a/src/data/set/countable.lean
+++ b/src/data/set/countable.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 import data.set.finite
+import data.countable.basic
 import logic.equiv.list
 
 /-!
 # Countable sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 noncomputable theory
 
@@ -15,8 +19,8 @@ open function set encodable
 
 open classical (hiding some)
 open_locale classical
-universes u v w
-variables {α : Type u} {β : Type v} {γ : Type w}
+universes u v w x
+variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}
 
 namespace set
 
@@ -25,106 +29,108 @@ An encoding is an injection with a partial inverse, which can be viewed as a
 constructive analogue of countability. (For the most part, theorems about
 `countable` will be classical and `encodable` will be constructive.)
 -/
-def countable (s : set α) : Prop := nonempty (encodable s)
+protected def countable (s : set α) : Prop := nonempty (encodable s)
+
+@[simp] lemma countable_coe_iff {s : set α} : countable s ↔ s.countable :=
+encodable.nonempty_encodable.symm
+
+/-- Prove `set.countable` from a `countable` instance on the subtype. -/
+lemma to_countable (s : set α) [countable s] : s.countable := countable_coe_iff.mp ‹_›
 
-lemma countable_iff_exists_injective {s : set α} :
-  countable s ↔ ∃f:s → ℕ, injective f :=
-⟨λ ⟨h⟩, by exactI ⟨encode, encode_injective⟩,
- λ ⟨f, h⟩, ⟨⟨f, partial_inv f, partial_inv_left h⟩⟩⟩
+/-- Restate `set.countable` as a `countable` instance. -/
+alias countable_coe_iff ↔ _root_.countable.to_set countable.to_subtype
+
+protected lemma countable_iff_exists_injective {s : set α} :
+  s.countable ↔ ∃ f : s → ℕ, injective f :=
+countable_coe_iff.symm.trans (countable_iff_exists_injective s)
 
 /-- A set `s : set α` is countable if and only if there exists a function `α → ℕ` injective
 on `s`. -/
 lemma countable_iff_exists_inj_on {s : set α} :
-  countable s ↔ ∃ f : α → ℕ, inj_on f s :=
-countable_iff_exists_injective.trans
-⟨λ ⟨f, hf⟩, ⟨λ a, if h : a ∈ s then f ⟨a, h⟩ else 0,
-   λ a as b bs h, congr_arg subtype.val $
-     hf $ by simpa [as, bs] using h⟩,
- λ ⟨f, hf⟩, ⟨_, inj_on_iff_injective.1 hf⟩⟩
-
-lemma countable_iff_exists_surjective [ne : nonempty α] {s : set α} :
-  countable s ↔ ∃f:ℕ → α, s ⊆ range f :=
-⟨λ ⟨h⟩, by inhabit α; exactI ⟨λ n, ((decode s n).map subtype.val).iget,
-  λ a as, ⟨encode (⟨a, as⟩ : s), by simp [encodek]⟩⟩,
- λ ⟨f, hf⟩, ⟨⟨
-  λ x, inv_fun f x.1,
-  λ n, if h : f n ∈ s then some ⟨f n, h⟩ else none,
-  λ ⟨x, hx⟩, begin
-    have := inv_fun_eq (hf hx), dsimp at this ⊢,
-    simp [this, hx]
-  end⟩⟩⟩
+  s.countable ↔ ∃ f : α → ℕ, inj_on f s :=
+set.countable_iff_exists_injective.trans exists_inj_on_iff_injective.symm
+
+/-- Convert `set.countable s` to `encodable s` (noncomputable). -/
+protected def countable.to_encodable {s : set α} : s.countable → encodable s :=
+classical.choice
+
+section enumerate
+
+/-- Noncomputably enumerate elements in a set. The `default` value is used to extend the domain to
+all of `ℕ`. -/
+
+def enumerate_countable {s : set α} (h : s.countable) (default : α) : ℕ → α :=
+assume n, match @encodable.decode s h.to_encodable n with
+        | (some y) := y
+        | (none)   := default
+        end
+
+lemma subset_range_enumerate {s : set α} (h : s.countable) (default : α) :
+   s ⊆ range (enumerate_countable h default) :=
+assume x hx,
+⟨@encodable.encode s h.to_encodable ⟨x, hx⟩,
+by simp [enumerate_countable, encodable.encodek]⟩
+
+end enumerate
+
+lemma countable.mono {s₁ s₂ : set α} (h : s₁ ⊆ s₂) : s₂.countable → s₁.countable
+| ⟨H⟩ := ⟨@of_inj _ _ H _ (embedding_of_subset _ _ h).2⟩
+
+lemma countable_range [countable ι] (f : ι → β) : (range f).countable :=
+surjective_onto_range.countable.to_set
+
+lemma countable_iff_exists_subset_range [nonempty α] {s : set α} :
+  s.countable ↔ ∃ f : ℕ → α, s ⊆ range f :=
+⟨λ h, by { inhabit α, exact ⟨enumerate_countable h default, subset_range_enumerate _ _⟩ },
+  λ ⟨f, hsf⟩, (countable_range f).mono hsf⟩
 
 /--
 A non-empty set is countable iff there exists a surjection from the
 natural numbers onto the subtype induced by the set.
 -/
-lemma countable_iff_exists_surjective_to_subtype {s : set α} (hs : s.nonempty) :
-  countable s ↔ ∃ f : ℕ → s, surjective f :=
-have inhabited s, from ⟨classical.choice hs.to_subtype⟩,
-have countable s → ∃ f : ℕ → s, surjective f, from assume ⟨h⟩,
-  by exactI ⟨λ n, (decode s n).iget, λ a, ⟨encode a, by simp [encodek]⟩⟩,
-have (∃ f : ℕ → s, surjective f) → countable s, from assume ⟨f, fsurj⟩,
-  ⟨⟨inv_fun f, option.some ∘ f,
-    by intro h; simp [(inv_fun_eq (fsurj h) : f (inv_fun f h) = h)]⟩⟩,
-by split; assumption
-
-/-- Convert `countable s` to `encodable s` (noncomputable). -/
-def countable.to_encodable {s : set α} : countable s → encodable s :=
-classical.choice
+protected lemma countable_iff_exists_surjective {s : set α} (hs : s.nonempty) :
+  s.countable ↔ ∃ f : ℕ → s, surjective f :=
+countable_coe_iff.symm.trans $ @countable_iff_exists_surjective s hs.to_subtype
 
-lemma countable_encodable' (s : set α) [H : encodable s] : countable s :=
-⟨H⟩
+alias set.countable_iff_exists_surjective ↔ countable.exists_surjective _
 
-lemma countable_encodable [encodable α] (s : set α) : countable s :=
-⟨by apply_instance⟩
+lemma countable_univ [countable α] : (univ : set α).countable := to_countable univ
 
 /-- If `s : set α` is a nonempty countable set, then there exists a map
 `f : ℕ → α` such that `s = range f`. -/
-lemma countable.exists_surjective {s : set α} (hc : countable s) (hs : s.nonempty) :
-  ∃f:ℕ → α, s = range f :=
+lemma countable.exists_eq_range {s : set α} (hc : s.countable) (hs : s.nonempty) :
+  ∃ f : ℕ → α, s = range f :=
 begin
-  letI : encodable s := countable.to_encodable hc,
-  letI : nonempty s := hs.to_subtype,
-  have : countable (univ : set s) := countable_encodable _,
-  rcases countable_iff_exists_surjective.1 this with ⟨g, hg⟩,
-  have : range g = univ := univ_subset_iff.1 hg,
-  use coe ∘ g,
-  simp only [range_comp, this, image_univ, subtype.range_coe]
+  rcases hc.exists_surjective hs with ⟨f, hf⟩,
+  refine ⟨coe ∘ f, _⟩,
+  rw [hf.range_comp, subtype.range_coe]
 end
 
-@[simp] lemma countable_empty : countable (∅ : set α) :=
-⟨⟨λ x, x.2.elim, λ n, none, λ x, x.2.elim⟩⟩
+@[simp] lemma countable_empty : (∅ : set α).countable := to_countable _
 
-@[simp] lemma countable_singleton (a : α) : countable ({a} : set α) :=
+@[simp] lemma countable_singleton (a : α) : ({a} : set α).countable :=
 ⟨of_equiv _ (equiv.set.singleton a)⟩
 
-lemma countable.mono {s₁ s₂ : set α} (h : s₁ ⊆ s₂) : countable s₂ → countable s₁
-| ⟨H⟩ := ⟨@of_inj _ _ H _ (embedding_of_subset _ _ h).2⟩
-
-lemma countable.image {s : set α} (hs : countable s) (f : α → β) : countable (f '' s) :=
-have surjective ((maps_to_image f s).restrict _ _ _), from surjective_maps_to_image_restrict f s,
-⟨@encodable.of_inj _ _ hs.to_encodable (surj_inv this) (injective_surj_inv this)⟩
-
-lemma countable_range [encodable α] (f : α → β) : countable (range f) :=
-by rw ← image_univ; exact (countable_encodable _).image _
+lemma countable.image {s : set α} (hs : s.countable) (f : α → β) : (f '' s).countable :=
+by { rw [image_eq_range], haveI := hs.to_subtype, apply countable_range }
 
 lemma maps_to.countable_of_inj_on {s : set α} {t : set β} {f : α → β}
-  (hf : maps_to f s t) (hf' : inj_on f s) (ht : countable t) :
-  countable s :=
+  (hf : maps_to f s t) (hf' : inj_on f s) (ht : t.countable) :
+  s.countable :=
 have injective (hf.restrict f s t), from (inj_on_iff_injective.1 hf').cod_restrict _,
 ⟨@encodable.of_inj _ _ ht.to_encodable _ this⟩
 
-lemma countable.preimage_of_inj_on {s : set β} (hs : countable s) {f : α → β}
-  (hf : inj_on f (f ⁻¹' s)) : countable (f ⁻¹' s) :=
+lemma countable.preimage_of_inj_on {s : set β} (hs : s.countable) {f : α → β}
+  (hf : inj_on f (f ⁻¹' s)) : (f ⁻¹' s).countable :=
 (maps_to_preimage f s).countable_of_inj_on hf hs
 
-protected lemma countable.preimage {s : set β} (hs : countable s) {f : α → β} (hf : injective f) :
-  countable (f ⁻¹' s) :=
+protected lemma countable.preimage {s : set β} (hs : s.countable) {f : α → β} (hf : injective f) :
+  (f ⁻¹' s).countable :=
 hs.preimage_of_inj_on (hf.inj_on _)
 
 lemma exists_seq_supr_eq_top_iff_countable [complete_lattice α] {p : α → Prop} (h : ∃ x, p x) :
   (∃ s : ℕ → α, (∀ n, p (s n)) ∧ (⨆ n, s n) = ⊤) ↔
-    ∃ S : set α, countable S ∧ (∀ s ∈ S, p s) ∧ Sup S = ⊤ :=
+    ∃ S : set α, S.countable ∧ (∀ s ∈ S, p s) ∧ Sup S = ⊤ :=
 begin
   split,
   { rintro ⟨s, hps, hs⟩,
@@ -133,121 +139,103 @@ begin
     rcases eq_empty_or_nonempty S with rfl|hne,
     { rw [Sup_empty] at hS, haveI := subsingleton_of_bot_eq_top hS,
       rcases h with ⟨x, hx⟩, exact ⟨λ n, x, λ n, hx, subsingleton.elim _ _⟩ },
-    { rcases (countable_iff_exists_surjective_to_subtype hne).1 hSc with ⟨s, hs⟩,
+    { rcases (set.countable_iff_exists_surjective hne).1 hSc with ⟨s, hs⟩,
       refine ⟨λ n, s n, λ n, hps _ (s n).coe_prop, _⟩,
       rwa [hs.supr_comp, ← Sup_eq_supr'] } }
 end
 
 lemma exists_seq_cover_iff_countable {p : set α → Prop} (h : ∃ s, p s) :
   (∃ s : ℕ → set α, (∀ n, p (s n)) ∧ (⋃ n, s n) = univ) ↔
-    ∃ S : set (set α), countable S ∧ (∀ s ∈ S, p s) ∧ ⋃₀ S = univ :=
+    ∃ S : set (set α), S.countable ∧ (∀ s ∈ S, p s) ∧ ⋃₀ S = univ :=
 exists_seq_supr_eq_top_iff_countable h
 
 lemma countable_of_injective_of_countable_image {s : set α} {f : α → β}
-  (hf : inj_on f s) (hs : countable (f '' s)) : countable s :=
+  (hf : inj_on f s) (hs : (f '' s).countable) : s.countable :=
 let ⟨g, hg⟩ := countable_iff_exists_inj_on.1 hs in
 countable_iff_exists_inj_on.2 ⟨g ∘ f, hg.comp hf (maps_to_image _ _)⟩
 
-lemma countable_Union {t : α → set β} [encodable α] (ht : ∀a, countable (t a)) :
-  countable (⋃a, t a) :=
-by haveI := (λ a, (ht a).to_encodable);
-   rw Union_eq_range_sigma; apply countable_range
+lemma countable_Union {t : ι → set α} [countable ι] (ht : ∀ i, (t i).countable) :
+  (⋃ i, t i).countable :=
+by { haveI := λ a, (ht a).to_subtype, rw Union_eq_range_psigma, apply countable_range }
 
-lemma countable.bUnion
-  {s : set α} {t : Π x ∈ s, set β} (hs : countable s) (ht : ∀a∈s, countable (t a ‹_›)) :
-  countable (⋃a∈s, t a ‹_›) :=
-begin
-  rw bUnion_eq_Union,
-  haveI := hs.to_encodable,
-  exact countable_Union (by simpa using ht)
-end
+@[simp] lemma countable_Union_iff [countable ι] {t : ι → set α} :
+  (⋃ i, t i).countable ↔ ∀ i, (t i).countable :=
+⟨λ h i, h.mono $ subset_Union _ _, countable_Union⟩
 
-lemma countable.sUnion {s : set (set α)} (hs : countable s) (h : ∀a∈s, countable a) :
-  countable (⋃₀ s) :=
-by rw sUnion_eq_bUnion; exact hs.bUnion h
+lemma countable.bUnion_iff {s : set α} {t : Π a ∈ s, set β} (hs : s.countable) :
+  (⋃ a ∈ s, t a ‹_›).countable ↔ ∀ a ∈ s, (t a ‹_›).countable :=
+by { haveI := hs.to_subtype, rw [bUnion_eq_Union, countable_Union_iff, set_coe.forall'] }
 
-lemma countable_Union_Prop {p : Prop} {t : p → set β} (ht : ∀h:p, countable (t h)) :
-  countable (⋃h:p, t h) :=
-by by_cases p; simp [h, ht]
+lemma countable.sUnion_iff {s : set (set α)} (hs : s.countable) :
+  (⋃₀ s).countable ↔ ∀ a ∈ s, (a : _).countable :=
+by rw [sUnion_eq_bUnion, hs.bUnion_iff]
 
-lemma countable.union
-  {s₁ s₂ : set α} (h₁ : countable s₁) (h₂ : countable s₂) : countable (s₁ ∪ s₂) :=
-by rw union_eq_Union; exact
-countable_Union (bool.forall_bool.2 ⟨h₂, h₁⟩)
+alias countable.bUnion_iff ↔ _ countable.bUnion
+alias countable.sUnion_iff ↔ _ countable.sUnion
 
-@[simp] lemma countable_union {s t : set α} : countable (s ∪ t) ↔ countable s ∧ countable t :=
-⟨λ h, ⟨h.mono (subset_union_left s t), h.mono (subset_union_right _ _)⟩, λ h, h.1.union h.2⟩
+@[simp] lemma countable_union {s t : set α} : (s ∪ t).countable ↔ s.countable ∧ t.countable :=
+by simp [union_eq_Union, and.comm]
 
-@[simp] lemma countable_insert {s : set α} {a : α} : countable (insert a s) ↔ countable s :=
+lemma countable.union {s t : set α} (hs : s.countable) (ht : t.countable) :
+  (s ∪ t).countable :=
+countable_union.2 ⟨hs, ht⟩
+
+@[simp] lemma countable_insert {s : set α} {a : α} : (insert a s).countable ↔ s.countable :=
 by simp only [insert_eq, countable_union, countable_singleton, true_and]
 
-lemma countable.insert {s : set α} (a : α) (h : countable s) : countable (insert a s) :=
+lemma countable.insert {s : set α} (a : α) (h : s.countable) : (insert a s).countable :=
 countable_insert.2 h
 
-lemma finite.countable {s : set α} : finite s → countable s
+lemma finite.countable {s : set α} : s.finite → s.countable
 | ⟨h⟩ := trunc.nonempty (by exactI fintype.trunc_encodable s)
 
-lemma subsingleton.countable {s : set α} (hs : s.subsingleton) : countable s :=
+@[nontriviality] lemma countable.of_subsingleton [subsingleton α] (s : set α) :
+  s.countable :=
+(finite.of_subsingleton s).countable
+
+lemma subsingleton.countable {s : set α} (hs : s.subsingleton) : s.countable :=
 hs.finite.countable
 
-lemma countable_is_top (α : Type*) [partial_order α] : countable {x : α | is_top x} :=
+lemma countable_is_top (α : Type*) [partial_order α] : {x : α | is_top x}.countable :=
 (finite_is_top α).countable
 
-lemma countable_is_bot (α : Type*) [partial_order α] : countable {x : α | is_bot x} :=
+lemma countable_is_bot (α : Type*) [partial_order α] : {x : α | is_bot x}.countable :=
 (finite_is_bot α).countable
 
 /-- The set of finite subsets of a countable set is countable. -/
-lemma countable_set_of_finite_subset {s : set α} : countable s →
-  countable {t | finite t ∧ t ⊆ s} | ⟨h⟩ :=
+lemma countable_set_of_finite_subset {s : set α} : s.countable →
+  {t | set.finite t ∧ t ⊆ s}.countable | ⟨h⟩ :=
 begin
   resetI,
   refine countable.mono _ (countable_range
     (λ t : finset s, {a | ∃ h:a ∈ s, subtype.mk a h ∈ t})),
   rintro t ⟨⟨ht⟩, ts⟩, resetI,
-  refine ⟨finset.univ.map (embedding_of_subset _ _ ts),
-    set.ext $ λ a, _⟩,
-  suffices : a ∈ s ∧ a ∈ t ↔ a ∈ t, by simpa,
-  exact ⟨and.right, λ h, ⟨ts h, h⟩⟩
+  refine ⟨finset.univ.map (embedding_of_subset _ _ ts), set.ext $ λ a, _⟩,
+  simpa using @ts a
 end
 
-lemma countable_pi {π : α → Type*} [fintype α] {s : Πa, set (π a)} (hs : ∀a, countable (s a)) :
-  countable {f : Πa, π a | ∀a, f a ∈ s a} :=
-countable.mono
-  (show {f : Πa, π a | ∀a, f a ∈ s a} ⊆ range (λf : Πa, s a, λa, (f a).1), from
-    assume f hf, ⟨λa, ⟨f a, hf a⟩, funext $ assume a, rfl⟩) $
-have trunc (encodable (Π (a : α), s a)), from
-  @encodable.fintype_pi α _ _ _ (assume a, (hs a).to_encodable),
-trunc.induction_on this $ assume h,
-@countable_range _ _ h _
-
-protected lemma countable.prod {s : set α} {t : set β} (hs : countable s) (ht : countable t) :
-  countable (s ×ˢ t) :=
+lemma countable_univ_pi {π : α → Type*} [finite α] {s : Π a, set (π a)}
+  (hs : ∀ a, (s a).countable) : (pi univ s).countable :=
 begin
-  haveI : encodable s := hs.to_encodable,
-  haveI : encodable t := ht.to_encodable,
-  exact ⟨of_equiv (s × t) (equiv.set.prod _ _)⟩
+  haveI := λ a, (hs a).to_subtype,
+  exact (countable.of_equiv _ (equiv.set.univ_pi s).symm).to_set
 end
 
-lemma countable.image2 {s : set α} {t : set β} (hs : countable s) (ht : countable t)
-  (f : α → β → γ) : countable (image2 f s t) :=
-by { rw ← image_prod, exact (hs.prod ht).image _ }
-
-section enumerate
+lemma countable_pi {π : α → Type*} [finite α] {s : Πa, set (π a)} (hs : ∀a, (s a).countable) :
+  {f : Πa, π a | ∀a, f a ∈ s a}.countable :=
+by simpa only [← mem_univ_pi] using countable_univ_pi hs
 
-/-- Enumerate elements in a countable set.-/
-def enumerate_countable {s : set α} (h : countable s) (default : α) : ℕ → α :=
-assume n, match @encodable.decode s (h.to_encodable) n with
-        | (some y) := y
-        | (none)   := default
-        end
-
-lemma subset_range_enumerate {s : set α} (h : countable s) (default : α) :
-   s ⊆ range (enumerate_countable h default) :=
-assume x hx,
-⟨@encodable.encode s h.to_encodable ⟨x, hx⟩,
-by simp [enumerate_countable, encodable.encodek]⟩
+protected lemma countable.prod {s : set α} {t : set β} (hs : s.countable) (ht : t.countable) :
+  set.countable (s ×ˢ t) :=
+begin
+  haveI : countable s := hs.to_subtype,
+  haveI : countable t := ht.to_subtype,
+  exact (countable.of_equiv _ $ (equiv.set.prod _ _).symm).to_set
+end
 
-end enumerate
+lemma countable.image2 {s : set α} {t : set β} (hs : s.countable) (ht : t.countable)
+  (f : α → β → γ) : (image2 f s t).countable :=
+by { rw ← image_prod, exact (hs.prod ht).image _ }
 
 end set
 
diff --git a/src/data/set/default.lean b/src/data/set/default.lean
deleted file mode 100644
index ca6ef04fcd3cc..0000000000000
--- a/src/data/set/default.lean
+++ /dev/null
@@ -1,2 +0,0 @@
-import data.set.finite
-import data.set.intervals
diff --git a/src/data/set/enumerate.lean b/src/data/set/enumerate.lean
index a78a8b3564fd4..78fe97525dd95 100644
--- a/src/data/set/enumerate.lean
+++ b/src/data/set/enumerate.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 import data.set.lattice
+import data.nat.order.basic
 import tactic.wlog
 
 /-!
 # Set enumeration
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file allows enumeration of sets given a choice function.
 
 The definition does not assume `sel` actually is a choice function, i.e. `sel s ∈ s` and
@@ -69,6 +73,7 @@ lemma enumerate_inj {n₁ n₂ : ℕ} {a : α} {s : set α} (h_sel : ∀ s a, se
   (h₁ : enumerate s n₁ = some a) (h₂ : enumerate s n₂ = some a) : n₁ = n₂ :=
 begin
   wlog hn : n₁ ≤ n₂,
+  { cases le_total n₁ n₂ with H H; [skip, symmetry]; apply_assumption; assumption },
   { rcases nat.le.dest hn with ⟨m, rfl⟩, clear hn,
     induction n₁ generalizing s,
     case nat.zero
diff --git a/src/data/set/equitable.lean b/src/data/set/equitable.lean
index e0687fb4ba4b5..4d3d766714651 100644
--- a/src/data/set/equitable.lean
+++ b/src/data/set/equitable.lean
@@ -9,6 +9,9 @@ import data.nat.basic
 /-!
 # Equitable functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines equitable functions.
 
 A function `f` is equitable on a set `s` if `f a₁ ≤ f a₂ + 1` for all `a₁, a₂ ∈ s`. This is mostly
diff --git a/src/data/set/finite.lean b/src/data/set/finite.lean
index de6dfea7e0e91..c073dce02f496 100644
--- a/src/data/set/finite.lean
+++ b/src/data/set/finite.lean
@@ -1,378 +1,347 @@
 /-
 Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Mario Carneiro
+Authors: Johannes Hölzl, Mario Carneiro, Kyle Miller
 -/
-import data.finset.sort
+import data.finset.basic
 import data.set.functor
+import data.finite.basic
 
 /-!
 # Finite sets
 
-This file defines predicates `finite : set α → Prop` and `infinite : set α → Prop` and proves some
-basic facts about finite sets.
--/
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-open set function
+This file defines predicates for finite and infinite sets and provides
+`fintype` instances for many set constructions. It also proves basic facts
+about finite sets and gives ways to manipulate `set.finite` expressions.
 
-universes u v w x
-variables {α : Type u} {β : Type v} {ι : Sort w} {γ : Type x}
+## Main definitions
 
-namespace set
+* `set.finite : set α → Prop`
+* `set.infinite : set α → Prop`
+* `set.to_finite` to prove `set.finite` for a `set` from a `finite` instance.
+* `set.finite.to_finset` to noncomputably produce a `finset` from a `set.finite` proof.
+  (See `set.to_finset` for a computable version.)
 
-/-- A set is finite if the subtype is a fintype, i.e. there is a
-  list that enumerates its members. -/
-inductive finite (s : set α) : Prop
-| intro : fintype s → finite
+## Implementation
 
-lemma finite_def {s : set α} : finite s ↔ nonempty (fintype s) := ⟨λ ⟨h⟩, ⟨h⟩, λ ⟨h⟩, ⟨h⟩⟩
+A finite set is defined to be a set whose coercion to a type has a `fintype` instance.
+Since `set.finite` is `Prop`-valued, this is the mere fact that the `fintype` instance
+exists.
 
-/-- A set is infinite if it is not finite. -/
-def infinite (s : set α) : Prop := ¬ finite s
+There are two components to finiteness constructions. The first is `fintype` instances for each
+construction. This gives a way to actually compute a `finset` that represents the set, and these
+may be accessed using `set.to_finset`. This gets the `finset` in the correct form, since otherwise
+`finset.univ : finset s` is a `finset` for the subtype for `s`. The second component is
+"constructors" for `set.finite` that give proofs that `fintype` instances exist classically given
+other `set.finite` proofs. Unlike the `fintype` instances, these *do not* use any decidability
+instances since they do not compute anything.
 
-/-- The subtype corresponding to a finite set is a finite type. Note
-that because `finite` isn't a typeclass, this will not fire if it
-is made into an instance -/
-noncomputable def finite.fintype {s : set α} (h : finite s) : fintype s :=
-classical.choice $ finite_def.1 h
+## Tags
 
-/-- Get a finset from a finite set -/
-noncomputable def finite.to_finset {s : set α} (h : finite s) : finset α :=
-@set.to_finset _ _ h.fintype
+finite sets
+-/
 
-@[simp] lemma not_infinite {s : set α} : ¬ s.infinite ↔ s.finite :=
-by simp [infinite]
+open set function
 
-/-- See also `fintype_or_infinite`. -/
-lemma finite_or_infinite {s : set α} : s.finite ∨ s.infinite := em _
+universes u v w x
+variables {α : Type u} {β : Type v} {ι : Sort w} {γ : Type x}
 
-@[simp] theorem finite.mem_to_finset {s : set α} (h : finite s) {a : α} : a ∈ h.to_finset ↔ a ∈ s :=
-@mem_to_finset _ _ h.fintype _
+namespace set
 
-@[simp] theorem finite.to_finset.nonempty {s : set α} (h : finite s) :
-  h.to_finset.nonempty ↔ s.nonempty :=
-show (∃ x, x ∈ h.to_finset) ↔ (∃ x, x ∈ s),
-from exists_congr (λ _, h.mem_to_finset)
+/-- A set is finite if there is a `finset` with the same elements.
+This is represented as there being a `fintype` instance for the set
+coerced to a type.
 
-@[simp] lemma finite.coe_to_finset {s : set α} (h : finite s) : ↑h.to_finset = s :=
-@set.coe_to_finset _ s h.fintype
+Note: this is a custom inductive type rather than `nonempty (fintype s)`
+so that it won't be frozen as a local instance. -/
+@[protected] inductive finite (s : set α) : Prop
+| intro : fintype s → finite
 
-@[simp] lemma finite.coe_sort_to_finset {s : set α} (h : finite s) :
-  (h.to_finset : Type*) = s :=
-by rw [← finset.coe_sort_coe _, h.coe_to_finset]
+-- The `protected` attribute does not take effect within the same namespace block.
+end set
 
-@[simp] lemma finite_empty_to_finset (h : finite (∅ : set α)) : h.to_finset = ∅ :=
-by rw [← finset.coe_inj, h.coe_to_finset, finset.coe_empty]
+namespace set
 
-@[simp] lemma finite.to_finset_inj {s t : set α} {hs : finite s} {ht : finite t} :
-  hs.to_finset = ht.to_finset ↔ s = t :=
-by simp [←finset.coe_inj]
+lemma finite_def {s : set α} : s.finite ↔ nonempty (fintype s) := ⟨λ ⟨h⟩, ⟨h⟩, λ ⟨h⟩, ⟨h⟩⟩
 
-lemma subset_to_finset_iff {s : finset α} {t : set α} (ht : finite t) :
-  s ⊆ ht.to_finset ↔ ↑s ⊆ t :=
-by rw [← finset.coe_subset, ht.coe_to_finset]
+alias finite_def ↔ finite.nonempty_fintype _
 
-@[simp] lemma finite_to_finset_eq_empty_iff {s : set α} {h : finite s} :
-  h.to_finset = ∅ ↔ s = ∅ :=
-by simp [←finset.coe_inj]
+lemma finite_coe_iff {s : set α} : finite s ↔ s.finite :=
+by rw [finite_iff_nonempty_fintype, finite_def]
 
-theorem finite.exists_finset {s : set α} : finite s →
-  ∃ s' : finset α, ∀ a : α, a ∈ s' ↔ a ∈ s
-| ⟨h⟩ := by exactI ⟨to_finset s, λ _, mem_to_finset⟩
+/-- Constructor for `set.finite` using a `finite` instance. -/
+theorem to_finite (s : set α) [finite s] : s.finite :=
+finite_coe_iff.mp ‹_›
 
-theorem finite.exists_finset_coe {s : set α} (hs : finite s) :
-  ∃ s' : finset α, ↑s' = s :=
-⟨hs.to_finset, hs.coe_to_finset⟩
+/-- Construct a `finite` instance for a `set` from a `finset` with the same elements. -/
+protected lemma finite.of_finset {p : set α} (s : finset α) (H : ∀ x, x ∈ s ↔ x ∈ p) : p.finite :=
+⟨fintype.of_finset s H⟩
 
-/-- Finite sets can be lifted to finsets. -/
-instance : can_lift (set α) (finset α) :=
-{ coe := coe,
-  cond := finite,
-  prf := λ s hs, hs.exists_finset_coe }
+/-- Projection of `set.finite` to its `finite` instance.
+This is intended to be used with dot notation.
+See also `set.finite.fintype` and `set.finite.nonempty_fintype`. -/
+protected lemma finite.to_subtype {s : set α} (h : s.finite) : finite s :=
+finite_coe_iff.mpr h
 
-theorem finite_mem_finset (s : finset α) : finite {a | a ∈ s} :=
-⟨fintype.of_finset s (λ _, iff.rfl)⟩
+/-- A finite set coerced to a type is a `fintype`.
+This is the `fintype` projection for a `set.finite`.
 
-theorem finite.of_fintype [fintype α] (s : set α) : finite s :=
-by classical; exact ⟨set_fintype s⟩
+Note that because `finite` isn't a typeclass, this definition will not fire if it
+is made into an instance -/
+protected noncomputable def finite.fintype {s : set α} (h : s.finite) : fintype s :=
+h.nonempty_fintype.some
 
-theorem exists_finite_iff_finset {p : set α → Prop} :
-  (∃ s, finite s ∧ p s) ↔ ∃ s : finset α, p ↑s :=
-⟨λ ⟨s, hs, hps⟩, ⟨hs.to_finset, hs.coe_to_finset.symm ▸ hps⟩,
-  λ ⟨s, hs⟩, ⟨↑s, finite_mem_finset s, hs⟩⟩
+/-- Using choice, get the `finset` that represents this `set.` -/
+protected noncomputable def finite.to_finset {s : set α} (h : s.finite) : finset α :=
+@set.to_finset _ _ h.fintype
 
-lemma finite.fin_embedding {s : set α} (h : finite s) : ∃ (n : ℕ) (f : fin n ↪ α), range f = s :=
-⟨_, (fintype.equiv_fin (h.to_finset : set α)).symm.as_embedding, by simp⟩
+theorem finite.to_finset_eq_to_finset {s : set α} [fintype s] (h : s.finite) :
+  h.to_finset = s.to_finset :=
+by { rw [finite.to_finset], congr }
 
-lemma finite.fin_param {s : set α} (h : finite s) :
-  ∃ (n : ℕ) (f : fin n → α), injective f ∧ range f = s :=
-let ⟨n, f, hf⟩ := h.fin_embedding in ⟨n, f, f.injective, hf⟩
+@[simp]
+theorem to_finite_to_finset (s : set α) [fintype s] : s.to_finite.to_finset = s.to_finset :=
+s.to_finite.to_finset_eq_to_finset
 
-/-- Membership of a subset of a finite type is decidable.
+theorem finite.exists_finset {s : set α} (h : s.finite) :
+  ∃ s' : finset α, ∀ a : α, a ∈ s' ↔ a ∈ s :=
+by { casesI h, exact ⟨s.to_finset, λ _, mem_to_finset⟩ }
 
-Using this as an instance leads to potential loops with `subtype.fintype` under certain decidability
-assumptions, so it should only be declared a local instance. -/
-def decidable_mem_of_fintype [decidable_eq α] (s : set α) [fintype s] (a) : decidable (a ∈ s) :=
-decidable_of_iff _ mem_to_finset
+theorem finite.exists_finset_coe {s : set α} (h : s.finite) :
+  ∃ s' : finset α, ↑s' = s :=
+by { casesI h, exact ⟨s.to_finset, s.coe_to_finset⟩ }
 
-instance fintype_empty : fintype (∅ : set α) :=
-fintype.of_finset ∅ $ by simp
+/-- Finite sets can be lifted to finsets. -/
+instance : can_lift (set α) (finset α) coe set.finite :=
+{ prf := λ s hs, hs.exists_finset_coe }
 
-theorem empty_card : fintype.card (∅ : set α) = 0 := rfl
+/-- A set is infinite if it is not finite.
 
-@[simp] theorem empty_card' {h : fintype.{u} (∅ : set α)} :
-  @fintype.card (∅ : set α) h = 0 :=
-eq.trans (by congr) empty_card
+This is protected so that it does not conflict with global `infinite`. -/
+protected def infinite (s : set α) : Prop := ¬ s.finite
 
-@[simp] theorem finite_empty : @finite α ∅ := ⟨set.fintype_empty⟩
+@[simp] lemma not_infinite {s : set α} : ¬ s.infinite ↔ s.finite := not_not
 
-instance finite.inhabited : inhabited {s : set α // finite s} := ⟨⟨∅, finite_empty⟩⟩
+alias not_infinite ↔ _ finite.not_infinite
 
-/-- A `fintype` structure on `insert a s`. -/
-def fintype_insert' {a : α} (s : set α) [fintype s] (h : a ∉ s) : fintype (insert a s : set α) :=
-fintype.of_finset ⟨a ::ₘ s.to_finset.1, s.to_finset.nodup.cons (by simp [h]) ⟩ $ by simp
+attribute [simp] finite.not_infinite
 
-theorem card_fintype_insert' {a : α} (s : set α) [fintype s] (h : a ∉ s) :
-  @fintype.card _ (fintype_insert' s h) = fintype.card s + 1 :=
-by rw [fintype_insert', fintype.card_of_finset];
-   simp [finset.card, to_finset]; refl
+/-- See also `finite_or_infinite`, `fintype_or_infinite`. -/
+protected lemma finite_or_infinite (s : set α) : s.finite ∨ s.infinite := em _
+protected lemma infinite_or_finite (s : set α) : s.infinite ∨ s.finite := em' _
 
-@[simp] theorem card_insert {a : α} (s : set α)
-  [fintype s] (h : a ∉ s) {d : fintype.{u} (insert a s : set α)} :
-  @fintype.card _ d = fintype.card s + 1 :=
-by rw ← card_fintype_insert' s h; congr
+/-! ### Basic properties of `set.finite.to_finset` -/
 
-lemma card_image_of_inj_on {s : set α} [fintype s]
-  {f : α → β} [fintype (f '' s)] (H : ∀x∈s, ∀y∈s, f x = f y → x = y) :
-  fintype.card (f '' s) = fintype.card s :=
-by haveI := classical.prop_decidable; exact
-calc fintype.card (f '' s) = (s.to_finset.image f).card : fintype.card_of_finset' _ (by simp)
-... = s.to_finset.card : finset.card_image_of_inj_on
-    (λ x hx y hy hxy, H x (mem_to_finset.1 hx) y (mem_to_finset.1 hy) hxy)
-... = fintype.card s : (fintype.card_of_finset' _ (λ a, mem_to_finset)).symm
+namespace finite
+variables {s t : set α} {a : α} {hs : s.finite} {ht : t.finite}
 
-lemma card_image_of_injective (s : set α) [fintype s]
-  {f : α → β} [fintype (f '' s)] (H : function.injective f) :
-  fintype.card (f '' s) = fintype.card s :=
-card_image_of_inj_on $ λ _ _ _ _ h, H h
+@[simp] protected lemma mem_to_finset (h : s.finite) : a ∈ h.to_finset ↔ a ∈ s :=
+@mem_to_finset _ _ h.fintype _
 
-section
+@[simp] protected lemma coe_to_finset (h : s.finite) : (h.to_finset : set α) = s :=
+@coe_to_finset _ _ h.fintype
 
-local attribute [instance] decidable_mem_of_fintype
+@[simp] protected lemma to_finset_nonempty (h : s.finite) : h.to_finset.nonempty ↔ s.nonempty :=
+by rw [← finset.coe_nonempty, finite.coe_to_finset]
 
-instance fintype_insert [decidable_eq α] (a : α) (s : set α) [fintype s] :
-  fintype (insert a s : set α) :=
-if h : a ∈ s then by rwa [insert_eq, union_eq_self_of_subset_left (singleton_subset_iff.2 h)]
-else fintype_insert' _ h
+/-- Note that this is an equality of types not holding definitionally. Use wisely. -/
+lemma coe_sort_to_finset (h : s.finite) : ↥h.to_finset = ↥s :=
+by rw [← finset.coe_sort_coe _, h.coe_to_finset]
 
-end
+@[simp] protected lemma to_finset_inj : hs.to_finset = ht.to_finset ↔ s = t :=
+@to_finset_inj _ _ _ hs.fintype ht.fintype
 
-@[simp] theorem finite.insert (a : α) {s : set α} : finite s → finite (insert a s)
-| ⟨h⟩ := ⟨@set.fintype_insert _ (classical.dec_eq α) _ _ h⟩
+@[simp] lemma to_finset_subset {t : finset α} : hs.to_finset ⊆ t ↔ s ⊆ t :=
+by rw [←finset.coe_subset, finite.coe_to_finset]
 
-lemma to_finset_insert [decidable_eq α] {a : α} {s : set α} (hs : finite s) :
-  (hs.insert a).to_finset = insert a hs.to_finset :=
-finset.ext $ by simp
+@[simp] lemma to_finset_ssubset {t : finset α} : hs.to_finset ⊂ t ↔ s ⊂ t :=
+by rw [←finset.coe_ssubset, finite.coe_to_finset]
 
-@[simp] lemma insert_to_finset [decidable_eq α] {a : α} {s : set α} [fintype s] :
-  (insert a s).to_finset = insert a s.to_finset :=
-by simp [finset.ext_iff, mem_insert_iff]
+@[simp] lemma subset_to_finset {s : finset α} : s ⊆ ht.to_finset ↔ ↑s ⊆ t :=
+by rw [←finset.coe_subset, finite.coe_to_finset]
 
-@[elab_as_eliminator]
-theorem finite.induction_on {C : set α → Prop} {s : set α} (h : finite s)
-  (H0 : C ∅) (H1 : ∀ {a s}, a ∉ s → finite s → C s → C (insert a s)) : C s :=
-let ⟨t⟩ := h in by exactI
-match s.to_finset, @mem_to_finset _ s _ with
-| ⟨l, nd⟩, al := begin
-    change ∀ a, a ∈ l ↔ a ∈ s at al,
-    clear _let_match _match t h, revert s nd al,
-    refine multiset.induction_on l _ (λ a l IH, _); intros s nd al,
-    { rw show s = ∅, from eq_empty_iff_forall_not_mem.2 (by simpa using al),
-      exact H0 },
-    { rw ← show insert a {x | x ∈ l} = s, from set.ext (by simpa using al),
-      cases multiset.nodup_cons.1 nd with m nd',
-      refine H1 _ ⟨finset.subtype.fintype ⟨l, nd'⟩⟩ (IH nd' (λ _, iff.rfl)),
-      exact m }
-  end
-end
+@[simp] lemma ssubset_to_finset {s : finset α} : s ⊂ ht.to_finset ↔ ↑s ⊂ t :=
+by rw [←finset.coe_ssubset, finite.coe_to_finset]
 
-@[elab_as_eliminator]
-theorem finite.dinduction_on {C : ∀s:set α, finite s → Prop} {s : set α} (h : finite s)
-  (H0 : C ∅ finite_empty)
-  (H1 : ∀ {a s}, a ∉ s → ∀ h : finite s, C s h → C (insert a s) (h.insert a)) :
-  C s h :=
-have ∀ h : finite s, C s h,
-  from finite.induction_on h (λ h, H0) (λ a s has hs ih h, H1 has hs (ih _)),
-this h
+@[mono] protected lemma to_finset_subset_to_finset : hs.to_finset ⊆ ht.to_finset ↔ s ⊆ t :=
+by simp only [← finset.coe_subset, finite.coe_to_finset]
 
-instance fintype_singleton (a : α) : fintype ({a} : set α) :=
-unique.fintype
+@[mono] protected lemma to_finset_ssubset_to_finset : hs.to_finset ⊂ ht.to_finset ↔ s ⊂ t :=
+by simp only [← finset.coe_ssubset, finite.coe_to_finset]
 
-@[simp] theorem card_singleton (a : α) :
-  fintype.card ({a} : set α) = 1 :=
-fintype.card_of_subsingleton _
+alias finite.to_finset_subset_to_finset ↔ _ to_finset_mono
+alias finite.to_finset_ssubset_to_finset ↔ _ to_finset_strict_mono
 
-@[simp] theorem finite_singleton (a : α) : finite ({a} : set α) :=
-⟨set.fintype_singleton _⟩
+attribute [protected] to_finset_mono to_finset_strict_mono
 
-lemma subsingleton.finite {s : set α} (h : s.subsingleton) : finite s :=
-h.induction_on finite_empty finite_singleton
+@[simp] protected lemma to_finset_set_of [fintype α] (p : α → Prop) [decidable_pred p]
+  (h : {x | p x}.finite) :
+  h.to_finset = finset.univ.filter p :=
+by { ext, simp }
 
-lemma to_finset_singleton (a : α) : ({a} : set α).to_finset = {a} := rfl
+@[simp] lemma disjoint_to_finset {hs : s.finite} {ht : t.finite} :
+  disjoint hs.to_finset ht.to_finset ↔ disjoint s t :=
+@disjoint_to_finset _ _ _ hs.fintype ht.fintype
 
-lemma finite_is_top (α : Type*) [partial_order α] : finite {x : α | is_top x} :=
-(subsingleton_is_top α).finite
+protected lemma to_finset_inter [decidable_eq α] (hs : s.finite) (ht : t.finite)
+  (h : (s ∩ t).finite) : h.to_finset = hs.to_finset ∩ ht.to_finset :=
+by { ext, simp }
 
-lemma finite_is_bot (α : Type*) [partial_order α] : finite {x : α | is_bot x} :=
-(subsingleton_is_bot α).finite
+protected lemma to_finset_union [decidable_eq α] (hs : s.finite) (ht : t.finite)
+  (h : (s ∪ t).finite) : h.to_finset = hs.to_finset ∪ ht.to_finset :=
+by { ext, simp }
 
-instance fintype_pure : ∀ a : α, fintype (pure a : set α) :=
-set.fintype_singleton
+protected lemma to_finset_diff [decidable_eq α] (hs : s.finite) (ht : t.finite)
+  (h : (s \ t).finite) : h.to_finset = hs.to_finset \ ht.to_finset :=
+by { ext, simp }
 
-theorem finite_pure (a : α) : finite (pure a : set α) :=
-⟨set.fintype_pure a⟩
+protected lemma to_finset_symm_diff [decidable_eq α] (hs : s.finite) (ht : t.finite)
+  (h : (s ∆ t).finite) : h.to_finset = hs.to_finset ∆ ht.to_finset :=
+by { ext, simp [mem_symm_diff, finset.mem_symm_diff] }
 
-instance fintype_univ [fintype α] : fintype (@univ α) :=
-fintype.of_equiv α $ (equiv.set.univ α).symm
+protected lemma to_finset_compl [decidable_eq α] [fintype α] (hs : s.finite) (h : sᶜ.finite) :
+  h.to_finset = hs.to_finsetᶜ :=
+by { ext, simp }
 
-theorem finite_univ [fintype α] : finite (@univ α) := ⟨set.fintype_univ⟩
+@[simp] protected lemma to_finset_empty (h : (∅ : set α).finite) : h.to_finset = ∅ :=
+by { ext, simp }
 
-/-- If `(set.univ : set α)` is finite then `α` is a finite type. -/
-noncomputable def fintype_of_univ_finite (H : (univ : set α).finite ) :
-  fintype α :=
-@fintype.of_equiv _ (univ : set α) H.fintype (equiv.set.univ _)
+@[simp] protected lemma to_finset_univ [fintype α] (h : (set.univ : set α).finite) :
+  h.to_finset = finset.univ :=
+by { ext, simp }
 
-lemma univ_finite_iff_nonempty_fintype :
-  (univ : set α).finite ↔ nonempty (fintype α) :=
-begin
-  split,
-  { intro h, exact ⟨fintype_of_univ_finite h⟩ },
-  { rintro ⟨_i⟩, exactI finite_univ }
-end
+@[simp] protected lemma to_finset_eq_empty {h : s.finite} : h.to_finset = ∅ ↔ s = ∅ :=
+@to_finset_eq_empty _ _ h.fintype
 
-theorem infinite_univ_iff : (@univ α).infinite ↔ _root_.infinite α :=
-⟨λ h₁, ⟨λ h₂, h₁ $ @finite_univ α h₂⟩, λ ⟨h₁⟩ h₂, h₁ (fintype_of_univ_finite h₂)⟩
+@[simp] protected lemma to_finset_eq_univ [fintype α] {h : s.finite} :
+  h.to_finset = finset.univ ↔ s = univ :=
+@to_finset_eq_univ _ _ _ h.fintype
 
-theorem infinite_univ [h : _root_.infinite α] : infinite (@univ α) :=
-infinite_univ_iff.2 h
+protected lemma to_finset_image [decidable_eq β] (f : α → β) (hs : s.finite) (h : (f '' s).finite) :
+  h.to_finset = hs.to_finset.image f :=
+by { ext, simp }
 
-theorem infinite_coe_iff {s : set α} : _root_.infinite s ↔ infinite s :=
-⟨λ ⟨h₁⟩ h₂, h₁ h₂.fintype, λ h₁, ⟨λ h₂, h₁ ⟨h₂⟩⟩⟩
+@[simp] protected lemma to_finset_range [decidable_eq α] [fintype β] (f : β → α)
+  (h : (range f).finite) :
+  h.to_finset = finset.univ.image f :=
+by { ext, simp }
 
-theorem infinite.to_subtype {s : set α} (h : infinite s) : _root_.infinite s :=
-infinite_coe_iff.2 h
+end finite
 
-/-- Embedding of `ℕ` into an infinite set. -/
-noncomputable def infinite.nat_embedding (s : set α) (h : infinite s) : ℕ ↪ s :=
-by { haveI := h.to_subtype, exact infinite.nat_embedding s }
+/-! ### Fintype instances
 
-lemma infinite.exists_subset_card_eq {s : set α} (hs : infinite s) (n : ℕ) :
-  ∃ t : finset α, ↑t ⊆ s ∧ t.card = n :=
-⟨((finset.range n).map (hs.nat_embedding _)).map (embedding.subtype _), by simp⟩
+Every instance here should have a corresponding `set.finite` constructor in the next section.
+ -/
 
-lemma infinite.nonempty {s : set α} (h : s.infinite) : s.nonempty :=
-let a := infinite.nat_embedding s h 37 in ⟨a.1, a.2⟩
+section fintype_instances
 
-instance fintype_union [decidable_eq α] (s t : set α) [fintype s] [fintype t] :
-  fintype (s ∪ t : set α) :=
-fintype.of_finset (s.to_finset ∪ t.to_finset) $ by simp
+instance fintype_univ [fintype α] : fintype (@univ α) :=
+fintype.of_equiv α (equiv.set.univ α).symm
 
-theorem finite.union {s t : set α} : finite s → finite t → finite (s ∪ t)
-| ⟨hs⟩ ⟨ht⟩ := ⟨@set.fintype_union _ (classical.dec_eq α) _ _ hs ht⟩
+/-- If `(set.univ : set α)` is finite then `α` is a finite type. -/
+noncomputable def fintype_of_finite_univ (H : (univ : set α).finite) : fintype α :=
+@fintype.of_equiv _ (univ : set α) H.fintype (equiv.set.univ _)
 
-lemma finite.sup {s t : set α} : finite s → finite t → finite (s ⊔ t) := finite.union
+instance fintype_union [decidable_eq α] (s t : set α) [fintype s] [fintype t] :
+  fintype (s ∪ t : set α) := fintype.of_finset (s.to_finset ∪ t.to_finset) $ by simp
 
-lemma infinite_of_finite_compl [_root_.infinite α] {s : set α}
-  (hs : sᶜ.finite) : s.infinite :=
-λ h, set.infinite_univ (by simpa using hs.union h)
+instance fintype_sep (s : set α) (p : α → Prop) [fintype s] [decidable_pred p] :
+  fintype ({a ∈ s | p a} : set α) := fintype.of_finset (s.to_finset.filter p) $ by simp
 
-lemma finite.infinite_compl [_root_.infinite α] {s : set α}
-  (hs : s.finite) : sᶜ.infinite :=
-λ h, set.infinite_univ (by simpa using hs.union h)
+instance fintype_inter (s t : set α) [decidable_eq α] [fintype s] [fintype t] :
+  fintype (s ∩ t : set α) := fintype.of_finset (s.to_finset ∩ t.to_finset) $ by simp
 
-instance fintype_sep (s : set α) (p : α → Prop) [fintype s] [decidable_pred p] :
-  fintype ({a ∈ s | p a} : set α) :=
-fintype.of_finset (s.to_finset.filter p) $ by simp
+/-- A `fintype` instance for set intersection where the left set has a `fintype` instance. -/
+instance fintype_inter_of_left (s t : set α) [fintype s] [decidable_pred (∈ t)] :
+  fintype (s ∩ t : set α) := fintype.of_finset (s.to_finset.filter (∈ t)) $ by simp
 
-instance fintype_inter (s t : set α) [fintype s] [decidable_pred (∈ t)] : fintype (s ∩ t : set α) :=
-set.fintype_sep s t
+/-- A `fintype` instance for set intersection where the right set has a `fintype` instance. -/
+instance fintype_inter_of_right (s t : set α) [fintype t] [decidable_pred (∈ s)] :
+  fintype (s ∩ t : set α) := fintype.of_finset (t.to_finset.filter (∈ s)) $ by simp [and_comm]
 
 /-- A `fintype` structure on a set defines a `fintype` structure on its subset. -/
 def fintype_subset (s : set α) {t : set α} [fintype s] [decidable_pred (∈ t)] (h : t ⊆ s) :
   fintype t :=
-by rw ← inter_eq_self_of_subset_right h; apply_instance
-
-theorem finite.subset {s : set α} : finite s → ∀ {t : set α}, t ⊆ s → finite t
-| ⟨hs⟩ t h := ⟨@set.fintype_subset _ _ _ hs (classical.dec_pred t) h⟩
-
-@[simp] lemma finite_union {s t : set α} : finite (s ∪ t) ↔ finite s ∧ finite t :=
-⟨λ h, ⟨h.subset (subset_union_left _ _), h.subset (subset_union_right _ _)⟩,
- λ ⟨hs, ht⟩, hs.union ht⟩
-
-lemma finite.of_diff {s t : set α} (hd : finite (s \ t)) (ht : finite t) : finite s :=
-(hd.union ht).subset $ subset_diff_union _ _
-
-theorem finite.inter_of_left {s : set α} (h : finite s) (t : set α) : finite (s ∩ t) :=
-h.subset (inter_subset_left _ _)
+by { rw ← inter_eq_self_of_subset_right h, apply set.fintype_inter_of_left }
 
-theorem finite.inter_of_right {s : set α} (h : finite s) (t : set α) : finite (t ∩ s) :=
-h.subset (inter_subset_right _ _)
+instance fintype_diff [decidable_eq α] (s t : set α) [fintype s] [fintype t] :
+  fintype (s \ t : set α) := fintype.of_finset (s.to_finset \ t.to_finset) $ by simp
 
-theorem finite.inf_of_left {s : set α} (h : finite s) (t : set α) : finite (s ⊓ t) :=
-h.inter_of_left t
-
-theorem finite.inf_of_right {s : set α} (h : finite s) (t : set α) : finite (t ⊓ s) :=
-h.inter_of_right t
+instance fintype_diff_left (s t : set α) [fintype s] [decidable_pred (∈ t)] :
+  fintype (s \ t : set α) := set.fintype_sep s (∈ tᶜ)
 
-lemma finite.sInter {α : Type*} {s : set (set α)} {t : set α} (ht : t ∈ s)
-  (hf : t.finite) : (⋂₀s).finite :=
-hf.subset (sInter_subset_of_mem ht)
+instance fintype_Union [decidable_eq α] [fintype (plift ι)]
+  (f : ι → set α) [∀ i, fintype (f i)] : fintype (⋃ i, f i) :=
+fintype.of_finset (finset.univ.bUnion (λ i : plift ι, (f i.down).to_finset)) $ by simp
 
-protected theorem infinite.mono {s t : set α} (h : s ⊆ t) : infinite s → infinite t :=
-mt (λ ht, ht.subset h)
+instance fintype_sUnion [decidable_eq α] {s : set (set α)}
+  [fintype s] [H : ∀ (t : s), fintype (t : set α)] : fintype (⋃₀ s) :=
+by { rw sUnion_eq_Union, exact @set.fintype_Union _ _ _ _ _ H }
 
-lemma infinite.diff {s t : set α} (hs : s.infinite) (ht : t.finite) :
-  (s \ t).infinite :=
-λ h, hs $ h.of_diff ht
+/-- A union of sets with `fintype` structure over a set with `fintype` structure has a `fintype`
+structure. -/
+def fintype_bUnion [decidable_eq α] {ι : Type*} (s : set ι) [fintype s]
+  (t : ι → set α) (H : ∀ i ∈ s, fintype (t i)) : fintype (⋃(x ∈ s), t x) :=
+fintype.of_finset
+(s.to_finset.attach.bUnion
+  (λ x, by { haveI := H x (by simpa using x.property), exact (t x).to_finset })) $ by simp
 
-@[simp] lemma infinite_union {s t : set α} : infinite (s ∪ t) ↔ infinite s ∨ infinite t :=
-by simp only [infinite, finite_union, not_and_distrib]
+instance fintype_bUnion' [decidable_eq α] {ι : Type*} (s : set ι) [fintype s]
+  (t : ι → set α) [∀ i, fintype (t i)] : fintype (⋃(x ∈ s), t x) :=
+fintype.of_finset (s.to_finset.bUnion (λ x, (t x).to_finset)) $ by simp
 
-instance fintype_image [decidable_eq β] (s : set α) (f : α → β) [fintype s] : fintype (f '' s) :=
-fintype.of_finset (s.to_finset.image f) $ by simp
+/-- If `s : set α` is a set with `fintype` instance and `f : α → set β` is a function such that
+each `f a`, `a ∈ s`, has a `fintype` structure, then `s >>= f` has a `fintype` structure. -/
+def fintype_bind {α β} [decidable_eq β] (s : set α) [fintype s]
+  (f : α → set β) (H : ∀ a ∈ s, fintype (f a)) : fintype (s >>= f) :=
+set.fintype_bUnion s f H
 
-instance fintype_range [decidable_eq α] (f : ι → α) [fintype (plift ι)] :
-  fintype (range f) :=
-fintype.of_finset (finset.univ.image $ f ∘ plift.down) $
-  by simp [(@equiv.plift ι).exists_congr_left]
+instance fintype_bind' {α β} [decidable_eq β] (s : set α) [fintype s]
+  (f : α → set β) [H : ∀ a, fintype (f a)] : fintype (s >>= f) :=
+set.fintype_bUnion' s f
 
-theorem finite_range (f : ι → α) [fintype (plift ι)] : finite (range f) :=
-by haveI := classical.dec_eq α; exact ⟨by apply_instance⟩
+instance fintype_empty : fintype (∅ : set α) := fintype.of_finset ∅ $ by simp
 
-theorem finite.image {s : set α} (f : α → β) : finite s → finite (f '' s)
-| ⟨h⟩ := ⟨@set.fintype_image _ _ (classical.dec_eq β) _ _ h⟩
+instance fintype_singleton (a : α) : fintype ({a} : set α) := fintype.of_finset {a} $ by simp
 
-theorem infinite_of_infinite_image (f : α → β) {s : set α} (hs : (f '' s).infinite) :
-  s.infinite :=
-mt (finite.image f) hs
+instance fintype_pure : ∀ a : α, fintype (pure a : set α) :=
+set.fintype_singleton
 
-lemma finite.dependent_image {s : set α} (hs : finite s) (F : Π i ∈ s, β) :
-  finite {y : β | ∃ x (hx : x ∈ s), y = F x hx} :=
-begin
-  letI : fintype s := hs.fintype,
-  convert finite_range (λ x : s, F x x.2),
-  simp only [set_coe.exists, subtype.coe_mk, eq_comm],
-end
+/-- A `fintype` instance for inserting an element into a `set` using the
+corresponding `insert` function on `finset`. This requires `decidable_eq α`.
+There is also `set.fintype_insert'` when `a ∈ s` is decidable. -/
+instance fintype_insert (a : α) (s : set α) [decidable_eq α] [fintype s] :
+  fintype (insert a s : set α) :=
+fintype.of_finset (insert a s.to_finset) $ by simp
 
-theorem finite.of_preimage {f : α → β} {s : set β} (h : finite (f ⁻¹' s)) (hf : surjective f) :
-  finite s :=
-hf.image_preimage s ▸ h.image _
+/-- A `fintype` structure on `insert a s` when inserting a new element. -/
+def fintype_insert_of_not_mem {a : α} (s : set α) [fintype s] (h : a ∉ s) :
+  fintype (insert a s : set α) :=
+fintype.of_finset ⟨a ::ₘ s.to_finset.1, s.to_finset.nodup.cons (by simp [h]) ⟩ $ by simp
 
-instance fintype_map {α β} [decidable_eq β] :
-  ∀ (s : set α) (f : α → β) [fintype s], fintype (f <$> s) := set.fintype_image
+/-- A `fintype` structure on `insert a s` when inserting a pre-existing element. -/
+def fintype_insert_of_mem {a : α} (s : set α) [fintype s] (h : a ∈ s) :
+  fintype (insert a s : set α) :=
+fintype.of_finset s.to_finset $ by simp [h]
+
+/-- The `set.fintype_insert` instance requires decidable equality, but when `a ∈ s`
+is decidable for this particular `a` we can still get a `fintype` instance by using
+`set.fintype_insert_of_not_mem` or `set.fintype_insert_of_mem`.
+
+This instance pre-dates `set.fintype_insert`, and it is less efficient.
+When `decidable_mem_of_fintype` is made a local instance, then this instance would
+override `set.fintype_insert` if not for the fact that its priority has been
+adjusted. See Note [lower instance priority]. -/
+@[priority 100]
+instance fintype_insert' (a : α) (s : set α) [decidable $ a ∈ s] [fintype s] :
+  fintype (insert a s : set α) :=
+if h : a ∈ s then fintype_insert_of_mem s h else fintype_insert_of_not_mem s h
 
-theorem finite.map {α β} {s : set α} :
-  ∀ (f : α → β), finite s → finite (f <$> s) := finite.image
+instance fintype_image [decidable_eq β] (s : set α) (f : α → β) [fintype s] : fintype (f '' s) :=
+fintype.of_finset (s.to_finset.image f) $ by simp
 
 /-- If a function `f` has a partial inverse and sends a set `s` to a set with `[fintype]` instance,
 then `s` has a `fintype` structure as well. -/
@@ -387,243 +356,492 @@ begin
   simp [I _, (injective_of_partial_inv I).eq_iff]
 end
 
-theorem finite_of_finite_image {s : set α} {f : α → β} (hi : set.inj_on f s) :
-  finite (f '' s) → finite s | ⟨h⟩ :=
-⟨@fintype.of_injective _ _ h (λ a : s, ⟨f a.1, mem_image_of_mem f a.2⟩) $
-  λ a b eq, subtype.eq $ hi a.2 b.2 $ subtype.ext_iff_val.1 eq⟩
-
-theorem finite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
-  finite (f '' s) ↔ finite s :=
-⟨finite_of_finite_image hi, finite.image _⟩
+instance fintype_range [decidable_eq α] (f : ι → α) [fintype (plift ι)] :
+  fintype (range f) :=
+fintype.of_finset (finset.univ.image $ f ∘ plift.down) $ by simp [equiv.plift.exists_congr_left]
 
-theorem infinite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
-  infinite (f '' s) ↔ infinite s :=
-not_congr $ finite_image_iff hi
+instance fintype_map {α β} [decidable_eq β] :
+  ∀ (s : set α) (f : α → β) [fintype s], fintype (f <$> s) := set.fintype_image
 
-theorem infinite_of_inj_on_maps_to {s : set α} {t : set β} {f : α → β}
-  (hi : inj_on f s) (hm : maps_to f s t) (hs : infinite s) : infinite t :=
-((infinite_image_iff hi).2 hs).mono (maps_to'.mp hm)
+instance fintype_lt_nat (n : ℕ) : fintype {i | i < n} :=
+fintype.of_finset (finset.range n) $ by simp
 
-theorem infinite.exists_ne_map_eq_of_maps_to {s : set α} {t : set β} {f : α → β}
-  (hs : infinite s) (hf : maps_to f s t) (ht : finite t) :
-  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
-begin
-  contrapose! ht,
-  exact infinite_of_inj_on_maps_to (λ x hx y hy, not_imp_not.1 (ht x hx y hy)) hf hs
-end
+instance fintype_le_nat (n : ℕ) : fintype {i | i ≤ n} :=
+by simpa [nat.lt_succ_iff] using set.fintype_lt_nat (n+1)
 
-theorem infinite.exists_lt_map_eq_of_maps_to [linear_order α] {s : set α} {t : set β} {f : α → β}
-  (hs : infinite s) (hf : maps_to f s t) (ht : finite t) :
-  ∃ (x ∈ s) (y ∈ s), x < y ∧ f x = f y :=
-let ⟨x, hx, y, hy, hxy, hf⟩ := hs.exists_ne_map_eq_of_maps_to hf ht
-in hxy.lt_or_lt.elim (λ hxy, ⟨x, hx, y, hy, hxy, hf⟩) (λ hyx, ⟨y, hy, x, hx, hyx, hf.symm⟩)
+/-- This is not an instance so that it does not conflict with the one
+in src/order/locally_finite. -/
+def nat.fintype_Iio (n : ℕ) : fintype (Iio n) :=
+set.fintype_lt_nat n
 
-lemma finite.exists_lt_map_eq_of_range_subset [linear_order α] [_root_.infinite α] {t : set β}
-  {f : α → β} (hf : range f ⊆ t) (ht : finite t) :
-  ∃ a b, a < b ∧ f a = f b :=
-begin
-  rw [range_subset_iff, ←maps_univ_to] at hf,
-  obtain ⟨a, -, b, -, h⟩ := (@infinite_univ α _).exists_lt_map_eq_of_maps_to hf ht,
-  exact ⟨a, b, h⟩,
-end
+instance fintype_prod (s : set α) (t : set β) [fintype s] [fintype t] :
+  fintype (s ×ˢ t : set (α × β)) :=
+fintype.of_finset (s.to_finset ×ˢ t.to_finset) $ by simp
 
-theorem infinite_range_of_injective [_root_.infinite α] {f : α → β} (hi : injective f) :
-  infinite (range f) :=
-by { rw [←image_univ, infinite_image_iff (inj_on_of_injective hi _)], exact infinite_univ }
+instance fintype_off_diag [decidable_eq α] (s : set α) [fintype s] : fintype s.off_diag :=
+fintype.of_finset s.to_finset.off_diag $ by simp
 
-theorem infinite_of_injective_forall_mem [_root_.infinite α] {s : set β} {f : α → β}
-  (hi : injective f) (hf : ∀ x : α, f x ∈ s) : infinite s :=
-by { rw ←range_subset_iff at hf, exact (infinite_range_of_injective hi).mono hf }
+/-- `image2 f s t` is `fintype` if `s` and `t` are. -/
+instance fintype_image2 [decidable_eq γ] (f : α → β → γ) (s : set α) (t : set β)
+  [hs : fintype s] [ht : fintype t] : fintype (image2 f s t : set γ) :=
+by { rw ← image_prod, apply set.fintype_image }
 
-theorem finite.preimage {s : set β} {f : α → β}
-  (I : set.inj_on f (f⁻¹' s)) (h : finite s) : finite (f ⁻¹' s) :=
-finite_of_finite_image I (h.subset (image_preimage_subset f s))
+instance fintype_seq [decidable_eq β] (f : set (α → β)) (s : set α) [fintype f] [fintype s] :
+  fintype (f.seq s) :=
+by { rw seq_def, apply set.fintype_bUnion' }
 
-theorem finite.preimage_embedding {s : set β} (f : α ↪ β) (h : s.finite) : (f ⁻¹' s).finite :=
-finite.preimage (λ _ _ _ _ h', f.injective h') h
+instance fintype_seq' {α β : Type u} [decidable_eq β]
+  (f : set (α → β)) (s : set α) [fintype f] [fintype s] : fintype (f <*> s) :=
+set.fintype_seq f s
 
-lemma finite_option {s : set (option α)} : finite s ↔ finite {x : α | some x ∈ s} :=
-⟨λ h, h.preimage_embedding embedding.some,
-  λ h, ((h.image some).insert none).subset $
-    λ x, option.cases_on x (λ _, or.inl rfl) (λ x hx, or.inr $ mem_image_of_mem _ hx)⟩
+instance fintype_mem_finset (s : finset α) : fintype {a | a ∈ s} :=
+finset.fintype_coe_sort s
 
-instance fintype_Union [decidable_eq α] [fintype (plift ι)]
-  (f : ι → set α) [∀ i, fintype (f i)] : fintype (⋃ i, f i) :=
-fintype.of_finset (finset.univ.bUnion (λ i : plift ι, (f i.down).to_finset)) $ by simp
+end fintype_instances
 
-theorem finite_Union [fintype (plift ι)] {f : ι → set α} (H : ∀i, finite (f i)) :
-  finite (⋃ i, f i) :=
-⟨@set.fintype_Union _ _ (classical.dec_eq α) _ _ (λ i, finite.fintype (H i))⟩
+end set
 
-/-- A union of sets with `fintype` structure over a set with `fintype` structure has a `fintype`
-structure. -/
-def fintype_bUnion [decidable_eq α] {ι : Type*} {s : set ι} [fintype s]
-  (f : ι → set α) (H : ∀ i ∈ s, fintype (f i)) : fintype (⋃ i ∈ s, f i) :=
-by rw bUnion_eq_Union; exact
-@set.fintype_Union _ _ _ _ _ (by rintro ⟨i, hi⟩; exact H i hi)
+lemma equiv.set_finite_iff {s : set α} {t : set β} (hst : s ≃ t) :
+  s.finite ↔ t.finite :=
+by simp_rw [← set.finite_coe_iff, hst.finite_iff]
 
-instance fintype_bUnion' [decidable_eq α] {ι : Type*} {s : set ι} [fintype s]
-  (f : ι → set α) [H : ∀ i, fintype (f i)] : fintype (⋃ i ∈ s, f i) :=
-fintype_bUnion _ (λ i _, H i)
+/-! ### Finset -/
 
-theorem finite.sUnion {s : set (set α)} (h : finite s) (H : ∀t∈s, finite t) : finite (⋃₀ s) :=
-by rw sUnion_eq_Union; haveI := finite.fintype h;
-   apply finite_Union; simpa using H
+namespace finset
 
-theorem finite.bUnion {α} {ι : Type*} {s : set ι} {f : Π i ∈ s, set α} :
-  finite s → (∀ i ∈ s, finite (f i ‹_›)) → finite (⋃ i∈s, f i ‹_›)
-| ⟨hs⟩ h := by rw [bUnion_eq_Union]; exactI finite_Union (λ i, h _ _)
+/-- Gives a `set.finite` for the `finset` coerced to a `set`.
+This is a wrapper around `set.to_finite`. -/
+@[simp] lemma finite_to_set (s : finset α) : (s : set α).finite := set.to_finite _
 
-instance fintype_lt_nat (n : ℕ) : fintype {i | i < n} :=
-fintype.of_finset (finset.range n) $ by simp
+@[simp] lemma finite_to_set_to_finset (s : finset α) : s.finite_to_set.to_finset = s :=
+by { ext, rw [set.finite.mem_to_finset, mem_coe] }
 
-instance fintype_le_nat (n : ℕ) : fintype {i | i ≤ n} :=
-by simpa [nat.lt_succ_iff] using set.fintype_lt_nat (n+1)
+end finset
 
-lemma finite_le_nat (n : ℕ) : finite {i | i ≤ n} := ⟨set.fintype_le_nat _⟩
+namespace multiset
 
-lemma finite_lt_nat (n : ℕ) : finite {i | i < n} := ⟨set.fintype_lt_nat _⟩
+@[simp] lemma finite_to_set (s : multiset α) : {x | x ∈ s}.finite :=
+by { classical, simpa only [← multiset.mem_to_finset] using s.to_finset.finite_to_set }
 
-lemma infinite.exists_nat_lt {s : set ℕ} (hs : infinite s) (n : ℕ) : ∃ m ∈ s, n < m :=
-let ⟨m, hm⟩ := (hs.diff $ set.finite_le_nat n).nonempty in ⟨m, by simpa using hm⟩
+@[simp] lemma finite_to_set_to_finset [decidable_eq α] (s : multiset α) :
+  s.finite_to_set.to_finset = s.to_finset :=
+by { ext x, simp }
 
-instance fintype_prod (s : set α) (t : set β) [fintype s] [fintype t] : fintype (s ×ˢ t : set _) :=
-fintype.of_finset (s.to_finset.product t.to_finset) $ by simp
+end multiset
 
-lemma finite.prod {s : set α} {t : set β} : finite s → finite t → finite (s ×ˢ t)
-| ⟨hs⟩ ⟨ht⟩ := by exactI ⟨set.fintype_prod s t⟩
+@[simp] lemma list.finite_to_set (l : list α) : {x | x ∈ l}.finite :=
+(show multiset α, from ⟦l⟧).finite_to_set
 
-lemma finite_image_fst_and_snd_iff {s : set (α × β)} :
-  finite (prod.fst '' s) ∧ finite (prod.snd '' s) ↔ finite s :=
-⟨λ h, (h.1.prod h.2).subset $ λ x h, ⟨mem_image_of_mem _ h, mem_image_of_mem _ h⟩,
-  λ h, ⟨h.image _, h.image _⟩⟩
+/-! ### Finite instances
 
-/-- `image2 f s t` is finitype if `s` and `t` are. -/
-instance fintype_image2 [decidable_eq γ] (f : α → β → γ) (s : set α) (t : set β)
-  [hs : fintype s] [ht : fintype t] : fintype (image2 f s t : set γ) :=
-by { rw ← image_prod, apply set.fintype_image }
+There is seemingly some overlap between the following instances and the `fintype` instances
+in `data.set.finite`. While every `fintype` instance gives a `finite` instance, those
+instances that depend on `fintype` or `decidable` instances need an additional `finite` instance
+to be able to generally apply.
 
-lemma finite.image2 (f : α → β → γ) {s : set α} {t : set β} (hs : finite s) (ht : finite t) :
-  finite (image2 f s t) :=
-by { rw ← image_prod, exact (hs.prod ht).image _ }
+Some set instances do not appear here since they are consequences of others, for example
+`subtype.finite` for subsets of a finite type.
+-/
 
-/-- If `s : set α` is a set with `fintype` instance and `f : α → set β` is a function such that
-each `f a`, `a ∈ s`, has a `fintype` structure, then `s >>= f` has a `fintype` structure. -/
-def fintype_bind {α β} [decidable_eq β] (s : set α) [fintype s]
-  (f : α → set β) (H : ∀ a ∈ s, fintype (f a)) : fintype (s >>= f) :=
-set.fintype_bUnion _ H
+namespace finite.set
 
-instance fintype_bind' {α β} [decidable_eq β] (s : set α) [fintype s]
-  (f : α → set β) [H : ∀ a, fintype (f a)] : fintype (s >>= f) :=
-fintype_bind _ _ (λ i _, H i)
+open_locale classical
 
-theorem finite.bind {α β} {s : set α} {f : α → set β} (h : finite s) (hf : ∀ a ∈ s, finite (f a)) :
-  finite (s >>= f) :=
-h.bUnion hf
+example {s : set α} [finite α] : finite s := infer_instance
+example : finite (∅ : set α) := infer_instance
+example (a : α) : finite ({a} : set α) := infer_instance
 
-instance fintype_seq [decidable_eq β] (f : set (α → β)) (s : set α) [fintype f] [fintype s] :
-  fintype (f.seq s) :=
-by { rw seq_def, apply set.fintype_bUnion' }
+instance finite_union (s t : set α) [finite s] [finite t] :
+  finite (s ∪ t : set α) :=
+by { casesI nonempty_fintype s, casesI nonempty_fintype t, apply_instance }
 
-instance fintype_seq' {α β : Type u} [decidable_eq β]
-  (f : set (α → β)) (s : set α) [fintype f] [fintype s] :
-  fintype (f <*> s) :=
-set.fintype_seq f s
+instance finite_sep (s : set α) (p : α → Prop) [finite s] :
+  finite ({a ∈ s | p a} : set α) :=
+by { casesI nonempty_fintype s, apply_instance }
 
-theorem finite.seq {f : set (α → β)} {s : set α} (hf : finite f) (hs : finite s) :
-  finite (f.seq s) :=
-by { rw seq_def, exact hf.bUnion (λ f _, hs.image _) }
+protected lemma subset (s : set α) {t : set α} [finite s] (h : t ⊆ s) : finite t :=
+by { rw ←sep_eq_of_subset h, apply_instance }
 
-theorem finite.seq' {α β : Type u} {f : set (α → β)} {s : set α} (hf : finite f) (hs : finite s) :
-  finite (f <*> s) :=
-hf.seq hs
+instance finite_inter_of_right (s t : set α) [finite t] :
+  finite (s ∩ t : set α) := finite.set.subset t (inter_subset_right s t)
 
-/-- There are finitely many subsets of a given finite set -/
-lemma finite.finite_subsets {α : Type u} {a : set α} (h : finite a) : finite {b | b ⊆ a} :=
-⟨fintype.of_finset ((finset.powerset h.to_finset).map finset.coe_emb.1) $ λ s,
-  by simpa [← @exists_finite_iff_finset α (λ t, t ⊆ a ∧ t = s), subset_to_finset_iff,
-    ← and.assoc] using h.subset⟩
+instance finite_inter_of_left (s t : set α) [finite s] :
+  finite (s ∩ t : set α) := finite.set.subset s (inter_subset_left s t)
 
-lemma exists_min_image [linear_order β] (s : set α) (f : α → β) (h1 : finite s) :
-  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f a ≤ f b
-| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
-  using h1.to_finset.exists_min_image f ⟨x, h1.mem_to_finset.2 hx⟩
+instance finite_diff (s t : set α) [finite s] :
+  finite (s \ t : set α) := finite.set.subset s (diff_subset s t)
 
-lemma exists_max_image [linear_order β] (s : set α) (f : α → β) (h1 : finite s) :
-  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f b ≤ f a
-| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
-  using h1.to_finset.exists_max_image f ⟨x, h1.mem_to_finset.2 hx⟩
+instance finite_range (f : ι → α) [finite ι] : finite (range f) :=
+by { haveI := fintype.of_finite (plift ι), apply_instance }
 
-theorem exists_lower_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
-  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f a ≤ f b :=
+instance finite_Union [finite ι] (f : ι → set α) [∀ i, finite (f i)] : finite (⋃ i, f i) :=
 begin
-  by_cases hs : set.nonempty s,
-  { exact let ⟨x₀, H, hx₀⟩ := set.exists_min_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
-  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
+  rw [Union_eq_range_psigma],
+  apply set.finite_range
 end
 
-theorem exists_upper_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
-  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f b ≤ f a :=
+instance finite_sUnion {s : set (set α)} [finite s] [H : ∀ (t : s), finite (t : set α)] :
+  finite (⋃₀ s) :=
+by { rw sUnion_eq_Union, exact @finite.set.finite_Union _ _ _ _ H }
+
+lemma finite_bUnion {ι : Type*} (s : set ι) [finite s] (t : ι → set α) (H : ∀ i ∈ s, finite (t i)) :
+  finite (⋃(x ∈ s), t x) :=
 begin
-  by_cases hs : set.nonempty s,
-  { exact let ⟨x₀, H, hx₀⟩ := set.exists_max_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
-  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
+  rw [bUnion_eq_Union],
+  haveI : ∀ (i : s), finite (t i) := λ i, H i i.property,
+  apply_instance,
 end
 
-end set
+instance finite_bUnion' {ι : Type*} (s : set ι) [finite s] (t : ι → set α) [∀ i, finite (t i)] :
+  finite (⋃(x ∈ s), t x) :=
+finite_bUnion s t (λ i h, infer_instance)
 
-namespace finset
-variables [decidable_eq β]
-variables {s : finset α}
+/--
+Example: `finite (⋃ (i < n), f i)` where `f : ℕ → set α` and `[∀ i, finite (f i)]`
+(when given instances from `data.nat.interval`).
+-/
+instance finite_bUnion'' {ι : Type*} (p : ι → Prop) [h : finite {x | p x}]
+  (t : ι → set α) [∀ i, finite (t i)] :
+  finite (⋃ x (h : p x), t x) :=
+@finite.set.finite_bUnion' _ _ (set_of p) h t _
 
-lemma finite_to_set (s : finset α) : set.finite (↑s : set α) :=
-set.finite_mem_finset s
+instance finite_Inter {ι : Sort*} [nonempty ι] (t : ι → set α) [∀ i, finite (t i)] :
+  finite (⋂ i, t i) :=
+finite.set.subset (t $ classical.arbitrary ι) (Inter_subset _ _)
 
-@[simp] lemma finite_to_set_to_finset {α : Type*} (s : finset α) :
-  (finite_to_set s).to_finset = s :=
-by { ext, rw [set.finite.mem_to_finset, mem_coe] }
+instance finite_insert (a : α) (s : set α) [finite s] : finite (insert a s : set α) :=
+finite.set.finite_union {a} s
 
-end finset
+instance finite_image (s : set α) (f : α → β) [finite s] : finite (f '' s) :=
+by { casesI nonempty_fintype s, apply_instance }
 
-namespace set
+instance finite_replacement [finite α] (f : α → β) : finite {(f x) | (x : α)} :=
+finite.set.finite_range f
 
-/-- Finite product of finite sets is finite -/
-lemma finite.pi {δ : Type*} [fintype δ] {κ : δ → Type*} {t : Π d, set (κ d)}
-  (ht : ∀ d, (t d).finite) :
-  (pi univ t).finite :=
-begin
-  lift t to Π d, finset (κ d) using ht,
-  classical,
-  rw ← fintype.coe_pi_finset,
-  exact (fintype.pi_finset t).finite_to_set,
-end
+instance finite_prod (s : set α) (t : set β) [finite s] [finite t] :
+  finite (s ×ˢ t : set (α × β)) :=
+finite.of_equiv _ (equiv.set.prod s t).symm
 
-lemma forall_finite_image_eval_iff {δ : Type*} [fintype δ] {κ : δ → Type*} {s : set (Π d, κ d)} :
-  (∀ d, finite (eval d '' s)) ↔ finite s :=
-⟨λ h, (finite.pi h).subset $ subset_pi_eval_image _ _, λ h d, h.image _⟩
+instance finite_image2 (f : α → β → γ) (s : set α) (t : set β) [finite s] [finite t] :
+  finite (image2 f s t : set γ) :=
+by { rw ← image_prod, apply_instance }
 
-/-- A finite union of finsets is finite. -/
-lemma union_finset_finite_of_range_finite (f : α → finset β) (h : (range f).finite) :
-  (⋃ a, (f a : set β)).finite :=
-begin
-  rw ← bUnion_range,
-  exact h.bUnion (λ y hy, y.finite_to_set)
-end
+instance finite_seq (f : set (α → β)) (s : set α) [finite f] [finite s] : finite (f.seq s) :=
+by { rw seq_def, apply_instance }
 
-lemma finite_subset_Union {s : set α} (hs : finite s)
-  {ι} {t : ι → set α} (h : s ⊆ ⋃ i, t i) : ∃ I : set ι, finite I ∧ s ⊆ ⋃ i ∈ I, t i :=
-begin
-  casesI hs,
+end finite.set
+
+namespace set
+
+/-! ### Constructors for `set.finite`
+
+Every constructor here should have a corresponding `fintype` instance in the previous section
+(or in the `fintype` module).
+
+The implementation of these constructors ideally should be no more than `set.to_finite`,
+after possibly setting up some `fintype` and classical `decidable` instances.
+-/
+section set_finite_constructors
+
+@[nontriviality] lemma finite.of_subsingleton [subsingleton α] (s : set α) : s.finite := s.to_finite
+
+theorem finite_univ [finite α] : (@univ α).finite := set.to_finite _
+
+theorem finite_univ_iff : (@univ α).finite ↔ finite α :=
+finite_coe_iff.symm.trans (equiv.set.univ α).finite_iff
+
+alias finite_univ_iff ↔ _root_.finite.of_finite_univ _
+
+theorem finite.union {s t : set α} (hs : s.finite) (ht : t.finite) : (s ∪ t).finite :=
+by { casesI hs, casesI ht, apply to_finite }
+
+theorem finite.finite_of_compl {s : set α} (hs : s.finite) (hsc : sᶜ.finite) : finite α :=
+by { rw [← finite_univ_iff, ← union_compl_self s], exact hs.union hsc }
+
+lemma finite.sup {s t : set α} : s.finite → t.finite → (s ⊔ t).finite := finite.union
+
+theorem finite.sep {s : set α} (hs : s.finite) (p : α → Prop) : {a ∈ s | p a}.finite :=
+by { casesI hs, apply to_finite }
+
+theorem finite.inter_of_left {s : set α} (hs : s.finite) (t : set α) : (s ∩ t).finite :=
+by { casesI hs, apply to_finite }
+
+theorem finite.inter_of_right {s : set α} (hs : s.finite) (t : set α) : (t ∩ s).finite :=
+by { casesI hs, apply to_finite }
+
+theorem finite.inf_of_left {s : set α} (h : s.finite) (t : set α) : (s ⊓ t).finite :=
+h.inter_of_left t
+
+theorem finite.inf_of_right {s : set α} (h : s.finite) (t : set α) : (t ⊓ s).finite :=
+h.inter_of_right t
+
+theorem finite.subset {s : set α} (hs : s.finite) {t : set α} (ht : t ⊆ s) : t.finite :=
+by { casesI hs, haveI := finite.set.subset _ ht, apply to_finite }
+
+theorem finite.diff {s : set α} (hs : s.finite) (t : set α) : (s \ t).finite :=
+by { casesI hs, apply to_finite }
+
+theorem finite.of_diff {s t : set α} (hd : (s \ t).finite) (ht : t.finite) : s.finite :=
+(hd.union ht).subset $ subset_diff_union _ _
+
+theorem finite_Union [finite ι] {f : ι → set α} (H : ∀ i, (f i).finite) :
+  (⋃ i, f i).finite :=
+by { haveI := λ i, (H i).fintype, apply to_finite }
+
+theorem finite.sUnion {s : set (set α)} (hs : s.finite) (H : ∀ t ∈ s, set.finite t) :
+  (⋃₀ s).finite :=
+by { casesI hs, haveI := λ (i : s), (H i i.2).to_subtype, apply to_finite }
+
+theorem finite.bUnion {ι} {s : set ι} (hs : s.finite)
+  {t : ι → set α} (ht : ∀ i ∈ s, (t i).finite) : (⋃(i ∈ s), t i).finite :=
+by { classical, casesI hs,
+     haveI := fintype_bUnion s t (λ i hi, (ht i hi).fintype), apply to_finite }
+
+/-- Dependent version of `finite.bUnion`. -/
+theorem finite.bUnion' {ι} {s : set ι} (hs : s.finite)
+  {t : Π (i ∈ s), set α} (ht : ∀ i ∈ s, (t i ‹_›).finite) : (⋃(i ∈ s), t i ‹_›).finite :=
+by { casesI hs, rw [bUnion_eq_Union], apply finite_Union (λ (i : s), ht i.1 i.2), }
+
+theorem finite.sInter {α : Type*} {s : set (set α)} {t : set α} (ht : t ∈ s)
+  (hf : t.finite) : (⋂₀ s).finite :=
+hf.subset (sInter_subset_of_mem ht)
+
+/-- If sets `s i` are finite for all `i` from a finite set `t` and are empty for `i ∉ t`, then the
+union `⋃ i, s i` is a finite set. -/
+lemma finite.Union {ι : Type*} {s : ι → set α} {t : set ι} (ht : t.finite)
+  (hs : ∀ i ∈ t, (s i).finite) (he : ∀ i ∉ t, s i = ∅) :
+  (⋃ i, s i).finite :=
+begin
+  suffices : (⋃ i, s i) ⊆ (⋃ i ∈ t, s i),
+  { exact (ht.bUnion hs).subset this, },
+  refine Union_subset (λ i x hx, _),
+  by_cases hi : i ∈ t,
+  { exact mem_bUnion hi hx },
+  { rw [he i hi, mem_empty_iff_false] at hx,
+    contradiction, },
+end
+
+theorem finite.bind {α β} {s : set α} {f : α → set β} (h : s.finite) (hf : ∀ a ∈ s, (f a).finite) :
+  (s >>= f).finite :=
+h.bUnion hf
+
+@[simp] theorem finite_empty : (∅ : set α).finite := to_finite _
+
+protected lemma infinite.nonempty {s : set α} (h : s.infinite) : s.nonempty :=
+nonempty_iff_ne_empty.2 $ by { rintro rfl, exact h finite_empty }
+
+@[simp] theorem finite_singleton (a : α) : ({a} : set α).finite := to_finite _
+
+theorem finite_pure (a : α) : (pure a : set α).finite := to_finite _
+
+@[simp] theorem finite.insert (a : α) {s : set α} (hs : s.finite) : (insert a s).finite :=
+by { casesI hs, apply to_finite }
+
+theorem finite.image {s : set α} (f : α → β) (hs : s.finite) : (f '' s).finite :=
+by { casesI hs, apply to_finite }
+
+theorem finite_range (f : ι → α) [finite ι] : (range f).finite :=
+to_finite _
+
+lemma finite.dependent_image {s : set α} (hs : s.finite) (F : Π i ∈ s, β) :
+  {y : β | ∃ x (hx : x ∈ s), y = F x hx}.finite :=
+by { casesI hs, simpa [range, eq_comm] using finite_range (λ x : s, F x x.2) }
+
+theorem finite.map {α β} {s : set α} : ∀ (f : α → β), s.finite → (f <$> s).finite :=
+finite.image
+
+theorem finite.of_finite_image {s : set α} {f : α → β} (h : (f '' s).finite) (hi : set.inj_on f s) :
+  s.finite :=
+by { casesI h, exact ⟨fintype.of_injective (λ a, (⟨f a.1, mem_image_of_mem f a.2⟩ : f '' s))
+                       (λ a b eq, subtype.eq $ hi a.2 b.2 $ subtype.ext_iff_val.1 eq)⟩ }
+
+lemma finite_of_finite_preimage {f : α → β} {s : set β} (h : (f ⁻¹' s).finite)
+  (hs : s ⊆ range f) : s.finite :=
+by { rw [← image_preimage_eq_of_subset hs], exact finite.image f h }
+
+theorem finite.of_preimage {f : α → β} {s : set β} (h : (f ⁻¹' s).finite) (hf : surjective f) :
+  s.finite :=
+hf.image_preimage s ▸ h.image _
+
+theorem finite.preimage {s : set β} {f : α → β}
+  (I : set.inj_on f (f⁻¹' s)) (h : s.finite) : (f ⁻¹' s).finite :=
+(h.subset (image_preimage_subset f s)).of_finite_image I
+
+theorem finite.preimage_embedding {s : set β} (f : α ↪ β) (h : s.finite) : (f ⁻¹' s).finite :=
+h.preimage (λ _ _ _ _ h', f.injective h')
+
+lemma finite_lt_nat (n : ℕ) : set.finite {i | i < n} := to_finite _
+
+lemma finite_le_nat (n : ℕ) : set.finite {i | i ≤ n} := to_finite _
+
+section prod
+variables {s : set α} {t : set β}
+
+protected lemma finite.prod (hs : s.finite) (ht : t.finite) : (s ×ˢ t : set (α × β)).finite :=
+by { casesI hs, casesI ht, apply to_finite }
+
+lemma finite.of_prod_left (h : (s ×ˢ t : set (α × β)).finite) : t.nonempty → s.finite :=
+λ ⟨b, hb⟩, (h.image prod.fst).subset $ λ a ha, ⟨(a, b), ⟨ha, hb⟩, rfl⟩
+
+lemma finite.of_prod_right (h : (s ×ˢ t : set (α × β)).finite) : s.nonempty → t.finite :=
+λ ⟨a, ha⟩, (h.image prod.snd).subset $ λ b hb, ⟨(a, b), ⟨ha, hb⟩, rfl⟩
+
+protected lemma infinite.prod_left (hs : s.infinite) (ht : t.nonempty) : (s ×ˢ t).infinite :=
+λ h, hs $ h.of_prod_left ht
+
+protected lemma infinite.prod_right (ht : t.infinite) (hs : s.nonempty) : (s ×ˢ t).infinite :=
+λ h, ht $ h.of_prod_right hs
+
+protected lemma infinite_prod :
+  (s ×ˢ t).infinite ↔ s.infinite ∧ t.nonempty ∨ t.infinite ∧ s.nonempty :=
+begin
+  refine ⟨λ h, _, _⟩,
+  { simp_rw [set.infinite, and_comm (¬ _), ←not_imp],
+    by_contra',
+    exact h ((this.1 h.nonempty.snd).prod $ this.2 h.nonempty.fst) },
+  { rintro (h | h),
+    { exact h.1.prod_left h.2 },
+    { exact h.1.prod_right h.2 } }
+end
+
+lemma finite_prod : (s ×ˢ t).finite ↔ (s.finite ∨ t = ∅) ∧ (t.finite ∨ s = ∅) :=
+by simp only [←not_infinite, set.infinite_prod, not_or_distrib, not_and_distrib,
+  not_nonempty_iff_eq_empty]
+
+protected lemma finite.off_diag (hs : s.finite) : s.off_diag.finite :=
+by { classical, casesI hs, apply set.to_finite }
+
+protected lemma finite.image2 (f : α → β → γ) (hs : s.finite) (ht : t.finite) :
+  (image2 f s t).finite :=
+by { casesI hs, casesI ht, apply to_finite }
+
+end prod
+
+theorem finite.seq {f : set (α → β)} {s : set α} (hf : f.finite) (hs : s.finite) :
+  (f.seq s).finite :=
+by { classical, casesI hf, casesI hs, apply to_finite }
+
+theorem finite.seq' {α β : Type u} {f : set (α → β)} {s : set α} (hf : f.finite) (hs : s.finite) :
+  (f <*> s).finite :=
+hf.seq hs
+
+theorem finite_mem_finset (s : finset α) : {a | a ∈ s}.finite := to_finite _
+
+lemma subsingleton.finite {s : set α} (h : s.subsingleton) : s.finite :=
+h.induction_on finite_empty finite_singleton
+
+lemma finite_preimage_inl_and_inr {s : set (α ⊕ β)} :
+  (sum.inl ⁻¹' s).finite ∧ (sum.inr ⁻¹' s).finite ↔ s.finite :=
+⟨λ h, image_preimage_inl_union_image_preimage_inr s ▸ (h.1.image _).union (h.2.image _),
+  λ h, ⟨h.preimage (sum.inl_injective.inj_on _), h.preimage (sum.inr_injective.inj_on _)⟩⟩
+
+theorem exists_finite_iff_finset {p : set α → Prop} :
+  (∃ s : set α, s.finite ∧ p s) ↔ ∃ s : finset α, p ↑s :=
+⟨λ ⟨s, hs, hps⟩, ⟨hs.to_finset, hs.coe_to_finset.symm ▸ hps⟩,
+  λ ⟨s, hs⟩, ⟨s, s.finite_to_set, hs⟩⟩
+
+/-- There are finitely many subsets of a given finite set -/
+lemma finite.finite_subsets {α : Type u} {a : set α} (h : a.finite) : {b | b ⊆ a}.finite :=
+⟨fintype.of_finset ((finset.powerset h.to_finset).map finset.coe_emb.1) $ λ s,
+  by simpa [← @exists_finite_iff_finset α (λ t, t ⊆ a ∧ t = s), finite.subset_to_finset,
+    ← and.assoc] using h.subset⟩
+
+/-- Finite product of finite sets is finite -/
+lemma finite.pi {δ : Type*} [finite δ] {κ : δ → Type*} {t : Π d, set (κ d)}
+  (ht : ∀ d, (t d).finite) :
+  (pi univ t).finite :=
+begin
+  casesI nonempty_fintype δ,
+  lift t to Π d, finset (κ d) using ht,
+  classical,
+  rw ← fintype.coe_pi_finset,
+  apply finset.finite_to_set
+end
+
+/-- A finite union of finsets is finite. -/
+lemma union_finset_finite_of_range_finite (f : α → finset β) (h : (range f).finite) :
+  (⋃ a, (f a : set β)).finite :=
+by { rw ← bUnion_range, exact h.bUnion (λ y hy, y.finite_to_set) }
+
+lemma finite_range_ite {p : α → Prop} [decidable_pred p] {f g : α → β} (hf : (range f).finite)
+  (hg : (range g).finite) : (range (λ x, if p x then f x else g x)).finite :=
+(hf.union hg).subset range_ite_subset
+
+lemma finite_range_const {c : β} : (range (λ x : α, c)).finite :=
+(finite_singleton c).subset range_const_subset
+
+end set_finite_constructors
+
+/-! ### Properties -/
+
+instance finite.inhabited : inhabited {s : set α // s.finite} := ⟨⟨∅, finite_empty⟩⟩
+
+@[simp] lemma finite_union {s t : set α} : (s ∪ t).finite ↔ s.finite ∧ t.finite :=
+⟨λ h, ⟨h.subset (subset_union_left _ _), h.subset (subset_union_right _ _)⟩,
+ λ ⟨hs, ht⟩, hs.union ht⟩
+
+theorem finite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
+  (f '' s).finite ↔ s.finite :=
+⟨λ h, h.of_finite_image hi, finite.image _⟩
+
+lemma univ_finite_iff_nonempty_fintype :
+  (univ : set α).finite ↔ nonempty (fintype α) :=
+⟨λ h, ⟨fintype_of_finite_univ h⟩, λ ⟨_i⟩, by exactI finite_univ⟩
+
+@[simp] lemma finite.to_finset_singleton {a : α} (ha : ({a} : set α).finite := finite_singleton _) :
+  ha.to_finset = {a} :=
+finset.ext $ by simp
+
+@[simp] lemma finite.to_finset_insert [decidable_eq α] {s : set α} {a : α}
+  (hs : (insert a s).finite) :
+  hs.to_finset = insert a (hs.subset $ subset_insert _ _).to_finset :=
+finset.ext $ by simp
+
+lemma finite.to_finset_insert' [decidable_eq α] {a : α} {s : set α} (hs : s.finite) :
+  (hs.insert a).to_finset = insert a hs.to_finset :=
+finite.to_finset_insert _
+
+lemma finite.to_finset_prod {s : set α} {t : set β} (hs : s.finite) (ht : t.finite) :
+hs.to_finset ×ˢ ht.to_finset = (hs.prod ht).to_finset := finset.ext $ by simp
+
+lemma finite.to_finset_off_diag {s : set α} [decidable_eq α] (hs : s.finite) :
+hs.off_diag.to_finset = hs.to_finset.off_diag := finset.ext $ by simp
+
+lemma finite.fin_embedding {s : set α} (h : s.finite) : ∃ (n : ℕ) (f : fin n ↪ α), range f = s :=
+⟨_, (fintype.equiv_fin (h.to_finset : set α)).symm.as_embedding, by simp⟩
+
+lemma finite.fin_param {s : set α} (h : s.finite) :
+  ∃ (n : ℕ) (f : fin n → α), injective f ∧ range f = s :=
+let ⟨n, f, hf⟩ := h.fin_embedding in ⟨n, f, f.injective, hf⟩
+
+lemma finite_option {s : set (option α)} : s.finite ↔ {x : α | some x ∈ s}.finite :=
+⟨λ h, h.preimage_embedding embedding.some,
+  λ h, ((h.image some).insert none).subset $
+    λ x, option.cases_on x (λ _, or.inl rfl) (λ x hx, or.inr $ mem_image_of_mem _ hx)⟩
+
+lemma finite_image_fst_and_snd_iff {s : set (α × β)} :
+  (prod.fst '' s).finite ∧ (prod.snd '' s).finite ↔ s.finite :=
+⟨λ h, (h.1.prod h.2).subset $ λ x h, ⟨mem_image_of_mem _ h, mem_image_of_mem _ h⟩,
+  λ h, ⟨h.image _, h.image _⟩⟩
+
+lemma forall_finite_image_eval_iff {δ : Type*} [finite δ] {κ : δ → Type*} {s : set (Π d, κ d)} :
+  (∀ d, (eval d '' s).finite) ↔ s.finite :=
+⟨λ h, (finite.pi h).subset $ subset_pi_eval_image _ _, λ h d, h.image _⟩
+
+lemma finite_subset_Union {s : set α} (hs : s.finite)
+  {ι} {t : ι → set α} (h : s ⊆ ⋃ i, t i) : ∃ I : set ι, I.finite ∧ s ⊆ ⋃ i ∈ I, t i :=
+begin
+  casesI hs,
   choose f hf using show ∀ x : s, ∃ i, x.1 ∈ t i, {simpa [subset_def] using h},
   refine ⟨range f, finite_range f, λ x hx, _⟩,
   rw [bUnion_range, mem_Union],
   exact ⟨⟨x, hx⟩, hf _⟩
 end
 
-lemma eq_finite_Union_of_finite_subset_Union  {ι} {s : ι → set α} {t : set α} (tfin : finite t)
+lemma eq_finite_Union_of_finite_subset_Union  {ι} {s : ι → set α} {t : set α} (tfin : t.finite)
   (h : t ⊆ ⋃ i, s i) :
-  ∃ I : set ι, (finite I) ∧ ∃ σ : {i | i ∈ I} → set α,
-     (∀ i, finite (σ i)) ∧ (∀ i, σ i ⊆ s i) ∧ t = ⋃ i, σ i :=
+  ∃ I : set ι, I.finite ∧ ∃ σ : {i | i ∈ I} → set α,
+     (∀ i, (σ i).finite) ∧ (∀ i, σ i ⊆ s i) ∧ t = ⋃ i, σ i :=
 let ⟨I, Ifin, hI⟩ := finite_subset_Union tfin h in
 ⟨I, Ifin, λ x, s x ∩ t,
     λ i, tfin.subset (inter_subset_right _ _),
@@ -639,35 +857,39 @@ let ⟨I, Ifin, hI⟩ := finite_subset_Union tfin h in
         exact H }
     end⟩
 
-/-- An increasing union distributes over finite intersection. -/
-lemma Union_Inter_of_monotone {ι ι' α : Type*} [fintype ι] [linear_order ι']
-  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, monotone (s i)) :
-  (⋃ j : ι', ⋂ i : ι, s i j) = ⋂ i : ι, ⋃ j : ι', s i j :=
+@[elab_as_eliminator]
+theorem finite.induction_on {C : set α → Prop} {s : set α} (h : s.finite)
+  (H0 : C ∅) (H1 : ∀ {a s}, a ∉ s → set.finite s → C s → C (insert a s)) : C s :=
 begin
-  ext x, refine ⟨λ hx, Union_Inter_subset hx, λ hx, _⟩,
-  simp only [mem_Inter, mem_Union, mem_Inter] at hx ⊢, choose j hj using hx,
-  obtain ⟨j₀⟩ := show nonempty ι', by apply_instance,
-  refine ⟨finset.univ.fold max j₀ j, λ i, hs i _ (hj i)⟩,
-  rw [finset.fold_op_rel_iff_or (@le_max_iff _ _)],
-  exact or.inr ⟨i, finset.mem_univ i, le_rfl⟩
+  lift s to finset α using h,
+  induction s using finset.cons_induction_on with a s ha hs,
+  { rwa [finset.coe_empty] },
+  { rw [finset.coe_cons],
+    exact @H1 a s ha (set.to_finite _) hs }
 end
 
-lemma Union_pi_of_monotone {ι ι' : Type*} [linear_order ι'] [nonempty ι'] {α : ι → Type*}
-  {I : set ι} {s : Π i, ι' → set (α i)} (hI : finite I) (hs : ∀ i ∈ I, monotone (s i)) :
-  (⋃ j : ι', I.pi (λ i, s i j)) = I.pi (λ i, ⋃ j, s i j) :=
+/-- Analogous to `finset.induction_on'`. -/
+@[elab_as_eliminator]
+theorem finite.induction_on' {C : set α → Prop} {S : set α} (h : S.finite)
+  (H0 : C ∅) (H1 : ∀ {a s}, a ∈ S → s ⊆ S → a ∉ s → C s → C (insert a s)) : C S :=
 begin
-  simp only [pi_def, bInter_eq_Inter, preimage_Union],
-  haveI := hI.fintype,
-  exact Union_Inter_of_monotone (λ i j₁ j₂ h, preimage_mono $ hs i i.2 h)
+  refine @set.finite.induction_on α (λ s, s ⊆ S → C s) S h (λ _, H0) _ subset.rfl,
+  intros a s has hsf hCs haS,
+  rw insert_subset at haS,
+  exact H1 haS.1 haS.2 has (hCs haS.2)
 end
 
-lemma Union_univ_pi_of_monotone {ι ι' : Type*} [linear_order ι'] [nonempty ι'] [fintype ι]
-  {α : ι → Type*} {s : Π i, ι' → set (α i)} (hs : ∀ i, monotone (s i)) :
-  (⋃ j : ι', pi univ (λ i, s i j)) = pi univ (λ i, ⋃ j, s i j) :=
-Union_pi_of_monotone (finite.of_fintype _) (λ i _, hs i)
+@[elab_as_eliminator]
+theorem finite.dinduction_on {C : ∀ (s : set α), s.finite → Prop} {s : set α} (h : s.finite)
+  (H0 : C ∅ finite_empty)
+  (H1 : ∀ {a s}, a ∉ s → ∀ h : set.finite s, C s h → C (insert a s) (h.insert a)) :
+  C s h :=
+have ∀ h : s.finite, C s h,
+  from finite.induction_on h (λ h, H0) (λ a s has hs ih h, H1 has hs (ih _)),
+this h
 
-instance nat.fintype_Iio (n : ℕ) : fintype (Iio n) :=
-fintype.of_finset (finset.range n) $ by simp
+section
+local attribute [instance] nat.fintype_Iio
 
 /--
 If `P` is some relation between terms of `γ` and sets in `γ`,
@@ -679,7 +901,7 @@ so `u n` is related to the image of `{0, 1, ..., n-1}` under `u`.
 are totally bounded.)
 -/
 lemma seq_of_forall_finite_exists  {γ : Type*}
-  {P : γ → set γ → Prop} (h : ∀ t,  finite t → ∃ c, P c t) :
+  {P : γ → set γ → Prop} (h : ∀ t : set γ, t.finite → ∃ c, P c t) :
   ∃ u : ℕ → γ, ∀ n, P (u n) (u '' Iio n) :=
 ⟨λ n, @nat.strong_rec_on' (λ _, γ) n $ λ n ih, classical.some $ h
     (range $ λ m : Iio n, ih m.1 m.2)
@@ -693,20 +915,42 @@ lemma seq_of_forall_finite_exists  {γ : Type*}
   { rintros ⟨⟨m, hmn⟩, rfl⟩, exact ⟨m, hmn, rfl⟩ }
 end⟩
 
-lemma finite_range_ite {p : α → Prop} [decidable_pred p] {f g : α → β} (hf : finite (range f))
-  (hg : finite (range g)) : finite (range (λ x, if p x then f x else g x)) :=
-(hf.union hg).subset range_ite_subset
+end
 
-lemma finite_range_const {c : β} : finite (range (λ x : α, c)) :=
-(finite_singleton c).subset range_const_subset
+/-! ### Cardinality -/
 
-lemma range_find_greatest_subset {P : α → ℕ → Prop} [∀ x, decidable_pred (P x)] {b : ℕ}:
-  range (λ x, nat.find_greatest (P x) b) ⊆ ↑(finset.range (b + 1)) :=
-by { rw range_subset_iff, intro x, simp [nat.lt_succ_iff, nat.find_greatest_le] }
+theorem empty_card : fintype.card (∅ : set α) = 0 := rfl
 
-lemma finite_range_find_greatest {P : α → ℕ → Prop} [∀ x, decidable_pred (P x)] {b : ℕ} :
-  finite (range (λ x, nat.find_greatest (P x) b)) :=
-(finset.range (b + 1)).finite_to_set.subset range_find_greatest_subset
+@[simp] theorem empty_card' {h : fintype.{u} (∅ : set α)} :
+  @fintype.card (∅ : set α) h = 0 :=
+eq.trans (by congr) empty_card
+
+theorem card_fintype_insert_of_not_mem {a : α} (s : set α) [fintype s] (h : a ∉ s) :
+  @fintype.card _ (fintype_insert_of_not_mem s h) = fintype.card s + 1 :=
+by simp [fintype_insert_of_not_mem, fintype.card_of_finset]
+
+@[simp] theorem card_insert {a : α} (s : set α)
+  [fintype s] (h : a ∉ s) {d : fintype.{u} (insert a s : set α)} :
+  @fintype.card _ d = fintype.card s + 1 :=
+by rw ← card_fintype_insert_of_not_mem s h; congr
+
+lemma card_image_of_inj_on {s : set α} [fintype s]
+  {f : α → β} [fintype (f '' s)] (H : ∀x∈s, ∀y∈s, f x = f y → x = y) :
+  fintype.card (f '' s) = fintype.card s :=
+by haveI := classical.prop_decidable; exact
+calc fintype.card (f '' s) = (s.to_finset.image f).card : fintype.card_of_finset' _ (by simp)
+... = s.to_finset.card : finset.card_image_of_inj_on
+    (λ x hx y hy hxy, H x (mem_to_finset.1 hx) y (mem_to_finset.1 hy) hxy)
+... = fintype.card s : (fintype.card_of_finset' _ (λ a, mem_to_finset)).symm
+
+lemma card_image_of_injective (s : set α) [fintype s]
+  {f : α → β} [fintype (f '' s)] (H : function.injective f) :
+  fintype.card (f '' s) = fintype.card s :=
+card_image_of_inj_on $ λ _ _ _ _ h, H h
+
+@[simp] theorem card_singleton (a : α) :
+  fintype.card ({a} : set α) = 1 :=
+fintype.card_of_subsingleton _
 
 lemma card_lt_card {s t : set α} [fintype s] [fintype t] (h : s ⊂ t) :
   fintype.card s < fintype.card t :=
@@ -722,142 +966,349 @@ lemma eq_of_subset_of_card_le {s t : set α} [fintype s] [fintype t]
 (eq_or_ssubset_of_subset hsub).elim id
   (λ h, absurd hcard $ not_le_of_lt $ card_lt_card h)
 
-lemma subset_iff_to_finset_subset (s t : set α) [fintype s] [fintype t] :
-  s ⊆ t ↔ s.to_finset ⊆ t.to_finset :=
-by simp
+lemma card_range_of_injective [fintype α] {f : α → β} (hf : injective f)
+  [fintype (range f)] : fintype.card (range f) = fintype.card α :=
+eq.symm $ fintype.card_congr $ equiv.of_injective f hf
 
-@[simp, mono] lemma finite.to_finset_mono {s t : set α} {hs : finite s} {ht : finite t} :
-  hs.to_finset ⊆ ht.to_finset ↔ s ⊆ t :=
+lemma finite.card_to_finset {s : set α} [fintype s] (h : s.finite) :
+  h.to_finset.card = fintype.card s :=
 begin
-  split,
-  { intros h x,
-    rw [←finite.mem_to_finset hs, ←finite.mem_to_finset ht],
-    exact λ hx, h hx },
-  { intros h x,
-    rw [finite.mem_to_finset hs, finite.mem_to_finset ht],
-    exact λ hx, h hx }
+  rw [← finset.card_attach, finset.attach_eq_univ, ← fintype.card],
+  refine fintype.card_congr (equiv.set_congr _),
+  ext x,
+  show x ∈ h.to_finset ↔ x ∈ s,
+  simp,
 end
 
-@[simp, mono] lemma finite.to_finset_strict_mono {s t : set α} {hs : finite s} {ht : finite t} :
-  hs.to_finset ⊂ ht.to_finset ↔ s ⊂ t :=
+lemma card_ne_eq [fintype α] (a : α) [fintype {x : α | x ≠ a}] :
+  fintype.card {x : α | x ≠ a} = fintype.card α - 1 :=
 begin
-  rw [←lt_eq_ssubset, ←finset.lt_iff_ssubset, lt_iff_le_and_ne, lt_iff_le_and_ne],
-  simp
+  haveI := classical.dec_eq α,
+  rw [←to_finset_card, to_finset_set_of, finset.filter_ne',
+    finset.card_erase_of_mem (finset.mem_univ _), finset.card_univ],
 end
 
-lemma card_range_of_injective [fintype α] {f : α → β} (hf : injective f)
-  [fintype (range f)] : fintype.card (range f) = fintype.card α :=
-eq.symm $ fintype.card_congr $ equiv.of_injective f hf
 
-lemma finite.exists_maximal_wrt [partial_order β] (f : α → β) (s : set α) (h : set.finite s) :
-  s.nonempty → ∃ a ∈ s, ∀ a' ∈ s, f a ≤ f a' → f a = f a' :=
+/-! ### Infinite sets -/
+
+theorem infinite_univ_iff : (@univ α).infinite ↔ infinite α :=
+by rw [set.infinite, finite_univ_iff, not_finite_iff_infinite]
+
+theorem infinite_univ [h : infinite α] : (@univ α).infinite :=
+infinite_univ_iff.2 h
+
+theorem infinite_coe_iff {s : set α} : infinite s ↔ s.infinite :=
+not_finite_iff_infinite.symm.trans finite_coe_iff.not
+
+alias infinite_coe_iff ↔ _ infinite.to_subtype
+
+/-- Embedding of `ℕ` into an infinite set. -/
+noncomputable def infinite.nat_embedding (s : set α) (h : s.infinite) : ℕ ↪ s :=
+by { haveI := h.to_subtype, exact infinite.nat_embedding s }
+
+lemma infinite.exists_subset_card_eq {s : set α} (hs : s.infinite) (n : ℕ) :
+  ∃ t : finset α, ↑t ⊆ s ∧ t.card = n :=
+⟨((finset.range n).map (hs.nat_embedding _)).map (embedding.subtype _), by simp⟩
+
+lemma infinite_of_finite_compl [infinite α] {s : set α} (hs : sᶜ.finite) : s.infinite :=
+λ h, set.infinite_univ (by simpa using hs.union h)
+
+lemma finite.infinite_compl [infinite α] {s : set α} (hs : s.finite) : sᶜ.infinite :=
+λ h, set.infinite_univ (by simpa using hs.union h)
+
+protected theorem infinite.mono {s t : set α} (h : s ⊆ t) : s.infinite → t.infinite :=
+mt (λ ht, ht.subset h)
+
+lemma infinite.diff {s t : set α} (hs : s.infinite) (ht : t.finite) : (s \ t).infinite :=
+λ h, hs $ h.of_diff ht
+
+@[simp] lemma infinite_union {s t : set α} : (s ∪ t).infinite ↔ s.infinite ∨ t.infinite :=
+by simp only [set.infinite, finite_union, not_and_distrib]
+
+theorem infinite.of_image (f : α → β) {s : set α} (hs : (f '' s).infinite) : s.infinite :=
+mt (finite.image f) hs
+
+theorem infinite_image_iff {s : set α} {f : α → β} (hi : inj_on f s) :
+  (f '' s).infinite ↔ s.infinite :=
+not_congr $ finite_image_iff hi
+
+alias infinite_image_iff ↔ _ infinite.image
+
+attribute [protected] infinite.image
+
+section image2
+variables {f : α → β → γ} {s : set α} {t : set β} {a : α} {b : β}
+
+protected lemma infinite.image2_left (hs : s.infinite) (hb : b ∈ t) (hf : inj_on (λ a, f a b) s) :
+  (image2 f s t).infinite :=
+(hs.image hf).mono $ image_subset_image2_left hb
+
+protected lemma infinite.image2_right (ht : t.infinite) (ha : a ∈ s) (hf : inj_on (f a) t) :
+  (image2 f s t).infinite :=
+(ht.image hf).mono $ image_subset_image2_right ha
+
+theorem infinite_image2 (hfs : ∀ b ∈ t, inj_on (λ a, f a b) s) (hft : ∀ a ∈ s, inj_on (f a) t) :
+  (image2 f s t).infinite ↔ s.infinite ∧ t.nonempty ∨ t.infinite ∧ s.nonempty :=
 begin
-  classical,
-  refine h.induction_on _ _,
-  { exact λ h, absurd h empty_not_nonempty },
-  intros a s his _ ih _,
-  cases s.eq_empty_or_nonempty with h h,
-  { use a, simp [h] },
-  rcases ih h with ⟨b, hb, ih⟩,
-  by_cases f b ≤ f a,
-  { refine ⟨a, set.mem_insert _ _, λ c hc hac, le_antisymm hac _⟩,
-    rcases set.mem_insert_iff.1 hc with rfl | hcs,
-    { refl },
-    { rwa [← ih c hcs (le_trans h hac)] } },
-  { refine ⟨b, set.mem_insert_of_mem _ hb, λ c hc hbc, _⟩,
-    rcases set.mem_insert_iff.1 hc with rfl | hcs,
-    { exact (h hbc).elim },
-    { exact ih c hcs hbc } }
+  refine ⟨λ h, set.infinite_prod.1 _, _⟩,
+  { rw ←image_uncurry_prod at h,
+    exact h.of_image _ },
+  { rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩),
+    { exact hs.image2_left hb (hfs _ hb) },
+    { exact ht.image2_right ha (hft _ ha) } }
 end
 
-lemma finite.card_to_finset {s : set α} [fintype s] (h : s.finite) :
-  h.to_finset.card = fintype.card s :=
+end image2
+
+theorem infinite_of_inj_on_maps_to {s : set α} {t : set β} {f : α → β}
+  (hi : inj_on f s) (hm : maps_to f s t) (hs : s.infinite) : t.infinite :=
+((infinite_image_iff hi).2 hs).mono (maps_to'.mp hm)
+
+theorem infinite.exists_ne_map_eq_of_maps_to {s : set α} {t : set β} {f : α → β}
+  (hs : s.infinite) (hf : maps_to f s t) (ht : t.finite) :
+  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
 begin
-  rw [← finset.card_attach, finset.attach_eq_univ, ← fintype.card],
-  refine fintype.card_congr (equiv.set_congr _),
-  ext x, show x ∈ h.to_finset ↔ x ∈ s,
-  simp,
+  contrapose! ht,
+  exact infinite_of_inj_on_maps_to (λ x hx y hy, not_imp_not.1 (ht x hx y hy)) hf hs
 end
 
+theorem infinite_range_of_injective [infinite α] {f : α → β} (hi : injective f) :
+  (range f).infinite :=
+by { rw [←image_univ, infinite_image_iff (inj_on_of_injective hi _)], exact infinite_univ }
+
+theorem infinite_of_injective_forall_mem [infinite α] {s : set β} {f : α → β}
+  (hi : injective f) (hf : ∀ x : α, f x ∈ s) : s.infinite :=
+by { rw ←range_subset_iff at hf, exact (infinite_range_of_injective hi).mono hf }
+
 lemma infinite.exists_not_mem_finset {s : set α} (hs : s.infinite) (f : finset α) :
   ∃ a ∈ s, a ∉ f :=
-let ⟨a, has, haf⟩ := (hs.diff f.finite_to_set).nonempty in ⟨a, has, λ h, haf $ finset.mem_coe.1 h⟩
+let ⟨a, has, haf⟩ := (hs.diff (to_finite f)).nonempty
+in ⟨a, has, λ h, haf $ finset.mem_coe.1 h⟩
 
-section decidable_eq
+lemma not_inj_on_infinite_finite_image {f : α → β} {s : set α}
+  (h_inf : s.infinite) (h_fin : (f '' s).finite) :
+  ¬ inj_on f s :=
+begin
+  haveI : finite (f '' s) := finite_coe_iff.mpr h_fin,
+  haveI : infinite s := infinite_coe_iff.mpr h_inf,
+  have := not_injective_infinite_finite
+    ((f '' s).cod_restrict (s.restrict f) $ λ x, ⟨x, x.property, rfl⟩),
+  contrapose! this,
+  rwa [injective_cod_restrict, ← inj_on_iff_injective],
+end
 
-lemma to_finset_inter {α : Type*} [decidable_eq α] (s t : set α) [fintype (s ∩ t : set α)]
-  [fintype s] [fintype t] : (s ∩ t).to_finset = s.to_finset ∩ t.to_finset :=
-by ext; simp
+/-! ### Order properties -/
 
-lemma to_finset_union {α : Type*} [decidable_eq α] (s t : set α) [fintype (s ∪ t : set α)]
-  [fintype s] [fintype t] : (s ∪ t).to_finset = s.to_finset ∪ t.to_finset :=
-by ext; simp
+section preorder
+variables [preorder α] [nonempty α] {s : set α}
 
-instance fintype_sdiff  {α : Type*} [decidable_eq α]
-  (s t : set α) [fintype s] [fintype t] :
-  fintype (s \ t : set α) :=
-fintype.of_finset (s.to_finset \ t.to_finset) $ by simp
+lemma infinite_of_forall_exists_gt (h : ∀ a, ∃ b ∈ s, a < b) : s.infinite :=
+begin
+  inhabit α,
+  set f : ℕ → α := λ n, nat.rec_on n (h default).some (λ n a, (h a).some),
+  have hf : ∀ n, f n ∈ s := by rintro (_ | _); exact (h _).some_spec.some,
+  refine infinite_of_injective_forall_mem (strict_mono_nat_of_lt_succ $ λ n, _).injective hf,
+  exact (h _).some_spec.some_spec,
+end
 
-lemma to_finset_sdiff {α : Type*} [decidable_eq α] (s t : set α) [fintype s] [fintype t]
-  [fintype (s \ t : set α)] : (s \ t).to_finset = s.to_finset \ t.to_finset :=
-by ext; simp
+lemma infinite_of_forall_exists_lt (h : ∀ a, ∃ b ∈ s, b < a) : s.infinite :=
+@infinite_of_forall_exists_gt αᵒᵈ _ _ _ h
 
-lemma to_finset_ne_eq_erase {α : Type*} [decidable_eq α] [fintype α] (a : α)
-  [fintype {x : α | x ≠ a}] : {x : α | x ≠ a}.to_finset = finset.univ.erase a :=
-by ext; simp
+end preorder
 
-lemma card_ne_eq [fintype α] (a : α) [fintype {x : α | x ≠ a}] :
-  fintype.card {x : α | x ≠ a} = fintype.card α - 1 :=
+lemma finite_is_top (α : Type*) [partial_order α] : {x : α | is_top x}.finite :=
+(subsingleton_is_top α).finite
+
+lemma finite_is_bot (α : Type*) [partial_order α] : {x : α | is_bot x}.finite :=
+(subsingleton_is_bot α).finite
+
+theorem infinite.exists_lt_map_eq_of_maps_to [linear_order α] {s : set α} {t : set β} {f : α → β}
+  (hs : s.infinite) (hf : maps_to f s t) (ht : t.finite) :
+  ∃ (x ∈ s) (y ∈ s), x < y ∧ f x = f y :=
+let ⟨x, hx, y, hy, hxy, hf⟩ := hs.exists_ne_map_eq_of_maps_to hf ht
+in hxy.lt_or_lt.elim (λ hxy, ⟨x, hx, y, hy, hxy, hf⟩) (λ hyx, ⟨y, hy, x, hx, hyx, hf.symm⟩)
+
+lemma finite.exists_lt_map_eq_of_forall_mem [linear_order α] [infinite α] {t : set β}
+  {f : α → β} (hf : ∀ a, f a ∈ t) (ht : t.finite) :
+  ∃ a b, a < b ∧ f a = f b :=
 begin
-  haveI := classical.dec_eq α,
-  rw [←to_finset_card, to_finset_ne_eq_erase, finset.card_erase_of_mem (finset.mem_univ _),
-      finset.card_univ],
+  rw ←maps_univ_to at hf,
+  obtain ⟨a, -, b, -, h⟩ := (@infinite_univ α _).exists_lt_map_eq_of_maps_to hf ht,
+  exact ⟨a, b, h⟩,
+end
+
+lemma exists_min_image [linear_order β] (s : set α) (f : α → β) (h1 : s.finite) :
+  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f a ≤ f b
+| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
+  using h1.to_finset.exists_min_image f ⟨x, h1.mem_to_finset.2 hx⟩
+
+lemma exists_max_image [linear_order β] (s : set α) (f : α → β) (h1 : s.finite) :
+  s.nonempty → ∃ a ∈ s, ∀ b ∈ s, f b ≤ f a
+| ⟨x, hx⟩ := by simpa only [exists_prop, finite.mem_to_finset]
+  using h1.to_finset.exists_max_image f ⟨x, h1.mem_to_finset.2 hx⟩
+
+theorem exists_lower_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
+  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f a ≤ f b :=
+begin
+  by_cases hs : set.nonempty s,
+  { exact let ⟨x₀, H, hx₀⟩ := set.exists_min_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
+  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
+end
+
+theorem exists_upper_bound_image [hα : nonempty α] [linear_order β] (s : set α) (f : α → β)
+  (h : s.finite) : ∃ (a : α), ∀ b ∈ s, f b ≤ f a :=
+begin
+  by_cases hs : set.nonempty s,
+  { exact let ⟨x₀, H, hx₀⟩ := set.exists_max_image s f h hs in ⟨x₀, λ x hx, hx₀ x hx⟩ },
+  { exact nonempty.elim hα (λ a, ⟨a, λ x hx, absurd (set.nonempty_of_mem hx) hs⟩) }
+end
+
+lemma finite.supr_binfi_of_monotone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
+  [is_directed ι' (≤)] [order.frame α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
+  (hf : ∀ i ∈ s, monotone (f i)) :
+  (⨆ j, ⨅ i ∈ s, f i j) = ⨅ i ∈ s, ⨆ j, f i j :=
+begin
+  revert hf,
+  refine hs.induction_on _ _,
+  { intro hf, simp [supr_const] },
+  { intros a s has hs ihs hf,
+    rw [ball_insert_iff] at hf,
+    simp only [infi_insert, ← ihs hf.2],
+    exact supr_inf_of_monotone hf.1 (λ j₁ j₂ hj, infi₂_mono $ λ i hi, hf.2 i hi hj) }
+end
+
+lemma finite.supr_binfi_of_antitone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
+  [is_directed ι' (swap (≤))] [order.frame α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
+  (hf : ∀ i ∈ s, antitone (f i)) :
+  (⨆ j, ⨅ i ∈ s, f i j) = ⨅ i ∈ s, ⨆ j, f i j :=
+@finite.supr_binfi_of_monotone ι ι'ᵒᵈ α _ _ _ _ _ hs _ (λ i hi, (hf i hi).dual_left)
+
+lemma finite.infi_bsupr_of_monotone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
+  [is_directed ι' (swap (≤))] [order.coframe α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
+  (hf : ∀ i ∈ s, monotone (f i)) :
+  (⨅ j, ⨆ i ∈ s, f i j) = ⨆ i ∈ s, ⨅ j, f i j :=
+hs.supr_binfi_of_antitone (λ i hi, (hf i hi).dual_right)
+
+lemma finite.infi_bsupr_of_antitone {ι ι' α : Type*} [preorder ι'] [nonempty ι']
+  [is_directed ι' (≤)] [order.coframe α] {s : set ι} (hs : s.finite) {f : ι → ι' → α}
+  (hf : ∀ i ∈ s, antitone (f i)) :
+  (⨅ j, ⨆ i ∈ s, f i j) = ⨆ i ∈ s, ⨅ j, f i j :=
+hs.supr_binfi_of_monotone (λ i hi, (hf i hi).dual_right)
+
+lemma _root_.supr_infi_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
+  [is_directed ι' (≤)] [order.frame α] {f : ι → ι' → α} (hf : ∀ i, monotone (f i)) :
+  (⨆ j, ⨅ i, f i j) = ⨅ i, ⨆ j, f i j :=
+by simpa only [infi_univ] using finite_univ.supr_binfi_of_monotone (λ i hi, hf i)
+
+lemma _root_.supr_infi_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
+  [is_directed ι' (swap (≤))] [order.frame α] {f : ι → ι' → α} (hf : ∀ i, antitone (f i)) :
+  (⨆ j, ⨅ i, f i j) = ⨅ i, ⨆ j, f i j :=
+@supr_infi_of_monotone ι ι'ᵒᵈ α _ _ _ _ _ _ (λ i, (hf i).dual_left)
+
+lemma _root_.infi_supr_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
+  [is_directed ι' (swap (≤))] [order.coframe α] {f : ι → ι' → α} (hf : ∀ i, monotone (f i)) :
+  (⨅ j, ⨆ i, f i j) = ⨆ i, ⨅ j, f i j :=
+supr_infi_of_antitone (λ i, (hf i).dual_right)
+
+lemma _root_.infi_supr_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [nonempty ι']
+  [is_directed ι' (≤)] [order.coframe α] {f : ι → ι' → α} (hf : ∀ i, antitone (f i)) :
+  (⨅ j, ⨆ i, f i j) = ⨆ i, ⨅ j, f i j :=
+supr_infi_of_monotone (λ i, (hf i).dual_right)
+
+/-- An increasing union distributes over finite intersection. -/
+lemma Union_Inter_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (≤)]
+  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, monotone (s i)) :
+  (⋃ j : ι', ⋂ i : ι, s i j) = ⋂ i : ι, ⋃ j : ι', s i j :=
+supr_infi_of_monotone hs
+
+/-- A decreasing union distributes over finite intersection. -/
+lemma Union_Inter_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (swap (≤))]
+  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, antitone (s i)) :
+  (⋃ j : ι', ⋂ i : ι, s i j) = ⋂ i : ι, ⋃ j : ι', s i j :=
+supr_infi_of_antitone hs
+
+/-- An increasing intersection distributes over finite union. -/
+lemma Inter_Union_of_monotone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (swap (≤))]
+  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, monotone (s i)) :
+  (⋂ j : ι', ⋃ i : ι, s i j) = ⋃ i : ι, ⋂ j : ι', s i j :=
+infi_supr_of_monotone hs
+
+/-- A decreasing intersection distributes over finite union. -/
+lemma Inter_Union_of_antitone {ι ι' α : Type*} [finite ι] [preorder ι'] [is_directed ι' (≤)]
+  [nonempty ι'] {s : ι → ι' → set α} (hs : ∀ i, antitone (s i)) :
+  (⋂ j : ι', ⋃ i : ι, s i j) = ⋃ i : ι, ⋂ j : ι', s i j :=
+infi_supr_of_antitone hs
+
+lemma Union_pi_of_monotone {ι ι' : Type*} [linear_order ι'] [nonempty ι'] {α : ι → Type*}
+  {I : set ι} {s : Π i, ι' → set (α i)} (hI : I.finite) (hs : ∀ i ∈ I, monotone (s i)) :
+  (⋃ j : ι', I.pi (λ i, s i j)) = I.pi (λ i, ⋃ j, s i j) :=
+begin
+  simp only [pi_def, bInter_eq_Inter, preimage_Union],
+  haveI := hI.fintype,
+  exact Union_Inter_of_monotone (λ i j₁ j₂ h, preimage_mono $ hs i i.2 h)
 end
 
-end decidable_eq
+lemma Union_univ_pi_of_monotone {ι ι' : Type*} [linear_order ι'] [nonempty ι'] [finite ι]
+  {α : ι → Type*} {s : Π i, ι' → set (α i)} (hs : ∀ i, monotone (s i)) :
+  (⋃ j : ι', pi univ (λ i, s i j)) = pi univ (λ i, ⋃ j, s i j) :=
+Union_pi_of_monotone finite_univ (λ i _, hs i)
+
+lemma finite_range_find_greatest {P : α → ℕ → Prop} [∀ x, decidable_pred (P x)] {b : ℕ} :
+  (range (λ x, nat.find_greatest (P x) b)).finite :=
+(finite_le_nat b).subset $ range_subset_iff.2 $ λ x, nat.find_greatest_le _
+
+lemma finite.exists_maximal_wrt [partial_order β] (f : α → β) (s : set α) (h : set.finite s) :
+  s.nonempty → ∃ a ∈ s, ∀ a' ∈ s, f a ≤ f a' → f a = f a' :=
+begin
+  refine h.induction_on _ _,
+  { exact λ h, absurd h not_nonempty_empty },
+  intros a s his _ ih _,
+  cases s.eq_empty_or_nonempty with h h,
+  { use a, simp [h] },
+  rcases ih h with ⟨b, hb, ih⟩,
+  by_cases f b ≤ f a,
+  { refine ⟨a, set.mem_insert _ _, λ c hc hac, le_antisymm hac _⟩,
+    rcases set.mem_insert_iff.1 hc with rfl | hcs,
+    { refl },
+    { rwa [← ih c hcs (le_trans h hac)] } },
+  { refine ⟨b, set.mem_insert_of_mem _ hb, λ c hc hbc, _⟩,
+    rcases set.mem_insert_iff.1 hc with rfl | hcs,
+    { exact (h hbc).elim },
+    { exact ih c hcs hbc } }
+end
 
 section
 
-variables [semilattice_sup α] [nonempty α] {s : set α}
+variables [preorder α] [is_directed α (≤)] [nonempty α] {s : set α}
 
 /--A finite set is bounded above.-/
-protected lemma finite.bdd_above (hs : finite s) : bdd_above s :=
+protected lemma finite.bdd_above (hs : s.finite) : bdd_above s :=
 finite.induction_on hs bdd_above_empty $ λ a s _ _ h, h.insert a
 
 /--A finite union of sets which are all bounded above is still bounded above.-/
-lemma finite.bdd_above_bUnion {I : set β} {S : β → set α} (H : finite I) :
-  (bdd_above (⋃i∈I, S i)) ↔ (∀i ∈ I, bdd_above (S i)) :=
+lemma finite.bdd_above_bUnion {I : set β} {S : β → set α} (H : I.finite) :
+  bdd_above (⋃ i ∈ I, S i) ↔ ∀ i ∈ I, bdd_above (S i) :=
 finite.induction_on H
   (by simp only [bUnion_empty, bdd_above_empty, ball_empty_iff])
   (λ a s ha _ hs, by simp only [bUnion_insert, ball_insert_iff, bdd_above_union, hs])
 
-lemma infinite_of_not_bdd_above : ¬ bdd_above s → s.infinite :=
-begin
-  contrapose!,
-  rw not_infinite,
-  apply finite.bdd_above,
-end
+lemma infinite_of_not_bdd_above : ¬ bdd_above s → s.infinite := mt finite.bdd_above
 
 end
 
 section
 
-variables [semilattice_inf α] [nonempty α] {s : set α}
+variables [preorder α] [is_directed α (≥)] [nonempty α] {s : set α}
 
 /--A finite set is bounded below.-/
-protected lemma finite.bdd_below (hs : finite s) : bdd_below s := @finite.bdd_above αᵒᵈ _ _ _ hs
+protected lemma finite.bdd_below (hs : s.finite) : bdd_below s := @finite.bdd_above αᵒᵈ _ _ _ _ hs
 
 /--A finite union of sets which are all bounded below is still bounded below.-/
-lemma finite.bdd_below_bUnion {I : set β} {S : β → set α} (H : finite I) :
+lemma finite.bdd_below_bUnion {I : set β} {S : β → set α} (H : I.finite) :
   bdd_below (⋃ i ∈ I, S i) ↔ ∀ i ∈ I, bdd_below (S i) :=
-@finite.bdd_above_bUnion αᵒᵈ _ _ _ _ _ H
+@finite.bdd_above_bUnion αᵒᵈ _ _ _ _ _ _ H
 
-lemma infinite_of_not_bdd_below : ¬ bdd_below s → s.infinite :=
-begin
-  contrapose!,
-  rw not_infinite,
-  apply finite.bdd_below,
-end
+lemma infinite_of_not_bdd_below : ¬ bdd_below s → s.infinite := mt finite.bdd_below
 
 end
 
@@ -877,46 +1328,27 @@ s.finite_to_set.bdd_below
 
 end finset
 
-namespace fintype
-variables [fintype α] {p q : α → Prop} [decidable_pred p] [decidable_pred q]
+variables [linear_order α]
 
-@[simp]
-lemma card_subtype_compl : fintype.card {x // ¬ p x} = fintype.card α - fintype.card {x // p x} :=
+/-- If a linear order does not contain any triple of elements `x < y < z`, then this type
+is finite. -/
+lemma finite.of_forall_not_lt_lt (h : ∀ ⦃x y z : α⦄, x < y → y < z → false) :
+  finite α :=
 begin
-  classical,
-  rw [fintype.card_of_subtype (set.to_finset pᶜ), set.to_finset_compl p, finset.card_compl,
-      fintype.card_of_subtype (set.to_finset p)];
-    intros; simp; refl
+  nontriviality α,
+  rcases exists_pair_ne α with ⟨x, y, hne⟩,
+  refine @finite.of_fintype α ⟨{x, y}, λ z , _⟩,
+  simpa [hne] using eq_or_eq_or_eq_of_forall_not_lt_lt h z x y
 end
 
-/-- If two subtypes of a fintype have equal cardinality, so do their complements. -/
-lemma card_compl_eq_card_compl (h : fintype.card {x // p x} = fintype.card {x // q x}) :
-  fintype.card {x // ¬ p x} = fintype.card {x // ¬ q x} :=
-by simp only [card_subtype_compl, h]
+/-- If a set `s` does not contain any triple of elements `x < y < z`, then `s` is finite. -/
+lemma set.finite_of_forall_not_lt_lt {s : set α} (h : ∀ (x y z ∈ s), x < y → y < z → false) :
+  set.finite s :=
+@set.to_finite _ s $ finite.of_forall_not_lt_lt $ by simpa only [set_coe.forall'] using h
 
-end fintype
+lemma set.finite_diff_Union_Ioo (s : set α) : (s \ ⋃ (x ∈ s) (y ∈ s), Ioo x y).finite :=
+set.finite_of_forall_not_lt_lt $ λ x hx y hy z hz hxy hyz, hy.2 $ mem_Union₂_of_mem hx.1 $
+  mem_Union₂_of_mem hz.1 ⟨hxy, hyz⟩
 
-/--
-If a set `s` does not contain any elements between any pair of elements `x, z ∈ s` with `x ≤ z`
-(i.e if given `x, y, z ∈ s` such that `x ≤ y ≤ z`, then `y` is either `x` or `z`), then `s` is
-finite.
--/
-lemma set.finite_of_forall_between_eq_endpoints {α : Type*} [linear_order α] (s : set α)
-  (h : ∀ (x ∈ s) (y ∈ s) (z ∈ s), x ≤ y → y ≤ z → x = y ∨ y = z) :
-  set.finite s :=
-begin
-  by_contra hinf,
-  change s.infinite at hinf,
-  rcases hinf.exists_subset_card_eq 3 with ⟨t, hts, ht⟩,
-  let f := t.order_iso_of_fin ht,
-  let x := f 0,
-  let y := f 1,
-  let z := f 2,
-  have := h x (hts x.2) y (hts y.2) z (hts z.2)
-    (f.monotone $ by dec_trivial) (f.monotone $ by dec_trivial),
-  have key₁ : (0 : fin 3) ≠ 1 := by dec_trivial,
-  have key₂ : (1 : fin 3) ≠ 2 := by dec_trivial,
-  cases this,
-  { dsimp only [x, y] at this, exact key₁ (f.injective $ subtype.coe_injective this) },
-  { dsimp only [y, z] at this, exact key₂ (f.injective $ subtype.coe_injective this) }
-end
+lemma set.finite_diff_Union_Ioo' (s : set α) : (s \ ⋃ x : s × s, Ioo x.1 x.2).finite :=
+by simpa only [Union, supr_prod, supr_subtype] using s.finite_diff_Union_Ioo
diff --git a/src/data/set/function.lean b/src/data/set/function.lean
index 7497ee422bfcb..f2bc48dc31da1 100644
--- a/src/data/set/function.lean
+++ b/src/data/set/function.lean
@@ -9,6 +9,9 @@ import logic.function.conjugate
 /-!
 # Functions over sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 ### Predicate
@@ -34,7 +37,7 @@ universes u v w x y
 
 variables {α : Type u} {β : Type v} {π : α → Type v} {γ : Type w} {ι : Sort x}
 
-open function
+open equiv equiv.perm function
 
 namespace set
 
@@ -48,6 +51,14 @@ lemma restrict_eq (f : α → β) (s : set α) : s.restrict f = f ∘ coe := rfl
 
 @[simp] lemma restrict_apply (f : α → β) (s : set α) (x : s) : s.restrict f x = f x := rfl
 
+lemma restrict_eq_iff {f : Π a, π a} {s : set α} {g : Π a : s, π a} :
+  restrict s f = g ↔ ∀ a (ha : a ∈ s), f a = g ⟨a, ha⟩ :=
+funext_iff.trans subtype.forall
+
+lemma eq_restrict_iff {s : set α} {f : Π a : s, π a} {g : Π a, π a} :
+  f = restrict s g ↔ ∀ a (ha : a ∈ s), f ⟨a, ha⟩ = g a :=
+funext_iff.trans subtype.forall
+
 @[simp] lemma range_restrict (f : α → β) (s : set α) : set.range (s.restrict f) = f '' s :=
 (range_comp _ _).trans $ congr_arg (('') f) subtype.range_coe
 
@@ -84,7 +95,7 @@ lemma restrict_extend_range (f : α → β) (g : α → γ) (g' : β → γ) :
 by convert restrict_dite _ _
 
 @[simp] lemma restrict_extend_compl_range (f : α → β) (g : α → γ) (g' : β → γ) :
-  (range f)ᶜ.restrict (extend f g g')  = g' ∘ coe :=
+  (range f)ᶜ.restrict (extend f g g') = g' ∘ coe :=
 by convert restrict_dite_compl _ _
 
 lemma range_extend_subset (f : α → β) (g : α → γ) (g' : β → γ) :
@@ -101,29 +112,29 @@ lemma range_extend {f : α → β} (hf : injective f) (g : α → γ) (g' : β 
 begin
   refine (range_extend_subset _ _ _).antisymm _,
   rintro z (⟨x, rfl⟩|⟨y, hy, rfl⟩),
-  exacts [⟨f x, extend_apply hf _ _ _⟩, ⟨y, extend_apply' _ _ _ hy⟩]
+  exacts [⟨f x, hf.extend_apply _ _ _⟩, ⟨y, extend_apply' _ _ _ hy⟩]
 end
 
 /-- Restrict codomain of a function `f` to a set `s`. Same as `subtype.coind` but this version
 has codomain `↥s` instead of `subtype s`. -/
-def cod_restrict (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) : α → s :=
+def cod_restrict (f : ι → α) (s : set α) (h : ∀ x, f x ∈ s) : ι → s :=
 λ x, ⟨f x, h x⟩
 
-@[simp] lemma coe_cod_restrict_apply (f : α → β) (s : set β) (h : ∀ x, f x ∈ s) (x : α) :
-  (cod_restrict f s h x : β) = f x :=
+@[simp] lemma coe_cod_restrict_apply (f : ι → α) (s : set α) (h : ∀ x, f x ∈ s) (x : ι) :
+  (cod_restrict f s h x : α) = f x :=
 rfl
 
-@[simp] lemma restrict_comp_cod_restrict {f : α → β} {g : β → γ} {b : set β}
+@[simp] lemma restrict_comp_cod_restrict {f : ι → α} {g : α → β} {b : set α}
   (h : ∀ x, f x ∈ b) : (b.restrict g) ∘ (b.cod_restrict f h) = g ∘ f := rfl
 
-variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {p : set γ} {f f₁ f₂ f₃ : α → β} {g g₁ g₂ : β → γ}
-  {f' f₁' f₂' : β → α} {g' : γ → β}
-
-@[simp] lemma injective_cod_restrict (h : ∀ x, f x ∈ t) :
-  injective (cod_restrict f t h) ↔ injective f :=
+@[simp] lemma injective_cod_restrict {f : ι → α} {s : set α} (h : ∀ x, f x ∈ s) :
+  injective (cod_restrict f s h) ↔ injective f :=
 by simp only [injective, subtype.ext_iff, coe_cod_restrict_apply]
 
-alias injective_cod_restrict ↔ _ function.injective.cod_restrict
+alias injective_cod_restrict ↔ _ _root_.function.injective.cod_restrict
+
+variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {p : set γ} {f f₁ f₂ f₃ : α → β} {g g₁ g₂ : β → γ}
+  {f' f₁' f₂' : β → α} {g' : γ → β} {a : α} {b : β}
 
 /-! ### Equality on a set -/
 
@@ -133,6 +144,10 @@ def eq_on (f₁ f₂ : α → β) (s : set α) : Prop :=
 ∀ ⦃x⦄, x ∈ s → f₁ x = f₂ x
 
 @[simp] lemma eq_on_empty (f₁ f₂ : α → β) : eq_on f₁ f₂ ∅ := λ x, false.elim
+@[simp] lemma eq_on_singleton : eq_on f₁ f₂ {a} ↔ f₁ a = f₂ a := by simp [set.eq_on]
+
+@[simp] lemma restrict_eq_restrict_iff : restrict s f₁ = restrict s f₂ ↔ eq_on f₁ f₂ s :=
+restrict_eq_iff
 
 @[symm] lemma eq_on.symm (h : eq_on f₁ f₂ s) : eq_on f₂ f₁ s :=
 λ x hx, (h hx).symm
@@ -155,11 +170,19 @@ ext $ λ x, and.congr_right_iff.2 $ λ hx, by rw [mem_preimage, mem_preimage, he
 lemma eq_on.mono (hs : s₁ ⊆ s₂) (hf : eq_on f₁ f₂ s₂) : eq_on f₁ f₂ s₁ :=
 λ x hx, hf (hs hx)
 
+@[simp] lemma eq_on_union : eq_on f₁ f₂ (s₁ ∪ s₂) ↔ eq_on f₁ f₂ s₁ ∧ eq_on f₁ f₂ s₂ :=
+ball_or_left_distrib
+
+lemma eq_on.union (h₁ : eq_on f₁ f₂ s₁) (h₂ : eq_on f₁ f₂ s₂) : eq_on f₁ f₂ (s₁ ∪ s₂) :=
+eq_on_union.2 ⟨h₁, h₂⟩
+
 lemma eq_on.comp_left (h : s.eq_on f₁ f₂) : s.eq_on (g ∘ f₁) (g ∘ f₂) := λ a ha, congr_arg _ $ h ha
 
-lemma comp_eq_of_eq_on_range {ι : Sort*} {f : ι → α} {g₁ g₂ : α → β} (h : eq_on g₁ g₂ (range f)) :
-  g₁ ∘ f = g₂ ∘ f :=
-funext $ λ x, h $ mem_range_self _
+@[simp] lemma eq_on_range {ι : Sort*} {f : ι → α} {g₁ g₂ : α → β} :
+  eq_on g₁ g₂ (range f) ↔ g₁ ∘ f = g₂ ∘ f :=
+forall_range_iff.trans $ funext_iff.symm
+
+alias eq_on_range ↔ eq_on.comp_eq _
 
 /-! ### Congruence lemmas -/
 
@@ -220,6 +243,20 @@ lemma _root_.strict_mono_on.mono (h : strict_mono_on f s) (h' : s₂ ⊆ s) : st
 lemma _root_.strict_anti_on.mono (h : strict_anti_on f s) (h' : s₂ ⊆ s) : strict_anti_on f s₂ :=
 λ x hx y hy, h (h' hx) (h' hy)
 
+protected lemma _root_.monotone_on.monotone (h : monotone_on f s) : monotone (f ∘ coe : s → β) :=
+λ x y hle, h x.coe_prop y.coe_prop hle
+
+protected lemma _root_.antitone_on.monotone (h : antitone_on f s) : antitone (f ∘ coe : s → β) :=
+λ x y hle, h x.coe_prop y.coe_prop hle
+
+protected lemma _root_.strict_mono_on.strict_mono (h : strict_mono_on f s) :
+  strict_mono (f ∘ coe : s → β) :=
+λ x y hlt, h x.coe_prop y.coe_prop hlt
+
+protected lemma _root_.strict_anti_on.strict_anti (h : strict_anti_on f s) :
+  strict_anti (f ∘ coe : s → β) :=
+λ x y hlt, h x.coe_prop y.coe_prop hlt
+
 end mono
 
 /-! ### maps to -/
@@ -236,6 +273,21 @@ subtype.map f h
 @[simp] lemma maps_to.coe_restrict_apply (h : maps_to f s t) (x : s) :
   (h.restrict f s t x : β) = f x := rfl
 
+/-- Restricting the domain and then the codomain is the same as `maps_to.restrict`. -/
+@[simp] lemma cod_restrict_restrict (h : ∀ x : s, f x ∈ t) :
+  cod_restrict (s.restrict f) t h = maps_to.restrict f s t (λ x hx, h ⟨x, hx⟩) := rfl
+
+/-- Reverse of `set.cod_restrict_restrict`. -/
+lemma maps_to.restrict_eq_cod_restrict (h : maps_to f s t) :
+  h.restrict f s t = cod_restrict (s.restrict f) t (λ x, h x.2) := rfl
+
+lemma maps_to.coe_restrict (h : set.maps_to f s t) :
+  coe ∘ h.restrict f s t = s.restrict f := rfl
+
+lemma maps_to.range_restrict (f : α → β) (s : set α) (t : set β) (h : maps_to f s t) :
+  range (h.restrict f s t) = coe ⁻¹' (f '' s) :=
+set.range_subtype_map f h
+
 lemma maps_to_iff_exists_map_subtype : maps_to f s t ↔ ∃ g : s → t, ∀ x : s, f x = g x :=
 ⟨λ h, ⟨h.restrict f s t, λ _, rfl⟩,
   λ ⟨g, hg⟩ x hx, by { erw [hg ⟨x, hx⟩], apply subtype.coe_prop }⟩
@@ -243,9 +295,14 @@ lemma maps_to_iff_exists_map_subtype : maps_to f s t ↔ ∃ g : s → t, ∀ x
 theorem maps_to' : maps_to f s t ↔ f '' s ⊆ t :=
 image_subset_iff.symm
 
-@[simp] theorem maps_to_singleton {x : α} : maps_to f {x} t ↔ f x ∈ t := singleton_subset_iff
+theorem maps_to_prod_map_diagonal : maps_to (prod.map f f) (diagonal α) (diagonal β) :=
+diagonal_subset_iff.2 $ λ x, rfl
+
+lemma maps_to.subset_preimage {f : α → β} {s : set α} {t : set β} (hf : maps_to f s t) :
+  s ⊆ f ⁻¹' t := hf
 
 theorem maps_to_empty (f : α → β) (t : set β) : maps_to f ∅ t := empty_subset _
+@[simp] lemma maps_to_singleton : maps_to f {a} t ↔ f a ∈ t := singleton_subset_iff
 
 theorem maps_to.image_subset (h : maps_to f s t) : f '' s ⊆ t :=
 maps_to'.1 h
@@ -280,6 +337,13 @@ begin
   { simp [nat.iterate, ihn] }
 end
 
+lemma maps_to_of_subsingleton' [subsingleton β] (f : α → β) (h : s.nonempty → t.nonempty) :
+  maps_to f s t :=
+λ a ha, subsingleton.mem_iff_nonempty.2 $ h ⟨a, ha⟩
+
+lemma maps_to_of_subsingleton [subsingleton α] (f : α → α) (s : set α) : maps_to f s s :=
+maps_to_of_subsingleton' _ id
+
 theorem maps_to.mono (hf : maps_to f s₁ t₁) (hs : s₂ ⊆ s₁) (ht : t₁ ⊆ t₂) :
   maps_to f s₂ t₂ :=
 λ x hx, ht (hf $ hs hx)
@@ -327,6 +391,12 @@ theorem maps_to_range (f : α → β) (s : set α) : maps_to f s (range f) :=
   maps_to f (g '' s) t ↔ maps_to (f ∘ g) s t :=
 ⟨λ h c hc, h ⟨c, hc, rfl⟩, λ h d ⟨c, hc⟩, hc.2 ▸ h hc.1⟩
 
+lemma maps_to.comp_left (g : β → γ) (hf : maps_to f s t) : maps_to (g ∘ f) s (g '' t) :=
+λ x hx, ⟨f x, hf hx, rfl⟩
+
+lemma maps_to.comp_right {s : set β} {t : set γ} (hg : maps_to g s t) (f : α → β) :
+  maps_to (g ∘ f) (f ⁻¹' s) t := λ x hx, hg hx
+
 @[simp] lemma maps_univ_to (f : α → β) (s : set β) :
   maps_to f univ s ↔ ∀ a, f a ∈ s :=
 ⟨λ h a, h (mem_univ _), λ h x _, h x⟩
@@ -342,6 +412,41 @@ theorem surjective_maps_to_image_restrict (f : α → β) (s : set α) :
 theorem maps_to.mem_iff (h : maps_to f s t) (hc : maps_to f sᶜ tᶜ) {x} : f x ∈ t ↔ x ∈ s :=
 ⟨λ ht, by_contra $ λ hs, hc hs ht, λ hx, h hx⟩
 
+/-! ### Restriction onto preimage -/
+
+section
+
+variables (t f)
+
+/-- The restriction of a function onto the preimage of a set. -/
+@[simps] def restrict_preimage : f ⁻¹' t → t :=
+(set.maps_to_preimage f t).restrict _ _ _
+
+lemma range_restrict_preimage :
+  range (t.restrict_preimage f) = coe ⁻¹' (range f) :=
+begin
+  delta set.restrict_preimage,
+  rw [maps_to.range_restrict, set.image_preimage_eq_inter_range,
+    set.preimage_inter, subtype.coe_preimage_self, set.univ_inter],
+end
+
+variables {f} {U : ι → set β}
+
+lemma restrict_preimage_injective (hf : injective f) : injective (t.restrict_preimage f) :=
+λ x y e, subtype.mk.inj_arrow e (λ e, subtype.coe_injective (hf e))
+
+lemma restrict_preimage_surjective (hf : surjective f) : surjective (t.restrict_preimage f) :=
+λ x, ⟨⟨_, (show f (hf x).some ∈ t, from (hf x).some_spec.symm ▸ x.2)⟩, subtype.ext (hf x).some_spec⟩
+
+lemma restrict_preimage_bijective (hf : bijective f) : bijective (t.restrict_preimage f) :=
+⟨t.restrict_preimage_injective hf.1, t.restrict_preimage_surjective hf.2⟩
+
+alias set.restrict_preimage_injective  ← _root_.function.injective.restrict_preimage
+alias set.restrict_preimage_surjective ← _root_.function.surjective.restrict_preimage
+alias set.restrict_preimage_bijective  ← _root_.function.bijective.restrict_preimage
+
+end
+
 /-! ### Injectivity on a set -/
 
 /-- `f` is injective on `a` if the restriction of `f` to `a` is injective. -/
@@ -361,6 +466,11 @@ theorem inj_on.eq_iff {x y} (h : inj_on f s) (hx : x ∈ s) (hy : y ∈ s) :
   f x = f y ↔ x = y :=
 ⟨h hx hy, λ h, h ▸ rfl⟩
 
+lemma inj_on.ne_iff {x y} (h : inj_on f s) (hx : x ∈ s) (hy : y ∈ s) : f x ≠ f y ↔ x ≠ y :=
+(h.eq_iff hx hy).not
+
+alias inj_on.ne_iff ↔ _ inj_on.ne
+
 theorem inj_on.congr (h₁ : inj_on f₁ s) (h : eq_on f₁ f₂ s) :
   inj_on f₂ s :=
 λ x hx y hy, h hx ▸ h hy ▸ h₁ hx hy
@@ -377,7 +487,7 @@ begin
   refine ⟨λ H, ⟨H.mono $ subset_union_left _ _, H.mono $ subset_union_right _ _, _⟩, _⟩,
   { intros x hx y hy hxy,
     obtain rfl : x = y, from H (or.inl hx) (or.inr hy) hxy,
-    exact h ⟨hx, hy⟩ },
+    exact h.le_bot ⟨hx, hy⟩ },
   { rintro ⟨h₁, h₂, h₁₂⟩,
     rintro x (hx|hx) y (hy|hy) hxy,
     exacts [h₁ hx hy hxy, (h₁₂ _ hx _ hy hxy).elim, (h₁₂ _ hy _ hx hxy.symm).elim, h₂ hx hy hxy] }
@@ -385,7 +495,7 @@ end
 
 theorem inj_on_insert {f : α → β} {s : set α} {a : α} (has : a ∉ s) :
   set.inj_on f (insert a s) ↔ set.inj_on f s ∧ f a ∉ f '' s :=
-have disjoint s {a}, from λ x ⟨hxs, (hxa : x = a)⟩, has (hxa ▸ hxs),
+have disjoint s {a}, from disjoint_iff_inf_le.mpr $ λ x ⟨hxs, (hxa : x = a)⟩, has (hxa ▸ hxs),
 by { rw [← union_singleton, inj_on_union this], simp }
 
 lemma injective_iff_inj_on_univ : injective f ↔ inj_on f univ :=
@@ -394,17 +504,38 @@ lemma injective_iff_inj_on_univ : injective f ↔ inj_on f univ :=
 lemma inj_on_of_injective (h : injective f) (s : set α) : inj_on f s :=
 λ x hx y hy hxy, h hxy
 
-alias inj_on_of_injective ← function.injective.inj_on
+alias inj_on_of_injective ← _root_.function.injective.inj_on
+
+lemma inj_on_id (s : set α) : inj_on id s := injective_id.inj_on _
 
 theorem inj_on.comp (hg : inj_on g t) (hf: inj_on f s) (h : maps_to f s t) :
   inj_on (g ∘ f) s :=
 λ x hx y hy heq, hf hx hy $ hg (h hx) (h hy) heq
 
+lemma inj_on.iterate {f : α → α} {s : set α} (h : inj_on f s) (hf : maps_to f s s) :
+  ∀ n, inj_on (f^[n]) s
+| 0 := inj_on_id _
+| (n + 1) := (inj_on.iterate n).comp h hf
+
+lemma inj_on_of_subsingleton [subsingleton α] (f : α → β) (s : set α) : inj_on f s :=
+(injective_of_subsingleton _).inj_on _
+
+lemma _root_.function.injective.inj_on_range (h : injective (g ∘ f)) : inj_on g (range f) :=
+by { rintros _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ H, exact congr_arg f (h H) }
+
 lemma inj_on_iff_injective : inj_on f s ↔ injective (s.restrict f) :=
 ⟨λ H a b h, subtype.eq $ H a.2 b.2 h,
  λ H a as b bs h, congr_arg subtype.val $ @H ⟨a, as⟩ ⟨b, bs⟩ h⟩
 
-alias inj_on_iff_injective ↔ set.inj_on.injective _
+alias inj_on_iff_injective ↔ inj_on.injective _
+
+lemma maps_to.restrict_inj (h : maps_to f s t) : injective (h.restrict f s t) ↔ inj_on f s :=
+by rw [h.restrict_eq_cod_restrict, injective_cod_restrict, inj_on_iff_injective]
+
+lemma exists_inj_on_iff_injective [nonempty β] :
+  (∃ f : α → β, inj_on f s) ↔ ∃ f : s → β, injective f :=
+⟨λ ⟨f, hf⟩, ⟨_, hf.injective⟩,
+  λ ⟨f, hf⟩, by { lift f to α → β using trivial, exact ⟨f, inj_on_iff_injective.2 hf⟩ }⟩
 
 lemma inj_on_preimage {B : set (set β)} (hB : B ⊆ 𝒫 (range f)) :
   inj_on (preimage f) B :=
@@ -431,6 +562,25 @@ lemma inj_on.cancel_left (hg : t.inj_on g) (hf₁ : s.maps_to f₁ t) (hf₂ : s
   s.eq_on (g ∘ f₁) (g ∘ f₂) ↔ s.eq_on f₁ f₂ :=
 ⟨λ h, h.cancel_left hg hf₁ hf₂, eq_on.comp_left⟩
 
+lemma inj_on.image_inter {s t u : set α} (hf : u.inj_on f) (hs : s ⊆ u) (ht : t ⊆ u) :
+  f '' (s ∩ t) = f '' s ∩ f '' t :=
+begin
+  apply subset.antisymm (image_inter_subset _ _ _),
+  rintros x ⟨⟨y, ys, hy⟩, ⟨z, zt, hz⟩⟩,
+  have : y = z,
+  { apply hf (hs ys) (ht zt),
+    rwa ← hz at hy },
+  rw ← this at zt,
+  exact ⟨y, ⟨ys, zt⟩, hy⟩,
+end
+
+lemma _root_.disjoint.image {s t u : set α} {f : α → β} (h : disjoint s t) (hf : inj_on f u)
+  (hs : s ⊆ u) (ht : t ⊆ u) : disjoint (f '' s) (f '' t) :=
+begin
+  rw disjoint_iff_inter_eq_empty at h ⊢,
+  rw [← hf.image_inter hs ht, h, image_empty],
+end
+
 /-! ### Surjectivity on a set -/
 
 /-- `f` is surjective from `a` to `b` if `b` is contained in the image of `a`. -/
@@ -447,6 +597,8 @@ lemma surj_on_iff_exists_map_subtype :
 
 theorem surj_on_empty (f : α → β) (s : set α) : surj_on f s ∅ := empty_subset _
 
+@[simp] lemma surj_on_singleton : surj_on f s {b} ↔ b ∈ f '' s := singleton_subset_iff
+
 theorem surj_on_image (f : α → β) (s : set α) : surj_on f s (f '' s) := subset.rfl
 
 theorem surj_on.comap_nonempty (h : surj_on f s t) (ht : t.nonempty) : s.nonempty :=
@@ -483,9 +635,29 @@ theorem surj_on.inter (h₁ : surj_on f s₁ t) (h₂ : surj_on f s₂ t) (h : i
   surj_on f (s₁ ∩ s₂) t :=
 inter_self t ▸ h₁.inter_inter h₂ h
 
+lemma surj_on_id (s : set α) : surj_on id s s := by simp [surj_on]
+
 theorem surj_on.comp (hg : surj_on g t p) (hf : surj_on f s t) : surj_on (g ∘ f) s p :=
 subset.trans hg $ subset.trans (image_subset g hf) $ (image_comp g f s) ▸ subset.refl _
 
+lemma surj_on.iterate {f : α → α} {s : set α} (h : surj_on f s s) : ∀ n, surj_on (f^[n]) s s
+| 0 := surj_on_id _
+| (n + 1) := (surj_on.iterate n).comp h
+
+lemma surj_on.comp_left (hf : surj_on f s t) (g : β → γ) : surj_on (g ∘ f) s (g '' t) :=
+by { rw [surj_on, image_comp g f], exact image_subset _ hf }
+
+lemma surj_on.comp_right {s : set β} {t : set γ} (hf : surjective f) (hg : surj_on g s t) :
+  surj_on (g ∘ f) (f ⁻¹' s) t :=
+by rwa [surj_on, image_comp g f, image_preimage_eq _ hf]
+
+lemma surj_on_of_subsingleton' [subsingleton β] (f : α → β) (h : t.nonempty → s.nonempty) :
+  surj_on f s t :=
+λ a ha, subsingleton.mem_iff_nonempty.2 $ (h ⟨a, ha⟩).image _
+
+lemma surj_on_of_subsingleton [subsingleton α] (f : α → α) (s : set α) : surj_on f s s :=
+surj_on_of_subsingleton' _ id
+
 lemma surjective_iff_surj_on_univ : surjective f ↔ surj_on f univ univ :=
 by simp [surjective, surj_on, subset_def]
 
@@ -540,9 +712,21 @@ lemma bij_on.mk (h₁ : maps_to f s t) (h₂ : inj_on f s) (h₃ : surj_on f s t
       bij_on f s t :=
 ⟨h₁, h₂, h₃⟩
 
-lemma bij_on_empty (f : α → β) : bij_on f ∅ ∅ :=
+@[simp] lemma bij_on_empty (f : α → β) : bij_on f ∅ ∅ :=
 ⟨maps_to_empty f ∅, inj_on_empty f, surj_on_empty f ∅⟩
 
+@[simp] lemma bij_on_singleton : bij_on f {a} {b} ↔ f a = b := by simp [bij_on, eq_comm]
+
+lemma bij_on.inter_maps_to (h₁ : bij_on f s₁ t₁) (h₂ : maps_to f s₂ t₂) (h₃ : s₁ ∩ f ⁻¹' t₂ ⊆ s₂) :
+  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
+⟨h₁.maps_to.inter_inter h₂, h₁.inj_on.mono $ inter_subset_left _ _,
+  λ y hy, let ⟨x, hx, hxy⟩ := h₁.surj_on hy.1 in ⟨x, ⟨hx, h₃ ⟨hx, hxy.symm.rec_on hy.2⟩⟩, hxy⟩⟩
+
+lemma maps_to.inter_bij_on (h₁ : maps_to f s₁ t₁) (h₂ : bij_on f s₂ t₂)
+  (h₃ : s₂ ∩ f ⁻¹' t₁ ⊆ s₁) :
+  bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
+inter_comm s₂ s₁ ▸ inter_comm t₂ t₁ ▸ h₂.inter_maps_to h₁ h₃
+
 lemma bij_on.inter (h₁ : bij_on f s₁ t₁) (h₂ : bij_on f s₂ t₂) (h : inj_on f (s₁ ∪ s₂)) :
   bij_on f (s₁ ∩ s₂) (t₁ ∩ t₂) :=
 ⟨h₁.maps_to.inter_inter h₂.maps_to, h₁.inj_on.mono $ inter_subset_left _ _,
@@ -569,12 +753,24 @@ lemma bij_on.image_eq (h : bij_on f s t) :
   f '' s = t :=
 h.surj_on.image_eq_of_maps_to h.maps_to
 
+lemma bij_on_id (s : set α) : bij_on id s s := ⟨s.maps_to_id, s.inj_on_id, s.surj_on_id⟩
+
 theorem bij_on.comp (hg : bij_on g t p) (hf : bij_on f s t) : bij_on (g ∘ f) s p :=
 bij_on.mk (hg.maps_to.comp hf.maps_to) (hg.inj_on.comp hf.inj_on hf.maps_to)
   (hg.surj_on.comp hf.surj_on)
 
-theorem bij_on.bijective (h : bij_on f s t) :
-  bijective (t.cod_restrict (s.restrict f) $ λ x, h.maps_to x.val_prop) :=
+lemma bij_on.iterate {f : α → α} {s : set α} (h : bij_on f s s) : ∀ n, bij_on (f^[n]) s s
+| 0 := s.bij_on_id
+| (n + 1) := (bij_on.iterate n).comp h
+
+lemma bij_on_of_subsingleton' [subsingleton α] [subsingleton β] (f : α → β)
+  (h : s.nonempty ↔ t.nonempty) : bij_on f s t :=
+⟨maps_to_of_subsingleton' _ h.1, inj_on_of_subsingleton _ _, surj_on_of_subsingleton' _ h.2⟩
+
+lemma bij_on_of_subsingleton [subsingleton α] (f : α → α) (s : set α) : bij_on f s s :=
+bij_on_of_subsingleton' _ iff.rfl
+
+theorem bij_on.bijective (h : bij_on f s t) : bijective (h.maps_to.restrict f s t) :=
 ⟨λ x y h', subtype.ext $ h.inj_on x.2 y.2 $ subtype.ext_iff.1 h',
   λ ⟨y, hy⟩, let ⟨x, hx, hxy⟩ := h.surj_on hy in ⟨⟨x, hx⟩, subtype.eq hxy⟩⟩
 
@@ -585,6 +781,8 @@ iff.intro
 (λ h, let ⟨map, inj, surj⟩ := h in
 ⟨iff.mpr injective_iff_inj_on_univ inj, iff.mpr surjective_iff_surj_on_univ surj⟩)
 
+alias bijective_iff_bij_on_univ ↔ _root_.function.bijective.bij_on_univ _
+
 lemma bij_on.compl (hst : bij_on f s t) (hf : bijective f) : bij_on f sᶜ tᶜ :=
 ⟨hst.surj_on.maps_to_compl hf.1, hf.1.inj_on _, hst.maps_to.surj_on_compl hf.2⟩
 
@@ -594,6 +792,9 @@ lemma bij_on.compl (hst : bij_on f s t) (hf : bijective f) : bij_on f sᶜ tᶜ
 def left_inv_on (f' : β → α) (f : α → β) (s : set α) : Prop :=
 ∀ ⦃x⦄, x ∈ s → f' (f x) = x
 
+@[simp] lemma left_inv_on_empty (f' : β → α) (f : α → β) : left_inv_on f' f ∅ := empty_subset _
+@[simp] lemma left_inv_on_singleton : left_inv_on f' f {a} ↔ f' (f a) = a := singleton_subset_iff
+
 lemma left_inv_on.eq_on (h : left_inv_on f' f s) : eq_on (f' ∘ f) id s := h
 
 lemma left_inv_on.eq (h : left_inv_on f' f s) {x} (hx : x ∈ s) : f' (f x) = x := h hx
@@ -619,6 +820,8 @@ theorem left_inv_on.surj_on (h : left_inv_on f' f s) (hf : maps_to f s t) : surj
 theorem left_inv_on.maps_to (h : left_inv_on f' f s) (hf : surj_on f s t) : maps_to f' t s :=
 λ y hy, let ⟨x, hs, hx⟩ := hf hy in by rwa [← hx, h hs]
 
+lemma left_inv_on_id (s : set α) : left_inv_on id id s := λ a _, rfl
+
 theorem left_inv_on.comp
   (hf' : left_inv_on f' f s) (hg' : left_inv_on g' g t) (hf : maps_to f s t) :
   left_inv_on (f' ∘ g') (g ∘ f) s :=
@@ -660,6 +863,9 @@ theorem left_inv_on.image_image' (hf : left_inv_on f' f s) (hs : s₁ ⊆ s) :
 @[reducible] def right_inv_on (f' : β → α) (f : α → β) (t : set β) : Prop :=
 left_inv_on f f' t
 
+@[simp] lemma right_inv_on_empty (f' : β → α) (f : α → β) : right_inv_on f' f ∅ := empty_subset _
+@[simp] lemma right_inv_on_singleton : right_inv_on f' f {b} ↔ f (f' b) = b := singleton_subset_iff
+
 lemma right_inv_on.eq_on (h : right_inv_on f' f t) : eq_on (f ∘ f') id t := h
 
 lemma right_inv_on.eq (h : right_inv_on f' f t) {y} (hy : y ∈ t) : f (f' y) = y := h hy
@@ -682,6 +888,8 @@ hf.surj_on hf'
 theorem right_inv_on.maps_to (h : right_inv_on f' f t) (hf : surj_on f' t s) : maps_to f s t :=
 h.maps_to hf
 
+lemma right_inv_on_id (s : set α) : right_inv_on id id s := λ a _, rfl
+
 theorem right_inv_on.comp (hf : right_inv_on f' f t) (hg : right_inv_on g' g p)
   (g'pt : maps_to g' p t) : right_inv_on (f' ∘ g') (g ∘ f) p :=
 hg.comp hf g'pt
@@ -710,8 +918,19 @@ theorem surj_on.left_inv_on_of_right_inv_on (hf : surj_on f s t) (hf' : right_in
 def inv_on (g : β → α) (f : α → β) (s : set α) (t : set β) : Prop :=
 left_inv_on g f s ∧ right_inv_on g f t
 
+@[simp] lemma inv_on_empty (f' : β → α) (f : α → β) : inv_on f' f ∅ ∅ := by simp [inv_on]
+@[simp] lemma inv_on_singleton : inv_on f' f {a} {b} ↔ f' (f a) = a ∧ f (f' b) = b :=
+by simp [inv_on]
+
 lemma inv_on.symm (h : inv_on f' f s t) : inv_on f f' t s := ⟨h.right, h.left⟩
 
+lemma inv_on_id (s : set α) : inv_on id id s s := ⟨s.left_inv_on_id, s.right_inv_on_id⟩
+
+lemma inv_on.comp (hf : inv_on f' f s t) (hg : inv_on g' g t p) (fst : maps_to f s t)
+  (g'pt : maps_to g' p t) :
+  inv_on (f' ∘ g') (g ∘ f) s p :=
+⟨hf.1.comp hg.1 fst, hf.2.comp hg.2 g'pt⟩
+
 lemma inv_on.mono (h : inv_on f' f s t) (hs : s₁ ⊆ s) (ht : t₁ ⊆ t) : inv_on f' f s₁ t₁ :=
 ⟨h.1.mono hs, h.2.mono ht⟩
 
@@ -722,6 +941,12 @@ theorem inv_on.bij_on (h : inv_on f' f s t) (hf : maps_to f s t) (hf' : maps_to
   bij_on f s t :=
 ⟨hf, h.left.inj_on, h.right.surj_on hf'⟩
 
+lemma bij_on.symm {g : β → α} (h : inv_on f g t s) (hf : bij_on f s t) : bij_on g t s :=
+⟨h.2.maps_to hf.surj_on, h.1.inj_on, h.2.surj_on hf.maps_to⟩
+
+lemma bij_on_comm {g : β → α} (h : inv_on f g t s) : bij_on f s t ↔ bij_on g t s :=
+⟨bij_on.symm h, bij_on.symm h.symm⟩
+
 end set
 
 /-! ### `inv_fun_on` is a left/right inverse -/
@@ -746,17 +971,21 @@ theorem inv_fun_on_eq (h : ∃a∈s, f a = b) : f (inv_fun_on f s b) = b := (inv
 theorem inv_fun_on_neg (h : ¬ ∃a∈s, f a = b) : inv_fun_on f s b = classical.choice ‹nonempty α› :=
 by rw [bex_def] at h; rw [inv_fun_on, dif_neg h]
 
-end function
+@[simp] theorem inv_fun_on_apply_mem (h : a ∈ s) : inv_fun_on f s (f a) ∈ s :=
+inv_fun_on_mem ⟨a, h, rfl⟩
 
-namespace set
+theorem inv_fun_on_apply_eq (h : a ∈ s) : f (inv_fun_on f s (f a)) = f a :=
+inv_fun_on_eq ⟨a, h, rfl⟩
+
+end function
 open function
 
+namespace set
 variables {s s₁ s₂ : set α} {t : set β} {f : α → β}
 
 theorem inj_on.left_inv_on_inv_fun_on [nonempty α] (h : inj_on f s) :
   left_inv_on (inv_fun_on f s) f s :=
-λ a ha, have ∃a'∈s, f a' = f a, from ⟨a, ha, rfl⟩,
-  h (inv_fun_on_mem this) ha (inv_fun_on_eq this)
+λ a ha, h (inv_fun_on_apply_mem ha) ha (inv_fun_on_apply_eq ha)
 
 lemma inj_on.inv_fun_on_image [nonempty α] (h : inj_on f s₂) (ht : s₁ ⊆ s₂) :
   (inv_fun_on f s₂) '' (f '' s₁) = s₁ :=
@@ -914,7 +1143,7 @@ funext $ λ x, if hx : x ∈ s then by simp [hx] else by simp [hx]
 @[simp] lemma piecewise_range_comp {ι : Sort*} (f : ι → α) [Π j, decidable (j ∈ range f)]
   (g₁ g₂ : α → β) :
   (range f).piecewise g₁ g₂ ∘ f = g₁ ∘ f :=
-comp_eq_of_eq_on_range $ piecewise_eq_on _ _ _
+eq_on.comp_eq $ piecewise_eq_on _ _ _
 
 theorem maps_to.piecewise_ite {s s₁ s₂ : set α} {t t₁ t₂ : set β} {f₁ f₂ : α → β}
   [∀ i, decidable (i ∈ s)]
@@ -979,7 +1208,7 @@ end
 lemma injective_piecewise_iff {f g : α → β} :
   injective (s.piecewise f g) ↔ inj_on f s ∧ inj_on g sᶜ ∧ (∀ (x ∈ s) (y ∉ s), f x ≠ g y) :=
 begin
-  rw [injective_iff_inj_on_univ, ← union_compl_self s, inj_on_union (@disjoint_compl_right _ s _),
+  rw [injective_iff_inj_on_univ, ← union_compl_self s, inj_on_union (@disjoint_compl_right _ _ s),
     (piecewise_eq_on s f g).inj_on_iff, (piecewise_eq_on_compl s f g).inj_on_iff],
   refine and_congr iff.rfl (and_congr iff.rfl $ forall₄_congr $ λ x hx y hy, _),
   rw [piecewise_eq_of_mem s f g hx, piecewise_eq_of_not_mem s f g hy]
@@ -995,7 +1224,7 @@ by { intros i ht, by_cases hs : i ∈ s; simp [hf i ht, hg i ht, hs] }
   pi s (s'.piecewise t t') = pi (s ∩ s') t ∩ pi (s \ s') t' :=
 begin
   ext x,
-  simp only [mem_pi, mem_inter_eq, ← forall_and_distrib],
+  simp only [mem_pi, mem_inter_iff, ← forall_and_distrib],
   refine forall_congr (λ i, _),
   by_cases hi : i ∈ s'; simp *
 end
@@ -1007,6 +1236,8 @@ by simp
 
 end set
 
+open set
+
 lemma strict_mono_on.inj_on [linear_order α] [preorder β] {f : α → β} {s : set α}
   (H : strict_mono_on f s) :
   s.inj_on f :=
@@ -1041,6 +1272,12 @@ lemma strict_anti_on.comp_strict_mono_on [preorder α] [preorder β] [preorder 
   strict_anti_on (g ∘ f) s :=
 λ x hx y hy hxy, hg (hs hx) (hs hy) $ hf hx hy hxy
 
+@[simp] lemma strict_mono_restrict [preorder α] [preorder β] {f : α → β} {s : set α} :
+  strict_mono (s.restrict f) ↔ strict_mono_on f s :=
+by simp [set.restrict, strict_mono, strict_mono_on]
+
+alias strict_mono_restrict ↔ _root_.strict_mono.of_restrict _root_.strict_mono_on.restrict
+
 lemma strict_mono.cod_restrict [preorder α] [preorder β] {f : α → β} (hf : strict_mono f)
   {s : set β} (hs : ∀ x, f x ∈ s) :
   strict_mono (set.cod_restrict f s hs) :=
@@ -1146,4 +1383,85 @@ update_comp_eq_of_not_mem_range' g a h
 
 lemma insert_inj_on (s : set α) : sᶜ.inj_on (λ a, insert a s) := λ a ha b _, (insert_inj ha).1
 
+lemma monotone_on_of_right_inv_on_of_maps_to
+  [partial_order α] [linear_order β] {φ : β → α} {ψ : α → β} {t : set β} {s : set α}
+  (hφ : monotone_on φ t) (φψs : set.right_inv_on ψ φ s) (ψts : set.maps_to ψ s t) :
+  monotone_on ψ s :=
+begin
+  rintro x xs y ys l,
+  rcases le_total (ψ x) (ψ y) with (ψxy|ψyx),
+  { exact ψxy, },
+  { cases le_antisymm l (φψs.eq ys ▸ φψs.eq xs ▸ hφ (ψts ys) (ψts xs) ψyx), refl, },
+end
+
+lemma antitone_on_of_right_inv_on_of_maps_to
+  [partial_order α] [linear_order β] {φ : β → α} {ψ : α → β} {t : set β} {s : set α}
+  (hφ : antitone_on φ t) (φψs : set.right_inv_on ψ φ s) (ψts : set.maps_to ψ s t) :
+  antitone_on ψ s :=
+(monotone_on_of_right_inv_on_of_maps_to hφ.dual_left φψs ψts).dual_right
+
 end function
+
+/-! ### Equivalences, permutations -/
+
+namespace set
+variables {p : β → Prop} [decidable_pred p] {f : α ≃ subtype p} {g g₁ g₂ : perm α} {s t : set α}
+
+protected lemma maps_to.extend_domain (h : maps_to g s t) :
+  maps_to (g.extend_domain f) (coe ∘ f '' s) (coe ∘ f '' t) :=
+by { rintro _ ⟨a, ha, rfl⟩, exact ⟨_, h ha, by rw extend_domain_apply_image⟩ }
+
+protected lemma surj_on.extend_domain (h : surj_on g s t) :
+  surj_on (g.extend_domain f) (coe ∘ f '' s) (coe ∘ f '' t) :=
+begin
+  rintro _ ⟨a, ha, rfl⟩,
+  obtain ⟨b, hb, rfl⟩ := h ha,
+  exact ⟨_, ⟨_, hb, rfl⟩, by rw extend_domain_apply_image⟩,
+end
+
+protected lemma bij_on.extend_domain (h : set.bij_on g s t) :
+  bij_on (g.extend_domain f) (coe ∘ f '' s) (coe ∘ f '' t) :=
+⟨h.maps_to.extend_domain, (g.extend_domain f).injective.inj_on _, h.surj_on.extend_domain⟩
+
+protected lemma left_inv_on.extend_domain (h : left_inv_on g₁ g₂ s) :
+  left_inv_on (g₁.extend_domain f) (g₂.extend_domain f) (coe ∘ f '' s) :=
+by { rintro _ ⟨a, ha, rfl⟩, simp_rw [extend_domain_apply_image, h ha] }
+
+protected lemma right_inv_on.extend_domain (h : right_inv_on g₁ g₂ t) :
+  right_inv_on (g₁.extend_domain f) (g₂.extend_domain f) (coe ∘ f '' t) :=
+by { rintro _ ⟨a, ha, rfl⟩, simp_rw [extend_domain_apply_image, h ha] }
+
+protected lemma inv_on.extend_domain (h : inv_on g₁ g₂ s t) :
+  inv_on (g₁.extend_domain f) (g₂.extend_domain f) (coe ∘ f '' s) (coe ∘ f '' t) :=
+⟨h.1.extend_domain, h.2.extend_domain⟩
+
+end set
+
+namespace equiv
+variables (e : α ≃ β) {s : set α} {t : set β}
+
+lemma bij_on' (h₁ : maps_to e s t) (h₂ : maps_to e.symm t s) : bij_on e s t :=
+⟨h₁, e.injective.inj_on _, λ b hb, ⟨e.symm b, h₂ hb, apply_symm_apply _ _⟩⟩
+
+protected lemma bij_on (h : ∀ a, e a ∈ t ↔ a ∈ s) : bij_on e s t :=
+e.bij_on' (λ a, (h _).2) $ λ b hb, (h _).1 $ by rwa apply_symm_apply
+
+lemma inv_on : inv_on e e.symm t s :=
+⟨e.right_inverse_symm.left_inv_on _, e.left_inverse_symm.left_inv_on _⟩
+
+lemma bij_on_image : bij_on e s (e '' s) := (e.injective.inj_on _).bij_on_image
+lemma bij_on_symm_image : bij_on e.symm (e '' s) s := e.bij_on_image.symm e.inv_on
+
+variables {e}
+
+@[simp] lemma bij_on_symm : bij_on e.symm t s ↔ bij_on e s t := bij_on_comm e.symm.inv_on
+
+alias bij_on_symm ↔ _root_.set.bij_on.of_equiv_symm _root_.set.bij_on.equiv_symm
+
+variables [decidable_eq α] {a b : α}
+
+lemma bij_on_swap (ha : a ∈ s) (hb : b ∈ s) : bij_on (swap a b) s s :=
+(swap a b).bij_on $ λ x, by obtain rfl | hxa := eq_or_ne x a; obtain rfl | hxb := eq_or_ne x b;
+  simp [*, swap_apply_of_ne_of_ne]
+
+end equiv
diff --git a/src/data/set/functor.lean b/src/data/set/functor.lean
index 99ed7e314045f..a4ae66503ca4d 100644
--- a/src/data/set/functor.lean
+++ b/src/data/set/functor.lean
@@ -8,6 +8,9 @@ import data.set.lattice
 /-!
 # Functoriality of `set`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the functor structure of `set`.
 -/
 
@@ -29,15 +32,19 @@ instance : monad.{u} set :=
 @[simp] lemma seq_eq_set_seq (s : set (α → β)) (t : set α) : s <*> t = s.seq t := rfl
 @[simp] lemma pure_def (a : α) : (pure a : set α) = {a} := rfl
 
+/-- `set.image2` in terms of monadic operations. Note that this can't be taken as the definition
+because of the lack of universe polymorphism. -/
+lemma image2_def {α β γ : Type*} (f : α → β → γ) (s : set α) (t : set β) :
+  image2 f s t = f <$> s <*> t :=
+by { ext, simp }
+
 instance : is_lawful_monad set :=
-{ pure_bind             := λ α β x f, by simp,
-  bind_assoc            := λ α β γ s f g, set.ext $ λ a,
-    by simp [exists_and_distrib_right.symm, -exists_and_distrib_right,
-             exists_and_distrib_left.symm, -exists_and_distrib_left, and_assoc];
-       exact exists_swap,
-  id_map                := λ α, id_map,
-  bind_pure_comp_eq_map := λ α β f s, set.ext $ by simp [set.image, eq_comm],
-  bind_map_eq_seq       := λ α β s t, by simp [seq_def] }
+{ id_map                := λ α, image_id,
+  comp_map              := λ α β γ f g s, image_comp _ _ _,
+  pure_bind             := λ α β, bUnion_singleton,
+  bind_assoc            := λ α β γ s f g, by simp only [bind_def, bUnion_Union],
+  bind_pure_comp_eq_map := λ α β f s, (image_eq_Union _ _).symm,
+  bind_map_eq_seq       := λ α β s t, seq_def.symm }
 
 instance : is_comm_applicative (set : Type u → Type u) :=
 ⟨ λ α β s t, prod_image_seq_comm s t ⟩
diff --git a/src/data/set/image.lean b/src/data/set/image.lean
new file mode 100644
index 0000000000000..9b00e12e92842
--- /dev/null
+++ b/src/data/set/image.lean
@@ -0,0 +1,1248 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Leonardo de Moura
+-/
+import data.set.basic
+
+/-!
+# Images and preimages of sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `preimage f t : set α` : the preimage f⁻¹(t) (written `f ⁻¹' t` in Lean) of a subset of β.
+
+* `range f : set β` : the image of `univ` under `f`.
+  Also works for `{p : Prop} (f : p → α)` (unlike `image`)
+
+## Notation
+
+* `f ⁻¹' t` for `set.preimage f t`
+
+* `f '' s` for `set.image f s`
+
+## Tags
+
+set, sets, image, preimage, pre-image, range
+
+-/
+
+open function set
+
+universes u v
+variables {α β γ : Type*} {ι ι' : Sort*}
+
+namespace set
+
+/-! ### Inverse image -/
+
+/-- The preimage of `s : set β` by `f : α → β`, written `f ⁻¹' s`,
+  is the set of `x : α` such that `f x ∈ s`. -/
+def preimage {α : Type u} {β : Type v} (f : α → β) (s : set β) : set α := {x | f x ∈ s}
+
+infix ` ⁻¹' `:80 := preimage
+
+section preimage
+variables {f : α → β} {g : β → γ}
+
+@[simp] theorem preimage_empty : f ⁻¹' ∅ = ∅ := rfl
+
+@[simp, mfld_simps] theorem mem_preimage {s : set β} {a : α} : (a ∈ f ⁻¹' s) ↔ (f a ∈ s) := iff.rfl
+
+lemma preimage_congr {f g : α → β} {s : set β} (h : ∀ (x : α), f x = g x) : f ⁻¹' s = g ⁻¹' s :=
+by { congr' with x, apply_assumption }
+
+theorem preimage_mono {s t : set β} (h : s ⊆ t) : f ⁻¹' s ⊆ f ⁻¹' t :=
+assume x hx, h hx
+
+@[simp, mfld_simps] theorem preimage_univ : f ⁻¹' univ = univ := rfl
+
+theorem subset_preimage_univ {s : set α} : s ⊆ f ⁻¹' univ := subset_univ _
+
+@[simp, mfld_simps] theorem preimage_inter {s t : set β} : f ⁻¹' (s ∩ t) = f ⁻¹' s ∩ f ⁻¹' t := rfl
+
+@[simp] theorem preimage_union {s t : set β} : f ⁻¹' (s ∪ t) = f ⁻¹' s ∪ f ⁻¹' t := rfl
+
+@[simp] theorem preimage_compl {s : set β} : f ⁻¹' sᶜ = (f ⁻¹' s)ᶜ := rfl
+
+@[simp] theorem preimage_diff (f : α → β) (s t : set β) :
+  f ⁻¹' (s \ t) = f ⁻¹' s \ f ⁻¹' t := rfl
+
+@[simp] lemma preimage_symm_diff (f : α → β) (s t : set β) :
+  f ⁻¹' (s ∆ t) = (f ⁻¹' s) ∆ (f ⁻¹' t) := rfl
+
+@[simp] theorem preimage_ite (f : α → β) (s t₁ t₂ : set β) :
+  f ⁻¹' (s.ite t₁ t₂) = (f ⁻¹' s).ite (f ⁻¹' t₁) (f ⁻¹' t₂) :=
+rfl
+
+@[simp] theorem preimage_set_of_eq {p : α → Prop} {f : β → α} : f ⁻¹' {a | p a} = {a | p (f a)} :=
+rfl
+
+@[simp] lemma preimage_id_eq : preimage (id : α → α) = id := rfl
+
+@[mfld_simps] theorem preimage_id {s : set α} : id ⁻¹' s = s := rfl
+
+@[simp] theorem preimage_id' {s : set α} : (λ x, x) ⁻¹' s = s := rfl
+
+@[simp] theorem preimage_const_of_mem {b : β} {s : set β} (h : b ∈ s) :
+  (λ (x : α), b) ⁻¹' s = univ :=
+eq_univ_of_forall $ λ x, h
+
+@[simp] theorem preimage_const_of_not_mem {b : β} {s : set β} (h : b ∉ s) :
+  (λ (x : α), b) ⁻¹' s = ∅ :=
+eq_empty_of_subset_empty $ λ x hx, h hx
+
+theorem preimage_const (b : β) (s : set β) [decidable (b ∈ s)] :
+  (λ (x : α), b) ⁻¹' s = if b ∈ s then univ else ∅ :=
+by { split_ifs with hb hb, exacts [preimage_const_of_mem hb, preimage_const_of_not_mem hb] }
+
+theorem preimage_comp {s : set γ} : (g ∘ f) ⁻¹' s = f ⁻¹' (g ⁻¹' s) := rfl
+
+lemma preimage_comp_eq : preimage (g ∘ f) = preimage f ∘ preimage g := rfl
+
+@[simp] lemma preimage_iterate_eq {f : α → α} {n : ℕ} :
+  set.preimage (f^[n]) = ((set.preimage f)^[n]) :=
+begin
+  induction n with n ih, { simp, },
+  rw [iterate_succ, iterate_succ', set.preimage_comp_eq, ih],
+end
+
+lemma preimage_preimage {g : β → γ} {f : α → β} {s : set γ} :
+  f ⁻¹' (g ⁻¹' s) = (λ x, g (f x)) ⁻¹' s :=
+preimage_comp.symm
+
+theorem eq_preimage_subtype_val_iff {p : α → Prop} {s : set (subtype p)} {t : set α} :
+  s = subtype.val ⁻¹' t ↔ (∀x (h : p x), (⟨x, h⟩ : subtype p) ∈ s ↔ x ∈ t) :=
+⟨assume s_eq x h, by { rw [s_eq], simp },
+ assume h, ext $ λ ⟨x, hx⟩, by simp [h]⟩
+
+lemma nonempty_of_nonempty_preimage {s : set β} {f : α → β} (hf : (f ⁻¹' s).nonempty) :
+  s.nonempty :=
+let ⟨x, hx⟩ := hf in ⟨f x, hx⟩
+
+@[simp] lemma preimage_singleton_true (p : α → Prop) : p ⁻¹' {true} = {a | p a} := by { ext, simp }
+@[simp] lemma preimage_singleton_false (p : α → Prop) : p ⁻¹' {false} = {a | ¬ p a} :=
+by { ext, simp }
+
+lemma preimage_subtype_coe_eq_compl {α : Type*} {s u v : set α} (hsuv : s ⊆ u ∪ v)
+  (H : s ∩ (u ∩ v) = ∅) : (coe : s → α) ⁻¹' u = (coe ⁻¹' v)ᶜ :=
+begin
+  ext ⟨x, x_in_s⟩,
+  split,
+  { intros x_in_u x_in_v,
+    exact eq_empty_iff_forall_not_mem.mp H x ⟨x_in_s, ⟨x_in_u, x_in_v⟩⟩ },
+  { intro hx,
+    exact or.elim (hsuv x_in_s) id (λ hx', hx.elim hx') }
+end
+
+end preimage
+
+/-! ### Image of a set under a function -/
+
+section image
+variables {f : α → β} {s t : set α}
+
+/-- The image of `s : set α` by `f : α → β`, written `f '' s`,
+  is the set of `y : β` such that `f x = y` for some `x ∈ s`. -/
+def image (f : α → β) (s : set α) : set β := {y | ∃ x, x ∈ s ∧ f x = y}
+
+infix ` '' `:80 := image
+
+theorem mem_image_iff_bex {f : α → β} {s : set α} {y : β} :
+  y ∈ f '' s ↔ ∃ x (_ : x ∈ s), f x = y := bex_def.symm
+
+@[simp] theorem mem_image (f : α → β) (s : set α) (y : β) :
+  y ∈ f '' s ↔ ∃ x, x ∈ s ∧ f x = y := iff.rfl
+
+lemma image_eta (f : α → β) : f '' s = (λ x, f x) '' s := rfl
+
+@[mfld_simps]
+theorem mem_image_of_mem (f : α → β) {x : α} {a : set α} (h : x ∈ a) : f x ∈ f '' a :=
+⟨_, h, rfl⟩
+
+theorem _root_.function.injective.mem_set_image {f : α → β} (hf : injective f) {s : set α} {a : α} :
+  f a ∈ f '' s ↔ a ∈ s :=
+⟨λ ⟨b, hb, eq⟩, (hf eq) ▸ hb, mem_image_of_mem f⟩
+
+theorem ball_image_iff {f : α → β} {s : set α} {p : β → Prop} :
+  (∀ y ∈ f '' s, p y) ↔ (∀ x ∈ s, p (f x)) :=
+by simp
+
+theorem ball_image_of_ball {f : α → β} {s : set α} {p : β → Prop}
+  (h : ∀ x ∈ s, p (f x)) : ∀ y ∈ f '' s, p y :=
+ball_image_iff.2 h
+
+theorem bex_image_iff {f : α → β} {s : set α} {p : β → Prop} :
+  (∃ y ∈ f '' s, p y) ↔ (∃ x ∈ s, p (f x)) :=
+by simp
+
+theorem mem_image_elim {f : α → β} {s : set α} {C : β → Prop} (h : ∀ (x : α), x ∈ s → C (f x)) :
+ ∀{y : β}, y ∈ f '' s → C y
+| ._ ⟨a, a_in, rfl⟩ := h a a_in
+
+theorem mem_image_elim_on {f : α → β} {s : set α} {C : β → Prop} {y : β} (h_y : y ∈ f '' s)
+  (h : ∀ (x : α), x ∈ s → C (f x)) : C y :=
+mem_image_elim h h_y
+
+@[congr] lemma image_congr {f g : α → β} {s : set α}
+  (h : ∀a∈s, f a = g a) : f '' s = g '' s :=
+by safe [ext_iff, iff_def]
+
+/-- A common special case of `image_congr` -/
+lemma image_congr' {f g : α → β} {s : set α} (h : ∀ (x : α), f x = g x) : f '' s = g '' s :=
+image_congr (λx _, h x)
+
+theorem image_comp (f : β → γ) (g : α → β) (a : set α) : (f ∘ g) '' a = f '' (g '' a) :=
+subset.antisymm
+  (ball_image_of_ball $ assume a ha, mem_image_of_mem _ $ mem_image_of_mem _ ha)
+  (ball_image_of_ball $ ball_image_of_ball $ assume a ha, mem_image_of_mem _ ha)
+
+/-- A variant of `image_comp`, useful for rewriting -/
+lemma image_image (g : β → γ) (f : α → β) (s : set α) : g '' (f '' s) = (λ x, g (f x)) '' s :=
+(image_comp g f s).symm
+
+lemma image_comm {β'} {f : β → γ} {g : α → β} {f' : α → β'} {g' : β' → γ}
+  (h_comm : ∀ a, f (g a) = g' (f' a)) :
+  (s.image g).image f = (s.image f').image g' :=
+by simp_rw [image_image, h_comm]
+
+lemma _root_.function.semiconj.set_image {f : α → β} {ga : α → α} {gb : β → β}
+  (h : function.semiconj f ga gb) :
+  function.semiconj (image f) (image ga) (image gb) :=
+λ s, image_comm h
+
+lemma _root_.function.commute.set_image {f g : α → α} (h : function.commute f g) :
+  function.commute (image f) (image g) :=
+h.set_image
+
+/-- Image is monotone with respect to `⊆`. See `set.monotone_image` for the statement in
+terms of `≤`. -/
+theorem image_subset {a b : set α} (f : α → β) (h : a ⊆ b) : f '' a ⊆ f '' b :=
+by { simp only [subset_def, mem_image], exact λ x, λ ⟨w, h1, h2⟩, ⟨w, h h1, h2⟩ }
+
+/-- `set.image` is monotone. See `set.image_subset` for the statement in terms of `⊆`. -/
+lemma monotone_image {f : α → β} : monotone (image f) :=
+λ s t, image_subset _
+
+theorem image_union (f : α → β) (s t : set α) :
+  f '' (s ∪ t) = f '' s ∪ f '' t :=
+ext $ λ x, ⟨by rintro ⟨a, h|h, rfl⟩; [left, right]; exact ⟨_, h, rfl⟩,
+  by rintro (⟨a, h, rfl⟩ | ⟨a, h, rfl⟩); refine ⟨_, _, rfl⟩; [left, right]; exact h⟩
+
+@[simp] theorem image_empty (f : α → β) : f '' ∅ = ∅ := by { ext, simp }
+
+lemma image_inter_subset (f : α → β) (s t : set α) :
+  f '' (s ∩ t) ⊆ f '' s ∩ f '' t :=
+subset_inter (image_subset _ $ inter_subset_left _ _) (image_subset _ $ inter_subset_right _ _)
+
+theorem image_inter_on {f : α → β} {s t : set α} (h : ∀x∈t, ∀y∈s, f x = f y → x = y) :
+  f '' (s ∩ t) = f '' s ∩ f '' t :=
+(image_inter_subset _ _ _).antisymm
+  (assume b ⟨⟨a₁, ha₁, h₁⟩, ⟨a₂, ha₂, h₂⟩⟩,
+    have a₂ = a₁, from h _ ha₂ _ ha₁ (by simp *),
+    ⟨a₁, ⟨ha₁, this ▸ ha₂⟩, h₁⟩)
+
+
+theorem image_inter {f : α → β} {s t : set α} (H : injective f) :
+  f '' (s ∩ t) = f '' s ∩ f '' t :=
+image_inter_on (assume x _ y _ h, H h)
+
+theorem image_univ_of_surjective {ι : Type*} {f : ι → β} (H : surjective f) : f '' univ = univ :=
+eq_univ_of_forall $ by { simpa [image] }
+
+@[simp] theorem image_singleton {f : α → β} {a : α} : f '' {a} = {f a} :=
+by { ext, simp [image, eq_comm] }
+
+@[simp] theorem nonempty.image_const {s : set α} (hs : s.nonempty) (a : β) : (λ _, a) '' s = {a} :=
+ext $ λ x, ⟨λ ⟨y, _, h⟩, h ▸ mem_singleton _,
+  λ h, (eq_of_mem_singleton h).symm ▸ hs.imp (λ y hy, ⟨hy, rfl⟩)⟩
+
+@[simp, mfld_simps]
+lemma image_eq_empty {α β} {f : α → β} {s : set α} : f '' s = ∅ ↔ s = ∅ :=
+by { simp only [eq_empty_iff_forall_not_mem],
+     exact ⟨λ H a ha, H _ ⟨_, ha, rfl⟩, λ H b ⟨_, ha, _⟩, H _ ha⟩ }
+
+lemma preimage_compl_eq_image_compl [boolean_algebra α] (S : set α) :
+  compl ⁻¹' S = compl '' S :=
+set.ext (λ x, ⟨λ h, ⟨xᶜ,h, compl_compl x⟩,
+  λ h, exists.elim h (λ y hy, (compl_eq_comm.mp hy.2).symm.subst hy.1)⟩)
+
+theorem mem_compl_image [boolean_algebra α] (t : α) (S : set α) :
+  t ∈ compl '' S ↔ tᶜ ∈ S :=
+by simp [←preimage_compl_eq_image_compl]
+
+/-- A variant of `image_id` -/
+@[simp] lemma image_id' (s : set α) : (λx, x) '' s = s := by { ext, simp }
+
+theorem image_id (s : set α) : id '' s = s := by simp
+
+theorem compl_compl_image [boolean_algebra α] (S : set α) :
+  compl '' (compl '' S) = S :=
+by rw [←image_comp, compl_comp_compl, image_id]
+
+theorem image_insert_eq {f : α → β} {a : α} {s : set α} :
+  f '' (insert a s) = insert (f a) (f '' s) :=
+by { ext, simp [and_or_distrib_left, exists_or_distrib, eq_comm, or_comm, and_comm] }
+
+theorem image_pair (f : α → β) (a b : α) : f '' {a, b} = {f a, f b} :=
+by simp only [image_insert_eq, image_singleton]
+
+theorem image_subset_preimage_of_inverse {f : α → β} {g : β → α}
+  (I : left_inverse g f) (s : set α) : f '' s ⊆ g ⁻¹' s :=
+λ b ⟨a, h, e⟩, e ▸ ((I a).symm ▸ h : g (f a) ∈ s)
+
+theorem preimage_subset_image_of_inverse {f : α → β} {g : β → α}
+  (I : left_inverse g f) (s : set β) : f ⁻¹' s ⊆ g '' s :=
+λ b h, ⟨f b, h, I b⟩
+
+theorem image_eq_preimage_of_inverse {f : α → β} {g : β → α}
+  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
+  image f = preimage g :=
+funext $ λ s, subset.antisymm
+  (image_subset_preimage_of_inverse h₁ s)
+  (preimage_subset_image_of_inverse h₂ s)
+
+theorem mem_image_iff_of_inverse {f : α → β} {g : β → α} {b : β} {s : set α}
+  (h₁ : left_inverse g f) (h₂ : right_inverse g f) :
+  b ∈ f '' s ↔ g b ∈ s :=
+by rw image_eq_preimage_of_inverse h₁ h₂; refl
+
+theorem image_compl_subset {f : α → β} {s : set α} (H : injective f) : f '' sᶜ ⊆ (f '' s)ᶜ :=
+disjoint.subset_compl_left $ by simp [disjoint_iff_inf_le, ←image_inter H]
+
+theorem subset_image_compl {f : α → β} {s : set α} (H : surjective f) : (f '' s)ᶜ ⊆ f '' sᶜ :=
+compl_subset_iff_union.2 $
+by { rw ← image_union, simp [image_univ_of_surjective H] }
+
+theorem image_compl_eq {f : α → β} {s : set α} (H : bijective f) : f '' sᶜ = (f '' s)ᶜ :=
+subset.antisymm (image_compl_subset H.1) (subset_image_compl H.2)
+
+theorem subset_image_diff (f : α → β) (s t : set α) :
+  f '' s \ f '' t ⊆ f '' (s \ t) :=
+begin
+  rw [diff_subset_iff, ← image_union, union_diff_self],
+  exact image_subset f (subset_union_right t s)
+end
+
+lemma subset_image_symm_diff : (f '' s) ∆ (f '' t) ⊆ f '' s ∆ t :=
+(union_subset_union (subset_image_diff _ _ _) $ subset_image_diff _ _ _).trans
+  (image_union _ _ _).superset
+
+theorem image_diff {f : α → β} (hf : injective f) (s t : set α) :
+  f '' (s \ t) = f '' s \ f '' t :=
+subset.antisymm
+  (subset.trans (image_inter_subset _ _ _) $ inter_subset_inter_right _ $ image_compl_subset hf)
+  (subset_image_diff f s t)
+
+lemma image_symm_diff (hf : injective f) (s t : set α) : f '' (s ∆ t) = (f '' s) ∆ (f '' t) :=
+by simp_rw [set.symm_diff_def, image_union, image_diff hf]
+
+lemma nonempty.image (f : α → β) {s : set α} : s.nonempty → (f '' s).nonempty
+| ⟨x, hx⟩ := ⟨f x, mem_image_of_mem f hx⟩
+
+lemma nonempty.of_image {f : α → β} {s : set α} : (f '' s).nonempty → s.nonempty
+| ⟨y, x, hx, _⟩ := ⟨x, hx⟩
+
+@[simp] lemma nonempty_image_iff {f : α → β} {s : set α} :
+  (f '' s).nonempty ↔ s.nonempty :=
+⟨nonempty.of_image, λ h, h.image f⟩
+
+lemma nonempty.preimage {s : set β} (hs : s.nonempty) {f : α → β} (hf : surjective f) :
+  (f ⁻¹' s).nonempty :=
+let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf y in ⟨x, mem_preimage.2 $ hx.symm ▸ hy⟩
+
+instance (f : α → β) (s : set α) [nonempty s] : nonempty (f '' s) :=
+(set.nonempty.image f nonempty_of_nonempty_subtype).to_subtype
+
+/-- image and preimage are a Galois connection -/
+@[simp] theorem image_subset_iff {s : set α} {t : set β} {f : α → β} :
+  f '' s ⊆ t ↔ s ⊆ f ⁻¹' t :=
+ball_image_iff
+
+theorem image_preimage_subset (f : α → β) (s : set β) : f '' (f ⁻¹' s) ⊆ s :=
+image_subset_iff.2 subset.rfl
+
+theorem subset_preimage_image (f : α → β) (s : set α) :
+  s ⊆ f ⁻¹' (f '' s) :=
+λ x, mem_image_of_mem f
+
+theorem preimage_image_eq {f : α → β} (s : set α) (h : injective f) : f ⁻¹' (f '' s) = s :=
+subset.antisymm
+  (λ x ⟨y, hy, e⟩, h e ▸ hy)
+  (subset_preimage_image f s)
+
+theorem image_preimage_eq {f : α → β} (s : set β) (h : surjective f) : f '' (f ⁻¹' s) = s :=
+subset.antisymm
+  (image_preimage_subset f s)
+  (λ x hx, let ⟨y, e⟩ := h x in ⟨y, (e.symm ▸ hx : f y ∈ s), e⟩)
+
+lemma preimage_eq_preimage {f : β → α} (hf : surjective f) : f ⁻¹' s = f ⁻¹' t ↔ s = t :=
+iff.intro
+  (assume eq, by rw [← image_preimage_eq s hf, ← image_preimage_eq t hf, eq])
+  (assume eq, eq ▸ rfl)
+
+lemma image_inter_preimage (f : α → β) (s : set α) (t : set β) :
+  f '' (s ∩ f ⁻¹' t) = f '' s ∩ t :=
+begin
+  apply subset.antisymm,
+  { calc f '' (s ∩ f ⁻¹' t) ⊆ f '' s ∩ (f '' (f⁻¹' t)) : image_inter_subset _ _ _
+  ... ⊆ f '' s ∩ t : inter_subset_inter_right _ (image_preimage_subset f t) },
+  { rintros _ ⟨⟨x, h', rfl⟩, h⟩,
+    exact ⟨x, ⟨h', h⟩, rfl⟩ }
+end
+
+lemma image_preimage_inter (f : α → β) (s : set α) (t : set β) :
+  f '' (f ⁻¹' t ∩ s) = t ∩ f '' s :=
+by simp only [inter_comm, image_inter_preimage]
+
+@[simp] lemma image_inter_nonempty_iff {f : α → β} {s : set α} {t : set β} :
+  (f '' s ∩ t).nonempty ↔ (s ∩ f ⁻¹' t).nonempty :=
+by rw [←image_inter_preimage, nonempty_image_iff]
+
+lemma image_diff_preimage {f : α → β} {s : set α} {t : set β} : f '' (s \ f ⁻¹' t) = f '' s \ t :=
+by simp_rw [diff_eq, ← preimage_compl, image_inter_preimage]
+
+theorem compl_image : image (compl : set α → set α) = preimage compl :=
+image_eq_preimage_of_inverse compl_compl compl_compl
+
+theorem compl_image_set_of {p : set α → Prop} :
+  compl '' {s | p s} = {s | p sᶜ} :=
+congr_fun compl_image p
+
+theorem inter_preimage_subset (s : set α) (t : set β) (f : α → β) :
+  s ∩ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∩ t) :=
+λ x h, ⟨mem_image_of_mem _ h.left, h.right⟩
+
+theorem union_preimage_subset (s : set α) (t : set β) (f : α → β) :
+  s ∪ f ⁻¹' t ⊆ f ⁻¹' (f '' s ∪ t) :=
+λ x h, or.elim h (λ l, or.inl $ mem_image_of_mem _ l) (λ r, or.inr r)
+
+theorem subset_image_union (f : α → β) (s : set α) (t : set β) :
+  f '' (s ∪ f ⁻¹' t) ⊆ f '' s ∪ t :=
+image_subset_iff.2 (union_preimage_subset _ _ _)
+
+lemma preimage_subset_iff {A : set α} {B : set β} {f : α → β} :
+  f⁻¹' B ⊆ A ↔ (∀ a : α, f a ∈ B → a ∈ A) := iff.rfl
+
+lemma image_eq_image {f : α → β} (hf : injective f) : f '' s = f '' t ↔ s = t :=
+iff.symm $ iff.intro (assume eq, eq ▸ rfl) $ assume eq,
+  by rw [← preimage_image_eq s hf, ← preimage_image_eq t hf, eq]
+
+lemma image_subset_image_iff {f : α → β} (hf : injective f) : f '' s ⊆ f '' t ↔ s ⊆ t :=
+begin
+  refine (iff.symm $ iff.intro (image_subset f) $ assume h, _),
+  rw [← preimage_image_eq s hf, ← preimage_image_eq t hf],
+  exact preimage_mono h
+end
+
+lemma prod_quotient_preimage_eq_image [s : setoid α] (g : quotient s → β) {h : α → β}
+  (Hh : h = g ∘ quotient.mk) (r : set (β × β)) :
+  {x : quotient s × quotient s | (g x.1, g x.2) ∈ r} =
+  (λ a : α × α, (⟦a.1⟧, ⟦a.2⟧)) '' ((λ a : α × α, (h a.1, h a.2)) ⁻¹' r) :=
+Hh.symm ▸ set.ext (λ ⟨a₁, a₂⟩, ⟨quotient.induction_on₂ a₁ a₂
+  (λ a₁ a₂ h, ⟨(a₁, a₂), h, rfl⟩),
+  λ ⟨⟨b₁, b₂⟩, h₁, h₂⟩, show (g a₁, g a₂) ∈ r, from
+  have h₃ : ⟦b₁⟧ = a₁ ∧ ⟦b₂⟧ = a₂ := prod.ext_iff.1 h₂,
+    h₃.1 ▸ h₃.2 ▸ h₁⟩)
+
+lemma exists_image_iff (f : α → β) (x : set α) (P : β → Prop) :
+  (∃ (a : f '' x), P a) ↔ ∃ (a : x), P (f a) :=
+⟨λ ⟨a, h⟩, ⟨⟨_, a.prop.some_spec.1⟩, a.prop.some_spec.2.symm ▸ h⟩,
+  λ ⟨a, h⟩, ⟨⟨_, _, a.prop, rfl⟩, h⟩⟩
+
+/-- Restriction of `f` to `s` factors through `s.image_factorization f : s → f '' s`. -/
+def image_factorization (f : α → β) (s : set α) : s → f '' s :=
+λ p, ⟨f p.1, mem_image_of_mem f p.2⟩
+
+lemma image_factorization_eq {f : α → β} {s : set α} :
+  subtype.val ∘ image_factorization f s = f ∘ subtype.val :=
+funext $ λ p, rfl
+
+lemma surjective_onto_image {f : α → β} {s : set α} :
+  surjective (image_factorization f s) :=
+λ ⟨_, ⟨a, ha, rfl⟩⟩, ⟨⟨a, ha⟩, rfl⟩
+
+/-- If the only elements outside `s` are those left fixed by `σ`, then mapping by `σ` has no effect.
+-/
+lemma image_perm {s : set α} {σ : equiv.perm α} (hs : {a : α | σ a ≠ a} ⊆ s) : σ '' s = s :=
+begin
+  ext i,
+  obtain hi | hi := eq_or_ne (σ i) i,
+  { refine ⟨_, λ h, ⟨i, h, hi⟩⟩,
+    rintro ⟨j, hj, h⟩,
+    rwa σ.injective (hi.trans h.symm) },
+  { refine iff_of_true ⟨σ.symm i, hs $ λ h, hi _, σ.apply_symm_apply _⟩ (hs hi),
+    convert congr_arg σ h; exact (σ.apply_symm_apply _).symm }
+end
+
+end image
+
+/-! ### Lemmas about the powerset and image. -/
+
+/-- The powerset of `{a} ∪ s` is `𝒫 s` together with `{a} ∪ t` for each `t ∈ 𝒫 s`. -/
+theorem powerset_insert (s : set α) (a : α) :
+  𝒫 (insert a s) = 𝒫 s ∪ (insert a '' 𝒫 s) :=
+begin
+  ext t,
+  simp_rw [mem_union, mem_image, mem_powerset_iff],
+  split,
+  { intro h,
+    by_cases hs : a ∈ t,
+    { right,
+      refine ⟨t \ {a}, _, _⟩,
+      { rw [diff_singleton_subset_iff],
+        assumption },
+      { rw [insert_diff_singleton, insert_eq_of_mem hs] }},
+    { left,
+      exact (subset_insert_iff_of_not_mem hs).mp h}},
+  { rintros (h | ⟨s', h₁, rfl⟩),
+    { exact subset_trans h (subset_insert a s) },
+    { exact insert_subset_insert h₁ }}
+end
+
+/-! ### Lemmas about range of a function. -/
+section range
+variables {f : ι → α} {s t : set α}
+
+/-- Range of a function.
+
+This function is more flexible than `f '' univ`, as the image requires that the domain is in Type
+and not an arbitrary Sort. -/
+def range (f : ι → α) : set α := {x | ∃y, f y = x}
+
+@[simp] theorem mem_range {x : α} : x ∈ range f ↔ ∃ y, f y = x := iff.rfl
+
+@[simp, mfld_simps] theorem mem_range_self (i : ι) : f i ∈ range f := ⟨i, rfl⟩
+
+theorem forall_range_iff {p : α → Prop} : (∀ a ∈ range f, p a) ↔ (∀ i, p (f i)) :=
+by simp
+
+theorem forall_subtype_range_iff {p : range f → Prop} :
+  (∀ a : range f, p a) ↔ ∀ i, p ⟨f i, mem_range_self _⟩ :=
+⟨λ H i, H _, λ H ⟨y, i, hi⟩, by { subst hi, apply H }⟩
+
+theorem exists_range_iff {p : α → Prop} : (∃ a ∈ range f, p a) ↔ (∃ i, p (f i)) :=
+by simp
+
+lemma exists_range_iff' {p : α → Prop} :
+  (∃ a, a ∈ range f ∧ p a) ↔ ∃ i, p (f i) :=
+by simpa only [exists_prop] using exists_range_iff
+
+lemma exists_subtype_range_iff {p : range f → Prop} :
+  (∃ a : range f, p a) ↔ ∃ i, p ⟨f i, mem_range_self _⟩ :=
+⟨λ ⟨⟨a, i, hi⟩, ha⟩, by { subst a, exact ⟨i, ha⟩}, λ ⟨i, hi⟩, ⟨_, hi⟩⟩
+
+theorem range_iff_surjective : range f = univ ↔ surjective f :=
+eq_univ_iff_forall
+
+alias range_iff_surjective ↔ _ _root_.function.surjective.range_eq
+
+@[simp] theorem image_univ {f : α → β} : f '' univ = range f :=
+by { ext, simp [image, range] }
+
+theorem image_subset_range (f : α → β) (s) : f '' s ⊆ range f :=
+by rw ← image_univ; exact image_subset _ (subset_univ _)
+
+theorem mem_range_of_mem_image (f : α → β) (s) {x : β} (h : x ∈ f '' s) : x ∈ range f :=
+image_subset_range f s h
+
+lemma _root_.nat.mem_range_succ (i : ℕ) : i ∈ range nat.succ ↔ 0 < i :=
+⟨by { rintros ⟨n, rfl⟩, exact nat.succ_pos n, }, λ h, ⟨_, nat.succ_pred_eq_of_pos h⟩⟩
+
+lemma nonempty.preimage' {s : set β} (hs : s.nonempty) {f : α → β} (hf : s ⊆ set.range f) :
+  (f ⁻¹' s).nonempty :=
+let ⟨y, hy⟩ := hs, ⟨x, hx⟩ := hf hy in ⟨x, set.mem_preimage.2 $ hx.symm ▸ hy⟩
+
+theorem range_comp (g : α → β) (f : ι → α) : range (g ∘ f) = g '' range f :=
+subset.antisymm
+  (forall_range_iff.mpr $ assume i, mem_image_of_mem g (mem_range_self _))
+  (ball_image_iff.mpr $ forall_range_iff.mpr mem_range_self)
+
+theorem range_subset_iff : range f ⊆ s ↔ ∀ y, f y ∈ s :=
+forall_range_iff
+
+theorem range_eq_iff (f : α → β) (s : set β) :
+  range f = s ↔ (∀ a, f a ∈ s) ∧ ∀ b ∈ s, ∃ a, f a = b :=
+by { rw ←range_subset_iff, exact le_antisymm_iff }
+
+lemma range_comp_subset_range (f : α → β) (g : β → γ) : range (g ∘ f) ⊆ range g :=
+by rw range_comp; apply image_subset_range
+
+lemma range_nonempty_iff_nonempty : (range f).nonempty ↔ nonempty ι :=
+⟨λ ⟨y, x, hxy⟩, ⟨x⟩, λ ⟨x⟩, ⟨f x, mem_range_self x⟩⟩
+
+lemma range_nonempty [h : nonempty ι] (f : ι → α) : (range f).nonempty :=
+range_nonempty_iff_nonempty.2 h
+
+@[simp] lemma range_eq_empty_iff {f : ι → α} : range f = ∅ ↔ is_empty ι :=
+by rw [← not_nonempty_iff, ← range_nonempty_iff_nonempty, not_nonempty_iff_eq_empty]
+
+lemma range_eq_empty [is_empty ι] (f : ι → α) : range f = ∅ := range_eq_empty_iff.2 ‹_›
+
+instance [nonempty ι] (f : ι → α) : nonempty (range f) := (range_nonempty f).to_subtype
+
+@[simp] lemma image_union_image_compl_eq_range (f : α → β) :
+  (f '' s) ∪ (f '' sᶜ) = range f :=
+by rw [← image_union, ← image_univ, ← union_compl_self]
+
+lemma insert_image_compl_eq_range (f : α → β) (x : α) :
+  insert (f x) (f '' {x}ᶜ) = range f :=
+begin
+  ext y, rw [mem_range, mem_insert_iff, mem_image],
+  split,
+  { rintro (h | ⟨x', hx', h⟩),
+    { exact ⟨x, h.symm⟩ },
+    { exact ⟨x', h⟩ } },
+  { rintro ⟨x', h⟩,
+    by_cases hx : x' = x,
+    { left, rw [← h, hx] },
+    { right, refine ⟨_, _, h⟩, rw mem_compl_singleton_iff, exact hx } }
+end
+
+theorem image_preimage_eq_inter_range {f : α → β} {t : set β} :
+  f '' (f ⁻¹' t) = t ∩ range f :=
+ext $ assume x, ⟨assume ⟨x, hx, heq⟩, heq ▸ ⟨hx, mem_range_self _⟩,
+  assume ⟨hx, ⟨y, h_eq⟩⟩, h_eq ▸ mem_image_of_mem f $
+    show y ∈ f ⁻¹' t, by simp [preimage, h_eq, hx]⟩
+
+lemma image_preimage_eq_of_subset {f : α → β} {s : set β} (hs : s ⊆ range f) :
+  f '' (f ⁻¹' s) = s :=
+by rw [image_preimage_eq_inter_range, inter_eq_self_of_subset_left hs]
+
+lemma image_preimage_eq_iff {f : α → β} {s : set β} : f '' (f ⁻¹' s) = s ↔ s ⊆ range f :=
+⟨by { intro h, rw [← h], apply image_subset_range }, image_preimage_eq_of_subset⟩
+
+lemma subset_range_iff_exists_image_eq {f : α → β} {s : set β} :
+  s ⊆ range f ↔ ∃ t, f '' t = s :=
+⟨λ h, ⟨_, image_preimage_eq_iff.2 h⟩, λ ⟨t, ht⟩, ht ▸ image_subset_range _ _⟩
+
+@[simp] lemma exists_subset_range_and_iff {f : α → β} {p : set β → Prop} :
+  (∃ s, s ⊆ range f ∧ p s) ↔ ∃ s, p (f '' s) :=
+⟨λ ⟨s, hsf, hps⟩, ⟨f ⁻¹' s, (image_preimage_eq_of_subset hsf).symm ▸ hps⟩,
+  λ ⟨s, hs⟩, ⟨f '' s, image_subset_range _ _, hs⟩⟩
+
+lemma exists_subset_range_iff {f : α → β} {p : set β → Prop} :
+  (∃ s ⊆ range f, p s) ↔ ∃ s, p (f '' s) :=
+by simp only [exists_prop, exists_subset_range_and_iff]
+
+lemma range_image (f : α → β) : range (image f) = 𝒫 (range f) :=
+ext $ λ s, subset_range_iff_exists_image_eq.symm
+
+lemma preimage_subset_preimage_iff {s t : set α} {f : β → α} (hs : s ⊆ range f) :
+  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
+begin
+  split,
+  { intros h x hx, rcases hs hx with ⟨y, rfl⟩, exact h hx },
+  intros h x, apply h
+end
+
+lemma preimage_eq_preimage' {s t : set α} {f : β → α} (hs : s ⊆ range f) (ht : t ⊆ range f) :
+  f ⁻¹' s = f ⁻¹' t ↔ s = t :=
+begin
+  split,
+  { intro h, apply subset.antisymm, rw [←preimage_subset_preimage_iff hs, h],
+    rw [←preimage_subset_preimage_iff ht, h] },
+  rintro rfl, refl
+end
+
+@[simp] theorem preimage_inter_range {f : α → β} {s : set β} : f ⁻¹' (s ∩ range f) = f ⁻¹' s :=
+set.ext $ λ x, and_iff_left ⟨x, rfl⟩
+
+@[simp] theorem preimage_range_inter {f : α → β} {s : set β} : f ⁻¹' (range f ∩ s) = f ⁻¹' s :=
+by rw [inter_comm, preimage_inter_range]
+
+theorem preimage_image_preimage {f : α → β} {s : set β} :
+  f ⁻¹' (f '' (f ⁻¹' s)) = f ⁻¹' s :=
+by rw [image_preimage_eq_inter_range, preimage_inter_range]
+
+@[simp, mfld_simps] theorem range_id : range (@id α) = univ := range_iff_surjective.2 surjective_id
+
+@[simp] theorem range_id' : range (λ (x : α), x) = univ := range_id
+
+@[simp] theorem _root_.prod.range_fst [nonempty β] : range (prod.fst : α × β → α) = univ :=
+prod.fst_surjective.range_eq
+
+@[simp] theorem _root_.prod.range_snd [nonempty α] : range (prod.snd : α × β → β) = univ :=
+prod.snd_surjective.range_eq
+
+@[simp] theorem range_eval {ι : Type*} {α : ι → Sort*} [Π i, nonempty (α i)] (i : ι) :
+  range (eval i : (Π i, α i) → α i) = univ :=
+(surjective_eval i).range_eq
+
+theorem range_inl : range (@sum.inl α β) = {x | x.is_left} := by ext (_|_); simp
+theorem range_inr : range (@sum.inr α β) = {x | x.is_right} := by ext (_|_); simp
+
+theorem is_compl_range_inl_range_inr : is_compl (range $ @sum.inl α β) (range sum.inr) :=
+is_compl.of_le
+  (by { rintro y ⟨⟨x₁, rfl⟩, ⟨x₂, _⟩⟩, cc })
+  (by { rintro (x|y) -; [left, right]; exact mem_range_self _ })
+
+@[simp] theorem range_inl_union_range_inr : range (sum.inl : α → α ⊕ β) ∪ range sum.inr = univ :=
+is_compl_range_inl_range_inr.sup_eq_top
+
+@[simp] theorem range_inl_inter_range_inr : range (sum.inl : α → α ⊕ β) ∩ range sum.inr = ∅ :=
+is_compl_range_inl_range_inr.inf_eq_bot
+
+@[simp] theorem range_inr_union_range_inl : range (sum.inr : β → α ⊕ β) ∪ range sum.inl = univ :=
+is_compl_range_inl_range_inr.symm.sup_eq_top
+
+@[simp] theorem range_inr_inter_range_inl : range (sum.inr : β → α ⊕ β) ∩ range sum.inl = ∅ :=
+is_compl_range_inl_range_inr.symm.inf_eq_bot
+
+@[simp] theorem preimage_inl_image_inr (s : set β) : sum.inl ⁻¹' (@sum.inr α β '' s) = ∅ :=
+by { ext, simp }
+
+@[simp] theorem preimage_inr_image_inl (s : set α) : sum.inr ⁻¹' (@sum.inl α β '' s) = ∅ :=
+by { ext, simp }
+
+@[simp] theorem preimage_inl_range_inr : sum.inl ⁻¹' range (sum.inr : β → α ⊕ β) = ∅ :=
+by rw [← image_univ, preimage_inl_image_inr]
+
+@[simp] theorem preimage_inr_range_inl : sum.inr ⁻¹' range (sum.inl : α → α ⊕ β) = ∅ :=
+by rw [← image_univ, preimage_inr_image_inl]
+
+@[simp] lemma compl_range_inl : (range (sum.inl : α → α ⊕ β))ᶜ = range (sum.inr : β → α ⊕ β) :=
+is_compl.compl_eq is_compl_range_inl_range_inr
+
+@[simp] lemma compl_range_inr : (range (sum.inr : β → α ⊕ β))ᶜ = range (sum.inl : α → α ⊕ β) :=
+is_compl.compl_eq is_compl_range_inl_range_inr.symm
+
+theorem image_preimage_inl_union_image_preimage_inr (s : set (α ⊕ β)) :
+  sum.inl '' (sum.inl ⁻¹' s) ∪ sum.inr '' (sum.inr ⁻¹' s) = s :=
+by rw [image_preimage_eq_inter_range, image_preimage_eq_inter_range, ← inter_distrib_left,
+  range_inl_union_range_inr, inter_univ]
+
+@[simp] theorem range_quot_mk (r : α → α → Prop) : range (quot.mk r) = univ :=
+(surjective_quot_mk r).range_eq
+
+@[simp] theorem range_quot_lift {r : ι → ι → Prop} (hf : ∀ x y, r x y → f x = f y) :
+  range (quot.lift f hf) = range f :=
+ext $ λ y, (surjective_quot_mk _).exists
+
+@[simp] theorem range_quotient_mk [setoid α] : range (λx : α, ⟦x⟧) = univ :=
+range_quot_mk _
+
+@[simp] theorem range_quotient_lift [s : setoid ι] (hf) :
+  range (quotient.lift f hf : quotient s → α) = range f :=
+range_quot_lift _
+
+@[simp] theorem range_quotient_mk' {s : setoid α} : range (quotient.mk' : α → quotient s) = univ :=
+range_quot_mk _
+
+@[simp] theorem range_quotient_lift_on' {s : setoid ι} (hf) :
+  range (λ x : quotient s, quotient.lift_on' x f hf) = range f :=
+range_quot_lift _
+
+instance can_lift (c) (p) [can_lift α β c p] :
+  can_lift (set α) (set β) (('') c) (λ s, ∀ x ∈ s, p x) :=
+{ prf := λ s hs, subset_range_iff_exists_image_eq.mp (λ x hx, can_lift.prf _ (hs x hx)) }
+
+lemma range_const_subset {c : α} : range (λ x : ι, c) ⊆ {c} :=
+range_subset_iff.2 $ λ x, rfl
+
+@[simp] lemma range_const : ∀ [nonempty ι] {c : α}, range (λx:ι, c) = {c}
+| ⟨x⟩ c := subset.antisymm range_const_subset $
+  assume y hy, (mem_singleton_iff.1 hy).symm ▸ mem_range_self x
+
+lemma range_subtype_map {p : α → Prop} {q : β → Prop} (f : α → β) (h : ∀ x, p x → q (f x)) :
+  range (subtype.map f h) = coe ⁻¹' (f '' {x | p x}) :=
+begin
+  ext ⟨x, hx⟩,
+  simp_rw [mem_preimage, mem_range, mem_image, subtype.exists, subtype.map, subtype.coe_mk,
+    mem_set_of, exists_prop]
+end
+
+lemma image_swap_eq_preimage_swap : image (@prod.swap α β) = preimage prod.swap :=
+image_eq_preimage_of_inverse prod.swap_left_inverse prod.swap_right_inverse
+
+theorem preimage_singleton_nonempty {f : α → β} {y : β} :
+  (f ⁻¹' {y}).nonempty ↔ y ∈ range f :=
+iff.rfl
+
+theorem preimage_singleton_eq_empty {f : α → β} {y : β} :
+  f ⁻¹' {y} = ∅ ↔ y ∉ range f :=
+not_nonempty_iff_eq_empty.symm.trans preimage_singleton_nonempty.not
+
+lemma range_subset_singleton {f : ι → α} {x : α} : range f ⊆ {x} ↔ f = const ι x :=
+by simp [range_subset_iff, funext_iff, mem_singleton]
+
+lemma image_compl_preimage {f : α → β} {s : set β} : f '' ((f ⁻¹' s)ᶜ) = range f \ s :=
+by rw [compl_eq_univ_diff, image_diff_preimage, image_univ]
+
+/-- Any map `f : ι → β` factors through a map `range_factorization f : ι → range f`. -/
+def range_factorization (f : ι → β) : ι → range f :=
+λ i, ⟨f i, mem_range_self i⟩
+
+lemma range_factorization_eq {f : ι → β} :
+  subtype.val ∘ range_factorization f = f :=
+funext $ λ i, rfl
+
+@[simp] lemma range_factorization_coe (f : ι → β) (a : ι) :
+  (range_factorization f a : β) = f a := rfl
+
+@[simp] lemma coe_comp_range_factorization (f : ι → β) : coe ∘ range_factorization f = f := rfl
+
+lemma surjective_onto_range : surjective (range_factorization f) :=
+λ ⟨_, ⟨i, rfl⟩⟩, ⟨i, rfl⟩
+
+lemma image_eq_range (f : α → β) (s : set α) : f '' s = range (λ(x : s), f x) :=
+by { ext, split, rintro ⟨x, h1, h2⟩, exact ⟨⟨x, h1⟩, h2⟩, rintro ⟨⟨x, h1⟩, h2⟩, exact ⟨x, h1, h2⟩ }
+
+lemma _root_.sum.range_eq (f : α ⊕ β → γ) : range f = range (f ∘ sum.inl) ∪ range (f ∘ sum.inr) :=
+ext $ λ x, sum.exists
+
+@[simp] lemma sum.elim_range (f : α → γ) (g : β → γ) : range (sum.elim f g) = range f ∪ range g :=
+sum.range_eq _
+
+lemma range_ite_subset' {p : Prop} [decidable p] {f g : α → β} :
+  range (if p then f else g) ⊆ range f ∪ range g :=
+begin
+  by_cases h : p, {rw if_pos h, exact subset_union_left _ _},
+  {rw if_neg h, exact subset_union_right _ _}
+end
+
+lemma range_ite_subset {p : α → Prop} [decidable_pred p] {f g : α → β} :
+  range (λ x, if p x then f x else g x) ⊆ range f ∪ range g :=
+begin
+  rw range_subset_iff, intro x, by_cases h : p x,
+  simp [if_pos h, mem_union, mem_range_self],
+  simp [if_neg h, mem_union, mem_range_self]
+end
+
+@[simp] lemma preimage_range (f : α → β) : f ⁻¹' (range f) = univ :=
+eq_univ_of_forall mem_range_self
+
+/-- The range of a function from a `unique` type contains just the
+function applied to its single value. -/
+lemma range_unique [h : unique ι] : range f = {f default} :=
+begin
+  ext x,
+  rw mem_range,
+  split,
+  { rintros ⟨i, hi⟩,
+    rw h.uniq i at hi,
+    exact hi ▸ mem_singleton _ },
+  { exact λ h, ⟨default, h.symm⟩ }
+end
+
+lemma range_diff_image_subset (f : α → β) (s : set α) :
+  range f \ f '' s ⊆ f '' sᶜ :=
+λ y ⟨⟨x, h₁⟩, h₂⟩, ⟨x, λ h, h₂ ⟨x, h, h₁⟩, h₁⟩
+
+lemma range_diff_image {f : α → β} (H : injective f) (s : set α) :
+  range f \ f '' s = f '' sᶜ :=
+subset.antisymm (range_diff_image_subset f s) $ λ y ⟨x, hx, hy⟩, hy ▸
+  ⟨mem_range_self _, λ ⟨x', hx', eq⟩, hx $ H eq ▸ hx'⟩
+
+
+@[simp] lemma range_inclusion (h : s ⊆ t) : range (inclusion h) = {x : t | (x:α) ∈ s} :=
+by { ext ⟨x, hx⟩, simp [inclusion] }
+
+/-- We can use the axiom of choice to pick a preimage for every element of `range f`. -/
+noncomputable def range_splitting (f : α → β) : range f → α := λ x, x.2.some
+
+-- This can not be a `@[simp]` lemma because the head of the left hand side is a variable.
+lemma apply_range_splitting (f : α → β) (x : range f) : f (range_splitting f x) = x :=
+x.2.some_spec
+
+attribute [irreducible] range_splitting
+
+@[simp] lemma comp_range_splitting (f : α → β) : f ∘ range_splitting f = coe :=
+by { ext, simp only [function.comp_app], apply apply_range_splitting, }
+
+-- When `f` is injective, see also `equiv.of_injective`.
+lemma left_inverse_range_splitting (f : α → β) :
+  left_inverse (range_factorization f) (range_splitting f) :=
+λ x, by { ext, simp only [range_factorization_coe], apply apply_range_splitting, }
+
+lemma range_splitting_injective (f : α → β) : injective (range_splitting f) :=
+(left_inverse_range_splitting f).injective
+
+lemma right_inverse_range_splitting {f : α → β} (h : injective f) :
+  right_inverse (range_factorization f) (range_splitting f) :=
+(left_inverse_range_splitting f).right_inverse_of_injective $
+  λ x y hxy, h $ subtype.ext_iff.1 hxy
+
+lemma preimage_range_splitting {f : α → β} (hf : injective f) :
+  preimage (range_splitting f) = image (range_factorization f) :=
+(image_eq_preimage_of_inverse (right_inverse_range_splitting hf)
+  (left_inverse_range_splitting f)).symm
+
+lemma is_compl_range_some_none (α : Type*) :
+  is_compl (range (some : α → option α)) {none} :=
+is_compl.of_le
+  (λ x ⟨⟨a, ha⟩, (hn : x = none)⟩, option.some_ne_none _ (ha.trans hn))
+  (λ x hx, option.cases_on x (or.inr rfl) (λ x, or.inl $ mem_range_self _))
+
+@[simp] lemma compl_range_some (α : Type*) :
+  (range (some : α → option α))ᶜ = {none} :=
+(is_compl_range_some_none α).compl_eq
+
+@[simp] lemma range_some_inter_none (α : Type*) : range (some : α → option α) ∩ {none} = ∅ :=
+(is_compl_range_some_none α).inf_eq_bot
+
+@[simp] lemma range_some_union_none (α : Type*) : range (some : α → option α) ∪ {none} = univ :=
+(is_compl_range_some_none α).sup_eq_top
+
+@[simp] lemma insert_none_range_some (α : Type*) :
+  insert none (range (some : α → option α)) = univ :=
+(is_compl_range_some_none α).symm.sup_eq_top
+
+end range
+
+section subsingleton
+variables {s : set α}
+
+/-- The image of a subsingleton is a subsingleton. -/
+lemma subsingleton.image (hs : s.subsingleton) (f : α → β) : (f '' s).subsingleton :=
+λ _ ⟨x, hx, Hx⟩ _ ⟨y, hy, Hy⟩, Hx ▸ Hy ▸ congr_arg f (hs hx hy)
+
+/-- The preimage of a subsingleton under an injective map is a subsingleton. -/
+theorem subsingleton.preimage {s : set β} (hs : s.subsingleton) {f : α → β}
+  (hf : function.injective f) : (f ⁻¹' s).subsingleton := λ a ha b hb, hf $ hs ha hb
+
+/-- If the image of a set under an injective map is a subsingleton, the set is a subsingleton. -/
+theorem subsingleton_of_image {α β : Type*} {f : α → β} (hf : function.injective f)
+  (s : set α) (hs : (f '' s).subsingleton) : s.subsingleton :=
+(hs.preimage hf).anti $ subset_preimage_image _ _
+
+/-- If the preimage of a set under an surjective map is a subsingleton,
+the set is a subsingleton. -/
+theorem subsingleton_of_preimage {α β : Type*} {f : α → β} (hf : function.surjective f)
+  (s : set β) (hs : (f ⁻¹' s).subsingleton) : s.subsingleton :=
+λ fx hx fy hy, by { rcases ⟨hf fx, hf fy⟩ with ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩, exact congr_arg f (hs hx hy) }
+
+lemma subsingleton_range {α : Sort*} [subsingleton α] (f : α → β) : (range f).subsingleton :=
+forall_range_iff.2 $ λ x, forall_range_iff.2 $ λ y, congr_arg f (subsingleton.elim x y)
+
+/-- The preimage of a nontrivial set under a surjective map is nontrivial. -/
+theorem nontrivial.preimage {s : set β} (hs : s.nontrivial) {f : α → β}
+  (hf : function.surjective f) : (f ⁻¹' s).nontrivial :=
+begin
+  rcases hs with ⟨fx, hx, fy, hy, hxy⟩,
+  rcases ⟨hf fx, hf fy⟩ with ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩,
+  exact ⟨x, hx, y, hy, mt (congr_arg f) hxy⟩
+end
+
+/-- The image of a nontrivial set under an injective map is nontrivial. -/
+theorem nontrivial.image (hs : s.nontrivial)
+  {f : α → β} (hf : function.injective f) : (f '' s).nontrivial :=
+let ⟨x, hx, y, hy, hxy⟩ := hs in ⟨f x, mem_image_of_mem f hx, f y, mem_image_of_mem f hy, hf.ne hxy⟩
+
+/-- If the image of a set is nontrivial, the set is nontrivial. -/
+lemma nontrivial_of_image (f : α → β) (s : set α) (hs : (f '' s).nontrivial) : s.nontrivial :=
+let ⟨_, ⟨x, hx, rfl⟩, _, ⟨y, hy, rfl⟩, hxy⟩ := hs in ⟨x, hx, y, hy, mt (congr_arg f) hxy⟩
+
+/-- If the preimage of a set under an injective map is nontrivial, the set is nontrivial. -/
+lemma nontrivial_of_preimage {f : α → β} (hf : function.injective f) (s : set β)
+  (hs : (f ⁻¹' s).nontrivial) : s.nontrivial :=
+(hs.image hf).mono $ image_preimage_subset _ _
+
+end subsingleton
+
+end set
+
+namespace function
+variables {f : α → β}
+
+open set
+
+lemma surjective.preimage_injective (hf : surjective f) : injective (preimage f) :=
+assume s t, (preimage_eq_preimage hf).1
+
+lemma injective.preimage_image (hf : injective f) (s : set α) : f ⁻¹' (f '' s) = s :=
+preimage_image_eq s hf
+
+lemma injective.preimage_surjective (hf : injective f) : surjective (preimage f) :=
+by { intro s, use f '' s, rw hf.preimage_image }
+
+lemma injective.subsingleton_image_iff (hf : injective f) {s : set α} :
+  (f '' s).subsingleton ↔ s.subsingleton :=
+⟨subsingleton_of_image hf s, λ h, h.image f⟩
+
+lemma surjective.image_preimage (hf : surjective f) (s : set β) : f '' (f ⁻¹' s) = s :=
+image_preimage_eq s hf
+
+lemma surjective.image_surjective (hf : surjective f) : surjective (image f) :=
+by { intro s, use f ⁻¹' s, rw hf.image_preimage }
+
+lemma surjective.nonempty_preimage (hf : surjective f) {s : set β} :
+  (f ⁻¹' s).nonempty ↔ s.nonempty :=
+by rw [← nonempty_image_iff, hf.image_preimage]
+
+lemma injective.image_injective (hf : injective f) : injective (image f) :=
+by { intros s t h, rw [←preimage_image_eq s hf, ←preimage_image_eq t hf, h] }
+
+lemma surjective.preimage_subset_preimage_iff {s t : set β} (hf : surjective f) :
+  f ⁻¹' s ⊆ f ⁻¹' t ↔ s ⊆ t :=
+by { apply preimage_subset_preimage_iff, rw [hf.range_eq], apply subset_univ }
+
+lemma surjective.range_comp {f : ι → ι'} (hf : surjective f) (g : ι' → α) :
+  range (g ∘ f) = range g :=
+ext $ λ y, (@surjective.exists _ _ _ hf (λ x, g x = y)).symm
+
+lemma injective.mem_range_iff_exists_unique (hf : injective f) {b : β} :
+  b ∈ range f ↔ ∃! a, f a = b :=
+⟨λ ⟨a, h⟩, ⟨a, h, λ a' ha, hf (ha.trans h.symm)⟩, exists_unique.exists⟩
+
+lemma injective.exists_unique_of_mem_range (hf : injective f) {b : β} (hb : b ∈ range f) :
+  ∃! a, f a = b :=
+hf.mem_range_iff_exists_unique.mp hb
+
+theorem injective.compl_image_eq (hf : injective f) (s : set α) :
+  (f '' s)ᶜ = f '' sᶜ ∪ (range f)ᶜ :=
+begin
+  ext y,
+  rcases em (y ∈ range f) with ⟨x, rfl⟩|hx,
+  { simp [hf.eq_iff] },
+  { rw [mem_range, not_exists] at hx,
+    simp [hx] }
+end
+
+lemma left_inverse.image_image {g : β → α} (h : left_inverse g f) (s : set α) :
+  g '' (f '' s) = s :=
+by rw [← image_comp, h.comp_eq_id, image_id]
+
+lemma left_inverse.preimage_preimage {g : β → α} (h : left_inverse g f) (s : set α) :
+  f ⁻¹' (g ⁻¹' s) = s :=
+by rw [← preimage_comp, h.comp_eq_id, preimage_id]
+
+protected lemma involutive.preimage {f : α → α} (hf : involutive f) : involutive (preimage f) :=
+hf.right_inverse.preimage_preimage
+
+end function
+
+namespace equiv_like
+variables {E : Type*} [equiv_like E ι ι']
+include ι
+
+@[simp] lemma range_comp (f : ι' → α) (e : E) : set.range (f ∘ e) = set.range f :=
+(equiv_like.surjective _).range_comp _
+
+end equiv_like
+
+/-! ### Image and preimage on subtypes -/
+
+namespace subtype
+open set
+
+lemma coe_image {p : α → Prop} {s : set (subtype p)} :
+  coe '' s = {x | ∃h : p x, (⟨x, h⟩ : subtype p) ∈ s} :=
+set.ext $ assume a,
+⟨assume ⟨⟨a', ha'⟩, in_s, h_eq⟩, h_eq ▸ ⟨ha', in_s⟩,
+  assume ⟨ha, in_s⟩, ⟨⟨a, ha⟩, in_s, rfl⟩⟩
+
+@[simp] lemma coe_image_of_subset {s t : set α} (h : t ⊆ s) : coe '' {x : ↥s | ↑x ∈ t} = t :=
+begin
+  ext x,
+  rw set.mem_image,
+  exact ⟨λ ⟨x', hx', hx⟩, hx ▸ hx', λ hx, ⟨⟨x, h hx⟩, hx, rfl⟩⟩,
+end
+
+lemma range_coe {s : set α} :
+  range (coe : s → α) = s :=
+by { rw ← set.image_univ, simp [-set.image_univ, coe_image] }
+
+/-- A variant of `range_coe`. Try to use `range_coe` if possible.
+  This version is useful when defining a new type that is defined as the subtype of something.
+  In that case, the coercion doesn't fire anymore. -/
+lemma range_val {s : set α} :
+  range (subtype.val : s → α) = s :=
+range_coe
+
+/-- We make this the simp lemma instead of `range_coe`. The reason is that if we write
+  for `s : set α` the function `coe : s → α`, then the inferred implicit arguments of `coe` are
+  `coe α (λ x, x ∈ s)`. -/
+@[simp] lemma range_coe_subtype {p : α → Prop} :
+  range (coe : subtype p → α) = {x | p x} :=
+range_coe
+
+@[simp] lemma coe_preimage_self (s : set α) : (coe : s → α) ⁻¹' s = univ :=
+by rw [← preimage_range (coe : s → α), range_coe]
+
+lemma range_val_subtype {p : α → Prop} :
+  range (subtype.val : subtype p → α) = {x | p x} :=
+range_coe
+
+theorem coe_image_subset (s : set α) (t : set s) : coe '' t ⊆ s :=
+λ x ⟨y, yt, yvaleq⟩, by rw ←yvaleq; exact y.property
+
+theorem coe_image_univ (s : set α) : (coe : s → α) '' set.univ = s :=
+image_univ.trans range_coe
+
+@[simp] theorem image_preimage_coe (s t : set α) :
+  (coe : s → α) '' (coe ⁻¹' t) = t ∩ s :=
+image_preimage_eq_inter_range.trans $ congr_arg _ range_coe
+
+theorem image_preimage_val (s t : set α) :
+  (subtype.val : s → α) '' (subtype.val ⁻¹' t) = t ∩ s :=
+image_preimage_coe s t
+
+theorem preimage_coe_eq_preimage_coe_iff {s t u : set α} :
+  ((coe : s → α) ⁻¹' t = coe ⁻¹' u) ↔ t ∩ s = u ∩ s :=
+by rw [← image_preimage_coe, ← image_preimage_coe, coe_injective.image_injective.eq_iff]
+
+@[simp] theorem preimage_coe_inter_self (s t : set α) :
+  (coe : s → α) ⁻¹' (t ∩ s) = coe ⁻¹' t :=
+by rw [preimage_coe_eq_preimage_coe_iff, inter_assoc, inter_self]
+
+theorem preimage_val_eq_preimage_val_iff (s t u : set α) :
+  ((subtype.val : s → α) ⁻¹' t = subtype.val ⁻¹' u) ↔ (t ∩ s = u ∩ s) :=
+preimage_coe_eq_preimage_coe_iff
+
+lemma exists_set_subtype {t : set α} (p : set α → Prop) :
+  (∃(s : set t), p (coe '' s)) ↔ ∃(s : set α), s ⊆ t ∧ p s :=
+begin
+  split,
+  { rintro ⟨s, hs⟩, refine ⟨coe '' s, _, hs⟩,
+    convert image_subset_range _ _, rw [range_coe] },
+  rintro ⟨s, hs₁, hs₂⟩, refine ⟨coe ⁻¹' s, _⟩,
+  rw [image_preimage_eq_of_subset], exact hs₂, rw [range_coe], exact hs₁
+end
+
+lemma preimage_coe_nonempty {s t : set α} : ((coe : s → α) ⁻¹' t).nonempty ↔ (s ∩ t).nonempty :=
+by rw [inter_comm, ← image_preimage_coe, nonempty_image_iff]
+
+lemma preimage_coe_eq_empty {s t : set α} : (coe : s → α) ⁻¹' t = ∅ ↔ s ∩ t = ∅ :=
+by simp only [← not_nonempty_iff_eq_empty, preimage_coe_nonempty]
+
+@[simp] lemma preimage_coe_compl (s : set α) : (coe : s → α) ⁻¹' sᶜ = ∅ :=
+preimage_coe_eq_empty.2 (inter_compl_self s)
+
+@[simp] lemma preimage_coe_compl' (s : set α) : (coe : sᶜ → α) ⁻¹' s = ∅ :=
+preimage_coe_eq_empty.2 (compl_inter_self s)
+
+end subtype
+
+/-! ### Images and preimages on `option` -/
+open set
+
+namespace option
+
+lemma injective_iff {α β} {f : option α → β} :
+  injective f ↔ injective (f ∘ some) ∧ f none ∉ range (f ∘ some) :=
+begin
+  simp only [mem_range, not_exists, (∘)],
+  refine ⟨λ hf, ⟨hf.comp (option.some_injective _), λ x, hf.ne $ option.some_ne_none _⟩, _⟩,
+  rintro ⟨h_some, h_none⟩ (_|a) (_|b) hab,
+  exacts [rfl, (h_none _ hab.symm).elim, (h_none _ hab).elim, congr_arg some (h_some hab)]
+end
+
+lemma range_eq {α β} (f : option α → β) : range f = insert (f none) (range (f ∘ some)) :=
+set.ext $ λ y, option.exists.trans $ eq_comm.or iff.rfl
+
+end option
+
+lemma with_bot.range_eq {α β} (f : with_bot α → β) :
+  range f = insert (f ⊥) (range (f ∘ coe : α → β)) :=
+option.range_eq f
+
+lemma with_top.range_eq {α β} (f : with_top α → β) :
+  range f = insert (f ⊤) (range (f ∘ coe : α → β)) :=
+option.range_eq f
+
+namespace set
+open function
+
+/-! ### Injectivity and surjectivity lemmas for image and preimage -/
+
+section image_preimage
+variables {f : α → β}
+
+@[simp] lemma preimage_injective : injective (preimage f) ↔ surjective f :=
+begin
+  refine ⟨λ h y, _, surjective.preimage_injective⟩,
+  obtain ⟨x, hx⟩ : (f ⁻¹' {y}).nonempty,
+  { rw [h.nonempty_apply_iff preimage_empty], apply singleton_nonempty },
+  exact ⟨x, hx⟩
+end
+
+@[simp]
+lemma preimage_surjective : surjective (preimage f) ↔ injective f :=
+begin
+  refine ⟨λ h x x' hx, _, injective.preimage_surjective⟩,
+  cases h {x} with s hs, have := mem_singleton x,
+  rwa [← hs, mem_preimage, hx, ← mem_preimage, hs, mem_singleton_iff, eq_comm] at this
+end
+
+@[simp] lemma image_surjective : surjective (image f) ↔ surjective f :=
+begin
+  refine ⟨λ h y, _, surjective.image_surjective⟩,
+  cases h {y} with s hs,
+  have := mem_singleton y, rw [← hs] at this, rcases this with ⟨x, h1x, h2x⟩,
+  exact ⟨x, h2x⟩
+end
+
+@[simp] lemma image_injective : injective (image f) ↔ injective f :=
+begin
+  refine ⟨λ h x x' hx, _, injective.image_injective⟩,
+  rw [← singleton_eq_singleton_iff], apply h,
+  rw [image_singleton, image_singleton, hx]
+end
+
+lemma preimage_eq_iff_eq_image {f : α → β} (hf : bijective f) {s t} :
+  f ⁻¹' s = t ↔ s = f '' t :=
+by rw [← image_eq_image hf.1, hf.2.image_preimage]
+
+lemma eq_preimage_iff_image_eq {f : α → β} (hf : bijective f) {s t} :
+  s = f ⁻¹' t ↔ f '' s = t :=
+by rw [← image_eq_image hf.1, hf.2.image_preimage]
+
+end image_preimage
+end set
+
+/-! ### Disjoint lemmas for image and preimage -/
+
+section disjoint
+variables {f : α → β} {s t : set α}
+
+lemma disjoint.preimage (f : α → β) {s t : set β} (h : disjoint s t) :
+  disjoint (f ⁻¹' s) (f ⁻¹' t) :=
+disjoint_iff_inf_le.mpr $ λ x hx, h.le_bot hx
+
+namespace set
+
+theorem disjoint_image_image {f : β → α} {g : γ → α} {s : set β} {t : set γ}
+  (h : ∀ b ∈ s, ∀ c ∈ t, f b ≠ g c) : disjoint (f '' s) (g '' t) :=
+disjoint_iff_inf_le.mpr $ by rintro a ⟨⟨b, hb, eq⟩, c, hc, rfl⟩; exact h b hb c hc eq
+
+lemma disjoint_image_of_injective {f : α → β} (hf : injective f) {s t : set α}
+  (hd : disjoint s t) : disjoint (f '' s) (f '' t) :=
+disjoint_image_image $ λ x hx y hy, hf.ne $ λ H, set.disjoint_iff.1 hd ⟨hx, H.symm ▸ hy⟩
+
+lemma _root_.disjoint.of_image (h : disjoint (f '' s) (f '' t)) : disjoint s t :=
+disjoint_iff_inf_le.mpr $
+  λ x hx, disjoint_left.1 h (mem_image_of_mem _ hx.1) (mem_image_of_mem _ hx.2)
+
+lemma disjoint_image_iff (hf : injective f) : disjoint (f '' s) (f '' t) ↔ disjoint s t :=
+⟨disjoint.of_image, disjoint_image_of_injective hf⟩
+
+lemma _root_.disjoint.of_preimage (hf : surjective f) {s t : set β}
+  (h : disjoint (f ⁻¹' s) (f ⁻¹' t)) :
+  disjoint s t :=
+by rw [disjoint_iff_inter_eq_empty, ←image_preimage_eq (_ ∩ _) hf, preimage_inter, h.inter_eq,
+  image_empty]
+
+lemma disjoint_preimage_iff (hf : surjective f) {s t : set β} :
+  disjoint (f ⁻¹' s) (f ⁻¹' t) ↔ disjoint s t :=
+⟨disjoint.of_preimage hf, disjoint.preimage _⟩
+
+lemma preimage_eq_empty {f : α → β} {s : set β} (h : disjoint s (range f)) :
+  f ⁻¹' s = ∅ :=
+by simpa using h.preimage f
+
+lemma preimage_eq_empty_iff {s : set β} : f ⁻¹' s = ∅ ↔ disjoint s (range f) :=
+⟨λ h, begin
+    simp only [eq_empty_iff_forall_not_mem, disjoint_iff_inter_eq_empty, not_exists,
+      mem_inter_iff, not_and, mem_range, mem_preimage] at h ⊢,
+    assume y hy x hx,
+    rw ← hx at hy,
+    exact h x hy,
+  end, preimage_eq_empty⟩
+
+end set
+
+end disjoint
diff --git a/src/data/set/intervals/basic.lean b/src/data/set/intervals/basic.lean
index 2db4ebb1c677c..250eba029ea68 100644
--- a/src/data/set/intervals/basic.lean
+++ b/src/data/set/intervals/basic.lean
@@ -3,12 +3,15 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot, Yury Kudryashov, Rémy Degenne
 -/
-import algebra.order.group
-import order.rel_iso
+import order.min_max
+import data.set.prod
 
 /-!
 # Intervals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In any preorder `α`, we define intervals (which on each side can be either infinite, open, or
 closed) using the following naming conventions:
 - `i`: infinite
@@ -25,13 +28,11 @@ for some statements it should be `linear_order` or `densely_ordered`).
 TODO: This is just the beginning; a lot of rules are missing
 -/
 
+open function order_dual (to_dual of_dual)
+
 variables {α β : Type*}
 
 namespace set
-
-open set
-open order_dual (to_dual of_dual)
-
 section preorder
 variables [preorder α] {a a₁ a₂ b b₁ b₂ c x : α}
 
@@ -84,6 +85,15 @@ lemma Ioi_def (a : α) : {x | a < x} = Ioi a := rfl
 @[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := iff.rfl
 @[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := iff.rfl
 
+instance decidable_mem_Ioo [decidable (a < x ∧ x < b)] : decidable (x ∈ Ioo a b) := by assumption
+instance decidable_mem_Ico [decidable (a ≤ x ∧ x < b)] : decidable (x ∈ Ico a b) := by assumption
+instance decidable_mem_Iio [decidable (x < b)] : decidable (x ∈ Iio b) := by assumption
+instance decidable_mem_Icc [decidable (a ≤ x ∧ x ≤ b)] : decidable (x ∈ Icc a b) := by assumption
+instance decidable_mem_Iic [decidable (x ≤ b)] : decidable (x ∈ Iic b) := by assumption
+instance decidable_mem_Ioc [decidable (a < x ∧ x ≤ b)] : decidable (x ∈ Ioc a b) := by assumption
+instance decidable_mem_Ici [decidable (a ≤ x)] : decidable (x ∈ Ici a) := by assumption
+instance decidable_mem_Ioi [decidable (a < x)] : decidable (x ∈ Ioi a) := by assumption
+
 @[simp] lemma left_mem_Ioo : a ∈ Ioo a b ↔ false := by simp [lt_irrefl]
 @[simp] lemma left_mem_Ico : a ∈ Ico a b ↔ a < b := by simp [le_refl]
 @[simp] lemma left_mem_Icc : a ∈ Icc a b ↔ a ≤ b := by simp [le_refl]
@@ -155,6 +165,18 @@ nonempty.to_subtype nonempty_Ioi
 instance nonempty_Iio_subtype [no_min_order α] : nonempty (Iio a) :=
 nonempty.to_subtype nonempty_Iio
 
+instance [no_min_order α] : no_min_order (Iio a) :=
+⟨λ a, let ⟨b, hb⟩ := exists_lt (a : α) in ⟨⟨b, lt_trans hb a.2⟩, hb⟩⟩
+
+instance [no_min_order α] : no_min_order (Iic a) :=
+⟨λ a, let ⟨b, hb⟩ := exists_lt (a : α) in ⟨⟨b, hb.le.trans a.2⟩, hb⟩⟩
+
+instance [no_max_order α] : no_max_order (Ioi a) :=
+order_dual.no_max_order (Iio (to_dual a))
+
+instance [no_max_order α] : no_max_order (Ici a) :=
+order_dual.no_max_order (Iic (to_dual a))
+
 @[simp] lemma Icc_eq_empty (h : ¬a ≤ b) : Icc a b = ∅ :=
 eq_empty_iff_forall_not_mem.2 $ λ x ⟨ha, hb⟩, h (ha.trans hb)
 
@@ -278,6 +300,10 @@ lemma Iio_subset_Iic_self : Iio a ⊆ Iic a := λ x hx, le_of_lt hx
 
 lemma Ico_subset_Ici_self : Ico a b ⊆ Ici a := λ x, and.left
 
+lemma Ioi_ssubset_Ici_self  : Ioi a ⊂ Ici a := ⟨Ioi_subset_Ici_self, λ h, lt_irrefl a (h le_rfl)⟩
+
+lemma Iio_ssubset_Iic_self : Iio a ⊂ Iic a := @Ioi_ssubset_Ici_self αᵒᵈ _ _
+
 lemma Icc_subset_Icc_iff (h₁ : a₁ ≤ b₁) :
   Icc a₁ b₁ ⊆ Icc a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
 ⟨λ h, ⟨(h ⟨le_rfl, h₁⟩).1, (h ⟨h₁, le_rfl⟩).2⟩,
@@ -381,6 +407,19 @@ lemma _root_.is_min.Iio_eq (h : is_min a) : Iio a = ∅ := eq_empty_of_subset_em
 lemma Iic_inter_Ioc_of_le (h : a ≤ c) : Iic a ∩ Ioc b c = Ioc b a :=
 ext $ λ x, ⟨λ H, ⟨H.2.1, H.1⟩, λ H, ⟨H.2, H.1, H.2.trans h⟩⟩
 
+lemma not_mem_Icc_of_lt (ha : c < a) : c ∉ Icc a b := λ h, ha.not_le h.1
+lemma not_mem_Icc_of_gt (hb : b < c) : c ∉ Icc a b := λ h, hb.not_le h.2
+lemma not_mem_Ico_of_lt (ha : c < a) : c ∉ Ico a b := λ h, ha.not_le h.1
+lemma not_mem_Ioc_of_gt (hb : b < c) : c ∉ Ioc a b := λ h, hb.not_le h.2
+
+@[simp] lemma not_mem_Ioi_self : a ∉ Ioi a := lt_irrefl _
+@[simp] lemma not_mem_Iio_self : b ∉ Iio b := lt_irrefl _
+
+lemma not_mem_Ioc_of_le (ha : c ≤ a) : c ∉ Ioc a b := λ h, lt_irrefl _ $ h.1.trans_le ha
+lemma not_mem_Ico_of_ge (hb : b ≤ c) : c ∉ Ico a b := λ h, lt_irrefl _ $ h.2.trans_le hb
+lemma not_mem_Ioo_of_le (ha : c ≤ a) : c ∉ Ioo a b := λ h, lt_irrefl _ $ h.1.trans_le ha
+lemma not_mem_Ioo_of_ge (hb : b ≤ c) : c ∉ Ioo a b := λ h, lt_irrefl _ $ h.2.trans_le hb
+
 end preorder
 
 section partial_order
@@ -524,6 +563,12 @@ eq_singleton_iff_unique_mem.2 ⟨left_mem_Ici, λ b, h.eq_of_ge⟩
 
 lemma _root_.is_min.Iic_eq (h : is_min a) : Iic a = {a} := h.to_dual.Ici_eq
 
+lemma Ici_injective : injective (Ici : α → set α) := λ a b, eq_of_forall_ge_iff ∘ set.ext_iff.1
+lemma Iic_injective : injective (Iic : α → set α) := λ a b, eq_of_forall_le_iff ∘ set.ext_iff.1
+
+lemma Ici_inj : Ici a = Ici b ↔ a = b := Ici_injective.eq_iff
+lemma Iic_inj : Iic a = Iic b ↔ a = b := Iic_injective.eq_iff
+
 end partial_order
 
 section order_top
@@ -562,34 +607,10 @@ lemma not_mem_Ici : c ∉ Ici a ↔ c < a := not_le
 
 lemma not_mem_Iic : c ∉ Iic b ↔ b < c := not_le
 
-lemma not_mem_Icc_of_lt (ha : c < a) : c ∉ Icc a b :=
-not_mem_subset Icc_subset_Ici_self $ not_mem_Ici.mpr ha
-
-lemma not_mem_Icc_of_gt (hb : b < c) : c ∉ Icc a b :=
-not_mem_subset Icc_subset_Iic_self $ not_mem_Iic.mpr hb
-
-lemma not_mem_Ico_of_lt (ha : c < a) : c ∉ Ico a b :=
-not_mem_subset Ico_subset_Ici_self $ not_mem_Ici.mpr ha
-
-lemma not_mem_Ioc_of_gt (hb : b < c) : c ∉ Ioc a b :=
-not_mem_subset Ioc_subset_Iic_self $ not_mem_Iic.mpr hb
-
 lemma not_mem_Ioi : c ∉ Ioi a ↔ c ≤ a := not_lt
 
 lemma not_mem_Iio : c ∉ Iio b ↔ b ≤ c := not_lt
 
-lemma not_mem_Ioc_of_le (ha : c ≤ a) : c ∉ Ioc a b :=
-not_mem_subset Ioc_subset_Ioi_self $ not_mem_Ioi.mpr ha
-
-lemma not_mem_Ico_of_ge (hb : b ≤ c) : c ∉ Ico a b :=
-not_mem_subset Ico_subset_Iio_self $ not_mem_Iio.mpr hb
-
-lemma not_mem_Ioo_of_le (ha : c ≤ a) : c ∉ Ioo a b :=
-not_mem_subset Ioo_subset_Ioi_self $ not_mem_Ioi.mpr ha
-
-lemma not_mem_Ioo_of_ge (hb : b ≤ c) : c ∉ Ioo a b :=
-not_mem_subset Ioo_subset_Iio_self $ not_mem_Iio.mpr hb
-
 @[simp] lemma compl_Iic : (Iic a)ᶜ = Ioi a := ext $ λ _, not_le
 @[simp] lemma compl_Ici : (Ici a)ᶜ = Iio a := ext $ λ _, not_le
 @[simp] lemma compl_Iio : (Iio a)ᶜ = Ici a := ext $ λ _, not_lt
@@ -619,6 +640,12 @@ by rw [diff_eq, compl_Iio, inter_comm, Ici_inter_Iic]
 @[simp] lemma Iio_diff_Iio : Iio b \ Iio a = Ico a b :=
 by rw [diff_eq, compl_Iio, inter_comm, Ici_inter_Iio]
 
+lemma Ioi_injective : injective (Ioi : α → set α) := λ a b, eq_of_forall_gt_iff ∘ set.ext_iff.1
+lemma Iio_injective : injective (Iio : α → set α) := λ a b, eq_of_forall_lt_iff ∘ set.ext_iff.1
+
+lemma Ioi_inj : Ioi a = Ioi b ↔ a = b := Ioi_injective.eq_iff
+lemma Iio_inj : Iio a = Iio b ↔ a = b := Iio_injective.eq_iff
+
 lemma Ico_subset_Ico_iff (h₁ : a₁ < b₁) :
   Ico a₁ b₁ ⊆ Ico a₂ b₂ ↔ a₂ ≤ a₁ ∧ b₁ ≤ b₂ :=
 ⟨λ h, have a₂ ≤ a₁ ∧ a₁ < b₂ := h ⟨le_rfl, h₁⟩,
@@ -680,11 +707,22 @@ by rw [←diff_eq_empty, Iio_diff_Iic, Ioo_eq_empty_iff, not_lt]
 
 /-! #### Two infinite intervals -/
 
-@[simp] lemma Iic_union_Ici : Iic a ∪ Ici a = univ := eq_univ_of_forall (λ x, le_total x a)
+lemma Iic_union_Ioi_of_le (h : a ≤ b) : Iic b ∪ Ioi a = univ :=
+eq_univ_of_forall $ λ x, (h.lt_or_le x).symm
+
+lemma Iio_union_Ici_of_le (h : a ≤ b) : Iio b ∪ Ici a = univ :=
+eq_univ_of_forall $ λ x, (h.le_or_lt x).symm
 
-@[simp] lemma Iio_union_Ici : Iio a ∪ Ici a = univ := eq_univ_of_forall (λ x, lt_or_le x a)
+lemma Iic_union_Ici_of_le (h : a ≤ b) : Iic b ∪ Ici a = univ :=
+eq_univ_of_forall $ λ x, (h.le_or_le x).symm
 
-@[simp] lemma Iic_union_Ioi : Iic a ∪ Ioi a = univ := eq_univ_of_forall (λ x, le_or_lt x a)
+lemma Iio_union_Ioi_of_lt (h : a < b) : Iio b ∪ Ioi a = univ :=
+eq_univ_of_forall $ λ x, (h.lt_or_lt x).symm
+
+@[simp] lemma Iic_union_Ici : Iic a ∪ Ici a = univ := Iic_union_Ici_of_le le_rfl
+@[simp] lemma Iio_union_Ici : Iio a ∪ Ici a = univ := Iio_union_Ici_of_le le_rfl
+@[simp] lemma Iic_union_Ioi : Iic a ∪ Ioi a = univ := Iic_union_Ioi_of_le le_rfl
+@[simp] lemma Iio_union_Ioi : Iio a ∪ Ioi a = {a}ᶜ := ext $ λ x, lt_or_lt_iff_ne
 
 /-! #### A finite and an infinite interval -/
 
@@ -876,7 +914,7 @@ begin
   ext x,
   cases lt_or_le x b with hba hba,
   { simp [hba, h₁] },
-  { simp only [mem_Iio, mem_union_eq, mem_Ioo, lt_max_iff],
+  { simp only [mem_Iio, mem_union, mem_Ioo, lt_max_iff],
     refine or_congr iff.rfl ⟨and.right, _⟩,
     exact λ h₂, ⟨h₁.trans_le hba, h₂⟩ },
 end
@@ -1126,6 +1164,26 @@ begin
       le_of_lt h₂, le_of_lt h₁] },
 end
 
+section lattice
+variables [lattice β] {f : α → β}
+
+lemma _root_.monotone_on.image_Icc_subset (hf : monotone_on f (Icc a b)) :
+  f '' Icc a b ⊆ Icc (f a) (f b) :=
+image_subset_iff.2 $ λ c hc,
+  ⟨hf (left_mem_Icc.2 $ hc.1.trans hc.2) hc hc.1, hf hc (right_mem_Icc.2 $ hc.1.trans hc.2) hc.2⟩
+
+lemma _root_.antitone_on.image_Icc_subset (hf : antitone_on f (Icc a b)) :
+  f '' Icc a b ⊆ Icc (f b) (f a) :=
+image_subset_iff.2 $ λ c hc,
+  ⟨hf hc (right_mem_Icc.2 $ hc.1.trans hc.2) hc.2, hf (left_mem_Icc.2 $ hc.1.trans hc.2) hc hc.1⟩
+
+lemma _root_.monotone.image_Icc_subset (hf : monotone f) : f '' Icc a b ⊆ Icc (f a) (f b) :=
+(hf.monotone_on _).image_Icc_subset
+
+lemma _root_.antitone.image_Icc_subset (hf : antitone f) : f '' Icc a b ⊆ Icc (f b) (f a) :=
+(hf.antitone_on _).image_Icc_subset
+
+end lattice
 end linear_order
 
 section lattice
@@ -1169,7 +1227,7 @@ end both
 end lattice
 
 section linear_order
-variables [linear_order α] {a a₁ a₂ b b₁ b₂ c d : α}
+variables [linear_order α] [linear_order β] {f : α → β} {a a₁ a₂ b b₁ b₂ c d : α}
 
 @[simp] lemma Ioi_inter_Ioi : Ioi a ∩ Ioi b = Ioi (a ⊔ b) := ext $ λ _, sup_lt_iff.symm
 @[simp] lemma Iio_inter_Iio : Iio a ∩ Iio b = Iio (a ⊓ b) := ext $ λ _, lt_inf_iff.symm
@@ -1259,162 +1317,8 @@ by simp
 
 end prod
 
-/-! ### Lemmas about membership of arithmetic operations -/
-
-section ordered_comm_group
-
-variables [ordered_comm_group α] {a b c d : α}
-
-/-! `inv_mem_Ixx_iff`, `sub_mem_Ixx_iff` -/
-@[to_additive] lemma inv_mem_Icc_iff : a⁻¹ ∈ set.Icc c d ↔ a ∈ set.Icc (d⁻¹) (c⁻¹) :=
-(and_comm _ _).trans $ and_congr inv_le' le_inv'
-@[to_additive] lemma inv_mem_Ico_iff : a⁻¹ ∈ set.Ico c d ↔ a ∈ set.Ioc (d⁻¹) (c⁻¹) :=
-(and_comm _ _).trans $ and_congr inv_lt' le_inv'
-@[to_additive] lemma inv_mem_Ioc_iff : a⁻¹ ∈ set.Ioc c d ↔ a ∈ set.Ico (d⁻¹) (c⁻¹) :=
-(and_comm _ _).trans $ and_congr inv_le' lt_inv'
-@[to_additive] lemma inv_mem_Ioo_iff : a⁻¹ ∈ set.Ioo c d ↔ a ∈ set.Ioo (d⁻¹) (c⁻¹) :=
-(and_comm _ _).trans $ and_congr inv_lt' lt_inv'
-
-end ordered_comm_group
-
-section ordered_add_comm_group
-
-variables [ordered_add_comm_group α] {a b c d : α}
-
-/-! `add_mem_Ixx_iff_left` -/
-lemma add_mem_Icc_iff_left : a + b ∈ set.Icc c d ↔ a ∈ set.Icc (c - b) (d - b) :=
-(and_congr sub_le_iff_le_add le_sub_iff_add_le).symm
-lemma add_mem_Ico_iff_left : a + b ∈ set.Ico c d ↔ a ∈ set.Ico (c - b) (d - b) :=
-(and_congr sub_le_iff_le_add lt_sub_iff_add_lt).symm
-lemma add_mem_Ioc_iff_left : a + b ∈ set.Ioc c d ↔ a ∈ set.Ioc (c - b) (d - b) :=
-(and_congr sub_lt_iff_lt_add le_sub_iff_add_le).symm
-lemma add_mem_Ioo_iff_left : a + b ∈ set.Ioo c d ↔ a ∈ set.Ioo (c - b) (d - b) :=
-(and_congr sub_lt_iff_lt_add lt_sub_iff_add_lt).symm
-
-/-! `add_mem_Ixx_iff_right` -/
-lemma add_mem_Icc_iff_right : a + b ∈ set.Icc c d ↔ b ∈ set.Icc (c - a) (d - a) :=
-(and_congr sub_le_iff_le_add' le_sub_iff_add_le').symm
-lemma add_mem_Ico_iff_right : a + b ∈ set.Ico c d ↔ b ∈ set.Ico (c - a) (d - a) :=
-(and_congr sub_le_iff_le_add' lt_sub_iff_add_lt').symm
-lemma add_mem_Ioc_iff_right : a + b ∈ set.Ioc c d ↔ b ∈ set.Ioc (c - a) (d - a) :=
-(and_congr sub_lt_iff_lt_add' le_sub_iff_add_le').symm
-lemma add_mem_Ioo_iff_right : a + b ∈ set.Ioo c d ↔ b ∈ set.Ioo (c - a) (d - a) :=
-(and_congr sub_lt_iff_lt_add' lt_sub_iff_add_lt').symm
-
-/-! `sub_mem_Ixx_iff_left` -/
-lemma sub_mem_Icc_iff_left : a - b ∈ set.Icc c d ↔ a ∈ set.Icc (c + b) (d + b) :=
-and_congr le_sub_iff_add_le sub_le_iff_le_add
-lemma sub_mem_Ico_iff_left : a - b ∈ set.Ico c d ↔ a ∈ set.Ico (c + b) (d + b) :=
-and_congr le_sub_iff_add_le sub_lt_iff_lt_add
-lemma sub_mem_Ioc_iff_left : a - b ∈ set.Ioc c d ↔ a ∈ set.Ioc (c + b) (d + b) :=
-and_congr lt_sub_iff_add_lt sub_le_iff_le_add
-lemma sub_mem_Ioo_iff_left : a - b ∈ set.Ioo c d ↔ a ∈ set.Ioo (c + b) (d + b) :=
-and_congr lt_sub_iff_add_lt sub_lt_iff_lt_add
-
-/-! `sub_mem_Ixx_iff_right` -/
-lemma sub_mem_Icc_iff_right : a - b ∈ set.Icc c d ↔ b ∈ set.Icc (a - d) (a - c) :=
-(and_comm _ _).trans $ and_congr sub_le le_sub
-lemma sub_mem_Ico_iff_right : a - b ∈ set.Ico c d ↔ b ∈ set.Ioc (a - d) (a - c) :=
-(and_comm _ _).trans $ and_congr sub_lt le_sub
-lemma sub_mem_Ioc_iff_right : a - b ∈ set.Ioc c d ↔ b ∈ set.Ico (a - d) (a - c) :=
-(and_comm _ _).trans $ and_congr sub_le lt_sub
-lemma sub_mem_Ioo_iff_right : a - b ∈ set.Ioo c d ↔ b ∈ set.Ioo (a - d) (a - c) :=
-(and_comm _ _).trans $ and_congr sub_lt lt_sub
-
--- I think that symmetric intervals deserve attention and API: they arise all the time,
--- for instance when considering metric balls in `ℝ`.
-lemma mem_Icc_iff_abs_le {R : Type*} [linear_ordered_add_comm_group R] {x y z : R} :
-  |x - y| ≤ z ↔ y ∈ Icc (x - z) (x + z) :=
-abs_le.trans $ (and_comm _ _).trans $ and_congr sub_le neg_le_sub_iff_le_add
-
-end ordered_add_comm_group
-
-section linear_ordered_add_comm_group
-
-variables [linear_ordered_add_comm_group α]
-
-/-- If we remove a smaller interval from a larger, the result is nonempty -/
-lemma nonempty_Ico_sdiff {x dx y dy : α} (h : dy < dx) (hx : 0 < dx) :
-  nonempty ↥(Ico x (x + dx) \ Ico y (y + dy)) :=
-begin
-  cases lt_or_le x y with h' h',
-  { use x, simp [*, not_le.2 h'] },
-  { use max x (x + dy), simp [*, le_refl] }
-end
-
-end linear_ordered_add_comm_group
-
 end set
 
-open set
-
-namespace order_iso
-
-section preorder
-variables [preorder α] [preorder β]
-
-@[simp] lemma preimage_Iic (e : α ≃o β) (b : β) : e ⁻¹' (Iic b) = Iic (e.symm b) :=
-by { ext x, simp [← e.le_iff_le] }
-
-@[simp] lemma preimage_Ici (e : α ≃o β) (b : β) : e ⁻¹' (Ici b) = Ici (e.symm b) :=
-by { ext x, simp [← e.le_iff_le] }
-
-@[simp] lemma preimage_Iio (e : α ≃o β) (b : β) : e ⁻¹' (Iio b) = Iio (e.symm b) :=
-by { ext x, simp [← e.lt_iff_lt] }
-
-@[simp] lemma preimage_Ioi (e : α ≃o β) (b : β) : e ⁻¹' (Ioi b) = Ioi (e.symm b) :=
-by { ext x, simp [← e.lt_iff_lt] }
-
-@[simp] lemma preimage_Icc (e : α ≃o β) (a b : β) : e ⁻¹' (Icc a b) = Icc (e.symm a) (e.symm b) :=
-by simp [← Ici_inter_Iic]
-
-@[simp] lemma preimage_Ico (e : α ≃o β) (a b : β) : e ⁻¹' (Ico a b) = Ico (e.symm a) (e.symm b) :=
-by simp [← Ici_inter_Iio]
-
-@[simp] lemma preimage_Ioc (e : α ≃o β) (a b : β) : e ⁻¹' (Ioc a b) = Ioc (e.symm a) (e.symm b) :=
-by simp [← Ioi_inter_Iic]
-
-@[simp] lemma preimage_Ioo (e : α ≃o β) (a b : β) : e ⁻¹' (Ioo a b) = Ioo (e.symm a) (e.symm b) :=
-by simp [← Ioi_inter_Iio]
-
-@[simp] lemma image_Iic (e : α ≃o β) (a : α) : e '' (Iic a) = Iic (e a) :=
-by rw [e.image_eq_preimage, e.symm.preimage_Iic, e.symm_symm]
-
-@[simp] lemma image_Ici (e : α ≃o β) (a : α) : e '' (Ici a) = Ici (e a) :=
-e.dual.image_Iic a
-
-@[simp] lemma image_Iio (e : α ≃o β) (a : α) : e '' (Iio a) = Iio (e a) :=
-by rw [e.image_eq_preimage, e.symm.preimage_Iio, e.symm_symm]
-
-@[simp] lemma image_Ioi (e : α ≃o β) (a : α) : e '' (Ioi a) = Ioi (e a) :=
-e.dual.image_Iio a
-
-@[simp] lemma image_Ioo (e : α ≃o β) (a b : α) : e '' (Ioo a b) = Ioo (e a) (e b) :=
-by rw [e.image_eq_preimage, e.symm.preimage_Ioo, e.symm_symm]
-
-@[simp] lemma image_Ioc (e : α ≃o β) (a b : α) : e '' (Ioc a b) = Ioc (e a) (e b) :=
-by rw [e.image_eq_preimage, e.symm.preimage_Ioc, e.symm_symm]
-
-@[simp] lemma image_Ico (e : α ≃o β) (a b : α) : e '' (Ico a b) = Ico (e a) (e b) :=
-by rw [e.image_eq_preimage, e.symm.preimage_Ico, e.symm_symm]
-
-@[simp] lemma image_Icc (e : α ≃o β) (a b : α) : e '' (Icc a b) = Icc (e a) (e b) :=
-by rw [e.image_eq_preimage, e.symm.preimage_Icc, e.symm_symm]
-
-end preorder
-
-/-- Order isomorphism between `Iic (⊤ : α)` and `α` when `α` has a top element -/
-def Iic_top [preorder α] [order_top α] : set.Iic (⊤ : α) ≃o α :=
-{ map_rel_iff' := λ x y, by refl,
-  .. (@equiv.subtype_univ_equiv α (set.Iic (⊤ : α)) (λ x, le_top)), }
-
-/-- Order isomorphism between `Ici (⊥ : α)` and `α` when `α` has a bottom element -/
-def Ici_bot [preorder α] [order_bot α] : set.Ici (⊥ : α) ≃o α :=
-{ map_rel_iff' := λ x y, by refl,
-  .. (@equiv.subtype_univ_equiv α (set.Ici (⊥ : α)) (λ x, bot_le)) }
-
-end order_iso
-
 /-! ### Lemmas about intervals in dense orders -/
 
 section dense
diff --git a/src/data/set/intervals/default.lean b/src/data/set/intervals/default.lean
deleted file mode 100644
index b071ccd6fd329..0000000000000
--- a/src/data/set/intervals/default.lean
+++ /dev/null
@@ -1,2 +0,0 @@
-import data.set.intervals.disjoint
-import data.set.intervals.unordered_interval
diff --git a/src/data/set/intervals/disjoint.lean b/src/data/set/intervals/disjoint.lean
index a121d359b7f93..c649e78d80052 100644
--- a/src/data/set/intervals/disjoint.lean
+++ b/src/data/set/intervals/disjoint.lean
@@ -8,6 +8,9 @@ import data.set.lattice
 /-!
 # Extra lemmas about intervals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains lemmas about intervals that cannot be included into `data.set.intervals.basic`
 because this would create an `import` cycle. Namely, lemmas in this file can use definitions
 from `data.set.lattice`, including `disjoint`.
@@ -25,7 +28,7 @@ section preorder
 variables [preorder α] {a b c : α}
 
 @[simp] lemma Iic_disjoint_Ioi (h : a ≤ b) : disjoint (Iic a) (Ioi b) :=
-λ x ⟨ha, hb⟩, not_le_of_lt (h.trans_lt hb) ha
+disjoint_left.mpr $ λ x ha hb, (h.trans_lt hb).not_le ha
 
 @[simp] lemma Iic_disjoint_Ioc (h : a ≤ b) : disjoint (Iic a) (Ioc b c) :=
 (Iic_disjoint_Ioi h).mono le_rfl (λ _, and.left)
@@ -34,7 +37,7 @@ variables [preorder α] {a b c : α}
 (Iic_disjoint_Ioc (le_refl b)).mono (λ _, and.right) le_rfl
 
 @[simp] lemma Ico_disjoint_Ico_same {a b c : α} : disjoint (Ico a b) (Ico b c) :=
-λ x hx, not_le_of_lt hx.1.2 hx.2.1
+disjoint_left.mpr $ λ x hab hbc, hab.2.not_le hbc.1
 
 @[simp] lemma Ici_disjoint_Iic : disjoint (Ici a) (Iic b) ↔ ¬(a ≤ b) :=
 by rw [set.disjoint_iff_inter_eq_empty, Ici_inter_Iic, Icc_eq_empty_iff]
@@ -42,6 +45,39 @@ by rw [set.disjoint_iff_inter_eq_empty, Ici_inter_Iic, Icc_eq_empty_iff]
 @[simp] lemma Iic_disjoint_Ici : disjoint (Iic a) (Ici b) ↔ ¬(b ≤ a) :=
 disjoint.comm.trans Ici_disjoint_Iic
 
+@[simp] lemma Union_Iic : (⋃ a : α, Iic a) = univ := Union_eq_univ_iff.2 $ λ x, ⟨x, right_mem_Iic⟩
+@[simp] lemma Union_Ici : (⋃ a : α, Ici a) = univ := Union_eq_univ_iff.2 $ λ x, ⟨x, left_mem_Ici⟩
+
+@[simp] lemma Union_Icc_right (a : α) : (⋃ b, Icc a b) = Ici a :=
+by simp only [← Ici_inter_Iic, ← inter_Union, Union_Iic, inter_univ]
+
+@[simp] lemma Union_Ioc_right (a : α) : (⋃ b, Ioc a b) = Ioi a :=
+by simp only [← Ioi_inter_Iic, ← inter_Union, Union_Iic, inter_univ]
+
+@[simp] lemma Union_Icc_left (b : α) : (⋃ a, Icc a b) = Iic b :=
+by simp only [← Ici_inter_Iic, ← Union_inter, Union_Ici, univ_inter]
+
+@[simp] lemma Union_Ico_left (b : α) : (⋃ a, Ico a b) = Iio b :=
+by simp only [← Ici_inter_Iio, ← Union_inter, Union_Ici, univ_inter]
+
+@[simp] lemma Union_Iio [no_max_order α] : (⋃ a : α, Iio a) = univ :=
+Union_eq_univ_iff.2 exists_gt
+
+@[simp] lemma Union_Ioi [no_min_order α] : (⋃ a : α, Ioi a) = univ :=
+Union_eq_univ_iff.2 exists_lt
+
+@[simp] lemma Union_Ico_right [no_max_order α] (a : α) : (⋃ b, Ico a b) = Ici a :=
+by simp only [← Ici_inter_Iio, ← inter_Union, Union_Iio, inter_univ]
+
+@[simp] lemma Union_Ioo_right [no_max_order α] (a : α) : (⋃ b, Ioo a b) = Ioi a :=
+by simp only [← Ioi_inter_Iio, ← inter_Union, Union_Iio, inter_univ]
+
+@[simp] lemma Union_Ioc_left [no_min_order α] (b : α) : (⋃ a, Ioc a b) = Iic b :=
+by simp only [← Ioi_inter_Iic, ← Union_inter, Union_Ioi, univ_inter]
+
+@[simp] lemma Union_Ioo_left [no_min_order α] (b : α) : (⋃ a, Ioo a b) = Iio b :=
+by simp only [← Ioi_inter_Iio, ← Union_inter, Union_Ioi, univ_inter]
+
 end preorder
 
 section linear_order
@@ -110,4 +146,53 @@ lemma is_lub.Union_Iio_eq (h : is_lub (range f) a) :
   (⋃ x, Iio (f x)) = Iio a :=
 h.dual.Union_Ioi_eq
 
+lemma is_glb.bUnion_Ici_eq_Ioi (a_glb : is_glb s a) (a_not_mem : a ∉ s) :
+  (⋃ x ∈ s, Ici x) = Ioi a :=
+begin
+  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
+  { exact Ici_subset_Ioi.mpr (lt_of_le_of_ne (a_glb.1 hx) (λ h, (h ▸ a_not_mem) hx)), },
+  { rcases a_glb.exists_between hx with ⟨y, hys, hay, hyx⟩,
+    apply mem_Union₂.mpr ,
+    refine ⟨y, hys, hyx.le⟩, },
+end
+
+lemma is_glb.bUnion_Ici_eq_Ici (a_glb : is_glb s a) (a_mem : a ∈ s) :
+  (⋃ x ∈ s, Ici x) = Ici a :=
+begin
+  refine (Union₂_subset $ λ x hx, _).antisymm (λ x hx, _),
+  { exact Ici_subset_Ici.mpr (mem_lower_bounds.mp a_glb.1 x hx), },
+  { apply mem_Union₂.mpr,
+    refine ⟨a, a_mem, hx⟩, },
+end
+
+lemma is_lub.bUnion_Iic_eq_Iio (a_lub : is_lub s a) (a_not_mem : a ∉ s) :
+  (⋃ x ∈ s, Iic x) = Iio a :=
+a_lub.dual.bUnion_Ici_eq_Ioi a_not_mem
+
+lemma is_lub.bUnion_Iic_eq_Iic (a_lub : is_lub s a) (a_mem : a ∈ s) :
+  (⋃ x ∈ s, Iic x) = Iic a :=
+a_lub.dual.bUnion_Ici_eq_Ici a_mem
+
+lemma Union_Ici_eq_Ioi_infi {R : Type*} [complete_linear_order R]
+  {f : ι → R} (no_least_elem : (⨅ i, f i) ∉ range f) :
+  (⋃ (i : ι), Ici (f i)) = Ioi (⨅ i, f i) :=
+by simp only [← is_glb.bUnion_Ici_eq_Ioi (@is_glb_infi _ _ _ f) no_least_elem,
+              mem_range, Union_exists, Union_Union_eq']
+
+lemma Union_Iic_eq_Iio_supr {R : Type*} [complete_linear_order R]
+  {f : ι → R} (no_greatest_elem : (⨆ i, f i) ∉ range f) :
+  (⋃ (i : ι), Iic (f i)) = Iio (⨆ i, f i) :=
+@Union_Ici_eq_Ioi_infi ι (order_dual R) _ f no_greatest_elem
+
+lemma Union_Ici_eq_Ici_infi {R : Type*} [complete_linear_order R]
+  {f : ι → R} (has_least_elem : (⨅ i, f i) ∈ range f) :
+  (⋃ (i : ι), Ici (f i)) = Ici (⨅ i, f i) :=
+by simp only [← is_glb.bUnion_Ici_eq_Ici (@is_glb_infi _ _ _ f) has_least_elem,
+              mem_range, Union_exists, Union_Union_eq']
+
+lemma Union_Iic_eq_Iic_supr {R : Type*} [complete_linear_order R]
+  {f : ι → R} (has_greatest_elem : (⨆ i, f i) ∈ range f) :
+  (⋃ (i : ι), Iic (f i)) = Iic (⨆ i, f i) :=
+@Union_Ici_eq_Ici_infi ι (order_dual R) _ f has_greatest_elem
+
 end Union_Ixx
diff --git a/src/data/set/intervals/group.lean b/src/data/set/intervals/group.lean
new file mode 100644
index 0000000000000..218d2dcc821fe
--- /dev/null
+++ b/src/data/set/intervals/group.lean
@@ -0,0 +1,199 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot, Yury Kudryashov, Rémy Degenne
+-/
+import data.set.intervals.basic
+import data.set.pairwise.basic
+import algebra.order.group.abs
+import algebra.group_power.lemmas
+
+/-! ### Lemmas about arithmetic operations and intervals.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α : Type*}
+
+namespace set
+
+section ordered_comm_group
+
+variables [ordered_comm_group α] {a b c d : α}
+
+/-! `inv_mem_Ixx_iff`, `sub_mem_Ixx_iff` -/
+@[to_additive] lemma inv_mem_Icc_iff : a⁻¹ ∈ set.Icc c d ↔ a ∈ set.Icc (d⁻¹) (c⁻¹) :=
+(and_comm _ _).trans $ and_congr inv_le' le_inv'
+@[to_additive] lemma inv_mem_Ico_iff : a⁻¹ ∈ set.Ico c d ↔ a ∈ set.Ioc (d⁻¹) (c⁻¹) :=
+(and_comm _ _).trans $ and_congr inv_lt' le_inv'
+@[to_additive] lemma inv_mem_Ioc_iff : a⁻¹ ∈ set.Ioc c d ↔ a ∈ set.Ico (d⁻¹) (c⁻¹) :=
+(and_comm _ _).trans $ and_congr inv_le' lt_inv'
+@[to_additive] lemma inv_mem_Ioo_iff : a⁻¹ ∈ set.Ioo c d ↔ a ∈ set.Ioo (d⁻¹) (c⁻¹) :=
+(and_comm _ _).trans $ and_congr inv_lt' lt_inv'
+
+end ordered_comm_group
+
+section ordered_add_comm_group
+
+variables [ordered_add_comm_group α] {a b c d : α}
+
+/-! `add_mem_Ixx_iff_left` -/
+lemma add_mem_Icc_iff_left : a + b ∈ set.Icc c d ↔ a ∈ set.Icc (c - b) (d - b) :=
+(and_congr sub_le_iff_le_add le_sub_iff_add_le).symm
+lemma add_mem_Ico_iff_left : a + b ∈ set.Ico c d ↔ a ∈ set.Ico (c - b) (d - b) :=
+(and_congr sub_le_iff_le_add lt_sub_iff_add_lt).symm
+lemma add_mem_Ioc_iff_left : a + b ∈ set.Ioc c d ↔ a ∈ set.Ioc (c - b) (d - b) :=
+(and_congr sub_lt_iff_lt_add le_sub_iff_add_le).symm
+lemma add_mem_Ioo_iff_left : a + b ∈ set.Ioo c d ↔ a ∈ set.Ioo (c - b) (d - b) :=
+(and_congr sub_lt_iff_lt_add lt_sub_iff_add_lt).symm
+
+/-! `add_mem_Ixx_iff_right` -/
+lemma add_mem_Icc_iff_right : a + b ∈ set.Icc c d ↔ b ∈ set.Icc (c - a) (d - a) :=
+(and_congr sub_le_iff_le_add' le_sub_iff_add_le').symm
+lemma add_mem_Ico_iff_right : a + b ∈ set.Ico c d ↔ b ∈ set.Ico (c - a) (d - a) :=
+(and_congr sub_le_iff_le_add' lt_sub_iff_add_lt').symm
+lemma add_mem_Ioc_iff_right : a + b ∈ set.Ioc c d ↔ b ∈ set.Ioc (c - a) (d - a) :=
+(and_congr sub_lt_iff_lt_add' le_sub_iff_add_le').symm
+lemma add_mem_Ioo_iff_right : a + b ∈ set.Ioo c d ↔ b ∈ set.Ioo (c - a) (d - a) :=
+(and_congr sub_lt_iff_lt_add' lt_sub_iff_add_lt').symm
+
+/-! `sub_mem_Ixx_iff_left` -/
+lemma sub_mem_Icc_iff_left : a - b ∈ set.Icc c d ↔ a ∈ set.Icc (c + b) (d + b) :=
+and_congr le_sub_iff_add_le sub_le_iff_le_add
+lemma sub_mem_Ico_iff_left : a - b ∈ set.Ico c d ↔ a ∈ set.Ico (c + b) (d + b) :=
+and_congr le_sub_iff_add_le sub_lt_iff_lt_add
+lemma sub_mem_Ioc_iff_left : a - b ∈ set.Ioc c d ↔ a ∈ set.Ioc (c + b) (d + b) :=
+and_congr lt_sub_iff_add_lt sub_le_iff_le_add
+lemma sub_mem_Ioo_iff_left : a - b ∈ set.Ioo c d ↔ a ∈ set.Ioo (c + b) (d + b) :=
+and_congr lt_sub_iff_add_lt sub_lt_iff_lt_add
+
+/-! `sub_mem_Ixx_iff_right` -/
+lemma sub_mem_Icc_iff_right : a - b ∈ set.Icc c d ↔ b ∈ set.Icc (a - d) (a - c) :=
+(and_comm _ _).trans $ and_congr sub_le_comm le_sub_comm
+lemma sub_mem_Ico_iff_right : a - b ∈ set.Ico c d ↔ b ∈ set.Ioc (a - d) (a - c) :=
+(and_comm _ _).trans $ and_congr sub_lt_comm le_sub_comm
+lemma sub_mem_Ioc_iff_right : a - b ∈ set.Ioc c d ↔ b ∈ set.Ico (a - d) (a - c) :=
+(and_comm _ _).trans $ and_congr sub_le_comm lt_sub_comm
+lemma sub_mem_Ioo_iff_right : a - b ∈ set.Ioo c d ↔ b ∈ set.Ioo (a - d) (a - c) :=
+(and_comm _ _).trans $ and_congr sub_lt_comm lt_sub_comm
+
+-- I think that symmetric intervals deserve attention and API: they arise all the time,
+-- for instance when considering metric balls in `ℝ`.
+lemma mem_Icc_iff_abs_le {R : Type*} [linear_ordered_add_comm_group R] {x y z : R} :
+  |x - y| ≤ z ↔ y ∈ Icc (x - z) (x + z) :=
+abs_le.trans $ (and_comm _ _).trans $ and_congr sub_le_comm neg_le_sub_iff_le_add
+
+end ordered_add_comm_group
+
+section linear_ordered_add_comm_group
+
+variables [linear_ordered_add_comm_group α]
+
+/-- If we remove a smaller interval from a larger, the result is nonempty -/
+lemma nonempty_Ico_sdiff {x dx y dy : α} (h : dy < dx) (hx : 0 < dx) :
+  nonempty ↥(Ico x (x + dx) \ Ico y (y + dy)) :=
+begin
+  cases lt_or_le x y with h' h',
+  { use x, simp [*, not_le.2 h'] },
+  { use max x (x + dy), simp [*, le_refl] }
+end
+
+end linear_ordered_add_comm_group
+
+/-! ### Lemmas about disjointness of translates of intervals -/
+section pairwise_disjoint
+
+section ordered_comm_group
+
+variables [ordered_comm_group α] (a b : α)
+
+@[to_additive]
+lemma pairwise_disjoint_Ioc_mul_zpow  :
+  pairwise (disjoint on λ n : ℤ, Ioc (a * b ^ n) (a * b ^ (n + 1))) :=
+begin
+  simp_rw [function.on_fun, set.disjoint_iff],
+  intros m n hmn x hx,
+  apply hmn,
+  have hb : 1 < b,
+  { have : a * b ^ m < a * b ^ (m + 1), from hx.1.1.trans_le hx.1.2,
+    rwa [mul_lt_mul_iff_left, ←mul_one (b ^ m), zpow_add_one, mul_lt_mul_iff_left] at this },
+  have i1 := hx.1.1.trans_le hx.2.2,
+  have i2 := hx.2.1.trans_le hx.1.2,
+  rw [mul_lt_mul_iff_left, zpow_lt_zpow_iff hb, int.lt_add_one_iff] at i1 i2,
+  exact le_antisymm i1 i2
+end
+
+@[to_additive]
+lemma pairwise_disjoint_Ico_mul_zpow :
+  pairwise (disjoint on λ n : ℤ, Ico (a * b ^ n) (a * b ^ (n + 1))) :=
+begin
+  simp_rw [function.on_fun, set.disjoint_iff],
+  intros m n hmn x hx,
+  apply hmn,
+  have hb : 1 < b,
+  { have : a * b ^ m < a * b ^ (m + 1), from hx.1.1.trans_lt hx.1.2,
+    rwa [mul_lt_mul_iff_left, ←mul_one (b ^ m), zpow_add_one, mul_lt_mul_iff_left] at this },
+  have i1 := hx.1.1.trans_lt hx.2.2,
+  have i2 := hx.2.1.trans_lt hx.1.2,
+  rw [mul_lt_mul_iff_left, zpow_lt_zpow_iff hb, int.lt_add_one_iff] at i1 i2,
+  exact le_antisymm i1 i2,
+end
+
+@[to_additive]
+lemma pairwise_disjoint_Ioo_mul_zpow :
+  pairwise (disjoint on λ n : ℤ, Ioo (a * b ^ n) (a * b ^ (n + 1))) :=
+λ m n hmn, (pairwise_disjoint_Ioc_mul_zpow a b hmn).mono Ioo_subset_Ioc_self Ioo_subset_Ioc_self
+
+@[to_additive]
+lemma pairwise_disjoint_Ioc_zpow :
+  pairwise (disjoint on λ n : ℤ, Ioc (b ^ n) (b ^ (n + 1))) :=
+by simpa only [one_mul] using pairwise_disjoint_Ioc_mul_zpow 1 b
+
+@[to_additive]
+lemma pairwise_disjoint_Ico_zpow :
+  pairwise (disjoint on λ n : ℤ, Ico (b ^ n) (b ^ (n + 1))) :=
+by simpa only [one_mul] using pairwise_disjoint_Ico_mul_zpow 1 b
+
+@[to_additive]
+lemma pairwise_disjoint_Ioo_zpow :
+  pairwise (disjoint on λ n : ℤ, Ioo (b ^ n) (b ^ (n + 1))) :=
+by simpa only [one_mul] using pairwise_disjoint_Ioo_mul_zpow 1 b
+
+end ordered_comm_group
+
+section ordered_ring
+
+variables [ordered_ring α] (a : α)
+
+lemma pairwise_disjoint_Ioc_add_int_cast :
+  pairwise (disjoint on λ n : ℤ, Ioc (a + n) (a + n + 1)) :=
+by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc]
+  using pairwise_disjoint_Ioc_add_zsmul a (1 : α)
+
+lemma pairwise_disjoint_Ico_add_int_cast :
+  pairwise (disjoint on λ n : ℤ, Ico (a + n) (a + n + 1)) :=
+by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc]
+  using pairwise_disjoint_Ico_add_zsmul a (1 : α)
+
+lemma pairwise_disjoint_Ioo_add_int_cast :
+  pairwise (disjoint on λ n : ℤ, Ioo (a + n) (a + n + 1)) :=
+by simpa only [zsmul_one, int.cast_add, int.cast_one, ←add_assoc]
+  using pairwise_disjoint_Ioo_add_zsmul a (1 : α)
+
+variables (α)
+
+lemma pairwise_disjoint_Ico_int_cast : pairwise (disjoint on λ n : ℤ, Ico (n : α) (n + 1)) :=
+by simpa only [zero_add] using pairwise_disjoint_Ico_add_int_cast (0 : α)
+
+lemma pairwise_disjoint_Ioo_int_cast : pairwise (disjoint on λ n : ℤ, Ioo (n : α) (n + 1)) :=
+by simpa only [zero_add] using pairwise_disjoint_Ioo_add_int_cast (0 : α)
+
+lemma pairwise_disjoint_Ioc_int_cast : pairwise (disjoint on λ n : ℤ, Ioc (n : α) (n + 1)) :=
+by simpa only [zero_add] using pairwise_disjoint_Ioc_add_int_cast (0 : α)
+
+end ordered_ring
+
+end pairwise_disjoint
+
+end set
diff --git a/src/data/set/intervals/image_preimage.lean b/src/data/set/intervals/image_preimage.lean
deleted file mode 100644
index 414413825f40a..0000000000000
--- a/src/data/set/intervals/image_preimage.lean
+++ /dev/null
@@ -1,547 +0,0 @@
-/-
-Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yury G. Kudryashov, Patrick Massot
--/
-import data.set.pointwise
-
-/-!
-# (Pre)images of intervals
-
-In this file we prove a bunch of trivial lemmas like “if we add `a` to all points of `[b, c]`,
-then we get `[a + b, a + c]`”. For the functions `x ↦ x ± a`, `x ↦ a ± x`, and `x ↦ -x` we prove
-lemmas about preimages and images of all intervals. We also prove a few lemmas about images under
-`x ↦ a * x`, `x ↦ x * a` and `x ↦ x⁻¹`.
--/
-
-universe u
-open_locale pointwise
-
-namespace set
-
-section has_exists_add_of_le
-/-!
-The lemmas in this section state that addition maps intervals bijectively. The typeclass
-`has_exists_add_of_le` is defined specifically to make them work when combined with
-`ordered_cancel_add_comm_monoid`; the lemmas below therefore apply to all
-`ordered_add_comm_group`, but also to `ℕ` and `ℝ≥0`, which are not groups.
-
-TODO : move as much as possible in this file to the setting of this weaker typeclass.
--/
-
-variables {α : Type u} [ordered_cancel_add_comm_monoid α] [has_exists_add_of_le α] (a b d : α)
-
-lemma Icc_add_bij : bij_on (+d) (Icc a b) (Icc (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_le_add_right h.1 _, add_le_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1,
-  rw [mem_Icc, add_right_comm, add_le_add_iff_right, add_le_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ioo_add_bij : bij_on (+d) (Ioo a b) (Ioo (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_lt_add_right h.1 _, add_lt_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1.le,
-  rw [mem_Ioo, add_right_comm, add_lt_add_iff_right, add_lt_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ioc_add_bij : bij_on (+d) (Ioc a b) (Ioc (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_lt_add_right h.1 _, add_le_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1.le,
-  rw [mem_Ioc, add_right_comm, add_lt_add_iff_right, add_le_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ico_add_bij : bij_on (+d) (Ico a b) (Ico (a + d) (b + d)) :=
-begin
-  refine ⟨λ _ h, ⟨add_le_add_right h.1 _, add_lt_add_right h.2 _⟩,
-          λ _ _ _ _ h, add_right_cancel h,
-          λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le h.1,
-  rw [mem_Ico, add_right_comm, add_le_add_iff_right, add_lt_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ici_add_bij : bij_on (+d) (Ici a) (Ici (a + d)) :=
-begin
-  refine ⟨λ x h, add_le_add_right (mem_Ici.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ici.mp h),
-  rw [mem_Ici, add_right_comm, add_le_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-lemma Ioi_add_bij : bij_on (+d) (Ioi a) (Ioi (a + d)) :=
-begin
-  refine ⟨λ x h, add_lt_add_right (mem_Ioi.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ioi.mp h).le,
-  rw [mem_Ioi, add_right_comm, add_lt_add_iff_right] at h,
-  exact ⟨a + c, h, by rw add_right_comm⟩,
-end
-
-end has_exists_add_of_le
-
-section ordered_add_comm_group
-
-variables {G : Type u} [ordered_add_comm_group G] (a b c : G)
-
-/-!
-### Preimages under `x ↦ a + x`
--/
-
-@[simp] lemma preimage_const_add_Ici : (λ x, a + x) ⁻¹' (Ici b) = Ici (b - a) :=
-ext $ λ x, sub_le_iff_le_add'.symm
-
-@[simp] lemma preimage_const_add_Ioi : (λ x, a + x) ⁻¹' (Ioi b) = Ioi (b - a) :=
-ext $ λ x, sub_lt_iff_lt_add'.symm
-
-@[simp] lemma preimage_const_add_Iic : (λ x, a + x) ⁻¹' (Iic b) = Iic (b - a) :=
-ext $ λ x, le_sub_iff_add_le'.symm
-
-@[simp] lemma preimage_const_add_Iio : (λ x, a + x) ⁻¹' (Iio b) = Iio (b - a) :=
-ext $ λ x, lt_sub_iff_add_lt'.symm
-
-@[simp] lemma preimage_const_add_Icc : (λ x, a + x) ⁻¹' (Icc b c) = Icc (b - a) (c - a) :=
-by simp [← Ici_inter_Iic]
-
-@[simp] lemma preimage_const_add_Ico : (λ x, a + x) ⁻¹' (Ico b c) = Ico (b - a) (c - a) :=
-by simp [← Ici_inter_Iio]
-
-@[simp] lemma preimage_const_add_Ioc : (λ x, a + x) ⁻¹' (Ioc b c) = Ioc (b - a) (c - a) :=
-by simp [← Ioi_inter_Iic]
-
-@[simp] lemma preimage_const_add_Ioo : (λ x, a + x) ⁻¹' (Ioo b c) = Ioo (b - a) (c - a) :=
-by simp [← Ioi_inter_Iio]
-
-/-!
-### Preimages under `x ↦ x + a`
--/
-
-@[simp] lemma preimage_add_const_Ici : (λ x, x + a) ⁻¹' (Ici b) = Ici (b - a) :=
-ext $ λ x, sub_le_iff_le_add.symm
-
-@[simp] lemma preimage_add_const_Ioi : (λ x, x + a) ⁻¹' (Ioi b) = Ioi (b - a) :=
-ext $ λ x, sub_lt_iff_lt_add.symm
-
-@[simp] lemma preimage_add_const_Iic : (λ x, x + a) ⁻¹' (Iic b) = Iic (b - a) :=
-ext $ λ x, le_sub_iff_add_le.symm
-
-@[simp] lemma preimage_add_const_Iio : (λ x, x + a) ⁻¹' (Iio b) = Iio (b - a) :=
-ext $ λ x, lt_sub_iff_add_lt.symm
-
-@[simp] lemma preimage_add_const_Icc : (λ x, x + a) ⁻¹' (Icc b c) = Icc (b - a) (c - a) :=
-by simp [← Ici_inter_Iic]
-
-@[simp] lemma preimage_add_const_Ico : (λ x, x + a) ⁻¹' (Ico b c) = Ico (b - a) (c - a) :=
-by simp [← Ici_inter_Iio]
-
-@[simp] lemma preimage_add_const_Ioc : (λ x, x + a) ⁻¹' (Ioc b c) = Ioc (b - a) (c - a) :=
-by simp [← Ioi_inter_Iic]
-
-@[simp] lemma preimage_add_const_Ioo : (λ x, x + a) ⁻¹' (Ioo b c) = Ioo (b - a) (c - a) :=
-by simp [← Ioi_inter_Iio]
-
-/-!
-### Preimages under `x ↦ -x`
--/
-
-@[simp] lemma preimage_neg_Ici : - Ici a = Iic (-a) := ext $ λ x, le_neg
-@[simp] lemma preimage_neg_Iic : - Iic a = Ici (-a) := ext $ λ x, neg_le
-@[simp] lemma preimage_neg_Ioi : - Ioi a = Iio (-a) := ext $ λ x, lt_neg
-@[simp] lemma preimage_neg_Iio : - Iio a = Ioi (-a) := ext $ λ x, neg_lt
-
-@[simp] lemma preimage_neg_Icc : - Icc a b = Icc (-b) (-a) :=
-by simp [← Ici_inter_Iic, inter_comm]
-
-@[simp] lemma preimage_neg_Ico : - Ico a b = Ioc (-b) (-a) :=
-by simp [← Ici_inter_Iio, ← Ioi_inter_Iic, inter_comm]
-
-@[simp] lemma preimage_neg_Ioc : - Ioc a b = Ico (-b) (-a) :=
-by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]
-
-@[simp] lemma preimage_neg_Ioo : - Ioo a b = Ioo (-b) (-a) :=
-by simp [← Ioi_inter_Iio, inter_comm]
-
-/-!
-### Preimages under `x ↦ x - a`
--/
-
-@[simp] lemma preimage_sub_const_Ici : (λ x, x - a) ⁻¹' (Ici b) = Ici (b + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Ioi : (λ x, x - a) ⁻¹' (Ioi b) = Ioi (b + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Iic : (λ x, x - a) ⁻¹' (Iic b) = Iic (b + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Iio : (λ x, x - a) ⁻¹' (Iio b) = Iio (b + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Icc : (λ x, x - a) ⁻¹' (Icc b c) = Icc (b + a) (c + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Ico : (λ x, x - a) ⁻¹' (Ico b c) = Ico (b + a) (c + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Ioc : (λ x, x - a) ⁻¹' (Ioc b c) = Ioc (b + a) (c + a) :=
-by simp [sub_eq_add_neg]
-
-@[simp] lemma preimage_sub_const_Ioo : (λ x, x - a) ⁻¹' (Ioo b c) = Ioo (b + a) (c + a) :=
-by simp [sub_eq_add_neg]
-
-/-!
-### Preimages under `x ↦ a - x`
--/
-
-@[simp] lemma preimage_const_sub_Ici : (λ x, a - x) ⁻¹' (Ici b) = Iic (a - b) :=
-ext $ λ x, le_sub
-
-@[simp] lemma preimage_const_sub_Iic : (λ x, a - x) ⁻¹' (Iic b) = Ici (a - b) :=
-ext $ λ x, sub_le
-
-@[simp] lemma preimage_const_sub_Ioi : (λ x, a - x) ⁻¹' (Ioi b) = Iio (a - b) :=
-ext $ λ x, lt_sub
-
-@[simp] lemma preimage_const_sub_Iio : (λ x, a - x) ⁻¹' (Iio b) = Ioi (a - b) :=
-ext $ λ x, sub_lt
-
-@[simp] lemma preimage_const_sub_Icc : (λ x, a - x) ⁻¹' (Icc b c) = Icc (a - c) (a - b) :=
-by simp [← Ici_inter_Iic, inter_comm]
-
-@[simp] lemma preimage_const_sub_Ico : (λ x, a - x) ⁻¹' (Ico b c) = Ioc (a - c) (a - b) :=
-by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]
-
-@[simp] lemma preimage_const_sub_Ioc : (λ x, a - x) ⁻¹' (Ioc b c) = Ico (a - c) (a - b) :=
-by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]
-
-@[simp] lemma preimage_const_sub_Ioo : (λ x, a - x) ⁻¹' (Ioo b c) = Ioo (a - c) (a - b) :=
-by simp [← Ioi_inter_Iio, inter_comm]
-
-/-!
-### Images under `x ↦ a + x`
--/
-
-@[simp] lemma image_const_add_Ici : (λ x, a + x) '' Ici b = Ici (a + b) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Iic : (λ x, a + x) '' Iic b = Iic (a + b) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Iio : (λ x, a + x) '' Iio b = Iio (a + b) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ioi : (λ x, a + x) '' Ioi b = Ioi (a + b) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Icc : (λ x, a + x) '' Icc b c = Icc (a + b) (a + c) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ico : (λ x, a + x) '' Ico b c = Ico (a + b) (a + c) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ioc : (λ x, a + x) '' Ioc b c = Ioc (a + b) (a + c) :=
-by simp [add_comm]
-
-@[simp] lemma image_const_add_Ioo : (λ x, a + x) '' Ioo b c = Ioo (a + b) (a + c) :=
-by simp [add_comm]
-
-/-!
-### Images under `x ↦ x + a`
--/
-
-@[simp] lemma image_add_const_Ici : (λ x, x + a) '' Ici b = Ici (b + a) := by simp
-@[simp] lemma image_add_const_Iic : (λ x, x + a) '' Iic b = Iic (b + a) := by simp
-@[simp] lemma image_add_const_Iio : (λ x, x + a) '' Iio b = Iio (b + a) := by simp
-@[simp] lemma image_add_const_Ioi : (λ x, x + a) '' Ioi b = Ioi (b + a) := by simp
-
-@[simp] lemma image_add_const_Icc : (λ x, x + a) '' Icc b c = Icc (b + a) (c + a) :=
-by simp
-
-@[simp] lemma image_add_const_Ico : (λ x, x + a) '' Ico b c = Ico (b + a) (c + a) :=
-by simp
-
-@[simp] lemma image_add_const_Ioc : (λ x, x + a) '' Ioc b c = Ioc (b + a) (c + a) :=
-by simp
-
-@[simp] lemma image_add_const_Ioo : (λ x, x + a) '' Ioo b c = Ioo (b + a) (c + a) :=
-by simp
-
-/-!
-### Images under `x ↦ -x`
--/
-
-lemma image_neg_Ici : has_neg.neg '' (Ici a) = Iic (-a) := by simp
-lemma image_neg_Iic : has_neg.neg '' (Iic a) = Ici (-a) := by simp
-lemma image_neg_Ioi : has_neg.neg '' (Ioi a) = Iio (-a) := by simp
-lemma image_neg_Iio : has_neg.neg '' (Iio a) = Ioi (-a) := by simp
-lemma image_neg_Icc : has_neg.neg '' (Icc a b) = Icc (-b) (-a) := by simp
-lemma image_neg_Ico : has_neg.neg '' (Ico a b) = Ioc (-b) (-a) := by simp
-lemma image_neg_Ioc : has_neg.neg '' (Ioc a b) = Ico (-b) (-a) := by simp
-lemma image_neg_Ioo : has_neg.neg '' (Ioo a b) = Ioo (-b) (-a) := by simp
-
-/-!
-### Images under `x ↦ a - x`
--/
-
-@[simp] lemma image_const_sub_Ici : (λ x, a - x) '' Ici b = Iic (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Iic : (λ x, a - x) '' Iic b = Ici (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Ioi : (λ x, a - x) '' Ioi b = Iio (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Iio : (λ x, a - x) '' Iio b = Ioi (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Icc : (λ x, a - x) '' Icc b c = Icc (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Ico : (λ x, a - x) '' Ico b c = Ioc (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Ioc : (λ x, a - x) '' Ioc b c = Ico (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-@[simp] lemma image_const_sub_Ioo : (λ x, a - x) '' Ioo b c = Ioo (a - c) (a - b) :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
-
-/-!
-### Images under `x ↦ x - a`
--/
-
-@[simp] lemma image_sub_const_Ici : (λ x, x - a) '' Ici b = Ici (b - a) := by simp [sub_eq_neg_add]
-@[simp] lemma image_sub_const_Iic : (λ x, x - a) '' Iic b = Iic (b - a) := by simp [sub_eq_neg_add]
-@[simp] lemma image_sub_const_Ioi : (λ x, x - a) '' Ioi b = Ioi (b - a) := by simp [sub_eq_neg_add]
-@[simp] lemma image_sub_const_Iio : (λ x, x - a) '' Iio b = Iio (b - a) := by simp [sub_eq_neg_add]
-
-@[simp] lemma image_sub_const_Icc : (λ x, x - a) '' Icc b c = Icc (b - a) (c - a) :=
-by simp [sub_eq_neg_add]
-
-@[simp] lemma image_sub_const_Ico : (λ x, x - a) '' Ico b c = Ico (b - a) (c - a) :=
-by simp [sub_eq_neg_add]
-
-@[simp] lemma image_sub_const_Ioc : (λ x, x - a) '' Ioc b c = Ioc (b - a) (c - a) :=
-by simp [sub_eq_neg_add]
-
-@[simp] lemma image_sub_const_Ioo : (λ x, x - a) '' Ioo b c = Ioo (b - a) (c - a) :=
-by simp [sub_eq_neg_add]
-
-/-!
-### Bijections
--/
-
-lemma Iic_add_bij : bij_on (+a) (Iic b) (Iic (b + a)) :=
-begin
-  refine ⟨λ x h, add_le_add_right (mem_Iic.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  simpa [add_comm a] using h,
-end
-
-lemma Iio_add_bij : bij_on (+a) (Iio b) (Iio (b + a)) :=
-begin
-  refine ⟨λ x h, add_lt_add_right (mem_Iio.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
-  simpa [add_comm a] using h,
-end
-
-end ordered_add_comm_group
-
-/-!
-### Multiplication and inverse in a field
--/
-
-section linear_ordered_field
-
-variables {k : Type u} [linear_ordered_field k]
-
-@[simp] lemma preimage_mul_const_Iio (a : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Iio a) = Iio (a / c) :=
-ext $ λ x, (lt_div_iff h).symm
-
-@[simp] lemma preimage_mul_const_Ioi (a : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Ioi a) = Ioi (a / c) :=
-ext $ λ x, (div_lt_iff h).symm
-
-@[simp] lemma preimage_mul_const_Iic (a : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Iic a) = Iic (a / c) :=
-ext $ λ x, (le_div_iff h).symm
-
-@[simp] lemma preimage_mul_const_Ici (a : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Ici a) = Ici (a / c) :=
-ext $ λ x, (div_le_iff h).symm
-
-@[simp] lemma preimage_mul_const_Ioo (a b : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Ioo a b) = Ioo (a / c) (b / c) :=
-by simp [← Ioi_inter_Iio, h]
-
-@[simp] lemma preimage_mul_const_Ioc (a b : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Ioc a b) = Ioc (a / c) (b / c) :=
-by simp [← Ioi_inter_Iic, h]
-
-@[simp] lemma preimage_mul_const_Ico (a b : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Ico a b) = Ico (a / c) (b / c) :=
-by simp [← Ici_inter_Iio, h]
-
-@[simp] lemma preimage_mul_const_Icc (a b : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) ⁻¹' (Icc a b) = Icc (a / c) (b / c) :=
-by simp [← Ici_inter_Iic, h]
-
-@[simp] lemma preimage_mul_const_Iio_of_neg (a : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Iio a) = Ioi (a / c) :=
-ext $ λ x, (div_lt_iff_of_neg h).symm
-
-@[simp] lemma preimage_mul_const_Ioi_of_neg (a : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Ioi a) = Iio (a / c) :=
-ext $ λ x, (lt_div_iff_of_neg h).symm
-
-@[simp] lemma preimage_mul_const_Iic_of_neg (a : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Iic a) = Ici (a / c) :=
-ext $ λ x, (div_le_iff_of_neg h).symm
-
-@[simp] lemma preimage_mul_const_Ici_of_neg (a : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Ici a) = Iic (a / c) :=
-ext $ λ x, (le_div_iff_of_neg h).symm
-
-@[simp] lemma preimage_mul_const_Ioo_of_neg (a b : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Ioo a b) = Ioo (b / c) (a / c) :=
-by simp [← Ioi_inter_Iio, h, inter_comm]
-
-@[simp] lemma preimage_mul_const_Ioc_of_neg (a b : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Ioc a b) = Ico (b / c) (a / c) :=
-by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, h, inter_comm]
-
-@[simp] lemma preimage_mul_const_Ico_of_neg (a b : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Ico a b) = Ioc (b / c) (a / c) :=
-by simp [← Ici_inter_Iio, ← Ioi_inter_Iic, h, inter_comm]
-
-@[simp] lemma preimage_mul_const_Icc_of_neg (a b : k) {c : k} (h : c < 0) :
-  (λ x, x * c) ⁻¹' (Icc a b) = Icc (b / c) (a / c) :=
-by simp [← Ici_inter_Iic, h, inter_comm]
-
-@[simp] lemma preimage_const_mul_Iio (a : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Iio a) = Iio (a / c) :=
-ext $ λ x, (lt_div_iff' h).symm
-
-@[simp] lemma preimage_const_mul_Ioi (a : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Ioi a) = Ioi (a / c) :=
-ext $ λ x, (div_lt_iff' h).symm
-
-@[simp] lemma preimage_const_mul_Iic (a : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Iic a) = Iic (a / c) :=
-ext $ λ x, (le_div_iff' h).symm
-
-@[simp] lemma preimage_const_mul_Ici (a : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Ici a) = Ici (a / c) :=
-ext $ λ x, (div_le_iff' h).symm
-
-@[simp] lemma preimage_const_mul_Ioo (a b : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Ioo a b) = Ioo (a / c) (b / c) :=
-by simp [← Ioi_inter_Iio, h]
-
-@[simp] lemma preimage_const_mul_Ioc (a b : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Ioc a b) = Ioc (a / c) (b / c) :=
-by simp [← Ioi_inter_Iic, h]
-
-@[simp] lemma preimage_const_mul_Ico (a b : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Ico a b) = Ico (a / c) (b / c) :=
-by simp [← Ici_inter_Iio, h]
-
-@[simp] lemma preimage_const_mul_Icc (a b : k) {c : k} (h : 0 < c) :
-  ((*) c) ⁻¹' (Icc a b) = Icc (a / c) (b / c) :=
-by simp [← Ici_inter_Iic, h]
-
-@[simp] lemma preimage_const_mul_Iio_of_neg (a : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Iio a) = Ioi (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Iio_of_neg a h
-
-@[simp] lemma preimage_const_mul_Ioi_of_neg (a : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Ioi a) = Iio (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Ioi_of_neg a h
-
-@[simp] lemma preimage_const_mul_Iic_of_neg (a : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Iic a) = Ici (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Iic_of_neg a h
-
-@[simp] lemma preimage_const_mul_Ici_of_neg (a : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Ici a) = Iic (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Ici_of_neg a h
-
-@[simp] lemma preimage_const_mul_Ioo_of_neg (a b : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Ioo a b) = Ioo (b / c) (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Ioo_of_neg a b h
-
-@[simp] lemma preimage_const_mul_Ioc_of_neg (a b : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Ioc a b) = Ico (b / c) (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Ioc_of_neg a b h
-
-@[simp] lemma preimage_const_mul_Ico_of_neg (a b : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Ico a b) = Ioc (b / c) (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Ico_of_neg a b h
-
-@[simp] lemma preimage_const_mul_Icc_of_neg (a b : k) {c : k} (h : c < 0) :
-  ((*) c) ⁻¹' (Icc a b) = Icc (b / c) (a / c) :=
-by simpa only [mul_comm] using preimage_mul_const_Icc_of_neg a b h
-
-lemma image_mul_right_Icc' (a b : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) '' Icc a b = Icc (a * c) (b * c) :=
-((units.mk0 c h.ne').mul_right.image_eq_preimage _).trans (by simp [h, division_def])
-
-lemma image_mul_right_Icc {a b c : k} (hab : a ≤ b) (hc : 0 ≤ c) :
-  (λ x, x * c) '' Icc a b = Icc (a * c) (b * c) :=
-begin
-  cases eq_or_lt_of_le hc,
-  { subst c,
-    simp [(nonempty_Icc.2 hab).image_const] },
-  exact image_mul_right_Icc' a b ‹0 < c›
-end
-
-lemma image_mul_left_Icc' {a : k} (h : 0 < a) (b c : k) :
-  ((*) a) '' Icc b c = Icc (a * b) (a * c) :=
-by { convert image_mul_right_Icc' b c h using 1; simp only [mul_comm _ a] }
-
-lemma image_mul_left_Icc {a b c : k} (ha : 0 ≤ a) (hbc : b ≤ c) :
-  ((*) a) '' Icc b c = Icc (a * b) (a * c) :=
-by { convert image_mul_right_Icc hbc ha using 1; simp only [mul_comm _ a] }
-
-lemma image_mul_right_Ioo (a b : k) {c : k} (h : 0 < c) :
-  (λ x, x * c) '' Ioo a b = Ioo (a * c) (b * c) :=
-((units.mk0 c h.ne').mul_right.image_eq_preimage _).trans (by simp [h, division_def])
-
-lemma image_mul_left_Ioo {a : k} (h : 0 < a) (b c : k) :
-  ((*) a) '' Ioo b c = Ioo (a * b) (a * c) :=
-by { convert image_mul_right_Ioo b c h using 1; simp only [mul_comm _ a] }
-
-/-- The (pre)image under `inv` of `Ioo 0 a` is `Ioi a⁻¹`. -/
-lemma inv_Ioo_0_left {a : k} (ha : 0 < a) : (Ioo 0 a)⁻¹ = Ioi a⁻¹ :=
-begin
-  ext x,
-  exact ⟨λ h, inv_inv x ▸ (inv_lt_inv ha h.1).2 h.2, λ h, ⟨inv_pos.2 $ (inv_pos.2 ha).trans h,
-    inv_inv a ▸ (inv_lt_inv ((inv_pos.2 ha).trans h) (inv_pos.2 ha)).2 h⟩⟩,
-end
-
-lemma inv_Ioi {a : k} (ha : 0 < a) : (Ioi a)⁻¹ = Ioo 0 a⁻¹ :=
-by rw [inv_eq_iff_inv_eq, inv_Ioo_0_left (inv_pos.2 ha), inv_inv]
-
-/-!
-### Images under `x ↦ a * x + b`
--/
-
-@[simp] lemma image_affine_Icc' {a : k} (h : 0 < a) (b c d : k) :
-  (λ x, a * x + b) '' Icc c d = Icc (a * c + b) (a * d + b) :=
-begin
-  suffices : (λ x, x + b) '' ((λ x, a * x) '' Icc c d) = Icc (a * c + b) (a * d + b),
-  { rwa set.image_image at this, },
-  rw [image_mul_left_Icc' h, image_add_const_Icc],
-end
-
-end linear_ordered_field
-end set
diff --git a/src/data/set/intervals/infinite.lean b/src/data/set/intervals/infinite.lean
index cdca43d3557a7..2851bcffdf423 100644
--- a/src/data/set/intervals/infinite.lean
+++ b/src/data/set/intervals/infinite.lean
@@ -8,65 +8,56 @@ import data.set.finite
 /-!
 # Infinitude of intervals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Bounded intervals in dense orders are infinite, as are unbounded intervals
-in orders that are unbounded on the appropriate side.
+in orders that are unbounded on the appropriate side. We also prove that an unbounded
+preorder is an infinite type.
 -/
 
-namespace set
-
 variables {α : Type*} [preorder α]
 
-section bounded
-
-variables [densely_ordered α]
+/-- A nonempty preorder with no maximal element is infinite. This is not an instance to avoid
+a cycle with `infinite α → nontrivial α → nonempty α`. -/
+lemma no_max_order.infinite [nonempty α] [no_max_order α] : infinite α :=
+let ⟨f, hf⟩ := nat.exists_strict_mono α in infinite.of_injective f hf.injective
 
-lemma Ioo.infinite {a b : α} (h : a < b) : infinite (Ioo a b) :=
-begin
-  rintro (f : finite (Ioo a b)),
-  obtain ⟨m, hm₁, hm₂⟩ : ∃ m ∈ Ioo a b, ∀ x ∈ Ioo a b, ¬x < m,
-  { simpa [h] using finset.exists_minimal f.to_finset },
-  obtain ⟨z, hz₁, hz₂⟩ : ∃ z, a < z ∧ z < m := exists_between hm₁.1,
-  exact hm₂ z ⟨hz₁, lt_trans hz₂ hm₁.2⟩ hz₂,
-end
+/-- A nonempty preorder with no minimal element is infinite. This is not an instance to avoid
+a cycle with `infinite α → nontrivial α → nonempty α`. -/
+lemma no_min_order.infinite [nonempty α] [no_min_order α] : infinite α :=
+@no_max_order.infinite αᵒᵈ _ _ _
 
-lemma Ico.infinite {a b : α} (h : a < b) : infinite (Ico a b) :=
-(Ioo.infinite h).mono Ioo_subset_Ico_self
-
-lemma Ioc.infinite {a b : α} (h : a < b) : infinite (Ioc a b) :=
-(Ioo.infinite h).mono Ioo_subset_Ioc_self
-
-lemma Icc.infinite {a b : α} (h : a < b) : infinite (Icc a b) :=
-(Ioo.infinite h).mono Ioo_subset_Icc_self
+namespace set
 
-end bounded
+section densely_ordered
 
-section unbounded_below
+variables [densely_ordered α] {a b : α} (h : a < b)
 
-variables [no_min_order α]
+lemma Ioo.infinite : infinite (Ioo a b) := @no_max_order.infinite _ _ (nonempty_Ioo_subtype h) _
+lemma Ioo_infinite : (Ioo a b).infinite := infinite_coe_iff.1 $ Ioo.infinite h
 
-lemma Iio.infinite {b : α} : infinite (Iio b) :=
-begin
-  rintro (f : finite (Iio b)),
-  obtain ⟨m, hm₁, hm₂⟩ : ∃ m < b, ∀ x < b, ¬x < m,
-  { simpa using finset.exists_minimal f.to_finset },
-  obtain ⟨z, hz⟩ : ∃ z, z < m := exists_lt _,
-  exact hm₂ z (lt_trans hz hm₁) hz
-end
+lemma Ico_infinite : (Ico a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ico_self
+lemma Ico.infinite : infinite (Ico a b) := infinite_coe_iff.2 $ Ico_infinite h
 
-lemma Iic.infinite {b : α} : infinite (Iic b) :=
-Iio.infinite.mono Iio_subset_Iic_self
+lemma Ioc_infinite : (Ioc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Ioc_self
+lemma Ioc.infinite : infinite (Ioc a b) := infinite_coe_iff.2 $ Ioc_infinite h
 
-end unbounded_below
+lemma Icc_infinite : (Icc a b).infinite := (Ioo_infinite h).mono Ioo_subset_Icc_self
+lemma Icc.infinite : infinite (Icc a b) := infinite_coe_iff.2 $ Icc_infinite h
 
-section unbounded_above
+end densely_ordered
 
-variables [no_max_order α]
+instance [no_min_order α] {a : α} : infinite (Iio a) := no_min_order.infinite
+lemma Iio_infinite [no_min_order α] (a : α) : (Iio a).infinite := infinite_coe_iff.1 Iio.infinite
 
-lemma Ioi.infinite {a : α} : infinite (Ioi a) := @Iio.infinite αᵒᵈ _ _ _
+instance [no_min_order α] {a : α} : infinite (Iic a) := no_min_order.infinite
+lemma Iic_infinite [no_min_order α] (a : α) : (Iic a).infinite := infinite_coe_iff.1 Iic.infinite
 
-lemma Ici.infinite {a : α} : infinite (Ici a) :=
-Ioi.infinite.mono Ioi_subset_Ici_self
+instance [no_max_order α] {a : α} : infinite (Ioi a) := no_max_order.infinite
+lemma Ioi_infinite [no_max_order α] (a : α) : (Ioi a).infinite := infinite_coe_iff.1 Ioi.infinite
 
-end unbounded_above
+instance [no_max_order α] {a : α} : infinite (Ici a) := no_max_order.infinite
+lemma Ici_infinite [no_max_order α] (a : α) : (Ici a).infinite := infinite_coe_iff.1 Ici.infinite
 
 end set
diff --git a/src/data/set/intervals/instances.lean b/src/data/set/intervals/instances.lean
new file mode 100644
index 0000000000000..b70ae02eee13e
--- /dev/null
+++ b/src/data/set/intervals/instances.lean
@@ -0,0 +1,261 @@
+/-
+Copyright (c) 2022 Stuart Presnell. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Stuart Presnell, Eric Wieser, Yaël Dillies, Patrick Massot, Scott Morrison
+-/
+import algebra.group_power.order
+import algebra.ring.regular
+
+/-!
+# Algebraic instances for unit intervals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+For suitably structured underlying type `α`, we exhibit the structure of
+the unit intervals (`set.Icc`, `set.Ioc`, `set.Ioc`, and `set.Ioo`) from `0` to `1`.
+
+Note: Instances for the interval `Ici 0` are dealt with in `algebra/order/nonneg.lean`.
+
+## Main definitions
+The strongest typeclass provided on each interval is:
+* `set.Icc.cancel_comm_monoid_with_zero`
+* `set.Ico.comm_semigroup`
+* `set.Ioc.comm_monoid`
+* `set.Ioo.comm_semigroup`
+
+## TODO
+* algebraic instances for intervals -1 to 1
+* algebraic instances for `Ici 1`
+* algebraic instances for `(Ioo (-1) 1)ᶜ`
+* provide `has_distrib_neg` instances where applicable
+* prove versions of `mul_le_{left,right}` for other intervals
+* prove versions of the lemmas in `topology/unit_interval` with `ℝ` generalized to
+  some arbitrary ordered semiring
+
+-/
+
+open set
+
+variables {α : Type*}
+
+section ordered_semiring
+variables [ordered_semiring α]
+
+/-! ### Instances for `↥(set.Icc 0 1)` -/
+
+namespace set.Icc
+
+instance has_zero : has_zero (Icc (0:α) 1) := { zero := ⟨0, left_mem_Icc.2 zero_le_one⟩ }
+
+instance has_one : has_one (Icc (0:α) 1) := { one := ⟨1, right_mem_Icc.2 zero_le_one⟩ }
+
+@[simp, norm_cast] lemma coe_zero : ↑(0 : Icc (0:α) 1) = (0 : α) := rfl
+@[simp, norm_cast] lemma coe_one : ↑(1 : Icc (0:α) 1) = (1 : α) := rfl
+
+@[simp] lemma mk_zero (h : (0 : α) ∈ Icc (0 : α) 1) : (⟨0, h⟩ : Icc (0:α) 1) = 0 := rfl
+@[simp] lemma mk_one (h : (1 : α) ∈ Icc (0 : α) 1) : (⟨1, h⟩ : Icc (0:α) 1) = 1 := rfl
+
+@[simp, norm_cast] lemma coe_eq_zero {x : Icc (0:α) 1} : (x : α) = 0 ↔ x = 0 :=
+by { symmetry, exact subtype.ext_iff }
+
+lemma coe_ne_zero {x : Icc (0:α) 1} : (x : α) ≠ 0 ↔ x ≠ 0 :=
+not_iff_not.mpr coe_eq_zero
+
+@[simp, norm_cast] lemma coe_eq_one {x : Icc (0:α) 1} : (x : α) = 1 ↔ x = 1 :=
+by { symmetry, exact subtype.ext_iff }
+
+lemma coe_ne_one {x : Icc (0:α) 1} : (x : α) ≠ 1 ↔ x ≠ 1 :=
+not_iff_not.mpr coe_eq_one
+
+lemma coe_nonneg (x : Icc (0:α) 1) : 0 ≤ (x : α) := x.2.1
+lemma coe_le_one (x : Icc (0:α) 1) : (x : α) ≤ 1 := x.2.2
+
+/-- like `coe_nonneg`, but with the inequality in `Icc (0:α) 1`. -/
+lemma nonneg {t : Icc (0:α) 1} : 0 ≤ t := t.2.1
+/-- like `coe_le_one`, but with the inequality in `Icc (0:α) 1`. -/
+lemma le_one {t : Icc (0:α) 1} : t ≤ 1 := t.2.2
+
+instance has_mul : has_mul (Icc (0:α) 1) :=
+{ mul := λ p q, ⟨p*q, ⟨mul_nonneg p.2.1 q.2.1, mul_le_one p.2.2 q.2.1 q.2.2⟩⟩ }
+
+instance has_pow : has_pow (Icc (0:α) 1) ℕ :=
+{ pow := λ p n, ⟨p.1 ^ n, ⟨pow_nonneg p.2.1 n, pow_le_one n p.2.1 p.2.2⟩⟩ }
+
+@[simp, norm_cast] lemma coe_mul (x y : Icc (0:α) 1) : ↑(x * y) = (x * y : α) := rfl
+@[simp, norm_cast] lemma coe_pow (x : Icc (0:α) 1) (n : ℕ) : ↑(x ^ n) = (x ^ n : α) := rfl
+
+lemma mul_le_left {x y : Icc (0:α) 1} : x * y ≤ x :=
+(mul_le_mul_of_nonneg_left y.2.2 x.2.1).trans_eq (mul_one x)
+
+lemma mul_le_right {x y : Icc (0:α) 1} : x * y ≤ y :=
+(mul_le_mul_of_nonneg_right x.2.2 y.2.1).trans_eq (one_mul y)
+
+instance monoid_with_zero : monoid_with_zero (Icc (0:α) 1) :=
+subtype.coe_injective.monoid_with_zero _ coe_zero coe_one coe_mul coe_pow
+
+instance comm_monoid_with_zero {α : Type*} [ordered_comm_semiring α] :
+  comm_monoid_with_zero (Icc (0:α) 1) :=
+subtype.coe_injective.comm_monoid_with_zero _ coe_zero coe_one coe_mul coe_pow
+
+instance cancel_monoid_with_zero {α : Type*} [ordered_ring α] [no_zero_divisors α] :
+  cancel_monoid_with_zero (Icc (0:α) 1) :=
+@function.injective.cancel_monoid_with_zero α _ no_zero_divisors.to_cancel_monoid_with_zero
+  _ _ _ _ coe subtype.coe_injective coe_zero coe_one coe_mul coe_pow
+
+instance cancel_comm_monoid_with_zero {α : Type*} [ordered_comm_ring α] [no_zero_divisors α] :
+  cancel_comm_monoid_with_zero (Icc (0:α) 1) :=
+@function.injective.cancel_comm_monoid_with_zero α _
+  no_zero_divisors.to_cancel_comm_monoid_with_zero
+  _ _ _ _ coe subtype.coe_injective coe_zero coe_one coe_mul coe_pow
+
+variables {β : Type*} [ordered_ring β]
+
+lemma one_sub_mem {t : β} (ht : t ∈ Icc (0:β) 1) : 1 - t ∈ Icc (0:β) 1 :=
+by { rw mem_Icc at *, exact ⟨sub_nonneg.2 ht.2, (sub_le_self_iff _).2 ht.1⟩ }
+
+lemma mem_iff_one_sub_mem {t : β} : t ∈ Icc (0:β) 1 ↔ 1 - t ∈ Icc (0:β) 1 :=
+⟨one_sub_mem, λ h, (sub_sub_cancel 1 t) ▸ one_sub_mem h⟩
+
+lemma one_sub_nonneg (x : Icc (0:β) 1) : 0 ≤ 1 - (x : β) := by simpa using x.2.2
+lemma one_sub_le_one (x : Icc (0:β) 1) : 1 - (x : β) ≤ 1 := by simpa using x.2.1
+
+end set.Icc
+
+/-! ### Instances for `↥(set.Ico 0 1)` -/
+
+namespace set.Ico
+
+instance has_zero [nontrivial α] : has_zero (Ico (0:α) 1) :=
+  { zero := ⟨0, left_mem_Ico.2 zero_lt_one⟩ }
+
+@[simp, norm_cast] lemma coe_zero [nontrivial α] : ↑(0 : Ico (0:α) 1) = (0 : α) := rfl
+
+@[simp] lemma mk_zero [nontrivial α] (h : (0 : α) ∈ Ico (0 : α) 1) : (⟨0, h⟩ : Ico (0:α) 1) = 0 :=
+  rfl
+
+@[simp, norm_cast] lemma coe_eq_zero [nontrivial α] {x : Ico (0:α) 1} : (x : α) = 0 ↔ x = 0 :=
+by { symmetry, exact subtype.ext_iff }
+
+lemma coe_ne_zero [nontrivial α] {x : Ico (0:α) 1} : (x : α) ≠ 0 ↔ x ≠ 0 :=
+not_iff_not.mpr coe_eq_zero
+
+lemma coe_nonneg (x : Ico (0:α) 1) : 0 ≤ (x : α) := x.2.1
+lemma coe_lt_one (x : Ico (0:α) 1) : (x : α) < 1 := x.2.2
+
+/-- like `coe_nonneg`, but with the inequality in `Ico (0:α) 1`. -/
+lemma nonneg [nontrivial α] {t : Ico (0:α) 1} : 0 ≤ t := t.2.1
+
+instance has_mul : has_mul (Ico (0:α) 1) :=
+{ mul := λ p q, ⟨p*q, ⟨mul_nonneg p.2.1 q.2.1,
+  mul_lt_one_of_nonneg_of_lt_one_right p.2.2.le q.2.1 q.2.2⟩⟩ }
+
+@[simp, norm_cast] lemma coe_mul (x y : Ico (0:α) 1) : ↑(x * y) = (x * y : α) := rfl
+
+instance semigroup : semigroup (Ico (0:α) 1) :=
+subtype.coe_injective.semigroup _ coe_mul
+
+instance comm_semigroup {α : Type*} [ordered_comm_semiring α] : comm_semigroup (Ico (0:α) 1) :=
+subtype.coe_injective.comm_semigroup _ coe_mul
+
+end set.Ico
+
+end ordered_semiring
+
+variables [strict_ordered_semiring α]
+
+/-! ### Instances for `↥(set.Ioc 0 1)` -/
+
+namespace set.Ioc
+
+instance has_one [nontrivial α] : has_one (Ioc (0:α) 1) := { one := ⟨1, ⟨zero_lt_one, le_refl 1⟩⟩ }
+
+@[simp, norm_cast] lemma coe_one [nontrivial α] : ↑(1 : Ioc (0:α) 1) = (1 : α) := rfl
+
+@[simp] lemma mk_one [nontrivial α] (h : (1 : α) ∈ Ioc (0 : α) 1) : (⟨1, h⟩ : Ioc (0:α) 1) = 1 :=
+  rfl
+
+@[simp, norm_cast] lemma coe_eq_one [nontrivial α] {x : Ioc (0:α) 1} : (x : α) = 1 ↔ x = 1 :=
+by { symmetry, exact subtype.ext_iff }
+
+lemma coe_ne_one [nontrivial α] {x : Ioc (0:α) 1} : (x : α) ≠ 1 ↔ x ≠ 1 :=
+not_iff_not.mpr coe_eq_one
+
+lemma coe_pos (x : Ioc (0:α) 1) : 0 < (x : α) := x.2.1
+lemma coe_le_one (x : Ioc (0:α) 1) : (x : α) ≤ 1 := x.2.2
+
+/-- like `coe_le_one`, but with the inequality in `Ioc (0:α) 1`. -/
+lemma le_one [nontrivial α] {t : Ioc (0:α) 1} : t ≤ 1 := t.2.2
+
+instance has_mul : has_mul (Ioc (0:α) 1) :=
+{ mul := λ p q, ⟨p.1 * q.1, ⟨mul_pos p.2.1 q.2.1, mul_le_one p.2.2 (le_of_lt q.2.1) q.2.2⟩⟩ }
+
+instance has_pow : has_pow (Ioc (0:α) 1) ℕ :=
+{ pow := λ p n, ⟨p.1 ^ n, ⟨pow_pos p.2.1 n, pow_le_one n (le_of_lt p.2.1) p.2.2⟩⟩ }
+
+@[simp, norm_cast] lemma coe_mul (x y : Ioc (0:α) 1) : ↑(x * y) = (x * y : α) := rfl
+@[simp, norm_cast] lemma coe_pow (x : Ioc (0:α) 1) (n : ℕ) : ↑(x ^ n) = (x ^ n : α) := rfl
+
+instance semigroup : semigroup (Ioc (0:α) 1) :=
+subtype.coe_injective.semigroup _ coe_mul
+
+instance monoid [nontrivial α] : monoid (Ioc (0:α) 1) :=
+subtype.coe_injective.monoid _ coe_one coe_mul coe_pow
+
+instance comm_semigroup {α : Type*} [strict_ordered_comm_semiring α] :
+  comm_semigroup (Ioc (0:α) 1) :=
+subtype.coe_injective.comm_semigroup _ coe_mul
+
+instance comm_monoid {α : Type*} [strict_ordered_comm_semiring α] [nontrivial α] :
+  comm_monoid (Ioc (0:α) 1) :=
+subtype.coe_injective.comm_monoid _ coe_one coe_mul coe_pow
+
+instance cancel_monoid {α : Type*} [strict_ordered_ring α] [is_domain α] :
+  cancel_monoid (Ioc (0:α) 1) :=
+{ mul_left_cancel := λ a b c h,
+    subtype.ext $ mul_left_cancel₀ a.prop.1.ne' $ (congr_arg subtype.val h : _),
+  mul_right_cancel := λ a b c h,
+    subtype.ext $ mul_right_cancel₀ b.prop.1.ne' $ (congr_arg subtype.val h : _),
+  ..set.Ioc.monoid}
+
+instance cancel_comm_monoid {α : Type*} [strict_ordered_comm_ring α] [is_domain α] :
+  cancel_comm_monoid (Ioc (0:α) 1) :=
+{ ..set.Ioc.cancel_monoid, ..set.Ioc.comm_monoid }
+
+end set.Ioc
+
+/-! ### Instances for `↥(set.Ioo 0 1)` -/
+
+namespace set.Ioo
+
+lemma pos (x : Ioo (0:α) 1) : 0 < (x : α) := x.2.1
+lemma lt_one (x : Ioo (0:α) 1) : (x : α) < 1 := x.2.2
+
+instance has_mul : has_mul (Ioo (0:α) 1) := { mul := λ p q, ⟨p.1 * q.1, ⟨mul_pos p.2.1 q.2.1,
+  mul_lt_one_of_nonneg_of_lt_one_right p.2.2.le q.2.1.le q.2.2⟩⟩ }
+
+@[simp, norm_cast] lemma coe_mul (x y : Ioo (0:α) 1) : ↑(x * y) = (x * y : α) := rfl
+
+instance semigroup : semigroup (Ioo (0:α) 1) :=
+subtype.coe_injective.semigroup _ coe_mul
+
+instance comm_semigroup {α : Type*} [strict_ordered_comm_semiring α] :
+  comm_semigroup (Ioo (0:α) 1) :=
+subtype.coe_injective.comm_semigroup _ coe_mul
+
+variables {β : Type*} [ordered_ring β]
+
+lemma one_sub_mem {t : β} (ht : t ∈ Ioo (0:β) 1) : 1 - t ∈ Ioo (0:β) 1 :=
+begin
+  rw mem_Ioo at *,
+  refine ⟨sub_pos.2 ht.2, _⟩,
+  exact lt_of_le_of_ne ((sub_le_self_iff 1).2 ht.1.le) (mt sub_eq_self.mp ht.1.ne'),
+end
+
+lemma mem_iff_one_sub_mem {t : β} : t ∈ Ioo (0:β) 1 ↔ 1 - t ∈ Ioo (0:β) 1 :=
+⟨one_sub_mem, λ h, (sub_sub_cancel 1 t) ▸ one_sub_mem h⟩
+
+lemma one_minus_pos (x : Ioo (0:β) 1) : 0 < 1 - (x : β) := by simpa using x.2.2
+lemma one_minus_lt_one (x : Ioo (0:β) 1) : 1 - (x : β) < 1 := by simpa using x.2.1
+
+end set.Ioo
diff --git a/src/data/set/intervals/iso_Ioo.lean b/src/data/set/intervals/iso_Ioo.lean
new file mode 100644
index 0000000000000..1ce9692e865e7
--- /dev/null
+++ b/src/data/set/intervals/iso_Ioo.lean
@@ -0,0 +1,40 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import order.monotone.odd
+import tactic.field_simp
+
+/-!
+# Order isomorphism between a linear ordered field and `(-1, 1)`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we provide an order isomorphism `order_iso_Ioo_neg_one_one` between the open interval
+`(-1, 1)` in a linear ordered field and the whole field.
+-/
+
+open set
+
+/-- In a linear ordered field, the whole field is order isomorphic to the open interval `(-1, 1)`.
+We consider the actual implementation to be a "black box", so it is irreducible.
+-/
+@[irreducible] def order_iso_Ioo_neg_one_one (k : Type*) [linear_ordered_field k] :
+  k ≃o Ioo (-1 : k) 1 :=
+begin
+  refine strict_mono.order_iso_of_right_inverse _ _ (λ x, x / (1 - |x|)) _,
+  { refine cod_restrict (λ x, x / (1 + |x|)) _ (λ x, abs_lt.1 _),
+    have H : 0 < 1 + |x|, from (abs_nonneg x).trans_lt (lt_one_add _),
+    calc |x / (1 + |x|)| = |x| / (1 + |x|) : by rw [abs_div, abs_of_pos H]
+                     ... < 1               : (div_lt_one H).2 (lt_one_add _) },
+  { refine (strict_mono_of_odd_strict_mono_on_nonneg _ _).cod_restrict _,
+    { intro x, simp only [abs_neg, neg_div] },
+    { rintros x (hx : 0 ≤ x) y (hy : 0 ≤ y) hxy,
+      simp [abs_of_nonneg, mul_add, mul_comm x y, div_lt_div_iff,
+        hx.trans_lt (lt_one_add _), hy.trans_lt (lt_one_add _), *] } },
+  { refine λ x, subtype.ext _,
+    have : 0 < 1 - |(x : k)|, from sub_pos.2 (abs_lt.2 x.2),
+    field_simp [abs_div, this.ne', abs_of_pos this] }
+end
diff --git a/src/data/set/intervals/monoid.lean b/src/data/set/intervals/monoid.lean
new file mode 100644
index 0000000000000..30d120a5f3a25
--- /dev/null
+++ b/src/data/set/intervals/monoid.lean
@@ -0,0 +1,116 @@
+/-
+Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury G. Kudryashov, Patrick Massot
+-/
+import data.set.intervals.basic
+import data.set.function
+import algebra.order.monoid.cancel.defs
+import algebra.order.monoid.canonical.defs
+import algebra.group.basic
+
+/-!
+# Images of intervals under `(+ d)`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The lemmas in this file state that addition maps intervals bijectively. The typeclass
+`has_exists_add_of_le` is defined specifically to make them work when combined with
+`ordered_cancel_add_comm_monoid`; the lemmas below therefore apply to all
+`ordered_add_comm_group`, but also to `ℕ` and `ℝ≥0`, which are not groups.
+-/
+
+namespace set
+
+variables {M : Type*} [ordered_cancel_add_comm_monoid M] [has_exists_add_of_le M] (a b c d : M)
+
+lemma Ici_add_bij : bij_on (+d) (Ici a) (Ici (a + d)) :=
+begin
+  refine ⟨λ x h, add_le_add_right (mem_Ici.mp h) _, (add_left_injective d).inj_on _, λ _ h, _⟩,
+  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ici.mp h),
+  rw [mem_Ici, add_right_comm, add_le_add_iff_right] at h,
+  exact ⟨a + c, h, by rw add_right_comm⟩,
+end
+
+lemma Ioi_add_bij : bij_on (+d) (Ioi a) (Ioi (a + d)) :=
+begin
+  refine ⟨λ x h, add_lt_add_right (mem_Ioi.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
+  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ioi.mp h).le,
+  rw [mem_Ioi, add_right_comm, add_lt_add_iff_right] at h,
+  exact ⟨a + c, h, by rw add_right_comm⟩,
+end
+
+lemma Icc_add_bij : bij_on (+d) (Icc a b) (Icc (a + d) (b + d)) :=
+begin
+  rw [← Ici_inter_Iic, ← Ici_inter_Iic],
+  exact (Ici_add_bij a d).inter_maps_to (λ x hx, add_le_add_right hx _)
+    (λ x hx, le_of_add_le_add_right hx.2)
+end
+
+lemma Ioo_add_bij : bij_on (+d) (Ioo a b) (Ioo (a + d) (b + d)) :=
+begin
+  rw [← Ioi_inter_Iio, ← Ioi_inter_Iio],
+  exact (Ioi_add_bij a d).inter_maps_to (λ x hx, add_lt_add_right hx _)
+    (λ x hx, lt_of_add_lt_add_right hx.2)
+end
+
+lemma Ioc_add_bij : bij_on (+d) (Ioc a b) (Ioc (a + d) (b + d)) :=
+begin
+  rw [← Ioi_inter_Iic, ← Ioi_inter_Iic],
+  exact (Ioi_add_bij a d).inter_maps_to (λ x hx, add_le_add_right hx _)
+    (λ x hx, le_of_add_le_add_right hx.2)
+end
+
+lemma Ico_add_bij : bij_on (+d) (Ico a b) (Ico (a + d) (b + d)) :=
+begin
+  rw [← Ici_inter_Iio, ← Ici_inter_Iio],
+  exact (Ici_add_bij a d).inter_maps_to (λ x hx, add_lt_add_right hx _)
+    (λ x hx, lt_of_add_lt_add_right hx.2)
+end
+
+/-!
+### Images under `x ↦ x + a`
+-/
+
+@[simp] lemma image_add_const_Ici : (λ x, x + a) '' Ici b = Ici (b + a) :=
+(Ici_add_bij _ _).image_eq
+
+@[simp] lemma image_add_const_Ioi : (λ x, x + a) '' Ioi b = Ioi (b + a) :=
+(Ioi_add_bij _ _).image_eq
+
+@[simp] lemma image_add_const_Icc : (λ x, x + a) '' Icc b c = Icc (b + a) (c + a) :=
+(Icc_add_bij _ _ _).image_eq
+
+@[simp] lemma image_add_const_Ico : (λ x, x + a) '' Ico b c = Ico (b + a) (c + a) :=
+(Ico_add_bij _ _ _).image_eq
+
+@[simp] lemma image_add_const_Ioc : (λ x, x + a) '' Ioc b c = Ioc (b + a) (c + a) :=
+(Ioc_add_bij _ _ _).image_eq
+
+@[simp] lemma image_add_const_Ioo : (λ x, x + a) '' Ioo b c = Ioo (b + a) (c + a) :=
+(Ioo_add_bij _ _ _).image_eq
+
+/-!
+### Images under `x ↦ a + x`
+-/
+
+@[simp] lemma image_const_add_Ici : (λ x, a + x) '' Ici b = Ici (a + b) :=
+by simp only [add_comm a, image_add_const_Ici]
+
+@[simp] lemma image_const_add_Ioi : (λ x, a + x) '' Ioi b = Ioi (a + b) :=
+by simp only [add_comm a, image_add_const_Ioi]
+
+@[simp] lemma image_const_add_Icc : (λ x, a + x) '' Icc b c = Icc (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Icc]
+
+@[simp] lemma image_const_add_Ico : (λ x, a + x) '' Ico b c = Ico (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Ico]
+
+@[simp] lemma image_const_add_Ioc : (λ x, a + x) '' Ioc b c = Ioc (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Ioc]
+
+@[simp] lemma image_const_add_Ioo : (λ x, a + x) '' Ioo b c = Ioo (a + b) (a + c) :=
+by simp only [add_comm a, image_add_const_Ioo]
+
+end set
diff --git a/src/data/set/intervals/monotone.lean b/src/data/set/intervals/monotone.lean
index 58f95ed94491a..ee16fb679330a 100644
--- a/src/data/set/intervals/monotone.lean
+++ b/src/data/set/intervals/monotone.lean
@@ -4,100 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
 import data.set.intervals.disjoint
-import tactic.field_simp
+import order.succ_pred.basic
 
 /-!
 # Monotonicity on intervals
 
-In this file we prove that a function is (strictly) monotone (or antitone) on a linear order `α`
-provided that it is (strictly) monotone on `(-∞, a]` and on `[a, +∞)`. We also provide an order
-isomorphism `order_iso_Ioo_neg_one_one` between the open interval `(-1, 1)` in a linear ordered
-field and the whole field.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that `set.Ici` etc are monotone/antitone functions. We also prove some lemmas
+about functions monotone on intervals in `succ_order`s.
 -/
 
 open set
 
-section
-
-variables {α β : Type*} [linear_order α] [preorder β] {a : α} {f : α → β}
-
-/-- If `f` is strictly monotone both on `(-∞, a]` and `[a, ∞)`, then it is strictly monotone on the
-whole line. -/
-protected lemma strict_mono_on.Iic_union_Ici (h₁ : strict_mono_on f (Iic a))
-  (h₂ : strict_mono_on f (Ici a)) : strict_mono f :=
-begin
-  intros x y hxy,
-  cases lt_or_le a x with hax hxa; [skip, cases le_or_lt y a with hya hay],
-  exacts [h₂ hax.le (hax.trans hxy).le hxy, h₁ hxa hya hxy,
-    (h₁.monotone_on hxa le_rfl hxa).trans_lt (h₂ le_rfl hay.le hay)]
-end
-
-/-- If `f` is strictly antitone both on `(-∞, a]` and `[a, ∞)`, then it is strictly antitone on the
-whole line. -/
-protected lemma strict_anti_on.Iic_union_Ici (h₁ : strict_anti_on f (Iic a))
-  (h₂ : strict_anti_on f (Ici a)) : strict_anti f :=
-(h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right
-protected lemma monotone_on.Iic_union_Ici (h₁ : monotone_on f (Iic a))
-  (h₂ : monotone_on f (Ici a)) : monotone f :=
-begin
-  intros x y hxy,
-  cases le_total x a with hxa hax; [cases le_total y a with hya hay, skip],
-  exacts [h₁ hxa hya hxy, (h₁ hxa le_rfl hxa).trans (h₂ le_rfl hay hay), h₂ hax (hax.trans hxy) hxy]
-end
-
-protected lemma antitone_on.Iic_union_Ici (h₁ : antitone_on f (Iic a))
-  (h₂ : antitone_on f (Ici a)) : antitone f :=
-(h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right
-
-end
-
-section ordered_group
-
-variables {G H : Type*} [linear_ordered_add_comm_group G] [ordered_add_comm_group H]
-
-lemma strict_mono_of_odd_strict_mono_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
-  (h₂ : strict_mono_on f (Ici 0)) :
-  strict_mono f :=
-begin
-  refine strict_mono_on.Iic_union_Ici (λ x hx y hy hxy, neg_lt_neg_iff.1 _) h₂,
-  rw [← h₁, ← h₁],
-  exact h₂ (neg_nonneg.2 hy) (neg_nonneg.2 hx) (neg_lt_neg hxy)
-end
-
-lemma monotone_of_odd_of_monotone_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
-  (h₂ : monotone_on f (Ici 0)) : monotone f :=
-begin
-  refine monotone_on.Iic_union_Ici (λ x hx y hy hxy, neg_le_neg_iff.1 _) h₂,
-  rw [← h₁, ← h₁],
-  exact h₂ (neg_nonneg.2 hy) (neg_nonneg.2 hx) (neg_le_neg hxy)
-end
-
-end ordered_group
-
-/-- In a linear ordered field, the whole field is order isomorphic to the open interval `(-1, 1)`.
-We consider the actual implementation to be a "black box", so it is irreducible.
--/
-@[irreducible] def order_iso_Ioo_neg_one_one (k : Type*) [linear_ordered_field k] :
-  k ≃o Ioo (-1 : k) 1 :=
-begin
-  refine strict_mono.order_iso_of_right_inverse _ _ (λ x, x / (1 - |x|)) _,
-  { refine cod_restrict (λ x, x / (1 + |x|)) _ (λ x, abs_lt.1 _),
-    have H : 0 < 1 + |x|, from (abs_nonneg x).trans_lt (lt_one_add _),
-    calc |x / (1 + |x|)| = |x| / (1 + |x|) : by rw [abs_div, abs_of_pos H]
-                     ... < 1               : (div_lt_one H).2 (lt_one_add _) },
-  { refine (strict_mono_of_odd_strict_mono_on_nonneg _ _).cod_restrict _,
-    { intro x, simp only [abs_neg, neg_div] },
-    { rintros x (hx : 0 ≤ x) y (hy : 0 ≤ y) hxy,
-      simp [abs_of_nonneg, mul_add, mul_comm x y, div_lt_div_iff,
-        hx.trans_lt (lt_one_add _), hy.trans_lt (lt_one_add _), *] } },
-  { refine λ x, subtype.ext _,
-    have : 0 < 1 - |(x : k)|, from sub_pos.2 (abs_lt.2 x.2),
-    field_simp [abs_div, this.ne', abs_of_pos this] }
-end
-
 section Ixx
 
-variables {α β : Type*} [preorder α] [preorder β] {f g : α → β}
+variables {α β : Type*} [preorder α] [preorder β] {f g : α → β} {s : set α}
 
 lemma antitone_Ici : antitone (Ici : α → set α) := λ _ _, Ici_subset_Ici.2
 
@@ -110,59 +33,115 @@ lemma monotone_Iio : monotone (Iio : α → set α) := λ _ _, Iio_subset_Iio
 protected lemma monotone.Ici (hf : monotone f) : antitone (λ x, Ici (f x)) :=
 antitone_Ici.comp_monotone hf
 
+protected lemma monotone_on.Ici (hf : monotone_on f s) : antitone_on (λ x, Ici (f x)) s :=
+antitone_Ici.comp_monotone_on hf
+
 protected lemma antitone.Ici (hf : antitone f) : monotone (λ x, Ici (f x)) :=
 antitone_Ici.comp hf
 
+protected lemma antitone_on.Ici (hf : antitone_on f s) : monotone_on (λ x, Ici (f x)) s :=
+antitone_Ici.comp_antitone_on hf
+
 protected lemma monotone.Iic (hf : monotone f) : monotone (λ x, Iic (f x)) :=
 monotone_Iic.comp hf
 
+protected lemma monotone_on.Iic (hf : monotone_on f s) : monotone_on (λ x, Iic (f x)) s :=
+monotone_Iic.comp_monotone_on hf
+
 protected lemma antitone.Iic (hf : antitone f) : antitone (λ x, Iic (f x)) :=
 monotone_Iic.comp_antitone hf
 
+protected lemma antitone_on.Iic (hf : antitone_on f s) : antitone_on (λ x, Iic (f x)) s :=
+monotone_Iic.comp_antitone_on hf
+
 protected lemma monotone.Ioi (hf : monotone f) : antitone (λ x, Ioi (f x)) :=
 antitone_Ioi.comp_monotone hf
 
+protected lemma monotone_on.Ioi (hf : monotone_on f s) : antitone_on (λ x, Ioi (f x)) s :=
+antitone_Ioi.comp_monotone_on hf
+
 protected lemma antitone.Ioi (hf : antitone f) : monotone (λ x, Ioi (f x)) :=
 antitone_Ioi.comp hf
 
+protected lemma antitone_on.Ioi (hf : antitone_on f s) : monotone_on (λ x, Ioi (f x)) s :=
+antitone_Ioi.comp_antitone_on hf
+
 protected lemma monotone.Iio (hf : monotone f) : monotone (λ x, Iio (f x)) :=
 monotone_Iio.comp hf
 
+protected lemma monotone_on.Iio (hf : monotone_on f s) : monotone_on (λ x, Iio (f x)) s :=
+monotone_Iio.comp_monotone_on hf
+
 protected lemma antitone.Iio (hf : antitone f) : antitone (λ x, Iio (f x)) :=
 monotone_Iio.comp_antitone hf
 
+protected lemma antitone_on.Iio (hf : antitone_on f s) : antitone_on (λ x, Iio (f x)) s :=
+monotone_Iio.comp_antitone_on hf
+
 protected lemma monotone.Icc (hf : monotone f) (hg : antitone g) :
   antitone (λ x, Icc (f x) (g x)) :=
 hf.Ici.inter hg.Iic
 
+protected lemma monotone_on.Icc (hf : monotone_on f s) (hg : antitone_on g s) :
+  antitone_on (λ x, Icc (f x) (g x)) s :=
+hf.Ici.inter hg.Iic
+
 protected lemma antitone.Icc (hf : antitone f) (hg : monotone g) :
   monotone (λ x, Icc (f x) (g x)) :=
 hf.Ici.inter hg.Iic
 
+protected lemma antitone_on.Icc (hf : antitone_on f s) (hg : monotone_on g s) :
+  monotone_on (λ x, Icc (f x) (g x)) s :=
+hf.Ici.inter hg.Iic
+
 protected lemma monotone.Ico (hf : monotone f) (hg : antitone g) :
   antitone (λ x, Ico (f x) (g x)) :=
 hf.Ici.inter hg.Iio
 
+protected lemma monotone_on.Ico (hf : monotone_on f s) (hg : antitone_on g s) :
+  antitone_on (λ x, Ico (f x) (g x)) s :=
+hf.Ici.inter hg.Iio
+
 protected lemma antitone.Ico (hf : antitone f) (hg : monotone g) :
   monotone (λ x, Ico (f x) (g x)) :=
 hf.Ici.inter hg.Iio
 
+protected lemma antitone_on.Ico (hf : antitone_on f s) (hg : monotone_on g s) :
+  monotone_on (λ x, Ico (f x) (g x)) s :=
+hf.Ici.inter hg.Iio
+
 protected lemma monotone.Ioc (hf : monotone f) (hg : antitone g) :
   antitone (λ x, Ioc (f x) (g x)) :=
 hf.Ioi.inter hg.Iic
 
+protected lemma monotone_on.Ioc (hf : monotone_on f s) (hg : antitone_on g s) :
+  antitone_on (λ x, Ioc (f x) (g x)) s :=
+hf.Ioi.inter hg.Iic
+
 protected lemma antitone.Ioc (hf : antitone f) (hg : monotone g) :
   monotone (λ x, Ioc (f x) (g x)) :=
 hf.Ioi.inter hg.Iic
 
+protected lemma antitone_on.Ioc (hf : antitone_on f s) (hg : monotone_on g s) :
+  monotone_on (λ x, Ioc (f x) (g x)) s :=
+hf.Ioi.inter hg.Iic
+
 protected lemma monotone.Ioo (hf : monotone f) (hg : antitone g) :
   antitone (λ x, Ioo (f x) (g x)) :=
 hf.Ioi.inter hg.Iio
 
+protected lemma monotone_on.Ioo (hf : monotone_on f s) (hg : antitone_on g s) :
+  antitone_on (λ x, Ioo (f x) (g x)) s :=
+hf.Ioi.inter hg.Iio
+
 protected lemma antitone.Ioo (hf : antitone f) (hg : monotone g) :
   monotone (λ x, Ioo (f x) (g x)) :=
 hf.Ioi.inter hg.Iio
 
+protected lemma antitone_on.Ioo (hf : antitone_on f s) (hg : monotone_on g s) :
+  monotone_on (λ x, Ioo (f x) (g x)) s :=
+hf.Ioi.inter hg.Iio
+
 end Ixx
 
 section Union
@@ -177,3 +156,79 @@ calc (⋃ x, Ioo (f x) (g x)) = (⋃ x, Ioi (f x)) ∩ ⋃ x, Iio (g x) :
 ... = Ioi a ∩ Iio b : congr_arg2 (∩) ha.Union_Ioi_eq hb.Union_Iio_eq
 
 end Union
+
+section succ_order
+
+open order
+
+variables {α β : Type*} [partial_order α]
+
+lemma strict_mono_on.Iic_id_le [succ_order α] [is_succ_archimedean α] [order_bot α]
+  {n : α} {φ : α → α} (hφ : strict_mono_on φ (set.Iic n)) :
+  ∀ m ≤ n, m ≤ φ m :=
+begin
+  revert hφ,
+  refine succ.rec_bot (λ n, strict_mono_on φ (set.Iic n) → ∀ m ≤ n, m ≤ φ m)
+    (λ _ _ hm, hm.trans bot_le) _ _,
+  rintro k ih hφ m hm,
+  by_cases hk : is_max k,
+  { rw succ_eq_iff_is_max.2 hk at hm,
+    exact ih (hφ.mono $ Iic_subset_Iic.2 (le_succ _)) _ hm },
+  obtain (rfl | h) := le_succ_iff_eq_or_le.1 hm,
+  { specialize ih (strict_mono_on.mono hφ (λ x hx, le_trans hx (le_succ _))) k le_rfl,
+    refine le_trans (succ_mono ih) (succ_le_of_lt (hφ (le_succ _) le_rfl _)),
+    rw lt_succ_iff_eq_or_lt_of_not_is_max hk,
+    exact or.inl rfl },
+  { exact ih (strict_mono_on.mono hφ (λ x hx, le_trans hx (le_succ _))) _ h }
+end
+
+lemma strict_mono_on.Ici_le_id [pred_order α] [is_pred_archimedean α] [order_top α]
+  {n : α} {φ : α → α} (hφ : strict_mono_on φ (set.Ici n)) :
+  ∀ m, n ≤ m → φ m ≤ m :=
+@strict_mono_on.Iic_id_le αᵒᵈ _ _ _ _ _ _ (λ i hi j hj hij, hφ hj hi hij)
+
+variables [preorder β] {ψ : α → β}
+
+/-- A function `ψ` on a `succ_order` is strictly monotone before some `n` if for all `m` such that
+`m < n`, we have `ψ m < ψ (succ m)`. -/
+lemma strict_mono_on_Iic_of_lt_succ [succ_order α] [is_succ_archimedean α]
+  {n : α} (hψ : ∀ m, m < n → ψ m < ψ (succ m)) :
+  strict_mono_on ψ (set.Iic n) :=
+begin
+  intros x hx y hy hxy,
+  obtain ⟨i, rfl⟩ := hxy.le.exists_succ_iterate,
+  induction i with k ih,
+  { simpa using hxy },
+  cases k,
+  { exact hψ _ (lt_of_lt_of_le hxy hy) },
+  rw set.mem_Iic at *,
+  simp only [function.iterate_succ', function.comp_apply] at ih hxy hy ⊢,
+  by_cases hmax : is_max (succ^[k] x),
+  { rw succ_eq_iff_is_max.2 hmax at hxy ⊢,
+    exact ih (le_trans (le_succ _) hy) hxy },
+  by_cases hmax' : is_max (succ (succ^[k] x)),
+  { rw succ_eq_iff_is_max.2 hmax' at hxy ⊢,
+    exact ih (le_trans (le_succ _) hy) hxy },
+  refine lt_trans (ih (le_trans (le_succ _) hy)
+    (lt_of_le_of_lt (le_succ_iterate k _) (lt_succ_iff_not_is_max.2 hmax))) _,
+  rw [← function.comp_apply succ, ← function.iterate_succ'],
+  refine hψ _ (lt_of_lt_of_le _ hy),
+  rwa [function.iterate_succ', function.comp_apply, lt_succ_iff_not_is_max],
+end
+
+lemma strict_anti_on_Iic_of_succ_lt [succ_order α] [is_succ_archimedean α]
+  {n : α} (hψ : ∀ m, m < n → ψ (succ m) < ψ m) :
+  strict_anti_on ψ (set.Iic n) :=
+λ i hi j hj hij, @strict_mono_on_Iic_of_lt_succ α βᵒᵈ _ _ ψ _ _ n hψ i hi j hj hij
+
+lemma strict_mono_on_Ici_of_pred_lt [pred_order α] [is_pred_archimedean α]
+  {n : α} (hψ : ∀ m, n < m → ψ (pred m) < ψ m) :
+  strict_mono_on ψ (set.Ici n) :=
+λ i hi j hj hij, @strict_mono_on_Iic_of_lt_succ αᵒᵈ βᵒᵈ _ _ ψ _ _ n hψ j hj i hi hij
+
+lemma strict_anti_on_Ici_of_lt_pred [pred_order α] [is_pred_archimedean α]
+  {n : α} (hψ : ∀ m, n < m → ψ m < ψ (pred m)) :
+  strict_anti_on ψ (set.Ici n) :=
+λ i hi j hj hij, @strict_anti_on_Iic_of_succ_lt αᵒᵈ βᵒᵈ _ _ ψ _ _ n hψ j hj i hi hij
+
+end succ_order
diff --git a/src/data/set/intervals/ord_connected.lean b/src/data/set/intervals/ord_connected.lean
index a18dcbd8d37ea..b0f3f1bec8817 100644
--- a/src/data/set/intervals/ord_connected.lean
+++ b/src/data/set/intervals/ord_connected.lean
@@ -5,10 +5,14 @@ Authors: Yury G. Kudryashov
 -/
 import data.set.intervals.unordered_interval
 import data.set.lattice
+import order.antichain
 
 /-!
 # Order-connected sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
 interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
 the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α` is a
@@ -18,6 +22,9 @@ In this file we prove that intersection of a family of `ord_connected` sets is `
 that all standard intervals are `ord_connected`.
 -/
 
+open_locale interval
+open order_dual (to_dual of_dual)
+
 namespace set
 section preorder
 variables {α β : Type*} [preorder α] [preorder β] {s t : set α}
@@ -53,6 +60,14 @@ begin
   exact insert_subset.2 ⟨hx, insert_subset.2 ⟨hy, hs x hx y hy hxy'⟩⟩,
 end
 
+lemma ord_connected.preimage_mono {f : β → α} (hs : ord_connected s) (hf : monotone f) :
+  ord_connected (f ⁻¹' s) :=
+⟨λ x hx y hy z hz, hs.out hx hy ⟨hf hz.1, hf hz.2⟩⟩
+
+lemma ord_connected.preimage_anti {f : β → α} (hs : ord_connected s) (hf : antitone f) :
+  ord_connected (f ⁻¹' s) :=
+⟨λ x hx y hy z hz, hs.out hy hx ⟨hf hz.2, hf hz.1⟩⟩
+
 protected lemma Icc_subset (s : set α) [hs : ord_connected s] {x y} (hx : x ∈ s) (hy : y ∈ s) :
   Icc x y ⊆ s := hs.out hx hy
 
@@ -134,49 +149,72 @@ instance [densely_ordered α] {s : set α} [hs : ord_connected s] :
 ⟨λ a b (h : (a : α) < b), let ⟨x, H⟩ := exists_between h in
     ⟨⟨x, (hs.out a.2 b.2) (Ioo_subset_Icc_self H)⟩, H⟩ ⟩
 
+@[instance] lemma ord_connected_preimage {F : Type*} [order_hom_class F α β] (f : F) {s : set β}
+  [hs : ord_connected s] : ord_connected (f ⁻¹' s) :=
+⟨λ x hx y hy z hz, hs.out hx hy ⟨order_hom_class.mono _ hz.1, order_hom_class.mono _ hz.2⟩⟩
+
 @[instance] lemma ord_connected_image {E : Type*} [order_iso_class E α β] (e : E) {s : set α}
   [hs : ord_connected s] : ord_connected (e '' s) :=
-begin
-  constructor,
-  rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ z ⟨hxz, hzy⟩,
-  exact ⟨equiv_like.inv e z, hs.out hx hy ⟨(le_map_inv_iff e).mpr hxz, (map_inv_le_iff e).mpr hzy⟩,
-    equiv_like.right_inv e z⟩
-end
+by { erw [(e : α ≃o β).image_eq_preimage], apply ord_connected_preimage }
 
 @[instance] lemma ord_connected_range {E : Type*} [order_iso_class E α β] (e : E) :
   ord_connected (range e) :=
 by simp_rw [← image_univ, ord_connected_image e]
 
+@[simp] lemma dual_ord_connected_iff {s : set α} :
+  ord_connected (of_dual ⁻¹' s) ↔ ord_connected s :=
+begin
+  simp_rw [ord_connected_def, to_dual.surjective.forall, dual_Icc, subtype.forall'],
+  exact forall_swap
+end
+
+@[instance] lemma dual_ord_connected {s : set α} [ord_connected s] :
+  ord_connected (of_dual ⁻¹' s) :=
+dual_ord_connected_iff.2 ‹_›
+
 end preorder
 
+section partial_order
+variables {α : Type*} [partial_order α] {s : set α}
+
+protected lemma _root_.is_antichain.ord_connected (hs : is_antichain (≤) s) : s.ord_connected :=
+⟨λ x hx y hy z hz, by { obtain rfl := hs.eq hx hy (hz.1.trans hz.2),
+  rw [Icc_self, mem_singleton_iff] at hz, rwa hz }⟩
+
+end partial_order
+
 section linear_order
 variables {α : Type*} [linear_order α] {s : set α} {x : α}
 
-@[instance] lemma ord_connected_interval {a b : α} : ord_connected (interval a b) :=
-ord_connected_Icc
+@[instance] lemma ord_connected_uIcc {a b : α} : ord_connected [a, b] := ord_connected_Icc
+@[instance] lemma ord_connected_uIoc {a b : α} : ord_connected (Ι a b) := ord_connected_Ioc
 
-lemma ord_connected.interval_subset (hs : ord_connected s) ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) :
-  interval x y ⊆ s :=
-by cases le_total x y; simp only [interval_of_le, interval_of_ge, *]; apply hs.out; assumption
+lemma ord_connected.uIcc_subset (hs : ord_connected s) ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) :
+  [x, y] ⊆ s :=
+hs.out (min_rec' (∈ s) hx hy) (max_rec' (∈ s) hx hy)
 
-lemma ord_connected_iff_interval_subset :
-  ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), interval x y ⊆ s :=
-⟨λ h, h.interval_subset,
-  λ h, ord_connected_iff.2 $ λ x hx y hy hxy, by simpa only [interval_of_le hxy] using h hx hy⟩
+lemma ord_connected.uIoc_subset (hs : ord_connected s) ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) :
+  Ι x y ⊆ s :=
+Ioc_subset_Icc_self.trans $ hs.uIcc_subset hx hy
 
-lemma ord_connected_iff_interval_subset_left (hx : x ∈ s) :
-  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → interval x y ⊆ s :=
-begin
-  refine ⟨λ hs, hs.interval_subset hx, λ hs, ord_connected_iff_interval_subset.2 $ λ y hy z hz, _⟩,
-  suffices h : interval y x ∪ interval x z ⊆ s,
-  { exact interval_subset_interval_union_interval.trans h },
-  rw [interval_swap, union_subset_iff],
-  exact ⟨hs hy, hs hz⟩,
-end
+lemma ord_connected_iff_uIcc_subset :
+  ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), [x, y] ⊆ s :=
+⟨λ h, h.uIcc_subset, λ H, ⟨λ x hx y hy, Icc_subset_uIcc.trans $ H hx hy⟩⟩
 
-lemma ord_connected_iff_interval_subset_right (hx : x ∈ s) :
-  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → interval y x ⊆ s :=
-by simp_rw [ord_connected_iff_interval_subset_left hx, interval_swap]
+lemma ord_connected_of_uIcc_subset_left (h : ∀ y ∈ s, [x, y] ⊆ s) :
+  ord_connected s :=
+ord_connected_iff_uIcc_subset.2 $ λ y hy z hz,
+calc [y, z] ⊆ [y, x] ∪ [x, z] : uIcc_subset_uIcc_union_uIcc
+... = [x, y] ∪ [x, z] : by rw [uIcc_comm]
+... ⊆ s : union_subset (h y hy) (h z hz)
+
+lemma ord_connected_iff_uIcc_subset_left (hx : x ∈ s) :
+  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → [x, y] ⊆ s :=
+⟨λ hs, hs.uIcc_subset hx, ord_connected_of_uIcc_subset_left⟩
+
+lemma ord_connected_iff_uIcc_subset_right (hx : x ∈ s) :
+  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → [y, x] ⊆ s :=
+by simp_rw [ord_connected_iff_uIcc_subset_left hx, uIcc_comm]
 
 end linear_order
 end set
diff --git a/src/data/set/intervals/ord_connected_component.lean b/src/data/set/intervals/ord_connected_component.lean
new file mode 100644
index 0000000000000..e425e8a41bc87
--- /dev/null
+++ b/src/data/set/intervals/ord_connected_component.lean
@@ -0,0 +1,193 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import data.set.intervals.ord_connected
+import tactic.wlog
+
+/-!
+# Order connected components of a set
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define `set.ord_connected_component s x` to be the set of `y` such that
+`set.uIcc x y ⊆ s` and prove some basic facts about this definition. At the moment of writing,
+this construction is used only to prove that any linear order with order topology is a T₅ space,
+so we only add API needed for this lemma.
+-/
+
+open function order_dual
+open_locale interval
+
+namespace set
+
+variables {α : Type*} [linear_order α] {s t : set α} {x y z : α}
+
+/-- Order-connected component of a point `x` in a set `s`. It is defined as the set of `y` such that
+`set.uIcc x y ⊆ s`. Note that it is empty if and only if `x ∉ s`. -/
+def ord_connected_component (s : set α) (x : α) : set α := {y | [x, y] ⊆ s}
+
+lemma mem_ord_connected_component : y ∈ ord_connected_component s x ↔ [x, y] ⊆ s := iff.rfl
+
+lemma dual_ord_connected_component :
+  ord_connected_component (of_dual ⁻¹' s) (to_dual x) = of_dual ⁻¹' (ord_connected_component s x) :=
+ext $ to_dual.surjective.forall.2 $ λ x,
+  by { rw [mem_ord_connected_component, dual_uIcc], refl }
+
+lemma ord_connected_component_subset : ord_connected_component s x ⊆ s := λ y hy, hy right_mem_uIcc
+
+lemma subset_ord_connected_component {t} [h : ord_connected s] (hs : x ∈ s) (ht : s ⊆ t) :
+  s ⊆ ord_connected_component t x :=
+λ y hy, (h.uIcc_subset hs hy).trans ht
+
+@[simp] lemma self_mem_ord_connected_component : x ∈ ord_connected_component s x ↔ x ∈ s :=
+by rw [mem_ord_connected_component, uIcc_self, singleton_subset_iff]
+
+@[simp] lemma nonempty_ord_connected_component : (ord_connected_component s x).nonempty ↔ x ∈ s :=
+⟨λ ⟨y, hy⟩, hy $ left_mem_uIcc, λ h, ⟨x, self_mem_ord_connected_component.2 h⟩⟩
+
+@[simp] lemma ord_connected_component_eq_empty : ord_connected_component s x = ∅ ↔ x ∉ s :=
+by rw [← not_nonempty_iff_eq_empty, nonempty_ord_connected_component]
+
+@[simp] lemma ord_connected_component_empty : ord_connected_component ∅ x = ∅ :=
+ord_connected_component_eq_empty.2 (not_mem_empty x)
+
+@[simp] lemma ord_connected_component_univ : ord_connected_component univ x = univ :=
+by simp [ord_connected_component]
+
+lemma ord_connected_component_inter (s t : set α) (x : α) :
+  ord_connected_component (s ∩ t) x = ord_connected_component s x ∩ ord_connected_component t x :=
+by simp [ord_connected_component, set_of_and]
+
+lemma mem_ord_connected_component_comm :
+  y ∈ ord_connected_component s x ↔ x ∈ ord_connected_component s y :=
+by rw [mem_ord_connected_component, mem_ord_connected_component, uIcc_comm]
+
+lemma mem_ord_connected_component_trans (hxy : y ∈ ord_connected_component s x)
+  (hyz : z ∈ ord_connected_component s y) : z ∈ ord_connected_component s x :=
+calc [x, z] ⊆ [x, y] ∪ [y, z] : uIcc_subset_uIcc_union_uIcc
+... ⊆ s : union_subset hxy hyz
+
+lemma ord_connected_component_eq (h : [x, y] ⊆ s) :
+  ord_connected_component s x = ord_connected_component s y :=
+ext $ λ z, ⟨mem_ord_connected_component_trans (mem_ord_connected_component_comm.2 h),
+  mem_ord_connected_component_trans h⟩
+
+instance : ord_connected (ord_connected_component s x) :=
+ord_connected_of_uIcc_subset_left $ λ y hy z hz, (uIcc_subset_uIcc_left hz).trans hy
+
+/-- Projection from `s : set α` to `α` sending each order connected component of `s` to a single
+point of this component. -/
+noncomputable def ord_connected_proj (s : set α) : s → α :=
+λ x : s, (nonempty_ord_connected_component.2 x.prop).some
+
+lemma ord_connected_proj_mem_ord_connected_component (s : set α) (x : s) :
+  ord_connected_proj s x ∈ ord_connected_component s x :=
+nonempty.some_mem _
+
+lemma mem_ord_connected_component_ord_connected_proj (s : set α) (x : s) :
+  ↑x ∈ ord_connected_component s (ord_connected_proj s x) :=
+mem_ord_connected_component_comm.2 $ ord_connected_proj_mem_ord_connected_component s x
+
+@[simp] lemma ord_connected_component_ord_connected_proj (s : set α) (x : s) :
+  ord_connected_component s (ord_connected_proj s x) = ord_connected_component s x :=
+ord_connected_component_eq $ mem_ord_connected_component_ord_connected_proj _ _
+
+@[simp] lemma ord_connected_proj_eq {x y : s} :
+  ord_connected_proj s x = ord_connected_proj s y ↔ [(x : α), y] ⊆ s :=
+begin
+  split; intro h,
+  { rw [← mem_ord_connected_component, ← ord_connected_component_ord_connected_proj, h,
+      ord_connected_component_ord_connected_proj, self_mem_ord_connected_component],
+    exact y.2 },
+  { simp only [ord_connected_proj],
+    congr' 1,
+    exact ord_connected_component_eq h }
+end
+
+/-- A set that intersects each order connected component of a set by a single point. Defined as the
+range of `set.ord_connected_proj s`. -/
+def ord_connected_section (s : set α) : set α := range $ ord_connected_proj s
+
+lemma dual_ord_connected_section (s : set α) :
+  ord_connected_section (of_dual ⁻¹' s) = of_dual ⁻¹' (ord_connected_section s) :=
+begin
+  simp only [ord_connected_section, ord_connected_proj],
+  congr' 1 with x, simp only, congr' 1,
+  exact dual_ord_connected_component
+end
+
+lemma ord_connected_section_subset : ord_connected_section s ⊆ s :=
+range_subset_iff.2 $ λ x, ord_connected_component_subset $ nonempty.some_mem _
+
+lemma eq_of_mem_ord_connected_section_of_uIcc_subset (hx : x ∈ ord_connected_section s)
+  (hy : y ∈ ord_connected_section s) (h : [x, y] ⊆ s) : x = y :=
+begin
+  rcases hx with ⟨x, rfl⟩, rcases hy with ⟨y, rfl⟩,
+  exact ord_connected_proj_eq.2 (mem_ord_connected_component_trans
+    (mem_ord_connected_component_trans (ord_connected_proj_mem_ord_connected_component _ _) h)
+    (mem_ord_connected_component_ord_connected_proj _ _))
+end
+
+/-- Given two sets `s t : set α`, the set `set.order_separating_set s t` is the set of points that
+belong both to some `set.ord_connected_component tᶜ x`, `x ∈ s`, and to some
+`set.ord_connected_component sᶜ x`, `x ∈ t`. In the case of two disjoint closed sets, this is the
+union of all open intervals $(a, b)$ such that their endpoints belong to different sets. -/
+def ord_separating_set (s t : set α) : set α :=
+(⋃ x ∈ s, ord_connected_component tᶜ x) ∩ (⋃ x ∈ t, ord_connected_component sᶜ x)
+
+lemma ord_separating_set_comm (s t : set α) :
+  ord_separating_set s t = ord_separating_set t s :=
+inter_comm _ _
+
+lemma disjoint_left_ord_separating_set : disjoint s (ord_separating_set s t) :=
+disjoint.inter_right' _ $ disjoint_Union₂_right.2 $ λ x hx, disjoint_compl_right.mono_right $
+  ord_connected_component_subset
+
+lemma disjoint_right_ord_separating_set : disjoint t (ord_separating_set s t) :=
+ord_separating_set_comm t s ▸ disjoint_left_ord_separating_set
+
+lemma dual_ord_separating_set :
+  ord_separating_set (of_dual ⁻¹' s) (of_dual ⁻¹' t) = of_dual ⁻¹' (ord_separating_set s t) :=
+by simp only [ord_separating_set, mem_preimage, ← to_dual.surjective.Union_comp, of_dual_to_dual,
+  dual_ord_connected_component, ← preimage_compl, preimage_inter, preimage_Union]
+
+/-- An auxiliary neighborhood that will be used in the proof of `order_topology.t5_space`. -/
+def ord_t5_nhd (s t : set α) : set α :=
+⋃ x ∈ s, ord_connected_component (tᶜ ∩ (ord_connected_section $ ord_separating_set s t)ᶜ) x
+
+lemma disjoint_ord_t5_nhd : disjoint (ord_t5_nhd s t) (ord_t5_nhd t s) :=
+begin
+  rw disjoint_iff_inf_le,
+  rintro x ⟨hx₁, hx₂⟩,
+  rcases mem_Union₂.1 hx₁ with ⟨a, has, ha⟩, clear hx₁,
+  rcases mem_Union₂.1 hx₂ with ⟨b, hbt, hb⟩, clear hx₂,
+  rw [mem_ord_connected_component, subset_inter_iff] at ha hb,
+  wlog hab : a ≤ b,
+  { exact this b hbt a has ha hb (le_of_not_le hab) },
+  cases ha with ha ha', cases hb with hb hb',
+  have hsub : [a, b] ⊆ (ord_separating_set s t).ord_connected_sectionᶜ,
+  { rw [ord_separating_set_comm, uIcc_comm] at hb',
+    calc [a, b] ⊆ [a, x] ∪ [x, b] : uIcc_subset_uIcc_union_uIcc
+    ... ⊆ (ord_separating_set s t).ord_connected_sectionᶜ : union_subset ha' hb' },
+  clear ha' hb',
+  cases le_total x a with hxa hax,
+  { exact hb (Icc_subset_uIcc' ⟨hxa, hab⟩) has },
+  cases le_total b x with hbx hxb,
+  { exact ha (Icc_subset_uIcc ⟨hab, hbx⟩) hbt },
+  have : x ∈ ord_separating_set s t,
+  { exact ⟨mem_Union₂.2 ⟨a, has, ha⟩, mem_Union₂.2 ⟨b, hbt, hb⟩⟩ },
+  lift x to ord_separating_set s t using this,
+  suffices : ord_connected_component (ord_separating_set s t) x ⊆ [a, b],
+    from hsub (this $ ord_connected_proj_mem_ord_connected_component _ _) (mem_range_self _),
+  rintros y (hy : [↑x, y] ⊆ ord_separating_set s t),
+  rw [uIcc_of_le hab, mem_Icc, ← not_lt, ← not_lt],
+  exact ⟨λ hya, disjoint_left.1 disjoint_left_ord_separating_set has
+    (hy $ Icc_subset_uIcc' ⟨hya.le, hax⟩),
+    λ hyb, disjoint_left.1 disjoint_right_ord_separating_set hbt
+      (hy $ Icc_subset_uIcc ⟨hxb, hyb.le⟩)⟩
+end
+
+end set
diff --git a/src/data/set/intervals/order_iso.lean b/src/data/set/intervals/order_iso.lean
new file mode 100644
index 0000000000000..b477ced88c324
--- /dev/null
+++ b/src/data/set/intervals/order_iso.lean
@@ -0,0 +1,84 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot, Yury Kudryashov, Rémy Degenne
+-/
+import data.set.intervals.basic
+import order.hom.set
+
+/-!
+# Lemmas about images of intervals under order isomorphisms.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α β : Type*}
+open set
+
+namespace order_iso
+
+section preorder
+variables [preorder α] [preorder β]
+
+@[simp] lemma preimage_Iic (e : α ≃o β) (b : β) : e ⁻¹' (Iic b) = Iic (e.symm b) :=
+by { ext x, simp [← e.le_iff_le] }
+
+@[simp] lemma preimage_Ici (e : α ≃o β) (b : β) : e ⁻¹' (Ici b) = Ici (e.symm b) :=
+by { ext x, simp [← e.le_iff_le] }
+
+@[simp] lemma preimage_Iio (e : α ≃o β) (b : β) : e ⁻¹' (Iio b) = Iio (e.symm b) :=
+by { ext x, simp [← e.lt_iff_lt] }
+
+@[simp] lemma preimage_Ioi (e : α ≃o β) (b : β) : e ⁻¹' (Ioi b) = Ioi (e.symm b) :=
+by { ext x, simp [← e.lt_iff_lt] }
+
+@[simp] lemma preimage_Icc (e : α ≃o β) (a b : β) : e ⁻¹' (Icc a b) = Icc (e.symm a) (e.symm b) :=
+by simp [← Ici_inter_Iic]
+
+@[simp] lemma preimage_Ico (e : α ≃o β) (a b : β) : e ⁻¹' (Ico a b) = Ico (e.symm a) (e.symm b) :=
+by simp [← Ici_inter_Iio]
+
+@[simp] lemma preimage_Ioc (e : α ≃o β) (a b : β) : e ⁻¹' (Ioc a b) = Ioc (e.symm a) (e.symm b) :=
+by simp [← Ioi_inter_Iic]
+
+@[simp] lemma preimage_Ioo (e : α ≃o β) (a b : β) : e ⁻¹' (Ioo a b) = Ioo (e.symm a) (e.symm b) :=
+by simp [← Ioi_inter_Iio]
+
+@[simp] lemma image_Iic (e : α ≃o β) (a : α) : e '' (Iic a) = Iic (e a) :=
+by rw [e.image_eq_preimage, e.symm.preimage_Iic, e.symm_symm]
+
+@[simp] lemma image_Ici (e : α ≃o β) (a : α) : e '' (Ici a) = Ici (e a) :=
+e.dual.image_Iic a
+
+@[simp] lemma image_Iio (e : α ≃o β) (a : α) : e '' (Iio a) = Iio (e a) :=
+by rw [e.image_eq_preimage, e.symm.preimage_Iio, e.symm_symm]
+
+@[simp] lemma image_Ioi (e : α ≃o β) (a : α) : e '' (Ioi a) = Ioi (e a) :=
+e.dual.image_Iio a
+
+@[simp] lemma image_Ioo (e : α ≃o β) (a b : α) : e '' (Ioo a b) = Ioo (e a) (e b) :=
+by rw [e.image_eq_preimage, e.symm.preimage_Ioo, e.symm_symm]
+
+@[simp] lemma image_Ioc (e : α ≃o β) (a b : α) : e '' (Ioc a b) = Ioc (e a) (e b) :=
+by rw [e.image_eq_preimage, e.symm.preimage_Ioc, e.symm_symm]
+
+@[simp] lemma image_Ico (e : α ≃o β) (a b : α) : e '' (Ico a b) = Ico (e a) (e b) :=
+by rw [e.image_eq_preimage, e.symm.preimage_Ico, e.symm_symm]
+
+@[simp] lemma image_Icc (e : α ≃o β) (a b : α) : e '' (Icc a b) = Icc (e a) (e b) :=
+by rw [e.image_eq_preimage, e.symm.preimage_Icc, e.symm_symm]
+
+end preorder
+
+/-- Order isomorphism between `Iic (⊤ : α)` and `α` when `α` has a top element -/
+def Iic_top [preorder α] [order_top α] : set.Iic (⊤ : α) ≃o α :=
+{ map_rel_iff' := λ x y, by refl,
+  .. (@equiv.subtype_univ_equiv α (set.Iic (⊤ : α)) (λ x, le_top)), }
+
+/-- Order isomorphism between `Ici (⊥ : α)` and `α` when `α` has a bottom element -/
+def Ici_bot [preorder α] [order_bot α] : set.Ici (⊥ : α) ≃o α :=
+{ map_rel_iff' := λ x y, by refl,
+  .. (@equiv.subtype_univ_equiv α (set.Ici (⊥ : α)) (λ x, bot_le)) }
+
+end order_iso
diff --git a/src/data/set/intervals/pi.lean b/src/data/set/intervals/pi.lean
index 575d49afb813c..4377982aa80cb 100644
--- a/src/data/set/intervals/pi.lean
+++ b/src/data/set/intervals/pi.lean
@@ -3,12 +3,17 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
+import data.pi.algebra
 import data.set.intervals.basic
+import data.set.intervals.unordered_interval
 import data.set.lattice
 
 /-!
 # Intervals in `pi`-space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this we prove various simple lemmas about intervals in `Π i, α i`. Closed intervals (`Ici x`,
 `Iic x`, `Icc x y`) are equal to products of their projections to `α i`, while (semi-)open intervals
 usually include the corresponding products as proper subsets.
@@ -94,13 +99,182 @@ lemma disjoint_pi_univ_Ioc_update_left_right {x y : Π i, α i} {i₀ : ι} {m :
   disjoint (pi univ (λ i, Ioc (x i) (update y i₀ m i)))
     (pi univ (λ i, Ioc (update x i₀ m i) (y i))) :=
 begin
-  rintro z ⟨h₁, h₂⟩,
+  rw disjoint_left,
+  rintro z h₁ h₂,
   refine (h₁ i₀ (mem_univ _)).2.not_lt _,
   simpa only [function.update_same] using (h₂ i₀ (mem_univ _)).1
 end
 
 end pi_preorder
 
+section pi_partial_order
+variables [decidable_eq ι] [Π i, partial_order (α i)]
+
+lemma image_update_Icc (f : Π i, α i) (i : ι) (a b : α i) :
+  f.update i '' Icc a b = Icc (f.update i a) (f.update i b) :=
+begin
+  ext,
+  rw ←set.pi_univ_Icc,
+  refine ⟨_, λ h, ⟨x i, _, _⟩⟩,
+  { rintro ⟨c, hc, rfl⟩,
+    simpa [update_le_update_iff] },
+  { simpa only [function.update_same] using h i (mem_univ i) },
+  { ext j,
+    obtain rfl | hij := eq_or_ne i j,
+    { exact function.update_same _ _ _ },
+    { simpa only [function.update_noteq hij.symm, le_antisymm_iff] using h j (mem_univ j) } }
+end
+
+lemma image_update_Ico (f : Π i, α i) (i : ι) (a b : α i) :
+  f.update i '' Ico a b = Ico (f.update i a) (f.update i b) :=
+by rw [←Icc_diff_right, ←Icc_diff_right, image_diff (f.update_injective _), image_singleton,
+  image_update_Icc]
+
+lemma image_update_Ioc (f : Π i, α i) (i : ι) (a b : α i) :
+  f.update i '' Ioc a b = Ioc (f.update i a) (f.update i b) :=
+by rw [←Icc_diff_left, ←Icc_diff_left, image_diff (f.update_injective _), image_singleton,
+  image_update_Icc]
+
+lemma image_update_Ioo (f : Π i, α i) (i : ι) (a b : α i) :
+  f.update i '' Ioo a b = Ioo (f.update i a) (f.update i b) :=
+by rw [←Ico_diff_left, ←Ico_diff_left, image_diff (f.update_injective _), image_singleton,
+  image_update_Ico]
+
+lemma image_update_Icc_left (f : Π i, α i) (i : ι) (a : α i) :
+  f.update i '' Icc a (f i) = Icc (f.update i a) f :=
+by simpa using image_update_Icc f i a (f i)
+
+lemma image_update_Ico_left (f : Π i, α i) (i : ι) (a : α i) :
+  f.update i '' Ico a (f i) = Ico (f.update i a) f :=
+by simpa using image_update_Ico f i a (f i)
+
+lemma image_update_Ioc_left (f : Π i, α i) (i : ι) (a : α i) :
+  f.update i '' Ioc a (f i) = Ioc (f.update i a) f :=
+by simpa using image_update_Ioc f i a (f i)
+
+lemma image_update_Ioo_left (f : Π i, α i) (i : ι) (a : α i) :
+  f.update i '' Ioo a (f i) = Ioo (f.update i a) f :=
+by simpa using image_update_Ioo f i a (f i)
+
+lemma image_update_Icc_right (f : Π i, α i) (i : ι) (b : α i) :
+  f.update i '' Icc (f i) b = Icc f (f.update i b) :=
+by simpa using image_update_Icc f i (f i) b
+
+lemma image_update_Ico_right (f : Π i, α i) (i : ι) (b : α i) :
+  f.update i '' Ico (f i) b = Ico f (f.update i b) :=
+by simpa using image_update_Ico f i (f i) b
+
+lemma image_update_Ioc_right (f : Π i, α i) (i : ι) (b : α i) :
+  f.update i '' Ioc (f i) b = Ioc f (f.update i b) :=
+by simpa using image_update_Ioc f i (f i) b
+
+lemma image_update_Ioo_right (f : Π i, α i) (i : ι) (b : α i) :
+  f.update i '' Ioo (f i) b = Ioo f (f.update i b) :=
+by simpa using image_update_Ioo f i (f i) b
+
+variables [Π i, has_one (α i)]
+
+@[to_additive]
+lemma image_mul_single_Icc (i : ι) (a b : α i) :
+  pi.mul_single i '' Icc a b = Icc (pi.mul_single i a) (pi.mul_single i b) :=
+image_update_Icc _ _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ico (i : ι) (a b : α i) :
+  pi.mul_single i '' Ico a b = Ico (pi.mul_single i a) (pi.mul_single i b) :=
+image_update_Ico _ _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ioc (i : ι) (a b : α i) :
+  pi.mul_single i '' Ioc a b = Ioc (pi.mul_single i a) (pi.mul_single i b) :=
+image_update_Ioc _ _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ioo (i : ι) (a b : α i) :
+  pi.mul_single i '' Ioo a b = Ioo (pi.mul_single i a) (pi.mul_single i b) :=
+image_update_Ioo _ _ _ _
+
+@[to_additive]
+lemma image_mul_single_Icc_left (i : ι) (a : α i) :
+  pi.mul_single i '' Icc a 1 = Icc (pi.mul_single i a) 1 :=
+image_update_Icc_left _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ico_left (i : ι) (a : α i) :
+  pi.mul_single i '' Ico a 1 = Ico (pi.mul_single i a) 1 :=
+image_update_Ico_left _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ioc_left (i : ι) (a : α i) :
+  pi.mul_single i '' Ioc a 1 = Ioc (pi.mul_single i a) 1 :=
+image_update_Ioc_left _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ioo_left (i : ι) (a : α i) :
+  pi.mul_single i '' Ioo a 1 = Ioo (pi.mul_single i a) 1 :=
+image_update_Ioo_left _ _ _
+
+@[to_additive]
+lemma image_mul_single_Icc_right (i : ι) (b : α i) :
+  pi.mul_single i '' Icc 1 b = Icc 1 (pi.mul_single i b) :=
+image_update_Icc_right _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ico_right (i : ι) (b : α i) :
+  pi.mul_single i '' Ico 1 b = Ico 1 (pi.mul_single i b) :=
+image_update_Ico_right _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ioc_right (i : ι) (b : α i) :
+  pi.mul_single i '' Ioc 1 b = Ioc 1 (pi.mul_single i b) :=
+image_update_Ioc_right _ _ _
+
+@[to_additive]
+lemma image_mul_single_Ioo_right (i : ι) (b : α i) :
+  pi.mul_single i '' Ioo 1 b = Ioo 1 (pi.mul_single i b) :=
+image_update_Ioo_right _ _ _
+
+end pi_partial_order
+
+section pi_lattice
+variables [Π i, lattice (α i)]
+
+@[simp] lemma pi_univ_uIcc (a b : Π i, α i) : pi univ (λ i, uIcc (a i) (b i)) = uIcc a b :=
+pi_univ_Icc _ _
+
+variables [decidable_eq ι]
+
+lemma image_update_uIcc (f : Π i, α i) (i : ι) (a b : α i) :
+  f.update i '' uIcc a b = uIcc (f.update i a) (f.update i b) :=
+(image_update_Icc _ _ _ _).trans $ by simp_rw [uIcc, f.update_sup, f.update_inf]
+
+lemma image_update_uIcc_left (f : Π i, α i) (i : ι) (a : α i) :
+  f.update i '' uIcc a (f i) = uIcc (f.update i a) f :=
+by simpa using image_update_uIcc f i a (f i)
+
+lemma image_update_uIcc_right (f : Π i, α i) (i : ι) (b : α i) :
+  f.update i '' uIcc (f i) b = uIcc f (f.update i b) :=
+by simpa using image_update_uIcc f i (f i) b
+
+variables [Π i, has_one (α i)]
+
+@[to_additive]
+lemma image_mul_single_uIcc (i : ι) (a b : α i) :
+  pi.mul_single i '' uIcc a b = uIcc (pi.mul_single i a) (pi.mul_single i b) :=
+image_update_uIcc _ _ _ _
+
+@[to_additive]
+lemma image_mul_single_uIcc_left (i : ι) (a : α i) :
+  pi.mul_single i '' uIcc a 1 = uIcc (pi.mul_single i a) 1 :=
+image_update_uIcc_left _ _ _
+
+@[to_additive]
+lemma image_mul_single_uIcc_right (i : ι) (b : α i) :
+  pi.mul_single i '' uIcc 1 b = uIcc 1 (pi.mul_single i b) :=
+image_update_uIcc_right _ _ _
+
+end pi_lattice
+
 variables [decidable_eq ι] [Π i, linear_order (α i)]
 
 open function (update)
diff --git a/src/data/set/intervals/proj_Icc.lean b/src/data/set/intervals/proj_Icc.lean
index 7a4cf4734a932..41a033fc0ed3a 100644
--- a/src/data/set/intervals/proj_Icc.lean
+++ b/src/data/set/intervals/proj_Icc.lean
@@ -3,15 +3,27 @@ Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Patrick Massot
 -/
-import data.set.intervals.basic
+import data.set.function
+import data.set.intervals.ord_connected
 
 /-!
 # Projection of a line onto a closed interval
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a linearly ordered type `α`, in this file we define
 
+* `set.proj_Ici (a : α)` to be the map `α → [a, ∞[` sending `]-∞, a]` to `a`,
+  and each point `x ∈ [a, ∞[` to itself;
+* `set.proj_Iic (b : α)` to be the map `α → ]-∞, b[` sending `[b, ∞[` to `b`,
+  and each point `x ∈ ]-∞, b]` to itself;
 * `set.proj_Icc (a b : α) (h : a ≤ b)` to be the map `α → [a, b]` sending `(-∞, a]` to `a`, `[b, ∞)`
   to `b`, and each point `x ∈ [a, b]` to itself;
+* `set.Ici_extend {a : α} (f : Ici a → β)` to be the extension of `f` to `α` defined
+  as `f ∘ proj_Ici a`.
+* `set.Iic_extend {b : α} (f : Iic b → β)` to be the extension of `f` to `α` defined
+  as `f ∘ proj_Iic b`.
 * `set.Icc_extend {a b : α} (h : a ≤ b) (f : Icc a b → β)` to be the extension of `f` to `α` defined
   as `f ∘ proj_Icc a b h`.
 
@@ -24,101 +36,209 @@ open function
 
 namespace set
 
+/-- Projection of `α` to the closed interval `[a, ∞[`. -/
+def proj_Ici (a x : α) : Ici a := ⟨max a x, le_max_left _ _⟩
+
+/-- Projection of `α` to the closed interval `]-∞, b]`. -/
+def proj_Iic (b x : α) : Iic b := ⟨min b x, min_le_left _ _⟩
+
 /-- Projection of `α` to the closed interval `[a, b]`. -/
 def proj_Icc (a b : α) (h : a ≤ b) (x : α) : Icc a b :=
 ⟨max a (min b x), le_max_left _ _, max_le h (min_le_left _ _)⟩
 
 variables {a b : α} (h : a ≤ b) {x : α}
 
+@[norm_cast] lemma coe_proj_Ici (a x : α) : (proj_Ici a x : α) = max a x := rfl
+@[norm_cast] lemma coe_proj_Iic (b x : α) : (proj_Iic b x : α) = min b x := rfl
+@[norm_cast] lemma coe_proj_Icc (a b : α) (h : a ≤ b) (x : α) :
+  (proj_Icc a b h x : α) = max a (min b x) := rfl
+
+lemma proj_Ici_of_le (hx : x ≤ a) : proj_Ici a x = ⟨a, le_rfl⟩ := subtype.ext $ max_eq_left hx
+lemma proj_Iic_of_le (hx : b ≤ x) : proj_Iic b x = ⟨b, le_rfl⟩ := subtype.ext $ min_eq_left hx
+
 lemma proj_Icc_of_le_left (hx : x ≤ a) : proj_Icc a b h x = ⟨a, left_mem_Icc.2 h⟩ :=
 by simp [proj_Icc, hx, hx.trans h]
 
-@[simp] lemma proj_Icc_left : proj_Icc a b h a = ⟨a, left_mem_Icc.2 h⟩ :=
-proj_Icc_of_le_left h le_rfl
-
 lemma proj_Icc_of_right_le (hx : b ≤ x) : proj_Icc a b h x = ⟨b, right_mem_Icc.2 h⟩ :=
 by simp [proj_Icc, hx, h]
 
+@[simp] lemma proj_Ici_self (a : α) : proj_Ici a a = ⟨a, le_rfl⟩ := proj_Ici_of_le le_rfl
+@[simp] lemma proj_Iic_self (b : α) : proj_Iic b b = ⟨b, le_rfl⟩ := proj_Iic_of_le le_rfl
+
+@[simp] lemma proj_Icc_left : proj_Icc a b h a = ⟨a, left_mem_Icc.2 h⟩ :=
+proj_Icc_of_le_left h le_rfl
+
 @[simp] lemma proj_Icc_right : proj_Icc a b h b = ⟨b, right_mem_Icc.2 h⟩ :=
 proj_Icc_of_right_le h le_rfl
 
+lemma proj_Ici_eq_self : proj_Ici a x = ⟨a, le_rfl⟩ ↔ x ≤ a := by simp [proj_Ici, subtype.ext_iff]
+lemma proj_Iic_eq_self : proj_Iic b x = ⟨b, le_rfl⟩ ↔ b ≤ x := by simp [proj_Iic, subtype.ext_iff]
+
 lemma proj_Icc_eq_left (h : a < b) : proj_Icc a b h.le x = ⟨a, left_mem_Icc.mpr h.le⟩ ↔ x ≤ a :=
-begin
-  refine ⟨λ h', _, proj_Icc_of_le_left _⟩,
-  simp_rw [subtype.ext_iff_val, proj_Icc, max_eq_left_iff, min_le_iff, h.not_le, false_or] at h',
-  exact h'
-end
+by simp [proj_Icc, subtype.ext_iff, h.not_le]
 
 lemma proj_Icc_eq_right (h : a < b) : proj_Icc a b h.le x = ⟨b, right_mem_Icc.mpr h.le⟩ ↔ b ≤ x :=
-begin
-  refine ⟨λ h', _, proj_Icc_of_right_le _⟩,
-  simp_rw [subtype.ext_iff_val, proj_Icc] at h',
-  have := ((max_choice _ _).resolve_left (by simp [h.ne', h'])).symm.trans h',
-  exact min_eq_left_iff.mp this
-end
+by simp [proj_Icc, subtype.ext_iff, max_min_distrib_left, h.le, h.not_le]
 
+lemma proj_Ici_of_mem (hx : x ∈ Ici a) : proj_Ici a x = ⟨x, hx⟩ := by simpa [proj_Ici]
+lemma proj_Iic_of_mem (hx : x ∈ Iic b) : proj_Iic b x = ⟨x, hx⟩ := by simpa [proj_Iic]
 lemma proj_Icc_of_mem (hx : x ∈ Icc a b) : proj_Icc a b h x = ⟨x, hx⟩ :=
 by simp [proj_Icc, hx.1, hx.2]
 
+@[simp] lemma proj_Ici_coe (x : Ici a) : proj_Ici a x = x := by { cases x, apply proj_Ici_of_mem }
+@[simp] lemma proj_Iic_coe (x : Iic b) : proj_Iic b x = x := by { cases x, apply proj_Iic_of_mem }
 @[simp] lemma proj_Icc_coe (x : Icc a b) : proj_Icc a b h x = x :=
 by { cases x, apply proj_Icc_of_mem }
 
+lemma proj_Ici_surj_on : surj_on (proj_Ici a) (Ici a) univ := λ x _, ⟨x, x.2, proj_Ici_coe x⟩
+lemma proj_Iic_surj_on : surj_on (proj_Iic b) (Iic b) univ := λ x _, ⟨x, x.2, proj_Iic_coe x⟩
 lemma proj_Icc_surj_on : surj_on (proj_Icc a b h) (Icc a b) univ :=
 λ x _, ⟨x, x.2, proj_Icc_coe h x⟩
 
-lemma proj_Icc_surjective : surjective (proj_Icc a b h) :=
-λ x, ⟨x, proj_Icc_coe h x⟩
+lemma proj_Ici_surjective : surjective (proj_Ici a) := λ x, ⟨x, proj_Ici_coe x⟩
+lemma proj_Iic_surjective : surjective (proj_Iic b) := λ x, ⟨x, proj_Iic_coe x⟩
+lemma proj_Icc_surjective : surjective (proj_Icc a b h) := λ x, ⟨x, proj_Icc_coe h x⟩
 
-@[simp] lemma range_proj_Icc : range (proj_Icc a b h) = univ :=
-(proj_Icc_surjective h).range_eq
+@[simp] lemma range_proj_Ici : range (proj_Ici a) = univ := proj_Ici_surjective.range_eq
+@[simp] lemma range_proj_Iic : range (proj_Iic a) = univ := proj_Iic_surjective.range_eq
+@[simp] lemma range_proj_Icc : range (proj_Icc a b h) = univ := (proj_Icc_surjective h).range_eq
 
+lemma monotone_proj_Ici : monotone (proj_Ici a) := λ x y, max_le_max le_rfl
+lemma monotone_proj_Iic : monotone (proj_Iic a) := λ x y, min_le_min le_rfl
 lemma monotone_proj_Icc : monotone (proj_Icc a b h) :=
 λ x y hxy, max_le_max le_rfl $ min_le_min le_rfl hxy
 
+lemma strict_mono_on_proj_Ici : strict_mono_on (proj_Ici a) (Ici a) :=
+λ x hx y hy hxy, by simpa only [proj_Ici_of_mem, hx, hy]
+lemma strict_mono_on_proj_Iic : strict_mono_on (proj_Iic b) (Iic b) :=
+λ x hx y hy hxy, by simpa only [proj_Iic_of_mem, hx, hy]
 lemma strict_mono_on_proj_Icc : strict_mono_on (proj_Icc a b h) (Icc a b) :=
 λ x hx y hy hxy, by simpa only [proj_Icc_of_mem, hx, hy]
 
+/-- Extend a function `[a, ∞[ → β` to a map `α → β`. -/
+def Ici_extend (f : Ici a → β) : α → β := f ∘ proj_Ici a
+
+/-- Extend a function `]-∞, b] → β` to a map `α → β`. -/
+def Iic_extend (f : Iic b → β) : α → β := f ∘ proj_Iic b
+
 /-- Extend a function `[a, b] → β` to a map `α → β`. -/
 def Icc_extend {a b : α} (h : a ≤ b) (f : Icc a b → β) : α → β :=
 f ∘ proj_Icc a b h
 
+@[simp] lemma Ici_extend_apply (f : Ici a → β) (x : α) :
+  Ici_extend f x = f ⟨max a x, le_max_left _ _⟩ := rfl
+@[simp] lemma Iic_extend_apply (f : Iic b → β) (x : α) :
+  Iic_extend f x = f ⟨min b x, min_le_left _ _⟩ := rfl
+lemma Icc_extend_apply (h : a ≤ b) (f : Icc a b → β) (x : α) :
+  Icc_extend h f x = f ⟨max a (min b x), le_max_left _ _, max_le h (min_le_left _ _)⟩ := rfl
+
+@[simp] lemma range_Ici_extend (f : Ici a → β) : range (Ici_extend f) = range f :=
+by simp only [Ici_extend, range_comp f, range_proj_Ici, range_id']
+
+@[simp] lemma range_Iic_extend (f : Iic b → β) : range (Iic_extend f) = range f :=
+by simp only [Iic_extend, range_comp f, range_proj_Iic, range_id']
+
 @[simp] lemma Icc_extend_range (f : Icc a b → β) :
   range (Icc_extend h f) = range f :=
 by simp only [Icc_extend, range_comp f, range_proj_Icc, range_id']
 
+lemma Ici_extend_of_le (f : Ici a → β) (hx : x ≤ a) : Ici_extend f x = f ⟨a, le_rfl⟩ :=
+congr_arg f $ proj_Ici_of_le hx
+
+lemma Iic_extend_of_le (f : Iic b → β) (hx : b ≤ x) : Iic_extend f x = f ⟨b, le_rfl⟩ :=
+congr_arg f $ proj_Iic_of_le hx
+
 lemma Icc_extend_of_le_left (f : Icc a b → β) (hx : x ≤ a) :
   Icc_extend h f x = f ⟨a, left_mem_Icc.2 h⟩ :=
 congr_arg f $ proj_Icc_of_le_left h hx
 
-@[simp] lemma Icc_extend_left (f : Icc a b → β) :
-  Icc_extend h f a = f ⟨a, left_mem_Icc.2 h⟩ :=
-Icc_extend_of_le_left h f le_rfl
-
 lemma Icc_extend_of_right_le (f : Icc a b → β) (hx : b ≤ x) :
   Icc_extend h f x = f ⟨b, right_mem_Icc.2 h⟩ :=
 congr_arg f $ proj_Icc_of_right_le h hx
 
+@[simp] lemma Ici_extend_self (f : Ici a → β) : Ici_extend f a = f ⟨a, le_rfl⟩ :=
+Ici_extend_of_le f le_rfl
+
+@[simp] lemma Iic_extend_self (f : Iic b → β) : Iic_extend f b = f ⟨b, le_rfl⟩ :=
+Iic_extend_of_le f le_rfl
+
+@[simp] lemma Icc_extend_left (f : Icc a b → β) :
+  Icc_extend h f a = f ⟨a, left_mem_Icc.2 h⟩ :=
+Icc_extend_of_le_left h f le_rfl
+
 @[simp] lemma Icc_extend_right (f : Icc a b → β) :
   Icc_extend h f b = f ⟨b, right_mem_Icc.2 h⟩ :=
 Icc_extend_of_right_le h f le_rfl
 
+lemma Ici_extend_of_mem (f : Ici a → β) (hx : x ∈ Ici a) : Ici_extend f x = f ⟨x, hx⟩ :=
+congr_arg f $ proj_Ici_of_mem hx
+
+lemma Iic_extend_of_mem (f : Iic b → β) (hx : x ∈ Iic b) : Iic_extend f x = f ⟨x, hx⟩ :=
+congr_arg f $ proj_Iic_of_mem hx
+
 lemma Icc_extend_of_mem (f : Icc a b → β) (hx : x ∈ Icc a b) :
   Icc_extend h f x = f ⟨x, hx⟩ :=
 congr_arg f $ proj_Icc_of_mem h hx
 
+@[simp] lemma Ici_extend_coe (f : Ici a → β) (x : Ici a) : Ici_extend f x = f x :=
+congr_arg f $ proj_Ici_coe x
+
+@[simp] lemma Iic_extend_coe (f : Iic b → β) (x : Iic b) : Iic_extend f x = f x :=
+congr_arg f $ proj_Iic_coe x
+
 @[simp] lemma Icc_extend_coe (f : Icc a b → β) (x : Icc a b) :
   Icc_extend h f x = f x :=
 congr_arg f $ proj_Icc_coe h x
 
+/-- If `f : α → β` is a constant both on $(-∞, a]$ and on $[b, +∞)$, then the extension of this
+function from $[a, b]$ to the whole line is equal to the original function. -/
+lemma Icc_extend_eq_self (f : α → β) (ha : ∀ x < a, f x = f a) (hb : ∀ x, b < x → f x = f b) :
+  Icc_extend h (f ∘ coe) = f :=
+begin
+  ext x,
+  cases lt_or_le x a with hxa hax,
+  { simp [Icc_extend_of_le_left _ _ hxa.le, ha x hxa] },
+  { cases le_or_lt x b with hxb hbx,
+    { lift x to Icc a b using ⟨hax, hxb⟩,
+      rw [Icc_extend_coe] },
+    { simp [Icc_extend_of_right_le _ _ hbx.le, hb x hbx] } }
+end
+
 end set
 
 open set
 
-variables [preorder β] {a b : α} (h : a ≤ b) {f : Icc a b → β}
+variables [preorder β] {s t : set α} {a b : α} (h : a ≤ b) {f : Icc a b → β}
+
+protected lemma monotone.Ici_extend {f : Ici a → β} (hf : monotone f) : monotone (Ici_extend f) :=
+hf.comp monotone_proj_Ici
 
-lemma monotone.Icc_extend (hf : monotone f) : monotone (Icc_extend h f) :=
+protected lemma monotone.Iic_extend {f : Iic b → β} (hf : monotone f) : monotone (Iic_extend f) :=
+hf.comp monotone_proj_Iic
+
+protected lemma monotone.Icc_extend (hf : monotone f) : monotone (Icc_extend h f) :=
 hf.comp $ monotone_proj_Icc h
 
+lemma strict_mono.strict_mono_on_Ici_extend {f : Ici a → β} (hf : strict_mono f) :
+  strict_mono_on (Ici_extend f) (Ici a) :=
+hf.comp_strict_mono_on strict_mono_on_proj_Ici
+
+lemma strict_mono.strict_mono_on_Iic_extend {f : Iic b → β} (hf : strict_mono f) :
+  strict_mono_on (Iic_extend f) (Iic b) :=
+hf.comp_strict_mono_on strict_mono_on_proj_Iic
+
 lemma strict_mono.strict_mono_on_Icc_extend (hf : strict_mono f) :
   strict_mono_on (Icc_extend h f) (Icc a b) :=
 hf.comp_strict_mono_on (strict_mono_on_proj_Icc h)
+
+protected lemma set.ord_connected.Ici_extend {s : set (Ici a)} (hs : s.ord_connected) :
+  {x | Ici_extend (∈ s) x}.ord_connected :=
+⟨λ x hx y hy z hz, hs.out hx hy ⟨max_le_max le_rfl hz.1, max_le_max le_rfl hz.2⟩⟩
+
+protected lemma set.ord_connected.Iic_extend {s : set (Iic b)} (hs : s.ord_connected) :
+  {x | Iic_extend (∈ s) x}.ord_connected :=
+⟨λ x hx y hy z hz, hs.out hx hy ⟨min_le_min le_rfl hz.1, min_le_min le_rfl hz.2⟩⟩
+
+protected lemma set.ord_connected.restrict (hs : s.ord_connected) :
+  {x | restrict t (∈ s) x}.ord_connected :=
+⟨λ x hx y hy z hz, hs.out hx hy hz⟩
diff --git a/src/data/set/intervals/surj_on.lean b/src/data/set/intervals/surj_on.lean
index 2a55228f23675..8089ce42be73f 100644
--- a/src/data/set/intervals/surj_on.lean
+++ b/src/data/set/intervals/surj_on.lean
@@ -9,6 +9,9 @@ import data.set.function
 /-!
 # Monotone surjective functions are surjective on intervals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A monotone surjective function sends any interval in the domain onto the interval with corresponding
 endpoints in the range.  This is expressed in this file using `set.surj_on`, and provided for all
 permutations of interval endpoints.
diff --git a/src/data/set/intervals/unordered_interval.lean b/src/data/set/intervals/unordered_interval.lean
index 94be4bae717a4..6edbb024832d0 100644
--- a/src/data/set/intervals/unordered_interval.lean
+++ b/src/data/set/intervals/unordered_interval.lean
@@ -3,254 +3,259 @@ Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou
 -/
-import order.bounds
-import data.set.intervals.image_preimage
+import order.bounds.basic
+import data.set.intervals.basic
 
 /-!
 # Intervals without endpoints ordering
 
-In any decidable linear order `α`, we define the set of elements lying between two elements `a` and
-`b` as `Icc (min a b) (max a b)`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In any lattice `α`, we define `uIcc a b` to be `Icc (a ⊓ b) (a ⊔ b)`, which in a linear order is the
+set of elements lying between `a` and `b`.
 
 `Icc a b` requires the assumption `a ≤ b` to be meaningful, which is sometimes inconvenient. The
 interval as defined in this file is always the set of things lying between `a` and `b`, regardless
 of the relative order of `a` and `b`.
 
-For real numbers, `Icc (min a b) (max a b)` is the same as `segment ℝ a b`.
+For real numbers, `uIcc a b` is the same as `segment ℝ a b`.
+
+In a product or pi type, `uIcc a b` is the smallest box containing `a` and `b`. For example,
+`uIcc (1, -1) (-1, 1) = Icc (-1, -1) (1, 1)` is the square of vertices `(1, -1)`, `(-1, -1)`,
+`(-1, 1)`, `(1, 1)`.
+
+In `finset α` (seen as a hypercube of dimension `fintype.card α`), `uIcc a b` is the smallest
+subcube containing both `a` and `b`.
 
 ## Notation
 
-We use the localized notation `[a, b]` for `interval a b`. One can open the locale `interval` to
+We use the localized notation `[a, b]` for `uIcc a b`. One can open the locale `interval` to
 make the notation available.
 
 -/
 
-universe u
-open_locale pointwise
+open function order_dual (to_dual of_dual)
 
-namespace set
+variables {α β : Type*}
 
-section linear_order
+namespace set
+section lattice
+variables [lattice α] [lattice β] {a a₁ a₂ b b₁ b₂ c x : α}
 
-variables {α : Type u} [linear_order α] {a a₁ a₂ b b₁ b₂ c x : α}
+/-- `uIcc a b` is the set of elements lying between `a` and `b`, with `a` and `b` included.
+Note that we define it more generally in a lattice as `set.Icc (a ⊓ b) (a ⊔ b)`. In a product type,
+`uIcc` corresponds to the bounding box of the two elements. -/
+def uIcc (a b : α) : set α := Icc (a ⊓ b) (a ⊔ b)
 
-/-- `interval a b` is the set of elements lying between `a` and `b`, with `a` and `b` included. -/
-def interval (a b : α) := Icc (min a b) (max a b)
+localized "notation (name := set.uIcc) `[`a `, ` b `]` := set.uIcc a b" in interval
 
-localized "notation `[`a `, ` b `]` := set.interval a b" in interval
+@[simp] lemma dual_uIcc (a b : α) : [to_dual a, to_dual b] = of_dual ⁻¹' [a, b] := dual_Icc
 
-@[simp] lemma interval_of_le (h : a ≤ b) : [a, b] = Icc a b :=
-by rw [interval, min_eq_left h, max_eq_right h]
+@[simp] lemma uIcc_of_le (h : a ≤ b) : [a, b] = Icc a b :=
+by rw [uIcc, inf_eq_left.2 h, sup_eq_right.2 h]
 
-@[simp] lemma interval_of_ge (h : b ≤ a) : [a, b] = Icc b a :=
-by { rw [interval, min_eq_right h, max_eq_left h] }
+@[simp] lemma uIcc_of_ge (h : b ≤ a) : [a, b] = Icc b a :=
+by rw [uIcc, inf_eq_right.2 h, sup_eq_left.2 h]
 
-lemma interval_swap (a b : α) : [a, b] = [b, a] :=
-by rw [interval, interval, min_comm, max_comm]
+lemma uIcc_comm (a b : α) : [a, b] = [b, a] := by simp_rw [uIcc, inf_comm, sup_comm]
 
-lemma interval_of_lt (h : a < b) : [a, b] = Icc a b :=
-interval_of_le (le_of_lt h)
+lemma uIcc_of_lt (h : a < b) : [a, b] = Icc a b := uIcc_of_le h.le
+lemma uIcc_of_gt (h : b < a) : [a, b] = Icc b a := uIcc_of_ge h.le
 
-lemma interval_of_gt (h : b < a) : [a, b] = Icc b a :=
-interval_of_ge (le_of_lt h)
+@[simp] lemma uIcc_self : [a, a] = {a} := by simp [uIcc]
 
-lemma interval_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a :=
-interval_of_gt (lt_of_not_ge h)
+@[simp] lemma nonempty_uIcc : [a, b].nonempty := nonempty_Icc.2 inf_le_sup
 
-lemma interval_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b :=
-interval_of_lt (lt_of_not_ge h)
+lemma Icc_subset_uIcc : Icc a b ⊆ [a, b] := Icc_subset_Icc inf_le_left le_sup_right
+lemma Icc_subset_uIcc' : Icc b a ⊆ [a, b] := Icc_subset_Icc inf_le_right le_sup_left
 
-@[simp] lemma interval_self : [a, a] = {a} :=
-set.ext $ by simp [le_antisymm_iff, and_comm]
+@[simp] lemma left_mem_uIcc : a ∈ [a, b] := ⟨inf_le_left, le_sup_left⟩
+@[simp] lemma right_mem_uIcc : b ∈ [a, b] := ⟨inf_le_right, le_sup_right⟩
 
-@[simp] lemma nonempty_interval : set.nonempty [a, b] :=
-by { simp only [interval, min_le_iff, le_max_iff, nonempty_Icc], left, left, refl }
+lemma mem_uIcc_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] := Icc_subset_uIcc ⟨ha, hb⟩
+lemma mem_uIcc_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] := Icc_subset_uIcc' ⟨hb, ha⟩
 
-@[simp] lemma left_mem_interval : a ∈ [a, b] :=
-by { rw [interval, mem_Icc], exact ⟨min_le_left _ _, le_max_left _ _⟩ }
+lemma uIcc_subset_uIcc (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] :=
+Icc_subset_Icc (le_inf h₁.1 h₂.1) (sup_le h₁.2 h₂.2)
 
-@[simp] lemma right_mem_interval : b ∈ [a, b] :=
-by { rw interval_swap, exact left_mem_interval }
+lemma uIcc_subset_Icc (ha : a₁ ∈ Icc a₂ b₂) (hb : b₁ ∈ Icc a₂ b₂) : [a₁, b₁] ⊆ Icc a₂ b₂ :=
+Icc_subset_Icc (le_inf ha.1 hb.1) (sup_le ha.2 hb.2)
 
-lemma Icc_subset_interval : Icc a b ⊆ [a, b] :=
-by { assume x h, rwa interval_of_le, exact le_trans h.1 h.2 }
+lemma uIcc_subset_uIcc_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] :=
+iff.intro (λh, ⟨h left_mem_uIcc, h right_mem_uIcc⟩) (λ h, uIcc_subset_uIcc h.1 h.2)
 
-lemma Icc_subset_interval' : Icc b a ⊆ [a, b] :=
-by { rw interval_swap, apply Icc_subset_interval }
+lemma uIcc_subset_uIcc_iff_le' : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₂ ⊓ b₂ ≤ a₁ ⊓ b₁ ∧ a₁ ⊔ b₁ ≤ a₂ ⊔ b₂ :=
+Icc_subset_Icc_iff inf_le_sup
 
-lemma mem_interval_of_le (ha : a ≤ x) (hb : x ≤ b) : x ∈ [a, b] :=
-Icc_subset_interval ⟨ha, hb⟩
+lemma uIcc_subset_uIcc_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] := uIcc_subset_uIcc h right_mem_uIcc
+lemma uIcc_subset_uIcc_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] := uIcc_subset_uIcc left_mem_uIcc h
 
-lemma mem_interval_of_ge (hb : b ≤ x) (ha : x ≤ a) : x ∈ [a, b] :=
-Icc_subset_interval' ⟨hb, ha⟩
+lemma bdd_below_bdd_above_iff_subset_uIcc (s : set α) :
+  bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ [a, b] :=
+bdd_below_bdd_above_iff_subset_Icc.trans
+  ⟨λ ⟨a, b, h⟩, ⟨a, b, λ x hx, Icc_subset_uIcc (h hx)⟩, λ ⟨a, b, h⟩, ⟨_, _, h⟩⟩
 
-lemma not_mem_interval_of_lt (ha : c < a) (hb : c < b) : c ∉ interval a b :=
-not_mem_Icc_of_lt $ lt_min_iff.mpr ⟨ha, hb⟩
+section prod
 
-lemma not_mem_interval_of_gt (ha : a < c) (hb : b < c) : c ∉ interval a b :=
-not_mem_Icc_of_gt $ max_lt_iff.mpr ⟨ha, hb⟩
+@[simp] lemma uIcc_prod_uIcc (a₁ a₂ : α) (b₁ b₂ : β) :
+  [a₁, a₂] ×ˢ [b₁, b₂] = [(a₁, b₁), (a₂, b₂)] :=
+Icc_prod_Icc _ _ _ _
 
-lemma interval_subset_interval (h₁ : a₁ ∈ [a₂, b₂]) (h₂ : b₁ ∈ [a₂, b₂]) : [a₁, b₁] ⊆ [a₂, b₂] :=
-Icc_subset_Icc (le_min h₁.1 h₂.1) (max_le h₁.2 h₂.2)
+lemma uIcc_prod_eq (a b : α × β) : [a, b] = [a.1, b.1] ×ˢ [a.2, b.2] := by simp
 
-lemma interval_subset_Icc (ha : a₁ ∈ Icc a₂ b₂) (hb : b₁ ∈ Icc a₂ b₂) : [a₁, b₁] ⊆ Icc a₂ b₂ :=
-Icc_subset_Icc (le_min ha.1 hb.1) (max_le ha.2 hb.2)
+end prod
 
-lemma interval_subset_interval_iff_mem : [a₁, b₁] ⊆ [a₂, b₂] ↔ a₁ ∈ [a₂, b₂] ∧ b₁ ∈ [a₂, b₂] :=
-iff.intro (λh, ⟨h left_mem_interval, h right_mem_interval⟩) (λ h, interval_subset_interval h.1 h.2)
+end lattice
 
-lemma interval_subset_interval_iff_le :
-  [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
-by { rw [interval, interval, Icc_subset_Icc_iff], exact min_le_max }
+open_locale interval
 
-lemma interval_subset_interval_right (h : x ∈ [a, b]) : [x, b] ⊆ [a, b] :=
-interval_subset_interval h right_mem_interval
+section distrib_lattice
+variables [distrib_lattice α] {a a₁ a₂ b b₁ b₂ c x : α}
 
-lemma interval_subset_interval_left (h : x ∈ [a, b]) : [a, x] ⊆ [a, b] :=
-interval_subset_interval left_mem_interval h
+lemma eq_of_mem_uIcc_of_mem_uIcc (ha : a ∈ [b, c]) (hb : b ∈ [a, c]) : a = b :=
+eq_of_inf_eq_sup_eq (inf_congr_right ha.1 hb.1) $ sup_congr_right ha.2 hb.2
 
-/-- A sort of triangle inequality. -/
-lemma interval_subset_interval_union_interval : [a, c] ⊆ [a, b] ∪ [b, c] :=
-begin
-  rintro x hx,
-  obtain hac | hac := le_total a c,
-  { rw interval_of_le hac at hx,
-    obtain hb | hb := le_total x b,
-    { exact or.inl (mem_interval_of_le hx.1 hb) },
-    { exact or.inr (mem_interval_of_le hb hx.2) } },
-  { rw interval_of_ge hac at hx,
-    obtain hb | hb := le_total x b,
-    { exact or.inr (mem_interval_of_ge hx.1 hb) },
-    { exact or.inl (mem_interval_of_ge hb hx.2) } }
-end
+lemma eq_of_mem_uIcc_of_mem_uIcc' : b ∈ [a, c] → c ∈ [a, b] → b = c :=
+by simpa only [uIcc_comm a] using eq_of_mem_uIcc_of_mem_uIcc
 
-lemma bdd_below_bdd_above_iff_subset_interval (s : set α) :
-  bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ [a, b] :=
-begin
-  rw [bdd_below_bdd_above_iff_subset_Icc],
-  split,
-  { rintro ⟨a, b, h⟩, exact ⟨a, b, λ x hx, Icc_subset_interval (h hx)⟩ },
-  { rintro ⟨a, b, h⟩, exact ⟨min a b, max a b, h⟩ }
-end
+lemma uIcc_injective_right (a : α) : injective (λ b, uIcc b a) :=
+λ b c h, by { rw ext_iff at h,
+  exact eq_of_mem_uIcc_of_mem_uIcc ((h _).1 left_mem_uIcc) ((h _).2 left_mem_uIcc) }
 
-/-- The open-closed interval with unordered bounds. -/
-def interval_oc : α → α → set α := λ a b, Ioc (min a b) (max a b)
+lemma uIcc_injective_left (a : α) : injective (uIcc a) :=
+by simpa only [uIcc_comm] using uIcc_injective_right a
 
--- Below is a capital iota
-localized "notation `Ι` := set.interval_oc" in interval
+end distrib_lattice
 
-lemma interval_oc_of_le (h : a ≤ b) : Ι a b = Ioc a b :=
-by simp [interval_oc, h]
+section linear_order
+variables [linear_order α]
 
-lemma interval_oc_of_lt (h : b < a) : Ι a b = Ioc b a :=
-by simp [interval_oc, le_of_lt h]
+section lattice
+variables [lattice β] {f : α → β} {s : set α} {a b : α}
 
-lemma interval_oc_eq_union : Ι a b = Ioc a b ∪ Ioc b a :=
-by cases le_total a b; simp [interval_oc, *]
+lemma _root_.monotone_on.image_uIcc_subset (hf : monotone_on f (uIcc a b)) :
+  f '' uIcc a b ⊆ uIcc (f a) (f b) :=
+hf.image_Icc_subset.trans $
+  by rw [hf.map_sup left_mem_uIcc right_mem_uIcc, hf.map_inf left_mem_uIcc right_mem_uIcc, uIcc]
 
-lemma forall_interval_oc_iff  {P : α → Prop} :
-  (∀ x ∈ Ι a b, P x) ↔ (∀ x ∈ Ioc a b, P x) ∧ (∀ x ∈ Ioc b a, P x) :=
-by simp only [interval_oc_eq_union, mem_union_eq, or_imp_distrib, forall_and_distrib]
+lemma _root_.antitone_on.image_uIcc_subset (hf : antitone_on f (uIcc a b)) :
+  f '' uIcc a b ⊆ uIcc (f a) (f b) :=
+hf.image_Icc_subset.trans $
+  by rw [hf.map_sup left_mem_uIcc right_mem_uIcc, hf.map_inf left_mem_uIcc right_mem_uIcc, uIcc]
 
-lemma interval_oc_subset_interval_oc_of_interval_subset_interval {a b c d : α}
-  (h : [a, b] ⊆ [c, d]) : Ι a b ⊆ Ι c d :=
-Ioc_subset_Ioc (interval_subset_interval_iff_le.1 h).1 (interval_subset_interval_iff_le.1 h).2
+lemma _root_.monotone.image_uIcc_subset (hf : monotone f) : f '' uIcc a b ⊆ uIcc (f a) (f b) :=
+(hf.monotone_on _).image_uIcc_subset
 
-lemma interval_oc_swap (a b : α) : Ι a b = Ι b a :=
-by simp only [interval_oc, min_comm a b, max_comm a b]
+lemma _root_.antitone.image_uIcc_subset (hf : antitone f) : f '' uIcc a b ⊆ uIcc (f a) (f b) :=
+(hf.antitone_on _).image_uIcc_subset
 
-end linear_order
+end lattice
 
-open_locale interval
+variables [linear_order β] {f : α → β} {s : set α} {a a₁ a₂ b b₁ b₂ c d x : α}
 
-section ordered_add_comm_group
+lemma Icc_min_max : Icc (min a b) (max a b) = [a, b] := rfl
 
-variables {α : Type u} [linear_ordered_add_comm_group α] (a b c x y : α)
+lemma uIcc_of_not_le (h : ¬ a ≤ b) : [a, b] = Icc b a := uIcc_of_gt $ lt_of_not_ge h
+lemma uIcc_of_not_ge (h : ¬ b ≤ a) : [a, b] = Icc a b := uIcc_of_lt $ lt_of_not_ge h
 
-@[simp] lemma preimage_const_add_interval : (λ x, a + x) ⁻¹' [b, c] = [b - a, c - a] :=
-by simp only [interval, preimage_const_add_Icc, min_sub_sub_right, max_sub_sub_right]
+lemma uIcc_eq_union : [a, b] = Icc a b ∪ Icc b a := by rw [Icc_union_Icc', max_comm]; refl
 
-@[simp] lemma preimage_add_const_interval : (λ x, x + a) ⁻¹' [b, c] = [b - a, c - a] :=
-by simpa only [add_comm] using preimage_const_add_interval a b c
+lemma mem_uIcc : a ∈ [b, c] ↔ b ≤ a ∧ a ≤ c ∨ c ≤ a ∧ a ≤ b := by simp [uIcc_eq_union]
 
-@[simp] lemma preimage_neg_interval : - [a, b] = [-a, -b] :=
-by simp only [interval, preimage_neg_Icc, min_neg_neg, max_neg_neg]
+lemma not_mem_uIcc_of_lt (ha : c < a) (hb : c < b) : c ∉ [a, b] :=
+not_mem_Icc_of_lt $ lt_min_iff.mpr ⟨ha, hb⟩
 
-@[simp] lemma preimage_sub_const_interval : (λ x, x - a) ⁻¹' [b, c] = [b + a, c + a] :=
-by simp [sub_eq_add_neg]
+lemma not_mem_uIcc_of_gt (ha : a < c) (hb : b < c) : c ∉ [a, b] :=
+not_mem_Icc_of_gt $ max_lt_iff.mpr ⟨ha, hb⟩
 
-@[simp] lemma preimage_const_sub_interval : (λ x, a - x) ⁻¹' [b, c] = [a - b, a - c] :=
-by { rw [interval, interval, preimage_const_sub_Icc],
-  simp only [sub_eq_add_neg, min_add_add_left, max_add_add_left, min_neg_neg, max_neg_neg], }
+lemma uIcc_subset_uIcc_iff_le :
+  [a₁, b₁] ⊆ [a₂, b₂] ↔ min a₂ b₂ ≤ min a₁ b₁ ∧ max a₁ b₁ ≤ max a₂ b₂ :=
+uIcc_subset_uIcc_iff_le'
 
-@[simp] lemma image_const_add_interval : (λ x, a + x) '' [b, c] = [a + b, a + c] :=
-by simp [add_comm]
+/-- A sort of triangle inequality. -/
+lemma uIcc_subset_uIcc_union_uIcc : [a, c] ⊆ [a, b] ∪ [b, c] :=
+λ x, by simp only [mem_uIcc, mem_union]; cases le_total a c; cases le_total x b; tauto
 
-@[simp] lemma image_add_const_interval : (λ x, x + a) '' [b, c] = [b + a, c + a] :=
-by simp
+lemma monotone_or_antitone_iff_uIcc :
+  monotone f ∨ antitone f ↔ ∀ a b c, c ∈ [a, b] → f c ∈ [f a, f b] :=
+begin
+  split,
+  { rintro (hf | hf) a b c; simp_rw [←Icc_min_max, ←hf.map_min, ←hf.map_max],
+    exacts [λ hc, ⟨hf hc.1, hf hc.2⟩, λ hc, ⟨hf hc.2, hf hc.1⟩] },
+  contrapose!,
+  rw not_monotone_not_antitone_iff_exists_le_le,
+  rintro ⟨a, b, c, hab, hbc, ⟨hfab, hfcb⟩ | ⟨hfba, hfbc⟩⟩,
+  { exact ⟨a, c, b, Icc_subset_uIcc ⟨hab, hbc⟩, λ h, h.2.not_lt $ max_lt hfab hfcb⟩ },
+  { exact ⟨a, c, b, Icc_subset_uIcc ⟨hab, hbc⟩, λ h, h.1.not_lt $ lt_min hfba hfbc⟩ }
+end
 
-@[simp] lemma image_const_sub_interval : (λ x, a - x) '' [b, c] = [a - b, a - c] :=
-by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+lemma monotone_on_or_antitone_on_iff_uIcc :
+  monotone_on f s ∨ antitone_on f s ↔ ∀ a b c ∈ s, c ∈ [a, b] → f c ∈ [f a, f b] :=
+by simp [monotone_on_iff_monotone, antitone_on_iff_antitone, monotone_or_antitone_iff_uIcc,
+  mem_uIcc]
 
-@[simp] lemma image_sub_const_interval : (λ x, x - a) '' [b, c] = [b - a, c - a] :=
-by simp [sub_eq_add_neg, add_comm]
+/-- The open-closed interval with unordered bounds. -/
+def uIoc : α → α → set α := λ a b, Ioc (min a b) (max a b)
 
-lemma image_neg_interval : has_neg.neg '' [a, b] = [-a, -b] := by simp
+-- Below is a capital iota
+localized "notation `Ι` := set.uIoc" in interval
 
-variables {a b c x y}
+@[simp] lemma uIoc_of_le (h : a ≤ b) : Ι a b = Ioc a b := by simp [uIoc, h]
+@[simp] lemma uIoc_of_lt (h : b < a) : Ι a b = Ioc b a := by simp [uIoc, h.le]
 
-/-- If `[x, y]` is a subinterval of `[a, b]`, then the distance between `x` and `y`
-is less than or equal to that of `a` and `b` -/
-lemma abs_sub_le_of_subinterval (h : [x, y] ⊆ [a, b]) : |y - x| ≤ |b - a| :=
-begin
-  rw [← max_sub_min_eq_abs, ← max_sub_min_eq_abs],
-  rw [interval_subset_interval_iff_le] at h,
-  exact sub_le_sub h.2 h.1,
-end
+lemma uIoc_eq_union : Ι a b = Ioc a b ∪ Ioc b a := by cases le_total a b; simp [uIoc, *]
 
-/-- If `x ∈ [a, b]`, then the distance between `a` and `x` is less than or equal to
-that of `a` and `b`  -/
-lemma abs_sub_left_of_mem_interval (h : x ∈ [a, b]) : |x - a| ≤ |b - a| :=
-abs_sub_le_of_subinterval (interval_subset_interval_left h)
+lemma mem_uIoc : a ∈ Ι b c ↔ b < a ∧ a ≤ c ∨ c < a ∧ a ≤ b :=
+by simp only [uIoc_eq_union, mem_union, mem_Ioc]
 
-/-- If `x ∈ [a, b]`, then the distance between `x` and `b` is less than or equal to
-that of `a` and `b`  -/
-lemma abs_sub_right_of_mem_interval (h : x ∈ [a, b]) : |b - x| ≤ |b - a| :=
-abs_sub_le_of_subinterval (interval_subset_interval_right h)
+lemma not_mem_uIoc : a ∉ Ι b c ↔ a ≤ b ∧ a ≤ c ∨ c < a ∧ b < a :=
+by { simp only [uIoc_eq_union, mem_union, mem_Ioc, not_lt, ←not_le], tauto }
 
-end ordered_add_comm_group
+@[simp] lemma left_mem_uIoc : a ∈ Ι a b ↔ b < a := by simp [mem_uIoc]
+@[simp] lemma right_mem_uIoc : b ∈ Ι a b ↔ a < b := by simp [mem_uIoc]
 
-section linear_ordered_field
+lemma forall_uIoc_iff  {P : α → Prop} :
+  (∀ x ∈ Ι a b, P x) ↔ (∀ x ∈ Ioc a b, P x) ∧ (∀ x ∈ Ioc b a, P x) :=
+by simp only [uIoc_eq_union, mem_union, or_imp_distrib, forall_and_distrib]
 
-variables {k : Type u} [linear_ordered_field k] {a : k}
+lemma uIoc_subset_uIoc_of_uIcc_subset_uIcc (h : [a, b] ⊆ [c, d]) : Ι a b ⊆ Ι c d :=
+Ioc_subset_Ioc (uIcc_subset_uIcc_iff_le.1 h).1 (uIcc_subset_uIcc_iff_le.1 h).2
 
-@[simp] lemma preimage_mul_const_interval (ha : a ≠ 0) (b c : k) :
-  (λ x, x * a) ⁻¹' [b, c] = [b / a, c / a] :=
-(lt_or_gt_of_ne ha).elim
-  (λ ha, by simp [interval, ha, ha.le, min_div_div_right_of_nonpos, max_div_div_right_of_nonpos])
-  (λ (ha : 0 < a), by simp [interval, ha, ha.le, min_div_div_right, max_div_div_right])
+lemma uIoc_swap (a b : α) : Ι a b = Ι b a := by simp only [uIoc, min_comm a b, max_comm a b]
 
-@[simp] lemma preimage_const_mul_interval (ha : a ≠ 0) (b c : k) :
-  (λ x, a * x) ⁻¹' [b, c] = [b / a, c / a] :=
-by simp only [← preimage_mul_const_interval ha, mul_comm]
+lemma Ioc_subset_uIoc : Ioc a b ⊆ Ι a b := Ioc_subset_Ioc (min_le_left _ _) (le_max_right _ _)
+lemma Ioc_subset_uIoc' : Ioc a b ⊆ Ι b a := Ioc_subset_Ioc (min_le_right _ _) (le_max_left _ _)
 
-@[simp] lemma preimage_div_const_interval (ha : a ≠ 0) (b c : k) :
-  (λ x, x / a) ⁻¹' [b, c] = [b * a, c * a] :=
-by simp only [div_eq_mul_inv, preimage_mul_const_interval (inv_ne_zero ha), inv_inv]
+lemma eq_of_mem_uIoc_of_mem_uIoc : a ∈ Ι b c → b ∈ Ι a c → a = b :=
+by simp_rw mem_uIoc; rintro (⟨_, _⟩ | ⟨_, _⟩) (⟨_, _⟩ | ⟨_, _⟩); apply le_antisymm;
+  assumption <|> exact le_of_lt ‹_› <|> exact le_trans ‹_› (le_of_lt ‹_›)
 
-@[simp] lemma image_mul_const_interval (a b c : k) : (λ x, x * a) '' [b, c] = [b * a, c * a] :=
-if ha : a = 0 then by simp [ha] else
-calc (λ x, x * a) '' [b, c] = (λ x, x * a⁻¹) ⁻¹' [b, c] :
-  (units.mk0 a ha).mul_right.image_eq_preimage _
-... = (λ x, x / a) ⁻¹' [b, c] : by simp only [div_eq_mul_inv]
-... = [b * a, c * a] : preimage_div_const_interval ha _ _
+lemma eq_of_mem_uIoc_of_mem_uIoc' : b ∈ Ι a c → c ∈ Ι a b → b = c :=
+by simpa only [uIoc_swap a] using eq_of_mem_uIoc_of_mem_uIoc
 
-@[simp] lemma image_const_mul_interval (a b c : k) : (λ x, a * x) '' [b, c] = [a * b, a * c] :=
-by simpa only [mul_comm] using image_mul_const_interval a b c
+lemma eq_of_not_mem_uIoc_of_not_mem_uIoc (ha : a ≤ c) (hb : b ≤ c) :
+  a ∉ Ι b c → b ∉ Ι a c → a = b :=
+by simp_rw not_mem_uIoc; rintro (⟨_, _⟩ | ⟨_, _⟩) (⟨_, _⟩ | ⟨_, _⟩); apply le_antisymm;
+    assumption <|> exact le_of_lt ‹_› <|> cases not_le_of_lt ‹_› ‹_›
 
-@[simp] lemma image_div_const_interval (a b c : k) : (λ x, x / a) '' [b, c] = [b / a, c / a] :=
-by simp only [div_eq_mul_inv, image_mul_const_interval]
+lemma uIoc_injective_right (a : α) : injective (λ b, Ι b a) :=
+begin
+  rintro b c h,
+  rw ext_iff at h,
+  obtain ha | ha := le_or_lt b a,
+  { have hb := (h b).not,
+    simp only [ha, left_mem_uIoc, not_lt, true_iff, not_mem_uIoc, ←not_le, and_true,
+      not_true, false_and, not_false_iff, true_iff, or_false] at hb,
+    refine hb.eq_of_not_lt (λ hc, _),
+    simpa [ha, and_iff_right hc, ←@not_le _ _ _ a, -not_le] using h c },
+  { refine eq_of_mem_uIoc_of_mem_uIoc ((h _).1 $ left_mem_uIoc.2 ha)
+      ((h _).2 $ left_mem_uIoc.2 $ ha.trans_le _),
+    simpa [ha, ha.not_le, mem_uIoc] using h b }
+end
 
-end linear_ordered_field
+lemma uIoc_injective_left (a : α) : injective (Ι a) :=
+by simpa only [uIoc_swap] using uIoc_injective_right a
 
+end linear_order
 end set
diff --git a/src/data/set/intervals/with_bot_top.lean b/src/data/set/intervals/with_bot_top.lean
index 6f4c2ee095456..872f690fdba60 100644
--- a/src/data/set/intervals/with_bot_top.lean
+++ b/src/data/set/intervals/with_bot_top.lean
@@ -8,6 +8,9 @@ import data.set.intervals.basic
 /-!
 # Intervals in `with_top α` and `with_bot α`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove various lemmas about `set.image`s and `set.preimage`s of intervals under
 `coe : α → with_top α` and `coe : α → with_bot α`.
 -/
diff --git a/src/data/set/lattice.lean b/src/data/set/lattice.lean
index a623ef7a53a1e..d29f105c83895 100644
--- a/src/data/set/lattice.lean
+++ b/src/data/set/lattice.lean
@@ -3,7 +3,6 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Leonardo de Moura, Johannes Hölzl, Mario Carneiro
 -/
-import data.nat.basic
 import order.complete_boolean_algebra
 import order.directed
 import order.galois_connection
@@ -11,6 +10,9 @@ import order.galois_connection
 /-!
 # The set lattice
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides usual set notation for unions and intersections, a `complete_lattice` instance
 for `set α`, and some more set constructions.
 
@@ -62,14 +64,19 @@ namespace set
 /-! ### Complete lattice and complete Boolean algebra instances -/
 
 instance : has_Inf (set α) := ⟨λ s, {a | ∀ t ∈ s, a ∈ t}⟩
-instance : has_Sup (set α) := ⟨sUnion⟩
+instance : has_Sup (set α) := ⟨λ s, {a | ∃ t ∈ s, a ∈ t}⟩
 
 /-- Intersection of a set of sets. -/
 def sInter (S : set (set α)) : set α := Inf S
 
+/-- Union of a set of sets. -/
+def sUnion (S : set (set α)) : set α := Sup S
+
 prefix `⋂₀ `:110 := sInter
+prefix `⋃₀ `:110 := sUnion
 
 @[simp] theorem mem_sInter {x : α} {S : set (set α)} : x ∈ ⋂₀ S ↔ ∀ t ∈ S, x ∈ t := iff.rfl
+@[simp] theorem mem_sUnion {x : α} {S : set (set α)} : x ∈ ⋃₀ S ↔ ∃ t ∈ S, x ∈ t := iff.rfl
 
 /-- Indexed union of a family of sets -/
 def Union (s : ι → set β) : set β := supr s
@@ -111,8 +118,6 @@ lemma mem_Inter_of_mem {s : ι → set α} {a : α} (h : ∀ i, a ∈ s i) : a 
 lemma mem_Inter₂_of_mem {s : Π i, κ i → set α} {a : α} (h : ∀ i j, a ∈ s i j) : a ∈ ⋂ i j, s i j :=
 mem_Inter₂.2 h
 
-theorem mem_sUnion {x : α} {S : set (set α)} : x ∈ ⋃₀ S ↔ ∃ t ∈ S, x ∈ t := iff.rfl
-
 instance : complete_boolean_algebra (set α) :=
 { Sup    := Sup,
   Inf    := Inf,
@@ -122,40 +127,7 @@ instance : complete_boolean_algebra (set α) :=
   Inf_le := λ s t t_in a h, h _ t_in,
   infi_sup_le_sup_Inf := λ s S x, iff.mp $ by simp [forall_or_distrib_left],
   inf_Sup_le_supr_inf := λ s S x, iff.mp $ by simp [exists_and_distrib_left],
-  .. set.boolean_algebra,
-  .. pi.complete_lattice }
-
-/-- `set.image` is monotone. See `set.image_image` for the statement in terms of `⊆`. -/
-lemma monotone_image {f : α → β} : monotone (image f) :=
-λ s t, image_subset _
-
-theorem _root_.monotone.inter [preorder β] {f g : β → set α}
-  (hf : monotone f) (hg : monotone g) : monotone (λ x, f x ∩ g x) :=
-hf.inf hg
-
-theorem _root_.antitone.inter [preorder β] {f g : β → set α}
-  (hf : antitone f) (hg : antitone g) : antitone (λ x, f x ∩ g x) :=
-hf.inf hg
-
-theorem _root_.monotone.union [preorder β] {f g : β → set α}
-  (hf : monotone f) (hg : monotone g) : monotone (λ x, f x ∪ g x) :=
-hf.sup hg
-
-theorem _root_.antitone.union [preorder β] {f g : β → set α}
-  (hf : antitone f) (hg : antitone g) : antitone (λ x, f x ∪ g x) :=
-hf.sup hg
-
-theorem monotone_set_of [preorder α] {p : α → β → Prop}
-  (hp : ∀ b, monotone (λ a, p a b)) : monotone (λ a, {b | p a b}) :=
-λ a a' h b, hp b h
-
-theorem antitone_set_of [preorder α] {p : α → β → Prop}
-  (hp : ∀ b, antitone (λ a, p a b)) : antitone (λ a, {b | p a b}) :=
-λ a a' h b, hp b h
-
-/-- Quantifying over a set is antitone in the set -/
-lemma antitone_bforall {P : α → Prop} : antitone (λ s : set α, ∀ x ∈ s, P x) :=
-λ s t hst h x hx, h x $ hst hx
+  .. set.boolean_algebra }
 
 section galois_connection
 variables {f : α → β}
@@ -187,6 +159,11 @@ supr_congr_Prop pq f
   (pq : p ↔ q) (f : ∀x, f₁ (pq.mpr x) = f₂ x) : Inter f₁ = Inter f₂ :=
 infi_congr_Prop pq f
 
+lemma Union_plift_up (f : plift ι → set α) : (⋃ i, f (plift.up i)) = ⋃ i, f i := supr_plift_up _
+lemma Union_plift_down (f : ι → set α) : (⋃ i, f (plift.down i)) = ⋃ i, f i := supr_plift_down _
+lemma Inter_plift_up (f : plift ι → set α) : (⋂ i, f (plift.up i)) = ⋂ i, f i := infi_plift_up _
+lemma Inter_plift_down (f : ι → set α) : (⋂ i, f (plift.down i)) = ⋂ i, f i := infi_plift_down _
+
 lemma Union_eq_if {p : Prop} [decidable p] (s : set α) :
   (⋃ h : p, s) = if p then s else ∅ :=
 supr_eq_if _
@@ -271,6 +248,18 @@ explicit for this purpose. -/
 lemma Inter_subset_of_subset {s : ι → set α} {t : set α} (i : ι) (h : s i ⊆ t) : (⋂ i, s i) ⊆ t :=
 @infi_le_of_le (set α) _ _ _ _ i h
 
+/-- This rather trivial consequence of `subset_Union₂` is convenient with `apply`, and has `i` and
+`j` explicit for this purpose. -/
+lemma subset_Union₂_of_subset {s : set α} {t : Π i, κ i → set α} (i : ι) (j : κ i) (h : s ⊆ t i j) :
+  s ⊆ ⋃ i j, t i j :=
+@le_supr₂_of_le (set α) _ _ _ _ _ i j h
+
+/-- This rather trivial consequence of `Inter₂_subset` is convenient with `apply`, and has `i` and
+`j` explicit for this purpose. -/
+lemma Inter₂_subset_of_subset {s : Π i, κ i → set α} {t : set α} (i : ι) (j : κ i) (h : s i j ⊆ t) :
+  (⋂ i j, s i j) ⊆ t :=
+@infi₂_le_of_le (set α) _ _ _ _ _ i j h
+
 lemma Union_mono {s t : ι → set α} (h : ∀ i, s i ⊆ t i) : (⋃ i, s i) ⊆ ⋃ i, t i :=
 @supr_mono (set α) _ _ s t h
 
@@ -323,9 +312,27 @@ lemma Inter_congr_of_surjective {f : ι → set α} {g : ι₂ → set α} (h :
   (h1 : surjective h) (h2 : ∀ x, g (h x) = f x) : (⋂ x, f x) = ⋂ y, g y :=
 h1.infi_congr h h2
 
-theorem Union_const [nonempty ι] (s : set β) : (⋃ i : ι, s) = s := supr_const
+lemma Union_congr {s t : ι → set α} (h : ∀ i, s i = t i) : (⋃ i, s i) = ⋃ i, t i := supr_congr h
+lemma Inter_congr {s t : ι → set α} (h : ∀ i, s i = t i) : (⋂ i, s i) = ⋂ i, t i := infi_congr h
+
+lemma Union₂_congr {s t : Π i, κ i → set α} (h : ∀ i j, s i j = t i j) :
+  (⋃ i j, s i j) = ⋃ i j, t i j :=
+Union_congr $ λ i, Union_congr $ h i
+
+lemma Inter₂_congr {s t : Π i, κ i → set α} (h : ∀ i j, s i j = t i j) :
+  (⋂ i j, s i j) = ⋂ i j, t i j :=
+Inter_congr $ λ i, Inter_congr $ h i
+
+section nonempty
+variables [nonempty ι] {f : ι → set α} {s : set α}
+
+lemma Union_const (s : set β) : (⋃ i : ι, s) = s := supr_const
+lemma Inter_const (s : set β) : (⋂ i : ι, s) = s := infi_const
 
-theorem Inter_const [nonempty ι] (s : set β) : (⋂ i : ι, s) = s := infi_const
+lemma Union_eq_const (hf : ∀ i, f i = s) : (⋃ i, f i) = s := (Union_congr hf).trans $ Union_const _
+lemma Inter_eq_const (hf : ∀ i, f i = s) : (⋂ i, f i) = s := (Inter_congr hf).trans $ Inter_const _
+
+end nonempty
 
 @[simp] theorem compl_Union (s : ι → set β) : (⋃ i, s i)ᶜ = (⋂ i, (s i)ᶜ) :=
 compl_supr
@@ -384,6 +391,10 @@ theorem union_Inter (s : set β) (t : ι → set β) :
   s ∪ (⋂ i, t i) = ⋂ i, s ∪ t i :=
 sup_infi_eq _ _
 
+theorem Inter_union (s : ι → set β) (t : set β) :
+  (⋂ i, s i) ∪ t = ⋂ i, s i ∪ t :=
+infi_sup_eq _ _
+
 theorem Union_diff (s : set β) (t : ι → set β) :
   (⋃ i, t i) \ s = ⋃ i, t i \ s :=
 Union_inter _ _
@@ -405,19 +416,27 @@ let ⟨z, zb₁, zb₂⟩ := hd b₁ b₂,
 ⟨x, ⟨z, xf⟩, xa₁, xa₂⟩
 
 lemma Union_inter_subset {ι α} {s t : ι → set α} : (⋃ i, s i ∩ t i) ⊆ (⋃ i, s i) ∩ (⋃ i, t i) :=
-by { rintro x ⟨_, ⟨i, rfl⟩, xs, xt⟩, exact ⟨⟨_, ⟨i, rfl⟩, xs⟩, _, ⟨i, rfl⟩, xt⟩ }
+le_supr_inf_supr s t
 
-lemma Union_inter_of_monotone {ι α} [semilattice_sup ι] {s t : ι → set α}
+lemma Union_inter_of_monotone {ι α} [preorder ι] [is_directed ι (≤)] {s t : ι → set α}
   (hs : monotone s) (ht : monotone t) : (⋃ i, s i ∩ t i) = (⋃ i, s i) ∩ (⋃ i, t i) :=
-begin
-  ext x, refine ⟨λ hx, Union_inter_subset hx, _⟩,
-  rintro ⟨⟨_, ⟨i, rfl⟩, xs⟩, _, ⟨j, rfl⟩, xt⟩,
-  exact ⟨_, ⟨i ⊔ j, rfl⟩, hs le_sup_left xs, ht le_sup_right xt⟩
-end
+supr_inf_of_monotone hs ht
+
+lemma Union_inter_of_antitone {ι α} [preorder ι] [is_directed ι (swap (≤))] {s t : ι → set α}
+  (hs : antitone s) (ht : antitone t) : (⋃ i, s i ∩ t i) = (⋃ i, s i) ∩ (⋃ i, t i) :=
+supr_inf_of_antitone hs ht
+
+lemma Inter_union_of_monotone {ι α} [preorder ι] [is_directed ι (swap (≤))] {s t : ι → set α}
+  (hs : monotone s) (ht : monotone t) : (⋂ i, s i ∪ t i) = (⋂ i, s i) ∪ (⋂ i, t i) :=
+infi_sup_of_monotone hs ht
+
+lemma Inter_union_of_antitone {ι α} [preorder ι] [is_directed ι (≤)] {s t : ι → set α}
+  (hs : antitone s) (ht : antitone t) : (⋂ i, s i ∪ t i) = (⋂ i, s i) ∪ (⋂ i, t i) :=
+infi_sup_of_antitone hs ht
 
 /-- An equality version of this lemma is `Union_Inter_of_monotone` in `data.set.finite`. -/
 lemma Union_Inter_subset {s : ι → ι' → set α} : (⋃ j, ⋂ i, s i j) ⊆ ⋂ i, ⋃ j, s i j :=
-by { rintro x ⟨_, ⟨i, rfl⟩, hx⟩ _ ⟨j, rfl⟩, exact ⟨_, ⟨i, rfl⟩, hx _ ⟨j, rfl⟩⟩ }
+supr_infi_le_infi_supr (flip s)
 
 lemma Union_option {ι} (s : option ι → set α) : (⋃ o, s o) = s none ∪ ⋃ i, s (some i) :=
 supr_option s
@@ -464,9 +483,8 @@ end
 
 /-! ### Unions and intersections indexed by `Prop` -/
 
-@[simp] theorem Inter_false {s : false → set α} : Inter s = univ := infi_false
-
-@[simp] theorem Union_false {s : false → set α} : Union s = ∅ := supr_false
+theorem Inter_false {s : false → set α} : Inter s = univ := infi_false
+theorem Union_false {s : false → set α} : Union s = ∅ := supr_false
 
 @[simp] theorem Inter_true {s : true → set α} : Inter s = s trivial := infi_true
 
@@ -493,11 +511,11 @@ variables {s : ι → set α}
 @[simp] lemma Inter_eq_univ : (⋂ i, s i) = univ ↔ ∀ i, s i = univ := infi_eq_top
 
 @[simp] lemma nonempty_Union : (⋃ i, s i).nonempty ↔ ∃ i, (s i).nonempty :=
-by simp [← ne_empty_iff_nonempty]
+by simp [nonempty_iff_ne_empty]
 
 @[simp] lemma nonempty_bUnion {t : set α} {s : α → set β} :
   (⋃ i ∈ t, s i).nonempty ↔ ∃ i ∈ t, (s i).nonempty :=
-by simp [← ne_empty_iff_nonempty]
+by simp [nonempty_iff_ne_empty]
 
 lemma Union_nonempty_index (s : set α) (t : s.nonempty → set β) :
   (⋃ h, t h) = ⋃ x ∈ s, t ⟨x, ‹_›⟩ :=
@@ -537,13 +555,16 @@ theorem Inter_and {p q : Prop} (s : p ∧ q → set α) :
   (⋂ h, s h) = ⋂ hp hq, s ⟨hp, hq⟩ :=
 infi_and
 
-theorem Union_comm (s : ι → ι' → set α) :
-  (⋃ i i', s i i') = ⋃ i' i, s i i' :=
-supr_comm
+lemma Union_comm (s : ι → ι' → set α) : (⋃ i i', s i i') = ⋃ i' i, s i i' := supr_comm
+lemma Inter_comm (s : ι → ι' → set α) : (⋂ i i', s i i') = ⋂ i' i, s i i' := infi_comm
+
+lemma Union₂_comm (s : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → set α) :
+  (⋃ i₁ j₁ i₂ j₂, s i₁ j₁ i₂ j₂) = ⋃ i₂ j₂ i₁ j₁, s i₁ j₁ i₂ j₂ :=
+supr₂_comm _
 
-theorem Inter_comm (s : ι → ι' → set α) :
-  (⋂ i i', s i i') = ⋂ i' i, s i i' :=
-infi_comm
+lemma Inter₂_comm (s : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → set α) :
+  (⋂ i₁ j₁ i₂ j₂, s i₁ j₁ i₂ j₂) = ⋂ i₂ j₂ i₁ j₁, s i₁ j₁ i₂ j₂ :=
+infi₂_comm _
 
 @[simp] theorem bUnion_and (p : ι → Prop) (q : ι → ι' → Prop) (s : Π x y, p x ∧ q x y → set α) :
   (⋃ (x : ι) (y : ι') (h : p x ∧ q x y), s x y h) =
@@ -611,17 +632,6 @@ lemma bInter_mono {s s' : set α} {t t' : α → set β} (hs : s ⊆ s') (h : 
   (⋂ x ∈ s', t x) ⊆ (⋂ x ∈ s, t' x) :=
 (bInter_subset_bInter_left hs).trans $ Inter₂_mono h
 
-lemma Union_congr {s t : ι → set α} (h : ∀ i, s i = t i) : (⋃ i, s i) = ⋃ i, t i := supr_congr h
-lemma Inter_congr {s t : ι → set α} (h : ∀ i, s i = t i) : (⋂ i, s i) = ⋂ i, t i := infi_congr h
-
-lemma Union₂_congr {s t : Π i, κ i → set α} (h : ∀ i j, s i j = t i j) :
-  (⋃ i j, s i j) = ⋃ i j, t i j :=
-Union_congr $ λ i, Union_congr $ h i
-
-lemma Inter₂_congr {s t : Π i, κ i → set α} (h : ∀ i j, s i j = t i j) :
-  (⋂ i j, s i j) = ⋂ i j, t i j :=
-Inter_congr $ λ i, Inter_congr $ h i
-
 theorem bUnion_eq_Union (s : set α) (t : Π x ∈ s, set β) :
   (⋃ x ∈ s, t x ‹_›) = (⋃ x : s, t x x.2) :=
 supr_subtype'
@@ -723,6 +733,12 @@ by simp only [inter_Union]
 lemma Union₂_inter (s : Π i, κ i → set α) (t : set α) : (⋃ i j, s i j) ∩ t = ⋃ i j, s i j ∩ t :=
 by simp_rw Union_inter
 
+lemma union_Inter₂ (s : set α) (t : Π i, κ i → set α) : s ∪ (⋂ i j, t i j) = ⋂ i j, s ∪ t i j :=
+by simp_rw union_Inter
+
+lemma Inter₂_union (s : Π i, κ i → set α) (t : set α) : (⋂ i j, s i j) ∪ t = ⋂ i j, s i j ∪ t :=
+by simp_rw Inter_union
+
 theorem mem_sUnion_of_mem {x : α} {t : set α} {S : set (set α)} (hx : x ∈ t) (ht : t ∈ S) :
   x ∈ ⋃₀ S :=
 ⟨t, ht, hx⟩
@@ -773,7 +789,7 @@ subset_sInter $ λ s hs, sInter_subset_of_mem (h hs)
 @[simp] theorem sInter_eq_univ {S : set (set α)} : (⋂₀ S) = univ ↔ ∀ s ∈ S, s = univ := Inf_eq_top
 
 @[simp] theorem nonempty_sUnion {S : set (set α)} : (⋃₀ S).nonempty ↔ ∃ s ∈ S, set.nonempty s :=
-by simp [← ne_empty_iff_nonempty]
+by simp [nonempty_iff_ne_empty]
 
 lemma nonempty.of_sUnion {s : set (set α)} (h : (⋃₀ s).nonempty) : s.nonempty :=
 let ⟨s, hs, _⟩ := nonempty_sUnion.1 h in ⟨s, hs⟩
@@ -791,6 +807,12 @@ Sup_insert
 @[simp] theorem sInter_insert (s : set α) (T : set (set α)) : ⋂₀ (insert s T) = s ∩ ⋂₀ T :=
 Inf_insert
 
+@[simp] lemma sUnion_diff_singleton_empty (s : set (set α)) : ⋃₀ (s \ {∅}) = ⋃₀ s :=
+Sup_diff_singleton_bot s
+
+@[simp] lemma sInter_diff_singleton_univ (s : set (set α)) : ⋂₀ (s \ {univ}) = ⋂₀ s :=
+Inf_diff_singleton_top s
+
 theorem sUnion_pair (s t : set α) : ⋃₀ {s, t} = s ∪ t :=
 Sup_pair
 
@@ -830,17 +852,17 @@ by simp [set.eq_empty_iff_forall_not_mem]
 
 -- classical
 @[simp] theorem nonempty_Inter {f : ι → set α} : (⋂ i, f i).nonempty ↔ ∃ x, ∀ i, x ∈ f i :=
-by simp [← ne_empty_iff_nonempty, Inter_eq_empty_iff]
+by simp [nonempty_iff_ne_empty, Inter_eq_empty_iff]
 
 -- classical
 @[simp] lemma nonempty_Inter₂ {s : Π i, κ i → set α} :
   (⋂ i j, s i j).nonempty ↔ ∃ a, ∀ i j, a ∈ s i j :=
-by simp [← ne_empty_iff_nonempty, Inter_eq_empty_iff]
+by simp [nonempty_iff_ne_empty, Inter_eq_empty_iff]
 
 -- classical
 @[simp] theorem nonempty_sInter {c : set (set α)}:
   (⋂₀ c).nonempty ↔ ∃ a, ∀ b ∈ c, a ∈ b :=
-by simp [← ne_empty_iff_nonempty, sInter_eq_empty_iff]
+by simp [nonempty_iff_ne_empty, sInter_eq_empty_iff]
 
 -- classical
 theorem compl_sUnion (S : set (set α)) :
@@ -875,6 +897,9 @@ set.ext $ by simp
 theorem Union_eq_range_sigma (s : α → set β) : (⋃ i, s i) = range (λ a : Σ i, s i, a.2) :=
 by simp [set.ext_iff]
 
+theorem Union_eq_range_psigma (s : ι → set β) : (⋃ i, s i) = range (λ a : Σ' i, s i, a.2) :=
+by simp [set.ext_iff]
+
 theorem Union_image_preimage_sigma_mk_eq_self {ι : Type*} {σ : ι → Type*} (s : set (sigma σ)) :
   (⋃ i, sigma.mk i '' (sigma.mk i ⁻¹' s)) = s :=
 begin
@@ -917,6 +942,9 @@ by simp only [←sUnion_range, subtype.range_coe]
 lemma sInter_eq_Inter {s : set (set α)} : (⋂₀ s) = (⋂ (i : s), i) :=
 by simp only [←sInter_range, subtype.range_coe]
 
+@[simp] lemma Union_of_empty [is_empty ι] (s : ι → set α) : (⋃ i, s i) = ∅ := supr_of_empty _
+@[simp] lemma Inter_of_empty [is_empty ι] (s : ι → set α) : (⋂ i, s i) = univ := infi_of_empty _
+
 lemma union_eq_Union {s₁ s₂ : set α} : s₁ ∪ s₂ = ⋃ b : bool, cond b s₁ s₂ :=
 sup_eq_supr s₁ s₂
 
@@ -1042,20 +1070,39 @@ lemma image_sInter_subset (S : set (set α)) (f : α → β) :
   f '' (⋂₀ S) ⊆ ⋂ s ∈ S, f '' s :=
 by { rw sInter_eq_bInter, apply image_Inter₂_subset }
 
-/-! ### `inj_on` -/
+/-! ### `restrict_preimage` -/
+section
 
-lemma inj_on.image_inter {f : α → β} {s t u : set α} (hf : inj_on f u) (hs : s ⊆ u) (ht : t ⊆ u) :
-  f '' (s ∩ t) = f '' s ∩ f '' t :=
+open function
+
+variables (s : set β) {f : α → β} {U : ι → set β} (hU : Union U = univ)
+
+include hU
+
+lemma injective_iff_injective_of_Union_eq_univ :
+  injective f ↔ ∀ i, injective ((U i).restrict_preimage f) :=
 begin
-  apply subset.antisymm (image_inter_subset _ _ _),
-  rintros x ⟨⟨y, ys, hy⟩, ⟨z, zt, hz⟩⟩,
-  have : y = z,
-  { apply hf (hs ys) (ht zt),
-    rwa ← hz at hy },
-  rw ← this at zt,
-  exact ⟨y, ⟨ys, zt⟩, hy⟩,
+  refine ⟨λ H i, (U i).restrict_preimage_injective H, λ H x y e, _⟩,
+  obtain ⟨i, hi⟩ := set.mem_Union.mp (show f x ∈ set.Union U, by { rw hU, triv }),
+  injection @H i ⟨x, hi⟩ ⟨y, show f y ∈ U i, from e ▸ hi⟩ (subtype.ext e)
 end
 
+lemma surjective_iff_surjective_of_Union_eq_univ :
+  surjective f ↔ ∀ i, surjective ((U i).restrict_preimage f) :=
+begin
+  refine ⟨λ H i, (U i).restrict_preimage_surjective H, λ H x, _⟩,
+  obtain ⟨i, hi⟩ := set.mem_Union.mp (show x ∈ set.Union U, by { rw hU, triv }),
+  exact ⟨_, congr_arg subtype.val (H i ⟨x, hi⟩).some_spec⟩
+end
+
+lemma bijective_iff_bijective_of_Union_eq_univ :
+  bijective f ↔ ∀ i, bijective ((U i).restrict_preimage f) :=
+by simp_rw [bijective, forall_and_distrib, injective_iff_injective_of_Union_eq_univ hU,
+  surjective_iff_surjective_of_Union_eq_univ hU]
+end
+
+/-! ### `inj_on` -/
+
 lemma inj_on.image_Inter_eq [nonempty ι] {s : ι → set α} {f : α → β} (h : inj_on f (⋃ i, s i)) :
   f '' (⋂ i, s i) = ⋂ i, f '' (s i) :=
 begin
@@ -1081,6 +1128,18 @@ begin
   simpa only [Union, supr_subtype'] using h
 end
 
+lemma image_Inter {f : α → β} (hf : bijective f) (s : ι → set α) :
+  f '' (⋂ i, s i) = ⋂ i, f '' s i :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { simp_rw [Inter_of_empty, image_univ_of_surjective hf.surjective] },
+  { exact (hf.injective.inj_on _).image_Inter_eq }
+end
+
+lemma image_Inter₂ {f : α → β} (hf : bijective f) (s : Π i, κ i → set α) :
+  f '' (⋂ i j, s i j) = ⋂ i j, f '' s i j :=
+by simp_rw image_Inter hf
+
 lemma inj_on_Union_of_directed {s : ι → set α} (hs : directed (⊆) s)
   {f : α → β} (hf : ∀ i, inj_on f (s i)) :
   inj_on f (⋃ i, s i) :=
@@ -1237,12 +1296,6 @@ end preimage
 
 section prod
 
-theorem monotone_prod [preorder α] {f : α → set β} {g : α → set γ}
-  (hf : monotone f) (hg : monotone g) : monotone (λ x, f x ×ˢ g x) :=
-λ a b h, prod_mono (hf h) (hg h)
-
-alias monotone_prod ← monotone.set_prod
-
 lemma prod_Union {s : set α} {t : ι → set β} : s ×ˢ (⋃ i, t i) = ⋃ i, s ×ˢ (t i) := by { ext, simp }
 
 lemma prod_Union₂ {s : set α} {t : Π i, κ i → set β} : s ×ˢ (⋃ i j, t i j) = ⋃ i j, s ×ˢ t i j :=
@@ -1274,8 +1327,34 @@ begin
   { intros x hz x' hw, exact ⟨x ⊔ x', hs le_sup_left hz, ht le_sup_right hw⟩ }
 end
 
-end prod
+lemma sInter_prod_sInter_subset (S : set (set α)) (T : set (set β)) :
+  ⋂₀ S ×ˢ ⋂₀ T ⊆ ⋂ r ∈ S ×ˢ T, r.1 ×ˢ r.2 :=
+subset_Inter₂ (λ x hx y hy, ⟨hy.1 x.1 hx.1, hy.2 x.2 hx.2⟩)
 
+lemma sInter_prod_sInter {S : set (set α)} {T : set (set β)} (hS : S.nonempty) (hT : T.nonempty) :
+  ⋂₀ S ×ˢ ⋂₀ T = ⋂ r ∈ S ×ˢ T, r.1 ×ˢ r.2 :=
+begin
+  obtain ⟨s₁, h₁⟩ := hS,
+  obtain ⟨s₂, h₂⟩ := hT,
+  refine set.subset.antisymm (sInter_prod_sInter_subset S T) (λ x hx, _),
+  rw mem_Inter₂ at hx,
+  exact ⟨λ s₀ h₀, (hx (s₀, s₂) ⟨h₀, h₂⟩).1, λ s₀ h₀, (hx (s₁, s₀) ⟨h₁, h₀⟩).2⟩,
+end
+
+lemma sInter_prod {S : set (set α)} (hS : S.nonempty) (t : set β) :
+  ⋂₀ S ×ˢ t = ⋂ s ∈ S, s ×ˢ t :=
+begin
+  rw [←sInter_singleton t, sInter_prod_sInter hS (singleton_nonempty t), sInter_singleton],
+  simp_rw [prod_singleton, mem_image, Inter_exists, bInter_and', Inter_Inter_eq_right],
+end
+
+lemma prod_sInter {T : set (set β)} (hT : T.nonempty) (s : set α) :
+  s ×ˢ ⋂₀ T = ⋂ t ∈ T, s ×ˢ t :=
+begin
+  rw [←sInter_singleton s, sInter_prod_sInter (singleton_nonempty s) hT, sInter_singleton],
+  simp_rw [singleton_prod, mem_image, Inter_exists, bInter_and', Inter_Inter_eq_right],
+end
+end prod
 
 section image2
 
@@ -1320,6 +1399,16 @@ lemma image2_Inter₂_subset_right (s : set α) (t : Π i, κ i → set β) :
   image2 f s (⋂ i j, t i j) ⊆ ⋂ i j, image2 f s (t i j) :=
 by { simp_rw [image2_subset_iff, mem_Inter], exact λ x hx y hy i j, mem_image2_of_mem hx (hy _ _) }
 
+/-- The `set.image2` version of `set.image_eq_Union` -/
+lemma image2_eq_Union (s : set α) (t : set β) : image2 f s t = ⋃ (i ∈ s) (j ∈ t), {f i j} :=
+by simp_rw [←image_eq_Union, Union_image_left]
+
+lemma prod_eq_bUnion_left : s ×ˢ t = ⋃ a ∈ s, (λ b, (a, b)) '' t :=
+by rw [Union_image_left, image2_mk_eq_prod]
+
+lemma prod_eq_bUnion_right : s ×ˢ t = ⋃ b ∈ t, (λ a, (a, b)) '' s :=
+by rw [Union_image_right, image2_mk_eq_prod]
+
 end image2
 
 section seq
@@ -1432,87 +1521,10 @@ We define some lemmas in the `disjoint` namespace to be able to use projection n
 
 section disjoint
 
-variables {s t u : set α}
-
-namespace disjoint
-
-theorem union_left (hs : disjoint s u) (ht : disjoint t u) : disjoint (s ∪ t) u :=
-hs.sup_left ht
-
-theorem union_right (ht : disjoint s t) (hu : disjoint s u) : disjoint s (t ∪ u) :=
-ht.sup_right hu
-
-lemma inter_left (u : set α) (h : disjoint s t) : disjoint (s ∩ u) t :=
-inf_left _ h
-
-lemma inter_left' (u : set α) (h : disjoint s t) : disjoint (u ∩ s) t :=
-inf_left' _ h
-
-lemma inter_right (u : set α) (h : disjoint s t) : disjoint s (t ∩ u) :=
-inf_right _ h
-
-lemma inter_right' (u : set α) (h : disjoint s t) : disjoint s (u ∩ t) :=
-inf_right' _ h
-
-lemma subset_left_of_subset_union (h : s ⊆ t ∪ u) (hac : disjoint s u) : s ⊆ t :=
-hac.left_le_of_le_sup_right h
-
-lemma subset_right_of_subset_union (h : s ⊆ t ∪ u) (hab : disjoint s t) : s ⊆ u :=
-hab.left_le_of_le_sup_left h
-
-lemma preimage {α β} (f : α → β) {s t : set β} (h : disjoint s t) : disjoint (f ⁻¹' s) (f ⁻¹' t) :=
-λ x hx, h hx
-
-end disjoint
+variables {s t u : set α} {f : α → β}
 
 namespace set
 
-protected theorem disjoint_iff : disjoint s t ↔ s ∩ t ⊆ ∅ := iff.rfl
-
-theorem disjoint_iff_inter_eq_empty : disjoint s t ↔ s ∩ t = ∅ :=
-disjoint_iff
-
-lemma not_disjoint_iff : ¬disjoint s t ↔ ∃ x, x ∈ s ∧ x ∈ t :=
-not_forall.trans $ exists_congr $ λ x, not_not
-
-lemma not_disjoint_iff_nonempty_inter : ¬disjoint s t ↔ (s ∩ t).nonempty :=
-by simp [set.not_disjoint_iff, set.nonempty_def]
-
-alias not_disjoint_iff_nonempty_inter ↔ _ set.nonempty.not_disjoint
-
-lemma disjoint_or_nonempty_inter (s t : set α) : disjoint s t ∨ (s ∩ t).nonempty :=
-(em _).imp_right not_disjoint_iff_nonempty_inter.mp
-
-lemma disjoint_left : disjoint s t ↔ ∀ {a}, a ∈ s → a ∉ t :=
-show (∀ x, ¬(x ∈ s ∩ t)) ↔ _, from ⟨λ h a, not_and.1 $ h a, λ h a, not_and.2 $ h a⟩
-
-theorem disjoint_right : disjoint s t ↔ ∀ {a}, a ∈ t → a ∉ s :=
-by rw [disjoint.comm, disjoint_left]
-
-lemma disjoint_iff_forall_ne : disjoint s t ↔ ∀ (x ∈ s) (y ∈ t), x ≠ y :=
-by simp only [ne.def, disjoint_left, @imp_not_comm _ (_ = _), forall_eq']
-
-lemma _root_.disjoint.ne_of_mem (h : disjoint s t) {x y} (hx : x ∈ s) (hy : y ∈ t) : x ≠ y :=
-disjoint_iff_forall_ne.mp h x hx y hy
-
-theorem disjoint_of_subset_left (h : s ⊆ u) (d : disjoint u t) : disjoint s t :=
-d.mono_left h
-
-theorem disjoint_of_subset_right (h : t ⊆ u) (d : disjoint s u) : disjoint s t :=
-d.mono_right h
-
-theorem disjoint_of_subset {s t u v : set α} (h1 : s ⊆ u) (h2 : t ⊆ v) (d : disjoint u v) :
-  disjoint s t :=
-d.mono h1 h2
-
-@[simp] theorem disjoint_union_left :
-  disjoint (s ∪ t) u ↔ disjoint s u ∧ disjoint t u :=
-disjoint_sup_left
-
-@[simp] theorem disjoint_union_right :
-  disjoint s (t ∪ u) ↔ disjoint s t ∧ disjoint s u :=
-disjoint_sup_right
-
 @[simp] theorem disjoint_Union_left {ι : Sort*} {s : ι → set α} :
   disjoint (⋃ i, s i) t ↔ ∀ i, disjoint (s i) t :=
 supr_disjoint_iff
@@ -1521,68 +1533,21 @@ supr_disjoint_iff
   disjoint t (⋃ i, s i) ↔ ∀ i, disjoint t (s i) :=
 disjoint_supr_iff
 
-theorem disjoint_diff {a b : set α} : disjoint a (b \ a) :=
-disjoint_iff.2 (inter_diff_self _ _)
-
-@[simp] theorem disjoint_empty (s : set α) : disjoint s ∅ := disjoint_bot_right
-
-@[simp] theorem empty_disjoint (s : set α) : disjoint ∅ s := disjoint_bot_left
-
-@[simp] lemma univ_disjoint {s : set α} : disjoint univ s ↔ s = ∅ :=
-top_disjoint
-
-@[simp] lemma disjoint_univ {s : set α} : disjoint s univ ↔ s = ∅ :=
-disjoint_top
-
-@[simp] theorem disjoint_singleton_left {a : α} {s : set α} : disjoint {a} s ↔ a ∉ s :=
-by simp [set.disjoint_iff, subset_def]; exact iff.rfl
-
-@[simp] theorem disjoint_singleton_right {a : α} {s : set α} : disjoint s {a} ↔ a ∉ s :=
-by rw [disjoint.comm]; exact disjoint_singleton_left
-
-@[simp] lemma disjoint_singleton {a b : α} : disjoint ({a} : set α) {b} ↔ a ≠ b :=
-by rw [disjoint_singleton_left, mem_singleton_iff]
+@[simp] lemma disjoint_Union₂_left {s : Π i, κ i → set α} {t : set α} :
+  disjoint (⋃ i j, s i j) t ↔ ∀ i j, disjoint (s i j) t :=
+supr₂_disjoint_iff
 
-theorem disjoint_image_image {f : β → α} {g : γ → α} {s : set β} {t : set γ}
-  (h : ∀ b ∈ s, ∀ c ∈ t, f b ≠ g c) : disjoint (f '' s) (g '' t) :=
-by rintro a ⟨⟨b, hb, eq⟩, c, hc, rfl⟩; exact h b hb c hc eq
+@[simp] lemma disjoint_Union₂_right {s : set α} {t : Π i, κ i → set α} :
+  disjoint s (⋃ i j, t i j) ↔ ∀ i j, disjoint s (t i j) :=
+disjoint_supr₂_iff
 
-lemma disjoint_image_of_injective {f : α → β} (hf : injective f) {s t : set α}
-  (hd : disjoint s t) : disjoint (f '' s) (f '' t) :=
-disjoint_image_image $ λ x hx y hy, hf.ne $ λ H, set.disjoint_iff.1 hd ⟨hx, H.symm ▸ hy⟩
+@[simp] lemma disjoint_sUnion_left {S : set (set α)} {t : set α} :
+  disjoint (⋃₀ S) t ↔ ∀ s ∈ S, disjoint s t :=
+Sup_disjoint_iff
 
-lemma disjoint_preimage {s t : set β} (hd : disjoint s t) (f : α → β) :
-  disjoint (f ⁻¹' s) (f ⁻¹' t) :=
-λ x hx, hd hx
-
-lemma preimage_eq_empty {f : α → β} {s : set β} (h : disjoint s (range f)) :
-  f ⁻¹' s = ∅ :=
-by simpa using h.preimage f
-
-lemma preimage_eq_empty_iff {f : α → β} {s : set β} : disjoint s (range f) ↔ f ⁻¹' s = ∅ :=
-⟨preimage_eq_empty,
-  λ h, begin
-    simp only [eq_empty_iff_forall_not_mem, disjoint_iff_inter_eq_empty, not_exists,
-      mem_inter_eq, not_and, mem_range, mem_preimage] at h ⊢,
-    assume y hy x hx,
-    rw ← hx at hy,
-    exact h x hy,
-  end ⟩
-
-lemma disjoint_iff_subset_compl_right :
-  disjoint s t ↔ s ⊆ tᶜ :=
-disjoint_left
-
-lemma disjoint_iff_subset_compl_left :
-  disjoint s t ↔ t ⊆ sᶜ :=
-disjoint_right
-
-lemma _root_.disjoint.image {s t u : set α} {f : α → β} (h : disjoint s t) (hf : inj_on f u)
-  (hs : s ⊆ u) (ht : t ⊆ u) : disjoint (f '' s) (f '' t) :=
-begin
-  rw disjoint_iff_inter_eq_empty at h ⊢,
-  rw [← hf.image_inter hs ht, h, image_empty],
-end
+@[simp] lemma disjoint_sUnion_right {s : set α} {S : set (set α)} :
+  disjoint s (⋃₀ S) ↔ ∀ t ∈ S, disjoint s t :=
+disjoint_Sup_iff
 
 end set
 
@@ -1610,10 +1575,6 @@ end set
 namespace set
 variables (t : α → set β)
 
-lemma subset_diff {s t u : set α} : s ⊆ t \ u ↔ s ⊆ t ∧ disjoint s u :=
-⟨λ h, ⟨λ x hxs, (h hxs).1, λ x ⟨hxs, hxu⟩, (h hxs).2 hxu⟩,
-λ ⟨h1, h2⟩ x hxs, ⟨h1 hxs, λ hxu, h2 ⟨hxs, hxu⟩⟩⟩
-
 lemma bUnion_diff_bUnion_subset (s₁ s₂ : set α) :
   (⋃ x ∈ s₁, t x) \ (⋃ x ∈ s₂, t x) ⊆ (⋃ x ∈ s₁ \ s₂, t x) :=
 begin
@@ -1636,7 +1597,7 @@ lemma sigma_to_Union_injective (h : ∀ i j, i ≠ j → disjoint (t i) (t j)) :
   have b_eq : b₁ = b₂, from congr_arg subtype.val eq,
   have a_eq : a₁ = a₂, from classical.by_contradiction $ λ ne,
     have b₁ ∈ t a₁ ∩ t a₂, from ⟨h₁, b_eq.symm ▸ h₂⟩,
-    h _ _ ne this,
+    (h _ _ ne).le_bot this,
   sigma.eq a_eq $ subtype.eq $ by subst b_eq; subst a_eq
 
 lemma sigma_to_Union_bijective (h : ∀ i j, i ≠ j → disjoint (t i) (t j)) :
@@ -1648,6 +1609,30 @@ noncomputable def Union_eq_sigma_of_disjoint {t : α → set β}
   (h : ∀ i j, i ≠ j → disjoint (t i) (t j)) : (⋃ i, t i) ≃ (Σ i, t i) :=
 (equiv.of_bijective _ $ sigma_to_Union_bijective t h).symm
 
+lemma Union_ge_eq_Union_nat_add (u : ℕ → set α) (n : ℕ) : (⋃ i ≥ n, u i) = ⋃ i, u (i + n) :=
+supr_ge_eq_supr_nat_add u n
+
+lemma Inter_ge_eq_Inter_nat_add (u : ℕ → set α) (n : ℕ) : (⋂ i ≥ n, u i) = ⋂ i, u (i + n) :=
+infi_ge_eq_infi_nat_add u n
+
+lemma _root_.monotone.Union_nat_add {f : ℕ → set α} (hf : monotone f) (k : ℕ) :
+  (⋃ n, f (n + k)) = ⋃ n, f n :=
+hf.supr_nat_add k
+
+lemma _root_.antitone.Inter_nat_add {f : ℕ → set α} (hf : antitone f) (k : ℕ) :
+  (⋂ n, f (n + k)) = ⋂ n, f n :=
+hf.infi_nat_add k
+
+@[simp] lemma Union_Inter_ge_nat_add (f : ℕ → set α) (k : ℕ) :
+  (⋃ n, ⋂ i ≥ n, f (i + k)) = ⋃ n, ⋂ i ≥ n, f i :=
+supr_infi_ge_nat_add f k
+
+lemma union_Union_nat_succ (u : ℕ → set α) : u 0 ∪ (⋃ i, u (i + 1)) = ⋃ i, u i :=
+sup_supr_nat_succ u
+
+lemma inter_Inter_nat_succ (u : ℕ → set α) : u 0 ∩ (⋂ i, u (i + 1)) = ⋂ i, u i :=
+inf_infi_nat_succ u
+
 end set
 
 open set
@@ -1658,4 +1643,9 @@ lemma supr_Union (s : ι → set α) (f : α → β) : (⨆ a ∈ (⋃ i, s i),
 by { rw supr_comm, simp_rw [mem_Union, supr_exists] }
 
 lemma infi_Union (s : ι → set α) (f : α → β) : (⨅ a ∈ (⋃ i, s i), f a) = ⨅ i (a ∈ s i), f a :=
-by { rw infi_comm, simp_rw [mem_Union, infi_exists] }
+@supr_Union α βᵒᵈ _ _ s f
+
+lemma Sup_sUnion (s : set (set β)) : Sup (⋃₀ s) = ⨆ t ∈ s, Sup t :=
+by simp only [sUnion_eq_bUnion, Sup_eq_supr, supr_Union]
+
+lemma Inf_sUnion (s : set (set β)) : Inf (⋃₀ s) = ⨅ t ∈ s, Inf t := @Sup_sUnion βᵒᵈ _ _
diff --git a/src/data/set/list.lean b/src/data/set/list.lean
new file mode 100644
index 0000000000000..afca35ed9df53
--- /dev/null
+++ b/src/data/set/list.lean
@@ -0,0 +1,72 @@
+/-
+Copyright (c) 2023 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import data.set.image
+import data.list.basic
+import data.fin.basic
+
+/-!
+# Lemmas about `list`s and `set.range`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove lemmas about range of some operations on lists.
+-/
+
+open list
+variables {α β : Type*} (l : list α)
+
+namespace set
+
+lemma range_list_map (f : α → β) : range (map f) = {l | ∀ x ∈ l, x ∈ range f} :=
+begin
+  refine subset.antisymm (range_subset_iff.2 $ λ l, forall_mem_map_iff.2 $ λ y _, mem_range_self _)
+    (λ l hl, _),
+  induction l with a l ihl, { exact ⟨[], rfl⟩ },
+  rcases ihl (λ x hx, hl x $ subset_cons _ _ hx) with ⟨l, rfl⟩,
+  rcases hl a (mem_cons_self _ _) with ⟨a, rfl⟩,
+  exact ⟨a :: l, map_cons _ _ _⟩
+end
+
+lemma range_list_map_coe (s : set α) : range (map (coe : s → α)) = {l | ∀ x ∈ l, x ∈ s} :=
+by rw [range_list_map, subtype.range_coe]
+
+@[simp] lemma range_list_nth_le : range (λ k : fin l.length, l.nth_le k k.2) = {x | x ∈ l} :=
+begin
+  ext x,
+  rw [mem_set_of_eq, mem_iff_nth_le],
+  exact ⟨λ ⟨⟨n, h₁⟩, h₂⟩, ⟨n, h₁, h₂⟩, λ ⟨n, h₁, h₂⟩, ⟨⟨n, h₁⟩, h₂⟩⟩
+end
+
+lemma range_list_nth : range l.nth = insert none (some '' {x | x ∈ l}) :=
+begin
+  rw [← range_list_nth_le, ← range_comp],
+  refine (range_subset_iff.2 $ λ n, _).antisymm (insert_subset.2 ⟨_, _⟩),
+  exacts [(le_or_lt l.length n).imp nth_eq_none_iff.2 (λ hlt, ⟨⟨_, _⟩, (nth_le_nth hlt).symm⟩),
+    ⟨_, nth_eq_none_iff.2 le_rfl⟩, range_subset_iff.2 $ λ k, ⟨_, nth_le_nth _⟩]
+end
+
+@[simp] lemma range_list_nthd (d : α) : range (λ n, l.nthd n d) = insert d {x | x ∈ l} :=
+calc range (λ n, l.nthd n d) = (λ o : option α, o.get_or_else d) '' range l.nth :
+  by simp only [← range_comp, (∘), nthd_eq_get_or_else_nth]
+... = insert d {x | x ∈ l} :
+  by simp only [range_list_nth, image_insert_eq, option.get_or_else, image_image, image_id']
+
+@[simp]
+lemma range_list_inth [inhabited α] (l : list α) : range l.inth = insert default {x | x ∈ l} :=
+range_list_nthd l default
+
+end set
+
+/-- If each element of a list can be lifted to some type, then the whole list can be lifted to this
+type. -/
+instance list.can_lift (c) (p) [can_lift α β c p] :
+  can_lift (list α) (list β) (list.map c) (λ l, ∀ x ∈ l, p x) :=
+{ prf  := λ l H,
+    begin
+      rw [← set.mem_range, set.range_list_map],
+      exact λ a ha, can_lift.prf a (H a ha),
+    end}
diff --git a/src/data/set/mul_antidiagonal.lean b/src/data/set/mul_antidiagonal.lean
new file mode 100644
index 0000000000000..49f259ebfcde6
--- /dev/null
+++ b/src/data/set/mul_antidiagonal.lean
@@ -0,0 +1,99 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Floris van Doorn
+-/
+import order.well_founded_set
+
+/-! # Multiplication antidiagonal 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
+
+namespace set
+variables {α : Type*}
+
+section has_mul
+variables [has_mul α] {s s₁ s₂ t t₁ t₂ : set α} {a : α} {x : α × α}
+
+/-- `set.mul_antidiagonal s t a` is the set of all pairs of an element in `s` and an element in `t`
+that multiply to `a`. -/
+@[to_additive "`set.add_antidiagonal s t a` is the set of all pairs of an element in `s` and an
+element in `t` that add to `a`."]
+def mul_antidiagonal (s t : set α) (a : α) : set (α × α) := {x | x.1 ∈ s ∧ x.2 ∈ t ∧ x.1 * x.2 = a}
+
+@[simp, to_additive]
+lemma mem_mul_antidiagonal : x ∈ mul_antidiagonal s t a ↔ x.1 ∈ s ∧ x.2 ∈ t ∧ x.1 * x.2 = a :=
+iff.rfl
+
+@[to_additive] lemma mul_antidiagonal_mono_left (h : s₁ ⊆ s₂) :
+  mul_antidiagonal s₁ t a ⊆ mul_antidiagonal s₂ t a :=
+λ x hx, ⟨h hx.1, hx.2.1, hx.2.2⟩
+
+@[to_additive] lemma mul_antidiagonal_mono_right (h : t₁ ⊆ t₂) :
+  mul_antidiagonal s t₁ a ⊆ mul_antidiagonal s t₂ a :=
+λ x hx, ⟨hx.1, h hx.2.1, hx.2.2⟩
+
+end has_mul
+
+@[simp, to_additive] lemma swap_mem_mul_antidiagonal [comm_semigroup α] {s t : set α} {a : α}
+  {x : α × α} :
+  x.swap ∈ set.mul_antidiagonal s t a ↔ x ∈ set.mul_antidiagonal t s a :=
+by simp [mul_comm, and.left_comm]
+
+namespace mul_antidiagonal
+
+section cancel_comm_monoid
+variables [cancel_comm_monoid α] {s t : set α} {a : α} {x y : mul_antidiagonal s t a}
+
+@[to_additive]
+lemma fst_eq_fst_iff_snd_eq_snd : (x : α × α).1 = (y : α × α).1 ↔ (x : α × α).2 = (y : α × α).2 :=
+⟨λ h, mul_left_cancel (y.prop.2.2.trans $ by { rw ←h, exact x.2.2.2.symm }).symm,
+  λ h, mul_right_cancel (y.prop.2.2.trans $ by { rw ←h, exact x.2.2.2.symm }).symm⟩
+
+@[to_additive] lemma eq_of_fst_eq_fst (h : (x : α × α).fst = (y : α × α).fst) : x = y :=
+subtype.ext $ prod.ext h $ fst_eq_fst_iff_snd_eq_snd.1 h
+
+@[to_additive] lemma eq_of_snd_eq_snd (h : (x : α × α).snd = (y : α × α).snd) : x = y :=
+subtype.ext $ prod.ext (fst_eq_fst_iff_snd_eq_snd.2 h) h
+
+end cancel_comm_monoid
+
+section ordered_cancel_comm_monoid
+variables [ordered_cancel_comm_monoid α] (s t : set α) (a : α) {x y : mul_antidiagonal s t a}
+
+@[to_additive]
+lemma eq_of_fst_le_fst_of_snd_le_snd (h₁ : (x : α × α).1 ≤ (y : α × α).1)
+  (h₂ : (x : α × α).2 ≤ (y : α × α).2) :
+  x = y :=
+eq_of_fst_eq_fst $ h₁.eq_of_not_lt $ λ hlt, (mul_lt_mul_of_lt_of_le hlt h₂).ne $
+  (mem_mul_antidiagonal.1 x.2).2.2.trans (mem_mul_antidiagonal.1 y.2).2.2.symm
+
+variables {s t}
+
+@[to_additive]
+lemma finite_of_is_pwo (hs : s.is_pwo) (ht : t.is_pwo) (a) : (mul_antidiagonal s t a).finite :=
+begin
+  refine not_infinite.1 (λ h, _),
+  have h1 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.fst ⁻¹'o (≤)),
+    from λ f hf, hs (prod.fst ∘ f) (λ n, (mem_mul_antidiagonal.1 (hf n)).1),
+  have h2 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.snd ⁻¹'o (≤)),
+    from λ f hf, ht (prod.snd ∘ f) (λ n, (mem_mul_antidiagonal.1 (hf n)).2.1),
+  obtain ⟨g, hg⟩ := h1.exists_monotone_subseq (λ n, h.nat_embedding _ n)
+    (λ n, (h.nat_embedding _ n).2),
+  obtain ⟨m, n, mn, h2'⟩ := h2 (λ x, (h.nat_embedding _) (g x)) (λ n, (h.nat_embedding _ _).2),
+  refine mn.ne (g.injective $ (h.nat_embedding _).injective _),
+  exact eq_of_fst_le_fst_of_snd_le_snd _ _ _ (hg _ _ mn.le) h2',
+end
+
+end ordered_cancel_comm_monoid
+
+@[to_additive]
+lemma finite_of_is_wf [linear_ordered_cancel_comm_monoid α] {s t : set α} (hs : s.is_wf)
+  (ht : t.is_wf) (a) :
+  (mul_antidiagonal s t a).finite :=
+finite_of_is_pwo hs.is_pwo ht.is_pwo a
+
+end mul_antidiagonal
+
+end set
diff --git a/src/data/set/n_ary.lean b/src/data/set/n_ary.lean
new file mode 100644
index 0000000000000..0ebf7b6ec2f87
--- /dev/null
+++ b/src/data/set/n_ary.lean
@@ -0,0 +1,366 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import data.set.prod
+
+/-!
+# N-ary images of sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `finset.image₂`, the binary image of finsets. This is the finset version of
+`set.image2`. This is mostly useful to define pointwise operations.
+
+## Notes
+
+This file is very similar to the n-ary section of `data.set.basic`, to `order.filter.n_ary` and to
+`data.option.n_ary`. Please keep them in sync.
+
+We do not define `finset.image₃` as its only purpose would be to prove properties of `finset.image₂`
+and `set.image2` already fulfills this task.
+-/
+
+open function
+
+namespace set
+variables {α α' β β' γ γ' δ δ' ε ε' ζ ζ' ν : Type*} {f f' : α → β → γ} {g g' : α → β → γ → δ}
+variables {s s' : set α} {t t' : set β} {u u' : set γ} {v : set δ} {a a' : α} {b b' : β} {c c' : γ}
+  {d d' : δ}
+
+
+/-- The image of a binary function `f : α → β → γ` as a function `set α → set β → set γ`.
+Mathematically this should be thought of as the image of the corresponding function `α × β → γ`.-/
+def image2 (f : α → β → γ) (s : set α) (t : set β) : set γ :=
+{c | ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c }
+
+@[simp] lemma mem_image2 : c ∈ image2 f s t ↔ ∃ a b, a ∈ s ∧ b ∈ t ∧ f a b = c := iff.rfl
+
+lemma mem_image2_of_mem (ha : a ∈ s) (hb : b ∈ t) : f a b ∈ image2 f s t := ⟨a, b, ha, hb, rfl⟩
+
+lemma mem_image2_iff (hf : injective2 f) : f a b ∈ image2 f s t ↔ a ∈ s ∧ b ∈ t :=
+⟨ by { rintro ⟨a', b', ha', hb', h⟩, rcases hf h with ⟨rfl, rfl⟩, exact ⟨ha', hb'⟩ },
+  λ ⟨ha, hb⟩, mem_image2_of_mem ha hb⟩
+
+/-- image2 is monotone with respect to `⊆`. -/
+lemma image2_subset (hs : s ⊆ s') (ht : t ⊆ t') : image2 f s t ⊆ image2 f s' t' :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_image2_of_mem (hs ha) (ht hb) }
+
+lemma image2_subset_left (ht : t ⊆ t') : image2 f s t ⊆ image2 f s t' := image2_subset subset.rfl ht
+
+lemma image2_subset_right (hs : s ⊆ s') : image2 f s t ⊆ image2 f s' t :=
+image2_subset hs subset.rfl
+
+lemma image_subset_image2_left (hb : b ∈ t) : (λ a, f a b) '' s ⊆ image2 f s t :=
+ball_image_of_ball $ λ a ha, mem_image2_of_mem ha hb
+
+lemma image_subset_image2_right (ha : a ∈ s) : f a '' t ⊆ image2 f s t :=
+ball_image_of_ball $ λ b, mem_image2_of_mem ha
+
+lemma forall_image2_iff {p : γ → Prop} :
+  (∀ z ∈ image2 f s t, p z) ↔ ∀ (x ∈ s) (y ∈ t), p (f x y) :=
+⟨λ h x hx y hy, h _ ⟨x, y, hx, hy, rfl⟩, λ h z ⟨x, y, hx, hy, hz⟩, hz ▸ h x hx y hy⟩
+
+@[simp] lemma image2_subset_iff {u : set γ} :
+  image2 f s t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), f x y ∈ u :=
+forall_image2_iff
+
+lemma image2_subset_iff_left : image2 f s t ⊆ u ↔ ∀ a ∈ s, (λ b, f a b) '' t ⊆ u :=
+by simp_rw [image2_subset_iff, image_subset_iff, subset_def, mem_preimage]
+
+lemma image2_subset_iff_right : image2 f s t ⊆ u ↔ ∀ b ∈ t, (λ a, f a b) '' s ⊆ u :=
+by simp_rw [image2_subset_iff, image_subset_iff, subset_def, mem_preimage, @forall₂_swap α]
+
+variables (f)
+
+@[simp] lemma image_prod : (λ x : α × β, f x.1 x.2) '' s ×ˢ t = image2 f s t :=
+ext $ λ a,
+⟨ by { rintro ⟨_, _, rfl⟩, exact ⟨_, _, (mem_prod.1 ‹_›).1, (mem_prod.1 ‹_›).2, rfl⟩ },
+  by { rintro ⟨_, _, _, _, rfl⟩, exact ⟨(_, _), ⟨‹_›, ‹_›⟩, rfl⟩ }⟩
+
+@[simp] lemma image_uncurry_prod (s : set α) (t : set β) : uncurry f '' s ×ˢ t = image2 f s t :=
+image_prod _
+
+@[simp] lemma image2_mk_eq_prod : image2 prod.mk s t = s ×ˢ t := ext $ by simp
+
+@[simp] lemma image2_curry (f : α × β → γ) (s : set α) (t : set β) :
+  image2 (λ a b, f (a, b)) s t = f '' s ×ˢ t :=
+by simp [←image_uncurry_prod, uncurry]
+
+lemma image2_swap (s : set α) (t : set β) : image2 f s t = image2 (λ a b, f b a) t s :=
+by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨b, a, hb, ha, rfl⟩ }
+
+variables {f}
+
+lemma image2_union_left : image2 f (s ∪ s') t = image2 f s t ∪ image2 f s' t :=
+begin
+  ext c,
+  split,
+  { rintro ⟨a, b, ha | ha, hb, rfl⟩; [left, right]; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ },
+  { rintro (⟨_, _, _, _, rfl⟩|⟨_, _, _, _, rfl⟩); refine ⟨_, _, _, ‹_›, rfl⟩;
+    simp [mem_union, *] }
+end
+
+lemma image2_union_right : image2 f s (t ∪ t') = image2 f s t ∪ image2 f s t' :=
+by rw [←image2_swap, image2_union_left, image2_swap f, image2_swap f]
+
+lemma image2_inter_left (hf : injective2 f) : image2 f (s ∩ s') t = image2 f s t ∩ image2 f s' t :=
+by simp_rw [←image_uncurry_prod, inter_prod, image_inter hf.uncurry]
+
+lemma image2_inter_right (hf : injective2 f) : image2 f s (t ∩ t') = image2 f s t ∩ image2 f s t' :=
+by simp_rw [←image_uncurry_prod, prod_inter, image_inter hf.uncurry]
+
+@[simp] lemma image2_empty_left : image2 f ∅ t = ∅ := ext $ by simp
+@[simp] lemma image2_empty_right : image2 f s ∅ = ∅ := ext $ by simp
+
+lemma nonempty.image2 : s.nonempty → t.nonempty → (image2 f s t).nonempty :=
+λ ⟨a, ha⟩ ⟨b, hb⟩, ⟨_, mem_image2_of_mem ha hb⟩
+
+@[simp] lemma image2_nonempty_iff : (image2 f s t).nonempty ↔ s.nonempty ∧ t.nonempty :=
+⟨λ ⟨_, a, b, ha, hb, _⟩, ⟨⟨a, ha⟩, b, hb⟩, λ h, h.1.image2 h.2⟩
+
+lemma nonempty.of_image2_left (h : (image2 f s t).nonempty) : s.nonempty :=
+(image2_nonempty_iff.1 h).1
+
+lemma nonempty.of_image2_right (h : (image2 f s t).nonempty) : t.nonempty :=
+(image2_nonempty_iff.1 h).2
+
+@[simp] lemma image2_eq_empty_iff : image2 f s t = ∅ ↔ s = ∅ ∨ t = ∅ :=
+by simp_rw [←not_nonempty_iff_eq_empty, image2_nonempty_iff, not_and_distrib]
+
+lemma image2_inter_subset_left : image2 f (s ∩ s') t ⊆ image2 f s t ∩ image2 f s' t :=
+by { rintro _ ⟨a, b, ⟨h1a, h2a⟩, hb, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
+
+lemma image2_inter_subset_right : image2 f s (t ∩ t') ⊆ image2 f s t ∩ image2 f s t' :=
+by { rintro _ ⟨a, b, ha, ⟨h1b, h2b⟩, rfl⟩, split; exact ⟨_, _, ‹_›, ‹_›, rfl⟩ }
+
+@[simp] lemma image2_singleton_left : image2 f {a} t = f a '' t := ext $ λ x, by simp
+@[simp] lemma image2_singleton_right : image2 f s {b} = (λ a, f a b) '' s := ext $ λ x, by simp
+
+lemma image2_singleton : image2 f {a} {b} = {f a b} := by simp
+
+@[simp] lemma image2_insert_left : image2 f (insert a s) t = (λ b, f a b) '' t ∪ image2 f s t :=
+by rw [insert_eq, image2_union_left, image2_singleton_left]
+
+@[simp] lemma image2_insert_right : image2 f s (insert b t) = (λ a, f a b) '' s  ∪ image2 f s t :=
+by rw [insert_eq, image2_union_right, image2_singleton_right]
+
+@[congr] lemma image2_congr (h : ∀ (a ∈ s) (b ∈ t), f a b = f' a b) :
+  image2 f s t = image2 f' s t :=
+by { ext, split; rintro ⟨a, b, ha, hb, rfl⟩; refine ⟨a, b, ha, hb, by rw h a ha b hb⟩ }
+
+/-- A common special case of `image2_congr` -/
+lemma image2_congr' (h : ∀ a b, f a b = f' a b) : image2 f s t = image2 f' s t :=
+image2_congr (λ a _ b _, h a b)
+
+/-- The image of a ternary function `f : α → β → γ → δ` as a function
+  `set α → set β → set γ → set δ`. Mathematically this should be thought of as the image of the
+  corresponding function `α × β × γ → δ`.
+-/
+def image3 (g : α → β → γ → δ) (s : set α) (t : set β) (u : set γ) : set δ :=
+{d | ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d }
+
+@[simp] lemma mem_image3 : d ∈ image3 g s t u ↔ ∃ a b c, a ∈ s ∧ b ∈ t ∧ c ∈ u ∧ g a b c = d :=
+iff.rfl
+
+lemma image3_mono (hs : s ⊆ s') (ht : t ⊆ t') (hu : u ⊆ u') : image3 g s t u ⊆ image3 g s' t' u' :=
+λ x, Exists₃.imp $ λ a b c ⟨ha, hb, hc, hx⟩, ⟨hs ha, ht hb, hu hc, hx⟩
+
+@[congr] lemma image3_congr (h : ∀ (a ∈ s) (b ∈ t) (c ∈ u), g a b c = g' a b c) :
+  image3 g s t u = image3 g' s t u :=
+by { ext x,
+     split; rintro ⟨a, b, c, ha, hb, hc, rfl⟩; exact ⟨a, b, c, ha, hb, hc, by rw h a ha b hb c hc⟩ }
+
+/-- A common special case of `image3_congr` -/
+lemma image3_congr' (h : ∀ a b c, g a b c = g' a b c) : image3 g s t u = image3 g' s t u :=
+image3_congr (λ a _ b _ c _, h a b c)
+
+lemma image2_image2_left (f : δ → γ → ε) (g : α → β → δ) :
+  image2 f (image2 g s t) u = image3 (λ a b c, f (g a b) c) s t u :=
+begin
+  ext, split,
+  { rintro ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
+  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩ }
+end
+
+lemma image2_image2_right (f : α → δ → ε) (g : β → γ → δ) :
+  image2 f s (image2 g t u) = image3 (λ a b c, f a (g b c)) s t u :=
+begin
+  ext, split,
+  { rintro ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩, refine ⟨a, b, c, ha, hb, hc, rfl⟩ },
+  { rintro ⟨a, b, c, ha, hb, hc, rfl⟩, refine ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩ }
+end
+
+lemma image_image2 (f : α → β → γ) (g : γ → δ) :
+  g '' image2 f s t = image2 (λ a b, g (f a b)) s t :=
+begin
+  ext, split,
+  { rintro ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
+  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, ⟨a, b, ha, hb, rfl⟩, rfl⟩ }
+end
+
+lemma image2_image_left (f : γ → β → δ) (g : α → γ) :
+  image2 f (g '' s) t = image2 (λ a b, f (g a) b) s t :=
+begin
+  ext, split,
+  { rintro ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
+  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨_, b, ⟨a, ha, rfl⟩, hb, rfl⟩ }
+end
+
+lemma image2_image_right (f : α → γ → δ) (g : β → γ) :
+  image2 f s (g '' t) = image2 (λ a b, f a (g b)) s t :=
+begin
+  ext, split,
+  { rintro ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩, refine ⟨a, b, ha, hb, rfl⟩ },
+  { rintro ⟨a, b, ha, hb, rfl⟩, refine ⟨a, _, ha, ⟨b, hb, rfl⟩, rfl⟩ }
+end
+
+@[simp] lemma image2_left (h : t.nonempty) : image2 (λ x y, x) s t = s :=
+by simp [nonempty_def.mp h, ext_iff]
+
+@[simp] lemma image2_right (h : s.nonempty) : image2 (λ x y, y) s t = t :=
+by simp [nonempty_def.mp h, ext_iff]
+
+lemma image2_assoc {f : δ → γ → ε} {g : α → β → δ} {f' : α → ε' → ε} {g' : β → γ → ε'}
+  (h_assoc : ∀ a b c, f (g a b) c = f' a (g' b c)) :
+  image2 f (image2 g s t) u = image2 f' s (image2 g' t u) :=
+by simp only [image2_image2_left, image2_image2_right, h_assoc]
+
+lemma image2_comm {g : β → α → γ} (h_comm : ∀ a b, f a b = g b a) : image2 f s t = image2 g t s :=
+(image2_swap _ _ _).trans $ by simp_rw h_comm
+
+lemma image2_left_comm {f : α → δ → ε} {g : β → γ → δ} {f' : α → γ → δ'} {g' : β → δ' → ε}
+  (h_left_comm : ∀ a b c, f a (g b c) = g' b (f' a c)) :
+  image2 f s (image2 g t u) = image2 g' t (image2 f' s u) :=
+by { rw [image2_swap f', image2_swap f], exact image2_assoc (λ _ _ _, h_left_comm _ _ _) }
+
+lemma image2_right_comm {f : δ → γ → ε} {g : α → β → δ} {f' : α → γ → δ'} {g' : δ' → β → ε}
+  (h_right_comm : ∀ a b c, f (g a b) c = g' (f' a c) b) :
+  image2 f (image2 g s t) u = image2 g' (image2 f' s u) t :=
+by { rw [image2_swap g, image2_swap g'], exact image2_assoc (λ _ _ _, h_right_comm _ _ _) }
+
+lemma image2_image2_image2_comm {f : ε → ζ → ν} {g : α → β → ε} {h : γ → δ → ζ} {f' : ε' → ζ' → ν}
+  {g' : α → γ → ε'} {h' : β → δ → ζ'}
+  (h_comm : ∀ a b c d, f (g a b) (h c d) = f' (g' a c) (h' b d)) :
+  image2 f (image2 g s t) (image2 h u v) = image2 f' (image2 g' s u) (image2 h' t v) :=
+begin
+  ext,
+  split,
+  { rintro ⟨_, _, ⟨a, b, ha, hb, rfl⟩, ⟨c, d, hc, hd, rfl⟩, rfl⟩,
+    exact ⟨_, _, ⟨a, c, ha, hc, rfl⟩, ⟨b, d, hb, hd, rfl⟩, (h_comm _ _ _ _).symm⟩ },
+  { rintro ⟨_, _, ⟨a, c, ha, hc, rfl⟩, ⟨b, d, hb, hd, rfl⟩, rfl⟩,
+    exact ⟨_, _, ⟨a, b, ha, hb, rfl⟩, ⟨c, d, hc, hd, rfl⟩, h_comm _ _ _ _⟩ }
+end
+
+lemma image_image2_distrib {g : γ → δ} {f' : α' → β' → δ} {g₁ : α → α'} {g₂ : β → β'}
+  (h_distrib : ∀ a b, g (f a b) = f' (g₁ a) (g₂ b)) :
+  (image2 f s t).image g = image2 f' (s.image g₁) (t.image g₂) :=
+by simp_rw [image_image2, image2_image_left, image2_image_right, h_distrib]
+
+/-- Symmetric statement to `set.image2_image_left_comm`. -/
+lemma image_image2_distrib_left {g : γ → δ} {f' : α' → β → δ} {g' : α → α'}
+  (h_distrib : ∀ a b, g (f a b) = f' (g' a) b) :
+  (image2 f s t).image g = image2 f' (s.image g') t :=
+(image_image2_distrib h_distrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_right_comm`. -/
+lemma image_image2_distrib_right {g : γ → δ} {f' : α → β' → δ} {g' : β → β'}
+  (h_distrib : ∀ a b, g (f a b) = f' a (g' b)) :
+  (image2 f s t).image g = image2 f' s (t.image g') :=
+(image_image2_distrib h_distrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_distrib_left`. -/
+lemma image2_image_left_comm {f : α' → β → γ} {g : α → α'} {f' : α → β → δ} {g' : δ → γ}
+  (h_left_comm : ∀ a b, f (g a) b = g' (f' a b)) :
+  image2 f (s.image g) t = (image2 f' s t).image g' :=
+(image_image2_distrib_left $ λ a b, (h_left_comm a b).symm).symm
+
+/-- Symmetric statement to `set.image_image2_distrib_right`. -/
+lemma image_image2_right_comm {f : α → β' → γ} {g : β → β'} {f' : α → β → δ} {g' : δ → γ}
+  (h_right_comm : ∀ a b, f a (g b) = g' (f' a b)) :
+  image2 f s (t.image g) = (image2 f' s t).image g' :=
+(image_image2_distrib_right $ λ a b, (h_right_comm a b).symm).symm
+
+/-- The other direction does not hold because of the `s`-`s` cross terms on the RHS. -/
+lemma image2_distrib_subset_left {f : α → δ → ε} {g : β → γ → δ} {f₁ : α → β → β'} {f₂ : α → γ → γ'}
+  {g' : β' → γ' → ε} (h_distrib : ∀ a b c, f a (g b c) = g' (f₁ a b) (f₂ a c)) :
+  image2 f s (image2 g t u) ⊆ image2 g' (image2 f₁ s t) (image2 f₂ s u) :=
+begin
+  rintro _ ⟨a, _, ha, ⟨b, c, hb, hc, rfl⟩, rfl⟩,
+  rw h_distrib,
+  exact mem_image2_of_mem (mem_image2_of_mem ha hb) (mem_image2_of_mem ha hc),
+end
+
+/-- The other direction does not hold because of the `u`-`u` cross terms on the RHS. -/
+lemma image2_distrib_subset_right {f : δ → γ → ε} {g : α → β → δ} {f₁ : α → γ → α'}
+  {f₂ : β → γ → β'} {g' : α' → β' → ε} (h_distrib : ∀ a b c, f (g a b) c = g' (f₁ a c) (f₂ b c)) :
+  image2 f (image2 g s t) u ⊆ image2 g' (image2 f₁ s u) (image2 f₂ t u) :=
+begin
+  rintro _ ⟨_, c, ⟨a, b, ha, hb, rfl⟩, hc, rfl⟩,
+  rw h_distrib,
+  exact mem_image2_of_mem (mem_image2_of_mem ha hc) (mem_image2_of_mem hb hc),
+end
+
+lemma image_image2_antidistrib {g : γ → δ} {f' : β' → α' → δ} {g₁ : β → β'} {g₂ : α → α'}
+  (h_antidistrib : ∀ a b, g (f a b) = f' (g₁ b) (g₂ a)) :
+  (image2 f s t).image g = image2 f' (t.image g₁) (s.image g₂) :=
+by { rw image2_swap f, exact image_image2_distrib (λ _ _, h_antidistrib _ _) }
+
+/-- Symmetric statement to `set.image2_image_left_anticomm`. -/
+lemma image_image2_antidistrib_left {g : γ → δ} {f' : β' → α → δ} {g' : β → β'}
+  (h_antidistrib : ∀ a b, g (f a b) = f' (g' b) a) :
+  (image2 f s t).image g = image2 f' (t.image g') s :=
+(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_right_anticomm`. -/
+lemma image_image2_antidistrib_right {g : γ → δ} {f' : β → α' → δ} {g' : α → α'}
+  (h_antidistrib : ∀ a b, g (f a b) = f' b (g' a)) :
+  (image2 f s t).image g = image2 f' t (s.image g') :=
+(image_image2_antidistrib h_antidistrib).trans $ by rw image_id'
+
+/-- Symmetric statement to `set.image_image2_antidistrib_left`. -/
+lemma image2_image_left_anticomm {f : α' → β → γ} {g : α → α'} {f' : β → α → δ} {g' : δ → γ}
+  (h_left_anticomm : ∀ a b, f (g a) b = g' (f' b a)) :
+  image2 f (s.image g) t = (image2 f' t s).image g' :=
+(image_image2_antidistrib_left $ λ a b, (h_left_anticomm b a).symm).symm
+
+/-- Symmetric statement to `set.image_image2_antidistrib_right`. -/
+lemma image_image2_right_anticomm {f : α → β' → γ} {g : β → β'} {f' : β → α → δ} {g' : δ → γ}
+  (h_right_anticomm : ∀ a b, f a (g b) = g' (f' b a)) :
+  image2 f s (t.image g) = (image2 f' t s).image g' :=
+(image_image2_antidistrib_right $ λ a b, (h_right_anticomm b a).symm).symm
+
+/-- If `a` is a left identity for `f : α → β → β`, then `{a}` is a left identity for
+`set.image2 f`. -/
+lemma image2_left_identity {f : α → β → β} {a : α} (h : ∀ b, f a b = b) (t : set β) :
+  image2 f {a} t = t :=
+by rw [image2_singleton_left, show f a = id, from funext h, image_id]
+
+/-- If `b` is a right identity for `f : α → β → α`, then `{b}` is a right identity for
+`set.image2 f`. -/
+lemma image2_right_identity {f : α → β → α} {b : β} (h : ∀ a, f a b = a) (s : set α) :
+  image2 f s {b} = s :=
+by rw [image2_singleton_right, funext h, image_id']
+
+lemma image2_inter_union_subset_union :
+  image2 f (s ∩ s') (t ∪ t') ⊆ image2 f s t ∪ image2 f s' t' :=
+by { rw image2_union_right, exact union_subset_union
+  (image2_subset_right $ inter_subset_left _ _) (image2_subset_right $ inter_subset_right _ _) }
+
+lemma image2_union_inter_subset_union :
+  image2 f (s ∪ s') (t ∩ t') ⊆ image2 f s t ∪ image2 f s' t' :=
+by { rw image2_union_left, exact union_subset_union
+  (image2_subset_left $ inter_subset_left _ _) (image2_subset_left $ inter_subset_right _ _) }
+
+lemma image2_inter_union_subset {f : α → α → β} {s t : set α} (hf : ∀ a b, f a b = f b a) :
+  image2 f (s ∩ t) (s ∪ t) ⊆ image2 f s t :=
+by { rw inter_comm,
+  exact image2_inter_union_subset_union.trans (union_subset (image2_comm hf).subset subset.rfl) }
+
+lemma image2_union_inter_subset {f : α → α → β} {s t : set α} (hf : ∀ a b, f a b = f b a) :
+  image2 f (s ∪ t) (s ∩ t) ⊆ image2 f s t :=
+by { rw image2_comm hf, exact image2_inter_union_subset hf }
+
+end set
diff --git a/src/data/set/ncard.lean b/src/data/set/ncard.lean
new file mode 100644
index 0000000000000..34ccdf0fa368a
--- /dev/null
+++ b/src/data/set/ncard.lean
@@ -0,0 +1,747 @@
+/-
+Copyright (c) 2023 Peter Nelson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Peter Nelson
+-/
+import data.finite.card
+import algebra.big_operators.finprod
+
+/-!
+# Noncomputable Set Cardinality
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the cardinality `set.ncard s` of a set `s` as a natural number. This function is
+noncomputable (being defined in terms of `nat.card`) and takes the value `0` if `s` is infinite.
+
+This can be seen as an API for `nat.card α` in the special case where `α` is a subtype arising from
+a set. It is intended as an alternative to `finset.card` and `fintype.card`,  both of which contain
+data in their definition that can cause awkwardness when using `set.to_finset`.  Using `set.ncard`
+allows cardinality computations to avoid `finset`/`fintype` completely, staying in `set` and letting
+finiteness be handled explicitly, or (where a `finite α` instance is present and the sets are
+in `set α`) via `auto_param`s.
+
+## Main Definitions
+
+* `set.ncard s` is the cardinality of the set `s` as a natural number, provided `s` is finite.
+  If `s` is infinite, then `set.ncard s = 0`.
+* `to_finite_tac` is a tactic that tries to synthesize an `set.finite s` argument with
+  `set.to_finite`. This will work for `s : set α` where there is a `finite α` instance.
+
+## Implementation Notes
+
+The lemmas in this file are very similar to those in `data.finset.card`, but with `set` operations
+instead of `finset`; most of the proofs invoke their `finset` analogues. Nearly all the lemmas
+require finiteness of one or more of their arguments. We provide this assumption with an
+`auto_param` argument of the form `(hs : s.finite . to_finite_tac)`, where `to_finite_tac` will find
+a `finite s` term in the cases where `s` is a set in a `finite` type.
+
+Often, where there are two set arguments `s` and `t`, the finiteness of one follows from the other
+in the context of the lemma, in which case we only include the ones that are needed, and derive the
+other inside the proof. A few of the lemmas, such as `ncard_union_le` do not require finiteness
+arguments; they are are true by coincidence due to junk values.
+-/
+
+open_locale big_operators
+
+variables {α β : Type*} {s t : set α} {a b x y : α} {f : α → β}
+
+namespace set
+
+/-- The cardinality of `s : set α`. Has the junk value `0` if `s` is infinite -/
+noncomputable def ncard (s : set α) := nat.card s
+
+/-- A tactic, for use in `auto_param`s, that finds a `t.finite` term for a set `t`
+  whose finiteness can be deduced from typeclasses (eg. in a `finite` type). -/
+meta def to_finite_tac : tactic unit := `[exact set.to_finite _]
+
+lemma ncard_def (s : set α) : s.ncard = nat.card s := rfl
+
+lemma ncard_eq_to_finset_card (s : set α) (hs : s.finite . to_finite_tac) :
+  s.ncard = hs.to_finset.card :=
+by rw [ncard_def, @nat.card_eq_fintype_card _ hs.fintype,
+  @finite.card_to_finset _ _ hs.fintype hs]
+
+lemma ncard_le_of_subset (hst : s ⊆ t) (ht : t.finite . to_finite_tac) : s.ncard ≤ t.ncard :=
+@finite.card_le_of_embedding _ _ (finite_coe_iff.mpr ht) (set.embedding_of_subset _ _ hst)
+
+lemma ncard_mono [finite α] : @monotone (set α) _ _ _ ncard :=
+λ _ _, ncard_le_of_subset
+
+@[simp] lemma ncard_eq_zero (hs : s.finite . to_finite_tac) : s.ncard = 0 ↔ s = ∅ :=
+by simp [ncard_def, @finite.card_eq_zero_iff _ hs.to_subtype]
+
+@[simp] lemma ncard_coe_finset (s : finset α) : (s : set α).ncard = s.card :=
+by rw [ncard_eq_to_finset_card, finset.finite_to_set_to_finset]
+
+lemma infinite.ncard (hs : s.infinite) : s.ncard = 0 :=
+@nat.card_eq_zero_of_infinite _ hs.to_subtype
+
+lemma ncard_univ (α : Type*) : (univ : set α).ncard = nat.card α :=
+begin
+  cases finite_or_infinite α with h h,
+  { haveI := @fintype.of_finite α h,
+    rw [ncard_eq_to_finset_card, finite.to_finset_univ, finset.card_univ,
+      nat.card_eq_fintype_card]},
+  rw [(@infinite_univ _ h).ncard, @nat.card_eq_zero_of_infinite _ h],
+end
+
+@[simp] lemma ncard_empty (α : Type*) : (∅ : set α).ncard = 0 :=
+by simp only [ncard_eq_zero]
+
+lemma ncard_pos (hs : s.finite . to_finite_tac) : 0 < s.ncard ↔ s.nonempty :=
+by rw [pos_iff_ne_zero, ne.def, ncard_eq_zero hs, nonempty_iff_ne_empty]
+
+lemma ncard_ne_zero_of_mem (h : a ∈ s) (hs : s.finite . to_finite_tac) : s.ncard ≠ 0 :=
+((ncard_pos hs).mpr ⟨a,h⟩).ne.symm
+
+lemma finite_of_ncard_ne_zero (hs : s.ncard ≠ 0) : s.finite :=
+s.finite_or_infinite.elim id (λ h, (hs h.ncard).elim)
+
+lemma finite_of_ncard_pos (hs : 0 < s.ncard) : s.finite :=
+finite_of_ncard_ne_zero hs.ne.symm
+
+lemma nonempty_of_ncard_ne_zero (hs : s.ncard ≠ 0) : s.nonempty :=
+by { rw nonempty_iff_ne_empty, rintro rfl, simpa using hs }
+
+@[simp] lemma ncard_singleton (a : α) : ({a} : set α).ncard = 1 :=
+by simp [ncard_eq_to_finset_card]
+
+lemma ncard_singleton_inter : ({a} ∩ s).ncard ≤ 1 :=
+begin
+  classical,
+  rw [←inter_self {a}, inter_assoc, ncard_eq_to_finset_card,
+    finite.to_finset_inter, finite.to_finset_singleton],
+  { apply finset.card_singleton_inter},
+  all_goals {apply to_finite},
+end
+
+section insert_erase
+
+@[simp] lemma ncard_insert_of_not_mem (h : a ∉ s) (hs : s.finite . to_finite_tac) :
+  (insert a s).ncard = s.ncard + 1 :=
+begin
+  classical,
+  haveI := hs.fintype,
+  rw [ncard_eq_to_finset_card, ncard_eq_to_finset_card, finite.to_finset_insert,
+    finset.card_insert_of_not_mem],
+  rwa [finite.mem_to_finset],
+end
+
+lemma ncard_insert_of_mem (h : a ∈ s) : ncard (insert a s) = s.ncard :=
+by rw insert_eq_of_mem h
+
+lemma ncard_insert_le (a : α) (s : set α) : (insert a s).ncard ≤ s.ncard + 1 :=
+begin
+  classical,
+  obtain (hs | hs) := s.finite_or_infinite,
+  { exact (em (a ∈ s)).elim (λ h, (ncard_insert_of_mem h).trans_le (nat.le_succ _))
+      (λ h, by rw ncard_insert_of_not_mem h hs)},
+  rw (hs.mono (subset_insert a s)).ncard,
+  exact nat.zero_le _,
+end
+
+lemma ncard_insert_eq_ite [decidable (a ∈ s)] (hs : s.finite . to_finite_tac) :
+  ncard (insert a s) = if a ∈ s then s.ncard else s.ncard + 1 :=
+begin
+  by_cases h : a ∈ s,
+  { rw [ncard_insert_of_mem h, if_pos h] },
+  { rw [ncard_insert_of_not_mem h hs, if_neg h] }
+end
+
+lemma ncard_le_ncard_insert (a : α) (s : set α) : s.ncard ≤ (insert a s).ncard :=
+begin
+  classical,
+  refine s.finite_or_infinite.elim (λ h, _) (λ h, by { rw h.ncard, exact nat.zero_le _ }),
+  rw ncard_insert_eq_ite h,
+  split_ifs,
+  { refl },
+  { simp only [le_add_iff_nonneg_right, zero_le'] },
+  exact classical.dec (a ∈ s),
+end
+
+lemma ncard_pair (h : a ≠ b) : ({a, b} : set α).ncard = 2 :=
+by {rw [ncard_insert_of_not_mem, ncard_singleton], simpa}
+
+lemma ncard_diff_singleton_add_one (h : a ∈ s) (hs : s.finite . to_finite_tac) :
+  (s \ {a}).ncard + 1 = s.ncard :=
+begin
+  have h' : a ∉ s \ {a}, by {rw [mem_diff_singleton], tauto},
+  rw ←ncard_insert_of_not_mem h' (hs.diff {a}),
+  congr',
+  simpa,
+end
+
+lemma ncard_diff_singleton_of_mem (h : a ∈ s) (hs : s.finite . to_finite_tac) :
+  (s \ {a}).ncard = s.ncard - 1 :=
+eq_tsub_of_add_eq (ncard_diff_singleton_add_one h hs)
+
+lemma ncard_diff_singleton_lt_of_mem (h : a ∈ s) (hs : s.finite . to_finite_tac) :
+  (s \ {a}).ncard < s.ncard :=
+by {rw [←ncard_diff_singleton_add_one h hs], apply lt_add_one}
+
+lemma ncard_diff_singleton_le (s : set α) (a : α) : (s \ {a}).ncard ≤ s.ncard :=
+begin
+  obtain (hs | hs) := s.finite_or_infinite,
+  { apply ncard_le_of_subset (diff_subset _ _) hs},
+  convert zero_le _,
+  exact (hs.diff (by simp : set.finite {a})).ncard,
+end
+
+lemma pred_ncard_le_ncard_diff_singleton (s : set α) (a : α) : s.ncard - 1 ≤ (s \ {a}).ncard :=
+begin
+  cases s.finite_or_infinite with hs hs,
+  { by_cases h : a ∈ s,
+    { rw ncard_diff_singleton_of_mem h hs, },
+    rw diff_singleton_eq_self h,
+    apply nat.pred_le},
+  convert nat.zero_le _,
+  rw hs.ncard,
+end
+
+lemma ncard_exchange (ha : a ∉ s) (hb : b ∈ s) : (insert a (s \ {b})).ncard = s.ncard :=
+begin
+  cases s.finite_or_infinite with h h,
+  { haveI := h.to_subtype,
+    rw [ncard_insert_of_not_mem, ncard_diff_singleton_add_one hb],
+    simpa only [mem_diff, not_and] using ha},
+  rw [((h.diff (set.to_finite {b})).mono (subset_insert _ _)).ncard, h.ncard],
+end
+
+lemma ncard_exchange' (ha : a ∉ s) (hb : b ∈ s) : ((insert a s) \ {b}).ncard = s.ncard :=
+by rw [←ncard_exchange ha hb, ←singleton_union, ←singleton_union, union_diff_distrib,
+  @diff_singleton_eq_self _ b {a} (λ h, ha (by rwa ← mem_singleton_iff.mp h) )]
+
+end insert_erase
+
+lemma ncard_image_le (hs : s.finite . to_finite_tac) : (f '' s).ncard ≤ s.ncard :=
+begin
+  classical,
+  rw ncard_eq_to_finset_card s hs,
+  haveI := hs.fintype,
+  convert @finset.card_image_le _ _ s.to_finset f _,
+  rw [ncard_eq_to_finset_card, finite.to_finset_image _ hs],
+  { congr', rw [←finset.coe_inj, finite.coe_to_finset, coe_to_finset]},
+  { apply_instance},
+  rw [←finset.coe_inj, finite.coe_to_finset, coe_to_finset],
+end
+
+lemma ncard_image_of_inj_on (H : set.inj_on f s) : (f '' s).ncard = s.ncard :=
+begin
+  cases s.finite_or_infinite,
+  { haveI := @fintype.of_finite s h.to_subtype,
+    haveI := @fintype.of_finite _ (h.image f).to_subtype,
+    convert card_image_of_inj_on H; simp [ncard_def]},
+  rw [h.ncard, ((infinite_image_iff H).mpr h).ncard],
+end
+
+lemma inj_on_of_ncard_image_eq (h : (f '' s).ncard = s.ncard) (hs : s.finite . to_finite_tac) :
+  set.inj_on f s :=
+begin
+  classical,
+  haveI := hs.fintype,
+  haveI := ((to_finite s).image f).fintype,
+  simp_rw ncard_eq_to_finset_card at h,
+  rw ← coe_to_finset s,
+  apply finset.inj_on_of_card_image_eq,
+  convert h,
+  ext,
+  simp,
+end
+
+lemma ncard_image_iff (hs : s.finite . to_finite_tac) : (f '' s).ncard = s.ncard ↔ set.inj_on f s :=
+⟨λ h, inj_on_of_ncard_image_eq h hs, ncard_image_of_inj_on⟩
+
+lemma ncard_image_of_injective (s : set α) (H : f.injective) : (f '' s).ncard = s.ncard :=
+ncard_image_of_inj_on $ λ x _ y _ h, H h
+
+lemma ncard_preimage_of_injective_subset_range {s : set β} (H : f.injective)
+  (hs : s ⊆ set.range f) : (f ⁻¹' s).ncard = s.ncard :=
+by rw [←ncard_image_of_injective _ H, image_preimage_eq_iff.mpr hs]
+
+lemma fiber_ncard_ne_zero_iff_mem_image {y : β} (hs : s.finite . to_finite_tac) :
+  {x ∈ s | f x = y}.ncard ≠ 0 ↔ y ∈ f '' s :=
+begin
+  refine ⟨nonempty_of_ncard_ne_zero, _⟩,
+  rintros ⟨z,hz,rfl⟩,
+  exact @ncard_ne_zero_of_mem _ {x ∈ s | f x = f z} z (mem_sep hz rfl)
+    (hs.subset (sep_subset _ _)),
+end
+
+@[simp] lemma ncard_map (f : α ↪ β) : (f '' s).ncard = s.ncard :=
+ncard_image_of_injective _ f.injective
+
+@[simp] lemma ncard_subtype (P : α → Prop) (s : set α) :
+  {x : subtype P | (x : α) ∈ s}.ncard = (s ∩ (set_of P)).ncard :=
+begin
+  convert (ncard_image_of_injective _ (@subtype.coe_injective _ P)).symm,
+  ext, rw inter_comm, simp,
+end
+
+@[simp] lemma nat.card_coe_set_eq (s : set α) : nat.card s = s.ncard :=
+begin
+  convert (ncard_image_of_injective univ subtype.coe_injective).symm using 1,
+  { rw ncard_univ, refl },
+  simp,
+end
+
+lemma ncard_inter_le_ncard_left (s t : set α) (hs : s.finite . to_finite_tac) :
+  (s ∩ t).ncard ≤ s.ncard :=
+ncard_le_of_subset (inter_subset_left _ _) hs
+
+lemma ncard_inter_le_ncard_right (s t : set α) (ht : t.finite . to_finite_tac) :
+  (s ∩ t).ncard ≤ t.ncard :=
+ncard_le_of_subset (inter_subset_right _ _) ht
+
+lemma eq_of_subset_of_ncard_le (h : s ⊆ t) (h' : t.ncard ≤ s.ncard)
+  (ht : t.finite . to_finite_tac) :
+  s = t :=
+begin
+  haveI := ht.fintype,
+  haveI := (ht.subset h).fintype,
+  rw ←@to_finset_inj,
+  apply finset.eq_of_subset_of_card_le,
+  { simpa, },
+  rw [ncard_eq_to_finset_card _ ht, ncard_eq_to_finset_card _ (ht.subset h)] at h',
+  convert h',
+end
+
+lemma subset_iff_eq_of_ncard_le (h : t.ncard ≤ s.ncard) (ht : t.finite . to_finite_tac) :
+  s ⊆ t ↔ s = t :=
+⟨λ hst, eq_of_subset_of_ncard_le hst h ht, eq.subset'⟩
+
+lemma map_eq_of_subset {f : α ↪ α} (h : f '' s ⊆ s) (hs : s.finite . to_finite_tac) : f '' s = s :=
+eq_of_subset_of_ncard_le h (ncard_map _).ge hs
+
+lemma sep_of_ncard_eq {P : α → Prop} (h : {x ∈ s | P x}.ncard = s.ncard) (ha : a ∈ s)
+  (hs : s.finite . to_finite_tac) :
+P a :=
+sep_eq_self_iff_mem_true.mp (eq_of_subset_of_ncard_le (by simp) h.symm.le hs) _ ha
+
+lemma ncard_lt_ncard (h : s ⊂ t) (ht : t.finite . to_finite_tac) : s.ncard < t.ncard :=
+begin
+  rw [ncard_eq_to_finset_card _ (ht.subset h.subset), ncard_eq_to_finset_card t ht],
+  refine finset.card_lt_card _,
+  rwa [finite.to_finset_ssubset_to_finset],
+end
+
+lemma ncard_strict_mono [finite α] : @strict_mono (set α) _ _ _ ncard :=
+λ _ _ h, ncard_lt_ncard h
+
+lemma ncard_eq_of_bijective {n : ℕ} (f : ∀ i, i < n → α) (hf : ∀ a ∈ s, ∃ i, ∃ h : i < n, f i h = a)
+  (hf' : ∀ i (h : i < n), f i h ∈ s)
+  (f_inj : ∀ i j (hi : i < n) (hj : j < n), f i hi = f j hj → i = j)
+  (hs : s.finite . to_finite_tac) :
+  s.ncard = n :=
+begin
+  rw ncard_eq_to_finset_card _ hs,
+  apply finset.card_eq_of_bijective,
+  all_goals {simpa},
+end
+
+lemma ncard_congr {t : set β} (f : Π a ∈ s, β) (h₁ : ∀ a ha, f a ha ∈ t)
+  (h₂ : ∀ a b ha hb, f a ha = f b hb → a = b) (h₃ : ∀ b ∈ t, ∃ a ha, f a ha = b)
+  (hs : s.finite . to_finite_tac) :
+  s.ncard = t.ncard :=
+begin
+  set f' : s → t := λ x, ⟨f x.1 x.2, h₁ _ _⟩ with hf',
+  have hbij : f'.bijective,
+  { split,
+    { rintros ⟨x,hx⟩ ⟨y,hy⟩ hxy,
+      simp only [hf', subtype.val_eq_coe, subtype.coe_mk, subtype.mk_eq_mk] at hxy ⊢,
+      apply h₂ _ _ hx hy hxy},
+    rintro ⟨y,hy⟩,
+    obtain ⟨a, ha, rfl⟩ := h₃ y hy,
+    simp only [subtype.val_eq_coe, subtype.coe_mk, subtype.mk_eq_mk, set_coe.exists],
+    exact ⟨_,ha,rfl⟩},
+  haveI := hs.to_subtype,
+  haveI := @fintype.of_finite _ (finite.of_bijective hbij),
+  haveI := fintype.of_finite s,
+  convert fintype.card_of_bijective hbij,
+  rw [ncard_def, nat.card_eq_fintype_card],
+  rw [ncard_def, nat.card_eq_fintype_card],
+end
+
+lemma ncard_le_ncard_of_inj_on {t : set β} (f : α → β) (hf : ∀ a ∈ s, f a ∈ t) (f_inj : inj_on f s)
+  (ht : t.finite . to_finite_tac) :
+  s.ncard ≤ t.ncard :=
+begin
+  cases s.finite_or_infinite,
+  { haveI := h.to_subtype,
+    rw [ncard_eq_to_finset_card _ ht, ncard_eq_to_finset_card _ (to_finite s)],
+    exact finset.card_le_card_of_inj_on f (by simpa) (by simpa)},
+  convert nat.zero_le _,
+  rw h.ncard,
+end
+
+lemma exists_ne_map_eq_of_ncard_lt_of_maps_to {t : set β} (hc : t.ncard < s.ncard) {f : α → β}
+  (hf : ∀ a ∈ s, f a ∈ t) (ht : t.finite . to_finite_tac) :
+  ∃ (x ∈ s) (y ∈ s), x ≠ y ∧ f x = f y :=
+begin
+  by_contra h',
+  simp only [ne.def, exists_prop, not_exists, not_and, not_imp_not] at h',
+  exact (ncard_le_ncard_of_inj_on f hf h' ht).not_lt hc,
+end
+
+lemma le_ncard_of_inj_on_range {n : ℕ} (f : ℕ → α) (hf : ∀ i < n, f i ∈ s)
+  (f_inj : ∀ (i < n) (j < n), f i = f j → i = j) (hs : s.finite . to_finite_tac):
+  n ≤ s.ncard :=
+by {rw ncard_eq_to_finset_card _ hs, apply finset.le_card_of_inj_on_range; simpa}
+
+lemma surj_on_of_inj_on_of_ncard_le {t : set β} (f : Π a ∈ s, β)
+  (hf : ∀ a ha, f a ha ∈ t) (hinj : ∀ a₁ a₂ ha₁ ha₂, f a₁ ha₁ = f a₂ ha₂ → a₁ = a₂)
+  (hst : t.ncard ≤ s.ncard) (ht : t.finite . to_finite_tac) :
+  ∀ b ∈ t, ∃ a ha, b = f a ha :=
+begin
+  intros b hb,
+  set f' : s → t := λ x, ⟨f x.1 x.2, hf _ _⟩ with hf',
+  have finj: f'.injective,
+  { rintros ⟨x,hx⟩ ⟨y,hy⟩ hxy,
+    simp only [hf', subtype.val_eq_coe, subtype.coe_mk, subtype.mk_eq_mk] at hxy ⊢,
+    apply hinj _ _ hx hy hxy},
+  haveI := ht.fintype,
+  haveI := fintype.of_injective f' finj,
+  simp_rw [ncard_eq_to_finset_card] at hst,
+  set f'' : ∀ a, a ∈ s.to_finset → β := λ a h, f a (by simpa using h) with hf'',
+  convert @finset.surj_on_of_inj_on_of_card_le _ _ _ t.to_finset f'' (by simpa) (by simpa)
+    (by convert hst) b (by simpa),
+  simp,
+end
+
+lemma inj_on_of_surj_on_of_ncard_le {t : set β} (f : Π a ∈ s, β)
+  (hf : ∀ a ha, f a ha ∈ t) (hsurj : ∀ b ∈ t, ∃ a ha, b = f a ha) (hst : s.ncard ≤ t.ncard)
+  ⦃a₁ a₂⦄ (ha₁ : a₁ ∈ s) (ha₂ : a₂ ∈ s) (ha₁a₂: f a₁ ha₁ = f a₂ ha₂)
+  (hs : s.finite . to_finite_tac) :
+  a₁ = a₂ :=
+begin
+  classical,
+   set f' : s → t := λ x, ⟨f x.1 x.2, hf _ _⟩ with hf',
+  have hsurj : f'.surjective,
+  { rintro ⟨y,hy⟩,
+    obtain ⟨a, ha, rfl⟩ := hsurj y hy,
+    simp only [subtype.val_eq_coe, subtype.coe_mk, subtype.mk_eq_mk, set_coe.exists],
+    exact ⟨_,ha,rfl⟩},
+  haveI := hs.fintype,
+  haveI := fintype.of_surjective _ hsurj,
+  simp_rw [ncard_eq_to_finset_card] at hst,
+  set f'' : ∀ a, a ∈ s.to_finset → β := λ a h, f a (by simpa using h) with hf'',
+  exact @finset.inj_on_of_surj_on_of_card_le _ _ _ t.to_finset f'' (by simpa) (by simpa)
+    (by convert hst) a₁ a₂ (by simpa) (by simpa) (by simpa),
+end
+
+section lattice
+
+lemma ncard_union_add_ncard_inter (s t : set α) (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac) :
+  (s ∪ t).ncard + (s ∩ t).ncard = s.ncard + t.ncard :=
+begin
+  classical,
+  have hu := hs.union ht,
+  have hi := (hs.subset (inter_subset_left s t)),
+  rw [ncard_eq_to_finset_card _ hs, ncard_eq_to_finset_card _ ht, ncard_eq_to_finset_card _ hu,
+    ncard_eq_to_finset_card _ hi, finite.to_finset_union, finite.to_finset_inter],
+  { exact finset.card_union_add_card_inter _ _},
+end
+
+lemma ncard_inter_add_ncard_union (s t : set α) (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac) :
+  (s ∩ t).ncard + (s ∪ t).ncard = s.ncard + t.ncard :=
+by rw [add_comm, ncard_union_add_ncard_inter _ _ hs ht]
+
+lemma ncard_union_le (s t : set α) : (s ∪ t).ncard ≤ s.ncard + t.ncard :=
+begin
+  classical,
+  cases (s ∪ t).finite_or_infinite,
+  { have hs := h.subset (subset_union_left s t),
+    have ht := h.subset (subset_union_right s t),
+    rw [ncard_eq_to_finset_card _ hs, ncard_eq_to_finset_card _ ht, ncard_eq_to_finset_card _ h,
+      finite.to_finset_union],
+    exact finset.card_union_le _ _},
+  convert nat.zero_le _,
+  rw h.ncard,
+end
+
+lemma ncard_union_eq (h : disjoint s t) (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac) :
+  (s ∪ t).ncard = s.ncard + t.ncard :=
+begin
+  classical,
+  rw [ncard_eq_to_finset_card _ hs, ncard_eq_to_finset_card _ ht,
+    ncard_eq_to_finset_card _ (hs.union ht),finite.to_finset_union],
+  refine finset.card_union_eq _,
+  rwa [finite.disjoint_to_finset],
+end
+
+lemma ncard_diff_add_ncard_eq_ncard (h : s ⊆ t) (ht : t.finite . to_finite_tac) :
+  (t \ s).ncard + s.ncard = t.ncard :=
+begin
+  classical,
+  rw [ncard_eq_to_finset_card _ ht, ncard_eq_to_finset_card _ (ht.subset h),
+      ncard_eq_to_finset_card _ (ht.diff s), finite.to_finset_diff],
+  refine finset.card_sdiff_add_card_eq_card _,
+  rwa finite.to_finset_subset_to_finset,
+end
+
+lemma ncard_diff (h : s ⊆ t) (ht : t.finite . to_finite_tac) : (t \ s).ncard = t.ncard - s.ncard :=
+by rw [←ncard_diff_add_ncard_eq_ncard h ht, add_tsub_cancel_right]
+
+lemma ncard_le_ncard_diff_add_ncard (s t : set α) (ht : t.finite . to_finite_tac) :
+  s.ncard ≤ (s \ t).ncard + t.ncard :=
+begin
+  cases s.finite_or_infinite,
+  { rw [←diff_inter_self_eq_diff, ←ncard_diff_add_ncard_eq_ncard (inter_subset_right t s) h,
+      add_le_add_iff_left],
+    apply ncard_inter_le_ncard_left _ _ ht,},
+  convert nat.zero_le _,
+  rw h.ncard,
+end
+
+lemma le_ncard_diff (s t : set α) (hs : s.finite . to_finite_tac) :
+  t.ncard - s.ncard ≤ (t \ s).ncard :=
+begin
+  refine tsub_le_iff_left.mpr _,
+  rw add_comm,
+  apply ncard_le_ncard_diff_add_ncard _ _ hs,
+end
+
+lemma ncard_diff_add_ncard (s t : set α) (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac) :
+  (s \ t).ncard + t.ncard = (s ∪ t).ncard :=
+by rw [←union_diff_right,ncard_diff_add_ncard_eq_ncard (subset_union_right s t) (hs.union ht)]
+
+lemma diff_nonempty_of_ncard_lt_ncard (h : s.ncard < t.ncard) (hs : s.finite . to_finite_tac) :
+  (t \ s).nonempty :=
+begin
+  rw [set.nonempty_iff_ne_empty, ne.def, diff_eq_empty],
+  exact λ h', h.not_le (ncard_le_of_subset h' hs),
+end
+
+lemma exists_mem_not_mem_of_ncard_lt_ncard (h : s.ncard < t.ncard) (hs : s.finite . to_finite_tac) :
+  ∃ e, e ∈ t ∧ e ∉ s :=
+diff_nonempty_of_ncard_lt_ncard h hs
+
+@[simp] lemma ncard_inter_add_ncard_diff_eq_ncard (s t : set α)
+  (hs : s.finite . to_finite_tac) :
+  (s ∩ t).ncard + (s \ t).ncard = s.ncard :=
+by rw [←ncard_diff_add_ncard_eq_ncard (diff_subset s t) hs, sdiff_sdiff_right_self, inf_eq_inter]
+
+lemma ncard_eq_ncard_iff_ncard_diff_eq_ncard_diff (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac) :
+  s.ncard = t.ncard ↔ (s \ t).ncard = (t \ s).ncard :=
+by rw [←ncard_inter_add_ncard_diff_eq_ncard s t hs, ←ncard_inter_add_ncard_diff_eq_ncard t s ht,
+    inter_comm, add_right_inj]
+
+lemma ncard_le_ncard_iff_ncard_diff_le_ncard_diff (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac)  :
+  s.ncard ≤ t.ncard ↔ (s \ t).ncard ≤ (t \ s).ncard :=
+by rw [←ncard_inter_add_ncard_diff_eq_ncard s t hs, ←ncard_inter_add_ncard_diff_eq_ncard t s ht,
+     inter_comm, add_le_add_iff_left]
+
+lemma ncard_lt_ncard_iff_ncard_diff_lt_ncard_diff (hs : s.finite . to_finite_tac)
+  (ht : t.finite . to_finite_tac)  :
+  s.ncard < t.ncard ↔ (s \ t).ncard < (t \ s).ncard :=
+by rw [←ncard_inter_add_ncard_diff_eq_ncard s t hs, ←ncard_inter_add_ncard_diff_eq_ncard t s ht,
+     inter_comm, add_lt_add_iff_left]
+
+lemma ncard_add_ncard_compl (s : set α) (hs : s.finite . to_finite_tac)
+  (hsc : sᶜ.finite . to_finite_tac) :
+  s.ncard + sᶜ.ncard = nat.card α :=
+by rw [←ncard_univ, ←ncard_union_eq (@disjoint_compl_right _ _ s) hs hsc, union_compl_self]
+
+end lattice
+
+/-- Given a set `t` and a set `s` inside it, we can shrink `t` to any appropriate size, and keep `s`
+    inside it. -/
+lemma exists_intermediate_set (i : ℕ) (h₁ : i + s.ncard ≤ t.ncard) (h₂ : s ⊆ t) :
+  ∃ (r : set α), s ⊆ r ∧ r ⊆ t ∧ r.ncard = i + s.ncard :=
+begin
+  cases t.finite_or_infinite with ht ht,
+  { haveI := ht.to_subtype,
+    haveI := (ht.subset h₂).to_subtype,
+    simp_rw [ncard_eq_to_finset_card] at h₁ ⊢,
+    obtain ⟨r', hsr', hr't, hr'⟩ := finset.exists_intermediate_set _ h₁ (by simpa),
+    exact ⟨r', by simpa using hsr', by simpa using hr't, by rw [←hr', ncard_coe_finset]⟩},
+  rw [ht.ncard] at h₁,
+  have h₁' := nat.eq_zero_of_le_zero h₁,
+  rw [add_eq_zero_iff] at h₁',
+  exact ⟨t, h₂, rfl.subset, by rw [ht.ncard, h₁'.1, h₁'.2]⟩
+end
+
+lemma exists_intermediate_set' {m : ℕ} (hs : s.ncard ≤ m) (ht : m ≤ t.ncard) (h : s ⊆ t) :
+  ∃ (r : set α), s ⊆ r ∧ r ⊆ t ∧ r.ncard = m :=
+begin
+  obtain ⟨r,hsr,hrt,hc⟩ :=
+    exists_intermediate_set (m - s.ncard) (by rwa [tsub_add_cancel_of_le hs]) h,
+  rw tsub_add_cancel_of_le hs at hc,
+  exact ⟨r,hsr,hrt,hc⟩,
+end
+
+/-- We can shrink `s` to any smaller size. -/
+lemma exists_smaller_set (s : set α) (i : ℕ) (h₁ : i ≤ s.ncard) :
+  ∃ (t : set α), t ⊆ s ∧ t.ncard = i :=
+(exists_intermediate_set i (by simpa) (empty_subset s)).imp (λ t ht, ⟨ht.2.1,by simpa using ht.2.2⟩)
+
+lemma infinite.exists_subset_ncard_eq {s : set α} (hs : s.infinite) (k : ℕ) :
+  ∃ t, t ⊆ s ∧ t.finite ∧ t.ncard = k :=
+begin
+  haveI := hs.to_subtype,
+  obtain ⟨t', -, rfl⟩ := @infinite.exists_subset_card_eq s univ infinite_univ k,
+  refine ⟨coe '' (t' : set s), by simp, finite.image _ (by simp), _⟩,
+  rw [ncard_image_of_injective _ subtype.coe_injective],
+  simp,
+end
+
+lemma infinite.exists_supset_ncard_eq {s t : set α} (ht : t.infinite) (hst : s ⊆ t)
+  (hs : s.finite) {k : ℕ} (hsk : s.ncard ≤ k) :
+  ∃ s', s ⊆ s' ∧ s' ⊆ t ∧ s'.ncard = k :=
+begin
+  obtain ⟨s₁, hs₁, hs₁fin, hs₁card⟩ := (ht.diff hs).exists_subset_ncard_eq (k - s.ncard),
+  refine ⟨s ∪ s₁, subset_union_left _ _, union_subset hst (hs₁.trans (diff_subset _ _)), _⟩,
+  rwa [ncard_union_eq (disjoint_of_subset_right hs₁ disjoint_sdiff_right) hs hs₁fin, hs₁card,
+    add_tsub_cancel_of_le],
+end
+
+lemma exists_subset_or_subset_of_two_mul_lt_ncard {n : ℕ} (hst : 2 * n < (s ∪ t).ncard) :
+  ∃ (r : set α), n < r.ncard ∧ (r ⊆ s ∨ r ⊆ t) :=
+begin
+  classical,
+  have hu := (finite_of_ncard_ne_zero ((nat.zero_le _).trans_lt hst).ne.symm),
+  rw [ncard_eq_to_finset_card _ hu, finite.to_finset_union
+    (hu.subset (subset_union_left _ _)) (hu.subset (subset_union_right _ _))] at hst,
+  obtain ⟨r', hnr', hr'⟩ := finset.exists_subset_or_subset_of_two_mul_lt_card hst,
+  exact ⟨r', by simpa , by simpa using hr'⟩,
+end
+
+/-! ### Explicit description of a set from its cardinality -/
+
+@[simp] lemma ncard_eq_one : s.ncard = 1 ↔ ∃ a, s = {a} :=
+begin
+  refine ⟨λ h, _,by {rintro ⟨a,rfl⟩, rw [ncard_singleton]}⟩,
+  haveI := (finite_of_ncard_ne_zero (ne_zero_of_eq_one h)).to_subtype,
+  rw [ncard_eq_to_finset_card, finset.card_eq_one] at h,
+  exact h.imp (λ a ha, by rwa [←finite.to_finset_singleton, finite.to_finset_inj] at ha),
+end
+
+lemma exists_eq_insert_iff_ncard (hs : s.finite . to_finite_tac) :
+  (∃ a ∉ s, insert a s = t) ↔ s ⊆ t ∧ s.ncard + 1 = t.ncard :=
+begin
+  classical,
+  split,
+  { rintro ⟨a, ha, rfl⟩,
+    rw [ncard_eq_to_finset_card _ hs, ncard_eq_to_finset_card _ (hs.insert a),
+      finite.to_finset_insert, ←@finite.to_finset_subset_to_finset _ _ _ hs (hs.insert a),
+      finite.to_finset_insert],
+    refine (@finset.exists_eq_insert_iff _ _ hs.to_finset (insert a hs.to_finset)).mp _,
+    exact ⟨a, by rwa finite.mem_to_finset, rfl⟩},
+  rintro ⟨hst, h⟩,
+  have ht := @finite_of_ncard_pos _ t (by {rw ←h, apply nat.zero_lt_succ}),
+
+  rw [ncard_eq_to_finset_card _ hs, ncard_eq_to_finset_card _ ht] at h,
+  obtain ⟨a,has, ha⟩ := (finset.exists_eq_insert_iff.mpr ⟨by {simpa},h⟩),
+  have hsa := hs.insert a,
+  rw ←finite.to_finset_insert at ha,
+  exact ⟨a, by {rwa finite.mem_to_finset at has}, by {rwa ←@finite.to_finset_inj _ _ _ hsa ht}⟩,
+end
+
+lemma ncard_le_one (hs : s.finite . to_finite_tac) : s.ncard ≤ 1 ↔ ∀ (a ∈ s) (b ∈ s), a = b :=
+by simp_rw [ncard_eq_to_finset_card _ hs, finset.card_le_one, finite.mem_to_finset]
+
+lemma ncard_le_one_iff (hs : s.finite . to_finite_tac) :
+  s.ncard ≤ 1 ↔ ∀ {a b}, a ∈ s → b ∈ s → a = b :=
+by { rw ncard_le_one hs, tauto}
+
+lemma ncard_le_one_iff_eq (hs : s.finite . to_finite_tac) : s.ncard ≤ 1 ↔ s = ∅ ∨ ∃ a, s = {a} :=
+begin
+  obtain (rfl | ⟨x,hx⟩) := s.eq_empty_or_nonempty,
+  { exact iff_of_true (by simp) (or.inl rfl), },
+  rw [ncard_le_one_iff hs],
+  refine ⟨λ h, or.inr ⟨x,(singleton_subset_iff.mpr hx).antisymm' (λ y hy, h hy hx)⟩, _⟩,
+  rintro (rfl | ⟨a,rfl⟩),
+  { exact (not_mem_empty _ hx).elim },
+  simp_rw mem_singleton_iff at hx ⊢, subst hx,
+  exact λ a b h h', h.trans h'.symm,
+end
+
+lemma ncard_le_one_iff_subset_singleton [nonempty α] (hs : s.finite . to_finite_tac) :
+  s.ncard ≤ 1 ↔ ∃ (x : α), s ⊆ {x} :=
+by simp_rw [ncard_eq_to_finset_card _ hs, finset.card_le_one_iff_subset_singleton,
+  finite.to_finset_subset, finset.coe_singleton]
+
+/-- A `set` of a subsingleton type has cardinality at most one. -/
+lemma ncard_le_one_of_subsingleton [subsingleton α] (s : set α) : s.ncard ≤ 1 :=
+by {rw [ncard_eq_to_finset_card], exact finset.card_le_one_of_subsingleton _}
+
+lemma one_lt_ncard (hs : s.finite . to_finite_tac) : 1 < s.ncard ↔ ∃ (a ∈ s) (b ∈ s), a ≠ b :=
+by simp_rw [ncard_eq_to_finset_card _ hs, finset.one_lt_card, finite.mem_to_finset]
+
+lemma one_lt_ncard_iff (hs : s.finite . to_finite_tac) :
+  1 < s.ncard ↔ ∃ a b, a ∈ s ∧ b ∈ s ∧ a ≠ b :=
+by { rw one_lt_ncard hs, simp only [exists_prop, exists_and_distrib_left] }
+
+lemma two_lt_ncard_iff (hs : s.finite . to_finite_tac) :
+  2 < s.ncard ↔ ∃ a b c, a ∈ s ∧ b ∈ s ∧ c ∈ s ∧ a ≠ b ∧ a ≠ c ∧ b ≠ c :=
+by simp_rw [ncard_eq_to_finset_card _ hs, finset.two_lt_card_iff, finite.mem_to_finset]
+
+lemma two_lt_card (hs : s.finite . to_finite_tac) :
+  2 < s.ncard ↔ ∃ (a ∈ s) (b ∈ s) (c ∈ s), a ≠ b ∧ a ≠ c ∧ b ≠ c :=
+by simp only [two_lt_ncard_iff hs, exists_and_distrib_left, exists_prop]
+
+lemma exists_ne_of_one_lt_ncard (hs : 1 < s.ncard) (a : α) : ∃ b, b ∈ s ∧ b ≠ a :=
+begin
+  haveI := (finite_of_ncard_ne_zero (zero_lt_one.trans hs).ne.symm).to_subtype,
+  rw [ncard_eq_to_finset_card] at hs,
+  simpa only [finite.mem_to_finset] using finset.exists_ne_of_one_lt_card hs a,
+end
+
+lemma eq_insert_of_ncard_eq_succ {n : ℕ} (h : s.ncard = n + 1) :
+  ∃ a t, a ∉ t ∧ insert a t = s ∧ t.ncard = n :=
+begin
+  classical,
+  haveI := @fintype.of_finite _ (finite_of_ncard_pos (n.zero_lt_succ.trans_eq h.symm)).to_subtype,
+  rw [ncard_eq_to_finset_card, finset.card_eq_succ] at h,
+  obtain ⟨a,t,hat,hts,rfl⟩ := h,
+  refine ⟨a,t,hat,_,by rw ncard_coe_finset⟩,
+  rw [←to_finset_inj],
+  convert hts,
+  simp only [to_finset_insert, finset.to_finset_coe],
+end
+
+lemma ncard_eq_succ {n : ℕ} (hs : s.finite . to_finite_tac) :
+  s.ncard = n + 1 ↔ ∃ a t, a ∉ t ∧ insert a t = s ∧ t.ncard = n :=
+begin
+  classical,
+  refine ⟨eq_insert_of_ncard_eq_succ, _⟩,
+  rintro ⟨a,t,hat,h,rfl⟩,
+  rw [← h, ncard_insert_of_not_mem hat (hs.subset ((subset_insert a t).trans_eq h))]
+end
+
+lemma ncard_eq_two : s.ncard = 2 ↔ ∃ x y, x ≠ y ∧ s = {x, y} :=
+begin
+  classical,
+  refine ⟨λ h, _, _⟩,
+  { obtain ⟨x,t,hxt,rfl,ht⟩ :=  eq_insert_of_ncard_eq_succ h,
+    obtain ⟨y,rfl⟩ := ncard_eq_one.mp ht,
+    rw mem_singleton_iff at hxt,
+    exact ⟨_,_,hxt,rfl⟩},
+  rintro ⟨x,y,hxy,rfl⟩,
+  rw [ncard_eq_to_finset_card, finset.card_eq_two],
+  exact ⟨x,y,hxy, by {ext, simp}⟩,
+end
+
+lemma ncard_eq_three : s.ncard = 3 ↔ ∃ x y z, x ≠ y ∧ x ≠ z ∧ y ≠ z ∧ s = {x, y, z} :=
+begin
+  classical,
+  refine ⟨λ h, _, _⟩,
+  { obtain ⟨x,t,hxt,rfl,ht⟩ :=  eq_insert_of_ncard_eq_succ h,
+    obtain ⟨y,z,hyz,rfl⟩ := ncard_eq_two.mp ht,
+    rw [mem_insert_iff, mem_singleton_iff, not_or_distrib] at hxt,
+    exact ⟨x,y,z,hxt.1,hxt.2,hyz,rfl⟩},
+  rintro ⟨x, y, z, xy, xz, yz, rfl⟩,
+  rw [ncard_insert_of_not_mem, ncard_insert_of_not_mem, ncard_singleton],
+  { rwa mem_singleton_iff},
+  rw [mem_insert_iff, mem_singleton_iff],
+  tauto,
+end
+
+end set
diff --git a/src/data/set/opposite.lean b/src/data/set/opposite.lean
index f2866a025d099..9a3786f567a47 100644
--- a/src/data/set/opposite.lean
+++ b/src/data/set/opposite.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Markus Himmel
 -/
 import data.opposite
-import data.set.basic
+import data.set.image
 
 /-!
 # The opposite of a set
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The opposite of a set `s` is simply the set obtained by taking the opposite of each member of `s`.
 -/
 
@@ -44,6 +47,10 @@ ext (by simp only [mem_unop, op_mem_op, iff_self, implies_true_iff])
 @[simp] lemma unop_op (s : set αᵒᵖ) : s.unop.op = s :=
 ext (by simp only [mem_op, unop_mem_unop, iff_self, implies_true_iff])
 
+/-- The members of the opposite of a set are in bijection with the members of the set itself. -/
+@[simps] def op_equiv_self (s : set α) : s.op ≃ s :=
+⟨λ x, ⟨unop x, x.2⟩, λ x, ⟨op x, x.2⟩, λ x, by simp, λ x, by simp⟩
+
 /-- Taking opposites as an equivalence of powersets. -/
 @[simps] def op_equiv : set α ≃ set αᵒᵖ :=
 ⟨set.op, set.unop, op_unop, unop_op⟩
diff --git a/src/data/set/pairwise.lean b/src/data/set/pairwise.lean
deleted file mode 100644
index 9cf16e6d3bad8..0000000000000
--- a/src/data/set/pairwise.lean
+++ /dev/null
@@ -1,391 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl
--/
-import data.set.lattice
-import logic.relation
-
-/-!
-# Relations holding pairwise
-
-This file defines pairwise relations and pairwise disjoint indexed sets.
-
-## Main declarations
-
-* `pairwise`: `pairwise r` states that `r i j` for all `i ≠ j`.
-* `set.pairwise`: `s.pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
-* `set.pairwise_disjoint`: `s.pairwise_disjoint f` states that images under `f` of distinct elements
-  of `s` are either equal or `disjoint`.
-
-## Notes
-
-The spelling `s.pairwise_disjoint id` is preferred over `s.pairwise disjoint` to permit dot notation
-on `set.pairwise_disjoint`, even though the latter unfolds to something nicer.
--/
-
-open set function
-
-variables {α ι ι' : Type*} {r p q : α → α → Prop}
-
-section pairwise
-variables {f g : ι → α} {s t u : set α} {a b : α}
-
-/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
-def pairwise (r : α → α → Prop) := ∀ i j, i ≠ j → r i j
-
-lemma pairwise.mono (hr : pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : pairwise p :=
-λ i j hij, h $ hr i j hij
-
-lemma pairwise_on_bool (hr : symmetric r) {a b : α} : pairwise (r on (λ c, cond c a b)) ↔ r a b :=
-by simpa [pairwise, function.on_fun] using @hr a b
-
-lemma pairwise_disjoint_on_bool [semilattice_inf α] [order_bot α] {a b : α} :
-  pairwise (disjoint on (λ c, cond c a b)) ↔ disjoint a b :=
-pairwise_on_bool disjoint.symm
-
-lemma symmetric.pairwise_on [linear_order ι] (hr : symmetric r) (f : ι → α) :
-  pairwise (r on f) ↔ ∀ m n, m < n → r (f m) (f n) :=
-⟨λ h m n hmn, h m n hmn.ne, λ h m n hmn, begin
-  obtain hmn' | hmn' := hmn.lt_or_lt,
-  { exact h _ _ hmn' },
-  { exact hr (h _ _ hmn') }
-end⟩
-
-lemma pairwise_disjoint_on [semilattice_inf α] [order_bot α] [linear_order ι] (f : ι → α) :
-  pairwise (disjoint on f) ↔ ∀ m n, m < n → disjoint (f m) (f n) :=
-symmetric.pairwise_on disjoint.symm f
-
-lemma pairwise_disjoint.mono [semilattice_inf α] [order_bot α]
-  (hs : pairwise (disjoint on f)) (h : g ≤ f) : pairwise (disjoint on g) :=
-hs.mono (λ i j hij, disjoint.mono (h i) (h j) hij)
-
-lemma function.injective_iff_pairwise_ne : injective f ↔ pairwise ((≠) on f) :=
-forall₂_congr $ λ i j, not_imp_not.symm
-
-alias function.injective_iff_pairwise_ne ↔ function.injective.pairwise_ne _
-
-namespace set
-
-/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
-protected def pairwise (s : set α) (r : α → α → Prop) := ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → r x y
-
-lemma pairwise_of_forall (s : set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.pairwise r :=
-λ a _ b _ _, h a b
-
-lemma pairwise.imp_on (h : s.pairwise r) (hrp : s.pairwise (λ ⦃a b : α⦄, r a b → p a b)) :
-  s.pairwise p :=
-λ a ha b hb hab, hrp ha hb hab $ h ha hb hab
-
-lemma pairwise.imp (h : s.pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.pairwise p :=
-h.imp_on $ pairwise_of_forall s _ hpq
-
-lemma pairwise.mono (h : t ⊆ s) (hs : s.pairwise r) : t.pairwise r :=
-λ x xt y yt, hs (h xt) (h yt)
-
-lemma pairwise.mono' (H : r ≤ p) (hr : s.pairwise r) : s.pairwise p := hr.imp H
-
-protected lemma pairwise.eq (hs : s.pairwise r) (ha : a ∈ s) (hb : b ∈ s) (h : ¬ r a b) : a = b :=
-of_not_not $ λ hab, h $ hs ha hb hab
-
-lemma pairwise_top (s : set α) : s.pairwise ⊤ := pairwise_of_forall s _ (λ a b, trivial)
-
-protected lemma subsingleton.pairwise (h : s.subsingleton) (r : α → α → Prop) :
-  s.pairwise r :=
-λ x hx y hy hne, (hne (h hx hy)).elim
-
-@[simp] lemma pairwise_empty (r : α → α → Prop) : (∅ : set α).pairwise r :=
-subsingleton_empty.pairwise r
-
-@[simp] lemma pairwise_singleton (a : α) (r : α → α → Prop) : set.pairwise {a} r :=
-subsingleton_singleton.pairwise r
-
-lemma pairwise_iff_of_refl [is_refl α r] : s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
-forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp of_eq
-
-alias pairwise_iff_of_refl ↔ set.pairwise.of_refl _
-
-lemma _root_.reflexive.set_pairwise_iff (hr : reflexive r) :
-  s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
-forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp $ eq.rec $ hr a
-
-lemma nonempty.pairwise_iff_exists_forall [is_equiv α r] {s : set ι} (hs : s.nonempty) :
-  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
-begin
-  fsplit,
-  { rcases hs with ⟨y, hy⟩,
-    refine λ H, ⟨f y, λ x hx, _⟩,
-    rcases eq_or_ne x y with rfl|hne,
-    { apply is_refl.refl },
-    { exact H hx hy hne } },
-  { rintro ⟨z, hz⟩ x hx y hy hne,
-    exact @is_trans.trans α r _ (f x) z (f y) (hz _ hx) (is_symm.symm _ _ $ hz _ hy) }
-end
-
-/-- For a nonempty set `s`, a function `f` takes pairwise equal values on `s` if and only if
-for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
-`set.pairwise_eq_iff_exists_eq` for a version that assumes `[nonempty ι]` instead of
-`set.nonempty s`. -/
-lemma nonempty.pairwise_eq_iff_exists_eq {s : set α} (hs : s.nonempty) {f : α → ι} :
-  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
-hs.pairwise_iff_exists_forall
-
-lemma pairwise_iff_exists_forall [nonempty ι] (s : set α) (f : α → ι) {r : ι → ι → Prop}
-  [is_equiv ι r] :
-  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
-begin
-  rcases s.eq_empty_or_nonempty with rfl|hne,
-  { simp },
-  { exact hne.pairwise_iff_exists_forall }
-end
-
-/-- A function `f : α → ι` with nonempty codomain takes pairwise equal values on a set `s` if and
-only if for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
-`set.nonempty.pairwise_eq_iff_exists_eq` for a version that assumes `set.nonempty s` instead of
-`[nonempty ι]`. -/
-lemma pairwise_eq_iff_exists_eq [nonempty ι] (s : set α) (f : α → ι) :
-  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
-pairwise_iff_exists_forall s f
-
-lemma pairwise_union :
-  (s ∪ t).pairwise r ↔
-    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b ∧ r b a :=
-begin
-  simp only [set.pairwise, mem_union_eq, or_imp_distrib, forall_and_distrib],
-  exact ⟨λ H, ⟨H.1.1, H.2.2, H.2.1, λ x hx y hy hne, H.1.2 y hy x hx hne.symm⟩,
-    λ H, ⟨⟨H.1, λ x hx y hy hne, H.2.2.2 y hy x hx hne.symm⟩, H.2.2.1, H.2.1⟩⟩
-end
-
-lemma pairwise_union_of_symmetric (hr : symmetric r) :
-  (s ∪ t).pairwise r ↔
-    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b :=
-pairwise_union.trans $ by simp only [hr.iff, and_self]
-
-lemma pairwise_insert :
-  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b ∧ r b a :=
-by simp only [insert_eq, pairwise_union, pairwise_singleton, true_and,
-  mem_singleton_iff, forall_eq]
-
-lemma pairwise.insert (hs : s.pairwise r) (h : ∀ b ∈ s, a ≠ b → r a b ∧ r b a) :
-  (insert a s).pairwise r :=
-pairwise_insert.2 ⟨hs, h⟩
-
-lemma pairwise_insert_of_symmetric (hr : symmetric r) :
-  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b :=
-by simp only [pairwise_insert, hr.iff a, and_self]
-
-lemma pairwise.insert_of_symmetric (hs : s.pairwise r) (hr : symmetric r)
-  (h : ∀ b ∈ s, a ≠ b → r a b) :
-  (insert a s).pairwise r :=
-(pairwise_insert_of_symmetric hr).2 ⟨hs, h⟩
-
-lemma pairwise_pair : set.pairwise {a, b} r ↔ (a ≠ b → r a b ∧ r b a) :=
-by simp [pairwise_insert]
-
-lemma pairwise_pair_of_symmetric (hr : symmetric r) : set.pairwise {a, b} r ↔ (a ≠ b → r a b) :=
-by simp [pairwise_insert_of_symmetric hr]
-
-lemma pairwise_univ : (univ : set α).pairwise r ↔ pairwise r :=
-by simp only [set.pairwise, pairwise, mem_univ, forall_const]
-
-@[simp] lemma pairwise_bot_iff : s.pairwise (⊥ : α → α → Prop) ↔ (s : set α).subsingleton :=
-⟨λ h a ha b hb, h.eq ha hb id, λ h, h.pairwise _⟩
-
-alias pairwise_bot_iff ↔ set.pairwise.subsingleton _
-
-lemma pairwise.on_injective (hs : s.pairwise r) (hf : function.injective f)
-  (hfs : ∀ x, f x ∈ s) :
-  pairwise (r on f) :=
-λ i j hij, hs (hfs i) (hfs j) (hf.ne hij)
-
-lemma inj_on.pairwise_image {s : set ι} (h : s.inj_on f) :
-  (f '' s).pairwise r ↔ s.pairwise (r on f) :=
-by simp [h.eq_iff, set.pairwise] {contextual := tt}
-
-lemma pairwise_Union {f : ι → set α} (h : directed (⊆) f) :
-  (⋃ n, f n).pairwise r ↔ ∀ n, (f n).pairwise r :=
-begin
-  split,
-  { assume H n,
-    exact pairwise.mono (subset_Union _ _) H },
-  { assume H i hi j hj hij,
-    rcases mem_Union.1 hi with ⟨m, hm⟩,
-    rcases mem_Union.1 hj with ⟨n, hn⟩,
-    rcases h m n with ⟨p, mp, np⟩,
-    exact H p (mp hm) (np hn) hij }
-end
-
-lemma pairwise_sUnion {r : α → α → Prop} {s : set (set α)} (h : directed_on (⊆) s) :
-  (⋃₀ s).pairwise r ↔ (∀ a ∈ s, set.pairwise a r) :=
-by { rw [sUnion_eq_Union, pairwise_Union (h.directed_coe), set_coe.forall], refl }
-
-end set
-
-lemma pairwise.set_pairwise (h : pairwise r) (s : set α) : s.pairwise r := λ x hx y hy, h x y
-
-end pairwise
-
-lemma pairwise_subtype_iff_pairwise_set {α : Type*} (s : set α) (r : α → α → Prop) :
-  pairwise (λ (x : s) (y : s), r x y) ↔ s.pairwise r :=
-begin
-  split,
-  { assume h x hx y hy hxy,
-    exact h ⟨x, hx⟩ ⟨y, hy⟩ (by simpa only [subtype.mk_eq_mk, ne.def]) },
-  { rintros h ⟨x, hx⟩ ⟨y, hy⟩ hxy,
-    simp only [subtype.mk_eq_mk, ne.def] at hxy,
-    exact h hx hy hxy }
-end
-
-alias pairwise_subtype_iff_pairwise_set ↔ pairwise.set_of_subtype set.pairwise.subtype
-
-namespace set
-section semilattice_inf_bot
-variables [semilattice_inf α] [order_bot α] {s t : set ι} {f g : ι → α}
-
-/-- A set is `pairwise_disjoint` under `f`, if the images of any distinct two elements under `f`
-are disjoint.
-
-`s.pairwise disjoint` is (definitionally) the same as `s.pairwise_disjoint id`. We prefer the latter
-in order to allow dot notation on `set.pairwise_disjoint`, even though the former unfolds more
-nicely. -/
-def pairwise_disjoint (s : set ι) (f : ι → α) : Prop := s.pairwise (disjoint on f)
-
-lemma pairwise_disjoint.subset (ht : t.pairwise_disjoint f) (h : s ⊆ t) : s.pairwise_disjoint f :=
-pairwise.mono h ht
-
-lemma pairwise_disjoint.mono_on (hs : s.pairwise_disjoint f) (h : ∀ ⦃i⦄, i ∈ s → g i ≤ f i) :
-  s.pairwise_disjoint g :=
-λ a ha b hb hab, (hs ha hb hab).mono (h ha) (h hb)
-
-lemma pairwise_disjoint.mono (hs : s.pairwise_disjoint f) (h : g ≤ f) : s.pairwise_disjoint g :=
-hs.mono_on (λ i _, h i)
-
-@[simp] lemma pairwise_disjoint_empty : (∅ : set ι).pairwise_disjoint f := pairwise_empty _
-
-@[simp] lemma pairwise_disjoint_singleton (i : ι) (f : ι → α) : pairwise_disjoint {i} f :=
-pairwise_singleton i _
-
-lemma pairwise_disjoint_insert {i : ι} :
-  (insert i s).pairwise_disjoint f
-    ↔ s.pairwise_disjoint f ∧ ∀ j ∈ s, i ≠ j → disjoint (f i) (f j) :=
-set.pairwise_insert_of_symmetric $ symmetric_disjoint.comap f
-
-lemma pairwise_disjoint.insert (hs : s.pairwise_disjoint f) {i : ι}
-  (h : ∀ j ∈ s, i ≠ j → disjoint (f i) (f j)) :
-  (insert i s).pairwise_disjoint f :=
-set.pairwise_disjoint_insert.2 ⟨hs, h⟩
-
-lemma pairwise_disjoint.image_of_le (hs : s.pairwise_disjoint f) {g : ι → ι} (hg : f ∘ g ≤ f) :
-  (g '' s).pairwise_disjoint f :=
-begin
-  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ h,
-  exact (hs ha hb $ ne_of_apply_ne _ h).mono (hg a) (hg b),
-end
-
-lemma inj_on.pairwise_disjoint_image {g : ι' → ι} {s : set ι'} (h : s.inj_on g) :
-  (g '' s).pairwise_disjoint f ↔ s.pairwise_disjoint (f ∘ g) :=
-h.pairwise_image
-
-lemma pairwise_disjoint.range (g : s → ι) (hg : ∀ (i : s), f (g i) ≤ f i)
-  (ht : s.pairwise_disjoint f) :
-  (range g).pairwise_disjoint f :=
-begin
-  rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ hxy,
-  exact (ht x.2 y.2 $ λ h, hxy $ congr_arg g $ subtype.ext h).mono (hg x) (hg y),
-end
-
-lemma pairwise_disjoint_union :
-  (s ∪ t).pairwise_disjoint f ↔ s.pairwise_disjoint f ∧ t.pairwise_disjoint f ∧
-    ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j) :=
-pairwise_union_of_symmetric $ symmetric_disjoint.comap f
-
-lemma pairwise_disjoint.union (hs : s.pairwise_disjoint f) (ht : t.pairwise_disjoint f)
-  (h : ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j)) :
-  (s ∪ t).pairwise_disjoint f :=
-pairwise_disjoint_union.2 ⟨hs, ht, h⟩
-
-lemma pairwise_disjoint_Union {g : ι' → set ι} (h : directed (⊆) g) :
-  (⋃ n, g n).pairwise_disjoint f ↔ ∀ ⦃n⦄, (g n).pairwise_disjoint f :=
-pairwise_Union h
-
-lemma pairwise_disjoint_sUnion {s : set (set ι)} (h : directed_on (⊆) s) :
-  (⋃₀ s).pairwise_disjoint f ↔ ∀ ⦃a⦄, a ∈ s → set.pairwise_disjoint a f :=
-pairwise_sUnion h
-
--- classical
-lemma pairwise_disjoint.elim (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
-  (h : ¬ disjoint (f i) (f j)) :
-  i = j :=
-hs.eq hi hj h
-
--- classical
-lemma pairwise_disjoint.elim' (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
-  (h : f i ⊓ f j ≠ ⊥) :
-  i = j :=
-hs.elim hi hj $ λ hij, h hij.eq_bot
-
-lemma pairwise_disjoint.eq_of_le (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
-  (hf : f i ≠ ⊥) (hij : f i ≤ f j) :
-  i = j :=
-hs.elim' hi hj $ λ h, hf $ (inf_of_le_left hij).symm.trans h
-
-end semilattice_inf_bot
-
-section complete_lattice
-variables [complete_lattice α]
-
-/-- Bind operation for `set.pairwise_disjoint`. If you want to only consider finsets of indices, you
-can use `set.pairwise_disjoint.bUnion_finset`. -/
-lemma pairwise_disjoint.bUnion {s : set ι'} {g : ι' → set ι} {f : ι → α}
-  (hs : s.pairwise_disjoint (λ i' : ι', ⨆ i ∈ g i', f i))
-  (hg : ∀ i ∈ s, (g i).pairwise_disjoint f) :
-  (⋃ i ∈ s, g i).pairwise_disjoint f :=
-begin
-  rintro a ha b hb hab,
-  simp_rw set.mem_Union at ha hb,
-  obtain ⟨c, hc, ha⟩ := ha,
-  obtain ⟨d, hd, hb⟩ := hb,
-  obtain hcd | hcd := eq_or_ne (g c) (g d),
-  { exact hg d hd (hcd.subst ha) hb hab },
-  { exact (hs hc hd $ ne_of_apply_ne _ hcd).mono (le_supr₂ a ha) (le_supr₂ b hb) }
-end
-
-end complete_lattice
-
-/-! ### Pairwise disjoint set of sets -/
-
-lemma pairwise_disjoint_range_singleton :
-  (set.range (singleton : ι → set ι)).pairwise_disjoint id :=
-begin
-  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
-  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
-end
-
-lemma pairwise_disjoint_fiber (f : ι → α) (s : set α) : s.pairwise_disjoint (λ a, f ⁻¹' {a}) :=
-λ a _ b _ h i ⟨hia, hib⟩, h $ (eq.symm hia).trans hib
-
--- classical
-lemma pairwise_disjoint.elim_set {s : set ι} {f : ι → set α} (hs : s.pairwise_disjoint f) {i j : ι}
-  (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i) (haj : a ∈ f j) : i = j :=
-hs.elim hi hj $ not_disjoint_iff.2 ⟨a, hai, haj⟩
-
-lemma bUnion_diff_bUnion_eq {s t : set ι} {f : ι → set α} (h : (s ∪ t).pairwise_disjoint f) :
-  (⋃ i ∈ s, f i) \ (⋃ i ∈ t, f i) = (⋃ i ∈ s \ t, f i) :=
-begin
-  refine (bUnion_diff_bUnion_subset f s t).antisymm
-    (Union₂_subset $ λ i hi a ha, (mem_diff _).2 ⟨mem_bUnion hi.1 ha, _⟩),
-  rw mem_Union₂, rintro ⟨j, hj, haj⟩,
-  exact h (or.inl hi.1) (or.inr hj) (ne_of_mem_of_not_mem hj hi.2).symm ⟨ha, haj⟩,
-end
-
-/-- Equivalence between a disjoint bounded union and a dependent sum. -/
-noncomputable def bUnion_eq_sigma_of_disjoint {s : set ι} {f : ι → set α}
-  (h : s.pairwise_disjoint f) :
-  (⋃ i ∈ s, f i) ≃ (Σ i : s, f i) :=
-(equiv.set_congr (bUnion_eq_Union _ _)).trans $ Union_eq_sigma_of_disjoint $
-  λ ⟨i, hi⟩ ⟨j, hj⟩ ne, h hi hj $ λ eq, ne $ subtype.eq eq
-
-end set
-
-lemma pairwise_disjoint_fiber (f : ι → α) : pairwise (disjoint on (λ a : α, f ⁻¹' {a})) :=
-set.pairwise_univ.1 $ set.pairwise_disjoint_fiber f univ
diff --git a/src/data/set/pairwise/basic.lean b/src/data/set/pairwise/basic.lean
new file mode 100644
index 0000000000000..25b2a2fac226e
--- /dev/null
+++ b/src/data/set/pairwise/basic.lean
@@ -0,0 +1,365 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import data.set.function
+import logic.relation
+import logic.pairwise
+
+/-!
+# Relations holding pairwise
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file develops pairwise relations and defines pairwise disjoint indexed sets.
+
+We also prove many basic facts about `pairwise`. It is possible that an intermediate file,
+with more imports than `logic.pairwise` but not importing `data.set.function` would be appropriate
+to hold many of these basic facts.
+
+## Main declarations
+
+* `set.pairwise_disjoint`: `s.pairwise_disjoint f` states that images under `f` of distinct elements
+  of `s` are either equal or `disjoint`.
+
+## Notes
+
+The spelling `s.pairwise_disjoint id` is preferred over `s.pairwise disjoint` to permit dot notation
+on `set.pairwise_disjoint`, even though the latter unfolds to something nicer.
+-/
+
+open function order set
+
+variables {α β γ ι ι' : Type*} {r p q : α → α → Prop}
+
+section pairwise
+variables {f g : ι → α} {s t u : set α} {a b : α}
+
+lemma pairwise_on_bool (hr : symmetric r) {a b : α} : pairwise (r on (λ c, cond c a b)) ↔ r a b :=
+by simpa [pairwise, function.on_fun] using @hr a b
+
+lemma pairwise_disjoint_on_bool [semilattice_inf α] [order_bot α] {a b : α} :
+  pairwise (disjoint on (λ c, cond c a b)) ↔ disjoint a b :=
+pairwise_on_bool disjoint.symm
+
+lemma symmetric.pairwise_on [linear_order ι] (hr : symmetric r) (f : ι → α) :
+  pairwise (r on f) ↔ ∀ ⦃m n⦄, m < n → r (f m) (f n) :=
+⟨λ h m n hmn, h hmn.ne, λ h m n hmn, hmn.lt_or_lt.elim (@h _ _) (λ h', hr (h h'))⟩
+
+lemma pairwise_disjoint_on [semilattice_inf α] [order_bot α] [linear_order ι] (f : ι → α) :
+  pairwise (disjoint on f) ↔ ∀ ⦃m n⦄, m < n → disjoint (f m) (f n) :=
+symmetric.pairwise_on disjoint.symm f
+
+lemma pairwise_disjoint.mono [semilattice_inf α] [order_bot α]
+  (hs : pairwise (disjoint on f)) (h : g ≤ f) : pairwise (disjoint on g) :=
+hs.mono (λ i j hij, disjoint.mono (h i) (h j) hij)
+
+namespace set
+
+lemma pairwise.mono (h : t ⊆ s) (hs : s.pairwise r) : t.pairwise r :=
+λ x xt y yt, hs (h xt) (h yt)
+
+lemma pairwise.mono' (H : r ≤ p) (hr : s.pairwise r) : s.pairwise p := hr.imp H
+
+lemma pairwise_top (s : set α) : s.pairwise ⊤ := pairwise_of_forall s _ (λ a b, trivial)
+
+protected lemma subsingleton.pairwise (h : s.subsingleton) (r : α → α → Prop) :
+  s.pairwise r :=
+λ x hx y hy hne, (hne (h hx hy)).elim
+
+@[simp] lemma pairwise_empty (r : α → α → Prop) : (∅ : set α).pairwise r :=
+subsingleton_empty.pairwise r
+
+@[simp] lemma pairwise_singleton (a : α) (r : α → α → Prop) : set.pairwise {a} r :=
+subsingleton_singleton.pairwise r
+
+lemma pairwise_iff_of_refl [is_refl α r] : s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
+forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp of_eq
+
+alias pairwise_iff_of_refl ↔ pairwise.of_refl _
+
+lemma nonempty.pairwise_iff_exists_forall [is_equiv α r] {s : set ι} (hs : s.nonempty) :
+  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
+begin
+  fsplit,
+  { rcases hs with ⟨y, hy⟩,
+    refine λ H, ⟨f y, λ x hx, _⟩,
+    rcases eq_or_ne x y with rfl|hne,
+    { apply is_refl.refl },
+    { exact H hx hy hne } },
+  { rintro ⟨z, hz⟩ x hx y hy hne,
+    exact @is_trans.trans α r _ (f x) z (f y) (hz _ hx) (is_symm.symm _ _ $ hz _ hy) }
+end
+
+/-- For a nonempty set `s`, a function `f` takes pairwise equal values on `s` if and only if
+for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
+`set.pairwise_eq_iff_exists_eq` for a version that assumes `[nonempty ι]` instead of
+`set.nonempty s`. -/
+lemma nonempty.pairwise_eq_iff_exists_eq {s : set α} (hs : s.nonempty) {f : α → ι} :
+  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
+hs.pairwise_iff_exists_forall
+
+lemma pairwise_iff_exists_forall [nonempty ι] (s : set α) (f : α → ι) {r : ι → ι → Prop}
+  [is_equiv ι r] :
+  (s.pairwise (r on f)) ↔ ∃ z, ∀ x ∈ s, r (f x) z :=
+begin
+  rcases s.eq_empty_or_nonempty with rfl|hne,
+  { simp },
+  { exact hne.pairwise_iff_exists_forall }
+end
+
+/-- A function `f : α → ι` with nonempty codomain takes pairwise equal values on a set `s` if and
+only if for some `z` in the codomain, `f` takes value `z` on all `x ∈ s`. See also
+`set.nonempty.pairwise_eq_iff_exists_eq` for a version that assumes `set.nonempty s` instead of
+`[nonempty ι]`. -/
+lemma pairwise_eq_iff_exists_eq [nonempty ι] (s : set α) (f : α → ι) :
+  (s.pairwise (λ x y, f x = f y)) ↔ ∃ z, ∀ x ∈ s, f x = z :=
+pairwise_iff_exists_forall s f
+
+lemma pairwise_union :
+  (s ∪ t).pairwise r ↔
+    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b ∧ r b a :=
+begin
+  simp only [set.pairwise, mem_union, or_imp_distrib, forall_and_distrib],
+  exact ⟨λ H, ⟨H.1.1, H.2.2, H.2.1, λ x hx y hy hne, H.1.2 y hy x hx hne.symm⟩,
+    λ H, ⟨⟨H.1, λ x hx y hy hne, H.2.2.2 y hy x hx hne.symm⟩, H.2.2.1, H.2.1⟩⟩
+end
+
+lemma pairwise_union_of_symmetric (hr : symmetric r) :
+  (s ∪ t).pairwise r ↔
+    s.pairwise r ∧ t.pairwise r ∧ ∀ (a ∈ s) (b ∈ t), a ≠ b → r a b :=
+pairwise_union.trans $ by simp only [hr.iff, and_self]
+
+lemma pairwise_insert :
+  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b ∧ r b a :=
+by simp only [insert_eq, pairwise_union, pairwise_singleton, true_and,
+  mem_singleton_iff, forall_eq]
+
+lemma pairwise_insert_of_not_mem (ha : a ∉ s) :
+  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, r a b ∧ r b a :=
+pairwise_insert.trans $ and_congr_right' $ forall₂_congr $ λ b hb,
+  by simp [(ne_of_mem_of_not_mem hb ha).symm]
+
+lemma pairwise.insert (hs : s.pairwise r) (h : ∀ b ∈ s, a ≠ b → r a b ∧ r b a) :
+  (insert a s).pairwise r :=
+pairwise_insert.2 ⟨hs, h⟩
+
+lemma pairwise.insert_of_not_mem (ha : a ∉ s) (hs : s.pairwise r) (h : ∀ b ∈ s, r a b ∧ r b a) :
+  (insert a s).pairwise r :=
+(pairwise_insert_of_not_mem ha).2 ⟨hs, h⟩
+
+lemma pairwise_insert_of_symmetric (hr : symmetric r) :
+  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, a ≠ b → r a b :=
+by simp only [pairwise_insert, hr.iff a, and_self]
+
+lemma pairwise_insert_of_symmetric_of_not_mem (hr : symmetric r) (ha : a ∉ s) :
+  (insert a s).pairwise r ↔ s.pairwise r ∧ ∀ b ∈ s, r a b :=
+by simp only [pairwise_insert_of_not_mem ha, hr.iff a, and_self]
+
+lemma pairwise.insert_of_symmetric (hs : s.pairwise r) (hr : symmetric r)
+  (h : ∀ b ∈ s, a ≠ b → r a b) :
+  (insert a s).pairwise r :=
+(pairwise_insert_of_symmetric hr).2 ⟨hs, h⟩
+
+lemma pairwise.insert_of_symmetric_of_not_mem (hs : s.pairwise r) (hr : symmetric r) (ha : a ∉ s)
+  (h : ∀ b ∈ s, r a b) :
+  (insert a s).pairwise r :=
+(pairwise_insert_of_symmetric_of_not_mem hr ha).2 ⟨hs, h⟩
+
+lemma pairwise_pair : set.pairwise {a, b} r ↔ (a ≠ b → r a b ∧ r b a) :=
+by simp [pairwise_insert]
+
+lemma pairwise_pair_of_symmetric (hr : symmetric r) : set.pairwise {a, b} r ↔ (a ≠ b → r a b) :=
+by simp [pairwise_insert_of_symmetric hr]
+
+lemma pairwise_univ : (univ : set α).pairwise r ↔ pairwise r :=
+by simp only [set.pairwise, pairwise, mem_univ, forall_const]
+
+@[simp] lemma pairwise_bot_iff : s.pairwise (⊥ : α → α → Prop) ↔ (s : set α).subsingleton :=
+⟨λ h a ha b hb, h.eq ha hb id, λ h, h.pairwise _⟩
+
+alias pairwise_bot_iff ↔ pairwise.subsingleton _
+
+lemma inj_on.pairwise_image {s : set ι} (h : s.inj_on f) :
+  (f '' s).pairwise r ↔ s.pairwise (r on f) :=
+by simp [h.eq_iff, set.pairwise] {contextual := tt}
+
+end set
+
+end pairwise
+
+lemma pairwise_subtype_iff_pairwise_set (s : set α) (r : α → α → Prop) :
+  pairwise (λ (x : s) (y : s), r x y) ↔ s.pairwise r :=
+by simp only [pairwise, set.pairwise, set_coe.forall, ne.def, subtype.ext_iff, subtype.coe_mk]
+
+alias pairwise_subtype_iff_pairwise_set ↔ pairwise.set_of_subtype set.pairwise.subtype
+
+namespace set
+section partial_order_bot
+variables [partial_order α] [order_bot α] {s t : set ι} {f g : ι → α}
+
+/-- A set is `pairwise_disjoint` under `f`, if the images of any distinct two elements under `f`
+are disjoint.
+
+`s.pairwise disjoint` is (definitionally) the same as `s.pairwise_disjoint id`. We prefer the latter
+in order to allow dot notation on `set.pairwise_disjoint`, even though the former unfolds more
+nicely. -/
+def pairwise_disjoint (s : set ι) (f : ι → α) : Prop := s.pairwise (disjoint on f)
+
+lemma pairwise_disjoint.subset (ht : t.pairwise_disjoint f) (h : s ⊆ t) : s.pairwise_disjoint f :=
+pairwise.mono h ht
+
+lemma pairwise_disjoint.mono_on (hs : s.pairwise_disjoint f) (h : ∀ ⦃i⦄, i ∈ s → g i ≤ f i) :
+  s.pairwise_disjoint g :=
+λ a ha b hb hab, (hs ha hb hab).mono (h ha) (h hb)
+
+lemma pairwise_disjoint.mono (hs : s.pairwise_disjoint f) (h : g ≤ f) : s.pairwise_disjoint g :=
+hs.mono_on (λ i _, h i)
+
+@[simp] lemma pairwise_disjoint_empty : (∅ : set ι).pairwise_disjoint f := pairwise_empty _
+
+@[simp] lemma pairwise_disjoint_singleton (i : ι) (f : ι → α) : pairwise_disjoint {i} f :=
+pairwise_singleton i _
+
+lemma pairwise_disjoint_insert {i : ι} :
+  (insert i s).pairwise_disjoint f
+    ↔ s.pairwise_disjoint f ∧ ∀ j ∈ s, i ≠ j → disjoint (f i) (f j) :=
+set.pairwise_insert_of_symmetric $ symmetric_disjoint.comap f
+
+lemma pairwise_disjoint_insert_of_not_mem {i : ι} (hi : i ∉ s) :
+  (insert i s).pairwise_disjoint f ↔ s.pairwise_disjoint f ∧ ∀ j ∈ s, disjoint (f i) (f j) :=
+pairwise_insert_of_symmetric_of_not_mem (symmetric_disjoint.comap f) hi
+
+lemma pairwise_disjoint.insert (hs : s.pairwise_disjoint f) {i : ι}
+  (h : ∀ j ∈ s, i ≠ j → disjoint (f i) (f j)) :
+  (insert i s).pairwise_disjoint f :=
+set.pairwise_disjoint_insert.2 ⟨hs, h⟩
+
+lemma pairwise_disjoint.insert_of_not_mem (hs : s.pairwise_disjoint f) {i : ι} (hi : i ∉ s)
+  (h : ∀ j ∈ s, disjoint (f i) (f j)) :
+  (insert i s).pairwise_disjoint f :=
+(set.pairwise_disjoint_insert_of_not_mem hi).2 ⟨hs, h⟩
+
+lemma pairwise_disjoint.image_of_le (hs : s.pairwise_disjoint f) {g : ι → ι} (hg : f ∘ g ≤ f) :
+  (g '' s).pairwise_disjoint f :=
+begin
+  rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩ h,
+  exact (hs ha hb $ ne_of_apply_ne _ h).mono (hg a) (hg b),
+end
+
+lemma inj_on.pairwise_disjoint_image {g : ι' → ι} {s : set ι'} (h : s.inj_on g) :
+  (g '' s).pairwise_disjoint f ↔ s.pairwise_disjoint (f ∘ g) :=
+h.pairwise_image
+
+lemma pairwise_disjoint.range (g : s → ι) (hg : ∀ (i : s), f (g i) ≤ f i)
+  (ht : s.pairwise_disjoint f) :
+  (range g).pairwise_disjoint f :=
+begin
+  rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ hxy,
+  exact (ht x.2 y.2 $ λ h, hxy $ congr_arg g $ subtype.ext h).mono (hg x) (hg y),
+end
+
+lemma pairwise_disjoint_union :
+  (s ∪ t).pairwise_disjoint f ↔ s.pairwise_disjoint f ∧ t.pairwise_disjoint f ∧
+    ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j) :=
+pairwise_union_of_symmetric $ symmetric_disjoint.comap f
+
+lemma pairwise_disjoint.union (hs : s.pairwise_disjoint f) (ht : t.pairwise_disjoint f)
+  (h : ∀ ⦃i⦄, i ∈ s → ∀ ⦃j⦄, j ∈ t → i ≠ j → disjoint (f i) (f j)) :
+  (s ∪ t).pairwise_disjoint f :=
+pairwise_disjoint_union.2 ⟨hs, ht, h⟩
+
+-- classical
+lemma pairwise_disjoint.elim (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
+  (h : ¬ disjoint (f i) (f j)) :
+  i = j :=
+hs.eq hi hj h
+
+end partial_order_bot
+
+section semilattice_inf_bot
+variables [semilattice_inf α] [order_bot α] {s t : set ι} {f g : ι → α}
+-- classical
+lemma pairwise_disjoint.elim' (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
+  (h : f i ⊓ f j ≠ ⊥) :
+  i = j :=
+hs.elim hi hj $ λ hij, h hij.eq_bot
+
+lemma pairwise_disjoint.eq_of_le (hs : s.pairwise_disjoint f) {i j : ι} (hi : i ∈ s) (hj : j ∈ s)
+  (hf : f i ≠ ⊥) (hij : f i ≤ f j) :
+  i = j :=
+hs.elim' hi hj $ λ h, hf $ (inf_of_le_left hij).symm.trans h
+
+end semilattice_inf_bot
+
+/-! ### Pairwise disjoint set of sets -/
+
+variables {s : set ι} {t : set ι'}
+
+lemma pairwise_disjoint_range_singleton :
+  (set.range (singleton : ι → set ι)).pairwise_disjoint id :=
+begin
+  rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ h,
+  exact disjoint_singleton.2 (ne_of_apply_ne _ h),
+end
+
+lemma pairwise_disjoint_fiber (f : ι → α) (s : set α) : s.pairwise_disjoint (λ a, f ⁻¹' {a}) :=
+λ a _ b _ h, disjoint_iff_inf_le.mpr $ λ i ⟨hia, hib⟩, h $ (eq.symm hia).trans hib
+
+-- classical
+lemma pairwise_disjoint.elim_set {s : set ι} {f : ι → set α} (hs : s.pairwise_disjoint f) {i j : ι}
+  (hi : i ∈ s) (hj : j ∈ s) (a : α) (hai : a ∈ f i) (haj : a ∈ f j) : i = j :=
+hs.elim hi hj $ not_disjoint_iff.2 ⟨a, hai, haj⟩
+
+lemma pairwise_disjoint.prod {f : ι → set α} {g : ι' → set β} (hs : s.pairwise_disjoint f)
+  (ht : t.pairwise_disjoint g) :
+  (s ×ˢ t : set (ι × ι')).pairwise_disjoint (λ i, f i.1 ×ˢ g i.2) :=
+λ ⟨i, i'⟩ ⟨hi, hi'⟩ ⟨j, j'⟩ ⟨hj, hj'⟩ hij, disjoint_left.2 $ λ ⟨a, b⟩ ⟨hai, hbi⟩ ⟨haj, hbj⟩,
+  hij $ prod.ext (hs.elim_set hi hj _ hai haj) $ ht.elim_set hi' hj' _ hbi hbj
+
+lemma pairwise_disjoint_pi {ι' α : ι → Type*} {s : Π i, set (ι' i)} {f : Π i, ι' i → set (α i)}
+  (hs : ∀ i, (s i).pairwise_disjoint (f i)) :
+  ((univ : set ι).pi s).pairwise_disjoint (λ I, (univ : set ι).pi (λ i, f _ (I i))) :=
+λ I hI J hJ hIJ, disjoint_left.2 $ λ a haI haJ, hIJ $ funext $ λ i,
+  (hs i).elim_set (hI i trivial) (hJ i trivial) (a i) (haI i trivial) (haJ i trivial)
+
+/-- The partial images of a binary function `f` whose partial evaluations are injective are pairwise
+disjoint iff `f` is injective . -/
+lemma pairwise_disjoint_image_right_iff {f : α → β → γ} {s : set α} {t : set β}
+  (hf : ∀ a ∈ s, injective (f a)) :
+  s.pairwise_disjoint (λ a, f a '' t) ↔ (s ×ˢ t).inj_on (λ p, f p.1 p.2) :=
+begin
+  refine ⟨λ hs x hx y hy (h : f _ _ = _), _, λ hs x hx y hy h, _⟩,
+  { suffices : x.1 = y.1,
+    { exact prod.ext this (hf _ hx.1 $ h.trans $ by rw this) },
+    refine hs.elim hx.1 hy.1 (not_disjoint_iff.2 ⟨_, mem_image_of_mem _ hx.2, _⟩),
+    rw h,
+    exact mem_image_of_mem _ hy.2 },
+  { refine disjoint_iff_inf_le.mpr _,
+    rintro _ ⟨⟨a, ha, hab⟩, b, hb, rfl⟩,
+    exact h (congr_arg prod.fst $ hs (mk_mem_prod hx ha) (mk_mem_prod hy hb) hab) }
+end
+
+/-- The partial images of a binary function `f` whose partial evaluations are injective are pairwise
+disjoint iff `f` is injective . -/
+lemma pairwise_disjoint_image_left_iff {f : α → β → γ} {s : set α} {t : set β}
+  (hf : ∀ b ∈ t, injective (λ a, f a b)) :
+  t.pairwise_disjoint (λ b, (λ a, f a b) '' s) ↔ (s ×ˢ t).inj_on (λ p, f p.1 p.2) :=
+begin
+  refine ⟨λ ht x hx y hy (h : f _ _ = _), _, λ ht x hx y hy h, _⟩,
+  { suffices : x.2 = y.2,
+    { exact prod.ext (hf _ hx.2 $ h.trans $ by rw this) this },
+    refine ht.elim hx.2 hy.2 (not_disjoint_iff.2 ⟨_, mem_image_of_mem _ hx.1, _⟩),
+    rw h,
+    exact mem_image_of_mem _ hy.1 },
+  { refine disjoint_iff_inf_le.mpr _,
+    rintro _ ⟨⟨a, ha, hab⟩, b, hb, rfl⟩,
+    exact h (congr_arg prod.snd $ ht (mk_mem_prod ha hx) (mk_mem_prod hb hy) hab) }
+end
+
+end set
+
+lemma pairwise_disjoint_fiber (f : ι → α) : pairwise (disjoint on (λ a : α, f ⁻¹' {a})) :=
+set.pairwise_univ.1 $ set.pairwise_disjoint_fiber f univ
diff --git a/src/data/set/pairwise/lattice.lean b/src/data/set/pairwise/lattice.lean
new file mode 100644
index 0000000000000..3382d20222314
--- /dev/null
+++ b/src/data/set/pairwise/lattice.lean
@@ -0,0 +1,159 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import data.set.lattice
+import data.set.pairwise.basic
+
+/-!
+# Relations holding pairwise
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove many facts about `pairwise` and the set lattice.
+-/
+
+open function set order
+
+variables {α β γ ι ι' : Type*} {κ : Sort*} {r p q : α → α → Prop}
+
+section pairwise
+variables {f g : ι → α} {s t u : set α} {a b : α}
+
+namespace set
+
+lemma pairwise_Union {f : κ → set α} (h : directed (⊆) f) :
+  (⋃ n, f n).pairwise r ↔ ∀ n, (f n).pairwise r :=
+begin
+  split,
+  { assume H n,
+    exact pairwise.mono (subset_Union _ _) H },
+  { assume H i hi j hj hij,
+    rcases mem_Union.1 hi with ⟨m, hm⟩,
+    rcases mem_Union.1 hj with ⟨n, hn⟩,
+    rcases h m n with ⟨p, mp, np⟩,
+    exact H p (mp hm) (np hn) hij }
+end
+
+lemma pairwise_sUnion {r : α → α → Prop} {s : set (set α)} (h : directed_on (⊆) s) :
+  (⋃₀ s).pairwise r ↔ (∀ a ∈ s, set.pairwise a r) :=
+by { rw [sUnion_eq_Union, pairwise_Union (h.directed_coe), set_coe.forall], refl }
+
+end set
+
+end pairwise
+
+namespace set
+section partial_order_bot
+variables [partial_order α] [order_bot α] {s t : set ι} {f g : ι → α}
+
+lemma pairwise_disjoint_Union {g : ι' → set ι} (h : directed (⊆) g) :
+  (⋃ n, g n).pairwise_disjoint f ↔ ∀ ⦃n⦄, (g n).pairwise_disjoint f :=
+pairwise_Union h
+
+lemma pairwise_disjoint_sUnion {s : set (set ι)} (h : directed_on (⊆) s) :
+  (⋃₀ s).pairwise_disjoint f ↔ ∀ ⦃a⦄, a ∈ s → set.pairwise_disjoint a f :=
+pairwise_sUnion h
+
+end partial_order_bot
+
+section complete_lattice
+variables [complete_lattice α] {s : set ι} {t : set ι'}
+
+/-- Bind operation for `set.pairwise_disjoint`. If you want to only consider finsets of indices, you
+can use `set.pairwise_disjoint.bUnion_finset`. -/
+lemma pairwise_disjoint.bUnion {s : set ι'} {g : ι' → set ι} {f : ι → α}
+  (hs : s.pairwise_disjoint (λ i' : ι', ⨆ i ∈ g i', f i))
+  (hg : ∀ i ∈ s, (g i).pairwise_disjoint f) :
+  (⋃ i ∈ s, g i).pairwise_disjoint f :=
+begin
+  rintro a ha b hb hab,
+  simp_rw set.mem_Union at ha hb,
+  obtain ⟨c, hc, ha⟩ := ha,
+  obtain ⟨d, hd, hb⟩ := hb,
+  obtain hcd | hcd := eq_or_ne (g c) (g d),
+  { exact hg d hd (hcd.subst ha) hb hab },
+  { exact (hs hc hd $ ne_of_apply_ne _ hcd).mono (le_supr₂ a ha) (le_supr₂ b hb) }
+end
+
+/-- If the suprema of columns are pairwise disjoint and suprema of rows as well, then everything is
+pairwise disjoint. Not to be confused with `set.pairwise_disjoint.prod`. -/
+lemma pairwise_disjoint.prod_left {f : ι × ι' → α}
+  (hs : s.pairwise_disjoint $ λ i, ⨆ i' ∈ t, f (i, i'))
+  (ht : t.pairwise_disjoint $ λ i', ⨆ i ∈ s, f (i, i')) :
+  (s ×ˢ t : set (ι × ι')).pairwise_disjoint f :=
+begin
+  rintro ⟨i, i'⟩ hi ⟨j, j'⟩ hj h,
+  rw mem_prod at hi hj,
+  obtain rfl | hij := eq_or_ne i j,
+  { refine (ht hi.2 hj.2 $ (prod.mk.inj_left _).ne_iff.1 h).mono _ _,
+    { convert le_supr₂ i hi.1, refl },
+    { convert le_supr₂ i hj.1, refl } },
+  { refine (hs hi.1 hj.1 hij).mono _ _,
+    { convert le_supr₂ i' hi.2, refl },
+    { convert le_supr₂ j' hj.2, refl } }
+end
+
+end complete_lattice
+
+section frame
+variables [frame α]
+
+lemma pairwise_disjoint_prod_left {s : set ι} {t : set ι'} {f : ι × ι' → α} :
+  (s ×ˢ t : set (ι × ι')).pairwise_disjoint f ↔ s.pairwise_disjoint (λ i, ⨆ i' ∈ t, f (i, i')) ∧
+    t.pairwise_disjoint (λ i', ⨆ i ∈ s, f (i, i')) :=
+begin
+  refine (⟨λ h, ⟨λ i hi j hj hij, _, λ i hi j hj hij, _⟩, λ h, h.1.prod_left h.2⟩);
+    simp_rw [function.on_fun, supr_disjoint_iff, disjoint_supr_iff]; intros i' hi' j' hj',
+  { exact h (mk_mem_prod hi hi') (mk_mem_prod hj hj') (ne_of_apply_ne prod.fst hij) },
+  { exact h (mk_mem_prod hi' hi) (mk_mem_prod hj' hj) (ne_of_apply_ne prod.snd hij) }
+end
+
+end frame
+
+lemma bUnion_diff_bUnion_eq {s t : set ι} {f : ι → set α} (h : (s ∪ t).pairwise_disjoint f) :
+  (⋃ i ∈ s, f i) \ (⋃ i ∈ t, f i) = (⋃ i ∈ s \ t, f i) :=
+begin
+  refine (bUnion_diff_bUnion_subset f s t).antisymm
+    (Union₂_subset $ λ i hi a ha, (mem_diff _).2 ⟨mem_bUnion hi.1 ha, _⟩),
+  rw mem_Union₂, rintro ⟨j, hj, haj⟩,
+  exact (h (or.inl hi.1) (or.inr hj) (ne_of_mem_of_not_mem hj hi.2).symm).le_bot ⟨ha, haj⟩,
+end
+
+/-- Equivalence between a disjoint bounded union and a dependent sum. -/
+noncomputable def bUnion_eq_sigma_of_disjoint {s : set ι} {f : ι → set α}
+  (h : s.pairwise_disjoint f) :
+  (⋃ i ∈ s, f i) ≃ (Σ i : s, f i) :=
+(equiv.set_congr (bUnion_eq_Union _ _)).trans $ Union_eq_sigma_of_disjoint $
+  λ ⟨i, hi⟩ ⟨j, hj⟩ ne, h hi hj $ λ eq, ne $ subtype.eq eq
+
+end set
+
+
+section
+variables {f : ι → set α} {s t : set ι}
+
+lemma set.pairwise_disjoint.subset_of_bUnion_subset_bUnion (h₀ : (s ∪ t).pairwise_disjoint f)
+  (h₁ : ∀ i ∈ s, (f i).nonempty) (h : (⋃ i ∈ s, f i) ⊆ ⋃ i ∈ t, f i) :
+  s ⊆ t :=
+begin
+  rintro i hi,
+  obtain ⟨a, hai⟩ := h₁ i hi,
+  obtain ⟨j, hj, haj⟩ := mem_Union₂.1 (h $ mem_Union₂_of_mem hi hai),
+  rwa h₀.eq (subset_union_left _ _ hi) (subset_union_right _ _ hj)
+    (not_disjoint_iff.2 ⟨a, hai, haj⟩),
+end
+
+lemma pairwise.subset_of_bUnion_subset_bUnion (h₀ : pairwise (disjoint on f))
+  (h₁ : ∀ i ∈ s, (f i).nonempty) (h : (⋃ i ∈ s, f i) ⊆ ⋃ i ∈ t, f i) :
+  s ⊆ t :=
+set.pairwise_disjoint.subset_of_bUnion_subset_bUnion (h₀.set_pairwise _) h₁ h
+
+lemma pairwise.bUnion_injective (h₀ : pairwise (disjoint on f)) (h₁ : ∀ i, (f i).nonempty) :
+  injective (λ s : set ι, ⋃ i ∈ s, f i) :=
+λ s t h, (h₀.subset_of_bUnion_subset_bUnion (λ _ _, h₁ _) $ h.subset).antisymm $
+  h₀.subset_of_bUnion_subset_bUnion (λ _ _, h₁ _) $ h.superset
+
+end
diff --git a/src/data/set/pointwise.lean b/src/data/set/pointwise.lean
deleted file mode 100644
index a93c4e8c54ceb..0000000000000
--- a/src/data/set/pointwise.lean
+++ /dev/null
@@ -1,1322 +0,0 @@
-/-
-Copyright (c) 2019 Johan Commelin. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin, Floris van Doorn
--/
-import algebra.module.basic
-import data.set.finite
-import group_theory.submonoid.basic
-
-/-!
-# Pointwise operations of sets
-
-This file defines pointwise algebraic operations on sets.
-
-## Main declarations
-
-For sets `s` and `t` and scalar `a`:
-* `s * t`: Multiplication, set of all `x * y` where `x ∈ s` and `y ∈ t`.
-* `s + t`: Addition, set of all `x + y` where `x ∈ s` and `y ∈ t`.
-* `s⁻¹`: Inversion, set of all `x⁻¹` where `x ∈ s`.
-* `-s`: Negation, set of all `-x` where `x ∈ s`.
-* `s / t`: Division, set of all `x / y` where `x ∈ s` and `y ∈ t`.
-* `s - t`: Subtraction, set of all `x - y` where `x ∈ s` and `y ∈ t`.
-* `s • t`: Scalar multiplication, set of all `x • y` where `x ∈ s` and `y ∈ t`.
-* `s +ᵥ t`: Scalar addition, set of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`.
-* `s -ᵥ t`: Scalar subtraction, set of all `x -ᵥ y` where `x ∈ s` and `y ∈ t`.
-* `a • s`: Scaling, set of all `a • x` where `x ∈ s`.
-* `a +ᵥ s`: Translation, set of all `a +ᵥ x` where `x ∈ s`.
-
-For `α` a semigroup/monoid, `set α` is a semigroup/monoid.
-As an unfortunate side effect, this means that `n • s`, where `n : ℕ`, is ambiguous between
-pointwise scaling and repeated pointwise addition; the former has `(2 : ℕ) • {1, 2} = {2, 4}`, while
-the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`.
-
-We define `set_semiring α`, an alias of `set α`, which we endow with `∪` as addition and `*` as
-multiplication. If `α` is a (commutative) monoid, `set_semiring α` is a (commutative) semiring.
-
-Appropriate definitions and results are also transported to the additive theory via `to_additive`.
-
-## Implementation notes
-
-* The following expressions are considered in simp-normal form in a group:
-  `(λ h, h * g) ⁻¹' s`, `(λ h, g * h) ⁻¹' s`, `(λ h, h * g⁻¹) ⁻¹' s`, `(λ h, g⁻¹ * h) ⁻¹' s`,
-  `s * t`, `s⁻¹`, `(1 : set _)` (and similarly for additive variants).
-  Expressions equal to one of these will be simplified.
-* We put all instances in the locale `pointwise`, so that these instances are not available by
-  default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
-  since we expect the locale to be open whenever the instances are actually used (and making the
-  instances reducible changes the behavior of `simp`.
-
-## Tags
-
-set multiplication, set addition, pointwise addition, pointwise multiplication,
-pointwise subtraction
--/
-
-open function
-
-variables {F α β γ : Type*}
-
-namespace set
-
-/-! ### `0`/`1` as sets -/
-
-section one
-variables [has_one α] {s : set α} {a : α}
-
-/-- The set `(1 : set α)` is defined as `{1}` in locale `pointwise`. -/
-@[to_additive
-/-"The set `(0 : set α)` is defined as `{0}` in locale `pointwise`. "-/]
-protected def has_one : has_one (set α) := ⟨{1}⟩
-
-localized "attribute [instance] set.has_one set.has_zero" in pointwise
-
-@[to_additive] lemma singleton_one : ({1} : set α) = 1 := rfl
-@[simp, to_additive] lemma mem_one : a ∈ (1 : set α) ↔ a = 1 := iff.rfl
-@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : set α) := eq.refl _
-@[simp, to_additive] lemma one_subset : 1 ⊆ s ↔ (1 : α) ∈ s := singleton_subset_iff
-@[to_additive] lemma one_nonempty : (1 : set α).nonempty := ⟨1, rfl⟩
-@[simp, to_additive] lemma image_one {f : α → β} : f '' 1 = {f 1} := image_singleton
-@[to_additive] lemma subset_one_iff_eq : s ⊆ 1 ↔ s = ∅ ∨ s = 1 := subset_singleton_iff_eq
-@[to_additive] lemma nonempty.subset_one_iff (h : s.nonempty) : s ⊆ 1 ↔ s = 1 :=
-h.subset_singleton_iff
-
-end one
-
-open_locale pointwise
-
-/-! ### Set addition/multiplication -/
-
-section mul
-variables {s s₁ s₂ t t₁ t₂ u : set α} {a b : α}
-
-/-- The set `(s * t : set α)` is defined as `{x * y | x ∈ s, y ∈ t}` in locale `pointwise`. -/
-@[to_additive
-/-" The set `(s + t : set α)` is defined as `{x + y | x ∈ s, y ∈ t}` in locale `pointwise`."-/]
-protected def has_mul [has_mul α] : has_mul (set α) := ⟨image2 has_mul.mul⟩
-
-localized "attribute [instance] set.has_mul set.has_add" in pointwise
-
-section has_mul
-variables {ι : Sort*} {κ : ι → Sort*} [has_mul α]
-
-@[simp, to_additive]
-lemma image2_mul : image2 has_mul.mul s t = s * t := rfl
-
-@[to_additive]
-lemma mem_mul : a ∈ s * t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x * y = a := iff.rfl
-
-@[to_additive] lemma mul_mem_mul : a ∈ s → b ∈ t → a * b ∈ s * t := mem_image2_of_mem
-
-@[to_additive add_image_prod]
-lemma image_mul_prod : (λ x : α × α, x.fst * x.snd) '' s ×ˢ t = s * t := image_prod _
-
-@[simp, to_additive] lemma empty_mul : ∅ * s = ∅ := image2_empty_left
-@[simp, to_additive] lemma mul_empty : s * ∅ = ∅ := image2_empty_right
-@[simp, to_additive] lemma mul_eq_empty : s * t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
-@[simp, to_additive] lemma mul_nonempty : (s * t).nonempty ↔ s.nonempty ∧ t.nonempty :=
-image2_nonempty_iff
-@[to_additive] lemma nonempty.mul : s.nonempty → t.nonempty → (s * t).nonempty := nonempty.image2
-@[to_additive] lemma nonempty.of_mul_left : (s * t).nonempty → s.nonempty := nonempty.of_image2_left
-@[to_additive] lemma nonempty.of_mul_right : (s * t).nonempty → t.nonempty :=
-nonempty.of_image2_right
-@[simp, to_additive] lemma mul_singleton : s * {b} = (* b) '' s := image2_singleton_right
-@[simp, to_additive] lemma singleton_mul : {a} * t = ((*) a) '' t := image2_singleton_left
-@[simp, to_additive] lemma singleton_mul_singleton : ({a} : set α) * {b} = {a * b} :=
-image2_singleton
-
-@[to_additive, mono] lemma mul_subset_mul : s₁ ⊆ t₁ → s₂ ⊆ t₂ → s₁ * s₂ ⊆ t₁ * t₂ := image2_subset
-@[to_additive] lemma mul_subset_mul_left : t₁ ⊆ t₂ → s * t₁ ⊆ s * t₂ := image2_subset_left
-@[to_additive] lemma mul_subset_mul_right : s₁ ⊆ s₂ → s₁ * t ⊆ s₂ * t := image2_subset_right
-@[to_additive] lemma mul_subset_iff : s * t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x * y ∈ u := image2_subset_iff
-
-attribute [mono] add_subset_add
-
-@[to_additive] lemma union_mul : (s₁ ∪ s₂) * t = s₁ * t ∪ s₂ * t := image2_union_left
-@[to_additive] lemma mul_union : s * (t₁ ∪ t₂) = s * t₁ ∪ s * t₂ := image2_union_right
-@[to_additive] lemma inter_mul_subset : (s₁ ∩ s₂) * t ⊆ s₁ * t ∩ (s₂ * t) :=
-image2_inter_subset_left
-@[to_additive] lemma mul_inter_subset : s * (t₁ ∩ t₂) ⊆ s * t₁ ∩ (s * t₂) :=
-image2_inter_subset_right
-
-@[to_additive] lemma Union_mul_left_image : (⋃ a ∈ s, ((*) a) '' t) = s * t := Union_image_left _
-@[to_additive] lemma Union_mul_right_image : (⋃ a ∈ t, (* a) '' s) = s * t := Union_image_right _
-
-@[to_additive] lemma Union_mul (s : ι → set α) (t : set α) : (⋃ i, s i) * t = ⋃ i, s i * t :=
-image2_Union_left _ _ _
-@[to_additive] lemma mul_Union (s : set α) (t : ι → set α) : s * (⋃ i, t i) = ⋃ i, s * t i :=
-image2_Union_right _ _ _
-
-@[to_additive]
-lemma Union₂_mul (s : Π i, κ i → set α) (t : set α) : (⋃ i j, s i j) * t = ⋃ i j, s i j * t :=
-image2_Union₂_left _ _ _
-
-@[to_additive]
-lemma mul_Union₂ (s : set α) (t : Π i, κ i → set α) : s * (⋃ i j, t i j) = ⋃ i j, s * t i j :=
-image2_Union₂_right _ _ _
-
-@[to_additive]
-lemma Inter_mul_subset (s : ι → set α) (t : set α) : (⋂ i, s i) * t ⊆ ⋂ i, s i * t :=
-image2_Inter_subset_left _ _ _
-
-@[to_additive]
-lemma mul_Inter_subset (s : set α) (t : ι → set α) : s * (⋂ i, t i) ⊆ ⋂ i, s * t i :=
-image2_Inter_subset_right _ _ _
-
-@[to_additive]
-lemma Inter₂_mul_subset (s : Π i, κ i → set α) (t : set α) :
-  (⋂ i j, s i j) * t ⊆ ⋂ i j, s i j * t :=
-image2_Inter₂_subset_left _ _ _
-
-@[to_additive]
-lemma mul_Inter₂_subset (s : set α) (t : Π i, κ i → set α) :
-  s * (⋂ i j, t i j) ⊆ ⋂ i j, s * t i j :=
-image2_Inter₂_subset_right _ _ _
-
-@[to_additive] lemma finite.mul : finite s → finite t → finite (s * t) := finite.image2 _
-
-/-- Under `[has_mul M]`, the `singleton` map from `M` to `set M` as a `mul_hom`, that is, a map
-which preserves multiplication. -/
-@[to_additive "Under `[has_add A]`, the `singleton` map from `A` to `set A` as an `add_hom`,
-that is, a map which preserves addition.", simps]
-def singleton_mul_hom : α →ₙ* (set α) :=
-{ to_fun := singleton,
-  map_mul' := λ a b, singleton_mul_singleton.symm }
-
-open mul_opposite
-
-@[simp, to_additive]
-lemma image_op_mul : op '' (s * t) = op '' t * op '' s := image_image2_antidistrib op_mul
-
-end has_mul
-
-@[simp, to_additive]
-lemma image_mul_left [group α] : ((*) a) '' t = ((*) a⁻¹) ⁻¹' t :=
-by { rw image_eq_preimage_of_inverse; intro c; simp }
-
-@[simp, to_additive]
-lemma image_mul_right [group α] : (* b) '' t = (* b⁻¹) ⁻¹' t :=
-by { rw image_eq_preimage_of_inverse; intro c; simp }
-
-@[to_additive]
-lemma image_mul_left' [group α] : (λ b, a⁻¹ * b) '' t = (λ b, a * b) ⁻¹' t := by simp
-
-@[to_additive]
-lemma image_mul_right' [group α] : (* b⁻¹) '' t = (* b) ⁻¹' t := by simp
-
-@[simp, to_additive]
-lemma preimage_mul_left_singleton [group α] : ((*) a) ⁻¹' {b} = {a⁻¹ * b} :=
-by rw [← image_mul_left', image_singleton]
-
-@[simp, to_additive]
-lemma preimage_mul_right_singleton [group α] : (* a) ⁻¹' {b} = {b * a⁻¹} :=
-by rw [← image_mul_right', image_singleton]
-
-@[simp, to_additive]
-lemma preimage_mul_left_one [group α] : ((*) a) ⁻¹' 1 = {a⁻¹} :=
-by rw [← image_mul_left', image_one, mul_one]
-
-@[simp, to_additive]
-lemma preimage_mul_right_one [group α] : (* b) ⁻¹' 1 = {b⁻¹} :=
-by rw [← image_mul_right', image_one, one_mul]
-
-@[to_additive]
-lemma preimage_mul_left_one' [group α] : (λ b, a⁻¹ * b) ⁻¹' 1 = {a} := by simp
-
-@[to_additive]
-lemma preimage_mul_right_one' [group α] : (* b⁻¹) ⁻¹' 1 = {b} := by simp
-
-/-- `set α` is a `mul_one_class` under pointwise operations if `α` is. -/
-@[to_additive /-"`set α` is an `add_zero_class` under pointwise operations if `α` is."-/]
-protected def mul_one_class [mul_one_class α] : mul_one_class (set α) :=
-{ mul_one := λ s, by { simp only [← singleton_one, mul_singleton, mul_one, image_id'] },
-  one_mul := λ s, by { simp only [← singleton_one, singleton_mul, one_mul, image_id'] },
-  ..set.has_one, ..set.has_mul }
-
-/-- `set α` is a `semigroup` under pointwise operations if `α` is. -/
-@[to_additive /-"`set α` is an `add_semigroup` under pointwise operations if `α` is. "-/]
-protected def semigroup [semigroup α] : semigroup (set α) :=
-{ mul_assoc := λ _ _ _, image2_assoc mul_assoc,
-  ..set.has_mul }
-
-/-- `set α` is a `comm_semigroup` under pointwise operations if `α` is. -/
-@[to_additive "`set α` is an `add_comm_semigroup` under pointwise operations if `α` is."]
-protected def comm_semigroup [comm_semigroup α] : comm_semigroup (set α) :=
-{ mul_comm := λ s t, image2_comm mul_comm
-  ..set.semigroup }
-
-/-- `set α` is a `monoid` under pointwise operations if `α` is. -/
-@[to_additive /-"`set α` is an `add_monoid` under pointwise operations if `α` is. "-/]
-protected def monoid [monoid α] : monoid (set α) :=
-{ ..set.semigroup,
-  ..set.mul_one_class }
-
-/-- `set α` is a `comm_monoid` under pointwise operations if `α` is. -/
-@[to_additive /-"`set α` is an `add_comm_monoid` under pointwise operations if `α` is. "-/]
-protected def comm_monoid [comm_monoid α] : comm_monoid (set α) :=
-{ ..set.monoid, ..set.comm_semigroup }
-
-localized "attribute [instance] set.mul_one_class set.add_zero_class set.semigroup set.add_semigroup
-  set.comm_semigroup set.add_comm_semigroup set.monoid set.add_monoid set.comm_monoid
-  set.add_comm_monoid" in pointwise
-
-@[to_additive]
-lemma pow_mem_pow [monoid α] (ha : a ∈ s) (n : ℕ) :
-  a ^ n ∈ s ^ n :=
-begin
-  induction n with n ih,
-  { rw pow_zero,
-    exact set.mem_singleton 1 },
-  { rw pow_succ,
-    exact set.mul_mem_mul ha ih },
-end
-
-@[to_additive]
-lemma empty_pow [monoid α] (n : ℕ) (hn : n ≠ 0) : (∅ : set α) ^ n = ∅ :=
-by rw [← tsub_add_cancel_of_le (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn), pow_succ, empty_mul]
-
-instance decidable_mem_mul [monoid α] [fintype α] [decidable_eq α]
-  [decidable_pred (∈ s)] [decidable_pred (∈ t)] :
-  decidable_pred (∈ s * t) :=
-λ _, decidable_of_iff _ mem_mul.symm
-
-instance decidable_mem_pow [monoid α] [fintype α] [decidable_eq α]
-  [decidable_pred (∈ s)] (n : ℕ) :
-  decidable_pred (∈ (s ^ n)) :=
-begin
-  induction n with n ih,
-  { simp_rw [pow_zero, mem_one], apply_instance },
-  { letI := ih, rw pow_succ, apply_instance }
-end
-
-@[to_additive]
-lemma subset_mul_left [mul_one_class α] (s : set α) {t : set α} (ht : (1 : α) ∈ t) : s ⊆ s * t :=
-λ x hx, ⟨x, 1, hx, ht, mul_one _⟩
-
-@[to_additive]
-lemma subset_mul_right [mul_one_class α] {s : set α} (t : set α) (hs : (1 : α) ∈ s) : t ⊆ s * t :=
-λ x hx, ⟨1, x, hs, hx, one_mul _⟩
-
-lemma pow_subset_pow [monoid α] (hst : s ⊆ t) (n : ℕ) :
-  s ^ n ⊆ t ^ n :=
-begin
-  induction n with n ih,
-  { rw pow_zero,
-    exact subset.rfl },
-  { rw [pow_succ, pow_succ],
-    exact mul_subset_mul hst ih },
-end
-
-@[simp, to_additive]
-lemma univ_mul_univ [monoid α] : (univ : set α) * univ = univ :=
-begin
-  have : ∀x, ∃a b : α, a * b = x := λx, ⟨x, ⟨1, mul_one x⟩⟩,
-  simpa only [mem_mul, eq_univ_iff_forall, mem_univ, true_and]
-end
-
-@[simp, to_additive]
-lemma mul_univ [group α] (hs : s.nonempty) : s * (univ : set α) = univ :=
-let ⟨a, ha⟩ := hs in eq_univ_of_forall $ λ b, ⟨a, a⁻¹ * b, ha, trivial, mul_inv_cancel_left _ _⟩
-
-@[simp, to_additive]
-lemma univ_mul [group α] (ht : t.nonempty) : (univ : set α) * t = univ :=
-let ⟨a, ha⟩ := ht in eq_univ_of_forall $ λ b, ⟨b * a⁻¹, a, trivial, ha, inv_mul_cancel_right _ _⟩
-
-/-- `singleton` is a monoid hom. -/
-@[to_additive singleton_add_hom "singleton is an add monoid hom"]
-def singleton_hom [monoid α] : α →* set α :=
-{ to_fun := singleton, map_one' := rfl, map_mul' := λ a b, singleton_mul_singleton.symm }
-
-/-- multiplication preserves finiteness -/
-@[to_additive "addition preserves finiteness"]
-def fintype_mul [has_mul α] [decidable_eq α] (s t : set α) [hs : fintype s] [ht : fintype t] :
-  fintype (s * t : set α) :=
-set.fintype_image2 _ s t
-
-@[to_additive]
-lemma bdd_above_mul [ordered_comm_monoid α] {A B : set α} :
-  bdd_above A → bdd_above B → bdd_above (A * B) :=
-begin
-  rintro ⟨bA, hbA⟩ ⟨bB, hbB⟩,
-  use bA * bB,
-  rintro x ⟨xa, xb, hxa, hxb, rfl⟩,
-  exact mul_le_mul' (hbA hxa) (hbB hxb),
-end
-
-end mul
-
-open_locale pointwise
-
-section big_operators
-open_locale big_operators
-
-variables {ι : Type*} [comm_monoid α]
-
-/-- The n-ary version of `set.mem_mul`. -/
-@[to_additive /-" The n-ary version of `set.mem_add`. "-/]
-lemma mem_finset_prod (t : finset ι) (f : ι → set α) (a : α) :
-  a ∈ ∏ i in t, f i ↔ ∃ (g : ι → α) (hg : ∀ {i}, i ∈ t → g i ∈ f i), ∏ i in t, g i = a :=
-begin
-  classical,
-  induction t using finset.induction_on with i is hi ih generalizing a,
-  { simp_rw [finset.prod_empty, set.mem_one],
-    exact ⟨λ h, ⟨λ i, a, λ i, false.elim, h.symm⟩, λ ⟨f, _, hf⟩, hf.symm⟩ },
-  rw [finset.prod_insert hi, set.mem_mul],
-  simp_rw [finset.prod_insert hi],
-  simp_rw ih,
-  split,
-  { rintro ⟨x, y, hx, ⟨g, hg, rfl⟩, rfl⟩,
-    refine ⟨function.update g i x, λ j hj, _, _⟩,
-    obtain rfl | hj := finset.mem_insert.mp hj,
-    { rw function.update_same, exact hx },
-    { rw update_noteq (ne_of_mem_of_not_mem hj hi), exact hg hj, },
-    rw [finset.prod_update_of_not_mem hi, function.update_same], },
-  { rintro ⟨g, hg, rfl⟩,
-    exact ⟨g i, is.prod g, hg (is.mem_insert_self _),
-      ⟨g, λ i hi, hg (finset.mem_insert_of_mem hi), rfl⟩, rfl⟩ },
-end
-
-/-- A version of `set.mem_finset_prod` with a simpler RHS for products over a fintype. -/
-@[to_additive /-" A version of `set.mem_finset_sum` with a simpler RHS for sums over a fintype. "-/]
-lemma mem_fintype_prod [fintype ι] (f : ι → set α) (a : α) :
-  a ∈ ∏ i, f i ↔ ∃ (g : ι → α) (hg : ∀ i, g i ∈ f i), ∏ i, g i = a :=
-by { rw mem_finset_prod, simp }
-
-/-- The n-ary version of `set.mul_mem_mul`. -/
-@[to_additive /-" The n-ary version of `set.add_mem_add`. "-/]
-lemma finset_prod_mem_finset_prod (t : finset ι) (f : ι → set α)
-  (g : ι → α) (hg : ∀ i ∈ t, g i ∈ f i) :
-  ∏ i in t, g i ∈ ∏ i in t, f i :=
-by { rw mem_finset_prod, exact ⟨g, hg, rfl⟩ }
-
-/-- The n-ary version of `set.mul_subset_mul`. -/
-@[to_additive /-" The n-ary version of `set.add_subset_add`. "-/]
-lemma finset_prod_subset_finset_prod (t : finset ι) (f₁ f₂ : ι → set α)
-  (hf : ∀ {i}, i ∈ t → f₁ i ⊆ f₂ i) :
-  ∏ i in t, f₁ i ⊆ ∏ i in t, f₂ i :=
-begin
-  intro a,
-  rw [mem_finset_prod, mem_finset_prod],
-  rintro ⟨g, hg, rfl⟩,
-  exact ⟨g, λ i hi, hf hi $ hg hi, rfl⟩
-end
-
-@[to_additive]
-lemma finset_prod_singleton {M ι : Type*} [comm_monoid M] (s : finset ι) (I : ι → M) :
-  ∏ (i : ι) in s, ({I i} : set M) = {∏ (i : ι) in s, I i} :=
-begin
-  letI := classical.dec_eq ι,
-  refine finset.induction_on s _ _,
-  { simpa },
-  { intros _ _ H ih,
-    rw [finset.prod_insert H, finset.prod_insert H, ih],
-    simp }
-end
-
-/-! TODO: define `decidable_mem_finset_prod` and `decidable_mem_finset_sum`. -/
-
-end big_operators
-
-/-! ### Set negation/inversion -/
-
-section inv
-
-/-- The set `(s⁻¹ : set α)` is defined as `{x | x⁻¹ ∈ s}` in locale `pointwise`.
-It is equal to `{x⁻¹ | x ∈ s}`, see `set.image_inv`. -/
-@[to_additive
-/-" The set `(-s : set α)` is defined as `{x | -x ∈ s}` in locale `pointwise`.
-It is equal to `{-x | x ∈ s}`, see `set.image_neg`. "-/]
-protected def has_inv [has_inv α] : has_inv (set α) :=
-⟨preimage has_inv.inv⟩
-
-localized "attribute [instance] set.has_inv set.has_neg" in pointwise
-
-section has_inv
-variables [has_inv α] {s t : set α} {a : α}
-
-@[simp, to_additive] lemma inv_empty : (∅ : set α)⁻¹ = ∅ := rfl
-@[simp, to_additive] lemma inv_univ : (univ : set α)⁻¹ = univ := rfl
-
-@[simp, to_additive]
-lemma mem_inv : a ∈ s⁻¹ ↔ a⁻¹ ∈ s := iff.rfl
-
-@[simp, to_additive]
-lemma inv_preimage : has_inv.inv ⁻¹' s = s⁻¹ := rfl
-
-@[simp, to_additive]
-lemma inter_inv : (s ∩ t)⁻¹ = s⁻¹ ∩ t⁻¹ := preimage_inter
-
-@[simp, to_additive]
-lemma union_inv : (s ∪ t)⁻¹ = s⁻¹ ∪ t⁻¹ := preimage_union
-
-@[simp, to_additive]
-lemma Inter_inv {ι : Sort*} (s : ι → set α) : (⋂ i, s i)⁻¹ = ⋂ i, (s i)⁻¹ :=
-preimage_Inter
-
-@[simp, to_additive]
-lemma Union_inv {ι : Sort*} (s : ι → set α) : (⋃ i, s i)⁻¹ = ⋃ i, (s i)⁻¹ :=
-preimage_Union
-
-@[simp, to_additive]
-lemma compl_inv : (sᶜ)⁻¹ = (s⁻¹)ᶜ := preimage_compl
-
-end has_inv
-
-section has_involutive_inv
-variables [has_involutive_inv α] {s t : set α} {a : α}
-
-@[to_additive] lemma inv_mem_inv : a⁻¹ ∈ s⁻¹ ↔ a ∈ s := by simp only [mem_inv, inv_inv]
-
-@[simp, to_additive] lemma nonempty_inv : s⁻¹.nonempty ↔ s.nonempty :=
-inv_involutive.surjective.nonempty_preimage
-
-@[to_additive] lemma nonempty.inv (h : s.nonempty) : s⁻¹.nonempty := nonempty_inv.2 h
-
-@[to_additive] lemma finite.inv (hs : finite s) : finite s⁻¹ :=
-hs.preimage $ inv_injective.inj_on _
-
-@[simp, to_additive]
-lemma image_inv : has_inv.inv '' s = s⁻¹ :=
-congr_fun (image_eq_preimage_of_inverse inv_involutive.left_inverse inv_involutive.right_inverse) _
-
-@[simp, to_additive]
-instance : has_involutive_inv (set α) :=
-{ inv := has_inv.inv,
-  inv_inv := λ s, by { simp only [← inv_preimage, preimage_preimage, inv_inv, preimage_id'] } }
-
-@[simp, to_additive]
-lemma inv_subset_inv : s⁻¹ ⊆ t⁻¹ ↔ s ⊆ t :=
-(equiv.inv α).surjective.preimage_subset_preimage_iff
-
-@[to_additive] lemma inv_subset : s⁻¹ ⊆ t ↔ s ⊆ t⁻¹ := by { rw [← inv_subset_inv, inv_inv] }
-
-@[simp, to_additive] lemma inv_singleton (a : α) : ({a} : set α)⁻¹ = {a⁻¹} :=
-by rw [←image_inv, image_singleton]
-
-open mul_opposite
-
-@[to_additive]
-lemma image_op_inv : op '' s⁻¹ = (op '' s)⁻¹ := by simp_rw [←image_inv, image_comm op_inv]
-
-end has_involutive_inv
-
-@[to_additive] protected lemma mul_inv_rev [group α] (s t : set α) : (s * t)⁻¹ = t⁻¹ * s⁻¹ :=
-by { simp_rw ←image_inv, exact image_image2_antidistrib mul_inv_rev }
-
-protected lemma mul_inv_rev₀ [group_with_zero α] (s t : set α) : (s * t)⁻¹ = t⁻¹ * s⁻¹ :=
-by { simp_rw ←image_inv, exact image_image2_antidistrib mul_inv_rev₀ }
-
-end inv
-
-open_locale pointwise
-
-/-! ### Set multiplication/division -/
-
-section div
-variables {s s₁ s₂ t t₁ t₂ u : set α} {a b : α}
-
-/-- The set `(s / t : set α)` is defined as `{x / y | x ∈ s, y ∈ t}` in locale `pointwise`. -/
-@[to_additive "The set `(s - t : set α)` is defined as `{x - y | x ∈ s, y ∈ t}` in locale
-`pointwise`."]
-protected def has_div [has_div α] : has_div (set α) := ⟨image2 has_div.div⟩
-
-localized "attribute [instance] set.has_div set.has_sub" in pointwise
-
-section has_div
-variables {ι : Sort*} {κ : ι → Sort*} [has_div α]
-
-@[simp, to_additive]
-lemma image2_div : image2 has_div.div s t = s / t := rfl
-
-@[to_additive]
-lemma mem_div : a ∈ s / t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x / y = a := iff.rfl
-
-@[to_additive] lemma div_mem_div : a ∈ s → b ∈ t → a / b ∈ s / t := mem_image2_of_mem
-
-@[to_additive add_image_prod]
-lemma image_div_prod : (λ x : α × α, x.fst / x.snd) '' s ×ˢ t = s / t := image_prod _
-
-@[simp, to_additive] lemma empty_div : ∅ / s = ∅ := image2_empty_left
-@[simp, to_additive] lemma div_empty : s / ∅ = ∅ := image2_empty_right
-@[simp, to_additive] lemma div_eq_empty : s / t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
-@[simp, to_additive] lemma div_nonempty : (s / t).nonempty ↔ s.nonempty ∧ t.nonempty :=
-image2_nonempty_iff
-@[to_additive] lemma nonempty.div : s.nonempty → t.nonempty → (s / t).nonempty := nonempty.image2
-@[to_additive] lemma nonempty.of_div_left : (s / t).nonempty → s.nonempty := nonempty.of_image2_left
-@[to_additive] lemma nonempty.of_div_right : (s / t).nonempty → t.nonempty :=
-nonempty.of_image2_right
-@[simp, to_additive] lemma div_singleton : s / {b} = (/ b) '' s := image2_singleton_right
-@[simp, to_additive] lemma singleton_div : {a} / t = ((/) a) '' t := image2_singleton_left
-@[simp, to_additive] lemma singleton_div_singleton : ({a} : set α) / {b} = {a / b} :=
-image2_singleton
-
-@[to_additive, mono] lemma div_subset_div : s₁ ⊆ t₁ → s₂ ⊆ t₂ → s₁ / s₂ ⊆ t₁ / t₂ := image2_subset
-@[to_additive] lemma div_subset_div_left : t₁ ⊆ t₂ → s / t₁ ⊆ s / t₂ := image2_subset_left
-@[to_additive] lemma div_subset_div_right : s₁ ⊆ s₂ → s₁ / t ⊆ s₂ / t := image2_subset_right
-@[to_additive] lemma div_subset_iff : s / t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x / y ∈ u := image2_subset_iff
-
-attribute [mono] sub_subset_sub
-
-@[to_additive] lemma union_div : (s₁ ∪ s₂) / t = s₁ / t ∪ s₂ / t := image2_union_left
-@[to_additive] lemma div_union : s / (t₁ ∪ t₂) = s / t₁ ∪ s / t₂ := image2_union_right
-@[to_additive] lemma inter_div_subset : (s₁ ∩ s₂) / t ⊆ s₁ / t ∩ (s₂ / t) :=
-image2_inter_subset_left
-@[to_additive] lemma div_inter_subset : s / (t₁ ∩ t₂) ⊆ s / t₁ ∩ (s / t₂) :=
-image2_inter_subset_right
-
-@[to_additive] lemma Union_div_left_image : (⋃ a ∈ s, ((/) a) '' t) = s / t := Union_image_left _
-@[to_additive] lemma Union_div_right_image : (⋃ a ∈ t, (/ a) '' s) = s / t := Union_image_right _
-
-@[to_additive] lemma Union_div (s : ι → set α) (t : set α) : (⋃ i, s i) / t = ⋃ i, s i / t :=
-image2_Union_left _ _ _
-@[to_additive] lemma div_Union (s : set α) (t : ι → set α) : s / (⋃ i, t i) = ⋃ i, s / t i :=
-image2_Union_right _ _ _
-
-@[to_additive]
-lemma Union₂_div (s : Π i, κ i → set α) (t : set α) : (⋃ i j, s i j) / t = ⋃ i j, s i j / t :=
-image2_Union₂_left _ _ _
-
-@[to_additive]
-lemma div_Union₂ (s : set α) (t : Π i, κ i → set α) : s / (⋃ i j, t i j) = ⋃ i j, s / t i j :=
-image2_Union₂_right _ _ _
-
-@[to_additive]
-lemma Inter_div_subset (s : ι → set α) (t : set α) : (⋂ i, s i) / t ⊆ ⋂ i, s i / t :=
-image2_Inter_subset_left _ _ _
-
-@[to_additive]
-lemma div_Inter_subset (s : set α) (t : ι → set α) : s / (⋂ i, t i) ⊆ ⋂ i, s / t i :=
-image2_Inter_subset_right _ _ _
-
-@[to_additive]
-lemma Inter₂_div_subset (s : Π i, κ i → set α) (t : set α) :
-  (⋂ i j, s i j) / t ⊆ ⋂ i j, s i j / t :=
-image2_Inter₂_subset_left _ _ _
-
-@[to_additive]
-lemma div_Inter₂_subset (s : set α) (t : Π i, κ i → set α) :
-  s / (⋂ i j, t i j) ⊆ ⋂ i j, s / t i j :=
-image2_Inter₂_subset_right _ _ _
-
-end has_div
-
-/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `finset`. -/
-protected def has_nsmul [has_zero α] [has_add α] : has_scalar ℕ (set α) := ⟨nsmul_rec⟩
-
-/-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a
-`set`. -/
-@[to_additive]
-protected def has_npow [has_one α] [has_mul α] : has_pow (set α) ℕ := ⟨λ s n, npow_rec n s⟩
-
-/-- Repeated pointwise addition/subtraction (not the same as pointwise repeated
-addition/subtraction!) of a `set`. -/
-protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_scalar ℤ (set α) := ⟨zsmul_rec⟩
-
-/-- Repeated pointwise multiplication/division (not the same as pointwise repeated
-multiplication/division!) of a `set`. -/
-@[to_additive] protected def has_zpow [has_one α] [has_mul α] [has_inv α] : has_pow (set α) ℤ :=
-⟨λ s n, zpow_rec n s⟩
-
-/-TODO: The below instances are duplicate because there is no typeclass greater than
-`div_inv_monoid` and `has_involutive_inv` but smaller than `group` and `group_with_zero`. -/
-
-/-- `s / t = s * t⁻¹` for all `s t : set α` if `a / b = a * b⁻¹` for all `a b : α`. -/
-@[to_additive "`s - t = s + -t` for all `s t : set α` if `a - b = a + -b` for all `a b : α`."]
-protected def div_inv_monoid [group α] : div_inv_monoid (set α) :=
-{ div_eq_mul_inv := λ s t,
-    by { rw [←image_id (s / t), ←image_inv], exact image_image2_distrib_right div_eq_mul_inv },
-  ..set.monoid, ..set.has_inv, ..set.has_div }
-
-/-- `s / t = s * t⁻¹` for all `s t : set α` if `a / b = a * b⁻¹` for all `a b : α`. -/
-protected def div_inv_monoid' [group_with_zero α] : div_inv_monoid (set α) :=
-{ div_eq_mul_inv := λ s t,
-    by { rw [←image_id (s / t), ←image_inv], exact image_image2_distrib_right div_eq_mul_inv },
-  ..set.monoid, ..set.has_inv, ..set.has_div }
-
-localized "attribute [instance] set.has_nsmul set.has_npow set.has_zsmul set.has_zpow
-  set.div_inv_monoid set.div_inv_monoid' set.sub_neg_add_monoid" in pointwise
-
-end div
-
-/-! ### Translation/scaling of sets -/
-
-section smul
-
-/-- The scaling of a set `(x • s : set β)` by a scalar `x ∶ α` is defined as `{x • y | y ∈ s}`
-in locale `pointwise`. -/
-@[to_additive has_vadd_set "The translation of a set `(x +ᵥ s : set β)` by a scalar `x ∶ α` is
-defined as `{x +ᵥ y | y ∈ s}` in locale `pointwise`."]
-protected def has_scalar_set [has_scalar α β] : has_scalar α (set β) :=
-⟨λ a, image (has_scalar.smul a)⟩
-
-/-- The pointwise scalar multiplication `(s • t : set β)` by a set of scalars `s ∶ set α`
-is defined as `{x • y | x ∈ s, y ∈ t}` in locale `pointwise`. -/
-@[to_additive has_vadd "The pointwise translation `(s +ᵥ t : set β)` by a set of constants
-`s ∶ set α` is defined as `{x +ᵥ y | x ∈ s, y ∈ t}` in locale `pointwise`."]
-protected def has_scalar [has_scalar α β] : has_scalar (set α) (set β) :=
-⟨image2 has_scalar.smul⟩
-
-localized "attribute [instance] set.has_scalar_set set.has_scalar" in pointwise
-localized "attribute [instance] set.has_vadd_set set.has_vadd" in pointwise
-
-section has_scalar
-variables {ι : Sort*} {κ : ι → Sort*} [has_scalar α β] {s s₁ s₂ : set α} {t t₁ t₂ u : set β} {a : α}
-  {b : β}
-
-@[simp, to_additive]
-lemma image2_smul : image2 has_scalar.smul s t = s • t := rfl
-
-@[to_additive add_image_prod]
-lemma image_smul_prod : (λ x : α × β, x.fst • x.snd) '' s ×ˢ t = s • t := image_prod _
-
-@[to_additive]
-lemma mem_smul : b ∈ s • t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x • y = b := iff.rfl
-
-@[to_additive] lemma smul_mem_smul : a ∈ s → b ∈ t → a • b ∈ s • t := mem_image2_of_mem
-
-@[simp, to_additive] lemma empty_smul : (∅ : set α) • t = ∅ := image2_empty_left
-@[simp, to_additive] lemma smul_empty : s • (∅ : set β) = ∅ := image2_empty_right
-@[simp, to_additive] lemma smul_eq_empty : s • t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
-@[simp, to_additive] lemma smul_nonempty : (s • t).nonempty ↔ s.nonempty ∧ t.nonempty :=
-image2_nonempty_iff
-@[to_additive] lemma nonempty.smul : s.nonempty → t.nonempty → (s • t).nonempty := nonempty.image2
-@[to_additive] lemma nonempty.of_smul_left : (s • t).nonempty → s.nonempty :=
-nonempty.of_image2_left
-@[to_additive] lemma nonempty.of_smul_right : (s • t).nonempty → t.nonempty :=
-nonempty.of_image2_right
-@[simp, to_additive] lemma smul_singleton : s • {b} = (• b) '' s := image2_singleton_right
-@[simp, to_additive] lemma singleton_smul : ({a} : set α) • t = a • t := image2_singleton_left
-@[simp, to_additive] lemma singleton_smul_singleton : ({a} : set α) • ({b} : set β) = {a • b} :=
-image2_singleton
-
-@[to_additive, mono] lemma smul_subset_smul : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ • t₁ ⊆ s₂ • t₂ := image2_subset
-@[to_additive] lemma smul_subset_smul_left : t₁ ⊆ t₂ → s • t₁ ⊆ s • t₂ := image2_subset_left
-@[to_additive] lemma smul_subset_smul_right : s₁ ⊆ s₂ → s₁ • t ⊆ s₂ • t := image2_subset_right
-@[to_additive] lemma smul_subset_iff : s • t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a • b ∈ u := image2_subset_iff
-
-attribute [mono] vadd_subset_vadd
-
-@[to_additive] lemma union_smul : (s₁ ∪ s₂) • t = s₁ • t ∪ s₂ • t := image2_union_left
-@[to_additive] lemma smul_union : s • (t₁ ∪ t₂) = s • t₁ ∪ s • t₂ := image2_union_right
-@[to_additive] lemma inter_smul_subset : (s₁ ∩ s₂) • t ⊆ s₁ • t ∩ s₂ • t := image2_inter_subset_left
-@[to_additive] lemma smul_inter_subset : s • (t₁ ∩ t₂) ⊆ s • t₁ ∩ s • t₂ :=
-image2_inter_subset_right
-
-@[to_additive] lemma Union_smul_left_image : (⋃ a ∈ s, a • t) = s • t := Union_image_left _
-@[to_additive] lemma Union_smul_right_image : (⋃ a ∈ t, (• a) '' s) = s • t := Union_image_right _
-
-@[to_additive] lemma Union_smul (s : ι → set α) (t : set β) : (⋃ i, s i) • t = ⋃ i, s i • t :=
-image2_Union_left _ _ _
-@[to_additive] lemma smul_Union (s : set α) (t : ι → set β) : s • (⋃ i, t i) = ⋃ i, s • t i :=
-image2_Union_right _ _ _
-
-@[to_additive]
-lemma Union₂_smul (s : Π i, κ i → set α) (t : set β) : (⋃ i j, s i j) • t = ⋃ i j, s i j • t :=
-image2_Union₂_left _ _ _
-
-@[to_additive]
-lemma smul_Union₂ (s : set α) (t : Π i, κ i → set β) : s • (⋃ i j, t i j) = ⋃ i j, s • t i j :=
-image2_Union₂_right _ _ _
-
-@[to_additive]
-lemma Inter_smul_subset (s : ι → set α) (t : set β) : (⋂ i, s i) • t ⊆ ⋂ i, s i • t :=
-image2_Inter_subset_left _ _ _
-
-@[to_additive]
-lemma smul_Inter_subset (s : set α) (t : ι → set β) : s • (⋂ i, t i) ⊆ ⋂ i, s • t i :=
-image2_Inter_subset_right _ _ _
-
-@[to_additive]
-lemma Inter₂_smul_subset (s : Π i, κ i → set α) (t : set β) :
-  (⋂ i j, s i j) • t ⊆ ⋂ i j, s i j • t :=
-image2_Inter₂_subset_left _ _ _
-
-@[to_additive]
-lemma smul_Inter₂_subset (s : set α) (t : Π i, κ i → set β) :
-  s • (⋂ i j, t i j) ⊆ ⋂ i j, s • t i j :=
-image2_Inter₂_subset_right _ _ _
-
-@[to_additive] lemma finite.smul : finite s → finite t → finite (s • t) := finite.image2 _
-
-end has_scalar
-
-section has_scalar_set
-variables {ι : Sort*} {κ : ι → Sort*} [has_scalar α β] {s t t₁ t₂ : set β} {a : α} {b : β} {x y : β}
-
-@[simp, to_additive] lemma image_smul : (λ x, a • x) '' t = a • t := rfl
-
-@[to_additive] lemma mem_smul_set : x ∈ a • t ↔ ∃ y, y ∈ t ∧ a • y = x := iff.rfl
-
-@[to_additive] lemma smul_mem_smul_set : b ∈ s → a • b ∈ a • s := mem_image_of_mem _
-
-@[simp, to_additive] lemma smul_set_empty : a • (∅ : set β) = ∅ := image_empty _
-@[simp, to_additive] lemma smul_set_eq_empty : a • s = ∅ ↔ s = ∅ := image_eq_empty
-@[simp, to_additive] lemma smul_set_nonempty : (a • s).nonempty ↔ s.nonempty := nonempty_image_iff
-
-@[simp, to_additive] lemma smul_set_singleton : a • ({b} : set β) = {a • b} := image_singleton
-
-@[to_additive] lemma smul_set_mono (h : s ⊆ t) : a • s ⊆ a • t := image_subset _ h
-
-@[to_additive] lemma smul_set_union : a • (t₁ ∪ t₂) = a • t₁ ∪ a • t₂ := image_union _ _ _
-
-@[to_additive]
-lemma smul_set_inter_subset : a • (t₁ ∩ t₂) ⊆ a • t₁ ∩ (a • t₂) := image_inter_subset _ _ _
-
-@[to_additive]
-lemma smul_set_Union (a : α) (s : ι → set β) : a • (⋃ i, s i) = ⋃ i, a • s i := image_Union
-
-@[to_additive]
-lemma smul_set_Union₂ (a : α) (s : Π i, κ i → set β) : a • (⋃ i j, s i j) = ⋃ i j, a • s i j :=
-image_Union₂ _ _
-
-@[to_additive]
-lemma smul_set_Inter_subset (a : α) (t : ι → set β) : a • (⋂ i, t i) ⊆ ⋂ i, a • t i :=
-image_Inter_subset _ _
-
-@[to_additive]
-lemma smul_set_Inter₂_subset (a : α) (t : Π i, κ i → set β) :
-  a • (⋂ i j, t i j) ⊆ ⋂ i j, a • t i j :=
-image_Inter₂_subset _ _
-
-@[to_additive] lemma nonempty.smul_set : s.nonempty → (a • s).nonempty := nonempty.image _
-@[to_additive] lemma finite.smul_set : finite s → finite (a • s) := finite.image _
-
-end has_scalar_set
-
-variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}
-
-@[to_additive]
-lemma smul_set_inter [group α] [mul_action α β] {s t : set β} :
-  a • (s ∩ t) = a • s ∩ a • t :=
-(image_inter $ mul_action.injective a).symm
-
-lemma smul_set_inter₀ [group_with_zero α] [mul_action α β] {s t : set β} (ha : a ≠ 0) :
-  a • (s ∩ t) = a • s ∩ a • t :=
-show units.mk0 a ha • _ = _, from smul_set_inter
-
-@[simp, to_additive]
-lemma smul_set_univ [group α] [mul_action α β] {a : α} : a • (univ : set β) = univ :=
-eq_univ_of_forall $ λ b, ⟨a⁻¹ • b, trivial, smul_inv_smul _ _⟩
-
-@[simp, to_additive]
-lemma smul_univ [group α] [mul_action α β] {s : set α} (hs : s.nonempty) :
-  s • (univ : set β) = univ :=
-let ⟨a, ha⟩ := hs in eq_univ_of_forall $ λ b, ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul _ _⟩
-
-@[to_additive]
-theorem range_smul_range {ι κ : Type*} [has_scalar α β] (b : ι → α) (c : κ → β) :
-  range b • range c = range (λ p : ι × κ, b p.1 • c p.2) :=
-ext $ λ x, ⟨λ hx, let ⟨p, q, ⟨i, hi⟩, ⟨j, hj⟩, hpq⟩ := set.mem_smul.1 hx in
-  ⟨(i, j), hpq ▸ hi ▸ hj ▸ rfl⟩,
-λ ⟨⟨i, j⟩, h⟩, set.mem_smul.2 ⟨b i, c j, ⟨i, rfl⟩, ⟨j, rfl⟩, h⟩⟩
-
-@[to_additive]
-instance smul_comm_class_set [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
-  smul_comm_class α (set β) (set γ) :=
-⟨λ _ _ _, image_image2_distrib_right $ smul_comm _⟩
-
-@[to_additive]
-instance smul_comm_class_set' [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
-  smul_comm_class (set α) β (set γ) :=
-by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _
-
-@[to_additive]
-instance smul_comm_class [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
-  smul_comm_class (set α) (set β) (set γ) :=
-⟨λ _ _ _, image2_left_comm smul_comm⟩
-
-instance is_scalar_tower [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
-  [is_scalar_tower α β γ] :
-  is_scalar_tower α β (set γ) :=
-{ smul_assoc := λ a b T, by simp only [←image_smul, image_image, smul_assoc] }
-
-instance is_scalar_tower' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
-  [is_scalar_tower α β γ] :
-  is_scalar_tower α (set β) (set γ) :=
-⟨λ _ _ _, image2_image_left_comm $ smul_assoc _⟩
-
-instance is_scalar_tower'' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
-  [is_scalar_tower α β γ] :
-  is_scalar_tower (set α) (set β) (set γ) :=
-{ smul_assoc := λ T T' T'', image2_assoc smul_assoc }
-
-instance is_central_scalar [has_scalar α β] [has_scalar αᵐᵒᵖ β] [is_central_scalar α β] :
-  is_central_scalar α (set β) :=
-⟨λ a S, congr_arg (λ f, f '' S) $ by exact funext (λ _, op_smul_eq_smul _ _)⟩
-
-/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of `set α`
-on `set β`. -/
-@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action
-of `set α` on `set β`"]
-protected def mul_action [monoid α] [mul_action α β] : mul_action (set α) (set β) :=
-{ mul_smul := λ _ _ _, image2_assoc mul_smul,
-  one_smul := λ s, image2_singleton_left.trans $ by simp_rw [one_smul, image_id'] }
-
-/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `set β`. -/
-@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action
-on `set β`."]
-protected def mul_action_set [monoid α] [mul_action α β] : mul_action α (set β) :=
-{ mul_smul := by { intros, simp only [← image_smul, image_image, ← mul_smul] },
-  one_smul := by { intros, simp only [← image_smul, one_smul, image_id'] } }
-
-localized "attribute [instance] set.mul_action_set set.add_action_set
-  set.mul_action set.add_action" in pointwise
-
-/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
-multiplicative action on `set β`. -/
-protected def distrib_mul_action_set [monoid α] [add_monoid β] [distrib_mul_action α β] :
-  distrib_mul_action α (set β) :=
-{ smul_add := λ _ _ _, image_image2_distrib $ smul_add _,
-  smul_zero := λ _, image_singleton.trans $ by rw [smul_zero, singleton_zero] }
-
-/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/
-protected def mul_distrib_mul_action_set [monoid α] [monoid β] [mul_distrib_mul_action α β] :
-  mul_distrib_mul_action α (set β) :=
-{ smul_mul := λ _ _ _, image_image2_distrib $ smul_mul' _,
-  smul_one := λ _, image_singleton.trans $ by rw [smul_one, singleton_one] }
-
-localized "attribute [instance] set.distrib_mul_action_set set.mul_distrib_mul_action_set"
-  in pointwise
-
-end smul
-
-section vsub
-variables {ι : Sort*} {κ : ι → Sort*} [has_vsub α β] {s s₁ s₂ t t₁ t₂ : set β} {u : set α} {a : α}
-  {b c : β}
-include α
-
-instance has_vsub : has_vsub (set α) (set β) := ⟨image2 (-ᵥ)⟩
-
-@[simp] lemma image2_vsub : (image2 has_vsub.vsub s t : set α) = s -ᵥ t := rfl
-
-lemma image_vsub_prod : (λ x : β × β, x.fst -ᵥ x.snd) '' s ×ˢ t = s -ᵥ t := image_prod _
-
-lemma mem_vsub : a ∈ s -ᵥ t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x -ᵥ y = a := iff.rfl
-
-lemma vsub_mem_vsub (hb : b ∈ s) (hc : c ∈ t) : b -ᵥ c ∈ s -ᵥ t := mem_image2_of_mem hb hc
-
-@[simp] lemma empty_vsub (t : set β) : ∅ -ᵥ t = ∅ := image2_empty_left
-@[simp] lemma vsub_empty (s : set β) : s -ᵥ ∅ = ∅ := image2_empty_right
-@[simp] lemma vsub_eq_empty : s -ᵥ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
-@[simp] lemma vsub_nonempty : (s -ᵥ t : set α).nonempty ↔ s.nonempty ∧ t.nonempty :=
-image2_nonempty_iff
-lemma nonempty.vsub : s.nonempty → t.nonempty → (s -ᵥ t : set α).nonempty := nonempty.image2
-lemma nonempty.of_vsub_left : (s -ᵥ t :set α).nonempty → s.nonempty := nonempty.of_image2_left
-lemma nonempty.of_vsub_right : (s -ᵥ t : set α).nonempty → t.nonempty := nonempty.of_image2_right
-@[simp] lemma vsub_singleton (s : set β) (b : β) : s -ᵥ {b} = (-ᵥ b) '' s := image2_singleton_right
-@[simp] lemma singleton_vsub (t : set β) (b : β) : {b} -ᵥ t = ((-ᵥ) b) '' t := image2_singleton_left
-@[simp] lemma singleton_vsub_singleton : ({b} : set β) -ᵥ {c} = {b -ᵥ c} := image2_singleton
-
-@[mono] lemma vsub_subset_vsub : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ -ᵥ t₁ ⊆ s₂ -ᵥ t₂ := image2_subset
-lemma vsub_subset_vsub_left : t₁ ⊆ t₂ → s -ᵥ t₁ ⊆ s -ᵥ t₂ := image2_subset_left
-lemma vsub_subset_vsub_right : s₁ ⊆ s₂ → s₁ -ᵥ t ⊆ s₂ -ᵥ t := image2_subset_right
-lemma vsub_subset_iff : s -ᵥ t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x -ᵥ y ∈ u := image2_subset_iff
-lemma vsub_self_mono (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t := vsub_subset_vsub h h
-
-lemma union_vsub : (s₁ ∪ s₂) -ᵥ t = s₁ -ᵥ t ∪ (s₂ -ᵥ t) := image2_union_left
-lemma vsub_union : s -ᵥ (t₁ ∪ t₂) = s -ᵥ t₁ ∪ (s -ᵥ t₂) := image2_union_right
-lemma inter_vsub_subset : s₁ ∩ s₂ -ᵥ t ⊆ (s₁ -ᵥ t) ∩ (s₂ -ᵥ t) := image2_inter_subset_left
-lemma vsub_inter_subset : s -ᵥ t₁ ∩ t₂ ⊆ (s -ᵥ t₁) ∩ (s -ᵥ t₂) := image2_inter_subset_right
-
-lemma Union_vsub_left_image : (⋃ a ∈ s, ((-ᵥ) a) '' t) = s -ᵥ t := Union_image_left _
-lemma Union_vsub_right_image : (⋃ a ∈ t, (-ᵥ a) '' s) = s -ᵥ t := Union_image_right _
-
-lemma Union_vsub (s : ι → set β) (t : set β) : (⋃ i, s i) -ᵥ t = ⋃ i, s i -ᵥ t :=
-image2_Union_left _ _ _
-lemma vsub_Union (s : set β) (t : ι → set β) : s -ᵥ (⋃ i, t i) = ⋃ i, s -ᵥ t i :=
-image2_Union_right _ _ _
-
-lemma Union₂_vsub (s : Π i, κ i → set β) (t : set β) : (⋃ i j, s i j) -ᵥ t = ⋃ i j, s i j -ᵥ t :=
-image2_Union₂_left _ _ _
-
-lemma vsub_Union₂ (s : set β) (t : Π i, κ i → set β) : s -ᵥ (⋃ i j, t i j) = ⋃ i j, s -ᵥ t i j :=
-image2_Union₂_right _ _ _
-
-lemma Inter_vsub_subset (s : ι → set β) (t : set β) : (⋂ i, s i) -ᵥ t ⊆ ⋂ i, s i -ᵥ t :=
-image2_Inter_subset_left _ _ _
-
-lemma vsub_Inter_subset (s : set β) (t : ι → set β) : s -ᵥ (⋂ i, t i) ⊆ ⋂ i, s -ᵥ t i :=
-image2_Inter_subset_right _ _ _
-
-lemma Inter₂_vsub_subset (s : Π i, κ i → set β) (t : set β) :
-  (⋂ i j, s i j) -ᵥ t ⊆ ⋂ i j, s i j -ᵥ t :=
-image2_Inter₂_subset_left _ _ _
-
-lemma vsub_Inter₂_subset (s : set β) (t : Π i, κ i → set β) :
-  s -ᵥ (⋂ i j, t i j) ⊆ ⋂ i j, s -ᵥ t i j :=
-image2_Inter₂_subset_right _ _ _
-
-lemma finite.vsub (hs : finite s) (ht : finite t) : finite (s -ᵥ t) := hs.image2 _ ht
-
-end vsub
-
-open_locale pointwise
-
-section ring
-variables [ring α] [add_comm_group β] [module α β] {s : set α} {t : set β} {a : α}
-
-@[simp] lemma neg_smul_set : -a • t = -(a • t) :=
-by simp_rw [←image_smul, ←image_neg, image_image, neg_smul]
-
-@[simp] lemma smul_set_neg : a • -t = -(a • t) :=
-by simp_rw [←image_smul, ←image_neg, image_image, smul_neg]
-
-@[simp] protected lemma neg_smul : -s • t = -(s • t) :=
-by simp_rw [←image2_smul, ←image_neg, image2_image_left, image_image2, neg_smul]
-
-@[simp] protected lemma smul_neg : s • -t = -(s • t) :=
-by simp_rw [←image2_smul, ←image_neg, image2_image_right, image_image2, smul_neg]
-
-end ring
-
-section monoid
-
-/-! ### `set α` as a `(∪, *)`-semiring -/
-
-/-- An alias for `set α`, which has a semiring structure given by `∪` as "addition" and pointwise
-  multiplication `*` as "multiplication". -/
-@[derive [inhabited, partial_order, order_bot]] def set_semiring (α : Type*) : Type* := set α
-
-/-- The identity function `set α → set_semiring α`. -/
-protected def up (s : set α) : set_semiring α := s
-/-- The identity function `set_semiring α → set α`. -/
-protected def set_semiring.down (s : set_semiring α) : set α := s
-@[simp] protected lemma down_up {s : set α} : s.up.down = s := rfl
-@[simp] protected lemma up_down {s : set_semiring α} : s.down.up = s := rfl
-
-/- This lemma is not tagged `simp`, since otherwise the linter complains. -/
-lemma up_le_up {s t : set α} : s.up ≤ t.up ↔ s ⊆ t := iff.rfl
-/- This lemma is not tagged `simp`, since otherwise the linter complains. -/
-lemma up_lt_up {s t : set α} : s.up < t.up ↔ s ⊂ t := iff.rfl
-
-@[simp] lemma down_subset_down {s t : set_semiring α} : s.down ⊆ t.down ↔ s ≤ t := iff.rfl
-@[simp] lemma down_ssubset_down {s t : set_semiring α} : s.down ⊂ t.down ↔ s < t := iff.rfl
-
-instance set_semiring.add_comm_monoid : add_comm_monoid (set_semiring α) :=
-{ add := λ s t, (s ∪ t : set α),
-  zero := (∅ : set α),
-  add_assoc := union_assoc,
-  zero_add := empty_union,
-  add_zero := union_empty,
-  add_comm := union_comm, }
-
-instance set_semiring.non_unital_non_assoc_semiring [has_mul α] :
-  non_unital_non_assoc_semiring (set_semiring α) :=
-{ zero_mul := λ s, empty_mul,
-  mul_zero := λ s, mul_empty,
-  left_distrib := λ _ _ _, mul_union,
-  right_distrib := λ _ _ _, union_mul,
-  ..set.has_mul, ..set_semiring.add_comm_monoid }
-
-instance set_semiring.non_assoc_semiring [mul_one_class α] : non_assoc_semiring (set_semiring α) :=
-{ ..set_semiring.non_unital_non_assoc_semiring, ..set.mul_one_class }
-
-instance set_semiring.non_unital_semiring [semigroup α] : non_unital_semiring (set_semiring α) :=
-{ ..set_semiring.non_unital_non_assoc_semiring, ..set.semigroup }
-
-instance set_semiring.semiring [monoid α] : semiring (set_semiring α) :=
-{ ..set_semiring.non_assoc_semiring, ..set_semiring.non_unital_semiring }
-
-instance set_semiring.non_unital_comm_semiring [comm_semigroup α] :
-  non_unital_comm_semiring (set_semiring α) :=
-{ ..set_semiring.non_unital_semiring, ..set.comm_semigroup }
-
-instance set_semiring.comm_semiring [comm_monoid α] : comm_semiring (set_semiring α) :=
-{ ..set.comm_monoid, ..set_semiring.semiring }
-
-section mul_hom
-
-variables [has_mul α] [has_mul β] [mul_hom_class F α β] (m : F) {s t : set α}
-
-@[to_additive]
-lemma image_mul : (m : α → β) '' (s * t) = m '' s * m '' t := image_image2_distrib $ map_mul m
-
-@[to_additive]
-lemma preimage_mul_preimage_subset {s t : set β} : (m : α → β) ⁻¹' s * m ⁻¹' t ⊆ m ⁻¹' (s * t) :=
-by { rintro _ ⟨_, _, _, _, rfl⟩, exact ⟨_, _, ‹_›, ‹_›, (map_mul m _ _).symm ⟩ }
-
-instance set_semiring.no_zero_divisors : no_zero_divisors (set_semiring α) :=
-⟨λ a b ab, a.eq_empty_or_nonempty.imp_right $ λ ha, b.eq_empty_or_nonempty.resolve_right $
-  λ hb, nonempty.ne_empty ⟨_, mul_mem_mul ha.some_mem hb.some_mem⟩ ab⟩
-
-/- Since addition on `set_semiring` is commutative (it is set union), there is no need
-to also have the instance `covariant_class (set_semiring α) (set_semiring α) (swap (+)) (≤)`. -/
-instance set_semiring.covariant_class_add :
-  covariant_class (set_semiring α) (set_semiring α) (+) (≤) :=
-{ elim := λ a b c, union_subset_union_right _ }
-
-instance set_semiring.covariant_class_mul_left :
-  covariant_class (set_semiring α) (set_semiring α) (*) (≤) :=
-{ elim := λ a b c, mul_subset_mul_left }
-
-instance set_semiring.covariant_class_mul_right :
-  covariant_class (set_semiring α) (set_semiring α) (swap (*)) (≤) :=
-{ elim := λ a b c, mul_subset_mul_right }
-
-end mul_hom
-
-/-- The image of a set under a multiplicative homomorphism is a ring homomorphism
-with respect to the pointwise operations on sets. -/
-def image_hom [monoid α] [monoid β] (f : α →* β) : set_semiring α →+* set_semiring β :=
-{ to_fun := image f,
-  map_zero' := image_empty _,
-  map_one' := by simp only [← singleton_one, image_singleton, f.map_one],
-  map_add' := image_union _,
-  map_mul' := λ _ _, image_mul f }
-
-end monoid
-
-section comm_monoid
-
-variable [comm_monoid α]
-
-instance : canonically_ordered_comm_semiring (set_semiring α) :=
-{ add_le_add_left := λ a b, add_le_add_left,
-  le_iff_exists_add := λ a b, ⟨λ ab, ⟨b, (union_eq_right_iff_subset.2 ab).symm⟩,
-    by { rintro ⟨c, rfl⟩, exact subset_union_left _ _ }⟩,
-  ..(infer_instance : comm_semiring (set_semiring α)),
-  ..(infer_instance : partial_order (set_semiring α)),
-  ..(infer_instance : order_bot (set_semiring α)),
-  ..(infer_instance : no_zero_divisors (set_semiring α)) }
-
-end comm_monoid
-
-end set
-
-open set
-open_locale pointwise
-
-section
-
-section smul_with_zero
-variables [has_zero α] [has_zero β] [smul_with_zero α β]
-
-/-- A nonempty set is scaled by zero to the singleton set containing 0. -/
-lemma zero_smul_set {s : set β} (h : s.nonempty) : (0 : α) • s = (0 : set β) :=
-by simp only [← image_smul, image_eta, zero_smul, h.image_const, singleton_zero]
-
-lemma zero_smul_subset (s : set β) : (0 : α) • s ⊆ 0 := image_subset_iff.2 $ λ x _, zero_smul α x
-
-lemma subsingleton_zero_smul_set (s : set β) : ((0 : α) • s).subsingleton :=
-subsingleton_singleton.mono (zero_smul_subset s)
-
-lemma zero_mem_smul_set {t : set β} {a : α} (h : (0 : β) ∈ t) : (0 : β) ∈ a • t :=
-⟨0, h, smul_zero' _ _⟩
-
-variables [no_zero_smul_divisors α β] {s : set α} {t : set β} {a : α}
-
-lemma zero_mem_smul_iff : (0 : β) ∈ s • t ↔ (0 : α) ∈ s ∧ t.nonempty ∨ (0 : β) ∈ t ∧ s.nonempty :=
-begin
-  split,
-  { rintro ⟨a, b, ha, hb, h⟩,
-    obtain rfl | rfl := eq_zero_or_eq_zero_of_smul_eq_zero h,
-    { exact or.inl ⟨ha, b, hb⟩ },
-    { exact or.inr ⟨hb, a, ha⟩ } },
-  { rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩),
-    { exact ⟨0, b, hs, hb, zero_smul _ _⟩ },
-    { exact ⟨a, 0, ha, ht, smul_zero' _ _⟩ } }
-end
-
-lemma zero_mem_smul_set_iff (ha : a ≠ 0) : (0 : β) ∈ a • t ↔ (0 : β) ∈ t :=
-begin
-  refine ⟨_, zero_mem_smul_set⟩,
-  rintro ⟨b, hb, h⟩,
-  rwa (eq_zero_or_eq_zero_of_smul_eq_zero h).resolve_left ha at hb,
-end
-
-end smul_with_zero
-
-lemma smul_add_set [monoid α] [add_monoid β] [distrib_mul_action α β] (c : α) (s t : set β) :
-  c • (s + t) = c • s + c • t :=
-image_add (distrib_mul_action.to_add_monoid_hom β c).to_add_hom
-
-section group
-variables [group α] [mul_action α β] {A B : set β} {a : α} {x : β}
-
-@[simp, to_additive]
-lemma smul_mem_smul_set_iff : a • x ∈ a • A ↔ x ∈ A :=
-⟨λ h, begin
-  rw [←inv_smul_smul a x, ←inv_smul_smul a A],
-  exact smul_mem_smul_set h,
-end, smul_mem_smul_set⟩
-
-@[to_additive]
-lemma mem_smul_set_iff_inv_smul_mem : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
-show x ∈ mul_action.to_perm a '' A ↔ _, from mem_image_equiv
-
-@[to_additive]
-lemma mem_inv_smul_set_iff : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
-by simp only [← image_smul, mem_image, inv_smul_eq_iff, exists_eq_right]
-
-@[to_additive]
-lemma preimage_smul (a : α) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
-((mul_action.to_perm a).symm.image_eq_preimage _).symm
-
-@[to_additive]
-lemma preimage_smul_inv (a : α) (t : set β) : (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
-preimage_smul (to_units a)⁻¹ t
-
-@[simp, to_additive]
-lemma set_smul_subset_set_smul_iff : a • A ⊆ a • B ↔ A ⊆ B :=
-image_subset_image_iff $ mul_action.injective _
-
-@[to_additive]
-lemma set_smul_subset_iff : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
-(image_subset_iff).trans $ iff_of_eq $ congr_arg _ $
-  preimage_equiv_eq_image_symm _ $ mul_action.to_perm _
-
-@[to_additive]
-lemma subset_set_smul_iff : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
-iff.symm $ (image_subset_iff).trans $ iff.symm $ iff_of_eq $ congr_arg _ $
-  image_equiv_eq_preimage_symm _ $ mul_action.to_perm _
-
-end group
-
-section group_with_zero
-variables [group_with_zero α] [mul_action α β] {s : set α} {a : α}
-
-@[simp] lemma smul_mem_smul_set_iff₀ (ha : a ≠ 0) (A : set β)
-  (x : β) : a • x ∈ a • A ↔ x ∈ A :=
-show units.mk0 a ha • _ ∈ _ ↔ _, from smul_mem_smul_set_iff
-
-lemma mem_smul_set_iff_inv_smul_mem₀ (ha : a ≠ 0) (A : set β) (x : β) :
-  x ∈ a • A ↔ a⁻¹ • x ∈ A :=
-show _ ∈ units.mk0 a ha • _ ↔ _, from mem_smul_set_iff_inv_smul_mem
-
-lemma mem_inv_smul_set_iff₀ (ha : a ≠ 0) (A : set β) (x : β) : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
-show _ ∈ (units.mk0 a ha)⁻¹ • _ ↔ _, from mem_inv_smul_set_iff
-
-lemma preimage_smul₀ (ha : a ≠ 0) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
-preimage_smul (units.mk0 a ha) t
-
-lemma preimage_smul_inv₀ (ha : a ≠ 0) (t : set β) :
-  (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
-preimage_smul ((units.mk0 a ha)⁻¹) t
-
-@[simp] lemma set_smul_subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} :
-  a • A ⊆ a • B ↔ A ⊆ B :=
-show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_set_smul_iff
-
-lemma set_smul_subset_iff₀ (ha : a ≠ 0) {A B : set β} : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
-show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_iff
-
-lemma subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
-show _ ⊆ units.mk0 a ha • _ ↔ _, from subset_set_smul_iff
-
-lemma smul_univ₀ (hs : ¬ s ⊆ 0) : s • (univ : set β) = univ :=
-let ⟨a, ha, ha₀⟩ := not_subset.1 hs in eq_univ_of_forall $ λ b,
-  ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul₀ ha₀ _⟩
-
-lemma smul_set_univ₀ (ha : a ≠ 0) : a • (univ : set β) = univ :=
-eq_univ_of_forall $ λ b, ⟨a⁻¹ • b, trivial, smul_inv_smul₀ ha _⟩
-
-end group_with_zero
-
-end
-
-/-! Some lemmas about pointwise multiplication and submonoids. Ideally we put these in
-  `group_theory.submonoid.basic`, but currently we cannot because that file is imported by this. -/
-namespace submonoid
-
-variables {M : Type*} [monoid M] {s t u : set M}
-
-@[to_additive]
-lemma mul_subset {S : submonoid M} (hs : s ⊆ S) (ht : t ⊆ S) : s * t ⊆ S :=
-by { rintro _ ⟨p, q, hp, hq, rfl⟩, exact submonoid.mul_mem _ (hs hp) (ht hq) }
-
-@[to_additive]
-lemma mul_subset_closure (hs : s ⊆ u) (ht : t ⊆ u) : s * t ⊆ submonoid.closure u :=
-mul_subset (subset.trans hs submonoid.subset_closure) (subset.trans ht submonoid.subset_closure)
-
-@[to_additive]
-lemma coe_mul_self_eq (s : submonoid M) : (s : set M) * s = s :=
-begin
-  ext x,
-  refine ⟨_, λ h, ⟨x, 1, h, s.one_mem, mul_one x⟩⟩,
-  rintro ⟨a, b, ha, hb, rfl⟩,
-  exact s.mul_mem ha hb
-end
-
-@[to_additive]
-lemma closure_mul_le (S T : set M) : closure (S * T) ≤ closure S ⊔ closure T :=
-Inf_le $ λ x ⟨s, t, hs, ht, hx⟩, hx ▸ (closure S ⊔ closure T).mul_mem
-    (set_like.le_def.mp le_sup_left $ subset_closure hs)
-    (set_like.le_def.mp le_sup_right $ subset_closure ht)
-
-@[to_additive]
-lemma sup_eq_closure (H K : submonoid M) : H ⊔ K = closure (H * K) :=
-le_antisymm
-  (sup_le
-    (λ h hh, subset_closure ⟨h, 1, hh, K.one_mem, mul_one h⟩)
-    (λ k hk, subset_closure ⟨1, k, H.one_mem, hk, one_mul k⟩))
-  (by conv_rhs { rw [← closure_eq H, ← closure_eq K] }; apply closure_mul_le)
-
-lemma pow_smul_mem_closure_smul {N : Type*} [comm_monoid N] [mul_action M N]
-  [is_scalar_tower M N N] (r : M) (s : set N) {x : N} (hx : x ∈ closure s) :
-  ∃ n : ℕ, r ^ n • x ∈ closure (r • s) :=
-begin
-  apply @closure_induction N _ s
-    (λ (x : N), ∃ n : ℕ, r ^ n • x ∈ closure (r • s)) _ hx,
-  { intros x hx,
-    exact ⟨1, subset_closure ⟨_, hx, by rw pow_one⟩⟩ },
-  { exact ⟨0, by simpa using one_mem _⟩ },
-  { rintro x y ⟨nx, hx⟩ ⟨ny, hy⟩,
-    use nx + ny,
-    convert mul_mem hx hy,
-    rw [pow_add, smul_mul_assoc, mul_smul, mul_comm, ← smul_mul_assoc, mul_comm] }
-end
-
-end submonoid
-
-namespace group
-
-lemma card_pow_eq_card_pow_card_univ_aux {f : ℕ → ℕ} (h1 : monotone f)
-  {B : ℕ} (h2 : ∀ n, f n ≤ B) (h3 : ∀ n, f n = f (n + 1) → f (n + 1) = f (n + 2)) :
-  ∀ k, B ≤ k → f k = f B :=
-begin
-  have key : ∃ n : ℕ, n ≤ B ∧ f n = f (n + 1),
-  { contrapose! h2,
-    suffices : ∀ n : ℕ, n ≤ B + 1 → n ≤ f n,
-    { exact ⟨B + 1, this (B + 1) (le_refl (B + 1))⟩ },
-    exact λ n, nat.rec (λ h, nat.zero_le (f 0)) (λ n ih h, lt_of_le_of_lt (ih (n.le_succ.trans h))
-      (lt_of_le_of_ne (h1 n.le_succ) (h2 n (nat.succ_le_succ_iff.mp h)))) n },
-  { obtain ⟨n, hn1, hn2⟩ := key,
-    replace key : ∀ k : ℕ, f (n + k) = f (n + k + 1) ∧ f (n + k) = f n :=
-    λ k, nat.rec ⟨hn2, rfl⟩ (λ k ih, ⟨h3 _ ih.1, ih.1.symm.trans ih.2⟩) k,
-    replace key : ∀ k : ℕ, n ≤ k → f k = f n :=
-    λ k hk, (congr_arg f (add_tsub_cancel_of_le hk)).symm.trans (key (k - n)).2,
-    exact λ k hk, (key k (hn1.trans hk)).trans (key B hn1).symm },
-end
-
-variables {G : Type*} [group G] [fintype G] (S : set G)
-
-@[to_additive]
-lemma card_pow_eq_card_pow_card_univ [∀ (k : ℕ), decidable_pred (∈ (S ^ k))] :
-  ∀ k, fintype.card G ≤ k → fintype.card ↥(S ^ k) = fintype.card ↥(S ^ (fintype.card G)) :=
-begin
-  have hG : 0 < fintype.card G := fintype.card_pos_iff.mpr ⟨1⟩,
-  by_cases hS : S = ∅,
-  { refine λ k hk, fintype.card_congr _,
-    rw [hS, empty_pow _ (ne_of_gt (lt_of_lt_of_le hG hk)), empty_pow _ (ne_of_gt hG)] },
-  obtain ⟨a, ha⟩ := set.ne_empty_iff_nonempty.mp hS,
-  classical,
-  have key : ∀ a (s t : set G), (∀ b : G, b ∈ s → a * b ∈ t) → fintype.card s ≤ fintype.card t,
-  { refine λ a s t h, fintype.card_le_of_injective (λ ⟨b, hb⟩, ⟨a * b, h b hb⟩) _,
-    rintro ⟨b, hb⟩ ⟨c, hc⟩ hbc,
-    exact subtype.ext (mul_left_cancel (subtype.ext_iff.mp hbc)) },
-  have mono : monotone (λ n, fintype.card ↥(S ^ n) : ℕ → ℕ) :=
-  monotone_nat_of_le_succ (λ n, key a _ _ (λ b hb, set.mul_mem_mul ha hb)),
-  convert card_pow_eq_card_pow_card_univ_aux mono (λ n, set_fintype_card_le_univ (S ^ n))
-    (λ n h, le_antisymm (mono (n + 1).le_succ) (key a⁻¹ _ _ _)),
-  { simp only [finset.filter_congr_decidable, fintype.card_of_finset] },
-  replace h : {a} * S ^ n = S ^ (n + 1),
-  { refine set.eq_of_subset_of_card_le _ (le_trans (ge_of_eq h) _),
-    { exact mul_subset_mul (set.singleton_subset_iff.mpr ha) set.subset.rfl },
-    { convert key a (S ^ n) ({a} * S ^ n) (λ b hb, set.mul_mem_mul (set.mem_singleton a) hb) } },
-  rw [pow_succ', ←h, mul_assoc, ←pow_succ', h],
-  rintro _ ⟨b, c, hb, hc, rfl⟩,
-  rwa [set.mem_singleton_iff.mp hb, inv_mul_cancel_left],
-end
-
-end group
diff --git a/src/data/set/pointwise/basic.lean b/src/data/set/pointwise/basic.lean
new file mode 100644
index 0000000000000..5b100178a201a
--- /dev/null
+++ b/src/data/set/pointwise/basic.lean
@@ -0,0 +1,726 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Floris van Doorn
+-/
+import algebra.group_power.basic
+import algebra.hom.equiv.basic
+import algebra.hom.units
+import data.set.lattice
+import data.nat.order.basic
+
+/-!
+# Pointwise operations of sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines pointwise algebraic operations on sets.
+
+## Main declarations
+
+For sets `s` and `t` and scalar `a`:
+* `s * t`: Multiplication, set of all `x * y` where `x ∈ s` and `y ∈ t`.
+* `s + t`: Addition, set of all `x + y` where `x ∈ s` and `y ∈ t`.
+* `s⁻¹`: Inversion, set of all `x⁻¹` where `x ∈ s`.
+* `-s`: Negation, set of all `-x` where `x ∈ s`.
+* `s / t`: Division, set of all `x / y` where `x ∈ s` and `y ∈ t`.
+* `s - t`: Subtraction, set of all `x - y` where `x ∈ s` and `y ∈ t`.
+
+For `α` a semigroup/monoid, `set α` is a semigroup/monoid.
+As an unfortunate side effect, this means that `n • s`, where `n : ℕ`, is ambiguous between
+pointwise scaling and repeated pointwise addition; the former has `(2 : ℕ) • {1, 2} = {2, 4}`, while
+the latter has `(2 : ℕ) • {1, 2} = {2, 3, 4}`. See note [pointwise nat action].
+
+Appropriate definitions and results are also transported to the additive theory via `to_additive`.
+
+## Implementation notes
+
+* The following expressions are considered in simp-normal form in a group:
+  `(λ h, h * g) ⁻¹' s`, `(λ h, g * h) ⁻¹' s`, `(λ h, h * g⁻¹) ⁻¹' s`, `(λ h, g⁻¹ * h) ⁻¹' s`,
+  `s * t`, `s⁻¹`, `(1 : set _)` (and similarly for additive variants).
+  Expressions equal to one of these will be simplified.
+* We put all instances in the locale `pointwise`, so that these instances are not available by
+  default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
+  since we expect the locale to be open whenever the instances are actually used (and making the
+  instances reducible changes the behavior of `simp`.
+
+## Tags
+
+set multiplication, set addition, pointwise addition, pointwise multiplication,
+pointwise subtraction
+-/
+
+/--
+Pointwise monoids (`set`, `finset`, `filter`) have derived pointwise actions of the form
+`has_smul α β → has_smul α (set β)`. When `α` is `ℕ` or `ℤ`, this action conflicts with the
+nat or int action coming from `set β` being a `monoid` or `div_inv_monoid`. For example,
+`2 • {a, b}` can both be `{2 • a, 2 • b}` (pointwise action, pointwise repeated addition,
+`set.has_smul_set`) and `{a + a, a + b, b + a, b + b}` (nat or int action, repeated pointwise
+addition, `set.has_nsmul`).
+
+Because the pointwise action can easily be spelled out in such cases, we give higher priority to the
+nat and int actions.
+-/
+library_note "pointwise nat action"
+
+open function
+
+variables {F α β γ : Type*}
+
+namespace set
+
+/-! ### `0`/`1` as sets -/
+
+section one
+variables [has_one α] {s : set α} {a : α}
+
+/-- The set `1 : set α` is defined as `{1}` in locale `pointwise`. -/
+@[to_additive "The set `0 : set α` is defined as `{0}` in locale `pointwise`."]
+protected def has_one : has_one (set α) := ⟨{1}⟩
+
+localized "attribute [instance] set.has_one set.has_zero" in pointwise
+
+@[to_additive] lemma singleton_one : ({1} : set α) = 1 := rfl
+@[simp, to_additive] lemma mem_one : a ∈ (1 : set α) ↔ a = 1 := iff.rfl
+@[to_additive] lemma one_mem_one : (1 : α) ∈ (1 : set α) := eq.refl _
+@[simp, to_additive] lemma one_subset : 1 ⊆ s ↔ (1 : α) ∈ s := singleton_subset_iff
+@[to_additive] lemma one_nonempty : (1 : set α).nonempty := ⟨1, rfl⟩
+@[simp, to_additive] lemma image_one {f : α → β} : f '' 1 = {f 1} := image_singleton
+@[to_additive] lemma subset_one_iff_eq : s ⊆ 1 ↔ s = ∅ ∨ s = 1 := subset_singleton_iff_eq
+@[to_additive] lemma nonempty.subset_one_iff (h : s.nonempty) : s ⊆ 1 ↔ s = 1 :=
+h.subset_singleton_iff
+
+/-- The singleton operation as a `one_hom`. -/
+@[to_additive "The singleton operation as a `zero_hom`."]
+def singleton_one_hom : one_hom α (set α) := ⟨singleton, singleton_one⟩
+
+@[simp, to_additive] lemma coe_singleton_one_hom : (singleton_one_hom : α → set α) = singleton :=
+rfl
+
+end one
+
+/-! ### Set negation/inversion -/
+
+section inv
+
+/-- The pointwise inversion of set `s⁻¹` is defined as `{x | x⁻¹ ∈ s}` in locale `pointwise`. It i
+equal to `{x⁻¹ | x ∈ s}`, see `set.image_inv`. -/
+@[to_additive "The pointwise negation of set `-s` is defined as `{x | -x ∈ s}` in locale
+`pointwise`. It is equal to `{-x | x ∈ s}`, see `set.image_neg`."]
+protected def has_inv [has_inv α] : has_inv (set α) := ⟨preimage has_inv.inv⟩
+
+localized "attribute [instance] set.has_inv set.has_neg" in pointwise
+
+section has_inv
+variables {ι : Sort*} [has_inv α] {s t : set α} {a : α}
+
+@[simp, to_additive] lemma mem_inv : a ∈ s⁻¹ ↔ a⁻¹ ∈ s := iff.rfl
+@[simp, to_additive] lemma inv_preimage : has_inv.inv ⁻¹' s = s⁻¹ := rfl
+@[simp, to_additive] lemma inv_empty : (∅ : set α)⁻¹ = ∅ := rfl
+@[simp, to_additive] lemma inv_univ : (univ : set α)⁻¹ = univ := rfl
+@[simp, to_additive] lemma inter_inv : (s ∩ t)⁻¹ = s⁻¹ ∩ t⁻¹ := preimage_inter
+@[simp, to_additive] lemma union_inv : (s ∪ t)⁻¹ = s⁻¹ ∪ t⁻¹ := preimage_union
+@[simp, to_additive] lemma Inter_inv (s : ι → set α) : (⋂ i, s i)⁻¹ = ⋂ i, (s i)⁻¹ := preimage_Inter
+@[simp, to_additive] lemma Union_inv (s : ι → set α) : (⋃ i, s i)⁻¹ = ⋃ i, (s i)⁻¹ := preimage_Union
+@[simp, to_additive] lemma compl_inv : (sᶜ)⁻¹ = (s⁻¹)ᶜ := preimage_compl
+
+end has_inv
+
+section has_involutive_inv
+variables [has_involutive_inv α] {s t : set α} {a : α}
+
+@[to_additive] lemma inv_mem_inv : a⁻¹ ∈ s⁻¹ ↔ a ∈ s := by simp only [mem_inv, inv_inv]
+
+@[simp, to_additive] lemma nonempty_inv : s⁻¹.nonempty ↔ s.nonempty :=
+inv_involutive.surjective.nonempty_preimage
+
+@[to_additive] lemma nonempty.inv (h : s.nonempty) : s⁻¹.nonempty := nonempty_inv.2 h
+
+@[simp, to_additive]
+lemma image_inv : has_inv.inv '' s = s⁻¹ :=
+congr_fun (image_eq_preimage_of_inverse inv_involutive.left_inverse inv_involutive.right_inverse) _
+
+@[simp, to_additive]
+instance : has_involutive_inv (set α) :=
+{ inv := has_inv.inv,
+  inv_inv := λ s, by { simp only [← inv_preimage, preimage_preimage, inv_inv, preimage_id'] } }
+
+@[simp, to_additive]
+lemma inv_subset_inv : s⁻¹ ⊆ t⁻¹ ↔ s ⊆ t :=
+(equiv.inv α).surjective.preimage_subset_preimage_iff
+
+@[to_additive] lemma inv_subset : s⁻¹ ⊆ t ↔ s ⊆ t⁻¹ := by { rw [← inv_subset_inv, inv_inv] }
+
+@[simp, to_additive] lemma inv_singleton (a : α) : ({a} : set α)⁻¹ = {a⁻¹} :=
+by rw [←image_inv, image_singleton]
+
+@[simp, to_additive] lemma inv_insert (a : α) (s : set α) : (insert a s)⁻¹ = insert a⁻¹ s⁻¹ :=
+by rw [insert_eq, union_inv, inv_singleton, insert_eq]
+
+@[to_additive] lemma inv_range {ι : Sort*} {f : ι → α} : (range f)⁻¹ = range (λ i, (f i)⁻¹) :=
+by { rw ←image_inv, exact (range_comp _ _).symm }
+
+open mul_opposite
+
+@[to_additive]
+lemma image_op_inv : op '' s⁻¹ = (op '' s)⁻¹ :=
+by simp_rw [←image_inv, function.semiconj.set_image op_inv s]
+
+end has_involutive_inv
+end inv
+
+open_locale pointwise
+
+/-! ### Set addition/multiplication -/
+
+section has_mul
+variables {ι : Sort*} {κ : ι → Sort*} [has_mul α] {s s₁ s₂ t t₁ t₂ u : set α} {a b : α}
+
+/-- The pointwise multiplication of sets `s * t` and `t` is defined as `{x * y | x ∈ s, y ∈ t}` in
+locale `pointwise`. -/
+@[to_additive "The pointwise addition of sets `s + t` is defined as `{x + y | x ∈ s, y ∈ t}` in
+locale `pointwise`."]
+protected def has_mul : has_mul (set α) := ⟨image2 (*)⟩
+
+localized "attribute [instance] set.has_mul set.has_add" in pointwise
+
+@[simp, to_additive]
+lemma image2_mul : image2 has_mul.mul s t = s * t := rfl
+
+@[to_additive]
+lemma mem_mul : a ∈ s * t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x * y = a := iff.rfl
+
+@[to_additive] lemma mul_mem_mul : a ∈ s → b ∈ t → a * b ∈ s * t := mem_image2_of_mem
+
+@[to_additive add_image_prod]
+lemma image_mul_prod : (λ x : α × α, x.fst * x.snd) '' s ×ˢ t = s * t := image_prod _
+
+@[simp, to_additive] lemma empty_mul : ∅ * s = ∅ := image2_empty_left
+@[simp, to_additive] lemma mul_empty : s * ∅ = ∅ := image2_empty_right
+@[simp, to_additive] lemma mul_eq_empty : s * t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+@[simp, to_additive] lemma mul_nonempty : (s * t).nonempty ↔ s.nonempty ∧ t.nonempty :=
+image2_nonempty_iff
+@[to_additive] lemma nonempty.mul : s.nonempty → t.nonempty → (s * t).nonempty := nonempty.image2
+@[to_additive] lemma nonempty.of_mul_left : (s * t).nonempty → s.nonempty := nonempty.of_image2_left
+@[to_additive] lemma nonempty.of_mul_right : (s * t).nonempty → t.nonempty :=
+nonempty.of_image2_right
+@[simp, to_additive] lemma mul_singleton : s * {b} = (* b) '' s := image2_singleton_right
+@[simp, to_additive] lemma singleton_mul : {a} * t = ((*) a) '' t := image2_singleton_left
+@[simp, to_additive] lemma singleton_mul_singleton : ({a} : set α) * {b} = {a * b} :=
+image2_singleton
+
+@[to_additive, mono] lemma mul_subset_mul : s₁ ⊆ t₁ → s₂ ⊆ t₂ → s₁ * s₂ ⊆ t₁ * t₂ := image2_subset
+@[to_additive] lemma mul_subset_mul_left : t₁ ⊆ t₂ → s * t₁ ⊆ s * t₂ := image2_subset_left
+@[to_additive] lemma mul_subset_mul_right : s₁ ⊆ s₂ → s₁ * t ⊆ s₂ * t := image2_subset_right
+@[to_additive] lemma mul_subset_iff : s * t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x * y ∈ u := image2_subset_iff
+
+attribute [mono] add_subset_add
+
+@[to_additive] lemma union_mul : (s₁ ∪ s₂) * t = s₁ * t ∪ s₂ * t := image2_union_left
+@[to_additive] lemma mul_union : s * (t₁ ∪ t₂) = s * t₁ ∪ s * t₂ := image2_union_right
+@[to_additive] lemma inter_mul_subset : (s₁ ∩ s₂) * t ⊆ s₁ * t ∩ (s₂ * t) :=
+image2_inter_subset_left
+@[to_additive] lemma mul_inter_subset : s * (t₁ ∩ t₂) ⊆ s * t₁ ∩ (s * t₂) :=
+image2_inter_subset_right
+@[to_additive] lemma inter_mul_union_subset_union : s₁ ∩ s₂ * (t₁ ∪ t₂) ⊆ (s₁ * t₁) ∪ (s₂ * t₂) :=
+image2_inter_union_subset_union
+@[to_additive] lemma union_mul_inter_subset_union : (s₁ ∪ s₂) * (t₁ ∩ t₂) ⊆ (s₁ * t₁) ∪ (s₂ * t₂) :=
+image2_union_inter_subset_union
+
+@[to_additive] lemma Union_mul_left_image : (⋃ a ∈ s, ((*) a) '' t) = s * t := Union_image_left _
+@[to_additive] lemma Union_mul_right_image : (⋃ a ∈ t, (* a) '' s) = s * t := Union_image_right _
+
+@[to_additive] lemma Union_mul (s : ι → set α) (t : set α) : (⋃ i, s i) * t = ⋃ i, s i * t :=
+image2_Union_left _ _ _
+@[to_additive] lemma mul_Union (s : set α) (t : ι → set α) : s * (⋃ i, t i) = ⋃ i, s * t i :=
+image2_Union_right _ _ _
+
+@[to_additive]
+lemma Union₂_mul (s : Π i, κ i → set α) (t : set α) : (⋃ i j, s i j) * t = ⋃ i j, s i j * t :=
+image2_Union₂_left _ _ _
+
+@[to_additive]
+lemma mul_Union₂ (s : set α) (t : Π i, κ i → set α) : s * (⋃ i j, t i j) = ⋃ i j, s * t i j :=
+image2_Union₂_right _ _ _
+
+@[to_additive]
+lemma Inter_mul_subset (s : ι → set α) (t : set α) : (⋂ i, s i) * t ⊆ ⋂ i, s i * t :=
+image2_Inter_subset_left _ _ _
+
+@[to_additive]
+lemma mul_Inter_subset (s : set α) (t : ι → set α) : s * (⋂ i, t i) ⊆ ⋂ i, s * t i :=
+image2_Inter_subset_right _ _ _
+
+@[to_additive]
+lemma Inter₂_mul_subset (s : Π i, κ i → set α) (t : set α) :
+  (⋂ i j, s i j) * t ⊆ ⋂ i j, s i j * t :=
+image2_Inter₂_subset_left _ _ _
+
+@[to_additive]
+lemma mul_Inter₂_subset (s : set α) (t : Π i, κ i → set α) :
+  s * (⋂ i j, t i j) ⊆ ⋂ i j, s * t i j :=
+image2_Inter₂_subset_right _ _ _
+
+/-- The singleton operation as a `mul_hom`. -/
+@[to_additive "The singleton operation as an `add_hom`."]
+def singleton_mul_hom : α →ₙ* set α := ⟨singleton, λ a b, singleton_mul_singleton.symm⟩
+
+@[simp, to_additive] lemma coe_singleton_mul_hom : (singleton_mul_hom : α → set α) = singleton :=
+rfl
+@[simp, to_additive] lemma singleton_mul_hom_apply (a : α) : singleton_mul_hom a = {a} := rfl
+
+open mul_opposite
+
+@[simp, to_additive]
+lemma image_op_mul : op '' (s * t) = op '' t * op '' s := image_image2_antidistrib op_mul
+
+end has_mul
+
+/-! ### Set subtraction/division -/
+
+section has_div
+variables {ι : Sort*} {κ : ι → Sort*} [has_div α] {s s₁ s₂ t t₁ t₂ u : set α} {a b : α}
+
+/-- The pointwise division of sets `s / t` is defined as `{x / y | x ∈ s, y ∈ t}` in locale
+`pointwise`. -/
+@[to_additive "The pointwise subtraction of sets `s - t` is defined as `{x - y | x ∈ s, y ∈ t}` in
+locale `pointwise`."]
+protected def has_div : has_div (set α) := ⟨image2 (/)⟩
+
+localized "attribute [instance] set.has_div set.has_sub" in pointwise
+
+@[simp, to_additive]
+lemma image2_div : image2 has_div.div s t = s / t := rfl
+
+@[to_additive]
+lemma mem_div : a ∈ s / t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x / y = a := iff.rfl
+
+@[to_additive] lemma div_mem_div : a ∈ s → b ∈ t → a / b ∈ s / t := mem_image2_of_mem
+
+@[to_additive add_image_prod]
+lemma image_div_prod : (λ x : α × α, x.fst / x.snd) '' s ×ˢ t = s / t := image_prod _
+
+@[simp, to_additive] lemma empty_div : ∅ / s = ∅ := image2_empty_left
+@[simp, to_additive] lemma div_empty : s / ∅ = ∅ := image2_empty_right
+@[simp, to_additive] lemma div_eq_empty : s / t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+@[simp, to_additive] lemma div_nonempty : (s / t).nonempty ↔ s.nonempty ∧ t.nonempty :=
+image2_nonempty_iff
+@[to_additive] lemma nonempty.div : s.nonempty → t.nonempty → (s / t).nonempty := nonempty.image2
+@[to_additive] lemma nonempty.of_div_left : (s / t).nonempty → s.nonempty := nonempty.of_image2_left
+@[to_additive] lemma nonempty.of_div_right : (s / t).nonempty → t.nonempty :=
+nonempty.of_image2_right
+@[simp, to_additive] lemma div_singleton : s / {b} = (/ b) '' s := image2_singleton_right
+@[simp, to_additive] lemma singleton_div : {a} / t = ((/) a) '' t := image2_singleton_left
+@[simp, to_additive] lemma singleton_div_singleton : ({a} : set α) / {b} = {a / b} :=
+image2_singleton
+
+@[to_additive, mono] lemma div_subset_div : s₁ ⊆ t₁ → s₂ ⊆ t₂ → s₁ / s₂ ⊆ t₁ / t₂ := image2_subset
+@[to_additive] lemma div_subset_div_left : t₁ ⊆ t₂ → s / t₁ ⊆ s / t₂ := image2_subset_left
+@[to_additive] lemma div_subset_div_right : s₁ ⊆ s₂ → s₁ / t ⊆ s₂ / t := image2_subset_right
+@[to_additive] lemma div_subset_iff : s / t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x / y ∈ u := image2_subset_iff
+
+attribute [mono] sub_subset_sub
+
+@[to_additive] lemma union_div : (s₁ ∪ s₂) / t = s₁ / t ∪ s₂ / t := image2_union_left
+@[to_additive] lemma div_union : s / (t₁ ∪ t₂) = s / t₁ ∪ s / t₂ := image2_union_right
+@[to_additive] lemma inter_div_subset : (s₁ ∩ s₂) / t ⊆ s₁ / t ∩ (s₂ / t) :=
+image2_inter_subset_left
+@[to_additive] lemma div_inter_subset : s / (t₁ ∩ t₂) ⊆ s / t₁ ∩ (s / t₂) :=
+image2_inter_subset_right
+@[to_additive] lemma inter_div_union_subset_union : s₁ ∩ s₂ / (t₁ ∪ t₂) ⊆ (s₁ / t₁) ∪ (s₂ / t₂) :=
+image2_inter_union_subset_union
+@[to_additive] lemma union_div_inter_subset_union : (s₁ ∪ s₂) / (t₁ ∩ t₂) ⊆ (s₁ / t₁) ∪ (s₂ / t₂) :=
+image2_union_inter_subset_union
+
+@[to_additive] lemma Union_div_left_image : (⋃ a ∈ s, ((/) a) '' t) = s / t := Union_image_left _
+@[to_additive] lemma Union_div_right_image : (⋃ a ∈ t, (/ a) '' s) = s / t := Union_image_right _
+
+@[to_additive] lemma Union_div (s : ι → set α) (t : set α) : (⋃ i, s i) / t = ⋃ i, s i / t :=
+image2_Union_left _ _ _
+@[to_additive] lemma div_Union (s : set α) (t : ι → set α) : s / (⋃ i, t i) = ⋃ i, s / t i :=
+image2_Union_right _ _ _
+
+@[to_additive]
+lemma Union₂_div (s : Π i, κ i → set α) (t : set α) : (⋃ i j, s i j) / t = ⋃ i j, s i j / t :=
+image2_Union₂_left _ _ _
+
+@[to_additive]
+lemma div_Union₂ (s : set α) (t : Π i, κ i → set α) : s / (⋃ i j, t i j) = ⋃ i j, s / t i j :=
+image2_Union₂_right _ _ _
+
+@[to_additive]
+lemma Inter_div_subset (s : ι → set α) (t : set α) : (⋂ i, s i) / t ⊆ ⋂ i, s i / t :=
+image2_Inter_subset_left _ _ _
+
+@[to_additive]
+lemma div_Inter_subset (s : set α) (t : ι → set α) : s / (⋂ i, t i) ⊆ ⋂ i, s / t i :=
+image2_Inter_subset_right _ _ _
+
+@[to_additive]
+lemma Inter₂_div_subset (s : Π i, κ i → set α) (t : set α) :
+  (⋂ i j, s i j) / t ⊆ ⋂ i j, s i j / t :=
+image2_Inter₂_subset_left _ _ _
+
+@[to_additive]
+lemma div_Inter₂_subset (s : set α) (t : Π i, κ i → set α) :
+  s / (⋂ i j, t i j) ⊆ ⋂ i j, s / t i j :=
+image2_Inter₂_subset_right _ _ _
+
+end has_div
+
+open_locale pointwise
+
+/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `finset`. See
+note [pointwise nat action].-/
+protected def has_nsmul [has_zero α] [has_add α] : has_smul ℕ (set α) := ⟨nsmul_rec⟩
+
+/-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a
+`set`. See note [pointwise nat action]. -/
+@[to_additive]
+protected def has_npow [has_one α] [has_mul α] : has_pow (set α) ℕ := ⟨λ s n, npow_rec n s⟩
+
+/-- Repeated pointwise addition/subtraction (not the same as pointwise repeated
+addition/subtraction!) of a `set`. See note [pointwise nat action]. -/
+protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_smul ℤ (set α) := ⟨zsmul_rec⟩
+
+/-- Repeated pointwise multiplication/division (not the same as pointwise repeated
+multiplication/division!) of a `set`. See note [pointwise nat action]. -/
+@[to_additive] protected def has_zpow [has_one α] [has_mul α] [has_inv α] : has_pow (set α) ℤ :=
+⟨λ s n, zpow_rec n s⟩
+
+localized "attribute [instance] set.has_nsmul set.has_npow set.has_zsmul set.has_zpow" in pointwise
+
+/-- `set α` is a `semigroup` under pointwise operations if `α` is. -/
+@[to_additive "`set α` is an `add_semigroup` under pointwise operations if `α` is."]
+protected def semigroup [semigroup α] : semigroup (set α) :=
+{ mul_assoc := λ _ _ _, image2_assoc mul_assoc,
+  ..set.has_mul }
+
+section comm_semigroup
+variables [comm_semigroup α] {s t : set α}
+
+/-- `set α` is a `comm_semigroup` under pointwise operations if `α` is. -/
+@[to_additive "`set α` is an `add_comm_semigroup` under pointwise operations if `α` is."]
+protected def comm_semigroup : comm_semigroup (set α) :=
+{ mul_comm := λ s t, image2_comm mul_comm
+  ..set.semigroup }
+
+@[to_additive] lemma inter_mul_union_subset : (s ∩ t) * (s ∪ t) ⊆ s * t :=
+image2_inter_union_subset mul_comm
+
+@[to_additive] lemma union_mul_inter_subset : (s ∪ t) * (s ∩ t) ⊆ s * t :=
+image2_union_inter_subset mul_comm
+
+end comm_semigroup
+
+section mul_one_class
+variables [mul_one_class α]
+
+/-- `set α` is a `mul_one_class` under pointwise operations if `α` is. -/
+@[to_additive "`set α` is an `add_zero_class` under pointwise operations if `α` is."]
+protected def mul_one_class : mul_one_class (set α) :=
+{ mul_one := image2_right_identity mul_one,
+  one_mul := image2_left_identity one_mul,
+  ..set.has_one, ..set.has_mul }
+
+localized "attribute [instance] set.mul_one_class set.add_zero_class set.semigroup set.add_semigroup
+  set.comm_semigroup set.add_comm_semigroup" in pointwise
+
+@[to_additive] lemma subset_mul_left (s : set α) {t : set α} (ht : (1 : α) ∈ t) : s ⊆ s * t :=
+λ x hx, ⟨x, 1, hx, ht, mul_one _⟩
+
+@[to_additive] lemma subset_mul_right {s : set α} (t : set α) (hs : (1 : α) ∈ s) : t ⊆ s * t :=
+λ x hx, ⟨1, x, hs, hx, one_mul _⟩
+
+/-- The singleton operation as a `monoid_hom`. -/
+@[to_additive "The singleton operation as an `add_monoid_hom`."]
+def singleton_monoid_hom : α →* set α := { ..singleton_mul_hom, ..singleton_one_hom }
+
+@[simp, to_additive] lemma coe_singleton_monoid_hom :
+  (singleton_monoid_hom : α → set α) = singleton := rfl
+@[simp, to_additive] lemma singleton_monoid_hom_apply (a : α) : singleton_monoid_hom a = {a} := rfl
+
+end mul_one_class
+
+section monoid
+variables [monoid α] {s t : set α} {a : α} {m n : ℕ}
+
+/-- `set α` is a `monoid` under pointwise operations if `α` is. -/
+@[to_additive "`set α` is an `add_monoid` under pointwise operations if `α` is."]
+protected def monoid : monoid (set α) := { ..set.semigroup, ..set.mul_one_class, ..set.has_npow }
+
+localized "attribute [instance] set.monoid set.add_monoid" in pointwise
+
+@[to_additive] lemma pow_mem_pow (ha : a ∈ s) : ∀ n : ℕ, a ^ n ∈ s ^ n
+| 0 := by { rw pow_zero, exact one_mem_one }
+| (n + 1) := by { rw pow_succ, exact mul_mem_mul ha (pow_mem_pow _) }
+
+@[to_additive] lemma pow_subset_pow (hst : s ⊆ t) : ∀ n : ℕ, s ^ n ⊆ t ^ n
+| 0 := by { rw pow_zero, exact subset.rfl }
+| (n + 1) := by { rw pow_succ, exact mul_subset_mul hst (pow_subset_pow _) }
+
+@[to_additive] lemma pow_subset_pow_of_one_mem (hs : (1 : α) ∈ s) : m ≤ n → s ^ m ⊆ s ^ n :=
+begin
+  refine nat.le_induction _ (λ n h ih, _) _,
+  { exact subset.rfl },
+  { rw pow_succ,
+    exact ih.trans (subset_mul_right _ hs) }
+end
+
+@[simp, to_additive] lemma empty_pow {n : ℕ} (hn : n ≠ 0) : (∅ : set α) ^ n = ∅ :=
+by rw [← tsub_add_cancel_of_le (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn), pow_succ, empty_mul]
+
+@[to_additive] lemma mul_univ_of_one_mem (hs : (1 : α) ∈ s) : s * univ = univ :=
+eq_univ_iff_forall.2 $ λ a, mem_mul.2 ⟨_, _, hs, mem_univ _, one_mul _⟩
+
+@[to_additive] lemma univ_mul_of_one_mem (ht : (1 : α) ∈ t) : univ * t = univ :=
+eq_univ_iff_forall.2 $ λ a, mem_mul.2 ⟨_, _, mem_univ _, ht, mul_one _⟩
+
+@[simp, to_additive] lemma univ_mul_univ : (univ : set α) * univ = univ :=
+mul_univ_of_one_mem $ mem_univ _
+
+--TODO: `to_additive` trips up on the `1 : ℕ` used in the pattern-matching.
+@[simp] lemma nsmul_univ {α : Type*} [add_monoid α] : ∀ {n : ℕ}, n ≠ 0 → n • (univ : set α) = univ
+| 0 := λ h, (h rfl).elim
+| 1 := λ _, one_nsmul _
+| (n + 2) := λ _, by { rw [succ_nsmul, nsmul_univ n.succ_ne_zero, univ_add_univ] }
+
+@[simp, to_additive nsmul_univ] lemma univ_pow : ∀ {n : ℕ}, n ≠ 0 → (univ : set α) ^ n = univ
+| 0 := λ h, (h rfl).elim
+| 1 := λ _, pow_one _
+| (n + 2) := λ _, by { rw [pow_succ, univ_pow n.succ_ne_zero, univ_mul_univ] }
+
+@[to_additive] protected lemma _root_.is_unit.set : is_unit a → is_unit ({a} : set α) :=
+is_unit.map (singleton_monoid_hom : α →* set α)
+
+end monoid
+
+/-- `set α` is a `comm_monoid` under pointwise operations if `α` is. -/
+@[to_additive "`set α` is an `add_comm_monoid` under pointwise operations if `α` is."]
+protected def comm_monoid [comm_monoid α] : comm_monoid (set α) :=
+{ ..set.monoid, ..set.comm_semigroup }
+
+localized "attribute [instance] set.comm_monoid set.add_comm_monoid" in pointwise
+
+open_locale pointwise
+
+section division_monoid
+variables [division_monoid α] {s t : set α}
+
+@[to_additive] protected lemma mul_eq_one_iff : s * t = 1 ↔ ∃ a b, s = {a} ∧ t = {b} ∧ a * b = 1 :=
+begin
+  refine ⟨λ h, _, _⟩,
+  { have hst : (s * t).nonempty := h.symm.subst one_nonempty,
+    obtain ⟨a, ha⟩ := hst.of_image2_left,
+    obtain ⟨b, hb⟩ := hst.of_image2_right,
+    have H : ∀ {a b}, a ∈ s → b ∈ t → a * b = (1 : α) :=
+      λ a b ha hb, (h.subset $ mem_image2_of_mem ha hb),
+    refine ⟨a, b, _, _, H ha hb⟩; refine eq_singleton_iff_unique_mem.2 ⟨‹_›, λ x hx, _⟩,
+    { exact (eq_inv_of_mul_eq_one_left $ H hx hb).trans (inv_eq_of_mul_eq_one_left $ H ha hb) },
+    { exact (eq_inv_of_mul_eq_one_right $ H ha hx).trans (inv_eq_of_mul_eq_one_right $ H ha hb) } },
+  { rintro ⟨b, c, rfl, rfl, h⟩,
+    rw [singleton_mul_singleton, h, singleton_one] }
+end
+
+/-- `set α` is a division monoid under pointwise operations if `α` is. -/
+@[to_additive "`set α` is a subtraction monoid under pointwise operations if `α` is."]
+protected def division_monoid : division_monoid (set α) :=
+{ mul_inv_rev := λ s t, by { simp_rw ←image_inv, exact image_image2_antidistrib mul_inv_rev },
+  inv_eq_of_mul := λ s t h, begin
+    obtain ⟨a, b, rfl, rfl, hab⟩ := set.mul_eq_one_iff.1 h,
+    rw [inv_singleton, inv_eq_of_mul_eq_one_right hab],
+  end,
+  div_eq_mul_inv := λ s t,
+    by { rw [←image_id (s / t), ←image_inv], exact image_image2_distrib_right div_eq_mul_inv },
+  ..set.monoid, ..set.has_involutive_inv, ..set.has_div, ..set.has_zpow }
+
+@[simp, to_additive] lemma is_unit_iff : is_unit s ↔ ∃ a, s = {a} ∧ is_unit a :=
+begin
+  split,
+  { rintro ⟨u, rfl⟩,
+    obtain ⟨a, b, ha, hb, h⟩ := set.mul_eq_one_iff.1 u.mul_inv,
+    refine ⟨a, ha, ⟨a, b, h, singleton_injective _⟩, rfl⟩,
+    rw [←singleton_mul_singleton, ←ha, ←hb],
+    exact u.inv_mul },
+  { rintro ⟨a, rfl, ha⟩,
+    exact ha.set }
+end
+
+end division_monoid
+
+/-- `set α` is a commutative division monoid under pointwise operations if `α` is. -/
+@[to_additive subtraction_comm_monoid "`set α` is a commutative subtraction monoid under pointwise
+operations if `α` is."]
+protected def division_comm_monoid [division_comm_monoid α] : division_comm_monoid (set α) :=
+{ ..set.division_monoid, ..set.comm_semigroup }
+
+/-- `set α` has distributive negation if `α` has. -/
+protected def has_distrib_neg [has_mul α] [has_distrib_neg α] : has_distrib_neg (set α) :=
+{ neg_mul := λ _ _, by { simp_rw ←image_neg, exact image2_image_left_comm neg_mul },
+  mul_neg := λ _ _, by { simp_rw ←image_neg, exact image_image2_right_comm mul_neg },
+  ..set.has_involutive_neg }
+
+localized "attribute [instance] set.division_monoid set.subtraction_monoid set.division_comm_monoid
+  set.subtraction_comm_monoid set.has_distrib_neg" in pointwise
+
+section distrib
+variables [distrib α] (s t u : set α)
+
+/-!
+Note that `set α` is not a `distrib` because `s * t + s * u` has cross terms that `s * (t + u)`
+lacks.
+-/
+
+lemma mul_add_subset : s * (t + u) ⊆ s * t + s * u := image2_distrib_subset_left mul_add
+lemma add_mul_subset : (s + t) * u ⊆ s * u + t * u := image2_distrib_subset_right add_mul
+
+end distrib
+
+section mul_zero_class
+variables [mul_zero_class α] {s t : set α}
+
+/-! Note that `set` is not a `mul_zero_class` because `0 * ∅ ≠ 0`. -/
+
+lemma mul_zero_subset (s : set α) : s * 0 ⊆ 0 := by simp [subset_def, mem_mul]
+lemma zero_mul_subset (s : set α) : 0 * s ⊆ 0 := by simp [subset_def, mem_mul]
+
+lemma nonempty.mul_zero (hs : s.nonempty) : s * 0 = 0 :=
+s.mul_zero_subset.antisymm $ by simpa [mem_mul] using hs
+
+lemma nonempty.zero_mul (hs : s.nonempty) : 0 * s = 0 :=
+s.zero_mul_subset.antisymm $ by simpa [mem_mul] using hs
+
+end mul_zero_class
+
+section group
+variables [group α] {s t : set α} {a b : α}
+
+/-! Note that `set` is not a `group` because `s / s ≠ 1` in general. -/
+
+@[simp, to_additive] lemma one_mem_div_iff : (1 : α) ∈ s / t ↔ ¬ disjoint s t :=
+by simp [not_disjoint_iff_nonempty_inter, mem_div, div_eq_one, set.nonempty]
+
+@[to_additive] lemma not_one_mem_div_iff : (1 : α) ∉ s / t ↔ disjoint s t :=
+one_mem_div_iff.not_left
+
+alias not_one_mem_div_iff ↔ _ _root_.disjoint.one_not_mem_div_set
+
+attribute [to_additive] disjoint.one_not_mem_div_set
+
+@[to_additive] lemma nonempty.one_mem_div (h : s.nonempty) : (1 : α) ∈ s / s :=
+let ⟨a, ha⟩ := h in mem_div.2 ⟨a, a, ha, ha, div_self' _⟩
+
+@[to_additive] lemma is_unit_singleton (a : α) : is_unit ({a} : set α) := (group.is_unit a).set
+
+@[simp, to_additive] lemma is_unit_iff_singleton : is_unit s ↔ ∃ a, s = {a} :=
+by simp only [is_unit_iff, group.is_unit, and_true]
+
+@[simp, to_additive] lemma image_mul_left : ((*) a) '' t = ((*) a⁻¹) ⁻¹' t :=
+by { rw image_eq_preimage_of_inverse; intro c; simp }
+
+@[simp, to_additive] lemma image_mul_right : (* b) '' t = (* b⁻¹) ⁻¹' t :=
+by { rw image_eq_preimage_of_inverse; intro c; simp }
+
+@[to_additive] lemma image_mul_left' : (λ b, a⁻¹ * b) '' t = (λ b, a * b) ⁻¹' t := by simp
+@[to_additive] lemma image_mul_right' : (* b⁻¹) '' t = (* b) ⁻¹' t := by simp
+
+@[simp, to_additive] lemma preimage_mul_left_singleton : ((*) a) ⁻¹' {b} = {a⁻¹ * b} :=
+by rw [← image_mul_left', image_singleton]
+
+@[simp, to_additive] lemma preimage_mul_right_singleton : (* a) ⁻¹' {b} = {b * a⁻¹} :=
+by rw [← image_mul_right', image_singleton]
+
+@[simp, to_additive] lemma preimage_mul_left_one : ((*) a) ⁻¹' 1 = {a⁻¹} :=
+by rw [← image_mul_left', image_one, mul_one]
+
+@[simp, to_additive] lemma preimage_mul_right_one : (* b) ⁻¹' 1 = {b⁻¹} :=
+by rw [← image_mul_right', image_one, one_mul]
+
+@[to_additive] lemma preimage_mul_left_one' : (λ b, a⁻¹ * b) ⁻¹' 1 = {a} := by simp
+@[to_additive] lemma preimage_mul_right_one' : (* b⁻¹) ⁻¹' 1 = {b} := by simp
+
+@[simp, to_additive] lemma mul_univ (hs : s.nonempty) : s * (univ : set α) = univ :=
+let ⟨a, ha⟩ := hs in eq_univ_of_forall $ λ b, ⟨a, a⁻¹ * b, ha, trivial, mul_inv_cancel_left _ _⟩
+
+@[simp, to_additive] lemma univ_mul (ht : t.nonempty) : (univ : set α) * t = univ :=
+let ⟨a, ha⟩ := ht in eq_univ_of_forall $ λ b, ⟨b * a⁻¹, a, trivial, ha, inv_mul_cancel_right _ _⟩
+
+end group
+
+section group_with_zero
+variables [group_with_zero α] {s t : set α}
+
+lemma div_zero_subset (s : set α) : s / 0 ⊆ 0 := by simp [subset_def, mem_div]
+lemma zero_div_subset (s : set α) : 0 / s ⊆ 0 := by simp [subset_def, mem_div]
+
+lemma nonempty.div_zero (hs : s.nonempty) : s / 0 = 0 :=
+s.div_zero_subset.antisymm $ by simpa [mem_div] using hs
+
+lemma nonempty.zero_div (hs : s.nonempty) : 0 / s = 0 :=
+s.zero_div_subset.antisymm $ by simpa [mem_div] using hs
+
+end group_with_zero
+
+section has_mul
+variables [has_mul α] [has_mul β] [mul_hom_class F α β] (m : F) {s t : set α}
+include α β
+
+@[to_additive] lemma image_mul : m '' (s * t) = m '' s * m '' t := image_image2_distrib $ map_mul m
+
+@[to_additive]
+lemma preimage_mul_preimage_subset {s t : set β} : m ⁻¹' s * m ⁻¹' t ⊆ m ⁻¹' (s * t) :=
+by { rintro _ ⟨_, _, _, _, rfl⟩, exact ⟨_, _, ‹_›, ‹_›, (map_mul m _ _).symm ⟩ }
+
+end has_mul
+
+section group
+variables [group α] [division_monoid β] [monoid_hom_class F α β] (m : F) {s t : set α}
+include α β
+
+@[to_additive] lemma image_div : m '' (s / t) = m '' s / m '' t := image_image2_distrib $ map_div m
+
+@[to_additive]
+lemma preimage_div_preimage_subset {s t : set β} : m ⁻¹' s / m ⁻¹' t ⊆ m ⁻¹' (s / t) :=
+by { rintro _ ⟨_, _, _, _, rfl⟩, exact ⟨_, _, ‹_›, ‹_›, (map_div m _ _).symm ⟩ }
+
+end group
+
+@[to_additive]
+lemma bdd_above_mul [ordered_comm_monoid α] {A B : set α} :
+  bdd_above A → bdd_above B → bdd_above (A * B) :=
+begin
+  rintro ⟨bA, hbA⟩ ⟨bB, hbB⟩,
+  use bA * bB,
+  rintro x ⟨xa, xb, hxa, hxb, rfl⟩,
+  exact mul_le_mul' (hbA hxa) (hbB hxb),
+end
+
+end set
+
+/-! ### Miscellaneous -/
+
+open set
+open_locale pointwise
+
+namespace group
+
+lemma card_pow_eq_card_pow_card_univ_aux {f : ℕ → ℕ} (h1 : monotone f)
+  {B : ℕ} (h2 : ∀ n, f n ≤ B) (h3 : ∀ n, f n = f (n + 1) → f (n + 1) = f (n + 2)) :
+  ∀ k, B ≤ k → f k = f B :=
+begin
+  have key : ∃ n : ℕ, n ≤ B ∧ f n = f (n + 1),
+  { contrapose! h2,
+    suffices : ∀ n : ℕ, n ≤ B + 1 → n ≤ f n,
+    { exact ⟨B + 1, this (B + 1) (le_refl (B + 1))⟩ },
+    exact λ n, nat.rec (λ h, nat.zero_le (f 0)) (λ n ih h, lt_of_le_of_lt (ih (n.le_succ.trans h))
+      (lt_of_le_of_ne (h1 n.le_succ) (h2 n (nat.succ_le_succ_iff.mp h)))) n },
+  { obtain ⟨n, hn1, hn2⟩ := key,
+    replace key : ∀ k : ℕ, f (n + k) = f (n + k + 1) ∧ f (n + k) = f n :=
+    λ k, nat.rec ⟨hn2, rfl⟩ (λ k ih, ⟨h3 _ ih.1, ih.1.symm.trans ih.2⟩) k,
+    replace key : ∀ k : ℕ, n ≤ k → f k = f n :=
+    λ k hk, (congr_arg f (add_tsub_cancel_of_le hk)).symm.trans (key (k - n)).2,
+    exact λ k hk, (key k (hn1.trans hk)).trans (key B hn1).symm },
+end
+
+end group
diff --git a/src/data/set/pointwise/big_operators.lean b/src/data/set/pointwise/big_operators.lean
new file mode 100644
index 0000000000000..5460c2512846c
--- /dev/null
+++ b/src/data/set/pointwise/big_operators.lean
@@ -0,0 +1,170 @@
+/-
+Copyright (c) 2021 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import algebra.big_operators.basic
+import data.set.pointwise.basic
+
+/-!
+# Results about pointwise operations on sets and big operators.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+namespace set
+
+open_locale big_operators pointwise
+open function
+
+variables {ι α β F : Type*}
+
+section monoid
+variables [monoid α] [monoid β] [monoid_hom_class F α β]
+
+@[to_additive]
+lemma image_list_prod (f : F) : ∀ (l : list (set α)),
+  (f : α → β) '' l.prod = (l.map (λ s, f '' s)).prod
+| [] := image_one.trans $ congr_arg singleton (map_one f)
+| (a :: as) := by rw [list.map_cons, list.prod_cons, list.prod_cons, image_mul, image_list_prod]
+
+end monoid
+
+section comm_monoid
+variables [comm_monoid α] [comm_monoid β] [monoid_hom_class F α β]
+
+@[to_additive]
+lemma image_multiset_prod (f : F) : ∀ (m : multiset (set α)),
+  (f : α → β) '' m.prod = (m.map (λ s, f '' s)).prod :=
+quotient.ind $ by simpa only [multiset.quot_mk_to_coe, multiset.coe_prod, multiset.coe_map]
+                 using image_list_prod f
+
+@[to_additive]
+lemma image_finset_prod (f : F) (m : finset ι) (s : ι → set α) :
+  (f : α → β) '' (∏ i in m, s i) = (∏ i in m, f '' s i) :=
+(image_multiset_prod f _).trans $ congr_arg multiset.prod $ multiset.map_map _ _ _
+
+/-- The n-ary version of `set.mem_mul`. -/
+@[to_additive /-" The n-ary version of `set.mem_add`. "-/]
+lemma mem_finset_prod (t : finset ι) (f : ι → set α) (a : α) :
+  a ∈ ∏ i in t, f i ↔ ∃ (g : ι → α) (hg : ∀ {i}, i ∈ t → g i ∈ f i), ∏ i in t, g i = a :=
+begin
+  classical,
+  induction t using finset.induction_on with i is hi ih generalizing a,
+  { simp_rw [finset.prod_empty, set.mem_one],
+    exact ⟨λ h, ⟨λ i, a, λ i, false.elim, h.symm⟩, λ ⟨f, _, hf⟩, hf.symm⟩ },
+  rw [finset.prod_insert hi, set.mem_mul],
+  simp_rw [finset.prod_insert hi],
+  simp_rw ih,
+  split,
+  { rintro ⟨x, y, hx, ⟨g, hg, rfl⟩, rfl⟩,
+    refine ⟨function.update g i x, λ j hj, _, _⟩,
+    obtain rfl | hj := finset.mem_insert.mp hj,
+    { rw function.update_same, exact hx },
+    { rw update_noteq (ne_of_mem_of_not_mem hj hi), exact hg hj, },
+    rw [finset.prod_update_of_not_mem hi, function.update_same], },
+  { rintro ⟨g, hg, rfl⟩,
+    exact ⟨g i, is.prod g, hg (is.mem_insert_self _),
+      ⟨g, λ i hi, hg (finset.mem_insert_of_mem hi), rfl⟩, rfl⟩ },
+end
+
+/-- A version of `set.mem_finset_prod` with a simpler RHS for products over a fintype. -/
+@[to_additive /-" A version of `set.mem_finset_sum` with a simpler RHS for sums over a fintype. "-/]
+lemma mem_fintype_prod [fintype ι] (f : ι → set α) (a : α) :
+  a ∈ ∏ i, f i ↔ ∃ (g : ι → α) (hg : ∀ i, g i ∈ f i), ∏ i, g i = a :=
+by { rw mem_finset_prod, simp }
+
+/-- An n-ary version of `set.mul_mem_mul`. -/
+@[to_additive /-" An n-ary version of `set.add_mem_add`. "-/]
+lemma list_prod_mem_list_prod (t : list ι) (f : ι → set α)
+  (g : ι → α) (hg : ∀ i ∈ t, g i ∈ f i) :
+  (t.map g).prod ∈ (t.map f).prod :=
+begin
+  induction t with h tl ih,
+  { simp_rw [list.map_nil, list.prod_nil, set.mem_one] },
+  { simp_rw [list.map_cons, list.prod_cons],
+    exact mul_mem_mul
+      (hg h $ list.mem_cons_self _ _) (ih $ λ i hi, hg i $ list.mem_cons_of_mem _ hi) }
+end
+
+/-- An n-ary version of `set.mul_subset_mul`. -/
+@[to_additive /-" An n-ary version of `set.add_subset_add`. "-/]
+lemma list_prod_subset_list_prod (t : list ι) (f₁ f₂ : ι → set α) (hf : ∀ i ∈ t, f₁ i ⊆ f₂ i) :
+  (t.map f₁).prod ⊆ (t.map f₂).prod :=
+begin
+  induction t with h tl ih,
+  { refl, },
+  { simp_rw [list.map_cons, list.prod_cons],
+    exact mul_subset_mul
+      (hf h $ list.mem_cons_self _ _) (ih $ λ i hi, hf i $ list.mem_cons_of_mem _ hi) }
+end
+
+@[to_additive]
+lemma list_prod_singleton {M : Type*} [comm_monoid M] (s : list M) :
+  (s.map $ λ i, ({i} : set M)).prod = {s.prod} :=
+(map_list_prod (singleton_monoid_hom : M →* set M) _).symm
+
+/-- An n-ary version of `set.mul_mem_mul`. -/
+@[to_additive /-" An n-ary version of `set.add_mem_add`. "-/]
+lemma multiset_prod_mem_multiset_prod (t : multiset ι) (f : ι → set α)
+  (g : ι → α) (hg : ∀ i ∈ t, g i ∈ f i) :
+  (t.map g).prod ∈ (t.map f).prod :=
+begin
+  induction t using quotient.induction_on,
+  simp_rw [multiset.quot_mk_to_coe, multiset.coe_map, multiset.coe_prod],
+  exact list_prod_mem_list_prod _ _ _ hg,
+end
+
+/-- An n-ary version of `set.mul_subset_mul`. -/
+@[to_additive /-" An n-ary version of `set.add_subset_add`. "-/]
+lemma multiset_prod_subset_multiset_prod (t : multiset ι) (f₁ f₂ : ι → set α)
+  (hf : ∀ i ∈ t, f₁ i ⊆ f₂ i) :
+  (t.map f₁).prod ⊆ (t.map f₂).prod :=
+begin
+  induction t using quotient.induction_on,
+  simp_rw [multiset.quot_mk_to_coe, multiset.coe_map, multiset.coe_prod],
+  exact list_prod_subset_list_prod _ _ _ hf,
+end
+
+@[to_additive]
+lemma multiset_prod_singleton {M : Type*} [comm_monoid M] (s : multiset M) :
+  (s.map $ λ i, ({i} : set M)).prod = {s.prod} :=
+(map_multiset_prod (singleton_monoid_hom : M →* set M) _).symm
+
+/-- An n-ary version of `set.mul_mem_mul`. -/
+@[to_additive /-" An n-ary version of `set.add_mem_add`. "-/]
+lemma finset_prod_mem_finset_prod (t : finset ι) (f : ι → set α)
+  (g : ι → α) (hg : ∀ i ∈ t, g i ∈ f i) :
+  ∏ i in t, g i ∈ ∏ i in t, f i :=
+multiset_prod_mem_multiset_prod _ _ _ hg
+
+/-- An n-ary version of `set.mul_subset_mul`. -/
+@[to_additive /-" An n-ary version of `set.add_subset_add`. "-/]
+lemma finset_prod_subset_finset_prod (t : finset ι) (f₁ f₂ : ι → set α)
+  (hf : ∀ i ∈ t, f₁ i ⊆ f₂ i) :
+  ∏ i in t, f₁ i ⊆ ∏ i in t, f₂ i :=
+multiset_prod_subset_multiset_prod _ _ _ hf
+
+@[to_additive]
+lemma finset_prod_singleton {M ι : Type*} [comm_monoid M] (s : finset ι) (I : ι → M) :
+  ∏ (i : ι) in s, ({I i} : set M) = {∏ (i : ι) in s, I i} :=
+(map_prod (singleton_monoid_hom : M →* set M) _ _).symm
+
+/-- The n-ary version of `set.image_mul_prod`. -/
+@[to_additive "The n-ary version of `set.add_image_prod`. "]
+lemma image_finset_prod_pi (l : finset ι) (S : ι → set α) :
+  (λ f : ι → α, ∏ i in l, f i) '' (l : set ι).pi S = (∏ i in l, S i) :=
+by { ext, simp_rw [mem_finset_prod, mem_image, mem_pi, exists_prop, finset.mem_coe] }
+
+/-- A special case of `set.image_finset_prod_pi` for `finset.univ`. -/
+@[to_additive "A special case of `set.image_finset_sum_pi` for `finset.univ`. "]
+lemma image_fintype_prod_pi [fintype ι] (S : ι → set α) :
+  (λ f : ι → α, ∏ i, f i) '' univ.pi S = (∏ i, S i) :=
+by simpa only [finset.coe_univ] using image_finset_prod_pi finset.univ S
+
+end comm_monoid
+
+/-! TODO: define `decidable_mem_finset_prod` and `decidable_mem_finset_sum`. -/
+
+end set
diff --git a/src/data/set/pointwise/finite.lean b/src/data/set/pointwise/finite.lean
new file mode 100644
index 0000000000000..ba1fc40875cfd
--- /dev/null
+++ b/src/data/set/pointwise/finite.lean
@@ -0,0 +1,151 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Floris van Doorn
+-/
+import data.set.finite
+import data.set.pointwise.smul
+
+/-!
+# Finiteness lemmas for pointwise operations on sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open_locale pointwise
+
+variables {F α β γ : Type*}
+
+namespace set
+section has_one
+variables [has_one α]
+
+@[simp, to_additive] lemma finite_one : (1 : set α).finite := finite_singleton _
+
+end has_one
+
+section has_involutive_inv
+variables [has_involutive_inv α] {s : set α}
+
+@[to_additive] lemma finite.inv (hs : s.finite) : s⁻¹.finite :=
+hs.preimage $ inv_injective.inj_on _
+
+end has_involutive_inv
+
+section has_mul
+variables [has_mul α] {s t : set α}
+
+@[to_additive] lemma finite.mul : s.finite → t.finite → (s * t).finite := finite.image2 _
+
+/-- Multiplication preserves finiteness. -/
+@[to_additive "Addition preserves finiteness."]
+def fintype_mul [decidable_eq α] (s t : set α) [fintype s] [fintype t] : fintype (s * t : set α) :=
+set.fintype_image2 _ _ _
+
+end has_mul
+
+section monoid
+variables [monoid α] {s t : set α}
+
+@[to_additive]
+instance decidable_mem_mul [fintype α] [decidable_eq α] [decidable_pred (∈ s)]
+  [decidable_pred (∈ t)] :
+  decidable_pred (∈ s * t) :=
+λ _, decidable_of_iff _ mem_mul.symm
+
+@[to_additive]
+instance decidable_mem_pow [fintype α] [decidable_eq α] [decidable_pred (∈ s)] (n : ℕ) :
+  decidable_pred (∈ (s ^ n)) :=
+begin
+  induction n with n ih,
+  { simp_rw [pow_zero, mem_one], apply_instance },
+  { letI := ih, rw pow_succ, apply_instance }
+end
+
+end monoid
+
+section has_smul
+variables [has_smul α β] {s : set α} {t : set β}
+
+@[to_additive] lemma finite.smul : s.finite → t.finite → (s • t).finite := finite.image2 _
+
+end has_smul
+
+section has_smul_set
+variables [has_smul α β] {s : set β} {a : α}
+
+@[to_additive] lemma finite.smul_set : s.finite → (a • s).finite := finite.image _
+@[to_additive] lemma infinite.of_smul_set : (a • s).infinite → s.infinite := infinite.of_image _
+
+end has_smul_set
+
+section vsub
+variables [has_vsub α β] {s t : set β}
+include α
+
+lemma finite.vsub (hs : s.finite) (ht : t.finite) : set.finite (s -ᵥ t) := hs.image2 _ ht
+
+end vsub
+
+section cancel
+variables [has_mul α] [is_left_cancel_mul α] [is_right_cancel_mul α] {s t : set α}
+
+@[to_additive] lemma infinite_mul :
+  (s * t).infinite ↔ s.infinite ∧ t.nonempty ∨ t.infinite ∧ s.nonempty :=
+infinite_image2 (λ _ _, (mul_left_injective _).inj_on _) (λ _ _, (mul_right_injective _).inj_on _)
+
+end cancel
+
+section group
+variables [group α] [mul_action α β] {a : α} {s : set β}
+
+@[simp, to_additive] lemma finite_smul_set : (a • s).finite ↔ s.finite :=
+finite_image_iff $ (mul_action.injective _).inj_on _
+
+@[simp, to_additive] lemma infinite_smul_set : (a • s).infinite ↔ s.infinite :=
+infinite_image_iff $ (mul_action.injective _).inj_on _
+
+alias finite_smul_set ↔ finite.of_smul_set _
+alias infinite_smul_set ↔ _ infinite.smul_set
+
+attribute [to_additive] finite.of_smul_set infinite.smul_set
+
+end group
+end set
+
+open set
+
+namespace group
+
+variables {G : Type*} [group G] [fintype G] (S : set G)
+
+@[to_additive]
+lemma card_pow_eq_card_pow_card_univ [∀ (k : ℕ), decidable_pred (∈ (S ^ k))] :
+  ∀ k, fintype.card G ≤ k → fintype.card ↥(S ^ k) = fintype.card ↥(S ^ (fintype.card G)) :=
+begin
+  have hG : 0 < fintype.card G := fintype.card_pos_iff.mpr ⟨1⟩,
+  by_cases hS : S = ∅,
+  { refine λ k hk, fintype.card_congr _,
+    rw [hS, empty_pow (ne_of_gt (lt_of_lt_of_le hG hk)), empty_pow (ne_of_gt hG)] },
+  obtain ⟨a, ha⟩ := set.nonempty_iff_ne_empty.2 hS,
+  classical!,
+  have key : ∀ a (s t : set G), (∀ b : G, b ∈ s → a * b ∈ t) → fintype.card s ≤ fintype.card t,
+  { refine λ a s t h, fintype.card_le_of_injective (λ ⟨b, hb⟩, ⟨a * b, h b hb⟩) _,
+    rintro ⟨b, hb⟩ ⟨c, hc⟩ hbc,
+    exact subtype.ext (mul_left_cancel (subtype.ext_iff.mp hbc)) },
+  have mono : monotone (λ n, fintype.card ↥(S ^ n) : ℕ → ℕ) :=
+  monotone_nat_of_le_succ (λ n, key a _ _ (λ b hb, set.mul_mem_mul ha hb)),
+  convert card_pow_eq_card_pow_card_univ_aux mono (λ n, set_fintype_card_le_univ (S ^ n))
+    (λ n h, le_antisymm (mono (n + 1).le_succ) (key a⁻¹ _ _ _)),
+  { simp only [finset.filter_congr_decidable, fintype.card_of_finset] },
+  replace h : {a} * S ^ n = S ^ (n + 1),
+  { refine set.eq_of_subset_of_card_le _ (le_trans (ge_of_eq h) _),
+    { exact mul_subset_mul (set.singleton_subset_iff.mpr ha) set.subset.rfl },
+    { convert key a (S ^ n) ({a} * S ^ n) (λ b hb, set.mul_mem_mul (set.mem_singleton a) hb) } },
+  rw [pow_succ', ←h, mul_assoc, ←pow_succ', h],
+  rintro _ ⟨b, c, hb, hc, rfl⟩,
+  rwa [set.mem_singleton_iff.mp hb, inv_mul_cancel_left],
+end
+
+end group
diff --git a/src/data/set/pointwise/interval.lean b/src/data/set/pointwise/interval.lean
new file mode 100644
index 0000000000000..723d973f360d3
--- /dev/null
+++ b/src/data/set/pointwise/interval.lean
@@ -0,0 +1,534 @@
+/-
+Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury G. Kudryashov, Patrick Massot
+-/
+import data.set.intervals.unordered_interval
+import data.set.intervals.monoid
+import data.set.pointwise.basic
+import algebra.order.field.basic
+import algebra.order.group.min_max
+
+/-!
+# (Pre)images of intervals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove a bunch of trivial lemmas like “if we add `a` to all points of `[b, c]`,
+then we get `[a + b, a + c]`”. For the functions `x ↦ x ± a`, `x ↦ a ± x`, and `x ↦ -x` we prove
+lemmas about preimages and images of all intervals. We also prove a few lemmas about images under
+`x ↦ a * x`, `x ↦ x * a` and `x ↦ x⁻¹`.
+-/
+
+open_locale interval pointwise
+
+variables {α : Type*}
+
+namespace set
+
+section ordered_add_comm_group
+variables [ordered_add_comm_group α] (a b c : α)
+
+/-!
+### Preimages under `x ↦ a + x`
+-/
+
+@[simp] lemma preimage_const_add_Ici : (λ x, a + x) ⁻¹' (Ici b) = Ici (b - a) :=
+ext $ λ x, sub_le_iff_le_add'.symm
+
+@[simp] lemma preimage_const_add_Ioi : (λ x, a + x) ⁻¹' (Ioi b) = Ioi (b - a) :=
+ext $ λ x, sub_lt_iff_lt_add'.symm
+
+@[simp] lemma preimage_const_add_Iic : (λ x, a + x) ⁻¹' (Iic b) = Iic (b - a) :=
+ext $ λ x, le_sub_iff_add_le'.symm
+
+@[simp] lemma preimage_const_add_Iio : (λ x, a + x) ⁻¹' (Iio b) = Iio (b - a) :=
+ext $ λ x, lt_sub_iff_add_lt'.symm
+
+@[simp] lemma preimage_const_add_Icc : (λ x, a + x) ⁻¹' (Icc b c) = Icc (b - a) (c - a) :=
+by simp [← Ici_inter_Iic]
+
+@[simp] lemma preimage_const_add_Ico : (λ x, a + x) ⁻¹' (Ico b c) = Ico (b - a) (c - a) :=
+by simp [← Ici_inter_Iio]
+
+@[simp] lemma preimage_const_add_Ioc : (λ x, a + x) ⁻¹' (Ioc b c) = Ioc (b - a) (c - a) :=
+by simp [← Ioi_inter_Iic]
+
+@[simp] lemma preimage_const_add_Ioo : (λ x, a + x) ⁻¹' (Ioo b c) = Ioo (b - a) (c - a) :=
+by simp [← Ioi_inter_Iio]
+
+/-!
+### Preimages under `x ↦ x + a`
+-/
+
+@[simp] lemma preimage_add_const_Ici : (λ x, x + a) ⁻¹' (Ici b) = Ici (b - a) :=
+ext $ λ x, sub_le_iff_le_add.symm
+
+@[simp] lemma preimage_add_const_Ioi : (λ x, x + a) ⁻¹' (Ioi b) = Ioi (b - a) :=
+ext $ λ x, sub_lt_iff_lt_add.symm
+
+@[simp] lemma preimage_add_const_Iic : (λ x, x + a) ⁻¹' (Iic b) = Iic (b - a) :=
+ext $ λ x, le_sub_iff_add_le.symm
+
+@[simp] lemma preimage_add_const_Iio : (λ x, x + a) ⁻¹' (Iio b) = Iio (b - a) :=
+ext $ λ x, lt_sub_iff_add_lt.symm
+
+@[simp] lemma preimage_add_const_Icc : (λ x, x + a) ⁻¹' (Icc b c) = Icc (b - a) (c - a) :=
+by simp [← Ici_inter_Iic]
+
+@[simp] lemma preimage_add_const_Ico : (λ x, x + a) ⁻¹' (Ico b c) = Ico (b - a) (c - a) :=
+by simp [← Ici_inter_Iio]
+
+@[simp] lemma preimage_add_const_Ioc : (λ x, x + a) ⁻¹' (Ioc b c) = Ioc (b - a) (c - a) :=
+by simp [← Ioi_inter_Iic]
+
+@[simp] lemma preimage_add_const_Ioo : (λ x, x + a) ⁻¹' (Ioo b c) = Ioo (b - a) (c - a) :=
+by simp [← Ioi_inter_Iio]
+
+/-!
+### Preimages under `x ↦ -x`
+-/
+
+@[simp] lemma preimage_neg_Ici : - Ici a = Iic (-a) := ext $ λ x, le_neg
+@[simp] lemma preimage_neg_Iic : - Iic a = Ici (-a) := ext $ λ x, neg_le
+@[simp] lemma preimage_neg_Ioi : - Ioi a = Iio (-a) := ext $ λ x, lt_neg
+@[simp] lemma preimage_neg_Iio : - Iio a = Ioi (-a) := ext $ λ x, neg_lt
+
+@[simp] lemma preimage_neg_Icc : - Icc a b = Icc (-b) (-a) :=
+by simp [← Ici_inter_Iic, inter_comm]
+
+@[simp] lemma preimage_neg_Ico : - Ico a b = Ioc (-b) (-a) :=
+by simp [← Ici_inter_Iio, ← Ioi_inter_Iic, inter_comm]
+
+@[simp] lemma preimage_neg_Ioc : - Ioc a b = Ico (-b) (-a) :=
+by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]
+
+@[simp] lemma preimage_neg_Ioo : - Ioo a b = Ioo (-b) (-a) :=
+by simp [← Ioi_inter_Iio, inter_comm]
+
+/-!
+### Preimages under `x ↦ x - a`
+-/
+
+@[simp] lemma preimage_sub_const_Ici : (λ x, x - a) ⁻¹' (Ici b) = Ici (b + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Ioi : (λ x, x - a) ⁻¹' (Ioi b) = Ioi (b + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Iic : (λ x, x - a) ⁻¹' (Iic b) = Iic (b + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Iio : (λ x, x - a) ⁻¹' (Iio b) = Iio (b + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Icc : (λ x, x - a) ⁻¹' (Icc b c) = Icc (b + a) (c + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Ico : (λ x, x - a) ⁻¹' (Ico b c) = Ico (b + a) (c + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Ioc : (λ x, x - a) ⁻¹' (Ioc b c) = Ioc (b + a) (c + a) :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_sub_const_Ioo : (λ x, x - a) ⁻¹' (Ioo b c) = Ioo (b + a) (c + a) :=
+by simp [sub_eq_add_neg]
+
+/-!
+### Preimages under `x ↦ a - x`
+-/
+
+@[simp] lemma preimage_const_sub_Ici : (λ x, a - x) ⁻¹' (Ici b) = Iic (a - b) :=
+ext $ λ x, le_sub_comm
+
+@[simp] lemma preimage_const_sub_Iic : (λ x, a - x) ⁻¹' (Iic b) = Ici (a - b) :=
+ext $ λ x, sub_le_comm
+
+@[simp] lemma preimage_const_sub_Ioi : (λ x, a - x) ⁻¹' (Ioi b) = Iio (a - b) :=
+ext $ λ x, lt_sub_comm
+
+@[simp] lemma preimage_const_sub_Iio : (λ x, a - x) ⁻¹' (Iio b) = Ioi (a - b) :=
+ext $ λ x, sub_lt_comm
+
+@[simp] lemma preimage_const_sub_Icc : (λ x, a - x) ⁻¹' (Icc b c) = Icc (a - c) (a - b) :=
+by simp [← Ici_inter_Iic, inter_comm]
+
+@[simp] lemma preimage_const_sub_Ico : (λ x, a - x) ⁻¹' (Ico b c) = Ioc (a - c) (a - b) :=
+by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]
+
+@[simp] lemma preimage_const_sub_Ioc : (λ x, a - x) ⁻¹' (Ioc b c) = Ico (a - c) (a - b) :=
+by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, inter_comm]
+
+@[simp] lemma preimage_const_sub_Ioo : (λ x, a - x) ⁻¹' (Ioo b c) = Ioo (a - c) (a - b) :=
+by simp [← Ioi_inter_Iio, inter_comm]
+
+/-!
+### Images under `x ↦ a + x`
+-/
+
+@[simp] lemma image_const_add_Iic : (λ x, a + x) '' Iic b = Iic (a + b) :=
+by simp [add_comm]
+
+@[simp] lemma image_const_add_Iio : (λ x, a + x) '' Iio b = Iio (a + b) :=
+by simp [add_comm]
+
+/-!
+### Images under `x ↦ x + a`
+-/
+
+@[simp] lemma image_add_const_Iic : (λ x, x + a) '' Iic b = Iic (b + a) := by simp
+@[simp] lemma image_add_const_Iio : (λ x, x + a) '' Iio b = Iio (b + a) := by simp
+
+/-!
+### Images under `x ↦ -x`
+-/
+
+lemma image_neg_Ici : has_neg.neg '' (Ici a) = Iic (-a) := by simp
+lemma image_neg_Iic : has_neg.neg '' (Iic a) = Ici (-a) := by simp
+lemma image_neg_Ioi : has_neg.neg '' (Ioi a) = Iio (-a) := by simp
+lemma image_neg_Iio : has_neg.neg '' (Iio a) = Ioi (-a) := by simp
+lemma image_neg_Icc : has_neg.neg '' (Icc a b) = Icc (-b) (-a) := by simp
+lemma image_neg_Ico : has_neg.neg '' (Ico a b) = Ioc (-b) (-a) := by simp
+lemma image_neg_Ioc : has_neg.neg '' (Ioc a b) = Ico (-b) (-a) := by simp
+lemma image_neg_Ioo : has_neg.neg '' (Ioo a b) = Ioo (-b) (-a) := by simp
+
+/-!
+### Images under `x ↦ a - x`
+-/
+
+@[simp] lemma image_const_sub_Ici : (λ x, a - x) '' Ici b = Iic (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+
+@[simp] lemma image_const_sub_Iic : (λ x, a - x) '' Iic b = Ici (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
+
+@[simp] lemma image_const_sub_Ioi : (λ x, a - x) '' Ioi b = Iio (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+
+@[simp] lemma image_const_sub_Iio : (λ x, a - x) '' Iio b = Ioi (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
+
+@[simp] lemma image_const_sub_Icc : (λ x, a - x) '' Icc b c = Icc (a - c) (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
+
+@[simp] lemma image_const_sub_Ico : (λ x, a - x) '' Ico b c = Ioc (a - c) (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
+
+@[simp] lemma image_const_sub_Ioc : (λ x, a - x) '' Ioc b c = Ico (a - c) (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
+
+@[simp] lemma image_const_sub_Ioo : (λ x, a - x) '' Ioo b c = Ioo (a - c) (a - b) :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x), add_comm]
+
+/-!
+### Images under `x ↦ x - a`
+-/
+
+@[simp] lemma image_sub_const_Ici : (λ x, x - a) '' Ici b = Ici (b - a) := by simp [sub_eq_neg_add]
+@[simp] lemma image_sub_const_Iic : (λ x, x - a) '' Iic b = Iic (b - a) := by simp [sub_eq_neg_add]
+@[simp] lemma image_sub_const_Ioi : (λ x, x - a) '' Ioi b = Ioi (b - a) := by simp [sub_eq_neg_add]
+@[simp] lemma image_sub_const_Iio : (λ x, x - a) '' Iio b = Iio (b - a) := by simp [sub_eq_neg_add]
+
+@[simp] lemma image_sub_const_Icc : (λ x, x - a) '' Icc b c = Icc (b - a) (c - a) :=
+by simp [sub_eq_neg_add]
+
+@[simp] lemma image_sub_const_Ico : (λ x, x - a) '' Ico b c = Ico (b - a) (c - a) :=
+by simp [sub_eq_neg_add]
+
+@[simp] lemma image_sub_const_Ioc : (λ x, x - a) '' Ioc b c = Ioc (b - a) (c - a) :=
+by simp [sub_eq_neg_add]
+
+@[simp] lemma image_sub_const_Ioo : (λ x, x - a) '' Ioo b c = Ioo (b - a) (c - a) :=
+by simp [sub_eq_neg_add]
+
+/-!
+### Bijections
+-/
+
+lemma Iic_add_bij : bij_on (+a) (Iic b) (Iic (b + a)) :=
+image_add_const_Iic a b ▸ ((add_left_injective _).inj_on _).bij_on_image
+
+lemma Iio_add_bij : bij_on (+a) (Iio b) (Iio (b + a)) :=
+image_add_const_Iio a b ▸ ((add_left_injective _).inj_on _).bij_on_image
+
+end ordered_add_comm_group
+
+section linear_ordered_add_comm_group
+variables [linear_ordered_add_comm_group α] (a b c d : α)
+
+@[simp] lemma preimage_const_add_uIcc : (λ x, a + x) ⁻¹' [b, c] = [b - a, c - a] :=
+by simp only [←Icc_min_max, preimage_const_add_Icc, min_sub_sub_right, max_sub_sub_right]
+
+@[simp] lemma preimage_add_const_uIcc : (λ x, x + a) ⁻¹' [b, c] = [b - a, c - a] :=
+by simpa only [add_comm] using preimage_const_add_uIcc a b c
+
+@[simp] lemma preimage_neg_uIcc : - [a, b] = [-a, -b] :=
+by simp only [←Icc_min_max, preimage_neg_Icc, min_neg_neg, max_neg_neg]
+
+@[simp] lemma preimage_sub_const_uIcc : (λ x, x - a) ⁻¹' [b, c] = [b + a, c + a] :=
+by simp [sub_eq_add_neg]
+
+@[simp] lemma preimage_const_sub_uIcc : (λ x, a - x) ⁻¹' [b, c] = [a - b, a - c] :=
+by { simp_rw [←Icc_min_max, preimage_const_sub_Icc],
+  simp only [sub_eq_add_neg, min_add_add_left, max_add_add_left, min_neg_neg, max_neg_neg], }
+
+@[simp] lemma image_const_add_uIcc : (λ x, a + x) '' [b, c] = [a + b, a + c] :=
+by simp [add_comm]
+
+@[simp] lemma image_add_const_uIcc : (λ x, x + a) '' [b, c] = [b + a, c + a] :=
+by simp
+
+@[simp] lemma image_const_sub_uIcc : (λ x, a - x) '' [b, c] = [a - b, a - c] :=
+by simp [sub_eq_add_neg, image_comp (λ x, a + x) (λ x, -x)]
+
+@[simp] lemma image_sub_const_uIcc : (λ x, x - a) '' [b, c] = [b - a, c - a] :=
+by simp [sub_eq_add_neg, add_comm]
+
+lemma image_neg_uIcc : has_neg.neg '' [a, b] = [-a, -b] := by simp
+
+variables {a b c d}
+
+/-- If `[c, d]` is a subinterval of `[a, b]`, then the distance between `c` and `d` is less than or
+equal to that of `a` and `b` -/
+lemma abs_sub_le_of_uIcc_subset_uIcc (h : [c, d] ⊆ [a, b]) : |d - c| ≤ |b - a| :=
+begin
+  rw [← max_sub_min_eq_abs, ← max_sub_min_eq_abs],
+  rw [uIcc_subset_uIcc_iff_le] at h,
+  exact sub_le_sub h.2 h.1,
+end
+
+/-- If `c ∈ [a, b]`, then the distance between `a` and `c` is less than or equal to
+that of `a` and `b`  -/
+lemma abs_sub_left_of_mem_uIcc (h : c ∈ [a, b]) : |c - a| ≤ |b - a| :=
+abs_sub_le_of_uIcc_subset_uIcc $ uIcc_subset_uIcc_left h
+
+/-- If `x ∈ [a, b]`, then the distance between `c` and `b` is less than or equal to
+that of `a` and `b`  -/
+lemma abs_sub_right_of_mem_uIcc (h : c ∈ [a, b]) : |b - c| ≤ |b - a| :=
+abs_sub_le_of_uIcc_subset_uIcc $ uIcc_subset_uIcc_right h
+
+end linear_ordered_add_comm_group
+
+/-!
+### Multiplication and inverse in a field
+-/
+
+section linear_ordered_field
+variables [linear_ordered_field α] {a : α}
+
+@[simp] lemma preimage_mul_const_Iio (a : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Iio a) = Iio (a / c) :=
+ext $ λ x, (lt_div_iff h).symm
+
+@[simp] lemma preimage_mul_const_Ioi (a : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Ioi a) = Ioi (a / c) :=
+ext $ λ x, (div_lt_iff h).symm
+
+@[simp] lemma preimage_mul_const_Iic (a : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Iic a) = Iic (a / c) :=
+ext $ λ x, (le_div_iff h).symm
+
+@[simp] lemma preimage_mul_const_Ici (a : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Ici a) = Ici (a / c) :=
+ext $ λ x, (div_le_iff h).symm
+
+@[simp] lemma preimage_mul_const_Ioo (a b : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Ioo a b) = Ioo (a / c) (b / c) :=
+by simp [← Ioi_inter_Iio, h]
+
+@[simp] lemma preimage_mul_const_Ioc (a b : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Ioc a b) = Ioc (a / c) (b / c) :=
+by simp [← Ioi_inter_Iic, h]
+
+@[simp] lemma preimage_mul_const_Ico (a b : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Ico a b) = Ico (a / c) (b / c) :=
+by simp [← Ici_inter_Iio, h]
+
+@[simp] lemma preimage_mul_const_Icc (a b : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) ⁻¹' (Icc a b) = Icc (a / c) (b / c) :=
+by simp [← Ici_inter_Iic, h]
+
+@[simp] lemma preimage_mul_const_Iio_of_neg (a : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Iio a) = Ioi (a / c) :=
+ext $ λ x, (div_lt_iff_of_neg h).symm
+
+@[simp] lemma preimage_mul_const_Ioi_of_neg (a : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Ioi a) = Iio (a / c) :=
+ext $ λ x, (lt_div_iff_of_neg h).symm
+
+@[simp] lemma preimage_mul_const_Iic_of_neg (a : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Iic a) = Ici (a / c) :=
+ext $ λ x, (div_le_iff_of_neg h).symm
+
+@[simp] lemma preimage_mul_const_Ici_of_neg (a : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Ici a) = Iic (a / c) :=
+ext $ λ x, (le_div_iff_of_neg h).symm
+
+@[simp] lemma preimage_mul_const_Ioo_of_neg (a b : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Ioo a b) = Ioo (b / c) (a / c) :=
+by simp [← Ioi_inter_Iio, h, inter_comm]
+
+@[simp] lemma preimage_mul_const_Ioc_of_neg (a b : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Ioc a b) = Ico (b / c) (a / c) :=
+by simp [← Ioi_inter_Iic, ← Ici_inter_Iio, h, inter_comm]
+
+@[simp] lemma preimage_mul_const_Ico_of_neg (a b : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Ico a b) = Ioc (b / c) (a / c) :=
+by simp [← Ici_inter_Iio, ← Ioi_inter_Iic, h, inter_comm]
+
+@[simp] lemma preimage_mul_const_Icc_of_neg (a b : α) {c : α} (h : c < 0) :
+  (λ x, x * c) ⁻¹' (Icc a b) = Icc (b / c) (a / c) :=
+by simp [← Ici_inter_Iic, h, inter_comm]
+
+@[simp] lemma preimage_const_mul_Iio (a : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Iio a) = Iio (a / c) :=
+ext $ λ x, (lt_div_iff' h).symm
+
+@[simp] lemma preimage_const_mul_Ioi (a : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Ioi a) = Ioi (a / c) :=
+ext $ λ x, (div_lt_iff' h).symm
+
+@[simp] lemma preimage_const_mul_Iic (a : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Iic a) = Iic (a / c) :=
+ext $ λ x, (le_div_iff' h).symm
+
+@[simp] lemma preimage_const_mul_Ici (a : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Ici a) = Ici (a / c) :=
+ext $ λ x, (div_le_iff' h).symm
+
+@[simp] lemma preimage_const_mul_Ioo (a b : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Ioo a b) = Ioo (a / c) (b / c) :=
+by simp [← Ioi_inter_Iio, h]
+
+@[simp] lemma preimage_const_mul_Ioc (a b : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Ioc a b) = Ioc (a / c) (b / c) :=
+by simp [← Ioi_inter_Iic, h]
+
+@[simp] lemma preimage_const_mul_Ico (a b : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Ico a b) = Ico (a / c) (b / c) :=
+by simp [← Ici_inter_Iio, h]
+
+@[simp] lemma preimage_const_mul_Icc (a b : α) {c : α} (h : 0 < c) :
+  ((*) c) ⁻¹' (Icc a b) = Icc (a / c) (b / c) :=
+by simp [← Ici_inter_Iic, h]
+
+@[simp] lemma preimage_const_mul_Iio_of_neg (a : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Iio a) = Ioi (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Iio_of_neg a h
+
+@[simp] lemma preimage_const_mul_Ioi_of_neg (a : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Ioi a) = Iio (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Ioi_of_neg a h
+
+@[simp] lemma preimage_const_mul_Iic_of_neg (a : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Iic a) = Ici (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Iic_of_neg a h
+
+@[simp] lemma preimage_const_mul_Ici_of_neg (a : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Ici a) = Iic (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Ici_of_neg a h
+
+@[simp] lemma preimage_const_mul_Ioo_of_neg (a b : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Ioo a b) = Ioo (b / c) (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Ioo_of_neg a b h
+
+@[simp] lemma preimage_const_mul_Ioc_of_neg (a b : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Ioc a b) = Ico (b / c) (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Ioc_of_neg a b h
+
+@[simp] lemma preimage_const_mul_Ico_of_neg (a b : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Ico a b) = Ioc (b / c) (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Ico_of_neg a b h
+
+@[simp] lemma preimage_const_mul_Icc_of_neg (a b : α) {c : α} (h : c < 0) :
+  ((*) c) ⁻¹' (Icc a b) = Icc (b / c) (a / c) :=
+by simpa only [mul_comm] using preimage_mul_const_Icc_of_neg a b h
+
+@[simp] lemma preimage_mul_const_uIcc (ha : a ≠ 0) (b c : α) :
+  (λ x, x * a) ⁻¹' [b, c] = [b / a, c / a] :=
+(lt_or_gt_of_ne ha).elim
+  (λ h, by simp [←Icc_min_max, h, h.le, min_div_div_right_of_nonpos, max_div_div_right_of_nonpos])
+  (λ (ha : 0 < a), by simp [←Icc_min_max, ha, ha.le, min_div_div_right, max_div_div_right])
+
+@[simp] lemma preimage_const_mul_uIcc (ha : a ≠ 0) (b c : α) :
+  (λ x, a * x) ⁻¹' [b, c] = [b / a, c / a] :=
+by simp only [← preimage_mul_const_uIcc ha, mul_comm]
+
+@[simp] lemma preimage_div_const_uIcc (ha : a ≠ 0) (b c : α) :
+  (λ x, x / a) ⁻¹' [b, c] = [b * a, c * a] :=
+by simp only [div_eq_mul_inv, preimage_mul_const_uIcc (inv_ne_zero ha), inv_inv]
+
+@[simp] lemma image_mul_const_uIcc (a b c : α) : (λ x, x * a) '' [b, c] = [b * a, c * a] :=
+if ha : a = 0 then by simp [ha] else
+calc (λ x, x * a) '' [b, c] = (λ x, x * a⁻¹) ⁻¹' [b, c] :
+  (units.mk0 a ha).mul_right.image_eq_preimage _
+... = (λ x, x / a) ⁻¹' [b, c] : by simp only [div_eq_mul_inv]
+... = [b * a, c * a] : preimage_div_const_uIcc ha _ _
+
+@[simp] lemma image_const_mul_uIcc (a b c : α) : (λ x, a * x) '' [b, c] = [a * b, a * c] :=
+by simpa only [mul_comm] using image_mul_const_uIcc a b c
+
+@[simp] lemma image_div_const_uIcc (a b c : α) : (λ x, x / a) '' [b, c] = [b / a, c / a] :=
+by simp only [div_eq_mul_inv, image_mul_const_uIcc]
+
+lemma image_mul_right_Icc' (a b : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) '' Icc a b = Icc (a * c) (b * c) :=
+((units.mk0 c h.ne').mul_right.image_eq_preimage _).trans (by simp [h, division_def])
+
+lemma image_mul_right_Icc {a b c : α} (hab : a ≤ b) (hc : 0 ≤ c) :
+  (λ x, x * c) '' Icc a b = Icc (a * c) (b * c) :=
+begin
+  cases eq_or_lt_of_le hc,
+  { subst c,
+    simp [(nonempty_Icc.2 hab).image_const] },
+  exact image_mul_right_Icc' a b ‹0 < c›
+end
+
+lemma image_mul_left_Icc' {a : α} (h : 0 < a) (b c : α) :
+  ((*) a) '' Icc b c = Icc (a * b) (a * c) :=
+by { convert image_mul_right_Icc' b c h using 1; simp only [mul_comm _ a] }
+
+lemma image_mul_left_Icc {a b c : α} (ha : 0 ≤ a) (hbc : b ≤ c) :
+  ((*) a) '' Icc b c = Icc (a * b) (a * c) :=
+by { convert image_mul_right_Icc hbc ha using 1; simp only [mul_comm _ a] }
+
+lemma image_mul_right_Ioo (a b : α) {c : α} (h : 0 < c) :
+  (λ x, x * c) '' Ioo a b = Ioo (a * c) (b * c) :=
+((units.mk0 c h.ne').mul_right.image_eq_preimage _).trans (by simp [h, division_def])
+
+lemma image_mul_left_Ioo {a : α} (h : 0 < a) (b c : α) :
+  ((*) a) '' Ioo b c = Ioo (a * b) (a * c) :=
+by { convert image_mul_right_Ioo b c h using 1; simp only [mul_comm _ a] }
+
+/-- The (pre)image under `inv` of `Ioo 0 a` is `Ioi a⁻¹`. -/
+lemma inv_Ioo_0_left {a : α} (ha : 0 < a) : (Ioo 0 a)⁻¹ = Ioi a⁻¹ :=
+begin
+  ext x,
+  exact ⟨λ h, inv_inv x ▸ (inv_lt_inv ha h.1).2 h.2, λ h, ⟨inv_pos.2 $ (inv_pos.2 ha).trans h,
+    inv_inv a ▸ (inv_lt_inv ((inv_pos.2 ha).trans h) (inv_pos.2 ha)).2 h⟩⟩,
+end
+
+lemma inv_Ioi {a : α} (ha : 0 < a) : (Ioi a)⁻¹ = Ioo 0 a⁻¹ :=
+by rw [inv_eq_iff_eq_inv, inv_Ioo_0_left (inv_pos.2 ha), inv_inv]
+
+lemma image_const_mul_Ioi_zero {k : Type*} [linear_ordered_field k]
+  {x : k} (hx : 0 < x) :
+  (λ y, x * y) '' Ioi (0 : k) = Ioi 0 :=
+by erw [(units.mk0 x hx.ne').mul_left.image_eq_preimage, preimage_const_mul_Ioi 0 (inv_pos.mpr hx),
+  zero_div]
+
+/-!
+### Images under `x ↦ a * x + b`
+-/
+
+@[simp] lemma image_affine_Icc' {a : α} (h : 0 < a) (b c d : α) :
+  (λ x, a * x + b) '' Icc c d = Icc (a * c + b) (a * d + b) :=
+begin
+  suffices : (λ x, x + b) '' ((λ x, a * x) '' Icc c d) = Icc (a * c + b) (a * d + b),
+  { rwa set.image_image at this, },
+  rw [image_mul_left_Icc' h, image_add_const_Icc],
+end
+
+end linear_ordered_field
+end set
diff --git a/src/data/set/pointwise/iterate.lean b/src/data/set/pointwise/iterate.lean
new file mode 100644
index 0000000000000..c12696ba46bd4
--- /dev/null
+++ b/src/data/set/pointwise/iterate.lean
@@ -0,0 +1,42 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import data.set.pointwise.smul
+import algebra.hom.iterate
+import dynamics.fixed_points.basic
+
+/-!
+# Results about pointwise operations on sets with iteration.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open_locale pointwise
+open set function
+
+/-- Let `n : ℤ` and `s` a subset of a commutative group `G` that is invariant under preimage for
+the map `x ↦ x^n`. Then `s` is invariant under the pointwise action of the subgroup of elements
+`g : G` such that `g^(n^j) = 1` for some `j : ℕ`. (This subgroup is called the Prüfer subgroup when
+ `G` is the `circle` and `n` is prime.) -/
+@[to_additive "Let `n : ℤ` and `s` a subset of an additive commutative group `G` that is invariant
+under preimage for the map `x ↦ n • x`. Then `s` is invariant under the pointwise action of the
+additive subgroup of elements `g : G` such that `(n^j) • g = 0` for some `j : ℕ`. (This additive
+subgroup is called the Prüfer subgroup when `G` is the `add_circle` and `n` is prime.)"]
+lemma smul_eq_self_of_preimage_zpow_eq_self {G : Type*} [comm_group G]
+  {n : ℤ} {s : set G} (hs : (λ x, x^n)⁻¹' s = s)
+  {g : G} {j : ℕ} (hg : g^(n^j) = 1) : g • s = s :=
+begin
+  suffices : ∀ {g' : G} (hg' : g'^(n^j) = 1), g' • s ⊆ s,
+  { refine le_antisymm (this hg) _,
+    conv_lhs { rw ← smul_inv_smul g s, },
+    replace hg : (g⁻¹)^(n^j) = 1, { rw [inv_zpow, hg, inv_one], },
+    simpa only [le_eq_subset, set_smul_subset_set_smul_iff] using this hg, },
+  rw (is_fixed_pt.preimage_iterate hs j : ((zpow_group_hom n)^[j])⁻¹' s = s).symm,
+  rintros g' hg' - ⟨y, hy, rfl⟩,
+  change ((zpow_group_hom n)^[j]) (g' * y) ∈ s,
+  replace hg' : ((zpow_group_hom n)^[j]) g' = 1, { simpa [zpow_group_hom], },
+  rwa [monoid_hom.iterate_map_mul, hg', one_mul],
+end
diff --git a/src/data/set/pointwise/list_of_fn.lean b/src/data/set/pointwise/list_of_fn.lean
new file mode 100644
index 0000000000000..cba70055c1b77
--- /dev/null
+++ b/src/data/set/pointwise/list_of_fn.lean
@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import data.set.pointwise.basic
+import data.list.of_fn
+
+/-!
+# Pointwise operations with lists of sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves some lemmas about pointwise algebraic operations with lists of sets.
+-/
+
+namespace set
+
+variables {F α β γ : Type*}
+variables [monoid α] {s t : set α} {a : α} {m n : ℕ}
+
+open_locale pointwise
+
+@[to_additive] lemma mem_prod_list_of_fn {a : α} {s : fin n → set α} :
+  a ∈ (list.of_fn s).prod ↔ ∃ f : (Π i : fin n, s i), (list.of_fn (λ i, (f i : α))).prod = a :=
+begin
+  induction n with n ih generalizing a,
+  { simp_rw [list.of_fn_zero, list.prod_nil, fin.exists_fin_zero_pi, eq_comm, set.mem_one] },
+  { simp_rw [list.of_fn_succ, list.prod_cons, fin.exists_fin_succ_pi, fin.cons_zero, fin.cons_succ,
+      mem_mul, @ih, exists_and_distrib_left, exists_exists_eq_and, set_coe.exists, subtype.coe_mk,
+      exists_prop] }
+end
+
+@[to_additive] lemma mem_list_prod {l : list (set α)} {a : α} :
+  a ∈ l.prod ↔ ∃ l' : list (Σ s : set α, ↥s),
+    list.prod (l'.map (λ x, (sigma.snd x : α))) = a ∧ l'.map sigma.fst = l :=
+begin
+  induction l using list.of_fn_rec with n f,
+  simp_rw [list.exists_iff_exists_tuple, list.map_of_fn, list.of_fn_inj', and.left_comm,
+    exists_and_distrib_left, exists_eq_left, heq_iff_eq, function.comp, mem_prod_list_of_fn],
+  split,
+  { rintros ⟨fi, rfl⟩,  exact ⟨λ i, ⟨_, fi i⟩, rfl, rfl⟩, },
+  { rintros ⟨fi, rfl, rfl⟩, exact ⟨λ i, _, rfl⟩, },
+end
+
+@[to_additive] lemma mem_pow {a : α} {n : ℕ} :
+  a ∈ s ^ n ↔ ∃ f : fin n → s, (list.of_fn (λ i, (f i : α))).prod = a :=
+by rw [←mem_prod_list_of_fn, list.of_fn_const, list.prod_replicate]
+
+end set
diff --git a/src/data/set/pointwise/smul.lean b/src/data/set/pointwise/smul.lean
new file mode 100644
index 0000000000000..2b807aa3215b2
--- /dev/null
+++ b/src/data/set/pointwise/smul.lean
@@ -0,0 +1,664 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Floris van Doorn
+-/
+import algebra.module.basic
+import data.set.pairwise.lattice
+import data.set.pointwise.basic
+import tactic.by_contra
+
+/-!
+# Pointwise operations of sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines pointwise algebraic operations on sets.
+
+## Main declarations
+
+For sets `s` and `t` and scalar `a`:
+* `s • t`: Scalar multiplication, set of all `x • y` where `x ∈ s` and `y ∈ t`.
+* `s +ᵥ t`: Scalar addition, set of all `x +ᵥ y` where `x ∈ s` and `y ∈ t`.
+* `s -ᵥ t`: Scalar subtraction, set of all `x -ᵥ y` where `x ∈ s` and `y ∈ t`.
+* `a • s`: Scaling, set of all `a • x` where `x ∈ s`.
+* `a +ᵥ s`: Translation, set of all `a +ᵥ x` where `x ∈ s`.
+
+For `α` a semigroup/monoid, `set α` is a semigroup/monoid.
+
+Appropriate definitions and results are also transported to the additive theory via `to_additive`.
+
+## Implementation notes
+
+* We put all instances in the locale `pointwise`, so that these instances are not available by
+  default. Note that we do not mark them as reducible (as argued by note [reducible non-instances])
+  since we expect the locale to be open whenever the instances are actually used (and making the
+  instances reducible changes the behavior of `simp`.
+
+-/
+
+open function mul_opposite
+
+variables {F α β γ : Type*}
+
+namespace set
+
+open_locale pointwise
+
+/-! ### Translation/scaling of sets -/
+
+section smul
+
+/-- The dilation of set `x • s` is defined as `{x • y | y ∈ s}` in locale `pointwise`. -/
+@[to_additive "The translation of set `x +ᵥ s` is defined as `{x +ᵥ y | y ∈ s}` in
+locale `pointwise`."]
+protected def has_smul_set [has_smul α β] : has_smul α (set β) :=
+⟨λ a, image (has_smul.smul a)⟩
+
+/-- The pointwise scalar multiplication of sets `s • t` is defined as `{x • y | x ∈ s, y ∈ t}` in
+locale `pointwise`. -/
+@[to_additive "The pointwise scalar addition of sets `s +ᵥ t` is defined as
+`{x +ᵥ y | x ∈ s, y ∈ t}` in locale `pointwise`."]
+protected def has_smul [has_smul α β] : has_smul (set α) (set β) :=
+⟨image2 has_smul.smul⟩
+
+localized "attribute [instance] set.has_smul_set set.has_smul" in pointwise
+localized "attribute [instance] set.has_vadd_set set.has_vadd" in pointwise
+
+section has_smul
+variables {ι : Sort*} {κ : ι → Sort*} [has_smul α β] {s s₁ s₂ : set α} {t t₁ t₂ u : set β} {a : α}
+  {b : β}
+
+@[simp, to_additive]
+lemma image2_smul : image2 has_smul.smul s t = s • t := rfl
+
+@[to_additive add_image_prod]
+lemma image_smul_prod : (λ x : α × β, x.fst • x.snd) '' s ×ˢ t = s • t := image_prod _
+
+@[to_additive]
+lemma mem_smul : b ∈ s • t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x • y = b := iff.rfl
+
+@[to_additive] lemma smul_mem_smul : a ∈ s → b ∈ t → a • b ∈ s • t := mem_image2_of_mem
+
+@[simp, to_additive] lemma empty_smul : (∅ : set α) • t = ∅ := image2_empty_left
+@[simp, to_additive] lemma smul_empty : s • (∅ : set β) = ∅ := image2_empty_right
+@[simp, to_additive] lemma smul_eq_empty : s • t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+@[simp, to_additive] lemma smul_nonempty : (s • t).nonempty ↔ s.nonempty ∧ t.nonempty :=
+image2_nonempty_iff
+@[to_additive] lemma nonempty.smul : s.nonempty → t.nonempty → (s • t).nonempty := nonempty.image2
+@[to_additive] lemma nonempty.of_smul_left : (s • t).nonempty → s.nonempty :=
+nonempty.of_image2_left
+@[to_additive] lemma nonempty.of_smul_right : (s • t).nonempty → t.nonempty :=
+nonempty.of_image2_right
+@[simp, to_additive] lemma smul_singleton : s • {b} = (• b) '' s := image2_singleton_right
+@[simp, to_additive] lemma singleton_smul : ({a} : set α) • t = a • t := image2_singleton_left
+@[simp, to_additive] lemma singleton_smul_singleton : ({a} : set α) • ({b} : set β) = {a • b} :=
+image2_singleton
+
+@[to_additive, mono] lemma smul_subset_smul : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ • t₁ ⊆ s₂ • t₂ := image2_subset
+@[to_additive] lemma smul_subset_smul_left : t₁ ⊆ t₂ → s • t₁ ⊆ s • t₂ := image2_subset_left
+@[to_additive] lemma smul_subset_smul_right : s₁ ⊆ s₂ → s₁ • t ⊆ s₂ • t := image2_subset_right
+@[to_additive] lemma smul_subset_iff : s • t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a • b ∈ u := image2_subset_iff
+
+attribute [mono] vadd_subset_vadd
+
+@[to_additive] lemma union_smul : (s₁ ∪ s₂) • t = s₁ • t ∪ s₂ • t := image2_union_left
+@[to_additive] lemma smul_union : s • (t₁ ∪ t₂) = s • t₁ ∪ s • t₂ := image2_union_right
+@[to_additive] lemma inter_smul_subset : (s₁ ∩ s₂) • t ⊆ s₁ • t ∩ s₂ • t := image2_inter_subset_left
+@[to_additive] lemma smul_inter_subset : s • (t₁ ∩ t₂) ⊆ s • t₁ ∩ s • t₂ :=
+image2_inter_subset_right
+@[to_additive] lemma inter_smul_union_subset_union :
+  (s₁ ∩ s₂) • (t₁ ∪ t₂) ⊆ (s₁ • t₁) ∪ (s₂ • t₂) :=
+image2_inter_union_subset_union
+@[to_additive] lemma union_smul_inter_subset_union :
+  (s₁ ∪ s₂) • (t₁ ∩ t₂) ⊆ (s₁ • t₁) ∪ (s₂ • t₂) :=
+image2_union_inter_subset_union
+
+@[to_additive] lemma Union_smul_left_image : (⋃ a ∈ s, a • t) = s • t := Union_image_left _
+@[to_additive] lemma Union_smul_right_image : (⋃ a ∈ t, (• a) '' s) = s • t := Union_image_right _
+
+@[to_additive] lemma Union_smul (s : ι → set α) (t : set β) : (⋃ i, s i) • t = ⋃ i, s i • t :=
+image2_Union_left _ _ _
+@[to_additive] lemma smul_Union (s : set α) (t : ι → set β) : s • (⋃ i, t i) = ⋃ i, s • t i :=
+image2_Union_right _ _ _
+
+@[to_additive]
+lemma Union₂_smul (s : Π i, κ i → set α) (t : set β) : (⋃ i j, s i j) • t = ⋃ i j, s i j • t :=
+image2_Union₂_left _ _ _
+
+@[to_additive]
+lemma smul_Union₂ (s : set α) (t : Π i, κ i → set β) : s • (⋃ i j, t i j) = ⋃ i j, s • t i j :=
+image2_Union₂_right _ _ _
+
+@[to_additive]
+lemma Inter_smul_subset (s : ι → set α) (t : set β) : (⋂ i, s i) • t ⊆ ⋂ i, s i • t :=
+image2_Inter_subset_left _ _ _
+
+@[to_additive]
+lemma smul_Inter_subset (s : set α) (t : ι → set β) : s • (⋂ i, t i) ⊆ ⋂ i, s • t i :=
+image2_Inter_subset_right _ _ _
+
+@[to_additive]
+lemma Inter₂_smul_subset (s : Π i, κ i → set α) (t : set β) :
+  (⋂ i j, s i j) • t ⊆ ⋂ i j, s i j • t :=
+image2_Inter₂_subset_left _ _ _
+
+@[to_additive]
+lemma smul_Inter₂_subset (s : set α) (t : Π i, κ i → set β) :
+  s • (⋂ i j, t i j) ⊆ ⋂ i j, s • t i j :=
+image2_Inter₂_subset_right _ _ _
+
+@[to_additive] lemma smul_set_subset_smul {s : set α} : a ∈ s → a • t ⊆ s • t :=
+image_subset_image2_right
+
+@[simp, to_additive] lemma bUnion_smul_set (s : set α) (t : set β) :
+  (⋃ a ∈ s, a • t) = s • t :=
+Union_image_left _
+
+end has_smul
+
+section has_smul_set
+variables {ι : Sort*} {κ : ι → Sort*} [has_smul α β] {s t t₁ t₂ : set β} {a : α} {b : β} {x y : β}
+
+@[simp, to_additive] lemma image_smul : (λ x, a • x) '' t = a • t := rfl
+
+@[to_additive] lemma mem_smul_set : x ∈ a • t ↔ ∃ y, y ∈ t ∧ a • y = x := iff.rfl
+
+@[to_additive] lemma smul_mem_smul_set : b ∈ s → a • b ∈ a • s := mem_image_of_mem _
+
+@[simp, to_additive] lemma smul_set_empty : a • (∅ : set β) = ∅ := image_empty _
+@[simp, to_additive] lemma smul_set_eq_empty : a • s = ∅ ↔ s = ∅ := image_eq_empty
+@[simp, to_additive] lemma smul_set_nonempty : (a • s).nonempty ↔ s.nonempty := nonempty_image_iff
+
+@[simp, to_additive] lemma smul_set_singleton : a • ({b} : set β) = {a • b} := image_singleton
+
+@[to_additive] lemma smul_set_mono : s ⊆ t → a • s ⊆ a • t := image_subset _
+@[to_additive] lemma smul_set_subset_iff : a • s ⊆ t ↔ ∀ ⦃b⦄, b ∈ s → a • b ∈ t := image_subset_iff
+
+@[to_additive] lemma smul_set_union : a • (t₁ ∪ t₂) = a • t₁ ∪ a • t₂ := image_union _ _ _
+
+@[to_additive]
+lemma smul_set_inter_subset : a • (t₁ ∩ t₂) ⊆ a • t₁ ∩ (a • t₂) := image_inter_subset _ _ _
+
+@[to_additive]
+lemma smul_set_Union (a : α) (s : ι → set β) : a • (⋃ i, s i) = ⋃ i, a • s i := image_Union
+
+@[to_additive]
+lemma smul_set_Union₂ (a : α) (s : Π i, κ i → set β) : a • (⋃ i j, s i j) = ⋃ i j, a • s i j :=
+image_Union₂ _ _
+
+@[to_additive]
+lemma smul_set_Inter_subset (a : α) (t : ι → set β) : a • (⋂ i, t i) ⊆ ⋂ i, a • t i :=
+image_Inter_subset _ _
+
+@[to_additive]
+lemma smul_set_Inter₂_subset (a : α) (t : Π i, κ i → set β) :
+  a • (⋂ i j, t i j) ⊆ ⋂ i j, a • t i j :=
+image_Inter₂_subset _ _
+
+@[to_additive] lemma nonempty.smul_set : s.nonempty → (a • s).nonempty := nonempty.image _
+
+end has_smul_set
+
+section has_mul
+variables [has_mul α] {s t u : set α} {a : α}
+
+@[to_additive] lemma op_smul_set_subset_mul : a ∈ t → op a • s ⊆ s * t := image_subset_image2_left
+
+@[simp, to_additive] lemma bUnion_op_smul_set (s t : set α) : (⋃ a ∈ t, op a • s) = s * t :=
+Union_image_right _
+
+@[to_additive] lemma mul_subset_iff_left : s * t ⊆ u ↔ ∀ a ∈ s, a • t ⊆ u := image2_subset_iff_left
+@[to_additive] lemma mul_subset_iff_right : s * t ⊆ u ↔ ∀ b ∈ t, op b • s ⊆ u :=
+image2_subset_iff_right
+
+end has_mul
+
+variables {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}
+
+@[to_additive]
+theorem range_smul_range {ι κ : Type*} [has_smul α β] (b : ι → α) (c : κ → β) :
+  range b • range c = range (λ p : ι × κ, b p.1 • c p.2) :=
+ext $ λ x, ⟨λ hx, let ⟨p, q, ⟨i, hi⟩, ⟨j, hj⟩, hpq⟩ := set.mem_smul.1 hx in
+  ⟨(i, j), hpq ▸ hi ▸ hj ▸ rfl⟩,
+λ ⟨⟨i, j⟩, h⟩, set.mem_smul.2 ⟨b i, c j, ⟨i, rfl⟩, ⟨j, rfl⟩, h⟩⟩
+
+@[to_additive] lemma smul_set_range [has_smul α β] {ι : Sort*} {f : ι → β} :
+  a • range f = range (λ i, a • f i) := (range_comp _ _).symm
+
+@[to_additive]
+instance smul_comm_class_set [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class α β (set γ) :=
+⟨λ _ _, commute.set_image $ smul_comm _ _⟩
+
+@[to_additive]
+instance smul_comm_class_set' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class α (set β) (set γ) :=
+⟨λ _ _ _, image_image2_distrib_right $ smul_comm _⟩
+
+@[to_additive]
+instance smul_comm_class_set'' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class (set α) β (set γ) :=
+by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _
+
+@[to_additive]
+instance smul_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class (set α) (set β) (set γ) :=
+⟨λ _ _ _, image2_left_comm smul_comm⟩
+
+@[to_additive]
+instance is_scalar_tower [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
+  is_scalar_tower α β (set γ) :=
+{ smul_assoc := λ a b T, by simp only [←image_smul, image_image, smul_assoc] }
+
+@[to_additive]
+instance is_scalar_tower' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
+  is_scalar_tower α (set β) (set γ) :=
+⟨λ _ _ _, image2_image_left_comm $ smul_assoc _⟩
+
+@[to_additive]
+instance is_scalar_tower'' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
+  is_scalar_tower (set α) (set β) (set γ) :=
+{ smul_assoc := λ T T' T'', image2_assoc smul_assoc }
+
+@[to_additive]
+instance is_central_scalar [has_smul α β] [has_smul αᵐᵒᵖ β] [is_central_scalar α β] :
+  is_central_scalar α (set β) :=
+⟨λ a S, congr_arg (λ f, f '' S) $ by exact funext (λ _, op_smul_eq_smul _ _)⟩
+
+/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of `set α`
+on `set β`. -/
+@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action
+of `set α` on `set β`"]
+protected def mul_action [monoid α] [mul_action α β] : mul_action (set α) (set β) :=
+{ mul_smul := λ _ _ _, image2_assoc mul_smul,
+  one_smul := λ s, image2_singleton_left.trans $ by simp_rw [one_smul, image_id'] }
+
+/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `set β`. -/
+@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action
+on `set β`."]
+protected def mul_action_set [monoid α] [mul_action α β] : mul_action α (set β) :=
+{ mul_smul := by { intros, simp only [← image_smul, image_image, ← mul_smul] },
+  one_smul := by { intros, simp only [← image_smul, one_smul, image_id'] } }
+
+localized "attribute [instance] set.mul_action_set set.add_action_set
+  set.mul_action set.add_action" in pointwise
+
+/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
+multiplicative action on `set β`. -/
+protected def distrib_mul_action_set [monoid α] [add_monoid β] [distrib_mul_action α β] :
+  distrib_mul_action α (set β) :=
+{ smul_add := λ _ _ _, image_image2_distrib $ smul_add _,
+  smul_zero := λ _, image_singleton.trans $ by rw [smul_zero, singleton_zero] }
+
+/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/
+protected def mul_distrib_mul_action_set [monoid α] [monoid β] [mul_distrib_mul_action α β] :
+  mul_distrib_mul_action α (set β) :=
+{ smul_mul := λ _ _ _, image_image2_distrib $ smul_mul' _,
+  smul_one := λ _, image_singleton.trans $ by rw [smul_one, singleton_one] }
+
+localized "attribute [instance] set.distrib_mul_action_set set.mul_distrib_mul_action_set"
+  in pointwise
+
+instance [has_zero α] [has_zero β] [has_smul α β] [no_zero_smul_divisors α β] :
+  no_zero_smul_divisors (set α) (set β) :=
+⟨λ s t h, begin
+  by_contra' H,
+  have hst : (s • t).nonempty := h.symm.subst zero_nonempty,
+  simp_rw [←hst.of_smul_left.subset_zero_iff, ←hst.of_smul_right.subset_zero_iff, not_subset,
+    mem_zero] at H,
+  obtain ⟨⟨a, hs, ha⟩, b, ht, hb⟩ := H,
+  exact (eq_zero_or_eq_zero_of_smul_eq_zero $ h.subset $ smul_mem_smul hs ht).elim ha hb,
+end⟩
+
+instance no_zero_smul_divisors_set [has_zero α] [has_zero β] [has_smul α β]
+  [no_zero_smul_divisors α β] : no_zero_smul_divisors α (set β) :=
+⟨λ a s h, begin
+  by_contra' H,
+  have hst : (a • s).nonempty := h.symm.subst zero_nonempty,
+  simp_rw [←hst.of_image.subset_zero_iff, not_subset, mem_zero] at H,
+  obtain ⟨ha, b, ht, hb⟩ := H,
+  exact (eq_zero_or_eq_zero_of_smul_eq_zero $ h.subset $ smul_mem_smul_set ht).elim ha hb,
+end⟩
+
+instance [has_zero α] [has_mul α] [no_zero_divisors α] : no_zero_divisors (set α) :=
+⟨λ s t h, eq_zero_or_eq_zero_of_smul_eq_zero h⟩
+
+end smul
+
+section vsub
+variables {ι : Sort*} {κ : ι → Sort*} [has_vsub α β] {s s₁ s₂ t t₁ t₂ : set β} {u : set α} {a : α}
+  {b c : β}
+include α
+
+instance has_vsub : has_vsub (set α) (set β) := ⟨image2 (-ᵥ)⟩
+
+@[simp] lemma image2_vsub : (image2 has_vsub.vsub s t : set α) = s -ᵥ t := rfl
+
+lemma image_vsub_prod : (λ x : β × β, x.fst -ᵥ x.snd) '' s ×ˢ t = s -ᵥ t := image_prod _
+
+lemma mem_vsub : a ∈ s -ᵥ t ↔ ∃ x y, x ∈ s ∧ y ∈ t ∧ x -ᵥ y = a := iff.rfl
+
+lemma vsub_mem_vsub (hb : b ∈ s) (hc : c ∈ t) : b -ᵥ c ∈ s -ᵥ t := mem_image2_of_mem hb hc
+
+@[simp] lemma empty_vsub (t : set β) : ∅ -ᵥ t = ∅ := image2_empty_left
+@[simp] lemma vsub_empty (s : set β) : s -ᵥ ∅ = ∅ := image2_empty_right
+@[simp] lemma vsub_eq_empty : s -ᵥ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+@[simp] lemma vsub_nonempty : (s -ᵥ t : set α).nonempty ↔ s.nonempty ∧ t.nonempty :=
+image2_nonempty_iff
+lemma nonempty.vsub : s.nonempty → t.nonempty → (s -ᵥ t : set α).nonempty := nonempty.image2
+lemma nonempty.of_vsub_left : (s -ᵥ t :set α).nonempty → s.nonempty := nonempty.of_image2_left
+lemma nonempty.of_vsub_right : (s -ᵥ t : set α).nonempty → t.nonempty := nonempty.of_image2_right
+@[simp] lemma vsub_singleton (s : set β) (b : β) : s -ᵥ {b} = (-ᵥ b) '' s := image2_singleton_right
+@[simp] lemma singleton_vsub (t : set β) (b : β) : {b} -ᵥ t = ((-ᵥ) b) '' t := image2_singleton_left
+@[simp] lemma singleton_vsub_singleton : ({b} : set β) -ᵥ {c} = {b -ᵥ c} := image2_singleton
+
+@[mono] lemma vsub_subset_vsub : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ -ᵥ t₁ ⊆ s₂ -ᵥ t₂ := image2_subset
+lemma vsub_subset_vsub_left : t₁ ⊆ t₂ → s -ᵥ t₁ ⊆ s -ᵥ t₂ := image2_subset_left
+lemma vsub_subset_vsub_right : s₁ ⊆ s₂ → s₁ -ᵥ t ⊆ s₂ -ᵥ t := image2_subset_right
+lemma vsub_subset_iff : s -ᵥ t ⊆ u ↔ ∀ (x ∈ s) (y ∈ t), x -ᵥ y ∈ u := image2_subset_iff
+lemma vsub_self_mono (h : s ⊆ t) : s -ᵥ s ⊆ t -ᵥ t := vsub_subset_vsub h h
+
+lemma union_vsub : (s₁ ∪ s₂) -ᵥ t = s₁ -ᵥ t ∪ (s₂ -ᵥ t) := image2_union_left
+lemma vsub_union : s -ᵥ (t₁ ∪ t₂) = s -ᵥ t₁ ∪ (s -ᵥ t₂) := image2_union_right
+lemma inter_vsub_subset : s₁ ∩ s₂ -ᵥ t ⊆ (s₁ -ᵥ t) ∩ (s₂ -ᵥ t) := image2_inter_subset_left
+lemma vsub_inter_subset : s -ᵥ t₁ ∩ t₂ ⊆ (s -ᵥ t₁) ∩ (s -ᵥ t₂) := image2_inter_subset_right
+lemma inter_vsub_union_subset_union : (s₁ ∩ s₂) -ᵥ (t₁ ∪ t₂) ⊆ (s₁ -ᵥ t₁) ∪ (s₂ -ᵥ t₂) :=
+image2_inter_union_subset_union
+lemma union_vsub_inter_subset_union : (s₁ ∪ s₂) -ᵥ (t₁ ∩ t₂) ⊆ (s₁ -ᵥ t₁) ∪ (s₂ -ᵥ t₂) :=
+image2_union_inter_subset_union
+
+lemma Union_vsub_left_image : (⋃ a ∈ s, ((-ᵥ) a) '' t) = s -ᵥ t := Union_image_left _
+lemma Union_vsub_right_image : (⋃ a ∈ t, (-ᵥ a) '' s) = s -ᵥ t := Union_image_right _
+
+lemma Union_vsub (s : ι → set β) (t : set β) : (⋃ i, s i) -ᵥ t = ⋃ i, s i -ᵥ t :=
+image2_Union_left _ _ _
+lemma vsub_Union (s : set β) (t : ι → set β) : s -ᵥ (⋃ i, t i) = ⋃ i, s -ᵥ t i :=
+image2_Union_right _ _ _
+
+lemma Union₂_vsub (s : Π i, κ i → set β) (t : set β) : (⋃ i j, s i j) -ᵥ t = ⋃ i j, s i j -ᵥ t :=
+image2_Union₂_left _ _ _
+
+lemma vsub_Union₂ (s : set β) (t : Π i, κ i → set β) : s -ᵥ (⋃ i j, t i j) = ⋃ i j, s -ᵥ t i j :=
+image2_Union₂_right _ _ _
+
+lemma Inter_vsub_subset (s : ι → set β) (t : set β) : (⋂ i, s i) -ᵥ t ⊆ ⋂ i, s i -ᵥ t :=
+image2_Inter_subset_left _ _ _
+
+lemma vsub_Inter_subset (s : set β) (t : ι → set β) : s -ᵥ (⋂ i, t i) ⊆ ⋂ i, s -ᵥ t i :=
+image2_Inter_subset_right _ _ _
+
+lemma Inter₂_vsub_subset (s : Π i, κ i → set β) (t : set β) :
+  (⋂ i j, s i j) -ᵥ t ⊆ ⋂ i j, s i j -ᵥ t :=
+image2_Inter₂_subset_left _ _ _
+
+lemma vsub_Inter₂_subset (s : set β) (t : Π i, κ i → set β) :
+  s -ᵥ (⋂ i j, t i j) ⊆ ⋂ i j, s -ᵥ t i j :=
+image2_Inter₂_subset_right _ _ _
+
+
+end vsub
+
+open_locale pointwise
+
+@[to_additive] lemma image_smul_comm [has_smul α β] [has_smul α γ] (f : β → γ) (a : α) (s : set β) :
+  (∀ b, f (a • b) = a • f b) → f '' (a • s) = a • f '' s :=
+image_comm
+
+@[to_additive] lemma image_smul_distrib [mul_one_class α] [mul_one_class β] [monoid_hom_class F α β]
+  (f : F) (a : α) (s : set α) :
+  f '' (a • s) = f a • f '' s :=
+image_comm $ map_mul _ _
+
+section has_smul
+variables[has_smul αᵐᵒᵖ β] [has_smul β γ] [has_smul α γ]
+
+-- TODO: replace hypothesis and conclusion with a typeclass
+@[to_additive] lemma op_smul_set_smul_eq_smul_smul_set (a : α) (s : set β) (t : set γ)
+  (h : ∀ (a : α) (b : β) (c : γ), (op a • b) • c = b • a • c) :
+  (op a • s) • t = s • a • t :=
+by { ext, simp [mem_smul, mem_smul_set, h] }
+
+end has_smul
+
+section smul_with_zero
+variables [has_zero α] [has_zero β] [smul_with_zero α β] {s : set α} {t : set β}
+
+/-!
+Note that we have neither `smul_with_zero α (set β)` nor `smul_with_zero (set α) (set β)`
+because `0 * ∅ ≠ 0`.
+-/
+
+lemma smul_zero_subset (s : set α) : s • (0 : set β) ⊆ 0 := by simp [subset_def, mem_smul]
+lemma zero_smul_subset (t : set β) : (0 : set α) • t ⊆ 0 := by simp [subset_def, mem_smul]
+
+lemma nonempty.smul_zero (hs : s.nonempty) : s • (0 : set β) = 0 :=
+s.smul_zero_subset.antisymm $ by simpa [mem_smul] using hs
+
+lemma nonempty.zero_smul (ht : t.nonempty) : (0 : set α) • t = 0 :=
+t.zero_smul_subset.antisymm $ by simpa [mem_smul] using ht
+
+/-- A nonempty set is scaled by zero to the singleton set containing 0. -/
+lemma zero_smul_set {s : set β} (h : s.nonempty) : (0 : α) • s = (0 : set β) :=
+by simp only [← image_smul, image_eta, zero_smul, h.image_const, singleton_zero]
+
+lemma zero_smul_set_subset (s : set β) : (0 : α) • s ⊆ 0 :=
+image_subset_iff.2 $ λ x _, zero_smul α x
+
+lemma subsingleton_zero_smul_set (s : set β) : ((0 : α) • s).subsingleton :=
+subsingleton_singleton.anti $ zero_smul_set_subset s
+
+lemma zero_mem_smul_set {t : set β} {a : α} (h : (0 : β) ∈ t) : (0 : β) ∈ a • t :=
+⟨0, h, smul_zero _⟩
+
+variables [no_zero_smul_divisors α β] {a : α}
+
+lemma zero_mem_smul_iff : (0 : β) ∈ s • t ↔ (0 : α) ∈ s ∧ t.nonempty ∨ (0 : β) ∈ t ∧ s.nonempty :=
+begin
+  split,
+  { rintro ⟨a, b, ha, hb, h⟩,
+    obtain rfl | rfl := eq_zero_or_eq_zero_of_smul_eq_zero h,
+    { exact or.inl ⟨ha, b, hb⟩ },
+    { exact or.inr ⟨hb, a, ha⟩ } },
+  { rintro (⟨hs, b, hb⟩ | ⟨ht, a, ha⟩),
+    { exact ⟨0, b, hs, hb, zero_smul _ _⟩ },
+    { exact ⟨a, 0, ha, ht, smul_zero _⟩ } }
+end
+
+lemma zero_mem_smul_set_iff (ha : a ≠ 0) : (0 : β) ∈ a • t ↔ (0 : β) ∈ t :=
+begin
+  refine ⟨_, zero_mem_smul_set⟩,
+  rintro ⟨b, hb, h⟩,
+  rwa (eq_zero_or_eq_zero_of_smul_eq_zero h).resolve_left ha at hb,
+end
+
+end smul_with_zero
+
+section semigroup
+variables [semigroup α]
+
+@[to_additive] lemma op_smul_set_mul_eq_mul_smul_set (a : α) (s : set α) (t : set α) :
+  (op a • s) * t = s * a • t :=
+op_smul_set_smul_eq_smul_smul_set _ _ _ $ λ _ _ _, mul_assoc _ _ _
+
+end semigroup
+
+section left_cancel_semigroup
+variables [left_cancel_semigroup α] {s t : set α}
+
+@[to_additive] lemma pairwise_disjoint_smul_iff :
+  s.pairwise_disjoint (• t) ↔ (s ×ˢ t).inj_on (λ p, p.1 * p.2) :=
+pairwise_disjoint_image_right_iff $ λ _ _, mul_right_injective _
+
+end left_cancel_semigroup
+
+section group
+variables [group α] [mul_action α β] {s t A B : set β} {a : α} {x : β}
+
+@[simp, to_additive]
+lemma smul_mem_smul_set_iff : a • x ∈ a • s ↔ x ∈ s := (mul_action.injective _).mem_set_image
+
+@[to_additive]
+lemma mem_smul_set_iff_inv_smul_mem : x ∈ a • A ↔ a⁻¹ • x ∈ A :=
+show x ∈ mul_action.to_perm a '' A ↔ _, from mem_image_equiv
+
+@[to_additive]
+lemma mem_inv_smul_set_iff : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
+by simp only [← image_smul, mem_image, inv_smul_eq_iff, exists_eq_right]
+
+@[to_additive]
+lemma preimage_smul (a : α) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
+((mul_action.to_perm a).symm.image_eq_preimage _).symm
+
+@[to_additive]
+lemma preimage_smul_inv (a : α) (t : set β) : (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
+preimage_smul (to_units a)⁻¹ t
+
+@[simp, to_additive]
+lemma set_smul_subset_set_smul_iff : a • A ⊆ a • B ↔ A ⊆ B :=
+image_subset_image_iff $ mul_action.injective _
+
+@[to_additive]
+lemma set_smul_subset_iff : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
+(image_subset_iff).trans $ iff_of_eq $ congr_arg _ $
+  preimage_equiv_eq_image_symm _ $ mul_action.to_perm _
+
+@[to_additive]
+lemma subset_set_smul_iff : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
+iff.symm $ (image_subset_iff).trans $ iff.symm $ iff_of_eq $ congr_arg _ $
+  image_equiv_eq_preimage_symm _ $ mul_action.to_perm _
+
+@[to_additive] lemma smul_set_inter : a • (s ∩ t) = a • s ∩ a • t :=
+image_inter $ mul_action.injective a
+
+@[to_additive] lemma smul_set_sdiff : a • (s \ t) = a • s \ a • t :=
+image_diff (mul_action.injective a) _ _
+
+@[to_additive] lemma smul_set_symm_diff : a • (s ∆ t) = (a • s) ∆ (a • t) :=
+image_symm_diff (mul_action.injective a) _ _
+
+@[simp, to_additive] lemma smul_set_univ : a • (univ : set β) = univ :=
+image_univ_of_surjective $ mul_action.surjective a
+
+@[simp, to_additive] lemma smul_univ {s : set α} (hs : s.nonempty) : s • (univ : set β) = univ :=
+let ⟨a, ha⟩ := hs in eq_univ_of_forall $ λ b, ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul _ _⟩
+
+@[to_additive]
+lemma smul_inter_ne_empty_iff {s t : set α} {x : α} :
+  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a * b⁻¹ = x :=
+begin
+  rw ←nonempty_iff_ne_empty,
+  split,
+  { rintros ⟨a, h, ha⟩,
+    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h,
+    exact ⟨x • b, b, ⟨ha, hb⟩, by simp⟩, },
+  { rintros ⟨a, b, ⟨ha, hb⟩, rfl⟩,
+    exact ⟨a, mem_inter (mem_smul_set.mpr ⟨b, hb, by simp⟩) ha⟩, },
+end
+
+@[to_additive]
+lemma smul_inter_ne_empty_iff' {s t : set α} {x : α} :
+  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ t ∧ b ∈ s) ∧ a / b = x :=
+by simp_rw [smul_inter_ne_empty_iff, div_eq_mul_inv]
+
+@[to_additive]
+lemma op_smul_inter_ne_empty_iff {s t : set α} {x : αᵐᵒᵖ} :
+  x • s ∩ t ≠ ∅ ↔ ∃ a b, (a ∈ s ∧ b ∈ t) ∧ a⁻¹ * b = mul_opposite.unop x :=
+begin
+  rw ←nonempty_iff_ne_empty,
+  split,
+  { rintros ⟨a, h, ha⟩,
+    obtain ⟨b, hb, rfl⟩ := mem_smul_set.mp h,
+    exact ⟨b, x • b, ⟨hb, ha⟩, by simp⟩, },
+  { rintros ⟨a, b, ⟨ha, hb⟩, H⟩,
+    have : mul_opposite.op (a⁻¹ * b) = x := congr_arg mul_opposite.op H,
+    exact ⟨b, mem_inter (mem_smul_set.mpr ⟨a, ha, by simp [← this]⟩) hb⟩, },
+end
+
+@[simp, to_additive] lemma Union_inv_smul :
+  (⋃ (g : α), g⁻¹ • s) = (⋃ (g : α), g • s) :=
+function.surjective.supr_congr _ inv_surjective $ λ g, rfl
+
+@[to_additive]
+lemma Union_smul_eq_set_of_exists {s : set β} :
+  (⋃ (g : α), g • s) = {a | ∃ (g : α), g • a ∈ s} :=
+by simp_rw [← Union_set_of, ← Union_inv_smul, ← preimage_smul, preimage]
+
+end group
+
+section group_with_zero
+variables [group_with_zero α] [mul_action α β] {s t : set β} {a : α}
+
+@[simp] lemma smul_mem_smul_set_iff₀ (ha : a ≠ 0) (A : set β)
+  (x : β) : a • x ∈ a • A ↔ x ∈ A :=
+show units.mk0 a ha • _ ∈ _ ↔ _, from smul_mem_smul_set_iff
+
+lemma mem_smul_set_iff_inv_smul_mem₀ (ha : a ≠ 0) (A : set β) (x : β) :
+  x ∈ a • A ↔ a⁻¹ • x ∈ A :=
+show _ ∈ units.mk0 a ha • _ ↔ _, from mem_smul_set_iff_inv_smul_mem
+
+lemma mem_inv_smul_set_iff₀ (ha : a ≠ 0) (A : set β) (x : β) : x ∈ a⁻¹ • A ↔ a • x ∈ A :=
+show _ ∈ (units.mk0 a ha)⁻¹ • _ ↔ _, from mem_inv_smul_set_iff
+
+lemma preimage_smul₀ (ha : a ≠ 0) (t : set β) : (λ x, a • x) ⁻¹' t = a⁻¹ • t :=
+preimage_smul (units.mk0 a ha) t
+
+lemma preimage_smul_inv₀ (ha : a ≠ 0) (t : set β) :
+  (λ x, a⁻¹ • x) ⁻¹' t = a • t :=
+preimage_smul ((units.mk0 a ha)⁻¹) t
+
+@[simp] lemma set_smul_subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} :
+  a • A ⊆ a • B ↔ A ⊆ B :=
+show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_set_smul_iff
+
+lemma set_smul_subset_iff₀ (ha : a ≠ 0) {A B : set β} : a • A ⊆ B ↔ A ⊆ a⁻¹ • B :=
+show units.mk0 a ha • _ ⊆ _ ↔ _, from set_smul_subset_iff
+
+lemma subset_set_smul_iff₀ (ha : a ≠ 0) {A B : set β} : A ⊆ a • B ↔ a⁻¹ • A ⊆ B :=
+show _ ⊆ units.mk0 a ha • _ ↔ _, from subset_set_smul_iff
+
+lemma smul_set_inter₀ (ha : a ≠ 0) : a • (s ∩ t) = a • s ∩ a • t :=
+show units.mk0 a ha • _ = _, from smul_set_inter
+
+lemma smul_set_sdiff₀ (ha : a ≠ 0) : a • (s \ t) = a • s \ a • t :=
+image_diff (mul_action.injective₀ ha) _ _
+
+lemma smul_set_symm_diff₀ (ha : a ≠ 0) : a • (s ∆ t) = (a • s) ∆ (a • t) :=
+image_symm_diff (mul_action.injective₀ ha) _ _
+
+lemma smul_set_univ₀ (ha : a ≠ 0) : a • (univ : set β) = univ :=
+image_univ_of_surjective $ mul_action.surjective₀ ha
+
+lemma smul_univ₀ {s : set α} (hs : ¬ s ⊆ 0) : s • (univ : set β) = univ :=
+let ⟨a, ha, ha₀⟩ := not_subset.1 hs in eq_univ_of_forall $ λ b,
+  ⟨a, a⁻¹ • b, ha, trivial, smul_inv_smul₀ ha₀ _⟩
+
+lemma smul_univ₀' {s : set α} (hs : s.nontrivial) : s • (univ : set β) = univ :=
+smul_univ₀ hs.not_subset_singleton
+
+end group_with_zero
+
+section monoid
+variables [monoid α] [add_group β] [distrib_mul_action α β] (a : α) (s : set α) (t : set β)
+
+@[simp] lemma smul_set_neg : a • -t = -(a • t) :=
+by simp_rw [←image_smul, ←image_neg, image_image, smul_neg]
+
+@[simp] protected lemma smul_neg : s • -t = -(s • t) :=
+by { simp_rw ←image_neg, exact image_image2_right_comm smul_neg }
+
+end monoid
+
+section ring
+variables [ring α] [add_comm_group β] [module α β] (a : α) (s : set α) (t : set β)
+
+@[simp] lemma neg_smul_set : -a • t = -(a • t) :=
+by simp_rw [←image_smul, ←image_neg, image_image, neg_smul]
+
+@[simp] protected lemma neg_smul : -s • t = -(s • t) :=
+by { simp_rw ←image_neg, exact image2_image_left_comm neg_smul }
+
+end ring
+
+end set
diff --git a/src/data/set/pointwise/support.lean b/src/data/set/pointwise/support.lean
new file mode 100644
index 0000000000000..6d11a9c38352b
--- /dev/null
+++ b/src/data/set/pointwise/support.lean
@@ -0,0 +1,51 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import data.set.pointwise.smul
+import algebra.support
+
+/-!
+# Support of a function composed with a scalar action
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We show that the support of `x ↦ f (c⁻¹ • x)` is equal to `c • support f`.
+-/
+
+open_locale pointwise
+open function set
+
+section group
+
+variables {α β γ : Type*} [group α] [mul_action α β]
+
+lemma mul_support_comp_inv_smul [has_one γ] (c : α) (f : β → γ) :
+  mul_support (λ x, f (c⁻¹ • x)) = c • mul_support f :=
+by { ext x, simp only [mem_smul_set_iff_inv_smul_mem, mem_mul_support] }
+
+lemma support_comp_inv_smul [has_zero γ] (c : α) (f : β → γ) :
+  support (λ x, f (c⁻¹ • x)) = c • support f :=
+by { ext x, simp only [mem_smul_set_iff_inv_smul_mem, mem_support] }
+
+attribute [to_additive support_comp_inv_smul] mul_support_comp_inv_smul
+
+end group
+
+section group_with_zero
+
+variables {α β γ : Type*} [group_with_zero α] [mul_action α β]
+
+lemma mul_support_comp_inv_smul₀ [has_one γ] {c : α} (hc : c ≠ 0) (f : β → γ) :
+  mul_support (λ x, f (c⁻¹ • x)) = c • mul_support f :=
+by { ext x, simp only [mem_smul_set_iff_inv_smul_mem₀ hc, mem_mul_support] }
+
+lemma support_comp_inv_smul₀ [has_zero γ] {c : α} (hc : c ≠ 0) (f : β → γ) :
+  support (λ x, f (c⁻¹ • x)) = c • support f :=
+by { ext x, simp only [mem_smul_set_iff_inv_smul_mem₀ hc, mem_support] }
+
+attribute [to_additive support_comp_inv_smul₀] mul_support_comp_inv_smul₀
+
+end group_with_zero
diff --git a/src/data/set/prod.lean b/src/data/set/prod.lean
index 4084dc924d300..90f2736c294bc 100644
--- a/src/data/set/prod.lean
+++ b/src/data/set/prod.lean
@@ -3,11 +3,14 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Johannes Hölzl, Patrick Massot
 -/
-import data.set.basic
+import data.set.image
 
 /-!
 # Sets in product and pi types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the product of sets in `α × β` and in `Π i, α i` along with the diagonal of a
 type.
 
@@ -16,18 +19,12 @@ type.
 * `set.prod`: Binary product of sets. For `s : set α`, `t : set β`, we have
   `s.prod t : set (α × β)`.
 * `set.diagonal`: Diagonal of a type. `set.diagonal α = {(x, x) | x : α}`.
+* `set.off_diag`: Off-diagonal. `s ×ˢ s` without the diagonal.
 * `set.pi`: Arbitrary product of sets.
 -/
 
 open function
 
-/-- Notation class for product of subobjects (sets, submonoids, subgroups, etc). -/
-class has_set_prod (α β : Type*) (γ : out_param Type*) :=
-(prod : α → β → γ)
-
-/- This notation binds more strongly than (pre)images, unions and intersections. -/
-infixr ` ×ˢ `:82 := has_set_prod.prod
-
 namespace set
 
 /-! ### Cartesian binary product of sets -/
@@ -35,24 +32,38 @@ namespace set
 section prod
 variables {α β γ δ : Type*} {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}
 
-/-- The cartesian product `prod s t` is the set of `(a, b)`
-  such that `a ∈ s` and `b ∈ t`. -/
-instance : has_set_prod (set α) (set β) (set (α × β)) :=
-⟨λ s t, {p | p.1 ∈ s ∧ p.2 ∈ t}⟩
+/-- The cartesian product `prod s t` is the set of `(a, b)` such that `a ∈ s` and `b ∈ t`. -/
+def prod (s : set α) (t : set β) : set (α × β) := {p | p.1 ∈ s ∧ p.2 ∈ t}
+
+/- This notation binds more strongly than (pre)images, unions and intersections. -/
+infixr (name := set.prod) ` ×ˢ `:82 := set.prod
 
 lemma prod_eq (s : set α) (t : set β) : s ×ˢ t = prod.fst ⁻¹' s ∩ prod.snd ⁻¹' t := rfl
 
 lemma mem_prod_eq {p : α × β} : p ∈ s ×ˢ t = (p.1 ∈ s ∧ p.2 ∈ t) := rfl
 
-@[simp] lemma mem_prod {p : α × β} : p ∈ s ×ˢ t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl
+@[simp, mfld_simps] lemma mem_prod {p : α × β} : p ∈ s ×ˢ t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl
 
-@[simp] lemma prod_mk_mem_set_prod_eq : (a, b) ∈ s ×ˢ t = (a ∈ s ∧ b ∈ t) := rfl
+@[simp, mfld_simps] lemma prod_mk_mem_set_prod_eq : (a, b) ∈ s ×ˢ t = (a ∈ s ∧ b ∈ t) := rfl
 
 lemma mk_mem_prod (ha : a ∈ s) (hb : b ∈ t) : (a, b) ∈ s ×ˢ t := ⟨ha, hb⟩
 
+instance decidable_mem_prod [hs : decidable_pred (∈ s)] [ht : decidable_pred (∈ t)] :
+  decidable_pred (∈ (s ×ˢ t)) :=
+λ _, and.decidable
+
 lemma prod_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ×ˢ t₁ ⊆ s₂ ×ˢ t₂ :=
 λ x ⟨h₁, h₂⟩, ⟨hs h₁, ht h₂⟩
 
+lemma prod_mono_left (hs : s₁ ⊆ s₂) : s₁ ×ˢ t ⊆ s₂ ×ˢ t := prod_mono hs subset.rfl
+lemma prod_mono_right (ht : t₁ ⊆ t₂) : s ×ˢ t₁ ⊆ s ×ˢ t₂ := prod_mono subset.rfl ht
+
+@[simp] lemma prod_self_subset_prod_self : s₁ ×ˢ s₁ ⊆ s₂ ×ˢ s₂ ↔ s₁ ⊆ s₂ :=
+⟨λ h x hx, (h (mk_mem_prod hx hx)).1, λ h x hx, ⟨h hx.1, h hx.2⟩⟩
+
+@[simp] lemma prod_self_ssubset_prod_self : s₁ ×ˢ s₁ ⊂ s₂ ×ˢ s₂ ↔ s₁ ⊂ s₂ :=
+and_congr prod_self_subset_prod_self $ not_congr prod_self_subset_prod_self
+
 lemma prod_subset_iff {P : set (α × β)} : s ×ˢ t ⊆ P ↔ ∀ (x ∈ s) (y ∈ t), (x, y) ∈ P :=
 ⟨λ h _ hx _ hy, h (mk_mem_prod hx hy), λ h ⟨_, _⟩ hp, h _ hp.1 _ hp.2⟩
 
@@ -66,7 +77,7 @@ by simp [and_assoc]
 
 @[simp] lemma empty_prod : (∅ : set α) ×ˢ t = ∅ := by { ext, exact false_and _ }
 
-@[simp] lemma univ_prod_univ : @univ α ×ˢ @univ β = univ := by { ext, exact true_and _ }
+@[simp, mfld_simps] lemma univ_prod_univ : @univ α ×ˢ @univ β = univ := by { ext, exact true_and _ }
 
 lemma univ_prod {t : set β} : (univ : set α) ×ˢ t = prod.snd ⁻¹' t := by simp [prod_eq]
 
@@ -86,9 +97,31 @@ by { ext ⟨x, y⟩, simp [or_and_distrib_right] }
 @[simp] lemma prod_union : s ×ˢ (t₁ ∪ t₂) = s ×ˢ t₁ ∪ s ×ˢ t₂ :=
 by { ext ⟨x, y⟩, simp [and_or_distrib_left] }
 
+lemma inter_prod : (s₁ ∩ s₂) ×ˢ t = s₁ ×ˢ t ∩ s₂ ×ˢ t :=
+by { ext ⟨x, y⟩, simp only [←and_and_distrib_right, mem_inter_iff, mem_prod] }
+
+lemma prod_inter : s ×ˢ (t₁ ∩ t₂) = s ×ˢ t₁ ∩ s ×ˢ t₂ :=
+by { ext ⟨x, y⟩, simp only [←and_and_distrib_left, mem_inter_iff, mem_prod] }
+
+@[mfld_simps]
 lemma prod_inter_prod : s₁ ×ˢ t₁ ∩ s₂ ×ˢ t₂ = (s₁ ∩ s₂) ×ˢ (t₁ ∩ t₂) :=
 by { ext ⟨x, y⟩, simp [and_assoc, and.left_comm] }
 
+@[simp] lemma disjoint_prod : disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ disjoint s₁ s₂ ∨ disjoint t₁ t₂ :=
+begin
+  simp_rw [disjoint_left, mem_prod, not_and_distrib, prod.forall, and_imp,
+    ←@forall_or_distrib_right α, ←@forall_or_distrib_left β,
+    ←@forall_or_distrib_right (_ ∈ s₁), ←@forall_or_distrib_left (_ ∈ t₁)],
+end
+
+lemma _root_.disjoint.set_prod_left (hs : disjoint s₁ s₂) (t₁ t₂ : set β) :
+  disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) :=
+disjoint_left.2 $ λ ⟨a, b⟩ ⟨ha₁, hb₁⟩ ⟨ha₂, hb₂⟩, disjoint_left.1 hs ha₁ ha₂
+
+lemma _root_.disjoint.set_prod_right (ht : disjoint t₁ t₂) (s₁ s₂ : set α) :
+  disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) :=
+disjoint_left.2 $ λ ⟨a, b⟩ ⟨ha₁, hb₁⟩ ⟨ha₂, hb₂⟩, disjoint_left.1 ht hb₁ hb₂
+
 lemma insert_prod : insert a s ×ˢ t = (prod.mk a '' t) ∪ s ×ˢ t :=
 by { ext ⟨x, y⟩, simp [image, iff_def, or_imp_distrib, imp.swap] {contextual := tt} }
 
@@ -139,10 +172,10 @@ lemma mk_preimage_prod_right_fn_eq_if [decidable_pred (∈ s)] (g : δ → β) :
   (λ b, (a, g b)) ⁻¹' s ×ˢ t = if a ∈ s then g ⁻¹' t else ∅ :=
 by rw [← mk_preimage_prod_right_eq_if, prod_preimage_right, preimage_preimage]
 
-lemma preimage_swap_prod {s : set α} {t : set β} : prod.swap ⁻¹' t ×ˢ s = s ×ˢ t :=
+@[simp] lemma preimage_swap_prod (s : set α) (t : set β) : prod.swap ⁻¹' s ×ˢ t = t ×ˢ s :=
 by { ext ⟨x, y⟩, simp [and_comm] }
 
-lemma image_swap_prod : prod.swap '' t ×ˢ s = s ×ˢ t :=
+@[simp] lemma image_swap_prod (s : set α) (t : set β) : prod.swap '' s ×ˢ t = t ×ˢ s :=
 by rw [image_swap_eq_preimage_swap, preimage_swap_prod]
 
 lemma prod_image_image_eq {m₁ : α → γ} {m₂ : β → δ} :
@@ -154,7 +187,7 @@ lemma prod_range_range_eq {m₁ : α → γ} {m₂ : β → δ} :
   (range m₁) ×ˢ (range m₂) = range (λ p : α × β, (m₁ p.1, m₂ p.2)) :=
 ext $ by simp [range]
 
-@[simp] lemma range_prod_map {m₁ : α → γ} {m₂ : β → δ} :
+@[simp, mfld_simps] lemma range_prod_map {m₁ : α → γ} {m₂ : β → δ} :
   range (prod.map m₁ m₂) = (range m₁) ×ˢ (range m₂) :=
 prod_range_range_eq.symm
 
@@ -171,13 +204,13 @@ lemma range_pair_subset (f : α → β) (g : α → γ) :
 have (λ x, (f x, g x)) = prod.map f g ∘ (λ x, (x, x)), from funext (λ x, rfl),
 by { rw [this, ← range_prod_map], apply range_comp_subset_range }
 
-lemma nonempty.prod : s.nonempty → t.nonempty → (s ×ˢ t : set _).nonempty :=
+lemma nonempty.prod : s.nonempty → t.nonempty → (s ×ˢ t).nonempty :=
 λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨(x, y), ⟨hx, hy⟩⟩
 
-lemma nonempty.fst : (s ×ˢ t : set _).nonempty → s.nonempty := λ ⟨x, hx⟩, ⟨x.1, hx.1⟩
-lemma nonempty.snd : (s ×ˢ t : set _).nonempty → t.nonempty := λ ⟨x, hx⟩, ⟨x.2, hx.2⟩
+lemma nonempty.fst : (s ×ˢ t).nonempty → s.nonempty := λ ⟨x, hx⟩, ⟨x.1, hx.1⟩
+lemma nonempty.snd : (s ×ˢ t).nonempty → t.nonempty := λ ⟨x, hx⟩, ⟨x.2, hx.2⟩
 
-lemma prod_nonempty_iff : (s ×ˢ t : set _).nonempty ↔ s.nonempty ∧ t.nonempty :=
+lemma prod_nonempty_iff : (s ×ˢ t).nonempty ↔ s.nonempty ∧ t.nonempty :=
 ⟨λ h, ⟨h.fst, h.snd⟩, λ h, h.1.prod h.2⟩
 
 lemma prod_eq_empty_iff : s ×ˢ t = ∅ ↔ s = ∅ ∨ t = ∅ :=
@@ -187,6 +220,10 @@ lemma prod_sub_preimage_iff {W : set γ} {f : α × β → γ} :
   s ×ˢ t ⊆ f ⁻¹' W ↔ ∀ a b, a ∈ s → b ∈ t → f (a, b) ∈ W :=
 by simp [subset_def]
 
+lemma image_prod_mk_subset_prod {f : α → β} {g : α → γ} {s : set α} :
+  (λ x, (f x, g x)) '' s ⊆ (f '' s) ×ˢ (g '' s) :=
+by { rintros _ ⟨x, hx, rfl⟩, exact mk_mem_prod (mem_image_of_mem f hx) (mem_image_of_mem g hx) }
+
 lemma image_prod_mk_subset_prod_left (hb : b ∈ t) : (λ a, (a, b)) '' s ⊆ s ×ˢ t :=
 by { rintro _ ⟨a, ha, rfl⟩, exact ⟨ha, hb⟩ }
 
@@ -218,7 +255,7 @@ by { ext x, by_cases h₁ : x.1 ∈ s₁; by_cases h₂ : x.2 ∈ t₁; simp * }
 first set is empty. -/
 lemma prod_subset_prod_iff : s ×ˢ t ⊆ s₁ ×ˢ t₁ ↔ s ⊆ s₁ ∧ t ⊆ t₁ ∨ s = ∅ ∨ t = ∅ :=
 begin
-  cases (s ×ˢ t : set _).eq_empty_or_nonempty with h h,
+  cases (s ×ˢ t).eq_empty_or_nonempty with h h,
   { simp [h, prod_eq_empty_iff.1 h] },
   have st : s.nonempty ∧ t.nonempty, by rwa [prod_nonempty_iff] at h,
   refine ⟨λ H, or.inl ⟨_, _⟩, _⟩,
@@ -231,42 +268,168 @@ begin
     exact prod_mono H.1 H.2 }
 end
 
-@[simp] lemma prod_eq_iff_eq (ht : t.nonempty) : s ×ˢ t = s₁ ×ˢ t ↔ s = s₁ :=
+lemma prod_eq_prod_iff_of_nonempty (h : (s ×ˢ t).nonempty) :
+  s ×ˢ t = s₁ ×ˢ t₁ ↔ s = s₁ ∧ t = t₁ :=
 begin
-  obtain ⟨b, hb⟩ := ht,
   split,
-  { simp only [set.ext_iff],
-    intros h a,
-    simpa [hb, set.mem_prod] using h (a, b) },
-  { rintros rfl,
-    refl },
+  { intro heq,
+    have h₁ : (s₁ ×ˢ t₁ : set _).nonempty, { rwa [← heq] },
+    rw [prod_nonempty_iff] at h h₁,
+    rw [← fst_image_prod s h.2, ← fst_image_prod s₁ h₁.2, heq, eq_self_iff_true, true_and,
+        ← snd_image_prod h.1 t, ← snd_image_prod h₁.1 t₁, heq] },
+  { rintro ⟨rfl, rfl⟩, refl }
+end
+
+lemma prod_eq_prod_iff : s ×ˢ t = s₁ ×ˢ t₁ ↔ s = s₁ ∧ t = t₁ ∨ (s = ∅ ∨ t = ∅) ∧
+  (s₁ = ∅ ∨ t₁ = ∅) :=
+begin
+  symmetry,
+  cases eq_empty_or_nonempty (s ×ˢ t) with h h,
+  { simp_rw [h, @eq_comm _ ∅, prod_eq_empty_iff, prod_eq_empty_iff.mp h, true_and,
+      or_iff_right_iff_imp],
+    rintro ⟨rfl, rfl⟩, exact prod_eq_empty_iff.mp h },
+  rw [prod_eq_prod_iff_of_nonempty h],
+  rw [nonempty_iff_ne_empty, ne.def, prod_eq_empty_iff] at h,
+  simp_rw [h, false_and, or_false],
+end
+
+@[simp] lemma prod_eq_iff_eq (ht : t.nonempty) : s ×ˢ t = s₁ ×ˢ t ↔ s = s₁ :=
+begin
+  simp_rw [prod_eq_prod_iff, ht.ne_empty, eq_self_iff_true, and_true, or_iff_left_iff_imp,
+    or_false],
+  rintro ⟨rfl, rfl⟩,
+  refl,
 end
 
-@[simp] lemma image_prod (f : α → β → γ) : (λ x : α × β, f x.1 x.2) '' s ×ˢ t = image2 f s t :=
-set.ext $ λ a,
-⟨ by { rintro ⟨_, _, rfl⟩, exact ⟨_, _, (mem_prod.mp ‹_›).1, (mem_prod.mp ‹_›).2, rfl⟩ },
-  by { rintro ⟨_, _, _, _, rfl⟩, exact ⟨(_, _), mem_prod.mpr ⟨‹_›, ‹_›⟩, rfl⟩ }⟩
+section mono
+
+variables [preorder α] {f : α → set β} {g : α → set γ}
+
+theorem _root_.monotone.set_prod (hf : monotone f) (hg : monotone g) : monotone (λ x, f x ×ˢ g x) :=
+λ a b h, prod_mono (hf h) (hg h)
+
+theorem _root_.antitone.set_prod (hf : antitone f) (hg : antitone g) : antitone (λ x, f x ×ˢ g x) :=
+λ a b h, prod_mono (hf h) (hg h)
+
+theorem _root_.monotone_on.set_prod (hf : monotone_on f s) (hg : monotone_on g s) :
+  monotone_on (λ x, f x ×ˢ g x) s :=
+λ a ha b hb h, prod_mono (hf ha hb h) (hg ha hb h)
+
+theorem _root_.antitone_on.set_prod (hf : antitone_on f s) (hg : antitone_on g s) :
+  antitone_on (λ x, f x ×ˢ g x) s :=
+λ a ha b hb h, prod_mono (hf ha hb h) (hg ha hb h)
+
+end mono
 
 end prod
 
-/-! ### Diagonal -/
+/-! ### Diagonal
+
+In this section we prove some lemmas about the diagonal set `{p | p.1 = p.2}` and the diagonal map
+`λ x, (x, x)`.
+-/
 
 section diagonal
-variables {α : Type*}
+variables {α : Type*} {s t : set α}
 
 /-- `diagonal α` is the set of `α × α` consisting of all pairs of the form `(a, a)`. -/
 def diagonal (α : Type*) : set (α × α) := {p | p.1 = p.2}
 
-@[simp] lemma mem_diagonal (x : α) : (x, x) ∈ diagonal α := by simp [diagonal]
+lemma mem_diagonal (x : α) : (x, x) ∈ diagonal α := by simp [diagonal]
+
+@[simp] lemma mem_diagonal_iff {x : α × α} : x ∈ diagonal α ↔ x.1 = x.2 := iff.rfl
+
+lemma diagonal_nonempty [nonempty α] : (diagonal α).nonempty :=
+nonempty.elim ‹_› $ λ x, ⟨_, mem_diagonal x⟩
+
+instance decidable_mem_diagonal [h : decidable_eq α] (x : α × α) : decidable (x ∈ diagonal α) :=
+h x.1 x.2
 
 lemma preimage_coe_coe_diagonal (s : set α) : (prod.map coe coe) ⁻¹' (diagonal α) = diagonal s :=
 by { ext ⟨⟨x, hx⟩, ⟨y, hy⟩⟩, simp [set.diagonal] }
 
-lemma diagonal_eq_range : diagonal α = range (λ x, (x, x)) :=
+@[simp] lemma range_diag : range (λ x, (x, x)) = diagonal α :=
 by { ext ⟨x, y⟩, simp [diagonal, eq_comm] }
 
+lemma diagonal_subset_iff {s} : diagonal α ⊆ s ↔ ∀ x, (x, x) ∈ s :=
+by rw [← range_diag, range_subset_iff]
+
+@[simp] lemma prod_subset_compl_diagonal_iff_disjoint : s ×ˢ t ⊆ (diagonal α)ᶜ ↔ disjoint s t :=
+prod_subset_iff.trans disjoint_iff_forall_ne.symm
+
+@[simp] lemma diag_preimage_prod (s t : set α) : (λ x, (x, x)) ⁻¹' (s ×ˢ t) = s ∩ t := rfl
+
+lemma diag_preimage_prod_self (s : set α) : (λ x, (x, x)) ⁻¹' (s ×ˢ s) = s := inter_self s
+
+lemma diag_image (s : set α) : (λ x, (x, x)) '' s = diagonal α ∩ (s ×ˢ s) :=
+begin
+  ext x, split,
+  { rintro ⟨x, hx, rfl⟩, exact ⟨rfl, hx, hx⟩ },
+  { obtain ⟨x, y⟩ := x,
+    rintro ⟨rfl : x = y, h2x⟩,
+    exact mem_image_of_mem _ h2x.1 }
+end
+
 end diagonal
 
+section off_diag
+variables {α : Type*} {s t : set α} {x : α × α} {a : α}
+
+/-- The off-diagonal of a set `s` is the set of pairs `(a, b)` with `a, b ∈ s` and `a ≠ b`. -/
+def off_diag (s : set α) : set (α × α) := {x | x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2}
+
+@[simp] lemma mem_off_diag : x ∈ s.off_diag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 := iff.rfl
+
+lemma off_diag_mono : monotone (off_diag : set α → set (α × α)) :=
+λ s t h x, and.imp (@h _) $ and.imp_left $ @h _
+
+@[simp] lemma off_diag_nonempty : s.off_diag.nonempty ↔ s.nontrivial :=
+by simp [off_diag, set.nonempty, set.nontrivial]
+
+@[simp] lemma off_diag_eq_empty : s.off_diag = ∅ ↔ s.subsingleton :=
+by rw [←not_nonempty_iff_eq_empty, ←not_nontrivial_iff, off_diag_nonempty.not]
+
+alias off_diag_nonempty ↔ _ nontrivial.off_diag_nonempty
+alias off_diag_nonempty ↔ _ subsingleton.off_diag_eq_empty
+
+variables (s t)
+
+lemma off_diag_subset_prod : s.off_diag ⊆ s ×ˢ s := λ x hx, ⟨hx.1, hx.2.1⟩
+lemma off_diag_eq_sep_prod : s.off_diag = {x ∈ s ×ˢ s | x.1 ≠ x.2} := ext $ λ _, and.assoc.symm
+
+@[simp] lemma off_diag_empty : (∅ : set α).off_diag = ∅ := by simp
+@[simp] lemma off_diag_singleton (a : α) : ({a} : set α).off_diag = ∅ := by simp
+@[simp] lemma off_diag_univ : (univ : set α).off_diag = (diagonal α)ᶜ := ext $ by simp
+
+@[simp] lemma prod_sdiff_diagonal : s ×ˢ s \ diagonal α = s.off_diag := ext $ λ _, and.assoc
+@[simp] lemma disjoint_diagonal_off_diag : disjoint (diagonal α) s.off_diag :=
+disjoint_left.mpr $ λ x hd ho, ho.2.2 hd
+
+lemma off_diag_inter : (s ∩ t).off_diag = s.off_diag ∩ t.off_diag :=
+ext $ λ x, by { simp only [mem_off_diag, mem_inter_iff], tauto }
+
+variables {s t}
+
+lemma off_diag_union (h : disjoint s t) :
+  (s ∪ t).off_diag = s.off_diag ∪ t.off_diag ∪ s ×ˢ t ∪ t ×ˢ s :=
+begin
+  rw [off_diag_eq_sep_prod, union_prod, prod_union, prod_union, union_comm _ (t ×ˢ t), union_assoc,
+    union_left_comm (s ×ˢ t), ←union_assoc, sep_union, sep_union, ←off_diag_eq_sep_prod,
+    ←off_diag_eq_sep_prod, sep_eq_self_iff_mem_true.2, ←union_assoc],
+  simp only [mem_union, mem_prod, ne.def, prod.forall],
+  rintro i j (⟨hi, hj⟩ | ⟨hi, hj⟩) rfl; exact h.le_bot ⟨‹_›, ‹_›⟩,
+end
+
+lemma off_diag_insert (ha : a ∉ s) : (insert a s).off_diag = s.off_diag ∪ {a} ×ˢ s ∪ s ×ˢ {a} :=
+begin
+  rw [insert_eq, union_comm, off_diag_union, off_diag_singleton, union_empty, union_right_comm],
+  rw disjoint_left,
+  rintro b hb (rfl : b = a),
+  exact ha hb
+end
+
+end off_diag
+
 /-! ### Cartesian set-indexed product of sets -/
 
 section pi
@@ -290,13 +453,13 @@ lemma pi_mono (h : ∀ i ∈ s, t₁ i ⊆ t₂ i) : pi s t₁ ⊆ pi s t₂ :=
 λ x hx i hi, (h i hi $ hx i hi)
 
 lemma pi_inter_distrib : s.pi (λ i, t i ∩ t₁ i) = s.pi t ∩ s.pi t₁ :=
-ext $ λ x, by simp only [forall_and_distrib, mem_pi, mem_inter_eq]
+ext $ λ x, by simp only [forall_and_distrib, mem_pi, mem_inter_iff]
 
 lemma pi_congr (h : s₁ = s₂) (h' : ∀ i ∈ s₁, t₁ i = t₂ i) : s₁.pi t₁ = s₂.pi t₂ :=
 h ▸ (ext $ λ x, forall₂_congr $ λ i hi, h' i hi ▸ iff.rfl)
 
 lemma pi_eq_empty (hs : i ∈ s) (ht : t i = ∅) : s.pi t = ∅ :=
-by { ext f, simp only [mem_empty_eq, not_forall, iff_false, mem_pi, not_imp],
+by { ext f, simp only [mem_empty_iff_false, not_forall, iff_false, mem_pi, not_imp],
      exact ⟨i, hs, by simp [ht]⟩ }
 
 lemma univ_pi_eq_empty (ht : t i = ∅) : pi univ t = ∅ := pi_eq_empty (mem_univ i) ht
@@ -311,20 +474,33 @@ lemma pi_eq_empty_iff : s.pi t = ∅ ↔ ∃ i, is_empty (α i) ∨ i ∈ s ∧
 begin
   rw [← not_nonempty_iff_eq_empty, pi_nonempty_iff],
   push_neg,
-  refine exists_congr (λ i, ⟨λ h, (is_empty_or_nonempty (α i)).imp_right _, _⟩),
-  { rintro ⟨x⟩,
-    exact ⟨(h x).1, by simp [eq_empty_iff_forall_not_mem, h]⟩ },
-  { rintro (h | h) x,
-    { exact h.elim' x },
-    { simp [h] } }
+  refine exists_congr (λ i, _),
+  casesI is_empty_or_nonempty (α i); simp [*, forall_and_distrib, eq_empty_iff_forall_not_mem],
 end
 
-lemma univ_pi_eq_empty_iff : pi univ t = ∅ ↔ ∃ i, t i = ∅ :=
+@[simp] lemma univ_pi_eq_empty_iff : pi univ t = ∅ ↔ ∃ i, t i = ∅ :=
 by simp [← not_nonempty_iff_eq_empty, univ_pi_nonempty_iff]
 
 @[simp] lemma univ_pi_empty [h : nonempty ι] : pi univ (λ i, ∅ : Π i, set (α i)) = ∅ :=
 univ_pi_eq_empty_iff.2 $ h.elim $ λ x, ⟨x, rfl⟩
 
+@[simp] lemma disjoint_univ_pi : disjoint (pi univ t₁) (pi univ t₂) ↔ ∃ i, disjoint (t₁ i) (t₂ i) :=
+by simp only [disjoint_iff_inter_eq_empty, ← pi_inter_distrib, univ_pi_eq_empty_iff]
+
+lemma _root_.disjoint.set_pi (hi : i ∈ s) (ht : disjoint (t₁ i) (t₂ i)) :
+  disjoint (s.pi t₁) (s.pi t₂) :=
+disjoint_left.2 $ λ h h₁ h₂, disjoint_left.1 ht (h₁ _ hi) (h₂ _ hi)
+
+section nonempty
+variables [Π i, nonempty (α i)]
+
+lemma pi_eq_empty_iff' : s.pi t = ∅ ↔ ∃ i ∈ s, t i = ∅ := by simp [pi_eq_empty_iff]
+
+@[simp] lemma disjoint_pi : disjoint (s.pi t₁) (s.pi t₂) ↔ ∃ i ∈ s, disjoint (t₁ i) (t₂ i) :=
+by simp only [disjoint_iff_inter_eq_empty, ← pi_inter_distrib, pi_eq_empty_iff']
+
+end nonempty
+
 @[simp] lemma range_dcomp (f : Π i, α i → β i) :
   range (λ (g : Π i, α i), (λ i, f i (g i))) = pi univ (λ i, range (f i)) :=
 begin
@@ -344,6 +520,12 @@ by { ext, simp [pi] }
 
 lemma singleton_pi' (i : ι) (t : Π i, set (α i)) : pi {i} t = {x | x i ∈ t i} := singleton_pi i t
 
+lemma univ_pi_singleton (f : Π i, α i) : pi univ (λ i, {f i}) = ({f} : set (Π i, α i)) :=
+ext $ λ g, by simp [funext_iff]
+
+lemma preimage_pi (s : set ι) (t : Π i, set (β i)) (f : Π i, α i → β i) :
+  (λ (g : Π i, α i) i, f _ (g i)) ⁻¹' s.pi t = s.pi (λ i, f i ⁻¹' t i) := rfl
+
 lemma pi_if {p : ι → Prop} [h : decidable_pred p] (s : set ι) (t₁ t₂ : Π i, set (α i)) :
   pi s (λ i, if p i then t₁ i else t₂ i) = pi {i ∈ s | p i} t₁ ∩ pi {i ∈ s | ¬ p i} t₂ :=
 begin
@@ -388,19 +570,33 @@ image_subset_iff.2 $ λ f hf, hf i hs
 lemma eval_image_univ_pi_subset : eval i '' pi univ t ⊆ t i :=
 eval_image_pi_subset (mem_univ i)
 
-lemma eval_image_pi (hs : i ∈ s) (ht : (s.pi t).nonempty) : eval i '' s.pi t = t i :=
+lemma subset_eval_image_pi (ht : (s.pi t).nonempty) (i : ι) : t i ⊆ eval i '' s.pi t :=
 begin
-  refine (eval_image_pi_subset hs).antisymm _,
   classical,
   obtain ⟨f, hf⟩ := ht,
   refine λ y hy, ⟨update f i y, λ j hj, _, update_same _ _ _⟩,
   obtain rfl | hji := eq_or_ne j i; simp [*, hf _ hj]
 end
 
+lemma eval_image_pi (hs : i ∈ s) (ht : (s.pi t).nonempty) : eval i '' s.pi t = t i :=
+(eval_image_pi_subset hs).antisymm (subset_eval_image_pi ht i)
+
 @[simp] lemma eval_image_univ_pi (ht : (pi univ t).nonempty) :
   (λ f : Π i, α i, f i) '' pi univ t = t i :=
 eval_image_pi (mem_univ i) ht
 
+lemma pi_subset_pi_iff : pi s t₁ ⊆ pi s t₂ ↔ (∀ i ∈ s, t₁ i ⊆ t₂ i) ∨ pi s t₁ = ∅ :=
+begin
+  refine ⟨λ h, or_iff_not_imp_right.2 _, λ h, h.elim pi_mono (λ h', h'.symm ▸ empty_subset _)⟩,
+  rw [← ne.def, ←nonempty_iff_ne_empty],
+  intros hne i hi,
+  simpa only [eval_image_pi hi hne, eval_image_pi hi (hne.mono h)]
+    using image_subset (λ f : Π i, α i, f i) h
+end
+
+lemma univ_pi_subset_univ_pi_iff : pi univ t₁ ⊆ pi univ t₂ ↔ (∀ i, t₁ i ⊆ t₂ i) ∨ ∃ i, t₁ i = ∅ :=
+by simp [pi_subset_pi_iff]
+
 lemma eval_preimage [decidable_eq ι] {s : set (α i)} :
   eval i ⁻¹' s = pi univ (update (λ i, univ) i s) :=
 by { ext x, simp [@forall_update_iff _ (λ i, set (α i)) _ _ _ _ (λ i' y, x i' ∈ y)] }
diff --git a/src/data/set/semiring.lean b/src/data/set/semiring.lean
new file mode 100644
index 0000000000000..317c3cb13408d
--- /dev/null
+++ b/src/data/set/semiring.lean
@@ -0,0 +1,159 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import algebra.order.kleene
+import data.set.pointwise.smul
+
+/-!
+# Sets as a semiring under union
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `set_semiring α`, an alias of `set α`, which we endow with `∪` as addition and
+pointwise `*` as multiplication. If `α` is a (commutative) monoid, `set_semiring α` is a
+(commutative) semiring.
+-/
+
+open function set
+open_locale pointwise
+
+variables {α β : Type*}
+
+/-- An alias for `set α`, which has a semiring structure given by `∪` as "addition" and pointwise
+  multiplication `*` as "multiplication". -/
+@[derive [inhabited, partial_order, order_bot]] def set_semiring (α : Type*) : Type* := set α
+
+/-- The identity function `set α → set_semiring α`. -/
+protected def set.up : set α ≃ set_semiring α := equiv.refl _
+
+namespace set_semiring
+
+/-- The identity function `set_semiring α → set α`. -/
+protected def down : set_semiring α ≃ set α := equiv.refl _
+
+@[simp] protected lemma down_up (s : set α) : s.up.down = s := rfl
+@[simp] protected lemma up_down (s : set_semiring α) : s.down.up = s := rfl
+
+-- TODO: These lemmas are not tagged `simp` because `set.le_eq_subset` simplifies the LHS
+lemma up_le_up {s t : set α} : s.up ≤ t.up ↔ s ⊆ t := iff.rfl
+lemma up_lt_up {s t : set α} : s.up < t.up ↔ s ⊂ t := iff.rfl
+
+@[simp] lemma down_subset_down {s t : set_semiring α} : s.down ⊆ t.down ↔ s ≤ t := iff.rfl
+@[simp] lemma down_ssubset_down {s t : set_semiring α} : s.down ⊂ t.down ↔ s < t := iff.rfl
+
+instance : add_comm_monoid (set_semiring α) :=
+{ add := λ s t, (s.down ∪ t.down).up,
+  zero := (∅ : set α).up,
+  add_assoc := union_assoc,
+  zero_add := empty_union,
+  add_zero := union_empty,
+  add_comm := union_comm }
+
+lemma zero_def : (0 : set_semiring α) = set.up ∅ := rfl
+
+@[simp] lemma down_zero : (0 : set_semiring α).down = ∅ := rfl
+
+@[simp] lemma _root_.set.up_empty : (∅ : set α).up = 0 := rfl
+
+lemma add_def (s t : set_semiring α) : s + t = (s.down ∪ t.down).up := rfl
+
+@[simp] lemma down_add (s t : set_semiring α) : (s + t).down = s.down ∪ t.down := rfl
+
+@[simp] lemma _root_.set.up_union (s t : set α) : (s ∪ t).up = s.up + t.up := rfl
+
+/- Since addition on `set_semiring` is commutative (it is set union), there is no need
+to also have the instance `covariant_class (set_semiring α) (set_semiring α) (swap (+)) (≤)`. -/
+instance covariant_class_add : covariant_class (set_semiring α) (set_semiring α) (+) (≤) :=
+⟨λ a b c, union_subset_union_right _⟩
+
+section has_mul
+variables [has_mul α]
+
+instance : non_unital_non_assoc_semiring (set_semiring α) :=
+{ -- reducibility linter complains if we use `(s.down * t.down).up`
+  mul := λ s t, (image2 (*) s.down t.down).up,
+  zero_mul := λ s, empty_mul,
+  mul_zero := λ s, mul_empty,
+  left_distrib := λ _ _ _, mul_union,
+  right_distrib := λ _ _ _, union_mul,
+  ..set_semiring.add_comm_monoid }
+
+lemma mul_def (s t : set_semiring α) : s * t = (s.down * t.down).up := rfl
+
+@[simp] lemma down_mul (s t : set_semiring α) : (s * t).down = s.down * t.down := rfl
+
+@[simp] lemma _root_.set.up_mul (s t : set α) : (s * t).up = s.up * t.up := rfl
+
+instance : no_zero_divisors (set_semiring α) :=
+⟨λ a b ab, a.eq_empty_or_nonempty.imp_right $ λ ha, b.eq_empty_or_nonempty.resolve_right $
+  λ hb, nonempty.ne_empty ⟨_, mul_mem_mul ha.some_mem hb.some_mem⟩ ab⟩
+
+instance covariant_class_mul_left : covariant_class (set_semiring α) (set_semiring α) (*) (≤) :=
+⟨λ a b c, mul_subset_mul_left⟩
+
+instance covariant_class_mul_right :
+  covariant_class (set_semiring α) (set_semiring α) (swap (*)) (≤) :=
+⟨λ a b c, mul_subset_mul_right⟩
+
+end has_mul
+
+section has_one
+variables [has_one α]
+
+instance : has_one (set_semiring α) := { one := set.up 1 }
+
+lemma one_def : (1 : set_semiring α) = set.up 1 := rfl
+
+@[simp] lemma down_one : (1 : set_semiring α).down = 1 := rfl
+
+@[simp] lemma _root_.set.up_one : (1 : set α).up = 1 := rfl
+
+end has_one
+
+instance [mul_one_class α] : non_assoc_semiring (set_semiring α) :=
+{ one := 1,
+  mul := (*),
+  ..set_semiring.non_unital_non_assoc_semiring, ..set.mul_one_class }
+
+instance [semigroup α] : non_unital_semiring (set_semiring α) :=
+{ ..set_semiring.non_unital_non_assoc_semiring, ..set.semigroup }
+
+instance [monoid α] : idem_semiring (set_semiring α) :=
+{ ..set_semiring.non_assoc_semiring, ..set_semiring.non_unital_semiring,
+  ..set.complete_boolean_algebra }
+
+instance [comm_semigroup α] : non_unital_comm_semiring (set_semiring α) :=
+{ ..set_semiring.non_unital_semiring, ..set.comm_semigroup }
+
+instance [comm_monoid α] : idem_comm_semiring (set_semiring α) :=
+{ ..set_semiring.idem_semiring, ..set.comm_monoid }
+
+instance [comm_monoid α] : canonically_ordered_comm_semiring (set_semiring α) :=
+{ add_le_add_left := λ a b, add_le_add_left,
+  exists_add_of_le := λ a b ab, ⟨b, (union_eq_right_iff_subset.2 ab).symm⟩,
+  le_self_add := subset_union_left,
+  ..set_semiring.idem_semiring, ..set.comm_monoid, ..set_semiring.no_zero_divisors }
+
+/-- The image of a set under a multiplicative homomorphism is a ring homomorphism
+with respect to the pointwise operations on sets. -/
+def image_hom [mul_one_class α] [mul_one_class β] (f : α →* β) :
+  set_semiring α →+* set_semiring β :=
+{ to_fun := λ s, (image f s.down).up,
+  map_zero' := image_empty _,
+  map_one' := by rw [down_one, image_one, map_one, singleton_one, set.up_one],
+  map_add' := image_union _,
+  map_mul' := λ _ _, image_mul f }
+
+lemma image_hom_def [mul_one_class α] [mul_one_class β] (f : α →* β) (s : set_semiring α) :
+  image_hom f s = (image f s.down).up := rfl
+
+@[simp] lemma down_image_hom [mul_one_class α] [mul_one_class β] (f : α →* β) (s : set_semiring α) :
+  (image_hom f s).down = f '' s.down := rfl
+
+@[simp] lemma _root_.set.up_image [mul_one_class α] [mul_one_class β] (f : α →* β) (s : set α) :
+  (f '' s).up = image_hom f s.up := rfl
+
+end set_semiring
diff --git a/src/data/set/sigma.lean b/src/data/set/sigma.lean
index 4fb39014e3819..76edf176d89de 100644
--- a/src/data/set/sigma.lean
+++ b/src/data/set/sigma.lean
@@ -3,17 +3,49 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import data.set.basic
+import data.set.image
 
 /-!
 # Sets in sigma types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `set.sigma`, the indexed sum of sets.
 -/
 
 namespace set
 variables {ι ι' : Type*} {α β : ι → Type*} {s s₁ s₂ : set ι} {t t₁ t₂ : Π i, set (α i)}
-  {u : set (Σ i, α i)} {x : Σ i, α i} {i : ι} {a : α i}
+  {u : set (Σ i, α i)} {x : Σ i, α i} {i j : ι} {a : α i}
+
+@[simp] theorem range_sigma_mk (i : ι) :
+  range (sigma.mk i : α i → sigma α) = sigma.fst ⁻¹' {i} :=
+begin
+  apply subset.antisymm,
+  { rintros _ ⟨b, rfl⟩, simp },
+  { rintros ⟨x, y⟩ (rfl|_),
+    exact mem_range_self y }
+end
+
+theorem preimage_image_sigma_mk_of_ne (h : i ≠ j) (s : set (α j)) :
+  sigma.mk i ⁻¹' (sigma.mk j '' s) = ∅ :=
+by { ext x, simp [h.symm] }
+
+lemma image_sigma_mk_preimage_sigma_map_subset {β : ι' → Type*} (f : ι → ι')
+  (g : Π i, α i → β (f i)) (i : ι) (s : set (β (f i))) :
+  sigma.mk i '' (g i ⁻¹' s) ⊆ sigma.map f g ⁻¹' (sigma.mk (f i) '' s) :=
+image_subset_iff.2 $ λ x hx, ⟨g i x, hx, rfl⟩
+
+lemma image_sigma_mk_preimage_sigma_map {β : ι' → Type*} {f : ι → ι'} (hf : function.injective f)
+  (g : Π i, α i → β (f i)) (i : ι) (s : set (β (f i))) :
+  sigma.mk i '' (g i ⁻¹' s) = sigma.map f g ⁻¹' (sigma.mk (f i) '' s) :=
+begin
+  refine (image_sigma_mk_preimage_sigma_map_subset f g i s).antisymm _,
+  rintro ⟨j, x⟩ ⟨y, hys, hxy⟩,
+  simp only [hf.eq_iff, sigma.map] at hxy,
+  rcases hxy with ⟨rfl, hxy⟩, rw [heq_iff_eq] at hxy, subst y,
+  exact ⟨x, hys, rfl⟩
+end
 
 /-- Indexed sum of sets. `s.sigma t` is the set of dependent pairs `⟨i, a⟩` such that `i ∈ s` and
 `a ∈ t i`.-/
@@ -38,7 +70,7 @@ lemma exists_sigma_iff {p : (Σ i, α i) → Prop} :
   (∃ x ∈ s.sigma t, p x) ↔ ∃ (i ∈ s) (a ∈ t i), p ⟨i, a⟩ :=
 ⟨λ ⟨⟨i, a⟩, ha, h⟩, ⟨i, ha.1, a, ha.2, h⟩, λ ⟨i, hi, a, ha, h⟩, ⟨⟨i, a⟩, ⟨hi, ha⟩, h⟩⟩
 
-@[simp] lemma sigma_empty : s.sigma (λ _, (∅ : set (α i))) = ∅ := ext $ λ _, and_false _
+@[simp] lemma sigma_empty : s.sigma (λ i, (∅ : set (α i))) = ∅ := ext $ λ _, and_false _
 @[simp] lemma empty_sigma : (∅ : set ι).sigma t = ∅ := ext $ λ _, false_and _
 lemma univ_sigma_univ : (@univ ι).sigma (λ _, @univ (α i)) = univ := ext $ λ _, true_and _
 @[simp] lemma sigma_univ : s.sigma (λ _, univ : Π i, set (α i)) = sigma.fst ⁻¹' s :=
diff --git a/src/data/set/sups.lean b/src/data/set/sups.lean
new file mode 100644
index 0000000000000..a03506695192e
--- /dev/null
+++ b/src/data/set/sups.lean
@@ -0,0 +1,223 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import data.set.n_ary
+import order.upper_lower.basic
+
+/-!
+# Set family operations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines a few binary operations on `set α` for use in set family combinatorics.
+
+## Main declarations
+
+* `s ⊻ t`: Set of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`.
+* `s ⊼ t`: Set of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`.
+
+## Notation
+
+We define the following notation in locale `set_family`:
+* `s ⊻ t`
+* `s ⊼ t`
+
+## References
+
+[B. Bollobás, *Combinatorics*][bollobas1986]
+-/
+
+open function
+
+variables {α : Type*}
+
+/-- Notation typeclass for pointwise supremum `⊻`. -/
+class has_sups (α : Type*) :=
+(sups : α → α → α)
+
+/-- Notation typeclass for pointwise infimum `⊼`. -/
+class has_infs (α : Type*) :=
+(infs : α → α → α)
+
+-- This notation is meant to have higher precedence than `⊔` and `⊓`, but still within the realm of
+-- other binary operations
+infix ` ⊻ `:74 := has_sups.sups
+infix ` ⊼ `:75 := has_infs.infs
+
+namespace set
+section sups
+variables [semilattice_sup α] (s s₁ s₂ t t₁ t₂ u v : set α)
+
+/-- `s ⊻ t` is the set of elements of the form `a ⊔ b` where `a ∈ s`, `b ∈ t`. -/
+protected def has_sups : has_sups (set α) := ⟨image2 (⊔)⟩
+
+localized "attribute [instance] set.has_sups" in set_family
+
+variables {s s₁ s₂ t t₁ t₂ u} {a b c : α}
+
+@[simp] lemma mem_sups : c ∈ s ⊻ t ↔ ∃ (a ∈ s) (b ∈ t), a ⊔ b = c := by simp [(⊻)]
+
+lemma sup_mem_sups : a ∈ s → b ∈ t → a ⊔ b ∈ s ⊻ t := mem_image2_of_mem
+lemma sups_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊻ t₁ ⊆ s₂ ⊻ t₂ := image2_subset
+lemma sups_subset_left : t₁ ⊆ t₂ → s ⊻ t₁ ⊆ s ⊻ t₂ := image2_subset_left
+lemma sups_subset_right : s₁ ⊆ s₂ → s₁ ⊻ t ⊆ s₂ ⊻ t := image2_subset_right
+
+lemma image_subset_sups_left : b ∈ t → (λ a, a ⊔ b) '' s ⊆ s ⊻ t := image_subset_image2_left
+lemma image_subset_sups_right : a ∈ s → (⊔) a '' t ⊆ s ⊻ t := image_subset_image2_right
+
+lemma forall_sups_iff {p : α → Prop} : (∀ c ∈ s ⊻ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), p (a ⊔ b) :=
+forall_image2_iff
+
+@[simp] lemma sups_subset_iff : s ⊻ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a ⊔ b ∈ u := image2_subset_iff
+
+@[simp] lemma sups_nonempty : (s ⊻ t).nonempty ↔ s.nonempty ∧ t.nonempty := image2_nonempty_iff
+
+protected lemma nonempty.sups : s.nonempty → t.nonempty → (s ⊻ t).nonempty := nonempty.image2
+lemma nonempty.of_sups_left : (s ⊻ t).nonempty → s.nonempty := nonempty.of_image2_left
+lemma nonempty.of_sups_right : (s ⊻ t).nonempty → t.nonempty := nonempty.of_image2_right
+
+@[simp] lemma empty_sups : ∅ ⊻ t = ∅ := image2_empty_left
+@[simp] lemma sups_empty : s ⊻ ∅ = ∅ := image2_empty_right
+@[simp] lemma sups_eq_empty : s ⊻ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+
+@[simp] lemma singleton_sups : {a} ⊻ t = t.image (λ b, a ⊔ b) := image2_singleton_left
+@[simp] lemma sups_singleton : s ⊻ {b} = s.image (λ a, a ⊔ b) := image2_singleton_right
+
+lemma singleton_sups_singleton : ({a} ⊻ {b} : set α) = {a ⊔ b} := image2_singleton
+
+lemma sups_union_left : (s₁ ∪ s₂) ⊻ t = s₁ ⊻ t ∪ s₂ ⊻ t := image2_union_left
+lemma sups_union_right : s ⊻ (t₁ ∪ t₂) = s ⊻ t₁ ∪ s ⊻ t₂ := image2_union_right
+
+lemma sups_inter_subset_left : (s₁ ∩ s₂) ⊻ t ⊆ s₁ ⊻ t ∩ s₂ ⊻ t := image2_inter_subset_left
+lemma sups_inter_subset_right : s ⊻ (t₁ ∩ t₂) ⊆ s ⊻ t₁ ∩ s ⊻ t₂ := image2_inter_subset_right
+
+variables (s t u v)
+
+lemma Union_image_sup_left : (⋃ a ∈ s, (⊔) a '' t) = s ⊻ t := Union_image_left _
+lemma Union_image_sup_right : (⋃ b ∈ t, (⊔ b) '' s) = s ⊻ t := Union_image_right _
+
+@[simp] lemma image_sup_prod (s t : set α) : (s ×ˢ t).image (uncurry (⊔)) = s ⊻ t :=
+image_uncurry_prod _ _ _
+
+lemma sups_assoc : (s ⊻ t) ⊻ u = s ⊻ (t ⊻ u) := image2_assoc $ λ _ _ _, sup_assoc
+lemma sups_comm : s ⊻ t = t ⊻ s := image2_comm $ λ _ _, sup_comm
+lemma sups_left_comm : s ⊻ (t ⊻ u) = t ⊻ (s ⊻ u) := image2_left_comm sup_left_comm
+lemma sups_right_comm : (s ⊻ t) ⊻ u = (s ⊻ u) ⊻ t := image2_right_comm sup_right_comm
+lemma sups_sups_sups_comm : (s ⊻ t) ⊻ (u ⊻ v) = (s ⊻ u) ⊻ (t ⊻ v) :=
+image2_image2_image2_comm sup_sup_sup_comm
+
+end sups
+
+section infs
+variables [semilattice_inf α] (s s₁ s₂ t t₁ t₂ u v : set α)
+
+/-- `s ⊼ t` is the set of elements of the form `a ⊓ b` where `a ∈ s`, `b ∈ t`. -/
+protected def has_infs : has_infs (set α) := ⟨image2 (⊓)⟩
+
+localized "attribute [instance] set.has_infs" in set_family
+
+variables {s s₁ s₂ t t₁ t₂ u} {a b c : α}
+
+@[simp] lemma mem_infs : c ∈ s ⊼ t ↔ ∃ (a ∈ s) (b ∈ t), a ⊓ b = c := by simp [(⊼)]
+
+lemma inf_mem_infs : a ∈ s → b ∈ t → a ⊓ b ∈ s ⊼ t := mem_image2_of_mem
+lemma infs_subset : s₁ ⊆ s₂ → t₁ ⊆ t₂ → s₁ ⊼ t₁ ⊆ s₂ ⊼ t₂ := image2_subset
+lemma infs_subset_left : t₁ ⊆ t₂ → s ⊼ t₁ ⊆ s ⊼ t₂ := image2_subset_left
+lemma infs_subset_right : s₁ ⊆ s₂ → s₁ ⊼ t ⊆ s₂ ⊼ t := image2_subset_right
+
+lemma image_subset_infs_left : b ∈ t → (λ a, a ⊓ b) '' s ⊆ s ⊼ t := image_subset_image2_left
+lemma image_subset_infs_right : a ∈ s → (⊓) a '' t ⊆ s ⊼ t := image_subset_image2_right
+
+lemma forall_infs_iff {p : α → Prop} : (∀ c ∈ s ⊼ t, p c) ↔ ∀ (a ∈ s) (b ∈ t), p (a ⊓ b) :=
+forall_image2_iff
+
+@[simp] lemma infs_subset_iff : s ⊼ t ⊆ u ↔ ∀ (a ∈ s) (b ∈ t), a ⊓ b ∈ u := image2_subset_iff
+
+@[simp] lemma infs_nonempty : (s ⊼ t).nonempty ↔ s.nonempty ∧ t.nonempty := image2_nonempty_iff
+
+protected lemma nonempty.infs : s.nonempty → t.nonempty → (s ⊼ t).nonempty := nonempty.image2
+lemma nonempty.of_infs_left : (s ⊼ t).nonempty → s.nonempty := nonempty.of_image2_left
+lemma nonempty.of_infs_right : (s ⊼ t).nonempty → t.nonempty := nonempty.of_image2_right
+
+@[simp] lemma empty_infs : ∅ ⊼ t = ∅ := image2_empty_left
+@[simp] lemma infs_empty : s ⊼ ∅ = ∅ := image2_empty_right
+@[simp] lemma infs_eq_empty : s ⊼ t = ∅ ↔ s = ∅ ∨ t = ∅ := image2_eq_empty_iff
+
+@[simp] lemma singleton_infs : {a} ⊼ t = t.image (λ b, a ⊓ b) := image2_singleton_left
+@[simp] lemma infs_singleton : s ⊼ {b} = s.image (λ a, a ⊓ b) := image2_singleton_right
+lemma singleton_infs_singleton : ({a} ⊼ {b} : set α) = {a ⊓ b} := image2_singleton
+
+lemma infs_union_left : (s₁ ∪ s₂) ⊼ t = s₁ ⊼ t ∪ s₂ ⊼ t := image2_union_left
+lemma infs_union_right : s ⊼ (t₁ ∪ t₂) = s ⊼ t₁ ∪ s ⊼ t₂ := image2_union_right
+
+lemma infs_inter_subset_left : (s₁ ∩ s₂) ⊼ t ⊆ s₁ ⊼ t ∩ s₂ ⊼ t := image2_inter_subset_left
+lemma infs_inter_subset_right : s ⊼ (t₁ ∩ t₂) ⊆ s ⊼ t₁ ∩ s ⊼ t₂ := image2_inter_subset_right
+
+variables (s t u v)
+
+lemma Union_image_inf_left : (⋃ a ∈ s, (⊓) a '' t) = s ⊼ t := Union_image_left _
+lemma Union_image_inf_right : (⋃ b ∈ t, (⊓ b) '' s) = s ⊼ t := Union_image_right _
+
+@[simp] lemma image_inf_prod (s t : set α) : (s ×ˢ t).image (uncurry (⊓)) = s ⊼ t :=
+image_uncurry_prod _ _ _
+
+lemma infs_assoc : (s ⊼ t) ⊼ u = s ⊼ (t ⊼ u) := image2_assoc $ λ _ _ _, inf_assoc
+lemma infs_comm : s ⊼ t = t ⊼ s := image2_comm $ λ _ _, inf_comm
+lemma infs_left_comm : s ⊼ (t ⊼ u) = t ⊼ (s ⊼ u) := image2_left_comm inf_left_comm
+lemma infs_right_comm : (s ⊼ t) ⊼ u = (s ⊼ u) ⊼ t := image2_right_comm inf_right_comm
+lemma infs_infs_infs_comm : (s ⊼ t) ⊼ (u ⊼ v) = (s ⊼ u) ⊼ (t ⊼ v) :=
+image2_image2_image2_comm inf_inf_inf_comm
+
+end infs
+
+open_locale set_family
+
+section distrib_lattice
+variables [distrib_lattice α] (s t u : set α)
+
+lemma sups_infs_subset_left : s ⊻ (t ⊼ u) ⊆ (s ⊻ t) ⊼ (s ⊻ u) :=
+image2_distrib_subset_left $ λ _ _ _, sup_inf_left
+
+lemma sups_infs_subset_right : (t ⊼ u) ⊻ s ⊆ (t ⊻ s) ⊼ (u ⊻ s) :=
+image2_distrib_subset_right $ λ _ _ _, sup_inf_right
+
+lemma infs_sups_subset_left : s ⊼ (t ⊻ u) ⊆ (s ⊼ t) ⊻ (s ⊼ u) :=
+image2_distrib_subset_left $ λ _ _ _, inf_sup_left
+
+lemma infs_sups_subset_right : (t ⊻ u) ⊼ s ⊆ (t ⊼ s) ⊻ (u ⊼ s) :=
+image2_distrib_subset_right $ λ _ _ _, inf_sup_right
+
+end distrib_lattice
+
+end set
+
+open_locale set_family
+
+@[simp] lemma upper_closure_sups [semilattice_sup α] (s t : set α) :
+  upper_closure (s ⊻ t) = upper_closure s ⊔ upper_closure t :=
+begin
+  ext a,
+  simp only [set_like.mem_coe, mem_upper_closure, set.mem_sups, exists_and_distrib_left,
+    exists_prop, upper_set.coe_sup, set.mem_inter_iff],
+  split,
+  { rintro ⟨_, ⟨b, hb, c, hc, rfl⟩, ha⟩,
+    exact ⟨⟨b, hb, le_sup_left.trans ha⟩, c, hc, le_sup_right.trans ha⟩ },
+  { rintro ⟨⟨b, hb, hab⟩, c, hc, hac⟩,
+    exact ⟨_, ⟨b, hb, c, hc, rfl⟩, sup_le hab hac⟩ }
+end
+
+@[simp] lemma lower_closure_infs [semilattice_inf α] (s t : set α) :
+  lower_closure (s ⊼ t) = lower_closure s ⊓ lower_closure t :=
+begin
+  ext a,
+  simp only [set_like.mem_coe, mem_lower_closure, set.mem_infs, exists_and_distrib_left,
+    exists_prop, lower_set.coe_sup, set.mem_inter_iff],
+  split,
+  { rintro ⟨_, ⟨b, hb, c, hc, rfl⟩, ha⟩,
+    exact ⟨⟨b, hb, ha.trans inf_le_left⟩, c, hc, ha.trans inf_le_right⟩ },
+  { rintro ⟨⟨b, hb, hab⟩, c, hc, hac⟩,
+    exact ⟨_, ⟨b, hb, c, hc, rfl⟩, le_inf hab hac⟩ }
+end
diff --git a/src/data/set_like/basic.lean b/src/data/set_like/basic.lean
index 2176811dcb11f..b83d85eaf1033 100644
--- a/src/data/set_like/basic.lean
+++ b/src/data/set_like/basic.lean
@@ -9,6 +9,9 @@ import tactic.monotonicity.basic
 /-!
 # Typeclass for types with a set-like extensionality property
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The `has_mem` typeclass is used to let terms of a type have elements.
 Many instances of `has_mem` have a set-like extensionality property:
 things are equal iff they have the same elements.  The `set_like`
@@ -79,6 +82,15 @@ Note: if `set_like.coe` is a projection, implementers should create a simp lemma
 @[simp] lemma mem_carrier {p : my_subobject X} : x ∈ p.carrier ↔ x ∈ (p : set X) := iff.rfl
 ```
 to normalize terms.
+
+If you declare an unbundled subclass of `set_like`, for example:
+```
+class mul_mem_class (S : Type*) (M : Type*) [has_mul M] [set_like S M] where
+  ...
+```
+Then you should *not* repeat the `out_param` declaration, `set_like` will supply the value instead.
+This ensures in Lean 4 your subclass will not have issues with synthesis of the `[has_mul M]`
+parameter starting before the value of `M` is known.
 -/
 @[protect_proj]
 class set_like (A : Type*) (B : out_param $ Type*) :=
diff --git a/src/data/set_like/fintype.lean b/src/data/set_like/fintype.lean
index 1909ca5648ff7..d1bb48f11a783 100644
--- a/src/data/set_like/fintype.lean
+++ b/src/data/set_like/fintype.lean
@@ -4,10 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
 import data.set_like.basic
-import data.fintype.basic
+import data.fintype.powerset
 /-!
 # Set-like fintype
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains a fintype instance for set-like objects such as subgroups. If `set_like A B`
 and `fintype B` then `fintype A`.
 -/
@@ -20,4 +23,8 @@ set_like objects. If we add those instances, we should remove this one. -/
 noncomputable instance {A B : Type*} [fintype B] [set_like A B] : fintype A :=
 fintype.of_injective coe set_like.coe_injective
 
+@[nolint dangerous_instance, priority 100] -- See note [lower instance priority]
+instance {A B : Type*} [finite B] [set_like A B] : finite A :=
+finite.of_injective coe set_like.coe_injective
+
 end set_like
diff --git a/src/data/setoid/basic.lean b/src/data/setoid/basic.lean
index f8e8c56b9a906..4e69c1aae666e 100644
--- a/src/data/setoid/basic.lean
+++ b/src/data/setoid/basic.lean
@@ -9,6 +9,9 @@ import order.galois_connection
 /-!
 # Equivalence relations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the complete lattice of equivalence relations on a type, results about the
 inductively defined equivalence closure of a binary relation, and the analogues of some isomorphism
 theorems for quotients of arbitrary types.
diff --git a/src/data/setoid/partition.lean b/src/data/setoid/partition.lean
index 8cf099452e55e..28919db4afddb 100644
--- a/src/data/setoid/partition.lean
+++ b/src/data/setoid/partition.lean
@@ -12,6 +12,9 @@ import order.partition.finpartition
 /-!
 # Equivalence relations: partitions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file comprises properties of equivalence relations viewed as partitions.
 There are two implementations of partitions here:
 * A collection `c : set (set α)` of sets is a partition of `α` if `∅ ∉ c` and each element `a : α`
@@ -67,9 +70,9 @@ lemma classes_ker_subset_fiber_set {β : Type*} (f : α → β) :
   (setoid.ker f).classes ⊆ set.range (λ y, {x | f x = y}) :=
 by { rintro s ⟨x, rfl⟩, rw set.mem_range, exact ⟨f x, rfl⟩ }
 
-lemma nonempty_fintype_classes_ker {α β : Type*} [fintype β] (f : α → β) :
-  nonempty (fintype (setoid.ker f).classes) :=
-by { classical, exact ⟨set.fintype_subset _ (classes_ker_subset_fiber_set f)⟩ }
+lemma finite_classes_ker {α β : Type*} [finite β] (f : α → β) :
+  (setoid.ker f).classes.finite :=
+(set.finite_range _).subset $ classes_ker_subset_fiber_set f
 
 lemma card_classes_ker_le {α β : Type*} [fintype β]
   (f : α → β) [fintype (setoid.ker f).classes] :
@@ -170,7 +173,7 @@ def is_partition (c : set (set α)) :=
 /-- A partition of `α` does not contain the empty set. -/
 lemma nonempty_of_mem_partition {c : set (set α)} (hc : is_partition c) {s} (h : s ∈ c) :
   s.nonempty :=
-set.ne_empty_iff_nonempty.1 $ λ hs0, hc.1 $ hs0 ▸ h
+set.nonempty_iff_ne_empty.2 $ λ hs0, hc.1 $ hs0 ▸ h
 
 lemma is_partition_classes (r : setoid α) : is_partition r.classes :=
 ⟨empty_not_mem_classes, classes_eqv_classes⟩
@@ -275,7 +278,7 @@ structure indexed_partition {ι α : Type*} (s : ι → set α) :=
 noncomputable
 def indexed_partition.mk' {ι α : Type*} (s : ι → set α) (dis : ∀ i j, i ≠ j → disjoint (s i) (s j))
   (nonempty : ∀ i, (s i).nonempty) (ex : ∀ x, ∃ i, x ∈ s i) : indexed_partition s :=
-{ eq_of_mem := λ x i j hxi hxj, classical.by_contradiction $ λ h, dis _ _ h ⟨hxi, hxj⟩,
+{ eq_of_mem := λ x i j hxi hxj, classical.by_contradiction $ λ h, (dis _ _ h).le_bot ⟨hxi, hxj⟩,
   some := λ i, (nonempty i).some,
   some_mem := λ i, (nonempty i).some_spec,
   index := λ x, (ex x).some,
@@ -291,9 +294,9 @@ variables {ι α : Type*} {s : ι → set α} (hs : indexed_partition s)
 instance [unique ι] [inhabited α] :
   inhabited (indexed_partition (λ i : ι, (set.univ : set α))) :=
 ⟨{ eq_of_mem := λ x i j hi hj, subsingleton.elim _ _,
-   some := λ i, default,
+   some := default,
    some_mem := set.mem_univ,
-   index := λ a, default,
+   index := default,
    mem_index := set.mem_univ }⟩
 
 attribute [simp] some_mem mem_index
@@ -306,7 +309,7 @@ lemma Union : (⋃ i, s i) = univ :=
 by { ext x, simp [hs.exists_mem x] }
 
 lemma disjoint : ∀ {i j}, i ≠ j → disjoint (s i) (s j) :=
-λ i j h x ⟨hxi, hxj⟩, h (hs.eq_of_mem hxi hxj)
+λ i j h, disjoint_left.mpr $ λ x hxi hxj, h (hs.eq_of_mem hxi hxj)
 
 lemma mem_iff_index_eq {x i} : x ∈ s i ↔ hs.index x = i :=
 ⟨λ hxi, (hs.eq_of_mem hxi (hs.mem_index x)).symm, λ h, h ▸ hs.mem_index _⟩
diff --git a/src/data/sigma/basic.lean b/src/data/sigma/basic.lean
index 0df3a86f44787..33637892d9fc4 100644
--- a/src/data/sigma/basic.lean
+++ b/src/data/sigma/basic.lean
@@ -3,12 +3,17 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
+import meta.univs
 import tactic.lint
 import tactic.ext
+import logic.function.basic
 
 /-!
 # Sigma types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves basic results about sigma types.
 
 A sigma type is a dependent pair type. Like `α × β` but where the type of the second component
@@ -96,21 +101,25 @@ lemma function.injective.sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a
 | ⟨i, x⟩ ⟨j, y⟩ h :=
 begin
   obtain rfl : i = j, from h₁ (sigma.mk.inj_iff.mp h).1,
-  obtain rfl : x = y, from h₂ i (eq_of_heq (sigma.mk.inj_iff.mp h).2),
+  obtain rfl : x = y, from h₂ i (sigma_mk_injective h),
   refl
 end
 
+lemma function.injective.of_sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
+  (h : function.injective (sigma.map f₁ f₂)) (a : α₁) : function.injective (f₂ a) :=
+λ x y hxy, sigma_mk_injective $ @h ⟨a, x⟩ ⟨a, y⟩ (sigma.ext rfl (heq_iff_eq.2 hxy))
+
+lemma function.injective.sigma_map_iff {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
+  (h₁ : function.injective f₁) :
+  function.injective (sigma.map f₁ f₂) ↔ ∀ a, function.injective (f₂ a) :=
+⟨λ h, h.of_sigma_map, h₁.sigma_map⟩
+
 lemma function.surjective.sigma_map {f₁ : α₁ → α₂} {f₂ : Πa, β₁ a → β₂ (f₁ a)}
   (h₁ : function.surjective f₁) (h₂ : ∀ a, function.surjective (f₂ a)) :
   function.surjective (sigma.map f₁ f₂) :=
 begin
-  intros y,
-  cases y with j y,
-  cases h₁ j with i hi,
-  subst j,
-  cases h₂ i y with x hx,
-  subst y,
-  exact ⟨⟨i, x⟩, rfl⟩
+  simp only [function.surjective, sigma.forall, h₁.forall],
+  exact λ i, (h₂ _).forall.2 (λ x, ⟨⟨i, x⟩, rfl⟩)
 end
 
 /-- Interpret a function on `Σ x : α, β x` as a dependent function with two arguments.
@@ -136,17 +145,20 @@ lemma sigma.curry_uncurry {γ : Π a, β a → Type*} (f : Π x (y : β x), γ x
 rfl
 
 /-- Convert a product type to a Σ-type. -/
-@[simp]
-def prod.to_sigma {α β} : α × β → Σ _ : α, β
-| ⟨x,y⟩ := ⟨x,y⟩
+def prod.to_sigma {α β} (p : α × β) : Σ _ : α, β := ⟨p.1, p.2⟩
 
-@[simp]
-lemma prod.fst_to_sigma {α β} (x : α × β) : (prod.to_sigma x).fst = x.fst :=
-by cases x; refl
+@[simp] lemma prod.fst_comp_to_sigma {α β} : sigma.fst ∘ @prod.to_sigma α β = prod.fst := rfl
+@[simp] lemma prod.fst_to_sigma {α β} (x : α × β) : (prod.to_sigma x).fst = x.fst := rfl
+@[simp] lemma prod.snd_to_sigma {α β} (x : α × β) : (prod.to_sigma x).snd = x.snd := rfl
+@[simp] lemma prod.to_sigma_mk {α β} (x : α) (y : β) : (x, y).to_sigma = ⟨x, y⟩ := rfl
 
-@[simp]
-lemma prod.snd_to_sigma {α β} (x : α × β) : (prod.to_sigma x).snd = x.snd :=
-by cases x; refl
+-- we generate this manually as `@[derive has_reflect]` fails
+@[instance]
+protected meta def {u v} sigma.reflect [reflected_univ.{u}] [reflected_univ.{v}]
+  {α : Type u} (β : α → Type v)
+  [reflected _ α] [reflected _ β] [hα : has_reflect α] [hβ : Π i, has_reflect (β i)] :
+  has_reflect (Σ a, β a) :=
+λ ⟨a, b⟩, (by reflect_name : reflected _ @sigma.mk.{u v}).subst₄ `(α) `(β) `(a) `(b)
 
 end sigma
 
@@ -186,6 +198,14 @@ by { cases x₀, cases x₁, cases h₀, cases h₁, refl }
 lemma ext_iff {x₀ x₁ : psigma β} : x₀ = x₁ ↔ x₀.1 = x₁.1 ∧ x₀.2 == x₁.2 :=
 by { cases x₀, cases x₁, exact psigma.mk.inj_iff }
 
+@[simp] theorem «forall» {p : (Σ' a, β a) → Prop} :
+  (∀ x, p x) ↔ (∀ a b, p ⟨a, b⟩) :=
+⟨assume h a b, h ⟨a, b⟩, assume h ⟨a, b⟩, h a b⟩
+
+@[simp] theorem «exists» {p : (Σ' a, β a) → Prop} :
+  (∃ x, p x) ↔ (∃ a b, p ⟨a, b⟩) :=
+⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩
+
 /-- A specialized ext lemma for equality of psigma types over an indexed subtype. -/
 @[ext]
 lemma subtype_ext {β : Sort*} {p : α → β → Prop} :
diff --git a/src/data/sigma/default.lean b/src/data/sigma/default.lean
deleted file mode 100644
index 98ed296c33440..0000000000000
--- a/src/data/sigma/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import data.sigma.basic
diff --git a/src/data/sigma/interval.lean b/src/data/sigma/interval.lean
index 0c70e2cc3b00f..b28ad6a754d30 100644
--- a/src/data/sigma/interval.lean
+++ b/src/data/sigma/interval.lean
@@ -9,6 +9,9 @@ import order.locally_finite
 /-!
 # Finite intervals in a sigma type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides the `locally_finite_order` instance for the disjoint sum of orders `Σ i, α i` and
 calculates the cardinality of its finite intervals.
 
diff --git a/src/data/sigma/lex.lean b/src/data/sigma/lex.lean
index 318941a413379..c6863bd0ad2c2 100644
--- a/src/data/sigma/lex.lean
+++ b/src/data/sigma/lex.lean
@@ -9,6 +9,9 @@ import order.rel_classes
 /-!
 # Lexicographic order on a sigma type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This defines the lexicographical order of two arbitrary relations on a sigma type and proves some
 lemmas about `psigma.lex`, which is defined in core Lean.
 
@@ -23,7 +26,7 @@ Related files are:
 * `data.list.lex`: Lexicographic order on lists.
 * `data.sigma.order`: Lexicographic order on `Σ i, α i` per say.
 * `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
-* `order.lexicographic`: Lexicographic order on `α × β`. Can be thought of as the special case of
+* `data.prod.lex`: Lexicographic order on `α × β`. Can be thought of as the special case of
   `sigma.lex` where all summands are the same
 -/
 
@@ -41,7 +44,7 @@ inductive lex (r : ι → ι → Prop) (s : Π i, α i → α i → Prop) : Π a
 lemma lex_iff : lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s _ (h.rec a.2) b.2 :=
 begin
   split,
-  { rintro (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
+  { rintro (⟨a, b, hij⟩ | ⟨a, b, hab⟩),
     { exact or.inl hij },
     { exact or.inr ⟨rfl, hab⟩ } },
   { obtain ⟨i, a⟩ := a,
@@ -61,7 +64,7 @@ lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ i a b, s₁ i a b
   (h : lex r₁ s₁ a b) :
   lex r₂ s₂ a b :=
 begin
-  obtain (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) := h,
+  obtain (⟨a, b, hij⟩ | ⟨a, b, hab⟩) := h,
   { exact lex.left _ _ (hr _ _ hij) },
   { exact lex.right _ _ (hs _ _ _ hab) }
 end
@@ -74,18 +77,21 @@ lemma lex.mono_right (hs : ∀ i a b, s₁ i a b → s₂ i a b) {a b : Σ i, α
   lex r s₂ a b :=
 h.mono (λ _ _, id) hs
 
+lemma lex_swap : lex r.swap s a b ↔ lex r (λ i, (s i).swap) b a :=
+by split; { rintro (⟨a, b, h⟩ | ⟨a, b, h⟩), exacts [lex.left _ _ h, lex.right _ _ h] }
+
 instance [Π i, is_refl (α i) (s i)] : is_refl _ (lex r s) := ⟨λ ⟨i, a⟩, lex.right _ _ $ refl _⟩
 
 instance [is_irrefl ι r] [Π i, is_irrefl (α i) (s i)] : is_irrefl _ (lex r s) :=
 ⟨begin
-  rintro _ (⟨i, j, a, b, hi⟩ | ⟨i, a, b, ha⟩),
+  rintro _ (⟨a, b, hi⟩ | ⟨a, b, ha⟩),
   { exact irrefl _ hi },
   { exact irrefl _ ha }
 end⟩
 
 instance [is_trans ι r] [Π i, is_trans (α i) (s i)] : is_trans _ (lex r s) :=
 ⟨begin
-  rintro _ _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) (⟨_, k, _, c, hk⟩ | ⟨_, _, c, hc⟩),
+  rintro _ _ _ (⟨a, b, hij⟩ | ⟨a, b, hab⟩) (⟨_, c, hk⟩ | ⟨_, c, hc⟩),
   { exact lex.left _ _ (trans hij hk) },
   { exact lex.left _ _ hij },
   { exact lex.left _ _ hk },
@@ -94,7 +100,7 @@ end⟩
 
 instance [is_symm ι r] [Π i, is_symm (α i) (s i)] : is_symm _ (lex r s) :=
 ⟨begin
-  rintro _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
+  rintro _ _ (⟨a, b, hij⟩ | ⟨a, b, hab⟩),
   { exact lex.left _ _ (symm hij) },
   { exact lex.right _ _ (symm hab) }
 end⟩
@@ -103,7 +109,7 @@ local attribute [instance] is_asymm.is_irrefl
 
 instance [is_asymm ι r] [Π i, is_antisymm (α i) (s i)] : is_antisymm _ (lex r s) :=
 ⟨begin
-  rintro _ _ (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) (⟨_, _, _, _, hji⟩ | ⟨_, _, _, hba⟩),
+  rintro _ _ (⟨a, b, hij⟩ | ⟨a, b, hab⟩) (⟨_, _, hji⟩ | ⟨_, _, hba⟩),
   { exact (asymm hij hji).elim },
   { exact (irrefl _ hij).elim },
   { exact (irrefl _ hji).elim },
@@ -143,7 +149,7 @@ variables {ι : Sort*} {α : ι → Sort*} {r r₁ r₂ : ι → ι → Prop} {s
 lemma lex_iff {a b : Σ' i, α i} : lex r s a b ↔ r a.1 b.1 ∨ ∃ h : a.1 = b.1, s _ (h.rec a.2) b.2 :=
 begin
   split,
-  { rintro (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩),
+  { rintro (⟨a, b, hij⟩ | ⟨i, hab⟩),
     { exact or.inl hij },
     { exact or.inr ⟨rfl, hab⟩ } },
   { obtain ⟨i, a⟩ := a,
@@ -164,7 +170,7 @@ lemma lex.mono {r₁ r₂ : ι → ι → Prop} {s₁ s₂ : Π i, α i → α i
   (h : lex r₁ s₁ a b) :
   lex r₂ s₂ a b :=
 begin
-  obtain (⟨i, j, a, b, hij⟩ | ⟨i, a, b, hab⟩) := h,
+  obtain (⟨a, b, hij⟩ | ⟨i, hab⟩) := h,
   { exact lex.left _ _ (hr _ _ hij) },
   { exact lex.right _ (hs _ _ _ hab) }
 end
diff --git a/src/data/sigma/order.lean b/src/data/sigma/order.lean
index bf30be59b47ed..c30c4b0dac88e 100644
--- a/src/data/sigma/order.lean
+++ b/src/data/sigma/order.lean
@@ -5,11 +5,13 @@ Authors: Yaël Dillies
 -/
 import data.sigma.lex
 import order.bounded_order
-import order.lexicographic
 
 /-!
 # Orders on a sigma type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines two orders on a sigma type:
 * The disjoint sum of orders. `a` is less `b` iff `a` and `b` are in the same summand and `a` is
   less than `b` there.
@@ -28,14 +30,12 @@ type synonym.
 Related files are:
 * `data.finset.colex`: Colexicographic order on finite sets.
 * `data.list.lex`: Lexicographic order on lists.
+* `data.pi.lex`: Lexicographic order on `Πₗ i, α i`.
 * `data.psigma.order`: Lexicographic order on `Σₗ' i, α i`. Basically a twin of this file.
-* `order.lexicographic`: Lexicographic order on `α × β`.
+* `data.prod.lex`: Lexicographic order on `α × β`.
 
 ## TODO
 
-Prove that a sigma type is a `no_max_order`, `no_min_order`, `densely_ordered` when its summands
-are.
-
 Upgrade `equiv.sigma_congr_left`, `equiv.sigma_congr`, `equiv.sigma_assoc`,
 `equiv.sigma_prod_of_equiv`, `equiv.sigma_equiv_prod`, ... to order isomorphisms.
 -/
@@ -110,6 +110,13 @@ instance [Π i, partial_order (α i)] : partial_order (Σ i, α i) :=
   end,
   .. sigma.preorder }
 
+instance [Π i, preorder (α i)] [Π i, densely_ordered (α i)] : densely_ordered (Σ i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨_, _⟩ ⟨_, _, b, h⟩,
+  obtain ⟨c, ha, hb⟩ := exists_between h,
+  exact ⟨⟨i, c⟩, lt.fiber i a c ha, lt.fiber i c b hb⟩,
+end⟩
+
 /-! ### Lexicographical order on `sigma` -/
 
 namespace lex
@@ -122,19 +129,25 @@ instance has_le [has_lt ι] [Π i, has_le (α i)] : has_le (Σₗ i, α i) := 
 /-- The lexicographical `<` on a sigma type. -/
 instance has_lt [has_lt ι] [Π i, has_lt (α i)] : has_lt (Σₗ i, α i) := ⟨lex (<) (λ i, (<))⟩
 
+lemma le_def [has_lt ι] [Π i, has_le (α i)] {a b : Σₗ i, α i} :
+  a ≤ b ↔ a.1 < b.1 ∨ ∃ (h : a.1 = b.1), h.rec a.2 ≤ b.2 := sigma.lex_iff
+
+lemma lt_def [has_lt ι] [Π i, has_lt (α i)] {a b : Σₗ i, α i} :
+  a < b ↔ a.1 < b.1 ∨ ∃ (h : a.1 = b.1), h.rec a.2 < b.2 := sigma.lex_iff
+
 /-- The lexicographical preorder on a sigma type. -/
 instance preorder [preorder ι] [Π i, preorder (α i)] : preorder (Σₗ i, α i) :=
 { le_refl := λ ⟨i, a⟩, lex.right a a le_rfl,
   le_trans := λ _ _ _, trans_of (lex (<) $ λ _, (≤)),
   lt_iff_le_not_le := begin
     refine λ a b, ⟨λ hab, ⟨hab.mono_right (λ i a b, le_of_lt), _⟩, _⟩,
-    { rintro (⟨j, i, b, a, hji⟩ | ⟨i, b, a, hba⟩);
-        obtain (⟨_, _, _, _, hij⟩ | ⟨_, _, _, hab⟩) := hab,
+    { rintro (⟨b, a, hji⟩ | ⟨b, a, hba⟩);
+        obtain (⟨_, _, hij⟩ | ⟨_, _, hab⟩) := hab,
       { exact hij.not_lt hji },
       { exact lt_irrefl _ hji },
       { exact lt_irrefl _ hij },
       { exact hab.not_le hba } },
-    { rintro ⟨⟨i, j, a, b, hij⟩ |⟨i, a, b, hab⟩, hba⟩,
+    { rintro ⟨⟨a, b, hij⟩ | ⟨a, b, hab⟩, hba⟩,
       { exact lex.left _ _ hij },
       { exact lex.right _ _ (hab.lt_of_not_le $ λ h, hba $ lex.right _ _ h) } }
   end,
@@ -181,5 +194,67 @@ instance bounded_order [partial_order ι] [bounded_order ι] [Π i, preorder (α
   bounded_order (Σₗ i, α i) :=
 { .. lex.order_bot, .. lex.order_top }
 
+instance densely_ordered [preorder ι] [densely_ordered ι] [Π i, nonempty (α i)]
+  [Π i, preorder (α i)] [Π i, densely_ordered (α i)] :
+  densely_ordered (Σₗ i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩),
+  { obtain ⟨k, hi, hj⟩ := exists_between h,
+    obtain ⟨c⟩ : nonempty (α k) := infer_instance,
+    exact ⟨⟨k, c⟩, left _ _ hi, left _ _ hj⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h,
+    exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩ }
+end⟩
+
+instance densely_ordered_of_no_max_order [preorder ι] [Π i, preorder (α i)]
+  [Π i, densely_ordered (α i)] [Π i, no_max_order (α i)] :
+  densely_ordered (Σₗ i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩),
+  { obtain ⟨c, ha⟩ := exists_gt a,
+    exact ⟨⟨i, c⟩, right _ _ ha, left _ _ h⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h,
+    exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩ }
+end⟩
+
+instance densely_ordered_of_no_min_order [preorder ι] [Π i, preorder (α i)]
+  [Π i, densely_ordered (α i)] [Π i, no_min_order (α i)] :
+  densely_ordered (Σₗ i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩ ⟨j, b⟩ (⟨_, _, h⟩ | ⟨_, b, h⟩),
+  { obtain ⟨c, hb⟩ := exists_lt b,
+    exact ⟨⟨j, c⟩, left _ _ h, right _ _ hb⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h,
+    exact ⟨⟨i, c⟩, right _ _ ha, right _ _ hb⟩ }
+end⟩
+
+instance no_max_order_of_nonempty [preorder ι] [Π i, preorder (α i)] [no_max_order ι]
+  [Π i, nonempty (α i)] :
+  no_max_order (Σₗ i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩,
+  obtain ⟨j, h⟩ := exists_gt i,
+  obtain ⟨b⟩ : nonempty (α j) := infer_instance,
+  exact ⟨⟨j, b⟩, left _ _ h⟩
+end⟩
+
+instance no_min_order_of_nonempty [preorder ι] [Π i, preorder (α i)] [no_max_order ι]
+  [Π i, nonempty (α i)] :
+  no_max_order (Σₗ i, α i) :=
+⟨begin
+  rintro ⟨i, a⟩,
+  obtain ⟨j, h⟩ := exists_gt i,
+  obtain ⟨b⟩ : nonempty (α j) := infer_instance,
+  exact ⟨⟨j, b⟩, left _ _ h⟩
+end⟩
+
+instance no_max_order [preorder ι] [Π i, preorder (α i)] [Π i, no_max_order (α i)] :
+  no_max_order (Σₗ i, α i) :=
+⟨by { rintro ⟨i, a⟩, obtain ⟨b, h⟩ := exists_gt a, exact ⟨⟨i, b⟩, right _ _ h⟩ }⟩
+
+instance no_min_order [preorder ι] [Π i, preorder (α i)] [Π i, no_min_order (α i)] :
+  no_min_order (Σₗ i, α i) :=
+⟨by { rintro ⟨i, a⟩, obtain ⟨b, h⟩ := exists_lt a, exact ⟨⟨i, b⟩, right _ _ h⟩ }⟩
+
 end lex
 end sigma
diff --git a/src/data/sign.lean b/src/data/sign.lean
index e170570845907..9420ce687e910 100644
--- a/src/data/sign.lean
+++ b/src/data/sign.lean
@@ -3,13 +3,17 @@ Copyright (c) 2022 Eric Rodriguez. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Rodriguez
 -/
-import order.basic
-import algebra.algebra.basic
+import algebra.big_operators.order
+import data.fintype.big_operators
+import data.int.lemmas
 import tactic.derive_fintype
 
 /-!
 # Sign function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the sign function for types with zero and a decidable less-than relation, and
 proves some basic theorems about it.
 -/
@@ -35,15 +39,12 @@ end⟩
 @[simp] lemma neg_eq_neg_one : neg = -1 := rfl
 @[simp] lemma pos_eq_one     : pos = 1  := rfl
 
-/-- The multiplication on `sign_type`. -/
-def mul : sign_type → sign_type → sign_type
-| neg neg  := pos
-| neg zero := zero
-| neg pos  := neg
-| zero _   := zero
-| pos h    := h
-
-instance : has_mul sign_type := ⟨mul⟩
+instance : has_mul sign_type :=
+⟨λ x y, match x with
+| neg  := -y
+| zero := zero
+| pos  := y
+end⟩
 
 /-- The less-than relation on signs. -/
 inductive le : sign_type → sign_type → Prop
@@ -81,6 +82,12 @@ instance : linear_order sign_type :=
   le_trans     := λ a b c hab hbc, by casesm* _; constructor,
   decidable_le := le.decidable_rel }
 
+instance : bounded_order sign_type :=
+{ top := 1,
+  le_top := le.of_pos,
+  bot := -1,
+  bot_le := le.of_neg }
+
 instance : has_distrib_neg sign_type :=
 { neg_neg := λ x, by cases x; refl,
   neg_mul := λ x y, by casesm* _; refl,
@@ -105,6 +112,44 @@ def fin3_equiv : sign_type ≃* fin 3 :=
   end,
   map_mul' := λ x y, by casesm* _; refl }
 
+section case_bashing
+
+lemma nonneg_iff {a : sign_type} : 0 ≤ a ↔ a = 0 ∨ a = 1 := by dec_trivial!
+
+lemma nonneg_iff_ne_neg_one {a : sign_type} : 0 ≤ a ↔ a ≠ -1 := by dec_trivial!
+
+lemma neg_one_lt_iff {a : sign_type} : -1 < a ↔ 0 ≤ a := by dec_trivial!
+
+lemma nonpos_iff {a : sign_type} : a ≤ 0 ↔ a = -1 ∨ a = 0 := by dec_trivial!
+
+lemma nonpos_iff_ne_one {a : sign_type} : a ≤ 0 ↔ a ≠ 1 := by dec_trivial!
+
+lemma lt_one_iff {a : sign_type} : a < 1 ↔ a ≤ 0 := by dec_trivial!
+
+@[simp] lemma neg_iff {a : sign_type} : a < 0 ↔ a = -1 := by dec_trivial!
+
+@[simp] lemma le_neg_one_iff {a : sign_type} : a ≤ -1 ↔ a = -1 := le_bot_iff
+
+@[simp] lemma pos_iff {a : sign_type} : 0 < a ↔ a = 1 := by dec_trivial!
+
+@[simp] lemma one_le_iff {a : sign_type} : 1 ≤ a ↔ a = 1 := top_le_iff
+
+@[simp] lemma neg_one_le (a : sign_type) : -1 ≤ a := bot_le
+
+@[simp] lemma le_one (a : sign_type) : a ≤ 1 := le_top
+
+@[simp] lemma not_lt_neg_one (a : sign_type) : ¬ a < -1 := not_lt_bot
+
+@[simp] lemma not_one_lt (a : sign_type) : ¬ 1 < a := not_top_lt
+
+@[simp] lemma self_eq_neg_iff (a : sign_type) : a = -a ↔ a = 0 := by dec_trivial!
+
+@[simp] lemma neg_eq_self_iff (a : sign_type) : -a = a ↔ a = 0 := by dec_trivial!
+
+@[simp] lemma neg_one_lt_one : (-1 : sign_type) < 1 := bot_lt_top
+
+end case_bashing
+
 section cast
 
 variables {α : Type*} [has_zero α] [has_one α] [has_neg α]
@@ -133,6 +178,13 @@ end cast
   map_one'  := rfl,
   map_mul'  := λ x y, by cases x; cases y; simp }
 
+lemma range_eq {α} (f : sign_type → α) : set.range f = {f zero, f neg, f pos} :=
+begin
+  classical,
+  simpa only [← finset.coe_singleton, ← finset.image_singleton,
+    ← fintype.coe_image_univ, finset.coe_image, ← set.image_insert_eq],
+end
+
 end sign_type
 
 variables {α : Type*}
@@ -160,6 +212,25 @@ lemma sign_apply : sign a = ite (0 < a) 1 (ite (a < 0) (-1) 0) := rfl
 @[simp] lemma sign_pos (ha : 0 < a) : sign a = 1 := by rwa [sign_apply, if_pos]
 @[simp] lemma sign_neg (ha : a < 0) : sign a = -1 := by rwa [sign_apply, if_neg $ asymm ha, if_pos]
 
+lemma sign_eq_one_iff : sign a = 1 ↔ 0 < a :=
+begin
+  refine ⟨λ h, _, λ h, sign_pos h⟩,
+  by_contra hn,
+  rw [sign_apply, if_neg hn] at h,
+  split_ifs at h;
+    simpa using h
+end
+
+lemma sign_eq_neg_one_iff : sign a = -1 ↔ a < 0 :=
+begin
+  refine ⟨λ h, _, λ h, sign_neg h⟩,
+  rw sign_apply at h,
+  split_ifs at h,
+  { simpa using h },
+  { exact h_2 },
+  { simpa using h }
+end
+
 end preorder
 
 section linear_order
@@ -177,8 +248,33 @@ end
 lemma sign_ne_zero : sign a ≠ 0 ↔ a ≠ 0 :=
 sign_eq_zero_iff.not
 
+@[simp] lemma sign_nonneg_iff : 0 ≤ sign a ↔ 0 ≤ a :=
+begin
+  rcases lt_trichotomy 0 a with (h|rfl|h),
+  { simp [h, h.le] },
+  { simp },
+  { simpa [h, h.not_le] }
+end
+
+@[simp] lemma sign_nonpos_iff : sign a ≤ 0 ↔ a ≤ 0 :=
+begin
+  rcases lt_trichotomy 0 a with (h|rfl|h),
+  { simp [h, h.not_le] },
+  { simp },
+  { simp [h, h.le] }
+end
+
 end linear_order
 
+section ordered_semiring
+
+variables [ordered_semiring α] [decidable_rel ((<) : α → α → Prop)] [nontrivial α]
+
+@[simp] lemma sign_one : sign (1 : α) = 1 :=
+sign_pos zero_lt_one
+
+end ordered_semiring
+
 section linear_ordered_ring
 
 variables [linear_ordered_ring α] {a b : α}
@@ -187,6 +283,14 @@ variables [linear_ordered_ring α] {a b : α}
 113488-general/topic/type.20class.20inference.20issues/near/276937942 -/
 local attribute [instance] linear_ordered_ring.decidable_lt
 
+lemma sign_mul (x y : α) : sign (x * y) = sign x * sign y :=
+begin
+  rcases lt_trichotomy x 0 with hx | hx | hx; rcases lt_trichotomy y 0 with hy | hy | hy;
+    simp only [sign_zero, mul_zero, zero_mul, sign_pos, sign_neg, hx, hy, mul_one, neg_one_mul,
+               neg_neg, one_mul, mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, neg_zero,
+               mul_neg_of_pos_of_neg, mul_pos]
+end
+
 /-- `sign` as a `monoid_with_zero_hom` for a nontrivial ordered semiring. Note that linearity
 is required; consider ℂ with the order `z ≤ w` iff they have the same imaginary part and
 `z - w ≤ 0` in the reals; then `1 + i` and `1 - i` are incomparable to zero, and thus we have:
@@ -194,11 +298,115 @@ is required; consider ℂ with the order `z ≤ w` iff they have the same imagin
 def sign_hom : α →*₀ sign_type :=
 { to_fun := sign,
   map_zero' := sign_zero,
-  map_one' := sign_pos zero_lt_one,
-  map_mul' := λ x y, by
-    rcases lt_trichotomy x 0 with hx | hx | hx; rcases lt_trichotomy y 0 with hy | hy | hy;
-    simp only [sign_zero, mul_zero, zero_mul, sign_pos, sign_neg, hx, hy, mul_one, neg_one_mul,
-               neg_neg, one_mul, mul_pos_of_neg_of_neg, mul_neg_of_neg_of_pos, neg_zero',
-               mul_neg_of_pos_of_neg, mul_pos] }
+  map_one' := sign_one,
+  map_mul' := sign_mul }
+
+lemma sign_pow (x : α) (n : ℕ) : sign (x ^ n) = (sign x) ^ n :=
+begin
+  change sign_hom (x ^ n) = (sign_hom x) ^ n,
+  exact map_pow _ _ _
+end
 
 end linear_ordered_ring
+
+section add_group
+
+variables [add_group α] [preorder α] [decidable_rel ((<) : α → α → Prop)]
+
+lemma left.sign_neg [covariant_class α α (+) (<)] (a : α) : sign (-a) = - sign a :=
+begin
+  simp_rw [sign_apply, left.neg_pos_iff, left.neg_neg_iff],
+  split_ifs with h h',
+  { exact false.elim (lt_asymm h h') },
+  { simp },
+  { simp },
+  { simp }
+end
+
+lemma right.sign_neg [covariant_class α α (function.swap (+)) (<)] (a : α) : sign (-a) = - sign a :=
+begin
+  simp_rw [sign_apply, right.neg_pos_iff, right.neg_neg_iff],
+  split_ifs with h h',
+  { exact false.elim (lt_asymm h h') },
+  { simp },
+  { simp },
+  { simp }
+end
+
+end add_group
+
+section linear_ordered_add_comm_group
+
+open_locale big_operators
+
+variables [linear_ordered_add_comm_group α]
+
+/- I'm not sure why this is necessary, see
+https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Decidable.20vs.20decidable_rel -/
+local attribute [instance] linear_ordered_add_comm_group.decidable_lt
+
+lemma sign_sum {ι : Type*} {s : finset ι} {f : ι → α} (hs : s.nonempty) (t : sign_type)
+  (h : ∀ i ∈ s, sign (f i) = t) : sign (∑ i in s, f i) = t :=
+begin
+  cases t,
+  { simp_rw [zero_eq_zero, sign_eq_zero_iff] at ⊢ h,
+    exact finset.sum_eq_zero h },
+  { simp_rw [neg_eq_neg_one, sign_eq_neg_one_iff] at ⊢ h,
+    exact finset.sum_neg h hs },
+  { simp_rw [pos_eq_one, sign_eq_one_iff] at ⊢ h,
+    exact finset.sum_pos h hs }
+end
+
+end linear_ordered_add_comm_group
+
+namespace int
+
+lemma sign_eq_sign (n : ℤ) : n.sign = _root_.sign n :=
+begin
+  obtain ((_ | _) | _) := n,
+  { exact congr_arg coe sign_zero.symm },
+  { exact congr_arg coe (sign_pos $ int.succ_coe_nat_pos _).symm },
+  { exact congr_arg coe (_root_.sign_neg $ neg_succ_lt_zero _).symm }
+end
+end int
+
+open finset nat
+open_locale big_operators
+
+private lemma exists_signed_sum_aux [decidable_eq α] (s : finset α) (f : α → ℤ) :
+  ∃ (β : Type u_1) (t : finset β) (sgn : β → sign_type) (g : β → α), (∀ b, g b ∈ s) ∧
+    t.card = ∑ a in s, (f a).nat_abs ∧
+    ∀ a ∈ s, (∑ b in t, if g b = a then (sgn b : ℤ) else 0) = f a :=
+begin
+  refine ⟨Σ a : {x // x ∈ s}, ℕ, finset.univ.sigma (λ a, range (f a).nat_abs), λ a, sign (f a.1),
+    λ a, a.1, λ a, a.1.prop, _, _⟩,
+  { simp [@sum_attach _ _ _ _ (λ a, (f a).nat_abs)] },
+  { intros x hx,
+    simp [sum_sigma, hx, ← int.sign_eq_sign, int.sign_mul_abs, mul_comm (|f _|),
+      @sum_attach _ _ _ _ (λ a, ∑ j in range (f a).nat_abs, if a = x then (f a).sign else 0)] }
+end
+
+/-- We can decompose a sum of absolute value `n` into a sum of `n` signs. -/
+lemma exists_signed_sum [decidable_eq α] (s : finset α) (f : α → ℤ) :
+  ∃ (β : Type u_1) (_ : fintype β) (sgn : β → sign_type) (g : β → α), by exactI (∀ b, g b ∈ s) ∧
+    fintype.card β = ∑ a in s, (f a).nat_abs ∧
+    ∀ a ∈ s, (∑ b, if g b = a then (sgn b : ℤ) else 0) = f a :=
+let ⟨β, t, sgn, g, hg, ht, hf⟩ := exists_signed_sum_aux s f in
+  ⟨t, infer_instance, λ b, sgn b, λ b, g b, λ b, hg b, by simp [ht], λ a ha,
+    (@sum_attach _ _ t _ (λ b, ite (g b = a) (sgn b : ℤ) 0)).trans $ hf _ ha⟩
+
+/-- We can decompose a sum of absolute value less than `n` into a sum of at most `n` signs. -/
+lemma exists_signed_sum' [nonempty α] [decidable_eq α] (s : finset α) (f : α → ℤ) (n : ℕ)
+  (h : ∑ i in s, (f i).nat_abs ≤ n) :
+  ∃ (β : Type u_1) (_ : fintype β) (sgn : β → sign_type) (g : β → α), by exactI
+    (∀ b, g b ∉ s → sgn b = 0) ∧ fintype.card β = n ∧
+    ∀ a ∈ s, (∑ i, if g i = a then (sgn i : ℤ) else 0) = f a :=
+begin
+  obtain ⟨β, _, sgn, g, hg, hβ, hf⟩ := exists_signed_sum s f,
+  resetI,
+  refine ⟨β ⊕ fin (n - ∑ i in s, (f i).nat_abs), infer_instance, sum.elim sgn 0,
+    sum.elim g $ classical.arbitrary _, _, by simp [hβ, h], λ a ha, by simp [hf _ ha]⟩,
+  rintro (b | b) hb,
+  { cases hb (hg _) },
+  { refl }
+end
diff --git a/src/data/stream/defs.lean b/src/data/stream/defs.lean
index 01fc44fde9e39..c106a14be6e23 100644
--- a/src/data/stream/defs.lean
+++ b/src/data/stream/defs.lean
@@ -7,6 +7,9 @@ Authors: Leonardo de Moura
 /-!
 # Definition of `stream` and functions on streams
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A stream `stream α` is an infinite sequence of elements of `α`. One can also think about it as an
 infinite list. In this file we define `stream` and some functions that take and/or return streams.
 -/
@@ -22,14 +25,11 @@ namespace stream
 variables {α : Type u} {β : Type v} {δ : Type w}
 
 /-- Prepend an element to a stream. -/
-def cons (a : α) (s : stream α) : stream α :=
-λ i,
-  match i with
-  | 0      := a
-  | succ n := s n
-  end
+def cons (a : α) (s : stream α) : stream α
+| 0       := a
+| (n + 1) := s n
 
-notation h :: t := cons h t
+notation (name := stream.cons) h :: t := cons h t
 
 /-- Head of a stream: `stream.head s = stream.nth 0 s`. -/
 def head (s : stream α) : α :=
@@ -66,6 +66,9 @@ def map (f : α → β) (s : stream α) : stream β :=
 def zip (f : α → β → δ) (s₁ : stream α) (s₂ : stream β) : stream δ :=
 λ n, f (nth s₁ n) (nth s₂ n)
 
+/-- Enumerate a stream by tagging each element with its index. -/
+def enum (s : stream α) : stream (ℕ × α) := λ n, (n, s.nth n)
+
 /-- The constant stream: `stream.nth n (stream.const a) = a`. -/
 def const (a : α) : stream α :=
 λ n, a
@@ -96,7 +99,7 @@ corec_on (s₁, s₂)
   (λ ⟨s₁, s₂⟩, head s₁)
   (λ ⟨s₁, s₂⟩, (s₂, tail s₁))
 
-infix `⋈`:65 := interleave
+infix ` ⋈ `:65 := interleave
 
 /-- Elements of a stream with even indices. -/
 def even (s : stream α) : stream α :=
@@ -114,7 +117,7 @@ def append_stream : list α → stream α → stream α
 | []              s := s
 | (list.cons a l) s := a :: append_stream l s
 
-infix `++ₛ`:65 := append_stream
+infix ` ++ₛ `:65 := append_stream
 
 /-- `take n s` returns a list of the `n` first elements of stream `s` -/
 def take : ℕ → stream α → list α
@@ -157,7 +160,7 @@ const a
 def apply (f : stream (α → β)) (s : stream α) : stream β :=
 λ n, (nth f n) (nth s n)
 
-infix `⊛`:75 := apply  -- input as \o*
+infix ` ⊛ `:75 := apply  -- input as \o*
 
 /-- The stream of natural numbers: `stream.nth n stream.nats = n`. -/
 def nats : stream nat :=
diff --git a/src/data/stream/init.lean b/src/data/stream/init.lean
index 867b2a3c97cf6..30c26cbdcd95b 100644
--- a/src/data/stream/init.lean
+++ b/src/data/stream/init.lean
@@ -5,10 +5,14 @@ Authors: Leonardo de Moura
 -/
 import data.stream.defs
 import tactic.ext
+import logic.function.basic
 
 /-!
 # Streams a.k.a. infinite lists a.k.a. infinite sequences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file used to be in the core library. It was moved to `mathlib` and renamed to `init` to avoid
 name clashes.  -/
 
@@ -25,7 +29,7 @@ instance {α} [inhabited α] : inhabited (stream α) :=
 protected theorem eta (s : stream α) : head s :: tail s = s :=
 funext (λ i, begin cases i; refl end)
 
-theorem nth_zero_cons (a : α) (s : stream α) : nth (a :: s) 0 = a := rfl
+@[simp] theorem nth_zero_cons (a : α) (s : stream α) : nth (a :: s) 0 = a := rfl
 
 theorem head_cons (a : α) (s : stream α) : head (a :: s) = a := rfl
 
@@ -43,6 +47,8 @@ funext (λ i, begin unfold drop, rw nat.add_assoc end)
 
 theorem nth_succ (n : nat) (s : stream α) : nth s (succ n) = nth (tail s) n := rfl
 
+@[simp] lemma nth_succ_cons (n : nat) (s : stream α) (x : α) : nth (x :: s) n.succ = nth s n := rfl
+
 theorem drop_succ (n : nat) (s : stream α) : drop (succ n) s = drop n (tail s) := rfl
 
 @[simp] lemma head_drop {α} (a : stream α) (n : ℕ) : (a.drop n).head = a.nth n :=
@@ -51,6 +57,16 @@ by simp only [drop, head, nat.zero_add, stream.nth]
 @[ext] protected theorem ext {s₁ s₂ : stream α} : (∀ n, nth s₁ n = nth s₂ n) → s₁ = s₂ :=
 assume h, funext h
 
+lemma cons_injective2 : function.injective2 (cons : α → stream α → stream α) :=
+λ x y s t h, ⟨by rw [←nth_zero_cons x s, h, nth_zero_cons],
+  stream.ext (λ n, by rw [←nth_succ_cons n _ x, h, nth_succ_cons])⟩
+
+lemma cons_injective_left (s : stream α) : function.injective (λ x, cons x s) :=
+cons_injective2.left _
+
+lemma cons_injective_right (x : α) : function.injective (cons x) :=
+cons_injective2.right _
+
 theorem all_def (p : α → Prop) (s : stream α) : all p s = ∀ n, p (nth s n) := rfl
 
 theorem any_def (p : α → Prop) (s : stream α) : any p s = ∃ n, p (nth s n) := rfl
@@ -125,6 +141,10 @@ theorem zip_eq (s₁ : stream α) (s₂ : stream β) :
   zip f s₁ s₂ = f (head s₁) (head s₂) :: zip f (tail s₁) (tail s₂) :=
 begin rw [← stream.eta (zip f s₁ s₂)], refl end
 
+@[simp] lemma nth_enum (s : stream α) (n : ℕ) : nth (enum s) n = (n, s.nth n) := rfl
+
+lemma enum_eq_zip (s : stream α) : enum s = zip prod.mk nats s := rfl
+
 end zip
 
 theorem mem_const (a : α) : a ∈ const a :=
diff --git a/src/data/string/basic.lean b/src/data/string/basic.lean
index 594a47f40015b..11b9289d66277 100644
--- a/src/data/string/basic.lean
+++ b/src/data/string/basic.lean
@@ -9,6 +9,9 @@ import data.char
 /-!
 # Strings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Supplementary theorems about the `string` type.
 -/
 
diff --git a/src/data/string/defs.lean b/src/data/string/defs.lean
index 5dcca2d98d967..ea5351bf282e7 100644
--- a/src/data/string/defs.lean
+++ b/src/data/string/defs.lean
@@ -8,6 +8,9 @@ import data.list.defs
 /-!
 # Definitions for `string`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a bunch of functions for the `string` datatype.
 -/
 
diff --git a/src/data/subtype.lean b/src/data/subtype.lean
index 7347ff7aa6a5d..10dc89a45d6f0 100644
--- a/src/data/subtype.lean
+++ b/src/data/subtype.lean
@@ -5,12 +5,14 @@ Authors: Johannes Hölzl
 -/
 import logic.function.basic
 import tactic.ext
-import tactic.lint
 import tactic.simps
 
 /-!
 # Subtypes
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides basic API for subtypes, which are defined in core.
 
 A subtype is a type made from restricting another type, say `α`, to its elements that satisfy some
@@ -82,12 +84,15 @@ ext_iff
 
 @[simp] theorem coe_eta (a : {a // p a}) (h : p a) : mk ↑a h = a := subtype.ext rfl
 
-@[simp] theorem coe_mk (a h) : (@mk α p a h : α) = a := rfl
+@[simp, mfld_simps] theorem coe_mk (a h) : (@mk α p a h : α) = a := rfl
 
 @[simp, nolint simp_nf] -- built-in reduction doesn't always work
 theorem mk_eq_mk {a h a' h'} : @mk α p a h = @mk α p a' h' ↔ a = a' :=
 ext_iff
 
+lemma coe_eq_of_eq_mk {a : {a // p a}} {b : α} (h : ↑a = b) :
+  a = ⟨b, h ▸ a.2⟩ := subtype.ext h
+
 theorem coe_eq_iff {a : {a // p a}} {b : α} : ↑a = b ↔ ∃ h, a = ⟨b, h⟩ :=
 ⟨λ h, h ▸ ⟨a.2, (coe_eta _ _).symm⟩, λ ⟨hb, ha⟩, ha.symm ▸ rfl⟩
 
diff --git a/src/data/sum/basic.lean b/src/data/sum/basic.lean
index 5bcda17b5f4ed..bec135e6da38c 100644
--- a/src/data/sum/basic.lean
+++ b/src/data/sum/basic.lean
@@ -3,11 +3,15 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Yury G. Kudryashov
 -/
-import data.option.basic
+import logic.function.basic
+import tactic.basic
 
 /-!
 # Disjoint union of types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves basic results about the sum type `α ⊕ β`.
 
 `α ⊕ β` is the type made of a copy of `α` and a copy of `β`. It is also called *disjoint union*.
@@ -78,33 +82,29 @@ section get
 
 variables {x y : α ⊕ β}
 
-lemma get_left_eq_none_iff : x.get_left = none ↔ x.is_right :=
+@[simp] lemma get_left_eq_none_iff : x.get_left = none ↔ x.is_right :=
 by cases x; simp only [get_left, is_right, coe_sort_tt, coe_sort_ff, eq_self_iff_true]
 
-lemma get_right_eq_none_iff : x.get_right = none ↔ x.is_left :=
+@[simp] lemma get_right_eq_none_iff : x.get_right = none ↔ x.is_left :=
 by cases x; simp only [get_right, is_left, coe_sort_tt, coe_sort_ff, eq_self_iff_true]
 
-end get
+@[simp] lemma get_left_eq_some_iff {a} : x.get_left = some a ↔ x = inl a :=
+by cases x; simp only [get_left]
 
-/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
-protected def map (f : α → α') (g : β → β')  : α ⊕ β → α' ⊕ β'
-| (inl x) := inl (f x)
-| (inr x) := inr (g x)
+@[simp] lemma get_right_eq_some_iff {b} : x.get_right = some b ↔ x = inr b :=
+by cases x; simp only [get_right]
 
-@[simp] lemma map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
-@[simp] lemma map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl
+@[simp] lemma bnot_is_left (x : α ⊕ β) : bnot x.is_left = x.is_right := by cases x; refl
+@[simp] lemma is_left_eq_ff : x.is_left = ff ↔ x.is_right := by cases x; simp
+lemma not_is_left : ¬x.is_left ↔ x.is_right := by simp
+@[simp] lemma bnot_is_right (x : α ⊕ β) : bnot x.is_right = x.is_left := by cases x; refl
+@[simp] lemma is_right_eq_ff : x.is_right = ff ↔ x.is_left := by cases x; simp
+lemma not_is_right : ¬x.is_right ↔ x.is_left := by simp
 
-@[simp] lemma map_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
-  ∀ x : α ⊕ β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
-| (inl a) := rfl
-| (inr b) := rfl
-
-@[simp] lemma map_comp_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
-  (sum.map f' g') ∘ (sum.map f g) = sum.map (f' ∘ f) (g' ∘ g) :=
-funext $ map_map f' g' f g
+lemma is_left_iff : x.is_left ↔ ∃ y, x = sum.inl y := by cases x; simp
+lemma is_right_iff : x.is_right ↔ ∃ y, x = sum.inr y := by cases x; simp
 
-@[simp] lemma map_id_id (α β) : sum.map (@id α) (@id β) = id :=
-funext $ λ x, sum.rec_on x (λ _, rfl) (λ _, rfl)
+end get
 
 theorem inl.inj_iff {a b} : (inl a : α ⊕ β) = inl b ↔ a = b :=
 ⟨inl.inj, congr_arg _⟩
@@ -143,13 +143,48 @@ funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)
   sum.elim (f ∘ inl) (f ∘ inr) = f :=
 funext $ λ x, sum.cases_on x (λ _, rfl) (λ _, rfl)
 
+/-- Map `α ⊕ β` to `α' ⊕ β'` sending `α` to `α'` and `β` to `β'`. -/
+protected def map (f : α → α') (g : β → β') : α ⊕ β → α' ⊕ β' :=
+sum.elim (inl ∘ f) (inr ∘ g)
+
+@[simp] lemma map_inl (f : α → α') (g : β → β') (x : α) : (inl x).map f g = inl (f x) := rfl
+@[simp] lemma map_inr (f : α → α') (g : β → β') (x : β) : (inr x).map f g = inr (g x) := rfl
+
+@[simp] lemma map_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
+  ∀ x : α ⊕ β, (x.map f g).map f' g' = x.map (f' ∘ f) (g' ∘ g)
+| (inl a) := rfl
+| (inr b) := rfl
+
+@[simp] lemma map_comp_map {α'' β''} (f' : α' → α'') (g' : β' → β'') (f : α → α') (g : β → β') :
+  (sum.map f' g') ∘ (sum.map f g) = sum.map (f' ∘ f) (g' ∘ g) :=
+funext $ map_map f' g' f g
+
+@[simp] lemma map_id_id (α β) : sum.map (@id α) (@id β) = id :=
+funext $ λ x, sum.rec_on x (λ _, rfl) (λ _, rfl)
+
+lemma elim_map {α β γ δ ε : Sort*} {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} {x} :
+  sum.elim f₂ g₂ (sum.map f₁ g₁ x) = sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) x :=
+by cases x; refl
+
 lemma elim_comp_map {α β γ δ ε : Sort*} {f₁ : α → β} {f₂ : β → ε} {g₁ : γ → δ} {g₂ : δ → ε} :
   sum.elim f₂ g₂ ∘ sum.map f₁ g₁ = sum.elim (f₂ ∘ f₁) (g₂ ∘ g₁) :=
-begin
-  ext (_|_),
-  { rw [function.comp_app, map_inl, elim_inl, elim_inl] },
-  { rw [function.comp_app, map_inr, elim_inr, elim_inr] },
-end
+funext $ λ _, elim_map
+
+@[simp] lemma is_left_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+  is_left (x.map f g) = is_left x :=
+by cases x; refl
+
+@[simp] lemma is_right_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+  is_right (x.map f g) = is_right x :=
+by cases x; refl
+
+@[simp] lemma get_left_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+  (x.map f g).get_left = x.get_left.map f :=
+by cases x; refl
+
+@[simp] lemma get_right_map (f : α → β) (g : γ → δ) (x : α ⊕ γ) :
+  (x.map f g).get_right = x.get_right.map g :=
+by cases x; refl
 
 open function (update update_eq_iff update_comp_eq_of_injective update_comp_eq_of_forall_ne)
 
@@ -200,14 +235,18 @@ update_comp_eq_of_injective _ inr_injective _ _
 by rw ← update_inr_comp_inr
 
 /-- Swap the factors of a sum type -/
-@[simp] def swap : α ⊕ β → β ⊕ α
-| (inl a) := inr a
-| (inr b) := inl b
+def swap : α ⊕ β → β ⊕ α := sum.elim inr inl
 
+@[simp] lemma swap_inl (x : α) : swap (inl x : α ⊕ β) = inr x := rfl
+@[simp] lemma swap_inr (x : β) : swap (inr x : α ⊕ β) = inl x := rfl
 @[simp] lemma swap_swap (x : α ⊕ β) : swap (swap x) = x := by cases x; refl
 @[simp] lemma swap_swap_eq : swap ∘ swap = @id (α ⊕ β) := funext $ swap_swap
 @[simp] lemma swap_left_inverse : function.left_inverse (@swap α β) swap := swap_swap
 @[simp] lemma swap_right_inverse : function.right_inverse (@swap α β) swap := swap_swap
+@[simp] lemma is_left_swap (x : α ⊕ β) : x.swap.is_left = x.is_right := by cases x; refl
+@[simp] lemma is_right_swap (x : α ⊕ β) : x.swap.is_right = x.is_left := by cases x; refl
+@[simp] lemma get_left_swap (x : α ⊕ β) : x.swap.get_left = x.get_right := by cases x; refl
+@[simp] lemma get_right_swap (x : α ⊕ β) : x.swap.get_right = x.get_left := by cases x; refl
 
 section lift_rel
 
@@ -291,6 +330,8 @@ instance [decidable_rel r] [decidable_rel s] : decidable_rel (lex r s)
 protected lemma lift_rel.lex {a b : α ⊕ β} (h : lift_rel r s a b) : lex r s a b :=
 by { cases h, exacts [lex.inl ‹_›, lex.inr ‹_›] }
 
+lemma lift_rel_subrelation_lex : subrelation (lift_rel r s) (lex r s) := λ a b, lift_rel.lex
+
 lemma lex.mono (hr : ∀ a b, r₁ a b → r₂ a b) (hs : ∀ a b, s₁ a b → s₂ a b) (h : lex r₁ s₁ x y) :
   lex r₂ s₂ x y :=
 by { cases h, exacts [lex.inl (hr _ _ ‹_›), lex.inr (hs _ _ ‹_›), lex.sep _ _] }
@@ -298,7 +339,7 @@ by { cases h, exacts [lex.inl (hr _ _ ‹_›), lex.inr (hs _ _ ‹_›), lex.se
 lemma lex.mono_left (hr : ∀ a b, r₁ a b → r₂ a b) (h : lex r₁ s x y) : lex r₂ s x y :=
 h.mono hr $ λ _ _, id
 
-lemma lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b)  (h : lex r s₁ x y) : lex r s₂ x y :=
+lemma lex.mono_right (hs : ∀ a b, s₁ a b → s₂ a b) (h : lex r s₁ x y) : lex r s₂ x y :=
 h.mono (λ _ _, id) hs
 
 lemma lex_acc_inl {a} (aca : acc r a) : acc (lex r s) (inl a) :=
@@ -347,8 +388,70 @@ lemma surjective.sum_map {f : α → β} {g : α' → β'} (hf : surjective f) (
 | (inl y) := let ⟨x, hx⟩ := hf y in ⟨inl x, congr_arg inl hx⟩
 | (inr y) := let ⟨x, hx⟩ := hg y in ⟨inr x, congr_arg inr hx⟩
 
+lemma bijective.sum_map {f : α → β} {g : α' → β'} (hf : bijective f) (hg : bijective g) :
+  bijective (sum.map f g) :=
+⟨hf.injective.sum_map hg.injective, hf.surjective.sum_map hg.surjective⟩
+
 end function
 
+namespace sum
+open function
+
+@[simp] lemma map_injective {f : α → γ} {g : β → δ} :
+  injective (sum.map f g) ↔ injective f ∧ injective g :=
+⟨λ h, ⟨λ a₁ a₂ ha, inl_injective $ @h (inl a₁) (inl a₂) (congr_arg inl ha : _),
+      λ b₁ b₂ hb, inr_injective $ @h (inr b₁) (inr b₂) (congr_arg inr hb : _)⟩,
+  λ h, h.1.sum_map h.2⟩
+
+@[simp] lemma map_surjective {f : α → γ} {g : β → δ} :
+  surjective (sum.map f g) ↔ surjective f ∧ surjective g :=
+⟨λ h, ⟨λ c, begin
+  obtain ⟨a | b, h⟩ := h (inl c),
+  { exact ⟨a, inl_injective h⟩ },
+  { cases h },
+end, λ d, begin
+  obtain ⟨a | b, h⟩ := h (inr d),
+  { cases h },
+  { exact ⟨b, inr_injective h⟩ },
+end⟩, λ h, h.1.sum_map h.2⟩
+
+@[simp] lemma map_bijective {f : α → γ} {g : β → δ} :
+  bijective (sum.map f g) ↔ bijective f ∧ bijective g :=
+(map_injective.and map_surjective).trans $ and_and_and_comm _ _ _ _
+
+lemma elim_const_const (c : γ) :
+  sum.elim (const _ c : α → γ) (const _ c : β → γ) = const _ c :=
+by { ext x, cases x; refl }
+
+@[simp]
+lemma elim_lam_const_lam_const (c : γ) :
+  sum.elim (λ (_ : α), c) (λ (_ : β), c) = λ _, c :=
+sum.elim_const_const c
+
+lemma elim_update_left [decidable_eq α] [decidable_eq β]
+    (f : α → γ) (g : β → γ) (i : α) (c : γ) :
+  sum.elim (function.update f i c) g = function.update (sum.elim f g) (inl i) c :=
+begin
+  ext x, cases x,
+  { by_cases h : x = i,
+    { subst h, simp },
+    { simp [h] } },
+  { simp }
+end
+
+lemma elim_update_right [decidable_eq α] [decidable_eq β]
+    (f : α → γ) (g : β → γ) (i : β) (c : γ) :
+  sum.elim f (function.update g i c) = function.update (sum.elim f g) (inr i) c :=
+begin
+  ext x, cases x,
+  { simp },
+  { by_cases h : x = i,
+    { subst h, simp },
+    { simp [h] } }
+end
+
+end sum
+
 /-!
 ### Ternary sum
 
diff --git a/src/data/sum/interval.lean b/src/data/sum/interval.lean
index 77e525f926504..e831e4564adfc 100644
--- a/src/data/sum/interval.lean
+++ b/src/data/sum/interval.lean
@@ -3,17 +3,18 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
+import data.finset.sum
 import data.sum.order
 import order.locally_finite
 
 /-!
 # Finite intervals in a disjoint union
 
-This file provides the `locally_finite_order` instance for the disjoint sum of two orders.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-## TODO
-
-Do the same for the lexicographic sum of orders.
+This file provides the `locally_finite_order` instance for the disjoint sum and linear sum of two
+orders and calculates the cardinality of their finite intervals.
 -/
 
 open function sum
@@ -96,6 +97,106 @@ lemma sum_lift₂_mono (h₁ : ∀ a b, f₁ a b ⊆ g₁ a b) (h₂ : ∀ a b,
 | (inr a) (inr b) := map_subset_map.2 (h₂ _ _)
 
 end sum_lift₂
+
+section sum_lex_lift
+variables (f₁ f₁' : α₁ → β₁ → finset γ₁) (f₂ f₂' : α₂ → β₂ → finset γ₂)
+          (g₁ g₁' : α₁ → β₂ → finset γ₁) (g₂ g₂' : α₁ → β₂ → finset γ₂)
+
+/-- Lifts maps `α₁ → β₁ → finset γ₁`, `α₂ → β₂ → finset γ₂`, `α₁ → β₂ → finset γ₁`,
+`α₂ → β₂ → finset γ₂`  to a map `α₁ ⊕ α₂ → β₁ ⊕ β₂ → finset (γ₁ ⊕ γ₂)`. Could be generalized to
+alternative monads if we can make sure to keep computability and universe polymorphism. -/
+def sum_lex_lift : Π (a : α₁ ⊕ α₂) (b : β₁ ⊕ β₂), finset (γ₁ ⊕ γ₂)
+| (inl a) (inl b) := (f₁ a b).map embedding.inl
+| (inl a) (inr b) := (g₁ a b).disj_sum (g₂ a b)
+| (inr a) (inl b) := ∅
+| (inr a) (inr b) := (f₂ a b).map ⟨_, inr_injective⟩
+
+@[simp] lemma sum_lex_lift_inl_inl (a : α₁) (b : β₁) :
+  sum_lex_lift f₁ f₂ g₁ g₂ (inl a) (inl b) = (f₁ a b).map embedding.inl := rfl
+
+@[simp] lemma sum_lex_lift_inl_inr (a : α₁) (b : β₂) :
+  sum_lex_lift f₁ f₂ g₁ g₂ (inl a) (inr b) = (g₁ a b).disj_sum (g₂ a b) := rfl
+
+@[simp] lemma sum_lex_lift_inr_inl (a : α₂) (b : β₁) :
+  sum_lex_lift f₁ f₂ g₁ g₂ (inr a) (inl b) = ∅ := rfl
+
+@[simp] lemma sum_lex_lift_inr_inr (a : α₂) (b : β₂) :
+  sum_lex_lift f₁ f₂ g₁ g₂ (inr a) (inr b) = (f₂ a b).map ⟨_, inr_injective⟩ := rfl
+
+variables {f₁ g₁ f₂ g₂ f₁' g₁' f₂' g₂'} {a : α₁ ⊕ α₂} {b : β₁ ⊕ β₂} {c : γ₁ ⊕ γ₂}
+
+lemma mem_sum_lex_lift :
+  c ∈ sum_lex_lift f₁ f₂ g₁ g₂ a b ↔
+    (∃ a₁ b₁ c₁, a = inl a₁ ∧ b = inl b₁ ∧ c = inl c₁ ∧ c₁ ∈ f₁ a₁ b₁) ∨
+    (∃ a₁ b₂ c₁, a = inl a₁ ∧ b = inr b₂ ∧ c = inl c₁ ∧ c₁ ∈ g₁ a₁ b₂) ∨
+    (∃ a₁ b₂ c₂, a = inl a₁ ∧ b = inr b₂ ∧ c = inr c₂ ∧ c₂ ∈ g₂ a₁ b₂) ∨
+     ∃ a₂ b₂ c₂, a = inr a₂ ∧ b = inr b₂ ∧ c = inr c₂ ∧ c₂ ∈ f₂ a₂ b₂ :=
+begin
+  split,
+  { cases a; cases b,
+    { rw [sum_lex_lift, mem_map],
+      rintro ⟨c, hc, rfl⟩,
+      exact or.inl ⟨a, b, c, rfl, rfl, rfl, hc⟩ },
+    { refine λ h, (mem_disj_sum.1 h).elim _ _,
+      { rintro ⟨c, hc, rfl⟩,
+        refine or.inr (or.inl ⟨a, b, c, rfl, rfl, rfl, hc⟩) },
+      { rintro ⟨c, hc, rfl⟩,
+        refine or.inr (or.inr $ or.inl ⟨a, b, c, rfl, rfl, rfl, hc⟩) } },
+    { refine λ h, (not_mem_empty _ h).elim },
+    { rw [sum_lex_lift, mem_map],
+      rintro ⟨c, hc, rfl⟩,
+      exact or.inr (or.inr $ or.inr $ ⟨a, b, c, rfl, rfl, rfl, hc⟩) } },
+  { rintro (⟨a, b, c, rfl, rfl, rfl, hc⟩ | ⟨a, b, c, rfl, rfl, rfl, hc⟩ |
+      ⟨a, b, c, rfl, rfl, rfl, hc⟩ | ⟨a, b, c, rfl, rfl, rfl, hc⟩),
+    { exact mem_map_of_mem _ hc },
+    { exact inl_mem_disj_sum.2 hc },
+    { exact inr_mem_disj_sum.2 hc },
+    { exact mem_map_of_mem _ hc } }
+end
+
+lemma inl_mem_sum_lex_lift {c₁ : γ₁} :
+  inl c₁ ∈ sum_lex_lift f₁ f₂ g₁ g₂ a b ↔
+    (∃ a₁ b₁, a = inl a₁ ∧ b = inl b₁ ∧ c₁ ∈ f₁ a₁ b₁) ∨
+     ∃ a₁ b₂, a = inl a₁ ∧ b = inr b₂ ∧ c₁ ∈ g₁ a₁ b₂ :=
+by simp [mem_sum_lex_lift]
+
+lemma inr_mem_sum_lex_lift {c₂ : γ₂} :
+  inr c₂ ∈ sum_lex_lift f₁ f₂ g₁ g₂ a b ↔
+    (∃ a₁ b₂, a = inl a₁ ∧ b = inr b₂ ∧ c₂ ∈ g₂ a₁ b₂) ∨
+     ∃ a₂ b₂, a = inr a₂ ∧ b = inr b₂ ∧ c₂ ∈ f₂ a₂ b₂ :=
+by simp [mem_sum_lex_lift]
+
+lemma sum_lex_lift_mono (hf₁ : ∀ a b, f₁ a b ⊆ f₁' a b) (hf₂ : ∀ a b, f₂ a b ⊆ f₂' a b)
+  (hg₁ : ∀ a b, g₁ a b ⊆ g₁' a b) (hg₂ : ∀ a b, g₂ a b ⊆ g₂' a b) (a : α₁ ⊕ α₂) (b : β₁ ⊕ β₂) :
+  sum_lex_lift f₁ f₂ g₁ g₂ a b ⊆ sum_lex_lift f₁' f₂' g₁' g₂' a b :=
+begin
+  cases a; cases b,
+  exacts [map_subset_map.2 (hf₁ _ _), disj_sum_mono (hg₁ _ _) (hg₂ _ _), subset.rfl,
+    map_subset_map.2 (hf₂ _ _)],
+end
+
+lemma sum_lex_lift_eq_empty :
+  (sum_lex_lift f₁ f₂ g₁ g₂ a b) = ∅ ↔ (∀ a₁ b₁, a = inl a₁ → b = inl b₁ → f₁ a₁ b₁ = ∅) ∧
+    (∀ a₁ b₂, a = inl a₁ → b = inr b₂ → g₁ a₁ b₂ = ∅ ∧ g₂ a₁ b₂ = ∅) ∧
+    ∀ a₂ b₂, a = inr a₂ → b = inr b₂ → f₂ a₂ b₂ = ∅ :=
+begin
+  refine ⟨λ h, ⟨_, _, _⟩, λ h, _⟩,
+  any_goals { rintro a b rfl rfl, exact map_eq_empty.1 h },
+  { rintro a b rfl rfl, exact disj_sum_eq_empty.1 h },
+  cases a; cases b,
+  { exact map_eq_empty.2 (h.1 _ _ rfl rfl) },
+  { simp [h.2.1 _ _ rfl rfl] },
+  { refl },
+  { exact map_eq_empty.2 (h.2.2 _ _ rfl rfl) }
+end
+
+lemma sum_lex_lift_nonempty :
+  (sum_lex_lift f₁ f₂ g₁ g₂ a b).nonempty ↔ (∃ a₁ b₁, a = inl a₁ ∧ b = inl b₁ ∧ (f₁ a₁ b₁).nonempty)
+    ∨ (∃ a₁ b₂, a = inl a₁ ∧ b = inr b₂ ∧ ((g₁ a₁ b₂).nonempty ∨ (g₂ a₁ b₂).nonempty))
+    ∨ ∃ a₂ b₂, a = inr a₂ ∧ b = inr b₂ ∧ (f₂ a₂ b₂).nonempty :=
+by simp [nonempty_iff_ne_empty, sum_lex_lift_eq_empty, not_and_distrib]
+
+end sum_lex_lift
 end finset
 
 open finset function
@@ -138,4 +239,84 @@ lemma Ioc_inr_inr : Ioc (inr b₁ : α ⊕ β) (inr b₂) = (Ioc b₁ b₂).map
 lemma Ioo_inr_inr : Ioo (inr b₁ : α ⊕ β) (inr b₂) = (Ioo b₁ b₂).map embedding.inr := rfl
 
 end disjoint
+
+/-! ### Lexicographical sum of orders -/
+
+namespace lex
+variables [preorder α] [preorder β] [order_top α] [order_bot β] [locally_finite_order α]
+  [locally_finite_order β]
+
+/-- Throwaway tactic. -/
+private meta def simp_lex : tactic unit :=
+`[refine to_lex.surjective.forall₃.2 _, rintro (a | a) (b | b) (c | c); simp only
+    [sum_lex_lift_inl_inl, sum_lex_lift_inl_inr, sum_lex_lift_inr_inl, sum_lex_lift_inr_inr,
+    inl_le_inl_iff, inl_le_inr, not_inr_le_inl, inr_le_inr_iff, inl_lt_inl_iff, inl_lt_inr,
+    not_inr_lt_inl, inr_lt_inr_iff, mem_Icc, mem_Ico, mem_Ioc, mem_Ioo, mem_Ici, mem_Ioi, mem_Iic,
+    mem_Iio, equiv.coe_to_embedding, to_lex_inj, exists_false, and_false, false_and, map_empty,
+    not_mem_empty, true_and, inl_mem_disj_sum, inr_mem_disj_sum, and_true, of_lex_to_lex, mem_map,
+    embedding.coe_fn_mk, exists_prop, exists_eq_right, embedding.inl_apply]]
+
+instance locally_finite_order : locally_finite_order (α ⊕ₗ β) :=
+{ finset_Icc := λ a b,
+    (sum_lex_lift Icc Icc (λ a _, Ici a) (λ _, Iic) (of_lex a) (of_lex b)).map to_lex.to_embedding,
+  finset_Ico := λ a b,
+    (sum_lex_lift Ico Ico (λ a _, Ici a) (λ _, Iio) (of_lex a) (of_lex b)).map to_lex.to_embedding,
+  finset_Ioc := λ a b,
+    (sum_lex_lift Ioc Ioc (λ a _, Ioi a) (λ _, Iic) (of_lex a) (of_lex b)).map to_lex.to_embedding,
+  finset_Ioo := λ a b,
+    (sum_lex_lift Ioo Ioo (λ a _, Ioi a) (λ _, Iio) (of_lex a) (of_lex b)).map to_lex.to_embedding,
+  finset_mem_Icc := by simp_lex,
+  finset_mem_Ico := by simp_lex,
+  finset_mem_Ioc := by simp_lex,
+  finset_mem_Ioo := by simp_lex }
+
+variables (a a₁ a₂ : α) (b b₁ b₂ : β)
+
+lemma Icc_inl_inl :
+  Icc (inlₗ a₁ : α ⊕ₗ β) (inlₗ a₂) = (Icc a₁ a₂).map (embedding.inl.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+lemma Ico_inl_inl :
+  Ico (inlₗ a₁ : α ⊕ₗ β) (inlₗ a₂) = (Ico a₁ a₂).map (embedding.inl.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+lemma Ioc_inl_inl :
+  Ioc (inlₗ a₁ : α ⊕ₗ β) (inlₗ a₂) = (Ioc a₁ a₂).map (embedding.inl.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+lemma Ioo_inl_inl :
+  Ioo (inlₗ a₁ : α ⊕ₗ β) (inlₗ a₂) = (Ioo a₁ a₂).map (embedding.inl.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+@[simp] lemma Icc_inl_inr :
+  Icc (inlₗ a) (inrₗ b) = ((Ici a).disj_sum (Iic b)).map to_lex.to_embedding := rfl
+@[simp] lemma Ico_inl_inr :
+  Ico (inlₗ a) (inrₗ b) = ((Ici a).disj_sum (Iio b)).map to_lex.to_embedding := rfl
+@[simp] lemma Ioc_inl_inr :
+  Ioc (inlₗ a) (inrₗ b) = ((Ioi a).disj_sum (Iic b)).map to_lex.to_embedding := rfl
+@[simp] lemma Ioo_inl_inr :
+  Ioo (inlₗ a) (inrₗ b) = ((Ioi a).disj_sum (Iio b)).map to_lex.to_embedding := rfl
+
+@[simp] lemma Icc_inr_inl : Icc (inrₗ b) (inlₗ a) = ∅ := rfl
+@[simp] lemma Ico_inr_inl : Ico (inrₗ b) (inlₗ a) = ∅ := rfl
+@[simp] lemma Ioc_inr_inl : Ioc (inrₗ b) (inlₗ a) = ∅ := rfl
+@[simp] lemma Ioo_inr_inl : Ioo (inrₗ b) (inlₗ a) = ∅ := rfl
+
+lemma Icc_inr_inr :
+  Icc (inrₗ b₁ : α ⊕ₗ β) (inrₗ b₂) = (Icc b₁ b₂).map (embedding.inr.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+lemma Ico_inr_inr :
+  Ico (inrₗ b₁ : α ⊕ₗ β) (inrₗ b₂) = (Ico b₁ b₂).map (embedding.inr.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+lemma Ioc_inr_inr :
+  Ioc (inrₗ b₁ : α ⊕ₗ β) (inrₗ b₂) = (Ioc b₁ b₂).map (embedding.inr.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+lemma Ioo_inr_inr :
+  Ioo (inrₗ b₁ : α ⊕ₗ β) (inrₗ b₂) = (Ioo b₁ b₂).map (embedding.inr.trans to_lex.to_embedding) :=
+by { rw ←finset.map_map, refl }
+
+end lex
 end sum
diff --git a/src/data/sum/order.lean b/src/data/sum/order.lean
index c6324afa960ac..c0c1601566d8f 100644
--- a/src/data/sum/order.lean
+++ b/src/data/sum/order.lean
@@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import order.hom.basic
-import order.lexicographic
 
 /-!
 # Orders on a sum type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the disjoint sum and the linear (aka lexicographic) sum of two orders and provides
 relation instances for `sum.lift_rel` and `sum.lex`.
 
@@ -25,9 +27,10 @@ type synonym.
 * `α ⊕ₗ β`:  The linear sum of `α` and `β`.
 -/
 
-namespace sum
 variables {α β γ δ : Type*}
 
+namespace sum
+
 /-! ### Unbundled relation classes -/
 
 section lift_rel
@@ -40,7 +43,7 @@ variables (r : α → α → Prop) (s : β → β → Prop)
 instance [is_refl α r] [is_refl β s] : is_refl (α ⊕ β) (lift_rel r s) := ⟨lift_rel.refl _ _⟩
 
 instance [is_irrefl α r] [is_irrefl β s] : is_irrefl (α ⊕ β) (lift_rel r s) :=
-⟨by { rintro _ (⟨a, _, h⟩ | ⟨a, _, h⟩); exact irrefl _ h }⟩
+⟨by { rintro _ (⟨h⟩ | ⟨h⟩); exact irrefl _ h }⟩
 
 @[trans] lemma lift_rel.trans [is_trans α r] [is_trans β s] :
   ∀ {a b c}, lift_rel r s a b → lift_rel r s b c → lift_rel r s a c
@@ -51,7 +54,7 @@ instance [is_trans α r] [is_trans β s] : is_trans (α ⊕ β) (lift_rel r s) :
 ⟨λ _ _ _, lift_rel.trans _ _⟩
 
 instance [is_antisymm α r] [is_antisymm β s] : is_antisymm (α ⊕ β) (lift_rel r s) :=
-⟨by { rintro _ _ (⟨a, b, hab⟩ | ⟨a, b, hab⟩) (⟨_, _, hba⟩ | ⟨_, _, hba⟩); rw antisymm hab hba }⟩
+⟨by { rintro _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hba⟩ | ⟨hba⟩); rw antisymm hab hba }⟩
 
 end lift_rel
 
@@ -62,14 +65,14 @@ instance [is_refl α r] [is_refl β s] : is_refl (α ⊕ β) (lex r s) :=
 ⟨by { rintro (a | a), exacts [lex.inl (refl _), lex.inr (refl _)] }⟩
 
 instance [is_irrefl α r] [is_irrefl β s] : is_irrefl (α ⊕ β) (lex r s) :=
-⟨by { rintro _ (⟨a, _, h⟩ | ⟨a, _, h⟩); exact irrefl _ h }⟩
+⟨by { rintro _ (⟨h⟩ | ⟨h⟩); exact irrefl _ h }⟩
 
 instance [is_trans α r] [is_trans β s] : is_trans (α ⊕ β) (lex r s) :=
-⟨by { rintro _ _ _ (⟨a, b, hab⟩ | ⟨a, b, hab⟩) (⟨_, c, hbc⟩ | ⟨_, c, hbc⟩),
+⟨by { rintro _ _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hbc⟩ | ⟨hbc⟩),
   exacts [lex.inl (trans hab hbc), lex.sep _ _, lex.inr (trans hab hbc), lex.sep _ _] }⟩
 
 instance [is_antisymm α r] [is_antisymm β s] : is_antisymm (α ⊕ β) (lex r s) :=
-⟨by { rintro _ _ (⟨a, b, hab⟩ | ⟨a, b, hab⟩) (⟨_, _, hba⟩ | ⟨_, _, hba⟩); rw antisymm hab hba }⟩
+⟨by { rintro _ _ (⟨hab⟩ | ⟨hab⟩) (⟨hba⟩ | ⟨hba⟩); rw antisymm hab hba }⟩
 
 instance [is_total α r] [is_total β s] : is_total (α ⊕ β) (lex r s) :=
 ⟨λ a b, match a, b with
@@ -88,7 +91,7 @@ instance [is_trichotomous α r] [is_trichotomous β s] : is_trichotomous (α ⊕
 end⟩
 
 instance [is_well_order α r] [is_well_order β s] : is_well_order (α ⊕ β) (sum.lex r s) :=
-{ wf := sum.lex_wf is_well_order.wf is_well_order.wf }
+{ wf := sum.lex_wf is_well_founded.wf is_well_founded.wf }
 
 end lex
 
@@ -134,10 +137,10 @@ instance : preorder (α ⊕ β) :=
   le_trans := λ _ _ _, trans,
   lt_iff_le_not_le := λ a b, begin
     refine ⟨λ hab, ⟨hab.mono (λ _ _, le_of_lt) (λ _ _, le_of_lt), _⟩, _⟩,
-    { rintro (⟨b, a, hba⟩ | ⟨b, a, hba⟩),
+    { rintro (⟨hba⟩ | ⟨hba⟩),
       { exact hba.not_lt (inl_lt_inl_iff.1 hab) },
       { exact hba.not_lt (inr_lt_inr_iff.1 hab) } },
-    { rintro ⟨⟨a, b, hab⟩ | ⟨a, b, hab⟩, hba⟩,
+    { rintro ⟨⟨hab⟩ | ⟨hab⟩, hba⟩,
       { exact lift_rel.inl (hab.lt_of_not_le $ λ h, hba $ lift_rel.inl h) },
       { exact lift_rel.inr (hab.lt_of_not_le $ λ h, hba $ lift_rel.inr h) } }
   end,
@@ -214,12 +217,10 @@ end⟩, ⟨λ a b h, begin
 end⟩⟩, λ h, @sum.densely_ordered _ _ _ _ h.1 h.2⟩
 
 @[simp] lemma swap_le_swap_iff [has_le α] [has_le β] {a b : α ⊕ β} : a.swap ≤ b.swap ↔ a ≤ b :=
-by cases a; cases b;
-  simp only [swap, inr_le_inr_iff, inl_le_inl_iff, not_inl_le_inr, not_inr_le_inl]
+lift_rel_swap_iff
 
 @[simp] lemma swap_lt_swap_iff [has_lt α] [has_lt β] {a b : α ⊕ β} : a.swap < b.swap ↔ a < b :=
-by cases a; cases b;
-  simp only [swap, inr_lt_inr_iff, inl_lt_inl_iff, not_inl_lt_inr, not_inr_lt_inl]
+lift_rel_swap_iff
 
 end disjoint
 
@@ -293,11 +294,11 @@ instance preorder : preorder (α ⊕ₗ β) :=
   le_trans := λ _ _ _, trans_of (lex (≤) (≤)),
   lt_iff_le_not_le := λ a b, begin
     refine ⟨λ hab, ⟨hab.mono (λ _ _, le_of_lt) (λ _ _, le_of_lt), _⟩, _⟩,
-    { rintro (⟨b, a, hba⟩ | ⟨b, a, hba⟩ | ⟨b, a⟩),
+    { rintro (⟨hba⟩ | ⟨hba⟩ | ⟨b, a⟩),
       { exact hba.not_lt (inl_lt_inl_iff.1 hab) },
       { exact hba.not_lt (inr_lt_inr_iff.1 hab) },
       { exact not_inr_lt_inl hab } },
-    { rintro ⟨⟨a, b, hab⟩ | ⟨a, b, hab⟩ | ⟨a, b⟩, hba⟩,
+    { rintro ⟨⟨hab⟩ | ⟨hab⟩ | ⟨a, b⟩, hba⟩,
       { exact lex.inl (hab.lt_of_not_le $ λ h, hba $ lex.inl h) },
       { exact lex.inr (hab.lt_of_not_le $ λ h, hba $ lex.inr h) },
       { exact lex.sep _ _} }
@@ -414,7 +415,7 @@ end sum
 open order_dual sum
 
 namespace order_iso
-variables {α β γ : Type*} [has_le α] [has_le β] [has_le γ] (a : α) (b : β) (c : γ)
+variables [has_le α] [has_le β] [has_le γ] (a : α) (b : β) (c : γ)
 
 /-- `equiv.sum_comm` promoted to an order isomorphism. -/
 @[simps apply] def sum_comm (α β : Type*) [has_le α] [has_le β] : α ⊕ β ≃o β ⊕ α :=
@@ -527,3 +528,49 @@ end,
   (sum_lex_dual_antidistrib α β).symm (inr (to_dual a)) = to_dual (inl a) := rfl
 
 end order_iso
+
+variable [has_le α]
+
+namespace with_bot
+
+/-- `with_bot α` is order-isomorphic to `punit ⊕ₗ α`, by sending `⊥` to `punit.star` and `↑a` to
+`a`. -/
+def order_iso_punit_sum_lex : with_bot α ≃o punit ⊕ₗ α :=
+⟨(equiv.option_equiv_sum_punit α).trans $ (equiv.sum_comm _ _).trans to_lex,
+  by rintro (a | _) (b | _); simp; exact not_coe_le_bot _⟩
+
+@[simp] lemma order_iso_punit_sum_lex_bot :
+  @order_iso_punit_sum_lex α _ ⊥ = to_lex (inl punit.star) := rfl
+
+@[simp] lemma order_iso_punit_sum_lex_coe (a : α) :
+  order_iso_punit_sum_lex (↑a) = to_lex (inr a) := rfl
+
+@[simp] lemma order_iso_punit_sum_lex_symm_inl (x : punit) :
+  (@order_iso_punit_sum_lex α _).symm (to_lex $ inl x) = ⊥ := rfl
+
+@[simp] lemma order_iso_punit_sum_lex_symm_inr (a : α) :
+  order_iso_punit_sum_lex.symm (to_lex $ inr a) = a := rfl
+
+end with_bot
+
+namespace with_top
+
+/-- `with_top α` is order-isomorphic to `α ⊕ₗ punit`, by sending `⊤` to `punit.star` and `↑a` to
+`a`. -/
+def order_iso_sum_lex_punit : with_top α ≃o α ⊕ₗ punit :=
+⟨(equiv.option_equiv_sum_punit α).trans to_lex,
+  by rintro (a | _) (b | _); simp; exact not_top_le_coe _⟩
+
+@[simp] lemma order_iso_sum_lex_punit_top :
+  @order_iso_sum_lex_punit α _ ⊤ = to_lex (inr punit.star) := rfl
+
+@[simp] lemma order_iso_sum_lex_punit_coe (a : α) :
+  order_iso_sum_lex_punit (↑a) = to_lex (inl a) := rfl
+
+@[simp] lemma order_iso_sum_lex_punit_symm_inr (x : punit) :
+  (@order_iso_sum_lex_punit α _).symm (to_lex $ inr x) = ⊤ := rfl
+
+@[simp] lemma order_iso_sum_lex_punit_symm_inl (a : α) :
+  order_iso_sum_lex_punit.symm (to_lex $ inl a) = a := rfl
+
+end with_top
diff --git a/src/data/sym/basic.lean b/src/data/sym/basic.lean
index eee663f3077c1..7e43f0dc741ad 100644
--- a/src/data/sym/basic.lean
+++ b/src/data/sym/basic.lean
@@ -12,6 +12,9 @@ import tactic.apply_fun
 /-!
 # Symmetric powers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines symmetric powers of a type.  The nth symmetric power
 consists of homogeneous n-tuples modulo permutations by the symmetric
 group.
@@ -53,7 +56,7 @@ local attribute [instance] vector.perm.is_setoid
 
 namespace sym
 
-variables {α β : Type*} {n : ℕ} {s : sym α n} {a b : α}
+variables {α β : Type*} {n n' m : ℕ} {s : sym α n} {a b : α}
 
 lemma coe_injective : injective (coe : sym α n → multiset α) := subtype.coe_injective
 
@@ -71,26 +74,28 @@ The unique element in `sym α 0`.
 -/
 @[pattern] def nil : sym α 0 := ⟨0, multiset.card_zero⟩
 
+@[simp] lemma coe_nil : (coe (@sym.nil α)) = (0 : multiset α) := rfl
+
 /--
 Inserts an element into the term of `sym α n`, increasing the length by one.
 -/
 @[pattern] def cons (a : α) (s : sym α n) : sym α n.succ :=
 ⟨a ::ₘ s.1, by rw [multiset.card_cons, s.2]⟩
 
-notation a :: b := cons a b
+infixr ` ::ₛ `:67 := cons
 
 @[simp]
-lemma cons_inj_right (a : α) (s s' : sym α n) : a :: s = a :: s' ↔ s = s' :=
+lemma cons_inj_right (a : α) (s s' : sym α n) : a ::ₛ s = a ::ₛ s' ↔ s = s' :=
 subtype.ext_iff.trans $ (multiset.cons_inj_right _).trans subtype.ext_iff.symm
 
 @[simp]
-lemma cons_inj_left (a a' : α) (s : sym α n) : a :: s = a' :: s ↔ a = a' :=
+lemma cons_inj_left (a a' : α) (s : sym α n) : a ::ₛ s = a' ::ₛ s ↔ a = a' :=
 subtype.ext_iff.trans $ multiset.cons_inj_left _
 
-lemma cons_swap (a b : α) (s : sym α n) : a :: b :: s = b :: a :: s :=
+lemma cons_swap (a b : α) (s : sym α n) : a ::ₛ b ::ₛ s = b ::ₛ a ::ₛ s :=
 subtype.ext $ multiset.cons_swap a b s.1
 
-lemma coe_cons (s : sym α n) (a : α) : (a :: s : multiset α) = a ::ₘ s := rfl
+lemma coe_cons (s : sym α n) (a : α) : (a ::ₛ s : multiset α) = a ::ₘ s := rfl
 
 /--
 This is the quotient map that takes a list of n elements as an n-tuple and produces an nth
@@ -102,7 +107,7 @@ instance : has_lift (vector α n) (sym α n) :=
 @[simp] lemma of_vector_nil : ↑(vector.nil : vector α 0) = (sym.nil : sym α 0) := rfl
 
 @[simp] lemma of_vector_cons (a : α) (v : vector α n) :
-  ↑(vector.cons a v) = a :: (↑v : sym α n) := by { cases v, refl }
+  ↑(vector.cons a v) = a ::ₛ (↑v : sym α n) := by { cases v, refl }
 
 /--
 `α ∈ s` means that `a` appears as one of the factors in `s`.
@@ -115,16 +120,18 @@ s.1.decidable_mem _
 @[simp]
 lemma mem_mk (a : α) (s : multiset α) (h : s.card = n) : a ∈ mk s h ↔ a ∈ s := iff.rfl
 
-@[simp] lemma mem_cons {a b : α} {s : sym α n} : a ∈ b :: s ↔ a = b ∨ a ∈ s :=
+@[simp] lemma mem_cons : a ∈ b ::ₛ s ↔ a = b ∨ a ∈ s :=
 multiset.mem_cons
 
-lemma mem_cons_of_mem {a b : α} {s : sym α n} (h : a ∈ s) : a ∈ b :: s :=
+@[simp] lemma mem_coe : a ∈ (s : multiset α) ↔ a ∈ s := iff.rfl
+
+lemma mem_cons_of_mem (h : a ∈ s) : a ∈ b ::ₛ s :=
 multiset.mem_cons_of_mem h
 
-@[simp] lemma mem_cons_self (a : α) (s : sym α n) : a ∈ a :: s :=
+@[simp] lemma mem_cons_self (a : α) (s : sym α n) : a ∈ a ::ₛ s :=
 multiset.mem_cons_self a s.1
 
-lemma cons_of_coe_eq (a : α) (v : vector α n) : a :: (↑v : sym α n) = ↑(a ::ᵥ v) :=
+lemma cons_of_coe_eq (a : α) (v : vector α n) : a ::ₛ (↑v : sym α n) = ↑(a ::ᵥ v) :=
 subtype.ext $ by { cases v, refl }
 
 lemma sound {a b : vector α n} (h : a.val ~ b.val) : (↑a : sym α n) = ↑b :=
@@ -142,11 +149,11 @@ def erase [decidable_eq α] (s : sym α (n + 1)) (a : α) (h : a ∈ s) : sym α
   (s.erase a h : multiset α) = multiset.erase s a := rfl
 
 @[simp] lemma cons_erase [decidable_eq α] {s : sym α n.succ} {a : α} (h : a ∈ s) :
-  a :: s.erase a h = s :=
+  a ::ₛ s.erase a h = s :=
 coe_injective $ multiset.cons_erase h
 
 @[simp] lemma erase_cons_head [decidable_eq α] (s : sym α n) (a : α)
-  (h : a ∈ a :: s := mem_cons_self a s) : (a :: s).erase a h = s :=
+  (h : a ∈ a ::ₛ s := mem_cons_self a s) : (a ::ₛ s).erase a h = s :=
 coe_injective $ multiset.erase_cons_head a s.1
 
 /--
@@ -160,7 +167,7 @@ This is `cons` but for the alternative `sym'` definition.
 def cons' {α : Type*} {n : ℕ} : α → sym' α n → sym' α (nat.succ n) :=
 λ a, quotient.map (vector.cons a) (λ ⟨l₁, h₁⟩ ⟨l₂, h₂⟩ h, list.perm.cons _ h)
 
-notation a :: b := cons' a b
+notation (name := sym.cons') a :: b := cons' a b
 
 /--
 Multisets of cardinality n are equivalent to length-n vectors up to permutations.
@@ -169,7 +176,7 @@ def sym_equiv_sym' {α : Type*} {n : ℕ} : sym α n ≃ sym' α n :=
 equiv.subtype_quotient_equiv_quotient_subtype _ _ (λ _, by refl) (λ _ _, by refl)
 
 lemma cons_equiv_eq_equiv_cons (α : Type*) (n : ℕ) (a : α) (s : sym α n) :
-  a :: sym_equiv_sym' s = sym_equiv_sym' (a :: s) :=
+  a :: sym_equiv_sym' s = sym_equiv_sym' (a ::ₛ s) :=
 by { rcases s with ⟨⟨l⟩, _⟩, refl, }
 
 instance : has_zero (sym α 0) := ⟨⟨0, rfl⟩⟩
@@ -181,37 +188,37 @@ subtype.ext $ multiset.card_eq_zero.1 s.2
 instance unique_zero : unique (sym α 0) :=
 ⟨⟨nil⟩, eq_nil_of_card_zero⟩
 
-/-- `repeat a n` is the sym containing only `a` with multiplicity `n`. -/
-def repeat (a : α) (n : ℕ) : sym α n := ⟨multiset.repeat a n, multiset.card_repeat _ _⟩
+/-- `replicate n a` is the sym containing only `a` with multiplicity `n`. -/
+def replicate (n : ℕ) (a : α) : sym α n := ⟨multiset.replicate n a, multiset.card_replicate _ _⟩
 
-lemma repeat_succ {a : α} {n : ℕ} : repeat a n.succ = a :: repeat a n := rfl
+lemma replicate_succ {a : α} {n : ℕ} : replicate n.succ a = a ::ₛ replicate n a := rfl
 
-lemma coe_repeat : (repeat a n : multiset α) = multiset.repeat a n := rfl
+lemma coe_replicate : (replicate n a : multiset α) = multiset.replicate n a := rfl
 
-@[simp] lemma mem_repeat : b ∈ repeat a n ↔ n ≠ 0 ∧ b = a := multiset.mem_repeat
+@[simp] lemma mem_replicate : b ∈ replicate n a ↔ n ≠ 0 ∧ b = a := multiset.mem_replicate
 
-lemma eq_repeat_iff : s = repeat a n ↔ ∀ b ∈ s, b = a :=
+lemma eq_replicate_iff : s = replicate n a ↔ ∀ b ∈ s, b = a :=
 begin
-  rw [subtype.ext_iff, coe_repeat],
-  convert multiset.eq_repeat',
-  exact s.2.symm,
+  rw [subtype.ext_iff, coe_replicate, multiset.eq_replicate],
+  exact and_iff_right s.2
 end
 
 lemma exists_mem (s : sym α n.succ) : ∃ a, a ∈ s :=
 multiset.card_pos_iff_exists_mem.1 $ s.2.symm ▸ n.succ_pos
 
-lemma exists_eq_cons_of_succ (s : sym α n.succ) : ∃ (a : α) (s' : sym α n), s = a :: s' :=
+lemma exists_eq_cons_of_succ (s : sym α n.succ) : ∃ (a : α) (s' : sym α n), s = a ::ₛ s' :=
 begin
   obtain ⟨a, ha⟩ := exists_mem s,
   classical,
   exact ⟨a, s.erase a ha, (cons_erase ha).symm⟩,
 end
 
-lemma eq_repeat {a : α} {n : ℕ} {s : sym α n} : s = repeat a n ↔ ∀ b ∈ s, b = a :=
-subtype.ext_iff.trans $ multiset.eq_repeat.trans $ and_iff_right s.prop
+lemma eq_replicate {a : α} {n : ℕ} {s : sym α n} : s = replicate n a ↔ ∀ b ∈ s, b = a :=
+subtype.ext_iff.trans $ multiset.eq_replicate.trans $ and_iff_right s.prop
 
-lemma eq_repeat_of_subsingleton [subsingleton α] (a : α) {n : ℕ} (s : sym α n) : s = repeat a n :=
-eq_repeat.2 $ λ b hb, subsingleton.elim _ _
+lemma eq_replicate_of_subsingleton [subsingleton α] (a : α) {n : ℕ} (s : sym α n) :
+  s = replicate n a :=
+eq_replicate.2 $ λ b hb, subsingleton.elim _ _
 
 instance [subsingleton α] (n : ℕ) : subsingleton (sym α n) :=
 ⟨begin
@@ -219,28 +226,29 @@ instance [subsingleton α] (n : ℕ) : subsingleton (sym α n) :=
   { simp, },
   { intros s s',
     obtain ⟨b, -⟩ := exists_mem s,
-    rw [eq_repeat_of_subsingleton b s', eq_repeat_of_subsingleton b s], },
+    rw [eq_replicate_of_subsingleton b s', eq_replicate_of_subsingleton b s], },
 end⟩
 
 instance inhabited_sym [inhabited α] (n : ℕ) : inhabited (sym α n) :=
-⟨repeat default n⟩
+⟨replicate n default⟩
 
 instance inhabited_sym' [inhabited α] (n : ℕ) : inhabited (sym' α n) :=
-⟨quotient.mk' (vector.repeat default n)⟩
+⟨quotient.mk' (vector.replicate n default)⟩
 
 instance (n : ℕ) [is_empty α] : is_empty (sym α n.succ) :=
 ⟨λ s, by { obtain ⟨a, -⟩ := exists_mem s, exact is_empty_elim a }⟩
 
 instance (n : ℕ) [unique α] : unique (sym α n) := unique.mk' _
 
-lemma repeat_left_inj {a b : α} {n : ℕ} (h : n ≠ 0) : repeat a n = repeat b n ↔ a = b :=
-subtype.ext_iff.trans (multiset.repeat_left_inj h)
+lemma replicate_right_inj {a b : α} {n : ℕ} (h : n ≠ 0) : replicate n a = replicate n b ↔ a = b :=
+subtype.ext_iff.trans (multiset.replicate_right_inj h)
 
-lemma repeat_left_injective {n : ℕ} (h : n ≠ 0) : function.injective (λ x : α, repeat x n) :=
-λ a b, (repeat_left_inj h).1
+lemma replicate_right_injective {n : ℕ} (h : n ≠ 0) :
+  function.injective (replicate n : α → sym α n) :=
+λ a b, (replicate_right_inj h).1
 
 instance (n : ℕ) [nontrivial α] : nontrivial (sym α (n + 1)) :=
-(repeat_left_injective n.succ_ne_zero).nontrivial
+(replicate_right_injective n.succ_ne_zero).nontrivial
 
 /-- A function `α → β` induces a function `sym α n → sym β n` by applying it to every element of
 the underlying `n`-tuple. -/
@@ -265,7 +273,7 @@ by simp [sym.map]
   sym.map f (0 : sym α 0) = (0 : sym β 0) := rfl
 
 @[simp] lemma map_cons {n : ℕ} (f : α → β) (a : α) (s : sym α n) :
-  (a :: s).map f = (f a) :: s.map f :=
+  (a ::ₛ s).map f = (f a) ::ₛ s.map f :=
 by simp [map, cons]
 
 @[congr] lemma map_congr {f g : α → β} {s : sym α n} (h : ∀ x ∈ s, f x = g x) :
@@ -312,4 +320,155 @@ multiset.mem_attach _ _
   :=
 coe_injective $ multiset.attach_cons _ _
 
+/-- Change the length of a `sym` using an equality.
+The simp-normal form is for the `cast` to be pushed outward. -/
+protected def cast {n m : ℕ} (h : n = m) : sym α n ≃ sym α m :=
+{ to_fun := λ s, ⟨s.val, s.2.trans h⟩,
+  inv_fun := λ s, ⟨s.val, s.2.trans h.symm⟩,
+  left_inv := λ s, subtype.ext rfl,
+  right_inv := λ s, subtype.ext rfl }
+
+@[simp] lemma cast_rfl : sym.cast rfl s = s := subtype.ext rfl
+
+@[simp] lemma cast_cast {n'' : ℕ} (h : n = n') (h' : n' = n'') :
+  sym.cast h' (sym.cast h s) = sym.cast (h.trans h') s := rfl
+
+@[simp] lemma coe_cast (h : n = m) : (sym.cast h s : multiset α) = s := rfl
+
+@[simp] lemma mem_cast (h : n = m) : a ∈ sym.cast h s ↔ a ∈ s := iff.rfl
+
+/-- Append a pair of `sym` terms. -/
+def append (s : sym α n) (s' : sym α n') : sym α (n + n') :=
+⟨s.1 + s'.1, by simp_rw [← s.2, ← s'.2, map_add]⟩
+
+@[simp] lemma append_inj_right (s : sym α n) {t t' : sym α n'} :
+  s.append t = s.append t' ↔ t = t' :=
+subtype.ext_iff.trans $ (add_right_inj _).trans subtype.ext_iff.symm
+
+@[simp] lemma append_inj_left {s s' : sym α n} (t : sym α n') :
+  s.append t = s'.append t ↔ s = s' :=
+subtype.ext_iff.trans $ (add_left_inj _).trans subtype.ext_iff.symm
+
+lemma append_comm (s : sym α n') (s' : sym α n') :
+  s.append s' = sym.cast (add_comm _ _) (s'.append s) :=
+by { ext, simp [append, add_comm], }
+
+@[simp, norm_cast] lemma coe_append (s : sym α n) (s' : sym α n') :
+  (s.append s' : multiset α) = s + s' := rfl
+
+lemma mem_append_iff {s' : sym α m} : a ∈ s.append s' ↔ a ∈ s ∨ a ∈ s' := multiset.mem_add
+
+/-- Fill a term `m : sym α (n - i)` with `i` copies of `a` to obtain a term of `sym α n`.
+This is a convenience wrapper for `m.append (replicate i a)` that adjusts the term using
+`sym.cast`. -/
+def fill (a : α) (i : fin (n + 1)) (m : sym α (n - i)) : sym α n :=
+sym.cast (nat.sub_add_cancel i.is_le) (m.append (replicate i a))
+
+lemma coe_fill {a : α} {i : fin (n + 1)} {m : sym α (n - i)} :
+  (fill a i m : multiset α) = m + replicate i a := rfl
+
+lemma mem_fill_iff {a b : α} {i : fin (n + 1)} {s : sym α (n - i)} :
+  a ∈ sym.fill b i s ↔ ((i : ℕ) ≠ 0 ∧ a = b) ∨ a ∈ s :=
+by rw [fill, mem_cast, mem_append_iff, or_comm, mem_replicate]
+
+open multiset
+
+/-- Remove every `a` from a given `sym α n`.
+Yields the number of copies `i` and a term of `sym α (n - i)`. -/
+def filter_ne [decidable_eq α] (a : α) (m : sym α n) : Σ i : fin (n + 1), sym α (n - i) :=
+⟨⟨m.1.count a, (count_le_card _ _).trans_lt $ by rw [m.2, nat.lt_succ_iff]⟩,
+  m.1.filter ((≠) a), eq_tsub_of_add_eq $ eq.trans begin
+    rw [← countp_eq_card_filter, add_comm],
+    exact (card_eq_countp_add_countp _ _).symm,
+  end m.2⟩
+
+lemma sigma_sub_ext {m₁ m₂ : Σ i : fin (n + 1), sym α (n - i)}
+  (h : (m₁.2 : multiset α) = m₂.2) : m₁ = m₂ :=
+sigma.subtype_ext (fin.ext $ by rw [← nat.sub_sub_self m₁.1.is_le, ← nat.sub_sub_self m₂.1.is_le,
+  ← m₁.2.2, ← m₂.2.2, subtype.val_eq_coe, subtype.val_eq_coe, h]) h
+
+lemma fill_filter_ne [decidable_eq α] (a : α) (m : sym α n) :
+  (m.filter_ne a).2.fill a (m.filter_ne a).1 = m :=
+subtype.ext begin
+  dsimp only [coe_fill, filter_ne, subtype.coe_mk, fin.coe_mk],
+  ext b, rw [count_add, count_filter, sym.coe_replicate, count_replicate],
+  obtain rfl | h := eq_or_ne a b,
+  { rw [if_pos rfl, if_neg (not_not.2 rfl), zero_add], refl },
+  { rw [if_pos h, if_neg h.symm, add_zero], refl },
+end
+
+lemma filter_ne_fill [decidable_eq α] (a : α) (m : Σ i : fin (n + 1), sym α (n - i)) (h : a ∉ m.2) :
+  (m.2.fill a m.1).filter_ne a = m :=
+sigma_sub_ext begin
+  dsimp only [filter_ne, subtype.coe_mk, subtype.val_eq_coe, coe_fill],
+  rw [filter_add, filter_eq_self.2, add_right_eq_self, eq_zero_iff_forall_not_mem],
+  { intros b hb, rw [mem_filter, sym.mem_coe, mem_replicate] at hb, exact hb.2 hb.1.2.symm },
+  { exact λ b hb, (hb.ne_of_not_mem h).symm },
+end
+
 end sym
+
+section equiv
+
+/-! ### Combinatorial equivalences -/
+
+variables {α : Type*} {n : ℕ}
+open sym
+
+namespace sym_option_succ_equiv
+
+/-- Function from the symmetric product over `option` splitting on whether or not
+it contains a `none`. -/
+def encode [decidable_eq α] (s : sym (option α) n.succ) : sym (option α) n ⊕ sym α n.succ :=
+if h : none ∈ s
+then sum.inl (s.erase none h)
+else sum.inr (s.attach.map $ λ o,
+  option.get $ option.ne_none_iff_is_some.1 $ ne_of_mem_of_not_mem o.2 h)
+
+@[simp] lemma encode_of_none_mem [decidable_eq α] (s : sym (option α) n.succ) (h : none ∈ s) :
+  encode s = sum.inl (s.erase none h) := dif_pos h
+
+@[simp] lemma encode_of_not_none_mem [decidable_eq α] (s : sym (option α) n.succ) (h : ¬ none ∈ s) :
+  encode s = sum.inr (s.attach.map $ λ o,
+    option.get $ option.ne_none_iff_is_some.1 $ ne_of_mem_of_not_mem o.2 h) := dif_neg h
+
+/-- Inverse of `sym_option_succ_equiv.decode`. -/
+@[simp] def decode : sym (option α) n ⊕ sym α n.succ → sym (option α) n.succ
+| (sum.inl s) := none ::ₛ s
+| (sum.inr s) := s.map embedding.coe_option
+
+@[simp] lemma decode_encode [decidable_eq α] (s : sym (option α) n.succ) :
+  decode (encode s) = s :=
+begin
+  by_cases h : none ∈ s,
+  { simp [h] },
+  { simp only [h, decode, not_false_iff, subtype.val_eq_coe, encode_of_not_none_mem,
+      embedding.coe_option_apply, map_map, comp_app, option.coe_get],
+    convert s.attach_map_coe }
+end
+
+@[simp] lemma encode_decode [decidable_eq α] (s : sym (option α) n ⊕ sym α n.succ) :
+  encode (decode s) = s :=
+begin
+  obtain (s | s) := s,
+  { simp },
+  { unfold sym_option_succ_equiv.encode,
+    split_ifs,
+    { obtain ⟨a, _, ha⟩ := multiset.mem_map.mp h,
+      exact option.some_ne_none _ ha },
+    { refine map_injective (option.some_injective _) _ _,
+      convert eq.trans _ (sym_option_succ_equiv.decode (sum.inr s)).attach_map_coe,
+      simp } }
+end
+
+end sym_option_succ_equiv
+
+/-- The symmetric product over `option` is a disjoint union over simpler symmetric products. -/
+@[simps] def sym_option_succ_equiv [decidable_eq α] :
+  sym (option α) n.succ ≃ sym (option α) n ⊕ sym α n.succ :=
+{ to_fun := sym_option_succ_equiv.encode,
+  inv_fun := sym_option_succ_equiv.decode,
+  left_inv := sym_option_succ_equiv.decode_encode,
+  right_inv := sym_option_succ_equiv.encode_decode }
+
+end equiv
diff --git a/src/data/sym/card.lean b/src/data/sym/card.lean
index 9d6a18ed295dd..f45e2c505f828 100644
--- a/src/data/sym/card.lean
+++ b/src/data/sym/card.lean
@@ -1,45 +1,135 @@
 /-
 Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies, Bhavik Mehta
+Authors: Yaël Dillies, Bhavik Mehta, Huỳnh Trần Khanh, Stuart Presnell
 -/
 import algebra.big_operators.basic
 import data.finset.sym
+import data.fintype.sum
 
 /-!
 # Stars and bars
 
-In this file, we prove the case `n = 2` of stars and bars.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we prove (in `sym.card_sym_eq_multichoose`) that the function `multichoose n k`
+defined in `data/nat/choose/basic` counts the number of multisets of cardinality `k` over an
+alphabet of cardinality `n`. In conjunction with `nat.multichoose_eq` proved in
+`data/nat/choose/basic`, which shows that `multichoose n k = choose (n + k - 1) k`,
+this is central to the "stars and bars" technique in combinatorics, where we switch between
+counting multisets of size `k` over an alphabet of size `n` to counting strings of `k` elements
+("stars") separated by `n-1` dividers ("bars").
 
 ## Informal statement
 
-If we have `n` objects to put in `k` boxes, we can do so in exactly `(n + k - 1).choose n` ways.
+Many problems in mathematics are of the form of (or can be reduced to) putting `k` indistinguishable
+objects into `n` distinguishable boxes; for example, the problem of finding natural numbers
+`x1, ..., xn` whose sum is `k`. This is equivalent to forming a multiset of cardinality `k` from
+an alphabet of cardinality `n` -- for each box `i ∈ [1, n]` the multiset contains as many copies
+of `i` as there are items in the `i`th box.
 
-## Formal statement
+The "stars and bars" technique arises from another way of presenting the same problem. Instead of
+putting `k` items into `n` boxes, we take a row of `k` items (the "stars") and separate them by
+inserting `n-1` dividers (the "bars").  For example, the pattern `*|||**|*|` exhibits 4 items
+distributed into 6 boxes -- note that any box, including the first and last, may be empty.
+Such arrangements of `k` stars and `n-1` bars are in 1-1 correspondence with multisets of size `k`
+over an alphabet of size `n`, and are counted by `choose (n + k - 1) k`.
 
-We can identify the `k` boxes with the elements of a fintype `α` of card `k`. Then placing `n`
-elements in those boxes corresponds to choosing how many of each element of `α` appear in a multiset
-of card `n`. `sym α n` being the subtype of `multiset α` of multisets of card `n`, writing stars
-and bars using types gives
-```lean
--- TODO: this lemma is not yet proven
-lemma stars_and_bars {α : Type*} [fintype α] (n : ℕ) :
-  card (sym α n) = (card α + n - 1).choose (card α) := sorry
-```
+Note that this problem is one component of Gian-Carlo Rota's "Twelvefold Way"
+https://en.wikipedia.org/wiki/Twelvefold_way
+
+## Formal statement
 
-## TODO
+Here we generalise the alphabet to an arbitrary fintype `α`, and we use `sym α k` as the type of
+multisets of size `k` over `α`. Thus the statement that these are counted by `multichoose` is:
+`sym.card_sym_eq_multichoose : card (sym α k) = multichoose (card α) k`
+while the "stars and bars" technique gives
+`sym.card_sym_eq_choose : card (sym α k) = choose (card α + k - 1) k`
 
-Prove the general case of stars and bars.
 
 ## Tags
 
-stars and bars
+stars and bars, multichoose
 -/
 
-open finset fintype
+open finset fintype function sum nat
+
+variables {α β : Type*}
+
+namespace sym
+
+section sym
+variables (α) (n : ℕ)
+
+/--
+Over `fin n+1`, the multisets of size `k+1` containing `0` are equivalent to those of size `k`,
+as demonstrated by respectively erasing or appending `0`.
+-/
+protected def E1 {n k : ℕ} :
+  {s : sym (fin n.succ) k.succ // ↑0 ∈ s} ≃ sym (fin n.succ) k :=
+{ to_fun    := λ s, s.1.erase 0 s.2,
+  inv_fun   := λ s, ⟨cons 0 s, mem_cons_self 0 s⟩,
+  left_inv  := λ s, by simp,
+  right_inv := λ s, by simp }
+
+/--
+The multisets of size `k` over `fin n+2` not containing `0`
+are equivalent to those of size `k` over `fin n+1`,
+as demonstrated by respectively decrementing or incrementing every element of the multiset.
+-/
+protected def E2 {n k : ℕ} :
+  {s : sym (fin n.succ.succ) k // ↑0 ∉ s} ≃ sym (fin n.succ) k :=
+{ to_fun    := λ s, map (fin.pred_above 0) s.1,
+  inv_fun   := λ s, ⟨map (fin.succ_above 0) s,
+    (mt mem_map.1) (not_exists.2 (λ t, (not_and.2 (λ _, (fin.succ_above_ne _ t)))))⟩,
+  left_inv  := λ s, by
+  { obtain ⟨s, hs⟩ := s,
+    simp only [map_map, comp_app],
+    nth_rewrite_rhs 0 ←(map_id' s),
+    refine sym.map_congr (λ v hv,  _),
+    simp [fin.pred_above_zero (ne_of_mem_of_not_mem hv hs)] },
+  right_inv := λ s, by
+  { simp only [fin.zero_succ_above, map_map, comp_app],
+    nth_rewrite_rhs 0 ←(map_id' s),
+    refine sym.map_congr (λ v hv,  _),
+    rw [←fin.zero_succ_above v, ←@fin.cast_succ_zero n.succ, fin.pred_above_succ_above 0 v] } }
+
+lemma card_sym_fin_eq_multichoose (n k : ℕ) : card (sym (fin n) k) = multichoose n k :=
+begin
+  apply @pincer_recursion (λ n k, card (sym (fin n) k) = multichoose n k),
+  { simp },
+  { intros b,
+    induction b with b IHb, { simp },
+    rw [multichoose_zero_succ, card_eq_zero_iff],
+    apply_instance },
+  { intros x y h1 h2,
+    rw [multichoose_succ_succ, ←h1, ←h2, add_comm],
+    cases x,
+    { simp only [card_eq_zero_iff, card_unique, self_eq_add_right],
+      apply_instance },
+    rw ←card_sum,
+    refine fintype.card_congr (equiv.symm _),
+    apply (equiv.sum_congr sym.E1.symm sym.E2.symm).trans,
+    apply equiv.sum_compl },
+end
+
+/-- For any fintype `α` of cardinality `n`, `card (sym α k) = multichoose (card α) k` -/
+lemma card_sym_eq_multichoose (α : Type*) (k : ℕ) [fintype α] [fintype (sym α k)] :
+  card (sym α k) = multichoose (card α) k :=
+by { rw ←card_sym_fin_eq_multichoose, exact card_congr (equiv_congr (equiv_fin α)) }
+
+/-- The *stars and bars* lemma: the cardinality of `sym α k` is equal to
+`nat.choose (card α + k - 1) k`. -/
+lemma card_sym_eq_choose {α : Type*} [fintype α] (k : ℕ) [fintype (sym α k)] :
+  card (sym α k) = (card α + k - 1).choose k :=
+by rw [card_sym_eq_multichoose, nat.multichoose_eq]
+
+end sym
+end sym
 
 namespace sym2
-variables {α : Type*} [decidable_eq α]
+variables [decidable_eq α]
 
 /-- The `diag` of `s : finset α` is sent on a finset of `sym2 α` of card `s.card`. -/
 lemma card_image_diag (s : finset α) : (s.diag.image quotient.mk).card = s.card :=
@@ -110,9 +200,10 @@ begin
   rw [←image_diag_union_image_off_diag, card_union_eq, sym2.card_image_diag,
     sym2.card_image_off_diag, nat.choose_two_right, add_comm, ←nat.triangle_succ, nat.succ_sub_one,
     mul_comm],
-  rintro m he,
-  rw [inf_eq_inter, mem_inter, mem_image, mem_image] at he,
-  obtain ⟨⟨a, ha, rfl⟩, b, hb, hab⟩ := he,
+  rw disjoint_left,
+  rintro m ha hb,
+  rw [mem_image] at ha hb,
+  obtain ⟨⟨a, ha, rfl⟩, ⟨b, hb, hab⟩⟩ := ⟨ha, hb⟩,
   refine not_is_diag_mk_of_mem_off_diag hb _,
   rw hab,
   exact is_diag_mk_of_mem_diag ha,
diff --git a/src/data/sym/sym2.lean b/src/data/sym/sym2.lean
index 2e911abd94b8b..8e8f7af283968 100644
--- a/src/data/sym/sym2.lean
+++ b/src/data/sym/sym2.lean
@@ -3,12 +3,17 @@ Copyright (c) 2020 Kyle Miller All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kyle Miller
 -/
+import data.finset.prod
 import data.sym.basic
+import data.set_like.basic
 import tactic.linarith
 
 /-!
 # The symmetric square
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the symmetric square, which is `α × α` modulo
 swapping.  This is also known as the type of unordered pairs.
 
@@ -41,7 +46,7 @@ term of the symmetric square.
 symmetric square, unordered pairs, symmetric powers
 -/
 
-open finset fintype function sym
+open finset function sym
 
 universe u
 variables {α β γ : Type*}
@@ -67,6 +72,14 @@ lemma rel.is_equivalence : equivalence (rel α) := by tidy; apply rel.trans; ass
 
 instance rel.setoid (α : Type u) : setoid (α × α) := ⟨rel α, rel.is_equivalence⟩
 
+@[simp] lemma rel_iff {x y z w : α} :
+  (x, y) ≈ (z, w) ↔ (x = z ∧ y = w) ∨ (x = w ∧ y = z) :=
+begin
+  split; intro h,
+  { cases h; simp },
+  { cases h; rw [h.1, h.2], constructor }
+end
+
 end sym2
 
 /--
@@ -86,9 +99,14 @@ protected lemma ind {f : sym2 α → Prop} (h : ∀ x y, f ⟦(x, y)⟧) : ∀ i
 quotient.ind $ prod.rec $ by exact h
 
 @[elab_as_eliminator]
-protected lemma induction_on {f : sym2 α → Prop} (i : sym2 α) (hf : ∀ x y, f ⟦(x,y)⟧) : f i :=
+protected lemma induction_on {f : sym2 α → Prop} (i : sym2 α) (hf : ∀ x y, f ⟦(x, y)⟧) : f i :=
 i.ind hf
 
+@[elab_as_eliminator]
+protected lemma induction_on₂ {f : sym2 α → sym2 β → Prop} (i : sym2 α) (j : sym2 β)
+  (hf : ∀ a₁ a₂ b₁ b₂, f ⟦(a₁, a₂)⟧ ⟦(b₁, b₂)⟧) : f i j :=
+quotient.induction_on₂ i j $ by { rintros ⟨a₁, a₂⟩ ⟨b₁, b₂⟩, exact hf _ _ _ _ }
+
 protected lemma «exists» {α : Sort*} {f : sym2 α → Prop} :
   (∃ (x : sym2 α), f x) ↔ ∃ x y, f ⟦(x, y)⟧ :=
 (surjective_quotient_mk _).exists.trans prod.exists
@@ -111,11 +129,7 @@ by { split; intro h, { rw quotient.eq at h, cases h; refl }, rw h }
 
 lemma eq_iff {x y z w : α} :
   ⟦(x, y)⟧ = ⟦(z, w)⟧ ↔ (x = z ∧ y = w) ∨ (x = w ∧ y = z) :=
-begin
-  split; intro h,
-  { rw quotient.eq at h, cases h; tidy },
-  { cases h; rw [h.1, h.2], rw eq_swap }
-end
+by simp
 
 lemma mk_eq_mk_iff {p q : α × α} :
   ⟦p⟧ = ⟦q⟧ ↔ p = q ∨ p = q.swap :=
@@ -138,6 +152,27 @@ lemma lift_mk (f : {f : α → α → β // ∀ a₁ a₂, f a₁ a₂ = f a₂
 lemma coe_lift_symm_apply (F : sym2 α → β) (a₁ a₂ : α) :
   (lift.symm F : α → α → β) a₁ a₂ = F ⟦(a₁, a₂)⟧ := rfl
 
+/-- A two-argument version of `sym2.lift`. -/
+def lift₂ : {f : α → α → β → β → γ // ∀ a₁ a₂ b₁ b₂,
+  f a₁ a₂ b₁ b₂ = f a₂ a₁ b₁ b₂ ∧ f a₁ a₂ b₁ b₂ = f a₁ a₂ b₂ b₁} ≃ (sym2 α → sym2 β → γ) :=
+{ to_fun := λ f, quotient.lift₂ (λ (a : α × α) (b : β × β), f.1 a.1 a.2 b.1 b.2) begin
+    rintro _ _ _ _ ⟨⟩ ⟨⟩,
+    exacts [rfl, (f.2 _ _ _ _).2, (f.2 _ _ _ _).1, (f.2 _ _ _ _).1.trans (f.2 _ _ _ _).2]
+  end,
+  inv_fun := λ F, ⟨λ a₁ a₂ b₁ b₂, F ⟦(a₁, a₂)⟧ ⟦(b₁, b₂)⟧, λ a₁ a₂ b₁ b₂,
+    by { split, exacts [congr_arg2 F eq_swap rfl, congr_arg2 F rfl eq_swap] }⟩,
+  left_inv := λ f, subtype.ext rfl,
+  right_inv := λ F, funext₂ $ λ a b, sym2.induction_on₂ a b $ λ _ _ _ _, rfl }
+
+@[simp]
+lemma lift₂_mk (f : {f : α → α → β → β → γ // ∀ a₁ a₂ b₁ b₂,
+  f a₁ a₂ b₁ b₂ = f a₂ a₁ b₁ b₂ ∧ f a₁ a₂ b₁ b₂ = f a₁ a₂ b₂ b₁}) (a₁ a₂ : α) (b₁ b₂ : β) :
+  lift₂ f ⟦(a₁, a₂)⟧ ⟦(b₁, b₂)⟧ = (f : α → α → β → β → γ) a₁ a₂ b₁ b₂ := rfl
+
+@[simp]
+lemma coe_lift₂_symm_apply (F : sym2 α → sym2 β → γ) (a₁ a₂ : α) (b₁ b₂ : β) :
+  (lift₂.symm F : α → α → β → β → γ) a₁ a₂ b₁ b₂ = F ⟦(a₁, a₂)⟧ ⟦(b₁, b₂)⟧ := rfl
+
 /--
 The functor `sym2` is functorial, and this function constructs the induced maps.
 -/
@@ -168,24 +203,42 @@ end
 
 section membership
 
-/-! ### Declarations about membership -/
+/-! ### Membership and set coercion -/
 
 /--
 This is a predicate that determines whether a given term is a member of a term of the
 symmetric square.  From this point of view, the symmetric square is the subtype of
 cardinality-two multisets on `α`.
 -/
-def mem (x : α) (z : sym2 α) : Prop :=
+protected def mem (x : α) (z : sym2 α) : Prop :=
 ∃ (y : α), z = ⟦(x, y)⟧
 
-instance : has_mem α (sym2 α) := ⟨mem⟩
+lemma mem_iff' {a b c : α} : sym2.mem a ⟦(b, c)⟧ ↔ a = b ∨ a = c :=
+{ mp  := by { rintro ⟨_, h⟩, rw eq_iff at h, tidy },
+  mpr := by { rintro (rfl|rfl), { exact ⟨_, rfl⟩ }, rw eq_swap, exact ⟨_, rfl⟩ } }
+
+instance : set_like (sym2 α) α :=
+{ coe := λ z, {x | z.mem x},
+  coe_injective' := λ z z' h, begin
+    simp only [set.ext_iff, set.mem_set_of_eq] at h,
+    induction z using sym2.ind with x y,
+    induction z' using sym2.ind with x' y',
+    have hx := h x, have hy := h y, have hx' := h x', have hy' := h y',
+    simp only [mem_iff', eq_self_iff_true, or_true, iff_true, true_or, true_iff] at hx hy hx' hy',
+    cases hx; cases hy; cases hx'; cases hy'; subst_vars,
+    rw [sym2.eq_swap],
+  end }
+
+@[simp] lemma mem_iff_mem {x : α} {z : sym2 α} : sym2.mem x z ↔ x ∈ z := iff.rfl
+
+lemma mem_iff_exists {x : α} {z : sym2 α} : x ∈ z ↔ ∃ (y : α), z = ⟦(x, y)⟧ := iff.rfl
+
+@[ext] theorem ext {p q : sym2 α} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q := set_like.ext h
 
 lemma mem_mk_left (x y : α) : x ∈ ⟦(x, y)⟧ := ⟨y, rfl⟩
 lemma mem_mk_right (x y : α) : y ∈ ⟦(x, y)⟧ := eq_swap.subst $ mem_mk_left y x
 
-@[simp] lemma mem_iff {a b c : α} : a ∈ ⟦(b, c)⟧ ↔ a = b ∨ a = c :=
-{ mp  := by { rintro ⟨_, h⟩, rw eq_iff at h, tidy },
-  mpr := by { rintro ⟨_⟩; subst a, { apply mem_mk_left }, apply mem_mk_right } }
+@[simp] lemma mem_iff {a b c : α} : a ∈ ⟦(b, c)⟧ ↔ a = b ∨ a = c := mem_iff'
 
 lemma out_fst_mem (e : sym2 α) : e.out.1 ∈ e := ⟨e.out.2, by rw [prod.mk.eta, e.out_eq]⟩
 lemma out_snd_mem (e : sym2 α) : e.out.2 ∈ e := ⟨e.out.1, by rw [eq_swap, prod.mk.eta, e.out_eq]⟩
@@ -227,17 +280,6 @@ lemma eq_of_ne_mem {x y : α} {z z' : sym2 α} (h : x ≠ y)
   (h1 : x ∈ z) (h2 : y ∈ z) (h3 : x ∈ z') (h4 : y ∈ z') : z = z' :=
 ((mem_and_mem_iff h).mp ⟨h1, h2⟩).trans ((mem_and_mem_iff h).mp ⟨h3, h4⟩).symm
 
-@[ext]
-protected lemma ext (z z' : sym2 α) (h : ∀ x, x ∈ z ↔ x ∈ z') : z = z' :=
-begin
-  induction z using sym2.ind with x y,
-  induction z' using sym2.ind with x' y',
-  have hx := h x, have hy := h y, have hx' := h x', have hy' := h y',
-  simp only [mem_iff, eq_self_iff_true, or_true, iff_true, true_or, true_iff] at hx hy hx' hy',
-  cases hx; cases hy; cases hx'; cases hy'; subst_vars,
-  simp only [sym2.eq_swap],
-end
-
 instance mem.decidable [decidable_eq α] (x : α) (z : sym2 α) : decidable (x ∈ z) :=
 quotient.rec_on_subsingleton z (λ ⟨y₁, y₂⟩, decidable_of_iff' _ mem_iff)
 
@@ -333,6 +375,20 @@ lemma from_rel_proj_prop {sym : symmetric r} {z : α × α} : ⟦z⟧ ∈ from_r
 @[simp]
 lemma from_rel_prop {sym : symmetric r} {a b : α} : ⟦(a, b)⟧ ∈ from_rel sym ↔ r a b := iff.rfl
 
+lemma from_rel_bot : from_rel (λ (x y : α) z, z : symmetric ⊥) = ∅ :=
+begin
+  apply set.eq_empty_of_forall_not_mem (λ e, _),
+  refine e.ind _,
+  simp [-set.bot_eq_empty, Prop.bot_eq_false],
+end
+
+lemma from_rel_top : from_rel (λ (x y : α) z, z : symmetric ⊤) = set.univ :=
+begin
+  apply set.eq_univ_of_forall (λ e, _),
+  refine e.ind _,
+  simp [-set.top_eq_univ, Prop.top_eq_true],
+end
+
 lemma from_rel_irreflexive {sym : symmetric r} :
   irreflexive r ↔ ∀ {z}, z ∈ from_rel sym → ¬is_diag z :=
 { mp  := λ h, sym2.ind $ by { rintros a b hr (rfl : a = b), exact h _ hr },
@@ -372,7 +428,7 @@ private def from_vector : vector α 2 → α × α
 
 private lemma perm_card_two_iff {a₁ b₁ a₂ b₂ : α} :
   [a₁, b₁].perm [a₂, b₂] ↔ a₁ = a₂ ∧ b₁ = b₂ ∨ a₁ = b₂ ∧ b₁ = a₂ :=
-{ mp  := by { simp [← multiset.coe_eq_coe, ← multiset.cons_coe, multiset.cons_eq_cons]; tidy },
+{ mp  := by { simp [← multiset.coe_eq_coe, ← multiset.cons_coe, multiset.cons_eq_cons], tidy },
   mpr := by { intro h, cases h; rw [h.1, h.2], apply list.perm.swap', refl } }
 
 /--
@@ -483,7 +539,7 @@ begin
   have h' := mem_iff.mp h,
   dsimp [mem.other', quot.rec, pair_other],
   cases h'; subst a,
-  { simp only [if_true, eq_self_iff_true], refl, },
+  { simp only [eq_self_iff_true], refl, },
   { split_ifs, subst h_1, refl, rw eq_swap, refl, },
   refl,
 end
@@ -503,7 +559,7 @@ begin
   split_ifs at hb; dsimp [mem.other', quot.rec, pair_other],
   simp only [h, if_true, eq_self_iff_true],
   split_ifs, assumption, refl,
-  simp only [h, if_false, if_true, eq_self_iff_true],
+  simp only [h, if_false, eq_self_iff_true],
   exact ((mem_iff.mp ha).resolve_left h).symm,
   refl,
 end
@@ -517,7 +573,7 @@ begin
 end
 
 lemma filter_image_quotient_mk_is_diag [decidable_eq α] (s : finset α) :
-  ((s.product s).image quotient.mk).filter is_diag = s.diag.image quotient.mk :=
+  ((s ×ˢ s).image quotient.mk).filter is_diag = s.diag.image quotient.mk :=
 begin
   ext z,
   induction z using quotient.induction_on,
@@ -533,13 +589,13 @@ begin
 end
 
 lemma filter_image_quotient_mk_not_is_diag [decidable_eq α] (s : finset α) :
-  ((s.product s).image quotient.mk).filter (λ a : sym2 α, ¬a.is_diag) =
+  ((s ×ˢ s).image quotient.mk).filter (λ a : sym2 α, ¬a.is_diag) =
     s.off_diag.image quotient.mk :=
 begin
   ext z,
   induction z using quotient.induction_on,
   rcases z with ⟨x, y⟩,
-  simp only [mem_image, mem_off_diag, exists_prop, mem_filter, prod.exists, mem_product],
+  simp only [mem_image, mem_off_diag, mem_filter, prod.exists, mem_product],
   split,
   { rintro ⟨⟨a, b, ⟨ha, hb⟩, h⟩, hab⟩,
     rw [←h, sym2.mk_is_diag_iff] at hab,
diff --git a/src/data/tree.lean b/src/data/tree.lean
index 6e3e388016a30..d2e2981efb571 100644
--- a/src/data/tree.lean
+++ b/src/data/tree.lean
@@ -5,14 +5,22 @@ Authors: Mario Carneiro, Wojciech Nawrocki
 -/
 import data.rbtree.init
 import data.num.basic
+import order.basic
 
 /-!
 # Binary tree
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Provides binary tree storage for values of any type, with O(lg n) retrieval.
 See also `data.rbtree` for red-black trees - this version allows more operations
 to be defined and is better suited for in-kernel computation.
 
+We also specialize for `tree unit`, which is a binary tree without any
+additional data. We provide the notation `a △ b` for making a `tree unit` with children
+`a` and `b`.
+
 ## References
 
 
@@ -81,4 +89,56 @@ def map {β} (f : α → β) : tree α → tree β
 | nil := nil
 | (node a l r) := node (f a) (map l) (map r)
 
+/-- The number of internal nodes (i.e. not including leaves) of a binary tree -/
+@[simp] def num_nodes : tree α → ℕ
+| nil := 0
+| (node _ a b) := a.num_nodes + b.num_nodes + 1
+
+/-- The number of leaves of a binary tree -/
+@[simp] def num_leaves : tree α → ℕ
+| nil := 1
+| (node _ a b) := a.num_leaves + b.num_leaves
+
+/-- The height - length of the longest path from the root - of a binary tree -/
+@[simp] def height : tree α → ℕ
+| nil := 0
+| (node _ a b) := max a.height b.height + 1
+
+lemma num_leaves_eq_num_nodes_succ (x : tree α) : x.num_leaves = x.num_nodes + 1 :=
+by { induction x; simp [*, nat.add_comm, nat.add_assoc, nat.add_left_comm], }
+
+lemma num_leaves_pos (x : tree α) : 0 < x.num_leaves :=
+by { rw num_leaves_eq_num_nodes_succ, exact x.num_nodes.zero_lt_succ, }
+
+lemma height_le_num_nodes : ∀ (x : tree α), x.height ≤ x.num_nodes
+| nil := le_rfl
+| (node _ a b) := nat.succ_le_succ
+    (max_le
+      (trans a.height_le_num_nodes $ a.num_nodes.le_add_right _)
+      (trans b.height_le_num_nodes $ b.num_nodes.le_add_left _))
+
+/-- The left child of the tree, or `nil` if the tree is `nil` -/
+@[simp] def left : tree α → tree α
+| nil := nil
+| (node _ l r) := l
+
+/-- The right child of the tree, or `nil` if the tree is `nil` -/
+@[simp] def right : tree α → tree α
+| nil := nil
+| (node _ l r) := r
+
+/- Notation for making a node with `unit` data -/
+localized "infixr ` △ `:65 := tree.node ()" in tree
+
+/-- Recursion on `tree unit`; allows for a better `induction` which does not have to worry
+  about the element of type `α = unit` -/
+@[elab_as_eliminator]
+def unit_rec_on {motive : tree unit → Sort*} (t : tree unit) (base : motive nil)
+  (ind : ∀ x y, motive x → motive y → motive (x △ y)) : motive t :=
+t.rec_on base (λ u, u.rec_on (by exact ind))
+
+lemma left_node_right_eq_self : ∀ {x : tree unit} (hx : x ≠ nil), x.left △ x.right = x
+| nil h := by trivial
+| (a △ b) _ := rfl
+
 end tree
diff --git a/src/data/two_pointing.lean b/src/data/two_pointing.lean
index 3ec9c59b4b4dc..9252b2247314b 100644
--- a/src/data/two_pointing.lean
+++ b/src/data/two_pointing.lean
@@ -9,6 +9,9 @@ import logic.nontrivial
 /-!
 # Two-pointings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `two_pointing α`, the type of two pointings of `α`. A two-pointing is the data of
 two distinct terms.
 
diff --git a/src/data/typevec.lean b/src/data/typevec.lean
index 778f801331ba4..55224d6e7ef0b 100644
--- a/src/data/typevec.lean
+++ b/src/data/typevec.lean
@@ -11,6 +11,9 @@ import tactic.basic
 
 # Tuples of types, and their categorical structure.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Features
 
 * `typevec n` - n-tuples of types
@@ -47,7 +50,7 @@ variable {n : ℕ}
 /-- arrow in the category of `typevec` -/
 def arrow (α β : typevec n) := Π i : fin2 n, α i → β i
 
-localized "infixl ` ⟹ `:40 := typevec.arrow" in mvfunctor
+localized "infixl (name := typevec.arrow) ` ⟹ `:40 := typevec.arrow" in mvfunctor
 
 instance arrow.inhabited (α β : typevec n) [Π i, inhabited (β i)] : inhabited (α ⟹ β) :=
 ⟨ λ _ _, default ⟩
@@ -59,7 +62,7 @@ def id {α : typevec n} : α ⟹ α := λ i x, x
 def comp {α β γ : typevec n} (g : β ⟹ γ) (f : α ⟹ β) : α ⟹ γ :=
 λ i x, g i (f i x)
 
-localized "infixr ` ⊚ `:80 := typevec.comp" in mvfunctor -- type as \oo
+localized "infixr (name := typevec.comp) ` ⊚ `:80 := typevec.comp" in mvfunctor -- type as \oo
 
 @[simp] theorem id_comp {α β : typevec n} (f : α ⟹ β) : id ⊚ f = f :=
 rfl
@@ -77,7 +80,7 @@ def append1 (α : typevec n) (β : Type*) : typevec (n+1)
 | (fin2.fs i) := α i
 | fin2.fz      := β
 
-infixl ` ::: `:67 := append1
+infixl (name := typevec.append1) ` ::: `:67 := append1
 
 /-- retain only a `n-length` prefix of the argument -/
 def drop (α : typevec.{u} (n+1)) : typevec n := λ i, α i.fs
@@ -120,7 +123,7 @@ and target types / typevecs -/
 def append_fun {α α' : typevec n} {β β' : Type*}
   (f : α ⟹ α') (g : β → β') : append1 α β ⟹ append1 α' β' := split_fun f g
 
-infixl ` ::: ` := append_fun
+infixl (name := typevec.append_fun) ` ::: ` := append_fun
 
 /-- split off the prefix of an arrow -/
 def drop_fun {α β : typevec (n+1)} (f : α ⟹ β) : drop α ⟹ drop β :=
@@ -137,7 +140,7 @@ def nil_fun {α : typevec 0} {β : typevec 0} : α ⟹ β :=
 theorem eq_of_drop_last_eq {α β : typevec (n+1)} {f g : α ⟹ β}
   (h₀ : drop_fun f = drop_fun g) (h₁ : last_fun f = last_fun g) : f = g :=
 by replace h₀ := congr_fun h₀;
-   ext1 (ieq | ⟨j, ieq⟩); apply_assumption
+   ext1 ⟨⟩; apply_assumption
 
 @[simp] theorem drop_fun_split_fun {α α' : typevec (n+1)}
   (f : drop α ⟹ drop α') (g : last α → last α') :
@@ -232,11 +235,6 @@ eq_of_drop_last_eq rfl rfl
 instance subsingleton0 : subsingleton (typevec 0) :=
 ⟨ λ a b, funext $ λ a, fin2.elim0 a  ⟩
 
-run_cmd do
-  mk_simp_attr `typevec,
-  tactic.add_doc_string `simp_attr.typevec
-"simp set for the manipulation of typevec and arrow expressions"
-
 local prefix `♯`:0 := cast (by try { simp }; congr' 1; try { simp })
 
 /-- cases distinction for 0-length type vector -/
@@ -334,7 +332,7 @@ def prod : Π {n} (α β : typevec.{u} n), typevec n
 | 0 α β := fin2.elim0
 | (n+1) α β := prod (drop α) (drop β) ::: (last α × last β)
 
-localized "infix ` ⊗ `:45 := typevec.prod" in mvfunctor
+localized "infix (name := typevec.prod) ` ⊗ `:45 := typevec.prod" in mvfunctor
 
 /-- `const x α` is an arrow that ignores its source and constructs a `typevec` that
 contains nothing but `x` -/
@@ -442,7 +440,7 @@ protected def prod.map : Π {n} {α α' β β' : typevec.{u} n}, (α ⟹ β) →
   @prod.map _ (drop α) (drop α') (drop β) (drop β') (drop_fun x) (drop_fun y) _ a
 | (succ n) α α' β β' x y fin2.fz a := (x _ a.1,y _ a.2)
 
-localized "infix ` ⊗' `:45 := typevec.prod.map" in mvfunctor
+localized "infix (name := typevec.prod.map) ` ⊗' `:45 := typevec.prod.map" in mvfunctor
 
 theorem fst_prod_mk {α α' β β' : typevec n} (f : α ⟹ β) (g : α' ⟹ β') :
   typevec.prod.fst ⊚ (f ⊗' g) = f ⊚ typevec.prod.fst :=
@@ -532,7 +530,7 @@ end liftp'
 @[simp]
 lemma drop_fun_diag {α} :
   drop_fun (@prod.diag (n+1) α) = prod.diag :=
-by { ext i : 2, induction i; simp [drop_fun,*]; refl }
+by { ext i : 2, induction i; simp [drop_fun, *]; refl }
 
 @[simp]
 lemma drop_fun_subtype_val {α} (p : α ⟹ repeat (n+1) Prop) :
@@ -545,22 +543,22 @@ lemma last_fun_subtype_val {α} (p : α ⟹ repeat (n+1) Prop) :
 @[simp]
 lemma drop_fun_to_subtype {α} (p : α ⟹ repeat (n+1) Prop) :
   drop_fun (to_subtype p) = to_subtype _ :=
-by { ext i : 2, induction i; simp [drop_fun,*]; refl }
+by { ext i : 2, induction i; simp [drop_fun, *]; refl }
 
 @[simp]
 lemma last_fun_to_subtype {α} (p : α ⟹ repeat (n+1) Prop) :
   last_fun (to_subtype p) = _root_.id :=
-by { ext i : 2, induction i; simp [drop_fun,*]; refl }
+by { ext i : 2, induction i; simp [drop_fun, *]; refl }
 
 @[simp]
 lemma drop_fun_of_subtype {α} (p : α ⟹ repeat (n+1) Prop) :
   drop_fun (of_subtype p) = of_subtype _ :=
-by { ext i : 2, induction i; simp [drop_fun,*]; refl }
+by { ext i : 2, induction i; simp [drop_fun, *]; refl }
 
 @[simp]
 lemma last_fun_of_subtype {α} (p : α ⟹ repeat (n+1) Prop) :
   last_fun (of_subtype p) = _root_.id :=
-by { ext i : 2, induction i; simp [drop_fun,*]; refl }
+by { ext i : 2, induction i; simp [drop_fun, *]; refl }
 
 @[simp]
 lemma drop_fun_rel_last {α : typevec n} {β}
@@ -573,12 +571,12 @@ open_locale mvfunctor
 @[simp]
 lemma drop_fun_prod {α α' β β' : typevec (n+1)} (f : α ⟹ β) (f' : α' ⟹ β') :
   drop_fun (f ⊗' f') = (drop_fun f ⊗' drop_fun f') :=
-by { ext i : 2, induction i; simp [drop_fun,*]; refl }
+by { ext i : 2, induction i; simp [drop_fun, *]; refl }
 
 @[simp]
 lemma last_fun_prod {α α' β β' : typevec (n+1)} (f : α ⟹ β) (f' : α' ⟹ β') :
   last_fun (f ⊗' f') = _root_.prod.map (last_fun f) (last_fun f') :=
-by { ext i : 1, induction i; simp [last_fun,*]; refl }
+by { ext i : 1, induction i; simp [last_fun, *]; refl }
 
 @[simp]
 lemma drop_fun_from_append1_drop_last {α : typevec (n+1)} :
@@ -595,7 +593,7 @@ lemma drop_fun_id {α : typevec (n+1)} :
 @[simp]
 lemma prod_map_id {α β : typevec n} :
   (@typevec.id _ α ⊗' @typevec.id _ β) = id :=
-by { ext i : 2, induction i; simp only [typevec.prod.map,*,drop_fun_id],
+by { ext i : 2, induction i; simp only [typevec.prod.map, *, drop_fun_id],
      cases x, refl, refl }
 
 @[simp]
diff --git a/src/data/ulift.lean b/src/data/ulift.lean
index 85151cf64cc94..5384eb374deed 100644
--- a/src/data/ulift.lean
+++ b/src/data/ulift.lean
@@ -8,27 +8,41 @@ import logic.equiv.basic
 /-!
 # Extra lemmas about `ulift` and `plift`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we provide `subsingleton`, `unique`, `decidable_eq`, and `is_empty` instances for
 `ulift α` and `plift α`. We also prove `ulift.forall`, `ulift.exists`, `plift.forall`, and
 `plift.exists`.
 -/
 
 universes u v
+open function
 
 namespace plift
 
 variables {α : Sort u} {β : Sort v}
 
 instance [subsingleton α] : subsingleton (plift α) := equiv.plift.subsingleton
+instance [nonempty α] : nonempty (plift α) := equiv.plift.nonempty
 instance [unique α] : unique (plift α) := equiv.plift.unique
 instance [decidable_eq α] : decidable_eq (plift α) := equiv.plift.decidable_eq
 instance [is_empty α] : is_empty (plift α) := equiv.plift.is_empty
 
+lemma up_injective : injective (@up α) := equiv.plift.symm.injective
+lemma up_surjective : surjective (@up α) := equiv.plift.symm.surjective
+lemma up_bijective : bijective (@up α) := equiv.plift.symm.bijective
+
+@[simp] lemma up_inj {x y : α} : up x = up y ↔ x = y := up_injective.eq_iff
+
+lemma down_surjective : surjective (@down α) := equiv.plift.surjective
+lemma down_bijective : bijective (@down α) := equiv.plift.bijective
+
 @[simp] lemma «forall» {p : plift α → Prop} : (∀ x, p x) ↔ ∀ x : α, p (plift.up x) :=
-equiv.plift.forall_congr_left'
+up_surjective.forall
 
 @[simp] lemma «exists» {p : plift α → Prop} : (∃ x, p x) ↔ ∃ x : α, p (plift.up x) :=
-equiv.plift.exists_congr_left
+up_surjective.exists
 
 end plift
 
@@ -37,14 +51,24 @@ namespace ulift
 variables {α : Type u} {β : Type v}
 
 instance [subsingleton α] : subsingleton (ulift α) := equiv.ulift.subsingleton
+instance [nonempty α] : nonempty (ulift α) := equiv.ulift.nonempty
 instance [unique α] : unique (ulift α) := equiv.ulift.unique
 instance [decidable_eq α] : decidable_eq (ulift α) := equiv.ulift.decidable_eq
 instance [is_empty α] : is_empty (ulift α) := equiv.ulift.is_empty
 
+lemma up_injective : injective (@up α) := equiv.ulift.symm.injective
+lemma up_surjective : surjective (@up α) := equiv.ulift.symm.surjective
+lemma up_bijective : bijective (@up α) := equiv.ulift.symm.bijective
+
+@[simp] lemma up_inj {x y : α} : up x = up y ↔ x = y := up_injective.eq_iff
+
+lemma down_surjective : surjective (@down α) := equiv.ulift.surjective
+lemma down_bijective : bijective (@down α) := equiv.ulift.bijective
+
 @[simp] lemma «forall» {p : ulift α → Prop} : (∀ x, p x) ↔ ∀ x : α, p (ulift.up x) :=
-equiv.ulift.forall_congr_left'
+up_surjective.forall
 
 @[simp] lemma «exists» {p : ulift α → Prop} : (∃ x, p x) ↔ ∃ x : α, p (ulift.up x) :=
-equiv.ulift.exists_congr_left
+up_surjective.exists
 
 end ulift
diff --git a/src/data/vector/basic.lean b/src/data/vector/basic.lean
index 006431584bc1b..f60d184892f4d 100644
--- a/src/data/vector/basic.lean
+++ b/src/data/vector/basic.lean
@@ -7,9 +7,13 @@ import data.vector
 import data.list.nodup
 import data.list.of_fn
 import control.applicative
+import meta.univs
 /-!
 # Additional theorems and definitions about the `vector` type
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file introduces the infix notation `::ᵥ` for `vector.cons`.
 -/
 universes u
@@ -18,12 +22,12 @@ variables {n : ℕ}
 namespace vector
 variables {α : Type*}
 
-infixr `::ᵥ`:67  := vector.cons
+infixr ` ::ᵥ `:67  := vector.cons
 
 attribute [simp] head_cons tail_cons
 
 instance [inhabited α] : inhabited (vector α n) :=
-⟨of_fn (λ _, default)⟩
+⟨of_fn default⟩
 
 theorem to_list_injective : function.injective (@to_list α n) :=
 subtype.val_injective
@@ -34,6 +38,10 @@ subtype.val_injective
 | ⟨v, hv⟩ ⟨w, hw⟩ h := subtype.eq (list.ext_le (by rw [hv, hw])
   (λ m hm hn, h ⟨m, hv ▸ hm⟩))
 
+/-- A vector with `n` elements `a`. -/
+def replicate (n : ℕ) (a : α) : vector α n :=
+⟨list.replicate n a, list.length_replicate n a⟩
+
 /-- The empty `vector` is a `subsingleton`. -/
 instance zero_subsingleton : subsingleton (vector α 0) :=
 ⟨λ _ _, vector.ext (λ m, fin.elim0 m)⟩
@@ -47,6 +55,19 @@ instance zero_subsingleton : subsingleton (vector α 0) :=
 @[simp] theorem cons_tail (a : α) : ∀ (v : vector α n), (a ::ᵥ v).tail = v
 | ⟨_, _⟩ := rfl
 
+lemma eq_cons_iff (a : α) (v : vector α n.succ) (v' : vector α n) :
+  v = a ::ᵥ v' ↔ v.head = a ∧ v.tail = v' :=
+⟨λ h, h.symm ▸ ⟨head_cons a v', tail_cons a v'⟩,
+ λ h, trans (cons_head_tail v).symm (by rw [h.1, h.2])⟩
+
+lemma ne_cons_iff (a : α) (v : vector α n.succ) (v' : vector α n) :
+  v ≠ a ::ᵥ v' ↔ v.head ≠ a ∨ v.tail ≠ v' :=
+by rw [ne.def, eq_cons_iff a v v', not_and_distrib]
+
+lemma exists_eq_cons (v : vector α n.succ) :
+  ∃ (a : α) (as : vector α n), v = a ::ᵥ as :=
+⟨v.head, v.tail, (eq_cons_iff v.head v v.tail).2 ⟨rfl, rfl⟩⟩
+
 @[simp] theorem to_list_of_fn : ∀ {n} (f : fin n → α), to_list (of_fn f) = list.of_fn f
 | 0     f := rfl
 | (n+1) f := by rw [of_fn, list.of_fn_succ, to_list_cons, to_list_of_fn]
@@ -63,14 +84,28 @@ v.2
 @[simp] lemma to_list_map {β : Type*} (v : vector α n) (f : α → β) : (v.map f).to_list =
   v.to_list.map f := by cases v; refl
 
+@[simp] lemma head_map {β : Type*} (v : vector α (n + 1)) (f : α → β) :
+  (v.map f).head = f v.head :=
+begin
+  obtain ⟨a, v', h⟩ := vector.exists_eq_cons v,
+  rw [h, map_cons, head_cons, head_cons],
+end
+
+@[simp] lemma tail_map {β : Type*} (v : vector α (n + 1)) (f : α → β) :
+  (v.map f).tail = v.tail.map f :=
+begin
+  obtain ⟨a, v', h⟩ := vector.exists_eq_cons v,
+  rw [h, map_cons, tail_cons, tail_cons],
+end
+
 theorem nth_eq_nth_le : ∀ (v : vector α n) (i),
   nth v i = v.to_list.nth_le i.1 (by rw to_list_length; exact i.2)
 | ⟨l, h⟩ i := rfl
 
 @[simp]
-lemma nth_repeat (a : α) (i : fin n) :
-  (vector.repeat a n).nth i = a :=
-by apply list.nth_le_repeat
+lemma nth_replicate (a : α) (i : fin n) :
+  (vector.replicate n a).nth i = a :=
+list.nth_le_replicate _ _
 
 @[simp] lemma nth_map {β : Type*} (v : vector α n) (f : α → β) (i : fin n) :
   (v.map f).nth i = f (v.nth i) :=
@@ -115,6 +150,8 @@ by simp only [←cons_head_tail, eq_iff_true_of_subsingleton]
   tail (of_fn f) = of_fn (λ i, f i.succ) :=
 (of_fn_nth _).symm.trans $ by { congr, funext i, cases i, simp, }
 
+@[simp] theorem to_list_empty (v : vector α 0) : v.to_list = [] := list.length_eq_zero.mp v.2
+
 /-- The list that makes up a `vector` made up of a single element,
 retrieved via `to_list`, is equal to the list of that single element. -/
 @[simp] lemma to_list_singleton (v : vector α 1) : v.to_list = [v.head] :=
@@ -124,15 +161,16 @@ begin
              and_self, singleton_tail]
 end
 
+@[simp] lemma empty_to_list_eq_ff (v : vector α (n + 1)) : v.to_list.empty = ff :=
+match v with | ⟨a :: as, _⟩ := rfl end
+
+lemma not_empty_to_list (v : vector α (n + 1)) : ¬ v.to_list.empty :=
+by simp only [empty_to_list_eq_ff, coe_sort_ff, not_false_iff]
+
 /-- Mapping under `id` does not change a vector. -/
 @[simp] lemma map_id {n : ℕ} (v : vector α n) : vector.map id v = v :=
   vector.eq _ _ (by simp only [list.map_id, vector.to_list_map])
 
-lemma mem_iff_nth {a : α} {v : vector α n} : a ∈ v.to_list ↔ ∃ i, v.nth i = a :=
-by simp only [list.mem_iff_nth_le, fin.exists_iff, vector.nth_eq_nth_le];
-  exact ⟨λ ⟨i, hi, h⟩, ⟨i, by rwa to_list_length at hi, h⟩,
-    λ ⟨i, hi, h⟩, ⟨i, by rwa to_list_length, h⟩⟩
-
 lemma nodup_iff_nth_inj {v : vector α n} : v.to_list.nodup ↔ function.injective v.nth :=
 begin
   cases v with l hl,
@@ -145,9 +183,6 @@ begin
     have := @h ⟨i, hi⟩ ⟨j, hj⟩, simp [nth_eq_nth_le] at *, tauto }
 end
 
-@[simp] lemma nth_mem (i : fin n) (v : vector α n) : v.nth i ∈ v.to_list :=
-by rw [nth_eq_nth_le]; exact list.nth_le_mem _ _ _
-
 theorem head'_to_list : ∀ (v : vector α n.succ),
   (to_list v).head' = some (head v)
 | ⟨a::l, e⟩ := rfl
@@ -320,9 +355,11 @@ def mmap {m} [monad m] {α} {β : Type u} (f : α → m β) :
 /-- Define `C v` by induction on `v : vector α n`.
 
 This function has two arguments: `h_nil` handles the base case on `C nil`,
-and `h_cons` defines the inductive step using `∀ x : α, C w → C (x ::ᵥ w)`. -/
+and `h_cons` defines the inductive step using `∀ x : α, C w → C (x ::ᵥ w)`.
+
+This can be used as `induction v using vector.induction_on`. -/
 @[elab_as_eliminator] def induction_on {C : Π {n : ℕ}, vector α n → Sort*}
-  (v : vector α n)
+  {n : ℕ} (v : vector α n)
   (h_nil : C nil)
   (h_cons : ∀ {n : ℕ} {x : α} {w : vector α n}, C w → C (x ::ᵥ w)) :
     C v :=
@@ -336,6 +373,9 @@ begin
     apply ih, }
 end
 
+-- check that the above works with `induction ... using`
+example (v : vector α n) : true := by induction v using vector.induction_on; trivial
+
 variables {β γ : Type*}
 
 /-- Define `C v w` by induction on a pair of vectors `v : vector α n` and `w : vector β n`. -/
@@ -564,4 +604,10 @@ instance : is_lawful_traversable.{u} (flip vector n) :=
   id_map := by intros; cases x; simp! [(<$>)],
   comp_map := by intros; cases x; simp! [(<$>)] }
 
+meta instance reflect [reflected_univ.{u}] {α : Type u} [has_reflect α] [reflected _ α] {n : ℕ} :
+  has_reflect (vector α n) :=
+λ v, @vector.induction_on α (λ n, reflected _) n v
+  ((by reflect_name : reflected _ @vector.nil.{u}).subst `(α))
+  (λ n x xs ih, (by reflect_name : reflected _ @vector.cons.{u}).subst₄ `(α) `(n) `(x) ih)
+
 end vector
diff --git a/src/data/vector/mem.lean b/src/data/vector/mem.lean
new file mode 100644
index 0000000000000..3a3d4503deb58
--- /dev/null
+++ b/src/data/vector/mem.lean
@@ -0,0 +1,74 @@
+/-
+Copyright (c) 2022 Devon Tuma. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Devon Tuma
+-/
+import data.vector.basic
+/-!
+# Theorems about membership of elements in vectors
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains theorems for membership in a `v.to_list` for a vector `v`.
+Having the length available in the type allows some of the lemmas to be
+  simpler and more general than the original version for lists.
+In particular we can avoid some assumptions about types being `inhabited`,
+  and make more general statements about `head` and `tail`.
+-/
+
+namespace vector
+variables {α β : Type*} {n : ℕ} (a a' : α)
+
+@[simp] lemma nth_mem (i : fin n) (v : vector α n) : v.nth i ∈ v.to_list :=
+by { rw nth_eq_nth_le,  exact list.nth_le_mem _ _ _ }
+
+lemma mem_iff_nth (v : vector α n) : a ∈ v.to_list ↔ ∃ i, v.nth i = a :=
+by simp only [list.mem_iff_nth_le, fin.exists_iff, vector.nth_eq_nth_le];
+  exact ⟨λ ⟨i, hi, h⟩, ⟨i, by rwa to_list_length at hi, h⟩,
+    λ ⟨i, hi, h⟩, ⟨i, by rwa to_list_length, h⟩⟩
+
+lemma not_mem_nil : a ∉ (vector.nil : vector α 0).to_list := id
+
+lemma not_mem_zero (v : vector α 0) : a ∉ v.to_list :=
+(vector.eq_nil v).symm ▸ (not_mem_nil a)
+
+lemma mem_cons_iff (v : vector α n) :
+  a' ∈ (a ::ᵥ v).to_list ↔ a' = a ∨ a' ∈ v.to_list :=
+by rw [vector.to_list_cons, list.mem_cons_iff]
+
+lemma mem_succ_iff (v : vector α (n + 1)) :
+  a ∈ v.to_list ↔ a = v.head ∨ a ∈ v.tail.to_list :=
+begin
+  obtain ⟨a', v', h⟩ := exists_eq_cons v,
+  simp_rw [h, vector.mem_cons_iff, vector.head_cons, vector.tail_cons],
+end
+
+lemma mem_cons_self (v : vector α n) : a ∈ (a ::ᵥ v).to_list :=
+(vector.mem_iff_nth a (a ::ᵥ v)).2 ⟨0, vector.nth_cons_zero a v⟩
+
+@[simp] lemma head_mem (v : vector α (n + 1)) : v.head ∈ v.to_list :=
+(vector.mem_iff_nth v.head v).2 ⟨0, vector.nth_zero v⟩
+
+lemma mem_cons_of_mem (v : vector α n) (ha' : a' ∈ v.to_list) : a' ∈ (a ::ᵥ v).to_list :=
+(vector.mem_cons_iff a a' v).2 (or.inr ha')
+
+lemma mem_of_mem_tail (v : vector α n) (ha : a ∈ v.tail.to_list) : a ∈ v.to_list :=
+begin
+  induction n with n hn,
+  { exact false.elim (vector.not_mem_zero a v.tail ha) },
+  { exact (mem_succ_iff a v).2 (or.inr ha) }
+end
+
+lemma mem_map_iff (b : β) (v : vector α n) (f : α → β) :
+  b ∈ (v.map f).to_list ↔ ∃ (a : α), a ∈ v.to_list ∧ f a = b :=
+by rw [vector.to_list_map, list.mem_map]
+
+lemma not_mem_map_zero (b : β) (v : vector α 0) (f : α → β) : b ∉ (v.map f).to_list :=
+by simpa only [vector.eq_nil v, vector.map_nil, vector.to_list_nil] using list.not_mem_nil b
+
+lemma mem_map_succ_iff (b : β) (v : vector α (n + 1)) (f : α → β) :
+  b ∈ (v.map f).to_list ↔ f v.head = b ∨ ∃ (a : α), a ∈ v.tail.to_list ∧ f a = b :=
+by rw [mem_succ_iff, head_map, tail_map, mem_map_iff, @eq_comm _ b]
+
+end vector
diff --git a/src/data/vector/zip.lean b/src/data/vector/zip.lean
index e47bc9ee582ad..001873b548393 100644
--- a/src/data/vector/zip.lean
+++ b/src/data/vector/zip.lean
@@ -8,6 +8,9 @@ import data.list.zip
 
 /-!
 # The `zip_with` operation on vectors.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 namespace vector
diff --git a/src/data/vector3.lean b/src/data/vector3.lean
index 2d73c296ca089..ac86ca9953c38 100644
--- a/src/data/vector3.lean
+++ b/src/data/vector3.lean
@@ -9,10 +9,13 @@ import tactic.localized
 /-!
 # Alternate definition of `vector` in terms of `fin2`
 
-This file provides a locale `vector3` which overrides `[a, b, c]` notation to create `vector3` not
-`list`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-The `::` notation is overloaded by this file to mean `vector3.cons`.
+This file provides a locale `vector3` which overrides the `[a, b, c]` notation to create a `vector3`
+instead of a `list`.
+
+The `::` notation is also overloaded by this file to mean `vector3.cons`.
 -/
 
 open fin2 nat
@@ -37,8 +40,9 @@ namespace vector3
 /- We do not want to make the following notation global, because then these expressions will be
 overloaded, and only the expected type will be able to disambiguate the meaning. Worse: Lean will
 try to insert a coercion from `vector3 α _` to `list α`, if a list is expected. -/
-localized "notation `[` l:(foldr `, ` (h t, vector3.cons h t) vector3.nil `]`) := l" in vector3
-notation a :: b := cons a b
+localized "notation (name := vector.list)
+  `[` l:(foldr `, ` (h t, vector3.cons h t) vector3.nil `]`) := l" in vector3
+notation (name := vector.cons) a :: b := cons a b
 
 @[simp] lemma cons_fz (a : α) (v : vector3 α n) : (a :: v) fz = a := rfl
 @[simp] lemma cons_fs (a : α) (v : vector3 α n) (i) : (a :: v) (fs i) = v i := rfl
diff --git a/src/data/zmod/algebra.lean b/src/data/zmod/algebra.lean
index 19c6123e6d4de..43e2ea791b9f9 100644
--- a/src/data/zmod/algebra.lean
+++ b/src/data/zmod/algebra.lean
@@ -9,23 +9,31 @@ import algebra.algebra.basic
 
 /-!
 # The `zmod n`-algebra structure on rings whose characteristic divides `n`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 namespace zmod
 
 variables (R : Type*) [ring R]
 
+instance (p : ℕ) : subsingleton (algebra (zmod p) R) :=
+⟨λ x y, algebra.algebra_ext _ _ $ ring_hom.congr_fun $ subsingleton.elim _ _⟩
+
 section
 variables {n : ℕ} (m : ℕ) [char_p R m]
 
-/-- The `zmod n`-algebra structure on rings whose characteristic `m` divides `n` -/
+/-- The `zmod n`-algebra structure on rings whose characteristic `m` divides `n`.
+See note [reducible non-instances]. -/
+@[reducible]
 def algebra' (h : m ∣ n) : algebra (zmod n) R :=
 { smul := λ a r, a * r,
   commutes' := λ a r, show (a * r : R) = r * a,
   begin
     rcases zmod.int_cast_surjective a with ⟨k, rfl⟩,
     show zmod.cast_hom h R k * r = r * zmod.cast_hom h R k,
-    rw ring_hom.map_int_cast,
+    rw map_int_cast,
     exact commute.cast_int_left r k,
   end,
   smul_def' := λ a r, rfl,
@@ -33,11 +41,10 @@ def algebra' (h : m ∣ n) : algebra (zmod n) R :=
 
 end
 
-section
-variables (n : ℕ) [char_p R n]
-
-instance : algebra (zmod n) R := algebra' R n (dvd_refl n)
-
-end
+/-- The `zmod p`-algebra structure on a ring of characteristic `p`. This is not an
+instance since it creates a diamond with `algebra.id`.
+See note [reducible non-instances]. -/
+@[reducible]
+def algebra (p : ℕ) [char_p R p] : algebra (zmod p) R := algebra' R p dvd_rfl
 
 end zmod
diff --git a/src/data/zmod/basic.lean b/src/data/zmod/basic.lean
index e40236ecdc6ec..807cd3aff05e8 100644
--- a/src/data/zmod/basic.lean
+++ b/src/data/zmod/basic.lean
@@ -5,12 +5,16 @@ Authors: Chris Hughes
 -/
 
 import algebra.char_p.basic
-import ring_theory.ideal.operations
+import data.fintype.units
+import data.nat.parity
 import tactic.fin_cases
 
 /-!
 # Integers mod `n`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Definition of the integers mod n, and the field structure on the integers mod p.
 
 
@@ -29,81 +33,11 @@ This is a ring hom if the ring has characteristic dividing `n`
 
 -/
 
-namespace fin
-
-/-!
-## Ring structure on `fin n`
-
-We define a commutative ring structure on `fin n`, but we do not register it as instance.
-Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
-to register the ring structure on `zmod n` as type class instance.
--/
-
-open nat.modeq int
-
-/-- Multiplicative commutative semigroup structure on `fin (n+1)`. -/
-instance (n : ℕ) : comm_semigroup (fin (n+1)) :=
-{ mul_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
-    (calc ((a * b) % (n+1) * c) ≡ a * b * c [MOD (n+1)] : (nat.mod_modeq _ _).mul_right _
-      ... ≡ a * (b * c) [MOD (n+1)] : by rw mul_assoc
-      ... ≡ a * (b * c % (n+1)) [MOD (n+1)] : (nat.mod_modeq _ _).symm.mul_left _),
-  mul_comm := λ ⟨a, _⟩ ⟨b, _⟩,
-    fin.eq_of_veq (show (a * b) % (n+1) = (b * a) % (n+1), by rw mul_comm),
-  ..fin.has_mul }
-
-private lemma left_distrib_aux (n : ℕ) : ∀ a b c : fin (n+1), a * (b + c) = a * b + a * c :=
-λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
-(calc a * ((b + c) % (n+1)) ≡ a * (b + c) [MOD (n+1)] : (nat.mod_modeq _ _).mul_left _
-  ... ≡ a * b + a * c [MOD (n+1)] : by rw mul_add
-  ... ≡ (a * b) % (n+1) + (a * c) % (n+1) [MOD (n+1)] :
-        (nat.mod_modeq _ _).symm.add (nat.mod_modeq _ _).symm)
-
-/-- Commutative ring structure on `fin (n+1)`. -/
-instance (n : ℕ) : comm_ring (fin (n+1)) :=
-{ one_mul := fin.one_mul,
-  mul_one := fin.mul_one,
-  left_distrib := left_distrib_aux n,
-  right_distrib := λ a b c, by rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm]; refl,
-  ..fin.has_one,
-  ..fin.add_comm_group n,
-  ..fin.comm_semigroup n }
-
-end fin
-
-/-- The integers modulo `n : ℕ`. -/
-def zmod : ℕ → Type
-| 0     := ℤ
-| (n+1) := fin (n+1)
+open function
 
 namespace zmod
 
-instance fintype : Π (n : ℕ) [fact (0 < n)], fintype (zmod n)
-| 0     h := false.elim $ nat.not_lt_zero 0 h.1
-| (n+1) _ := fin.fintype (n+1)
-
-instance infinite : infinite (zmod 0) :=
-int.infinite
-
-@[simp] lemma card (n : ℕ) [fintype (zmod n)] : fintype.card (zmod n) = n :=
-begin
-  casesI n,
-  { exfalso, exact not_fintype (zmod 0) },
-  { convert fintype.card_fin (n+1) }
-end
-
-instance decidable_eq : Π (n : ℕ), decidable_eq (zmod n)
-| 0     := int.decidable_eq
-| (n+1) := fin.decidable_eq _
-
-instance has_repr : Π (n : ℕ), has_repr (zmod n)
-| 0     := int.has_repr
-| (n+1) := fin.has_repr _
-
-instance comm_ring : Π (n : ℕ), comm_ring (zmod n)
-| 0     := int.comm_ring
-| (n+1) := fin.comm_ring n
-
-instance inhabited (n : ℕ) : inhabited (zmod n) := ⟨0⟩
+instance : char_zero (zmod 0) := (by apply_instance : char_zero ℤ)
 
 /-- `val a` is a natural number defined as:
   - for `a : zmod 0` it is the absolute value of `a`
@@ -115,14 +49,14 @@ def val : Π {n : ℕ}, zmod n → ℕ
 | 0     := int.nat_abs
 | (n+1) := (coe : fin (n + 1) → ℕ)
 
-lemma val_lt {n : ℕ} [fact (0 < n)] (a : zmod n) : a.val < n :=
+lemma val_lt {n : ℕ} [ne_zero n] (a : zmod n) : a.val < n :=
 begin
   casesI n,
-  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
+  { cases ne_zero.ne 0 rfl },
   exact fin.is_lt a
 end
 
-lemma val_le {n : ℕ} [fact (0 < n)] (a : zmod n) : a.val ≤ n :=
+lemma val_le {n : ℕ} [ne_zero n] (a : zmod n) : a.val ≤ n :=
 a.val_lt.le
 
 @[simp] lemma val_zero : ∀ {n}, (0 : zmod n).val = 0
@@ -137,7 +71,7 @@ by simp [val, int.nat_abs_mul]
 lemma val_nat_cast {n : ℕ} (a : ℕ) : (a : zmod n).val = a % n :=
 begin
   casesI n,
-  { rw [nat.mod_zero, int.nat_cast_eq_coe_nat],
+  { rw [nat.mod_zero],
     exact int.nat_abs_of_nat a, },
   rw ← fin.of_nat_eq_coe,
   refl
@@ -148,12 +82,31 @@ instance (n : ℕ) : char_p (zmod n) n :=
   begin
     intro k,
     cases n,
-    { simp only [int.nat_cast_eq_coe_nat, zero_dvd_iff, int.coe_nat_eq_zero], },
+    { simp only [zero_dvd_iff, int.coe_nat_eq_zero], },
     rw [fin.eq_iff_veq],
     show (k : zmod (n+1)).val = (0 : zmod (n+1)).val ↔ _,
     rw [val_nat_cast, val_zero, nat.dvd_iff_mod_eq_zero],
   end }
 
+@[simp] lemma add_order_of_one (n : ℕ) : add_order_of (1 : zmod n) = n :=
+char_p.eq _ (char_p.add_order_of_one _) (zmod.char_p n)
+
+/--  This lemma works in the case in which `zmod n` is not infinite, i.e. `n ≠ 0`.  The version
+where `a ≠ 0` is `add_order_of_coe'`. -/
+@[simp] lemma add_order_of_coe (a : ℕ) {n : ℕ} (n0 : n ≠ 0) :
+  add_order_of (a : zmod n) = n / n.gcd a :=
+begin
+  cases a,
+  simp [nat.pos_of_ne_zero n0],
+  rw [← nat.smul_one_eq_coe, add_order_of_nsmul' _ a.succ_ne_zero, zmod.add_order_of_one],
+end
+
+/--  This lemma works in the case in which `a ≠ 0`.  The version where
+ `zmod n` is not infinite, i.e. `n ≠ 0`, is `add_order_of_coe`. -/
+@[simp] lemma add_order_of_coe' {a : ℕ} (n : ℕ) (a0 : a ≠ 0) :
+  add_order_of (a : zmod n) = n / n.gcd a :=
+by rw [← nat.smul_one_eq_coe, add_order_of_nsmul' _ a0, zmod.add_order_of_one]
+
 /-- We have that `ring_char (zmod n) = n`. -/
 lemma ring_char_zmod_n (n : ℕ) : ring_char (zmod n) = n :=
 by { rw ring_char.eq_iff, exact zmod.char_p n, }
@@ -169,7 +122,7 @@ section universal_property
 variables {n : ℕ} {R : Type*}
 
 section
-variables [has_zero R] [has_one R] [has_add R] [has_neg R]
+variables [add_group_with_one R]
 
 /-- Cast an integer modulo `n` to another semiring.
 This function is a morphism if the characteristic of `R` divides `n`.
@@ -182,9 +135,16 @@ def cast : Π {n : ℕ}, zmod n → R
 @[priority 900] instance (n : ℕ) : has_coe_t (zmod n) R := ⟨cast⟩
 
 @[simp] lemma cast_zero : ((0 : zmod n) : R) = 0 :=
-by { cases n; refl }
+by cases n; simp
 
-variables {S : Type*} [has_zero S] [has_one S] [has_add S] [has_neg S]
+lemma cast_eq_val [ne_zero n] (a : zmod n) : (a : R) = a.val :=
+begin
+  casesI n,
+  { cases ne_zero.ne 0 rfl },
+  refl,
+end
+
+variables {S : Type*} [add_group_with_one S]
 
 @[simp] lemma _root_.prod.fst_zmod_cast (a : zmod n) : (a : R × S).fst = a :=
 by cases n; simp
@@ -196,26 +156,26 @@ end
 
 /-- So-named because the coercion is `nat.cast` into `zmod`. For `nat.cast` into an arbitrary ring,
 see `zmod.nat_cast_val`. -/
-lemma nat_cast_zmod_val {n : ℕ} [fact (0 < n)] (a : zmod n) : (a.val : zmod n) = a :=
+lemma nat_cast_zmod_val {n : ℕ} [ne_zero n] (a : zmod n) : (a.val : zmod n) = a :=
 begin
   casesI n,
-  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
+  { cases ne_zero.ne 0 rfl },
   { apply fin.coe_coe_eq_self }
 end
 
-lemma nat_cast_right_inverse [fact (0 < n)] : function.right_inverse val (coe : ℕ → zmod n) :=
+lemma nat_cast_right_inverse [ne_zero n] : function.right_inverse val (coe : ℕ → zmod n) :=
 nat_cast_zmod_val
 
-lemma nat_cast_zmod_surjective [fact (0 < n)] : function.surjective (coe : ℕ → zmod n) :=
+lemma nat_cast_zmod_surjective [ne_zero n] : function.surjective (coe : ℕ → zmod n) :=
 nat_cast_right_inverse.surjective
 
 /-- So-named because the outer coercion is `int.cast` into `zmod`. For `int.cast` into an arbitrary
 ring, see `zmod.int_cast_cast`. -/
-lemma int_cast_zmod_cast (a : zmod n) : ((a : ℤ) : zmod n) = a :=
+@[norm_cast] lemma int_cast_zmod_cast (a : zmod n) : ((a : ℤ) : zmod n) = a :=
 begin
   cases n,
   { rw [int.cast_id a, int.cast_id a], },
-  { rw [coe_coe, int.nat_cast_eq_coe_nat, int.cast_coe_nat, fin.coe_coe_eq_self] }
+  { rw [coe_coe, int.cast_coe_nat, fin.coe_coe_eq_self] }
 end
 
 lemma int_cast_right_inverse : function.right_inverse (coe : zmod n → ℤ) (coe : ℤ → zmod n) :=
@@ -235,11 +195,11 @@ lemma cast_id' : (coe : zmod n → zmod n) = id := funext (cast_id n)
 variables (R) [ring R]
 
 /-- The coercions are respectively `nat.cast` and `zmod.cast`. -/
-@[simp] lemma nat_cast_comp_val [fact (0 < n)] :
+@[simp] lemma nat_cast_comp_val [ne_zero n] :
   (coe : ℕ → R) ∘ (val : zmod n → ℕ) = coe :=
 begin
   casesI n,
-  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
+  { cases ne_zero.ne 0 rfl },
   refl
 end
 
@@ -253,7 +213,7 @@ end
 
 variables {R}
 
-@[simp] lemma nat_cast_val [fact (0 < n)] (i : zmod n) : (i.val : R) = i :=
+@[simp] lemma nat_cast_val [ne_zero n] (i : zmod n) : (i.val : R) = i :=
 congr_fun (nat_cast_comp_val R) i
 
 @[simp] lemma int_cast_cast (i : zmod n) : ((i : ℤ) : R) = i :=
@@ -264,7 +224,7 @@ lemma coe_add_eq_ite {n : ℕ} (a b : zmod n) :
 begin
   cases n,
   { simp },
-  simp only [coe_coe, fin.coe_add_eq_ite, int.nat_cast_eq_coe_nat,
+  simp only [coe_coe, fin.coe_add_eq_ite,
              ← int.coe_nat_add, ← int.coe_nat_succ, int.coe_nat_le],
   split_ifs with h,
   { exact int.coe_nat_sub h },
@@ -294,7 +254,7 @@ begin
   simp only [coe_coe],
   symmetry,
   erw [fin.coe_add, ← nat.cast_add, ← sub_eq_zero, ← nat.cast_sub (nat.mod_le _ _),
-      @char_p.cast_eq_zero_iff R _ _ m],
+      @char_p.cast_eq_zero_iff R _ m],
   exact h.trans (nat.dvd_sub_mod _),
 end
 
@@ -305,7 +265,7 @@ begin
   simp only [coe_coe],
   symmetry,
   erw [fin.coe_mul, ← nat.cast_mul, ← sub_eq_zero, ← nat.cast_sub (nat.mod_le _ _),
-      @char_p.cast_eq_zero_iff R _ _ m],
+      @char_p.cast_eq_zero_iff R _ m],
   exact h.trans (nat.dvd_sub_mod _),
 end
 
@@ -339,8 +299,7 @@ lemma cast_nat_cast (h : m ∣ n) (k : ℕ) : ((k : zmod n) : R) = k :=
 map_nat_cast (cast_hom h R) k
 
 @[simp, norm_cast]
-lemma cast_int_cast (h : m ∣ n) (k : ℤ) : ((k : zmod n) : R) = k :=
-(cast_hom h R).map_int_cast k
+lemma cast_int_cast (h : m ∣ n) (k : ℤ) : ((k : zmod n) : R) = k := map_int_cast (cast_hom h R) k
 
 end char_dvd
 
@@ -378,7 +337,7 @@ begin
   rw injective_iff_map_eq_zero,
   intro x,
   obtain ⟨k, rfl⟩ := zmod.int_cast_surjective x,
-  rw [ring_hom.map_int_cast, char_p.int_cast_eq_zero_iff R n,
+  rw [map_int_cast, char_p.int_cast_eq_zero_iff R n,
     char_p.int_cast_eq_zero_iff (zmod n) n],
   exact id
 end
@@ -386,9 +345,8 @@ end
 lemma cast_hom_bijective [fintype R] (h : fintype.card R = n) :
   function.bijective (zmod.cast_hom (dvd_refl n) R) :=
 begin
-  haveI : fact (0 < n) :=
+  haveI : ne_zero n :=
   ⟨begin
-    rw [pos_iff_ne_zero],
     intro hn,
     rw hn at h,
     exact (fintype.card_eq_zero_iff.mp h).elim' 0
@@ -402,13 +360,30 @@ of characteristic `n` and cardinality `n`. -/
 noncomputable def ring_equiv [fintype R] (h : fintype.card R = n) : zmod n ≃+* R :=
 ring_equiv.of_bijective _ (zmod.cast_hom_bijective R h)
 
+/-- The identity between `zmod m` and `zmod n` when `m = n`, as a ring isomorphism. -/
+def ring_equiv_congr {m n : ℕ} (h : m = n) : zmod m ≃+* zmod n :=
+begin
+  cases m; cases n,
+  { exact ring_equiv.refl _ },
+  { exfalso, exact n.succ_ne_zero h.symm },
+  { exfalso, exact m.succ_ne_zero h },
+  { exact
+    { map_mul' := λ a b, begin
+        rw [order_iso.to_fun_eq_coe], ext,
+        rw [fin.coe_cast, fin.coe_mul, fin.coe_mul, fin.coe_cast, fin.coe_cast, ← h] end,
+      map_add' := λ a b, begin
+        rw [order_iso.to_fun_eq_coe], ext,
+        rw [fin.coe_cast, fin.coe_add, fin.coe_add, fin.coe_cast, fin.coe_cast, ← h] end,
+      ..fin.cast h } }
+end
+
 end char_eq
 
 end universal_property
 
 lemma int_coe_eq_int_coe_iff (a b : ℤ) (c : ℕ) :
   (a : zmod c) = (b : zmod c) ↔ a ≡ b [ZMOD c] :=
-char_p.int_coe_eq_int_coe_iff (zmod c) c a b
+char_p.int_cast_eq_int_cast (zmod c) c
 
 lemma int_coe_eq_int_coe_iff' (a b : ℤ) (c : ℕ) :
   (a : zmod c) = (b : zmod c) ↔ a % c = b % c :=
@@ -416,20 +391,14 @@ zmod.int_coe_eq_int_coe_iff a b c
 
 lemma nat_coe_eq_nat_coe_iff (a b c : ℕ) :
   (a : zmod c) = (b : zmod c) ↔ a ≡ b [MOD c] :=
-begin
-  convert zmod.int_coe_eq_int_coe_iff a b c,
-  simp [nat.modeq_iff_dvd, int.modeq_iff_dvd],
-end
+by simpa [int.coe_nat_modeq_iff] using zmod.int_coe_eq_int_coe_iff a b c
 
 lemma nat_coe_eq_nat_coe_iff' (a b c : ℕ) :
   (a : zmod c) = (b : zmod c) ↔ a % c = b % c :=
 zmod.nat_coe_eq_nat_coe_iff a b c
 
 lemma int_coe_zmod_eq_zero_iff_dvd (a : ℤ) (b : ℕ) : (a : zmod b) = 0 ↔ (b : ℤ) ∣ a :=
-begin
-  change (a : zmod b) = ((0 : ℤ) : zmod b) ↔ (b : ℤ) ∣ a,
-  rw [zmod.int_coe_eq_int_coe_iff, int.modeq_zero_iff_dvd],
-end
+by rw [← int.cast_zero, zmod.int_coe_eq_int_coe_iff, int.modeq_zero_iff_dvd]
 
 lemma int_coe_eq_int_coe_iff_dvd_sub (a b : ℤ) (c : ℕ) : (a : zmod c) = ↑b ↔ ↑c ∣ b-a :=
 begin
@@ -437,12 +406,9 @@ begin
 end
 
 lemma nat_coe_zmod_eq_zero_iff_dvd (a b : ℕ) : (a : zmod b) = 0 ↔ b ∣ a :=
-begin
-  change (a : zmod b) = ((0 : ℕ) : zmod b) ↔ b ∣ a,
-  rw [zmod.nat_coe_eq_nat_coe_iff, nat.modeq_zero_iff_dvd],
-end
+by rw [← nat.cast_zero, zmod.nat_coe_eq_nat_coe_iff, nat.modeq_zero_iff_dvd]
 
-lemma val_int_cast {n : ℕ} (a : ℤ) [fact (0 < n)] : ↑(a : zmod n).val = a % n :=
+lemma val_int_cast {n : ℕ} (a : ℤ) [ne_zero n] : ↑(a : zmod n).val = a % n :=
 begin
   have hle : (0 : ℤ) ≤ ↑(a : zmod n).val := int.coe_nat_nonneg _,
   have hlt : ↑(a : zmod n).val < (n : ℤ) := int.coe_nat_lt.mpr (zmod.val_lt a),
@@ -454,7 +420,7 @@ lemma coe_int_cast {n : ℕ} (a : ℤ) : ↑(a : zmod n) = a % n :=
 begin
   cases n,
   { rw [int.coe_nat_zero, int.mod_zero, int.cast_id, int.cast_id] },
-  { rw [←val_int_cast, ←int.nat_cast_eq_coe_nat, val, coe_coe] },
+  { rw [←val_int_cast, val, coe_coe] },
 end
 
 @[simp] lemma val_neg_one (n : ℕ) : (-1 : zmod n.succ).val = n :=
@@ -486,7 +452,7 @@ begin
       { exact hk } } },
 end
 
-lemma nat_coe_zmod_eq_iff (p : ℕ) (n : ℕ) (z : zmod p) [fact (0 < p)] :
+lemma nat_coe_zmod_eq_iff (p : ℕ) (n : ℕ) (z : zmod p) [ne_zero p] :
   ↑n = z ↔ ∃ k, n = z.val + p * k :=
 begin
   split,
@@ -497,7 +463,7 @@ begin
     rw [nat.cast_add, nat_cast_zmod_val, nat.cast_mul, nat_cast_self, zero_mul, add_zero] }
 end
 
-lemma int_coe_zmod_eq_iff (p : ℕ) (n : ℤ) (z : zmod p) [fact (0 < p)] :
+lemma int_coe_zmod_eq_iff (p : ℕ) (n : ℤ) (z : zmod p) [ne_zero p] :
   ↑n = z ↔ ∃ k, n = z.val + p * k :=
 begin
   split,
@@ -533,11 +499,11 @@ local attribute [semireducible] int.nonneg
 | (n : ℕ) h := by simp only [int.cast_coe_nat, int.to_nat_coe_nat]
 | -[1+n]  h := false.elim h
 
-lemma val_injective (n : ℕ) [fact (0 < n)] :
+lemma val_injective (n : ℕ) [ne_zero n] :
   function.injective (zmod.val : zmod n → ℕ) :=
 begin
   casesI n,
-  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
+  { cases ne_zero.ne 0 rfl },
   assume a b h,
   ext,
   exact h
@@ -549,10 +515,10 @@ by rw [← nat.cast_one, val_nat_cast]
 lemma val_one (n : ℕ) [fact (1 < n)] : (1 : zmod n).val = 1 :=
 by { rw val_one_eq_one_mod, exact nat.mod_eq_of_lt (fact.out _) }
 
-lemma val_add {n : ℕ} [fact (0 < n)] (a b : zmod n) : (a + b).val = (a.val + b.val) % n :=
+lemma val_add {n : ℕ} [ne_zero n] (a b : zmod n) : (a + b).val = (a.val + b.val) % n :=
 begin
   casesI n,
-  { exfalso, exact nat.not_lt_zero 0 (fact.out _) },
+  { cases ne_zero.ne 0 rfl },
   { apply fin.val_add }
 end
 
@@ -569,6 +535,8 @@ instance nontrivial (n : ℕ) [fact (1 < n)] : nontrivial (zmod n) :=
       ... = (1 : zmod n).val : congr_arg zmod.val h
       ... = 1                : val_one n ⟩⟩
 
+instance nontrivial' : nontrivial (zmod 0) := int.nontrivial
+
 /-- The inversion on `zmod n`.
 It is setup in such a way that `a * a⁻¹` is equal to `gcd a.val n`.
 In particular, if `a` is coprime to `n`, and hence a unit, `a * a⁻¹ = 1`. -/
@@ -588,7 +556,7 @@ lemma mul_inv_eq_gcd {n : ℕ} (a : zmod n) :
 begin
   cases n,
   { calc a * a⁻¹ = a * int.sign a  : rfl
-             ... = a.nat_abs   : by rw [int.mul_sign, int.nat_cast_eq_coe_nat]
+             ... = a.nat_abs   : by rw int.mul_sign
              ... = a.val.gcd 0 : by rw nat.gcd_zero_right; refl },
   { set k := n.succ,
     calc a * a⁻¹ = a * a⁻¹ + k * nat.gcd_b (val a) k : by rw [nat_cast_self, zero_mul, add_zero]
@@ -603,7 +571,7 @@ by conv {to_rhs, rw ← nat.mod_add_div a n}; simp
 lemma eq_iff_modeq_nat (n : ℕ) {a b : ℕ} : (a : zmod n) = b ↔ a ≡ b [MOD n] :=
 begin
   cases n,
-  { simp only [nat.modeq, int.coe_nat_inj', nat.mod_zero, int.nat_cast_eq_coe_nat], },
+  { simp only [nat.modeq, int.coe_nat_inj', nat.mod_zero], },
   { rw [fin.ext_iff, nat.modeq, ← val_nat_cast, ← val_nat_cast], exact iff.rfl, }
 end
 
@@ -657,10 +625,10 @@ lemma inv_mul_of_unit {n : ℕ} (a : zmod n) (h : is_unit a) :
   a⁻¹ * a = 1 :=
 by rw [mul_comm, mul_inv_of_unit a h]
 
+-- TODO: this equivalence is true for `zmod 0 = ℤ`, but needs to use different functions.
 /-- Equivalence between the units of `zmod n` and
 the subtype of terms `x : zmod n` for which `x.val` is comprime to `n` -/
-def units_equiv_coprime {n : ℕ} [fact (0 < n)] :
-  (zmod n)ˣ ≃ {x : zmod n // nat.coprime x.val n} :=
+def units_equiv_coprime {n : ℕ} [ne_zero n] : (zmod n)ˣ ≃ {x : zmod n // nat.coprime x.val n} :=
 { to_fun := λ x, ⟨x, val_coe_unit_coprime x⟩,
   inv_fun := λ x, unit_of_coprime x.1.val x.2,
   left_inv := λ ⟨_, _, _, _⟩, units.ext (nat_cast_zmod_val _),
@@ -687,13 +655,13 @@ have inv : function.left_inverse inv_fun to_fun ∧ function.right_inverse inv_f
     then begin
       rcases h.eq_of_mul_eq_zero hmn0 with ⟨rfl, rfl⟩ | ⟨rfl, rfl⟩;
       simp [inv_fun, to_fun, function.left_inverse, function.right_inverse,
-        ring_hom.eq_int_cast, prod.ext_iff]
+        eq_int_cast, prod.ext_iff]
     end
     else
       begin
-        haveI : fact (0 < (m * n)) := ⟨nat.pos_of_ne_zero hmn0⟩,
-        haveI : fact (0 < m) := ⟨nat.pos_of_ne_zero $ left_ne_zero_of_mul hmn0⟩,
-        haveI : fact (0 < n) := ⟨nat.pos_of_ne_zero $ right_ne_zero_of_mul hmn0⟩,
+        haveI : ne_zero (m * n) := ⟨hmn0⟩,
+        haveI : ne_zero m := ⟨left_ne_zero_of_mul hmn0⟩,
+        haveI : ne_zero n := ⟨right_ne_zero_of_mul hmn0⟩,
         have left_inv : function.left_inverse inv_fun to_fun,
         { intro x,
           dsimp only [dvd_mul_left, dvd_mul_right, zmod.cast_hom_apply, coe_coe, inv_fun, to_fun],
@@ -705,7 +673,7 @@ have inv : function.left_inverse inv_fun to_fun ∧ function.right_inverse inv_f
             (nat.chinese_remainder h (x : zmod m).val (x : zmod n).val).2.right.trans _⟩,
           { rw [← zmod.eq_iff_modeq_nat, zmod.nat_cast_zmod_val, zmod.nat_cast_val] },
           { rw [← zmod.eq_iff_modeq_nat, zmod.nat_cast_zmod_val, zmod.nat_cast_val] } },
-        exact ⟨left_inv, fintype.right_inverse_of_left_inverse_of_card_le left_inv (by simp)⟩,
+        exact ⟨left_inv, left_inv.right_inverse_of_card_le (by simp)⟩,
       end,
 { to_fun := to_fun,
   inv_fun := inv_fun,
@@ -714,26 +682,20 @@ have inv : function.left_inverse inv_fun to_fun ∧ function.right_inverse inv_f
   left_inv := inv.1,
   right_inv := inv.2 }
 
+-- todo: this can be made a `unique` instance.
 instance subsingleton_units : subsingleton ((zmod 2)ˣ) :=
-⟨λ x y, begin
-  ext1,
-  cases x with x xi hx1 hx2,
-  cases y with y yi hy1 hy2,
-  revert hx1 hx2 hy1 hy2,
-  fin_cases x; fin_cases y; simp
-end⟩
+⟨dec_trivial⟩
 
 lemma le_div_two_iff_lt_neg (n : ℕ) [hn : fact ((n : ℕ) % 2 = 1)]
   {x : zmod n} (hx0 : x ≠ 0) : x.val ≤ (n / 2 : ℕ) ↔ (n / 2 : ℕ) < (-x).val :=
 begin
-  haveI npos : fact (0 < n) := ⟨by
-  { apply (nat.eq_zero_or_pos n).resolve_left,
-    unfreezingI { rintro rfl },
+  haveI npos : ne_zero n := ⟨by
+  { unfreezingI { rintro rfl },
     simpa [fact_iff] using hn, }⟩,
   have hn2 : (n : ℕ) / 2 < n := nat.div_lt_of_lt_mul
-    ((lt_mul_iff_one_lt_left npos.1).2 dec_trivial),
+    ((lt_mul_iff_one_lt_left $ ne_zero.pos n).2 dec_trivial),
   have hn2' : (n : ℕ) - n / 2 = n / 2 + 1,
-  { conv {to_lhs, congr, rw [← nat.succ_sub_one n, nat.succ_sub npos.1]},
+  { conv {to_lhs, congr, rw [← nat.succ_sub_one n, nat.succ_sub $ ne_zero.pos n]},
     rw [← nat.two_mul_odd_div_two hn.1, two_mul, ← nat.succ_add, add_tsub_cancel_right], },
   have hxn : (n : ℕ) - x.val < n,
   { rw [tsub_lt_iff_tsub_lt x.val_le le_rfl, tsub_self],
@@ -767,23 +729,42 @@ end
 | 0     a := int.nat_abs_eq_zero
 | (n+1) a := by { rw fin.ext_iff, exact iff.rfl }
 
+lemma neg_eq_self_iff {n : ℕ} (a : zmod n) : -a = a ↔ a = 0 ∨ 2 * a.val = n :=
+begin
+  rw [neg_eq_iff_add_eq_zero, ← two_mul],
+  cases n,
+  { rw [@mul_eq_zero ℤ, @mul_eq_zero ℕ, val_eq_zero],
+    exact ⟨λ h, h.elim dec_trivial or.inl, λ h, or.inr (h.elim id $ λ h, h.elim dec_trivial id)⟩ },
+  conv_lhs
+  { rw [← a.nat_cast_zmod_val, ← nat.cast_two, ← nat.cast_mul, nat_coe_zmod_eq_zero_iff_dvd] },
+  split,
+  { rintro ⟨m, he⟩, cases m,
+    { rw [mul_zero, mul_eq_zero] at he,
+      rcases he with ⟨⟨⟩⟩|he,
+      exact or.inl (a.val_eq_zero.1 he) },
+    cases m, { right, rwa mul_one at he },
+    refine (a.val_lt.not_le $ nat.le_of_mul_le_mul_left _ zero_lt_two).elim,
+    rw [he, mul_comm], apply nat.mul_le_mul_left, dec_trivial },
+  { rintro (rfl|h), { rw [val_zero, mul_zero], apply dvd_zero }, { rw h } },
+end
+
 lemma val_cast_of_lt {n : ℕ} {a : ℕ} (h : a < n) : (a : zmod n).val = a :=
 by rw [val_nat_cast, nat.mod_eq_of_lt h]
 
-lemma neg_val' {n : ℕ} [fact (0 < n)] (a : zmod n) : (-a).val = (n - a.val) % n :=
+lemma neg_val' {n : ℕ} [ne_zero n] (a : zmod n) : (-a).val = (n - a.val) % n :=
 calc (-a).val = val (-a)    % n : by rw nat.mod_eq_of_lt ((-a).val_lt)
           ... = (n - val a) % n : nat.modeq.add_right_cancel' _ (by rw [nat.modeq, ←val_add,
                   add_left_neg, tsub_add_cancel_of_le a.val_le, nat.mod_self, val_zero])
 
-lemma neg_val {n : ℕ} [fact (0 < n)] (a : zmod n) : (-a).val = if a = 0 then 0 else n - a.val :=
+lemma neg_val {n : ℕ} [ne_zero n] (a : zmod n) : (-a).val = if a = 0 then 0 else n - a.val :=
 begin
   rw neg_val',
   by_cases h : a = 0, { rw [if_pos h, h, val_zero, tsub_zero, nat.mod_self] },
   rw if_neg h,
   apply nat.mod_eq_of_lt,
-  apply nat.sub_lt (fact.out (0 < n)),
+  apply nat.sub_lt (ne_zero.pos n),
   contrapose! h,
-  rwa [nat.le_zero_iff, val_eq_zero] at h,
+  rwa [le_zero_iff, val_eq_zero] at h,
 end
 
 /-- `val_min_abs x` returns the integer in the same equivalence class as `x` that is closest to `0`,
@@ -794,15 +775,15 @@ def val_min_abs : Π {n : ℕ}, zmod n → ℤ
 
 @[simp] lemma val_min_abs_def_zero (x : zmod 0) : val_min_abs x = x := rfl
 
-lemma val_min_abs_def_pos {n : ℕ} [fact (0 < n)] (x : zmod n) :
+lemma val_min_abs_def_pos {n : ℕ} [ne_zero n] (x : zmod n) :
   val_min_abs x = if x.val ≤ n / 2 then x.val else x.val - n :=
 begin
   casesI n,
-  { exfalso, exact nat.not_lt_zero 0 (fact.out (0 < 0)) },
+  { cases ne_zero.ne 0 rfl },
   { refl }
 end
 
-@[simp] lemma coe_val_min_abs : ∀ {n : ℕ} (x : zmod n), (x.val_min_abs : zmod n) = x
+@[simp, norm_cast] lemma coe_val_min_abs : ∀ {n : ℕ} (x : zmod n), (x.val_min_abs : zmod n) = x
 | 0       x := int.cast_id x
 | k@(n+1) x :=
 begin
@@ -813,22 +794,60 @@ begin
       sub_zero] }
 end
 
-lemma nat_abs_val_min_abs_le {n : ℕ} [fact (0 < n)] (x : zmod n) : x.val_min_abs.nat_abs ≤ n / 2 :=
+lemma injective_val_min_abs {n : ℕ} : (val_min_abs : zmod n → ℤ).injective :=
+function.injective_iff_has_left_inverse.2 ⟨_, coe_val_min_abs⟩
+
+lemma _root_.nat.le_div_two_iff_mul_two_le {n m : ℕ} : m ≤ n / 2 ↔ (m : ℤ) * 2 ≤ n :=
+by rw [nat.le_div_iff_mul_le zero_lt_two, ← int.coe_nat_le, int.coe_nat_mul, nat.cast_two]
+
+lemma val_min_abs_nonneg_iff {n : ℕ} [ne_zero n] (x : zmod n) :
+  0 ≤ x.val_min_abs ↔ x.val ≤ n / 2 :=
+begin
+  rw [val_min_abs_def_pos], split_ifs,
+  { exact iff_of_true (nat.cast_nonneg _) h },
+  { exact iff_of_false (sub_lt_zero.2 $ int.coe_nat_lt.2 x.val_lt).not_le h },
+end
+
+lemma val_min_abs_mul_two_eq_iff {n : ℕ} (a : zmod n) : a.val_min_abs * 2 = n ↔ 2 * a.val = n :=
 begin
-  rw zmod.val_min_abs_def_pos,
-  split_ifs with h, { exact h },
-  have : (x.val - n : ℤ) ≤ 0,
-  { rw [sub_nonpos, int.coe_nat_le], exact x.val_le, },
-  rw [← int.coe_nat_le, int.of_nat_nat_abs_of_nonpos this, neg_sub],
-  conv_lhs { congr, rw [← nat.mod_add_div n 2, int.coe_nat_add, int.coe_nat_mul,
-    int.coe_nat_bit0, int.coe_nat_one] },
-  suffices : ((n % 2 : ℕ) + (n / 2) : ℤ) ≤ (val x),
-  { rw ← sub_nonneg at this ⊢, apply le_trans this (le_of_eq _), ring },
-  norm_cast,
-  calc (n : ℕ) % 2 + n / 2 ≤ 1 + n / 2 :
-    nat.add_le_add_right (nat.le_of_lt_succ (nat.mod_lt _ dec_trivial)) _
-                       ... ≤ x.val     :
-    by { rw add_comm, exact nat.succ_le_of_lt (lt_of_not_ge h) }
+  cases n, { simp },
+  by_cases a.val ≤ n.succ / 2,
+  { rw [val_min_abs, if_pos h, ← int.coe_nat_inj', nat.cast_mul, nat.cast_two, mul_comm] },
+  apply iff_of_false (λ he, _) (mt _ h),
+  { rw [← a.val_min_abs_nonneg_iff, ← mul_nonneg_iff_left_nonneg_of_pos, he] at h,
+    exacts [h (nat.cast_nonneg _), zero_lt_two] },
+  { rw [mul_comm], exact λ h, (nat.le_div_iff_mul_le zero_lt_two).2 h.le },
+end
+
+lemma val_min_abs_mem_Ioc {n : ℕ} [ne_zero n] (x : zmod n) :
+  x.val_min_abs * 2 ∈ set.Ioc (-n : ℤ) n :=
+begin
+  simp_rw [val_min_abs_def_pos, nat.le_div_two_iff_mul_two_le], split_ifs,
+  { refine ⟨(neg_lt_zero.2 $ by exact_mod_cast ne_zero.pos n).trans_le (mul_nonneg _ _), h⟩,
+    exacts [nat.cast_nonneg _, zero_le_two] },
+  { refine ⟨_, trans (mul_nonpos_of_nonpos_of_nonneg _ zero_le_two) $ nat.cast_nonneg _⟩,
+    { linarith only [h] },
+    { rw [sub_nonpos, int.coe_nat_le], exact x.val_lt.le } },
+end
+
+lemma val_min_abs_spec {n : ℕ} [ne_zero n] (x : zmod n) (y : ℤ) :
+  x.val_min_abs = y ↔ x = y ∧ y * 2 ∈ set.Ioc (-n : ℤ) n :=
+⟨by { rintro rfl, exact ⟨x.coe_val_min_abs.symm, x.val_min_abs_mem_Ioc⟩ }, λ h, begin
+  rw ← sub_eq_zero,
+  apply @int.eq_zero_of_abs_lt_dvd n,
+  { rw [← int_coe_zmod_eq_zero_iff_dvd, int.cast_sub, coe_val_min_abs, h.1, sub_self] },
+  rw [← mul_lt_mul_right (@zero_lt_two ℤ _ _ _ _ _)],
+  nth_rewrite 0 ← abs_eq_self.2 (@zero_le_two ℤ _ _ _ _),
+  rw [← abs_mul, sub_mul, abs_lt], split;
+  linarith only [x.val_min_abs_mem_Ioc.1, x.val_min_abs_mem_Ioc.2, h.2.1, h.2.2],
+end⟩
+
+lemma nat_abs_val_min_abs_le {n : ℕ} [ne_zero n] (x : zmod n) : x.val_min_abs.nat_abs ≤ n / 2 :=
+begin
+  rw [nat.le_div_two_iff_mul_two_le],
+  cases x.val_min_abs.nat_abs_eq,
+  { rw ← h, exact x.val_min_abs_mem_Ioc.2 },
+  { rw [← neg_le_neg_iff, ← neg_mul, ← h], exact x.val_min_abs_mem_Ioc.1.le },
 end
 
 @[simp] lemma val_min_abs_zero : ∀ n, (0 : zmod n).val_min_abs = 0
@@ -839,66 +858,117 @@ end
   x.val_min_abs = 0 ↔ x = 0 :=
 begin
   cases n, { simp },
-  split,
-  { simp only [val_min_abs_def_pos, int.coe_nat_succ],
-    split_ifs with h h; assume h0,
-    { apply val_injective, rwa [int.coe_nat_eq_zero] at h0, },
-    { apply absurd h0, rw sub_eq_zero, apply ne_of_lt, exact_mod_cast x.val_lt } },
-  { rintro rfl, rw val_min_abs_zero }
+  rw ← val_min_abs_zero n.succ,
+  apply injective_val_min_abs.eq_iff,
 end
 
-lemma nat_cast_nat_abs_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) :
+lemma nat_cast_nat_abs_val_min_abs {n : ℕ} [ne_zero n] (a : zmod n) :
   (a.val_min_abs.nat_abs : zmod n) = if a.val ≤ (n : ℕ) / 2 then a else -a :=
 begin
   have : (a.val : ℤ) - n ≤ 0,
     by { erw [sub_nonpos, int.coe_nat_le], exact a.val_le, },
-  rw [zmod.val_min_abs_def_pos],
+  rw [val_min_abs_def_pos],
   split_ifs,
   { rw [int.nat_abs_of_nat, nat_cast_zmod_val] },
-  { rw [← int.cast_coe_nat, int.of_nat_nat_abs_of_nonpos this, int.cast_neg, int.cast_sub],
-    rw [int.cast_coe_nat, int.cast_coe_nat, nat_cast_self, sub_zero, nat_cast_zmod_val], }
+  { rw [← int.cast_coe_nat, int.of_nat_nat_abs_of_nonpos this, int.cast_neg, int.cast_sub,
+      int.cast_coe_nat, int.cast_coe_nat, nat_cast_self, sub_zero, nat_cast_zmod_val], }
+end
+
+lemma val_min_abs_neg_of_ne_half {n : ℕ} {a : zmod n} (ha : 2 * a.val ≠ n) :
+  (-a).val_min_abs = -a.val_min_abs :=
+begin
+  casesI eq_zero_or_ne_zero n, { subst h, refl },
+  refine (val_min_abs_spec _ _).2 ⟨_, _, _⟩,
+  { rw [int.cast_neg, coe_val_min_abs] },
+  { rw [neg_mul, neg_lt_neg_iff],
+    exact a.val_min_abs_mem_Ioc.2.lt_of_ne (mt a.val_min_abs_mul_two_eq_iff.1 ha) },
+  { linarith only [a.val_min_abs_mem_Ioc.1] },
 end
 
 @[simp] lemma nat_abs_val_min_abs_neg {n : ℕ} (a : zmod n) :
   (-a).val_min_abs.nat_abs = a.val_min_abs.nat_abs :=
 begin
-  cases n, { simp only [int.nat_abs_neg, val_min_abs_def_zero], },
-  by_cases ha0 : a = 0, { rw [ha0, neg_zero] },
-  by_cases haa : -a = a, { rw [haa] },
-  suffices hpa : (n+1 : ℕ) - a.val ≤ (n+1) / 2 ↔ (n+1 : ℕ) / 2 < a.val,
-  { rw [val_min_abs_def_pos, val_min_abs_def_pos],
-    rw ← not_le at hpa,
-    simp only [if_neg ha0, neg_val, hpa, int.coe_nat_sub a.val_le],
-    split_ifs,
-    all_goals { rw [← int.nat_abs_neg], congr' 1, ring } },
-  suffices : (((n+1 : ℕ) % 2) + 2 * ((n + 1) / 2)) - a.val ≤ (n+1) / 2 ↔ (n+1 : ℕ) / 2 < a.val,
-  by rwa [nat.mod_add_div] at this,
-  suffices : (n + 1) % 2 + (n + 1) / 2 ≤ val a ↔ (n + 1) / 2 < val a,
-  by rw [tsub_le_iff_tsub_le, two_mul, ← add_assoc, add_tsub_cancel_right, this],
-  cases (n + 1 : ℕ).mod_two_eq_zero_or_one with hn0 hn1,
-  { split,
-    { assume h,
-      apply lt_of_le_of_ne (le_trans (nat.le_add_left _ _) h),
-      contrapose! haa,
-      rw [← zmod.nat_cast_zmod_val a, ← haa, neg_eq_iff_add_eq_zero, ← nat.cast_add],
-      rw [char_p.cast_eq_zero_iff (zmod (n+1)) (n+1)],
-      rw [← two_mul, ← zero_add (2 * _), ← hn0, nat.mod_add_div] },
-    { rw [hn0, zero_add], exact le_of_lt } },
-  { rw [hn1, add_comm, nat.succ_le_iff] }
-end
-
-lemma val_eq_ite_val_min_abs {n : ℕ} [fact (0 < n)] (a : zmod n) :
+  by_cases h2a : 2 * a.val = n,
+  { rw a.neg_eq_self_iff.2 (or.inr h2a) },
+  { rw [val_min_abs_neg_of_ne_half h2a, int.nat_abs_neg] }
+end
+
+lemma val_eq_ite_val_min_abs {n : ℕ} [ne_zero n] (a : zmod n) :
   (a.val : ℤ) = a.val_min_abs + if a.val ≤ n / 2 then 0 else n :=
-by { rw [zmod.val_min_abs_def_pos], split_ifs; simp only [add_zero, sub_add_cancel] }
+by { rw val_min_abs_def_pos, split_ifs; simp only [add_zero, sub_add_cancel] }
 
 lemma prime_ne_zero (p q : ℕ) [hp : fact p.prime] [hq : fact q.prime] (hpq : p ≠ q) :
   (q : zmod p) ≠ 0 :=
 by rwa [← nat.cast_zero, ne.def, eq_iff_modeq_nat, nat.modeq_zero_iff_dvd,
   ← hp.1.coprime_iff_not_dvd, nat.coprime_primes hp.1 hq.1]
 
-end zmod
+variables {n a : ℕ}
 
-namespace zmod
+lemma val_min_abs_nat_abs_eq_min {n : ℕ} [hpos : ne_zero n] (a : zmod n) :
+  a.val_min_abs.nat_abs = min a.val (n - a.val) :=
+begin
+  rw val_min_abs_def_pos,
+  split_ifs with h h,
+  { rw int.nat_abs_of_nat, symmetry,
+    apply min_eq_left (le_trans h (le_trans
+      (nat.half_le_of_sub_le_half _) (nat.sub_le_sub_left n h))),
+    rw nat.sub_sub_self (nat.div_le_self _ _) },
+  { rw [←int.nat_abs_neg, neg_sub, ←nat.cast_sub a.val_le], symmetry,
+    apply min_eq_right (le_trans (le_trans (nat.sub_le_sub_left n (lt_of_not_ge h))
+      (nat.le_half_of_half_lt_sub _)) (le_of_not_ge h)),
+    rw nat.sub_sub_self (nat.div_lt_self (lt_of_le_of_ne' (nat.zero_le _) hpos.1) one_lt_two),
+    apply nat.lt_succ_self }
+end
+
+lemma val_min_abs_nat_cast_of_le_half (ha : a ≤ n / 2) : (a : zmod n).val_min_abs = a :=
+begin
+  cases n,
+  { simp },
+  { simp [val_min_abs_def_pos, val_nat_cast,
+      nat.mod_eq_of_lt (ha.trans_lt $ nat.div_lt_self' _ 0), ha] }
+end
+
+lemma val_min_abs_nat_cast_of_half_lt (ha : n / 2 < a) (ha' : a < n) :
+  (a : zmod n).val_min_abs = a - n :=
+begin
+  cases n,
+  { cases not_lt_bot ha' },
+  { simp [val_min_abs_def_pos, val_nat_cast, nat.mod_eq_of_lt ha', ha.not_le] }
+end
+
+@[simp] lemma val_min_nat_abs_nat_cast_eq_self [ne_zero n] :
+  (a : zmod n).val_min_abs = a ↔ a ≤ n / 2 :=
+begin
+  refine ⟨λ ha, _, val_min_abs_nat_cast_of_le_half⟩,
+  rw [←int.nat_abs_of_nat a, ←ha],
+  exact nat_abs_val_min_abs_le a,
+end
+
+lemma nat_abs_min_of_le_div_two (n : ℕ) (x y : ℤ)
+  (he : (x : zmod n) = y) (hl : x.nat_abs ≤ n / 2) : x.nat_abs ≤ y.nat_abs :=
+begin
+  rw int_coe_eq_int_coe_iff_dvd_sub at he,
+  obtain ⟨m, he⟩ := he,
+  rw sub_eq_iff_eq_add at he,
+  subst he,
+  obtain rfl|hm := eq_or_ne m 0,
+  { rw [mul_zero, zero_add] },
+  apply hl.trans,
+  rw ← add_le_add_iff_right x.nat_abs,
+  refine trans (trans ((add_le_add_iff_left _).2 hl) _) (int.nat_abs_sub_le _ _),
+  rw [add_sub_cancel, int.nat_abs_mul, int.nat_abs_of_nat],
+  refine trans _ (nat.le_mul_of_pos_right $ int.nat_abs_pos_of_ne_zero hm),
+  rw ← mul_two, apply nat.div_mul_le_self,
+end
+
+lemma nat_abs_val_min_abs_add_le {n : ℕ} (a b : zmod n) :
+  (a + b).val_min_abs.nat_abs ≤ (a.val_min_abs + b.val_min_abs).nat_abs :=
+begin
+  cases n, { refl },
+  apply nat_abs_min_of_le_div_two n.succ,
+  { simp_rw [int.cast_add, coe_val_min_abs] },
+  { apply nat_abs_val_min_abs_le },
+end
 
 variables (p : ℕ) [fact p.prime]
 
diff --git a/src/data/zmod/coprime.lean b/src/data/zmod/coprime.lean
new file mode 100644
index 0000000000000..967b2ffe4df5b
--- /dev/null
+++ b/src/data/zmod/coprime.lean
@@ -0,0 +1,37 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import data.zmod.basic
+import ring_theory.int.basic
+
+/-!
+# Coprimality and vanishing
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We show that for prime `p`, the image of an integer `a` in `zmod p` vanishes if and only if
+`a` and `p` are not coprime.
+-/
+
+namespace zmod
+
+/-- If `p` is a prime and `a` is an integer, then `a : zmod p` is zero if and only if
+`gcd a p ≠ 1`. -/
+lemma eq_zero_iff_gcd_ne_one {a : ℤ} {p : ℕ} [pp : fact p.prime] : (a : zmod p) = 0 ↔ a.gcd p ≠ 1 :=
+by rw [ne, int.gcd_comm, int.gcd_eq_one_iff_coprime,
+       (nat.prime_iff_prime_int.1 pp.1).coprime_iff_not_dvd, not_not, int_coe_zmod_eq_zero_iff_dvd]
+
+/-- If an integer `a` and a prime `p` satisfy `gcd a p = 1`, then `a : zmod p` is nonzero. -/
+lemma ne_zero_of_gcd_eq_one {a : ℤ} {p : ℕ} (pp : p.prime) (h : a.gcd p = 1) :
+  (a : zmod p) ≠ 0 :=
+mt (@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mp (not_not.mpr h)
+
+/-- If an integer `a` and a prime `p` satisfy `gcd a p ≠ 1`, then `a : zmod p` is zero. -/
+lemma eq_zero_of_gcd_ne_one {a : ℤ} {p : ℕ} (pp : p.prime) (h : a.gcd p ≠ 1) :
+  (a : zmod p) = 0 :=
+(@eq_zero_iff_gcd_ne_one a p ⟨pp⟩).mpr h
+
+end zmod
diff --git a/src/data/zmod/defs.lean b/src/data/zmod/defs.lean
new file mode 100644
index 0000000000000..918a0caf9ab08
--- /dev/null
+++ b/src/data/zmod/defs.lean
@@ -0,0 +1,158 @@
+/-
+Copyright (c) 2022 Eric Rodriguez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Rodriguez
+-/
+import algebra.ne_zero
+import data.nat.modeq
+import data.fintype.lattice
+
+/-!
+# Definition of `zmod n` + basic results.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides the basic details of `zmod n`, including its commutative ring structure.
+
+## Implementation details
+
+This used to be inlined into data/zmod/basic.lean. This file imports `char_p/basic`, which is an
+issue; all `char_p` instances create an `algebra (zmod p) R` instance; however, this instance may
+not be definitionally equal to other `algebra` instances (for example, `galois_field` also has an
+`algebra` instance as it is defined as a `splitting_field`). The way to fix this is to use the
+forgetful inheritance pattern, and make `char_p` carry the data of what the `smul` should be (so
+for example, the `smul` on the `galois_field` `char_p` instance should be equal to the `smul` from
+its `splitting_field` structure); there is only one possible `zmod p` algebra for any `p`, so this
+is not an issue mathematically. For this to be possible, however, we need `char_p/basic` to be
+able to import some part of `zmod`.
+
+-/
+
+namespace fin
+
+/-!
+## Ring structure on `fin n`
+
+We define a commutative ring structure on `fin n`, but we do not register it as instance.
+Afterwords, when we define `zmod n` in terms of `fin n`, we use these definitions
+to register the ring structure on `zmod n` as type class instance.
+-/
+
+open nat.modeq int
+
+/-- Multiplicative commutative semigroup structure on `fin n`. -/
+instance (n : ℕ) : comm_semigroup (fin n) :=
+{ mul_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
+    (calc ((a * b) % n * c) ≡ a * b * c [MOD n] : (nat.mod_modeq _ _).mul_right _
+      ... ≡ a * (b * c) [MOD n] : by rw mul_assoc
+      ... ≡ a * (b * c % n) [MOD n] : (nat.mod_modeq _ _).symm.mul_left _),
+  mul_comm := fin.mul_comm,
+  ..fin.has_mul }
+
+private lemma left_distrib_aux (n : ℕ) : ∀ a b c : fin n, a * (b + c) = a * b + a * c :=
+λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, fin.eq_of_veq
+(calc a * ((b + c) % n) ≡ a * (b + c) [MOD n] : (nat.mod_modeq _ _).mul_left _
+  ... ≡ a * b + a * c [MOD n] : by rw mul_add
+  ... ≡ (a * b) % n + (a * c) % n [MOD n] :
+        (nat.mod_modeq _ _).symm.add (nat.mod_modeq _ _).symm)
+
+instance (n : ℕ) : distrib (fin n) :=
+{ left_distrib := left_distrib_aux n,
+  right_distrib := λ a b c, by rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm]; refl,
+  ..fin.add_comm_semigroup n,
+  ..fin.comm_semigroup n }
+
+/-- Commutative ring structure on `fin n`. -/
+instance (n : ℕ) [ne_zero n] : comm_ring (fin n) :=
+{ one_mul := fin.one_mul,
+  mul_one := fin.mul_one,
+  ..fin.add_monoid_with_one,
+  ..fin.add_comm_group n,
+  ..fin.comm_semigroup n,
+  ..fin.distrib n }
+
+/-- Note this is more general than `fin.comm_ring` as it applies (vacuously) to `fin 0` too. -/
+instance (n : ℕ) : has_distrib_neg (fin n) :=
+{ neg := has_neg.neg,
+  mul_neg := nat.cases_on n fin_zero_elim $ λ i, mul_neg,
+  neg_mul := nat.cases_on n fin_zero_elim $ λ i, neg_mul,
+  ..fin.has_involutive_neg n }
+
+end fin
+
+/-- The integers modulo `n : ℕ`. -/
+def zmod : ℕ → Type
+| 0     := ℤ
+| (n+1) := fin (n+1)
+
+instance zmod.decidable_eq : Π (n : ℕ), decidable_eq (zmod n)
+| 0     := int.decidable_eq
+| (n+1) := fin.decidable_eq _
+
+instance zmod.has_repr : Π (n : ℕ), has_repr (zmod n)
+| 0     := int.has_repr
+| (n+1) := fin.has_repr _
+
+namespace zmod
+
+instance fintype : Π (n : ℕ) [ne_zero n], fintype (zmod n)
+| 0    h  := by exactI (ne_zero.ne 0 rfl).elim
+| (n+1) _ := fin.fintype (n+1)
+
+instance infinite : infinite (zmod 0) :=
+int.infinite
+
+@[simp] lemma card (n : ℕ) [fintype (zmod n)] : fintype.card (zmod n) = n :=
+begin
+  casesI n,
+  { exact (not_finite (zmod 0)).elim },
+  { convert fintype.card_fin (n+1) }
+end
+
+/- We define each field by cases, to ensure that the eta-expanded `zmod.comm_ring` is defeq to the
+original, this helps avoid diamonds with instances coming from classes extending `comm_ring` such as
+field. -/
+instance comm_ring (n : ℕ) : comm_ring (zmod n) :=
+{ add := nat.cases_on n ((@has_add.add) int _) (λ n, @has_add.add (fin n.succ) _),
+  add_assoc := nat.cases_on n (@add_assoc int _) (λ n, @add_assoc (fin n.succ) _),
+  zero := nat.cases_on n (0 : int) (λ n, (0 : fin n.succ)),
+  zero_add := nat.cases_on n (@zero_add int _) (λ n, @zero_add (fin n.succ) _),
+  add_zero := nat.cases_on n (@add_zero int _) (λ n, @add_zero (fin n.succ) _),
+  neg := nat.cases_on n ((@has_neg.neg) int _) (λ n, @has_neg.neg (fin n.succ) _),
+  sub := nat.cases_on n ((@has_sub.sub) int _) (λ n, @has_sub.sub (fin n.succ) _),
+  sub_eq_add_neg := nat.cases_on n (@sub_eq_add_neg int _) (λ n, @sub_eq_add_neg (fin n.succ) _),
+  zsmul := nat.cases_on n ((@comm_ring.zsmul) int _) (λ n, @comm_ring.zsmul (fin n.succ) _),
+  zsmul_zero' := nat.cases_on n (@comm_ring.zsmul_zero' int _)
+    (λ n, @comm_ring.zsmul_zero' (fin n.succ) _),
+  zsmul_succ' := nat.cases_on n (@comm_ring.zsmul_succ' int _)
+    (λ n, @comm_ring.zsmul_succ' (fin n.succ) _),
+  zsmul_neg' := nat.cases_on n (@comm_ring.zsmul_neg' int _)
+    (λ n, @comm_ring.zsmul_neg' (fin n.succ) _),
+  nsmul := nat.cases_on n ((@comm_ring.nsmul) int _) (λ n, @comm_ring.nsmul (fin n.succ) _),
+  nsmul_zero' := nat.cases_on n (@comm_ring.nsmul_zero' int _)
+    (λ n, @comm_ring.nsmul_zero' (fin n.succ) _),
+  nsmul_succ' := nat.cases_on n (@comm_ring.nsmul_succ' int _)
+    (λ n, @comm_ring.nsmul_succ' (fin n.succ) _),
+  add_left_neg := by { cases n, exacts [@add_left_neg int _, @add_left_neg (fin n.succ) _] },
+  add_comm := nat.cases_on n (@add_comm int _) (λ n, @add_comm (fin n.succ) _),
+  mul := nat.cases_on n ((@has_mul.mul) int _) (λ n, @has_mul.mul (fin n.succ) _),
+  mul_assoc := nat.cases_on n (@mul_assoc int _) (λ n, @mul_assoc (fin n.succ) _),
+  one := nat.cases_on n (1 : int) (λ n, (1 : fin n.succ)),
+  one_mul := nat.cases_on n (@one_mul int _) (λ n, @one_mul (fin n.succ) _),
+  mul_one := nat.cases_on n (@mul_one int _) (λ n, @mul_one (fin n.succ) _),
+  nat_cast := nat.cases_on n (coe : ℕ → ℤ) (λ n, (coe : ℕ → fin n.succ)),
+  nat_cast_zero := nat.cases_on n (@nat.cast_zero int _) (λ n, @nat.cast_zero (fin n.succ) _),
+  nat_cast_succ := nat.cases_on n (@nat.cast_succ int _) (λ n, @nat.cast_succ (fin n.succ) _),
+  int_cast := nat.cases_on n (coe : ℤ → ℤ) (λ n, (coe : ℤ → fin n.succ)),
+  int_cast_of_nat := nat.cases_on n (@int.cast_of_nat int _) (λ n, @int.cast_of_nat (fin n.succ) _),
+  int_cast_neg_succ_of_nat := nat.cases_on n (@int.cast_neg_succ_of_nat int _)
+    (λ n, @int.cast_neg_succ_of_nat (fin n.succ) _),
+  left_distrib := nat.cases_on n (@left_distrib int _ _ _) (λ n, @left_distrib (fin n.succ) _ _ _),
+  right_distrib :=
+    nat.cases_on n (@right_distrib int _ _ _) (λ n, @right_distrib (fin n.succ) _ _ _),
+  mul_comm := nat.cases_on n (@mul_comm int _) (λ n, @mul_comm (fin n.succ) _) }
+
+instance inhabited (n : ℕ) : inhabited (zmod n) := ⟨0⟩
+
+end zmod
diff --git a/src/data/zmod/parity.lean b/src/data/zmod/parity.lean
index f08e23f86efa9..c83d693c6c394 100644
--- a/src/data/zmod/parity.lean
+++ b/src/data/zmod/parity.lean
@@ -8,6 +8,9 @@ import data.zmod.basic
 /-!
 # Relating parity to natural numbers mod 2
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This module provides lemmas relating `zmod 2` to `even` and `odd`.
 
 ## Tags
diff --git a/src/data/zmod/quotient.lean b/src/data/zmod/quotient.lean
index da2352fce381c..c619573eabdc4 100644
--- a/src/data/zmod/quotient.lean
+++ b/src/data/zmod/quotient.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
 import data.zmod.basic
-import group_theory.quotient_group
+import group_theory.group_action.quotient
 import ring_theory.int.basic
+import ring_theory.ideal.quotient_operations
 
 /-!
 # `zmod n` and quotient groups / rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file relates `zmod n` to the quotient group
 `quotient_add_group.quotient (add_subgroup.zmultiples n)` and to the quotient ring
 `(ideal.span {n}).quotient`.
@@ -39,13 +43,13 @@ namespace int
 /-- `ℤ` modulo multiples of `n : ℕ` is `zmod n`. -/
 def quotient_zmultiples_nat_equiv_zmod :
   ℤ ⧸ add_subgroup.zmultiples (n : ℤ) ≃+ zmod n :=
-(equiv_quotient_of_eq (zmod.ker_int_cast_add_hom _)).symm.trans $
+(quotient_add_equiv_of_eq (zmod.ker_int_cast_add_hom _)).symm.trans $
 quotient_ker_equiv_of_right_inverse (int.cast_add_hom (zmod n)) coe int_cast_zmod_cast
 
 /-- `ℤ` modulo multiples of `a : ℤ` is `zmod a.nat_abs`. -/
 def quotient_zmultiples_equiv_zmod (a : ℤ) :
   ℤ ⧸ add_subgroup.zmultiples a ≃+ zmod a.nat_abs :=
-(equiv_quotient_of_eq (zmultiples_nat_abs a)).symm.trans
+(quotient_add_equiv_of_eq (zmultiples_nat_abs a)).symm.trans
   (quotient_zmultiples_nat_equiv_zmod a.nat_abs)
 
 /-- `ℤ` modulo the ideal generated by `n : ℕ` is `zmod n`. -/
@@ -91,3 +95,99 @@ lemma zmultiples_quotient_stabilizer_equiv_symm_apply (n : zmod (minimal_period
 rfl
 
 end add_action
+
+namespace mul_action
+
+open add_action subgroup add_subgroup function
+
+variables {α β : Type*} [group α] (a : α) [mul_action α β] (b : β)
+
+local attribute [semireducible] mul_opposite
+
+/-- The quotient `(a ^ ℤ) ⧸ (stabilizer b)` is cyclic of order `minimal_period ((•) a) b`. -/
+noncomputable def zpowers_quotient_stabilizer_equiv :
+  zpowers a ⧸ stabilizer (zpowers a) b ≃* multiplicative (zmod (minimal_period ((•) a) b)) :=
+let f := zmultiples_quotient_stabilizer_equiv (additive.of_mul a) b in
+⟨f.to_fun, f.inv_fun, f.left_inv, f.right_inv, f.map_add'⟩
+
+lemma zpowers_quotient_stabilizer_equiv_symm_apply (n : zmod (minimal_period ((•) a) b)) :
+  (zpowers_quotient_stabilizer_equiv a b).symm n = (⟨a, mem_zpowers a⟩ : zpowers a) ^ (n : ℤ) :=
+rfl
+
+/-- The orbit `(a ^ ℤ) • b` is a cycle of order `minimal_period ((•) a) b`. -/
+noncomputable def orbit_zpowers_equiv : orbit (zpowers a) b ≃ zmod (minimal_period ((•) a) b) :=
+(orbit_equiv_quotient_stabilizer _ b).trans (zpowers_quotient_stabilizer_equiv a b).to_equiv
+
+/-- The orbit `(ℤ • a) +ᵥ b` is a cycle of order `minimal_period ((+ᵥ) a) b`. -/
+noncomputable def _root_.add_action.orbit_zmultiples_equiv
+  {α β : Type*} [add_group α] (a : α) [add_action α β] (b : β) :
+  add_action.orbit (zmultiples a) b ≃ zmod (minimal_period ((+ᵥ) a) b) :=
+(add_action.orbit_equiv_quotient_stabilizer (zmultiples a) b).trans
+  (zmultiples_quotient_stabilizer_equiv a b).to_equiv
+
+attribute [to_additive orbit_zmultiples_equiv] orbit_zpowers_equiv
+
+@[to_additive orbit_zmultiples_equiv_symm_apply]
+lemma orbit_zpowers_equiv_symm_apply (k : zmod (minimal_period ((•) a) b)) :
+  (orbit_zpowers_equiv a b).symm k =
+    (⟨a, mem_zpowers a⟩ : zpowers a) ^ (k : ℤ) • ⟨b, mem_orbit_self b⟩ :=
+rfl
+
+lemma orbit_zpowers_equiv_symm_apply' (k : ℤ) :
+  (orbit_zpowers_equiv a b).symm k =
+    (⟨a, mem_zpowers a⟩ : zpowers a) ^ k • ⟨b, mem_orbit_self b⟩ :=
+begin
+  rw [orbit_zpowers_equiv_symm_apply, zmod.coe_int_cast],
+  exact subtype.ext (zpow_smul_mod_minimal_period _ _ k),
+end
+
+lemma _root_.add_action.orbit_zmultiples_equiv_symm_apply'
+  {α β : Type*} [add_group α] (a : α) [add_action α β] (b : β) (k : ℤ) :
+  (add_action.orbit_zmultiples_equiv a b).symm k =
+    (k • (⟨a, mem_zmultiples a⟩ : zmultiples a)) +ᵥ ⟨b, add_action.mem_orbit_self b⟩ :=
+begin
+  rw [add_action.orbit_zmultiples_equiv_symm_apply, zmod.coe_int_cast],
+  exact subtype.ext (zsmul_vadd_mod_minimal_period _ _ k),
+end
+
+attribute [to_additive orbit_zmultiples_equiv_symm_apply'] orbit_zpowers_equiv_symm_apply'
+
+@[to_additive] lemma minimal_period_eq_card [fintype (orbit (zpowers a) b)] :
+  minimal_period ((•) a) b = fintype.card (orbit (zpowers a) b) :=
+by rw [←fintype.of_equiv_card (orbit_zpowers_equiv a b), zmod.card]
+
+@[to_additive] instance minimal_period_pos [finite $ orbit (zpowers a) b] :
+  ne_zero $ minimal_period ((•) a) b :=
+⟨begin
+  casesI nonempty_fintype (orbit (zpowers a) b),
+  haveI : nonempty (orbit (zpowers a) b) := (orbit_nonempty b).to_subtype,
+  rw minimal_period_eq_card,
+  exact fintype.card_ne_zero,
+end⟩
+
+end mul_action
+
+section group
+
+open subgroup
+
+variables {α : Type*} [group α] (a : α)
+
+/-- See also `order_eq_card_zpowers`. -/
+@[to_additive add_order_eq_card_zmultiples' "See also `add_order_eq_card_zmultiples`."]
+lemma order_eq_card_zpowers' : order_of a = nat.card (zpowers a) :=
+begin
+  have := nat.card_congr (mul_action.orbit_zpowers_equiv a (1 : α)),
+  rwa [nat.card_zmod, orbit_subgroup_one_eq_self, eq_comm] at this,
+end
+
+variables {a}
+
+@[to_additive is_of_fin_add_order.finite_zmultiples]
+lemma is_of_fin_order.finite_zpowers (h : is_of_fin_order a) : finite $ zpowers a :=
+begin
+  rw [← order_of_pos_iff, order_eq_card_zpowers'] at h,
+  exact nat.finite_of_card_ne_zero h.ne.symm,
+end
+
+end group
diff --git a/src/deprecated/group.lean b/src/deprecated/group.lean
index c854026aa9287..d6cdaa34ce16f 100644
--- a/src/deprecated/group.lean
+++ b/src/deprecated/group.lean
@@ -4,17 +4,24 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
 import algebra.group.type_tags
-import algebra.hom.equiv
+import algebra.hom.equiv.basic
+import algebra.hom.ring
 import algebra.hom.units
-import algebra.ring.basic
 
 /-!
 # Unbundled monoid and group homomorphisms
 
-This file defines predicates for unbundled monoid and group homomorphisms. Though
-bundled morphisms are preferred in mathlib, these unbundled predicates are still occasionally used
-in mathlib, and probably will not go away before Lean 4
-because Lean 3 often fails to coerce a bundled homomorphism to a function.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is deprecated, and is no longer imported by anything in mathlib other than other
+deprecated files, and test files. You should not need to import it.
+
+This file defines predicates for unbundled monoid and group homomorphisms. Instead of using
+this file, please use `monoid_hom`, defined in `algebra.hom.group`, with notation `→*`, for
+morphisms between monoids or groups. For example use `φ : G →* H` to represent a group
+homomorphism between multiplicative groups, and `ψ : A →+ B` to represent a group homomorphism
+between additive groups.
 
 ## Main Definitions
 
@@ -52,7 +59,8 @@ lemma comp {f : α → β} {g : β → γ} (hf : is_mul_hom f) (hg : is_mul_hom
 
 /-- A product of maps which preserve multiplication,
 preserves multiplication when the target is commutative. -/
-@[to_additive]
+@[to_additive "A sum of maps which preserves addition, preserves addition when the target
+is commutative."]
 lemma mul {α β} [semigroup α] [comm_semigroup β]
   {f g : α → β} (hf : is_mul_hom f) (hg : is_mul_hom g) :
   is_mul_hom (λ a, f a * g a) :=
@@ -60,7 +68,8 @@ lemma mul {α β} [semigroup α] [comm_semigroup β]
 
 /-- The inverse of a map which preserves multiplication,
 preserves multiplication when the target is commutative. -/
-@[to_additive]
+@[to_additive "The negation of a map which preserves addition, preserves addition when
+the target is commutative."]
 lemma inv {α β} [has_mul α] [comm_group β] {f : α → β} (hf : is_mul_hom f) :
   is_mul_hom (λ a, (f a)⁻¹) :=
 { map_mul := λ a b, (hf.map_mul a b).symm ▸ mul_inv _ _ }
@@ -107,12 +116,13 @@ namespace mul_equiv
 variables {M : Type*} {N : Type*} [mul_one_class M] [mul_one_class N]
 
 /-- A multiplicative isomorphism preserves multiplication (deprecated). -/
-@[to_additive]
+@[to_additive "An additive isomorphism preserves addition (deprecated)."]
 theorem is_mul_hom (h : M ≃* N) : is_mul_hom h := ⟨h.map_mul⟩
 
 /-- A multiplicative bijection between two monoids is a monoid hom
   (deprecated -- use `mul_equiv.to_monoid_hom`). -/
-@[to_additive]
+@[to_additive "An additive bijection between two additive monoids is an additive
+monoid hom (deprecated). "]
 lemma is_monoid_hom (h : M ≃* N) : is_monoid_hom h :=
 { map_mul := h.map_mul,
   map_one := h.map_one }
@@ -123,22 +133,24 @@ namespace is_monoid_hom
 variables [mul_one_class α] [mul_one_class β] {f : α → β} (hf : is_monoid_hom f)
 
 /-- A monoid homomorphism preserves multiplication. -/
-@[to_additive]
+@[to_additive "An additive monoid homomorphism preserves addition."]
 lemma map_mul (x y) : f (x * y) = f x * f y :=
 hf.map_mul x y
 
 /-- The inverse of a map which preserves multiplication,
 preserves multiplication when the target is commutative. -/
-@[to_additive]
+@[to_additive "The negation of a map which preserves addition, preserves addition
+when the target is commutative."]
 lemma inv {α β} [mul_one_class α] [comm_group β] {f : α → β} (hf : is_monoid_hom f) :
   is_monoid_hom (λ a, (f a)⁻¹) :=
-{ map_one := hf.map_one.symm ▸ one_inv,
+{ map_one := hf.map_one.symm ▸ inv_one,
   map_mul := λ a b, (hf.map_mul a b).symm ▸ mul_inv _ _ }
 
 end is_monoid_hom
 
 /-- A map to a group preserving multiplication is a monoid homomorphism. -/
-@[to_additive]
+@[to_additive "A map to an additive group preserving addition is an additive monoid
+homomorphism."]
 theorem is_mul_hom.to_is_monoid_hom [mul_one_class α] [group β] {f : α → β} (hf : is_mul_hom f) :
   is_monoid_hom f :=
 { map_one := mul_right_eq_self.1 $ by rw [← hf.map_mul, one_mul],
@@ -148,11 +160,12 @@ namespace is_monoid_hom
 variables [mul_one_class α] [mul_one_class β] {f : α → β}
 
 /-- The identity map is a monoid homomorphism. -/
-@[to_additive]
+@[to_additive "The identity map is an additive monoid homomorphism."]
 lemma id : is_monoid_hom (@id α) := { map_one := rfl, map_mul := λ _ _, rfl }
 
 /-- The composite of two monoid homomorphisms is a monoid homomorphism. -/
-@[to_additive]
+@[to_additive "The composite of two additive monoid homomorphisms is an additive monoid
+homomorphism."]
 lemma comp (hf : is_monoid_hom f) {γ} [mul_one_class γ] {g : β → γ} (hg : is_monoid_hom g) :
   is_monoid_hom (g ∘ f) :=
 { map_one := show g _ = 1, by rw [hf.map_one, hg.map_one],
@@ -191,7 +204,7 @@ lemma mul_equiv.is_group_hom {G H : Type*} {_ : group G} {_ : group H} (h : G 
   is_group_hom h := { map_mul := h.map_mul }
 
 /-- Construct `is_group_hom` from its only hypothesis. -/
-@[to_additive]
+@[to_additive "Construct `is_add_group_hom` from its only hypothesis."]
 lemma is_group_hom.mk' [group α] [group β] {f : α → β} (hf : ∀ x y, f (x * y) = f x * f y) :
   is_group_hom f :=
 { map_mul := hf }
@@ -203,47 +216,51 @@ open is_mul_hom (map_mul)
 lemma map_mul : ∀ (x y), f (x * y) = f x * f y := hf.to_is_mul_hom.map_mul
 
 /-- A group homomorphism is a monoid homomorphism. -/
-@[to_additive]
+@[to_additive "An additive group homomorphism is an additive monoid homomorphism."]
 lemma to_is_monoid_hom : is_monoid_hom f :=
 hf.to_is_mul_hom.to_is_monoid_hom
 
 /-- A group homomorphism sends 1 to 1. -/
-@[to_additive]
+@[to_additive "An additive group homomorphism sends 0 to 0."]
 lemma map_one : f 1 = 1 := hf.to_is_monoid_hom.map_one
 
 /-- A group homomorphism sends inverses to inverses. -/
-@[to_additive]
+@[to_additive "An additive group homomorphism sends negations to negations."]
 theorem map_inv (hf : is_group_hom f) (a : α) : f a⁻¹ = (f a)⁻¹ :=
-eq_inv_of_mul_eq_one $ by rw [← hf.map_mul, inv_mul_self, hf.map_one]
+eq_inv_of_mul_eq_one_left $ by rw [← hf.map_mul, inv_mul_self, hf.map_one]
+
+@[to_additive] lemma map_div (hf : is_group_hom f) (a b : α) : f (a / b) = f a / f b :=
+by simp_rw [div_eq_mul_inv, hf.map_mul, hf.map_inv]
 
 /-- The identity is a group homomorphism. -/
-@[to_additive]
+@[to_additive "The identity is an additive group homomorphism."]
 lemma id : is_group_hom (@id α) := { map_mul := λ _ _, rfl}
 
 /-- The composition of two group homomorphisms is a group homomorphism. -/
-@[to_additive]
+@[to_additive "The composition of two additive group homomorphisms is an additive
+group homomorphism."]
 lemma comp (hf : is_group_hom f) {γ} [group γ] {g : β → γ} (hg : is_group_hom g) :
   is_group_hom (g ∘ f) :=
 { ..is_mul_hom.comp hf.to_is_mul_hom hg.to_is_mul_hom }
 
 /-- A group homomorphism is injective iff its kernel is trivial. -/
-@[to_additive]
+@[to_additive "An additive group homomorphism is injective if its kernel is trivial."]
 lemma injective_iff {f : α → β} (hf : is_group_hom f) :
   function.injective f ↔ (∀ a, f a = 1 → a = 1) :=
 ⟨λ h _, by rw ← hf.map_one; exact @h _ _,
-  λ h x y hxy, by rw [← inv_inv (f x), inv_eq_iff_mul_eq_one, ← hf.map_inv,
-      ← hf.map_mul] at hxy;
-    simpa using inv_eq_of_mul_eq_one (h _ hxy)⟩
+  λ h x y hxy, eq_of_div_eq_one $ h _ $ by rwa [hf.map_div, div_eq_one]⟩
 
 /-- The product of group homomorphisms is a group homomorphism if the target is commutative. -/
-@[to_additive]
+@[to_additive "The sum of two additive group homomorphisms is an additive group homomorphism
+if the target is commutative."]
 lemma mul {α β} [group α] [comm_group β]
   {f g : α → β} (hf : is_group_hom f) (hg : is_group_hom g) :
   is_group_hom (λa, f a * g a) :=
 { map_mul := (hf.to_is_mul_hom.mul hg.to_is_mul_hom).map_mul }
 
 /-- The inverse of a group homomorphism is a group homomorphism if the target is commutative. -/
-@[to_additive]
+@[to_additive "The negation of an additive group homomorphism is an additive group homomorphism
+if the target is commutative."]
 lemma inv {α β} [group α] [comm_group β] {f : α → β} (hf : is_group_hom f) :
   is_group_hom (λa, (f a)⁻¹) :=
 { map_mul := hf.to_is_mul_hom.inv.map_mul }
@@ -284,18 +301,6 @@ end ring_hom
 lemma inv.is_group_hom [comm_group α] : is_group_hom (has_inv.inv : α → α) :=
 { map_mul := mul_inv }
 
-namespace is_add_group_hom
-variables [add_group α] [add_group β] {f : α → β} (hf : is_add_group_hom f)
-
-/-- Additive group homomorphisms commute with subtraction. -/
-lemma map_sub (a b) : f (a - b) = f a - f b :=
-calc f (a - b) = f (a + -b)   : congr_arg f (sub_eq_add_neg a b)
-           ... = f a + f (-b) : hf.map_add _ _
-           ... = f a + -f b   : by rw [hf.map_neg]
-           ... = f a - f b    : (sub_eq_add_neg _ _).symm
-
-end is_add_group_hom
-
 /-- The difference of two additive group homomorphisms is an additive group
 homomorphism if the target is commutative. -/
 lemma is_add_group_hom.sub {α β} [add_group α] [add_comm_group β]
diff --git a/src/deprecated/ring.lean b/src/deprecated/ring.lean
index 1d36df151c1d1..315e6ff949eaf 100644
--- a/src/deprecated/ring.lean
+++ b/src/deprecated/ring.lean
@@ -8,10 +8,16 @@ import deprecated.group
 /-!
 # Unbundled semiring and ring homomorphisms (deprecated)
 
-This file defines structures for unbundled semiring and ring homomorphisms. Though bundled
-morphisms are now preferred, the unbundled structures are still occasionally used in mathlib,
-and probably will not go away before Lean 4 because Lean 3 often fails to coerce a bundled
-homomorphism to a function.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is deprecated, and is no longer imported by anything in mathlib other than other
+deprecated files, and test files. You should not need to import it.
+
+This file defines predicates for unbundled semiring and ring homomorphisms. Instead of using
+this file, please use `ring_hom`, defined in `algebra.hom.ring`, with notation `→+*`, for
+morphisms between semirings or rings. For example use `φ : A →+* B` to represent a
+ring homomorphism.
 
 ## Main Definitions
 
@@ -104,7 +110,8 @@ lemma comp (hf : is_ring_hom f) {γ} [ring γ] {g : β → γ} (hg : is_ring_hom
 lemma to_is_semiring_hom (hf : is_ring_hom f) : is_semiring_hom f :=
 { map_zero := map_zero hf, ..‹is_ring_hom f› }
 
-lemma to_is_add_group_hom (hf : is_ring_hom f) : is_add_group_hom f := { map_add := hf.map_add }
+lemma to_is_add_group_hom (hf : is_ring_hom f) : is_add_group_hom f :=
+{ map_add := λ _ _, hf.map_add }
 
 end is_ring_hom
 
diff --git a/src/deprecated/subfield.lean b/src/deprecated/subfield.lean
index 0a45f87f9a428..2c68a30c862e5 100644
--- a/src/deprecated/subfield.lean
+++ b/src/deprecated/subfield.lean
@@ -4,19 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Andreas Swerdlow
 -/
 import deprecated.subring
-import algebra.group_with_zero.power
-/-
 
-# Unbundled subfields
+/-!
+# Unbundled subfields (deprecated)
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is deprecated, and is no longer imported by anything in mathlib other than other
+deprecated files, and test files. You should not need to import it.
 
-This file introduces the predicate `is_subfield` on `S : set F` where `F` is a field.
-This is *not* the preferred way to do subfields in Lean 3: in general `S : subfield F`
-works more smoothly.
+This file defines predicates for unbundled subfields. Instead of using this file, please use
+`subfield`, defined in `field_theory.subfield`, for subfields of fields.
 
 ## Main definitions
 
-`is_subfield (S : set F)` : the predicate that `S` is the underlying set of a subfield
-of the field `F`. Note that the bundled variant `subfield F` is preferred to this approach.
+`is_subfield (S : set F) : Prop` : the predicate that `S` is the underlying set of a subfield
+of the field `F`. The bundled variant `subfield F` should be used in preference to this.
 
 ## Tags
 
@@ -24,6 +28,9 @@ is_subfield
 -/
 variables {F : Type*} [field F] (S : set F)
 
+/-- `is_subfield (S : set F)` is the predicate saying that a given subset of a field is
+the set underlying a subfield. This structure is deprecated; use the bundled variant
+`subfield F` to model subfields of a field. -/
 structure is_subfield extends is_subring S : Prop :=
 (inv_mem : ∀ {x : F}, x ∈ S → x⁻¹ ∈ S)
 
@@ -47,13 +54,13 @@ lemma univ.is_subfield : is_subfield (@set.univ F) :=
 lemma preimage.is_subfield {K : Type*} [field K]
   (f : F →+* K) {s : set K} (hs : is_subfield s) : is_subfield (f ⁻¹' s) :=
 { inv_mem := λ a (ha : f a ∈ s), show f a⁻¹ ∈ s,
-    by { rw [f.map_inv],
+    by { rw [map_inv₀],
          exact hs.inv_mem ha },
   ..f.is_subring_preimage hs.to_is_subring }
 
 lemma image.is_subfield {K : Type*} [field K]
   (f : F →+* K) {s : set F} (hs : is_subfield s) : is_subfield (f '' s) :=
-{ inv_mem := λ a ⟨x, xmem, ha⟩, ⟨x⁻¹, hs.inv_mem xmem, ha ▸ f.map_inv _⟩,
+{ inv_mem := λ a ⟨x, xmem, ha⟩, ⟨x⁻¹, hs.inv_mem xmem, ha ▸ map_inv₀ f _⟩,
   ..f.is_subring_image hs.to_is_subring }
 
 lemma range.is_subfield {K : Type*} [field K]
@@ -77,7 +84,7 @@ lemma closure.is_submonoid : is_submonoid (closure S) :=
           is_submonoid.mul_mem ring.closure.is_subring.to_is_submonoid hp hr,
           q * s,
           is_submonoid.mul_mem ring.closure.is_subring.to_is_submonoid hq hs,
-          (div_mul_div_comm₀ _ _ _ _).symm⟩,
+          (div_mul_div_comm _ _ _ _).symm⟩,
   one_mem := ring_closure_subset $ is_submonoid.one_mem ring.closure.is_subring.to_is_submonoid }
 
 lemma closure.is_subfield : is_subfield (closure S) :=
@@ -102,7 +109,7 @@ have h0 : (0:F) ∈ closure S, from ring_closure_subset $
   end,
   inv_mem := begin
     rintros _ ⟨p, hp, q, hq, rfl⟩,
-    exact ⟨q, hq, p, hp, inv_div.symm⟩
+    exact ⟨q, hq, p, hp, (inv_div _ _).symm⟩
   end,
   ..closure.is_submonoid }
 
diff --git a/src/deprecated/subgroup.lean b/src/deprecated/subgroup.lean
index b07d7ac513966..6e164389592e0 100644
--- a/src/deprecated/subgroup.lean
+++ b/src/deprecated/subgroup.lean
@@ -6,18 +6,23 @@ Authors: Johannes Hölzl, Mitchell Rowett, Scott Morrison, Johan Commelin, Mario
 -/
 import group_theory.subgroup.basic
 import deprecated.submonoid
+
 /-!
-# Unbundled subgroups
+# Unbundled subgroups (deprecated)
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is deprecated, and is no longer imported by anything in mathlib other than other
+deprecated files, and test files. You should not need to import it.
 
-This file defines unbundled multiplicative and additive subgroups `is_subgroup` and
-`is_add_subgroup`. These are not the preferred way to talk about subgroups and should
-not be used for any new projects. The preferred way in mathlib are the bundled
-versions `subgroup G` and `add_subgroup G`.
+This file defines unbundled multiplicative and additive subgroups. Instead of using this file,
+please use `subgroup G` and `add_subgroup A`, defined in `group_theory.subgroup.basic`.
 
 ## Main definitions
 
-`is_add_subgroup (S : set G)` : the predicate that `S` is the underlying subset of an additive
-subgroup of `G`. The bundled variant `add_subgroup G` should be used in preference to this.
+`is_add_subgroup (S : set A)` : the predicate that `S` is the underlying subset of an additive
+subgroup of `A`. The bundled variant `add_subgroup A` should be used in preference to this.
 
 `is_subgroup (S : set G)` : the predicate that `S` is the underlying subset of a subgroup
 of `G`. The bundled variant `subgroup G` should be used in preference to this.
@@ -49,8 +54,8 @@ by simpa only [div_eq_mul_inv] using hs.mul_mem hx (hs.inv_mem hy)
 
 lemma additive.is_add_subgroup
   {s : set G} (hs : is_subgroup s) : @is_add_subgroup (additive G) _ s :=
-@is_add_subgroup.mk (additive G) _ _ (additive.is_add_submonoid hs.to_is_submonoid)
-  hs.inv_mem
+@is_add_subgroup.mk (additive G) _ _ (additive.is_add_submonoid hs.to_is_submonoid) $
+  λ _, hs.inv_mem
 
 theorem additive.is_add_subgroup_iff
   {s : set G} : @is_add_subgroup (additive G) _ s ↔ is_subgroup s :=
@@ -59,8 +64,8 @@ theorem additive.is_add_subgroup_iff
 
 lemma multiplicative.is_subgroup
   {s : set A} (hs : is_add_subgroup s) : @is_subgroup (multiplicative A) _ s :=
-@is_subgroup.mk (multiplicative A) _ _ (multiplicative.is_submonoid hs.to_is_add_submonoid)
-  hs.neg_mem
+@is_subgroup.mk (multiplicative A) _ _ (multiplicative.is_submonoid hs.to_is_add_submonoid) $
+  λ _, hs.neg_mem
 
 theorem multiplicative.is_subgroup_iff
   {s : set A} : @is_subgroup (multiplicative A) _ s ↔ is_add_subgroup s :=
@@ -274,7 +279,7 @@ variables [group G] [group H]
 lemma one_ker_inv {f : G → H} (hf : is_group_hom f) {a b : G} (h : f (a * b⁻¹) = 1) : f a = f b :=
 begin
   rw [hf.map_mul, hf.map_inv] at h,
-  rw [←inv_inv (f b), eq_inv_of_mul_eq_one h]
+  rw [←inv_inv (f b), eq_inv_of_mul_eq_one_left h]
 end
 
 @[to_additive]
@@ -282,7 +287,7 @@ lemma one_ker_inv' {f : G → H} (hf : is_group_hom f) {a b : G} (h : f (a⁻¹
 begin
   rw [hf.map_mul, hf.map_inv] at h,
   apply inv_injective,
-  rw eq_inv_of_mul_eq_one h
+  rw eq_inv_of_mul_eq_one_left h
 end
 
 @[to_additive]
@@ -352,7 +357,7 @@ begin
   intros a₁ a₂ hfa,
   simp [ext_iff, ker, is_subgroup.trivial] at h,
   have ha : a₁ * a₂⁻¹ = 1, by rw ←h; exact hf.inv_ker_one hfa,
-  rw [eq_inv_of_mul_eq_one ha, inv_inv a₂]
+  rw [eq_inv_of_mul_eq_one_left ha, inv_inv a₂]
 end
 
 @[to_additive]
@@ -447,7 +452,7 @@ in_closure.rec_on h
   (λ x _ ⟨L, HL1, HL2⟩, ⟨L.reverse.map has_inv.inv,
     λ x hx, let ⟨y, hy1, hy2⟩ := list.exists_of_mem_map hx in
       hy2 ▸ or.imp id (by rw [inv_inv]; exact id) (HL1 _ $ list.mem_reverse.1 hy1).symm,
-      HL2 ▸ list.rec_on L one_inv.symm (λ hd tl ih,
+      HL2 ▸ list.rec_on L inv_one.symm (λ hd tl ih,
         by rw [list.reverse_cons, list.map_append, list.prod_append, ih, list.map_singleton,
             list.prod_cons, list.prod_nil, mul_one, list.prod_cons, mul_inv_rev])⟩)
   (λ x y hx hy ⟨L1, HL1, HL2⟩ ⟨L2, HL3, HL4⟩, ⟨L1 ++ L2, list.forall_mem_append.2 ⟨HL1, HL3⟩,
@@ -484,12 +489,12 @@ theorem closure_eq_mclosure {s : set G} : closure s = monoid.closure (s ∪ has_
 set.subset.antisymm
   (@closure_subset _ _ _ (monoid.closure (s ∪ has_inv.inv ⁻¹' s))
     { one_mem := (monoid.closure.is_submonoid _).one_mem,
-      mul_mem := (monoid.closure.is_submonoid _).mul_mem,
+      mul_mem := λ _ _, (monoid.closure.is_submonoid _).mul_mem,
       inv_mem := λ x hx, monoid.in_closure.rec_on hx
       (λ x hx, or.cases_on hx (λ hx, monoid.subset_closure $ or.inr $
         show x⁻¹⁻¹ ∈ s, from (inv_inv x).symm ▸ hx)
         (λ hx, monoid.subset_closure $ or.inl hx))
-      ((@one_inv G _).symm ▸ is_submonoid.one_mem (monoid.closure.is_submonoid _))
+      ((@inv_one G _).symm ▸ is_submonoid.one_mem (monoid.closure.is_submonoid _))
       (λ x y hx hy ihx ihy,
         (mul_inv_rev x y).symm ▸ is_submonoid.mul_mem (monoid.closure.is_submonoid _) ihy ihx) }
     (set.subset.trans (set.subset_union_left _ _) monoid.subset_closure))
@@ -595,14 +600,14 @@ end group
 def subgroup.of [group G] {s : set G} (h : is_subgroup s) : subgroup G :=
 { carrier := s,
   one_mem' := h.1.1,
-  mul_mem' := h.1.2,
-  inv_mem' := h.2 }
+  mul_mem' := λ _ _, h.1.2,
+  inv_mem' := λ _, h.2 }
 
 @[to_additive]
 lemma subgroup.is_subgroup [group G] (K : subgroup G) : is_subgroup (K : set G) :=
 { one_mem := K.one_mem',
-  mul_mem := K.mul_mem',
-  inv_mem := K.inv_mem' }
+  mul_mem := λ _ _, K.mul_mem',
+  inv_mem := λ _, K.inv_mem' }
 
 -- this will never fire if it's an instance
 @[to_additive]
diff --git a/src/deprecated/submonoid.lean b/src/deprecated/submonoid.lean
index 1cec680bb5201..d8887860703e0 100644
--- a/src/deprecated/submonoid.lean
+++ b/src/deprecated/submonoid.lean
@@ -8,24 +8,24 @@ import algebra.big_operators.basic
 import deprecated.group
 
 /-!
-# Unbundled submonoids
+# Unbundled submonoids (deprecated)
 
-This file defines unbundled multiplicative and additive submonoids `is_submonoid` and
-`is_add_submonoid`. These are not the preferred way to talk about submonoids and should
-not be used for any new projects. The preferred way in mathlib are the bundled
-versions `submonoid G` and `add_submonoid G`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-## Main definitions
+This file is deprecated, and is no longer imported by anything in mathlib other than other
+deprecated files, and test files. You should not need to import it.
 
-`is_add_submonoid (S : set G)` : the predicate that `S` is the underlying subset of an additive
-submonoid of `G`. The bundled variant `add_subgroup G` should be used in preference to this.
+This file defines unbundled multiplicative and additive submonoids. Instead of using this file,
+please use `submonoid G` and `add_submonoid A`, defined in `group_theory.submonoid.basic`.
 
-`is_submonoid (S : set G)` : the predicate that `S` is the underlying subset of a submonoid
-of `G`. The bundled variant `submonoid G` should be used in preference to this.
+## Main definitions
 
-## Tags
+`is_add_submonoid (S : set M)` : the predicate that `S` is the underlying subset of an additive
+submonoid of `M`. The bundled variant `add_submonoid M` should be used in preference to this.
 
-subgroup, subgroups, is_subgroup
+`is_submonoid (S : set M)` : the predicate that `S` is the underlying subset of a submonoid
+of `M`. The bundled variant `submonoid M` should be used in preference to this.
 
 ## Tags
 submonoid, submonoids, is_submonoid
@@ -323,7 +323,7 @@ end monoid
 
 /-- Create a bundled submonoid from a set `s` and `[is_submonoid s]`. -/
 @[to_additive "Create a bundled additive submonoid from a set `s` and `[is_add_submonoid s]`."]
-def submonoid.of {s : set M} (h : is_submonoid s) : submonoid M := ⟨s, h.2, h.1⟩
+def submonoid.of {s : set M} (h : is_submonoid s) : submonoid M := ⟨s, λ _ _, h.2, h.1⟩
 
 @[to_additive]
-lemma submonoid.is_submonoid (S : submonoid M) : is_submonoid (S : set M) := ⟨S.3, S.2⟩
+lemma submonoid.is_submonoid (S : submonoid M) : is_submonoid (S : set M) := ⟨S.3, λ _ _, S.2⟩
diff --git a/src/deprecated/subring.lean b/src/deprecated/subring.lean
index ba4f799512f25..fa0f809eb5fae 100644
--- a/src/deprecated/subring.lean
+++ b/src/deprecated/subring.lean
@@ -7,6 +7,27 @@ import deprecated.subgroup
 import deprecated.group
 import ring_theory.subring.basic
 
+/-!
+# Unbundled subrings (deprecated)
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is deprecated, and is no longer imported by anything in mathlib other than other
+deprecated files, and test files. You should not need to import it.
+
+This file defines predicates for unbundled subrings. Instead of using this file, please use
+`subring`, defined in `ring_theory.subring.basic`, for subrings of rings.
+
+## Main definitions
+
+`is_subring (S : set R) : Prop` : the predicate that `S` is the underlying set of a subring
+of the ring `R`. The bundled variant `subring R` should be used in preference to this.
+
+## Tags
+
+is_subring
+-/
 universes u v
 
 open group
@@ -21,10 +42,10 @@ structure is_subring (S : set R) extends is_add_subgroup S, is_submonoid S : Pro
 def is_subring.subring {S : set R} (hs : is_subring S) : subring R :=
 { carrier := S,
   one_mem' := hs.one_mem,
-  mul_mem' := hs.mul_mem,
+  mul_mem' := λ _ _, hs.mul_mem,
   zero_mem' := hs.zero_mem,
-  add_mem' := hs.add_mem,
-  neg_mem' := hs.neg_mem }
+  add_mem' := λ _ _, hs.add_mem,
+  neg_mem' := λ _, hs.neg_mem }
 
 namespace ring_hom
 
@@ -67,6 +88,8 @@ lemma is_subring_Union_of_directed {ι : Type*} [hι : nonempty ι]
 
 namespace ring
 
+/-- The smallest subring containing a given subset of a ring, considered as a set. This function
+is deprecated; use `subring.closure`. -/
 def closure (s : set R) := add_group.closure (monoid.closure s)
 
 variable {s : set R}
@@ -107,14 +130,13 @@ begin
   { rw [list.map_cons, list.sum_cons],
     exact ha this (ih HL.2) },
   replace HL := HL.1, clear ih tl,
-  suffices : ∃ L : list R,
+  rsuffices ⟨L, HL', HP | HP⟩ : ∃ L : list R,
     (∀ x ∈ L, x ∈ s) ∧ (list.prod hd = list.prod L ∨ list.prod hd = -list.prod L),
-  { rcases this with ⟨L, HL', HP | HP⟩,
-    { rw HP, clear HP HL hd, induction L with hd tl ih, { exact h1 },
-      rw list.forall_mem_cons at HL',
-      rw list.prod_cons,
-      exact hs _ HL'.1 _ (ih HL'.2) },
-    rw HP, clear HP HL hd, induction L with hd tl ih, { exact hneg1 },
+  { rw HP, clear HP HL hd, induction L with hd tl ih, { exact h1 },
+    rw list.forall_mem_cons at HL',
+    rw list.prod_cons,
+    exact hs _ HL'.1 _ (ih HL'.2) },
+  { rw HP, clear HP HL hd, induction L with hd tl ih, { exact hneg1 },
     rw [list.prod_cons, neg_mul_eq_mul_neg],
     rw list.forall_mem_cons at HL',
     exact hs _ HL'.1 _ (ih HL'.2) },
diff --git a/src/dynamics/circle/rotation_number/translation_number.lean b/src/dynamics/circle/rotation_number/translation_number.lean
index 1f34e5edb2925..4c340988b2134 100644
--- a/src/dynamics/circle/rotation_number/translation_number.lean
+++ b/src/dynamics/circle/rotation_number/translation_number.lean
@@ -12,6 +12,9 @@ import topology.algebra.order.monotone_continuity
 /-!
 # Translation number of a monotone real map that commutes with `x ↦ x + 1`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `f : ℝ → ℝ` be a monotone map such that `f (x + 1) = f x + 1` for all `x`. Then the limit
 $$
   \tau(f)=\lim_{n\to\infty}{f^n(x)-x}{n}
@@ -116,7 +119,7 @@ circle homeomorphism, rotation number
 -/
 
 open filter set function (hiding commute) int
-open_locale topological_space classical
+open_locale topology classical
 
 /-!
 ### Definition and monoid structure
@@ -280,7 +283,7 @@ by simpa only [sub_eq_add_neg] using
 
 lemma commute_add_int : ∀ n : ℤ, function.commute f (λ x, x + n)
 | (n:ℕ) := f.commute_add_nat n
-| -[1+n] := by simpa only [sub_eq_add_neg] using f.commute_sub_nat (n + 1)
+| -[1+n] := by simpa [sub_eq_add_neg] using f.commute_sub_nat (n + 1)
 
 lemma commute_int_add (n : ℤ) : function.commute f ((+) n) :=
 by simpa only [add_comm _ (n:ℝ)] using f.commute_add_int n
@@ -413,7 +416,7 @@ lemma dist_map_zero_lt_of_semiconj {f g₁ g₂ : circle_deg1_lift} (h : functio
   dist (g₁ 0) (g₂ 0) < 2 :=
 calc dist (g₁ 0) (g₂ 0) ≤ dist (g₁ 0) (f (g₁ 0) - f 0) + dist _ (g₂ 0) : dist_triangle _ _ _
 ... = dist (f 0 + g₁ 0) (f (g₁ 0)) + dist (g₂ 0 + f 0) (g₂ (f 0)) :
-  by simp only [h.eq, real.dist_eq, sub_sub, add_comm (f 0), sub_sub_assoc_swap, abs_sub_comm
+  by simp only [h.eq, real.dist_eq, sub_sub, add_comm (f 0), sub_sub_eq_add_sub, abs_sub_comm
     (g₂ (f 0))]
 ... < 2 : add_lt_add (f.dist_map_map_zero_lt g₁) (g₂.dist_map_map_zero_lt f)
 
@@ -527,7 +530,7 @@ using h.comp (nat.tendsto_pow_at_top_at_top_of_one_lt one_lt_two)
 lemma translation_number_eq_of_tendsto₀' {τ' : ℝ}
   (h : tendsto (λ n:ℕ, f^[n + 1] 0 / (n + 1)) at_top (𝓝 τ')) :
   τ f = τ' :=
-f.translation_number_eq_of_tendsto₀ $ (tendsto_add_at_top_iff_nat 1).1 h
+f.translation_number_eq_of_tendsto₀ $ (tendsto_add_at_top_iff_nat 1).1 (by exact_mod_cast h)
 
 lemma transnum_aux_seq_zero : f.transnum_aux_seq 0 = f 0 := by simp [transnum_aux_seq]
 
@@ -535,12 +538,12 @@ lemma transnum_aux_seq_dist_lt (n : ℕ) :
   dist (f.transnum_aux_seq n) (f.transnum_aux_seq (n+1)) < (1 / 2) / (2^n) :=
 begin
   have : 0 < (2^(n+1):ℝ) := pow_pos zero_lt_two _,
-  rw [div_div_eq_div_mul, ← pow_succ, ← abs_of_pos this],
+  rw [div_div, ← pow_succ, ← abs_of_pos this],
   replace := abs_pos.2 (ne_of_gt this),
   convert (div_lt_div_right this).2 ((f^(2^n)).dist_map_map_zero_lt (f^(2^n))),
   simp_rw [transnum_aux_seq, real.dist_eq],
   rw [← abs_div, sub_div, pow_succ', pow_succ, ← two_mul,
-    mul_div_mul_left _ _ (@two_ne_zero ℝ _ _),
+    mul_div_mul_left _ _ (two_ne_zero' ℝ),
     pow_mul, sq, mul_apply]
 end
 
@@ -633,13 +636,13 @@ begin
   dsimp,
   have : (0:ℝ) < n + 1 := n.cast_add_one_pos,
   rw [real.dist_eq, div_sub' _ _ _ (ne_of_gt this), abs_div, ← real.dist_eq, abs_of_pos this,
-    div_le_div_right this, ← nat.cast_add_one],
+    nat.cast_add_one, div_le_div_right this, ← nat.cast_add_one],
   apply dist_pow_map_zero_mul_translation_number_le
 end
 
 lemma tendsto_translation_number₀ :
   tendsto (λ n:ℕ, ((f^n) 0) / n) at_top (𝓝 $ τ f) :=
-(tendsto_add_at_top_iff_nat 1).1 f.tendsto_translation_number₀'
+(tendsto_add_at_top_iff_nat 1).1 (by exact_mod_cast f.tendsto_translation_number₀')
 
 /-- For any `x : ℝ` the sequence $\frac{f^n(x)-x}{n}$ tends to the translation number of `f`.
 In particular, this limit does not depend on `x`. -/
@@ -654,7 +657,7 @@ end
 
 lemma tendsto_translation_number' (x : ℝ) :
   tendsto (λ n:ℕ, ((f^(n+1)) x - x) / (n+1)) at_top (𝓝 $ τ f) :=
-(tendsto_add_at_top_iff_nat 1).2 (f.tendsto_translation_number x)
+by exact_mod_cast (tendsto_add_at_top_iff_nat 1).2 (f.tendsto_translation_number x)
 
 lemma translation_number_mono : monotone τ :=
 λ f g h, le_of_tendsto_of_tendsto' f.tendsto_translation_number₀
@@ -676,7 +679,7 @@ translation_number_translate z ▸ translation_number_mono
 lemma translation_number_le_of_le_add_int {x : ℝ} {m : ℤ} (h : f x ≤ x + m) : τ f ≤ m :=
 le_of_tendsto' (f.tendsto_translation_number' x) $ λ n,
 (div_le_iff' (n.cast_add_one_pos : (0 : ℝ) < _)).mpr $ sub_le_iff_le_add'.2 $
-(coe_pow f (n + 1)).symm ▸ f.iterate_le_of_map_le_add_int h (n + 1)
+(coe_pow f (n + 1)).symm ▸ @nat.cast_add_one ℝ _ n ▸ f.iterate_le_of_map_le_add_int h (n + 1)
 
 lemma translation_number_le_of_le_add_nat {x : ℝ} {m : ℕ} (h : f x ≤ x + m) : τ f ≤ m :=
 @translation_number_le_of_le_add_int f x m h
@@ -842,7 +845,7 @@ begin
   { refine csupr_mono (this y) (λ g, _),
     exact mono _ (mono _ hxy) },
   { simp only [map_add_one],
-    exact (map_csupr_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const)
+    exact (monotone.map_csupr_of_continuous_at (continuous_at_id.add continuous_at_const)
       (monotone_id.add_const (1 : ℝ)) (this x)).symm },
   { exact this x }
 end
diff --git a/src/dynamics/ergodic/add_circle.lean b/src/dynamics/ergodic/add_circle.lean
new file mode 100644
index 0000000000000..8bac8c19a8a8b
--- /dev/null
+++ b/src/dynamics/ergodic/add_circle.lean
@@ -0,0 +1,140 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import measure_theory.group.add_circle
+import dynamics.ergodic.ergodic
+import measure_theory.covering.density_theorem
+import data.set.pointwise.iterate
+
+/-!
+# Ergodic maps of the additive circle
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains proofs of ergodicity for maps of the additive circle.
+
+## Main definitions:
+
+ * `add_circle.ergodic_zsmul`: given `n : ℤ` such that `1 < |n|`, the self map `y ↦ n • y` on
+   the additive circle is ergodic (wrt the Haar measure).
+ * `add_circle.ergodic_nsmul`: given `n : ℕ` such that `1 < n`, the self map `y ↦ n • y` on
+   the additive circle is ergodic (wrt the Haar measure).
+ * `add_circle.ergodic_zsmul_add`: given `n : ℤ` such that `1 < |n|` and `x : add_circle T`, the
+   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).
+ * `add_circle.ergodic_nsmul_add`: given `n : ℕ` such that `1 < n` and `x : add_circle T`, the
+   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).
+
+-/
+
+open set function measure_theory measure_theory.measure filter metric
+open_locale measure_theory nnreal ennreal topology pointwise
+
+namespace add_circle
+
+variables {T : ℝ} [hT : fact (0 < T)]
+include hT
+
+/-- If a null-measurable subset of the circle is almost invariant under rotation by a family of
+rational angles with denominators tending to infinity, then it must be almost empty or almost full.
+-/
+lemma ae_empty_or_univ_of_forall_vadd_ae_eq_self
+  {s : set $ add_circle T} (hs : null_measurable_set s volume)
+  {ι : Type*} {l : filter ι} [l.ne_bot] {u : ι → add_circle T}
+  (hu₁ : ∀ i, ((u i) +ᵥ s : set _) =ᵐ[volume] s) (hu₂ : tendsto (add_order_of ∘ u) l at_top) :
+  s =ᵐ[volume] (∅ : set $ add_circle T) ∨ s =ᵐ[volume] univ :=
+begin
+  /- Sketch of proof:
+  Assume `T = 1` for simplicity and let `μ` be the Haar measure. We may assume `s` has positive
+  measure since otherwise there is nothing to prove. In this case, by Lebesgue's density theorem,
+  there exists a point `d` of positive density. Let `Iⱼ` be the sequence of closed balls about `d`
+  of diameter `1 / nⱼ` where `nⱼ` is the additive order of `uⱼ`. Since `d` has positive density we
+  must have `μ (s ∩ Iⱼ) / μ Iⱼ → 1` along `l`. However since `s` is invariant under the action of
+  `uⱼ` and since `Iⱼ` is a fundamental domain for this action, we must have
+  `μ (s ∩ Iⱼ) = nⱼ * μ s = (μ Iⱼ) * μ s`. We thus have `μ s → 1` and thus `μ s = 1`. -/
+  set μ := (volume : measure $ add_circle T),
+  set n : ι → ℕ := add_order_of ∘ u,
+  have hT₀ : 0 < T := hT.out,
+  have hT₁ : ennreal.of_real T ≠ 0 := by simpa,
+  rw [ae_eq_empty, ae_eq_univ_iff_measure_eq hs, add_circle.measure_univ],
+  cases (eq_or_ne (μ s) 0) with h h, { exact or.inl h, },
+  right,
+  obtain ⟨d, -, hd⟩ : ∃ d, d ∈ s ∧ ∀ {ι'} {l : filter ι'} (w : ι' → add_circle T) (δ : ι' → ℝ),
+    tendsto δ l (𝓝[>] 0) → (∀ᶠ j in l, d ∈ closed_ball (w j) (1 * δ j)) →
+      tendsto (λ j, μ (s ∩ closed_ball (w j) (δ j)) / μ (closed_ball (w j) (δ j))) l (𝓝 1) :=
+    exists_mem_of_measure_ne_zero_of_ae h
+      (is_unif_loc_doubling_measure.ae_tendsto_measure_inter_div μ s 1),
+  let I : ι → set (add_circle T) := λ j, closed_ball d (T / (2 * ↑(n j))),
+  replace hd : tendsto (λ j, μ (s ∩ I j) / μ (I j)) l (𝓝 1),
+  { let δ : ι → ℝ := λ j, T / (2 * ↑(n j)),
+    have hδ₀ : ∀ᶠ j in l, 0 < δ j :=
+      (hu₂.eventually_gt_at_top 0).mono (λ j hj, div_pos hT₀ $ by positivity),
+    have hδ₁ : tendsto δ l (𝓝[>] 0),
+    { refine tendsto_nhds_within_iff.mpr ⟨_, hδ₀⟩,
+      replace hu₂ : tendsto (λ j, (T⁻¹ * 2) * n j) l at_top :=
+        (tendsto_coe_nat_at_top_iff.mpr hu₂).const_mul_at_top (by positivity : 0 < T⁻¹ * 2),
+      convert hu₂.inv_tendsto_at_top,
+      ext j,
+      simp only [δ, pi.inv_apply, mul_inv_rev, inv_inv, div_eq_inv_mul, ← mul_assoc], },
+    have hw : ∀ᶠ j in l, d ∈ closed_ball d (1 * δ j) := hδ₀.mono (λ j hj, by simp [hj.le]),
+    exact hd _ δ hδ₁ hw, },
+  suffices : ∀ᶠ j in l, μ (s ∩ I j) / μ (I j) = μ s / ennreal.of_real T,
+  { replace hd := hd.congr' this,
+    rwa [tendsto_const_nhds_iff, ennreal.div_eq_one_iff hT₁ ennreal.of_real_ne_top] at hd, },
+  refine (hu₂.eventually_gt_at_top 0).mono (λ j hj, _),
+  have huj : is_of_fin_add_order (u j) := add_order_of_pos_iff.mp hj,
+  have huj' : 1 ≤ (↑(n j) : ℝ), { norm_cast, exact nat.succ_le_iff.mpr hj, },
+  have hI₀ : μ (I j) ≠ 0 := (measure_closed_ball_pos _ d $ by positivity).ne.symm,
+  have hI₁ : μ (I j) ≠ ⊤ := measure_ne_top _ _,
+  have hI₂ : μ (I j) * ↑(n j) = ennreal.of_real T,
+  { rw [volume_closed_ball, mul_div, mul_div_mul_left T _ two_ne_zero,
+      min_eq_right (div_le_self hT₀.le huj'), mul_comm, ← nsmul_eq_mul, ← ennreal.of_real_nsmul,
+      nsmul_eq_mul, mul_div_cancel'],
+    exact nat.cast_ne_zero.mpr hj.ne', },
+  rw [ennreal.div_eq_div_iff hT₁ ennreal.of_real_ne_top hI₀ hI₁,
+    volume_of_add_preimage_eq s _ (u j) d huj (hu₁ j) closed_ball_ae_eq_ball, nsmul_eq_mul,
+    ← mul_assoc, hI₂],
+end
+
+lemma ergodic_zsmul {n : ℤ} (hn : 1 < |n|) : ergodic (λ (y : add_circle T), n • y) :=
+{ ae_empty_or_univ := λ s hs hs',
+  begin
+    let u : ℕ → add_circle T := λ j, ↑(((↑1 : ℝ) / ↑(n.nat_abs^j)) * T),
+    replace hn : 1 < n.nat_abs, { rwa [int.abs_eq_nat_abs, nat.one_lt_cast] at hn, },
+    have hu₀ : ∀ j, add_order_of (u j) = n.nat_abs^j,
+    { exact λ j, add_order_of_div_of_gcd_eq_one (pow_pos (pos_of_gt hn) j) (gcd_one_left _), },
+    have hnu : ∀ j, n^j • (u j) = 0 := λ j, by rw [← add_order_of_dvd_iff_zsmul_eq_zero, hu₀,
+      int.coe_nat_pow, int.coe_nat_abs, ← abs_pow, abs_dvd],
+    have hu₁ : ∀ j, ((u j) +ᵥ s : set _) =ᵐ[volume] s :=
+      λ j, by rw vadd_eq_self_of_preimage_zsmul_eq_self hs' (hnu j),
+    have hu₂ : tendsto (λ j, add_order_of $ u j) at_top at_top,
+    { simp_rw hu₀, exact nat.tendsto_pow_at_top_at_top_of_one_lt hn, },
+    exact ae_empty_or_univ_of_forall_vadd_ae_eq_self hs.null_measurable_set hu₁ hu₂,
+  end,
+  .. measure_preserving_zsmul volume (abs_pos.mp $ lt_trans zero_lt_one hn), }
+
+lemma ergodic_nsmul {n : ℕ} (hn : 1 < n) : ergodic (λ (y : add_circle T), n • y) :=
+ergodic_zsmul (by simp [hn] : 1 < |(n : ℤ)|)
+
+lemma ergodic_zsmul_add (x : add_circle T) {n : ℤ} (h : 1 < |n|) : ergodic $ λ y, n • y + x :=
+begin
+  set f : add_circle T → add_circle T := λ y, n • y + x,
+  let e : add_circle T ≃ᵐ add_circle T := measurable_equiv.add_left (divisible_by.div x $ n - 1),
+  have he : measure_preserving e volume volume := measure_preserving_add_left volume _,
+  suffices : e ∘ f ∘ e.symm = λ y, n • y,
+  { rw [← he.ergodic_conjugate_iff, this], exact ergodic_zsmul h, },
+  replace h : n - 1 ≠ 0, { rw ←abs_one at h, rw sub_ne_zero, exact ne_of_apply_ne _ (ne_of_gt h), },
+  have hnx : n • divisible_by.div x (n - 1) = x + divisible_by.div x (n - 1),
+  { conv_rhs { congr, rw ←divisible_by.div_cancel x h }, rw [sub_smul, one_smul, sub_add_cancel], },
+  ext y,
+  simp only [f, hnx, measurable_equiv.coe_add_left, measurable_equiv.symm_add_left, comp_app,
+    smul_add, zsmul_neg', neg_smul, neg_add_rev],
+  abel,
+end
+
+lemma ergodic_nsmul_add (x : add_circle T) {n : ℕ} (h : 1 < n) : ergodic $ λ y, n • y + x :=
+ergodic_zsmul_add x (by simp [h] : 1 < |(n : ℤ)|)
+
+end add_circle
diff --git a/src/dynamics/ergodic/conservative.lean b/src/dynamics/ergodic/conservative.lean
index 58899311fd3c6..19c1596937165 100644
--- a/src/dynamics/ergodic/conservative.lean
+++ b/src/dynamics/ergodic/conservative.lean
@@ -3,13 +3,16 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
 import dynamics.ergodic.measure_preserving
 import combinatorics.pigeonhole
 
 /-!
 # Conservative systems
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `f : α → α` to be a *conservative* system w.r.t a measure `μ` if `f` is
 non-singular (`measure_theory.quasi_measure_preserving`) and for every measurable set `s` of
 positive measure at least one point `x ∈ s` returns back to `s` after some number of iterations of
@@ -38,7 +41,7 @@ conservative dynamical system, Poincare recurrence theorem
 noncomputable theory
 
 open classical set filter measure_theory finset function topological_space
-open_locale classical topological_space
+open_locale classical topology
 
 variables {ι : Type*} {α : Type*} [measurable_space α] {f : α → α} {s : set α} {μ : measure α}
 
@@ -82,10 +85,10 @@ begin
   rcases ihN with ⟨n, hn, hμn⟩,
   set T := s ∩ ⋃ n ≥ N + 1, (f^[n]) ⁻¹' s,
   have hT : measurable_set T,
-    from hs.inter (measurable_set.bUnion (countable_encodable _)
+    from hs.inter (measurable_set.bUnion (to_countable _)
       (λ _ _, hf.measurable.iterate _ hs)),
   have hμT : μ T = 0,
-  { convert (measure_bUnion_null_iff $ countable_encodable _).2 hN,
+  { convert (measure_bUnion_null_iff $ to_countable _).2 hN,
     rw ←inter_Union₂, refl },
   have : μ ((s ∩ (f^[n]) ⁻¹' s) \ T) ≠ 0, by rwa [measure_diff_null hμT],
   rcases hf.exists_mem_image_mem ((hs.inter (hf.measurable.iterate n hs)).diff hT) this
@@ -114,7 +117,7 @@ begin
   by_contradiction H,
   have : measurable_set (s ∩ {x | ∀ m ≥ n, f^[m] x ∉ s}),
   { simp only [set_of_forall, ← compl_set_of],
-    exact hs.inter (measurable_set.bInter (countable_encodable _)
+    exact hs.inter (measurable_set.bInter (to_countable _)
       (λ m _, hf.measurable.iterate m hs.compl)) },
   rcases (hf.exists_gt_measure_inter_ne_zero this H) n with ⟨m, hmn, hm⟩,
   rcases nonempty_of_measure_ne_zero hm with ⟨x, ⟨hxs, hxn⟩, hxm, -⟩,
diff --git a/src/dynamics/ergodic/ergodic.lean b/src/dynamics/ergodic/ergodic.lean
new file mode 100644
index 0000000000000..a9a005f971042
--- /dev/null
+++ b/src/dynamics/ergodic/ergodic.lean
@@ -0,0 +1,189 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import dynamics.ergodic.measure_preserving
+
+/-!
+# Ergodic maps and measures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `f : α → α` be measure preserving with respect to a measure `μ`. We say `f` is ergodic with
+respect to `μ` (or `μ` is ergodic with respect to `f`) if the only measurable sets `s` such that
+`f⁻¹' s = s` are either almost empty or full.
+
+In this file we define ergodic maps / measures together with quasi-ergodic maps / measures and
+provide some basic API. Quasi-ergodicity is a weaker condition than ergodicity for which the measure
+preserving condition is relaxed to quasi measure preserving.
+
+# Main definitions:
+
+ * `pre_ergodic`: the ergodicity condition without the measure preserving condition. This exists
+   to share code between the `ergodic` and `quasi_ergodic` definitions.
+ * `ergodic`: the definition of ergodic maps / measures.
+ * `quasi_ergodic`: the definition of quasi ergodic maps / measures.
+ * `ergodic.quasi_ergodic`: an ergodic map / measure is quasi ergodic.
+ * `quasi_ergodic.ae_empty_or_univ'`: when the map is quasi measure preserving, one may relax the
+   strict invariance condition to almost invariance in the ergodicity condition.
+
+-/
+
+open set function filter measure_theory measure_theory.measure
+open_locale ennreal
+
+variables {α : Type*} {m : measurable_space α} (f : α → α) {s : set α}
+include m
+
+/-- A map `f : α → α` is said to be pre-ergodic with respect to a measure `μ` if any measurable
+strictly invariant set is either almost empty or full. -/
+structure pre_ergodic (μ : measure α . volume_tac) : Prop :=
+(ae_empty_or_univ : ∀ ⦃s⦄, measurable_set s → f⁻¹' s = s → s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ)
+
+/-- A map `f : α → α` is said to be ergodic with respect to a measure `μ` if it is measure
+preserving and pre-ergodic. -/
+@[nolint has_nonempty_instance] structure ergodic (μ : measure α . volume_tac) extends
+  measure_preserving f μ μ, pre_ergodic f μ : Prop
+
+/-- A map `f : α → α` is said to be quasi ergodic with respect to a measure `μ` if it is quasi
+measure preserving and pre-ergodic. -/
+@[nolint has_nonempty_instance] structure quasi_ergodic (μ : measure α . volume_tac) extends
+  quasi_measure_preserving f μ μ, pre_ergodic f μ : Prop
+
+variables {f} {μ : measure α}
+
+namespace pre_ergodic
+
+lemma measure_self_or_compl_eq_zero (hf : pre_ergodic f μ)
+  (hs : measurable_set s) (hs' : f⁻¹' s = s) :
+  μ s = 0 ∨ μ sᶜ = 0 :=
+by simpa using hf.ae_empty_or_univ hs hs'
+
+/-- On a probability space, the (pre)ergodicity condition is a zero one law. -/
+lemma prob_eq_zero_or_one [is_probability_measure μ] (hf : pre_ergodic f μ)
+  (hs : measurable_set s) (hs' : f⁻¹' s = s) :
+  μ s = 0 ∨ μ s = 1 :=
+by simpa [hs] using hf.measure_self_or_compl_eq_zero hs hs'
+
+lemma of_iterate (n : ℕ) (hf : pre_ergodic (f^[n]) μ) : pre_ergodic f μ :=
+⟨λ s hs hs', hf.ae_empty_or_univ hs $ is_fixed_pt.preimage_iterate hs' n⟩
+
+end pre_ergodic
+
+namespace measure_theory.measure_preserving
+
+variables {β : Type*} {m' : measurable_space β} {μ' : measure β} {s' : set β} {g : α → β}
+
+lemma pre_ergodic_of_pre_ergodic_conjugate (hg : measure_preserving g μ μ')
+  (hf : pre_ergodic f μ) {f' : β → β} (h_comm : g ∘ f = f' ∘ g) :
+  pre_ergodic f' μ' :=
+⟨begin
+  intros s hs₀ hs₁,
+  replace hs₁ : f⁻¹' (g⁻¹' s) = g⁻¹' s, { rw [← preimage_comp, h_comm, preimage_comp, hs₁], },
+  cases hf.ae_empty_or_univ (hg.measurable hs₀) hs₁ with hs₂ hs₂;
+  [left, right],
+  { simpa only [ae_eq_empty, hg.measure_preimage hs₀] using hs₂, },
+  { simpa only [ae_eq_univ, ← preimage_compl, hg.measure_preimage hs₀.compl] using hs₂, },
+end⟩
+
+lemma pre_ergodic_conjugate_iff {e : α ≃ᵐ β} (h : measure_preserving e μ μ') :
+  pre_ergodic (e ∘ f ∘ e.symm) μ' ↔ pre_ergodic f μ :=
+begin
+  refine ⟨λ hf, pre_ergodic_of_pre_ergodic_conjugate (h.symm e) hf _,
+          λ hf, pre_ergodic_of_pre_ergodic_conjugate h hf _⟩,
+  { change (e.symm ∘ e) ∘ f ∘ e.symm = f ∘ e.symm,
+    rw [measurable_equiv.symm_comp_self, comp.left_id], },
+  { change e ∘ f = e ∘ f ∘ e.symm ∘ e,
+    rw [measurable_equiv.symm_comp_self, comp.right_id], },
+end
+
+lemma ergodic_conjugate_iff {e : α ≃ᵐ β} (h : measure_preserving e μ μ') :
+  ergodic (e ∘ f ∘ e.symm) μ' ↔ ergodic f μ :=
+begin
+  have : measure_preserving (e ∘ f ∘ e.symm) μ' μ' ↔ measure_preserving f μ μ :=
+    by rw [h.comp_left_iff, (measure_preserving.symm e h).comp_right_iff],
+  replace h : pre_ergodic (e ∘ f ∘ e.symm) μ' ↔ pre_ergodic f μ := h.pre_ergodic_conjugate_iff,
+  exact ⟨λ hf, { .. this.mp hf.to_measure_preserving, .. h.mp hf.to_pre_ergodic, },
+         λ hf, { .. this.mpr hf.to_measure_preserving, .. h.mpr hf.to_pre_ergodic, }⟩,
+end
+
+end measure_theory.measure_preserving
+
+namespace quasi_ergodic
+
+/-- For a quasi ergodic map, sets that are almost invariant (rather than strictly invariant) are
+still either almost empty or full. -/
+lemma ae_empty_or_univ'
+  (hf : quasi_ergodic f μ) (hs : measurable_set s) (hs' : f⁻¹' s =ᵐ[μ] s) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+begin
+  obtain ⟨t, h₀, h₁, h₂⟩ := hf.to_quasi_measure_preserving.exists_preimage_eq_of_preimage_ae hs hs',
+  rcases hf.ae_empty_or_univ h₀ h₂ with h₃ | h₃;
+  [left, right];
+  exact ae_eq_trans h₁.symm h₃,
+end
+
+end quasi_ergodic
+
+namespace ergodic
+
+/-- An ergodic map is quasi ergodic. -/
+lemma quasi_ergodic (hf : ergodic f μ) : quasi_ergodic f μ :=
+{ .. hf.to_pre_ergodic,
+  .. hf.to_measure_preserving.quasi_measure_preserving, }
+
+/-- See also `ergodic.ae_empty_or_univ_of_preimage_ae_le`. -/
+lemma ae_empty_or_univ_of_preimage_ae_le'
+  (hf : ergodic f μ) (hs : measurable_set s) (hs' : f⁻¹' s ≤ᵐ[μ] s) (h_fin : μ s ≠ ∞) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+begin
+  refine hf.quasi_ergodic.ae_empty_or_univ' hs _,
+  refine ae_eq_of_ae_subset_of_measure_ge hs' (hf.measure_preimage hs).symm.le _ h_fin,
+  exact measurable_set_preimage hf.measurable hs,
+end
+
+/-- See also `ergodic.ae_empty_or_univ_of_ae_le_preimage`. -/
+lemma ae_empty_or_univ_of_ae_le_preimage'
+  (hf : ergodic f μ) (hs : measurable_set s) (hs' : s ≤ᵐ[μ] f⁻¹' s) (h_fin : μ s ≠ ∞) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+begin
+  replace h_fin : μ (f⁻¹' s) ≠ ∞, { rwa hf.measure_preimage hs, },
+  refine hf.quasi_ergodic.ae_empty_or_univ' hs _,
+  exact (ae_eq_of_ae_subset_of_measure_ge hs' (hf.measure_preimage hs).le hs h_fin).symm,
+end
+
+/-- See also `ergodic.ae_empty_or_univ_of_image_ae_le`. -/
+lemma ae_empty_or_univ_of_image_ae_le'
+  (hf : ergodic f μ) (hs : measurable_set s) (hs' : f '' s ≤ᵐ[μ] s) (h_fin : μ s ≠ ∞) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+begin
+  replace hs' : s ≤ᵐ[μ] f ⁻¹' s :=
+    (has_subset.subset.eventually_le (subset_preimage_image f s)).trans
+    (hf.quasi_measure_preserving.preimage_mono_ae hs'),
+  exact ae_empty_or_univ_of_ae_le_preimage' hf hs hs' h_fin,
+end
+
+section is_finite_measure
+
+variables [is_finite_measure μ]
+
+lemma ae_empty_or_univ_of_preimage_ae_le
+  (hf : ergodic f μ) (hs : measurable_set s) (hs' : f⁻¹' s ≤ᵐ[μ] s) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+ae_empty_or_univ_of_preimage_ae_le' hf hs hs' $ measure_ne_top μ s
+
+lemma ae_empty_or_univ_of_ae_le_preimage
+  (hf : ergodic f μ) (hs : measurable_set s) (hs' : s ≤ᵐ[μ] f⁻¹' s) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+ae_empty_or_univ_of_ae_le_preimage' hf hs hs' $ measure_ne_top μ s
+
+lemma ae_empty_or_univ_of_image_ae_le
+  (hf : ergodic f μ) (hs : measurable_set s) (hs' : f '' s ≤ᵐ[μ] s) :
+  s =ᵐ[μ] (∅ : set α) ∨ s =ᵐ[μ] univ :=
+ae_empty_or_univ_of_image_ae_le' hf hs hs' $ measure_ne_top μ s
+
+end is_finite_measure
+
+end ergodic
diff --git a/src/dynamics/ergodic/measure_preserving.lean b/src/dynamics/ergodic/measure_preserving.lean
index 305c3f171284b..9942a6e3fcffd 100644
--- a/src/dynamics/ergodic/measure_preserving.lean
+++ b/src/dynamics/ergodic/measure_preserving.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.ae_measurable
 /-!
 # Measure preserving maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that `f : α → β` is a measure preserving map w.r.t. measures `μ : measure α` and
 `ν : measure β` if `f` is measurable and `map f μ = ν`. In this file we define the predicate
 `measure_theory.measure_preserving` and prove its basic properties.
@@ -83,11 +86,27 @@ protected lemma quasi_measure_preserving {f : α → β} (hf : measure_preservin
   quasi_measure_preserving f μa μb :=
 ⟨hf.1, hf.2.absolutely_continuous⟩
 
-lemma comp {g : β → γ} {f : α → β} (hg : measure_preserving g μb μc)
+protected lemma comp {g : β → γ} {f : α → β} (hg : measure_preserving g μb μc)
   (hf : measure_preserving f μa μb) :
   measure_preserving (g ∘ f) μa μc :=
 ⟨hg.1.comp hf.1, by rw [← map_map hg.1 hf.1, hf.2, hg.2]⟩
 
+protected lemma comp_left_iff {g : α → β} {e : β ≃ᵐ γ} (h : measure_preserving e μb μc) :
+  measure_preserving (e ∘ g) μa μc ↔ measure_preserving g μa μb :=
+begin
+  refine ⟨λ hg, _, λ hg, h.comp hg⟩,
+  convert (measure_preserving.symm e h).comp hg,
+  simp [← function.comp.assoc e.symm e g],
+end
+
+protected lemma comp_right_iff {g : α → β} {e : γ ≃ᵐ α} (h : measure_preserving e μc μa) :
+  measure_preserving (g ∘ e) μc μb ↔ measure_preserving g μa μb :=
+begin
+  refine ⟨λ hg, _, λ hg, hg.comp h⟩,
+  convert hg.comp (measure_preserving.symm e h),
+  simp [function.comp.assoc g e e.symm],
+end
+
 protected lemma sigma_finite {f : α → β} (hf : measure_preserving f μa μb) [sigma_finite μb] :
   sigma_finite μa :=
 sigma_finite.of_map μa hf.ae_measurable (by rwa hf.map_eq)
@@ -121,12 +140,11 @@ begin
     by simpa only [B, nsmul_eq_mul, finset.sum_const, finset.card_range],
   rcases exists_nonempty_inter_of_measure_univ_lt_sum_measure μ (λ m hm, A m) this
     with ⟨i, hi, j, hj, hij, x, hxi, hxj⟩,
-  -- without `tactic.skip` Lean closes the extra goal but it takes a long time; not sure why
-  wlog hlt : i < j := hij.lt_or_lt using [i j, j i] tactic.skip,
-  { simp only [set.mem_preimage, finset.mem_range] at hi hj hxi hxj,
-    refine ⟨f^[i] x, hxi, j - i, ⟨tsub_pos_of_lt hlt, lt_of_le_of_lt (j.sub_le i) hj⟩, _⟩,
-    rwa [← iterate_add_apply, tsub_add_cancel_of_le hlt.le] },
-  { exact λ hi hj hij hxi hxj, this hj hi hij.symm hxj hxi }
+  wlog hlt : i < j generalizing i j,
+  { exact this j hj i hi hij.symm hxj hxi (hij.lt_or_lt.resolve_left hlt) },
+  simp only [set.mem_preimage, finset.mem_range] at hi hj hxi hxj,
+  refine ⟨f^[i] x, hxi, j - i, ⟨tsub_pos_of_lt hlt, lt_of_le_of_lt (j.sub_le i) hj⟩, _⟩,
+  rwa [← iterate_add_apply, tsub_add_cancel_of_le hlt.le]
 end
 
 /-- A self-map preserving a finite measure is conservative: if `μ s ≠ 0`, then at least one point
@@ -144,4 +162,11 @@ end
 
 end measure_preserving
 
+namespace measurable_equiv
+
+lemma measure_preserving_symm (μ : measure α) (e : α ≃ᵐ β) :
+  measure_preserving e.symm (map e μ) μ :=
+(e.measurable.measure_preserving μ).symm _
+
+end measurable_equiv
 end measure_theory
diff --git a/src/dynamics/fixed_points/basic.lean b/src/dynamics/fixed_points/basic.lean
index 27623adab8802..d5eda405f92dc 100644
--- a/src/dynamics/fixed_points/basic.lean
+++ b/src/dynamics/fixed_points/basic.lean
@@ -5,10 +5,14 @@ Authors: Yury Kudryashov
 -/
 import data.set.function
 import logic.function.iterate
+import group_theory.perm.basic
 
 /-!
 # Fixed points of a self-map
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define
 
 * the predicate `is_fixed_pt f x := f x = x`;
@@ -21,9 +25,11 @@ We also prove some simple lemmas about `is_fixed_pt` and `∘`, `iterate`, and `
 fixed point
 -/
 
+open equiv
+
 universes u v
 
-variables {α : Type u} {β : Type v} {f fa g : α → α} {x y : α} {fb : β → β} {m n k : ℕ}
+variables {α : Type u} {β : Type v} {f fa g : α → α} {x y : α} {fb : β → β} {m n k : ℕ} {e : perm α}
 
 namespace function
 
@@ -71,6 +77,22 @@ calc fb (g x) = g (fa x) : (h.eq x).symm
 protected lemma apply {x : α} (hx : is_fixed_pt f x) : is_fixed_pt f (f x) :=
 by convert hx
 
+lemma preimage_iterate {s : set α} (h : is_fixed_pt (set.preimage f) s) (n : ℕ) :
+  is_fixed_pt (set.preimage (f^[n])) s :=
+by { rw set.preimage_iterate_eq, exact h.iterate n, }
+
+protected lemma equiv_symm (h : is_fixed_pt e x) : is_fixed_pt e.symm x :=
+h.to_left_inverse e.left_inverse_symm
+
+protected lemma perm_inv (h : is_fixed_pt e x) : is_fixed_pt ⇑(e⁻¹) x := h.equiv_symm
+
+protected lemma perm_pow (h : is_fixed_pt e x) (n : ℕ) : is_fixed_pt ⇑(e ^ n) x :=
+by { rw equiv.perm.coe_pow, exact h.iterate _ }
+
+protected lemma perm_zpow (h : is_fixed_pt e x) : ∀ n : ℤ, is_fixed_pt ⇑(e ^ n) x
+| (int.of_nat n) := h.perm_pow _
+| (int.neg_succ_of_nat n) := (h.perm_pow $ n + 1).perm_inv
+
 end is_fixed_pt
 
 @[simp] lemma injective.is_fixed_pt_apply_iff (hf : injective f) {x : α} :
diff --git a/src/dynamics/fixed_points/topology.lean b/src/dynamics/fixed_points/topology.lean
index 665a645538719..ace366252c332 100644
--- a/src/dynamics/fixed_points/topology.lean
+++ b/src/dynamics/fixed_points/topology.lean
@@ -9,6 +9,9 @@ import topology.separation
 /-!
 # Topological properties of fixed points
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Currently this file contains two lemmas:
 
 - `is_fixed_pt_of_tendsto_iterate`: if `f^n(x) → y` and `f` is continuous at `y`, then `f y = y`;
@@ -22,7 +25,7 @@ fixed points, iterates
 variables {α : Type*} [topological_space α] [t2_space α] {f : α → α}
 
 open function filter
-open_locale topological_space
+open_locale topology
 
 /-- If the iterates `f^[n] x` converge to `y` and `f` is continuous at `y`,
 then `y` is a fixed point for `f`. -/
diff --git a/src/dynamics/flow.lean b/src/dynamics/flow.lean
index 5103f6a58c727..14000867f74f3 100644
--- a/src/dynamics/flow.lean
+++ b/src/dynamics/flow.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jean Lo
 -/
 
-import topology.algebra.group
+import topology.algebra.group.basic
 import logic.function.iterate
 
 /-!
 # Flows and invariant sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a flow on a topological space `α` by a topological
 monoid `τ` as a continuous monoid-act of `τ` on `α`. Anticipating the
 cases where `τ` is one of `ℕ`, `ℤ`, `ℝ⁺`, or `ℝ`, we use additive
@@ -109,7 +112,7 @@ protected lemma continuous {β : Type*} [topological_space β]
   continuous (λ x, ϕ (t x) (f x)) :=
 ϕ.cont'.comp (ht.prod_mk hf)
 
-alias flow.continuous ← continuous.flow
+alias flow.continuous ← _root_.continuous.flow
 
 lemma map_add (t₁ t₂ : τ) (x : α) : ϕ (t₁ + t₂) x = ϕ t₁ (ϕ t₂ x) :=
 ϕ.map_add' _ _ _
@@ -129,8 +132,7 @@ def from_iter {g : α → α} (h : continuous g) : flow ℕ α :=
 /-- Restriction of a flow onto an invariant set. -/
 def restrict {s : set α} (h : is_invariant ϕ s) : flow τ ↥s :=
 { to_fun    := λ t, (h t).restrict _ _ _,
-  cont'     := continuous_subtype_mk _ (ϕ.continuous continuous_fst
-    (continuous_subtype_coe.comp continuous_snd)),
+  cont'     := (ϕ.continuous continuous_fst continuous_subtype_coe.snd').subtype_mk _,
   map_add'  := λ _ _ _, subtype.ext (map_add _ _ _ _),
   map_zero' := λ _, subtype.ext (map_zero_apply _ _)}
 
diff --git a/src/dynamics/minimal.lean b/src/dynamics/minimal.lean
index fbe3a23715fe8..0f2dbe871cb8d 100644
--- a/src/dynamics/minimal.lean
+++ b/src/dynamics/minimal.lean
@@ -3,12 +3,15 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import topology.algebra.mul_action
 import group_theory.group_action.basic
+import topology.algebra.const_mul_action
 
 /-!
 # Minimal action of a group
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define an action of a monoid `M` on a topological space `α` to be *minimal* if the
 `M`-orbit of every point `x : α` is dense. We also provide an additive version of this definition
 and prove some basic facts about minimal actions.
diff --git a/src/dynamics/omega_limit.lean b/src/dynamics/omega_limit.lean
index 8a9c50a52a212..1f1866f150ec7 100644
--- a/src/dynamics/omega_limit.lean
+++ b/src/dynamics/omega_limit.lean
@@ -8,6 +8,9 @@ import dynamics.flow
 /-!
 # ω-limits
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For a function `ϕ : τ → α → β` where `β` is a topological space, we
 define the ω-limit under `ϕ` of a set `s` in `α` with respect to
 filter `f` on `τ`: an element `y : β` is in the ω-limit of `s` if the
@@ -30,7 +33,7 @@ endowed with an order.
 -/
 
 open set function filter
-open_locale topological_space
+open_locale topology
 
 /-!
 ### Definition and notation
@@ -45,10 +48,10 @@ variables {τ : Type*} {α : Type*} {β : Type*} {ι : Type*}
 def omega_limit [topological_space β] (f : filter τ) (ϕ : τ → α → β) (s : set α) : set β :=
 ⋂ u ∈ f, closure (image2 ϕ u s)
 
-localized "notation `ω` := omega_limit" in omega_limit
+localized "notation (name := omega_limit) `ω` := omega_limit" in omega_limit
 
-localized "notation `ω⁺` := omega_limit filter.at_top" in omega_limit
-localized "notation `ω⁻` := omega_limit filter.at_bot" in omega_limit
+localized "notation (name := omega_limit.at_top) `ω⁺` := omega_limit filter.at_top" in omega_limit
+localized "notation (name := omega_limit.at_bot) `ω⁻` := omega_limit filter.at_bot" in omega_limit
 
 variables [topological_space β]
 variables (f : filter τ) (ϕ : τ → α → β) (s s₁ s₂: set α)
@@ -68,7 +71,7 @@ begin
 end
 
 lemma omega_limit_mono_left {f₁ f₂ : filter τ} (hf : f₁ ≤ f₂) : ω f₁ ϕ s ⊆ ω f₂ ϕ s :=
-omega_limit_subset_of_tendsto ϕ s (tendsto_id' hf)
+omega_limit_subset_of_tendsto ϕ s (tendsto_id'.2 hf)
 
 lemma omega_limit_mono_right {s₁ s₂ : set α} (hs : s₁ ⊆ s₂) : ω f ϕ s₁ ⊆ ω f ϕ s₂ :=
 Inter₂_mono $ λ u hu, closure_mono (image2_subset subset.rfl hs)
@@ -218,7 +221,7 @@ begin
   rcases hc₂ with ⟨v, hv₁, hv₂⟩,
   let k := closure (image2 ϕ v s),
   have hk : is_compact (k \ n) :=
-    is_compact.diff (compact_of_is_closed_subset hc₁ is_closed_closure hv₂) hn₁,
+    is_compact.diff (is_compact_of_is_closed_subset hc₁ is_closed_closure hv₂) hn₁,
   let j := λ u, (closure (image2 ϕ (u ∩ v) s))ᶜ,
   have hj₁ : ∀ u ∈ f, is_open (j u), from
     λ _ _, (is_open_compl_iff.mpr is_closed_closure),
@@ -279,7 +282,7 @@ lemma eventually_closure_subset_of_is_open_of_omega_limit_subset [compact_space
   {v : set β} (hv₁ : is_open v) (hv₂ : ω f ϕ s ⊆ v) :
   ∃ u ∈ f, closure (image2 ϕ u s) ⊆ v :=
 eventually_closure_subset_of_is_compact_absorbing_of_is_open_of_omega_limit_subset'
-  _ _ _ compact_univ ⟨univ, univ_mem, subset_univ _⟩ hv₁ hv₂
+  _ _ _ is_compact_univ ⟨univ, univ_mem, subset_univ _⟩ hv₁ hv₂
 
 lemma eventually_maps_to_of_is_open_of_omega_limit_subset [compact_space β]
   {v : set β} (hv₁ : is_open v) (hv₂ : ω f ϕ s ⊆ v) :
@@ -308,7 +311,7 @@ begin
       nonempty.image2 (nonempty_of_mem (inter_mem u.prop hv₁)) hs,
     exact hn.mono subset_closure },
   { intro _,
-    apply compact_of_is_closed_subset hc₁ is_closed_closure,
+    apply is_compact_of_is_closed_subset hc₁ is_closed_closure,
     calc _ ⊆ closure (image2 ϕ v s) : closure_mono (image2_subset
                                         (inter_subset_right _ _) subset.rfl)
     ...    ⊆ c : hv₂ },
@@ -318,7 +321,7 @@ end
 lemma nonempty_omega_limit [compact_space β] [ne_bot f] (hs : s.nonempty) :
   (ω f ϕ s).nonempty :=
 nonempty_omega_limit_of_is_compact_absorbing _ _ _
-  compact_univ ⟨univ, univ_mem, subset_univ _⟩ hs
+  is_compact_univ ⟨univ, univ_mem, subset_univ _⟩ hs
 
 end omega_limit
 
diff --git a/src/dynamics/periodic_pts.lean b/src/dynamics/periodic_pts.lean
index 004ee9f03663a..353804e7661ea 100644
--- a/src/dynamics/periodic_pts.lean
+++ b/src/dynamics/periodic_pts.lean
@@ -4,14 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import algebra.hom.iterate
+import data.list.cycle
+import data.pnat.basic
 import data.nat.prime
 import dynamics.fixed_points.basic
-import data.pnat.basic
-import data.set.lattice
+import group_theory.group_action.group
 
 /-!
 # Periodic points
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A point `x : α` is a periodic point of `f : α → α` of period `n` if `f^[n] x = x`.
 
 ## Main definitions
@@ -23,6 +27,7 @@ A point `x : α` is a periodic point of `f : α → α` of period `n` if `f^[n]
 * `periodic_pts f` : the set of all periodic points of `f`.
 * `minimal_period f x` : the minimal period of a point `x` under an endomorphism `f` or zero
   if `x` is not a periodic point of `f`.
+* `orbit f x`: the cycle `[x, f x, f (f x), ...]` for a periodic point.
 
 ## Main statements
 
@@ -229,8 +234,7 @@ then `minimal_period f x = 0`. -/
 def minimal_period (f : α → α) (x : α) :=
 if h : x ∈ periodic_pts f then nat.find h else 0
 
-lemma is_periodic_pt_minimal_period (f : α → α) (x : α) :
-  is_periodic_pt f (minimal_period f x) x :=
+lemma is_periodic_pt_minimal_period (f : α → α) (x : α) : is_periodic_pt f (minimal_period f x) x :=
 begin
   delta minimal_period,
   split_ifs with hx,
@@ -238,16 +242,23 @@ begin
   { exact is_periodic_pt_zero f x }
 end
 
-lemma iterate_minimal_period (f : α → α) (x : α) : f^[minimal_period f x] x = x :=
+@[simp] lemma iterate_minimal_period : f^[minimal_period f x] x = x :=
 is_periodic_pt_minimal_period f x
 
-lemma iterate_eq_mod_minimal_period : f^[n] x = (f^[n % minimal_period f x] x) :=
-((is_periodic_pt_minimal_period f x).iterate_mod_apply n).symm
+@[simp] lemma iterate_add_minimal_period_eq : f^[n + minimal_period f x] x = (f^[n] x) :=
+by { rw iterate_add_apply, congr, exact is_periodic_pt_minimal_period f x }
+
+@[simp] lemma iterate_mod_minimal_period_eq : f^[n % minimal_period f x] x = (f^[n] x) :=
+(is_periodic_pt_minimal_period f x).iterate_mod_apply n
 
 lemma minimal_period_pos_of_mem_periodic_pts (hx : x ∈ periodic_pts f) :
   0 < minimal_period f x :=
 by simp only [minimal_period, dif_pos hx, (nat.find_spec hx).fst.lt]
 
+lemma minimal_period_eq_zero_of_nmem_periodic_pts (hx : x ∉ periodic_pts f) :
+  minimal_period f x = 0 :=
+by simp only [minimal_period, dif_neg hx]
+
 lemma is_periodic_pt.minimal_period_pos (hn : 0 < n) (hx : is_periodic_pt f n x) :
   0 < minimal_period f x :=
 minimal_period_pos_of_mem_periodic_pts $ mk_mem_periodic_pts hn hx
@@ -258,6 +269,9 @@ lemma minimal_period_pos_iff_mem_periodic_pts :
   by simp only [minimal_period, dif_neg h, lt_irrefl 0, not_false_iff],
   minimal_period_pos_of_mem_periodic_pts⟩
 
+lemma minimal_period_eq_zero_iff_nmem_periodic_pts : minimal_period f x = 0 ↔ x ∉ periodic_pts f :=
+by rw [←minimal_period_pos_iff_mem_periodic_pts, not_lt, nonpos_iff_eq_zero]
+
 lemma is_periodic_pt.minimal_period_le (hn : 0 < n) (hx : is_periodic_pt f n x) :
   minimal_period f x ≤ n :=
 begin
@@ -265,16 +279,42 @@ begin
   exact nat.find_min' (mk_mem_periodic_pts hn hx) ⟨hn, hx⟩
 end
 
-lemma iterate_injective_of_lt_minimal_period (hm : m < minimal_period f x)
-  (hn : n < minimal_period f x) (hf : (f^[m] x) = (f^[n] x)) : m = n :=
+lemma minimal_period_apply_iterate (hx : x ∈ periodic_pts f) (n : ℕ) :
+  minimal_period f (f^[n] x) = minimal_period f x :=
 begin
-  wlog h_le : n ≤ m,
-  rw [←h_le.le_iff_eq, ←tsub_le_tsub_iff_left hm.le, tsub_le_iff_right],
-  apply is_periodic_pt.minimal_period_le (nat.add_pos_left (tsub_pos_of_lt hm) n),
-  rw [is_periodic_pt, is_fixed_pt, iterate_add_apply, ←hf, ←iterate_add_apply,
-      nat.sub_add_cancel hm.le, iterate_minimal_period],
+  apply (is_periodic_pt.minimal_period_le (minimal_period_pos_of_mem_periodic_pts hx) _).antisymm
+    ((is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate hx
+      (is_periodic_pt_minimal_period f _)).minimal_period_le
+    (minimal_period_pos_of_mem_periodic_pts _)),
+  { exact (is_periodic_pt_minimal_period f x).apply_iterate n, },
+  { rcases hx with ⟨m, hm, hx⟩,
+    exact ⟨m, hm, hx.apply_iterate n⟩ }
 end
 
+lemma minimal_period_apply (hx : x ∈ periodic_pts f) :
+  minimal_period f (f x) = minimal_period f x :=
+minimal_period_apply_iterate hx 1
+
+lemma le_of_lt_minimal_period_of_iterate_eq {m n : ℕ} (hm : m < minimal_period f x)
+  (hmn : f^[m] x = (f^[n] x)) : m ≤ n :=
+begin
+  by_contra' hmn',
+  rw [←nat.add_sub_of_le hmn'.le, add_comm, iterate_add_apply] at hmn,
+  exact ((is_periodic_pt.minimal_period_le (tsub_pos_of_lt hmn')
+    (is_periodic_pt_of_mem_periodic_pts_of_is_periodic_pt_iterate
+    (minimal_period_pos_iff_mem_periodic_pts.1 ((zero_le m).trans_lt hm)) hmn)).trans
+    (nat.sub_le m n)).not_lt hm
+end
+
+lemma eq_of_lt_minimal_period_of_iterate_eq {m n : ℕ} (hm : m < minimal_period f x)
+  (hn : n < minimal_period f x) (hmn : f^[m] x = (f^[n] x)) : m = n :=
+(le_of_lt_minimal_period_of_iterate_eq hm hmn).antisymm
+  (le_of_lt_minimal_period_of_iterate_eq hn hmn.symm)
+
+lemma eq_iff_lt_minimal_period_of_iterate_eq {m n : ℕ} (hm : m < minimal_period f x)
+  (hn : n < minimal_period f x) : f^[m] x = (f^[n] x) ↔ m = n :=
+⟨eq_of_lt_minimal_period_of_iterate_eq hm hn, congr_arg _⟩
+
 lemma minimal_period_id : minimal_period id x = 1 :=
 ((is_periodic_id _ _ ).minimal_period_le nat.one_pos).antisymm
   (nat.succ_le_of_lt ((is_periodic_id _ _ ).minimal_period_pos nat.one_pos))
@@ -291,25 +331,22 @@ begin
 end
 
 lemma is_periodic_pt.eq_zero_of_lt_minimal_period (hx : is_periodic_pt f n x)
-  (hn : n < minimal_period f x) :
-  n = 0 :=
+  (hn : n < minimal_period f x) : n = 0 :=
 eq.symm $ (eq_or_lt_of_le $ n.zero_le).resolve_right $ λ hn0,
 not_lt.2 (hx.minimal_period_le hn0) hn
 
 lemma not_is_periodic_pt_of_pos_of_lt_minimal_period :
-  ∀ {n: ℕ} (n0 : n ≠ 0) (hn : n < minimal_period f x), ¬ is_periodic_pt f n x
+  ∀ {n : ℕ} (n0 : n ≠ 0) (hn : n < minimal_period f x), ¬ is_periodic_pt f n x
 | 0 n0 _ := (n0 rfl).elim
 | (n + 1) _ hn := λ hp, nat.succ_ne_zero _ (hp.eq_zero_of_lt_minimal_period hn)
 
-lemma is_periodic_pt.minimal_period_dvd (hx : is_periodic_pt f n x) :
-  minimal_period f x ∣ n :=
+lemma is_periodic_pt.minimal_period_dvd (hx : is_periodic_pt f n x) : minimal_period f x ∣ n :=
 (eq_or_lt_of_le $ n.zero_le).elim (λ hn0, hn0 ▸ dvd_zero _) $ λ hn0,
-(nat.dvd_iff_mod_eq_zero _ _).2 $
+nat.dvd_iff_mod_eq_zero.2 $
 (hx.mod $ is_periodic_pt_minimal_period f x).eq_zero_of_lt_minimal_period $
 nat.mod_lt _ $ hx.minimal_period_pos hn0
 
-lemma is_periodic_pt_iff_minimal_period_dvd :
-  is_periodic_pt f n x ↔ minimal_period f x ∣ n :=
+lemma is_periodic_pt_iff_minimal_period_dvd : is_periodic_pt f n x ↔ minimal_period f x ∣ n :=
 ⟨is_periodic_pt.minimal_period_dvd, λ h, (is_periodic_pt_minimal_period f x).trans_dvd h⟩
 
 open nat
@@ -382,6 +419,129 @@ lemma minimal_period_iterate_eq_div_gcd' (h : x ∈ periodic_pts f) :
 minimal_period_iterate_eq_div_gcd_aux $
   gcd_pos_of_pos_left n (minimal_period_pos_iff_mem_periodic_pts.mpr h)
 
+/-- The orbit of a periodic point `x` of `f` is the cycle `[x, f x, f (f x), ...]`. Its length is
+the minimal period of `x`.
+
+If `x` is not a periodic point, then this is the empty (aka nil) cycle. -/
+def periodic_orbit (f : α → α) (x : α) : cycle α :=
+(list.range (minimal_period f x)).map (λ n, f^[n] x)
+
+/-- The definition of a periodic orbit, in terms of `list.map`. -/
+lemma periodic_orbit_def (f : α → α) (x : α) :
+  periodic_orbit f x = (list.range (minimal_period f x)).map (λ n, f^[n] x) :=
+rfl
+
+/-- The definition of a periodic orbit, in terms of `cycle.map`. -/
+lemma periodic_orbit_eq_cycle_map (f : α → α) (x : α) :
+  periodic_orbit f x = (list.range (minimal_period f x) : cycle ℕ).map (λ n, f^[n] x) :=
+rfl
+
+@[simp] lemma periodic_orbit_length : (periodic_orbit f x).length = minimal_period f x :=
+by rw [periodic_orbit, cycle.length_coe, list.length_map, list.length_range]
+
+@[simp] lemma periodic_orbit_eq_nil_iff_not_periodic_pt :
+  periodic_orbit f x = cycle.nil ↔ x ∉ periodic_pts f :=
+by { simp [periodic_orbit], exact minimal_period_eq_zero_iff_nmem_periodic_pts }
+
+lemma periodic_orbit_eq_nil_of_not_periodic_pt (h : x ∉ periodic_pts f) :
+  periodic_orbit f x = cycle.nil :=
+periodic_orbit_eq_nil_iff_not_periodic_pt.2 h
+
+@[simp] lemma mem_periodic_orbit_iff (hx : x ∈ periodic_pts f) :
+  y ∈ periodic_orbit f x ↔ ∃ n, f^[n] x = y :=
+begin
+  simp only [periodic_orbit, cycle.mem_coe_iff, list.mem_map, list.mem_range],
+  use λ ⟨a, ha, ha'⟩, ⟨a, ha'⟩,
+  rintro ⟨n, rfl⟩,
+  use [n % minimal_period f x, mod_lt _ (minimal_period_pos_of_mem_periodic_pts hx)],
+  rw iterate_mod_minimal_period_eq
+end
+
+@[simp] lemma iterate_mem_periodic_orbit (hx : x ∈ periodic_pts f) (n : ℕ) :
+  f^[n] x ∈ periodic_orbit f x :=
+(mem_periodic_orbit_iff hx).2 ⟨n, rfl⟩
+
+@[simp] lemma self_mem_periodic_orbit (hx : x ∈ periodic_pts f) : x ∈ periodic_orbit f x :=
+iterate_mem_periodic_orbit hx 0
+
+lemma nodup_periodic_orbit : (periodic_orbit f x).nodup :=
+begin
+  rw [periodic_orbit, cycle.nodup_coe_iff, list.nodup_map_iff_inj_on (list.nodup_range _)],
+  intros m hm n hn hmn,
+  rw list.mem_range at hm hn,
+  rwa eq_iff_lt_minimal_period_of_iterate_eq hm hn at hmn
+end
+
+lemma periodic_orbit_apply_iterate_eq (hx : x ∈ periodic_pts f) (n : ℕ) :
+  periodic_orbit f (f^[n] x) = periodic_orbit f x :=
+eq.symm $ cycle.coe_eq_coe.2 $ ⟨n, begin
+  apply list.ext_le _ (λ m _ _, _),
+  { simp [minimal_period_apply_iterate hx] },
+  { rw list.nth_le_rotate _ n m,
+    simp [iterate_add_apply] }
+end⟩
+
+lemma periodic_orbit_apply_eq (hx : x ∈ periodic_pts f) :
+  periodic_orbit f (f x) = periodic_orbit f x :=
+periodic_orbit_apply_iterate_eq hx 1
+
+theorem periodic_orbit_chain (r : α → α → Prop) {f : α → α} {x : α} :
+  (periodic_orbit f x).chain r ↔ ∀ n < minimal_period f x, r (f^[n] x) (f^[n+1] x) :=
+begin
+  by_cases hx : x ∈ periodic_pts f,
+  { have hx' := minimal_period_pos_of_mem_periodic_pts hx,
+    have hM := nat.sub_add_cancel (succ_le_iff.2 hx'),
+    rw [periodic_orbit, ←cycle.map_coe, cycle.chain_map, ←hM, cycle.chain_range_succ],
+    refine ⟨_, λ H, ⟨_, λ m hm, H _ (hm.trans (nat.lt_succ_self _))⟩⟩,
+    { rintro ⟨hr, H⟩ n hn,
+      cases eq_or_lt_of_le (lt_succ_iff.1 hn) with hM' hM',
+      { rwa [hM', hM, iterate_minimal_period] },
+      { exact H _ hM' } },
+    { rw iterate_zero_apply,
+      nth_rewrite 2 ←@iterate_minimal_period α f x,
+      nth_rewrite 1 ←hM,
+      exact H _ (nat.lt_succ_self _) } },
+  { rw [periodic_orbit_eq_nil_of_not_periodic_pt hx,
+      minimal_period_eq_zero_of_nmem_periodic_pts hx],
+    simp }
+end
+
+theorem periodic_orbit_chain' (r : α → α → Prop) {f : α → α} {x : α} (hx : x ∈ periodic_pts f) :
+  (periodic_orbit f x).chain r ↔ ∀ n, r (f^[n] x) (f^[n+1] x) :=
+begin
+  rw periodic_orbit_chain r,
+  refine ⟨λ H n, _, λ H n _, H n⟩,
+  rw [iterate_succ_apply, ←iterate_mod_minimal_period_eq],
+  nth_rewrite 1 ←iterate_mod_minimal_period_eq,
+  rw [←iterate_succ_apply, minimal_period_apply hx],
+  exact H _ (mod_lt _ (minimal_period_pos_of_mem_periodic_pts hx))
+end
+
+end function
+
+namespace function
+variables {α β : Type*} {f : α → α} {g : β → β} {x : α × β} {a : α} {b : β} {m n : ℕ}
+
+@[simp] lemma iterate_prod_map (f : α → α) (g : β → β) (n : ℕ) :
+  (prod.map f g)^[n] = prod.map (f^[n]) (g^[n]) := by induction n; simp [*, prod.map_comp_map]
+
+@[simp] lemma is_fixed_pt_prod_map (x : α × β) :
+  is_fixed_pt (prod.map f g) x ↔ is_fixed_pt f x.1 ∧ is_fixed_pt g x.2 := prod.ext_iff
+
+@[simp] lemma is_periodic_pt_prod_map (x : α × β) :
+  is_periodic_pt (prod.map f g) n x ↔ is_periodic_pt f n x.1 ∧ is_periodic_pt g n x.2 :=
+by simp [is_periodic_pt]
+
+lemma minimal_period_prod_map (f : α → α) (g : β → β) (x : α × β) :
+  minimal_period (prod.map f g) x = (minimal_period f x.1).lcm (minimal_period g x.2) :=
+eq_of_forall_dvd $ by cases x; simp [←is_periodic_pt_iff_minimal_period_dvd, nat.lcm_dvd_iff]
+
+lemma minimal_period_fst_dvd : minimal_period f x.1 ∣ minimal_period (prod.map f g) x :=
+by { rw minimal_period_prod_map, exact nat.dvd_lcm_left _ _ }
+
+lemma minimal_period_snd_dvd : minimal_period g x.2 ∣ minimal_period (prod.map f g) x :=
+by { rw minimal_period_prod_map, exact nat.dvd_lcm_right _ _ }
+
 end function
 
 namespace mul_action
@@ -403,4 +563,16 @@ begin
         dvd_neg, int.coe_nat_dvd, pow_smul_eq_iff_minimal_period_dvd] },
 end
 
+variables (a b)
+
+@[simp, to_additive] lemma pow_smul_mod_minimal_period (n : ℕ) :
+  a ^ (n % function.minimal_period ((•) a) b) • b = a ^ n • b :=
+by conv_rhs { rw [← nat.mod_add_div n (minimal_period ((•) a) b), pow_add, mul_smul,
+    pow_smul_eq_iff_minimal_period_dvd.mpr (dvd_mul_right _ _)] }
+
+@[simp, to_additive] lemma zpow_smul_mod_minimal_period (n : ℤ) :
+  a ^ (n % (function.minimal_period ((•) a) b : ℤ)) • b = a ^ n • b :=
+by conv_rhs { rw [← int.mod_add_div n (minimal_period ((•) a) b), zpow_add, mul_smul,
+    zpow_smul_eq_iff_minimal_period_dvd.mpr (dvd_mul_right _ _)] }
+
 end mul_action
diff --git a/src/field_theory/abel_ruffini.lean b/src/field_theory/abel_ruffini.lean
index fa008eb6e9400..8c54b0d3de584 100644
--- a/src/field_theory/abel_ruffini.lean
+++ b/src/field_theory/abel_ruffini.lean
@@ -6,11 +6,14 @@ Authors: Thomas Browning, Patrick Lutz
 
 import group_theory.solvable
 import field_theory.polynomial_galois_group
-import ring_theory.roots_of_unity
+import ring_theory.roots_of_unity.basic
 
 /-!
 # The Abel-Ruffini Theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves one direction of the Abel-Ruffini theorem, namely that if an element is solvable
 by radicals, then its minimal polynomial has solvable Galois group.
 
@@ -98,19 +101,15 @@ begin
   { rw [hn, pow_zero, sub_self],
     exact gal_zero_is_solvable },
   have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
-  have hn'' : (X ^ n - 1 : F[X]) ≠ 0 :=
-    λ h, one_ne_zero ((leading_coeff_X_pow_sub_one hn').symm.trans (congr_arg leading_coeff h)),
+  have hn'' : (X ^ n - 1 : F[X]) ≠ 0 := X_pow_sub_C_ne_zero hn' 1,
   apply is_solvable_of_comm,
   intros σ τ,
   ext a ha,
-  rw [mem_root_set hn'', alg_hom.map_sub, aeval_X_pow, aeval_one, sub_eq_zero] at ha,
+  simp only [mem_root_set_of_ne hn'', map_sub, aeval_X_pow, aeval_one, sub_eq_zero] at ha,
   have key : ∀ σ : (X ^ n - 1 : F[X]).gal, ∃ m : ℕ, σ a = a ^ m,
   { intro σ,
-    obtain ⟨m, hm⟩ := map_root_of_unity_eq_pow_self σ.to_alg_hom
-      ⟨is_unit.unit (is_unit_of_pow_eq_one a n ha hn'),
-      by { ext, rwa [units.coe_pow, is_unit.unit_spec, subtype.coe_mk n hn'] }⟩,
-    use m,
-    convert hm },
+    lift n to ℕ+ using hn',
+    exact map_root_of_unity_eq_pow_self σ.to_alg_hom (roots_of_unity.mk_of_pow_eq a ha) },
   obtain ⟨c, hc⟩ := key σ,
   obtain ⟨d, hd⟩ := key τ,
   rw [σ.mul_apply, τ.mul_apply, hc, τ.map_pow, hd, σ.map_pow, hc, ←pow_mul, pow_mul'],
@@ -128,18 +127,16 @@ begin
   { rw [hn, pow_zero, ←C_1, ←C_sub],
     exact gal_C_is_solvable (1 - a) },
   have hn' : 0 < n := pos_iff_ne_zero.mpr hn,
-  have hn'' : X ^ n - C a ≠ 0 :=
-    λ h, one_ne_zero ((leading_coeff_X_pow_sub_C hn').symm.trans (congr_arg leading_coeff h)),
-  have hn''' : (X ^ n - 1 : F[X]) ≠ 0 :=
-    λ h, one_ne_zero ((leading_coeff_X_pow_sub_one hn').symm.trans (congr_arg leading_coeff h)),
+  have hn'' : X ^ n - C a ≠ 0 := X_pow_sub_C_ne_zero hn' a,
+  have hn''' : (X ^ n - 1 : F[X]) ≠ 0 := X_pow_sub_C_ne_zero hn' 1,
   have mem_range : ∀ {c}, c ^ n = 1 → ∃ d, algebra_map F (X ^ n - C a).splitting_field d = c :=
-    λ c hc, ring_hom.mem_range.mp (minpoly.mem_range_of_degree_eq_one F c (or.resolve_left h hn'''
+    λ c hc, ring_hom.mem_range.mp (minpoly.mem_range_of_degree_eq_one F c (h.def.resolve_left hn'''
       (minpoly.irreducible ((splitting_field.normal (X ^ n - C a)).is_integral c)) (minpoly.dvd F c
       (by rwa [map_id, alg_hom.map_sub, sub_eq_zero, aeval_X_pow, aeval_one])))),
   apply is_solvable_of_comm,
   intros σ τ,
   ext b hb,
-  rw [mem_root_set hn'', alg_hom.map_sub, aeval_X_pow, aeval_C, sub_eq_zero] at hb,
+  simp only [mem_root_set_of_ne hn'', map_sub, aeval_X_pow, aeval_C, sub_eq_zero] at hb,
   have hb' : b ≠ 0,
   { intro hb',
     rw [hb', zero_pow hn'] at hb,
@@ -189,8 +186,8 @@ begin
   { ext1 c,
     change (X - C c).comp (C b * X) = C b * (X - C (c / b)),
     rw [sub_comp, X_comp, C_comp, mul_sub, ←C_mul, mul_div_cancel' c hb'] },
-  rw [key1, hs, prod_comp, multiset.map_map, key2, multiset.prod_map_mul, multiset.map_const,
-      multiset.prod_repeat, hs', ←C_pow, hb, ←mul_assoc, C_mul_C, one_mul],
+  rw [key1, hs, multiset_prod_comp, multiset.map_map, key2, multiset.prod_map_mul,
+    multiset.map_const, multiset.prod_replicate, hs', ←C_pow, hb, ←mul_assoc, C_mul_C, one_mul],
   all_goals { exact field.to_nontrivial F },
 end
 
@@ -215,8 +212,8 @@ variables (F)
 
 /-- Inductive definition of solvable by radicals -/
 inductive is_solvable_by_rad : E → Prop
-| base (a : F) : is_solvable_by_rad (algebra_map F E a)
-| add (a b : E) : is_solvable_by_rad a → is_solvable_by_rad b → is_solvable_by_rad (a + b)
+| base (α : F) : is_solvable_by_rad (algebra_map F E α)
+| add (α β : E) : is_solvable_by_rad α → is_solvable_by_rad β → is_solvable_by_rad (α + β)
 | neg (α : E) : is_solvable_by_rad α → is_solvable_by_rad (-α)
 | mul (α β : E) : is_solvable_by_rad α → is_solvable_by_rad β → is_solvable_by_rad (α * β)
 | inv (α : E) : is_solvable_by_rad α → is_solvable_by_rad α⁻¹
@@ -311,10 +308,10 @@ begin
       (minpoly.dvd F α (by rw [aeval_comp, aeval_X_pow, minpoly.aeval]))⟩ },
   { refine gal_is_solvable_tower p (p.comp (X ^ n)) _ hα _,
     { exact gal.splits_in_splitting_field_of_comp _ _ (by rwa [nat_degree_X_pow]) },
-    { obtain ⟨s, hs⟩ := exists_multiset_of_splits _ (splitting_field.splits p),
+    { obtain ⟨s, hs⟩ := (splits_iff_exists_multiset _).1 (splitting_field.splits p),
       rw [map_comp, polynomial.map_pow, map_X, hs, mul_comp, C_comp],
       apply gal_mul_is_solvable (gal_C_is_solvable _),
-      rw prod_comp,
+      rw multiset_prod_comp,
       apply gal_prod_is_solvable,
       intros q hq,
       rw multiset.mem_map at hq,
@@ -346,12 +343,12 @@ begin
       suffices : aeval (⟨γ, hγ⟩ : F ⟮α, β⟯) (minpoly F γ) = 0,
       { rw [aeval_alg_hom_apply, this, alg_hom.map_zero] },
       apply (algebra_map F⟮α, β⟯ (solvable_by_rad F E)).injective,
-      rw [ring_hom.map_zero, is_scalar_tower.algebra_map_aeval],
+      rw [ring_hom.map_zero, ← aeval_algebra_map_apply],
       exact minpoly.aeval F γ,
     end (minpoly.monic (is_integral γ)),
   rw [P, key],
-  exact gal_is_solvable_of_splits ⟨normal.splits (splitting_field.normal _) _⟩
-    (gal_mul_is_solvable hα hβ),
+  refine gal_is_solvable_of_splits ⟨_⟩ (gal_mul_is_solvable hα hβ),
+  exact normal.splits (splitting_field.normal _) (f ⟨γ, hγ⟩),
 end
 
 /-- An auxiliary induction lemma, which is generalized by `solvable_by_rad.is_solvable`. -/
diff --git a/src/field_theory/adjoin.lean b/src/field_theory/adjoin.lean
index 58faf14ce24b0..24cc89792d68f 100644
--- a/src/field_theory/adjoin.lean
+++ b/src/field_theory/adjoin.lean
@@ -6,11 +6,15 @@ Authors: Thomas Browning, Patrick Lutz
 
 import field_theory.intermediate_field
 import field_theory.separable
+import field_theory.splitting_field.is_splitting_field
 import ring_theory.tensor_product
 
 /-!
 # Adjoining Elements to Fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we introduce the notion of adjoining elements to fields.
 This isn't quite the same as adjoining elements to rings.
 For example, `algebra.adjoin K {x}` might not include `x⁻¹`.
@@ -18,7 +22,7 @@ For example, `algebra.adjoin K {x}` might not include `x⁻¹`.
 ## Main results
 
 - `adjoin_adjoin_left`: adjoining S and then T is the same as adjoining `S ∪ T`.
-- `bot_eq_top_of_dim_adjoin_eq_one`: if `F⟮x⟯` has dimension `1` over `F` for every `x`
+- `bot_eq_top_of_rank_adjoin_eq_one`: if `F⟮x⟯` has dimension `1` over `F` for every `x`
   in `E` then `F = E`
 
 ## Notation
@@ -150,18 +154,25 @@ variables {F E}
   bot_equiv F E (algebra_map F (⊥ : intermediate_field F E) x) = x :=
 alg_equiv.commutes (bot_equiv F E) x
 
+@[simp] lemma bot_equiv_symm (x : F) :
+  (bot_equiv F E).symm x = algebra_map F _ x :=
+rfl
+
 noncomputable instance algebra_over_bot : algebra (⊥ : intermediate_field F E) F :=
 (intermediate_field.bot_equiv F E).to_alg_hom.to_ring_hom.to_algebra
 
+lemma coe_algebra_map_over_bot :
+  (algebra_map (⊥ : intermediate_field F E) F : (⊥ : intermediate_field F E) → F) =
+    (intermediate_field.bot_equiv F E) :=
+rfl
+
 instance is_scalar_tower_over_bot : is_scalar_tower (⊥ : intermediate_field F E) F E :=
 is_scalar_tower.of_algebra_map_eq
 begin
   intro x,
-  let ϕ := algebra.of_id F (⊥ : subalgebra F E),
-  let ψ := alg_equiv.of_bijective ϕ ((algebra.bot_equiv F E).symm.bijective),
-  change (↑x : E) = ↑(ψ (ψ.symm ⟨x, _⟩)),
-  rw alg_equiv.apply_symm_apply ψ ⟨x, _⟩,
-  refl
+  obtain ⟨y, rfl⟩ := (bot_equiv F E).symm.surjective x,
+  rw [coe_algebra_map_over_bot, (bot_equiv F E).apply_symm_apply, bot_equiv_symm,
+      is_scalar_tower.algebra_map_apply F (⊥ : intermediate_field F E) E]
 end
 
 /-- The top intermediate_field is isomorphic to the field.
@@ -173,12 +184,30 @@ This is the intermediate field version of `subalgebra.top_equiv`. -/
 @[simp] lemma top_equiv_symm_apply_coe (a : E) :
   ↑((top_equiv.symm) a : (⊤ : intermediate_field F E)) = a := rfl
 
-@[simp] lemma coe_bot_eq_self (K : intermediate_field F E) : ↑(⊥ : intermediate_field K E) = K :=
-by { ext, rw [mem_lift2, mem_bot], exact set.ext_iff.mp subtype.range_coe x }
+@[simp] lemma restrict_scalars_bot_eq_self (K : intermediate_field F E) :
+  (⊥ : intermediate_field K E).restrict_scalars _ = K :=
+by { ext, rw [mem_restrict_scalars, mem_bot], exact set.ext_iff.mp subtype.range_coe x }
 
-@[simp] lemma coe_top_eq_top (K : intermediate_field F E) :
-  ↑(⊤ : intermediate_field K E) = (⊤ : intermediate_field F E) :=
-set_like.ext_iff.mpr $ λ _, mem_lift2.trans (iff_of_true mem_top mem_top)
+@[simp] lemma restrict_scalars_top {K : Type*} [field K] [algebra K E] [algebra K F]
+  [is_scalar_tower K F E] :
+  (⊤ : intermediate_field F E).restrict_scalars K = ⊤ :=
+rfl
+
+lemma _root_.alg_hom.field_range_eq_map {K : Type*} [field K] [algebra F K] (f : E →ₐ[F] K) :
+  f.field_range = intermediate_field.map f ⊤ :=
+set_like.ext' set.image_univ.symm
+
+lemma _root_.alg_hom.map_field_range {K L : Type*} [field K] [field L] [algebra F K] [algebra F L]
+  (f : E →ₐ[F] K) (g : K →ₐ[F] L) : f.field_range.map g = (g.comp f).field_range :=
+set_like.ext' (set.range_comp g f).symm
+
+lemma _root_.alg_hom.field_range_eq_top {K : Type*} [field K] [algebra F K] {f : E →ₐ[F] K} :
+  f.field_range = ⊤ ↔ function.surjective f :=
+set_like.ext'_iff.trans set.range_iff_surjective
+
+@[simp] lemma _root_.alg_equiv.field_range_eq_top {K : Type*} [field K] [algebra F K]
+  (f : E ≃ₐ[F] K) : (f : E →ₐ[F] K).field_range = ⊤ :=
+alg_hom.field_range_eq_top.mpr f.surjective
 
 end lattice
 
@@ -244,7 +273,8 @@ lemma adjoin_subset_adjoin_iff {F' : Type*} [field F'] [algebra F' E]
   λ ⟨hF, hS⟩, subfield.closure_le.mpr (set.union_subset hF hS)⟩
 
 /-- `F[S][T] = F[S ∪ T]` -/
-lemma adjoin_adjoin_left (T : set E) : ↑(adjoin (adjoin F S) T) = adjoin F (S ∪ T) :=
+lemma adjoin_adjoin_left (T : set E) :
+  (adjoin (adjoin F S) T).restrict_scalars _ = adjoin F (S ∪ T) :=
 begin
   rw set_like.ext'_iff,
   change ↑(adjoin (adjoin F S) T) = _,
@@ -266,7 +296,7 @@ le_antisymm
 
 /-- `F[S][T] = F[T][S]` -/
 lemma adjoin_adjoin_comm (T : set E) :
-  ↑(adjoin (adjoin F S) T) = (↑(adjoin (adjoin F T) S) : (intermediate_field F E)) :=
+  (adjoin (adjoin F S) T).restrict_scalars F = (adjoin (adjoin F T) S).restrict_scalars F :=
 by rw [adjoin_adjoin_left, adjoin_adjoin_left, set.union_comm]
 
 lemma adjoin_map {E' : Type*} [field E'] [algebra F E'] (f : E →ₐ[F] E') :
@@ -328,7 +358,7 @@ instance insert_empty {α : Type*} : insert (∅ : set α) :=
 
 @[priority 900]
 instance insert_nonempty {α : Type*} (s : set α) : insert s :=
-{ insert := λ x, set.insert x s }
+{ insert := λ x, has_insert.insert x s }
 
 notation K`⟮`:std.prec.max_plus l:(foldr `, ` (h t, insert.insert t h) ∅) `⟯` := adjoin K l
 
@@ -349,34 +379,140 @@ by { conv_rhs { rw ← adjoin_simple.algebra_map_gen F α },
      rw is_integral_algebra_map_iff (algebra_map F⟮α⟯ E).injective,
      apply_instance }
 
-lemma adjoin_simple_adjoin_simple (β : E) : ↑F⟮α⟯⟮β⟯ = F⟮α, β⟯ :=
+lemma adjoin_simple_adjoin_simple (β : E) : F⟮α⟯⟮β⟯.restrict_scalars F = F⟮α, β⟯ :=
 adjoin_adjoin_left _ _ _
 
-lemma adjoin_simple_comm (β : E) : ↑F⟮α⟯⟮β⟯ = (↑F⟮β⟯⟮α⟯ : intermediate_field F E) :=
+lemma adjoin_simple_comm (β : E) : F⟮α⟯⟮β⟯.restrict_scalars F = F⟮β⟯⟮α⟯.restrict_scalars F :=
 adjoin_adjoin_comm _ _ _
 
--- TODO: develop the API for `subalgebra.is_field_of_algebraic` so it can be used here
+variables {F} {α}
+
+lemma adjoin_algebraic_to_subalgebra
+  {S : set E} (hS : ∀ x ∈ S, is_algebraic F x) :
+  (intermediate_field.adjoin F S).to_subalgebra = algebra.adjoin F S :=
+begin
+  simp only [is_algebraic_iff_is_integral] at hS,
+  have : algebra.is_integral F (algebra.adjoin F S) :=
+  by rwa [←le_integral_closure_iff_is_integral, algebra.adjoin_le_iff],
+  have := is_field_of_is_integral_of_is_field' this (field.to_is_field F),
+  rw ← ((algebra.adjoin F S).to_intermediate_field' this).eq_adjoin_of_eq_algebra_adjoin F S; refl,
+end
+
 lemma adjoin_simple_to_subalgebra_of_integral (hα : is_integral F α) :
   (F⟮α⟯).to_subalgebra = algebra.adjoin F {α} :=
 begin
-  apply adjoin_eq_algebra_adjoin,
-  intros x hx,
-  by_cases x = 0,
-  { rw [h, inv_zero], exact subalgebra.zero_mem (algebra.adjoin F {α}) },
+  apply adjoin_algebraic_to_subalgebra,
+  rintro x (rfl : x = α),
+  rwa is_algebraic_iff_is_integral,
+end
+
+lemma is_splitting_field_iff {p : F[X]} {K : intermediate_field F E} :
+  p.is_splitting_field F K ↔ p.splits (algebra_map F K) ∧ K = adjoin F (p.root_set E) :=
+begin
+  suffices : _ → ((algebra.adjoin F (p.root_set K) = ⊤ ↔ K = adjoin F (p.root_set E))),
+  { exact ⟨λ h, ⟨h.1, (this h.1).mp h.2⟩, λ h, ⟨h.1, (this h.1).mpr h.2⟩⟩ },
+  simp_rw [set_like.ext_iff, ←mem_to_subalgebra, ←set_like.ext_iff],
+  rw [←K.range_val, adjoin_algebraic_to_subalgebra (λ x, is_algebraic_of_mem_root_set)],
+  exact λ hp, (adjoin_root_set_eq_range hp K.val).symm.trans eq_comm,
+end
+
+lemma adjoin_root_set_is_splitting_field {p : F[X]} (hp : p.splits (algebra_map F E)) :
+  p.is_splitting_field F (adjoin F (p.root_set E)) :=
+is_splitting_field_iff.mpr ⟨splits_of_splits hp (λ x hx, subset_adjoin F (p.root_set E) hx), rfl⟩
+
+open_locale big_operators
+
+/-- A compositum of splitting fields is a splitting field -/
+lemma is_splitting_field_supr {ι : Type*} {t : ι → intermediate_field F E} {p : ι → F[X]}
+  {s : finset ι} (h0 : ∏ i in s, p i ≠ 0) (h : ∀ i ∈ s, (p i).is_splitting_field F (t i)) :
+  (∏ i in s, p i).is_splitting_field F (⨆ i ∈ s, t i : intermediate_field F E) :=
+begin
+  let K : intermediate_field F E := ⨆ i ∈ s, t i,
+  have hK : ∀ i ∈ s, t i ≤ K := λ i hi, le_supr_of_le i (le_supr (λ _, t i) hi),
+  simp only [is_splitting_field_iff] at h ⊢,
+  refine ⟨splits_prod (algebra_map F K) (λ i hi, polynomial.splits_comp_of_splits
+    (algebra_map F (t i)) (inclusion (hK i hi)).to_ring_hom (h i hi).1), _⟩,
+  simp only [root_set_prod p s h0, ←set.supr_eq_Union, (@gc F _ E _ _).l_supr₂],
+  exact supr_congr (λ i, supr_congr (λ hi, (h i hi).2)),
+end
+
+open set complete_lattice
 
-  let ϕ := alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly F α,
-  haveI := minpoly.irreducible hα,
-  suffices : ϕ ⟨x, hx⟩ * (ϕ ⟨x, hx⟩)⁻¹ = 1,
-  { convert subtype.mem (ϕ.symm (ϕ ⟨x, hx⟩)⁻¹),
-    refine (eq_inv_of_mul_right_eq_one _).symm,
-    apply_fun ϕ.symm at this,
-    rw [alg_equiv.map_one, alg_equiv.map_mul, alg_equiv.symm_apply_apply] at this,
-    rw [←subsemiring.coe_one, ←this, subsemiring.coe_mul, subtype.coe_mk] },
+@[simp] lemma adjoin_simple_le_iff {K : intermediate_field F E} : F⟮α⟯ ≤ K ↔ α ∈ K :=
+adjoin_le_iff.trans singleton_subset_iff
 
-  rw mul_inv_cancel (mt (λ key, _) h),
-  rw ← ϕ.map_zero at key,
-  change ↑(⟨x, hx⟩ : algebra.adjoin F {α}) = _,
-  rw [ϕ.injective key, subalgebra.coe_zero]
+/-- Adjoining a single element is compact in the lattice of intermediate fields. -/
+lemma adjoin_simple_is_compact_element (x : E) : is_compact_element F⟮x⟯ :=
+begin
+  rw is_compact_element_iff_le_of_directed_Sup_le,
+  rintros s ⟨F₀, hF₀⟩ hs hx,
+  simp only [adjoin_simple_le_iff] at hx ⊢,
+  let F : intermediate_field F E :=
+  { carrier := ⋃ E ∈ s, ↑E,
+    add_mem' := by
+    { rintros x₁ x₂ ⟨-, ⟨F₁, rfl⟩, ⟨-, ⟨hF₁, rfl⟩, hx₁⟩⟩ ⟨-, ⟨F₂, rfl⟩, ⟨-, ⟨hF₂, rfl⟩, hx₂⟩⟩,
+      obtain ⟨F₃, hF₃, h₁₃, h₂₃⟩ := hs F₁ hF₁ F₂ hF₂,
+      exact mem_Union_of_mem F₃ (mem_Union_of_mem hF₃ (F₃.add_mem (h₁₃ hx₁) (h₂₃ hx₂))) },
+    neg_mem' := by
+    { rintros x ⟨-, ⟨E, rfl⟩, ⟨-, ⟨hE, rfl⟩, hx⟩⟩,
+      exact mem_Union_of_mem E (mem_Union_of_mem hE (E.neg_mem hx)) },
+    mul_mem' := by
+    { rintros x₁ x₂ ⟨-, ⟨F₁, rfl⟩, ⟨-, ⟨hF₁, rfl⟩, hx₁⟩⟩ ⟨-, ⟨F₂, rfl⟩, ⟨-, ⟨hF₂, rfl⟩, hx₂⟩⟩,
+      obtain ⟨F₃, hF₃, h₁₃, h₂₃⟩ := hs F₁ hF₁ F₂ hF₂,
+      exact mem_Union_of_mem F₃ (mem_Union_of_mem hF₃ (F₃.mul_mem (h₁₃ hx₁) (h₂₃ hx₂))) },
+    inv_mem' := by
+    { rintros x ⟨-, ⟨E, rfl⟩, ⟨-, ⟨hE, rfl⟩, hx⟩⟩,
+      exact mem_Union_of_mem E (mem_Union_of_mem hE (E.inv_mem hx)) },
+    algebra_map_mem' := λ x, mem_Union_of_mem F₀ (mem_Union_of_mem hF₀ (F₀.algebra_map_mem x)) },
+  have key : Sup s ≤ F := Sup_le (λ E hE, subset_Union_of_subset E (subset_Union _ hE)),
+  obtain ⟨-, ⟨E, rfl⟩, -, ⟨hE, rfl⟩, hx⟩ := key hx,
+  exact ⟨E, hE, hx⟩,
+end
+
+/-- Adjoining a finite subset is compact in the lattice of intermediate fields. -/
+lemma adjoin_finset_is_compact_element (S : finset E) :
+  is_compact_element (adjoin F S : intermediate_field F E) :=
+begin
+  have key : adjoin F ↑S = ⨆ x ∈ S, F⟮x⟯ :=
+  le_antisymm (adjoin_le_iff.mpr (λ x hx, set_like.mem_coe.mpr (adjoin_simple_le_iff.mp
+      (le_supr_of_le x (le_supr_of_le hx le_rfl)))))
+      (supr_le (λ x, supr_le (λ hx, adjoin_simple_le_iff.mpr (subset_adjoin F S hx)))),
+  rw [key, ←finset.sup_eq_supr],
+  exact finset_sup_compact_of_compact S (λ x hx, adjoin_simple_is_compact_element x),
+end
+
+/-- Adjoining a finite subset is compact in the lattice of intermediate fields. -/
+lemma adjoin_finite_is_compact_element {S : set E} (h : S.finite) :
+  is_compact_element (adjoin F S) :=
+finite.coe_to_finset h ▸ (adjoin_finset_is_compact_element h.to_finset)
+
+/-- The lattice of intermediate fields is compactly generated. -/
+instance : is_compactly_generated (intermediate_field F E) :=
+⟨λ s, ⟨(λ x, F⟮x⟯) '' s, ⟨by rintros t ⟨x, hx, rfl⟩; exact adjoin_simple_is_compact_element x,
+  Sup_image.trans (le_antisymm (supr_le (λ i, supr_le (λ hi, adjoin_simple_le_iff.mpr hi)))
+    (λ x hx, adjoin_simple_le_iff.mp (le_supr_of_le x (le_supr_of_le hx le_rfl))))⟩⟩⟩
+
+lemma exists_finset_of_mem_supr {ι : Type*} {f : ι → intermediate_field F E}
+  {x : E} (hx : x ∈ ⨆ i, f i) : ∃ s : finset ι, x ∈ ⨆ i ∈ s, f i :=
+begin
+  have := (adjoin_simple_is_compact_element x).exists_finset_of_le_supr (intermediate_field F E) f,
+  simp only [adjoin_simple_le_iff] at this,
+  exact this hx,
+end
+
+lemma exists_finset_of_mem_supr' {ι : Type*} {f : ι → intermediate_field F E}
+  {x : E} (hx : x ∈ ⨆ i, f i) : ∃ s : finset (Σ i, f i), x ∈ ⨆ i ∈ s, F⟮(i.2 : E)⟯ :=
+exists_finset_of_mem_supr (set_like.le_def.mp (supr_le
+  (λ i x h, set_like.le_def.mp (le_supr_of_le ⟨i, x, h⟩ le_rfl) (mem_adjoin_simple_self F x))) hx)
+
+lemma exists_finset_of_mem_supr'' {ι : Type*} {f : ι → intermediate_field F E}
+  (h : ∀ i, algebra.is_algebraic F (f i)) {x : E} (hx : x ∈ ⨆ i, f i) :
+  ∃ s : finset (Σ i, f i), x ∈ ⨆ i ∈ s, adjoin F ((minpoly F (i.2 : _)).root_set E) :=
+begin
+  refine exists_finset_of_mem_supr (set_like.le_def.mp (supr_le (λ i x hx, set_like.le_def.mp
+    (le_supr_of_le ⟨i, x, hx⟩ le_rfl) (subset_adjoin F _ _))) hx),
+  rw [intermediate_field.minpoly_eq, subtype.coe_mk, mem_root_set_of_ne, minpoly.aeval],
+  exact minpoly.ne_zero (is_integral_iff.mp (is_algebraic_iff_is_integral.mp (h i ⟨x, hx⟩)))
 end
 
 end adjoin_simple
@@ -401,32 +537,32 @@ adjoin_simple_eq_bot_iff.mpr (one_mem ⊥)
 adjoin_simple_eq_bot_iff.mpr (coe_int_mem ⊥ n)
 
 @[simp] lemma adjoin_nat (n : ℕ) : F⟮(n : E)⟯ = ⊥ :=
-adjoin_simple_eq_bot_iff.mpr (coe_int_mem ⊥ n)
+adjoin_simple_eq_bot_iff.mpr (coe_nat_mem ⊥ n)
 
-section adjoin_dim
+section adjoin_rank
 open finite_dimensional module
 
 variables {K L : intermediate_field F E}
 
-@[simp] lemma dim_eq_one_iff : module.rank F K = 1 ↔ K = ⊥ :=
-by rw [← to_subalgebra_eq_iff, ← dim_eq_dim_subalgebra,
-  subalgebra.dim_eq_one_iff, bot_to_subalgebra]
+@[simp] lemma rank_eq_one_iff : module.rank F K = 1 ↔ K = ⊥ :=
+by rw [← to_subalgebra_eq_iff, ← rank_eq_rank_subalgebra,
+  subalgebra.rank_eq_one_iff, bot_to_subalgebra]
 
 @[simp] lemma finrank_eq_one_iff : finrank F K = 1 ↔ K = ⊥ :=
 by rw [← to_subalgebra_eq_iff, ← finrank_eq_finrank_subalgebra,
   subalgebra.finrank_eq_one_iff, bot_to_subalgebra]
 
-@[simp] lemma dim_bot : module.rank F (⊥ : intermediate_field F E) = 1 :=
-by rw dim_eq_one_iff
+@[simp] lemma rank_bot : module.rank F (⊥ : intermediate_field F E) = 1 :=
+by rw rank_eq_one_iff
 
 @[simp] lemma finrank_bot : finrank F (⊥ : intermediate_field F E) = 1 :=
 by rw finrank_eq_one_iff
 
-lemma dim_adjoin_eq_one_iff : module.rank F (adjoin F S) = 1 ↔ S ⊆ (⊥ : intermediate_field F E) :=
-iff.trans dim_eq_one_iff adjoin_eq_bot_iff
+lemma rank_adjoin_eq_one_iff : module.rank F (adjoin F S) = 1 ↔ S ⊆ (⊥ : intermediate_field F E) :=
+iff.trans rank_eq_one_iff adjoin_eq_bot_iff
 
-lemma dim_adjoin_simple_eq_one_iff : module.rank F F⟮α⟯ = 1 ↔ α ∈ (⊥ : intermediate_field F E) :=
-by { rw dim_adjoin_eq_one_iff, exact set.singleton_subset_iff }
+lemma rank_adjoin_simple_eq_one_iff : module.rank F F⟮α⟯ = 1 ↔ α ∈ (⊥ : intermediate_field F E) :=
+by { rw rank_adjoin_eq_one_iff, exact set.singleton_subset_iff }
 
 lemma finrank_adjoin_eq_one_iff : finrank F (adjoin F S) = 1 ↔ S ⊆ (⊥ : intermediate_field F E) :=
 iff.trans finrank_eq_one_iff adjoin_eq_bot_iff
@@ -435,12 +571,12 @@ lemma finrank_adjoin_simple_eq_one_iff : finrank F F⟮α⟯ = 1 ↔ α ∈ (⊥
 by { rw [finrank_adjoin_eq_one_iff], exact set.singleton_subset_iff }
 
 /-- If `F⟮x⟯` has dimension `1` over `F` for every `x ∈ E` then `F = E`. -/
-lemma bot_eq_top_of_dim_adjoin_eq_one (h : ∀ x : E, module.rank F F⟮x⟯ = 1) :
+lemma bot_eq_top_of_rank_adjoin_eq_one (h : ∀ x : E, module.rank F F⟮x⟯ = 1) :
   (⊥ : intermediate_field F E) = ⊤ :=
 begin
   ext,
   rw iff_true_right intermediate_field.mem_top,
-  exact dim_adjoin_simple_eq_one_iff.mp (h x),
+  exact rank_adjoin_simple_eq_one_iff.mp (h x),
 end
 
 lemma bot_eq_top_of_finrank_adjoin_eq_one (h : ∀ x : E, finrank F F⟮x⟯ = 1) :
@@ -451,9 +587,9 @@ begin
   exact finrank_adjoin_simple_eq_one_iff.mp (h x),
 end
 
-lemma subsingleton_of_dim_adjoin_eq_one (h : ∀ x : E, module.rank F F⟮x⟯ = 1) :
+lemma subsingleton_of_rank_adjoin_eq_one (h : ∀ x : E, module.rank F F⟮x⟯ = 1) :
   subsingleton (intermediate_field F E) :=
-subsingleton_of_bot_eq_top (bot_eq_top_of_dim_adjoin_eq_one h)
+subsingleton_of_bot_eq_top (bot_eq_top_of_rank_adjoin_eq_one h)
 
 lemma subsingleton_of_finrank_adjoin_eq_one (h : ∀ x : E, finrank F F⟮x⟯ = 1) :
   subsingleton (intermediate_field F E) :=
@@ -471,7 +607,7 @@ lemma subsingleton_of_finrank_adjoin_le_one [finite_dimensional F E]
   (h : ∀ x : E, finrank F F⟮x⟯ ≤ 1) : subsingleton (intermediate_field F E) :=
 subsingleton_of_bot_eq_top (bot_eq_top_of_finrank_adjoin_le_one h)
 
-end adjoin_dim
+end adjoin_rank
 end adjoin_intermediate_field_lattice
 
 section adjoin_integral_element
@@ -495,7 +631,7 @@ begin
   ext,
   convert minpoly.aeval F α,
   conv in (aeval α) { rw [← adjoin_simple.algebra_map_gen F α] },
-  exact is_scalar_tower.algebra_map_aeval F F⟮α⟯ E _ _
+  exact (aeval_algebra_map_apply E (adjoin_simple.gen F α) _).symm
 end
 
 /-- algebra isomorphism between `adjoin_root` and `F⟮α⟯` -/
@@ -505,7 +641,7 @@ alg_equiv.of_bijective
   (adjoin_root.lift_hom (minpoly F α) (adjoin_simple.gen F α) (aeval_gen_minpoly F α))
   (begin
     set f := adjoin_root.lift _ _ (aeval_gen_minpoly F α : _),
-    haveI := minpoly.irreducible h,
+    haveI := fact.mk (minpoly.irreducible h),
     split,
     { exact ring_hom.injective f },
     { suffices : F⟮α⟯.to_subfield ≤ ring_hom.field_range ((F⟮α⟯.to_subfield.subtype).comp f),
@@ -554,6 +690,14 @@ begin
   refl
 end
 
+lemma _root_.minpoly.nat_degree_le {x : L} [finite_dimensional K L] (hx : is_integral K x) :
+  (minpoly K x).nat_degree ≤ finrank K L :=
+le_of_eq_of_le (intermediate_field.adjoin.finrank hx).symm K⟮x⟯.to_submodule.finrank_le
+
+lemma _root_.minpoly.degree_le {x : L} [finite_dimensional K L] (hx : is_integral K x) :
+  (minpoly K x).degree ≤ finrank K L :=
+degree_le_of_nat_degree_le (minpoly.nat_degree_le hx)
+
 end power_basis
 
 /-- Algebra homomorphism `F⟮α⟯ →ₐ[F] K` are in bijection with the set of roots
@@ -591,8 +735,7 @@ lemma fg_adjoin_finset (t : finset E) : (adjoin F (↑t : set E)).fg :=
 ⟨t, rfl⟩
 
 theorem fg_def {S : intermediate_field F E} : S.fg ↔ ∃ t : set E, set.finite t ∧ adjoin F t = S :=
-⟨λ ⟨t, ht⟩, ⟨↑t, set.finite_mem_finset t, ht⟩,
- λ ⟨t, ht1, ht2⟩, ⟨ht1.to_finset, by rwa set.finite.coe_to_finset⟩⟩
+iff.symm set.exists_finite_iff_finset
 
 theorem fg_bot : (⊥ : intermediate_field F E).fg :=
 ⟨∅, adjoin_empty F E⟩
@@ -609,7 +752,8 @@ lemma fg_of_noetherian (S : intermediate_field F E)
 S.fg_of_fg_to_subalgebra S.to_subalgebra.fg_of_noetherian
 
 lemma induction_on_adjoin_finset (S : finset E) (P : intermediate_field F E → Prop) (base : P ⊥)
-  (ih : ∀ (K : intermediate_field F E) (x ∈ S), P K → P ↑K⟮x⟯) : P (adjoin F ↑S) :=
+  (ih : ∀ (K : intermediate_field F E) (x ∈ S), P K → P (K⟮x⟯.restrict_scalars F)) :
+  P (adjoin F ↑S) :=
 begin
   apply finset.induction_on' S,
   { exact base },
@@ -619,7 +763,7 @@ begin
 end
 
 lemma induction_on_adjoin_fg (P : intermediate_field F E → Prop)
-  (base : P ⊥) (ih : ∀ (K : intermediate_field F E) (x : E), P K → P ↑K⟮x⟯)
+  (base : P ⊥) (ih : ∀ (K : intermediate_field F E) (x : E), P K → P (K⟮x⟯.restrict_scalars F))
   (K : intermediate_field F E) (hK : K.fg) : P K :=
 begin
   obtain ⟨S, rfl⟩ := hK,
@@ -627,7 +771,7 @@ begin
 end
 
 lemma induction_on_adjoin [fd : finite_dimensional F E] (P : intermediate_field F E → Prop)
-  (base : P ⊥) (ih : ∀ (K : intermediate_field F E) (x : E), P K → P ↑K⟮x⟯)
+  (base : P ⊥) (ih : ∀ (K : intermediate_field F E) (x : E), P K → P (K⟮x⟯.restrict_scalars F))
   (K : intermediate_field F E) : P K :=
 begin
   letI : is_noetherian F E := is_noetherian.iff_fg.2 infer_instance,
@@ -673,8 +817,8 @@ lemma lifts.eq_of_le {x y : lifts F E K} (hxy : x ≤ y) (s : x.1) :
   x.2 s = y.2 ⟨s, hxy.1 s.mem⟩ := hxy.2 s ⟨s, hxy.1 s.mem⟩ rfl
 
 lemma lifts.exists_max_two {c : set (lifts F E K)} {x y : lifts F E K} (hc : is_chain (≤) c)
-  (hx : x ∈ set.insert ⊥ c) (hy : y ∈ set.insert ⊥ c) :
-  ∃ z : lifts F E K, z ∈ set.insert ⊥ c ∧ x ≤ z ∧ y ≤ z :=
+  (hx : x ∈ has_insert.insert ⊥ c) (hy : y ∈ has_insert.insert ⊥ c) :
+  ∃ z : lifts F E K, z ∈ has_insert.insert ⊥ c ∧ x ≤ z ∧ y ≤ z :=
 begin
   cases (hc.insert $ λ _ _ _, or.inl bot_le).total hx hy with hxy hyx,
   { exact ⟨y, hy, hxy, le_refl y⟩ },
@@ -682,8 +826,9 @@ begin
 end
 
 lemma lifts.exists_max_three {c : set (lifts F E K)} {x y z : lifts F E K} (hc : is_chain (≤) c)
-  (hx : x ∈ set.insert ⊥ c) (hy : y ∈ set.insert ⊥ c) (hz : z ∈ set.insert ⊥ c) :
-  ∃ w  : lifts F E K, w ∈ set.insert ⊥ c ∧ x ≤ w ∧ y ≤ w ∧ z ≤ w :=
+  (hx : x ∈ has_insert.insert ⊥ c) (hy : y ∈ has_insert.insert ⊥ c)
+  (hz : z ∈ has_insert.insert ⊥ c) :
+  ∃ w  : lifts F E K, w ∈ has_insert.insert ⊥ c ∧ x ≤ w ∧ y ≤ w ∧ z ≤ w :=
 begin
   obtain ⟨v, hv, hxv, hyv⟩ := lifts.exists_max_two hc hx hy,
   obtain ⟨w, hw, hzw, hvw⟩ := lifts.exists_max_two hc hz hv,
@@ -693,7 +838,7 @@ end
 /-- An upper bound on a chain of lifts -/
 def lifts.upper_bound_intermediate_field {c : set (lifts F E K)} (hc : is_chain (≤) c) :
   intermediate_field F E :=
-{ carrier := λ s, ∃ x : (lifts F E K), x ∈ set.insert ⊥ c ∧ (s ∈ x.1 : Prop),
+{ carrier := λ s, ∃ x : (lifts F E K), x ∈ has_insert.insert ⊥ c ∧ (s ∈ x.1 : Prop),
   zero_mem' := ⟨⊥, set.mem_insert ⊥ c, zero_mem ⊥⟩,
   one_mem' := ⟨⊥, set.mem_insert ⊥ c, one_mem ⊥⟩,
   neg_mem' := by { rintros _ ⟨x, y, h⟩, exact ⟨x, ⟨y, x.1.neg_mem h⟩⟩ },
@@ -753,12 +898,12 @@ end⟩
 /-- Extend a lift `x : lifts F E K` to an element `s : E` whose conjugates are all in `K` -/
 noncomputable def lifts.lift_of_splits (x : lifts F E K) {s : E} (h1 : is_integral F s)
   (h2 : (minpoly F s).splits (algebra_map F K)) : lifts F E K :=
-let h3 : is_integral x.1 s := is_integral_of_is_scalar_tower s h1 in
+let h3 : is_integral x.1 s := is_integral_of_is_scalar_tower h1 in
 let key : (minpoly x.1 s).splits x.2.to_ring_hom :=
   splits_of_splits_of_dvd _ (map_ne_zero (minpoly.ne_zero h1))
   ((splits_map_iff _ _).mpr (by {convert h2, exact ring_hom.ext (λ y, x.2.commutes y)}))
   (minpoly.dvd_map_of_is_scalar_tower _ _ _) in
-⟨↑x.1⟮s⟯, (@alg_hom_equiv_sigma F x.1 (↑x.1⟮s⟯ : intermediate_field F E) K _ _ _ _ _ _ _
+⟨x.1⟮s⟯.restrict_scalars F, (@alg_hom_equiv_sigma F x.1 (x.1⟮s⟯.restrict_scalars F) K _ _ _ _ _ _ _
   (intermediate_field.algebra x.1⟮s⟯) (is_scalar_tower.of_algebra_map_eq (λ _, rfl))).inv_fun
   ⟨x.2, (@alg_hom_adjoin_integral_equiv x.1 _ E _ _ s K _ x.2.to_ring_hom.to_algebra
   h3).inv_fun ⟨root_of_splits x.2.to_ring_hom key (ne_of_gt (minpoly.degree_pos h3)), by
@@ -805,13 +950,13 @@ end alg_hom_mk_adjoin_splits
 
 section supremum
 
-lemma le_sup_to_subalgebra {K L : Type*} [field K] [field L] [algebra K L]
-  (E1 E2 : intermediate_field K L) :
+variables {K L : Type*} [field K] [field L] [algebra K L] (E1 E2 : intermediate_field K L)
+
+lemma le_sup_to_subalgebra :
   E1.to_subalgebra ⊔ E2.to_subalgebra ≤ (E1 ⊔ E2).to_subalgebra :=
 sup_le (show E1 ≤ E1 ⊔ E2, from le_sup_left) (show E2 ≤ E1 ⊔ E2, from le_sup_right)
 
-lemma sup_to_subalgebra {K L : Type*} [field K] [field L] [algebra K L]
-  (E1 E2 : intermediate_field K L) [h1 : finite_dimensional K E1] [h2 : finite_dimensional K E2] :
+lemma sup_to_subalgebra [h1 : finite_dimensional K E1] [h2 : finite_dimensional K E2] :
   (E1 ⊔ E2).to_subalgebra = E1.to_subalgebra ⊔ E2.to_subalgebra :=
 begin
   let S1 := E1.to_subalgebra,
@@ -824,14 +969,13 @@ begin
     { rw [←subtype.coe_mk x hx, hx', subalgebra.coe_zero, inv_zero],
       exact (S1 ⊔ S2).zero_mem },
     { obtain ⟨y, h⟩ := this.mul_inv_cancel hx',
-      exact (congr_arg (∈ S1 ⊔ S2) (eq_inv_of_mul_right_eq_one (subtype.ext_iff.mp h))).mp y.2 } },
+      exact (congr_arg (∈ S1 ⊔ S2) $ eq_inv_of_mul_eq_one_right $ subtype.ext_iff.mp h).mp y.2 } },
   exact is_field_of_is_integral_of_is_field'
     (is_integral_sup.mpr ⟨algebra.is_integral_of_finite K E1, algebra.is_integral_of_finite K E2⟩)
     (field.to_is_field K),
 end
 
-lemma finite_dimensional_sup {K L : Type*} [field K] [field L] [algebra K L]
-  (E1 E2 : intermediate_field K L) [h1 : finite_dimensional K E1] [h2 : finite_dimensional K E2] :
+instance finite_dimensional_sup [h1 : finite_dimensional K E1] [h2 : finite_dimensional K E2] :
   finite_dimensional K ↥(E1 ⊔ E2) :=
 begin
   let g := algebra.tensor_product.product_map E1.val E2.val,
@@ -841,6 +985,47 @@ begin
   rw [algebra.tensor_product.product_map_range, E1.range_val, E2.range_val, sup_to_subalgebra],
 end
 
+instance finite_dimensional_supr_of_finite
+  {ι : Type*} {t : ι → intermediate_field K L} [h : finite ι] [Π i, finite_dimensional K (t i)] :
+  finite_dimensional K (⨆ i, t i : intermediate_field K L) :=
+begin
+  rw ← supr_univ,
+  let P : set ι → Prop := λ s, finite_dimensional K (⨆ i ∈ s, t i : intermediate_field K L),
+  change P set.univ,
+  apply set.finite.induction_on,
+  { exact set.finite_univ },
+  all_goals { dsimp only [P] },
+  { rw supr_emptyset,
+    exact (bot_equiv K L).symm.to_linear_equiv.finite_dimensional },
+  { intros _ s _ _ hs,
+    rw supr_insert,
+    exactI intermediate_field.finite_dimensional_sup _ _ },
+end
+
+instance finite_dimensional_supr_of_finset {ι : Type*}
+  {f : ι → intermediate_field K L} {s : finset ι} [h : Π i ∈ s, finite_dimensional K (f i)] :
+  finite_dimensional K (⨆ i ∈ s, f i : intermediate_field K L) :=
+begin
+  haveI : Π i : {i // i ∈ s}, finite_dimensional K (f i) := λ i, h i i.2,
+  have : (⨆ i ∈ s, f i) = ⨆ i : {i // i ∈ s}, f i :=
+  le_antisymm (supr_le (λ i, supr_le (λ h, le_supr (λ i : {i // i ∈ s}, f i) ⟨i, h⟩)))
+    (supr_le (λ i, le_supr_of_le i (le_supr_of_le i.2 le_rfl))),
+  exact this.symm ▸ intermediate_field.finite_dimensional_supr_of_finite,
+end
+
+/-- A compositum of algebraic extensions is algebraic -/
+lemma is_algebraic_supr {ι : Type*} {f : ι → intermediate_field K L}
+  (h : ∀ i, algebra.is_algebraic K (f i)) :
+  algebra.is_algebraic K (⨆ i, f i : intermediate_field K L) :=
+begin
+  rintros ⟨x, hx⟩,
+  obtain ⟨s, hx⟩ := exists_finset_of_mem_supr' hx,
+  rw [is_algebraic_iff, subtype.coe_mk, ←subtype.coe_mk x hx, ←is_algebraic_iff],
+  haveI : ∀ i : (Σ i, f i), finite_dimensional K K⟮(i.2 : L)⟯ :=
+  λ ⟨i, x⟩, adjoin.finite_dimensional (is_integral_iff.1 (is_algebraic_iff_is_integral.1 (h i x))),
+  apply algebra.is_algebraic_of_finite,
+end
+
 end supremum
 
 end intermediate_field
diff --git a/src/field_theory/ax_grothendieck.lean b/src/field_theory/ax_grothendieck.lean
new file mode 100644
index 0000000000000..691f6f9a276b4
--- /dev/null
+++ b/src/field_theory/ax_grothendieck.lean
@@ -0,0 +1,80 @@
+/-
+Copyright (c) 2023 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes
+-/
+import data.mv_polynomial.basic
+import ring_theory.algebraic
+import data.fintype.card
+
+/-!
+# Ax-Grothendieck for algebraic extensions of `zmod p`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves that if `R` is an algebraic extension of a finite field,
+then any injective polynomial map `R^n -> R^n` is also surjective.
+
+This proof is required for the true Ax-Grothendieck theorem, which proves the same result
+for any algebraically closed field of characteristic zero.
+
+## TODO
+
+The proof of the theorem for characteristic zero is not in mathlib, but it is at
+https://github.com/Jlh18/ModelTheoryInLean8
+-/
+
+noncomputable theory
+
+open mv_polynomial finset function
+
+/-- Any injective polynomial map over an algebraic extension of a finite field is surjective. -/
+lemma ax_grothendieck_of_locally_finite {ι K R : Type*} [field K] [finite K] [comm_ring R]
+  [finite ι] [algebra K R] (alg : algebra.is_algebraic K R)
+  (ps : ι → mv_polynomial ι R)
+  (hinj : injective (λ v i, eval v (ps i))) :
+  surjective (λ v i, eval v (ps i)) :=
+begin
+  have is_int : ∀ x : R, is_integral K x,
+    from λ x, is_algebraic_iff_is_integral.1 (alg x),
+  classical,
+  intros v,
+  casesI nonempty_fintype ι,
+  /- `s` is the set of all coefficients of the polynomial, as well as all of
+  the coordinates of `v`, the point I am trying to find the preimage of. -/
+  let s : finset R := finset.bUnion (univ : finset ι)
+      (λ i, (ps i).support.image (λ x, coeff x (ps i)))
+    ∪ (univ : finset ι).image v,
+  have hv : ∀ i, v i ∈ algebra.adjoin K (s : set R),
+    from λ j, algebra.subset_adjoin
+        (mem_union_right _
+          (mem_image.2 ⟨j, mem_univ _, rfl⟩)),
+  have hs₁ : ∀ (i : ι) (k : ι →₀ ℕ), k ∈ (ps i).support →
+      coeff k (ps i) ∈ algebra.adjoin K (s : set R),
+    from λ i k hk, algebra.subset_adjoin
+      (mem_union_left _ (mem_bUnion.2
+        ⟨i, mem_univ _, mem_image_of_mem _ hk⟩)),
+  have hs : ∀ i, mv_polynomial.eval v (ps i) ∈ algebra.adjoin K (s : set R),
+    from λ i, eval_mem (hs₁ _) hv,
+  letI := is_noetherian_adjoin_finset s (λ x _, is_int x),
+  letI := module.is_noetherian.finite K (algebra.adjoin K (s : set R)),
+  letI : finite (algebra.adjoin K (s : set R)) :=
+    finite_dimensional.finite_of_finite
+      K (algebra.adjoin K (s : set R)),
+  /- The restriction of the polynomial map, `ps`, to the subalgebra generated by `s` -/
+  let res : (ι → algebra.adjoin K (s : set R)) →
+      (ι → algebra.adjoin K (s : set R)) :=
+    λ x i, ⟨eval (λ j : ι, (x j : R)) (ps i),
+      eval_mem (hs₁ _) (λ i, (x i).2)⟩,
+  have hres_inj : injective res,
+  { intros x y hxy,
+    ext i,
+    simp only [res, subtype.ext_iff, funext_iff] at hxy,
+    exact congr_fun (hinj (funext hxy)) i },
+  have hres_surj : surjective res,
+    from finite.injective_iff_surjective.1 hres_inj,
+  cases hres_surj (λ i, ⟨v i, hv i⟩) with w hw,
+  use λ i, w i,
+  simpa only [res, subtype.ext_iff, funext_iff] using hw,
+end
diff --git a/src/field_theory/cardinality.lean b/src/field_theory/cardinality.lean
index 2d48f1aa45b25..e01d6b48ab64b 100644
--- a/src/field_theory/cardinality.lean
+++ b/src/field_theory/cardinality.lean
@@ -3,8 +3,9 @@ Copyright (c) 2022 Eric Rodriguez. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Rodriguez
 -/
-import algebra.ring.ulift
+import algebra.field.ulift
 import data.mv_polynomial.cardinal
+import data.nat.factorization.prime_pow
 import data.rat.denumerable
 import field_theory.finite.galois_field
 import logic.equiv.transfer_instance
@@ -14,6 +15,9 @@ import set_theory.cardinal.divisibility
 /-!
 # Cardinality of Fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we show all the possible cardinalities of fields. All infinite cardinals can harbour
 a field structure, and so can all types with prime power cardinalities, and this is sharp.
 
@@ -35,8 +39,10 @@ universe u
 /-- A finite field has prime power cardinality. -/
 lemma fintype.is_prime_pow_card_of_field {α} [fintype α] [field α] : is_prime_pow (‖α‖) :=
 begin
+  -- TODO: `algebra` version of `char_p.exists`, of type `Σ p, algebra (zmod p) α`
   casesI char_p.exists α with p _,
   haveI hp := fact.mk (char_p.char_is_prime α p),
+  letI : algebra (zmod p) α := zmod.algebra _ _,
   let b := is_noetherian.finset_basis (zmod p) α,
   rw [module.card_fintype b, zmod.card, is_prime_pow_pow_iff],
   { exact hp.1.is_prime_pow },
@@ -49,7 +55,7 @@ lemma fintype.nonempty_field_iff {α} [fintype α] : nonempty (field α) ↔ is_
 begin
   refine ⟨λ ⟨h⟩, by exactI fintype.is_prime_pow_card_of_field, _⟩,
   rintros ⟨p, n, hp, hn, hα⟩,
-  haveI := fact.mk (nat.prime_iff.mpr hp),
+  haveI := fact.mk hp.nat_prime,
   exact ⟨(fintype.equiv_of_card_eq ((galois_field.card p n hn.ne').trans hα)).symm.field⟩,
 end
 
@@ -68,7 +74,7 @@ begin
   apply le_antisymm,
   { refine ⟨⟨λ a, mv_polynomial.monomial (finsupp.single a 1) (1 : ulift.{u} ℚ), λ x y h, _⟩⟩,
     simpa [mv_polynomial.monomial_eq_monomial_iff, finsupp.single_eq_single_iff] using h },
-  { simpa using @mv_polynomial.cardinal_mk_le_max α (ulift.{u} ℚ) _ }
+  { simp }
 end
 
 /-- There is a field structure on type if and only if its cardinality is a prime power. -/
@@ -77,7 +83,7 @@ begin
   rw cardinal.is_prime_pow_iff,
   casesI fintype_or_infinite α with h h,
   { simpa only [cardinal.mk_fintype, nat.cast_inj, exists_eq_left',
-        (cardinal.nat_lt_omega _).not_le, false_or]
+        (cardinal.nat_lt_aleph_0 _).not_le, false_or]
       using fintype.nonempty_field_iff },
   { simpa only [← cardinal.infinite_iff, h, true_or, iff_true]
       using infinite.nonempty_field },
diff --git a/src/field_theory/chevalley_warning.lean b/src/field_theory/chevalley_warning.lean
index cad0f2899a95b..8fa213e4bbe9f 100644
--- a/src/field_theory/chevalley_warning.lean
+++ b/src/field_theory/chevalley_warning.lean
@@ -9,6 +9,9 @@ import field_theory.finite.basic
 /-!
 # The Chevalley–Warning theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains a proof of the Chevalley–Warning theorem.
 Throughout most of this file, `K` denotes a finite field
 and `q` is notation for the cardinality of `K`.
@@ -18,8 +21,8 @@ and `q` is notation for the cardinality of `K`.
 1. Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
    such that the total degree of `f` is less than `(q-1)` times the cardinality of `σ`.
    Then the evaluation of `f` on all points of `σ → K` (aka `K^σ`) sums to `0`.
-   (`sum_mv_polynomial_eq_zero`)
-2. The Chevalley–Warning theorem (`char_dvd_card_solutions`).
+   (`sum_eval_eq_zero`)
+2. The Chevalley–Warning theorem (`char_dvd_card_solutions_of_sum_lt`).
    Let `f i` be a finite family of multivariate polynomials
    in finitely many variables (`X s`, `s : σ`) such that
    the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
@@ -41,12 +44,12 @@ open_locale big_operators
 section finite_field
 open mv_polynomial function (hiding eval) finset finite_field
 
-variables {K : Type*} {σ : Type*} [fintype K] [field K] [fintype σ]
+variables {K σ ι : Type*} [fintype K] [field K] [fintype σ] [decidable_eq σ]
 local notation `q` := fintype.card K
 
-lemma mv_polynomial.sum_mv_polynomial_eq_zero [decidable_eq σ] (f : mv_polynomial σ K)
+lemma mv_polynomial.sum_eval_eq_zero (f : mv_polynomial σ K)
   (h : f.total_degree < (q - 1) * fintype.card σ) :
-  (∑ x, eval x f) = 0 :=
+  ∑ x, eval x f = 0 :=
 begin
   haveI : decidable_eq K := classical.dec_eq K,
   calc (∑ x, eval x f)
@@ -86,15 +89,14 @@ begin
     rw equiv.subtype_equiv_codomain_symm_apply_ne, }
 end
 
-variables [decidable_eq K] [decidable_eq σ]
+variables [decidable_eq K] (p : ℕ) [char_p K p]
 
-/-- The Chevalley–Warning theorem.
+/-- The **Chevalley–Warning theorem**, finitary version.
 Let `(f i)` be a finite family of multivariate polynomials
 in finitely many variables (`X s`, `s : σ`) over a finite field of characteristic `p`.
 Assume that the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
 Then the number of common solutions of the `f i` is divisible by `p`. -/
-theorem char_dvd_card_solutions_family (p : ℕ) [char_p K p]
-  {ι : Type*} {s : finset ι} {f : ι → mv_polynomial σ K}
+theorem char_dvd_card_solutions_of_sum_lt {s : finset ι} {f : ι → mv_polynomial σ K}
   (h : (∑ i in s, (f i).total_degree) < fintype.card σ) :
   p ∣ fintype.card {x : σ → K // ∀ i ∈ s, eval x (f i) = 0} :=
 begin
@@ -131,7 +133,7 @@ begin
   rw [← char_p.cast_eq_zero_iff K, ← key],
   show ∑ x, eval x F = 0,
   -- We are now ready to apply the main machine, proven before.
-  apply F.sum_mv_polynomial_eq_zero,
+  apply F.sum_eval_eq_zero,
   -- It remains to verify the crucial assumption of this machine
   show F.total_degree < (q - 1) * fintype.card σ,
   calc F.total_degree ≤ ∑ i in s, (1 - (f i)^(q - 1)).total_degree : total_degree_finset_prod s _
@@ -147,22 +149,43 @@ begin
     ... ≤ (q - 1) * (f i).total_degree : total_degree_pow _ _
 end
 
-/-- The Chevalley–Warning theorem.
+/-- The **Chevalley–Warning theorem**, fintype version.
+Let `(f i)` be a finite family of multivariate polynomials
+in finitely many variables (`X s`, `s : σ`) over a finite field of characteristic `p`.
+Assume that the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
+Then the number of common solutions of the `f i` is divisible by `p`. -/
+theorem char_dvd_card_solutions_of_fintype_sum_lt [fintype ι] {f : ι → mv_polynomial σ K}
+  (h : (∑ i, (f i).total_degree) < fintype.card σ) :
+  p ∣ fintype.card {x : σ → K // ∀ i, eval x (f i) = 0} :=
+by simpa using char_dvd_card_solutions_of_sum_lt p h
+
+/-- The **Chevalley–Warning theorem**, unary version.
 Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
 over a finite field of characteristic `p`.
 Assume that the total degree of `f` is less than the cardinality of `σ`.
 Then the number of solutions of `f` is divisible by `p`.
-See `char_dvd_card_solutions_family` for a version that takes a family of polynomials `f i`. -/
-theorem char_dvd_card_solutions (p : ℕ) [char_p K p]
-  {f : mv_polynomial σ K} (h : f.total_degree < fintype.card σ) :
+See `char_dvd_card_solutions_of_sum_lt` for a version that takes a family of polynomials `f i`. -/
+theorem char_dvd_card_solutions {f : mv_polynomial σ K} (h : f.total_degree < fintype.card σ) :
   p ∣ fintype.card {x : σ → K // eval x f = 0} :=
 begin
   let F : unit → mv_polynomial σ K := λ _, f,
-  have : ∑ i : unit, (F i).total_degree < fintype.card σ,
-  { simpa only [fintype.univ_punit, sum_singleton] using h, },
-  have key := char_dvd_card_solutions_family p this,
-  simp only [F, fintype.univ_punit, forall_eq, mem_singleton] at key,
-  convert key,
+  have : ∑ i : unit, (F i).total_degree < fintype.card σ := h,
+  simpa only [F, fintype.univ_punit, forall_eq, mem_singleton] using
+    char_dvd_card_solutions_of_sum_lt p this,
+end
+
+/-- The **Chevalley–Warning theorem**, binary version.
+Let `f₁`, `f₂` be two multivariate polynomials in finitely many variables (`X s`, `s : σ`) over a
+finite field of characteristic `p`.
+Assume that the sum of the total degrees of `f₁` and `f₂` is less than the cardinality of `σ`.
+Then the number of common solutions of the `f₁` and `f₂` is divisible by `p`. -/
+theorem char_dvd_card_solutions_of_add_lt {f₁ f₂ : mv_polynomial σ K}
+  (h : f₁.total_degree + f₂.total_degree < fintype.card σ) :
+  p ∣ fintype.card {x : σ → K // eval x f₁ = 0 ∧ eval x f₂ = 0} :=
+begin
+  let F : bool → mv_polynomial σ K := λ b, cond b f₂ f₁,
+  have : ∑ b : bool, (F b).total_degree < fintype.card σ := (add_comm _ _).trans_lt h,
+  simpa only [F, bool.forall_bool] using char_dvd_card_solutions_of_fintype_sum_lt p this,
 end
 
 end finite_field
diff --git a/src/field_theory/finite/basic.lean b/src/field_theory/finite/basic.lean
index d1494e70e2aef..505d9e97e807c 100644
--- a/src/field_theory/finite/basic.lean
+++ b/src/field_theory/finite/basic.lean
@@ -3,16 +3,16 @@ Copyright (c) 2018 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes, Joey van Langen, Casper Putz
 -/
-import tactic.apply_fun
-import algebra.ring.equiv
-import data.zmod.algebra
-import linear_algebra.finite_dimensional
-import ring_theory.integral_domain
 import field_theory.separable
+import ring_theory.integral_domain
+import tactic.apply_fun
 
 /-!
 # Finite fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains basic results about finite fields.
 Throughout most of this file, `K` denotes a finite field
 and `q` is notation for the cardinality of `K`.
@@ -46,10 +46,10 @@ diamonds, as `fintype` carries data.
 variables {K : Type*} {R : Type*}
 local notation `q` := fintype.card K
 
+open finset function
 open_locale big_operators polynomial
 
 namespace finite_field
-open finset function
 
 section polynomial
 
@@ -103,7 +103,7 @@ begin
   have : (∏ x in (@univ Kˣ _).erase (-1), x) = 1,
   from prod_involution (λ x _, x⁻¹) (by simp)
     (λ a, by simp [units.inv_eq_self_iff] {contextual := tt})
-    (λ a, by simp [@inv_eq_iff_inv_eq _ _ a, eq_comm])
+    (λ a, by simp [@inv_eq_iff_eq_inv _ _ a])
     (by simp),
   rw [← insert_erase (mem_univ (-1 : Kˣ)), prod_insert (not_mem_erase _ _),
       this, mul_one]
@@ -221,7 +221,6 @@ begin
     ... = 0 : by { rw [sum_pow_units K i, if_neg], exact hiq, }
 end
 
-section is_splitting_field
 open polynomial
 
 section
@@ -252,7 +251,7 @@ X_pow_card_sub_X_ne_zero K' $ nat.one_lt_pow _ _ (nat.pos_of_ne_zero hn) hp
 
 end
 
-variables (p : ℕ) [fact p.prime] [char_p K p]
+variables (p : ℕ) [fact p.prime] [algebra (zmod p) K]
 lemma roots_X_pow_card_sub_X : roots (X^q - X : K[X]) = finset.univ.val :=
 begin
   classical,
@@ -266,28 +265,10 @@ begin
   apply nodup_roots,
   rw separable_def,
   convert is_coprime_one_right.neg_right using 1,
-  { rw [derivative_sub, derivative_X, derivative_X_pow, ←C_eq_nat_cast,
-    C_eq_zero.mpr (char_p.cast_card_eq_zero K), zero_mul, zero_sub], },
+  { rw [derivative_sub, derivative_X, derivative_X_pow, char_p.cast_card_eq_zero K, C_0, zero_mul,
+      zero_sub] },
   end
 
-instance : is_splitting_field (zmod p) K (X^q - X) :=
-{ splits :=
-  begin
-    have h : (X^q - X : K[X]).nat_degree = q :=
-      X_pow_card_sub_X_nat_degree_eq K fintype.one_lt_card,
-    rw [←splits_id_iff_splits, splits_iff_card_roots, polynomial.map_sub, polynomial.map_pow,
-      map_X, h, roots_X_pow_card_sub_X K, ←finset.card_def, finset.card_univ],
-  end,
-  adjoin_roots :=
-  begin
-    classical,
-    transitivity algebra.adjoin (zmod p) ((roots (X^q - X : K[X])).to_finset : set K),
-    { simp only [polynomial.map_pow, map_X, polynomial.map_sub], convert rfl },
-    { rw [roots_X_pow_card_sub_X, val_to_finset, coe_univ, algebra.adjoin_univ], }
-  end }
-
-end is_splitting_field
-
 variables {K}
 
 theorem frobenius_pow {p : ℕ} [fact p.prime] [char_p K p] {n : ℕ} (hcard : q = p^n) :
@@ -337,7 +318,7 @@ end zmod
 namespace char_p
 
 lemma sq_add_sq (R : Type*) [comm_ring R] [is_domain R]
-  (p : ℕ) [fact (0 < p)] [char_p R p] (x : ℤ) :
+  (p : ℕ) [ne_zero p] [char_p R p] (x : ℤ) :
   ∃ a b : ℕ, (a^2 + b^2 : R) = x :=
 begin
   haveI := char_is_prime_of_pos R p,
@@ -353,18 +334,21 @@ open zmod
 
 /-- The **Fermat-Euler totient theorem**. `nat.modeq.pow_totient` is an alternative statement
   of the same theorem. -/
-@[simp] lemma zmod.pow_totient {n : ℕ} [fact (0 < n)] (x : (zmod n)ˣ) : x ^ φ n = 1 :=
-by rw [← card_units_eq_totient, pow_card_eq_one]
+@[simp] lemma zmod.pow_totient {n : ℕ} (x : (zmod n)ˣ) : x ^ φ n = 1 :=
+begin
+  cases n,
+  { rw [nat.totient_zero, pow_zero] },
+  { rw [← card_units_eq_totient, pow_card_eq_one] }
+end
 
 /-- The **Fermat-Euler totient theorem**. `zmod.pow_totient` is an alternative statement
   of the same theorem. -/
 lemma nat.modeq.pow_totient {x n : ℕ} (h : nat.coprime x n) : x ^ φ n ≡ 1 [MOD n] :=
 begin
-  cases n, {simp},
   rw ← zmod.eq_iff_modeq_nat,
-  let x' : units (zmod (n+1)) := zmod.unit_of_coprime _ h,
+  let x' : units (zmod n) := zmod.unit_of_coprime _ h,
   have := zmod.pow_totient x',
-  apply_fun (coe : units (zmod (n+1)) → zmod (n+1)) at this,
+  apply_fun (coe : units (zmod n) → zmod n) at this,
   simpa only [-zmod.pow_totient, nat.succ_eq_add_one, nat.cast_pow, units.coe_one,
     nat.cast_one, coe_unit_of_coprime, units.coe_pow],
 end
@@ -416,6 +400,14 @@ theorem pow_card_sub_one_eq_one {p : ℕ} [fact p.prime] {a : zmod p} (ha : a 
   a ^ (p - 1) = 1 :=
 by { have h := pow_card_sub_one_eq_one a ha, rwa zmod.card p at h }
 
+theorem order_of_units_dvd_card_sub_one {p : ℕ} [fact p.prime] (u : (zmod p)ˣ) :
+  order_of u ∣ p - 1 :=
+order_of_dvd_of_pow_eq_one $ units_pow_card_sub_one_eq_one _ _
+
+theorem order_of_dvd_card_sub_one {p : ℕ} [fact p.prime] {a : zmod p} (ha : a ≠ 0) :
+  order_of a ∣ p - 1 :=
+order_of_dvd_of_pow_eq_one $ pow_card_sub_one_eq_one ha
+
 open polynomial
 
 lemma expand_card {p : ℕ} [fact p.prime] (f : polynomial (zmod p)) :
@@ -436,3 +428,113 @@ begin
     exact zmod.char_p p },
   simpa [← zmod.int_coe_eq_int_coe_iff] using zmod.pow_card_sub_one_eq_one this
 end
+
+section
+
+namespace finite_field
+
+variables {F : Type*} [field F]
+
+section finite
+variables [finite F]
+
+/-- In a finite field of characteristic `2`, all elements are squares. -/
+lemma is_square_of_char_two (hF : ring_char F = 2) (a : F) : is_square a :=
+begin
+  haveI hF' : char_p F 2 := ring_char.of_eq hF,
+  exact is_square_of_char_two' a,
+end
+
+/-- In a finite field of odd characteristic, not every element is a square. -/
+lemma exists_nonsquare (hF : ring_char F ≠ 2) : ∃ (a : F), ¬ is_square a :=
+begin
+  -- Idea: the squaring map on `F` is not injective, hence not surjective
+  let sq : F → F := λ x, x ^ 2,
+  have h : ¬ injective sq,
+  { simp only [injective, not_forall, exists_prop],
+    refine ⟨-1, 1, _, ring.neg_one_ne_one_of_char_ne_two hF⟩,
+    simp only [sq, one_pow, neg_one_sq] },
+  rw finite.injective_iff_surjective at h, -- sq not surjective
+  simp_rw [is_square, ←pow_two, @eq_comm _ _ (_ ^ 2)],
+  push_neg at ⊢ h,
+  exact h,
+end
+
+end finite
+
+variables [fintype F]
+
+/-- The finite field `F` has even cardinality iff it has characteristic `2`. -/
+lemma even_card_iff_char_two : ring_char F = 2 ↔ fintype.card F % 2 = 0 :=
+begin
+  rcases finite_field.card F (ring_char F) with ⟨n, hp, h⟩,
+  rw [h, nat.pow_mod],
+  split,
+  { intro hF,
+    rw hF,
+    simp only [nat.bit0_mod_two, zero_pow', ne.def, pnat.ne_zero, not_false_iff, nat.zero_mod], },
+  { rw [← nat.even_iff, nat.even_pow],
+    rintros ⟨hev, hnz⟩,
+    rw [nat.even_iff, nat.mod_mod] at hev,
+    exact (nat.prime.eq_two_or_odd hp).resolve_right (ne_of_eq_of_ne hev zero_ne_one), },
+end
+
+lemma even_card_of_char_two (hF : ring_char F = 2) : fintype.card F % 2 = 0 :=
+even_card_iff_char_two.mp hF
+
+lemma odd_card_of_char_ne_two (hF : ring_char F ≠ 2) : fintype.card F % 2 = 1 :=
+nat.mod_two_ne_zero.mp (mt even_card_iff_char_two.mpr hF)
+
+/-- If `F` has odd characteristic, then for nonzero `a : F`, we have that `a ^ (#F / 2) = ±1`. -/
+lemma pow_dichotomy (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
+  a ^ (fintype.card F / 2) = 1 ∨ a ^ (fintype.card F / 2) = -1 :=
+begin
+  have h₁ := finite_field.pow_card_sub_one_eq_one a ha,
+  rw [← nat.two_mul_odd_div_two (finite_field.odd_card_of_char_ne_two hF),
+      mul_comm, pow_mul, pow_two] at h₁,
+  exact mul_self_eq_one_iff.mp h₁,
+end
+
+/-- A unit `a` of a finite field `F` of odd characteristic is a square
+if and only if `a ^ (#F / 2) = 1`. -/
+lemma unit_is_square_iff (hF : ring_char F ≠ 2) (a : Fˣ) :
+  is_square a ↔ a ^ (fintype.card F / 2) = 1 :=
+begin
+  classical,
+  obtain ⟨g, hg⟩ := is_cyclic.exists_generator Fˣ,
+  obtain ⟨n, hn⟩ : a ∈ submonoid.powers g, { rw mem_powers_iff_mem_zpowers, apply hg },
+  have hodd := nat.two_mul_odd_div_two (finite_field.odd_card_of_char_ne_two hF),
+  split,
+  { rintro ⟨y, rfl⟩,
+    rw [← pow_two, ← pow_mul, hodd],
+    apply_fun (@coe Fˣ F _) using units.ext,
+    { push_cast,
+      exact finite_field.pow_card_sub_one_eq_one (y : F) (units.ne_zero y), }, },
+  { subst a, assume h,
+    have key : 2 * (fintype.card F / 2) ∣ n * (fintype.card F / 2),
+    { rw [← pow_mul] at h,
+      rw [hodd, ← fintype.card_units, ← order_of_eq_card_of_forall_mem_zpowers hg],
+      apply order_of_dvd_of_pow_eq_one h },
+    have : 0 < fintype.card F / 2 := nat.div_pos fintype.one_lt_card (by norm_num),
+    obtain ⟨m, rfl⟩ := nat.dvd_of_mul_dvd_mul_right this key,
+    refine ⟨g ^ m, _⟩,
+    rw [mul_comm, pow_mul, pow_two], },
+end
+
+/-- A non-zero `a : F` is a square if and only if `a ^ (#F / 2) = 1`. -/
+lemma is_square_iff (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
+  is_square a ↔ a ^ (fintype.card F / 2) = 1 :=
+begin
+  apply (iff_congr _ (by simp [units.ext_iff])).mp
+        (finite_field.unit_is_square_iff hF (units.mk0 a ha)),
+  simp only [is_square, units.ext_iff, units.coe_mk0, units.coe_mul],
+  split,
+  { rintro ⟨y, hy⟩, exact ⟨y, hy⟩ },
+  { rintro ⟨y, rfl⟩,
+    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
+    refine ⟨units.mk0 y hy, _⟩, simp, }
+end
+
+end finite_field
+
+end
diff --git a/src/field_theory/finite/galois_field.lean b/src/field_theory/finite/galois_field.lean
index 71e008d43a339..d787c29c4b3c7 100644
--- a/src/field_theory/finite/galois_field.lean
+++ b/src/field_theory/finite/galois_field.lean
@@ -5,13 +5,17 @@ Authors: Aaron Anderson, Alex J. Best, Johan Commelin, Eric Rodriguez, Ruben Van
 -/
 
 import algebra.char_p.algebra
+import data.zmod.algebra
 import field_theory.finite.basic
-import field_theory.separable
-import linear_algebra.finite_dimensional
+import field_theory.galois
+import field_theory.splitting_field.is_splitting_field
 
 /-!
 # Galois fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `p` is a prime number, and `n` a natural number,
 then `galois_field p n` is defined as the splitting field of `X^(p^n) - X` over `zmod p`.
 It is a finite field with `p ^ n` elements.
@@ -30,15 +34,32 @@ It is a finite field with `p ^ n` elements.
 
 noncomputable theory
 
-open polynomial
+open polynomial finset
 open_locale polynomial
 
+instance finite_field.has_sub.sub.polynomial.is_splitting_field (K F : Type*) [field K] [fintype K]
+  [field F] [algebra F K] : is_splitting_field F K (X ^ (fintype.card K) - X) :=
+{ splits :=
+  begin
+    have h : (X ^ (fintype.card K) - X : K[X]).nat_degree = fintype.card K :=
+      finite_field.X_pow_card_sub_X_nat_degree_eq K fintype.one_lt_card,
+    rw [←splits_id_iff_splits, splits_iff_card_roots, polynomial.map_sub, polynomial.map_pow,
+      map_X, h, finite_field.roots_X_pow_card_sub_X K, ←finset.card_def, finset.card_univ],
+  end,
+  adjoin_root_set :=
+  begin
+    classical,
+    transitivity algebra.adjoin F ((roots (X ^ (fintype.card K) - X : K[X])).to_finset : set K),
+    { simp only [root_set, polynomial.map_pow, map_X, polynomial.map_sub], },
+    { rw [finite_field.roots_X_pow_card_sub_X, val_to_finset, coe_univ, algebra.adjoin_univ], }
+  end }
+
 lemma galois_poly_separable {K : Type*} [field K] (p q : ℕ) [char_p K p] (h : p ∣ q) :
   separable (X ^ q - X : K[X]) :=
 begin
   use [1, (X ^ q - X - 1)],
   rw [← char_p.cast_eq_zero_iff K[X] p] at h,
-  rw [derivative_sub, derivative_pow, derivative_X, h],
+  rw [derivative_sub, derivative_X_pow, derivative_X, C_eq_nat_cast, h],
   ring,
 end
 
@@ -91,15 +112,15 @@ begin
   intros x hx,
   -- We discharge the `p = 0` separately, to avoid typeclass issues on `zmod p`.
   unfreezingI { cases p, cases hp, },
-  apply subring.closure_induction hx; clear_dependent x; simp_rw mem_root_set aux,
+  apply subring.closure_induction hx; clear_dependent x; simp_rw mem_root_set_of_ne aux,
   { rintros x (⟨r, rfl⟩ | hx),
     { simp only [aeval_X_pow, aeval_X, alg_hom.map_sub],
       rw [← map_pow, zmod.pow_card_pow, sub_self], },
     { dsimp only [galois_field] at hx,
-      rwa mem_root_set aux at hx, }, },
+      rwa mem_root_set_of_ne aux at hx, apply_instance }, },
   { dsimp only [g_poly],
     rw [← coeff_zero_eq_aeval_zero'],
-    simp only [coeff_X_pow, coeff_X_zero, sub_zero, ring_hom.map_eq_zero, ite_eq_right_iff,
+    simp only [coeff_X_pow, coeff_X_zero, sub_zero, _root_.map_eq_zero, ite_eq_right_iff,
       one_ne_zero, coeff_sub],
     intro hn,
     exact nat.not_lt_zero 1 (pow_eq_zero hn.symm ▸ hp), },
@@ -136,32 +157,31 @@ end
 
 /-- A Galois field with exponent 1 is equivalent to `zmod` -/
 def equiv_zmod_p : galois_field p 1 ≃ₐ[zmod p] (zmod p) :=
-have h : (X ^ p ^ 1 : (zmod p)[X]) = X ^ (fintype.card (zmod p)),
-  by rw [pow_one, zmod.card p],
-have inst : is_splitting_field (zmod p) (zmod p) (X ^ p ^ 1 - X),
-  by { rw h, apply_instance },
-by exactI (is_splitting_field.alg_equiv (zmod p) (X ^ (p ^ 1) - X : (zmod p)[X])).symm
+let h : (X ^ p ^ 1 : (zmod p)[X]) = X ^ (fintype.card (zmod p)) :=
+  by rw [pow_one, zmod.card p] in
+let inst : is_splitting_field (zmod p) (zmod p) (X ^ p ^ 1 - X) :=
+  by { rw h, apply_instance } in
+(@is_splitting_field.alg_equiv _ (zmod p) _ _ _ (X ^ (p ^ 1) - X : (zmod p)[X]) inst).symm
 
 variables {K : Type*} [field K] [fintype K] [algebra (zmod p) K]
 
 theorem splits_X_pow_card_sub_X : splits (algebra_map (zmod p) K) (X ^ fintype.card K - X) :=
-by rw [←splits_id_iff_splits, polynomial.map_sub, polynomial.map_pow, map_X, splits_iff_card_roots,
-  finite_field.roots_X_pow_card_sub_X, ←finset.card_def, finset.card_univ,
-  finite_field.X_pow_card_sub_X_nat_degree_eq]; exact fintype.one_lt_card
+(finite_field.has_sub.sub.polynomial.is_splitting_field K (zmod p)).splits
 
 lemma is_splitting_field_of_card_eq (h : fintype.card K = p ^ n) :
   is_splitting_field (zmod p) K (X ^ (p ^ n) - X) :=
-{ splits := by { rw ← h, exact splits_X_pow_card_sub_X p },
-  adjoin_roots :=
-  begin
-    have hne : n ≠ 0,
-    { rintro rfl, rw [pow_zero, fintype.card_eq_one_iff_nonempty_unique] at h,
-      cases h, resetI, exact false_of_nontrivial_of_subsingleton K },
-    refine algebra.eq_top_iff.mpr (λ x, algebra.subset_adjoin _),
-    rw [polynomial.map_sub, polynomial.map_pow, map_X, finset.mem_coe, multiset.mem_to_finset,
-        mem_roots, is_root.def, eval_sub, eval_pow, eval_X, ← h, finite_field.pow_card, sub_self],
-    exact finite_field.X_pow_card_pow_sub_X_ne_zero K hne (fact.out _)
-  end }
+h ▸ finite_field.has_sub.sub.polynomial.is_splitting_field K (zmod p)
+
+@[priority 100]
+instance {K K' : Type*} [field K] [field K'] [finite K'] [algebra K K'] : is_galois K K' :=
+begin
+  casesI nonempty_fintype K',
+  obtain ⟨p, hp⟩ := char_p.exists K,
+  haveI : char_p K p := hp,
+  haveI : char_p K' p := char_p_of_injective_algebra_map' K K' p,
+  exact is_galois.of_separable_splitting_field (galois_poly_separable p (fintype.card K')
+    (let ⟨n, hp, hn⟩ := finite_field.card K' p in hn.symm ▸ dvd_pow_self p n.ne_zero)),
+end
 
 /-- Any finite field is (possibly non canonically) isomorphic to some Galois field. -/
 def alg_equiv_galois_field (h : fintype.card K = p ^ n) :
@@ -210,6 +230,8 @@ begin
     all_goals {apply_instance}, },
   rw ← hpp' at *,
   haveI := fact_iff.2 hp,
+  letI : algebra (zmod p) K := zmod.algebra _ _,
+  letI : algebra (zmod p) K' := zmod.algebra _ _,
   exact alg_equiv_of_card_eq p hKK',
 end
 
diff --git a/src/field_theory/finite/polynomial.lean b/src/field_theory/finite/polynomial.lean
index ab9d717b709f4..5576616d7209b 100644
--- a/src/field_theory/finite/polynomial.lean
+++ b/src/field_theory/finite/polynomial.lean
@@ -12,6 +12,9 @@ import field_theory.finite.basic
 
 /-!
 ## Polynomials over finite fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 namespace mv_polynomial
@@ -127,10 +130,11 @@ variables (K σ)
   map_smul' := λ a p, by { ext e, rw [smul_eq_C_mul, ring_hom.map_mul, eval_C], refl } }
 end
 
-variables [field K] [fintype K] [fintype σ]
+variables [field K] [fintype K] [finite σ]
 
 lemma map_restrict_dom_evalₗ : (restrict_degree σ K (fintype.card K - 1)).map (evalₗ K σ) = ⊤ :=
 begin
+  casesI nonempty_fintype σ,
   refine top_unique (set_like.le_def.2 $ assume e _, mem_map.2 _),
   refine ⟨∑ n : σ → K, e n • indicator n, _, _⟩,
   { exact sum_mem (assume c _, smul_mem _ _ (indicator_mem_restrict_degree _)) },
@@ -176,47 +180,48 @@ end comm_ring
 
 variables [field K]
 
-lemma dim_R [fintype σ] : module.rank K (R σ K) = fintype.card (σ → K) :=
+lemma rank_R [fintype σ] : module.rank K (R σ K) = fintype.card (σ → K) :=
 calc module.rank K (R σ K) =
   module.rank K (↥{s : σ →₀ ℕ | ∀ (n : σ), s n ≤ fintype.card K - 1} →₀ K) :
-    linear_equiv.dim_eq
+    linear_equiv.rank_eq
       (finsupp.supported_equiv_finsupp {s : σ →₀ ℕ | ∀n:σ, s n ≤ fintype.card K - 1 })
-  ... = #{s : σ →₀ ℕ | ∀ (n : σ), s n ≤ fintype.card K - 1} :
-    by rw [finsupp.dim_eq, dim_self, mul_one]
+  ... = #{s : σ →₀ ℕ | ∀ (n : σ), s n ≤ fintype.card K - 1} : by rw [rank_finsupp_self']
   ... = #{s : σ → ℕ | ∀ (n : σ), s n < fintype.card K } :
   begin
-    refine quotient.sound ⟨equiv.subtype_equiv finsupp.equiv_fun_on_fintype $ assume f, _⟩,
+    refine quotient.sound ⟨equiv.subtype_equiv finsupp.equiv_fun_on_finite $ assume f, _⟩,
     refine forall_congr (assume n, le_tsub_iff_right _),
     exact fintype.card_pos_iff.2 ⟨0⟩
   end
   ... = #(σ → {n // n < fintype.card K}) :
     (@equiv.subtype_pi_equiv_pi σ (λ_, ℕ) (λs n, n < fintype.card K)).cardinal_eq
   ... = #(σ → fin (fintype.card K)) :
-    (equiv.arrow_congr (equiv.refl σ) (equiv.fin_equiv_subtype _).symm).cardinal_eq
+    (equiv.arrow_congr (equiv.refl σ) fin.equiv_subtype.symm).cardinal_eq
   ... = #(σ → K) :
     (equiv.arrow_congr (equiv.refl σ) (fintype.equiv_fin K).symm).cardinal_eq
   ... = fintype.card (σ → K) : cardinal.mk_fintype _
 
-instance [fintype σ] : finite_dimensional K (R σ K) :=
-is_noetherian.iff_fg.1 $ is_noetherian.iff_dim_lt_omega.mpr
-  (by simpa only [dim_R] using cardinal.nat_lt_omega (fintype.card (σ → K)))
+instance [finite σ] : finite_dimensional K (R σ K) :=
+by { casesI nonempty_fintype σ,
+  exact is_noetherian.iff_fg.1 (is_noetherian.iff_rank_lt_aleph_0.mpr $
+    by simpa only [rank_R] using cardinal.nat_lt_aleph_0 (fintype.card (σ → K))) }
 
 lemma finrank_R [fintype σ] : finite_dimensional.finrank K (R σ K) = fintype.card (σ → K) :=
-finite_dimensional.finrank_eq_of_dim_eq (dim_R σ K)
+finite_dimensional.finrank_eq_of_rank_eq (rank_R σ K)
 
-lemma range_evalᵢ [fintype σ] : (evalᵢ σ K).range = ⊤ :=
+lemma range_evalᵢ [finite σ] : (evalᵢ σ K).range = ⊤ :=
 begin
   rw [evalᵢ, linear_map.range_comp, range_subtype],
   exact map_restrict_dom_evalₗ
 end
 
-lemma ker_evalₗ [fintype σ] : (evalᵢ σ K).ker = ⊥ :=
+lemma ker_evalₗ [finite σ] : (evalᵢ σ K).ker = ⊥ :=
 begin
+  casesI nonempty_fintype σ,
   refine (ker_eq_bot_iff_range_eq_top_of_finrank_eq_finrank _).mpr (range_evalᵢ _ _),
   rw [finite_dimensional.finrank_fintype_fun_eq_card, finrank_R]
 end
 
-lemma eq_zero_of_eval_eq_zero  [fintype σ] (p : mv_polynomial σ K)
+lemma eq_zero_of_eval_eq_zero  [finite σ] (p : mv_polynomial σ K)
   (h : ∀v:σ → K, eval v p = 0) (hp : p ∈ restrict_degree σ K (fintype.card K - 1)) :
   p = 0 :=
 let p' : R σ K := ⟨p, hp⟩ in
diff --git a/src/field_theory/finite/trace.lean b/src/field_theory/finite/trace.lean
new file mode 100644
index 0000000000000..59dd268d8dc49
--- /dev/null
+++ b/src/field_theory/finite/trace.lean
@@ -0,0 +1,36 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import ring_theory.trace
+import field_theory.finite.galois_field
+
+/-!
+# The trace map for finite fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We state the fact that the trace map from a finite field of
+characteristic `p` to `zmod p` is nondegenerate.
+
+## Tags
+finite field, trace
+-/
+
+namespace finite_field
+
+/-- The trace map from a finite field to its prime field is nongedenerate. -/
+lemma trace_to_zmod_nondegenerate (F : Type*) [field F] [finite F]
+  [algebra (zmod (ring_char F)) F] {a : F} (ha : a ≠ 0) :
+  ∃ b : F, algebra.trace (zmod (ring_char F)) F (a * b) ≠ 0 :=
+begin
+  haveI : fact (ring_char F).prime := ⟨char_p.char_is_prime F _⟩,
+  have htr := trace_form_nondegenerate (zmod (ring_char F)) F a,
+  simp_rw [algebra.trace_form_apply] at htr,
+  by_contra' hf,
+  exact ha (htr hf)
+end
+
+end finite_field
diff --git a/src/field_theory/finiteness.lean b/src/field_theory/finiteness.lean
index b8ca2c16da3a9..55746cd353899 100644
--- a/src/field_theory/finiteness.lean
+++ b/src/field_theory/finiteness.lean
@@ -9,6 +9,9 @@ import linear_algebra.dimension
 /-!
 # A module over a division ring is noetherian if and only if it is finite.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 -/
 
 universes u v
@@ -22,12 +25,12 @@ variables {K : Type u} {V : Type v} [division_ring K] [add_comm_group V] [module
 
 /--
 A module over a division ring is noetherian if and only if
-its dimension (as a cardinal) is strictly less than the first infinite cardinal `ω`.
+its dimension (as a cardinal) is strictly less than the first infinite cardinal `ℵ₀`.
 -/
-lemma iff_dim_lt_omega : is_noetherian K V ↔ module.rank K V < ω :=
+lemma iff_rank_lt_aleph_0 : is_noetherian K V ↔ module.rank K V < ℵ₀ :=
 begin
   let b := basis.of_vector_space K V,
-  rw [← b.mk_eq_dim'', lt_omega_iff_finite],
+  rw [← b.mk_eq_rank'', lt_aleph_0_iff_set_finite],
   split,
   { introI,
     exact finite_of_linear_independent (basis.of_vector_space_index.linear_independent K V) },
@@ -41,16 +44,16 @@ end
 variables (K V)
 
 /-- The dimension of a noetherian module over a division ring, as a cardinal,
-is strictly less than the first infinite cardinal `ω`. -/
-lemma dim_lt_omega : ∀ [is_noetherian K V], module.rank K V < ω :=
-is_noetherian.iff_dim_lt_omega.1
+is strictly less than the first infinite cardinal `ℵ₀`. -/
+lemma rank_lt_aleph_0 : ∀ [is_noetherian K V], module.rank K V < ℵ₀ :=
+is_noetherian.iff_rank_lt_aleph_0.1
 
 variables {K V}
 
 /-- In a noetherian module over a division ring, all bases are indexed by a finite type. -/
 noncomputable def fintype_basis_index {ι : Type*} [is_noetherian K V] (b : basis ι K V) :
   fintype ι :=
-b.fintype_index_of_dim_lt_omega (dim_lt_omega K V)
+b.fintype_index_of_rank_lt_aleph_0 (rank_lt_aleph_0 K V)
 
 /-- In a noetherian module over a division ring,
 `basis.of_vector_space` is indexed by a finite type. -/
@@ -61,7 +64,7 @@ fintype_basis_index (basis.of_vector_space K V)
 if a basis is indexed by a set, that set is finite. -/
 lemma finite_basis_index {ι : Type*} {s : set ι} [is_noetherian K V] (b : basis s K V) :
   s.finite :=
-b.finite_index_of_dim_lt_omega (dim_lt_omega K V)
+b.finite_index_of_rank_lt_aleph_0 (rank_lt_aleph_0 K V)
 
 variables (K V)
 
@@ -103,8 +106,8 @@ begin
   { introI h,
     exact ⟨⟨finset_basis_index K V, by { convert (finset_basis K V).span_eq, simp }⟩⟩ },
   { rintros ⟨s, hs⟩,
-    rw [is_noetherian.iff_dim_lt_omega, ← dim_top, ← hs],
-    exact lt_of_le_of_lt (dim_span_le _) (lt_omega_iff_finite.2 (set.finite_mem_finset s)) }
+    rw [is_noetherian.iff_rank_lt_aleph_0, ← rank_top, ← hs],
+    exact lt_of_le_of_lt (rank_span_le _) s.finite_to_set.lt_aleph_0 }
 end
 
 end is_noetherian
diff --git a/src/field_theory/fixed.lean b/src/field_theory/fixed.lean
index af1fd0a57bfad..eb7d527720fe8 100644
--- a/src/field_theory/fixed.lean
+++ b/src/field_theory/fixed.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 
+import algebra.group_ring_action.invariant
 import algebra.polynomial.group_ring_action
 import field_theory.normal
 import field_theory.separable
@@ -12,6 +13,9 @@ import field_theory.tower
 /-!
 # Fixed field under a group action.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This is the basis of the Fundamental Theorem of Galois Theory.
 Given a (finite) group `G` that acts on a field `F`, we define `fixed_points G F`,
 the subfield consisting of elements of `F` fixed_points by every element of `G`.
@@ -140,6 +144,7 @@ begin
   rw [hla, to_fun_apply, to_fun_apply, smul_smul, mul_inv_cancel_left]
 end
 
+section fintype
 variables [fintype G] (x : F)
 
 /-- `minpoly G F x` is the minimal polynomial of `(x : F)` over `fixed_points G F`. -/
@@ -175,7 +180,7 @@ begin
   erw [← polynomial.map_dvd_map' (subfield.subtype $ fixed_points.subfield G F),
       minpoly, polynomial.map_to_subring _ (subfield G F).to_subring, prod_X_sub_smul],
   refine fintype.prod_dvd_of_coprime
-    (polynomial.pairwise_coprime_X_sub $ mul_action.injective_of_quotient_stabilizer G x)
+    (polynomial.pairwise_coprime_X_sub_C $ mul_action.injective_of_quotient_stabilizer G x)
     (λ y, quotient_group.induction_on y $ λ g, _),
   rw [polynomial.dvd_iff_is_root, polynomial.is_root.def, mul_action.of_quotient_stabilizer_mk,
       polynomial.eval_smul',
@@ -217,45 +222,58 @@ theorem irreducible : irreducible (minpoly G F x) :=
 (polynomial.irreducible_of_monic (monic G F x) (ne_one G F x)).2 (irreducible_aux G F x)
 
 end minpoly
+end fintype
+
+theorem is_integral [finite G] (x : F) : is_integral (fixed_points.subfield G F) x :=
+by { casesI nonempty_fintype G, exact ⟨minpoly G F x, minpoly.monic G F x, minpoly.eval₂ G F x⟩ }
 
-theorem is_integral : is_integral (fixed_points.subfield G F) x :=
-⟨minpoly G F x, minpoly.monic G F x, minpoly.eval₂ G F x⟩
+section fintype
+variables [fintype G] (x : F)
 
 theorem minpoly_eq_minpoly :
   minpoly G F x = _root_.minpoly (fixed_points.subfield G F) x :=
 minpoly.eq_of_irreducible_of_monic (minpoly.irreducible G F x)
   (minpoly.eval₂ G F x) (minpoly.monic G F x)
 
+lemma rank_le_card : module.rank (fixed_points.subfield G F) F ≤ fintype.card G :=
+rank_le $ λ s hs, by simpa only [rank_fun', cardinal.mk_coe_finset, finset.coe_sort_coe,
+  cardinal.lift_nat_cast, cardinal.nat_cast_le]
+  using cardinal_lift_le_rank_of_linear_independent'
+    (linear_independent_smul_of_linear_independent G F hs)
+
+end fintype
+
+section finite
+variables [finite G]
+
 instance normal : normal (fixed_points.subfield G F) F :=
-⟨λ x, is_integral G F x, λ x, (polynomial.splits_id_iff_splits _).1 $
-by { rw [← minpoly_eq_minpoly, minpoly,
-    coe_algebra_map, ← subfield.to_subring.subtype_eq_subtype,
-    polynomial.map_to_subring _ (fixed_points.subfield G F).to_subring, prod_X_sub_smul],
-  exact polynomial.splits_prod _ (λ _ _, polynomial.splits_X_sub_C _) }⟩
+⟨λ x, (is_integral G F x).is_algebraic _, λ x, (polynomial.splits_id_iff_splits _).1 $
+begin
+  casesI nonempty_fintype G,
+  rw [←minpoly_eq_minpoly, minpoly, coe_algebra_map, ←subfield.to_subring.subtype_eq_subtype,
+    polynomial.map_to_subring _ (subfield G F).to_subring, prod_X_sub_smul],
+  exact polynomial.splits_prod _ (λ _ _, polynomial.splits_X_sub_C _),
+end⟩
 
 instance separable : is_separable (fixed_points.subfield G F) F :=
-⟨λ x, is_integral G F x,
- λ x, by
-{ -- this was a plain rw when we were using unbundled subrings
+⟨is_integral G F, λ x, by
+{ casesI nonempty_fintype G,
+  -- this was a plain rw when we were using unbundled subrings
   erw [← minpoly_eq_minpoly,
     ← polynomial.separable_map (fixed_points.subfield G F).subtype,
     minpoly, polynomial.map_to_subring _ ((subfield G F).to_subring) ],
   exact polynomial.separable_prod_X_sub_C_iff.2 (injective_of_quotient_stabilizer G x) }⟩
 
-lemma dim_le_card : module.rank (fixed_points.subfield G F) F ≤ fintype.card G :=
-dim_le $ λ s hs, by simpa only [dim_fun', cardinal.mk_finset, finset.coe_sort_coe,
-  cardinal.lift_nat_cast, cardinal.nat_cast_le]
-  using cardinal_lift_le_dim_of_linear_independent'
-    (linear_independent_smul_of_linear_independent G F hs)
+instance : finite_dimensional (subfield G F) F :=
+by { casesI nonempty_fintype G, exact is_noetherian.iff_fg.1 (is_noetherian.iff_rank_lt_aleph_0.2 $
+  (rank_le_card G F).trans_lt $ cardinal.nat_lt_aleph_0 _) }
 
-instance : finite_dimensional (fixed_points.subfield G F) F :=
-is_noetherian.iff_fg.1 $ is_noetherian.iff_dim_lt_omega.2 $
-lt_of_le_of_lt (dim_le_card G F) (cardinal.nat_lt_omega _)
+end finite
 
-lemma finrank_le_card : finrank (fixed_points.subfield G F) F ≤ fintype.card G :=
+lemma finrank_le_card [fintype G] : finrank (subfield G F) F ≤ fintype.card G :=
 begin
-  rw [← cardinal.nat_cast_le, finrank_eq_dim],
-  apply dim_le_card,
+  rw [← cardinal.nat_cast_le, finrank_eq_rank],
+  apply rank_le_card,
 end
 
 end fixed_points
@@ -276,13 +294,6 @@ lemma cardinal_mk_alg_hom (K : Type u) (V : Type v) (W : Type w)
   cardinal.mk (V →ₐ[K] W) ≤ finrank W (V →ₗ[K] W) :=
 cardinal_mk_le_finrank_of_linear_independent $ linear_independent_to_linear_map K V W
 
-noncomputable instance alg_hom.fintype (K : Type u) (V : Type v) (W : Type w)
-  [field K] [field V] [algebra K V] [finite_dimensional K V]
-            [field W] [algebra K W] [finite_dimensional K W] :
-  fintype (V →ₐ[K] W) :=
-classical.choice $ cardinal.lt_omega_iff_fintype.1 $
-lt_of_le_of_lt (cardinal_mk_alg_hom K V W) (cardinal.nat_lt_omega _)
-
 noncomputable instance alg_equiv.fintype (K : Type u) (V : Type v)
   [field K] [field V] [algebra K V] [finite_dimensional K V] :
   fintype (V ≃ₐ[K] V) :=
@@ -296,7 +307,7 @@ fintype_card_le_finrank_of_linear_independent $ linear_independent_to_linear_map
 namespace fixed_points
 
 theorem finrank_eq_card (G : Type u) (F : Type v) [group G] [field F]
-  [fintype G] [mul_semiring_action G F] [has_faithful_scalar G F] :
+  [fintype G] [mul_semiring_action G F] [has_faithful_smul G F] :
   finrank (fixed_points.subfield G F) F = fintype.card G :=
 le_antisymm (fixed_points.finrank_le_card G F) $
 calc  fintype.card G
@@ -307,9 +318,10 @@ calc  fintype.card G
 
 /-- `mul_semiring_action.to_alg_hom` is bijective. -/
 theorem to_alg_hom_bijective (G : Type u) (F : Type v) [group G] [field F]
-  [fintype G] [mul_semiring_action G F] [has_faithful_scalar G F] :
+  [finite G] [mul_semiring_action G F] [has_faithful_smul G F] :
   function.bijective (mul_semiring_action.to_alg_hom _ _ : G → F →ₐ[subfield G F] F) :=
 begin
+  casesI nonempty_fintype G,
   rw fintype.bijective_iff_injective_and_card,
   split,
   { exact mul_semiring_action.to_alg_hom_injective _ F },
@@ -321,7 +333,7 @@ end
 
 /-- Bijection between G and algebra homomorphisms that fix the fixed points -/
 def to_alg_hom_equiv (G : Type u) (F : Type v) [group G] [field F]
-  [fintype G] [mul_semiring_action G F] [has_faithful_scalar G F] :
+  [fintype G] [mul_semiring_action G F] [has_faithful_smul G F] :
     G ≃ (F →ₐ[fixed_points.subfield G F] F) :=
 equiv.of_bijective _ (to_alg_hom_bijective G F)
 
diff --git a/src/field_theory/galois.lean b/src/field_theory/galois.lean
index 6447db5cb2dac..f1bc6f0db9643 100644
--- a/src/field_theory/galois.lean
+++ b/src/field_theory/galois.lean
@@ -4,15 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning, Patrick Lutz
 -/
 
-import field_theory.normal
 import field_theory.primitive_element
 import field_theory.fixed
-import ring_theory.power_basis
 import group_theory.group_action.fixing_subgroup
 
 /-!
 # Galois Extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define Galois extensions as extensions which are both separable and normal.
 
 ## Main definitions
@@ -66,7 +67,7 @@ instance self : is_galois F F :=
 
 variables (F) {E}
 
-lemma integral [is_galois F E] (x : E) : is_integral F x := normal.is_integral' x
+lemma integral [is_galois F E] (x : E) : is_integral F x := to_normal.is_integral x
 
 lemma separable [is_galois F E] (x : E) : (minpoly F x).separable := is_separable.separable F x
 
@@ -74,7 +75,7 @@ lemma splits [is_galois F E] (x : E) : (minpoly F x).splits (algebra_map F E) :=
 
 variables (F E)
 
-instance of_fixed_field (G : Type*) [group G] [fintype G] [mul_semiring_action G E] :
+instance of_fixed_field (G : Type*) [group G] [finite G] [mul_semiring_action G E] :
   is_galois (fixed_points.subfield G E) E :=
 ⟨⟩
 
@@ -208,7 +209,7 @@ begin
         (set.inclusion H_le)).mpr ⟨set.inclusion_injective H_le, this⟩).2).symm },
   apply fintype.card_congr,
   refine (fixed_points.to_alg_hom_equiv H E).trans _,
-  refine (alg_equiv_equiv_alg_hom (fixed_field H) E).symm.trans _,
+  refine (alg_equiv_equiv_alg_hom (fixed_field H) E).to_equiv.symm.trans _,
   exact (fixing_subgroup_equiv (fixed_field H)).to_equiv.symm
 end
 
@@ -257,7 +258,7 @@ def intermediate_field_equiv_subgroup [finite_dimensional F E] [is_galois F E] :
   left_inv := λ K, fixed_field_fixing_subgroup K,
   right_inv := λ H, intermediate_field.fixing_subgroup_fixed_field H,
   map_rel_iff' := λ K L, by { rw [←fixed_field_fixing_subgroup L, intermediate_field.le_iff_le,
-                                  fixed_field_fixing_subgroup L, ←order_dual.dual_le], refl } }
+                                  fixed_field_fixing_subgroup L], refl } }
 
 /-- The Galois correspondence as a galois_insertion -/
 def galois_insertion_intermediate_field_subgroup [finite_dimensional F E] :
@@ -297,13 +298,10 @@ begin
   cases field.exists_primitive_element F E with α h1,
   use [minpoly F α, separable F α, is_galois.splits F α],
   rw [eq_top_iff, ←intermediate_field.top_to_subalgebra, ←h1],
-  rw intermediate_field.adjoin_simple_to_subalgebra_of_integral F α (integral F α),
+  rw intermediate_field.adjoin_simple_to_subalgebra_of_integral (integral F α),
   apply algebra.adjoin_mono,
-  rw [set.singleton_subset_iff, finset.mem_coe, multiset.mem_to_finset, polynomial.mem_roots],
-  { dsimp only [polynomial.is_root],
-    rw [polynomial.eval_map, ←polynomial.aeval_def],
-    exact minpoly.aeval _ _ },
-  { exact polynomial.map_ne_zero (minpoly.ne_zero (integral F α)) }
+  rw [set.singleton_subset_iff, polynomial.mem_root_set],
+  exact ⟨minpoly.ne_zero (integral F α), minpoly.aeval _ _⟩
 end
 
 lemma of_fixed_field_eq_bot [finite_dimensional F E]
@@ -329,23 +327,28 @@ end
 
 variables {F} {E} {p : F[X]}
 
-lemma of_separable_splitting_field_aux [hFE : finite_dimensional F E]
-  [sp : p.is_splitting_field F E] (hp : p.separable) (K : intermediate_field F E) {x : E}
-  (hx : x ∈ (p.map (algebra_map F E)).roots) :
-  fintype.card ((↑K⟮x⟯ : intermediate_field F E) →ₐ[F] E) =
+lemma of_separable_splitting_field_aux
+  [hFE : finite_dimensional F E]
+  [sp : p.is_splitting_field F E] (hp : p.separable)
+  (K : Type*) [field K] [algebra F K] [algebra K E] [is_scalar_tower F K E]
+  {x : E} (hx : x ∈ (p.map (algebra_map F E)).roots)
+  -- these are both implied by `hFE`, but as they carry data this makes the lemma more general
+  [fintype (K →ₐ[F] E)] [fintype (K⟮x⟯.restrict_scalars F →ₐ[F] E)] :
+  fintype.card (K⟮x⟯.restrict_scalars F →ₐ[F] E) =
     fintype.card (K →ₐ[F] E) * finrank K K⟮x⟯ :=
 begin
-  have h : is_integral K x := is_integral_of_is_scalar_tower x
+  have h : is_integral K x := is_integral_of_is_scalar_tower
     (is_integral_of_noetherian (is_noetherian.iff_fg.2 hFE) x),
   have h1 : p ≠ 0 := λ hp, by rwa [hp, polynomial.map_zero, polynomial.roots_zero] at hx,
   have h2 : (minpoly K x) ∣ p.map (algebra_map F K),
   { apply minpoly.dvd,
-    rw [polynomial.aeval_def, polynomial.eval₂_map, ←polynomial.eval_map],
+    rw [polynomial.aeval_def, polynomial.eval₂_map, ←polynomial.eval_map,
+      ←is_scalar_tower.algebra_map_eq],
     exact (polynomial.mem_roots (polynomial.map_ne_zero h1)).mp hx },
-  let key_equiv : ((↑K⟮x⟯ : intermediate_field F E) →ₐ[F] E) ≃ Σ (f : K →ₐ[F] E),
-    @alg_hom K K⟮x⟯ E _ _ _ _ (ring_hom.to_algebra f) :=
-  equiv.trans (alg_equiv.arrow_congr (intermediate_field.lift2_alg_equiv K⟮x⟯) (alg_equiv.refl))
-    alg_hom_equiv_sigma,
+  let key_equiv : (K⟮x⟯.restrict_scalars F →ₐ[F] E) ≃ Σ (f : K →ₐ[F] E),
+    @alg_hom K K⟮x⟯ E _ _ _ _ (ring_hom.to_algebra f),
+  { change (K⟮x⟯ →ₐ[F] E) ≃ Σ (f : K →ₐ[F] E), _,
+    exact alg_hom_equiv_sigma },
   haveI : Π (f : K →ₐ[F] E), fintype (@alg_hom K K⟮x⟯ E _ _ _ _ (ring_hom.to_algebra f)) := λ f, by
   { apply fintype.of_injective (sigma.mk f) (λ _ _ H, eq_of_heq ((sigma.mk.inj H).2)),
     exact fintype.of_equiv _ key_equiv },
@@ -368,15 +371,15 @@ begin
   let s := (p.map (algebra_map F E)).roots.to_finset,
   have adjoin_root : intermediate_field.adjoin F ↑s = ⊤,
   { apply intermediate_field.to_subalgebra_injective,
-    rw [intermediate_field.top_to_subalgebra, ←top_le_iff, ←sp.adjoin_roots],
+    rw [intermediate_field.top_to_subalgebra, ←top_le_iff, ←sp.adjoin_root_set],
     apply intermediate_field.algebra_adjoin_le_adjoin, },
   let P : intermediate_field F E → Prop := λ K, fintype.card (K →ₐ[F] E) = finrank F K,
   suffices : P (intermediate_field.adjoin F ↑s),
   { rw adjoin_root at this,
     apply of_card_aut_eq_finrank,
     rw ← eq.trans this (linear_equiv.finrank_eq intermediate_field.top_equiv.to_linear_equiv),
-    exact fintype.card_congr (equiv.trans (alg_equiv_equiv_alg_hom F E)
-      (alg_equiv.arrow_congr intermediate_field.top_equiv.symm alg_equiv.refl)) },
+    exact fintype.card_congr ((alg_equiv_equiv_alg_hom F E).to_equiv.trans
+      (intermediate_field.top_equiv.symm.arrow_congr alg_equiv.refl)) },
   apply intermediate_field.induction_on_adjoin_finset s P,
   { have key := intermediate_field.card_alg_hom_adjoin_integral F
       (show is_integral F (0 : E), by exact is_integral_zero),
@@ -391,7 +394,8 @@ begin
   rw [of_separable_splitting_field_aux hp K (multiset.mem_to_finset.mp hx),
     hK, finrank_mul_finrank],
   symmetry,
-  exact linear_equiv.finrank_eq (alg_equiv.to_linear_equiv (intermediate_field.lift2_alg_equiv _))
+  refine linear_equiv.finrank_eq _,
+  refl,
 end
 
 /--Equivalent characterizations of a Galois extension of finite degree-/
@@ -419,3 +423,21 @@ end
 end is_galois
 
 end galois_equivalent_definitions
+
+section normal_closure
+
+variables (k K F : Type*) [field k] [field K] [field F] [algebra k K] [algebra k F]
+  [algebra K F] [is_scalar_tower k K F] [is_galois k F]
+
+instance is_galois.normal_closure : is_galois k (normal_closure k K F) :=
+{ to_is_separable := is_separable_tower_bot_of_is_separable k _ F }
+
+end normal_closure
+
+section is_alg_closure
+
+@[priority 100]
+instance is_alg_closure.is_galois (k K : Type*) [field k] [field K] [algebra k K]
+  [is_alg_closure k K] [char_zero k] : is_galois k K := { }
+
+end is_alg_closure
diff --git a/src/field_theory/intermediate_field.lean b/src/field_theory/intermediate_field.lean
index cdb81f585706c..241d7b54f2b42 100644
--- a/src/field_theory/intermediate_field.lean
+++ b/src/field_theory/intermediate_field.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
 
+import field_theory.minpoly.field
 import field_theory.subfield
 import field_theory.tower
-import ring_theory.algebraic
 
 /-!
 # Intermediate fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `L / K` be a field extension, given as an instance `algebra K L`.
 This file defines the type of fields in between `K` and `L`, `intermediate_field K L`.
 An `intermediate_field K L` is a subfield of `L` which contains (the image of) `K`,
@@ -18,15 +21,14 @@ i.e. it is a `subfield L` and a `subalgebra K L`.
 
 ## Main definitions
 
- * `intermediate_field K L` : the type of intermediate fields between `K` and `L`.
-
- * `subalgebra.to_intermediate_field`: turns a subalgebra closed under `⁻¹`
-   into an intermediate field
-
- * `subfield.to_intermediate_field`: turns a subfield containing the image of `K`
-   into an intermediate field
-
+* `intermediate_field K L` : the type of intermediate fields between `K` and `L`.
+* `subalgebra.to_intermediate_field`: turns a subalgebra closed under `⁻¹`
+  into an intermediate field
+* `subfield.to_intermediate_field`: turns a subfield containing the image of `K`
+  into an intermediate field
 * `intermediate_field.map`: map an intermediate field along an `alg_hom`
+* `intermediate_field.restrict_scalars`: restrict the scalars of an intermediate field to a smaller
+  field in a tower of fields.
 
 ## Implementation notes
 
@@ -40,7 +42,7 @@ intermediate field, field extension
 open finite_dimensional polynomial
 open_locale big_operators polynomial
 
-variables (K L : Type*) [field K] [field L] [algebra K L]
+variables (K L L' : Type*) [field K] [field L] [field L'] [algebra K L] [algebra K L']
 
 /-- `S : intermediate_field K L` is a subset of `L` such that there is a field
 tower `L / S / K`. -/
@@ -51,7 +53,7 @@ structure intermediate_field extends subalgebra K L :=
 /-- Reinterpret an `intermediate_field` as a `subalgebra`. -/
 add_decl_doc intermediate_field.to_subalgebra
 
-variables {K L} (S : intermediate_field K L)
+variables {K L L'} (S : intermediate_field K L)
 
 namespace intermediate_field
 
@@ -62,10 +64,10 @@ instance : set_like (intermediate_field K L) L :=
 ⟨λ S, S.to_subalgebra.carrier, by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨h⟩, congr, }⟩
 
 instance : subfield_class (intermediate_field K L) L :=
-{ add_mem := λ s, s.add_mem',
+{ add_mem := λ s _ _, s.add_mem',
   zero_mem := λ s, s.zero_mem',
   neg_mem := neg_mem',
-  mul_mem := λ s, s.mul_mem',
+  mul_mem := λ s _ _, s.mul_mem',
   one_mem := λ s, s.one_mem',
   inv_mem := inv_mem' }
 
@@ -174,6 +176,9 @@ protected lemma coe_pow (x : S) (n : ℕ) : (↑(x ^ n) : L) = ↑x ^ n := submo
 
 end inherited_lemmas
 
+lemma coe_nat_mem (n : ℕ) : (n : L) ∈ S :=
+by simpa using coe_int_mem S n
+
 end intermediate_field
 
 /-- Turn a subalgebra closed under inverses into an intermediate field -/
@@ -188,11 +193,30 @@ def subalgebra.to_intermediate_field (S : subalgebra K L) (inv_mem : ∀ x ∈ S
   (S.to_intermediate_field inv_mem).to_subalgebra = S :=
 by { ext, refl }
 
-@[simp] lemma to_intermediate_field_to_subalgebra
-  (S : intermediate_field K L) (inv_mem : ∀ x ∈ S.to_subalgebra, x⁻¹ ∈ S) :
-  S.to_subalgebra.to_intermediate_field inv_mem = S :=
+@[simp] lemma to_intermediate_field_to_subalgebra (S : intermediate_field K L) :
+  S.to_subalgebra.to_intermediate_field (λ x, S.inv_mem) = S :=
 by { ext, refl }
 
+/-- Turn a subalgebra satisfying `is_field` into an intermediate_field -/
+def subalgebra.to_intermediate_field' (S : subalgebra K L) (hS : is_field S) :
+  intermediate_field K L :=
+S.to_intermediate_field $ λ x hx, begin
+  by_cases hx0 : x = 0,
+  { rw [hx0, inv_zero],
+    exact S.zero_mem },
+  letI hS' := hS.to_field,
+  obtain ⟨y, hy⟩ := hS.mul_inv_cancel (show (⟨x, hx⟩ : S) ≠ 0, from subtype.ne_of_val_ne hx0),
+  rw [subtype.ext_iff, S.coe_mul, S.coe_one, subtype.coe_mk, mul_eq_one_iff_inv_eq₀ hx0] at hy,
+  exact hy.symm ▸ y.2,
+end
+
+@[simp] lemma to_subalgebra_to_intermediate_field' (S : subalgebra K L) (hS : is_field S) :
+  (S.to_intermediate_field' hS).to_subalgebra = S :=
+by { ext, refl }
+
+@[simp] lemma to_intermediate_field'_to_subalgebra (S : intermediate_field K L) :
+  S.to_subalgebra.to_intermediate_field' (field.to_is_field S) = S :=
+by { ext, refl }
 
 /-- Turn a subfield of `L` containing the image of `K` into an intermediate field -/
 def subfield.to_intermediate_field (S : subfield L)
@@ -227,21 +251,21 @@ end
 
 /-! `intermediate_field`s inherit structure from their `subalgebra` coercions. -/
 
-instance module' {R} [semiring R] [has_scalar R K] [module R L] [is_scalar_tower R K L] :
+instance module' {R} [semiring R] [has_smul R K] [module R L] [is_scalar_tower R K L] :
   module R S :=
 S.to_subalgebra.module'
 instance module : module K S := S.to_subalgebra.module
 
-instance is_scalar_tower {R} [semiring R] [has_scalar R K] [module R L]
+instance is_scalar_tower {R} [semiring R] [has_smul R K] [module R L]
   [is_scalar_tower R K L] :
   is_scalar_tower R K S :=
 S.to_subalgebra.is_scalar_tower
 
-@[simp] lemma coe_smul {R} [semiring R] [has_scalar R K] [module R L] [is_scalar_tower R K L]
+@[simp] lemma coe_smul {R} [semiring R] [has_smul R K] [module R L] [is_scalar_tower R K L]
   (r : R) (x : S) :
   ↑(r • x) = (r • x : L) := rfl
 
-instance algebra' {K'} [comm_semiring K'] [has_scalar K' K] [algebra K' L]
+instance algebra' {K'} [comm_semiring K'] [has_smul K' K] [algebra K' L]
   [is_scalar_tower K' K L] :
   algebra K' S :=
 S.to_subalgebra.algebra'
@@ -262,15 +286,15 @@ is_scalar_tower.subalgebra' _ _ _ S.to_subalgebra
 instance is_scalar_tower_mid' : is_scalar_tower K S L :=
 S.is_scalar_tower_mid
 
-variables {L' : Type*} [field L'] [algebra K L']
-
 /-- If `f : L →+* L'` fixes `K`, `S.map f` is the intermediate field between `L'` and `K`
 such that `x ∈ S ↔ f x ∈ S.map f`. -/
-def map (f : L →ₐ[K] L') : intermediate_field K L' :=
-{ inv_mem' := by { rintros _ ⟨x, hx, rfl⟩, exact ⟨x⁻¹, S.inv_mem hx, f.map_inv x⟩ },
+def map (f : L →ₐ[K] L') (S : intermediate_field K L) : intermediate_field K L' :=
+{ inv_mem' := by { rintros _ ⟨x, hx, rfl⟩, exact ⟨x⁻¹, S.inv_mem hx, map_inv₀ f x⟩ },
   neg_mem' := λ x hx, (S.to_subalgebra.map f).neg_mem hx,
   .. S.to_subalgebra.map f}
 
+@[simp] lemma coe_map (f : L →ₐ[K] L') : (S.map f : set L') = f '' S := rfl
+
 lemma map_map {K L₁ L₂ L₃ : Type*} [field K] [field L₁] [algebra K L₁]
   [field L₂] [algebra K L₂] [field L₃] [algebra K L₃]
   (E : intermediate_field K L₁) (f : L₁ →ₐ[K] L₂) (g : L₂ →ₐ[K] L₃) :
@@ -280,10 +304,43 @@ set_like.coe_injective $ set.image_image _ _ _
 /-- Given an equivalence `e : L ≃ₐ[K] L'` of `K`-field extensions and an intermediate
 field `E` of `L/K`, `intermediate_field_equiv_map e E` is the induced equivalence
 between `E` and `E.map e` -/
-@[simps] def intermediate_field_map (e : L ≃ₐ[K] L') (E : intermediate_field K L) :
+def intermediate_field_map (e : L ≃ₐ[K] L') (E : intermediate_field K L) :
   E ≃ₐ[K] (E.map e.to_alg_hom) :=
 e.subalgebra_map E.to_subalgebra
 
+/- We manually add these two simp lemmas because `@[simps]` before `intermediate_field_map`
+  led to a timeout. -/
+@[simp] lemma intermediate_field_map_apply_coe (e : L ≃ₐ[K] L') (E : intermediate_field K L)
+  (a : E) : ↑(intermediate_field_map e E a) = e a := rfl
+
+@[simp] lemma intermediate_field_map_symm_apply_coe (e : L ≃ₐ[K] L') (E : intermediate_field K L)
+  (a : E.map e.to_alg_hom) : ↑((intermediate_field_map e E).symm a) = e.symm a := rfl
+
+end intermediate_field
+
+namespace alg_hom
+
+variables (f : L →ₐ[K] L')
+
+/-- The range of an algebra homomorphism, as an intermediate field. -/
+@[simps to_subalgebra]
+def field_range : intermediate_field K L' :=
+{ .. f.range,
+  .. (f : L →+* L').field_range }
+
+@[simp] lemma coe_field_range : ↑f.field_range = set.range f := rfl
+
+@[simp] lemma field_range_to_subfield :
+  f.field_range.to_subfield = (f : L →+* L').field_range := rfl
+
+variables {f}
+
+@[simp] lemma mem_field_range {y : L'} : y ∈ f.field_range ↔ ∃ x, f x = y := iff.rfl
+
+end alg_hom
+
+namespace intermediate_field
+
 /-- The embedding from an intermediate field of `L / K` to `L`. -/
 def val : S →ₐ[K] L :=
 S.to_subalgebra.val
@@ -295,6 +352,11 @@ S.to_subalgebra.val
 lemma range_val : S.val.range = S.to_subalgebra :=
 S.to_subalgebra.range_val
 
+@[simp] lemma field_range_val : S.val.field_range = S :=
+set_like.ext' subtype.range_val
+
+instance alg_hom.inhabited : inhabited (S →ₐ[K] L) := ⟨S.val⟩
+
 lemma aeval_coe {R : Type*} [comm_ring R] [algebra R K] [algebra R L]
   [is_scalar_tower R K L] (x : S) (P : R[X]) : aeval (x : L) P = aeval x P :=
 begin
@@ -306,7 +368,7 @@ begin
 end
 
 lemma coe_is_integral_iff {R : Type*} [comm_ring R] [algebra R K] [algebra R L]
-  [is_scalar_tower R K L] {x : S} : is_integral R (x : L) ↔ _root_.is_integral R x :=
+  [is_scalar_tower R K L] {x : S} : is_integral R (x : L) ↔ is_integral R x :=
 begin
   refine ⟨λ h, _, λ h, _⟩,
   { obtain ⟨P, hPmo, hProot⟩ := h,
@@ -316,9 +378,30 @@ begin
       ← is_scalar_tower.algebra_map_eq, ← eval₂_eq_eval_map] },
   { obtain ⟨P, hPmo, hProot⟩ := h,
     refine ⟨P, hPmo, _⟩,
-    rw [← aeval_def, aeval_coe, aeval_def, hProot, add_submonoid_class.coe_zero] },
+    rw [← aeval_def, aeval_coe, aeval_def, hProot, zero_mem_class.coe_zero] },
 end
 
+/-- The map `E → F` when `E` is an intermediate field contained in the intermediate field `F`.
+
+This is the intermediate field version of `subalgebra.inclusion`. -/
+def inclusion {E F : intermediate_field K L} (hEF : E ≤ F) : E →ₐ[K] F :=
+subalgebra.inclusion hEF
+
+lemma inclusion_injective {E F : intermediate_field K L} (hEF : E ≤ F) :
+  function.injective (inclusion hEF) :=
+subalgebra.inclusion_injective hEF
+
+@[simp] lemma inclusion_self {E : intermediate_field K L}:
+  inclusion (le_refl E) = alg_hom.id K E :=
+subalgebra.inclusion_self
+
+@[simp] lemma inclusion_inclusion {E F G : intermediate_field K L} (hEF : E ≤ F) (hFG : F ≤ G)
+  (x : E) : inclusion hFG (inclusion hEF x) = inclusion (le_trans hEF hFG) x :=
+subalgebra.inclusion_inclusion hEF hFG x
+
+@[simp] lemma coe_inclusion {E F : intermediate_field K L} (hEF : E ≤ F) (e : E) :
+  (inclusion hEF e : L) = e := rfl
+
 variables {S}
 
 lemma to_subalgebra_injective {S S' : intermediate_field K L}
@@ -344,44 +427,46 @@ variables {S}
 section tower
 
 /-- Lift an intermediate_field of an intermediate_field -/
-def lift1 {F : intermediate_field K L} (E : intermediate_field K F) : intermediate_field K L :=
-  map E (val F)
+def lift {F : intermediate_field K L} (E : intermediate_field K F) : intermediate_field K L :=
+E.map (val F)
 
-/-- Lift an intermediate_field of an intermediate_field -/
-def lift2 {F : intermediate_field K L} (E : intermediate_field F L) : intermediate_field K L :=
+instance has_lift {F : intermediate_field K L} :
+  has_lift_t (intermediate_field K F) (intermediate_field K L) := ⟨lift⟩
+
+section restrict_scalars
+variables (K) [algebra L' L] [is_scalar_tower K L' L]
+
+/-- Given a tower `L / ↥E / L' / K` of field extensions, where `E` is an `L'`-intermediate field of
+`L`, reinterpret `E` as a `K`-intermediate field of `L`. -/
+def restrict_scalars (E : intermediate_field L' L) :
+  intermediate_field K L :=
 { carrier := E.carrier,
-  zero_mem' := zero_mem E,
-  add_mem' := λ x y (hx : x ∈ E), add_mem hx,
-  neg_mem' := λ x (hx : x ∈ E), neg_mem hx,
-  one_mem' := one_mem E,
-  mul_mem' := λ x y (hx : x ∈ E), mul_mem hx,
-  inv_mem' := λ x (hx : x ∈ E), inv_mem hx,
-  algebra_map_mem' := λ x, algebra_map_mem E (algebra_map K F x) }
+  ..E.to_subfield,
+  ..E.to_subalgebra.restrict_scalars K }
 
-instance has_lift1 {F : intermediate_field K L} :
-  has_lift_t (intermediate_field K F) (intermediate_field K L) := ⟨lift1⟩
+@[simp] lemma coe_restrict_scalars {E : intermediate_field L' L} :
+  (restrict_scalars K E : set L) = (E : set L) := rfl
 
-instance has_lift2 {F : intermediate_field K L} :
-  has_lift_t (intermediate_field F L) (intermediate_field K L) := ⟨lift2⟩
+@[simp] lemma restrict_scalars_to_subalgebra {E : intermediate_field L' L} :
+  (E.restrict_scalars K).to_subalgebra = E.to_subalgebra.restrict_scalars K :=
+set_like.coe_injective rfl
 
-@[simp] lemma mem_lift2 {F : intermediate_field K L} {E : intermediate_field F L} {x : L} :
-  x ∈ (↑E : intermediate_field K L) ↔ x ∈ E := iff.rfl
+@[simp] lemma restrict_scalars_to_subfield {E : intermediate_field L' L} :
+  (E.restrict_scalars K).to_subfield = E.to_subfield :=
+set_like.coe_injective rfl
 
-/-- This was formerly an instance called `lift2_alg`, but an instance above already provides it. -/
-example {F : intermediate_field K L} {E : intermediate_field F L} : algebra K E :=
-by apply_instance
+@[simp] lemma mem_restrict_scalars {E : intermediate_field L' L} {x : L} :
+  x ∈ restrict_scalars K E ↔ x ∈ E := iff.rfl
 
-lemma lift2_algebra_map {F : intermediate_field K L} {E : intermediate_field F L} :
-  algebra_map K E = (algebra_map F E).comp (algebra_map K F) := rfl
+lemma restrict_scalars_injective :
+  function.injective (restrict_scalars K : intermediate_field L' L → intermediate_field K L) :=
+λ U V H, ext $ λ x, by rw [← mem_restrict_scalars K, H, mem_restrict_scalars]
 
-instance lift2_tower {F : intermediate_field K L} {E : intermediate_field F L} :
-  is_scalar_tower K F E :=
-E.is_scalar_tower
+end restrict_scalars
 
-/-- `lift2` is isomorphic to the original `intermediate_field`. -/
-def lift2_alg_equiv {F : intermediate_field K L} (E : intermediate_field F L) :
-  (↑E : intermediate_field K L) ≃ₐ[K] E :=
-alg_equiv.refl
+/-- This was formerly an instance called `lift2_alg`, but an instance above already provides it. -/
+example {F : intermediate_field K L} {E : intermediate_field F L} : algebra K E :=
+by apply_instance
 
 end tower
 
@@ -390,12 +475,12 @@ section finite_dimensional
 variables (F E : intermediate_field K L)
 
 instance finite_dimensional_left [finite_dimensional K L] : finite_dimensional K F :=
-finite_dimensional.finite_dimensional_submodule F.to_subalgebra.to_submodule
+left K F L
 
 instance finite_dimensional_right [finite_dimensional K L] : finite_dimensional F L :=
 right K F L
 
-@[simp] lemma dim_eq_dim_subalgebra :
+@[simp] lemma rank_eq_rank_subalgebra :
   module.rank K F.to_subalgebra = module.rank K F := rfl
 
 @[simp] lemma finrank_eq_finrank_subalgebra :
@@ -408,7 +493,7 @@ by { rw [set_like.ext_iff, set_like.ext'_iff, set.ext_iff], refl }
 
 lemma eq_of_le_of_finrank_le [finite_dimensional K L] (h_le : F ≤ E)
   (h_finrank : finrank K E ≤ finrank K F) : F = E :=
-to_subalgebra_injective $ subalgebra.to_submodule_injective $ eq_of_le_of_finrank_le h_le h_finrank
+to_subalgebra_injective $ subalgebra.to_submodule.injective $ eq_of_le_of_finrank_le h_le h_finrank
 
 lemma eq_of_le_of_finrank_eq [finite_dimensional K L] (h_le : F ≤ E)
   (h_finrank : finrank K F = finrank K E) : F = E :=
@@ -430,6 +515,19 @@ eq_of_le_of_finrank_le' h_le h_finrank.le
 
 end finite_dimensional
 
+lemma is_algebraic_iff {x : S} : is_algebraic K x ↔ is_algebraic K (x : L) :=
+(is_algebraic_algebra_map_iff (algebra_map S L).injective).symm
+
+lemma is_integral_iff {x : S} : is_integral K x ↔ is_integral K (x : L) :=
+by rw [←is_algebraic_iff_is_integral, is_algebraic_iff, is_algebraic_iff_is_integral]
+
+lemma minpoly_eq (x : S) : minpoly K x = minpoly K (x : L) :=
+begin
+  by_cases hx : is_integral K x,
+  { exact minpoly.eq_of_algebra_map_eq (algebra_map S L).injective hx rfl },
+  { exact (minpoly.eq_zero hx).trans (minpoly.eq_zero (mt is_integral_iff.mpr hx)).symm },
+end
+
 end intermediate_field
 
 /-- If `L/K` is algebraic, the `K`-subalgebras of `L` are all fields.  -/
@@ -438,7 +536,7 @@ def subalgebra_equiv_intermediate_field (alg : algebra.is_algebraic K L) :
 { to_fun := λ S, S.to_intermediate_field (λ x hx, S.inv_mem_of_algebraic (alg (⟨x, hx⟩ : S))),
   inv_fun := λ S, S.to_subalgebra,
   left_inv := λ S, to_subalgebra_to_intermediate_field _ _,
-  right_inv := λ S, to_intermediate_field_to_subalgebra _ _,
+  right_inv := to_intermediate_field_to_subalgebra,
   map_rel_iff' := λ S S', iff.rfl }
 
 @[simp] lemma mem_subalgebra_equiv_intermediate_field (alg : algebra.is_algebraic K L)
diff --git a/src/field_theory/is_alg_closed/algebraic_closure.lean b/src/field_theory/is_alg_closed/algebraic_closure.lean
index 94f4671ff1e03..5aa7ca14f72f6 100644
--- a/src/field_theory/is_alg_closed/algebraic_closure.lean
+++ b/src/field_theory/is_alg_closed/algebraic_closure.lean
@@ -4,10 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 import algebra.direct_limit
+import algebra.char_p.algebra
 import field_theory.is_alg_closed.basic
+import field_theory.splitting_field.construction
+
 /-!
 # Algebraic Closure
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we construct the algebraic closure of a field
 
 ## Main Definitions
@@ -257,7 +263,7 @@ def of_step_hom (n) : step k n →ₐ[k] algebraic_closure k :=
 
 theorem is_algebraic : algebra.is_algebraic k (algebraic_closure k) :=
 λ z, is_algebraic_iff_is_integral.2 $ let ⟨n, x, hx⟩ := exists_of_step k z in
-hx ▸ is_integral_alg_hom (of_step_hom k n) (step.is_integral k n x)
+hx ▸ map_is_integral (of_step_hom k n) (step.is_integral k n x)
 
 instance : is_alg_closure k (algebraic_closure k) :=
 ⟨algebraic_closure.is_alg_closed k, is_algebraic k⟩
diff --git a/src/field_theory/is_alg_closed/basic.lean b/src/field_theory/is_alg_closed/basic.lean
index b7e2868f5099f..6c87fd98682f3 100644
--- a/src/field_theory/is_alg_closed/basic.lean
+++ b/src/field_theory/is_alg_closed/basic.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 
-import field_theory.splitting_field
+import field_theory.normal
 import field_theory.perfect_closure
-import field_theory.separable
+import ring_theory.localization.integral
 
 /-!
 # Algebraically Closed Field
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the typeclass for algebraically closed fields and algebraic closures,
 and prove some of their properties.
 
@@ -169,6 +172,19 @@ theorem is_alg_closure_iff (K : Type v) [field K] [algebra k K] :
   is_alg_closure k K ↔ is_alg_closed K ∧ algebra.is_algebraic k K :=
 ⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩
 
+@[priority 100]
+instance is_alg_closure.normal (R K : Type*) [field R] [field K] [algebra R K] [is_alg_closure R K]:
+  normal R K :=
+⟨is_alg_closure.algebraic, λ _,
+  @is_alg_closed.splits_codomain _ _ _ (is_alg_closure.alg_closed R) _ _ _⟩
+
+@[priority 100]
+instance is_alg_closure.separable (R K : Type*) [field R] [field K] [algebra R K]
+[is_alg_closure R K] [char_zero R] :
+  is_separable R K :=
+⟨λ _, is_algebraic_iff_is_integral.mp (is_alg_closure.algebraic _), λ _, (minpoly.irreducible
+  (is_algebraic_iff_is_integral.mp (is_alg_closure.algebraic _))).separable⟩
+
 namespace lift
 
 /- In this section, the homomorphism from any algebraic extension into an algebraically
@@ -317,15 +333,22 @@ variables {M}
 
 include hS
 
+private lemma fraction_ring.is_algebraic :
+  by letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R S).is_domain _; exact
+  algebra.is_algebraic (fraction_ring R) (fraction_ring S) :=
+begin
+  introsI inst x,
+  exact (is_fraction_ring.is_algebraic_iff R (fraction_ring R) (fraction_ring S)).1
+    ((is_fraction_ring.is_algebraic_iff' R S (fraction_ring S)).1 hS x)
+end
+
 /-- A (random) homomorphism from an algebraic extension of R into an algebraically
   closed extension of R. -/
-
 @[irreducible] noncomputable def lift : S →ₐ[R] M :=
 begin
   letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R S).is_domain _,
-  have hfRfS : algebra.is_algebraic (fraction_ring R) (fraction_ring S),
-    from λ x, (is_fraction_ring.is_algebraic_iff R (fraction_ring R) (fraction_ring S)).1
-      ((is_fraction_ring.is_algebraic_iff' R S (fraction_ring S)).1 hS x),
+  have hfRfS : algebra.is_algebraic (fraction_ring R) (fraction_ring S) :=
+    fraction_ring.is_algebraic hS,
   let f : fraction_ring S →ₐ[fraction_ring R] M :=
     lift_aux (fraction_ring R) (fraction_ring S) M hfRfS,
   exact (f.restrict_scalars R).comp ((algebra.of_id S (fraction_ring S)).restrict_scalars R),
@@ -335,13 +358,13 @@ omit hS
 @[priority 100]
 noncomputable instance perfect_ring (p : ℕ) [fact p.prime] [char_p k p]
   [is_alg_closed k] : perfect_ring k p :=
-perfect_ring.of_surjective k p $ λ x, is_alg_closed.exists_pow_nat_eq _ $ fact.out _
+perfect_ring.of_surjective k p $ λ x, is_alg_closed.exists_pow_nat_eq _ $ ne_zero.pos p
 
 /-- Algebraically closed fields are infinite since `Xⁿ⁺¹ - 1` is separable when `#K = n` -/
 @[priority 500]
 instance {K : Type*} [field K] [is_alg_closed K] : infinite K :=
 begin
-  apply infinite.mk,
+  apply infinite.of_not_fintype,
   introsI hfin,
   set n := fintype.card K with hn,
   set f := (X : K[X]) ^ (n + 1) - 1 with hf,
@@ -391,6 +414,10 @@ variables [algebra R S] [algebra R L] [is_scalar_tower R S L]
 variables [algebra K J] [algebra J L] [is_alg_closure J L] [algebra K L]
   [is_scalar_tower K J L]
 
+/-- If `J` is an algebraic extension of `K` and `L` is an algebraic closure of `J`, then it is
+  also an algebraic closure of `K`. -/
+lemma of_algebraic (hKJ : algebra.is_algebraic K J) : is_alg_closure K L :=
+⟨is_alg_closure.alg_closed J, algebra.is_algebraic_trans hKJ is_alg_closure.algebraic⟩
 
 /-- A (random) isomorphism between an algebraic closure of `R` and an algebraic closure of
   an algebraic extension of `R` -/
@@ -479,3 +506,26 @@ ring_hom.ext_iff.2 (equiv_of_equiv_symm_algebra_map L M hSR)
 end equiv_of_equiv
 
 end is_alg_closure
+
+/-- Let `A` be an algebraically closed field and let `x ∈ K`, with `K/F` an algebraic extension
+  of fields. Then the images of `x` by the `F`-algebra morphisms from `K` to `A` are exactly
+  the roots in `A` of the minimal polynomial of `x` over `F`. -/
+lemma algebra.is_algebraic.range_eval_eq_root_set_minpoly {F K} (A) [field F] [field K] [field A]
+  [is_alg_closed A] [algebra F K] (hK : algebra.is_algebraic F K) [algebra F A] (x : K) :
+  set.range (λ ψ : K →ₐ[F] A, ψ x) = (minpoly F x).root_set A :=
+begin
+  have := algebra.is_algebraic_iff_is_integral.1 hK,
+  ext a, rw [mem_root_set_of_ne (minpoly.ne_zero (this x))]; [skip, apply_instance],
+  refine ⟨_, λ ha, _⟩,
+  { rintro ⟨ψ, rfl⟩, rw [aeval_alg_hom_apply ψ x, minpoly.aeval, map_zero] },
+  let Fx := adjoin_root (minpoly F x),
+  have hx : aeval x (minpoly F x) = 0 := minpoly.aeval F x,
+  letI : algebra Fx A := (adjoin_root.lift (algebra_map F A) a ha).to_algebra,
+  letI : algebra Fx K := (adjoin_root.lift (algebra_map F K) x hx).to_algebra,
+  haveI : is_scalar_tower F Fx A := is_scalar_tower.of_ring_hom (adjoin_root.lift_hom _ a ha),
+  haveI : is_scalar_tower F Fx K := is_scalar_tower.of_ring_hom (adjoin_root.lift_hom _ x hx),
+  haveI : fact (irreducible $ minpoly F x) := ⟨minpoly.irreducible $ this x⟩,
+  let ψ₀ : K →ₐ[Fx] A := is_alg_closed.lift (algebra.is_algebraic_of_larger_base F Fx hK),
+  exact ⟨ψ₀.restrict_scalars F, (congr_arg ψ₀ (adjoin_root.lift_root hx).symm).trans $
+    (ψ₀.commutes _).trans $ adjoin_root.lift_root ha⟩,
+end
diff --git a/src/field_theory/is_alg_closed/classification.lean b/src/field_theory/is_alg_closed/classification.lean
index 0480bdd8de3b3..77d72392bc026 100644
--- a/src/field_theory/is_alg_closed/classification.lean
+++ b/src/field_theory/is_alg_closed/classification.lean
@@ -3,16 +3,17 @@ Copyright (c) 2022 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
-import data.W.cardinal
 import ring_theory.algebraic_independent
 import field_theory.is_alg_closed.basic
-import field_theory.intermediate_field
 import data.polynomial.cardinal
 import data.mv_polynomial.cardinal
 import data.zmod.algebra
 /-!
 # Classification of Algebraically closed fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains results related to classifying algebraically closed fields.
 
 ## Main statements
@@ -55,24 +56,19 @@ lemma cardinal_mk_le_sigma_polynomial :
   end)
 
 /--The cardinality of an algebraic extension is at most the maximum of the cardinality
-of the base ring or `ω` -/
-lemma cardinal_mk_le_max : #L ≤ max (#R) ω :=
+of the base ring or `ℵ₀` -/
+lemma cardinal_mk_le_max : #L ≤ max (#R) ℵ₀ :=
 calc #L ≤ #(Σ p : R[X], { x : L // x ∈ (p.map (algebra_map R L)).roots }) :
   cardinal_mk_le_sigma_polynomial R L halg
 ... = cardinal.sum (λ p : R[X], #{ x : L | x ∈ (p.map (algebra_map R L)).roots }) :
   by rw ← mk_sigma; refl
-... ≤ cardinal.sum.{u u} (λ p : R[X], ω) : sum_le_sum _ _
-  (λ p, le_of_lt begin
-    rw [lt_omega_iff_finite],
-    classical,
-    simp only [← @multiset.mem_to_finset _ _ _ (p.map (algebra_map R L)).roots],
-    exact set.finite_mem_finset _,
-  end)
-... = #R[X] * ω : sum_const' _ _
-... ≤ max (max (#R[X]) ω) ω : mul_le_max _ _
-... ≤ max (max (max (#R) ω) ω) ω :
+... ≤ cardinal.sum.{u u} (λ p : R[X], ℵ₀) :
+  sum_le_sum _ _ $ λ p, (multiset.finite_to_set _).lt_aleph_0.le
+... = #R[X] * ℵ₀ : sum_const' _ _
+... ≤ max (max (#R[X]) ℵ₀) ℵ₀ : mul_le_max _ _
+... ≤ max (max (max (#R) ℵ₀) ℵ₀) ℵ₀ :
   max_le_max (max_le_max polynomial.cardinal_mk_le_max le_rfl) le_rfl
-... = max (#R) ω : by simp only [max_assoc, max_comm omega.{u}, max_left_comm omega.{u}, max_self]
+... = max (#R) ℵ₀ : by simp only [max_assoc, max_comm ℵ₀, max_left_comm ℵ₀, max_self]
 
 end algebra.is_algebraic
 
@@ -130,25 +126,25 @@ variables {ι : Type u} (v : ι → K)
 variable (hv : is_transcendence_basis R v)
 
 lemma cardinal_le_max_transcendence_basis (hv : is_transcendence_basis R v) :
-  #K ≤ max (max (#R) (#ι)) ω :=
-calc #K ≤ max (#(algebra.adjoin R (set.range v))) ω :
+  #K ≤ max (max (#R) (#ι)) ℵ₀ :=
+calc #K ≤ max (#(algebra.adjoin R (set.range v))) ℵ₀ :
   by letI := is_alg_closure_of_transcendence_basis v hv;
    exact algebra.is_algebraic.cardinal_mk_le_max _ _ is_alg_closure.algebraic
-... = max (#(mv_polynomial ι R)) ω : by rw [cardinal.eq.2 ⟨(hv.1.aeval_equiv).to_equiv⟩]
-... ≤ max (max (max (#R) (#ι)) ω) ω : max_le_max mv_polynomial.cardinal_mk_le_max le_rfl
+... = max (#(mv_polynomial ι R)) ℵ₀ : by rw [cardinal.eq.2 ⟨(hv.1.aeval_equiv).to_equiv⟩]
+... ≤ max (max (max (#R) (#ι)) ℵ₀) ℵ₀ : max_le_max mv_polynomial.cardinal_mk_le_max le_rfl
 ... = _ : by simp [max_assoc]
 
 /-- If `K` is an uncountable algebraically closed field, then its
 cardinality is the same as that of a transcendence basis. -/
-lemma cardinal_eq_cardinal_transcendence_basis_of_omega_lt [nontrivial R]
-  (hv : is_transcendence_basis R v) (hR : #R ≤ ω) (hK : ω < #K) : #K = #ι :=
-have ω ≤ #ι,
+lemma cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt [nontrivial R]
+  (hv : is_transcendence_basis R v) (hR : #R ≤ ℵ₀) (hK : ℵ₀ < #K) : #K = #ι :=
+have ℵ₀ ≤ #ι,
   from le_of_not_lt (λ h,
     not_le_of_gt hK $ calc
-      #K ≤ max (max (#R) (#ι)) ω : cardinal_le_max_transcendence_basis v hv
+      #K ≤ max (max (#R) (#ι)) ℵ₀ : cardinal_le_max_transcendence_basis v hv
      ... ≤ _ : max_le (max_le hR (le_of_lt h)) le_rfl),
 le_antisymm
-  (calc #K ≤ max (max (#R) (#ι)) ω : cardinal_le_max_transcendence_basis v hv
+  (calc #K ≤ max (max (#R) (#ι)) ℵ₀ : cardinal_le_max_transcendence_basis v hv
        ... = #ι : begin
          rw [max_eq_left, max_eq_right],
          { exact le_trans hR this },
@@ -162,10 +158,9 @@ variables {K L : Type} [field K] [field L] [is_alg_closed K] [is_alg_closed L]
 
 /-- Two uncountable algebraically closed fields of characteristic zero are isomorphic
 if they have the same cardinality. -/
-@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_zero [char_zero K] [char_zero L]
-  (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
+lemma ring_equiv_of_cardinal_eq_of_char_zero [char_zero K] [char_zero L]
+  (hK : ℵ₀ < #K) (hKL : #K = #L) : nonempty (K ≃+* L) :=
 begin
-  apply classical.choice,
   cases exists_is_transcendence_basis ℤ
     (show function.injective (algebra_map ℤ K),
       from int.cast_injective) with s hs,
@@ -173,17 +168,18 @@ begin
     (show function.injective (algebra_map ℤ L),
       from int.cast_injective) with t ht,
   have : #s = #t,
-  { rw [← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ hs (le_of_eq mk_int) hK,
-        ← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ ht (le_of_eq mk_int), hKL],
+  { rw [← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ hs (le_of_eq mk_int) hK,
+        ← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ ht (le_of_eq mk_int), hKL],
     rwa ← hKL },
   cases cardinal.eq.1 this with e,
   exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
 end
 
 private lemma ring_equiv_of_cardinal_eq_of_char_p (p : ℕ) [fact p.prime]
-  [char_p K p] [char_p L p] (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
+  [char_p K p] [char_p L p] (hK : ℵ₀ < #K) (hKL : #K = #L) : nonempty (K ≃+* L) :=
 begin
-  apply classical.choice,
+  letI : algebra (zmod p) K := zmod.algebra _ _,
+  letI : algebra (zmod p) L := zmod.algebra _ _,
   cases exists_is_transcendence_basis (zmod p)
     (show function.injective (algebra_map (zmod p) K),
       from ring_hom.injective _) with s hs,
@@ -191,10 +187,10 @@ begin
     (show function.injective (algebra_map (zmod p) L),
       from ring_hom.injective _) with t ht,
   have : #s = #t,
-  { rw [← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ hs
-      (lt_omega_of_fintype (zmod p)).le hK,
-        ← cardinal_eq_cardinal_transcendence_basis_of_omega_lt _ ht
-      (lt_omega_of_fintype (zmod p)).le, hKL],
+  { rw [← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ hs
+      (lt_aleph_0_of_finite (zmod p)).le hK,
+        ← cardinal_eq_cardinal_transcendence_basis_of_aleph_0_lt _ ht
+      (lt_aleph_0_of_finite (zmod p)).le, hKL],
     rwa ← hKL },
   cases cardinal.eq.1 this with e,
   exact ⟨equiv_of_transcendence_basis _ _ e hs ht⟩
@@ -202,18 +198,19 @@ end
 
 /-- Two uncountable algebraically closed fields are isomorphic
 if they have the same cardinality and the same characteristic. -/
-@[nolint def_lemma] lemma ring_equiv_of_cardinal_eq_of_char_eq (p : ℕ) [char_p K p] [char_p L p]
-  (hK : ω < #K) (hKL : #K = #L) : K ≃+* L :=
+lemma ring_equiv_of_cardinal_eq_of_char_eq (p : ℕ) [char_p K p] [char_p L p]
+  (hK : ℵ₀ < #K) (hKL : #K = #L) : nonempty (K ≃+* L) :=
 begin
-  apply classical.choice,
   rcases char_p.char_is_prime_or_zero K p with hp | hp,
   { haveI : fact p.prime := ⟨hp⟩,
-    exact ⟨ring_equiv_of_cardinal_eq_of_char_p p hK hKL⟩ },
+    letI : algebra (zmod p) K := zmod.algebra _ _,
+    letI : algebra (zmod p) L := zmod.algebra _ _,
+    exact ring_equiv_of_cardinal_eq_of_char_p p hK hKL },
   { rw [hp] at *,
     resetI,
     letI : char_zero K := char_p.char_p_to_char_zero K,
     letI : char_zero L := char_p.char_p_to_char_zero L,
-    exact ⟨ring_equiv_of_cardinal_eq_of_char_zero hK hKL⟩ }
+    exact ring_equiv_of_cardinal_eq_of_char_zero hK hKL }
 end
 
 end is_alg_closed
diff --git a/src/field_theory/is_alg_closed/spectrum.lean b/src/field_theory/is_alg_closed/spectrum.lean
new file mode 100644
index 0000000000000..8747b3ccb009f
--- /dev/null
+++ b/src/field_theory/is_alg_closed/spectrum.lean
@@ -0,0 +1,166 @@
+/-
+Copyright (c) 2021 Jireh Loreaux. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jireh Loreaux
+-/
+import algebra.algebra.spectrum
+import field_theory.is_alg_closed.basic
+
+/-!
+# Spectrum mapping theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file develops proves the spectral mapping theorem for polynomials over algebraically closed
+fields. In particular, if `a` is an element of an `𝕜`-algebra `A` where `𝕜` is a field, and
+`p : 𝕜[X]` is a polynomial, then the spectrum of `polynomial.aeval a p` contains the image of the
+spectrum of `a` under `(λ k, polynomial.eval k p)`. When `𝕜` is algebraically closed, these are in
+fact equal (assuming either that the spectrum of `a` is nonempty or the polynomial has positive
+degree), which is the **spectral mapping theorem**.
+
+In addition, this file contains the fact that every element of a finite dimensional nontrivial
+algebra over an algebraically closed field has nonempty spectrum. In particular, this is used in
+`module.End.exists_eigenvalue` to show that every linear map from a vector space to itself has an
+eigenvalue.
+
+## Main statements
+
+* `spectrum.subset_polynomial_aeval`, `spectrum.map_polynomial_aeval_of_degree_pos`,
+  `spectrum.map_polynomial_aeval_of_nonempty`: variations on the **spectral mapping theorem**.
+* `spectrum.nonempty_of_is_alg_closed_of_finite_dimensional`: the spectrum is nonempty for any
+  element of a nontrivial finite dimensional algebra over an algebraically closed field.
+
+## Notations
+
+* `σ a` : `spectrum R a` of `a : A`
+-/
+
+namespace spectrum
+
+open set polynomial
+open_locale pointwise polynomial
+
+universes u v
+
+section scalar_ring
+
+variables {R : Type u} {A : Type v}
+variables [comm_ring R] [ring A] [algebra R A]
+
+local notation `σ` := spectrum R
+local notation `↑ₐ` := algebra_map R A
+
+lemma exists_mem_of_not_is_unit_aeval_prod [is_domain R] {p : R[X]} {a : A} (hp : p ≠ 0)
+  (h : ¬is_unit (aeval a (multiset.map (λ (x : R), X - C x) p.roots).prod)) :
+  ∃ k : R, k ∈ σ a ∧ eval k p = 0 :=
+begin
+  rw [←multiset.prod_to_list, alg_hom.map_list_prod] at h,
+  replace h := mt list.prod_is_unit h,
+  simp only [not_forall, exists_prop, aeval_C, multiset.mem_to_list,
+    list.mem_map, aeval_X, exists_exists_and_eq_and, multiset.mem_map, alg_hom.map_sub] at h,
+  rcases h with ⟨r, r_mem, r_nu⟩,
+  exact ⟨r, by rwa [mem_iff, ←is_unit.sub_iff], by rwa [←is_root.def, ←mem_roots hp]⟩
+end
+
+end scalar_ring
+
+section scalar_field
+
+variables {𝕜 : Type u} {A : Type v}
+variables [field 𝕜] [ring A] [algebra 𝕜 A]
+
+local notation `σ` := spectrum 𝕜
+local notation `↑ₐ` := algebra_map 𝕜 A
+
+open polynomial
+/-- Half of the spectral mapping theorem for polynomials. We prove it separately
+because it holds over any field, whereas `spectrum.map_polynomial_aeval_of_degree_pos` and
+`spectrum.map_polynomial_aeval_of_nonempty` need the field to be algebraically closed. -/
+theorem subset_polynomial_aeval (a : A) (p : 𝕜[X]) :
+  (λ k, eval k p) '' (σ a) ⊆ σ (aeval a p) :=
+begin
+  rintros _ ⟨k, hk, rfl⟩,
+  let q := C (eval k p) - p,
+  have hroot : is_root q k, by simp only [eval_C, eval_sub, sub_self, is_root.def],
+  rw [←mul_div_eq_iff_is_root, ←neg_mul_neg, neg_sub] at hroot,
+  have aeval_q_eq : ↑ₐ(eval k p) - aeval a p = aeval a q,
+    by simp only [aeval_C, alg_hom.map_sub, sub_left_inj],
+  rw [mem_iff, aeval_q_eq, ←hroot, aeval_mul],
+  have hcomm := (commute.all (C k - X) (- (q / (X - C k)))).map (aeval a),
+  apply mt (λ h, (hcomm.is_unit_mul_iff.mp h).1),
+  simpa only [aeval_X, aeval_C, alg_hom.map_sub] using hk,
+end
+
+/-- The *spectral mapping theorem* for polynomials.  Note: the assumption `degree p > 0`
+is necessary in case `σ a = ∅`, for then the left-hand side is `∅` and the right-hand side,
+assuming `[nontrivial A]`, is `{k}` where `p = polynomial.C k`. -/
+theorem map_polynomial_aeval_of_degree_pos [is_alg_closed 𝕜] (a : A) (p : 𝕜[X])
+  (hdeg : 0 < degree p) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
+begin
+  /- handle the easy direction via `spectrum.subset_polynomial_aeval` -/
+  refine set.eq_of_subset_of_subset (λ k hk, _) (subset_polynomial_aeval a p),
+  /- write `C k - p` product of linear factors and a constant; show `C k - p ≠ 0`. -/
+  have hprod := eq_prod_roots_of_splits_id (is_alg_closed.splits (C k - p)),
+  have h_ne : C k - p ≠ 0, from ne_zero_of_degree_gt
+    (by rwa [degree_sub_eq_right_of_degree_lt (lt_of_le_of_lt degree_C_le hdeg)]),
+  have lead_ne := leading_coeff_ne_zero.mpr h_ne,
+  have lead_unit := (units.map (↑ₐ).to_monoid_hom (units.mk0 _ lead_ne)).is_unit,
+  /- leading coefficient is a unit so product of linear factors is not a unit;
+  apply `exists_mem_of_not_is_unit_aeval_prod`. -/
+  have p_a_eq : aeval a (C k - p) = ↑ₐk - aeval a p,
+    by simp only [aeval_C, alg_hom.map_sub, sub_left_inj],
+  rw [mem_iff, ←p_a_eq, hprod, aeval_mul,
+    ((commute.all _ _).map (aeval a)).is_unit_mul_iff, aeval_C] at hk,
+  replace hk := exists_mem_of_not_is_unit_aeval_prod h_ne (not_and.mp hk lead_unit),
+  rcases hk with ⟨r, r_mem, r_ev⟩,
+  exact ⟨r, r_mem, symm (by simpa [eval_sub, eval_C, sub_eq_zero] using r_ev)⟩,
+end
+
+/-- In this version of the spectral mapping theorem, we assume the spectrum
+is nonempty instead of assuming the degree of the polynomial is positive. -/
+theorem map_polynomial_aeval_of_nonempty [is_alg_closed 𝕜] (a : A) (p : 𝕜[X])
+  (hnon : (σ a).nonempty) : σ (aeval a p) = (λ k, eval k p) '' (σ a) :=
+begin
+  nontriviality A,
+  refine or.elim (le_or_gt (degree p) 0) (λ h, _) (map_polynomial_aeval_of_degree_pos a p),
+  { rw eq_C_of_degree_le_zero h,
+    simp only [set.image_congr, eval_C, aeval_C, scalar_eq, set.nonempty.image_const hnon] },
+end
+
+/-- A specialization of `spectrum.subset_polynomial_aeval` to monic monomials for convenience. -/
+lemma pow_image_subset (a : A) (n : ℕ) : (λ x, x ^ n) '' (σ a) ⊆ σ (a ^ n) :=
+by simpa only [eval_pow, eval_X, aeval_X_pow] using subset_polynomial_aeval a (X ^ n : 𝕜[X])
+
+/-- A specialization of `spectrum.map_polynomial_aeval_of_nonempty` to monic monomials for
+convenience. -/
+lemma map_pow_of_pos [is_alg_closed 𝕜] (a : A) {n : ℕ} (hn : 0 < n) :
+  σ (a ^ n) = (λ x, x ^ n) '' (σ a) :=
+by simpa only [aeval_X_pow, eval_pow, eval_X] using
+  map_polynomial_aeval_of_degree_pos a (X ^ n : 𝕜[X]) (by { rw_mod_cast degree_X_pow, exact hn })
+
+/-- A specialization of `spectrum.map_polynomial_aeval_of_nonempty` to monic monomials for
+convenience. -/
+lemma map_pow_of_nonempty [is_alg_closed 𝕜] {a : A} (ha : (σ a).nonempty) (n : ℕ) :
+  σ (a ^ n) = (λ x, x ^ n) '' (σ a) :=
+by simpa only [aeval_X_pow, eval_pow, eval_X] using map_polynomial_aeval_of_nonempty a (X ^ n) ha
+
+variable (𝕜)
+/--
+Every element `a` in a nontrivial finite-dimensional algebra `A`
+over an algebraically closed field `𝕜` has non-empty spectrum. -/
+-- We will use this both to show eigenvalues exist, and to prove Schur's lemma.
+lemma nonempty_of_is_alg_closed_of_finite_dimensional [is_alg_closed 𝕜]
+  [nontrivial A] [I : finite_dimensional 𝕜 A] (a : A) :
+  (σ a).nonempty :=
+begin
+  obtain ⟨p, ⟨h_mon, h_eval_p⟩⟩ := is_integral_of_noetherian (is_noetherian.iff_fg.2 I) a,
+  have nu : ¬ is_unit (aeval a p), { rw [←aeval_def] at h_eval_p, rw h_eval_p, simp, },
+  rw [eq_prod_roots_of_monic_of_splits_id h_mon (is_alg_closed.splits p)] at nu,
+  obtain ⟨k, hk, _⟩ := exists_mem_of_not_is_unit_aeval_prod (monic.ne_zero h_mon) nu,
+  exact ⟨k, hk⟩
+end
+
+end scalar_field
+
+end spectrum
diff --git a/src/field_theory/krull_topology.lean b/src/field_theory/krull_topology.lean
index 541542daa033f..03894aa273074 100644
--- a/src/field_theory/krull_topology.lean
+++ b/src/field_theory/krull_topology.lean
@@ -12,6 +12,9 @@ import tactic.by_contra
 /-!
 # Krull topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the Krull topology on `L ≃ₐ[K] L` for an arbitrary field extension `L/K`. In order to do
 this, we first define a `group_filter_basis` on `L ≃ₐ[K] L`, whose sets are `E.fixing_subgroup` for
 all intermediate fields `E` with `E/K` finite dimensional.
@@ -88,7 +91,7 @@ intermediate_field.fixing_subgroup '' (finite_exts K L)
 /-- For an field extension `L/K`, the intermediate field `K` is finite-dimensional over `K` -/
 lemma intermediate_field.finite_dimensional_bot (K L : Type*) [field K]
   [field L] [algebra K L] : finite_dimensional K (⊥ : intermediate_field K L) :=
-finite_dimensional_of_dim_eq_one intermediate_field.dim_bot
+finite_dimensional_of_rank_eq_one intermediate_field.rank_bot
 
 /-- This lemma says that `Gal(L/K) = L ≃ₐ[K] L` -/
 lemma intermediate_field.fixing_subgroup.bot {K L : Type*} [field K]
@@ -163,7 +166,7 @@ def gal_group_basis (K L : Type*) [field K] [field L] [algebra K L] :
   end⟩,
   inv' := λ U hU, ⟨U, hU, begin
     rcases hU with ⟨H, hH, rfl⟩,
-    exact H.inv_mem',
+    exact λ _, H.inv_mem',
   end⟩,
   conj' :=
   begin
@@ -176,13 +179,13 @@ def gal_group_basis (K L : Type*) [field K] [field L] [algebra K L] :
     change σ * g * σ⁻¹ ∈ E.fixing_subgroup,
     rw intermediate_field.mem_fixing_subgroup_iff,
     intros x hx,
-    change σ(g(σ⁻¹ x)) = x,
+    change σ (g (σ⁻¹ x)) = x,
     have h_in_F : σ⁻¹ x ∈ F := ⟨x, hx, by {dsimp, rw ← alg_equiv.inv_fun_eq_symm, refl }⟩,
-    have h_g_fix : g (σ⁻¹ x) = (σ⁻¹ x),
+    have h_g_fix : g (σ⁻¹ x) = σ⁻¹ x,
     { rw [subgroup.mem_carrier, intermediate_field.mem_fixing_subgroup_iff F g] at hg,
       exact hg (σ⁻¹ x) h_in_F },
     rw h_g_fix,
-    change σ(σ⁻¹ x) = x,
+    change σ (σ⁻¹ x) = x,
     exact alg_equiv.apply_symm_apply σ x,
   end }
 
@@ -199,7 +202,7 @@ group_filter_basis.is_topological_group (gal_group_basis K L)
 
 section krull_t2
 
-open_locale topological_space filter
+open_locale topology filter
 
 /-- Let `L/E/K` be a tower of fields with `E/K` finite. Then `Gal(L/E)` is an open subgroup of
   `L ≃ₐ[K] L`. -/
@@ -208,11 +211,9 @@ lemma intermediate_field.fixing_subgroup_is_open {K L : Type*} [field K] [field
   is_open (E.fixing_subgroup : set (L ≃ₐ[K] L)) :=
 begin
   have h_basis : E.fixing_subgroup.carrier ∈ (gal_group_basis K L) :=
-   ⟨E.fixing_subgroup, ⟨E, _inst_4, rfl⟩, rfl⟩,
+   ⟨E.fixing_subgroup, ⟨E, ‹_›, rfl⟩, rfl⟩,
   have h_nhd := group_filter_basis.mem_nhds_one (gal_group_basis K L) h_basis,
-  rw mem_nhds_iff at h_nhd,
-  rcases h_nhd with ⟨U, hU_le, hU_open, h1U⟩,
-  exact subgroup.is_open_of_one_mem_interior ⟨U, ⟨hU_open, hU_le⟩, h1U⟩,
+  exact subgroup.is_open_of_mem_nhds _ h_nhd
 end
 
 /-- Given a tower of fields `L/E/K`, with `E/K` finite, the subgroup `Gal(L/E) ≤ L ≃ₐ[K] L` is
@@ -244,12 +245,8 @@ lemma krull_topology_t2 {K L : Type*} [field K] [field L] [algebra K L]
     rcases h_nhd with ⟨W, hWH, hW_open, hW_1⟩,
     refine ⟨left_coset f W, left_coset g W,
       ⟨hW_open.left_coset f, hW_open.left_coset g, ⟨1, hW_1, mul_one _⟩, ⟨1, hW_1, mul_one _⟩, _⟩⟩,
-    by_contra h_nonempty,
-    change left_coset f W ∩ left_coset g W ≠ ∅ at h_nonempty,
-    rw set.ne_empty_iff_nonempty at h_nonempty,
-    rcases h_nonempty with ⟨σ, ⟨⟨w1, hw1, hfw1⟩, ⟨w2, hw2, hgw2⟩⟩⟩,
-    rw ← hgw2 at hfw1,
-    rename hfw1 h,
+    rw set.disjoint_left,
+    rintro σ ⟨w1, hw1, h⟩ ⟨w2, hw2, rfl⟩,
     rw [eq_inv_mul_iff_mul_eq.symm, ← mul_assoc, mul_inv_eq_iff_eq_mul.symm] at h,
     have h_in_H : w1 * w2⁻¹ ∈ H := H.mul_mem (hWH hw1) (H.inv_mem (hWH hw2)),
     rw h at h_in_H,
@@ -280,7 +277,7 @@ begin
   haveI := intermediate_field.adjoin.finite_dimensional (h_int x),
   refine ⟨left_coset σ E.fixing_subgroup,
     ⟨E.fixing_subgroup_is_open.left_coset σ, E.fixing_subgroup_is_closed.left_coset σ⟩,
-    ⟨1, E.fixing_subgroup.one_mem', by simp⟩, _⟩,
+    ⟨1, E.fixing_subgroup.one_mem', mul_one σ⟩, _⟩,
   simp only [mem_left_coset_iff, set_like.mem_coe, intermediate_field.mem_fixing_subgroup_iff,
     not_forall],
   exact ⟨x, intermediate_field.mem_adjoin_simple_self K x, hx⟩,
diff --git a/src/field_theory/laurent.lean b/src/field_theory/laurent.lean
index ac3f52e1a6b89..2e39eea2aeab5 100644
--- a/src/field_theory/laurent.lean
+++ b/src/field_theory/laurent.lean
@@ -6,11 +6,13 @@ Authors: Yakov Pechersky
 
 import data.polynomial.taylor
 import field_theory.ratfunc
-import ring_theory.laurent_series
 
 /-!
 # Laurent expansions of rational functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main declarations
 
 * `ratfunc.laurent`: the Laurent expansion of the rational function `f` at `r`, as an `alg_hom`.
diff --git a/src/field_theory/minpoly.lean b/src/field_theory/minpoly.lean
deleted file mode 100644
index bbb19173ee18d..0000000000000
--- a/src/field_theory/minpoly.lean
+++ /dev/null
@@ -1,490 +0,0 @@
-/-
-Copyright (c) 2019 Chris Hughes. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Chris Hughes, Johan Commelin
--/
-import data.polynomial.field_division
-import ring_theory.integral_closure
-import ring_theory.polynomial.gauss_lemma
-
-/-!
-# Minimal polynomials
-
-This file defines the minimal polynomial of an element `x` of an `A`-algebra `B`,
-under the assumption that x is integral over `A`.
-
-After stating the defining property we specialize to the setting of field extensions
-and derive some well-known properties, amongst which the fact that minimal polynomials
-are irreducible, and uniquely determined by their defining property.
-
--/
-
-open_locale classical polynomial
-open polynomial set function
-
-variables {A B : Type*}
-
-section min_poly_def
-variables (A) [comm_ring A] [ring B] [algebra A B]
-
-/--
-Suppose `x : B`, where `B` is an `A`-algebra.
-
-The minimal polynomial `minpoly A x` of `x`
-is a monic polynomial with coefficients in `A` of smallest degree that has `x` as its root,
-if such exists (`is_integral A x`) or zero otherwise.
-
-For example, if `V` is a `𝕜`-vector space for some field `𝕜` and `f : V →ₗ[𝕜] V` then
-the minimal polynomial of `f` is `minpoly 𝕜 f`.
--/
-noncomputable def minpoly (x : B) : A[X] :=
-if hx : is_integral A x then well_founded.min degree_lt_wf _ hx else 0
-
-end min_poly_def
-
-namespace minpoly
-
-section ring
-variables [comm_ring A] [ring B] [algebra A B]
-variables {x : B}
-
-/-- A minimal polynomial is monic. -/
-lemma monic (hx : is_integral A x) : monic (minpoly A x) :=
-by { delta minpoly, rw dif_pos hx, exact (well_founded.min_mem degree_lt_wf _ hx).1 }
-
-/-- A minimal polynomial is nonzero. -/
-lemma ne_zero [nontrivial A] (hx : is_integral A x) : minpoly A x ≠ 0 :=
-(monic hx).ne_zero
-
-lemma eq_zero (hx : ¬ is_integral A x) : minpoly A x = 0 :=
-dif_neg hx
-
-variables (A x)
-
-/-- An element is a root of its minimal polynomial. -/
-@[simp] lemma aeval : aeval x (minpoly A x) = 0 :=
-begin
-  delta minpoly, split_ifs with hx,
-  { exact (well_founded.min_mem degree_lt_wf _ hx).2 },
-  { exact aeval_zero _ }
-end
-
-/-- A minimal polynomial is not `1`. -/
-lemma ne_one [nontrivial B] : minpoly A x ≠ 1 :=
-begin
-  intro h,
-  refine (one_ne_zero : (1 : B) ≠ 0) _,
-  simpa using congr_arg (polynomial.aeval x) h
-end
-
-lemma map_ne_one [nontrivial B] {R : Type*} [semiring R] [nontrivial R] (f : A →+* R) :
-  (minpoly A x).map f ≠ 1 :=
-begin
-  by_cases hx : is_integral A x,
-  { exact mt ((monic hx).eq_one_of_map_eq_one f) (ne_one A x) },
-  { rw [eq_zero hx, polynomial.map_zero], exact zero_ne_one },
-end
-
-/-- A minimal polynomial is not a unit. -/
-lemma not_is_unit [nontrivial B] : ¬ is_unit (minpoly A x) :=
-begin
-  haveI : nontrivial A := (algebra_map A B).domain_nontrivial,
-  by_cases hx : is_integral A x,
-  { exact mt (eq_one_of_is_unit_of_monic (monic hx)) (ne_one A x) },
-  { rw [eq_zero hx], exact not_is_unit_zero }
-end
-
-lemma mem_range_of_degree_eq_one (hx : (minpoly A x).degree = 1) : x ∈ (algebra_map A B).range :=
-begin
-  have h : is_integral A x,
-  { by_contra h,
-    rw [eq_zero h, degree_zero, ←with_bot.coe_one] at hx,
-    exact (ne_of_lt (show ⊥ < ↑1, from with_bot.bot_lt_coe 1) hx) },
-  have key := minpoly.aeval A x,
-  rw [eq_X_add_C_of_degree_eq_one hx, (minpoly.monic h).leading_coeff, C_1, one_mul, aeval_add,
-      aeval_C, aeval_X, ←eq_neg_iff_add_eq_zero, ←ring_hom.map_neg] at key,
-  exact ⟨-(minpoly A x).coeff 0, key.symm⟩,
-end
-
-/-- The defining property of the minimal polynomial of an element `x`:
-it is the monic polynomial with smallest degree that has `x` as its root. -/
-lemma min {p : A[X]} (pmonic : p.monic) (hp : polynomial.aeval x p = 0) :
-  degree (minpoly A x) ≤ degree p :=
-begin
-  delta minpoly, split_ifs with hx,
-  { exact le_of_not_lt (well_founded.not_lt_min degree_lt_wf _ hx ⟨pmonic, hp⟩) },
-  { simp only [degree_zero, bot_le] }
-end
-
-@[nontriviality] lemma subsingleton [subsingleton B] : minpoly A x = 1 :=
-begin
-  nontriviality A,
-  have := minpoly.min A x monic_one (subsingleton.elim _ _),
-  rw degree_one at this,
-  cases le_or_lt (minpoly A x).degree 0 with h h,
-  { rwa (monic ⟨1, monic_one, by simp⟩ : (minpoly A x).monic).degree_le_zero_iff_eq_one at h },
-  { exact (this.not_lt h).elim },
-end
-
-end ring
-
-section comm_ring
-
-variables [comm_ring A]
-
-section ring
-
-variables [ring B] [algebra A B] [nontrivial B]
-variables {x : B}
-
-/-- The degree of a minimal polynomial, as a natural number, is positive. -/
-lemma nat_degree_pos (hx : is_integral A x) : 0 < nat_degree (minpoly A x) :=
-begin
-  rw pos_iff_ne_zero,
-  intro ndeg_eq_zero,
-  have eq_one : minpoly A x = 1,
-  { rw eq_C_of_nat_degree_eq_zero ndeg_eq_zero, convert C_1,
-    simpa only [ndeg_eq_zero.symm] using (monic hx).leading_coeff },
-  simpa only [eq_one, alg_hom.map_one, one_ne_zero] using aeval A x
-end
-
-/-- The degree of a minimal polynomial is positive. -/
-lemma degree_pos (hx : is_integral A x) : 0 < degree (minpoly A x) :=
-nat_degree_pos_iff_degree_pos.mp (nat_degree_pos hx)
-
-/-- If `B/A` is an injective ring extension, and `a` is an element of `A`,
-then the minimal polynomial of `algebra_map A B a` is `X - C a`. -/
-lemma eq_X_sub_C_of_algebra_map_inj
-  (a : A) (hf : function.injective (algebra_map A B)) :
-  minpoly A (algebra_map A B a) = X - C a :=
-begin
-  nontriviality A,
-  have hdegle : (minpoly A (algebra_map A B a)).nat_degree ≤ 1,
-  { apply with_bot.coe_le_coe.1,
-    rw [←degree_eq_nat_degree (ne_zero (@is_integral_algebra_map A B _ _ _ a)),
-      with_top.coe_one, ←degree_X_sub_C a],
-    refine min A (algebra_map A B a) (monic_X_sub_C a) _,
-    simp only [aeval_C, aeval_X, alg_hom.map_sub, sub_self] },
-  have hdeg : (minpoly A (algebra_map A B a)).degree = 1,
-  { apply (degree_eq_iff_nat_degree_eq (ne_zero (@is_integral_algebra_map A B _ _ _ a))).2,
-    apply le_antisymm hdegle (nat_degree_pos (@is_integral_algebra_map A B _ _ _ a)) },
-  have hrw := eq_X_add_C_of_degree_eq_one hdeg,
-  simp only [monic (@is_integral_algebra_map A B _ _ _ a), one_mul,
-    monic.leading_coeff, ring_hom.map_one] at hrw,
-  have h0 : (minpoly A (algebra_map A B a)).coeff 0 = -a,
-  { have hroot := aeval A (algebra_map A B a),
-    rw [hrw, add_comm] at hroot,
-    simp only [aeval_C, aeval_X, aeval_add] at hroot,
-    replace hroot := eq_neg_of_add_eq_zero hroot,
-    rw [←ring_hom.map_neg _ a] at hroot,
-    exact (hf hroot) },
-  rw hrw,
-  simp only [h0, ring_hom.map_neg, sub_eq_add_neg],
-end
-
-end ring
-
-section is_domain
-
-variables [is_domain A] [ring B] [algebra A B]
-variables {x : B}
-
-/-- If `a` strictly divides the minimal polynomial of `x`, then `x` cannot be a root for `a`. -/
-lemma aeval_ne_zero_of_dvd_not_unit_minpoly {a : A[X]} (hx : is_integral A x)
-  (hamonic : a.monic) (hdvd : dvd_not_unit a (minpoly A x)) :
-  polynomial.aeval x a ≠ 0 :=
-begin
-  intro ha,
-  refine not_lt_of_ge (minpoly.min A x hamonic ha) _,
-  obtain ⟨hzeroa, b, hb_nunit, prod⟩ := hdvd,
-  have hbmonic : b.monic,
-  { rw monic.def,
-    have := monic hx,
-    rwa [monic.def, prod, leading_coeff_mul, monic.def.mp hamonic, one_mul] at this },
-  have hzerob : b ≠ 0 := hbmonic.ne_zero,
-  have degbzero : 0 < b.nat_degree,
-  { apply nat.pos_of_ne_zero,
-    intro h,
-    have h₁ := eq_C_of_nat_degree_eq_zero h,
-    rw [←h, ←leading_coeff, monic.def.1 hbmonic, C_1] at h₁,
-    rw h₁ at hb_nunit,
-    have := is_unit_one,
-    contradiction },
-  rw [prod, degree_mul, degree_eq_nat_degree hzeroa, degree_eq_nat_degree hzerob],
-  exact_mod_cast lt_add_of_pos_right _ degbzero,
-end
-
-variables [is_domain B]
-
-/-- A minimal polynomial is irreducible. -/
-lemma irreducible (hx : is_integral A x) : irreducible (minpoly A x) :=
-begin
-  cases irreducible_or_factor (minpoly A x) (not_is_unit A x) with hirr hred,
-  { exact hirr },
-  exfalso,
-  obtain ⟨a, b, ha_nunit, hb_nunit, hab_eq⟩ := hred,
-  have coeff_prod : a.leading_coeff * b.leading_coeff = 1,
-  { rw [←monic.def.1 (monic hx), ←hab_eq],
-    simp only [leading_coeff_mul] },
-  have hamonic : (a * C b.leading_coeff).monic,
-  { rw monic.def,
-    simp only [coeff_prod, leading_coeff_mul, leading_coeff_C] },
-  have hbmonic : (b * C a.leading_coeff).monic,
-  { rw [monic.def, mul_comm],
-    simp only [coeff_prod, leading_coeff_mul, leading_coeff_C] },
-  have prod : minpoly A x = (a * C b.leading_coeff) * (b * C a.leading_coeff),
-  { symmetry,
-    calc a * C b.leading_coeff * (b * C a.leading_coeff)
-        = a * b * (C a.leading_coeff * C b.leading_coeff) : by ring
-    ... = a * b * (C (a.leading_coeff * b.leading_coeff)) : by simp only [ring_hom.map_mul]
-    ... = a * b : by rw [coeff_prod, C_1, mul_one]
-    ... = minpoly A x : hab_eq },
-  have hzero := aeval A x,
-  rw [prod, aeval_mul, mul_eq_zero] at hzero,
-  cases hzero,
-  { refine aeval_ne_zero_of_dvd_not_unit_minpoly hx hamonic _ hzero,
-    exact ⟨hamonic.ne_zero, _, mt is_unit_of_mul_is_unit_left hb_nunit, prod⟩ },
-  { refine aeval_ne_zero_of_dvd_not_unit_minpoly hx hbmonic _ hzero,
-    rw mul_comm at prod,
-    exact ⟨hbmonic.ne_zero, _, mt is_unit_of_mul_is_unit_left ha_nunit, prod⟩ },
-end
-
-end is_domain
-
-end comm_ring
-
-section field
-variables [field A]
-
-section ring
-variables [ring B] [algebra A B]
-variables {x : B}
-
-variables (A x)
-
-/-- If an element `x` is a root of a nonzero polynomial `p`,
-then the degree of `p` is at least the degree of the minimal polynomial of `x`. -/
-lemma degree_le_of_ne_zero
-  {p : A[X]} (pnz : p ≠ 0) (hp : polynomial.aeval x p = 0) :
-  degree (minpoly A x) ≤ degree p :=
-calc degree (minpoly A x) ≤ degree (p * C (leading_coeff p)⁻¹) :
-    min A x (monic_mul_leading_coeff_inv pnz) (by simp [hp])
-  ... = degree p : degree_mul_leading_coeff_inv p pnz
-
-lemma ne_zero_of_finite_field_extension (e : B) [finite_dimensional A B] : minpoly A e ≠ 0 :=
-minpoly.ne_zero $ is_integral_of_noetherian (is_noetherian.iff_fg.2 infer_instance) _
-
-/-- The minimal polynomial of an element `x` is uniquely characterized by its defining property:
-if there is another monic polynomial of minimal degree that has `x` as a root,
-then this polynomial is equal to the minimal polynomial of `x`. -/
-lemma unique {p : A[X]}
-  (pmonic : p.monic) (hp : polynomial.aeval x p = 0)
-  (pmin : ∀ q : A[X], q.monic → polynomial.aeval x q = 0 → degree p ≤ degree q) :
-  p = minpoly A x :=
-begin
-  have hx : is_integral A x := ⟨p, pmonic, hp⟩,
-  symmetry, apply eq_of_sub_eq_zero,
-  by_contra hnz,
-  have := degree_le_of_ne_zero A x hnz (by simp [hp]),
-  contrapose! this,
-  apply degree_sub_lt _ (ne_zero hx),
-  { rw [(monic hx).leading_coeff, pmonic.leading_coeff] },
-  { exact le_antisymm (min A x pmonic hp)
-      (pmin (minpoly A x) (monic hx) (aeval A x)) }
-end
-
-/-- If an element `x` is a root of a polynomial `p`,
-then the minimal polynomial of `x` divides `p`. -/
-lemma dvd {p : A[X]} (hp : polynomial.aeval x p = 0) : minpoly A x ∣ p :=
-begin
-  by_cases hp0 : p = 0,
-  { simp only [hp0, dvd_zero] },
-  have hx : is_integral A x,
-  { rw ← is_algebraic_iff_is_integral, exact ⟨p, hp0, hp⟩ },
-  rw ← dvd_iff_mod_by_monic_eq_zero (monic hx),
-  by_contra hnz,
-  have := degree_le_of_ne_zero A x hnz _,
-  { contrapose! this,
-    exact degree_mod_by_monic_lt _ (monic hx) },
-  { rw ← mod_by_monic_add_div p (monic hx) at hp,
-    simpa using hp }
-end
-
-lemma dvd_map_of_is_scalar_tower (A K : Type*) {R : Type*} [comm_ring A] [field K] [comm_ring R]
-  [algebra A K] [algebra A R] [algebra K R] [is_scalar_tower A K R] (x : R) :
-  minpoly K x ∣ (minpoly A x).map (algebra_map A K) :=
-by { refine minpoly.dvd K x _, rw [← is_scalar_tower.aeval_apply, minpoly.aeval] }
-
-/-- If `y` is a conjugate of `x` over a field `K`, then it is a conjugate over a subring `R`. -/
-lemma aeval_of_is_scalar_tower (R : Type*) {K T U : Type*} [comm_ring R] [field K] [comm_ring T]
-  [algebra R K] [algebra K T] [algebra R T] [is_scalar_tower R K T]
-  [comm_semiring U] [algebra K U] [algebra R U] [is_scalar_tower R K U]
-  (x : T) (y : U)
-  (hy : polynomial.aeval y (minpoly K x) = 0) : polynomial.aeval y (minpoly R x) = 0 :=
-by { rw is_scalar_tower.aeval_apply R K,
-     exact eval₂_eq_zero_of_dvd_of_eval₂_eq_zero (algebra_map K U) y
-        (minpoly.dvd_map_of_is_scalar_tower R K x) hy }
-
-variables {A x}
-
-theorem eq_of_irreducible_of_monic
-  [nontrivial B] {p : A[X]} (hp1 : _root_.irreducible p)
-  (hp2 : polynomial.aeval x p = 0) (hp3 : p.monic) : p = minpoly A x :=
-let ⟨q, hq⟩ := dvd A x hp2 in
-eq_of_monic_of_associated hp3 (monic ⟨p, ⟨hp3, hp2⟩⟩) $
-mul_one (minpoly A x) ▸ hq.symm ▸ associated.mul_left _ $
-associated_one_iff_is_unit.2 $ (hp1.is_unit_or_is_unit hq).resolve_left $ not_is_unit A x
-
-lemma eq_of_irreducible [nontrivial B] {p : A[X]}
-  (hp1 : _root_.irreducible p) (hp2 : polynomial.aeval x p = 0) :
-  p * C p.leading_coeff⁻¹ = minpoly A x :=
-begin
-  have : p.leading_coeff ≠ 0 := leading_coeff_ne_zero.mpr hp1.ne_zero,
-  apply eq_of_irreducible_of_monic,
-  { exact associated.irreducible ⟨⟨C p.leading_coeff⁻¹, C p.leading_coeff,
-      by rwa [←C_mul, inv_mul_cancel, C_1], by rwa [←C_mul, mul_inv_cancel, C_1]⟩, rfl⟩ hp1 },
-  { rw [aeval_mul, hp2, zero_mul] },
-  { rwa [polynomial.monic, leading_coeff_mul, leading_coeff_C, mul_inv_cancel] },
-end
-
-/-- If `y` is the image of `x` in an extension, their minimal polynomials coincide.
-
-We take `h : y = algebra_map L T x` as an argument because `rw h` typically fails
-since `is_integral R y` depends on y.
--/
-lemma eq_of_algebra_map_eq {K S T : Type*} [field K] [comm_ring S] [comm_ring T]
-  [algebra K S] [algebra K T] [algebra S T]
-  [is_scalar_tower K S T] (hST : function.injective (algebra_map S T))
-  {x : S} {y : T} (hx : is_integral K x) (h : y = algebra_map S T x) :
-  minpoly K x = minpoly K y :=
-minpoly.unique _ _ (minpoly.monic hx)
-  (by rw [h, ← is_scalar_tower.algebra_map_aeval, minpoly.aeval, ring_hom.map_zero])
-  (λ q q_monic root_q, minpoly.min _ _ q_monic
-    (is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero K S T hST
-      (h ▸ root_q : polynomial.aeval (algebra_map S T x) q = 0)))
-
-lemma add_algebra_map {B : Type*} [comm_ring B] [algebra A B] {x : B}
-  (hx : is_integral A x) (a : A) :
-  minpoly A (x + (algebra_map A B a)) = (minpoly A x).comp (X - C a) :=
-begin
-  refine (minpoly.unique _ _ ((minpoly.monic hx).comp_X_sub_C _) _ (λ q qmo hq, _)).symm,
-  { simp [aeval_comp] },
-  { have : (polynomial.aeval x) (q.comp (X + C a)) = 0 := by simpa [aeval_comp] using hq,
-    have H := minpoly.min A x (qmo.comp_X_add_C _) this,
-    rw [degree_eq_nat_degree qmo.ne_zero, degree_eq_nat_degree
-      ((minpoly.monic hx).comp_X_sub_C _).ne_zero, with_bot.coe_le_coe, nat_degree_comp,
-      nat_degree_X_sub_C, mul_one],
-    rwa [degree_eq_nat_degree (minpoly.ne_zero hx), degree_eq_nat_degree
-      (qmo.comp_X_add_C _).ne_zero, with_bot.coe_le_coe, nat_degree_comp,
-      nat_degree_X_add_C, mul_one] at H }
-end
-
-lemma sub_algebra_map {B : Type*} [comm_ring B] [algebra A B] {x : B}
-  (hx : is_integral A x) (a : A) :
-  minpoly A (x - (algebra_map A B a)) = (minpoly A x).comp (X + C a) :=
-by simpa [sub_eq_add_neg] using add_algebra_map hx (-a)
-
-section gcd_domain
-
-/-- For GCD domains, the minimal polynomial over the ring is the same as the minimal polynomial
-over the fraction field. -/
-lemma gcd_domain_eq_field_fractions {A R : Type*} (K : Type*) [comm_ring A] [is_domain A]
-  [normalized_gcd_monoid A] [field K]
-  [comm_ring R] [is_domain R] [algebra A K] [is_fraction_ring A K]
-  [algebra K R] [algebra A R] [is_scalar_tower A K R] {x : R} (hx : is_integral A x) :
-  minpoly K x = (minpoly A x).map (algebra_map A K) :=
-begin
-  symmetry,
-  refine eq_of_irreducible_of_monic _ _ _,
-  { exact (polynomial.is_primitive.irreducible_iff_irreducible_map_fraction_map
-      (polynomial.monic.is_primitive (monic hx))).1 (irreducible hx) },
-  { have htower := is_scalar_tower.aeval_apply A K R x (minpoly A x),
-    rwa [aeval, eq_comm] at htower },
-  { exact (monic hx).map _ }
-end
-
-/-- For GCD domains, the minimal polynomial divides any primitive polynomial that has the integral
-element as root. -/
-lemma gcd_domain_dvd {A R : Type*} (K : Type*)
-  [comm_ring A] [is_domain A] [normalized_gcd_monoid A] [field K]
-  [comm_ring R] [is_domain R] [algebra A K]
-  [is_fraction_ring A K] [algebra K R] [algebra A R] [is_scalar_tower A K R]
-  {x : R} (hx : is_integral A x)
-  {P : A[X]} (hprim : is_primitive P) (hroot : polynomial.aeval x P = 0) :
-  minpoly A x ∣ P :=
-begin
-  apply (is_primitive.dvd_iff_fraction_map_dvd_fraction_map K
-    (monic.is_primitive (monic hx)) hprim).2,
-  rw ← gcd_domain_eq_field_fractions K hx,
-  refine dvd _ _ _,
-  rwa ← is_scalar_tower.aeval_apply
-end
-
-end gcd_domain
-
-variables (B) [nontrivial B]
-
-/-- If `B/K` is a nontrivial algebra over a field, and `x` is an element of `K`,
-then the minimal polynomial of `algebra_map K B x` is `X - C x`. -/
-lemma eq_X_sub_C (a : A) : minpoly A (algebra_map A B a) = X - C a :=
-eq_X_sub_C_of_algebra_map_inj a (algebra_map A B).injective
-
-lemma eq_X_sub_C' (a : A) : minpoly A a = X - C a := eq_X_sub_C A a
-
-variables (A)
-
-/-- The minimal polynomial of `0` is `X`. -/
-@[simp] lemma zero : minpoly A (0:B) = X :=
-by simpa only [add_zero, C_0, sub_eq_add_neg, neg_zero, ring_hom.map_zero]
-  using eq_X_sub_C B (0:A)
-
-/-- The minimal polynomial of `1` is `X - 1`. -/
-@[simp] lemma one : minpoly A (1:B) = X - 1 :=
-by simpa only [ring_hom.map_one, C_1, sub_eq_add_neg] using eq_X_sub_C B (1:A)
-
-end ring
-
-section is_domain
-variables [ring B] [is_domain B] [algebra A B]
-variables {x : B}
-
-/-- A minimal polynomial is prime. -/
-lemma prime (hx : is_integral A x) : prime (minpoly A x) :=
-begin
-  refine ⟨ne_zero hx, not_is_unit A x, _⟩,
-  rintros p q ⟨d, h⟩,
-  have :    polynomial.aeval x (p*q) = 0 := by simp [h, aeval A x],
-  replace : polynomial.aeval x p = 0 ∨ polynomial.aeval x q = 0 := by simpa,
-  exact or.imp (dvd A x) (dvd A x) this
-end
-
-/-- If `L/K` is a field extension and an element `y` of `K` is a root of the minimal polynomial
-of an element `x ∈ L`, then `y` maps to `x` under the field embedding. -/
-lemma root {x : B} (hx : is_integral A x) {y : A} (h : is_root (minpoly A x) y) :
-  algebra_map A B y = x :=
-have key : minpoly A x = X - C y :=
-eq_of_monic_of_associated (monic hx) (monic_X_sub_C y) (associated_of_dvd_dvd
-  ((irreducible_X_sub_C y).dvd_symm (irreducible hx) (dvd_iff_is_root.2 h))
-  (dvd_iff_is_root.2 h)),
-by { have := aeval A x, rwa [key, alg_hom.map_sub, aeval_X, aeval_C, sub_eq_zero, eq_comm] at this }
-
-/-- The constant coefficient of the minimal polynomial of `x` is `0` if and only if `x = 0`. -/
-@[simp] lemma coeff_zero_eq_zero (hx : is_integral A x) : coeff (minpoly A x) 0 = 0 ↔ x = 0 :=
-begin
-  split,
-  { intro h,
-    have zero_root := zero_is_root_of_coeff_zero_eq_zero h,
-    rw ← root hx zero_root,
-    exact ring_hom.map_zero _ },
-  { rintro rfl, simp }
-end
-
-/-- The minimal polynomial of a nonzero element has nonzero constant coefficient. -/
-lemma coeff_zero_ne_zero (hx : is_integral A x) (h : x ≠ 0) : coeff (minpoly A x) 0 ≠ 0 :=
-by { contrapose! h, simpa only [hx, coeff_zero_eq_zero] using h }
-
-end is_domain
-
-end field
-
-end minpoly
diff --git a/src/field_theory/minpoly/basic.lean b/src/field_theory/minpoly/basic.lean
new file mode 100644
index 0000000000000..4a19907b5e231
--- /dev/null
+++ b/src/field_theory/minpoly/basic.lean
@@ -0,0 +1,243 @@
+/-
+Copyright (c) 2019 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes, Johan Commelin
+-/
+import ring_theory.integral_closure
+
+/-!
+# Minimal polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the minimal polynomial of an element `x` of an `A`-algebra `B`,
+under the assumption that x is integral over `A`, and derives some basic properties
+such as ireducibility under the assumption `B` is a domain.
+
+-/
+
+open_locale classical polynomial
+open polynomial set function
+
+variables {A B B' : Type*}
+
+section min_poly_def
+variables (A) [comm_ring A] [ring B] [algebra A B]
+
+/--
+Suppose `x : B`, where `B` is an `A`-algebra.
+
+The minimal polynomial `minpoly A x` of `x`
+is a monic polynomial with coefficients in `A` of smallest degree that has `x` as its root,
+if such exists (`is_integral A x`) or zero otherwise.
+
+For example, if `V` is a `𝕜`-vector space for some field `𝕜` and `f : V →ₗ[𝕜] V` then
+the minimal polynomial of `f` is `minpoly 𝕜 f`.
+-/
+noncomputable def minpoly (x : B) : A[X] :=
+if hx : is_integral A x then degree_lt_wf.min _ hx else 0
+
+end min_poly_def
+
+namespace minpoly
+
+section ring
+variables [comm_ring A] [ring B] [ring B'] [algebra A B] [algebra A B']
+variables {x : B}
+
+/-- A minimal polynomial is monic. -/
+lemma monic (hx : is_integral A x) : monic (minpoly A x) :=
+by { delta minpoly, rw dif_pos hx, exact (degree_lt_wf.min_mem _ hx).1 }
+
+/-- A minimal polynomial is nonzero. -/
+lemma ne_zero [nontrivial A] (hx : is_integral A x) : minpoly A x ≠ 0 :=
+(monic hx).ne_zero
+
+lemma eq_zero (hx : ¬ is_integral A x) : minpoly A x = 0 :=
+dif_neg hx
+
+lemma minpoly_alg_hom (f : B →ₐ[A] B') (hf : function.injective f) (x : B) :
+  minpoly A (f x) = minpoly A x :=
+begin
+  refine dif_ctx_congr (is_integral_alg_hom_iff _ hf) (λ _, _) (λ _, rfl),
+  simp_rw [←polynomial.aeval_def, aeval_alg_hom, alg_hom.comp_apply, _root_.map_eq_zero_iff f hf],
+end
+
+@[simp] lemma minpoly_alg_equiv (f : B ≃ₐ[A] B') (x : B) : minpoly A (f x) = minpoly A x :=
+minpoly_alg_hom (f : B →ₐ[A] B') f.injective x
+
+variables (A x)
+
+/-- An element is a root of its minimal polynomial. -/
+@[simp] lemma aeval : aeval x (minpoly A x) = 0 :=
+begin
+  delta minpoly, split_ifs with hx,
+  { exact (degree_lt_wf.min_mem _ hx).2 },
+  { exact aeval_zero _ }
+end
+
+/-- A minimal polynomial is not `1`. -/
+lemma ne_one [nontrivial B] : minpoly A x ≠ 1 :=
+begin
+  intro h,
+  refine (one_ne_zero : (1 : B) ≠ 0) _,
+  simpa using congr_arg (polynomial.aeval x) h
+end
+
+lemma map_ne_one [nontrivial B] {R : Type*} [semiring R] [nontrivial R] (f : A →+* R) :
+  (minpoly A x).map f ≠ 1 :=
+begin
+  by_cases hx : is_integral A x,
+  { exact mt ((monic hx).eq_one_of_map_eq_one f) (ne_one A x) },
+  { rw [eq_zero hx, polynomial.map_zero], exact zero_ne_one },
+end
+
+/-- A minimal polynomial is not a unit. -/
+lemma not_is_unit [nontrivial B] : ¬ is_unit (minpoly A x) :=
+begin
+  haveI : nontrivial A := (algebra_map A B).domain_nontrivial,
+  by_cases hx : is_integral A x,
+  { exact mt (monic hx).eq_one_of_is_unit (ne_one A x) },
+  { rw [eq_zero hx], exact not_is_unit_zero }
+end
+
+lemma mem_range_of_degree_eq_one (hx : (minpoly A x).degree = 1) : x ∈ (algebra_map A B).range :=
+begin
+  have h : is_integral A x,
+  { by_contra h,
+    rw [eq_zero h, degree_zero, ←with_bot.coe_one] at hx,
+    exact (ne_of_lt (show ⊥ < ↑1, from with_bot.bot_lt_coe 1) hx) },
+  have key := minpoly.aeval A x,
+  rw [eq_X_add_C_of_degree_eq_one hx, (minpoly.monic h).leading_coeff, C_1, one_mul, aeval_add,
+      aeval_C, aeval_X, ←eq_neg_iff_add_eq_zero, ←ring_hom.map_neg] at key,
+  exact ⟨-(minpoly A x).coeff 0, key.symm⟩,
+end
+
+/-- The defining property of the minimal polynomial of an element `x`:
+it is the monic polynomial with smallest degree that has `x` as its root. -/
+lemma min {p : A[X]} (pmonic : p.monic) (hp : polynomial.aeval x p = 0) :
+  degree (minpoly A x) ≤ degree p :=
+begin
+  delta minpoly, split_ifs with hx,
+  { exact le_of_not_lt (degree_lt_wf.not_lt_min _ hx ⟨pmonic, hp⟩) },
+  { simp only [degree_zero, bot_le] }
+end
+
+lemma unique' {p : A[X]} (hm : p.monic) (hp : polynomial.aeval x p = 0)
+  (hl : ∀ q : A[X], degree q < degree p → q = 0 ∨ polynomial.aeval x q ≠ 0) :
+  p = minpoly A x :=
+begin
+  nontriviality A,
+  have hx : is_integral A x := ⟨p, hm, hp⟩,
+  obtain h | h := hl _ ((minpoly A x).degree_mod_by_monic_lt hm), swap,
+  { exact (h $ (aeval_mod_by_monic_eq_self_of_root hm hp).trans $ aeval A x).elim },
+  obtain ⟨r, hr⟩ := (dvd_iff_mod_by_monic_eq_zero hm).1 h,
+  rw hr, have hlead := congr_arg leading_coeff hr,
+  rw [mul_comm, leading_coeff_mul_monic hm, (monic hx).leading_coeff] at hlead,
+  have : nat_degree r ≤ 0,
+  { have hr0 : r ≠ 0 := by { rintro rfl, exact ne_zero hx (mul_zero p ▸ hr) },
+    apply_fun nat_degree at hr,
+    rw hm.nat_degree_mul' hr0 at hr,
+    apply nat.le_of_add_le_add_left,
+    rw add_zero,
+    exact hr.symm.trans_le (nat_degree_le_nat_degree $ min A x hm hp) },
+  rw [eq_C_of_nat_degree_le_zero this, ← nat.eq_zero_of_le_zero this,
+      ← leading_coeff, ← hlead, C_1, mul_one],
+end
+
+@[nontriviality] lemma subsingleton [subsingleton B] : minpoly A x = 1 :=
+begin
+  nontriviality A,
+  have := minpoly.min A x monic_one (subsingleton.elim _ _),
+  rw degree_one at this,
+  cases le_or_lt (minpoly A x).degree 0 with h h,
+  { rwa (monic ⟨1, monic_one, by simp⟩ : (minpoly A x).monic).degree_le_zero_iff_eq_one at h },
+  { exact (this.not_lt h).elim },
+end
+
+end ring
+
+section comm_ring
+
+variables [comm_ring A]
+
+section ring
+
+variables [ring B] [algebra A B]
+variables {x : B}
+
+/-- The degree of a minimal polynomial, as a natural number, is positive. -/
+lemma nat_degree_pos [nontrivial B] (hx : is_integral A x) : 0 < nat_degree (minpoly A x) :=
+begin
+  rw pos_iff_ne_zero,
+  intro ndeg_eq_zero,
+  have eq_one : minpoly A x = 1,
+  { rw eq_C_of_nat_degree_eq_zero ndeg_eq_zero, convert C_1,
+    simpa only [ndeg_eq_zero.symm] using (monic hx).leading_coeff },
+  simpa only [eq_one, alg_hom.map_one, one_ne_zero] using aeval A x
+end
+
+/-- The degree of a minimal polynomial is positive. -/
+lemma degree_pos [nontrivial B] (hx : is_integral A x) : 0 < degree (minpoly A x) :=
+nat_degree_pos_iff_degree_pos.mp (nat_degree_pos hx)
+
+/-- If `B/A` is an injective ring extension, and `a` is an element of `A`,
+then the minimal polynomial of `algebra_map A B a` is `X - C a`. -/
+lemma eq_X_sub_C_of_algebra_map_inj
+  (a : A) (hf : function.injective (algebra_map A B)) :
+  minpoly A (algebra_map A B a) = X - C a :=
+begin
+  nontriviality A,
+  refine (unique' A _ (monic_X_sub_C a) _ _).symm,
+  { rw [map_sub, aeval_C, aeval_X, sub_self] },
+  simp_rw or_iff_not_imp_left,
+  intros q hl h0,
+  rw [← nat_degree_lt_nat_degree_iff h0, nat_degree_X_sub_C, nat.lt_one_iff] at hl,
+  rw eq_C_of_nat_degree_eq_zero hl at h0 ⊢,
+  rwa [aeval_C, map_ne_zero_iff _ hf, ← C_ne_zero],
+end
+
+end ring
+
+section is_domain
+
+variables [ring B] [algebra A B]
+variables {x : B}
+
+/-- If `a` strictly divides the minimal polynomial of `x`, then `x` cannot be a root for `a`. -/
+lemma aeval_ne_zero_of_dvd_not_unit_minpoly {a : A[X]} (hx : is_integral A x)
+  (hamonic : a.monic) (hdvd : dvd_not_unit a (minpoly A x)) :
+  polynomial.aeval x a ≠ 0 :=
+begin
+  refine λ ha, (min A x hamonic ha).not_lt (degree_lt_degree _),
+  obtain ⟨b, c, hu, he⟩ := hdvd,
+  have hcm := hamonic.of_mul_monic_left (he.subst $ monic hx),
+  rw [he, hamonic.nat_degree_mul hcm],
+  apply nat.lt_add_of_zero_lt_left _ _ (lt_of_not_le $ λ h, hu _),
+  rw [eq_C_of_nat_degree_le_zero h, ← nat.eq_zero_of_le_zero h,
+      ← leading_coeff, hcm.leading_coeff, C_1],
+  exact is_unit_one,
+end
+
+variables [is_domain A] [is_domain B]
+
+/-- A minimal polynomial is irreducible. -/
+lemma irreducible (hx : is_integral A x) : irreducible (minpoly A x) :=
+begin
+  refine (irreducible_of_monic (monic hx) $ ne_one A x).2 (λ f g hf hg he, _),
+  rw [← hf.is_unit_iff, ← hg.is_unit_iff],
+  by_contra' h,
+  have heval := congr_arg (polynomial.aeval x) he,
+  rw [aeval A x, aeval_mul, mul_eq_zero] at heval,
+  cases heval,
+  { exact aeval_ne_zero_of_dvd_not_unit_minpoly hx hf ⟨hf.ne_zero, g, h.2, he.symm⟩ heval },
+  { refine aeval_ne_zero_of_dvd_not_unit_minpoly hx hg ⟨hg.ne_zero, f, h.1, _⟩ heval,
+    rw [mul_comm, he] },
+end
+
+end is_domain
+
+end comm_ring
+
+end minpoly
diff --git a/src/field_theory/minpoly/field.lean b/src/field_theory/minpoly/field.lean
new file mode 100644
index 0000000000000..dc6c8381ecff9
--- /dev/null
+++ b/src/field_theory/minpoly/field.lean
@@ -0,0 +1,269 @@
+/-
+Copyright (c) 2019 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca, Johan Commelin
+-/
+import data.polynomial.field_division
+import field_theory.minpoly.basic
+import ring_theory.algebraic
+
+/-!
+# Minimal polynomials on an algebra over a field
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file specializes the theory of minpoly to the setting of field extensions
+and derives some well-known properties, amongst which the fact that minimal polynomials
+are irreducible, and uniquely determined by their defining property.
+
+-/
+
+open_locale classical polynomial
+open polynomial set function minpoly
+
+namespace minpoly
+
+variables {A B : Type*}
+variables (A) [field A]
+
+section ring
+
+variables [ring B] [algebra A B] (x : B)
+
+/-- If an element `x` is a root of a nonzero polynomial `p`, then the degree of `p` is at least the
+degree of the minimal polynomial of `x`. See also `gcd_domain_degree_le_of_ne_zero` which relaxes
+the assumptions on `A` in exchange for stronger assumptions on `B`. -/
+lemma degree_le_of_ne_zero
+  {p : A[X]} (pnz : p ≠ 0) (hp : polynomial.aeval x p = 0) :
+  degree (minpoly A x) ≤ degree p :=
+calc degree (minpoly A x) ≤ degree (p * C (leading_coeff p)⁻¹) :
+    min A x (monic_mul_leading_coeff_inv pnz) (by simp [hp])
+  ... = degree p : degree_mul_leading_coeff_inv p pnz
+
+lemma ne_zero_of_finite_field_extension (e : B) [finite_dimensional A B] : minpoly A e ≠ 0 :=
+minpoly.ne_zero $ is_integral_of_noetherian (is_noetherian.iff_fg.2 infer_instance) _
+
+/-- The minimal polynomial of an element `x` is uniquely characterized by its defining property:
+if there is another monic polynomial of minimal degree that has `x` as a root, then this polynomial
+is equal to the minimal polynomial of `x`. See also `minpoly.gcd_unique` which relaxes the
+assumptions on `A` in exchange for stronger assumptions on `B`. -/
+lemma unique {p : A[X]}
+  (pmonic : p.monic) (hp : polynomial.aeval x p = 0)
+  (pmin : ∀ q : A[X], q.monic → polynomial.aeval x q = 0 → degree p ≤ degree q) :
+  p = minpoly A x :=
+begin
+  have hx : is_integral A x := ⟨p, pmonic, hp⟩,
+  symmetry, apply eq_of_sub_eq_zero,
+  by_contra hnz,
+  have := degree_le_of_ne_zero A x hnz (by simp [hp]),
+  contrapose! this,
+  apply degree_sub_lt _ (ne_zero hx),
+  { rw [(monic hx).leading_coeff, pmonic.leading_coeff] },
+  { exact le_antisymm (min A x pmonic hp)
+      (pmin (minpoly A x) (monic hx) (aeval A x)) }
+end
+
+/-- If an element `x` is a root of a polynomial `p`, then the minimal polynomial of `x` divides `p`.
+See also `minpoly.gcd_domain_dvd` which relaxes the assumptions on `A` in exchange for stronger
+assumptions on `B`. -/
+lemma dvd {p : A[X]} (hp : polynomial.aeval x p = 0) : minpoly A x ∣ p :=
+begin
+  by_cases hp0 : p = 0,
+  { simp only [hp0, dvd_zero] },
+  have hx : is_integral A x,
+  { rw ← is_algebraic_iff_is_integral, exact ⟨p, hp0, hp⟩ },
+  rw ← dvd_iff_mod_by_monic_eq_zero (monic hx),
+  by_contra hnz,
+  have := degree_le_of_ne_zero A x hnz _,
+  { contrapose! this,
+    exact degree_mod_by_monic_lt _ (monic hx) },
+  { rw ← mod_by_monic_add_div p (monic hx) at hp,
+    simpa using hp }
+end
+
+lemma dvd_map_of_is_scalar_tower (A K : Type*) {R : Type*} [comm_ring A] [field K] [comm_ring R]
+  [algebra A K] [algebra A R] [algebra K R] [is_scalar_tower A K R] (x : R) :
+  minpoly K x ∣ (minpoly A x).map (algebra_map A K) :=
+by { refine minpoly.dvd K x _, rw [aeval_map_algebra_map, minpoly.aeval] }
+
+lemma dvd_map_of_is_scalar_tower' (R : Type*) {S : Type*} (K L : Type*) [comm_ring R]
+  [comm_ring S] [field K] [comm_ring L] [algebra R S] [algebra R K] [algebra S L] [algebra K L]
+  [algebra R L] [is_scalar_tower R K L] [is_scalar_tower R S L] (s : S):
+  minpoly K (algebra_map S L s) ∣ (map (algebra_map R K) (minpoly R s)) :=
+begin
+  apply minpoly.dvd K (algebra_map S L s),
+  rw [← map_aeval_eq_aeval_map, minpoly.aeval, map_zero],
+  rw [← is_scalar_tower.algebra_map_eq, ← is_scalar_tower.algebra_map_eq]
+end
+
+/-- If `y` is a conjugate of `x` over a field `K`, then it is a conjugate over a subring `R`. -/
+lemma aeval_of_is_scalar_tower (R : Type*) {K T U : Type*} [comm_ring R] [field K] [comm_ring T]
+  [algebra R K] [algebra K T] [algebra R T] [is_scalar_tower R K T]
+  [comm_semiring U] [algebra K U] [algebra R U] [is_scalar_tower R K U]
+  (x : T) (y : U)
+  (hy : polynomial.aeval y (minpoly K x) = 0) : polynomial.aeval y (minpoly R x) = 0 :=
+aeval_map_algebra_map K y (minpoly R x) ▸ eval₂_eq_zero_of_dvd_of_eval₂_eq_zero (algebra_map K U)
+                                              y (minpoly.dvd_map_of_is_scalar_tower R K x) hy
+
+variables {A x}
+
+theorem eq_of_irreducible_of_monic
+  [nontrivial B] {p : A[X]} (hp1 : _root_.irreducible p)
+  (hp2 : polynomial.aeval x p = 0) (hp3 : p.monic) : p = minpoly A x :=
+let ⟨q, hq⟩ := dvd A x hp2 in
+eq_of_monic_of_associated hp3 (monic ⟨p, ⟨hp3, hp2⟩⟩) $
+mul_one (minpoly A x) ▸ hq.symm ▸ associated.mul_left _ $
+associated_one_iff_is_unit.2 $ (hp1.is_unit_or_is_unit hq).resolve_left $ not_is_unit A x
+
+lemma eq_of_irreducible [nontrivial B] {p : A[X]}
+  (hp1 : _root_.irreducible p) (hp2 : polynomial.aeval x p = 0) :
+  p * C p.leading_coeff⁻¹ = minpoly A x :=
+begin
+  have : p.leading_coeff ≠ 0 := leading_coeff_ne_zero.mpr hp1.ne_zero,
+  apply eq_of_irreducible_of_monic,
+  { exact associated.irreducible ⟨⟨C p.leading_coeff⁻¹, C p.leading_coeff,
+      by rwa [←C_mul, inv_mul_cancel, C_1], by rwa [←C_mul, mul_inv_cancel, C_1]⟩, rfl⟩ hp1 },
+  { rw [aeval_mul, hp2, zero_mul] },
+  { rwa [polynomial.monic, leading_coeff_mul, leading_coeff_C, mul_inv_cancel] },
+end
+
+/-- If `y` is the image of `x` in an extension, their minimal polynomials coincide.
+
+We take `h : y = algebra_map L T x` as an argument because `rw h` typically fails
+since `is_integral R y` depends on y.
+-/
+lemma eq_of_algebra_map_eq {K S T : Type*} [field K] [comm_ring S] [comm_ring T]
+  [algebra K S] [algebra K T] [algebra S T]
+  [is_scalar_tower K S T] (hST : function.injective (algebra_map S T))
+  {x : S} {y : T} (hx : is_integral K x) (h : y = algebra_map S T x) :
+  minpoly K x = minpoly K y :=
+minpoly.unique _ _ (minpoly.monic hx)
+  (by rw [h, aeval_algebra_map_apply, minpoly.aeval, ring_hom.map_zero])
+  (λ q q_monic root_q, minpoly.min _ _ q_monic
+    ((aeval_algebra_map_eq_zero_iff_of_injective hST).mp
+      (h ▸ root_q : polynomial.aeval (algebra_map S T x) q = 0)))
+
+lemma add_algebra_map {B : Type*} [comm_ring B] [algebra A B] {x : B}
+  (hx : is_integral A x) (a : A) :
+  minpoly A (x + (algebra_map A B a)) = (minpoly A x).comp (X - C a) :=
+begin
+  refine (minpoly.unique _ _ ((minpoly.monic hx).comp_X_sub_C _) _ (λ q qmo hq, _)).symm,
+  { simp [aeval_comp] },
+  { have : (polynomial.aeval x) (q.comp (X + C a)) = 0 := by simpa [aeval_comp] using hq,
+    have H := minpoly.min A x (qmo.comp_X_add_C _) this,
+    rw [degree_eq_nat_degree qmo.ne_zero, degree_eq_nat_degree
+      ((minpoly.monic hx).comp_X_sub_C _).ne_zero, with_bot.coe_le_coe, nat_degree_comp,
+      nat_degree_X_sub_C, mul_one],
+    rwa [degree_eq_nat_degree (minpoly.ne_zero hx), degree_eq_nat_degree
+      (qmo.comp_X_add_C _).ne_zero, with_bot.coe_le_coe, nat_degree_comp,
+      nat_degree_X_add_C, mul_one] at H }
+end
+
+lemma sub_algebra_map {B : Type*} [comm_ring B] [algebra A B] {x : B}
+  (hx : is_integral A x) (a : A) :
+  minpoly A (x - (algebra_map A B a)) = (minpoly A x).comp (X + C a) :=
+by simpa [sub_eq_add_neg] using add_algebra_map hx (-a)
+
+section alg_hom_fintype
+
+/-- A technical finiteness result. -/
+noncomputable def fintype.subtype_prod {E : Type*} {X : set E} (hX : X.finite) {L : Type*}
+  (F : E → multiset L) : fintype (Π x : X, {l : L // l ∈ F x}) :=
+let hX := finite.fintype hX in by exactI pi.fintype
+
+variables (F E K : Type*) [field F] [ring E] [comm_ring K] [is_domain K]
+  [algebra F E] [algebra F K] [finite_dimensional F E]
+
+/-- Function from Hom_K(E,L) to pi type Π (x : basis), roots of min poly of x -/
+-- Marked as `noncomputable!` since this definition takes multiple seconds to compile,
+-- and isn't very computable in practice (since neither `finrank` nor `fin_basis` are).
+noncomputable! def roots_of_min_poly_pi_type (φ : E →ₐ[F] K)
+  (x : range (finite_dimensional.fin_basis F E : _ → E)) :
+  {l : K // l ∈ (((minpoly F x.1).map (algebra_map F K)).roots : multiset K)} :=
+⟨φ x, by rw [mem_roots_map (minpoly.ne_zero_of_finite_field_extension F x.val),
+  subtype.val_eq_coe, ←aeval_def, aeval_alg_hom_apply, minpoly.aeval, map_zero]⟩
+
+lemma aux_inj_roots_of_min_poly : injective (roots_of_min_poly_pi_type F E K) :=
+begin
+  intros f g h,
+  suffices : (f : E →ₗ[F] K) = g,
+  { rwa fun_like.ext'_iff at this ⊢ },
+  rw funext_iff at h,
+  exact linear_map.ext_on (finite_dimensional.fin_basis F E).span_eq
+    (λ e he, subtype.ext_iff.mp (h ⟨e, he⟩)),
+end
+
+/-- Given field extensions `E/F` and `K/F`, with `E/F` finite, there are finitely many `F`-algebra
+  homomorphisms `E →ₐ[K] K`. -/
+noncomputable instance alg_hom.fintype : fintype (E →ₐ[F] K) :=
+@fintype.of_injective _ _ (fintype.subtype_prod (finite_range (finite_dimensional.fin_basis F E))
+  (λ e, ((minpoly F e).map (algebra_map F K)).roots)) _ (aux_inj_roots_of_min_poly F E K)
+
+end alg_hom_fintype
+
+variables (B) [nontrivial B]
+
+/-- If `B/K` is a nontrivial algebra over a field, and `x` is an element of `K`,
+then the minimal polynomial of `algebra_map K B x` is `X - C x`. -/
+lemma eq_X_sub_C (a : A) : minpoly A (algebra_map A B a) = X - C a :=
+eq_X_sub_C_of_algebra_map_inj a (algebra_map A B).injective
+
+lemma eq_X_sub_C' (a : A) : minpoly A a = X - C a := eq_X_sub_C A a
+
+variables (A)
+
+/-- The minimal polynomial of `0` is `X`. -/
+@[simp] lemma zero : minpoly A (0:B) = X :=
+by simpa only [add_zero, C_0, sub_eq_add_neg, neg_zero, ring_hom.map_zero]
+  using eq_X_sub_C B (0:A)
+
+/-- The minimal polynomial of `1` is `X - 1`. -/
+@[simp] lemma one : minpoly A (1:B) = X - 1 :=
+by simpa only [ring_hom.map_one, C_1, sub_eq_add_neg] using eq_X_sub_C B (1:A)
+
+end ring
+
+section is_domain
+
+variables [ring B] [is_domain B] [algebra A B]
+variables {A} {x : B}
+
+/-- A minimal polynomial is prime. -/
+lemma prime (hx : is_integral A x) : prime (minpoly A x) :=
+begin
+  refine ⟨ne_zero hx, not_is_unit A x, _⟩,
+  rintros p q ⟨d, h⟩,
+  have :    polynomial.aeval x (p*q) = 0 := by simp [h, aeval A x],
+  replace : polynomial.aeval x p = 0 ∨ polynomial.aeval x q = 0 := by simpa,
+  exact or.imp (dvd A x) (dvd A x) this
+end
+
+/-- If `L/K` is a field extension and an element `y` of `K` is a root of the minimal polynomial
+of an element `x ∈ L`, then `y` maps to `x` under the field embedding. -/
+lemma root {x : B} (hx : is_integral A x) {y : A} (h : is_root (minpoly A x) y) :
+  algebra_map A B y = x :=
+have key : minpoly A x = X - C y :=
+eq_of_monic_of_associated (monic hx) (monic_X_sub_C y) (associated_of_dvd_dvd
+  ((irreducible_X_sub_C y).dvd_symm (irreducible hx) (dvd_iff_is_root.2 h))
+  (dvd_iff_is_root.2 h)),
+by { have := aeval A x, rwa [key, alg_hom.map_sub, aeval_X, aeval_C, sub_eq_zero, eq_comm] at this }
+
+/-- The constant coefficient of the minimal polynomial of `x` is `0` if and only if `x = 0`. -/
+@[simp] lemma coeff_zero_eq_zero (hx : is_integral A x) : coeff (minpoly A x) 0 = 0 ↔ x = 0 :=
+begin
+  split,
+  { intro h,
+    have zero_root := zero_is_root_of_coeff_zero_eq_zero h,
+    rw ← root hx zero_root,
+    exact ring_hom.map_zero _ },
+  { rintro rfl, simp }
+end
+
+/-- The minimal polynomial of a nonzero element has nonzero constant coefficient. -/
+lemma coeff_zero_ne_zero (hx : is_integral A x) (h : x ≠ 0) : coeff (minpoly A x) 0 ≠ 0 :=
+by { contrapose! h, simpa only [hx, coeff_zero_eq_zero] using h }
+
+end is_domain
+
+end minpoly
diff --git a/src/field_theory/minpoly/is_integrally_closed.lean b/src/field_theory/minpoly/is_integrally_closed.lean
new file mode 100644
index 0000000000000..6a10a09a9738e
--- /dev/null
+++ b/src/field_theory/minpoly/is_integrally_closed.lean
@@ -0,0 +1,199 @@
+/-
+Copyright (c) 2019 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca, Paul Lezeau, Junyan Xu
+-/
+import ring_theory.adjoin_root
+import field_theory.minpoly.field
+import ring_theory.polynomial.gauss_lemma
+
+/-!
+# Minimal polynomials over a GCD monoid
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file specializes the theory of minpoly to the case of an algebra over a GCD monoid.
+
+## Main results
+
+ * `is_integrally_closed_eq_field_fractions`: For integrally closed domains, the minimal polynomial
+    over the ring is the same as the minimal polynomial over the fraction field.
+
+ * `is_integrally_closed_dvd` : For integrally closed domains, the minimal polynomial divides any
+    primitive polynomial that has the integral element as root.
+
+ * `is_integrally_closed_unique` : The minimal polynomial of an element `x` is uniquely
+    characterized by its defining property: if there is another monic polynomial of minimal degree
+    that has `x` as a root, then this polynomial is equal to the minimal polynomial of `x`.
+
+-/
+
+open_locale classical polynomial
+open polynomial set function minpoly
+
+namespace minpoly
+
+variables {R S : Type*} [comm_ring R] [comm_ring S] [is_domain R] [algebra R S]
+
+section
+
+variables (K L : Type*) [field K] [algebra R K] [is_fraction_ring R K] [field L] [algebra R L]
+ [algebra S L] [algebra K L] [is_scalar_tower R K L] [is_scalar_tower R S L]
+
+variables [is_integrally_closed R]
+
+/-- For integrally closed domains, the minimal polynomial over the ring is the same as the minimal
+polynomial over the fraction field. See `minpoly.is_integrally_closed_eq_field_fractions'` if
+`S` is already a `K`-algebra. -/
+theorem is_integrally_closed_eq_field_fractions [is_domain S] {s : S} (hs : is_integral R s) :
+  minpoly K (algebra_map S L s) = (minpoly R s).map (algebra_map R K) :=
+begin
+  refine (eq_of_irreducible_of_monic _ _ _).symm,
+  { exact (polynomial.monic.irreducible_iff_irreducible_map_fraction_map
+      (monic hs)).1 (irreducible hs) },
+   { rw [aeval_map_algebra_map, aeval_algebra_map_apply, aeval, map_zero] },
+  { exact (monic hs).map _ }
+end
+
+/-- For integrally closed domains, the minimal polynomial over the ring is the same as the minimal
+polynomial over the fraction field. Compared to `minpoly.is_integrally_closed_eq_field_fractions`,
+this version is useful if the element is in a ring that is already a `K`-algebra. -/
+theorem is_integrally_closed_eq_field_fractions' [is_domain S] [algebra K S] [is_scalar_tower R K S]
+  {s : S} (hs : is_integral R s) : minpoly K s = (minpoly R s).map (algebra_map R K) :=
+begin
+  let L := fraction_ring S,
+  rw [← is_integrally_closed_eq_field_fractions K L hs],
+  refine minpoly.eq_of_algebra_map_eq (is_fraction_ring.injective S L)
+    (is_integral_of_is_scalar_tower hs) rfl
+end
+
+end
+
+variables [is_domain S] [no_zero_smul_divisors R S]
+
+variable [is_integrally_closed R]
+
+/-- For integrally closed rings, the minimal polynomial divides any polynomial that has the
+  integral element as root. See also `minpoly.dvd` which relaxes the assumptions on `S`
+  in exchange for stronger assumptions on `R`. -/
+theorem is_integrally_closed_dvd [nontrivial R] {s : S} (hs : is_integral R s) {p : R[X]}
+  (hp : polynomial.aeval s p = 0) : minpoly R s ∣ p :=
+begin
+  let K := fraction_ring R,
+    let L := fraction_ring S,
+    have : minpoly K (algebra_map S L s) ∣ map (algebra_map R K) (p %ₘ (minpoly R s)),
+    { rw [map_mod_by_monic _ (minpoly.monic hs), mod_by_monic_eq_sub_mul_div],
+      refine dvd_sub (minpoly.dvd K (algebra_map S L s) _) _,
+      rw [← map_aeval_eq_aeval_map, hp, map_zero],
+      rw [← is_scalar_tower.algebra_map_eq, ← is_scalar_tower.algebra_map_eq],
+
+      apply dvd_mul_of_dvd_left,
+      rw is_integrally_closed_eq_field_fractions K L hs,
+
+      exact monic.map _ (minpoly.monic hs) },
+    rw [is_integrally_closed_eq_field_fractions _ _ hs, map_dvd_map (algebra_map R K)
+      (is_fraction_ring.injective R K) (minpoly.monic hs)] at this,
+    rw [← dvd_iff_mod_by_monic_eq_zero (minpoly.monic hs)],
+    refine polynomial.eq_zero_of_dvd_of_degree_lt this
+      (degree_mod_by_monic_lt p $ minpoly.monic hs),
+      all_goals { apply_instance }
+end
+
+theorem is_integrally_closed_dvd_iff [nontrivial R] {s : S} (hs : is_integral R s) (p : R[X]) :
+  polynomial.aeval s p = 0 ↔  minpoly R s ∣ p :=
+⟨λ hp, is_integrally_closed_dvd hs hp, λ hp, by simpa only [ring_hom.mem_ker, ring_hom.coe_comp,
+  coe_eval_ring_hom, coe_map_ring_hom, function.comp_app, eval_map, ← aeval_def] using
+    aeval_eq_zero_of_dvd_aeval_eq_zero hp (minpoly.aeval R s)⟩
+
+lemma ker_eval {s : S} (hs : is_integral R s) :
+  ((polynomial.aeval s).to_ring_hom : R[X] →+* S).ker = ideal.span ({minpoly R s} : set R[X] ):=
+by ext p ; simp_rw [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom,
+  is_integrally_closed_dvd_iff hs, ← ideal.mem_span_singleton]
+
+/-- If an element `x` is a root of a nonzero polynomial `p`, then the degree of `p` is at least the
+degree of the minimal polynomial of `x`. See also `minpoly.degree_le_of_ne_zero` which relaxes the
+assumptions on `S` in exchange for stronger assumptions on `R`. -/
+lemma is_integrally_closed.degree_le_of_ne_zero {s : S} (hs : is_integral R s) {p : R[X]}
+  (hp0 : p ≠ 0) (hp : polynomial.aeval s p = 0) : degree (minpoly R s) ≤ degree p :=
+begin
+  rw [degree_eq_nat_degree (minpoly.ne_zero hs), degree_eq_nat_degree hp0],
+  norm_cast,
+  exact nat_degree_le_of_dvd ((is_integrally_closed_dvd_iff hs _).mp hp) hp0
+end
+
+/-- The minimal polynomial of an element `x` is uniquely characterized by its defining property:
+if there is another monic polynomial of minimal degree that has `x` as a root, then this polynomial
+is equal to the minimal polynomial of `x`. See also `minpoly.unique` which relaxes the
+assumptions on `S` in exchange for stronger assumptions on `R`. -/
+lemma is_integrally_closed.minpoly.unique {s : S} {P : R[X]} (hmo : P.monic)
+  (hP : polynomial.aeval s P = 0)
+  (Pmin : ∀ Q : R[X], Q.monic → polynomial.aeval s Q = 0 → degree P ≤ degree Q) :
+  P = minpoly R s :=
+begin
+  have hs : is_integral R s := ⟨P, hmo, hP⟩,
+  symmetry, apply eq_of_sub_eq_zero,
+  by_contra hnz,
+  have := is_integrally_closed.degree_le_of_ne_zero hs hnz (by simp [hP]),
+  contrapose! this,
+  refine degree_sub_lt _ (ne_zero hs) _,
+  { exact le_antisymm (min R s hmo hP)
+      (Pmin (minpoly R s) (monic hs) (aeval R s)) },
+  { rw [(monic hs).leading_coeff, hmo.leading_coeff] }
+end
+
+theorem prime_of_is_integrally_closed {x : S} (hx : is_integral R x) :
+  _root_.prime (minpoly R x) :=
+begin
+  refine ⟨(minpoly.monic hx).ne_zero, ⟨by by_contra h_contra ;
+    exact (ne_of_lt (minpoly.degree_pos hx)) (degree_eq_zero_of_is_unit h_contra).symm,
+      λ a b h, or_iff_not_imp_left.mpr (λ h', _)⟩⟩,
+  rw ← minpoly.is_integrally_closed_dvd_iff hx at ⊢ h' h,
+  rw aeval_mul at h,
+  exact eq_zero_of_ne_zero_of_mul_left_eq_zero h' h,
+end
+
+section adjoin_root
+
+noncomputable theory
+
+open algebra polynomial adjoin_root
+
+variables {R} {x : S}
+
+lemma to_adjoin.injective (hx : is_integral R x) :
+  function.injective (minpoly.to_adjoin R x) :=
+begin
+  refine (injective_iff_map_eq_zero _).2 (λ P₁ hP₁, _),
+  obtain ⟨P, hP⟩ := mk_surjective (minpoly.monic hx) P₁,
+  by_cases hPzero : P = 0,
+  { simpa [hPzero] using hP.symm },
+  rw [← hP, minpoly.to_adjoin_apply', lift_hom_mk,  ← subalgebra.coe_eq_zero,
+    aeval_subalgebra_coe, set_like.coe_mk, is_integrally_closed_dvd_iff hx] at hP₁,
+  obtain ⟨Q, hQ⟩ := hP₁,
+  rw [← hP, hQ, ring_hom.map_mul, mk_self, zero_mul],
+end
+
+/-- The algebra isomorphism `adjoin_root (minpoly R x) ≃ₐ[R] adjoin R x` -/
+@[simps] def equiv_adjoin (hx : is_integral R x) :
+  adjoin_root (minpoly R x) ≃ₐ[R] adjoin R ({x} : set S) :=
+alg_equiv.of_bijective (minpoly.to_adjoin R x)
+  ⟨minpoly.to_adjoin.injective hx, minpoly.to_adjoin.surjective R x⟩
+
+/-- The `power_basis` of `adjoin R {x}` given by `x`. See `algebra.adjoin.power_basis` for a version
+over a field. -/
+@[simps] def _root_.algebra.adjoin.power_basis' (hx : is_integral R x) :
+  power_basis R (algebra.adjoin R ({x} : set S)) :=
+power_basis.map (adjoin_root.power_basis' (minpoly.monic hx)) (minpoly.equiv_adjoin hx)
+
+/-- The power basis given by `x` if `B.gen ∈ adjoin R {x}`. -/
+@[simps] noncomputable def _root_.power_basis.of_gen_mem_adjoin' (B : power_basis R S)
+  (hint : is_integral R x) (hx : B.gen ∈ adjoin R ({x} : set S)) :
+  power_basis R S :=
+(algebra.adjoin.power_basis' hint).map $
+  (subalgebra.equiv_of_eq _ _ $ power_basis.adjoin_eq_top_of_gen_mem_adjoin hx).trans
+  subalgebra.top_equiv
+
+end adjoin_root
+
+end minpoly
diff --git a/src/field_theory/mv_polynomial.lean b/src/field_theory/mv_polynomial.lean
index 8627c5c743ac0..93d2ee62db8d8 100644
--- a/src/field_theory/mv_polynomial.lean
+++ b/src/field_theory/mv_polynomial.lean
@@ -4,11 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 
+import data.mv_polynomial.comm_ring
+import linear_algebra.dimension
+import ring_theory.ideal.quotient
 import ring_theory.mv_polynomial.basic
 
 /-!
 # Multivariate polynomials over fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains basic facts about multivariate polynomials over fields, for example that the
 dimension of the space of multivariate polynomials over a field is equal to the cardinality of
 finitely supported functions from the indexing set to `ℕ`.
@@ -47,7 +53,7 @@ variables {σ : Type u} {K : Type u} [field K]
 
 open_locale classical
 
-lemma dim_mv_polynomial : module.rank K (mv_polynomial σ K) = cardinal.mk (σ →₀ ℕ) :=
-by rw [← cardinal.lift_inj, ← (basis_monomials σ K).mk_eq_dim]
+lemma rank_mv_polynomial : module.rank K (mv_polynomial σ K) = cardinal.mk (σ →₀ ℕ) :=
+by rw [← cardinal.lift_inj, ← (basis_monomials σ K).mk_eq_rank]
 
 end mv_polynomial
diff --git a/src/field_theory/normal.lean b/src/field_theory/normal.lean
index 4a1e33c1053b4..0ffe508f3c704 100644
--- a/src/field_theory/normal.lean
+++ b/src/field_theory/normal.lean
@@ -12,6 +12,9 @@ import ring_theory.power_basis
 /-!
 # Normal field extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define normal field extensions and prove that for a finite extension, being normal
 is the same as being a splitting field (`normal.of_is_splitting_field` and
 `normal.exists_is_splitting_field`).
@@ -30,24 +33,25 @@ open polynomial is_scalar_tower
 
 variables (F K : Type*) [field F] [field K] [algebra F K]
 
---TODO(Commelin): refactor normal to extend `is_algebraic`??
-
 /-- Typeclass for normal field extension: `K` is a normal extension of `F` iff the minimal
 polynomial of every element `x` in `K` splits in `K`, i.e. every conjugate of `x` is in `K`. -/
 class normal : Prop :=
-(is_integral' (x : K) : is_integral F x)
+(is_algebraic' : algebra.is_algebraic F K)
 (splits' (x : K) : splits (algebra_map F K) (minpoly F x))
 
 variables {F K}
 
-theorem normal.is_integral (h : normal F K) (x : K) : is_integral F x := normal.is_integral' x
+theorem normal.is_algebraic (h : normal F K) (x : K) : is_algebraic F x := normal.is_algebraic' x
+
+theorem normal.is_integral (h : normal F K) (x : K) : is_integral F x :=
+is_algebraic_iff_is_integral.mp (h.is_algebraic x)
 
 theorem normal.splits (h : normal F K) (x : K) :
   splits (algebra_map F K) (minpoly F x) := normal.splits' x
 
 theorem normal_iff : normal F K ↔
   ∀ x : K, is_integral F x ∧ splits (algebra_map F K) (minpoly F x) :=
-⟨λ h x, ⟨h.is_integral x, h.splits x⟩, λ h, ⟨λ x, (h x).1, λ x, (h x).2⟩⟩
+⟨λ h x, ⟨h.is_integral x, h.splits x⟩, λ h, ⟨λ x, (h x).1.is_algebraic F, λ x, (h x).2⟩⟩
 
 theorem normal.out : normal F K →
   ∀ x : K, is_integral F x ∧ splits (algebra_map F K) (minpoly F x) := normal_iff.1
@@ -55,7 +59,7 @@ theorem normal.out : normal F K →
 variables (F K)
 
 instance normal_self : normal F F :=
-⟨λ x, is_integral_algebra_map, λ x, by { rw minpoly.eq_X_sub_C', exact splits_X_sub_C _ }⟩
+⟨λ x, is_integral_algebra_map.is_algebraic F, λ x, (minpoly.eq_X_sub_C' x).symm ▸ splits_X_sub_C _⟩
 
 variables {K}
 
@@ -67,10 +71,10 @@ begin
   let s := basis.of_vector_space F K,
   refine ⟨∏ x, minpoly F (s x),
     splits_prod _ $ λ x hx, h.splits (s x),
-    subalgebra.to_submodule_injective _⟩,
+    subalgebra.to_submodule.injective _⟩,
   rw [algebra.top_to_submodule, eq_top_iff, ← s.span_eq, submodule.span_le, set.range_subset_iff],
   refine λ x, algebra.subset_adjoin (multiset.mem_to_finset.mpr $
-    (mem_roots $ mt (map_eq_zero $ algebra_map F K).1 $
+    (mem_roots $ mt (polynomial.map_eq_zero $ algebra_map F K).1 $
     finset.prod_ne_zero_iff.2 $ λ x hx, _).2 _),
   { exact minpoly.ne_zero (h.is_integral (s x)) },
   rw [is_root.def, eval_map, ← aeval_def, alg_hom.map_prod],
@@ -85,7 +89,7 @@ lemma normal.tower_top_of_normal [h : normal F E] : normal K E :=
 normal_iff.2 $ λ x, begin
   cases h.out x with hx hhx,
   rw algebra_map_eq F K E at hhx,
-  exact ⟨is_integral_of_is_scalar_tower x hx, polynomial.splits_of_splits_of_dvd (algebra_map K E)
+  exact ⟨is_integral_of_is_scalar_tower hx, polynomial.splits_of_splits_of_dvd (algebra_map K E)
     (polynomial.map_ne_zero (minpoly.ne_zero hx))
     ((polynomial.splits_map_iff (algebra_map F K) (algebra_map K E)).mpr hhx)
     (minpoly.dvd_map_of_is_scalar_tower F K x)⟩,
@@ -95,12 +99,11 @@ lemma alg_hom.normal_bijective [h : normal F E] (ϕ : E →ₐ[F] K) : function.
 ⟨ϕ.to_ring_hom.injective, λ x, by
 { letI : algebra E K := ϕ.to_ring_hom.to_algebra,
   obtain ⟨h1, h2⟩ := h.out (algebra_map K E x),
-  cases minpoly.mem_range_of_degree_eq_one E x (or.resolve_left h2 (minpoly.ne_zero h1)
-    (minpoly.irreducible (is_integral_of_is_scalar_tower x
+  cases minpoly.mem_range_of_degree_eq_one E x (h2.def.resolve_left (minpoly.ne_zero h1)
+    (minpoly.irreducible (is_integral_of_is_scalar_tower
       ((is_integral_algebra_map_iff (algebra_map K E).injective).mp h1)))
     (minpoly.dvd E x ((algebra_map K E).injective (by
-    { rw [ring_hom.map_zero, aeval_map, ←is_scalar_tower.to_alg_hom_apply F K E,
-          ←alg_hom.comp_apply, ←aeval_alg_hom],
+    { rw [ring_hom.map_zero, aeval_map_algebra_map, ← aeval_algebra_map_apply],
       exact minpoly.aeval F (algebra_map K E x) })))) with y hy,
   exact ⟨y, hy⟩ }⟩
 
@@ -109,7 +112,7 @@ variables {F} {E} {E' : Type*} [field E'] [algebra F E']
 lemma normal.of_alg_equiv [h : normal F E] (f : E ≃ₐ[F] E') : normal F E' :=
 normal_iff.2 $ λ x, begin
   cases h.out (f.symm x) with hx hhx,
-  have H := is_integral_alg_hom f.to_alg_hom hx,
+  have H := map_is_integral f.to_alg_hom hx,
   rw [alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom, alg_equiv.apply_symm_apply] at H,
   use H,
   apply polynomial.splits_of_splits_of_dvd (algebra_map F E') (minpoly.ne_zero hx),
@@ -124,35 +127,42 @@ end
 lemma alg_equiv.transfer_normal (f : E ≃ₐ[F] E') : normal F E ↔ normal F E' :=
 ⟨λ h, by exactI normal.of_alg_equiv f, λ h, by exactI normal.of_alg_equiv f.symm⟩
 
-lemma normal.of_is_splitting_field (p : F[X]) [hFEp : is_splitting_field F E p] :
-  normal F E :=
+-- seems to be causing a diamond in the below proof
+-- however, this may be a fluke and the proof below uses non-canonical `algebra` instances:
+-- when I replaced all the instances inside the proof with the "canonical" instances we have,
+-- I had the (unprovable) goal (of the form) `adjoin_root.mk f (C x) = adjoin_root.mk f X`
+-- for some `x, f`. So maybe this is indeed the correct approach and rewriting this proof is
+-- salient in the future, or at least taking a closer look at the algebra instances it uses.
+local attribute [-instance] adjoin_root.has_smul
+
+lemma normal.of_is_splitting_field (p : F[X]) [hFEp : is_splitting_field F E p] : normal F E :=
 begin
-  by_cases hp : p = 0,
-  { haveI : is_splitting_field F F p, { rw hp, exact ⟨splits_zero _, subsingleton.elim _ _⟩ },
-    exactI (alg_equiv.transfer_normal ((is_splitting_field.alg_equiv F p).trans
-      (is_splitting_field.alg_equiv E p).symm)).mp (normal_self F) },
+  unfreezingI { rcases eq_or_ne p 0 with rfl | hp },
+  { have := hFEp.adjoin_root_set,
+    simp only [root_set_zero, algebra.adjoin_empty] at this,
+    exact normal.of_alg_equiv (alg_equiv.of_bijective (algebra.of_id F E)
+      (algebra.bijective_algebra_map_iff.2 this.symm)) },
   refine normal_iff.2 (λ x, _),
-  haveI hFE : finite_dimensional F E := is_splitting_field.finite_dimensional E p,
+  have hFE : finite_dimensional F E := is_splitting_field.finite_dimensional E p,
   have Hx : is_integral F x := is_integral_of_noetherian (is_noetherian.iff_fg.2 hFE) x,
   refine ⟨Hx, or.inr _⟩,
   rintros q q_irred ⟨r, hr⟩,
   let D := adjoin_root q,
+  haveI := fact.mk q_irred,
   let pbED := adjoin_root.power_basis q_irred.ne_zero,
   haveI : finite_dimensional E D := power_basis.finite_dimensional pbED,
-  have finrankED : finite_dimensional.finrank E D = q.nat_degree := power_basis.finrank pbED,
-  letI : algebra F D := ring_hom.to_algebra ((algebra_map E D).comp (algebra_map F E)),
-  haveI : is_scalar_tower F E D := of_algebra_map_eq (λ _, rfl),
+  have finrankED : finite_dimensional.finrank E D = q.nat_degree,
+  { rw [power_basis.finrank pbED, adjoin_root.power_basis_dim] },
   haveI : finite_dimensional F D := finite_dimensional.trans F E D,
-  suffices : nonempty (D →ₐ[F] E),
-  { cases this with ϕ,
-    rw [←with_bot.coe_one, degree_eq_iff_nat_degree_eq q_irred.ne_zero, ←finrankED],
+  rsuffices ⟨ϕ⟩ : nonempty (D →ₐ[F] E),
+  { rw [←with_bot.coe_one, degree_eq_iff_nat_degree_eq q_irred.ne_zero, ←finrankED],
     have nat_lemma : ∀ a b c : ℕ, a * b = c → c ≤ a → 0 < c → b = 1,
     { intros a b c h1 h2 h3, nlinarith },
     exact nat_lemma _ _ _ (finite_dimensional.finrank_mul_finrank F E D)
       (linear_map.finrank_le_finrank_of_injective (show function.injective ϕ.to_linear_map,
         from ϕ.to_ring_hom.injective)) finite_dimensional.finrank_pos, },
   let C := adjoin_root (minpoly F x),
-  have Hx_irred := minpoly.irreducible Hx,
+  haveI Hx_irred := fact.mk (minpoly.irreducible Hx),
   letI : algebra C D := ring_hom.to_algebra (adjoin_root.lift
     (algebra_map F D) (adjoin_root.root q) (by rw [algebra_map_eq F E D, ←eval₂_map, hr,
       adjoin_root.algebra_map_eq, eval₂_mul, adjoin_root.eval₂_root, zero_mul])),
@@ -179,41 +189,75 @@ begin
   rw [←intermediate_field.to_subalgebra_le_to_subalgebra, intermediate_field.top_to_subalgebra],
   apply ge_trans (intermediate_field.algebra_adjoin_le_adjoin C S),
   suffices : (algebra.adjoin C S).restrict_scalars F
-           = (algebra.adjoin E {adjoin_root.root q}).restrict_scalars F,
+            = (algebra.adjoin E {adjoin_root.root q}).restrict_scalars F,
   { rw [adjoin_root.adjoin_root_eq_top, subalgebra.restrict_scalars_top,
       ←@subalgebra.restrict_scalars_top F C] at this,
     exact top_le_iff.mpr (subalgebra.restrict_scalars_injective F this) },
   dsimp only [S],
   rw [←finset.image_to_finset, finset.coe_image],
   apply eq.trans (algebra.adjoin_res_eq_adjoin_res F E C D
-    hFEp.adjoin_roots adjoin_root.adjoin_root_eq_top),
+    hFEp.adjoin_root_set adjoin_root.adjoin_root_eq_top),
   rw [set.image_singleton, ring_hom.algebra_map_to_algebra, adjoin_root.lift_root]
 end
 
-instance (p : F[X]) : normal F p.splitting_field := normal.of_is_splitting_field p
-
 end normal_tower
 
-variables {F} {K} (ϕ ψ : K →ₐ[F] K) (χ ω : K ≃ₐ[F] K)
+namespace intermediate_field
+
+/-- A compositum of normal extensions is normal -/
+instance normal_supr {ι : Type*} (t : ι → intermediate_field F K) [h : ∀ i, normal F (t i)] :
+  normal F (⨆ i, t i : intermediate_field F K) :=
+begin
+  refine ⟨is_algebraic_supr (λ i, (h i).1), λ x, _⟩,
+  obtain ⟨s, hx⟩ := exists_finset_of_mem_supr'' (λ i, (h i).1) x.2,
+  let E : intermediate_field F K := ⨆ i ∈ s, adjoin F ((minpoly F (i.2 : _)).root_set K),
+  have hF : normal F E,
+  { apply normal.of_is_splitting_field (∏ i in s, minpoly F i.2),
+    refine is_splitting_field_supr _ (λ i hi, adjoin_root_set_is_splitting_field _),
+    { exact finset.prod_ne_zero_iff.mpr (λ i hi, minpoly.ne_zero ((h i.1).is_integral i.2)) },
+    { exact polynomial.splits_comp_of_splits _ (algebra_map (t i.1) K) ((h i.1).splits i.2) } },
+  have hE : E ≤ ⨆ i, t i,
+  { refine supr_le (λ i, supr_le (λ hi, le_supr_of_le i.1 _)),
+    rw [adjoin_le_iff, ←image_root_set ((h i.1).splits i.2) (t i.1).val],
+    exact λ _ ⟨a, _, h⟩, h ▸ a.2 },
+  have := hF.splits ⟨x, hx⟩,
+  rw [minpoly_eq, subtype.coe_mk, ←minpoly_eq] at this,
+  exact polynomial.splits_comp_of_splits _ (inclusion hE).to_ring_hom this,
+end
+
+variables {F K} {L : Type*} [field L] [algebra F L] [algebra K L] [is_scalar_tower F K L]
+
+@[simp] lemma restrict_scalars_normal {E : intermediate_field K L} :
+  normal F (E.restrict_scalars F) ↔ normal F E :=
+iff.rfl
+
+end intermediate_field
+
+variables {F} {K} {K₁ K₂ K₃:Type*} [field K₁] [field K₂] [field K₃]
+ [algebra F K₁] [algebra F K₂] [algebra F K₃]
+ (ϕ : K₁ →ₐ[F] K₂) (χ : K₁ ≃ₐ[F] K₂) (ψ : K₂ →ₐ[F] K₃) (ω : K₂ ≃ₐ[F] K₃)
+
 
 section restrict
 
-variables (E : Type*) [field E] [algebra F E] [algebra E K] [is_scalar_tower F E K]
+variables (E : Type*) [field E] [algebra F E] [algebra E K₁] [algebra E K₂] [algebra E K₃]
+[is_scalar_tower F E K₁] [is_scalar_tower F E K₂] [is_scalar_tower F E K₃]
 
 /-- Restrict algebra homomorphism to image of normal subfield -/
 def alg_hom.restrict_normal_aux [h : normal F E] :
-  (to_alg_hom F E K).range →ₐ[F] (to_alg_hom F E K).range :=
+  (to_alg_hom F E K₁).range →ₐ[F] (to_alg_hom F E K₂).range :=
 { to_fun := λ x, ⟨ϕ x, by
-  { suffices : (to_alg_hom F E K).range.map ϕ ≤ _,
+  { suffices : (to_alg_hom F E K₁).range.map ϕ ≤ _,
     { exact this ⟨x, subtype.mem x, rfl⟩ },
     rintros x ⟨y, ⟨z, hy⟩, hx⟩,
     rw [←hx, ←hy],
     apply minpoly.mem_range_of_degree_eq_one E,
-    exact or.resolve_left (h.splits z) (minpoly.ne_zero (h.is_integral z))
-      (minpoly.irreducible $ is_integral_of_is_scalar_tower _ $
-        is_integral_alg_hom ϕ $ is_integral_alg_hom _ $ h.is_integral z)
-      (minpoly.dvd E _ $ by rw [aeval_map, aeval_alg_hom, aeval_alg_hom, alg_hom.comp_apply,
-        alg_hom.comp_apply, minpoly.aeval, alg_hom.map_zero, alg_hom.map_zero]) }⟩,
+    refine or.resolve_left (h.splits z).def (minpoly.ne_zero (h.is_integral z))
+      (minpoly.irreducible _) (minpoly.dvd E _ (by simp [aeval_alg_hom_apply])),
+    simp only [alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom],
+    suffices : is_integral F _,
+    { exact is_integral_of_is_scalar_tower this },
+    exact map_is_integral ϕ (map_is_integral (to_alg_hom F E K₁) (h.is_integral z)) }⟩,
   map_zero' := subtype.ext ϕ.map_zero,
   map_one' := subtype.ext ϕ.map_one,
   map_add' := λ x y, subtype.ext (ϕ.map_add x y),
@@ -222,100 +266,194 @@ def alg_hom.restrict_normal_aux [h : normal F E] :
 
 /-- Restrict algebra homomorphism to normal subfield -/
 def alg_hom.restrict_normal [normal F E] : E →ₐ[F] E :=
-((alg_equiv.of_injective_field (is_scalar_tower.to_alg_hom F E K)).symm.to_alg_hom.comp
+((alg_equiv.of_injective_field (is_scalar_tower.to_alg_hom F E K₂)).symm.to_alg_hom.comp
   (ϕ.restrict_normal_aux E)).comp
-    (alg_equiv.of_injective_field (is_scalar_tower.to_alg_hom F E K)).to_alg_hom
+    (alg_equiv.of_injective_field (is_scalar_tower.to_alg_hom F E K₁)).to_alg_hom
+
+/-- Restrict algebra homomorphism to normal subfield (`alg_equiv` version) -/
+def alg_hom.restrict_normal' [normal F E] : E ≃ₐ[F] E :=
+alg_equiv.of_bijective (alg_hom.restrict_normal ϕ E) (alg_hom.normal_bijective F E E _)
 
 @[simp] lemma alg_hom.restrict_normal_commutes [normal F E] (x : E) :
-  algebra_map E K (ϕ.restrict_normal E x) = ϕ (algebra_map E K x) :=
+  algebra_map E K₂ (ϕ.restrict_normal E x) = ϕ (algebra_map E K₁ x) :=
 subtype.ext_iff.mp (alg_equiv.apply_symm_apply (alg_equiv.of_injective_field
-  (is_scalar_tower.to_alg_hom F E K)) (ϕ.restrict_normal_aux E
-    ⟨is_scalar_tower.to_alg_hom F E K x, x, rfl⟩))
+  (is_scalar_tower.to_alg_hom F E K₂)) (ϕ.restrict_normal_aux E
+    ⟨is_scalar_tower.to_alg_hom F E K₁ x, x, rfl⟩))
 
 lemma alg_hom.restrict_normal_comp [normal F E] :
-  (ϕ.restrict_normal E).comp (ψ.restrict_normal E) = (ϕ.comp ψ).restrict_normal E :=
-alg_hom.ext (λ _, (algebra_map E K).injective
+  (ψ.restrict_normal E).comp (ϕ.restrict_normal E) = (ψ.comp ϕ).restrict_normal E :=
+alg_hom.ext (λ _, (algebra_map E K₃).injective
   (by simp only [alg_hom.comp_apply, alg_hom.restrict_normal_commutes]))
 
+lemma alg_hom.field_range_of_normal {E : intermediate_field F K} [normal F E] (f : E →ₐ[F] K) :
+  f.field_range = E :=
+begin
+  haveI : is_scalar_tower F E E := by apply_instance,
+  let g := f.restrict_normal' E,
+  rw [←show E.val.comp ↑g = f, from fun_like.ext_iff.mpr (f.restrict_normal_commutes E),
+    ←alg_hom.map_field_range, g.field_range_eq_top, ←E.val.field_range_eq_map, E.field_range_val],
+end
+
 /-- Restrict algebra isomorphism to a normal subfield -/
 def alg_equiv.restrict_normal [h : normal F E] : E ≃ₐ[F] E :=
-alg_equiv.of_bijective (χ.to_alg_hom.restrict_normal E) (alg_hom.normal_bijective F E E _)
+alg_hom.restrict_normal' χ.to_alg_hom E
 
 @[simp] lemma alg_equiv.restrict_normal_commutes [normal F E] (x : E) :
-  algebra_map E K (χ.restrict_normal E x) = χ (algebra_map E K x) :=
+  algebra_map E K₂ (χ.restrict_normal E x) = χ (algebra_map E K₁ x) :=
 χ.to_alg_hom.restrict_normal_commutes E x
 
 lemma alg_equiv.restrict_normal_trans [normal F E] :
   (χ.trans ω).restrict_normal E = (χ.restrict_normal E).trans (ω.restrict_normal E) :=
-alg_equiv.ext (λ _, (algebra_map E K).injective
+alg_equiv.ext (λ _, (algebra_map E K₃).injective
 (by simp only [alg_equiv.trans_apply, alg_equiv.restrict_normal_commutes]))
 
+
 /-- Restriction to an normal subfield as a group homomorphism -/
-def alg_equiv.restrict_normal_hom [normal F E] : (K ≃ₐ[F] K) →* (E ≃ₐ[F] E) :=
+def alg_equiv.restrict_normal_hom [normal F E] : (K₁ ≃ₐ[F] K₁) →* (E ≃ₐ[F] E) :=
 monoid_hom.mk' (λ χ, χ.restrict_normal E) (λ ω χ, (χ.restrict_normal_trans ω E))
 
+variables (F K₁ E)
+
+/-- If `K₁/E/F` is a tower of fields with `E/F` normal then `normal.alg_hom_equiv_aut` is an
+ equivalence. -/
+@[simps] def normal.alg_hom_equiv_aut [normal F E] : (E →ₐ[F] K₁) ≃ (E ≃ₐ[F] E) :=
+{ to_fun := λ σ, alg_hom.restrict_normal' σ E,
+  inv_fun := λ σ, (is_scalar_tower.to_alg_hom F E K₁).comp σ.to_alg_hom,
+  left_inv := λ σ, begin
+    ext,
+    simp[alg_hom.restrict_normal'],
+  end,
+  right_inv := λ σ, begin
+    ext,
+    simp only [alg_hom.restrict_normal', alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_of_bijective],
+    apply no_zero_smul_divisors.algebra_map_injective E K₁,
+    rw alg_hom.restrict_normal_commutes,
+    simp,
+  end }
+
+
 end restrict
 
 section lift
 
-variables {F} {K} (E : Type*) [field E] [algebra F E] [algebra K E] [is_scalar_tower F K E]
+variables {F} {K₁ K₂} (E : Type*) [field E] [algebra F E] [algebra K₁ E] [algebra K₂ E]
+[is_scalar_tower F K₁ E] [is_scalar_tower F K₂ E]
 
-/-- If `E/K/F` is a tower of fields with `E/F` normal then we can lift
-  an algebra homomorphism `ϕ : K →ₐ[F] K` to `ϕ.lift_normal E : E →ₐ[F] E`. -/
+/-- If `E/Kᵢ/F` are towers of fields with `E/F` normal then we can lift
+  an algebra homomorphism `ϕ : K₁ →ₐ[F] K₂` to `ϕ.lift_normal E : E →ₐ[F] E`. -/
 noncomputable def alg_hom.lift_normal [h : normal F E] : E →ₐ[F] E :=
-@alg_hom.restrict_scalars F K E E _ _ _ _ _ _
-  ((is_scalar_tower.to_alg_hom F K E).comp ϕ).to_ring_hom.to_algebra _ _ _ _ $ nonempty.some $
+@alg_hom.restrict_scalars F K₁ E E _ _ _ _ _ _
+  ((is_scalar_tower.to_alg_hom F K₂ E).comp ϕ).to_ring_hom.to_algebra _ _ _ _ $ nonempty.some $
   @intermediate_field.alg_hom_mk_adjoin_splits' _ _ _ _ _ _ _
-  ((is_scalar_tower.to_alg_hom F K E).comp ϕ).to_ring_hom.to_algebra _
+  ((is_scalar_tower.to_alg_hom F K₂ E).comp ϕ).to_ring_hom.to_algebra _
   (intermediate_field.adjoin_univ _ _)
-  (λ x hx, ⟨is_integral_of_is_scalar_tower x (h.out x).1,
+  (λ x hx, ⟨is_integral_of_is_scalar_tower (h.out x).1,
     splits_of_splits_of_dvd _ (map_ne_zero (minpoly.ne_zero (h.out x).1))
     (by { rw [splits_map_iff, ←is_scalar_tower.algebra_map_eq], exact (h.out x).2 })
-    (minpoly.dvd_map_of_is_scalar_tower F K x)⟩)
+    (minpoly.dvd_map_of_is_scalar_tower F K₁ x)⟩)
 
-@[simp] lemma alg_hom.lift_normal_commutes [normal F E] (x : K) :
-  ϕ.lift_normal E (algebra_map K E x) = algebra_map K E (ϕ x) :=
-@alg_hom.commutes K E E _ _ _ _
-  ((is_scalar_tower.to_alg_hom F K E).comp ϕ).to_ring_hom.to_algebra _ x
+@[simp] lemma alg_hom.lift_normal_commutes [normal F E] (x : K₁) :
+  ϕ.lift_normal E (algebra_map K₁ E x) = algebra_map K₂ E (ϕ x) :=
+by apply @alg_hom.commutes K₁ E E _ _ _ _
 
-@[simp] lemma alg_hom.restrict_lift_normal [normal F K] [normal F E] :
-  (ϕ.lift_normal E).restrict_normal K = ϕ :=
-alg_hom.ext (λ x, (algebra_map K E).injective
-  (eq.trans (alg_hom.restrict_normal_commutes _ K x) (ϕ.lift_normal_commutes E x)))
+@[simp] lemma alg_hom.restrict_lift_normal (ϕ : K₁ →ₐ[F] K₁) [normal F K₁] [normal F E] :
+  (ϕ.lift_normal E).restrict_normal K₁ = ϕ :=
+alg_hom.ext (λ x, (algebra_map K₁ E).injective
+  (eq.trans (alg_hom.restrict_normal_commutes _ K₁ x) (ϕ.lift_normal_commutes E x)))
 
-/-- If `E/K/F` is a tower of fields with `E/F` normal then we can lift
-  an algebra isomorphism `ϕ : K ≃ₐ[F] K` to `ϕ.lift_normal E : E ≃ₐ[F] E`. -/
+/-- If `E/Kᵢ/F` are towers of fields with `E/F` normal then we can lift
+  an algebra isomorphism `ϕ : K₁ ≃ₐ[F] K₂` to `ϕ.lift_normal E : E ≃ₐ[F] E`. -/
 noncomputable def alg_equiv.lift_normal [normal F E] : E ≃ₐ[F] E :=
 alg_equiv.of_bijective (χ.to_alg_hom.lift_normal E) (alg_hom.normal_bijective F E E _)
 
-@[simp] lemma alg_equiv.lift_normal_commutes [normal F E] (x : K) :
-  χ.lift_normal E (algebra_map K E x) = algebra_map K E (χ x) :=
+@[simp] lemma alg_equiv.lift_normal_commutes [normal F E] (x : K₁) :
+  χ.lift_normal E (algebra_map K₁ E x) = algebra_map K₂ E (χ x) :=
 χ.to_alg_hom.lift_normal_commutes E x
 
-@[simp] lemma alg_equiv.restrict_lift_normal [normal F K] [normal F E] :
-  (χ.lift_normal E).restrict_normal K = χ :=
-alg_equiv.ext (λ x, (algebra_map K E).injective
-  (eq.trans (alg_equiv.restrict_normal_commutes _ K x) (χ.lift_normal_commutes E x)))
+@[simp] lemma alg_equiv.restrict_lift_normal (χ : K₁ ≃ₐ[F] K₁) [normal F K₁] [normal F E] :
+  (χ.lift_normal E).restrict_normal K₁ = χ :=
+alg_equiv.ext (λ x, (algebra_map K₁ E).injective
+  (eq.trans (alg_equiv.restrict_normal_commutes _ K₁ x) (χ.lift_normal_commutes E x)))
 
-lemma alg_equiv.restrict_normal_hom_surjective [normal F K] [normal F E] :
-  function.surjective (alg_equiv.restrict_normal_hom K : (E ≃ₐ[F] E) → (K ≃ₐ[F] K)) :=
+lemma alg_equiv.restrict_normal_hom_surjective [normal F K₁] [normal F E] :
+  function.surjective (alg_equiv.restrict_normal_hom K₁ : (E ≃ₐ[F] E) → (K₁ ≃ₐ[F] K₁)) :=
 λ χ, ⟨χ.lift_normal E, χ.restrict_lift_normal E⟩
 
-variables (F) (K) (E)
+variables (F) (K₁) (E)
 
-lemma is_solvable_of_is_scalar_tower [normal F K] [h1 : is_solvable (K ≃ₐ[F] K)]
-  [h2 : is_solvable (E ≃ₐ[K] E)] : is_solvable (E ≃ₐ[F] E) :=
+lemma is_solvable_of_is_scalar_tower [normal F K₁] [h1 : is_solvable (K₁ ≃ₐ[F] K₁)]
+  [h2 : is_solvable (E ≃ₐ[K₁] E)] : is_solvable (E ≃ₐ[F] E) :=
 begin
-  let f : (E ≃ₐ[K] E) →* (E ≃ₐ[F] E) :=
+  let f : (E ≃ₐ[K₁] E) →* (E ≃ₐ[F] E) :=
   { to_fun := λ ϕ, alg_equiv.of_alg_hom (ϕ.to_alg_hom.restrict_scalars F)
       (ϕ.symm.to_alg_hom.restrict_scalars F)
       (alg_hom.ext (λ x, ϕ.apply_symm_apply x))
       (alg_hom.ext (λ x, ϕ.symm_apply_apply x)),
     map_one' := alg_equiv.ext (λ _, rfl),
     map_mul' := λ _ _, alg_equiv.ext (λ _, rfl) },
-  refine solvable_of_ker_le_range f (alg_equiv.restrict_normal_hom K)
+  refine solvable_of_ker_le_range f (alg_equiv.restrict_normal_hom K₁)
     (λ ϕ hϕ, ⟨{commutes' := λ x, _, .. ϕ}, alg_equiv.ext (λ _, rfl)⟩),
-  exact (eq.trans (ϕ.restrict_normal_commutes K x).symm (congr_arg _ (alg_equiv.ext_iff.mp hϕ x))),
+  exact (eq.trans (ϕ.restrict_normal_commutes K₁ x).symm (congr_arg _ (alg_equiv.ext_iff.mp hϕ x))),
 end
 
 end lift
+
+section normal_closure
+
+open intermediate_field
+
+variables (F K) (L : Type*) [field L] [algebra F L] [algebra K L] [is_scalar_tower F K L]
+
+/-- The normal closure of `K` in `L`. -/
+noncomputable! def normal_closure : intermediate_field K L :=
+{ algebra_map_mem' := λ r, le_supr (λ f : K →ₐ[F] L, f.field_range)
+    (is_scalar_tower.to_alg_hom F K L) ⟨r, rfl⟩,
+  .. (⨆ f : K →ₐ[F] L, f.field_range).to_subfield }
+
+namespace normal_closure
+
+lemma restrict_scalars_eq_supr_adjoin [h : normal F L] :
+  (normal_closure F K L).restrict_scalars F = ⨆ x : K, adjoin F ((minpoly F x).root_set L) :=
+begin
+  refine le_antisymm (supr_le _) (supr_le (λ x, adjoin_le_iff.mpr (λ y hy, _))),
+  { rintros f _ ⟨x, rfl⟩,
+    refine le_supr (λ x, adjoin F ((minpoly F x).root_set L)) x
+      (subset_adjoin F ((minpoly F x).root_set L) _),
+    rw [mem_root_set_of_ne, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom,
+        polynomial.aeval_alg_hom_apply, minpoly.aeval, map_zero],
+    exact minpoly.ne_zero ((is_integral_algebra_map_iff (algebra_map K L).injective).mp
+      (h.is_integral (algebra_map K L x))) },
+  { rw [polynomial.root_set, finset.mem_coe, multiset.mem_to_finset] at hy,
+    let g := (alg_hom_adjoin_integral_equiv F ((is_integral_algebra_map_iff
+      (algebra_map K L).injective).mp (h.is_integral (algebra_map K L x)))).symm ⟨y, hy⟩,
+    refine le_supr (λ f : K →ₐ[F] L, f.field_range)
+      ((g.lift_normal L).comp (is_scalar_tower.to_alg_hom F K L))
+      ⟨x, (g.lift_normal_commutes L (adjoin_simple.gen F x)).trans _⟩,
+    rw [algebra.id.map_eq_id, ring_hom.id_apply],
+    apply power_basis.lift_gen },
+end
+
+instance normal [h : normal F L] : normal F (normal_closure F K L) :=
+let ϕ := algebra_map K L in begin
+  rw [←intermediate_field.restrict_scalars_normal, restrict_scalars_eq_supr_adjoin],
+  apply intermediate_field.normal_supr F L _,
+  intro x,
+  apply normal.of_is_splitting_field (minpoly F x),
+  exact adjoin_root_set_is_splitting_field ((minpoly.eq_of_algebra_map_eq ϕ.injective
+    ((is_integral_algebra_map_iff ϕ.injective).mp (h.is_integral (ϕ x))) rfl).symm ▸ h.splits _),
+end
+
+instance is_finite_dimensional [finite_dimensional F K] :
+  finite_dimensional F (normal_closure F K L) :=
+begin
+  haveI : ∀ f : K →ₐ[F] L, finite_dimensional F f.field_range :=
+  λ f, f.to_linear_map.finite_dimensional_range,
+  apply intermediate_field.finite_dimensional_supr_of_finite,
+end
+
+instance is_scalar_tower : is_scalar_tower F (normal_closure F K L) L :=
+is_scalar_tower.subalgebra' F L L _
+
+end normal_closure
+
+end normal_closure
diff --git a/src/field_theory/perfect_closure.lean b/src/field_theory/perfect_closure.lean
index e361fc5837101..fd21739bf06bc 100644
--- a/src/field_theory/perfect_closure.lean
+++ b/src/field_theory/perfect_closure.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Yury Kudryashov
 -/
 import algebra.char_p.basic
-import algebra.group_with_zero.power
 import algebra.hom.iterate
 import algebra.ring.equiv
 
 /-!
 # The perfect closure of a field
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 universes u v
@@ -224,6 +226,7 @@ end)⟩
 instance : has_zero (perfect_closure K p) := ⟨mk K p (0, 0)⟩
 
 lemma zero_def : (0 : perfect_closure K p) = mk K p (0, 0) := rfl
+@[simp] lemma mk_zero_zero : mk K p (0, 0) = 0 := rfl
 
 theorem mk_zero (n : ℕ) : mk K p (n, 0) = 0 :=
 by induction n with n ih; [refl, rw ← ih]; symmetry; apply quot.sound;
@@ -234,7 +237,7 @@ theorem r.sound (m n : ℕ) (x y : K) (H : frobenius K p^[m] x = y) :
 by subst H; induction m with m ih; [simp only [zero_add, iterate_zero_apply],
   rw [ih, nat.succ_add, iterate_succ']]; apply quot.sound; apply r.intro
 
-instance : comm_ring (perfect_closure K p) :=
+instance : add_comm_group (perfect_closure K p) :=
 { add_assoc := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
     quot.induction_on g $ λ ⟨s, z⟩, congr_arg (quot.mk _) $
     by simp only [ring_hom.iterate_map_add, ← iterate_add_apply, add_assoc, add_comm s _],
@@ -249,7 +252,11 @@ instance : comm_ring (perfect_closure K p) :=
       ring_hom.iterate_map_neg, add_left_neg, mk_zero]),
   add_comm := λ e f, quot.induction_on e (λ ⟨m, x⟩, quot.induction_on f (λ ⟨n, y⟩,
     congr_arg (quot.mk _) $ by simp only [add_comm])),
-  left_distrib := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
+  .. (infer_instance : has_add (perfect_closure K p)),
+  .. (infer_instance : has_neg (perfect_closure K p)) }
+
+instance : comm_ring (perfect_closure K p) :=
+{ left_distrib := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
     quot.induction_on g $ λ ⟨s, z⟩, show quot.mk _ _ = quot.mk _ _,
     by simp only [add_assoc, add_comm, add_left_comm]; apply r.sound;
     simp only [ring_hom.iterate_map_mul, ring_hom.iterate_map_add,
@@ -259,8 +266,8 @@ instance : comm_ring (perfect_closure K p) :=
     by simp only [add_assoc, add_comm _ s, add_left_comm _ s]; apply r.sound;
     simp only [ring_hom.iterate_map_mul, ring_hom.iterate_map_add,
       ← iterate_add_apply, add_mul, add_comm, add_left_comm],
-  .. (infer_instance : has_add (perfect_closure K p)),
-  .. (infer_instance : has_neg (perfect_closure K p)),
+  .. perfect_closure.add_comm_group K p,
+  .. add_monoid_with_one.unary,
   .. (infer_instance : comm_monoid (perfect_closure K p)) }
 
 theorem eq_iff' (x y : ℕ × K) : mk K p x = mk K p y ↔
@@ -295,7 +302,7 @@ end
 theorem nat_cast (n x : ℕ) : (x : perfect_closure K p) = mk K p (n, x) :=
 begin
   induction n with n ih,
-  { induction x with x ih, {refl},
+  { induction x with x ih, {simp},
     rw [nat.cast_succ, nat.cast_succ, ih], refl },
   rw ih, apply quot.sound,
   conv {congr, skip, skip, rw ← frobenius_nat_cast K p x},
@@ -361,7 +368,7 @@ variables [field K] (p : ℕ) [fact p.prime] [char_p K p]
 
 instance : has_inv (perfect_closure K p) :=
 ⟨quot.lift (λ x:ℕ×K, quot.mk (r K p) (x.1, x.2⁻¹)) (λ x y (H : r K p x y), match x, y, H with
-| _, _, r.intro n x := quot.sound $ by { simp only [frobenius_def], rw ← inv_pow₀, apply r.intro }
+| _, _, r.intro n x := quot.sound $ by { simp only [frobenius_def], rw ← inv_pow, apply r.intro }
 end)⟩
 
 instance : field (perfect_closure K p) :=
diff --git a/src/field_theory/polynomial_galois_group.lean b/src/field_theory/polynomial_galois_group.lean
index dd73712774cc3..d522d1b6ba71f 100644
--- a/src/field_theory/polynomial_galois_group.lean
+++ b/src/field_theory/polynomial_galois_group.lean
@@ -3,14 +3,16 @@ Copyright (c) 2020 Thomas Browning, Patrick Lutz. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning, Patrick Lutz
 -/
-
-import group_theory.perm.cycle_type
 import analysis.complex.polynomial
 import field_theory.galois
+import group_theory.perm.cycle.type
 
 /-!
 # Galois Groups of Polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we introduce the Galois group of a polynomial `p` over a field `F`,
 defined as the automorphism group of its splitting field. We also provide
 some results about some extension `E` above `p.splitting_field`, and some specific
@@ -40,7 +42,7 @@ equals the number of real roots plus the number of roots not fixed by complex co
 -/
 
 noncomputable theory
-open_locale classical polynomial
+open_locale polynomial
 
 open finite_dimensional
 
@@ -57,11 +59,14 @@ namespace gal
 instance : has_coe_to_fun p.gal (λ _, p.splitting_field → p.splitting_field) :=
 alg_equiv.has_coe_to_fun
 
+instance apply_mul_semiring_action : mul_semiring_action p.gal p.splitting_field :=
+alg_equiv.apply_mul_semiring_action
+
 @[ext] lemma ext {σ τ : p.gal} (h : ∀ x ∈ p.root_set p.splitting_field, σ x = τ x) : σ = τ :=
 begin
   refine alg_equiv.ext (λ x, (alg_hom.mem_equalizer σ.to_alg_hom τ.to_alg_hom x).mp
       ((set_like.ext_iff.mp _ x).mpr algebra.mem_top)),
-  rwa [eq_top_iff, ←splitting_field.adjoin_roots, algebra.adjoin_le_iff],
+  rwa [eq_top_iff, ←splitting_field.adjoin_root_set, algebra.adjoin_le_iff],
 end
 
 /-- If `p` splits in `F` then the `p.gal` is trivial. -/
@@ -121,12 +126,7 @@ section roots_action
 see `polynomial.gal.map_roots_bijective`. -/
 def map_roots [fact (p.splits (algebra_map F E))] :
   root_set p p.splitting_field → root_set p E :=
-λ x, ⟨is_scalar_tower.to_alg_hom F p.splitting_field E x, begin
-  have key := subtype.mem x,
-  by_cases p = 0,
-  { simp only [h, root_set_zero] at key,
-    exact false.rec _ key },
-  { rw [mem_root_set h, aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩
+set.maps_to.restrict (is_scalar_tower.to_alg_hom F p.splitting_field E) _ _ $ root_set_maps_to _
 
 lemma map_roots_bijective [h : fact (p.splits (algebra_map F E))] :
   function.bijective (map_roots p E) :=
@@ -142,7 +142,7 @@ begin
     have hy := subtype.mem y,
     simp only [root_set, finset.mem_coe, multiset.mem_to_finset, key, multiset.mem_map] at hy,
     rcases hy with ⟨x, hx1, hx2⟩,
-    exact ⟨⟨x, multiset.mem_to_finset.mpr hx1⟩, subtype.ext hx2⟩ }
+    exact ⟨⟨x, (@multiset.mem_to_finset _ (classical.dec_eq _) _ _).mpr hx1⟩, subtype.ext hx2⟩ }
 end
 
 /-- The bijection between `root_set p p.splitting_field` and `root_set p E`. -/
@@ -151,15 +151,7 @@ def roots_equiv_roots [fact (p.splits (algebra_map F E))] :
 equiv.of_bijective (map_roots p E) (map_roots_bijective p E)
 
 instance gal_action_aux : mul_action p.gal (root_set p p.splitting_field) :=
-{ smul := λ ϕ x, ⟨ϕ x, begin
-    have key := subtype.mem x,
-    --simp only [root_set, finset.mem_coe, multiset.mem_to_finset] at *,
-    by_cases p = 0,
-    { simp only [h, root_set_zero] at key,
-      exact false.rec _ key },
-    { rw mem_root_set h,
-      change aeval (ϕ.to_alg_hom x) p = 0,
-      rw [aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩,
+{ smul := λ ϕ, set.maps_to.restrict ϕ _ _ $ root_set_maps_to ϕ.to_alg_hom,
   one_smul := λ _, by { ext, refl },
   mul_smul := λ _ _ _, by { ext, refl } }
 
@@ -186,10 +178,7 @@ variables (p E)
 
 /-- `polynomial.gal.gal_action` as a permutation representation -/
 def gal_action_hom [fact (p.splits (algebra_map F E))] : p.gal →* equiv.perm (root_set p E) :=
-{ to_fun := λ ϕ, equiv.mk (λ x, ϕ • x) (λ x, ϕ⁻¹ • x)
-  (λ x, inv_smul_smul ϕ x) (λ x, smul_inv_smul ϕ x),
-  map_one' := by { ext1 x, exact mul_action.one_smul x },
-  map_mul' := λ x y, by { ext1 z, exact mul_action.mul_smul x y z } }
+mul_action.to_perm_hom _ _
 
 lemma gal_action_hom_restrict [fact (p.splits (algebra_map F E))]
   (ϕ : E ≃ₐ[F] E) (x : root_set p E) : ↑(gal_action_hom p E (restrict p E ϕ) x) = ϕ x :=
@@ -215,12 +204,18 @@ variables {p q}
 
 /-- `polynomial.gal.restrict`, when both fields are splitting fields of polynomials. -/
 def restrict_dvd (hpq : p ∣ q) : q.gal →* p.gal :=
+by haveI := classical.dec (q = 0); exact
 if hq : q = 0 then 1 else @restrict F _ p _ _ _
   ⟨splits_of_splits_of_dvd (algebra_map F q.splitting_field) hq (splitting_field.splits q) hpq⟩
 
+lemma restrict_dvd_def [decidable (q = 0)] (hpq : p ∣ q) :
+  restrict_dvd hpq = if hq : q = 0 then 1 else @restrict F _ p _ _ _
+  ⟨splits_of_splits_of_dvd (algebra_map F q.splitting_field) hq (splitting_field.splits q) hpq⟩ :=
+by convert rfl
+
 lemma restrict_dvd_surjective (hpq : p ∣ q) (hq : q ≠ 0) :
   function.surjective (restrict_dvd hpq) :=
-by simp only [restrict_dvd, dif_neg hq, restrict_surjective]
+by classical; simp only [restrict_dvd_def, dif_neg hq, restrict_surjective]
 
 variables (p q)
 
@@ -235,22 +230,25 @@ begin
   { haveI : unique (p * q).gal, { rw hpq, apply_instance },
     exact λ f g h, eq.trans (unique.eq_default f) (unique.eq_default g).symm },
   intros f g hfg,
-  dsimp only [restrict_prod, restrict_dvd] at hfg,
+  classical,
+  simp only [restrict_prod, restrict_dvd_def] at hfg,
   simp only [dif_neg hpq, monoid_hom.prod_apply, prod.mk.inj_iff] at hfg,
   ext x hx,
-  rw [root_set, polynomial.map_mul, polynomial.roots_mul] at hx,
+  rw [root_set_def, polynomial.map_mul, polynomial.roots_mul] at hx,
   cases multiset.mem_add.mp (multiset.mem_to_finset.mp hx) with h h,
   { haveI : fact (p.splits (algebra_map F (p * q).splitting_field)) :=
       ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_right p q)⟩,
     have key : x = algebra_map (p.splitting_field) (p * q).splitting_field
-      ((roots_equiv_roots p _).inv_fun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
+      ((roots_equiv_roots p _).inv_fun ⟨x,
+        (@multiset.mem_to_finset _ (classical.dec_eq _) _ _).mpr h⟩) :=
       subtype.ext_iff.mp (equiv.apply_symm_apply (roots_equiv_roots p _) ⟨x, _⟩).symm,
     rw [key, ←alg_equiv.restrict_normal_commutes, ←alg_equiv.restrict_normal_commutes],
     exact congr_arg _ (alg_equiv.ext_iff.mp hfg.1 _) },
   { haveI : fact (q.splits (algebra_map F (p * q).splitting_field)) :=
       ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_left q p)⟩,
     have key : x = algebra_map (q.splitting_field) (p * q).splitting_field
-      ((roots_equiv_roots q _).inv_fun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
+      ((roots_equiv_roots q _).inv_fun ⟨x,
+        (@multiset.mem_to_finset _ (classical.dec_eq _) _ _).mpr h⟩) :=
       subtype.ext_iff.mp (equiv.apply_symm_apply (roots_equiv_roots q _) ⟨x, _⟩).symm,
     rw [key, ←alg_equiv.restrict_normal_commutes, ←alg_equiv.restrict_normal_commutes],
     exact congr_arg _ (alg_equiv.ext_iff.mp hfg.2 _) },
@@ -263,12 +261,12 @@ lemma mul_splits_in_splitting_field_of_mul {p₁ q₁ p₂ q₂ : F[X]}
   (p₁ * p₂).splits (algebra_map F (q₁ * q₂).splitting_field) :=
 begin
   apply splits_mul,
-  { rw ← (splitting_field.lift q₁ (splits_of_splits_of_dvd _
-      (mul_ne_zero hq₁ hq₂) (splitting_field.splits _) (dvd_mul_right q₁ q₂))).comp_algebra_map,
-    exact splits_comp_of_splits _ _ h₁, },
-  { rw ← (splitting_field.lift q₂ (splits_of_splits_of_dvd _
-      (mul_ne_zero hq₁ hq₂) (splitting_field.splits _) (dvd_mul_left q₂ q₁))).comp_algebra_map,
-    exact splits_comp_of_splits _ _ h₂, },
+  { rw ← (splitting_field.lift q₁ (splits_of_splits_of_dvd (algebra_map F (q₁ * q₂).splitting_field)
+     (mul_ne_zero hq₁ hq₂) (splitting_field.splits _) (dvd_mul_right q₁ q₂))).comp_algebra_map,
+    exact splits_comp_of_splits _ _ h₁ },
+  { rw ← (splitting_field.lift q₂ (splits_of_splits_of_dvd (algebra_map F (q₁ * q₂).splitting_field)
+     (mul_ne_zero hq₁ hq₂) (splitting_field.splits _) (dvd_mul_left q₂ q₁))).comp_algebra_map,
+    exact splits_comp_of_splits _ _ h₂ },
 end
 
 /-- `p` splits in the splitting field of `p ∘ q`, for `q` non-constant. -/
@@ -310,7 +308,9 @@ end
 
 /-- `polynomial.gal.restrict` for the composition of polynomials. -/
 def restrict_comp (hq : q.nat_degree ≠ 0) : (p.comp q).gal →* p.gal :=
-@restrict F _ p _ _ _ ⟨splits_in_splitting_field_of_comp p q hq⟩
+let h : fact (splits (algebra_map F (p.comp q).splitting_field) p) :=
+    ⟨splits_in_splitting_field_of_comp p q hq⟩ in
+@restrict F _ p _ _ _ h
 
 lemma restrict_comp_surjective (hq : q.nat_degree ≠ 0) :
   function.surjective (restrict_comp p q hq) :=
@@ -363,10 +363,9 @@ lemma card_complex_roots_eq_card_real_add_card_not_gal_inv (p : ℚ[X]) :
   (gal_action_hom p ℂ (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ))).support.card :=
 begin
   by_cases hp : p = 0,
-  { simp_rw [hp, root_set_zero, set.to_finset_eq_empty_iff.mpr rfl, finset.card_empty, zero_add],
-    refine eq.symm (nat.le_zero_iff.mp ((finset.card_le_univ _).trans (le_of_eq _))),
-    simp_rw [hp, root_set_zero, fintype.card_eq_zero_iff],
-    apply_instance },
+  { haveI : is_empty (p.root_set ℂ) := by { rw [hp, root_set_zero], apply_instance },
+    simp_rw [(gal_action_hom p ℂ _).support.eq_empty_of_is_empty, hp, root_set_zero,
+      set.to_finset_empty, finset.card_empty] },
   have inj : function.injective (is_scalar_tower.to_alg_hom ℚ ℝ ℂ) := (algebra_map ℝ ℂ).injective,
   rw [←finset.card_image_of_injective _ subtype.coe_injective,
       ←finset.card_image_of_injective _ inj],
@@ -374,11 +373,11 @@ begin
   let b : finset ℂ := _,
   let c : finset ℂ := _,
   change a.card = b.card + c.card,
-  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0 :=
-  λ z, by rw [set.mem_to_finset, mem_root_set hp],
+  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0,
+  { intro z, rw [set.mem_to_finset, mem_root_set_of_ne hp], apply_instance },
   have hb : ∀ z : ℂ, z ∈ b ↔ aeval z p = 0 ∧ z.im = 0,
   { intro z,
-    simp_rw [finset.mem_image, exists_prop, set.mem_to_finset, mem_root_set hp],
+    simp_rw [finset.mem_image, exists_prop, set.mem_to_finset, mem_root_set_of_ne hp],
     split,
     { rintros ⟨w, hw, rfl⟩,
       exact ⟨by rw [aeval_alg_hom_apply, hw, alg_hom.map_zero], rfl⟩ },
@@ -389,22 +388,23 @@ begin
     (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ)) w = w ↔ w.val.im = 0,
   { intro w,
     rw [subtype.ext_iff, gal_action_hom_restrict],
-    exact complex.eq_conj_iff_im },
+    exact complex.conj_eq_iff_im },
   have hc : ∀ z : ℂ, z ∈ c ↔ aeval z p = 0 ∧ z.im ≠ 0,
   { intro z,
     simp_rw [finset.mem_image, exists_prop],
     split,
     { rintros ⟨w, hw, rfl⟩,
-      exact ⟨(mem_root_set hp).mp w.2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩ },
+      exact ⟨(mem_root_set.mp w.2).2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩ },
     { rintros ⟨hz1, hz2⟩,
-      exact ⟨⟨z, (mem_root_set hp).mpr hz1⟩,
+      exact ⟨⟨z, mem_root_set.mpr ⟨hp, hz1⟩⟩,
         equiv.perm.mem_support.mpr (mt (hc0 _).mp hz2), rfl⟩ } },
   rw ← finset.card_disjoint_union,
   { apply congr_arg finset.card,
     simp_rw [finset.ext_iff, finset.mem_union, ha, hb, hc],
     tauto },
-  { intro z,
-    rw [finset.inf_eq_inter, finset.mem_inter, hb, hc],
+  { rw finset.disjoint_left,
+    intros z,
+    rw [hb, hc],
     tauto },
   { apply_instance },
 end
@@ -415,6 +415,7 @@ lemma gal_action_hom_bijective_of_prime_degree
   (p_roots : fintype.card (p.root_set ℂ) = fintype.card (p.root_set ℝ) + 2) :
   function.bijective (gal_action_hom p ℂ) :=
 begin
+  classical,
   have h1 : fintype.card (p.root_set ℂ) = p.nat_degree,
   { simp_rw [root_set_def, finset.coe_sort_coe, fintype.card_coe],
     rw [multiset.to_finset_card_of_nodup, ←nat_degree_eq_card_roots],
diff --git a/src/field_theory/primitive_element.lean b/src/field_theory/primitive_element.lean
index 1b10e811c194c..cf57da928a8f7 100644
--- a/src/field_theory/primitive_element.lean
+++ b/src/field_theory/primitive_element.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning, Patrick Lutz
 -/
 
-import field_theory.adjoin
+import field_theory.splitting_field.construction
 import field_theory.is_alg_closed.basic
 import field_theory.separable
 import ring_theory.integral_domain
@@ -12,6 +12,9 @@ import ring_theory.integral_domain
 /-!
 # Primitive Element Theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the primitive element theorem.
 
 ## Main results
@@ -46,7 +49,7 @@ variables (F : Type*) [field F] (E : Type*) [field E] [algebra F E]
 /-! ### Primitive element theorem for finite fields -/
 
 /-- **Primitive element theorem** assuming E is finite. -/
-lemma exists_primitive_element_of_fintype_top [fintype E] : ∃ α : E, F⟮α⟯ = ⊤ :=
+lemma exists_primitive_element_of_finite_top [finite E] : ∃ α : E, F⟮α⟯ = ⊤ :=
 begin
   obtain ⟨α, hα⟩ := is_cyclic.exists_generator (units E),
   use α,
@@ -61,11 +64,11 @@ begin
 end
 
 /-- Primitive element theorem for finite dimensional extension of a finite field. -/
-theorem exists_primitive_element_of_fintype_bot [fintype F] [finite_dimensional F E] :
+theorem exists_primitive_element_of_finite_bot [finite F] [finite_dimensional F E] :
   ∃ α : E, F⟮α⟯ = ⊤ :=
 begin
-  haveI : fintype E := fintype_of_fintype F E,
-  exact exists_primitive_element_of_fintype_top F E,
+  haveI : finite E := finite_of_finite F E,
+  exact exists_primitive_element_of_finite_top F E
 end
 
 end primitive_element_finite
@@ -112,9 +115,7 @@ begin
       { rw ← add_sub_cancel α (c • β),
         exact F⟮γ⟯.sub_mem (mem_adjoin_simple_self F γ) (F⟮γ⟯.to_subalgebra.smul_mem β_in_Fγ c) },
       exact λ x hx, by cases hx; cases hx; cases hx; assumption },
-    { rw adjoin_le_iff,
-      change {γ} ⊆ _,
-      rw set.singleton_subset_iff,
+    { rw [adjoin_simple_le_iff],
       have α_in_Fαβ : α ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert α {β}),
       have β_in_Fαβ : β ∈ F⟮α, β⟯ := subset_adjoin F {α, β} (set.mem_insert_of_mem α rfl),
       exact F⟮α,β⟯.add_mem α_in_Fαβ (F⟮α, β⟯.smul_mem β_in_Fαβ) } },
@@ -126,7 +127,7 @@ begin
     (not_and.mpr (λ _, map_g_ne_zero)),
   suffices p_linear : p.map (algebra_map F⟮γ⟯ E) = (C h.leading_coeff) * (X - C β),
   { have finale : β = algebra_map F⟮γ⟯ E (-p.coeff 0 / p.coeff 1),
-    { rw [ring_hom.map_div, ring_hom.map_neg, ←coeff_map, ←coeff_map, p_linear],
+    { rw [map_div₀, ring_hom.map_neg, ←coeff_map, ←coeff_map, p_linear],
       simp [mul_sub, coeff_C, mul_div_cancel_left β (mt leading_coeff_eq_zero.mp h_ne_zero)] },
     rw finale,
     exact subtype.mem (-p.coeff 0 / p.coeff 1) },
@@ -178,7 +179,7 @@ begin
   rcases is_empty_or_nonempty (fintype F) with F_inf|⟨⟨F_finite⟩⟩,
   { let P : intermediate_field F E → Prop := λ K, ∃ α : E, F⟮α⟯ = K,
     have base : P ⊥ := ⟨0, adjoin_zero⟩,
-    have ih : ∀ (K : intermediate_field F E) (x : E), P K → P ↑K⟮x⟯,
+    have ih : ∀ (K : intermediate_field F E) (x : E), P K → P (K⟮x⟯.restrict_scalars F),
     { intros K β hK,
       cases hK with α hK,
       rw [←hK, adjoin_simple_adjoin_simple],
@@ -186,7 +187,7 @@ begin
       cases primitive_element_inf_aux F α β with γ hγ,
       exact ⟨γ, hγ.symm⟩ },
     exact induction_on_adjoin P base ih ⊤ },
-  { exactI exists_primitive_element_of_fintype_bot F E }
+  { exactI exists_primitive_element_of_finite_bot F E }
 end
 
 /-- Alternative phrasing of primitive element theorem:
@@ -201,52 +202,6 @@ pb.map ((intermediate_field.equiv_of_eq e).trans intermediate_field.top_equiv)
 
 end separable_assumption
 
-/-- A technical finiteness result. -/
-noncomputable def fintype.subtype_prod {E : Type*} {X : set E} (hX : X.finite) {L : Type*}
-  (F : E → multiset L) : fintype (Π x : X, {l : L // l ∈ F x}) :=
-by { classical, letI : fintype X := set.finite.fintype hX, exact pi.fintype}
-
-variables (K : Type*) [field K] [algebra F K]
-
-variables (E F)
-
-/-- Function from Hom_K(E,L) to pi type Π (x : basis), roots of min poly of x -/
-def roots_of_min_poly_pi_type (φ : E →ₐ[F] K)
-  (x : set.range (finite_dimensional.fin_basis F E : _ → E)) :
-  {l : K // l ∈ (((minpoly F x.1).map (algebra_map F K)).roots : multiset K)} :=
-⟨φ x, begin
-  rw [polynomial.mem_roots_map (minpoly.ne_zero_of_finite_field_extension F x.val),
-    ← polynomial.alg_hom_eval₂_algebra_map, ← φ.map_zero],
-  exact congr_arg φ (minpoly.aeval F (x : E)),
-end⟩
-
-lemma aux_inj_roots_of_min_poly : function.injective (roots_of_min_poly_pi_type F E K) :=
-begin
-  intros f g h,
-  suffices : (f : E →ₗ[F] K) = g,
-  { rw linear_map.ext_iff at this,
-    ext x, exact this x },
-  rw function.funext_iff at h,
-  apply linear_map.ext_on (finite_dimensional.fin_basis F E).span_eq,
-  rintro e he,
-  have := (h ⟨e, he⟩),
-  apply_fun subtype.val at this,
-  exact this,
-end
-
-/-- Given field extensions `E/F` and `K/F`, with `E/F` finite, there are finitely many `F`-algebra
-  homomorphisms `E →ₐ[K] K`. -/
-noncomputable instance : fintype (E →ₐ[F] K) :=
-let n := finite_dimensional.finrank F E in
-begin
-  let B : basis (fin n) F E := finite_dimensional.fin_basis F E,
-  let X := set.range (B : fin n → E),
-  have hX : X.finite := set.finite_range ⇑B,
-  refine @fintype.of_injective _ _
-    (fintype.subtype_prod hX (λ e, ((minpoly F e).map (algebra_map F K)).roots)) _
-    (aux_inj_roots_of_min_poly F E K),
-end
-
 end field
 
 @[simp] lemma alg_hom.card (F E K : Type*) [field F] [field E] [field K] [is_alg_closed K]
diff --git a/src/field_theory/ratfunc.lean b/src/field_theory/ratfunc.lean
index cba314c27bc11..735db2340429f 100644
--- a/src/field_theory/ratfunc.lean
+++ b/src/field_theory/ratfunc.lean
@@ -12,8 +12,11 @@ import ring_theory.polynomial.content
 /-!
 # The field of rational functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the field `ratfunc K` of rational functions over a field `K`,
-and shows it is the field of fractions of `polynomial K`.
+and shows it is the field of fractions of `K[X]`.
 
 ## Main definitions
 
@@ -24,11 +27,11 @@ Working with rational functions as polynomials:
  - `ratfunc.eval` evaluates a rational function given a value for the indeterminate
 You can use `is_fraction_ring` API to treat `ratfunc` as the field of fractions of polynomials:
  * `algebra_map K[X] (ratfunc K)` maps polynomials to rational functions
- * `is_fraction_ring.alg_equiv` maps other fields of fractions of `polynomial K` to `ratfunc K`,
+ * `is_fraction_ring.alg_equiv` maps other fields of fractions of `K[X]` to `ratfunc K`,
     in particular:
  * `fraction_ring.alg_equiv K[X] (ratfunc K)` maps the generic field of
     fraction construction to `ratfunc K`. Combine this with `alg_equiv.restrict_scalars` to change
-    the `fraction_ring K[X] ≃ₐ[polynomial K] ratfunc K` to
+    the `fraction_ring K[X] ≃ₐ[K[X]] ratfunc K` to
     `fraction_ring K[X] ≃ₐ[K] ratfunc K`.
 
 Working with rational functions as fractions:
@@ -40,18 +43,18 @@ the underlying `ratfunc.coe_alg_hom`.
 
 Lifting homomorphisms of polynomials to other types, by mapping and dividing, as long
 as the homomorphism retains the non-zero-divisor property:
-  - `ratfunc.lift_monoid_with_zero_hom` lifts a `polynomial K →*₀ G₀` to
+  - `ratfunc.lift_monoid_with_zero_hom` lifts a `K[X] →*₀ G₀` to
       a `ratfunc K →*₀ G₀`, where `[comm_ring K] [comm_group_with_zero G₀]`
-  - `ratfunc.lift_ring_hom` lifts a `polynomial K →+* L` to a `ratfunc K →+* L`,
+  - `ratfunc.lift_ring_hom` lifts a `K[X] →+* L` to a `ratfunc K →+* L`,
       where `[comm_ring K] [field L]`
-  - `ratfunc.lift_alg_hom` lifts a `polynomial K →ₐ[S] L` to a `ratfunc K →ₐ[S] L`,
+  - `ratfunc.lift_alg_hom` lifts a `K[X] →ₐ[S] L` to a `ratfunc K →ₐ[S] L`,
       where `[comm_ring K] [field L] [comm_semiring S] [algebra S K[X]] [algebra S L]`
 This is satisfied by injective homs.
 We also have lifting homomorphisms of polynomials to other polynomials,
 with the same condition on retaining the non-zero-divisor property across the map:
-  - `ratfunc.map` lifts `polynomial K →* R[X]` when `[comm_ring K] [comm_ring R]`
-  - `ratfunc.map_ring_hom` lifts `polynomial K →+* R[X]` when `[comm_ring K] [comm_ring R]`
-  - `ratfunc.map_alg_hom` lifts `polynomial K →ₐ[S] R[X]` when
+  - `ratfunc.map` lifts `K[X] →* R[X]` when `[comm_ring K] [comm_ring R]`
+  - `ratfunc.map_ring_hom` lifts `K[X] →+* R[X]` when `[comm_ring K] [comm_ring R]`
+  - `ratfunc.map_alg_hom` lifts `K[X] →ₐ[S] R[X]` when
     `[comm_ring K] [is_domain K] [comm_ring R] [is_domain R]`
 
 We also have a set of recursion and induction principles:
@@ -95,21 +98,23 @@ open_locale non_zero_divisors polynomial
 
 universes u v
 
-variables (K : Type u) [hring : comm_ring K] [hdomain : is_domain K]
-include hring
+variable (K : Type u)
 
 /-- `ratfunc K` is `K(x)`, the field of rational functions over `K`.
 
 The inclusion of polynomials into `ratfunc` is `algebra_map K[X] (ratfunc K)`,
-the maps between `ratfunc K` and another field of fractions of `polynomial K`,
+the maps between `ratfunc K` and another field of fractions of `K[X]`,
 especially `fraction_ring K[X]`, are given by `is_localization.algebra_equiv`.
 -/
-structure ratfunc : Type u := of_fraction_ring ::
+structure ratfunc [comm_ring K] : Type u := of_fraction_ring ::
 (to_fraction_ring : fraction_ring K[X])
 
 namespace ratfunc
 
-variables {K}
+section comm_ring
+
+variable {K}
+variable [comm_ring K]
 
 section rec
 
@@ -125,7 +130,7 @@ lemma to_fraction_ring_injective :
 /-- Non-dependent recursion principle for `ratfunc K`:
 To construct a term of `P : Sort*` out of `x : ratfunc K`,
 it suffices to provide a constructor `f : Π (p q : K[X]), P`
-and a proof that `f p q = f p' q'` for all `p q p' q'` such that `p * q' = p' * q` where
+and a proof that `f p q = f p' q'` for all `p q p' q'` such that `q' * p = q * p'` where
 both `q` and `q'` are not zero divisors, stated as `q ∉ K[X]⁰`, `q' ∉ K[X]⁰`.
 
 If considering `K` as an integral domain, this is the same as saying that
@@ -137,24 +142,36 @@ of `∀ {p q a : K[X]} (hq : q ≠ 0) (ha : a ≠ 0), f (a * p) (a * q) = f p q)
 -/
 @[irreducible] protected def lift_on {P : Sort v} (x : ratfunc K)
   (f : ∀ (p q : K[X]), P)
-  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), p * q' = p' * q →
+  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), q' * p = q * p' →
     f p q = f p' q') :
   P :=
-localization.lift_on (to_fraction_ring x) (λ p q, f p q) (λ p p' q q' h, H q.2 q'.2
+localization.lift_on
+  (by exact to_fraction_ring x) -- Fix timeout by manipulating elaboration order
+  (λ p q, f p q) (λ p p' q q' h, H q.2 q'.2
   (let ⟨⟨c, hc⟩, mul_eq⟩ := (localization.r_iff_exists).mp h in
-    mul_cancel_right_coe_non_zero_divisor.mp mul_eq))
+    mul_cancel_left_coe_non_zero_divisor.mp mul_eq))
 
 lemma lift_on_of_fraction_ring_mk {P : Sort v} (n : K[X]) (d : K[X]⁰)
   (f : ∀ (p q : K[X]), P)
-  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), p * q' = p' * q →
+  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), q' * p = q * p' →
     f p q = f p' q') :
-  ratfunc.lift_on (of_fraction_ring (localization.mk n d)) f @H = f n d :=
+  ratfunc.lift_on (by exact of_fraction_ring (localization.mk n d)) f @H = f n d :=
 begin
   unfold ratfunc.lift_on,
   exact localization.lift_on_mk _ _ _ _
 end
 
-include hdomain
+lemma lift_on_condition_of_lift_on'_condition {P : Sort v} {f : ∀ (p q : K[X]), P}
+  (H : ∀ {p q a} (hq : q ≠ 0) (ha : a ≠ 0), f (a * p) (a * q) = f p q)
+  ⦃p q p' q' : K[X]⦄ (hq : q ≠ 0) (hq' : q' ≠ 0) (h : q' * p = q * p') :
+  f p q = f p' q' :=
+calc f p q = f (q' * p) (q' * q) : (H hq hq').symm
+       ... = f (q * p') (q * q') : by rw [h, mul_comm q']
+       ... = f p' q' : H hq' hq
+
+section is_domain
+
+variable [is_domain K]
 
 /-- `ratfunc.mk (p q : K[X])` is `p / q` as a rational function.
 
@@ -197,13 +214,13 @@ by rw [← is_localization.mk'_one (fraction_ring K[X]) p, ← mk_coe_def, submo
 lemma mk_eq_mk {p q p' q' : K[X]} (hq : q ≠ 0) (hq' : q' ≠ 0) :
   ratfunc.mk p q = ratfunc.mk p' q' ↔ p * q' = p' * q :=
 by rw [mk_def_of_ne _ hq, mk_def_of_ne _ hq', of_fraction_ring_injective.eq_iff,
-       is_localization.mk'_eq_iff_eq, set_like.coe_mk, set_like.coe_mk,
+       is_localization.mk'_eq_iff_eq', set_like.coe_mk, set_like.coe_mk,
        (is_fraction_ring.injective K[X] (fraction_ring K[X])).eq_iff]
 
 lemma lift_on_mk {P : Sort v} (p q : K[X])
   (f : ∀ (p q : K[X]), P) (f0 : ∀ p, f p 0 = f 0 1)
-  (H' : ∀ {p q p' q'} (hq : q ≠ 0) (hq' : q' ≠ 0), p * q' = p' * q → f p q = f p' q')
-  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), p * q' = p' * q →
+  (H' : ∀ {p q p' q'} (hq : q ≠ 0) (hq' : q' ≠ 0), q' * p = q * p' → f p q = f p' q')
+  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), q' * p = q * p' →
     f p q = f p' q' :=
     λ p q p' q' hq hq' h, H' (non_zero_divisors.ne_zero hq) (non_zero_divisors.ne_zero hq') h) :
   (ratfunc.mk p q).lift_on f @H = f p q :=
@@ -216,25 +233,6 @@ begin
                set_like.coe_mk] }
 end
 
-lemma lift_on_condition_of_lift_on'_condition {P : Sort v} {f : ∀ (p q : K[X]), P}
-  (H : ∀ {p q a} (hq : q ≠ 0) (ha : a ≠ 0), f (a * p) (a * q) = f p q)
-  ⦃p q p' q' : K[X]⦄ (hq : q ≠ 0) (hq' : q' ≠ 0) (h : p * q' = p' * q) :
-  f p q = f p' q' :=
-begin
-  have H0 : f 0 q = f 0 q',
-  { calc f 0 q = f (q' * 0) (q' * q) : (H hq hq').symm
-           ... = f (q * 0) (q * q') : by rw [mul_zero, mul_zero, mul_comm]
-           ... = f 0 q' : H hq' hq },
-  by_cases hp : p = 0,
-  { simp only [hp, hq, zero_mul, or_false, zero_eq_mul] at ⊢ h, rw [h, H0] },
-  by_cases hp' : p' = 0,
-  { simpa only [hp, hp', hq', zero_mul, or_self, mul_eq_zero] using h },
-  calc f p q = f (p' * p) (p' * q) : (H hq hp').symm
-         ... = f (p * p') (p * q') : by rw [mul_comm p p', h]
-         ... = f p' q' : H hq' hp
-end
-
--- f
 /-- Non-dependent recursion principle for `ratfunc K`: if `f p q : P` for all `p q`,
 such that `f (a * p) (a * q) = f p q`, then we can find a value of `P`
 for all elements of `ratfunc K` by setting `lift_on' (p / q) f _ = f p q`.
@@ -269,6 +267,8 @@ See also `induction_on`, which is a recursion principle defined in terms of `alg
   (λ ⟨p, q⟩, by simpa only [mk_coe_def, localization.mk_eq_mk'] using f p q
     (mem_non_zero_divisors_iff_ne_zero.mp q.2))
 
+end is_domain
+
 end rec
 
 section field
@@ -319,7 +319,9 @@ lemma of_fraction_ring_mul (p q : fraction_ring K[X]) :
   of_fraction_ring (p * q) = of_fraction_ring p * of_fraction_ring q :=
 by unfold has_mul.mul ratfunc.mul
 
-include hdomain
+section is_domain
+
+variable [is_domain K]
 
 /-- Division of rational functions. -/
 @[irreducible] protected def div : ratfunc K → ratfunc K → ratfunc K
@@ -343,24 +345,26 @@ lemma mul_inv_cancel : ∀ {p : ratfunc K} (hp : p ≠ 0), p * p⁻¹ = 1
 by simpa only [← of_fraction_ring_inv, ← of_fraction_ring_mul, ← of_fraction_ring_one]
   using _root_.mul_inv_cancel this
 
-section has_scalar
-omit hdomain
+end is_domain
+
+section has_smul
 
 variables {R : Type*}
 
 /-- Scalar multiplication of rational functions. -/
-@[irreducible] protected def smul [has_scalar R (fraction_ring K[X])] :
+@[irreducible] protected def smul [has_smul R (fraction_ring K[X])] :
   R → ratfunc K → ratfunc K
 | r ⟨p⟩ := ⟨r • p⟩
 
-instance [has_scalar R (fraction_ring K[X])] : has_scalar R (ratfunc K) :=
+@[nolint fails_quickly] -- cannot reproduce
+instance [has_smul R (fraction_ring K[X])] : has_smul R (ratfunc K) :=
 ⟨ratfunc.smul⟩
 
-lemma of_fraction_ring_smul [has_scalar R (fraction_ring K[X])]
+lemma of_fraction_ring_smul [has_smul R (fraction_ring K[X])]
   (c : R) (p : fraction_ring K[X]) :
   of_fraction_ring (c • p) = c • of_fraction_ring p :=
-by unfold has_scalar.smul ratfunc.smul
-lemma to_fraction_ring_smul [has_scalar R (fraction_ring K[X])]
+by unfold has_smul.smul ratfunc.smul
+lemma to_fraction_ring_smul [has_smul R (fraction_ring K[X])]
   (c : R) (p : ratfunc K) :
   to_fraction_ring (c • p) = c • to_fraction_ring p :=
 by { cases p, rw ←of_fraction_ring_smul }
@@ -375,10 +379,11 @@ begin
   { simp only }
 end
 
-include hdomain
+section is_domain
+
+variable [is_domain K]
 variables [monoid R] [distrib_mul_action R K[X]]
-variables [htower : is_scalar_tower R K[X] K[X]]
-include htower
+variables [is_scalar_tower R K[X] K[X]]
 
 lemma mk_smul (c : R) (p q : K[X]) :
   ratfunc.mk (c • p) q = c • ratfunc.mk p q :=
@@ -392,11 +397,11 @@ end
 instance : is_scalar_tower R K[X] (ratfunc K) :=
 ⟨λ c p q, q.induction_on' (λ q r _, by rw [← mk_smul, smul_assoc, mk_smul, mk_smul])⟩
 
-end has_scalar
+end is_domain
 
-variables (K)
+end has_smul
 
-omit hdomain
+variables (K)
 
 instance [subsingleton K] : subsingleton (ratfunc K) :=
 to_fraction_ring_injective.subsingleton
@@ -406,7 +411,7 @@ instance : inhabited (ratfunc K) :=
 instance [nontrivial K] : nontrivial (ratfunc K) :=
 of_fraction_ring_injective.nontrivial
 
-/-- `ratfunc K` is isomorphic to the field of fractions of `polynomial K`, as rings.
+/-- `ratfunc K` is isomorphic to the field of fractions of `K[X]`, as rings.
 
 This is an auxiliary definition; `simp`-normal form is `is_localization.alg_equiv`.
 -/
@@ -418,8 +423,9 @@ This is an auxiliary definition; `simp`-normal form is `is_localization.alg_equi
   map_add' := λ ⟨_⟩ ⟨_⟩, by simp [←of_fraction_ring_add],
   map_mul' := λ ⟨_⟩ ⟨_⟩, by simp [←of_fraction_ring_mul] }
 
-omit hring
+end field
 
+section tactic_interlude -- pre-porting note: should comm_ring be disabled here?
 /-- Solve equations for `ratfunc K` by working in `fraction_ring K[X]`. -/
 meta def frac_tac : tactic unit :=
 `[repeat { rintro (⟨⟩ : ratfunc _) },
@@ -437,12 +443,12 @@ meta def smul_tac : tactic unit :=
   simp only [add_comm, mul_comm, zero_smul, succ_nsmul, zsmul_eq_mul, mul_add, mul_one, mul_zero,
     neg_add, mul_neg,
     int.of_nat_eq_coe, int.coe_nat_succ, int.cast_zero, int.cast_add, int.cast_one,
-    int.cast_neg_succ_of_nat, int.cast_coe_nat,
+    int.cast_neg_succ_of_nat, int.cast_coe_nat, nat.cast_succ,
     localization.mk_zero, localization.add_mk_self, localization.neg_mk,
     of_fraction_ring_zero, ← of_fraction_ring_add, ← of_fraction_ring_neg]]
 
-include hring
-
+end tactic_interlude
+variable (K)
 instance : comm_ring (ratfunc K) :=
 { add := (+),
   add_assoc := by frac_tac,
@@ -476,7 +482,6 @@ variables {K}
 section lift_hom
 
 variables {G₀ L R S F : Type*} [comm_group_with_zero G₀] [field L] [comm_ring R] [comm_ring S]
-omit hring
 
 /-- Lift a monoid homomorphism that maps polynomials `φ : R[X] →* S[X]`
 to a `ratfunc R →* ratfunc S`,
@@ -493,7 +498,7 @@ def map [monoid_hom_class F R[X] S[X]] (φ : F)
       { exact hφ hq' },
       { exact hφ hq },
       refine localization.r_of_eq _,
-      simpa only [map_mul] using (congr_arg φ h).symm,
+      simpa only [map_mul] using (congr_arg φ h),
     end,
   map_one' := begin
     rw [←of_fraction_ring_one, ←localization.mk_one, lift_on_of_fraction_ring_mk, dif_pos],
@@ -529,7 +534,7 @@ begin
   rintro ⟨x⟩ ⟨y⟩ h, induction x, induction y,
   { simpa only [map_apply_of_fraction_ring_mk, of_fraction_ring_injective.eq_iff,
                 localization.mk_eq_mk_iff, localization.r_iff_exists,
-                mul_cancel_right_coe_non_zero_divisor, exists_const, set_like.coe_mk, ←map_mul,
+                mul_cancel_left_coe_non_zero_divisor, exists_const, set_like.coe_mk, ←map_mul,
                 hf.eq_iff] using h },
   { refl },
   { refl }
@@ -562,22 +567,22 @@ lemma coe_map_ring_hom_eq_coe_map [ring_hom_class F R[X] S[X]] (φ : F)
   (map_ring_hom φ hφ : ratfunc R → ratfunc S) = map φ hφ := rfl
 
 -- TODO: Generalize to `fun_like` classes,
-/-- Lift an monoid with zero homomorphism `polynomial R →*₀ G₀` to a `ratfunc R →*₀ G₀`
+/-- Lift an monoid with zero homomorphism `R[X] →*₀ G₀` to a `ratfunc R →*₀ G₀`
 on the condition that `φ` maps non zero divisors to non zero divisors,
-by mapping both the numerator and denominator and quotienting them. --/
+by mapping both the numerator and denominator and quotienting them. -/
 def lift_monoid_with_zero_hom (φ : R[X] →*₀ G₀) (hφ : R[X]⁰ ≤ G₀⁰.comap φ) :
   ratfunc R →*₀ G₀ :=
 { to_fun := λ f, ratfunc.lift_on f (λ p q, φ p / (φ q)) $ λ p q p' q' hq hq' h, begin
     casesI subsingleton_or_nontrivial R,
     { rw [subsingleton.elim p q, subsingleton.elim p' q, subsingleton.elim q' q] },
-    rw [div_eq_div_iff, ←map_mul, h, map_mul];
+    rw [div_eq_div_iff, ←map_mul, mul_comm p, h, map_mul, mul_comm];
     exact non_zero_divisors.ne_zero (hφ ‹_›),
   end,
   map_one' := by { rw [←of_fraction_ring_one, ←localization.mk_one, lift_on_of_fraction_ring_mk],
                    simp only [map_one, submonoid.coe_one, div_one] },
   map_mul' := λ x y, by { cases x, cases y, induction x with p q, induction y with p' q',
     { rw [←of_fraction_ring_mul, localization.mk_mul],
-      simp only [lift_on_of_fraction_ring_mk, div_mul_div_comm₀, map_mul, submonoid.coe_mul] },
+      simp only [lift_on_of_fraction_ring_mk, div_mul_div_comm, map_mul, submonoid.coe_mul] },
     { refl },
     { refl } },
   map_zero' := by { rw [←of_fraction_ring_zero, ←localization.mk_zero (1 : R[X]⁰),
@@ -599,14 +604,15 @@ begin
   { simp_rw [lift_monoid_with_zero_hom_apply_of_fraction_ring_mk, localization.mk_eq_mk_iff],
     intro h,
     refine localization.r_of_eq _,
-    simpa only [←hφ.eq_iff, map_mul] using mul_eq_mul_of_div_eq_div _ _ _ _ h.symm;
-    exact (map_ne_zero_of_mem_non_zero_divisors _ hφ (set_like.coe_mem _)) },
+    have := mul_eq_mul_of_div_eq_div _ _ _ _ h,
+    rwa [←map_mul, ←map_mul, hφ.eq_iff, mul_comm, mul_comm y_a] at this,
+    all_goals { exact (map_ne_zero_of_mem_non_zero_divisors _ hφ (set_like.coe_mem _)) } },
   { exact λ _, rfl },
   { exact λ _, rfl }
 end
 
-/-- Lift an injective ring homomorphism `polynomial R →+* L` to a `ratfunc R →+* L`
-by mapping both the numerator and denominator and quotienting them. --/
+/-- Lift an injective ring homomorphism `R[X] →+* L` to a `ratfunc R →+* L`
+by mapping both the numerator and denominator and quotienting them. -/
 def lift_ring_hom (φ : R[X] →+* L) (hφ : R[X]⁰ ≤ L⁰.comap φ) : ratfunc R →+* L :=
 { map_add' := λ x y, by { simp only [monoid_with_zero_hom.to_fun_eq_coe],
     casesI subsingleton_or_nontrivial R,
@@ -638,10 +644,10 @@ lift_monoid_with_zero_hom_injective _ hφ
 
 end lift_hom
 
-variables (K)
-include hdomain
+variable (K)
 
-instance : field (ratfunc K) :=
+instance [is_domain K] : field (ratfunc K) :=
+by exact
 { inv := has_inv.inv,
   inv_zero := by frac_tac,
   div := (/),
@@ -651,13 +657,12 @@ instance : field (ratfunc K) :=
   .. ratfunc.comm_ring K,
   .. ratfunc.nontrivial K }
 
-end field
-
 section is_fraction_ring
 
 /-! ### `ratfunc` as field of fractions of `polynomial` -/
 
-include hdomain
+section is_domain
+variable [is_domain K]
 
 instance (R : Type*) [comm_semiring R] [algebra R K[X]] :
   algebra R (ratfunc K) :=
@@ -765,7 +770,7 @@ variables {L R S : Type*} [field L] [comm_ring R] [is_domain R] [comm_semiring S
   [algebra S K[X]] [algebra S L] [algebra S R[X]]
   (φ : K[X] →ₐ[S] L) (hφ : K[X]⁰ ≤ L⁰.comap φ)
 
-/-- Lift an algebra homomorphism that maps polynomials `φ : polynomial K →ₐ[S] R[X]`
+/-- Lift an algebra homomorphism that maps polynomials `φ : K[X] →ₐ[S] R[X]`
 to a `ratfunc K →ₐ[S] ratfunc R`,
 on the condition that `φ` maps non zero divisors to non zero divisors,
 by mapping both the numerator and denominator and quotienting them. -/
@@ -779,8 +784,8 @@ lemma coe_map_alg_hom_eq_coe_map (φ : K[X] →ₐ[S] R[X])
   (hφ : K[X]⁰ ≤ R[X]⁰.comap φ) :
   (map_alg_hom φ hφ : ratfunc K → ratfunc R) = map φ hφ := rfl
 
-/-- Lift an injective algebra homomorphism `polynomial K →ₐ[S] L` to a `ratfunc K →ₐ[S] L`
-by mapping both the numerator and denominator and quotienting them. --/
+/-- Lift an injective algebra homomorphism `K[X] →ₐ[S] L` to a `ratfunc K →ₐ[S] L`
+by mapping both the numerator and denominator and quotienting them. -/
 def lift_alg_hom : ratfunc K →ₐ[S] L :=
 { commutes' := λ r, by simp_rw [ring_hom.to_fun_eq_coe, alg_hom.to_ring_hom_eq_coe,
     algebra_map_apply r, lift_ring_hom_apply_div, alg_hom.coe_to_ring_hom, map_one,
@@ -805,10 +810,6 @@ end lift_alg_hom
 
 variables (K)
 
-omit hdomain
-
-include hdomain
-
 /-- `ratfunc K` is the field of fractions of the polynomials over `K`. -/
 instance : is_fraction_ring K[X] (ratfunc K) :=
 { map_units := λ y, by rw ← of_fraction_ring_algebra_map;
@@ -824,8 +825,8 @@ variables {K}
 
 @[simp] lemma lift_on_div {P : Sort v} (p q : K[X])
   (f : ∀ (p q : K[X]), P) (f0 : ∀ p, f p 0 = f 0 1)
-  (H' : ∀ {p q p' q'} (hq : q ≠ 0) (hq' : q' ≠ 0), p * q' = p' * q → f p q = f p' q')
-  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), p * q' = p' * q →
+  (H' : ∀ {p q p' q'} (hq : q ≠ 0) (hq' : q' ≠ 0), q' * p = q * p' → f p q = f p' q')
+  (H : ∀ {p q p' q'} (hq : q ∈ K[X]⁰) (hq' : q' ∈ K[X]⁰), q' * p = q * p' →
   f p q = f p' q' :=
   λ p q p' q' hq hq' h, H' (non_zero_divisors.ne_zero hq) (non_zero_divisors.ne_zero hq') h) :
   (algebra_map _ (ratfunc K) p / algebra_map _ _ q).lift_on f @H = f p q :=
@@ -839,7 +840,7 @@ begin
   exact lift_on_condition_of_lift_on'_condition @H
 end
 
-/-- Induction principle for `ratfunc K`: if `f p q : P (p / q)` for all `p q : polynomial K`,
+/-- Induction principle for `ratfunc K`: if `f p q : P (p / q)` for all `p q : K[X]`,
 then `P` holds on all elements of `ratfunc K`.
 
 See also `induction_on'`, which is a recursion principle defined in terms of `ratfunc.mk`.
@@ -876,17 +877,21 @@ by simp only [localization.mk_eq_mk'_apply, of_fraction_ring_mk', is_localizatio
 by { ext x,
      simp [to_fraction_ring_ring_equiv, of_fraction_ring_eq, alg_equiv.coe_ring_equiv'] }
 
+end is_domain
+
 end is_fraction_ring
 
+end comm_ring
+
+variable {K}
+
 section num_denom
 
 /-! ### Numerator and denominator -/
 
 open gcd_monoid polynomial
 
-omit hring
-variables [hfield : field K]
-include hfield
+variables [field K]
 
 /-- `ratfunc.num_denom` are numerator and denominator of a rational function over a field,
 normalized such that the denominator is monic. -/
@@ -925,7 +930,7 @@ x.lift_on' (λ p q, if q = 0 then ⟨0, 1⟩ else let r := gcd p q in
 begin
   rw [num_denom, lift_on'_div, if_neg hq],
   intros p,
-  rw [if_pos rfl, if_neg (@one_ne_zero K[X] _ _)],
+  rw [if_pos rfl, if_neg (one_ne_zero' K[X])],
   simp,
 end
 
@@ -1025,6 +1030,14 @@ x.induction_on (λ p q hq, begin
     exact inv_ne_zero (polynomial.leading_coeff_ne_zero.mpr q_div_ne_zero) },
 end)
 
+lemma is_coprime_num_denom (x : ratfunc K) : is_coprime x.num x.denom :=
+begin
+  induction x using ratfunc.induction_on with p q hq,
+  rw [num_div, denom_div _ hq],
+  exact (is_coprime_mul_unit_left ((leading_coeff_ne_zero.2 $ right_div_gcd_ne_zero
+    hq).is_unit.inv.map C) _ _).2 (is_coprime_div_gcd_div_gcd hq),
+end
+
 @[simp] lemma num_eq_zero_iff {x : ratfunc K} : num x = 0 ↔ x = 0 :=
 ⟨λ h, by rw [← num_div_denom x, h, ring_hom.map_zero, zero_div],
  λ h, h.symm ▸ num_zero⟩
@@ -1060,7 +1073,7 @@ by rw [num_mul_eq_mul_denom_iff (denom_ne_zero x), _root_.map_neg, neg_div, num_
 lemma num_denom_mul (x y : ratfunc K) :
   (x * y).num * (x.denom * y.denom) = x.num * y.num * (x * y).denom :=
 (num_mul_eq_mul_denom_iff (mul_ne_zero (denom_ne_zero x) (denom_ne_zero y))).mpr $
-  by conv_lhs { rw [← num_div_denom x, ← num_div_denom y, div_mul_div_comm₀,
+  by conv_lhs { rw [← num_div_denom x, ← num_div_denom y, div_mul_div_comm,
                     ← ring_hom.map_mul, ← ring_hom.map_mul] }
 
 lemma num_dvd {x : ratfunc K} {p : K[X]} (hp : p ≠ 0) :
@@ -1070,7 +1083,7 @@ begin
   { rintro ⟨q, rfl⟩,
     obtain ⟨hx, hq⟩ := mul_ne_zero_iff.mp hp,
     use denom x * q,
-    rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm₀, div_self, mul_one, num_div_denom],
+    rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm, div_self, mul_one, num_div_denom],
     { exact ⟨mul_ne_zero (denom_ne_zero x) hq, rfl⟩ },
     { exact algebra_map_ne_zero hq } },
   { rintro ⟨q, hq, rfl⟩,
@@ -1084,7 +1097,7 @@ begin
   { rintro ⟨p, rfl⟩,
     obtain ⟨hx, hp⟩ := mul_ne_zero_iff.mp hq,
     use num x * p,
-    rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm₀, div_self, mul_one, num_div_denom],
+    rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm, div_self, mul_one, num_div_denom],
     { exact algebra_map_ne_zero hp } },
   { rintro ⟨p, rfl⟩,
     exact denom_div_dvd p q },
@@ -1098,14 +1111,14 @@ begin
   { simp [hy] },
   rw num_dvd (mul_ne_zero (num_ne_zero hx) (num_ne_zero hy)),
   refine ⟨x.denom * y.denom, mul_ne_zero (denom_ne_zero x) (denom_ne_zero y), _⟩,
-  rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm₀, num_div_denom, num_div_denom]
+  rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm, num_div_denom, num_div_denom]
 end
 
 lemma denom_mul_dvd (x y : ratfunc K) : denom (x * y) ∣ denom x * denom y :=
 begin
   rw denom_dvd (mul_ne_zero (denom_ne_zero x) (denom_ne_zero y)),
   refine ⟨x.num * y.num, _⟩,
-  rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm₀, num_div_denom, num_div_denom]
+  rw [ring_hom.map_mul, ring_hom.map_mul, ← div_mul_div_comm, num_div_denom, num_div_denom]
 end
 
 lemma denom_add_dvd (x y : ratfunc K) : denom (x + y) ∣ denom x * denom y :=
@@ -1161,7 +1174,8 @@ section eval
 
 /-! ### Polynomial structure: `C`, `X`, `eval` -/
 
-include hdomain
+section domain
+variables [comm_ring K] [is_domain K]
 
 /-- `ratfunc.C a` is the constant rational function `a`. -/
 def C : K →+* ratfunc K :=
@@ -1183,9 +1197,11 @@ def X : ratfunc K := algebra_map K[X] (ratfunc K) polynomial.X
 @[simp] lemma algebra_map_X :
   algebra_map K[X] (ratfunc K) polynomial.X = X := rfl
 
-omit hring hdomain
-variables [hfield : field K]
-include hfield
+end domain
+
+section field
+
+variables [field K]
 
 @[simp] lemma num_C (c : K) : num (C c) = polynomial.C c :=
 num_algebra_map _
@@ -1269,21 +1285,21 @@ begin
   { have := polynomial.eval₂_eq_zero_of_dvd_of_eval₂_eq_zero f a (denom_mul_dvd x y) hxy,
     rw polynomial.eval₂_mul at this,
     cases mul_eq_zero.mp this; contradiction },
-  rw [div_mul_div_comm₀, eq_div_iff (mul_ne_zero hx hy), div_eq_mul_inv, mul_right_comm,
+  rw [div_mul_div_comm, eq_div_iff (mul_ne_zero hx hy), div_eq_mul_inv, mul_right_comm,
       ← div_eq_mul_inv, div_eq_iff hxy],
   repeat { rw ← polynomial.eval₂_mul },
   congr' 1,
   apply num_denom_mul,
 end
 
+end field
+
 end eval
 
 section int_degree
 
 open polynomial
 
-omit hring
-
 variables [field K]
 
 /-- `int_degree x` is the degree of the rational function `x`, defined as the difference between
@@ -1304,15 +1320,15 @@ by rw [int_degree, num_C, nat_degree_C, denom_C, nat_degree_one, sub_self]
 by rw [int_degree, ratfunc.num_X, polynomial.nat_degree_X, ratfunc.denom_X,
   polynomial.nat_degree_one, int.coe_nat_one, int.coe_nat_zero, sub_zero]
 
-@[simp] lemma int_degree_polynomial {p : polynomial K} :
-  int_degree (algebra_map (polynomial K) (ratfunc K) p) = nat_degree p :=
+@[simp] lemma int_degree_polynomial {p : K[X]} :
+  int_degree (algebra_map K[X] (ratfunc K) p) = nat_degree p :=
 by rw [int_degree, ratfunc.num_algebra_map, ratfunc.denom_algebra_map, polynomial.nat_degree_one,
   int.coe_nat_zero, sub_zero]
 
 lemma int_degree_mul {x y : ratfunc K} (hx : x ≠ 0) (hy : y ≠ 0) :
   int_degree (x * y) = int_degree x + int_degree y :=
 begin
-  simp only [int_degree, add_sub, sub_add, sub_sub_assoc_swap, sub_sub, sub_eq_sub_iff_add_eq_add],
+  simp only [int_degree, add_sub, sub_add, sub_sub_eq_add_sub, sub_sub, sub_eq_sub_iff_add_eq_add],
   norm_cast,
   rw [← polynomial.nat_degree_mul x.denom_ne_zero y.denom_ne_zero,
         ← polynomial.nat_degree_mul (ratfunc.num_ne_zero (mul_ne_zero hx hy))
@@ -1339,7 +1355,7 @@ nat_degree_sub_eq_of_prod_eq (num_ne_zero hxy) ((x + y).denom_ne_zero)
     (num_denom_add x y)
 
 lemma nat_degree_num_mul_right_sub_nat_degree_denom_mul_left_eq_int_degree {x : ratfunc K}
-  (hx : x ≠ 0) {s : polynomial K} (hs : s ≠ 0) :
+  (hx : x ≠ 0) {s : K[X]} (hs : s ≠ 0) :
   ((x.num * s).nat_degree : ℤ) - (s * x.denom).nat_degree = x.int_degree :=
 begin
   apply nat_degree_sub_eq_of_prod_eq (mul_ne_zero (num_ne_zero hx) hs)
@@ -1367,11 +1383,10 @@ section laurent_series
 
 open power_series laurent_series hahn_series
 
-omit hring
 variables {F : Type u} [field F] (p q : F[X]) (f g : ratfunc F)
 
 /-- The coercion `ratfunc F → laurent_series F` as bundled alg hom. -/
-def coe_alg_hom (F : Type u) [field F] : ratfunc F →ₐ[polynomial F] laurent_series F :=
+def coe_alg_hom (F : Type u) [field F] : ratfunc F →ₐ[F[X]] laurent_series F :=
 lift_alg_hom (algebra.of_id _ _) $ non_zero_divisors_le_comap_non_zero_divisors_of_injective _ $
   polynomial.algebra_map_hahn_series_injective _
 
@@ -1397,12 +1412,21 @@ lift_alg_hom_injective _ (polynomial.algebra_map_hahn_series_injective _)
 @[simp, norm_cast] lemma coe_add : ((f + g : ratfunc F) : laurent_series F) = f + g :=
 (coe_alg_hom F).map_add _ _
 
+@[simp, norm_cast] lemma coe_sub : ((f - g : ratfunc F) : laurent_series F) = f - g :=
+(coe_alg_hom F).map_sub _ _
+
+@[simp, norm_cast] lemma coe_neg : ((-f : ratfunc F) : laurent_series F) = -f :=
+(coe_alg_hom F).map_neg _
+
 @[simp, norm_cast] lemma coe_mul : ((f * g : ratfunc F) : laurent_series F) = f * g :=
 (coe_alg_hom F).map_mul _ _
 
+@[simp, norm_cast] lemma coe_pow (n : ℕ) : ((f ^ n  : ratfunc F) : laurent_series F) = f ^ n :=
+(coe_alg_hom F).map_pow _ _
+
 @[simp, norm_cast] lemma coe_div : ((f / g : ratfunc F) : laurent_series F) =
   (f : laurent_series F) / (g : laurent_series F) :=
-(coe_alg_hom F).map_div _ _
+map_div₀ (coe_alg_hom F) _ _
 
 @[simp, norm_cast] lemma coe_C (r : F) : ((C r : ratfunc F) : laurent_series F) = hahn_series.C r :=
 by rw [coe_num_denom, num_C, denom_C, coe_coe, polynomial.coe_C, coe_C, coe_coe, polynomial.coe_one,
diff --git a/src/field_theory/separable.lean b/src/field_theory/separable.lean
index a1dd56957cd6b..6ba14bbcdd1ea 100644
--- a/src/field_theory/separable.lean
+++ b/src/field_theory/separable.lean
@@ -4,25 +4,25 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 
-import algebra.polynomial.big_operators
 import algebra.squarefree
-import field_theory.minpoly
-import field_theory.splitting_field
 import data.polynomial.expand
+import data.polynomial.splits
+import field_theory.minpoly.field
+import ring_theory.power_basis
 
 /-!
 
 # Separable polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define a polynomial to be separable if it is coprime with its derivative. We prove basic
 properties about separable polynomials here.
 
 ## Main definitions
 
 * `polynomial.separable f`: a polynomial `f` is separable iff it is coprime with its derivative.
-* `polynomial.expand R p f`: expand the polynomial `f` with coefficients in a
-  commutative semiring `R` by a factor of p, so `expand R p (∑ aₙ xⁿ)` is `∑ aₙ xⁿᵖ`.
-* `polynomial.contract p f`: the opposite of `expand`, so it sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`.
 
 -/
 
@@ -134,7 +134,7 @@ begin
   apply is_unit_of_self_mul_dvd_separable hsep,
   rw ← sq,
   apply multiplicity.pow_dvd_of_le_multiplicity,
-  simpa only [nat.cast_one, nat.cast_bit0] using enat.add_one_le_of_lt hq
+  simpa only [nat.cast_one, nat.cast_bit0] using part_enat.add_one_le_of_lt hq
 end
 
 lemma separable.squarefree {p : R[X]} (hsep : separable p) : squarefree p :=
@@ -171,7 +171,7 @@ end
 
 lemma separable_prod {ι : Sort*} [fintype ι] {f : ι → R[X]}
   (h1 : pairwise (is_coprime on f)) (h2 : ∀ x, (f x).separable) : (∏ x, f x).separable :=
-separable_prod' (λ x hx y hy hxy, h1 x y hxy) (λ x hx, h2 x)
+separable_prod' (λ x hx y hy hxy, h1 hxy) (λ x hx, h2 x)
 
 lemma separable.inj_of_prod_X_sub_C [nontrivial R] {ι : Sort*} {f : ι → R} {s : finset ι}
   (hfs : (∏ i in s, (X - C (f i))).separable)
@@ -220,7 +220,8 @@ lemma root_multiplicity_le_one_of_separable [nontrivial R] {p : R[X]}
 begin
   by_cases hp : p = 0,
   { simp [hp], },
-  rw [root_multiplicity_eq_multiplicity, dif_neg hp, ← enat.coe_le_coe, enat.coe_get, nat.cast_one],
+  rw [root_multiplicity_eq_multiplicity, dif_neg hp, ← part_enat.coe_le_coe, part_enat.coe_get,
+    nat.cast_one],
   exact multiplicity_le_one_of_separable (not_is_unit_X_sub_C _) hsep
 end
 
@@ -262,7 +263,7 @@ lemma separable_prod_X_sub_C_iff' {ι : Sort*} {f : ι → F} {s : finset ι} :
   (∏ i in s, (X - C (f i))).separable ↔ (∀ (x ∈ s) (y ∈ s), f x = f y → x = y) :=
 ⟨λ hfs x hx y hy hfxy, hfs.inj_of_prod_X_sub_C hx hy hfxy,
 λ H, by { rw ← prod_attach, exact separable_prod' (λ x hx y hy hxy,
-    @pairwise_coprime_X_sub _ _ { x // x ∈ s } (λ x, f x)
+    @pairwise_coprime_X_sub_C _ _ { x // x ∈ s } (λ x, f x)
       (λ x y hxy, subtype.eq $ H x.1 x.2 y.1 y.2 hxy) _ _ hxy)
   (λ _ _, separable_X_sub_C) }⟩
 
@@ -337,7 +338,9 @@ theorem unique_separable_of_irreducible {f : F[X]} (hf : irreducible f) (hp : 0
   n₁ = n₂ ∧ g₁ = g₂ :=
 begin
   revert g₁ g₂,
-  wlog hn : n₁ ≤ n₂ := le_total n₁ n₂ using [n₁ n₂, n₂ n₁],
+  wlog hn : n₁ ≤ n₂,
+  { intros g₁ g₂ hg₁ Hg₁ hg₂ Hg₂,
+    simpa only [eq_comm] using this hf hp n₂ n₁ (le_of_not_le hn) g₂ g₁ hg₂ Hg₂ hg₁ Hg₁ },
   have hf0 : f ≠ 0 := hf.ne_zero,
   unfreezingI { intros, rw le_iff_exists_add at hn, rcases hn with ⟨k, rfl⟩,
     rw [← hgf₁, pow_add, expand_mul, expand_inj (pow_pos hp n₁)] at hgf₂, subst hgf₂,
@@ -346,8 +349,6 @@ begin
     { rw is_unit_iff at h, rcases h with ⟨r, hr, rfl⟩,
       simp_rw expand_C at hf, exact absurd (is_unit_C.2 hr) hf.1 },
     { rw [add_zero, pow_zero, expand_one], split; refl } },
-  obtain ⟨hn, hg⟩ := this g₂ g₁ hg₂ hgf₂ hg₁ hgf₁,
-  exact ⟨hn.symm, hg.symm⟩
 end
 
 end char_p
@@ -367,9 +368,8 @@ begin
   rw [separable_def', derivative_sub, derivative_X_pow, derivative_one, sub_zero],
   -- Suppose `(n : F) = 0`, then the derivative is `0`, so `X ^ n - 1` is a unit, contradiction.
   rintro (h : is_coprime _ _) hn',
-  rw [← C_eq_nat_cast, hn', C.map_zero, zero_mul, is_coprime_zero_right] at h,
-  have := not_is_unit_X_pow_sub_one F n,
-  contradiction
+  rw [hn', C_0, zero_mul, is_coprime_zero_right] at h,
+  exact not_is_unit_X_pow_sub_one F n h
 end
 
 section splits
@@ -404,11 +404,9 @@ end
 
 lemma exists_finset_of_splits
   (i : F →+* K) {f : F[X]} (sep : separable f) (sp : splits i f) :
-  ∃ (s : finset K), f.map i =
-    C (i f.leading_coeff) * (s.prod (λ a : K, (X : K[X]) - C a)) :=
+  ∃ (s : finset K), f.map i = C (i f.leading_coeff) * (s.prod (λ a : K, X - C a)) :=
 begin
-  classical,
-  obtain ⟨s, h⟩ := exists_multiset_of_splits i sp,
+  obtain ⟨s, h⟩ := (splits_iff_exists_multiset _).1 sp,
   use s.to_finset,
   rw [h, finset.prod_eq_multiset_prod, ←multiset.to_finset_eq],
   apply nodup_of_separable_prod,
@@ -490,7 +488,7 @@ variables (F K E : Type*) [field F] [field K] [field E] [algebra F K] [algebra F
   [algebra K E] [is_scalar_tower F K E]
 
 lemma is_separable_tower_top_of_is_separable [is_separable F E] : is_separable K E :=
-⟨λ x, is_integral_of_is_scalar_tower x (is_separable.is_integral F x),
+⟨λ x, is_integral_of_is_scalar_tower (is_separable.is_integral F x),
  λ x, (is_separable.separable F x).map.of_dvd (minpoly.dvd_map_of_is_scalar_tower _ _ _)⟩
 
 lemma is_separable_tower_bot_of_is_separable [h : is_separable F E] : is_separable F K :=
@@ -498,8 +496,7 @@ is_separable_iff.2 $ λ x, begin
   refine (is_separable_iff.1 h (algebra_map K E x)).imp
     is_integral_tower_bot_of_is_integral_field (λ hs, _),
   obtain ⟨q, hq⟩ := minpoly.dvd F x
-    (is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero_field
-      (minpoly.aeval F ((algebra_map K E) x))),
+    ((aeval_algebra_map_eq_zero_iff _ _ _).mp (minpoly.aeval F ((algebra_map K E) x))),
   rw hq at hs,
   exact hs.of_mul_left
 end
diff --git a/src/field_theory/separable_degree.lean b/src/field_theory/separable_degree.lean
index e6f895ae4a5e2..b0314e1a1c4c0 100644
--- a/src/field_theory/separable_degree.lean
+++ b/src/field_theory/separable_degree.lean
@@ -11,15 +11,19 @@ import field_theory.separable
 
 # Separable degree
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains basics about the separable degree of a polynomial.
 
 ## Main results
 
-- `is_separable_contraction`: is the condition that `g(x^(q^m)) = f(x)` for some `m : ℕ`
+- `is_separable_contraction`: is the condition that, for `g` a separable polynomial, we have that
+   `g(x^(q^m)) = f(x)` for some `m : ℕ`.
 - `has_separable_contraction`: the condition of having a separable contraction
 - `has_separable_contraction.degree`: the separable degree, defined as the degree of some
   separable contraction
-- `irreducible_has_separable_contraction`: any irreducible polynomial can be contracted
+- `irreducible.has_separable_contraction`: any irreducible polynomial can be contracted
   to a separable polynomial
 - `has_separable_contraction.dvd_degree'`: the degree of a separable contraction divides the degree,
   in function of the exponential characteristic of the field
@@ -40,7 +44,7 @@ open_locale classical polynomial
 
 section comm_semiring
 
-variables {F : Type} [comm_semiring F] (q : ℕ)
+variables {F : Type*} [comm_semiring F] (q : ℕ)
 
 /-- A separable contraction of a polynomial `f` is a separable polynomial `g` such that
 `g(x^(q^m)) = f(x)` for some `m : ℕ`.-/
@@ -85,13 +89,13 @@ end comm_semiring
 
 section field
 
-variables {F : Type} [field F]
+variables {F : Type*} [field F]
 variables (q : ℕ) {f : F[X]} (hf : has_separable_contraction q f)
 
 /-- Every irreducible polynomial can be contracted to a separable polynomial.
 https://stacks.math.columbia.edu/tag/09H0 -/
-lemma irreducible_has_separable_contraction (q : ℕ) [hF : exp_char F q]
-  (f : F[X]) [irred : irreducible f] : has_separable_contraction q f :=
+lemma _root_.irreducible.has_separable_contraction (q : ℕ) [hF : exp_char F q]
+  (f : F[X]) (irred : irreducible f) : has_separable_contraction q f :=
 begin
   casesI hF,
   { exact ⟨f, irred.separable, ⟨0, by rw [pow_zero, expand_one]⟩⟩ },
@@ -99,45 +103,23 @@ begin
     exact ⟨g, hgs, n, hge⟩, }
 end
 
-/-- A helper lemma: if two expansions (along the positive characteristic) of two polynomials `g` and
-`g'` agree, and the one with the larger degree is separable, then their degrees are the same. -/
-lemma contraction_degree_eq_aux [hq : fact q.prime] [hF : char_p F q]
-  (g g' : F[X]) (m m' : ℕ)
-  (h_expand : expand F (q^m) g = expand F (q^m') g')
-  (h : m < m') (hg : g.separable):
-  g.nat_degree =  g'.nat_degree :=
-begin
-  obtain ⟨s, rfl⟩ := nat.exists_eq_add_of_lt h,
-  rw [add_assoc, pow_add, expand_mul] at h_expand,
-  let aux := expand_injective (pow_pos hq.1.pos m) h_expand,
-  rw aux at hg,
-  have := (is_unit_or_eq_zero_of_separable_expand q (s + 1) hq.out.pos hg).resolve_right
-    s.succ_ne_zero,
-  rw [aux, nat_degree_expand,
-    nat_degree_eq_of_degree_eq_some (degree_eq_zero_of_is_unit this),
-    zero_mul]
-end
-
-/-- If two expansions (along the positive characteristic) of two separable polynomials
-`g` and `g'` agree, then they have the same degree. -/
+/-- If two expansions (along the positive characteristic) of two separable polynomials `g` and `g'`
+agree, then they have the same degree. -/
 theorem contraction_degree_eq_or_insep
-  [hq : fact q.prime] [char_p F q]
+  [hq : ne_zero q] [char_p F q]
   (g g' : F[X]) (m m' : ℕ)
   (h_expand : expand F (q^m) g = expand F (q^m') g')
   (hg : g.separable) (hg' : g'.separable) :
   g.nat_degree = g'.nat_degree :=
 begin
-  by_cases h : m = m',
-  { -- if `m = m'` then we show `g.nat_degree = g'.nat_degree` by unfolding the definitions
-    rw h at h_expand,
-    have expand_deg : ((expand F (q ^ m')) g).nat_degree =
-      (expand F (q ^ m') g').nat_degree, by rw h_expand,
-    rw [nat_degree_expand (q^m') g, nat_degree_expand (q^m') g'] at expand_deg,
-    apply nat.eq_of_mul_eq_mul_left (pow_pos hq.1.pos m'),
-    rw [mul_comm] at expand_deg, rw expand_deg, rw [mul_comm] },
-  { cases ne.lt_or_lt h,
-    { exact contraction_degree_eq_aux q g g' m m' h_expand h_1 hg },
-    { exact (contraction_degree_eq_aux q g' g m' m h_expand.symm h_1 hg').symm, } }
+  wlog hm : m ≤ m',
+  { exact (this g' g m' m h_expand.symm hg' hg (le_of_not_le hm)).symm },
+  obtain ⟨s, rfl⟩ := exists_add_of_le hm,
+  rw [pow_add, expand_mul, expand_inj (pow_pos (ne_zero.pos q) m)] at h_expand,
+  subst h_expand,
+  rcases is_unit_or_eq_zero_of_separable_expand q s (ne_zero.pos q) hg with h | rfl,
+  { rw [nat_degree_expand, nat_degree_eq_zero_of_is_unit h, zero_mul] },
+  { rw [nat_degree_expand, pow_zero, mul_one] },
 end
 
 /-- The separable degree equals the degree of any separable contraction, i.e., it is unique. -/
diff --git a/src/field_theory/splitting_field.lean b/src/field_theory/splitting_field.lean
deleted file mode 100644
index 06699d272c09f..0000000000000
--- a/src/field_theory/splitting_field.lean
+++ /dev/null
@@ -1,951 +0,0 @@
-/-
-Copyright (c) 2018 Chris Hughes. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Chris Hughes
--/
-import field_theory.minpoly
-import ring_theory.adjoin_root
-import linear_algebra.finite_dimensional
-import algebra.polynomial.big_operators
-import ring_theory.algebraic
-import ring_theory.algebra_tower
-import tactic.field_simp
-
-/-!
-# Splitting fields
-
-This file introduces the notion of a splitting field of a polynomial and provides an embedding from
-a splitting field to any field that splits the polynomial. A polynomial `f : polynomial K` splits
-over a field extension `L` of `K` if it is zero or all of its irreducible factors over `L` have
-degree `1`. A field extension of `K` of a polynomial `f : polynomial K` is called a splitting field
-if it is the smallest field extension of `K` such that `f` splits.
-
-## Main definitions
-
-* `polynomial.splits i f`: A predicate on a field homomorphism `i : K → L` and a polynomial `f`
-  saying that `f` is zero or all of its irreducible factors over `L` have degree `1`.
-* `polynomial.splitting_field f`: A fixed splitting field of the polynomial `f`.
-* `polynomial.is_splitting_field`: A predicate on a field to be a splitting field of a polynomial
-  `f`.
-
-## Main statements
-
-* `polynomial.C_leading_coeff_mul_prod_multiset_X_sub_C`: If a polynomial has as many roots as its
-  degree, it can be written as the product of its leading coefficient with `∏ (X - a)` where `a`
-  ranges through its roots.
-* `lift_of_splits`: If `K` and `L` are field extensions of a field `F` and for some finite subset
-  `S` of `K`, the minimal polynomial of every `x ∈ K` splits as a polynomial with coefficients in
-  `L`, then `algebra.adjoin F S` embeds into `L`.
-* `polynomial.is_splitting_field.lift`: An embedding of a splitting field of the polynomial `f` into
-  another field such that `f` splits.
-* `polynomial.is_splitting_field.alg_equiv`: Every splitting field of a polynomial `f` is isomorphic
-  to `splitting_field f` and thus, being a splitting field is unique up to isomorphism.
-
--/
-
-noncomputable theory
-open_locale classical big_operators polynomial
-
-universes u v w
-
-variables {F : Type u} {K : Type v} {L : Type w}
-
-namespace polynomial
-
-variables [field K] [field L] [field F]
-open polynomial
-
-section splits
-
-variables (i : K →+* L)
-
-/-- A polynomial `splits` iff it is zero or all of its irreducible factors have `degree` 1. -/
-def splits (f : K[X]) : Prop :=
-f = 0 ∨ ∀ {g : L[X]}, irreducible g → g ∣ f.map i → degree g = 1
-
-@[simp] lemma splits_zero : splits i (0 : K[X]) := or.inl rfl
-
-@[simp] lemma splits_C (a : K) : splits i (C a) :=
-if ha : a = 0 then ha.symm ▸ (@C_0 K _).symm ▸ splits_zero i
-else
-have hia : i a ≠ 0, from mt ((injective_iff_map_eq_zero i).1
-  i.injective _) ha,
-or.inr $ λ g hg ⟨p, hp⟩, absurd hg.1 (not_not.2 (is_unit_iff_degree_eq_zero.2 $
-  by have := congr_arg degree hp;
-    simp [degree_C hia, @eq_comm (with_bot ℕ) 0,
-      nat.with_bot.add_eq_zero_iff] at this; clear _fun_match; tauto))
-
-lemma splits_of_degree_eq_one {f : K[X]} (hf : degree f = 1) : splits i f :=
-or.inr $ λ g hg ⟨p, hp⟩,
-  by have := congr_arg degree hp;
-  simp [nat.with_bot.add_eq_one_iff, hf, @eq_comm (with_bot ℕ) 1,
-    mt is_unit_iff_degree_eq_zero.2 hg.1] at this;
-  clear _fun_match; tauto
-
-lemma splits_of_degree_le_one {f : K[X]} (hf : degree f ≤ 1) : splits i f :=
-begin
-  cases h : degree f with n,
-  { rw [degree_eq_bot.1 h]; exact splits_zero i },
-  { cases n with n,
-    { rw [eq_C_of_degree_le_zero (trans_rel_right (≤) h le_rfl)];
-      exact splits_C _ _ },
-    { have hn : n = 0,
-      { rw h at hf,
-        cases n, { refl }, { exact absurd hf dec_trivial } },
-      exact splits_of_degree_eq_one _ (by rw [h, hn]; refl) } }
-end
-
-lemma splits_of_nat_degree_le_one {f : K[X]} (hf : nat_degree f ≤ 1) : splits i f :=
-splits_of_degree_le_one i (degree_le_of_nat_degree_le hf)
-
-lemma splits_of_nat_degree_eq_one {f : K[X]} (hf : nat_degree f = 1) : splits i f :=
-splits_of_nat_degree_le_one i (le_of_eq hf)
-
-lemma splits_mul {f g : K[X]} (hf : splits i f) (hg : splits i g) : splits i (f * g) :=
-if h : f * g = 0 then by simp [h]
-else or.inr $ λ p hp hpf, ((principal_ideal_ring.irreducible_iff_prime.1 hp).2.2 _ _
-    (show p ∣ map i f * map i g, by convert hpf; rw polynomial.map_mul)).elim
-  (hf.resolve_left (λ hf, by simpa [hf] using h) hp)
-  (hg.resolve_left (λ hg, by simpa [hg] using h) hp)
-
-lemma splits_of_splits_mul {f g : K[X]} (hfg : f * g ≠ 0) (h : splits i (f * g)) :
-  splits i f ∧ splits i g :=
-⟨or.inr $ λ g hgi hg, or.resolve_left h hfg hgi
-   (by rw polynomial.map_mul; exact hg.trans (dvd_mul_right _ _)),
- or.inr $ λ g hgi hg, or.resolve_left h hfg hgi
-   (by rw polynomial.map_mul; exact hg.trans (dvd_mul_left _ _))⟩
-
-lemma splits_of_splits_of_dvd {f g : K[X]} (hf0 : f ≠ 0) (hf : splits i f) (hgf : g ∣ f) :
-  splits i g :=
-by { obtain ⟨f, rfl⟩ := hgf, exact (splits_of_splits_mul i hf0 hf).1 }
-
-lemma splits_of_splits_gcd_left {f g : K[X]} (hf0 : f ≠ 0) (hf : splits i f) :
-  splits i (euclidean_domain.gcd f g) :=
-polynomial.splits_of_splits_of_dvd i hf0 hf (euclidean_domain.gcd_dvd_left f g)
-
-lemma splits_of_splits_gcd_right {f g : K[X]} (hg0 : g ≠ 0) (hg : splits i g) :
-  splits i (euclidean_domain.gcd f g) :=
-polynomial.splits_of_splits_of_dvd i hg0 hg (euclidean_domain.gcd_dvd_right f g)
-
-lemma splits_map_iff (j : L →+* F) {f : K[X]} :
-  splits j (f.map i) ↔ splits (j.comp i) f :=
-by simp [splits, polynomial.map_map]
-
-theorem splits_one : splits i 1 :=
-splits_C i 1
-
-theorem splits_of_is_unit {u : K[X]} (hu : is_unit u) : u.splits i :=
-splits_of_splits_of_dvd i one_ne_zero (splits_one _) $ is_unit_iff_dvd_one.1 hu
-
-theorem splits_X_sub_C {x : K} : (X - C x).splits i :=
-splits_of_degree_eq_one _ $ degree_X_sub_C x
-
-theorem splits_X : X.splits i :=
-splits_of_degree_eq_one _ $ degree_X
-
-theorem splits_id_iff_splits {f : K[X]} :
-  (f.map i).splits (ring_hom.id L) ↔ f.splits i :=
-by rw [splits_map_iff, ring_hom.id_comp]
-
-theorem splits_mul_iff {f g : K[X]} (hf : f ≠ 0) (hg : g ≠ 0) :
-  (f * g).splits i ↔ f.splits i ∧ g.splits i :=
-⟨splits_of_splits_mul i (mul_ne_zero hf hg), λ ⟨hfs, hgs⟩, splits_mul i hfs hgs⟩
-
-theorem splits_prod {ι : Type u} {s : ι → K[X]} {t : finset ι} :
-  (∀ j ∈ t, (s j).splits i) → (∏ x in t, s x).splits i :=
-begin
-  refine finset.induction_on t (λ _, splits_one i) (λ a t hat ih ht, _),
-  rw finset.forall_mem_insert at ht, rw finset.prod_insert hat,
-  exact splits_mul i ht.1 (ih ht.2)
-end
-
-lemma splits_pow {f : K[X]} (hf : f.splits i) (n : ℕ) : (f ^ n).splits i :=
-begin
-  rw [←finset.card_range n, ←finset.prod_const],
-  exact splits_prod i (λ j hj, hf),
-end
-
-lemma splits_X_pow (n : ℕ) : (X ^ n).splits i := splits_pow i (splits_X i) n
-
-theorem splits_prod_iff {ι : Type u} {s : ι → K[X]} {t : finset ι} :
-  (∀ j ∈ t, s j ≠ 0) → ((∏ x in t, s x).splits i ↔ ∀ j ∈ t, (s j).splits i) :=
-begin
-  refine finset.induction_on t (λ _, ⟨λ _ _ h, h.elim, λ _, splits_one i⟩) (λ a t hat ih ht, _),
-  rw finset.forall_mem_insert at ht ⊢,
-  rw [finset.prod_insert hat, splits_mul_iff i ht.1 (finset.prod_ne_zero_iff.2 ht.2), ih ht.2]
-end
-
-lemma degree_eq_one_of_irreducible_of_splits {p : L[X]}
-  (hp : irreducible p) (hp_splits : splits (ring_hom.id L) p) :
-  p.degree = 1 :=
-begin
-  by_cases h_nz : p = 0,
-  { exfalso, simp [*] at *, },
-  rcases hp_splits,
-  { contradiction },
-  { apply hp_splits hp, simp }
-end
-
-lemma exists_root_of_splits {f : K[X]} (hs : splits i f) (hf0 : degree f ≠ 0) :
-  ∃ x, eval₂ i x f = 0 :=
-if hf0 : f = 0 then ⟨37, by simp [hf0]⟩
-else
-  let ⟨g, hg⟩ := wf_dvd_monoid.exists_irreducible_factor
-    (show ¬ is_unit (f.map i), from mt is_unit_iff_degree_eq_zero.1 (by rwa degree_map))
-    (map_ne_zero hf0) in
-  let ⟨x, hx⟩ := exists_root_of_degree_eq_one (hs.resolve_left hf0 hg.1 hg.2) in
-  let ⟨i, hi⟩ := hg.2 in
-  ⟨x, by rw [← eval_map, hi, eval_mul, show _ = _, from hx, zero_mul]⟩
-
-lemma exists_multiset_of_splits {f : K[X]} : splits i f →
-  ∃ (s : multiset L), f.map i = C (i f.leading_coeff) *
-  (s.map (λ a : L, (X : L[X]) - C a)).prod :=
-suffices splits (ring_hom.id _) (f.map i) → ∃ s : multiset L, f.map i =
-  (C (f.map i).leading_coeff) * (s.map (λ a : L, (X : L[X]) - C a)).prod,
-by rwa [splits_map_iff, leading_coeff_map i] at this,
-wf_dvd_monoid.induction_on_irreducible (f.map i)
-  (λ _, ⟨{37}, by simp [i.map_zero]⟩)
-  (λ u hu _, ⟨0,
-    by conv_lhs { rw eq_C_of_degree_eq_zero (is_unit_iff_degree_eq_zero.1 hu) };
-      simp [leading_coeff, nat_degree_eq_of_degree_eq_some (is_unit_iff_degree_eq_zero.1 hu)]⟩)
-  (λ f p hf0 hp ih hfs,
-    have hpf0 : p * f ≠ 0, from mul_ne_zero hp.ne_zero hf0,
-    let ⟨s, hs⟩ := ih (splits_of_splits_mul _ hpf0 hfs).2 in
-    ⟨-(p * norm_unit p).coeff 0 ::ₘ s,
-      have hp1 : degree p = 1, from hfs.resolve_left hpf0 hp (by simp),
-      begin
-        rw [multiset.map_cons, multiset.prod_cons, leading_coeff_mul, C_mul, mul_assoc,
-          mul_left_comm (C f.leading_coeff), ← hs, ← mul_assoc, mul_left_inj' hf0],
-        conv_lhs {rw eq_X_add_C_of_degree_eq_one hp1},
-        simp only [mul_add, coe_norm_unit_of_ne_zero hp.ne_zero, mul_comm p, coeff_neg,
-          C_neg, sub_eq_add_neg, neg_neg, coeff_C_mul, (mul_assoc _ _ _).symm, C_mul.symm,
-          mul_inv_cancel (show p.leading_coeff ≠ 0, from mt leading_coeff_eq_zero.1
-            hp.ne_zero), one_mul],
-      end⟩)
-
-/-- Pick a root of a polynomial that splits. -/
-def root_of_splits {f : K[X]} (hf : f.splits i) (hfd : f.degree ≠ 0) : L :=
-classical.some $ exists_root_of_splits i hf hfd
-
-theorem map_root_of_splits {f : K[X]} (hf : f.splits i) (hfd) :
-  f.eval₂ i (root_of_splits i hf hfd) = 0 :=
-classical.some_spec $ exists_root_of_splits i hf hfd
-
-theorem roots_map {f : K[X]} (hf : f.splits $ ring_hom.id K) :
-  (f.map i).roots = (f.roots).map i :=
-if hf0 : f = 0 then by rw [hf0, polynomial.map_zero, roots_zero, roots_zero, multiset.map_zero] else
-have hmf0 : f.map i ≠ 0 := map_ne_zero hf0,
-let ⟨m, hm⟩ := exists_multiset_of_splits _ hf in
-have h1 : (0 : K[X]) ∉ m.map (λ r, X - C r),
-  from zero_nmem_multiset_map_X_sub_C _ _,
-have h2 : (0 : L[X]) ∉ m.map (λ r, X - C (i r)),
-  from zero_nmem_multiset_map_X_sub_C _ _,
-begin
-  rw map_id at hm, rw hm at hf0 hmf0 ⊢, rw polynomial.map_mul at hmf0 ⊢,
-  rw [roots_mul hf0, roots_mul hmf0, map_C, roots_C, zero_add, roots_C, zero_add,
-      polynomial.map_multiset_prod, multiset.map_map],
-  simp_rw [(∘), polynomial.map_sub, map_X, map_C],
-  rw [roots_multiset_prod _ h2, multiset.bind_map,
-      roots_multiset_prod _ h1, multiset.bind_map],
-  simp_rw roots_X_sub_C,
-  rw [multiset.bind_singleton, multiset.bind_singleton, multiset.map_id']
-end
-
-lemma eq_prod_roots_of_splits {p : K[X]} {i : K →+* L}
-  (hsplit : splits i p) :
-  p.map i = C (i p.leading_coeff) * ((p.map i).roots.map (λ a, X - C a)).prod :=
-begin
-  by_cases p_eq_zero : p = 0,
-  { rw [p_eq_zero, polynomial.map_zero, leading_coeff_zero, i.map_zero, C.map_zero, zero_mul] },
-
-  obtain ⟨s, hs⟩ := exists_multiset_of_splits i hsplit,
-  have map_ne_zero : p.map i ≠ 0 := map_ne_zero (p_eq_zero),
-  have prod_ne_zero : C (i p.leading_coeff) * (multiset.map (λ a, X - C a) s).prod ≠ 0 :=
-    by rwa hs at map_ne_zero,
-
-  have zero_nmem : (0 : L[X]) ∉ s.map (λ a, X - C a),
-    from zero_nmem_multiset_map_X_sub_C _ _,
-  have map_bind_roots_eq : (s.map (λ a, X - C a)).bind (λ a, a.roots) = s,
-  { refine multiset.induction_on s (by rw [multiset.map_zero, multiset.zero_bind]) _,
-    intros a s ih,
-    rw [multiset.map_cons, multiset.cons_bind, ih, roots_X_sub_C, multiset.singleton_add] },
-
-  rw [hs, roots_mul prod_ne_zero, roots_C, zero_add,
-      roots_multiset_prod _ zero_nmem,
-      map_bind_roots_eq]
-end
-
-lemma eq_prod_roots_of_splits_id {p : K[X]}
-  (hsplit : splits (ring_hom.id K) p) :
-  p = C (p.leading_coeff) * (p.roots.map (λ a, X - C a)).prod :=
-by simpa using eq_prod_roots_of_splits hsplit
-
-lemma eq_prod_roots_of_monic_of_splits_id {p : K[X]}
-  (m : monic p) (hsplit : splits (ring_hom.id K) p) :
-  p = (p.roots.map (λ a, X - C a)).prod :=
-begin
-  convert eq_prod_roots_of_splits_id hsplit,
-  simp [m],
-end
-
-lemma eq_X_sub_C_of_splits_of_single_root {x : K} {h : K[X]} (h_splits : splits i h)
-  (h_roots : (h.map i).roots = {i x}) : h = (C (leading_coeff h)) * (X - C x) :=
-begin
-  apply polynomial.map_injective _ i.injective,
-  rw [eq_prod_roots_of_splits h_splits, h_roots],
-  simp,
-end
-
-lemma nat_degree_eq_card_roots {p : K[X]} {i : K →+* L}
-  (hsplit : splits i p) : p.nat_degree = (p.map i).roots.card :=
-begin
-  by_cases p_eq_zero : p = 0,
-  { rw [p_eq_zero, nat_degree_zero, polynomial.map_zero, roots_zero, multiset.card_zero] },
-  have map_ne_zero : p.map i ≠ 0 := map_ne_zero (p_eq_zero),
-  rw eq_prod_roots_of_splits hsplit at map_ne_zero,
-
-  conv_lhs { rw [← nat_degree_map i, eq_prod_roots_of_splits hsplit] },
-  have : (0 : L[X]) ∉ (map i p).roots.map (λ a, X - C a),
-    from zero_nmem_multiset_map_X_sub_C _ _,
-  simp [nat_degree_mul (left_ne_zero_of_mul map_ne_zero) (right_ne_zero_of_mul map_ne_zero),
-        nat_degree_multiset_prod _ this]
-end
-
-lemma degree_eq_card_roots {p : K[X]} {i : K →+* L} (p_ne_zero : p ≠ 0)
-  (hsplit : splits i p) : p.degree = (p.map i).roots.card :=
-by rw [degree_eq_nat_degree p_ne_zero, nat_degree_eq_card_roots hsplit]
-
-section UFD
-
-local attribute [instance, priority 10] principal_ideal_ring.to_unique_factorization_monoid
-local infix ` ~ᵤ ` : 50 := associated
-
-open unique_factorization_monoid associates
-
-lemma splits_of_exists_multiset {f : K[X]} {s : multiset L}
-  (hs : f.map i = C (i f.leading_coeff) * (s.map (λ a : L, (X : L[X]) - C a)).prod) :
-  splits i f :=
-if hf0 : f = 0 then or.inl hf0
-else
-  or.inr $ λ p hp hdp,
-    have ht : multiset.rel associated
-      (normalized_factors (f.map i)) (s.map (λ a : L, (X : L[X]) - C a)) :=
-    factors_unique
-      (λ p hp, irreducible_of_normalized_factor _ hp)
-      (λ p' m, begin
-          obtain ⟨a,m,rfl⟩ := multiset.mem_map.1 m,
-          exact irreducible_of_degree_eq_one (degree_X_sub_C _),
-        end)
-      (associated.symm $ calc _ ~ᵤ f.map i :
-        ⟨(units.map C.to_monoid_hom : Lˣ →* (polynomial L)ˣ)
-          (units.mk0 (f.map i).leading_coeff
-            (mt leading_coeff_eq_zero.1 (map_ne_zero hf0))),
-          by conv_rhs { rw [hs, ← leading_coeff_map i, mul_comm] }; refl⟩
-        ... ~ᵤ _ : (unique_factorization_monoid.normalized_factors_prod (by simpa using hf0)).symm),
-  let ⟨q, hq, hpq⟩ := exists_mem_normalized_factors_of_dvd (by simpa) hp hdp in
-  let ⟨q', hq', hqq'⟩ := multiset.exists_mem_of_rel_of_mem ht hq in
-  let ⟨a, ha⟩ := multiset.mem_map.1 hq' in
-  by rw [← degree_X_sub_C a, ha.2];
-    exact degree_eq_degree_of_associated (hpq.trans hqq')
-
-lemma splits_of_splits_id {f : K[X]} : splits (ring_hom.id _) f → splits i f :=
-unique_factorization_monoid.induction_on_prime f (λ _, splits_zero _)
-  (λ _ hu _, splits_of_degree_le_one _
-    ((is_unit_iff_degree_eq_zero.1 hu).symm ▸ dec_trivial))
-  (λ a p ha0 hp ih hfi, splits_mul _
-    (splits_of_degree_eq_one _
-      ((splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).1.resolve_left
-        hp.1 hp.irreducible (by rw map_id)))
-    (ih (splits_of_splits_mul _ (mul_ne_zero hp.1 ha0) hfi).2))
-
-end UFD
-
-lemma splits_iff_exists_multiset {f : K[X]} : splits i f ↔
-  ∃ (s : multiset L), f.map i = C (i f.leading_coeff) *
-  (s.map (λ a : L, (X : L[X]) - C a)).prod :=
-⟨exists_multiset_of_splits i, λ ⟨s, hs⟩, splits_of_exists_multiset i hs⟩
-
-lemma splits_comp_of_splits (j : L →+* F) {f : K[X]}
-  (h : splits i f) : splits (j.comp i) f :=
-begin
-  change i with ((ring_hom.id _).comp i) at h,
-  rw [← splits_map_iff],
-  rw [← splits_map_iff i] at h,
-  exact splits_of_splits_id _ h
-end
-
-/-- A monic polynomial `p` that has as many roots as its degree
-can be written `p = ∏(X - a)`, for `a` in `p.roots`. -/
-private lemma prod_multiset_X_sub_C_of_monic_of_roots_card_eq_of_field {p : K[X]}
-  (hmonic : p.monic) (hroots : p.roots.card = p.nat_degree) :
-  (multiset.map (λ (a : K), X - C a) p.roots).prod = p :=
-begin
-  have hprodmonic : (multiset.map (λ (a : K), X - C a) p.roots).prod.monic,
-  { simp only [prod_multiset_root_eq_finset_root,
-      monic_prod_of_monic, monic_X_sub_C, monic.pow, forall_true_iff] },
-  have hdegree : (multiset.map (λ (a : K), X - C a) p.roots).prod.nat_degree = p.nat_degree,
-  { rw [← hroots, nat_degree_multiset_prod _ (zero_nmem_multiset_map_X_sub_C _ (λ a : K, a))],
-    simp only [eq_self_iff_true, mul_one, nat.cast_id, nsmul_eq_mul, multiset.sum_repeat,
-      multiset.map_const,nat_degree_X_sub_C, function.comp, multiset.map_map] },
-  obtain ⟨q, hq⟩ := prod_multiset_X_sub_C_dvd p,
-  have qzero : q ≠ 0,
-  { rintro rfl, apply hmonic.ne_zero, simpa only [mul_zero] using hq },
-  have degp :
-    p.nat_degree = (multiset.map (λ (a : K), X - C a) p.roots).prod.nat_degree + q.nat_degree,
-  { nth_rewrite 0 [hq],
-    simp only [nat_degree_mul hprodmonic.ne_zero qzero] },
-  have degq : q.nat_degree = 0,
-  { rw hdegree at degp,
-    rw [← add_right_inj p.nat_degree, ← degp, add_zero], },
-  obtain ⟨u, hu⟩ := is_unit_iff_degree_eq_zero.2 ((degree_eq_iff_nat_degree_eq qzero).2 degq),
-  have hassoc : associated (multiset.map (λ (a : K), X - C a) p.roots).prod p,
-  { rw associated, use u, rw [hu, ← hq] },
-  exact eq_of_monic_of_associated hprodmonic hmonic hassoc
-end
-
-lemma prod_multiset_X_sub_C_of_monic_of_roots_card_eq {K : Type*} [comm_ring K] [is_domain K]
-  {p : K[X]} (hmonic : p.monic) (hroots : p.roots.card = p.nat_degree) :
-  (multiset.map (λ (a : K), X - C a) p.roots).prod = p :=
-begin
-  apply map_injective _ (is_fraction_ring.injective K (fraction_ring K)),
-  rw polynomial.map_multiset_prod,
-  simp only [map_C, function.comp_app, map_X, multiset.map_map, polynomial.map_sub],
-  have : p.roots.map (algebra_map K (fraction_ring K)) =
-    (map (algebra_map K (fraction_ring K)) p).roots :=
-    roots_map_of_injective_card_eq_total_degree
-      (is_fraction_ring.injective K (fraction_ring K)) hroots,
-  rw ← prod_multiset_X_sub_C_of_monic_of_roots_card_eq_of_field
-    (hmonic.map (algebra_map K (fraction_ring K))),
-  { simp only [map_C, function.comp_app, map_X, polynomial.map_sub],
-    congr' 1,
-    rw ← this,
-    simp, },
-  { rw [nat_degree_map_eq_of_injective (is_fraction_ring.injective K (fraction_ring K)), ← this],
-    simp only [←hroots, multiset.card_map], },
-end
-
-/-- A polynomial `p` that has as many roots as its degree
-can be written `p = p.leading_coeff * ∏(X - a)`, for `a` in `p.roots`.
-Used to prove the more general `C_leading_coeff_mul_prod_multiset_X_sub_C` below. -/
-private lemma C_leading_coeff_mul_prod_multiset_X_sub_C_of_field {p : K[X]}
-  (hroots : p.roots.card = p.nat_degree) :
-  C p.leading_coeff * (multiset.map (λ (a : K), X - C a) p.roots).prod = p :=
-begin
-  by_cases hzero : p = 0,
-  { rw [hzero, leading_coeff_zero, ring_hom.map_zero, zero_mul], },
-  { have hcoeff : p.leading_coeff ≠ 0,
-    { intro h, exact hzero (leading_coeff_eq_zero.1 h) },
-    have hrootsnorm : (normalize p).roots.card = (normalize p).nat_degree,
-    { rw [roots_normalize, normalize_apply, nat_degree_mul hzero (units.ne_zero _), hroots,
-          coe_norm_unit, nat_degree_C, add_zero], },
-    have hprod := prod_multiset_X_sub_C_of_monic_of_roots_card_eq (monic_normalize hzero)
-                    hrootsnorm,
-    rw [roots_normalize, normalize_apply, coe_norm_unit_of_ne_zero hzero] at hprod,
-    calc (C p.leading_coeff) * (multiset.map (λ (a : K), X - C a) p.roots).prod
-        = p * C ((p.leading_coeff)⁻¹ * p.leading_coeff) :
-        by rw [hprod, mul_comm, mul_assoc, ← C_mul]
-    ... = p * C 1 : by field_simp
-    ... = p : by simp only [mul_one, ring_hom.map_one], },
-end
-
-/-- A polynomial `p` that has as many roots as its degree
-can be written `p = p.leading_coeff * ∏(X - a)`, for `a` in `p.roots`. -/
-lemma C_leading_coeff_mul_prod_multiset_X_sub_C {K : Type*} [comm_ring K] [is_domain K]
-  {p : K[X]} (hroots : p.roots.card = p.nat_degree) :
-  C p.leading_coeff * (multiset.map (λ (a : K), X - C a) p.roots).prod = p :=
-begin
-  by_cases hzero : p = 0,
-  { rw [hzero, leading_coeff_zero, ring_hom.map_zero, zero_mul], },
-  have hcoeff : p.leading_coeff ≠ 0,
-  { intro h, exact hzero (leading_coeff_eq_zero.1 h) },
-  apply map_injective _ (is_fraction_ring.injective K (fraction_ring K)),
-  rw [polynomial.map_mul, polynomial.map_multiset_prod],
-  simp only [map_C, function.comp_app, map_X, multiset.map_map, polynomial.map_sub],
-  have h : p.roots.map (algebra_map K (fraction_ring K)) =
-    (map (algebra_map K (fraction_ring K)) p).roots :=
-    roots_map_of_injective_card_eq_total_degree
-      (is_fraction_ring.injective K (fraction_ring K)) hroots,
-  have : multiset.card (map (algebra_map K (fraction_ring K)) p).roots =
-    (map (algebra_map K (fraction_ring K)) p).nat_degree,
-  { rw [nat_degree_map_eq_of_injective (is_fraction_ring.injective K (fraction_ring K)), ← h],
-    simp only [←hroots, multiset.card_map], },
-  rw [← C_leading_coeff_mul_prod_multiset_X_sub_C_of_field this],
-  simp only [map_C, function.comp_app, map_X, polynomial.map_sub],
-  have w : (algebra_map K (fraction_ring K)) p.leading_coeff ≠ 0,
-  { intro hn,
-    apply hcoeff,
-    apply is_fraction_ring.injective K (fraction_ring K),
-    simp [hn], },
-  rw [←h, leading_coeff_map_of_leading_coeff_ne_zero _ w, multiset.map_map],
-end
-
-/-- A polynomial splits if and only if it has as many roots as its degree. -/
-lemma splits_iff_card_roots {p : K[X]} :
-  splits (ring_hom.id K) p ↔ p.roots.card = p.nat_degree :=
-begin
-  split,
-  { intro H, rw [nat_degree_eq_card_roots H, map_id] },
-  { intro hroots,
-    apply (splits_iff_exists_multiset (ring_hom.id K)).2,
-    use p.roots,
-    simp only [ring_hom.id_apply, map_id],
-    exact (C_leading_coeff_mul_prod_multiset_X_sub_C hroots).symm },
-end
-
-lemma aeval_root_derivative_of_splits [algebra K L] {P : K[X]} (hmo : P.monic)
-  (hP : P.splits (algebra_map K L)) {r : L} (hr : r ∈ (P.map (algebra_map K L)).roots) :
-  aeval r P.derivative =
-  (multiset.map (λ a, r - a) ((P.map (algebra_map K L)).roots.erase r)).prod :=
-begin
-  replace hmo := hmo.map (algebra_map K L),
-  replace hP := (splits_id_iff_splits (algebra_map K L)).2 hP,
-  rw [aeval_def, ← eval_map, ← derivative_map],
-  nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP],
-  rw [eval_multiset_prod_X_sub_C_derivative hr]
-end
-
-/-- If `P` is a monic polynomial that splits, then `coeff P 0` equals the product of the roots. -/
-lemma prod_roots_eq_coeff_zero_of_monic_of_split {P : K[X]} (hmo : P.monic)
-  (hP : P.splits (ring_hom.id K)) : coeff P 0 = (-1) ^ P.nat_degree * P.roots.prod :=
-begin
-  nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP],
-  rw [coeff_zero_eq_eval_zero, eval_multiset_prod, multiset.map_map],
-  simp_rw [function.comp_app, eval_sub, eval_X, zero_sub, eval_C],
-  conv_lhs { congr, congr, funext,
-    rw [neg_eq_neg_one_mul] },
-  rw [multiset.prod_map_mul, multiset.map_const, multiset.prod_repeat, multiset.map_id',
-    splits_iff_card_roots.1 hP]
-end
-
-/-- If `P` is a monic polynomial that splits, then `P.next_coeff` equals the sum of the roots. -/
-lemma sum_roots_eq_next_coeff_of_monic_of_split {P : K[X]} (hmo : P.monic)
-  (hP : P.splits (ring_hom.id K)) : P.next_coeff = - P.roots.sum :=
-begin
-  nth_rewrite 0 [eq_prod_roots_of_monic_of_splits_id hmo hP],
-  rw [monic.next_coeff_multiset_prod _ _ (λ a ha, _)],
-  { simp_rw [next_coeff_X_sub_C, multiset.sum_map_neg] },
-  { exact monic_X_sub_C a }
-end
-
-end splits
-
-end polynomial
-
-
-section embeddings
-
-variables (F) [field F]
-
-/-- If `p` is the minimal polynomial of `a` over `F` then `F[a] ≃ₐ[F] F[x]/(p)` -/
-def alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly
-  {R : Type*} [comm_ring R] [algebra F R] (x : R) :
-  algebra.adjoin F ({x} : set R) ≃ₐ[F] adjoin_root (minpoly F x) :=
-alg_equiv.symm $ alg_equiv.of_bijective
-  (alg_hom.cod_restrict
-    (adjoin_root.lift_hom _ x $ minpoly.aeval F x) _
-    (λ p, adjoin_root.induction_on _ p $ λ p,
-      (algebra.adjoin_singleton_eq_range_aeval F x).symm ▸
-        (polynomial.aeval _).mem_range.mpr ⟨p, rfl⟩))
-  ⟨(alg_hom.injective_cod_restrict _ _ _).2 $ (injective_iff_map_eq_zero _).2 $ λ p,
-    adjoin_root.induction_on _ p $ λ p hp, ideal.quotient.eq_zero_iff_mem.2 $
-    ideal.mem_span_singleton.2 $ minpoly.dvd F x hp,
-  λ y,
-    let ⟨p, hp⟩ := (set_like.ext_iff.1
-      (algebra.adjoin_singleton_eq_range_aeval F x) (y : R)).1 y.2 in
-    ⟨adjoin_root.mk _ p, subtype.eq hp⟩⟩
-
-open finset
-
-/-- If a `subalgebra` is finite_dimensional as a submodule then it is `finite_dimensional`. -/
-lemma finite_dimensional.of_subalgebra_to_submodule
-  {K V : Type*} [field K] [ring V] [algebra K V] {s : subalgebra K V}
-  (h : finite_dimensional K s.to_submodule) : finite_dimensional K s := h
-
-/-- If `K` and `L` are field extensions of `F` and we have `s : finset K` such that
-the minimal polynomial of each `x ∈ s` splits in `L` then `algebra.adjoin F s` embeds in `L`. -/
-theorem lift_of_splits {F K L : Type*} [field F] [field K] [field L]
-  [algebra F K] [algebra F L] (s : finset K) :
-  (∀ x ∈ s, is_integral F x ∧ polynomial.splits (algebra_map F L) (minpoly F x)) →
-  nonempty (algebra.adjoin F (↑s : set K) →ₐ[F] L) :=
-begin
-  refine finset.induction_on s (λ H, _) (λ a s has ih H, _),
-  { rw [coe_empty, algebra.adjoin_empty],
-    exact ⟨(algebra.of_id F L).comp (algebra.bot_equiv F K)⟩ },
-  rw forall_mem_insert at H, rcases H with ⟨⟨H1, H2⟩, H3⟩, cases ih H3 with f,
-  choose H3 H4 using H3,
-  rw [coe_insert, set.insert_eq, set.union_comm, algebra.adjoin_union_eq_adjoin_adjoin],
-  letI := (f : algebra.adjoin F (↑s : set K) →+* L).to_algebra,
-  haveI : finite_dimensional F (algebra.adjoin F (↑s : set K)) := (
-    (submodule.fg_iff_finite_dimensional _).1
-      (fg_adjoin_of_finite (set.finite_mem_finset s) H3)).of_subalgebra_to_submodule,
-  letI := field_of_finite_dimensional F (algebra.adjoin F (↑s : set K)),
-  have H5 : is_integral (algebra.adjoin F (↑s : set K)) a := is_integral_of_is_scalar_tower a H1,
-  have H6 : (minpoly (algebra.adjoin F (↑s : set K)) a).splits
-    (algebra_map (algebra.adjoin F (↑s : set K)) L),
-  { refine polynomial.splits_of_splits_of_dvd _
-      (polynomial.map_ne_zero $ minpoly.ne_zero H1 :
-        polynomial.map (algebra_map _ _) _ ≠ 0)
-      ((polynomial.splits_map_iff _ _).2 _)
-      (minpoly.dvd _ _ _),
-    { rw ← is_scalar_tower.algebra_map_eq, exact H2 },
-    { rw [← is_scalar_tower.aeval_apply, minpoly.aeval] } },
-  obtain ⟨y, hy⟩ := polynomial.exists_root_of_splits _ H6 (ne_of_lt (minpoly.degree_pos H5)).symm,
-  refine ⟨subalgebra.of_restrict_scalars _ _ _⟩,
-  refine (adjoin_root.lift_hom (minpoly (algebra.adjoin F (↑s : set K)) a) y hy).comp _,
-  exact alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly (algebra.adjoin F (↑s : set K)) a
-end
-
-end embeddings
-
-
-namespace polynomial
-
-variables [field K] [field L] [field F]
-open polynomial
-
-section splitting_field
-
-/-- Non-computably choose an irreducible factor from a polynomial. -/
-def factor (f : K[X]) : K[X] :=
-if H : ∃ g, irreducible g ∧ g ∣ f then classical.some H else X
-
-instance irreducible_factor (f : K[X]) : irreducible (factor f) :=
-begin
-  rw factor, split_ifs with H, { exact (classical.some_spec H).1 }, { exact irreducible_X }
-end
-
-theorem factor_dvd_of_not_is_unit {f : K[X]} (hf1 : ¬is_unit f) : factor f ∣ f :=
-begin
-  by_cases hf2 : f = 0, { rw hf2, exact dvd_zero _ },
-  rw [factor, dif_pos (wf_dvd_monoid.exists_irreducible_factor hf1 hf2)],
-  exact (classical.some_spec $ wf_dvd_monoid.exists_irreducible_factor hf1 hf2).2
-end
-
-theorem factor_dvd_of_degree_ne_zero {f : K[X]} (hf : f.degree ≠ 0) : factor f ∣ f :=
-factor_dvd_of_not_is_unit (mt degree_eq_zero_of_is_unit hf)
-
-theorem factor_dvd_of_nat_degree_ne_zero {f : K[X]} (hf : f.nat_degree ≠ 0) :
-  factor f ∣ f :=
-factor_dvd_of_degree_ne_zero (mt nat_degree_eq_of_degree_eq_some hf)
-
-/-- Divide a polynomial f by X - C r where r is a root of f in a bigger field extension. -/
-def remove_factor (f : K[X]) : polynomial (adjoin_root $ factor f) :=
-map (adjoin_root.of f.factor) f /ₘ (X - C (adjoin_root.root f.factor))
-
-theorem X_sub_C_mul_remove_factor (f : K[X]) (hf : f.nat_degree ≠ 0) :
-  (X - C (adjoin_root.root f.factor)) * f.remove_factor = map (adjoin_root.of f.factor) f :=
-let ⟨g, hg⟩ := factor_dvd_of_nat_degree_ne_zero hf in
-mul_div_by_monic_eq_iff_is_root.2 $ by rw [is_root.def, eval_map, hg, eval₂_mul, ← hg,
-    adjoin_root.eval₂_root, zero_mul]
-
-theorem nat_degree_remove_factor (f : K[X]) :
-  f.remove_factor.nat_degree = f.nat_degree - 1 :=
-by rw [remove_factor, nat_degree_div_by_monic _ (monic_X_sub_C _), nat_degree_map,
-       nat_degree_X_sub_C]
-
-theorem nat_degree_remove_factor' {f : K[X]} {n : ℕ} (hfn : f.nat_degree = n+1) :
-  f.remove_factor.nat_degree = n :=
-by rw [nat_degree_remove_factor, hfn, n.add_sub_cancel]
-
-/-- Auxiliary construction to a splitting field of a polynomial. Uses induction on the degree. -/
-def splitting_field_aux (n : ℕ) : Π {K : Type u} [field K], by exactI Π (f : K[X]),
-  f.nat_degree = n → Type u :=
-nat.rec_on n (λ K _ _ _, K) $ λ n ih K _ f hf, by exactI
-ih f.remove_factor (nat_degree_remove_factor' hf)
-
-namespace splitting_field_aux
-
-theorem succ (n : ℕ) (f : K[X]) (hfn : f.nat_degree = n + 1) :
-  splitting_field_aux (n+1) f hfn =
-    splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn) := rfl
-
-instance field (n : ℕ) : Π {K : Type u} [field K], by exactI
-  Π {f : K[X]} (hfn : f.nat_degree = n), field (splitting_field_aux n f hfn) :=
-nat.rec_on n (λ K _ _ _, ‹field K›) $ λ n ih K _ f hf, ih _
-
-instance inhabited {n : ℕ} {f : K[X]} (hfn : f.nat_degree = n) :
-  inhabited (splitting_field_aux n f hfn) := ⟨37⟩
-
-/-
-Note that the recursive nature of this definition and `splitting_field_aux.field` creates
-non-definitionally-equal diamonds in the `ℕ`- and `ℤ`- actions.
-```lean
-example (n : ℕ) {K : Type u} [field K] {f : K[X]} (hfn : f.nat_degree = n) :
-    (add_comm_monoid.nat_module : module ℕ (splitting_field_aux n f hfn)) =
-  @algebra.to_module _ _ _ _ (splitting_field_aux.algebra n _ hfn) :=
-rfl  -- fails
-```
-It's not immediately clear whether this _can_ be fixed; the failure is much the same as the reason
-that the following fails:
-```lean
-def cases_twice {α} (a₀ aₙ : α) : ℕ → α × α
-| 0 := (a₀, a₀)
-| (n + 1) := (aₙ, aₙ)
-
-example (x : ℕ) {α} (a₀ aₙ : α) : (cases_twice a₀ aₙ x).1 = (cases_twice a₀ aₙ x).2 := rfl  -- fails
-```
-We don't really care at this point because this is an implementation detail (which is why this is
-not a docstring), but we do in `splitting_field.algebra'` below. -/
-instance algebra (n : ℕ) : Π (R : Type*) {K : Type u} [comm_semiring R] [field K],
-  by exactI Π [algebra R K] {f : K[X]} (hfn : f.nat_degree = n),
-    algebra R (splitting_field_aux n f hfn) :=
-nat.rec_on n (λ R K _ _ _ _ _, by exactI ‹algebra R K›) $
-         λ n ih R K _ _ _ f hfn, by exactI ih R (nat_degree_remove_factor' hfn)
-
-instance is_scalar_tower (n : ℕ) : Π (R₁ R₂ : Type*) {K : Type u}
-  [comm_semiring R₁] [comm_semiring R₂] [has_scalar R₁ R₂] [field K],
-  by exactI Π [algebra R₁ K] [algebra R₂ K],
-  by exactI Π [is_scalar_tower R₁ R₂ K] {f : K[X]} (hfn : f.nat_degree = n),
-    is_scalar_tower R₁ R₂ (splitting_field_aux n f hfn) :=
-nat.rec_on n (λ R₁ R₂ K _ _ _ _ _ _ _ _ _, by exactI ‹is_scalar_tower R₁ R₂ K›) $
-         λ n ih R₁ R₂ K _ _ _ _ _ _ _ f hfn, by exactI ih R₁ R₂ (nat_degree_remove_factor' hfn)
-
-instance algebra''' {n : ℕ} {f : K[X]} (hfn : f.nat_degree = n + 1) :
-  algebra (adjoin_root f.factor)
-    (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)) :=
-splitting_field_aux.algebra n _ _
-
-instance algebra' {n : ℕ} {f : K[X]} (hfn : f.nat_degree = n + 1) :
-  algebra (adjoin_root f.factor) (splitting_field_aux n.succ f hfn) :=
-splitting_field_aux.algebra''' _
-
-instance algebra'' {n : ℕ} {f : K[X]} (hfn : f.nat_degree = n + 1) :
-  algebra K (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)) :=
-splitting_field_aux.algebra n K _
-
-instance scalar_tower' {n : ℕ} {f : K[X]} (hfn : f.nat_degree = n + 1) :
-  is_scalar_tower K (adjoin_root f.factor)
-    (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)) :=
-begin
-  -- finding this instance ourselves makes things faster
-  haveI : is_scalar_tower K (adjoin_root f.factor) (adjoin_root f.factor) :=
-    is_scalar_tower.right,
-  exact
-    splitting_field_aux.is_scalar_tower n K (adjoin_root f.factor) (nat_degree_remove_factor' hfn),
-end
-
-instance scalar_tower {n : ℕ} {f : K[X]} (hfn : f.nat_degree = n + 1) :
-  is_scalar_tower K (adjoin_root f.factor) (splitting_field_aux _ f hfn) :=
-splitting_field_aux.scalar_tower' _
-
-theorem algebra_map_succ (n : ℕ) (f : K[X]) (hfn : f.nat_degree = n + 1) :
-  by exact algebra_map K (splitting_field_aux _ _ hfn) =
-    (algebra_map (adjoin_root f.factor)
-        (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn))).comp
-      (adjoin_root.of f.factor) :=
-is_scalar_tower.algebra_map_eq _ _ _
-
-protected theorem splits (n : ℕ) : ∀ {K : Type u} [field K], by exactI
-  ∀ (f : K[X]) (hfn : f.nat_degree = n),
-    splits (algebra_map K $ splitting_field_aux n f hfn) f :=
-nat.rec_on n (λ K _ _ hf, by exactI splits_of_degree_le_one _
-  (le_trans degree_le_nat_degree $ hf.symm ▸ with_bot.coe_le_coe.2 zero_le_one)) $ λ n ih K _ f hf,
-by { resetI, rw [← splits_id_iff_splits, algebra_map_succ, ← map_map, splits_id_iff_splits,
-    ← X_sub_C_mul_remove_factor f (λ h, by { rw h at hf, cases hf })],
-exact splits_mul _ (splits_X_sub_C _) (ih _ _) }
-
-theorem exists_lift (n : ℕ) : ∀ {K : Type u} [field K], by exactI
-  ∀ (f : K[X]) (hfn : f.nat_degree = n) {L : Type*} [field L], by exactI
-    ∀ (j : K →+* L) (hf : splits j f), ∃ k : splitting_field_aux n f hfn →+* L,
-      k.comp (algebra_map _ _) = j :=
-nat.rec_on n (λ K _ _ _ L _ j _, by exactI ⟨j, j.comp_id⟩) $ λ n ih K _ f hf L _ j hj, by exactI
-have hndf : f.nat_degree ≠ 0, by { intro h, rw h at hf, cases hf },
-have hfn0 : f ≠ 0, by { intro h, rw h at hndf, exact hndf rfl },
-let ⟨r, hr⟩ := exists_root_of_splits _ (splits_of_splits_of_dvd j hfn0 hj
-  (factor_dvd_of_nat_degree_ne_zero hndf))
-  (mt is_unit_iff_degree_eq_zero.2 f.irreducible_factor.1) in
-have hmf0 : map (adjoin_root.of f.factor) f ≠ 0, from map_ne_zero hfn0,
-have hsf : splits (adjoin_root.lift j r hr) f.remove_factor,
-by { rw ← X_sub_C_mul_remove_factor _ hndf at hmf0, refine (splits_of_splits_mul _ hmf0 _).2,
-  rwa [X_sub_C_mul_remove_factor _ hndf, ← splits_id_iff_splits, map_map, adjoin_root.lift_comp_of,
-      splits_id_iff_splits] },
-let ⟨k, hk⟩ := ih f.remove_factor (nat_degree_remove_factor' hf) (adjoin_root.lift j r hr) hsf in
-⟨k, by rw [algebra_map_succ, ← ring_hom.comp_assoc, hk, adjoin_root.lift_comp_of]⟩
-
-theorem adjoin_roots (n : ℕ) : ∀ {K : Type u} [field K], by exactI
-  ∀ (f : K[X]) (hfn : f.nat_degree = n),
-    algebra.adjoin K (↑(f.map $ algebra_map K $ splitting_field_aux n f hfn).roots.to_finset :
-      set (splitting_field_aux n f hfn)) = ⊤ :=
-nat.rec_on n (λ K _ f hf, by exactI algebra.eq_top_iff.2 (λ x, subalgebra.range_le _ ⟨x, rfl⟩)) $
-λ n ih K _ f hfn, by exactI
-have hndf : f.nat_degree ≠ 0, by { intro h, rw h at hfn, cases hfn },
-have hfn0 : f ≠ 0, by { intro h, rw h at hndf, exact hndf rfl },
-have hmf0 : map (algebra_map K (splitting_field_aux n.succ f hfn)) f ≠ 0 := map_ne_zero hfn0,
-by { rw [algebra_map_succ, ← map_map, ← X_sub_C_mul_remove_factor _ hndf,
-         polynomial.map_mul] at hmf0 ⊢,
-rw [roots_mul hmf0, polynomial.map_sub, map_X, map_C, roots_X_sub_C, multiset.to_finset_add,
-    finset.coe_union, multiset.to_finset_singleton, finset.coe_singleton,
-    algebra.adjoin_union_eq_adjoin_adjoin, ← set.image_singleton,
-    algebra.adjoin_algebra_map K (adjoin_root f.factor)
-      (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)),
-    adjoin_root.adjoin_root_eq_top, algebra.map_top,
-    is_scalar_tower.adjoin_range_to_alg_hom K (adjoin_root f.factor)
-      (splitting_field_aux n f.remove_factor (nat_degree_remove_factor' hfn)),
-    ih, subalgebra.restrict_scalars_top] }
-
-end splitting_field_aux
-
-/-- A splitting field of a polynomial. -/
-def splitting_field (f : K[X]) :=
-splitting_field_aux _ f rfl
-
-namespace splitting_field
-
-variables (f : K[X])
-
-instance : field (splitting_field f) :=
-splitting_field_aux.field _ _
-
-instance inhabited : inhabited (splitting_field f) := ⟨37⟩
-
-/-- This should be an instance globally, but it creates diamonds with the `ℕ` and `ℤ` actions:
-
-```lean
-example :
-  (add_comm_monoid.nat_module : module ℕ (splitting_field f)) =
-    @algebra.to_module _ _ _ _ (splitting_field.algebra' f) :=
-rfl  -- fails
-
-example :
-  (add_comm_group.int_module _ : module ℤ (splitting_field f)) =
-    @algebra.to_module _ _ _ _ (splitting_field.algebra' f) :=
-rfl  -- fails
-```
-
-Until we resolve these diamonds, it's more convenient to only turn this instance on with
-`local attribute [instance]` in places where the benefit of having the instance outweighs the cost.
-
-In the meantime, the `splitting_field.algebra` instance below is immune to these particular diamonds
-since `K = ℕ` and `K = ℤ` are not possible due to the `field K` assumption. Diamonds in
-`algebra ℚ (splitting_field f)` instances are still possible, but this is a problem throughout the
-library and not unique to this `algebra` instance.
--/
-instance algebra' {R} [comm_semiring R] [algebra R K] : algebra R (splitting_field f) :=
-splitting_field_aux.algebra _ _ _
-
-instance : algebra K (splitting_field f) :=
-splitting_field_aux.algebra _ _ _
-
-protected theorem splits : splits (algebra_map K (splitting_field f)) f :=
-splitting_field_aux.splits _ _ _
-
-variables [algebra K L] (hb : splits (algebra_map K L) f)
-
-/-- Embeds the splitting field into any other field that splits the polynomial. -/
-def lift : splitting_field f →ₐ[K] L :=
-{ commutes' := λ r, by { have := classical.some_spec (splitting_field_aux.exists_lift _ _ _ _ hb),
-    exact ring_hom.ext_iff.1 this r },
-  .. classical.some (splitting_field_aux.exists_lift _ _ _ _ hb) }
-
-theorem adjoin_roots : algebra.adjoin K
-    (↑(f.map (algebra_map K $ splitting_field f)).roots.to_finset : set (splitting_field f)) = ⊤ :=
-splitting_field_aux.adjoin_roots _ _ _
-
-theorem adjoin_root_set : algebra.adjoin K (f.root_set f.splitting_field) = ⊤ :=
-adjoin_roots f
-
-end splitting_field
-
-variables (K L) [algebra K L]
-/-- Typeclass characterising splitting fields. -/
-class is_splitting_field (f : K[X]) : Prop :=
-(splits [] : splits (algebra_map K L) f)
-(adjoin_roots [] : algebra.adjoin K (↑(f.map (algebra_map K L)).roots.to_finset : set L) = ⊤)
-
-namespace is_splitting_field
-
-variables {K}
-instance splitting_field (f : K[X]) : is_splitting_field K (splitting_field f) f :=
-⟨splitting_field.splits f, splitting_field.adjoin_roots f⟩
-
-section scalar_tower
-
-variables {K L F} [algebra F K] [algebra F L] [is_scalar_tower F K L]
-
-variables {K}
-instance map (f : F[X]) [is_splitting_field F L f] :
-  is_splitting_field K L (f.map $ algebra_map F K) :=
-⟨by { rw [splits_map_iff, ← is_scalar_tower.algebra_map_eq], exact splits L f },
- subalgebra.restrict_scalars_injective F $
-  by { rw [map_map, ← is_scalar_tower.algebra_map_eq, subalgebra.restrict_scalars_top,
-    eq_top_iff, ← adjoin_roots L f, algebra.adjoin_le_iff],
-  exact λ x hx, @algebra.subset_adjoin K _ _ _ _ _ _ hx }⟩
-
-variables {K} (L)
-theorem splits_iff (f : K[X]) [is_splitting_field K L f] :
-  polynomial.splits (ring_hom.id K) f ↔ (⊤ : subalgebra K L) = ⊥ :=
-⟨λ h, eq_bot_iff.2 $ adjoin_roots L f ▸ (roots_map (algebra_map K L) h).symm ▸
-  algebra.adjoin_le_iff.2 (λ y hy,
-    let ⟨x, hxs, hxy⟩ := finset.mem_image.1 (by rwa multiset.to_finset_map at hy) in
-    hxy ▸ set_like.mem_coe.2 $ subalgebra.algebra_map_mem _ _),
- λ h, @ring_equiv.to_ring_hom_refl K _ ▸
-  ring_equiv.self_trans_symm (ring_equiv.of_bijective _ $ algebra.bijective_algebra_map_iff.2 h) ▸
-  by { rw ring_equiv.to_ring_hom_trans, exact splits_comp_of_splits _ _ (splits L f) }⟩
-
-theorem mul (f g : F[X]) (hf : f ≠ 0) (hg : g ≠ 0) [is_splitting_field F K f]
-  [is_splitting_field K L (g.map $ algebra_map F K)] :
-  is_splitting_field F L (f * g) :=
-⟨(is_scalar_tower.algebra_map_eq F K L).symm ▸ splits_mul _
-  (splits_comp_of_splits _ _ (splits K f))
-  ((splits_map_iff _ _).1 (splits L $ g.map $ algebra_map F K)),
- by rw [polynomial.map_mul, roots_mul (mul_ne_zero (map_ne_zero hf : f.map (algebra_map F L) ≠ 0)
-        (map_ne_zero hg)), multiset.to_finset_add, finset.coe_union,
-      algebra.adjoin_union_eq_adjoin_adjoin,
-      is_scalar_tower.algebra_map_eq F K L, ← map_map,
-      roots_map (algebra_map K L) ((splits_id_iff_splits $ algebra_map F K).2 $ splits K f),
-      multiset.to_finset_map, finset.coe_image, algebra.adjoin_algebra_map, adjoin_roots,
-      algebra.map_top, is_scalar_tower.adjoin_range_to_alg_hom, ← map_map, adjoin_roots,
-      subalgebra.restrict_scalars_top]⟩
-
-end scalar_tower
-
-/-- Splitting field of `f` embeds into any field that splits `f`. -/
-def lift [algebra K F] (f : K[X]) [is_splitting_field K L f]
-  (hf : polynomial.splits (algebra_map K F) f) : L →ₐ[K] F :=
-if hf0 : f = 0 then (algebra.of_id K F).comp $
-  (algebra.bot_equiv K L : (⊥ : subalgebra K L) →ₐ[K] K).comp $
-  by { rw ← (splits_iff L f).1 (show f.splits (ring_hom.id K), from hf0.symm ▸ splits_zero _),
-  exact algebra.to_top } else
-alg_hom.comp (by { rw ← adjoin_roots L f, exact classical.choice (lift_of_splits _ $ λ y hy,
-    have aeval y f = 0, from (eval₂_eq_eval_map _).trans $
-      (mem_roots $ by exact map_ne_zero hf0).1 (multiset.mem_to_finset.mp hy),
-    ⟨is_algebraic_iff_is_integral.1 ⟨f, hf0, this⟩,
-      splits_of_splits_of_dvd _ hf0 hf $ minpoly.dvd _ _ this⟩) })
-  algebra.to_top
-
-theorem finite_dimensional (f : K[X]) [is_splitting_field K L f] : finite_dimensional K L :=
-⟨@algebra.top_to_submodule K L _ _ _ ▸ adjoin_roots L f ▸
-  fg_adjoin_of_finite (set.finite_mem_finset _) (λ y hy,
-  if hf : f = 0
-  then by { rw [hf, polynomial.map_zero, roots_zero] at hy, cases hy }
-  else is_algebraic_iff_is_integral.1 ⟨f, hf, (eval₂_eq_eval_map _).trans $
-    (mem_roots $ by exact map_ne_zero hf).1 (multiset.mem_to_finset.mp hy)⟩)⟩
-
-instance (f : K[X]) : _root_.finite_dimensional K f.splitting_field :=
-finite_dimensional f.splitting_field f
-
-/-- Any splitting field is isomorphic to `splitting_field f`. -/
-def alg_equiv (f : K[X]) [is_splitting_field K L f] : L ≃ₐ[K] splitting_field f :=
-begin
-  refine alg_equiv.of_bijective (lift L f $ splits (splitting_field f) f)
-    ⟨ring_hom.injective (lift L f $ splits (splitting_field f) f).to_ring_hom, _⟩,
-  haveI := finite_dimensional (splitting_field f) f,
-  haveI := finite_dimensional L f,
-  have : finite_dimensional.finrank K L = finite_dimensional.finrank K (splitting_field f) :=
-  le_antisymm
-    (linear_map.finrank_le_finrank_of_injective
-      (show function.injective (lift L f $ splits (splitting_field f) f).to_linear_map, from
-        ring_hom.injective (lift L f $ splits (splitting_field f) f : L →+* f.splitting_field)))
-    (linear_map.finrank_le_finrank_of_injective
-      (show function.injective (lift (splitting_field f) f $ splits L f).to_linear_map, from
-        ring_hom.injective (lift (splitting_field f) f $ splits L f : f.splitting_field →+* L))),
-  change function.surjective (lift L f $ splits (splitting_field f) f).to_linear_map,
-  refine (linear_map.injective_iff_surjective_of_finrank_eq_finrank this).1 _,
-  exact ring_hom.injective (lift L f $ splits (splitting_field f) f : L →+* f.splitting_field)
-end
-
-end is_splitting_field
-
-end splitting_field
-
-end polynomial
diff --git a/src/field_theory/splitting_field/construction.lean b/src/field_theory/splitting_field/construction.lean
new file mode 100644
index 0000000000000..85ec974bcb001
--- /dev/null
+++ b/src/field_theory/splitting_field/construction.lean
@@ -0,0 +1,371 @@
+/-
+Copyright (c) 2018 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes
+-/
+import field_theory.normal
+
+/-!
+# Splitting fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove the existence and uniqueness of splitting fields.
+
+## Main definitions
+
+* `polynomial.splitting_field f`: A fixed splitting field of the polynomial `f`.
+
+## Main statements
+
+* `polynomial.is_splitting_field.alg_equiv`: Every splitting field of a polynomial `f` is isomorphic
+  to `splitting_field f` and thus, being a splitting field is unique up to isomorphism.
+
+## Implementation details
+We construct a `splitting_field_aux` without worrying about whether the instances satisfy nice
+definitional equalities. Then the actual `splitting_field` is defined to be a quotient of a
+`mv_polynomial` ring by the kernel of the obvious map into `splitting_field_aux`. Because the
+actual `splitting_field` will be a quotient of a `mv_polynomial`, it has nice instances on it.
+
+-/
+
+noncomputable theory
+open_locale classical big_operators polynomial
+
+universes u v w
+
+variables {F : Type u} {K : Type v} {L : Type w}
+
+namespace polynomial
+
+variables [field K] [field L] [field F]
+open polynomial
+
+section splitting_field
+
+/-- Non-computably choose an irreducible factor from a polynomial. -/
+def factor (f : K[X]) : K[X] :=
+if H : ∃ g, irreducible g ∧ g ∣ f then classical.some H else X
+
+lemma irreducible_factor (f : K[X]) : irreducible (factor f) :=
+begin
+  rw factor, split_ifs with H, { exact (classical.some_spec H).1 }, { exact irreducible_X }
+end
+
+/-- See note [fact non-instances]. -/
+lemma fact_irreducible_factor (f : K[X]) : fact (irreducible (factor f)) :=
+⟨irreducible_factor f⟩
+
+local attribute [instance] fact_irreducible_factor
+
+theorem factor_dvd_of_not_is_unit {f : K[X]} (hf1 : ¬is_unit f) : factor f ∣ f :=
+begin
+  by_cases hf2 : f = 0, { rw hf2, exact dvd_zero _ },
+  rw [factor, dif_pos (wf_dvd_monoid.exists_irreducible_factor hf1 hf2)],
+  exact (classical.some_spec $ wf_dvd_monoid.exists_irreducible_factor hf1 hf2).2
+end
+
+theorem factor_dvd_of_degree_ne_zero {f : K[X]} (hf : f.degree ≠ 0) : factor f ∣ f :=
+factor_dvd_of_not_is_unit (mt degree_eq_zero_of_is_unit hf)
+
+theorem factor_dvd_of_nat_degree_ne_zero {f : K[X]} (hf : f.nat_degree ≠ 0) :
+  factor f ∣ f :=
+factor_dvd_of_degree_ne_zero (mt nat_degree_eq_of_degree_eq_some hf)
+
+/-- Divide a polynomial f by X - C r where r is a root of f in a bigger field extension. -/
+def remove_factor (f : K[X]) : polynomial (adjoin_root $ factor f) :=
+map (adjoin_root.of f.factor) f /ₘ (X - C (adjoin_root.root f.factor))
+
+theorem X_sub_C_mul_remove_factor (f : K[X]) (hf : f.nat_degree ≠ 0) :
+  (X - C (adjoin_root.root f.factor)) * f.remove_factor = map (adjoin_root.of f.factor) f :=
+let ⟨g, hg⟩ := factor_dvd_of_nat_degree_ne_zero hf in
+mul_div_by_monic_eq_iff_is_root.2 $ by rw [is_root.def, eval_map, hg, eval₂_mul, ← hg,
+    adjoin_root.eval₂_root, zero_mul]
+
+theorem nat_degree_remove_factor (f : K[X]) :
+  f.remove_factor.nat_degree = f.nat_degree - 1 :=
+by rw [remove_factor, nat_degree_div_by_monic _ (monic_X_sub_C _), nat_degree_map,
+       nat_degree_X_sub_C]
+
+theorem nat_degree_remove_factor' {f : K[X]} {n : ℕ} (hfn : f.nat_degree = n+1) :
+  f.remove_factor.nat_degree = n :=
+by rw [nat_degree_remove_factor, hfn, n.add_sub_cancel]
+
+/-- Auxiliary construction to a splitting field of a polynomial, which removes
+`n` (arbitrarily-chosen) factors.
+
+It constructs the type, proves that is a field and algebra over the base field.
+
+Uses recursion on the degree.
+-/
+def splitting_field_aux_aux (n : ℕ) : Π {K : Type u} [field K], by exactI Π (f : K[X]),
+  Σ (L : Type u) (inst : field L), by exactI algebra K L :=
+nat.rec_on n (λ K inst f, ⟨K, inst, infer_instance⟩) (λ m ih K inst f,
+  let L := ih (@remove_factor K inst f) in let h₁ := L.2.1 in let h₂ := L.2.2 in
+  ⟨L.1, L.2.1, by
+    { exactI (ring_hom.comp (algebra_map _ _) (adjoin_root.of f.factor)).to_algebra }⟩)
+
+/-- Auxiliary construction to a splitting field of a polynomial, which removes
+`n` (arbitrarily-chosen) factors. It is the type constructed in `splitting_field_aux_aux`.
+-/
+def splitting_field_aux (n : ℕ) {K : Type u} [field K] (f : K[X]) : Type u :=
+  (splitting_field_aux_aux n f).1
+
+instance splitting_field_aux.field (n : ℕ) {K : Type u} [field K] (f : K[X]) :
+    field (splitting_field_aux n f) :=
+  (splitting_field_aux_aux n f).2.1
+
+instance  (n : ℕ) {K : Type u} [field K] (f : K[X]) : inhabited (splitting_field_aux n f) :=
+⟨0⟩
+
+instance splitting_field_aux.algebra (n : ℕ) {K : Type u} [field K] (f : K[X]) :
+    algebra K (splitting_field_aux n f) :=
+  (splitting_field_aux_aux n f).2.2
+
+namespace splitting_field_aux
+
+theorem succ (n : ℕ) (f : K[X]) :
+  splitting_field_aux (n+1) f = splitting_field_aux n f.remove_factor := rfl
+
+instance algebra''' {n : ℕ} {f : K[X]} :
+  algebra (adjoin_root f.factor)
+    (splitting_field_aux n f.remove_factor) :=
+splitting_field_aux.algebra n _
+
+instance algebra' {n : ℕ} {f : K[X]} :
+  algebra (adjoin_root f.factor) (splitting_field_aux n.succ f) :=
+splitting_field_aux.algebra'''
+
+instance algebra'' {n : ℕ} {f : K[X]} :
+  algebra K (splitting_field_aux n f.remove_factor) :=
+ring_hom.to_algebra (ring_hom.comp (algebra_map _ _) (adjoin_root.of f.factor))
+
+instance scalar_tower' {n : ℕ} {f : K[X]} :
+  is_scalar_tower K (adjoin_root f.factor)
+    (splitting_field_aux n f.remove_factor) :=
+is_scalar_tower.of_algebra_map_eq (λ x, rfl)
+
+theorem algebra_map_succ (n : ℕ) (f : K[X]) :
+  by exact algebra_map K (splitting_field_aux (n+1) f) =
+    (algebra_map (adjoin_root f.factor)
+        (splitting_field_aux n f.remove_factor)).comp
+      (adjoin_root.of f.factor) :=
+rfl
+
+protected theorem splits (n : ℕ) : ∀ {K : Type u} [field K], by exactI
+  ∀ (f : K[X]) (hfn : f.nat_degree = n),
+    splits (algebra_map K $ splitting_field_aux n f) f :=
+nat.rec_on n (λ K _ _ hf, by exactI splits_of_degree_le_one _
+  (le_trans degree_le_nat_degree $ hf.symm ▸ with_bot.coe_le_coe.2 zero_le_one)) $ λ n ih K _ f hf,
+by { resetI, rw [← splits_id_iff_splits, algebra_map_succ, ← map_map, splits_id_iff_splits,
+    ← X_sub_C_mul_remove_factor f (λ h, by { rw h at hf, cases hf })],
+exact splits_mul _ (splits_X_sub_C _) (ih _ (nat_degree_remove_factor' hf)) }
+
+theorem adjoin_root_set (n : ℕ) : ∀ {K : Type u} [field K], by exactI
+  ∀ (f : K[X]) (hfn : f.nat_degree = n),
+    algebra.adjoin K (f.root_set (splitting_field_aux n f)) = ⊤ :=
+nat.rec_on n (λ K _ f hf, by exactI algebra.eq_top_iff.2 (λ x, subalgebra.range_le _ ⟨x, rfl⟩)) $
+λ n ih K _ f hfn, by exactI
+have hndf : f.nat_degree ≠ 0, by { intro h, rw h at hfn, cases hfn },
+have hfn0 : f ≠ 0, by { intro h, rw h at hndf, exact hndf rfl },
+have hmf0 : map (algebra_map K (splitting_field_aux n.succ f)) f ≠ 0 := map_ne_zero hfn0,
+begin
+  simp_rw root_set at ⊢ ih,
+  rw [algebra_map_succ, ← map_map, ← X_sub_C_mul_remove_factor _ hndf,
+         polynomial.map_mul] at hmf0 ⊢,
+  rw [roots_mul hmf0, polynomial.map_sub, map_X, map_C, roots_X_sub_C, multiset.to_finset_add,
+      finset.coe_union, multiset.to_finset_singleton, finset.coe_singleton,
+      algebra.adjoin_union_eq_adjoin_adjoin, ← set.image_singleton,
+      algebra.adjoin_algebra_map K (adjoin_root f.factor)
+        (splitting_field_aux n f.remove_factor),
+      adjoin_root.adjoin_root_eq_top, algebra.map_top,
+      is_scalar_tower.adjoin_range_to_alg_hom K (adjoin_root f.factor)
+        (splitting_field_aux n f.remove_factor),
+      ih _ (nat_degree_remove_factor' hfn), subalgebra.restrict_scalars_top]
+end
+
+instance (f : K[X]) : is_splitting_field K (splitting_field_aux f.nat_degree f) f :=
+  ⟨splitting_field_aux.splits _ _ rfl, splitting_field_aux.adjoin_root_set _ _ rfl⟩
+
+/-- The natural map from `mv_polynomial (f.root_set (splitting_field_aux f.nat_degree f))`
+to `splitting_field_aux f.nat_degree f` sendind a variable to the corresponding root. -/
+def of_mv_polynomial (f : K[X]) :
+    mv_polynomial (f.root_set (splitting_field_aux f.nat_degree f)) K →ₐ[K]
+    splitting_field_aux f.nat_degree f :=
+  mv_polynomial.aeval (λ i, i.1)
+
+theorem of_mv_polynomial_surjective (f : K[X]) : function.surjective (of_mv_polynomial f) :=
+begin
+  suffices : alg_hom.range (of_mv_polynomial f) = ⊤,
+  { rw [← set.range_iff_surjective]; rwa [set_like.ext'_iff] at this },
+  rw [of_mv_polynomial, ← algebra.adjoin_range_eq_range_aeval K, eq_top_iff,
+    ← adjoin_root_set _ _ rfl],
+  exact algebra.adjoin_le (λ α hα, algebra.subset_adjoin ⟨⟨α, hα⟩, rfl⟩)
+end
+
+/-- The algebra isomorphism between the quotient of
+`mv_polynomial (f.root_set (splitting_field_aux f.nat_degree f)) K` by the kernel of
+`of_mv_polynomial f` and `splitting_field_aux f.nat_degree f`. It is used to transport all the
+algebraic structures from the latter to `f.splitting_field`, that is defined as the former. -/
+def alg_equiv_quotient_mv_polynomial (f : K[X]) :
+    (mv_polynomial (f.root_set (splitting_field_aux f.nat_degree f)) K ⧸
+      ring_hom.ker (of_mv_polynomial f).to_ring_hom) ≃ₐ[K]
+    splitting_field_aux f.nat_degree f :=
+  (ideal.quotient_ker_alg_equiv_of_surjective (of_mv_polynomial_surjective f) : _)
+
+end splitting_field_aux
+
+/-- A splitting field of a polynomial. -/
+def splitting_field (f : K[X]) :=
+mv_polynomial (f.root_set (splitting_field_aux f.nat_degree f)) K ⧸
+    ring_hom.ker (splitting_field_aux.of_mv_polynomial f).to_ring_hom
+
+namespace splitting_field
+
+variables (f : K[X])
+
+instance comm_ring : comm_ring (splitting_field f) :=
+ideal.quotient.comm_ring _
+
+instance inhabited : inhabited (splitting_field f) :=
+  ⟨37⟩
+
+instance {S : Type*} [distrib_smul S K] [is_scalar_tower S K K] :
+  has_smul S (splitting_field f) :=
+  submodule.quotient.has_smul' _
+
+instance algebra : algebra K (splitting_field f) :=
+ideal.quotient.algebra _
+
+instance algebra' {R : Type*} [comm_semiring R] [algebra R K] : algebra R (splitting_field f) :=
+ideal.quotient.algebra _
+
+instance is_scalar_tower {R : Type*} [comm_semiring R] [algebra R K] :
+  is_scalar_tower R K (splitting_field f) :=
+ideal.quotient.is_scalar_tower _ _ _
+
+/-- The algebra equivalence with `splitting_field_aux`,
+which we will use to construct the field structure. -/
+def alg_equiv_splitting_field_aux (f : K[X]) :
+    splitting_field f ≃ₐ[K] splitting_field_aux f.nat_degree f :=
+  splitting_field_aux.alg_equiv_quotient_mv_polynomial f
+
+instance : field (splitting_field f) :=
+let e := alg_equiv_splitting_field_aux f in
+{ rat_cast := λ a, algebra_map K _ (a : K),
+  inv := λ a, e.symm (e a)⁻¹,
+  qsmul := (•),
+  qsmul_eq_mul' := λ a x, quotient.induction_on' x (λ p, congr_arg quotient.mk'
+  begin
+    ext,
+    simp only [mv_polynomial.algebra_map_eq, rat.smul_def, mv_polynomial.coeff_smul,
+      mv_polynomial.coeff_C_mul],
+  end),
+  rat_cast_mk := λ a b h1 h2,
+  begin
+    apply e.injective,
+    change e (algebra_map K _ _) = _,
+    simp only [map_rat_cast, map_nat_cast, map_mul, map_int_cast, alg_equiv.commutes],
+    change _ = e ↑a * e (e.symm (e b)⁻¹),
+    rw [alg_equiv.apply_symm_apply],
+    convert field.rat_cast_mk a b h1 h2,
+    all_goals { simp },
+  end,
+  exists_pair_ne := ⟨e.symm 0, e.symm 1, λ w, zero_ne_one ((e.symm).injective w)⟩,
+  mul_inv_cancel := λ a w,
+  begin
+    apply e.injective,
+    rw [map_mul, map_one],
+    change e a * e (e.symm (e a)⁻¹) = 1,
+    rw [alg_equiv.apply_symm_apply, mul_inv_cancel],
+    exact (λ w', w (by simpa only [add_equiv_class.map_eq_zero_iff] using w')),
+  end,
+  inv_zero :=
+  begin
+    change e.symm (e 0)⁻¹ = 0,
+    simp
+  end,
+  ..splitting_field.comm_ring f }
+
+instance [char_zero K] : char_zero (splitting_field f) :=
+char_zero_of_injective_algebra_map ((algebra_map K _).injective)
+
+-- The algebra instance deriving from `K` should be definitionally equal to that
+-- deriving from the field structure on `splitting_field f`.
+example : (add_comm_monoid.nat_module : module ℕ (splitting_field f)) =
+    @algebra.to_module _ _ _ _ (splitting_field.algebra' f) :=
+rfl
+
+example : (add_comm_group.int_module _ : module ℤ (splitting_field f)) =
+    @algebra.to_module _ _ _ _ (splitting_field.algebra' f) :=
+rfl
+
+example [char_zero K] : (splitting_field.algebra' f) = algebra_rat :=
+rfl
+
+example {q : ℚ[X]} : algebra_int (splitting_field q) = splitting_field.algebra' q := rfl
+
+instance _root_.polynomial.is_splitting_field.splitting_field (f : K[X]) :
+    is_splitting_field K (splitting_field f) f :=
+  is_splitting_field.of_alg_equiv _ f (splitting_field_aux.alg_equiv_quotient_mv_polynomial f).symm
+
+protected theorem splits : splits (algebra_map K (splitting_field f)) f :=
+is_splitting_field.splits f.splitting_field f
+
+variables [algebra K L] (hb : splits (algebra_map K L) f)
+
+/-- Embeds the splitting field into any other field that splits the polynomial. -/
+def lift : splitting_field f →ₐ[K] L :=
+is_splitting_field.lift f.splitting_field f hb
+
+theorem adjoin_root_set : algebra.adjoin K (f.root_set (splitting_field f)) = ⊤ :=
+polynomial.is_splitting_field.adjoin_root_set _ f
+
+end splitting_field
+
+end splitting_field
+
+namespace is_splitting_field
+
+variables (K L) [algebra K L]
+
+variables {K}
+
+instance (f : K[X]) : _root_.finite_dimensional K f.splitting_field :=
+finite_dimensional f.splitting_field f
+
+instance [fintype K] (f : K[X]) : fintype f.splitting_field :=
+finite_dimensional.fintype_of_fintype K _
+
+instance (f : K[X]) : no_zero_smul_divisors K f.splitting_field := infer_instance
+
+/-- Any splitting field is isomorphic to `splitting_field f`. -/
+def alg_equiv (f : K[X]) [is_splitting_field K L f] : L ≃ₐ[K] splitting_field f :=
+begin
+  refine alg_equiv.of_bijective (lift L f $ splits (splitting_field f) f)
+    ⟨ring_hom.injective (lift L f $ splits (splitting_field f) f).to_ring_hom, _⟩,
+  haveI := finite_dimensional (splitting_field f) f,
+  haveI := finite_dimensional L f,
+  have : finite_dimensional.finrank K L = finite_dimensional.finrank K (splitting_field f) :=
+  le_antisymm
+    (linear_map.finrank_le_finrank_of_injective
+      (show function.injective (lift L f $ splits (splitting_field f) f).to_linear_map, from
+        ring_hom.injective (lift L f $ splits (splitting_field f) f : L →+* f.splitting_field)))
+    (linear_map.finrank_le_finrank_of_injective
+      (show function.injective (lift (splitting_field f) f $ splits L f).to_linear_map, from
+        ring_hom.injective (lift (splitting_field f) f $ splits L f : f.splitting_field →+* L))),
+  change function.surjective (lift L f $ splits (splitting_field f) f).to_linear_map,
+  refine (linear_map.injective_iff_surjective_of_finrank_eq_finrank this).1 _,
+  exact ring_hom.injective (lift L f $ splits (splitting_field f) f : L →+* f.splitting_field)
+end
+
+end is_splitting_field
+
+end polynomial
+
+section normal
+
+instance [field F] (p : F[X]) : normal F p.splitting_field := normal.of_is_splitting_field p
+
+end normal
diff --git a/src/field_theory/splitting_field/is_splitting_field.lean b/src/field_theory/splitting_field/is_splitting_field.lean
new file mode 100644
index 0000000000000..1916a19ed67b9
--- /dev/null
+++ b/src/field_theory/splitting_field/is_splitting_field.lean
@@ -0,0 +1,153 @@
+/-
+Copyright (c) 2018 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes
+-/
+import algebra.char_p.algebra
+import field_theory.intermediate_field
+import ring_theory.adjoin.field
+
+/-!
+# Splitting fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file introduces the notion of a splitting field of a polynomial and provides an embedding from
+a splitting field to any field that splits the polynomial. A polynomial `f : K[X]` splits
+over a field extension `L` of `K` if it is zero or all of its irreducible factors over `L` have
+degree `1`. A field extension of `K` of a polynomial `f : K[X]` is called a splitting field
+if it is the smallest field extension of `K` such that `f` splits.
+
+## Main definitions
+
+* `polynomial.is_splitting_field`: A predicate on a field to be a splitting field of a polynomial
+  `f`.
+
+## Main statements
+
+* `polynomial.is_splitting_field.lift`: An embedding of a splitting field of the polynomial `f` into
+  another field such that `f` splits.
+
+-/
+
+noncomputable theory
+open_locale classical big_operators polynomial
+
+universes u v w
+
+variables {F : Type u} (K : Type v) (L : Type w)
+
+namespace polynomial
+
+variables [field K] [field L] [field F] [algebra K L]
+
+/-- Typeclass characterising splitting fields. -/
+class is_splitting_field (f : K[X]) : Prop :=
+(splits [] : splits (algebra_map K L) f)
+(adjoin_root_set [] : algebra.adjoin K (f.root_set L) = ⊤)
+
+variables {K L F}
+
+namespace is_splitting_field
+
+section scalar_tower
+
+variables [algebra F K] [algebra F L] [is_scalar_tower F K L]
+
+instance map (f : F[X]) [is_splitting_field F L f] :
+  is_splitting_field K L (f.map $ algebra_map F K) :=
+⟨by { rw [splits_map_iff, ← is_scalar_tower.algebra_map_eq], exact splits L f },
+ subalgebra.restrict_scalars_injective F $
+  by { rw [root_set, map_map, ← is_scalar_tower.algebra_map_eq, subalgebra.restrict_scalars_top,
+    eq_top_iff, ← adjoin_root_set L f, algebra.adjoin_le_iff],
+  exact λ x hx, @algebra.subset_adjoin K _ _ _ _ _ _ hx }⟩
+
+variables (L)
+theorem splits_iff (f : K[X]) [is_splitting_field K L f] :
+  polynomial.splits (ring_hom.id K) f ↔ (⊤ : subalgebra K L) = ⊥ :=
+⟨λ h, eq_bot_iff.2 $ adjoin_root_set L f ▸
+  algebra.adjoin_le_iff.2 (λ y hy,
+    let ⟨x, hxs, hxy⟩ := finset.mem_image.1
+      (by rwa [root_set, roots_map _ h, multiset.to_finset_map] at hy) in
+    hxy ▸ set_like.mem_coe.2 $ subalgebra.algebra_map_mem _ _),
+ λ h, @ring_equiv.to_ring_hom_refl K _ ▸
+  ring_equiv.self_trans_symm (ring_equiv.of_bijective _ $ algebra.bijective_algebra_map_iff.2 h) ▸
+  by { rw ring_equiv.to_ring_hom_trans, exact splits_comp_of_splits _ _ (splits L f) }⟩
+
+theorem mul (f g : F[X]) (hf : f ≠ 0) (hg : g ≠ 0) [is_splitting_field F K f]
+  [is_splitting_field K L (g.map $ algebra_map F K)] :
+  is_splitting_field F L (f * g) :=
+⟨(is_scalar_tower.algebra_map_eq F K L).symm ▸ splits_mul _
+  (splits_comp_of_splits _ _ (splits K f))
+  ((splits_map_iff _ _).1 (splits L $ g.map $ algebra_map F K)),
+ by rw [root_set, polynomial.map_mul,
+      roots_mul (mul_ne_zero (map_ne_zero hf : f.map (algebra_map F L) ≠ 0)
+        (map_ne_zero hg)), multiset.to_finset_add, finset.coe_union,
+      algebra.adjoin_union_eq_adjoin_adjoin,
+      is_scalar_tower.algebra_map_eq F K L, ← map_map,
+      roots_map (algebra_map K L) ((splits_id_iff_splits $ algebra_map F K).2 $ splits K f),
+      multiset.to_finset_map, finset.coe_image, algebra.adjoin_algebra_map, ←root_set,
+      adjoin_root_set, algebra.map_top, is_scalar_tower.adjoin_range_to_alg_hom, ← map_map,
+      ←root_set, adjoin_root_set, subalgebra.restrict_scalars_top]⟩
+
+end scalar_tower
+
+variable (L)
+
+/-- Splitting field of `f` embeds into any field that splits `f`. -/
+def lift [algebra K F] (f : K[X]) [is_splitting_field K L f]
+  (hf : polynomial.splits (algebra_map K F) f) : L →ₐ[K] F :=
+if hf0 : f = 0 then (algebra.of_id K F).comp $
+  (algebra.bot_equiv K L : (⊥ : subalgebra K L) →ₐ[K] K).comp $
+  by { rw ← (splits_iff L f).1 (show f.splits (ring_hom.id K), from hf0.symm ▸ splits_zero _),
+  exact algebra.to_top } else
+alg_hom.comp (by { rw ← adjoin_root_set L f, exact classical.choice (lift_of_splits _ $ λ y hy,
+    have aeval y f = 0, from (eval₂_eq_eval_map _).trans $
+      (mem_roots $ by exact map_ne_zero hf0).1 (multiset.mem_to_finset.mp hy),
+    ⟨is_algebraic_iff_is_integral.1 ⟨f, hf0, this⟩,
+      splits_of_splits_of_dvd _ hf0 hf $ minpoly.dvd _ _ this⟩) })
+  algebra.to_top
+
+theorem finite_dimensional (f : K[X]) [is_splitting_field K L f] : finite_dimensional K L :=
+⟨@algebra.top_to_submodule K L _ _ _ ▸ adjoin_root_set L f ▸
+  fg_adjoin_of_finite (finset.finite_to_set _) (λ y hy,
+  if hf : f = 0
+  then by { rw [hf, root_set_zero] at hy, cases hy }
+  else is_algebraic_iff_is_integral.1 ⟨f, hf, (eval₂_eq_eval_map _).trans $
+    (mem_roots $ by exact map_ne_zero hf).1 (multiset.mem_to_finset.mp hy)⟩)⟩
+
+lemma of_alg_equiv [algebra K F] (p : K[X]) (f : F ≃ₐ[K] L) [is_splitting_field K F p] :
+  is_splitting_field K L p :=
+begin
+  split,
+  { rw ← f.to_alg_hom.comp_algebra_map,
+    exact splits_comp_of_splits _ _ (splits F p) },
+  { rw [←(algebra.range_top_iff_surjective f.to_alg_hom).mpr f.surjective,
+        adjoin_root_set_eq_range (splits F p), adjoin_root_set F p] },
+end
+
+end is_splitting_field
+
+end polynomial
+
+namespace intermediate_field
+
+open polynomial
+
+variables {K L} [field K] [field L] [algebra K L] {p : K[X]}
+
+lemma splits_of_splits {F : intermediate_field K L} (h : p.splits (algebra_map K L))
+  (hF : ∀ x ∈ p.root_set L, x ∈ F) : p.splits (algebra_map K F) :=
+begin
+  simp_rw [root_set, finset.mem_coe, multiset.mem_to_finset] at hF,
+  rw splits_iff_exists_multiset,
+  refine ⟨multiset.pmap subtype.mk _ hF, map_injective _ (algebra_map F L).injective _⟩,
+  conv_lhs { rw [polynomial.map_map, ←is_scalar_tower.algebra_map_eq,
+    eq_prod_roots_of_splits h, ←multiset.pmap_eq_map _ _ _ hF] },
+  simp_rw [polynomial.map_mul, polynomial.map_multiset_prod,
+    multiset.map_pmap, polynomial.map_sub, map_C, map_X],
+  refl,
+end
+
+end intermediate_field
diff --git a/src/field_theory/subfield.lean b/src/field_theory/subfield.lean
index 4fac3f3053e1f..dc67432a1eeff 100644
--- a/src/field_theory/subfield.lean
+++ b/src/field_theory/subfield.lean
@@ -5,10 +5,14 @@ Authors: Anne Baanen
 -/
 
 import algebra.algebra.basic
+import algebra.order.field.inj_surj
 
 /-!
 # Subfields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `K` be a field. This file defines the "bundled" subfield type `subfield K`, a type
 whose terms correspond to subfields of `K`. This is the preferred way to talk
 about subfields in mathlib. Unbundled subfields (`s : set K` and `is_subfield s`)
@@ -64,8 +68,8 @@ universes u v w
 variables {K : Type u} {L : Type v} {M : Type w} [field K] [field L] [field M]
 
 /-- `subfield_class S K` states `S` is a type of subsets `s ⊆ K` closed under field operations. -/
-class subfield_class (S : Type*) (K : out_param $ Type*) [field K] [set_like S K]
-  extends subring_class S K, inv_mem_class S K.
+class subfield_class (S K : Type*) [field K] [set_like S K]
+  extends subring_class S K, inv_mem_class S K : Prop
 
 namespace subfield_class
 
@@ -80,12 +84,32 @@ Be assured that we're not actually proving that subfields are subgroups:
 @[priority 100] -- See note [lower instance priority]
 instance subfield_class.to_subgroup_class : subgroup_class S K := { .. h }
 
+variables {S}
+
+lemma coe_rat_mem (s : S) (x : ℚ) : (x : K) ∈ s :=
+by simpa only [rat.cast_def] using div_mem (coe_int_mem s x.num) (coe_nat_mem s x.denom)
+
+instance (s : S) : has_rat_cast s :=
+⟨λ x, ⟨↑x, coe_rat_mem s x⟩⟩
+
+@[simp] lemma coe_rat_cast (s : S) (x : ℚ) : ((x : s) : K) = x := rfl
+
+lemma rat_smul_mem (s : S) (a : ℚ) (x : s) : (a • x : K) ∈ s :=
+by simpa only [rat.smul_def] using mul_mem (coe_rat_mem s a) x.prop
+
+instance (s : S) : has_smul ℚ s :=
+⟨λ a x, ⟨a • x, rat_smul_mem s a x⟩⟩
+
+@[simp] lemma coe_rat_smul (s : S) (a : ℚ) (x : s) : (↑(a • x) : K) = a • x := rfl
+
+variables (S)
+
 /-- A subfield inherits a field structure -/
 @[priority 75] -- Prefer subclasses of `field` over subclasses of `subfield_class`.
 instance to_field (s : S) : field s :=
 subtype.coe_injective.field (coe : s → K)
   rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl)
 
 omit h
 
@@ -96,7 +120,8 @@ instance to_linear_ordered_field {K} [linear_ordered_field K] [set_like S K]
   linear_ordered_field s :=
 subtype.coe_injective.linear_ordered_field coe
   rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 end subfield_class
 
@@ -235,16 +260,17 @@ instance : has_pow s ℤ := ⟨λ x z, ⟨x ^ z, s.zpow_mem x.2 z⟩⟩
 
 /-- A subfield inherits a field structure -/
 instance to_field : field s :=
-subtype.coe_injective.field coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.field (coe : s → K)
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subfield of a `linear_ordered_field` is a `linear_ordered_field`. -/
 instance to_linear_ordered_field {K} [linear_ordered_field K] (s : subfield K) :
   linear_ordered_field s :=
 subtype.coe_injective.linear_ordered_field coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 @[simp, norm_cast] lemma coe_add (x y : s) : (↑(x + y) : K) = ↑x + ↑y := rfl
 @[simp, norm_cast] lemma coe_sub (x y : s) : (↑(x - y) : K) = ↑x - ↑y := rfl
@@ -291,13 +317,17 @@ instance : inhabited (subfield K) := ⟨⊤⟩
 
 @[simp] lemma coe_top : ((⊤ : subfield K) : set K) = set.univ := rfl
 
+/-- The ring equiv between the top element of `subfield K` and `K`. -/
+@[simps]
+def top_equiv : (⊤ : subfield K) ≃+* K := subsemiring.top_equiv
+
 /-! # comap -/
 
 variables (f : K →+* L)
 
 /-- The preimage of a subfield along a ring homomorphism is a subfield. -/
 def comap (s : subfield L) : subfield K :=
-{ inv_mem' := λ x hx, show f (x⁻¹) ∈ s, by { rw f.map_inv, exact s.inv_mem hx },
+{ inv_mem' := λ x hx, show f (x⁻¹) ∈ s, by { rw map_inv₀ f, exact s.inv_mem hx },
   .. s.to_subring.comap f }
 
 @[simp] lemma coe_comap (s : subfield L) : (s.comap f : set K) = f ⁻¹' s := rfl
@@ -313,7 +343,7 @@ rfl
 
 /-- The image of a subfield along a ring homomorphism is a subfield. -/
 def map (s : subfield K) : subfield L :=
-{ inv_mem' := by { rintros _ ⟨x, hx, rfl⟩, exact ⟨x⁻¹, s.inv_mem hx, f.map_inv x⟩ },
+{ inv_mem' := by { rintros _ ⟨x, hx, rfl⟩, exact ⟨x⁻¹, s.inv_mem hx, map_inv₀ f x⟩ },
   .. s.to_subring.map f }
 
 @[simp] lemma coe_map : (s.map f : set L) = f '' s := rfl
@@ -441,7 +471,7 @@ def closure (s : set K) : subfield K :=
   zero_mem' := ⟨0, subring.zero_mem _, 1, subring.one_mem _, div_one _⟩,
   one_mem' := ⟨1, subring.one_mem _, 1, subring.one_mem _, div_one _⟩,
   neg_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨-y, subring.neg_mem _ hy, z, hz, x_eq ▸ neg_div _ _⟩,
-  inv_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨z, hz, y, hy, x_eq ▸ inv_div.symm⟩,
+  inv_mem' := λ x ⟨y, hy, z, hz, x_eq⟩, ⟨z, hz, y, hy, x_eq ▸ (inv_div _ _).symm⟩,
   add_mem' := λ x y x_mem y_mem, begin
     obtain ⟨nx, hnx, dx, hdx, rfl⟩ := id x_mem,
     obtain ⟨ny, hny, dy, hdy, rfl⟩ := id y_mem,
@@ -457,7 +487,7 @@ def closure (s : set K) : subfield K :=
     obtain ⟨ny, hny, dy, hdy, rfl⟩ := id y_mem,
     exact ⟨nx * ny, subring.mul_mem _ hnx hny,
            dx * dy, subring.mul_mem _ hdx hdy,
-           (div_mul_div_comm₀ _ _ _ _).symm⟩
+           (div_mul_div_comm _ _ _ _).symm⟩
   end }
 
 lemma mem_closure_iff {s : set K} {x} :
@@ -600,20 +630,6 @@ variables {s : subfield K}
 
 open subfield
 
-/-- Restrict the codomain of a ring homomorphism to a subfield that includes the range. -/
-def cod_restrict_field (f : K →+* L)
-  (s : subfield L) (h : ∀ x, f x ∈ s) : K →+* s :=
-{ to_fun := λ x, ⟨f x, h x⟩,
-  map_add' := λ x y, subtype.eq $ f.map_add x y,
-  map_zero' := subtype.eq f.map_zero,
-  map_mul' := λ x y, subtype.eq $ f.map_mul x y,
-  map_one' := subtype.eq f.map_one }
-
-/-- Restriction of a ring homomorphism to a subfield of the domain. -/
-def restrict_field (f : K →+* L) (s : subfield K) : s →+* L := f.comp s.subtype
-
-@[simp] lemma restrict_field_apply (f : K →+* L) (x : s) : f.restrict_field s x = f x := rfl
-
 /-- Restriction of a ring homomorphism to its range interpreted as a subfield. -/
 def range_restrict_field (f : K →+* L) : K →+* f.field_range :=
 f.srange_restrict
@@ -624,7 +640,7 @@ f.srange_restrict
 /-- The subfield of elements `x : R` such that `f x = g x`, i.e.,
 the equalizer of f and g as a subfield of R -/
 def eq_locus_field (f g : K →+* L) : subfield K :=
-{ inv_mem' := λ x (hx : f x = g x), show f x⁻¹ = g x⁻¹, by rw [f.map_inv, g.map_inv, hx],
+{ inv_mem' := λ x (hx : f x = g x), show f x⁻¹ = g x⁻¹, by rw [map_inv₀ f, map_inv₀ g, hx],
   carrier := {x | f x = g x}, .. (f : K →+* L).eq_locus g }
 
 /-- If two ring homomorphisms are equal on a set, then they are equal on its subfield closure. -/
@@ -661,7 +677,7 @@ open ring_hom
 
 /-- The ring homomorphism associated to an inclusion of subfields. -/
 def inclusion {S T : subfield K} (h : S ≤ T) : S →+* T :=
-S.subtype.cod_restrict_field _ (λ x, h x.2)
+S.subtype.cod_restrict _ (λ x, h x.2)
 
 @[simp] lemma field_range_subtype (s : subfield K) : s.subtype.field_range = s :=
 set_like.ext' $ (coe_srange _).trans subtype.range_coe
diff --git a/src/field_theory/tower.lean b/src/field_theory/tower.lean
index 0f910682526e7..d3c38ccef9dff 100644
--- a/src/field_theory/tower.lean
+++ b/src/field_theory/tower.lean
@@ -4,19 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 
+import data.nat.prime
 import ring_theory.algebra_tower
-import linear_algebra.matrix.finite_dimensional
-import linear_algebra.matrix.to_lin
+import linear_algebra.finite_dimensional
+import linear_algebra.free_module.finite.matrix
 
 /-!
 # Tower of field extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the tower law for arbitrary extensions and finite extensions.
 Suppose `L` is a field extension of `K` and `K` is a field extension of `F`.
 Then `[L:F] = [L:K] [K:F]` where `[E₁:E₂]` means the `E₂`-dimension of `E₁`.
 
-In fact we generalize it to vector spaces, where `L` is not necessarily a field,
-but just a vector space over `K`.
+In fact we generalize it to rings and modules, where `L` is not necessarily a field,
+but just a free module over `K`.
 
 ## Implementation notes
 
@@ -33,79 +37,116 @@ tower law
 universes u v w u₁ v₁ w₁
 open_locale classical big_operators
 
-section field
-
+open finite_dimensional
 open cardinal
 
 variables (F : Type u) (K : Type v) (A : Type w)
-variables [field F] [field K] [add_comm_group A]
+
+section ring
+
+variables [comm_ring F] [ring K] [add_comm_group A]
 variables [algebra F K] [module K A] [module F A] [is_scalar_tower F K A]
+variables [strong_rank_condition F] [strong_rank_condition K] [module.free F K] [module.free K A]
 
-/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
-`dim_F(A) = dim_F(K) * dim_K(A)`. -/
-theorem dim_mul_dim' :
+/-- Tower law: if `A` is a `K`-module and `K` is an extension of `F` then
+$\operatorname{rank}_F(A) = \operatorname{rank}_F(K) * \operatorname{rank}_K(A)$. -/
+theorem lift_rank_mul_lift_rank :
   (cardinal.lift.{w} (module.rank F K) * cardinal.lift.{v} (module.rank K A)) =
   cardinal.lift.{v} (module.rank F A) :=
-let b := basis.of_vector_space F K, c := basis.of_vector_space K A in
-by rw [← (module.rank F K).lift_id, ← b.mk_eq_dim,
-    ← (module.rank K A).lift_id, ← c.mk_eq_dim,
-    ← lift_umax.{w v}, ← (b.smul c).mk_eq_dim, mk_prod, lift_mul,
-    lift_lift, lift_lift, lift_lift, lift_lift, lift_umax]
+begin
+  obtain ⟨_, b⟩ := module.free.exists_basis F K,
+  obtain ⟨_, c⟩ := module.free.exists_basis K A,
+  rw [← (module.rank F K).lift_id, ← b.mk_eq_rank,
+      ← (module.rank K A).lift_id, ← c.mk_eq_rank,
+      ← lift_umax.{w v}, ← (b.smul c).mk_eq_rank, mk_prod, lift_mul,
+      lift_lift, lift_lift, lift_lift, lift_lift, lift_umax]
+end
 
-/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
-`dim_F(A) = dim_F(K) * dim_K(A)`. -/
-theorem dim_mul_dim (F : Type u) (K A : Type v) [field F] [field K] [add_comm_group A]
-  [algebra F K] [module K A] [module F A] [is_scalar_tower F K A] :
+/-- Tower law: if `A` is a `K`-module and `K` is an extension of `F` then
+$\operatorname{rank}_F(A) = \operatorname{rank}_F(K) * \operatorname{rank}_K(A)$.
+
+This is a simpler version of `lift_rank_mul_lift_rank` with `K` and `A` in the same universe. -/
+theorem rank_mul_rank (F : Type u) (K A : Type v)
+  [comm_ring F] [ring K] [add_comm_group A]
+  [algebra F K] [module K A] [module F A] [is_scalar_tower F K A]
+  [strong_rank_condition F] [strong_rank_condition K] [module.free F K] [module.free K A] :
   module.rank F K * module.rank K A = module.rank F A :=
-by convert dim_mul_dim' F K A; rw lift_id
+by convert lift_rank_mul_lift_rank F K A; rw lift_id
+
+/-- Tower law: if `A` is a `K`-module and `K` is an extension of `F` then
+$\operatorname{rank}_F(A) = \operatorname{rank}_F(K) * \operatorname{rank}_K(A)$. -/
+theorem finite_dimensional.finrank_mul_finrank'
+  [nontrivial K] [module.finite F K] [module.finite K A] :
+  finrank F K * finrank K A = finrank F A :=
+begin
+  letI := nontrivial_of_invariant_basis_number F,
+  let b := module.free.choose_basis F K,
+  let c := module.free.choose_basis K A,
+  rw [finrank_eq_card_basis b, finrank_eq_card_basis c, finrank_eq_card_basis (b.smul c),
+    fintype.card_prod],
+end
+
+end ring
+
+section field
+variables [field F] [division_ring K] [add_comm_group A]
+variables [algebra F K] [module K A] [module F A] [is_scalar_tower F K A]
 
 namespace finite_dimensional
 
 open is_noetherian
 
 theorem trans [finite_dimensional F K] [finite_dimensional K A] : finite_dimensional F A :=
-let b := basis.of_vector_space F K, c := basis.of_vector_space K A in
-of_fintype_basis $ b.smul c
+module.finite.trans K A
+
+/-- In a tower of field extensions `L / K / F`, if `L / F` is finite, so is `K / F`.
+
+(In fact, it suffices that `L` is a nontrivial ring.)
+
+Note this cannot be an instance as Lean cannot infer `L`.
+-/
+theorem left (K L : Type*) [field K] [algebra F K] [ring L] [nontrivial L]
+  [algebra F L] [algebra K L] [is_scalar_tower F K L]
+  [finite_dimensional F L] : finite_dimensional F K :=
+finite_dimensional.of_injective
+  (is_scalar_tower.to_alg_hom F K L).to_linear_map
+  (ring_hom.injective _)
 
 lemma right [hf : finite_dimensional F A] : finite_dimensional K A :=
 let ⟨⟨b, hb⟩⟩ := hf in ⟨⟨b, submodule.restrict_scalars_injective F _ _ $
 by { rw [submodule.restrict_scalars_top, eq_top_iff, ← hb, submodule.span_le],
   exact submodule.subset_span }⟩⟩
 
-/-- Tower law: if `A` is a `K`-algebra and `K` is a field extension of `F` then
-`dim_F(A) = dim_F(K) * dim_K(A)`. -/
-theorem finrank_mul_finrank [finite_dimensional F K] :
-  finrank F K * finrank K A = finrank F A :=
+/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
+`dim_F(A) = dim_F(K) * dim_K(A)`.
+
+This is `finite_dimensional.finrank_mul_finrank'` with one fewer finiteness assumption. -/
+theorem finrank_mul_finrank [finite_dimensional F K] : finrank F K * finrank K A = finrank F A :=
 begin
   by_cases hA : finite_dimensional K A,
   { resetI,
-    let b := basis.of_vector_space F K,
-    let c := basis.of_vector_space K A,
-    rw [finrank_eq_card_basis b, finrank_eq_card_basis c,
-      finrank_eq_card_basis (b.smul c), fintype.card_prod] },
+    rw finrank_mul_finrank' },
   { rw [finrank_of_infinite_dimensional hA, mul_zero, finrank_of_infinite_dimensional],
     exact mt (@right F K A _ _ _ _ _ _ _) hA }
 end
 
-instance linear_map (F : Type u) (V : Type v) (W : Type w)
-  [field F] [add_comm_group V] [module F V] [add_comm_group W] [module F W]
-  [finite_dimensional F V] [finite_dimensional F W] :
-  finite_dimensional F (V →ₗ[F] W) :=
-let b := basis.of_vector_space F V, c := basis.of_vector_space F W in
-(matrix.to_lin b c).finite_dimensional
-
-lemma finrank_linear_map (F : Type u) (V : Type v) (W : Type w)
-  [field F] [add_comm_group V] [module F V] [add_comm_group W] [module F W]
-  [finite_dimensional F V] [finite_dimensional F W] :
-  finrank F (V →ₗ[F] W) = finrank F V * finrank F W :=
-  let b := basis.of_vector_space F V, c := basis.of_vector_space F W in
-by rw [linear_equiv.finrank_eq (linear_map.to_matrix b c), matrix.finrank_matrix,
-      finrank_eq_card_basis b, finrank_eq_card_basis c, mul_comm]
+theorem subalgebra.is_simple_order_of_finrank_prime (A) [ring A] [is_domain A] [algebra F A]
+  (hp : (finrank F A).prime) : is_simple_order (subalgebra F A) :=
+{ to_nontrivial :=
+    ⟨⟨⊥, ⊤, λ he, nat.not_prime_one ((subalgebra.bot_eq_top_iff_finrank_eq_one.1 he).subst hp)⟩⟩,
+  eq_bot_or_eq_top := λ K, begin
+    haveI := finite_dimensional_of_finrank hp.pos,
+    letI := division_ring_of_finite_dimensional F K,
+    refine (hp.eq_one_or_self_of_dvd _ ⟨_, (finrank_mul_finrank F K A).symm⟩).imp _ (λ h, _),
+    { exact subalgebra.eq_bot_of_finrank_one },
+    { exact algebra.to_submodule_eq_top.1 (eq_top_of_finrank_eq $ K.finrank_to_submodule.trans h) },
+  end }
+/- TODO: `intermediate_field` version -/
 
 -- TODO: generalize by removing [finite_dimensional F K]
 -- V = ⊕F,
 -- (V →ₗ[F] K) = ((⊕F) →ₗ[F] K) = (⊕ (F →ₗ[F] K)) = ⊕K
-instance linear_map' (F : Type u) (K : Type v) (V : Type w)
+instance _root_.linear_map.finite_dimensional'' (F : Type u) (K : Type v) (V : Type w)
   [field F] [field K] [algebra F K] [finite_dimensional F K]
   [add_comm_group V] [module F V] [finite_dimensional F V] :
   finite_dimensional K (V →ₗ[F] K) :=
@@ -115,7 +156,7 @@ lemma finrank_linear_map' (F : Type u) (K : Type v) (V : Type w)
   [field F] [field K] [algebra F K] [finite_dimensional F K]
   [add_comm_group V] [module F V] [finite_dimensional F V] :
   finrank K (V →ₗ[F] K) = finrank F V :=
-(nat.mul_right_inj $ show 0 < finrank F K, from finrank_pos).1 $
+mul_right_injective₀ finrank_pos.ne' $
 calc  finrank F K * finrank K (V →ₗ[F] K)
     = finrank F (V →ₗ[F] K) : finrank_mul_finrank _ _ _
 ... = finrank F V * finrank F K : finrank_linear_map F V K
diff --git a/src/geometry/euclidean/angle/oriented/affine.lean b/src/geometry/euclidean/angle/oriented/affine.lean
new file mode 100644
index 0000000000000..4539469cf2dad
--- /dev/null
+++ b/src/geometry/euclidean/angle/oriented/affine.lean
@@ -0,0 +1,792 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import analysis.convex.side
+import geometry.euclidean.angle.oriented.rotation
+import geometry.euclidean.angle.unoriented.affine
+
+/-!
+# Oriented angles.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines oriented angles in Euclidean affine spaces.
+
+## Main definitions
+
+* `euclidean_geometry.oangle`, with notation `∡`, is the oriented angle determined by three
+  points.
+
+-/
+
+noncomputable theory
+
+open finite_dimensional complex
+open_locale affine euclidean_geometry real real_inner_product_space complex_conjugate
+
+namespace euclidean_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
+include hd2
+
+local notation `o` := module.oriented.positive_orientation
+
+/-- The oriented angle at `p₂` between the line segments to `p₁` and `p₃`, modulo `2 * π`. If
+either of those points equals `p₂`, this is 0. See `euclidean_geometry.angle` for the
+corresponding unoriented angle definition. -/
+def oangle (p₁ p₂ p₃ : P) : real.angle := (o).oangle (p₁ -ᵥ p₂) (p₃ -ᵥ p₂)
+
+localized "notation (name := oangle) `∡` := euclidean_geometry.oangle" in euclidean_geometry
+
+/-- Oriented angles are continuous when neither end point equals the middle point. -/
+lemma continuous_at_oangle {x : P × P × P} (hx12 : x.1 ≠ x.2.1) (hx32 : x.2.2 ≠ x.2.1) :
+  continuous_at (λ y : P × P × P, ∡ y.1 y.2.1 y.2.2) x :=
+begin
+  let f : P × P × P → V × V := λ y, (y.1 -ᵥ y.2.1, y.2.2 -ᵥ y.2.1),
+  have hf1 : (f x).1 ≠ 0, by simp [hx12],
+  have hf2 : (f x).2 ≠ 0, by simp [hx32],
+  exact ((o).continuous_at_oangle hf1 hf2).comp
+    ((continuous_fst.vsub continuous_snd.fst).prod_mk
+      (continuous_snd.snd.vsub continuous_snd.fst)).continuous_at
+end
+
+/-- The angle ∡AAB at a point. -/
+@[simp] lemma oangle_self_left (p₁ p₂ : P) : ∡ p₁ p₁ p₂ = 0 :=
+by simp [oangle]
+
+/-- The angle ∡ABB at a point. -/
+@[simp] lemma oangle_self_right (p₁ p₂ : P) : ∡ p₁ p₂ p₂ = 0 :=
+by simp [oangle]
+
+/-- The angle ∡ABA at a point. -/
+@[simp] lemma oangle_self_left_right (p₁ p₂ : P) : ∡ p₁ p₂ p₁ = 0 :=
+(o).oangle_self _
+
+/-- If the angle between three points is nonzero, the first two points are not equal. -/
+lemma left_ne_of_oangle_ne_zero {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ ≠ 0) : p₁ ≠ p₂ :=
+by { rw ←@vsub_ne_zero V, exact (o).left_ne_zero_of_oangle_ne_zero h }
+
+/-- If the angle between three points is nonzero, the last two points are not equal. -/
+lemma right_ne_of_oangle_ne_zero {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ ≠ 0) : p₃ ≠ p₂ :=
+by { rw ←@vsub_ne_zero V, exact (o).right_ne_zero_of_oangle_ne_zero h }
+
+/-- If the angle between three points is nonzero, the first and third points are not equal. -/
+lemma left_ne_right_of_oangle_ne_zero {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ ≠ 0) : p₁ ≠ p₃ :=
+by { rw ←(vsub_left_injective p₂).ne_iff, exact (o).ne_of_oangle_ne_zero h }
+
+/-- If the angle between three points is `π`, the first two points are not equal. -/
+lemma left_ne_of_oangle_eq_pi {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = π) : p₁ ≠ p₂ :=
+left_ne_of_oangle_ne_zero (h.symm ▸ real.angle.pi_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `π`, the last two points are not equal. -/
+lemma right_ne_of_oangle_eq_pi {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = π) : p₃ ≠ p₂ :=
+right_ne_of_oangle_ne_zero (h.symm ▸ real.angle.pi_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `π`, the first and third points are not equal. -/
+lemma left_ne_right_of_oangle_eq_pi {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = π) : p₁ ≠ p₃ :=
+left_ne_right_of_oangle_ne_zero (h.symm ▸ real.angle.pi_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `π / 2`, the first two points are not equal. -/
+lemma left_ne_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = (π / 2 : ℝ)) : p₁ ≠ p₂ :=
+left_ne_of_oangle_ne_zero (h.symm ▸ real.angle.pi_div_two_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `π / 2`, the last two points are not equal. -/
+lemma right_ne_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = (π / 2 : ℝ)) : p₃ ≠ p₂ :=
+right_ne_of_oangle_ne_zero (h.symm ▸ real.angle.pi_div_two_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `π / 2`, the first and third points are not equal. -/
+lemma left_ne_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = (π / 2 : ℝ)) :
+  p₁ ≠ p₃ :=
+left_ne_right_of_oangle_ne_zero (h.symm ▸ real.angle.pi_div_two_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `-π / 2`, the first two points are not equal. -/
+lemma left_ne_of_oangle_eq_neg_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = (-π / 2 : ℝ)) :
+  p₁ ≠ p₂ :=
+left_ne_of_oangle_ne_zero (h.symm ▸ real.angle.neg_pi_div_two_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `-π / 2`, the last two points are not equal. -/
+lemma right_ne_of_oangle_eq_neg_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = (-π / 2 : ℝ)) :
+  p₃ ≠ p₂ :=
+right_ne_of_oangle_ne_zero (h.symm ▸ real.angle.neg_pi_div_two_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the angle between three points is `-π / 2`, the first and third points are not equal. -/
+lemma left_ne_right_of_oangle_eq_neg_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = (-π / 2 : ℝ)) :
+  p₁ ≠ p₃ :=
+left_ne_right_of_oangle_ne_zero (h.symm ▸ real.angle.neg_pi_div_two_ne_zero : ∡ p₁ p₂ p₃ ≠ 0)
+
+/-- If the sign of the angle between three points is nonzero, the first two points are not
+equal. -/
+lemma left_ne_of_oangle_sign_ne_zero {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign ≠ 0) : p₁ ≠ p₂ :=
+left_ne_of_oangle_ne_zero (real.angle.sign_ne_zero_iff.1 h).1
+
+/-- If the sign of the angle between three points is nonzero, the last two points are not
+equal. -/
+lemma right_ne_of_oangle_sign_ne_zero {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign ≠ 0) : p₃ ≠ p₂ :=
+right_ne_of_oangle_ne_zero (real.angle.sign_ne_zero_iff.1 h).1
+
+/-- If the sign of the angle between three points is nonzero, the first and third points are not
+equal. -/
+lemma left_ne_right_of_oangle_sign_ne_zero {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign ≠ 0) :
+  p₁ ≠ p₃ :=
+left_ne_right_of_oangle_ne_zero (real.angle.sign_ne_zero_iff.1 h).1
+
+/-- If the sign of the angle between three points is positive, the first two points are not
+equal. -/
+lemma left_ne_of_oangle_sign_eq_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = 1) : p₁ ≠ p₂ :=
+left_ne_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (∡ p₁ p₂ p₃).sign ≠ 0)
+
+/-- If the sign of the angle between three points is positive, the last two points are not
+equal. -/
+lemma right_ne_of_oangle_sign_eq_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = 1) : p₃ ≠ p₂ :=
+right_ne_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (∡ p₁ p₂ p₃).sign ≠ 0)
+
+/-- If the sign of the angle between three points is positive, the first and third points are not
+equal. -/
+lemma left_ne_right_of_oangle_sign_eq_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = 1) : p₁ ≠ p₃ :=
+left_ne_right_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (∡ p₁ p₂ p₃).sign ≠ 0)
+
+/-- If the sign of the angle between three points is negative, the first two points are not
+equal. -/
+lemma left_ne_of_oangle_sign_eq_neg_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = -1) : p₁ ≠ p₂ :=
+left_ne_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (∡ p₁ p₂ p₃).sign ≠ 0)
+
+/-- If the sign of the angle between three points is negative, the last two points are not equal.
+-/
+lemma right_ne_of_oangle_sign_eq_neg_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = -1) : p₃ ≠ p₂ :=
+right_ne_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (∡ p₁ p₂ p₃).sign ≠ 0)
+
+/-- If the sign of the angle between three points is negative, the first and third points are not
+equal. -/
+lemma left_ne_right_of_oangle_sign_eq_neg_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = -1) :
+  p₁ ≠ p₃ :=
+left_ne_right_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (∡ p₁ p₂ p₃).sign ≠ 0)
+
+/-- Reversing the order of the points passed to `oangle` negates the angle. -/
+lemma oangle_rev (p₁ p₂ p₃ : P) : ∡ p₃ p₂ p₁ = -∡ p₁ p₂ p₃ :=
+(o).oangle_rev _ _
+
+/-- Adding an angle to that with the order of the points reversed results in 0. -/
+@[simp] lemma oangle_add_oangle_rev (p₁ p₂ p₃ : P) : ∡ p₁ p₂ p₃ + ∡ p₃ p₂ p₁ = 0 :=
+(o).oangle_add_oangle_rev _ _
+
+/-- An oriented angle is zero if and only if the angle with the order of the points reversed is
+zero. -/
+lemma oangle_eq_zero_iff_oangle_rev_eq_zero {p₁ p₂ p₃ : P} : ∡ p₁ p₂ p₃ = 0 ↔ ∡ p₃ p₂ p₁ = 0 :=
+(o).oangle_eq_zero_iff_oangle_rev_eq_zero
+
+/-- An oriented angle is `π` if and only if the angle with the order of the points reversed is
+`π`. -/
+lemma oangle_eq_pi_iff_oangle_rev_eq_pi {p₁ p₂ p₃ : P} : ∡ p₁ p₂ p₃ = π ↔ ∡ p₃ p₂ p₁ = π :=
+(o).oangle_eq_pi_iff_oangle_rev_eq_pi
+
+/-- An oriented angle is not zero or `π` if and only if the three points are affinely
+independent. -/
+lemma oangle_ne_zero_and_ne_pi_iff_affine_independent {p₁ p₂ p₃ : P} :
+  (∡ p₁ p₂ p₃ ≠ 0 ∧ ∡ p₁ p₂ p₃ ≠ π) ↔ affine_independent ℝ ![p₁, p₂, p₃] :=
+begin
+  rw [oangle, (o).oangle_ne_zero_and_ne_pi_iff_linear_independent,
+      affine_independent_iff_linear_independent_vsub ℝ _ (1 : fin 3),
+      ←linear_independent_equiv (fin_succ_above_equiv (1 : fin 3)).to_equiv],
+  convert iff.rfl,
+  ext i,
+  fin_cases i;
+    refl
+end
+
+/-- An oriented angle is zero or `π` if and only if the three points are collinear. -/
+lemma oangle_eq_zero_or_eq_pi_iff_collinear {p₁ p₂ p₃ : P} :
+  (∡ p₁ p₂ p₃ = 0 ∨ ∡ p₁ p₂ p₃ = π) ↔ collinear ℝ ({p₁, p₂, p₃} : set P) :=
+by rw [←not_iff_not, not_or_distrib, oangle_ne_zero_and_ne_pi_iff_affine_independent,
+       affine_independent_iff_not_collinear_set]
+
+/-- If twice the oriented angles between two triples of points are equal, one triple is affinely
+independent if and only if the other is. -/
+lemma affine_independent_iff_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆) :
+  affine_independent ℝ ![p₁, p₂, p₃] ↔ affine_independent ℝ ![p₄, p₅, p₆] :=
+by simp_rw [←oangle_ne_zero_and_ne_pi_iff_affine_independent, ←real.angle.two_zsmul_ne_zero_iff, h]
+
+/-- If twice the oriented angles between two triples of points are equal, one triple is collinear
+if and only if the other is. -/
+lemma collinear_iff_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆) :
+  collinear ℝ ({p₁, p₂, p₃} : set P) ↔ collinear ℝ ({p₄, p₅, p₆} : set P) :=
+by simp_rw [←oangle_eq_zero_or_eq_pi_iff_collinear, ←real.angle.two_zsmul_eq_zero_iff, h]
+
+/-- If corresponding pairs of points in two angles have the same vector span, twice those angles
+are equal. -/
+lemma two_zsmul_oangle_of_vector_span_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h₁₂₄₅ : vector_span ℝ ({p₁, p₂} : set P) = vector_span ℝ ({p₄, p₅} : set P))
+  (h₃₂₆₅ : vector_span ℝ ({p₃, p₂} : set P) = vector_span ℝ ({p₆, p₅} : set P)) :
+  (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆ :=
+begin
+  simp_rw vector_span_pair at h₁₂₄₅ h₃₂₆₅,
+  exact (o).two_zsmul_oangle_of_span_eq_of_span_eq h₁₂₄₅ h₃₂₆₅
+end
+
+/-- If the lines determined by corresponding pairs of points in two angles are parallel, twice
+those angles are equal. -/
+lemma two_zsmul_oangle_of_parallel {p₁ p₂ p₃ p₄ p₅ p₆ : P}
+  (h₁₂₄₅ : line[ℝ, p₁, p₂] ∥ line[ℝ, p₄, p₅]) (h₃₂₆₅ : line[ℝ, p₃, p₂] ∥ line[ℝ, p₆, p₅]) :
+  (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₄ p₅ p₆ :=
+begin
+  rw affine_subspace.affine_span_pair_parallel_iff_vector_span_eq at h₁₂₄₅ h₃₂₆₅,
+  exact two_zsmul_oangle_of_vector_span_eq h₁₂₄₅ h₃₂₆₅
+end
+
+/-- Given three points not equal to `p`, the angle between the first and the second at `p` plus
+the angle between the second and the third equals the angle between the first and the third. -/
+@[simp] lemma oangle_add {p p₁ p₂ p₃ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) (hp₃ : p₃ ≠ p) :
+  ∡ p₁ p p₂ + ∡ p₂ p p₃ = ∡ p₁ p p₃ :=
+(o).oangle_add (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂) (vsub_ne_zero.2 hp₃)
+
+/-- Given three points not equal to `p`, the angle between the second and the third at `p` plus
+the angle between the first and the second equals the angle between the first and the third. -/
+@[simp] lemma oangle_add_swap {p p₁ p₂ p₃ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) (hp₃ : p₃ ≠ p) :
+  ∡ p₂ p p₃ + ∡ p₁ p p₂ = ∡ p₁ p p₃ :=
+(o).oangle_add_swap (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂) (vsub_ne_zero.2 hp₃)
+
+/-- Given three points not equal to `p`, the angle between the first and the third at `p` minus
+the angle between the first and the second equals the angle between the second and the third. -/
+@[simp] lemma oangle_sub_left {p p₁ p₂ p₃ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) (hp₃ : p₃ ≠ p) :
+  ∡ p₁ p p₃ - ∡ p₁ p p₂ = ∡ p₂ p p₃ :=
+(o).oangle_sub_left (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂) (vsub_ne_zero.2 hp₃)
+
+/-- Given three points not equal to `p`, the angle between the first and the third at `p` minus
+the angle between the second and the third equals the angle between the first and the second. -/
+@[simp] lemma oangle_sub_right {p p₁ p₂ p₃ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) (hp₃ : p₃ ≠ p) :
+  ∡ p₁ p p₃ - ∡ p₂ p p₃ = ∡ p₁ p p₂ :=
+(o).oangle_sub_right (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂) (vsub_ne_zero.2 hp₃)
+
+/-- Given three points not equal to `p`, adding the angles between them at `p` in cyclic order
+results in 0. -/
+@[simp] lemma oangle_add_cyc3 {p p₁ p₂ p₃ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) (hp₃ : p₃ ≠ p) :
+  ∡ p₁ p p₂ + ∡ p₂ p p₃ + ∡ p₃ p p₁ = 0 :=
+(o).oangle_add_cyc3 (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂) (vsub_ne_zero.2 hp₃)
+
+/-- Pons asinorum, oriented angle-at-point form. -/
+lemma oangle_eq_oangle_of_dist_eq {p₁ p₂ p₃ : P} (h : dist p₁ p₂ = dist p₁ p₃) :
+  ∡ p₁ p₂ p₃ = ∡ p₂ p₃ p₁ :=
+begin
+  simp_rw dist_eq_norm_vsub at h,
+  rw [oangle, oangle, ←vsub_sub_vsub_cancel_left p₃ p₂ p₁, ←vsub_sub_vsub_cancel_left p₂ p₃ p₁,
+      (o).oangle_sub_eq_oangle_sub_rev_of_norm_eq h]
+end
+
+/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
+angle-at-point form. -/
+lemma oangle_eq_pi_sub_two_zsmul_oangle_of_dist_eq {p₁ p₂ p₃ : P} (hn : p₂ ≠ p₃)
+  (h : dist p₁ p₂ = dist p₁ p₃) : ∡ p₃ p₁ p₂ = π - (2 : ℤ) • ∡ p₁ p₂ p₃ :=
+begin
+  simp_rw dist_eq_norm_vsub at h,
+  rw [oangle, oangle],
+  convert (o).oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq _ h using 1,
+  { rw [←neg_vsub_eq_vsub_rev p₁ p₃, ←neg_vsub_eq_vsub_rev p₁ p₂, (o).oangle_neg_neg] },
+  { rw [←(o).oangle_sub_eq_oangle_sub_rev_of_norm_eq h], simp },
+  { simpa using hn }
+end
+
+/-- A base angle of an isosceles triangle is acute, oriented angle-at-point form. -/
+lemma abs_oangle_right_to_real_lt_pi_div_two_of_dist_eq {p₁ p₂ p₃ : P}
+  (h : dist p₁ p₂ = dist p₁ p₃) : |(∡ p₁ p₂ p₃).to_real| < π / 2 :=
+begin
+  simp_rw dist_eq_norm_vsub at h,
+  rw [oangle, ←vsub_sub_vsub_cancel_left p₃ p₂ p₁],
+  exact (o).abs_oangle_sub_right_to_real_lt_pi_div_two h
+end
+
+/-- A base angle of an isosceles triangle is acute, oriented angle-at-point form. -/
+lemma abs_oangle_left_to_real_lt_pi_div_two_of_dist_eq {p₁ p₂ p₃ : P}
+  (h : dist p₁ p₂ = dist p₁ p₃) : |(∡ p₂ p₃ p₁).to_real| < π / 2 :=
+(oangle_eq_oangle_of_dist_eq h) ▸ abs_oangle_right_to_real_lt_pi_div_two_of_dist_eq h
+
+/-- The cosine of the oriented angle at `p` between two points not equal to `p` equals that of the
+unoriented angle. -/
+lemma cos_oangle_eq_cos_angle {p p₁ p₂ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) :
+  real.angle.cos (∡ p₁ p p₂) = real.cos (∠ p₁ p p₂) :=
+(o).cos_oangle_eq_cos_angle (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂)
+
+/-- The oriented angle at `p` between two points not equal to `p` is plus or minus the unoriented
+angle. -/
+lemma oangle_eq_angle_or_eq_neg_angle {p p₁ p₂ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) :
+  ∡ p₁ p p₂ = ∠ p₁ p p₂ ∨ ∡ p₁ p p₂ = -∠ p₁ p p₂ :=
+(o).oangle_eq_angle_or_eq_neg_angle (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂)
+
+/-- The unoriented angle at `p` between two points not equal to `p` is the absolute value of the
+oriented angle. -/
+lemma angle_eq_abs_oangle_to_real {p p₁ p₂ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) :
+  ∠ p₁ p p₂ = |(∡ p₁ p p₂).to_real| :=
+(o).angle_eq_abs_oangle_to_real (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂)
+
+/-- If the sign of the oriented angle at `p` between two points is zero, either one of the points
+equals `p` or the unoriented angle is 0 or π. -/
+lemma eq_zero_or_angle_eq_zero_or_pi_of_sign_oangle_eq_zero {p p₁ p₂ : P}
+  (h : (∡ p₁ p p₂).sign = 0) : p₁ = p ∨ p₂ = p ∨ ∠ p₁ p p₂ = 0 ∨ ∠ p₁ p p₂ = π :=
+begin
+  convert (o).eq_zero_or_angle_eq_zero_or_pi_of_sign_oangle_eq_zero h;
+    simp
+end
+
+/-- If two unoriented angles are equal, and the signs of the corresponding oriented angles are
+equal, then the oriented angles are equal (even in degenerate cases). -/
+lemma oangle_eq_of_angle_eq_of_sign_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P} (h : ∠ p₁ p₂ p₃ = ∠ p₄ p₅ p₆)
+  (hs : (∡ p₁ p₂ p₃).sign = (∡ p₄ p₅ p₆).sign) : ∡ p₁ p₂ p₃ = ∡ p₄ p₅ p₆ :=
+(o).oangle_eq_of_angle_eq_of_sign_eq h hs
+
+/-- If the signs of two nondegenerate oriented angles between points are equal, the oriented
+angles are equal if and only if the unoriented angles are equal. -/
+lemma angle_eq_iff_oangle_eq_of_sign_eq {p₁ p₂ p₃ p₄ p₅ p₆ : P} (hp₁ : p₁ ≠ p₂) (hp₃ : p₃ ≠ p₂)
+  (hp₄ : p₄ ≠ p₅) (hp₆ : p₆ ≠ p₅) (hs : (∡ p₁ p₂ p₃).sign = (∡ p₄ p₅ p₆).sign) :
+  ∠ p₁ p₂ p₃ = ∠ p₄ p₅ p₆ ↔ ∡ p₁ p₂ p₃ = ∡ p₄ p₅ p₆ :=
+(o).angle_eq_iff_oangle_eq_of_sign_eq (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₃)
+                                      (vsub_ne_zero.2 hp₄) (vsub_ne_zero.2 hp₆) hs
+
+/-- The oriented angle between three points equals the unoriented angle if the sign is
+positive. -/
+lemma oangle_eq_angle_of_sign_eq_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = 1) :
+  ∡ p₁ p₂ p₃ = ∠ p₁ p₂ p₃ :=
+(o).oangle_eq_angle_of_sign_eq_one h
+
+/-- The oriented angle between three points equals minus the unoriented angle if the sign is
+negative. -/
+lemma oangle_eq_neg_angle_of_sign_eq_neg_one {p₁ p₂ p₃ : P} (h : (∡ p₁ p₂ p₃).sign = -1) :
+  ∡ p₁ p₂ p₃ = -∠ p₁ p₂ p₃ :=
+(o).oangle_eq_neg_angle_of_sign_eq_neg_one h
+
+/-- The unoriented angle at `p` between two points not equal to `p` is zero if and only if the
+unoriented angle is zero. -/
+lemma oangle_eq_zero_iff_angle_eq_zero {p p₁ p₂ : P} (hp₁ : p₁ ≠ p) (hp₂ : p₂ ≠ p) :
+  ∡ p₁ p p₂ = 0 ↔ ∠ p₁ p p₂ = 0 :=
+(o).oangle_eq_zero_iff_angle_eq_zero (vsub_ne_zero.2 hp₁) (vsub_ne_zero.2 hp₂)
+
+/-- The oriented angle between three points is `π` if and only if the unoriented angle is `π`. -/
+lemma oangle_eq_pi_iff_angle_eq_pi {p₁ p₂ p₃ : P} : ∡ p₁ p₂ p₃ = π ↔ ∠ p₁ p₂ p₃ = π :=
+(o).oangle_eq_pi_iff_angle_eq_pi
+
+/-- If the oriented angle between three points is `π / 2`, so is the unoriented angle. -/
+lemma angle_eq_pi_div_two_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∠ p₁ p₂ p₃ = π / 2 :=
+begin
+  rw [angle, ←inner_product_geometry.inner_eq_zero_iff_angle_eq_pi_div_two],
+  exact (o).inner_eq_zero_of_oangle_eq_pi_div_two h
+end
+
+/-- If the oriented angle between three points is `π / 2`, so is the unoriented angle
+(reversed). -/
+lemma angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∠ p₃ p₂ p₁ = π / 2 :=
+begin
+  rw angle_comm,
+  exact angle_eq_pi_div_two_of_oangle_eq_pi_div_two h,
+end
+
+/-- If the oriented angle between three points is `-π / 2`, the unoriented angle is `π / 2`. -/
+lemma angle_eq_pi_div_two_of_oangle_eq_neg_pi_div_two {p₁ p₂ p₃ : P}
+  (h : ∡ p₁ p₂ p₃ = ↑(-π / 2)) : ∠ p₁ p₂ p₃ = π / 2 :=
+begin
+  rw [angle, ←inner_product_geometry.inner_eq_zero_iff_angle_eq_pi_div_two],
+  exact (o).inner_eq_zero_of_oangle_eq_neg_pi_div_two h
+end
+
+/-- If the oriented angle between three points is `-π / 2`, the unoriented angle (reversed) is
+`π / 2`. -/
+lemma angle_rev_eq_pi_div_two_of_oangle_eq_neg_pi_div_two {p₁ p₂ p₃ : P}
+  (h : ∡ p₁ p₂ p₃ = ↑(-π / 2)) : ∠ p₃ p₂ p₁ = π / 2 :=
+begin
+  rw angle_comm,
+  exact angle_eq_pi_div_two_of_oangle_eq_neg_pi_div_two h
+end
+
+/-- Swapping the first and second points in an oriented angle negates the sign of that angle. -/
+lemma oangle_swap₁₂_sign (p₁ p₂ p₃ : P) : -(∡ p₁ p₂ p₃).sign = (∡ p₂ p₁ p₃).sign :=
+begin
+  rw [eq_comm, oangle, oangle, ←(o).oangle_neg_neg, neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev,
+      ←vsub_sub_vsub_cancel_left p₁ p₃ p₂, ←neg_vsub_eq_vsub_rev p₃ p₂, sub_eq_add_neg,
+      neg_vsub_eq_vsub_rev p₂ p₁, add_comm, ←@neg_one_smul ℝ],
+  nth_rewrite 1 [←one_smul ℝ (p₁ -ᵥ p₂)],
+  rw (o).oangle_sign_smul_add_smul_right,
+  simp
+end
+
+/-- Swapping the first and third points in an oriented angle negates the sign of that angle. -/
+lemma oangle_swap₁₃_sign (p₁ p₂ p₃ : P) : -(∡ p₁ p₂ p₃).sign = (∡ p₃ p₂ p₁).sign :=
+by rw [oangle_rev, real.angle.sign_neg, neg_neg]
+
+/-- Swapping the second and third points in an oriented angle negates the sign of that angle. -/
+lemma oangle_swap₂₃_sign (p₁ p₂ p₃ : P) : -(∡ p₁ p₂ p₃).sign = (∡ p₁ p₃ p₂).sign :=
+by rw [oangle_swap₁₃_sign, ←oangle_swap₁₂_sign, oangle_swap₁₃_sign]
+
+/-- Rotating the points in an oriented angle does not change the sign of that angle. -/
+lemma oangle_rotate_sign (p₁ p₂ p₃ : P) : (∡ p₂ p₃ p₁).sign = (∡ p₁ p₂ p₃).sign :=
+by rw [←oangle_swap₁₂_sign, oangle_swap₁₃_sign]
+
+/-- The oriented angle between three points is π if and only if the second point is strictly
+between the other two. -/
+lemma oangle_eq_pi_iff_sbtw {p₁ p₂ p₃ : P} : ∡ p₁ p₂ p₃ = π ↔ sbtw ℝ p₁ p₂ p₃ :=
+by rw [oangle_eq_pi_iff_angle_eq_pi, angle_eq_pi_iff_sbtw]
+
+/-- If the second of three points is strictly between the other two, the oriented angle at that
+point is π. -/
+lemma _root_.sbtw.oangle₁₂₃_eq_pi {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∡ p₁ p₂ p₃ = π :=
+oangle_eq_pi_iff_sbtw.2 h
+
+/-- If the second of three points is strictly between the other two, the oriented angle at that
+point (reversed) is π. -/
+lemma _root_.sbtw.oangle₃₂₁_eq_pi {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∡ p₃ p₂ p₁ = π :=
+by rw [oangle_eq_pi_iff_oangle_rev_eq_pi, ←h.oangle₁₂₃_eq_pi]
+
+/-- If the second of three points is weakly between the other two, the oriented angle at the
+first point is zero. -/
+lemma _root_.wbtw.oangle₂₁₃_eq_zero {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) : ∡ p₂ p₁ p₃ = 0 :=
+begin
+  by_cases hp₂p₁ : p₂ = p₁, { simp [hp₂p₁] },
+  by_cases hp₃p₁ : p₃ = p₁, { simp [hp₃p₁] },
+  rw oangle_eq_zero_iff_angle_eq_zero hp₂p₁ hp₃p₁,
+  exact h.angle₂₁₃_eq_zero_of_ne hp₂p₁
+end
+
+/-- If the second of three points is strictly between the other two, the oriented angle at the
+first point is zero. -/
+lemma _root_.sbtw.oangle₂₁₃_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∡ p₂ p₁ p₃ = 0 :=
+h.wbtw.oangle₂₁₃_eq_zero
+
+/-- If the second of three points is weakly between the other two, the oriented angle at the
+first point (reversed) is zero. -/
+lemma _root_.wbtw.oangle₃₁₂_eq_zero {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) : ∡ p₃ p₁ p₂ = 0 :=
+by rw [oangle_eq_zero_iff_oangle_rev_eq_zero, h.oangle₂₁₃_eq_zero]
+
+/-- If the second of three points is strictly between the other two, the oriented angle at the
+first point (reversed) is zero. -/
+lemma _root_.sbtw.oangle₃₁₂_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∡ p₃ p₁ p₂ = 0 :=
+h.wbtw.oangle₃₁₂_eq_zero
+
+/-- If the second of three points is weakly between the other two, the oriented angle at the
+third point is zero. -/
+lemma _root_.wbtw.oangle₂₃₁_eq_zero {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) : ∡ p₂ p₃ p₁ = 0 :=
+h.symm.oangle₂₁₃_eq_zero
+
+/-- If the second of three points is strictly between the other two, the oriented angle at the
+third point is zero. -/
+lemma _root_.sbtw.oangle₂₃₁_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∡ p₂ p₃ p₁ = 0 :=
+h.wbtw.oangle₂₃₁_eq_zero
+
+/-- If the second of three points is weakly between the other two, the oriented angle at the
+third point (reversed) is zero. -/
+lemma _root_.wbtw.oangle₁₃₂_eq_zero {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) : ∡ p₁ p₃ p₂ = 0 :=
+h.symm.oangle₃₁₂_eq_zero
+
+/-- If the second of three points is strictly between the other two, the oriented angle at the
+third point (reversed) is zero. -/
+lemma _root_.sbtw.oangle₁₃₂_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∡ p₁ p₃ p₂ = 0 :=
+h.wbtw.oangle₁₃₂_eq_zero
+
+/-- The oriented angle between three points is zero if and only if one of the first and third
+points is weakly between the other two. -/
+lemma oangle_eq_zero_iff_wbtw {p₁ p₂ p₃ : P} :
+  ∡ p₁ p₂ p₃ = 0 ↔ wbtw ℝ p₂ p₁ p₃ ∨ wbtw ℝ p₂ p₃ p₁ :=
+begin
+  by_cases hp₁p₂ : p₁ = p₂, { simp [hp₁p₂] },
+  by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] },
+  rw [oangle_eq_zero_iff_angle_eq_zero hp₁p₂ hp₃p₂, angle_eq_zero_iff_ne_and_wbtw],
+  simp [hp₁p₂, hp₃p₂]
+end
+
+/-- An oriented angle is unchanged by replacing the first point by one weakly further away on the
+same ray. -/
+lemma _root_.wbtw.oangle_eq_left {p₁ p₁' p₂ p₃ : P} (h : wbtw ℝ p₂ p₁ p₁') (hp₁p₂ : p₁ ≠ p₂) :
+  ∡ p₁ p₂ p₃ = ∡ p₁' p₂ p₃ :=
+begin
+  by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] },
+  by_cases hp₁'p₂ : p₁' = p₂, { rw [hp₁'p₂, wbtw_self_iff] at h, exact false.elim (hp₁p₂ h) },
+  rw [←oangle_add hp₁'p₂ hp₁p₂ hp₃p₂, h.oangle₃₁₂_eq_zero, zero_add]
+end
+
+/-- An oriented angle is unchanged by replacing the first point by one strictly further away on
+the same ray. -/
+lemma _root_.sbtw.oangle_eq_left {p₁ p₁' p₂ p₃ : P} (h : sbtw ℝ p₂ p₁ p₁') :
+  ∡ p₁ p₂ p₃ = ∡ p₁' p₂ p₃ :=
+h.wbtw.oangle_eq_left h.ne_left
+
+/-- An oriented angle is unchanged by replacing the third point by one weakly further away on the
+same ray. -/
+lemma _root_.wbtw.oangle_eq_right {p₁ p₂ p₃ p₃' : P} (h : wbtw ℝ p₂ p₃ p₃') (hp₃p₂ : p₃ ≠ p₂) :
+  ∡ p₁ p₂ p₃ = ∡ p₁ p₂ p₃' :=
+by rw [oangle_rev, h.oangle_eq_left hp₃p₂, ←oangle_rev]
+
+/-- An oriented angle is unchanged by replacing the third point by one strictly further away on
+the same ray. -/
+lemma _root_.sbtw.oangle_eq_right {p₁ p₂ p₃ p₃' : P} (h : sbtw ℝ p₂ p₃ p₃') :
+  ∡ p₁ p₂ p₃ = ∡ p₁ p₂ p₃' :=
+h.wbtw.oangle_eq_right h.ne_left
+
+/-- An oriented angle is unchanged by replacing the first point with the midpoint of the segment
+between it and the second point. -/
+@[simp] lemma oangle_midpoint_left (p₁ p₂ p₃ : P) : ∡ (midpoint ℝ p₁ p₂) p₂ p₃ = ∡ p₁ p₂ p₃ :=
+begin
+  by_cases h : p₁ = p₂, { simp [h] },
+  exact (sbtw_midpoint_of_ne ℝ h).symm.oangle_eq_left
+end
+
+/-- An oriented angle is unchanged by replacing the first point with the midpoint of the segment
+between the second point and that point. -/
+@[simp] lemma oangle_midpoint_rev_left (p₁ p₂ p₃ : P) : ∡ (midpoint ℝ p₂ p₁) p₂ p₃ = ∡ p₁ p₂ p₃ :=
+by rw [midpoint_comm, oangle_midpoint_left]
+
+/-- An oriented angle is unchanged by replacing the third point with the midpoint of the segment
+between it and the second point. -/
+@[simp] lemma oangle_midpoint_right (p₁ p₂ p₃ : P) : ∡ p₁ p₂ (midpoint ℝ p₃ p₂) = ∡ p₁ p₂ p₃ :=
+begin
+  by_cases h : p₃ = p₂, { simp [h] },
+  exact (sbtw_midpoint_of_ne ℝ h).symm.oangle_eq_right
+end
+
+/-- An oriented angle is unchanged by replacing the third point with the midpoint of the segment
+between the second point and that point. -/
+@[simp] lemma oangle_midpoint_rev_right (p₁ p₂ p₃ : P) : ∡ p₁ p₂ (midpoint ℝ p₂ p₃) = ∡ p₁ p₂ p₃ :=
+by rw [midpoint_comm, oangle_midpoint_right]
+
+/-- Replacing the first point by one on the same line but the opposite ray adds π to the oriented
+angle. -/
+lemma _root_.sbtw.oangle_eq_add_pi_left {p₁ p₁' p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₁')
+  (hp₃p₂ : p₃ ≠ p₂) : ∡ p₁ p₂ p₃ = ∡ p₁' p₂ p₃ + π :=
+by rw [←h.oangle₁₂₃_eq_pi, oangle_add_swap h.left_ne h.right_ne hp₃p₂]
+
+/-- Replacing the third point by one on the same line but the opposite ray adds π to the oriented
+angle. -/
+lemma _root_.sbtw.oangle_eq_add_pi_right {p₁ p₂ p₃ p₃' : P} (h : sbtw ℝ p₃ p₂ p₃')
+  (hp₁p₂ : p₁ ≠ p₂) : ∡ p₁ p₂ p₃ = ∡ p₁ p₂ p₃' + π :=
+by rw [←h.oangle₃₂₁_eq_pi, oangle_add hp₁p₂ h.right_ne h.left_ne]
+
+/-- Replacing both the first and third points by ones on the same lines but the opposite rays
+does not change the oriented angle (vertically opposite angles). -/
+lemma _root_.sbtw.oangle_eq_left_right {p₁ p₁' p₂ p₃ p₃' : P} (h₁ : sbtw ℝ p₁ p₂ p₁')
+  (h₃ : sbtw ℝ p₃ p₂ p₃') : ∡ p₁ p₂ p₃ = ∡ p₁' p₂ p₃' :=
+by rw [h₁.oangle_eq_add_pi_left h₃.left_ne, h₃.oangle_eq_add_pi_right h₁.right_ne, add_assoc,
+       real.angle.coe_pi_add_coe_pi, add_zero]
+
+/-- Replacing the first point by one on the same line does not change twice the oriented angle. -/
+lemma _root_.collinear.two_zsmul_oangle_eq_left {p₁ p₁' p₂ p₃ : P}
+  (h : collinear ℝ ({p₁, p₂, p₁'} : set P)) (hp₁p₂ : p₁ ≠ p₂) (hp₁'p₂ : p₁' ≠ p₂) :
+  (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₁' p₂ p₃ :=
+begin
+  by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] },
+  rcases h.wbtw_or_wbtw_or_wbtw with hw | hw | hw,
+  { have hw' : sbtw ℝ p₁ p₂ p₁' := ⟨hw, hp₁p₂.symm, hp₁'p₂.symm⟩,
+    rw [hw'.oangle_eq_add_pi_left hp₃p₂, smul_add, real.angle.two_zsmul_coe_pi, add_zero] },
+  { rw hw.oangle_eq_left hp₁'p₂ },
+  { rw hw.symm.oangle_eq_left hp₁p₂ }
+end
+
+/-- Replacing the third point by one on the same line does not change twice the oriented angle. -/
+lemma _root_.collinear.two_zsmul_oangle_eq_right {p₁ p₂ p₃ p₃' : P}
+  (h : collinear ℝ ({p₃, p₂, p₃'} : set P)) (hp₃p₂ : p₃ ≠ p₂) (hp₃'p₂ : p₃' ≠ p₂) :
+  (2 : ℤ) • ∡ p₁ p₂ p₃ = (2 : ℤ) • ∡ p₁ p₂ p₃' :=
+by rw [oangle_rev, smul_neg, h.two_zsmul_oangle_eq_left hp₃p₂ hp₃'p₂, ←smul_neg, ←oangle_rev]
+
+/-- Two different points are equidistant from a third point if and only if that third point
+equals some multiple of a `π / 2` rotation of the vector between those points, plus the midpoint
+of those points. -/
+lemma dist_eq_iff_eq_smul_rotation_pi_div_two_vadd_midpoint {p₁ p₂ p : P} (h : p₁ ≠ p₂) :
+  dist p₁ p = dist p₂ p ↔
+    ∃ r : ℝ, r • ((o).rotation (π / 2 : ℝ) (p₂ -ᵥ p₁)) +ᵥ midpoint ℝ p₁ p₂ = p :=
+begin
+  refine ⟨λ hd, _, λ hr, _⟩,
+  { have hi : ⟪p₂ -ᵥ p₁, p -ᵥ midpoint ℝ p₁ p₂⟫ = 0,
+    { rw [@dist_eq_norm_vsub' V, @dist_eq_norm_vsub' V,
+          ←mul_self_inj (norm_nonneg _) (norm_nonneg _), ←real_inner_self_eq_norm_mul_norm,
+          ←real_inner_self_eq_norm_mul_norm] at hd,
+      simp_rw [vsub_midpoint, ←vsub_sub_vsub_cancel_left p₂ p₁ p, inner_sub_left,
+               inner_add_right, inner_smul_right, hd, real_inner_comm (p -ᵥ p₁)],
+      abel },
+    rw [@orientation.inner_eq_zero_iff_eq_zero_or_eq_smul_rotation_pi_div_two V _ _ _ o,
+        or_iff_right (vsub_ne_zero.2 h.symm)] at hi,
+    rcases hi with ⟨r, hr⟩,
+    rw [eq_comm, ←eq_vadd_iff_vsub_eq] at hr,
+    exact ⟨r, hr.symm⟩ },
+  { rcases hr with ⟨r, rfl⟩,
+    simp_rw [@dist_eq_norm_vsub V, vsub_vadd_eq_vsub_sub, left_vsub_midpoint,
+             right_vsub_midpoint, inv_of_eq_inv, ←neg_vsub_eq_vsub_rev p₂ p₁,
+             ←mul_self_inj (norm_nonneg _) (norm_nonneg _), ←real_inner_self_eq_norm_mul_norm,
+             inner_sub_sub_self],
+    simp [-neg_vsub_eq_vsub_rev] }
+end
+
+open affine_subspace
+
+/-- Given two pairs of distinct points on the same line, such that the vectors between those
+pairs of points are on the same ray (oriented in the same direction on that line), and a fifth
+point, the angles at the fifth point between each of those two pairs of points have the same
+sign. -/
+lemma _root_.collinear.oangle_sign_of_same_ray_vsub {p₁ p₂ p₃ p₄ : P} (p₅ : P) (hp₁p₂ : p₁ ≠ p₂)
+  (hp₃p₄ : p₃ ≠ p₄) (hc : collinear ℝ ({p₁, p₂, p₃, p₄} : set P))
+  (hr : same_ray ℝ (p₂ -ᵥ p₁) (p₄ -ᵥ p₃)) : (∡ p₁ p₅ p₂).sign = (∡ p₃ p₅ p₄).sign :=
+begin
+  by_cases hc₅₁₂ : collinear ℝ ({p₅, p₁, p₂} : set P),
+  { have hc₅₁₂₃₄ : collinear ℝ ({p₅, p₁, p₂, p₃, p₄} : set P) :=
+      (hc.collinear_insert_iff_of_ne (set.mem_insert _ _)
+                                     (set.mem_insert_of_mem _ (set.mem_insert _ _)) hp₁p₂).2 hc₅₁₂,
+    have hc₅₃₄ : collinear ℝ ({p₅, p₃, p₄} : set P) :=
+      (hc.collinear_insert_iff_of_ne
+        (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert _ _)))
+        (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert_of_mem _
+          (set.mem_singleton _)))) hp₃p₄).1 hc₅₁₂₃₄,
+    rw set.insert_comm at hc₅₁₂ hc₅₃₄,
+    have hs₁₅₂ := oangle_eq_zero_or_eq_pi_iff_collinear.2 hc₅₁₂,
+    have hs₃₅₄ := oangle_eq_zero_or_eq_pi_iff_collinear.2 hc₅₃₄,
+    rw ←real.angle.sign_eq_zero_iff at hs₁₅₂ hs₃₅₄,
+    rw [hs₁₅₂, hs₃₅₄] },
+  { let s : set (P × P × P) :=
+      (λ x : line[ℝ, p₁, p₂] × V, (x.1, p₅, x.2 +ᵥ x.1)) ''
+        set.univ ×ˢ {v | same_ray ℝ (p₂ -ᵥ p₁) v ∧ v ≠ 0},
+    have hco : is_connected s,
+    { haveI : connected_space line[ℝ, p₁, p₂] := add_torsor.connected_space _ _,
+      exact (is_connected_univ.prod (is_connected_set_of_same_ray_and_ne_zero
+        (vsub_ne_zero.2 hp₁p₂.symm))).image _
+          ((continuous_fst.subtype_coe.prod_mk
+            (continuous_const.prod_mk
+              (continuous_snd.vadd continuous_fst.subtype_coe))).continuous_on) },
+    have hf : continuous_on (λ p : P × P × P, ∡ p.1 p.2.1 p.2.2) s,
+    { refine continuous_at.continuous_on (λ p hp, continuous_at_oangle _ _),
+      all_goals { simp_rw [s, set.mem_image, set.mem_prod, set.mem_univ, true_and,
+                           prod.ext_iff] at hp,
+                  obtain ⟨q₁, q₅, q₂⟩ := p,
+                  dsimp only at ⊢ hp,
+                  obtain ⟨⟨⟨q, hq⟩, v⟩, hv, rfl, rfl, rfl⟩ := hp,
+                  dsimp only [subtype.coe_mk, set.mem_set_of] at ⊢ hv,
+                  obtain ⟨hvr, -⟩ := hv,
+                  rintro rfl,
+                  refine hc₅₁₂ ((collinear_insert_iff_of_mem_affine_span _).2
+                                  (collinear_pair _ _ _)) },
+      { exact hq },
+      { refine vadd_mem_of_mem_direction _ hq,
+        rw ←exists_nonneg_left_iff_same_ray (vsub_ne_zero.2 hp₁p₂.symm) at hvr,
+        obtain ⟨r, -, rfl⟩ := hvr,
+        rw direction_affine_span,
+        exact smul_vsub_rev_mem_vector_span_pair _ _ _ } },
+    have hsp : ∀ p : P × P × P, p ∈ s → ∡ p.1 p.2.1 p.2.2 ≠ 0 ∧ ∡ p.1 p.2.1 p.2.2 ≠ π,
+    { intros p hp,
+      simp_rw [s, set.mem_image, set.mem_prod, set.mem_set_of, set.mem_univ, true_and,
+               prod.ext_iff] at hp,
+      obtain ⟨q₁, q₅, q₂⟩ := p,
+      dsimp only at ⊢ hp,
+      obtain ⟨⟨⟨q, hq⟩, v⟩, hv, rfl, rfl, rfl⟩ := hp,
+      dsimp only [subtype.coe_mk, set.mem_set_of] at ⊢ hv,
+      obtain ⟨hvr, hv0⟩ := hv,
+      rw ←exists_nonneg_left_iff_same_ray (vsub_ne_zero.2 hp₁p₂.symm) at hvr,
+      obtain ⟨r, -, rfl⟩ := hvr,
+      change q ∈ line[ℝ, p₁, p₂] at hq,
+      rw [oangle_ne_zero_and_ne_pi_iff_affine_independent],
+      refine affine_independent_of_ne_of_mem_of_not_mem_of_mem _ hq
+        (λ h, hc₅₁₂ ((collinear_insert_iff_of_mem_affine_span h).2 (collinear_pair _ _ _))) _,
+      { rwa [←@vsub_ne_zero V, vsub_vadd_eq_vsub_sub, vsub_self, zero_sub, neg_ne_zero] },
+      { refine vadd_mem_of_mem_direction _ hq,
+        rw direction_affine_span,
+        exact smul_vsub_rev_mem_vector_span_pair _ _ _ } },
+    have hp₁p₂s : (p₁, p₅, p₂) ∈ s,
+    { simp_rw [s, set.mem_image, set.mem_prod, set.mem_set_of, set.mem_univ, true_and,
+               prod.ext_iff],
+      refine ⟨⟨⟨p₁, left_mem_affine_span_pair _ _ _⟩, p₂ -ᵥ p₁⟩,
+              ⟨same_ray.rfl, vsub_ne_zero.2 hp₁p₂.symm⟩, _⟩,
+      simp },
+    have hp₃p₄s : (p₃, p₅, p₄) ∈ s,
+    { simp_rw [s, set.mem_image, set.mem_prod, set.mem_set_of, set.mem_univ, true_and,
+               prod.ext_iff],
+      refine ⟨⟨⟨p₃,
+                hc.mem_affine_span_of_mem_of_ne
+                  (set.mem_insert _ _)
+                  (set.mem_insert_of_mem _ (set.mem_insert _ _))
+                  (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_insert _ _)))
+                  hp₁p₂⟩, p₄ -ᵥ p₃⟩, ⟨hr, vsub_ne_zero.2 hp₃p₄.symm⟩, _⟩,
+      simp },
+    convert real.angle.sign_eq_of_continuous_on hco hf hsp hp₃p₄s hp₁p₂s }
+end
+
+/-- Given three points in strict order on the same line, and a fourth point, the angles at the
+fourth point between the first and second or second and third points have the same sign. -/
+lemma _root_.sbtw.oangle_sign_eq {p₁ p₂ p₃ : P} (p₄ : P) (h : sbtw ℝ p₁ p₂ p₃) :
+  (∡ p₁ p₄ p₂).sign = (∡ p₂ p₄ p₃).sign :=
+begin
+  have hc : collinear ℝ ({p₁, p₂, p₂, p₃} : set P), { simpa using h.wbtw.collinear },
+  exact hc.oangle_sign_of_same_ray_vsub _ h.left_ne h.ne_right h.wbtw.same_ray_vsub
+end
+
+/-- Given three points in weak order on the same line, with the first not equal to the second,
+and a fourth point, the angles at the fourth point between the first and second or first and
+third points have the same sign. -/
+lemma _root_.wbtw.oangle_sign_eq_of_ne_left {p₁ p₂ p₃ : P} (p₄ : P) (h : wbtw ℝ p₁ p₂ p₃)
+  (hne : p₁ ≠ p₂) : (∡ p₁ p₄ p₂).sign = (∡ p₁ p₄ p₃).sign :=
+begin
+  have hc : collinear ℝ ({p₁, p₂, p₁, p₃} : set P),
+  { simpa [set.insert_comm p₂] using h.collinear },
+  exact hc.oangle_sign_of_same_ray_vsub _ hne (h.left_ne_right_of_ne_left hne.symm)
+    h.same_ray_vsub_left
+end
+
+/-- Given three points in strict order on the same line, and a fourth point, the angles at the
+fourth point between the first and second or first and third points have the same sign. -/
+lemma _root_.sbtw.oangle_sign_eq_left {p₁ p₂ p₃ : P} (p₄ : P) (h : sbtw ℝ p₁ p₂ p₃) :
+  (∡ p₁ p₄ p₂).sign = (∡ p₁ p₄ p₃).sign :=
+h.wbtw.oangle_sign_eq_of_ne_left _ h.left_ne
+
+/-- Given three points in weak order on the same line, with the second not equal to the third,
+and a fourth point, the angles at the fourth point between the second and third or first and
+third points have the same sign. -/
+lemma _root_.wbtw.oangle_sign_eq_of_ne_right {p₁ p₂ p₃ : P} (p₄ : P) (h : wbtw ℝ p₁ p₂ p₃)
+  (hne : p₂ ≠ p₃) : (∡ p₂ p₄ p₃).sign = (∡ p₁ p₄ p₃).sign :=
+by simp_rw [oangle_rev p₃, real.angle.sign_neg, h.symm.oangle_sign_eq_of_ne_left _ hne.symm]
+
+/-- Given three points in strict order on the same line, and a fourth point, the angles at the
+fourth point between the second and third or first and third points have the same sign. -/
+lemma _root_.sbtw.oangle_sign_eq_right {p₁ p₂ p₃ : P} (p₄ : P) (h : sbtw ℝ p₁ p₂ p₃) :
+  (∡ p₂ p₄ p₃).sign = (∡ p₁ p₄ p₃).sign :=
+h.wbtw.oangle_sign_eq_of_ne_right _ h.ne_right
+
+/-- Given two points in an affine subspace, the angles between those two points at two other
+points on the same side of that subspace have the same sign. -/
+lemma _root_.affine_subspace.s_same_side.oangle_sign_eq {s : affine_subspace ℝ P}
+  {p₁ p₂ p₃ p₄ : P} (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃p₄ : s.s_same_side p₃ p₄) :
+  (∡ p₁ p₄ p₂).sign = (∡ p₁ p₃ p₂).sign :=
+begin
+  by_cases h : p₁ = p₂, { simp [h] },
+  let sp : set (P × P × P) := (λ p : P, (p₁, p, p₂)) '' {p | s.s_same_side p₃ p},
+  have hc : is_connected sp := (is_connected_set_of_s_same_side hp₃p₄.2.1 hp₃p₄.nonempty).image
+    _ (continuous_const.prod_mk (continuous.prod.mk_left _)).continuous_on,
+  have hf : continuous_on (λ p : P × P × P, ∡ p.1 p.2.1 p.2.2) sp,
+  { refine continuous_at.continuous_on (λ p hp, continuous_at_oangle _ _),
+    all_goals { simp_rw [sp, set.mem_image, set.mem_set_of] at hp,
+                obtain ⟨p', hp', rfl⟩ := hp,
+                dsimp only,
+                rintro rfl },
+    { exact hp'.2.2 hp₁ },
+    { exact hp'.2.2 hp₂ } },
+  have hsp : ∀ p : P × P × P, p ∈ sp → ∡ p.1 p.2.1 p.2.2 ≠ 0 ∧ ∡ p.1 p.2.1 p.2.2 ≠ π,
+  { intros p hp,
+    simp_rw [sp, set.mem_image, set.mem_set_of] at hp,
+    obtain ⟨p', hp', rfl⟩ := hp,
+    dsimp only,
+    rw [oangle_ne_zero_and_ne_pi_iff_affine_independent],
+    exact affine_independent_of_ne_of_mem_of_not_mem_of_mem h hp₁ hp'.2.2 hp₂ },
+  have hp₃ : (p₁, p₃, p₂) ∈ sp :=
+    set.mem_image_of_mem _ (s_same_side_self_iff.2 ⟨hp₃p₄.nonempty, hp₃p₄.2.1⟩),
+  have hp₄ : (p₁, p₄, p₂) ∈ sp := set.mem_image_of_mem _ hp₃p₄,
+  convert real.angle.sign_eq_of_continuous_on hc hf hsp hp₃ hp₄
+end
+
+/-- Given two points in an affine subspace, the angles between those two points at two other
+points on opposite sides of that subspace have opposite signs. -/
+lemma _root_.affine_subspace.s_opp_side.oangle_sign_eq_neg {s : affine_subspace ℝ P}
+  {p₁ p₂ p₃ p₄ : P} (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃p₄ : s.s_opp_side p₃ p₄) :
+  (∡ p₁ p₄ p₂).sign = -(∡ p₁ p₃ p₂).sign :=
+begin
+  have hp₁p₃ : p₁ ≠ p₃, { rintro rfl, exact hp₃p₄.left_not_mem hp₁ },
+  rw [←(hp₃p₄.symm.trans (s_opp_side_point_reflection hp₁ hp₃p₄.left_not_mem)).oangle_sign_eq
+          hp₁ hp₂, ←oangle_rotate_sign p₁, ←oangle_rotate_sign p₁, oangle_swap₁₃_sign,
+      (sbtw_point_reflection_of_ne ℝ hp₁p₃).symm.oangle_sign_eq _],
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/angle/oriented/basic.lean b/src/geometry/euclidean/angle/oriented/basic.lean
new file mode 100644
index 0000000000000..b5de68815a179
--- /dev/null
+++ b/src/geometry/euclidean/angle/oriented/basic.lean
@@ -0,0 +1,1036 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers, Heather Macbeth
+-/
+import analysis.inner_product_space.two_dim
+import geometry.euclidean.angle.unoriented.basic
+
+/-!
+# Oriented angles.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines oriented angles in real inner product spaces.
+
+## Main definitions
+
+* `orientation.oangle` is the oriented angle between two vectors with respect to an orientation.
+
+## Implementation notes
+
+The definitions here use the `real.angle` type, angles modulo `2 * π`. For some purposes,
+angles modulo `π` are more convenient, because results are true for such angles with less
+configuration dependence. Results that are only equalities modulo `π` can be represented
+modulo `2 * π` as equalities of `(2 : ℤ) • θ`.
+
+## References
+
+* Evan Chen, Euclidean Geometry in Mathematical Olympiads.
+
+-/
+
+noncomputable theory
+
+open finite_dimensional complex
+open_locale real real_inner_product_space complex_conjugate
+
+namespace orientation
+
+local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ
+local attribute [instance] complex.finrank_real_complex_fact
+
+variables {V V' : Type*}
+variables [normed_add_comm_group V] [normed_add_comm_group V']
+variables [inner_product_space ℝ V] [inner_product_space ℝ V']
+variables [fact (finrank ℝ V = 2)] [fact (finrank ℝ V' = 2)] (o : orientation ℝ V (fin 2))
+
+local notation `ω` := o.area_form
+
+/-- The oriented angle from `x` to `y`, modulo `2 * π`. If either vector is 0, this is 0.
+See `inner_product_geometry.angle` for the corresponding unoriented angle definition. -/
+def oangle (x y : V) : real.angle :=
+complex.arg (o.kahler x y)
+
+/-- Oriented angles are continuous when the vectors involved are nonzero. -/
+lemma continuous_at_oangle {x : V × V} (hx1 : x.1 ≠ 0) (hx2 : x.2 ≠ 0) :
+  continuous_at (λ y : V × V, o.oangle y.1 y.2) x :=
+begin
+  refine (complex.continuous_at_arg_coe_angle _).comp _,
+  { exact o.kahler_ne_zero hx1 hx2 },
+  exact ((continuous_of_real.comp continuous_inner).add
+    ((continuous_of_real.comp o.area_form'.continuous₂).mul continuous_const)).continuous_at,
+end
+
+/-- If the first vector passed to `oangle` is 0, the result is 0. -/
+@[simp] lemma oangle_zero_left (x : V) : o.oangle 0 x = 0 :=
+by simp [oangle]
+
+/-- If the second vector passed to `oangle` is 0, the result is 0. -/
+@[simp] lemma oangle_zero_right (x : V) : o.oangle x 0 = 0 :=
+by simp [oangle]
+
+/-- If the two vectors passed to `oangle` are the same, the result is 0. -/
+@[simp] lemma oangle_self (x : V) : o.oangle x x = 0 :=
+begin
+  simp only [oangle, kahler_apply_self, ← complex.of_real_pow],
+  convert quotient_add_group.coe_zero _,
+  apply arg_of_real_of_nonneg,
+  positivity,
+end
+
+/-- If the angle between two vectors is nonzero, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_ne_zero {x y : V} (h : o.oangle x y ≠ 0) : x ≠ 0 :=
+by { rintro rfl, simpa using h }
+
+/-- If the angle between two vectors is nonzero, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_ne_zero {x y : V} (h : o.oangle x y ≠ 0) : y ≠ 0 :=
+by { rintro rfl, simpa using h }
+
+/-- If the angle between two vectors is nonzero, the vectors are not equal. -/
+lemma ne_of_oangle_ne_zero {x y : V} (h : o.oangle x y ≠ 0) : x ≠ y :=
+by { rintro rfl, simpa using h }
+
+/-- If the angle between two vectors is `π`, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_eq_pi {x y : V} (h : o.oangle x y = π) : x ≠ 0 :=
+o.left_ne_zero_of_oangle_ne_zero (h.symm ▸ real.angle.pi_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `π`, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_eq_pi {x y : V} (h : o.oangle x y = π) : y ≠ 0 :=
+o.right_ne_zero_of_oangle_ne_zero (h.symm ▸ real.angle.pi_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `π`, the vectors are not equal. -/
+lemma ne_of_oangle_eq_pi {x y : V} (h : o.oangle x y = π) : x ≠ y :=
+o.ne_of_oangle_ne_zero (h.symm ▸ real.angle.pi_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `π / 2`, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = (π / 2 : ℝ)) : x ≠ 0 :=
+o.left_ne_zero_of_oangle_ne_zero (h.symm ▸ real.angle.pi_div_two_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `π / 2`, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = (π / 2 : ℝ)) : y ≠ 0 :=
+o.right_ne_zero_of_oangle_ne_zero (h.symm ▸ real.angle.pi_div_two_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `π / 2`, the vectors are not equal. -/
+lemma ne_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = (π / 2 : ℝ)) : x ≠ y :=
+o.ne_of_oangle_ne_zero (h.symm ▸ real.angle.pi_div_two_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `-π / 2`, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_eq_neg_pi_div_two {x y : V} (h : o.oangle x y = (-π / 2 : ℝ)) :
+  x ≠ 0 :=
+o.left_ne_zero_of_oangle_ne_zero (h.symm ▸ real.angle.neg_pi_div_two_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `-π / 2`, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_eq_neg_pi_div_two {x y : V} (h : o.oangle x y = (-π / 2 : ℝ)) :
+  y ≠ 0 :=
+o.right_ne_zero_of_oangle_ne_zero (h.symm ▸ real.angle.neg_pi_div_two_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the angle between two vectors is `-π / 2`, the vectors are not equal. -/
+lemma ne_of_oangle_eq_neg_pi_div_two {x y : V} (h : o.oangle x y = (-π / 2 : ℝ)) :
+  x ≠ y :=
+o.ne_of_oangle_ne_zero (h.symm ▸ real.angle.neg_pi_div_two_ne_zero : o.oangle x y ≠ 0)
+
+/-- If the sign of the angle between two vectors is nonzero, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_sign_ne_zero {x y : V} (h : (o.oangle x y).sign ≠ 0) : x ≠ 0 :=
+o.left_ne_zero_of_oangle_ne_zero (real.angle.sign_ne_zero_iff.1 h).1
+
+/-- If the sign of the angle between two vectors is nonzero, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_sign_ne_zero {x y : V} (h : (o.oangle x y).sign ≠ 0) : y ≠ 0 :=
+o.right_ne_zero_of_oangle_ne_zero (real.angle.sign_ne_zero_iff.1 h).1
+
+/-- If the sign of the angle between two vectors is nonzero, the vectors are not equal. -/
+lemma ne_of_oangle_sign_ne_zero {x y : V} (h : (o.oangle x y).sign ≠ 0) : x ≠ y :=
+o.ne_of_oangle_ne_zero (real.angle.sign_ne_zero_iff.1 h).1
+
+/-- If the sign of the angle between two vectors is positive, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_sign_eq_one {x y : V} (h : (o.oangle x y).sign = 1) : x ≠ 0 :=
+o.left_ne_zero_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (o.oangle x y).sign ≠ 0)
+
+/-- If the sign of the angle between two vectors is positive, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_sign_eq_one {x y : V} (h : (o.oangle x y).sign = 1) : y ≠ 0 :=
+o.right_ne_zero_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (o.oangle x y).sign ≠ 0)
+
+/-- If the sign of the angle between two vectors is positive, the vectors are not equal. -/
+lemma ne_of_oangle_sign_eq_one {x y : V} (h : (o.oangle x y).sign = 1) : x ≠ y :=
+o.ne_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (o.oangle x y).sign ≠ 0)
+
+/-- If the sign of the angle between two vectors is negative, the first vector is nonzero. -/
+lemma left_ne_zero_of_oangle_sign_eq_neg_one {x y : V} (h : (o.oangle x y).sign = -1) : x ≠ 0 :=
+o.left_ne_zero_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (o.oangle x y).sign ≠ 0)
+
+/-- If the sign of the angle between two vectors is negative, the second vector is nonzero. -/
+lemma right_ne_zero_of_oangle_sign_eq_neg_one {x y : V} (h : (o.oangle x y).sign = -1) : y ≠ 0 :=
+o.right_ne_zero_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (o.oangle x y).sign ≠ 0)
+
+/-- If the sign of the angle between two vectors is negative, the vectors are not equal. -/
+lemma ne_of_oangle_sign_eq_neg_one {x y : V} (h : (o.oangle x y).sign = -1) : x ≠ y :=
+o.ne_of_oangle_sign_ne_zero (h.symm ▸ dec_trivial : (o.oangle x y).sign ≠ 0)
+
+/-- Swapping the two vectors passed to `oangle` negates the angle. -/
+lemma oangle_rev (x y : V) : o.oangle y x = -o.oangle x y :=
+by simp only [oangle, o.kahler_swap y x, complex.arg_conj_coe_angle]
+
+/-- Adding the angles between two vectors in each order results in 0. -/
+@[simp] lemma oangle_add_oangle_rev (x y : V) : o.oangle x y + o.oangle y x = 0 :=
+by simp [o.oangle_rev y x]
+
+/-- Negating the first vector passed to `oangle` adds `π` to the angle. -/
+lemma oangle_neg_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  o.oangle (-x) y = o.oangle x y + π :=
+begin
+  simp only [oangle, map_neg],
+  convert complex.arg_neg_coe_angle _,
+  exact o.kahler_ne_zero hx hy,
+end
+
+/-- Negating the second vector passed to `oangle` adds `π` to the angle. -/
+lemma oangle_neg_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  o.oangle x (-y) = o.oangle x y + π :=
+begin
+  simp only [oangle, map_neg],
+  convert complex.arg_neg_coe_angle _,
+  exact o.kahler_ne_zero hx hy,
+end
+
+/-- Negating the first vector passed to `oangle` does not change twice the angle. -/
+@[simp] lemma two_zsmul_oangle_neg_left (x y : V) :
+  (2 : ℤ) • o.oangle (-x) y = (2 : ℤ) • o.oangle x y :=
+begin
+  by_cases hx : x = 0,
+  { simp [hx] },
+  { by_cases hy : y = 0,
+    { simp [hy] },
+    { simp [o.oangle_neg_left hx hy] } }
+end
+
+/-- Negating the second vector passed to `oangle` does not change twice the angle. -/
+@[simp] lemma two_zsmul_oangle_neg_right (x y : V) :
+  (2 : ℤ) • o.oangle x (-y) = (2 : ℤ) • o.oangle x y :=
+begin
+  by_cases hx : x = 0,
+  { simp [hx] },
+  { by_cases hy : y = 0,
+    { simp [hy] },
+    { simp [o.oangle_neg_right hx hy] } }
+end
+
+/-- Negating both vectors passed to `oangle` does not change the angle. -/
+@[simp] lemma oangle_neg_neg (x y : V) : o.oangle (-x) (-y) = o.oangle x y :=
+by simp [oangle]
+
+/-- Negating the first vector produces the same angle as negating the second vector. -/
+lemma oangle_neg_left_eq_neg_right (x y : V) : o.oangle (-x) y = o.oangle x (-y) :=
+by rw [←neg_neg y, oangle_neg_neg, neg_neg]
+
+/-- The angle between the negation of a nonzero vector and that vector is `π`. -/
+@[simp] lemma oangle_neg_self_left {x : V} (hx : x ≠ 0) : o.oangle (-x) x = π :=
+by simp [oangle_neg_left, hx]
+
+/-- The angle between a nonzero vector and its negation is `π`. -/
+@[simp] lemma oangle_neg_self_right {x : V} (hx : x ≠ 0) : o.oangle x (-x) = π :=
+by simp [oangle_neg_right, hx]
+
+/-- Twice the angle between the negation of a vector and that vector is 0. -/
+@[simp] lemma two_zsmul_oangle_neg_self_left (x : V) : (2 : ℤ) • o.oangle (-x) x = 0 :=
+begin
+  by_cases hx : x = 0;
+    simp [hx]
+end
+
+/-- Twice the angle between a vector and its negation is 0. -/
+@[simp] lemma two_zsmul_oangle_neg_self_right (x : V) : (2 : ℤ) • o.oangle x (-x) = 0 :=
+begin
+  by_cases hx : x = 0;
+    simp [hx]
+end
+
+/-- Adding the angles between two vectors in each order, with the first vector in each angle
+negated, results in 0. -/
+@[simp] lemma oangle_add_oangle_rev_neg_left (x y : V) :
+  o.oangle (-x) y + o.oangle (-y) x = 0 :=
+by rw [oangle_neg_left_eq_neg_right, oangle_rev, add_left_neg]
+
+/-- Adding the angles between two vectors in each order, with the second vector in each angle
+negated, results in 0. -/
+@[simp] lemma oangle_add_oangle_rev_neg_right (x y : V) :
+  o.oangle x (-y) + o.oangle y (-x) = 0 :=
+by rw [o.oangle_rev (-x), oangle_neg_left_eq_neg_right, add_neg_self]
+
+/-- Multiplying the first vector passed to `oangle` by a positive real does not change the
+angle. -/
+@[simp] lemma oangle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
+  o.oangle (r • x) y = o.oangle x y :=
+by simp [oangle, complex.arg_real_mul _ hr]
+
+/-- Multiplying the second vector passed to `oangle` by a positive real does not change the
+angle. -/
+@[simp] lemma oangle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
+  o.oangle x (r • y) = o.oangle x y :=
+by simp [oangle, complex.arg_real_mul _ hr]
+
+/-- Multiplying the first vector passed to `oangle` by a negative real produces the same angle
+as negating that vector. -/
+@[simp] lemma oangle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
+  o.oangle (r • x) y = o.oangle (-x) y :=
+by rw [←neg_neg r, neg_smul, ←smul_neg, o.oangle_smul_left_of_pos _ _ (neg_pos_of_neg hr)]
+
+/-- Multiplying the second vector passed to `oangle` by a negative real produces the same angle
+as negating that vector. -/
+@[simp] lemma oangle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
+  o.oangle x (r • y) = o.oangle x (-y) :=
+by rw [←neg_neg r, neg_smul, ←smul_neg, o.oangle_smul_right_of_pos _ _ (neg_pos_of_neg hr)]
+
+/-- The angle between a nonnegative multiple of a vector and that vector is 0. -/
+@[simp] lemma oangle_smul_left_self_of_nonneg (x : V) {r : ℝ} (hr : 0 ≤ r) :
+  o.oangle (r • x) x = 0 :=
+begin
+  rcases hr.lt_or_eq with (h|h),
+  { simp [h] },
+  { simp [h.symm] }
+end
+
+/-- The angle between a vector and a nonnegative multiple of that vector is 0. -/
+@[simp] lemma oangle_smul_right_self_of_nonneg (x : V) {r : ℝ} (hr : 0 ≤ r) :
+  o.oangle x (r • x) = 0 :=
+begin
+  rcases hr.lt_or_eq with (h|h),
+  { simp [h] },
+  { simp [h.symm] }
+end
+
+/-- The angle between two nonnegative multiples of the same vector is 0. -/
+@[simp] lemma oangle_smul_smul_self_of_nonneg (x : V) {r₁ r₂ : ℝ} (hr₁ : 0 ≤ r₁) (hr₂ : 0 ≤ r₂) :
+  o.oangle (r₁ • x) (r₂ • x) = 0 :=
+begin
+  rcases hr₁.lt_or_eq with (h|h),
+  { simp [h, hr₂] },
+  { simp [h.symm] }
+end
+
+/-- Multiplying the first vector passed to `oangle` by a nonzero real does not change twice the
+angle. -/
+@[simp] lemma two_zsmul_oangle_smul_left_of_ne_zero (x y : V) {r : ℝ} (hr : r ≠ 0) :
+  (2 : ℤ) • o.oangle (r • x) y = (2 : ℤ) • o.oangle x y :=
+begin
+  rcases hr.lt_or_lt with (h|h);
+    simp [h]
+end
+
+/-- Multiplying the second vector passed to `oangle` by a nonzero real does not change twice the
+angle. -/
+@[simp] lemma two_zsmul_oangle_smul_right_of_ne_zero (x y : V) {r : ℝ} (hr : r ≠ 0) :
+  (2 : ℤ) • o.oangle x (r • y) = (2 : ℤ) • o.oangle x y :=
+begin
+  rcases hr.lt_or_lt with (h|h);
+    simp [h]
+end
+
+/-- Twice the angle between a multiple of a vector and that vector is 0. -/
+@[simp] lemma two_zsmul_oangle_smul_left_self (x : V) {r : ℝ} :
+  (2 : ℤ) • o.oangle (r • x) x = 0 :=
+begin
+  rcases lt_or_le r 0 with (h|h);
+    simp [h]
+end
+
+/-- Twice the angle between a vector and a multiple of that vector is 0. -/
+@[simp] lemma two_zsmul_oangle_smul_right_self (x : V) {r : ℝ} :
+  (2 : ℤ) • o.oangle x (r • x) = 0 :=
+begin
+  rcases lt_or_le r 0 with (h|h);
+    simp [h]
+end
+
+/-- Twice the angle between two multiples of a vector is 0. -/
+@[simp] lemma two_zsmul_oangle_smul_smul_self (x : V) {r₁ r₂ : ℝ} :
+  (2 : ℤ) • o.oangle (r₁ • x) (r₂ • x) = 0 :=
+begin
+  by_cases h : r₁ = 0;
+    simp [h]
+end
+
+/-- If the spans of two vectors are equal, twice angles with those vectors on the left are
+equal. -/
+lemma two_zsmul_oangle_left_of_span_eq {x y : V} (z : V) (h : (ℝ ∙ x) = ℝ ∙ y) :
+  (2 : ℤ) • o.oangle x z = (2 : ℤ) • o.oangle y z :=
+begin
+  rw submodule.span_singleton_eq_span_singleton at h,
+  rcases h with ⟨r, rfl⟩,
+  exact (o.two_zsmul_oangle_smul_left_of_ne_zero _ _ (units.ne_zero _)).symm
+end
+
+/-- If the spans of two vectors are equal, twice angles with those vectors on the right are
+equal. -/
+lemma two_zsmul_oangle_right_of_span_eq (x : V) {y z : V} (h : (ℝ ∙ y) = ℝ ∙ z) :
+  (2 : ℤ) • o.oangle x y = (2 : ℤ) • o.oangle x z :=
+begin
+  rw submodule.span_singleton_eq_span_singleton at h,
+  rcases h with ⟨r, rfl⟩,
+  exact (o.two_zsmul_oangle_smul_right_of_ne_zero _ _ (units.ne_zero _)).symm
+end
+
+/-- If the spans of two pairs of vectors are equal, twice angles between those vectors are
+equal. -/
+lemma two_zsmul_oangle_of_span_eq_of_span_eq {w x y z : V} (hwx : (ℝ ∙ w) = ℝ ∙ x)
+  (hyz : (ℝ ∙ y) = ℝ ∙ z) : (2 : ℤ) • o.oangle w y = (2 : ℤ) • o.oangle x z :=
+by rw [(o).two_zsmul_oangle_left_of_span_eq y hwx, (o).two_zsmul_oangle_right_of_span_eq x hyz]
+
+/-- The oriented angle between two vectors is zero if and only if the angle with the vectors
+swapped is zero. -/
+lemma oangle_eq_zero_iff_oangle_rev_eq_zero {x y : V} : o.oangle x y = 0 ↔ o.oangle y x = 0 :=
+by rw [oangle_rev, neg_eq_zero]
+
+/-- The oriented angle between two vectors is zero if and only if they are on the same ray. -/
+lemma oangle_eq_zero_iff_same_ray {x y : V} : o.oangle x y = 0 ↔ same_ray ℝ x y :=
+begin
+  rw [oangle, kahler_apply_apply, complex.arg_coe_angle_eq_iff_eq_to_real, real.angle.to_real_zero,
+    complex.arg_eq_zero_iff],
+  simpa using o.nonneg_inner_and_area_form_eq_zero_iff_same_ray x y,
+end
+
+/-- The oriented angle between two vectors is `π` if and only if the angle with the vectors
+swapped is `π`. -/
+lemma oangle_eq_pi_iff_oangle_rev_eq_pi {x y : V} : o.oangle x y = π ↔ o.oangle y x = π :=
+by rw [oangle_rev, neg_eq_iff_eq_neg, real.angle.neg_coe_pi]
+
+/-- The oriented angle between two vectors is `π` if and only they are nonzero and the first is
+on the same ray as the negation of the second. -/
+lemma oangle_eq_pi_iff_same_ray_neg {x y : V} :
+  o.oangle x y = π ↔ x ≠ 0 ∧ y ≠ 0 ∧ same_ray ℝ x (-y) :=
+begin
+  rw [←o.oangle_eq_zero_iff_same_ray],
+  split,
+  { intro h,
+    by_cases hx : x = 0, { simpa [hx, real.angle.pi_ne_zero.symm] using h },
+    by_cases hy : y = 0, { simpa [hy, real.angle.pi_ne_zero.symm] using h },
+    refine ⟨hx, hy, _⟩,
+    rw [o.oangle_neg_right hx hy, h, real.angle.coe_pi_add_coe_pi] },
+  { rintro ⟨hx, hy, h⟩,
+    rwa [o.oangle_neg_right hx hy, ←real.angle.sub_coe_pi_eq_add_coe_pi, sub_eq_zero] at h }
+end
+
+/-- The oriented angle between two vectors is zero or `π` if and only if those two vectors are
+not linearly independent. -/
+lemma oangle_eq_zero_or_eq_pi_iff_not_linear_independent {x y : V} :
+  (o.oangle x y = 0 ∨ o.oangle x y = π) ↔ ¬ linear_independent ℝ ![x, y] :=
+by rw [oangle_eq_zero_iff_same_ray, oangle_eq_pi_iff_same_ray_neg,
+       same_ray_or_ne_zero_and_same_ray_neg_iff_not_linear_independent]
+
+/-- The oriented angle between two vectors is zero or `π` if and only if the first vector is zero
+or the second is a multiple of the first. -/
+lemma oangle_eq_zero_or_eq_pi_iff_right_eq_smul {x y : V} :
+  (o.oangle x y = 0 ∨ o.oangle x y = π) ↔ (x = 0 ∨ ∃ r : ℝ, y = r • x) :=
+begin
+  rw [oangle_eq_zero_iff_same_ray, oangle_eq_pi_iff_same_ray_neg],
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with h|⟨-, -, h⟩,
+    { by_cases hx : x = 0, { simp [hx] },
+      obtain ⟨r, -, rfl⟩ := h.exists_nonneg_left hx,
+      exact or.inr ⟨r, rfl⟩ },
+    { by_cases hx : x = 0, { simp [hx] },
+      obtain ⟨r, -, hy⟩ := h.exists_nonneg_left hx,
+      refine or.inr ⟨-r, _⟩,
+      simp [hy] } },
+  { rcases h with rfl|⟨r, rfl⟩, { simp },
+    by_cases hx : x = 0, { simp [hx] },
+    rcases lt_trichotomy r 0 with hr|hr|hr,
+    { rw ←neg_smul,
+      exact or.inr ⟨hx, smul_ne_zero hr.ne hx,
+                    same_ray_pos_smul_right x (left.neg_pos_iff.2 hr)⟩ },
+    { simp [hr] },
+    { exact or.inl (same_ray_pos_smul_right x hr) } }
+end
+
+/-- The oriented angle between two vectors is not zero or `π` if and only if those two vectors
+are linearly independent. -/
+lemma oangle_ne_zero_and_ne_pi_iff_linear_independent {x y : V} :
+  (o.oangle x y ≠ 0 ∧ o.oangle x y ≠ π) ↔ linear_independent ℝ ![x, y] :=
+by rw [←not_or_distrib, ←not_iff_not, not_not, oangle_eq_zero_or_eq_pi_iff_not_linear_independent]
+
+/-- Two vectors are equal if and only if they have equal norms and zero angle between them. -/
+lemma eq_iff_norm_eq_and_oangle_eq_zero (x y : V) : x = y ↔ ‖x‖ = ‖y‖ ∧ o.oangle x y = 0 :=
+begin
+  rw oangle_eq_zero_iff_same_ray,
+  split,
+  { rintros rfl,
+    simp },
+  { rcases eq_or_ne y 0 with rfl | hy,
+    { simp },
+    rintros ⟨h₁, h₂⟩,
+    obtain ⟨r, hr, rfl⟩ := h₂.exists_nonneg_right hy,
+    have : ‖y‖ ≠ 0 := by simpa using hy,
+    obtain rfl : r = 1,
+    { apply mul_right_cancel₀ this,
+      simpa [norm_smul, _root_.abs_of_nonneg hr] using h₁ },
+    simp },
+end
+
+/-- Two vectors with equal norms are equal if and only if they have zero angle between them. -/
+lemma eq_iff_oangle_eq_zero_of_norm_eq {x y : V} (h : ‖x‖ = ‖y‖) : x = y ↔ o.oangle x y = 0 :=
+⟨λ he, ((o.eq_iff_norm_eq_and_oangle_eq_zero x y).1 he).2,
+ λ ha, (o.eq_iff_norm_eq_and_oangle_eq_zero x y).2 ⟨h, ha⟩⟩
+
+/-- Two vectors with zero angle between them are equal if and only if they have equal norms. -/
+lemma eq_iff_norm_eq_of_oangle_eq_zero {x y : V} (h : o.oangle x y = 0) : x = y ↔ ‖x‖ = ‖y‖ :=
+⟨λ he, ((o.eq_iff_norm_eq_and_oangle_eq_zero x y).1 he).1,
+ λ hn, (o.eq_iff_norm_eq_and_oangle_eq_zero x y).2 ⟨hn, h⟩⟩
+
+/-- Given three nonzero vectors, the angle between the first and the second plus the angle
+between the second and the third equals the angle between the first and the third. -/
+@[simp] lemma oangle_add {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+  o.oangle x y + o.oangle y z = o.oangle x z :=
+begin
+  simp_rw [oangle],
+  rw [←complex.arg_mul_coe_angle, o.kahler_mul y x z],
+  congr' 1,
+  convert complex.arg_real_mul _ (_ : 0 < ‖y‖ ^ 2) using 2,
+  { norm_cast },
+  { have : 0 < ‖y‖ := by simpa using hy,
+    positivity },
+  { exact o.kahler_ne_zero hx hy, },
+  { exact o.kahler_ne_zero hy hz }
+end
+
+/-- Given three nonzero vectors, the angle between the second and the third plus the angle
+between the first and the second equals the angle between the first and the third. -/
+@[simp] lemma oangle_add_swap {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+   o.oangle y z + o.oangle x y = o.oangle x z :=
+by rw [add_comm, o.oangle_add hx hy hz]
+
+/-- Given three nonzero vectors, the angle between the first and the third minus the angle
+between the first and the second equals the angle between the second and the third. -/
+@[simp] lemma oangle_sub_left {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+  o.oangle x z - o.oangle x y = o.oangle y z :=
+by rw [sub_eq_iff_eq_add, o.oangle_add_swap hx hy hz]
+
+/-- Given three nonzero vectors, the angle between the first and the third minus the angle
+between the second and the third equals the angle between the first and the second. -/
+@[simp] lemma oangle_sub_right {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+  o.oangle x z - o.oangle y z = o.oangle x y :=
+by rw [sub_eq_iff_eq_add, o.oangle_add hx hy hz]
+
+/-- Given three nonzero vectors, adding the angles between them in cyclic order results in 0. -/
+@[simp] lemma oangle_add_cyc3 {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+  o.oangle x y + o.oangle y z + o.oangle z x = 0 :=
+by simp [hx, hy, hz]
+
+/-- Given three nonzero vectors, adding the angles between them in cyclic order, with the first
+vector in each angle negated, results in π. If the vectors add to 0, this is a version of the
+sum of the angles of a triangle. -/
+@[simp] lemma oangle_add_cyc3_neg_left {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+  o.oangle (-x) y + o.oangle (-y) z + o.oangle (-z) x = π :=
+by rw [o.oangle_neg_left hx hy, o.oangle_neg_left hy hz, o.oangle_neg_left hz hx,
+       (show o.oangle x y + π + (o.oangle y z + π) + (o.oangle z x + π) =
+         o.oangle x y + o.oangle y z + o.oangle z x + (π + π + π : real.angle), by abel),
+       o.oangle_add_cyc3 hx hy hz, real.angle.coe_pi_add_coe_pi, zero_add, zero_add]
+
+/-- Given three nonzero vectors, adding the angles between them in cyclic order, with the second
+vector in each angle negated, results in π. If the vectors add to 0, this is a version of the
+sum of the angles of a triangle. -/
+@[simp] lemma oangle_add_cyc3_neg_right {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
+  o.oangle x (-y) + o.oangle y (-z) + o.oangle z (-x) = π :=
+by simp_rw [←oangle_neg_left_eq_neg_right, o.oangle_add_cyc3_neg_left hx hy hz]
+
+/-- Pons asinorum, oriented vector angle form. -/
+lemma oangle_sub_eq_oangle_sub_rev_of_norm_eq {x y : V} (h : ‖x‖ = ‖y‖) :
+  o.oangle x (x - y) = o.oangle (y - x) y :=
+by simp [oangle, h]
+
+/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
+vector angle form. -/
+lemma oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq {x y : V} (hn : x ≠ y) (h : ‖x‖ = ‖y‖) :
+  o.oangle y x = π - (2 : ℤ) • o.oangle (y - x) y :=
+begin
+  rw two_zsmul,
+  rw [←o.oangle_sub_eq_oangle_sub_rev_of_norm_eq h] { occs := occurrences.pos [1] },
+  rw [eq_sub_iff_add_eq, ←oangle_neg_neg, ←add_assoc],
+  have hy : y ≠ 0,
+  { rintro rfl,
+    rw [norm_zero, norm_eq_zero] at h,
+    exact hn h },
+  have hx : x ≠ 0 := norm_ne_zero_iff.1 (h.symm ▸ norm_ne_zero_iff.2 hy),
+  convert o.oangle_add_cyc3_neg_right (neg_ne_zero.2 hy) hx (sub_ne_zero_of_ne hn.symm);
+    simp
+end
+
+/-- The angle between two vectors, with respect to an orientation given by `orientation.map`
+with a linear isometric equivalence, equals the angle between those two vectors, transformed by
+the inverse of that equivalence, with respect to the original orientation. -/
+@[simp] lemma oangle_map (x y : V') (f : V ≃ₗᵢ[ℝ] V') :
+  (orientation.map (fin 2) f.to_linear_equiv o).oangle x y = o.oangle (f.symm x) (f.symm y) :=
+by simp [oangle, o.kahler_map]
+
+@[simp] protected lemma _root_.complex.oangle (w z : ℂ) :
+  complex.orientation.oangle w z = complex.arg (conj w * z) :=
+by simp [oangle]
+
+/-- The oriented angle on an oriented real inner product space of dimension 2 can be evaluated in
+terms of a complex-number representation of the space. -/
+lemma oangle_map_complex (f : V ≃ₗᵢ[ℝ] ℂ)
+  (hf : (orientation.map (fin 2) f.to_linear_equiv o) = complex.orientation) (x y : V) :
+  o.oangle x y = complex.arg (conj (f x) * f y) :=
+begin
+  rw [← complex.oangle, ← hf, o.oangle_map],
+  simp,
+end
+
+/-- Negating the orientation negates the value of `oangle`. -/
+lemma oangle_neg_orientation_eq_neg (x y : V) : (-o).oangle x y = -(o.oangle x y) :=
+by simp [oangle]
+
+/-- The inner product of two vectors is the product of the norms and the cosine of the oriented
+angle between the vectors. -/
+lemma inner_eq_norm_mul_norm_mul_cos_oangle (x y : V) :
+  ⟪x, y⟫ = ‖x‖ * ‖y‖ * real.angle.cos (o.oangle x y) :=
+begin
+  by_cases hx : x = 0, { simp [hx] },
+  by_cases hy : y = 0, { simp [hy] },
+  have : ‖x‖ ≠ 0 := by simpa using hx,
+  have : ‖y‖ ≠ 0 := by simpa using hy,
+  rw [oangle, real.angle.cos_coe, complex.cos_arg, o.abs_kahler],
+  { simp only [kahler_apply_apply, real_smul, add_re, of_real_re, mul_re, I_re, of_real_im],
+    field_simp,
+    ring },
+  { exact o.kahler_ne_zero hx hy }
+end
+
+/-- The cosine of the oriented angle between two nonzero vectors is the inner product divided by
+the product of the norms. -/
+lemma cos_oangle_eq_inner_div_norm_mul_norm {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  real.angle.cos (o.oangle x y) = ⟪x, y⟫ / (‖x‖ * ‖y‖) :=
+begin
+  rw o.inner_eq_norm_mul_norm_mul_cos_oangle,
+  field_simp [norm_ne_zero_iff.2 hx, norm_ne_zero_iff.2 hy],
+  ring
+end
+
+/-- The cosine of the oriented angle between two nonzero vectors equals that of the unoriented
+angle. -/
+lemma cos_oangle_eq_cos_angle {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  real.angle.cos (o.oangle x y) = real.cos (inner_product_geometry.angle x y) :=
+by rw [o.cos_oangle_eq_inner_div_norm_mul_norm hx hy, inner_product_geometry.cos_angle]
+
+/-- The oriented angle between two nonzero vectors is plus or minus the unoriented angle. -/
+lemma oangle_eq_angle_or_eq_neg_angle {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  o.oangle x y = inner_product_geometry.angle x y ∨
+    o.oangle x y = -inner_product_geometry.angle x y :=
+real.angle.cos_eq_real_cos_iff_eq_or_eq_neg.1 $ o.cos_oangle_eq_cos_angle hx hy
+
+/-- The unoriented angle between two nonzero vectors is the absolute value of the oriented angle,
+converted to a real. -/
+lemma angle_eq_abs_oangle_to_real {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  inner_product_geometry.angle x y = |(o.oangle x y).to_real| :=
+begin
+  have h0 := inner_product_geometry.angle_nonneg x y,
+  have hpi := inner_product_geometry.angle_le_pi x y,
+  rcases o.oangle_eq_angle_or_eq_neg_angle hx hy with (h|h),
+  { rw [h, eq_comm, real.angle.abs_to_real_coe_eq_self_iff],
+    exact ⟨h0, hpi⟩ },
+  { rw [h, eq_comm, real.angle.abs_to_real_neg_coe_eq_self_iff],
+    exact ⟨h0, hpi⟩ }
+end
+
+/-- If the sign of the oriented angle between two vectors is zero, either one of the vectors is
+zero or the unoriented angle is 0 or π. -/
+lemma eq_zero_or_angle_eq_zero_or_pi_of_sign_oangle_eq_zero {x y : V}
+  (h : (o.oangle x y).sign = 0) :
+  x = 0 ∨ y = 0 ∨ inner_product_geometry.angle x y = 0 ∨ inner_product_geometry.angle x y = π :=
+begin
+  by_cases hx : x = 0, { simp [hx] },
+  by_cases hy : y = 0, { simp [hy] },
+  rw o.angle_eq_abs_oangle_to_real hx hy,
+  rw real.angle.sign_eq_zero_iff at h,
+  rcases h with h|h;
+    simp [h, real.pi_pos.le]
+end
+
+/-- If two unoriented angles are equal, and the signs of the corresponding oriented angles are
+equal, then the oriented angles are equal (even in degenerate cases). -/
+lemma oangle_eq_of_angle_eq_of_sign_eq {w x y z : V}
+  (h : inner_product_geometry.angle w x = inner_product_geometry.angle y z)
+  (hs : (o.oangle w x).sign = (o.oangle y z).sign) : o.oangle w x = o.oangle y z :=
+begin
+  by_cases h0 : (w = 0 ∨ x = 0) ∨ (y = 0 ∨ z = 0),
+  { have hs' : (o.oangle w x).sign = 0 ∧ (o.oangle y z).sign = 0,
+    { rcases h0 with (rfl|rfl)|rfl|rfl,
+      { simpa using hs.symm },
+      { simpa using hs.symm },
+      { simpa using hs },
+      { simpa using hs } },
+    rcases hs' with ⟨hswx, hsyz⟩,
+    have h' : inner_product_geometry.angle w x = π / 2 ∧ inner_product_geometry.angle y z = π / 2,
+    { rcases h0 with (rfl|rfl)|rfl|rfl,
+      { simpa using h.symm },
+      { simpa using h.symm },
+      { simpa using h },
+      { simpa using h } },
+    rcases h' with ⟨hwx, hyz⟩,
+    have hpi : π / 2 ≠ π,
+    { intro hpi,
+      rw [div_eq_iff, eq_comm, ←sub_eq_zero, mul_two, add_sub_cancel] at hpi,
+      { exact real.pi_pos.ne.symm hpi },
+      { exact two_ne_zero } },
+    have h0wx : (w = 0 ∨ x = 0),
+    { have h0' := o.eq_zero_or_angle_eq_zero_or_pi_of_sign_oangle_eq_zero hswx,
+      simpa [hwx, real.pi_pos.ne.symm, hpi] using h0' },
+    have h0yz : (y = 0 ∨ z = 0),
+    { have h0' := o.eq_zero_or_angle_eq_zero_or_pi_of_sign_oangle_eq_zero hsyz,
+      simpa [hyz, real.pi_pos.ne.symm, hpi] using h0' },
+    rcases h0wx with h0wx|h0wx; rcases h0yz with h0yz|h0yz;
+      simp [h0wx, h0yz] },
+  { push_neg at h0,
+    rw real.angle.eq_iff_abs_to_real_eq_of_sign_eq hs,
+    rwa [o.angle_eq_abs_oangle_to_real h0.1.1 h0.1.2,
+         o.angle_eq_abs_oangle_to_real h0.2.1 h0.2.2] at h }
+end
+
+/-- If the signs of two oriented angles between nonzero vectors are equal, the oriented angles are
+equal if and only if the unoriented angles are equal. -/
+lemma angle_eq_iff_oangle_eq_of_sign_eq {w x y z : V} (hw : w ≠ 0) (hx : x ≠ 0) (hy : y ≠ 0)
+  (hz : z ≠ 0) (hs : (o.oangle w x).sign = (o.oangle y z).sign) :
+  inner_product_geometry.angle w x = inner_product_geometry.angle y z ↔
+    o.oangle w x = o.oangle y z :=
+begin
+  refine ⟨λ h, o.oangle_eq_of_angle_eq_of_sign_eq h hs, λ h, _⟩,
+  rw [o.angle_eq_abs_oangle_to_real hw hx, o.angle_eq_abs_oangle_to_real hy hz, h]
+end
+
+/-- The oriented angle between two vectors equals the unoriented angle if the sign is positive. -/
+lemma oangle_eq_angle_of_sign_eq_one {x y : V} (h : (o.oangle x y).sign = 1) :
+  o.oangle x y = inner_product_geometry.angle x y :=
+begin
+  by_cases hx : x = 0, { exfalso, simpa [hx] using h },
+  by_cases hy : y = 0, { exfalso, simpa [hy] using h },
+  refine (o.oangle_eq_angle_or_eq_neg_angle hx hy).resolve_right _,
+  intro hxy,
+  rw [hxy, real.angle.sign_neg, neg_eq_iff_eq_neg, ←sign_type.neg_iff, ←not_le] at h,
+  exact h (real.angle.sign_coe_nonneg_of_nonneg_of_le_pi (inner_product_geometry.angle_nonneg _ _)
+                                                         (inner_product_geometry.angle_le_pi _ _))
+end
+
+/-- The oriented angle between two vectors equals minus the unoriented angle if the sign is
+negative. -/
+lemma oangle_eq_neg_angle_of_sign_eq_neg_one {x y : V} (h : (o.oangle x y).sign = -1) :
+  o.oangle x y = -inner_product_geometry.angle x y :=
+begin
+  by_cases hx : x = 0, { exfalso, simpa [hx] using h },
+  by_cases hy : y = 0, { exfalso, simpa [hy] using h },
+  refine (o.oangle_eq_angle_or_eq_neg_angle hx hy).resolve_left _,
+  intro hxy,
+  rw [hxy, ←sign_type.neg_iff, ←not_le] at h,
+  exact h (real.angle.sign_coe_nonneg_of_nonneg_of_le_pi (inner_product_geometry.angle_nonneg _ _)
+                                                         (inner_product_geometry.angle_le_pi _ _))
+end
+
+/-- The oriented angle between two nonzero vectors is zero if and only if the unoriented angle
+is zero. -/
+lemma oangle_eq_zero_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  o.oangle x y = 0 ↔ inner_product_geometry.angle x y = 0 :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { simpa [o.angle_eq_abs_oangle_to_real hx hy] },
+  { have ha := o.oangle_eq_angle_or_eq_neg_angle hx hy,
+    rw h at ha,
+    simpa using ha }
+end
+
+/-- The oriented angle between two vectors is `π` if and only if the unoriented angle is `π`. -/
+lemma oangle_eq_pi_iff_angle_eq_pi {x y : V} :
+  o.oangle x y = π ↔ inner_product_geometry.angle x y = π :=
+begin
+  by_cases hx : x = 0, { simp [hx, real.angle.pi_ne_zero.symm, div_eq_mul_inv, mul_right_eq_self₀,
+                               not_or_distrib, real.pi_ne_zero], norm_num },
+  by_cases hy : y = 0, { simp [hy, real.angle.pi_ne_zero.symm, div_eq_mul_inv, mul_right_eq_self₀,
+                               not_or_distrib, real.pi_ne_zero], norm_num },
+  refine ⟨λ h, _, λ h, _⟩,
+  { rw [o.angle_eq_abs_oangle_to_real hx hy, h],
+    simp [real.pi_pos.le] },
+  { have ha := o.oangle_eq_angle_or_eq_neg_angle hx hy,
+    rw h at ha,
+    simpa using ha }
+end
+
+/-- One of two vectors is zero or the oriented angle between them is plus or minus `π / 2` if
+and only if the inner product of those vectors is zero. -/
+lemma eq_zero_or_oangle_eq_iff_inner_eq_zero {x y : V} :
+  (x = 0 ∨ y = 0 ∨ o.oangle x y = (π / 2 : ℝ) ∨ o.oangle x y = (-π / 2 : ℝ)) ↔ ⟪x, y⟫ = 0 :=
+begin
+  by_cases hx : x = 0, { simp [hx] },
+  by_cases hy : y = 0, { simp [hy] },
+  rw [inner_product_geometry.inner_eq_zero_iff_angle_eq_pi_div_two, or_iff_right hx,
+      or_iff_right hy],
+  refine ⟨λ h, _, λ h, _⟩,
+  { rwa [o.angle_eq_abs_oangle_to_real hx hy, real.angle.abs_to_real_eq_pi_div_two_iff] },
+  { convert o.oangle_eq_angle_or_eq_neg_angle hx hy; rw [h],
+    exact neg_div _ _ }
+end
+
+/-- If the oriented angle between two vectors is `π / 2`, the inner product of those vectors
+is zero. -/
+lemma inner_eq_zero_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = (π / 2 : ℝ)) :
+  ⟪x, y⟫ = 0 :=
+o.eq_zero_or_oangle_eq_iff_inner_eq_zero.1 $ or.inr $ or.inr $ or.inl h
+
+/-- If the oriented angle between two vectors is `π / 2`, the inner product of those vectors
+(reversed) is zero. -/
+lemma inner_rev_eq_zero_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = (π / 2 : ℝ)) :
+  ⟪y, x⟫ = 0 :=
+by rw [real_inner_comm, o.inner_eq_zero_of_oangle_eq_pi_div_two h]
+
+/-- If the oriented angle between two vectors is `-π / 2`, the inner product of those vectors
+is zero. -/
+lemma inner_eq_zero_of_oangle_eq_neg_pi_div_two {x y : V} (h : o.oangle x y = (-π / 2 : ℝ)) :
+  ⟪x, y⟫ = 0 :=
+o.eq_zero_or_oangle_eq_iff_inner_eq_zero.1 $ or.inr $ or.inr $ or.inr h
+
+/-- If the oriented angle between two vectors is `-π / 2`, the inner product of those vectors
+(reversed) is zero. -/
+lemma inner_rev_eq_zero_of_oangle_eq_neg_pi_div_two {x y : V} (h : o.oangle x y = (-π / 2 : ℝ)) :
+  ⟪y, x⟫ = 0 :=
+by rw [real_inner_comm, o.inner_eq_zero_of_oangle_eq_neg_pi_div_two h]
+
+/-- Negating the first vector passed to `oangle` negates the sign of the angle. -/
+@[simp] lemma oangle_sign_neg_left (x y : V) :
+  (o.oangle (-x) y).sign = -((o.oangle x y).sign) :=
+begin
+  by_cases hx : x = 0, { simp [hx] },
+  by_cases hy : y = 0, { simp [hy] },
+  rw [o.oangle_neg_left hx hy, real.angle.sign_add_pi]
+end
+
+/-- Negating the second vector passed to `oangle` negates the sign of the angle. -/
+@[simp] lemma oangle_sign_neg_right (x y : V) :
+  (o.oangle x (-y)).sign = -((o.oangle x y).sign) :=
+begin
+  by_cases hx : x = 0, { simp [hx] },
+  by_cases hy : y = 0, { simp [hy] },
+  rw [o.oangle_neg_right hx hy, real.angle.sign_add_pi]
+end
+
+/-- Multiplying the first vector passed to `oangle` by a real multiplies the sign of the angle by
+the sign of the real. -/
+@[simp] lemma oangle_sign_smul_left (x y : V) (r : ℝ) :
+  (o.oangle (r • x) y).sign = sign r * (o.oangle x y).sign :=
+begin
+  rcases lt_trichotomy r 0 with h|h|h;
+    simp [h]
+end
+
+/-- Multiplying the second vector passed to `oangle` by a real multiplies the sign of the angle by
+the sign of the real. -/
+@[simp] lemma oangle_sign_smul_right (x y : V) (r : ℝ) :
+  (o.oangle x (r • y)).sign = sign r * (o.oangle x y).sign :=
+begin
+  rcases lt_trichotomy r 0 with h|h|h;
+    simp [h]
+end
+
+/-- Auxiliary lemma for the proof of `oangle_sign_smul_add_right`; not intended to be used
+outside of that proof. -/
+lemma oangle_smul_add_right_eq_zero_or_eq_pi_iff {x y : V} (r : ℝ) :
+  (o.oangle x (r • x + y) = 0 ∨ o.oangle x (r • x + y) = π) ↔
+    (o.oangle x y = 0 ∨ o.oangle x y = π) :=
+begin
+  simp_rw [oangle_eq_zero_or_eq_pi_iff_not_linear_independent,
+           fintype.not_linear_independent_iff, fin.sum_univ_two, fin.exists_fin_two],
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with ⟨m, h, hm⟩,
+    change m 0 • x + m 1 • (r • x + y) = 0 at h,
+    refine ⟨![m 0 + m 1 * r, m 1], _⟩,
+    change (m 0 + m 1 * r) • x + m 1 • y = 0 ∧ (m 0 + m 1 * r ≠ 0 ∨ m 1 ≠ 0),
+    rw [smul_add, smul_smul, ←add_assoc, ←add_smul] at h,
+    refine ⟨h, not_and_distrib.1 (λ h0, _)⟩,
+    obtain ⟨h0, h1⟩ := h0,
+    rw h1 at h0 hm,
+    rw [zero_mul, add_zero] at h0,
+    simpa [h0] using hm },
+  { rcases h with ⟨m, h, hm⟩,
+    change m 0 • x + m 1 • y = 0 at h,
+    refine ⟨![m 0 - m 1 * r, m 1], _⟩,
+    change (m 0 - m 1 * r) • x + m 1 • (r • x + y) = 0 ∧ (m 0 - m 1 * r ≠ 0 ∨ m 1 ≠ 0),
+    rw [sub_smul, smul_add, smul_smul, ←add_assoc, sub_add_cancel],
+    refine ⟨h, not_and_distrib.1 (λ h0, _)⟩,
+    obtain ⟨h0, h1⟩ := h0,
+    rw h1 at h0 hm,
+    rw [zero_mul, sub_zero] at h0,
+    simpa [h0] using hm }
+end
+
+/-- Adding a multiple of the first vector passed to `oangle` to the second vector does not change
+the sign of the angle. -/
+@[simp] lemma oangle_sign_smul_add_right (x y : V) (r : ℝ) :
+  (o.oangle x (r • x + y)).sign = (o.oangle x y).sign :=
+begin
+  by_cases h : o.oangle x y = 0 ∨ o.oangle x y = π,
+  { rwa [real.angle.sign_eq_zero_iff.2 h, real.angle.sign_eq_zero_iff,
+         oangle_smul_add_right_eq_zero_or_eq_pi_iff] },
+  have h' : ∀ r' : ℝ, o.oangle x (r' • x + y) ≠ 0 ∧ o.oangle x (r' • x + y) ≠ π,
+  { intro r',
+    rwa [←o.oangle_smul_add_right_eq_zero_or_eq_pi_iff r', not_or_distrib] at h },
+  let s : set (V × V) := (λ r' : ℝ, (x, r' • x + y)) '' set.univ,
+  have hc : is_connected s := is_connected_univ.image _ ((continuous_const.prod_mk
+    ((continuous_id.smul continuous_const).add continuous_const)).continuous_on),
+  have hf : continuous_on (λ z : V × V, o.oangle z.1 z.2) s,
+  { refine continuous_at.continuous_on (λ z hz, o.continuous_at_oangle _ _),
+    all_goals { simp_rw [s, set.mem_image] at hz,
+                obtain ⟨r', -, rfl⟩ := hz,
+                simp only [prod.fst, prod.snd],
+                intro hz },
+    { simpa [hz] using (h' 0).1 },
+    { simpa [hz] using (h' r').1 } },
+  have hs : ∀ z : V × V, z ∈ s → o.oangle z.1 z.2 ≠ 0 ∧ o.oangle z.1 z.2 ≠ π,
+  { intros z hz,
+    simp_rw [s, set.mem_image] at hz,
+    obtain ⟨r', -, rfl⟩ := hz,
+    exact h' r' },
+  have hx : (x, y) ∈ s,
+  { convert set.mem_image_of_mem (λ r' : ℝ, (x, r' • x + y)) (set.mem_univ 0),
+    simp },
+  have hy : (x, r • x + y) ∈ s := set.mem_image_of_mem _ (set.mem_univ _),
+  convert real.angle.sign_eq_of_continuous_on hc hf hs hx hy
+end
+
+/-- Adding a multiple of the second vector passed to `oangle` to the first vector does not change
+the sign of the angle. -/
+@[simp] lemma oangle_sign_add_smul_left (x y : V) (r : ℝ) :
+  (o.oangle (x + r • y) y).sign = (o.oangle x y).sign :=
+by simp_rw [o.oangle_rev y, real.angle.sign_neg, add_comm x, oangle_sign_smul_add_right]
+
+/-- Subtracting a multiple of the first vector passed to `oangle` from the second vector does
+not change the sign of the angle. -/
+@[simp] lemma oangle_sign_sub_smul_right (x y : V) (r : ℝ) :
+  (o.oangle x (y - r • x)).sign = (o.oangle x y).sign :=
+by rw [sub_eq_add_neg, ←neg_smul, add_comm, oangle_sign_smul_add_right]
+
+/-- Subtracting a multiple of the second vector passed to `oangle` from the first vector does
+not change the sign of the angle. -/
+@[simp] lemma oangle_sign_sub_smul_left (x y : V) (r : ℝ) :
+  (o.oangle (x - r • y) y).sign = (o.oangle x y).sign :=
+by rw [sub_eq_add_neg, ←neg_smul, oangle_sign_add_smul_left]
+
+/-- Adding the first vector passed to `oangle` to the second vector does not change the sign of
+the angle. -/
+@[simp] lemma oangle_sign_add_right (x y : V) : (o.oangle x (x + y)).sign = (o.oangle x y).sign :=
+by rw [←o.oangle_sign_smul_add_right x y 1, one_smul]
+
+/-- Adding the second vector passed to `oangle` to the first vector does not change the sign of
+the angle. -/
+@[simp] lemma oangle_sign_add_left (x y : V) : (o.oangle (x + y) y).sign = (o.oangle x y).sign :=
+by rw [←o.oangle_sign_add_smul_left x y 1, one_smul]
+
+/-- Subtracting the first vector passed to `oangle` from the second vector does not change the
+sign of the angle. -/
+@[simp] lemma oangle_sign_sub_right (x y : V) :
+  (o.oangle x (y - x)).sign = (o.oangle x y).sign :=
+by rw [←o.oangle_sign_sub_smul_right x y 1, one_smul]
+
+/-- Subtracting the second vector passed to `oangle` from the first vector does not change the
+sign of the angle. -/
+@[simp] lemma oangle_sign_sub_left (x y : V) :
+  (o.oangle (x - y) y).sign = (o.oangle x y).sign :=
+by rw [←o.oangle_sign_sub_smul_left x y 1, one_smul]
+
+/-- Subtracting the second vector passed to `oangle` from a multiple of the first vector negates
+the sign of the angle. -/
+@[simp] lemma oangle_sign_smul_sub_right (x y : V) (r : ℝ) :
+  (o.oangle x (r • x - y)).sign = -(o.oangle x y).sign :=
+by rw [←oangle_sign_neg_right, sub_eq_add_neg, oangle_sign_smul_add_right]
+
+/-- Subtracting the first vector passed to `oangle` from a multiple of the second vector negates
+the sign of the angle. -/
+@[simp] lemma oangle_sign_smul_sub_left (x y : V) (r : ℝ) :
+  (o.oangle (r • y - x) y).sign = -(o.oangle x y).sign :=
+by rw [←oangle_sign_neg_left, sub_eq_neg_add, oangle_sign_add_smul_left]
+
+/-- Subtracting the second vector passed to `oangle` from the first vector negates the sign of
+the angle. -/
+lemma oangle_sign_sub_right_eq_neg (x y : V) :
+  (o.oangle x (x - y)).sign = -(o.oangle x y).sign :=
+by rw [←o.oangle_sign_smul_sub_right x y 1, one_smul]
+
+/-- Subtracting the first vector passed to `oangle` from the second vector negates the sign of
+the angle. -/
+lemma oangle_sign_sub_left_eq_neg (x y : V) :
+  (o.oangle (y - x) y).sign = -(o.oangle x y).sign :=
+by rw [←o.oangle_sign_smul_sub_left x y 1, one_smul]
+
+/-- Subtracting the first vector passed to `oangle` from the second vector then swapping the
+vectors does not change the sign of the angle. -/
+@[simp] lemma oangle_sign_sub_right_swap (x y : V) :
+  (o.oangle y (y - x)).sign = (o.oangle x y).sign :=
+by rw [oangle_sign_sub_right_eq_neg, o.oangle_rev y x, real.angle.sign_neg]
+
+/-- Subtracting the second vector passed to `oangle` from the first vector then swapping the
+vectors does not change the sign of the angle. -/
+@[simp] lemma oangle_sign_sub_left_swap (x y : V) :
+  (o.oangle (x - y) x).sign = (o.oangle x y).sign :=
+by rw [oangle_sign_sub_left_eq_neg, o.oangle_rev y x, real.angle.sign_neg]
+
+/-- The sign of the angle between a vector, and a linear combination of that vector with a second
+vector, is the sign of the factor by which the second vector is multiplied in that combination
+multiplied by the sign of the angle between the two vectors. -/
+@[simp] lemma oangle_sign_smul_add_smul_right (x y : V) (r₁ r₂ : ℝ) :
+  (o.oangle x (r₁ • x + r₂ • y)).sign = sign r₂ * (o.oangle x y).sign :=
+begin
+  rw ←o.oangle_sign_smul_add_right x (r₁ • x + r₂ • y) (-r₁),
+  simp
+end
+
+/-- The sign of the angle between a linear combination of two vectors and the second vector is
+the sign of the factor by which the first vector is multiplied in that combination multiplied by
+the sign of the angle between the two vectors. -/
+@[simp] lemma oangle_sign_smul_add_smul_left (x y : V) (r₁ r₂ : ℝ) :
+  (o.oangle (r₁ • x + r₂ • y) y).sign = sign r₁ * (o.oangle x y).sign :=
+by simp_rw [o.oangle_rev y, real.angle.sign_neg, add_comm (r₁ • x),
+            oangle_sign_smul_add_smul_right, mul_neg]
+
+/-- The sign of the angle between two linear combinations of two vectors is the sign of the
+determinant of the factors in those combinations multiplied by the sign of the angle between the
+two vectors. -/
+lemma oangle_sign_smul_add_smul_smul_add_smul (x y : V) (r₁ r₂ r₃ r₄ : ℝ) :
+  (o.oangle (r₁ • x + r₂ • y) (r₃ • x + r₄ • y)).sign =
+    sign (r₁ * r₄ - r₂ * r₃) * (o.oangle x y).sign :=
+begin
+  by_cases hr₁ : r₁ = 0,
+  { rw [hr₁, zero_smul, zero_mul, zero_add, zero_sub, left.sign_neg, oangle_sign_smul_left,
+        add_comm, oangle_sign_smul_add_smul_right, oangle_rev, real.angle.sign_neg, sign_mul,
+        mul_neg, mul_neg, neg_mul, mul_assoc] },
+  { rw [←o.oangle_sign_smul_add_right (r₁ • x + r₂ • y) (r₃ • x + r₄ • y) (-r₃ / r₁),
+        smul_add, smul_smul, smul_smul, div_mul_cancel _ hr₁, neg_smul, ←add_assoc,
+        add_comm (-(r₃ • x)), ←sub_eq_add_neg, sub_add_cancel, ←add_smul,
+        oangle_sign_smul_right, oangle_sign_smul_add_smul_left, ←mul_assoc, ←sign_mul,
+        add_mul, mul_assoc, mul_comm r₂ r₁, ←mul_assoc, div_mul_cancel _ hr₁, add_comm,
+        neg_mul, ←sub_eq_add_neg, mul_comm r₄, mul_comm r₃] }
+end
+
+/-- A base angle of an isosceles triangle is acute, oriented vector angle form. -/
+lemma abs_oangle_sub_left_to_real_lt_pi_div_two {x y : V} (h : ‖x‖ = ‖y‖) :
+  |(o.oangle (y - x) y).to_real| < π / 2 :=
+begin
+  by_cases hn : x = y, { simp [hn, div_pos, real.pi_pos] },
+  have hs : ((2 : ℤ) • (o.oangle (y - x) y)).sign = (o.oangle (y - x) y).sign,
+  { conv_rhs { rw oangle_sign_sub_left_swap },
+    rw [o.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hn h, real.angle.sign_pi_sub] },
+  rw real.angle.sign_two_zsmul_eq_sign_iff at hs,
+  rcases hs with hs | hs,
+  { rw [oangle_eq_pi_iff_oangle_rev_eq_pi, oangle_eq_pi_iff_same_ray_neg, neg_sub] at hs,
+    rcases hs with ⟨hy, -, hr⟩,
+    rw ←exists_nonneg_left_iff_same_ray hy at hr,
+    rcases hr with ⟨r, hr0, hr⟩,
+    rw [eq_sub_iff_add_eq] at hr,
+    nth_rewrite 1 ←one_smul ℝ y at hr,
+    rw ←add_smul at hr,
+    rw [←hr, norm_smul, real.norm_eq_abs, abs_of_pos (left.add_pos_of_nonneg_of_pos hr0 one_pos),
+        mul_left_eq_self₀, or_iff_left (norm_ne_zero_iff.2 hy), add_left_eq_self] at h,
+    rw [h, zero_add, one_smul] at hr,
+    exact false.elim (hn hr.symm) },
+  { exact hs }
+end
+
+/-- A base angle of an isosceles triangle is acute, oriented vector angle form. -/
+lemma abs_oangle_sub_right_to_real_lt_pi_div_two {x y : V} (h : ‖x‖ = ‖y‖) :
+  |(o.oangle x (x - y)).to_real| < π / 2 :=
+(o.oangle_sub_eq_oangle_sub_rev_of_norm_eq h).symm ▸ o.abs_oangle_sub_left_to_real_lt_pi_div_two h
+
+end orientation
diff --git a/src/geometry/euclidean/angle/oriented/right_angle.lean b/src/geometry/euclidean/angle/oriented/right_angle.lean
new file mode 100644
index 0000000000000..b38ec3b422bf2
--- /dev/null
+++ b/src/geometry/euclidean/angle/oriented/right_angle.lean
@@ -0,0 +1,882 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import geometry.euclidean.angle.oriented.affine
+import geometry.euclidean.angle.unoriented.right_angle
+
+/-!
+# Oriented angles in right-angled triangles.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves basic geometrical results about distances and oriented angles in (possibly
+degenerate) right-angled triangles in real inner product spaces and Euclidean affine spaces.
+
+-/
+
+noncomputable theory
+
+open_locale euclidean_geometry
+open_locale real
+open_locale real_inner_product_space
+
+namespace orientation
+
+open finite_dimensional
+
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
+variables [hd2 : fact (finrank ℝ V = 2)] (o : orientation ℝ V (fin 2))
+include hd2 o
+
+/-- An angle in a right-angled triangle expressed using `arccos`. -/
+lemma oangle_add_right_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle x (x + y) = real.arccos (‖x‖ / ‖x + y‖) :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs,
+      inner_product_geometry.angle_add_eq_arccos_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- An angle in a right-angled triangle expressed using `arccos`. -/
+lemma oangle_add_left_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle (x + y) y = real.arccos (‖y‖ / ‖x + y‖) :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).oangle_add_right_eq_arccos_of_oangle_eq_pi_div_two h
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`. -/
+lemma oangle_add_right_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle x (x + y) = real.arcsin (‖y‖ / ‖x + y‖) :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs,
+      inner_product_geometry.angle_add_eq_arcsin_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`. -/
+lemma oangle_add_left_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle (x + y) y = real.arcsin (‖x‖ / ‖x + y‖) :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).oangle_add_right_eq_arcsin_of_oangle_eq_pi_div_two h
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`. -/
+lemma oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle x (x + y) = real.arctan (‖y‖ / ‖x‖) :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs,
+      inner_product_geometry.angle_add_eq_arctan_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h) (o.left_ne_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`. -/
+lemma oangle_add_left_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle (x + y) y = real.arctan (‖x‖ / ‖y‖) :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two h
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma cos_oangle_add_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.cos (o.oangle x (x + y)) = ‖x‖ / ‖x + y‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      inner_product_geometry.cos_angle_add_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma cos_oangle_add_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.cos (o.oangle (x + y) y) = ‖y‖ / ‖x + y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).cos_oangle_add_right_of_oangle_eq_pi_div_two h
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma sin_oangle_add_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.sin (o.oangle x (x + y)) = ‖y‖ / ‖x + y‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      inner_product_geometry.sin_angle_add_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma sin_oangle_add_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.sin (o.oangle (x + y) y) = ‖x‖ / ‖x + y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).sin_oangle_add_right_of_oangle_eq_pi_div_two h
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
+lemma tan_oangle_add_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.tan (o.oangle x (x + y)) = ‖y‖ / ‖x‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      inner_product_geometry.tan_angle_add_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
+lemma tan_oangle_add_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.tan (o.oangle (x + y) y) = ‖x‖ / ‖y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).tan_oangle_add_right_of_oangle_eq_pi_div_two h
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side. -/
+lemma cos_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle x (x + y)) * ‖x + y‖ = ‖x‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      inner_product_geometry.cos_angle_add_mul_norm_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side. -/
+lemma cos_oangle_add_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle (x + y) y) * ‖x + y‖ = ‖y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).cos_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two h
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side. -/
+lemma sin_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle x (x + y)) * ‖x + y‖ = ‖y‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      inner_product_geometry.sin_angle_add_mul_norm_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side. -/
+lemma sin_oangle_add_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle (x + y) y) * ‖x + y‖ = ‖x‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).sin_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two h
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side. -/
+lemma tan_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle x (x + y)) * ‖x‖ = ‖y‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      inner_product_geometry.tan_angle_add_mul_norm_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side. -/
+lemma tan_oangle_add_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle (x + y) y) * ‖y‖ = ‖x‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).tan_oangle_add_right_mul_norm_of_oangle_eq_pi_div_two h
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse. -/
+lemma norm_div_cos_oangle_add_right_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.cos (o.oangle x (x + y)) = ‖x + y‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      inner_product_geometry.norm_div_cos_angle_add_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse. -/
+lemma norm_div_cos_oangle_add_left_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.cos (o.oangle (x + y) y) = ‖x + y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).norm_div_cos_oangle_add_right_of_oangle_eq_pi_div_two h
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse. -/
+lemma norm_div_sin_oangle_add_right_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.sin (o.oangle x (x + y)) = ‖x + y‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      inner_product_geometry.norm_div_sin_angle_add_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inr (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse. -/
+lemma norm_div_sin_oangle_add_left_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.sin (o.oangle (x + y) y) = ‖x + y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).norm_div_sin_oangle_add_right_of_oangle_eq_pi_div_two h
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side. -/
+lemma norm_div_tan_oangle_add_right_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.tan (o.oangle x (x + y)) = ‖x‖ :=
+begin
+  have hs : (o.oangle x (x + y)).sign = 1,
+  { rw [oangle_sign_add_right, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      inner_product_geometry.norm_div_tan_angle_add_of_inner_eq_zero
+        (o.inner_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inr (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side. -/
+lemma norm_div_tan_oangle_add_left_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.tan (o.oangle (x + y) y) = ‖y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  rw add_comm,
+  exact (-o).norm_div_tan_oangle_add_right_of_oangle_eq_pi_div_two h
+end
+
+/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
+lemma oangle_sub_right_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle y (y - x) = real.arccos (‖y‖ / ‖y - x‖) :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs,
+      inner_product_geometry.angle_sub_eq_arccos_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
+lemma oangle_sub_left_eq_arccos_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle (x - y) x = real.arccos (‖x‖ / ‖x - y‖) :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).oangle_sub_right_eq_arccos_of_oangle_eq_pi_div_two h
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
+lemma oangle_sub_right_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle y (y - x) = real.arcsin (‖x‖ / ‖y - x‖) :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs,
+      inner_product_geometry.angle_sub_eq_arcsin_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
+lemma oangle_sub_left_eq_arcsin_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle (x - y) x = real.arcsin (‖y‖ / ‖x - y‖) :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).oangle_sub_right_eq_arcsin_of_oangle_eq_pi_div_two h
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
+lemma oangle_sub_right_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle y (y - x) = real.arctan (‖x‖ / ‖y‖) :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs,
+      inner_product_geometry.angle_sub_eq_arctan_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (o.right_ne_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
+lemma oangle_sub_left_eq_arctan_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  o.oangle (x - y) x = real.arctan (‖y‖ / ‖x‖) :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).oangle_sub_right_eq_arctan_of_oangle_eq_pi_div_two h
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma cos_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.cos (o.oangle y (y - x)) = ‖y‖ / ‖y - x‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      inner_product_geometry.cos_angle_sub_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma cos_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.cos (o.oangle (x - y) x) = ‖x‖ / ‖x - y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).cos_oangle_sub_right_of_oangle_eq_pi_div_two h
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma sin_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.sin (o.oangle y (y - x)) = ‖x‖ / ‖y - x‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      inner_product_geometry.sin_angle_sub_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma sin_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.sin (o.oangle (x - y) x) = ‖y‖ / ‖x - y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).sin_oangle_sub_right_of_oangle_eq_pi_div_two h
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma tan_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.tan (o.oangle y (y - x)) = ‖x‖ / ‖y‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      inner_product_geometry.tan_angle_sub_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma tan_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V} (h : o.oangle x y = ↑(π / 2)) :
+  real.angle.tan (o.oangle (x - y) x) = ‖y‖ / ‖x‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).tan_oangle_sub_right_of_oangle_eq_pi_div_two h
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side, version subtracting vectors. -/
+lemma cos_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle y (y - x)) * ‖y - x‖ = ‖y‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      inner_product_geometry.cos_angle_sub_mul_norm_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side, version subtracting vectors. -/
+lemma cos_oangle_sub_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.cos (o.oangle (x - y) x) * ‖x - y‖ = ‖x‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).cos_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two h
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side, version subtracting vectors. -/
+lemma sin_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle y (y - x)) * ‖y - x‖ = ‖x‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      inner_product_geometry.sin_angle_sub_mul_norm_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side, version subtracting vectors. -/
+lemma sin_oangle_sub_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.sin (o.oangle (x - y) x) * ‖x - y‖ = ‖y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).sin_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two h
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side, version subtracting vectors. -/
+lemma tan_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle y (y - x)) * ‖y‖ = ‖x‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      inner_product_geometry.tan_angle_sub_mul_norm_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side, version subtracting vectors. -/
+lemma tan_oangle_sub_left_mul_norm_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : real.angle.tan (o.oangle (x - y) x) * ‖x‖ = ‖y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).tan_oangle_sub_right_mul_norm_of_oangle_eq_pi_div_two h
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse, version subtracting vectors. -/
+lemma norm_div_cos_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.cos (o.oangle y (y - x)) = ‖y - x‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      inner_product_geometry.norm_div_cos_angle_sub_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inl (o.right_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse, version subtracting vectors. -/
+lemma norm_div_cos_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.cos (o.oangle (x - y) x) = ‖x - y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).norm_div_cos_oangle_sub_right_of_oangle_eq_pi_div_two h
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse, version subtracting vectors. -/
+lemma norm_div_sin_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.sin (o.oangle y (y - x)) = ‖y - x‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      inner_product_geometry.norm_div_sin_angle_sub_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inr (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse, version subtracting vectors. -/
+lemma norm_div_sin_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.sin (o.oangle (x - y) x) = ‖x - y‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).norm_div_sin_oangle_sub_right_of_oangle_eq_pi_div_two h
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side, version subtracting vectors. -/
+lemma norm_div_tan_oangle_sub_right_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖x‖ / real.angle.tan (o.oangle y (y - x)) = ‖y‖ :=
+begin
+  have hs : (o.oangle y (y - x)).sign = 1,
+  { rw [oangle_sign_sub_right_swap, h, real.angle.sign_coe_pi_div_two] },
+  rw [o.oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      inner_product_geometry.norm_div_tan_angle_sub_of_inner_eq_zero
+        (o.inner_rev_eq_zero_of_oangle_eq_pi_div_two h)
+        (or.inr (o.left_ne_zero_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side, version subtracting vectors. -/
+lemma norm_div_tan_oangle_sub_left_of_oangle_eq_pi_div_two {x y : V}
+  (h : o.oangle x y = ↑(π / 2)) : ‖y‖ / real.angle.tan (o.oangle (x - y) x) = ‖x‖ :=
+begin
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj] at h ⊢,
+  exact (-o).norm_div_tan_oangle_sub_right_of_oangle_eq_pi_div_two h
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
+of a rotation of another by `π / 2`. -/
+lemma oangle_add_right_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
+  o.oangle x (x + r • o.rotation (π / 2 : ℝ) x) = real.arctan r :=
+begin
+  rcases lt_trichotomy r 0 with hr | rfl | hr,
+  { have ha : o.oangle x (r • o.rotation (π / 2 : ℝ) x) = -(π / 2 : ℝ),
+    { rw [o.oangle_smul_right_of_neg _ _ hr, o.oangle_neg_right h,
+          o.oangle_rotation_self_right h, ←sub_eq_zero, add_comm, sub_neg_eq_add,
+          ←real.angle.coe_add, ←real.angle.coe_add, add_assoc, add_halves, ←two_mul,
+          real.angle.coe_two_pi],
+      simpa using h },
+    rw [←neg_inj, ←oangle_neg_orientation_eq_neg, neg_neg] at ha,
+    rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj, oangle_rev,
+        (-o).oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two ha, norm_smul,
+        linear_isometry_equiv.norm_map, mul_div_assoc, div_self (norm_ne_zero_iff.2 h), mul_one,
+        real.norm_eq_abs, abs_of_neg hr, real.arctan_neg, real.angle.coe_neg, neg_neg] },
+  { rw [zero_smul, add_zero, oangle_self, real.arctan_zero, real.angle.coe_zero] },
+  { have ha : o.oangle x (r • o.rotation (π / 2 : ℝ) x) = (π / 2 : ℝ),
+    { rw [o.oangle_smul_right_of_pos _ _ hr, o.oangle_rotation_self_right h] },
+    rw [o.oangle_add_right_eq_arctan_of_oangle_eq_pi_div_two ha, norm_smul,
+        linear_isometry_equiv.norm_map, mul_div_assoc, div_self (norm_ne_zero_iff.2 h), mul_one,
+        real.norm_eq_abs, abs_of_pos hr] }
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
+of a rotation of another by `π / 2`. -/
+lemma oangle_add_left_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
+  o.oangle (x + r • o.rotation (π / 2 : ℝ) x) (r • o.rotation (π / 2 : ℝ) x) = real.arctan r⁻¹ :=
+begin
+  by_cases hr : r = 0, { simp [hr] },
+  rw [←neg_inj, oangle_rev, ←oangle_neg_orientation_eq_neg, neg_inj,
+      ←neg_neg ((π / 2 : ℝ) : real.angle), ←rotation_neg_orientation_eq_neg, add_comm],
+  have hx : x = r⁻¹ • ((-o).rotation (π / 2 : ℝ) (r • ((-o).rotation (-(π / 2 : ℝ)) x))),
+  { simp [hr] },
+  nth_rewrite 2 hx,
+  refine (-o).oangle_add_right_smul_rotation_pi_div_two _ _,
+  simp [hr, h]
+end
+
+/-- The tangent of an angle in a right-angled triangle, where one side is a multiple of a
+rotation of another by `π / 2`. -/
+lemma tan_oangle_add_right_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
+  real.angle.tan (o.oangle x (x + r • o.rotation (π / 2 : ℝ) x)) = r :=
+by rw [o.oangle_add_right_smul_rotation_pi_div_two h, real.angle.tan_coe, real.tan_arctan]
+
+/-- The tangent of an angle in a right-angled triangle, where one side is a multiple of a
+rotation of another by `π / 2`. -/
+lemma tan_oangle_add_left_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
+  real.angle.tan (o.oangle (x + r • o.rotation (π / 2 : ℝ) x) (r • o.rotation (π / 2 : ℝ) x)) =
+    r⁻¹ :=
+by rw [o.oangle_add_left_smul_rotation_pi_div_two h, real.angle.tan_coe, real.tan_arctan]
+
+/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
+of a rotation of another by `π / 2`, version subtracting vectors. -/
+lemma oangle_sub_right_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
+  o.oangle (r • o.rotation (π / 2 : ℝ) x) (r • o.rotation (π / 2 : ℝ) x - x) = real.arctan r⁻¹ :=
+begin
+  by_cases hr : r = 0, { simp [hr] },
+  have hx : -x = r⁻¹ • (o.rotation (π / 2 : ℝ) (r • (o.rotation (π / 2 : ℝ) x))),
+  { simp [hr, ←real.angle.coe_add] },
+  rw [sub_eq_add_neg, hx, o.oangle_add_right_smul_rotation_pi_div_two],
+  simpa [hr] using h
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`, where one side is a multiple
+of a rotation of another by `π / 2`, version subtracting vectors. -/
+lemma oangle_sub_left_smul_rotation_pi_div_two {x : V} (h : x ≠ 0) (r : ℝ) :
+  o.oangle (x - r • o.rotation (π / 2 : ℝ) x) x = real.arctan r :=
+begin
+  by_cases hr : r = 0, { simp [hr] },
+  have hx : x = r⁻¹ • (o.rotation (π / 2 : ℝ) (-(r • (o.rotation (π / 2 : ℝ) x)))),
+  { simp [hr, ←real.angle.coe_add] },
+  rw [sub_eq_add_neg, add_comm],
+  nth_rewrite 2 hx,
+  nth_rewrite 1 hx,
+  rw [o.oangle_add_left_smul_rotation_pi_div_two, inv_inv],
+  simpa [hr] using h
+end
+
+end orientation
+
+namespace euclidean_geometry
+
+open finite_dimensional
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
+include hd2
+
+/-- An angle in a right-angled triangle expressed using `arccos`. -/
+lemma oangle_right_eq_arccos_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∡ p₂ p₃ p₁ = real.arccos (dist p₃ p₂ / dist p₁ p₃) :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs,
+      angle_eq_arccos_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- An angle in a right-angled triangle expressed using `arccos`. -/
+lemma oangle_left_eq_arccos_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∡ p₃ p₁ p₂ = real.arccos (dist p₁ p₂ / dist p₁ p₃) :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm,
+      angle_eq_arccos_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h),
+      dist_comm p₁ p₃]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`. -/
+lemma oangle_right_eq_arcsin_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∡ p₂ p₃ p₁ = real.arcsin (dist p₁ p₂ / dist p₁ p₃) :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs,
+      angle_eq_arcsin_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                             (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`. -/
+lemma oangle_left_eq_arcsin_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∡ p₃ p₁ p₂ = real.arcsin (dist p₃ p₂ / dist p₁ p₃) :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm,
+      angle_eq_arcsin_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                             (or.inr (left_ne_of_oangle_eq_pi_div_two h)),
+      dist_comm p₁ p₃]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`. -/
+lemma oangle_right_eq_arctan_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∡ p₂ p₃ p₁ = real.arctan (dist p₁ p₂ / dist p₃ p₂) :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs,
+      angle_eq_arctan_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                             (right_ne_of_oangle_eq_pi_div_two h)]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`. -/
+lemma oangle_left_eq_arctan_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  ∡ p₃ p₁ p₂ = real.arctan (dist p₃ p₂ / dist p₁ p₂) :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm,
+      angle_eq_arctan_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                             (left_ne_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma cos_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.cos (∡ p₂ p₃ p₁) = dist p₃ p₂ / dist p₁ p₃ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      cos_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma cos_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.cos (∡ p₃ p₁ p₂) = dist p₁ p₂ / dist p₁ p₃ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.cos_coe,
+      cos_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h),
+      dist_comm p₁ p₃]
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma sin_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.sin (∡ p₂ p₃ p₁) = dist p₁ p₂ / dist p₁ p₃ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      sin_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                       (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma sin_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.sin (∡ p₃ p₁ p₂) = dist p₃ p₂ / dist p₁ p₃ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.sin_coe,
+      sin_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                       (or.inr (left_ne_of_oangle_eq_pi_div_two h)),
+      dist_comm p₁ p₃]
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
+lemma tan_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.tan (∡ p₂ p₃ p₁) = dist p₁ p₂ / dist p₃ p₂ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      tan_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
+lemma tan_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.tan (∡ p₃ p₁ p₂) = dist p₃ p₂ / dist p₁ p₂ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.tan_coe,
+      tan_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side. -/
+lemma cos_oangle_right_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.cos (∡ p₂ p₃ p₁) * dist p₁ p₃ = dist p₃ p₂ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      cos_angle_mul_dist_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side. -/
+lemma cos_oangle_left_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.cos (∡ p₃ p₁ p₂) * dist p₁ p₃ = dist p₁ p₂ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.cos_coe, dist_comm p₁ p₃,
+      cos_angle_mul_dist_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side. -/
+lemma sin_oangle_right_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.sin (∡ p₂ p₃ p₁) * dist p₁ p₃ = dist p₁ p₂ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      sin_angle_mul_dist_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side. -/
+lemma sin_oangle_left_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.sin (∡ p₃ p₁ p₂) * dist p₁ p₃ = dist p₃ p₂ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.sin_coe, dist_comm p₁ p₃,
+      sin_angle_mul_dist_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)]
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side. -/
+lemma tan_oangle_right_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.tan (∡ p₂ p₃ p₁) * dist p₃ p₂ = dist p₁ p₂ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      tan_angle_mul_dist_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inr (right_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side. -/
+lemma tan_oangle_left_mul_dist_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  real.angle.tan (∡ p₃ p₁ p₂) * dist p₁ p₂ = dist p₃ p₂ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.tan_coe,
+      tan_angle_mul_dist_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inr (left_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse. -/
+lemma dist_div_cos_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  dist p₃ p₂ / real.angle.cos (∡ p₂ p₃ p₁) = dist p₁ p₃ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.cos_coe,
+      dist_div_cos_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inr (right_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse. -/
+lemma dist_div_cos_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  dist p₁ p₂ / real.angle.cos (∡ p₃ p₁ p₂) = dist p₁ p₃ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.cos_coe, dist_comm p₁ p₃,
+      dist_div_cos_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inr (left_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse. -/
+lemma dist_div_sin_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  dist p₁ p₂ / real.angle.sin (∡ p₂ p₃ p₁) = dist p₁ p₃ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.sin_coe,
+      dist_div_sin_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse. -/
+lemma dist_div_sin_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  dist p₃ p₂ / real.angle.sin (∡ p₃ p₁ p₂) = dist p₁ p₃ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.sin_coe, dist_comm p₁ p₃,
+      dist_div_sin_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inl (right_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side. -/
+lemma dist_div_tan_oangle_right_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  dist p₁ p₂ / real.angle.tan (∡ p₂ p₃ p₁) = dist p₃ p₂ :=
+begin
+  have hs : (∡ p₂ p₃ p₁).sign = 1, { rw [oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, real.angle.tan_coe,
+      dist_div_tan_angle_of_angle_eq_pi_div_two (angle_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inl (left_ne_of_oangle_eq_pi_div_two h))]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side. -/
+lemma dist_div_tan_oangle_left_of_oangle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∡ p₁ p₂ p₃ = ↑(π / 2)) :
+  dist p₃ p₂ / real.angle.tan (∡ p₃ p₁ p₂) = dist p₁ p₂ :=
+begin
+  have hs : (∡ p₃ p₁ p₂).sign = 1, { rw [←oangle_rotate_sign, h, real.angle.sign_coe_pi_div_two] },
+  rw [oangle_eq_angle_of_sign_eq_one hs, angle_comm, real.angle.tan_coe,
+      dist_div_tan_angle_of_angle_eq_pi_div_two (angle_rev_eq_pi_div_two_of_oangle_eq_pi_div_two h)
+                                                (or.inl (right_ne_of_oangle_eq_pi_div_two h))]
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/angle/oriented/rotation.lean b/src/geometry/euclidean/angle/oriented/rotation.lean
new file mode 100644
index 0000000000000..8ca7a0bcff940
--- /dev/null
+++ b/src/geometry/euclidean/angle/oriented/rotation.lean
@@ -0,0 +1,494 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers, Heather Macbeth
+-/
+import analysis.special_functions.complex.circle
+import geometry.euclidean.angle.oriented.basic
+
+/-!
+# Rotations by oriented angles.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines rotations by oriented angles in real inner product spaces.
+
+## Main definitions
+
+* `orientation.rotation` is the rotation by an oriented angle with respect to an orientation.
+
+-/
+
+noncomputable theory
+
+open finite_dimensional complex
+open_locale real real_inner_product_space complex_conjugate
+
+namespace orientation
+
+local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ
+local attribute [instance] complex.finrank_real_complex_fact
+
+variables {V V' : Type*}
+variables [normed_add_comm_group V] [normed_add_comm_group V']
+variables [inner_product_space ℝ V] [inner_product_space ℝ V']
+variables [fact (finrank ℝ V = 2)] [fact (finrank ℝ V' = 2)] (o : orientation ℝ V (fin 2))
+
+local notation `J` := o.right_angle_rotation
+
+/-- Auxiliary construction to build a rotation by the oriented angle `θ`. -/
+def rotation_aux (θ : real.angle) : V →ₗᵢ[ℝ] V :=
+linear_map.isometry_of_inner
+  (real.angle.cos θ • linear_map.id
+        + real.angle.sin θ • ↑(linear_isometry_equiv.to_linear_equiv J))
+  begin
+    intros x y,
+    simp only [is_R_or_C.conj_to_real, id.def, linear_map.smul_apply, linear_map.add_apply,
+      linear_map.id_coe, linear_equiv.coe_coe, linear_isometry_equiv.coe_to_linear_equiv,
+      orientation.area_form_right_angle_rotation_left,
+      orientation.inner_right_angle_rotation_left,
+      orientation.inner_right_angle_rotation_right,
+      inner_add_left, inner_smul_left, inner_add_right, inner_smul_right],
+    linear_combination inner x y * θ.cos_sq_add_sin_sq,
+  end
+
+@[simp] lemma rotation_aux_apply (θ : real.angle) (x : V) :
+  o.rotation_aux θ x = real.angle.cos θ • x + real.angle.sin θ • J x :=
+rfl
+
+/-- A rotation by the oriented angle `θ`. -/
+def rotation (θ : real.angle) : V ≃ₗᵢ[ℝ] V :=
+linear_isometry_equiv.of_linear_isometry
+  (o.rotation_aux θ)
+  (real.angle.cos θ • linear_map.id - real.angle.sin θ • ↑(linear_isometry_equiv.to_linear_equiv J))
+  begin
+    ext x,
+    convert congr_arg (λ t : ℝ, t • x) θ.cos_sq_add_sin_sq using 1,
+    { simp only [o.right_angle_rotation_right_angle_rotation, o.rotation_aux_apply,
+        function.comp_app, id.def, linear_equiv.coe_coe, linear_isometry.coe_to_linear_map,
+        linear_isometry_equiv.coe_to_linear_equiv, map_smul, map_sub, linear_map.coe_comp,
+        linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply, ← mul_smul, add_smul,
+        smul_add, smul_neg, smul_sub, mul_comm, sq],
+      abel },
+    { simp },
+  end
+  begin
+    ext x,
+    convert congr_arg (λ t : ℝ, t • x) θ.cos_sq_add_sin_sq using 1,
+    { simp only [o.right_angle_rotation_right_angle_rotation, o.rotation_aux_apply,
+        function.comp_app, id.def, linear_equiv.coe_coe, linear_isometry.coe_to_linear_map,
+        linear_isometry_equiv.coe_to_linear_equiv, map_add, map_smul, linear_map.coe_comp,
+        linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply, add_smul, ← mul_smul,
+        mul_comm, smul_add, smul_neg, sq],
+      abel },
+    { simp },
+  end
+
+lemma rotation_apply (θ : real.angle) (x : V) :
+  o.rotation θ x = real.angle.cos θ • x + real.angle.sin θ • J x :=
+rfl
+
+lemma rotation_symm_apply (θ : real.angle) (x : V) :
+  (o.rotation θ).symm x = real.angle.cos θ • x - real.angle.sin θ • J x :=
+rfl
+
+attribute [irreducible] rotation
+
+lemma rotation_eq_matrix_to_lin (θ : real.angle) {x : V} (hx : x ≠ 0) :
+  (o.rotation θ).to_linear_map
+  = matrix.to_lin
+      (o.basis_right_angle_rotation x hx) (o.basis_right_angle_rotation x hx)
+      !![θ.cos, -θ.sin; θ.sin, θ.cos] :=
+begin
+  apply (o.basis_right_angle_rotation x hx).ext,
+  intros i,
+  fin_cases i,
+  { rw matrix.to_lin_self,
+    simp [rotation_apply, fin.sum_univ_succ] },
+  { rw matrix.to_lin_self,
+    simp [rotation_apply, fin.sum_univ_succ, add_comm] },
+end
+
+/-- The determinant of `rotation` (as a linear map) is equal to `1`. -/
+@[simp] lemma det_rotation (θ : real.angle) :
+  (o.rotation θ).to_linear_map.det = 1 :=
+begin
+  haveI : nontrivial V :=
+    finite_dimensional.nontrivial_of_finrank_eq_succ (fact.out (finrank ℝ V = 2)),
+  obtain ⟨x, hx⟩ : ∃ x, x ≠ (0:V) := exists_ne (0:V),
+  rw o.rotation_eq_matrix_to_lin θ hx,
+  simpa [sq] using θ.cos_sq_add_sin_sq,
+end
+
+/-- The determinant of `rotation` (as a linear equiv) is equal to `1`. -/
+@[simp] lemma linear_equiv_det_rotation (θ : real.angle) :
+  (o.rotation θ).to_linear_equiv.det = 1 :=
+units.ext $ o.det_rotation θ
+
+/-- The inverse of `rotation` is rotation by the negation of the angle. -/
+@[simp] lemma rotation_symm (θ : real.angle) : (o.rotation θ).symm = o.rotation (-θ) :=
+by ext; simp [o.rotation_apply, o.rotation_symm_apply, sub_eq_add_neg]
+
+/-- Rotation by 0 is the identity. -/
+@[simp] lemma rotation_zero : o.rotation 0 = linear_isometry_equiv.refl ℝ V :=
+by ext; simp [rotation]
+
+/-- Rotation by π is negation. -/
+@[simp] lemma rotation_pi : o.rotation π = linear_isometry_equiv.neg ℝ :=
+begin
+  ext x,
+  simp [rotation]
+end
+
+/-- Rotation by π is negation. -/
+lemma rotation_pi_apply (x : V) : o.rotation π x = -x :=
+by simp
+
+/-- Rotation by π / 2 is the "right-angle-rotation" map `J`. -/
+lemma rotation_pi_div_two : o.rotation (π / 2 : ℝ) = J :=
+begin
+  ext x,
+  simp [rotation],
+end
+
+/-- Rotating twice is equivalent to rotating by the sum of the angles. -/
+@[simp] lemma rotation_rotation (θ₁ θ₂ : real.angle) (x : V) :
+  o.rotation θ₁ (o.rotation θ₂ x) = o.rotation (θ₁ + θ₂) x :=
+begin
+  simp only [o.rotation_apply, ←mul_smul, real.angle.cos_add, real.angle.sin_add, add_smul,
+    sub_smul, linear_isometry_equiv.trans_apply, smul_add, linear_isometry_equiv.map_add,
+    linear_isometry_equiv.map_smul, right_angle_rotation_right_angle_rotation, smul_neg],
+  ring_nf,
+  abel,
+end
+
+/-- Rotating twice is equivalent to rotating by the sum of the angles. -/
+@[simp] lemma rotation_trans (θ₁ θ₂ : real.angle) :
+  (o.rotation θ₁).trans (o.rotation θ₂) = o.rotation (θ₂ + θ₁) :=
+linear_isometry_equiv.ext $ λ _, by rw [←rotation_rotation, linear_isometry_equiv.trans_apply]
+
+/-- Rotating the first of two vectors by `θ` scales their Kahler form by `cos θ - sin θ * I`. -/
+@[simp] lemma kahler_rotation_left (x y : V) (θ : real.angle) :
+  o.kahler (o.rotation θ x) y = conj (θ.exp_map_circle : ℂ) * o.kahler x y :=
+begin
+  simp only [o.rotation_apply, map_add, map_mul, linear_map.map_smulₛₗ, ring_hom.id_apply,
+    linear_map.add_apply, linear_map.smul_apply, real_smul, kahler_right_angle_rotation_left,
+    real.angle.coe_exp_map_circle, is_R_or_C.conj_of_real, conj_I],
+  ring,
+end
+
+/-- Negating a rotation is equivalent to rotation by π plus the angle. -/
+lemma neg_rotation (θ : real.angle) (x : V) : -o.rotation θ x = o.rotation (π + θ) x :=
+by rw [←o.rotation_pi_apply, rotation_rotation]
+
+/-- Negating a rotation by -π / 2 is equivalent to rotation by π / 2. -/
+@[simp] lemma neg_rotation_neg_pi_div_two (x : V) :
+  -o.rotation (-π / 2 : ℝ) x = o.rotation (π / 2 : ℝ) x :=
+by rw [neg_rotation, ←real.angle.coe_add, neg_div, ←sub_eq_add_neg, sub_half]
+
+/-- Negating a rotation by π / 2 is equivalent to rotation by -π / 2. -/
+lemma neg_rotation_pi_div_two (x : V) : -o.rotation (π / 2 : ℝ) x = o.rotation (-π / 2 : ℝ) x :=
+(neg_eq_iff_eq_neg.mp $ o.neg_rotation_neg_pi_div_two _).symm
+
+/-- Rotating the first of two vectors by `θ` scales their Kahler form by `cos (-θ) + sin (-θ) * I`.
+-/
+lemma kahler_rotation_left' (x y : V) (θ : real.angle) :
+  o.kahler (o.rotation θ x) y = (-θ).exp_map_circle * o.kahler x y :=
+by simpa [coe_inv_circle_eq_conj, -kahler_rotation_left] using o.kahler_rotation_left x y θ
+
+/-- Rotating the second of two vectors by `θ` scales their Kahler form by `cos θ + sin θ * I`. -/
+@[simp] lemma kahler_rotation_right (x y : V) (θ : real.angle) :
+  o.kahler x (o.rotation θ y) = θ.exp_map_circle * o.kahler x y :=
+begin
+  simp only [o.rotation_apply, map_add, linear_map.map_smulₛₗ, ring_hom.id_apply, real_smul,
+    kahler_right_angle_rotation_right, real.angle.coe_exp_map_circle],
+  ring,
+end
+
+/-- Rotating the first vector by `θ` subtracts `θ` from the angle between two vectors. -/
+@[simp] lemma oangle_rotation_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
+  o.oangle (o.rotation θ x) y = o.oangle x y - θ :=
+begin
+  simp only [oangle, o.kahler_rotation_left'],
+  rw [complex.arg_mul_coe_angle, real.angle.arg_exp_map_circle],
+  { abel },
+  { exact ne_zero_of_mem_circle _ },
+  { exact o.kahler_ne_zero hx hy },
+end
+
+/-- Rotating the second vector by `θ` adds `θ` to the angle between two vectors. -/
+@[simp] lemma oangle_rotation_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
+  o.oangle x (o.rotation θ y) = o.oangle x y + θ :=
+begin
+  simp only [oangle, o.kahler_rotation_right],
+  rw [complex.arg_mul_coe_angle, real.angle.arg_exp_map_circle],
+  { abel },
+  { exact ne_zero_of_mem_circle _ },
+  { exact o.kahler_ne_zero hx hy },
+end
+
+/-- The rotation of a vector by `θ` has an angle of `-θ` from that vector. -/
+@[simp] lemma oangle_rotation_self_left {x : V} (hx : x ≠ 0) (θ : real.angle) :
+  o.oangle (o.rotation θ x) x = -θ :=
+by simp [hx]
+
+/-- A vector has an angle of `θ` from the rotation of that vector by `θ`. -/
+@[simp] lemma oangle_rotation_self_right {x : V} (hx : x ≠ 0) (θ : real.angle) :
+  o.oangle x (o.rotation θ x) = θ :=
+by simp [hx]
+
+/-- Rotating the first vector by the angle between the two vectors results an an angle of 0. -/
+@[simp] lemma oangle_rotation_oangle_left (x y : V) :
+  o.oangle (o.rotation (o.oangle x y) x) y = 0 :=
+begin
+  by_cases hx : x = 0,
+  { simp [hx] },
+  { by_cases hy : y = 0,
+    { simp [hy] },
+    { simp [hx, hy] } }
+end
+
+/-- Rotating the first vector by the angle between the two vectors and swapping the vectors
+results an an angle of 0. -/
+@[simp] lemma oangle_rotation_oangle_right (x y : V) :
+  o.oangle y (o.rotation (o.oangle x y) x) = 0 :=
+begin
+  rw [oangle_rev],
+  simp
+end
+
+/-- Rotating both vectors by the same angle does not change the angle between those vectors. -/
+@[simp] lemma oangle_rotation (x y : V) (θ : real.angle) :
+  o.oangle (o.rotation θ x) (o.rotation θ y) = o.oangle x y :=
+begin
+  by_cases hx : x = 0; by_cases hy : y = 0;
+    simp [hx, hy]
+end
+
+/-- A rotation of a nonzero vector equals that vector if and only if the angle is zero. -/
+@[simp] lemma rotation_eq_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
+  o.rotation θ x = x ↔ θ = 0 :=
+begin
+  split,
+  { intro h,
+    rw eq_comm,
+    simpa [hx, h] using o.oangle_rotation_right hx hx θ },
+  { intro h,
+    simp [h] }
+end
+
+/-- A nonzero vector equals a rotation of that vector if and only if the angle is zero. -/
+@[simp] lemma eq_rotation_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
+  x = o.rotation θ x ↔ θ = 0 :=
+by rw [←o.rotation_eq_self_iff_angle_eq_zero hx, eq_comm]
+
+/-- A rotation of a vector equals that vector if and only if the vector or the angle is zero. -/
+lemma rotation_eq_self_iff (x : V) (θ : real.angle) :
+  o.rotation θ x = x ↔ x = 0 ∨ θ = 0 :=
+begin
+  by_cases h : x = 0;
+    simp [h]
+end
+
+/-- A vector equals a rotation of that vector if and only if the vector or the angle is zero. -/
+lemma eq_rotation_self_iff (x : V) (θ : real.angle) :
+  x = o.rotation θ x ↔ x = 0 ∨ θ = 0 :=
+by rw [←rotation_eq_self_iff, eq_comm]
+
+/-- Rotating a vector by the angle to another vector gives the second vector if and only if the
+norms are equal. -/
+@[simp] lemma rotation_oangle_eq_iff_norm_eq (x y : V) :
+  o.rotation (o.oangle x y) x = y ↔ ‖x‖ = ‖y‖ :=
+begin
+  split,
+  { intro h,
+    rw [←h, linear_isometry_equiv.norm_map] },
+  { intro h,
+    rw o.eq_iff_oangle_eq_zero_of_norm_eq;
+      simp [h] }
+end
+
+/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
+rotated by `θ` and scaled by the ratio of the norms. -/
+lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
+  (θ : real.angle) : o.oangle x y = θ ↔ y = (‖y‖ / ‖x‖) • o.rotation θ x :=
+begin
+  have hp := div_pos (norm_pos_iff.2 hy) (norm_pos_iff.2 hx),
+  split,
+  { rintro rfl,
+    rw [←linear_isometry_equiv.map_smul, ←o.oangle_smul_left_of_pos x y hp,
+        eq_comm, rotation_oangle_eq_iff_norm_eq, norm_smul, real.norm_of_nonneg hp.le,
+        div_mul_cancel _ (norm_ne_zero_iff.2 hx)] },
+  { intro hye,
+    rw [hye, o.oangle_smul_right_of_pos _ _ hp, o.oangle_rotation_self_right hx] }
+end
+
+/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
+rotated by `θ` and scaled by a positive real. -/
+lemma oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
+  (θ : real.angle) : o.oangle x y = θ ↔ ∃ r : ℝ, 0 < r ∧ y = r • o.rotation θ x :=
+begin
+  split,
+  { intro h,
+    rw o.oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy at h,
+    exact ⟨‖y‖ / ‖x‖, div_pos (norm_pos_iff.2 hy) (norm_pos_iff.2 hx), h⟩ },
+  { rintro ⟨r, hr, rfl⟩,
+    rw [o.oangle_smul_right_of_pos _ _ hr, o.oangle_rotation_self_right hx] }
+end
+
+/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
+is the first rotated by `θ` and scaled by the ratio of the norms, or `θ` and at least one of the
+vectors are zero. -/
+lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
+  o.oangle x y = θ ↔
+    (x ≠ 0 ∧ y ≠ 0 ∧ y = (‖y‖ / ‖x‖) • o.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
+begin
+  by_cases hx : x = 0,
+  { simp [hx, eq_comm] },
+  { by_cases hy : y = 0,
+    { simp [hy, eq_comm] },
+    { rw o.oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy,
+      simp [hx, hy] } }
+end
+
+/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
+is the first rotated by `θ` and scaled by a positive real, or `θ` and at least one of the
+vectors are zero. -/
+lemma oangle_eq_iff_eq_pos_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
+  o.oangle x y = θ ↔
+    (x ≠ 0 ∧ y ≠ 0 ∧ ∃ r : ℝ, 0 < r ∧ y = r • o.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
+begin
+  by_cases hx : x = 0,
+  { simp [hx, eq_comm] },
+  { by_cases hy : y = 0,
+    { simp [hy, eq_comm] },
+    { rw o.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero hx hy,
+      simp [hx, hy] } }
+end
+
+/-- Any linear isometric equivalence in `V` with positive determinant is `rotation`. -/
+lemma exists_linear_isometry_equiv_eq_of_det_pos {f : V ≃ₗᵢ[ℝ] V}
+  (hd : 0 < (f.to_linear_equiv : V →ₗ[ℝ] V).det) : ∃ θ : real.angle, f = o.rotation θ :=
+begin
+  haveI : nontrivial V :=
+    finite_dimensional.nontrivial_of_finrank_eq_succ (fact.out (finrank ℝ V = 2)),
+  obtain ⟨x, hx⟩ : ∃ x, x ≠ (0:V) := exists_ne (0:V),
+  use o.oangle x (f x),
+  apply linear_isometry_equiv.to_linear_equiv_injective,
+  apply linear_equiv.to_linear_map_injective,
+  apply (o.basis_right_angle_rotation x hx).ext,
+  intros i,
+  symmetry,
+  fin_cases i,
+  { simp },
+  have : o.oangle (J x) (f (J x)) = o.oangle x (f x),
+  { simp only [oangle, o.linear_isometry_equiv_comp_right_angle_rotation f hd,
+      o.kahler_comp_right_angle_rotation] },
+  simp [← this],
+end
+
+lemma rotation_map (θ : real.angle) (f : V ≃ₗᵢ[ℝ] V') (x : V') :
+  (orientation.map (fin 2) f.to_linear_equiv o).rotation θ x
+  = f (o.rotation θ (f.symm x)) :=
+by simp [rotation_apply, o.right_angle_rotation_map]
+
+@[simp] protected lemma _root_.complex.rotation (θ : real.angle) (z : ℂ) :
+  complex.orientation.rotation θ z = θ.exp_map_circle * z :=
+begin
+  simp only [rotation_apply, complex.right_angle_rotation, real.angle.coe_exp_map_circle,
+    real_smul],
+  ring
+end
+
+/-- Rotation in an oriented real inner product space of dimension 2 can be evaluated in terms of a
+complex-number representation of the space. -/
+lemma rotation_map_complex (θ : real.angle) (f : V ≃ₗᵢ[ℝ] ℂ)
+  (hf : (orientation.map (fin 2) f.to_linear_equiv o) = complex.orientation) (x : V) :
+  f (o.rotation θ x) = θ.exp_map_circle * f x :=
+begin
+  rw [← complex.rotation, ← hf, o.rotation_map],
+  simp,
+end
+
+/-- Negating the orientation negates the angle in `rotation`. -/
+lemma rotation_neg_orientation_eq_neg (θ : real.angle) :
+  (-o).rotation θ = o.rotation (-θ) :=
+linear_isometry_equiv.ext $ by simp [rotation_apply]
+
+/-- The inner product between a `π / 2` rotation of a vector and that vector is zero. -/
+@[simp] lemma inner_rotation_pi_div_two_left (x : V) : ⟪o.rotation (π / 2 : ℝ) x, x⟫ = 0 :=
+by rw [rotation_pi_div_two, inner_right_angle_rotation_self]
+
+/-- The inner product between a vector and a `π / 2` rotation of that vector is zero. -/
+@[simp] lemma inner_rotation_pi_div_two_right (x : V) : ⟪x, o.rotation (π / 2 : ℝ) x⟫ = 0 :=
+by rw [real_inner_comm, inner_rotation_pi_div_two_left]
+
+/-- The inner product between a multiple of a `π / 2` rotation of a vector and that vector is
+zero. -/
+@[simp] lemma inner_smul_rotation_pi_div_two_left (x : V) (r : ℝ) :
+  ⟪r • o.rotation (π / 2 : ℝ) x, x⟫ = 0 :=
+by rw [inner_smul_left, inner_rotation_pi_div_two_left, mul_zero]
+
+/-- The inner product between a vector and a multiple of a `π / 2` rotation of that vector is
+zero. -/
+@[simp] lemma inner_smul_rotation_pi_div_two_right (x : V) (r : ℝ) :
+  ⟪x, r • o.rotation (π / 2 : ℝ) x⟫ = 0 :=
+by rw [real_inner_comm, inner_smul_rotation_pi_div_two_left]
+
+/-- The inner product between a `π / 2` rotation of a vector and a multiple of that vector is
+zero. -/
+@[simp] lemma inner_rotation_pi_div_two_left_smul (x : V) (r : ℝ) :
+  ⟪o.rotation (π / 2 : ℝ) x, r • x⟫ = 0 :=
+by rw [inner_smul_right, inner_rotation_pi_div_two_left, mul_zero]
+
+/-- The inner product between a multiple of a vector and a `π / 2` rotation of that vector is
+zero. -/
+@[simp] lemma inner_rotation_pi_div_two_right_smul (x : V) (r : ℝ) :
+  ⟪r • x, o.rotation (π / 2 : ℝ) x⟫ = 0 :=
+by rw [real_inner_comm, inner_rotation_pi_div_two_left_smul]
+
+/-- The inner product between a multiple of a `π / 2` rotation of a vector and a multiple of
+that vector is zero. -/
+@[simp] lemma inner_smul_rotation_pi_div_two_smul_left (x : V) (r₁ r₂ : ℝ) :
+  ⟪r₁ • o.rotation (π / 2 : ℝ) x, r₂ • x⟫ = 0 :=
+by rw [inner_smul_right, inner_smul_rotation_pi_div_two_left, mul_zero]
+
+/-- The inner product between a multiple of a vector and a multiple of a `π / 2` rotation of
+that vector is zero. -/
+@[simp] lemma inner_smul_rotation_pi_div_two_smul_right (x : V) (r₁ r₂ : ℝ) :
+  ⟪r₂ • x, r₁ • o.rotation (π / 2 : ℝ) x⟫ = 0 :=
+by rw [real_inner_comm, inner_smul_rotation_pi_div_two_smul_left]
+
+/-- The inner product between two vectors is zero if and only if the first vector is zero or
+the second is a multiple of a `π / 2` rotation of that vector. -/
+lemma inner_eq_zero_iff_eq_zero_or_eq_smul_rotation_pi_div_two {x y : V} :
+  ⟪x, y⟫ = 0 ↔ (x = 0 ∨ ∃ r : ℝ, r • o.rotation (π / 2 : ℝ) x = y) :=
+begin
+  rw ←o.eq_zero_or_oangle_eq_iff_inner_eq_zero,
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with rfl | rfl | h | h,
+    { exact or.inl rfl },
+    { exact or.inr ⟨0, zero_smul _ _⟩ },
+    { obtain ⟨r, hr, rfl⟩ := (o.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero
+        (o.left_ne_zero_of_oangle_eq_pi_div_two h)
+        (o.right_ne_zero_of_oangle_eq_pi_div_two h) _).1 h,
+      exact or.inr ⟨r, rfl⟩ },
+    { obtain ⟨r, hr, rfl⟩ := (o.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero
+        (o.left_ne_zero_of_oangle_eq_neg_pi_div_two h)
+        (o.right_ne_zero_of_oangle_eq_neg_pi_div_two h) _).1 h,
+      refine or.inr ⟨-r, _⟩,
+      rw [neg_smul, ←smul_neg, o.neg_rotation_pi_div_two] } },
+  { rcases h with rfl | ⟨r, rfl⟩,
+    { exact or.inl rfl },
+    { by_cases hx : x = 0, { exact or.inl hx },
+      rcases lt_trichotomy r 0 with hr | rfl | hr,
+      { refine or.inr (or.inr (or.inr _)),
+        rw [o.oangle_smul_right_of_neg _ _ hr, o.neg_rotation_pi_div_two,
+            o.oangle_rotation_self_right hx] },
+      { exact or.inr (or.inl (zero_smul _ _)) },
+      { refine or.inr (or.inr (or.inl _)),
+        rw [o.oangle_smul_right_of_pos _ _ hr, o.oangle_rotation_self_right hx] } } }
+end
+
+end orientation
diff --git a/src/geometry/euclidean/angle/sphere.lean b/src/geometry/euclidean/angle/sphere.lean
new file mode 100644
index 0000000000000..4b32efd19ef3a
--- /dev/null
+++ b/src/geometry/euclidean/angle/sphere.lean
@@ -0,0 +1,431 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import geometry.euclidean.angle.oriented.right_angle
+import geometry.euclidean.circumcenter
+
+/-!
+# Angles in circles and sphere.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves results about angles in circles and spheres.
+
+-/
+
+noncomputable theory
+
+open finite_dimensional complex
+open_locale euclidean_geometry real real_inner_product_space complex_conjugate
+
+namespace orientation
+
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
+variables [fact (finrank ℝ V = 2)] (o : orientation ℝ V (fin 2))
+
+/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
+form. -/
+lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
+  (hxy : ‖x‖ = ‖y‖) (hxz : ‖x‖ = ‖z‖) : o.oangle y z = (2 : ℤ) • o.oangle (y - x) (z - x) :=
+begin
+  have hy : y ≠ 0,
+  { rintro rfl,
+    rw [norm_zero, norm_eq_zero] at hxy,
+    exact hxyne hxy },
+  have hx : x ≠ 0 := norm_ne_zero_iff.1 (hxy.symm ▸ norm_ne_zero_iff.2 hy),
+  have hz : z ≠ 0 := norm_ne_zero_iff.1 (hxz ▸ norm_ne_zero_iff.2 hx),
+  calc o.oangle y z = o.oangle x z - o.oangle x y : (o.oangle_sub_left hx hy hz).symm
+       ...           = (π - (2 : ℤ) • o.oangle (x - z) x) -
+                       (π - (2 : ℤ) • o.oangle (x - y) x) :
+         by rw [o.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hxzne.symm hxz.symm,
+                o.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hxyne.symm hxy.symm]
+       ...           = (2 : ℤ) • (o.oangle (x - y) x - o.oangle (x - z) x) : by abel
+       ...           = (2 : ℤ) • o.oangle (x - y) (x - z) :
+         by rw o.oangle_sub_right (sub_ne_zero_of_ne hxyne) (sub_ne_zero_of_ne hxzne) hx
+       ...           = (2 : ℤ) • o.oangle (y - x) (z - x) :
+         by rw [←oangle_neg_neg, neg_sub, neg_sub]
+end
+
+/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
+form with radius specified. -/
+lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
+  {r : ℝ} (hx : ‖x‖ = r) (hy : ‖y‖ = r) (hz : ‖z‖ = r) :
+  o.oangle y z = (2 : ℤ) • o.oangle (y - x) (z - x) :=
+o.oangle_eq_two_zsmul_oangle_sub_of_norm_eq hxyne hxzne (hy.symm ▸ hx) (hz.symm ▸ hx)
+
+/-- Oriented vector angle version of "angles in same segment are equal" and "opposite angles of
+a cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same
+result), represented here as equality of twice the angles. -/
+lemma two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq {x₁ x₂ y z : V} (hx₁yne : x₁ ≠ y)
+  (hx₁zne : x₁ ≠ z) (hx₂yne : x₂ ≠ y) (hx₂zne : x₂ ≠ z) {r : ℝ} (hx₁ : ‖x₁‖ = r) (hx₂ : ‖x₂‖ = r)
+  (hy : ‖y‖ = r) (hz : ‖z‖ = r) :
+  (2 : ℤ) • o.oangle (y - x₁) (z - x₁) = (2 : ℤ) • o.oangle (y - x₂) (z - x₂) :=
+o.oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hx₁yne hx₁zne hx₁ hy hz ▸
+  o.oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hx₂yne hx₂zne hx₂ hy hz
+
+end orientation
+
+namespace euclidean_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
+include hd2
+
+local notation `o` := module.oriented.positive_orientation
+
+namespace sphere
+
+/-- Angle at center of a circle equals twice angle at circumference, oriented angle version. -/
+lemma oangle_center_eq_two_zsmul_oangle {s : sphere P} {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₃ : p₂ ≠ p₃) :
+  ∡ p₁ s.center p₃ = (2 : ℤ) • ∡ p₁ p₂ p₃ :=
+begin
+  rw [mem_sphere, @dist_eq_norm_vsub V] at hp₁ hp₂ hp₃,
+  rw [oangle, oangle, (o).oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real _ _ hp₂ hp₁ hp₃];
+    simp [hp₂p₁, hp₂p₃]
+end
+
+/-- Oriented angle version of "angles in same segment are equal" and "opposite angles of a
+cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same result),
+represented here as equality of twice the angles. -/
+lemma two_zsmul_oangle_eq {s : sphere P} {p₁ p₂ p₃ p₄ : P} (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s)
+  (hp₃ : p₃ ∈ s) (hp₄ : p₄ ∈ s) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₄ : p₂ ≠ p₄) (hp₃p₁ : p₃ ≠ p₁)
+  (hp₃p₄ : p₃ ≠ p₄) : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄ :=
+begin
+  rw [mem_sphere, @dist_eq_norm_vsub V] at hp₁ hp₂ hp₃ hp₄,
+  rw [oangle, oangle, ←vsub_sub_vsub_cancel_right p₁ p₂ s.center,
+      ←vsub_sub_vsub_cancel_right p₄ p₂ s.center,
+      (o).two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq _ _ _ _ hp₂ hp₃ hp₁ hp₄];
+    simp [hp₂p₁, hp₂p₄, hp₃p₁, hp₃p₄]
+end
+
+end sphere
+
+/-- Oriented angle version of "angles in same segment are equal" and "opposite angles of a
+cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same result),
+represented here as equality of twice the angles. -/
+lemma cospherical.two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ : P}
+  (h : cospherical ({p₁, p₂, p₃, p₄} : set P)) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₄ : p₂ ≠ p₄)
+  (hp₃p₁ : p₃ ≠ p₁) (hp₃p₄ : p₃ ≠ p₄) : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄ :=
+begin
+  obtain ⟨s, hs⟩ := cospherical_iff_exists_sphere.1 h,
+  simp_rw [set.insert_subset, set.singleton_subset_iff, sphere.mem_coe] at hs,
+  exact sphere.two_zsmul_oangle_eq hs.1 hs.2.1 hs.2.2.1 hs.2.2.2 hp₂p₁ hp₂p₄ hp₃p₁ hp₃p₄
+end
+
+namespace sphere
+
+/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
+angle-at-point form where the apex is given as the center of a circle. -/
+lemma oangle_eq_pi_sub_two_zsmul_oangle_center_left {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : ∡ p₁ s.center p₂ = π - (2 : ℤ) • ∡ s.center p₂ p₁ :=
+by rw [oangle_eq_pi_sub_two_zsmul_oangle_of_dist_eq h.symm
+  (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)]
+
+/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
+angle-at-point form where the apex is given as the center of a circle. -/
+lemma oangle_eq_pi_sub_two_zsmul_oangle_center_right {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : ∡ p₁ s.center p₂ = π - (2 : ℤ) • ∡ p₂ p₁ s.center :=
+by rw [oangle_eq_pi_sub_two_zsmul_oangle_center_left hp₁ hp₂ h,
+       oangle_eq_oangle_of_dist_eq (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)]
+
+/-- Twice a base angle of an isosceles triangle with apex at the center of a circle, plus twice
+the angle at the apex of a triangle with the same base but apex on the circle, equals `π`. -/
+lemma two_zsmul_oangle_center_add_two_zsmul_oangle_eq_pi {s : sphere P} {p₁ p₂ p₃ : P}
+  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₂p₁ : p₂ ≠ p₁) (hp₂p₃ : p₂ ≠ p₃)
+  (hp₁p₃ : p₁ ≠ p₃) : (2 : ℤ) • ∡ p₃ p₁ s.center + (2 : ℤ) • ∡ p₁ p₂ p₃ = π :=
+by rw [←oangle_center_eq_two_zsmul_oangle hp₁ hp₂ hp₃ hp₂p₁ hp₂p₃,
+       oangle_eq_pi_sub_two_zsmul_oangle_center_right hp₁ hp₃ hp₁p₃, add_sub_cancel'_right]
+
+/-- A base angle of an isosceles triangle with apex at the center of a circle is acute. -/
+lemma abs_oangle_center_left_to_real_lt_pi_div_two {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) : |(∡ s.center p₂ p₁).to_real| < π / 2 :=
+abs_oangle_right_to_real_lt_pi_div_two_of_dist_eq
+  (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)
+
+/-- A base angle of an isosceles triangle with apex at the center of a circle is acute. -/
+lemma abs_oangle_center_right_to_real_lt_pi_div_two {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) : |(∡ p₂ p₁ s.center).to_real| < π / 2 :=
+abs_oangle_left_to_real_lt_pi_div_two_of_dist_eq
+  (dist_center_eq_dist_center_of_mem_sphere' hp₂ hp₁)
+
+/-- Given two points on a circle, the center of that circle may be expressed explicitly as a
+multiple (by half the tangent of the angle between the chord and the radius at one of those
+points) of a `π / 2` rotation of the vector between those points, plus the midpoint of those
+points. -/
+lemma tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center {s : sphere P} {p₁ p₂ : P}
+  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) :
+  (real.angle.tan (∡ p₂ p₁ s.center) / 2) • ((o).rotation (π / 2 : ℝ) (p₂ -ᵥ p₁)) +ᵥ
+    midpoint ℝ p₁ p₂ = s.center :=
+begin
+  obtain ⟨r, hr⟩ := (dist_eq_iff_eq_smul_rotation_pi_div_two_vadd_midpoint h).1
+    (dist_center_eq_dist_center_of_mem_sphere hp₁ hp₂),
+  rw [←hr, ←oangle_midpoint_rev_left, oangle, vadd_vsub_assoc],
+  nth_rewrite 0 (show p₂ -ᵥ p₁ = (2 : ℝ) • (midpoint ℝ p₁ p₂ -ᵥ p₁), by simp),
+  rw [map_smul, smul_smul, add_comm, (o).tan_oangle_add_right_smul_rotation_pi_div_two,
+      mul_div_cancel _ (two_ne_zero' ℝ)],
+  simpa using h.symm
+end
+
+/-- Given three points on a circle, the center of that circle may be expressed explicitly as a
+multiple (by half the inverse of the tangent of the angle at one of those points) of a `π / 2`
+rotation of the vector between the other two points, plus the midpoint of those points. -/
+lemma inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center {s : sphere P}
+  {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) (hp₁p₃ : p₁ ≠ p₃)
+  (hp₂p₃ : p₂ ≠ p₃) :
+  ((real.angle.tan (∡ p₁ p₂ p₃))⁻¹ / 2) • ((o).rotation (π / 2 : ℝ) (p₃ -ᵥ p₁)) +ᵥ
+    midpoint ℝ p₁ p₃ = s.center :=
+begin
+  convert tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center hp₁ hp₃ hp₁p₃,
+  convert (real.angle.tan_eq_inv_of_two_zsmul_add_two_zsmul_eq_pi _).symm,
+  rw [add_comm,
+      two_zsmul_oangle_center_add_two_zsmul_oangle_eq_pi hp₁ hp₂ hp₃ hp₁p₂.symm hp₂p₃ hp₁p₃]
+end
+
+/-- Given two points on a circle, the radius of that circle may be expressed explicitly as half
+the distance between those two points divided by the cosine of the angle between the chord and
+the radius at one of those points. -/
+lemma dist_div_cos_oangle_center_div_two_eq_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : dist p₁ p₂ / real.angle.cos (∡ p₂ p₁ s.center) / 2 = s.radius :=
+begin
+  rw [div_right_comm, div_eq_mul_inv _ (2 : ℝ), mul_comm,
+      (show (2 : ℝ)⁻¹ * dist p₁ p₂ = dist p₁ (midpoint ℝ p₁ p₂), by simp), ←mem_sphere.1 hp₁,
+      ←tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center hp₁ hp₂ h,
+      ←oangle_midpoint_rev_left, oangle, vadd_vsub_assoc,
+      (show p₂ -ᵥ p₁ = (2 : ℝ) • (midpoint ℝ p₁ p₂ -ᵥ p₁), by simp), map_smul, smul_smul,
+      div_mul_cancel _ (two_ne_zero' ℝ), @dist_eq_norm_vsub' V, @dist_eq_norm_vsub' V,
+      vadd_vsub_assoc, add_comm, (o).oangle_add_right_smul_rotation_pi_div_two,
+      real.angle.cos_coe, real.cos_arctan, one_div, div_inv_eq_mul,
+      ←mul_self_inj (mul_nonneg (norm_nonneg _) (real.sqrt_nonneg _)) (norm_nonneg _),
+      norm_add_sq_eq_norm_sq_add_norm_sq_real ((o).inner_smul_rotation_pi_div_two_right _ _),
+      ←mul_assoc, mul_comm, mul_comm _ (real.sqrt _), ←mul_assoc, ←mul_assoc,
+      real.mul_self_sqrt (add_nonneg zero_le_one (sq_nonneg _)), norm_smul,
+      linear_isometry_equiv.norm_map],
+  swap, { simpa using h.symm },
+  conv_rhs { rw [←mul_assoc, mul_comm _ ‖real.angle.tan _‖, ←mul_assoc, real.norm_eq_abs,
+                 abs_mul_abs_self] },
+  ring
+end
+
+/-- Given two points on a circle, twice the radius of that circle may be expressed explicitly as
+the distance between those two points divided by the cosine of the angle between the chord and
+the radius at one of those points. -/
+lemma dist_div_cos_oangle_center_eq_two_mul_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (h : p₁ ≠ p₂) : dist p₁ p₂ / real.angle.cos (∡ p₂ p₁ s.center) = 2 * s.radius :=
+by rw [←dist_div_cos_oangle_center_div_two_eq_radius hp₁ hp₂ h,
+       mul_div_cancel' _ (two_ne_zero' ℝ)]
+
+/-- Given three points on a circle, the radius of that circle may be expressed explicitly as half
+the distance between two of those points divided by the absolute value of the sine of the angle
+at the third point (a version of the law of sines or sine rule). -/
+lemma dist_div_sin_oangle_div_two_eq_radius {s : sphere P} {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) (hp₁p₃ : p₁ ≠ p₃) (hp₂p₃ : p₂ ≠ p₃) :
+  dist p₁ p₃ / |real.angle.sin (∡ p₁ p₂ p₃)| / 2 = s.radius :=
+begin
+  convert dist_div_cos_oangle_center_div_two_eq_radius hp₁ hp₃ hp₁p₃,
+  rw [←real.angle.abs_cos_eq_abs_sin_of_two_zsmul_add_two_zsmul_eq_pi
+        (two_zsmul_oangle_center_add_two_zsmul_oangle_eq_pi
+          hp₁ hp₂ hp₃ hp₁p₂.symm hp₂p₃ hp₁p₃),
+      _root_.abs_of_nonneg (real.angle.cos_nonneg_iff_abs_to_real_le_pi_div_two.2 _)],
+  exact (abs_oangle_center_right_to_real_lt_pi_div_two hp₁ hp₃).le
+end
+
+/-- Given three points on a circle, twice the radius of that circle may be expressed explicitly as
+the distance between two of those points divided by the absolute value of the sine of the angle
+at the third point (a version of the law of sines or sine rule). -/
+lemma dist_div_sin_oangle_eq_two_mul_radius {s : sphere P} {p₁ p₂ p₃ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) (hp₁p₃ : p₁ ≠ p₃) (hp₂p₃ : p₂ ≠ p₃) :
+  dist p₁ p₃ / |real.angle.sin (∡ p₁ p₂ p₃)| = 2 * s.radius :=
+by rw [←dist_div_sin_oangle_div_two_eq_radius hp₁ hp₂ hp₃ hp₁p₂ hp₁p₃ hp₂p₃,
+       mul_div_cancel' _ (two_ne_zero' ℝ)]
+
+end sphere
+
+end euclidean_geometry
+
+namespace affine
+namespace triangle
+
+open euclidean_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
+include hd2
+
+local notation `o` := module.oriented.positive_orientation
+
+/-- The circumcenter of a triangle may be expressed explicitly as a multiple (by half the inverse
+of the tangent of the angle at one of the vertices) of a `π / 2` rotation of the vector between
+the other two vertices, plus the midpoint of those vertices. -/
+lemma inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_circumcenter (t : triangle ℝ P)
+  {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  ((real.angle.tan (∡ (t.points i₁) (t.points i₂) (t.points i₃)))⁻¹ / 2) •
+    ((o).rotation (π / 2 : ℝ) (t.points i₃ -ᵥ t.points i₁)) +ᵥ
+    midpoint ℝ (t.points i₁) (t.points i₃) = t.circumcenter :=
+sphere.inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_center
+  (t.mem_circumsphere _) (t.mem_circumsphere _) (t.mem_circumsphere _)
+  (t.independent.injective.ne h₁₂) (t.independent.injective.ne h₁₃) (t.independent.injective.ne h₂₃)
+
+/-- The circumradius of a triangle may be expressed explicitly as half the length of a side
+divided by the absolute value of the sine of the angle at the third point (a version of the law
+of sines or sine rule). -/
+lemma dist_div_sin_oangle_div_two_eq_circumradius (t : triangle ℝ P) {i₁ i₂ i₃ : fin 3}
+  (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  dist (t.points i₁) (t.points i₃) /
+    |real.angle.sin (∡ (t.points i₁) (t.points i₂) (t.points i₃))| / 2 = t.circumradius :=
+sphere.dist_div_sin_oangle_div_two_eq_radius (t.mem_circumsphere _) (t.mem_circumsphere _)
+  (t.mem_circumsphere _) (t.independent.injective.ne h₁₂) (t.independent.injective.ne h₁₃)
+  (t.independent.injective.ne h₂₃)
+
+/-- Twice the circumradius of a triangle may be expressed explicitly as the length of a side
+divided by the absolute value of the sine of the angle at the third point (a version of the law
+of sines or sine rule). -/
+lemma dist_div_sin_oangle_eq_two_mul_circumradius (t : triangle ℝ P) {i₁ i₂ i₃ : fin 3}
+  (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  dist (t.points i₁) (t.points i₃) /
+    |real.angle.sin (∡ (t.points i₁) (t.points i₂) (t.points i₃))| = 2 * t.circumradius :=
+sphere.dist_div_sin_oangle_eq_two_mul_radius (t.mem_circumsphere _) (t.mem_circumsphere _)
+  (t.mem_circumsphere _) (t.independent.injective.ne h₁₂) (t.independent.injective.ne h₁₃)
+  (t.independent.injective.ne h₂₃)
+
+/-- The circumsphere of a triangle may be expressed explicitly in terms of two points and the
+angle at the third point. -/
+lemma circumsphere_eq_of_dist_of_oangle (t : triangle ℝ P) {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
+  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  t.circumsphere = ⟨((real.angle.tan (∡ (t.points i₁) (t.points i₂) (t.points i₃)))⁻¹ / 2) •
+      ((o).rotation (π / 2 : ℝ) (t.points i₃ -ᵥ t.points i₁)) +ᵥ
+      midpoint ℝ (t.points i₁) (t.points i₃),
+    dist (t.points i₁) (t.points i₃) /
+      |real.angle.sin (∡ (t.points i₁) (t.points i₂) (t.points i₃))| / 2⟩ :=
+t.circumsphere.ext _
+  (t.inv_tan_div_two_smul_rotation_pi_div_two_vadd_midpoint_eq_circumcenter h₁₂ h₁₃ h₂₃).symm
+  (t.dist_div_sin_oangle_div_two_eq_circumradius h₁₂ h₁₃ h₂₃).symm
+
+/-- If two triangles have two points the same, and twice the angle at the third point the same,
+they have the same circumsphere. -/
+lemma circumsphere_eq_circumsphere_of_eq_of_eq_of_two_zsmul_oangle_eq {t₁ t₂ : triangle ℝ P}
+  {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃)
+  (h₁ : t₁.points i₁ = t₂.points i₁) (h₃ : t₁.points i₃ = t₂.points i₃)
+  (h₂ : (2 : ℤ) • ∡ (t₁.points i₁) (t₁.points i₂) (t₁.points i₃) =
+    (2 : ℤ) • ∡ (t₂.points i₁) (t₂.points i₂) (t₂.points i₃)) :
+  t₁.circumsphere = t₂.circumsphere :=
+begin
+  rw [t₁.circumsphere_eq_of_dist_of_oangle h₁₂ h₁₃ h₂₃,
+      t₂.circumsphere_eq_of_dist_of_oangle h₁₂ h₁₃ h₂₃],
+  congrm ⟨((_ : ℝ)⁻¹ / 2) • _ +ᵥ _, _ / _ / 2⟩,
+  { exact real.angle.tan_eq_of_two_zsmul_eq h₂ },
+  { rw [h₁, h₃] },
+  { rw [h₁, h₃] },
+  { rw [h₁, h₃] },
+  { exact real.angle.abs_sin_eq_of_two_zsmul_eq h₂ }
+end
+
+/-- Given a triangle, and a fourth point such that twice the angle between two points of the
+triangle at that fourth point equals twice the third angle of the triangle, the fourth point
+lies in the circumsphere of the triangle. -/
+lemma mem_circumsphere_of_two_zsmul_oangle_eq {t : triangle ℝ P} {p : P} {i₁ i₂ i₃ : fin 3}
+  (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃)
+  (h : (2 : ℤ) • ∡ (t.points i₁) p (t.points i₃) =
+    (2 : ℤ) • ∡ (t.points i₁) (t.points i₂) (t.points i₃)) : p ∈ t.circumsphere :=
+begin
+  let t'p : fin 3 → P := function.update t.points i₂ p,
+  have h₁ : t'p i₁ = t.points i₁, { simp [t'p, h₁₂] },
+  have h₂ : t'p i₂ = p, { simp [t'p] },
+  have h₃ : t'p i₃ = t.points i₃, { simp [t'p, h₂₃.symm] },
+  have ha : affine_independent ℝ t'p,
+  { rw [affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃, h₁, h₂, h₃,
+        collinear_iff_of_two_zsmul_oangle_eq h,
+        ←affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃],
+    exact t.independent },
+  let t' : triangle ℝ P := ⟨t'p, ha⟩,
+  have h₁' : t'.points i₁ = t.points i₁ := h₁,
+  have h₂' : t'.points i₂ = p := h₂,
+  have h₃' : t'.points i₃ = t.points i₃ := h₃,
+  have h' : (2 : ℤ) • ∡ (t'.points i₁) (t'.points i₂) (t'.points i₃) =
+    (2 : ℤ) • ∡ (t.points i₁) (t.points i₂) (t.points i₃), { rwa [h₁', h₂', h₃'] },
+  rw [←circumsphere_eq_circumsphere_of_eq_of_eq_of_two_zsmul_oangle_eq h₁₂ h₁₃ h₂₃ h₁' h₃' h',
+      ←h₂'],
+  exact simplex.mem_circumsphere _ _
+end
+
+end triangle
+end affine
+
+namespace euclidean_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+  [hd2 : fact (finrank ℝ V = 2)] [module.oriented ℝ V (fin 2)]
+include hd2
+
+local notation `o` := module.oriented.positive_orientation
+
+/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
+add to π", for oriented angles mod π. -/
+lemma cospherical_of_two_zsmul_oangle_eq_of_not_collinear {p₁ p₂ p₃ p₄ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) (hn : ¬collinear ℝ ({p₁, p₂, p₄} : set P)) :
+  cospherical ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  have hn' : ¬collinear ℝ ({p₁, p₃, p₄} : set P), { rwa ←collinear_iff_of_two_zsmul_oangle_eq h },
+  let t₁ : affine.triangle ℝ P := ⟨![p₁, p₂, p₄], affine_independent_iff_not_collinear_set.2 hn⟩,
+  let t₂ : affine.triangle ℝ P := ⟨![p₁, p₃, p₄], affine_independent_iff_not_collinear_set.2 hn'⟩,
+  rw cospherical_iff_exists_sphere,
+  refine ⟨t₂.circumsphere, _⟩,
+  simp_rw [set.insert_subset, set.singleton_subset_iff],
+  refine ⟨t₂.mem_circumsphere 0, _, t₂.mem_circumsphere 1, t₂.mem_circumsphere 2⟩,
+  rw affine.triangle.circumsphere_eq_circumsphere_of_eq_of_eq_of_two_zsmul_oangle_eq
+    (dec_trivial : (0 : fin 3) ≠ 1) (dec_trivial: (0 : fin 3) ≠ 2) dec_trivial
+    (show t₂.points 0 = t₁.points 0, from rfl) rfl h.symm,
+  exact t₁.mem_circumsphere 1
+end
+
+/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
+add to π", for oriented angles mod π, with a "concyclic" conclusion. -/
+lemma concyclic_of_two_zsmul_oangle_eq_of_not_collinear {p₁ p₂ p₃ p₄ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) (hn : ¬collinear ℝ ({p₁, p₂, p₄} : set P)) :
+  concyclic ({p₁, p₂, p₃, p₄} : set P) :=
+⟨cospherical_of_two_zsmul_oangle_eq_of_not_collinear h hn, coplanar_of_fact_finrank_eq_two _⟩
+
+/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
+add to π", for oriented angles mod π, with a "cospherical or collinear" conclusion. -/
+lemma cospherical_or_collinear_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) :
+  cospherical ({p₁, p₂, p₃, p₄} : set P) ∨ collinear ℝ ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  by_cases hc : collinear ℝ ({p₁, p₂, p₄} : set P),
+  { by_cases he : p₁ = p₄,
+    { rw [he, set.insert_eq_self.2 (set.mem_insert_of_mem _ (set.mem_insert_of_mem _
+            (set.mem_singleton _)))],
+      by_cases hl : collinear ℝ ({p₂, p₃, p₄} : set P), { exact or.inr hl },
+      rw or_iff_left hl,
+      let t : affine.triangle ℝ P := ⟨![p₂, p₃, p₄], affine_independent_iff_not_collinear_set.2 hl⟩,
+      rw cospherical_iff_exists_sphere,
+      refine ⟨t.circumsphere, _⟩,
+      simp_rw [set.insert_subset, set.singleton_subset_iff],
+      exact ⟨t.mem_circumsphere 0, t.mem_circumsphere 1, t.mem_circumsphere 2⟩ },
+    have hc' : collinear ℝ ({p₁, p₃, p₄} : set P),
+    { rwa [←collinear_iff_of_two_zsmul_oangle_eq h] },
+    refine or.inr _,
+    rw set.insert_comm p₁ p₂ at hc,
+    rwa [set.insert_comm p₁ p₂, hc'.collinear_insert_iff_of_ne (set.mem_insert _ _)
+           (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_singleton _))) he] },
+  { exact or.inl (cospherical_of_two_zsmul_oangle_eq_of_not_collinear h hc) }
+end
+
+/-- Converse of "angles in same segment are equal" and "opposite angles of a cyclic quadrilateral
+add to π", for oriented angles mod π, with a "concyclic or collinear" conclusion. -/
+lemma concyclic_or_collinear_of_two_zsmul_oangle_eq {p₁ p₂ p₃ p₄ : P}
+  (h : (2 : ℤ) • ∡ p₁ p₂ p₄ = (2 : ℤ) • ∡ p₁ p₃ p₄) :
+  concyclic ({p₁, p₂, p₃, p₄} : set P) ∨ collinear ℝ ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  rcases cospherical_or_collinear_of_two_zsmul_oangle_eq h with hc | hc,
+  { exact or.inl ⟨hc, coplanar_of_fact_finrank_eq_two _⟩ },
+  { exact or.inr hc }
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/angle/unoriented/affine.lean b/src/geometry/euclidean/angle/unoriented/affine.lean
new file mode 100644
index 0000000000000..8a91034cff029
--- /dev/null
+++ b/src/geometry/euclidean/angle/unoriented/affine.lean
@@ -0,0 +1,493 @@
+/-
+Copyright (c) 2020 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers, Manuel Candales
+-/
+import analysis.convex.between
+import geometry.euclidean.angle.unoriented.basic
+
+/-!
+# Angles between points
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines unoriented angles in Euclidean affine spaces.
+
+## Main definitions
+
+* `euclidean_geometry.angle`, with notation `∠`, is the undirected angle determined by three
+  points.
+
+-/
+
+noncomputable theory
+open_locale big_operators
+open_locale real
+open_locale real_inner_product_space
+
+namespace euclidean_geometry
+
+open inner_product_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- The undirected angle at `p2` between the line segments to `p1` and
+`p3`. If either of those points equals `p2`, this is π/2. Use
+`open_locale euclidean_geometry` to access the `∠ p1 p2 p3`
+notation. -/
+def angle (p1 p2 p3 : P) : ℝ := angle (p1 -ᵥ p2 : V) (p3 -ᵥ p2)
+
+localized "notation (name := angle) `∠` := euclidean_geometry.angle" in euclidean_geometry
+
+lemma continuous_at_angle {x : P × P × P} (hx12 : x.1 ≠ x.2.1) (hx32 : x.2.2 ≠ x.2.1) :
+  continuous_at (λ y : P × P × P, ∠ y.1 y.2.1 y.2.2) x :=
+begin
+  let f : P × P × P → V × V := λ y, (y.1 -ᵥ y.2.1, y.2.2 -ᵥ y.2.1),
+  have hf1 : (f x).1 ≠ 0, by simp [hx12],
+  have hf2 : (f x).2 ≠ 0, by simp [hx32],
+  exact (inner_product_geometry.continuous_at_angle hf1 hf2).comp
+    ((continuous_fst.vsub continuous_snd.fst).prod_mk
+      (continuous_snd.snd.vsub continuous_snd.fst)).continuous_at
+end
+
+@[simp] lemma _root_.affine_isometry.angle_map {V₂ P₂ : Type*}
+  [normed_add_comm_group V₂] [inner_product_space ℝ V₂]
+  [metric_space P₂] [normed_add_torsor V₂ P₂] (f : P →ᵃⁱ[ℝ] P₂) (p₁ p₂ p₃ : P) :
+  ∠ (f p₁) (f p₂) (f p₃) = ∠ p₁ p₂ p₃ :=
+by simp_rw [angle, ←affine_isometry.map_vsub, linear_isometry.angle_map]
+
+@[simp, norm_cast] lemma _root_.affine_subspace.angle_coe {s : affine_subspace ℝ P}
+  (p₁ p₂ p₃ : s) :
+  by haveI : nonempty s := ⟨p₁⟩; exact ∠ (p₁ : P) (p₂ : P) (p₃ : P) = ∠ p₁ p₂ p₃ :=
+by haveI : nonempty s := ⟨p₁⟩; exact s.subtypeₐᵢ.angle_map p₁ p₂ p₃
+
+/-- Angles are translation invariant -/
+@[simp] lemma angle_const_vadd (v : V) (p₁ p₂ p₃ : P) :
+  ∠ (v +ᵥ p₁) (v +ᵥ p₂) (v +ᵥ p₃) = ∠ p₁ p₂ p₃ :=
+(affine_isometry_equiv.const_vadd ℝ P v).to_affine_isometry.angle_map _ _ _
+
+/-- Angles are translation invariant -/
+@[simp] lemma angle_vadd_const (v₁ v₂ v₃ : V) (p : P) :
+  ∠ (v₁ +ᵥ p) (v₂ +ᵥ p) (v₃ +ᵥ p) = ∠ v₁ v₂ v₃ :=
+(affine_isometry_equiv.vadd_const ℝ p).to_affine_isometry.angle_map _ _ _
+
+/-- Angles are translation invariant -/
+@[simp] lemma angle_const_vsub (p p₁ p₂ p₃ : P) : ∠ (p -ᵥ p₁) (p -ᵥ p₂) (p -ᵥ p₃) = ∠ p₁ p₂ p₃ :=
+(affine_isometry_equiv.const_vsub ℝ p).to_affine_isometry.angle_map _ _ _
+
+/-- Angles are translation invariant -/
+@[simp] lemma angle_vsub_const (p₁ p₂ p₃ p : P) : ∠ (p₁ -ᵥ p) (p₂ -ᵥ p) (p₃ -ᵥ p) = ∠ p₁ p₂ p₃ :=
+(affine_isometry_equiv.vadd_const ℝ p).symm.to_affine_isometry.angle_map _ _ _
+
+/-- Angles in a vector space are translation invariant -/
+@[simp] lemma angle_add_const (v₁ v₂ v₃ : V) (v : V) : ∠ (v₁ + v) (v₂ + v) (v₃ + v) = ∠ v₁ v₂ v₃ :=
+angle_vadd_const _ _ _ _
+
+/-- Angles in a vector space are translation invariant -/
+@[simp] lemma angle_const_add (v : V) (v₁ v₂ v₃ : V) : ∠ (v + v₁) (v + v₂) (v + v₃) = ∠ v₁ v₂ v₃ :=
+angle_const_vadd _ _ _ _
+
+/-- Angles in a vector space are translation invariant -/
+@[simp] lemma angle_sub_const (v₁ v₂ v₃ : V) (v : V) : ∠ (v₁ - v) (v₂ - v) (v₃ - v) = ∠ v₁ v₂ v₃ :=
+by simpa only [vsub_eq_sub] using angle_vsub_const v₁ v₂ v₃ v
+
+/-- Angles in a vector space are invariant to inversion -/
+@[simp] lemma angle_const_sub (v : V) (v₁ v₂ v₃ : V) : ∠ (v - v₁) (v - v₂) (v - v₃) = ∠ v₁ v₂ v₃ :=
+by simpa only [vsub_eq_sub] using angle_const_vsub _ _ _ _
+
+/-- Angles in a vector space are invariant to inversion -/
+@[simp] lemma angle_neg (v₁ v₂ v₃ : V) : ∠ (-v₁) (-v₂) (-v₃) = ∠ v₁ v₂ v₃ :=
+by simpa only [zero_sub] using angle_const_sub 0 v₁ v₂ v₃
+
+/-- The angle at a point does not depend on the order of the other two
+points. -/
+lemma angle_comm (p1 p2 p3 : P) : ∠ p1 p2 p3 = ∠ p3 p2 p1 :=
+angle_comm _ _
+
+/-- The angle at a point is nonnegative. -/
+lemma angle_nonneg (p1 p2 p3 : P) : 0 ≤ ∠ p1 p2 p3 :=
+angle_nonneg _ _
+
+/-- The angle at a point is at most π. -/
+lemma angle_le_pi (p1 p2 p3 : P) : ∠ p1 p2 p3 ≤ π :=
+angle_le_pi _ _
+
+/-- The angle ∠AAB at a point. -/
+lemma angle_eq_left (p1 p2 : P) : ∠ p1 p1 p2 = π / 2 :=
+begin
+  unfold angle,
+  rw vsub_self,
+  exact angle_zero_left _
+end
+
+/-- The angle ∠ABB at a point. -/
+lemma angle_eq_right (p1 p2 : P) : ∠ p1 p2 p2 = π / 2 :=
+by rw [angle_comm, angle_eq_left]
+
+/-- The angle ∠ABA at a point. -/
+lemma angle_eq_of_ne {p1 p2 : P} (h : p1 ≠ p2) : ∠ p1 p2 p1 = 0 :=
+angle_self (λ he, h (vsub_eq_zero_iff_eq.1 he))
+
+/-- If the angle ∠ABC at a point is π, the angle ∠BAC is 0. -/
+lemma angle_eq_zero_of_angle_eq_pi_left {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
+  ∠ p2 p1 p3 = 0 :=
+begin
+  unfold angle at h,
+  rw angle_eq_pi_iff at h,
+  rcases h with ⟨hp1p2, ⟨r, ⟨hr, hpr⟩⟩⟩,
+  unfold angle,
+  rw angle_eq_zero_iff,
+  rw [←neg_vsub_eq_vsub_rev, neg_ne_zero] at hp1p2,
+  use [hp1p2, -r + 1, add_pos (neg_pos_of_neg hr) zero_lt_one],
+  rw [add_smul, ←neg_vsub_eq_vsub_rev p1 p2, smul_neg],
+  simp [←hpr]
+end
+
+/-- If the angle ∠ABC at a point is π, the angle ∠BCA is 0. -/
+lemma angle_eq_zero_of_angle_eq_pi_right {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
+  ∠ p2 p3 p1 = 0 :=
+begin
+  rw angle_comm at h,
+  exact angle_eq_zero_of_angle_eq_pi_left h
+end
+
+/-- If ∠BCD = π, then ∠ABC = ∠ABD. -/
+lemma angle_eq_angle_of_angle_eq_pi (p1 : P) {p2 p3 p4 : P} (h : ∠ p2 p3 p4 = π) :
+  ∠ p1 p2 p3 = ∠ p1 p2 p4 :=
+begin
+  unfold angle at *,
+  rcases angle_eq_pi_iff.1 h with ⟨hp2p3, ⟨r, ⟨hr, hpr⟩⟩⟩,
+  rw [eq_comm],
+  convert angle_smul_right_of_pos (p1 -ᵥ p2) (p3 -ᵥ p2) (add_pos (neg_pos_of_neg hr) zero_lt_one),
+  rw [add_smul, ← neg_vsub_eq_vsub_rev p2 p3, smul_neg, neg_smul, ← hpr],
+  simp
+end
+
+/-- If ∠BCD = π, then ∠ACB + ∠ACD = π. -/
+lemma angle_add_angle_eq_pi_of_angle_eq_pi (p1 : P) {p2 p3 p4 : P} (h : ∠ p2 p3 p4 = π) :
+  ∠ p1 p3 p2 + ∠ p1 p3 p4 = π :=
+begin
+  unfold angle at h,
+  rw [angle_comm p1 p3 p2, angle_comm p1 p3 p4],
+  unfold angle,
+  exact angle_add_angle_eq_pi_of_angle_eq_pi _ h
+end
+
+/-- Vertical Angles Theorem: angles opposite each other, formed by two intersecting straight
+lines, are equal. -/
+lemma angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi {p1 p2 p3 p4 p5 : P}
+  (hapc : ∠ p1 p5 p3 = π) (hbpd : ∠ p2 p5 p4 = π) : ∠ p1 p5 p2 = ∠ p3 p5 p4 :=
+by linarith [angle_add_angle_eq_pi_of_angle_eq_pi p1 hbpd, angle_comm p4 p5 p1,
+             angle_add_angle_eq_pi_of_angle_eq_pi p4 hapc, angle_comm p4 p5 p3]
+
+/-- If ∠ABC = π then dist A B ≠ 0. -/
+lemma left_dist_ne_zero_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) : dist p1 p2 ≠ 0 :=
+begin
+  by_contra heq,
+  rw [dist_eq_zero] at heq,
+  rw [heq, angle_eq_left] at h,
+  exact real.pi_ne_zero (by linarith),
+end
+
+/-- If ∠ABC = π then dist C B ≠ 0. -/
+lemma right_dist_ne_zero_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) : dist p3 p2 ≠ 0 :=
+left_dist_ne_zero_of_angle_eq_pi $ (angle_comm _ _ _).trans h
+
+/-- If ∠ABC = π, then (dist A C) = (dist A B) + (dist B C). -/
+lemma dist_eq_add_dist_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
+  dist p1 p3 = dist p1 p2 + dist p3 p2 :=
+begin
+  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
+  exact norm_sub_eq_add_norm_of_angle_eq_pi h,
+end
+
+/-- If A ≠ B and C ≠ B then ∠ABC = π if and only if (dist A C) = (dist A B) + (dist B C). -/
+lemma dist_eq_add_dist_iff_angle_eq_pi {p1 p2 p3 : P} (hp1p2 : p1 ≠ p2) (hp3p2 : p3 ≠ p2) :
+  dist p1 p3 = dist p1 p2 + dist p3 p2 ↔ ∠ p1 p2 p3 = π :=
+begin
+  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
+  exact norm_sub_eq_add_norm_iff_angle_eq_pi
+    ((λ he, hp1p2 (vsub_eq_zero_iff_eq.1 he))) (λ he, hp3p2 (vsub_eq_zero_iff_eq.1 he)),
+end
+
+/-- If ∠ABC = 0, then (dist A C) = abs ((dist A B) - (dist B C)). -/
+lemma dist_eq_abs_sub_dist_of_angle_eq_zero {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = 0) :
+  (dist p1 p3) = |(dist p1 p2) - (dist p3 p2)| :=
+begin
+  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
+  exact norm_sub_eq_abs_sub_norm_of_angle_eq_zero h,
+end
+
+/-- If A ≠ B and C ≠ B then ∠ABC = 0 if and only if (dist A C) = abs ((dist A B) - (dist B C)). -/
+lemma dist_eq_abs_sub_dist_iff_angle_eq_zero {p1 p2 p3 : P} (hp1p2 : p1 ≠ p2) (hp3p2 : p3 ≠ p2) :
+  (dist p1 p3) = |(dist p1 p2) - (dist p3 p2)| ↔ ∠ p1 p2 p3 = 0 :=
+begin
+  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
+  exact norm_sub_eq_abs_sub_norm_iff_angle_eq_zero
+    ((λ he, hp1p2 (vsub_eq_zero_iff_eq.1 he))) (λ he, hp3p2 (vsub_eq_zero_iff_eq.1 he)),
+end
+
+/-- If M is the midpoint of the segment AB, then ∠AMB = π. -/
+lemma angle_midpoint_eq_pi (p1 p2 : P) (hp1p2 : p1 ≠ p2) : ∠ p1 (midpoint ℝ p1 p2) p2 = π :=
+have p2 -ᵥ midpoint ℝ p1 p2 = -(p1 -ᵥ midpoint ℝ p1 p2), by { rw neg_vsub_eq_vsub_rev, simp },
+by simp [angle, this, hp1p2, -zero_lt_one]
+
+/-- If M is the midpoint of the segment AB and C is the same distance from A as it is from B
+then ∠CMA = π / 2. -/
+lemma angle_left_midpoint_eq_pi_div_two_of_dist_eq {p1 p2 p3 : P} (h : dist p3 p1 = dist p3 p2) :
+  ∠ p3 (midpoint ℝ p1 p2) p1 = π / 2 :=
+begin
+  let m : P := midpoint ℝ p1 p2,
+  have h1 : p3 -ᵥ p1 = (p3 -ᵥ m) - (p1 -ᵥ m) := (vsub_sub_vsub_cancel_right p3 p1 m).symm,
+  have h2 : p3 -ᵥ p2 = (p3 -ᵥ m) + (p1 -ᵥ m),
+  { rw [left_vsub_midpoint, ← midpoint_vsub_right, vsub_add_vsub_cancel] },
+  rw [dist_eq_norm_vsub V p3 p1, dist_eq_norm_vsub V p3 p2, h1, h2] at h,
+  exact (norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (p3 -ᵥ m) (p1 -ᵥ m)).mp h.symm,
+end
+
+/-- If M is the midpoint of the segment AB and C is the same distance from A as it is from B
+then ∠CMB = π / 2. -/
+lemma angle_right_midpoint_eq_pi_div_two_of_dist_eq {p1 p2 p3 : P} (h : dist p3 p1 = dist p3 p2) :
+  ∠ p3 (midpoint ℝ p1 p2) p2 = π / 2 :=
+by rw [midpoint_comm p1 p2, angle_left_midpoint_eq_pi_div_two_of_dist_eq h.symm]
+
+/-- If the second of three points is strictly between the other two, the angle at that point
+is π. -/
+lemma _root_.sbtw.angle₁₂₃_eq_pi {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∠ p₁ p₂ p₃ = π :=
+begin
+  rw [angle, angle_eq_pi_iff],
+  rcases h with ⟨⟨r, ⟨hr0, hr1⟩, hp₂⟩, hp₂p₁, hp₂p₃⟩,
+  refine ⟨vsub_ne_zero.2 hp₂p₁.symm, -(1 - r) / r, _⟩,
+  have hr0' : r ≠ 0,
+  { rintro rfl,
+    rw ←hp₂ at hp₂p₁,
+    simpa using hp₂p₁ },
+  have hr1' : r ≠ 1,
+  { rintro rfl,
+    rw ←hp₂ at hp₂p₃,
+    simpa using hp₂p₃ },
+  replace hr0 := hr0.lt_of_ne hr0'.symm,
+  replace hr1 := hr1.lt_of_ne hr1',
+  refine ⟨div_neg_of_neg_of_pos (left.neg_neg_iff.2 (sub_pos.2 hr1)) hr0, _⟩,
+  rw [←hp₂, affine_map.line_map_apply, vsub_vadd_eq_vsub_sub, vsub_vadd_eq_vsub_sub, vsub_self,
+      zero_sub, smul_neg, smul_smul, div_mul_cancel _ hr0', neg_smul, neg_neg, sub_eq_iff_eq_add,
+      ←add_smul, sub_add_cancel, one_smul]
+end
+
+/-- If the second of three points is strictly between the other two, the angle at that point
+(reversed) is π. -/
+lemma _root_.sbtw.angle₃₂₁_eq_pi {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∠ p₃ p₂ p₁ = π :=
+by rw [←h.angle₁₂₃_eq_pi, angle_comm]
+
+/-- The angle between three points is π if and only if the second point is strictly between the
+other two. -/
+lemma angle_eq_pi_iff_sbtw {p₁ p₂ p₃ : P} : ∠ p₁ p₂ p₃ = π ↔ sbtw ℝ p₁ p₂ p₃ :=
+begin
+  refine ⟨_, λ h, h.angle₁₂₃_eq_pi⟩,
+  rw [angle, angle_eq_pi_iff],
+  rintro ⟨hp₁p₂, r, hr, hp₃p₂⟩,
+  refine ⟨⟨1 / (1 - r),
+           ⟨div_nonneg zero_le_one (sub_nonneg.2 (hr.le.trans zero_le_one)),
+            (div_le_one (sub_pos.2 (hr.trans zero_lt_one))).2 ((le_sub_self_iff 1).2 hr.le)⟩, _⟩,
+          (vsub_ne_zero.1 hp₁p₂).symm, _⟩,
+  { rw ←eq_vadd_iff_vsub_eq at hp₃p₂,
+    rw [affine_map.line_map_apply, hp₃p₂, vadd_vsub_assoc, ←neg_vsub_eq_vsub_rev p₂ p₁,
+        smul_neg, ←neg_smul, smul_add, smul_smul, ←add_smul, eq_comm, eq_vadd_iff_vsub_eq],
+    convert (one_smul ℝ (p₂ -ᵥ p₁)).symm,
+    field_simp [(sub_pos.2 (hr.trans zero_lt_one)).ne.symm],
+    abel },
+  { rw [ne_comm, ←@vsub_ne_zero V, hp₃p₂, smul_ne_zero_iff],
+    exact ⟨hr.ne, hp₁p₂⟩ }
+end
+
+/-- If the second of three points is weakly between the other two, and not equal to the first,
+the angle at the first point is zero. -/
+lemma _root_.wbtw.angle₂₁₃_eq_zero_of_ne {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) (hp₂p₁ : p₂ ≠ p₁) :
+  ∠ p₂ p₁ p₃ = 0 :=
+begin
+  rw [angle, angle_eq_zero_iff],
+  rcases h with ⟨r, ⟨hr0, hr1⟩, rfl⟩,
+  have hr0' : r ≠ 0, { rintro rfl, simpa using hp₂p₁ },
+  replace hr0 := hr0.lt_of_ne hr0'.symm,
+  refine ⟨vsub_ne_zero.2 hp₂p₁, r⁻¹, inv_pos.2 hr0, _⟩,
+  rw [affine_map.line_map_apply, vadd_vsub_assoc, vsub_self, add_zero, smul_smul,
+      inv_mul_cancel hr0', one_smul]
+end
+
+/-- If the second of three points is strictly between the other two, the angle at the first point
+is zero. -/
+lemma _root_.sbtw.angle₂₁₃_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∠ p₂ p₁ p₃ = 0 :=
+h.wbtw.angle₂₁₃_eq_zero_of_ne h.ne_left
+
+/-- If the second of three points is weakly between the other two, and not equal to the first,
+the angle at the first point (reversed) is zero. -/
+lemma _root_.wbtw.angle₃₁₂_eq_zero_of_ne {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) (hp₂p₁ : p₂ ≠ p₁) :
+  ∠ p₃ p₁ p₂ = 0 :=
+by rw [←h.angle₂₁₃_eq_zero_of_ne hp₂p₁, angle_comm]
+
+/-- If the second of three points is strictly between the other two, the angle at the first point
+(reversed) is zero. -/
+lemma _root_.sbtw.angle₃₁₂_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∠ p₃ p₁ p₂ = 0 :=
+h.wbtw.angle₃₁₂_eq_zero_of_ne h.ne_left
+
+/-- If the second of three points is weakly between the other two, and not equal to the third,
+the angle at the third point is zero. -/
+lemma _root_.wbtw.angle₂₃₁_eq_zero_of_ne {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) (hp₂p₃ : p₂ ≠ p₃) :
+  ∠ p₂ p₃ p₁ = 0 :=
+h.symm.angle₂₁₃_eq_zero_of_ne hp₂p₃
+
+/-- If the second of three points is strictly between the other two, the angle at the third point
+is zero. -/
+lemma _root_.sbtw.angle₂₃₁_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∠ p₂ p₃ p₁ = 0 :=
+h.wbtw.angle₂₃₁_eq_zero_of_ne h.ne_right
+
+/-- If the second of three points is weakly between the other two, and not equal to the third,
+the angle at the third point (reversed) is zero. -/
+lemma _root_.wbtw.angle₁₃₂_eq_zero_of_ne {p₁ p₂ p₃ : P} (h : wbtw ℝ p₁ p₂ p₃) (hp₂p₃ : p₂ ≠ p₃) :
+  ∠ p₁ p₃ p₂ = 0 :=
+h.symm.angle₃₁₂_eq_zero_of_ne hp₂p₃
+
+/-- If the second of three points is strictly between the other two, the angle at the third point
+(reversed) is zero. -/
+lemma _root_.sbtw.angle₁₃₂_eq_zero {p₁ p₂ p₃ : P} (h : sbtw ℝ p₁ p₂ p₃) : ∠ p₁ p₃ p₂ = 0 :=
+h.wbtw.angle₁₃₂_eq_zero_of_ne h.ne_right
+
+/-- The angle between three points is zero if and only if one of the first and third points is
+weakly between the other two, and not equal to the second. -/
+lemma angle_eq_zero_iff_ne_and_wbtw {p₁ p₂ p₃ : P} :
+  ∠ p₁ p₂ p₃ = 0 ↔ (p₁ ≠ p₂ ∧ wbtw ℝ p₂ p₁ p₃) ∨ (p₃ ≠ p₂ ∧ wbtw ℝ p₂ p₃ p₁) :=
+begin
+  split,
+  { rw [angle, angle_eq_zero_iff],
+    rintro ⟨hp₁p₂, r, hr0, hp₃p₂⟩,
+    rcases le_or_lt 1 r with hr1 | hr1,
+    { refine or.inl ⟨vsub_ne_zero.1 hp₁p₂, r⁻¹, ⟨(inv_pos.2 hr0).le, inv_le_one hr1⟩, _⟩,
+      rw [affine_map.line_map_apply, hp₃p₂, smul_smul, inv_mul_cancel hr0.ne.symm, one_smul,
+          vsub_vadd] },
+    { refine or.inr ⟨_, r, ⟨hr0.le, hr1.le⟩, _⟩,
+      { rw [←@vsub_ne_zero V, hp₃p₂, smul_ne_zero_iff],
+        exact ⟨hr0.ne.symm, hp₁p₂⟩ },
+      { rw [affine_map.line_map_apply, ←hp₃p₂, vsub_vadd] } } },
+  { rintro (⟨hp₁p₂, h⟩ | ⟨hp₃p₂, h⟩),
+    { exact h.angle₂₁₃_eq_zero_of_ne hp₁p₂ },
+    { exact h.angle₃₁₂_eq_zero_of_ne hp₃p₂ } }
+end
+
+/-- The angle between three points is zero if and only if one of the first and third points is
+strictly between the other two, or those two points are equal but not equal to the second. -/
+lemma angle_eq_zero_iff_eq_and_ne_or_sbtw {p₁ p₂ p₃ : P} :
+  ∠ p₁ p₂ p₃ = 0 ↔ (p₁ = p₃ ∧ p₁ ≠ p₂) ∨ sbtw ℝ p₂ p₁ p₃ ∨ sbtw ℝ p₂ p₃ p₁ :=
+begin
+  rw angle_eq_zero_iff_ne_and_wbtw,
+  by_cases hp₁p₂ : p₁ = p₂, { simp [hp₁p₂] },
+  by_cases hp₁p₃ : p₁ = p₃, { simp [hp₁p₃] },
+  by_cases hp₃p₂ : p₃ = p₂, { simp [hp₃p₂] },
+  simp [hp₁p₂, hp₁p₃, ne.symm hp₁p₃, sbtw, hp₃p₂]
+end
+
+/-- Three points are collinear if and only if the first or third point equals the second or the
+angle between them is 0 or π. -/
+lemma collinear_iff_eq_or_eq_or_angle_eq_zero_or_angle_eq_pi {p₁ p₂ p₃ : P} :
+  collinear ℝ ({p₁, p₂, p₃} : set P) ↔ p₁ = p₂ ∨ p₃ = p₂ ∨ ∠ p₁ p₂ p₃ = 0 ∨ ∠ p₁ p₂ p₃ = π :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { replace h := h.wbtw_or_wbtw_or_wbtw,
+    by_cases h₁₂ : p₁ = p₂, { exact or.inl h₁₂ },
+    by_cases h₃₂ : p₃ = p₂, { exact or.inr (or.inl h₃₂) },
+    rw [or_iff_right h₁₂, or_iff_right h₃₂],
+    rcases h with h | h | h,
+    { exact or.inr (angle_eq_pi_iff_sbtw.2 ⟨h, ne.symm h₁₂, ne.symm h₃₂⟩) },
+    { exact or.inl (h.angle₃₁₂_eq_zero_of_ne h₃₂) },
+    { exact or.inl (h.angle₂₃₁_eq_zero_of_ne h₁₂) } },
+  { rcases h with rfl | rfl | h | h,
+    { simpa using collinear_pair ℝ p₁ p₃ },
+    { simpa using collinear_pair ℝ p₁ p₃ },
+    { rw angle_eq_zero_iff_ne_and_wbtw at h,
+      rcases h with ⟨-, h⟩ | ⟨-, h⟩,
+      { rw set.insert_comm, exact h.collinear },
+      { rw [set.insert_comm, set.pair_comm], exact h.collinear } },
+    { rw angle_eq_pi_iff_sbtw at h,
+      exact h.wbtw.collinear } }
+end
+
+/-- If the angle between three points is 0, they are collinear. -/
+lemma collinear_of_angle_eq_zero {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = 0) :
+  collinear ℝ ({p₁, p₂, p₃} : set P) :=
+collinear_iff_eq_or_eq_or_angle_eq_zero_or_angle_eq_pi.2 $ or.inr $ or.inr $ or.inl h
+
+/-- If the angle between three points is π, they are collinear. -/
+lemma collinear_of_angle_eq_pi {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π) :
+  collinear ℝ ({p₁, p₂, p₃} : set P) :=
+collinear_iff_eq_or_eq_or_angle_eq_zero_or_angle_eq_pi.2 $ or.inr $ or.inr $ or.inr h
+
+/-- If three points are not collinear, the angle between them is nonzero. -/
+lemma angle_ne_zero_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear ℝ ({p₁, p₂, p₃} : set P)) :
+  ∠ p₁ p₂ p₃ ≠ 0 :=
+mt collinear_of_angle_eq_zero h
+
+/-- If three points are not collinear, the angle between them is not π. -/
+lemma angle_ne_pi_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear ℝ ({p₁, p₂, p₃} : set P)) :
+  ∠ p₁ p₂ p₃ ≠ π :=
+mt collinear_of_angle_eq_pi h
+
+/-- If three points are not collinear, the angle between them is positive. -/
+lemma angle_pos_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear ℝ ({p₁, p₂, p₃} : set P)) :
+  0 < ∠ p₁ p₂ p₃ :=
+(angle_nonneg _ _ _).lt_of_ne (angle_ne_zero_of_not_collinear h).symm
+
+/-- If three points are not collinear, the angle between them is less than π. -/
+lemma angle_lt_pi_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear ℝ ({p₁, p₂, p₃} : set P)) :
+  ∠ p₁ p₂ p₃ < π :=
+(angle_le_pi _ _ _).lt_of_ne $ angle_ne_pi_of_not_collinear h
+
+/-- The cosine of the angle between three points is 1 if and only if the angle is 0. -/
+lemma cos_eq_one_iff_angle_eq_zero {p₁ p₂ p₃ : P} :
+  real.cos (∠ p₁ p₂ p₃) = 1 ↔ ∠ p₁ p₂ p₃ = 0 :=
+cos_eq_one_iff_angle_eq_zero
+
+/-- The cosine of the angle between three points is 0 if and only if the angle is π / 2. -/
+lemma cos_eq_zero_iff_angle_eq_pi_div_two {p₁ p₂ p₃ : P} :
+  real.cos (∠ p₁ p₂ p₃) = 0 ↔ ∠ p₁ p₂ p₃ = π / 2 :=
+cos_eq_zero_iff_angle_eq_pi_div_two
+
+/-- The cosine of the angle between three points is -1 if and only if the angle is π. -/
+lemma cos_eq_neg_one_iff_angle_eq_pi {p₁ p₂ p₃ : P} :
+  real.cos (∠ p₁ p₂ p₃) = -1 ↔ ∠ p₁ p₂ p₃ = π :=
+cos_eq_neg_one_iff_angle_eq_pi
+
+/-- The sine of the angle between three points is 0 if and only if the angle is 0 or π. -/
+lemma sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi {p₁ p₂ p₃ : P} :
+  real.sin (∠ p₁ p₂ p₃) = 0 ↔ ∠ p₁ p₂ p₃ = 0 ∨ ∠ p₁ p₂ p₃ = π :=
+sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi
+
+/-- The sine of the angle between three points is 1 if and only if the angle is π / 2. -/
+lemma sin_eq_one_iff_angle_eq_pi_div_two {p₁ p₂ p₃ : P} :
+  real.sin (∠ p₁ p₂ p₃) = 1 ↔ ∠ p₁ p₂ p₃ = π / 2 :=
+sin_eq_one_iff_angle_eq_pi_div_two
+
+/-- Three points are collinear if and only if the first or third point equals the second or
+the sine of the angle between three points is zero. -/
+lemma collinear_iff_eq_or_eq_or_sin_eq_zero {p₁ p₂ p₃ : P} :
+  collinear ℝ ({p₁, p₂, p₃} : set P) ↔ p₁ = p₂ ∨ p₃ = p₂ ∨ real.sin (∠ p₁ p₂ p₃) = 0 :=
+by rw [sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi,
+       collinear_iff_eq_or_eq_or_angle_eq_zero_or_angle_eq_pi]
+
+/-- If three points are not collinear, the sine of the angle between them is positive. -/
+lemma sin_pos_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear ℝ ({p₁, p₂, p₃} : set P)) :
+  0 < real.sin (∠ p₁ p₂ p₃) :=
+real.sin_pos_of_pos_of_lt_pi (angle_pos_of_not_collinear h) (angle_lt_pi_of_not_collinear h)
+
+/-- If three points are not collinear, the sine of the angle between them is nonzero. -/
+lemma sin_ne_zero_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear ℝ ({p₁, p₂, p₃} : set P)) :
+  real.sin (∠ p₁ p₂ p₃) ≠ 0 :=
+ne_of_gt (sin_pos_of_not_collinear h)
+
+/-- If the sine of the angle between three points is 0, they are collinear. -/
+lemma collinear_of_sin_eq_zero {p₁ p₂ p₃ : P} (h : real.sin (∠ p₁ p₂ p₃) = 0) :
+  collinear ℝ ({p₁, p₂, p₃} : set P) :=
+imp_of_not_imp_not _ _ sin_ne_zero_of_not_collinear h
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/angle/unoriented/basic.lean b/src/geometry/euclidean/angle/unoriented/basic.lean
new file mode 100644
index 0000000000000..e001f6f43dc7c
--- /dev/null
+++ b/src/geometry/euclidean/angle/unoriented/basic.lean
@@ -0,0 +1,360 @@
+/-
+Copyright (c) 2020 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers, Manuel Candales
+-/
+import analysis.inner_product_space.basic
+import analysis.special_functions.trigonometric.inverse
+
+/-!
+# Angles between vectors
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines unoriented angles in real inner product spaces.
+
+## Main definitions
+
+* `inner_product_geometry.angle` is the undirected angle between two vectors.
+
+-/
+
+assert_not_exists has_fderiv_at
+assert_not_exists conformal_at
+
+noncomputable theory
+open real set
+open_locale big_operators
+open_locale real
+open_locale real_inner_product_space
+
+namespace inner_product_geometry
+
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V] {x y : V}
+
+/-- The undirected angle between two vectors. If either vector is 0,
+this is π/2. See `orientation.oangle` for the corresponding oriented angle
+definition. -/
+def angle (x y : V) : ℝ := real.arccos (⟪x, y⟫ / (‖x‖ * ‖y‖))
+
+lemma continuous_at_angle {x : V × V} (hx1 : x.1 ≠ 0) (hx2 : x.2 ≠ 0) :
+  continuous_at (λ y : V × V, angle y.1 y.2) x :=
+real.continuous_arccos.continuous_at.comp $ continuous_inner.continuous_at.div
+  ((continuous_norm.comp continuous_fst).mul (continuous_norm.comp continuous_snd)).continuous_at
+  (by simp [hx1, hx2])
+
+lemma angle_smul_smul {c : ℝ} (hc : c ≠ 0) (x y : V) :
+  angle (c • x) (c • y) = angle x y :=
+have c * c ≠ 0, from mul_ne_zero hc hc,
+by rw [angle, angle, real_inner_smul_left, inner_smul_right, norm_smul, norm_smul, real.norm_eq_abs,
+  mul_mul_mul_comm _ (‖x‖), abs_mul_abs_self, ← mul_assoc c c, mul_div_mul_left _ _ this]
+
+@[simp] lemma _root_.linear_isometry.angle_map {E F : Type*}
+  [normed_add_comm_group E] [normed_add_comm_group F]
+  [inner_product_space ℝ E] [inner_product_space ℝ F] (f : E →ₗᵢ[ℝ] F) (u v : E) :
+  angle (f u) (f v) = angle u v :=
+by rw [angle, angle, f.inner_map_map, f.norm_map, f.norm_map]
+
+@[simp, norm_cast] lemma _root_.submodule.angle_coe {s : submodule ℝ V} (x y : s) :
+  angle (x : V) (y : V) = angle x y :=
+s.subtypeₗᵢ.angle_map x y
+
+/-- The cosine of the angle between two vectors. -/
+lemma cos_angle (x y : V) : real.cos (angle x y) = ⟪x, y⟫ / (‖x‖ * ‖y‖) :=
+real.cos_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
+                (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
+
+/-- The angle between two vectors does not depend on their order. -/
+lemma angle_comm (x y : V) : angle x y = angle y x :=
+begin
+  unfold angle,
+  rw [real_inner_comm, mul_comm]
+end
+
+/-- The angle between the negation of two vectors. -/
+@[simp] lemma angle_neg_neg (x y : V) : angle (-x) (-y) = angle x y :=
+begin
+  unfold angle,
+  rw [inner_neg_neg, norm_neg, norm_neg]
+end
+
+/-- The angle between two vectors is nonnegative. -/
+lemma angle_nonneg (x y : V) : 0 ≤ angle x y :=
+real.arccos_nonneg _
+
+/-- The angle between two vectors is at most π. -/
+lemma angle_le_pi (x y : V) : angle x y ≤ π :=
+real.arccos_le_pi _
+
+/-- The angle between a vector and the negation of another vector. -/
+lemma angle_neg_right (x y : V) : angle x (-y) = π - angle x y :=
+begin
+  unfold angle,
+  rw [←real.arccos_neg, norm_neg, inner_neg_right, neg_div]
+end
+
+/-- The angle between the negation of a vector and another vector. -/
+lemma angle_neg_left (x y : V) : angle (-x) y = π - angle x y :=
+by rw [←angle_neg_neg, neg_neg, angle_neg_right]
+
+/-- The angle between the zero vector and a vector. -/
+@[simp] lemma angle_zero_left (x : V) : angle 0 x = π / 2 :=
+begin
+  unfold angle,
+  rw [inner_zero_left, zero_div, real.arccos_zero]
+end
+
+/-- The angle between a vector and the zero vector. -/
+@[simp] lemma angle_zero_right (x : V) : angle x 0 = π / 2 :=
+begin
+  unfold angle,
+  rw [inner_zero_right, zero_div, real.arccos_zero]
+end
+
+/-- The angle between a nonzero vector and itself. -/
+@[simp] lemma angle_self {x : V} (hx : x ≠ 0) : angle x x = 0 :=
+begin
+  unfold angle,
+  rw [←real_inner_self_eq_norm_mul_norm, div_self (inner_self_ne_zero.2 hx : ⟪x, x⟫ ≠ 0),
+    real.arccos_one]
+end
+
+/-- The angle between a nonzero vector and its negation. -/
+@[simp] lemma angle_self_neg_of_nonzero {x : V} (hx : x ≠ 0) : angle x (-x) = π :=
+by rw [angle_neg_right, angle_self hx, sub_zero]
+
+/-- The angle between the negation of a nonzero vector and that
+vector. -/
+@[simp] lemma angle_neg_self_of_nonzero {x : V} (hx : x ≠ 0) : angle (-x) x = π :=
+by rw [angle_comm, angle_self_neg_of_nonzero hx]
+
+/-- The angle between a vector and a positive multiple of a vector. -/
+@[simp] lemma angle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
+  angle x (r • y) = angle x y :=
+begin
+  unfold angle,
+  rw [inner_smul_right, norm_smul, real.norm_eq_abs, abs_of_nonneg (le_of_lt hr), ←mul_assoc,
+      mul_comm _ r, mul_assoc, mul_div_mul_left _ _ (ne_of_gt hr)]
+end
+
+/-- The angle between a positive multiple of a vector and a vector. -/
+@[simp] lemma angle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
+  angle (r • x) y = angle x y :=
+by rw [angle_comm, angle_smul_right_of_pos y x hr, angle_comm]
+
+/-- The angle between a vector and a negative multiple of a vector. -/
+@[simp] lemma angle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
+  angle x (r • y) = angle x (-y) :=
+by rw [←neg_neg r, neg_smul, angle_neg_right, angle_smul_right_of_pos x y (neg_pos_of_neg hr),
+       angle_neg_right]
+
+/-- The angle between a negative multiple of a vector and a vector. -/
+@[simp] lemma angle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
+  angle (r • x) y = angle (-x) y :=
+by rw [angle_comm, angle_smul_right_of_neg y x hr, angle_comm]
+
+/-- The cosine of the angle between two vectors, multiplied by the
+product of their norms. -/
+lemma cos_angle_mul_norm_mul_norm (x y : V) : real.cos (angle x y) * (‖x‖ * ‖y‖) = ⟪x, y⟫ :=
+begin
+  rw [cos_angle, div_mul_cancel_of_imp],
+  simp [or_imp_distrib] { contextual := tt },
+end
+
+/-- The sine of the angle between two vectors, multiplied by the
+product of their norms. -/
+lemma sin_angle_mul_norm_mul_norm (x y : V) : real.sin (angle x y) * (‖x‖ * ‖y‖) =
+    real.sqrt (⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫) :=
+begin
+  unfold angle,
+  rw [real.sin_arccos,
+      ←real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
+      ←real.sqrt_mul' _ (mul_self_nonneg _), sq,
+      real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
+      real_inner_self_eq_norm_mul_norm,
+      real_inner_self_eq_norm_mul_norm],
+  by_cases h : (‖x‖ * ‖y‖) = 0,
+  { rw [(show ‖x‖ * ‖x‖ * (‖y‖ * ‖y‖) = (‖x‖ * ‖y‖) * (‖x‖ * ‖y‖), by ring), h, mul_zero, mul_zero,
+        zero_sub],
+    cases eq_zero_or_eq_zero_of_mul_eq_zero h with hx hy,
+    { rw norm_eq_zero at hx,
+      rw [hx, inner_zero_left, zero_mul, neg_zero] },
+    { rw norm_eq_zero at hy,
+      rw [hy, inner_zero_right, zero_mul, neg_zero] } },
+  { field_simp [h], ring_nf }
+end
+
+/-- The angle between two vectors is zero if and only if they are
+nonzero and one is a positive multiple of the other. -/
+lemma angle_eq_zero_iff {x y : V} : angle x y = 0 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), 0 < r ∧ y = r • x) :=
+begin
+  rw [angle, ← real_inner_div_norm_mul_norm_eq_one_iff, real.arccos_eq_zero, has_le.le.le_iff_eq,
+    eq_comm],
+  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
+end
+
+/-- The angle between two vectors is π if and only if they are nonzero
+and one is a negative multiple of the other. -/
+lemma angle_eq_pi_iff {x y : V} : angle x y = π ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r < 0 ∧ y = r • x) :=
+begin
+  rw [angle, ← real_inner_div_norm_mul_norm_eq_neg_one_iff, real.arccos_eq_pi, has_le.le.le_iff_eq],
+  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
+end
+
+/-- If the angle between two vectors is π, the angles between those
+vectors and a third vector add to π. -/
+lemma angle_add_angle_eq_pi_of_angle_eq_pi {x y : V} (z : V) (h : angle x y = π) :
+  angle x z + angle y z = π :=
+begin
+  rcases angle_eq_pi_iff.1 h with ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩,
+  rw [angle_smul_left_of_neg x z hr, angle_neg_left, add_sub_cancel'_right]
+end
+
+/-- Two vectors have inner product 0 if and only if the angle between
+them is π/2. -/
+lemma inner_eq_zero_iff_angle_eq_pi_div_two (x y : V) : ⟪x, y⟫ = 0 ↔ angle x y = π / 2 :=
+iff.symm $ by simp [angle, or_imp_distrib] { contextual := tt }
+
+/-- If the angle between two vectors is π, the inner product equals the negative product
+of the norms. -/
+lemma inner_eq_neg_mul_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ⟪x, y⟫ = - (‖x‖ * ‖y‖) :=
+by simp [← cos_angle_mul_norm_mul_norm, h]
+
+/-- If the angle between two vectors is 0, the inner product equals the product of the norms. -/
+lemma inner_eq_mul_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ⟪x, y⟫ = ‖x‖ * ‖y‖ :=
+by simp [← cos_angle_mul_norm_mul_norm, h]
+
+/-- The inner product of two non-zero vectors equals the negative product of their norms
+if and only if the angle between the two vectors is π. -/
+lemma inner_eq_neg_mul_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  ⟪x, y⟫ = - (‖x‖ * ‖y‖) ↔ angle x y = π :=
+begin
+  refine ⟨λ h, _, inner_eq_neg_mul_norm_of_angle_eq_pi⟩,
+  have h₁ : (‖x‖ * ‖y‖) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
+  rw [angle, h, neg_div, div_self h₁, real.arccos_neg_one],
+end
+
+/-- The inner product of two non-zero vectors equals the product of their norms
+if and only if the angle between the two vectors is 0. -/
+lemma inner_eq_mul_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  ⟪x, y⟫ = ‖x‖ * ‖y‖ ↔ angle x y = 0 :=
+begin
+  refine ⟨λ h, _, inner_eq_mul_norm_of_angle_eq_zero⟩,
+  have h₁ : (‖x‖ * ‖y‖) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
+  rw [angle, h, div_self h₁, real.arccos_one],
+end
+
+/-- If the angle between two vectors is π, the norm of their difference equals
+the sum of their norms. -/
+lemma norm_sub_eq_add_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ‖x - y‖ = ‖x‖ + ‖y‖ :=
+begin
+  rw ← sq_eq_sq (norm_nonneg (x - y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
+  rw [norm_sub_pow_two_real, inner_eq_neg_mul_norm_of_angle_eq_pi h],
+  ring,
+end
+
+/-- If the angle between two vectors is 0, the norm of their sum equals
+the sum of their norms. -/
+lemma norm_add_eq_add_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ‖x + y‖ = ‖x‖ + ‖y‖ :=
+begin
+  rw ← sq_eq_sq (norm_nonneg (x + y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
+  rw [norm_add_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h],
+  ring,
+end
+
+/-- If the angle between two vectors is 0, the norm of their difference equals
+the absolute value of the difference of their norms. -/
+lemma norm_sub_eq_abs_sub_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) :
+  ‖x - y‖ = |‖x‖ - ‖y‖| :=
+begin
+  rw [← sq_eq_sq (norm_nonneg (x - y)) (abs_nonneg (‖x‖ - ‖y‖)),
+      norm_sub_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h, sq_abs (‖x‖ - ‖y‖)],
+  ring,
+end
+
+/-- The norm of the difference of two non-zero vectors equals the sum of their norms
+if and only the angle between the two vectors is π. -/
+lemma norm_sub_eq_add_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  ‖x - y‖ = ‖x‖ + ‖y‖ ↔ angle x y = π :=
+begin
+  refine ⟨λ h, _, norm_sub_eq_add_norm_of_angle_eq_pi⟩,
+  rw ← inner_eq_neg_mul_norm_iff_angle_eq_pi hx hy,
+  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x - y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
+  rw [← sq_eq_sq hxy₁ hxy₂, norm_sub_pow_two_real] at h,
+  calc ⟪x, y⟫ = (‖x‖ ^ 2 + ‖y‖ ^ 2 - (‖x‖ + ‖y‖) ^ 2) / 2 : by linarith
+  ...         = -(‖x‖ * ‖y‖) : by ring,
+end
+
+/-- The norm of the sum of two non-zero vectors equals the sum of their norms
+if and only the angle between the two vectors is 0. -/
+lemma norm_add_eq_add_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  ‖x + y‖ = ‖x‖ + ‖y‖ ↔ angle x y = 0 :=
+begin
+  refine ⟨λ h, _, norm_add_eq_add_norm_of_angle_eq_zero⟩,
+  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
+  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x + y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
+  rw [← sq_eq_sq hxy₁ hxy₂, norm_add_pow_two_real] at h,
+  calc ⟪x, y⟫ = ((‖x‖ + ‖y‖) ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2)/ 2 : by linarith
+  ...         = ‖x‖ * ‖y‖ : by ring,
+end
+
+/-- The norm of the difference of two non-zero vectors equals the absolute value
+of the difference of their norms if and only the angle between the two vectors is 0. -/
+lemma norm_sub_eq_abs_sub_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
+  ‖x - y‖ = |‖x‖ - ‖y‖| ↔ angle x y = 0 :=
+begin
+  refine ⟨λ h, _, norm_sub_eq_abs_sub_norm_of_angle_eq_zero⟩,
+  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
+  have h1 : ‖x - y‖ ^ 2 = (‖x‖ - ‖y‖) ^ 2, { rw h, exact sq_abs (‖x‖ - ‖y‖) },
+  rw norm_sub_pow_two_real at h1,
+  calc ⟪x, y⟫ = ((‖x‖ + ‖y‖) ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2)/ 2 : by linarith
+  ...         = ‖x‖ * ‖y‖ : by ring,
+end
+
+/-- The norm of the sum of two vectors equals the norm of their difference if and only if
+the angle between them is π/2. -/
+lemma norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (x y : V) :
+  ‖x + y‖ = ‖x - y‖ ↔ angle x y = π / 2 :=
+begin
+  rw [← sq_eq_sq (norm_nonneg (x + y)) (norm_nonneg (x - y)),
+      ← inner_eq_zero_iff_angle_eq_pi_div_two x y, norm_add_pow_two_real, norm_sub_pow_two_real],
+  split; intro h; linarith,
+end
+
+/-- The cosine of the angle between two vectors is 1 if and only if the angle is 0. -/
+lemma cos_eq_one_iff_angle_eq_zero : cos (angle x y) = 1 ↔ angle x y = 0 :=
+begin
+  rw ← cos_zero,
+  exact inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩ (left_mem_Icc.2 pi_pos.le),
+end
+
+/-- The cosine of the angle between two vectors is 0 if and only if the angle is π / 2. -/
+lemma cos_eq_zero_iff_angle_eq_pi_div_two : cos (angle x y) = 0 ↔ angle x y = π / 2 :=
+begin
+  rw ← cos_pi_div_two,
+  apply inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩,
+  split; linarith [pi_pos],
+end
+
+/-- The cosine of the angle between two vectors is -1 if and only if the angle is π. -/
+lemma cos_eq_neg_one_iff_angle_eq_pi : cos (angle x y) = -1 ↔ angle x y = π :=
+begin
+  rw ← cos_pi,
+  exact inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩ (right_mem_Icc.2 pi_pos.le),
+end
+
+/-- The sine of the angle between two vectors is 0 if and only if the angle is 0 or π. -/
+lemma sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi :
+  sin (angle x y) = 0 ↔ angle x y = 0 ∨ angle x y = π :=
+by rw [sin_eq_zero_iff_cos_eq, cos_eq_one_iff_angle_eq_zero, cos_eq_neg_one_iff_angle_eq_pi]
+
+/-- The sine of the angle between two vectors is 1 if and only if the angle is π / 2. -/
+lemma sin_eq_one_iff_angle_eq_pi_div_two : sin (angle x y) = 1 ↔ angle x y = π / 2 :=
+begin
+  refine ⟨λ h, _, λ h, by rw [h, sin_pi_div_two]⟩,
+  rw [←cos_eq_zero_iff_angle_eq_pi_div_two, ←abs_eq_zero, abs_cos_eq_sqrt_one_sub_sin_sq, h],
+  simp,
+end
+
+end inner_product_geometry
diff --git a/src/geometry/euclidean/angle/unoriented/conformal.lean b/src/geometry/euclidean/angle/unoriented/conformal.lean
new file mode 100644
index 0000000000000..ed2de536eddc9
--- /dev/null
+++ b/src/geometry/euclidean/angle/unoriented/conformal.lean
@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2021 Yourong Zang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yourong Zang
+-/
+import analysis.calculus.conformal.normed_space
+import geometry.euclidean.angle.unoriented.basic
+
+/-!
+# Angles and conformal maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves that conformal maps preserve angles.
+
+-/
+
+namespace inner_product_geometry
+
+variables {E F : Type*}
+variables [normed_add_comm_group E] [normed_add_comm_group F]
+variables [inner_product_space ℝ E] [inner_product_space ℝ F]
+
+lemma is_conformal_map.preserves_angle {f' : E →L[ℝ] F} (h : is_conformal_map f') (u v : E) :
+  angle (f' u) (f' v) = angle u v :=
+begin
+  obtain ⟨c, hc, li, rfl⟩ := h,
+  exact (angle_smul_smul hc _ _).trans (li.angle_map _ _)
+end
+
+/-- If a real differentiable map `f` is conformal at a point `x`,
+    then it preserves the angles at that point. -/
+lemma conformal_at.preserves_angle {f : E → F} {x : E} {f' : E →L[ℝ] F}
+  (h : has_fderiv_at f f' x) (H : conformal_at f x) (u v : E) :
+  angle (f' u) (f' v) = angle u v :=
+let ⟨f₁, h₁, c⟩ := H in h₁.unique h ▸ is_conformal_map.preserves_angle c u v
+
+end inner_product_geometry
diff --git a/src/geometry/euclidean/angle/unoriented/right_angle.lean b/src/geometry/euclidean/angle/unoriented/right_angle.lean
new file mode 100644
index 0000000000000..b6f03ee3b3454
--- /dev/null
+++ b/src/geometry/euclidean/angle/unoriented/right_angle.lean
@@ -0,0 +1,571 @@
+/-
+Copyright (c) 2020 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import analysis.special_functions.trigonometric.arctan
+import geometry.euclidean.angle.unoriented.affine
+
+/-!
+# Right-angled triangles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves basic geometrical results about distances and angles in (possibly degenerate)
+right-angled triangles in real inner product spaces and Euclidean affine spaces.
+
+## Implementation notes
+
+Results in this file are generally given in a form with only those non-degeneracy conditions
+needed for the particular result, rather than requiring affine independence of the points of a
+triangle unnecessarily.
+
+## References
+
+* https://en.wikipedia.org/wiki/Pythagorean_theorem
+
+-/
+
+noncomputable theory
+open_locale big_operators
+open_locale euclidean_geometry
+open_locale real
+open_locale real_inner_product_space
+
+namespace inner_product_geometry
+
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
+
+/-- Pythagorean theorem, if-and-only-if vector angle form. -/
+lemma norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
+  ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ angle x y = π / 2 :=
+begin
+  rw norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
+  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
+end
+
+/-- Pythagorean theorem, vector angle form. -/
+lemma norm_add_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
+  ‖x + y‖ * ‖x + y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ :=
+(norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h
+
+/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
+lemma norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
+  ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ ↔ angle x y = π / 2 :=
+begin
+  rw norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
+  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
+end
+
+/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
+lemma norm_sub_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
+  ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ :=
+(norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h
+
+/-- An angle in a right-angled triangle expressed using `arccos`. -/
+lemma angle_add_eq_arccos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  angle x (x + y) = real.arccos (‖x‖ / ‖x + y‖) :=
+begin
+  rw [angle, inner_add_right, h, add_zero, real_inner_self_eq_norm_mul_norm],
+  by_cases hx : ‖x‖ = 0, { simp [hx] },
+  rw [div_mul_eq_div_div, mul_self_div_self]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`. -/
+lemma angle_add_eq_arcsin_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
+  angle x (x + y) = real.arcsin (‖y‖ / ‖x + y‖) :=
+begin
+  have hxy : ‖x + y‖ ^ 2 ≠ 0,
+  { rw [pow_two, norm_add_sq_eq_norm_sq_add_norm_sq_real h, ne_comm],
+    refine ne_of_lt _,
+    rcases h0 with h0 | h0,
+    { exact left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
+                                          (mul_self_nonneg _) },
+    { exact left.add_pos_of_nonneg_of_pos (mul_self_nonneg _)
+                                          (mul_self_pos.2 (norm_ne_zero_iff.2 h0)) } },
+  rw [angle_add_eq_arccos_of_inner_eq_zero h,
+      real.arccos_eq_arcsin (div_nonneg (norm_nonneg _) (norm_nonneg _)), div_pow,
+      one_sub_div hxy],
+  nth_rewrite 0 [pow_two],
+  rw [norm_add_sq_eq_norm_sq_add_norm_sq_real h, pow_two, add_sub_cancel', ←pow_two, ←div_pow,
+      real.sqrt_sq (div_nonneg (norm_nonneg _) (norm_nonneg _))]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`. -/
+lemma angle_add_eq_arctan_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
+  angle x (x + y) = real.arctan (‖y‖ / ‖x‖) :=
+begin
+  rw [angle_add_eq_arcsin_of_inner_eq_zero h (or.inl h0), real.arctan_eq_arcsin,
+      ←div_mul_eq_div_div, norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h],
+  nth_rewrite 2 [←real.sqrt_sq (norm_nonneg x)],
+  rw [←real.sqrt_mul (sq_nonneg _), div_pow, pow_two, pow_two, mul_add, mul_one, mul_div,
+      mul_comm (‖x‖ * ‖x‖), ←mul_div, div_self (mul_self_pos.2 (norm_ne_zero_iff.2 h0)).ne',
+      mul_one]
+end
+
+/-- An angle in a non-degenerate right-angled triangle is positive. -/
+lemma angle_add_pos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
+  0 < angle x (x + y) :=
+begin
+  rw [angle_add_eq_arccos_of_inner_eq_zero h, real.arccos_pos,
+      norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h],
+  by_cases hx : x = 0, { simp [hx] },
+  rw [div_lt_one (real.sqrt_pos.2 (left.add_pos_of_pos_of_nonneg
+                                     (mul_self_pos.2 (norm_ne_zero_iff.2 hx))
+                                     (mul_self_nonneg _))), real.lt_sqrt (norm_nonneg _),
+      pow_two],
+  simpa [hx] using h0
+end
+
+/-- An angle in a right-angled triangle is at most `π / 2`. -/
+lemma angle_add_le_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  angle x (x + y) ≤ π / 2 :=
+begin
+  rw [angle_add_eq_arccos_of_inner_eq_zero h, real.arccos_le_pi_div_two],
+  exact div_nonneg (norm_nonneg _) (norm_nonneg _)
+end
+
+/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`. -/
+lemma angle_add_lt_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
+  angle x (x + y) < π / 2 :=
+begin
+  rw [angle_add_eq_arccos_of_inner_eq_zero h, real.arccos_lt_pi_div_two,
+      norm_add_eq_sqrt_iff_real_inner_eq_zero.2 h],
+  exact div_pos (norm_pos_iff.2 h0) (real.sqrt_pos.2 (left.add_pos_of_pos_of_nonneg
+                                                        (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
+                                                        (mul_self_nonneg _)))
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma cos_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.cos (angle x (x + y)) = ‖x‖ / ‖x + y‖ :=
+begin
+  rw [angle_add_eq_arccos_of_inner_eq_zero h,
+      real.cos_arccos (le_trans (by norm_num) (div_nonneg (norm_nonneg _) (norm_nonneg _)))
+                      (div_le_one_of_le _ (norm_nonneg _))],
+  rw [mul_self_le_mul_self_iff (norm_nonneg _) (norm_nonneg _),
+      norm_add_sq_eq_norm_sq_add_norm_sq_real h],
+  exact le_add_of_nonneg_right (mul_self_nonneg _)
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma sin_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
+  real.sin (angle x (x + y)) = ‖y‖ / ‖x + y‖ :=
+begin
+  rw [angle_add_eq_arcsin_of_inner_eq_zero h h0,
+      real.sin_arcsin (le_trans (by norm_num) (div_nonneg (norm_nonneg _) (norm_nonneg _)))
+                      (div_le_one_of_le _ (norm_nonneg _))],
+  rw [mul_self_le_mul_self_iff (norm_nonneg _) (norm_nonneg _),
+      norm_add_sq_eq_norm_sq_add_norm_sq_real h],
+  exact le_add_of_nonneg_left (mul_self_nonneg _)
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
+lemma tan_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.tan (angle x (x + y)) = ‖y‖ / ‖x‖ :=
+begin
+  by_cases h0 : x = 0, { simp [h0] },
+  rw [angle_add_eq_arctan_of_inner_eq_zero h h0, real.tan_arctan]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side. -/
+lemma cos_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.cos (angle x (x + y)) * ‖x + y‖ = ‖x‖ :=
+begin
+  rw cos_angle_add_of_inner_eq_zero h,
+  by_cases hxy : ‖x + y‖ = 0,
+  { have h' := norm_add_sq_eq_norm_sq_add_norm_sq_real h,
+    rw [hxy, zero_mul, eq_comm, add_eq_zero_iff' (mul_self_nonneg ‖x‖) (mul_self_nonneg ‖y‖),
+        mul_self_eq_zero] at h',
+    simp [h'.1] },
+  { exact div_mul_cancel _ hxy }
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side. -/
+lemma sin_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.sin (angle x (x + y)) * ‖x + y‖ = ‖y‖ :=
+begin
+  by_cases h0 : x = 0 ∧ y = 0, { simp [h0] },
+  rw not_and_distrib at h0,
+  rw [sin_angle_add_of_inner_eq_zero h h0, div_mul_cancel],
+  rw [←mul_self_ne_zero, norm_add_sq_eq_norm_sq_add_norm_sq_real h],
+  refine (ne_of_lt _).symm,
+  rcases h0 with h0 | h0,
+  { exact left.add_pos_of_pos_of_nonneg (mul_self_pos.2 (norm_ne_zero_iff.2 h0))
+                                        (mul_self_nonneg _) },
+  { exact left.add_pos_of_nonneg_of_pos (mul_self_nonneg _)
+                                        (mul_self_pos.2 (norm_ne_zero_iff.2 h0)) }
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side. -/
+lemma tan_angle_add_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
+  real.tan (angle x (x + y)) * ‖x‖ = ‖y‖ :=
+begin
+  rw [tan_angle_add_of_inner_eq_zero h],
+  rcases h0 with h0 | h0; simp [h0]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse. -/
+lemma norm_div_cos_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
+  ‖x‖ / real.cos (angle x (x + y)) = ‖x + y‖ :=
+begin
+  rw cos_angle_add_of_inner_eq_zero h,
+  rcases h0 with h0 | h0,
+  { rw [div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
+        mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)] },
+  { simp [h0] }
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse. -/
+lemma norm_div_sin_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
+  ‖y‖ / real.sin (angle x (x + y)) = ‖x + y‖ :=
+begin
+  rcases h0 with h0 | h0, { simp [h0] },
+  rw [sin_angle_add_of_inner_eq_zero h (or.inr h0), div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
+        mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side. -/
+lemma norm_div_tan_angle_add_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
+  ‖y‖ / real.tan (angle x (x + y)) = ‖x‖ :=
+begin
+  rw tan_angle_add_of_inner_eq_zero h,
+  rcases h0 with h0 | h0,
+  { simp [h0] },
+  { rw [div_div_eq_mul_div, mul_comm, div_eq_mul_inv,
+        mul_inv_cancel_right₀ (norm_ne_zero_iff.2 h0)] }
+end
+
+/-- An angle in a right-angled triangle expressed using `arccos`, version subtracting vectors. -/
+lemma angle_sub_eq_arccos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  angle x (x - y) = real.arccos (‖x‖ / ‖x - y‖) :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw [sub_eq_add_neg, angle_add_eq_arccos_of_inner_eq_zero h]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`, version subtracting vectors. -/
+lemma angle_sub_eq_arcsin_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
+  angle x (x - y) = real.arcsin (‖y‖ / ‖x - y‖) :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  nth_rewrite 1 ←neg_ne_zero at h0,
+  rw [sub_eq_add_neg, angle_add_eq_arcsin_of_inner_eq_zero h h0, norm_neg]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`, version subtracting vectors. -/
+lemma angle_sub_eq_arctan_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
+  angle x (x - y) = real.arctan (‖y‖ / ‖x‖) :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw [sub_eq_add_neg, angle_add_eq_arctan_of_inner_eq_zero h h0, norm_neg]
+end
+
+/-- An angle in a non-degenerate right-angled triangle is positive, version subtracting
+vectors. -/
+lemma angle_sub_pos_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
+  0 < angle x (x - y) :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw ←neg_ne_zero at h0,
+  rw sub_eq_add_neg,
+  exact angle_add_pos_of_inner_eq_zero h h0
+end
+
+/-- An angle in a right-angled triangle is at most `π / 2`, version subtracting vectors. -/
+lemma angle_sub_le_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  angle x (x - y) ≤ π / 2 :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw sub_eq_add_neg,
+  exact angle_add_le_pi_div_two_of_inner_eq_zero h
+end
+
+/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`, version subtracting
+vectors. -/
+lemma angle_sub_lt_pi_div_two_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0) :
+  angle x (x - y) < π / 2 :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw sub_eq_add_neg,
+  exact angle_add_lt_pi_div_two_of_inner_eq_zero h h0
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma cos_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.cos (angle x (x - y)) = ‖x‖ / ‖x - y‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw [sub_eq_add_neg, cos_angle_add_of_inner_eq_zero h]
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma sin_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y ≠ 0) :
+  real.sin (angle x (x - y)) = ‖y‖ / ‖x - y‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  nth_rewrite 1 ←neg_ne_zero at h0,
+  rw [sub_eq_add_neg, sin_angle_add_of_inner_eq_zero h h0, norm_neg]
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides, version subtracting
+vectors. -/
+lemma tan_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.tan (angle x (x - y)) = ‖y‖ / ‖x‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw [sub_eq_add_neg, tan_angle_add_of_inner_eq_zero h, norm_neg]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side, version subtracting vectors. -/
+lemma cos_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.cos (angle x (x - y)) * ‖x - y‖ = ‖x‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw [sub_eq_add_neg, cos_angle_add_mul_norm_of_inner_eq_zero h]
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side, version subtracting vectors. -/
+lemma sin_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) :
+  real.sin (angle x (x - y)) * ‖x - y‖ = ‖y‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw [sub_eq_add_neg, sin_angle_add_mul_norm_of_inner_eq_zero h, norm_neg]
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side, version subtracting vectors. -/
+lemma tan_angle_sub_mul_norm_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
+  real.tan (angle x (x - y)) * ‖x‖ = ‖y‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw ←neg_eq_zero at h0,
+  rw [sub_eq_add_neg, tan_angle_add_mul_norm_of_inner_eq_zero h h0, norm_neg]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse, version subtracting vectors. -/
+lemma norm_div_cos_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x ≠ 0 ∨ y = 0) :
+  ‖x‖ / real.cos (angle x (x - y)) = ‖x - y‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw ←neg_eq_zero at h0,
+  rw [sub_eq_add_neg, norm_div_cos_angle_add_of_inner_eq_zero h h0]
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse, version subtracting vectors. -/
+lemma norm_div_sin_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
+  ‖y‖ / real.sin (angle x (x - y)) = ‖x - y‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw ←neg_ne_zero at h0,
+  rw [sub_eq_add_neg, ←norm_neg, norm_div_sin_angle_add_of_inner_eq_zero h h0]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side, version subtracting vectors. -/
+lemma norm_div_tan_angle_sub_of_inner_eq_zero {x y : V} (h : ⟪x, y⟫ = 0) (h0 : x = 0 ∨ y ≠ 0) :
+  ‖y‖ / real.tan (angle x (x - y)) = ‖x‖ :=
+begin
+  rw [←neg_eq_zero, ←inner_neg_right] at h,
+  rw ←neg_ne_zero at h0,
+  rw [sub_eq_add_neg, ←norm_neg, norm_div_tan_angle_add_of_inner_eq_zero h h0]
+end
+
+end inner_product_geometry
+
+namespace euclidean_geometry
+
+open inner_product_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- **Pythagorean theorem**, if-and-only-if angle-at-point form. -/
+lemma dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two (p1 p2 p3 : P) :
+  dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔
+    ∠ p1 p2 p3 = π / 2 :=
+by erw [dist_comm p3 p2, dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2,
+        dist_eq_norm_vsub V p2 p3,
+        ←norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two,
+        vsub_sub_vsub_cancel_right p1, ←neg_vsub_eq_vsub_rev p2 p3, norm_neg]
+
+/-- An angle in a right-angled triangle expressed using `arccos`. -/
+lemma angle_eq_arccos_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
+  ∠ p₂ p₃ p₁ = real.arccos (dist p₃ p₂ / dist p₁ p₃) :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, angle_add_eq_arccos_of_inner_eq_zero h]
+end
+
+/-- An angle in a right-angled triangle expressed using `arcsin`. -/
+lemma angle_eq_arcsin_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ ≠ p₂ ∨ p₃ ≠ p₂) : ∠ p₂ p₃ p₁ = real.arcsin (dist p₁ p₂ / dist p₁ p₃) :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [←@vsub_ne_zero V, @ne_comm _ p₃, ←@vsub_ne_zero V _ _ _ p₂, or_comm] at h0,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, angle_add_eq_arcsin_of_inner_eq_zero h h0]
+end
+
+/-- An angle in a right-angled triangle expressed using `arctan`. -/
+lemma angle_eq_arctan_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₃ ≠ p₂) : ∠ p₂ p₃ p₁ = real.arctan (dist p₁ p₂ / dist p₃ p₂) :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [ne_comm, ←@vsub_ne_zero V] at h0,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, angle_add_eq_arctan_of_inner_eq_zero h h0]
+end
+
+/-- An angle in a non-degenerate right-angled triangle is positive. -/
+lemma angle_pos_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : 0 < ∠ p₂ p₃ p₁ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [←@vsub_ne_zero V, eq_comm, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
+  rw [angle, ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm],
+  exact angle_add_pos_of_inner_eq_zero h h0
+end
+
+/-- An angle in a right-angled triangle is at most `π / 2`. -/
+lemma angle_le_pi_div_two_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
+  ∠ p₂ p₃ p₁ ≤ π / 2 :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [angle, ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm],
+  exact angle_add_le_pi_div_two_of_inner_eq_zero h
+end
+
+/-- An angle in a non-degenerate right-angled triangle is less than `π / 2`. -/
+lemma angle_lt_pi_div_two_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₃ ≠ p₂) : ∠ p₂ p₃ p₁ < π / 2 :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [ne_comm, ←@vsub_ne_zero V] at h0,
+  rw [angle, ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm],
+  exact angle_add_lt_pi_div_two_of_inner_eq_zero h h0
+end
+
+/-- The cosine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma cos_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
+  real.cos (∠ p₂ p₃ p₁) = dist p₃ p₂ / dist p₁ p₃ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, cos_angle_add_of_inner_eq_zero h]
+end
+
+/-- The sine of an angle in a right-angled triangle as a ratio of sides. -/
+lemma sin_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ ≠ p₂ ∨ p₃ ≠ p₂) : real.sin (∠ p₂ p₃ p₁) = dist p₁ p₂ / dist p₁ p₃ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [←@vsub_ne_zero V, @ne_comm _ p₃, ←@vsub_ne_zero V _ _ _ p₂, or_comm] at h0,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, sin_angle_add_of_inner_eq_zero h h0]
+end
+
+/-- The tangent of an angle in a right-angled triangle as a ratio of sides. -/
+lemma tan_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
+  real.tan (∠ p₂ p₃ p₁) = dist p₁ p₂ / dist p₃ p₂ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, tan_angle_add_of_inner_eq_zero h]
+end
+
+/-- The cosine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+adjacent side. -/
+lemma cos_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
+  real.cos (∠ p₂ p₃ p₁) * dist p₁ p₃ = dist p₃ p₂ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, cos_angle_add_mul_norm_of_inner_eq_zero h]
+end
+
+/-- The sine of an angle in a right-angled triangle multiplied by the hypotenuse equals the
+opposite side. -/
+lemma sin_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2) :
+  real.sin (∠ p₂ p₃ p₁) * dist p₁ p₃ = dist p₁ p₂ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, sin_angle_add_mul_norm_of_inner_eq_zero h]
+end
+
+/-- The tangent of an angle in a right-angled triangle multiplied by the adjacent side equals
+the opposite side. -/
+lemma tan_angle_mul_dist_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ = p₂ ∨ p₃ ≠ p₂) : real.tan (∠ p₂ p₃ p₁) * dist p₃ p₂ = dist p₁ p₂ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [ne_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, tan_angle_add_mul_norm_of_inner_eq_zero h h0]
+end
+
+/-- A side of a right-angled triangle divided by the cosine of the adjacent angle equals the
+hypotenuse. -/
+lemma dist_div_cos_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ = p₂ ∨ p₃ ≠ p₂) : dist p₃ p₂ / real.cos (∠ p₂ p₃ p₁) = dist p₁ p₃ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [ne_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
+  rw [angle, dist_eq_norm_vsub' V p₃ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, norm_div_cos_angle_add_of_inner_eq_zero h h0]
+end
+
+/-- A side of a right-angled triangle divided by the sine of the opposite angle equals the
+hypotenuse. -/
+lemma dist_div_sin_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : dist p₁ p₂ / real.sin (∠ p₂ p₃ p₁) = dist p₁ p₃ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [eq_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub V p₁ p₃,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, norm_div_sin_angle_add_of_inner_eq_zero h h0]
+end
+
+/-- A side of a right-angled triangle divided by the tangent of the opposite angle equals the
+adjacent side. -/
+lemma dist_div_tan_angle_of_angle_eq_pi_div_two {p₁ p₂ p₃ : P} (h : ∠ p₁ p₂ p₃ = π / 2)
+  (h0 : p₁ ≠ p₂ ∨ p₃ = p₂) : dist p₁ p₂ / real.tan (∠ p₂ p₃ p₁) = dist p₃ p₂ :=
+begin
+  rw [angle, ←inner_eq_zero_iff_angle_eq_pi_div_two, real_inner_comm, ←neg_eq_zero,
+      ←inner_neg_left, neg_vsub_eq_vsub_rev] at h,
+  rw [eq_comm, ←@vsub_ne_zero V, ←@vsub_eq_zero_iff_eq V, or_comm] at h0,
+  rw [angle, dist_eq_norm_vsub V p₁ p₂, dist_eq_norm_vsub' V p₃ p₂,
+      ←vsub_add_vsub_cancel p₁ p₂ p₃, add_comm, norm_div_tan_angle_add_of_inner_eq_zero h h0]
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/basic.lean b/src/geometry/euclidean/basic.lean
index 8b22924bf157f..f8d4cf7ee4f1f 100644
--- a/src/geometry/euclidean/basic.lean
+++ b/src/geometry/euclidean/basic.lean
@@ -4,14 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers, Manuel Candales
 -/
 import analysis.inner_product_space.projection
-import analysis.special_functions.trigonometric.inverse
 import algebra.quadratic_discriminant
-import linear_algebra.affine_space.finite_dimensional
-import analysis.calculus.conformal.normed_space
 
 /-!
 # Euclidean spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file makes some definitions and proves very basic geometrical
 results about real inner product spaces and Euclidean affine spaces.
 Results about real inner product spaces that involve the norm and
@@ -21,12 +21,6 @@ proofs or more geometrical content generally go in separate files.
 
 ## Main definitions
 
-* `inner_product_geometry.angle` is the undirected angle between two
-  vectors.
-
-* `euclidean_geometry.angle`, with notation `∠`, is the undirected
-  angle determined by three points.
-
 * `euclidean_geometry.orthogonal_projection` is the orthogonal
   projection of a point onto an affine subspace.
 
@@ -36,8 +30,9 @@ proofs or more geometrical content generally go in separate files.
 ## Implementation notes
 
 To declare `P` as the type of points in a Euclidean affine space with
-`V` as the type of vectors, use `[inner_product_space ℝ V] [metric_space P]
-[normed_add_torsor V P]`.  This works better with `out_param` to make
+`V` as the type of vectors, use
+`[normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]`.
+This works better with `out_param` to make
 `V` implicit in most cases than having a separate type alias for
 Euclidean affine spaces.
 
@@ -54,318 +49,8 @@ theorems that need it.
 noncomputable theory
 open_locale big_operators
 open_locale classical
-open_locale real
 open_locale real_inner_product_space
 
-namespace inner_product_geometry
-/-!
-### Geometrical results on real inner product spaces
-
-This section develops some geometrical definitions and results on real
-inner product spaces, where those definitions and results can most
-conveniently be developed in terms of vectors and then used to deduce
-corresponding results for Euclidean affine spaces.
--/
-
-variables {V : Type*} [inner_product_space ℝ V]
-
-/-- The undirected angle between two vectors. If either vector is 0,
-this is π/2. See `orientation.oangle` for the corresponding oriented angle
-definition. -/
-def angle (x y : V) : ℝ := real.arccos (inner x y / (∥x∥ * ∥y∥))
-
-lemma is_conformal_map.preserves_angle {E F : Type*}
-  [inner_product_space ℝ E] [inner_product_space ℝ F]
-  {f' : E →L[ℝ] F} (h : is_conformal_map f') (u v : E) :
-  angle (f' u) (f' v) = angle u v :=
-begin
-  obtain ⟨c, hc, li, hcf⟩ := h,
-  suffices : c * (c * inner u v) / (∥c∥ * ∥u∥ * (∥c∥ * ∥v∥)) = inner u v / (∥u∥ * ∥v∥),
-  { simp [this, angle, hcf, norm_smul, inner_smul_left, inner_smul_right] },
-  by_cases hu : ∥u∥ = 0,
-  { simp [norm_eq_zero.mp hu] },
-  by_cases hv : ∥v∥ = 0,
-  { simp [norm_eq_zero.mp hv] },
-  have hc : ∥c∥ ≠ 0 := λ w, hc (norm_eq_zero.mp w),
-  field_simp,
-  have : c * c = ∥c∥ * ∥c∥ := by simp [real.norm_eq_abs, abs_mul_abs_self],
-  convert congr_arg (λ x, x * ⟪u, v⟫ * ∥u∥ * ∥v∥) this using 1; ring,
-end
-
-/-- If a real differentiable map `f` is conformal at a point `x`,
-    then it preserves the angles at that point. -/
-lemma conformal_at.preserves_angle {E F : Type*}
-  [inner_product_space ℝ E] [inner_product_space ℝ F]
-  {f : E → F} {x : E} {f' : E →L[ℝ] F}
-  (h : has_fderiv_at f f' x) (H : conformal_at f x) (u v : E) :
-  angle (f' u) (f' v) = angle u v :=
-let ⟨f₁, h₁, c⟩ := H in h₁.unique h ▸ is_conformal_map.preserves_angle c u v
-
-/-- The cosine of the angle between two vectors. -/
-lemma cos_angle (x y : V) : real.cos (angle x y) = inner x y / (∥x∥ * ∥y∥) :=
-real.cos_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
-                (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
-
-/-- The angle between two vectors does not depend on their order. -/
-lemma angle_comm (x y : V) : angle x y = angle y x :=
-begin
-  unfold angle,
-  rw [real_inner_comm, mul_comm]
-end
-
-/-- The angle between the negation of two vectors. -/
-@[simp] lemma angle_neg_neg (x y : V) : angle (-x) (-y) = angle x y :=
-begin
-  unfold angle,
-  rw [inner_neg_neg, norm_neg, norm_neg]
-end
-
-/-- The angle between two vectors is nonnegative. -/
-lemma angle_nonneg (x y : V) : 0 ≤ angle x y :=
-real.arccos_nonneg _
-
-/-- The angle between two vectors is at most π. -/
-lemma angle_le_pi (x y : V) : angle x y ≤ π :=
-real.arccos_le_pi _
-
-/-- The angle between a vector and the negation of another vector. -/
-lemma angle_neg_right (x y : V) : angle x (-y) = π - angle x y :=
-begin
-  unfold angle,
-  rw [←real.arccos_neg, norm_neg, inner_neg_right, neg_div]
-end
-
-/-- The angle between the negation of a vector and another vector. -/
-lemma angle_neg_left (x y : V) : angle (-x) y = π - angle x y :=
-by rw [←angle_neg_neg, neg_neg, angle_neg_right]
-
-/-- The angle between the zero vector and a vector. -/
-@[simp] lemma angle_zero_left (x : V) : angle 0 x = π / 2 :=
-begin
-  unfold angle,
-  rw [inner_zero_left, zero_div, real.arccos_zero]
-end
-
-/-- The angle between a vector and the zero vector. -/
-@[simp] lemma angle_zero_right (x : V) : angle x 0 = π / 2 :=
-begin
-  unfold angle,
-  rw [inner_zero_right, zero_div, real.arccos_zero]
-end
-
-/-- The angle between a nonzero vector and itself. -/
-@[simp] lemma angle_self {x : V} (hx : x ≠ 0) : angle x x = 0 :=
-begin
-  unfold angle,
-  rw [←real_inner_self_eq_norm_mul_norm, div_self (λ h, hx (inner_self_eq_zero.1 h)),
-      real.arccos_one]
-end
-
-/-- The angle between a nonzero vector and its negation. -/
-@[simp] lemma angle_self_neg_of_nonzero {x : V} (hx : x ≠ 0) : angle x (-x) = π :=
-by rw [angle_neg_right, angle_self hx, sub_zero]
-
-/-- The angle between the negation of a nonzero vector and that
-vector. -/
-@[simp] lemma angle_neg_self_of_nonzero {x : V} (hx : x ≠ 0) : angle (-x) x = π :=
-by rw [angle_comm, angle_self_neg_of_nonzero hx]
-
-/-- The angle between a vector and a positive multiple of a vector. -/
-@[simp] lemma angle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
-  angle x (r • y) = angle x y :=
-begin
-  unfold angle,
-  rw [inner_smul_right, norm_smul, real.norm_eq_abs, abs_of_nonneg (le_of_lt hr), ←mul_assoc,
-      mul_comm _ r, mul_assoc, mul_div_mul_left _ _ (ne_of_gt hr)]
-end
-
-/-- The angle between a positive multiple of a vector and a vector. -/
-@[simp] lemma angle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
-  angle (r • x) y = angle x y :=
-by rw [angle_comm, angle_smul_right_of_pos y x hr, angle_comm]
-
-/-- The angle between a vector and a negative multiple of a vector. -/
-@[simp] lemma angle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
-  angle x (r • y) = angle x (-y) :=
-by rw [←neg_neg r, neg_smul, angle_neg_right, angle_smul_right_of_pos x y (neg_pos_of_neg hr),
-       angle_neg_right]
-
-/-- The angle between a negative multiple of a vector and a vector. -/
-@[simp] lemma angle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
-  angle (r • x) y = angle (-x) y :=
-by rw [angle_comm, angle_smul_right_of_neg y x hr, angle_comm]
-
-/-- The cosine of the angle between two vectors, multiplied by the
-product of their norms. -/
-lemma cos_angle_mul_norm_mul_norm (x y : V) : real.cos (angle x y) * (∥x∥ * ∥y∥) = inner x y :=
-begin
-  rw [cos_angle, div_mul_cancel_of_imp],
-  simp [or_imp_distrib] { contextual := tt },
-end
-
-/-- The sine of the angle between two vectors, multiplied by the
-product of their norms. -/
-lemma sin_angle_mul_norm_mul_norm (x y : V) : real.sin (angle x y) * (∥x∥ * ∥y∥) =
-    real.sqrt (inner x x * inner y y - inner x y * inner x y) :=
-begin
-  unfold angle,
-  rw [real.sin_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
-                      (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2,
-      ←real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
-      ←real.sqrt_mul' _ (mul_self_nonneg _), sq,
-      real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
-      real_inner_self_eq_norm_mul_norm,
-      real_inner_self_eq_norm_mul_norm],
-  by_cases h : (∥x∥ * ∥y∥) = 0,
-  { rw [(show ∥x∥ * ∥x∥ * (∥y∥ * ∥y∥) = (∥x∥ * ∥y∥) * (∥x∥ * ∥y∥), by ring), h, mul_zero, mul_zero,
-        zero_sub],
-    cases eq_zero_or_eq_zero_of_mul_eq_zero h with hx hy,
-    { rw norm_eq_zero at hx,
-      rw [hx, inner_zero_left, zero_mul, neg_zero] },
-    { rw norm_eq_zero at hy,
-      rw [hy, inner_zero_right, zero_mul, neg_zero] } },
-  { field_simp [h], ring_nf }
-end
-
-/-- The angle between two vectors is zero if and only if they are
-nonzero and one is a positive multiple of the other. -/
-lemma angle_eq_zero_iff {x y : V} : angle x y = 0 ↔ (x ≠ 0 ∧ ∃ (r : ℝ), 0 < r ∧ y = r • x) :=
-begin
-  rw [angle, ← real_inner_div_norm_mul_norm_eq_one_iff, real.arccos_eq_zero, has_le.le.le_iff_eq,
-    eq_comm],
-  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
-end
-
-/-- The angle between two vectors is π if and only if they are nonzero
-and one is a negative multiple of the other. -/
-lemma angle_eq_pi_iff {x y : V} : angle x y = π ↔ (x ≠ 0 ∧ ∃ (r : ℝ), r < 0 ∧ y = r • x) :=
-begin
-  rw [angle, ← real_inner_div_norm_mul_norm_eq_neg_one_iff, real.arccos_eq_pi, has_le.le.le_iff_eq],
-  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
-end
-
-/-- If the angle between two vectors is π, the angles between those
-vectors and a third vector add to π. -/
-lemma angle_add_angle_eq_pi_of_angle_eq_pi {x y : V} (z : V) (h : angle x y = π) :
-  angle x z + angle y z = π :=
-begin
-  rcases angle_eq_pi_iff.1 h with ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩,
-  rw [angle_smul_left_of_neg x z hr, angle_neg_left, add_sub_cancel'_right]
-end
-
-/-- Two vectors have inner product 0 if and only if the angle between
-them is π/2. -/
-lemma inner_eq_zero_iff_angle_eq_pi_div_two (x y : V) : ⟪x, y⟫ = 0 ↔ angle x y = π / 2 :=
-iff.symm $ by simp [angle, or_imp_distrib] { contextual := tt }
-
-/-- If the angle between two vectors is π, the inner product equals the negative product
-of the norms. -/
-lemma inner_eq_neg_mul_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ⟪x, y⟫ = - (∥x∥ * ∥y∥) :=
-by simp [← cos_angle_mul_norm_mul_norm, h]
-
-/-- If the angle between two vectors is 0, the inner product equals the product of the norms. -/
-lemma inner_eq_mul_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ⟪x, y⟫ = ∥x∥ * ∥y∥ :=
-by simp [← cos_angle_mul_norm_mul_norm, h]
-
-/-- The inner product of two non-zero vectors equals the negative product of their norms
-if and only if the angle between the two vectors is π. -/
-lemma inner_eq_neg_mul_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  ⟪x, y⟫ = - (∥x∥ * ∥y∥) ↔ angle x y = π :=
-begin
-  refine ⟨λ h, _, inner_eq_neg_mul_norm_of_angle_eq_pi⟩,
-  have h₁ : (∥x∥ * ∥y∥) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
-  rw [angle, h, neg_div, div_self h₁, real.arccos_neg_one],
-end
-
-/-- The inner product of two non-zero vectors equals the product of their norms
-if and only if the angle between the two vectors is 0. -/
-lemma inner_eq_mul_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  ⟪x, y⟫ = ∥x∥ * ∥y∥ ↔ angle x y = 0 :=
-begin
-  refine ⟨λ h, _, inner_eq_mul_norm_of_angle_eq_zero⟩,
-  have h₁ : (∥x∥ * ∥y∥) ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne',
-  rw [angle, h, div_self h₁, real.arccos_one],
-end
-
-/-- If the angle between two vectors is π, the norm of their difference equals
-the sum of their norms. -/
-lemma norm_sub_eq_add_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ∥x - y∥ = ∥x∥ + ∥y∥ :=
-begin
-  rw ← sq_eq_sq (norm_nonneg (x - y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
-  rw [norm_sub_pow_two_real, inner_eq_neg_mul_norm_of_angle_eq_pi h],
-  ring,
-end
-
-/-- If the angle between two vectors is 0, the norm of their sum equals
-the sum of their norms. -/
-lemma norm_add_eq_add_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ∥x + y∥ = ∥x∥ + ∥y∥ :=
-begin
-  rw ← sq_eq_sq (norm_nonneg (x + y)) (add_nonneg (norm_nonneg x) (norm_nonneg y)),
-  rw [norm_add_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h],
-  ring,
-end
-
-/-- If the angle between two vectors is 0, the norm of their difference equals
-the absolute value of the difference of their norms. -/
-lemma norm_sub_eq_abs_sub_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) :
-  ∥x - y∥ = |∥x∥ - ∥y∥| :=
-begin
-  rw [← sq_eq_sq (norm_nonneg (x - y)) (abs_nonneg (∥x∥ - ∥y∥)),
-      norm_sub_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h, sq_abs (∥x∥ - ∥y∥)],
-  ring,
-end
-
-/-- The norm of the difference of two non-zero vectors equals the sum of their norms
-if and only the angle between the two vectors is π. -/
-lemma norm_sub_eq_add_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  ∥x - y∥ = ∥x∥ + ∥y∥ ↔ angle x y = π :=
-begin
-  refine ⟨λ h, _, norm_sub_eq_add_norm_of_angle_eq_pi⟩,
-  rw ← inner_eq_neg_mul_norm_iff_angle_eq_pi hx hy,
-  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x - y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
-  rw [← sq_eq_sq hxy₁ hxy₂, norm_sub_pow_two_real] at h,
-  calc inner x y = (∥x∥ ^ 2 + ∥y∥ ^ 2 - (∥x∥ + ∥y∥) ^ 2) / 2 : by linarith
-  ...            = -(∥x∥ * ∥y∥) : by ring,
-end
-
-/-- The norm of the sum of two non-zero vectors equals the sum of their norms
-if and only the angle between the two vectors is 0. -/
-lemma norm_add_eq_add_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  ∥x + y∥ = ∥x∥ + ∥y∥ ↔ angle x y = 0 :=
-begin
-  refine ⟨λ h, _, norm_add_eq_add_norm_of_angle_eq_zero⟩,
-  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
-  obtain ⟨hxy₁, hxy₂⟩ := ⟨norm_nonneg (x + y), add_nonneg (norm_nonneg x) (norm_nonneg y)⟩,
-  rw [← sq_eq_sq hxy₁ hxy₂, norm_add_pow_two_real] at h,
-  calc inner x y = ((∥x∥ + ∥y∥) ^ 2 - ∥x∥ ^ 2 - ∥y∥ ^ 2)/ 2 : by linarith
-  ...            = ∥x∥ * ∥y∥ : by ring,
-end
-
-/-- The norm of the difference of two non-zero vectors equals the absolute value
-of the difference of their norms if and only the angle between the two vectors is 0. -/
-lemma norm_sub_eq_abs_sub_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  ∥x - y∥ = |∥x∥ - ∥y∥| ↔ angle x y = 0 :=
-begin
-  refine ⟨λ h, _, norm_sub_eq_abs_sub_norm_of_angle_eq_zero⟩,
-  rw ← inner_eq_mul_norm_iff_angle_eq_zero hx hy,
-  have h1 : ∥x - y∥ ^ 2 = (∥x∥ - ∥y∥) ^ 2, { rw h, exact sq_abs (∥x∥ - ∥y∥) },
-  rw norm_sub_pow_two_real at h1,
-  calc inner x y = ((∥x∥ + ∥y∥) ^ 2 - ∥x∥ ^ 2 - ∥y∥ ^ 2)/ 2 : by linarith
-  ...            = ∥x∥ * ∥y∥ : by ring,
-end
-
-/-- The norm of the sum of two vectors equals the norm of their difference if and only if
-the angle between them is π/2. -/
-lemma norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (x y : V) :
-  ∥x + y∥ = ∥x - y∥ ↔ angle x y = π / 2 :=
-begin
-  rw [← sq_eq_sq (norm_nonneg (x + y)) (norm_nonneg (x - y)),
-      ← inner_eq_zero_iff_angle_eq_pi_div_two x y, norm_add_pow_two_real, norm_sub_pow_two_real],
-  split; intro h; linarith,
-end
-
-end inner_product_geometry
-
 namespace euclidean_geometry
 /-!
 ### Geometrical results on Euclidean affine spaces
@@ -373,184 +58,23 @@ namespace euclidean_geometry
 This section develops some geometrical definitions and results on
 Euclidean affine spaces.
 -/
-open inner_product_geometry
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
-local notation `⟪`x`, `y`⟫` := @inner ℝ V _ x y
+variables {V : Type*} {P : Type*}
+variables [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P]
+variables [normed_add_torsor V P]
 include V
 
-/-- The undirected angle at `p2` between the line segments to `p1` and
-`p3`. If either of those points equals `p2`, this is π/2. Use
-`open_locale euclidean_geometry` to access the `∠ p1 p2 p3`
-notation. -/
-def angle (p1 p2 p3 : P) : ℝ := angle (p1 -ᵥ p2 : V) (p3 -ᵥ p2)
-
-localized "notation `∠` := euclidean_geometry.angle" in euclidean_geometry
-
-/-- The angle at a point does not depend on the order of the other two
-points. -/
-lemma angle_comm (p1 p2 p3 : P) : ∠ p1 p2 p3 = ∠ p3 p2 p1 :=
-angle_comm _ _
-
-/-- The angle at a point is nonnegative. -/
-lemma angle_nonneg (p1 p2 p3 : P) : 0 ≤ ∠ p1 p2 p3 :=
-angle_nonneg _ _
-
-/-- The angle at a point is at most π. -/
-lemma angle_le_pi (p1 p2 p3 : P) : ∠ p1 p2 p3 ≤ π :=
-angle_le_pi _ _
-
-/-- The angle ∠AAB at a point. -/
-lemma angle_eq_left (p1 p2 : P) : ∠ p1 p1 p2 = π / 2 :=
-begin
-  unfold angle,
-  rw vsub_self,
-  exact angle_zero_left _
-end
-
-/-- The angle ∠ABB at a point. -/
-lemma angle_eq_right (p1 p2 : P) : ∠ p1 p2 p2 = π / 2 :=
-by rw [angle_comm, angle_eq_left]
-
-/-- The angle ∠ABA at a point. -/
-lemma angle_eq_of_ne {p1 p2 : P} (h : p1 ≠ p2) : ∠ p1 p2 p1 = 0 :=
-angle_self (λ he, h (vsub_eq_zero_iff_eq.1 he))
-
-/-- If the angle ∠ABC at a point is π, the angle ∠BAC is 0. -/
-lemma angle_eq_zero_of_angle_eq_pi_left {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
-  ∠ p2 p1 p3 = 0 :=
-begin
-  unfold angle at h,
-  rw angle_eq_pi_iff at h,
-  rcases h with ⟨hp1p2, ⟨r, ⟨hr, hpr⟩⟩⟩,
-  unfold angle,
-  rw angle_eq_zero_iff,
-  rw [←neg_vsub_eq_vsub_rev, neg_ne_zero] at hp1p2,
-  use [hp1p2, -r + 1, add_pos (neg_pos_of_neg hr) zero_lt_one],
-  rw [add_smul, ←neg_vsub_eq_vsub_rev p1 p2, smul_neg],
-  simp [←hpr]
-end
-
-/-- If the angle ∠ABC at a point is π, the angle ∠BCA is 0. -/
-lemma angle_eq_zero_of_angle_eq_pi_right {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
-  ∠ p2 p3 p1 = 0 :=
-begin
-  rw angle_comm at h,
-  exact angle_eq_zero_of_angle_eq_pi_left h
-end
-
-/-- If ∠BCD = π, then ∠ABC = ∠ABD. -/
-lemma angle_eq_angle_of_angle_eq_pi (p1 : P) {p2 p3 p4 : P} (h : ∠ p2 p3 p4 = π) :
-  ∠ p1 p2 p3 = ∠ p1 p2 p4 :=
-begin
-  unfold angle at *,
-  rcases angle_eq_pi_iff.1 h with ⟨hp2p3, ⟨r, ⟨hr, hpr⟩⟩⟩,
-  rw [eq_comm],
-  convert angle_smul_right_of_pos (p1 -ᵥ p2) (p3 -ᵥ p2) (add_pos (neg_pos_of_neg hr) zero_lt_one),
-  rw [add_smul, ← neg_vsub_eq_vsub_rev p2 p3, smul_neg, neg_smul, ← hpr],
-  simp
-end
-
-/-- If ∠BCD = π, then ∠ACB + ∠ACD = π. -/
-lemma angle_add_angle_eq_pi_of_angle_eq_pi (p1 : P) {p2 p3 p4 : P} (h : ∠ p2 p3 p4 = π) :
-  ∠ p1 p3 p2 + ∠ p1 p3 p4 = π :=
-begin
-  unfold angle at h,
-  rw [angle_comm p1 p3 p2, angle_comm p1 p3 p4],
-  unfold angle,
-  exact angle_add_angle_eq_pi_of_angle_eq_pi _ h
-end
-
-/-- Vertical Angles Theorem: angles opposite each other, formed by two intersecting straight
-lines, are equal. -/
-lemma angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi {p1 p2 p3 p4 p5 : P}
-  (hapc : ∠ p1 p5 p3 = π) (hbpd : ∠ p2 p5 p4 = π) : ∠ p1 p5 p2 = ∠ p3 p5 p4 :=
-by linarith [angle_add_angle_eq_pi_of_angle_eq_pi p1 hbpd, angle_comm p4 p5 p1,
-             angle_add_angle_eq_pi_of_angle_eq_pi p4 hapc, angle_comm p4 p5 p3]
-
-/-- If ∠ABC = π then dist A B ≠ 0. -/
-lemma left_dist_ne_zero_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) : dist p1 p2 ≠ 0 :=
-begin
-  by_contra heq,
-  rw [dist_eq_zero] at heq,
-  rw [heq, angle_eq_left] at h,
-  exact real.pi_ne_zero (by linarith),
-end
-
-/-- If ∠ABC = π then dist C B ≠ 0. -/
-lemma right_dist_ne_zero_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) : dist p3 p2 ≠ 0 :=
-left_dist_ne_zero_of_angle_eq_pi $ (angle_comm _ _ _).trans h
-
-/-- If ∠ABC = π, then (dist A C) = (dist A B) + (dist B C). -/
-lemma dist_eq_add_dist_of_angle_eq_pi {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = π) :
-  dist p1 p3 = dist p1 p2 + dist p3 p2 :=
-begin
-  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
-  exact norm_sub_eq_add_norm_of_angle_eq_pi h,
-end
-
-/-- If A ≠ B and C ≠ B then ∠ABC = π if and only if (dist A C) = (dist A B) + (dist B C). -/
-lemma dist_eq_add_dist_iff_angle_eq_pi {p1 p2 p3 : P} (hp1p2 : p1 ≠ p2) (hp3p2 : p3 ≠ p2) :
-  dist p1 p3 = dist p1 p2 + dist p3 p2 ↔ ∠ p1 p2 p3 = π :=
-begin
-  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
-  exact norm_sub_eq_add_norm_iff_angle_eq_pi
-    ((λ he, hp1p2 (vsub_eq_zero_iff_eq.1 he))) (λ he, hp3p2 (vsub_eq_zero_iff_eq.1 he)),
-end
-
-/-- If ∠ABC = 0, then (dist A C) = abs ((dist A B) - (dist B C)). -/
-lemma dist_eq_abs_sub_dist_of_angle_eq_zero {p1 p2 p3 : P} (h : ∠ p1 p2 p3 = 0) :
-  (dist p1 p3) = |(dist p1 p2) - (dist p3 p2)| :=
-begin
-  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
-  exact norm_sub_eq_abs_sub_norm_of_angle_eq_zero h,
-end
-
-/-- If A ≠ B and C ≠ B then ∠ABC = 0 if and only if (dist A C) = abs ((dist A B) - (dist B C)). -/
-lemma dist_eq_abs_sub_dist_iff_angle_eq_zero {p1 p2 p3 : P} (hp1p2 : p1 ≠ p2) (hp3p2 : p3 ≠ p2) :
-  (dist p1 p3) = |(dist p1 p2) - (dist p3 p2)| ↔ ∠ p1 p2 p3 = 0 :=
-begin
-  rw [dist_eq_norm_vsub V, dist_eq_norm_vsub V, dist_eq_norm_vsub V, ← vsub_sub_vsub_cancel_right],
-  exact norm_sub_eq_abs_sub_norm_iff_angle_eq_zero
-    ((λ he, hp1p2 (vsub_eq_zero_iff_eq.1 he))) (λ he, hp3p2 (vsub_eq_zero_iff_eq.1 he)),
-end
-
 /-- The midpoint of the segment AB is the same distance from A as it is from B. -/
 lemma dist_left_midpoint_eq_dist_right_midpoint (p1 p2 : P) :
   dist p1 (midpoint ℝ p1 p2) = dist p2 (midpoint ℝ p1 p2) :=
 by rw [dist_left_midpoint p1 p2, dist_right_midpoint p1 p2]
 
-/-- If M is the midpoint of the segment AB, then ∠AMB = π. -/
-lemma angle_midpoint_eq_pi (p1 p2 : P) (hp1p2 : p1 ≠ p2) : ∠ p1 (midpoint ℝ p1 p2) p2 = π :=
-have p2 -ᵥ midpoint ℝ p1 p2 = -(p1 -ᵥ midpoint ℝ p1 p2), by { rw neg_vsub_eq_vsub_rev, simp },
-by simp [angle, this, hp1p2, -zero_lt_one]
-
-/-- If M is the midpoint of the segment AB and C is the same distance from A as it is from B
-then ∠CMA = π / 2. -/
-lemma angle_left_midpoint_eq_pi_div_two_of_dist_eq {p1 p2 p3 : P} (h : dist p3 p1 = dist p3 p2) :
-  ∠ p3 (midpoint ℝ p1 p2) p1 = π / 2 :=
-begin
-  let m : P := midpoint ℝ p1 p2,
-  have h1 : p3 -ᵥ p1 = (p3 -ᵥ m) - (p1 -ᵥ m) := (vsub_sub_vsub_cancel_right p3 p1 m).symm,
-  have h2 : p3 -ᵥ p2 = (p3 -ᵥ m) + (p1 -ᵥ m),
-  { rw [left_vsub_midpoint, ← midpoint_vsub_right, vsub_add_vsub_cancel] },
-  rw [dist_eq_norm_vsub V p3 p1, dist_eq_norm_vsub V p3 p2, h1, h2] at h,
-  exact (norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (p3 -ᵥ m) (p1 -ᵥ m)).mp h.symm,
-end
-
-/-- If M is the midpoint of the segment AB and C is the same distance from A as it is from B
-then ∠CMB = π / 2. -/
-lemma angle_right_midpoint_eq_pi_div_two_of_dist_eq {p1 p2 p3 : P} (h : dist p3 p1 = dist p3 p2) :
-  ∠ p3 (midpoint ℝ p1 p2) p2 = π / 2 :=
-by rw [midpoint_comm p1 p2, angle_left_midpoint_eq_pi_div_two_of_dist_eq h.symm]
-
 /-- The inner product of two vectors given with `weighted_vsub`, in
 terms of the pairwise distances. -/
 lemma inner_weighted_vsub {ι₁ : Type*} {s₁ : finset ι₁} {w₁ : ι₁ → ℝ} (p₁ : ι₁ → P)
     (h₁ : ∑ i in s₁, w₁ i = 0) {ι₂ : Type*} {s₂ : finset ι₂} {w₂ : ι₂ → ℝ} (p₂ : ι₂ → P)
     (h₂ : ∑ i in s₂, w₂ i = 0) :
-  inner (s₁.weighted_vsub p₁ w₁) (s₂.weighted_vsub p₂ w₂) =
+  ⟪s₁.weighted_vsub p₁ w₁, s₂.weighted_vsub p₂ w₂⟫ =
     (-∑ i₁ in s₁, ∑ i₂ in s₂,
       w₁ i₁ * w₂ i₂ * (dist (p₁ i₁) (p₂ i₂) * dist (p₁ i₁) (p₂ i₂))) / 2 :=
 begin
@@ -565,13 +89,12 @@ in terms of the pairwise distances between the points in that
 combination. -/
 lemma dist_affine_combination {ι : Type*} {s : finset ι} {w₁ w₂ : ι → ℝ} (p : ι → P)
     (h₁ : ∑ i in s, w₁ i = 1) (h₂ : ∑ i in s, w₂ i = 1) :
-  dist (s.affine_combination p w₁) (s.affine_combination p w₂) *
-    dist (s.affine_combination p w₁) (s.affine_combination p w₂) =
-    (-∑ i₁ in s, ∑ i₂ in s,
+  by have a₁ := s.affine_combination ℝ p w₁; have a₂ := s.affine_combination ℝ p w₂; exact
+  dist a₁ a₂ * dist a₁ a₂ = (-∑ i₁ in s, ∑ i₂ in s,
       (w₁ - w₂) i₁ * (w₁ - w₂) i₂ * (dist (p i₁) (p i₂) * dist (p i₁) (p i₂))) / 2 :=
 begin
-  rw [dist_eq_norm_vsub V (s.affine_combination p w₁) (s.affine_combination p w₂),
-      ←inner_self_eq_norm_mul_norm, finset.affine_combination_vsub],
+  rw [dist_eq_norm_vsub V (s.affine_combination ℝ p w₁) (s.affine_combination ℝ p w₂),
+      ←@inner_self_eq_norm_mul_norm ℝ, finset.affine_combination_vsub],
   have h : ∑ i in s, (w₁ - w₂) i = 0,
   { simp_rw [pi.sub_apply, finset.sum_sub_distrib, h₁, h₂, sub_self] },
   exact inner_weighted_vsub p h p h
@@ -587,7 +110,7 @@ begin
   have h : ⟪(c₂ -ᵥ c₁) + (c₂ -ᵥ c₁), p₂ -ᵥ p₁⟫ = 0,
   { conv_lhs { congr, congr, rw ←vsub_sub_vsub_cancel_right c₂ c₁ p₁,
                skip, rw ←vsub_sub_vsub_cancel_right c₂ c₁ p₂ },
-    rw [←add_sub_comm, inner_sub_left],
+    rw [sub_add_sub_comm, inner_sub_left],
     conv_lhs { congr, rw ←vsub_sub_vsub_cancel_right p₂ p₁ c₂,
                skip, rw ←vsub_sub_vsub_cancel_right p₂ p₁ c₁ },
     rw [dist_comm p₁, dist_comm p₂, dist_eq_norm_vsub V _ p₁,
@@ -619,7 +142,7 @@ begin
                  ←real_inner_self_eq_norm_mul_norm, sub_self] },
   have hvi : ⟪v, v⟫ ≠ 0, by simpa using hv,
   have hd : discrim ⟪v, v⟫ (2 * ⟪v, p₁ -ᵥ p₂⟫) 0 =
-    (2 * inner v (p₁ -ᵥ p₂)) * (2 * inner v (p₁ -ᵥ p₂)),
+    (2 * ⟪v, p₁ -ᵥ p₂⟫) * (2 * ⟪v, p₁ -ᵥ p₂⟫),
   { rw discrim, ring },
   rw [quadratic_eq_zero_iff hvi hd, add_left_neg, zero_div, neg_mul_eq_neg_mul,
       ←mul_sub_right_distrib, sub_eq_add_neg, ←mul_two, mul_assoc, mul_div_assoc,
@@ -765,6 +288,8 @@ lemma orthogonal_projection_fn_vsub_mem_direction_orthogonal {s : affine_subspac
 direction_mk' p s.directionᗮ ▸
   vsub_mem_direction (orthogonal_projection_fn_mem_orthogonal p) (self_mem_mk' _ _)
 
+local attribute [instance] affine_subspace.to_add_torsor
+
 /-- The orthogonal projection of a point onto a nonempty affine
 subspace, whose direction is complete. The corresponding linear map
 (mapping a vector to the difference between the projections of two
@@ -963,7 +488,7 @@ lemma dist_sq_eq_dist_orthogonal_projection_sq_add_dist_orthogonal_projection_sq
     dist p1 (orthogonal_projection s p2) * dist p1 (orthogonal_projection s p2) +
     dist p2 (orthogonal_projection s p2) * dist p2 (orthogonal_projection s p2) :=
 begin
-  rw [pseudo_metric_space.dist_comm p2 _, dist_eq_norm_vsub V p1 _, dist_eq_norm_vsub V p1 _,
+  rw [dist_comm p2 _, dist_eq_norm_vsub V p1 _, dist_eq_norm_vsub V p1 _,
     dist_eq_norm_vsub V _ p2, ← vsub_add_vsub_cancel p1 (orthogonal_projection s p2) p2,
     norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero],
   exact submodule.inner_right_of_mem_orthogonal
@@ -978,18 +503,18 @@ lemma dist_sq_smul_orthogonal_vadd_smul_orthogonal_vadd {s : affine_subspace ℝ
     {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) (r1 r2 : ℝ) {v : V}
     (hv : v ∈ s.directionᗮ) :
   dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) * dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) =
-    dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (∥v∥ * ∥v∥) :=
+    dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (‖v‖ * ‖v‖) :=
 calc dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2) * dist (r1 • v +ᵥ p1) (r2 • v +ᵥ p2)
-    = ∥(p1 -ᵥ p2) + (r1 - r2) • v∥ * ∥(p1 -ᵥ p2) + (r1 - r2) • v∥
+    = ‖(p1 -ᵥ p2) + (r1 - r2) • v‖ * ‖(p1 -ᵥ p2) + (r1 - r2) • v‖
   : by rw [dist_eq_norm_vsub V (r1 • v +ᵥ p1), vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, sub_smul,
       add_comm, add_sub_assoc]
-... = ∥p1 -ᵥ p2∥ * ∥p1 -ᵥ p2∥ + ∥(r1 - r2) • v∥ * ∥(r1 - r2) • v∥
+... = ‖p1 -ᵥ p2‖ * ‖p1 -ᵥ p2‖ + ‖(r1 - r2) • v‖ * ‖(r1 - r2) • v‖
   : norm_add_sq_eq_norm_sq_add_norm_sq_real
       (submodule.inner_right_of_mem_orthogonal (vsub_mem_direction hp1 hp2)
         (submodule.smul_mem _ _ hv))
-... = ∥(p1 -ᵥ p2 : V)∥ * ∥(p1 -ᵥ p2 : V)∥ + |r1 - r2| * |r1 - r2| * ∥v∥ * ∥v∥
+... = ‖(p1 -ᵥ p2 : V)‖ * ‖(p1 -ᵥ p2 : V)‖ + |r1 - r2| * |r1 - r2| * ‖v‖ * ‖v‖
   : by { rw [norm_smul, real.norm_eq_abs], ring }
-... = dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (∥v∥ * ∥v∥)
+... = dist p1 p2 * dist p1 p2 + (r1 - r2) * (r1 - r2) * (‖v‖ * ‖v‖)
   : by { rw [dist_eq_norm_vsub V p1, abs_mul_abs_self, mul_assoc] }
 
 /-- Reflection in an affine subspace, which is expected to be nonempty
@@ -1144,101 +669,4 @@ lemma reflection_vadd_smul_vsub_orthogonal_projection {s : affine_subspace ℝ P
 reflection_orthogonal_vadd hp₁
   (submodule.smul_mem _ _ (vsub_orthogonal_projection_mem_direction_orthogonal s _))
 
-omit V
-
-/-- A set of points is cospherical if they are equidistant from some
-point.  In two dimensions, this is the same thing as being
-concyclic. -/
-def cospherical (ps : set P) : Prop :=
-∃ (center : P) (radius : ℝ), ∀ p ∈ ps, dist p center = radius
-
-/-- The definition of `cospherical`. -/
-lemma cospherical_def (ps : set P) :
-  cospherical ps ↔ ∃ (center : P) (radius : ℝ), ∀ p ∈ ps, dist p center = radius :=
-iff.rfl
-
-/-- A subset of a cospherical set is cospherical. -/
-lemma cospherical_subset {ps₁ ps₂ : set P} (hs : ps₁ ⊆ ps₂) (hc : cospherical ps₂) :
-  cospherical ps₁ :=
-begin
-  rcases hc with ⟨c, r, hcr⟩,
-  exact ⟨c, r, λ p hp, hcr p (hs hp)⟩
-end
-
-include V
-
-/-- The empty set is cospherical. -/
-lemma cospherical_empty : cospherical (∅ : set P) :=
-begin
-  use add_torsor.nonempty.some,
-  simp,
-end
-
-omit V
-
-/-- A single point is cospherical. -/
-lemma cospherical_singleton (p : P) : cospherical ({p} : set P) :=
-begin
-  use p,
-  simp
-end
-
-include V
-
-/-- Two points are cospherical. -/
-lemma cospherical_insert_singleton (p₁ p₂ : P) : cospherical ({p₁, p₂} : set P) :=
-begin
-  use [(2⁻¹ : ℝ) • (p₂ -ᵥ p₁) +ᵥ p₁, (2⁻¹ : ℝ) * (dist p₂ p₁)],
-  intro p,
-  rw [set.mem_insert_iff, set.mem_singleton_iff],
-  rintro ⟨_|_⟩,
-  { rw [dist_eq_norm_vsub V p₁, vsub_vadd_eq_vsub_sub, vsub_self, zero_sub, norm_neg, norm_smul,
-        dist_eq_norm_vsub V p₂],
-    simp },
-  { rw [H, dist_eq_norm_vsub V p₂, vsub_vadd_eq_vsub_sub, dist_eq_norm_vsub V p₂],
-    conv_lhs { congr, congr, rw ←one_smul ℝ (p₂ -ᵥ p₁ : V) },
-    rw [←sub_smul, norm_smul],
-    norm_num }
-end
-
-/-- Any three points in a cospherical set are affinely independent. -/
-lemma cospherical.affine_independent {s : set P} (hs : cospherical s) {p : fin 3 → P}
-  (hps : set.range p ⊆ s) (hpi : function.injective p) :
-  affine_independent ℝ p :=
-begin
-  rw affine_independent_iff_not_collinear,
-  intro hc,
-  rw collinear_iff_of_mem ℝ (set.mem_range_self (0 : fin 3)) at hc,
-  rcases hc with ⟨v, hv⟩,
-  rw set.forall_range_iff at hv,
-  have hv0 : v ≠ 0,
-  { intro h,
-    have he : p 1 = p 0, by simpa [h] using hv 1,
-    exact (dec_trivial : (1 : fin 3) ≠ 0) (hpi he) },
-  rcases hs with ⟨c, r, hs⟩,
-  have hs' := λ i, hs (p i) (set.mem_of_mem_of_subset (set.mem_range_self _) hps),
-  choose f hf using hv,
-  have hsd : ∀ i, dist ((f i • v) +ᵥ p 0) c = r,
-  { intro i,
-    rw ←hf,
-    exact hs' i },
-  have hf0 : f 0 = 0,
-  { have hf0' := hf 0,
-    rw [eq_comm, ←@vsub_eq_zero_iff_eq V, vadd_vsub, smul_eq_zero] at hf0',
-    simpa [hv0] using hf0' },
-  have hfi : function.injective f,
-  { intros i j h,
-    have hi := hf i,
-    rw [h, ←hf j] at hi,
-    exact hpi hi },
-  simp_rw [←hsd 0, hf0, zero_smul, zero_vadd, dist_smul_vadd_eq_dist (p 0) c hv0] at hsd,
-  have hfn0 : ∀ i, i ≠ 0 → f i ≠ 0 := λ i, (hfi.ne_iff' hf0).2,
-  have hfn0' : ∀ i, i ≠ 0 → f i = (-2) * ⟪v, (p 0 -ᵥ c)⟫ / ⟪v, v⟫,
-  { intros i hi,
-    have hsdi := hsd i,
-    simpa [hfn0, hi] using hsdi },
-  have hf12 : f 1 = f 2, { rw [hfn0' 1 dec_trivial, hfn0' 2 dec_trivial] },
-  exact (dec_trivial : (1 : fin 3) ≠ 2) (hfi hf12)
-end
-
 end euclidean_geometry
diff --git a/src/geometry/euclidean/circumcenter.lean b/src/geometry/euclidean/circumcenter.lean
index bb4fbc109bac0..a65c0db65410b 100644
--- a/src/geometry/euclidean/circumcenter.lean
+++ b/src/geometry/euclidean/circumcenter.lean
@@ -3,13 +3,16 @@ Copyright (c) 2020 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers
 -/
-import geometry.euclidean.basic
+import geometry.euclidean.sphere.basic
 import linear_algebra.affine_space.finite_dimensional
 import tactic.derive_fintype
 
 /-!
 # Circumcenter and circumradius
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves some lemmas on points equidistant from a set of
 points, and defines the circumradius and circumcenter of a simplex.
 There are also some definitions for use in calculations where it is
@@ -30,15 +33,12 @@ the circumcenter.
 noncomputable theory
 open_locale big_operators
 open_locale classical
-open_locale real
 open_locale real_inner_product_space
 
 namespace euclidean_geometry
 
-open inner_product_geometry
-
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 include V
 
 open affine_subspace
@@ -95,21 +95,21 @@ subspace with `p` added. -/
 lemma exists_unique_dist_eq_of_insert {s : affine_subspace ℝ P}
   [complete_space s.direction] {ps : set P} (hnps : ps.nonempty) {p : P}
   (hps : ps ⊆ s) (hp : p ∉ s)
-  (hu : ∃! cccr : (P × ℝ), cccr.fst ∈ s ∧ ∀ p1 ∈ ps, dist p1 cccr.fst = cccr.snd) :
-  ∃! cccr₂ : (P × ℝ), cccr₂.fst ∈ affine_span ℝ (insert p (s : set P)) ∧
-    ∀ p1 ∈ insert p ps, dist p1 cccr₂.fst = cccr₂.snd :=
+  (hu : ∃! cs : sphere P, cs.center ∈ s ∧ ps ⊆ (cs : set P)) :
+  ∃! cs₂ : sphere P, cs₂.center ∈ affine_span ℝ (insert p (s : set P)) ∧
+    (insert p ps) ⊆ (cs₂ : set P) :=
 begin
   haveI : nonempty s := set.nonempty.to_subtype (hnps.mono hps),
   rcases hu with ⟨⟨cc, cr⟩, ⟨hcc, hcr⟩, hcccru⟩,
-  simp only [prod.fst, prod.snd] at hcc hcr hcccru,
+  simp only at hcc hcr hcccru,
   let x := dist cc (orthogonal_projection s p),
   let y := dist p (orthogonal_projection s p),
   have hy0 : y ≠ 0 := dist_orthogonal_projection_ne_zero_of_not_mem hp,
   let ycc₂ := (x * x + y * y - cr * cr) / (2 * y),
   let cc₂ := (ycc₂ / y) • (p -ᵥ orthogonal_projection s p : V) +ᵥ cc,
   let cr₂ := real.sqrt (cr * cr + ycc₂ * ycc₂),
-  use (cc₂, cr₂),
-  simp only [prod.fst, prod.snd],
+  use ⟨cc₂, cr₂⟩,
+  simp only,
   have hpo : p = (1 : ℝ) • (p -ᵥ orthogonal_projection s p : V) +ᵥ orthogonal_projection s p,
   { simp },
   split,
@@ -120,7 +120,7 @@ begin
         (vsub_mem_vector_span ℝ (set.mem_insert _ _)
                                 (set.mem_insert_of_mem _ (orthogonal_projection_mem _))) },
     { intros p1 hp1,
-      rw [←mul_self_inj_of_nonneg dist_nonneg (real.sqrt_nonneg _),
+      rw [sphere.mem_coe, mem_sphere, ←mul_self_inj_of_nonneg dist_nonneg (real.sqrt_nonneg _),
           real.mul_self_sqrt (add_nonneg (mul_self_nonneg _) (mul_self_nonneg _))],
       cases hp1,
       { rw hp1,
@@ -134,39 +134,39 @@ begin
       { rw [dist_sq_eq_dist_orthogonal_projection_sq_add_dist_orthogonal_projection_sq
                _ (hps hp1),
             orthogonal_projection_vadd_smul_vsub_orthogonal_projection _ _ hcc, subtype.coe_mk,
-            hcr _ hp1, dist_eq_norm_vsub V cc₂ cc, vadd_vsub, norm_smul, ←dist_eq_norm_vsub V,
+            dist_of_mem_subset_mk_sphere hp1 hcr,
+            dist_eq_norm_vsub V cc₂ cc, vadd_vsub, norm_smul, ←dist_eq_norm_vsub V,
             real.norm_eq_abs, abs_div, abs_of_nonneg dist_nonneg, div_mul_cancel _ hy0,
             abs_mul_abs_self] } } },
   { rintros ⟨cc₃, cr₃⟩ ⟨hcc₃, hcr₃⟩,
-    simp only [prod.fst, prod.snd] at hcc₃ hcr₃,
+    simp only at hcc₃ hcr₃,
     obtain ⟨t₃, cc₃', hcc₃', hcc₃''⟩ :
       ∃ (r : ℝ) (p0 : P) (hp0 : p0 ∈ s), cc₃ = r • (p -ᵥ ↑((orthogonal_projection s) p)) +ᵥ p0,
     { rwa mem_affine_span_insert_iff (orthogonal_projection_mem p) at hcc₃ },
     have hcr₃' : ∃ r, ∀ p1 ∈ ps, dist p1 cc₃ = r :=
-      ⟨cr₃, λ p1 hp1, hcr₃ p1 (set.mem_insert_of_mem _ hp1)⟩,
+      ⟨cr₃, λ p1 hp1, dist_of_mem_subset_mk_sphere (set.mem_insert_of_mem _ hp1) hcr₃⟩,
     rw [exists_dist_eq_iff_exists_dist_orthogonal_projection_eq hps cc₃, hcc₃'',
       orthogonal_projection_vadd_smul_vsub_orthogonal_projection _ _ hcc₃'] at hcr₃',
     cases hcr₃' with cr₃' hcr₃',
-    have hu := hcccru (cc₃', cr₃'),
-    simp only [prod.fst, prod.snd] at hu,
+    have hu := hcccru ⟨cc₃', cr₃'⟩,
+    simp only at hu,
     replace hu := hu ⟨hcc₃', hcr₃'⟩,
-    rw prod.ext_iff at hu,
-    simp only [prod.fst, prod.snd] at hu,
     cases hu with hucc hucr,
     substs hucc hucr,
     have hcr₃val : cr₃ = real.sqrt (cr₃' * cr₃' + (t₃ * y) * (t₃ * y)),
     { cases hnps with p0 hp0,
       have h' : ↑(⟨cc₃', hcc₃'⟩ : s) = cc₃' := rfl,
-      rw [←hcr₃ p0 (set.mem_insert_of_mem _ hp0), hcc₃'',
+      rw [←dist_of_mem_subset_mk_sphere (set.mem_insert_of_mem _ hp0) hcr₃, hcc₃'',
           ←mul_self_inj_of_nonneg dist_nonneg (real.sqrt_nonneg _),
           real.mul_self_sqrt (add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)),
           dist_sq_eq_dist_orthogonal_projection_sq_add_dist_orthogonal_projection_sq
             _ (hps hp0),
-          orthogonal_projection_vadd_smul_vsub_orthogonal_projection _ _ hcc₃', h', hcr p0 hp0,
+          orthogonal_projection_vadd_smul_vsub_orthogonal_projection _ _ hcc₃', h',
+          dist_of_mem_subset_mk_sphere hp0 hcr,
           dist_eq_norm_vsub V _ cc₃', vadd_vsub, norm_smul, ←dist_eq_norm_vsub V p,
           real.norm_eq_abs, ←mul_assoc, mul_comm _ (|t₃|), ←mul_assoc, abs_mul_abs_self],
       ring },
-    replace hcr₃ := hcr₃ p (set.mem_insert _ _),
+    replace hcr₃ := dist_of_mem_subset_mk_sphere (set.mem_insert _ _) hcr₃,
     rw [hpo, hcc₃'', hcr₃val, ←mul_self_inj_of_nonneg dist_nonneg (real.sqrt_nonneg _),
         dist_sq_smul_orthogonal_vadd_smul_orthogonal_vadd
           (orthogonal_projection_mem p) hcc₃' _ _
@@ -191,11 +191,11 @@ end
 /-- Given a finite nonempty affinely independent family of points,
 there is a unique (circumcenter, circumradius) pair for those points
 in the affine subspace they span. -/
-lemma _root_.affine_independent.exists_unique_dist_eq {ι : Type*} [hne : nonempty ι] [fintype ι]
+lemma _root_.affine_independent.exists_unique_dist_eq {ι : Type*} [hne : nonempty ι] [finite ι]
     {p : ι → P} (ha : affine_independent ℝ p) :
-  ∃! cccr : (P × ℝ), cccr.fst ∈ affine_span ℝ (set.range p) ∧
-    ∀ i, dist (p i) cccr.fst = cccr.snd :=
+  ∃! cs : sphere P, cs.center ∈ affine_span ℝ (set.range p) ∧ set.range p ⊆ (cs : set P) :=
 begin
+  casesI nonempty_fintype ι,
   unfreezingI { induction hn : fintype.card ι with m hm generalizing ι },
   { exfalso,
     have h := fintype.card_pos_iff.2 hne,
@@ -205,21 +205,17 @@ begin
     { rw fintype.card_eq_one_iff at hn,
       cases hn with i hi,
       haveI : unique ι := ⟨⟨i⟩, hi⟩,
-      use (p i, 0),
-      simp only [prod.fst, prod.snd, set.range_unique, affine_subspace.mem_affine_span_singleton],
+      use ⟨p i, 0⟩,
+      simp only [set.range_unique, affine_subspace.mem_affine_span_singleton],
       split,
-      { simp_rw [hi default],
-        use rfl,
-        intro i1,
-        rw hi i1,
-        exact dist_self _ },
+      { simp_rw [hi default, set.singleton_subset_iff, sphere.mem_coe, mem_sphere, dist_self],
+        exact ⟨rfl, rfl⟩ },
       { rintros ⟨cc, cr⟩,
-        simp only [prod.fst, prod.snd],
+        simp only,
         rintros ⟨rfl, hdist⟩,
-        rw hi default,
-        congr',
-        rw ←hdist default,
-        exact dist_self _ } },
+        simp_rw [set.singleton_subset_iff, sphere.mem_coe, mem_sphere, dist_self] at hdist,
+        rw [hi default, hdist],
+        exact ⟨rfl, rfl⟩ } },
     { have i := hne.some,
       let ι2 := {x // x ≠ i},
       have hc : fintype.card ι2 = m + 1,
@@ -233,19 +229,13 @@ begin
         { simp } },
       haveI : nonempty ι2 := fintype.card_pos_iff.1 (hc.symm ▸ nat.zero_lt_succ _),
       have ha2 : affine_independent ℝ (λ i2 : ι2, p i2) := ha.subtype _,
-      replace hm := hm ha2 hc,
+      replace hm := hm ha2 _ hc,
       have hr : set.range p = insert (p i) (set.range (λ i2 : ι2, p i2)),
       { change _ = insert _ (set.range (λ i2 : {x | x ≠ i}, p i2)),
         rw [←set.image_eq_range, ←set.image_univ, ←set.image_insert_eq],
         congr' with j,
         simp [classical.em] },
-      change ∃! (cccr : P × ℝ), (_ ∧ ∀ i2, (λ q, dist q cccr.fst = cccr.snd) (p i2)),
-      conv { congr, funext, conv { congr, skip, rw ←set.forall_range_iff } },
-      dsimp only,
-      rw hr,
-      change ∃! (cccr : P × ℝ), (_ ∧ ∀ (i2 : ι2), (λ q, dist q cccr.fst = cccr.snd) (p i2)) at hm,
-      conv at hm { congr, funext, conv { congr, skip, rw ←set.forall_range_iff } },
-      rw ←affine_span_insert_affine_span,
+      rw [hr, ←affine_span_insert_affine_span],
       refine exists_unique_dist_eq_of_insert
         (set.range_nonempty _)
         (subset_span_points ℝ _)
@@ -265,40 +255,55 @@ namespace simplex
 
 open finset affine_subspace euclidean_geometry
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 include V
 
-/-- The pair (circumcenter, circumradius) of a simplex. -/
-def circumcenter_circumradius {n : ℕ} (s : simplex ℝ P n) : (P × ℝ) :=
+/-- The circumsphere of a simplex. -/
+def circumsphere {n : ℕ} (s : simplex ℝ P n) : sphere P :=
 s.independent.exists_unique_dist_eq.some
 
-/-- The property satisfied by the (circumcenter, circumradius) pair. -/
-lemma circumcenter_circumradius_unique_dist_eq {n : ℕ} (s : simplex ℝ P n) :
-  (s.circumcenter_circumradius.fst ∈ affine_span ℝ (set.range s.points) ∧
-    ∀ i, dist (s.points i) s.circumcenter_circumradius.fst = s.circumcenter_circumradius.snd) ∧
-  (∀ cccr : (P × ℝ), (cccr.fst ∈ affine_span ℝ (set.range s.points) ∧
-    ∀ i, dist (s.points i) cccr.fst = cccr.snd) → cccr = s.circumcenter_circumradius) :=
+/-- The property satisfied by the circumsphere. -/
+lemma circumsphere_unique_dist_eq {n : ℕ} (s : simplex ℝ P n) :
+  (s.circumsphere.center ∈ affine_span ℝ (set.range s.points) ∧
+    set.range s.points ⊆ s.circumsphere) ∧
+  (∀ cs : sphere P, (cs.center ∈ affine_span ℝ (set.range s.points) ∧
+    set.range s.points ⊆ cs → cs = s.circumsphere)) :=
 s.independent.exists_unique_dist_eq.some_spec
 
 /-- The circumcenter of a simplex. -/
 def circumcenter {n : ℕ} (s : simplex ℝ P n) : P :=
-s.circumcenter_circumradius.fst
+s.circumsphere.center
 
 /-- The circumradius of a simplex. -/
 def circumradius {n : ℕ} (s : simplex ℝ P n) : ℝ :=
-s.circumcenter_circumradius.snd
+s.circumsphere.radius
+
+/-- The center of the circumsphere is the circumcenter. -/
+@[simp] lemma circumsphere_center {n : ℕ} (s : simplex ℝ P n) :
+  s.circumsphere.center = s.circumcenter :=
+rfl
+
+/-- The radius of the circumsphere is the circumradius. -/
+@[simp] lemma circumsphere_radius {n : ℕ} (s : simplex ℝ P n) :
+  s.circumsphere.radius = s.circumradius :=
+rfl
 
 /-- The circumcenter lies in the affine span. -/
 lemma circumcenter_mem_affine_span {n : ℕ} (s : simplex ℝ P n) :
   s.circumcenter ∈ affine_span ℝ (set.range s.points) :=
-s.circumcenter_circumradius_unique_dist_eq.1.1
+s.circumsphere_unique_dist_eq.1.1
 
 /-- All points have distance from the circumcenter equal to the
 circumradius. -/
-@[simp] lemma dist_circumcenter_eq_circumradius {n : ℕ} (s : simplex ℝ P n) :
-  ∀ i, dist (s.points i) s.circumcenter = s.circumradius :=
-s.circumcenter_circumradius_unique_dist_eq.1.2
+@[simp] lemma dist_circumcenter_eq_circumradius {n : ℕ} (s : simplex ℝ P n) (i : fin (n + 1)) :
+  dist (s.points i) s.circumcenter = s.circumradius :=
+dist_of_mem_subset_sphere (set.mem_range_self _) s.circumsphere_unique_dist_eq.1.2
+
+/-- All points lie in the circumsphere. -/
+lemma mem_circumsphere {n : ℕ} (s : simplex ℝ P n) (i : fin (n + 1)) :
+  s.points i ∈ s.circumsphere :=
+s.dist_circumcenter_eq_circumradius i
 
 /-- All points have distance to the circumcenter equal to the
 circumradius. -/
@@ -316,8 +321,9 @@ lemma eq_circumcenter_of_dist_eq {n : ℕ} (s : simplex ℝ P n) {p : P}
     (hp : p ∈ affine_span ℝ (set.range s.points)) {r : ℝ} (hr : ∀ i, dist (s.points i) p = r) :
   p = s.circumcenter :=
 begin
-  have h := s.circumcenter_circumradius_unique_dist_eq.2 (p, r),
-  simp only [hp, hr, forall_const, eq_self_iff_true, and_self, prod.ext_iff] at h,
+  have h := s.circumsphere_unique_dist_eq.2 ⟨p, r⟩,
+  simp only [hp, hr, forall_const, eq_self_iff_true, subset_sphere, sphere.ext_iff,
+             set.forall_range_iff, mem_sphere, true_and] at h,
   exact h.1
 end
 
@@ -327,8 +333,9 @@ lemma eq_circumradius_of_dist_eq {n : ℕ} (s : simplex ℝ P n) {p : P}
     (hp : p ∈ affine_span ℝ (set.range s.points)) {r : ℝ} (hr : ∀ i, dist (s.points i) p = r) :
   r = s.circumradius :=
 begin
-  have h := s.circumcenter_circumradius_unique_dist_eq.2 (p, r),
-  simp only [hp, hr, forall_const, eq_self_iff_true, and_self, prod.ext_iff] at h,
+  have h := s.circumsphere_unique_dist_eq.2 ⟨p, r⟩,
+  simp only [hp, hr, forall_const, eq_self_iff_true, subset_sphere, sphere.ext_iff,
+             set.forall_range_iff, mem_sphere, true_and] at h,
   exact h.2
 end
 
@@ -366,7 +373,7 @@ begin
     (λ i j : fin 2, dist (s.points i) (finset.univ.centroid ℝ s.points) =
                     dist (s.points j) (finset.univ.centroid ℝ s.points)),
   { intros i hi j hj hij,
-    rw [finset.centroid_insert_singleton_fin, dist_eq_norm_vsub V (s.points i),
+    rw [finset.centroid_pair_fin, dist_eq_norm_vsub V (s.points i),
         dist_eq_norm_vsub V (s.points j), vsub_vadd_eq_vsub_sub, vsub_vadd_eq_vsub_sub,
         ←one_smul ℝ (s.points i -ᵥ s.points 0), ←one_smul ℝ (s.points j -ᵥ s.points 0)],
     fin_cases i; fin_cases j; simp [-one_smul, ←sub_smul]; norm_num },
@@ -377,6 +384,27 @@ begin
           (λ i, hr i (set.mem_univ _))).symm
 end
 
+/-- Reindexing a simplex along an `equiv` of index types does not change the circumsphere. -/
+@[simp] lemma circumsphere_reindex {m n : ℕ} (s : simplex ℝ P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).circumsphere = s.circumsphere :=
+begin
+  refine s.circumsphere_unique_dist_eq.2 _ ⟨_, _⟩; rw ←s.reindex_range_points e,
+  { exact (s.reindex e).circumsphere_unique_dist_eq.1.1 },
+  { exact (s.reindex e).circumsphere_unique_dist_eq.1.2 }
+end
+
+/-- Reindexing a simplex along an `equiv` of index types does not change the circumcenter. -/
+@[simp] lemma circumcenter_reindex {m n : ℕ} (s : simplex ℝ P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).circumcenter = s.circumcenter :=
+by simp_rw [←circumcenter, circumsphere_reindex]
+
+/-- Reindexing a simplex along an `equiv` of index types does not change the circumradius. -/
+@[simp] lemma circumradius_reindex {m n : ℕ} (s : simplex ℝ P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).circumradius = s.circumradius :=
+by simp_rw [←circumradius, circumsphere_reindex]
+
+local attribute [instance] affine_subspace.to_add_torsor
+
 /-- The orthogonal projection of a point `p` onto the hyperplane spanned by the simplex's points. -/
 def orthogonal_projection_span {n : ℕ} (s : simplex ℝ P n) :
   P →ᵃ[ℝ] affine_span ℝ (set.range s.points) :=
@@ -558,7 +586,7 @@ include V
 lemma point_eq_affine_combination_of_points_with_circumcenter {n : ℕ} (s : simplex ℝ P n)
   (i : fin (n + 1)) :
   s.points i =
-    (univ : finset (points_with_circumcenter_index n)).affine_combination
+    (univ : finset (points_with_circumcenter_index n)).affine_combination ℝ
       s.points_with_circumcenter (point_weights_with_circumcenter i) :=
 begin
   rw ←points_with_circumcenter_point,
@@ -602,7 +630,7 @@ include V
 lemma centroid_eq_affine_combination_of_points_with_circumcenter {n : ℕ} (s : simplex ℝ P n)
   (fs : finset (fin (n + 1))) :
   fs.centroid ℝ s.points =
-    (univ : finset (points_with_circumcenter_index n)).affine_combination
+    (univ : finset (points_with_circumcenter_index n)).affine_combination ℝ
       s.points_with_circumcenter (centroid_weights_with_circumcenter fs) :=
 begin
   simp_rw [centroid_def, affine_combination_apply,
@@ -641,7 +669,7 @@ include V
 `points_with_circumcenter`. -/
 lemma circumcenter_eq_affine_combination_of_points_with_circumcenter {n : ℕ}
   (s : simplex ℝ P n) :
-  s.circumcenter = (univ : finset (points_with_circumcenter_index n)).affine_combination
+  s.circumcenter = (univ : finset (points_with_circumcenter_index n)).affine_combination ℝ
     s.points_with_circumcenter (circumcenter_weights_with_circumcenter n) :=
 begin
   rw ←points_with_circumcenter_eq_circumcenter,
@@ -677,7 +705,7 @@ terms of `points_with_circumcenter`. -/
 lemma reflection_circumcenter_eq_affine_combination_of_points_with_circumcenter {n : ℕ}
   (s : simplex ℝ P n) {i₁ i₂ : fin (n + 1)} (h : i₁ ≠ i₂) :
   reflection (affine_span ℝ (s.points '' {i₁, i₂})) s.circumcenter =
-    (univ : finset (points_with_circumcenter_index n)).affine_combination
+    (univ : finset (points_with_circumcenter_index n)).affine_combination ℝ
       s.points_with_circumcenter (reflection_circumcenter_weights_with_circumcenter i₁ i₂) :=
 begin
   have hc : card ({i₁, i₂} : finset (fin (n + 1))) = 2,
@@ -710,8 +738,8 @@ namespace euclidean_geometry
 
 open affine affine_subspace finite_dimensional
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 include V
 
 /-- Given a nonempty affine subspace, whose direction is complete,
@@ -849,6 +877,53 @@ begin
   rw [hr sx₁ hsx₁, hr sx₂ hsx₂]
 end
 
+/-- All n-simplices among cospherical points in an n-dimensional
+subspace have the same circumsphere. -/
+lemma exists_circumsphere_eq_of_cospherical_subset {s : affine_subspace ℝ P} {ps : set P}
+  (h : ps ⊆ s) [nonempty s] {n : ℕ} [finite_dimensional ℝ s.direction]
+  (hd : finrank ℝ s.direction = n) (hc : cospherical ps) :
+  ∃ c : sphere P, ∀ sx : simplex ℝ P n, set.range sx.points ⊆ ps → sx.circumsphere = c :=
+begin
+  obtain ⟨r, hr⟩ := exists_circumradius_eq_of_cospherical_subset h hd hc,
+  obtain ⟨c, hc⟩ := exists_circumcenter_eq_of_cospherical_subset h hd hc,
+  exact ⟨⟨c, r⟩, λ sx hsx, sphere.ext _ _ (hc sx hsx) (hr sx hsx)⟩
+end
+
+/-- Two n-simplices among cospherical points in an n-dimensional
+subspace have the same circumsphere. -/
+lemma circumsphere_eq_of_cospherical_subset {s : affine_subspace ℝ P} {ps : set P}
+  (h : ps ⊆ s) [nonempty s] {n : ℕ} [finite_dimensional ℝ s.direction]
+  (hd : finrank ℝ s.direction = n) (hc : cospherical ps) {sx₁ sx₂ : simplex ℝ P n}
+  (hsx₁ : set.range sx₁.points ⊆ ps) (hsx₂ : set.range sx₂.points ⊆ ps) :
+  sx₁.circumsphere = sx₂.circumsphere :=
+begin
+  rcases exists_circumsphere_eq_of_cospherical_subset h hd hc with ⟨r, hr⟩,
+  rw [hr sx₁ hsx₁, hr sx₂ hsx₂]
+end
+
+/-- All n-simplices among cospherical points in n-space have the same
+circumsphere. -/
+lemma exists_circumsphere_eq_of_cospherical {ps : set P} {n : ℕ} [finite_dimensional ℝ V]
+  (hd : finrank ℝ V = n) (hc : cospherical ps) :
+  ∃ c : sphere P, ∀ sx : simplex ℝ P n, set.range sx.points ⊆ ps → sx.circumsphere = c :=
+begin
+  haveI : nonempty (⊤ : affine_subspace ℝ P) := set.univ.nonempty,
+  rw [←finrank_top, ←direction_top ℝ V P] at hd,
+  refine exists_circumsphere_eq_of_cospherical_subset _ hd hc,
+  exact set.subset_univ _
+end
+
+/-- Two n-simplices among cospherical points in n-space have the same
+circumsphere. -/
+lemma circumsphere_eq_of_cospherical {ps : set P} {n : ℕ} [finite_dimensional ℝ V]
+  (hd : finrank ℝ V = n) (hc : cospherical ps) {sx₁ sx₂ : simplex ℝ P n}
+  (hsx₁ : set.range sx₁.points ⊆ ps) (hsx₂ : set.range sx₂.points ⊆ ps) :
+  sx₁.circumsphere = sx₂.circumsphere :=
+begin
+  rcases exists_circumsphere_eq_of_cospherical hd hc with ⟨r, hr⟩,
+  rw [hr sx₁ hsx₁, hr sx₂ hsx₂]
+end
+
 /-- Suppose all distances from `p₁` and `p₂` to the points of a
 simplex are equal, and that `p₁` and `p₂` lie in the affine span of
 `p` with the vertices of that simplex.  Then `p₁` and `p₂` are equal
diff --git a/src/geometry/euclidean/default.lean b/src/geometry/euclidean/default.lean
deleted file mode 100644
index a79e5c08e564b..0000000000000
--- a/src/geometry/euclidean/default.lean
+++ /dev/null
@@ -1,4 +0,0 @@
-import geometry.euclidean.basic
-import geometry.euclidean.circumcenter
-import geometry.euclidean.monge_point
-import geometry.euclidean.triangle
diff --git a/src/geometry/euclidean/inversion.lean b/src/geometry/euclidean/inversion.lean
new file mode 100644
index 0000000000000..92cd13a99fa17
--- /dev/null
+++ b/src/geometry/euclidean/inversion.lean
@@ -0,0 +1,130 @@
+/-
+Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury G. Kudryashov
+-/
+import analysis.inner_product_space.basic
+
+/-!
+# Inversion in an affine space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define inversion in a sphere in an affine space. This map sends each point `x` to
+the point `y` such that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center
+and the radius the sphere.
+
+In many applications, it is convenient to assume that the inversions swaps the center and the point
+at infinity. In order to stay in the original affine space, we define the map so that it sends
+center to itself.
+
+Currently, we prove only a few basic lemmas needed to prove Ptolemy's inequality, see
+`euclidean_geometry.mul_dist_le_mul_dist_add_mul_dist`.
+-/
+
+noncomputable theory
+open metric real function
+
+namespace euclidean_geometry
+
+variables {V P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+  {a b c d x y z : P} {R : ℝ}
+
+include V
+
+/-- Inversion in a sphere in an affine space. This map sends each point `x` to the point `y` such
+that `y -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c)`, where `c` and `R` are the center and the radius the
+sphere. -/
+def inversion (c : P) (R : ℝ) (x : P) : P := (R / dist x c) ^ 2 • (x -ᵥ c) +ᵥ c
+
+lemma inversion_vsub_center (c : P) (R : ℝ) (x : P) :
+  inversion c R x -ᵥ c = (R / dist x c) ^ 2 • (x -ᵥ c) :=
+vadd_vsub _ _
+
+@[simp] lemma inversion_self (c : P) (R : ℝ) : inversion c R c = c := by simp [inversion]
+
+@[simp] lemma inversion_dist_center (c x : P) : inversion c (dist x c) x = x :=
+begin
+  rcases eq_or_ne x c with rfl|hne,
+  { apply inversion_self },
+  { rw [inversion, div_self, one_pow, one_smul, vsub_vadd],
+    rwa [dist_ne_zero] }
+end
+
+lemma inversion_of_mem_sphere (h : x ∈ metric.sphere c R) : inversion c R x = x :=
+h.out ▸ inversion_dist_center c x
+
+/-- Distance from the image of a point under inversion to the center. This formula accidentally
+works for `x = c`. -/
+lemma dist_inversion_center (c x : P) (R : ℝ) : dist (inversion c R x) c = R ^ 2 / dist x c :=
+begin
+  rcases eq_or_ne x c with (rfl|hx), { simp },
+  have : dist x c ≠ 0, from dist_ne_zero.2 hx,
+  field_simp [inversion, norm_smul, abs_div, ← dist_eq_norm_vsub, sq, mul_assoc]
+end
+
+/-- Distance from the center of an inversion to the image of a point under the inversion. This
+formula accidentally works for `x = c`. -/
+lemma dist_center_inversion (c x : P) (R : ℝ) : dist c (inversion c R x) = R ^ 2 / dist c x :=
+by rw [dist_comm c, dist_comm c, dist_inversion_center]
+
+@[simp] lemma inversion_inversion (c : P) {R : ℝ} (hR : R ≠ 0) (x : P) :
+  inversion c R (inversion c R x) = x :=
+begin
+  rcases eq_or_ne x c with rfl|hne,
+  { rw [inversion_self, inversion_self] },
+  { rw [inversion, dist_inversion_center, inversion_vsub_center, smul_smul, ← mul_pow,
+      div_mul_div_comm, div_mul_cancel _ (dist_ne_zero.2 hne), ← sq, div_self, one_pow, one_smul,
+      vsub_vadd],
+    exact pow_ne_zero _ hR }
+end
+
+lemma inversion_involutive (c : P) {R : ℝ} (hR : R ≠ 0) : involutive (inversion c R) :=
+inversion_inversion c hR
+
+lemma inversion_surjective (c : P) {R : ℝ} (hR : R ≠ 0) : surjective (inversion c R) :=
+(inversion_involutive c hR).surjective
+
+lemma inversion_injective (c : P) {R : ℝ} (hR : R ≠ 0) : injective (inversion c R) :=
+(inversion_involutive c hR).injective
+
+lemma inversion_bijective (c : P) {R : ℝ} (hR : R ≠ 0) : bijective (inversion c R) :=
+(inversion_involutive c hR).bijective
+
+/-- Distance between the images of two points under an inversion. -/
+lemma dist_inversion_inversion (hx : x ≠ c) (hy : y ≠ c) (R : ℝ) :
+  dist (inversion c R x) (inversion c R y) = (R ^ 2 / (dist x c * dist y c)) * dist x y :=
+begin
+  dunfold inversion,
+  simp_rw [dist_vadd_cancel_right, dist_eq_norm_vsub V _ c],
+  simpa only [dist_vsub_cancel_right]
+    using dist_div_norm_sq_smul (vsub_ne_zero.2 hx) (vsub_ne_zero.2 hy) R
+end
+
+/-- **Ptolemy's inequality**: in a quadrangle `ABCD`, `|AC| * |BD| ≤ |AB| * |CD| + |BC| * |AD|`. If
+`ABCD` is a convex cyclic polygon, then this inequality becomes an equality, see
+`euclidean_geometry.mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`.  -/
+lemma mul_dist_le_mul_dist_add_mul_dist (a b c d : P) :
+  dist a c * dist b d ≤ dist a b * dist c d + dist b c * dist a d :=
+begin
+  -- If one of the points `b`, `c`, `d` is equal to `a`, then the inequality is trivial.
+  rcases eq_or_ne b a with rfl|hb,
+  { rw [dist_self, zero_mul, zero_add] },
+  rcases eq_or_ne c a with rfl|hc,
+  { rw [dist_self, zero_mul],
+    apply_rules [add_nonneg, mul_nonneg, dist_nonneg] },
+  rcases eq_or_ne d a with rfl|hd,
+  { rw [dist_self, mul_zero, add_zero, dist_comm d, dist_comm d, mul_comm] },
+  /- Otherwise, we apply the triangle inequality to `euclidean_geometry.inversion a 1 b`,
+  `euclidean_geometry.inversion a 1 c`, and `euclidean_geometry.inversion a 1 d`. -/
+  have H := dist_triangle (inversion a 1 b) (inversion a 1 c) (inversion a 1 d),
+  rw [dist_inversion_inversion hb hd, dist_inversion_inversion hb hc,
+    dist_inversion_inversion hc hd, one_pow] at H,
+  rw [← dist_pos] at hb hc hd,
+  rw [← div_le_div_right (mul_pos hb (mul_pos hc hd))],
+  convert H; { field_simp [hb.ne', hc.ne', hd.ne', dist_comm a], ring }
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/monge_point.lean b/src/geometry/euclidean/monge_point.lean
index 51e3480d07f48..250e4f686b38e 100644
--- a/src/geometry/euclidean/monge_point.lean
+++ b/src/geometry/euclidean/monge_point.lean
@@ -8,6 +8,9 @@ import geometry.euclidean.circumcenter
 /-!
 # Monge point and orthocenter
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the orthocenter of a triangle, via its n-dimensional
 generalization, the Monge point of a simplex.
 
@@ -49,7 +52,6 @@ generalization, the Monge point of a simplex.
 noncomputable theory
 open_locale big_operators
 open_locale classical
-open_locale real
 open_locale real_inner_product_space
 
 namespace affine
@@ -58,8 +60,8 @@ namespace simplex
 
 open finset affine_subspace euclidean_geometry points_with_circumcenter_index
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 include V
 
 /-- The Monge point of a simplex (in 2 or more dimensions) is a
@@ -127,7 +129,7 @@ include V
 `points_with_circumcenter`. -/
 lemma monge_point_eq_affine_combination_of_points_with_circumcenter {n : ℕ}
   (s : simplex ℝ P (n + 2)) :
-  s.monge_point = (univ : finset (points_with_circumcenter_index (n + 2))).affine_combination
+  s.monge_point = (univ : finset (points_with_circumcenter_index (n + 2))).affine_combination ℝ
     s.points_with_circumcenter (monge_point_weights_with_circumcenter n) :=
 begin
   rw [monge_point_eq_smul_vsub_vadd_circumcenter,
@@ -273,7 +275,7 @@ begin
   simp_rw monge_plane_def,
   congr' 3,
   { congr' 1,
-    exact insert_singleton_comm _ _ },
+    exact pair_comm _ _ },
   { ext,
     simp_rw submodule.mem_span_singleton,
     split,
@@ -368,14 +370,11 @@ by rw [altitude_def,
 
 /-- The vector span of the opposite face lies in the direction
 orthogonal to an altitude. -/
-lemma vector_span_le_altitude_direction_orthogonal  {n : ℕ} (s : simplex ℝ P (n + 1))
-    (i : fin (n + 2)) :
-  vector_span ℝ (s.points '' ↑(finset.univ.erase i)) ≤ (s.altitude i).directionᗮ :=
+lemma vector_span_is_ortho_altitude_direction {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + 2)) :
+  vector_span ℝ (s.points '' ↑(finset.univ.erase i)) ⟂ (s.altitude i).direction :=
 begin
   rw direction_altitude,
-  exact le_trans
-    (vector_span ℝ (s.points '' ↑(finset.univ.erase i))).le_orthogonal_orthogonal
-    (submodule.orthogonal_le inf_le_left)
+  exact (submodule.is_ortho_orthogonal_right _).mono_right inf_le_left,
 end
 
 open finite_dimensional
@@ -403,9 +402,9 @@ end
 
 /-- A line through a vertex is the altitude through that vertex if and
 only if it is orthogonal to the opposite face. -/
-lemma affine_span_insert_singleton_eq_altitude_iff {n : ℕ} (s : simplex ℝ P (n + 1))
+lemma affine_span_pair_eq_altitude_iff {n : ℕ} (s : simplex ℝ P (n + 1))
     (i : fin (n + 2)) (p : P) :
-  affine_span ℝ {p, s.points i} = s.altitude i ↔ (p ≠ s.points i ∧
+  line[ℝ, p, s.points i] = s.altitude i ↔ (p ≠ s.points i ∧
     p ∈ affine_span ℝ (set.range s.points) ∧
     p -ᵥ s.points i ∈ (affine_span ℝ (s.points '' ↑(finset.univ.erase i))).directionᗮ) :=
 begin
@@ -444,8 +443,8 @@ namespace triangle
 
 open euclidean_geometry finset simplex affine_subspace finite_dimensional
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 include V
 
 /-- The orthocenter of a triangle is the intersection of its
@@ -552,7 +551,7 @@ by { convert dist_orthocenter_reflection_circumcenter _ h, simp }
 /-- The affine span of the orthocenter and a vertex is contained in
 the altitude. -/
 lemma affine_span_orthocenter_point_le_altitude (t : triangle ℝ P) (i : fin 3) :
-  affine_span ℝ {t.orthocenter, t.points i} ≤ t.altitude i :=
+  line[ℝ, t.orthocenter, t.points i] ≤ t.altitude i :=
 begin
   refine span_points_subset_coe_of_subset_coe _,
   rw [set.insert_subset, set.singleton_subset_iff],
@@ -567,10 +566,10 @@ lemma altitude_replace_orthocenter_eq_affine_span {t₁ t₂ : triangle ℝ P} {
     (hi₁₂ : i₁ ≠ i₂) (hi₁₃ : i₁ ≠ i₃) (hi₂₃ : i₂ ≠ i₃) (hj₁₂ : j₁ ≠ j₂) (hj₁₃ : j₁ ≠ j₃)
     (hj₂₃ : j₂ ≠ j₃) (h₁ : t₂.points j₁ = t₁.orthocenter) (h₂ : t₂.points j₂ = t₁.points i₂)
     (h₃ : t₂.points j₃ = t₁.points i₃) :
-  t₂.altitude j₂ = affine_span ℝ {t₁.points i₁, t₁.points i₂} :=
+  t₂.altitude j₂ = line[ℝ, t₁.points i₁, t₁.points i₂] :=
 begin
   symmetry,
-  rw [←h₂, t₂.affine_span_insert_singleton_eq_altitude_iff],
+  rw [←h₂, t₂.affine_span_pair_eq_altitude_iff],
   rw [h₂],
   use t₁.independent.injective.ne hi₁₂,
   have he : affine_span ℝ (set.range t₂.points) = affine_span ℝ (set.range t₁.points),
@@ -593,9 +592,9 @@ begin
   rw [hu, finset.coe_insert, finset.coe_singleton, set.image_insert_eq, set.image_singleton,
       h₁, h₃],
   have hle : (t₁.altitude i₃).directionᗮ ≤
-    (affine_span ℝ ({t₁.orthocenter, t₁.points i₃} : set P)).directionᗮ :=
+    line[ℝ, t₁.orthocenter, t₁.points i₃].directionᗮ :=
       submodule.orthogonal_le (direction_le (affine_span_orthocenter_point_le_altitude _ _)),
-  refine hle ((t₁.vector_span_le_altitude_direction_orthogonal i₃) _),
+  refine hle ((t₁.vector_span_is_ortho_altitude_direction i₃) _),
   have hui : finset.univ.erase i₃ = {i₁, i₂}, { clear hle h₂ h₃, dec_trivial! },
   rw [hui, finset.coe_insert, finset.coe_singleton, set.image_insert_eq, set.image_singleton],
   refine vsub_mem_vector_span ℝ (set.mem_insert _ _)
@@ -627,8 +626,8 @@ namespace euclidean_geometry
 
 open affine affine_subspace finite_dimensional
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 
 include V
 
diff --git a/src/geometry/euclidean/oriented_angle.lean b/src/geometry/euclidean/oriented_angle.lean
deleted file mode 100644
index a5492ab26573e..0000000000000
--- a/src/geometry/euclidean/oriented_angle.lean
+++ /dev/null
@@ -1,1204 +0,0 @@
-/-
-Copyright (c) 2022 Joseph Myers. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Joseph Myers
--/
-import analysis.inner_product_space.orientation
-import analysis.inner_product_space.pi_L2
-import analysis.special_functions.complex.circle
-
-/-!
-# Oriented angles.
-
-This file defines oriented angles in real inner product spaces.
-
-## Main definitions
-
-* `orientation.oangle` is the oriented angle between two vectors with respect to an orientation.
-
-* `orientation.rotation` is the rotation by an oriented angle with respect to an orientation.
-
-## Implementation notes
-
-The definitions here use the `real.angle` type, angles modulo `2 * π`. For some purposes,
-angles modulo `π` are more convenient, because results are true for such angles with less
-configuration dependence. Results that are only equalities modulo `π` can be represented
-modulo `2 * π` as equalities of `(2 : ℤ) • θ`.
-
-Definitions and results in the `orthonormal` namespace, with respect to a particular choice
-of orthonormal basis, are mainly for use in setting up the API and proving that certain
-definitions do not depend on the choice of basis for a given orientation. Applications should
-generally use the definitions and results in the `orientation` namespace instead.
-
-## References
-
-* Evan Chen, Euclidean Geometry in Mathematical Olympiads.
-
--/
-
-noncomputable theory
-
-open_locale real
-
-namespace orthonormal
-
-variables {V : Type*} [inner_product_space ℝ V]
-variables {b : basis (fin 2) ℝ V} (hb : orthonormal ℝ b)
-include hb
-
-/-- The oriented angle from `x` to `y`, modulo `2 * π`. If either vector is 0, this is 0. -/
-def oangle (x y : V) : real.angle :=
-complex.arg ((complex.isometry_of_orthonormal hb).symm y /
-  (complex.isometry_of_orthonormal hb).symm x)
-
-/-- If the first vector passed to `oangle` is 0, the result is 0. -/
-@[simp] lemma oangle_zero_left (x : V) : hb.oangle 0 x = 0 :=
-by simp [oangle]
-
-/-- If the second vector passed to `oangle` is 0, the result is 0. -/
-@[simp] lemma oangle_zero_right (x : V) : hb.oangle x 0 = 0 :=
-by simp [oangle]
-
-/-- If the two vectors passed to `oangle` are the same, the result is 0. -/
-@[simp] lemma oangle_self (x : V) : hb.oangle x x = 0 :=
-begin
-  by_cases h : x = 0;
-    simp [oangle, h]
-end
-
-/-- Swapping the two vectors passed to `oangle` negates the angle. -/
-lemma oangle_rev (x y : V) : hb.oangle y x = -hb.oangle x y :=
-begin
-  simp only [oangle],
-  convert complex.arg_inv_coe_angle _,
-  exact inv_div.symm
-end
-
-/-- Adding the angles between two vectors in each order results in 0. -/
-@[simp] lemma oangle_add_oangle_rev (x y : V) : hb.oangle x y + hb.oangle y x = 0 :=
-by simp [hb.oangle_rev y x]
-
-/-- Negating the first vector passed to `oangle` adds `π` to the angle. -/
-lemma oangle_neg_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  hb.oangle (-x) y = hb.oangle x y + π :=
-begin
-  simp only [oangle, div_neg_eq_neg_div, map_neg],
-  refine complex.arg_neg_coe_angle _,
-  simp [hx, hy]
-end
-
-/-- Negating the second vector passed to `oangle` adds `π` to the angle. -/
-lemma oangle_neg_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  hb.oangle x (-y) = hb.oangle x y + π :=
-begin
-  simp only [oangle, neg_div, map_neg],
-  refine complex.arg_neg_coe_angle _,
-  simp [hx, hy]
-end
-
-/-- Negating the first vector passed to `oangle` does not change twice the angle. -/
-@[simp] lemma two_zsmul_oangle_neg_left (x y : V) :
-  (2 : ℤ) • hb.oangle (-x) y = (2 : ℤ) • hb.oangle x y :=
-begin
-  by_cases hx : x = 0,
-  { simp [hx] },
-  { by_cases hy : y = 0,
-    { simp [hy] },
-    { simp [hb.oangle_neg_left hx hy] } }
-end
-
-/-- Negating the second vector passed to `oangle` does not change twice the angle. -/
-@[simp] lemma two_zsmul_oangle_neg_right (x y : V) :
-  (2 : ℤ) • hb.oangle x (-y) = (2 : ℤ) • hb.oangle x y :=
-begin
-  by_cases hx : x = 0,
-  { simp [hx] },
-  { by_cases hy : y = 0,
-    { simp [hy] },
-    { simp [hb.oangle_neg_right hx hy] } }
-end
-
-/-- Negating both vectors passed to `oangle` does not change the angle. -/
-@[simp] lemma oangle_neg_neg (x y : V) : hb.oangle (-x) (-y) = hb.oangle x y :=
-by simp [oangle, neg_div_neg_eq]
-
-/-- Negating the first vector produces the same angle as negating the second vector. -/
-lemma oangle_neg_left_eq_neg_right (x y : V) : hb.oangle (-x) y = hb.oangle x (-y) :=
-by rw [←neg_neg y, oangle_neg_neg, neg_neg]
-
-/-- The angle between the negation of a nonzero vector and that vector is `π`. -/
-@[simp] lemma oangle_neg_self_left {x : V} (hx : x ≠ 0) : hb.oangle (-x) x = π :=
-by simp [oangle_neg_left, hx]
-
-/-- The angle between a nonzero vector and its negation is `π`. -/
-@[simp] lemma oangle_neg_self_right {x : V} (hx : x ≠ 0) : hb.oangle x (-x) = π :=
-by simp [oangle_neg_right, hx]
-
-/-- Twice the angle between the negation of a vector and that vector is 0. -/
-@[simp] lemma two_zsmul_oangle_neg_self_left (x : V) : (2 : ℤ) • hb.oangle (-x) x = 0 :=
-begin
-  by_cases hx : x = 0;
-    simp [hx]
-end
-
-/-- Twice the angle between a vector and its negation is 0. -/
-@[simp] lemma two_zsmul_oangle_neg_self_right (x : V) : (2 : ℤ) • hb.oangle x (-x) = 0 :=
-begin
-  by_cases hx : x = 0;
-    simp [hx]
-end
-
-/-- Adding the angles between two vectors in each order, with the first vector in each angle
-negated, results in 0. -/
-@[simp] lemma oangle_add_oangle_rev_neg_left (x y : V) :
-  hb.oangle (-x) y + hb.oangle (-y) x = 0 :=
-by rw [oangle_neg_left_eq_neg_right, oangle_rev, add_left_neg]
-
-/-- Adding the angles between two vectors in each order, with the second vector in each angle
-negated, results in 0. -/
-@[simp] lemma oangle_add_oangle_rev_neg_right (x y : V) :
-  hb.oangle x (-y) + hb.oangle y (-x) = 0 :=
-by rw [hb.oangle_rev (-x), oangle_neg_left_eq_neg_right, add_neg_self]
-
-/-- Multiplying the first vector passed to `oangle` by a positive real does not change the
-angle. -/
-@[simp] lemma oangle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
-  hb.oangle (r • x) y = hb.oangle x y :=
-begin
-  simp only [oangle, linear_isometry_equiv.map_smul, complex.real_smul],
-  rw [mul_comm, div_mul_eq_div_mul_one_div, one_div, mul_comm, ←complex.of_real_inv],
-  congr' 1,
-  exact complex.arg_real_mul _ (inv_pos.2 hr)
-end
-
-/-- Multiplying the second vector passed to `oangle` by a positive real does not change the
-angle. -/
-@[simp] lemma oangle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
-  hb.oangle x (r • y) = hb.oangle x y :=
-begin
-  simp only [oangle, linear_isometry_equiv.map_smul, complex.real_smul],
-  congr' 1,
-  rw mul_div_assoc,
-  exact complex.arg_real_mul _ hr
-end
-
-/-- Multiplying the first vector passed to `oangle` by a negative real produces the same angle
-as negating that vector. -/
-@[simp] lemma oangle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
-  hb.oangle (r • x) y = hb.oangle (-x) y :=
-by rw [←neg_neg r, neg_smul, ←smul_neg, hb.oangle_smul_left_of_pos _ _ (neg_pos_of_neg hr)]
-
-/-- Multiplying the second vector passed to `oangle` by a negative real produces the same angle
-as negating that vector. -/
-@[simp] lemma oangle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
-  hb.oangle x (r • y) = hb.oangle x (-y) :=
-by rw [←neg_neg r, neg_smul, ←smul_neg, hb.oangle_smul_right_of_pos _ _ (neg_pos_of_neg hr)]
-
-/-- The angle between a nonnegative multiple of a vector and that vector is 0. -/
-@[simp] lemma oangle_smul_left_self_of_nonneg (x : V) {r : ℝ} (hr : 0 ≤ r) :
-  hb.oangle (r • x) x = 0 :=
-begin
-  rcases hr.lt_or_eq with (h|h),
-  { simp [h] },
-  { simp [h.symm] }
-end
-
-/-- The angle between a vector and a nonnegative multiple of that vector is 0. -/
-@[simp] lemma oangle_smul_right_self_of_nonneg (x : V) {r : ℝ} (hr : 0 ≤ r) :
-  hb.oangle x (r • x) = 0 :=
-begin
-  rcases hr.lt_or_eq with (h|h),
-  { simp [h] },
-  { simp [h.symm] }
-end
-
-/-- The angle between two nonnegative multiples of the same vector is 0. -/
-@[simp] lemma oangle_smul_smul_self_of_nonneg (x : V) {r₁ r₂ : ℝ} (hr₁ : 0 ≤ r₁) (hr₂ : 0 ≤ r₂) :
-  hb.oangle (r₁ • x) (r₂ • x) = 0 :=
-begin
-  rcases hr₁.lt_or_eq with (h|h),
-  { simp [h, hr₂] },
-  { simp [h.symm] }
-end
-
-/-- Multiplying the first vector passed to `oangle` by a nonzero real does not change twice the
-angle. -/
-@[simp] lemma two_zsmul_oangle_smul_left_of_ne_zero (x y : V) {r : ℝ} (hr : r ≠ 0) :
-  (2 : ℤ) • hb.oangle (r • x) y = (2 : ℤ) • hb.oangle x y :=
-begin
-  rcases hr.lt_or_lt with (h|h);
-    simp [h]
-end
-
-/-- Multiplying the second vector passed to `oangle` by a nonzero real does not change twice the
-angle. -/
-@[simp] lemma two_zsmul_oangle_smul_right_of_ne_zero (x y : V) {r : ℝ} (hr : r ≠ 0) :
-  (2 : ℤ) • hb.oangle x (r • y) = (2 : ℤ) • hb.oangle x y :=
-begin
-  rcases hr.lt_or_lt with (h|h);
-    simp [h]
-end
-
-/-- Twice the angle between a multiple of a vector and that vector is 0. -/
-@[simp] lemma two_zsmul_oangle_smul_left_self (x : V) {r : ℝ} :
-  (2 : ℤ) • hb.oangle (r • x) x = 0 :=
-begin
-  rcases lt_or_le r 0 with (h|h);
-    simp [h]
-end
-
-/-- Twice the angle between a vector and a multiple of that vector is 0. -/
-@[simp] lemma two_zsmul_oangle_smul_right_self (x : V) {r : ℝ} :
-  (2 : ℤ) • hb.oangle x (r • x) = 0 :=
-begin
-  rcases lt_or_le r 0 with (h|h);
-    simp [h]
-end
-
-/-- Twice the angle between two multiples of a vector is 0. -/
-@[simp] lemma two_zsmul_oangle_smul_smul_self (x : V) {r₁ r₂ : ℝ} :
-  (2 : ℤ) • hb.oangle (r₁ • x) (r₂ • x) = 0 :=
-begin
-  by_cases h : r₁ = 0;
-    simp [h]
-end
-
-/-- Two vectors are equal if and only if they have equal norms and zero angle between them. -/
-lemma eq_iff_norm_eq_and_oangle_eq_zero (x y : V) : x = y ↔ ∥x∥ = ∥y∥ ∧ hb.oangle x y = 0 :=
-begin
-  split,
-  { intro h,
-    simp [h] },
-  { rintro ⟨hn, ha⟩,
-    rw [oangle] at ha,
-    by_cases hy0 : y = 0,
-    { simpa [hy0] using hn },
-    { have hx0 : x ≠ 0 := norm_ne_zero_iff.1 (hn.symm ▸ norm_ne_zero_iff.2 hy0),
-      have hx0' : (complex.isometry_of_orthonormal hb).symm x ≠ 0,
-      { simp [hx0] },
-      have hy0' : (complex.isometry_of_orthonormal hb).symm y ≠ 0,
-      { simp [hy0] },
-      rw [complex.arg_div_coe_angle hy0' hx0', sub_eq_zero, complex.arg_coe_angle_eq_iff,
-          complex.arg_eq_arg_iff hy0' hx0', ←complex.norm_eq_abs, ←complex.norm_eq_abs,
-          linear_isometry_equiv.norm_map, linear_isometry_equiv.norm_map, hn,
-          ←complex.of_real_div, div_self (norm_ne_zero_iff.2 hy0), complex.of_real_one,
-          one_mul, linear_isometry_equiv.map_eq_iff] at ha,
-      exact ha.symm } }
-end
-
-/-- Two vectors with equal norms are equal if and only if they have zero angle between them. -/
-lemma eq_iff_oangle_eq_zero_of_norm_eq {x y : V} (h : ∥x∥ = ∥y∥) : x = y ↔ hb.oangle x y = 0 :=
-⟨λ he, ((hb.eq_iff_norm_eq_and_oangle_eq_zero x y).1 he).2,
- λ ha, (hb.eq_iff_norm_eq_and_oangle_eq_zero x y).2 ⟨h, ha⟩⟩
-
-/-- Two vectors with zero angle between them are equal if and only if they have equal norms. -/
-lemma eq_iff_norm_eq_of_oangle_eq_zero {x y : V} (h : hb.oangle x y = 0) : x = y ↔ ∥x∥ = ∥y∥ :=
-⟨λ he, ((hb.eq_iff_norm_eq_and_oangle_eq_zero x y).1 he).1,
- λ hn, (hb.eq_iff_norm_eq_and_oangle_eq_zero x y).2 ⟨hn, h⟩⟩
-
-/-- Given three nonzero vectors, the angle between the first and the second plus the angle
-between the second and the third equals the angle between the first and the third. -/
-@[simp] lemma oangle_add {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  hb.oangle x y + hb.oangle y z = hb.oangle x z :=
-begin
-  simp_rw [oangle],
-  rw ←complex.arg_mul_coe_angle,
-  { rw [mul_comm, div_mul_div_cancel],
-    simp [hy] },
-  { simp [hx, hy] },
-  { simp [hy, hz] }
-end
-
-/-- Given three nonzero vectors, the angle between the second and the third plus the angle
-between the first and the second equals the angle between the first and the third. -/
-@[simp] lemma oangle_add_swap {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-   hb.oangle y z + hb.oangle x y = hb.oangle x z :=
-by rw [add_comm, hb.oangle_add hx hy hz]
-
-/-- Given three nonzero vectors, the angle between the first and the third minus the angle
-between the first and the second equals the angle between the second and the third. -/
-@[simp] lemma oangle_sub_left {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  hb.oangle x z - hb.oangle x y = hb.oangle y z :=
-by rw [sub_eq_iff_eq_add, hb.oangle_add_swap hx hy hz]
-
-/-- Given three nonzero vectors, the angle between the first and the third minus the angle
-between the second and the third equals the angle between the first and the second. -/
-@[simp] lemma oangle_sub_right {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  hb.oangle x z - hb.oangle y z = hb.oangle x y :=
-by rw [sub_eq_iff_eq_add, hb.oangle_add hx hy hz]
-
-/-- Given three nonzero vectors, adding the angles between them in cyclic order results in 0. -/
-@[simp] lemma oangle_add_cyc3 {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  hb.oangle x y + hb.oangle y z + hb.oangle z x = 0 :=
-by simp [hx, hy, hz]
-
-/-- Given three nonzero vectors, adding the angles between them in cyclic order, with the first
-vector in each angle negated, results in π. If the vectors add to 0, this is a version of the
-sum of the angles of a triangle. -/
-@[simp] lemma oangle_add_cyc3_neg_left {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  hb.oangle (-x) y + hb.oangle (-y) z + hb.oangle (-z) x = π :=
-by rw [hb.oangle_neg_left hx hy, hb.oangle_neg_left hy hz, hb.oangle_neg_left hz hx,
-       (show hb.oangle x y + π + (hb.oangle y z + π) + (hb.oangle z x + π) =
-         hb.oangle x y + hb.oangle y z + hb.oangle z x + (π + π + π : real.angle), by abel),
-       hb.oangle_add_cyc3 hx hy hz, real.angle.coe_pi_add_coe_pi, zero_add, zero_add]
-
-/-- Given three nonzero vectors, adding the angles between them in cyclic order, with the second
-vector in each angle negated, results in π. If the vectors add to 0, this is a version of the
-sum of the angles of a triangle. -/
-@[simp] lemma oangle_add_cyc3_neg_right {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  hb.oangle x (-y) + hb.oangle y (-z) + hb.oangle z (-x) = π :=
-by simp_rw [←oangle_neg_left_eq_neg_right, hb.oangle_add_cyc3_neg_left hx hy hz]
-
-/-- Pons asinorum, oriented vector angle form. -/
-lemma oangle_sub_eq_oangle_sub_rev_of_norm_eq {x y : V} (h : ∥x∥ = ∥y∥) :
-  hb.oangle x (x - y) = hb.oangle (y - x) y :=
-begin
-  by_cases hx : x = 0,
-  { simp [hx] },
-  { have hy : y ≠ 0 := norm_ne_zero_iff.1 (h ▸ norm_ne_zero_iff.2 hx),
-    simp_rw [hb.oangle_rev y, oangle, linear_isometry_equiv.map_sub,
-             ←complex.arg_conj_coe_angle, sub_div,
-             div_self (((complex.isometry_of_orthonormal hb).symm.map_eq_zero_iff).not.2 hx),
-             div_self (((complex.isometry_of_orthonormal hb).symm.map_eq_zero_iff).not.2 hy),
-             map_sub, map_one],
-    rw ←inv_div,
-    simp_rw [complex.inv_def, complex.norm_sq_div, ←complex.sq_abs, ←complex.norm_eq_abs,
-             linear_isometry_equiv.norm_map, h],
-    simp [hy] }
-end
-
-/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
-vector angle form. -/
-lemma oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq {x y : V} (hn : x ≠ y) (h : ∥x∥ = ∥y∥) :
-  hb.oangle y x = π - (2 : ℤ) • hb.oangle (y - x) y :=
-begin
-  rw two_zsmul,
-  rw [←hb.oangle_sub_eq_oangle_sub_rev_of_norm_eq h] { occs := occurrences.pos [1] },
-  rw [eq_sub_iff_add_eq, ←oangle_neg_neg, ←add_assoc],
-  have hy : y ≠ 0,
-  { rintro rfl,
-    rw [norm_zero, norm_eq_zero] at h,
-    exact hn h },
-  have hx : x ≠ 0 := norm_ne_zero_iff.1 (h.symm ▸ norm_ne_zero_iff.2 hy),
-  convert hb.oangle_add_cyc3_neg_right (neg_ne_zero.2 hy) hx (sub_ne_zero_of_ne hn.symm);
-    simp
-end
-
-/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
-form. -/
-lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
-  (hxy : ∥x∥ = ∥y∥) (hxz : ∥x∥ = ∥z∥) : hb.oangle y z = (2 : ℤ) • hb.oangle (y - x) (z - x) :=
-begin
-  have hy : y ≠ 0,
-  { rintro rfl,
-    rw [norm_zero, norm_eq_zero] at hxy,
-    exact hxyne hxy },
-  have hx : x ≠ 0 := norm_ne_zero_iff.1 (hxy.symm ▸ norm_ne_zero_iff.2 hy),
-  have hz : z ≠ 0 := norm_ne_zero_iff.1 (hxz ▸ norm_ne_zero_iff.2 hx),
-  calc hb.oangle y z = hb.oangle x z - hb.oangle x y : (hb.oangle_sub_left hx hy hz).symm
-       ...           = (π - (2 : ℤ) • hb.oangle (x - z) x) -
-                       (π - (2 : ℤ) • hb.oangle (x - y) x) :
-         by rw [hb.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hxzne.symm hxz.symm,
-                hb.oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hxyne.symm hxy.symm]
-       ...           = (2 : ℤ) • (hb.oangle (x - y) x - hb.oangle (x - z) x) : by abel
-       ...           = (2 : ℤ) • hb.oangle (x - y) (x - z) :
-         by rw hb.oangle_sub_right (sub_ne_zero_of_ne hxyne) (sub_ne_zero_of_ne hxzne) hx
-       ...           = (2 : ℤ) • hb.oangle (y - x) (z - x) :
-         by rw [←oangle_neg_neg, neg_sub, neg_sub]
-end
-
-/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
-form with radius specified. -/
-lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
-  {r : ℝ} (hx : ∥x∥ = r) (hy : ∥y∥ = r) (hz : ∥z∥ = r) :
-  hb.oangle y z = (2 : ℤ) • hb.oangle (y - x) (z - x) :=
-hb.oangle_eq_two_zsmul_oangle_sub_of_norm_eq hxyne hxzne (hy.symm ▸ hx) (hz.symm ▸ hx)
-
-/-- Oriented vector angle version of "angles in same segment are equal" and "opposite angles of
-a cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same
-result), represented here as equality of twice the angles. -/
-lemma two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq {x₁ x₂ y z : V} (hx₁yne : x₁ ≠ y)
-  (hx₁zne : x₁ ≠ z) (hx₂yne : x₂ ≠ y) (hx₂zne : x₂ ≠ z) {r : ℝ} (hx₁ : ∥x₁∥ = r) (hx₂ : ∥x₂∥ = r)
-  (hy : ∥y∥ = r) (hz : ∥z∥ = r) :
-  (2 : ℤ) • hb.oangle (y - x₁) (z - x₁) = (2 : ℤ) • hb.oangle (y - x₂) (z - x₂) :=
-hb.oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hx₁yne hx₁zne hx₁ hy hz ▸
-  hb.oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hx₂yne hx₂zne hx₂ hy hz
-
-/-- A rotation by the oriented angle `θ`. -/
-def rotation (θ : real.angle) : V ≃ₗᵢ[ℝ] V :=
-((complex.isometry_of_orthonormal hb).symm.trans (rotation (real.angle.exp_map_circle θ))).trans
-  (complex.isometry_of_orthonormal hb)
-
-/-- The determinant of `rotation` (as a linear map) is equal to `1`. -/
-@[simp] lemma det_rotation (θ : real.angle) :
-  ((hb.rotation θ).to_linear_equiv : V →ₗ[ℝ] V).det = 1 :=
-by simp [rotation, ←linear_isometry_equiv.to_linear_equiv_symm, ←linear_equiv.comp_coe]
-
-/-- The determinant of `rotation` (as a linear equiv) is equal to `1`. -/
-@[simp] lemma linear_equiv_det_rotation (θ : real.angle) :
-  (hb.rotation θ).to_linear_equiv.det = 1 :=
-by simp [rotation, ←linear_isometry_equiv.to_linear_equiv_symm]
-
-/-- The inverse of `rotation` is rotation by the negation of the angle. -/
-@[simp] lemma rotation_symm (θ : real.angle) : (hb.rotation θ).symm = hb.rotation (-θ) :=
-by simp [rotation, linear_isometry_equiv.trans_assoc]
-
-/-- Rotation by 0 is the identity. -/
-@[simp] lemma rotation_zero : hb.rotation 0 = linear_isometry_equiv.refl ℝ V :=
-by simp [rotation]
-
-/-- Rotation by π is negation. -/
-lemma rotation_pi : hb.rotation π = linear_isometry_equiv.neg ℝ :=
-begin
-  ext x,
-  simp [rotation]
-end
-
-/-- Rotating twice is equivalent to rotating by the sum of the angles. -/
-@[simp] lemma rotation_trans (θ₁ θ₂ : real.angle) :
-  (hb.rotation θ₁).trans (hb.rotation θ₂) = hb.rotation (θ₂ + θ₁) :=
-begin
-  simp only [rotation, ←linear_isometry_equiv.trans_assoc],
-  ext1 x,
-  simp
-end
-
-/-- Rotating the first vector by `θ` subtracts `θ` from the angle between two vectors. -/
-@[simp] lemma oangle_rotation_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
-  hb.oangle (hb.rotation θ x) y = hb.oangle x y - θ :=
-begin
-  simp [oangle, rotation, complex.arg_div_coe_angle, complex.arg_mul_coe_angle, hx, hy,
-        ne_zero_of_mem_circle],
-  abel
-end
-
-/-- Rotating the second vector by `θ` adds `θ` to the angle between two vectors. -/
-@[simp] lemma oangle_rotation_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
-  hb.oangle x (hb.rotation θ y) = hb.oangle x y + θ :=
-begin
-  simp [oangle, rotation, complex.arg_div_coe_angle, complex.arg_mul_coe_angle, hx, hy,
-        ne_zero_of_mem_circle],
-  abel
-end
-
-/-- The rotation of a vector by `θ` has an angle of `-θ` from that vector. -/
-@[simp] lemma oangle_rotation_self_left {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  hb.oangle (hb.rotation θ x) x = -θ :=
-by simp [hx]
-
-/-- A vector has an angle of `θ` from the rotation of that vector by `θ`. -/
-@[simp] lemma oangle_rotation_self_right {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  hb.oangle x (hb.rotation θ x) = θ :=
-by simp [hx]
-
-/-- Rotating the first vector by the angle between the two vectors results an an angle of 0. -/
-@[simp] lemma oangle_rotation_oangle_left (x y : V) :
-  hb.oangle (hb.rotation (hb.oangle x y) x) y = 0 :=
-begin
-  by_cases hx : x = 0,
-  { simp [hx] },
-  { by_cases hy : y = 0,
-    { simp [hy] },
-    { simp [hx, hy] } }
-end
-
-/-- Rotating the first vector by the angle between the two vectors and swapping the vectors
-results an an angle of 0. -/
-@[simp] lemma oangle_rotation_oangle_right (x y : V) :
-  hb.oangle y (hb.rotation (hb.oangle x y) x) = 0 :=
-begin
-  rw [oangle_rev],
-  simp
-end
-
-/-- Rotating both vectors by the same angle does not change the angle between those vectors. -/
-@[simp] lemma oangle_rotation (x y : V) (θ : real.angle) :
-  hb.oangle (hb.rotation θ x) (hb.rotation θ y) = hb.oangle x y :=
-begin
-  by_cases hx : x = 0; by_cases hy : y = 0;
-    simp [hx, hy]
-end
-
-/-- A rotation of a nonzero vector equals that vector if and only if the angle is zero. -/
-@[simp] lemma rotation_eq_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  hb.rotation θ x = x ↔ θ = 0 :=
-begin
-  split,
-  { intro h,
-    rw eq_comm,
-    simpa [hx, h] using hb.oangle_rotation_right hx hx θ },
-  { intro h,
-    simp [h] }
-end
-
-/-- A nonzero vector equals a rotation of that vector if and only if the angle is zero. -/
-@[simp] lemma eq_rotation_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  x = hb.rotation θ x ↔ θ = 0 :=
-by rw [←hb.rotation_eq_self_iff_angle_eq_zero hx, eq_comm]
-
-/-- A rotation of a vector equals that vector if and only if the vector or the angle is zero. -/
-lemma rotation_eq_self_iff (x : V) (θ : real.angle) :
-  hb.rotation θ x = x ↔ x = 0 ∨ θ = 0 :=
-begin
-  by_cases h : x = 0;
-    simp [h]
-end
-
-/-- A vector equals a rotation of that vector if and only if the vector or the angle is zero. -/
-lemma eq_rotation_self_iff (x : V) (θ : real.angle) :
-  x = hb.rotation θ x ↔ x = 0 ∨ θ = 0 :=
-by rw [←rotation_eq_self_iff, eq_comm]
-
-/-- Rotating a vector by the angle to another vector gives the second vector if and only if the
-norms are equal. -/
-@[simp] lemma rotation_oangle_eq_iff_norm_eq (x y : V) :
-  hb.rotation (hb.oangle x y) x = y ↔ ∥x∥ = ∥y∥ :=
-begin
-  split,
-  { intro h,
-    rw [←h, linear_isometry_equiv.norm_map] },
-  { intro h,
-    rw hb.eq_iff_oangle_eq_zero_of_norm_eq;
-      simp [h] }
-end
-
-/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
-rotated by `θ` and scaled by the ratio of the norms. -/
-lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
-  (θ : real.angle) : hb.oangle x y = θ ↔ y = (∥y∥ / ∥x∥) • hb.rotation θ x :=
-begin
-  have hp := div_pos (norm_pos_iff.2 hy) (norm_pos_iff.2 hx),
-  split,
-  { rintro rfl,
-    rw [←linear_isometry_equiv.map_smul, ←hb.oangle_smul_left_of_pos x y hp,
-        eq_comm, rotation_oangle_eq_iff_norm_eq, norm_smul, real.norm_of_nonneg hp.le,
-        div_mul_cancel _ (norm_ne_zero_iff.2 hx)] },
-  { intro hye,
-    rw [hye, hb.oangle_smul_right_of_pos _ _ hp, hb.oangle_rotation_self_right hx] }
-end
-
-/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
-rotated by `θ` and scaled by a positive real. -/
-lemma oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
-  (θ : real.angle) : hb.oangle x y = θ ↔ ∃ r : ℝ, 0 < r ∧ y = r • hb.rotation θ x :=
-begin
-  split,
-  { intro h,
-    rw hb.oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy at h,
-    exact ⟨∥y∥ / ∥x∥, div_pos (norm_pos_iff.2 hy) (norm_pos_iff.2 hx), h⟩ },
-  { rintro ⟨r, hr, rfl⟩,
-    rw [hb.oangle_smul_right_of_pos _ _ hr, hb.oangle_rotation_self_right hx] }
-end
-
-/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
-is the first rotated by `θ` and scaled by the ratio of the norms, or `θ` and at least one of the
-vectors are zero. -/
-lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
-  hb.oangle x y = θ ↔
-    (x ≠ 0 ∧ y ≠ 0 ∧ y = (∥y∥ / ∥x∥) • hb.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
-begin
-  by_cases hx : x = 0,
-  { simp [hx, eq_comm] },
-  { by_cases hy : y = 0,
-    { simp [hy, eq_comm] },
-    { rw hb.oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy,
-      simp [hx, hy] } }
-end
-
-/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
-is the first rotated by `θ` and scaled by a positive real, or `θ` and at least one of the
-vectors are zero. -/
-lemma oangle_eq_iff_eq_pos_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
-  hb.oangle x y = θ ↔
-    (x ≠ 0 ∧ y ≠ 0 ∧ ∃ r : ℝ, 0 < r ∧ y = r • hb.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
-begin
-  by_cases hx : x = 0,
-  { simp [hx, eq_comm] },
-  { by_cases hy : y = 0,
-    { simp [hy, eq_comm] },
-    { rw hb.oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero hx hy,
-      simp [hx, hy] } }
-end
-
-/-- Complex conjugation as a linear isometric equivalence in `V`. Note that this definition
-depends on the choice of basis, not just on its orientation; for most geometrical purposes,
-the `reflection` definitions should be preferred instead. -/
-def conj_lie : V ≃ₗᵢ[ℝ] V :=
-((complex.isometry_of_orthonormal hb).symm.trans complex.conj_lie).trans
-  (complex.isometry_of_orthonormal hb)
-
-/-- The determinant of `conj_lie` (as a linear map) is equal to `-1`. -/
-@[simp] lemma det_conj_lie : (hb.conj_lie.to_linear_equiv : V →ₗ[ℝ] V).det = -1 :=
-by simp [conj_lie, ←linear_isometry_equiv.to_linear_equiv_symm, ←linear_equiv.comp_coe]
-
-/-- The determinant of `conj_lie` (as a linear equiv) is equal to `-1`. -/
-@[simp] lemma linear_equiv_det_conj_lie : hb.conj_lie.to_linear_equiv.det = -1 :=
-by simp [conj_lie, ←linear_isometry_equiv.to_linear_equiv_symm]
-
-/-- `conj_lie` is its own inverse. -/
-@[simp] lemma conj_lie_symm : hb.conj_lie.symm = hb.conj_lie :=
-rfl
-
-/-- Applying `conj_lie` to both vectors negates the angle between those vectors. -/
-@[simp] lemma oangle_conj_lie (x y : V) :
-  hb.oangle (hb.conj_lie x) (hb.conj_lie y) = -hb.oangle x y :=
-by simp only [orthonormal.conj_lie, linear_isometry_equiv.symm_apply_apply, orthonormal.oangle,
-  eq_self_iff_true, function.comp_app, complex.arg_coe_angle_eq_iff,
-  linear_isometry_equiv.coe_trans, neg_inj, complex.conj_lie_apply, complex.arg_conj_coe_angle,
-  ←(star_ring_end ℂ).map_div]
-
-/-- Any linear isometric equivalence in `V` is `rotation` or `conj_lie` composed with
-`rotation`. -/
-lemma exists_linear_isometry_equiv_eq (f : V ≃ₗᵢ[ℝ] V) :
-  ∃ θ : real.angle, f = hb.rotation θ ∨ f = hb.conj_lie.trans (hb.rotation θ) :=
-begin
-  cases linear_isometry_complex (((complex.isometry_of_orthonormal hb).trans f).trans
-    (complex.isometry_of_orthonormal hb).symm) with a ha,
-  use complex.arg a,
-  rcases ha with (ha|ha),
-  { left,
-    simp only [rotation, ←ha, linear_isometry_equiv.trans_assoc, linear_isometry_equiv.refl_trans,
-               linear_isometry_equiv.symm_trans_self, real.angle.exp_map_circle_coe,
-               exp_map_circle_arg],
-    simp [←linear_isometry_equiv.trans_assoc] },
-  { right,
-    simp only [rotation, conj_lie, linear_isometry_equiv.trans_assoc,
-               real.angle.exp_map_circle_coe, exp_map_circle_arg],
-    simp only [←linear_isometry_equiv.trans_assoc, linear_isometry_equiv.self_trans_symm,
-               linear_isometry_equiv.trans_refl],
-    simp_rw [linear_isometry_equiv.trans_assoc complex.conj_lie, ←ha],
-    simp only [linear_isometry_equiv.trans_assoc, linear_isometry_equiv.refl_trans,
-               linear_isometry_equiv.symm_trans_self],
-    simp [←linear_isometry_equiv.trans_assoc] }
-end
-
-/-- Any linear isometric equivalence in `V` with positive determinant is `rotation`. -/
-lemma exists_linear_isometry_equiv_eq_of_det_pos {f : V ≃ₗᵢ[ℝ] V}
-  (hd : 0 < (f.to_linear_equiv : V →ₗ[ℝ] V).det) : ∃ θ : real.angle, f = hb.rotation θ :=
-begin
-  rcases hb.exists_linear_isometry_equiv_eq f with ⟨θ, (hf|hf)⟩,
-  { exact ⟨θ, hf⟩ },
-  { simp [hf, ←linear_equiv.coe_det] at hd,
-    norm_num at hd }
-end
-
-/-- Any linear isometric equivalence in `V` with negative determinant is `conj_lie` composed
-with `rotation`. -/
-lemma exists_linear_isometry_equiv_eq_of_det_neg {f : V ≃ₗᵢ[ℝ] V}
-  (hd : (f.to_linear_equiv : V →ₗ[ℝ] V).det < 0) :
-  ∃ θ : real.angle, f = hb.conj_lie.trans (hb.rotation θ) :=
-begin
-  rcases hb.exists_linear_isometry_equiv_eq f with ⟨θ, (hf|hf)⟩,
-  { simp [hf, ←linear_equiv.coe_det] at hd,
-    norm_num at hd },
-  { exact ⟨θ, hf⟩ }
-end
-
-/-- Two bases with the same orientation are related by a `rotation`. -/
-lemma exists_linear_isometry_equiv_map_eq_of_orientation_eq {b₂ : basis (fin 2) ℝ V}
-  (hb₂ : orthonormal ℝ b₂) (ho : b.orientation = b₂.orientation) :
-  ∃ θ : real.angle, b₂ = b.map (hb.rotation θ).to_linear_equiv :=
-begin
-  have h : b₂ = b.map (hb.equiv hb₂ (equiv.refl _)).to_linear_equiv,
-  { rw hb.map_equiv, simp },
-  rw [eq_comm, h, b.orientation_comp_linear_equiv_eq_iff_det_pos] at ho,
-  cases hb.exists_linear_isometry_equiv_eq_of_det_pos ho with θ hθ,
-  rw hθ at h,
-  exact ⟨θ, h⟩
-end
-
-/-- Two bases with opposite orientations are related by `conj_lie` composed with a `rotation`. -/
-lemma exists_linear_isometry_equiv_map_eq_of_orientation_eq_neg {b₂ : basis (fin 2) ℝ V}
-  (hb₂ : orthonormal ℝ b₂) (ho : b.orientation = -b₂.orientation) :
-  ∃ θ : real.angle, b₂ = b.map (hb.conj_lie.trans (hb.rotation θ)).to_linear_equiv :=
-begin
-  have h : b₂ = b.map (hb.equiv hb₂ (equiv.refl _)).to_linear_equiv,
-  { rw hb.map_equiv, simp },
-  rw [eq_neg_iff_eq_neg, h, b.orientation_comp_linear_equiv_eq_neg_iff_det_neg] at ho,
-  cases hb.exists_linear_isometry_equiv_eq_of_det_neg ho with θ hθ,
-  rw hθ at h,
-  exact ⟨θ, h⟩
-end
-
-/-- The angle between two vectors, with respect to a basis given by `basis.map` with a linear
-isometric equivalence, equals the angle between those two vectors, transformed by the inverse of
-that equivalence, with respect to the original basis. -/
-@[simp] lemma oangle_map (x y : V) (f : V ≃ₗᵢ[ℝ] V) :
-  (hb.map_linear_isometry_equiv f).oangle x y = hb.oangle (f.symm x) (f.symm y) :=
-by simp [oangle]
-
-/-- The value of `oangle` does not depend on the choice of basis for a given orientation. -/
-lemma oangle_eq_of_orientation_eq {b₂ : basis (fin 2) ℝ V} (hb₂ : orthonormal ℝ b₂)
-  (ho : b.orientation = b₂.orientation) (x y : V) : hb.oangle x y = hb₂.oangle x y :=
-begin
-  obtain ⟨θ, rfl⟩ := hb.exists_linear_isometry_equiv_map_eq_of_orientation_eq hb₂ ho,
-  simp [hb]
-end
-
-/-- Negating the orientation negates the value of `oangle`. -/
-lemma oangle_eq_neg_of_orientation_eq_neg {b₂ : basis (fin 2) ℝ V} (hb₂ : orthonormal ℝ b₂)
-  (ho : b.orientation = -b₂.orientation) (x y : V) : hb.oangle x y = -hb₂.oangle x y :=
-begin
-  obtain ⟨θ, rfl⟩ := hb.exists_linear_isometry_equiv_map_eq_of_orientation_eq_neg hb₂ ho,
-  rw hb.oangle_map,
-  simp [hb]
-end
-
-/-- `rotation` does not depend on the choice of basis for a given orientation. -/
-lemma rotation_eq_of_orientation_eq {b₂ : basis (fin 2) ℝ V} (hb₂ : orthonormal ℝ b₂)
-  (ho : b.orientation = b₂.orientation) (θ : real.angle) : hb.rotation θ = hb₂.rotation θ :=
-begin
-  obtain ⟨θ₂, rfl⟩ := hb.exists_linear_isometry_equiv_map_eq_of_orientation_eq hb₂ ho,
-  simp_rw [rotation, complex.map_isometry_of_orthonormal hb],
-  simp only [linear_isometry_equiv.trans_assoc, linear_isometry_equiv.self_trans_symm,
-             linear_isometry_equiv.refl_trans, linear_isometry_equiv.symm_trans],
-  simp only [←linear_isometry_equiv.trans_assoc, _root_.rotation_symm, _root_.rotation_trans,
-             mul_comm (real.angle.exp_map_circle θ), ←mul_assoc, mul_right_inv, one_mul]
-end
-
-/-- Negating the orientation negates the angle in `rotation`. -/
-lemma rotation_eq_rotation_neg_of_orientation_eq_neg {b₂ : basis (fin 2) ℝ V}
-  (hb₂ : orthonormal ℝ b₂) (ho : b.orientation = -b₂.orientation) (θ : real.angle) :
-  hb.rotation θ = hb₂.rotation (-θ) :=
-begin
-  obtain ⟨θ₂, rfl⟩ := hb.exists_linear_isometry_equiv_map_eq_of_orientation_eq_neg hb₂ ho,
-  simp_rw [rotation, complex.map_isometry_of_orthonormal hb, conj_lie],
-  simp only [linear_isometry_equiv.trans_assoc, linear_isometry_equiv.self_trans_symm,
-             linear_isometry_equiv.refl_trans, linear_isometry_equiv.symm_trans],
-  congr' 1,
-  simp only [←linear_isometry_equiv.trans_assoc, _root_.rotation_symm,
-             linear_isometry_equiv.symm_symm, linear_isometry_equiv.self_trans_symm,
-             linear_isometry_equiv.trans_refl, complex.conj_lie_symm],
-  congr' 1,
-  ext1 x,
-  simp only [linear_isometry_equiv.coe_trans, function.comp_app, rotation_apply,
-             complex.conj_lie_apply, map_mul, star_ring_end_self_apply, ←coe_inv_circle_eq_conj,
-             inv_inv, real.angle.exp_map_circle_neg, ←mul_assoc],
-  congr' 1,
-  simp only [mul_comm (real.angle.exp_map_circle θ₂ : ℂ), mul_assoc],
-  rw [←submonoid.coe_mul, mul_left_inv, submonoid.coe_one, mul_one]
-end
-
-end orthonormal
-
-namespace orientation
-
-open finite_dimensional
-
-variables {V : Type*} [inner_product_space ℝ V]
-variables [hd2 : fact (finrank ℝ V = 2)] (o : orientation ℝ V (fin 2))
-include hd2 o
-
-local notation `ob` := o.fin_orthonormal_basis_orthonormal dec_trivial hd2.out
-
-/-- The oriented angle from `x` to `y`, modulo `2 * π`. If either vector is 0, this is 0.
-See `inner_product_geometry.angle` for the corresponding unoriented angle definition. -/
-def oangle (x y : V) : real.angle :=
-(ob).oangle x y
-
-/-- If the first vector passed to `oangle` is 0, the result is 0. -/
-@[simp] lemma oangle_zero_left (x : V) : o.oangle 0 x = 0 :=
-(ob).oangle_zero_left x
-
-/-- If the second vector passed to `oangle` is 0, the result is 0. -/
-@[simp] lemma oangle_zero_right (x : V) : o.oangle x 0 = 0 :=
-(ob).oangle_zero_right x
-
-/-- If the two vectors passed to `oangle` are the same, the result is 0. -/
-@[simp] lemma oangle_self (x : V) : o.oangle x x = 0 :=
-(ob).oangle_self x
-
-/-- Swapping the two vectors passed to `oangle` negates the angle. -/
-lemma oangle_rev (x y : V) : o.oangle y x = -o.oangle x y :=
-(ob).oangle_rev x y
-
-/-- Adding the angles between two vectors in each order results in 0. -/
-@[simp] lemma oangle_add_oangle_rev (x y : V) : o.oangle x y + o.oangle y x = 0 :=
-(ob).oangle_add_oangle_rev x y
-
-/-- Negating the first vector passed to `oangle` adds `π` to the angle. -/
-lemma oangle_neg_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  o.oangle (-x) y = o.oangle x y + π :=
-(ob).oangle_neg_left hx hy
-
-/-- Negating the second vector passed to `oangle` adds `π` to the angle. -/
-lemma oangle_neg_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
-  o.oangle x (-y) = o.oangle x y + π :=
-(ob).oangle_neg_right hx hy
-
-/-- Negating the first vector passed to `oangle` does not change twice the angle. -/
-@[simp] lemma two_zsmul_oangle_neg_left (x y : V) :
-  (2 : ℤ) • o.oangle (-x) y = (2 : ℤ) • o.oangle x y :=
-(ob).two_zsmul_oangle_neg_left x y
-
-/-- Negating the second vector passed to `oangle` does not change twice the angle. -/
-@[simp] lemma two_zsmul_oangle_neg_right (x y : V) :
-  (2 : ℤ) • o.oangle x (-y) = (2 : ℤ) • o.oangle x y :=
-(ob).two_zsmul_oangle_neg_right x y
-
-/-- Negating both vectors passed to `oangle` does not change the angle. -/
-@[simp] lemma oangle_neg_neg (x y : V) : o.oangle (-x) (-y) = o.oangle x y :=
-(ob).oangle_neg_neg x y
-
-/-- Negating the first vector produces the same angle as negating the second vector. -/
-lemma oangle_neg_left_eq_neg_right (x y : V) : o.oangle (-x) y = o.oangle x (-y) :=
-(ob).oangle_neg_left_eq_neg_right x y
-
-/-- The angle between the negation of a nonzero vector and that vector is `π`. -/
-@[simp] lemma oangle_neg_self_left {x : V} (hx : x ≠ 0) : o.oangle (-x) x = π :=
-(ob).oangle_neg_self_left hx
-
-/-- The angle between a nonzero vector and its negation is `π`. -/
-@[simp] lemma oangle_neg_self_right {x : V} (hx : x ≠ 0) : o.oangle x (-x) = π :=
-(ob).oangle_neg_self_right hx
-
-/-- Twice the angle between the negation of a vector and that vector is 0. -/
-@[simp] lemma two_zsmul_oangle_neg_self_left (x : V) : (2 : ℤ) • o.oangle (-x) x = 0 :=
-(ob).two_zsmul_oangle_neg_self_left x
-
-/-- Twice the angle between a vector and its negation is 0. -/
-@[simp] lemma two_zsmul_oangle_neg_self_right (x : V) : (2 : ℤ) • o.oangle x (-x) = 0 :=
-(ob).two_zsmul_oangle_neg_self_right x
-
-/-- Adding the angles between two vectors in each order, with the first vector in each angle
-negated, results in 0. -/
-@[simp] lemma oangle_add_oangle_rev_neg_left (x y : V) :
-  o.oangle (-x) y + o.oangle (-y) x = 0 :=
-(ob).oangle_add_oangle_rev_neg_left x y
-
-/-- Adding the angles between two vectors in each order, with the second vector in each angle
-negated, results in 0. -/
-@[simp] lemma oangle_add_oangle_rev_neg_right (x y : V) :
-  o.oangle x (-y) + o.oangle y (-x) = 0 :=
-(ob).oangle_add_oangle_rev_neg_right x y
-
-/-- Multiplying the first vector passed to `oangle` by a positive real does not change the
-angle. -/
-@[simp] lemma oangle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
-  o.oangle (r • x) y = o.oangle x y :=
-(ob).oangle_smul_left_of_pos x y hr
-
-/-- Multiplying the second vector passed to `oangle` by a positive real does not change the
-angle. -/
-@[simp] lemma oangle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) :
-  o.oangle x (r • y) = o.oangle x y :=
-(ob).oangle_smul_right_of_pos x y hr
-
-/-- Multiplying the first vector passed to `oangle` by a negative real produces the same angle
-as negating that vector. -/
-@[simp] lemma oangle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
-  o.oangle (r • x) y = o.oangle (-x) y :=
-(ob).oangle_smul_left_of_neg x y hr
-
-/-- Multiplying the second vector passed to `oangle` by a negative real produces the same angle
-as negating that vector. -/
-@[simp] lemma oangle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) :
-  o.oangle x (r • y) = o.oangle x (-y) :=
-(ob).oangle_smul_right_of_neg x y hr
-
-/-- The angle between a nonnegative multiple of a vector and that vector is 0. -/
-@[simp] lemma oangle_smul_left_self_of_nonneg (x : V) {r : ℝ} (hr : 0 ≤ r) :
-  o.oangle (r • x) x = 0 :=
-(ob).oangle_smul_left_self_of_nonneg x hr
-
-/-- The angle between a vector and a nonnegative multiple of that vector is 0. -/
-@[simp] lemma oangle_smul_right_self_of_nonneg (x : V) {r : ℝ} (hr : 0 ≤ r) :
-  o.oangle x (r • x) = 0 :=
-(ob).oangle_smul_right_self_of_nonneg x hr
-
-/-- The angle between two nonnegative multiples of the same vector is 0. -/
-@[simp] lemma oangle_smul_smul_self_of_nonneg (x : V) {r₁ r₂ : ℝ} (hr₁ : 0 ≤ r₁) (hr₂ : 0 ≤ r₂) :
-  o.oangle (r₁ • x) (r₂ • x) = 0 :=
-(ob).oangle_smul_smul_self_of_nonneg x hr₁ hr₂
-
-/-- Multiplying the first vector passed to `oangle` by a nonzero real does not change twice the
-angle. -/
-@[simp] lemma two_zsmul_oangle_smul_left_of_ne_zero (x y : V) {r : ℝ} (hr : r ≠ 0) :
-  (2 : ℤ) • o.oangle (r • x) y = (2 : ℤ) • o.oangle x y :=
-(ob).two_zsmul_oangle_smul_left_of_ne_zero x y hr
-
-/-- Multiplying the second vector passed to `oangle` by a nonzero real does not change twice the
-angle. -/
-@[simp] lemma two_zsmul_oangle_smul_right_of_ne_zero (x y : V) {r : ℝ} (hr : r ≠ 0) :
-  (2 : ℤ) • o.oangle x (r • y) = (2 : ℤ) • o.oangle x y :=
-(ob).two_zsmul_oangle_smul_right_of_ne_zero x y hr
-
-/-- Twice the angle between a multiple of a vector and that vector is 0. -/
-@[simp] lemma two_zsmul_oangle_smul_left_self (x : V) {r : ℝ} :
-  (2 : ℤ) • o.oangle (r • x) x = 0 :=
-(ob).two_zsmul_oangle_smul_left_self x
-
-/-- Twice the angle between a vector and a multiple of that vector is 0. -/
-@[simp] lemma two_zsmul_oangle_smul_right_self (x : V) {r : ℝ} :
-  (2 : ℤ) • o.oangle x (r • x) = 0 :=
-(ob).two_zsmul_oangle_smul_right_self x
-
-/-- Twice the angle between two multiples of a vector is 0. -/
-@[simp] lemma two_zsmul_oangle_smul_smul_self (x : V) {r₁ r₂ : ℝ} :
-  (2 : ℤ) • o.oangle (r₁ • x) (r₂ • x) = 0 :=
-(ob).two_zsmul_oangle_smul_smul_self x
-
-/-- Two vectors are equal if and only if they have equal norms and zero angle between them. -/
-lemma eq_iff_norm_eq_and_oangle_eq_zero (x y : V) : x = y ↔ ∥x∥ = ∥y∥ ∧ o.oangle x y = 0 :=
-(ob).eq_iff_norm_eq_and_oangle_eq_zero x y
-
-/-- Two vectors with equal norms are equal if and only if they have zero angle between them. -/
-lemma eq_iff_oangle_eq_zero_of_norm_eq {x y : V} (h : ∥x∥ = ∥y∥) : x = y ↔ o.oangle x y = 0 :=
-(ob).eq_iff_oangle_eq_zero_of_norm_eq h
-
-/-- Two vectors with zero angle between them are equal if and only if they have equal norms. -/
-lemma eq_iff_norm_eq_of_oangle_eq_zero {x y : V} (h : o.oangle x y = 0) : x = y ↔ ∥x∥ = ∥y∥ :=
-(ob).eq_iff_norm_eq_of_oangle_eq_zero h
-
-/-- Given three nonzero vectors, the angle between the first and the second plus the angle
-between the second and the third equals the angle between the first and the third. -/
-@[simp] lemma oangle_add {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  o.oangle x y + o.oangle y z = o.oangle x z :=
-(ob).oangle_add hx hy hz
-
-/-- Given three nonzero vectors, the angle between the second and the third plus the angle
-between the first and the second equals the angle between the first and the third. -/
-@[simp] lemma oangle_add_swap {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-   o.oangle y z + o.oangle x y = o.oangle x z :=
-(ob).oangle_add_swap hx hy hz
-
-/-- Given three nonzero vectors, the angle between the first and the third minus the angle
-between the first and the second equals the angle between the second and the third. -/
-@[simp] lemma oangle_sub_left {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  o.oangle x z - o.oangle x y = o.oangle y z :=
-(ob).oangle_sub_left hx hy hz
-
-/-- Given three nonzero vectors, the angle between the first and the third minus the angle
-between the second and the third equals the angle between the first and the second. -/
-@[simp] lemma oangle_sub_right {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  o.oangle x z - o.oangle y z = o.oangle x y :=
-(ob).oangle_sub_right hx hy hz
-
-/-- Given three nonzero vectors, adding the angles between them in cyclic order results in 0. -/
-@[simp] lemma oangle_add_cyc3 {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  o.oangle x y + o.oangle y z + o.oangle z x = 0 :=
-(ob).oangle_add_cyc3 hx hy hz
-
-/-- Given three nonzero vectors, adding the angles between them in cyclic order, with the first
-vector in each angle negated, results in π. If the vectors add to 0, this is a version of the
-sum of the angles of a triangle. -/
-@[simp] lemma oangle_add_cyc3_neg_left {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  o.oangle (-x) y + o.oangle (-y) z + o.oangle (-z) x = π :=
-(ob).oangle_add_cyc3_neg_left hx hy hz
-
-/-- Given three nonzero vectors, adding the angles between them in cyclic order, with the second
-vector in each angle negated, results in π. If the vectors add to 0, this is a version of the
-sum of the angles of a triangle. -/
-@[simp] lemma oangle_add_cyc3_neg_right {x y z : V} (hx : x ≠ 0) (hy : y ≠ 0) (hz : z ≠ 0) :
-  o.oangle x (-y) + o.oangle y (-z) + o.oangle z (-x) = π :=
-(ob).oangle_add_cyc3_neg_right hx hy hz
-
-/-- Pons asinorum, oriented vector angle form. -/
-lemma oangle_sub_eq_oangle_sub_rev_of_norm_eq {x y : V} (h : ∥x∥ = ∥y∥) :
-  o.oangle x (x - y) = o.oangle (y - x) y :=
-(ob).oangle_sub_eq_oangle_sub_rev_of_norm_eq h
-
-/-- The angle at the apex of an isosceles triangle is `π` minus twice a base angle, oriented
-vector angle form. -/
-lemma oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq {x y : V} (hn : x ≠ y) (h : ∥x∥ = ∥y∥) :
-  o.oangle y x = π - (2 : ℤ) • o.oangle (y - x) y :=
-(ob).oangle_eq_pi_sub_two_zsmul_oangle_sub_of_norm_eq hn h
-
-/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
-form. -/
-lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
-  (hxy : ∥x∥ = ∥y∥) (hxz : ∥x∥ = ∥z∥) : o.oangle y z = (2 : ℤ) • o.oangle (y - x) (z - x) :=
-(ob).oangle_eq_two_zsmul_oangle_sub_of_norm_eq hxyne hxzne hxy hxz
-
-/-- Angle at center of a circle equals twice angle at circumference, oriented vector angle
-form with radius specified. -/
-lemma oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real {x y z : V} (hxyne : x ≠ y) (hxzne : x ≠ z)
-  {r : ℝ} (hx : ∥x∥ = r) (hy : ∥y∥ = r) (hz : ∥z∥ = r) :
-  o.oangle y z = (2 : ℤ) • o.oangle (y - x) (z - x) :=
-(ob).oangle_eq_two_zsmul_oangle_sub_of_norm_eq_real hxyne hxzne hx hy hz
-
-/-- Oriented vector angle version of "angles in same segment are equal" and "opposite angles of
-a cyclic quadrilateral add to π", for oriented angles mod π (for which those are the same
-result), represented here as equality of twice the angles. -/
-lemma two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq {x₁ x₂ y z : V} (hx₁yne : x₁ ≠ y)
-  (hx₁zne : x₁ ≠ z) (hx₂yne : x₂ ≠ y) (hx₂zne : x₂ ≠ z) {r : ℝ} (hx₁ : ∥x₁∥ = r) (hx₂ : ∥x₂∥ = r)
-  (hy : ∥y∥ = r) (hz : ∥z∥ = r) :
-  (2 : ℤ) • o.oangle (y - x₁) (z - x₁) = (2 : ℤ) • o.oangle (y - x₂) (z - x₂) :=
-(ob).two_zsmul_oangle_sub_eq_two_zsmul_oangle_sub_of_norm_eq hx₁yne hx₁zne hx₂yne hx₂zne hx₁ hx₂
-  hy hz
-
-/-- A rotation by the oriented angle `θ`. -/
-def rotation (θ : real.angle) : V ≃ₗᵢ[ℝ] V :=
-(ob).rotation θ
-
-/-- The determinant of `rotation` (as a linear map) is equal to `1`. -/
-@[simp] lemma det_rotation (θ : real.angle) :
-  ((o.rotation θ).to_linear_equiv : V →ₗ[ℝ] V).det = 1 :=
-(ob).det_rotation θ
-
-/-- The determinant of `rotation` (as a linear equiv) is equal to `1`. -/
-@[simp] lemma linear_equiv_det_rotation (θ : real.angle) :
-  (o.rotation θ).to_linear_equiv.det = 1 :=
-(ob).linear_equiv_det_rotation θ
-
-/-- The inverse of `rotation` is rotation by the negation of the angle. -/
-@[simp] lemma rotation_symm (θ : real.angle) : (o.rotation θ).symm = o.rotation (-θ) :=
-(ob).rotation_symm θ
-
-/-- Rotation by 0 is the identity. -/
-@[simp] lemma rotation_zero : o.rotation 0 = linear_isometry_equiv.refl ℝ V :=
-(ob).rotation_zero
-
-/-- Rotation by π is negation. -/
-lemma rotation_pi : o.rotation π = linear_isometry_equiv.neg ℝ :=
-(ob).rotation_pi
-
-/-- Rotating twice is equivalent to rotating by the sum of the angles. -/
-@[simp] lemma rotation_trans (θ₁ θ₂ : real.angle) :
-  (o.rotation θ₁).trans (o.rotation θ₂) = o.rotation (θ₂ + θ₁) :=
-(ob).rotation_trans θ₁ θ₂
-
-/-- Rotating the first vector by `θ` subtracts `θ` from the angle between two vectors. -/
-@[simp] lemma oangle_rotation_left {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
-  o.oangle (o.rotation θ x) y = o.oangle x y - θ :=
-(ob).oangle_rotation_left hx hy θ
-
-/-- Rotating the second vector by `θ` adds `θ` to the angle between two vectors. -/
-@[simp] lemma oangle_rotation_right {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) (θ : real.angle) :
-  o.oangle x (o.rotation θ y) = o.oangle x y + θ :=
-(ob).oangle_rotation_right hx hy θ
-
-/-- The rotation of a vector by `θ` has an angle of `-θ` from that vector. -/
-@[simp] lemma oangle_rotation_self_left {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  o.oangle (o.rotation θ x) x = -θ :=
-(ob).oangle_rotation_self_left hx θ
-
-/-- A vector has an angle of `θ` from the rotation of that vector by `θ`. -/
-@[simp] lemma oangle_rotation_self_right {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  o.oangle x (o.rotation θ x) = θ :=
-(ob).oangle_rotation_self_right hx θ
-
-/-- Rotating the first vector by the angle between the two vectors results an an angle of 0. -/
-@[simp] lemma oangle_rotation_oangle_left (x y : V) :
-  o.oangle (o.rotation (o.oangle x y) x) y = 0 :=
-(ob).oangle_rotation_oangle_left x y
-
-/-- Rotating the first vector by the angle between the two vectors and swapping the vectors
-results an an angle of 0. -/
-@[simp] lemma oangle_rotation_oangle_right (x y : V) :
-  o.oangle y (o.rotation (o.oangle x y) x) = 0 :=
-(ob).oangle_rotation_oangle_right x y
-
-/-- Rotating both vectors by the same angle does not change the angle between those vectors. -/
-@[simp] lemma oangle_rotation (x y : V) (θ : real.angle) :
-  o.oangle (o.rotation θ x) (o.rotation θ y) = o.oangle x y :=
-(ob).oangle_rotation x y θ
-
-/-- A rotation of a nonzero vector equals that vector if and only if the angle is zero. -/
-@[simp] lemma rotation_eq_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  o.rotation θ x = x ↔ θ = 0 :=
-(ob).rotation_eq_self_iff_angle_eq_zero hx θ
-
-/-- A nonzero vector equals a rotation of that vector if and only if the angle is zero. -/
-@[simp] lemma eq_rotation_self_iff_angle_eq_zero {x : V} (hx : x ≠ 0) (θ : real.angle) :
-  x = o.rotation θ x ↔ θ = 0 :=
-(ob).eq_rotation_self_iff_angle_eq_zero hx θ
-
-/-- A rotation of a vector equals that vector if and only if the vector or the angle is zero. -/
-lemma rotation_eq_self_iff (x : V) (θ : real.angle) :
-  o.rotation θ x = x ↔ x = 0 ∨ θ = 0 :=
-(ob).rotation_eq_self_iff x θ
-
-/-- A vector equals a rotation of that vector if and only if the vector or the angle is zero. -/
-lemma eq_rotation_self_iff (x : V) (θ : real.angle) :
-  x = o.rotation θ x ↔ x = 0 ∨ θ = 0 :=
-(ob).eq_rotation_self_iff x θ
-
-/-- Rotating a vector by the angle to another vector gives the second vector if and only if the
-norms are equal. -/
-@[simp] lemma rotation_oangle_eq_iff_norm_eq (x y : V) :
-  o.rotation (o.oangle x y) x = y ↔ ∥x∥ = ∥y∥ :=
-(ob).rotation_oangle_eq_iff_norm_eq x y
-
-/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
-rotated by `θ` and scaled by the ratio of the norms. -/
-lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
-  (θ : real.angle) : o.oangle x y = θ ↔ y = (∥y∥ / ∥x∥) • o.rotation θ x :=
-(ob).oangle_eq_iff_eq_norm_div_norm_smul_rotation_of_ne_zero hx hy θ
-
-/-- The angle between two nonzero vectors is `θ` if and only if the second vector is the first
-rotated by `θ` and scaled by a positive real. -/
-lemma oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0)
-  (θ : real.angle) : o.oangle x y = θ ↔ ∃ r : ℝ, 0 < r ∧ y = r • o.rotation θ x :=
-(ob).oangle_eq_iff_eq_pos_smul_rotation_of_ne_zero hx hy θ
-
-/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
-is the first rotated by `θ` and scaled by the ratio of the norms, or `θ` and at least one of the
-vectors are zero. -/
-lemma oangle_eq_iff_eq_norm_div_norm_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
-  o.oangle x y = θ ↔
-    (x ≠ 0 ∧ y ≠ 0 ∧ y = (∥y∥ / ∥x∥) • o.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
-(ob).oangle_eq_iff_eq_norm_div_norm_smul_rotation_or_eq_zero θ
-
-/-- The angle between two vectors is `θ` if and only if they are nonzero and the second vector
-is the first rotated by `θ` and scaled by a positive real, or `θ` and at least one of the
-vectors are zero. -/
-lemma oangle_eq_iff_eq_pos_smul_rotation_or_eq_zero {x y : V} (θ : real.angle) :
-  o.oangle x y = θ ↔
-    (x ≠ 0 ∧ y ≠ 0 ∧ ∃ r : ℝ, 0 < r ∧ y = r • o.rotation θ x) ∨ (θ = 0 ∧ (x = 0 ∨ y = 0)) :=
-(ob).oangle_eq_iff_eq_pos_smul_rotation_or_eq_zero θ
-
-/-- Any linear isometric equivalence in `V` with positive determinant is `rotation`. -/
-lemma exists_linear_isometry_equiv_eq_of_det_pos {f : V ≃ₗᵢ[ℝ] V}
-  (hd : 0 < (f.to_linear_equiv : V →ₗ[ℝ] V).det) : ∃ θ : real.angle, f = o.rotation θ :=
-(ob).exists_linear_isometry_equiv_eq_of_det_pos hd
-
-/-- The angle between two vectors, with respect to an orientation given by `orientation.map`
-with a linear isometric equivalence, equals the angle between those two vectors, transformed by
-the inverse of that equivalence, with respect to the original orientation. -/
-@[simp] lemma oangle_map (x y : V) (f : V ≃ₗᵢ[ℝ] V) :
-  (orientation.map (fin 2) f.to_linear_equiv o).oangle x y = o.oangle (f.symm x) (f.symm y) :=
-begin
-  convert (ob).oangle_map x y f using 1,
-  refine orthonormal.oangle_eq_of_orientation_eq _ _ _ _ _,
-  simp_rw [basis.orientation_map, orientation.fin_orthonormal_basis_orientation]
-end
-
-/-- `orientation.oangle` equals `orthonormal.oangle` for any orthonormal basis with that
-orientation. -/
-lemma oangle_eq_basis_oangle {b : basis (fin 2) ℝ V} (hb : orthonormal ℝ b)
-  (h : b.orientation = o) (x y : V) : o.oangle x y = hb.oangle x y :=
-begin
-  rw oangle,
-  refine orthonormal.oangle_eq_of_orientation_eq _ _ _ _ _,
-  simp [h]
-end
-
-/-- Negating the orientation negates the value of `oangle`. -/
-lemma oangle_neg_orientation_eq_neg (x y : V) : (-o).oangle x y = -(o.oangle x y) :=
-begin
-  simp_rw oangle,
-  refine orthonormal.oangle_eq_neg_of_orientation_eq_neg _ _ _ _ _,
-  simp_rw orientation.fin_orthonormal_basis_orientation
-end
-
-/-- `orientation.rotation` equals `orthonormal.rotation` for any orthonormal basis with that
-orientation. -/
-lemma rotation_eq_basis_rotation {b : basis (fin 2) ℝ V} (hb : orthonormal ℝ b)
-  (h : b.orientation = o) (θ : ℝ) : o.rotation θ = hb.rotation θ :=
-begin
-  rw rotation,
-  refine orthonormal.rotation_eq_of_orientation_eq _ _ _ _,
-  simp [h]
-end
-
-/-- Negating the orientation negates the angle in `rotation`. -/
-lemma rotation_neg_orientation_eq_neg (θ : real.angle) :
-  (-o).rotation θ = o.rotation (-θ) :=
-begin
-  simp_rw rotation,
-  refine orthonormal.rotation_eq_rotation_neg_of_orientation_eq_neg _ _ _ _,
-  simp_rw orientation.fin_orthonormal_basis_orientation
-end
-
-end orientation
diff --git a/src/geometry/euclidean/sphere.lean b/src/geometry/euclidean/sphere.lean
deleted file mode 100644
index f7bacb34d643c..0000000000000
--- a/src/geometry/euclidean/sphere.lean
+++ /dev/null
@@ -1,183 +0,0 @@
-/-
-Copyright (c) 2021 Manuel Candales. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Manuel Candales, Benjamin Davidson
--/
-import geometry.euclidean.triangle
-
-/-!
-# Spheres
-
-This file proves basic geometrical results about distances and angles
-in spheres in real inner product spaces and Euclidean affine spaces.
-
-## Main theorems
-
-* `mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi`: Intersecting Chords Theorem (Freek No. 55).
-* `mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_zero`: Intersecting Secants Theorem.
-* `mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`: Ptolemy’s Theorem (Freek No. 95).
-
-TODO: The current statement of Ptolemy’s theorem works around the lack of a "cyclic polygon" concept
-in mathlib, which is what the theorem statement would naturally use (or two such concepts, since
-both a strict version, where all vertices must be distinct, and a weak version, where consecutive
-vertices may be equal, would be useful; Ptolemy's theorem should then use the weak one).
-
-An API needs to be built around that concept, which would include:
-- strict cyclic implies weak cyclic,
-- weak cyclic and consecutive points distinct implies strict cyclic,
-- weak/strict cyclic implies weak/strict cyclic for any subsequence,
-- any three points on a sphere are weakly or strictly cyclic according to whether they are distinct,
-- any number of points on a sphere intersected with a two-dimensional affine subspace are cyclic in
-  some order,
-- a list of points is cyclic if and only if its reversal is,
-- a list of points is cyclic if and only if any cyclic permutation is, while other permutations
-  are not when the points are distinct,
-- a point P where the diagonals of a cyclic polygon cross exists (and is unique) with weak/strict
-  betweenness depending on weak/strict cyclicity,
-- four points on a sphere with such a point P are cyclic in the appropriate order,
-and so on.
--/
-
-open real
-open_locale euclidean_geometry real_inner_product_space real
-
-variables {V : Type*} [inner_product_space ℝ V]
-
-namespace inner_product_geometry
-
-/-!
-### Geometrical results on spheres in real inner product spaces
-
-This section develops some results on spheres in real inner product spaces,
-which are used to deduce corresponding results for Euclidean affine spaces.
--/
-
-lemma mul_norm_eq_abs_sub_sq_norm {x y z : V}
-  (h₁ : ∃ k : ℝ, k ≠ 1 ∧ x + y = k • (x - y)) (h₂ : ∥z - y∥ = ∥z + y∥) :
-  ∥x - y∥ * ∥x + y∥ = |∥z + y∥ ^ 2 - ∥z - x∥ ^ 2| :=
-begin
-  obtain ⟨k, hk_ne_one, hk⟩ := h₁,
-  let r := (k - 1)⁻¹ * (k + 1),
-
-  have hxy : x = r • y,
-  { rw [← smul_smul, eq_inv_smul_iff₀ (sub_ne_zero.mpr hk_ne_one), ← sub_eq_zero],
-    calc  (k - 1) • x - (k + 1) • y
-        = (k • x - x) - (k • y + y) : by simp_rw [sub_smul, add_smul, one_smul]
-    ... = (k • x - k • y) - (x + y) : by simp_rw [← sub_sub, sub_right_comm]
-    ... = k • (x - y) - (x + y)     : by rw ← smul_sub k x y
-    ... = 0                         : sub_eq_zero.mpr hk.symm },
-
-  have hzy : ⟪z, y⟫ = 0,
-    by rwa [inner_eq_zero_iff_angle_eq_pi_div_two, ← norm_add_eq_norm_sub_iff_angle_eq_pi_div_two,
-      eq_comm],
-
-  have hzx : ⟪z, x⟫ = 0 := by rw [hxy, inner_smul_right, hzy, mul_zero],
-
-  calc  ∥x - y∥ * ∥x + y∥
-      = ∥(r - 1) • y∥ * ∥(r + 1) • y∥      : by simp [sub_smul, add_smul, hxy]
-  ... = ∥r - 1∥ * ∥y∥ * (∥r + 1∥ * ∥y∥)      : by simp_rw [norm_smul]
-  ... = ∥r - 1∥ * ∥r + 1∥ * ∥y∥ ^ 2         : by ring
-  ... = |(r - 1) * (r + 1) * ∥y∥ ^ 2| : by simp [abs_mul, norm_eq_abs]
-  ... = |r ^ 2 * ∥y∥ ^ 2 - ∥y∥ ^ 2|    : by ring_nf
-  ... = |∥x∥ ^ 2 - ∥y∥ ^ 2|            : by simp [hxy, norm_smul, mul_pow, norm_eq_abs, sq_abs]
-  ... = |∥z + y∥ ^ 2 - ∥z - x∥ ^ 2|    : by simp [norm_add_sq_real, norm_sub_sq_real,
-                                                    hzy, hzx, abs_sub_comm],
-end
-
-end inner_product_geometry
-
-namespace euclidean_geometry
-
-/-!
-### Geometrical results on spheres in Euclidean affine spaces
-
-This section develops some results on spheres in Euclidean affine spaces.
--/
-
-open inner_product_geometry
-
-variables {P : Type*} [metric_space P] [normed_add_torsor V P]
-include V
-
-/-- If `P` is a point on the line `AB` and `Q` is equidistant from `A` and `B`, then
-`AP * BP = abs (BQ ^ 2 - PQ ^ 2)`. -/
-lemma mul_dist_eq_abs_sub_sq_dist {a b p q : P}
-  (hp : ∃ k : ℝ, k ≠ 1 ∧ b -ᵥ p = k • (a -ᵥ p)) (hq : dist a q = dist b q) :
-  dist a p * dist b p = |dist b q ^ 2 - dist p q ^ 2| :=
-begin
-  let m : P := midpoint ℝ a b,
-  obtain ⟨v, h1, h2, h3⟩ := ⟨vsub_sub_vsub_cancel_left, v a p m, v p q m, v a q m⟩,
-  have h : ∀ r, b -ᵥ r = (m -ᵥ r) + (m -ᵥ a) :=
-    λ r, by rw [midpoint_vsub_left, ← right_vsub_midpoint, add_comm, vsub_add_vsub_cancel],
-  iterate 4 { rw dist_eq_norm_vsub V },
-  rw [← h1, ← h2, h, h],
-  rw [← h1, h] at hp,
-  rw [dist_eq_norm_vsub V a q, dist_eq_norm_vsub V b q, ← h3, h] at hq,
-  exact mul_norm_eq_abs_sub_sq_norm hp hq,
-end
-
-/-- If `A`, `B`, `C`, `D` are cospherical and `P` is on both lines `AB` and `CD`, then
-`AP * BP = CP * DP`. -/
-lemma mul_dist_eq_mul_dist_of_cospherical {a b c d p : P}
-  (h : cospherical ({a, b, c, d} : set P))
-  (hapb : ∃ k₁ : ℝ, k₁ ≠ 1 ∧ b -ᵥ p = k₁ • (a -ᵥ p))
-  (hcpd : ∃ k₂ : ℝ, k₂ ≠ 1 ∧ d -ᵥ p = k₂ • (c -ᵥ p)) :
-  dist a p * dist b p = dist c p * dist d p :=
-begin
-  obtain ⟨q, r, h'⟩ := (cospherical_def {a, b, c, d}).mp h,
-  obtain ⟨ha, hb, hc, hd⟩ := ⟨h' a _, h' b _, h' c _, h' d _⟩,
-  { rw ← hd at hc,
-    rw ← hb at ha,
-    rw [mul_dist_eq_abs_sub_sq_dist hapb ha, hb, mul_dist_eq_abs_sub_sq_dist hcpd hc, hd] },
-  all_goals { simp },
-end
-
-/-- **Intersecting Chords Theorem**. -/
-theorem mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi {a b c d p : P}
-  (h : cospherical ({a, b, c, d} : set P))
-  (hapb : ∠ a p b = π) (hcpd : ∠ c p d = π) :
-  dist a p * dist b p = dist c p * dist d p :=
-begin
-  obtain ⟨-, k₁, _, hab⟩ := angle_eq_pi_iff.mp hapb,
-  obtain ⟨-, k₂, _, hcd⟩ := angle_eq_pi_iff.mp hcpd,
-  exact mul_dist_eq_mul_dist_of_cospherical h ⟨k₁, (by linarith), hab⟩ ⟨k₂, (by linarith), hcd⟩,
-end
-
-/-- **Intersecting Secants Theorem**. -/
-theorem mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_zero {a b c d p : P}
-  (h : cospherical ({a, b, c, d} : set P))
-  (hab : a ≠ b) (hcd : c ≠ d) (hapb : ∠ a p b = 0) (hcpd : ∠ c p d = 0) :
-  dist a p * dist b p = dist c p * dist d p :=
-begin
-  obtain ⟨-, k₁, -, hab₁⟩ := angle_eq_zero_iff.mp hapb,
-  obtain ⟨-, k₂, -, hcd₁⟩ := angle_eq_zero_iff.mp hcpd,
-  refine mul_dist_eq_mul_dist_of_cospherical h ⟨k₁, _, hab₁⟩ ⟨k₂, _, hcd₁⟩;
-  by_contra hnot;
-  simp only [not_not, *, one_smul] at *,
-  exacts [hab (vsub_left_cancel hab₁).symm, hcd (vsub_left_cancel hcd₁).symm],
-end
-
-/-- **Ptolemy’s Theorem**. -/
-theorem mul_dist_add_mul_dist_eq_mul_dist_of_cospherical {a b c d p : P}
-  (h : cospherical ({a, b, c, d} : set P))
-  (hapc : ∠ a p c = π) (hbpd : ∠ b p d = π) :
-  dist a b * dist c d + dist b c * dist d a = dist a c * dist b d :=
-begin
-  have h' : cospherical ({a, c, b, d} : set P), { rwa set.insert_comm c b {d} },
-  have hmul := mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi h' hapc hbpd,
-  have hbp := left_dist_ne_zero_of_angle_eq_pi hbpd,
-  have h₁ : dist c d = dist c p / dist b p * dist a b,
-  { rw [dist_mul_of_eq_angle_of_dist_mul b p a c p d, dist_comm a b],
-    { rw [angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi hbpd hapc, angle_comm] },
-    all_goals { field_simp [mul_comm, hmul] } },
-  have h₂ : dist d a = dist a p / dist b p * dist b c,
-  { rw [dist_mul_of_eq_angle_of_dist_mul c p b d p a, dist_comm c b],
-    { rwa [angle_comm, angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi], rwa angle_comm },
-    all_goals { field_simp [mul_comm, hmul] } },
-  have h₃ : dist d p = dist a p * dist c p / dist b p, { field_simp [mul_comm, hmul] },
-  have h₄ : ∀ x y : ℝ, x * (y * x) = x * x * y := λ x y, by rw [mul_left_comm, mul_comm],
-  field_simp [h₁, h₂, dist_eq_add_dist_of_angle_eq_pi hbpd, h₃, hbp, dist_comm a b,
-              h₄, ← sq, dist_sq_mul_dist_add_dist_sq_mul_dist b, hapc],
-end
-
-end euclidean_geometry
diff --git a/src/geometry/euclidean/sphere/basic.lean b/src/geometry/euclidean/sphere/basic.lean
new file mode 100644
index 0000000000000..8004575cf2780
--- /dev/null
+++ b/src/geometry/euclidean/sphere/basic.lean
@@ -0,0 +1,353 @@
+/-
+Copyright (c) 2020 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import analysis.convex.strict_convex_between
+import geometry.euclidean.basic
+
+/-!
+# Spheres
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines and proves basic results about spheres and cospherical sets of points in
+Euclidean affine spaces.
+
+## Main definitions
+
+* `euclidean_geometry.sphere` bundles a `center` and a `radius`.
+
+* `euclidean_geometry.cospherical` is the property of a set of points being equidistant from some
+  point.
+
+* `euclidean_geometry.concyclic` is the property of a set of points being cospherical and
+  coplanar.
+
+-/
+
+noncomputable theory
+open_locale real_inner_product_space
+
+namespace euclidean_geometry
+
+variables {V : Type*} (P : Type*)
+
+open finite_dimensional
+
+/-- A `sphere P` bundles a `center` and `radius`. This definition does not require the radius to
+be positive; that should be given as a hypothesis to lemmas that require it. -/
+@[ext] structure sphere [metric_space P] :=
+(center : P)
+(radius : ℝ)
+
+variables {P}
+
+section metric_space
+variables [metric_space P]
+
+instance [nonempty P] : nonempty (sphere P) := ⟨⟨classical.arbitrary P, 0⟩⟩
+
+instance : has_coe (sphere P) (set P) := ⟨λ s, metric.sphere s.center s.radius⟩
+instance : has_mem P (sphere P) := ⟨λ p s, p ∈ (s : set P)⟩
+
+lemma sphere.mk_center (c : P) (r : ℝ) : (⟨c, r⟩ : sphere P).center = c := rfl
+
+lemma sphere.mk_radius (c : P) (r : ℝ) : (⟨c, r⟩ : sphere P).radius = r := rfl
+
+@[simp] lemma sphere.mk_center_radius (s : sphere P) : (⟨s.center, s.radius⟩ : sphere P) = s :=
+by ext; refl
+
+lemma sphere.coe_def (s : sphere P) : (s : set P) = metric.sphere s.center s.radius := rfl
+
+@[simp] lemma sphere.coe_mk (c : P) (r : ℝ) : ↑(⟨c, r⟩ : sphere P) = metric.sphere c r := rfl
+
+@[simp] lemma sphere.mem_coe {p : P} {s : sphere P} : p ∈ (s : set P) ↔ p ∈ s := iff.rfl
+
+lemma mem_sphere {p : P} {s : sphere P} : p ∈ s ↔ dist p s.center = s.radius := iff.rfl
+
+lemma mem_sphere' {p : P} {s : sphere P} : p ∈ s ↔ dist s.center p = s.radius :=
+metric.mem_sphere'
+
+lemma subset_sphere {ps : set P} {s : sphere P} : ps ⊆ s ↔ ∀ p ∈ ps, p ∈ s := iff.rfl
+
+lemma dist_of_mem_subset_sphere {p : P} {ps : set P} {s : sphere P} (hp : p ∈ ps)
+  (hps : ps ⊆ (s : set P)) : dist p s.center = s.radius :=
+mem_sphere.1 (sphere.mem_coe.1 (set.mem_of_mem_of_subset hp hps))
+
+lemma dist_of_mem_subset_mk_sphere {p c : P} {ps : set P} {r : ℝ} (hp : p ∈ ps)
+  (hps : ps ⊆ ↑(⟨c, r⟩ : sphere P)) : dist p c = r :=
+dist_of_mem_subset_sphere hp hps
+
+lemma sphere.ne_iff {s₁ s₂ : sphere P} :
+  s₁ ≠ s₂ ↔ s₁.center ≠ s₂.center ∨ s₁.radius ≠ s₂.radius :=
+by rw [←not_and_distrib, ←sphere.ext_iff]
+
+lemma sphere.center_eq_iff_eq_of_mem {s₁ s₂ : sphere P} {p : P} (hs₁ : p ∈ s₁) (hs₂ : p ∈ s₂) :
+  s₁.center = s₂.center ↔ s₁ = s₂ :=
+begin
+  refine ⟨λ h, sphere.ext _ _ h _, λ h, h ▸ rfl⟩,
+  rw mem_sphere at hs₁ hs₂,
+  rw [←hs₁, ←hs₂, h]
+end
+
+lemma sphere.center_ne_iff_ne_of_mem {s₁ s₂ : sphere P} {p : P} (hs₁ : p ∈ s₁) (hs₂ : p ∈ s₂) :
+  s₁.center ≠ s₂.center ↔ s₁ ≠ s₂ :=
+(sphere.center_eq_iff_eq_of_mem hs₁ hs₂).not
+
+lemma dist_center_eq_dist_center_of_mem_sphere {p₁ p₂ : P} {s : sphere P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) : dist p₁ s.center = dist p₂ s.center :=
+by rw [mem_sphere.1 hp₁, mem_sphere.1 hp₂]
+
+lemma dist_center_eq_dist_center_of_mem_sphere' {p₁ p₂ : P} {s : sphere P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) : dist s.center p₁ = dist s.center p₂ :=
+by rw [mem_sphere'.1 hp₁, mem_sphere'.1 hp₂]
+
+/-- A set of points is cospherical if they are equidistant from some
+point.  In two dimensions, this is the same thing as being
+concyclic. -/
+def cospherical (ps : set P) : Prop :=
+∃ (center : P) (radius : ℝ), ∀ p ∈ ps, dist p center = radius
+
+/-- The definition of `cospherical`. -/
+lemma cospherical_def (ps : set P) :
+  cospherical ps ↔ ∃ (center : P) (radius : ℝ), ∀ p ∈ ps, dist p center = radius :=
+iff.rfl
+
+/-- A set of points is cospherical if and only if they lie in some sphere. -/
+lemma cospherical_iff_exists_sphere {ps : set P} :
+  cospherical ps ↔ ∃ s : sphere P, ps ⊆ (s : set P) :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with ⟨c, r, h⟩,
+    exact ⟨⟨c, r⟩, h⟩ },
+  { rcases h with ⟨s, h⟩,
+    exact ⟨s.center, s.radius, h⟩ }
+end
+
+/-- The set of points in a sphere is cospherical. -/
+lemma sphere.cospherical (s : sphere P) : cospherical (s : set P) :=
+cospherical_iff_exists_sphere.2 ⟨s, set.subset.rfl⟩
+
+/-- A subset of a cospherical set is cospherical. -/
+lemma cospherical.subset {ps₁ ps₂ : set P} (hs : ps₁ ⊆ ps₂) (hc : cospherical ps₂) :
+  cospherical ps₁ :=
+begin
+  rcases hc with ⟨c, r, hcr⟩,
+  exact ⟨c, r, λ p hp, hcr p (hs hp)⟩
+end
+
+/-- The empty set is cospherical. -/
+lemma cospherical_empty [nonempty P] : cospherical (∅ : set P) :=
+let ⟨p⟩ := ‹nonempty P› in ⟨p, 0, λ p, false.elim⟩
+
+/-- A single point is cospherical. -/
+lemma cospherical_singleton (p : P) : cospherical ({p} : set P) :=
+begin
+  use p,
+  simp
+end
+
+end metric_space
+
+section normed_space
+variables [normed_add_comm_group V] [normed_space ℝ V] [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- Two points are cospherical. -/
+lemma cospherical_pair (p₁ p₂ : P) : cospherical ({p₁, p₂} : set P) :=
+⟨midpoint ℝ p₁ p₂, ‖(2 : ℝ)‖⁻¹ * dist p₁ p₂, begin
+  rintros p (rfl | rfl | _),
+  { rw [dist_comm, dist_midpoint_left] },
+  { rw [dist_comm, dist_midpoint_right] }
+end⟩
+
+/-- A set of points is concyclic if it is cospherical and coplanar. (Most results are stated
+directly in terms of `cospherical` instead of using `concyclic`.) -/
+structure concyclic (ps : set P) : Prop :=
+(cospherical : cospherical ps)
+(coplanar : coplanar ℝ ps)
+
+/-- A subset of a concyclic set is concyclic. -/
+lemma concyclic.subset {ps₁ ps₂ : set P} (hs : ps₁ ⊆ ps₂) (h : concyclic ps₂) : concyclic ps₁ :=
+⟨h.1.subset hs, h.2.subset hs⟩
+
+/-- The empty set is concyclic. -/
+lemma concyclic_empty : concyclic (∅ : set P) :=
+⟨cospherical_empty, coplanar_empty ℝ P⟩
+
+/-- A single point is concyclic. -/
+lemma concyclic_singleton (p : P) : concyclic ({p} : set P) :=
+⟨cospherical_singleton p, coplanar_singleton ℝ p⟩
+
+/-- Two points are concyclic. -/
+lemma concyclic_pair (p₁ p₂ : P) : concyclic ({p₁, p₂} : set P) :=
+⟨cospherical_pair p₁ p₂, coplanar_pair ℝ p₁ p₂⟩
+
+end normed_space
+
+section euclidean_space
+variables
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- Any three points in a cospherical set are affinely independent. -/
+lemma cospherical.affine_independent {s : set P} (hs : cospherical s) {p : fin 3 → P}
+  (hps : set.range p ⊆ s) (hpi : function.injective p) :
+  affine_independent ℝ p :=
+begin
+  rw affine_independent_iff_not_collinear,
+  intro hc,
+  rw collinear_iff_of_mem (set.mem_range_self (0 : fin 3)) at hc,
+  rcases hc with ⟨v, hv⟩,
+  rw set.forall_range_iff at hv,
+  have hv0 : v ≠ 0,
+  { intro h,
+    have he : p 1 = p 0, by simpa [h] using hv 1,
+    exact (dec_trivial : (1 : fin 3) ≠ 0) (hpi he) },
+  rcases hs with ⟨c, r, hs⟩,
+  have hs' := λ i, hs (p i) (set.mem_of_mem_of_subset (set.mem_range_self _) hps),
+  choose f hf using hv,
+  have hsd : ∀ i, dist ((f i • v) +ᵥ p 0) c = r,
+  { intro i,
+    rw ←hf,
+    exact hs' i },
+  have hf0 : f 0 = 0,
+  { have hf0' := hf 0,
+    rw [eq_comm, ←@vsub_eq_zero_iff_eq V, vadd_vsub, smul_eq_zero] at hf0',
+    simpa [hv0] using hf0' },
+  have hfi : function.injective f,
+  { intros i j h,
+    have hi := hf i,
+    rw [h, ←hf j] at hi,
+    exact hpi hi },
+  simp_rw [←hsd 0, hf0, zero_smul, zero_vadd, dist_smul_vadd_eq_dist (p 0) c hv0] at hsd,
+  have hfn0 : ∀ i, i ≠ 0 → f i ≠ 0 := λ i, (hfi.ne_iff' hf0).2,
+  have hfn0' : ∀ i, i ≠ 0 → f i = (-2) * ⟪v, (p 0 -ᵥ c)⟫ / ⟪v, v⟫,
+  { intros i hi,
+    have hsdi := hsd i,
+    simpa [hfn0, hi] using hsdi },
+  have hf12 : f 1 = f 2, { rw [hfn0' 1 dec_trivial, hfn0' 2 dec_trivial] },
+  exact (dec_trivial : (1 : fin 3) ≠ 2) (hfi hf12)
+end
+
+/-- Any three points in a cospherical set are affinely independent. -/
+lemma cospherical.affine_independent_of_mem_of_ne {s : set P} (hs : cospherical s) {p₁ p₂ p₃ : P}
+  (h₁ : p₁ ∈ s) (h₂ : p₂ ∈ s) (h₃ : p₃ ∈ s) (h₁₂ : p₁ ≠ p₂) (h₁₃ : p₁ ≠ p₃) (h₂₃ : p₂ ≠ p₃) :
+  affine_independent ℝ ![p₁, p₂, p₃] :=
+begin
+  refine hs.affine_independent _ _,
+  { simp [h₁, h₂, h₃, set.insert_subset] },
+  { erw [fin.cons_injective_iff, fin.cons_injective_iff],
+    simp [h₁₂, h₁₃, h₂₃, function.injective] }
+end
+
+/-- The three points of a cospherical set are affinely independent. -/
+lemma cospherical.affine_independent_of_ne {p₁ p₂ p₃ : P} (hs : cospherical ({p₁, p₂, p₃} : set P))
+  (h₁₂ : p₁ ≠ p₂) (h₁₃ : p₁ ≠ p₃) (h₂₃ : p₂ ≠ p₃) :
+  affine_independent ℝ ![p₁, p₂, p₃] :=
+hs.affine_independent_of_mem_of_ne (set.mem_insert _ _)
+  (set.mem_insert_of_mem _ (set.mem_insert _ _))
+  (set.mem_insert_of_mem _ (set.mem_insert_of_mem _ (set.mem_singleton _))) h₁₂ h₁₃ h₂₃
+
+/-- Suppose that `p₁` and `p₂` lie in spheres `s₁` and `s₂`.  Then the vector between the centers
+of those spheres is orthogonal to that between `p₁` and `p₂`; this is a version of
+`inner_vsub_vsub_of_dist_eq_of_dist_eq` for bundled spheres.  (In two dimensions, this says that
+the diagonals of a kite are orthogonal.) -/
+lemma inner_vsub_vsub_of_mem_sphere_of_mem_sphere {p₁ p₂ : P} {s₁ s₂ : sphere P}
+  (hp₁s₁ : p₁ ∈ s₁) (hp₂s₁ : p₂ ∈ s₁) (hp₁s₂ : p₁ ∈ s₂) (hp₂s₂ : p₂ ∈ s₂) :
+  ⟪s₂.center -ᵥ s₁.center, p₂ -ᵥ p₁⟫ = 0 :=
+inner_vsub_vsub_of_dist_eq_of_dist_eq (dist_center_eq_dist_center_of_mem_sphere hp₁s₁ hp₂s₁)
+                                      (dist_center_eq_dist_center_of_mem_sphere hp₁s₂ hp₂s₂)
+
+/-- Two spheres intersect in at most two points in a two-dimensional subspace containing their
+centers; this is a version of `eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two` for bundled
+spheres. -/
+lemma eq_of_mem_sphere_of_mem_sphere_of_mem_of_finrank_eq_two {s : affine_subspace ℝ P}
+  [finite_dimensional ℝ s.direction] (hd : finrank ℝ s.direction = 2) {s₁ s₂ : sphere P}
+  {p₁ p₂ p : P} (hs₁ : s₁.center ∈ s) (hs₂ : s₂.center ∈ s) (hp₁s : p₁ ∈ s) (hp₂s : p₂ ∈ s)
+  (hps : p ∈ s) (hs : s₁ ≠ s₂) (hp : p₁ ≠ p₂) (hp₁s₁ : p₁ ∈ s₁) (hp₂s₁ : p₂ ∈ s₁) (hps₁ : p ∈ s₁)
+  (hp₁s₂ : p₁ ∈ s₂) (hp₂s₂ : p₂ ∈ s₂) (hps₂ : p ∈ s₂) : p = p₁ ∨ p = p₂ :=
+eq_of_dist_eq_of_dist_eq_of_mem_of_finrank_eq_two hd hs₁ hs₂ hp₁s hp₂s hps
+  ((sphere.center_ne_iff_ne_of_mem hps₁ hps₂).2 hs) hp hp₁s₁ hp₂s₁ hps₁ hp₁s₂ hp₂s₂ hps₂
+
+/-- Two spheres intersect in at most two points in two-dimensional space; this is a version of
+`eq_of_dist_eq_of_dist_eq_of_finrank_eq_two` for bundled spheres. -/
+lemma eq_of_mem_sphere_of_mem_sphere_of_finrank_eq_two [finite_dimensional ℝ V]
+  (hd : finrank ℝ V = 2) {s₁ s₂ : sphere P} {p₁ p₂ p : P} (hs : s₁ ≠ s₂) (hp : p₁ ≠ p₂)
+  (hp₁s₁ : p₁ ∈ s₁) (hp₂s₁ : p₂ ∈ s₁) (hps₁ : p ∈ s₁) (hp₁s₂ : p₁ ∈ s₂) (hp₂s₂ : p₂ ∈ s₂)
+  (hps₂ : p ∈ s₂) : p = p₁ ∨ p = p₂ :=
+eq_of_dist_eq_of_dist_eq_of_finrank_eq_two hd ((sphere.center_ne_iff_ne_of_mem hps₁ hps₂).2 hs)
+  hp hp₁s₁ hp₂s₁ hps₁ hp₁s₂ hp₂s₂ hps₂
+
+/-- Given a point on a sphere and a point not outside it, the inner product between the
+difference of those points and the radius vector is positive unless the points are equal. -/
+lemma inner_pos_or_eq_of_dist_le_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : dist p₂ s.center ≤ s.radius) : 0 < ⟪p₁ -ᵥ p₂, p₁ -ᵥ s.center⟫ ∨ p₁ = p₂ :=
+begin
+  by_cases h : p₁ = p₂, { exact or.inr h },
+  refine or.inl _,
+  rw mem_sphere at hp₁,
+  rw [←vsub_sub_vsub_cancel_right p₁ p₂ s.center, inner_sub_left,
+      real_inner_self_eq_norm_mul_norm/-, ←dist_eq_norm_vsub, hp₁-/, sub_pos],
+  refine lt_of_le_of_ne
+    ((real_inner_le_norm _ _).trans (mul_le_mul_of_nonneg_right _ (norm_nonneg _)))
+    _,
+  { rwa [←dist_eq_norm_vsub, ←dist_eq_norm_vsub, hp₁] },
+  { rcases hp₂.lt_or_eq with hp₂' | hp₂',
+    { refine ((real_inner_le_norm _ _).trans_lt (mul_lt_mul_of_pos_right _ _)).ne,
+      { rwa [←hp₁, @dist_eq_norm_vsub V, @dist_eq_norm_vsub V] at hp₂' },
+      { rw [norm_pos_iff, vsub_ne_zero],
+        rintro rfl,
+        rw ←hp₁ at hp₂',
+        refine (dist_nonneg.not_lt : ¬dist p₂ s.center < 0) _,
+        simpa using hp₂' } },
+    { rw [←hp₁, @dist_eq_norm_vsub V, @dist_eq_norm_vsub V] at hp₂',
+      nth_rewrite 0 ←hp₂',
+      rw [ne.def, inner_eq_norm_mul_iff_real, hp₂', ←sub_eq_zero, ←smul_sub,
+          vsub_sub_vsub_cancel_right, ←ne.def, smul_ne_zero_iff, vsub_ne_zero,
+          and_iff_left (ne.symm h), norm_ne_zero_iff, vsub_ne_zero],
+      rintro rfl,
+      refine h (eq.symm _),
+      simpa using hp₂' } }
+end
+
+/-- Given a point on a sphere and a point not outside it, the inner product between the
+difference of those points and the radius vector is nonnegative. -/
+lemma inner_nonneg_of_dist_le_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : dist p₂ s.center ≤ s.radius) : 0 ≤ ⟪p₁ -ᵥ p₂, p₁ -ᵥ s.center⟫ :=
+begin
+  rcases inner_pos_or_eq_of_dist_le_radius hp₁ hp₂ with h | rfl,
+  { exact h.le },
+  { simp }
+end
+
+/-- Given a point on a sphere and a point inside it, the inner product between the difference of
+those points and the radius vector is positive. -/
+lemma inner_pos_of_dist_lt_radius {s : sphere P} {p₁ p₂ : P} (hp₁ : p₁ ∈ s)
+  (hp₂ : dist p₂ s.center < s.radius) : 0 < ⟪p₁ -ᵥ p₂, p₁ -ᵥ s.center⟫ :=
+begin
+  by_cases h : p₁ = p₂,
+  { rw [h, mem_sphere] at hp₁,
+    exact false.elim (hp₂.ne hp₁) },
+  exact (inner_pos_or_eq_of_dist_le_radius hp₁ hp₂.le).resolve_right h
+end
+
+/-- Given three collinear points, two on a sphere and one not outside it, the one not outside it
+is weakly between the other two points. -/
+lemma wbtw_of_collinear_of_dist_center_le_radius {s : sphere P} {p₁ p₂ p₃ : P}
+  (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : p₁ ∈ s) (hp₂ : dist p₂ s.center ≤ s.radius)
+  (hp₃ : p₃ ∈ s) (hp₁p₃ : p₁ ≠ p₃) : wbtw ℝ p₁ p₂ p₃ :=
+h.wbtw_of_dist_eq_of_dist_le hp₁ hp₂ hp₃ hp₁p₃
+
+/-- Given three collinear points, two on a sphere and one inside it, the one inside it is
+strictly between the other two points. -/
+lemma sbtw_of_collinear_of_dist_center_lt_radius {s : sphere P} {p₁ p₂ p₃ : P}
+  (h : collinear ℝ ({p₁, p₂, p₃} : set P)) (hp₁ : p₁ ∈ s) (hp₂ : dist p₂ s.center < s.radius)
+  (hp₃ : p₃ ∈ s) (hp₁p₃ : p₁ ≠ p₃) : sbtw ℝ p₁ p₂ p₃ :=
+h.sbtw_of_dist_eq_of_dist_lt hp₁ hp₂ hp₃ hp₁p₃
+
+end euclidean_space
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/sphere/power.lean b/src/geometry/euclidean/sphere/power.lean
new file mode 100644
index 0000000000000..7807c30705a37
--- /dev/null
+++ b/src/geometry/euclidean/sphere/power.lean
@@ -0,0 +1,143 @@
+/-
+Copyright (c) 2021 Manuel Candales. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Manuel Candales, Benjamin Davidson
+-/
+import geometry.euclidean.angle.unoriented.affine
+import geometry.euclidean.sphere.basic
+
+/-!
+# Power of a point (intersecting chords and secants)
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves basic geometrical results about power of a point (intersecting chords and
+secants) in spheres in real inner product spaces and Euclidean affine spaces.
+
+## Main theorems
+
+* `mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi`: Intersecting Chords Theorem (Freek No. 55).
+* `mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_zero`: Intersecting Secants Theorem.
+-/
+
+open real
+open_locale euclidean_geometry real_inner_product_space real
+
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
+
+namespace inner_product_geometry
+
+/-!
+### Geometrical results on spheres in real inner product spaces
+
+This section develops some results on spheres in real inner product spaces,
+which are used to deduce corresponding results for Euclidean affine spaces.
+-/
+
+lemma mul_norm_eq_abs_sub_sq_norm {x y z : V}
+  (h₁ : ∃ k : ℝ, k ≠ 1 ∧ x + y = k • (x - y)) (h₂ : ‖z - y‖ = ‖z + y‖) :
+  ‖x - y‖ * ‖x + y‖ = |‖z + y‖ ^ 2 - ‖z - x‖ ^ 2| :=
+begin
+  obtain ⟨k, hk_ne_one, hk⟩ := h₁,
+  let r := (k - 1)⁻¹ * (k + 1),
+
+  have hxy : x = r • y,
+  { rw [← smul_smul, eq_inv_smul_iff₀ (sub_ne_zero.mpr hk_ne_one), ← sub_eq_zero],
+    calc  (k - 1) • x - (k + 1) • y
+        = (k • x - x) - (k • y + y) : by simp_rw [sub_smul, add_smul, one_smul]
+    ... = (k • x - k • y) - (x + y) : by simp_rw [← sub_sub, sub_right_comm]
+    ... = k • (x - y) - (x + y)     : by rw ← smul_sub k x y
+    ... = 0                         : sub_eq_zero.mpr hk.symm },
+
+  have hzy : ⟪z, y⟫ = 0,
+    by rwa [inner_eq_zero_iff_angle_eq_pi_div_two, ← norm_add_eq_norm_sub_iff_angle_eq_pi_div_two,
+      eq_comm],
+
+  have hzx : ⟪z, x⟫ = 0 := by rw [hxy, inner_smul_right, hzy, mul_zero],
+
+  calc  ‖x - y‖ * ‖x + y‖
+      = ‖(r - 1) • y‖ * ‖(r + 1) • y‖      : by simp [sub_smul, add_smul, hxy]
+  ... = ‖r - 1‖ * ‖y‖ * (‖r + 1‖ * ‖y‖)      : by simp_rw [norm_smul]
+  ... = ‖r - 1‖ * ‖r + 1‖ * ‖y‖ ^ 2         : by ring
+  ... = |(r - 1) * (r + 1) * ‖y‖ ^ 2| : by simp [abs_mul]
+  ... = |r ^ 2 * ‖y‖ ^ 2 - ‖y‖ ^ 2|    : by ring_nf
+  ... = |‖x‖ ^ 2 - ‖y‖ ^ 2|            : by simp [hxy, norm_smul, mul_pow, sq_abs]
+  ... = |‖z + y‖ ^ 2 - ‖z - x‖ ^ 2|    : by simp [norm_add_sq_real, norm_sub_sq_real,
+                                                    hzy, hzx, abs_sub_comm],
+end
+
+end inner_product_geometry
+
+namespace euclidean_geometry
+
+/-!
+### Geometrical results on spheres in Euclidean affine spaces
+
+This section develops some results on spheres in Euclidean affine spaces.
+-/
+
+open inner_product_geometry
+
+variables {P : Type*} [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- If `P` is a point on the line `AB` and `Q` is equidistant from `A` and `B`, then
+`AP * BP = abs (BQ ^ 2 - PQ ^ 2)`. -/
+lemma mul_dist_eq_abs_sub_sq_dist {a b p q : P}
+  (hp : ∃ k : ℝ, k ≠ 1 ∧ b -ᵥ p = k • (a -ᵥ p)) (hq : dist a q = dist b q) :
+  dist a p * dist b p = |dist b q ^ 2 - dist p q ^ 2| :=
+begin
+  let m : P := midpoint ℝ a b,
+  obtain ⟨v, h1, h2, h3⟩ := ⟨vsub_sub_vsub_cancel_left, v a p m, v p q m, v a q m⟩,
+  have h : ∀ r, b -ᵥ r = (m -ᵥ r) + (m -ᵥ a) :=
+    λ r, by rw [midpoint_vsub_left, ← right_vsub_midpoint, add_comm, vsub_add_vsub_cancel],
+  iterate 4 { rw dist_eq_norm_vsub V },
+  rw [← h1, ← h2, h, h],
+  rw [← h1, h] at hp,
+  rw [dist_eq_norm_vsub V a q, dist_eq_norm_vsub V b q, ← h3, h] at hq,
+  exact mul_norm_eq_abs_sub_sq_norm hp hq,
+end
+
+/-- If `A`, `B`, `C`, `D` are cospherical and `P` is on both lines `AB` and `CD`, then
+`AP * BP = CP * DP`. -/
+lemma mul_dist_eq_mul_dist_of_cospherical {a b c d p : P}
+  (h : cospherical ({a, b, c, d} : set P))
+  (hapb : ∃ k₁ : ℝ, k₁ ≠ 1 ∧ b -ᵥ p = k₁ • (a -ᵥ p))
+  (hcpd : ∃ k₂ : ℝ, k₂ ≠ 1 ∧ d -ᵥ p = k₂ • (c -ᵥ p)) :
+  dist a p * dist b p = dist c p * dist d p :=
+begin
+  obtain ⟨q, r, h'⟩ := (cospherical_def {a, b, c, d}).mp h,
+  obtain ⟨ha, hb, hc, hd⟩ := ⟨h' a _, h' b _, h' c _, h' d _⟩,
+  { rw ← hd at hc,
+    rw ← hb at ha,
+    rw [mul_dist_eq_abs_sub_sq_dist hapb ha, hb, mul_dist_eq_abs_sub_sq_dist hcpd hc, hd] },
+  all_goals { simp },
+end
+
+/-- **Intersecting Chords Theorem**. -/
+theorem mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi {a b c d p : P}
+  (h : cospherical ({a, b, c, d} : set P))
+  (hapb : ∠ a p b = π) (hcpd : ∠ c p d = π) :
+  dist a p * dist b p = dist c p * dist d p :=
+begin
+  obtain ⟨-, k₁, _, hab⟩ := angle_eq_pi_iff.mp hapb,
+  obtain ⟨-, k₂, _, hcd⟩ := angle_eq_pi_iff.mp hcpd,
+  exact mul_dist_eq_mul_dist_of_cospherical h ⟨k₁, (by linarith), hab⟩ ⟨k₂, (by linarith), hcd⟩,
+end
+
+/-- **Intersecting Secants Theorem**. -/
+theorem mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_zero {a b c d p : P}
+  (h : cospherical ({a, b, c, d} : set P))
+  (hab : a ≠ b) (hcd : c ≠ d) (hapb : ∠ a p b = 0) (hcpd : ∠ c p d = 0) :
+  dist a p * dist b p = dist c p * dist d p :=
+begin
+  obtain ⟨-, k₁, -, hab₁⟩ := angle_eq_zero_iff.mp hapb,
+  obtain ⟨-, k₂, -, hcd₁⟩ := angle_eq_zero_iff.mp hcpd,
+  refine mul_dist_eq_mul_dist_of_cospherical h ⟨k₁, _, hab₁⟩ ⟨k₂, _, hcd₁⟩;
+  by_contra hnot;
+  simp only [not_not, *, one_smul] at *,
+  exacts [hab (vsub_left_cancel hab₁).symm, hcd (vsub_left_cancel hcd₁).symm],
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/sphere/ptolemy.lean b/src/geometry/euclidean/sphere/ptolemy.lean
new file mode 100644
index 0000000000000..bb988789b7787
--- /dev/null
+++ b/src/geometry/euclidean/sphere/ptolemy.lean
@@ -0,0 +1,75 @@
+/-
+Copyright (c) 2021 Manuel Candales. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Manuel Candales, Benjamin Davidson
+-/
+import geometry.euclidean.sphere.power
+import geometry.euclidean.triangle
+
+/-!
+# Ptolemy's theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves Ptolemy's theorem on the lengths of the diagonals and sides of a cyclic
+quadrilateral.
+
+## Main theorems
+
+* `mul_dist_add_mul_dist_eq_mul_dist_of_cospherical`: Ptolemy’s Theorem (Freek No. 95).
+
+TODO: The current statement of Ptolemy’s theorem works around the lack of a "cyclic polygon" concept
+in mathlib, which is what the theorem statement would naturally use (or two such concepts, since
+both a strict version, where all vertices must be distinct, and a weak version, where consecutive
+vertices may be equal, would be useful; Ptolemy's theorem should then use the weak one).
+
+An API needs to be built around that concept, which would include:
+- strict cyclic implies weak cyclic,
+- weak cyclic and consecutive points distinct implies strict cyclic,
+- weak/strict cyclic implies weak/strict cyclic for any subsequence,
+- any three points on a sphere are weakly or strictly cyclic according to whether they are distinct,
+- any number of points on a sphere intersected with a two-dimensional affine subspace are cyclic in
+  some order,
+- a list of points is cyclic if and only if its reversal is,
+- a list of points is cyclic if and only if any cyclic permutation is, while other permutations
+  are not when the points are distinct,
+- a point P where the diagonals of a cyclic polygon cross exists (and is unique) with weak/strict
+  betweenness depending on weak/strict cyclicity,
+- four points on a sphere with such a point P are cyclic in the appropriate order,
+and so on.
+-/
+
+open real
+open_locale euclidean_geometry real_inner_product_space real
+
+namespace euclidean_geometry
+
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
+variables {P : Type*} [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- **Ptolemy’s Theorem**. -/
+theorem mul_dist_add_mul_dist_eq_mul_dist_of_cospherical {a b c d p : P}
+  (h : cospherical ({a, b, c, d} : set P))
+  (hapc : ∠ a p c = π) (hbpd : ∠ b p d = π) :
+  dist a b * dist c d + dist b c * dist d a = dist a c * dist b d :=
+begin
+  have h' : cospherical ({a, c, b, d} : set P), { rwa set.insert_comm c b {d} },
+  have hmul := mul_dist_eq_mul_dist_of_cospherical_of_angle_eq_pi h' hapc hbpd,
+  have hbp := left_dist_ne_zero_of_angle_eq_pi hbpd,
+  have h₁ : dist c d = dist c p / dist b p * dist a b,
+  { rw [dist_mul_of_eq_angle_of_dist_mul b p a c p d, dist_comm a b],
+    { rw [angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi hbpd hapc, angle_comm] },
+    all_goals { field_simp [mul_comm, hmul] } },
+  have h₂ : dist d a = dist a p / dist b p * dist b c,
+  { rw [dist_mul_of_eq_angle_of_dist_mul c p b d p a, dist_comm c b],
+    { rwa [angle_comm, angle_eq_angle_of_angle_eq_pi_of_angle_eq_pi], rwa angle_comm },
+    all_goals { field_simp [mul_comm, hmul] } },
+  have h₃ : dist d p = dist a p * dist c p / dist b p, { field_simp [mul_comm, hmul] },
+  have h₄ : ∀ x y : ℝ, x * (y * x) = x * x * y := λ x y, by rw [mul_left_comm, mul_comm],
+  field_simp [h₁, h₂, dist_eq_add_dist_of_angle_eq_pi hbpd, h₃, hbp, dist_comm a b,
+              h₄, ← sq, dist_sq_mul_dist_add_dist_sq_mul_dist b, hapc],
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/sphere/second_inter.lean b/src/geometry/euclidean/sphere/second_inter.lean
new file mode 100644
index 0000000000000..f036d3c70ebdd
--- /dev/null
+++ b/src/geometry/euclidean/sphere/second_inter.lean
@@ -0,0 +1,179 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import geometry.euclidean.sphere.basic
+
+/-!
+# Second intersection of a sphere and a line
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines and proves basic results about the second intersection of a sphere with a line
+through a point on that sphere.
+
+## Main definitions
+
+* `euclidean_geometry.sphere.second_inter` is the second intersection of a sphere with a line
+  through a point on that sphere.
+
+-/
+
+noncomputable theory
+open_locale real_inner_product_space
+
+namespace euclidean_geometry
+
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
+include V
+
+/-- The second intersection of a sphere with a line through a point on that sphere; that point
+if it is the only point of intersection of the line with the sphere. The intended use of this
+definition is when `p ∈ s`; the definition does not use `s.radius`, so in general it returns
+the second intersection with the sphere through `p` and with center `s.center`. -/
+def sphere.second_inter (s : sphere P) (p : P) (v : V) : P :=
+(-2 * ⟪v, p -ᵥ s.center⟫ / ⟪v, v⟫) • v +ᵥ p
+
+/-- The distance between `second_inter` and the center equals the distance between the original
+point and the center. -/
+@[simp] lemma sphere.second_inter_dist (s : sphere P) (p : P) (v : V) :
+  dist (s.second_inter p v) s.center = dist p s.center :=
+begin
+  rw sphere.second_inter,
+  by_cases hv : v = 0, { simp [hv] },
+  rw dist_smul_vadd_eq_dist _ _ hv,
+  exact or.inr rfl
+end
+
+/-- The point given by `second_inter` lies on the sphere. -/
+@[simp] lemma sphere.second_inter_mem {s : sphere P} {p : P} (v : V) :
+  s.second_inter p v ∈ s ↔ p ∈ s :=
+by simp_rw [mem_sphere, sphere.second_inter_dist]
+
+variables (V)
+
+/-- If the vector is zero, `second_inter` gives the original point. -/
+@[simp] lemma sphere.second_inter_zero (s : sphere P) (p : P) :
+  s.second_inter p (0 : V) = p :=
+by simp [sphere.second_inter]
+
+variables {V}
+
+/-- The point given by `second_inter` equals the original point if and only if the line is
+orthogonal to the radius vector. -/
+lemma sphere.second_inter_eq_self_iff {s : sphere P} {p : P} {v : V} :
+  s.second_inter p v = p ↔ ⟪v, p -ᵥ s.center⟫ = 0 :=
+begin
+  refine ⟨λ hp, _, λ hp, _⟩,
+  { by_cases hv : v = 0, { simp [hv] },
+    rwa [sphere.second_inter, eq_comm, eq_vadd_iff_vsub_eq, vsub_self, eq_comm, smul_eq_zero,
+         or_iff_left hv, div_eq_zero_iff, inner_self_eq_zero, or_iff_left hv, mul_eq_zero,
+         or_iff_right (by norm_num : (-2 : ℝ) ≠ 0)] at hp },
+  { rw [sphere.second_inter, hp, mul_zero, zero_div, zero_smul, zero_vadd] }
+end
+
+/-- A point on a line through a point on a sphere equals that point or `second_inter`. -/
+lemma sphere.eq_or_eq_second_inter_of_mem_mk'_span_singleton_iff_mem {s : sphere P} {p : P}
+  (hp : p ∈ s) {v : V} {p' : P} (hp' : p' ∈ affine_subspace.mk' p (ℝ ∙ v)) :
+  (p' = p ∨ p' = s.second_inter p v) ↔ p' ∈ s :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with h | h,
+    { rwa h },
+    { rwa [h, sphere.second_inter_mem] } },
+  { rw [affine_subspace.mem_mk'_iff_vsub_mem, submodule.mem_span_singleton] at hp',
+    rcases hp' with ⟨r, hr⟩,
+    rw [eq_comm, ←eq_vadd_iff_vsub_eq] at hr,
+    subst hr,
+    by_cases hv : v = 0, { simp [hv] },
+    rw sphere.second_inter,
+    rw mem_sphere at h hp,
+    rw [←hp, dist_smul_vadd_eq_dist _ _ hv] at h,
+    rcases h with h | h;
+      simp [h] }
+end
+
+/-- `second_inter` is unchanged by multiplying the vector by a nonzero real. -/
+@[simp] lemma sphere.second_inter_smul (s : sphere P) (p : P) (v : V) {r : ℝ}
+  (hr : r ≠ 0) : s.second_inter p (r • v) = s.second_inter p v :=
+begin
+  simp_rw [sphere.second_inter, real_inner_smul_left, inner_smul_right, smul_smul,
+           div_mul_eq_div_div],
+  rw [mul_comm, ←mul_div_assoc, ←mul_div_assoc, mul_div_cancel_left _ hr, mul_comm, mul_assoc,
+      mul_div_cancel_left _ hr, mul_comm]
+end
+
+/-- `second_inter` is unchanged by negating the vector. -/
+@[simp] lemma sphere.second_inter_neg (s : sphere P) (p : P) (v : V) :
+  s.second_inter p (-v) = s.second_inter p v :=
+by rw [←neg_one_smul ℝ v, s.second_inter_smul p v (by norm_num : (-1 : ℝ) ≠ 0)]
+
+/-- Applying `second_inter` twice returns the original point. -/
+@[simp] lemma sphere.second_inter_second_inter (s : sphere P) (p : P) (v : V) :
+  s.second_inter (s.second_inter p v) v = p :=
+begin
+  by_cases hv : v = 0, { simp [hv] },
+  have hv' : ⟪v, v⟫ ≠ 0 := inner_self_ne_zero.2 hv,
+  simp only [sphere.second_inter, vadd_vsub_assoc, vadd_vadd, inner_add_right, inner_smul_right,
+             div_mul_cancel _ hv'],
+  rw [←@vsub_eq_zero_iff_eq V, vadd_vsub, ←add_smul, ←add_div],
+  convert zero_smul ℝ _,
+  convert zero_div _,
+  ring
+end
+
+/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
+`second_inter`, the result of `second_inter` may be expressed using `line_map`. -/
+lemma sphere.second_inter_eq_line_map (s : sphere P) (p p' : P) :
+  s.second_inter p (p' -ᵥ p) =
+    affine_map.line_map p p' (-2 * ⟪p' -ᵥ p, p -ᵥ s.center⟫ / ⟪p' -ᵥ p, p' -ᵥ p⟫) :=
+rfl
+
+/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
+`second_inter`, the result lies in the span of the two points. -/
+lemma sphere.second_inter_vsub_mem_affine_span (s : sphere P) (p₁ p₂ : P) :
+  s.second_inter p₁ (p₂ -ᵥ p₁) ∈ line[ℝ, p₁, p₂] :=
+smul_vsub_vadd_mem_affine_span_pair _ _ _
+
+/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
+`second_inter`, the three points are collinear. -/
+lemma sphere.second_inter_collinear (s : sphere P) (p p' : P) :
+  collinear ℝ ({p, p', s.second_inter p (p' -ᵥ p)} : set P) :=
+begin
+  rw [set.pair_comm, set.insert_comm],
+  exact (collinear_insert_iff_of_mem_affine_span (s.second_inter_vsub_mem_affine_span _ _)).2
+    (collinear_pair ℝ _ _)
+end
+
+/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
+`second_inter`, and the second point is not outside the sphere, the second point is weakly
+between the first point and the result of `second_inter`. -/
+lemma sphere.wbtw_second_inter {s : sphere P} {p p' : P} (hp : p ∈ s)
+  (hp' : dist p' s.center ≤ s.radius) : wbtw ℝ p p' (s.second_inter p (p' -ᵥ p)) :=
+begin
+  by_cases h : p' = p, { simp [h] },
+  refine wbtw_of_collinear_of_dist_center_le_radius (s.second_inter_collinear p p')
+    hp hp' ((sphere.second_inter_mem _).2 hp) _,
+  intro he,
+  rw [eq_comm, sphere.second_inter_eq_self_iff, ←neg_neg (p' -ᵥ p), inner_neg_left,
+      neg_vsub_eq_vsub_rev, neg_eq_zero, eq_comm] at he,
+  exact ((inner_pos_or_eq_of_dist_le_radius hp hp').resolve_right (ne.symm h)).ne he
+end
+
+/-- If the vector passed to `second_inter` is given by a subtraction involving the point in
+`second_inter`, and the second point is inside the sphere, the second point is strictly between
+the first point and the result of `second_inter`. -/
+lemma sphere.sbtw_second_inter {s : sphere P} {p p' : P} (hp : p ∈ s)
+  (hp' : dist p' s.center < s.radius) : sbtw ℝ p p' (s.second_inter p (p' -ᵥ p)) :=
+begin
+  refine ⟨sphere.wbtw_second_inter hp hp'.le, _, _⟩,
+  { rintro rfl, rw mem_sphere at hp, simpa [hp] using hp' },
+  { rintro h,
+    rw [h, mem_sphere.1 ((sphere.second_inter_mem _).2 hp)] at hp',
+    exact lt_irrefl _ hp' }
+end
+
+end euclidean_geometry
diff --git a/src/geometry/euclidean/triangle.lean b/src/geometry/euclidean/triangle.lean
index 588e38eff54f4..315ab548f31e4 100644
--- a/src/geometry/euclidean/triangle.lean
+++ b/src/geometry/euclidean/triangle.lean
@@ -3,12 +3,16 @@ Copyright (c) 2020 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers, Manuel Candales
 -/
-import geometry.euclidean.basic
+import geometry.euclidean.angle.oriented.affine
+import geometry.euclidean.angle.unoriented.affine
 import tactic.interval_cases
 
 /-!
 # Triangles
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves basic geometrical results about distances and angles
 in (possibly degenerate) triangles in real inner product spaces and
 Euclidean affine spaces.  More specialized results, and results
@@ -26,7 +30,6 @@ unnecessarily.
 
 ## References
 
-* https://en.wikipedia.org/wiki/Pythagorean_theorem
 * https://en.wikipedia.org/wiki/Law_of_cosines
 * https://en.wikipedia.org/wiki/Pons_asinorum
 * https://en.wikipedia.org/wiki/Sum_of_angles_of_a_triangle
@@ -50,46 +53,20 @@ most conveniently be developed in terms of vectors and then used to
 deduce corresponding results for Euclidean affine spaces.
 -/
 
-variables {V : Type*} [inner_product_space ℝ V]
-
-/-- Pythagorean theorem, if-and-only-if vector angle form. -/
-lemma norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
-  ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ ↔ angle x y = π / 2 :=
-begin
-  rw norm_add_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
-  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
-end
-
-/-- Pythagorean theorem, vector angle form. -/
-lemma norm_add_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
-  ∥x + y∥ * ∥x + y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ :=
-(norm_add_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h
-
-/-- Pythagorean theorem, subtracting vectors, if-and-only-if vector angle form. -/
-lemma norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two (x y : V) :
-  ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ ↔ angle x y = π / 2 :=
-begin
-  rw norm_sub_sq_eq_norm_sq_add_norm_sq_iff_real_inner_eq_zero,
-  exact inner_eq_zero_iff_angle_eq_pi_div_two x y
-end
-
-/-- Pythagorean theorem, subtracting vectors, vector angle form. -/
-lemma norm_sub_sq_eq_norm_sq_add_norm_sq' (x y : V) (h : angle x y = π / 2) :
-  ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ :=
-(norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two x y).2 h
+variables {V : Type*} [normed_add_comm_group V] [inner_product_space ℝ V]
 
 /-- Law of cosines (cosine rule), vector angle form. -/
 lemma norm_sub_sq_eq_norm_sq_add_norm_sq_sub_two_mul_norm_mul_norm_mul_cos_angle
     (x y : V) :
-  ∥x - y∥ * ∥x - y∥ = ∥x∥ * ∥x∥ + ∥y∥ * ∥y∥ - 2 * ∥x∥ * ∥y∥ * real.cos (angle x y) :=
-by rw [(show 2 * ∥x∥ * ∥y∥ * real.cos (angle x y) =
-             2 * (real.cos (angle x y) * (∥x∥ * ∥y∥)), by ring),
+  ‖x - y‖ * ‖x - y‖ = ‖x‖ * ‖x‖ + ‖y‖ * ‖y‖ - 2 * ‖x‖ * ‖y‖ * real.cos (angle x y) :=
+by rw [(show 2 * ‖x‖ * ‖y‖ * real.cos (angle x y) =
+             2 * (real.cos (angle x y) * (‖x‖ * ‖y‖)), by ring),
        cos_angle_mul_norm_mul_norm, ←real_inner_self_eq_norm_mul_norm,
        ←real_inner_self_eq_norm_mul_norm, ←real_inner_self_eq_norm_mul_norm,
        real_inner_sub_sub_self, sub_add_eq_add_sub]
 
 /-- Pons asinorum, vector angle form. -/
-lemma angle_sub_eq_angle_sub_rev_of_norm_eq {x y : V} (h : ∥x∥ = ∥y∥) :
+lemma angle_sub_eq_angle_sub_rev_of_norm_eq {x y : V} (h : ‖x‖ = ‖y‖) :
   angle x (x - y) = angle y (y - x) :=
 begin
   refine real.inj_on_cos ⟨angle_nonneg _ _, angle_le_pi _ _⟩ ⟨angle_nonneg _ _, angle_le_pi _ _⟩ _,
@@ -100,15 +77,15 @@ end
 
 /-- Converse of pons asinorum, vector angle form. -/
 lemma norm_eq_of_angle_sub_eq_angle_sub_rev_of_angle_ne_pi {x y : V}
-    (h : angle x (x - y) = angle y (y - x)) (hpi : angle x y ≠ π) : ∥x∥ = ∥y∥ :=
+    (h : angle x (x - y) = angle y (y - x)) (hpi : angle x y ≠ π) : ‖x‖ = ‖y‖ :=
 begin
   replace h := real.arccos_inj_on
     (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x (x - y)))
     (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one y (y - x))) h,
   by_cases hxy : x = y,
   { rw hxy },
-  { rw [←norm_neg (y - x), neg_sub, mul_comm, mul_comm ∥y∥, div_eq_mul_inv, div_eq_mul_inv,
-        mul_inv_rev₀, mul_inv_rev₀, ←mul_assoc, ←mul_assoc] at h,
+  { rw [←norm_neg (y - x), neg_sub, mul_comm, mul_comm ‖y‖, div_eq_mul_inv, div_eq_mul_inv,
+        mul_inv_rev, mul_inv_rev, ←mul_assoc, ←mul_assoc] at h,
     replace h :=
       mul_right_cancel₀ (inv_ne_zero (λ hz, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 hz)))) h,
     rw [inner_sub_right, inner_sub_right, real_inner_comm x y, real_inner_self_eq_norm_mul_norm,
@@ -139,23 +116,23 @@ begin
   { rw [hxy, angle_self hy],
     simp },
   { rw [real.cos_add, cos_angle, cos_angle, cos_angle],
-    have hxn : ∥x∥ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
-    have hyn : ∥y∥ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
-    have hxyn : ∥x - y∥ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
+    have hxn : ‖x‖ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
+    have hyn : ‖y‖ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
+    have hxyn : ‖x - y‖ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
     apply mul_right_cancel₀ hxn,
     apply mul_right_cancel₀ hyn,
     apply mul_right_cancel₀ hxyn,
     apply mul_right_cancel₀ hxyn,
     have H1 : real.sin (angle x (x - y)) * real.sin (angle y (y - x)) *
-                ∥x∥ * ∥y∥ * ∥x - y∥ * ∥x - y∥ =
-              (real.sin (angle x (x - y)) * (∥x∥ * ∥x - y∥)) *
-                (real.sin (angle y (y - x)) * (∥y∥ * ∥x - y∥)), { ring },
-    have H2 : ⟪x, x⟫ * (inner x x - inner x y - (inner x y - inner y y)) -
-                (inner x x - inner x y) * (inner x x - inner x y) =
-              inner x x * inner y y - inner x y * inner x y, { ring },
-    have H3 : ⟪y, y⟫ * (inner y y - inner x y - (inner x y - inner x x)) -
-                (inner y y - inner x y) * (inner y y - inner x y) =
-              inner x x * inner y y - inner x y * inner x y, { ring },
+                ‖x‖ * ‖y‖ * ‖x - y‖ * ‖x - y‖ =
+              (real.sin (angle x (x - y)) * (‖x‖ * ‖x - y‖)) *
+                (real.sin (angle y (y - x)) * (‖y‖ * ‖x - y‖)), { ring },
+    have H2 : ⟪x, x⟫ * (⟪x, x⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪y, y⟫)) -
+                (⟪x, x⟫ - ⟪x, y⟫) * (⟪x, x⟫ - ⟪x, y⟫) =
+              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
+    have H3 : ⟪y, y⟫ * (⟪y, y⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪x, x⟫)) -
+                (⟪y, y⟫ - ⟪x, y⟫) * (⟪y, y⟫ - ⟪x, y⟫) =
+              ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
     rw [mul_sub_right_distrib, mul_sub_right_distrib, mul_sub_right_distrib,
         mul_sub_right_distrib, H1, sin_angle_mul_norm_mul_norm, norm_sub_rev x y,
         sin_angle_mul_norm_mul_norm, norm_sub_rev y x, inner_sub_left, inner_sub_left,
@@ -176,19 +153,19 @@ begin
   { rw [hxy, angle_self hy],
     simp },
   { rw [real.sin_add, cos_angle, cos_angle],
-    have hxn : ∥x∥ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
-    have hyn : ∥y∥ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
-    have hxyn : ∥x - y∥ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
+    have hxn : ‖x‖ ≠ 0 := (λ h, hx (norm_eq_zero.1 h)),
+    have hyn : ‖y‖ ≠ 0 := (λ h, hy (norm_eq_zero.1 h)),
+    have hxyn : ‖x - y‖ ≠ 0 := (λ h, hxy (eq_of_sub_eq_zero (norm_eq_zero.1 h))),
     apply mul_right_cancel₀ hxn,
     apply mul_right_cancel₀ hyn,
     apply mul_right_cancel₀ hxyn,
     apply mul_right_cancel₀ hxyn,
-    have H1 : real.sin (angle x (x - y)) * (⟪y, y - x⟫ / (∥y∥ * ∥y - x∥)) * ∥x∥ * ∥y∥ * ∥x - y∥ =
-                real.sin (angle x (x - y)) * (∥x∥ * ∥x - y∥) *
-                  (⟪y, y - x⟫ / (∥y∥ * ∥y - x∥)) * ∥y∥, { ring },
-    have H2 : ⟪x, x - y⟫ / (∥x∥ * ∥y - x∥) * real.sin (angle y (y - x)) * ∥x∥ * ∥y∥ * ∥y - x∥ =
-                ⟪x, x - y⟫ / (∥x∥ * ∥y - x∥) *
-                  (real.sin (angle y (y - x)) * (∥y∥ * ∥y - x∥)) * ∥x∥, { ring },
+    have H1 : real.sin (angle x (x - y)) * (⟪y, y - x⟫ / (‖y‖ * ‖y - x‖)) * ‖x‖ * ‖y‖ * ‖x - y‖ =
+                real.sin (angle x (x - y)) * (‖x‖ * ‖x - y‖) *
+                  (⟪y, y - x⟫ / (‖y‖ * ‖y - x‖)) * ‖y‖, { ring },
+    have H2 : ⟪x, x - y⟫ / (‖x‖ * ‖y - x‖) * real.sin (angle y (y - x)) * ‖x‖ * ‖y‖ * ‖y - x‖ =
+                ⟪x, x - y⟫ / (‖x‖ * ‖y - x‖) *
+                  (real.sin (angle y (y - x)) * (‖y‖ * ‖y - x‖)) * ‖x‖, { ring },
     have H3 : ⟪x, x⟫ * (⟪x, x⟫ - ⟪x, y⟫ - (⟪x, y⟫ - ⟪y, y⟫)) -
                 (⟪x, x⟫ - ⟪x, y⟫) * (⟪x, x⟫ - ⟪x, y⟫) =
               ⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫, { ring },
@@ -288,19 +265,10 @@ open inner_product_geometry
 
 open_locale euclidean_geometry
 
-variables {V : Type*} {P : Type*} [inner_product_space ℝ V] [metric_space P]
-    [normed_add_torsor V P]
+variables {V : Type*} {P : Type*}
+  [normed_add_comm_group V] [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P]
 include V
 
-/-- **Pythagorean theorem**, if-and-only-if angle-at-point form. -/
-lemma dist_sq_eq_dist_sq_add_dist_sq_iff_angle_eq_pi_div_two (p1 p2 p3 : P) :
-  dist p1 p3 * dist p1 p3 = dist p1 p2 * dist p1 p2 + dist p3 p2 * dist p3 p2 ↔
-    ∠ p1 p2 p3 = π / 2 :=
-by erw [pseudo_metric_space.dist_comm p3 p2, dist_eq_norm_vsub V p1 p3, dist_eq_norm_vsub V p1 p2,
-        dist_eq_norm_vsub V p2 p3,
-        ←norm_sub_sq_eq_norm_sq_add_norm_sq_iff_angle_eq_pi_div_two,
-        vsub_sub_vsub_cancel_right p1, ←neg_vsub_eq_vsub_rev p2 p3, norm_neg]
-
 /-- **Law of cosines** (cosine rule), angle-at-point form. -/
 lemma dist_sq_eq_dist_sq_add_dist_sq_sub_two_mul_dist_mul_dist_mul_cos_angle
     (p1 p2 p3 : P) :
@@ -354,6 +322,15 @@ begin
                                                 (λ he, h2 (vsub_eq_zero_iff_eq.1 he))
 end
 
+/-- The **sum of the angles of a triangle** (possibly degenerate, where the triangle is a line),
+oriented angles at point. -/
+lemma oangle_add_oangle_add_oangle_eq_pi
+  [module.oriented ℝ V (fin 2)] [fact (finite_dimensional.finrank ℝ V = 2)] {p1 p2 p3 : P}
+  (h21 : p2 ≠ p1) (h32 : p3 ≠ p2) (h13 : p1 ≠ p3) : ∡ p1 p2 p3 + ∡ p2 p3 p1 + ∡ p3 p1 p2 = π :=
+by simpa only [neg_vsub_eq_vsub_rev] using
+    positive_orientation.oangle_add_cyc3_neg_left
+      (vsub_ne_zero.mpr h21) (vsub_ne_zero.mpr h32) (vsub_ne_zero.mpr h13)
+
 /-- **Stewart's Theorem**. -/
 theorem dist_sq_mul_dist_add_dist_sq_mul_dist (a b c p : P) (h : ∠ b p c = π) :
   dist a b ^ 2 * dist c p + dist a c ^ 2 * dist b p =
@@ -397,7 +374,7 @@ begin
   { have hab'₁ : a' = b', { rw [← dist_eq_zero, hab, dist_eq_zero.mpr hab₁, mul_zero r] },
     rw [hab₁, hab'₁, dist_comm b' c', dist_comm b c, hcb] },
   { have h1 : 0 ≤ r * dist a b, { rw ← hab, exact dist_nonneg },
-    have h2 : 0 ≤ r := nonneg_of_mul_nonneg_right h1 (dist_pos.mpr hab₁),
+    have h2 : 0 ≤ r := nonneg_of_mul_nonneg_left h1 (dist_pos.mpr hab₁),
     exact (sq_eq_sq dist_nonneg (mul_nonneg h2 dist_nonneg)).mp h' },
 end
 
diff --git a/src/geometry/manifold/algebra/left_invariant_derivation.lean b/src/geometry/manifold/algebra/left_invariant_derivation.lean
index 2260510c10028..eb5dd7aff2692 100644
--- a/src/geometry/manifold/algebra/left_invariant_derivation.lean
+++ b/src/geometry/manifold/algebra/left_invariant_derivation.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Nicolò Cavalleri
 -/
 
+import ring_theory.derivation.lie
 import geometry.manifold.derivation_bundle
 
 /-!
 
 # Left invariant derivations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the concept of left invariant derivation for a Lie group. The concept is
 analogous to the more classical concept of left invariant vector fields, and it holds that the
 derivation associated to a vector field is left invariant iff the field is.
@@ -23,8 +27,8 @@ noncomputable theory
 
 open_locale lie_group manifold derivation
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
 (G : Type*) [topological_space G] [charted_space H G] [monoid G] [has_smooth_mul I G] (g h : G)
 
@@ -112,20 +116,17 @@ instance : has_sub (left_invariant_derivation I G) :=
 @[simp, norm_cast] lemma lift_zero :
   (↑(0 : left_invariant_derivation I G) : derivation 𝕜 C^∞⟮I, G; 𝕜⟯ C^∞⟮I, G; 𝕜⟯) = 0 := rfl
 
-instance has_nat_scalar : has_scalar ℕ (left_invariant_derivation I G) :=
-{ smul := λ r X, ⟨r • X, λ g, by simp only [derivation.smul_apply, smul_eq_mul,
-            mul_eq_mul_left_iff, linear_map.map_smul_of_tower, left_invariant']⟩ }
+instance has_nat_scalar : has_smul ℕ (left_invariant_derivation I G) :=
+{ smul := λ r X, ⟨r • X, λ g, by simp_rw [linear_map.map_smul_of_tower, left_invariant']⟩ }
 
-instance has_int_scalar : has_scalar ℤ (left_invariant_derivation I G) :=
-{ smul := λ r X, ⟨r • X, λ g, by simp only [derivation.smul_apply, smul_eq_mul,
-            mul_eq_mul_left_iff, linear_map.map_smul_of_tower, left_invariant']⟩ }
+instance has_int_scalar : has_smul ℤ (left_invariant_derivation I G) :=
+{ smul := λ r X, ⟨r • X, λ g, by simp_rw [linear_map.map_smul_of_tower, left_invariant']⟩ }
 
 instance : add_comm_group (left_invariant_derivation I G) :=
 coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)
 
-instance : has_scalar 𝕜 (left_invariant_derivation I G) :=
-{ smul := λ r X, ⟨r • X, λ g, by simp only [derivation.smul_apply, smul_eq_mul,
-            mul_eq_mul_left_iff, linear_map.map_smul, left_invariant']⟩ }
+instance : has_smul 𝕜 (left_invariant_derivation I G) :=
+{ smul := λ r X, ⟨r • X, λ g, by simp_rw [linear_map.map_smul, left_invariant']⟩ }
 
 variables (r X)
 
diff --git a/src/geometry/manifold/algebra/lie_group.lean b/src/geometry/manifold/algebra/lie_group.lean
index f9a3408b9f97e..90009628761f9 100644
--- a/src/geometry/manifold/algebra/lie_group.lean
+++ b/src/geometry/manifold/algebra/lie_group.lean
@@ -9,6 +9,9 @@ import geometry.manifold.algebra.monoid
 /-!
 # Lie groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A Lie group is a group that is also a smooth manifold, in which the group operations of
 multiplication and inversion are smooth maps. Smoothness of the group multiplication means that
 multiplication is a smooth mapping of the product manifold `G` × `G` into `G`.
@@ -22,7 +25,7 @@ groups here are not necessarily finite dimensional.
 * `lie_add_group I G` : a Lie additive group where `G` is a manifold on the model with corners `I`.
 * `lie_group I G`     : a Lie multiplicative group where `G` is a manifold on the model with
                         corners `I`.
-* `normed_space_lie_add_group` : a normed vector space over a nondiscrete normed field
+* `normed_space_lie_add_group` : a normed vector space over a nontrivially normed field
                                  is an additive Lie group.
 
 ## Implementation notes
@@ -44,9 +47,9 @@ open_locale manifold
 the addition and negation operations are smooth. -/
 -- See note [Design choices about smooth algebraic structures]
 @[ancestor has_smooth_add]
-class lie_add_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+class lie_add_group {𝕜 : Type*} [nontrivially_normed_field 𝕜]
   {H : Type*} [topological_space H]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
   (G : Type*) [add_group G] [topological_space G] [charted_space H G]
   extends has_smooth_add I G : Prop :=
 (smooth_neg : smooth I I (λ a:G, -a))
@@ -55,26 +58,26 @@ class lie_add_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
 the multiplication and inverse operations are smooth. -/
 -- See note [Design choices about smooth algebraic structures]
 @[ancestor has_smooth_mul, to_additive]
-class lie_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+class lie_group {𝕜 : Type*} [nontrivially_normed_field 𝕜]
   {H : Type*} [topological_space H]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
   (G : Type*) [group G] [topological_space G] [charted_space H G]
   extends has_smooth_mul I G : Prop :=
 (smooth_inv : smooth I I (λ a:G, a⁻¹))
 
 section lie_group
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
 {H : Type*} [topological_space H]
-{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
-{F : Type*} [normed_group F] [normed_space 𝕜 F] {J : model_with_corners 𝕜 F F}
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
+{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F] {J : model_with_corners 𝕜 F F}
 {G : Type*} [topological_space G] [charted_space H G] [group G] [lie_group I G]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {M : Type*} [topological_space M] [charted_space H' M]
-{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
 {H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
-{M' : Type*} [topological_space M'] [charted_space H'' M']
+{M' : Type*} [topological_space M'] [charted_space H'' M'] {n : ℕ∞}
 
 section
 
@@ -96,24 +99,90 @@ lemma topological_group_of_lie_group : topological_group G :=
 end
 
 @[to_additive]
-lemma smooth.inv {f : M → G}
-  (hf : smooth I' I f) : smooth I' I (λx, (f x)⁻¹) :=
-(smooth_inv I).comp hf
+lemma cont_mdiff_within_at.inv {f : M → G} {s : set M} {x₀ : M}
+  (hf : cont_mdiff_within_at I' I n f s x₀) : cont_mdiff_within_at I' I n (λx, (f x)⁻¹) s x₀ :=
+((smooth_inv I).of_le le_top).cont_mdiff_at.cont_mdiff_within_at.comp x₀ hf $ set.maps_to_univ _ _
+
+@[to_additive]
+lemma cont_mdiff_at.inv {f : M → G} {x₀ : M}
+  (hf : cont_mdiff_at I' I n f x₀) : cont_mdiff_at I' I n (λx, (f x)⁻¹) x₀ :=
+((smooth_inv I).of_le le_top).cont_mdiff_at.comp x₀ hf
+
+@[to_additive]
+lemma cont_mdiff_on.inv {f : M → G} {s : set M}
+  (hf : cont_mdiff_on I' I n f s) : cont_mdiff_on I' I n (λx, (f x)⁻¹) s :=
+λ x hx, (hf x hx).inv
+
+@[to_additive]
+lemma cont_mdiff.inv {f : M → G}
+  (hf : cont_mdiff I' I n f) : cont_mdiff I' I n (λx, (f x)⁻¹) :=
+λ x, (hf x).inv
+
+@[to_additive]
+lemma smooth_within_at.inv {f : M → G} {s : set M} {x₀ : M}
+  (hf : smooth_within_at I' I f s x₀) : smooth_within_at I' I (λx, (f x)⁻¹) s x₀ :=
+hf.inv
+
+@[to_additive]
+lemma smooth_at.inv {f : M → G} {x₀ : M}
+  (hf : smooth_at I' I f x₀) : smooth_at I' I (λx, (f x)⁻¹) x₀ :=
+hf.inv
 
 @[to_additive]
 lemma smooth_on.inv {f : M → G} {s : set M}
   (hf : smooth_on I' I f s) : smooth_on I' I (λx, (f x)⁻¹) s :=
-(smooth_inv I).comp_smooth_on hf
+hf.inv
 
 @[to_additive]
-lemma smooth.div {f g : M → G}
-  (hf : smooth I' I f) (hg : smooth I' I g) : smooth I' I (f / g) :=
-by { rw div_eq_mul_inv, exact ((smooth_mul I).comp (hf.prod_mk hg.inv) : _), }
+lemma smooth.inv {f : M → G}
+  (hf : smooth I' I f) : smooth I' I (λx, (f x)⁻¹) :=
+hf.inv
+
+@[to_additive]
+lemma cont_mdiff_within_at.div {f g : M → G} {s : set M} {x₀ : M}
+  (hf : cont_mdiff_within_at I' I n f s x₀) (hg : cont_mdiff_within_at I' I n g s x₀) :
+  cont_mdiff_within_at I' I n (λ x, f x / g x) s x₀ :=
+by { simp_rw div_eq_mul_inv, exact hf.mul hg.inv }
+
+@[to_additive]
+lemma cont_mdiff_at.div {f g : M → G} {x₀ : M}
+  (hf : cont_mdiff_at I' I n f x₀) (hg : cont_mdiff_at I' I n g x₀) :
+  cont_mdiff_at I' I n (λ x, f x / g x) x₀ :=
+by { simp_rw div_eq_mul_inv, exact hf.mul hg.inv }
+
+@[to_additive]
+lemma cont_mdiff_on.div {f g : M → G} {s : set M}
+  (hf : cont_mdiff_on I' I n f s) (hg : cont_mdiff_on I' I n g s) :
+  cont_mdiff_on I' I n (λ x, f x / g x) s :=
+by { simp_rw div_eq_mul_inv, exact hf.mul hg.inv }
+
+@[to_additive]
+lemma cont_mdiff.div {f g : M → G}
+  (hf : cont_mdiff I' I n f) (hg : cont_mdiff I' I n g) :
+  cont_mdiff I' I n (λ x, f x / g x) :=
+by { simp_rw div_eq_mul_inv, exact hf.mul hg.inv }
+
+@[to_additive]
+lemma smooth_within_at.div {f g : M → G} {s : set M} {x₀ : M}
+  (hf : smooth_within_at I' I f s x₀) (hg : smooth_within_at I' I g s x₀) :
+  smooth_within_at I' I (λ x, f x / g x) s x₀ :=
+hf.div hg
+
+@[to_additive]
+lemma smooth_at.div {f g : M → G} {x₀ : M}
+  (hf : smooth_at I' I f x₀) (hg : smooth_at I' I g x₀) :
+  smooth_at I' I (λ x, f x / g x) x₀ :=
+hf.div hg
 
 @[to_additive]
 lemma smooth_on.div {f g : M → G} {s : set M}
   (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) : smooth_on I' I (f / g) s :=
-by { rw div_eq_mul_inv, exact ((smooth_mul I).comp_smooth_on (hf.prod_mk hg.inv) : _), }
+hf.div hg
+
+@[to_additive]
+lemma smooth.div {f g : M → G}
+  (hf : smooth I' I f) (hg : smooth I' I g) : smooth I' I (f / g) :=
+hf.div hg
 
 end lie_group
 
@@ -121,10 +190,10 @@ section prod_lie_group
 
 /- Instance of product group -/
 @[to_additive]
-instance {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {H : Type*} [topological_space H]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]  {I : model_with_corners 𝕜 E H}
+instance {𝕜 : Type*} [nontrivially_normed_field 𝕜] {H : Type*} [topological_space H]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]  {I : model_with_corners 𝕜 E H}
   {G : Type*} [topological_space G] [charted_space H G] [group G] [lie_group I G]
-  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+  {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
   {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
   {G' : Type*} [topological_space G'] [charted_space H' G']
   [group G'] [lie_group I' G'] :
@@ -136,8 +205,8 @@ end prod_lie_group
 
 /-! ### Normed spaces are Lie groups -/
 
-instance normed_space_lie_add_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] :
+instance normed_space_lie_add_group {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] :
   lie_add_group (𝓘(𝕜, E)) E :=
 { smooth_add := smooth_iff.2 ⟨continuous_add, λ x y, cont_diff_add.cont_diff_on⟩,
   smooth_neg := smooth_iff.2 ⟨continuous_neg, λ x y, cont_diff_neg.cont_diff_on⟩,
diff --git a/src/geometry/manifold/algebra/monoid.lean b/src/geometry/manifold/algebra/monoid.lean
index d420bbfdded3a..3c2be5411253f 100644
--- a/src/geometry/manifold/algebra/monoid.lean
+++ b/src/geometry/manifold/algebra/monoid.lean
@@ -8,6 +8,9 @@ import geometry.manifold.cont_mdiff_map
 
 /-!
 # Smooth monoid
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 A smooth monoid is a monoid that is also a smooth manifold, in which multiplication is a smooth map
 of the product manifold `G` × `G` into `G`.
 
@@ -42,9 +45,9 @@ semigroup. A smooth additive monoid over `α`, for example, is obtained by requi
 instances `add_monoid α` and `has_smooth_add α`. -/
 -- See note [Design choices about smooth algebraic structures]
 @[ancestor smooth_manifold_with_corners]
-class has_smooth_add {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+class has_smooth_add {𝕜 : Type*} [nontrivially_normed_field 𝕜]
   {H : Type*} [topological_space H]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
   (G : Type*) [has_add G] [topological_space G] [charted_space H G]
   extends smooth_manifold_with_corners I G : Prop :=
 (smooth_add : smooth (I.prod I) I (λ p : G×G, p.1 + p.2))
@@ -54,20 +57,20 @@ A smooth monoid over `G`, for example, is obtained by requiring both the instanc
 and `has_smooth_mul I G`. -/
 -- See note [Design choices about smooth algebraic structures]
 @[ancestor smooth_manifold_with_corners, to_additive]
-class has_smooth_mul {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+class has_smooth_mul {𝕜 : Type*} [nontrivially_normed_field 𝕜]
   {H : Type*} [topological_space H]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
   (G : Type*) [has_mul G] [topological_space G] [charted_space H G]
   extends smooth_manifold_with_corners I G : Prop :=
 (smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2))
 
 section has_smooth_mul
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
 {H : Type*} [topological_space H]
-{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
 {G : Type*} [has_mul G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {M : Type*} [topological_space M] [charted_space H' M]
 
@@ -89,10 +92,49 @@ lemma has_continuous_mul_of_smooth : has_continuous_mul G :=
 
 end
 
+section
+
+variables {f g : M → G} {s : set M} {x : M} {n : ℕ∞}
+
 @[to_additive]
-lemma smooth.mul {f : M → G} {g : M → G} (hf : smooth I' I f) (hg : smooth I' I g) :
+lemma cont_mdiff_within_at.mul (hf : cont_mdiff_within_at I' I n f s x)
+  (hg : cont_mdiff_within_at I' I n g s x) : cont_mdiff_within_at I' I n (f * g) s x :=
+((smooth_mul I).smooth_at.of_le le_top).comp_cont_mdiff_within_at x (hf.prod_mk hg)
+
+@[to_additive]
+lemma cont_mdiff_at.mul (hf : cont_mdiff_at I' I n f x) (hg : cont_mdiff_at I' I n g x) :
+  cont_mdiff_at I' I n (f * g) x :=
+hf.mul hg
+
+@[to_additive]
+lemma cont_mdiff_on.mul (hf : cont_mdiff_on I' I n f s) (hg : cont_mdiff_on I' I n g s) :
+  cont_mdiff_on I' I n (f * g) s :=
+λ x hx, (hf x hx).mul (hg x hx)
+
+@[to_additive]
+lemma cont_mdiff.mul (hf : cont_mdiff I' I n f) (hg : cont_mdiff I' I n g) :
+  cont_mdiff I' I n (f * g) :=
+λ x, (hf x).mul (hg x)
+
+@[to_additive]
+lemma smooth_within_at.mul (hf : smooth_within_at I' I f s x)
+  (hg : smooth_within_at I' I g s x) : smooth_within_at I' I (f * g) s x :=
+hf.mul hg
+
+@[to_additive]
+lemma smooth_at.mul (hf : smooth_at I' I f x) (hg : smooth_at I' I g x) :
+  smooth_at I' I (f * g) x :=
+hf.mul hg
+
+@[to_additive]
+lemma smooth_on.mul (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) :
+  smooth_on I' I (f * g) s :=
+hf.mul hg
+
+@[to_additive]
+lemma smooth.mul (hf : smooth I' I f) (hg : smooth I' I g) :
   smooth I' I (f * g) :=
-(smooth_mul I).comp (hf.prod_mk hg)
+hf.mul hg
 
 @[to_additive]
 lemma smooth_mul_left {a : G} : smooth I I (λ b : G, a * b) :=
@@ -102,11 +144,7 @@ smooth_const.mul smooth_id
 lemma smooth_mul_right {a : G} : smooth I I (λ b : G, b * a) :=
 smooth_id.mul smooth_const
 
-@[to_additive]
-lemma smooth_on.mul {f : M → G} {g : M → G} {s : set M}
-  (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) :
-  smooth_on I' I (f * g) s :=
-((smooth_mul I).comp_smooth_on (hf.prod_mk hg) : _)
+end
 
 variables (I) (g h : G)
 
@@ -121,10 +159,10 @@ names. -/
 def smooth_right_mul : C^∞⟮I, G; I, G⟯ := ⟨(right_mul g), smooth_mul_right⟩
 
 /- Left multiplication. The abbreviation is `MIL`. -/
-localized "notation `𝑳` := smooth_left_mul" in lie_group
+localized "notation (name := smooth_left_mul) `𝑳` := smooth_left_mul" in lie_group
 
 /- Right multiplication. The abbreviation is `MIR`. -/
-localized "notation `𝑹` := smooth_right_mul" in lie_group
+localized "notation (name := smooth_right_mul) `𝑹` := smooth_right_mul" in lie_group
 
 open_locale lie_group
 
@@ -151,12 +189,12 @@ end
 
 /- Instance of product -/
 @[to_additive]
-instance has_smooth_mul.prod {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+instance has_smooth_mul.prod {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   (G : Type*) [topological_space G] [charted_space H G]
   [has_mul G] [has_smooth_mul I G]
-  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+  {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
   {H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
   (G' : Type*) [topological_space G'] [charted_space H' G']
   [has_mul G'] [has_smooth_mul I' G'] :
@@ -169,12 +207,12 @@ end has_smooth_mul
 
 section monoid
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
 {H : Type*} [topological_space H]
-{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
 {G : Type*} [monoid G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
 {H' : Type*} [topological_space H']
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E'] {I' : model_with_corners 𝕜 E' H'}
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E'] {I' : model_with_corners 𝕜 E' H'}
 {G' : Type*} [monoid G'] [topological_space G'] [charted_space H' G'] [has_smooth_mul I' G']
 
 lemma smooth_pow : ∀ n : ℕ, smooth I I (λ a : G, a ^ n)
@@ -213,44 +251,136 @@ section comm_monoid
 
 open_locale big_operators
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+variables {ι 𝕜 : Type*} [nontrivially_normed_field 𝕜]
 {H : Type*} [topological_space H]
-{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
 {G : Type*} [comm_monoid G] [topological_space G] [charted_space H G] [has_smooth_mul I G]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
-{M : Type*} [topological_space M] [charted_space H' M]
+{M : Type*} [topological_space M] [charted_space H' M] {s : set M} {x : M}
+{t : finset ι} {f : ι → M → G} {n : ℕ∞} {p : ι → Prop}
+
+@[to_additive]
+lemma cont_mdiff_within_at_finset_prod' (h : ∀ i ∈ t, cont_mdiff_within_at I' I n (f i) s x) :
+  cont_mdiff_within_at I' I n (∏ i in t, f i) s x :=
+finset.prod_induction f (λ f, cont_mdiff_within_at I' I n f s x)
+    (λ f g hf hg, hf.mul hg) cont_mdiff_within_at_const h
+
+@[to_additive]
+lemma cont_mdiff_at_finset_prod' (h : ∀ i ∈ t, cont_mdiff_at I' I n (f i) x) :
+  cont_mdiff_at I' I n (∏ i in t, f i) x :=
+cont_mdiff_within_at_finset_prod' h
+
+@[to_additive]
+lemma cont_mdiff_on_finset_prod' (h : ∀ i ∈ t, cont_mdiff_on I' I n (f i) s) :
+  cont_mdiff_on I' I n (∏ i in t, f i) s :=
+λ x hx, cont_mdiff_within_at_finset_prod' $ λ i hi, h i hi x hx
+
+@[to_additive]
+lemma cont_mdiff_finset_prod' (h : ∀ i ∈ t, cont_mdiff I' I n (f i)) :
+  cont_mdiff I' I n (∏ i in t, f i) :=
+λ x, cont_mdiff_at_finset_prod' $ λ i hi, h i hi x
+
+@[to_additive]
+lemma cont_mdiff_within_at_finset_prod (h : ∀ i ∈ t, cont_mdiff_within_at I' I n (f i) s x) :
+  cont_mdiff_within_at I' I n (λ x, ∏ i in t, f i x) s x :=
+by { simp only [← finset.prod_apply], exact cont_mdiff_within_at_finset_prod' h }
 
 @[to_additive]
-lemma smooth_finset_prod' {ι} {s : finset ι} {f : ι → M → G} (h : ∀ i ∈ s, smooth I' I (f i)) :
-  smooth I' I (∏ i in s, f i) :=
-finset.prod_induction _ _ (λ f g hf hg, hf.mul hg)
-  (@smooth_const _ _ _ _ _ _ _ I' _ _ _ _ _ _ _ _ I _ _ _ 1) h
+lemma cont_mdiff_at_finset_prod (h : ∀ i ∈ t, cont_mdiff_at I' I n (f i) x) :
+  cont_mdiff_at I' I n (λ x, ∏ i in t, f i x) x :=
+cont_mdiff_within_at_finset_prod h
 
 @[to_additive]
-lemma smooth_finset_prod {ι} {s : finset ι} {f : ι → M → G} (h : ∀ i ∈ s, smooth I' I (f i)) :
-  smooth I' I (λ x, ∏ i in s, f i x) :=
-by { simp only [← finset.prod_apply], exact smooth_finset_prod' h }
+lemma cont_mdiff_on_finset_prod (h : ∀ i ∈ t, cont_mdiff_on I' I n (f i) s) :
+  cont_mdiff_on I' I n (λ x, ∏ i in t, f i x) s :=
+λ x hx, cont_mdiff_within_at_finset_prod $ λ i hi, h i hi x hx
+
+@[to_additive]
+lemma cont_mdiff_finset_prod (h : ∀ i ∈ t, cont_mdiff I' I n (f i)) :
+  cont_mdiff I' I n (λ x, ∏ i in t, f i x) :=
+λ x, cont_mdiff_at_finset_prod $ λ i hi, h i hi x
+
+@[to_additive]
+lemma smooth_within_at_finset_prod' (h : ∀ i ∈ t, smooth_within_at I' I (f i) s x) :
+  smooth_within_at I' I (∏ i in t, f i) s x :=
+cont_mdiff_within_at_finset_prod' h
+
+@[to_additive]
+lemma smooth_at_finset_prod' (h : ∀ i ∈ t, smooth_at I' I (f i) x) :
+  smooth_at I' I (∏ i in t, f i) x :=
+cont_mdiff_at_finset_prod' h
+
+@[to_additive]
+lemma smooth_on_finset_prod' (h : ∀ i ∈ t, smooth_on I' I (f i) s) :
+  smooth_on I' I (∏ i in t, f i) s :=
+cont_mdiff_on_finset_prod' h
+
+@[to_additive]
+lemma smooth_finset_prod' (h : ∀ i ∈ t, smooth I' I (f i)) : smooth I' I (∏ i in t, f i) :=
+cont_mdiff_finset_prod' h
+
+@[to_additive]
+lemma smooth_within_at_finset_prod (h : ∀ i ∈ t, smooth_within_at I' I (f i) s x) :
+  smooth_within_at I' I (λ x, ∏ i in t, f i x) s x :=
+cont_mdiff_within_at_finset_prod h
+
+@[to_additive]
+lemma smooth_at_finset_prod (h : ∀ i ∈ t, smooth_at I' I (f i) x) :
+  smooth_at I' I (λ x, ∏ i in t, f i x) x :=
+cont_mdiff_at_finset_prod h
+
+@[to_additive]
+lemma smooth_on_finset_prod (h : ∀ i ∈ t, smooth_on I' I (f i) s) :
+  smooth_on I' I (λ x, ∏ i in t, f i x) s :=
+cont_mdiff_on_finset_prod h
+
+@[to_additive]
+lemma smooth_finset_prod (h : ∀ i ∈ t, smooth I' I (f i)) :
+  smooth I' I (λ x, ∏ i in t, f i x) :=
+cont_mdiff_finset_prod h
 
 open function filter
 
 @[to_additive]
-lemma smooth_finprod {ι} {f : ι → M → G} (h : ∀ i, smooth I' I (f i))
+lemma cont_mdiff_finprod (h : ∀ i, cont_mdiff I' I n (f i))
   (hfin : locally_finite (λ i, mul_support (f i))) :
-  smooth I' I (λ x, ∏ᶠ i, f i x) :=
+  cont_mdiff I' I n (λ x, ∏ᶠ i, f i x) :=
 begin
   intro x,
   rcases finprod_eventually_eq_prod hfin x with ⟨s, hs⟩,
-  exact (smooth_finset_prod (λ i hi, h i) x).congr_of_eventually_eq hs,
+  exact (cont_mdiff_finset_prod (λ i hi, h i) x).congr_of_eventually_eq hs,
 end
 
 @[to_additive]
-lemma smooth_finprod_cond {ι} {f : ι → M → G} {p : ι → Prop} (hc : ∀ i, p i → smooth I' I (f i))
+lemma cont_mdiff_finprod_cond (hc : ∀ i, p i → cont_mdiff I' I n (f i))
   (hf : locally_finite (λ i, mul_support (f i))) :
-  smooth I' I (λ x, ∏ᶠ i (hi : p i), f i x) :=
+  cont_mdiff I' I n (λ x, ∏ᶠ i (hi : p i), f i x) :=
 begin
   simp only [← finprod_subtype_eq_finprod_cond],
-  exact smooth_finprod (λ i, hc i i.2) (hf.comp_injective subtype.coe_injective)
+  exact cont_mdiff_finprod (λ i, hc i i.2) (hf.comp_injective subtype.coe_injective)
 end
 
+@[to_additive]
+lemma smooth_finprod (h : ∀ i, smooth I' I (f i)) (hfin : locally_finite (λ i, mul_support (f i))) :
+  smooth I' I (λ x, ∏ᶠ i, f i x) :=
+cont_mdiff_finprod h hfin
+
+@[to_additive]
+lemma smooth_finprod_cond (hc : ∀ i, p i → smooth I' I (f i))
+  (hf : locally_finite (λ i, mul_support (f i))) :
+  smooth I' I (λ x, ∏ᶠ i (hi : p i), f i x) :=
+cont_mdiff_finprod_cond hc hf
+
 end comm_monoid
+
+section
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+
+instance has_smooth_add_self : has_smooth_add 𝓘(𝕜, E) E :=
+⟨by { convert cont_diff_add.cont_mdiff, exact model_with_corners_self_prod.symm,
+  exact charted_space_self_prod }⟩
+
+end
diff --git a/src/geometry/manifold/algebra/smooth_functions.lean b/src/geometry/manifold/algebra/smooth_functions.lean
index e0b1ebd25623b..47e08e8c88e99 100644
--- a/src/geometry/manifold/algebra/smooth_functions.lean
+++ b/src/geometry/manifold/algebra/smooth_functions.lean
@@ -9,20 +9,24 @@ import geometry.manifold.algebra.structures
 /-!
 # Algebraic structures over smooth functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define instances of algebraic structures over smooth functions.
 -/
 
 noncomputable theory
 
 open_locale manifold
+open topological_space
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {N : Type*} [topological_space N] [charted_space H N]
-{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
 {H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
 {N' : Type*} [topological_space N'] [charted_space H'' N']
 
@@ -85,6 +89,38 @@ def coe_fn_monoid_hom {G : Type*} [monoid G] [topological_space G]
   [charted_space H' G] [has_smooth_mul I' G] : C^∞⟮I, N; I', G⟯ →* (N → G) :=
 { to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }
 
+variables (I N)
+
+/-- For a manifold `N` and a smooth homomorphism `φ` between Lie groups `G'`, `G''`, the
+'left-composition-by-`φ`' group homomorphism from `C^∞⟮I, N; I', G'⟯` to `C^∞⟮I, N; I'', G''⟯`. -/
+@[to_additive "For a manifold `N` and a smooth homomorphism `φ` between additive Lie groups `G'`,
+`G''`, the 'left-composition-by-`φ`' group homomorphism from `C^∞⟮I, N; I', G'⟯` to
+`C^∞⟮I, N; I'', G''⟯`."]
+def comp_left_monoid_hom
+  {G' : Type*} [monoid G'] [topological_space G'] [charted_space H' G'] [has_smooth_mul I' G']
+  {G'' : Type*} [monoid G''] [topological_space G''] [charted_space H'' G'']
+  [has_smooth_mul I'' G''] (φ : G' →* G'') (hφ : smooth I' I'' φ) :
+  C^∞⟮I, N; I', G'⟯ →* C^∞⟮I, N; I'', G''⟯ :=
+{ to_fun := λ f, ⟨φ ∘ f, λ x, (hφ.smooth _).comp x (f.cont_mdiff x)⟩,
+  map_one' := by ext x; show φ 1 = 1; simp,
+  map_mul' := λ f g, by ext x; show φ (f x * g x) = φ (f x) * φ (g x); simp }
+
+variables (I') {N}
+
+/-- For a Lie group `G` and open sets `U ⊆ V` in `N`, the 'restriction' group homomorphism from
+`C^∞⟮I, V; I', G⟯` to `C^∞⟮I, U; I', G⟯`. -/
+@[to_additive "For an additive Lie group `G` and open sets `U ⊆ V` in `N`, the 'restriction' group
+homomorphism from `C^∞⟮I, V; I', G⟯` to `C^∞⟮I, U; I', G⟯`."]
+def restrict_monoid_hom
+  (G : Type*) [monoid G] [topological_space G] [charted_space H' G] [has_smooth_mul I' G]
+  {U V : opens N} (h : U ≤ V) :
+  C^∞⟮I, V; I', G⟯ →* C^∞⟮I, U; I', G⟯ :=
+{ to_fun := λ f, ⟨f ∘ set.inclusion h, f.smooth.comp (smooth_inclusion h)⟩,
+  map_one' := rfl,
+  map_mul' := λ f g, rfl }
+
+variables {I N I' N'}
+
 @[to_additive]
 instance comm_monoid {G : Type*} [comm_monoid G] [topological_space G]
   [charted_space H' G] [has_smooth_mul I' G] :
@@ -155,6 +191,33 @@ instance comm_ring {R : Type*} [comm_ring R] [topological_space R]
   ..smooth_map.add_comm_group,
   ..smooth_map.comm_monoid,}
 
+variables (I N)
+
+/-- For a manifold `N` and a smooth homomorphism `φ` between smooth rings `R'`, `R''`, the
+'left-composition-by-`φ`' ring homomorphism from `C^∞⟮I, N; I', R'⟯` to `C^∞⟮I, N; I'', R''⟯`. -/
+def comp_left_ring_hom
+  {R' : Type*} [ring R'] [topological_space R'] [charted_space H' R'] [smooth_ring I' R']
+  {R'' : Type*} [ring R''] [topological_space R''] [charted_space H'' R''] [smooth_ring I'' R'']
+  (φ : R' →+* R'') (hφ : smooth I' I'' φ) :
+  C^∞⟮I, N; I', R'⟯ →+* C^∞⟮I, N; I'', R''⟯ :=
+{ to_fun := λ f, ⟨φ ∘ f, λ x, (hφ.smooth _).comp x (f.cont_mdiff x)⟩,
+  .. smooth_map.comp_left_monoid_hom I N φ.to_monoid_hom hφ,
+  .. smooth_map.comp_left_add_monoid_hom I N φ.to_add_monoid_hom hφ }
+
+variables (I') {N}
+
+/-- For a "smooth ring" `R` and open sets `U ⊆ V` in `N`, the "restriction" ring homomorphism from
+`C^∞⟮I, V; I', R⟯` to `C^∞⟮I, U; I', R⟯`. -/
+def restrict_ring_hom
+  (R : Type*) [ring R] [topological_space R] [charted_space H' R] [smooth_ring I' R]
+  {U V : opens N} (h : U ≤ V) :
+  C^∞⟮I, V; I', R⟯ →+* C^∞⟮I, U; I', R⟯ :=
+{ to_fun := λ f, ⟨f ∘ set.inclusion h, f.smooth.comp (smooth_inclusion h)⟩,
+  .. smooth_map.restrict_monoid_hom I I' R h,
+  .. smooth_map.restrict_add_monoid_hom I I' R h }
+
+variables {I N I' N'}
+
 /-- Coercion to a function as a `ring_hom`. -/
 @[simps]
 def coe_fn_ring_hom {R : Type*} [comm_ring R] [topological_space R]
@@ -179,26 +242,26 @@ In this section we show that smooth functions valued in a vector space `M` over
 field `𝕜` inherit a vector space structure.
 -/
 
-instance has_scalar {V : Type*} [normed_group V] [normed_space 𝕜 V] :
-  has_scalar 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
+instance has_smul {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
+  has_smul 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
 ⟨λ r f, ⟨r • f, smooth_const.smul f.smooth⟩⟩
 
 @[simp]
-lemma coe_smul {V : Type*} [normed_group V] [normed_space 𝕜 V]
+lemma coe_smul {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
   (r : 𝕜) (f : C^∞⟮I, N; 𝓘(𝕜, V), V⟯) :
   ⇑(r • f) = r • f := rfl
 
-@[simp] lemma smul_comp {V : Type*} [normed_group V] [normed_space 𝕜 V]
+@[simp] lemma smul_comp {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
   (r : 𝕜) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
 (r • g).comp h = r • (g.comp h) := rfl
 
-instance module {V : Type*} [normed_group V] [normed_space 𝕜 V] :
+instance module {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
   module 𝕜 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
 function.injective.module 𝕜 coe_fn_add_monoid_hom cont_mdiff_map.coe_inj coe_smul
 
 /-- Coercion to a function as a `linear_map`. -/
 @[simps]
-def coe_fn_linear_map {V : Type*} [normed_group V] [normed_space 𝕜 V] :
+def coe_fn_linear_map {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
 C^∞⟮I, N; 𝓘(𝕜, V), V⟯ →ₗ[𝕜] (N → V) :=
 { to_fun := coe_fn,
   map_smul' := coe_smul,
@@ -254,15 +317,15 @@ section module_over_continuous_functions
 If `V` is a module over `𝕜`, then we show that the space of smooth functions from `N` to `V`
 is naturally a vector space over the ring of smooth functions from `N` to `𝕜`. -/
 
-instance has_scalar' {V : Type*} [normed_group V] [normed_space 𝕜 V] :
-  has_scalar C^∞⟮I, N; 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
+instance has_smul' {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
+  has_smul C^∞⟮I, N; 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
 ⟨λ f g, ⟨λ x, (f x) • (g x), (smooth.smul f.2 g.2)⟩⟩
 
-@[simp] lemma smul_comp' {V : Type*} [normed_group V] [normed_space 𝕜 V]
+@[simp] lemma smul_comp' {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
   (f : C^∞⟮I'', N'; 𝕜⟯) (g : C^∞⟮I'', N'; 𝓘(𝕜, V), V⟯) (h : C^∞⟮I, N; I'', N'⟯) :
 (f • g).comp h = (f.comp h) • (g.comp h) := rfl
 
-instance module' {V : Type*} [normed_group V] [normed_space 𝕜 V] :
+instance module' {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V] :
   module C^∞⟮I, N; 𝓘(𝕜), 𝕜⟯ C^∞⟮I, N; 𝓘(𝕜, V), V⟯ :=
 { smul     := (•),
   smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
diff --git a/src/geometry/manifold/algebra/structures.lean b/src/geometry/manifold/algebra/structures.lean
index 63fa459321fbc..e90599f0c066d 100644
--- a/src/geometry/manifold/algebra/structures.lean
+++ b/src/geometry/manifold/algebra/structures.lean
@@ -8,6 +8,9 @@ import geometry.manifold.algebra.lie_group
 /-!
 # Smooth structures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define smooth structures that build on Lie groups. We prefer using the term smooth
 instead of Lie mainly because Lie ring has currently another use in mathematics.
 -/
@@ -15,9 +18,9 @@ instead of Lie mainly because Lie ring has currently another use in mathematics.
 open_locale manifold
 
 section smooth_ring
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
 {H : Type*} [topological_space H]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 
 set_option default_priority 100 -- see Note [default priority]
 
@@ -42,7 +45,7 @@ instance smooth_ring.to_lie_add_group (I : model_with_corners 𝕜 E H)
 
 end smooth_ring
 
-instance field_smooth_ring {𝕜 : Type*} [nondiscrete_normed_field 𝕜] :
+instance field_smooth_ring {𝕜 : Type*} [nontrivially_normed_field 𝕜] :
   smooth_ring 𝓘(𝕜) 𝕜 :=
 { smooth_mul :=
   begin
@@ -55,7 +58,7 @@ instance field_smooth_ring {𝕜 : Type*} [nondiscrete_normed_field 𝕜] :
   ..normed_space_lie_add_group }
 
 variables {𝕜 R E H : Type*} [topological_space R] [topological_space H]
-  [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E]
+  [nontrivially_normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]
   [charted_space H R] (I : model_with_corners 𝕜 E H)
 
 /-- A smooth (semi)ring is a topological (semi)ring. This is not an instance for technical reasons,
diff --git a/src/geometry/manifold/bump_function.lean b/src/geometry/manifold/bump_function.lean
index a3213d6934f69..c301d8103d3f4 100644
--- a/src/geometry/manifold/bump_function.lean
+++ b/src/geometry/manifold/bump_function.lean
@@ -3,19 +3,22 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import analysis.calculus.specific_functions
+import analysis.calculus.bump_function_findim
 import geometry.manifold.cont_mdiff
 
 /-!
 # Smooth bump functions on a smooth manifold
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `smooth_bump_function I c` to be a bundled smooth "bump" function centered at
 `c`. It is a structure that consists of two real numbers `0 < r < R` with small enough `R`. We
 define a coercion to function for this type, and for `f : smooth_bump_function I c`, the function
 `⇑f` written in the extended chart at `c` has the following properties:
 
-* `f x = 1` in the closed euclidean ball of radius `f.r` centered at `c`;
-* `f x = 0` outside of the euclidean ball of radius `f.R` centered at `c`;
+* `f x = 1` in the closed ball of radius `f.r` centered at `c`;
+* `f x = 0` outside of the ball of radius `f.R` centered at `c`;
 * `0 ≤ f x ≤ 1` for all `x`.
 
 The actual statements involve (pre)images under `ext_chart_at I f` and are given as lemmas in the
@@ -28,12 +31,12 @@ manifold, smooth bump function
 
 universes uE uF uH uM
 variables
-{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+{E : Type uE} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
 {H : Type uH} [topological_space H] (I : model_with_corners ℝ E H)
 {M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
 
-open function filter finite_dimensional set
-open_locale topological_space manifold classical filter big_operators
+open function filter finite_dimensional set metric
+open_locale topology manifold classical filter big_operators
 
 noncomputable theory
 
@@ -47,8 +50,8 @@ In this section we define a structure for a bundled smooth bump function and pro
 `f : smooth_bump_function I M` is a smooth function on `M` such that in the extended chart `e` at
 `f.c`:
 
-* `f x = 1` in the closed euclidean ball of radius `f.r` centered at `f.c`;
-* `f x = 0` outside of the euclidean ball of radius `f.R` centered at `f.c`;
+* `f x = 1` in the closed ball of radius `f.r` centered at `f.c`;
+* `f x = 0` outside of the ball of radius `f.R` centered at `f.c`;
 * `0 ≤ f x ≤ 1` for all `x`.
 
 The structure contains data required to construct a function with these properties. The function is
@@ -56,15 +59,12 @@ available as `⇑f` or `f x`. Formal statements of the properties listed above i
 (pre)images under `ext_chart_at I f.c` and are given as lemmas in the `smooth_bump_function`
 namespace. -/
 structure smooth_bump_function (c : M) extends cont_diff_bump (ext_chart_at I c c) :=
-(closed_ball_subset :
-  (euclidean.closed_ball (ext_chart_at I c c) R) ∩ range I ⊆ (ext_chart_at I c).target)
+(closed_ball_subset : (closed_ball (ext_chart_at I c c) R) ∩ range I ⊆ (ext_chart_at I c).target)
 
 variable {M}
 
 namespace smooth_bump_function
 
-open euclidean (renaming dist -> eudist)
-
 variables {c : M} (f : smooth_bump_function I c) {x : M} {I}
 
 /-- The function defined by `f : smooth_bump_function c`. Use automatic coercion to function
@@ -93,7 +93,7 @@ lemma eventually_eq_of_mem_source (hx : x ∈ (chart_at H c).source) :
 f.eq_on_source.eventually_eq_of_mem $ is_open.mem_nhds (chart_at H c).open_source hx
 
 lemma one_of_dist_le (hs : x ∈ (chart_at H c).source)
-  (hd : eudist (ext_chart_at I c x) (ext_chart_at I c c) ≤ f.r) :
+  (hd : dist (ext_chart_at I c x) (ext_chart_at I c c) ≤ f.r) :
   f x = 1 :=
 by simp only [f.eq_on_source hs, (∘), f.to_cont_diff_bump.one_of_mem_closed_ball hd]
 
@@ -104,8 +104,8 @@ by rw [coe_def, support_indicator, (∘), support_comp_eq_preimage, ← ext_char
   ← (ext_chart_at I c).symm_image_target_inter_eq',
   ← (ext_chart_at I c).symm_image_target_inter_eq', f.to_cont_diff_bump.support_eq]
 
-lemma open_support : is_open (support f) :=
-by { rw support_eq_inter_preimage, exact ext_chart_preimage_open_of_open I c is_open_ball }
+lemma is_open_support : is_open (support f) :=
+by { rw support_eq_inter_preimage, exact is_open_ext_chart_at_preimage I c is_open_ball }
 
 lemma support_eq_symm_image :
   support f = (ext_chart_at I c).symm '' (ball (ext_chart_at I c c) f.R ∩ range I) :=
@@ -149,17 +149,17 @@ lemma nonneg : 0 ≤ f x := f.mem_Icc.1
 lemma le_one : f x ≤ 1 := f.mem_Icc.2
 
 lemma eventually_eq_one_of_dist_lt (hs : x ∈ (chart_at H c).source)
-  (hd : eudist (ext_chart_at I c x) (ext_chart_at I c c) < f.r) :
+  (hd : dist (ext_chart_at I c x) (ext_chart_at I c c) < f.r) :
   f =ᶠ[𝓝 x] 1 :=
 begin
-  filter_upwards [is_open.mem_nhds (ext_chart_preimage_open_of_open I c is_open_ball) ⟨hs, hd⟩],
+  filter_upwards [is_open.mem_nhds (is_open_ext_chart_at_preimage I c is_open_ball) ⟨hs, hd⟩],
   rintro z ⟨hzs, hzd : _ < _⟩,
   exact f.one_of_dist_le hzs hzd.le
 end
 
 lemma eventually_eq_one : f =ᶠ[𝓝 c] 1 :=
 f.eventually_eq_one_of_dist_lt (mem_chart_source _ _) $
-by { rw [euclidean.dist, dist_self], exact f.r_pos }
+by { rw [dist_self], exact f.r_pos }
 
 @[simp] lemma eq_one : f c = 1 := f.eventually_eq_one.eq_of_nhds
 
@@ -173,10 +173,10 @@ lemma c_mem_support : c ∈ support f := mem_of_mem_nhds f.support_mem_nhds
 
 lemma nonempty_support : (support f).nonempty := ⟨c, f.c_mem_support⟩
 
-lemma compact_symm_image_closed_ball :
+lemma is_compact_symm_image_closed_ball :
   is_compact ((ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)) :=
-(euclidean.is_compact_closed_ball.inter_right I.closed_range).image_of_continuous_on $
-  (ext_chart_at_continuous_on_symm _ _).mono f.closed_ball_subset
+((is_compact_closed_ball _ _).inter_right I.closed_range).image_of_continuous_on $
+  (continuous_on_ext_chart_at_symm _ _).mono f.closed_ball_subset
 
 /-- Given a smooth bump function `f : smooth_bump_function I c`, the closed ball of radius `f.R` is
 known to include the support of `f`. These closed balls (in the model normed space `E`) intersected
@@ -185,21 +185,21 @@ lemma nhds_within_range_basis :
   (𝓝[range I] (ext_chart_at I c c)).has_basis (λ f : smooth_bump_function I c, true)
     (λ f, closed_ball (ext_chart_at I c c) f.R ∩ range I) :=
 begin
-  refine ((nhds_within_has_basis euclidean.nhds_basis_closed_ball _).restrict_subset
+  refine ((nhds_within_has_basis nhds_basis_closed_ball _).restrict_subset
       (ext_chart_at_target_mem_nhds_within _ _)).to_has_basis' _ _,
   { rintro R ⟨hR0, hsub⟩,
-    exact ⟨⟨⟨⟨R / 2, R, half_pos hR0, half_lt_self hR0⟩⟩, hsub⟩, trivial, subset.rfl⟩ },
-  { exact λ f _, inter_mem (mem_nhds_within_of_mem_nhds $ closed_ball_mem_nhds f.R_pos)
+    exact ⟨⟨⟨R / 2, R, half_pos hR0, half_lt_self hR0⟩, hsub⟩, trivial, subset.rfl⟩ },
+  { exact λ f _, inter_mem (mem_nhds_within_of_mem_nhds $ closed_ball_mem_nhds _ f.R_pos)
       self_mem_nhds_within }
 end
 
-lemma closed_image_of_closed {s : set M} (hsc : is_closed s) (hs : s ⊆ support f) :
+lemma is_closed_image_of_is_closed {s : set M} (hsc : is_closed s) (hs : s ⊆ support f) :
   is_closed (ext_chart_at I c '' s) :=
 begin
   rw f.image_eq_inter_preimage_of_subset_support hs,
   refine continuous_on.preimage_closed_of_closed
-    ((ext_chart_continuous_on_symm _ _).mono f.closed_ball_subset) _ hsc,
-  exact is_closed.inter is_closed_closed_ball I.closed_range
+    ((continuous_on_ext_chart_at_symm _ _).mono f.closed_ball_subset) _ hsc,
+  exact is_closed.inter is_closed_ball I.closed_range
 end
 
 /-- If `f` is a smooth bump function and `s` closed subset of the support of `f` (i.e., of the open
@@ -210,15 +210,15 @@ lemma exists_r_pos_lt_subset_ball {s : set M} (hsc : is_closed s) (hs : s ⊆ su
     (chart_at H c).source ∩ ext_chart_at I c ⁻¹' (ball (ext_chart_at I c c) r) :=
 begin
   set e := ext_chart_at I c,
-  have : is_closed (e '' s) := f.closed_image_of_closed hsc hs,
+  have : is_closed (e '' s) := f.is_closed_image_of_is_closed hsc hs,
   rw [support_eq_inter_preimage, subset_inter_iff, ← image_subset_iff] at hs,
-  rcases euclidean.exists_pos_lt_subset_ball f.R_pos this hs.2 with ⟨r, hrR, hr⟩,
+  rcases exists_pos_lt_subset_ball f.R_pos this hs.2 with ⟨r, hrR, hr⟩,
   exact ⟨r, hrR, subset_inter hs.1 (image_subset_iff.1 hr)⟩
 end
 
 /-- Replace `r` with another value in the interval `(0, f.R)`. -/
 def update_r (r : ℝ) (hr : r ∈ Ioo 0 f.R) : smooth_bump_function I c :=
-⟨⟨⟨r, f.R, hr.1, hr.2⟩⟩, f.closed_ball_subset⟩
+⟨⟨r, f.R, hr.1, hr.2⟩, f.closed_ball_subset⟩
 
 @[simp] lemma update_r_R {r : ℝ} (hr : r ∈ Ioo 0 f.R) : (f.update_r r hr).R = f.R := rfl
 
@@ -233,16 +233,16 @@ classical.inhabited_of_nonempty nhds_within_range_basis.nonempty
 
 variables [t2_space M]
 
-lemma closed_symm_image_closed_ball :
+lemma is_closed_symm_image_closed_ball :
   is_closed ((ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)) :=
-f.compact_symm_image_closed_ball.is_closed
+f.is_compact_symm_image_closed_ball.is_closed
 
 lemma tsupport_subset_symm_image_closed_ball :
   tsupport f ⊆ (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I) :=
 begin
   rw [tsupport, support_eq_symm_image],
   exact closure_minimal (image_subset _ $ inter_subset_inter_left _ ball_subset_closed_ball)
-    f.closed_symm_image_closed_ball
+    f.is_closed_symm_image_closed_ball
 end
 
 lemma tsupport_subset_ext_chart_at_source :
@@ -260,7 +260,7 @@ lemma tsupport_subset_chart_at_source :
 by simpa only [ext_chart_at_source] using f.tsupport_subset_ext_chart_at_source
 
 protected lemma has_compact_support : has_compact_support f :=
-compact_of_is_closed_subset f.compact_symm_image_closed_ball is_closed_closure
+is_compact_of_is_closed_subset f.is_compact_symm_image_closed_ball is_closed_closure
  f.tsupport_subset_symm_image_closed_ball
 
 variables (I c)
@@ -273,7 +273,7 @@ lemma nhds_basis_tsupport :
 begin
   have : (𝓝 c).has_basis (λ f : smooth_bump_function I c, true)
     (λ f, (ext_chart_at I c).symm '' (closed_ball (ext_chart_at I c c) f.R ∩ range I)),
-  { rw [← ext_chart_at_symm_map_nhds_within_range I c],
+  { rw [← map_ext_chart_at_symm_nhds_within_range I c],
     exact nhds_within_range_basis.map _ },
   refine this.to_has_basis' (λ f hf, ⟨f, trivial, f.tsupport_subset_symm_image_closed_ball⟩)
     (λ f _, f.tsupport_mem_nhds),
@@ -309,14 +309,14 @@ protected lemma continuous : continuous f := f.smooth.continuous
 
 /-- If `f : smooth_bump_function I c` is a smooth bump function and `g : M → G` is a function smooth
 on the source of the chart at `c`, then `f • g` is smooth on the whole manifold. -/
-lemma smooth_smul {G} [normed_group G] [normed_space ℝ G]
+lemma smooth_smul {G} [normed_add_comm_group G] [normed_space ℝ G]
   {g : M → G} (hg : smooth_on I 𝓘(ℝ, G) g (chart_at H c).source) :
   smooth I 𝓘(ℝ, G) (λ x, f x • g x) :=
 begin
   apply cont_mdiff_of_support (λ x hx, _),
   have : x ∈ (chart_at H c).source,
   calc x ∈ tsupport (λ x, f x • g x) : hx
-     ... ⊆ tsupport f : closure_mono (support_smul_subset_left _ _)
+     ... ⊆ tsupport f : tsupport_smul_subset_left _ _
      ... ⊆ (chart_at _ c).source : f.tsupport_subset_chart_at_source,
   exact f.smooth_at.smul ((hg _ this).cont_mdiff_at $
     is_open.mem_nhds (chart_at _ _).open_source this)
diff --git a/src/geometry/manifold/charted_space.lean b/src/geometry/manifold/charted_space.lean
index baa4940a1a64d..9d562746d5252 100644
--- a/src/geometry/manifold/charted_space.lean
+++ b/src/geometry/manifold/charted_space.lean
@@ -8,6 +8,9 @@ import topology.local_homeomorph
 /-!
 # Charted spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A smooth manifold is a topological space `M` locally modelled on a euclidean space (or a euclidean
 half-space for manifolds with boundaries, or an infinite dimensional vector space for more general
 notions of manifolds), i.e., the manifold is covered by open subsets on which there are local
@@ -108,7 +111,7 @@ composition of local equivs with `≫`.
 -/
 
 noncomputable theory
-open_locale classical topological_space
+open_locale classical topology
 open filter
 universes u
 
@@ -118,14 +121,10 @@ variables {H : Type u} {H' : Type*} {M : Type*} {M' : Type*} {M'' : Type*}
 `local_homeomorph.trans` and `local_equiv.trans`.
 Note that, as is usual for equivs, the composition is from left to right, hence the direction of
 the arrow. -/
-localized "infixr  ` ≫ₕ `:100 := local_homeomorph.trans" in manifold
-localized "infixr  ` ≫ `:100 := local_equiv.trans" in manifold
-
-/- `simp` looks for subsingleton instances at every call. This turns out to be very
-inefficient, especially in `simp`-heavy parts of the library such as the manifold code.
-Disable two such instances to speed up things.
-NB: this is just a hack. TODO: fix `simp` properly. -/
-localized "attribute [-instance] unique.subsingleton pi.subsingleton" in manifold
+localized "infixr (name := local_homeomorph.trans)
+  ` ≫ₕ `:100 := local_homeomorph.trans" in manifold
+localized "infixr (name := local_equiv.trans)
+  ` ≫ `:100 := local_equiv.trans" in manifold
 
 open set local_homeomorph
 
@@ -211,7 +210,7 @@ def id_groupoid (H : Type u) [topological_space H] : structure_groupoid H :=
     { simpa only [he, refl_trans]},
     { have : (e ≫ₕ e').source ⊆ e.source := sep_subset _ _,
       rw he at this,
-      have : (e ≫ₕ e') ∈ {e : local_homeomorph H H | e.source = ∅} := disjoint_iff.1 this,
+      have : (e ≫ₕ e') ∈ {e : local_homeomorph H H | e.source = ∅} := eq_bot_iff.2 this,
       exact (mem_union _ _ _).2 (or.inr this) },
   end,
   symm' := λe he, begin
@@ -266,7 +265,7 @@ instance : order_bot (structure_groupoid H) :=
       apply u.id_mem },
     { apply u.locality,
       assume x hx,
-      rw [hf, mem_empty_eq] at hx,
+      rw [hf, mem_empty_iff_false] at hx,
       exact hx.elim }
   end }
 
@@ -460,6 +459,7 @@ The model space is written as an explicit parameter as there can be several mode
 given topological space. For instance, a complex manifold (modelled over `ℂ^n`) will also be seen
 sometimes as a real manifold over `ℝ^(2n)`.
 -/
+@[ext]
 class charted_space (H : Type*) [topological_space H] (M : Type*) [topological_space M] :=
 (atlas []            : set (local_homeomorph M H))
 (chart_at []         : M → local_homeomorph M H)
@@ -497,27 +497,30 @@ variables (H) [topological_space H] [topological_space M] [charted_space H M]
 lemma mem_chart_target (x : M) : chart_at H x x ∈ (chart_at H x).target :=
 (chart_at H x).map_source (mem_chart_source _ _)
 
-/-- If a topological space admits an atlas with locally compact charts, then the space itself
-is locally compact. -/
-lemma charted_space.locally_compact [locally_compact_space H] : locally_compact_space M :=
-begin
-  have : ∀ (x : M), (𝓝 x).has_basis
-      (λ s, s ∈ 𝓝 (chart_at H x x) ∧ is_compact s ∧ s ⊆ (chart_at H x).target)
-      (λ s, (chart_at H x).symm '' s),
-  { intro x,
-    rw [← (chart_at H x).symm_map_nhds_eq (mem_chart_source H x)],
-    exact ((compact_basis_nhds (chart_at H x x)).has_basis_self_subset
-      (is_open.mem_nhds (chart_at H x).open_target (mem_chart_target H x))).map _ },
-  refine locally_compact_space_of_has_basis this _,
-  rintro x s ⟨h₁, h₂, h₃⟩,
-  exact h₂.image_of_continuous_on ((chart_at H x).continuous_on_symm.mono h₃)
-end
+lemma chart_source_mem_nhds (x : M) : (chart_at H x).source ∈ 𝓝 x :=
+(chart_at H x).open_source.mem_nhds $ mem_chart_source H x
+
+lemma chart_target_mem_nhds (x : M) : (chart_at H x).target ∈ 𝓝 (chart_at H x x) :=
+(chart_at H x).open_target.mem_nhds $ mem_chart_target H x
+
+/-- `achart H x` is the chart at `x`, considered as an element of the atlas.
+Especially useful for working with `basic_smooth_vector_bundle_core` -/
+def achart (x : M) : atlas H M := ⟨chart_at H x, chart_mem_atlas H x⟩
+
+lemma achart_def (x : M) : achart H x = ⟨chart_at H x, chart_mem_atlas H x⟩ := rfl
+@[simp, mfld_simps]
+lemma coe_achart (x : M) : (achart H x : local_homeomorph M H) = chart_at H x := rfl
+@[simp, mfld_simps]
+lemma achart_val (x : M) : (achart H x).1 = chart_at H x := rfl
+
+lemma mem_achart_source (x : M) : x ∈ (achart H x).1.source :=
+mem_chart_source H x
 
 open topological_space
 
 lemma charted_space.second_countable_of_countable_cover [second_countable_topology H]
   {s : set M} (hs : (⋃ x (hx : x ∈ s), (chart_at H x).source) = univ)
-  (hsc : countable s) :
+  (hsc : s.countable) :
   second_countable_topology M :=
 begin
   haveI : ∀ x : M, second_countable_topology (chart_at H x).source :=
@@ -527,16 +530,61 @@ begin
   exact second_countable_topology_of_countable_cover (λ x : s, (chart_at H (x : M)).open_source) hs
 end
 
+variable (M)
+
 lemma charted_space.second_countable_of_sigma_compact [second_countable_topology H]
   [sigma_compact_space M] :
   second_countable_topology M :=
 begin
-  obtain ⟨s, hsc, hsU⟩ : ∃ s, countable s ∧ (⋃ x (hx : x ∈ s), (chart_at H x).source) = univ :=
-    countable_cover_nhds_of_sigma_compact
-      (λ x : M, is_open.mem_nhds (chart_at H x).open_source (mem_chart_source H x)),
+  obtain ⟨s, hsc, hsU⟩ : ∃ s, set.countable s ∧ (⋃ x (hx : x ∈ s), (chart_at H x).source) = univ :=
+    countable_cover_nhds_of_sigma_compact (λ x : M, chart_source_mem_nhds H x),
   exact charted_space.second_countable_of_countable_cover H hsU hsc
 end
 
+/-- If a topological space admits an atlas with locally compact charts, then the space itself
+is locally compact. -/
+lemma charted_space.locally_compact [locally_compact_space H] : locally_compact_space M :=
+begin
+  have : ∀ (x : M), (𝓝 x).has_basis
+      (λ s, s ∈ 𝓝 (chart_at H x x) ∧ is_compact s ∧ s ⊆ (chart_at H x).target)
+      (λ s, (chart_at H x).symm '' s),
+  { intro x,
+    rw [← (chart_at H x).symm_map_nhds_eq (mem_chart_source H x)],
+    exact ((compact_basis_nhds (chart_at H x x)).has_basis_self_subset
+      (chart_target_mem_nhds H x)).map _ },
+  refine locally_compact_space_of_has_basis this _,
+  rintro x s ⟨h₁, h₂, h₃⟩,
+  exact h₂.image_of_continuous_on ((chart_at H x).continuous_on_symm.mono h₃)
+end
+
+/-- If a topological space admits an atlas with locally connected charts, then the space itself is
+locally connected. -/
+lemma charted_space.locally_connected_space [locally_connected_space H] :
+  locally_connected_space M :=
+begin
+  let E : M → local_homeomorph M H := chart_at H,
+  refine locally_connected_space_of_connected_bases
+    (λ x s, (E x).symm '' s)
+    (λ x s, (is_open s ∧ E x x ∈ s ∧ is_connected s) ∧ s ⊆ (E x).target) _ _,
+  { intros x,
+    simpa only [local_homeomorph.symm_map_nhds_eq, mem_chart_source] using
+      ((locally_connected_space.open_connected_basis (E x x)).restrict_subset
+      ((E x).open_target.mem_nhds (mem_chart_target H x))).map (E x).symm },
+  { rintros x s ⟨⟨-, -, hsconn⟩, hssubset⟩,
+    exact hsconn.is_preconnected.image _ ((E x).continuous_on_symm.mono hssubset) },
+end
+
+/-- If `M` is modelled on `H'` and `H'` is itself modelled on `H`, then we can consider `M` as being
+modelled on `H`. -/
+def charted_space.comp (H : Type*) [topological_space H] (H' : Type*) [topological_space H']
+  (M : Type*) [topological_space M] [charted_space H H'] [charted_space H' M] :
+  charted_space H M :=
+{ atlas := image2 local_homeomorph.trans (atlas H' M) (atlas H H'),
+  chart_at := λ p : M, (chart_at H' p).trans (chart_at H (chart_at H' p p)),
+  mem_chart_source := λ p, by simp only with mfld_simps,
+  chart_mem_atlas :=
+    λ p, ⟨chart_at H' p, chart_at H _, chart_mem_atlas H' p, chart_mem_atlas H _, rfl⟩ }
+
 end
 
 /-- For technical reasons we introduce two type tags:
@@ -616,6 +664,9 @@ variables [topological_space H] [topological_space M] [charted_space H M]
 @[simp, mfld_simps] lemma prod_charted_space_chart_at :
   (chart_at (model_prod H H') x) = (chart_at H x.fst).prod (chart_at H' x.snd) := rfl
 
+lemma charted_space_self_prod : prod_charted_space H H H' H' = charted_space_self (H × H') :=
+by { ext1, { simp [prod_charted_space, atlas] }, { ext1, simp [chart_at_self_eq], refl } }
+
 end prod_charted_space
 
 /-- The product of a finite family of charted spaces is naturally a charted space, with the
@@ -641,7 +692,7 @@ end charted_space
 have a topological structure, where the topology would come from the charts. For this, one needs
 charts that are only local equivs, and continuity properties for their composition.
 This is formalised in `charted_space_core`. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure charted_space_core (H : Type*) [topological_space H] (M : Type*) :=
 (atlas            : set (local_equiv M H))
 (chart_at         : M → local_equiv M H)
@@ -660,7 +711,7 @@ protected def to_topological_space : topological_space M :=
 topological_space.generate_from $ ⋃ (e : local_equiv M H) (he : e ∈ c.atlas)
   (s : set H) (s_open : is_open s), {e ⁻¹' s ∩ e.source}
 
-lemma open_source' (he : e ∈ c.atlas) : @is_open M c.to_topological_space e.source :=
+lemma open_source' (he : e ∈ c.atlas) : is_open[c.to_topological_space] e.source :=
 begin
   apply topological_space.generate_open.basic,
   simp only [exists_prop, mem_Union, mem_singleton_iff],
@@ -746,7 +797,7 @@ has_groupoid.compatible G he he'
 
 lemma has_groupoid_of_le {G₁ G₂ : structure_groupoid H} (h : has_groupoid M G₁) (hle : G₁ ≤ G₂) :
   has_groupoid M G₂ :=
-⟨ λ e e' he he', hle ((h.compatible : _) he he') ⟩
+⟨λ e e' he he', hle (h.compatible he he')⟩
 
 lemma has_groupoid_of_pregroupoid (PG : pregroupoid H)
   (h : ∀{e e' : local_homeomorph M H}, e ∈ atlas H M → e' ∈ atlas H M
@@ -785,13 +836,13 @@ def structure_groupoid.maximal_atlas : set (local_homeomorph M H) :=
 variable {M}
 
 /-- The elements of the atlas belong to the maximal atlas for any structure groupoid -/
-lemma structure_groupoid.mem_maximal_atlas_of_mem_atlas [has_groupoid M G]
-  {e : local_homeomorph M H} (he : e ∈ atlas H M) : e ∈ G.maximal_atlas M :=
-λ e' he', ⟨G.compatible he he', G.compatible he' he⟩
+lemma structure_groupoid.subset_maximal_atlas [has_groupoid M G] :
+  atlas H M ⊆ G.maximal_atlas M :=
+λ e he e' he', ⟨G.compatible he he', G.compatible he' he⟩
 
 lemma structure_groupoid.chart_mem_maximal_atlas [has_groupoid M G]
   (x : M) : chart_at H x ∈ G.maximal_atlas M :=
-G.mem_maximal_atlas_of_mem_atlas (chart_mem_atlas H x)
+G.subset_maximal_atlas (chart_mem_atlas H x)
 
 variable {G}
 
@@ -828,7 +879,15 @@ variable (G)
 
 /-- In the model space, the identity is in any maximal atlas. -/
 lemma structure_groupoid.id_mem_maximal_atlas : local_homeomorph.refl H ∈ G.maximal_atlas H :=
-G.mem_maximal_atlas_of_mem_atlas (by simp)
+G.subset_maximal_atlas $ by simp
+
+/-- In the model space, any element of the groupoid is in the maximal atlas. -/
+lemma structure_groupoid.mem_maximal_atlas_of_mem_groupoid {f : local_homeomorph H H} (hf : f ∈ G) :
+  f ∈ G.maximal_atlas H :=
+begin
+  rintros e (rfl : e = local_homeomorph.refl H),
+  exact ⟨G.trans (G.symm hf) G.id_mem, G.trans (G.symm G.id_mem) hf⟩,
+end
 
 end maximal_atlas
 
@@ -925,6 +984,21 @@ instance [closed_under_restriction G] : has_groupoid s G :=
     { exact preimage_open_of_open_symm (chart_at H x) s.2 },
   end }
 
+lemma chart_at_inclusion_symm_eventually_eq {U V : opens M} (hUV : U ≤ V) {x : U} :
+  (chart_at H (set.inclusion hUV x)).symm
+  =ᶠ[𝓝 (chart_at H (set.inclusion hUV x) (set.inclusion hUV x))] set.inclusion hUV
+    ∘ (chart_at H x).symm :=
+begin
+  set i := set.inclusion hUV,
+  set e := chart_at H (x:M),
+  haveI : nonempty U := ⟨x⟩,
+  haveI : nonempty V := ⟨i x⟩,
+  have heUx_nhds : (e.subtype_restr U).target ∈ 𝓝 (e x),
+  { apply (e.subtype_restr U).open_target.mem_nhds,
+    exact e.map_subtype_source (mem_chart_source _ _) },
+  exact filter.eventually_eq_of_mem heUx_nhds (e.subtype_restr_symm_eq_on_of_le hUV),
+end
+
 end topological_space.opens
 
 /-! ### Structomorphisms -/
@@ -932,7 +1006,7 @@ end topological_space.opens
 /-- A `G`-diffeomorphism between two charted spaces is a homeomorphism which, when read in the
 charts, belongs to `G`. We avoid the word diffeomorph as it is too related to the smooth category,
 and use structomorph instead. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure structomorph (G : structure_groupoid H) (M : Type*) (M' : Type*)
   [topological_space M] [topological_space M'] [charted_space H M] [charted_space H M']
   extends homeomorph M M' :=
diff --git a/src/geometry/manifold/complex.lean b/src/geometry/manifold/complex.lean
new file mode 100644
index 0000000000000..bcd39594ce8bc
--- /dev/null
+++ b/src/geometry/manifold/complex.lean
@@ -0,0 +1,118 @@
+/-
+Copyright (c) 2022 Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Heather Macbeth
+-/
+import analysis.complex.abs_max
+import analysis.locally_convex.with_seminorms
+import geometry.manifold.mfderiv
+import topology.locally_constant.basic
+
+/-! # Holomorphic functions on complex manifolds
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Thanks to the rigidity of complex-differentiability compared to real-differentiability, there are
+many results about complex manifolds with no analogue for manifolds over a general normed field. For
+now, this file contains just two (closely related) such results:
+
+## Main results
+
+* `mdifferentiable.is_locally_constant`: A complex-differentiable function on a compact complex
+  manifold is locally constant.
+* `mdifferentiable.exists_eq_const_of_compact_space`: A complex-differentiable function on a compact
+  preconnected complex manifold is constant.
+
+## TODO
+
+There is a whole theory to develop here.  Maybe a next step would be to develop a theory of
+holomorphic vector/line bundles, including:
+* the finite-dimensionality of the space of sections of a holomorphic vector bundle
+* Siegel's theorem: for any `n + 1` formal ratios `g 0 / h 0`, `g 1 / h 1`, .... `g n / h n` of
+  sections of a fixed line bundle `L` over a complex `n`-manifold, there exists a polynomial
+  relationship `P (g 0 / h 0, g 1 / h 1, .... g n / h n) = 0`
+
+Another direction would be to develop the relationship with sheaf theory, building the sheaves of
+holomorphic and meromorphic functions on a complex manifold and proving algebraic results about the
+stalks, such as the Weierstrass preparation theorem.
+
+-/
+
+open_locale manifold topology
+open complex
+
+namespace mdifferentiable
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E]
+variables {F : Type*} [normed_add_comm_group F] [normed_space ℂ F] [strict_convex_space ℝ F]
+
+variables {M : Type*} [topological_space M] [compact_space M] [charted_space E M]
+  [smooth_manifold_with_corners 𝓘(ℂ, E) M]
+
+/-- A holomorphic function on a compact complex manifold is locally constant. -/
+protected lemma is_locally_constant {f : M → F} (hf : mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) :
+  is_locally_constant f :=
+begin
+  haveI : locally_connected_space M := charted_space.locally_connected_space E M,
+  apply is_locally_constant.of_constant_on_preconnected_clopens,
+  intros s hs₂ hs₃ a ha b hb,
+  have hs₁ : is_compact s := hs₃.2.is_compact,
+  -- for an empty set this fact is trivial
+  rcases s.eq_empty_or_nonempty with rfl | hs',
+  { exact false.rec _ ha },
+  -- otherwise, let `p₀` be a point where the value of `f` has maximal norm
+  obtain ⟨p₀, hp₀s, hp₀⟩ := hs₁.exists_forall_ge hs' hf.continuous.norm.continuous_on,
+  -- we will show `f` agrees everywhere with `f p₀`
+  suffices : s ⊆ {r : M | f r = f p₀} ∩ s,
+  { exact (this hb).1.trans (this ha).1.symm }, clear ha hb a b,
+  refine hs₂.subset_clopen _ ⟨p₀, hp₀s, ⟨rfl, hp₀s⟩⟩,
+  -- closedness of the set of points sent to `f p₀`
+  refine ⟨_, (is_closed_singleton.preimage hf.continuous).inter hs₃.2⟩,
+  -- we will show this set is open by showing it is a neighbourhood of each of its members
+  rw is_open_iff_mem_nhds,
+  rintros p ⟨hp : f p = _, hps⟩, -- let `p` be  in this set
+  have hps' : s ∈ 𝓝 p := hs₃.1.mem_nhds hps,
+  have key₁ : (chart_at E p).symm ⁻¹' s ∈ 𝓝 (chart_at E p p),
+  { rw [← filter.mem_map, (chart_at E p).symm_map_nhds_eq (mem_chart_source E p)],
+    exact hps' },
+  have key₂ : (chart_at E p).target ∈ 𝓝 (chart_at E p p) :=
+    (local_homeomorph.open_target _).mem_nhds (mem_chart_target E p),
+  -- `f` pulled back by the chart at `p` is differentiable around `chart_at E p p`
+  have hf' : ∀ᶠ (z : E) in 𝓝 (chart_at E p p), differentiable_at ℂ (f ∘ (chart_at E p).symm) z,
+  { refine filter.eventually_of_mem key₂ (λ z hz, _),
+    have H₁ : (chart_at E p).symm z ∈ (chart_at E p).source := (chart_at E p).map_target hz,
+    have H₂ : f ((chart_at E p).symm z) ∈ (chart_at F (0:F)).source := trivial,
+    have H := (mdifferentiable_at_iff_of_mem_source H₁ H₂).mp (hf ((chart_at E p).symm z)),
+    simp only [differentiable_within_at_univ] with mfld_simps at H,
+    simpa [local_homeomorph.right_inv _ hz] using H.2, },
+  -- `f` pulled back by the chart at `p` has a local max at `chart_at E p p`
+  have hf'' : is_local_max (norm ∘ f ∘ (chart_at E p).symm) (chart_at E p p),
+  { refine filter.eventually_of_mem key₁ (λ z hz, _),
+    refine (hp₀ ((chart_at E p).symm z) hz).trans (_ : ‖f p₀‖ ≤ ‖f _‖),
+    rw [← hp, local_homeomorph.left_inv _ (mem_chart_source E p)] },
+  -- so by the maximum principle `f` is equal to `f p` near `p`
+  obtain ⟨U, hU, hUf⟩ := (complex.eventually_eq_of_is_local_max_norm hf' hf'').exists_mem,
+  have H₁ : (chart_at E p) ⁻¹' U ∈ 𝓝 p := (chart_at E p).continuous_at (mem_chart_source E p) hU,
+  have H₂ : (chart_at E p).source ∈ 𝓝 p :=
+    (local_homeomorph.open_source _).mem_nhds (mem_chart_source E p),
+  apply filter.mem_of_superset (filter.inter_mem hps' (filter.inter_mem H₁ H₂)),
+  rintros q ⟨hqs, hq : chart_at E p q ∈ _, hq'⟩,
+  refine ⟨_, hqs⟩,
+  simpa [local_homeomorph.left_inv _ hq', hp, -norm_eq_abs] using hUf (chart_at E p q) hq,
+end
+
+/-- A holomorphic function on a compact connected complex manifold is constant. -/
+lemma apply_eq_of_compact_space [preconnected_space M]
+  {f : M → F} (hf : mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) (a b : M) :
+  f a = f b :=
+hf.is_locally_constant.apply_eq_of_preconnected_space _ _
+
+/-- A holomorphic function on a compact connected complex manifold is the constant function `f ≡ v`,
+for some value `v`. -/
+lemma exists_eq_const_of_compact_space [preconnected_space M]
+  {f : M → F} (hf : mdifferentiable 𝓘(ℂ, E) 𝓘(ℂ, F) f) :
+  ∃ v : F, f = function.const M v :=
+hf.is_locally_constant.exists_eq_const
+
+end mdifferentiable
diff --git a/src/geometry/manifold/conformal_groupoid.lean b/src/geometry/manifold/conformal_groupoid.lean
index b1f8c1fc6573a..6a75afe7a26f1 100644
--- a/src/geometry/manifold/conformal_groupoid.lean
+++ b/src/geometry/manifold/conformal_groupoid.lean
@@ -9,6 +9,9 @@ import geometry.manifold.charted_space
 /-!
 # Conformal Groupoid
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the groupoid of conformal maps on normed spaces.
 
 ## Main definitions
@@ -20,7 +23,7 @@ In this file we define the groupoid of conformal maps on normed spaces.
 conformal, groupoid
 -/
 
-variables {X : Type*} [normed_group X] [normed_space ℝ X]
+variables {X : Type*} [normed_add_comm_group X] [normed_space ℝ X]
 
 /-- The pregroupoid of conformal maps. -/
 def conformal_pregroupoid : pregroupoid X :=
diff --git a/src/geometry/manifold/cont_mdiff.lean b/src/geometry/manifold/cont_mdiff.lean
index 9839fc53ae3ba..2ffd0e1c3c7d8 100644
--- a/src/geometry/manifold/cont_mdiff.lean
+++ b/src/geometry/manifold/cont_mdiff.lean
@@ -1,15 +1,17 @@
 /-
 Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
+Authors: Sébastien Gouëzel, Floris van Doorn
 -/
-
-import geometry.manifold.mfderiv
+import geometry.manifold.smooth_manifold_with_corners
 import geometry.manifold.local_invariant_properties
 
 /-!
 # Smooth functions between smooth manifolds
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `Cⁿ` functions between smooth manifolds, as functions which are `Cⁿ` in charts, and prove
 basic properties of these notions.
 
@@ -24,10 +26,6 @@ Let `M ` and `M'` be two smooth manifolds, with respect to model with corners `I
 * `cont_mdiff_on I I' n f s` states that the function `f` is `Cⁿ` on the set `s`
 * `cont_mdiff I I' n f` states that the function `f` is `Cⁿ`.
 * `cont_mdiff_on.comp` gives the invariance of the `Cⁿ` property under composition
-* `cont_mdiff_on.cont_mdiff_on_tangent_map_within` states that the bundled derivative
-  of a `Cⁿ` function in a domain is `Cᵐ` when `m + 1 ≤ n`.
-* `cont_mdiff.cont_mdiff_tangent_map` states that the bundled derivative
-  of a `Cⁿ` function is `Cᵐ` when `m + 1 ≤ n`.
 * `cont_mdiff_iff_cont_diff` states that, for functions between vector spaces,
   manifold-smoothness is equivalent to usual smoothness.
 
@@ -48,46 +46,72 @@ in terms of extended charts in `cont_mdiff_on_iff` and `cont_mdiff_iff`.
 -/
 
 open set function filter charted_space smooth_manifold_with_corners
-open_locale topological_space manifold
+open_locale topology manifold
 
 /-! ### Definition of smooth functions between manifolds -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
 -- declare a smooth manifold `M` over the pair `(E, H)`.
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
 {M : Type*} [topological_space M] [charted_space H M] [Is : smooth_manifold_with_corners I M]
 -- declare a smooth manifold `M'` over the pair `(E', H')`.
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
 {M' : Type*} [topological_space M'] [charted_space H' M'] [I's : smooth_manifold_with_corners I' M']
+-- declare a manifold `M''` over the pair `(E'', H'')`.
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
+{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
+{M'' : Type*} [topological_space M''] [charted_space H'' M'']
 -- declare a smooth manifold `N` over the pair `(F, G)`.
-{F : Type*} [normed_group F] [normed_space 𝕜 F]
+{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
 {G : Type*} [topological_space G] {J : model_with_corners 𝕜 F G}
 {N : Type*} [topological_space N] [charted_space G N] [Js : smooth_manifold_with_corners J N]
 -- declare a smooth manifold `N'` over the pair `(F', G')`.
-{F' : Type*} [normed_group F'] [normed_space 𝕜 F']
+{F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜 F']
 {G' : Type*} [topological_space G'] {J' : model_with_corners 𝕜 F' G'}
 {N' : Type*} [topological_space N'] [charted_space G' N'] [J's : smooth_manifold_with_corners J' N']
+-- F₁, F₂, F₃, F₄ are normed spaces
+{F₁ : Type*} [normed_add_comm_group F₁] [normed_space 𝕜 F₁]
+{F₂ : Type*} [normed_add_comm_group F₂] [normed_space 𝕜 F₂]
+{F₃ : Type*} [normed_add_comm_group F₃] [normed_space 𝕜 F₃]
+{F₄ : Type*} [normed_add_comm_group F₄] [normed_space 𝕜 F₄]
 -- declare functions, sets, points and smoothness indices
-{f f₁ : M → M'} {s s₁ t : set M} {x : M} {m n : with_top ℕ}
+{e : local_homeomorph M H} {e' : local_homeomorph M' H'}
+{f f₁ : M → M'} {s s₁ t : set M} {x : M} {m n : ℕ∞}
 
 /-- Property in the model space of a model with corners of being `C^n` within at set at a point,
 when read in the model vector space. This property will be lifted to manifolds to define smooth
 functions between manifolds. -/
-def cont_diff_within_at_prop (n : with_top ℕ) (f s x) : Prop :=
-cont_diff_within_at 𝕜 n (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) (I x)
+def cont_diff_within_at_prop (n : ℕ∞) (f : H → H') (s : set H) (x : H) : Prop :=
+cont_diff_within_at 𝕜 n (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) (I x)
+
+lemma cont_diff_within_at_prop_self_source {f : E → H'} {s : set E} {x : E} :
+  cont_diff_within_at_prop 𝓘(𝕜, E) I' n f s x ↔ cont_diff_within_at 𝕜 n (I' ∘ f) s x :=
+begin
+  simp_rw [cont_diff_within_at_prop, model_with_corners_self_coe, range_id, inter_univ],
+  refl
+end
+
+lemma cont_diff_within_at_prop_self {f : E → E'} {s : set E} {x : E} :
+  cont_diff_within_at_prop 𝓘(𝕜, E) 𝓘(𝕜, E') n f s x ↔ cont_diff_within_at 𝕜 n f s x :=
+cont_diff_within_at_prop_self_source 𝓘(𝕜, E')
+
+lemma cont_diff_within_at_prop_self_target {f : H → E'} {s : set H} {x : H} :
+  cont_diff_within_at_prop I 𝓘(𝕜, E') n f s x ↔
+  cont_diff_within_at 𝕜 n (f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) (I x) :=
+iff.rfl
 
 /-- Being `Cⁿ` in the model space is a local property, invariant under smooth maps. Therefore,
 it will lift nicely to manifolds. -/
-lemma cont_diff_within_at_local_invariant_prop (n : with_top ℕ) :
+lemma cont_diff_within_at_local_invariant_prop (n : ℕ∞) :
   (cont_diff_groupoid ∞ I).local_invariant_prop (cont_diff_groupoid ∞ I')
   (cont_diff_within_at_prop I I' n) :=
 { is_local :=
   begin
     assume s x u f u_open xu,
-    have : range I ∩ I.symm ⁻¹' (s ∩ u) = (range I ∩ I.symm ⁻¹' s) ∩ I.symm ⁻¹' u,
-      by simp only [inter_assoc, preimage_inter],
+    have : I.symm ⁻¹' (s ∩ u) ∩ range I = (I.symm ⁻¹' s ∩ range I) ∩ I.symm ⁻¹' u,
+      by simp only [inter_right_comm, preimage_inter],
     rw [cont_diff_within_at_prop, cont_diff_within_at_prop, this],
     symmetry,
     apply cont_diff_within_at_inter,
@@ -95,19 +119,21 @@ lemma cont_diff_within_at_local_invariant_prop (n : with_top ℕ) :
       by { rw [model_with_corners.left_inv], exact is_open.mem_nhds u_open xu },
     apply continuous_at.preimage_mem_nhds I.continuous_symm.continuous_at this,
   end,
-  right_invariance :=
+  right_invariance' :=
   begin
     assume s x f e he hx h,
     rw cont_diff_within_at_prop at h ⊢,
     have : I x = (I ∘ e.symm ∘ I.symm) (I (e x)), by simp only [hx] with mfld_simps,
     rw this at h,
-    have : I (e x) ∈ (I.symm) ⁻¹' e.target ∩ range ⇑I, by simp only [hx] with mfld_simps,
+    have : I (e x) ∈ (I.symm) ⁻¹' e.target ∩ range I, by simp only [hx] with mfld_simps,
     have := ((mem_groupoid_of_pregroupoid.2 he).2.cont_diff_within_at this).of_le le_top,
-    convert h.comp' _ this using 1,
+    convert (h.comp' _ this).mono_of_mem _ using 1,
     { ext y, simp only with mfld_simps },
-    { mfld_set_tac }
+    refine mem_nhds_within.mpr ⟨I.symm ⁻¹' e.target, e.open_target.preimage I.continuous_symm,
+      by simp_rw [mem_preimage, I.left_inv, e.maps_to hx], _⟩,
+    mfld_set_tac
   end,
-  congr :=
+  congr_of_forall :=
   begin
     assume s x f g h hx hf,
     apply hf.congr,
@@ -116,7 +142,7 @@ lemma cont_diff_within_at_local_invariant_prop (n : with_top ℕ) :
       simp only [h, hy] with mfld_simps },
     { simp only [hx] with mfld_simps }
   end,
-  left_invariance :=
+  left_invariance' :=
   begin
     assume s x f e' he' hs hx h,
     rw cont_diff_within_at_prop at h ⊢,
@@ -125,23 +151,23 @@ lemma cont_diff_within_at_local_invariant_prop (n : with_top ℕ) :
     have := ((mem_groupoid_of_pregroupoid.2 he').1.cont_diff_within_at A).of_le le_top,
     convert this.comp _ h _,
     { ext y, simp only with mfld_simps },
-    { assume y hy, simp only with mfld_simps at hy, simpa only [hy] with mfld_simps using hs hy.2 }
+    { assume y hy, simp only with mfld_simps at hy, simpa only [hy] with mfld_simps using hs hy.1 }
   end }
 
-lemma cont_diff_within_at_local_invariant_prop_mono (n : with_top ℕ)
-  ⦃s x t⦄ ⦃f : H → H'⦄ (hts : t ⊆ s) (h : cont_diff_within_at_prop I I' n f s x) :
+lemma cont_diff_within_at_prop_mono_of_mem (n : ℕ∞)
+  ⦃s x t⦄ ⦃f : H → H'⦄ (hts : s ∈ 𝓝[t] x) (h : cont_diff_within_at_prop I I' n f s x) :
   cont_diff_within_at_prop I I' n f t x :=
 begin
-  apply h.mono (λ y hy, _),
-  simp only with mfld_simps at hy,
-  simp only [hy, hts _] with mfld_simps
+  refine h.mono_of_mem _,
+  refine inter_mem _ (mem_of_superset self_mem_nhds_within $ inter_subset_right _ _),
+  rwa [← filter.mem_map, ← I.image_eq, I.symm_map_nhds_within_image]
 end
 
-lemma cont_diff_within_at_local_invariant_prop_id (x : H) :
-  cont_diff_within_at_prop I I ∞ id univ x :=
+lemma cont_diff_within_at_prop_id (x : H) :
+  cont_diff_within_at_prop I I n id univ x :=
 begin
   simp [cont_diff_within_at_prop],
-  have : cont_diff_within_at 𝕜 ∞ id (range I) (I x) :=
+  have : cont_diff_within_at 𝕜 n id (range I) (I x) :=
     cont_diff_id.cont_diff_at.cont_diff_within_at,
   apply this.congr (λ y hy, _),
   { simp only with mfld_simps },
@@ -151,27 +177,32 @@ end
 /-- A function is `n` times continuously differentiable within a set at a point in a manifold if
 it is continuous and it is `n` times continuously differentiable in this set around this point, when
 read in the preferred chart at this point. -/
-def cont_mdiff_within_at (n : with_top ℕ) (f : M → M') (s : set M) (x : M) :=
+def cont_mdiff_within_at (n : ℕ∞) (f : M → M') (s : set M) (x : M) :=
 lift_prop_within_at (cont_diff_within_at_prop I I' n) f s x
 
 /-- Abbreviation for `cont_mdiff_within_at I I' ⊤ f s x`. See also documentation for `smooth`.
 -/
 @[reducible] def smooth_within_at (f : M → M') (s : set M) (x : M) :=
-  cont_mdiff_within_at I I' ⊤ f s x
+cont_mdiff_within_at I I' ⊤ f s x
 
 /-- A function is `n` times continuously differentiable at a point in a manifold if
 it is continuous and it is `n` times continuously differentiable around this point, when
 read in the preferred chart at this point. -/
-def cont_mdiff_at (n : with_top ℕ) (f : M → M') (x : M) :=
+def cont_mdiff_at (n : ℕ∞) (f : M → M') (x : M) :=
 cont_mdiff_within_at I I' n f univ x
 
+lemma cont_mdiff_at_iff {n : ℕ∞} {f : M → M'} {x : M} :
+  cont_mdiff_at I I' n f x ↔ continuous_at f x ∧ cont_diff_within_at 𝕜 n
+    (ext_chart_at I' (f x) ∘ f ∘ (ext_chart_at I x).symm) (range I) (ext_chart_at I x x) :=
+lift_prop_at_iff.trans $ by { rw [cont_diff_within_at_prop, preimage_univ, univ_inter], refl }
+
 /-- Abbreviation for `cont_mdiff_at I I' ⊤ f x`. See also documentation for `smooth`. -/
 @[reducible] def smooth_at (f : M → M') (x : M) := cont_mdiff_at I I' ⊤ f x
 
 /-- A function is `n` times continuously differentiable in a set of a manifold if it is continuous
 and, for any pair of points, it is `n` times continuously differentiable on this set in the charts
 around these points. -/
-def cont_mdiff_on (n : with_top ℕ) (f : M → M') (s : set M) :=
+def cont_mdiff_on (n : ℕ∞) (f : M → M') (s : set M) :=
 ∀ x ∈ s, cont_mdiff_within_at I I' n f s x
 
 /-- Abbreviation for `cont_mdiff_on I I' ⊤ f s`. See also documentation for `smooth`. -/
@@ -180,7 +211,7 @@ def cont_mdiff_on (n : with_top ℕ) (f : M → M') (s : set M) :=
 /-- A function is `n` times continuously differentiable in a manifold if it is continuous
 and, for any pair of points, it is `n` times continuously differentiable in the charts
 around these points. -/
-def cont_mdiff (n : with_top ℕ) (f : M → M') :=
+def cont_mdiff (n : ℕ∞) (f : M → M') :=
 ∀ x, cont_mdiff_at I I' n f x
 
 /-- Abbreviation for `cont_mdiff I I' ⊤ f`.
@@ -225,7 +256,7 @@ lemma cont_mdiff_within_at_univ :
   cont_mdiff_within_at I I' n f univ x ↔ cont_mdiff_at I I' n f x :=
 iff.rfl
 
-lemma smooth_at_univ :
+lemma smooth_within_at_univ :
  smooth_within_at I I' f univ x ↔ smooth_at I I' f x := cont_mdiff_within_at_univ
 
 lemma cont_mdiff_on_univ :
@@ -233,41 +264,37 @@ lemma cont_mdiff_on_univ :
 by simp only [cont_mdiff_on, cont_mdiff, cont_mdiff_within_at_univ,
   forall_prop_of_true, mem_univ]
 
-lemma smooth_on_univ :
-  smooth_on I I' f univ ↔ smooth I I' f := cont_mdiff_on_univ
+lemma smooth_on_univ : smooth_on I I' f univ ↔ smooth I I' f := cont_mdiff_on_univ
 
 /-- One can reformulate smoothness within a set at a point as continuity within this set at this
 point, and smoothness in the corresponding extended chart. -/
 lemma cont_mdiff_within_at_iff :
   cont_mdiff_within_at I I' n f s x ↔ continuous_within_at f s x ∧
     cont_diff_within_at 𝕜 n ((ext_chart_at I' (f x)) ∘ f ∘ (ext_chart_at I x).symm)
-    ((ext_chart_at I x).target ∩
-      (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' (f x)).source))
+    ((ext_chart_at I x).symm ⁻¹' s ∩ range I)
     (ext_chart_at I x x) :=
-begin
-  rw [cont_mdiff_within_at, lift_prop_within_at, cont_diff_within_at_prop],
-  congr' 3,
-  mfld_set_tac
-end
+iff.rfl
 
 /-- One can reformulate smoothness within a set at a point as continuity within this set at this
 point, and smoothness in the corresponding extended chart. This form states smoothness of `f`
-written in the `ext_chart_at`s within the set `(ext_chart_at I x).symm ⁻¹' s ∩ range I`. This set
-is larger than the set
-`(ext_chart_at I x).target ∩ (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' (f x)).source)`
-used in `cont_mdiff_within_at_iff` but their germs at `ext_chart_at I x x` are equal. It may
-be useful to rewrite using `cont_mdiff_within_at_iff''` in the *assumptions* of a lemma and
-using `cont_mdiff_within_at_iff` in the goal. -/
-lemma cont_mdiff_within_at_iff'' :
+written in such a way that the set is restricted to lie within the domain/codomain of the
+corresponding charts.
+Even though this expression is more complicated than the one in `cont_mdiff_within_at_iff`, it is
+a smaller set, but their germs at `ext_chart_at I x x` are equal. It is sometimes useful to rewrite
+using this in the goal.
+-/
+lemma cont_mdiff_within_at_iff' :
   cont_mdiff_within_at I I' n f s x ↔ continuous_within_at f s x ∧
-    cont_diff_within_at 𝕜 n (written_in_ext_chart_at I I' x f)
-      ((ext_chart_at I x).symm ⁻¹' s ∩ range I) (ext_chart_at I x x) :=
+    cont_diff_within_at 𝕜 n ((ext_chart_at I' (f x)) ∘ f ∘ (ext_chart_at I x).symm)
+    ((ext_chart_at I x).target ∩
+      (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' (f x)).source))
+    (ext_chart_at I x x) :=
 begin
   rw [cont_mdiff_within_at_iff, and.congr_right_iff],
   set e := ext_chart_at I x, set e' := ext_chart_at I' (f x),
   refine λ hc, cont_diff_within_at_congr_nhds _,
-  rw [← e.image_source_inter_eq', ← ext_chart_at_map_nhds_within_eq_image,
-      ← ext_chart_at_map_nhds_within, inter_comm, nhds_within_inter_of_mem],
+  rw [← e.image_source_inter_eq', ← map_ext_chart_at_nhds_within_eq_image,
+      ← map_ext_chart_at_nhds_within, inter_comm, nhds_within_inter_of_mem],
   exact hc (ext_chart_at_source_mem_nhds _ _)
 end
 
@@ -275,85 +302,199 @@ end
 point, and smoothness in the corresponding extended chart in the target. -/
 lemma cont_mdiff_within_at_iff_target :
   cont_mdiff_within_at I I' n f s x ↔ continuous_within_at f s x ∧
-    cont_mdiff_within_at I 𝓘(𝕜, E') n ((ext_chart_at I' (f x)) ∘ f)
-    (s ∩ f ⁻¹' (ext_chart_at I' (f x)).source) x :=
+    cont_mdiff_within_at I 𝓘(𝕜, E') n (ext_chart_at I' (f x) ∘ f) s x :=
 begin
-  rw [cont_mdiff_within_at, cont_mdiff_within_at, lift_prop_within_at,
-    lift_prop_within_at, ← and_assoc],
+  simp_rw [cont_mdiff_within_at, lift_prop_within_at, ← and_assoc],
   have cont : (continuous_within_at f s x ∧
-      continuous_within_at ((I' ∘ (chart_at H' (f x))) ∘ f)
-      (s ∩ f ⁻¹' (chart_at H' (f x)).to_local_equiv.source) x) ↔
+      continuous_within_at (ext_chart_at I' (f x) ∘ f) s x) ↔
       continuous_within_at f s x,
   { refine ⟨λ h, h.1, λ h, ⟨h, _⟩⟩,
-    have h₁ : continuous_within_at _ univ ((chart_at H' (f x)) (f x)),
-    { exact (model_with_corners.continuous I').continuous_within_at },
     have h₂ := (chart_at H' (f x)).continuous_to_fun.continuous_within_at (mem_chart_source _ _),
-    convert (h₁.comp' h₂).comp' h,
-    simp },
-  simp [cont, cont_diff_within_at_prop]
+    refine ((I'.continuous_at.comp_continuous_within_at h₂).comp' h).mono_of_mem _,
+    exact inter_mem self_mem_nhds_within (h.preimage_mem_nhds_within $
+      (chart_at _ _).open_source.mem_nhds $ mem_chart_source _ _) },
+  simp_rw [cont, cont_diff_within_at_prop, ext_chart_at, local_homeomorph.extend,
+    local_equiv.coe_trans, model_with_corners.to_local_equiv_coe, local_homeomorph.coe_coe,
+    model_with_corners_self_coe, chart_at_self_eq, local_homeomorph.refl_apply, comp.left_id]
 end
 
 lemma smooth_within_at_iff :
   smooth_within_at I I' f s x ↔ continuous_within_at f s x ∧
-    cont_diff_within_at 𝕜 ∞ ((ext_chart_at I' (f x)) ∘ f ∘ (ext_chart_at I x).symm)
-    ((ext_chart_at I x).target ∩
-      (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' (f x)).source))
+    cont_diff_within_at 𝕜 ∞ (ext_chart_at I' (f x) ∘ f ∘ (ext_chart_at I x).symm)
+    ((ext_chart_at I x).symm ⁻¹' s ∩ range I)
     (ext_chart_at I x x) :=
 cont_mdiff_within_at_iff
 
 lemma smooth_within_at_iff_target :
   smooth_within_at I I' f s x ↔ continuous_within_at f s x ∧
-    smooth_within_at I 𝓘(𝕜, E') ((ext_chart_at I' (f x)) ∘ f)
-    (s ∩ f ⁻¹' (ext_chart_at I' (f x)).source) x :=
+    smooth_within_at I 𝓘(𝕜, E') (ext_chart_at I' (f x) ∘ f) s x :=
 cont_mdiff_within_at_iff_target
 
-lemma cont_mdiff_at_ext_chart_at :
-  cont_mdiff_at I 𝓘(𝕜, E) n (ext_chart_at I x) x :=
-begin
-  rw [cont_mdiff_at, cont_mdiff_within_at_iff],
-  refine ⟨(ext_chart_at_continuous_at _ _).continuous_within_at, _⟩,
-  refine cont_diff_within_at_id.congr _ _;
-    simp only with mfld_simps { contextual := tt }
-end
+lemma cont_mdiff_at_iff_target {x : M} :
+  cont_mdiff_at I I' n f x ↔
+    continuous_at f x ∧ cont_mdiff_at I 𝓘(𝕜, E') n (ext_chart_at I' (f x) ∘ f) x :=
+by rw [cont_mdiff_at, cont_mdiff_at, cont_mdiff_within_at_iff_target, continuous_within_at_univ]
+
+lemma smooth_at_iff_target {x : M} :
+  smooth_at I I' f x ↔ continuous_at f x ∧ smooth_at I 𝓘(𝕜, E') (ext_chart_at I' (f x) ∘ f) x :=
+cont_mdiff_at_iff_target
 
 include Is I's
 
+lemma cont_mdiff_within_at_iff_of_mem_maximal_atlas
+  {x : M} (he : e ∈ maximal_atlas I M) (he' : e' ∈ maximal_atlas I' M')
+  (hx : x ∈ e.source) (hy : f x ∈ e'.source) :
+  cont_mdiff_within_at I I' n f s x ↔ continuous_within_at f s x ∧
+    cont_diff_within_at 𝕜 n (e'.extend I' ∘ f ∘ (e.extend I).symm)
+    ((e.extend I).symm ⁻¹' s ∩ range I)
+    (e.extend I x) :=
+(cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart he hx he' hy
+
+/-- An alternative formulation of `cont_mdiff_within_at_iff_of_mem_maximal_atlas`
+  if the set if `s` lies in `e.source`. -/
+lemma cont_mdiff_within_at_iff_image {x : M} (he : e ∈ maximal_atlas I M)
+  (he' : e' ∈ maximal_atlas I' M') (hs : s ⊆ e.source) (hx : x ∈ e.source) (hy : f x ∈ e'.source) :
+  cont_mdiff_within_at I I' n f s x ↔ continuous_within_at f s x ∧
+  cont_diff_within_at 𝕜 n (e'.extend I' ∘ f ∘ (e.extend I).symm) (e.extend I '' s) (e.extend I x) :=
+begin
+  rw [cont_mdiff_within_at_iff_of_mem_maximal_atlas he he' hx hy, and.congr_right_iff],
+  refine λ hf, cont_diff_within_at_congr_nhds _,
+  simp_rw [nhds_within_eq_iff_eventually_eq,
+    e.extend_symm_preimage_inter_range_eventually_eq I hs hx]
+end
+
 /-- One can reformulate smoothness within a set at a point as continuity within this set at this
-point, and smoothness in the corresponding extended chart. -/
-lemma cont_mdiff_within_at_iff' {x' : M} {y : M'} (hx : x' ∈ (chart_at H x).source)
+point, and smoothness in any chart containing that point. -/
+lemma cont_mdiff_within_at_iff_of_mem_source
+  {x' : M} {y : M'} (hx : x' ∈ (chart_at H x).source)
+  (hy : f x' ∈ (chart_at H' y).source) :
+  cont_mdiff_within_at I I' n f s x' ↔ continuous_within_at f s x' ∧
+    cont_diff_within_at 𝕜 n (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
+    ((ext_chart_at I x).symm ⁻¹' s ∩ range I)
+    (ext_chart_at I x x') :=
+cont_mdiff_within_at_iff_of_mem_maximal_atlas
+  (chart_mem_maximal_atlas _ x) (chart_mem_maximal_atlas _ y) hx hy
+
+lemma cont_mdiff_within_at_iff_of_mem_source' {x' : M} {y : M'} (hx : x' ∈ (chart_at H x).source)
   (hy : f x' ∈ (chart_at H' y).source) :
   cont_mdiff_within_at I I' n f s x' ↔ continuous_within_at f s x' ∧
     cont_diff_within_at 𝕜 n ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
     ((ext_chart_at I x).target ∩ (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' y).source))
     (ext_chart_at I x x') :=
 begin
-  refine ((cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart
-    (structure_groupoid.chart_mem_maximal_atlas _ x) hx
-    (structure_groupoid.chart_mem_maximal_atlas _ y) hy).trans _,
-  rw [cont_diff_within_at_prop, iff_eq_eq],
-  congr' 2,
-  mfld_set_tac
+  refine (cont_mdiff_within_at_iff_of_mem_source hx hy).trans _,
+  rw [← ext_chart_at_source I] at hx,
+  rw [← ext_chart_at_source I'] at hy,
+  rw [and.congr_right_iff],
+  set e := ext_chart_at I x, set e' := ext_chart_at I' (f x),
+  refine λ hc, cont_diff_within_at_congr_nhds _,
+  rw [← e.image_source_inter_eq', ← map_ext_chart_at_nhds_within_eq_image' I x hx,
+      ← map_ext_chart_at_nhds_within' I x hx, inter_comm, nhds_within_inter_of_mem],
+  exact hc (ext_chart_at_source_mem_nhds' _ _ hy)
+end
+
+lemma cont_mdiff_at_iff_of_mem_source {x' : M} {y : M'} (hx : x' ∈ (chart_at H x).source)
+  (hy : f x' ∈ (chart_at H' y).source) :
+  cont_mdiff_at I I' n f x' ↔ continuous_at f x' ∧
+    cont_diff_within_at 𝕜 n (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
+    (range I)
+    (ext_chart_at I x x') :=
+(cont_mdiff_within_at_iff_of_mem_source hx hy).trans $
+  by rw [continuous_within_at_univ, preimage_univ, univ_inter]
+
+omit Is
+
+lemma cont_mdiff_within_at_iff_target_of_mem_source
+  {x : M} {y : M'} (hy : f x ∈ (chart_at H' y).source) :
+  cont_mdiff_within_at I I' n f s x ↔ continuous_within_at f s x ∧
+    cont_mdiff_within_at I 𝓘(𝕜, E') n (ext_chart_at I' y ∘ f) s x :=
+begin
+  simp_rw [cont_mdiff_within_at],
+  rw [(cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart_target
+    (chart_mem_maximal_atlas I' y) hy, and_congr_right],
+  intro hf,
+  simp_rw [structure_groupoid.lift_prop_within_at_self_target],
+  simp_rw [((chart_at H' y).continuous_at hy).comp_continuous_within_at hf],
+  rw [← ext_chart_at_source I'] at hy,
+  simp_rw [(continuous_at_ext_chart_at' I' _ hy).comp_continuous_within_at hf],
+  refl,
+end
+
+lemma cont_mdiff_at_iff_target_of_mem_source
+  {x : M} {y : M'} (hy : f x ∈ (chart_at H' y).source) :
+  cont_mdiff_at I I' n f x ↔ continuous_at f x ∧
+    cont_mdiff_at I 𝓘(𝕜, E') n (ext_chart_at I' y ∘ f) x :=
+begin
+  rw [cont_mdiff_at, cont_mdiff_within_at_iff_target_of_mem_source hy,
+    continuous_within_at_univ, cont_mdiff_at],
+  apply_instance
 end
 
 omit I's
+include Is
 
-lemma cont_mdiff_at_ext_chart_at' {x' : M} (h : x' ∈ (chart_at H x).source) :
-  cont_mdiff_at I 𝓘(𝕜, E) n (ext_chart_at I x) x' :=
+lemma cont_mdiff_within_at_iff_source_of_mem_maximal_atlas
+  (he : e ∈ maximal_atlas I M) (hx : x ∈ e.source) :
+  cont_mdiff_within_at I I' n f s x ↔
+    cont_mdiff_within_at 𝓘(𝕜, E) I' n (f ∘ (e.extend I).symm)
+      ((e.extend I).symm ⁻¹' s ∩ range I) (e.extend I x) :=
 begin
-  refine (cont_mdiff_within_at_iff' h (mem_chart_source _ _)).2 _,
-  refine ⟨(ext_chart_at_continuous_at' _ _ _).continuous_within_at, _⟩,
-  { rwa ext_chart_at_source },
-  refine cont_diff_within_at_id.congr' _ _;
-    simp only [h] with mfld_simps { contextual := tt }
+  have h2x := hx, rw [← e.extend_source I] at h2x,
+  simp_rw [cont_mdiff_within_at,
+    (cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart_source
+    he hx, structure_groupoid.lift_prop_within_at_self_source,
+    e.extend_symm_continuous_within_at_comp_right_iff, cont_diff_within_at_prop_self_source,
+    cont_diff_within_at_prop, function.comp, e.left_inv hx, (e.extend I).left_inv h2x],
+  refl,
 end
 
+lemma cont_mdiff_within_at_iff_source_of_mem_source
+  {x' : M} (hx' : x' ∈ (chart_at H x).source) :
+  cont_mdiff_within_at I I' n f s x' ↔
+    cont_mdiff_within_at 𝓘(𝕜, E) I' n (f ∘ (ext_chart_at I x).symm)
+    ((ext_chart_at I x).symm ⁻¹' s ∩ range I) (ext_chart_at I x x') :=
+cont_mdiff_within_at_iff_source_of_mem_maximal_atlas (chart_mem_maximal_atlas I x) hx'
+
+lemma cont_mdiff_at_iff_source_of_mem_source
+  {x' : M} (hx' : x' ∈ (chart_at H x).source) :
+  cont_mdiff_at I I' n f x' ↔ cont_mdiff_within_at 𝓘(𝕜, E) I' n (f ∘ (ext_chart_at I x).symm)
+    (range I) (ext_chart_at I x x') :=
+by simp_rw [cont_mdiff_at, cont_mdiff_within_at_iff_source_of_mem_source hx', preimage_univ,
+  univ_inter]
+
 include I's
 
+lemma cont_mdiff_on_iff_of_mem_maximal_atlas
+  (he : e ∈ maximal_atlas I M) (he' : e' ∈ maximal_atlas I' M')
+  (hs : s ⊆ e.source)
+  (h2s : maps_to f s e'.source) :
+  cont_mdiff_on I I' n f s ↔ continuous_on f s ∧
+    cont_diff_on 𝕜 n (e'.extend I' ∘ f ∘ (e.extend I).symm)
+    (e.extend I '' s) :=
+begin
+  simp_rw [continuous_on, cont_diff_on, set.ball_image_iff, ← forall_and_distrib, cont_mdiff_on],
+  exact forall₂_congr (λ x hx, cont_mdiff_within_at_iff_image he he' hs (hs hx) (h2s hx))
+end
+
+/-- If the set where you want `f` to be smooth lies entirely in a single chart, and `f` maps it
+  into a single chart, the smoothness of `f` on that set can be expressed by purely looking in
+  these charts.
+  Note: this lemma uses `ext_chart_at I x '' s` instead of `(ext_chart_at I x).symm ⁻¹' s` to ensure
+  that this set lies in `(ext_chart_at I x).target`. -/
+lemma cont_mdiff_on_iff_of_subset_source {x : M} {y : M'}
+  (hs : s ⊆ (chart_at H x).source)
+  (h2s : maps_to f s (chart_at H' y).source) :
+  cont_mdiff_on I I' n f s ↔ continuous_on f s ∧
+    cont_diff_on 𝕜 n (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
+    (ext_chart_at I x '' s) :=
+cont_mdiff_on_iff_of_mem_maximal_atlas
+  (chart_mem_maximal_atlas I x) (chart_mem_maximal_atlas I' y) hs h2s
+
 /-- One can reformulate smoothness on a set as continuity on this set, and smoothness in any
 extended chart. -/
 lemma cont_mdiff_on_iff :
   cont_mdiff_on I I' n f s ↔ continuous_on f s ∧
-    ∀ (x : M) (y : M'), cont_diff_on 𝕜 n ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
+    ∀ (x : M) (y : M'), cont_diff_on 𝕜 n (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
     ((ext_chart_at I x).target ∩
       (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' y).source)) :=
 begin
@@ -366,17 +507,14 @@ begin
     specialize h w this,
     have w1 : w ∈ (chart_at H x).source, by simp only [w, hz] with mfld_simps,
     have w2 : f w ∈ (chart_at H' y).source, by simp only [w, hz] with mfld_simps,
-    convert
-      (((cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart
-        (structure_groupoid.chart_mem_maximal_atlas _ x) w1
-        (structure_groupoid.chart_mem_maximal_atlas _ y) w2).1 h).2 using 1,
-    { mfld_set_tac },
-    { simp only [w, hz] with mfld_simps } },
+    convert ((cont_mdiff_within_at_iff_of_mem_source w1 w2).mp h).2.mono _,
+    { simp only [w, hz] with mfld_simps },
+    { mfld_set_tac } },
   { rintros ⟨hcont, hdiff⟩ x hx,
+    refine (cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_iff.mpr _,
     refine ⟨hcont x hx, _⟩,
-    have Z := hdiff x (f x) (ext_chart_at I x x) (by simp only [hx] with mfld_simps),
     dsimp [cont_diff_within_at_prop],
-    convert Z using 1,
+    convert hdiff x (f x) (ext_chart_at I x x) (by simp only [hx] with mfld_simps) using 1,
     mfld_set_tac }
 end
 
@@ -384,13 +522,13 @@ end
 extended chart in the target. -/
 lemma cont_mdiff_on_iff_target :
   cont_mdiff_on I I' n f s ↔ continuous_on f s ∧ ∀ (y : M'),
-    cont_mdiff_on I 𝓘(𝕜, E') n ((ext_chart_at I' y) ∘ f)
+    cont_mdiff_on I 𝓘(𝕜, E') n (ext_chart_at I' y ∘ f)
     (s ∩ f ⁻¹' (ext_chart_at I' y).source) :=
 begin
   inhabit E',
   simp only [cont_mdiff_on_iff, model_with_corners.source_eq, chart_at_self_eq,
-    local_homeomorph.refl_local_equiv, local_equiv.refl_trans, ext_chart_at.equations._eqn_1,
-    set.preimage_univ, set.inter_univ, and.congr_right_iff],
+    local_homeomorph.refl_local_equiv, local_equiv.refl_trans, ext_chart_at,
+    local_homeomorph.extend, set.preimage_univ, set.inter_univ, and.congr_right_iff],
   intros h,
   split,
   { refine λ h' y, ⟨_, λ x _, h' x y⟩,
@@ -402,21 +540,21 @@ end
 
 lemma smooth_on_iff :
   smooth_on I I' f s ↔ continuous_on f s ∧
-    ∀ (x : M) (y : M'), cont_diff_on 𝕜 ⊤ ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
+    ∀ (x : M) (y : M'), cont_diff_on 𝕜 ⊤ (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
     ((ext_chart_at I x).target ∩
       (ext_chart_at I x).symm ⁻¹' (s ∩ f ⁻¹' (ext_chart_at I' y).source)) :=
 cont_mdiff_on_iff
 
 lemma smooth_on_iff_target :
   smooth_on I I' f s ↔ continuous_on f s ∧ ∀ (y : M'),
-    smooth_on I 𝓘(𝕜, E') ((ext_chart_at I' y) ∘ f)
+    smooth_on I 𝓘(𝕜, E') (ext_chart_at I' y ∘ f)
     (s ∩ f ⁻¹' (ext_chart_at I' y).source) :=
 cont_mdiff_on_iff_target
 
 /-- One can reformulate smoothness as continuity and smoothness in any extended chart. -/
 lemma cont_mdiff_iff :
   cont_mdiff I I' n f ↔ continuous f ∧
-    ∀ (x : M) (y : M'), cont_diff_on 𝕜 n ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
+    ∀ (x : M) (y : M'), cont_diff_on 𝕜 n (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
     ((ext_chart_at I x).target ∩ (ext_chart_at I x).symm ⁻¹' (f ⁻¹' (ext_chart_at I' y).source)) :=
 by simp [← cont_mdiff_on_univ, cont_mdiff_on_iff, continuous_iff_continuous_on_univ]
 
@@ -424,7 +562,7 @@ by simp [← cont_mdiff_on_univ, cont_mdiff_on_iff, continuous_iff_continuous_on
 target. -/
 lemma cont_mdiff_iff_target :
   cont_mdiff I I' n f ↔ continuous f ∧
-    ∀ (y : M'), cont_mdiff_on I 𝓘(𝕜, E') n ((ext_chart_at I' y) ∘ f)
+    ∀ (y : M'), cont_mdiff_on I 𝓘(𝕜, E') n (ext_chart_at I' y ∘ f)
     (f ⁻¹' (ext_chart_at I' y).source) :=
 begin
   rw [← cont_mdiff_on_univ, cont_mdiff_on_iff_target],
@@ -433,12 +571,12 @@ end
 
 lemma smooth_iff :
   smooth I I' f ↔ continuous f ∧
-    ∀ (x : M) (y : M'), cont_diff_on 𝕜 ⊤ ((ext_chart_at I' y) ∘ f ∘ (ext_chart_at I x).symm)
+    ∀ (x : M) (y : M'), cont_diff_on 𝕜 ⊤ (ext_chart_at I' y ∘ f ∘ (ext_chart_at I x).symm)
     ((ext_chart_at I x).target ∩ (ext_chart_at I x).symm ⁻¹' (f ⁻¹' (ext_chart_at I' y).source)) :=
 cont_mdiff_iff
 
 lemma smooth_iff_target :
-  smooth I I' f ↔ continuous f ∧ ∀ (y : M'), smooth_on I 𝓘(𝕜, E') ((ext_chart_at I' y) ∘ f)
+  smooth I I' f ↔ continuous f ∧ ∀ (y : M'), smooth_on I 𝓘(𝕜, E') (ext_chart_at I' y ∘ f)
     (f ⁻¹' (ext_chart_at I' y).source) :=
 cont_mdiff_iff_target
 
@@ -481,7 +619,7 @@ lemma cont_mdiff.of_succ {n : ℕ} (h : cont_mdiff I I' n.succ f) :
   cont_mdiff I I' n f :=
 λ x, (h x).of_succ
 
-/-! ### Deducing continuity from smoothness-/
+/-! ### Deducing continuity from smoothness -/
 
 lemma cont_mdiff_within_at.continuous_within_at
   (hf : cont_mdiff_within_at I I' n f s x) : continuous_within_at f s x :=
@@ -499,43 +637,6 @@ lemma cont_mdiff.continuous (hf : cont_mdiff I I' n f) :
   continuous f :=
 continuous_iff_continuous_at.2 $ λ x, (hf x).continuous_at
 
-/-! ### Deducing differentiability from smoothness -/
-
-lemma cont_mdiff_within_at.mdifferentiable_within_at
-  (hf : cont_mdiff_within_at I I' n f s x) (hn : 1 ≤ n) :
-  mdifferentiable_within_at I I' f s x :=
-begin
-  suffices h : mdifferentiable_within_at I I' f (s ∩ (f ⁻¹' (ext_chart_at I' (f x)).source)) x,
-  { rwa mdifferentiable_within_at_inter' at h,
-    apply (hf.1).preimage_mem_nhds_within,
-    exact is_open.mem_nhds (ext_chart_at_open_source I' (f x)) (mem_ext_chart_source I' (f x)) },
-  rw mdifferentiable_within_at_iff,
-  exact ⟨hf.1.mono (inter_subset_left _ _),
-    (hf.2.differentiable_within_at hn).mono (by mfld_set_tac)⟩,
-end
-
-lemma cont_mdiff_at.mdifferentiable_at (hf : cont_mdiff_at I I' n f x) (hn : 1 ≤ n) :
-  mdifferentiable_at I I' f x :=
-mdifferentiable_within_at_univ.1 $ cont_mdiff_within_at.mdifferentiable_within_at hf hn
-
-lemma cont_mdiff_on.mdifferentiable_on (hf : cont_mdiff_on I I' n f s) (hn : 1 ≤ n) :
-  mdifferentiable_on I I' f s :=
-λ x hx, (hf x hx).mdifferentiable_within_at hn
-
-lemma cont_mdiff.mdifferentiable (hf : cont_mdiff I I' n f) (hn : 1 ≤ n) :
-  mdifferentiable I I' f :=
-λ x, (hf x).mdifferentiable_at hn
-
-lemma smooth.mdifferentiable (hf : smooth I I' f) : mdifferentiable I I' f :=
-cont_mdiff.mdifferentiable hf le_top
-
-lemma smooth.mdifferentiable_at (hf : smooth I I' f) : mdifferentiable_at I I' f x :=
-hf.mdifferentiable x
-
-lemma smooth.mdifferentiable_within_at (hf : smooth I I' f) :
-  mdifferentiable_within_at I I' f s x :=
-hf.mdifferentiable_at.mdifferentiable_within_at
-
 /-! ### `C^∞` smoothness -/
 
 lemma cont_mdiff_within_at_top :
@@ -557,7 +658,7 @@ lemma cont_mdiff_top :
 
 lemma cont_mdiff_within_at_iff_nat :
   cont_mdiff_within_at I I' n f s x ↔
-  (∀m:ℕ, (m : with_top ℕ) ≤ n → cont_mdiff_within_at I I' m f s x) :=
+  (∀m:ℕ, (m : ℕ∞) ≤ n → cont_mdiff_within_at I I' m f s x) :=
 begin
   refine ⟨λ h m hm, h.of_le hm, λ h, _⟩,
   cases n,
@@ -567,10 +668,19 @@ end
 
 /-! ### Restriction to a smaller set -/
 
+lemma cont_mdiff_within_at.mono_of_mem (hf : cont_mdiff_within_at I I' n f s x)
+  (hts : s ∈ 𝓝[t] x) : cont_mdiff_within_at I I' n f t x :=
+structure_groupoid.local_invariant_prop.lift_prop_within_at_mono_of_mem
+  (cont_diff_within_at_prop_mono_of_mem I I' n) hf hts
+
 lemma cont_mdiff_within_at.mono (hf : cont_mdiff_within_at I I' n f s x) (hts : t ⊆ s) :
   cont_mdiff_within_at I I' n f t x :=
-structure_groupoid.local_invariant_prop.lift_prop_within_at_mono
-  (cont_diff_within_at_local_invariant_prop_mono I I' n) hf hts
+hf.mono_of_mem $ mem_of_superset self_mem_nhds_within hts
+
+lemma cont_mdiff_within_at_congr_nhds (hst : 𝓝[s] x = 𝓝[t] x) :
+  cont_mdiff_within_at I I' n f s x ↔ cont_mdiff_within_at I I' n f t x :=
+⟨λ h, h.mono_of_mem $ hst ▸ self_mem_nhds_within,
+  λ h, h.mono_of_mem $ hst.symm ▸ self_mem_nhds_within⟩
 
 lemma cont_mdiff_at.cont_mdiff_within_at (hf : cont_mdiff_at I I' n f x) :
   cont_mdiff_within_at I I' n f s x :=
@@ -610,11 +720,26 @@ lemma smooth_within_at.smooth_at
   smooth_at I I' f x :=
 cont_mdiff_within_at.cont_mdiff_at h ht
 
+lemma cont_mdiff_on.cont_mdiff_at (h : cont_mdiff_on I I' n f s) (hx : s ∈ 𝓝 x) :
+  cont_mdiff_at I I' n f x :=
+(h x (mem_of_mem_nhds hx)).cont_mdiff_at hx
+
+lemma smooth_on.smooth_at (h : smooth_on I I' f s) (hx : s ∈ 𝓝 x) : smooth_at I I' f x :=
+h.cont_mdiff_at hx
+
 include Is
 
-lemma cont_mdiff_on_ext_chart_at :
-  cont_mdiff_on I 𝓘(𝕜, E) n (ext_chart_at I x) (chart_at H x).source :=
-λ x' hx', (cont_mdiff_at_ext_chart_at' hx').cont_mdiff_within_at
+lemma cont_mdiff_on_iff_source_of_mem_maximal_atlas
+  (he : e ∈ maximal_atlas I M) (hs : s ⊆ e.source) :
+  cont_mdiff_on I I' n f s ↔ cont_mdiff_on 𝓘(𝕜, E) I' n (f ∘ (e.extend I).symm) (e.extend I '' s) :=
+begin
+  simp_rw [cont_mdiff_on, set.ball_image_iff],
+  refine forall₂_congr (λ x hx, _),
+  rw [cont_mdiff_within_at_iff_source_of_mem_maximal_atlas he (hs hx)],
+  apply cont_mdiff_within_at_congr_nhds,
+  simp_rw [nhds_within_eq_iff_eventually_eq,
+    e.extend_symm_preimage_inter_range_eventually_eq I hs (hs hx)]
+end
 
 include I's
 
@@ -638,8 +763,7 @@ begin
       { assume y hy, exact hy.2 },
       { assume y hy, exact hu ⟨hy.1.1, hy.2⟩ } },
     have h' : cont_mdiff_within_at I I' n f (s ∩ o) x := h.mono (inter_subset_left _ _),
-    simp only [cont_mdiff_within_at, lift_prop_within_at, cont_diff_within_at_prop]
-      at h',
+    simp only [cont_mdiff_within_at, lift_prop_within_at, cont_diff_within_at_prop] at h',
     -- let `u` be a good neighborhood in the chart where the function is smooth
     rcases h.2.cont_diff_on le_rfl with ⟨u, u_nhds, u_subset, hu⟩,
     -- pull it back to the manifold, and intersect with a suitable neighborhood of `x`, to get the
@@ -656,7 +780,7 @@ begin
     { rw nhds_within_restrict _ xo o_open,
       refine filter.inter_mem self_mem_nhds_within _,
       suffices : u ∈ 𝓝[(ext_chart_at I x) '' (insert x s ∩ o)] (ext_chart_at I x x),
-        from (ext_chart_at_continuous_at I x).continuous_within_at.preimage_mem_nhds_within' this,
+        from (continuous_at_ext_chart_at I x).continuous_within_at.preimage_mem_nhds_within' this,
       apply nhds_within_mono _ _ u_nhds,
       rw image_subset_iff,
       assume y hy,
@@ -665,13 +789,9 @@ begin
       { simp only [mem_insert_iff, ho hy.2, h', h'o ⟨hy.2, h'⟩] with mfld_simps } },
     show cont_mdiff_on I I' n f v,
     { assume y hy,
-      apply
-        (((cont_diff_within_at_local_invariant_prop I I' n).lift_prop_within_at_indep_chart
-        (structure_groupoid.chart_mem_maximal_atlas _ x) (v_incl hy)
-        (structure_groupoid.chart_mem_maximal_atlas _ (f x)) (v_incl' y hy))).2,
-      split,
-      { apply (((ext_chart_at_continuous_on_symm I' (f x) _ _).comp'
-          (hu _ hy.2).continuous_within_at).comp' (ext_chart_at_continuous_on I x _ _)).congr_mono,
+      have : continuous_within_at f v y,
+      { apply (((continuous_on_ext_chart_at_symm I' (f x) _ _).comp'
+          (hu _ hy.2).continuous_within_at).comp' (continuous_on_ext_chart_at I x _ _)).congr_mono,
         { assume z hz,
           simp only [v_incl hz, v_incl' z hz] with mfld_simps },
         { assume z hz,
@@ -680,6 +800,7 @@ begin
         { simp only [v_incl hy, v_incl' y hy] with mfld_simps },
         { simp only [v_incl hy, v_incl' y hy] with mfld_simps },
         { simp only [v_incl hy] with mfld_simps } },
+      refine (cont_mdiff_within_at_iff_of_mem_source' (v_incl hy) (v_incl' y hy)).mpr ⟨this, _⟩,
       { apply hu.mono,
         { assume z hz,
           simp only [v] with mfld_simps at hz,
@@ -702,6 +823,18 @@ lemma cont_mdiff_at_iff_cont_mdiff_on_nhds {n : ℕ} :
 by simp [← cont_mdiff_within_at_univ, cont_mdiff_within_at_iff_cont_mdiff_on_nhds,
   nhds_within_univ]
 
+/-- Note: This does not hold for `n = ∞`. `f` being `C^∞` at `x` means that for every `n`, `f` is
+`C^n` on some neighborhood of `x`, but this neighborhood can depend on `n`. -/
+lemma cont_mdiff_at_iff_cont_mdiff_at_nhds {n : ℕ} :
+  cont_mdiff_at I I' n f x ↔ ∀ᶠ x' in 𝓝 x, cont_mdiff_at I I' n f x' :=
+begin
+  refine ⟨_, λ h, h.self_of_nhds⟩,
+  rw [cont_mdiff_at_iff_cont_mdiff_on_nhds],
+  rintro ⟨u, hu, h⟩,
+  refine (eventually_mem_nhds.mpr hu).mono (λ x' hx', _),
+  exact (h x' $ mem_of_mem_nhds hx').cont_mdiff_at hx'
+end
+
 omit Is I's
 
 /-! ### Congruence lemmas -/
@@ -761,17 +894,13 @@ lemma cont_mdiff_of_locally_cont_mdiff_on
 
 section composition
 
-variables {E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
-{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
-{M'' : Type*} [topological_space M''] [charted_space H'' M'']
-
 /-- The composition of `C^n` functions within domains at points is `C^n`. -/
 lemma cont_mdiff_within_at.comp {t : set M'} {g : M' → M''} (x : M)
   (hg : cont_mdiff_within_at I' I'' n g t (f x))
   (hf : cont_mdiff_within_at I I' n f s x)
   (st : maps_to f s t) : cont_mdiff_within_at I I'' n (g ∘ f) s x :=
 begin
-  rw cont_mdiff_within_at_iff'' at hg hf ⊢,
+  rw cont_mdiff_within_at_iff at hg hf ⊢,
   refine ⟨hg.1.comp hf.1 st, _⟩,
   set e := ext_chart_at I x,
   set e' := ext_chart_at I' (f x),
@@ -781,7 +910,7 @@ begin
   rw this at hg,
   have A : ∀ᶠ y in 𝓝[e.symm ⁻¹' s ∩ range I] e x,
     y ∈ e.target ∧ f (e.symm y) ∈ t ∧ f (e.symm y) ∈ e'.source ∧ g (f (e.symm y)) ∈ e''.source,
-  { simp only [← ext_chart_at_map_nhds_within, eventually_map],
+  { simp only [← map_ext_chart_at_nhds_within, eventually_map],
     filter_upwards [hf.1.tendsto (ext_chart_at_source_mem_nhds I' (f x)),
       (hg.1.comp hf.1 st).tendsto (ext_chart_at_source_mem_nhds I'' (g (f x))),
       (inter_mem_nhds_within s (ext_chart_at_source_mem_nhds I x))],
@@ -791,7 +920,7 @@ begin
     (inter_mem _ self_mem_nhds_within)).congr_of_eventually_eq _ _,
   { filter_upwards [A],
     rintro x' ⟨hx', ht, hfx', hgfx'⟩,
-    simp only [*, mem_preimage, written_in_ext_chart_at, (∘), mem_inter_eq, e'.left_inv, true_and],
+    simp only [*, mem_preimage, written_in_ext_chart_at, (∘), mem_inter_iff, e'.left_inv, true_and],
     exact mem_range_self _ },
   { filter_upwards [A],
     rintro x' ⟨hx', ht, hfx', hgfx'⟩,
@@ -799,18 +928,44 @@ begin
   { simp only [written_in_ext_chart_at, (∘), mem_ext_chart_source, e.left_inv, e'.left_inv] }
 end
 
+/-- See note [comp_of_eq lemmas] -/
+lemma cont_mdiff_within_at.comp_of_eq {t : set M'} {g : M' → M''} {x : M} {y : M'}
+  (hg : cont_mdiff_within_at I' I'' n g t y) (hf : cont_mdiff_within_at I I' n f s x)
+  (st : maps_to f s t) (hx : f x = y) :
+  cont_mdiff_within_at I I'' n (g ∘ f) s x :=
+by { subst hx, exact hg.comp x hf st }
+
+/-- The composition of `C^∞` functions within domains at points is `C^∞`. -/
+lemma smooth_within_at.comp {t : set M'} {g : M' → M''} (x : M)
+  (hg : smooth_within_at I' I'' g t (f x))
+  (hf : smooth_within_at I I' f s x)
+  (st : maps_to f s t) : smooth_within_at I I'' (g ∘ f) s x :=
+hg.comp x hf st
+
 /-- The composition of `C^n` functions on domains is `C^n`. -/
 lemma cont_mdiff_on.comp {t : set M'} {g : M' → M''}
   (hg : cont_mdiff_on I' I'' n g t) (hf : cont_mdiff_on I I' n f s)
   (st : s ⊆ f ⁻¹' t) : cont_mdiff_on I I'' n (g ∘ f) s :=
 λ x hx, (hg _ (st hx)).comp x (hf x hx) st
 
+/-- The composition of `C^∞` functions on domains is `C^∞`. -/
+lemma smooth_on.comp {t : set M'} {g : M' → M''}
+  (hg : smooth_on I' I'' g t) (hf : smooth_on I I' f s)
+  (st : s ⊆ f ⁻¹' t) : smooth_on I I'' (g ∘ f) s :=
+hg.comp hf st
+
 /-- The composition of `C^n` functions on domains is `C^n`. -/
 lemma cont_mdiff_on.comp' {t : set M'} {g : M' → M''}
   (hg : cont_mdiff_on I' I'' n g t) (hf : cont_mdiff_on I I' n f s) :
   cont_mdiff_on I I'' n (g ∘ f) (s ∩ f ⁻¹' t) :=
 hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)
 
+/-- The composition of `C^∞` functions is `C^∞`. -/
+lemma smooth_on.comp' {t : set M'} {g : M' → M''}
+  (hg : smooth_on I' I'' g t) (hf : smooth_on I I' f s) :
+  smooth_on I I'' (g ∘ f) (s ∩ f ⁻¹' t) :=
+hg.comp' hf
+
 /-- The composition of `C^n` functions is `C^n`. -/
 lemma cont_mdiff.comp {g : M' → M''}
   (hg : cont_mdiff I' I'' n g) (hf : cont_mdiff I I' n f) :
@@ -820,6 +975,11 @@ begin
   exact hg.comp hf subset_preimage_univ,
 end
 
+/-- The composition of `C^∞` functions is `C^∞`. -/
+lemma smooth.comp {g : M' → M''} (hg : smooth I' I'' g) (hf : smooth I I' f) :
+  smooth I I'' (g ∘ f) :=
+hg.comp hf
+
 /-- The composition of `C^n` functions within domains at points is `C^n`. -/
 lemma cont_mdiff_within_at.comp' {t : set M'} {g : M' → M''} (x : M)
   (hg : cont_mdiff_within_at I' I'' n g t (f x))
@@ -827,6 +987,13 @@ lemma cont_mdiff_within_at.comp' {t : set M'} {g : M' → M''} (x : M)
   cont_mdiff_within_at I I'' n (g ∘ f) (s ∩ f⁻¹' t) x :=
 hg.comp x (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)
 
+/-- The composition of `C^∞` functions within domains at points is `C^∞`. -/
+lemma smooth_within_at.comp' {t : set M'} {g : M' → M''} (x : M)
+  (hg : smooth_within_at I' I'' g t (f x))
+  (hf : smooth_within_at I I' f s x) :
+  smooth_within_at I I'' (g ∘ f) (s ∩ f⁻¹' t) x :=
+hg.comp' x hf
+
 /-- `g ∘ f` is `C^n` within `s` at `x` if `g` is `C^n` at `f x` and
 `f` is `C^n` within `s` at `x`. -/
 lemma cont_mdiff_at.comp_cont_mdiff_within_at {g : M' → M''} (x : M)
@@ -834,12 +1001,32 @@ lemma cont_mdiff_at.comp_cont_mdiff_within_at {g : M' → M''} (x : M)
   cont_mdiff_within_at I I'' n (g ∘ f) s x :=
 hg.comp x hf (maps_to_univ _ _)
 
+/-- `g ∘ f` is `C^∞` within `s` at `x` if `g` is `C^∞` at `f x` and
+`f` is `C^∞` within `s` at `x`. -/
+lemma smooth_at.comp_smooth_within_at {g : M' → M''} (x : M)
+  (hg : smooth_at I' I'' g (f x)) (hf : smooth_within_at I I' f s x) :
+  smooth_within_at I I'' (g ∘ f) s x :=
+hg.comp_cont_mdiff_within_at x hf
+
 /-- The composition of `C^n` functions at points is `C^n`. -/
 lemma cont_mdiff_at.comp {g : M' → M''} (x : M)
   (hg : cont_mdiff_at I' I'' n g (f x)) (hf : cont_mdiff_at I I' n f x) :
   cont_mdiff_at I I'' n (g ∘ f) x :=
 hg.comp x hf (maps_to_univ _ _)
 
+/-- See note [comp_of_eq lemmas] -/
+lemma cont_mdiff_at.comp_of_eq {g : M' → M''} {x : M} {y : M'}
+  (hg : cont_mdiff_at I' I'' n g y) (hf : cont_mdiff_at I I' n f x) (hx : f x = y) :
+  cont_mdiff_at I I'' n (g ∘ f) x :=
+by { subst hx, exact hg.comp x hf }
+
+
+/-- The composition of `C^∞` functions at points is `C^∞`. -/
+lemma smooth_at.comp {g : M' → M''} (x : M)
+  (hg : smooth_at I' I'' g (f x)) (hf : smooth_at I I' f x) :
+  smooth_at I I'' (g ∘ f) x :=
+hg.comp x hf
+
 lemma cont_mdiff.comp_cont_mdiff_on {f : M → M'} {g : M' → M''} {s : set M}
   (hg : cont_mdiff I' I'' n g) (hf : cont_mdiff_on I I' n f s) :
   cont_mdiff_on I I'' n (g ∘ f) s :=
@@ -850,12 +1037,39 @@ lemma smooth.comp_smooth_on {f : M → M'} {g : M' → M''} {s : set M}
   smooth_on I I'' (g ∘ f) s :=
 hg.smooth_on.comp hf set.subset_preimage_univ
 
+lemma cont_mdiff_on.comp_cont_mdiff {t : set M'} {g : M' → M''}
+  (hg : cont_mdiff_on I' I'' n g t) (hf : cont_mdiff I I' n f)
+  (ht : ∀ x, f x ∈ t) : cont_mdiff I I'' n (g ∘ f) :=
+cont_mdiff_on_univ.mp $ hg.comp hf.cont_mdiff_on (λ x _, ht x)
+
+lemma smooth_on.comp_smooth {t : set M'} {g : M' → M''}
+  (hg : smooth_on I' I'' g t) (hf : smooth I I' f)
+  (ht : ∀ x, f x ∈ t) : smooth I I'' (g ∘ f) :=
+hg.comp_cont_mdiff hf ht
+
 end composition
 
 /-! ### Atlas members are smooth -/
 section atlas
 
-variables {e : local_homeomorph M H}
+lemma cont_mdiff_model : cont_mdiff I 𝓘(𝕜, E) n I :=
+begin
+  intro x,
+  refine (cont_mdiff_at_iff _ _).mpr ⟨I.continuous_at, _⟩,
+  simp only with mfld_simps,
+  refine cont_diff_within_at_id.congr_of_eventually_eq _ _,
+  { exact eventually_eq_of_mem self_mem_nhds_within (λ x₂, I.right_inv) },
+  simp_rw [function.comp_apply, I.left_inv, id_def]
+end
+
+lemma cont_mdiff_on_model_symm : cont_mdiff_on 𝓘(𝕜, E) I n I.symm (range I) :=
+begin
+  rw [cont_mdiff_on_iff],
+  refine ⟨I.continuous_on_symm, λ x y, _⟩,
+  simp only with mfld_simps,
+  exact cont_diff_on_id.congr (λ x', I.right_inv)
+end
+
 include Is
 
 /-- An atlas member is `C^n` for any `n`. -/
@@ -863,24 +1077,69 @@ lemma cont_mdiff_on_of_mem_maximal_atlas
   (h : e ∈ maximal_atlas I M) : cont_mdiff_on I I n e e.source :=
 cont_mdiff_on.of_le
   ((cont_diff_within_at_local_invariant_prop I I ∞).lift_prop_on_of_mem_maximal_atlas
-    (cont_diff_within_at_local_invariant_prop_id I) h) le_top
+    (cont_diff_within_at_prop_id I) h) le_top
 
 /-- The inverse of an atlas member is `C^n` for any `n`. -/
 lemma cont_mdiff_on_symm_of_mem_maximal_atlas
   (h : e ∈ maximal_atlas I M) : cont_mdiff_on I I n e.symm e.target :=
 cont_mdiff_on.of_le
   ((cont_diff_within_at_local_invariant_prop I I ∞).lift_prop_on_symm_of_mem_maximal_atlas
-    (cont_diff_within_at_local_invariant_prop_id I) h) le_top
+    (cont_diff_within_at_prop_id I) h) le_top
+
+lemma cont_mdiff_at_of_mem_maximal_atlas (h : e ∈ maximal_atlas I M) (hx : x ∈ e.source) :
+  cont_mdiff_at I I n e x :=
+(cont_mdiff_on_of_mem_maximal_atlas h).cont_mdiff_at $ e.open_source.mem_nhds hx
+
+lemma cont_mdiff_at_symm_of_mem_maximal_atlas {x : H}
+  (h : e ∈ maximal_atlas I M) (hx : x ∈ e.target) : cont_mdiff_at I I n e.symm x :=
+(cont_mdiff_on_symm_of_mem_maximal_atlas h).cont_mdiff_at $ e.open_target.mem_nhds hx
 
 lemma cont_mdiff_on_chart :
   cont_mdiff_on I I n (chart_at H x) (chart_at H x).source :=
-cont_mdiff_on_of_mem_maximal_atlas
-  ((cont_diff_groupoid ⊤ I).chart_mem_maximal_atlas x)
+cont_mdiff_on_of_mem_maximal_atlas $ chart_mem_maximal_atlas I x
 
 lemma cont_mdiff_on_chart_symm :
   cont_mdiff_on I I n (chart_at H x).symm (chart_at H x).target :=
-cont_mdiff_on_symm_of_mem_maximal_atlas
-  ((cont_diff_groupoid ⊤ I).chart_mem_maximal_atlas x)
+cont_mdiff_on_symm_of_mem_maximal_atlas $ chart_mem_maximal_atlas I x
+
+lemma cont_mdiff_at_extend {x : M} (he : e ∈ maximal_atlas I M) (hx : x ∈ e.source) :
+  cont_mdiff_at I 𝓘(𝕜, E) n (e.extend I) x :=
+(cont_mdiff_model _).comp x $ cont_mdiff_at_of_mem_maximal_atlas he hx
+
+lemma cont_mdiff_at_ext_chart_at' {x' : M} (h : x' ∈ (chart_at H x).source) :
+  cont_mdiff_at I 𝓘(𝕜, E) n (ext_chart_at I x) x' :=
+cont_mdiff_at_extend (chart_mem_maximal_atlas I x) h
+
+lemma cont_mdiff_at_ext_chart_at : cont_mdiff_at I 𝓘(𝕜, E) n (ext_chart_at I x) x :=
+cont_mdiff_at_ext_chart_at' $ mem_chart_source H x
+
+lemma cont_mdiff_on_ext_chart_at :
+  cont_mdiff_on I 𝓘(𝕜, E) n (ext_chart_at I x) (chart_at H x).source :=
+λ x' hx', (cont_mdiff_at_ext_chart_at' hx').cont_mdiff_within_at
+
+lemma cont_mdiff_on_extend_symm (he : e ∈ maximal_atlas I M) :
+  cont_mdiff_on 𝓘(𝕜, E) I n (e.extend I).symm (I '' e.target) :=
+begin
+  have h2 := cont_mdiff_on_symm_of_mem_maximal_atlas he,
+  refine h2.comp (cont_mdiff_on_model_symm.mono $ image_subset_range _ _) _,
+  simp_rw [image_subset_iff, local_equiv.restr_coe_symm, I.to_local_equiv_coe_symm,
+    preimage_preimage, I.left_inv, preimage_id']
+end
+
+lemma cont_mdiff_on_ext_chart_at_symm (x : M) :
+  cont_mdiff_on 𝓘(𝕜, E) I n (ext_chart_at I x).symm (ext_chart_at I x).target :=
+begin
+  convert cont_mdiff_on_extend_symm (chart_mem_maximal_atlas I x),
+  rw [ext_chart_at_target, I.image_eq]
+end
+
+omit Is
+
+/-- An element of `cont_diff_groupoid ⊤ I` is `C^n` for any `n`. -/
+lemma cont_mdiff_on_of_mem_cont_diff_groupoid {e' : local_homeomorph H H}
+  (h : e' ∈ cont_diff_groupoid ⊤ I) : cont_mdiff_on I I n e' e'.source :=
+(cont_diff_within_at_local_invariant_prop I I n).lift_prop_on_of_mem_groupoid
+  (cont_diff_within_at_prop_id I) h
 
 end atlas
 
@@ -889,7 +1148,7 @@ section id
 
 lemma cont_mdiff_id : cont_mdiff I I n (id : M → M) :=
 cont_mdiff.of_le ((cont_diff_within_at_local_invariant_prop I I ∞).lift_prop_id
-  (cont_diff_within_at_local_invariant_prop_id I)) le_top
+  (cont_diff_within_at_prop_id I)) le_top
 
 lemma smooth_id : smooth I I (id : M → M) := cont_mdiff_id
 
@@ -989,6 +1248,28 @@ begin
     exact cont_mdiff_at_const }
 end
 
+/-! ### The inclusion map from one open set to another is smooth -/
+section
+open topological_space
+
+lemma cont_mdiff_inclusion {n : ℕ∞} {U V : opens M} (h : U ≤ V) :
+  cont_mdiff I I n (set.inclusion h : U → V) :=
+begin
+  rintros ⟨x, hx : x ∈ U⟩,
+  apply (cont_diff_within_at_local_invariant_prop I I n).lift_prop_inclusion,
+  intros y,
+  dsimp [cont_diff_within_at_prop],
+  rw [set.univ_inter],
+  refine cont_diff_within_at_id.congr _ _,
+  { exact I.right_inv_on },
+  { exact congr_arg I (I.left_inv y) },
+end
+
+lemma smooth_inclusion {U V : opens M} (h : U ≤ V) : smooth I I (set.inclusion h : U → V) :=
+cont_mdiff_inclusion h
+
+end
+
 /-! ### Equivalence with the basic definition for functions between vector spaces -/
 
 section module
@@ -1032,555 +1313,30 @@ by rw [← cont_diff_on_univ, ← cont_mdiff_on_univ,
 alias cont_mdiff_iff_cont_diff ↔
   cont_mdiff.cont_diff cont_diff.cont_mdiff
 
-end module
-
-/-! ### The tangent map of a smooth function is smooth -/
-
-section tangent_map
-
-/-- If a function is `C^n` with `1 ≤ n` on a domain with unique derivatives, then its bundled
-derivative is continuous. In this auxiliary lemma, we prove this fact when the source and target
-space are model spaces in models with corners. The general fact is proved in
-`cont_mdiff_on.continuous_on_tangent_map_within`-/
-lemma cont_mdiff_on.continuous_on_tangent_map_within_aux
-  {f : H → H'} {s : set H}
-  (hf : cont_mdiff_on I I' n f s) (hn : 1 ≤ n) (hs : unique_mdiff_on I s) :
-  continuous_on (tangent_map_within I I' f s) ((tangent_bundle.proj I H) ⁻¹' s) :=
-begin
-  suffices h : continuous_on (λ (p : H × E), (f p.fst,
-    (fderiv_within 𝕜 (written_in_ext_chart_at I I' p.fst f) (I.symm ⁻¹' s ∩ range I)
-      ((ext_chart_at I p.fst) p.fst) : E →L[𝕜] E') p.snd)) (prod.fst ⁻¹' s),
-  { have A := (tangent_bundle_model_space_homeomorph H I).continuous,
-    rw continuous_iff_continuous_on_univ at A,
-    have B := ((tangent_bundle_model_space_homeomorph H' I').symm.continuous.comp_continuous_on h)
-      .comp' A,
-    have : (univ ∩ ⇑(tangent_bundle_model_space_homeomorph H I) ⁻¹' (prod.fst ⁻¹' s)) =
-      tangent_bundle.proj I H ⁻¹' s,
-      by { ext ⟨x, v⟩, simp only with mfld_simps },
-    rw this at B,
-    apply B.congr,
-    rintros ⟨x, v⟩ hx,
-    dsimp [tangent_map_within],
-    ext, { refl },
-    simp only with mfld_simps,
-    apply congr_fun,
-    apply congr_arg,
-    rw mdifferentiable_within_at.mfderiv_within (hf.mdifferentiable_on hn x hx),
-    refl },
-  suffices h : continuous_on (λ (p : H × E), (fderiv_within 𝕜 (I' ∘ f ∘ I.symm)
-    (I.symm ⁻¹' s ∩ range I) (I p.fst) : E →L[𝕜] E') p.snd) (prod.fst ⁻¹' s),
-  { dsimp [written_in_ext_chart_at, ext_chart_at],
-    apply continuous_on.prod
-      (continuous_on.comp hf.continuous_on continuous_fst.continuous_on (subset.refl _)),
-    apply h.congr,
-    assume p hp,
-    refl },
-  suffices h : continuous_on (fderiv_within 𝕜 (I' ∘ f ∘ I.symm)
-                     (I.symm ⁻¹' s ∩ range I)) (I '' s),
-  { have C := continuous_on.comp h I.continuous_to_fun.continuous_on (subset.refl _),
-    have A : continuous (λq : (E →L[𝕜] E') × E, q.1 q.2) :=
-      is_bounded_bilinear_map_apply.continuous,
-    have B : continuous_on (λp : H × E,
-      (fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I)
-                       (I p.1), p.2)) (prod.fst ⁻¹' s),
-    { apply continuous_on.prod _ continuous_snd.continuous_on,
-      refine (continuous_on.comp C continuous_fst.continuous_on _ : _),
-      exact preimage_mono (subset_preimage_image _ _) },
-    exact A.comp_continuous_on B },
-  rw cont_mdiff_on_iff at hf,
-  let x : H := I.symm (0 : E),
-  let y : H' := I'.symm (0 : E'),
-  have A := hf.2 x y,
-  simp only [I.image_eq, inter_comm] with mfld_simps at A ⊢,
-  apply A.continuous_on_fderiv_within _ hn,
-  convert hs.unique_diff_on_target_inter x using 1,
-  simp only [inter_comm] with mfld_simps
-end
-
-/-- If a function is `C^n` on a domain with unique derivatives, then its bundled derivative is
-`C^m` when `m+1 ≤ n`. In this auxiliary lemma, we prove this fact when the source and target space
-are model spaces in models with corners. The general fact is proved in
-`cont_mdiff_on.cont_mdiff_on_tangent_map_within` -/
-lemma cont_mdiff_on.cont_mdiff_on_tangent_map_within_aux
-  {f : H → H'} {s : set H}
-  (hf : cont_mdiff_on I I' n f s) (hmn : m + 1 ≤ n) (hs : unique_mdiff_on I s) :
-  cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s)
-    ((tangent_bundle.proj I H) ⁻¹' s) :=
-begin
-  have m_le_n : m ≤ n,
-  { apply le_trans _ hmn,
-    have : m + 0 ≤ m + 1 := add_le_add_left (zero_le _) _,
-    simpa only [add_zero] using this },
-  have one_le_n : 1 ≤ n,
-  { apply le_trans _ hmn,
-    change 0 + 1 ≤ m + 1,
-    exact add_le_add_right (zero_le _) _ },
-  have U': unique_diff_on 𝕜 (range I ∩ I.symm ⁻¹' s),
-  { assume y hy,
-    simpa only [unique_mdiff_on, unique_mdiff_within_at, hy.1, inter_comm] with mfld_simps
-      using hs (I.symm y) hy.2 },
-  have U : unique_diff_on 𝕜 ((range I ∩ I.symm ⁻¹' s) ×ˢ (univ : set E)) :=
-    U'.prod unique_diff_on_univ,
-  rw cont_mdiff_on_iff,
-  refine ⟨hf.continuous_on_tangent_map_within_aux one_le_n hs, λp q, _⟩,
-  have A : range I ×ˢ (univ : set E) ∩
-      ((equiv.sigma_equiv_prod H E).symm ∘ λ (p : E × E), ((I.symm) p.fst, p.snd)) ⁻¹'
-        (tangent_bundle.proj I H ⁻¹' s)
-      = (range I ∩ I.symm ⁻¹' s) ×ˢ (univ : set E),
-    by { ext ⟨x, v⟩, simp only with mfld_simps },
-  suffices h : cont_diff_on 𝕜 m (((λ (p : H' × E'), (I' p.fst, p.snd)) ∘
-      (equiv.sigma_equiv_prod H' E')) ∘ tangent_map_within I I' f s ∘
-      ((equiv.sigma_equiv_prod H E).symm) ∘ λ (p : E × E), (I.symm p.fst, p.snd))
-    ((range ⇑I ∩ ⇑(I.symm) ⁻¹' s) ×ˢ (univ : set E)),
-    by simpa [A] using h,
-  change cont_diff_on 𝕜 m (λ (p : E × E),
-    ((I' (f (I.symm p.fst)), ((mfderiv_within I I' f s (I.symm p.fst)) : E → E') p.snd) : E' × E'))
-    ((range I ∩ I.symm ⁻¹' s) ×ˢ (univ : set E)),
-  -- check that all bits in this formula are `C^n`
-  have hf' := cont_mdiff_on_iff.1 hf,
-  have A : cont_diff_on 𝕜 m (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) :=
-    by simpa only with mfld_simps using (hf'.2 (I.symm 0) (I'.symm 0)).of_le m_le_n,
-  have B : cont_diff_on 𝕜 m ((I' ∘ f ∘ I.symm) ∘ prod.fst)
-           ((range I ∩ I.symm ⁻¹' s) ×ˢ (univ : set E)) :=
-    A.comp (cont_diff_fst.cont_diff_on) (prod_subset_preimage_fst _ _),
-  suffices C : cont_diff_on 𝕜 m (λ (p : E × E),
-    ((fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) p.1 : _) p.2))
-    ((range I ∩ I.symm ⁻¹' s) ×ˢ (univ : set E)),
-  { apply cont_diff_on.prod B _,
-    apply C.congr (λp hp, _),
-    simp only with mfld_simps at hp,
-    simp only [mfderiv_within, hf.mdifferentiable_on one_le_n _ hp.2, hp.1, dif_pos]
-      with mfld_simps },
-  have D : cont_diff_on 𝕜 m (λ x,
-    (fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) x))
-    (range I ∩ I.symm ⁻¹' s),
-  { have : cont_diff_on 𝕜 n (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) :=
-      by simpa only with mfld_simps using (hf'.2 (I.symm 0) (I'.symm 0)),
-    simpa only [inter_comm] using this.fderiv_within U' hmn },
-  have := D.comp (cont_diff_fst.cont_diff_on) (prod_subset_preimage_fst _ _),
-  have := cont_diff_on.prod this (cont_diff_snd.cont_diff_on),
-  exact is_bounded_bilinear_map_apply.cont_diff.comp_cont_diff_on this,
-end
-
-include Is I's
-
-/-- If a function is `C^n` on a domain with unique derivatives, then its bundled derivative
-is `C^m` when `m+1 ≤ n`. -/
-theorem cont_mdiff_on.cont_mdiff_on_tangent_map_within
-  (hf : cont_mdiff_on I I' n f s) (hmn : m + 1 ≤ n) (hs : unique_mdiff_on I s) :
-  cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s)
-  ((tangent_bundle.proj I M) ⁻¹' s) :=
-begin
-  /- The strategy of the proof is to avoid unfolding the definitions, and reduce by functoriality
-  to the case of functions on the model spaces, where we have already proved the result.
-  Let `l` and `r` be the charts to the left and to the right, so that we have
-  ```
-     l^{-1}      f       r
-  H --------> M ---> M' ---> H'
-  ```
-  Then the tangent map `T(r ∘ f ∘ l)` is smooth by a previous result. Consider the composition
-  ```
-      Tl        T(r ∘ f ∘ l^{-1})         Tr^{-1}
-  TM -----> TH -------------------> TH' ---------> TM'
-  ```
-  where `Tr^{-1}` and `Tl` are the tangent maps of `r^{-1}` and `l`. Writing `Tl` and `Tr^{-1}` as
-  composition of charts (called `Dl` and `il` for `l` and `Dr` and `ir` in the proof below), it
-  follows that they are smooth. The composition of all these maps is `Tf`, and is therefore smooth
-  as a composition of smooth maps.
-  -/
-  have m_le_n : m ≤ n,
-  { apply le_trans _ hmn,
-    have : m + 0 ≤ m + 1 := add_le_add_left (zero_le _) _,
-    simpa only [add_zero] },
-  have one_le_n : 1 ≤ n,
-  { apply le_trans _ hmn,
-    change 0 + 1 ≤ m + 1,
-    exact add_le_add_right (zero_le _) _ },
-  /- First step: local reduction on the space, to a set `s'` which is contained in chart domains. -/
-  refine cont_mdiff_on_of_locally_cont_mdiff_on (λp hp, _),
-  have hf' := cont_mdiff_on_iff.1 hf,
-  simp [tangent_bundle.proj] at hp,
-  let l  := chart_at H p.1,
-  set Dl := chart_at (model_prod H E) p with hDl,
-  let r  := chart_at H' (f p.1),
-  let Dr := chart_at (model_prod H' E') (tangent_map_within I I' f s p),
-  let il := chart_at (model_prod H E) (tangent_map I I l p),
-  let ir := chart_at (model_prod H' E') (tangent_map I I' (r ∘ f) p),
-  let s' := f ⁻¹' r.source ∩ s ∩ l.source,
-  let s'_lift := (tangent_bundle.proj I M)⁻¹' s',
-  let s'l := l.target ∩ l.symm ⁻¹' s',
-  let s'l_lift := (tangent_bundle.proj I H) ⁻¹' s'l,
-  rcases continuous_on_iff'.1 hf'.1 r.source r.open_source with ⟨o, o_open, ho⟩,
-  suffices h : cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s) s'_lift,
-  { refine ⟨(tangent_bundle.proj I M)⁻¹' (o ∩ l.source), _, _, _⟩,
-    show is_open ((tangent_bundle.proj I M)⁻¹' (o ∩ l.source)), from
-      (is_open.inter o_open l.open_source).preimage (tangent_bundle_proj_continuous _ _) ,
-    show p ∈ tangent_bundle.proj I M ⁻¹' (o ∩ l.source),
-    { simp [tangent_bundle.proj] at ⊢,
-      have : p.1 ∈ f ⁻¹' r.source ∩ s, by simp [hp],
-      rw ho at this,
-      exact this.1 },
-    { have : tangent_bundle.proj I M ⁻¹' s ∩ tangent_bundle.proj I M ⁻¹' (o ∩ l.source) = s'_lift,
-      { dsimp only [s'_lift, s'], rw [ho], mfld_set_tac },
-      rw this,
-      exact h } },
-  /- Second step: check that all functions are smooth, and use the chain rule to write the bundled
-  derivative as a composition of a function between model spaces and of charts.
-  Convention: statements about the differentiability of `a ∘ b ∘ c` are named `diff_abc`. Statements
-  about differentiability in the bundle have a `_lift` suffix. -/
-  have U' : unique_mdiff_on I s',
-  { apply unique_mdiff_on.inter _ l.open_source,
-    rw [ho, inter_comm],
-    exact hs.inter o_open },
-  have U'l : unique_mdiff_on I s'l :=
-    U'.unique_mdiff_on_preimage (mdifferentiable_chart _ _),
-  have diff_f : cont_mdiff_on I I' n f s' :=
-    hf.mono (by mfld_set_tac),
-  have diff_r : cont_mdiff_on I' I' n r r.source :=
-    cont_mdiff_on_chart,
-  have diff_rf : cont_mdiff_on I I' n (r ∘ f) s',
-  { apply cont_mdiff_on.comp diff_r diff_f (λx hx, _),
-    simp only [s'] with mfld_simps at hx, simp only [hx] with mfld_simps },
-  have diff_l : cont_mdiff_on I I n l.symm s'l,
-  { have A : cont_mdiff_on I I n l.symm l.target :=
-      cont_mdiff_on_chart_symm,
-    exact A.mono (by mfld_set_tac) },
-  have diff_rfl : cont_mdiff_on I I' n (r ∘ f ∘ l.symm) s'l,
-  { apply cont_mdiff_on.comp diff_rf diff_l,
-    mfld_set_tac },
-  have diff_rfl_lift : cont_mdiff_on I.tangent I'.tangent m
-      (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l) s'l_lift :=
-    diff_rfl.cont_mdiff_on_tangent_map_within_aux hmn U'l,
-  have diff_irrfl_lift : cont_mdiff_on I.tangent I'.tangent m
-      (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l)) s'l_lift,
-  { have A : cont_mdiff_on I'.tangent I'.tangent m ir ir.source := cont_mdiff_on_chart,
-    exact cont_mdiff_on.comp A diff_rfl_lift (λp hp, by simp only [ir] with mfld_simps) },
-  have diff_Drirrfl_lift : cont_mdiff_on I.tangent I'.tangent m
-    (Dr.symm ∘ (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l))) s'l_lift,
-  { have A : cont_mdiff_on I'.tangent I'.tangent m Dr.symm Dr.target :=
-      cont_mdiff_on_chart_symm,
-    apply cont_mdiff_on.comp A diff_irrfl_lift (λp hp, _),
-    simp only [s'l_lift, tangent_bundle.proj] with mfld_simps at hp,
-    simp only [ir, @local_equiv.refl_coe (model_prod H' E'), hp] with mfld_simps },
-  -- conclusion of this step: the composition of all the maps above is smooth
-  have diff_DrirrflilDl : cont_mdiff_on I.tangent I'.tangent m
-    (Dr.symm ∘ (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l)) ∘
-      (il.symm ∘ Dl)) s'_lift,
-  { have A : cont_mdiff_on I.tangent I.tangent m Dl Dl.source := cont_mdiff_on_chart,
-    have A' : cont_mdiff_on I.tangent I.tangent m Dl s'_lift,
-    { apply A.mono (λp hp, _),
-      simp only [s'_lift, tangent_bundle.proj] with mfld_simps at hp,
-      simp only [Dl, hp] with mfld_simps },
-    have B : cont_mdiff_on I.tangent I.tangent m il.symm il.target :=
-      cont_mdiff_on_chart_symm,
-    have C : cont_mdiff_on I.tangent I.tangent m (il.symm ∘ Dl) s'_lift :=
-      cont_mdiff_on.comp B A' (λp hp, by simp only [il] with mfld_simps),
-    apply cont_mdiff_on.comp diff_Drirrfl_lift C (λp hp, _),
-    simp only [s'_lift, tangent_bundle.proj] with mfld_simps at hp,
-    simp only [il, s'l_lift, hp, tangent_bundle.proj] with mfld_simps },
-  /- Third step: check that the composition of all the maps indeed coincides with the derivative we
-  are looking for -/
-  have eq_comp : ∀q ∈ s'_lift, tangent_map_within I I' f s q =
-      (Dr.symm ∘ ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l) ∘
-      (il.symm ∘ Dl)) q,
-  { assume q hq,
-    simp only [s'_lift, tangent_bundle.proj] with mfld_simps at hq,
-    have U'q : unique_mdiff_within_at I s' q.1,
-      by { apply U', simp only [hq, s'] with mfld_simps },
-    have U'lq : unique_mdiff_within_at I s'l (Dl q).1,
-      by { apply U'l, simp only [hq, s'l] with mfld_simps },
-    have A : tangent_map_within I I' ((r ∘ f) ∘ l.symm) s'l (il.symm (Dl q)) =
-      tangent_map_within I I' (r ∘ f) s' (tangent_map_within I I l.symm s'l (il.symm (Dl q))),
-    { refine tangent_map_within_comp_at (il.symm (Dl q)) _ _ (λp hp, _) U'lq,
-      { apply diff_rf.mdifferentiable_on one_le_n,
-        simp only [hq] with mfld_simps },
-      { apply diff_l.mdifferentiable_on one_le_n,
-        simp only [s'l, hq] with mfld_simps },
-      { simp only with mfld_simps at hp, simp only [hp] with mfld_simps } },
-    have B : tangent_map_within I I l.symm s'l (il.symm (Dl q)) = q,
-    { have : tangent_map_within I I l.symm s'l (il.symm (Dl q))
-        = tangent_map I I l.symm (il.symm (Dl q)),
-      { refine tangent_map_within_eq_tangent_map U'lq _,
-        refine mdifferentiable_at_atlas_symm _ (chart_mem_atlas _ _) _,
-        simp only [hq] with mfld_simps },
-      rw [this, tangent_map_chart_symm, hDl],
-      { simp only [hq] with mfld_simps,
-        have : q ∈ (chart_at (model_prod H E) p).source, by simp only [hq] with mfld_simps,
-        exact (chart_at (model_prod H E) p).left_inv this },
-      { simp only [hq] with mfld_simps } },
-    have C : tangent_map_within I I' (r ∘ f) s' q
-      = tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q),
-    { refine tangent_map_within_comp_at q _ _ (λr hr, _) U'q,
-      { apply diff_r.mdifferentiable_on one_le_n,
-        simp only [hq] with mfld_simps },
-      { apply diff_f.mdifferentiable_on one_le_n,
-        simp only [hq] with mfld_simps },
-      { simp only [s'] with mfld_simps at hr,
-        simp only [hr] with mfld_simps } },
-    have D : Dr.symm (ir (tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q)))
-      = tangent_map_within I I' f s' q,
-    { have A : tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q) =
-             tangent_map I' I' r (tangent_map_within I I' f s' q),
-      { apply tangent_map_within_eq_tangent_map,
-        { apply is_open.unique_mdiff_within_at _ r.open_source, simp [hq] },
-        { refine mdifferentiable_at_atlas _ (chart_mem_atlas _ _) _,
-          simp only [hq] with mfld_simps } },
-      have : f p.1 = (tangent_map_within I I' f s p).1 := rfl,
-      rw [A],
-      dsimp [r, Dr],
-      rw [this, tangent_map_chart],
-      { simp only [hq] with mfld_simps,
-        have : tangent_map_within I I' f s' q ∈
-          (chart_at (model_prod H' E') (tangent_map_within I I' f s p)).source,
-            by simp only [hq] with mfld_simps,
-        exact (chart_at (model_prod H' E') (tangent_map_within I I' f s p)).left_inv this },
-      { simp only [hq] with mfld_simps } },
-    have E : tangent_map_within I I' f s' q = tangent_map_within I I' f s q,
-    { refine tangent_map_within_subset (by mfld_set_tac) U'q _,
-      apply hf.mdifferentiable_on one_le_n,
-      simp only [hq] with mfld_simps },
-    simp only [(∘), A, B, C, D, E.symm] },
-  exact diff_DrirrflilDl.congr eq_comp,
-end
-
-/-- If a function is `C^n` on a domain with unique derivatives, with `1 ≤ n`, then its bundled
-derivative is continuous there. -/
-theorem cont_mdiff_on.continuous_on_tangent_map_within
-  (hf : cont_mdiff_on I I' n f s) (hmn : 1 ≤ n) (hs : unique_mdiff_on I s) :
-  continuous_on (tangent_map_within I I' f s) ((tangent_bundle.proj I M) ⁻¹' s) :=
-begin
-  have : cont_mdiff_on I.tangent I'.tangent 0 (tangent_map_within I I' f s)
-         ((tangent_bundle.proj I M) ⁻¹' s) :=
-    hf.cont_mdiff_on_tangent_map_within hmn hs,
-  exact this.continuous_on
-end
-
-/-- If a function is `C^n`, then its bundled derivative is `C^m` when `m+1 ≤ n`. -/
-theorem cont_mdiff.cont_mdiff_tangent_map
-  (hf : cont_mdiff I I' n f) (hmn : m + 1 ≤ n) :
-  cont_mdiff I.tangent I'.tangent m (tangent_map I I' f) :=
-begin
-  rw ← cont_mdiff_on_univ at hf ⊢,
-  convert hf.cont_mdiff_on_tangent_map_within hmn unique_mdiff_on_univ,
-  rw tangent_map_within_univ
-end
-
-/-- If a function is `C^n`, with `1 ≤ n`, then its bundled derivative is continuous. -/
-theorem cont_mdiff.continuous_tangent_map
-  (hf : cont_mdiff I I' n f) (hmn : 1 ≤ n) :
-  continuous (tangent_map I I' f) :=
-begin
-  rw ← cont_mdiff_on_univ at hf,
-  rw continuous_iff_continuous_on_univ,
-  convert hf.continuous_on_tangent_map_within hmn unique_mdiff_on_univ,
-  rw tangent_map_within_univ
-end
-
-end tangent_map
-
-/-! ### Smoothness of the projection in a basic smooth bundle -/
-
-namespace basic_smooth_vector_bundle_core
-
-variables (Z : basic_smooth_vector_bundle_core I M E')
-
-lemma cont_mdiff_proj :
-  cont_mdiff ((I.prod 𝓘(𝕜, E'))) I n
-    Z.to_topological_vector_bundle_core.proj :=
-begin
-  assume x,
-  rw [cont_mdiff_at, cont_mdiff_within_at_iff],
-  refine ⟨Z.to_topological_vector_bundle_core.continuous_proj.continuous_within_at, _⟩,
-  simp only [(∘), chart_at, chart] with mfld_simps,
-  apply cont_diff_within_at_fst.congr,
-  { rintros ⟨a, b⟩ hab,
-    simp only with mfld_simps at hab,
-    simp only [hab] with mfld_simps },
-  { simp only with mfld_simps }
-end
-
-lemma smooth_proj :
-  smooth ((I.prod 𝓘(𝕜, E'))) I Z.to_topological_vector_bundle_core.proj :=
-cont_mdiff_proj Z
-
-lemma cont_mdiff_on_proj {s : set (Z.to_topological_vector_bundle_core.total_space)} :
-  cont_mdiff_on ((I.prod 𝓘(𝕜, E'))) I n
-    Z.to_topological_vector_bundle_core.proj s :=
-Z.cont_mdiff_proj.cont_mdiff_on
-
-lemma smooth_on_proj {s : set (Z.to_topological_vector_bundle_core.total_space)} :
-  smooth_on ((I.prod 𝓘(𝕜, E'))) I Z.to_topological_vector_bundle_core.proj s :=
-cont_mdiff_on_proj Z
-
-lemma cont_mdiff_at_proj {p : Z.to_topological_vector_bundle_core.total_space} :
-  cont_mdiff_at ((I.prod 𝓘(𝕜, E'))) I n
-    Z.to_topological_vector_bundle_core.proj p :=
-Z.cont_mdiff_proj.cont_mdiff_at
-
-lemma smooth_at_proj {p : Z.to_topological_vector_bundle_core.total_space} :
-  smooth_at ((I.prod 𝓘(𝕜, E'))) I Z.to_topological_vector_bundle_core.proj p :=
-Z.cont_mdiff_at_proj
-
-lemma cont_mdiff_within_at_proj
-  {s : set (Z.to_topological_vector_bundle_core.total_space)}
-  {p : Z.to_topological_vector_bundle_core.total_space} :
-  cont_mdiff_within_at ((I.prod 𝓘(𝕜, E'))) I n
-    Z.to_topological_vector_bundle_core.proj s p :=
-Z.cont_mdiff_at_proj.cont_mdiff_within_at
-
-lemma smooth_within_at_proj
-  {s : set (Z.to_topological_vector_bundle_core.total_space)}
-  {p : Z.to_topological_vector_bundle_core.total_space} :
-  smooth_within_at ((I.prod 𝓘(𝕜, E'))) I
-    Z.to_topological_vector_bundle_core.proj s p :=
-Z.cont_mdiff_within_at_proj
-
-/-- If an element of `E'` is invariant under all coordinate changes, then one can define a
-corresponding section of the fiber bundle, which is smooth. This applies in particular to the
-zero section of a vector bundle. Another example (not yet defined) would be the identity
-section of the endomorphism bundle of a vector bundle. -/
-lemma smooth_const_section (v : E')
-  (h : ∀ (i j : atlas H M), ∀ x ∈ i.1.source ∩ j.1.source, Z.coord_change i j (i.1 x) v = v) :
-  smooth I ((I.prod 𝓘(𝕜, E')))
-    (show M → Z.to_topological_vector_bundle_core.total_space, from λ x, ⟨x, v⟩) :=
-begin
-  assume x,
-  rw [cont_mdiff_at, cont_mdiff_within_at_iff],
-  split,
-  { apply continuous.continuous_within_at,
-    apply topological_fiber_bundle_core.continuous_const_section,
-    assume i j y hy,
-    exact h _ _ _ hy },
-  { have : cont_diff 𝕜 ⊤ (λ (y : E), (y, v)) := cont_diff_id.prod cont_diff_const,
-    apply this.cont_diff_within_at.congr,
-    { assume y hy,
-      simp only with mfld_simps at hy,
-      simp only [chart, hy, chart_at, prod.mk.inj_iff, to_topological_vector_bundle_core]
-        with mfld_simps,
-      apply h,
-      simp only [hy, subtype.val_eq_coe] with mfld_simps,
-      exact mem_chart_source H (((chart_at H x).symm) ((model_with_corners.symm I) y)) },
-    { simp only [chart, chart_at, prod.mk.inj_iff, to_topological_vector_bundle_core]
-        with mfld_simps,
-      apply h,
-      simp only [subtype.val_eq_coe] with mfld_simps,
-      exact mem_chart_source H x, } }
-end
-
-end basic_smooth_vector_bundle_core
-
-/-! ### Smoothness of the tangent bundle projection -/
-
-namespace tangent_bundle
-
-include Is
-
-lemma cont_mdiff_proj :
-  cont_mdiff I.tangent I n (proj I M) :=
-basic_smooth_vector_bundle_core.cont_mdiff_proj _
-
-lemma smooth_proj : smooth I.tangent I (proj I M) :=
-basic_smooth_vector_bundle_core.smooth_proj _
-
-lemma cont_mdiff_on_proj {s : set (tangent_bundle I M)} :
-  cont_mdiff_on I.tangent I n (proj I M) s :=
-basic_smooth_vector_bundle_core.cont_mdiff_on_proj _
-
-lemma smooth_on_proj {s : set (tangent_bundle I M)} :
-  smooth_on I.tangent I (proj I M) s :=
-basic_smooth_vector_bundle_core.smooth_on_proj _
-
-lemma cont_mdiff_at_proj {p : tangent_bundle I M} :
-  cont_mdiff_at I.tangent I n
-    (proj I M) p :=
-basic_smooth_vector_bundle_core.cont_mdiff_at_proj _
-
-lemma smooth_at_proj {p : tangent_bundle I M} :
-  smooth_at I.tangent I (proj I M) p :=
-basic_smooth_vector_bundle_core.smooth_at_proj _
-
-lemma cont_mdiff_within_at_proj
-  {s : set (tangent_bundle I M)} {p : tangent_bundle I M} :
-  cont_mdiff_within_at I.tangent I n
-    (proj I M) s p :=
-basic_smooth_vector_bundle_core.cont_mdiff_within_at_proj _
-
-lemma smooth_within_at_proj
-  {s : set (tangent_bundle I M)} {p : tangent_bundle I M} :
-  smooth_within_at I.tangent I
-    (proj I M) s p :=
-basic_smooth_vector_bundle_core.smooth_within_at_proj _
-
-variables (I M)
-/-- The zero section of the tangent bundle -/
-def zero_section : M → tangent_bundle I M := λ x, ⟨x, 0⟩
-variables {I M}
-
-lemma smooth_zero_section : smooth I I.tangent (zero_section I M) :=
+lemma cont_diff_within_at.comp_cont_mdiff_within_at
+  {g : F → F'} {f : M → F} {s : set M} {t : set F} {x : M}
+  (hg : cont_diff_within_at 𝕜 n g t (f x))
+  (hf : cont_mdiff_within_at I 𝓘(𝕜, F) n f s x) (h : s ⊆ f ⁻¹' t) :
+  cont_mdiff_within_at I 𝓘(𝕜, F') n (g ∘ f) s x :=
 begin
-  apply basic_smooth_vector_bundle_core.smooth_const_section (tangent_bundle_core I M) 0,
-  assume i j x hx,
-  simp only [tangent_bundle_core, continuous_linear_map.map_zero, continuous_linear_map.coe_coe]
-    with mfld_simps,
+  rw cont_mdiff_within_at_iff at *,
+  refine ⟨hg.continuous_within_at.comp hf.1 h, _⟩,
+  rw [← (ext_chart_at I x).left_inv (mem_ext_chart_source I x)] at hg,
+  apply cont_diff_within_at.comp _ (by exact hg) hf.2 _,
+  exact (inter_subset_left _ _).trans (preimage_mono h)
 end
 
-open bundle
-
-/-- The derivative of the zero section of the tangent bundle maps `⟨x, v⟩` to `⟨⟨x, 0⟩, ⟨v, 0⟩⟩`.
+lemma cont_diff_at.comp_cont_mdiff_at {g : F → F'} {f : M → F} {x : M}
+  (hg : cont_diff_at 𝕜 n g (f x)) (hf : cont_mdiff_at I 𝓘(𝕜, F) n f x) :
+  cont_mdiff_at I 𝓘(𝕜, F') n (g ∘ f) x :=
+hg.comp_cont_mdiff_within_at hf subset.rfl
 
-Note that, as currently framed, this is a statement in coordinates, thus reliant on the choice
-of the coordinate system we use on the tangent bundle.
+lemma cont_diff.comp_cont_mdiff {g : F → F'} {f : M → F}
+  (hg : cont_diff 𝕜 n g) (hf : cont_mdiff I 𝓘(𝕜, F) n f) :
+  cont_mdiff I 𝓘(𝕜, F') n (g ∘ f) :=
+λ x, hg.cont_diff_at.comp_cont_mdiff_at (hf x)
 
-However, the result itself is coordinate-dependent only to the extent that the coordinates
-determine a splitting of the tangent bundle.  Moreover, there is a canonical splitting at each
-point of the zero section (since there is a canonical horizontal space there, the tangent space
-to the zero section, in addition to the canonical vertical space which is the kernel of the
-derivative of the projection), and this canonical splitting is also the one that comes from the
-coordinates on the tangent bundle in our definitions. So this statement is not as crazy as it
-may seem.
-
-TODO define splittings of vector bundles; state this result invariantly. -/
-lemma tangent_map_tangent_bundle_pure (p : tangent_bundle I M) :
-  tangent_map I I.tangent (tangent_bundle.zero_section I M) p = ⟨⟨p.1, 0⟩, ⟨p.2, 0⟩⟩ :=
-begin
-  rcases p with ⟨x, v⟩,
-  have N : I.symm ⁻¹' (chart_at H x).target ∈ 𝓝 (I ((chart_at H x) x)),
-  { apply is_open.mem_nhds,
-    apply (local_homeomorph.open_target _).preimage I.continuous_inv_fun,
-    simp only with mfld_simps },
-  have A : mdifferentiable_at I I.tangent (λ (x : M), total_space_mk (tangent_space I) x 0) x :=
-    tangent_bundle.smooth_zero_section.mdifferentiable_at,
-  have B : fderiv_within 𝕜 (λ (x_1 : E), (x_1, (0 : E))) (set.range ⇑I) (I ((chart_at H x) x)) v
-    = (v, 0),
-  { rw [fderiv_within_eq_fderiv, differentiable_at.fderiv_prod],
-    { simp },
-    { exact differentiable_at_id' },
-    { exact differentiable_at_const _ },
-    { exact model_with_corners.unique_diff_at_image I },
-    { exact differentiable_at_id'.prod (differentiable_at_const _) } },
-  simp only [tangent_bundle.zero_section, tangent_map, mfderiv,
-    A, dif_pos, chart_at, basic_smooth_vector_bundle_core.chart,
-    basic_smooth_vector_bundle_core.to_topological_vector_bundle_core, tangent_bundle_core,
-    function.comp, continuous_linear_map.map_zero] with mfld_simps,
-  rw ← fderiv_within_inter N (I.unique_diff (I ((chart_at H x) x)) (set.mem_range_self _)) at B,
-  rw [← fderiv_within_inter N (I.unique_diff (I ((chart_at H x) x)) (set.mem_range_self _)), ← B],
-  congr' 2,
-  apply fderiv_within_congr _ (λ y hy, _),
-  { simp only [prod.mk.inj_iff] with mfld_simps,
-    exact ((tangent_bundle_core I M).to_topological_vector_bundle_core.coord_change
-      ((tangent_bundle_core I M).to_topological_vector_bundle_core.index_at (((chart_at H x).symm)
-      (I.symm (I ((chart_at H x) x))))) ⟨chart_at H x, _⟩ (((chart_at H x).symm)
-      (I.symm (I ((chart_at H x) x))))).map_zero, },
-  { apply unique_diff_within_at.inter (I.unique_diff _ _) N,
-    simp only with mfld_simps },
-  { simp only with mfld_simps at hy,
-    simp only [hy, prod.mk.inj_iff] with mfld_simps,
-    exact ((tangent_bundle_core I M).to_topological_vector_bundle_core.coord_change
-      ((tangent_bundle_core I M).to_topological_vector_bundle_core.index_at (((chart_at H x).symm)
-      (I.symm y))) ⟨chart_at H x, _⟩ (((chart_at H x).symm) (I.symm y))).map_zero, },
-end
-
-end tangent_bundle
+end module
 
 /-! ### Smoothness of standard maps associated to the product of manifolds -/
 
@@ -1590,7 +1346,7 @@ lemma cont_mdiff_within_at.prod_mk {f : M → M'} {g : M → N'}
   (hf : cont_mdiff_within_at I I' n f s x) (hg : cont_mdiff_within_at I J' n g s x) :
   cont_mdiff_within_at I (I'.prod J') n (λ x, (f x, g x)) s x :=
 begin
-  rw cont_mdiff_within_at_iff'' at *,
+  rw cont_mdiff_within_at_iff at *,
   exact ⟨hf.1.prod hg.1, hf.2.prod hg.2⟩,
 end
 
@@ -1599,7 +1355,7 @@ lemma cont_mdiff_within_at.prod_mk_space {f : M → E'} {g : M → F'}
   (hg : cont_mdiff_within_at I 𝓘(𝕜, F') n g s x) :
   cont_mdiff_within_at I 𝓘(𝕜, E' × F') n (λ x, (f x, g x)) s x :=
 begin
-  rw cont_mdiff_within_at_iff'' at *,
+  rw cont_mdiff_within_at_iff at *,
   exact ⟨hf.1.prod hg.1, hf.2.prod hg.2⟩,
 end
 
@@ -1680,7 +1436,7 @@ section projections
 lemma cont_mdiff_within_at_fst {s : set (M × N)} {p : M × N} :
   cont_mdiff_within_at (I.prod J) I n prod.fst s p :=
 begin
-  rw cont_mdiff_within_at_iff,
+  rw cont_mdiff_within_at_iff',
   refine ⟨continuous_within_at_fst, _⟩,
   refine cont_diff_within_at_fst.congr (λ y hy, _) _,
   { simp only with mfld_simps at hy,
@@ -1688,6 +1444,11 @@ begin
   { simp only with mfld_simps }
 end
 
+lemma cont_mdiff_within_at.fst {f : N → M × M'} {s : set N} {x : N}
+  (hf : cont_mdiff_within_at J (I.prod I') n f s x) :
+  cont_mdiff_within_at J I n (λ x, (f x).1) s x :=
+cont_mdiff_within_at_fst.comp x hf (maps_to_image f s)
+
 lemma cont_mdiff_at_fst {p : M × N} :
   cont_mdiff_at (I.prod J) I n prod.fst p :=
 cont_mdiff_within_at_fst
@@ -1716,10 +1477,26 @@ lemma smooth_fst :
   smooth (I.prod J) I (@prod.fst M N) :=
 cont_mdiff_fst
 
+lemma cont_mdiff_at.fst {f : N → M × M'} {x : N} (hf : cont_mdiff_at J (I.prod I') n f x) :
+  cont_mdiff_at J I n (λ x, (f x).1) x :=
+cont_mdiff_at_fst.comp x hf
+
+lemma cont_mdiff.fst {f : N → M × M'} (hf : cont_mdiff J (I.prod I') n f) :
+  cont_mdiff J I n (λ x, (f x).1) :=
+cont_mdiff_fst.comp hf
+
+lemma smooth_at.fst {f : N → M × M'} {x : N} (hf : smooth_at J (I.prod I') f x) :
+  smooth_at J I (λ x, (f x).1) x :=
+smooth_at_fst.comp x hf
+
+lemma smooth.fst {f : N → M × M'} (hf : smooth J (I.prod I') f) :
+  smooth J I (λ x, (f x).1) :=
+smooth_fst.comp hf
+
 lemma cont_mdiff_within_at_snd {s : set (M × N)} {p : M × N} :
   cont_mdiff_within_at (I.prod J) J n prod.snd s p :=
 begin
-  rw cont_mdiff_within_at_iff,
+  rw cont_mdiff_within_at_iff',
   refine ⟨continuous_within_at_snd, _⟩,
   refine cont_diff_within_at_snd.congr (λ y hy, _) _,
   { simp only with mfld_simps at hy,
@@ -1727,6 +1504,11 @@ begin
   { simp only with mfld_simps }
 end
 
+lemma cont_mdiff_within_at.snd {f : N → M × M'} {s : set N} {x : N}
+  (hf : cont_mdiff_within_at J (I.prod I') n f s x) :
+  cont_mdiff_within_at J I' n (λ x, (f x).2) s x :=
+cont_mdiff_within_at_snd.comp x hf (maps_to_image f s)
+
 lemma cont_mdiff_at_snd {p : M × N} :
   cont_mdiff_at (I.prod J) J n prod.snd p :=
 cont_mdiff_within_at_snd
@@ -1755,16 +1537,53 @@ lemma smooth_snd :
   smooth (I.prod J) J (@prod.snd M N) :=
 cont_mdiff_snd
 
-lemma smooth_iff_proj_smooth {f : M → M' × N'} :
-  (smooth I (I'.prod J') f) ↔ (smooth I I' (prod.fst ∘ f)) ∧ (smooth I J' (prod.snd ∘ f)) :=
-begin
-  split,
-  { intro h, exact ⟨smooth_fst.comp h, smooth_snd.comp h⟩ },
-  { rintro ⟨h_fst, h_snd⟩, simpa only [prod.mk.eta] using h_fst.prod_mk h_snd, }
-end
+lemma cont_mdiff_at.snd {f : N → M × M'} {x : N} (hf : cont_mdiff_at J (I.prod I') n f x) :
+  cont_mdiff_at J I' n (λ x, (f x).2) x :=
+cont_mdiff_at_snd.comp x hf
+
+lemma cont_mdiff.snd {f : N → M × M'} (hf : cont_mdiff J (I.prod I') n f) :
+  cont_mdiff J I' n (λ x, (f x).2) :=
+cont_mdiff_snd.comp hf
+
+lemma smooth_at.snd {f : N → M × M'} {x : N} (hf : smooth_at J (I.prod I') f x) :
+  smooth_at J I' (λ x, (f x).2) x :=
+smooth_at_snd.comp x hf
+
+lemma smooth.snd {f : N → M × M'} (hf : smooth J (I.prod I') f) :
+  smooth J I' (λ x, (f x).2) :=
+smooth_snd.comp hf
 
 end projections
 
+lemma cont_mdiff_within_at_prod_iff (f : M → M' × N') {s : set M} {x : M} :
+  cont_mdiff_within_at I (I'.prod J') n f s x ↔
+  cont_mdiff_within_at I I' n (prod.fst ∘ f) s x ∧
+  cont_mdiff_within_at I J' n (prod.snd ∘ f) s x :=
+by { refine ⟨λ h, ⟨h.fst, h.snd⟩, λ h, _⟩, simpa only [prod.mk.eta] using h.1.prod_mk h.2 }
+
+lemma cont_mdiff_at_prod_iff (f : M → M' × N') {x : M} :
+  cont_mdiff_at I (I'.prod J') n f x ↔
+  cont_mdiff_at I I' n (prod.fst ∘ f) x ∧ cont_mdiff_at I J' n (prod.snd ∘ f) x :=
+by simp_rw [← cont_mdiff_within_at_univ, cont_mdiff_within_at_prod_iff]
+
+lemma cont_mdiff_prod_iff (f : M → M' × N') :
+  cont_mdiff I (I'.prod J') n f ↔
+  cont_mdiff I I' n (prod.fst ∘ f) ∧ cont_mdiff I J' n (prod.snd ∘ f) :=
+⟨λ h, ⟨h.fst, h.snd⟩, λ h, by { convert h.1.prod_mk h.2, ext; refl }⟩
+
+lemma smooth_at_prod_iff (f : M → M' × N') {x : M} :
+  smooth_at I (I'.prod J') f x ↔
+  smooth_at I I' (prod.fst ∘ f) x ∧ smooth_at I J' (prod.snd ∘ f) x :=
+cont_mdiff_at_prod_iff f
+
+lemma smooth_prod_iff (f : M → M' × N') :
+  smooth I (I'.prod J') f ↔ smooth I I' (prod.fst ∘ f) ∧ smooth I J' (prod.snd ∘ f) :=
+cont_mdiff_prod_iff f
+
+lemma smooth_prod_assoc :
+  smooth ((I.prod I').prod J) (I.prod (I'.prod J)) (λ x : (M × M') × N, (x.1.1, x.1.2, x.2)) :=
+smooth_fst.fst.prod_mk $ smooth_fst.snd.prod_mk smooth_snd
+
 section prod_map
 
 variables {g : N → N'} {r : set N} {y : N}
@@ -1845,15 +1664,15 @@ We have no `model_with_corners.pi` yet, so we prove lemmas about functions `f :
 use `𝓘(𝕜, Π i, F i)` as the model space.
 -/
 
-variables {ι : Type*} [fintype ι] {Fi : ι → Type*} [Π i, normed_group (Fi i)]
+variables {ι : Type*} [fintype ι] {Fi : ι → Type*} [Π i, normed_add_comm_group (Fi i)]
   [Π i, normed_space 𝕜 (Fi i)] {φ : M → Π i, Fi i}
 
 lemma cont_mdiff_within_at_pi_space :
   cont_mdiff_within_at I (𝓘(𝕜, Π i, Fi i)) n φ s x ↔
     ∀ i, cont_mdiff_within_at I (𝓘(𝕜, Fi i)) n (λ x, φ x i) s x :=
-by simp only [cont_mdiff_within_at_iff'', continuous_within_at_pi,
+by simp only [cont_mdiff_within_at_iff, continuous_within_at_pi,
   cont_diff_within_at_pi, forall_and_distrib, written_in_ext_chart_at,
-  ext_chart_model_space_eq_id, (∘), local_equiv.refl_coe, id]
+  ext_chart_at_model_space_eq_id, (∘), local_equiv.refl_coe, id]
 
 lemma cont_mdiff_on_pi_space :
   cont_mdiff_on I (𝓘(𝕜, Π i, Fi i)) n φ s ↔
@@ -1897,25 +1716,271 @@ lemma continuous_linear_map.cont_mdiff (L : E →L[𝕜] F) :
   cont_mdiff 𝓘(𝕜, E) 𝓘(𝕜, F) n L :=
 L.cont_diff.cont_mdiff
 
+lemma cont_mdiff_within_at.clm_comp {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₁} {s : set M} {x : M}
+  (hg : cont_mdiff_within_at I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g s x)
+  (hf : cont_mdiff_within_at I 𝓘(𝕜, F₂ →L[𝕜] F₁) n f s x) :
+  cont_mdiff_within_at I 𝓘(𝕜, F₂ →L[𝕜] F₃) n (λ x, (g x).comp (f x)) s x :=
+@cont_diff_within_at.comp_cont_mdiff_within_at _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
+  (λ x : (F₁ →L[𝕜] F₃) × (F₂ →L[𝕜] F₁), x.1.comp x.2) (λ x, (g x, f x)) s _ x
+  (by { apply cont_diff.cont_diff_at, exact cont_diff_fst.clm_comp cont_diff_snd })
+  (hg.prod_mk_space hf) (by simp_rw [preimage_univ, subset_univ])
+
+lemma cont_mdiff_at.clm_comp {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₁} {x : M}
+  (hg : cont_mdiff_at I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g x) (hf : cont_mdiff_at I 𝓘(𝕜, F₂ →L[𝕜] F₁) n f x) :
+  cont_mdiff_at I 𝓘(𝕜, F₂ →L[𝕜] F₃) n (λ x, (g x).comp (f x)) x :=
+(hg.cont_mdiff_within_at.clm_comp hf.cont_mdiff_within_at).cont_mdiff_at univ_mem
+
+lemma cont_mdiff_on.clm_comp {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₁} {s : set M}
+  (hg : cont_mdiff_on I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g s) (hf : cont_mdiff_on I 𝓘(𝕜, F₂ →L[𝕜] F₁) n f s) :
+  cont_mdiff_on I 𝓘(𝕜, F₂ →L[𝕜] F₃) n (λ x, (g x).comp (f x)) s :=
+λ x hx, (hg x hx).clm_comp (hf x hx)
+
+lemma cont_mdiff.clm_comp {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₁}
+  (hg : cont_mdiff I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g) (hf : cont_mdiff I 𝓘(𝕜, F₂ →L[𝕜] F₁) n f) :
+  cont_mdiff I 𝓘(𝕜, F₂ →L[𝕜] F₃) n (λ x, (g x).comp (f x)) :=
+λ x, (hg x).clm_comp (hf x)
+
+lemma cont_mdiff_within_at.clm_apply {g : M → F₁ →L[𝕜] F₂} {f : M → F₁} {s : set M} {x : M}
+  (hg : cont_mdiff_within_at I 𝓘(𝕜, F₁ →L[𝕜] F₂) n g s x)
+  (hf : cont_mdiff_within_at I 𝓘(𝕜, F₁) n f s x) :
+  cont_mdiff_within_at I 𝓘(𝕜, F₂) n (λ x, g x (f x)) s x :=
+@cont_diff_within_at.comp_cont_mdiff_within_at _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
+  (λ x : (F₁ →L[𝕜] F₂) × F₁, x.1 x.2) (λ x, (g x, f x)) s _ x
+  (by { apply cont_diff.cont_diff_at, exact cont_diff_fst.clm_apply cont_diff_snd })
+  (hg.prod_mk_space hf) (by simp_rw [preimage_univ, subset_univ])
+
+lemma cont_mdiff_at.clm_apply {g : M → F₁ →L[𝕜] F₂} {f : M → F₁} {x : M}
+  (hg : cont_mdiff_at I 𝓘(𝕜, F₁ →L[𝕜] F₂) n g x) (hf : cont_mdiff_at I 𝓘(𝕜, F₁) n f x) :
+  cont_mdiff_at I 𝓘(𝕜, F₂) n (λ x, g x (f x)) x :=
+(hg.cont_mdiff_within_at.clm_apply hf.cont_mdiff_within_at).cont_mdiff_at univ_mem
+
+lemma cont_mdiff_on.clm_apply {g : M → F₁ →L[𝕜] F₂} {f : M → F₁} {s : set M}
+  (hg : cont_mdiff_on I 𝓘(𝕜, F₁ →L[𝕜] F₂) n g s) (hf : cont_mdiff_on I 𝓘(𝕜, F₁) n f s) :
+  cont_mdiff_on I 𝓘(𝕜, F₂) n (λ x, g x (f x)) s :=
+λ x hx, (hg x hx).clm_apply (hf x hx)
+
+lemma cont_mdiff.clm_apply {g : M → F₁ →L[𝕜] F₂} {f : M → F₁}
+  (hg : cont_mdiff I 𝓘(𝕜, F₁ →L[𝕜] F₂) n g) (hf : cont_mdiff I 𝓘(𝕜, F₁) n f) :
+  cont_mdiff I 𝓘(𝕜, F₂) n (λ x, g x (f x)) :=
+λ x, (hg x).clm_apply (hf x)
+
+lemma cont_mdiff_within_at.clm_prod_map
+  {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₄} {s : set M} {x : M}
+  (hg : cont_mdiff_within_at I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g s x)
+  (hf : cont_mdiff_within_at I 𝓘(𝕜, F₂ →L[𝕜] F₄) n f s x) :
+  cont_mdiff_within_at I 𝓘(𝕜, F₁ × F₂ →L[𝕜] F₃ × F₄) n (λ x, (g x).prod_map (f x)) s x :=
+@cont_diff_within_at.comp_cont_mdiff_within_at _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
+  (λ x : (F₁ →L[𝕜] F₃) × (F₂ →L[𝕜] F₄), x.1.prod_map x.2) (λ x, (g x, f x)) s _ x
+  (by { apply cont_diff.cont_diff_at,
+    exact (continuous_linear_map.prod_mapL 𝕜 F₁ F₃ F₂ F₄).cont_diff })
+  (hg.prod_mk_space hf) (by simp_rw [preimage_univ, subset_univ])
+
+lemma cont_mdiff_at.clm_prod_map {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₄} {x : M}
+  (hg : cont_mdiff_at I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g x) (hf : cont_mdiff_at I 𝓘(𝕜, F₂ →L[𝕜] F₄) n f x) :
+  cont_mdiff_at I 𝓘(𝕜, F₁ × F₂ →L[𝕜] F₃ × F₄) n (λ x, (g x).prod_map (f x)) x :=
+(hg.cont_mdiff_within_at.clm_prod_map hf.cont_mdiff_within_at).cont_mdiff_at univ_mem
+
+lemma cont_mdiff_on.clm_prod_map {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₄} {s : set M}
+  (hg : cont_mdiff_on I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g s) (hf : cont_mdiff_on I 𝓘(𝕜, F₂ →L[𝕜] F₄) n f s) :
+  cont_mdiff_on I 𝓘(𝕜, F₁ × F₂ →L[𝕜] F₃ × F₄) n (λ x, (g x).prod_map (f x)) s :=
+λ x hx, (hg x hx).clm_prod_map (hf x hx)
+
+lemma cont_mdiff.clm_prod_map {g : M → F₁ →L[𝕜] F₃} {f : M → F₂ →L[𝕜] F₄}
+  (hg : cont_mdiff I 𝓘(𝕜, F₁ →L[𝕜] F₃) n g) (hf : cont_mdiff I 𝓘(𝕜, F₂ →L[𝕜] F₄) n f) :
+  cont_mdiff I 𝓘(𝕜, F₁ × F₂ →L[𝕜] F₃ × F₄) n (λ x, (g x).prod_map (f x)) :=
+λ x, (hg x).clm_prod_map (hf x)
+
 /-! ### Smoothness of standard operations -/
 
-variables {V : Type*} [normed_group V] [normed_space 𝕜 V]
+variables {V : Type*} [normed_add_comm_group V] [normed_space 𝕜 V]
 
 /-- On any vector space, multiplication by a scalar is a smooth operation. -/
 lemma smooth_smul : smooth (𝓘(𝕜).prod 𝓘(𝕜, V)) 𝓘(𝕜, V) (λp : 𝕜 × V, p.1 • p.2) :=
 smooth_iff.2 ⟨continuous_smul, λ x y, cont_diff_smul.cont_diff_on⟩
 
-lemma smooth.smul {N : Type*} [topological_space N] [charted_space H N]
-  {f : N → 𝕜} {g : N → V} (hf : smooth I 𝓘(𝕜) f) (hg : smooth I 𝓘(𝕜, V) g) :
-  smooth I 𝓘(𝕜, V) (λ p, f p • g p) :=
-smooth_smul.comp (hf.prod_mk hg)
+lemma cont_mdiff_within_at.smul {f : M → 𝕜} {g : M → V} (hf : cont_mdiff_within_at I 𝓘(𝕜) n f s x)
+  (hg : cont_mdiff_within_at I 𝓘(𝕜, V) n g s x) :
+  cont_mdiff_within_at I 𝓘(𝕜, V) n (λ p, f p • g p) s x :=
+(smooth_smul.of_le le_top).cont_mdiff_at.comp_cont_mdiff_within_at x (hf.prod_mk hg)
+
+lemma cont_mdiff_at.smul {f : M → 𝕜} {g : M → V} (hf : cont_mdiff_at I 𝓘(𝕜) n f x)
+  (hg : cont_mdiff_at I 𝓘(𝕜, V) n g x) :
+  cont_mdiff_at I 𝓘(𝕜, V) n (λ p, f p • g p) x :=
+hf.smul hg
+
+lemma cont_mdiff_on.smul {f : M → 𝕜} {g : M → V} (hf : cont_mdiff_on I 𝓘(𝕜) n f s)
+  (hg : cont_mdiff_on I 𝓘(𝕜, V) n g s) :
+  cont_mdiff_on I 𝓘(𝕜, V) n (λ p, f p • g p) s :=
+λ x hx, (hf x hx).smul (hg x hx)
+
+lemma cont_mdiff.smul {f : M → 𝕜} {g : M → V} (hf : cont_mdiff I 𝓘(𝕜) n f)
+  (hg : cont_mdiff I 𝓘(𝕜, V) n g) :
+  cont_mdiff I 𝓘(𝕜, V) n (λ p, f p • g p) :=
+λ x, (hf x).smul (hg x)
+
+lemma smooth_within_at.smul {f : M → 𝕜} {g : M → V} (hf : smooth_within_at I 𝓘(𝕜) f s x)
+  (hg : smooth_within_at I 𝓘(𝕜, V) g s x) :
+  smooth_within_at I 𝓘(𝕜, V) (λ p, f p • g p) s x :=
+hf.smul hg
+
+lemma smooth_at.smul {f : M → 𝕜} {g : M → V} (hf : smooth_at I 𝓘(𝕜) f x)
+  (hg : smooth_at I 𝓘(𝕜, V) g x) :
+  smooth_at I 𝓘(𝕜, V) (λ p, f p • g p) x :=
+hf.smul hg
 
-lemma smooth_on.smul {N : Type*} [topological_space N] [charted_space H N]
-  {f : N → 𝕜} {g : N → V} {s : set N} (hf : smooth_on I 𝓘(𝕜) f s) (hg : smooth_on I 𝓘(𝕜, V) g s) :
+lemma smooth_on.smul {f : M → 𝕜} {g : M → V} (hf : smooth_on I 𝓘(𝕜) f s)
+  (hg : smooth_on I 𝓘(𝕜, V) g s) :
   smooth_on I 𝓘(𝕜, V) (λ p, f p • g p) s :=
-smooth_smul.comp_smooth_on (hf.prod_mk hg)
+hf.smul hg
 
-lemma smooth_at.smul {N : Type*} [topological_space N] [charted_space H N]
-  {f : N → 𝕜} {g : N → V} {x : N} (hf : smooth_at I 𝓘(𝕜) f x) (hg : smooth_at I 𝓘(𝕜, V) g x) :
-  smooth_at I 𝓘(𝕜, V) (λ p, f p • g p) x :=
-smooth_smul.smooth_at.comp _ (hf.prod_mk hg)
+lemma smooth.smul {f : M → 𝕜} {g : M → V} (hf : smooth I 𝓘(𝕜) f) (hg : smooth I 𝓘(𝕜, V) g) :
+  smooth I 𝓘(𝕜, V) (λ p, f p • g p) :=
+hf.smul hg
+
+/-! ### Smoothness of (local) structomorphisms -/
+section
+
+variables [charted_space H M'] [IsM' : smooth_manifold_with_corners I M']
+include Is IsM'
+
+lemma is_local_structomorph_on_cont_diff_groupoid_iff_aux {f : local_homeomorph M M'}
+  (hf : lift_prop_on (cont_diff_groupoid ⊤ I).is_local_structomorph_within_at f f.source) :
+  smooth_on I I f f.source :=
+begin
+  -- It suffices to show smoothness near each `x`
+  apply cont_mdiff_on_of_locally_cont_mdiff_on,
+  intros x hx,
+  let c := chart_at H x,
+  let c' := chart_at H (f x),
+  obtain ⟨-, hxf⟩ := hf x hx,
+  -- Since `f` is a local structomorph, it is locally equal to some transferred element `e` of
+  -- the `cont_diff_groupoid`.
+  obtain ⟨e, he, he' : eq_on (c' ∘ f ∘ c.symm) e (c.symm ⁻¹' f.source ∩ e.source),
+    hex : c x ∈ e.source⟩ := hxf (by simp only [hx] with mfld_simps),
+  -- We choose a convenient set `s` in `M`.
+  let s : set M := (f.trans c').source ∩ ((c.trans e).trans c'.symm).source,
+  refine ⟨s, (f.trans c').open_source.inter ((c.trans e).trans c'.symm).open_source, _, _⟩,
+  { simp only with mfld_simps,
+    rw ← he'; simp only [hx, hex] with mfld_simps },
+  -- We need to show `f` is `cont_mdiff_on` the domain `s ∩ f.source`.  We show this in two
+  -- steps: `f` is equal to `c'.symm ∘ e ∘ c` on that domain and that function is
+  -- `cont_mdiff_on` it.
+  have H₁ : cont_mdiff_on I I ⊤ (c'.symm ∘ e ∘ c) s,
+  { have hc' : cont_mdiff_on I I ⊤ c'.symm _ := cont_mdiff_on_chart_symm,
+    have he'' : cont_mdiff_on I I ⊤ e _ := cont_mdiff_on_of_mem_cont_diff_groupoid he,
+    have hc : cont_mdiff_on I I ⊤ c _ := cont_mdiff_on_chart,
+    refine (hc'.comp' (he''.comp' hc)).mono _,
+    mfld_set_tac },
+  have H₂ : eq_on f (c'.symm ∘ e ∘ c) s,
+  { intros y hy,
+    simp only with mfld_simps at hy,
+    have hy₁ : f y ∈ c'.source := by simp only [hy] with mfld_simps,
+    have hy₂ : y ∈ c.source := by simp only [hy] with mfld_simps,
+    have hy₃ : c y ∈ c.symm ⁻¹' f.source ∩ e.source := by simp only [hy] with mfld_simps,
+    calc f y = c'.symm (c' (f y)) : by rw c'.left_inv hy₁
+    ... = c'.symm (c' (f (c.symm (c y)))) : by rw c.left_inv hy₂
+    ... = c'.symm (e (c y)) : by rw ← he' hy₃ },
+  refine (H₁.congr H₂).mono _,
+  mfld_set_tac
+end
+
+/-- Let `M` and `M'` be smooth manifolds with the same model-with-corners, `I`.  Then `f : M → M'`
+is a local structomorphism for `I`, if and only if it is manifold-smooth on the domain of definition
+in both directions. -/
+lemma is_local_structomorph_on_cont_diff_groupoid_iff (f : local_homeomorph M M') :
+  lift_prop_on (cont_diff_groupoid ⊤ I).is_local_structomorph_within_at f f.source
+  ↔ smooth_on I I f f.source ∧ smooth_on I I f.symm f.target :=
+begin
+  split,
+  { intros h,
+    refine ⟨is_local_structomorph_on_cont_diff_groupoid_iff_aux h,
+      is_local_structomorph_on_cont_diff_groupoid_iff_aux _⟩,
+    -- todo: we can generalize this part of the proof to a lemma
+    intros X hX,
+    let x := f.symm X,
+    have hx : x ∈ f.source := f.symm.maps_to hX,
+    let c := chart_at H x,
+    let c' := chart_at H X,
+    obtain ⟨-, hxf⟩ := h x hx,
+    refine ⟨(f.symm.continuous_at hX).continuous_within_at, λ h2x, _⟩,
+    obtain ⟨e, he, h2e, hef, hex⟩ : ∃ e : local_homeomorph H H, e ∈ cont_diff_groupoid ⊤ I ∧
+      e.source ⊆ (c.symm ≫ₕ f ≫ₕ c').source ∧
+      eq_on (c' ∘ f ∘ c.symm) e e.source ∧ c x ∈ e.source,
+    { have h1 : c' = chart_at H (f x) := by simp only [f.right_inv hX],
+      have h2 : ⇑c' ∘ ⇑f ∘ ⇑(c.symm) = ⇑(c.symm ≫ₕ f ≫ₕ c') := rfl,
+      have hcx : c x ∈ c.symm ⁻¹' f.source, { simp only [hx] with mfld_simps },
+      rw [h2],
+      rw [← h1, h2, local_homeomorph.is_local_structomorph_within_at_iff'] at hxf,
+      { exact hxf hcx },
+      { mfld_set_tac },
+      { apply or.inl,
+        simp only [hx, h1] with mfld_simps } },
+    have h2X : c' X = e (c (f.symm X)),
+    { rw ← hef hex,
+      dsimp only [function.comp],
+      have hfX : f.symm X ∈ c.source := by simp only [hX] with mfld_simps,
+      rw [c.left_inv hfX, f.right_inv hX] },
+    have h3e : eq_on (c ∘ f.symm ∘ c'.symm) e.symm (c'.symm ⁻¹' f.target ∩ e.target),
+    { have h1 : eq_on (c.symm ≫ₕ f ≫ₕ c').symm e.symm (e.target ∩ e.target),
+      { apply eq_on.symm,
+        refine e.is_image_source_target.symm_eq_on_of_inter_eq_of_eq_on _ _,
+        { rw [inter_self, inter_eq_right_iff_subset.mpr h2e] },
+        rw [inter_self], exact hef.symm },
+      have h2 : e.target ⊆ (c.symm ≫ₕ f ≫ₕ c').target,
+      { intros x hx, rw [← e.right_inv hx, ← hef (e.symm.maps_to hx)],
+        exact local_homeomorph.maps_to _ (h2e $ e.symm.maps_to hx) },
+      rw [inter_self] at h1,
+      rwa [inter_eq_right_iff_subset.mpr],
+      refine h2.trans _,
+      mfld_set_tac },
+    refine ⟨e.symm, structure_groupoid.symm _ he, h3e, _⟩,
+    rw [h2X], exact e.maps_to hex },
+  { -- We now show the converse: a local homeomorphism `f : M → M'` which is smooth in both
+    -- directions is a local structomorphism.  We do this by proposing
+    -- `((chart_at H x).symm.trans f).trans (chart_at H (f x))` as a candidate for a structomorphism
+    -- of `H`.
+    rintros ⟨h₁, h₂⟩ x hx,
+    refine ⟨(h₁ x hx).continuous_within_at, _⟩,
+    let c := chart_at H x,
+    let c' := chart_at H (f x),
+    rintros (hx' : c x ∈ c.symm ⁻¹' f.source),
+    -- propose `(c.symm.trans f).trans c'` as a candidate for a local structomorphism of `H`
+    refine ⟨(c.symm.trans f).trans c', ⟨_, _⟩, (_ : eq_on (c' ∘ f ∘ c.symm) _ _), _⟩,
+    { -- smoothness of the candidate local structomorphism in the forward direction
+      intros y hy,
+      simp only with mfld_simps at hy,
+      have H : cont_mdiff_within_at I I ⊤ f (f ≫ₕ c').source (((ext_chart_at I x).symm) y),
+      { refine (h₁ ((ext_chart_at I x).symm y) _).mono _,
+        { simp only [hy] with mfld_simps },
+        { mfld_set_tac } },
+      have hy' : (ext_chart_at I x).symm y ∈ c.source := by simp only [hy] with mfld_simps,
+      have hy'' : f ((ext_chart_at I x).symm y) ∈ c'.source := by simp only [hy] with mfld_simps,
+      rw cont_mdiff_within_at_iff_of_mem_source hy' hy'' at H,
+      { convert H.2.mono _,
+        { simp only [hy] with mfld_simps },
+        { mfld_set_tac } },
+      { apply_instance },
+      { apply_instance } },
+    { -- smoothness of the candidate local structomorphism in the reverse direction
+      intros y hy,
+      simp only with mfld_simps at hy,
+      have H : cont_mdiff_within_at I I ⊤ f.symm (f.symm ≫ₕ c).source
+        (((ext_chart_at I (f x)).symm) y),
+      { refine (h₂ ((ext_chart_at I (f x)).symm y) _).mono _,
+        { simp only [hy] with mfld_simps },
+        { mfld_set_tac } },
+      have hy' : (ext_chart_at I (f x)).symm y ∈ c'.source := by simp only [hy] with mfld_simps,
+      have hy'' : f.symm ((ext_chart_at I (f x)).symm y) ∈ c.source,
+      { simp only [hy] with mfld_simps },
+      rw cont_mdiff_within_at_iff_of_mem_source hy' hy'' at H,
+      { convert H.2.mono _,
+        { simp only [hy] with mfld_simps },
+        { mfld_set_tac } },
+      { apply_instance },
+      { apply_instance } },
+    -- now check the candidate local structomorphism agrees with `f` where it is supposed to
+    { simp only with mfld_simps },
+    { simp only [hx'] with mfld_simps } },
+end
+
+end
diff --git a/src/geometry/manifold/cont_mdiff_map.lean b/src/geometry/manifold/cont_mdiff_map.lean
index 8fa29bf4479e5..e5c95ee2813fd 100644
--- a/src/geometry/manifold/cont_mdiff_map.lean
+++ b/src/geometry/manifold/cont_mdiff_map.lean
@@ -10,36 +10,40 @@ import topology.continuous_function.basic
 /-!
 # Smooth bundled map
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the type `cont_mdiff_map` of `n` times continuously differentiable
 bundled maps.
 -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H : Type*} [topological_space H]
 {H' : Type*} [topological_space H']
 (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
 (M : Type*) [topological_space M] [charted_space H M]
 (M' : Type*) [topological_space M'] [charted_space H' M']
-{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
 {H'' : Type*} [topological_space H'']
 {I'' : model_with_corners 𝕜 E'' H''}
 {M'' : Type*} [topological_space M''] [charted_space H'' M'']
-(n : with_top ℕ)
+-- declare a manifold `N` over the pair `(F, G)`.
+{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+{G : Type*} [topological_space G] {J : model_with_corners 𝕜 F G}
+{N : Type*} [topological_space N] [charted_space G N]
+(n : ℕ∞)
 
 /-- Bundled `n` times continuously differentiable maps. -/
-@[protect_proj]
-structure cont_mdiff_map :=
-(to_fun                  : M → M')
-(cont_mdiff_to_fun : cont_mdiff I I' n to_fun)
+def cont_mdiff_map := {f : M → M' // cont_mdiff I I' n f}
 
 /-- Bundled smooth maps. -/
 @[reducible] def smooth_map := cont_mdiff_map I I' M M' ⊤
 
-localized "notation `C^` n `⟮` I `, ` M `; ` I' `, ` M' `⟯` :=
+localized "notation (name := cont_mdiff_map) `C^` n `⟮` I `, ` M `; ` I' `, ` M' `⟯` :=
   cont_mdiff_map I I' M M' n" in manifold
-localized "notation `C^` n `⟮` I `, ` M `; ` k `⟯` :=
+localized "notation (name := cont_mdiff_map.self) `C^` n `⟮` I `, ` M `; ` k `⟯` :=
   cont_mdiff_map I (model_with_corners_self k k) M k n" in manifold
 
 open_locale manifold
@@ -48,35 +52,26 @@ namespace cont_mdiff_map
 
 variables {I} {I'} {M} {M'} {n}
 
-instance : has_coe_to_fun C^n⟮I, M; I', M'⟯ (λ _, M → M') := ⟨cont_mdiff_map.to_fun⟩
-instance : has_coe C^n⟮I, M; I', M'⟯ C(M, M') :=
-⟨λ f, ⟨f, f.cont_mdiff_to_fun.continuous⟩⟩
-
-attribute [to_additive_ignore_args 21] cont_mdiff_map
-  cont_mdiff_map.has_coe_to_fun cont_mdiff_map.continuous_map.has_coe
-variables {f g : C^n⟮I, M; I', M'⟯}
-
-@[simp] lemma coe_fn_mk (f : M → M') (hf : cont_mdiff I I' n f) :
-  (mk f hf : M → M') = f :=
-rfl
+instance fun_like : fun_like C^n⟮I, M; I', M'⟯ M (λ _, M') :=
+{ coe := subtype.val,
+  coe_injective' := subtype.coe_injective }
 
 protected lemma cont_mdiff (f : C^n⟮I, M; I', M'⟯) :
-  cont_mdiff I I' n f := f.cont_mdiff_to_fun
+  cont_mdiff I I' n f := f.prop
 
 protected lemma smooth (f : C^∞⟮I, M; I', M'⟯) :
-  smooth I I' f := f.cont_mdiff_to_fun
+  smooth I I' f := f.prop
 
-protected lemma mdifferentiable' (f : C^n⟮I, M; I', M'⟯) (hn : 1 ≤ n) :
-  mdifferentiable I I' f :=
-f.cont_mdiff.mdifferentiable hn
+instance : has_coe C^n⟮I, M; I', M'⟯ C(M, M') :=
+⟨λ f, ⟨f, f.cont_mdiff.continuous⟩⟩
 
-protected lemma mdifferentiable (f : C^∞⟮I, M; I', M'⟯) :
-  mdifferentiable I I' f :=
-f.cont_mdiff.mdifferentiable le_top
+attribute [to_additive_ignore_args 21] cont_mdiff_map
+  cont_mdiff_map.fun_like cont_mdiff_map.continuous_map.has_coe
+variables {f g : C^n⟮I, M; I', M'⟯}
 
-protected lemma mdifferentiable_at (f : C^∞⟮I, M; I', M'⟯) {x} :
-  mdifferentiable_at I I' f x :=
-f.mdifferentiable x
+@[simp] lemma coe_fn_mk (f : M → M') (hf : cont_mdiff I I' n f) :
+  ((by exact subtype.mk f hf : C^n⟮I, M; I', M'⟯) : M → M') = f :=
+rfl
 
 lemma coe_inj ⦃f g : C^n⟮I, M; I', M'⟯⦄ (h : (f : M → M') = g) : f = g :=
 by cases f; cases g; cases h; refl
@@ -84,13 +79,18 @@ by cases f; cases g; cases h; refl
 @[ext] theorem ext (h : ∀ x, f x = g x) : f = g :=
 by cases f; cases g; congr'; exact funext h
 
+instance : continuous_map_class C^n⟮I, M; I', M'⟯ M M' :=
+{ coe := (λ f, ⇑f),
+  coe_injective' := coe_inj,
+  map_continuous := λ f, f.cont_mdiff.continuous }
+
 /-- The identity as a smooth map. -/
 def id : C^n⟮I, M; I, M⟯ := ⟨id, cont_mdiff_id⟩
 
 /-- The composition of smooth maps, as a smooth map. -/
 def comp (f : C^n⟮I', M'; I'', M''⟯) (g : C^n⟮I, M; I', M'⟯) : C^n⟮I, M; I'', M''⟯ :=
-{ to_fun := λ a, f (g a),
-  cont_mdiff_to_fun := f.cont_mdiff_to_fun.comp g.cont_mdiff_to_fun, }
+{ val := λ a, f (g a),
+  property := f.cont_mdiff.comp g.cont_mdiff, }
 
 @[simp] lemma comp_apply (f : C^n⟮I', M'; I'', M''⟯) (g : C^n⟮I, M; I', M'⟯) (x : M) :
   f.comp g x = f (g x) := rfl
@@ -101,6 +101,16 @@ instance [inhabited M'] : inhabited C^n⟮I, M; I', M'⟯ :=
 /-- Constant map as a smooth map -/
 def const (y : M') : C^n⟮I, M; I', M'⟯ := ⟨λ x, y, cont_mdiff_const⟩
 
+/-- The first projection of a product, as a smooth map. -/
+def fst : C^n⟮I.prod I', M × M'; I, M⟯ := ⟨prod.fst, cont_mdiff_fst⟩
+
+/-- The second projection of a product, as a smooth map. -/
+def snd : C^n⟮I.prod I', M × M'; I', M'⟯ := ⟨prod.snd, cont_mdiff_snd⟩
+
+/-- Given two smooth maps `f` and `g`, this is the smooth map `x ↦ (f x, g x)`. -/
+def prod_mk (f : C^n⟮J, N; I, M⟯) (g : C^n⟮J, N; I', M'⟯) : C^n⟮J, N; I.prod I', M × M'⟯ :=
+⟨λ x, (f x, g x), f.2.prod_mk g.2⟩
+
 end cont_mdiff_map
 
 instance continuous_linear_map.has_coe_to_cont_mdiff_map :
diff --git a/src/geometry/manifold/cont_mdiff_mfderiv.lean b/src/geometry/manifold/cont_mdiff_mfderiv.lean
new file mode 100644
index 0000000000000..89abe55046496
--- /dev/null
+++ b/src/geometry/manifold/cont_mdiff_mfderiv.lean
@@ -0,0 +1,660 @@
+/-
+Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel, Floris van Doorn
+-/
+import geometry.manifold.mfderiv
+import geometry.manifold.cont_mdiff_map
+
+/-!
+### Interactions between differentiability, smoothness and manifold derivatives
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We give the relation between `mdifferentiable`, `cont_mdiff`, `mfderiv`, `tangent_map`
+and related notions.
+
+## Main statements
+
+* `cont_mdiff_on.cont_mdiff_on_tangent_map_within` states that the bundled derivative
+  of a `Cⁿ` function in a domain is `Cᵐ` when `m + 1 ≤ n`.
+* `cont_mdiff.cont_mdiff_tangent_map` states that the bundled derivative
+  of a `Cⁿ` function is `Cᵐ` when `m + 1 ≤ n`.
+-/
+
+open set function filter charted_space smooth_manifold_with_corners bundle
+open_locale topology manifold bundle
+
+/-! ### Definition of smooth functions between manifolds -/
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+-- declare a smooth manifold `M` over the pair `(E, H)`.
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
+{M : Type*} [topological_space M] [charted_space H M] [Is : smooth_manifold_with_corners I M]
+-- declare a smooth manifold `M'` over the pair `(E', H')`.
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
+{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
+{M' : Type*} [topological_space M'] [charted_space H' M'] [I's : smooth_manifold_with_corners I' M']
+-- declare a smooth manifold `N` over the pair `(F, G)`.
+{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+{G : Type*} [topological_space G] {J : model_with_corners 𝕜 F G}
+{N : Type*} [topological_space N] [charted_space G N] [Js : smooth_manifold_with_corners J N]
+-- declare a smooth manifold `N'` over the pair `(F', G')`.
+{F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜 F']
+{G' : Type*} [topological_space G'] {J' : model_with_corners 𝕜 F' G'}
+{N' : Type*} [topological_space N'] [charted_space G' N'] [J's : smooth_manifold_with_corners J' N']
+-- declare some additional normed spaces, used for fibers of vector bundles
+{F₁ : Type*} [normed_add_comm_group F₁] [normed_space 𝕜 F₁]
+{F₂ : Type*} [normed_add_comm_group F₂] [normed_space 𝕜 F₂]
+-- declare functions, sets, points and smoothness indices
+{f f₁ : M → M'} {s s₁ t : set M} {x : M} {m n : ℕ∞}
+
+/-! ### Deducing differentiability from smoothness -/
+
+lemma cont_mdiff_within_at.mdifferentiable_within_at
+  (hf : cont_mdiff_within_at I I' n f s x) (hn : 1 ≤ n) :
+  mdifferentiable_within_at I I' f s x :=
+begin
+  suffices h : mdifferentiable_within_at I I' f (s ∩ (f ⁻¹' (ext_chart_at I' (f x)).source)) x,
+  { rwa mdifferentiable_within_at_inter' at h,
+    apply (hf.1).preimage_mem_nhds_within,
+    exact ext_chart_at_source_mem_nhds I' (f x) },
+  rw mdifferentiable_within_at_iff,
+  exact ⟨hf.1.mono (inter_subset_left _ _),
+    (hf.2.differentiable_within_at hn).mono (by mfld_set_tac)⟩,
+end
+
+lemma cont_mdiff_at.mdifferentiable_at (hf : cont_mdiff_at I I' n f x) (hn : 1 ≤ n) :
+  mdifferentiable_at I I' f x :=
+mdifferentiable_within_at_univ.1 $ cont_mdiff_within_at.mdifferentiable_within_at hf hn
+
+lemma cont_mdiff_on.mdifferentiable_on (hf : cont_mdiff_on I I' n f s) (hn : 1 ≤ n) :
+  mdifferentiable_on I I' f s :=
+λ x hx, (hf x hx).mdifferentiable_within_at hn
+
+lemma cont_mdiff.mdifferentiable (hf : cont_mdiff I I' n f) (hn : 1 ≤ n) :
+  mdifferentiable I I' f :=
+λ x, (hf x).mdifferentiable_at hn
+
+lemma smooth_within_at.mdifferentiable_within_at
+  (hf : smooth_within_at I I' f s x) : mdifferentiable_within_at I I' f s x :=
+hf.mdifferentiable_within_at le_top
+
+lemma smooth_at.mdifferentiable_at (hf : smooth_at I I' f x) : mdifferentiable_at I I' f x :=
+hf.mdifferentiable_at le_top
+
+lemma smooth_on.mdifferentiable_on (hf : smooth_on I I' f s) : mdifferentiable_on I I' f s :=
+hf.mdifferentiable_on le_top
+
+lemma smooth.mdifferentiable (hf : smooth I I' f) : mdifferentiable I I' f :=
+cont_mdiff.mdifferentiable hf le_top
+
+lemma smooth.mdifferentiable_at (hf : smooth I I' f) : mdifferentiable_at I I' f x :=
+hf.mdifferentiable x
+
+lemma smooth.mdifferentiable_within_at (hf : smooth I I' f) :
+  mdifferentiable_within_at I I' f s x :=
+hf.mdifferentiable_at.mdifferentiable_within_at
+
+/-! ### The derivative of a smooth function is smooth -/
+
+section mfderiv
+
+include Is I's Js
+
+/-- The function that sends `x` to the `y`-derivative of `f(x,y)` at `g(x)` is `C^m` at `x₀`,
+where the derivative is taken as a continuous linear map.
+We have to assume that `f` is `C^n` at `(x₀, g(x₀))` for `n ≥ m + 1` and `g` is `C^m` at `x₀`.
+We have to insert a coordinate change from `x₀` to `x` to make the derivative sensible.
+This result is used to show that maps into the 1-jet bundle and cotangent bundle are smooth.
+`cont_mdiff_at.mfderiv_id` and `cont_mdiff_at.mfderiv_const` are special cases of this.
+
+This result should be generalized to a `cont_mdiff_within_at` for `mfderiv_within`.
+If we do that, we can deduce `cont_mdiff_on.cont_mdiff_on_tangent_map_within` from this.
+-/
+theorem cont_mdiff_at.mfderiv {x₀ : N} (f : N → M → M') (g : N → M)
+  (hf : cont_mdiff_at (J.prod I) I' n (function.uncurry f) (x₀, g x₀))
+  (hg : cont_mdiff_at J I m g x₀) (hmn : m + 1 ≤ n) :
+  cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
+    (in_tangent_coordinates I I' g (λ x, f x (g x)) (λ x, mfderiv I I' (f x) (g x)) x₀) x₀ :=
+begin
+  have h4f : continuous_at (λ x, f x (g x)) x₀,
+  { apply continuous_at.comp (by apply hf.continuous_at) (continuous_at_id.prod hg.continuous_at) },
+  have h4f := h4f.preimage_mem_nhds (ext_chart_at_source_mem_nhds I' (f x₀ (g x₀))),
+  have h3f := cont_mdiff_at_iff_cont_mdiff_at_nhds.mp (hf.of_le $ (self_le_add_left 1 m).trans hmn),
+  have h2f : ∀ᶠ x₂ in 𝓝 x₀, cont_mdiff_at I I' 1 (f x₂) (g x₂),
+  { refine ((continuous_at_id.prod hg.continuous_at).tendsto.eventually h3f).mono (λ x hx, _),
+    exact hx.comp (g x) (cont_mdiff_at_const.prod_mk cont_mdiff_at_id) },
+  have h2g := hg.continuous_at.preimage_mem_nhds (ext_chart_at_source_mem_nhds I (g x₀)),
+  have : cont_diff_within_at 𝕜 m (λ x, fderiv_within 𝕜
+    (ext_chart_at I' (f x₀ (g x₀)) ∘ f ((ext_chart_at J x₀).symm x) ∘ (ext_chart_at I (g x₀)).symm)
+    (range I) (ext_chart_at I (g x₀) (g ((ext_chart_at J x₀).symm x))))
+    (range J) (ext_chart_at J x₀ x₀),
+  { rw [cont_mdiff_at_iff] at hf hg,
+    simp_rw [function.comp, uncurry, ext_chart_at_prod, local_equiv.prod_coe_symm,
+      model_with_corners.range_prod] at hf ⊢,
+    refine cont_diff_within_at.fderiv_within _ hg.2 I.unique_diff hmn (mem_range_self _) _,
+    { simp_rw [ext_chart_at_to_inv], exact hf.2 },
+    { rw [← image_subset_iff],
+      rintros _ ⟨x, hx, rfl⟩,
+      exact mem_range_self _ } },
+  have : cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
+    (λ x, fderiv_within 𝕜 (ext_chart_at I' (f x₀ (g x₀)) ∘ f x ∘ (ext_chart_at I (g x₀)).symm)
+    (range I) (ext_chart_at I (g x₀) (g x))) x₀,
+  { simp_rw [cont_mdiff_at_iff_source_of_mem_source (mem_chart_source G x₀),
+      cont_mdiff_within_at_iff_cont_diff_within_at, function.comp],
+    exact this },
+  have : cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
+    (λ x, fderiv_within 𝕜 (ext_chart_at I' (f x₀ (g x₀)) ∘ (ext_chart_at I' (f x (g x))).symm ∘
+      written_in_ext_chart_at I I' (g x) (f x) ∘ ext_chart_at I (g x) ∘
+      (ext_chart_at I (g x₀)).symm) (range I) (ext_chart_at I (g x₀) (g x))) x₀,
+  { refine this.congr_of_eventually_eq _,
+    filter_upwards [h2g, h2f],
+    intros x₂ hx₂ h2x₂,
+    have : ∀ x ∈ (ext_chart_at I (g x₀)).symm ⁻¹' (ext_chart_at I (g x₂)).source ∩
+        (ext_chart_at I (g x₀)).symm ⁻¹' (f x₂ ⁻¹' (ext_chart_at I' (f x₂ (g x₂))).source),
+      (ext_chart_at I' (f x₀ (g x₀)) ∘ (ext_chart_at I' (f x₂ (g x₂))).symm ∘
+      written_in_ext_chart_at I I' (g x₂) (f x₂) ∘ ext_chart_at I (g x₂) ∘
+      (ext_chart_at I (g x₀)).symm) x =
+      ext_chart_at I' (f x₀ (g x₀)) (f x₂ ((ext_chart_at I (g x₀)).symm x)),
+    { rintro x ⟨hx, h2x⟩,
+      simp_rw [written_in_ext_chart_at, function.comp_apply],
+      rw [(ext_chart_at I (g x₂)).left_inv hx, (ext_chart_at I' (f x₂ (g x₂))).left_inv h2x] },
+    refine filter.eventually_eq.fderiv_within_eq_nhds _,
+    refine eventually_of_mem (inter_mem _ _) this,
+    { exact ext_chart_at_preimage_mem_nhds' _ _ hx₂ (ext_chart_at_source_mem_nhds I (g x₂)) },
+    refine ext_chart_at_preimage_mem_nhds' _ _ hx₂ _,
+    exact (h2x₂.continuous_at).preimage_mem_nhds (ext_chart_at_source_mem_nhds _ _) },
+  /- The conclusion is equal to the following, when unfolding coord_change of
+    `tangent_bundle_core` -/
+  have : cont_mdiff_at J 𝓘(𝕜, E →L[𝕜] E') m
+    (λ x, (fderiv_within 𝕜 (ext_chart_at I' (f x₀ (g x₀)) ∘ (ext_chart_at I' (f x (g x))).symm)
+        (range I') (ext_chart_at I' (f x (g x)) (f x (g x)))).comp
+        ((mfderiv I I' (f x) (g x)).comp (fderiv_within 𝕜 (ext_chart_at I (g x) ∘
+        (ext_chart_at I (g x₀)).symm) (range I) (ext_chart_at I (g x₀) (g x))))) x₀,
+  { refine this.congr_of_eventually_eq _,
+    filter_upwards [h2g, h2f, h4f],
+    intros x₂ hx₂ h2x₂ h3x₂,
+    symmetry,
+    rw [(h2x₂.mdifferentiable_at le_rfl).mfderiv],
+    have hI := (cont_diff_within_at_ext_coord_change I (g x₂) (g x₀) $
+      local_equiv.mem_symm_trans_source _ hx₂ $ mem_ext_chart_source I (g x₂))
+      .differentiable_within_at le_top,
+    have hI' := (cont_diff_within_at_ext_coord_change I' (f x₀ (g x₀)) (f x₂ (g x₂)) $
+      local_equiv.mem_symm_trans_source _
+      (mem_ext_chart_source I' (f x₂ (g x₂))) h3x₂).differentiable_within_at le_top,
+    have h3f := (h2x₂.mdifferentiable_at le_rfl).2,
+    refine fderiv_within.comp₃ _ hI' h3f hI _ _ _ _ (I.unique_diff _ $ mem_range_self _),
+    { exact λ x _, mem_range_self _ },
+    { exact λ x _, mem_range_self _ },
+    { simp_rw [written_in_ext_chart_at, function.comp_apply,
+        (ext_chart_at I (g x₂)).left_inv (mem_ext_chart_source I (g x₂))] },
+    { simp_rw [function.comp_apply, (ext_chart_at I (g x₀)).left_inv hx₂] } },
+  refine this.congr_of_eventually_eq _,
+  filter_upwards [h2g, h4f] with x hx h2x,
+  rw [in_tangent_coordinates_eq],
+  { refl },
+  { rwa [ext_chart_at_source] at hx },
+  { rwa [ext_chart_at_source] at h2x },
+end
+
+omit Js
+
+/-- The derivative `D_yf(y)` is `C^m` at `x₀`, where the derivative is taken as a continuous
+linear map. We have to assume that `f` is `C^n` at `x₀` for some `n ≥ m + 1`.
+We have to insert a coordinate change from `x₀` to `x` to make the derivative sensible.
+This is a special case of `cont_mdiff_at.mfderiv` where `f` does not contain any parameters and
+`g = id`.
+-/
+lemma cont_mdiff_at.mfderiv_const {x₀ : M} {f : M → M'}
+  (hf : cont_mdiff_at I I' n f x₀) (hmn : m + 1 ≤ n) :
+  cont_mdiff_at I 𝓘(𝕜, E →L[𝕜] E') m (in_tangent_coordinates I I' id f (mfderiv I I' f) x₀) x₀ :=
+begin
+  have : cont_mdiff_at (I.prod I) I' n (λ x : M × M, f x.2) (x₀, x₀) :=
+    cont_mdiff_at.comp (x₀, x₀) hf cont_mdiff_at_snd,
+  exact this.mfderiv (λ x, f) id cont_mdiff_at_id hmn,
+end
+
+include Js
+/-- The function that sends `x` to the `y`-derivative of `f(x,y)` at `g(x)` applied to `g₂(x)` is
+`C^n` at `x₀`, where the derivative is taken as a continuous linear map.
+We have to assume that `f` is `C^(n+1)` at `(x₀, g(x₀))` and `g` is `C^n` at `x₀`.
+We have to insert a coordinate change from `x₀` to `g₁(x)` to make the derivative sensible.
+
+This is  similar to `cont_mdiff_at.mfderiv`, but where the continuous linear map is applied to a
+(variable) vector.
+-/
+lemma cont_mdiff_at.mfderiv_apply {x₀ : N'} (f : N → M → M') (g : N → M) (g₁ : N' → N)
+  (g₂ : N' → E)
+  (hf : cont_mdiff_at (J.prod I) I' n (function.uncurry f) (g₁ x₀, g (g₁ x₀)))
+  (hg : cont_mdiff_at J I m g (g₁ x₀))
+  (hg₁ : cont_mdiff_at J' J m g₁ x₀)
+  (hg₂ : cont_mdiff_at J' 𝓘(𝕜, E) m g₂ x₀) (hmn : m + 1 ≤ n) :
+  cont_mdiff_at J' 𝓘(𝕜, E') m
+    (λ x, in_tangent_coordinates I I' g (λ x, f x (g x)) (λ x, mfderiv I I' (f x) (g x))
+      (g₁ x₀) (g₁ x) (g₂ x))
+    x₀ :=
+((hf.mfderiv f g hg hmn).comp_of_eq hg₁ rfl).clm_apply hg₂
+
+end mfderiv
+
+/-! ### The tangent map of a smooth function is smooth -/
+
+section tangent_map
+
+/-- If a function is `C^n` with `1 ≤ n` on a domain with unique derivatives, then its bundled
+derivative is continuous. In this auxiliary lemma, we prove this fact when the source and target
+space are model spaces in models with corners. The general fact is proved in
+`cont_mdiff_on.continuous_on_tangent_map_within`-/
+lemma cont_mdiff_on.continuous_on_tangent_map_within_aux
+  {f : H → H'} {s : set H}
+  (hf : cont_mdiff_on I I' n f s) (hn : 1 ≤ n) (hs : unique_mdiff_on I s) :
+  continuous_on (tangent_map_within I I' f s) (π E (tangent_space I) ⁻¹' s) :=
+begin
+  suffices h : continuous_on (λ (p : H × E), (f p.fst,
+    (fderiv_within 𝕜 (written_in_ext_chart_at I I' p.fst f) (I.symm ⁻¹' s ∩ range I)
+      ((ext_chart_at I p.fst) p.fst) : E →L[𝕜] E') p.snd)) (prod.fst ⁻¹' s),
+  { have A := (tangent_bundle_model_space_homeomorph H I).continuous,
+    rw continuous_iff_continuous_on_univ at A,
+    have B := ((tangent_bundle_model_space_homeomorph H' I').symm.continuous.comp_continuous_on h)
+      .comp' A,
+    have : (univ ∩ ⇑(tangent_bundle_model_space_homeomorph H I) ⁻¹' (prod.fst ⁻¹' s)) =
+      π E (tangent_space I) ⁻¹' s,
+      by { ext ⟨x, v⟩, simp only with mfld_simps },
+    rw this at B,
+    apply B.congr,
+    rintros ⟨x, v⟩ hx,
+    dsimp [tangent_map_within],
+    ext, { refl },
+    simp only with mfld_simps,
+    apply congr_fun,
+    apply congr_arg,
+    rw mdifferentiable_within_at.mfderiv_within (hf.mdifferentiable_on hn x hx),
+    refl },
+  suffices h : continuous_on (λ (p : H × E), (fderiv_within 𝕜 (I' ∘ f ∘ I.symm)
+    (I.symm ⁻¹' s ∩ range I) (I p.fst) : E →L[𝕜] E') p.snd) (prod.fst ⁻¹' s),
+  { dsimp [written_in_ext_chart_at, ext_chart_at],
+    apply continuous_on.prod
+      (continuous_on.comp hf.continuous_on continuous_fst.continuous_on (subset.refl _)),
+    apply h.congr,
+    assume p hp,
+    refl },
+  suffices h : continuous_on (fderiv_within 𝕜 (I' ∘ f ∘ I.symm)
+                     (I.symm ⁻¹' s ∩ range I)) (I '' s),
+  { have C := continuous_on.comp h I.continuous_to_fun.continuous_on (subset.refl _),
+    have A : continuous (λq : (E →L[𝕜] E') × E, q.1 q.2) :=
+      is_bounded_bilinear_map_apply.continuous,
+    have B : continuous_on (λp : H × E,
+      (fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I)
+                       (I p.1), p.2)) (prod.fst ⁻¹' s),
+    { apply continuous_on.prod _ continuous_snd.continuous_on,
+      refine (continuous_on.comp C continuous_fst.continuous_on _ : _),
+      exact preimage_mono (subset_preimage_image _ _) },
+    exact A.comp_continuous_on B },
+  rw cont_mdiff_on_iff at hf,
+  let x : H := I.symm (0 : E),
+  let y : H' := I'.symm (0 : E'),
+  have A := hf.2 x y,
+  simp only [I.image_eq, inter_comm] with mfld_simps at A ⊢,
+  apply A.continuous_on_fderiv_within _ hn,
+  convert hs.unique_diff_on_target_inter x using 1,
+  simp only [inter_comm] with mfld_simps
+end
+
+/-- If a function is `C^n` on a domain with unique derivatives, then its bundled derivative is
+`C^m` when `m+1 ≤ n`. In this auxiliary lemma, we prove this fact when the source and target space
+are model spaces in models with corners. The general fact is proved in
+`cont_mdiff_on.cont_mdiff_on_tangent_map_within` -/
+lemma cont_mdiff_on.cont_mdiff_on_tangent_map_within_aux
+  {f : H → H'} {s : set H}
+  (hf : cont_mdiff_on I I' n f s) (hmn : m + 1 ≤ n) (hs : unique_mdiff_on I s) :
+  cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s)
+    (π E (tangent_space I) ⁻¹' s) :=
+begin
+  have m_le_n : m ≤ n,
+  { apply le_trans _ hmn,
+    have : m + 0 ≤ m + 1 := add_le_add_left (zero_le _) _,
+    simpa only [add_zero] using this },
+  have one_le_n : 1 ≤ n,
+  { apply le_trans _ hmn,
+    change 0 + 1 ≤ m + 1,
+    exact add_le_add_right (zero_le _) _ },
+  have U': unique_diff_on 𝕜 (range I ∩ I.symm ⁻¹' s),
+  { assume y hy,
+    simpa only [unique_mdiff_on, unique_mdiff_within_at, hy.1, inter_comm] with mfld_simps
+      using hs (I.symm y) hy.2 },
+  rw cont_mdiff_on_iff,
+  refine ⟨hf.continuous_on_tangent_map_within_aux one_le_n hs, λp q, _⟩,
+  have A : range I ×ˢ univ ∩
+      ((total_space.to_prod H E).symm ∘ λ (p : E × E), ((I.symm) p.fst, p.snd)) ⁻¹'
+        (π E (tangent_space I) ⁻¹' s)
+      = (range I ∩ I.symm ⁻¹' s) ×ˢ univ,
+    by { ext ⟨x, v⟩, simp only with mfld_simps, },
+  suffices h : cont_diff_on 𝕜 m (((λ (p : H' × E'), (I' p.fst, p.snd)) ∘
+      (total_space.to_prod H' E')) ∘ tangent_map_within I I' f s ∘
+      ((total_space.to_prod H E).symm) ∘ λ (p : E × E), (I.symm p.fst, p.snd))
+    ((range ⇑I ∩ ⇑(I.symm) ⁻¹' s) ×ˢ univ),
+    by simpa [A] using h,
+  change cont_diff_on 𝕜 m (λ (p : E × E),
+    ((I' (f (I.symm p.fst)), ((mfderiv_within I I' f s (I.symm p.fst)) : E → E') p.snd) : E' × E'))
+    ((range I ∩ I.symm ⁻¹' s) ×ˢ univ),
+  -- check that all bits in this formula are `C^n`
+  have hf' := cont_mdiff_on_iff.1 hf,
+  have A : cont_diff_on 𝕜 m (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) :=
+    by simpa only with mfld_simps using (hf'.2 (I.symm 0) (I'.symm 0)).of_le m_le_n,
+  have B : cont_diff_on 𝕜 m ((I' ∘ f ∘ I.symm) ∘ prod.fst)
+           ((range I ∩ I.symm ⁻¹' s) ×ˢ univ) :=
+    A.comp (cont_diff_fst.cont_diff_on) (prod_subset_preimage_fst _ _),
+  suffices C : cont_diff_on 𝕜 m (λ (p : E × E),
+    ((fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) p.1 : _) p.2))
+    ((range I ∩ I.symm ⁻¹' s) ×ˢ univ),
+  { apply cont_diff_on.prod B _,
+    apply C.congr (λp hp, _),
+    simp only with mfld_simps at hp,
+    simp only [mfderiv_within, hf.mdifferentiable_on one_le_n _ hp.2, hp.1, if_pos]
+      with mfld_simps },
+  have D : cont_diff_on 𝕜 m (λ x,
+    (fderiv_within 𝕜 (I' ∘ f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) x))
+    (range I ∩ I.symm ⁻¹' s),
+  { have : cont_diff_on 𝕜 n (I' ∘ f ∘ I.symm) (range I ∩ I.symm ⁻¹' s) :=
+      by simpa only with mfld_simps using (hf'.2 (I.symm 0) (I'.symm 0)),
+    simpa only [inter_comm] using this.fderiv_within U' hmn },
+  have := D.comp (cont_diff_fst.cont_diff_on) (prod_subset_preimage_fst _ _),
+  have := cont_diff_on.prod this (cont_diff_snd.cont_diff_on),
+  exact is_bounded_bilinear_map_apply.cont_diff.comp_cont_diff_on this,
+end
+
+include Is I's
+
+/-- If a function is `C^n` on a domain with unique derivatives, then its bundled derivative
+is `C^m` when `m+1 ≤ n`. -/
+theorem cont_mdiff_on.cont_mdiff_on_tangent_map_within
+  (hf : cont_mdiff_on I I' n f s) (hmn : m + 1 ≤ n) (hs : unique_mdiff_on I s) :
+  cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s)
+  (π E (tangent_space I) ⁻¹' s) :=
+begin
+  /- The strategy of the proof is to avoid unfolding the definitions, and reduce by functoriality
+  to the case of functions on the model spaces, where we have already proved the result.
+  Let `l` and `r` be the charts to the left and to the right, so that we have
+  ```
+     l^{-1}      f       r
+  H --------> M ---> M' ---> H'
+  ```
+  Then the tangent map `T(r ∘ f ∘ l)` is smooth by a previous result. Consider the composition
+  ```
+      Tl        T(r ∘ f ∘ l^{-1})         Tr^{-1}
+  TM -----> TH -------------------> TH' ---------> TM'
+  ```
+  where `Tr^{-1}` and `Tl` are the tangent maps of `r^{-1}` and `l`. Writing `Tl` and `Tr^{-1}` as
+  composition of charts (called `Dl` and `il` for `l` and `Dr` and `ir` in the proof below), it
+  follows that they are smooth. The composition of all these maps is `Tf`, and is therefore smooth
+  as a composition of smooth maps.
+  -/
+  have m_le_n : m ≤ n,
+  { apply le_trans _ hmn,
+    have : m + 0 ≤ m + 1 := add_le_add_left (zero_le _) _,
+    simpa only [add_zero] },
+  have one_le_n : 1 ≤ n,
+  { apply le_trans _ hmn,
+    change 0 + 1 ≤ m + 1,
+    exact add_le_add_right (zero_le _) _ },
+  /- First step: local reduction on the space, to a set `s'` which is contained in chart domains. -/
+  refine cont_mdiff_on_of_locally_cont_mdiff_on (λp hp, _),
+  have hf' := cont_mdiff_on_iff.1 hf,
+  simp only with mfld_simps at hp,
+  let l  := chart_at H p.proj,
+  set Dl := chart_at (model_prod H E) p with hDl,
+  let r  := chart_at H' (f p.proj),
+  let Dr := chart_at (model_prod H' E') (tangent_map_within I I' f s p),
+  let il := chart_at (model_prod H E) (tangent_map I I l p),
+  let ir := chart_at (model_prod H' E') (tangent_map I I' (r ∘ f) p),
+  let s' := f ⁻¹' r.source ∩ s ∩ l.source,
+  let s'_lift := π E (tangent_space I) ⁻¹' s',
+  let s'l := l.target ∩ l.symm ⁻¹' s',
+  let s'l_lift := π E (tangent_space I) ⁻¹' s'l,
+  rcases continuous_on_iff'.1 hf'.1 r.source r.open_source with ⟨o, o_open, ho⟩,
+  suffices h : cont_mdiff_on I.tangent I'.tangent m (tangent_map_within I I' f s) s'_lift,
+  { refine ⟨π E (tangent_space I) ⁻¹' (o ∩ l.source), _, _, _⟩,
+    show is_open (π E (tangent_space I) ⁻¹' (o ∩ l.source)), from
+      (is_open.inter o_open l.open_source).preimage (continuous_proj E _) ,
+    show p ∈ π E (tangent_space I) ⁻¹' (o ∩ l.source),
+    { simp,
+      have : p.proj ∈ f ⁻¹' r.source ∩ s, by simp [hp],
+      rw ho at this,
+      exact this.1 },
+    { have : π E (tangent_space I) ⁻¹' s ∩ π E (tangent_space I) ⁻¹' (o ∩ l.source) = s'_lift,
+      { dsimp only [s'_lift, s'], rw [ho], mfld_set_tac },
+      rw this,
+      exact h } },
+  /- Second step: check that all functions are smooth, and use the chain rule to write the bundled
+  derivative as a composition of a function between model spaces and of charts.
+  Convention: statements about the differentiability of `a ∘ b ∘ c` are named `diff_abc`. Statements
+  about differentiability in the bundle have a `_lift` suffix. -/
+  have U' : unique_mdiff_on I s',
+  { apply unique_mdiff_on.inter _ l.open_source,
+    rw [ho, inter_comm],
+    exact hs.inter o_open },
+  have U'l : unique_mdiff_on I s'l :=
+    U'.unique_mdiff_on_preimage (mdifferentiable_chart _ _),
+  have diff_f : cont_mdiff_on I I' n f s' :=
+    hf.mono (by mfld_set_tac),
+  have diff_r : cont_mdiff_on I' I' n r r.source :=
+    cont_mdiff_on_chart,
+  have diff_rf : cont_mdiff_on I I' n (r ∘ f) s',
+  { apply cont_mdiff_on.comp diff_r diff_f (λx hx, _),
+    simp only [s'] with mfld_simps at hx, simp only [hx] with mfld_simps },
+  have diff_l : cont_mdiff_on I I n l.symm s'l,
+  { have A : cont_mdiff_on I I n l.symm l.target :=
+      cont_mdiff_on_chart_symm,
+    exact A.mono (by mfld_set_tac) },
+  have diff_rfl : cont_mdiff_on I I' n (r ∘ f ∘ l.symm) s'l,
+  { apply cont_mdiff_on.comp diff_rf diff_l,
+    mfld_set_tac },
+  have diff_rfl_lift : cont_mdiff_on I.tangent I'.tangent m
+      (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l) s'l_lift :=
+    diff_rfl.cont_mdiff_on_tangent_map_within_aux hmn U'l,
+  have diff_irrfl_lift : cont_mdiff_on I.tangent I'.tangent m
+      (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l)) s'l_lift,
+  { have A : cont_mdiff_on I'.tangent I'.tangent m ir ir.source := cont_mdiff_on_chart,
+    exact cont_mdiff_on.comp A diff_rfl_lift (λp hp, by simp only [ir] with mfld_simps) },
+  have diff_Drirrfl_lift : cont_mdiff_on I.tangent I'.tangent m
+    (Dr.symm ∘ (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l))) s'l_lift,
+  { have A : cont_mdiff_on I'.tangent I'.tangent m Dr.symm Dr.target :=
+      cont_mdiff_on_chart_symm,
+    apply cont_mdiff_on.comp A diff_irrfl_lift (λp hp, _),
+    simp only [s'l_lift] with mfld_simps at hp,
+    simp only [ir, hp] with mfld_simps },
+  -- conclusion of this step: the composition of all the maps above is smooth
+  have diff_DrirrflilDl : cont_mdiff_on I.tangent I'.tangent m
+    (Dr.symm ∘ (ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l)) ∘
+      (il.symm ∘ Dl)) s'_lift,
+  { have A : cont_mdiff_on I.tangent I.tangent m Dl Dl.source := cont_mdiff_on_chart,
+    have A' : cont_mdiff_on I.tangent I.tangent m Dl s'_lift,
+    { apply A.mono (λp hp, _),
+      simp only [s'_lift] with mfld_simps at hp,
+      simp only [Dl, hp] with mfld_simps },
+    have B : cont_mdiff_on I.tangent I.tangent m il.symm il.target :=
+      cont_mdiff_on_chart_symm,
+    have C : cont_mdiff_on I.tangent I.tangent m (il.symm ∘ Dl) s'_lift :=
+      cont_mdiff_on.comp B A' (λp hp, by simp only [il] with mfld_simps),
+    apply cont_mdiff_on.comp diff_Drirrfl_lift C (λp hp, _),
+    simp only [s'_lift] with mfld_simps at hp,
+    simp only [il, s'l_lift, hp, total_space.proj] with mfld_simps },
+  /- Third step: check that the composition of all the maps indeed coincides with the derivative we
+  are looking for -/
+  have eq_comp : ∀q ∈ s'_lift, tangent_map_within I I' f s q =
+      (Dr.symm ∘ ir ∘ (tangent_map_within I I' (r ∘ f ∘ l.symm) s'l) ∘
+      (il.symm ∘ Dl)) q,
+  { assume q hq,
+    simp only [s'_lift] with mfld_simps at hq,
+    have U'q : unique_mdiff_within_at I s' q.1,
+      by { apply U', simp only [hq, s'] with mfld_simps },
+    have U'lq : unique_mdiff_within_at I s'l (Dl q).1,
+      by { apply U'l, simp only [hq, s'l] with mfld_simps },
+    have A : tangent_map_within I I' ((r ∘ f) ∘ l.symm) s'l (il.symm (Dl q)) =
+      tangent_map_within I I' (r ∘ f) s' (tangent_map_within I I l.symm s'l (il.symm (Dl q))),
+    { refine tangent_map_within_comp_at (il.symm (Dl q)) _ _ (λp hp, _) U'lq,
+      { apply diff_rf.mdifferentiable_on one_le_n,
+        simp only [hq] with mfld_simps },
+      { apply diff_l.mdifferentiable_on one_le_n,
+        simp only [s'l, hq] with mfld_simps },
+      { simp only with mfld_simps at hp, simp only [hp] with mfld_simps } },
+    have B : tangent_map_within I I l.symm s'l (il.symm (Dl q)) = q,
+    { have : tangent_map_within I I l.symm s'l (il.symm (Dl q))
+        = tangent_map I I l.symm (il.symm (Dl q)),
+      { refine tangent_map_within_eq_tangent_map U'lq _,
+        refine mdifferentiable_at_atlas_symm _ (chart_mem_atlas _ _) _,
+        simp only [hq] with mfld_simps },
+      rw [this, tangent_map_chart_symm, hDl],
+      { simp only [hq] with mfld_simps,
+        have : q ∈ (chart_at (model_prod H E) p).source, { simp only [hq] with mfld_simps },
+        exact (chart_at (model_prod H E) p).left_inv this },
+      { simp only [hq] with mfld_simps } },
+    have C : tangent_map_within I I' (r ∘ f) s' q
+      = tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q),
+    { refine tangent_map_within_comp_at q _ _ (λr hr, _) U'q,
+      { apply diff_r.mdifferentiable_on one_le_n,
+        simp only [hq] with mfld_simps },
+      { apply diff_f.mdifferentiable_on one_le_n,
+        simp only [hq] with mfld_simps },
+      { simp only [s'] with mfld_simps at hr,
+        simp only [hr] with mfld_simps } },
+    have D : Dr.symm (ir (tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q)))
+      = tangent_map_within I I' f s' q,
+    { have A : tangent_map_within I' I' r r.source (tangent_map_within I I' f s' q) =
+             tangent_map I' I' r (tangent_map_within I I' f s' q),
+      { apply tangent_map_within_eq_tangent_map,
+        { apply is_open.unique_mdiff_within_at _ r.open_source, simp [hq] },
+        { refine mdifferentiable_at_atlas _ (chart_mem_atlas _ _) _,
+          simp only [hq] with mfld_simps } },
+      have : f p.proj = (tangent_map_within I I' f s p).1 := rfl,
+      rw [A],
+      dsimp [r, Dr],
+      rw [this, tangent_map_chart],
+      { simp only [hq] with mfld_simps,
+        have : tangent_map_within I I' f s' q ∈
+          (chart_at (model_prod H' E') (tangent_map_within I I' f s p)).source,
+            by { simp only [hq] with mfld_simps },
+        exact (chart_at (model_prod H' E') (tangent_map_within I I' f s p)).left_inv this },
+      { simp only [hq] with mfld_simps } },
+    have E : tangent_map_within I I' f s' q = tangent_map_within I I' f s q,
+    { refine tangent_map_within_subset (by mfld_set_tac) U'q _,
+      apply hf.mdifferentiable_on one_le_n,
+      simp only [hq] with mfld_simps },
+    simp only [(∘), A, B, C, D, E.symm] },
+  exact diff_DrirrflilDl.congr eq_comp,
+end
+
+/-- If a function is `C^n` on a domain with unique derivatives, with `1 ≤ n`, then its bundled
+derivative is continuous there. -/
+theorem cont_mdiff_on.continuous_on_tangent_map_within
+  (hf : cont_mdiff_on I I' n f s) (hmn : 1 ≤ n) (hs : unique_mdiff_on I s) :
+  continuous_on (tangent_map_within I I' f s) (π E (tangent_space I) ⁻¹' s) :=
+begin
+  have : cont_mdiff_on I.tangent I'.tangent 0 (tangent_map_within I I' f s)
+         (π E (tangent_space I) ⁻¹' s) :=
+    hf.cont_mdiff_on_tangent_map_within hmn hs,
+  exact this.continuous_on
+end
+
+/-- If a function is `C^n`, then its bundled derivative is `C^m` when `m+1 ≤ n`. -/
+theorem cont_mdiff.cont_mdiff_tangent_map
+  (hf : cont_mdiff I I' n f) (hmn : m + 1 ≤ n) :
+  cont_mdiff I.tangent I'.tangent m (tangent_map I I' f) :=
+begin
+  rw ← cont_mdiff_on_univ at hf ⊢,
+  convert hf.cont_mdiff_on_tangent_map_within hmn unique_mdiff_on_univ,
+  rw tangent_map_within_univ
+end
+
+/-- If a function is `C^n`, with `1 ≤ n`, then its bundled derivative is continuous. -/
+theorem cont_mdiff.continuous_tangent_map
+  (hf : cont_mdiff I I' n f) (hmn : 1 ≤ n) :
+  continuous (tangent_map I I' f) :=
+begin
+  rw ← cont_mdiff_on_univ at hf,
+  rw continuous_iff_continuous_on_univ,
+  convert hf.continuous_on_tangent_map_within hmn unique_mdiff_on_univ,
+  rw tangent_map_within_univ
+end
+
+end tangent_map
+
+namespace tangent_bundle
+
+include Is
+variables (I M)
+open bundle
+
+/-- The derivative of the zero section of the tangent bundle maps `⟨x, v⟩` to `⟨⟨x, 0⟩, ⟨v, 0⟩⟩`.
+
+Note that, as currently framed, this is a statement in coordinates, thus reliant on the choice
+of the coordinate system we use on the tangent bundle.
+
+However, the result itself is coordinate-dependent only to the extent that the coordinates
+determine a splitting of the tangent bundle.  Moreover, there is a canonical splitting at each
+point of the zero section (since there is a canonical horizontal space there, the tangent space
+to the zero section, in addition to the canonical vertical space which is the kernel of the
+derivative of the projection), and this canonical splitting is also the one that comes from the
+coordinates on the tangent bundle in our definitions. So this statement is not as crazy as it
+may seem.
+
+TODO define splittings of vector bundles; state this result invariantly. -/
+lemma tangent_map_tangent_bundle_pure (p : tangent_bundle I M) :
+  tangent_map I I.tangent (zero_section E (tangent_space I)) p = ⟨⟨p.proj, 0⟩, ⟨p.2, 0⟩⟩ :=
+begin
+  rcases p with ⟨x, v⟩,
+  have N : I.symm ⁻¹' (chart_at H x).target ∈ 𝓝 (I ((chart_at H x) x)),
+  { apply is_open.mem_nhds,
+    apply (local_homeomorph.open_target _).preimage I.continuous_inv_fun,
+    simp only with mfld_simps },
+  have A : mdifferentiable_at I I.tangent (λ x, @total_space.mk M E (tangent_space I) x 0) x,
+  { have : smooth I (I.prod 𝓘(𝕜, E)) (zero_section E (tangent_space I : M → Type*)) :=
+    bundle.smooth_zero_section 𝕜 (tangent_space I : M → Type*),
+    exact this.mdifferentiable_at },
+  have B : fderiv_within 𝕜 (λ (x' : E), (x', (0 : E))) (set.range ⇑I) (I ((chart_at H x) x)) v
+    = (v, 0),
+  { rw [fderiv_within_eq_fderiv, differentiable_at.fderiv_prod],
+    { simp },
+    { exact differentiable_at_id' },
+    { exact differentiable_at_const _ },
+    { exact model_with_corners.unique_diff_at_image I },
+    { exact differentiable_at_id'.prod (differentiable_at_const _) } },
+  simp only [bundle.zero_section, tangent_map, mfderiv, A, if_pos, chart_at,
+    fiber_bundle.charted_space_chart_at, tangent_bundle.trivialization_at_apply,
+    tangent_bundle_core, function.comp, continuous_linear_map.map_zero] with mfld_simps,
+  rw [← fderiv_within_inter N] at B,
+  rw [← fderiv_within_inter N, ← B],
+  congr' 1,
+  refine fderiv_within_congr (λ y hy, _) _,
+  { simp only with mfld_simps at hy,
+    simp only [hy, prod.mk.inj_iff] with mfld_simps },
+  { simp only [prod.mk.inj_iff] with mfld_simps },
+end
+
+end tangent_bundle
+
+namespace cont_mdiff_map
+
+-- These helpers for dot notation have been moved here from `geometry.manifold.cont_mdiff_map`
+-- to avoid needing to import `geometry.manifold.cont_mdiff_mfderiv` there.
+-- (However as a consequence we import `geometry.manifold.cont_mdiff_map` here now.)
+-- They could be moved to another file (perhaps a new file) if desired.
+
+open_locale manifold
+
+protected lemma mdifferentiable' (f : C^n⟮I, M; I', M'⟯) (hn : 1 ≤ n) :
+  mdifferentiable I I' f :=
+f.cont_mdiff.mdifferentiable hn
+
+protected lemma mdifferentiable (f : C^∞⟮I, M; I', M'⟯) :
+  mdifferentiable I I' f :=
+f.cont_mdiff.mdifferentiable le_top
+
+protected lemma mdifferentiable_at (f : C^∞⟮I, M; I', M'⟯) {x} :
+  mdifferentiable_at I I' f x :=
+f.mdifferentiable x
+
+end cont_mdiff_map
diff --git a/src/geometry/manifold/derivation_bundle.lean b/src/geometry/manifold/derivation_bundle.lean
index fadbf3a1350f7..d4ad6affb65b6 100644
--- a/src/geometry/manifold/derivation_bundle.lean
+++ b/src/geometry/manifold/derivation_bundle.lean
@@ -5,12 +5,15 @@ Authors: Nicolò Cavalleri
 -/
 
 import geometry.manifold.algebra.smooth_functions
-import ring_theory.derivation
+import ring_theory.derivation.basic
 
 /-!
 
 # Derivation bundle
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the derivations at a point of a manifold on the algebra of smooth fuctions.
 Moreover, we define the differential of a function in terms of derivations.
 
@@ -20,10 +23,10 @@ of the Lie algebra for a Lie group.
 
 -/
 
-variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables (𝕜 : Type*) [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
-(M : Type*) [topological_space M] [charted_space H M] (n : with_top ℕ)
+(M : Type*) [topological_space M] [charted_space H M] (n : ℕ∞)
 
 open_locale manifold
 
@@ -31,19 +34,19 @@ open_locale manifold
 instance smooth_functions_algebra : algebra 𝕜 C^∞⟮I, M; 𝕜⟯ := by apply_instance
 instance smooth_functions_tower : is_scalar_tower 𝕜 C^∞⟮I, M; 𝕜⟯ C^∞⟮I, M; 𝕜⟯ := by apply_instance
 
-/-- Type synonym, introduced to put a different `has_scalar` action on `C^n⟮I, M; 𝕜⟯`
+/-- Type synonym, introduced to put a different `has_smul` action on `C^n⟮I, M; 𝕜⟯`
 which is defined as `f • r = f(x) * r`. -/
 @[nolint unused_arguments] def pointed_smooth_map (x : M) := C^n⟮I, M; 𝕜⟯
 
-localized "notation `C^` n `⟮` I `,` M `;` 𝕜 `⟯⟨` x `⟩` :=
+localized "notation (name := pointed_smooth_map) `C^` n `⟮` I `, ` M `; ` 𝕜 `⟯⟨` x `⟩` :=
   pointed_smooth_map 𝕜 I M n x" in derivation
 
 variables {𝕜 M}
 
 namespace pointed_smooth_map
 
-instance {x : M} : has_coe_to_fun C^∞⟮I, M; 𝕜⟯⟨x⟩ (λ _, M → 𝕜) :=
-cont_mdiff_map.has_coe_to_fun
+instance fun_like {x : M} : fun_like C^∞⟮I, M; 𝕜⟯⟨x⟩ M (λ _, 𝕜) :=
+cont_mdiff_map.fun_like
 instance {x : M} : comm_ring C^∞⟮I, M; 𝕜⟯⟨x⟩ := smooth_map.comm_ring
 instance {x : M} : algebra 𝕜 C^∞⟮I, M; 𝕜⟯⟨x⟩ := smooth_map.algebra
 instance {x : M} : inhabited C^∞⟮I, M; 𝕜⟯⟨x⟩ := ⟨0⟩
@@ -95,7 +98,7 @@ lemma eval_at_apply (x : M) : eval_at x X f = (X f) x := rfl
 
 end derivation
 
-variables {I} {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+variables {I} {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {M' : Type*} [topological_space M'] [charted_space H' M']
 
@@ -120,10 +123,10 @@ def fdifferential (f : C^∞⟮I, M; I', M'⟯) (x : M) :
 hfdifferential (rfl : f x = f x)
 
 /- Standard notation for the differential. The abbreviation is `MId`. -/
-localized "notation `𝒅` := fdifferential" in manifold
+localized "notation (name := fdifferential) `𝒅` := fdifferential" in manifold
 
 /- Standard notation for the differential. The abbreviation is `MId`. -/
-localized "notation `𝒅ₕ` := hfdifferential" in manifold
+localized "notation (name := hfdifferential) `𝒅ₕ` := hfdifferential" in manifold
 
 @[simp] lemma apply_fdifferential (f : C^∞⟮I, M; I', M'⟯) {x : M} (v : point_derivation I x)
   (g : C^∞⟮I', M'; 𝕜⟯) : 𝒅f x v g = v (g.comp f) := rfl
@@ -131,7 +134,7 @@ localized "notation `𝒅ₕ` := hfdifferential" in manifold
 @[simp] lemma apply_hfdifferential {f : C^∞⟮I, M; I', M'⟯} {x : M} {y : M'} (h : f x = y)
   (v : point_derivation I x) (g : C^∞⟮I', M'; 𝕜⟯) : 𝒅ₕh v g = 𝒅f x v g := rfl
 
-variables {E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
+variables {E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
 {H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
 {M'' : Type*} [topological_space M''] [charted_space H'' M'']
 
diff --git a/src/geometry/manifold/diffeomorph.lean b/src/geometry/manifold/diffeomorph.lean
index f3f29504c0973..f7eef23e11ca7 100644
--- a/src/geometry/manifold/diffeomorph.lean
+++ b/src/geometry/manifold/diffeomorph.lean
@@ -5,9 +5,13 @@ Authors: Nicolò Cavalleri, Yury Kudryashov
 -/
 
 import geometry.manifold.cont_mdiff_map
+import geometry.manifold.cont_mdiff_mfderiv
 
 /-!
 # Diffeomorphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file implements diffeomorphisms.
 
 ## Definitions
@@ -43,23 +47,25 @@ practice.
 diffeomorphism, manifold
 -/
 
-open_locale manifold topological_space
+open_locale manifold topology
 open function set
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
-{F : Type*} [normed_group F] [normed_space 𝕜 F]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
+{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
 {H : Type*} [topological_space H]
 {H' : Type*} [topological_space H']
 {G : Type*} [topological_space G]
+{G' : Type*} [topological_space G']
 {I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
-{J : model_with_corners 𝕜 F G}
+{J : model_with_corners 𝕜 F G} {J' : model_with_corners 𝕜 F G'}
 
 variables {M : Type*} [topological_space M] [charted_space H M]
 {M' : Type*} [topological_space M'] [charted_space H' M']
 {N : Type*} [topological_space N] [charted_space G N]
-{n : with_top ℕ}
+{N' : Type*} [topological_space N'] [charted_space G' N']
+{n : ℕ∞}
 
 section defs
 
@@ -68,18 +74,20 @@ variables (I I' M M' n)
 /--
 `n`-times continuously differentiable diffeomorphism between `M` and `M'` with respect to I and I'
 -/
-@[protect_proj, nolint has_inhabited_instance]
+@[protect_proj, nolint has_nonempty_instance]
 structure diffeomorph extends M ≃ M' :=
 (cont_mdiff_to_fun  : cont_mdiff I I' n to_equiv)
 (cont_mdiff_inv_fun : cont_mdiff I' I n to_equiv.symm)
 
 end defs
 
-localized "notation M ` ≃ₘ^` n:1000 `⟮`:50 I `,` J `⟯ ` N := diffeomorph I J M N n" in manifold
-localized "notation M ` ≃ₘ⟮` I `,` J `⟯ ` N := diffeomorph I J M N ⊤" in manifold
-localized "notation E ` ≃ₘ^` n:1000 `[`:50 𝕜 `] ` E' :=
+localized "notation (name := diffeomorph) M ` ≃ₘ^` n:1000 `⟮`:50 I `, ` J `⟯ ` N :=
+  diffeomorph I J M N n" in manifold
+localized "notation (name := diffeomorph.top) M ` ≃ₘ⟮` I `, ` J `⟯ ` N :=
+  diffeomorph I J M N ⊤" in manifold
+localized "notation (name := diffeomorph.self) E ` ≃ₘ^` n:1000 `[`:50 𝕜 `] ` E' :=
   diffeomorph (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') E E' n" in manifold
-localized "notation E ` ≃ₘ[` 𝕜 `] ` E' :=
+localized "notation (name := diffeomorph.self.top) E ` ≃ₘ[` 𝕜 `] ` E' :=
   diffeomorph (model_with_corners_self 𝕜 E) (model_with_corners_self 𝕜 E') E E' ⊤" in manifold
 
 namespace diffeomorph
@@ -121,6 +129,11 @@ equiv.coe_fn_injective.comp to_equiv_injective
 @[ext] lemma ext {h h' : M ≃ₘ^n⟮I, I'⟯ M'} (Heq : ∀ x, h x = h' x) : h = h' :=
 coe_fn_injective $ funext Heq
 
+instance : continuous_map_class (M ≃ₘ⟮I, J⟯ N) M N :=
+{ coe := coe_fn,
+  coe_injective' := coe_fn_injective,
+  map_continuous := λ f, f.continuous }
+
 section
 
 variables (M I n)
@@ -257,6 +270,46 @@ lemma to_local_homeomorph_mdifferentiable (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 
   h.to_homeomorph.to_local_homeomorph.mdifferentiable I J :=
 ⟨h.mdifferentiable_on _ hn, h.symm.mdifferentiable_on _ hn⟩
 
+section constructions
+
+/-- Product of two diffeomorphisms. -/
+def prod_congr (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : N ≃ₘ^n⟮J, J'⟯ N') :
+  M × N ≃ₘ^n⟮I.prod J, I'.prod J'⟯ M' × N' :=
+{ cont_mdiff_to_fun  := (h₁.cont_mdiff.comp cont_mdiff_fst).prod_mk
+    (h₂.cont_mdiff.comp cont_mdiff_snd),
+  cont_mdiff_inv_fun := (h₁.symm.cont_mdiff.comp cont_mdiff_fst).prod_mk
+    (h₂.symm.cont_mdiff.comp cont_mdiff_snd),
+  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }
+
+@[simp] lemma prod_congr_symm (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : N ≃ₘ^n⟮J, J'⟯ N') :
+  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl
+
+@[simp] lemma coe_prod_congr (h₁ : M ≃ₘ^n⟮I, I'⟯ M') (h₂ : N ≃ₘ^n⟮J, J'⟯ N') :
+  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl
+
+section
+variables (I J J' M N N' n)
+
+/-- `M × N` is diffeomorphic to `N × M`. -/
+def prod_comm : M × N ≃ₘ^n⟮I.prod J, J.prod I⟯ N × M :=
+{ cont_mdiff_to_fun  := cont_mdiff_snd.prod_mk cont_mdiff_fst,
+  cont_mdiff_inv_fun := cont_mdiff_snd.prod_mk cont_mdiff_fst,
+  to_equiv := equiv.prod_comm M N }
+
+@[simp] lemma prod_comm_symm : (prod_comm I J M N n).symm = prod_comm J I N M n := rfl
+@[simp] lemma coe_prod_comm : ⇑(prod_comm I J M N n) = prod.swap := rfl
+
+/-- `(M × N) × N'` is diffeomorphic to `M × (N × N')`. -/
+def prod_assoc : (M × N) × N' ≃ₘ^n⟮(I.prod J).prod J', I.prod (J.prod J')⟯ M × (N × N') :=
+{ cont_mdiff_to_fun  := (cont_mdiff_fst.comp cont_mdiff_fst).prod_mk
+    ((cont_mdiff_snd.comp cont_mdiff_fst).prod_mk cont_mdiff_snd),
+  cont_mdiff_inv_fun := (cont_mdiff_fst.prod_mk (cont_mdiff_fst.comp cont_mdiff_snd)).prod_mk
+    (cont_mdiff_snd.comp cont_mdiff_snd),
+  to_equiv := equiv.prod_assoc M N N' }
+
+end
+end constructions
+
 variables [smooth_manifold_with_corners I M] [smooth_manifold_with_corners J N]
 
 lemma unique_mdiff_on_image_aux (h : M ≃ₘ^n⟮I, J⟯ N) (hn : 1 ≤ n)
@@ -356,7 +409,7 @@ def to_trans_diffeomorph (e : E ≃ₘ[𝕜] F) : M ≃ₘ⟮I, I.trans_diffeomo
 { to_equiv := equiv.refl M,
   cont_mdiff_to_fun := λ x,
     begin
-      refine cont_mdiff_within_at_iff.2 ⟨continuous_within_at_id, _⟩,
+      refine cont_mdiff_within_at_iff'.2 ⟨continuous_within_at_id, _⟩,
       refine e.cont_diff.cont_diff_within_at.congr' (λ y hy, _) _,
       { simp only [equiv.coe_refl, id, (∘), I.coe_ext_chart_at_trans_diffeomorph,
           (ext_chart_at I x).right_inv hy.1] },
@@ -365,9 +418,9 @@ def to_trans_diffeomorph (e : E ≃ₘ[𝕜] F) : M ≃ₘ⟮I, I.trans_diffeomo
     end,
   cont_mdiff_inv_fun := λ x,
     begin
-      refine cont_mdiff_within_at_iff.2 ⟨continuous_within_at_id, _⟩,
+      refine cont_mdiff_within_at_iff'.2 ⟨continuous_within_at_id, _⟩,
       refine e.symm.cont_diff.cont_diff_within_at.congr' (λ y hy, _) _,
-      { simp only [mem_inter_eq, I.ext_chart_at_trans_diffeomorph_target] at hy,
+      { simp only [mem_inter_iff, I.ext_chart_at_trans_diffeomorph_target] at hy,
         simp only [equiv.coe_refl, equiv.refl_symm, id, (∘),
           I.coe_ext_chart_at_trans_diffeomorph_symm, (ext_chart_at I x).right_inv hy.1] },
       exact ⟨(ext_chart_at _ x).map_source (mem_ext_chart_source _ x), trivial,
diff --git a/src/geometry/manifold/instances/real.lean b/src/geometry/manifold/instances/real.lean
index 1e6df2db0d821..f82c76fdf1478 100644
--- a/src/geometry/manifold/instances/real.lean
+++ b/src/geometry/manifold/instances/real.lean
@@ -3,13 +3,15 @@ Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
-import linear_algebra.finite_dimensional
 import geometry.manifold.smooth_manifold_with_corners
 import analysis.inner_product_space.pi_L2
 
 /-!
 # Constructing examples of manifolds over ℝ
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We introduce the necessary bits to be able to define manifolds modelled over `ℝ^n`, boundaryless
 or with boundary or with corners. As a concrete example, we construct explicitly the manifold with
 boundary structure on the real interval `[x, y]`.
@@ -98,8 +100,8 @@ def model_with_corners_euclidean_half_space (n : ℕ) [has_zero (fin n)] :
       unique_diff_on.pi (fin n) (λ _, ℝ) _ _ (λ i ∈ ({0} : set (fin n)), unique_diff_on_Ici 0),
     by simpa only [singleton_pi] using this,
   continuous_to_fun  := continuous_subtype_val,
-  continuous_inv_fun := continuous_subtype_mk _ $ continuous_id.update 0 $
-    (continuous_apply 0).max continuous_const }
+  continuous_inv_fun := (continuous_id.update 0 $
+    (continuous_apply 0).max continuous_const).subtype_mk _ }
 
 /--
 Definition of the model with corners `(euclidean_space ℝ (fin n), euclidean_quadrant n)`, used as a
@@ -120,13 +122,13 @@ def model_with_corners_euclidean_quadrant (n : ℕ) :
       unique_diff_on.univ_pi (fin n) (λ _, ℝ) _ (λ i, unique_diff_on_Ici 0),
     by simpa only [pi_univ_Ici] using this,
   continuous_to_fun  := continuous_subtype_val,
-  continuous_inv_fun := continuous_subtype_mk _ $ continuous_pi $ λ i,
-    (continuous_id.max continuous_const).comp (continuous_apply i) }
+  continuous_inv_fun := continuous.subtype_mk (continuous_pi $ λ i,
+    (continuous_id.max continuous_const).comp (continuous_apply i)) _ }
 
-localized "notation `𝓡 `n :=
+localized "notation (name := model_with_corners_self.euclidean) `𝓡 `n :=
   (model_with_corners_self ℝ (euclidean_space ℝ (fin n)) :
     model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_space ℝ (fin n)))" in manifold
-localized "notation `𝓡∂ `n :=
+localized "notation (name := model_with_corners_euclidean_half_space.euclidean) `𝓡∂ `n :=
   (model_with_corners_euclidean_half_space n :
     model_with_corners ℝ (euclidean_space ℝ (fin n)) (euclidean_half_space n))" in manifold
 
@@ -170,14 +172,14 @@ def Icc_left_chart (x y : ℝ) [fact (x < y)] :
   end,
   continuous_to_fun := begin
     apply continuous.continuous_on,
-    apply continuous_subtype_mk,
+    apply continuous.subtype_mk,
     have : continuous (λ (z : ℝ) (i : fin 1), z - x) :=
       continuous.sub (continuous_pi $ λi, continuous_id) continuous_const,
     exact this.comp continuous_subtype_val,
   end,
   continuous_inv_fun := begin
     apply continuous.continuous_on,
-    apply continuous_subtype_mk,
+    apply continuous.subtype_mk,
     have A : continuous (λ z : ℝ, min (z + x) y) :=
       (continuous_id.add continuous_const).min continuous_const,
     have B : continuous (λz : euclidean_space ℝ (fin 1), z 0) := continuous_apply 0,
@@ -225,14 +227,14 @@ def Icc_right_chart (x y : ℝ) [fact (x < y)] :
   end,
   continuous_to_fun := begin
     apply continuous.continuous_on,
-    apply continuous_subtype_mk,
+    apply continuous.subtype_mk,
     have : continuous (λ (z : ℝ) (i : fin 1), y - z) :=
       continuous_const.sub (continuous_pi (λi, continuous_id)),
     exact this.comp continuous_subtype_val,
   end,
   continuous_inv_fun := begin
     apply continuous.continuous_on,
-    apply continuous_subtype_mk,
+    apply continuous.subtype_mk,
     have A : continuous (λ z : ℝ, max (y - z) x) :=
       (continuous_const.sub continuous_id).max continuous_const,
     have B : continuous (λz : euclidean_space ℝ (fin 1), z 0) := continuous_apply 0,
@@ -291,7 +293,7 @@ begin
     rintro _ ⟨⟨hz₁, hz₂⟩, ⟨z, hz₀⟩, rfl⟩,
     simp only [model_with_corners_euclidean_half_space, Icc_left_chart, Icc_right_chart, max_lt_iff,
       update_same, max_eq_left hz₀] with mfld_simps at hz₁ hz₂,
-    rw lt_sub at hz₁,
+    rw lt_sub_comm at hz₁,
     ext i,
     rw subsingleton.elim i 0,
     simp only [model_with_corners_euclidean_half_space, Icc_left_chart, Icc_right_chart,
@@ -304,9 +306,7 @@ end
 /-! Register the manifold structure on `Icc 0 1`, and also its zero and one. -/
 section
 
-lemma fact_zero_lt_one : fact ((0 : ℝ) < 1) := ⟨zero_lt_one⟩
-
-local attribute [instance] fact_zero_lt_one
+local attribute [instance] real.fact_zero_lt_one
 
 instance : charted_space (euclidean_half_space 1) (Icc (0 : ℝ) 1) := by apply_instance
 instance : smooth_manifold_with_corners (𝓡∂ 1) (Icc (0 : ℝ) 1) := by apply_instance
diff --git a/src/geometry/manifold/instances/sphere.lean b/src/geometry/manifold/instances/sphere.lean
index 5b25152ceaa64..71158b59e4aa9 100644
--- a/src/geometry/manifold/instances/sphere.lean
+++ b/src/geometry/manifold/instances/sphere.lean
@@ -3,15 +3,21 @@ Copyright (c) 2021 Heather Macbeth. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Heather Macbeth
 -/
-import analysis.complex.circle
+import analysis.calculus.deriv.inv
+import analysis.normed_space.ball_action
+import analysis.special_functions.exp_deriv
 import analysis.inner_product_space.calculus
 import analysis.inner_product_space.pi_L2
 import geometry.manifold.algebra.lie_group
 import geometry.manifold.instances.real
+import geometry.manifold.cont_mdiff_mfderiv
 
 /-!
 # Manifold structure on the sphere
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines stereographic projection from the sphere in an inner product space `E`, and uses
 it to put a smooth manifold structure on the sphere.
 
@@ -54,11 +60,11 @@ naive expression `euclidean_space ℝ (fin (finrank ℝ E - 1))` for the model s
 `euclidean_space ℝ (fin 1)`.
 -/
 
-variables {E : Type*} [inner_product_space ℝ E]
+variables {E : Type*} [normed_add_comm_group E] [inner_product_space ℝ E]
 
 noncomputable theory
 
-open metric finite_dimensional
+open metric finite_dimensional function
 open_locale manifold
 
 local attribute [instance] fact_finite_dimensional_of_finrank_eq_succ
@@ -73,28 +79,28 @@ the orthogonal complement of an element `v` of `E`. It is smooth away from the a
 through `v` parallel to the orthogonal complement.  It restricts on the sphere to the stereographic
 projection. -/
 def stereo_to_fun [complete_space E] (x : E) : (ℝ ∙ v)ᗮ :=
-(2 / ((1:ℝ) - innerSL v x)) • orthogonal_projection (ℝ ∙ v)ᗮ x
+(2 / ((1:ℝ) - innerSL _ v x)) • orthogonal_projection (ℝ ∙ v)ᗮ x
 
 variables {v}
 
 @[simp] lemma stereo_to_fun_apply [complete_space E] (x : E) :
-  stereo_to_fun v x = (2 / ((1:ℝ) - innerSL v x)) • orthogonal_projection (ℝ ∙ v)ᗮ x :=
+  stereo_to_fun v x = (2 / ((1:ℝ) - innerSL _ v x)) • orthogonal_projection (ℝ ∙ v)ᗮ x :=
 rfl
 
 lemma cont_diff_on_stereo_to_fun [complete_space E] :
-  cont_diff_on ℝ ⊤ (stereo_to_fun v) {x : E | innerSL v x ≠ (1:ℝ)} :=
+  cont_diff_on ℝ ⊤ (stereo_to_fun v) {x : E | innerSL _ v x ≠ (1:ℝ)} :=
 begin
   refine cont_diff_on.smul _
     (orthogonal_projection ((ℝ ∙ v)ᗮ)).cont_diff.cont_diff_on,
   refine cont_diff_const.cont_diff_on.div _ _,
-  { exact (cont_diff_const.sub (innerSL v).cont_diff).cont_diff_on },
+  { exact (cont_diff_const.sub (innerSL ℝ v).cont_diff).cont_diff_on },
   { intros x h h',
     exact h (sub_eq_zero.mp h').symm }
 end
 
 lemma continuous_on_stereo_to_fun [complete_space E] :
-  continuous_on (stereo_to_fun v) {x : E | innerSL v x ≠ (1:ℝ)} :=
-cont_diff_on_stereo_to_fun.continuous_on
+  continuous_on (stereo_to_fun v) {x : E | innerSL _ v x ≠ (1:ℝ)} :=
+(@cont_diff_on_stereo_to_fun E _ _ v _).continuous_on
 
 variables (v)
 
@@ -103,39 +109,70 @@ projection.  This is a map from the orthogonal complement of a unit vector `v` i
 space `E` to `E`; we will later prove that it takes values in the unit sphere.
 
 For most purposes, use `stereo_inv_fun`, not `stereo_inv_fun_aux`. -/
-def stereo_inv_fun_aux (w : E) : E := (∥w∥ ^ 2 + 4)⁻¹ • ((4:ℝ) • w + (∥w∥ ^ 2 - 4) • v)
+def stereo_inv_fun_aux (w : E) : E := (‖w‖ ^ 2 + 4)⁻¹ • ((4:ℝ) • w + (‖w‖ ^ 2 - 4) • v)
 
 variables {v}
 
 @[simp] lemma stereo_inv_fun_aux_apply (w : E) :
-  stereo_inv_fun_aux v w = (∥w∥ ^ 2 + 4)⁻¹ • ((4:ℝ) • w + (∥w∥ ^ 2 - 4) • v) :=
+  stereo_inv_fun_aux v w = (‖w‖ ^ 2 + 4)⁻¹ • ((4:ℝ) • w + (‖w‖ ^ 2 - 4) • v) :=
 rfl
 
-lemma stereo_inv_fun_aux_mem (hv : ∥v∥ = 1) {w : E} (hw : w ∈ (ℝ ∙ v)ᗮ) :
+lemma stereo_inv_fun_aux_mem (hv : ‖v‖ = 1) {w : E} (hw : w ∈ (ℝ ∙ v)ᗮ) :
   stereo_inv_fun_aux v w ∈ (sphere (0:E) 1) :=
 begin
-  have h₁ : 0 ≤ ∥w∥ ^ 2 + 4 := by nlinarith,
-  suffices : ∥(4:ℝ) • w + (∥w∥ ^ 2 - 4) • v∥ = ∥w∥ ^ 2 + 4,
-  { have h₂ : ∥w∥ ^ 2 + 4 ≠ 0 := by nlinarith,
+  have h₁ : 0 ≤ ‖w‖ ^ 2 + 4 := by nlinarith,
+  suffices : ‖(4:ℝ) • w + (‖w‖ ^ 2 - 4) • v‖ = ‖w‖ ^ 2 + 4,
+  { have h₂ : ‖w‖ ^ 2 + 4 ≠ 0 := by nlinarith,
     simp only [mem_sphere_zero_iff_norm, norm_smul, real.norm_eq_abs, abs_inv, this,
       abs_of_nonneg h₁, stereo_inv_fun_aux_apply],
     field_simp },
-  suffices : ∥(4:ℝ) • w + (∥w∥ ^ 2 - 4) • v∥ ^ 2 = (∥w∥ ^ 2 + 4) ^ 2,
-  { have h₃ : 0 ≤ ∥stereo_inv_fun_aux v w∥ := norm_nonneg _,
+  suffices : ‖(4:ℝ) • w + (‖w‖ ^ 2 - 4) • v‖ ^ 2 = (‖w‖ ^ 2 + 4) ^ 2,
+  { have h₃ : 0 ≤ ‖stereo_inv_fun_aux v w‖ := norm_nonneg _,
     simpa [h₁, h₃, -one_pow] using this },
+  rw submodule.mem_orthogonal_singleton_iff_inner_left at hw,
   simp [norm_add_sq_real, norm_smul, inner_smul_left, inner_smul_right,
-    inner_left_of_mem_orthogonal_singleton _ hw, mul_pow, real.norm_eq_abs, hv],
+    hw, mul_pow, real.norm_eq_abs, hv],
   ring
 end
 
+lemma has_fderiv_at_stereo_inv_fun_aux (v : E) :
+  has_fderiv_at (stereo_inv_fun_aux v) (continuous_linear_map.id ℝ E) 0 :=
+begin
+  have h₀ : has_fderiv_at (λ w : E, ‖w‖ ^ 2) (0 : E →L[ℝ] ℝ) 0,
+  { convert (has_strict_fderiv_at_norm_sq _).has_fderiv_at,
+    simp },
+  have h₁ : has_fderiv_at (λ w : E, (‖w‖ ^ 2 + 4)⁻¹) (0 : E →L[ℝ] ℝ) 0,
+  { convert (has_fderiv_at_inv _).comp _ (h₀.add (has_fderiv_at_const 4 0)); simp },
+  have h₂ : has_fderiv_at (λ w, (4:ℝ) • w + (‖w‖ ^ 2 - 4) • v)
+    ((4:ℝ) • continuous_linear_map.id ℝ E) 0,
+  { convert ((has_fderiv_at_const (4:ℝ) 0).smul (has_fderiv_at_id 0)).add
+      ((h₀.sub (has_fderiv_at_const (4:ℝ) 0)).smul (has_fderiv_at_const v 0)),
+    ext w,
+    simp, },
+  convert h₁.smul h₂,
+  ext w,
+  simp,
+end
+
+lemma has_fderiv_at_stereo_inv_fun_aux_comp_coe (v : E) :
+  has_fderiv_at (stereo_inv_fun_aux v ∘ (coe : (ℝ ∙ v)ᗮ → E)) (ℝ ∙ v)ᗮ.subtypeL 0 :=
+begin
+  have : has_fderiv_at
+    (stereo_inv_fun_aux v)
+    (continuous_linear_map.id ℝ E)
+    ((ℝ ∙ v)ᗮ.subtypeL 0) :=
+    has_fderiv_at_stereo_inv_fun_aux v,
+  convert this.comp (0 : (ℝ ∙ v)ᗮ) (by apply continuous_linear_map.has_fderiv_at),
+end
+
 lemma cont_diff_stereo_inv_fun_aux : cont_diff ℝ ⊤ (stereo_inv_fun_aux v) :=
 begin
-  have h₀ : cont_diff ℝ ⊤ (λ w : E, ∥w∥ ^ 2) := cont_diff_norm_sq,
-  have h₁ : cont_diff ℝ ⊤ (λ w : E, (∥w∥ ^ 2 + 4)⁻¹),
+  have h₀ : cont_diff ℝ ⊤ (λ w : E, ‖w‖ ^ 2) := cont_diff_norm_sq ℝ,
+  have h₁ : cont_diff ℝ ⊤ (λ w : E, (‖w‖ ^ 2 + 4)⁻¹),
   { refine (h₀.add cont_diff_const).inv _,
     intros x,
     nlinarith },
-  have h₂ : cont_diff ℝ ⊤ (λ w, (4:ℝ) • w + (∥w∥ ^ 2 - 4) • v),
+  have h₂ : cont_diff ℝ ⊤ (λ w, (4:ℝ) • w + (‖w‖ ^ 2 - 4) • v),
   { refine (cont_diff_const.smul cont_diff_id).add _,
     refine (h₀.sub cont_diff_const).smul cont_diff_const },
   exact h₁.smul h₂
@@ -143,20 +180,20 @@ end
 
 /-- Stereographic projection, reverse direction.  This is a map from the orthogonal complement of a
 unit vector `v` in an inner product space `E` to the unit sphere in `E`. -/
-def stereo_inv_fun (hv : ∥v∥ = 1) (w : (ℝ ∙ v)ᗮ) : sphere (0:E) 1 :=
+def stereo_inv_fun (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) : sphere (0:E) 1 :=
 ⟨stereo_inv_fun_aux v (w:E), stereo_inv_fun_aux_mem hv w.2⟩
 
-@[simp] lemma stereo_inv_fun_apply (hv : ∥v∥ = 1) (w : (ℝ ∙ v)ᗮ) :
-  (stereo_inv_fun hv w : E) = (∥w∥ ^ 2 + 4)⁻¹ • ((4:ℝ) • w + (∥w∥ ^ 2 - 4) • v) :=
+@[simp] lemma stereo_inv_fun_apply (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) :
+  (stereo_inv_fun hv w : E) = (‖w‖ ^ 2 + 4)⁻¹ • ((4:ℝ) • w + (‖w‖ ^ 2 - 4) • v) :=
 rfl
 
-lemma stereo_inv_fun_ne_north_pole (hv : ∥v∥ = 1) (w : (ℝ ∙ v)ᗮ) :
+lemma stereo_inv_fun_ne_north_pole (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) :
   stereo_inv_fun hv w ≠ (⟨v, by simp [hv]⟩ : sphere (0:E) 1) :=
 begin
   refine subtype.ne_of_val_ne _,
   rw ← inner_lt_one_iff_real_of_norm_one _ hv,
-  { have hw : ⟪v, w⟫_ℝ = 0 := inner_right_of_mem_orthogonal_singleton v w.2,
-    have hw' : (∥(w:E)∥ ^ 2 + 4)⁻¹ * (∥(w:E)∥ ^ 2 - 4) < 1,
+  { have hw : ⟪v, w⟫_ℝ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2,
+    have hw' : (‖(w:E)‖ ^ 2 + 4)⁻¹ * (‖(w:E)‖ ^ 2 - 4) < 1,
     { refine (inv_mul_lt_iff' _).mpr _,
       { nlinarith },
       linarith },
@@ -165,46 +202,46 @@ begin
   { simpa using stereo_inv_fun_aux_mem hv w.2 }
 end
 
-lemma continuous_stereo_inv_fun (hv : ∥v∥ = 1) : continuous (stereo_inv_fun hv) :=
-continuous_induced_rng (cont_diff_stereo_inv_fun_aux.continuous.comp continuous_subtype_coe)
+lemma continuous_stereo_inv_fun (hv : ‖v‖ = 1) : continuous (stereo_inv_fun hv) :=
+continuous_induced_rng.2 (cont_diff_stereo_inv_fun_aux.continuous.comp continuous_subtype_coe)
 
 variables [complete_space E]
 
-lemma stereo_left_inv (hv : ∥v∥ = 1) {x : sphere (0:E) 1} (hx : (x:E) ≠ v) :
+lemma stereo_left_inv (hv : ‖v‖ = 1) {x : sphere (0:E) 1} (hx : (x:E) ≠ v) :
   stereo_inv_fun hv (stereo_to_fun v x) = x :=
 begin
   ext,
   simp only [stereo_to_fun_apply, stereo_inv_fun_apply, smul_add],
   -- name two frequently-occuring quantities and write down their basic properties
-  set a : ℝ := innerSL v x,
+  set a : ℝ := innerSL _ v x,
   set y := orthogonal_projection (ℝ ∙ v)ᗮ x,
   have split : ↑x = a • v + ↑y,
   { convert eq_sum_orthogonal_projection_self_orthogonal_complement (ℝ ∙ v) x,
     exact (orthogonal_projection_unit_singleton ℝ hv x).symm },
-  have hvy : ⟪v, y⟫_ℝ = 0 := inner_right_of_mem_orthogonal_singleton v y.2,
-  have pythag : 1 = a ^ 2 + ∥y∥ ^ 2,
+  have hvy : ⟪v, y⟫_ℝ = 0 := submodule.mem_orthogonal_singleton_iff_inner_right.mp y.2,
+  have pythag : 1 = a ^ 2 + ‖y‖ ^ 2,
   { have hvy' : ⟪a • v, y⟫_ℝ = 0 := by simp [inner_smul_left, hvy],
     convert norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero _ _ hvy' using 2,
     { simp [← split] },
-    { simp [norm_smul, hv, real.norm_eq_abs, ← sq, sq_abs] },
+    { simp [norm_smul, hv, ← sq, sq_abs] },
     { exact sq _ } },
   -- two facts which will be helpful for clearing denominators in the main calculation
   have ha : 1 - a ≠ 0,
   { have : a < 1 := (inner_lt_one_iff_real_of_norm_one hv (by simp)).mpr hx.symm,
     linarith },
-  have : 2 ^ 2 * ∥y∥ ^ 2 + 4 * (1 - a) ^ 2 ≠ 0,
+  have : 2 ^ 2 * ‖y‖ ^ 2 + 4 * (1 - a) ^ 2 ≠ 0,
   { refine ne_of_gt _,
     have := norm_nonneg (y:E),
     have : 0 < (1 - a) ^ 2 := sq_pos_of_ne_zero (1 - a) ha,
     nlinarith },
   -- the core of the problem is these two algebraic identities:
-  have h₁ : (2 ^ 2 / (1 - a) ^ 2 * ∥y∥ ^ 2 + 4)⁻¹ * 4 * (2 / (1 - a)) = 1,
+  have h₁ : (2 ^ 2 / (1 - a) ^ 2 * ‖y‖ ^ 2 + 4)⁻¹ * 4 * (2 / (1 - a)) = 1,
   { field_simp,
     simp only [submodule.coe_norm] at *,
     nlinarith },
-  have h₂ : (2 ^ 2 / (1 - a) ^ 2 * ∥y∥ ^ 2 + 4)⁻¹ * (2 ^ 2 / (1 - a) ^ 2 * ∥y∥ ^ 2 - 4) = a,
+  have h₂ : (2 ^ 2 / (1 - a) ^ 2 * ‖y‖ ^ 2 + 4)⁻¹ * (2 ^ 2 / (1 - a) ^ 2 * ‖y‖ ^ 2 - 4) = a,
   { field_simp,
-    transitivity (1 - a) ^ 2 * (a * (2 ^ 2 * ∥y∥ ^ 2 + 4 * (1 - a) ^ 2)),
+    transitivity (1 - a) ^ 2 * (a * (2 ^ 2 * ‖y‖ ^ 2 + 4 * (1 - a) ^ 2)),
     { congr,
       simp only [submodule.coe_norm] at *,
       nlinarith },
@@ -217,11 +254,11 @@ begin
   { simp [split, add_comm] }
 end
 
-lemma stereo_right_inv (hv : ∥v∥ = 1) (w : (ℝ ∙ v)ᗮ) :
+lemma stereo_right_inv (hv : ‖v‖ = 1) (w : (ℝ ∙ v)ᗮ) :
   stereo_to_fun v (stereo_inv_fun hv w) = w :=
 begin
-  have : 2 / (1 - (∥(w:E)∥ ^ 2 + 4)⁻¹ * (∥(w:E)∥ ^ 2 - 4)) * (∥(w:E)∥ ^ 2 + 4)⁻¹ * 4 = 1,
-  { have : ∥(w:E)∥ ^ 2 + 4 ≠ 0 := by nlinarith,
+  have : 2 / (1 - (‖(w:E)‖ ^ 2 + 4)⁻¹ * (‖(w:E)‖ ^ 2 - 4)) * (‖(w:E)‖ ^ 2 + 4)⁻¹ * 4 = 1,
+  { have : ‖(w:E)‖ ^ 2 + 4 ≠ 0 := by nlinarith,
     have : (4:ℝ) + 4 ≠ 0 := by nlinarith,
     field_simp,
     ring },
@@ -230,8 +267,8 @@ begin
       orthogonal_projection_orthogonal_complement_singleton_eq_zero v,
     have h₂ : orthogonal_projection (ℝ ∙ v)ᗮ w = w :=
       orthogonal_projection_mem_subspace_eq_self w,
-    have h₃ : innerSL v w = (0:ℝ) := inner_right_of_mem_orthogonal_singleton v w.2,
-    have h₄ : innerSL v v = (1:ℝ) := by simp [real_inner_self_eq_norm_mul_norm, hv],
+    have h₃ : innerSL _ v w = (0:ℝ) := submodule.mem_orthogonal_singleton_iff_inner_right.mp w.2,
+    have h₄ : innerSL _ v v = (1:ℝ) := by simp [real_inner_self_eq_norm_mul_norm, hv],
     simp [h₁, h₂, h₃, h₄, continuous_linear_map.map_add, continuous_linear_map.map_smul,
       mul_smul] },
   { simp }
@@ -239,7 +276,7 @@ end
 
 /-- Stereographic projection from the unit sphere in `E`, centred at a unit vector `v` in `E`; this
 is the version as a local homeomorphism. -/
-def stereographic (hv : ∥v∥ = 1) : local_homeomorph (sphere (0:E) 1) (ℝ ∙ v)ᗮ :=
+def stereographic (hv : ‖v‖ = 1) : local_homeomorph (sphere (0:E) 1) (ℝ ∙ v)ᗮ :=
 { to_fun := (stereo_to_fun v) ∘ coe,
   inv_fun := stereo_inv_fun hv,
   source := {⟨v, by simp [hv]⟩}ᶜ,
@@ -251,14 +288,30 @@ def stereographic (hv : ∥v∥ = 1) : local_homeomorph (sphere (0:E) 1) (ℝ 
   open_source := is_open_compl_singleton,
   open_target := is_open_univ,
   continuous_to_fun := continuous_on_stereo_to_fun.comp continuous_subtype_coe.continuous_on
-    (λ w h, h ∘ subtype.ext ∘ eq.symm ∘ (inner_eq_norm_mul_iff_of_norm_one hv (by simp)).mp),
+    (λ w h, h ∘ subtype.ext ∘ eq.symm ∘ (inner_eq_one_iff_of_norm_one hv (by simp)).mp),
   continuous_inv_fun := (continuous_stereo_inv_fun hv).continuous_on }
 
-@[simp] lemma stereographic_source (hv : ∥v∥ = 1) :
+lemma stereographic_apply (hv : ‖v‖ = 1) (x : sphere (0 : E) 1) :
+  stereographic hv x = (2 / ((1:ℝ) - inner v x)) • orthogonal_projection (ℝ ∙ v)ᗮ x :=
+rfl
+
+@[simp] lemma stereographic_source (hv : ‖v‖ = 1) :
   (stereographic hv).source = {⟨v, by simp [hv]⟩}ᶜ :=
 rfl
 
-@[simp] lemma stereographic_target (hv : ∥v∥ = 1) : (stereographic hv).target = set.univ := rfl
+@[simp] lemma stereographic_target (hv : ‖v‖ = 1) : (stereographic hv).target = set.univ := rfl
+
+@[simp] lemma stereographic_apply_neg (v : sphere (0:E) 1) :
+  stereographic (norm_eq_of_mem_sphere v) (-v) = 0 :=
+by simp [stereographic_apply, orthogonal_projection_orthogonal_complement_singleton_eq_zero]
+
+@[simp] lemma stereographic_neg_apply (v : sphere (0:E) 1) :
+  stereographic (norm_eq_of_mem_sphere (-v)) v = 0 :=
+begin
+  convert stereographic_apply_neg (-v),
+  ext1,
+  simp,
+end
 
 end stereographic_projection
 
@@ -289,8 +342,8 @@ from `(ℝ ∙ v)ᗮ` to the Euclidean space. -/
 def stereographic' (n : ℕ) [fact (finrank ℝ E = n + 1)] (v : sphere (0:E) 1) :
   local_homeomorph (sphere (0:E) 1) (euclidean_space ℝ (fin n)) :=
 (stereographic (norm_eq_of_mem_sphere v)) ≫ₕ
-(linear_isometry_equiv.from_orthogonal_span_singleton n
-  (ne_zero_of_mem_unit_sphere v)).to_homeomorph.to_local_homeomorph
+(orthonormal_basis.from_orthogonal_span_singleton n
+  (ne_zero_of_mem_unit_sphere v)).repr.to_homeomorph.to_local_homeomorph
 
 @[simp] lemma stereographic'_source {n : ℕ} [fact (finrank ℝ E = n + 1)] (v : sphere (0:E) 1) :
   (stereographic' n v).source = {v}ᶜ :=
@@ -313,6 +366,20 @@ end charted_space
 
 section smooth_manifold
 
+lemma sphere_ext_iff (u v : sphere (0:E) 1) :
+  u = v ↔ ⟪(u:E), v⟫_ℝ = 1 :=
+by simp [subtype.ext_iff, inner_eq_one_iff_of_norm_one]
+
+lemma stereographic'_symm_apply {n : ℕ} [fact (finrank ℝ E = n + 1)]
+    (v : sphere (0:E) 1) (x : euclidean_space ℝ (fin n)) :
+  ((stereographic' n v).symm x : E) =
+    let U : (ℝ ∙ (v:E))ᗮ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin n) :=
+      (orthonormal_basis.from_orthogonal_span_singleton n
+        (ne_zero_of_mem_unit_sphere v)).repr in
+    ((‖(U.symm x : E)‖ ^ 2 + 4)⁻¹ • (4 : ℝ) • (U.symm x : E) +
+      (‖(U.symm x : E)‖ ^ 2 + 4)⁻¹ • (‖(U.symm x : E)‖ ^ 2 - 4) • v) :=
+by simp [real_inner_comm, stereographic, stereographic', ← submodule.coe_norm]
+
 /-! ### Smooth manifold structure on the sphere -/
 
 /-- The unit sphere in an `n + 1`-dimensional inner product space `E` is a smooth manifold,
@@ -322,12 +389,12 @@ instance {n : ℕ} [fact (finrank ℝ E = n + 1)] :
 smooth_manifold_with_corners_of_cont_diff_on (𝓡 n) (sphere (0:E) 1)
 begin
   rintros _ _ ⟨v, rfl⟩ ⟨v', rfl⟩,
-  let U : (ℝ ∙ (v:E))ᗮ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin n) :=
-    linear_isometry_equiv.from_orthogonal_span_singleton n
-      (ne_zero_of_mem_unit_sphere v),
-  let U' : (ℝ ∙ (v':E))ᗮ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin n) :=
-    linear_isometry_equiv.from_orthogonal_span_singleton n
-      (ne_zero_of_mem_unit_sphere v'),
+  let U := -- Removed type ascription, and this helped for some reason with timeout issues?
+    (orthonormal_basis.from_orthogonal_span_singleton n
+      (ne_zero_of_mem_unit_sphere v)).repr,
+  let U' :=-- Removed type ascription, and this helped for some reason with timeout issues?
+    (orthonormal_basis.from_orthogonal_span_singleton n
+      (ne_zero_of_mem_unit_sphere v')).repr,
   have hUv : stereographic' n v = (stereographic (norm_eq_of_mem_sphere v)) ≫ₕ
     U.to_homeomorph.to_local_homeomorph := rfl,
   have hU'v' : stereographic' n v' = (stereographic (norm_eq_of_mem_sphere v')).trans
@@ -336,10 +403,15 @@ begin
   have H₂ := (cont_diff_stereo_inv_fun_aux.comp
       (ℝ ∙ (v:E))ᗮ.subtypeL.cont_diff).comp U.symm.cont_diff,
   convert H₁.comp' (H₂.cont_diff_on : cont_diff_on ℝ ⊤ _ set.univ) using 1,
-  have h_set : ∀ p : sphere (0:E) 1, p = v' ↔ ⟪(p:E), v'⟫_ℝ = 1,
-  { simp [subtype.ext_iff, inner_eq_norm_mul_iff_of_norm_one] },
-  ext,
-  simp [h_set, hUv, hU'v', stereographic, real_inner_comm, ← submodule.coe_norm]
+  -- squeezed from `ext, simp [sphere_ext_iff, stereographic'_symm_apply, real_inner_comm]`
+  simp only [local_homeomorph.trans_to_local_equiv, local_homeomorph.symm_to_local_equiv,
+    local_equiv.trans_source, local_equiv.symm_source, stereographic'_target,
+    stereographic'_source],
+  simp only [model_with_corners_self_coe, model_with_corners_self_coe_symm, set.preimage_id,
+    set.range_id, set.inter_univ, set.univ_inter, set.compl_singleton_eq, set.preimage_set_of_eq],
+  simp only [id.def, comp_apply, submodule.subtypeL_apply, local_homeomorph.coe_coe_symm,
+    innerSL_apply, ne.def, sphere_ext_iff, real_inner_comm (v' : E)],
+  refl,
 end
 
 /-- The inclusion map (i.e., `coe`) from the sphere in `E` to `E` is smooth.  -/
@@ -350,37 +422,38 @@ begin
   split,
   { exact continuous_subtype_coe },
   { intros v _,
-    let U : (ℝ ∙ ((-v):E))ᗮ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin n) :=
-      linear_isometry_equiv.from_orthogonal_span_singleton n (ne_zero_of_mem_unit_sphere (-v)),
+    let U : _ ≃ₗᵢ[ℝ] _ := -- Again, partially removing type ascription...
+      (orthonormal_basis.from_orthogonal_span_singleton n
+        (ne_zero_of_mem_unit_sphere (-v))).repr,
     exact ((cont_diff_stereo_inv_fun_aux.comp
       (ℝ ∙ ((-v):E))ᗮ.subtypeL.cont_diff).comp U.symm.cont_diff).cont_diff_on }
 end
 
-variables {F : Type*} [normed_group F] [normed_space ℝ F]
+variables {F : Type*} [normed_add_comm_group F] [normed_space ℝ F]
 variables {H : Type*} [topological_space H] {I : model_with_corners ℝ F H}
 variables {M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
 
 /-- If a `cont_mdiff` function `f : M → E`, where `M` is some manifold, takes values in the
 sphere, then it restricts to a `cont_mdiff` function from `M` to the sphere. -/
 lemma cont_mdiff.cod_restrict_sphere {n : ℕ} [fact (finrank ℝ E = n + 1)]
-  {m : with_top ℕ} {f : M → E} (hf : cont_mdiff I 𝓘(ℝ, E) m f)
+  {m : ℕ∞} {f : M → E} (hf : cont_mdiff I 𝓘(ℝ, E) m f)
   (hf' : ∀ x, f x ∈ sphere (0:E) 1) :
   cont_mdiff I (𝓡 n) m (set.cod_restrict _ _ hf' : M → (sphere (0:E) 1)) :=
 begin
   rw cont_mdiff_iff_target,
-  refine ⟨continuous_induced_rng hf.continuous, _⟩,
+  refine ⟨continuous_induced_rng.2 hf.continuous, _⟩,
   intros v,
-  let U : (ℝ ∙ ((-v):E))ᗮ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin n) :=
-    (linear_isometry_equiv.from_orthogonal_span_singleton n (ne_zero_of_mem_unit_sphere (-v))),
-  have h : cont_diff_on ℝ ⊤ U set.univ :=
+  let U : _ ≃ₗᵢ[ℝ] _ := -- Again, partially removing type ascription... Weird that this helps!
+    (orthonormal_basis.from_orthogonal_span_singleton n (ne_zero_of_mem_unit_sphere (-v))).repr,
+  have h : cont_diff_on ℝ ⊤ _ set.univ :=
     U.cont_diff.cont_diff_on,
   have H₁ := (h.comp' cont_diff_on_stereo_to_fun).cont_mdiff_on,
   have H₂ : cont_mdiff_on _ _ _ _ set.univ := hf.cont_mdiff_on,
   convert (H₁.of_le le_top).comp' H₂ using 1,
   ext x,
   have hfxv : f x = -↑v ↔ ⟪f x, -↑v⟫_ℝ = 1,
-  { have hfx : ∥f x∥ = 1 := by simpa using hf' x,
-    rw inner_eq_norm_mul_iff_of_norm_one hfx,
+  { have hfx : ‖f x‖ = 1 := by simpa using hf' x,
+    rw inner_eq_one_iff_of_norm_one hfx,
     exact norm_eq_of_mem_sphere (-v) },
   dsimp [chart_at],
   simp [not_iff_not, subtype.ext_iff, hfxv, real_inner_comm]
@@ -396,6 +469,67 @@ begin
   exact cont_mdiff_coe_sphere,
 end
 
+/-- Consider the differential of the inclusion of the sphere in `E` at the point `v` as a continuous
+linear map from `tangent_space (𝓡 n) v` to `E`.  The range of this map is the orthogonal complement
+of `v` in `E`.
+
+Note that there is an abuse here of the defeq between `E` and the tangent space to `E` at `(v:E`).
+In general this defeq is not canonical, but in this case (the tangent space of a vector space) it is
+canonical. -/
+lemma range_mfderiv_coe_sphere {n : ℕ} [fact (finrank ℝ E = n + 1)] (v : sphere (0:E) 1) :
+  (mfderiv (𝓡 n) 𝓘(ℝ, E) (coe : sphere (0:E) 1 → E) v : tangent_space (𝓡 n) v →L[ℝ] E).range
+  = (ℝ ∙ (v:E))ᗮ :=
+begin
+  rw ((cont_mdiff_coe_sphere v).mdifferentiable_at le_top).mfderiv,
+  simp only [chart_at, stereographic', stereographic_neg_apply, fderiv_within_univ,
+    linear_isometry_equiv.to_homeomorph_symm, linear_isometry_equiv.coe_to_homeomorph,
+    linear_isometry_equiv.map_zero] with mfld_simps,
+  let U :=
+    (orthonormal_basis.from_orthogonal_span_singleton n (ne_zero_of_mem_unit_sphere (-v))).repr,
+  change (fderiv ℝ ((stereo_inv_fun_aux (-v : E) ∘ coe) ∘ U.symm) 0).range = (ℝ ∙ (v:E))ᗮ,
+  have : has_fderiv_at
+      (stereo_inv_fun_aux (-v : E) ∘ (coe : (ℝ ∙ (↑(-v):E))ᗮ → E))
+      (ℝ ∙ (↑(-v):E))ᗮ.subtypeL
+      (U.symm 0),
+  { convert has_fderiv_at_stereo_inv_fun_aux_comp_coe (-v:E),
+    simp },
+  rw (this.comp 0 U.symm.to_continuous_linear_equiv.has_fderiv_at).fderiv,
+  convert (U.symm : euclidean_space ℝ (fin n) ≃ₗᵢ[ℝ] (ℝ ∙ (↑(-v):E))ᗮ).range_comp
+      (ℝ ∙ (↑(-v):E))ᗮ.subtype using 1,
+  simp only [submodule.range_subtype, coe_neg_sphere],
+  congr' 1,
+  -- we must show `submodule.span ℝ {v} = submodule.span ℝ {-v}`
+  apply submodule.span_eq_span,
+  { simp only [set.singleton_subset_iff, set_like.mem_coe],
+    rw ← submodule.neg_mem_iff,
+    exact submodule.mem_span_singleton_self (-v) },
+  { simp only [set.singleton_subset_iff, set_like.mem_coe],
+    rw submodule.neg_mem_iff,
+    exact submodule.mem_span_singleton_self v },
+end
+
+/-- Consider the differential of the inclusion of the sphere in `E` at the point `v` as a continuous
+linear map from `tangent_space (𝓡 n) v` to `E`.  This map is injective. -/
+lemma mfderiv_coe_sphere_injective {n : ℕ} [fact (finrank ℝ E = n + 1)] (v : sphere (0:E) 1) :
+  injective (mfderiv (𝓡 n) 𝓘(ℝ, E) (coe : sphere (0:E) 1 → E) v) :=
+begin
+  rw ((cont_mdiff_coe_sphere v).mdifferentiable_at le_top).mfderiv,
+  simp only [chart_at, stereographic', stereographic_neg_apply, fderiv_within_univ,
+    linear_isometry_equiv.to_homeomorph_symm, linear_isometry_equiv.coe_to_homeomorph,
+    linear_isometry_equiv.map_zero] with mfld_simps,
+  let U :=
+    (orthonormal_basis.from_orthogonal_span_singleton n (ne_zero_of_mem_unit_sphere (-v))).repr,
+  change injective (fderiv ℝ ((stereo_inv_fun_aux (-v : E) ∘ coe) ∘ U.symm) 0),
+  have : has_fderiv_at
+      (stereo_inv_fun_aux (-v : E) ∘ (coe : (ℝ ∙ (↑(-v):E))ᗮ → E))
+      (ℝ ∙ (↑(-v):E))ᗮ.subtypeL
+      (U.symm 0),
+  { convert has_fderiv_at_stereo_inv_fun_aux_comp_coe (-v:E),
+    simp },
+  rw (this.comp 0 U.symm.to_continuous_linear_equiv.has_fderiv_at).fderiv,
+  simpa using subtype.coe_injective,
+end
+
 end smooth_manifold
 
 section circle
@@ -418,7 +552,7 @@ instance : lie_group (𝓡 1) circle :=
     let c : circle → ℂ := coe,
     have h₂ : cont_mdiff (𝓘(ℝ, ℂ).prod 𝓘(ℝ, ℂ)) 𝓘(ℝ, ℂ) ∞ (λ (z : ℂ × ℂ), z.fst * z.snd),
     { rw cont_mdiff_iff,
-      exact ⟨continuous_mul, λ x y, (cont_diff_mul.restrict_scalars ℝ).cont_diff_on⟩ },
+      exact ⟨continuous_mul, λ x y, cont_diff_mul.cont_diff_on⟩ },
     suffices h₁ : cont_mdiff _ _ _ (prod.map c c),
     { apply h₂.comp h₁ },
     -- this elaborates much faster with `apply`
@@ -426,12 +560,12 @@ instance : lie_group (𝓡 1) circle :=
   end,
   smooth_inv := begin
     apply cont_mdiff.cod_restrict_sphere,
+    simp only [← coe_inv_circle, coe_inv_circle_eq_conj],
     exact complex.conj_cle.cont_diff.cont_mdiff.comp cont_mdiff_coe_sphere
   end }
 
 /-- The map `λ t, exp (t * I)` from `ℝ` to the unit circle in `ℂ` is smooth. -/
 lemma cont_mdiff_exp_map_circle : cont_mdiff 𝓘(ℝ, ℝ) (𝓡 1) ∞ exp_map_circle :=
-(((cont_diff_exp.restrict_scalars ℝ).comp
-  (cont_diff_id.smul cont_diff_const)).cont_mdiff).cod_restrict_sphere _
+((cont_diff_exp.comp (cont_diff_id.smul cont_diff_const)).cont_mdiff).cod_restrict_sphere _
 
 end circle
diff --git a/src/geometry/manifold/instances/units_of_normed_algebra.lean b/src/geometry/manifold/instances/units_of_normed_algebra.lean
index f80a4a3fe5c6b..a7b7b50267a71 100644
--- a/src/geometry/manifold/instances/units_of_normed_algebra.lean
+++ b/src/geometry/manifold/instances/units_of_normed_algebra.lean
@@ -10,6 +10,9 @@ import analysis.normed_space.units
 /-!
 # Units of a normed algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file is a stub, containing a construction of the charted space structure on the group of units
 of a complete normed ring `R`, and of the smooth manifold structure on the group of units of a
 complete normed `𝕜`-algebra `R`.
@@ -57,7 +60,7 @@ instance : charted_space R Rˣ := open_embedding_coe.singleton_charted_space
 lemma chart_at_apply {a : Rˣ} {b : Rˣ} : chart_at R a b = b := rfl
 lemma chart_at_source {a : Rˣ} : (chart_at R a).source = set.univ := rfl
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_algebra 𝕜 R]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_algebra 𝕜 R]
 
 instance : smooth_manifold_with_corners 𝓘(𝕜, R) Rˣ :=
 open_embedding_coe.singleton_smooth_manifold_with_corners 𝓘(𝕜, R)
diff --git a/src/geometry/manifold/local_invariant_properties.lean b/src/geometry/manifold/local_invariant_properties.lean
index 5ac943c74f0a5..fedd470ff9b59 100644
--- a/src/geometry/manifold/local_invariant_properties.lean
+++ b/src/geometry/manifold/local_invariant_properties.lean
@@ -1,13 +1,16 @@
 /-
 Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
+Authors: Sébastien Gouëzel, Floris van Doorn
 -/
 import geometry.manifold.charted_space
 
 /-!
 # Local properties invariant under a groupoid
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We study properties of a triple `(g, s, x)` where `g` is a function between two spaces `H` and `H'`,
 `s` is a subset of `H` and `x` is a point of `H`. Our goal is to register how such a property
 should behave to make sense in charted spaces modelled on `H` and `H'`.
@@ -43,12 +46,14 @@ in the one for `lift_prop_within_at`.
 -/
 
 noncomputable theory
-open_locale classical manifold topological_space
+open_locale classical manifold topology
 
-open set
+open set filter topological_space
 
-variables {H : Type*} {M : Type*} [topological_space H] [topological_space M] [charted_space H M]
-{H' : Type*} {M' : Type*} [topological_space H'] [topological_space M'] [charted_space H' M']
+variables {H M H' M' X : Type*}
+variables [topological_space H] [topological_space M] [charted_space H M]
+variables [topological_space H'] [topological_space M'] [charted_space H' M']
+variables [topological_space X]
 
 namespace structure_groupoid
 
@@ -60,45 +65,131 @@ variables (G : structure_groupoid H) (G' : structure_groupoid H')
 to charted spaces admitting these groupoids will inherit the good behavior. -/
 structure local_invariant_prop (P : (H → H') → (set H) → H → Prop) : Prop :=
 (is_local : ∀ {s x u} {f : H → H'}, is_open u → x ∈ u → (P f s x ↔ P f (s ∩ u) x))
-(right_invariance : ∀ {s x f} {e : local_homeomorph H H}, e ∈ G → x ∈ e.source → P f s x →
-                      P (f ∘ e.symm) (e.target ∩ e.symm ⁻¹' s) (e x))
-(congr : ∀ {s x} {f g : H → H'}, (∀ y ∈ s, f y = g y) → (f x = g x) → P f s x → P g s x)
-(left_invariance : ∀ {s x f} {e' : local_homeomorph H' H'}, e' ∈ G' → s ⊆ f ⁻¹' (e'.source) →
+(right_invariance' : ∀ {s x f} {e : local_homeomorph H H}, e ∈ G → x ∈ e.source → P f s x →
+                      P (f ∘ e.symm) (e.symm ⁻¹' s) (e x))
+(congr_of_forall : ∀ {s x} {f g : H → H'}, (∀ y ∈ s, f y = g y) → f x = g x → P f s x → P g s x)
+(left_invariance' : ∀ {s x f} {e' : local_homeomorph H' H'}, e' ∈ G' → s ⊆ f ⁻¹' e'.source →
                      f x ∈ e'.source → P f s x → P (e' ∘ f) s x)
 
+variables {G G'} {P : (H → H') → (set H) → H → Prop} {s t u : set H} {x : H}
+
+variable (hG : G.local_invariant_prop G' P)
+include hG
+
+namespace local_invariant_prop
+
+lemma congr_set {s t : set H} {x : H} {f : H → H'} (hu : s =ᶠ[𝓝 x] t) :
+  P f s x ↔ P f t x :=
+begin
+  obtain ⟨o, host, ho, hxo⟩ := mem_nhds_iff.mp hu.mem_iff,
+  simp_rw [subset_def, mem_set_of, ← and.congr_left_iff, ← mem_inter_iff, ← set.ext_iff] at host,
+  rw [hG.is_local ho hxo, host, ← hG.is_local ho hxo]
+end
+
+lemma is_local_nhds {s u : set H} {x : H} {f : H → H'} (hu : u ∈ 𝓝[s] x) :
+  P f s x ↔ P f (s ∩ u) x :=
+hG.congr_set $ mem_nhds_within_iff_eventually_eq.mp hu
+
+lemma congr_iff_nhds_within {s : set H} {x : H} {f g : H → H'} (h1 : f =ᶠ[𝓝[s] x] g)
+  (h2 : f x = g x) : P f s x ↔ P g s x :=
+by { simp_rw [hG.is_local_nhds h1],
+  exact ⟨hG.congr_of_forall (λ y hy, hy.2) h2, hG.congr_of_forall (λ y hy, hy.2.symm) h2.symm⟩ }
+
+lemma congr_nhds_within {s : set H} {x : H} {f g : H → H'} (h1 : f =ᶠ[𝓝[s] x] g) (h2 : f x = g x)
+  (hP : P f s x) : P g s x :=
+(hG.congr_iff_nhds_within h1 h2).mp hP
+
+lemma congr_nhds_within' {s : set H} {x : H} {f g : H → H'} (h1 : f =ᶠ[𝓝[s] x] g) (h2 : f x = g x)
+  (hP : P g s x) : P f s x :=
+(hG.congr_iff_nhds_within h1 h2).mpr hP
+
+lemma congr_iff {s : set H} {x : H} {f g : H → H'} (h : f =ᶠ[𝓝 x] g) : P f s x ↔ P g s x :=
+hG.congr_iff_nhds_within (mem_nhds_within_of_mem_nhds h) (mem_of_mem_nhds h : _)
+
+lemma congr {s : set H} {x : H} {f g : H → H'} (h : f =ᶠ[𝓝 x] g) (hP : P f s x) : P g s x :=
+(hG.congr_iff h).mp hP
+
+lemma congr' {s : set H} {x : H} {f g : H → H'} (h : f =ᶠ[𝓝 x] g) (hP : P g s x) : P f s x :=
+hG.congr h.symm hP
+
+lemma left_invariance {s : set H} {x : H} {f : H → H'} {e' : local_homeomorph H' H'}
+  (he' : e' ∈ G') (hfs : continuous_within_at f s x) (hxe' : f x ∈ e'.source) :
+  P (e' ∘ f) s x ↔ P f s x :=
+begin
+  have h2f := hfs.preimage_mem_nhds_within (e'.open_source.mem_nhds hxe'),
+  have h3f := (((e'.continuous_at hxe').comp_continuous_within_at hfs).preimage_mem_nhds_within $
+    e'.symm.open_source.mem_nhds $ e'.maps_to hxe'),
+  split,
+  { intro h,
+    rw [hG.is_local_nhds h3f] at h,
+    have h2 := hG.left_invariance' (G'.symm he') (inter_subset_right _ _)
+      (by exact e'.maps_to hxe') h,
+    rw [← hG.is_local_nhds h3f] at h2,
+    refine hG.congr_nhds_within _ (e'.left_inv hxe') h2,
+    exact eventually_of_mem h2f (λ x', e'.left_inv) },
+  { simp_rw [hG.is_local_nhds h2f],
+    exact hG.left_invariance' he' (inter_subset_right _ _) hxe' }
+end
+
+lemma right_invariance {s : set H} {x : H} {f : H → H'} {e : local_homeomorph H H}
+  (he : e ∈ G) (hxe : x ∈ e.source) : P (f ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P f s x :=
+begin
+  refine ⟨λ h, _, hG.right_invariance' he hxe⟩,
+  have := hG.right_invariance' (G.symm he) (e.maps_to hxe) h,
+  rw [e.symm_symm, e.left_inv hxe] at this,
+  refine hG.congr _ ((hG.congr_set _).mp this),
+  { refine eventually_of_mem (e.open_source.mem_nhds hxe) (λ x' hx', _),
+    simp_rw [function.comp_apply, e.left_inv hx'] },
+  { rw [eventually_eq_set],
+    refine eventually_of_mem (e.open_source.mem_nhds hxe) (λ x' hx', _),
+    simp_rw [mem_preimage, e.left_inv hx'] },
+end
+
+end local_invariant_prop
 end structure_groupoid
 
+namespace charted_space
+
 /-- Given a property of germs of functions and sets in the model space, then one defines
 a corresponding property in a charted space, by requiring that it holds at the preferred chart at
 this point. (When the property is local and invariant, it will in fact hold using any chart, see
 `lift_prop_within_at_indep_chart`). We require continuity in the lifted property, as otherwise one
 single chart might fail to capture the behavior of the function.
 -/
-def charted_space.lift_prop_within_at (P : (H → H') → set H → H → Prop)
+def lift_prop_within_at (P : (H → H') → set H → H → Prop)
   (f : M → M') (s : set M) (x : M) : Prop :=
 continuous_within_at f s x ∧
-P ((chart_at H' (f x)) ∘ f ∘ (chart_at H x).symm)
-  ((chart_at H x).target ∩ (chart_at H x).symm ⁻¹' (s ∩ f ⁻¹' (chart_at H' (f x)).source))
-  (chart_at H x x)
+P (chart_at H' (f x) ∘ f ∘ (chart_at H x).symm) ((chart_at H x).symm ⁻¹' s) (chart_at H x x)
 
 /-- Given a property of germs of functions and sets in the model space, then one defines
 a corresponding property of functions on sets in a charted space, by requiring that it holds
 around each point of the set, in the preferred charts. -/
-def charted_space.lift_prop_on (P : (H → H') → set H → H → Prop) (f : M → M') (s : set M) :=
-∀ x ∈ s, charted_space.lift_prop_within_at P f s x
+def lift_prop_on (P : (H → H') → set H → H → Prop) (f : M → M') (s : set M) :=
+∀ x ∈ s, lift_prop_within_at P f s x
 
 /-- Given a property of germs of functions and sets in the model space, then one defines
 a corresponding property of a function at a point in a charted space, by requiring that it holds
 in the preferred chart. -/
-def charted_space.lift_prop_at (P : (H → H') → set H → H → Prop) (f : M → M') (x : M) :=
-charted_space.lift_prop_within_at P f univ x
+def lift_prop_at (P : (H → H') → set H → H → Prop) (f : M → M') (x : M) :=
+lift_prop_within_at P f univ x
+
+lemma lift_prop_at_iff {P : (H → H') → set H → H → Prop} {f : M → M'} {x : M} :
+  lift_prop_at P f x ↔ continuous_at f x ∧
+  P (chart_at H' (f x) ∘ f ∘ (chart_at H x).symm) univ (chart_at H x x) :=
+by rw [lift_prop_at, lift_prop_within_at, continuous_within_at_univ, preimage_univ]
 
 /-- Given a property of germs of functions and sets in the model space, then one defines
 a corresponding property of a function in a charted space, by requiring that it holds
 in the preferred chart around every point. -/
-def charted_space.lift_prop (P : (H → H') → set H → H → Prop) (f : M → M') :=
-∀ x, charted_space.lift_prop_at P f x
+def lift_prop (P : (H → H') → set H → H → Prop) (f : M → M') :=
+∀ x, lift_prop_at P f x
+
+lemma lift_prop_iff {P : (H → H') → set H → H → Prop} {f : M → M'} :
+  lift_prop P f ↔ continuous f ∧
+  ∀ x, P (chart_at H' (f x) ∘ f ∘ (chart_at H x).symm) univ (chart_at H x x) :=
+by simp_rw [lift_prop, lift_prop_at_iff, forall_and_distrib, continuous_iff_continuous_at]
 
+end charted_space
 open charted_space
 
 namespace structure_groupoid
@@ -108,19 +199,90 @@ variables {G : structure_groupoid H} {G' : structure_groupoid H'}
 {P : (H → H') → set H → H → Prop} {g g' : M → M'} {s t : set M} {x : M}
 {Q : (H → H) → set H → H → Prop}
 
-lemma lift_prop_within_at_univ :
-  lift_prop_within_at P g univ x ↔ lift_prop_at P g x :=
+lemma lift_prop_within_at_univ : lift_prop_within_at P g univ x ↔ lift_prop_at P g x :=
 iff.rfl
 
-lemma lift_prop_on_univ :
-  lift_prop_on P g univ ↔ lift_prop P g :=
+lemma lift_prop_on_univ : lift_prop_on P g univ ↔ lift_prop P g :=
 by simp [lift_prop_on, lift_prop, lift_prop_at]
 
+lemma lift_prop_within_at_self {f : H → H'} {s : set H} {x : H} :
+  lift_prop_within_at P f s x ↔ continuous_within_at f s x ∧ P f s x :=
+iff.rfl
+
+lemma lift_prop_within_at_self_source {f : H → M'} {s : set H} {x : H} :
+  lift_prop_within_at P f s x ↔ continuous_within_at f s x ∧ P (chart_at H' (f x) ∘ f) s x :=
+iff.rfl
+
+lemma lift_prop_within_at_self_target {f : M → H'} :
+  lift_prop_within_at P f s x ↔
+    continuous_within_at f s x ∧
+    P (f ∘ (chart_at H x).symm) ((chart_at H x).symm ⁻¹' s) (chart_at H x x) :=
+iff.rfl
+
 namespace local_invariant_prop
 
 variable (hG : G.local_invariant_prop G' P)
 include hG
 
+/-- `lift_prop_within_at P f s x` is equivalent to a definition where we restrict the set we are
+  considering to the domain of the charts at `x` and `f x`. -/
+lemma lift_prop_within_at_iff {f : M → M'} :
+  lift_prop_within_at P f s x ↔
+  continuous_within_at f s x ∧ P ((chart_at H' (f x)) ∘ f ∘ (chart_at H x).symm)
+  ((chart_at H x).target ∩ (chart_at H x).symm ⁻¹' (s ∩ f ⁻¹' (chart_at H' (f x)).source))
+  (chart_at H x x) :=
+begin
+  refine and_congr_right (λ hf, hG.congr_set _),
+  exact local_homeomorph.preimage_eventually_eq_target_inter_preimage_inter hf
+    (mem_chart_source H x) (chart_source_mem_nhds H' (f x))
+end
+
+lemma lift_prop_within_at_indep_chart_source_aux (g : M → H')
+  (he : e ∈ G.maximal_atlas M) (xe : x ∈ e.source)
+  (he' : e' ∈ G.maximal_atlas M) (xe' : x ∈ e'.source) :
+  P (g ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P (g ∘ e'.symm) (e'.symm ⁻¹' s) (e' x) :=
+begin
+  rw [← hG.right_invariance (compatible_of_mem_maximal_atlas he he')],
+  swap, { simp only [xe, xe'] with mfld_simps },
+  simp_rw [local_homeomorph.trans_apply, e.left_inv xe],
+  rw [hG.congr_iff],
+  { refine hG.congr_set _,
+    refine (eventually_of_mem _ $ λ y (hy : y ∈ e'.symm ⁻¹' e.source), _).set_eq,
+    { refine (e'.symm.continuous_at $ e'.maps_to xe').preimage_mem_nhds (e.open_source.mem_nhds _),
+      simp_rw [e'.left_inv xe', xe] },
+    simp_rw [mem_preimage, local_homeomorph.coe_trans_symm, local_homeomorph.symm_symm,
+      function.comp_apply, e.left_inv hy] },
+  { refine ((e'.eventually_nhds' _ xe').mpr $ e.eventually_left_inverse xe).mono (λ y hy, _),
+    simp only with mfld_simps,
+    rw [hy] },
+end
+
+lemma lift_prop_within_at_indep_chart_target_aux2 (g : H → M') {x : H} {s : set H}
+  (hf : f ∈ G'.maximal_atlas M') (xf : g x ∈ f.source)
+  (hf' : f' ∈ G'.maximal_atlas M') (xf' : g x ∈ f'.source)
+  (hgs : continuous_within_at g s x) :
+  P (f ∘ g) s x ↔ P (f' ∘ g) s x :=
+begin
+  have hcont : continuous_within_at (f ∘ g) s x :=
+    (f.continuous_at xf).comp_continuous_within_at hgs,
+  rw [← hG.left_invariance (compatible_of_mem_maximal_atlas hf hf') hcont
+      (by simp only [xf, xf'] with mfld_simps)],
+  refine hG.congr_iff_nhds_within _ (by simp only [xf] with mfld_simps),
+  exact (hgs.eventually $ f.eventually_left_inverse xf).mono (λ y, congr_arg f')
+end
+
+lemma lift_prop_within_at_indep_chart_target_aux {g : X → M'} {e : local_homeomorph X H} {x : X}
+  {s : set X} (xe : x ∈ e.source)
+  (hf : f ∈ G'.maximal_atlas M') (xf : g x ∈ f.source)
+  (hf' : f' ∈ G'.maximal_atlas M') (xf' : g x ∈ f'.source)
+  (hgs : continuous_within_at g s x) :
+  P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P (f' ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
+begin
+  rw [← e.left_inv xe] at xf xf' hgs,
+  refine hG.lift_prop_within_at_indep_chart_target_aux2 (g ∘ e.symm) hf xf hf' xf' _,
+  exact hgs.comp (e.symm.continuous_at $ e.maps_to xe).continuous_within_at subset.rfl
+end
+
 /-- If a property of a germ of function `g` on a pointed set `(s, x)` is invariant under the
 structure groupoid (by composition in the source space and in the target space), then
 expressing it in charted spaces does not depend on the element of the maximal atlas one uses
@@ -132,133 +294,79 @@ lemma lift_prop_within_at_indep_chart_aux
   (he' : e' ∈ G.maximal_atlas M) (xe' : x ∈ e'.source)
   (hf : f ∈ G'.maximal_atlas M') (xf : g x ∈ f.source)
   (hf' : f' ∈ G'.maximal_atlas M') (xf' : g x ∈ f'.source)
-  (hgs : continuous_within_at g s x)
-  (h : P (f ∘ g ∘ e.symm) (e.target ∩ e.symm ⁻¹' (s ∩ g⁻¹' f.source)) (e x)) :
-  P (f' ∘ g ∘ e'.symm) (e'.target ∩ e'.symm ⁻¹' (s ∩ g⁻¹' f'.source)) (e' x) :=
+  (hgs : continuous_within_at g s x) :
+  P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) ↔ P (f' ∘ g ∘ e'.symm) (e'.symm ⁻¹' s) (e' x) :=
+by rw [hG.lift_prop_within_at_indep_chart_source_aux (f ∘ g) he xe he' xe',
+    hG.lift_prop_within_at_indep_chart_target_aux xe' hf xf hf' xf' hgs]
+
+lemma lift_prop_within_at_indep_chart [has_groupoid M G] [has_groupoid M' G']
+  (he : e ∈ G.maximal_atlas M) (xe : x ∈ e.source)
+  (hf : f ∈ G'.maximal_atlas M') (xf : g x ∈ f.source) :
+  lift_prop_within_at P g s x ↔
+    continuous_within_at g s x ∧ P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
+and_congr_right $ hG.lift_prop_within_at_indep_chart_aux (chart_mem_maximal_atlas _ _)
+  (mem_chart_source _ _) he xe (chart_mem_maximal_atlas _ _) (mem_chart_source _ _) hf xf
+
+/-- A version of `lift_prop_within_at_indep_chart`, only for the source. -/
+lemma lift_prop_within_at_indep_chart_source [has_groupoid M G]
+  (he : e ∈ G.maximal_atlas M) (xe : x ∈ e.source) :
+  lift_prop_within_at P g s x ↔ lift_prop_within_at P (g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
 begin
-  obtain ⟨o, o_open, xo, oe, oe', of, of'⟩ :
-    ∃ (o : set M), is_open o ∧ x ∈ o ∧ o ⊆ e.source ∧ o ⊆ e'.source ∧
-      o ∩ s ⊆ g ⁻¹' f.source ∧ o ∩ s ⊆  g⁻¹' f'.to_local_equiv.source,
-  { have : f.source ∩ f'.source ∈ 𝓝 (g x) :=
-      is_open.mem_nhds (is_open.inter f.open_source f'.open_source) ⟨xf, xf'⟩,
-    rcases mem_nhds_within.1 (hgs.preimage_mem_nhds_within this) with ⟨u, u_open, xu, hu⟩,
-    refine ⟨u ∩ e.source ∩ e'.source, _, ⟨⟨xu, xe⟩, xe'⟩, _, _, _, _⟩,
-    { exact is_open.inter (is_open.inter u_open e.open_source) e'.open_source },
-    { assume x hx, exact hx.1.2 },
-    { assume x hx, exact hx.2 },
-    { assume x hx, exact (hu ⟨hx.1.1.1, hx.2⟩).1 },
-    { assume x hx, exact (hu ⟨hx.1.1.1, hx.2⟩).2 } },
-  have A : P (f ∘ g ∘ e.symm)
-             (e.target ∩ e.symm ⁻¹' (s ∩ g⁻¹' f.source) ∩ (e.target ∩ e.symm ⁻¹' o)) (e x),
-  { apply (hG.is_local _ _).1 h,
-    { exact e.continuous_on_symm.preimage_open_of_open e.open_target o_open },
-    { simp only [xe, xo] with mfld_simps} },
-  have B : P ((f.symm ≫ₕ f') ∘ (f ∘ g ∘ e.symm))
-             (e.target ∩ e.symm ⁻¹' (s ∩ g⁻¹' f.source) ∩ (e.target ∩ e.symm ⁻¹' o)) (e x),
-  { refine hG.left_invariance (compatible_of_mem_maximal_atlas hf hf') (λ y hy, _)
-      (by simp only [xe, xf, xf'] with mfld_simps) A,
-    simp only with mfld_simps at hy,
-    have : e.symm y ∈ o ∩ s, by simp only [hy] with mfld_simps,
-    simpa only [hy] with mfld_simps using of' this },
-  have C : P (f' ∘ g ∘ e.symm)
-             (e.target ∩ e.symm ⁻¹' (s ∩ g⁻¹' f.source) ∩ (e.target ∩ e.symm ⁻¹' o)) (e x),
-  { refine hG.congr (λ y hy, _) (by simp only [xe, xf] with mfld_simps) B,
-    simp only [local_homeomorph.coe_trans, function.comp_app],
-    rw f.left_inv,
-    apply of,
-    simp only with mfld_simps at hy,
-    simp only [hy] with mfld_simps },
-  let w := e.symm ≫ₕ e',
-  let ow := w.target ∩ w.symm ⁻¹'
-    (e.target ∩ e.symm ⁻¹' (s ∩ g⁻¹' f.source) ∩ (e.target ∩ e.symm ⁻¹' o)),
-  have wG : w ∈ G := compatible_of_mem_maximal_atlas he he',
-  have D : P ((f' ∘ g ∘ e.symm) ∘ w.symm) ow (w (e x)) :=
-    hG.right_invariance wG (by simp only [w, xe, xe'] with mfld_simps) C,
-  have E : P (f' ∘ g ∘ e'.symm) ow (w (e x)),
-  { refine hG.congr _ (by simp only [xe, xe'] with mfld_simps) D,
-    assume y hy,
-    simp only with mfld_simps,
-    rw e.left_inv,
-    simp only with mfld_simps at hy,
-    simp only [hy] with mfld_simps },
-  have : w (e x) = e' x, by simp only [w, xe] with mfld_simps,
-  rw this at E,
-  have : ow = (e'.target ∩ e'.symm ⁻¹' (s ∩ g⁻¹' f'.source))
-               ∩ (w.target ∩ (e'.target ∩ e'.symm ⁻¹' o)),
-  { ext y,
-    split,
-    { assume hy,
-      have : e.symm (e ((e'.symm) y)) = e'.symm y,
-        by { simp only with mfld_simps at hy, simp only [hy] with mfld_simps },
-      simp only [this] with mfld_simps at hy,
-      have : g (e'.symm y) ∈ f'.source, by { apply of', simp only [hy] with mfld_simps },
-      simp only [hy, this] with mfld_simps },
-    { assume hy,
-      simp only with mfld_simps at hy,
-      have : g (e'.symm y) ∈ f.source, by { apply of, simp only [hy] with mfld_simps },
-      simp only [this, hy] with mfld_simps } },
-  rw this at E,
-  apply (hG.is_local _ _).2 E,
-  { exact is_open.inter w.open_target
-      (e'.continuous_on_symm.preimage_open_of_open e'.open_target o_open) },
-  { simp only [xe', xe, xo] with mfld_simps },
+  have := e.symm.continuous_within_at_iff_continuous_within_at_comp_right xe,
+  rw [e.symm_symm] at this,
+  rw [lift_prop_within_at_self_source, lift_prop_within_at, ← this],
+  simp_rw [function.comp_app, e.left_inv xe],
+  refine and_congr iff.rfl _,
+  rw hG.lift_prop_within_at_indep_chart_source_aux (chart_at H' (g x) ∘ g)
+    (chart_mem_maximal_atlas G x) (mem_chart_source H x) he xe,
 end
 
-lemma lift_prop_within_at_indep_chart [has_groupoid M G] [has_groupoid M' G']
+/-- A version of `lift_prop_within_at_indep_chart`, only for the target. -/
+lemma lift_prop_within_at_indep_chart_target [has_groupoid M' G']
+  (hf : f ∈ G'.maximal_atlas M') (xf : g x ∈ f.source) :
+  lift_prop_within_at P g s x ↔ continuous_within_at g s x ∧ lift_prop_within_at P (f ∘ g) s x :=
+begin
+  rw [lift_prop_within_at_self_target, lift_prop_within_at, and.congr_right_iff],
+  intro hg,
+  simp_rw [(f.continuous_at xf).comp_continuous_within_at hg, true_and],
+  exact hG.lift_prop_within_at_indep_chart_target_aux (mem_chart_source _ _)
+    (chart_mem_maximal_atlas _ _) (mem_chart_source _ _) hf xf hg
+end
+
+/-- A version of `lift_prop_within_at_indep_chart`, that uses `lift_prop_within_at` on both sides.
+-/
+lemma lift_prop_within_at_indep_chart' [has_groupoid M G] [has_groupoid M' G']
   (he : e ∈ G.maximal_atlas M) (xe : x ∈ e.source)
   (hf : f ∈ G'.maximal_atlas M') (xf : g x ∈ f.source) :
   lift_prop_within_at P g s x ↔
-    continuous_within_at g s x ∧ P (f ∘ g ∘ e.symm)
-      (e.target ∩ e.symm ⁻¹' (s ∩ g⁻¹' f.source)) (e x) :=
-⟨λ H, ⟨H.1,
-  hG.lift_prop_within_at_indep_chart_aux (chart_mem_maximal_atlas _ _) (mem_chart_source _ _) he xe
-  (chart_mem_maximal_atlas _ _) (mem_chart_source _ _) hf xf H.1 H.2⟩,
-λ H, ⟨H.1,
-  hG.lift_prop_within_at_indep_chart_aux he xe (chart_mem_maximal_atlas _ _) (mem_chart_source _ _)
-    hf xf (chart_mem_maximal_atlas _ _) (mem_chart_source _ _) H.1 H.2⟩⟩
+    continuous_within_at g s x ∧ lift_prop_within_at P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) (e x) :=
+begin
+  rw [hG.lift_prop_within_at_indep_chart he xe hf xf, lift_prop_within_at_self, and.left_comm,
+    iff.comm, and_iff_right_iff_imp],
+  intro h,
+  have h1 := (e.symm.continuous_within_at_iff_continuous_within_at_comp_right xe).mp h.1,
+  have : continuous_at f ((g ∘ e.symm) (e x)),
+  { simp_rw [function.comp, e.left_inv xe, f.continuous_at xf] },
+  exact this.comp_continuous_within_at h1,
+end
 
 lemma lift_prop_on_indep_chart [has_groupoid M G] [has_groupoid M' G']
-  (he : e ∈ G.maximal_atlas M) (hf : f ∈ G'.maximal_atlas M') (h : lift_prop_on P g s) :
-  ∀ y ∈ e.target ∩ e.symm ⁻¹' (s ∩ g ⁻¹' f.source),
-  P (f ∘ g ∘ e.symm) (e.target ∩ e.symm ⁻¹' (s ∩ g ⁻¹' f.source)) y :=
+  (he : e ∈ G.maximal_atlas M) (hf : f ∈ G'.maximal_atlas M') (h : lift_prop_on P g s)
+  {y : H} (hy : y ∈ e.target ∩ e.symm ⁻¹'  (s ∩ g ⁻¹' f.source)) :
+  P (f ∘ g ∘ e.symm) (e.symm ⁻¹' s) y :=
 begin
-  assume y hy,
-  simp only with mfld_simps at hy,
-  have : e.symm y ∈ s, by simp only [hy] with mfld_simps,
-  convert ((hG.lift_prop_within_at_indep_chart he _ hf _).1 (h _ this)).2,
-  repeat { simp only [hy] with mfld_simps },
+  convert ((hG.lift_prop_within_at_indep_chart he (e.symm_maps_to hy.1) hf hy.2.2).1
+    (h _ hy.2.1)).2,
+  rw [e.right_inv hy.1],
 end
 
 lemma lift_prop_within_at_inter' (ht : t ∈ 𝓝[s] x) :
   lift_prop_within_at P g (s ∩ t) x ↔ lift_prop_within_at P g s x :=
 begin
-  by_cases hcont : ¬ (continuous_within_at g s x),
-  { have : ¬ (continuous_within_at g (s ∩ t) x), by rwa [continuous_within_at_inter' ht],
-    simp only [lift_prop_within_at, hcont, this, false_and] },
-  push_neg at hcont,
-  have A : continuous_within_at g (s ∩ t) x, by rwa [continuous_within_at_inter' ht],
-  obtain ⟨o, o_open, xo, oc, oc', ost⟩ :
-    ∃ (o : set M), is_open o ∧ x ∈ o ∧ o ⊆ (chart_at H x).source ∧
-      o ∩ s ⊆ g ⁻¹' (chart_at H' (g x)).source ∧ o ∩ s ⊆ t,
-  { rcases mem_nhds_within.1 ht with ⟨u, u_open, xu, ust⟩,
-    have : (chart_at H' (g x)).source ∈ 𝓝 (g x) :=
-      is_open.mem_nhds ((chart_at H' (g x))).open_source (mem_chart_source H' (g x)),
-    rcases mem_nhds_within.1 (hcont.preimage_mem_nhds_within this) with ⟨v, v_open, xv, hv⟩,
-    refine ⟨u ∩ v ∩ (chart_at H x).source, _, ⟨⟨xu, xv⟩, mem_chart_source _ _⟩, _, _, _⟩,
-    { exact is_open.inter (is_open.inter u_open v_open) (chart_at H x).open_source },
-    { assume y hy, exact hy.2 },
-    { assume y hy, exact hv ⟨hy.1.1.2, hy.2⟩ },
-    { assume y hy, exact ust ⟨hy.1.1.1, hy.2⟩ } },
-  simp only [lift_prop_within_at, A, hcont, true_and, preimage_inter],
-  have B : is_open ((chart_at H x).target ∩ (chart_at H x).symm⁻¹' o) :=
-    (chart_at H x).preimage_open_of_open_symm o_open,
-  have C : (chart_at H x) x ∈ (chart_at H x).target ∩ (chart_at H x).symm⁻¹' o,
-    by simp only [xo] with mfld_simps,
-  conv_lhs { rw hG.is_local B C },
-  conv_rhs { rw hG.is_local B C },
-  congr' 2,
-  have : ∀ y, y ∈ o ∩ s → y ∈ t := ost,
-  mfld_set_tac
+  rw [lift_prop_within_at, lift_prop_within_at, continuous_within_at_inter' ht, hG.congr_set],
+  simp_rw [eventually_eq_set, mem_preimage,
+    (chart_at H x).eventually_nhds' (λ x, x ∈ s ∩ t ↔ x ∈ s) (mem_chart_source H x)],
+  exact (mem_nhds_within_iff_eventually_eq.mp ht).symm.mem_iff
 end
 
 lemma lift_prop_within_at_inter (ht : t ∈ 𝓝 x) :
@@ -267,20 +375,14 @@ hG.lift_prop_within_at_inter' (mem_nhds_within_of_mem_nhds ht)
 
 lemma lift_prop_at_of_lift_prop_within_at (h : lift_prop_within_at P g s x) (hs : s ∈ 𝓝 x) :
   lift_prop_at P g x :=
-begin
-  have : s = univ ∩ s, by rw univ_inter,
-  rwa [this, hG.lift_prop_within_at_inter hs] at h,
-end
+by rwa [← univ_inter s, hG.lift_prop_within_at_inter hs] at h
 
 lemma lift_prop_within_at_of_lift_prop_at_of_mem_nhds (h : lift_prop_at P g x) (hs : s ∈ 𝓝 x) :
   lift_prop_within_at P g s x :=
-begin
-  have : s = univ ∩ s, by rw univ_inter,
-  rwa [this, hG.lift_prop_within_at_inter hs],
-end
+by rwa [← univ_inter s, hG.lift_prop_within_at_inter hs]
 
 lemma lift_prop_on_of_locally_lift_prop_on
-  (h : ∀x∈s, ∃u, is_open u ∧ x ∈ u ∧ lift_prop_on P g (s ∩ u)) :
+  (h : ∀ x ∈ s, ∃ u, is_open u ∧ x ∈ u ∧ lift_prop_on P g (s ∩ u)) :
   lift_prop_on P g s :=
 begin
   assume x hx,
@@ -290,8 +392,7 @@ begin
   exact is_open.mem_nhds u_open xu,
 end
 
-lemma lift_prop_of_locally_lift_prop_on
-  (h : ∀x, ∃u, is_open u ∧ x ∈ u ∧ lift_prop_on P g u) :
+lemma lift_prop_of_locally_lift_prop_on (h : ∀ x, ∃ u, is_open u ∧ x ∈ u ∧ lift_prop_on P g u) :
   lift_prop P g :=
 begin
   rw ← lift_prop_on_univ,
@@ -299,62 +400,41 @@ begin
   simp [h x],
 end
 
-lemma lift_prop_within_at_congr
-  (h : lift_prop_within_at P g s x) (h₁ : ∀ y ∈ s, g' y = g y) (hx : g' x = g x) :
-  lift_prop_within_at P g' s x :=
-begin
-  refine ⟨h.1.congr h₁ hx, _⟩,
-  have A : s ∩ g' ⁻¹' (chart_at H' (g' x)).source = s ∩ g ⁻¹' (chart_at H' (g' x)).source,
-  { ext y,
-    split,
-    { assume hy,
-      simp only with mfld_simps at hy,
-      simp only [hy, ← h₁ _ hy.1] with mfld_simps },
-    { assume hy,
-      simp only with mfld_simps at hy,
-      simp only [hy, h₁ _ hy.1] with mfld_simps } },
-  have := h.2,
-  rw [← hx, ← A] at this,
-  convert hG.congr _ _ this using 2,
-  { assume y hy,
-    simp only with mfld_simps at hy,
-    have : (chart_at H x).symm y ∈ s, by simp only [hy],
-    simp only [hy, h₁ _ this] with mfld_simps },
-  { simp only [hx] with mfld_simps }
-end
-
-lemma lift_prop_within_at_congr_iff (h₁ : ∀ y ∈ s, g' y = g y) (hx : g' x = g x) :
-  lift_prop_within_at P g' s x ↔ lift_prop_within_at P g s x :=
-⟨λ h, hG.lift_prop_within_at_congr h (λ y hy, (h₁ y hy).symm) hx.symm,
- λ h, hG.lift_prop_within_at_congr h h₁ hx⟩
-
 lemma lift_prop_within_at_congr_of_eventually_eq
   (h : lift_prop_within_at P g s x) (h₁ : g' =ᶠ[𝓝[s] x] g) (hx : g' x = g x) :
   lift_prop_within_at P g' s x :=
 begin
-  rcases h₁.exists_mem with ⟨t, t_nhd, ht⟩,
-  rw ← hG.lift_prop_within_at_inter' t_nhd at h ⊢,
-  exact hG.lift_prop_within_at_congr h (λ y hy, ht hy.2) hx
+  refine ⟨h.1.congr_of_eventually_eq h₁ hx, _⟩,
+  refine hG.congr_nhds_within' _ (by simp_rw [function.comp_apply,
+    (chart_at H x).left_inv (mem_chart_source H x), hx]) h.2,
+  simp_rw [eventually_eq, function.comp_app, (chart_at H x).eventually_nhds_within'
+    (λ y, chart_at H' (g' x) (g' y) = chart_at H' (g x) (g y))
+    (mem_chart_source H x)],
+  exact h₁.mono (λ y hy, by rw [hx, hy])
 end
 
-lemma lift_prop_within_at_congr_iff_of_eventually_eq
-  (h₁ : g' =ᶠ[𝓝[s] x] g) (hx : g' x = g x) :
+lemma lift_prop_within_at_congr_iff_of_eventually_eq (h₁ :  g' =ᶠ[𝓝[s] x] g) (hx : g' x = g x) :
   lift_prop_within_at P g' s x ↔ lift_prop_within_at P g s x :=
 ⟨λ h, hG.lift_prop_within_at_congr_of_eventually_eq h h₁.symm hx.symm,
  λ h, hG.lift_prop_within_at_congr_of_eventually_eq h h₁ hx⟩
 
-lemma lift_prop_at_congr_of_eventually_eq (h : lift_prop_at P g x) (h₁ : g' =ᶠ[𝓝 x] g) :
-  lift_prop_at P g' x :=
-begin
-  apply hG.lift_prop_within_at_congr_of_eventually_eq h _ h₁.eq_of_nhds,
-  convert h₁,
-  rw nhds_within_univ
-end
+lemma lift_prop_within_at_congr_iff
+  (h₁ : ∀ y ∈ s, g' y = g y) (hx : g' x = g x) :
+  lift_prop_within_at P g' s x ↔ lift_prop_within_at P g s x :=
+hG.lift_prop_within_at_congr_iff_of_eventually_eq (eventually_nhds_within_of_forall h₁) hx
+
+lemma lift_prop_within_at_congr
+  (h : lift_prop_within_at P g s x) (h₁ : ∀ y ∈ s, g' y = g y) (hx : g' x = g x) :
+  lift_prop_within_at P g' s x :=
+(hG.lift_prop_within_at_congr_iff h₁ hx).mpr h
 
 lemma lift_prop_at_congr_iff_of_eventually_eq
   (h₁ : g' =ᶠ[𝓝 x] g) : lift_prop_at P g' x ↔ lift_prop_at P g x :=
-⟨λ h, hG.lift_prop_at_congr_of_eventually_eq h h₁.symm,
- λ h, hG.lift_prop_at_congr_of_eventually_eq h h₁⟩
+hG.lift_prop_within_at_congr_iff_of_eventually_eq (by simp_rw [nhds_within_univ, h₁]) h₁.eq_of_nhds
+
+lemma lift_prop_at_congr_of_eventually_eq (h : lift_prop_at P g x) (h₁ : g' =ᶠ[𝓝 x] g) :
+  lift_prop_at P g' x :=
+(hG.lift_prop_at_congr_iff_of_eventually_eq h₁).mpr h
 
 lemma lift_prop_on_congr (h : lift_prop_on P g s) (h₁ : ∀ y ∈ s, g' y = g y) :
   lift_prop_on P g' s :=
@@ -366,15 +446,25 @@ lemma lift_prop_on_congr_iff (h₁ : ∀ y ∈ s, g' y = g y) :
 
 omit hG
 
+lemma lift_prop_within_at_mono_of_mem
+  (mono_of_mem : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, s ∈ 𝓝[t] x → P f s x → P f t x)
+  (h : lift_prop_within_at P g s x) (hst : s ∈ 𝓝[t] x) :
+  lift_prop_within_at P g t x :=
+begin
+  refine ⟨h.1.mono_of_mem hst, mono_of_mem _ h.2⟩,
+  simp_rw [← mem_map, (chart_at H x).symm.map_nhds_within_preimage_eq (mem_chart_target H x),
+    (chart_at H x).left_inv (mem_chart_source H x), hst]
+end
+
 lemma lift_prop_within_at_mono
   (mono : ∀ ⦃s x t⦄ ⦃f : H → H'⦄, t ⊆ s → P f s x → P f t x)
-  (h : lift_prop_within_at P g t x) (hst : s ⊆ t) :
-  lift_prop_within_at P g s x :=
+  (h : lift_prop_within_at P g s x) (hts : t ⊆ s) :
+  lift_prop_within_at P g t x :=
 begin
-  refine ⟨h.1.mono hst, _⟩,
+  refine ⟨h.1.mono hts, _⟩,
   apply mono (λ y hy, _) h.2,
   simp only with mfld_simps at hy,
-  simp only [hy, hst _] with mfld_simps,
+  simp only [hy, hts _] with mfld_simps,
 end
 
 lemma lift_prop_within_at_of_lift_prop_at
@@ -402,15 +492,10 @@ lemma lift_prop_at_of_mem_maximal_atlas [has_groupoid M G]
   (hG : G.local_invariant_prop G Q) (hQ : ∀ y, Q id univ y)
   (he : e ∈ maximal_atlas M G) (hx : x ∈ e.source) : lift_prop_at Q e x :=
 begin
-  suffices h : Q (e ∘ e.symm) e.target (e x),
-  { rw [lift_prop_at, hG.lift_prop_within_at_indep_chart he hx G.id_mem_maximal_atlas (mem_univ _)],
-    refine ⟨(e.continuous_at hx).continuous_within_at, _⟩,
-    simpa only with mfld_simps },
-  have A : Q id e.target (e x),
-  { have : e x ∈ e.target, by simp only [hx] with mfld_simps,
-    simpa only with mfld_simps using (hG.is_local e.open_target this).1 (hQ (e x)) },
-  apply hG.congr _ _ A;
-  simp only [hx] with mfld_simps {contextual := tt}
+  simp_rw [lift_prop_at,
+    hG.lift_prop_within_at_indep_chart he hx G.id_mem_maximal_atlas (mem_univ _),
+    (e.continuous_at hx).continuous_within_at, true_and],
+  exact hG.congr' (e.eventually_right_inverse' hx) (hQ _)
 end
 
 lemma lift_prop_on_of_mem_maximal_atlas [has_groupoid M G]
@@ -420,26 +505,22 @@ begin
   assume x hx,
   apply hG.lift_prop_within_at_of_lift_prop_at_of_mem_nhds
     (hG.lift_prop_at_of_mem_maximal_atlas hQ he hx),
-  apply is_open.mem_nhds e.open_source hx,
+  exact is_open.mem_nhds e.open_source hx,
 end
 
 lemma lift_prop_at_symm_of_mem_maximal_atlas [has_groupoid M G] {x : H}
   (hG : G.local_invariant_prop G Q) (hQ : ∀ y, Q id univ y)
   (he : e ∈ maximal_atlas M G) (hx : x ∈ e.target) : lift_prop_at Q e.symm x :=
 begin
-  suffices h : Q (e ∘ e.symm) e.target x,
+  suffices h : Q (e ∘ e.symm) univ x,
   { have A : e.symm ⁻¹' e.source ∩ e.target = e.target,
       by mfld_set_tac,
     have : e.symm x ∈ e.source, by simp only [hx] with mfld_simps,
     rw [lift_prop_at,
       hG.lift_prop_within_at_indep_chart G.id_mem_maximal_atlas (mem_univ _) he this],
     refine ⟨(e.symm.continuous_at hx).continuous_within_at, _⟩,
-    simp only with mfld_simps,
-    rwa [hG.is_local e.open_target hx, A] },
-  have A : Q id e.target x,
-    by simpa only with mfld_simps using (hG.is_local e.open_target hx).1 (hQ x),
-  apply hG.congr _ _ A;
-  simp only [hx] with mfld_simps {contextual := tt}
+    simp only [h] with mfld_simps },
+  exact hG.congr' (e.eventually_right_inverse hx) (hQ x)
 end
 
 lemma lift_prop_on_symm_of_mem_maximal_atlas [has_groupoid M G]
@@ -449,7 +530,7 @@ begin
   assume x hx,
   apply hG.lift_prop_within_at_of_lift_prop_at_of_mem_nhds
     (hG.lift_prop_at_symm_of_mem_maximal_atlas hQ he hx),
-  apply is_open.mem_nhds e.open_target hx,
+  exact is_open.mem_nhds e.open_target hx,
 end
 
 lemma lift_prop_at_chart [has_groupoid M G]
@@ -471,21 +552,43 @@ lemma lift_prop_on_chart_symm [has_groupoid M G]
   lift_prop_on Q (chart_at H x).symm (chart_at H x).target :=
 hG.lift_prop_on_symm_of_mem_maximal_atlas hQ (chart_mem_maximal_atlas G x)
 
+lemma lift_prop_at_of_mem_groupoid (hG : G.local_invariant_prop G Q) (hQ : ∀ y, Q id univ y)
+  {f : local_homeomorph H H} (hf : f ∈ G) {x : H} (hx : x ∈ f.source) :
+  lift_prop_at Q f x :=
+lift_prop_at_of_mem_maximal_atlas hG hQ (G.mem_maximal_atlas_of_mem_groupoid hf) hx
+
+lemma lift_prop_on_of_mem_groupoid (hG : G.local_invariant_prop G Q) (hQ : ∀ y, Q id univ y)
+  {f : local_homeomorph H H} (hf : f ∈ G) :
+  lift_prop_on Q f f.source :=
+lift_prop_on_of_mem_maximal_atlas hG hQ (G.mem_maximal_atlas_of_mem_groupoid hf)
+
 lemma lift_prop_id (hG : G.local_invariant_prop G Q) (hQ : ∀ y, Q id univ y) :
   lift_prop Q (id : M → M) :=
 begin
-  assume x,
-  dsimp [lift_prop_at, lift_prop_within_at],
-  refine ⟨continuous_within_at_id, _⟩,
-  let t := ((chart_at H x).target ∩ (chart_at H x).symm ⁻¹' (chart_at H x).source),
-  suffices H : Q id t ((chart_at H x) x),
-  { simp only with mfld_simps,
-    refine hG.congr (λ y hy, _) (by simp) H,
-    simp only with mfld_simps at hy,
-    simp only [hy] with mfld_simps },
-  have : t = univ ∩ (chart_at H x).target, by mfld_set_tac,
-  rw this,
-  exact (hG.is_local (chart_at H x).open_target (by simp)).1 (hQ _)
+  simp_rw [lift_prop_iff, continuous_id, true_and],
+  exact λ x, hG.congr' ((chart_at H x).eventually_right_inverse $ mem_chart_target H x) (hQ _)
+end
+
+lemma lift_prop_at_iff_comp_inclusion (hG : local_invariant_prop G G' P) {U V : opens M}
+  (hUV : U ≤ V) (f : V → M') (x : U) :
+  lift_prop_at P f (set.inclusion hUV x) ↔ lift_prop_at P (f ∘ set.inclusion hUV : U → M') x :=
+begin
+  congrm _ ∧ _,
+  { simp [continuous_within_at_univ,
+      (topological_space.opens.open_embedding_of_le hUV).continuous_at_iff] },
+  { apply hG.congr_iff,
+    exact (topological_space.opens.chart_at_inclusion_symm_eventually_eq hUV).fun_comp
+      (chart_at H' (f (set.inclusion hUV x)) ∘ f) },
+end
+
+lemma lift_prop_inclusion {Q : (H → H) → (set H) → H → Prop} (hG : local_invariant_prop G G Q)
+  (hQ : ∀ y, Q id univ y) {U V : opens M} (hUV : U ≤ V) :
+  lift_prop Q (set.inclusion hUV : U → V) :=
+begin
+  intro x,
+  show lift_prop_at Q (id ∘ inclusion hUV) x,
+  rw ← hG.lift_prop_at_iff_comp_inclusion hUV,
+  apply hG.lift_prop_id hQ,
 end
 
 end local_invariant_prop
@@ -499,7 +602,7 @@ open local_homeomorph
 structure groupoid `G` for `H`, relative to a set `s` in `H`, if for all points `x` in the set, the
 function agrees with a `G`-structomorphism on `s` in a neighbourhood of `x`. -/
 def is_local_structomorph_within_at (f : H → H) (s : set H) (x : H) : Prop :=
-(x ∈ s) → ∃ (e : local_homeomorph H H), e ∈ G ∧ eq_on f e.to_fun (s ∩ e.source) ∧ x ∈ e.source
+x ∈ s → ∃ (e : local_homeomorph H H), e ∈ G ∧ eq_on f e.to_fun (s ∩ e.source) ∧ x ∈ e.source
 
 /-- For a groupoid `G` which is `closed_under_restriction`, being a local structomorphism is a local
 invariant property. -/
@@ -520,24 +623,24 @@ lemma is_local_structomorph_within_at_local_invariant_prop [closed_under_restric
         simpa only [this, interior_interior, hu.interior_eq] with mfld_simps using hef },
       { simp only [*, interior_interior, hu.interior_eq] with mfld_simps } }
   end,
-  right_invariance := begin
+  right_invariance' := begin
     intros s x f e' he'G he'x h hx,
-    have hxs : x ∈ s := by simpa only [e'.left_inv he'x] with mfld_simps using hx.2,
+    have hxs : x ∈ s := by simpa only [e'.left_inv he'x] with mfld_simps using hx,
     rcases h hxs with ⟨e, heG, hef, hex⟩,
     refine ⟨e'.symm.trans e, G.trans (G.symm he'G) heG, _, _⟩,
     { intros y hy,
       simp only with mfld_simps at hy,
-      simp only [hef ⟨hy.1.2, hy.2.2⟩] with mfld_simps },
+      simp only [hef ⟨hy.1, hy.2.2⟩] with mfld_simps },
     { simp only [hex, he'x] with mfld_simps }
   end,
-  congr := begin
+  congr_of_forall := begin
     intros s x f g hfgs hfg' h hx,
     rcases h hx with ⟨e, heG, hef, hex⟩,
     refine ⟨e, heG, _, hex⟩,
     intros y hy,
     rw [← hef hy, hfgs y hy.1]
   end,
-  left_invariance := begin
+  left_invariance' := begin
     intros s x f e' he'G he' hfx h hx,
     rcases h hx with ⟨e, heG, hef, hex⟩,
     refine ⟨e.trans e', G.trans heG he'G, _, _⟩,
@@ -547,6 +650,87 @@ lemma is_local_structomorph_within_at_local_invariant_prop [closed_under_restric
     { simpa only [hex, hef ⟨hx, hex⟩] with mfld_simps using hfx }
   end }
 
+/-- A slight reformulation of `is_local_structomorph_within_at` when `f` is a local homeomorph.
+  This gives us an `e` that is defined on a subset of `f.source`. -/
+lemma _root_.local_homeomorph.is_local_structomorph_within_at_iff {G : structure_groupoid H}
+  [closed_under_restriction G]
+  (f : local_homeomorph H H) {s : set H} {x : H} (hx : x ∈ f.source ∪ sᶜ) :
+  G.is_local_structomorph_within_at ⇑f s x ↔
+  x ∈ s → ∃ (e : local_homeomorph H H), e ∈ G ∧ e.source ⊆ f.source ∧
+  eq_on f ⇑e (s ∩ e.source) ∧ x ∈ e.source :=
+begin
+  split,
+  { intros hf h2x,
+    obtain ⟨e, he, hfe, hxe⟩ := hf h2x,
+    refine ⟨e.restr f.source, closed_under_restriction' he f.open_source, _, _, hxe, _⟩,
+    { simp_rw [local_homeomorph.restr_source],
+      refine (inter_subset_right _ _).trans interior_subset },
+    { intros x' hx', exact hfe ⟨hx'.1, hx'.2.1⟩ },
+    { rw [f.open_source.interior_eq], exact or.resolve_right hx (not_not.mpr h2x) } },
+  { intros hf hx, obtain ⟨e, he, h2e, hfe, hxe⟩ := hf hx, exact ⟨e, he, hfe, hxe⟩ }
+end
+
+/-- A slight reformulation of `is_local_structomorph_within_at` when `f` is a local homeomorph and
+  the set we're considering is a superset of `f.source`. -/
+lemma _root_.local_homeomorph.is_local_structomorph_within_at_iff' {G : structure_groupoid H}
+  [closed_under_restriction G]
+  (f : local_homeomorph H H) {s : set H} {x : H} (hs : f.source ⊆ s) (hx : x ∈ f.source ∪ sᶜ) :
+  G.is_local_structomorph_within_at ⇑f s x ↔
+  x ∈ s → ∃ (e : local_homeomorph H H), e ∈ G ∧ e.source ⊆ f.source ∧
+  eq_on f ⇑e e.source ∧ x ∈ e.source :=
+begin
+  simp_rw [f.is_local_structomorph_within_at_iff hx],
+  refine imp_congr_right (λ hx, exists_congr $ λ e, and_congr_right $ λ he, _),
+  refine and_congr_right (λ h2e, _),
+  rw [inter_eq_right_iff_subset.mpr (h2e.trans hs)],
+end
+
+/-- A slight reformulation of `is_local_structomorph_within_at` when `f` is a local homeomorph and
+  the set we're considering is `f.source`. -/
+lemma _root_.local_homeomorph.is_local_structomorph_within_at_source_iff {G : structure_groupoid H}
+  [closed_under_restriction G]
+  (f : local_homeomorph H H) {x : H} :
+  G.is_local_structomorph_within_at ⇑f f.source x ↔
+  x ∈ f.source → ∃ (e : local_homeomorph H H), e ∈ G ∧ e.source ⊆ f.source ∧
+  eq_on f ⇑e e.source ∧ x ∈ e.source :=
+begin
+  have : x ∈ f.source ∪ f.sourceᶜ, { simp_rw [union_compl_self] },
+  exact f.is_local_structomorph_within_at_iff' subset.rfl this,
+end
+
+variables {H₁ : Type*} [topological_space H₁] {H₂ : Type*} [topological_space H₂]
+   {H₃ : Type*} [topological_space H₃] [charted_space H₁ H₂] [charted_space H₂ H₃]
+   {G₁ : structure_groupoid H₁} [has_groupoid H₂ G₁] [closed_under_restriction G₁]
+   (G₂ : structure_groupoid H₂) [has_groupoid H₃ G₂]
+
+variables (G₂)
+lemma has_groupoid.comp
+  (H : ∀ e ∈ G₂, lift_prop_on (is_local_structomorph_within_at G₁) (e : H₂ → H₂) e.source) :
+  @has_groupoid H₁ _ H₃ _ (charted_space.comp H₁ H₂ H₃) G₁ :=
+{ compatible := begin
+    rintros _ _ ⟨e, f, he, hf, rfl⟩ ⟨e', f', he', hf', rfl⟩,
+    apply G₁.locality,
+    intros x hx,
+    simp only with mfld_simps at hx,
+    have hxs : x ∈ f.symm ⁻¹' (e.symm ≫ₕ e').source,
+    { simp only [hx] with mfld_simps },
+    have hxs' : x ∈ f.target ∩ (f.symm) ⁻¹' ((e.symm ≫ₕ e').source ∩ (e.symm ≫ₕ e') ⁻¹' f'.source),
+    { simp only [hx] with mfld_simps },
+    obtain ⟨φ, hφG₁, hφ, hφ_dom⟩ := local_invariant_prop.lift_prop_on_indep_chart
+      (is_local_structomorph_within_at_local_invariant_prop G₁) (G₁.subset_maximal_atlas hf)
+      (G₁.subset_maximal_atlas hf') (H _ (G₂.compatible he he')) hxs' hxs,
+    simp_rw [← local_homeomorph.coe_trans, local_homeomorph.trans_assoc] at hφ,
+    simp_rw [local_homeomorph.trans_symm_eq_symm_trans_symm, local_homeomorph.trans_assoc],
+    have hs : is_open (f.symm ≫ₕ e.symm ≫ₕ e' ≫ₕ f').source :=
+      (f.symm ≫ₕ e.symm ≫ₕ e' ≫ₕ f').open_source,
+    refine ⟨_, hs.inter φ.open_source, _, _⟩,
+    { simp only [hx, hφ_dom] with mfld_simps, },
+    { refine G₁.eq_on_source (closed_under_restriction' hφG₁ hs) _,
+      rw local_homeomorph.restr_source_inter,
+      refine (hφ.mono _).restr_eq_on_source,
+      mfld_set_tac },
+  end }
+
 end local_structomorph
 
 end structure_groupoid
diff --git a/src/geometry/manifold/metrizable.lean b/src/geometry/manifold/metrizable.lean
new file mode 100644
index 0000000000000..681a32a20b59e
--- /dev/null
+++ b/src/geometry/manifold/metrizable.lean
@@ -0,0 +1,35 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import geometry.manifold.smooth_manifold_with_corners
+import topology.paracompact
+import topology.metric_space.metrizable
+
+/-!
+# Metrizability of a σ-compact manifold
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we show that a σ-compact Hausdorff topological manifold over a finite dimensional real
+vector space is metrizable.
+-/
+
+open topological_space
+
+/-- A σ-compact Hausdorff topological manifold over a finite dimensional real vector space is
+metrizable. -/
+lemma manifold_with_corners.metrizable_space
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+  {H : Type*} [topological_space H] (I : model_with_corners ℝ E H)
+  (M : Type*) [topological_space M] [charted_space H M]
+  [sigma_compact_space M] [t2_space M] : metrizable_space M :=
+begin
+  haveI := I.locally_compact, haveI := charted_space.locally_compact H M,
+  haveI : normal_space M := normal_of_paracompact_t2,
+  haveI := I.second_countable_topology,
+  haveI := charted_space.second_countable_of_sigma_compact H M,
+  exact metrizable_space_of_t3_second_countable M
+end
diff --git a/src/geometry/manifold/mfderiv.lean b/src/geometry/manifold/mfderiv.lean
index 6435272cf0b0c..c621b85eee4fc 100644
--- a/src/geometry/manifold/mfderiv.lean
+++ b/src/geometry/manifold/mfderiv.lean
@@ -1,13 +1,16 @@
 /-
 Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
+Authors: Sébastien Gouëzel, Floris van Doorn
 -/
-import geometry.manifold.tangent_bundle
+import geometry.manifold.vector_bundle.tangent
 
 /-!
 # The derivative of functions between smooth manifolds
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `M` and `M'` be two smooth manifolds with corners over a field `𝕜` (with respective models with
 corners `I` on `(E, H)` and `I'` on `(E', H')`), and let `f : M → M'`. We define the
 derivative of the function at a point, within a set or along the whole space, mimicking the API
@@ -60,9 +63,9 @@ of `f` in these charts.
 Due to the fact that we are working in a model with corners, with an additional embedding `I` of the
 model space `H` in the model vector space `E`, the charts taking values in `E` are not the original
 charts of the manifold, but those ones composed with `I`, called extended charts. We define
-`written_in_ext_chart I I' x f` for the function `f` written in the preferred extended charts.  Then
-the manifold derivative of `f`, at `x`, is just the usual derivative of `written_in_ext_chart I I' x
-f`, at the point `(ext_chart_at I x) x`.
+`written_in_ext_chart I I' x f` for the function `f` written in the preferred extended charts. Then
+the manifold derivative of `f`, at `x`, is just the usual derivative of
+`written_in_ext_chart I I' x f`, at the point `(ext_chart_at I x) x`.
 
 There is a subtelty with respect to continuity: if the function is not continuous, then the image
 of a small open set around `x` will not be contained in the source of the preferred chart around
@@ -92,9 +95,9 @@ Derivative, manifold
 -/
 
 noncomputable theory
-open_locale classical topological_space manifold
+open_locale classical topology manifold bundle
 
-open set
+open set bundle
 
 universe u
 
@@ -110,14 +113,72 @@ this specific chart.
 We use the names `mdifferentiable` and `mfderiv`, where the prefix letter `m` means "manifold".
 -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
 {M : Type*} [topological_space M] [charted_space H M]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
 {M' : Type*} [topological_space M'] [charted_space H' M']
 
+/-- Property in the model space of a model with corners of being differentiable within at set at a
+point, when read in the model vector space. This property will be lifted to manifolds to define
+differentiable functions between manifolds. -/
+def differentiable_within_at_prop (f : H → H') (s : set H) (x : H) : Prop :=
+differentiable_within_at 𝕜 (I' ∘ f ∘ (I.symm)) (⇑(I.symm) ⁻¹' s ∩ set.range I) (I x)
+
+/-- Being differentiable in the model space is a local property, invariant under smooth maps.
+Therefore, it will lift nicely to manifolds. -/
+lemma differentiable_within_at_local_invariant_prop :
+  (cont_diff_groupoid ⊤ I).local_invariant_prop (cont_diff_groupoid ⊤ I')
+    (differentiable_within_at_prop I I') :=
+{ is_local :=
+  begin
+    assume s x u f u_open xu,
+    have : I.symm ⁻¹' (s ∩ u) ∩ set.range I = (I.symm ⁻¹' s ∩ set.range I) ∩ I.symm ⁻¹' u,
+      by simp only [set.inter_right_comm, set.preimage_inter],
+    rw [differentiable_within_at_prop, differentiable_within_at_prop, this],
+    symmetry,
+    apply differentiable_within_at_inter,
+    have : u ∈ 𝓝 (I.symm (I x)),
+      by { rw [model_with_corners.left_inv], exact is_open.mem_nhds u_open xu },
+    apply continuous_at.preimage_mem_nhds I.continuous_symm.continuous_at this,
+  end,
+  right_invariance' :=
+  begin
+    assume s x f e he hx h,
+    rw differentiable_within_at_prop at h ⊢,
+    have : I x = (I ∘ e.symm ∘ I.symm) (I (e x)), by simp only [hx] with mfld_simps,
+    rw this at h,
+    have : I (e x) ∈ (I.symm) ⁻¹' e.target ∩ set.range I, by simp only [hx] with mfld_simps,
+    have := ((mem_groupoid_of_pregroupoid.2 he).2.cont_diff_within_at this),
+    convert (h.comp' _ (this.differentiable_within_at le_top)).mono_of_mem _ using 1,
+    { ext y, simp only with mfld_simps },
+    refine mem_nhds_within.mpr ⟨I.symm ⁻¹' e.target, e.open_target.preimage I.continuous_symm,
+      by simp_rw [set.mem_preimage, I.left_inv, e.maps_to hx], _⟩,
+    mfld_set_tac
+  end,
+  congr_of_forall :=
+  begin
+    assume s x f g h hx hf,
+    apply hf.congr,
+    { assume y hy,
+      simp only with mfld_simps at hy,
+      simp only [h, hy] with mfld_simps },
+    { simp only [hx] with mfld_simps }
+  end,
+  left_invariance' :=
+  begin
+    assume s x f e' he' hs hx h,
+    rw differentiable_within_at_prop at h ⊢,
+    have A : (I' ∘ f ∘ I.symm) (I x) ∈ (I'.symm ⁻¹' e'.source ∩ set.range I'),
+      by simp only [hx] with mfld_simps,
+    have := ((mem_groupoid_of_pregroupoid.2 he').1.cont_diff_within_at A),
+    convert (this.differentiable_within_at le_top).comp _ h _,
+    { ext y, simp only with mfld_simps },
+    { assume y hy, simp only with mfld_simps at hy, simpa only [hy] with mfld_simps using hs hy.1 }
+  end }
+
 /-- Predicate ensuring that, at a point and within a set, a function can have at most one
 derivative. This is expressed using the preferred chart at the considered point. -/
 def unique_mdiff_within_at (s : set M) (x : M) :=
@@ -127,11 +188,6 @@ unique_diff_within_at 𝕜 ((ext_chart_at I x).symm ⁻¹' s ∩ range I) ((ext_
 def unique_mdiff_on (s : set M) :=
 ∀x∈s, unique_mdiff_within_at I s x
 
-/-- Conjugating a function to write it in the preferred charts around `x`. The manifold derivative
-of `f` will just be the derivative of this conjugated function. -/
-@[simp, mfld_simps] def written_in_ext_chart_at (x : M) (f : M → M') : E → E' :=
-(ext_chart_at I' (f x)) ∘ f ∘ (ext_chart_at I x).symm
-
 /-- `mdifferentiable_within_at I I' f s x` indicates that the function `f` between manifolds
 has a derivative at the point `x` within the set `s`.
 This is a generalization of `differentiable_within_at` to manifolds.
@@ -145,6 +201,11 @@ continuous_within_at f s x ∧
 differentiable_within_at 𝕜 (written_in_ext_chart_at I I' x f)
   ((ext_chart_at I x).symm ⁻¹' s ∩ range I) ((ext_chart_at I x) x)
 
+lemma mdifferentiable_within_at_iff_lift_prop_within_at (f : M → M') (s : set M) (x : M) :
+  mdifferentiable_within_at I I' f s x
+  ↔ lift_prop_within_at (differentiable_within_at_prop I I') f s x :=
+by refl
+
 /-- `mdifferentiable_at I I' f x` indicates that the function `f` between manifolds
 has a derivative at the point `x`.
 This is a generalization of `differentiable_at` to manifolds.
@@ -158,6 +219,15 @@ continuous_at f x ∧
 differentiable_within_at 𝕜 (written_in_ext_chart_at I I' x f) (range I)
   ((ext_chart_at I x) x)
 
+lemma mdifferentiable_at_iff_lift_prop_at (f : M → M') (x : M) :
+  mdifferentiable_at I I' f x
+  ↔ lift_prop_at (differentiable_within_at_prop I I') f x :=
+begin
+  congrm _ ∧ _,
+  { rw continuous_within_at_univ },
+  { simp [differentiable_within_at_prop, set.univ_inter] }
+end
+
 /-- `mdifferentiable_on I I' f s` indicates that the function `f` between manifolds
 has a derivative within `s` at all points of `s`.
 This is a generalization of `differentiable_on` to manifolds. -/
@@ -212,7 +282,7 @@ derivative of `f` at `x` within `s`, as a continuous linear map from the tangent
 tangent space at `f x`. -/
 def mfderiv_within (f : M → M') (s : set M) (x : M) :
   tangent_space I x →L[𝕜] tangent_space I' (f x) :=
-if h : mdifferentiable_within_at I I' f s x then
+if mdifferentiable_within_at I I' f s x then
 (fderiv_within 𝕜 (written_in_ext_chart_at I I' x f) ((ext_chart_at I x).symm ⁻¹' s ∩ range I)
   ((ext_chart_at I x) x) : _)
 else 0
@@ -221,7 +291,7 @@ else 0
 `f` at `x`, as a continuous linear map from the tangent space at `x` to the tangent space at
 `f x`. -/
 def mfderiv (f : M → M') (x : M) : tangent_space I x →L[𝕜] tangent_space I' (f x) :=
-if h : mdifferentiable_at I I' f x then
+if mdifferentiable_at I I' f x then
 (fderiv_within 𝕜 (written_in_ext_chart_at I I' x f : E → E') (range I)
   ((ext_chart_at I x) x) : _)
 else 0
@@ -239,14 +309,14 @@ end derivatives_definitions
 section derivatives_properties
 /-! ### Unique differentiability sets in manifolds -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
 {M : Type*} [topological_space M] [charted_space H M] --
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {M' : Type*} [topological_space M'] [charted_space H' M']
-{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
 {H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
 {M'' : Type*} [topological_space M''] [charted_space H'' M'']
 {f f₀ f₁ : M → M'}
@@ -269,7 +339,7 @@ lemma unique_mdiff_within_at_iff {s : set M} {x : M} :
   ((ext_chart_at I x) x) :=
 begin
   apply unique_diff_within_at_congr,
-  rw [nhds_within_inter, nhds_within_inter, nhds_within_ext_chart_target_eq]
+  rw [nhds_within_inter, nhds_within_inter, nhds_within_ext_chart_at_target_eq]
 end
 
 lemma unique_mdiff_within_at.mono (h : unique_mdiff_within_at I s x) (st : s ⊆ t) :
@@ -279,15 +349,15 @@ unique_diff_within_at.mono h $ inter_subset_inter (preimage_mono st) (subset.ref
 lemma unique_mdiff_within_at.inter' (hs : unique_mdiff_within_at I s x) (ht : t ∈ 𝓝[s] x) :
   unique_mdiff_within_at I (s ∩ t) x :=
 begin
-  rw [unique_mdiff_within_at, ext_chart_preimage_inter_eq],
-  exact unique_diff_within_at.inter' hs (ext_chart_preimage_mem_nhds_within I x ht)
+  rw [unique_mdiff_within_at, ext_chart_at_preimage_inter_eq],
+  exact unique_diff_within_at.inter' hs (ext_chart_at_preimage_mem_nhds_within I x ht)
 end
 
 lemma unique_mdiff_within_at.inter (hs : unique_mdiff_within_at I s x) (ht : t ∈ 𝓝 x) :
   unique_mdiff_within_at I (s ∩ t) x :=
 begin
-  rw [unique_mdiff_within_at, ext_chart_preimage_inter_eq],
-  exact unique_diff_within_at.inter hs (ext_chart_preimage_mem_nhds I x ht)
+  rw [unique_mdiff_within_at, ext_chart_at_preimage_inter_eq],
+  exact unique_diff_within_at.inter hs (ext_chart_at_preimage_mem_nhds I x ht)
 end
 
 lemma is_open.unique_mdiff_within_at (xs : x ∈ s) (hs : is_open s) : unique_mdiff_within_at I s x :=
@@ -340,18 +410,34 @@ lemma mdifferentiable_within_at_iff {f : M → M'} {s : set M} {x : M} :
 begin
   refine and_congr iff.rfl (exists_congr $ λ f', _),
   rw [inter_comm],
-  simp only [has_fderiv_within_at, nhds_within_inter, nhds_within_ext_chart_target_eq]
+  simp only [has_fderiv_within_at, nhds_within_inter, nhds_within_ext_chart_at_target_eq]
 end
 
 include Is I's
 
+/-- One can reformulate differentiability within a set at a point as continuity within this set at
+this point, and differentiability in any chart containing that point. -/
+lemma mdifferentiable_within_at_iff_of_mem_source
+  {x' : M} {y : M'}
+  (hx : x' ∈ (charted_space.chart_at H x).source)
+  (hy : f x' ∈ (charted_space.chart_at H' y).source) :
+  mdifferentiable_within_at I I' f s x'
+  ↔ continuous_within_at f s x'
+    ∧ differentiable_within_at 𝕜
+        ((ext_chart_at I' y) ∘ f ∘ ((ext_chart_at I x).symm))
+        (((ext_chart_at I x).symm) ⁻¹' s ∩ set.range I)
+        ((ext_chart_at I x) x') :=
+(differentiable_within_at_local_invariant_prop I I').lift_prop_within_at_indep_chart
+  (structure_groupoid.chart_mem_maximal_atlas _ x) hx
+  (structure_groupoid.chart_mem_maximal_atlas _ y) hy
+
 lemma mfderiv_within_zero_of_not_mdifferentiable_within_at
   (h : ¬ mdifferentiable_within_at I I' f s x) : mfderiv_within I I' f s x = 0 :=
-by simp only [mfderiv_within, h, dif_neg, not_false_iff]
+by simp only [mfderiv_within, h, if_neg, not_false_iff]
 
 lemma mfderiv_zero_of_not_mdifferentiable_at
   (h : ¬ mdifferentiable_at I I' f x) : mfderiv I I' f x = 0 :=
-by simp only [mfderiv, h, dif_neg, not_false_iff]
+by simp only [mfderiv, h, if_neg, not_false_iff]
 
 theorem has_mfderiv_within_at.mono (h : has_mfderiv_within_at I I' f t x f') (hst : s ⊆ t) :
   has_mfderiv_within_at I I' f s x f' :=
@@ -384,17 +470,17 @@ end
 lemma has_mfderiv_within_at_inter' (h : t ∈ 𝓝[s] x) :
   has_mfderiv_within_at I I' f (s ∩ t) x f' ↔ has_mfderiv_within_at I I' f s x f' :=
 begin
-  rw [has_mfderiv_within_at, has_mfderiv_within_at, ext_chart_preimage_inter_eq,
+  rw [has_mfderiv_within_at, has_mfderiv_within_at, ext_chart_at_preimage_inter_eq,
       has_fderiv_within_at_inter', continuous_within_at_inter' h],
-  exact ext_chart_preimage_mem_nhds_within I x h,
+  exact ext_chart_at_preimage_mem_nhds_within I x h,
 end
 
 lemma has_mfderiv_within_at_inter (h : t ∈ 𝓝 x) :
   has_mfderiv_within_at I I' f (s ∩ t) x f' ↔ has_mfderiv_within_at I I' f s x f' :=
 begin
-  rw [has_mfderiv_within_at, has_mfderiv_within_at, ext_chart_preimage_inter_eq,
+  rw [has_mfderiv_within_at, has_mfderiv_within_at, ext_chart_at_preimage_inter_eq,
       has_fderiv_within_at_inter, continuous_within_at_inter h],
-  exact ext_chart_preimage_mem_nhds I x h,
+  exact ext_chart_at_preimage_mem_nhds I x h,
 end
 
 lemma has_mfderiv_within_at.union
@@ -420,7 +506,7 @@ lemma mdifferentiable_within_at.has_mfderiv_within_at (h : mdifferentiable_withi
   has_mfderiv_within_at I I' f s x (mfderiv_within I I' f s x) :=
 begin
   refine ⟨h.1, _⟩,
-  simp only [mfderiv_within, h, dif_pos] with mfld_simps,
+  simp only [mfderiv_within, h, if_pos] with mfld_simps,
   exact differentiable_within_at.has_fderiv_within_at h.2
 end
 
@@ -428,20 +514,20 @@ lemma mdifferentiable_within_at.mfderiv_within (h : mdifferentiable_within_at I
   (mfderiv_within I I' f s x) =
   fderiv_within 𝕜 (written_in_ext_chart_at I I' x f : _) ((ext_chart_at I x).symm ⁻¹' s ∩ range I)
   ((ext_chart_at I x) x) :=
-by simp only [mfderiv_within, h, dif_pos]
+by simp only [mfderiv_within, h, if_pos]
 
 lemma mdifferentiable_at.has_mfderiv_at (h : mdifferentiable_at I I' f x) :
   has_mfderiv_at I I' f x (mfderiv I I' f x) :=
 begin
   refine ⟨h.1, _⟩,
-  simp only [mfderiv, h, dif_pos] with mfld_simps,
+  simp only [mfderiv, h, if_pos] with mfld_simps,
   exact differentiable_within_at.has_fderiv_within_at h.2
 end
 
 lemma mdifferentiable_at.mfderiv (h : mdifferentiable_at I I' f x) :
   (mfderiv I I' f x) =
   fderiv_within 𝕜 (written_in_ext_chart_at I I' x f : _) (range I) ((ext_chart_at I x) x) :=
-by simp only [mfderiv, h, dif_pos]
+by simp only [mfderiv, h, if_pos]
 
 lemma has_mfderiv_at.mfderiv (h : has_mfderiv_at I I' f x f') :
   mfderiv I I' f x = f' :=
@@ -480,17 +566,17 @@ by simp only [mdifferentiable_within_at, mdifferentiable_at, continuous_within_a
 lemma mdifferentiable_within_at_inter (ht : t ∈ 𝓝 x) :
   mdifferentiable_within_at I I' f (s ∩ t) x ↔ mdifferentiable_within_at I I' f s x :=
 begin
-  rw [mdifferentiable_within_at, mdifferentiable_within_at, ext_chart_preimage_inter_eq,
+  rw [mdifferentiable_within_at, mdifferentiable_within_at, ext_chart_at_preimage_inter_eq,
       differentiable_within_at_inter, continuous_within_at_inter ht],
-  exact ext_chart_preimage_mem_nhds I x ht
+  exact ext_chart_at_preimage_mem_nhds I x ht
 end
 
 lemma mdifferentiable_within_at_inter' (ht : t ∈ 𝓝[s] x) :
   mdifferentiable_within_at I I' f (s ∩ t) x ↔ mdifferentiable_within_at I I' f s x :=
 begin
-  rw [mdifferentiable_within_at, mdifferentiable_within_at, ext_chart_preimage_inter_eq,
+  rw [mdifferentiable_within_at, mdifferentiable_within_at, ext_chart_at_preimage_inter_eq,
       differentiable_within_at_inter', continuous_within_at_inter' ht],
-  exact ext_chart_preimage_mem_nhds_within I x ht
+  exact ext_chart_at_preimage_mem_nhds_within I x ht
 end
 
 lemma mdifferentiable_at.mdifferentiable_within_at
@@ -533,10 +619,24 @@ begin
   rw mdifferentiable_within_at_univ
 end
 
-lemma mfderiv_within_inter (ht : t ∈ 𝓝 x) (hs : unique_mdiff_within_at I s x) :
+lemma mfderiv_within_inter (ht : t ∈ 𝓝 x) :
   mfderiv_within I I' f (s ∩ t) x = mfderiv_within I I' f s x :=
-by rw [mfderiv_within, mfderiv_within, ext_chart_preimage_inter_eq,
-  mdifferentiable_within_at_inter ht, fderiv_within_inter (ext_chart_preimage_mem_nhds I x ht) hs]
+by rw [mfderiv_within, mfderiv_within, ext_chart_at_preimage_inter_eq,
+  mdifferentiable_within_at_inter ht,
+  fderiv_within_inter (ext_chart_at_preimage_mem_nhds I x ht)]
+
+lemma mdifferentiable_at_iff_of_mem_source {x' : M} {y : M'}
+  (hx : x' ∈ (charted_space.chart_at H x).source)
+  (hy : f x' ∈ (charted_space.chart_at H' y).source) :
+  mdifferentiable_at I I' f x'
+  ↔ continuous_at f x'
+    ∧ differentiable_within_at 𝕜
+        ((ext_chart_at I' y) ∘ f ∘ ((ext_chart_at I x).symm))
+        (set.range I)
+        ((ext_chart_at I x) x') :=
+mdifferentiable_within_at_univ.symm.trans $
+  (mdifferentiable_within_at_iff_of_mem_source hx hy).trans $
+  by rw [continuous_within_at_univ, set.preimage_univ, set.univ_inter]
 
 omit Is I's
 
@@ -585,20 +685,62 @@ begin
   exact tangent_map_within_subset (subset_univ _) hs h,
 end
 
-@[simp, mfld_simps] lemma tangent_map_within_tangent_bundle_proj {p : tangent_bundle I M} :
-  tangent_bundle.proj I' M' (tangent_map_within I I' f s p) = f (tangent_bundle.proj I M p) := rfl
-
 @[simp, mfld_simps] lemma tangent_map_within_proj {p : tangent_bundle I M} :
-  (tangent_map_within I I' f s p).1 = f p.1 := rfl
-
-@[simp, mfld_simps] lemma tangent_map_tangent_bundle_proj {p : tangent_bundle I M} :
-  tangent_bundle.proj I' M' (tangent_map I I' f p) = f (tangent_bundle.proj I M p) := rfl
+  (tangent_map_within I I' f s p).proj = f p.proj := rfl
 
 @[simp, mfld_simps] lemma tangent_map_proj {p : tangent_bundle I M} :
-  (tangent_map I I' f p).1 = f p.1 := rfl
+  (tangent_map I I' f p).proj = f p.proj := rfl
 
 omit Is I's
 
+lemma mdifferentiable_within_at.prod_mk {f : M → M'} {g : M → M''}
+  (hf : mdifferentiable_within_at I I' f s x)
+  (hg : mdifferentiable_within_at I I'' g s x) :
+  mdifferentiable_within_at I (I'.prod I'') (λ x, (f x, g x)) s x :=
+⟨hf.1.prod hg.1, hf.2.prod hg.2⟩
+
+lemma mdifferentiable_at.prod_mk {f : M → M'} {g : M → M''}
+  (hf : mdifferentiable_at I I' f x)
+  (hg : mdifferentiable_at I I'' g x) :
+  mdifferentiable_at I (I'.prod I'') (λ x, (f x, g x)) x :=
+⟨hf.1.prod hg.1, hf.2.prod hg.2⟩
+
+lemma mdifferentiable_on.prod_mk {f : M → M'} {g : M → M''}
+  (hf : mdifferentiable_on I I' f s)
+  (hg : mdifferentiable_on I I'' g s) :
+  mdifferentiable_on I (I'.prod I'') (λ x, (f x, g x)) s :=
+λ x hx, (hf x hx).prod_mk (hg x hx)
+
+lemma mdifferentiable.prod_mk {f : M → M'} {g : M → M''}
+  (hf : mdifferentiable I I' f)
+  (hg : mdifferentiable I I'' g) :
+  mdifferentiable I (I'.prod I'') (λ x, (f x, g x)) :=
+λ x, (hf x).prod_mk (hg x)
+
+lemma mdifferentiable_within_at.prod_mk_space {f : M → E'} {g : M → E''}
+  (hf : mdifferentiable_within_at I 𝓘(𝕜, E') f s x)
+  (hg : mdifferentiable_within_at I 𝓘(𝕜, E'') g s x) :
+  mdifferentiable_within_at I 𝓘(𝕜, E' × E'') (λ x, (f x, g x)) s x :=
+⟨hf.1.prod hg.1, hf.2.prod hg.2⟩
+
+lemma mdifferentiable_at.prod_mk_space {f : M → E'} {g : M → E''}
+  (hf : mdifferentiable_at I 𝓘(𝕜, E') f x)
+  (hg : mdifferentiable_at I 𝓘(𝕜, E'') g x) :
+  mdifferentiable_at I 𝓘(𝕜, E' × E'') (λ x, (f x, g x)) x :=
+⟨hf.1.prod hg.1, hf.2.prod hg.2⟩
+
+lemma mdifferentiable_on.prod_mk_space {f : M → E'} {g : M → E''}
+  (hf : mdifferentiable_on I 𝓘(𝕜, E') f s)
+  (hg : mdifferentiable_on I 𝓘(𝕜, E'') g s) :
+  mdifferentiable_on I 𝓘(𝕜, E' × E'') (λ x, (f x, g x)) s :=
+λ x hx, (hf x hx).prod_mk_space (hg x hx)
+
+lemma mdifferentiable.prod_mk_space {f : M → E'} {g : M → E''}
+  (hf : mdifferentiable I 𝓘(𝕜, E') f)
+  (hg : mdifferentiable I 𝓘(𝕜, E'') g) :
+  mdifferentiable I 𝓘(𝕜, E' × E'') (λ x, (f x, g x)) :=
+λ x, (hf x).prod_mk_space (hg x)
+
 /-! ### Congruence lemmas for derivatives on manifolds -/
 
 lemma has_mfderiv_within_at.congr_of_eventually_eq (h : has_mfderiv_within_at I I' f s x f')
@@ -608,7 +750,7 @@ begin
   apply has_fderiv_within_at.congr_of_eventually_eq h.2,
   { have : (ext_chart_at I x).symm ⁻¹' {y | f₁ y = f y} ∈
       𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] ((ext_chart_at I x) x)  :=
-      ext_chart_preimage_mem_nhds_within I x h₁,
+      ext_chart_at_preimage_mem_nhds_within I x h₁,
     apply filter.mem_of_superset this (λy, _),
     simp only [hx] with mfld_simps {contextual := tt} },
   { simp only [hx] with mfld_simps },
@@ -680,7 +822,7 @@ begin
   by_cases h : mdifferentiable_within_at I I' f s x,
   { exact ((h.has_mfderiv_within_at).congr_of_eventually_eq hL hx).mfderiv_within hs },
   { unfold mfderiv_within,
-    rw [dif_neg h, dif_neg],
+    rw [if_neg h, if_neg],
     rwa ← hL.mdifferentiable_within_at_iff I I' hx }
 end
 
@@ -693,8 +835,7 @@ lemma tangent_map_within_congr (h : ∀ x ∈ s, f x = f₁ x)
   (p : tangent_bundle I M) (hp : p.1 ∈ s) (hs : unique_mdiff_within_at I s p.1) :
   tangent_map_within I I' f s p = tangent_map_within I I' f₁ s p :=
 begin
-  simp only [tangent_map_within, h p.fst hp, true_and, eq_self_iff_true, heq_iff_eq,
-    sigma.mk.inj_iff],
+  simp only [tangent_map_within, h p.1 hp, true_and, eq_self_iff_true, heq_iff_eq],
   congr' 1,
   exact mfderiv_within_congr hs h (h _ hp)
 end
@@ -708,6 +849,18 @@ begin
   exact hL.mfderiv_within_eq (unique_mdiff_within_at_univ I) A
 end
 
+/-- A congruence lemma for `mfderiv`, (ab)using the fact that `tangent_space I' (f x)` is
+definitionally equal to `E'`. -/
+lemma mfderiv_congr_point {x' : M} (h : x = x') :
+  @eq (E →L[𝕜] E') (mfderiv I I' f x) (mfderiv I I' f x') :=
+by subst h
+
+/-- A congruence lemma for `mfderiv`, (ab)using the fact that `tangent_space I' (f x)` is
+definitionally equal to `E'`. -/
+lemma mfderiv_congr {f' : M → M'} (h : f = f') :
+  @eq (E →L[𝕜] E') (mfderiv I I' f x) (mfderiv I I' f' x) :=
+by subst h
+
 /-! ### Composition lemmas -/
 
 omit Is I's
@@ -719,7 +872,7 @@ lemma written_in_ext_chart_comp (h : continuous_within_at f s x) :
 begin
   apply @filter.mem_of_superset _ _
     ((f ∘ (ext_chart_at I x).symm)⁻¹' (ext_chart_at I' (f x)).source) _
-    (ext_chart_preimage_mem_nhds_within I x
+    (ext_chart_at_preimage_mem_nhds_within I x
       (h.preimage_mem_nhds_within (ext_chart_at_source_mem_nhds _ _))),
   mfld_set_tac,
 end
@@ -740,10 +893,10 @@ begin
     ((ext_chart_at I x) x),
   { have : (ext_chart_at I x).symm ⁻¹' (f ⁻¹' (ext_chart_at I' (f x)).source)
     ∈ 𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] ((ext_chart_at I x) x)  :=
-      (ext_chart_preimage_mem_nhds_within I x
+      (ext_chart_at_preimage_mem_nhds_within I x
         (hf.1.preimage_mem_nhds_within (ext_chart_at_source_mem_nhds _ _))),
     unfold has_mfderiv_within_at at *,
-    rw [← has_fderiv_within_at_inter' this, ← ext_chart_preimage_inter_eq] at hf ⊢,
+    rw [← has_fderiv_within_at_inter' this, ← ext_chart_at_preimage_inter_eq] at hf ⊢,
     have : written_in_ext_chart_at I I' x f ((ext_chart_at I x) x)
         = (ext_chart_at I' (f x)) (f x),
       by simp only with mfld_simps,
@@ -808,6 +961,11 @@ begin
   exact has_mfderiv_at.comp x hg.has_mfderiv_at hf.has_mfderiv_at
 end
 
+lemma mfderiv_comp_of_eq {x : M} {y : M'}
+  (hg : mdifferentiable_at I' I'' g y) (hf : mdifferentiable_at I I' f x) (hy : f x = y) :
+  mfderiv I I'' (g ∘ f) x = (mfderiv I' I'' g (f x)).comp (mfderiv I I' f x) :=
+by { subst hy, exact mfderiv_comp x hg hf }
+
 lemma mdifferentiable_on.comp
   (hg : mdifferentiable_on I' I'' g u) (hf : mdifferentiable_on I I' f s) (st : s ⊆ f ⁻¹' u) :
   mdifferentiable_on I I'' (g ∘ f) s :=
@@ -853,9 +1011,9 @@ manifold structure, coincides with the usual Frechet derivative `fderiv`. In thi
 this and related statements.
 -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {f : E → E'} {s : set E} {x : E}
 
 lemma unique_mdiff_within_at_iff_unique_diff_within_at :
@@ -939,8 +1097,8 @@ alias mdifferentiable_iff_differentiable ↔
   mfderiv_within (𝓘(𝕜, E)) (𝓘(𝕜, E')) f s x = fderiv_within 𝕜 f s x :=
 begin
   by_cases h : mdifferentiable_within_at (𝓘(𝕜, E)) (𝓘(𝕜, E')) f s x,
-  { simp only [mfderiv_within, h, dif_pos] with mfld_simps },
-  { simp only [mfderiv_within, h, dif_neg, not_false_iff],
+  { simp only [mfderiv_within, h, if_pos] with mfld_simps },
+  { simp only [mfderiv_within, h, if_neg, not_false_iff],
     rw [mdifferentiable_within_at_iff_differentiable_within_at] at h,
     exact (fderiv_within_zero_of_not_differentiable_within_at h).symm }
 end
@@ -959,13 +1117,16 @@ section specific_functions
 
 /-! ### Differentiability of specific functions -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
 {M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
 {M' : Type*} [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
+{H'' : Type*} [topological_space H''] (I'' : model_with_corners 𝕜 E'' H'')
+{M'' : Type*} [topological_space M''] [charted_space H'' M''] [smooth_manifold_with_corners I'' M'']
 
 namespace continuous_linear_map
 
@@ -1038,7 +1199,7 @@ section id
 lemma has_mfderiv_at_id (x : M) :
   has_mfderiv_at I I (@_root_.id M) x (continuous_linear_map.id 𝕜 (tangent_space I x)) :=
 begin
-  refine ⟨continuous_id.continuous_at, _⟩,
+  refine ⟨continuous_at_id, _⟩,
   have : ∀ᶠ y in 𝓝[range I] ((ext_chart_at I x) x),
     ((ext_chart_at I x) ∘ (ext_chart_at I x).symm) y = id y,
   { apply filter.mem_of_superset (ext_chart_at_target_mem_nhds_within I x),
@@ -1078,7 +1239,7 @@ end
 by { ext1 ⟨x, v⟩, simp [tangent_map] }
 
 lemma tangent_map_within_id {p : tangent_bundle I M}
-  (hs : unique_mdiff_within_at I s (tangent_bundle.proj I M p)) :
+  (hs : unique_mdiff_within_at I s p.proj) :
   tangent_map_within I I (id : M → M) s p = p :=
 begin
   simp only [tangent_map_within, id.def],
@@ -1130,6 +1291,325 @@ lemma mfderiv_within_const (hxs : unique_mdiff_within_at I s x) :
 
 end const
 
+section prod
+/-! Operations on the product of two manifolds-/
+
+lemma has_mfderiv_at_fst (x : M × M') :
+  has_mfderiv_at (I.prod I') I prod.fst x
+    (continuous_linear_map.fst 𝕜 (tangent_space I x.1) (tangent_space I' x.2)) :=
+begin
+  refine ⟨continuous_fst.continuous_at, _⟩,
+  have : ∀ᶠ y in 𝓝[range (I.prod I')] (ext_chart_at (I.prod I') x x),
+    ((ext_chart_at I x.1) ∘ prod.fst ∘ (ext_chart_at (I.prod I') x).symm) y = y.1,
+  { apply filter.mem_of_superset (ext_chart_at_target_mem_nhds_within (I.prod I') x),
+    mfld_set_tac },
+  apply has_fderiv_within_at.congr_of_eventually_eq has_fderiv_within_at_fst this,
+  simp only with mfld_simps
+end
+
+theorem has_mfderiv_within_at_fst (s : set (M × M')) (x : M × M') :
+  has_mfderiv_within_at (I.prod I') I prod.fst s x
+    (continuous_linear_map.fst 𝕜 (tangent_space I x.1) (tangent_space I' x.2)) :=
+(has_mfderiv_at_fst I I' x).has_mfderiv_within_at
+
+lemma mdifferentiable_at_fst {x : M × M'} : mdifferentiable_at (I.prod I') I prod.fst x :=
+(has_mfderiv_at_fst I I' x).mdifferentiable_at
+
+lemma mdifferentiable_within_at_fst {s : set (M × M')} {x : M × M'} :
+  mdifferentiable_within_at (I.prod I') I prod.fst s x :=
+(mdifferentiable_at_fst I I').mdifferentiable_within_at
+
+lemma mdifferentiable_fst : mdifferentiable (I.prod I') I (prod.fst : M × M' → M) :=
+λx, mdifferentiable_at_fst I I'
+
+lemma mdifferentiable_on_fst {s : set (M × M')} : mdifferentiable_on (I.prod I') I prod.fst s :=
+(mdifferentiable_fst I I').mdifferentiable_on
+
+@[simp, mfld_simps] lemma mfderiv_fst {x : M × M'} :
+  mfderiv (I.prod I') I prod.fst x =
+  continuous_linear_map.fst 𝕜 (tangent_space I x.1) (tangent_space I' x.2) :=
+(has_mfderiv_at_fst I I' x).mfderiv
+
+lemma mfderiv_within_fst {s : set (M × M')} {x : M × M'}
+  (hxs : unique_mdiff_within_at (I.prod I') s x) :
+  mfderiv_within (I.prod I') I prod.fst s x =
+  continuous_linear_map.fst 𝕜 (tangent_space I x.1) (tangent_space I' x.2) :=
+by { rw mdifferentiable.mfderiv_within (mdifferentiable_at_fst I I') hxs, exact mfderiv_fst I I' }
+
+@[simp, mfld_simps] lemma tangent_map_prod_fst {p : tangent_bundle (I.prod I') (M × M')} :
+  tangent_map (I.prod I') I prod.fst p = ⟨p.proj.1, p.2.1⟩ :=
+by simp [tangent_map]
+
+lemma tangent_map_within_prod_fst {s : set (M × M')} {p : tangent_bundle (I.prod I') (M × M')}
+  (hs : unique_mdiff_within_at (I.prod I') s p.proj) :
+  tangent_map_within (I.prod I') I prod.fst s p = ⟨p.proj.1, p.2.1⟩ :=
+begin
+  simp only [tangent_map_within],
+  rw mfderiv_within_fst _ _ hs,
+  rcases p,
+  exact ⟨rfl, heq.rfl⟩
+end
+
+lemma has_mfderiv_at_snd (x : M × M') :
+  has_mfderiv_at (I.prod I') I' prod.snd x
+    (continuous_linear_map.snd 𝕜 (tangent_space I x.1) (tangent_space I' x.2)) :=
+begin
+  refine ⟨continuous_snd.continuous_at, _⟩,
+  have : ∀ᶠ y in 𝓝[range (I.prod I')] (ext_chart_at (I.prod I') x x),
+    ((ext_chart_at I' x.2) ∘ prod.snd ∘ (ext_chart_at (I.prod I') x).symm) y = y.2,
+  { apply filter.mem_of_superset (ext_chart_at_target_mem_nhds_within (I.prod I') x),
+    mfld_set_tac },
+  apply has_fderiv_within_at.congr_of_eventually_eq has_fderiv_within_at_snd this,
+  simp only with mfld_simps
+end
+
+theorem has_mfderiv_within_at_snd (s : set (M × M')) (x : M × M') :
+  has_mfderiv_within_at (I.prod I') I' prod.snd s x
+    (continuous_linear_map.snd 𝕜 (tangent_space I x.1) (tangent_space I' x.2)) :=
+(has_mfderiv_at_snd I I' x).has_mfderiv_within_at
+
+lemma mdifferentiable_at_snd {x : M × M'} : mdifferentiable_at (I.prod I') I' prod.snd x :=
+(has_mfderiv_at_snd I I' x).mdifferentiable_at
+
+lemma mdifferentiable_within_at_snd {s : set (M × M')} {x : M × M'} :
+  mdifferentiable_within_at (I.prod I') I' prod.snd s x :=
+(mdifferentiable_at_snd I I').mdifferentiable_within_at
+
+lemma mdifferentiable_snd : mdifferentiable (I.prod I') I' (prod.snd : M × M' → M') :=
+λx, mdifferentiable_at_snd I I'
+
+lemma mdifferentiable_on_snd {s : set (M × M')} : mdifferentiable_on (I.prod I') I' prod.snd s :=
+(mdifferentiable_snd I I').mdifferentiable_on
+
+@[simp, mfld_simps] lemma mfderiv_snd {x : M × M'} :
+  mfderiv (I.prod I') I' prod.snd x =
+  continuous_linear_map.snd 𝕜 (tangent_space I x.1) (tangent_space I' x.2) :=
+(has_mfderiv_at_snd I I' x).mfderiv
+
+lemma mfderiv_within_snd {s : set (M × M')} {x : M × M'}
+  (hxs : unique_mdiff_within_at (I.prod I') s x) :
+  mfderiv_within (I.prod I') I' prod.snd s x =
+  continuous_linear_map.snd 𝕜 (tangent_space I x.1) (tangent_space I' x.2) :=
+by { rw mdifferentiable.mfderiv_within (mdifferentiable_at_snd I I') hxs, exact mfderiv_snd I I' }
+
+@[simp, mfld_simps] lemma tangent_map_prod_snd {p : tangent_bundle (I.prod I') (M × M')} :
+  tangent_map (I.prod I') I' prod.snd p = ⟨p.proj.2, p.2.2⟩ :=
+by simp [tangent_map]
+
+lemma tangent_map_within_prod_snd {s : set (M × M')} {p : tangent_bundle (I.prod I') (M × M')}
+  (hs : unique_mdiff_within_at (I.prod I') s p.proj) :
+  tangent_map_within (I.prod I') I' prod.snd s p = ⟨p.proj.2, p.2.2⟩ :=
+begin
+  simp only [tangent_map_within],
+  rw mfderiv_within_snd,
+  { rcases p, split; refl },
+  { exact hs }
+end
+
+variables {I I' I''}
+lemma mdifferentiable_at.mfderiv_prod {f : M → M'} {g : M → M''} {x : M}
+  (hf : mdifferentiable_at I I' f x)
+  (hg : mdifferentiable_at I I'' g x) :
+  mfderiv I (I'.prod I'') (λ x, (f x, g x)) x = (mfderiv I I' f x).prod (mfderiv I I'' g x) :=
+begin
+  classical,
+  simp_rw [mfderiv, if_pos (hf.prod_mk hg), if_pos hf, if_pos hg],
+  exact hf.2.fderiv_within_prod hg.2 (I.unique_diff _ (mem_range_self _))
+end
+
+variables (I I' I'')
+
+lemma mfderiv_prod_left {x₀ : M} {y₀ : M'} :
+  mfderiv I (I.prod I') (λ x, (x, y₀)) x₀ =
+  continuous_linear_map.inl 𝕜 (tangent_space I x₀) (tangent_space I' y₀) :=
+begin
+  refine ((mdifferentiable_at_id I).mfderiv_prod (mdifferentiable_at_const I I')).trans _,
+  rw [mfderiv_id, mfderiv_const, continuous_linear_map.inl]
+end
+
+lemma mfderiv_prod_right {x₀ : M} {y₀ : M'} :
+  mfderiv I' (I.prod I') (λ y, (x₀, y)) y₀ =
+  continuous_linear_map.inr 𝕜 (tangent_space I x₀) (tangent_space I' y₀) :=
+begin
+  refine ((mdifferentiable_at_const I' I).mfderiv_prod (mdifferentiable_at_id I')).trans _,
+  rw [mfderiv_id, mfderiv_const, continuous_linear_map.inr]
+end
+
+/-- The total derivative of a function in two variables is the sum of the partial derivatives.
+  Note that to state this (without casts) we need to be able to see through the definition of
+  `tangent_space`. -/
+lemma mfderiv_prod_eq_add {f : M × M' → M''} {p : M × M'}
+  (hf : mdifferentiable_at (I.prod I') I'' f p) :
+  mfderiv (I.prod I') I'' f p =
+  (show E × E' →L[𝕜] E'', from mfderiv (I.prod I') I'' (λ (z : M × M'), f (z.1, p.2)) p +
+  mfderiv (I.prod I') I'' (λ (z : M × M'), f (p.1, z.2)) p) :=
+begin
+  dsimp only,
+  rw [← @prod.mk.eta _ _ p] at hf,
+  rw [mfderiv_comp_of_eq hf ((mdifferentiable_at_fst I I').prod_mk (mdifferentiable_at_const _ _))
+      rfl,
+    mfderiv_comp_of_eq hf ((mdifferentiable_at_const _ _).prod_mk (mdifferentiable_at_snd I I'))
+      rfl,
+    ← continuous_linear_map.comp_add,
+    (mdifferentiable_at_fst I I').mfderiv_prod (mdifferentiable_at_const (I.prod I') I'),
+    (mdifferentiable_at_const (I.prod I') I).mfderiv_prod (mdifferentiable_at_snd I I'),
+    mfderiv_fst, mfderiv_snd, mfderiv_const, mfderiv_const],
+  symmetry,
+  convert continuous_linear_map.comp_id _,
+  { exact continuous_linear_map.coprod_inl_inr },
+  simp_rw [prod.mk.eta],
+  all_goals { apply_instance }
+end
+
+end prod
+
+section arithmetic
+/-! #### Arithmetic
+
+Note that in the in `has_mfderiv_at` lemmas there is an abuse of the defeq between `E'` and
+`tangent_space 𝓘(𝕜, E') (f z)` (similarly for `g',F',p',q'`). In general this defeq is not
+canonical, but in this case (the tangent space of a vector space) it is canonical.
+ -/
+
+section group
+variables {I} {z : M} {f g : M → E'} {f' g' : tangent_space I z →L[𝕜] E'}
+
+lemma has_mfderiv_at.add (hf : has_mfderiv_at I 𝓘(𝕜, E') f z f')
+  (hg : has_mfderiv_at I 𝓘(𝕜, E') g z g') : has_mfderiv_at I 𝓘(𝕜, E') (f + g) z (f' + g') :=
+⟨hf.1.add hg.1, hf.2.add hg.2⟩
+
+lemma mdifferentiable_at.add (hf : mdifferentiable_at I 𝓘(𝕜, E') f z)
+  (hg : mdifferentiable_at I 𝓘(𝕜, E') g z) : mdifferentiable_at I 𝓘(𝕜, E') (f + g) z :=
+(hf.has_mfderiv_at.add hg.has_mfderiv_at).mdifferentiable_at
+
+lemma mdifferentiable.add (hf : mdifferentiable I 𝓘(𝕜, E') f) (hg : mdifferentiable I 𝓘(𝕜, E') g) :
+  mdifferentiable I 𝓘(𝕜, E') (f + g) :=
+λ x, (hf x).add (hg x)
+
+lemma mfderiv_add (hf : mdifferentiable_at I 𝓘(𝕜, E') f z)
+  (hg : mdifferentiable_at I 𝓘(𝕜, E') g z) :
+  (mfderiv I 𝓘(𝕜, E') (f + g) z : tangent_space I z →L[𝕜] E') =
+  (mfderiv I 𝓘(𝕜, E') f z + mfderiv I 𝓘(𝕜, E') g z : tangent_space I z →L[𝕜] E') :=
+(hf.has_mfderiv_at.add hg.has_mfderiv_at).mfderiv
+
+lemma has_mfderiv_at.const_smul (hf : has_mfderiv_at I 𝓘(𝕜, E') f z f') (s : 𝕜) :
+   has_mfderiv_at I 𝓘(𝕜, E') (s • f) z (s • f') :=
+⟨hf.1.const_smul s, hf.2.const_smul s⟩
+
+lemma mdifferentiable_at.const_smul (hf : mdifferentiable_at I 𝓘(𝕜, E') f z) (s : 𝕜) :
+  mdifferentiable_at I 𝓘(𝕜, E') (s • f) z :=
+(hf.has_mfderiv_at.const_smul s).mdifferentiable_at
+
+lemma mdifferentiable.const_smul (s : 𝕜) (hf : mdifferentiable I 𝓘(𝕜, E') f) :
+  mdifferentiable I 𝓘(𝕜, E') (s • f) :=
+λ x, (hf x).const_smul s
+
+lemma const_smul_mfderiv (hf : mdifferentiable_at I 𝓘(𝕜, E') f z) (s : 𝕜) :
+  (mfderiv I 𝓘(𝕜, E') (s • f) z : tangent_space I z →L[𝕜] E') =
+  (s • mfderiv I 𝓘(𝕜, E') f z : tangent_space I z →L[𝕜] E') :=
+(hf.has_mfderiv_at.const_smul s).mfderiv
+
+lemma has_mfderiv_at.neg (hf : has_mfderiv_at I 𝓘(𝕜, E') f z f') :
+   has_mfderiv_at I 𝓘(𝕜, E') (-f) z (-f') :=
+⟨hf.1.neg, hf.2.neg⟩
+
+lemma has_mfderiv_at_neg :
+  has_mfderiv_at I 𝓘(𝕜, E') (-f) z (-f') ↔ has_mfderiv_at I 𝓘(𝕜, E') f z f' :=
+⟨λ hf, by { convert hf.neg; rw [neg_neg] }, λ hf, hf.neg⟩
+
+lemma mdifferentiable_at.neg (hf : mdifferentiable_at I 𝓘(𝕜, E') f z) :
+  mdifferentiable_at I 𝓘(𝕜, E') (-f) z :=
+hf.has_mfderiv_at.neg.mdifferentiable_at
+
+lemma mdifferentiable_at_neg :
+  mdifferentiable_at I 𝓘(𝕜, E') (-f) z ↔ mdifferentiable_at I 𝓘(𝕜, E') f z :=
+⟨λ hf, by { convert hf.neg; rw [neg_neg] }, λ hf, hf.neg⟩
+
+lemma mdifferentiable.neg (hf : mdifferentiable I 𝓘(𝕜, E') f) :
+  mdifferentiable I 𝓘(𝕜, E') (-f) :=
+λ x, (hf x).neg
+
+lemma mfderiv_neg (f : M → E') (x : M) :
+  (mfderiv I 𝓘(𝕜, E') (-f) x : tangent_space I x →L[𝕜] E') =
+  (- mfderiv I 𝓘(𝕜, E') f x : tangent_space I x →L[𝕜] E') :=
+begin
+  simp_rw [mfderiv],
+  by_cases hf : mdifferentiable_at I 𝓘(𝕜, E') f x,
+  { exact hf.has_mfderiv_at.neg.mfderiv },
+  { rw [if_neg hf], rw [← mdifferentiable_at_neg] at hf, rw [if_neg hf, neg_zero] },
+end
+
+lemma has_mfderiv_at.sub (hf : has_mfderiv_at I 𝓘(𝕜, E') f z f')
+  (hg : has_mfderiv_at I 𝓘(𝕜, E') g z g') : has_mfderiv_at I 𝓘(𝕜, E') (f - g) z (f'- g') :=
+⟨hf.1.sub hg.1, hf.2.sub hg.2⟩
+
+lemma mdifferentiable_at.sub (hf : mdifferentiable_at I 𝓘(𝕜, E') f z)
+  (hg : mdifferentiable_at I 𝓘(𝕜, E') g z) : mdifferentiable_at I 𝓘(𝕜, E') (f - g) z :=
+(hf.has_mfderiv_at.sub hg.has_mfderiv_at).mdifferentiable_at
+
+lemma mdifferentiable.sub (hf : mdifferentiable I 𝓘(𝕜, E') f)
+  (hg : mdifferentiable I 𝓘(𝕜, E') g)  : mdifferentiable I 𝓘(𝕜, E') (f - g) :=
+λ x, (hf x).sub (hg x)
+
+lemma mfderiv_sub (hf : mdifferentiable_at I 𝓘(𝕜, E') f z)
+  (hg : mdifferentiable_at I 𝓘(𝕜, E') g z) :
+  (mfderiv I 𝓘(𝕜, E') (f - g) z : tangent_space I z →L[𝕜] E') =
+  (mfderiv I 𝓘(𝕜, E') f z - mfderiv I 𝓘(𝕜, E') g z : tangent_space I z →L[𝕜] E') :=
+(hf.has_mfderiv_at.sub hg.has_mfderiv_at).mfderiv
+
+end group
+
+section algebra_over_ring
+variables {I} {z : M} {F' : Type*} [normed_ring F'] [normed_algebra 𝕜 F']
+  {p q : M → F'} {p' q' : tangent_space I z →L[𝕜] F'}
+
+lemma has_mfderiv_within_at.mul' (hp : has_mfderiv_within_at I 𝓘(𝕜, F') p s z p')
+  (hq : has_mfderiv_within_at I 𝓘(𝕜, F') q s z q') :
+  has_mfderiv_within_at I 𝓘(𝕜, F') (p * q) s z (p z • q' + p'.smul_right (q z) : E →L[𝕜] F') :=
+⟨hp.1.mul hq.1, by simpa only with mfld_simps using hp.2.mul' hq.2⟩
+
+lemma has_mfderiv_at.mul' (hp : has_mfderiv_at I 𝓘(𝕜, F') p z p')
+  (hq : has_mfderiv_at I 𝓘(𝕜, F') q z q') :
+  has_mfderiv_at I 𝓘(𝕜, F') (p * q) z (p z • q' + p'.smul_right (q z) : E →L[𝕜] F') :=
+has_mfderiv_within_at_univ.mp $ hp.has_mfderiv_within_at.mul' hq.has_mfderiv_within_at
+
+lemma mdifferentiable_within_at.mul (hp : mdifferentiable_within_at I 𝓘(𝕜, F') p s z)
+  (hq : mdifferentiable_within_at I 𝓘(𝕜, F') q s z) :
+  mdifferentiable_within_at I 𝓘(𝕜, F') (p * q) s z :=
+(hp.has_mfderiv_within_at.mul' hq.has_mfderiv_within_at).mdifferentiable_within_at
+
+lemma mdifferentiable_at.mul (hp : mdifferentiable_at I 𝓘(𝕜, F') p z)
+  (hq : mdifferentiable_at I 𝓘(𝕜, F') q z) : mdifferentiable_at I 𝓘(𝕜, F') (p * q) z :=
+(hp.has_mfderiv_at.mul' hq.has_mfderiv_at).mdifferentiable_at
+
+lemma mdifferentiable_on.mul (hp : mdifferentiable_on I 𝓘(𝕜, F') p s)
+  (hq : mdifferentiable_on I 𝓘(𝕜, F') q s) : mdifferentiable_on I 𝓘(𝕜, F') (p * q) s :=
+λ x hx, (hp x hx).mul $ hq x hx
+
+lemma mdifferentiable.mul (hp : mdifferentiable I 𝓘(𝕜, F') p)
+  (hq : mdifferentiable I 𝓘(𝕜, F') q) : mdifferentiable I 𝓘(𝕜, F') (p * q) :=
+λ x, (hp x).mul (hq x)
+
+end algebra_over_ring
+
+section algebra_over_comm_ring
+variables {I} {z : M} {F' : Type*} [normed_comm_ring F'] [normed_algebra 𝕜 F']
+  {p q : M → F'} {p' q' : tangent_space I z →L[𝕜] F'}
+
+lemma has_mfderiv_within_at.mul (hp : has_mfderiv_within_at I 𝓘(𝕜, F') p s z p')
+  (hq : has_mfderiv_within_at I 𝓘(𝕜, F') q s z q') :
+  has_mfderiv_within_at I 𝓘(𝕜, F') (p * q) s z (p z • q' + q z • p' : E →L[𝕜] F') :=
+by { convert hp.mul' hq, ext z, apply mul_comm }
+
+lemma has_mfderiv_at.mul (hp : has_mfderiv_at I 𝓘(𝕜, F') p z p')
+  (hq : has_mfderiv_at I 𝓘(𝕜, F') q z q') :
+  has_mfderiv_at I 𝓘(𝕜, F') (p * q) z (p z • q' + q z • p' : E →L[𝕜] F') :=
+has_mfderiv_within_at_univ.mp $ hp.has_mfderiv_within_at.mul hq.has_mfderiv_within_at
+
+end algebra_over_comm_ring
+
+end arithmetic
+
 namespace model_with_corners
 /-! #### Model with corners -/
 
@@ -1229,7 +1709,7 @@ mdifferentiable_of_mem_atlas _ (chart_mem_atlas _ _)
 the identification between the tangent bundle of the model space and the product space. -/
 lemma tangent_map_chart {p q : tangent_bundle I M} (h : q.1 ∈ (chart_at H p.1).source) :
   tangent_map I I (chart_at H p.1) q =
-  (equiv.sigma_equiv_prod _ _).symm
+  (total_space.to_prod _ _).symm
     ((chart_at (model_prod H E) p : tangent_bundle I M → model_prod H E) q) :=
 begin
   dsimp [tangent_map],
@@ -1245,15 +1725,14 @@ lemma tangent_map_chart_symm {p : tangent_bundle I M} {q : tangent_bundle I H}
   (h : q.1 ∈ (chart_at H p.1).target) :
   tangent_map I I (chart_at H p.1).symm q =
   ((chart_at (model_prod H E) p).symm : model_prod H E → tangent_bundle I M)
-    ((equiv.sigma_equiv_prod H E) q) :=
+    ((total_space.to_prod H E) q) :=
 begin
   dsimp only [tangent_map],
   rw mdifferentiable_at.mfderiv (mdifferentiable_at_atlas_symm _ (chart_mem_atlas _ _) h),
   -- a trivial instance is needed after the rewrite, handle it right now.
   rotate, { apply_instance },
-  simp only [continuous_linear_map.coe_coe, basic_smooth_vector_bundle_core.chart, h,
-    tangent_bundle_core, basic_smooth_vector_bundle_core.to_topological_vector_bundle_core,
-    chart_at, sigma.mk.inj_iff] with mfld_simps,
+  simp only [continuous_linear_map.coe_coe, tangent_bundle.chart_at, h,
+    tangent_bundle_core, chart_at, total_space.to_prod_apply] with mfld_simps,
 end
 
 end charts
@@ -1263,14 +1742,14 @@ end specific_functions
 /-! ### Differentiable local homeomorphisms -/
 namespace local_homeomorph.mdifferentiable
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
 {M : Type*} [topological_space M] [charted_space H M]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {M' : Type*} [topological_space M'] [charted_space H' M']
-{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
 {H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
 {M'' : Type*} [topological_space M''] [charted_space H'' M'']
 {e : local_homeomorph M M'} (he : e.mdifferentiable I I')
@@ -1345,11 +1824,11 @@ lemma mfderiv_surjective {x : M} (hx : x ∈ e.source) :
 (he.mfderiv hx).surjective
 
 lemma ker_mfderiv_eq_bot {x : M} (hx : x ∈ e.source) :
-  (mfderiv I I' e x).ker = ⊥ :=
+  linear_map.ker (mfderiv I I' e x) = ⊥ :=
 (he.mfderiv hx).to_linear_equiv.ker
 
 lemma range_mfderiv_eq_top {x : M} (hx : x ∈ e.source) :
-  (mfderiv I I' e x).range = ⊤ :=
+  linear_map.range (mfderiv I I' e x) = ⊤ :=
 (he.mfderiv hx).to_linear_equiv.range
 
 lemma range_mfderiv_eq_univ {x : M} (hx : x ∈ e.source) :
@@ -1375,8 +1854,8 @@ end local_homeomorph.mdifferentiable
 
 section ext_chart_at
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
 {M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
 {s : set M} {x y : M}
@@ -1402,11 +1881,11 @@ end ext_chart_at
 /-! ### Unique derivative sets in manifolds -/
 section unique_mdiff
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
 {M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
 {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
 {M' : Type*} [topological_space M'] [charted_space H' M']
 {s : set M}
@@ -1436,7 +1915,7 @@ begin
   { have : unique_mdiff_within_at I s z := hs _ hx.2,
     have S : e.source ∩ e ⁻¹' ((ext_chart_at I' x).source) ∈ 𝓝 z,
     { apply is_open.mem_nhds,
-      apply e.continuous_on.preimage_open_of_open e.open_source (ext_chart_at_open_source I' x),
+      apply e.continuous_on.preimage_open_of_open e.open_source (is_open_ext_chart_at_source I' x),
       simp only [z_source, zx] with mfld_simps },
     have := this.inter S,
     rw [unique_mdiff_within_at_iff] at this,
@@ -1512,50 +1991,70 @@ begin
   { assume z hz,
     apply (hs z hz.1).inter',
     apply (hf z hz.1).preimage_mem_nhds_within,
-    exact is_open.mem_nhds (ext_chart_at_open_source I' y) hz.2 },
+    exact (is_open_ext_chart_at_source I' y).mem_nhds hz.2 },
   exact this.unique_diff_on_target_inter _
 end
 
-variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
-(Z : basic_smooth_vector_bundle_core I M F)
+open bundle
+variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+  (Z : M → Type*) [topological_space (total_space F Z)] [∀ b, topological_space (Z b)]
+  [∀ b, add_comm_monoid (Z b)] [∀ b, module 𝕜 (Z b)]
+  [fiber_bundle F Z] [vector_bundle 𝕜 F Z] [smooth_vector_bundle F Z I]
 
-/-- In a smooth fiber bundle constructed from core, the preimage under the projection of a set with
+/-- In a smooth fiber bundle, the preimage under the projection of a set with
 unique differential in the basis also has unique differential. -/
 lemma unique_mdiff_on.smooth_bundle_preimage (hs : unique_mdiff_on I s) :
-  unique_mdiff_on (I.prod (𝓘(𝕜, F))) (Z.to_topological_vector_bundle_core.proj ⁻¹' s) :=
+  unique_mdiff_on (I.prod (𝓘(𝕜, F))) (π F Z ⁻¹' s) :=
 begin
   /- Using a chart (and the fact that unique differentiability is invariant under charts), we
   reduce the situation to the model space, where we can use the fact that products respect
   unique differentiability. -/
   assume p hp,
-  replace hp : p.fst ∈ s, by simpa only with mfld_simps using hp,
+  replace hp : p.1 ∈ s, by simpa only with mfld_simps using hp,
   let e₀ := chart_at H p.1,
   let e := chart_at (model_prod H F) p,
+  have h2s : ∀ x, x ∈ e.target ∩ e.symm ⁻¹' (π F Z ⁻¹' s) ↔
+    (x.1 ∈ e₀.target ∧ (e₀.symm) x.1 ∈ (trivialization_at F Z p.1).base_set) ∧ (e₀.symm) x.1 ∈ s,
+  { intro x,
+    have A : x ∈ e.target ↔ x.1 ∈ e₀.target ∧
+      (e₀.symm) x.1 ∈ (trivialization_at F Z p.1).base_set,
+    { simp only [e, fiber_bundle.charted_space_chart_at, trivialization.mem_target,
+        bundle.total_space.proj] with mfld_simps },
+    rw [← A, mem_inter_iff, and.congr_right_iff],
+    intro hx,
+    simp only [fiber_bundle.charted_space_chart_at_symm_fst p x hx] with mfld_simps },
   -- It suffices to prove unique differentiability in a chart
   suffices h : unique_mdiff_on (I.prod (𝓘(𝕜, F)))
-    (e.target ∩ e.symm⁻¹' (Z.to_topological_vector_bundle_core.proj ⁻¹' s)),
+    (e.target ∩ e.symm ⁻¹' (π F Z ⁻¹' s)),
   { have A : unique_mdiff_on (I.prod (𝓘(𝕜, F))) (e.symm.target ∩
-      e.symm.symm ⁻¹' (e.target ∩ e.symm⁻¹' (Z.to_topological_vector_bundle_core.proj ⁻¹' s))),
+      e.symm.symm ⁻¹' (e.target ∩ e.symm⁻¹' (π F Z ⁻¹' s))),
     { apply h.unique_mdiff_on_preimage,
       exact (mdifferentiable_of_mem_atlas _ (chart_mem_atlas _ _)).symm,
       apply_instance },
-    have : p ∈ e.symm.target ∩
-      e.symm.symm ⁻¹' (e.target ∩ e.symm⁻¹' (Z.to_topological_vector_bundle_core.proj ⁻¹' s)),
-        by simp only [e, hp] with mfld_simps,
+    have : p ∈ e.symm.target ∩ e.symm.symm ⁻¹' (e.target ∩ e.symm⁻¹' (π F Z ⁻¹' s)),
+    { simp only [e, hp] with mfld_simps },
     apply (A _ this).mono,
     assume q hq,
     simp only [e, local_homeomorph.left_inv _ hq.1] with mfld_simps at hq,
     simp only [hq] with mfld_simps },
-  -- rewrite the relevant set in the chart as a direct product
-  have : (λ (p : E × F), (I.symm p.1, p.snd)) ⁻¹' e.target ∩
-         (λ (p : E × F), (I.symm p.1, p.snd)) ⁻¹' (e.symm ⁻¹' (sigma.fst ⁻¹' s)) ∩
-         (range I ×ˢ (univ : set F))
-        = (I.symm ⁻¹' (e₀.target ∩ e₀.symm⁻¹' s) ∩ range I) ×ˢ (univ : set F),
-    by mfld_set_tac,
   assume q hq,
-  replace hq : q.1 ∈ (chart_at H p.1).target ∧ ((chart_at H p.1).symm : H → M) q.1 ∈ s,
-    by simpa only with mfld_simps using hq,
-  simp only [unique_mdiff_within_at, model_with_corners.prod, preimage_inter, this] with mfld_simps,
+  simp only [unique_mdiff_within_at, model_with_corners.prod, -preimage_inter] with mfld_simps,
+  have : 𝓝[(I.symm ⁻¹' (e₀.target ∩ e₀.symm⁻¹' s) ∩ range I) ×ˢ univ] (I q.1, q.2) ≤
+    𝓝[(λ (p : E × F), (I.symm p.1, p.snd)) ⁻¹' (e.target ∩ e.symm ⁻¹' (π F Z ⁻¹' s)) ∩
+      (range I ×ˢ univ)] (I q.1, q.2),
+  { rw [nhds_within_le_iff, mem_nhds_within],
+    refine ⟨(λ (p : E × F), (I.symm p.1, p.snd)) ⁻¹' e.target, _, _, _⟩,
+    { exact e.open_target.preimage (I.continuous_symm.prod_map continuous_id) },
+    { simp only [prod.mk.eta] with mfld_simps at hq,
+      simp only [prod.mk.eta, hq] with mfld_simps },
+    rintro x hx,
+    simp only with mfld_simps at hx,
+    have h2x := hx,
+    simp only [e, fiber_bundle.charted_space_chart_at, trivialization.mem_target]
+      with mfld_simps at h2x,
+    simp only [h2s, hx, h2x, -preimage_inter] with mfld_simps },
+  refine unique_diff_within_at.mono_nhds _ this,
+  rw [h2s] at hq,
   -- apply unique differentiability of products to conclude
   apply unique_diff_on.prod _ unique_diff_on_univ,
   { simp only [hq] with mfld_simps },
@@ -1570,7 +2069,7 @@ begin
 end
 
 lemma unique_mdiff_on.tangent_bundle_proj_preimage (hs : unique_mdiff_on I s):
-  unique_mdiff_on I.tangent ((tangent_bundle.proj I M) ⁻¹' s) :=
+  unique_mdiff_on I.tangent (π E (tangent_space I) ⁻¹' s) :=
 hs.smooth_bundle_preimage _
 
 end unique_mdiff
diff --git a/src/geometry/manifold/partition_of_unity.lean b/src/geometry/manifold/partition_of_unity.lean
index 372b10dfa89b1..e345b485faf25 100644
--- a/src/geometry/manifold/partition_of_unity.lean
+++ b/src/geometry/manifold/partition_of_unity.lean
@@ -5,13 +5,15 @@ Authors: Yury G. Kudryashov
 -/
 import geometry.manifold.algebra.structures
 import geometry.manifold.bump_function
-import topology.paracompact
-import topology.partition_of_unity
+import topology.metric_space.partition_of_unity
 import topology.shrinking_lemma
 
 /-!
 # Smooth partition of unity
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define two structures, `smooth_bump_covering` and `smooth_partition_of_unity`. Both
 structures describe coverings of a set by a locally finite family of supports of smooth functions
 with some additional properties. The former structure is mostly useful as an intermediate step in
@@ -39,31 +41,33 @@ depends on `x`.
 We prove that on a smooth finitely dimensional real manifold with `σ`-compact Hausdorff topology,
 for any `U : M → set M` such that `∀ x ∈ s, U x ∈ 𝓝 x` there exists a `smooth_bump_covering ι I M s`
 subordinate to `U`. Then we use this fact to prove a similar statement about smooth partitions of
-unity.
-
-## Implementation notes
-
+unity, see `smooth_partition_of_unity.exists_is_subordinate`.
 
+Finally, we use existence of a partition of unity to prove lemma
+`exists_smooth_forall_mem_convex_of_local` that allows us to construct a globally defined smooth
+function from local functions.
 
 ## TODO
 
 * Build a framework for to transfer local definitions to global using partition of unity and use it
-  to define, e.g., the integral of a differential form over a manifold.
+  to define, e.g., the integral of a differential form over a manifold. Lemma
+  `exists_smooth_forall_mem_convex_of_local` is a first step in this direction.
 
 ## Tags
 
 smooth bump function, partition of unity
 -/
 
-universes uι uE uH uM
+universes uι uE uH uM uF
 
 open function filter finite_dimensional set
-open_locale topological_space manifold classical filter big_operators
+open_locale topology manifold classical filter big_operators
 
 noncomputable theory
 
 variables {ι : Type uι}
-{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+{E : Type uE} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+{F : Type uF} [normed_add_comm_group F] [normed_space ℝ F]
 {H : Type uH} [topological_space H] (I : model_with_corners ℝ E H)
 {M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
 
@@ -90,13 +94,13 @@ variables (ι M)
 * for each point `x ∈ s` there exists `i` such that `f i =ᶠ[𝓝 x] 1`;
   in other words, `x` belongs to the interior of `{y | f i y = 1}`;
 
-If `M` is a finite dimensional real manifold which is a sigma-compact Hausdorff topological space,
+If `M` is a finite dimensional real manifold which is a `σ`-compact Hausdorff topological space,
 then for every covering `U : M → set M`, `∀ x, U x ∈ 𝓝 x`, there exists a `smooth_bump_covering`
 subordinate to `U`, see `smooth_bump_covering.exists_is_subordinate`.
 
 This covering can be used, e.g., to construct a partition of unity and to prove the weak
 Whitney embedding theorem. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure smooth_bump_covering (s : set M := univ) :=
 (c : ι → M)
 (to_fun : Π i, smooth_bump_function I (c i))
@@ -121,7 +125,7 @@ variables {ι I M}
 
 namespace smooth_partition_of_unity
 
-variables {s : set M} (f : smooth_partition_of_unity ι I M s)
+variables {s : set M} (f : smooth_partition_of_unity ι I M s) {n : ℕ∞}
 
 instance {s : set M} : has_coe_to_fun (smooth_partition_of_unity ι I M s)
   (λ _, ι → C^∞⟮I, M; 𝓘(ℝ), ℝ⟯) :=
@@ -147,25 +151,72 @@ lemma le_one (i : ι) (x : M) : f i x ≤ 1 := f.to_partition_of_unity.le_one i
 
 lemma sum_nonneg (x : M) : 0 ≤ ∑ᶠ i, f i x := f.to_partition_of_unity.sum_nonneg x
 
+lemma cont_mdiff_smul {g : M → F} {i} (hg : ∀ x ∈ tsupport (f i), cont_mdiff_at I 𝓘(ℝ, F) n g x) :
+  cont_mdiff I 𝓘(ℝ, F) n (λ x, f i x • g x) :=
+cont_mdiff_of_support $ λ x hx, ((f i).cont_mdiff.cont_mdiff_at.of_le le_top).smul $ hg x $
+  tsupport_smul_subset_left _ _ hx
+
+lemma smooth_smul {g : M → F} {i} (hg : ∀ x ∈ tsupport (f i), smooth_at I 𝓘(ℝ, F) g x) :
+  smooth I 𝓘(ℝ, F) (λ x, f i x • g x) :=
+f.cont_mdiff_smul hg
+
+/-- If `f` is a smooth partition of unity on a set `s : set M` and `g : ι → M → F` is a family of
+functions such that `g i` is $C^n$ smooth at every point of the topological support of `f i`, then
+the sum `λ x, ∑ᶠ i, f i x • g i x` is smooth on the whole manifold. -/
+lemma cont_mdiff_finsum_smul {g : ι → M → F}
+  (hg : ∀ i (x ∈ tsupport (f i)), cont_mdiff_at I 𝓘(ℝ, F) n (g i) x) :
+  cont_mdiff I 𝓘(ℝ, F) n (λ x, ∑ᶠ i, f i x • g i x) :=
+cont_mdiff_finsum (λ i, f.cont_mdiff_smul (hg i)) $ f.locally_finite.subset $
+  λ i, support_smul_subset_left _ _
+
+/-- If `f` is a smooth partition of unity on a set `s : set M` and `g : ι → M → F` is a family of
+functions such that `g i` is smooth at every point of the topological support of `f i`, then the sum
+`λ x, ∑ᶠ i, f i x • g i x` is smooth on the whole manifold. -/
+lemma smooth_finsum_smul {g : ι → M → F}
+  (hg : ∀ i (x ∈ tsupport (f i)), smooth_at I 𝓘(ℝ, F) (g i) x) :
+  smooth I 𝓘(ℝ, F) (λ x, ∑ᶠ i, f i x • g i x) :=
+f.cont_mdiff_finsum_smul hg
+
+lemma finsum_smul_mem_convex {g : ι → M → F} {t : set F} {x : M} (hx : x ∈ s)
+  (hg : ∀ i, f i x ≠ 0 → g i x ∈ t) (ht : convex ℝ t) :
+  ∑ᶠ i, f i x • g i x ∈ t :=
+ht.finsum_mem (λ i, f.nonneg _ _) (f.sum_eq_one hx) hg
+
 /-- A smooth partition of unity `f i` is subordinate to a family of sets `U i` indexed by the same
 type if for each `i` the closure of the support of `f i` is a subset of `U i`. -/
 def is_subordinate (f : smooth_partition_of_unity ι I M s) (U : ι → set M) :=
 ∀ i, tsupport (f i) ⊆ U i
 
-@[simp] lemma is_subordinate_to_partition_of_unity {f : smooth_partition_of_unity ι I M s}
-  {U : ι → set M} :
+variables {f} {U : ι → set M}
+
+@[simp] lemma is_subordinate_to_partition_of_unity :
   f.to_partition_of_unity.is_subordinate U ↔ f.is_subordinate U :=
 iff.rfl
 
-alias is_subordinate_to_partition_of_unity ↔
-  _ smooth_partition_of_unity.is_subordinate.to_partition_of_unity
+alias is_subordinate_to_partition_of_unity ↔ _ is_subordinate.to_partition_of_unity
+
+/-- If `f` is a smooth partition of unity on a set `s : set M` subordinate to a family of open sets
+`U : ι → set M` and `g : ι → M → F` is a family of functions such that `g i` is $C^n$ smooth on
+`U i`, then the sum `λ x, ∑ᶠ i, f i x • g i x` is $C^n$ smooth on the whole manifold. -/
+lemma is_subordinate.cont_mdiff_finsum_smul {g : ι → M → F} (hf : f.is_subordinate U)
+  (ho : ∀ i, is_open (U i)) (hg : ∀ i, cont_mdiff_on I 𝓘(ℝ, F) n (g i) (U i)) :
+  cont_mdiff I 𝓘(ℝ, F) n (λ x, ∑ᶠ i, f i x • g i x) :=
+f.cont_mdiff_finsum_smul $ λ i x hx, (hg i).cont_mdiff_at $ (ho i).mem_nhds (hf i hx)
+
+/-- If `f` is a smooth partition of unity on a set `s : set M` subordinate to a family of open sets
+`U : ι → set M` and `g : ι → M → F` is a family of functions such that `g i` is smooth on `U i`,
+then the sum `λ x, ∑ᶠ i, f i x • g i x` is smooth on the whole manifold. -/
+lemma is_subordinate.smooth_finsum_smul {g : ι → M → F} (hf : f.is_subordinate U)
+  (ho : ∀ i, is_open (U i)) (hg : ∀ i, smooth_on I 𝓘(ℝ, F) (g i) (U i)) :
+  smooth I 𝓘(ℝ, F) (λ x, ∑ᶠ i, f i x • g i x) :=
+hf.cont_mdiff_finsum_smul ho hg
 
 end smooth_partition_of_unity
 
 namespace bump_covering
 
 -- Repeat variables to drop [finite_dimensional ℝ E] and [smooth_manifold_with_corners I M]
-lemma smooth_to_partition_of_unity {E : Type uE} [normed_group E] [normed_space ℝ E]
+lemma smooth_to_partition_of_unity {E : Type uE} [normed_add_comm_group E] [normed_space ℝ E]
   {H : Type uH} [topological_space H] {I : model_with_corners ℝ E H}
   {M : Type uM} [topological_space M] [charted_space H M] {s : set M}
   (f : bump_covering ι M s) (hf : ∀ i, smooth I 𝓘(ℝ) (f i)) (i : ι) :
@@ -242,14 +293,14 @@ lemma exists_is_subordinate [t2_space M] [sigma_compact_space M] (hs : is_closed
 begin
   -- First we deduce some missing instances
   haveI : locally_compact_space H := I.locally_compact,
-  haveI : locally_compact_space M := charted_space.locally_compact H,
+  haveI : locally_compact_space M := charted_space.locally_compact H M,
   haveI : normal_space M := normal_of_paracompact_t2,
   -- Next we choose a covering by supports of smooth bump functions
   have hB := λ x hx, smooth_bump_function.nhds_basis_support I (hU x hx),
   rcases refinement_of_locally_compact_sigma_compact_of_nhds_basis_set hs hB
     with ⟨ι, c, f, hf, hsub', hfin⟩, choose hcs hfU using hf,
   /- Then we use the shrinking lemma to get a covering by smaller open -/
-  rcases exists_subset_Union_closed_subset hs (λ i, (f i).open_support)
+  rcases exists_subset_Union_closed_subset hs (λ i, (f i).is_open_support)
     (λ x hx, hfin.point_finite x) hsub' with ⟨V, hsV, hVc, hVf⟩,
   choose r hrR hr using λ i, (f i).exists_r_pos_lt_subset_ball (hVc i) (hVf i),
   refine ⟨ι, ⟨c, λ i, (f i).update_r (r i) (hrR i), hcs, _, λ x hx, _⟩, λ i, _⟩,
@@ -314,8 +365,7 @@ def to_bump_covering : bump_covering ι M s :=
   f.to_bump_covering.is_subordinate (λ i, U (f.c i)) ↔ f.is_subordinate U :=
 iff.rfl
 
-alias is_subordinate_to_bump_covering ↔
-  _ smooth_bump_covering.is_subordinate.to_bump_covering
+alias is_subordinate_to_bump_covering ↔ _ is_subordinate.to_bump_covering
 
 /-- Every `smooth_bump_covering` defines a smooth partition of unity. -/
 def to_smooth_partition_of_unity : smooth_partition_of_unity ι I M s :=
@@ -374,8 +424,6 @@ begin
   exact nmem_support.1 (subset_compl_comm.1 (hf.support_subset i) hx)
 end
 
-variable {I}
-
 namespace smooth_partition_of_unity
 
 /-- A `smooth_partition_of_unity` that consists of a single function, uniformly equal to one,
@@ -390,7 +438,7 @@ def single (i : ι) (s : set M) : smooth_partition_of_unity ι I M s :=
   end
 
 instance [inhabited ι] (s : set M) : inhabited (smooth_partition_of_unity ι I M s) :=
-⟨single default s⟩
+⟨single I default s⟩
 
 variables [t2_space M] [sigma_compact_space M]
 
@@ -401,7 +449,7 @@ lemma exists_is_subordinate {s : set M} (hs : is_closed s) (U : ι → set M) (h
   ∃ f : smooth_partition_of_unity ι I M s, f.is_subordinate U :=
 begin
   haveI : locally_compact_space H := I.locally_compact,
-  haveI : locally_compact_space M := charted_space.locally_compact H,
+  haveI : locally_compact_space M := charted_space.locally_compact H M,
   haveI : normal_space M := normal_of_paracompact_t2,
   rcases bump_covering.exists_is_subordinate_of_prop (smooth I 𝓘(ℝ)) _ hs U ho hU
     with ⟨f, hf, hfU⟩,
@@ -412,3 +460,78 @@ begin
 end
 
 end smooth_partition_of_unity
+
+variables [sigma_compact_space M] [t2_space M] {t : M → set F} {n : ℕ∞}
+
+/-- Let `M` be a σ-compact Hausdorff finite dimensional topological manifold. Let `t : M → set F`
+be a family of convex sets. Suppose that for each point `x : M` there exists a neighborhood
+`U ∈ 𝓝 x` and a function `g : M → F` such that `g` is $C^n$ smooth on `U` and `g y ∈ t y` for all
+`y ∈ U`. Then there exists a $C^n$ smooth function `g : C^∞⟮I, M; 𝓘(ℝ, F), F⟯` such that `g x ∈ t x`
+for all `x`. See also `exists_smooth_forall_mem_convex_of_local` and
+`exists_smooth_forall_mem_convex_of_local_const`. -/
+lemma exists_cont_mdiff_forall_mem_convex_of_local (ht : ∀ x, convex ℝ (t x))
+  (Hloc : ∀ x : M, ∃ (U ∈ 𝓝 x) (g : M → F), cont_mdiff_on I 𝓘(ℝ, F) n g U ∧ ∀ y ∈ U, g y ∈ t y) :
+  ∃ g : C^n⟮I, M; 𝓘(ℝ, F), F⟯, ∀ x, g x ∈ t x :=
+begin
+  choose U hU g hgs hgt using Hloc,
+  obtain ⟨f, hf⟩ := smooth_partition_of_unity.exists_is_subordinate I is_closed_univ
+    (λ x, interior (U x)) (λ x, is_open_interior)
+    (λ x hx, mem_Union.2 ⟨x, mem_interior_iff_mem_nhds.2 (hU x)⟩),
+  refine ⟨⟨λ x, ∑ᶠ i, f i x • g i x,
+    hf.cont_mdiff_finsum_smul (λ i, is_open_interior) $ λ i, (hgs i).mono interior_subset⟩,
+    λ x, f.finsum_smul_mem_convex (mem_univ x) (λ i hi, hgt _ _ _) (ht _)⟩,
+  exact interior_subset (hf _ $ subset_closure hi)
+end
+
+/-- Let `M` be a σ-compact Hausdorff finite dimensional topological manifold. Let `t : M → set F`
+be a family of convex sets. Suppose that for each point `x : M` there exists a neighborhood
+`U ∈ 𝓝 x` and a function `g : M → F` such that `g` is smooth on `U` and `g y ∈ t y` for all `y ∈ U`.
+Then there exists a smooth function `g : C^∞⟮I, M; 𝓘(ℝ, F), F⟯` such that `g x ∈ t x` for all `x`.
+See also `exists_cont_mdiff_forall_mem_convex_of_local` and
+`exists_smooth_forall_mem_convex_of_local_const`. -/
+lemma exists_smooth_forall_mem_convex_of_local (ht : ∀ x, convex ℝ (t x))
+  (Hloc : ∀ x : M, ∃ (U ∈ 𝓝 x) (g : M → F), smooth_on I 𝓘(ℝ, F) g U ∧ ∀ y ∈ U, g y ∈ t y) :
+  ∃ g : C^∞⟮I, M; 𝓘(ℝ, F), F⟯, ∀ x, g x ∈ t x :=
+exists_cont_mdiff_forall_mem_convex_of_local I ht Hloc
+
+/-- Let `M` be a σ-compact Hausdorff finite dimensional topological manifold. Let `t : M → set F` be
+a family of convex sets. Suppose that for each point `x : M` there exists a vector `c : F` such that
+for all `y` in a neighborhood of `x` we have `c ∈ t y`. Then there exists a smooth function
+`g : C^∞⟮I, M; 𝓘(ℝ, F), F⟯` such that `g x ∈ t x` for all `x`.  See also
+`exists_cont_mdiff_forall_mem_convex_of_local` and `exists_smooth_forall_mem_convex_of_local`. -/
+lemma exists_smooth_forall_mem_convex_of_local_const (ht : ∀ x, convex ℝ (t x))
+  (Hloc : ∀ x : M, ∃ c : F, ∀ᶠ y in 𝓝 x, c ∈ t y) :
+  ∃ g : C^∞⟮I, M; 𝓘(ℝ, F), F⟯, ∀ x, g x ∈ t x :=
+exists_smooth_forall_mem_convex_of_local I ht $ λ x,
+  let ⟨c, hc⟩ := Hloc x in ⟨_, hc, λ _, c, smooth_on_const, λ y, id⟩
+
+/-- Let `M` be a smooth σ-compact manifold with extended distance. Let `K : ι → set M` be a locally
+finite family of closed sets, let `U : ι → set M` be a family of open sets such that `K i ⊆ U i` for
+all `i`. Then there exists a positive smooth function `δ : M → ℝ≥0` such that for any `i` and
+`x ∈ K i`, we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
+lemma emetric.exists_smooth_forall_closed_ball_subset {M} [emetric_space M] [charted_space H M]
+  [smooth_manifold_with_corners I M] [sigma_compact_space M] {K : ι → set M}
+  {U : ι → set M} (hK : ∀ i, is_closed (K i)) (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i)
+  (hfin : locally_finite K) :
+  ∃ δ : C^∞⟮I, M; 𝓘(ℝ, ℝ), ℝ⟯, (∀ x, 0 < δ x) ∧
+    ∀ i (x ∈ K i), emetric.closed_ball x (ennreal.of_real (δ x)) ⊆ U i :=
+by simpa only [mem_inter_iff, forall_and_distrib, mem_preimage, mem_Inter, @forall_swap ι M]
+  using exists_smooth_forall_mem_convex_of_local_const I
+    emetric.exists_forall_closed_ball_subset_aux₂
+    (emetric.exists_forall_closed_ball_subset_aux₁ hK hU hKU hfin)
+
+/-- Let `M` be a smooth σ-compact manifold with a metric. Let `K : ι → set M` be a locally finite
+family of closed sets, let `U : ι → set M` be a family of open sets such that `K i ⊆ U i` for all
+`i`. Then there exists a positive smooth function `δ : M → ℝ≥0` such that for any `i` and `x ∈ K i`,
+we have `metric.closed_ball x (δ x) ⊆ U i`. -/
+lemma metric.exists_smooth_forall_closed_ball_subset {M} [metric_space M] [charted_space H M]
+  [smooth_manifold_with_corners I M] [sigma_compact_space M] {K : ι → set M}
+  {U : ι → set M} (hK : ∀ i, is_closed (K i)) (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i)
+  (hfin : locally_finite K) :
+  ∃ δ : C^∞⟮I, M; 𝓘(ℝ, ℝ), ℝ⟯, (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), metric.closed_ball x (δ x) ⊆ U i :=
+begin
+  rcases emetric.exists_smooth_forall_closed_ball_subset I hK hU hKU hfin with ⟨δ, hδ0, hδ⟩,
+  refine ⟨δ, hδ0, λ i x hx, _⟩,
+  rw [← metric.emetric_closed_ball (hδ0 _).le],
+  exact hδ i x hx
+end
diff --git a/src/geometry/manifold/sheaf/basic.lean b/src/geometry/manifold/sheaf/basic.lean
new file mode 100644
index 0000000000000..5c4722153c102
--- /dev/null
+++ b/src/geometry/manifold/sheaf/basic.lean
@@ -0,0 +1,92 @@
+/-
+Copyright © 2023 Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Heather Macbeth
+-/
+import geometry.manifold.local_invariant_properties
+import topology.sheaves.local_predicate
+
+/-! # Generic construction of a sheaf from a `local_invariant_prop` on a manifold
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file constructs the sheaf-of-types of functions `f : M → M'` (for charted spaces `M`, `M'`)
+which satisfy the lifted property `lift_prop P` associated to some locally invariant (in the sense
+of `structure_groupoid.local_invariant_prop`) property `P` on the model spaces of `M` and `M'`. For
+example, differentiability and smoothness are locally invariant properties in this sense, so this
+construction can be used to construct the sheaf of differentiable functions on a manifold and the
+sheaf of smooth functions on a manifold.
+
+The mathematical work is in associating a `Top.local_predicate` to a
+`structure_groupoid.local_invariant_prop`: that is, showing that a differential-geometric "locally
+invariant" property is preserved under restriction and gluing.
+
+## Main definitions
+
+* `structure_groupoid.local_invariant_prop.local_predicate`: the `Top.local_predicate` (in the
+  sheaf-theoretic sense) on functions from open subsets of `M` into `M'`, which states whether
+  such functions satisfy `lift_prop P`.
+* `structure_groupoid.local_invariant_prop.sheaf`: the sheaf-of-types of functions `f : M → M'`
+  which satisfy the lifted property `lift_prop P`.
+-/
+
+open_locale manifold topology
+open set topological_space structure_groupoid structure_groupoid.local_invariant_prop opposite
+
+universe u
+
+variables {H : Type*} [topological_space H] {H' : Type*} [topological_space H']
+  {G : structure_groupoid H} {G' : structure_groupoid H'}
+  {P : (H → H') → (set H) → H → Prop}
+  (M : Type u) [topological_space M] [charted_space H M]
+  (M' : Type u) [topological_space M'] [charted_space H' M']
+
+instance Top.of.charted_space : charted_space H (Top.of M) := (infer_instance : charted_space H M)
+
+instance Top.of.has_groupoid [has_groupoid M G] : has_groupoid (Top.of M) G :=
+(infer_instance : has_groupoid M G)
+
+/-- Let `P` be a `local_invariant_prop` for functions between spaces with the groupoids `G`, `G'`
+and let `M`, `M'` be charted spaces modelled on the model spaces of those groupoids.  Then there is
+an induced `local_predicate` on the functions from `M` to `M'`, given by `lift_prop P`. -/
+def structure_groupoid.local_invariant_prop.local_predicate (hG : local_invariant_prop G G' P) :
+  Top.local_predicate (λ (x : Top.of M), M') :=
+{ pred := λ {U : opens (Top.of M)}, λ (f : U → M'), lift_prop P f,
+  res := begin
+    intros U V i f h x,
+    have hUV : U ≤ V := category_theory.le_of_hom i,
+    show lift_prop_at P (f ∘ set.inclusion hUV) x,
+    rw ← hG.lift_prop_at_iff_comp_inclusion hUV,
+    apply h,
+  end,
+  locality := begin
+    intros V f h x,
+    obtain ⟨U, hxU, i, hU : lift_prop P (f ∘ i)⟩ := h x,
+    let x' : U := ⟨x, hxU⟩,
+    have hUV : U ≤ V := category_theory.le_of_hom i,
+    have : lift_prop_at P f (inclusion hUV x'),
+    { rw hG.lift_prop_at_iff_comp_inclusion hUV,
+      exact hU x' },
+    convert this,
+    ext1,
+    refl
+  end }
+
+/-- Let `P` be a `local_invariant_prop` for functions between spaces with the groupoids `G`, `G'`
+and let `M`, `M'` be charted spaces modelled on the model spaces of those groupoids.  Then there is
+a sheaf of types on `M` which, to each open set `U` in `M`, associates the type of bundled
+functions from `U` to `M'` satisfying the lift of `P`. -/
+def structure_groupoid.local_invariant_prop.sheaf (hG : local_invariant_prop G G' P) :
+  Top.sheaf (Type u) (Top.of M) :=
+Top.subsheaf_to_Types (hG.local_predicate M M')
+
+instance structure_groupoid.local_invariant_prop.sheaf_has_coe_to_fun
+  (hG : local_invariant_prop G G' P) (U : (opens (Top.of M))ᵒᵖ) :
+  has_coe_to_fun ((hG.sheaf M M').val.obj U) (λ _, (unop U) → M') :=
+{ coe := λ a, a.1 }
+
+lemma structure_groupoid.local_invariant_prop.section_spec (hG : local_invariant_prop G G' P)
+  (U : (opens (Top.of M))ᵒᵖ) (f : (hG.sheaf M M').val.obj U) :
+  lift_prop P f :=
+f.2
diff --git a/src/geometry/manifold/smooth_manifold_with_corners.lean b/src/geometry/manifold/smooth_manifold_with_corners.lean
index 3d2d6e9dd857a..9eade2cf3a81a 100644
--- a/src/geometry/manifold/smooth_manifold_with_corners.lean
+++ b/src/geometry/manifold/smooth_manifold_with_corners.lean
@@ -9,12 +9,15 @@ import geometry.manifold.charted_space
 /-!
 # Smooth manifolds (possibly with boundary or corners)
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A smooth manifold is a manifold modelled on a normed vector space, or a subset like a
 half-space (to get manifolds with boundaries) for which the changes of coordinates are smooth maps.
 We define a model with corners as a map `I : H → E` embedding nicely the topological space `H` in
 the vector space `E` (or more precisely as a structure containing all the relevant properties).
 Given such a model with corners `I` on `(E, H)`, we define the groupoid of local
-homeomorphisms of `H` which are smooth when read in `E` (for any regularity `n : with_top ℕ`).
+homeomorphisms of `H` which are smooth when read in `E` (for any regularity `n : ℕ∞`).
 With this groupoid at hand and the general machinery of charted spaces, we thus get the notion
 of `C^n` manifold with respect to any model with corners `I` on `(E, H)`. We also introduce a
 specific type class for `C^∞` manifolds as these are the most commonly used.
@@ -63,7 +66,7 @@ In the same way, it would not apply to product manifolds, modelled on
 The right invocation does not focus on one specific construction, but on all constructions sharing
 the right properties, like
 
-  `variables {E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+  `variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
   {I : model_with_corners ℝ E E} [I.boundaryless]
   {M : Type*} [topological_space M] [charted_space E M] [smooth_manifold_with_corners I M]`
 
@@ -113,21 +116,20 @@ noncomputable theory
 
 universes u v w u' v' w'
 
-open set filter
-open_locale manifold filter topological_space
+open set filter function
+open_locale manifold filter topology
 
-localized "notation `∞` := (⊤ : with_top ℕ)" in manifold
+localized "notation (name := with_top.nat.top) `∞` := (⊤ : ℕ∞)" in manifold
 
-section model_with_corners
 /-! ### Models with corners. -/
 
 /-- A structure containing informations on the way a space `H` embeds in a
 model vector space `E` over the field `𝕜`. This is all what is needed to
 define a smooth manifold with model space `H`, and model vector space `E`.
 -/
-@[nolint has_inhabited_instance]
-structure model_with_corners (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
-  (E : Type*) [normed_group E] [normed_space 𝕜 E] (H : Type*) [topological_space H]
+@[ext, nolint has_nonempty_instance]
+structure model_with_corners (𝕜 : Type*) [nontrivially_normed_field 𝕜]
+  (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] (H : Type*) [topological_space H]
   extends local_equiv H E :=
 (source_eq          : source = univ)
 (unique_diff'       : unique_diff_on 𝕜 to_local_equiv.target)
@@ -137,21 +139,23 @@ structure model_with_corners (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
 attribute [simp, mfld_simps] model_with_corners.source_eq
 
 /-- A vector space is a model with corners. -/
-def model_with_corners_self (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
-  (E : Type*) [normed_group E] [normed_space 𝕜 E] : model_with_corners 𝕜 E E :=
+def model_with_corners_self (𝕜 : Type*) [nontrivially_normed_field 𝕜]
+  (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] : model_with_corners 𝕜 E E :=
 { to_local_equiv := local_equiv.refl E,
   source_eq    := rfl,
   unique_diff' := unique_diff_on_univ,
   continuous_to_fun  := continuous_id,
   continuous_inv_fun := continuous_id }
 
-localized "notation `𝓘(` 𝕜 `, ` E `)` := model_with_corners_self 𝕜 E" in manifold
+localized "notation (name := model_with_corners_self) `𝓘(` 𝕜 `, ` E `)` :=
+  model_with_corners_self 𝕜 E" in manifold
 
-localized "notation `𝓘(` 𝕜 `)` := model_with_corners_self 𝕜 𝕜" in manifold
+localized "notation (name := model_with_corners_self.self) `𝓘(` 𝕜 `)` :=
+  model_with_corners_self 𝕜 𝕜" in manifold
 
 section
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] {H : Type*} [topological_space H]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {H : Type*} [topological_space H]
   (I : model_with_corners 𝕜 E H)
 
 namespace model_with_corners
@@ -161,6 +165,21 @@ instance : has_coe_to_fun (model_with_corners 𝕜 E H) (λ _, H → E) := ⟨λ
 /-- The inverse to a model with corners, only registered as a local equiv. -/
 protected def symm : local_equiv E H := I.to_local_equiv.symm
 
+/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
+  because it is a composition of multiple projections. -/
+def simps.apply (𝕜 : Type*) [nontrivially_normed_field 𝕜]
+  (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] (H : Type*) [topological_space H]
+  (I : model_with_corners 𝕜 E H) : H → E := I
+
+/-- See Note [custom simps projection] -/
+def simps.symm_apply (𝕜 : Type*) [nontrivially_normed_field 𝕜]
+  (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] (H : Type*) [topological_space H]
+  (I : model_with_corners 𝕜 E H) : E → H := I.symm
+
+initialize_simps_projections model_with_corners
+  (to_local_equiv_to_fun → apply, to_local_equiv_inv_fun → symm_apply,
+   to_local_equiv_source → source, to_local_equiv_target → target, -to_local_equiv)
+
 /- Register a few lemmas to make sure that `simp` puts expressions in normal form -/
 @[simp, mfld_simps] lemma to_local_equiv_coe : (I.to_local_equiv : H → E) = I :=
 rfl
@@ -198,7 +217,10 @@ protected lemma unique_diff : unique_diff_on 𝕜 (range I) := I.target_eq ▸ I
 @[simp, mfld_simps] protected lemma left_inv (x : H) : I.symm (I x) = x :=
 by { refine I.left_inv' _, simp }
 
-protected lemma left_inverse : function.left_inverse I.symm I := I.left_inv
+protected lemma left_inverse : left_inverse I.symm I := I.left_inv
+
+lemma injective : injective I :=
+I.left_inverse.injective
 
 @[simp, mfld_simps] lemma symm_comp_self : I.symm ∘ I = id :=
 I.left_inverse.comp_eq_id
@@ -209,6 +231,9 @@ I.left_inverse.right_inv_on_range
 @[simp, mfld_simps] protected lemma right_inv {x : E} (hx : x ∈ range I) : I (I.symm x) = x :=
 I.right_inv_on hx
 
+lemma preimage_image (s : set H) : I ⁻¹' (I '' s) = s :=
+I.injective.preimage_image s
+
 protected lemma image_eq (s : set H) : I '' s = I.symm ⁻¹' s ∩ range I :=
 begin
   refine (I.to_local_equiv.image_eq_target_inter_inv_preimage _).trans _,
@@ -225,10 +250,17 @@ I.closed_embedding.closed_range
 lemma map_nhds_eq (x : H) : map I (𝓝 x) = 𝓝[range I] (I x) :=
 I.closed_embedding.to_embedding.map_nhds_eq x
 
+lemma map_nhds_within_eq (s : set H) (x : H) : map I (𝓝[s] x) = 𝓝[I '' s] (I x) :=
+I.closed_embedding.to_embedding.map_nhds_within_eq s x
+
 lemma image_mem_nhds_within {x : H} {s : set H} (hs : s ∈ 𝓝 x) :
   I '' s ∈ 𝓝[range I] (I x) :=
 I.map_nhds_eq x ▸ image_mem_map hs
 
+lemma symm_map_nhds_within_image {x : H} {s : set H} :
+  map I.symm (𝓝[I '' s] (I x)) = 𝓝[s] x :=
+by rw [← I.map_nhds_within_eq, map_map, I.symm_comp_self, map_id]
+
 lemma symm_map_nhds_within_range (x : H) :
   map I.symm (𝓝[range I] (I x)) = 𝓝 x :=
 by rw [← I.map_nhds_eq, map_map, I.symm_comp_self, map_id]
@@ -244,6 +276,18 @@ I.unique_diff_preimage e.open_source
 lemma unique_diff_at_image {x : H} : unique_diff_within_at 𝕜 (range I) (I x) :=
 I.unique_diff _ (mem_range_self _)
 
+lemma symm_continuous_within_at_comp_right_iff {X} [topological_space X]
+  {f : H → X} {s : set H} {x : H} :
+  continuous_within_at (f ∘ I.symm) (I.symm ⁻¹' s ∩ range I) (I x) ↔ continuous_within_at f s x :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { have := h.comp I.continuous_within_at (maps_to_preimage _ _),
+    simp_rw [preimage_inter, preimage_preimage, I.left_inv, preimage_id', preimage_range,
+      inter_univ] at this,
+    rwa [function.comp.assoc, I.symm_comp_self] at this },
+  { rw [← I.left_inv x] at h, exact h.comp I.continuous_within_at_symm (inter_subset_left _ _) }
+end
+
 protected lemma locally_compact [locally_compact_space E] (I : model_with_corners 𝕜 E H) :
   locally_compact_space H :=
 begin
@@ -289,12 +333,12 @@ corners `I.prod I'` on `(E × E', model_prod H H')`. This appears in particular
 structure on the tangent bundle to a manifold modelled on `(E, H)`: it will be modelled on
 `(E × E, H × E)`. See note [Manifold type tags] for explanation about `model_prod H H'`
 vs `H × H'`. -/
-def model_with_corners.prod
-  {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
-  {E : Type v} [normed_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
-  (I : model_with_corners 𝕜 E H)
-  {E' : Type v'} [normed_group E'] [normed_space 𝕜 E'] {H' : Type w'} [topological_space H']
-  (I' : model_with_corners 𝕜 E' H') : model_with_corners 𝕜 (E × E') (model_prod H H') :=
+@[simps (lemmas_only)] def model_with_corners.prod
+  {𝕜 : Type u} [nontrivially_normed_field 𝕜]
+  {E : Type v} [normed_add_comm_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
+  (I : model_with_corners 𝕜 E H) {E' : Type v'} [normed_add_comm_group E'] [normed_space 𝕜 E']
+  {H' : Type w'} [topological_space H'] (I' : model_with_corners 𝕜 E' H') :
+  model_with_corners 𝕜 (E × E') (model_prod H H') :=
 { to_fun := λ x, (I x.1, I' x.2),
   inv_fun := λ x, (I.symm x.1, I'.symm x.2),
   source := {x | x.1 ∈ I.source ∧ x.2 ∈ I'.source},
@@ -308,8 +352,8 @@ def model_with_corners.prod
 corners `pi I` on `(Π i, E i, model_pi H)`. See note [Manifold type tags] for explanation about
 `model_pi H`. -/
 def model_with_corners.pi
-  {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {ι : Type v} [fintype ι]
-  {E : ι → Type w} [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
+  {𝕜 : Type u} [nontrivially_normed_field 𝕜] {ι : Type v} [fintype ι]
+  {E : ι → Type w} [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)]
   {H : ι → Type u'} [Π i, topological_space (H i)] (I : Π i, model_with_corners 𝕜 (E i) (H i)) :
   model_with_corners 𝕜 (Π i, E i) (model_pi H) :=
 { to_local_equiv := local_equiv.pi (λ i, (I i).to_local_equiv),
@@ -321,14 +365,15 @@ def model_with_corners.pi
 /-- Special case of product model with corners, which is trivial on the second factor. This shows up
 as the model to tangent bundles. -/
 @[reducible] def model_with_corners.tangent
-  {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
-  {E : Type v} [normed_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
+  {𝕜 : Type u} [nontrivially_normed_field 𝕜]
+  {E : Type v} [normed_add_comm_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
   (I : model_with_corners 𝕜 E H) : model_with_corners 𝕜 (E × E) (model_prod H E) :=
 I.prod (𝓘(𝕜, E))
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E] {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
-{F : Type*} [normed_group F] [normed_space 𝕜 F] {F' : Type*} [normed_group F'] [normed_space 𝕜 F']
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] {E : Type*} [normed_add_comm_group E]
+  [normed_space 𝕜 E] {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E'] {F : Type*}
+   [normed_add_comm_group F] [normed_space 𝕜 F] {F' : Type*} [normed_add_comm_group F']
+   [normed_space 𝕜 F']
 {H : Type*} [topological_space H] {H' : Type*} [topological_space H']
 {G : Type*} [topological_space G] {G' : Type*} [topological_space G']
 {I : model_with_corners 𝕜 E H} {J : model_with_corners 𝕜 F G}
@@ -345,26 +390,33 @@ rfl
   (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H') :
   ((I.prod I').symm : _ × _ → _ × _) = prod.map I.symm I'.symm := rfl
 
+lemma model_with_corners_self_prod : 𝓘(𝕜, E × F) = 𝓘(𝕜, E).prod 𝓘(𝕜, F) :=
+by { ext1, simp }
+
+lemma model_with_corners.range_prod : range (I.prod J) = range I ×ˢ range J :=
+by { simp_rw [← model_with_corners.target_eq], refl }
+
 end model_with_corners_prod
 
 section boundaryless
 
 /-- Property ensuring that the model with corners `I` defines manifolds without boundary. -/
-class model_with_corners.boundaryless {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] {H : Type*} [topological_space H]
+class model_with_corners.boundaryless {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {H : Type*} [topological_space H]
   (I : model_with_corners 𝕜 E H) : Prop :=
 (range_eq_univ : range I = univ)
 
 /-- The trivial model with corners has no boundary -/
-instance model_with_corners_self_boundaryless (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
-  (E : Type*) [normed_group E] [normed_space 𝕜 E] : (model_with_corners_self 𝕜 E).boundaryless :=
+instance model_with_corners_self_boundaryless (𝕜 : Type*) [nontrivially_normed_field 𝕜]
+  (E : Type*) [normed_add_comm_group E] [normed_space 𝕜 E] :
+  (model_with_corners_self 𝕜 E).boundaryless :=
 ⟨by simp⟩
 
 /-- If two model with corners are boundaryless, their product also is -/
-instance model_with_corners.range_eq_univ_prod {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
-  {E : Type v} [normed_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
-  (I : model_with_corners 𝕜 E H) [I.boundaryless]
-  {E' : Type v'} [normed_group E'] [normed_space 𝕜 E'] {H' : Type w'} [topological_space H']
+instance model_with_corners.range_eq_univ_prod {𝕜 : Type u} [nontrivially_normed_field 𝕜]
+  {E : Type v} [normed_add_comm_group E] [normed_space 𝕜 E] {H : Type w} [topological_space H]
+  (I : model_with_corners 𝕜 E H) [I.boundaryless] {E' : Type v'} [normed_add_comm_group E']
+  [normed_space 𝕜 E'] {H' : Type w'} [topological_space H']
   (I' : model_with_corners 𝕜 E' H') [I'.boundaryless] :
   (I.prod I').boundaryless :=
 begin
@@ -379,8 +431,8 @@ end boundaryless
 section cont_diff_groupoid
 /-! ### Smooth functions on models with corners -/
 
-variables {m n : with_top ℕ} {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {m n : ℕ∞} {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 {H : Type*} [topological_space H]
 (I : model_with_corners 𝕜 E H)
 {M : Type*} [topological_space M]
@@ -489,7 +541,7 @@ begin
     (of_set_mem_cont_diff_groupoid n I e.open_target) this
 end
 
-variables {E' : Type*} [normed_group E'] [normed_space 𝕜 E'] {H' : Type*} [topological_space H']
+variables {E' H' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E'] [topological_space H']
 
 /-- The product of two smooth local homeomorphisms is smooth. -/
 lemma cont_diff_groupoid_prod
@@ -525,8 +577,6 @@ end
 
 end cont_diff_groupoid
 
-end model_with_corners
-
 section smooth_manifold_with_corners
 
 /-! ### Smooth manifolds with corners -/
@@ -534,22 +584,22 @@ section smooth_manifold_with_corners
 /-- Typeclass defining smooth manifolds with corners with respect to a model with corners, over a
 field `𝕜` and with infinite smoothness to simplify typeclass search and statements later on. -/
 @[ancestor has_groupoid]
-class smooth_manifold_with_corners {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+class smooth_manifold_with_corners {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   (M : Type*) [topological_space M] [charted_space H M] extends
   has_groupoid M (cont_diff_groupoid ∞ I) : Prop
 
-lemma smooth_manifold_with_corners.mk' {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+lemma smooth_manifold_with_corners.mk' {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   (M : Type*) [topological_space M] [charted_space H M]
   [gr : has_groupoid M (cont_diff_groupoid ∞ I)] :
   smooth_manifold_with_corners I M := { ..gr }
 
 lemma smooth_manifold_with_corners_of_cont_diff_on
-  {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+  {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   (M : Type*) [topological_space M] [charted_space H M]
   (h : ∀ (e e' : local_homeomorph M H), e ∈ atlas H M → e' ∈ atlas H M →
@@ -563,8 +613,8 @@ lemma smooth_manifold_with_corners_of_cont_diff_on
   end }
 
 /-- For any model with corners, the model space is a smooth manifold -/
-instance model_space_smooth {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] {H : Type*} [topological_space H]
+instance model_space_smooth {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] {H : Type*} [topological_space H]
   {I : model_with_corners 𝕜 E H} :
   smooth_manifold_with_corners I H := { .. has_groupoid_model_space _ _ }
 
@@ -575,8 +625,8 @@ namespace smooth_manifold_with_corners
 charted space with a structure groupoid, avoiding the need to specify the groupoid
 `cont_diff_groupoid ∞ I` explicitly. -/
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   (M : Type*) [topological_space M] [charted_space H M]
 
@@ -586,9 +636,9 @@ def maximal_atlas := (cont_diff_groupoid ∞ I).maximal_atlas M
 
 variable {M}
 
-lemma mem_maximal_atlas_of_mem_atlas [smooth_manifold_with_corners I M]
-  {e : local_homeomorph M H} (he : e ∈ atlas H M) : e ∈ maximal_atlas I M :=
-structure_groupoid.mem_maximal_atlas_of_mem_atlas _ he
+lemma subset_maximal_atlas [smooth_manifold_with_corners I M] :
+  atlas H M ⊆ maximal_atlas I M :=
+structure_groupoid.subset_maximal_atlas _
 
 lemma chart_mem_maximal_atlas [smooth_manifold_with_corners I M] (x : M) :
   chart_at H x ∈ maximal_atlas I M :=
@@ -602,9 +652,9 @@ lemma compatible_of_mem_maximal_atlas
 structure_groupoid.compatible_of_mem_maximal_atlas he he'
 
 /-- The product of two smooth manifolds with corners is naturally a smooth manifold with corners. -/
-instance prod {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
-  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
+instance prod {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+  {E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
   {H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
   {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
   (M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
@@ -622,8 +672,8 @@ instance prod {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
 end smooth_manifold_with_corners
 
 lemma local_homeomorph.singleton_smooth_manifold_with_corners
-  {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+  {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   {M : Type*} [topological_space M]
   (e : local_homeomorph M H) (h : e.source = set.univ) :
@@ -632,8 +682,8 @@ lemma local_homeomorph.singleton_smooth_manifold_with_corners
 e.singleton_has_groupoid h (cont_diff_groupoid ∞ I)
 
 lemma open_embedding.singleton_smooth_manifold_with_corners
-  {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+  {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   {M : Type*} [topological_space M]
   [nonempty M] {f : M → H} (h : open_embedding f) :
@@ -644,8 +694,8 @@ namespace topological_space.opens
 
 open topological_space
 
-variables  {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables  {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+  {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
   {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
   {M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
   (s : opens M)
@@ -655,12 +705,13 @@ instance : smooth_manifold_with_corners I s := { ..s.has_groupoid (cont_diff_gro
 end topological_space.opens
 
 section extended_charts
-open_locale topological_space
+open_locale topology
 
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E]
-  {H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
-  {M : Type*} [topological_space M] [charted_space H M]
+variables {𝕜 E M H E' M' H' : Type*} [nontrivially_normed_field 𝕜]
+  [normed_add_comm_group E] [normed_space 𝕜 E] [topological_space H] [topological_space M]
+  (f f' : local_homeomorph M H) (I : model_with_corners 𝕜 E H)
+  [normed_add_comm_group E'] [normed_space 𝕜 E'] [topological_space H'] [topological_space M']
+  (I' : model_with_corners 𝕜 E' H')
   (x : M) {s t : set M}
 
 /-!
@@ -672,10 +723,250 @@ not `local_homeomorph` as the target is not open in `E` in general, but we can s
 as `local_equiv`.
 -/
 
+namespace local_homeomorph
+/-- Given a chart `f` on a manifold with corners, `f.extend I` is the extended chart to the model
+vector space. -/
+@[simp, mfld_simps] def extend : local_equiv M E :=
+f.to_local_equiv ≫ I.to_local_equiv
+
+lemma extend_coe : ⇑(f.extend I) = I ∘ f := rfl
+
+lemma extend_coe_symm : ⇑(f.extend I).symm = f.symm ∘ I.symm := rfl
+
+lemma extend_source : (f.extend I).source = f.source :=
+by rw [extend, local_equiv.trans_source, I.source_eq, preimage_univ, inter_univ]
+
+lemma is_open_extend_source : is_open (f.extend I).source :=
+by { rw extend_source, exact f.open_source }
+
+lemma extend_target : (f.extend I).target = I.symm ⁻¹' f.target ∩ range I :=
+by simp_rw [extend, local_equiv.trans_target, I.target_eq, I.to_local_equiv_coe_symm, inter_comm]
+
+lemma maps_to_extend (hs : s ⊆ f.source) :
+  maps_to (f.extend I) s ((f.extend I).symm ⁻¹' s ∩ range I) :=
+begin
+  rw [maps_to', extend_coe, extend_coe_symm, preimage_comp, ← I.image_eq, image_comp,
+    f.image_eq_target_inter_inv_preimage hs],
+  exact image_subset _ (inter_subset_right _ _)
+end
+
+lemma extend_left_inv {x : M} (hxf : x ∈ f.source) : (f.extend I).symm (f.extend I x) = x :=
+(f.extend I).left_inv $ by rwa f.extend_source
+
+lemma extend_source_mem_nhds {x : M} (h : x ∈ f.source) :
+  (f.extend I).source ∈ 𝓝 x :=
+(is_open_extend_source f I).mem_nhds $ by rwa f.extend_source I
+
+lemma extend_source_mem_nhds_within {x : M} (h : x ∈ f.source) :
+  (f.extend I).source ∈ 𝓝[s] x :=
+mem_nhds_within_of_mem_nhds $ extend_source_mem_nhds f I h
+
+lemma continuous_on_extend : continuous_on (f.extend I) (f.extend I).source :=
+begin
+  refine I.continuous.comp_continuous_on _,
+  rw extend_source,
+  exact f.continuous_on
+end
+
+lemma continuous_at_extend {x : M} (h : x ∈ f.source) :
+  continuous_at (f.extend I) x :=
+(continuous_on_extend f I).continuous_at $ extend_source_mem_nhds f I h
+
+lemma map_extend_nhds {x : M} (hy : x ∈ f.source) :
+  map (f.extend I) (𝓝 x) = 𝓝[range I] (f.extend I x) :=
+by rwa [extend_coe, (∘), ← I.map_nhds_eq, ← f.map_nhds_eq, map_map]
+
+lemma extend_target_mem_nhds_within {y : M} (hy : y ∈ f.source) :
+  (f.extend I).target ∈ 𝓝[range I] (f.extend I y) :=
+begin
+  rw [← local_equiv.image_source_eq_target, ← map_extend_nhds f I hy],
+  exact image_mem_map (extend_source_mem_nhds _ _ hy)
+end
+
+lemma extend_target_subset_range : (f.extend I).target ⊆ range I :=
+by simp only with mfld_simps
+
+lemma nhds_within_extend_target_eq {y : M} (hy : y ∈ f.source) :
+  𝓝[(f.extend I).target] (f.extend I y) =
+  𝓝[range I] (f.extend I y) :=
+(nhds_within_mono _ (extend_target_subset_range _ _)).antisymm $
+  nhds_within_le_of_mem (extend_target_mem_nhds_within _ _ hy)
+
+lemma continuous_at_extend_symm' {x : E} (h : x ∈ (f.extend I).target) :
+  continuous_at (f.extend I).symm x :=
+continuous_at.comp (f.continuous_at_symm h.2) (I.continuous_symm.continuous_at)
+
+lemma continuous_at_extend_symm {x : M} (h : x ∈ f.source) :
+  continuous_at (f.extend I).symm (f.extend I x) :=
+continuous_at_extend_symm' f I $ (f.extend I).map_source $ by rwa f.extend_source
+
+lemma continuous_on_extend_symm :
+  continuous_on (f.extend I).symm (f.extend I).target :=
+λ y hy, (continuous_at_extend_symm' _ _ hy).continuous_within_at
+
+lemma extend_symm_continuous_within_at_comp_right_iff {X} [topological_space X] {g : M → X}
+  {s : set M} {x : M} :
+  continuous_within_at (g ∘ (f.extend I).symm) ((f.extend I).symm ⁻¹' s ∩ range I) (f.extend I x) ↔
+  continuous_within_at (g ∘ f.symm) (f.symm ⁻¹' s) (f x) :=
+by convert I.symm_continuous_within_at_comp_right_iff; refl
+
+lemma is_open_extend_preimage' {s : set E} (hs : is_open s) :
+  is_open ((f.extend I).source ∩ f.extend I ⁻¹' s) :=
+(continuous_on_extend f I).preimage_open_of_open (is_open_extend_source _ _) hs
+
+lemma is_open_extend_preimage {s : set E} (hs : is_open s) :
+  is_open (f.source ∩ f.extend I ⁻¹' s) :=
+by { rw ← extend_source f I, exact is_open_extend_preimage' f I hs }
+
+lemma map_extend_nhds_within_eq_image {y : M} (hy : y ∈ f.source) :
+  map (f.extend I) (𝓝[s] y) =
+    𝓝[f.extend I '' ((f.extend I).source ∩ s)] (f.extend I y) :=
+by set e := f.extend I;
+calc map e (𝓝[s] y) = map e (𝓝[e.source ∩ s] y) :
+  congr_arg (map e) (nhds_within_inter_of_mem (extend_source_mem_nhds_within f I hy)).symm
+... = 𝓝[e '' (e.source ∩ s)] (e y) :
+  ((f.extend I).left_inv_on.mono $ inter_subset_left _ _).map_nhds_within_eq
+    ((f.extend I).left_inv $ by rwa f.extend_source)
+    (continuous_at_extend_symm f I hy).continuous_within_at
+    (continuous_at_extend f I hy).continuous_within_at
+
+lemma map_extend_nhds_within {y : M} (hy : y ∈ f.source) :
+  map (f.extend I) (𝓝[s] y) =
+    𝓝[(f.extend I).symm ⁻¹' s ∩ range I] (f.extend I y) :=
+by rw [map_extend_nhds_within_eq_image f I hy, nhds_within_inter,
+  ← nhds_within_extend_target_eq _ _ hy, ← nhds_within_inter,
+  (f.extend I).image_source_inter_eq', inter_comm]
+
+lemma map_extend_symm_nhds_within {y : M} (hy : y ∈ f.source) :
+  map (f.extend I).symm
+    (𝓝[(f.extend I).symm ⁻¹' s ∩ range I] (f.extend I y)) = 𝓝[s] y :=
+begin
+  rw [← map_extend_nhds_within f I hy, map_map, map_congr, map_id],
+  exact (f.extend I).left_inv_on.eq_on.eventually_eq_of_mem
+    (extend_source_mem_nhds_within _ _ hy)
+end
+
+lemma map_extend_symm_nhds_within_range {y : M} (hy : y ∈ f.source) :
+  map (f.extend I).symm (𝓝[range I] (f.extend I y)) = 𝓝 y :=
+by rw [← nhds_within_univ, ← map_extend_symm_nhds_within f I hy, preimage_univ, univ_inter]
+
+/-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of a point
+in the source is a neighborhood of the preimage, within a set. -/
+lemma extend_preimage_mem_nhds_within {x : M} (h : x ∈ f.source)
+  (ht : t ∈ 𝓝[s] x) :
+  (f.extend I).symm ⁻¹' t ∈
+    𝓝[(f.extend I).symm ⁻¹' s ∩ range I] (f.extend I x) :=
+by rwa [← map_extend_symm_nhds_within f I h, mem_map] at ht
+
+lemma extend_preimage_mem_nhds {x : M} (h : x ∈ f.source) (ht : t ∈ 𝓝 x) :
+  (f.extend I).symm ⁻¹' t ∈ 𝓝 (f.extend I x) :=
+begin
+  apply (continuous_at_extend_symm f I h).preimage_mem_nhds,
+  rwa (f.extend I).left_inv,
+  rwa f.extend_source
+end
+
+/-- Technical lemma to rewrite suitably the preimage of an intersection under an extended chart, to
+bring it into a convenient form to apply derivative lemmas. -/
+lemma extend_preimage_inter_eq :
+  ((f.extend I).symm ⁻¹' (s ∩ t) ∩ range I)
+  = ((f.extend I).symm ⁻¹' s ∩ range I) ∩ ((f.extend I).symm ⁻¹' t) :=
+by mfld_set_tac
+
+lemma extend_symm_preimage_inter_range_eventually_eq_aux {s : set M} {x : M} (hx : x ∈ f.source) :
+  ((f.extend I).symm ⁻¹' s ∩ range I : set _) =ᶠ[𝓝 (f.extend I x)]
+  ((f.extend I).target ∩ (f.extend I).symm ⁻¹' s : set _) :=
+begin
+  rw [f.extend_target, inter_assoc, inter_comm (range I)],
+  conv { congr, skip, rw [← @univ_inter _ (_ ∩ _)] },
+  refine (eventually_eq_univ.mpr _).symm.inter eventually_eq.rfl,
+  refine I.continuous_at_symm.preimage_mem_nhds (f.open_target.mem_nhds _),
+  simp_rw [f.extend_coe, function.comp_apply, I.left_inv, f.maps_to hx]
+end
+
+lemma extend_symm_preimage_inter_range_eventually_eq {s : set M} {x : M}
+  (hs : s ⊆ f.source) (hx : x ∈ f.source) :
+  ((f.extend I).symm ⁻¹' s ∩ range I : set _) =ᶠ[𝓝 (f.extend I x)] f.extend I '' s :=
+begin
+  rw [← f.extend_source I] at hs,
+  rw [(f.extend I).image_eq_target_inter_inv_preimage hs],
+  exact f.extend_symm_preimage_inter_range_eventually_eq_aux I hx
+end
+
+/-! We use the name `extend_coord_change` for `(f'.extend I).symm ≫ f.extend I`. -/
+
+lemma extend_coord_change_source :
+  ((f.extend I).symm ≫ f'.extend I).source =
+  I '' (f.symm ≫ₕ f').source :=
+by { simp_rw [local_equiv.trans_source, I.image_eq, extend_source, local_equiv.symm_source,
+      extend_target, inter_right_comm _ (range I)], refl }
+
+lemma extend_image_source_inter :
+  f.extend I '' (f.source ∩ f'.source) = ((f.extend I).symm ≫ f'.extend I).source :=
+by simp_rw [f.extend_coord_change_source, f.extend_coe, image_comp I f, trans_source'', symm_symm,
+  symm_target]
+
+lemma extend_coord_change_source_mem_nhds_within {x : E}
+  (hx : x ∈ ((f.extend I).symm ≫ f'.extend I).source) :
+  ((f.extend I).symm ≫ f'.extend I).source ∈ 𝓝[range I] x :=
+begin
+  rw [f.extend_coord_change_source] at hx ⊢,
+  obtain ⟨x, hx, rfl⟩ := hx,
+  refine I.image_mem_nhds_within _,
+  refine (local_homeomorph.open_source _).mem_nhds hx
+end
+
+lemma extend_coord_change_source_mem_nhds_within' {x : M}
+  (hxf : x ∈ f.source) (hxf' : x ∈ f'.source) :
+  ((f.extend I).symm ≫ f'.extend I).source ∈ 𝓝[range I] f.extend I x :=
+begin
+  apply extend_coord_change_source_mem_nhds_within,
+  rw [← extend_image_source_inter],
+  exact mem_image_of_mem _ ⟨hxf, hxf'⟩,
+end
+
+variables {f f'}
+open smooth_manifold_with_corners
+
+lemma cont_diff_on_extend_coord_change [charted_space H M]
+  (hf : f ∈ maximal_atlas I M) (hf' : f' ∈ maximal_atlas I M) :
+  cont_diff_on 𝕜 ⊤ (f.extend I ∘ (f'.extend I).symm)
+  ((f'.extend I).symm ≫ f.extend I).source :=
+begin
+  rw [extend_coord_change_source, I.image_eq],
+  exact (structure_groupoid.compatible_of_mem_maximal_atlas hf' hf).1
+end
+
+lemma cont_diff_within_at_extend_coord_change [charted_space H M]
+  (hf : f ∈ maximal_atlas I M) (hf' : f' ∈ maximal_atlas I M) {x : E}
+  (hx : x ∈ ((f'.extend I).symm ≫ f.extend I).source) :
+  cont_diff_within_at 𝕜 ⊤ (f.extend I ∘ (f'.extend I).symm) (range I) x :=
+begin
+  apply (cont_diff_on_extend_coord_change I hf hf' x hx).mono_of_mem,
+  rw [extend_coord_change_source] at hx ⊢,
+  obtain ⟨z, hz, rfl⟩ := hx,
+  exact I.image_mem_nhds_within ((local_homeomorph.open_source _).mem_nhds hz)
+end
+
+lemma cont_diff_within_at_extend_coord_change' [charted_space H M]
+  (hf : f ∈ maximal_atlas I M) (hf' : f' ∈ maximal_atlas I M) {x : M}
+  (hxf : x ∈ f.source) (hxf' : x ∈ f'.source) :
+  cont_diff_within_at 𝕜 ⊤ (f.extend I ∘ (f'.extend I).symm) (range I) (f'.extend I x) :=
+begin
+  refine cont_diff_within_at_extend_coord_change I hf hf' _,
+  rw [← extend_image_source_inter],
+  exact mem_image_of_mem _ ⟨hxf', hxf⟩
+end
+
+end local_homeomorph
+open local_homeomorph
+
+variables [charted_space H M] [charted_space H' M']
+
 /-- The preferred extended chart on a manifold with corners around a point `x`, from a neighborhood
 of `x` to the model vector space. -/
 @[simp, mfld_simps] def ext_chart_at (x : M) : local_equiv M E :=
-(chart_at H x).to_local_equiv.trans I.to_local_equiv
+(chart_at H x).extend I
 
 lemma ext_chart_at_coe : ⇑(ext_chart_at I x) = I ∘ chart_at H x := rfl
 
@@ -683,21 +974,28 @@ lemma ext_chart_at_coe_symm :
   ⇑(ext_chart_at I x).symm = (chart_at H x).symm ∘ I.symm := rfl
 
 lemma ext_chart_at_source : (ext_chart_at I x).source = (chart_at H x).source :=
-by rw [ext_chart_at, local_equiv.trans_source, I.source_eq, preimage_univ, inter_univ]
+extend_source _ _
 
-lemma ext_chart_at_open_source : is_open (ext_chart_at I x).source :=
-by { rw ext_chart_at_source, exact (chart_at H x).open_source }
+lemma is_open_ext_chart_at_source : is_open (ext_chart_at I x).source :=
+is_open_extend_source _ _
 
 lemma mem_ext_chart_source : x ∈ (ext_chart_at I x).source :=
 by simp only [ext_chart_at_source, mem_chart_source]
 
-lemma ext_chart_at_to_inv :
-  (ext_chart_at I x).symm ((ext_chart_at I x) x) = x :=
+lemma ext_chart_at_target (x : M) : (ext_chart_at I x).target =
+  I.symm ⁻¹' (chart_at H x).target ∩ range I :=
+extend_target _ _
+
+lemma ext_chart_at_to_inv : (ext_chart_at I x).symm ((ext_chart_at I x) x) = x :=
 (ext_chart_at I x).left_inv (mem_ext_chart_source I x)
 
+lemma maps_to_ext_chart_at (hs : s ⊆ (chart_at H x).source) :
+  maps_to (ext_chart_at I x) s ((ext_chart_at I x).symm ⁻¹' s ∩ range I) :=
+maps_to_extend _ _ hs
+
 lemma ext_chart_at_source_mem_nhds' {x' : M} (h : x' ∈ (ext_chart_at I x).source) :
   (ext_chart_at I x).source ∈ 𝓝 x' :=
-is_open.mem_nhds (ext_chart_at_open_source I x) h
+extend_source_mem_nhds _ _ $ by rwa ← ext_chart_at_source I
 
 lemma ext_chart_at_source_mem_nhds : (ext_chart_at I x).source ∈ 𝓝 x :=
 ext_chart_at_source_mem_nhds' I x (mem_ext_chart_source I x)
@@ -710,43 +1008,28 @@ lemma ext_chart_at_source_mem_nhds_within :
   (ext_chart_at I x).source ∈ 𝓝[s] x :=
 mem_nhds_within_of_mem_nhds (ext_chart_at_source_mem_nhds I x)
 
-lemma ext_chart_at_continuous_on :
+lemma continuous_on_ext_chart_at :
   continuous_on (ext_chart_at I x) (ext_chart_at I x).source :=
-begin
-  refine I.continuous.comp_continuous_on _,
-  rw ext_chart_at_source,
-  exact (chart_at H x).continuous_on
-end
+continuous_on_extend _ _
 
-lemma ext_chart_at_continuous_at' {x' : M} (h : x' ∈ (ext_chart_at I x).source) :
+lemma continuous_at_ext_chart_at' {x' : M} (h : x' ∈ (ext_chart_at I x).source) :
   continuous_at (ext_chart_at I x) x' :=
-(ext_chart_at_continuous_on I x).continuous_at $ ext_chart_at_source_mem_nhds' I x h
+continuous_at_extend _ _ $ by rwa ← ext_chart_at_source I
 
-lemma ext_chart_at_continuous_at : continuous_at (ext_chart_at I x) x :=
-ext_chart_at_continuous_at' _ _ (mem_ext_chart_source I x)
+lemma continuous_at_ext_chart_at : continuous_at (ext_chart_at I x) x :=
+continuous_at_ext_chart_at' _ _ (mem_ext_chart_source I x)
 
-lemma ext_chart_at_continuous_on_symm :
-  continuous_on (ext_chart_at I x).symm (ext_chart_at I x).target :=
-(chart_at H x).continuous_on_symm.comp I.continuous_on_symm $
-  (maps_to_preimage _ _).mono_left (inter_subset_right _ _)
-
-lemma ext_chart_at_map_nhds' {x y : M} (hy : y ∈ (ext_chart_at I x).source) :
+lemma map_ext_chart_at_nhds' {x y : M} (hy : y ∈ (ext_chart_at I x).source) :
   map (ext_chart_at I x) (𝓝 y) = 𝓝[range I] (ext_chart_at I x y) :=
-begin
-  rw [ext_chart_at_coe, (∘), ← I.map_nhds_eq, ← (chart_at H x).map_nhds_eq, map_map],
-  rwa ext_chart_at_source at hy
-end
+map_extend_nhds _ _ $ by rwa ← ext_chart_at_source I
 
-lemma ext_chart_at_map_nhds :
+lemma map_ext_chart_at_nhds :
   map (ext_chart_at I x) (𝓝 x) = 𝓝[range I] (ext_chart_at I x x) :=
-ext_chart_at_map_nhds' I $ mem_ext_chart_source I x
+map_ext_chart_at_nhds' I $ mem_ext_chart_source I x
 
 lemma ext_chart_at_target_mem_nhds_within' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
   (ext_chart_at I x).target ∈ 𝓝[range I] (ext_chart_at I x y) :=
-begin
-  rw [← local_equiv.image_source_eq_target, ← ext_chart_at_map_nhds' I hy],
-  exact image_mem_map (ext_chart_at_source_mem_nhds' _ _ hy)
-end
+extend_target_mem_nhds_within _ _ $ by rwa ← ext_chart_at_source I
 
 lemma ext_chart_at_target_mem_nhds_within :
   (ext_chart_at I x).target ∈ 𝓝[range I] (ext_chart_at I x x) :=
@@ -755,128 +1038,155 @@ ext_chart_at_target_mem_nhds_within' I x (mem_ext_chart_source I x)
 lemma ext_chart_at_target_subset_range : (ext_chart_at I x).target ⊆ range I :=
 by simp only with mfld_simps
 
-lemma nhds_within_ext_chart_target_eq' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
+lemma nhds_within_ext_chart_at_target_eq' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
   𝓝[(ext_chart_at I x).target] (ext_chart_at I x y) =
   𝓝[range I] (ext_chart_at I x y) :=
-(nhds_within_mono _ (ext_chart_at_target_subset_range _ _)).antisymm $
-  nhds_within_le_of_mem (ext_chart_at_target_mem_nhds_within' _ _ hy)
+nhds_within_extend_target_eq _ _ $ by rwa ← ext_chart_at_source I
 
-lemma nhds_within_ext_chart_target_eq :
+lemma nhds_within_ext_chart_at_target_eq :
   𝓝[(ext_chart_at I x).target] ((ext_chart_at I x) x) =
   𝓝[range I] ((ext_chart_at I x) x) :=
-nhds_within_ext_chart_target_eq' I x (mem_ext_chart_source I x)
+nhds_within_ext_chart_at_target_eq' I x (mem_ext_chart_source I x)
 
-lemma ext_chart_continuous_at_symm'' {y : E} (h : y ∈ (ext_chart_at I x).target) :
+lemma continuous_at_ext_chart_at_symm'' {y : E} (h : y ∈ (ext_chart_at I x).target) :
   continuous_at (ext_chart_at I x).symm y :=
-continuous_at.comp ((chart_at H x).continuous_at_symm h.2) (I.continuous_symm.continuous_at)
+continuous_at_extend_symm' _ _ h
 
-lemma ext_chart_continuous_at_symm' {x' : M} (h : x' ∈ (ext_chart_at I x).source) :
+lemma continuous_at_ext_chart_at_symm' {x' : M} (h : x' ∈ (ext_chart_at I x).source) :
   continuous_at (ext_chart_at I x).symm (ext_chart_at I x x') :=
-ext_chart_continuous_at_symm'' I _ $ (ext_chart_at I x).map_source h
+continuous_at_ext_chart_at_symm'' I _ $ (ext_chart_at I x).map_source h
 
-lemma ext_chart_continuous_at_symm :
+lemma continuous_at_ext_chart_at_symm :
   continuous_at (ext_chart_at I x).symm ((ext_chart_at I x) x) :=
-ext_chart_continuous_at_symm' I x (mem_ext_chart_source I x)
+continuous_at_ext_chart_at_symm' I x (mem_ext_chart_source I x)
 
-lemma ext_chart_continuous_on_symm :
+lemma continuous_on_ext_chart_at_symm :
   continuous_on (ext_chart_at I x).symm (ext_chart_at I x).target :=
-λ y hy, (ext_chart_continuous_at_symm'' _ _ hy).continuous_within_at
+λ y hy, (continuous_at_ext_chart_at_symm'' _ _ hy).continuous_within_at
 
-lemma ext_chart_preimage_open_of_open' {s : set E} (hs : is_open s) :
+lemma is_open_ext_chart_at_preimage' {s : set E} (hs : is_open s) :
   is_open ((ext_chart_at I x).source ∩ ext_chart_at I x ⁻¹' s) :=
-(ext_chart_at_continuous_on I x).preimage_open_of_open (ext_chart_at_open_source _ _) hs
+is_open_extend_preimage' _ _ hs
 
-lemma ext_chart_preimage_open_of_open {s : set E} (hs : is_open s) :
+lemma is_open_ext_chart_at_preimage {s : set E} (hs : is_open s) :
   is_open ((chart_at H x).source ∩ ext_chart_at I x ⁻¹' s) :=
-by { rw ← ext_chart_at_source I, exact ext_chart_preimage_open_of_open' I x hs }
+by { rw ← ext_chart_at_source I, exact is_open_ext_chart_at_preimage' I x hs }
 
-lemma ext_chart_at_map_nhds_within_eq_image' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
+lemma map_ext_chart_at_nhds_within_eq_image' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
   map (ext_chart_at I x) (𝓝[s] y) =
     𝓝[ext_chart_at I x '' ((ext_chart_at I x).source ∩ s)] (ext_chart_at I x y) :=
-by set e := ext_chart_at I x;
-calc map e (𝓝[s] y) = map e (𝓝[e.source ∩ s] y) :
-  congr_arg (map e) (nhds_within_inter_of_mem (ext_chart_at_source_mem_nhds_within' I x hy)).symm
-... = 𝓝[e '' (e.source ∩ s)] (e y) :
-  ((ext_chart_at I x).left_inv_on.mono $ inter_subset_left _ _).map_nhds_within_eq
-    ((ext_chart_at I x).left_inv hy)
-    (ext_chart_continuous_at_symm' I x hy).continuous_within_at
-    (ext_chart_at_continuous_at' I x hy).continuous_within_at
+map_extend_nhds_within_eq_image _ _ $ by rwa ← ext_chart_at_source I
 
-lemma ext_chart_at_map_nhds_within_eq_image :
+lemma map_ext_chart_at_nhds_within_eq_image :
   map (ext_chart_at I x) (𝓝[s] x) =
     𝓝[ext_chart_at I x '' ((ext_chart_at I x).source ∩ s)] (ext_chart_at I x x) :=
-ext_chart_at_map_nhds_within_eq_image' I x (mem_ext_chart_source I x)
+map_ext_chart_at_nhds_within_eq_image' I x (mem_ext_chart_source I x)
 
-lemma ext_chart_at_map_nhds_within' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
+lemma map_ext_chart_at_nhds_within' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
   map (ext_chart_at I x) (𝓝[s] y) =
     𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] (ext_chart_at I x y) :=
-by rw [ext_chart_at_map_nhds_within_eq_image' I x hy, nhds_within_inter,
-  ← nhds_within_ext_chart_target_eq' _ _ hy, ← nhds_within_inter,
-  (ext_chart_at I x).image_source_inter_eq', inter_comm]
+map_extend_nhds_within _ _ $ by rwa ← ext_chart_at_source I
 
-lemma ext_chart_at_map_nhds_within :
+lemma map_ext_chart_at_nhds_within :
   map (ext_chart_at I x) (𝓝[s] x) =
     𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] (ext_chart_at I x x) :=
-ext_chart_at_map_nhds_within' I x (mem_ext_chart_source I x)
+map_ext_chart_at_nhds_within' I x (mem_ext_chart_source I x)
 
-lemma ext_chart_at_symm_map_nhds_within' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
+lemma map_ext_chart_at_symm_nhds_within' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
   map (ext_chart_at I x).symm
     (𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] (ext_chart_at I x y)) = 𝓝[s] y :=
-begin
-  rw [← ext_chart_at_map_nhds_within' I x hy, map_map, map_congr, map_id],
-  exact (ext_chart_at I x).left_inv_on.eq_on.eventually_eq_of_mem
-    (ext_chart_at_source_mem_nhds_within' _ _ hy)
-end
+map_extend_symm_nhds_within _ _ $ by rwa ← ext_chart_at_source I
 
-lemma ext_chart_at_symm_map_nhds_within_range' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
+lemma map_ext_chart_at_symm_nhds_within_range' {y : M} (hy : y ∈ (ext_chart_at I x).source) :
   map (ext_chart_at I x).symm (𝓝[range I] (ext_chart_at I x y)) = 𝓝 y :=
-by rw [← nhds_within_univ, ← ext_chart_at_symm_map_nhds_within' I x hy, preimage_univ, univ_inter]
+map_extend_symm_nhds_within_range _ _ $ by rwa ← ext_chart_at_source I
 
-lemma ext_chart_at_symm_map_nhds_within :
+lemma map_ext_chart_at_symm_nhds_within :
   map (ext_chart_at I x).symm
     (𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] (ext_chart_at I x x)) = 𝓝[s] x :=
-ext_chart_at_symm_map_nhds_within' I x (mem_ext_chart_source I x)
+map_ext_chart_at_symm_nhds_within' I x (mem_ext_chart_source I x)
 
-lemma ext_chart_at_symm_map_nhds_within_range :
+lemma map_ext_chart_at_symm_nhds_within_range :
   map (ext_chart_at I x).symm (𝓝[range I] (ext_chart_at I x x)) = 𝓝 x :=
-ext_chart_at_symm_map_nhds_within_range' I x (mem_ext_chart_source I x)
+map_ext_chart_at_symm_nhds_within_range' I x (mem_ext_chart_source I x)
 
 /-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of a point
 in the source is a neighborhood of the preimage, within a set. -/
-lemma ext_chart_preimage_mem_nhds_within' {x' : M} (h : x' ∈ (ext_chart_at I x).source)
+lemma ext_chart_at_preimage_mem_nhds_within' {x' : M} (h : x' ∈ (ext_chart_at I x).source)
   (ht : t ∈ 𝓝[s] x') :
   (ext_chart_at I x).symm ⁻¹' t ∈
     𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] ((ext_chart_at I x) x') :=
-by rwa [← ext_chart_at_symm_map_nhds_within' I x h, mem_map] at ht
+by rwa [← map_ext_chart_at_symm_nhds_within' I x h, mem_map] at ht
 
 /-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of the
 base point is a neighborhood of the preimage, within a set. -/
-lemma ext_chart_preimage_mem_nhds_within (ht : t ∈ 𝓝[s] x) :
+lemma ext_chart_at_preimage_mem_nhds_within (ht : t ∈ 𝓝[s] x) :
   (ext_chart_at I x).symm ⁻¹' t ∈
     𝓝[(ext_chart_at I x).symm ⁻¹' s ∩ range I] ((ext_chart_at I x) x) :=
-ext_chart_preimage_mem_nhds_within' I x (mem_ext_chart_source I x) ht
+ext_chart_at_preimage_mem_nhds_within' I x (mem_ext_chart_source I x) ht
+
+lemma ext_chart_at_preimage_mem_nhds' {x' : M}
+  (h : x' ∈ (ext_chart_at I x).source) (ht : t ∈ 𝓝 x') :
+  (ext_chart_at I x).symm ⁻¹' t ∈ 𝓝 (ext_chart_at I x x') :=
+extend_preimage_mem_nhds _ _ (by rwa ← ext_chart_at_source I) ht
 
 /-- Technical lemma ensuring that the preimage under an extended chart of a neighborhood of a point
 is a neighborhood of the preimage. -/
-lemma ext_chart_preimage_mem_nhds (ht : t ∈ 𝓝 x) :
+lemma ext_chart_at_preimage_mem_nhds (ht : t ∈ 𝓝 x) :
   (ext_chart_at I x).symm ⁻¹' t ∈ 𝓝 ((ext_chart_at I x) x) :=
 begin
-  apply (ext_chart_continuous_at_symm I x).preimage_mem_nhds,
+  apply (continuous_at_ext_chart_at_symm I x).preimage_mem_nhds,
   rwa (ext_chart_at I x).left_inv (mem_ext_chart_source _ _)
 end
 
 /-- Technical lemma to rewrite suitably the preimage of an intersection under an extended chart, to
 bring it into a convenient form to apply derivative lemmas. -/
-lemma ext_chart_preimage_inter_eq :
+lemma ext_chart_at_preimage_inter_eq :
   ((ext_chart_at I x).symm ⁻¹' (s ∩ t) ∩ range I)
   = ((ext_chart_at I x).symm ⁻¹' s ∩ range I) ∩ ((ext_chart_at I x).symm ⁻¹' t) :=
 by mfld_set_tac
 
-end extended_charts
+/-! We use the name `ext_coord_change` for `(ext_chart_at I x').symm ≫ ext_chart_at I x`. -/
+
+lemma ext_coord_change_source (x x' : M) :
+  ((ext_chart_at I x').symm ≫ ext_chart_at I x).source =
+  I '' ((chart_at H x').symm ≫ₕ (chart_at H x)).source :=
+extend_coord_change_source _ _ _
+
+open smooth_manifold_with_corners
+
+lemma cont_diff_on_ext_coord_change [smooth_manifold_with_corners I M] (x x' : M) :
+  cont_diff_on 𝕜 ⊤ (ext_chart_at I x ∘ (ext_chart_at I x').symm)
+  ((ext_chart_at I x').symm ≫ ext_chart_at I x).source :=
+cont_diff_on_extend_coord_change I (chart_mem_maximal_atlas I x) (chart_mem_maximal_atlas I x')
+
+lemma cont_diff_within_at_ext_coord_change [smooth_manifold_with_corners I M] (x x' : M) {y : E}
+  (hy : y ∈ ((ext_chart_at I x').symm ≫ ext_chart_at I x).source) :
+  cont_diff_within_at 𝕜 ⊤ (ext_chart_at I x ∘ (ext_chart_at I x').symm) (range I) y :=
+cont_diff_within_at_extend_coord_change I
+  (chart_mem_maximal_atlas I x) (chart_mem_maximal_atlas I x') hy
+
+/-- Conjugating a function to write it in the preferred charts around `x`.
+The manifold derivative of `f` will just be the derivative of this conjugated function. -/
+@[simp, mfld_simps] def written_in_ext_chart_at (x : M) (f : M → M') : E → E' :=
+ext_chart_at I' (f x) ∘ f ∘ (ext_chart_at I x).symm
+
+variable (𝕜)
+
+lemma ext_chart_at_self_eq {x : H} : ⇑(ext_chart_at I x) = I := rfl
+lemma ext_chart_at_self_apply {x y : H} : ext_chart_at I x y = I y := rfl
 
 /-- In the case of the manifold structure on a vector space, the extended charts are just the
 identity.-/
-lemma ext_chart_model_space_eq_id (𝕜 : Type*) [nondiscrete_normed_field 𝕜]
-  {E : Type*} [normed_group E] [normed_space 𝕜 E] (x : E) :
-  ext_chart_at (model_with_corners_self 𝕜 E) x = local_equiv.refl E :=
+lemma ext_chart_at_model_space_eq_id (x : E) : ext_chart_at 𝓘(𝕜, E) x = local_equiv.refl E :=
 by simp only with mfld_simps
+
+lemma ext_chart_model_space_apply {x y : E} : ext_chart_at 𝓘(𝕜, E) x y = y := rfl
+
+variable {𝕜}
+
+lemma ext_chart_at_prod (x : M × M') :
+  ext_chart_at (I.prod I') x = (ext_chart_at I x.1).prod (ext_chart_at I' x.2) :=
+by simp only with mfld_simps
+
+end extended_charts
diff --git a/src/geometry/manifold/tangent_bundle.lean b/src/geometry/manifold/tangent_bundle.lean
deleted file mode 100644
index db791abf647c9..0000000000000
--- a/src/geometry/manifold/tangent_bundle.lean
+++ /dev/null
@@ -1,610 +0,0 @@
-/-
-Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
--/
-import topology.vector_bundle
-import geometry.manifold.smooth_manifold_with_corners
-import data.set.prod
-
-/-!
-# Basic smooth bundles
-
-In general, a smooth bundle is a bundle over a smooth manifold, whose fiber is a manifold, and
-for which the coordinate changes are smooth. In this definition, there are charts involved at
-several places: in the manifold structure of the base, in the manifold structure of the fibers, and
-in the local trivializations. This makes it a complicated object in general. There is however a
-specific situation where things are much simpler: when the fiber is a vector space (no need for
-charts for the fibers), and when the local trivializations of the bundle and the charts of the base
-coincide. Then everything is expressed in terms of the charts of the base, making for a much
-simpler overall structure, which is easier to manipulate formally.
-
-Most vector bundles that naturally occur in differential geometry are of this form:
-the tangent bundle, the cotangent bundle, differential forms (used to define de Rham cohomology)
-and the bundle of Riemannian metrics. Therefore, it is worth defining a specific constructor for
-this kind of bundle, that we call basic smooth bundles.
-
-A basic smooth bundle is thus a smooth bundle over a smooth manifold whose fiber is a vector space,
-and which is trivial in the coordinate charts of the base. (We recall that in our notion of manifold
-there is a distinguished atlas, which does not need to be maximal: we require the triviality above
-this specific atlas). It can be constructed from a basic smooth bundled core, defined below,
-specifying the changes in the fiber when one goes from one coordinate chart to another one.
-
-## Main definitions
-
-* `basic_smooth_vector_bundle_core I M F`: assuming that `M` is a smooth manifold over the model
-  with corners `I` on `(𝕜, E, H)`, and `F` is a normed vector space over `𝕜`, this structure
-  registers, for each pair of charts of `M`, a linear change of coordinates on `F` depending
-  smoothly on the base point. This is the core structure from which one will build a smooth vector
-  bundle with fiber `F` over `M`.
-
-Let `Z` be a basic smooth bundle core over `M` with fiber `F`. We define
-`Z.to_topological_vector_bundle_core`, the (topological) vector bundle core associated to `Z`. From
-it, we get a space `Z.to_topological_vector_bundle_core.total_space` (which as a Type is just
-`Σ (x : M), F`), with the fiber bundle topology. It inherits a manifold structure (where the
-charts are in bijection with the charts of the basis). We show that this manifold is smooth.
-
-Then we use this machinery to construct the tangent bundle of a smooth manifold.
-
-* `tangent_bundle_core I M`: the basic smooth bundle core associated to a smooth manifold `M` over
-  a model with corners `I`.
-* `tangent_bundle I M`     : the total space of `tangent_bundle_core I M`. It is itself a
-  smooth manifold over the model with corners `I.tangent`, the product of `I` and the trivial model
-  with corners on `E`.
-* `tangent_space I x`      : the tangent space to `M` at `x`
-* `tangent_bundle.proj I M`: the projection from the tangent bundle to the base manifold
-
-## Implementation notes
-
-We register the vector space structure on the fibers of the tangent bundle, but we do not register
-the normed space structure coming from that of `F` (as it is not canonical, and we also want to
-keep the possibility to add a Riemannian structure on the manifold later on without having two
-competing normed space instances on the tangent spaces).
-
-We require `F` to be a normed space, and not just a topological vector space, as we want to talk
-about smooth functions on `F`. The notion of derivative requires a norm to be defined.
-
-## TODO
-construct the cotangent bundle, and the bundles of differential forms. They should follow
-functorially from the description of the tangent bundle as a basic smooth bundle.
-
-## Tags
-Smooth fiber bundle, vector bundle, tangent space, tangent bundle
--/
-noncomputable theory
-
-universe u
-
-open topological_space set
-open_locale manifold topological_space
-
-/-- Core structure used to create a smooth bundle above `M` (a manifold over the model with
-corner `I`) with fiber the normed vector space `F` over `𝕜`, which is trivial in the chart domains
-of `M`. This structure registers the changes in the fibers when one changes coordinate charts in the
-base. We require the change of coordinates of the fibers to be linear, so that the resulting bundle
-is a vector bundle. -/
-structure basic_smooth_vector_bundle_core {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
-(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-(F : Type*) [normed_group F] [normed_space 𝕜 F] :=
-(coord_change      : atlas H M → atlas H M → H → (F →L[𝕜] F))
-(coord_change_self : ∀ i : atlas H M, ∀ x ∈ i.1.target, ∀ v, coord_change i i x v = v)
-(coord_change_comp : ∀ i j k : atlas H M,
-  ∀ x ∈ ((i.1.symm.trans j.1).trans (j.1.symm.trans k.1)).source, ∀ v,
-  (coord_change j k ((i.1.symm.trans j.1) x)) (coord_change i j x v) = coord_change i k x v)
-(coord_change_smooth_clm : ∀ i j : atlas H M,
-  cont_diff_on 𝕜 ∞ ((coord_change i j) ∘ I.symm) (I '' (i.1.symm.trans j.1).source))
-
-/-- The trivial basic smooth bundle core, in which all the changes of coordinates are the
-identity. -/
-def trivial_basic_smooth_vector_bundle_core {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
-(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-(F : Type*) [normed_group F] [normed_space 𝕜 F] : basic_smooth_vector_bundle_core I M F :=
-{ coord_change := λ i j x, continuous_linear_map.id 𝕜 F,
-  coord_change_self := λ i x hx v, rfl,
-  coord_change_comp := λ i j k x hx v, rfl,
-  coord_change_smooth_clm := λ i j, by { dsimp, exact cont_diff_on_const } }
-
-namespace basic_smooth_vector_bundle_core
-
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
-{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-{F : Type*} [normed_group F] [normed_space 𝕜 F]
-(Z : basic_smooth_vector_bundle_core I M F)
-
-instance : inhabited (basic_smooth_vector_bundle_core I M F) :=
-⟨trivial_basic_smooth_vector_bundle_core I M F⟩
-
-lemma coord_change_continuous (i j : atlas H M) :
-  continuous_on (Z.coord_change i j) (i.1.symm.trans j.1).source :=
-begin
-  assume x hx,
-  apply (((Z.coord_change_smooth_clm i j).continuous_on.continuous_within_at
-    (mem_image_of_mem I hx)).comp I.continuous_within_at _).congr,
-  { assume y hy,
-    simp only with mfld_simps },
-  { simp only with mfld_simps },
-  { exact maps_to_image I _ },
-end
-
-lemma coord_change_smooth (i j : atlas H M) :
-  cont_diff_on 𝕜 ∞ (λ p : E × F, Z.coord_change i j (I.symm p.1) p.2)
-    ((I '' (i.1.symm.trans j.1).source) ×ˢ (univ : set F)) :=
-begin
-  have A : cont_diff 𝕜 ∞ (λ p : (F →L[𝕜] F) × F, p.1 p.2),
-  { apply is_bounded_bilinear_map.cont_diff,
-    exact is_bounded_bilinear_map_apply },
-  have B : cont_diff_on 𝕜 ∞ (λ (p : E × F), (Z.coord_change i j (I.symm p.1), p.snd))
-    ((I '' (i.1.symm.trans j.1).source) ×ˢ (univ : set F)),
-  { apply cont_diff_on.prod _ _,
-    { exact (Z.coord_change_smooth_clm i j).comp cont_diff_fst.cont_diff_on
-       (prod_subset_preimage_fst _ _) },
-    { exact is_bounded_linear_map.snd.cont_diff.cont_diff_on } },
-  exact A.comp_cont_diff_on B,
-end
-
-/-- Vector bundle core associated to a basic smooth bundle core -/
-def to_topological_vector_bundle_core : topological_vector_bundle_core 𝕜 M F (atlas H M) :=
-{ base_set := λ i, i.1.source,
-  is_open_base_set := λ i, i.1.open_source,
-  index_at := λ x, ⟨chart_at H x, chart_mem_atlas H x⟩,
-  mem_base_set_at := λ x, mem_chart_source H x,
-  coord_change := λ i j x, Z.coord_change i j (i.1 x),
-  coord_change_self := λ i x hx v, Z.coord_change_self i (i.1 x) (i.1.map_source hx) v,
-  coord_change_comp := λ i j k x ⟨⟨hx1, hx2⟩, hx3⟩ v, begin
-    have := Z.coord_change_comp i j k (i.1 x) _ v,
-    convert this using 2,
-    { simp only [hx1] with mfld_simps },
-    { simp only [hx1, hx2, hx3] with mfld_simps }
-  end,
-  coord_change_continuous := λ i j, begin
-    refine ((Z.coord_change_continuous i j).comp' i.1.continuous_on).mono _,
-    rintros p ⟨hp₁, hp₂⟩,
-    refine ⟨hp₁, i.1.maps_to hp₁, _⟩,
-    simp only [i.1.left_inv hp₁, hp₂] with mfld_simps
-  end }
-
-@[simp, mfld_simps] lemma base_set (i : atlas H M) :
-  (Z.to_topological_vector_bundle_core.local_triv i).base_set = i.1.source := rfl
-
-@[simp, mfld_simps] lemma target (i : atlas H M) :
-  (Z.to_topological_vector_bundle_core.local_triv i).target = i.1.source ×ˢ (univ : set F) := rfl
-
-/-- Local chart for the total space of a basic smooth bundle -/
-def chart {e : local_homeomorph M H} (he : e ∈ atlas H M) :
-  local_homeomorph (Z.to_topological_vector_bundle_core.total_space) (model_prod H F) :=
-(Z.to_topological_vector_bundle_core.local_triv ⟨e, he⟩).to_local_homeomorph.trans
-  (local_homeomorph.prod e (local_homeomorph.refl F))
-
-@[simp, mfld_simps] lemma chart_source (e : local_homeomorph M H) (he : e ∈ atlas H M) :
-  (Z.chart he).source = Z.to_topological_vector_bundle_core.proj ⁻¹' e.source :=
-by { simp only [chart, mem_prod], mfld_set_tac }
-
-@[simp, mfld_simps] lemma chart_target (e : local_homeomorph M H) (he : e ∈ atlas H M) :
-  (Z.chart he).target = e.target ×ˢ (univ : set F) :=
-by { simp only [chart], mfld_set_tac }
-
-/-- The total space of a basic smooth bundle is endowed with a charted space structure, where the
-charts are in bijection with the charts of the basis. -/
-instance to_charted_space :
-  charted_space (model_prod H F) Z.to_topological_vector_bundle_core.total_space :=
-{ atlas := ⋃(e : local_homeomorph M H) (he : e ∈ atlas H M), {Z.chart he},
-  chart_at := λ p, Z.chart (chart_mem_atlas H p.1),
-  mem_chart_source := λ p, by simp [mem_chart_source],
-  chart_mem_atlas := λ p, begin
-    simp only [mem_Union, mem_singleton_iff, chart_mem_atlas],
-    exact ⟨chart_at H p.1, chart_mem_atlas H p.1, rfl⟩
-  end }
-
-lemma mem_atlas_iff
-  (f : local_homeomorph Z.to_topological_vector_bundle_core.total_space (model_prod H F)) :
-  f ∈ atlas (model_prod H F) Z.to_topological_vector_bundle_core.total_space ↔
-  ∃(e : local_homeomorph M H) (he : e ∈ atlas H M), f = Z.chart he :=
-by simp only [atlas, mem_Union, mem_singleton_iff]
-
-@[simp, mfld_simps] lemma mem_chart_source_iff
-  (p q : Z.to_topological_vector_bundle_core.total_space) :
-  p ∈ (chart_at (model_prod H F) q).source ↔ p.1 ∈ (chart_at H q.1).source :=
-by simp only [chart_at] with mfld_simps
-
-@[simp, mfld_simps] lemma mem_chart_target_iff
-  (p : H × F) (q : Z.to_topological_vector_bundle_core.total_space) :
-  p ∈ (chart_at (model_prod H F) q).target ↔ p.1 ∈ (chart_at H q.1).target :=
-by simp only [chart_at] with mfld_simps
-
-@[simp, mfld_simps] lemma coe_chart_at_fst (p q : Z.to_topological_vector_bundle_core.total_space) :
-  ((chart_at (model_prod H F) q) p).1 = chart_at H q.1 p.1 := rfl
-
-@[simp, mfld_simps] lemma coe_chart_at_symm_fst
-  (p : H × F) (q : Z.to_topological_vector_bundle_core.total_space) :
-  ((chart_at (model_prod H F) q).symm p).1 = ((chart_at H q.1).symm : H → M) p.1 := rfl
-
-/-- Smooth manifold structure on the total space of a basic smooth bundle -/
-instance to_smooth_manifold :
-  smooth_manifold_with_corners (I.prod (𝓘(𝕜, F))) Z.to_topological_vector_bundle_core.total_space :=
-begin
-  /- We have to check that the charts belong to the smooth groupoid, i.e., they are smooth on their
-  source, and their inverses are smooth on the target. Since both objects are of the same kind, it
-  suffices to prove the first statement in A below, and then glue back the pieces at the end. -/
-  let J := model_with_corners.to_local_equiv (I.prod (𝓘(𝕜, F))),
-  have A : ∀ (e e' : local_homeomorph M H) (he : e ∈ atlas H M) (he' : e' ∈ atlas H M),
-    cont_diff_on 𝕜 ∞
-    (J ∘ ((Z.chart he).symm.trans (Z.chart he')) ∘ J.symm)
-    (J.symm ⁻¹' ((Z.chart he).symm.trans (Z.chart he')).source ∩ range J),
-  { assume e e' he he',
-    have : J.symm ⁻¹' ((chart Z he).symm.trans (chart Z he')).source ∩ range J =
-      (I.symm ⁻¹' (e.symm.trans e').source ∩ range I) ×ˢ (univ : set F),
-      by { simp only [J, chart, model_with_corners.prod], mfld_set_tac },
-    rw this,
-    -- check separately that the two components of the coordinate change are smooth
-    apply cont_diff_on.prod,
-    show cont_diff_on 𝕜 ∞ (λ (p : E × F), (I ∘ e' ∘ e.symm ∘ I.symm) p.1)
-         ((I.symm ⁻¹' (e.symm.trans e').source ∩ range I) ×ˢ (univ : set F)),
-    { -- the coordinate change on the base is just a coordinate change for `M`, smooth since
-      -- `M` is smooth
-      have A : cont_diff_on 𝕜 ∞ (I ∘ (e.symm.trans e') ∘ I.symm)
-        (I.symm ⁻¹' (e.symm.trans e').source ∩ range I) :=
-      (has_groupoid.compatible (cont_diff_groupoid ∞ I) he he').1,
-      have B : cont_diff_on 𝕜 ∞ (λ p : E × F, p.1)
-        ((I.symm ⁻¹' (e.symm.trans e').source ∩ range I) ×ˢ (univ : set F)) :=
-      cont_diff_fst.cont_diff_on,
-      exact cont_diff_on.comp A B (prod_subset_preimage_fst _ _) },
-    show cont_diff_on 𝕜 ∞ (λ (p : E × F),
-      Z.coord_change ⟨chart_at H (e.symm (I.symm p.1)), _⟩ ⟨e', he'⟩
-         ((chart_at H (e.symm (I.symm p.1)) : M → H) (e.symm (I.symm p.1)))
-      (Z.coord_change ⟨e, he⟩ ⟨chart_at H (e.symm (I.symm p.1)), _⟩
-        (e (e.symm (I.symm p.1))) p.2))
-      ((I.symm ⁻¹' (e.symm.trans e').source ∩ range I) ×ˢ (univ : set F)),
-    { /- The coordinate change in the fiber is more complicated as its definition involves the
-      reference chart chosen at each point. However, it appears with its inverse, so using the
-      cocycle property one can get rid of it, and then conclude using the smoothness of the
-      cocycle as given in the definition of basic smooth bundles. -/
-      have := Z.coord_change_smooth ⟨e, he⟩ ⟨e', he'⟩,
-      rw I.image_eq at this,
-      apply cont_diff_on.congr this,
-      rintros ⟨x, v⟩ hx,
-      simp only with mfld_simps at hx,
-      let f := chart_at H (e.symm (I.symm x)),
-      have A : I.symm x ∈ ((e.symm.trans f).trans (f.symm.trans e')).source,
-        by simp only [hx.1.1, hx.1.2] with mfld_simps,
-      rw e.right_inv hx.1.1,
-      have := Z.coord_change_comp ⟨e, he⟩ ⟨f, chart_mem_atlas _ _⟩ ⟨e', he'⟩ (I.symm x) A v,
-      simpa only [] using this } },
-  refine @smooth_manifold_with_corners.mk _ _ _ _ _ _ _ _ _ _ _ ⟨_⟩,
-  assume e₀ e₀' he₀ he₀',
-  rcases (Z.mem_atlas_iff _).1 he₀ with ⟨e, he, rfl⟩,
-  rcases (Z.mem_atlas_iff _).1 he₀' with ⟨e', he', rfl⟩,
-  rw [cont_diff_groupoid, mem_groupoid_of_pregroupoid],
-  exact ⟨A e e' he he', A e' e he' he⟩
-end
-
-end basic_smooth_vector_bundle_core
-
-section tangent_bundle
-
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-{E : Type*} [normed_group E] [normed_space 𝕜 E]
-{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
-(M : Type*) [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
-
-/-- Basic smooth bundle core version of the tangent bundle of a smooth manifold `M` modelled over a
-model with corners `I` on `(E, H)`. The fibers are equal to `E`, and the coordinate change in the
-fiber corresponds to the derivative of the coordinate change in `M`. -/
-def tangent_bundle_core : basic_smooth_vector_bundle_core I M E :=
-{ coord_change := λ i j x, (fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm) (range I) (I x)),
-  coord_change_smooth_clm := λ i j,
-  begin
-    rw I.image_eq,
-    have A : cont_diff_on 𝕜 ∞
-      (I ∘ (i.1.symm.trans j.1) ∘ I.symm)
-      (I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I) :=
-      (has_groupoid.compatible (cont_diff_groupoid ∞ I) i.2 j.2).1,
-    have B : unique_diff_on 𝕜 (I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I) :=
-      I.unique_diff_preimage_source,
-    have C : cont_diff_on 𝕜 ∞
-      (λ (p : E × E), (fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-            (I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I) p.1 : E → E) p.2)
-      ((I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I) ×ˢ (univ : set E)) :=
-      cont_diff_on_fderiv_within_apply A B le_top,
-    have D : ∀ x ∈ (I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I),
-      fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-            (range I) x =
-      fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-            (I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I) x,
-    { assume x hx,
-      have N : I.symm ⁻¹' (i.1.symm.trans j.1).source ∈ nhds x :=
-        I.continuous_symm.continuous_at.preimage_mem_nhds
-          (is_open.mem_nhds (local_homeomorph.open_source _) hx.1),
-      symmetry,
-      rw inter_comm,
-      exact fderiv_within_inter N (I.unique_diff _ hx.2) },
-    apply (A.fderiv_within B le_top).congr,
-    assume x hx,
-    simp only with mfld_simps at hx,
-    simp only [hx, D] with mfld_simps,
-  end,
-  coord_change_self := λ i x hx v, begin
-    /- Locally, a self-change of coordinate is just the identity, thus its derivative is the
-    identity. One just needs to write this carefully, paying attention to the sets where the
-    functions are defined. -/
-    have A : I.symm ⁻¹' (i.1.symm.trans i.1).source ∩ range I ∈ 𝓝[range I] (I x),
-    { rw inter_comm,
-      apply inter_mem_nhds_within,
-      apply I.continuous_symm.continuous_at.preimage_mem_nhds
-        (is_open.mem_nhds (local_homeomorph.open_source _) _),
-      simp only [hx, i.1.map_target] with mfld_simps },
-    have B : ∀ᶠ y in 𝓝[range I] (I x),
-      (I ∘ i.1 ∘ i.1.symm ∘ I.symm) y = (id : E → E) y,
-    { filter_upwards [A] with _ hy,
-      rw ← I.image_eq at hy,
-      rcases hy with ⟨z, hz⟩,
-      simp only with mfld_simps at hz,
-      simp only [hz.2.symm, hz.1] with mfld_simps, },
-    have C : fderiv_within 𝕜 (I ∘ i.1 ∘ i.1.symm ∘ I.symm) (range I) (I x) =
-             fderiv_within 𝕜 (id : E → E) (range I) (I x) :=
-      filter.eventually_eq.fderiv_within_eq I.unique_diff_at_image B
-      (by simp only [hx] with mfld_simps),
-    rw fderiv_within_id I.unique_diff_at_image at C,
-    rw C,
-    refl
-  end,
-  coord_change_comp := λ i j u x hx, begin
-    /- The cocycle property is just the fact that the derivative of a composition is the product of
-    the derivatives. One needs however to check that all the functions one considers are smooth, and
-    to pay attention to the domains where these functions are defined, making this proof a little
-    bit cumbersome although there is nothing complicated here. -/
-    have M : I x ∈
-      (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I) :=
-    ⟨by simpa only [mem_preimage, model_with_corners.left_inv] using hx, mem_range_self _⟩,
-    have U : unique_diff_within_at 𝕜
-      (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I) (I x) :=
-      I.unique_diff_preimage_source _ M,
-    have A : fderiv_within 𝕜 ((I ∘ u.1 ∘ j.1.symm ∘ I.symm) ∘ (I ∘ j.1 ∘ i.1.symm ∘ I.symm))
-             (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-             (I x)
-      = (fderiv_within 𝕜 (I ∘ u.1 ∘ j.1.symm ∘ I.symm)
-             (I.symm ⁻¹' (j.1.symm.trans u.1).source ∩ range I)
-             ((I ∘ j.1 ∘ i.1.symm ∘ I.symm) (I x))).comp
-        (fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-             (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-             (I x)),
-    { apply fderiv_within.comp _ _ _ _ U,
-      show differentiable_within_at 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-        (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-        (I x),
-      { have A : cont_diff_on 𝕜 ∞
-          (I ∘ (i.1.symm.trans j.1) ∘ I.symm)
-          (I.symm ⁻¹' (i.1.symm.trans j.1).source ∩ range I) :=
-        (has_groupoid.compatible (cont_diff_groupoid ∞ I) i.2 j.2).1,
-        have B : differentiable_on 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-          (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I),
-        { apply (A.differentiable_on le_top).mono,
-          have : ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ⊆
-            (i.1.symm.trans j.1).source := inter_subset_left _ _,
-          exact inter_subset_inter (preimage_mono this) (subset.refl (range I)) },
-        apply B,
-        simpa only [] with mfld_simps using hx },
-      show differentiable_within_at 𝕜 (I ∘ u.1 ∘ j.1.symm ∘ I.symm)
-        (I.symm ⁻¹' (j.1.symm.trans u.1).source ∩ range I)
-        ((I ∘ j.1 ∘ i.1.symm ∘ I.symm) (I x)),
-      { have A : cont_diff_on 𝕜 ∞
-          (I ∘ (j.1.symm.trans u.1) ∘ I.symm)
-          (I.symm ⁻¹' (j.1.symm.trans u.1).source ∩ range I) :=
-        (has_groupoid.compatible (cont_diff_groupoid ∞ I) j.2 u.2).1,
-        apply A.differentiable_on le_top,
-        rw [local_homeomorph.trans_source] at hx,
-        simp only with mfld_simps,
-        exact hx.2 },
-      show (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-        ⊆ (I ∘ j.1 ∘ i.1.symm ∘ I.symm) ⁻¹' (I.symm ⁻¹' (j.1.symm.trans u.1).source ∩ range I),
-      { assume y hy,
-        simp only with mfld_simps at hy,
-        rw [local_homeomorph.left_inv] at hy,
-        { simp only [hy] with mfld_simps },
-        { exact hy.1.1.2 } } },
-    have B : fderiv_within 𝕜 ((I ∘ u.1 ∘ j.1.symm ∘ I.symm)
-                          ∘ (I ∘ j.1 ∘ i.1.symm ∘ I.symm))
-             (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-             (I x)
-             = fderiv_within 𝕜 (I ∘ u.1 ∘ i.1.symm ∘ I.symm)
-             (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-             (I x),
-    { have E :
-        ∀ y ∈ (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I),
-          ((I ∘ u.1 ∘ j.1.symm ∘ I.symm) ∘ (I ∘ j.1 ∘ i.1.symm ∘ I.symm)) y =
-            (I ∘ u.1 ∘ i.1.symm ∘ I.symm) y,
-      { assume y hy,
-        simp only [function.comp_app, model_with_corners.left_inv],
-        rw [j.1.left_inv],
-        exact hy.1.1.2 },
-      exact fderiv_within_congr U E (E _ M) },
-    have C : fderiv_within 𝕜 (I ∘ u.1 ∘ i.1.symm ∘ I.symm)
-             (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-             (I x) =
-             fderiv_within 𝕜 (I ∘ u.1 ∘ i.1.symm ∘ I.symm)
-             (range I) (I x),
-    { rw inter_comm,
-      apply fderiv_within_inter _ I.unique_diff_at_image,
-      apply I.continuous_symm.continuous_at.preimage_mem_nhds
-        (is_open.mem_nhds (local_homeomorph.open_source _) _),
-      simpa only [model_with_corners.left_inv] using hx },
-    have D : fderiv_within 𝕜 (I ∘ u.1 ∘ j.1.symm ∘ I.symm)
-      (I.symm ⁻¹' (j.1.symm.trans u.1).source ∩ range I) ((I ∘ j.1 ∘ i.1.symm ∘ I.symm) (I x)) =
-      fderiv_within 𝕜 (I ∘ u.1 ∘ j.1.symm ∘ I.symm) (range I) ((I ∘ j.1 ∘ i.1.symm ∘ I.symm) (I x)),
-    { rw inter_comm,
-      apply fderiv_within_inter _ I.unique_diff_at_image,
-      apply I.continuous_symm.continuous_at.preimage_mem_nhds
-        (is_open.mem_nhds (local_homeomorph.open_source _) _),
-      rw [local_homeomorph.trans_source] at hx,
-      simp only with mfld_simps,
-      exact hx.2 },
-    have E : fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm)
-               (I.symm ⁻¹' ((i.1.symm.trans j.1).trans (j.1.symm.trans u.1)).source ∩ range I)
-               (I x) =
-             fderiv_within 𝕜 (I ∘ j.1 ∘ i.1.symm ∘ I.symm) (range I) (I x),
-    { rw inter_comm,
-      apply fderiv_within_inter _ I.unique_diff_at_image,
-      apply I.continuous_symm.continuous_at.preimage_mem_nhds
-        (is_open.mem_nhds (local_homeomorph.open_source _) _),
-      simpa only [model_with_corners.left_inv] using hx },
-    rw [B, C, D, E] at A,
-    simp only [A, continuous_linear_map.coe_comp'] with mfld_simps,
-  end }
-
-variable {M}
-include I
-
-/-- The tangent space at a point of the manifold `M`. It is just `E`. We could use instead
-`(tangent_bundle_core I M).to_topological_vector_bundle_core.fiber x`, but we use `E` to help the
-kernel.
--/
-@[nolint unused_arguments]
-def tangent_space (x : M) : Type* := E
-
-omit I
-variable (M)
-
-/-- The tangent bundle to a smooth manifold, as a Sigma type. Defined in terms of
-`bundle.total_space` to be able to put a suitable topology on it. -/
-@[nolint has_inhabited_instance, reducible] -- is empty if the base manifold is empty
-def tangent_bundle := bundle.total_space (tangent_space I : M → Type*)
-
-local notation `TM` := tangent_bundle I M
-
-/-- The projection from the tangent bundle of a smooth manifold to the manifold. As the tangent
-bundle is represented internally as a sigma type, the notation `p.1` also works for the projection
-of the point `p`. -/
-def tangent_bundle.proj : TM → M :=
-λ p, p.1
-
-variable {M}
-
-@[simp, mfld_simps] lemma tangent_bundle.proj_apply (x : M) (v : tangent_space I x) :
-  tangent_bundle.proj I M ⟨x, v⟩ = x :=
-rfl
-
-section tangent_bundle_instances
-
-/- In general, the definition of tangent_bundle and tangent_space are not reducible, so that type
-class inference does not pick wrong instances. In this section, we record the right instances for
-them, noting in particular that the tangent bundle is a smooth manifold. -/
-
-section
-local attribute [reducible] tangent_space
-
-variables {M} (x : M)
-
-instance : topological_space (tangent_space I x) := by apply_instance
-instance : add_comm_group (tangent_space I x) := by apply_instance
-instance : topological_add_group (tangent_space I x) := by apply_instance
-instance : module 𝕜 (tangent_space I x) := by apply_instance
-instance : inhabited (tangent_space I x) := ⟨0⟩
-
-end
-
-variable (M)
-
-instance : topological_space TM :=
-(tangent_bundle_core I M).to_topological_vector_bundle_core.to_topological_space (atlas H M)
-
-instance : charted_space (model_prod H E) TM :=
-(tangent_bundle_core I M).to_charted_space
-
-instance : smooth_manifold_with_corners I.tangent TM :=
-(tangent_bundle_core I M).to_smooth_manifold
-
-instance : topological_vector_bundle 𝕜 E (tangent_space I : M → Type*) :=
-topological_vector_bundle_core.fiber.topological_vector_bundle
-  (tangent_bundle_core I M).to_topological_vector_bundle_core
-
-end tangent_bundle_instances
-
-variable (M)
-
-/-- The tangent bundle projection on the basis is a continuous map. -/
-lemma tangent_bundle_proj_continuous : continuous (tangent_bundle.proj I M) :=
-((tangent_bundle_core I M).to_topological_vector_bundle_core).continuous_proj
-
-/-- The tangent bundle projection on the basis is an open map. -/
-lemma tangent_bundle_proj_open : is_open_map (tangent_bundle.proj I M) :=
-((tangent_bundle_core I M).to_topological_vector_bundle_core).is_open_map_proj
-
-/-- In the tangent bundle to the model space, the charts are just the canonical identification
-between a product type and a sigma type, a.k.a. `equiv.sigma_equiv_prod`. -/
-@[simp, mfld_simps] lemma tangent_bundle_model_space_chart_at (p : tangent_bundle I H) :
-  (chart_at (model_prod H E) p).to_local_equiv = (equiv.sigma_equiv_prod H E).to_local_equiv :=
-begin
-  have A : ∀ x_fst, fderiv_within 𝕜 (I ∘ I.symm) (range I) (I x_fst) = continuous_linear_map.id 𝕜 E,
-  { assume x_fst,
-    have : fderiv_within 𝕜 (I ∘ I.symm) (range I) (I x_fst)
-         = fderiv_within 𝕜 id (range I) (I x_fst),
-    { refine fderiv_within_congr I.unique_diff_at_image (λ y hy, _) (by simp),
-      exact model_with_corners.right_inv _ hy },
-    rwa fderiv_within_id I.unique_diff_at_image at this },
-  ext x : 1,
-  show (chart_at (model_prod H E) p : tangent_bundle I H → model_prod H E) x =
-    (equiv.sigma_equiv_prod H E) x,
-  { cases x,
-    simp only [chart_at, basic_smooth_vector_bundle_core.chart, tangent_bundle_core,
-      basic_smooth_vector_bundle_core.to_topological_vector_bundle_core, A, prod.mk.inj_iff,
-      continuous_linear_map.coe_id'] with mfld_simps,
-      exact (tangent_bundle_core I H).coord_change_self _ _ trivial x_snd, },
-  show ∀ x, ((chart_at (model_prod H E) p).to_local_equiv).symm x =
-    (equiv.sigma_equiv_prod H E).symm x,
-  { rintros ⟨x_fst, x_snd⟩,
-    simp only [basic_smooth_vector_bundle_core.to_topological_vector_bundle_core,
-      tangent_bundle_core, A, continuous_linear_map.coe_id', basic_smooth_vector_bundle_core.chart,
-      chart_at, continuous_linear_map.coe_coe, sigma.mk.inj_iff] with mfld_simps, },
-  show ((chart_at (model_prod H E) p).to_local_equiv).source = univ,
-    by simp only [chart_at] with mfld_simps,
-end
-
-@[simp, mfld_simps] lemma tangent_bundle_model_space_coe_chart_at (p : tangent_bundle I H) :
-  ⇑(chart_at (model_prod H E) p) = equiv.sigma_equiv_prod H E :=
-by { unfold_coes, simp only with mfld_simps }
-
-@[simp, mfld_simps] lemma tangent_bundle_model_space_coe_chart_at_symm (p : tangent_bundle I H) :
-  ((chart_at (model_prod H E) p).symm : model_prod H E → tangent_bundle I H) =
-  (equiv.sigma_equiv_prod H E).symm :=
-by { unfold_coes, simp only with mfld_simps }
-
-variable (H)
-/-- The canonical identification between the tangent bundle to the model space and the product,
-as a homeomorphism -/
-def tangent_bundle_model_space_homeomorph : tangent_bundle I H ≃ₜ model_prod H E :=
-{ continuous_to_fun :=
-  begin
-    let p : tangent_bundle I H := ⟨I.symm (0 : E), (0 : E)⟩,
-    have : continuous (chart_at (model_prod H E) p),
-    { rw continuous_iff_continuous_on_univ,
-      convert local_homeomorph.continuous_on _,
-      simp only with mfld_simps },
-    simpa only with mfld_simps using this,
-  end,
-  continuous_inv_fun :=
-  begin
-    let p : tangent_bundle I H := ⟨I.symm (0 : E), (0 : E)⟩,
-    have : continuous (chart_at (model_prod H E) p).symm,
-    { rw continuous_iff_continuous_on_univ,
-      convert local_homeomorph.continuous_on _,
-      simp only with mfld_simps },
-    simpa only with mfld_simps using this,
-  end,
-  .. equiv.sigma_equiv_prod H E }
-
-@[simp, mfld_simps] lemma tangent_bundle_model_space_homeomorph_coe :
-  (tangent_bundle_model_space_homeomorph H I : tangent_bundle I H → model_prod H E)
-  = equiv.sigma_equiv_prod H E :=
-rfl
-
-@[simp, mfld_simps] lemma tangent_bundle_model_space_homeomorph_coe_symm :
-  ((tangent_bundle_model_space_homeomorph H I).symm : model_prod H E → tangent_bundle I H)
-  = (equiv.sigma_equiv_prod H E).symm :=
-rfl
-
-end tangent_bundle
diff --git a/src/geometry/manifold/vector_bundle/basic.lean b/src/geometry/manifold/vector_bundle/basic.lean
new file mode 100644
index 0000000000000..2ee022460ef97
--- /dev/null
+++ b/src/geometry/manifold/vector_bundle/basic.lean
@@ -0,0 +1,460 @@
+/-
+Copyright (c) 2022 Floris van Doorn, Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Heather Macbeth
+-/
+import geometry.manifold.vector_bundle.fiberwise_linear
+import topology.vector_bundle.constructions
+
+/-! # Smooth vector bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines smooth vector bundles over a smooth manifold.
+
+Let `E` be a topological vector bundle, with model fiber `F` and base space `B`.  We consider `E` as
+carrying a charted space structure given by its trivializations -- these are charts to `B × F`.
+Then, by "composition", if `B` is itself a charted space over `H` (e.g. a smooth manifold), then `E`
+is also a charted space over `H × F`
+
+Now, we define `smooth_vector_bundle` as the `Prop` of having smooth transition functions.
+Recall the structure groupoid `smooth_fiberwise_linear` on `B × F` consisting of smooth, fiberwise
+linear local homeomorphisms.  We show that our definition of "smooth vector bundle" implies
+`has_groupoid` for this groupoid, and show (by a "composition" of `has_groupoid` instances) that
+this means that a smooth vector bundle is a smooth manifold.
+
+Since `smooth_vector_bundle` is a mixin, it should be easy to make variants and for many such
+variants to coexist -- vector bundles can be smooth vector bundles over several different base
+fields, they can also be C^k vector bundles, etc.
+
+## Main definitions and constructions
+
+* `fiber_bundle.charted_space`: A fiber bundle `E` over a base `B` with model fiber `F` is naturally
+  a charted space modelled on `B × F`.
+
+* `fiber_bundle.charted_space'`: Let `B` be a charted space modelled on `HB`.  Then a fiber bundle
+  `E` over a base `B` with model fiber `F` is naturally a charted space modelled on `HB.prod F`.
+
+* `smooth_vector_bundle`: Mixin class stating that a (topological) `vector_bundle` is smooth, in the
+  sense of having smooth transition functions.
+
+* `smooth_fiberwise_linear.has_groupoid`: For a smooth vector bundle `E` over `B` with fiber
+  modelled on `F`, the change-of-co-ordinates between two trivializations `e`, `e'` for `E`,
+  considered as charts to `B × F`, is smooth and fiberwise linear, in the sense of belonging to the
+  structure groupoid `smooth_fiberwise_linear`.
+
+* `bundle.total_space.smooth_manifold_with_corners`: A smooth vector bundle is naturally a smooth
+  manifold.
+
+* `vector_bundle_core.smooth_vector_bundle`: If a (topological) `vector_bundle_core` is smooth,
+  in the sense of having smooth transition functions (cf. `vector_bundle_core.is_smooth`),
+  then the vector bundle constructed from it is a smooth vector bundle.
+
+* `vector_prebundle.smooth_vector_bundle`: If a `vector_prebundle` is smooth,
+  in the sense of having smooth transition functions (cf. `vector_prebundle.is_smooth`),
+  then the vector bundle constructed from it is a smooth vector bundle.
+
+* `bundle.prod.smooth_vector_bundle`: The direct sum of two smooth vector bundles is a smooth vector
+  bundle.
+-/
+
+assert_not_exists mfderiv
+
+open bundle set local_homeomorph function (id_def) filter
+open_locale manifold bundle topology
+
+variables {𝕜 B B' F M : Type*} {E : B → Type*}
+
+/-! ### Charted space structure on a fiber bundle -/
+
+section
+variables [topological_space F] [topological_space (total_space F E)] [∀ x, topological_space (E x)]
+  {HB : Type*} [topological_space HB]
+  [topological_space B] [charted_space HB B] [fiber_bundle F E]
+
+/-- A fiber bundle `E` over a base `B` with model fiber `F` is naturally a charted space modelled on
+`B × F`. -/
+instance fiber_bundle.charted_space : charted_space (B × F) (total_space F E) :=
+{ atlas := (λ e : trivialization F (π F E), e.to_local_homeomorph) '' trivialization_atlas F E,
+  chart_at := λ x, (trivialization_at F E x.proj).to_local_homeomorph,
+  mem_chart_source := λ x, (trivialization_at F E x.proj).mem_source.mpr
+    (mem_base_set_trivialization_at F E x.proj),
+  chart_mem_atlas := λ x, mem_image_of_mem _ (trivialization_mem_atlas F E _) }
+
+section
+local attribute [reducible] model_prod
+
+/-- Let `B` be a charted space modelled on `HB`.  Then a fiber bundle `E` over a base `B` with model
+fiber `F` is naturally a charted space modelled on `HB.prod F`. -/
+instance fiber_bundle.charted_space' : charted_space (model_prod HB F) (total_space F E) :=
+charted_space.comp _ (model_prod B F) _
+end
+
+lemma fiber_bundle.charted_space_chart_at (x : total_space F E) :
+  chart_at (model_prod HB F) x =
+  (trivialization_at F E x.proj).to_local_homeomorph ≫ₕ
+  (chart_at HB x.proj).prod (local_homeomorph.refl F) :=
+begin
+  dsimp only [fiber_bundle.charted_space', charted_space.comp, fiber_bundle.charted_space,
+    prod_charted_space, charted_space_self],
+  rw [trivialization.coe_coe,
+    trivialization.coe_fst' _ (mem_base_set_trivialization_at F E x.proj)]
+end
+
+lemma fiber_bundle.charted_space_chart_at_symm_fst (x : total_space F E) (y : model_prod HB F)
+  (hy : y ∈ (chart_at (model_prod HB F) x).target) :
+  ((chart_at (model_prod HB F) x).symm y).proj = (chart_at HB x.proj).symm y.1 :=
+begin
+  simp only [fiber_bundle.charted_space_chart_at] with mfld_simps at hy ⊢,
+  exact (trivialization_at F E x.proj).proj_symm_apply hy.2,
+end
+
+end
+
+section
+variables [nontrivially_normed_field 𝕜]
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  [topological_space (total_space F E)] [∀ x, topological_space (E x)]
+
+  {EB : Type*} [normed_add_comm_group EB] [normed_space 𝕜 EB]
+  {HB : Type*} [topological_space HB] (IB : model_with_corners 𝕜 EB HB)
+  (E' : B → Type*) [Π x, has_zero (E' x)]
+  {EM : Type*} [normed_add_comm_group EM] [normed_space 𝕜 EM]
+  {HM : Type*} [topological_space HM] {IM : model_with_corners 𝕜 EM HM}
+  [topological_space M] [charted_space HM M] [Is : smooth_manifold_with_corners IM M]
+  {n : ℕ∞}
+
+variables [topological_space B] [charted_space HB B] [fiber_bundle F E]
+
+protected lemma fiber_bundle.ext_chart_at (x : total_space F E) :
+  ext_chart_at (IB.prod 𝓘(𝕜, F)) x =
+  (trivialization_at F E x.proj).to_local_equiv ≫
+  (ext_chart_at IB x.proj).prod (local_equiv.refl F) :=
+begin
+  simp_rw [ext_chart_at, fiber_bundle.charted_space_chart_at, extend],
+  simp only [local_equiv.trans_assoc] with mfld_simps,
+end
+
+/-! ### Smoothness of maps in/out fiber bundles
+
+Note: For these results we don't need that the bundle is a smooth vector bundle, or even a vector
+bundle at all, just that it is a fiber bundle over a charted base space.
+-/
+
+namespace bundle
+variables {F E IB}
+
+/-- Characterization of C^n functions into a smooth vector bundle. -/
+lemma cont_mdiff_within_at_total_space (f : M → total_space F E) {s : set M} {x₀ : M} :
+  cont_mdiff_within_at IM (IB.prod (𝓘(𝕜, F))) n f s x₀ ↔
+  cont_mdiff_within_at IM IB n (λ x, (f x).proj) s x₀ ∧
+  cont_mdiff_within_at IM 𝓘(𝕜, F) n (λ x, (trivialization_at F E (f x₀).proj (f x)).2) s x₀ :=
+begin
+  simp only [cont_mdiff_within_at_iff_target] {single_pass := tt},
+  rw [and_and_and_comm, ← continuous_within_at_total_space, and.congr_right_iff],
+  intros hf,
+  simp_rw [model_with_corners_self_prod, fiber_bundle.ext_chart_at, function.comp,
+    local_equiv.trans_apply, local_equiv.prod_coe, local_equiv.refl_coe,
+    ext_chart_at_self_apply, model_with_corners_self_coe, id_def],
+  refine (cont_mdiff_within_at_prod_iff _).trans _, -- rw doesn't do this?
+  have h1 : (λ x, (f x).proj) ⁻¹' (trivialization_at F E (f x₀).proj).base_set ∈ 𝓝[s] x₀ :=
+    ((continuous_proj F E).continuous_within_at.comp hf (maps_to_image f s))
+      .preimage_mem_nhds_within
+      ((trivialization.open_base_set _).mem_nhds (mem_base_set_trivialization_at F E _)),
+  refine and_congr (eventually_eq.cont_mdiff_within_at_iff (eventually_of_mem h1 $ λ x hx, _) _)
+    iff.rfl,
+  { simp_rw [function.comp, local_homeomorph.coe_coe, trivialization.coe_coe],
+    rw [trivialization.coe_fst'],
+    exact hx },
+  { simp only with mfld_simps },
+end
+
+/-- Characterization of C^n functions into a smooth vector bundle. -/
+lemma cont_mdiff_at_total_space (f : M → total_space F E) (x₀ : M) :
+  cont_mdiff_at IM (IB.prod (𝓘(𝕜, F))) n f x₀ ↔
+  cont_mdiff_at IM IB n (λ x, (f x).proj) x₀ ∧
+  cont_mdiff_at IM 𝓘(𝕜, F) n (λ x, (trivialization_at F E (f x₀).proj (f x)).2) x₀ :=
+by { simp_rw [← cont_mdiff_within_at_univ], exact cont_mdiff_within_at_total_space f }
+
+/-- Characterization of C^n sections of a smooth vector bundle. -/
+lemma cont_mdiff_at_section (s : Π x, E x) (x₀ : B) :
+  cont_mdiff_at IB (IB.prod (𝓘(𝕜, F))) n (λ x, total_space.mk' F x (s x)) x₀ ↔
+  cont_mdiff_at IB 𝓘(𝕜, F) n (λ x, (trivialization_at F E x₀ (total_space.mk' F x (s x))).2) x₀ :=
+by { simp_rw [cont_mdiff_at_total_space, and_iff_right_iff_imp], intro x, exact cont_mdiff_at_id }
+
+variables (E)
+lemma cont_mdiff_proj : cont_mdiff (IB.prod 𝓘(𝕜, F)) IB n (π F E) :=
+begin
+  intro x,
+  rw [cont_mdiff_at, cont_mdiff_within_at_iff'],
+  refine ⟨(continuous_proj F E).continuous_within_at, _⟩,
+  simp_rw [(∘), fiber_bundle.ext_chart_at],
+  apply cont_diff_within_at_fst.congr,
+  { rintros ⟨a, b⟩ hab,
+    simp only with mfld_simps at hab,
+    have : ((chart_at HB x.1).symm (IB.symm a), b) ∈ (trivialization_at F E x.proj).target,
+    { simp only [hab] with mfld_simps },
+    simp only [trivialization.proj_symm_apply _ this, hab] with mfld_simps },
+  { simp only with mfld_simps }
+end
+
+lemma smooth_proj : smooth (IB.prod 𝓘(𝕜, F)) IB (π F E) :=
+cont_mdiff_proj E
+
+lemma cont_mdiff_on_proj {s : set (total_space F E)} :
+  cont_mdiff_on (IB.prod 𝓘(𝕜, F)) IB n (π F E) s :=
+(bundle.cont_mdiff_proj E).cont_mdiff_on
+
+lemma smooth_on_proj {s : set (total_space F E)} :
+  smooth_on (IB.prod 𝓘(𝕜, F)) IB (π F E) s :=
+cont_mdiff_on_proj E
+
+lemma cont_mdiff_at_proj {p : total_space F E} :
+  cont_mdiff_at (IB.prod 𝓘(𝕜, F)) IB n
+    (π F E) p :=
+(bundle.cont_mdiff_proj E).cont_mdiff_at
+
+lemma smooth_at_proj {p : total_space F E} :
+  smooth_at (IB.prod 𝓘(𝕜, F)) IB (π F E) p :=
+bundle.cont_mdiff_at_proj E
+
+lemma cont_mdiff_within_at_proj
+  {s : set (total_space F E)}
+  {p : total_space F E} :
+  cont_mdiff_within_at (IB.prod 𝓘(𝕜, F)) IB n (π F E) s p :=
+(bundle.cont_mdiff_at_proj E).cont_mdiff_within_at
+
+lemma smooth_within_at_proj
+  {s : set (total_space F E)}
+  {p : total_space F E} :
+  smooth_within_at (IB.prod 𝓘(𝕜, F)) IB (π F E) s p :=
+bundle.cont_mdiff_within_at_proj E
+
+variables (𝕜 E) [∀ x, add_comm_monoid (E x)] [∀ x, module 𝕜 (E x)] [vector_bundle 𝕜 F E]
+
+lemma smooth_zero_section : smooth IB (IB.prod 𝓘(𝕜, F)) (zero_section F E) :=
+begin
+  intro x,
+  rw [bundle.cont_mdiff_at_total_space],
+  refine ⟨cont_mdiff_at_id, cont_mdiff_at_const.congr_of_eventually_eq _⟩,
+  { exact 0 },
+  refine eventually_of_mem ((trivialization_at F E x).open_base_set.mem_nhds
+    (mem_base_set_trivialization_at F E x)) (λ x' hx', _),
+  simp_rw [zero_section_proj, (trivialization_at F E x).zero_section 𝕜 hx']
+end
+
+end bundle
+
+end
+
+/-! ### Smooth vector bundles -/
+
+variables [nontrivially_normed_field 𝕜]
+  {EB : Type*} [normed_add_comm_group EB] [normed_space 𝕜 EB]
+  {HB : Type*} [topological_space HB] (IB : model_with_corners 𝕜 EB HB)
+  [topological_space B] [charted_space HB B] [smooth_manifold_with_corners IB B]
+  {EM : Type*} [normed_add_comm_group EM] [normed_space 𝕜 EM]
+  {HM : Type*} [topological_space HM] {IM : model_with_corners 𝕜 EM HM}
+  [topological_space M] [charted_space HM M] [Is : smooth_manifold_with_corners IM M]
+  {n : ℕ∞}
+  [∀ x, add_comm_monoid (E x)] [∀ x, module 𝕜 (E x)]
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+
+section with_topology
+
+variables [topological_space (total_space F E)] [∀ x, topological_space (E x)]
+
+variables (F E) [fiber_bundle F E] [vector_bundle 𝕜 F E]
+
+/-- When `B` is a smooth manifold with corners with respect to a model `IB` and `E` is a
+topological vector bundle over `B` with fibers isomorphic to `F`, then `smooth_vector_bundle F E IB`
+registers that the bundle is smooth, in the sense of having smooth transition functions.
+This is a mixin, not carrying any new data`. -/
+class smooth_vector_bundle : Prop :=
+(smooth_on_coord_change : ∀ (e e' : trivialization F (π F E))
+  [mem_trivialization_atlas e] [mem_trivialization_atlas e'],
+  smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ b : B, (e.coord_changeL 𝕜 e' b : F →L[𝕜] F))
+  (e.base_set ∩ e'.base_set))
+
+export smooth_vector_bundle (smooth_on_coord_change)
+
+variables [smooth_vector_bundle F E IB]
+
+/-- For a smooth vector bundle `E` over `B` with fiber modelled on `F`, the change-of-co-ordinates
+between two trivializations `e`, `e'` for `E`, considered as charts to `B × F`, is smooth and
+fiberwise linear. -/
+instance : has_groupoid (total_space F E) (smooth_fiberwise_linear B F IB) :=
+{ compatible := begin
+    rintros _ _ ⟨e, he, rfl⟩ ⟨e', he', rfl⟩,
+    haveI : mem_trivialization_atlas e := ⟨he⟩,
+    haveI : mem_trivialization_atlas e' := ⟨he'⟩,
+    resetI,
+    rw mem_smooth_fiberwise_linear_iff,
+    refine ⟨_, _, e.open_base_set.inter e'.open_base_set, smooth_on_coord_change e e', _, _, _⟩,
+    { rw inter_comm,
+      apply cont_mdiff_on.congr (smooth_on_coord_change e' e),
+      { intros b hb,
+        rw e.symm_coord_changeL e' hb },
+      { apply_instance },
+      { apply_instance }, },
+    { simp only [e.symm_trans_source_eq e', fiberwise_linear.local_homeomorph,
+      trans_to_local_equiv, symm_to_local_equiv]},
+    { rintros ⟨b, v⟩ hb,
+      have hb' : b ∈ e.base_set ∩ e'.base_set,
+      { simpa only [trans_to_local_equiv, symm_to_local_equiv, e.symm_trans_source_eq e',
+          coe_coe_symm, prod_mk_mem_set_prod_eq, mem_univ, and_true] using hb },
+      exact e.apply_symm_apply_eq_coord_changeL e' hb' v, }
+  end }
+
+/-- A smooth vector bundle `E` is naturally a smooth manifold. -/
+instance : smooth_manifold_with_corners (IB.prod 𝓘(𝕜, F)) (total_space F E) :=
+begin
+  refine { .. structure_groupoid.has_groupoid.comp (smooth_fiberwise_linear B F IB) _ },
+  intros e he,
+  rw mem_smooth_fiberwise_linear_iff at he,
+  obtain ⟨φ, U, hU, hφ, h2φ, heφ⟩ := he,
+  rw [is_local_structomorph_on_cont_diff_groupoid_iff],
+  refine ⟨cont_mdiff_on.congr _ heφ.eq_on, cont_mdiff_on.congr _ heφ.symm'.eq_on⟩,
+  { rw heφ.source_eq,
+    apply smooth_on_fst.prod_mk,
+    exact (hφ.comp cont_mdiff_on_fst $ prod_subset_preimage_fst _ _).clm_apply cont_mdiff_on_snd },
+  { rw heφ.target_eq,
+    apply smooth_on_fst.prod_mk,
+    exact (h2φ.comp cont_mdiff_on_fst $ prod_subset_preimage_fst _ _).clm_apply cont_mdiff_on_snd },
+end
+
+/-! ### Core construction for smooth vector bundles -/
+
+namespace vector_bundle_core
+variables {ι : Type*} {F} (Z : vector_bundle_core 𝕜 B F ι)
+
+/-- Mixin for a `vector_bundle_core` stating smoothness (of transition functions). -/
+class is_smooth (IB : model_with_corners 𝕜 EB HB) : Prop :=
+(smooth_on_coord_change [] :
+  ∀ i j, smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (Z.coord_change i j) (Z.base_set i ∩ Z.base_set j))
+
+export is_smooth (renaming smooth_on_coord_change → vector_bundle_core.smooth_on_coord_change)
+
+variables [Z.is_smooth IB]
+
+/-- If a `vector_bundle_core` has the `is_smooth` mixin, then the vector bundle constructed from it
+is a smooth vector bundle. -/
+instance smooth_vector_bundle : smooth_vector_bundle F Z.fiber IB :=
+{ smooth_on_coord_change := begin
+    rintros - - ⟨i, rfl⟩ ⟨i', rfl⟩,
+    refine (Z.smooth_on_coord_change IB i i').congr (λ b hb, _),
+    ext v,
+    exact Z.local_triv_coord_change_eq i i' hb v,
+  end }
+
+end vector_bundle_core
+
+/-! ### The trivial smooth vector bundle -/
+
+/-- A trivial vector bundle over a smooth manifold is a smooth vector bundle. -/
+instance bundle.trivial.smooth_vector_bundle : smooth_vector_bundle F (bundle.trivial B F) IB :=
+{ smooth_on_coord_change := begin
+    introsI e e' he he',
+    unfreezingI { obtain rfl := bundle.trivial.eq_trivialization B F e },
+    unfreezingI { obtain rfl := bundle.trivial.eq_trivialization B F e' },
+    simp_rw bundle.trivial.trivialization.coord_changeL,
+    exact smooth_const.smooth_on
+  end }
+
+/-! ### Direct sums of smooth vector bundles -/
+
+section prod
+variables (F₁ : Type*) [normed_add_comm_group F₁] [normed_space 𝕜 F₁]
+  (E₁ : B → Type*) [topological_space (total_space F₁ E₁)]
+  [Π x, add_comm_monoid (E₁ x)] [Π x, module 𝕜 (E₁ x)]
+
+variables (F₂ : Type*) [normed_add_comm_group F₂] [normed_space 𝕜 F₂]
+  (E₂ : B → Type*) [topological_space (total_space F₂ E₂)]
+  [Π x, add_comm_monoid (E₂ x)] [Π x, module 𝕜 (E₂ x)]
+
+variables [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
+  [fiber_bundle F₁ E₁] [fiber_bundle F₂ E₂]
+  [vector_bundle 𝕜 F₁ E₁] [vector_bundle 𝕜 F₂ E₂]
+  [smooth_vector_bundle F₁ E₁ IB] [smooth_vector_bundle F₂ E₂ IB]
+
+/-- The direct sum of two smooth vector bundles over the same base is a smooth vector bundle. -/
+instance bundle.prod.smooth_vector_bundle :
+  smooth_vector_bundle (F₁ × F₂) (E₁ ×ᵇ E₂) IB :=
+{ smooth_on_coord_change := begin
+    rintros _ _ ⟨e₁, e₂, i₁, i₂, rfl⟩ ⟨e₁', e₂', i₁', i₂', rfl⟩,
+    resetI,
+    rw [smooth_on],
+    refine cont_mdiff_on.congr _ (e₁.coord_changeL_prod 𝕜 e₁' e₂ e₂'),
+    refine cont_mdiff_on.clm_prod_map _ _,
+    { refine (smooth_on_coord_change e₁ e₁').mono _,
+      simp only [trivialization.base_set_prod] with mfld_simps,
+      mfld_set_tac },
+    { refine (smooth_on_coord_change e₂ e₂').mono _,
+      simp only [trivialization.base_set_prod] with mfld_simps,
+      mfld_set_tac },
+  end }
+
+end prod
+
+end with_topology
+
+/-! ### Prebundle construction for smooth vector bundles -/
+
+namespace vector_prebundle
+
+variables [∀ x, topological_space (E x)] {F E}
+
+/-- Mixin for a `vector_prebundle` stating smoothness of coordinate changes. -/
+class is_smooth (a : vector_prebundle 𝕜 F E) : Prop :=
+(exists_smooth_coord_change : ∀ (e e' ∈ a.pretrivialization_atlas), ∃ f : B → F →L[𝕜] F,
+  smooth_on IB 𝓘(𝕜, F →L[𝕜] F) f (e.base_set ∩ e'.base_set) ∧
+  ∀ (b : B) (hb : b ∈ e.base_set ∩ e'.base_set) (v : F), f b v = (e' ⟨b ,e.symm b v⟩).2)
+
+variables (a : vector_prebundle 𝕜 F E) [ha : a.is_smooth IB] {e e' : pretrivialization F (π F E)}
+include ha
+
+/-- A randomly chosen coordinate change on a `smooth_vector_prebundle`, given by
+  the field `exists_coord_change`. Note that `a.smooth_coord_change` need not be the same as
+  `a.coord_change`. -/
+noncomputable def smooth_coord_change (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) (b : B) : F →L[𝕜] F :=
+classical.some (ha.exists_smooth_coord_change e he e' he') b
+
+variables {IB}
+lemma smooth_on_smooth_coord_change (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) :
+  smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (a.smooth_coord_change IB he he') (e.base_set ∩ e'.base_set) :=
+(classical.some_spec (ha.exists_smooth_coord_change e he e' he')).1
+
+lemma smooth_coord_change_apply (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
+  a.smooth_coord_change IB he he' b v = (e' ⟨b, e.symm b v⟩).2 :=
+(classical.some_spec (ha.exists_smooth_coord_change e he e' he')).2 b hb v
+
+lemma mk_smooth_coord_change (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
+  (b, (a.smooth_coord_change IB he he' b v)) = e' ⟨b, e.symm b v⟩ :=
+begin
+  ext,
+  { rw [e.mk_symm hb.1 v, e'.coe_fst', e.proj_symm_apply' hb.1],
+    rw [e.proj_symm_apply' hb.1], exact hb.2 },
+  { exact a.smooth_coord_change_apply he he' hb v }
+end
+
+variables (IB)
+/-- Make a `smooth_vector_bundle` from a `smooth_vector_prebundle`.  -/
+lemma smooth_vector_bundle :
+  @smooth_vector_bundle _ _ F E _ _ _ _ _ _ IB _ _ _ _ _ _ _
+    a.total_space_topology _ a.to_fiber_bundle a.to_vector_bundle :=
+{ smooth_on_coord_change := begin
+    rintros _ _ ⟨e, he, rfl⟩ ⟨e', he', rfl⟩,
+    refine (a.smooth_on_smooth_coord_change he he').congr _,
+    intros b hb,
+    ext v,
+    rw [a.smooth_coord_change_apply he he' hb v, continuous_linear_equiv.coe_coe,
+      trivialization.coord_changeL_apply],
+    exacts [rfl, hb]
+  end }
+
+end vector_prebundle
diff --git a/src/geometry/manifold/vector_bundle/fiberwise_linear.lean b/src/geometry/manifold/vector_bundle/fiberwise_linear.lean
new file mode 100644
index 0000000000000..d2253f00b568d
--- /dev/null
+++ b/src/geometry/manifold/vector_bundle/fiberwise_linear.lean
@@ -0,0 +1,290 @@
+/-
+Copyright (c) 2022 Floris van Doorn, Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Heather Macbeth
+-/
+import geometry.manifold.cont_mdiff
+
+/-! # The groupoid of smooth, fiberwise-linear maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains preliminaries for the definition of a smooth vector bundle: an associated
+`structure_groupoid`, the groupoid of `smooth_fiberwise_linear` functions.
+-/
+
+noncomputable theory
+
+open set topological_space
+open_locale manifold topology
+
+/-! ### The groupoid of smooth, fiberwise-linear maps -/
+
+variables {𝕜 B F : Type*} [topological_space B]
+variables [nontrivially_normed_field 𝕜] [normed_add_comm_group F] [normed_space 𝕜 F]
+
+namespace fiberwise_linear
+
+variables {φ φ' : B → F ≃L[𝕜] F} {U U' : set B}
+
+/-- For `B` a topological space and `F` a `𝕜`-normed space, a map from `U : set B` to `F ≃L[𝕜] F`
+determines a local homeomorphism from `B × F` to itself by its action fiberwise. -/
+def local_homeomorph (φ : B → F ≃L[𝕜] F) (hU : is_open U)
+  (hφ : continuous_on (λ x, φ x : B → F →L[𝕜] F) U)
+  (h2φ : continuous_on (λ x, (φ x).symm : B → F →L[𝕜] F) U) :
+  local_homeomorph (B × F) (B × F) :=
+{ to_fun := λ x, (x.1, φ x.1 x.2),
+  inv_fun := λ x, (x.1, (φ x.1).symm x.2),
+  source := U ×ˢ univ,
+  target := U ×ˢ univ,
+  map_source' := λ x hx, mk_mem_prod hx.1 (mem_univ _),
+  map_target' := λ x hx, mk_mem_prod hx.1 (mem_univ _),
+  left_inv' := λ x _, prod.ext rfl (continuous_linear_equiv.symm_apply_apply _ _),
+  right_inv' := λ x _, prod.ext rfl (continuous_linear_equiv.apply_symm_apply _ _),
+  open_source := hU.prod is_open_univ,
+  open_target := hU.prod is_open_univ,
+  continuous_to_fun := begin
+    have : continuous_on (λ p : B × F, ((φ p.1 : F →L[𝕜] F), p.2)) (U ×ˢ univ),
+    { exact hφ.prod_map continuous_on_id },
+    exact continuous_on_fst.prod (is_bounded_bilinear_map_apply.continuous.comp_continuous_on this),
+  end,
+  continuous_inv_fun := begin
+    have : continuous_on (λ p : B × F, (((φ p.1).symm : F →L[𝕜] F), p.2)) (U ×ˢ univ),
+    { exact h2φ.prod_map continuous_on_id },
+    exact continuous_on_fst.prod (is_bounded_bilinear_map_apply.continuous.comp_continuous_on this),
+  end, }
+
+/-- Compute the composition of two local homeomorphisms induced by fiberwise linear
+equivalences. -/
+lemma trans_local_homeomorph_apply
+  (hU : is_open U)
+  (hφ : continuous_on (λ x, φ x : B → F →L[𝕜] F) U)
+  (h2φ : continuous_on (λ x, (φ x).symm : B → F →L[𝕜] F) U)
+  (hU' : is_open U')
+  (hφ' : continuous_on (λ x, φ' x : B → F →L[𝕜] F) U')
+  (h2φ' : continuous_on (λ x, (φ' x).symm : B → F →L[𝕜] F) U')
+  (b : B) (v : F) :
+  (fiberwise_linear.local_homeomorph φ hU hφ h2φ ≫ₕ
+    fiberwise_linear.local_homeomorph φ' hU' hφ' h2φ') ⟨b, v⟩ = ⟨b, φ' b (φ b v)⟩ :=
+rfl
+
+/-- Compute the source of the composition of two local homeomorphisms induced by fiberwise linear
+equivalences. -/
+lemma source_trans_local_homeomorph
+  (hU : is_open U)
+  (hφ : continuous_on (λ x, φ x : B → F →L[𝕜] F) U)
+  (h2φ : continuous_on (λ x, (φ x).symm : B → F →L[𝕜] F) U)
+  (hU' : is_open U')
+  (hφ' : continuous_on (λ x, φ' x : B → F →L[𝕜] F) U')
+  (h2φ' : continuous_on (λ x, (φ' x).symm : B → F →L[𝕜] F) U') :
+  (fiberwise_linear.local_homeomorph φ hU hφ h2φ ≫ₕ
+    fiberwise_linear.local_homeomorph φ' hU' hφ' h2φ').source = (U ∩ U') ×ˢ univ :=
+by { dsimp only [fiberwise_linear.local_homeomorph], mfld_set_tac }
+
+/-- Compute the target of the composition of two local homeomorphisms induced by fiberwise linear
+equivalences. -/
+lemma target_trans_local_homeomorph
+  (hU : is_open U)
+  (hφ : continuous_on (λ x, φ x : B → F →L[𝕜] F) U)
+  (h2φ : continuous_on (λ x, (φ x).symm : B → F →L[𝕜] F) U)
+  (hU' : is_open U')
+  (hφ' : continuous_on (λ x, φ' x : B → F →L[𝕜] F) U')
+  (h2φ' : continuous_on (λ x, (φ' x).symm : B → F →L[𝕜] F) U') :
+  (fiberwise_linear.local_homeomorph φ hU hφ h2φ ≫ₕ
+    fiberwise_linear.local_homeomorph φ' hU' hφ' h2φ').target = (U ∩ U') ×ˢ univ :=
+by { dsimp only [fiberwise_linear.local_homeomorph], mfld_set_tac }
+
+end fiberwise_linear
+
+variables {EB : Type*} [normed_add_comm_group EB] [normed_space 𝕜 EB]
+  {HB : Type*} [topological_space HB] [charted_space HB B] {IB : model_with_corners 𝕜 EB HB}
+
+/-- Let `e` be a local homeomorphism of `B × F`.  Suppose that at every point `p` in the source of
+`e`, there is some neighbourhood `s` of `p` on which `e` is equal to a bi-smooth fiberwise linear
+local homeomorphism.
+Then the source of `e` is of the form `U ×ˢ univ`, for some set `U` in `B`, and, at any point `x` in
+`U`, admits a neighbourhood `u` of `x` such that `e` is equal on `u ×ˢ univ` to some bi-smooth
+fiberwise linear local homeomorphism. -/
+lemma smooth_fiberwise_linear.locality_aux₁ (e : local_homeomorph (B × F) (B × F))
+  (h : ∀ p ∈ e.source, ∃ s : set (B × F), is_open s ∧ p ∈ s ∧
+    ∃ (φ : B → (F ≃L[𝕜] F)) (u : set B) (hu : is_open u)
+      (hφ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, (φ x : F →L[𝕜] F)) u)
+      (h2φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, ((φ x).symm : F →L[𝕜] F)) u),
+      (e.restr s).eq_on_source
+        (fiberwise_linear.local_homeomorph φ hu hφ.continuous_on h2φ.continuous_on)) :
+  ∃ (U : set B) (hU : e.source = U ×ˢ univ),
+  ∀ x ∈ U, ∃ (φ : B → (F ≃L[𝕜] F)) (u : set B) (hu : is_open u) (huU : u ⊆ U) (hux : x ∈ u)
+    (hφ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, (φ x : F →L[𝕜] F)) u)
+    (h2φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, ((φ x).symm : F →L[𝕜] F)) u),
+    (e.restr (u ×ˢ univ)).eq_on_source
+      (fiberwise_linear.local_homeomorph φ hu hφ.continuous_on h2φ.continuous_on) :=
+begin
+  rw [set_coe.forall'] at h,
+  -- choose s hs hsp φ u hu hφ h2φ heφ using h,
+  -- the following 2 lines should be `choose s hs hsp φ u hu hφ h2φ heφ using h,`
+  -- `choose` produces a proof term that takes a long time to type-check by the kernel (it seems)
+  -- porting note: todo: try using `choose` again in Lean 4
+  simp only [classical.skolem, ← exists_prop] at h,
+  rcases h with ⟨s, hs, hsp, φ, u, hu, hφ, h2φ, heφ⟩,
+  have hesu : ∀ p : e.source, e.source ∩ s p = u p ×ˢ univ,
+  { intros p,
+    rw ← e.restr_source' (s _) (hs _),
+    exact (heφ p).1 },
+  have hu' : ∀ p : e.source, (p : B × F).fst ∈ u p,
+  { intros p,
+    have : (p : B × F) ∈ e.source ∩ s p := ⟨p.prop, hsp p⟩,
+    simpa only [hesu, mem_prod, mem_univ, and_true] using this },
+  have heu : ∀ p : e.source, ∀ q : B × F, q.fst ∈ u p → q ∈ e.source,
+  { intros p q hq,
+    have : q ∈ u p ×ˢ (univ : set F) := ⟨hq, trivial⟩,
+    rw ← hesu p at this,
+    exact this.1 },
+  have he : e.source = (prod.fst '' e.source) ×ˢ (univ : set F),
+  { apply has_subset.subset.antisymm,
+    { intros p hp,
+      exact ⟨⟨p, hp, rfl⟩, trivial⟩ },
+    { rintros ⟨x, v⟩ ⟨⟨p, hp, rfl : p.fst = x⟩, -⟩,
+      exact heu ⟨p, hp⟩ (p.fst, v) (hu' ⟨p, hp⟩) } },
+  refine ⟨prod.fst '' e.source, he, _⟩,
+  rintros x ⟨p, hp, rfl⟩,
+  refine ⟨φ ⟨p, hp⟩, u ⟨p, hp⟩, hu ⟨p, hp⟩, _, hu' _, hφ ⟨p, hp⟩, h2φ ⟨p, hp⟩, _⟩,
+  { intros y hy, refine ⟨(y, 0), heu ⟨p, hp⟩ ⟨_, _⟩ hy, rfl⟩ },
+  { rw [← hesu, e.restr_source_inter], exact heφ ⟨p, hp⟩ },
+end
+
+/-- Let `e` be a local homeomorphism of `B × F` whose source is `U ×ˢ univ`, for some set `U` in
+`B`, and which, at any point `x` in `U`, admits a neighbourhood `u` of `x` such that `e` is equal on
+`u ×ˢ univ` to some bi-smooth fiberwise linear local homeomorphism.  Then `e` itself is equal to
+some bi-smooth fiberwise linear local homeomorphism.
+
+This is the key mathematical point of the `locality` condition in the construction of the
+`structure_groupoid` of bi-smooth fiberwise linear local homeomorphisms.  The proof is by gluing
+together the various bi-smooth fiberwise linear local homeomorphism which exist locally.
+
+The `U` in the conclusion is the same `U` as in the hypothesis. We state it like this, because this
+is exactly what we need for `smooth_fiberwise_linear`. -/
+lemma smooth_fiberwise_linear.locality_aux₂ (e : local_homeomorph (B × F) (B × F))
+  (U : set B) (hU : e.source = U ×ˢ univ)
+  (h : ∀ x ∈ U, ∃ (φ : B → (F ≃L[𝕜] F)) (u : set B) (hu : is_open u) (hUu : u ⊆ U) (hux : x ∈ u)
+    (hφ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, (φ x : F →L[𝕜] F)) u)
+    (h2φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, ((φ x).symm : F →L[𝕜] F)) u),
+    (e.restr (u ×ˢ univ)).eq_on_source
+      (fiberwise_linear.local_homeomorph φ hu hφ.continuous_on h2φ.continuous_on)) :
+  ∃ (Φ : B → (F ≃L[𝕜] F)) (U : set B) (hU₀ : is_open U)
+    (hΦ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, (Φ x : F →L[𝕜] F)) U)
+    (h2Φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, ((Φ x).symm : F →L[𝕜] F)) U),
+    e.eq_on_source (fiberwise_linear.local_homeomorph Φ hU₀ hΦ.continuous_on h2Φ.continuous_on) :=
+begin
+  classical,
+  rw set_coe.forall' at h,
+  choose! φ u hu hUu hux hφ h2φ heφ using h,
+  have heuφ : ∀ x : U, eq_on e (λ q, (q.1, φ x q.1 q.2)) (u x ×ˢ univ),
+  { intros x p hp,
+    refine (heφ x).2 _,
+    rw (heφ x).1,
+    exact hp },
+  have huφ : ∀ (x x' : U) (y : B) (hyx : y ∈ u x) (hyx' : y ∈ u x'), φ x y = φ x' y,
+  { intros p p' y hyp hyp',
+    ext v,
+    have h1 : e (y, v) = (y, φ p y v) := heuφ _ ⟨(id hyp : (y, v).fst ∈ u p), trivial⟩,
+    have h2 : e (y, v) = (y, φ p' y v) := heuφ _ ⟨(id hyp' : (y, v).fst ∈ u p'), trivial⟩,
+    exact congr_arg prod.snd (h1.symm.trans h2) },
+  have hUu' : U = ⋃ i, u i,
+  { ext x,
+    rw mem_Union,
+    refine ⟨λ h, ⟨⟨x, h⟩, hux _⟩, _⟩,
+    rintros ⟨x, hx⟩,
+    exact hUu x hx },
+  have hU' : is_open U,
+  { rw hUu',
+    apply is_open_Union hu },
+  let Φ₀ : U → F ≃L[𝕜] F := Union_lift u (λ x, (φ x) ∘ coe) huφ U hUu'.le,
+  let Φ : B → F ≃L[𝕜] F := λ y, if hy : y ∈ U then Φ₀ ⟨y, hy⟩ else continuous_linear_equiv.refl 𝕜 F,
+  have hΦ : ∀ (y) (hy : y ∈ U), Φ y = Φ₀ ⟨y, hy⟩ := λ y hy, dif_pos hy,
+  have hΦφ : ∀ x : U, ∀ y ∈ u x, Φ y = φ x y,
+  { intros x y hyu,
+    refine (hΦ y (hUu x hyu)).trans _,
+    exact Union_lift_mk ⟨y, hyu⟩ _ },
+  have hΦ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ y, (Φ y : F →L[𝕜] F)) U,
+  { apply cont_mdiff_on_of_locally_cont_mdiff_on,
+    intros x hx,
+    refine ⟨u ⟨x, hx⟩, hu ⟨x, hx⟩, hux _, _⟩,
+    refine (cont_mdiff_on.congr (hφ ⟨x, hx⟩) _).mono (inter_subset_right _ _),
+    intros y hy,
+    rw hΦφ ⟨x, hx⟩ y hy },
+  have h2Φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ y, ((Φ y).symm : F →L[𝕜] F)) U,
+  { apply cont_mdiff_on_of_locally_cont_mdiff_on,
+    intros x hx,
+    refine ⟨u ⟨x, hx⟩, hu ⟨x, hx⟩, hux _, _⟩,
+    refine (cont_mdiff_on.congr (h2φ ⟨x, hx⟩) _).mono (inter_subset_right _ _),
+    intros y hy,
+    rw hΦφ ⟨x, hx⟩ y hy },
+  refine ⟨Φ, U, hU', hΦ, h2Φ, hU, λ p hp, _⟩,
+  rw [hU] at hp,
+  -- using rw on the next line seems to cause a timeout in kernel type-checking
+  refine (heuφ ⟨p.fst, hp.1⟩ ⟨hux _, hp.2⟩).trans _,
+  congrm (_, _),
+  rw hΦφ,
+  apply hux
+end
+
+variables (F B IB)
+/-- For `B` a manifold and `F` a normed space, the groupoid on `B × F` consisting of local
+homeomorphisms which are bi-smooth and fiberwise linear, and induce the identity on `B`.
+When a (topological) vector bundle is smooth, then the composition of charts associated
+to the vector bundle belong to this groupoid. -/
+def smooth_fiberwise_linear : structure_groupoid (B × F) :=
+{ members := ⋃ (φ : B → F ≃L[𝕜] F) (U : set B) (hU : is_open U)
+  (hφ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, φ x : B → F →L[𝕜] F) U)
+  (h2φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, (φ x).symm : B → F →L[𝕜] F) U),
+  {e | e.eq_on_source (fiberwise_linear.local_homeomorph φ hU hφ.continuous_on h2φ.continuous_on)},
+  trans' := begin
+    simp_rw [mem_Union],
+    rintros e e' ⟨φ, U, hU, hφ, h2φ, heφ⟩ ⟨φ', U', hU', hφ', h2φ', heφ'⟩,
+    refine ⟨λ b, (φ b).trans (φ' b), _, hU.inter hU', _, _, setoid.trans (heφ.trans' heφ') ⟨_, _⟩⟩,
+    { show smooth_on IB 𝓘(𝕜, F →L[𝕜] F)
+        (λ (x : B), (φ' x).to_continuous_linear_map ∘L (φ x).to_continuous_linear_map) (U ∩ U'),
+      exact (hφ'.mono $ inter_subset_right _ _).clm_comp (hφ.mono $ inter_subset_left _ _) },
+    { show smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ (x : B),
+        (φ x).symm.to_continuous_linear_map ∘L (φ' x).symm.to_continuous_linear_map) (U ∩ U'),
+      exact (h2φ.mono $ inter_subset_left _ _).clm_comp (h2φ'.mono $ inter_subset_right _ _) },
+    { apply fiberwise_linear.source_trans_local_homeomorph },
+    { rintros ⟨b, v⟩ hb, apply fiberwise_linear.trans_local_homeomorph_apply }
+  end,
+  symm' := begin
+    simp_rw [mem_Union],
+    rintros e ⟨φ, U, hU, hφ, h2φ, heφ⟩,
+    refine ⟨λ b, (φ b).symm, U, hU, h2φ, _, heφ.symm'⟩,
+    simp_rw continuous_linear_equiv.symm_symm,
+    exact hφ
+  end,
+  id_mem' := begin
+    simp_rw [mem_Union],
+    refine ⟨λ b, continuous_linear_equiv.refl 𝕜 F, univ, is_open_univ, _, _, ⟨_, λ b hb, _⟩⟩,
+    { apply cont_mdiff_on_const },
+    { apply cont_mdiff_on_const },
+    { simp only [fiberwise_linear.local_homeomorph, local_homeomorph.refl_local_equiv,
+        local_equiv.refl_source, univ_prod_univ] },
+    { simp only [fiberwise_linear.local_homeomorph, local_homeomorph.refl_apply, prod.mk.eta,
+        id.def, continuous_linear_equiv.coe_refl', local_homeomorph.mk_coe, local_equiv.coe_mk] },
+  end,
+  locality' := begin -- the hard work has been extracted to `locality_aux₁` and `locality_aux₂`
+    simp_rw [mem_Union],
+    intros e he,
+    obtain ⟨U, hU, h⟩ := smooth_fiberwise_linear.locality_aux₁ e he,
+    exact smooth_fiberwise_linear.locality_aux₂ e U hU h,
+  end,
+  eq_on_source' := begin
+    simp_rw [mem_Union],
+    rintros e e' ⟨φ, U, hU, hφ, h2φ, heφ⟩ hee',
+    exact ⟨φ, U, hU, hφ, h2φ, setoid.trans hee' heφ⟩,
+  end }
+
+@[simp] lemma mem_smooth_fiberwise_linear_iff (e : local_homeomorph (B × F) (B × F)) :
+  e ∈ smooth_fiberwise_linear B F IB ↔
+  ∃ (φ : B → F ≃L[𝕜] F) (U : set B) (hU : is_open U)
+  (hφ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, φ x : B → F →L[𝕜] F) U)
+  (h2φ : smooth_on IB 𝓘(𝕜, F →L[𝕜] F) (λ x, (φ x).symm : B → F →L[𝕜] F) U),
+  e.eq_on_source (fiberwise_linear.local_homeomorph φ hU hφ.continuous_on h2φ.continuous_on) :=
+show e ∈ set.Union _ ↔ _, by { simp only [mem_Union], refl }
diff --git a/src/geometry/manifold/vector_bundle/hom.lean b/src/geometry/manifold/vector_bundle/hom.lean
new file mode 100644
index 0000000000000..ef6b4079edcfb
--- /dev/null
+++ b/src/geometry/manifold/vector_bundle/hom.lean
@@ -0,0 +1,118 @@
+/-
+Copyright (c) 2022 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import geometry.manifold.vector_bundle.basic
+import topology.vector_bundle.hom
+
+/-! # Homs of smooth vector bundles over the same base space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Here we show that `bundle.continuous_linear_map` is a smooth vector bundle.
+
+Note that we only do this for bundles of linear maps, not for bundles of arbitrary semilinear maps.
+To do it for semilinear maps, we would need to generalize `continuous_linear_map.cont_mdiff`
+(and `continuous_linear_map.cont_diff`) to semilinear maps.
+-/
+
+noncomputable theory
+
+open bundle set local_homeomorph continuous_linear_map pretrivialization
+open_locale manifold bundle
+
+variables {𝕜 B F F₁ F₂ M M₁ M₂ : Type*}
+  {E : B → Type*} {E₁ : B → Type*} {E₂ : B → Type*}
+  [nontrivially_normed_field 𝕜]
+  [∀ x, add_comm_group (E x)] [∀ x, module 𝕜 (E x)]
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  [topological_space (total_space F E)] [∀ x, topological_space (E x)]
+  [∀ x, add_comm_group (E₁ x)] [∀ x, module 𝕜 (E₁ x)]
+  [normed_add_comm_group F₁] [normed_space 𝕜 F₁]
+  [topological_space (total_space F₁ E₁)] [∀ x, topological_space (E₁ x)]
+  [∀ x, add_comm_group (E₂ x)] [∀ x, module 𝕜 (E₂ x)]
+  [normed_add_comm_group F₂] [normed_space 𝕜 F₂]
+  [topological_space (total_space F₂ E₂)] [∀ x, topological_space (E₂ x)]
+  [_i₁ : ∀ x, topological_add_group (E₂ x)] [_i₂ : ∀ x, has_continuous_smul 𝕜 (E₂ x)]
+
+  {EB : Type*} [normed_add_comm_group EB] [normed_space 𝕜 EB]
+  {HB : Type*} [topological_space HB] (IB : model_with_corners 𝕜 EB HB)
+  [topological_space B] [charted_space HB B]
+  {EM : Type*} [normed_add_comm_group EM] [normed_space 𝕜 EM]
+  {HM : Type*} [topological_space HM] {IM : model_with_corners 𝕜 EM HM}
+  [topological_space M] [charted_space HM M] [Is : smooth_manifold_with_corners IM M]
+  {n : ℕ∞}
+  [fiber_bundle F₁ E₁] [vector_bundle 𝕜 F₁ E₁]
+  [fiber_bundle F₂ E₂] [vector_bundle 𝕜 F₂ E₂]
+  {e₁ e₁' : trivialization F₁ (π F₁ E₁)} {e₂ e₂' : trivialization F₂ (π F₂ E₂)}
+
+local notation `LE₁E₂` := total_space (F₁ →L[𝕜] F₂)
+  (bundle.continuous_linear_map (ring_hom.id 𝕜) E₁ E₂)
+
+/- This proof is slow, especially the `simp only` and the elaboration of `h₂`. -/
+lemma smooth_on_continuous_linear_map_coord_change
+  [smooth_manifold_with_corners IB B]
+  [smooth_vector_bundle F₁ E₁ IB] [smooth_vector_bundle F₂ E₂ IB]
+  [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₁']
+  [mem_trivialization_atlas e₂] [mem_trivialization_atlas e₂'] :
+  smooth_on IB 𝓘(𝕜, ((F₁ →L[𝕜] F₂) →L[𝕜] (F₁ →L[𝕜] F₂)))
+    (continuous_linear_map_coord_change (ring_hom.id 𝕜) e₁ e₁' e₂ e₂')
+    ((e₁.base_set ∩ e₂.base_set) ∩ (e₁'.base_set ∩ e₂'.base_set)) :=
+begin
+  let L₁ := compL 𝕜 F₁ F₂ F₂,
+  have h₁ : smooth _ _ _ := L₁.cont_mdiff,
+  have h₂ : smooth _ _ _ := (continuous_linear_map.flip (compL 𝕜 F₁ F₁ F₂)).cont_mdiff,
+  have h₃ : smooth_on IB _ _ _ := smooth_on_coord_change e₁' e₁,
+  have h₄ : smooth_on IB _ _ _ := smooth_on_coord_change e₂ e₂',
+  refine ((h₁.comp_smooth_on (h₄.mono _)).clm_comp (h₂.comp_smooth_on (h₃.mono _))).congr _,
+  { mfld_set_tac },
+  { mfld_set_tac },
+  { intros b hb, ext L v,
+    simp only [continuous_linear_map_coord_change, continuous_linear_equiv.coe_coe,
+      continuous_linear_equiv.arrow_congrSL_apply, comp_apply, function.comp, compL_apply,
+      flip_apply, continuous_linear_equiv.symm_symm, linear_equiv.to_fun_eq_coe,
+      continuous_linear_map.coe_comp'] },
+end
+
+include _i₁ _i₂
+
+lemma hom_chart (y₀ y : LE₁E₂) :
+  chart_at (model_prod HB (F₁ →L[𝕜] F₂)) y₀ y =
+  (chart_at HB y₀.1 y.1, in_coordinates F₁ E₁ F₂ E₂ y₀.1 y.1 y₀.1 y.1 y.2) :=
+by simp_rw [fiber_bundle.charted_space_chart_at, trans_apply, local_homeomorph.prod_apply,
+  trivialization.coe_coe, local_homeomorph.refl_apply, function.id_def, hom_trivialization_at_apply]
+
+variables {IB}
+
+lemma cont_mdiff_at_hom_bundle (f : M → LE₁E₂) {x₀ : M} {n : ℕ∞} :
+  cont_mdiff_at IM (IB.prod 𝓘(𝕜, F₁ →L[𝕜] F₂)) n f x₀ ↔
+  cont_mdiff_at IM IB n (λ x, (f x).1) x₀ ∧
+  cont_mdiff_at IM 𝓘(𝕜, F₁ →L[𝕜] F₂) n
+  (λ x, in_coordinates F₁ E₁ F₂ E₂ (f x₀).1 (f x).1 (f x₀).1 (f x).1 (f x).2) x₀ :=
+by apply cont_mdiff_at_total_space
+
+lemma smooth_at_hom_bundle (f : M → LE₁E₂) {x₀ : M} :
+  smooth_at IM (IB.prod 𝓘(𝕜, F₁ →L[𝕜] F₂)) f x₀ ↔
+  smooth_at IM IB (λ x, (f x).1) x₀ ∧
+  smooth_at IM 𝓘(𝕜, F₁ →L[𝕜] F₂)
+  (λ x, in_coordinates F₁ E₁ F₂ E₂ (f x₀).1 (f x).1 (f x₀).1 (f x).1 (f x).2) x₀ :=
+cont_mdiff_at_hom_bundle f
+
+variables [smooth_manifold_with_corners IB B]
+  [smooth_vector_bundle F₁ E₁ IB] [smooth_vector_bundle F₂ E₂ IB]
+
+instance bundle.continuous_linear_map.vector_prebundle.is_smooth :
+  (bundle.continuous_linear_map.vector_prebundle (ring_hom.id 𝕜) F₁ E₁ F₂ E₂).is_smooth IB :=
+{ exists_smooth_coord_change := begin
+    rintro _ ⟨e₁, e₂, he₁, he₂, rfl⟩ _ ⟨e₁', e₂', he₁', he₂', rfl⟩,
+    resetI,
+    refine ⟨continuous_linear_map_coord_change (ring_hom.id 𝕜) e₁ e₁' e₂ e₂',
+      smooth_on_continuous_linear_map_coord_change IB,
+      continuous_linear_map_coord_change_apply (ring_hom.id 𝕜) e₁ e₁' e₂ e₂'⟩
+  end }
+
+instance smooth_vector_bundle.continuous_linear_map :
+  smooth_vector_bundle (F₁ →L[𝕜] F₂) (bundle.continuous_linear_map (ring_hom.id 𝕜) E₁ E₂) IB :=
+(bundle.continuous_linear_map.vector_prebundle (ring_hom.id 𝕜) F₁ E₁ F₂ E₂).smooth_vector_bundle IB
diff --git a/src/geometry/manifold/vector_bundle/pullback.lean b/src/geometry/manifold/vector_bundle/pullback.lean
new file mode 100644
index 0000000000000..a68fa9c52a52a
--- /dev/null
+++ b/src/geometry/manifold/vector_bundle/pullback.lean
@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2023 Floris van Doorn, Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Heather Macbeth
+-/
+import geometry.manifold.cont_mdiff_map
+import geometry.manifold.vector_bundle.basic
+
+/-! # Pullbacks of smooth vector bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines pullbacks of smooth vector bundles over a smooth manifold.
+
+## Main definitions
+
+* `smooth_vector_bundle.pullback`: For a smooth vector bundle `E` over a manifold `B` and a smooth
+  map `f : B' → B`, the pullback vector bundle `f *ᵖ E` is a smooth vector bundle.
+
+-/
+
+open bundle set
+open_locale manifold
+
+variables {𝕜 B B' M : Type*} (F : Type*) (E : B → Type*)
+
+variables [nontrivially_normed_field 𝕜] [∀ x, add_comm_monoid (E x)] [∀ x, module 𝕜 (E x)]
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  [topological_space (total_space F E)] [∀ x, topological_space (E x)]
+
+  {EB : Type*} [normed_add_comm_group EB] [normed_space 𝕜 EB]
+  {HB : Type*} [topological_space HB] (IB : model_with_corners 𝕜 EB HB)
+  [topological_space B] [charted_space HB B] [smooth_manifold_with_corners IB B]
+  {EB' : Type*} [normed_add_comm_group EB'] [normed_space 𝕜 EB']
+  {HB' : Type*} [topological_space HB'] (IB' : model_with_corners 𝕜 EB' HB')
+  [topological_space B'] [charted_space HB' B'] [smooth_manifold_with_corners IB' B']
+  [fiber_bundle F E] [vector_bundle 𝕜 F E] [smooth_vector_bundle F E IB]
+  (f : smooth_map IB' IB B' B)
+
+/-- For a smooth vector bundle `E` over a manifold `B` and a smooth map `f : B' → B`, the pullback
+vector bundle `f *ᵖ E` is a smooth vector bundle. -/
+instance smooth_vector_bundle.pullback : smooth_vector_bundle F (f *ᵖ E) IB' :=
+{ smooth_on_coord_change := begin
+    rintro _ _ ⟨e, he, rfl⟩ ⟨e', he', rfl⟩, resetI,
+    refine ((smooth_on_coord_change e e').comp f.smooth.smooth_on
+      (λ b hb, hb)).congr _,
+    rintro b (hb : f b ∈ e.base_set ∩ e'.base_set), ext v,
+    show ((e.pullback f).coord_changeL 𝕜 (e'.pullback f) b) v = (e.coord_changeL 𝕜 e' (f b)) v,
+    rw [e.coord_changeL_apply e' hb, (e.pullback f).coord_changeL_apply' _],
+    exacts [rfl, hb]
+  end }
diff --git a/src/geometry/manifold/vector_bundle/smooth_section.lean b/src/geometry/manifold/vector_bundle/smooth_section.lean
new file mode 100644
index 0000000000000..d6c5115c08f70
--- /dev/null
+++ b/src/geometry/manifold/vector_bundle/smooth_section.lean
@@ -0,0 +1,213 @@
+/-
+Copyright © 2023 Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Heather Macbeth, Floris van Doorn
+-/
+
+import geometry.manifold.cont_mdiff_mfderiv
+import topology.continuous_function.basic
+import geometry.manifold.algebra.lie_group
+
+/-!
+# Smooth sections
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define the type `cont_mdiff_section` of `n` times continuously differentiable
+sections of a smooth vector bundle over a manifold `M` and prove that it's a module.
+-/
+open bundle filter function
+open_locale bundle manifold
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
+{H : Type*} [topological_space H]
+{H' : Type*} [topological_space H']
+(I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
+{M : Type*} [topological_space M] [charted_space H M]
+{M' : Type*} [topological_space M'] [charted_space H' M']
+{E'' : Type*} [normed_add_comm_group E''] [normed_space 𝕜 E'']
+{H'' : Type*} [topological_space H'']
+{I'' : model_with_corners 𝕜 E'' H''}
+{M'' : Type*} [topological_space M''] [charted_space H'' M'']
+[smooth_manifold_with_corners I M]
+
+
+variables (F : Type*) [normed_add_comm_group F] [normed_space 𝕜 F] -- `F` model fiber
+  (n : ℕ∞)
+  (V : M → Type*) [topological_space (total_space F V)] -- `V` vector bundle
+  [Π x, add_comm_group (V x)] [Π x, module 𝕜 (V x)]
+variables [Π x : M, topological_space (V x)]
+  [fiber_bundle F V]
+  [vector_bundle 𝕜 F V]
+  [smooth_vector_bundle F V I]
+
+/-- Bundled `n` times continuously differentiable sections of a vector bundle. -/
+@[protect_proj]
+structure cont_mdiff_section :=
+(to_fun            : Π x, V x)
+(cont_mdiff_to_fun : cont_mdiff I (I.prod 𝓘(𝕜, F)) n (λ x, total_space.mk' F x (to_fun x)))
+
+/-- Bundled smooth sections of a vector bundle. -/
+@[reducible] def smooth_section := cont_mdiff_section I F ⊤ V
+
+localized "notation (name := cont_mdiff_section) `Cₛ^` n `⟮` I `; ` F `, ` V `⟯` :=
+  cont_mdiff_section I F n V" in manifold
+
+namespace cont_mdiff_section
+
+variables {I} {I'} {n} {F} {V}
+
+instance : has_coe_to_fun Cₛ^n⟮I; F, V⟯ (λ s, Π x, V x) := ⟨cont_mdiff_section.to_fun⟩
+
+variables {s t : Cₛ^n⟮I; F, V⟯}
+
+@[simp] lemma coe_fn_mk (s : Π x, V x)
+  (hs : cont_mdiff I (I.prod 𝓘(𝕜, F)) n (λ x, total_space.mk x (s x))) :
+  (mk s hs : Π x, V x) = s :=
+rfl
+
+protected lemma cont_mdiff (s : Cₛ^n⟮I; F, V⟯) :
+  cont_mdiff I (I.prod 𝓘(𝕜, F)) n (λ x, total_space.mk' F x (s x : V x)) := s.cont_mdiff_to_fun
+
+protected lemma smooth (s : Cₛ^∞⟮I; F, V⟯) :
+  smooth I (I.prod 𝓘(𝕜, F)) (λ x, total_space.mk' F x (s x : V x)) := s.cont_mdiff_to_fun
+
+protected lemma mdifferentiable' (s : Cₛ^n⟮I; F, V⟯) (hn : 1 ≤ n) :
+  mdifferentiable I (I.prod 𝓘(𝕜, F)) (λ x, total_space.mk' F x (s x : V x)) :=
+s.cont_mdiff.mdifferentiable hn
+
+protected lemma mdifferentiable (s : Cₛ^∞⟮I; F, V⟯) :
+  mdifferentiable I (I.prod 𝓘(𝕜, F)) (λ x, total_space.mk' F x (s x : V x)) :=
+s.cont_mdiff.mdifferentiable le_top
+
+protected lemma mdifferentiable_at (s : Cₛ^∞⟮I; F, V⟯) {x} :
+  mdifferentiable_at I (I.prod 𝓘(𝕜, F)) (λ x, total_space.mk' F x (s x : V x)) x :=
+s.mdifferentiable x
+
+lemma coe_inj ⦃s t : Cₛ^n⟮I; F, V⟯⦄ (h : (s : Π x, V x) = t) : s = t :=
+by cases s; cases t; cases h; refl
+
+lemma coe_injective : injective (coe_fn : Cₛ^n⟮I; F, V⟯ → Π x, V x) :=
+coe_inj
+
+@[ext] theorem ext (h : ∀ x, s x = t x) : s = t :=
+by cases s; cases t; congr'; exact funext h
+
+instance has_add : has_add Cₛ^n⟮I; F, V⟯ :=
+begin
+  refine ⟨λ s t, ⟨s + t, _⟩⟩,
+  intro x₀,
+  have hs := s.cont_mdiff x₀,
+  have ht := t.cont_mdiff x₀,
+  rw [cont_mdiff_at_section] at hs ht ⊢,
+  set e := trivialization_at F V x₀,
+  refine (hs.add ht).congr_of_eventually_eq _,
+  refine eventually_of_mem (e.open_base_set.mem_nhds $ mem_base_set_trivialization_at F V x₀) _,
+  intros x hx,
+  apply (e.linear 𝕜 hx).1,
+end
+
+@[simp]
+lemma coe_add (s t : Cₛ^n⟮I; F, V⟯) : ⇑(s + t) = s + t := rfl
+
+instance has_sub : has_sub Cₛ^n⟮I; F, V⟯ :=
+begin
+  refine ⟨λ s t, ⟨s - t, _⟩⟩,
+  intro x₀,
+  have hs := s.cont_mdiff x₀,
+  have ht := t.cont_mdiff x₀,
+  rw [cont_mdiff_at_section] at hs ht ⊢,
+  set e := trivialization_at F V x₀,
+  refine (hs.sub ht).congr_of_eventually_eq _,
+  refine eventually_of_mem (e.open_base_set.mem_nhds $ mem_base_set_trivialization_at F V x₀) _,
+  intros x hx,
+  apply (e.linear 𝕜 hx).map_sub,
+end
+
+@[simp]
+lemma coe_sub (s t : Cₛ^n⟮I; F, V⟯) : ⇑(s - t) = s - t := rfl
+
+instance has_zero : has_zero Cₛ^n⟮I; F, V⟯ :=
+⟨⟨λ x, 0, (smooth_zero_section 𝕜 V).of_le le_top⟩⟩
+
+instance inhabited : inhabited Cₛ^n⟮I; F, V⟯ := ⟨0⟩
+
+@[simp]
+lemma coe_zero : ⇑(0 : Cₛ^n⟮I; F, V⟯) = 0 := rfl
+
+instance has_smul : has_smul 𝕜 Cₛ^n⟮I; F, V⟯ :=
+begin
+  refine ⟨λ c s, ⟨c • s, _⟩⟩,
+  intro x₀,
+  have hs := s.cont_mdiff x₀,
+  rw [cont_mdiff_at_section] at hs ⊢,
+  set e := trivialization_at F V x₀,
+  refine (cont_mdiff_at_const.smul hs).congr_of_eventually_eq _,
+  { exact c },
+  refine eventually_of_mem (e.open_base_set.mem_nhds $ mem_base_set_trivialization_at F V x₀) _,
+  intros x hx,
+  apply (e.linear 𝕜 hx).2,
+end
+
+@[simp]
+lemma coe_smul (r : 𝕜) (s : Cₛ^n⟮I; F, V⟯) : ⇑(r • s : Cₛ^n⟮I; F, V⟯) = r • s := rfl
+
+instance has_neg : has_neg Cₛ^n⟮I; F, V⟯ :=
+begin
+  refine ⟨λ s, ⟨- s, _⟩⟩,
+  intro x₀,
+  have hs := s.cont_mdiff x₀,
+  rw [cont_mdiff_at_section] at hs ⊢,
+  set e := trivialization_at F V x₀,
+  refine hs.neg.congr_of_eventually_eq _,
+  refine eventually_of_mem (e.open_base_set.mem_nhds $ mem_base_set_trivialization_at F V x₀) _,
+  intros x hx,
+  apply (e.linear 𝕜 hx).map_neg
+end
+
+@[simp]
+lemma coe_neg (s : Cₛ^n⟮I; F, V⟯) : ⇑(- s : Cₛ^n⟮I; F, V⟯) = - s := rfl
+
+instance has_nsmul : has_smul ℕ Cₛ^n⟮I; F, V⟯ :=
+⟨nsmul_rec⟩
+
+@[simp]
+lemma coe_nsmul (s : Cₛ^n⟮I; F, V⟯) (k : ℕ) : ⇑(k • s : Cₛ^n⟮I; F, V⟯) = k • s :=
+begin
+  induction k with k ih,
+  { simp_rw [zero_smul], refl },
+  simp_rw [succ_nsmul, ← ih], refl,
+end
+
+instance has_zsmul : has_smul ℤ Cₛ^n⟮I; F, V⟯ :=
+⟨zsmul_rec⟩
+
+@[simp]
+lemma coe_zsmul (s : Cₛ^n⟮I; F, V⟯) (z : ℤ) : ⇑(z • s : Cₛ^n⟮I; F, V⟯) = z • s :=
+begin
+  cases z with n n,
+  refine (coe_nsmul s n).trans _,
+  simp only [int.of_nat_eq_coe, coe_nat_zsmul],
+  refine (congr_arg has_neg.neg (coe_nsmul s (n+1))).trans _,
+  simp only [zsmul_neg_succ_of_nat, neg_inj]
+end
+
+instance add_comm_group : add_comm_group Cₛ^n⟮I; F, V⟯ :=
+coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub coe_nsmul coe_zsmul
+
+variables (I F V n)
+/-- The additive morphism from smooth sections to dependent maps. -/
+def coe_add_hom : Cₛ^n⟮I; F, V⟯ →+ Π x, V x :=
+{ to_fun := coe_fn,
+  map_zero' := coe_zero,
+  map_add' := coe_add }
+
+variables {I F V n}
+
+instance module : module 𝕜 Cₛ^n⟮I; F, V⟯ :=
+coe_injective.module 𝕜 (coe_add_hom I F n V) coe_smul
+
+end cont_mdiff_section
diff --git a/src/geometry/manifold/vector_bundle/tangent.lean b/src/geometry/manifold/vector_bundle/tangent.lean
new file mode 100644
index 0000000000000..491f7107ff786
--- /dev/null
+++ b/src/geometry/manifold/vector_bundle/tangent.lean
@@ -0,0 +1,407 @@
+/-
+Copyright (c) 2022 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Heather Macbeth
+-/
+
+import geometry.manifold.vector_bundle.basic
+
+/-! # Tangent bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the tangent bundle as a smooth vector bundle.
+
+Let `M` be a smooth manifold with corners with model `I` on `(E, H)`. We define the tangent bundle
+of `M` using the `vector_bundle_core` construction indexed by the charts of `M` with fibers `E`.
+Given two charts `i, j : local_homeomorph M H`, the coordinate change between `i` and `j` at a point
+`x : M` is the derivative of the composite
+```
+  I.symm   i.symm    j     I
+E -----> H -----> M --> H --> E
+```
+within the set `range I ⊆ E` at `I (i x) : E`.
+This defines a smooth vector bundle `tangent_bundle` with fibers `tangent_space`.
+
+## Main definitions
+
+* `tangent_space I M x` is the fiber of the tangent bundle at `x : M`, which is defined to be `E`.
+
+* `tangent_bundle I M` is the total space of `tangent_space I M`, proven to be a smooth vector
+  bundle.
+-/
+
+open bundle set smooth_manifold_with_corners local_homeomorph continuous_linear_map
+open_locale manifold topology bundle
+
+noncomputable theory
+
+section general
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+{E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+{E' : Type*} [normed_add_comm_group E'] [normed_space 𝕜 E']
+{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
+{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
+{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
+{M' : Type*} [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
+{F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+
+variables (I)
+
+/-- Auxiliary lemma for tangent spaces: the derivative of a coordinate change between two charts is
+  smooth on its source. -/
+lemma cont_diff_on_fderiv_coord_change (i j : atlas H M) :
+  cont_diff_on 𝕜 ∞ (fderiv_within 𝕜 (j.1.extend I ∘ (i.1.extend I).symm) (range I))
+    ((i.1.extend I).symm ≫ j.1.extend I).source :=
+begin
+  have h : ((i.1.extend I).symm ≫ j.1.extend I).source ⊆ range I,
+  { rw [i.1.extend_coord_change_source], apply image_subset_range },
+  intros x hx,
+  refine (cont_diff_within_at.fderiv_within_right _ I.unique_diff le_top $ h hx).mono h,
+  refine (local_homeomorph.cont_diff_on_extend_coord_change I (subset_maximal_atlas I j.2)
+    (subset_maximal_atlas I i.2) x hx).mono_of_mem _,
+  exact i.1.extend_coord_change_source_mem_nhds_within j.1 I hx
+end
+
+variables (M)
+open smooth_manifold_with_corners
+
+/--
+Let `M` be a smooth manifold with corners with model `I` on `(E, H)`.
+Then `vector_bundle_core I M` is the vector bundle core for the tangent bundle over `M`.
+It is indexed by the atlas of `M`, with fiber `E` and its change of coordinates from the chart `i`
+to the chart `j` at point `x : M` is the derivative of the composite
+```
+  I.symm   i.symm    j     I
+E -----> H -----> M --> H --> E
+```
+within the set `range I ⊆ E` at `I (i x) : E`. -/
+@[simps] def tangent_bundle_core : vector_bundle_core 𝕜 M E (atlas H M) :=
+{ base_set := λ i, i.1.source,
+  is_open_base_set := λ i, i.1.open_source,
+  index_at := achart H,
+  mem_base_set_at := mem_chart_source H,
+  coord_change := λ i j x, fderiv_within 𝕜 (j.1.extend I ∘ (i.1.extend I).symm) (range I)
+    (i.1.extend I x),
+  coord_change_self := λ i x hx v, begin
+    rw [filter.eventually_eq.fderiv_within_eq, fderiv_within_id', continuous_linear_map.id_apply],
+    { exact I.unique_diff_at_image },
+    { filter_upwards [i.1.extend_target_mem_nhds_within I hx] with y hy,
+      exact (i.1.extend I).right_inv hy },
+    { simp_rw [function.comp_apply, i.1.extend_left_inv I hx] }
+  end,
+  continuous_on_coord_change := λ i j, begin
+      refine (cont_diff_on_fderiv_coord_change I i j).continuous_on.comp
+        ((i.1.continuous_on_extend I).mono _) _,
+      { rw [i.1.extend_source], exact inter_subset_left _ _ },
+      simp_rw [← i.1.extend_image_source_inter, maps_to_image]
+    end,
+  coord_change_comp := begin
+    rintro i j k x ⟨⟨hxi, hxj⟩, hxk⟩ v,
+    rw [fderiv_within_fderiv_within, filter.eventually_eq.fderiv_within_eq],
+    { have := i.1.extend_preimage_mem_nhds I hxi (j.1.extend_source_mem_nhds I hxj),
+      filter_upwards [nhds_within_le_nhds this] with y hy,
+      simp_rw [function.comp_apply, (j.1.extend I).left_inv hy] },
+    { simp_rw [function.comp_apply, i.1.extend_left_inv I hxi, j.1.extend_left_inv I hxj] },
+    { exact (cont_diff_within_at_extend_coord_change' I (subset_maximal_atlas I k.2)
+        (subset_maximal_atlas I j.2) hxk hxj).differentiable_within_at le_top },
+    { exact (cont_diff_within_at_extend_coord_change' I (subset_maximal_atlas I j.2)
+        (subset_maximal_atlas I i.2) hxj hxi).differentiable_within_at le_top },
+    { intros x hx, exact mem_range_self _ },
+    { exact I.unique_diff_at_image },
+    { rw [function.comp_apply, i.1.extend_left_inv I hxi] }
+  end }
+
+variables {M}
+
+lemma tangent_bundle_core_coord_change_achart (x x' z : M) :
+  (tangent_bundle_core I M).coord_change (achart H x) (achart H x') z =
+  fderiv_within 𝕜 (ext_chart_at I x' ∘ (ext_chart_at I x).symm) (range I) (ext_chart_at I x z) :=
+rfl
+
+include I
+
+/-- The tangent space at a point of the manifold `M`. It is just `E`. We could use instead
+`(tangent_bundle_core I M).to_topological_vector_bundle_core.fiber x`, but we use `E` to help the
+kernel.
+-/
+@[nolint unused_arguments, derive [topological_space, add_comm_group, topological_add_group]]
+def tangent_space (x : M) : Type* := E
+
+omit I
+variable (M)
+
+/-- The tangent bundle to a smooth manifold, as a Sigma type. Defined in terms of
+`bundle.total_space` to be able to put a suitable topology on it. -/
+@[nolint has_nonempty_instance, reducible] -- is empty if the base manifold is empty
+def tangent_bundle := bundle.total_space E (tangent_space I : M → Type*)
+
+local notation `TM` := tangent_bundle I M
+
+section tangent_bundle_instances
+
+/- In general, the definition of tangent_space is not reducible, so that type class inference
+does not pick wrong instances. In this section, we record the right instances for
+them, noting in particular that the tangent bundle is a smooth manifold. -/
+
+section
+
+variables {M} (x : M)
+
+instance : module 𝕜 (tangent_space I x) := by delta_instance tangent_space
+instance : inhabited (tangent_space I x) := ⟨0⟩
+instance {x : M} : has_continuous_add (tangent_space I x) := by delta_instance tangent_space
+
+end
+
+instance : topological_space TM :=
+(tangent_bundle_core I M).to_topological_space
+
+instance : fiber_bundle E (tangent_space I : M → Type*) :=
+(tangent_bundle_core I M).fiber_bundle
+
+instance : vector_bundle 𝕜 E (tangent_space I : M → Type*) :=
+(tangent_bundle_core I M).vector_bundle
+
+namespace tangent_bundle
+
+protected lemma chart_at (p : TM) :
+  chart_at (model_prod H E) p =
+    ((tangent_bundle_core I M).to_fiber_bundle_core.local_triv (achart H p.1))
+      .to_local_homeomorph ≫ₕ (chart_at H p.1).prod (local_homeomorph.refl E) :=
+rfl
+
+lemma chart_at_to_local_equiv (p : TM) :
+  (chart_at (model_prod H E) p).to_local_equiv =
+    (tangent_bundle_core I M).to_fiber_bundle_core.local_triv_as_local_equiv (achart H p.1) ≫
+    (chart_at H p.1).to_local_equiv.prod (local_equiv.refl E) :=
+rfl
+
+lemma trivialization_at_eq_local_triv (x : M) :
+  trivialization_at E (tangent_space I) x =
+  (tangent_bundle_core I M).to_fiber_bundle_core.local_triv (achart H x) :=
+rfl
+
+@[simp, mfld_simps]
+lemma trivialization_at_source (x : M) :
+  (trivialization_at E (tangent_space I) x).source =
+    π E (tangent_space I) ⁻¹' (chart_at H x).source :=
+rfl
+
+@[simp, mfld_simps]
+lemma trivialization_at_target (x : M) :
+  (trivialization_at E (tangent_space I) x).target = (chart_at H x).source ×ˢ univ :=
+rfl
+
+@[simp, mfld_simps]
+lemma trivialization_at_base_set (x : M) :
+  (trivialization_at E (tangent_space I) x).base_set = (chart_at H x).source :=
+rfl
+
+lemma trivialization_at_apply (x : M) (z : TM) :
+  trivialization_at E (tangent_space I) x z =
+  (z.1, fderiv_within 𝕜 ((chart_at H x).extend I ∘ ((chart_at H z.1).extend I).symm) (range I)
+    ((chart_at H z.1).extend I z.1) z.2) :=
+rfl
+
+@[simp, mfld_simps]
+lemma trivialization_at_fst (x : M) (z : TM) :
+  (trivialization_at E (tangent_space I) x z).1 = z.1 :=
+rfl
+
+@[simp, mfld_simps] lemma mem_chart_source_iff (p q : TM) :
+  p ∈ (chart_at (model_prod H E) q).source ↔ p.1 ∈ (chart_at H q.1).source :=
+by simp only [fiber_bundle.charted_space_chart_at] with mfld_simps
+
+@[simp, mfld_simps] lemma mem_chart_target_iff (p : H × E) (q : TM) :
+  p ∈ (chart_at (model_prod H E) q).target ↔ p.1 ∈ (chart_at H q.1).target :=
+by simp only [fiber_bundle.charted_space_chart_at, and_iff_left_iff_imp] with mfld_simps
+  {contextual := tt}
+
+@[simp, mfld_simps] lemma coe_chart_at_fst (p q : TM) :
+  ((chart_at (model_prod H E) q) p).1 = chart_at H q.1 p.1 := rfl
+
+@[simp, mfld_simps] lemma coe_chart_at_symm_fst (p : H × E) (q : TM) :
+  ((chart_at (model_prod H E) q).symm p).1 = ((chart_at H q.1).symm : H → M) p.1 := rfl
+
+@[simp, mfld_simps] lemma trivialization_at_continuous_linear_map_at {b₀ b : M}
+  (hb : b ∈ (trivialization_at E (tangent_space I) b₀).base_set) :
+  (trivialization_at E (tangent_space I) b₀).continuous_linear_map_at 𝕜 b =
+  (tangent_bundle_core I M).coord_change (achart H b) (achart H b₀) b :=
+(tangent_bundle_core I M).local_triv_continuous_linear_map_at hb
+
+@[simp, mfld_simps] lemma trivialization_at_symmL {b₀ b : M}
+  (hb : b ∈ (trivialization_at E (tangent_space I) b₀).base_set) :
+  (trivialization_at E (tangent_space I) b₀).symmL 𝕜 b =
+    (tangent_bundle_core I M).coord_change (achart H b₀) (achart H b) b :=
+(tangent_bundle_core I M).local_triv_symmL hb
+
+@[simp, mfld_simps]
+lemma coord_change_model_space (b b' x : F) :
+  (tangent_bundle_core 𝓘(𝕜, F) F).coord_change (achart F b) (achart F b') x = 1 :=
+by simpa only [tangent_bundle_core_coord_change] with mfld_simps using
+    fderiv_within_id unique_diff_within_at_univ
+
+@[simp, mfld_simps]
+lemma symmL_model_space (b b' : F) :
+  (trivialization_at F (tangent_space 𝓘(𝕜, F)) b).symmL 𝕜 b' = (1 : F →L[𝕜] F) :=
+begin
+  rw [tangent_bundle.trivialization_at_symmL, coord_change_model_space],
+  apply mem_univ
+end
+
+@[simp, mfld_simps]
+lemma continuous_linear_map_at_model_space (b b' : F) :
+  (trivialization_at F (tangent_space 𝓘(𝕜, F)) b).continuous_linear_map_at 𝕜 b' =
+  (1 : F →L[𝕜] F) :=
+begin
+  rw [tangent_bundle.trivialization_at_continuous_linear_map_at, coord_change_model_space],
+  apply mem_univ
+end
+
+end tangent_bundle
+
+instance tangent_bundle_core.is_smooth : (tangent_bundle_core I M).is_smooth I :=
+begin
+  refine ⟨λ i j, _⟩,
+  rw [smooth_on, cont_mdiff_on_iff_source_of_mem_maximal_atlas
+    (subset_maximal_atlas I i.2), cont_mdiff_on_iff_cont_diff_on],
+  refine ((cont_diff_on_fderiv_coord_change I i j).congr $ λ x hx, _).mono _,
+  { rw [local_equiv.trans_source'] at hx,
+    simp_rw [function.comp_apply, tangent_bundle_core_coord_change,
+      (i.1.extend I).right_inv hx.1] },
+  { exact (i.1.extend_image_source_inter j.1 I).subset },
+  { apply inter_subset_left }
+end
+
+instance tangent_bundle.smooth_vector_bundle :
+  smooth_vector_bundle E (tangent_space I : M → Type*) I :=
+(tangent_bundle_core I M).smooth_vector_bundle _
+
+end tangent_bundle_instances
+
+/-! ## The tangent bundle to the model space -/
+
+/-- In the tangent bundle to the model space, the charts are just the canonical identification
+between a product type and a sigma type, a.k.a. `equiv.sigma_equiv_prod`. -/
+@[simp, mfld_simps] lemma tangent_bundle_model_space_chart_at (p : tangent_bundle I H) :
+  (chart_at (model_prod H E) p).to_local_equiv = (total_space.to_prod H E).to_local_equiv :=
+begin
+  ext x : 1,
+  { ext, { refl },
+    exact (tangent_bundle_core I H).coord_change_self (achart _ x.1) x.1
+      (mem_achart_source H x.1) x.2 },
+  { intros x, ext, { refl }, apply heq_of_eq,
+    exact (tangent_bundle_core I H).coord_change_self (achart _ x.1) x.1
+      (mem_achart_source H x.1) x.2 },
+  simp_rw [tangent_bundle.chart_at, fiber_bundle_core.local_triv,
+    fiber_bundle_core.local_triv_as_local_equiv, vector_bundle_core.to_fiber_bundle_core_base_set,
+    tangent_bundle_core_base_set],
+  simp only with mfld_simps,
+end
+
+@[simp, mfld_simps] lemma tangent_bundle_model_space_coe_chart_at (p : tangent_bundle I H) :
+  ⇑(chart_at (model_prod H E) p) = total_space.to_prod H E :=
+by { unfold_coes, simp_rw [tangent_bundle_model_space_chart_at], refl }
+
+@[simp, mfld_simps] lemma tangent_bundle_model_space_coe_chart_at_symm (p : tangent_bundle I H) :
+  ((chart_at (model_prod H E) p).symm : model_prod H E → tangent_bundle I H) =
+  (total_space.to_prod H E).symm :=
+by { unfold_coes,
+  simp_rw [local_homeomorph.symm_to_local_equiv, tangent_bundle_model_space_chart_at], refl }
+
+lemma tangent_bundle_core_coord_change_model_space (x x' z : H) :
+  (tangent_bundle_core I H).coord_change (achart H x) (achart H x') z =
+  continuous_linear_map.id 𝕜 E :=
+by { ext v, exact (tangent_bundle_core I H).coord_change_self (achart _ z) z (mem_univ _) v }
+
+variable (H)
+/-- The canonical identification between the tangent bundle to the model space and the product,
+as a homeomorphism -/
+def tangent_bundle_model_space_homeomorph : tangent_bundle I H ≃ₜ model_prod H E :=
+{ continuous_to_fun :=
+  begin
+    let p : tangent_bundle I H := ⟨I.symm (0 : E), (0 : E)⟩,
+    have : continuous (chart_at (model_prod H E) p),
+    { rw continuous_iff_continuous_on_univ,
+      convert local_homeomorph.continuous_on _,
+      simp only [tangent_space.fiber_bundle] with mfld_simps },
+    simpa only with mfld_simps using this,
+  end,
+  continuous_inv_fun :=
+  begin
+    let p : tangent_bundle I H := ⟨I.symm (0 : E), (0 : E)⟩,
+    have : continuous (chart_at (model_prod H E) p).symm,
+    { rw continuous_iff_continuous_on_univ,
+      convert local_homeomorph.continuous_on _,
+      simp only with mfld_simps },
+    simpa only with mfld_simps using this,
+  end,
+  .. total_space.to_prod H E }
+
+@[simp, mfld_simps] lemma tangent_bundle_model_space_homeomorph_coe :
+  (tangent_bundle_model_space_homeomorph H I : tangent_bundle I H → model_prod H E)
+  = total_space.to_prod H E :=
+rfl
+
+@[simp, mfld_simps] lemma tangent_bundle_model_space_homeomorph_coe_symm :
+  ((tangent_bundle_model_space_homeomorph H I).symm : model_prod H E → tangent_bundle I H)
+  = (total_space.to_prod H E).symm :=
+rfl
+
+section in_tangent_coordinates
+
+variables (I I') {M M' H H'} {N : Type*}
+
+/-- The map `in_coordinates` for the tangent bundle is trivial on the model spaces -/
+lemma in_coordinates_tangent_bundle_core_model_space
+  (x₀ x : H) (y₀ y : H') (ϕ : E →L[𝕜] E') :
+    in_coordinates E (tangent_space I) E' (tangent_space I') x₀ x y₀ y ϕ = ϕ :=
+begin
+  refine (vector_bundle_core.in_coordinates_eq _ _ _ _ _).trans _,
+  { exact mem_univ x },
+  { exact mem_univ y },
+  simp_rw [tangent_bundle_core_index_at, tangent_bundle_core_coord_change_model_space,
+    continuous_linear_map.id_comp, continuous_linear_map.comp_id]
+end
+
+/-- When `ϕ x` is a continuous linear map that changes vectors in charts around `f x` to vectors
+in charts around `g x`, `in_tangent_coordinates I I' f g ϕ x₀ x` is a coordinate change of
+this continuous linear map that makes sense from charts around `f x₀` to charts around `g x₀`
+by composing it with appropriate coordinate changes.
+Note that the type of `ϕ` is more accurately
+`Π x : N, tangent_space I (f x) →L[𝕜] tangent_space I' (g x)`.
+We are unfolding `tangent_space` in this type so that Lean recognizes that the type of `ϕ` doesn't
+actually depend on `f` or `g`.
+
+This is the underlying function of the trivializations of the hom of (pullbacks of) tangent spaces.
+-/
+def in_tangent_coordinates (f : N → M) (g : N → M') (ϕ : N → E →L[𝕜] E') : N → N → E →L[𝕜] E' :=
+λ x₀ x, in_coordinates E (tangent_space I) E' (tangent_space I') (f x₀) (f x) (g x₀) (g x) (ϕ x)
+
+lemma in_tangent_coordinates_model_space (f : N → H) (g : N → H') (ϕ : N → E →L[𝕜] E') (x₀ : N) :
+    in_tangent_coordinates I I' f g ϕ x₀ = ϕ :=
+by simp_rw [in_tangent_coordinates, in_coordinates_tangent_bundle_core_model_space]
+
+lemma in_tangent_coordinates_eq (f : N → M) (g : N → M') (ϕ : N → E →L[𝕜] E') {x₀ x : N}
+  (hx : f x ∈ (chart_at H (f x₀)).source) (hy : g x ∈ (chart_at H' (g x₀)).source) :
+  in_tangent_coordinates I I' f g ϕ x₀ x =
+  (tangent_bundle_core I' M').coord_change (achart H' (g x)) (achart H' (g x₀)) (g x) ∘L ϕ x ∘L
+  (tangent_bundle_core I M).coord_change (achart H (f x₀)) (achart H (f x)) (f x) :=
+(tangent_bundle_core I M).in_coordinates_eq (tangent_bundle_core I' M') (ϕ x) hx hy
+
+end in_tangent_coordinates
+
+end general
+
+section real
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+{H : Type*} [topological_space H] {I : model_with_corners ℝ E H}
+{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
+
+instance {x : M} : path_connected_space (tangent_space I x) := by delta_instance tangent_space
+
+end real
diff --git a/src/geometry/manifold/whitney_embedding.lean b/src/geometry/manifold/whitney_embedding.lean
index fe0a799e38d9f..c47bcd133c47e 100644
--- a/src/geometry/manifold/whitney_embedding.lean
+++ b/src/geometry/manifold/whitney_embedding.lean
@@ -10,6 +10,9 @@ import geometry.manifold.partition_of_unity
 /-!
 # Whitney embedding theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove a version of the Whitney embedding theorem: for any compact real manifold `M`,
 for sufficiently large `n` there exists a smooth embedding `M → ℝ^n`.
 
@@ -27,12 +30,12 @@ partition of unity, smooth bump function, whitney theorem
 
 universes uι uE uH uM
 variables {ι : Type uι}
-{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+{E : Type uE} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
 {H : Type uH} [topological_space H] {I : model_with_corners ℝ E H}
 {M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
 
 open function filter finite_dimensional set
-open_locale topological_space manifold classical filter big_operators
+open_locale topology manifold classical filter big_operators
 
 noncomputable theory
 
@@ -45,12 +48,13 @@ In this section we prove a version of the Whitney embedding theorem: for any com
 `M`, for sufficiently large `n` there exists a smooth embedding `M → ℝ^n`.
 -/
 
-variables [t2_space M] [fintype ι] {s : set M} (f : smooth_bump_covering ι I M s)
+variables [t2_space M] [hi : fintype ι] {s : set M} (f : smooth_bump_covering ι I M s)
+include hi
 
 /-- Smooth embedding of `M` into `(E × ℝ) ^ ι`. -/
 def embedding_pi_tangent : C^∞⟮I, M; 𝓘(ℝ, ι → (E × ℝ)), ι → (E × ℝ)⟯ :=
-{ to_fun := λ x i, (f i x • ext_chart_at I (f.c i) x, f i x),
-  cont_mdiff_to_fun := cont_mdiff_pi_space.2 $ λ i,
+{ val := λ x i, (f i x • ext_chart_at I (f.c i) x, f i x),
+  property := cont_mdiff_pi_space.2 $ λ i,
     ((f i).smooth_smul cont_mdiff_on_ext_chart_at).prod_mk_space ((f i).smooth) }
 
 local attribute [simp] lemma embedding_pi_tangent_coe :
@@ -91,7 +95,7 @@ begin
 end
 
 lemma embedding_pi_tangent_ker_mfderiv (x : M) (hx : x ∈ s) :
-  (mfderiv I 𝓘(ℝ, ι → (E × ℝ)) f.embedding_pi_tangent x).ker = ⊥ :=
+  linear_map.ker (mfderiv I 𝓘(ℝ, ι → (E × ℝ)) f.embedding_pi_tangent x) = ⊥ :=
 begin
   apply bot_unique,
   rw [← (mdifferentiable_chart I (f.c (f.ind x hx))).ker_mfderiv_eq_bot
@@ -103,13 +107,16 @@ lemma embedding_pi_tangent_injective_mfderiv (x : M) (hx : x ∈ s) :
   injective (mfderiv I 𝓘(ℝ, ι → (E × ℝ)) f.embedding_pi_tangent x) :=
 linear_map.ker_eq_bot.1 (f.embedding_pi_tangent_ker_mfderiv x hx)
 
-/-- Baby version of the Whitney weak embedding theorem: if `M` admits a finite covering by
+omit hi
+
+/-- Baby version of the **Whitney weak embedding theorem**: if `M` admits a finite covering by
 supports of bump functions, then for some `n` it can be immersed into the `n`-dimensional
 Euclidean space. -/
-lemma exists_immersion_euclidean (f : smooth_bump_covering ι I M) :
+lemma exists_immersion_euclidean [finite ι] (f : smooth_bump_covering ι I M) :
   ∃ (n : ℕ) (e : M → euclidean_space ℝ (fin n)), smooth I (𝓡 n) e ∧
     injective e ∧ ∀ x : M, injective (mfderiv I (𝓡 n) e x) :=
 begin
+  casesI nonempty_fintype ι,
   set F := euclidean_space ℝ (fin $ finrank ℝ (ι → (E × ℝ))),
   letI : is_noetherian ℝ (E × ℝ) := is_noetherian.iff_fg.2 infer_instance,
   letI : finite_dimensional ℝ (ι → E × ℝ) := is_noetherian.iff_fg.1 infer_instance,
diff --git a/src/group_theory/abelianization.lean b/src/group_theory/abelianization.lean
index 7bf9be76b99ae..c2915d7a36840 100644
--- a/src/group_theory/abelianization.lean
+++ b/src/group_theory/abelianization.lean
@@ -3,12 +3,16 @@ Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Michael Howes
 -/
+import data.finite.card
 import group_theory.commutator
-import group_theory.quotient_group
+import group_theory.finiteness
 
 /-!
 # The abelianization of a group
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the commutator and the abelianization of a group. It furthermore prepares for the
 result that the abelianization is left adjoint to the forgetful functor from abelian groups to
 groups, which can be found in `algebra/category/Group/adjunctions`.
@@ -28,6 +32,8 @@ universes u v w
 -- Let G be a group.
 variables (G : Type u) [group G]
 
+open subgroup (centralizer)
+
 /-- The commutator subgroup of a group G is the normal subgroup
   generated by the commutators [p,q]=`p*q*p⁻¹*q⁻¹`. -/
 @[derive subgroup.normal]
@@ -36,23 +42,37 @@ def commutator : subgroup G :=
 
 lemma commutator_def : commutator G = ⁅(⊤ : subgroup G), ⊤⁆ := rfl
 
-lemma commutator_eq_closure : commutator G = subgroup.closure {g | ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g} :=
-by simp_rw [commutator, subgroup.commutator_def, subgroup.mem_top, exists_true_left]
+lemma commutator_eq_closure : commutator G = subgroup.closure (commutator_set G) :=
+by simp [commutator, subgroup.commutator_def, commutator_set]
 
 lemma commutator_eq_normal_closure :
-  commutator G = subgroup.normal_closure {g | ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g} :=
-by simp_rw [commutator, subgroup.commutator_def', subgroup.mem_top, exists_true_left]
+  commutator G = subgroup.normal_closure (commutator_set G) :=
+by simp [commutator, subgroup.commutator_def', commutator_set]
 
 instance commutator_characteristic : (commutator G).characteristic :=
 subgroup.commutator_characteristic ⊤ ⊤
 
+instance [finite (commutator_set G)] : group.fg (commutator G) :=
+begin
+  rw commutator_eq_closure,
+  apply group.closure_finite_fg,
+end
+
+lemma rank_commutator_le_card [finite (commutator_set G)] :
+  group.rank (commutator G) ≤ nat.card (commutator_set G) :=
+begin
+  rw subgroup.rank_congr (commutator_eq_closure G),
+  apply subgroup.rank_closure_finite_le_nat_card,
+end
+
 lemma commutator_centralizer_commutator_le_center :
-  ⁅(commutator G).centralizer, (commutator G).centralizer⁆ ≤ subgroup.center G :=
+  ⁅centralizer (commutator G : set G), centralizer (commutator G : set G)⁆ ≤ subgroup.center G :=
 begin
-  rw [←subgroup.centralizer_top, ←subgroup.commutator_eq_bot_iff_le_centralizer],
-  suffices : ⁅⁅⊤, (commutator G).centralizer⁆, (commutator G).centralizer⁆ = ⊥,
+  rw [←subgroup.centralizer_univ, ←subgroup.coe_top,
+    ←subgroup.commutator_eq_bot_iff_le_centralizer],
+  suffices : ⁅⁅⊤, centralizer (commutator G : set G)⁆, centralizer (commutator G : set G)⁆ = ⊥,
   { refine subgroup.commutator_commutator_eq_bot_of_rotate _ this,
-    rwa subgroup.commutator_comm (commutator G).centralizer },
+    rwa subgroup.commutator_comm (centralizer (commutator G : set G)) },
   rw [subgroup.commutator_comm, subgroup.commutator_eq_bot_iff_le_centralizer],
   exact set.centralizer_subset (subgroup.commutator_mono le_top le_top),
 end
@@ -67,6 +87,7 @@ local attribute [instance] quotient_group.left_rel
 
 instance : comm_group (abelianization G) :=
 { mul_comm := λ x y, quotient.induction_on₂' x y $ λ a b, quotient.sound' $
+    quotient_group.left_rel_apply.mpr $
     subgroup.subset_closure ⟨b⁻¹, subgroup.mem_top b⁻¹, a⁻¹, subgroup.mem_top a⁻¹, by group⟩,
 .. quotient_group.quotient.group _ }
 
@@ -76,6 +97,9 @@ instance [fintype G] [decidable_pred (∈ commutator G)] :
   fintype (abelianization G) :=
 quotient_group.fintype (commutator G)
 
+instance [finite G] : finite (abelianization G) :=
+quotient.finite _
+
 variable {G}
 
 /-- `of` is the canonical projection from G to its abelianization. -/
@@ -197,3 +221,70 @@ end abelianization_congr
   left_inv  := λ a, rfl,
   right_inv := by { rintros ⟨a⟩, refl, },
   .. abelianization.of }
+
+section commutator_representatives
+
+open subgroup
+
+/-- Representatives `(g₁, g₂) : G × G` of commutator_set `⁅g₁, g₂⁆ ∈ G`. -/
+def commutator_representatives : set (G × G) :=
+set.range (λ g : commutator_set G, (g.2.some, g.2.some_spec.some))
+
+instance [finite (commutator_set G)] : finite (commutator_representatives G) :=
+set.finite_coe_iff.mpr (set.finite_range _)
+
+/-- Subgroup generated by representatives `g₁ g₂ : G` of commutators `⁅g₁, g₂⁆ ∈ G`. -/
+def closure_commutator_representatives : subgroup G :=
+closure (prod.fst '' commutator_representatives G ∪ prod.snd '' commutator_representatives G)
+
+instance closure_commutator_representatives_fg [finite (commutator_set G)] :
+  group.fg (closure_commutator_representatives G) :=
+group.closure_finite_fg _
+
+lemma rank_closure_commutator_representations_le [finite (commutator_set G)] :
+  group.rank (closure_commutator_representatives G) ≤ 2 * nat.card (commutator_set G) :=
+begin
+  rw two_mul,
+  exact (subgroup.rank_closure_finite_le_nat_card _).trans ((set.card_union_le _ _).trans
+    (add_le_add ((finite.card_image_le _).trans (finite.card_range_le _))
+    ((finite.card_image_le _).trans (finite.card_range_le _ )))),
+end
+
+lemma image_commutator_set_closure_commutator_representatives :
+  (closure_commutator_representatives G).subtype ''
+    (commutator_set (closure_commutator_representatives G)) = commutator_set G :=
+begin
+  apply set.subset.antisymm,
+  { rintros - ⟨-, ⟨g₁, g₂, rfl⟩, rfl⟩,
+    exact ⟨g₁, g₂, rfl⟩ },
+  { exact λ g hg, ⟨_,
+      ⟨⟨_, subset_closure (or.inl ⟨_, ⟨⟨g, hg⟩, rfl⟩, rfl⟩)⟩,
+       ⟨_, subset_closure (or.inr ⟨_, ⟨⟨g, hg⟩, rfl⟩, rfl⟩)⟩,
+       rfl⟩,
+      hg.some_spec.some_spec⟩ },
+end
+
+lemma card_commutator_set_closure_commutator_representatives :
+  nat.card (commutator_set (closure_commutator_representatives G)) = nat.card (commutator_set G) :=
+begin
+  rw ← image_commutator_set_closure_commutator_representatives G,
+  exact nat.card_congr (equiv.set.image _ _ (subtype_injective _)),
+end
+
+lemma card_commutator_closure_commutator_representatives :
+  nat.card (commutator (closure_commutator_representatives G)) = nat.card (commutator G) :=
+begin
+  rw [commutator_eq_closure G, ←image_commutator_set_closure_commutator_representatives,
+      ←monoid_hom.map_closure, ←commutator_eq_closure],
+  exact nat.card_congr (equiv.set.image _ _ (subtype_injective _)),
+end
+
+instance [finite (commutator_set G)] :
+  finite (commutator_set (closure_commutator_representatives G)) :=
+begin
+  apply nat.finite_of_card_ne_zero,
+  rw card_commutator_set_closure_commutator_representatives,
+  exact finite.card_pos.ne',
+end
+
+end commutator_representatives
diff --git a/src/group_theory/archimedean.lean b/src/group_theory/archimedean.lean
index d5732aa7bbd2b..7efb0f3ef1c51 100644
--- a/src/group_theory/archimedean.lean
+++ b/src/group_theory/archimedean.lean
@@ -9,6 +9,9 @@ import group_theory.subgroup.basic
 /-!
 # Archimedean groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves a few facts about ordered groups which satisfy the `archimedean` property, that is:
 `class archimedean (α) [ordered_add_comm_monoid α] : Prop :=`
 `(arch : ∀ (x : α) {y}, 0 < y → ∃ n : ℕ, x ≤ n • y)`
diff --git a/src/group_theory/commensurable.lean b/src/group_theory/commensurable.lean
index 7ac884e351076..bf7f219b618b5 100644
--- a/src/group_theory/commensurable.lean
+++ b/src/group_theory/commensurable.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Birkbeck
 -/
 import group_theory.index
-import group_theory.quotient_group
 import group_theory.subgroup.pointwise
 import group_theory.group_action.conj_act
 /-!
 # Commensurability for subgroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines commensurability for subgroups of a group `G`. It then goes on to prove that
 commensurability defines an equivalence relation and finally defines the commensurator of a subgroup
 of `G`.
@@ -53,10 +55,10 @@ lemma equivalence : equivalence (@commensurable G _) :=
 /--Equivalence of `K/H ⊓ K` with `gKg⁻¹/gHg⁻¹ ⊓ gKg⁻¹`-/
 def  quot_conj_equiv (H K : subgroup G) (g : conj_act G) :
   K ⧸ (H.subgroup_of K) ≃ (g • K).1 ⧸ ((g • H).subgroup_of (g • K)) :=
-quotient.congr (K.equiv_smul g).to_equiv (λ a b, by { rw [←quotient.eq', ←quotient.eq',
+quotient.congr (K.equiv_smul g).to_equiv (λ a b, by { dsimp, rw [←quotient.eq', ←quotient.eq',
   quotient_group.eq', quotient_group.eq', subgroup.mem_subgroup_of, subgroup.mem_subgroup_of,
-  mul_equiv.to_equiv_eq_coe, mul_equiv.coe_to_equiv, ←mul_equiv.map_inv, ←mul_equiv.map_mul,
-  subgroup.equiv_smul_apply_coe, subgroup.smul_mem_pointwise_smul_iff] })
+  ←mul_equiv.map_inv, ←mul_equiv.map_mul, subgroup.equiv_smul_apply_coe],
+  exact subgroup.smul_mem_pointwise_smul_iff.symm })
 
 lemma commensurable_conj {H K : subgroup G} (g : conj_act G) :
    commensurable H K ↔ commensurable (g • H) (g • K) :=
diff --git a/src/group_theory/commutator.lean b/src/group_theory/commutator.lean
index c738ac771c4b2..5c21d23e5f311 100644
--- a/src/group_theory/commutator.lean
+++ b/src/group_theory/commutator.lean
@@ -5,12 +5,15 @@ Authors: Jordan Brown, Thomas Browning, Patrick Lutz
 -/
 
 import data.bracket
-import group_theory.subgroup.basic
+import group_theory.subgroup.finite
 import tactic.group
 
 /-!
 # Commutators of Subgroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `G` is a group and `H₁ H₂ : subgroup G` then the commutator `⁅H₁, H₂⁆ : subgroup G`
 is the subgroup of `G` generated by the commutators `h₁ * h₂ * h₁⁻¹ * h₂⁻¹`.
 
@@ -40,6 +43,9 @@ variables (g₁ g₂ g₃ g)
 @[simp] lemma commutator_element_one_left : ⁅(1 : G), g⁆ = 1 :=
 (commute.one_left g).commutator_eq
 
+@[simp] lemma commutator_element_self : ⁅g, g⁆ = 1 :=
+(commute.refl g).commutator_eq
+
 @[simp] lemma commutator_element_inv : ⁅g₁, g₂⁆⁻¹ = ⁅g₂, g₁⁆ :=
 by simp_rw [commutator_element_def, mul_inv_rev, inv_inv, mul_assoc]
 
@@ -69,7 +75,7 @@ H₃.closure_le.trans ⟨λ h a b c d, h ⟨a, b, c, d, rfl⟩, λ h g ⟨a, b,
 lemma commutator_mono (h₁ : H₁ ≤ K₁) (h₂ : H₂ ≤ K₂) : ⁅H₁, H₂⁆ ≤ ⁅K₁, K₂⁆ :=
 commutator_le.mpr (λ g₁ hg₁ g₂ hg₂, commutator_mem_commutator (h₁ hg₁) (h₂ hg₂))
 
-lemma commutator_eq_bot_iff_le_centralizer : ⁅H₁, H₂⁆ = ⊥ ↔ H₁ ≤ H₂.centralizer :=
+lemma commutator_eq_bot_iff_le_centralizer : ⁅H₁, H₂⁆ = ⊥ ↔ H₁ ≤ centralizer H₂ :=
 begin
   rw [eq_bot_iff, commutator_le],
   refine forall_congr (λ p, forall_congr (λ hp, forall_congr (λ q, forall_congr (λ hq, _)))),
@@ -174,7 +180,7 @@ end
 
 /-- The commutator of direct product is contained in the direct product of the commutators.
 
-See `commutator_pi_pi_of_fintype` for equality given `fintype η`.
+See `commutator_pi_pi_of_finite` for equality given `fintype η`.
 -/
 lemma commutator_pi_pi_le {η : Type*} {Gs : η → Type*} [∀ i, group (Gs i)]
   (H K : Π i, subgroup (Gs i)) :
@@ -183,7 +189,7 @@ commutator_le.mpr $ λ p hp q hq i hi, commutator_mem_commutator (hp i hi) (hq i
 
 /-- The commutator of a finite direct product is contained in the direct product of the commutators.
 -/
-lemma commutator_pi_pi_of_fintype {η : Type*} [fintype η] {Gs : η → Type*}
+lemma commutator_pi_pi_of_finite {η : Type*} [finite η] {Gs : η → Type*}
   [∀ i, group (Gs i)] (H K : Π i, subgroup (Gs i)) :
   ⁅subgroup.pi set.univ H, subgroup.pi set.univ K⁆ = subgroup.pi set.univ (λ i, ⁅H i, K i⁆) :=
 begin
@@ -201,3 +207,25 @@ begin
 end
 
 end subgroup
+
+variables (G)
+
+/-- The set of commutator elements `⁅g₁, g₂⁆` in `G`. -/
+def commutator_set : set G :=
+{g | ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g}
+
+lemma commutator_set_def : commutator_set G = {g | ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g} := rfl
+
+lemma one_mem_commutator_set : (1 : G) ∈ commutator_set G :=
+⟨1, 1, commutator_element_self 1⟩
+
+instance : nonempty (commutator_set G) :=
+⟨⟨1, one_mem_commutator_set G⟩⟩
+
+variables {G g}
+
+lemma mem_commutator_set_iff : g ∈ commutator_set G ↔ ∃ g₁ g₂ : G, ⁅g₁, g₂⁆ = g :=
+iff.rfl
+
+lemma commutator_mem_commutator_set : ⁅g₁, g₂⁆ ∈ commutator_set G :=
+⟨g₁, g₂, rfl⟩
diff --git a/src/group_theory/commuting_probability.lean b/src/group_theory/commuting_probability.lean
index deda527d2a0b1..bc035f0065209 100644
--- a/src/group_theory/commuting_probability.lean
+++ b/src/group_theory/commuting_probability.lean
@@ -3,12 +3,17 @@ Copyright (c) 2022 Thomas Browning. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning
 -/
+import algebra.group.conj_finite
 import group_theory.abelianization
 import group_theory.group_action.conj_act
+import group_theory.group_action.quotient
 import group_theory.index
 
 /-!
 # Commuting Probability
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file introduces the commuting probability of finite groups.
 
 ## Main definitions
@@ -24,41 +29,48 @@ open_locale big_operators
 
 open fintype
 
-variables (M : Type*) [fintype M] [has_mul M]
+variables (M : Type*) [has_mul M]
 
 /-- The commuting probability of a finite type with a multiplication operation -/
-def comm_prob : ℚ := card {p : M × M // p.1 * p.2 = p.2 * p.1} / card M ^ 2
+def comm_prob : ℚ := nat.card {p : M × M // p.1 * p.2 = p.2 * p.1} / nat.card M ^ 2
 
-lemma comm_prob_def : comm_prob M = card {p : M × M // p.1 * p.2 = p.2 * p.1} / card M ^ 2 :=
+lemma comm_prob_def :
+  comm_prob M = nat.card {p : M × M // p.1 * p.2 = p.2 * p.1} / nat.card M ^ 2 :=
 rfl
 
+variables [finite M]
+
 lemma comm_prob_pos [h : nonempty M] : 0 < comm_prob M :=
-h.elim (λ x, div_pos (nat.cast_pos.mpr (card_pos_iff.mpr ⟨⟨(x, x), rfl⟩⟩))
-  (pow_pos (nat.cast_pos.mpr card_pos) 2))
+h.elim (λ x, div_pos (nat.cast_pos.mpr (finite.card_pos_iff.mpr ⟨⟨(x, x), rfl⟩⟩))
+  (pow_pos (nat.cast_pos.mpr finite.card_pos) 2))
 
 lemma comm_prob_le_one : comm_prob M ≤ 1 :=
 begin
-  refine div_le_one_of_le _ (sq_nonneg (card M)),
-  rw [←nat.cast_pow, nat.cast_le, sq, ←card_prod],
-  apply set_fintype_card_le_univ,
+  refine div_le_one_of_le _ (sq_nonneg (nat.card M)),
+  rw [←nat.cast_pow, nat.cast_le, sq, ←nat.card_prod],
+  apply finite.card_subtype_le,
 end
 
 variables {M}
 
 lemma comm_prob_eq_one_iff [h : nonempty M] : comm_prob M = 1 ↔ commutative ((*) : M → M → M) :=
 begin
-  change (card {p : M × M | p.1 * p.2 = p.2 * p.1} : ℚ) / _ = 1 ↔ _,
+  haveI := fintype.of_finite M,
+  rw [comm_prob, ←set.coe_set_of, nat.card_eq_fintype_card, nat.card_eq_fintype_card],
   rw [div_eq_one_iff_eq, ←nat.cast_pow, nat.cast_inj, sq, ←card_prod,
       set_fintype_card_eq_univ_iff, set.eq_univ_iff_forall],
   { exact ⟨λ h x y, h (x, y), λ h x, h x.1 x.2⟩ },
   { exact pow_ne_zero 2 (nat.cast_ne_zero.mpr card_ne_zero) },
 end
 
-variables (G : Type*) [group G] [fintype G]
+variables (G : Type*) [group G] [finite G]
 
 lemma card_comm_eq_card_conj_classes_mul_card :
-  card {p : G × G // p.1 * p.2 = p.2 * p.1} = card (conj_classes G) * card G :=
-calc card {p : G × G // p.1 * p.2 = p.2 * p.1} = card (Σ g, {h // g * h = h * g}) :
+  nat.card {p : G × G // p.1 * p.2 = p.2 * p.1} = nat.card (conj_classes G) * nat.card G :=
+begin
+  haveI := fintype.of_finite G,
+  simp only [nat.card_eq_fintype_card],
+  convert calc card {p : G × G // p.1 * p.2 = p.2 * p.1} = card (Σ g, {h // g * h = h * g}) :
   card_congr (equiv.subtype_prod_equiv_sigma_subtype (λ g h : G, g * h = h * g))
 ... = ∑ g, card {h // g * h = h * g} : card_sigma _
 ... = ∑ g, card (mul_action.fixed_by (conj_act G) G g) : sum_equiv conj_act.to_conj_act.to_equiv
@@ -69,11 +81,12 @@ calc card {p : G × G // p.1 * p.2 = p.2 * p.1} = card (Σ g, {h // g * h = h *
   have this : mul_action.orbit_rel (conj_act G) G = is_conj.setoid G :=
     setoid.ext (λ g h, (setoid.comm' _).trans is_conj_iff.symm),
   by cc
+end
 
-lemma comm_prob_def' : comm_prob G = card (conj_classes G) / card G :=
+lemma comm_prob_def' : comm_prob G = nat.card (conj_classes G) / nat.card G :=
 begin
   rw [comm_prob, card_comm_eq_card_conj_classes_mul_card, nat.cast_mul, sq],
-  exact mul_div_mul_right (card (conj_classes G)) (card G) (nat.cast_ne_zero.mpr card_ne_zero),
+  exact mul_div_mul_right _ _ (nat.cast_ne_zero.mpr finite.card_pos.ne'),
 end
 
 variables {G} (H : subgroup G)
@@ -82,30 +95,30 @@ lemma subgroup.comm_prob_subgroup_le : comm_prob H ≤ comm_prob G * H.index ^ 2
 begin
   /- After rewriting with `comm_prob_def`, we reduce to showing that `G` has at least as many
     commuting pairs as `H`. -/
-  rw [comm_prob_def, comm_prob_def, div_le_iff, mul_assoc, ←mul_pow, ←nat.cast_mul,
-      H.index_mul_card, div_mul_cancel, nat.cast_le],
-  { apply card_le_of_injective _ _,
-    exact λ p, ⟨⟨p.1.1, p.1.2⟩, subtype.ext_iff.mp p.2⟩,
+  rw [comm_prob_def, comm_prob_def,  div_le_iff, mul_assoc, ←mul_pow, ←nat.cast_mul,
+      mul_comm H.index, H.card_mul_index, div_mul_cancel, nat.cast_le],
+  { refine finite.card_le_of_injective (λ p, ⟨⟨p.1.1, p.1.2⟩, subtype.ext_iff.mp p.2⟩) _,
     exact λ p q h, by simpa only [subtype.ext_iff, prod.ext_iff] using h },
-  { exact pow_ne_zero 2 (nat.cast_ne_zero.mpr card_ne_zero) },
-  { exact pow_pos (nat.cast_pos.mpr card_pos) 2 },
+  { exact pow_ne_zero 2 (nat.cast_ne_zero.mpr finite.card_pos.ne') },
+  { exact pow_pos (nat.cast_pos.mpr finite.card_pos) 2 },
 end
 
-lemma subgroup.comm_prob_quotient_le [H.normal] : comm_prob (G ⧸ H) ≤ comm_prob G * card H :=
+lemma subgroup.comm_prob_quotient_le [H.normal] : comm_prob (G ⧸ H) ≤ comm_prob G * nat.card H :=
 begin
   /- After rewriting with `comm_prob_def'`, we reduce to showing that `G` has at least as many
     conjugacy classes as `G ⧸ H`. -/
-  rw [comm_prob_def', comm_prob_def', div_le_iff, mul_assoc, ←nat.cast_mul, mul_comm (card H),
-      ←subgroup.card_eq_card_quotient_mul_card_subgroup, div_mul_cancel, nat.cast_le],
-  { exact card_le_of_surjective (conj_classes.map (quotient_group.mk' H))
-      (conj_classes.map_surjective quotient.surjective_quotient_mk') },
-  { exact nat.cast_ne_zero.mpr card_ne_zero },
-  { exact nat.cast_pos.mpr card_pos },
+  rw [comm_prob_def', comm_prob_def', div_le_iff, mul_assoc, ←nat.cast_mul, ←subgroup.index,
+      H.card_mul_index, div_mul_cancel, nat.cast_le],
+  { apply finite.card_le_of_surjective,
+    show function.surjective (conj_classes.map (quotient_group.mk' H)),
+    exact (conj_classes.map_surjective quotient.surjective_quotient_mk') },
+  { exact nat.cast_ne_zero.mpr finite.card_pos.ne' },
+  { exact nat.cast_pos.mpr finite.card_pos },
 end
 
 variables (G)
 
-lemma inv_card_commutator_le_comm_prob : (↑(card (commutator G)))⁻¹ ≤ comm_prob G :=
-(inv_pos_le_iff_one_le_mul (by exact nat.cast_pos.mpr card_pos)).mpr
+lemma inv_card_commutator_le_comm_prob : (↑(nat.card (commutator G)))⁻¹ ≤ comm_prob G :=
+(inv_pos_le_iff_one_le_mul (by exact nat.cast_pos.mpr finite.card_pos)).mpr
   (le_trans (ge_of_eq (comm_prob_eq_one_iff.mpr (abelianization.comm_group G).mul_comm))
     (commutator G).comm_prob_quotient_le)
diff --git a/src/group_theory/complement.lean b/src/group_theory/complement.lean
index bdd887bfe7d56..fbea4afce7115 100644
--- a/src/group_theory/complement.lean
+++ b/src/group_theory/complement.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning
 -/
 
-import group_theory.order_of_element
+import data.zmod.quotient
 
 /-!
 # Complements
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the complement of a subgroup.
 
 ## Main definitions
@@ -19,13 +22,15 @@ In this file we define the complement of a subgroup.
   i.e. the set of all `S : set G` that contain exactly one element of each left coset of `T`.
 - `right_transversals S` where `S` is a subset of `G` is the set of all right-complements of `S`,
   i.e. the set of all `T : set G` that contain exactly one element of each right coset of `S`.
+- `transfer_transversal H g` is a specific `left_transversal` of `H` that is used in the
+  computation of the transfer homomorphism evaluated at an element `g : G`.
 
 ## Main results
 
 - `is_complement_of_coprime` : Subgroups of coprime order are complements.
 -/
 
-open_locale big_operators
+open_locale big_operators pointwise
 
 namespace subgroup
 
@@ -172,9 +177,8 @@ end
   S ∈ left_transversals (H : set G) ↔
   ∀ q : quotient (quotient_group.left_rel H), ∃! s : S, quotient.mk' s.1 = q :=
 begin
-  have key : ∀ g h, quotient.mk' g = quotient.mk' h ↔ g⁻¹ * h ∈ H :=
-  @quotient.eq' G (quotient_group.left_rel H),
-  simp_rw [mem_left_transversals_iff_exists_unique_inv_mul_mem, set_like.mem_coe, ←key],
+  simp_rw [mem_left_transversals_iff_exists_unique_inv_mul_mem, set_like.mem_coe,
+    ← quotient_group.eq'],
   exact ⟨λ h q, quotient.induction_on' q h, λ h g, h (quotient.mk' g)⟩,
 end
 
@@ -182,9 +186,8 @@ end
   S ∈ right_transversals (H : set G) ↔
   ∀ q : quotient (quotient_group.right_rel H), ∃! s : S, quotient.mk' s.1 = q :=
 begin
-  have key : ∀ g h, quotient.mk' g = quotient.mk' h ↔ h * g⁻¹ ∈ H :=
-  @quotient.eq' G (quotient_group.right_rel H),
-  simp_rw [mem_right_transversals_iff_exists_unique_mul_inv_mem, set_like.mem_coe, ←key],
+  simp_rw [mem_right_transversals_iff_exists_unique_mul_inv_mem, set_like.mem_coe,
+    ← quotient_group.right_rel_apply, ← quotient.eq'],
   exact ⟨λ h q, quotient.induction_on' q h, λ h g, h (quotient.mk' g)⟩,
 end
 
@@ -198,6 +201,15 @@ mem_left_transversals_iff_exists_unique_quotient_mk'_eq.trans
 mem_right_transversals_iff_exists_unique_quotient_mk'_eq.trans
   (function.bijective_iff_exists_unique (S.restrict quotient.mk')).symm
 
+@[to_additive] lemma card_left_transversal (h : S ∈ left_transversals (H : set G)) :
+  nat.card S = H.index :=
+nat.card_congr $ equiv.of_bijective _ $ mem_left_transversals_iff_bijective.mp h
+
+@[to_additive] lemma card_right_transversal (h : S ∈ right_transversals (H : set G)) :
+  nat.card S = H.index :=
+nat.card_congr $ (equiv.of_bijective _ $ mem_right_transversals_iff_bijective.mp h).trans $
+  quotient_group.quotient_right_rel_equiv_quotient_left_rel H
+
 @[to_additive] lemma range_mem_left_transversals {f : G ⧸ H → G} (hf : ∀ q, ↑(f q) = q) :
   set.range f ∈ left_transversals (H : set G) :=
 mem_left_transversals_iff_bijective.mpr ⟨by rintros ⟨-, q₁, rfl⟩ ⟨-, q₂, rfl⟩ h;
@@ -257,7 +269,7 @@ to_equiv hS ∘ quotient.mk'
 
 @[to_additive] lemma inv_to_fun_mul_mem (hS : S ∈ subgroup.left_transversals (H : set G))
   (g : G) : (to_fun hS g : G)⁻¹ * g ∈ H :=
-quotient.exact' (mk'_to_equiv hS g)
+quotient_group.left_rel_apply.mp $ quotient.exact' $ mk'_to_equiv _ _
 
 @[to_additive] lemma inv_mul_to_fun_mem (hS : S ∈ subgroup.left_transversals (H : set G))
   (g : G) : g⁻¹ * to_fun hS g ∈ H :=
@@ -294,7 +306,7 @@ to_equiv hS ∘ quotient.mk'
 
 @[to_additive] lemma mul_inv_to_fun_mem (hS : S ∈ subgroup.right_transversals (H : set G))
   (g : G) : g * (to_fun hS g : G)⁻¹ ∈ H :=
-quotient.exact' (mk'_to_equiv hS _)
+quotient_group.right_rel_apply.mp $ quotient.exact' $ mk'_to_equiv _ _
 
 @[to_additive] lemma to_fun_mul_inv_mem (hS : S ∈ subgroup.right_transversals (H : set G))
   (g : G) : (to_fun hS g : G) * g⁻¹ ∈ H :=
@@ -348,18 +360,23 @@ end action
 
 lemma is_complement'.is_compl (h : is_complement' H K) : is_compl H K :=
 begin
-  refine ⟨λ g ⟨p, q⟩, let x : H × K := ⟨⟨g, p⟩, 1⟩, y : H × K := ⟨1, g, q⟩ in subtype.ext_iff.mp
-    (prod.ext_iff.mp (show x = y, from h.1 ((mul_one g).trans (one_mul g).symm))).1, λ g _, _⟩,
+  refine ⟨disjoint_iff_inf_le.mpr $
+    λ g ⟨p, q⟩, let x : H × K := ⟨⟨g, p⟩, 1⟩, y : H × K := ⟨1, g, q⟩ in subtype.ext_iff.mp
+    (prod.ext_iff.mp (show x = y, from h.1 ((mul_one g).trans (one_mul g).symm))).1,
+    codisjoint_iff_le_sup.mpr $ λ g _, _⟩,
   obtain ⟨⟨h, k⟩, rfl⟩ := h.2 g,
   exact subgroup.mul_mem_sup h.2 k.2,
 end
 
-lemma is_complement'.sup_eq_top (h : subgroup.is_complement' H K) : H ⊔ K = ⊤ :=
+lemma is_complement'.sup_eq_top (h : is_complement' H K) : H ⊔ K = ⊤ :=
 h.is_compl.sup_eq_top
 
 lemma is_complement'.disjoint (h : is_complement' H K) : disjoint H K :=
 h.is_compl.disjoint
 
+lemma is_complement'.index_eq_card (h : is_complement' H K) : K.index = nat.card H :=
+(card_left_transversal h).symm
+
 lemma is_complement.card_mul [fintype G] [fintype S] [fintype T] (h : is_complement S T) :
   fintype.card S * fintype.card T = fintype.card G :=
 (fintype.card_prod _ _).symm.trans (fintype.card_of_bijective h)
@@ -368,18 +385,19 @@ lemma is_complement'.card_mul [fintype G] [fintype H] [fintype K] (h : is_comple
   fintype.card H * fintype.card K = fintype.card G :=
 h.card_mul
 
+lemma is_complement'_of_disjoint_and_mul_eq_univ
+  (h1 : disjoint H K) (h2 : ↑H * ↑K = (set.univ : set G)) : is_complement' H K :=
+begin
+  refine ⟨mul_injective_of_disjoint h1, λ g, _⟩,
+  obtain ⟨h, k, hh, hk, hg⟩ := set.eq_univ_iff_forall.mp h2 g,
+  exact ⟨(⟨h, hh⟩, ⟨k, hk⟩), hg⟩,
+end
+
 lemma is_complement'_of_card_mul_and_disjoint [fintype G] [fintype H] [fintype K]
   (h1 : fintype.card H * fintype.card K = fintype.card G) (h2 : disjoint H K) :
   is_complement' H K :=
-begin
-  refine (fintype.bijective_iff_injective_and_card _).mpr
-    ⟨λ x y h, _, (fintype.card_prod H K).trans h1⟩,
-  rw [←eq_inv_mul_iff_mul_eq, ←mul_assoc, ←mul_inv_eq_iff_eq_mul] at h,
-  change ↑(x.2 * y.2⁻¹) = ↑(x.1⁻¹ * y.1) at h,
-  rw [prod.ext_iff, ←@inv_mul_eq_one H _ x.1 y.1, ←@mul_inv_eq_one K _ x.2 y.2, subtype.ext_iff,
-      subtype.ext_iff, coe_one, coe_one, h, and_self, ←mem_bot, ←h2.eq_bot, mem_inf],
-  exact ⟨subtype.mem ((x.1)⁻¹ * (y.1)), (congr_arg (∈ K) h).mp (subtype.mem (x.2 * (y.2)⁻¹))⟩,
-end
+(fintype.bijective_iff_injective_and_card _).mpr
+  ⟨mul_injective_of_disjoint h2, (fintype.card_prod H K).trans h1⟩
 
 lemma is_complement'_iff_card_mul_and_disjoint [fintype G] [fintype H] [fintype K] :
   is_complement' H K ↔
@@ -402,8 +420,85 @@ begin
   refine ⟨⟨h⁻¹, h * g, hh'⟩, inv_mul_cancel_left h g, _⟩,
   rintros ⟨h', g, hg : g • a = a⟩ rfl,
   specialize h1 (h * h') (by rwa [mul_smul, smul_def h', ←hg, ←mul_smul, hg]),
-  refine prod.ext (eq_inv_of_eq_inv (eq_inv_of_mul_eq_one h1)) (subtype.ext _),
+  refine prod.ext (eq_inv_of_mul_eq_one_right h1) (subtype.ext _),
   rwa [subtype.ext_iff, coe_one, coe_mul, ←self_eq_mul_left, mul_assoc ↑h ↑h' g] at h1,
 end
 
 end subgroup
+
+namespace subgroup
+
+open equiv function mem_left_transversals mul_action mul_action.quotient zmod
+
+universe u
+
+variables {G : Type u} [group G] (H : subgroup G) (g : G)
+
+/-- Partition `G ⧸ H` into orbits of the action of `g : G`. -/
+noncomputable def quotient_equiv_sigma_zmod : G ⧸ H ≃
+  Σ (q : orbit_rel.quotient (zpowers g) (G ⧸ H)), zmod (minimal_period ((•) g) q.out') :=
+(self_equiv_sigma_orbits (zpowers g) (G ⧸ H)).trans
+  (sigma_congr_right (λ q, orbit_zpowers_equiv g q.out'))
+
+lemma quotient_equiv_sigma_zmod_symm_apply
+  (q : orbit_rel.quotient (zpowers g) (G ⧸ H)) (k : zmod (minimal_period ((•) g) q.out')) :
+  (quotient_equiv_sigma_zmod H g).symm ⟨q, k⟩ = g ^ (k : ℤ) • q.out' :=
+rfl
+
+lemma quotient_equiv_sigma_zmod_apply (q : orbit_rel.quotient (zpowers g) (G ⧸ H)) (k : ℤ) :
+  quotient_equiv_sigma_zmod H g (g ^ k • q.out') = ⟨q, k⟩ :=
+by rw [apply_eq_iff_eq_symm_apply, quotient_equiv_sigma_zmod_symm_apply,
+  zmod.coe_int_cast, zpow_smul_mod_minimal_period]
+
+/-- The transfer transversal as a function. Given a `⟨g⟩`-orbit `q₀, g • q₀, ..., g ^ (m - 1) • q₀`
+  in `G ⧸ H`, an element `g ^ k • q₀` is mapped to `g ^ k • g₀` for a fixed choice of
+  representative `g₀` of `q₀`. -/
+noncomputable def transfer_function : G ⧸ H → G :=
+λ q, g ^ ((quotient_equiv_sigma_zmod H g q).2 : ℤ) * (quotient_equiv_sigma_zmod H g q).1.out'.out'
+
+lemma transfer_function_apply (q : G ⧸ H) : transfer_function H g q =
+  g ^ ((quotient_equiv_sigma_zmod H g q).2 : ℤ) * (quotient_equiv_sigma_zmod H g q).1.out'.out' :=
+rfl
+
+lemma coe_transfer_function (q : G ⧸ H) : ↑(transfer_function H g q) = q :=
+by rw [transfer_function_apply, ←smul_eq_mul, coe_smul_out',
+  ←quotient_equiv_sigma_zmod_symm_apply, sigma.eta, symm_apply_apply]
+
+/-- The transfer transversal as a set. Contains elements of the form `g ^ k • g₀` for fixed choices
+  of representatives `g₀` of fixed choices of representatives `q₀` of `⟨g⟩`-orbits in `G ⧸ H`. -/
+def transfer_set : set G :=
+set.range (transfer_function H g)
+
+lemma mem_transfer_set (q : G ⧸ H) : transfer_function H g q ∈ transfer_set H g :=
+⟨q, rfl⟩
+
+/-- The transfer transversal. Contains elements of the form `g ^ k • g₀` for fixed choices
+  of representatives `g₀` of fixed choices of representatives `q₀` of `⟨g⟩`-orbits in `G ⧸ H`. -/
+def transfer_transversal : left_transversals (H : set G) :=
+⟨transfer_set H g, range_mem_left_transversals (coe_transfer_function H g)⟩
+
+lemma transfer_transversal_apply (q : G ⧸ H) :
+  ↑(to_equiv (transfer_transversal H g).2 q) = transfer_function H g q :=
+to_equiv_apply (coe_transfer_function H g) q
+
+lemma transfer_transversal_apply'
+  (q : orbit_rel.quotient (zpowers g) (G ⧸ H)) (k : zmod (minimal_period ((•) g) q.out')) :
+  ↑(to_equiv (transfer_transversal H g).2 (g ^ (k : ℤ) • q.out')) = g ^ (k : ℤ) * q.out'.out' :=
+by rw [transfer_transversal_apply, transfer_function_apply,
+  ←quotient_equiv_sigma_zmod_symm_apply, apply_symm_apply]
+
+lemma transfer_transversal_apply''
+  (q : orbit_rel.quotient (zpowers g) (G ⧸ H)) (k : zmod (minimal_period ((•) g) q.out')) :
+  ↑(to_equiv (g • transfer_transversal H g).2 (g ^ (k : ℤ) • q.out')) =
+    if k = 0 then g ^ minimal_period ((•) g) q.out' * q.out'.out' else g ^ (k : ℤ) * q.out'.out' :=
+begin
+  rw [smul_apply_eq_smul_apply_inv_smul, transfer_transversal_apply, transfer_function_apply,
+      ←mul_smul, ←zpow_neg_one, ←zpow_add, quotient_equiv_sigma_zmod_apply, smul_eq_mul,
+      ←mul_assoc, ←zpow_one_add, int.cast_add, int.cast_neg, int.cast_one, int_cast_cast,
+      cast_id', id.def, ←sub_eq_neg_add, cast_sub_one, add_sub_cancel'_right],
+  by_cases hk : k = 0,
+  { rw [if_pos hk, if_pos hk, zpow_coe_nat] },
+  { rw [if_neg hk, if_neg hk] },
+end
+
+end subgroup
diff --git a/src/group_theory/congruence.lean b/src/group_theory/congruence.lean
index 4f1d62b46d190..857995ec74330 100644
--- a/src/group_theory/congruence.lean
+++ b/src/group_theory/congruence.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Amelia Livingston
 -/
 import algebra.group.prod
-import algebra.hom.equiv
+import algebra.hom.equiv.basic
 import data.setoid.basic
 import group_theory.submonoid.operations
 
 /-!
 # Congruence relations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines congruence relations: equivalence relations that preserve a binary operation,
 which in this case is multiplication or addition. The principal definition is a `structure`
 extending a `setoid` (an equivalence relation), and the inductive definition of the smallest
@@ -274,8 +277,7 @@ quotient.eq'
 @[to_additive "The addition induced on the quotient by an additive congruence relation on a type
 with an addition."]
 instance has_mul : has_mul c.quotient :=
-⟨λ x y, quotient.lift_on₂' x y (λ w z, ((w * z : M) : c.quotient))
-     $ λ _ _ _ _ h1 h2, c.eq.2 $ c.mul h1 h2⟩
+⟨quotient.map₂' (*) $ λ _ _ h1 _ _ h2, c.mul h1 h2⟩
 
 /-- The kernel of the quotient map induced by a congruence relation `c` equals `c`. -/
 @[simp, to_additive "The kernel of the quotient map induced by an additive congruence relation
@@ -572,8 +574,8 @@ an `add_monoid`."]
 instance mul_one_class : mul_one_class c.quotient :=
 { one := ((1 : M) : c.quotient),
   mul := (*),
-  mul_one := λ x, quotient.induction_on' x $ λ _, congr_arg coe $ mul_one _,
-  one_mul := λ x, quotient.induction_on' x $ λ _, congr_arg coe $ one_mul _ }
+  mul_one := λ x, quotient.induction_on' x $ λ _, congr_arg (coe : M → c.quotient) $ mul_one _,
+  one_mul := λ x, quotient.induction_on' x $ λ _, congr_arg (coe : M → c.quotient) $ one_mul _ }
 
 variables {c}
 
@@ -662,6 +664,9 @@ quotient.surjective_quotient_mk'
 
 @[simp, to_additive] lemma coe_mk' : (c.mk' : M → c.quotient) = coe := rfl
 
+@[simp, to_additive] lemma mrange_mk' : c.mk'.mrange = ⊤ :=
+monoid_hom.mrange_top_iff_surjective.2 mk'_surjective
+
 /-- The elements related to `x ∈ M`, `M` a monoid, by the kernel of a monoid homomorphism are
     those in the preimage of `f(x)` under `f`. -/
 @[to_additive "The elements related to `x ∈ M`, `M` an `add_monoid`, by the kernel of
@@ -881,15 +886,18 @@ protected lemma pow {M : Type*} [monoid M] (c : con M) :
 instance {M : Type*} [mul_one_class M] (c : con M) : has_one c.quotient :=
 { one := ((1 : M) : c.quotient) }
 
+@[to_additive]
+lemma smul {α M : Type*} [mul_one_class M] [has_smul α M] [is_scalar_tower α M M] (c : con M)
+  (a : α) {w x : M} (h : c w x) : c (a • w) (a • x) :=
+by simpa only [smul_one_mul] using c.mul (c.refl' (a • 1 : M)) h
+
 instance _root_.add_con.quotient.has_nsmul
-  {M : Type*} [add_monoid M] (c : add_con M) : has_scalar ℕ c.quotient :=
-{ smul := λ n x, quotient.lift_on' x (λ w, ((n • w : M) : c.quotient))
-     $ λ x y h, c.eq.2 $ c.nsmul n h}
+  {M : Type*} [add_monoid M] (c : add_con M) : has_smul ℕ c.quotient :=
+{ smul := λ n, quotient.map' ((•) n) $ λ x y, c.nsmul n }
 
 @[to_additive add_con.quotient.has_nsmul]
 instance {M : Type*} [monoid M] (c : con M) : has_pow c.quotient ℕ :=
-{ pow := λ x n, quotient.lift_on' x (λ w, ((w ^ n : M) : c.quotient))
-     $ λ x y h, c.eq.2 $ c.pow n h}
+{ pow := λ x n, quotient.map' (λ x, x ^ n) (λ x y, c.pow n) x }
 
 /-- The quotient of a semigroup by a congruence relation is a semigroup. -/
 @[to_additive "The quotient of an `add_semigroup` by an additive congruence relation is
@@ -943,30 +951,26 @@ protected lemma zpow : ∀ (n : ℤ) {w x}, c w x → c (w ^ n) (x ^ n)
 @[to_additive "The negation induced on the quotient by an additive congruence relation on a type
 with an negation."]
 instance has_inv : has_inv c.quotient :=
-⟨λ x, quotient.lift_on' x (λ w, ((w⁻¹ : M) : c.quotient))
-     $ λ x y h, c.eq.2 $ c.inv h⟩
+⟨quotient.map' has_inv.inv $ λ a b, c.inv⟩
 
 /-- The division induced on the quotient by a congruence relation on a type with a
     division. -/
 @[to_additive "The subtraction induced on the quotient by an additive congruence relation on a type
 with a subtraction."]
 instance has_div : has_div c.quotient :=
-⟨λ x y, quotient.lift_on₂' x y (λ w z, ((w / z : M) : c.quotient))
-     $ λ _ _ _ _ h1 h2, c.eq.2 $ c.div h1 h2⟩
+⟨quotient.map₂' (/) $ λ _ _ h₁ _ _ h₂, c.div h₁ h₂⟩
 
 /-- The integer scaling induced on the quotient by a congruence relation on a type with a
     subtraction. -/
 instance _root_.add_con.quotient.has_zsmul
-  {M : Type*} [add_group M] (c : add_con M) : has_scalar ℤ c.quotient :=
-⟨λ z x, quotient.lift_on' x (λ w, ((z • w : M) : c.quotient))
-     $ λ x y h, c.eq.2 $ c.zsmul z h⟩
+  {M : Type*} [add_group M] (c : add_con M) : has_smul ℤ c.quotient :=
+⟨λ z, quotient.map' ((•) z) $ λ x y, c.zsmul z⟩
 
 /-- The integer power induced on the quotient by a congruence relation on a type with a
     division. -/
 @[to_additive add_con.quotient.has_zsmul]
 instance has_zpow : has_pow c.quotient ℤ :=
-⟨λ x z, quotient.lift_on' x (λ w, ((w ^ z : M) : c.quotient))
-     $ λ x y h, c.eq.2 $ c.zpow z h⟩
+⟨λ x z, quotient.map' (λ x, x ^ z) (λ x y h, c.zpow z h) x⟩
 
 /-- The quotient of a group by a congruence relation is a group. -/
 @[to_additive "The quotient of an `add_group` by an additive congruence relation is
@@ -1025,4 +1029,34 @@ end
 
 end units
 
+section actions
+
+@[to_additive]
+instance has_smul {α M : Type*} [mul_one_class M] [has_smul α M] [is_scalar_tower α M M]
+  (c : con M) :
+  has_smul α c.quotient :=
+{ smul := λ a, quotient.map' ((•) a) $ λ x y, c.smul a }
+
+@[to_additive]
+lemma coe_smul {α M : Type*} [mul_one_class M] [has_smul α M] [is_scalar_tower α M M] (c : con M)
+  (a : α) (x : M) : (↑(a • x) : c.quotient) = a • ↑x := rfl
+
+@[to_additive]
+instance mul_action {α M : Type*} [monoid α] [mul_one_class M] [mul_action α M]
+  [is_scalar_tower α M M] (c : con M) :
+  mul_action α c.quotient :=
+{ smul := (•),
+  one_smul := quotient.ind' $ by exact λ x, congr_arg quotient.mk' $ one_smul _ _,
+  mul_smul := λ a₁ a₂, quotient.ind' $ by exact λ x, congr_arg quotient.mk' $ mul_smul _ _ _ }
+
+instance mul_distrib_mul_action {α M : Type*} [monoid α] [monoid M] [mul_distrib_mul_action α M]
+  [is_scalar_tower α M M] (c : con M) :
+  mul_distrib_mul_action α c.quotient :=
+{ smul := (•),
+  smul_one := λ r, congr_arg quotient.mk' $ smul_one _,
+  smul_mul := λ r, quotient.ind₂' $ by exact λ m₁ m₂, congr_arg quotient.mk' $ smul_mul' _ _ _,
+  .. c.mul_action }
+
+end actions
+
 end con
diff --git a/src/group_theory/coset.lean b/src/group_theory/coset.lean
index 84d750bca52d5..01fc5e6c7e3e5 100644
--- a/src/group_theory/coset.lean
+++ b/src/group_theory/coset.lean
@@ -5,12 +5,17 @@ Authors: Mitchell Rowett, Scott Morrison
 -/
 
 import algebra.quotient
-import group_theory.subgroup.basic
+import data.fintype.prod
+import group_theory.group_action.basic
+import group_theory.subgroup.mul_opposite
 import tactic.group
 
 /-!
 # Cosets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file develops the basic theory of left and right cosets.
 
 ## Main definitions
@@ -34,10 +39,6 @@ This file develops the basic theory of left and right cosets.
 * `s +r a`: for `right_add_coset s a`.
 
 * `G ⧸ H` is the quotient of the (additive) group `G` by the (additive) subgroup `H`
-
-## TODO
-
-Add `to_additive` to `preimage_mk_equiv_subgroup_times_set`.
 -/
 
 open set function
@@ -54,10 +55,10 @@ def left_coset [has_mul α] (a : α) (s : set α) : set α := (λ x, a * x) '' s
 and a subset `s : set α`"]
 def right_coset [has_mul α] (s : set α) (a : α) : set α := (λ x, x * a) '' s
 
-localized "infix ` *l `:70 := left_coset" in coset
-localized "infix ` +l `:70 := left_add_coset" in coset
-localized "infix ` *r `:70 := right_coset" in coset
-localized "infix ` +r `:70 := right_add_coset" in coset
+localized "infix (name := left_coset) ` *l `:70 := left_coset" in coset
+localized "infix (name := left_add_coset) ` +l `:70 := left_add_coset" in coset
+localized "infix (name := right_coset) ` *r `:70 := right_coset" in coset
+localized "infix (name := right_add_coset) ` +r `:70 := right_add_coset" in coset
 
 section coset_mul
 variable [has_mul α]
@@ -170,6 +171,16 @@ set.ext $ by simp [mem_left_coset_iff, mul_mem_cancel_left (s.inv_mem ha)]
 lemma right_coset_mem_right_coset {a : α} (ha : a ∈ s) : (s : set α) *r a = s :=
 set.ext $ assume b, by simp [mem_right_coset_iff, mul_mem_cancel_right (s.inv_mem ha)]
 
+@[to_additive] lemma orbit_subgroup_eq_right_coset (a : α) : mul_action.orbit s a = s *r a :=
+set.ext (λ b, ⟨λ ⟨c, d⟩, ⟨c, c.2, d⟩, λ ⟨c, d, e⟩, ⟨⟨c, d⟩, e⟩⟩)
+
+@[to_additive] lemma orbit_subgroup_eq_self_of_mem {a : α} (ha : a ∈ s) :
+  mul_action.orbit s a = s :=
+(orbit_subgroup_eq_right_coset s a).trans (right_coset_mem_right_coset s ha)
+
+@[to_additive] lemma orbit_subgroup_one_eq_self : mul_action.orbit s (1 : α) = s :=
+orbit_subgroup_eq_self_of_mem s s.one_mem
+
 @[to_additive eq_add_cosets_of_normal]
 theorem eq_cosets_of_normal (N : s.normal) (g : α) : g *l s = s *r g :=
 set.ext $ assume a, by simp [mem_left_coset_iff, mem_right_coset_iff]; rw [N.mem_comm_iff]
@@ -215,16 +226,31 @@ variables [group α] (s : subgroup α)
 of a subgroup.-/
 @[to_additive "The equivalence relation corresponding to the partition of a group by left cosets
 of a subgroup."]
-def left_rel : setoid α :=
-⟨λ x y, x⁻¹ * y ∈ s, by { simp_rw ←left_coset_eq_iff, exact left_coset_equivalence_rel s }⟩
+def left_rel : setoid α := mul_action.orbit_rel s.opposite α
+
+variables {s}
+
+@[to_additive]
+lemma left_rel_apply {x y : α} : @setoid.r _ (left_rel s) x y ↔ (x⁻¹ * y ∈ s) :=
+calc (∃ a : s.opposite, y * mul_opposite.unop a = x)
+    ↔ ∃ a : s, y * a = x : s.opposite_equiv.symm.exists_congr_left
+... ↔ ∃ a : s, x⁻¹ * y = a⁻¹ : by simp only [inv_mul_eq_iff_eq_mul, eq_mul_inv_iff_mul_eq]
+... ↔ x⁻¹ * y ∈ s : by simp [set_like.exists]
+
+variables (s)
+
+@[to_additive]
+lemma left_rel_eq : @setoid.r _ (left_rel s) = λ x y, x⁻¹ * y ∈ s :=
+funext₂ $ by { simp only [eq_iff_iff], apply left_rel_apply }
 
 lemma left_rel_r_eq_left_coset_equivalence :
   @setoid.r _ (quotient_group.left_rel s) = left_coset_equivalence s :=
-by { ext, exact (left_coset_eq_iff s).symm }
+by { ext, rw left_rel_eq, exact (left_coset_eq_iff s).symm }
 
 @[to_additive]
 instance left_rel_decidable [decidable_pred (∈ s)] :
-  decidable_rel (left_rel s).r := λ x y, ‹decidable_pred (∈ s)› _
+  decidable_rel (left_rel s).r :=
+λ x y, by { rw left_rel_eq, exact ‹decidable_pred (∈ s)› _ }
 
 /-- `α ⧸ s` is the quotient type representing the left cosets of `s`.
   If `s` is a normal subgroup, `α ⧸ s` is a group -/
@@ -236,22 +262,38 @@ instance : has_quotient α (subgroup α) := ⟨λ s, quotient (left_rel s)⟩
 subgroup. -/
 @[to_additive "The equivalence relation corresponding to the partition of a group by right cosets of
 a subgroup."]
-def right_rel : setoid α :=
-⟨λ x y, y * x⁻¹ ∈ s, by { simp_rw ←right_coset_eq_iff, exact right_coset_equivalence_rel s }⟩
+def right_rel : setoid α := mul_action.orbit_rel s α
+
+variables {s}
+
+@[to_additive]
+lemma right_rel_apply {x y : α} : @setoid.r _ (right_rel s) x y ↔ (y * x⁻¹ ∈ s) :=
+calc (∃ a : s, (a:α) * y = x)
+    ↔ ∃ a : s, y * x⁻¹ = a⁻¹ : by simp only [mul_inv_eq_iff_eq_mul, eq_inv_mul_iff_mul_eq]
+... ↔ y * x⁻¹ ∈ s : by simp [set_like.exists]
+
+variables (s)
+
+@[to_additive]
+lemma right_rel_eq : @setoid.r _ (right_rel s) = λ x y, y * x⁻¹ ∈ s :=
+funext₂ $ by { simp only [eq_iff_iff], apply right_rel_apply }
 
 lemma right_rel_r_eq_right_coset_equivalence :
   @setoid.r _ (quotient_group.right_rel s) = right_coset_equivalence s :=
-by { ext, exact (right_coset_eq_iff s).symm }
+by { ext, rw right_rel_eq, exact (right_coset_eq_iff s).symm }
 
 @[to_additive]
 instance right_rel_decidable [decidable_pred (∈ s)] :
-  decidable_rel (right_rel s).r := λ x y, ‹decidable_pred (∈ s)› _
+  decidable_rel (right_rel s).r :=
+λ x y, by { rw right_rel_eq, exact ‹decidable_pred (∈ s)› _ }
 
 /-- Right cosets are in bijection with left cosets. -/
 @[to_additive "Right cosets are in bijection with left cosets."]
 def quotient_right_rel_equiv_quotient_left_rel : quotient (quotient_group.right_rel s) ≃ α ⧸ s :=
-{ to_fun := quotient.map' (λ g, g⁻¹) (λ a b h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h)),
-  inv_fun := quotient.map' (λ g, g⁻¹) (λ a b h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h)),
+{ to_fun := quotient.map' (λ g, g⁻¹) (λ a b, by { rw [left_rel_apply, right_rel_apply],
+      exact λ h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h) }),
+  inv_fun := quotient.map' (λ g, g⁻¹) (λ a b, by { rw [left_rel_apply, right_rel_apply],
+      exact λ h, (congr_arg (∈ s) (by group)).mp (s.inv_mem h) }),
   left_inv := λ g, quotient.induction_on' g (λ g, quotient.sound' (by
   { simp only [inv_inv],
     exact quotient.exact' rfl })),
@@ -303,10 +345,11 @@ quotient.induction_on' x H
 lemma quotient_lift_on_coe {β} (f : α → β) (h) (x : α) :
   quotient.lift_on' (x : α ⧸ s) f h = f x := rfl
 
-@[to_additive]
-lemma forall_coe {C : α ⧸ s → Prop} :
-  (∀ x : α ⧸ s, C x) ↔ ∀ x : α, C x :=
-⟨λ hx x, hx _, quot.ind⟩
+@[to_additive] lemma forall_coe {C : α ⧸ s → Prop} : (∀ x : α ⧸ s, C x) ↔ ∀ x : α, C x :=
+mk_surjective.forall
+
+@[to_additive] lemma exists_coe {C : α ⧸ s → Prop} : (∃ x : α ⧸ s, C x) ↔ ∃ x : α, C x :=
+mk_surjective.exists
 
 @[to_additive]
 instance (s : subgroup α) : inhabited (α ⧸ s) :=
@@ -314,13 +357,14 @@ instance (s : subgroup α) : inhabited (α ⧸ s) :=
 
 @[to_additive quotient_add_group.eq]
 protected lemma eq {a b : α} : (a : α ⧸ s) = b ↔ a⁻¹ * b ∈ s :=
-quotient.eq'
+calc _ ↔ @setoid.r _ (left_rel s) a b : quotient.eq'
+... ↔ _ : by rw left_rel_apply
 
 @[to_additive quotient_add_group.eq']
 lemma eq' {a b : α} : (mk a : α ⧸ s) = mk b ↔ a⁻¹ * b ∈ s :=
 quotient_group.eq
 
-@[to_additive quotient_add_group.out_eq']
+@[simp, to_additive quotient_add_group.out_eq']
 lemma out_eq' (a : α ⧸ s) : mk a.out' = a :=
 quotient.out_eq' a
 
@@ -333,10 +377,10 @@ variables (s)
 lemma mk_out'_eq_mul (g : α) : ∃ h : s, (mk g : α ⧸ s).out' = g * h :=
 ⟨⟨g⁻¹ * (mk g).out', eq'.mp (mk g).out_eq'.symm⟩, by rw [set_like.coe_mk, mul_inv_cancel_left]⟩
 
-variables {s}
+variables {s} {a b : α}
 
-@[to_additive quotient_add_group.mk_mul_of_mem]
-lemma mk_mul_of_mem (g₁ g₂ : α) (hg₂ : g₂ ∈ s) : (mk (g₁ * g₂) : α ⧸ s) = mk g₁ :=
+@[simp, to_additive quotient_add_group.mk_add_of_mem]
+lemma mk_mul_of_mem (a : α) (hb : b ∈ s) : (mk (a * b) : α ⧸ s) = mk a :=
 by rwa [eq', mul_inv_rev, inv_mul_cancel_right, s.inv_mem_iff]
 
 @[to_additive]
@@ -399,6 +443,18 @@ calc α ≃ Σ L : α ⧸ s, {x : α // (x : α ⧸ s) = L} :
 
 variables {t : subgroup α}
 
+/-- If two subgroups `M` and `N` of `G` are equal, their quotients are in bijection. -/
+@[to_additive "If two subgroups `M` and `N` of `G` are equal, their quotients are in bijection."]
+def quotient_equiv_of_eq (h : s = t) : α ⧸ s ≃ α ⧸ t :=
+{ to_fun := quotient.map' id (λ a b h', h ▸ h'),
+  inv_fun := quotient.map' id (λ a b h', h.symm ▸ h'),
+  left_inv := λ q, induction_on' q (λ g, rfl),
+  right_inv := λ q, induction_on' q (λ g, rfl) }
+
+lemma quotient_equiv_of_eq_mk (h : s = t) (a : α) :
+  quotient_equiv_of_eq h (quotient_group.mk a) = (quotient_group.mk a) :=
+rfl
+
 /-- If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
 of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_of_le`. -/
 @[to_additive "If `H ≤ K`, then `G/H ≃ G/K × K/H` constructively, using the provided right inverse
@@ -406,13 +462,17 @@ of the quotient map `G → G/K`. The classical version is `quotient_equiv_prod_o
 def quotient_equiv_prod_of_le' (h_le : s ≤ t)
   (f : α ⧸ t → α) (hf : function.right_inverse f quotient_group.mk) :
   α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
-{ to_fun := λ a, ⟨a.map' id (λ b c h, h_le h),
-    a.map' (λ g : α, ⟨(f (quotient.mk' g))⁻¹ * g, quotient.exact' (hf g)⟩) (λ b c h, by
-    { change ((f b)⁻¹ * b)⁻¹ * ((f c)⁻¹ * c) ∈ s,
-      have key : f b = f c := congr_arg f (quotient.sound' (h_le h)),
-      rwa [key, mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_left] })⟩,
+{ to_fun := λ a, ⟨a.map' id (λ b c h, left_rel_apply.mpr (h_le (left_rel_apply.mp h))),
+    a.map' (λ g : α, ⟨(f (quotient.mk' g))⁻¹ * g, left_rel_apply.mp (quotient.exact' (hf g))⟩)
+    (λ b c h, by
+    { rw left_rel_apply,
+      change ((f b)⁻¹ * b)⁻¹ * ((f c)⁻¹ * c) ∈ s,
+      have key : f b = f c :=
+        congr_arg f (quotient.sound' (left_rel_apply.mpr (h_le (left_rel_apply.mp h)))),
+      rwa [key, mul_inv_rev, inv_inv, mul_assoc, mul_inv_cancel_left, ← left_rel_apply] })⟩,
   inv_fun := λ a, a.2.map' (λ b, f a.1 * b) (λ b c h, by
-  { change (f a.1 * b)⁻¹ * (f a.1 * c) ∈ s,
+  { rw left_rel_apply at ⊢ h,
+    change (f a.1 * b)⁻¹ * (f a.1 * c) ∈ s,
     rwa [mul_inv_rev, mul_assoc, inv_mul_cancel_left] }),
   left_inv := by
   { refine quotient.ind' (λ a, _),
@@ -422,7 +482,7 @@ def quotient_equiv_prod_of_le' (h_le : s ≤ t)
     refine quotient.ind' (λ a, _),
     refine quotient.ind' (λ b, _),
     have key : quotient.mk' (f (quotient.mk' a) * b) = quotient.mk' a :=
-      (quotient_group.mk_mul_of_mem (f a) ↑b b.2).trans (hf a),
+      (quotient_group.mk_mul_of_mem (f a) b.2).trans (hf a),
     simp_rw [quotient.map'_mk', id.def, key, inv_mul_cancel_left, subtype.coe_eta] } }
 
 /-- If `H ≤ K`, then `G/H ≃ G/K × K/H` nonconstructively.
@@ -433,13 +493,67 @@ noncomputable def quotient_equiv_prod_of_le (h_le : s ≤ t) :
   α ⧸ s ≃ (α ⧸ t) × (t ⧸ s.subgroup_of t) :=
 quotient_equiv_prod_of_le' h_le quotient.out' quotient.out_eq'
 
-/-- If `K ≤ L`, then there is an embedding `K ⧸ (H.subgroup_of K) ↪ L ⧸ (H.subgroup_of L)`. -/
-@[to_additive "If `K ≤ L`, then there is an embedding
-  `K ⧸ (H.add_subgroup_of K) ↪ L ⧸ (H.add_subgroup_of L)`."]
-def quotient_subgroup_of_embedding_of_le (H : subgroup α) {K L : subgroup α} (h : K ≤ L) :
-  K ⧸ (H.subgroup_of K) ↪ L ⧸ (H.subgroup_of L) :=
-{ to_fun := quotient.map' (set.inclusion h) (λ a b, id),
-  inj' := by refine quotient.ind₂' (λ a b, _); exact quotient.eq'.mpr ∘ quotient.eq'.mp }
+/-- If `s ≤ t`, then there is an embedding `s ⧸ H.subgroup_of s ↪ t ⧸ H.subgroup_of t`. -/
+@[to_additive "If `s ≤ t`, then there is an embedding
+  `s ⧸ H.add_subgroup_of s ↪ t ⧸ H.add_subgroup_of t`."]
+def quotient_subgroup_of_embedding_of_le (H : subgroup α) (h : s ≤ t) :
+  s ⧸ H.subgroup_of s ↪ t ⧸ H.subgroup_of t :=
+{ to_fun := quotient.map' (inclusion h) (λ a b, by { simp_rw left_rel_eq, exact id }),
+  inj' := quotient.ind₂' $ by { intros a b h, simpa only [quotient.map'_mk', eq'] using h } }
+
+@[simp, to_additive]
+lemma quotient_subgroup_of_embedding_of_le_apply_mk (H : subgroup α) (h : s ≤ t) (g : s) :
+  quotient_subgroup_of_embedding_of_le H h (quotient_group.mk g) =
+    quotient_group.mk (inclusion h g) :=
+rfl
+
+/-- If `s ≤ t`, then there is a map `H ⧸ s.subgroup_of H → H ⧸ t.subgroup_of H`. -/
+@[to_additive "If `s ≤ t`, then there is an map
+  `H ⧸ s.add_subgroup_of H → H ⧸ t.add_subgroup_of H`."]
+def quotient_subgroup_of_map_of_le (H : subgroup α) (h : s ≤ t) :
+  H ⧸ s.subgroup_of H → H ⧸ t.subgroup_of H :=
+quotient.map' id $ λ a b, by { simp_rw [left_rel_eq], apply h }
+
+@[simp, to_additive]
+lemma quotient_subgroup_of_map_of_le_apply_mk (H : subgroup α) (h : s ≤ t) (g : H) :
+  quotient_subgroup_of_map_of_le H h (quotient_group.mk g) = quotient_group.mk g :=
+rfl
+
+/-- If `s ≤ t`, then there is a map `α ⧸ s → α ⧸ t`. -/
+@[to_additive "If `s ≤ t`, then there is an map `α ⧸ s → α ⧸ t`."]
+def quotient_map_of_le (h : s ≤ t) : α ⧸ s → α ⧸ t :=
+quotient.map' id $ λ a b, by { simp_rw [left_rel_eq], apply h }
+
+@[simp, to_additive]
+lemma quotient_map_of_le_apply_mk (h : s ≤ t) (g : α) :
+  quotient_map_of_le h (quotient_group.mk g) = quotient_group.mk g :=
+rfl
+
+/-- The natural embedding `H ⧸ (⨅ i, f i).subgroup_of H ↪ Π i, H ⧸ (f i).subgroup_of H`. -/
+@[to_additive "The natural embedding
+  `H ⧸ (⨅ i, f i).add_subgroup_of H) ↪ Π i, H ⧸ (f i).add_subgroup_of H`.", simps]
+def quotient_infi_subgroup_of_embedding {ι : Type*} (f : ι → subgroup α) (H : subgroup α) :
+  H ⧸ (⨅ i, f i).subgroup_of H ↪ Π i, H ⧸ (f i).subgroup_of H :=
+{ to_fun := λ q i, quotient_subgroup_of_map_of_le H (infi_le f i) q,
+  inj' := quotient.ind₂' $ by simp_rw [funext_iff, quotient_subgroup_of_map_of_le_apply_mk,
+    eq', mem_subgroup_of, mem_infi, imp_self, forall_const] }
+
+@[simp, to_additive] lemma quotient_infi_subgroup_of_embedding_apply_mk
+  {ι : Type*} (f : ι → subgroup α) (H : subgroup α) (g : H) (i : ι) :
+  quotient_infi_subgroup_of_embedding f H (quotient_group.mk g) i = quotient_group.mk g :=
+rfl
+
+/-- The natural embedding `α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i`. -/
+@[to_additive "The natural embedding `α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i`.", simps]
+def quotient_infi_embedding {ι : Type*} (f : ι → subgroup α) : α ⧸ (⨅ i, f i) ↪ Π i, α ⧸ f i :=
+{ to_fun := λ q i, quotient_map_of_le (infi_le f i) q,
+  inj' := quotient.ind₂' $ by simp_rw [funext_iff, quotient_map_of_le_apply_mk,
+    eq', mem_infi, imp_self, forall_const] }
+
+@[simp, to_additive] lemma quotient_infi_embedding_apply_mk
+  {ι : Type*} (f : ι → subgroup α) (g : α) (i : ι) :
+  quotient_infi_embedding f (quotient_group.mk g) i = quotient_group.mk g :=
+rfl
 
 @[to_additive] lemma card_eq_card_quotient_mul_card_subgroup
   [fintype α] (s : subgroup α) [fintype s] [decidable_pred (λ a, a ∈ s)] :
@@ -448,12 +562,14 @@ by rw ← fintype.card_prod;
   exact fintype.card_congr (subgroup.group_equiv_quotient_times_subgroup)
 
 /-- **Lagrange's Theorem**: The order of a subgroup divides the order of its ambient group. -/
-@[to_additive] lemma card_subgroup_dvd_card [fintype α] (s : subgroup α) [fintype s] :
+@[to_additive "**Lagrange's Theorem**: The order of an additive subgroup divides the order of its
+ambient group."]
+lemma card_subgroup_dvd_card [fintype α] (s : subgroup α) [fintype s] :
   fintype.card s ∣ fintype.card α :=
 by classical; simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_left ℕ]
 
-@[to_additive] lemma card_quotient_dvd_card [fintype α] (s : subgroup α)
-  [decidable_pred (λ a, a ∈ s)] [fintype s] : fintype.card (α ⧸ s) ∣ fintype.card α :=
+@[to_additive] lemma card_quotient_dvd_card [fintype α] (s : subgroup α) [decidable_pred (∈ s)] :
+  fintype.card (α ⧸ s) ∣ fintype.card α :=
 by simp [card_eq_card_quotient_mul_card_subgroup s, @dvd_mul_right ℕ]
 
 open fintype
@@ -485,25 +601,20 @@ namespace quotient_group
 
 variables [group α]
 
--- FIXME -- why is there no `to_additive`?
-
-/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α/s`, then
-there is a (typically non-canonical) bijection between the preimage of `t` in
-`α` and the product `s × t`. -/
-noncomputable def preimage_mk_equiv_subgroup_times_set
-  (s : subgroup α) (t : set (α ⧸ s)) : quotient_group.mk ⁻¹' t ≃ s × t :=
-have h : ∀ {x : α ⧸ s} {a : α}, x ∈ t → a ∈ s →
-  (quotient.mk' (quotient.out' x * a) : α ⧸ s) = quotient.mk' (quotient.out' x) :=
-    λ x a hx ha, quotient.sound' (show (quotient.out' x * a)⁻¹ * quotient.out' x ∈ s,
-      from (s.inv_mem_iff).1 $
-        by rwa [mul_inv_rev, inv_inv, ← mul_assoc, inv_mul_self, one_mul]),
-{ to_fun := λ ⟨a, ha⟩, ⟨⟨(quotient.out' (quotient.mk' a))⁻¹ * a,
-    @quotient.exact' _ (left_rel s) _ _ $ (quotient.out_eq' _)⟩,
-      ⟨quotient.mk' a, ha⟩⟩,
-  inv_fun := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, ⟨quotient.out' x * a, show quotient.mk' _ ∈ t,
-    by simp [h hx ha, hx]⟩,
+/-- If `s` is a subgroup of the group `α`, and `t` is a subset of `α ⧸ s`, then there is a
+(typically non-canonical) bijection between the preimage of `t` in `α` and the product `s × t`. -/
+@[to_additive "If `s` is a subgroup of the additive group `α`, and `t` is a subset of `α ⧸ s`, then
+there is a (typically non-canonical) bijection between the preimage of `t` in `α` and the product
+`s × t`."]
+noncomputable def preimage_mk_equiv_subgroup_times_set (s : subgroup α) (t : set (α ⧸ s)) :
+  quotient_group.mk ⁻¹' t ≃ s × t :=
+{ to_fun := λ a, ⟨⟨(quotient.out' (quotient_group.mk a))⁻¹ * a,
+    left_rel_apply.mp (@quotient.exact' _ (left_rel s) _ _ $ (quotient.out_eq' _))⟩,
+      ⟨quotient_group.mk a, a.2⟩⟩,
+  inv_fun := λ a, ⟨quotient.out' a.2.1 * a.1.1, show quotient_group.mk _ ∈ t,
+    by { rw [mk_mul_of_mem _ a.1.2, out_eq'], exact a.2.2 }⟩,
   left_inv := λ ⟨a, ha⟩, subtype.eq $ show _ * _ = a, by simp,
-  right_inv := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, show (_, _) = _, by simp [h hx ha] }
+  right_inv := λ ⟨⟨a, ha⟩, ⟨x, hx⟩⟩, by ext; simp [ha] }
 
 end quotient_group
 
diff --git a/src/group_theory/divisible.lean b/src/group_theory/divisible.lean
new file mode 100644
index 0000000000000..d31c71515a3e6
--- /dev/null
+++ b/src/group_theory/divisible.lean
@@ -0,0 +1,263 @@
+/-
+Copyright (c) 2022 Jujian Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jujian Zhang
+-/
+import group_theory.subgroup.pointwise
+import group_theory.quotient_group
+import algebra.group.pi
+
+/-!
+# Divisible Group and rootable group
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we define a divisible add monoid and a rootable monoid with some basic properties.
+
+## Main definition
+
+* `divisible_by A α`: An additive monoid `A` is said to be divisible by `α` iff for all `n ≠ 0 ∈ α`
+  and `y ∈ A`, there is an `x ∈ A` such that `n • x = y`. In this file, we adopt a constructive
+  approach, i.e. we ask for an explicit `div : A → α → A` function such that `div a 0 = 0` and
+  `n • div a n = a` for all `n ≠ 0 ∈ α`.
+* `rootable_by A α`: A monoid `A` is said to be rootable by `α` iff for all `n ≠ 0 ∈ α` and `y ∈ A`,
+  there is an `x ∈ A` such that `x^n = y`. In this file, we adopt a constructive approach, i.e. we
+  ask for an explicit `root : A → α → A` function such that `root a 0 = 1` and `(root a n)ⁿ = a` for
+  all `n ≠ 0 ∈ α`.
+
+## Main results
+
+For additive monoids and groups:
+
+* `divisible_by_of_smul_right_surj` : the constructive definition of divisiblity is implied by
+  the condition that `n • x = a` has solutions for all `n ≠ 0` and `a ∈ A`.
+* `smul_right_surj_of_divisible_by` : the constructive definition of divisiblity implies
+  the condition that `n • x = a` has solutions for all `n ≠ 0` and `a ∈ A`.
+* `prod.divisible_by` : `A × B` is divisible for any two divisible additive monoids.
+* `pi.divisible_by` : any product of divisble additive monoids is divisible.
+* `add_group.divisible_by_int_of_divisible_by_nat` : for additive groups, int divisiblity is implied
+  by nat divisiblity.
+* `add_group.divisible_by_nat_of_divisible_by_int` : for additive groups, nat divisiblity is implied
+  by int divisiblity.
+* `add_comm_group.divisible_by_int_of_smul_top_eq_top`: the constructive definition of divisiblity
+  is implied by the condition that `n • A = A` for all `n ≠ 0`.
+* `add_comm_group.smul_top_eq_top_of_divisible_by_int`: the constructive definition of divisiblity
+  implies the condition that `n • A = A` for all `n ≠ 0`.
+* `divisible_by_int_of_char_zero` : any field of characteristic zero is divisible.
+* `quotient_add_group.divisible_by` : quotient group of divisible group is divisible.
+* `function.surjective.divisible_by` : if `A` is divisible and `A →+ B` is surjective, then `B`
+  is divisible.
+
+and their multiplicative counterparts:
+
+* `rootable_by_of_pow_left_surj` : the constructive definition of rootablity is implied by the
+  condition that `xⁿ = y` has solutions for all `n ≠ 0` and `a ∈ A`.
+* `pow_left_surj_of_rootable_by` : the constructive definition of rootablity implies the
+  condition that `xⁿ = y` has solutions for all `n ≠ 0` and `a ∈ A`.
+* `prod.rootable_by` : any product of two rootable monoids is rootable.
+* `pi.rootable_by` : any product of rootable monoids is rootable.
+* `group.rootable_by_int_of_rootable_by_nat` : in groups, int rootablity is implied by nat
+  rootablity.
+* `group.rootable_by_nat_of_rootable_by_int` : in groups, nat rootablity is implied by int
+  rootablity.
+* `quotient_group.rootable_by` : quotient group of rootable group is rootable.
+* `function.surjective.rootable_by` : if `A` is rootable and `A →* B` is surjective, then `B` is
+  rootable.
+
+TODO: Show that divisibility implies injectivity in the category of `AddCommGroup`.
+-/
+
+open_locale pointwise
+
+section add_monoid
+
+variables (A α : Type*) [add_monoid A] [has_smul α A] [has_zero α]
+
+/--
+An `add_monoid A` is `α`-divisible iff `n • x = a` has a solution for all `n ≠ 0 ∈ α` and `a ∈ A`.
+Here we adopt a constructive approach where we ask an explicit `div : A → α → A` function such that
+* `div a 0 = 0` for all `a ∈ A`
+* `n • div a n = a` for all `n ≠ 0 ∈ α` and `a ∈ A`.
+-/
+class divisible_by :=
+(div : A → α → A)
+(div_zero : ∀ a, div a 0 = 0)
+(div_cancel : ∀ {n : α} (a : A), n ≠ 0 → n • (div a n) = a)
+
+end add_monoid
+
+section monoid
+
+variables (A α : Type*) [monoid A] [has_pow A α] [has_zero α]
+
+/--
+A `monoid A` is `α`-rootable iff `xⁿ = a` has a solution for all `n ≠ 0 ∈ α` and `a ∈ A`.
+Here we adopt a constructive approach where we ask an explicit `root : A → α → A` function such that
+* `root a 0 = 1` for all `a ∈ A`
+* `(root a n)ⁿ = a` for all `n ≠ 0 ∈ α` and `a ∈ A`.
+-/
+@[to_additive]
+class rootable_by :=
+(root : A → α → A)
+(root_zero : ∀ a, root a 0 = 1)
+(root_cancel : ∀ {n : α} (a : A), n ≠ 0 → (root a n)^n = a)
+
+@[to_additive smul_right_surj_of_divisible_by]
+lemma pow_left_surj_of_rootable_by [rootable_by A α] {n : α} (hn : n ≠ 0) :
+  function.surjective (λ a, pow a n : A → A) :=
+λ x, ⟨rootable_by.root x n, rootable_by.root_cancel _ hn⟩
+
+/--
+A `monoid A` is `α`-rootable iff the `pow _ n` function is surjective, i.e. the constructive version
+implies the textbook approach.
+-/
+@[to_additive divisible_by_of_smul_right_surj
+"An `add_monoid A` is `α`-divisible iff `n • _` is a surjective function, i.e. the constructive
+version implies the textbook approach."]
+noncomputable def rootable_by_of_pow_left_surj
+  (H : ∀ {n : α}, n ≠ 0 → function.surjective (λ a, a^n : A → A)) :
+rootable_by A α :=
+{ root := λ a n, @dite _ (n = 0) (classical.dec _) (λ _, (1 : A)) (λ hn, (H hn a).some),
+  root_zero := λ _, by classical; exact dif_pos rfl,
+  root_cancel := λ n a hn, by { classical, rw dif_neg hn, exact (H hn a).some_spec } }
+
+section pi
+
+variables {ι β : Type*} (B : ι → Type*) [Π (i : ι), has_pow (B i) β]
+variables [has_zero β] [Π (i : ι), monoid (B i)] [Π i, rootable_by (B i) β]
+
+@[to_additive]
+instance pi.rootable_by : rootable_by (Π i, B i) β :=
+{ root := λ x n i, rootable_by.root (x i) n,
+  root_zero := λ x, funext $ λ i, rootable_by.root_zero _,
+  root_cancel := λ n x hn, funext $ λ i, rootable_by.root_cancel _ hn }
+
+end pi
+
+section prod
+
+variables {β B B' : Type*} [has_pow B β] [has_pow B' β]
+variables [has_zero β] [monoid B] [monoid B'] [rootable_by B β] [rootable_by B' β]
+
+@[to_additive]
+instance prod.rootable_by : rootable_by (B × B') β :=
+{ root := λ p n, (rootable_by.root p.1 n, rootable_by.root p.2 n),
+  root_zero := λ p, prod.ext (rootable_by.root_zero _) (rootable_by.root_zero _),
+  root_cancel := λ n p hn, prod.ext (rootable_by.root_cancel _ hn) (rootable_by.root_cancel _ hn) }
+
+end prod
+
+end monoid
+
+namespace add_comm_group
+
+variables (A : Type*) [add_comm_group A]
+
+lemma smul_top_eq_top_of_divisible_by_int [divisible_by A ℤ] {n : ℤ} (hn : n ≠ 0) :
+  n • (⊤ : add_subgroup A) = ⊤ :=
+add_subgroup.map_top_of_surjective _ $ λ a, ⟨divisible_by.div a n, divisible_by.div_cancel _ hn⟩
+
+/--
+If for all `n ≠ 0 ∈ ℤ`, `n • A = A`, then `A` is divisible.
+-/
+noncomputable def divisible_by_int_of_smul_top_eq_top
+  (H : ∀ {n : ℤ} (hn : n ≠ 0), n • (⊤ : add_subgroup A) = ⊤) :
+  divisible_by A ℤ :=
+{ div := λ a n, if hn : n = 0 then 0 else
+    (show a ∈ n • (⊤ : add_subgroup A), by rw [H hn]; trivial).some,
+  div_zero := λ a, dif_pos rfl,
+  div_cancel := λ n a hn, begin
+    rw [dif_neg hn],
+    generalize_proofs h1,
+    exact h1.some_spec.2,
+  end }
+
+end add_comm_group
+
+@[priority 100]
+instance divisible_by_int_of_char_zero {𝕜} [division_ring 𝕜] [char_zero 𝕜] : divisible_by 𝕜 ℤ :=
+{ div := λ q n, q / n,
+  div_zero := λ q, by norm_num,
+  div_cancel := λ n q hn,
+    by rw [zsmul_eq_mul, (int.cast_commute n _).eq, div_mul_cancel q (int.cast_ne_zero.mpr hn)] }
+
+namespace group
+
+variables (A : Type*) [group A]
+
+/--
+A group is `ℤ`-rootable if it is `ℕ`-rootable.
+-/
+@[to_additive add_group.divisible_by_int_of_divisible_by_nat
+"An additive group is `ℤ`-divisible if it is `ℕ`-divisible."]
+def rootable_by_int_of_rootable_by_nat [rootable_by A ℕ] : rootable_by A ℤ :=
+{ root := λ a z, match z with
+  | (n : ℕ) := rootable_by.root a n
+  | -[1+n] := (rootable_by.root a (n + 1))⁻¹
+  end,
+  root_zero := λ a, rootable_by.root_zero a,
+  root_cancel := λ n a hn, begin
+    induction n,
+    { change (rootable_by.root a _) ^ _ = a,
+      norm_num,
+      rw [rootable_by.root_cancel],
+      rw [int.of_nat_eq_coe] at hn,
+      exact_mod_cast hn, },
+    { change ((rootable_by.root a _) ⁻¹)^_ = a,
+      norm_num,
+      rw [rootable_by.root_cancel],
+      norm_num, }
+  end}
+
+/--A group is `ℕ`-rootable if it is `ℤ`-rootable
+-/
+@[to_additive add_group.divisible_by_nat_of_divisible_by_int
+"An additive group is `ℕ`-divisible if it `ℤ`-divisible."]
+def rootable_by_nat_of_rootable_by_int [rootable_by A ℤ] : rootable_by A ℕ :=
+{ root := λ a n, rootable_by.root a (n : ℤ),
+  root_zero := λ a, rootable_by.root_zero a,
+  root_cancel := λ n a hn, begin
+    have := rootable_by.root_cancel a (show (n : ℤ) ≠ 0, by exact_mod_cast hn),
+    norm_num at this,
+    exact this,
+  end }
+
+end group
+
+section hom
+
+variables {α A B : Type*}
+variables [has_zero α] [monoid A] [monoid B] [has_pow A α] [has_pow B α] [rootable_by A α]
+variables (f : A → B)
+
+/--
+If `f : A → B` is a surjective homomorphism and `A` is `α`-rootable, then `B` is also `α`-rootable.
+-/
+@[to_additive "If `f : A → B` is a surjective homomorphism and
+`A` is `α`-divisible, then `B` is also `α`-divisible."]
+noncomputable def function.surjective.rootable_by (hf : function.surjective f)
+  (hpow : ∀ (a : A) (n : α), f (a ^ n) = f a ^ n) : rootable_by B α :=
+rootable_by_of_pow_left_surj _ _ $ λ n hn x,
+  let ⟨y, hy⟩ := hf x in ⟨f $ rootable_by.root y n, (by rw [←hpow (rootable_by.root y n) n,
+    rootable_by.root_cancel _ hn, hy] : _ ^ _ = x)⟩
+
+@[to_additive divisible_by.surjective_smul]
+lemma rootable_by.surjective_pow
+  (A α : Type*) [monoid A] [has_pow A α] [has_zero α] [rootable_by A α] {n : α} (hn : n ≠ 0) :
+  function.surjective (λ (a : A), a^n) :=
+λ a, ⟨rootable_by.root a n, rootable_by.root_cancel a hn⟩
+
+end hom
+
+section quotient
+
+variables (α : Type*) {A : Type*} [comm_group A] (B : subgroup A)
+
+/-- Any quotient group of a rootable group is rootable. -/
+@[to_additive quotient_add_group.divisible_by
+"Any quotient group of a divisible group is divisible"]
+noncomputable instance quotient_group.rootable_by [rootable_by A ℕ] : rootable_by (A ⧸ B) ℕ :=
+quotient_group.mk_surjective.rootable_by _ $ λ _ _, rfl
+
+end quotient
diff --git a/src/group_theory/double_coset.lean b/src/group_theory/double_coset.lean
index 67b06f2a43f62..f7a35dcafbaee 100644
--- a/src/group_theory/double_coset.lean
+++ b/src/group_theory/double_coset.lean
@@ -13,6 +13,9 @@ import tactic.group
 /-!
 # Double cosets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines double cosets for two subgroups `H K` of a group `G` and the quotient of `G` by
 the double coset relation, i.e. `H \ G / K`. We also prove that `G` can be writen as a disjoint
 union of the double cosets and that if one of `H` or `K` is the trivial group (i.e. `⊥` ) then
@@ -85,7 +88,7 @@ lemma bot_rel_eq_left_rel (H : subgroup G) :
   (setoid ↑(⊥ : subgroup G) ↑H).rel = (quotient_group.left_rel H).rel :=
 begin
   ext a b,
-  rw rel_iff,
+  rw [rel_iff, setoid.rel, quotient_group.left_rel_apply],
   split,
   { rintros ⟨a, (rfl : a = 1), b, hb, rfl⟩,
     change a⁻¹ * (1 * a * b) ∈ H,
@@ -98,7 +101,7 @@ lemma rel_bot_eq_right_group_rel (H : subgroup G) :
   (setoid ↑H ↑(⊥ : subgroup G)).rel = (quotient_group.right_rel H).rel :=
 begin
   ext a b,
-  rw rel_iff,
+  rw [rel_iff, setoid.rel, quotient_group.right_rel_apply],
   split,
   { rintros ⟨b, hb, a, (rfl : a = 1), rfl⟩,
     change b * a * 1 * a⁻¹ ∈ H,
diff --git a/src/group_theory/eckmann_hilton.lean b/src/group_theory/eckmann_hilton.lean
index 9ac8e44c83bdc..96230eae00de6 100644
--- a/src/group_theory/eckmann_hilton.lean
+++ b/src/group_theory/eckmann_hilton.lean
@@ -8,6 +8,9 @@ import algebra.group.defs
 /-!
 # Eckmann-Hilton argument
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Eckmann-Hilton argument says that if a type carries two monoid structures that distribute
 over one another, then they are equal, and in addition commutative.
 The main application lies in proving that higher homotopy groups (`πₙ` for `n ≥ 2`) are commutative.
@@ -27,7 +30,7 @@ universe u
 namespace eckmann_hilton
 variables {X : Type u}
 
-local notation a `<`m`>` b := m a b
+local notation a ` <`m`> ` b := m a b
 
 /-- `is_unital m e` expresses that `e : X` is a left and right unit
 for the binary operation `m : X → X → X`. -/
@@ -81,8 +84,8 @@ omit h₁ h₂ distrib
 
 /-- If a type carries a unital magma structure that distributes over a unital binary
 operations, then the magma structure is a commutative monoid. -/
-@[to_additive "If a type carries a unital additive magma structure that distributes over a
-unital binary operations, then the additive magma structure is a commutative additive monoid."]
+@[reducible, to_additive "If a type carries a unital additive magma structure that distributes over
+a unital binary operations, then the additive magma structure is a commutative additive monoid."]
 def comm_monoid [h : mul_one_class X]
   (distrib : ∀ a b c d, ((a * b)  (c * d)) = ((a  c) * (b  d))) : comm_monoid X :=
 { mul := (*),
@@ -93,8 +96,8 @@ def comm_monoid [h : mul_one_class X]
 
 /-- If a type carries a group structure that distributes over a unital binary operation,
 then the group is commutative. -/
-@[to_additive "If a type carries an additive group structure that distributes
-over a unital binary operation, then the additive group is commutative."]
+@[reducible, to_additive "If a type carries an additive group structure that
+distributes over a unital binary operation, then the additive group is commutative."]
 def comm_group [G : group X]
   (distrib : ∀ a b c d, ((a * b)  (c * d)) = ((a  c) * (b  d))) : comm_group X :=
 { ..(eckmann_hilton.comm_monoid h₁ distrib),
diff --git a/src/group_theory/exponent.lean b/src/group_theory/exponent.lean
index 7dbc8923e5e68..76bfdd346d6c5 100644
--- a/src/group_theory/exponent.lean
+++ b/src/group_theory/exponent.lean
@@ -3,15 +3,19 @@ Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Julian Kuelshammer
 -/
+import data.zmod.quotient
+import group_theory.noncomm_pi_coprod
 import group_theory.order_of_element
-import algebra.punit_instances
 import algebra.gcd_monoid.finset
+import data.nat.factorization.basic
 import tactic.by_contra
-import number_theory.padics.padic_val
 
 /-!
 # Exponent of a group
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the exponent of a group, or more generally a monoid. For a group `G` it is defined
 to be the minimal `n≥1` such that `g ^ n = 1` for all `g ∈ G`. For a finite group `G`,
 it is equal to the lowest common multiple of the order of all elements of the group `G`.
@@ -178,7 +182,7 @@ begin
     { simpa using mt (exponent_dvd_of_forall_pow_eq_one G (exponent G / p)) key },
     exact λ hd, hp.one_lt.not_le ((mul_le_iff_le_one_left he).mp $
                 nat.le_of_dvd he $ nat.mul_dvd_of_dvd_div (nat.dvd_of_mem_factorization h) hd) },
-  obtain ⟨k, hk : exponent G = p ^ _ * k⟩ := nat.pow_factorization_dvd _ _,
+  obtain ⟨k, hk : exponent G = p ^ _ * k⟩ := nat.ord_proj_dvd _ _,
   obtain ⟨t, ht⟩ := nat.exists_eq_succ_of_ne_zero (finsupp.mem_support_iff.mp h),
   refine ⟨g ^ k, _⟩,
   rw ht,
@@ -195,7 +199,7 @@ variable {G}
 begin
   refine ⟨λ he, _, λ he, _⟩,
   { by_contra h,
-    obtain ⟨m, ⟨t, rfl⟩, het⟩ := set.infinite.exists_nat_lt h (exponent G),
+    obtain ⟨m, ⟨t, rfl⟩, het⟩ := set.infinite.exists_gt h (exponent G),
     exact pow_ne_one_of_lt_order_of' he het (pow_exponent_eq_one t) },
   { lift (set.range order_of) to finset ℕ using he with t ht,
     have htpos : 0 < t.prod id,
@@ -235,8 +239,9 @@ section left_cancel_monoid
 variable [left_cancel_monoid G]
 
 @[to_additive]
-lemma exponent_ne_zero_of_fintype [fintype G] : exponent G ≠ 0 :=
-by simpa [←lcm_order_eq_exponent, finset.lcm_eq_zero_iff] using λ x, (order_of_pos x).ne'
+lemma exponent_ne_zero_of_finite [finite G] : exponent G ≠ 0 :=
+by { casesI nonempty_fintype G,
+  simpa [←lcm_order_eq_exponent, finset.lcm_eq_zero_iff] using λ x, (order_of_pos x).ne' }
 
 end left_cancel_monoid
 
@@ -268,7 +273,7 @@ begin
   suffices : order_of t < order_of (t ^ (p ^ k) * g),
   { rw ht at this,
     exact this.not_le (le_cSup hfin.bdd_above $ set.mem_range_self _) },
-  have hpk  : p ^ k ∣ order_of t := nat.pow_factorization_dvd _ _,
+  have hpk  : p ^ k ∣ order_of t := nat.ord_proj_dvd _ _,
   have hpk' : order_of (t ^ p ^ k) = order_of t / p ^ k,
   { rw [order_of_pow' t (pow_ne_zero k hp.ne_zero), nat.gcd_eq_right hpk] },
   obtain ⟨a, ha⟩ := nat.exists_eq_add_of_lt hpe,
@@ -312,3 +317,32 @@ end
 end cancel_comm_monoid
 
 end monoid
+
+section comm_group
+
+open subgroup
+open_locale big_operators
+
+variables (G) [comm_group G] [group.fg G]
+
+@[to_additive] lemma card_dvd_exponent_pow_rank : nat.card G ∣ monoid.exponent G ^ group.rank G :=
+begin
+  obtain ⟨S, hS1, hS2⟩ := group.rank_spec G,
+  rw [←hS1, ←fintype.card_coe, ←finset.card_univ, ←finset.prod_const],
+  let f : (Π g : S, zpowers (g : G)) →* G := noncomm_pi_coprod (λ s t h x y hx hy, mul_comm x y),
+  have hf : function.surjective f,
+  { rw [←monoid_hom.range_top_iff_surjective, eq_top_iff, ←hS2, closure_le],
+    exact λ g hg, ⟨pi.mul_single ⟨g, hg⟩ ⟨g, mem_zpowers g⟩, noncomm_pi_coprod_mul_single _ _⟩ },
+  replace hf := nat_card_dvd_of_surjective f hf,
+  rw nat.card_pi at hf,
+  refine hf.trans (finset.prod_dvd_prod_of_dvd _ _ (λ g hg, _)),
+  rw ← order_eq_card_zpowers',
+  exact monoid.order_dvd_exponent (g : G),
+end
+
+@[to_additive] lemma card_dvd_exponent_pow_rank' {n : ℕ} (hG : ∀ g : G, g ^ n = 1) :
+  nat.card G ∣ n ^ group.rank G :=
+(card_dvd_exponent_pow_rank G).trans
+    (pow_dvd_pow_of_dvd (monoid.exponent_dvd_of_forall_pow_eq_one G n hG) (group.rank G))
+
+end comm_group
diff --git a/src/group_theory/finite_abelian.lean b/src/group_theory/finite_abelian.lean
new file mode 100644
index 0000000000000..bf23854627a70
--- /dev/null
+++ b/src/group_theory/finite_abelian.lean
@@ -0,0 +1,94 @@
+/-
+Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Pierre-Alexandre Bazin
+-/
+import algebra.module.pid
+import data.zmod.quotient
+
+/-!
+# Structure of finite(ly generated) abelian groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+* `add_comm_group.equiv_free_prod_direct_sum_zmod` : Any finitely generated abelian group is the
+  product of a power of `ℤ` and a direct sum of some `zmod (p i ^ e i)` for some prime powers
+  `p i ^ e i`.
+* `add_comm_group.equiv_direct_sum_zmod_of_fintype` : Any finite abelian group is a direct sum of
+  some `zmod (p i ^ e i)` for some prime powers `p i ^ e i`.
+
+-/
+
+open_locale direct_sum
+
+universe u
+
+namespace module
+
+variables (M : Type u)
+
+lemma finite_of_fg_torsion [add_comm_group M] [module ℤ M] [module.finite ℤ M]
+  (hM : module.is_torsion ℤ M) : _root_.finite M :=
+begin
+  rcases module.equiv_direct_sum_of_is_torsion hM with ⟨ι, _, p, h, e, ⟨l⟩⟩,
+  haveI : ∀ i : ι, ne_zero (p i ^ e i).nat_abs :=
+  λ i, ⟨int.nat_abs_ne_zero_of_ne_zero $ pow_ne_zero (e i) (h i).ne_zero⟩,
+  haveI : ∀ i : ι, _root_.finite $ ℤ ⧸ submodule.span ℤ {p i ^ e i} :=
+  λ i, finite.of_equiv _ (p i ^ e i).quotient_span_equiv_zmod.symm.to_equiv,
+  haveI : _root_.finite ⨁ i, ℤ ⧸ (submodule.span ℤ {p i ^ e i} : submodule ℤ ℤ) :=
+  finite.of_equiv _ dfinsupp.equiv_fun_on_fintype.symm,
+  exact finite.of_equiv _ l.symm.to_equiv
+end
+
+end module
+
+variables (G : Type u)
+
+namespace add_comm_group
+
+variable [add_comm_group G]
+
+/-- **Structure theorem of finitely generated abelian groups** : Any finitely generated abelian
+group is the product of a power of `ℤ` and a direct sum of some `zmod (p i ^ e i)` for some
+prime powers `p i ^ e i`. -/
+theorem equiv_free_prod_direct_sum_zmod [hG : add_group.fg G] :
+  ∃ (n : ℕ) (ι : Type) [fintype ι] (p : ι → ℕ) [∀ i, nat.prime $ p i] (e : ι → ℕ),
+  nonempty $ G ≃+ (fin n →₀ ℤ) × ⨁ (i : ι), zmod (p i ^ e i) :=
+begin
+  obtain ⟨n, ι, fι, p, hp, e, ⟨f⟩⟩ :=
+    @module.equiv_free_prod_direct_sum _ _ _ _ _ _ _ (module.finite.iff_add_group_fg.mpr hG),
+  refine ⟨n, ι, fι, λ i, (p i).nat_abs, λ i, _, e, ⟨_⟩⟩,
+  { rw [← int.prime_iff_nat_abs_prime, ← gcd_monoid.irreducible_iff_prime], exact hp i },
+  exact f.to_add_equiv.trans ((add_equiv.refl _).prod_congr $ dfinsupp.map_range.add_equiv $
+    λ i, ((int.quotient_span_equiv_zmod _).trans $
+      zmod.ring_equiv_congr $ (p i).nat_abs_pow _).to_add_equiv)
+end
+
+/-- **Structure theorem of finite abelian groups** : Any finite abelian group is a direct sum of
+some `zmod (p i ^ e i)` for some prime powers `p i ^ e i`. -/
+theorem equiv_direct_sum_zmod_of_fintype [finite G] :
+  ∃ (ι : Type) [fintype ι] (p : ι → ℕ) [∀ i, nat.prime $ p i] (e : ι → ℕ),
+  nonempty $ G ≃+ ⨁ (i : ι), zmod (p i ^ e i) :=
+begin
+  casesI nonempty_fintype G,
+  obtain ⟨n, ι, fι, p, hp, e, ⟨f⟩⟩ := equiv_free_prod_direct_sum_zmod G,
+  cases n,
+  { exact ⟨ι, fι, p, hp, e, ⟨f.trans add_equiv.unique_prod⟩⟩ },
+  { haveI := @fintype.prod_left _ _ _ (fintype.of_equiv G f.to_equiv) _,
+    exact (fintype.of_surjective (λ f : fin n.succ →₀ ℤ, f 0) $
+      λ a, ⟨finsupp.single 0 a, finsupp.single_eq_same⟩).false.elim }
+end
+
+lemma finite_of_fg_torsion [hG' : add_group.fg G] (hG : add_monoid.is_torsion G) : finite G :=
+@module.finite_of_fg_torsion _ _ _ (module.finite.iff_add_group_fg.mpr hG') $
+  add_monoid.is_torsion_iff_is_torsion_int.mp hG
+
+end add_comm_group
+
+namespace comm_group
+
+lemma finite_of_fg_torsion [comm_group G] [group.fg G] (hG : monoid.is_torsion G) : finite G :=
+@finite.of_equiv _ _ (add_comm_group.finite_of_fg_torsion (additive G) hG) multiplicative.of_add
+
+end comm_group
diff --git a/src/group_theory/finiteness.lean b/src/group_theory/finiteness.lean
index 0523b90f69ccf..7a47344442139 100644
--- a/src/group_theory/finiteness.lean
+++ b/src/group_theory/finiteness.lean
@@ -4,15 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
-import data.set.finite
-import data.finset
+import data.set.pointwise.finite
 import group_theory.quotient_group
 import group_theory.submonoid.operations
 import group_theory.subgroup.basic
+import set_theory.cardinal.finite
+import data.finset.preimage
 
 /-!
 # Finitely generated monoids and groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define finitely generated monoids and groups. See also `submodule.fg` and `module.finite` for
 finitely-generated modules.
 
@@ -101,6 +105,11 @@ monoid.fg_iff_add_fg.1 ‹_›
 instance monoid.fg_of_add_monoid_fg [add_monoid.fg N] : monoid.fg (multiplicative N) :=
 add_monoid.fg_iff_mul_fg.1 ‹_›
 
+@[to_additive, priority 100]
+instance monoid.fg_of_finite [finite M] : monoid.fg M :=
+by { casesI nonempty_fintype M,
+  exact ⟨⟨finset.univ, by rw finset.coe_univ; exact submonoid.closure_univ⟩⟩ }
+
 end monoid
 
 @[to_additive]
@@ -156,6 +165,20 @@ lemma submonoid.powers_fg (r : M) : (submonoid.powers r).fg :=
 instance monoid.powers_fg (r : M) : monoid.fg (submonoid.powers r) :=
 (monoid.fg_iff_submonoid_fg _).mpr (submonoid.powers_fg r)
 
+@[to_additive] instance monoid.closure_finset_fg (s : finset M) :
+  monoid.fg (submonoid.closure (s : set M)) :=
+begin
+  refine ⟨⟨s.preimage coe (subtype.coe_injective.inj_on _), _⟩⟩,
+  rw [finset.coe_preimage, submonoid.closure_closure_coe_preimage],
+end
+
+@[to_additive] instance monoid.closure_finite_fg (s : set M) [finite s] :
+  monoid.fg (submonoid.closure s) :=
+begin
+  haveI := fintype.of_finite s,
+  exact s.coe_to_finset ▸ monoid.closure_finset_fg s.to_finset,
+end
+
 /-! ### Groups and subgroups -/
 
 variables {G H : Type*} [group G] [add_group H]
@@ -259,6 +282,11 @@ group_fg.iff_add_fg.1 ‹_›
 instance group.fg_of_mul_group_fg [add_group.fg H] : group.fg (multiplicative H) :=
 add_group.fg_iff_mul_fg.1 ‹_›
 
+@[to_additive, priority 100]
+instance group.fg_of_finite [finite G] : group.fg G :=
+by { casesI nonempty_fintype G,
+  exact ⟨⟨finset.univ, by rw finset.coe_univ; exact subgroup.closure_univ⟩⟩ }
+
 @[to_additive]
 lemma group.fg_of_surjective {G' : Type*} [group G'] [hG : group.fg G] {f : G →* G'}
   (hf : function.surjective f) : group.fg G' :=
@@ -268,26 +296,89 @@ group.fg_iff_monoid.fg.mpr $ @monoid.fg_of_surjective G _ G' _ (group.fg_iff_mon
 instance group.fg_range {G' : Type*} [group G'] [group.fg G] (f : G →* G') : group.fg f.range :=
 group.fg_of_surjective f.range_restrict_surjective
 
+@[to_additive] instance group.closure_finset_fg (s : finset G) :
+  group.fg (subgroup.closure (s : set G)) :=
+begin
+  refine ⟨⟨s.preimage coe (subtype.coe_injective.inj_on _), _⟩⟩,
+  rw [finset.coe_preimage, ←subgroup.coe_subtype, subgroup.closure_preimage_eq_top],
+end
+
+@[to_additive] instance group.closure_finite_fg (s : set G) [finite s] :
+  group.fg (subgroup.closure s) :=
+begin
+  haveI := fintype.of_finite s,
+  exact s.coe_to_finset ▸ group.closure_finset_fg s.to_finset,
+end
+
 variables (G)
 
 /-- The minimum number of generators of a group. -/
 @[to_additive "The minimum number of generators of an additive group"]
-def group.rank [h : group.fg G]
-  [decidable_pred (λ n, ∃ (S : finset G), S.card = n ∧ subgroup.closure (S : set G) = ⊤)] :=
-nat.find (group.fg_iff'.mp h)
+noncomputable def group.rank [h : group.fg G] :=
+@nat.find _ (classical.dec_pred _) (group.fg_iff'.mp h)
 
-@[to_additive] lemma group.rank_spec [h : group.fg G]
-  [decidable_pred (λ n, ∃ (S : finset G), S.card = n ∧ subgroup.closure (S : set G) = ⊤)] :
+@[to_additive] lemma group.rank_spec [h : group.fg G] :
   ∃ S : finset G, S.card = group.rank G ∧ subgroup.closure (S : set G) = ⊤ :=
-nat.find_spec (group.fg_iff'.mp h)
+@nat.find_spec _ (classical.dec_pred _) (group.fg_iff'.mp h)
 
-@[to_additive] lemma group.rank_le [group.fg G]
-  [decidable_pred (λ n, ∃ (S : finset G), S.card = n ∧ subgroup.closure (S : set G) = ⊤)]
+@[to_additive] lemma group.rank_le [h : group.fg G]
   {S : finset G} (hS : subgroup.closure (S : set G) = ⊤) : group.rank G ≤ S.card :=
-nat.find_le ⟨S, rfl, hS⟩
+@nat.find_le _ _ (classical.dec_pred _) (group.fg_iff'.mp h) ⟨S, rfl, hS⟩
+
+variables {G} {G' : Type*} [group G']
+
+@[to_additive] lemma group.rank_le_of_surjective [group.fg G] [group.fg G'] (f : G →* G')
+  (hf : function.surjective f) : group.rank G' ≤ group.rank G :=
+begin
+  classical,
+  obtain ⟨S, hS1, hS2⟩ := group.rank_spec G,
+  transitivity (S.image f).card,
+  { apply group.rank_le,
+    rw [finset.coe_image, ←monoid_hom.map_closure, hS2, subgroup.map_top_of_surjective f hf] },
+  { exact finset.card_image_le.trans_eq hS1 },
+end
+
+@[to_additive] lemma group.rank_range_le [group.fg G] {f : G →* G'} :
+  group.rank f.range ≤ group.rank G :=
+group.rank_le_of_surjective f.range_restrict f.range_restrict_surjective
+
+@[to_additive] lemma group.rank_congr [group.fg G] [group.fg G'] (f : G ≃* G') :
+  group.rank G = group.rank G' :=
+le_antisymm (group.rank_le_of_surjective f.symm f.symm.surjective)
+  (group.rank_le_of_surjective f f.surjective)
 
 end group
 
+namespace subgroup
+
+@[to_additive] lemma rank_congr {H K : subgroup G} [group.fg H] [group.fg K] (h : H = K) :
+  group.rank H = group.rank K :=
+by unfreezingI { subst h }
+
+@[to_additive] lemma rank_closure_finset_le_card (s : finset G) :
+  group.rank (closure (s : set G)) ≤ s.card :=
+begin
+  classical,
+  let t : finset (closure (s : set G)) := s.preimage coe (subtype.coe_injective.inj_on _),
+  have ht : closure (t : set (closure (s : set G))) = ⊤,
+  { rw finset.coe_preimage,
+    exact closure_preimage_eq_top s },
+  apply (group.rank_le (closure (s : set G)) ht).trans,
+  rw [←finset.card_image_of_inj_on, finset.image_preimage],
+  { apply finset.card_filter_le },
+  { apply subtype.coe_injective.inj_on },
+end
+
+@[to_additive] lemma rank_closure_finite_le_nat_card (s : set G) [finite s] :
+  group.rank (closure s) ≤ nat.card s :=
+begin
+  haveI := fintype.of_finite s,
+  rw [nat.card_eq_fintype_card, ←s.to_finset_card, ←rank_congr (congr_arg _ s.coe_to_finset)],
+  exact rank_closure_finset_le_card s.to_finset,
+end
+
+end subgroup
+
 section quotient_group
 
 @[to_additive]
diff --git a/src/group_theory/free_abelian_group.lean b/src/group_theory/free_abelian_group.lean
index 069e6160df8e1..d9e4dbc8d6405 100644
--- a/src/group_theory/free_abelian_group.lean
+++ b/src/group_theory/free_abelian_group.lean
@@ -7,11 +7,14 @@ Authors: Kenny Lau
 import algebra.group.pi
 import group_theory.free_group
 import group_theory.abelianization
-import algebra.module.basic -- we use the ℤ-module structure on an add_comm_group in punit_equiv
+import algebra.module.basic
 
 /-!
 # Free abelian groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The free abelian group on a type `α`, defined as the abelianisation of
 the free group on `α`.
 
@@ -164,7 +167,7 @@ begin
   { assume x,
     simp only [lift.of, pi.add_apply] },
   { assume x h,
-    simp only [(lift _).map_neg, lift.of, pi.add_apply, neg_add] },
+    simp only [map_neg, lift.of, pi.add_apply, neg_add] },
   { assume x y hx hy,
     simp only [(lift _).map_add, hx, hy, add_add_add_comm] }
 end
@@ -176,6 +179,9 @@ corresponding to the evaluation of the induced map `free_abelian_group X → A`
 def lift_add_group_hom {α} (β) [add_comm_group β] (a : free_abelian_group α) : (α → β) →+ β :=
 add_monoid_hom.mk' (λ f, lift f a) (lift.add' a)
 
+lemma lift_neg' {β} [add_comm_group β] (f : α → β) : lift (-f) = -lift f :=
+add_monoid_hom.ext $ λ _, (lift_add_group_hom _ _ : (α → β) →+ β).map_neg _
+
 section monad
 
 variables {β : Type u}
@@ -197,19 +203,19 @@ free_abelian_group.induction_on z C0 C1 Cn Cp
 @[simp] lemma map_pure (f : α → β) (x : α) : f <$> (pure x : free_abelian_group α) = pure (f x) :=
 rfl
 
-@[simp] lemma map_zero (f : α → β) : f <$> (0 : free_abelian_group α) = 0 :=
+@[simp] protected lemma map_zero (f : α → β) : f <$> (0 : free_abelian_group α) = 0 :=
 (lift (of ∘ f)).map_zero
 
-@[simp] lemma map_add (f : α → β) (x y : free_abelian_group α) :
+@[simp] protected lemma map_add (f : α → β) (x y : free_abelian_group α) :
   f <$> (x + y) = f <$> x + f <$> y :=
 (lift _).map_add _ _
 
-@[simp] lemma map_neg (f : α → β) (x : free_abelian_group α) : f <$> (-x) = -(f <$> x) :=
-(lift _).map_neg _
+@[simp] protected lemma map_neg (f : α → β) (x : free_abelian_group α) : f <$> (-x) = -(f <$> x) :=
+map_neg (lift $ of ∘ f) _
 
-@[simp] lemma map_sub (f : α → β) (x y : free_abelian_group α) :
+@[simp] protected lemma map_sub (f : α → β) (x y : free_abelian_group α) :
   f <$> (x - y) = f <$> x - f <$> y :=
-(lift _).map_sub _ _
+map_sub (lift $ of ∘ f) _ _
 
 @[simp] lemma map_of (f : α → β) (y : α) : f <$> of y = of (f y) := rfl
 
@@ -225,11 +231,11 @@ lift.of _ _
 
 @[simp] lemma neg_bind (f : α → free_abelian_group β) (x : free_abelian_group α) :
   -x >>= f = -(x >>= f) :=
-(lift _).map_neg _
+map_neg (lift f) _
 
 @[simp] lemma sub_bind (f : α → free_abelian_group β) (x y : free_abelian_group α) :
   x - y >>= f = (x >>= f) - (y >>= f) :=
-(lift _).map_sub _ _
+map_sub (lift f) _ _
 
 @[simp] lemma pure_seq (f : α → β) (x : free_abelian_group α) : pure f <*> x = f <$> x :=
 pure_bind _ _
@@ -255,7 +261,7 @@ def seq_add_group_hom (f : free_abelian_group (α → β)) :
   free_abelian_group α →+ free_abelian_group β :=
 add_monoid_hom.mk' ((<*>) f)
   (λ x y, show lift (<$> (x+y)) _ = _,
-    by { simp only [map_add], exact lift.add' f _ _, })
+    by { simp only [free_abelian_group.map_add], exact lift.add' f _ _, })
 
 @[simp] lemma seq_zero (f : free_abelian_group (α → β)) : f <*> 0 = 0 :=
 (seq_add_group_hom f).map_zero
@@ -273,8 +279,9 @@ add_monoid_hom.mk' ((<*>) f)
 (seq_add_group_hom f).map_sub x y
 
 instance : is_lawful_monad free_abelian_group.{u} :=
-{ id_map := λ α x, free_abelian_group.induction_on' x (map_zero id) (λ x, map_pure id x)
-    (λ x ih, by rw [map_neg, ih]) (λ x y ihx ihy, by rw [map_add, ihx, ihy]),
+{ id_map := λ α x, free_abelian_group.induction_on' x (free_abelian_group.map_zero id)
+    (map_pure id) (λ x ih, by rw [free_abelian_group.map_neg, ih])
+      (λ x y ihx ihy, by rw [free_abelian_group.map_add, ihx, ihy]),
   pure_bind := λ α β x f, pure_bind f x,
   bind_assoc := λ α β γ x f g, free_abelian_group.induction_on' x
     (by iterate 3 { rw zero_bind }) (λ x, by iterate 2 { rw pure_bind })
@@ -283,14 +290,15 @@ instance : is_lawful_monad free_abelian_group.{u} :=
 
 instance : is_comm_applicative free_abelian_group.{u} :=
 { commutative_prod := λ α β x y, free_abelian_group.induction_on' x
-    (by rw [map_zero, zero_seq, seq_zero])
+    (by rw [free_abelian_group.map_zero, zero_seq, seq_zero])
     (λ p, by rw [map_pure, pure_seq]; exact free_abelian_group.induction_on' y
-      (by rw [map_zero, map_zero, zero_seq])
+      (by rw [free_abelian_group.map_zero, free_abelian_group.map_zero, zero_seq])
       (λ q, by rw [map_pure, map_pure, pure_seq, map_pure])
-      (λ q ih, by rw [map_neg, map_neg, neg_seq, ih])
-      (λ y₁ y₂ ih1 ih2, by rw [map_add, map_add, add_seq, ih1, ih2]))
-    (λ p ih, by rw [map_neg, neg_seq, seq_neg, ih])
-    (λ x₁ x₂ ih1 ih2, by rw [map_add, add_seq, seq_add, ih1, ih2]) }
+      (λ q ih, by rw [free_abelian_group.map_neg, free_abelian_group.map_neg, neg_seq, ih])
+      (λ y₁ y₂ ih1 ih2,
+        by rw [free_abelian_group.map_add, free_abelian_group.map_add, add_seq, ih1, ih2]))
+    (λ p ih, by rw [free_abelian_group.map_neg, neg_seq, seq_neg, ih])
+    (λ x₁ x₂ ih1 ih2, by rw [free_abelian_group.map_add, add_seq, seq_add, ih1, ih2]) }
 
 
 end monad
@@ -332,67 +340,74 @@ lemma map_comp_apply {f : α → β} {g : β → γ} (x : free_abelian_group α)
 
 variable (α)
 
-section monoid
-
-variables {R : Type*} [monoid α] [ring R]
+section has_mul
+variables [has_mul α]
 
-instance : semigroup (free_abelian_group α) :=
-{ mul := λ x, lift $ λ x₂, lift (λ x₁, of $ x₁ * x₂) x,
-  mul_assoc := λ x y z, begin
-    unfold has_mul.mul,
-    refine free_abelian_group.induction_on z (by simp) _ _ _,
-    { intros L3, rw [lift.of, lift.of],
-      refine free_abelian_group.induction_on y (by simp) _ _ _,
-      { intros L2, iterate 3 { rw lift.of },
-        refine free_abelian_group.induction_on x (by simp) _ _ _,
-        { intros L1, iterate 3 { rw lift.of }, congr' 1, exact mul_assoc _ _ _ },
-        { intros L1 ih, iterate 3 { rw (lift _).map_neg }, rw ih },
-        { intros x1 x2 ih1 ih2, iterate 3 { rw (lift _).map_add }, rw [ih1, ih2] } },
-      { intros L2 ih, iterate 4 { rw (lift _).map_neg }, rw ih },
-      { intros y1 y2 ih1 ih2, iterate 4 { rw (lift _).map_add }, rw [ih1, ih2] } },
-    { intros L3 ih, iterate 3 { rw (lift _).map_neg }, rw ih },
-    { intros z1 z2 ih1 ih2, iterate 2 { rw (lift _).map_add }, rw [ih1, ih2],
-      exact ((lift _).map_add _ _).symm }
-  end }
+instance : has_mul (free_abelian_group α) := ⟨λ x, lift $ λ x₂, lift (λ x₁, of $ x₁ * x₂) x⟩
 
 variable {α}
 
-lemma mul_def (x y : free_abelian_group α) :
-  x * y = lift (λ x₂, lift (λ x₁, of (x₁ * x₂)) x) y := rfl
+lemma mul_def (x y : free_abelian_group α) : x * y = lift (λ x₂, lift (λ x₁, of (x₁ * x₂)) x) y :=
+rfl
 
-lemma of_mul_of (x y : α) : of x * of y = of (x * y) := rfl
+@[simp] lemma of_mul_of (x y : α) : of x * of y = of (x * y) := rfl
 lemma of_mul (x y : α) : of (x * y) = of x * of y := rfl
 
-variable (α)
+instance : distrib (free_abelian_group α) :=
+{ add := (+),
+  left_distrib := λ x y z, (lift _).map_add _ _,
+  right_distrib := λ x y z, by simp only [(*), map_add, ←pi.add_def, lift.add'],
+  ..free_abelian_group.has_mul _ }
+
+instance : non_unital_non_assoc_ring (free_abelian_group α) :=
+{ zero_mul := λ a, by { have h : 0 * a + 0 * a = 0 * a, by simp [←add_mul], simpa using h },
+  mul_zero := λ a, rfl,
+  ..free_abelian_group.distrib, ..free_abelian_group.add_comm_group _ }
+
+end has_mul
+
+instance [has_one α] : has_one (free_abelian_group α) := ⟨of 1⟩
+
+instance [semigroup α] : non_unital_ring (free_abelian_group α) :=
+{ mul := (*),
+  mul_assoc := λ x y z, begin
+    refine free_abelian_group.induction_on z (by simp) (λ L3, _) (λ L3 ih, _) (λ z₁ z₂ ih₁ ih₂, _),
+    { refine free_abelian_group.induction_on y (by simp) (λ L2, _) (λ L2 ih, _)
+        (λ y₁ y₂ ih₁ ih₂, _),
+      { refine free_abelian_group.induction_on x (by simp) (λ L1, _) (λ L1 ih, _)
+          (λ x₁ x₂ ih₁ ih₂, _),
+        { rw [of_mul_of, of_mul_of, of_mul_of, of_mul_of, mul_assoc] },
+        { rw [neg_mul, neg_mul, neg_mul, ih] },
+        { rw [add_mul, add_mul, add_mul, ih₁, ih₂] } },
+      { rw [neg_mul, mul_neg, mul_neg, neg_mul, ih] },
+      { rw [add_mul, mul_add, mul_add, add_mul, ih₁, ih₂] } },
+    { rw [mul_neg, mul_neg, mul_neg, ih] },
+    { rw [mul_add, mul_add, mul_add, ih₁, ih₂] }
+  end,
+  .. free_abelian_group.non_unital_non_assoc_ring }
+
+section monoid
+
+variables {R : Type*} [monoid α] [ring R]
 
 instance : ring (free_abelian_group α) :=
-{ one := free_abelian_group.of 1,
+{ mul := (*),
   mul_one := λ x, begin
     unfold has_mul.mul semigroup.mul has_one.one,
     rw lift.of,
-    refine free_abelian_group.induction_on x rfl _ _ _,
-    { intros L, erw [lift.of], congr' 1, exact mul_one L },
-    { intros L ih, rw [(lift _).map_neg, ih] },
-    { intros x1 x2 ih1 ih2, rw [(lift _).map_add, ih1, ih2] }
+    refine free_abelian_group.induction_on x rfl (λ L, _) (λ L ih, _) (λ x1 x2 ih1 ih2, _),
+    { erw [lift.of], congr' 1, exact mul_one L },
+    { rw [map_neg, ih] },
+    { rw [map_add, ih1, ih2] }
   end,
   one_mul := λ x, begin
     unfold has_mul.mul semigroup.mul has_one.one,
     refine free_abelian_group.induction_on x rfl _ _ _,
     { intros L, rw [lift.of, lift.of], congr' 1, exact one_mul L },
-    { intros L ih, rw [(lift _).map_neg, ih] },
-    { intros x1 x2 ih1 ih2, rw [(lift _).map_add, ih1, ih2] }
-  end,
-  left_distrib := λ x y z, (lift _).map_add _ _,
-  right_distrib := λ x y z, begin
-    unfold has_mul.mul semigroup.mul,
-    refine free_abelian_group.induction_on z rfl _ _ _,
-    { intros L, iterate 3 { rw lift.of }, rw (lift _).map_add, refl },
-    { intros L ih, iterate 3 { rw (lift _).map_neg }, rw [ih, neg_add], refl },
-    { intros z1 z2 ih1 ih2, iterate 3 { rw (lift _).map_add }, rw [ih1, ih2],
-      rw [add_assoc, add_assoc], congr' 1, apply add_left_comm }
+    { intros L ih, rw [map_neg, ih] },
+    { intros x1 x2 ih1 ih2, rw [map_add, ih1, ih2] }
   end,
-  .. free_abelian_group.add_comm_group α,
-  .. free_abelian_group.semigroup α }
+  .. free_abelian_group.non_unital_ring _, ..free_abelian_group.has_one _ }
 
 variable {α}
 
@@ -407,28 +422,21 @@ def of_mul_hom : α →* free_abelian_group α :=
 /-- If `f` preserves multiplication, then so does `lift f`. -/
 def lift_monoid : (α →* R) ≃ (free_abelian_group α →+* R) :=
 { to_fun := λ f,
-  { map_one' := (lift.of f _).trans f.map_one,
+  { to_fun := lift f,
+    map_one' := (lift.of f _).trans f.map_one,
     map_mul' := λ x y,
     begin
-      simp only [add_monoid_hom.to_fun_eq_coe],
-      refine free_abelian_group.induction_on y (mul_zero _).symm _ _ _,
-      { intros L2,
-        rw mul_def x,
-        simp only [lift.of],
-        refine free_abelian_group.induction_on x (zero_mul _).symm _ _ _,
-        { intros L1, iterate 3 { rw lift.of },
+      refine free_abelian_group.induction_on y (mul_zero _).symm (λ L2, _) (λ L2 ih, _) _,
+      { refine free_abelian_group.induction_on x (zero_mul _).symm (λ L1, _) (λ L1 ih, _) _,
+        { simp_rw [of_mul_of, lift.of],
           exact f.map_mul _ _ },
-        { intros L1 ih,
-          iterate 3 { rw (lift _).map_neg },
-          rw [ih, neg_mul_eq_neg_mul] },
+        { simp_rw [neg_mul, map_neg, neg_mul],
+          exact congr_arg has_neg.neg ih },
         { intros x1 x2 ih1 ih2,
-          iterate 3 { rw (lift _).map_add },
-          rw [ih1, ih2, add_mul] } },
-      { intros L2 ih,
-        rw [mul_neg, add_monoid_hom.map_neg, add_monoid_hom.map_neg,
-          mul_neg, ih] },
+          simp only [add_mul, map_add, ih1, ih2] } },
+      { rw [mul_neg, map_neg, map_neg, mul_neg, ih] },
       { intros y1 y2 ih1 ih2,
-        rw [mul_add, add_monoid_hom.map_add, add_monoid_hom.map_add, mul_add, ih1, ih2] },
+        rw [mul_add, map_add, map_add, mul_add, ih1, ih2] },
     end,
     .. lift f },
   inv_fun := λ F, monoid_hom.comp ↑F of_mul_hom,
diff --git a/src/group_theory/free_abelian_group_finsupp.lean b/src/group_theory/free_abelian_group_finsupp.lean
index abfc54c4af2ae..10e05a6d2520b 100644
--- a/src/group_theory/free_abelian_group_finsupp.lean
+++ b/src/group_theory/free_abelian_group_finsupp.lean
@@ -4,8 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 
+import algebra.hom.equiv.type_tags
 import algebra.module.equiv
-import data.finsupp.basic
+import data.finsupp.defs
 import group_theory.free_abelian_group
 import group_theory.is_free_group
 import linear_algebra.dimension
@@ -13,6 +14,9 @@ import linear_algebra.dimension
 /-!
 # Isomorphism between `free_abelian_group X` and `X →₀ ℤ`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we construct the canonical isomorphism between `free_abelian_group X` and `X →₀ ℤ`.
 We use this to transport the notion of `support` from `finsupp` to `free_abelian_group`.
 
@@ -156,7 +160,7 @@ by { rw [support, finsupp.not_mem_support_iff], exact iff.rfl }
 by simp only [support, finsupp.support_zero, add_monoid_hom.map_zero]
 
 @[simp] lemma support_of (x : X) : support (of x) = {x} :=
-by simp only [support, to_finsupp_of, finsupp.support_single_ne_zero (one_ne_zero)]
+by simp only [support, to_finsupp_of, finsupp.support_single_ne_zero _ one_ne_zero]
 
 @[simp] lemma support_neg (a : free_abelian_group X) : support (-a) = support a :=
 by simp only [support, add_monoid_hom.map_neg, finsupp.support_neg]
diff --git a/src/group_theory/free_group.lean b/src/group_theory/free_group.lean
index 843aaa9b3c7a1..d466c401c27f9 100644
--- a/src/group_theory/free_group.lean
+++ b/src/group_theory/free_group.lean
@@ -4,28 +4,32 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 import data.fintype.basic
+import data.list.sublists
 import group_theory.subgroup.basic
 
 /-!
 # Free groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines free groups over a type. Furthermore, it is shown that the free group construction
 is an instance of a monad. For the result that `free_group` is the left adjoint to the forgetful
 functor from groups to types, see `algebra/category/Group/adjunctions`.
 
 ## Main definitions
 
-* `free_group`: the free group associated to a type `α` defined as the words over `a : α × bool`
-  modulo the relation `a * x * x⁻¹ * b = a * b`.
-* `free_group.mk`: the canonical quotient map `list (α × bool) → free_group α`.
-* `free_group.of`: the canoical injection `α → free_group α`.
-* `free_group.lift f`: the canonical group homomorphism `free_group α →* G`
+* `free_group`/`free_add_group`: the free group (resp. free additive group) associated to a type
+  `α` defined as the words over `a : α × bool` modulo the relation `a * x * x⁻¹ * b = a * b`.
+* `free_group.mk`/`free_add_group.mk`: the canonical quotient map `list (α × bool) → free_group α`.
+* `free_group.of`/`free_add_group.of`: the canonical injection `α → free_group α`.
+* `free_group.lift f`/`free_add_group.lift`: the canonical group homomorphism `free_group α →* G`
   given a group `G` and a function `f : α → G`.
 
 ## Main statements
 
-* `free_group.church_rosser`: The Church-Rosser theorem for word reduction
-  (also known as Newman's diamond lemma).
+* `free_group.church_rosser`/`free_add_group.church_rosser`: The Church-Rosser theorem for word
+  reduction (also known as Newman's diamond lemma).
 * `free_group.free_group_unit_equiv_int`: The free group over the one-point type
   is isomorphic to the integers.
 * The free group construction is an instance of a monad.
@@ -37,6 +41,10 @@ First we introduce the one step reduction relation `free_group.red.step`:
 and prove that its join is an equivalence relation. Then we introduce `free_group α` as a quotient
 over `free_group.red.step`.
 
+For the additive version we introduce the same relation under a different name so that we can
+distinguish the quotient types more easily.
+
+
 ## Tags
 
 free group, Newman's diamond lemma, Church-Rosser theorem
@@ -50,45 +58,63 @@ variables {α : Type u}
 
 local attribute [simp] list.append_eq_has_append
 
+run_cmd to_additive.map_namespace `free_group `free_add_group
+
+/-- Reduction step for the additive free group relation: `w + x + (-x) + v ~> w + v` -/
+inductive free_add_group.red.step : list (α × bool) → list (α × bool) → Prop
+| bnot {L₁ L₂ x b} : free_add_group.red.step (L₁ ++ (x, b) :: (x, bnot b) :: L₂) (L₁ ++ L₂)
+attribute [simp] free_add_group.red.step.bnot
+
+/-- Reduction step for the multiplicative free group relation: `w * x * x⁻¹ * v ~> w * v` -/
+@[to_additive]
+inductive free_group.red.step : list (α × bool) → list (α × bool) → Prop
+| bnot {L₁ L₂ x b} : free_group.red.step (L₁ ++ (x, b) :: (x, bnot b) :: L₂) (L₁ ++ L₂)
+attribute [simp] free_group.red.step.bnot
+
 namespace free_group
-variables {L L₁ L₂ L₃ L₄ : list (α × bool)}
 
-/-- Reduction step: `w * x * x⁻¹ * v ~> w * v` -/
-inductive red.step : list (α × bool) → list (α × bool) → Prop
-| bnot {L₁ L₂ x b} : red.step (L₁ ++ (x, b) :: (x, bnot b) :: L₂) (L₁ ++ L₂)
-attribute [simp] red.step.bnot
+variables {L L₁ L₂ L₃ L₄ : list (α × bool)}
 
 /-- Reflexive-transitive closure of red.step -/
+@[to_additive "Reflexive-transitive closure of red.step"]
 def red : list (α × bool) → list (α × bool) → Prop := refl_trans_gen red.step
 
-@[refl] lemma red.refl : red L L := refl_trans_gen.refl
-@[trans] lemma red.trans : red L₁ L₂ → red L₂ L₃ → red L₁ L₃ := refl_trans_gen.trans
+@[refl, to_additive] lemma red.refl : red L L := refl_trans_gen.refl
+@[trans, to_additive] lemma red.trans : red L₁ L₂ → red L₂ L₃ → red L₁ L₃ := refl_trans_gen.trans
 
 namespace red
 
-/-- Predicate asserting that word `w₁` can be reduced to `w₂` in one step, i.e. there are words
+/-- Predicate asserting that the word `w₁` can be reduced to `w₂` in one step, i.e. there are words
 `w₃ w₄` and letter `x` such that `w₁ = w₃xx⁻¹w₄` and `w₂ = w₃w₄`  -/
+@[to_additive
+"Predicate asserting that the word `w₁` can be reduced to `w₂` in one step, i.e. there are words
+`w₃ w₄` and letter `x` such that `w₁ = w₃ + x + (-x) + w₄` and `w₂ = w₃w₄`"]
 theorem step.length : ∀ {L₁ L₂ : list (α × bool)}, step L₁ L₂ → L₂.length + 2 = L₁.length
 | _ _ (@red.step.bnot _ L1 L2 x b) := by rw [list.length_append, list.length_append]; refl
 
-@[simp] lemma step.bnot_rev {x b} : step (L₁ ++ (x, bnot b) :: (x, b) :: L₂) (L₁ ++ L₂) :=
+@[simp, to_additive]
+lemma step.bnot_rev {x b} : step (L₁ ++ (x, bnot b) :: (x, b) :: L₂) (L₁ ++ L₂) :=
 by cases b; from step.bnot
 
-@[simp] lemma step.cons_bnot {x b} : red.step ((x, b) :: (x, bnot b) :: L) L :=
+@[simp, to_additive] lemma step.cons_bnot {x b} : red.step ((x, b) :: (x, bnot b) :: L) L :=
 @step.bnot _ [] _ _ _
 
-@[simp] lemma step.cons_bnot_rev {x b} : red.step ((x, bnot b) :: (x, b) :: L) L :=
+@[simp, to_additive] lemma step.cons_bnot_rev {x b} : red.step ((x, bnot b) :: (x, b) :: L) L :=
 @red.step.bnot_rev _ [] _ _ _
 
+@[to_additive]
 theorem step.append_left : ∀ {L₁ L₂ L₃ : list (α × bool)}, step L₂ L₃ → step (L₁ ++ L₂) (L₁ ++ L₃)
 | _ _ _ red.step.bnot := by rw [← list.append_assoc, ← list.append_assoc]; constructor
 
+@[to_additive]
 theorem step.cons {x} (H : red.step L₁ L₂) : red.step (x :: L₁) (x :: L₂) :=
 @step.append_left _ [x] _ _ H
 
+@[to_additive]
 theorem step.append_right : ∀ {L₁ L₂ L₃ : list (α × bool)}, step L₁ L₂ → step (L₁ ++ L₃) (L₂ ++ L₃)
 | _ _ _ red.step.bnot := by simp
 
+@[to_additive]
 lemma not_step_nil : ¬ step [] L :=
 begin
   generalize h' : [] = L',
@@ -98,35 +124,38 @@ begin
   contradiction
 end
 
+@[to_additive]
 lemma step.cons_left_iff {a : α} {b : bool} :
   step ((a, b) :: L₁) L₂ ↔ (∃L, step L₁ L ∧ L₂ = (a, b) :: L) ∨ (L₁ = (a, bnot b)::L₂) :=
 begin
   split,
   { generalize hL : ((a, b) :: L₁ : list _) = L,
-    assume h,
-    rcases h with ⟨_ | ⟨p, s'⟩, e, a', b'⟩,
+    rintro @⟨_ | ⟨p, s'⟩, e, a', b'⟩,
     { simp at hL, simp [*] },
     { simp at hL,
       rcases hL with ⟨rfl, rfl⟩,
       refine or.inl ⟨s' ++ e, step.bnot, _⟩,
       simp } },
-  { assume h,
-    rcases h with ⟨L, h, rfl⟩ | rfl,
+  { rintro (⟨L, h, rfl⟩ | rfl),
     { exact step.cons h },
     { exact step.cons_bnot } }
 end
 
+@[to_additive]
 lemma not_step_singleton : ∀ {p : α × bool}, ¬ step [p] L
 | (a, b) := by simp [step.cons_left_iff, not_step_nil]
 
+@[to_additive]
 lemma step.cons_cons_iff : ∀{p : α × bool}, step (p :: L₁) (p :: L₂) ↔ step L₁ L₂ :=
 by simp [step.cons_left_iff, iff_def, or_imp_distrib] {contextual := tt}
 
+@[to_additive]
 lemma step.append_left_iff : ∀L, step (L ++ L₁) (L ++ L₂) ↔ step L₁ L₂
 | [] := by simp
 | (p :: l) := by simp [step.append_left_iff l, step.cons_cons_iff]
 
-private theorem step.diamond_aux : ∀ {L₁ L₂ L₃ L₄ : list (α × bool)} {x1 b1 x2 b2},
+@[to_additive]
+theorem step.diamond_aux : ∀ {L₁ L₂ L₃ L₄ : list (α × bool)} {x1 b1 x2 b2},
   L₁ ++ (x1, b1) :: (x1, bnot b1) :: L₂ = L₃ ++ (x2, b2) :: (x2, bnot b2) :: L₄ →
   L₁ ++ L₂ = L₃ ++ L₄ ∨ ∃ L₅, red.step (L₁ ++ L₂) L₅ ∧ red.step (L₃ ++ L₄) L₅
 | []        _ []        _ _ _ _ _ H := by injections; subst_vars; simp
@@ -144,17 +173,23 @@ private theorem step.diamond_aux : ∀ {L₁ L₂ L₃ L₄ : list (α × bool)}
       ⟨_, step.cons H3, by simpa [H1] using step.cons H4⟩
   end
 
+@[to_additive]
 theorem step.diamond : ∀ {L₁ L₂ L₃ L₄ : list (α × bool)},
   red.step L₁ L₃ → red.step L₂ L₄ → L₁ = L₂ →
   L₃ = L₄ ∨ ∃ L₅, red.step L₃ L₅ ∧ red.step L₄ L₅
 | _ _ _ _ red.step.bnot red.step.bnot H := step.diamond_aux H
 
+@[to_additive]
 lemma step.to_red : step L₁ L₂ → red L₁ L₂ :=
 refl_trans_gen.single
 
 /-- **Church-Rosser theorem** for word reduction: If `w1 w2 w3` are words such that `w1` reduces
 to `w2` and `w3` respectively, then there is a word `w4` such that `w2` and `w3` reduce to `w4`
 respectively. This is also known as Newman's diamond lemma. -/
+@[to_additive
+"**Church-Rosser theorem** for word reduction: If `w1 w2 w3` are words such that `w1` reduces
+to `w2` and `w3` respectively, then there is a word `w4` such that `w2` and `w3` reduce to `w4`
+respectively. This is also known as Newman's diamond lemma."]
 theorem church_rosser : red L₁ L₂ → red L₁ L₃ → join red L₂ L₃ :=
 relation.church_rosser (assume a b c hab hac,
 match b, c, red.step.diamond hab hac rfl with
@@ -162,9 +197,11 @@ match b, c, red.step.diamond hab hac rfl with
 | b, c, or.inr ⟨d, hbd, hcd⟩ := ⟨d, refl_gen.single hbd, hcd.to_red⟩
 end)
 
+@[to_additive]
 lemma cons_cons {p} : red L₁ L₂ → red (p :: L₁) (p :: L₂) :=
 refl_trans_gen.lift (list.cons p) (assume a b, step.cons)
 
+@[to_additive]
 lemma cons_cons_iff (p) : red (p :: L₁) (p :: L₂) ↔ red L₁ L₂ :=
 iff.intro
   begin
@@ -184,13 +221,16 @@ iff.intro
   end
   cons_cons
 
+@[to_additive]
 lemma append_append_left_iff : ∀L, red (L ++ L₁) (L ++ L₂) ↔ red L₁ L₂
 | []       := iff.rfl
 | (p :: L) := by simp [append_append_left_iff L, cons_cons_iff]
 
+@[to_additive]
 lemma append_append (h₁ : red L₁ L₃) (h₂ : red L₂ L₄) : red (L₁ ++ L₂) (L₃ ++ L₄) :=
 (h₁.lift (λL, L ++ L₂) (assume a b, step.append_right)).trans ((append_append_left_iff _).2 h₂)
 
+@[to_additive]
 lemma to_append_iff : red L (L₁ ++ L₂) ↔ (∃L₃ L₄, L = L₃ ++ L₄ ∧ red L₃ L₁ ∧ red L₄ L₂) :=
 iff.intro
   begin
@@ -214,15 +254,19 @@ iff.intro
   (assume ⟨L₃, L₄, eq, h₃, h₄⟩, eq.symm ▸ append_append h₃ h₄)
 
 /-- The empty word `[]` only reduces to itself. -/
+@[to_additive "The empty word `[]` only reduces to itself."]
 theorem nil_iff : red [] L ↔ L = [] :=
 refl_trans_gen_iff_eq (assume l, red.not_step_nil)
 
 /-- A letter only reduces to itself. -/
+@[to_additive "A letter only reduces to itself."]
 theorem singleton_iff {x} : red [x] L₁ ↔ L₁ = [x] :=
 refl_trans_gen_iff_eq (assume l, not_step_singleton)
 
 /-- If `x` is a letter and `w` is a word such that `xw` reduces to the empty word, then `w` reduces
 to `x⁻¹` -/
+@[to_additive "If `x` is a letter and `w` is a word such that `x + w` reduces to the empty word,
+then `w` reduces to `-x`."]
 theorem cons_nil_iff_singleton {x b} : red ((x, b) :: L) [] ↔ red L [(x, bnot b)] :=
 iff.intro
   (assume h,
@@ -232,6 +276,7 @@ iff.intro
     by rw [singleton_iff] at h₁; subst L'; assumption)
   (assume h, (cons_cons h).tail step.cons_bnot)
 
+@[to_additive]
 theorem red_iff_irreducible {x1 b1 x2 b2} (h : (x1, b1) ≠ (x2, b2)) :
   red [(x1, bnot b1), (x2, b2)] L ↔ L = [(x1, bnot b1), (x2, b2)] :=
 begin
@@ -247,6 +292,9 @@ end
 
 /-- If `x` and `y` are distinct letters and `w₁ w₂` are words such that `xw₁` reduces to `yw₂`, then
 `w₁` reduces to `x⁻¹yw₂`. -/
+@[to_additive
+"If `x` and `y` are distinct letters and `w₁ w₂` are words such that `x + w₁` reduces to `y + w₂`,
+then `w₁` reduces to `-x + y + w₂`."]
 theorem inv_of_red_of_ne {x1 b1 x2 b2}
   (H1 : (x1, b1) ≠ (x2, b2))
   (H2 : red ((x1, b1) :: L₁) ((x2, b2) :: L₂)) :
@@ -267,14 +315,21 @@ begin
     rwa [h₁] at h₂ }
 end
 
+@[to_additive]
 theorem step.sublist (H : red.step L₁ L₂) : L₂ <+ L₁ :=
 by cases H; simp; constructor; constructor; refl
 
 /-- If `w₁ w₂` are words such that `w₁` reduces to `w₂`, then `w₂` is a sublist of `w₁`. -/
-theorem sublist : red L₁ L₂ → L₂ <+ L₁ :=
+@[to_additive "If `w₁ w₂` are words such that `w₁` reduces to `w₂`,
+then `w₂` is a sublist of `w₁`."]
+protected theorem sublist : red L₁ L₂ → L₂ <+ L₁ :=
 refl_trans_gen_of_transitive_reflexive
   (λl, list.sublist.refl l) (λa b c hab hbc, list.sublist.trans hbc hab) (λa b, red.step.sublist)
 
+@[to_additive]
+theorem length_le (h : red L₁ L₂) : L₂.length ≤ L₁.length := h.sublist.length_le
+
+@[to_additive]
 theorem sizeof_of_step : ∀ {L₁ L₂ : list (α × bool)}, step L₁ L₂ → L₂.sizeof < L₁.sizeof
 | _ _ (@step.bnot _ L1 L2 x b) :=
   begin
@@ -291,6 +346,7 @@ theorem sizeof_of_step : ∀ {L₁ L₂ : list (α × bool)}, step L₁ L₂ →
       exact nat.add_lt_add_left ih _ }
   end
 
+@[to_additive]
 theorem length (h : red L₁ L₂) : ∃ n, L₁.length = L₂.length + 2 * n :=
 begin
   induction h with L₂ L₃ h₁₂ h₂₃ ih,
@@ -300,18 +356,13 @@ begin
     simp [mul_add, eq, (step.length h₂₃).symm, add_assoc] }
 end
 
-theorem antisymm (h₁₂ : red L₁ L₂) : red L₂ L₁ → L₁ = L₂ :=
-match L₁, h₁₂.cases_head with
-| _,  or.inl rfl            := assume h, rfl
-| L₁, or.inr ⟨L₃, h₁₃, h₃₂⟩ := assume h₂₁,
-  let ⟨n, eq⟩ := length (h₃₂.trans h₂₁) in
-  have list.length L₃ + 0 = list.length L₃ + (2 * n + 2),
-    by simpa [(step.length h₁₃).symm, add_comm, add_assoc] using eq,
-  (nat.no_confusion $ nat.add_left_cancel this)
-end
+@[to_additive]
+theorem antisymm (h₁₂ : red L₁ L₂) (h₂₁ : red L₂ L₁) : L₁ = L₂ :=
+h₂₁.sublist.antisymm h₁₂.sublist
 
 end red
 
+@[to_additive]
 theorem equivalence_join_red : equivalence (join (@red α)) :=
 equivalence_join_refl_trans_gen $ assume a b c hab hac,
 (match b, c, red.step.diamond hab hac rfl with
@@ -319,9 +370,11 @@ equivalence_join_refl_trans_gen $ assume a b c hab hac,
 | b, c, or.inr ⟨d, hbd, hcd⟩ := ⟨d, refl_gen.single hbd, refl_trans_gen.single hcd⟩
 end)
 
+@[to_additive]
 theorem join_red_of_step (h : red.step L₁ L₂) : join red L₁ L₂ :=
 join_of_single reflexive_refl_trans_gen h.to_red
 
+@[to_additive]
 theorem eqv_gen_step_iff_join_red : eqv_gen red.step L₁ L₂ ↔ join red L₁ L₂ :=
 iff.intro
   (assume h,
@@ -334,6 +387,8 @@ end free_group
 
 /-- The free group over a type, i.e. the words formed by the elements of the type and their formal
 inverses, quotient by one step reduction. -/
+@[to_additive "The free additive group over a type, i.e. the words formed by the elements of the
+type and their formal inverses, quotient by one step reduction."]
 def free_group (α : Type u) : Type u :=
 quot $ @free_group.red.step α
 
@@ -342,38 +397,84 @@ namespace free_group
 variables {α} {L L₁ L₂ L₃ L₄ : list (α × bool)}
 
 /-- The canonical map from `list (α × bool)` to the free group on `α`. -/
+@[to_additive "The canonical map from `list (α × bool)` to the free additive group on `α`."]
 def mk (L) : free_group α := quot.mk red.step L
 
-@[simp] lemma quot_mk_eq_mk : quot.mk red.step L = mk L := rfl
+@[simp, to_additive] lemma quot_mk_eq_mk : quot.mk red.step L = mk L := rfl
 
-@[simp] lemma quot_lift_mk (β : Type v) (f : list (α × bool) → β)
+@[simp, to_additive] lemma quot_lift_mk (β : Type v) (f : list (α × bool) → β)
   (H : ∀ L₁ L₂, red.step L₁ L₂ → f L₁ = f L₂) :
 quot.lift f H (mk L) = f L := rfl
 
-@[simp] lemma quot_lift_on_mk (β : Type v) (f : list (α × bool) → β)
+@[simp, to_additive] lemma quot_lift_on_mk (β : Type v) (f : list (α × bool) → β)
   (H : ∀ L₁ L₂, red.step L₁ L₂ → f L₁ = f L₂) :
 quot.lift_on (mk L) f H = f L := rfl
 
-@[simp] lemma quot_map_mk (β : Type v) (f : list (α × bool) → list (β × bool))
+@[simp, to_additive] lemma quot_map_mk (β : Type v) (f : list (α × bool) → list (β × bool))
   (H : (red.step ⇒ red.step) f f) :
 quot.map f H (mk L) = mk (f L) := rfl
 
+@[to_additive]
 instance : has_one (free_group α) := ⟨mk []⟩
+@[to_additive]
 lemma one_eq_mk : (1 : free_group α) = mk [] := rfl
 
+@[to_additive]
 instance : inhabited (free_group α) := ⟨1⟩
 
+@[to_additive]
 instance : has_mul (free_group α) :=
 ⟨λ x y, quot.lift_on x
     (λ L₁, quot.lift_on y (λ L₂, mk $ L₁ ++ L₂) (λ L₂ L₃ H, quot.sound $ red.step.append_left H))
     (λ L₁ L₂ H, quot.induction_on y $ λ L₃, quot.sound $ red.step.append_right H)⟩
-@[simp] lemma mul_mk : mk L₁ * mk L₂ = mk (L₁ ++ L₂) := rfl
-
+@[simp, to_additive] lemma mul_mk : mk L₁ * mk L₂ = mk (L₁ ++ L₂) := rfl
+
+/-- Transform a word representing a free group element into a word representing its inverse. -/
+@[to_additive "Transform a word representing a free group element into a word representing its
+negative."]
+def inv_rev (w : list (α × bool)) : list (α × bool) :=
+(list.map (λ (g : α × bool), (g.1, bnot g.2)) w).reverse
+
+@[simp, to_additive] lemma inv_rev_length : (inv_rev L₁).length = L₁.length := by simp [inv_rev]
+@[simp, to_additive] lemma inv_rev_inv_rev : (inv_rev (inv_rev L₁) = L₁) := by simp [inv_rev, (∘)]
+@[simp, to_additive] lemma inv_rev_empty : inv_rev ([] : list (α × bool)) = [] := rfl
+
+@[to_additive]
+lemma inv_rev_involutive : function.involutive (@inv_rev α) := λ _, inv_rev_inv_rev
+@[to_additive]
+lemma inv_rev_injective : function.injective (@inv_rev α) := inv_rev_involutive.injective
+@[to_additive]
+lemma inv_rev_surjective : function.surjective (@inv_rev α) := inv_rev_involutive.surjective
+@[to_additive]
+lemma inv_rev_bijective : function.bijective (@inv_rev α) := inv_rev_involutive.bijective
+
+@[to_additive]
 instance : has_inv (free_group α) :=
-⟨λx, quot.lift_on x (λ L, mk (L.map $ λ x : α × bool, (x.1, bnot x.2)).reverse)
-  (assume a b h, quot.sound $ by cases h; simp)⟩
-@[simp] lemma inv_mk : (mk L)⁻¹ = mk (L.map $ λ x : α × bool, (x.1, bnot x.2)).reverse := rfl
+⟨quot.map inv_rev (by { intros a b h, cases h, simp [inv_rev], })⟩
 
+@[simp, to_additive] lemma inv_mk : (mk L)⁻¹ = mk (inv_rev L) := rfl
+
+@[to_additive]
+lemma red.step.inv_rev {L₁ L₂ : list (α × bool)} (h : red.step L₁ L₂) :
+  red.step (inv_rev L₁) (inv_rev L₂) :=
+begin
+  cases h with a b x y,
+  simp [inv_rev],
+end
+
+@[to_additive]
+lemma red.inv_rev {L₁ L₂ : list (α × bool)} (h : red L₁ L₂) :
+  red (inv_rev L₁) (inv_rev L₂) :=
+relation.refl_trans_gen.lift _ (λ a b, red.step.inv_rev) h
+
+@[simp, to_additive]
+lemma red.step_inv_rev_iff : red.step (inv_rev L₁) (inv_rev L₂) ↔ red.step L₁ L₂ :=
+⟨λ h, by simpa only [inv_rev_inv_rev] using h.inv_rev, λ h, h.inv_rev⟩
+
+@[simp, to_additive] lemma red_inv_rev_iff : red (inv_rev L₁) (inv_rev L₂) ↔ red L₁ L₂ :=
+⟨λ h, by simpa only [inv_rev_inv_rev] using h.inv_rev, λ h, h.inv_rev⟩
+
+@[to_additive]
 instance : group (free_group α) :=
 { mul := (*),
   one := 1,
@@ -382,18 +483,22 @@ instance : group (free_group α) :=
   one_mul := by rintros ⟨L⟩; refl,
   mul_one := by rintros ⟨L⟩; simp [one_eq_mk],
   mul_left_inv := by rintros ⟨L⟩; exact (list.rec_on L rfl $
-    λ ⟨x, b⟩ tl ih, eq.trans (quot.sound $ by simp [one_eq_mk]) ih) }
+    λ ⟨x, b⟩ tl ih, eq.trans (quot.sound $ by simp [inv_rev, one_eq_mk]) ih) }
 
 /-- `of` is the canonical injection from the type to the free group over that type by sending each
 element to the equivalence class of the letter that is the element. -/
+@[to_additive "`of` is the canonical injection from the type to the free group over that type
+by sending each element to the equivalence class of the letter that is the element."]
 def of (x : α) : free_group α :=
 mk [(x, tt)]
 
+@[to_additive]
 theorem red.exact : mk L₁ = mk L₂ ↔ join red L₁ L₂ :=
 calc (mk L₁ = mk L₂) ↔ eqv_gen red.step L₁ L₂ : iff.intro (quot.exact _) quot.eqv_gen_sound
   ... ↔ join red L₁ L₂ : eqv_gen_step_iff_join_red
 
-/-- The canonical injection from the type to the free group is an injection. -/
+/-- The canonical map from the type to the free group is an injection. -/
+@[to_additive "The canonical map from the type to the additive free group is an injection."]
 theorem of_injective : function.injective (@of α) :=
 λ _ _ H, let ⟨L₁, hx, hy⟩ := red.exact.1 H in
   by simp [red.singleton_iff] at hx hy; cc
@@ -403,9 +508,12 @@ section lift
 variables {β : Type v} [group β] (f : α → β) {x y : free_group α}
 
 /-- Given `f : α → β` with `β` a group, the canonical map `list (α × bool) → β` -/
+@[to_additive "Given `f : α → β` with `β` an additive group, the canonical map
+`list (α × bool) → β`"]
 def lift.aux : list (α × bool) → β :=
 λ L, list.prod $ L.map $ λ x, cond x.2 (f x.1) (f x.1)⁻¹
 
+@[to_additive]
 theorem red.step.lift {f : α → β} (H : red.step L₁ L₂) :
   lift.aux f L₁ = lift.aux f L₂ :=
 by cases H with _ _ _ b; cases b; simp [lift.aux]
@@ -414,7 +522,9 @@ by cases H with _ _ _ b; cases b; simp [lift.aux]
 /-- If `β` is a group, then any function from `α` to `β`
 extends uniquely to a group homomorphism from
 the free group over `α` to `β` -/
-@[simps symm_apply]
+@[to_additive "If `β` is an additive group, then any function from `α` to `β`
+extends uniquely to an additive group homomorphism from
+the free additive group over `α` to `β`", simps symm_apply]
 def lift : (α → β) ≃ (free_group α →* β) :=
 { to_fun := λ f,
     monoid_hom.mk' (quot.lift (lift.aux f) $ λ L₁ L₂, red.step.lift) $ begin
@@ -434,13 +544,14 @@ def lift : (α → β) ≃ (free_group α →* β) :=
   end }
 variable {f}
 
-@[simp] lemma lift.mk : lift f (mk L) =
+@[simp, to_additive] lemma lift.mk : lift f (mk L) =
   list.prod (L.map $ λ x, cond x.2 (f x.1) (f x.1)⁻¹) :=
 rfl
 
-@[simp] lemma lift.of {x} : lift f (of x) = f x :=
+@[simp, to_additive] lemma lift.of {x} : lift f (of x) = f x :=
 one_mul _
 
+@[to_additive]
 theorem lift.unique (g : free_group α →* β)
   (hg : ∀ x, g (of x) = f x) : ∀{x}, g x = lift f x :=
 monoid_hom.congr_fun $ (lift.symm_apply_eq).mp (funext hg : g ∘ of = f)
@@ -448,14 +559,19 @@ monoid_hom.congr_fun $ (lift.symm_apply_eq).mp (funext hg : g ∘ of = f)
 /-- Two homomorphisms out of a free group are equal if they are equal on generators.
 
 See note [partially-applied ext lemmas]. -/
-@[ext]
+@[ext, to_additive
+"Two homomorphisms out of a free additive group are equal if they are equal on generators.
+
+See note [partially-applied ext lemmas]."]
 lemma ext_hom {G : Type*} [group G] (f g : free_group α →* G) (h : ∀ a, f (of a) = g (of a)) :
   f = g :=
 lift.symm.injective $ funext h
 
+@[to_additive]
 theorem lift.of_eq (x : free_group α) : lift of x = x :=
 monoid_hom.congr_fun (lift.apply_symm_apply (monoid_hom.id _)) x
 
+@[to_additive]
 theorem lift.range_le {s : subgroup β} (H : set.range f ⊆ s) :
   (lift f).range ≤ s :=
 by rintros _ ⟨⟨L⟩, rfl⟩; exact list.rec_on L s.one_mem
@@ -464,6 +580,7 @@ by rintros _ ⟨⟨L⟩, rfl⟩; exact list.rec_on L s.one_mem
       (s.inv_mem $ H ⟨x, rfl⟩) ih)
     (by simp at ih ⊢; from s.mul_mem (H ⟨x, rfl⟩) ih))
 
+@[to_additive]
 theorem lift.range_eq_closure :
   (lift f).range = subgroup.closure (set.range f) :=
 begin
@@ -481,7 +598,9 @@ variables {β : Type v} (f : α → β) {x y : free_group α}
 
 /-- Any function from `α` to `β` extends uniquely
 to a group homomorphism from the free group
-ver `α` to the free group over `β`. -/
+over `α` to the free group over `β`. -/
+@[to_additive "Any function from `α` to `β` extends uniquely to an additive group homomorphism
+from the additive free group over `α` to the additive free group over `β`."]
 def map : free_group α →* free_group β :=
 monoid_hom.mk'
   (quot.map (list.map $ λ x, (f x.1, x.2)) $ λ L₁ L₂ H, by cases H; simp)
@@ -489,20 +608,22 @@ monoid_hom.mk'
 
 variable {f}
 
-@[simp] lemma map.mk : map f (mk L) = mk (L.map (λ x, (f x.1, x.2))) :=
+@[simp, to_additive] lemma map.mk : map f (mk L) = mk (L.map (λ x, (f x.1, x.2))) :=
 rfl
 
-@[simp] lemma map.id (x : free_group α) : map id x = x :=
+@[simp, to_additive] lemma map.id (x : free_group α) : map id x = x :=
 by rcases x with ⟨L⟩; simp [list.map_id']
 
-@[simp] lemma map.id' (x : free_group α) : map (λ z, z) x = x := map.id x
+@[simp, to_additive] lemma map.id' (x : free_group α) : map (λ z, z) x = x := map.id x
 
+@[to_additive]
 theorem map.comp {γ : Type w} (f : α → β) (g : β → γ) (x) :
   map g (map f x) = map (g ∘ f) x :=
 by rcases x with ⟨L⟩; simp
 
-@[simp] lemma map.of {x} : map f (of x) = of (f x) := rfl
+@[simp, to_additive] lemma map.of {x} : map f (of x) = of (f x) := rfl
 
+@[to_additive]
 theorem map.unique (g : free_group α →* free_group β)
   (hg : ∀ x, g (of x) = of (f x)) : ∀{x}, g x = map f x :=
 by rintros ⟨L⟩; exact list.rec_on L g.map_one
@@ -512,6 +633,7 @@ by rintros ⟨L⟩; exact list.rec_on L g.map_one
   (show g (of x * mk t) = map f (of x * mk t),
      by simp [g.map_mul, hg, ih]))
 
+@[to_additive]
 theorem map_eq_lift : map f x = lift (of ∘ f) x :=
 eq.symm $ map.unique _ $ λ x, by simp
 
@@ -520,20 +642,23 @@ eq.symm $ map.unique _ $ λ x, by simp
 The converse can be found in `group_theory.free_abelian_group_finsupp`,
 as `equiv.of_free_group_equiv`
  -/
-@[simps apply]
+@[to_additive "Equivalent types give rise to additively equivalent additive free groups.",
+simps apply]
 def free_group_congr {α β} (e : α ≃ β) : free_group α ≃* free_group β :=
 { to_fun := map e, inv_fun := map e.symm,
   left_inv := λ x, by simp [function.comp, map.comp],
   right_inv := λ x, by simp [function.comp, map.comp],
   map_mul' := monoid_hom.map_mul _ }
 
-@[simp] lemma free_group_congr_refl : free_group_congr (equiv.refl α) = mul_equiv.refl _ :=
+@[simp, to_additive]
+lemma free_group_congr_refl : free_group_congr (equiv.refl α) = mul_equiv.refl _ :=
 mul_equiv.ext map.id
 
-@[simp] lemma free_group_congr_symm {α β} (e : α ≃ β) :
+@[simp, to_additive] lemma free_group_congr_symm {α β} (e : α ≃ β) :
   (free_group_congr e).symm = free_group_congr e.symm :=
 rfl
 
+@[to_additive]
 lemma free_group_congr_trans {α β γ} (e : α ≃ β) (f : β ≃ γ) :
   (free_group_congr e).trans (free_group_congr f) = free_group_congr (e.trans f) :=
 mul_equiv.ext $ map.comp _ _
@@ -547,18 +672,23 @@ variables [group α] (x y : free_group α)
 /-- If `α` is a group, then any function from `α` to `α`
 extends uniquely to a homomorphism from the
 free group over `α` to `α`. This is the multiplicative
-version of `sum`. -/
+version of `free_group.sum`. -/
+@[to_additive
+"If `α` is an additive group, then any function from `α` to `α`
+extends uniquely to an additive homomorphism from the
+additive free group over `α` to `α`."]
 def prod : free_group α →* α := lift id
 
 variables {x y}
 
-@[simp] lemma prod_mk :
+@[simp, to_additive] lemma prod_mk :
   prod (mk L) = list.prod (L.map $ λ x, cond x.2 x.1 x.1⁻¹) :=
 rfl
 
-@[simp] lemma prod.of {x : α} : prod (of x) = x :=
+@[simp, to_additive] lemma prod.of {x : α} : prod (of x) = x :=
 lift.of
 
+@[to_additive]
 lemma prod.unique (g : free_group α →* α)
   (hg : ∀ x, g (of x) = x) {x} :
   g x = prod x :=
@@ -566,6 +696,7 @@ lift.unique g hg
 
 end prod
 
+@[to_additive]
 theorem lift_eq_prod_map {β : Type v} [group β] {f : α → β} {x} :
   lift f x = prod (map f x) :=
 begin
@@ -603,11 +734,13 @@ prod.of
 (@prod (multiplicative _) _).map_one
 
 @[simp] lemma sum.map_inv : sum x⁻¹ = -sum x :=
-(@prod (multiplicative _) _).map_inv _
+(prod : free_group (multiplicative α) →* multiplicative α).map_inv _
 
 end sum
 
 /-- The bijection between the free group on the empty type, and a type with one element. -/
+@[to_additive
+"The bijection between the additive free group on the empty type, and a type with one element."]
 def free_group_empty_equiv_unit : free_group empty ≃ unit :=
 { to_fun    := λ _, (),
   inv_fun   := λ _, 1,
@@ -636,12 +769,13 @@ section category
 
 variables {β : Type u}
 
+@[to_additive]
 instance : monad free_group.{u} :=
 { pure := λ α, of,
   map := λ α β f, (map f),
   bind := λ α β x f, lift f x }
 
-@[elab_as_eliminator]
+@[elab_as_eliminator, to_additive]
 protected theorem induction_on
   {C : free_group α → Prop}
   (z : free_group α)
@@ -652,31 +786,34 @@ protected theorem induction_on
 quot.induction_on z $ λ L, list.rec_on L C1 $ λ ⟨x, b⟩ tl ih,
 bool.rec_on b (Cm _ _ (Ci _ $ Cp x) ih) (Cm _ _ (Cp x) ih)
 
-@[simp] lemma map_pure (f : α → β) (x : α) : f <$> (pure x : free_group α) = pure (f x) :=
-map.of
+@[simp, to_additive]
+lemma map_pure (f : α → β) (x : α) : f <$> (pure x : free_group α) = pure (f x) := map.of
 
-@[simp] lemma map_one (f : α → β) : f <$> (1 : free_group α) = 1 :=
+@[simp, to_additive] lemma map_one (f : α → β) : f <$> (1 : free_group α) = 1 :=
 (map f).map_one
 
-@[simp] lemma map_mul (f : α → β) (x y : free_group α) : f <$> (x * y) = f <$> x * f <$> y :=
+@[simp, to_additive]
+lemma map_mul (f : α → β) (x y : free_group α) : f <$> (x * y) = f <$> x * f <$> y :=
 (map f).map_mul x y
 
-@[simp] lemma map_inv (f : α → β) (x : free_group α) : f <$> (x⁻¹) = (f <$> x)⁻¹ :=
+@[simp, to_additive] lemma map_inv (f : α → β) (x : free_group α) : f <$> (x⁻¹) = (f <$> x)⁻¹ :=
 (map f).map_inv x
 
-@[simp] lemma pure_bind (f : α → free_group β) (x) : pure x >>= f = f x :=
+@[simp, to_additive] lemma pure_bind (f : α → free_group β) (x) : pure x >>= f = f x :=
 lift.of
 
-@[simp] lemma one_bind (f : α → free_group β) : 1 >>= f = 1 :=
+@[simp, to_additive] lemma one_bind (f : α → free_group β) : 1 >>= f = 1 :=
 (lift f).map_one
 
-@[simp] lemma mul_bind (f : α → free_group β) (x y : free_group α) :
+@[simp, to_additive] lemma mul_bind (f : α → free_group β) (x y : free_group α) :
   x * y >>= f = (x >>= f) * (y >>= f) :=
 (lift f).map_mul _ _
 
-@[simp] lemma inv_bind (f : α → free_group β) (x : free_group α) : x⁻¹ >>= f = (x >>= f)⁻¹ :=
+@[simp, to_additive]
+lemma inv_bind (f : α → free_group β) (x : free_group α) : x⁻¹ >>= f = (x >>= f)⁻¹ :=
 (lift f).map_inv _
 
+@[to_additive]
 instance : is_lawful_monad free_group.{u} :=
 { id_map := λ α x, free_group.induction_on x (map_one id) (λ x, map_pure id x)
     (λ x ih, by rw [map_inv, ih]) (λ x y ihx ihy, by rw [map_mul, ihx, ihy]),
@@ -697,19 +834,24 @@ variable [decidable_eq α]
 
 /-- The maximal reduction of a word. It is computable
 iff `α` has decidable equality. -/
+@[to_additive "The maximal reduction of a word. It is computable
+iff `α` has decidable equality."]
 def reduce (L : list (α × bool)) : list (α × bool) :=
 list.rec_on L [] $ λ hd1 tl1 ih,
 list.cases_on ih [hd1] $ λ hd2 tl2,
 if hd1.1 = hd2.1 ∧ hd1.2 = bnot hd2.2 then tl2
 else hd1 :: hd2 :: tl2
 
-@[simp] lemma reduce.cons (x) : reduce (x :: L) =
+@[simp, to_additive] lemma reduce.cons (x) : reduce (x :: L) =
   list.cases_on (reduce L) [x] (λ hd tl,
   if x.1 = hd.1 ∧ x.2 = bnot hd.2 then tl
   else x :: hd :: tl) := rfl
 
 /-- The first theorem that characterises the function
 `reduce`: a word reduces to its maximal reduction. -/
+@[to_additive
+"The first theorem that characterises the function
+`reduce`: a word reduces to its maximal reduction."]
 theorem reduce.red : red L (reduce L) :=
 begin
   induction L with hd1 tl1 ih,
@@ -724,18 +866,17 @@ begin
     case list.nil
     { exact red.cons_cons ih },
     case list.cons
-    { dsimp,
-      by_cases h : hd1.fst = hd2.fst ∧ hd1.snd = bnot (hd2.snd),
-      { rw [if_pos h],
-        transitivity,
+    { dsimp only,
+      split_ifs with h,
+      { transitivity,
         { exact red.cons_cons ih },
         { cases hd1, cases hd2, cases h,
           dsimp at *, subst_vars,
           exact red.step.cons_bnot_rev.to_red } },
-      { rw [if_neg h],
-        exact red.cons_cons ih } } }
+      { exact red.cons_cons ih } } }
 end
 
+@[to_additive]
 theorem reduce.not {p : Prop} :
   ∀ {L₁ L₂ L₃ : list (α × bool)} {x b}, reduce L₁ = L₂ ++ (x, b) :: (x, bnot b) :: L₃ → p
 | [] L2 L3 _ _ := λ h, by cases L2; injections
@@ -747,7 +888,8 @@ theorem reduce.not {p : Prop} :
     simp [-add_comm] at this,
     exact absurd this dec_trivial },
   cases hd with y c,
-  by_cases x = y ∧ b = bnot c; simp [h]; intro H,
+  dsimp only,
+  split_ifs with h; intro H,
   { rw H at r,
     exact @reduce.not L1 ((y,c)::L2) L3 x' b' r },
   rcases L2 with _|⟨a, L2⟩,
@@ -761,6 +903,9 @@ end
 /-- The second theorem that characterises the
 function `reduce`: the maximal reduction of a word
 only reduces to itself. -/
+@[to_additive "The second theorem that characterises the
+function `reduce`: the maximal reduction of a word
+only reduces to itself."]
 theorem reduce.min (H : red (reduce L₁) L₂) : reduce L₁ = L₂ :=
 begin
   induction H with L1 L' L2 H1 H2 ih,
@@ -772,62 +917,127 @@ end
 /-- `reduce` is idempotent, i.e. the maximal reduction
 of the maximal reduction of a word is the maximal
 reduction of the word. -/
-theorem reduce.idem : reduce (reduce L) = reduce L :=
+@[simp, to_additive "`reduce` is idempotent, i.e. the maximal reduction
+of the maximal reduction of a word is the maximal
+reduction of the word."] theorem reduce.idem : reduce (reduce L) = reduce L :=
 eq.symm $ reduce.min reduce.red
 
+@[to_additive]
 theorem reduce.step.eq (H : red.step L₁ L₂) : reduce L₁ = reduce L₂ :=
 let ⟨L₃, HR13, HR23⟩ := red.church_rosser reduce.red (reduce.red.head H) in
 (reduce.min HR13).trans (reduce.min HR23).symm
 
 /-- If a word reduces to another word, then they have
 a common maximal reduction. -/
+@[to_additive "If a word reduces to another word, then they have
+a common maximal reduction."]
 theorem reduce.eq_of_red (H : red L₁ L₂) : reduce L₁ = reduce L₂ :=
 let ⟨L₃, HR13, HR23⟩ := red.church_rosser reduce.red (red.trans H reduce.red) in
 (reduce.min HR13).trans (reduce.min HR23).symm
 
+alias reduce.eq_of_red ← red.reduce_eq
+alias free_add_group.reduce.eq_of_red ← free_add_group.red.reduce_eq
+
+@[to_additive]
+lemma red.reduce_right (h : red L₁ L₂) : red L₁ (reduce L₂) :=
+reduce.eq_of_red h ▸ reduce.red
+
+@[to_additive]
+lemma red.reduce_left (h : red L₁ L₂) : red L₂ (reduce L₁) :=
+(reduce.eq_of_red h).symm ▸ reduce.red
+
 /-- If two words correspond to the same element in
 the free group, then they have a common maximal
 reduction. This is the proof that the function that
 sends an element of the free group to its maximal
 reduction is well-defined. -/
+@[to_additive
+"If two words correspond to the same element in
+the additive free group, then they have a common maximal
+reduction. This is the proof that the function that
+sends an element of the free group to its maximal
+reduction is well-defined."]
 theorem reduce.sound (H : mk L₁ = mk L₂) : reduce L₁ = reduce L₂ :=
 let ⟨L₃, H13, H23⟩ := red.exact.1 H in
 (reduce.eq_of_red H13).trans (reduce.eq_of_red H23).symm
 
 /-- If two words have a common maximal reduction,
 then they correspond to the same element in the free group. -/
+@[to_additive "If two words have a common maximal reduction,
+then they correspond to the same element in the additive free group."]
 theorem reduce.exact (H : reduce L₁ = reduce L₂) : mk L₁ = mk L₂ :=
 red.exact.2 ⟨reduce L₂, H ▸ reduce.red, reduce.red⟩
 
 /-- A word and its maximal reduction correspond to
 the same element of the free group. -/
+@[to_additive "A word and its maximal reduction correspond to
+the same element of the additive free group."]
 theorem reduce.self : mk (reduce L) = mk L :=
 reduce.exact reduce.idem
 
 /-- If words `w₁ w₂` are such that `w₁` reduces to `w₂`,
 then `w₂` reduces to the maximal reduction of `w₁`. -/
+@[to_additive "If words `w₁ w₂` are such that `w₁` reduces to `w₂`,
+then `w₂` reduces to the maximal reduction of `w₁`."]
 theorem reduce.rev (H : red L₁ L₂) : red L₂ (reduce L₁) :=
 (reduce.eq_of_red H).symm ▸ reduce.red
 
 /-- The function that sends an element of the free
 group to its maximal reduction. -/
+@[to_additive "The function that sends an element of the additive free
+group to its maximal reduction."]
 def to_word : free_group α → list (α × bool) :=
 quot.lift reduce $ λ L₁ L₂ H, reduce.step.eq H
 
-lemma to_word.mk : ∀{x : free_group α}, mk (to_word x) = x :=
+@[to_additive]
+lemma mk_to_word : ∀{x : free_group α}, mk (to_word x) = x :=
 by rintros ⟨L⟩; exact reduce.self
 
-lemma to_word.inj : ∀(x y : free_group α), to_word x = to_word y → x = y :=
+@[to_additive]
+lemma to_word_injective : function.injective (to_word : free_group α → list (α × bool)) :=
 by rintros ⟨L₁⟩ ⟨L₂⟩; exact reduce.exact
 
+@[simp, to_additive] lemma to_word_inj {x y : free_group α} : to_word x = to_word y ↔ x = y :=
+to_word_injective.eq_iff
+
+@[simp, to_additive] lemma to_word_mk : (mk L₁).to_word = reduce L₁ := rfl
+
+@[simp, to_additive] lemma reduce_to_word : ∀ (x : free_group α), reduce (to_word x) = to_word x :=
+by { rintro ⟨L⟩, exact reduce.idem }
+
+@[simp, to_additive] lemma to_word_one : (1 : free_group α).to_word = [] := rfl
+
+@[simp, to_additive] lemma to_word_eq_nil_iff {x : free_group α} : (x.to_word = []) ↔ (x = 1) :=
+to_word_injective.eq_iff' to_word_one
+
+@[to_additive]
+lemma reduce_inv_rev {w : list (α × bool)} : reduce (inv_rev w) = inv_rev (reduce w) :=
+begin
+  apply reduce.min,
+  rw [← red_inv_rev_iff, inv_rev_inv_rev],
+  apply red.reduce_left,
+  have : red (inv_rev (inv_rev w)) (inv_rev (reduce (inv_rev w))) := reduce.red.inv_rev,
+  rwa inv_rev_inv_rev at this
+end
+
+@[to_additive]
+lemma to_word_inv {x : free_group α} : (x⁻¹).to_word = inv_rev x.to_word :=
+begin
+  rcases x with ⟨L⟩,
+  rw [quot_mk_eq_mk, inv_mk, to_word_mk, to_word_mk, reduce_inv_rev]
+end
+
 /-- Constructive Church-Rosser theorem (compare `church_rosser`). -/
+@[to_additive "Constructive Church-Rosser theorem (compare `church_rosser`)."]
 def reduce.church_rosser (H12 : red L₁ L₂) (H13 : red L₁ L₃) :
   { L₄ // red L₂ L₄ ∧ red L₃ L₄ } :=
 ⟨reduce L₁, reduce.rev H12, reduce.rev H13⟩
 
+@[to_additive]
 instance : decidable_eq (free_group α) :=
-function.injective.decidable_eq to_word.inj
+to_word_injective.decidable_eq
 
+-- TODO @[to_additive] doesn't succeed, possibly due to a bug
 instance red.decidable_rel : decidable_rel (@red α)
 | [] []          := is_true red.refl
 | [] (hd2::tl2)  := is_false $ λ H, list.no_confusion (red.nil_iff.1 H)
@@ -863,4 +1073,31 @@ fintype.subtype (list.to_finset $ red.enum L₁) $
 
 end reduce
 
+section metric
+
+variable [decidable_eq α]
+
+/-- The length of reduced words provides a norm on a free group. -/
+@[to_additive "The length of reduced words provides a norm on an additive free group."]
+def norm (x : free_group α) : ℕ := x.to_word.length
+
+@[simp, to_additive] lemma norm_inv_eq {x : free_group α} : norm x⁻¹ = norm x :=
+by simp only [norm, to_word_inv, inv_rev_length]
+
+@[simp, to_additive] lemma norm_eq_zero {x : free_group α} : norm x = 0 ↔ x = 1 :=
+by simp only [norm, list.length_eq_zero, to_word_eq_nil_iff]
+
+@[simp, to_additive] lemma norm_one : norm (1 : free_group α) = 0 := rfl
+
+@[to_additive]
+theorem norm_mk_le : norm (mk L₁) ≤ L₁.length := reduce.red.length_le
+
+@[to_additive]
+lemma norm_mul_le (x y : free_group α) : norm (x * y) ≤ norm x + norm y :=
+calc norm (x * y) = norm (mk (x.to_word ++ y.to_word)) : by rw [← mul_mk, mk_to_word, mk_to_word]
+              ... ≤ (x.to_word ++ y.to_word).length    : norm_mk_le
+              ... = norm x + norm y                    : list.length_append _ _
+
+end metric
+
 end free_group
diff --git a/src/group_theory/free_product.lean b/src/group_theory/free_product.lean
index 8471ceda85989..9426a82491c56 100644
--- a/src/group_theory/free_product.lean
+++ b/src/group_theory/free_product.lean
@@ -3,15 +3,19 @@ Copyright (c) 2021 David Wärn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: David Wärn, Joachim Breitner
 -/
-import algebra.free_monoid
+import algebra.free_monoid.basic
 import group_theory.congruence
 import group_theory.is_free_group
-import group_theory.subgroup.pointwise
 import data.list.chain
 import set_theory.cardinal.ordinal
+import data.set.pointwise.smul
+
 /-!
 # The free product of groups or monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given an `ι`-indexed family `M` of monoids, we define their free product (categorical coproduct)
 `free_product M`. When `ι` and all `M i` have decidable equality, the free product bijects with the
 type `word M` of reduced words. This bijection is constructed by defining an action of
@@ -63,6 +67,8 @@ another answer, which is constructively more satisfying, could be obtained by sh
 
 -/
 
+open set
+
 variables {ι : Type*} (M : Π i : ι, Type*) [Π i, monoid (M i)]
 
 /-- A relation on the free monoid on alphabet `Σ i, M i`, relating `⟨i, 1⟩` with `1` and
@@ -111,7 +117,7 @@ def lift : (Π i, M i →* N) ≃ (free_product M →* N) :=
 { to_fun := λ fi, con.lift _ (free_monoid.lift $ λ p : Σ i, M i, fi p.fst p.snd) $ con.con_gen_le
     begin
       simp_rw [con.rel_eq_coe, con.ker_rel],
-      rintros _ _ (i | ⟨i, x, y⟩),
+      rintro _ _ (i | ⟨x, y⟩),
       { change free_monoid.lift _ (free_monoid.of _) = free_monoid.lift _ 1,
         simp only [monoid_hom.map_one, free_monoid.lift_eval_of], },
       { change free_monoid.lift _ (free_monoid.of _ * free_monoid.of _) =
@@ -137,11 +143,11 @@ lemma induction_on {C : free_product M → Prop}
   C m :=
 begin
   let S : submonoid (free_product M) := submonoid.mk (set_of C) h_mul h_one,
-  convert subtype.prop (lift (λ i, of.cod_mrestrict S (h_of i)) m),
+  convert subtype.prop (lift (λ i, of.cod_restrict S (h_of i)) m),
   change monoid_hom.id _ m = S.subtype.comp _ m,
   congr,
   ext,
-  simp [monoid_hom.cod_mrestrict],
+  simp [monoid_hom.cod_restrict],
 end
 
 lemma of_left_inverse [decidable_eq ι] (i : ι) :
@@ -378,7 +384,7 @@ variable (M)
 /-- A `neword M i j` is a representation of a non-empty reduced words where the first letter comes
 from `M i` and the last letter comes from `M j`. It can be constructed from singletons and via
 concatentation, and thus provides a useful induction principle. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 inductive neword : ι → ι → Type (max u_1 u_2)
 | singleton : ∀ {i} (x : M i) (hne1 : x ≠ 1), neword i i
 | append : ∀ {i j k l} (w₁ : neword i j) (hne : j ≠ k) (w₂ : neword k l), neword i l
@@ -459,8 +465,8 @@ def to_word {i j} (w : neword M i j) : word M :=
 lemma of_word (w : word M) (h : w ≠ empty) :
   ∃ i j (w' : neword M i j), w'.to_word = w :=
 begin
-  suffices : ∃ i j (w' : neword M i j), w'.to_word.to_list = w.to_list,
-  { obtain ⟨i, j, w, h⟩ := this, refine ⟨i, j, w, _⟩, ext, rw h, },
+  rsuffices ⟨i, j, w, h⟩ : ∃ i j (w' : neword M i j), w'.to_word.to_list = w.to_list,
+  { refine ⟨i, j, w, _⟩, ext, rw h, },
   cases w with l hnot1 hchain,
   induction l with x l hi,
   { contradiction, },
@@ -589,7 +595,7 @@ lemma lift_word_ping_pong {i j k} (w : neword H i j) (hk : j ≠ k) :
 begin
   rename [i → i', j → j', k → m, hk → hm],
   induction w with i x hne_one i j k l w₁ hne w₂  hIw₁ hIw₂ generalizing m; clear i' j',
-  { simpa using hpp _ _ hm _ hne_one, },
+  { simpa using hpp hm _ hne_one, },
   { calc lift f (neword.append w₁ hne w₂).prod • X m
         = lift f w₁.prod • lift f w₂.prod • X m : by simp [mul_action.mul_smul]
     ... ⊆ lift f w₁.prod • X k : set_smul_subset_set_smul_iff.mpr (hIw₂ hm)
@@ -605,7 +611,7 @@ begin
   have : X k ⊆ X i,
     by simpa [heq1] using lift_word_ping_pong f X hpp w hlast.symm,
   obtain ⟨x, hx⟩ := hXnonempty k,
-  exact hXdisj k i hhead ⟨hx, this hx⟩,
+  exact (hXdisj hhead).le_bot ⟨hx, this hx⟩,
 end
 
 include hnontriv
@@ -674,7 +680,7 @@ The Ping-Pong-Lemma.
 
 Given a group action of `G` on `X` so that the `H i` acts in a specific way on disjoint subsets
 `X i` we can prove that `lift f` is injective, and thus the image of `lift f` is isomorphic to the
-direct product of the `H i`.
+free product of the `H i`.
 
 Often the Ping-Pong-Lemma is stated with regard to subgroups `H i` that generate the whole group;
 we generalize to arbitrary group homomorphisms `f i : H i →* G` and do not require the group to be
@@ -688,13 +694,11 @@ theorem lift_injective_of_ping_pong:
 begin
   classical,
   apply (injective_iff_map_eq_one (lift f)).mpr,
-  rw free_product.word.equiv.forall_congr_left',
+  rw (free_product.word.equiv : _ ≃ word H).forall_congr_left',
   { intros w Heq,
     dsimp [word.equiv] at *,
     { rw empty_of_word_prod_eq_one f hcard X hXnonempty hXdisj hpp Heq,
       reflexivity, }, },
-  apply_instance,
-  apply_instance,
 end
 
 end ping_pong_lemma
@@ -744,8 +748,8 @@ variables (hXnonempty : ∀ i, (X i).nonempty)
 variables (hXdisj : pairwise (λ i j, disjoint (X i) (X j)))
 variables (hYdisj : pairwise (λ i j, disjoint (Y i) (Y j)))
 variables (hXYdisj : ∀ i j, disjoint (X i) (Y j))
-variables (hX : ∀ i, a i • set.compl (Y i) ⊆ X i)
-variables (hY : ∀ i, a⁻¹ i • set.compl (X i) ⊆ Y i)
+variables (hX : ∀ i, a i • (Y i)ᶜ ⊆ X i)
+variables (hY : ∀ i, a⁻¹ i • (X i)ᶜ ⊆ Y i)
 
 include hXnonempty hXdisj hYdisj hXYdisj hX hY
 
@@ -796,10 +800,10 @@ begin
   { intros i j hij,
     simp only [X'],
     apply disjoint.union_left; apply disjoint.union_right,
-    { exact hXdisj i j hij, },
+    { exact hXdisj hij, },
     { exact hXYdisj i j, },
     { exact (hXYdisj j i).symm, },
-    { exact hYdisj i j hij, }, },
+    { exact hYdisj hij, }, },
 
   show pairwise (λ i j, ∀ h : H i, h ≠ 1 → f i h • X' j ⊆ X' i),
   { rintros i j hij,
@@ -815,38 +819,34 @@ begin
     -- Positive and negative powers separately
     cases (lt_or_gt_of_ne hnne0).swap with hlt hgt,
     { have h1n : 1 ≤ n := hlt,
-      calc a i ^ n • X' j ⊆ a i ^ n • (Y i).compl : set_smul_subset_set_smul_iff.mpr $
-        set.disjoint_iff_subset_compl_right.mp $
-          disjoint.union_left (hXYdisj j i) (hYdisj j i hij.symm)
+      calc a i ^ n • X' j ⊆ a i ^ n • (Y i)ᶜ : smul_set_mono
+            ((hXYdisj j i).union_left $ hYdisj hij.symm).subset_compl_right
       ... ⊆ X i :
       begin
         refine int.le_induction _ _ _ h1n,
         { rw zpow_one, exact hX i, },
         { intros n hle hi,
-          calc (a i ^ (n + 1)) • (Y i).compl
-                = (a i ^ n * a i) • (Y i).compl : by rw [zpow_add, zpow_one]
-            ... = a i ^ n • (a i • (Y i).compl) : mul_action.mul_smul _ _ _
-            ... ⊆ a i ^ n • X i : set_smul_subset_set_smul_iff.mpr $ hX i
-            ... ⊆ a i ^ n • (Y i).compl : set_smul_subset_set_smul_iff.mpr $
-              set.disjoint_iff_subset_compl_right.mp (hXYdisj i i)
+          calc (a i ^ (n + 1)) • (Y i)ᶜ
+                = (a i ^ n * a i) • (Y i)ᶜ : by rw [zpow_add, zpow_one]
+            ... = a i ^ n • (a i • (Y i)ᶜ) : mul_action.mul_smul _ _ _
+            ... ⊆ a i ^ n • X i : smul_set_mono $ hX i
+            ... ⊆ a i ^ n • (Y i)ᶜ : smul_set_mono (hXYdisj i i).subset_compl_right
             ... ⊆ X i : hi, },
       end
       ... ⊆ X' i : set.subset_union_left _ _, },
     { have h1n : n ≤ -1, { apply int.le_of_lt_add_one, simpa using hgt, },
-      calc a i ^ n • X' j ⊆ a i ^ n • (X i).compl : set_smul_subset_set_smul_iff.mpr $
-        set.disjoint_iff_subset_compl_right.mp $
-          disjoint.union_left (hXdisj j i hij.symm) (hXYdisj i j).symm
+      calc a i ^ n • X' j ⊆ a i ^ n • (X i)ᶜ : smul_set_mono
+            ((hXdisj hij.symm).union_left (hXYdisj i j).symm).subset_compl_right
       ... ⊆ Y i :
       begin
         refine int.le_induction_down _ _ _ h1n,
         { rw [zpow_neg, zpow_one], exact hY i, },
         { intros n hle hi,
-          calc (a i ^ (n - 1)) • (X i).compl
-                = (a i ^ n * (a i)⁻¹) • (X i).compl : by rw [zpow_sub, zpow_one]
-            ... = a i ^ n • ((a i)⁻¹ • (X i).compl) : mul_action.mul_smul _ _ _
-            ... ⊆ a i ^ n • Y i : set_smul_subset_set_smul_iff.mpr $ hY i
-            ... ⊆ a i ^ n • (X i).compl : set_smul_subset_set_smul_iff.mpr $
-              set.disjoint_iff_subset_compl_right.mp (hXYdisj i i).symm
+          calc (a i ^ (n - 1)) • (X i)ᶜ
+                = (a i ^ n * (a i)⁻¹) • (X i)ᶜ : by rw [zpow_sub, zpow_one]
+            ... = a i ^ n • ((a i)⁻¹ • (X i)ᶜ) : mul_action.mul_smul _ _ _
+            ... ⊆ a i ^ n • Y i : smul_set_mono $ hY i
+            ... ⊆ a i ^ n • (X i)ᶜ : smul_set_mono (hXYdisj i i).symm.subset_compl_right
             ... ⊆ Y i : hi, },
       end
       ... ⊆ X' i : set.subset_union_right _ _, }, },
diff --git a/src/group_theory/group_action/basic.lean b/src/group_theory/group_action/basic.lean
index 88f649e9ab8ff..c9dfe90ea91b9 100644
--- a/src/group_theory/group_action/basic.lean
+++ b/src/group_theory/group_action/basic.lean
@@ -3,16 +3,19 @@ Copyright (c) 2018 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
-import algebra.hom.group_action
+import data.fintype.card
 import group_theory.group_action.defs
 import group_theory.group_action.group
-import group_theory.quotient_group
 import data.setoid.basic
-import data.fintype.card
+import data.set.pointwise.smul
+import group_theory.subgroup.basic
 
 /-!
 # Basic properties of group actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file primarily concerns itself with orbits, stabilizers, and other objects defined in terms of
 actions. Despite this file being called `basic`, low-level helper lemmas for algebraic manipulation
 of `•` belong elsewhere.
@@ -29,7 +32,7 @@ of `•` belong elsewhere.
 universes u v w
 variables {α : Type u} {β : Type v} {γ : Type w}
 
-open_locale big_operators pointwise
+open_locale pointwise
 open function
 
 namespace mul_action
@@ -188,10 +191,14 @@ def orbit_rel : setoid β :=
 local attribute [instance] orbit_rel
 
 variables {α} {β}
+
+@[to_additive]
+lemma orbit_rel_apply {x y : β} : (orbit_rel α β).rel x y ↔ x ∈ orbit α y := iff.rfl
+
 /-- When you take a set `U` in `β`, push it down to the quotient, and pull back, you get the union
-of the orbit of `U` under `α`.
--/
-@[to_additive] lemma quotient_preimage_image_eq_union_mul (U : set β) :
+of the orbit of `U` under `α`. -/
+@[to_additive "When you take a set `U` in `β`, push it down to the quotient, and pull back, you get
+the union of the orbit of `U` under `α`."] lemma quotient_preimage_image_eq_union_mul (U : set β) :
   quotient.mk ⁻¹' (quotient.mk '' U) = ⋃ a : α, ((•) a) '' U :=
 begin
   set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
@@ -211,48 +218,85 @@ begin
     simp only [inv_smul_smul], },
 end
 
+@[to_additive] lemma disjoint_image_image_iff {U V : set β} :
+  disjoint (quotient.mk '' U) (quotient.mk '' V) ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
+begin
+  set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
+  refine ⟨λ h x x_in_U a a_in_V,
+    h.le_bot ⟨⟨x, x_in_U, quotient.sound ⟨a⁻¹, _⟩⟩, ⟨a • x, a_in_V, rfl⟩⟩, _⟩,
+  { simp },
+  { intro h,
+    rw set.disjoint_left,
+    rintro x ⟨y, hy₁, hy₂⟩ ⟨z, hz₁, hz₂⟩,
+    obtain ⟨a, rfl⟩ := quotient.exact (hz₂.trans hy₂.symm),
+    exact h y hy₁ a hz₁ }
+end
+
 @[to_additive]
 lemma image_inter_image_iff (U V : set β) :
   (quotient.mk '' U) ∩ (quotient.mk '' V) = ∅ ↔ ∀ x ∈ U, ∀ a : α, a • x ∉ V :=
+set.disjoint_iff_inter_eq_empty.symm.trans disjoint_image_image_iff
+
+variables (α β)
+
+/-- The quotient by `mul_action.orbit_rel`, given a name to enable dot notation. -/
+@[reducible, to_additive "The quotient by `add_action.orbit_rel`, given a name to enable dot
+notation."]
+def orbit_rel.quotient : Type* := quotient $ orbit_rel α β
+
+variables {α β}
+
+/-- The orbit corresponding to an element of the quotient by `mul_action.orbit_rel` -/
+@[to_additive "The orbit corresponding to an element of the quotient by `add_action.orbit_rel`"]
+def orbit_rel.quotient.orbit (x : orbit_rel.quotient α β) : set β :=
+quotient.lift_on' x (orbit α) $ λ _ _, mul_action.orbit_eq_iff.2
+
+@[simp, to_additive]
+lemma orbit_rel.quotient.orbit_mk (b : β) :
+  orbit_rel.quotient.orbit (quotient.mk' b : orbit_rel.quotient α β) = orbit α b := rfl
+
+@[to_additive]
+lemma orbit_rel.quotient.mem_orbit {b : β} {x : orbit_rel.quotient α β} :
+  b ∈ x.orbit ↔ quotient.mk' b = x :=
+by { induction x using quotient.induction_on', rw quotient.eq', refl }
+
+/-- Note that `hφ = quotient.out_eq'` is a useful choice here. -/
+@[to_additive "Note that `hφ = quotient.out_eq'` is a useful choice here."]
+lemma orbit_rel.quotient.orbit_eq_orbit_out (x : orbit_rel.quotient α β)
+  {φ : orbit_rel.quotient α β → β} (hφ : right_inverse φ quotient.mk') :
+  orbit_rel.quotient.orbit x = orbit α (φ x) :=
 begin
-  set f : β → quotient (mul_action.orbit_rel α β) := quotient.mk,
-  rw set.eq_empty_iff_forall_not_mem,
-  split,
-  { intros h x x_in_U a a_in_V,
-    refine h (f (a • x)) ⟨⟨x, x_in_U, _⟩, ⟨a • x, a_in_V, rfl⟩⟩,
-    rw quotient.eq,
-    use a⁻¹,
-    simp, },
-  { rintros h x ⟨⟨y, hy₁, hy₂⟩, ⟨z, hz₁, hz₂⟩⟩,
-    obtain ⟨a, ha⟩ := quotient.exact (hz₂.trans hy₂.symm),
-    apply h y hy₁ a,
-    convert hz₁, },
+  conv_lhs { rw ←hφ x },
+  induction x using quotient.induction_on',
+  refl,
 end
 
 variables (α) (β)
-local notation `Ω` := (quotient $ orbit_rel α β)
+
+local notation `Ω` := orbit_rel.quotient α β
 
 /-- Decomposition of a type `X` as a disjoint union of its orbits under a group action.
-This version works with any right inverse to `quotient.mk'` in order to stay computable. In most
-cases you'll want to use `quotient.out'`, so we provide `mul_action.self_equiv_sigma_orbits` as
-a special case. -/
+
+This version is expressed in terms of `mul_action.orbit_rel.quotient.orbit` instead of
+`mul_action.orbit`, to avoid mentioning `quotient.out'`. -/
 @[to_additive "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
-action. This version works with any right inverse to `quotient.mk'` in order to stay computable.
-In most cases you'll want to use `quotient.out'`, so we provide `add_action.self_equiv_sigma_orbits`
-as a special case."]
-def self_equiv_sigma_orbits' {φ : Ω → β} (hφ : right_inverse φ quotient.mk') :
-  β ≃ Σ (ω : Ω), orbit α (φ ω) :=
+action.
+
+This version is expressed in terms of `add_action.orbit_rel.quotient.orbit` instead of
+`add_action.orbit`, to avoid mentioning `quotient.out'`. "]
+def self_equiv_sigma_orbits' : β ≃ Σ ω : Ω, ω.orbit :=
 calc  β
     ≃ Σ (ω : Ω), {b // quotient.mk' b = ω} : (equiv.sigma_fiber_equiv quotient.mk').symm
-... ≃ Σ (ω : Ω), orbit α (φ ω) :
-        equiv.sigma_congr_right (λ ω, equiv.subtype_equiv_right $
-          λ x, by {rw [← hφ ω, quotient.eq', hφ ω], refl })
+... ≃ Σ (ω : Ω), ω.orbit :
+        equiv.sigma_congr_right $ λ ω, equiv.subtype_equiv_right $ λ x,
+          orbit_rel.quotient.mem_orbit.symm
 
 /-- Decomposition of a type `X` as a disjoint union of its orbits under a group action. -/
 @[to_additive "Decomposition of a type `X` as a disjoint union of its orbits under an additive group
 action."]
-noncomputable def self_equiv_sigma_orbits : β ≃ Σ (ω : Ω), orbit α ω.out' :=
-self_equiv_sigma_orbits' α β quotient.out_eq'
+def self_equiv_sigma_orbits : β ≃ Σ (ω : Ω), orbit α ω.out' :=
+(self_equiv_sigma_orbits' α β).trans $ equiv.sigma_congr_right $ λ i,
+  equiv.set.of_eq $ orbit_rel.quotient.orbit_eq_orbit_out _ quotient.out_eq'
 
 variables {α β}
 
@@ -303,240 +347,6 @@ have this : stabilizer α x = (stabilizer α y).map (add_aut.conj g).to_add_mono
 
 end add_action
 
-namespace mul_action
-
-variables [group α]
-
-section quotient_action
-
-open subgroup mul_opposite
-
-variables (β) [monoid β] [mul_action β α] (H : subgroup α)
-
-/-- A typeclass for when a `mul_action β α` descends to the quotient `α ⧸ H`. -/
-class quotient_action : Prop :=
-(inv_mul_mem : ∀ (b : β) {a a' : α}, a⁻¹ * a' ∈ H → (b • a)⁻¹ * (b • a') ∈ H)
-
-/-- A typeclass for when an `add_action β α` descends to the quotient `α ⧸ H`. -/
-class _root_.add_action.quotient_action {α : Type*} (β : Type*) [add_group α] [add_monoid β]
-  [add_action β α] (H : add_subgroup α) : Prop :=
-(inv_mul_mem : ∀ (b : β) {a a' : α}, -a + a' ∈ H → -(b +ᵥ a) + (b +ᵥ a') ∈ H)
-
-attribute [to_additive add_action.quotient_action] mul_action.quotient_action
-
-@[to_additive] instance left_quotient_action : quotient_action α H :=
-⟨λ _ _ _ _, by rwa [smul_eq_mul, smul_eq_mul, mul_inv_rev, mul_assoc, inv_mul_cancel_left]⟩
-
-@[to_additive] instance right_quotient_action : quotient_action H.normalizer.opposite H :=
-⟨λ b c _ _, by rwa [smul_def, smul_def, smul_eq_mul_unop, smul_eq_mul_unop, mul_inv_rev, ←mul_assoc,
-  mem_normalizer_iff'.mp b.prop, mul_assoc, mul_inv_cancel_left]⟩
-
-@[to_additive] instance right_quotient_action' [hH : H.normal] : quotient_action αᵐᵒᵖ H :=
-⟨λ _ _ _ _, by rwa [smul_eq_mul_unop, smul_eq_mul_unop, mul_inv_rev, mul_assoc, hH.mem_comm_iff,
-  mul_assoc, mul_inv_cancel_right]⟩
-
-@[to_additive] instance quotient [quotient_action β H] : mul_action β (α ⧸ H) :=
-{ smul := λ b, quotient.map' ((•) b) (λ a a' h, quotient_action.inv_mul_mem b h),
-  one_smul := λ q, quotient.induction_on' q (λ a, congr_arg quotient.mk' (one_smul β a)),
-  mul_smul := λ b b' q, quotient.induction_on' q (λ a, congr_arg quotient.mk' (mul_smul b b' a)) }
-
-variables {β}
-
-@[simp, to_additive] lemma quotient.smul_mk [quotient_action β H] (b : β) (a : α) :
-  (b • quotient_group.mk a : α ⧸ H) = quotient_group.mk (b • a) := rfl
-
-@[simp, to_additive] lemma quotient.smul_coe [quotient_action β H] (b : β) (a : α) :
-  (b • a : α ⧸ H) = ↑(b • a) := rfl
-
-@[simp, to_additive] lemma quotient.mk_smul_out' [quotient_action β H] (b : β) (q : α ⧸ H) :
-  quotient_group.mk (b • q.out') = b • q :=
-by rw [←quotient.smul_mk, quotient_group.out_eq']
-
-@[simp, to_additive] lemma quotient.coe_smul_out' [quotient_action β H] (b : β) (q : α ⧸ H) :
-  ↑(b • q.out') = b • q :=
-quotient.mk_smul_out' H b q
-
-end quotient_action
-
-open quotient_group
-
-/-- The canonical map to the left cosets. -/
-def _root_.mul_action_hom.to_quotient (H : subgroup α) : α →[α] α ⧸ H :=
-⟨coe, quotient.smul_coe H⟩
-
-@[simp] lemma _root_.mul_action_hom.to_quotient_apply (H : subgroup α) (g : α) :
-  mul_action_hom.to_quotient H g = g := rfl
-
-@[to_additive] instance mul_left_cosets_comp_subtype_val (H I : subgroup α) :
-  mul_action I (α ⧸ H) :=
-mul_action.comp_hom (α ⧸ H) (subgroup.subtype I)
-
-variables (α) {β} [mul_action α β] (x : β)
-
-/-- The canonical map from the quotient of the stabilizer to the set. -/
-@[to_additive "The canonical map from the quotient of the stabilizer to the set. "]
-def of_quotient_stabilizer (g : α ⧸ (mul_action.stabilizer α x)) : β :=
-quotient.lift_on' g (•x) $ λ g1 g2 H,
-calc  g1 • x
-    = g1 • (g1⁻¹ * g2) • x : congr_arg _ H.symm
-... = g2 • x : by rw [smul_smul, mul_inv_cancel_left]
-
-@[simp, to_additive] theorem of_quotient_stabilizer_mk (g : α) :
-  of_quotient_stabilizer α x (quotient_group.mk g) = g • x :=
-rfl
-
-@[to_additive] theorem of_quotient_stabilizer_mem_orbit (g) :
-  of_quotient_stabilizer α x g ∈ orbit α x :=
-quotient.induction_on' g $ λ g, ⟨g, rfl⟩
-
-@[to_additive] theorem of_quotient_stabilizer_smul (g : α)
-  (g' : α ⧸ (mul_action.stabilizer α x)) :
-  of_quotient_stabilizer α x (g • g') = g • of_quotient_stabilizer α x g' :=
-quotient.induction_on' g' $ λ _, mul_smul _ _ _
-
-@[to_additive] theorem injective_of_quotient_stabilizer :
-  function.injective (of_quotient_stabilizer α x) :=
-λ y₁ y₂, quotient.induction_on₂' y₁ y₂ $ λ g₁ g₂ (H : g₁ • x = g₂ • x), quotient.sound' $
-show (g₁⁻¹ * g₂) • x = x, by rw [mul_smul, ← H, inv_smul_smul]
-
-/-- Orbit-stabilizer theorem. -/
-@[to_additive "Orbit-stabilizer theorem."]
-noncomputable def orbit_equiv_quotient_stabilizer (b : β) :
-  orbit α b ≃ α ⧸ (stabilizer α b) :=
-equiv.symm $ equiv.of_bijective
-  (λ g, ⟨of_quotient_stabilizer α b g, of_quotient_stabilizer_mem_orbit α b g⟩)
-  ⟨λ x y hxy, injective_of_quotient_stabilizer α b (by convert congr_arg subtype.val hxy),
-  λ ⟨b, ⟨g, hgb⟩⟩, ⟨g, subtype.eq hgb⟩⟩
-
-/-- Orbit-stabilizer theorem. -/
-@[to_additive "Orbit-stabilizer theorem."]
-noncomputable def orbit_prod_stabilizer_equiv_group (b : β) :
-  orbit α b × stabilizer α b ≃ α :=
-(equiv.prod_congr (orbit_equiv_quotient_stabilizer α _) (equiv.refl _)).trans
-subgroup.group_equiv_quotient_times_subgroup.symm
-
-/-- Orbit-stabilizer theorem. -/
-@[to_additive "Orbit-stabilizer theorem."]
-lemma card_orbit_mul_card_stabilizer_eq_card_group (b : β) [fintype α] [fintype $ orbit α b]
-  [fintype $ stabilizer α b] :
-  fintype.card (orbit α b) * fintype.card (stabilizer α b) = fintype.card α :=
-by rw [← fintype.card_prod, fintype.card_congr (orbit_prod_stabilizer_equiv_group α b)]
-
-@[simp, to_additive] theorem orbit_equiv_quotient_stabilizer_symm_apply (b : β) (a : α) :
-  ((orbit_equiv_quotient_stabilizer α b).symm a : β) = a • b :=
-rfl
-
-@[simp, to_additive] lemma stabilizer_quotient {G} [group G] (H : subgroup G) :
-  mul_action.stabilizer G ((1 : G) : G ⧸ H) = H :=
-by { ext, simp [quotient_group.eq] }
-
-variable (β)
-
-local notation `Ω` := (quotient $ orbit_rel α β)
-
-/-- **Class formula** : given `G` a group acting on `X` and `φ` a function mapping each orbit of `X`
-under this action (that is, each element of the quotient of `X` by the relation `orbit_rel G X`) to
-an element in this orbit, this gives a (noncomputable) bijection between `X` and the disjoint union
-of `G/Stab(φ(ω))` over all orbits `ω`. In most cases you'll want `φ` to be `quotient.out'`, so we
-provide `mul_action.self_equiv_sigma_orbits_quotient_stabilizer` as a special case. -/
-@[to_additive "**Class formula** : given `G` an additive group acting on `X` and `φ` a function
-mapping each orbit of `X` under this action (that is, each element of the quotient of `X` by the
-relation `orbit_rel G X`) to an element in this orbit, this gives a (noncomputable) bijection
-between `X` and the disjoint union of `G/Stab(φ(ω))` over all orbits `ω`. In most cases you'll want
-`φ` to be `quotient.out'`, so we provide `add_action.self_equiv_sigma_orbits_quotient_stabilizer`
-as a special case. "]
-noncomputable def self_equiv_sigma_orbits_quotient_stabilizer' {φ : Ω → β}
-  (hφ : left_inverse quotient.mk' φ) : β ≃ Σ (ω : Ω), α ⧸ (stabilizer α (φ ω)) :=
-calc  β
-    ≃ Σ (ω : Ω), orbit α (φ ω) : self_equiv_sigma_orbits' α β hφ
-... ≃ Σ (ω : Ω), α ⧸ (stabilizer α (φ ω)) :
-        equiv.sigma_congr_right (λ ω, orbit_equiv_quotient_stabilizer α (φ ω))
-
-/-- **Class formula** for a finite group acting on a finite type. See
-`mul_action.card_eq_sum_card_group_div_card_stabilizer` for a specialized version using
-`quotient.out'`. -/
-@[to_additive "**Class formula** for a finite group acting on a finite type. See
-`add_action.card_eq_sum_card_add_group_div_card_stabilizer` for a specialized version using
-`quotient.out'`."]
-lemma card_eq_sum_card_group_div_card_stabilizer' [fintype α] [fintype β] [fintype Ω]
-  [Π (b : β), fintype $ stabilizer α b] {φ : Ω → β} (hφ : left_inverse quotient.mk' φ) :
-  fintype.card β = ∑ (ω : Ω), fintype.card α / fintype.card (stabilizer α (φ ω)) :=
-begin
-  classical,
-  have : ∀ ω : Ω, fintype.card α / fintype.card ↥(stabilizer α (φ ω)) =
-    fintype.card (α ⧸ stabilizer α (φ ω)),
-  { intro ω,
-    rw [fintype.card_congr (@subgroup.group_equiv_quotient_times_subgroup α _ (stabilizer α $ φ ω)),
-        fintype.card_prod, nat.mul_div_cancel],
-    exact fintype.card_pos_iff.mpr (by apply_instance) },
-  simp_rw [this, ← fintype.card_sigma, fintype.card_congr
-            (self_equiv_sigma_orbits_quotient_stabilizer' α β hφ)],
-end
-
-/-- **Class formula**. This is a special case of
-`mul_action.self_equiv_sigma_orbits_quotient_stabilizer'` with `φ = quotient.out'`. -/
-@[to_additive "**Class formula**. This is a special case of
-`add_action.self_equiv_sigma_orbits_quotient_stabilizer'` with `φ = quotient.out'`. "]
-noncomputable def self_equiv_sigma_orbits_quotient_stabilizer :
-  β ≃ Σ (ω : Ω), α ⧸ (stabilizer α ω.out') :=
-self_equiv_sigma_orbits_quotient_stabilizer' α β quotient.out_eq'
-
-/-- **Class formula** for a finite group acting on a finite type. -/
-@[to_additive "**Class formula** for a finite group acting on a finite type."]
-lemma card_eq_sum_card_group_div_card_stabilizer [fintype α] [fintype β] [fintype Ω]
-  [Π (b : β), fintype $ stabilizer α b] :
-  fintype.card β = ∑ (ω : Ω), fintype.card α / fintype.card (stabilizer α ω.out') :=
-card_eq_sum_card_group_div_card_stabilizer' α β quotient.out_eq'
-
-/-- **Burnside's lemma** : a (noncomputable) bijection between the disjoint union of all
-`{x ∈ X | g • x = x}` for `g ∈ G` and the product `G × X/G`, where `G` is a group acting on `X` and
-`X/G`denotes the quotient of `X` by the relation `orbit_rel G X`. -/
-@[to_additive "**Burnside's lemma** : a (noncomputable) bijection between the disjoint union of all
-`{x ∈ X | g • x = x}` for `g ∈ G` and the product `G × X/G`, where `G` is an additive group acting
-on `X` and `X/G`denotes the quotient of `X` by the relation `orbit_rel G X`. "]
-noncomputable def sigma_fixed_by_equiv_orbits_prod_group :
-  (Σ (a : α), (fixed_by α β a)) ≃ Ω × α :=
-calc  (Σ (a : α), fixed_by α β a)
-    ≃ {ab : α × β // ab.1 • ab.2 = ab.2} :
-        (equiv.subtype_prod_equiv_sigma_subtype _).symm
-... ≃ {ba : β × α // ba.2 • ba.1 = ba.1} :
-        (equiv.prod_comm α β).subtype_equiv (λ ab, iff.rfl)
-... ≃ Σ (b : β), stabilizer α b :
-        equiv.subtype_prod_equiv_sigma_subtype (λ (b : β) a, a ∈ stabilizer α b)
-... ≃ Σ (ωb : (Σ (ω : Ω), orbit α ω.out')), stabilizer α (ωb.2 : β) :
-        (self_equiv_sigma_orbits α β).sigma_congr_left'
-... ≃ Σ (ω : Ω), (Σ (b : orbit α ω.out'), stabilizer α (b : β)) :
-        equiv.sigma_assoc (λ (ω : Ω) (b : orbit α ω.out'), stabilizer α (b : β))
-... ≃ Σ (ω : Ω), (Σ (b : orbit α ω.out'), stabilizer α ω.out') :
-        equiv.sigma_congr_right (λ ω, equiv.sigma_congr_right $
-          λ ⟨b, hb⟩, (stabilizer_equiv_stabilizer_of_orbit_rel hb).to_equiv)
-... ≃ Σ (ω : Ω), orbit α ω.out' × stabilizer α ω.out' :
-        equiv.sigma_congr_right (λ ω, equiv.sigma_equiv_prod _ _)
-... ≃ Σ (ω : Ω), α :
-        equiv.sigma_congr_right (λ ω, orbit_prod_stabilizer_equiv_group α ω.out')
-... ≃ Ω × α :
-        equiv.sigma_equiv_prod Ω α
-
-/-- **Burnside's lemma** : given a finite group `G` acting on a set `X`, the average number of
-elements fixed by each `g ∈ G` is the number of orbits. -/
-@[to_additive "**Burnside's lemma** : given a finite additive group `G` acting on a set `X`,
-the average number of elements fixed by each `g ∈ G` is the number of orbits. "]
-lemma sum_card_fixed_by_eq_card_orbits_mul_card_group [fintype α] [Π a, fintype $ fixed_by α β a]
-  [fintype Ω] :
-  ∑ (a : α), fintype.card (fixed_by α β a) = fintype.card Ω * fintype.card α :=
-by rw [← fintype.card_prod, ← fintype.card_sigma,
-        fintype.card_congr (sigma_fixed_by_equiv_orbits_prod_group α β)]
-
-@[to_additive] instance is_pretransitive_quotient (G) [group G] (H : subgroup G) :
-  is_pretransitive G (G ⧸ H) :=
-{ exists_smul_eq := begin
-    rintros ⟨x⟩ ⟨y⟩,
-    refine ⟨y * x⁻¹, quotient_group.eq.mpr _⟩,
-    simp only [smul_eq_mul, H.one_mem, mul_left_inv, inv_mul_cancel_right],
-  end }
-
-end mul_action
-
 /-- `smul` by a `k : M` over a ring is injective, if `k` is not a zero divisor.
 The general theory of such `k` is elaborated by `is_smul_regular`.
 The typeclass that restricts all terms of `M` to have this property is `no_zero_smul_divisors`. -/
@@ -549,29 +359,3 @@ begin
   refine h _ _,
   rw [smul_sub, h', sub_self]
 end
-
-namespace subgroup
-
-variables {G : Type*} [group G] (H : subgroup G)
-
-lemma normal_core_eq_ker :
-  H.normal_core = (mul_action.to_perm_hom G (G ⧸ H)).ker :=
-begin
-  refine le_antisymm (λ g hg, equiv.perm.ext (λ q, quotient_group.induction_on q
-    (λ g', (mul_action.quotient.smul_mk H g g').trans (quotient_group.eq.mpr _))))
-    (subgroup.normal_le_normal_core.mpr (λ g hg, _)),
-  { rw [smul_eq_mul, mul_inv_rev, ←inv_inv g', inv_inv],
-    exact H.normal_core.inv_mem hg g'⁻¹ },
-  { rw [←H.inv_mem_iff, ←mul_one g⁻¹, ←quotient_group.eq, ←mul_one g],
-    exact (mul_action.quotient.smul_mk H g 1).symm.trans (equiv.perm.ext_iff.mp hg (1 : G)) },
-end
-
-noncomputable instance fintype_quotient_normal_core [fintype (G ⧸ H)] :
-  fintype (G ⧸ H.normal_core) :=
-begin
-  rw H.normal_core_eq_ker,
-  classical,
-  exact fintype.of_equiv _ (quotient_group.quotient_ker_equiv_range _).symm.to_equiv,
-end
-
-end subgroup
diff --git a/src/group_theory/group_action/big_operators.lean b/src/group_theory/group_action/big_operators.lean
index f1a2ec0b17ea8..3c799badb1f36 100644
--- a/src/group_theory/group_action/big_operators.lean
+++ b/src/group_theory/group_action/big_operators.lean
@@ -11,6 +11,9 @@ import group_theory.group_action.defs
 /-!
 # Lemmas about group actions on big operators
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Note that analogous lemmas for `module`s like `finset.sum_smul` appear in other files.
 -/
 
@@ -19,11 +22,11 @@ variables {α β γ : Type*}
 open_locale big_operators
 
 section
-variables [monoid α] [add_monoid β] [distrib_mul_action α β]
+variables [add_monoid β] [distrib_smul α β]
 
 lemma list.smul_sum {r : α} {l : list β} :
   r • l.sum = (l.map ((•) r)).sum :=
-(distrib_mul_action.to_add_monoid_hom β r).map_list_sum l
+(distrib_smul.to_add_monoid_hom β r).map_list_sum l
 
 end
 
@@ -37,15 +40,15 @@ lemma list.smul_prod {r : α} {l : list β} :
 end
 
 section
-variables [monoid α] [add_comm_monoid β] [distrib_mul_action α β]
+variables [add_comm_monoid β] [distrib_smul α β]
 
 lemma multiset.smul_sum {r : α} {s : multiset β} :
   r • s.sum = (s.map ((•) r)).sum :=
-(distrib_mul_action.to_add_monoid_hom β r).map_multiset_sum s
+(distrib_smul.to_add_monoid_hom β r).map_multiset_sum s
 
 lemma finset.smul_sum {r : α} {f : γ → β} {s : finset γ} :
   r • ∑ x in s, f x = ∑ x in s, r • f x :=
-(distrib_mul_action.to_add_monoid_hom β r).map_sum f s
+(distrib_smul.to_add_monoid_hom β r).map_sum f s
 
 end
 
diff --git a/src/group_theory/group_action/conj_act.lean b/src/group_theory/group_action/conj_act.lean
index a24437af312be..54cf1c4e85312 100644
--- a/src/group_theory/group_action/conj_act.lean
+++ b/src/group_theory/group_action/conj_act.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
 import group_theory.group_action.basic
-import group_theory.subgroup.basic
-import algebra.group_ring_action
+import group_theory.subgroup.zpowers
+import algebra.group_ring_action.basic
 /-!
 # Conjugation action of a group on itself
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the conjugation action of a group on itself. See also `mul_aut.conj` for
 the definition of conjugation as a homomorphism into the automorphism group.
 
@@ -30,7 +33,7 @@ is that some theorems about the group actions will not apply when since this
 
 -/
 
-variables (M G G₀ R K : Type*)
+variables (α M G G₀ R K : Type*)
 
 /-- A type alias for a group `G`. `conj_act G` acts on `G` by conjugation -/
 def conj_act : Type* := G
@@ -62,6 +65,9 @@ def to_conj_act : G ≃* conj_act G := of_conj_act.symm
 /-- A recursor for `conj_act`, for use as `induction x using conj_act.rec` when `x : conj_act G`. -/
 protected def rec {C : conj_act G → Sort*} (h : Π g, C (to_conj_act g)) : Π g, C g := h
 
+@[simp] lemma «forall» (p : conj_act G → Prop) :
+  (∀ (x : conj_act G), p x) ↔ ∀ x : G, p (to_conj_act x) := iff.rfl
+
 @[simp] lemma of_mul_symm_eq : (@of_conj_act G _).symm = to_conj_act := rfl
 @[simp] lemma to_mul_symm_eq : (@to_conj_act G _).symm = of_conj_act := rfl
 @[simp] lemma to_conj_act_of_conj_act (x : conj_act G) : to_conj_act (of_conj_act x) = x := rfl
@@ -75,14 +81,11 @@ protected def rec {C : conj_act G → Sort*} (h : Π g, C (to_conj_act g)) : Π
 @[simp] lemma to_conj_act_mul (x y : G) : to_conj_act (x * y) =
   to_conj_act x * to_conj_act y := rfl
 
-instance : has_scalar (conj_act G) G :=
+instance : has_smul (conj_act G) G :=
 { smul := λ g h, of_conj_act g * h * (of_conj_act g)⁻¹ }
 
 lemma smul_def (g : conj_act G) (h : G) : g • h = of_conj_act g * h * (of_conj_act g)⁻¹ := rfl
 
-@[simp] lemma «forall» (p : conj_act G → Prop) :
-  (∀ (x : conj_act G), p x) ↔ ∀ x : G, p (to_conj_act x) := iff.rfl
-
 end div_inv_monoid
 
 section units
@@ -90,7 +93,7 @@ section units
 section monoid
 variables [monoid M]
 
-instance has_units_scalar : has_scalar (conj_act Mˣ) M :=
+instance has_units_scalar : has_smul (conj_act Mˣ) M :=
 { smul := λ g h, of_conj_act g * h * ↑(of_conj_act g)⁻¹ }
 
 lemma units_smul_def (g : conj_act Mˣ) (h : M) : g • h = of_conj_act g * h * ↑(of_conj_act g)⁻¹ :=
@@ -99,10 +102,18 @@ rfl
 instance units_mul_distrib_mul_action : mul_distrib_mul_action (conj_act Mˣ) M :=
 { smul := (•),
   one_smul := by simp [units_smul_def],
-  mul_smul := by simp [units_smul_def, mul_assoc, mul_inv_rev₀],
+  mul_smul := by simp [units_smul_def, mul_assoc, mul_inv_rev],
   smul_mul := by simp [units_smul_def, mul_assoc],
   smul_one := by simp [units_smul_def], }
 
+instance units_smul_comm_class [has_smul α M] [smul_comm_class α M M] [is_scalar_tower α M M] :
+  smul_comm_class α (conj_act Mˣ) M :=
+{ smul_comm := λ a um m, by rw [units_smul_def, units_smul_def, mul_smul_comm, smul_mul_assoc] }
+
+instance units_smul_comm_class' [has_smul α M] [smul_comm_class M α M] [is_scalar_tower α M M] :
+  smul_comm_class (conj_act Mˣ) α M :=
+by { haveI : smul_comm_class α M M := smul_comm_class.symm _ _ _, exact smul_comm_class.symm _ _ _ }
+
 end monoid
 
 section semiring
@@ -127,7 +138,15 @@ variable [group_with_zero G₀]
 instance mul_action₀ : mul_action (conj_act G₀) G₀ :=
 { smul := (•),
   one_smul := by simp [smul_def],
-  mul_smul := by simp [smul_def, mul_assoc, mul_inv_rev₀] }
+  mul_smul := by simp [smul_def, mul_assoc, mul_inv_rev] }
+
+instance smul_comm_class₀ [has_smul α G₀] [smul_comm_class α G₀ G₀] [is_scalar_tower α G₀ G₀] :
+  smul_comm_class α (conj_act G₀) G₀ :=
+{ smul_comm := λ a ug g, by rw [smul_def, smul_def, mul_smul_comm, smul_mul_assoc] }
+
+instance smul_comm_class₀' [has_smul α G₀] [smul_comm_class G₀ α G₀] [is_scalar_tower α G₀ G₀] :
+  smul_comm_class (conj_act G₀) α G₀ :=
+by { haveI := smul_comm_class.symm G₀ α G₀, exact smul_comm_class.symm _ _ _ }
 
 end group_with_zero
 
@@ -151,6 +170,14 @@ instance : mul_distrib_mul_action (conj_act G) G :=
   one_smul := by simp [smul_def],
   mul_smul := by simp [smul_def, mul_assoc] }
 
+instance smul_comm_class [has_smul α G] [smul_comm_class α G G] [is_scalar_tower α G G] :
+  smul_comm_class α (conj_act G) G :=
+{ smul_comm := λ a ug g, by rw [smul_def, smul_def, mul_smul_comm, smul_mul_assoc] }
+
+instance smul_comm_class' [has_smul α G] [smul_comm_class G α G] [is_scalar_tower α G G] :
+  smul_comm_class (conj_act G) α G :=
+by { haveI := smul_comm_class.symm G α G, exact smul_comm_class.symm _ _ _ }
+
 lemma smul_eq_mul_aut_conj (g : conj_act G) (h : G) : g • h = mul_aut.conj (of_conj_act g) h := rfl
 
 /-- The set of fixed points of the conjugation action of `G` on itself is the center of `G`. -/
@@ -160,10 +187,21 @@ begin
   simp [mem_center_iff, smul_def, mul_inv_eq_iff_eq_mul]
 end
 
+@[simp] lemma mem_orbit_conj_act {g h : G} : g ∈ orbit (conj_act G) h ↔ is_conj g h :=
+by { rw [is_conj_comm, is_conj_iff, mem_orbit_iff], refl }
+
+lemma orbit_rel_conj_act : (orbit_rel (conj_act G) G).rel = is_conj :=
+funext₂ $ λ g h, by rw [orbit_rel_apply, mem_orbit_conj_act]
+
+lemma stabilizer_eq_centralizer (g : G) :
+  stabilizer (conj_act G) g = centralizer (zpowers (to_conj_act g) : set (conj_act G)) :=
+le_antisymm (le_centralizer_iff.mp (zpowers_le.mpr (λ x, mul_inv_eq_iff_eq_mul.mp)))
+  (λ x h, mul_inv_eq_of_eq_mul (h g (mem_zpowers g)).symm)
+
 /-- As normal subgroups are closed under conjugation, they inherit the conjugation action
   of the underlying group. -/
 instance subgroup.conj_action {H : subgroup G} [hH : H.normal] :
-  has_scalar (conj_act G) H :=
+  has_smul (conj_act G) H :=
 ⟨λ g h, ⟨g • h, hH.conj_mem h.1 h.2 (of_conj_act g)⟩⟩
 
 lemma subgroup.coe_conj_smul {H : subgroup G} [hH : H.normal] (g : conj_act G) (h : H) :
diff --git a/src/group_theory/group_action/default.lean b/src/group_theory/group_action/default.lean
deleted file mode 100644
index f64b8ea3262f6..0000000000000
--- a/src/group_theory/group_action/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import group_theory.group_action.basic
diff --git a/src/group_theory/group_action/defs.lean b/src/group_theory/group_action/defs.lean
index 232be4278097b..00aa045ea0f59 100644
--- a/src/group_theory/group_action/defs.lean
+++ b/src/group_theory/group_action/defs.lean
@@ -4,19 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes, Yury Kudryashov
 -/
 import algebra.group.type_tags
+import algebra.group.commute
 import algebra.hom.group
 import algebra.opposites
-import logic.embedding
+import logic.embedding.basic
 
 /-!
 # Definitions of group actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a hierarchy of group action type-classes on top of the previously defined
-notation classes `has_scalar` and its additive version `has_vadd`:
+notation classes `has_smul` and its additive version `has_vadd`:
 
 * `mul_action M α` and its additive version `add_action G P` are typeclasses used for
   actions of multiplicative and additive monoids and groups; they extend notation classes
-  `has_scalar` and `has_vadd` that are defined in `algebra.group.defs`;
+  `has_smul` and `has_vadd` that are defined in `algebra.group.defs`;
 * `distrib_mul_action M A` is a typeclass for an action of a multiplicative monoid on
   an additive monoid such that `a • (b + c) = a • b + a • c` and `a • 0 = 0`.
 
@@ -31,7 +35,7 @@ interaction of different group actions,
 
 ## Notation
 
-- `a • b` is used as notation for `has_scalar.smul a b`.
+- `a • b` is used as notation for `has_smul.smul a b`.
 - `a +ᵥ b` is used as notation for `has_vadd.vadd a b`.
 
 ## Implementation details
@@ -57,20 +61,21 @@ class has_faithful_vadd (G : Type*) (P : Type*) [has_vadd G P] : Prop :=
 (eq_of_vadd_eq_vadd : ∀ {g₁ g₂ : G}, (∀ p : P, g₁ +ᵥ p = g₂ +ᵥ p) → g₁ = g₂)
 
 /-- Typeclass for faithful actions. -/
-@[to_additive has_faithful_vadd]
-class has_faithful_scalar (M : Type*) (α : Type*) [has_scalar M α] : Prop :=
+@[to_additive]
+class has_faithful_smul (M : Type*) (α : Type*) [has_smul M α] : Prop :=
 (eq_of_smul_eq_smul : ∀ {m₁ m₂ : M}, (∀ a : α, m₁ • a = m₂ • a) → m₁ = m₂)
 
-export has_faithful_scalar (eq_of_smul_eq_smul) has_faithful_vadd (eq_of_vadd_eq_vadd)
+export has_faithful_smul (eq_of_smul_eq_smul) has_faithful_vadd (eq_of_vadd_eq_vadd)
 
 @[to_additive]
-lemma smul_left_injective' [has_scalar M α] [has_faithful_scalar M α] :
+lemma smul_left_injective' [has_smul M α] [has_faithful_smul M α] :
   function.injective ((•) : M → α → α) :=
-λ m₁ m₂ h, has_faithful_scalar.eq_of_smul_eq_smul (congr_fun h)
+λ m₁ m₂ h, has_faithful_smul.eq_of_smul_eq_smul (congr_fun h)
 
 /-- See also `monoid.to_mul_action` and `mul_zero_class.to_smul_with_zero`. -/
-@[priority 910, to_additive] -- see Note [lower instance priority]
-instance has_mul.to_has_scalar (α : Type*) [has_mul α] : has_scalar α α := ⟨(*)⟩
+@[priority 910, -- see Note [lower instance priority]
+to_additive "See also `add_monoid.to_add_action`"]
+instance has_mul.to_has_smul (α : Type*) [has_mul α] : has_smul α α := ⟨(*)⟩
 
 @[simp, to_additive] lemma smul_eq_mul (α : Type*) [has_mul α] {a a' : α} : a • a' = a * a' := rfl
 
@@ -81,29 +86,10 @@ instance has_mul.to_has_scalar (α : Type*) [has_mul α] : has_scalar α α := 
 
 /-- Typeclass for multiplicative actions by monoids. This generalizes group actions. -/
 @[ext, protect_proj, to_additive]
-class mul_action (α : Type*) (β : Type*) [monoid α] extends has_scalar α β :=
+class mul_action (α : Type*) (β : Type*) [monoid α] extends has_smul α β :=
 (one_smul : ∀ b : β, (1 : α) • b = b)
 (mul_smul : ∀ (x y : α) (b : β), (x * y) • b = x • y • b)
 
-instance additive.add_action [monoid α] [mul_action α β] : add_action (additive α) β :=
-{ vadd := (•) ∘ additive.to_mul,
-  zero_vadd := mul_action.one_smul,
-  add_vadd := mul_action.mul_smul }
-
-@[simp] lemma additive.of_mul_vadd [monoid α] [mul_action α β] (a : α) (b : β) :
-  additive.of_mul a +ᵥ b = a • b :=
-rfl
-
-instance multiplicative.mul_action [add_monoid α] [add_action α β] :
-  mul_action (multiplicative α) β :=
-{ smul := (+ᵥ) ∘ multiplicative.to_add,
-  one_smul := add_action.zero_vadd,
-  mul_smul := add_action.add_vadd }
-
-@[simp] lemma multiplicative.of_add_smul [add_monoid α] [add_action α β] (a : α) (b : β) :
-  multiplicative.of_add a • b = a +ᵥ b :=
-rfl
-
 /-!
 ### (Pre)transitive action
 
@@ -123,12 +109,12 @@ class add_action.is_pretransitive (M α : Type*) [has_vadd M α] : Prop :=
 
 /-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y`.
   A transitive action should furthermore have `α` nonempty. -/
-@[to_additive] class mul_action.is_pretransitive (M α : Type*) [has_scalar M α] : Prop :=
+@[to_additive] class mul_action.is_pretransitive (M α : Type*) [has_smul M α] : Prop :=
 (exists_smul_eq : ∀ x y : α, ∃ g : M, g • x = y)
 
 namespace mul_action
 
-variables (M) {α} [has_scalar M α] [is_pretransitive M α]
+variables (M) {α} [has_smul M α] [is_pretransitive M α]
 
 @[to_additive] lemma exists_smul_eq (x y : α) : ∃ m : M, m • x = y :=
 is_pretransitive.exists_smul_eq x y
@@ -136,7 +122,8 @@ is_pretransitive.exists_smul_eq x y
 @[to_additive] lemma surjective_smul (x : α) : surjective (λ c : M, c • x) := exists_smul_eq M x
 
 /-- The regular action of a group on itself is transitive. -/
-@[to_additive] instance regular.is_pretransitive [group G] : is_pretransitive G G :=
+@[to_additive "The regular action of a group on itself is transitive."]
+instance regular.is_pretransitive [group G] : is_pretransitive G G :=
 ⟨λ x y, ⟨y * x⁻¹, inv_mul_cancel_right _ _⟩⟩
 
 end mul_action
@@ -150,7 +137,7 @@ class vadd_comm_class (M N α : Type*) [has_vadd M α] [has_vadd N α] : Prop :=
 (vadd_comm : ∀ (m : M) (n : N) (a : α), m +ᵥ (n +ᵥ a) = n +ᵥ (m +ᵥ a))
 
 /-- A typeclass mixin saying that two multiplicative actions on the same space commute. -/
-@[to_additive] class smul_comm_class (M N α : Type*) [has_scalar M α] [has_scalar N α] : Prop :=
+@[to_additive] class smul_comm_class (M N α : Type*) [has_smul M α] [has_smul N α] : Prop :=
 (smul_comm : ∀ (m : M) (n : N) (a : α), m • n • a = n • m • a)
 
 export mul_action (mul_smul) add_action (add_vadd) smul_comm_class (smul_comm)
@@ -176,7 +163,7 @@ library_note "bundled maps over different rings"
 
 /-- Commutativity of actions is a symmetric relation. This lemma can't be an instance because this
 would cause a loop in the instance search graph. -/
-@[to_additive] lemma smul_comm_class.symm (M N α : Type*) [has_scalar M α] [has_scalar N α]
+@[to_additive] lemma smul_comm_class.symm (M N α : Type*) [has_smul M α] [has_smul N α]
   [smul_comm_class M N α] : smul_comm_class N M α :=
 ⟨λ a' a b, (smul_comm a a' b).symm⟩
 
@@ -188,61 +175,77 @@ add_decl_doc vadd_comm_class.symm
   smul_comm_class M M α :=
 ⟨λ a a' b, by rw [← mul_smul, mul_comm, mul_smul]⟩
 
+/-- An instance of `vadd_assoc_class M N α` states that the additive action of `M` on `α` is
+determined by the additive actions of `M` on `N` and `N` on `α`. -/
+class vadd_assoc_class (M N α : Type*) [has_vadd M N] [has_vadd N α] [has_vadd M α] : Prop :=
+(vadd_assoc : ∀ (x : M) (y : N) (z : α), (x +ᵥ y) +ᵥ z = x +ᵥ (y +ᵥ z))
+
 /-- An instance of `is_scalar_tower M N α` states that the multiplicative
 action of `M` on `α` is determined by the multiplicative actions of `M` on `N`
 and `N` on `α`. -/
-class is_scalar_tower (M N α : Type*) [has_scalar M N] [has_scalar N α] [has_scalar M α] : Prop :=
+@[to_additive]
+class is_scalar_tower (M N α : Type*) [has_smul M N] [has_smul N α] [has_smul M α] : Prop :=
 (smul_assoc : ∀ (x : M) (y : N) (z : α), (x • y) • z = x • (y • z))
 
-@[simp] lemma smul_assoc {M N} [has_scalar M N] [has_scalar N α] [has_scalar M α]
+@[simp, to_additive] lemma smul_assoc {M N} [has_smul M N] [has_smul N α] [has_smul M α]
   [is_scalar_tower M N α] (x : M) (y : N) (z : α) :
   (x • y) • z = x • y • z :=
 is_scalar_tower.smul_assoc x y z
 
+@[to_additive]
 instance semigroup.is_scalar_tower [semigroup α] : is_scalar_tower α α α := ⟨mul_assoc⟩
 
+/-- A typeclass indicating that the right (aka `add_opposite`) and left actions by `M` on `α` are
+equal, that is that `M` acts centrally on `α`. This can be thought of as a version of commutativity
+for `+ᵥ`. -/
+class is_central_vadd (M α : Type*) [has_vadd M α] [has_vadd Mᵃᵒᵖ α] : Prop :=
+(op_vadd_eq_vadd : ∀ (m : M) (a : α), add_opposite.op m +ᵥ a = m +ᵥ a)
+
 /-- A typeclass indicating that the right (aka `mul_opposite`) and left actions by `M` on `α` are
 equal, that is that `M` acts centrally on `α`. This can be thought of as a version of commutativity
 for `•`. -/
-class is_central_scalar (M α : Type*) [has_scalar M α] [has_scalar Mᵐᵒᵖ α] : Prop :=
+@[to_additive]
+class is_central_scalar (M α : Type*) [has_smul M α] [has_smul Mᵐᵒᵖ α] : Prop :=
 (op_smul_eq_smul : ∀ (m : M) (a : α), mul_opposite.op m • a = m • a)
 
-lemma is_central_scalar.unop_smul_eq_smul {M α : Type*} [has_scalar M α] [has_scalar Mᵐᵒᵖ α]
+@[to_additive]
+lemma is_central_scalar.unop_smul_eq_smul {M α : Type*} [has_smul M α] [has_smul Mᵐᵒᵖ α]
   [is_central_scalar M α] (m : Mᵐᵒᵖ) (a : α) : (mul_opposite.unop m) • a = m • a :=
 mul_opposite.rec (by exact λ m, (is_central_scalar.op_smul_eq_smul _ _).symm) m
 
+export is_central_vadd (op_vadd_eq_vadd unop_vadd_eq_vadd)
 export is_central_scalar (op_smul_eq_smul unop_smul_eq_smul)
 
 -- these instances are very low priority, as there is usually a faster way to find these instances
 
-@[priority 50]
-instance smul_comm_class.op_left [has_scalar M α] [has_scalar Mᵐᵒᵖ α]
-  [is_central_scalar M α] [has_scalar N α] [smul_comm_class M N α] : smul_comm_class Mᵐᵒᵖ N α :=
+@[priority 50, to_additive]
+instance smul_comm_class.op_left [has_smul M α] [has_smul Mᵐᵒᵖ α]
+  [is_central_scalar M α] [has_smul N α] [smul_comm_class M N α] : smul_comm_class Mᵐᵒᵖ N α :=
 ⟨λ m n a, by rw [←unop_smul_eq_smul m (n • a), ←unop_smul_eq_smul m a, smul_comm]⟩
 
-@[priority 50]
-instance smul_comm_class.op_right [has_scalar M α] [has_scalar N α] [has_scalar Nᵐᵒᵖ α]
+@[priority 50, to_additive]
+instance smul_comm_class.op_right [has_smul M α] [has_smul N α] [has_smul Nᵐᵒᵖ α]
   [is_central_scalar N α] [smul_comm_class M N α] : smul_comm_class M Nᵐᵒᵖ α :=
 ⟨λ m n a, by rw [←unop_smul_eq_smul n (m • a), ←unop_smul_eq_smul n a, smul_comm]⟩
 
-@[priority 50]
+@[priority 50, to_additive]
 instance is_scalar_tower.op_left
-  [has_scalar M α] [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α]
-  [has_scalar M N] [has_scalar Mᵐᵒᵖ N] [is_central_scalar M N]
-  [has_scalar N α] [is_scalar_tower M N α] : is_scalar_tower Mᵐᵒᵖ N α :=
+  [has_smul M α] [has_smul Mᵐᵒᵖ α] [is_central_scalar M α]
+  [has_smul M N] [has_smul Mᵐᵒᵖ N] [is_central_scalar M N]
+  [has_smul N α] [is_scalar_tower M N α] : is_scalar_tower Mᵐᵒᵖ N α :=
 ⟨λ m n a, by rw [←unop_smul_eq_smul m (n • a), ←unop_smul_eq_smul m n, smul_assoc]⟩
 
-@[priority 50]
-instance is_scalar_tower.op_right [has_scalar M α] [has_scalar M N]
-  [has_scalar N α] [has_scalar Nᵐᵒᵖ α] [is_central_scalar N α]
+@[priority 50, to_additive]
+instance is_scalar_tower.op_right [has_smul M α] [has_smul M N]
+  [has_smul N α] [has_smul Nᵐᵒᵖ α] [is_central_scalar N α]
   [is_scalar_tower M N α] : is_scalar_tower M Nᵐᵒᵖ α :=
 ⟨λ m n a, by rw [←unop_smul_eq_smul n a, ←unop_smul_eq_smul (m • n) a, mul_opposite.unop_smul,
                  smul_assoc]⟩
 
-namespace has_scalar
-variables [has_scalar M α]
+namespace has_smul
+variables [has_smul M α]
 
-/-- Auxiliary definition for `has_scalar.comp`, `mul_action.comp_hom`,
+/-- Auxiliary definition for `has_smul.comp`, `mul_action.comp_hom`,
 `distrib_mul_action.comp_hom`, `module.comp_hom`, etc. -/
 @[simp, to_additive  /-" Auxiliary definition for `has_vadd.comp`, `add_action.comp_hom`, etc. "-/]
 def comp.smul (g : N → M) (n : N) (a : α) : α :=
@@ -253,74 +256,84 @@ variables (α)
 /-- An action of `M` on `α` and a function `N → M` induces an action of `N` on `α`.
 
 See note [reducible non-instances]. Since this is reducible, we make sure to go via
-`has_scalar.comp.smul` to prevent typeclass inference unfolding too far. -/
+`has_smul.comp.smul` to prevent typeclass inference unfolding too far. -/
 @[reducible, to_additive /-" An additive action of `M` on `α` and a function `N → M` induces
   an additive action of `N` on `α` "-/]
-def comp (g : N → M) : has_scalar N α :=
-{ smul := has_scalar.comp.smul g }
+def comp (g : N → M) : has_smul N α :=
+{ smul := has_smul.comp.smul g }
 
 variables {α}
 
-/-- Given a tower of scalar actions `M → α → β`, if we use `has_scalar.comp`
+/-- Given a tower of scalar actions `M → α → β`, if we use `has_smul.comp`
 to pull back both of `M`'s actions by a map `g : N → M`, then we obtain a new
 tower of scalar actions `N → α → β`.
 
-This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
+This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
 are still metavariables.
 -/
-@[priority 100]
-lemma comp.is_scalar_tower [has_scalar M β] [has_scalar α β] [is_scalar_tower M α β]
-  (g : N → M) :
+@[priority 100, to_additive "Given a tower of additive actions `M → α → β`, if we use
+`has_smul.comp` to pull back both of `M`'s actions by a map `g : N → M`, then we obtain a new tower
+of scalar actions `N → α → β`.
+
+This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
+are still metavariables."]
+lemma comp.is_scalar_tower [has_smul M β] [has_smul α β] [is_scalar_tower M α β] (g : N → M) :
   (by haveI := comp α g; haveI := comp β g; exact is_scalar_tower N α β) :=
 by exact {smul_assoc := λ n, @smul_assoc _ _ _ _ _ _ _ (g n) }
 
 /--
-This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
+This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
 are still metavariables.
 -/
-@[priority 100]
-lemma comp.smul_comm_class [has_scalar β α] [smul_comm_class M β α] (g : N → M) :
+@[priority 100, to_additive "This cannot be an instance because it can cause infinite loops whenever
+the `has_vadd` arguments are still metavariables."]
+lemma comp.smul_comm_class [has_smul β α] [smul_comm_class M β α] (g : N → M) :
   (by haveI := comp α g; exact smul_comm_class N β α) :=
 by exact {smul_comm := λ n, @smul_comm _ _ _ _ _ _ (g n) }
 
 /--
-This cannot be an instance because it can cause infinite loops whenever the `has_scalar` arguments
+This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
 are still metavariables.
 -/
-@[priority 100]
-lemma comp.smul_comm_class' [has_scalar β α] [smul_comm_class β M α] (g : N → M) :
+@[priority 100, to_additive "This cannot be an instance because it can cause infinite loops whenever
+the `has_vadd` arguments are still metavariables."]
+lemma comp.smul_comm_class' [has_smul β α] [smul_comm_class β M α] (g : N → M) :
   (by haveI := comp α g; exact smul_comm_class β N α) :=
 by exact {smul_comm := λ _ n, @smul_comm _ _ _ _ _ _ _ (g n) }
 
-end has_scalar
+end has_smul
 
 section
 
 /-- Note that the `smul_comm_class α β β` typeclass argument is usually satisfied by `algebra α β`.
 -/
-@[to_additive]
-lemma mul_smul_comm [has_mul β] [has_scalar α β] [smul_comm_class α β β] (s : α) (x y : β) :
+@[to_additive, nolint to_additive_doc]
+lemma mul_smul_comm [has_mul β] [has_smul α β] [smul_comm_class α β β] (s : α) (x y : β) :
   x * (s • y) = s • (x * y) :=
 (smul_comm s x y).symm
 
 /-- Note that the `is_scalar_tower α β β` typeclass argument is usually satisfied by `algebra α β`.
 -/
-lemma smul_mul_assoc [has_mul β] [has_scalar α β] [is_scalar_tower α β β] (r : α) (x y : β)  :
+@[to_additive, nolint to_additive_doc]
+lemma smul_mul_assoc [has_mul β] [has_smul α β] [is_scalar_tower α β β] (r : α) (x y : β)  :
   (r • x) * y = r • (x * y) :=
 smul_assoc r x y
 
-lemma smul_smul_smul_comm [has_scalar α β] [has_scalar α γ] [has_scalar β δ] [has_scalar α δ]
-  [has_scalar γ δ] [is_scalar_tower α β δ] [is_scalar_tower α γ δ] [smul_comm_class β γ δ]
+@[to_additive]
+lemma smul_smul_smul_comm [has_smul α β] [has_smul α γ] [has_smul β δ] [has_smul α δ]
+  [has_smul γ δ] [is_scalar_tower α β δ] [is_scalar_tower α γ δ] [smul_comm_class β γ δ]
   (a : α) (b : β) (c : γ) (d : δ) : (a • b) • (c • d) = (a • c) • b • d :=
 by { rw [smul_assoc, smul_assoc, smul_comm b], apply_instance }
 
-variables [has_scalar M α]
+variables [has_smul M α]
 
+@[to_additive]
 lemma commute.smul_right [has_mul α] [smul_comm_class M α α] [is_scalar_tower M α α]
   {a b : α} (h : commute a b) (r : M) :
   commute a (r • b) :=
 (mul_smul_comm _ _ _).trans ((congr_arg _ h).trans $ (smul_mul_assoc _ _ _).symm)
 
+@[to_additive]
 lemma commute.smul_left [has_mul α] [smul_comm_class M α α] [is_scalar_tower M α α]
   {a b : α} (h : commute a b) (r : M) :
   commute (r • a) b :=
@@ -329,7 +342,7 @@ lemma commute.smul_left [has_mul α] [smul_comm_class M α α] [is_scalar_tower
 end
 
 section ite
-variables [has_scalar M α] (p : Prop) [decidable p]
+variables [has_smul M α] (p : Prop) [decidable p]
 
 @[to_additive] lemma ite_smul (a₁ a₂ : M) (b : α) : (ite p a₁ a₂) • b = ite p (a₁ • b) (a₂ • b) :=
 by split_ifs; refl
@@ -348,12 +361,12 @@ variables [monoid M] [mul_action M α]
 variable (M)
 @[simp, to_additive] theorem one_smul (b : α) : (1 : M) • b = b := mul_action.one_smul _
 
-/-- `has_scalar` version of `one_mul_eq_id` -/
-@[to_additive]
+/-- `has_smul` version of `one_mul_eq_id` -/
+@[to_additive "`has_vadd` version of `zero_add_eq_id`"]
 lemma one_smul_eq_id : ((•) (1 : M) : α → α) = id := funext $ one_smul _
 
-/-- `has_scalar` version of `comp_mul_left` -/
-@[to_additive]
+/-- `has_smul` version of `comp_mul_left` -/
+@[to_additive "`has_vadd` version of `comp_add_left`"]
 lemma comp_smul_left (a₁ a₂ : M) : (•) a₁ ∘ (•) a₂ = ((•) (a₁ * a₂) : α → α) :=
 funext $ λ _, (mul_smul _ _ _).symm
 
@@ -362,7 +375,7 @@ variables {M}
 /-- Pullback a multiplicative action along an injective map respecting `•`.
 See note [reducible non-instances]. -/
 @[reducible, to_additive "Pullback an additive action along an injective map respecting `+ᵥ`."]
-protected def function.injective.mul_action [has_scalar M β] (f : β → α)
+protected def function.injective.mul_action [has_smul M β] (f : β → α)
   (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
   mul_action M β :=
 { smul := (•),
@@ -372,7 +385,7 @@ protected def function.injective.mul_action [has_scalar M β] (f : β → α)
 /-- Pushforward a multiplicative action along a surjective map respecting `•`.
 See note [reducible non-instances]. -/
 @[reducible, to_additive "Pushforward an additive action along a surjective map respecting `+ᵥ`."]
-protected def function.surjective.mul_action [has_scalar M β] (f : α → β) (hf : surjective f)
+protected def function.surjective.mul_action [has_smul M β] (f : α → β) (hf : surjective f)
   (smul : ∀ (c : M) x, f (c • x) = c • f x) :
   mul_action M β :=
 { smul := (•),
@@ -386,7 +399,7 @@ See also `function.surjective.distrib_mul_action_left` and `function.surjective.
 @[reducible, to_additive "Push forward the action of `R` on `M` along a compatible
 surjective map `f : R →+ S`."]
 def function.surjective.mul_action_left {R S M : Type*} [monoid R] [mul_action R M]
-  [monoid S] [has_scalar S M]
+  [monoid S] [has_smul S M]
   (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
   mul_action S M :=
 { smul := (•),
@@ -411,13 +424,14 @@ instance monoid.to_mul_action : mul_action M M :=
 This is promoted to an `add_torsor` by `add_group_is_add_torsor`. -/
 add_decl_doc add_monoid.to_add_action
 
-instance is_scalar_tower.left : is_scalar_tower M M α :=
+@[to_additive] instance is_scalar_tower.left : is_scalar_tower M M α :=
 ⟨λ x y z, mul_smul x y z⟩
 
 variables {M}
 
 /-- Note that the `is_scalar_tower M α α` and `smul_comm_class M α α` typeclass arguments are
 usually satisfied by `algebra M α`. -/
+@[to_additive, nolint to_additive_doc]
 lemma smul_mul_smul [has_mul α] (r s : M) (x y : α)
   [is_scalar_tower M α α] [smul_comm_class M α α] :
   (r • x) * (s • y) = (r * s) • (x * y) :=
@@ -449,7 +463,7 @@ a multiplicative action of `N` on `α`.
 See note [reducible non-instances]. -/
 @[reducible, to_additive] def comp_hom [monoid N] (g : N →* M) :
   mul_action N α :=
-{ smul := has_scalar.comp.smul g,
+{ smul := has_smul.comp.smul g,
   one_smul := by simp [g.map_one, mul_action.one_smul],
   mul_smul := by simp [g.map_mul, mul_action.mul_smul] }
 
@@ -465,69 +479,209 @@ end
 
 section compatible_scalar
 
-@[simp] lemma smul_one_smul {M} (N) [monoid N] [has_scalar M N] [mul_action N α] [has_scalar M α]
-  [is_scalar_tower M N α] (x : M) (y : α) :
+@[simp, to_additive] lemma smul_one_smul {M} (N) [monoid N] [has_smul M N] [mul_action N α]
+  [has_smul M α] [is_scalar_tower M N α] (x : M) (y : α) :
   (x • (1 : N)) • y = x • y :=
 by rw [smul_assoc, one_smul]
 
-@[simp] lemma smul_one_mul {M N} [monoid N] [has_scalar M N] [is_scalar_tower M N N] (x : M)
-  (y : N) : (x • 1) * y = x • y :=
-smul_one_smul N x y
+@[simp, to_additive] lemma smul_one_mul {M N} [mul_one_class N] [has_smul M N]
+  [is_scalar_tower M N N] (x : M) (y : N) : (x • 1) * y = x • y :=
+by rw [smul_mul_assoc, one_mul]
 
 @[simp, to_additive] lemma mul_smul_one
-  {M N} [mul_one_class N] [has_scalar M N] [smul_comm_class M N N] (x : M) (y : N) :
+  {M N} [mul_one_class N] [has_smul M N] [smul_comm_class M N N] (x : M) (y : N) :
   y * (x • 1) = x • y :=
 by rw [← smul_eq_mul, ← smul_comm, smul_eq_mul, mul_one]
 
-lemma is_scalar_tower.of_smul_one_mul {M N} [monoid N] [has_scalar M N]
+@[to_additive]
+lemma is_scalar_tower.of_smul_one_mul {M N} [monoid N] [has_smul M N]
   (h : ∀ (x : M) (y : N), (x • (1 : N)) * y = x • y) :
   is_scalar_tower M N N :=
 ⟨λ x y z, by rw [← h, smul_eq_mul, mul_assoc, h, smul_eq_mul]⟩
 
-@[to_additive] lemma smul_comm_class.of_mul_smul_one {M N} [monoid N] [has_scalar M N]
+@[to_additive] lemma smul_comm_class.of_mul_smul_one {M N} [monoid N] [has_smul M N]
   (H : ∀ (x : M) (y : N), y * (x • (1 : N)) = x • y) : smul_comm_class M N N :=
 ⟨λ x y z, by rw [← H x z, smul_eq_mul, ← H, smul_eq_mul, mul_assoc]⟩
 
+/-- If the multiplicative action of `M` on `N` is compatible with multiplication on `N`, then
+`λ x, x • 1` is a monoid homomorphism from `M` to `N`. -/
+@[to_additive "If the additive action of `M` on `N` is compatible with addition on `N`, then
+`λ x, x +ᵥ 0` is an additive monoid homomorphism from `M` to `N`.", simps]
+def smul_one_hom {M N} [monoid M] [monoid N] [mul_action M N] [is_scalar_tower M N N] :
+  M →* N :=
+{ to_fun := λ x, x • 1,
+  map_one' := one_smul _ _,
+  map_mul' := λ x y, by rw [smul_one_mul, smul_smul] }
+
 end compatible_scalar
 
+/-- Typeclass for scalar multiplication that preserves `0` on the right. -/
+class smul_zero_class (M A : Type*) [has_zero A] extends has_smul M A :=
+(smul_zero : ∀ (a : M), a • (0 : A) = 0)
+
+section smul_zero
+
+variables [has_zero A] [smul_zero_class M A]
+
+@[simp] theorem smul_zero (a : M) : a • (0 : A) = 0 :=
+smul_zero_class.smul_zero _
+
+/-- Pullback a zero-preserving scalar multiplication along an injective zero-preserving map.
+See note [reducible non-instances]. -/
+@[reducible]
+protected def function.injective.smul_zero_class [has_zero B] [has_smul M B] (f : zero_hom B A)
+  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
+  smul_zero_class M B :=
+{ smul := (•),
+  smul_zero := λ c, hf $ by simp only [smul, map_zero, smul_zero] }
+
+/-- Pushforward a zero-preserving scalar multiplication along a zero-preserving map.
+See note [reducible non-instances]. -/
+@[reducible]
+protected def zero_hom.smul_zero_class [has_zero B] [has_smul M B] (f : zero_hom A B)
+  (smul : ∀ (c : M) x, f (c • x) = c • f x) :
+  smul_zero_class M B :=
+{ smul := (•),
+  smul_zero := λ c, by simp only [← map_zero f, ← smul, smul_zero] }
+
+/-- Push forward the multiplication of `R` on `M` along a compatible surjective map `f : R → S`.
+
+See also `function.surjective.distrib_mul_action_left`.
+-/
+@[reducible]
+def function.surjective.smul_zero_class_left {R S M : Type*} [has_zero M] [smul_zero_class R M]
+  [has_smul S M] (f : R → S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
+  smul_zero_class S M :=
+{ smul := (•),
+  smul_zero := hf.forall.mpr $ λ c, by rw [hsmul, smul_zero] }
+
+variable (A)
+
+/-- Compose a `smul_zero_class` with a function, with scalar multiplication `f r' • m`.
+See note [reducible non-instances]. -/
+@[reducible] def smul_zero_class.comp_fun (f : N → M) :
+  smul_zero_class N A :=
+{ smul := has_smul.comp.smul f,
+  smul_zero := λ x, smul_zero (f x) }
+
+/-- Each element of the scalars defines a zero-preserving map. -/
+@[simps]
+def smul_zero_class.to_zero_hom (x : M) : zero_hom A A :=
+{ to_fun := (•) x,
+  map_zero' := smul_zero x }
+
+end smul_zero
+
+/-- Typeclass for scalar multiplication that preserves `0` and `+` on the right.
+
+This is exactly `distrib_mul_action` without the `mul_action` part.
+-/
+@[ext] class distrib_smul (M A : Type*) [add_zero_class A]
+  extends smul_zero_class M A :=
+(smul_add : ∀ (a : M) (x y : A), a • (x + y) = a • x + a • y)
+
+section distrib_smul
+
+variables [add_zero_class A] [distrib_smul M A]
+
+theorem smul_add (a : M) (b₁ b₂ : A) :
+  a • (b₁ + b₂) = a • b₁ + a • b₂ :=
+distrib_smul.smul_add _ _ _
+
+/-- Pullback a distributive scalar multiplication along an injective additive monoid
+homomorphism.
+See note [reducible non-instances]. -/
+@[reducible]
+protected def function.injective.distrib_smul [add_zero_class B] [has_smul M B] (f : B →+ A)
+  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
+  distrib_smul M B :=
+{ smul := (•),
+  smul_add := λ c x y, hf $ by simp only [smul, map_add, smul_add],
+  .. hf.smul_zero_class f.to_zero_hom smul }
+
+/-- Pushforward a distributive scalar multiplication along a surjective additive monoid
+homomorphism.
+See note [reducible non-instances]. -/
+@[reducible]
+protected def function.surjective.distrib_smul [add_zero_class B] [has_smul M B] (f : A →+ B)
+  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
+  distrib_smul M B :=
+{ smul := (•),
+  smul_add := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
+    simp only [smul_add, ← smul, ← map_add] },
+  .. f.to_zero_hom.smul_zero_class smul }
+
+/-- Push forward the multiplication of `R` on `M` along a compatible surjective map `f : R → S`.
+
+See also `function.surjective.distrib_mul_action_left`.
+-/
+@[reducible]
+def function.surjective.distrib_smul_left {R S M : Type*} [add_zero_class M] [distrib_smul R M]
+  [has_smul S M] (f : R → S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
+  distrib_smul S M :=
+{ smul := (•),
+  smul_add := hf.forall.mpr $ λ c x y, by simp only [hsmul, smul_add],
+  .. hf.smul_zero_class_left f hsmul }
+
+variable (A)
+
+/-- Compose a `distrib_smul` with a function, with scalar multiplication `f r' • m`.
+See note [reducible non-instances]. -/
+@[reducible] def distrib_smul.comp_fun (f : N → M) :
+  distrib_smul N A :=
+{ smul := has_smul.comp.smul f,
+  smul_add := λ x, smul_add (f x),
+  .. smul_zero_class.comp_fun A f }
+
+/-- Each element of the scalars defines a additive monoid homomorphism. -/
+@[simps]
+def distrib_smul.to_add_monoid_hom (x : M) : A →+ A :=
+{ to_fun := (•) x,
+  map_add' := smul_add x,
+  .. smul_zero_class.to_zero_hom A x }
+
+end distrib_smul
+
 /-- Typeclass for multiplicative actions on additive structures. This generalizes group modules. -/
-@[ext] class distrib_mul_action (M : Type*) (A : Type*) [monoid M] [add_monoid A]
+@[ext] class distrib_mul_action (M A : Type*) [monoid M] [add_monoid A]
   extends mul_action M A :=
-(smul_add : ∀(r : M) (x y : A), r • (x + y) = r • x + r • y)
-(smul_zero : ∀(r : M), r • (0 : A) = 0)
+(smul_zero : ∀ (a : M), a • (0 : A) = 0)
+(smul_add : ∀ (a : M) (x y : A), a • (x + y) = a • x + a • y)
 
 section
+
 variables [monoid M] [add_monoid A] [distrib_mul_action M A]
 
-theorem smul_add (a : M) (b₁ b₂ : A) : a • (b₁ + b₂) = a • b₁ + a • b₂ :=
-distrib_mul_action.smul_add _ _ _
+@[priority 100] -- See note [lower instance priority]
+instance distrib_mul_action.to_distrib_smul : distrib_smul M A :=
+{ ..‹distrib_mul_action M A› }
 
-@[simp] theorem smul_zero (a : M) : a • (0 : A) = 0 :=
-distrib_mul_action.smul_zero _
+/-! Since Lean 3 does not have definitional eta for structures, we have to make sure
+that the definition of `distrib_mul_action.to_distrib_smul` was done correctly,
+and the two paths from `distrib_mul_action` to `has_smul` are indeed definitionally equal. -/
+example : (distrib_mul_action.to_mul_action.to_has_smul : has_smul M A) =
+  distrib_mul_action.to_distrib_smul.to_has_smul := rfl
 
 /-- Pullback a distributive multiplicative action along an injective additive monoid
 homomorphism.
 See note [reducible non-instances]. -/
 @[reducible]
-protected def function.injective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : B →+ A)
+protected def function.injective.distrib_mul_action [add_monoid B] [has_smul M B] (f : B →+ A)
   (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
   distrib_mul_action M B :=
 { smul := (•),
-  smul_add := λ c x y, hf $ by simp only [smul, f.map_add, smul_add],
-  smul_zero := λ c, hf $ by simp only [smul, f.map_zero, smul_zero],
+  .. hf.distrib_smul f smul,
   .. hf.mul_action f smul }
 
 /-- Pushforward a distributive multiplicative action along a surjective additive monoid
 homomorphism.
 See note [reducible non-instances]. -/
 @[reducible]
-protected def function.surjective.distrib_mul_action [add_monoid B] [has_scalar M B] (f : A →+ B)
+protected def function.surjective.distrib_mul_action [add_monoid B] [has_smul M B] (f : A →+ B)
   (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
   distrib_mul_action M B :=
 { smul := (•),
-  smul_add := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
-    simp only [smul_add, ← smul, ← f.map_add] },
-  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero],
+  .. hf.distrib_smul f smul,
   .. hf.mul_action f smul }
 
 /-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.
@@ -536,12 +690,11 @@ See also `function.surjective.mul_action_left` and `function.surjective.module_l
 -/
 @[reducible]
 def function.surjective.distrib_mul_action_left {R S M : Type*} [monoid R] [add_monoid M]
-  [distrib_mul_action R M] [monoid S] [has_scalar S M]
+  [distrib_mul_action R M] [monoid S] [has_smul S M]
   (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
   distrib_mul_action S M :=
 { smul := (•),
-  smul_zero := hf.forall.mpr $ λ c, by rw [hsmul, smul_zero],
-  smul_add := hf.forall.mpr $ λ c x y, by simp only [hsmul, smul_add],
+  .. hf.distrib_smul_left f hsmul,
   .. hf.mul_action_left f hsmul }
 
 variable (A)
@@ -550,17 +703,14 @@ variable (A)
 See note [reducible non-instances]. -/
 @[reducible] def distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
   distrib_mul_action N A :=
-{ smul := has_scalar.comp.smul f,
-  smul_zero := λ x, smul_zero (f x),
-  smul_add := λ x, smul_add (f x),
+{ smul := has_smul.comp.smul f,
+  .. distrib_smul.comp_fun A f,
   .. mul_action.comp_hom A f }
 
 /-- Each element of the monoid defines a additive monoid homomorphism. -/
 @[simps]
 def distrib_mul_action.to_add_monoid_hom (x : M) : A →+ A :=
-{ to_fun := (•) x,
-  map_zero' := smul_zero x,
-  map_add' := smul_add x }
+distrib_smul.to_add_monoid_hom A x
 
 variables (M)
 
@@ -591,7 +741,7 @@ instance add_group.int_smul_comm_class' : smul_comm_class M ℤ A :=
 smul_comm_class.symm _ _ _
 
 @[simp] theorem smul_neg (r : M) (x : A) : r • (-x) = -(r • x) :=
-eq_neg_of_add_eq_zero $ by rw [← smul_add, neg_add_self, smul_zero]
+eq_neg_of_add_eq_zero_left $ by rw [← smul_add, neg_add_self, smul_zero]
 
 theorem smul_sub (r : M) (x y : A) : r • (x - y) = r • x - r • y :=
 by rw [sub_eq_add_neg, sub_eq_add_neg, smul_add, smul_neg]
@@ -617,7 +767,7 @@ mul_distrib_mul_action.smul_mul _ _ _
 homomorphism.
 See note [reducible non-instances]. -/
 @[reducible]
-protected def function.injective.mul_distrib_mul_action [monoid B] [has_scalar M B] (f : B →* A)
+protected def function.injective.mul_distrib_mul_action [monoid B] [has_smul M B] (f : B →* A)
   (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
   mul_distrib_mul_action M B :=
 { smul := (•),
@@ -629,7 +779,7 @@ protected def function.injective.mul_distrib_mul_action [monoid B] [has_scalar M
 homomorphism.
 See note [reducible non-instances]. -/
 @[reducible]
-protected def function.surjective.mul_distrib_mul_action [monoid B] [has_scalar M B] (f : A →* B)
+protected def function.surjective.mul_distrib_mul_action [monoid B] [has_smul M B] (f : A →* B)
   (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
   mul_distrib_mul_action M B :=
 { smul := (•),
@@ -644,7 +794,7 @@ variable (A)
 See note [reducible non-instances]. -/
 @[reducible] def mul_distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
   mul_distrib_mul_action N A :=
-{ smul := has_scalar.comp.smul f,
+{ smul := has_smul.comp.smul f,
   smul_one := λ x, smul_one (f x),
   smul_mul := λ x, smul_mul' (f x),
   .. mul_action.comp_hom A f }
@@ -678,7 +828,7 @@ variables [monoid M] [group A] [mul_distrib_mul_action M A]
 (mul_distrib_mul_action.to_monoid_hom A r).map_inv x
 
 theorem smul_div' (r : M) (x y : A) : r • (x / y) = (r • x) / (r • y) :=
-(mul_distrib_mul_action.to_monoid_hom A r).map_div x y
+map_div (mul_distrib_mul_action.to_monoid_hom A r) x y
 
 end
 
@@ -721,7 +871,7 @@ instance function.End.apply_mul_action : mul_action (function.End α) α :=
 @[simp] lemma function.End.smul_def (f : function.End α) (a : α) : f • a = f a := rfl
 
 /-- `function.End.apply_mul_action` is faithful. -/
-instance function.End.apply_has_faithful_scalar : has_faithful_scalar (function.End α) α :=
+instance function.End.apply_has_faithful_smul : has_faithful_smul (function.End α) α :=
 ⟨λ x y, funext⟩
 
 /-- The tautological action by `add_monoid.End α` on `α`.
@@ -739,8 +889,8 @@ instance add_monoid.End.apply_distrib_mul_action [add_monoid α] :
   f • a = f a := rfl
 
 /-- `add_monoid.End.apply_distrib_mul_action` is faithful. -/
-instance add_monoid.End.apply_has_faithful_scalar [add_monoid α] :
-  has_faithful_scalar (add_monoid.End α) α :=
+instance add_monoid.End.apply_has_faithful_smul [add_monoid α] :
+  has_faithful_smul (add_monoid.End α) α :=
 ⟨add_monoid_hom.ext⟩
 
 /-- The monoid hom representing a monoid action.
@@ -778,3 +928,45 @@ See note [reducible non-instances]. -/
 @[reducible]
 def add_action.of_End_hom [add_monoid M] (f : M →+ additive (function.End α)) : add_action M α :=
 add_action.comp_hom α f
+
+/-! ### `additive`, `multiplicative` -/
+
+section
+
+open additive multiplicative
+
+instance additive.has_vadd [has_smul α β] : has_vadd (additive α) β := ⟨λ a, (•) (to_mul a)⟩
+instance multiplicative.has_smul [has_vadd α β] : has_smul (multiplicative α) β :=
+⟨λ a, (+ᵥ) (to_add a)⟩
+
+@[simp] lemma to_mul_smul [has_smul α β] (a) (b : β) : (to_mul a : α) • b = a +ᵥ b := rfl
+@[simp] lemma of_mul_vadd [has_smul α β] (a : α) (b : β) : of_mul a +ᵥ b = a • b := rfl
+@[simp] lemma to_add_vadd [has_vadd α β] (a) (b : β) : (to_add a : α) +ᵥ b = a • b := rfl
+@[simp] lemma of_add_smul [has_vadd α β] (a : α) (b : β) : of_add a • b = a +ᵥ b := rfl
+
+instance additive.add_action [monoid α] [mul_action α β] : add_action (additive α) β :=
+{ zero_vadd := mul_action.one_smul,
+  add_vadd := mul_action.mul_smul }
+
+instance multiplicative.mul_action [add_monoid α] [add_action α β] :
+  mul_action (multiplicative α) β :=
+{ one_smul := add_action.zero_vadd,
+  mul_smul := add_action.add_vadd }
+
+instance additive.add_action_is_pretransitive [monoid α] [mul_action α β]
+  [mul_action.is_pretransitive α β] : add_action.is_pretransitive (additive α) β :=
+⟨@mul_action.exists_smul_eq α _ _ _⟩
+
+instance multiplicative.add_action_is_pretransitive [add_monoid α] [add_action α β]
+  [add_action.is_pretransitive α β] : mul_action.is_pretransitive (multiplicative α) β :=
+⟨@add_action.exists_vadd_eq α _ _ _⟩
+
+instance additive.vadd_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  vadd_comm_class (additive α) (additive β) γ :=
+⟨@smul_comm α β _ _ _ _⟩
+
+instance multiplicative.smul_comm_class [has_vadd α γ] [has_vadd β γ] [vadd_comm_class α β γ] :
+  smul_comm_class (multiplicative α) (multiplicative β) γ :=
+⟨@vadd_comm α β _ _ _ _⟩
+
+end
diff --git a/src/group_theory/group_action/embedding.lean b/src/group_theory/group_action/embedding.lean
index 25553f746f4f8..459fc50b60e86 100644
--- a/src/group_theory/group_action/embedding.lean
+++ b/src/group_theory/group_action/embedding.lean
@@ -9,6 +9,9 @@ import group_theory.group_action.pi
 /-!
 # Group actions on embeddings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides a `mul_action G (α ↪ β)` instance that agrees with the `mul_action G (α → β)`
 instances defined by `pi.mul_action`.
 
@@ -21,7 +24,7 @@ variables {G G' α β : Type*}
 namespace function.embedding
 
 @[to_additive function.embedding.has_vadd]
-instance [group G] [mul_action G β] : has_scalar G (α ↪ β) :=
+instance [group G] [mul_action G β] : has_smul G (α ↪ β) :=
 ⟨λ g f, f.trans (mul_action.to_perm g).to_embedding⟩
 
 @[to_additive]
@@ -33,7 +36,7 @@ rfl
 @[to_additive]
 lemma coe_smul [group G] [mul_action G β] (g : G) (f : α ↪ β) : ⇑(g • f) = g • f := rfl
 
-instance [group G] [group G'] [has_scalar G G'] [mul_action G β] [mul_action G' β]
+instance [group G] [group G'] [has_smul G G'] [mul_action G β] [mul_action G' β]
   [is_scalar_tower G G' β] : is_scalar_tower G G' (α ↪ β) :=
 ⟨λ x y z, function.embedding.ext $ λ i, smul_assoc x y (z i)⟩
 
diff --git a/src/group_theory/group_action/fixing_subgroup.lean b/src/group_theory/group_action/fixing_subgroup.lean
index e280128e15198..3f60d952629ee 100644
--- a/src/group_theory/group_action/fixing_subgroup.lean
+++ b/src/group_theory/group_action/fixing_subgroup.lean
@@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Antoine Chambert-Loir
 -/
 
-import group_theory.subgroup.basic
+import group_theory.subgroup.actions
 import group_theory.group_action.basic
-import order.order_dual
 
 /-!
 
 # Fixing submonoid, fixing subgroup of an action
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In the presence of of an action of a monoid or a group,
 this file defines the fixing submonoid or the fixing subgroup,
 and relates it to the set of fixed points via a Galois connection.
diff --git a/src/group_theory/group_action/group.lean b/src/group_theory/group_action/group.lean
index a7535049889a5..be6086db460c1 100644
--- a/src/group_theory/group_action/group.lean
+++ b/src/group_theory/group_action/group.lean
@@ -9,9 +9,14 @@ import group_theory.group_action.units
 /-!
 # Group actions applied to various types of group
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains lemmas about `smul` on `group_with_zero`, and `group`.
 -/
 
+open function
+
 universes u v w
 variables {α : Type u} {β : Type v} {γ : Type w}
 
@@ -19,8 +24,8 @@ section mul_action
 
 /-- `monoid.to_mul_action` is faithful on cancellative monoids. -/
 @[to_additive /-" `add_monoid.to_add_action` is faithful on additive cancellative monoids. "-/]
-instance right_cancel_monoid.to_has_faithful_scalar [right_cancel_monoid α] :
-  has_faithful_scalar α α :=
+instance right_cancel_monoid.to_has_faithful_smul [right_cancel_monoid α] :
+  has_faithful_smul α α :=
 ⟨λ x y h, mul_right_cancel (h 1)⟩
 
 section group
@@ -40,7 +45,8 @@ by rw [smul_smul, mul_right_inv, one_smul]
 add_decl_doc add_action.to_perm
 
 /-- `mul_action.to_perm` is injective on faithful actions. -/
-@[to_additive] lemma mul_action.to_perm_injective [has_faithful_scalar α β] :
+@[to_additive "`add_action.to_perm` is injective on faithful actions."]
+lemma mul_action.to_perm_injective [has_faithful_smul α β] :
   function.injective (mul_action.to_perm : α → equiv.perm β) :=
 (show function.injective (equiv.to_fun ∘ mul_action.to_perm), from smul_left_injective').of_comp
 
@@ -74,7 +80,7 @@ instance equiv.perm.apply_mul_action (α : Type*) : mul_action (equiv.perm α) 
 rfl
 
 /-- `equiv.perm.apply_mul_action` is faithful. -/
-instance equiv.perm.apply_has_faithful_scalar (α : Type*) : has_faithful_scalar (equiv.perm α) α :=
+instance equiv.perm.apply_has_faithful_smul (α : Type*) : has_faithful_smul (equiv.perm α) α :=
 ⟨λ x y, equiv.ext⟩
 
 variables {α} {β}
@@ -104,12 +110,15 @@ by { cases p; simp [smul_pow, smul_inv] }
   commute (r • a) b ↔ commute a b :=
 by rw [commute.symm_iff, commute.smul_right_iff, commute.symm_iff]
 
-@[to_additive] protected lemma mul_action.bijective (g : α) : function.bijective (λ b : β, g • b) :=
+@[to_additive] protected lemma mul_action.bijective (g : α) : bijective ((•) g : β → β) :=
 (mul_action.to_perm g).bijective
 
-@[to_additive] protected lemma mul_action.injective (g : α) : function.injective (λ b : β, g • b) :=
+@[to_additive] protected lemma mul_action.injective (g : α) : injective ((•) g : β → β) :=
 (mul_action.bijective g).injective
 
+@[to_additive] protected lemma mul_action.surjective (g : α) : surjective ((•) g : β → β) :=
+(mul_action.bijective g).surjective
+
 @[to_additive] lemma smul_left_cancel (g : α) {x y : β} (h : g • x = g • y) : x = y :=
 mul_action.injective g h
 
@@ -123,12 +132,12 @@ mul_action.injective g h
 end group
 
 /-- `monoid.to_mul_action` is faithful on nontrivial cancellative monoids with zero. -/
-instance cancel_monoid_with_zero.to_has_faithful_scalar [cancel_monoid_with_zero α] [nontrivial α] :
-  has_faithful_scalar α α :=
+instance cancel_monoid_with_zero.to_has_faithful_smul [cancel_monoid_with_zero α] [nontrivial α] :
+  has_faithful_smul α α :=
 ⟨λ x y h, mul_left_injective₀ one_ne_zero (h 1)⟩
 
 section gwz
-variables [group_with_zero α] [mul_action α β]
+variables [group_with_zero α] [mul_action α β] {a : α}
 
 @[simp]
 lemma inv_smul_smul₀ {c : α} (hc : c ≠ 0) (x : β) : c⁻¹ • c • x = x :=
@@ -154,6 +163,15 @@ commute.smul_right_iff (units.mk0 c hc)
   commute (c • a) b ↔ commute a b :=
 commute.smul_left_iff (units.mk0 c hc)
 
+protected lemma mul_action.bijective₀ (ha : a ≠ 0) : bijective ((•) a : β → β) :=
+mul_action.bijective $ units.mk0 a ha
+
+protected lemma mul_action.injective₀ (ha : a ≠ 0) : injective ((•) a : β → β) :=
+(mul_action.bijective₀ ha).injective
+
+protected lemma mul_action.surjective₀ (ha : a ≠ 0) : surjective ((•) a : β → β) :=
+(mul_action.bijective₀ ha).surjective
+
 end gwz
 
 end mul_action
@@ -173,6 +191,17 @@ def distrib_mul_action.to_add_equiv (x : α) : β ≃+ β :=
 { .. distrib_mul_action.to_add_monoid_hom β x,
   .. mul_action.to_perm_hom α β x }
 
+/-- Each non-zero element of a `group_with_zero` defines an additive monoid isomorphism of an
+`add_monoid` on which it acts distributively.
+
+This is a stronger version of `distrib_mul_action.to_add_monoid_hom`. -/
+def distrib_mul_action.to_add_equiv₀ {α : Type*} (β : Type*) [group_with_zero α] [add_monoid β]
+  [distrib_mul_action α β] (x : α) (hx : x ≠ 0) : β ≃+ β :=
+{ inv_fun := λ b, x⁻¹ • b,
+  left_inv := inv_smul_smul₀ hx,
+  right_inv := smul_inv_smul₀ hx,
+  .. distrib_mul_action.to_add_monoid_hom β x, }
+
 variables (α β)
 
 /-- Each element of the group defines an additive monoid isomorphism.
@@ -198,10 +227,10 @@ section gwz
 variables [group_with_zero α] [add_monoid β] [distrib_mul_action α β]
 
 theorem smul_eq_zero_iff_eq' {a : α} (ha : a ≠ 0) {x : β} : a • x = 0 ↔ x = 0 :=
-smul_eq_zero_iff_eq (units.mk0 a ha)
+show units.mk0 a ha • x = 0 ↔ x = 0, from smul_eq_zero_iff_eq _
 
 theorem smul_ne_zero_iff_ne' {a : α} (ha : a ≠ 0) {x : β} : a • x ≠ 0 ↔ x ≠ 0 :=
-smul_ne_zero_iff_ne (units.mk0 a ha)
+show units.mk0 a ha • x ≠ 0 ↔ x ≠ 0, from smul_ne_zero_iff_ne _
 
 end gwz
 
@@ -238,9 +267,11 @@ end mul_distrib_mul_action
 section arrow
 
 /-- If `G` acts on `A`, then it acts also on `A → B`, by `(g • F) a = F (g⁻¹ • a)`. -/
-@[simps] def arrow_action {G A B : Type*} [group G] [mul_action G A] : mul_action G (A → B) :=
+@[to_additive arrow_add_action "If `G` acts on `A`, then it acts also on `A → B`, by
+`(g +ᵥ F) a = F (g⁻¹ +ᵥ a)`", simps]
+def arrow_action {G A B : Type*} [division_monoid G] [mul_action G A] : mul_action G (A → B) :=
 { smul := λ g F a, F (g⁻¹ • a),
-  one_smul := by { intro, simp only [one_inv, one_smul] },
+  one_smul := by { intro, simp only [inv_one, one_smul] },
   mul_smul := by { intros, simp only [mul_smul, mul_inv_rev] } }
 
 local attribute [instance] arrow_action
@@ -276,7 +307,7 @@ variables [monoid α] [add_monoid β] [distrib_mul_action α β]
 
 @[simp] theorem smul_eq_zero {u : α} (hu : is_unit u) {x : β} :
   u • x = 0 ↔ x = 0 :=
-exists.elim hu $ λ u hu, hu ▸ smul_eq_zero_iff_eq u
+exists.elim hu $ λ u hu, hu ▸ show u • x = 0 ↔ x = 0, from smul_eq_zero_iff_eq u
 
 end distrib_mul_action
 
diff --git a/src/group_theory/group_action/opposite.lean b/src/group_theory/group_action/opposite.lean
index 10bdc5494a0fd..6d3b9d2174b6e 100644
--- a/src/group_theory/group_action/opposite.lean
+++ b/src/group_theory/group_action/opposite.lean
@@ -9,10 +9,13 @@ import group_theory.group_action.defs
 /-!
 # Scalar actions on and by `Mᵐᵒᵖ`
 
-This file defines the actions on the opposite type `has_scalar R Mᵐᵒᵖ`, and actions by the opposite
-type, `has_scalar Rᵐᵒᵖ M`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-Note that `mul_opposite.has_scalar` is provided in an earlier file as it is needed to provide the
+This file defines the actions on the opposite type `has_smul R Mᵐᵒᵖ`, and actions by the opposite
+type, `has_smul Rᵐᵒᵖ M`.
+
+Note that `mul_opposite.has_smul` is provided in an earlier file as it is needed to provide the
 `add_monoid.nsmul` and `add_comm_group.gsmul` fields.
 -/
 
@@ -28,7 +31,7 @@ namespace mul_opposite
 @[to_additive] instance (R : Type*) [monoid R] [mul_action R α] : mul_action R αᵐᵒᵖ :=
 { one_smul := λ x, unop_injective $ one_smul R (unop x),
   mul_smul := λ r₁ r₂ x, unop_injective $ mul_smul r₁ r₂ (unop x),
-  .. mul_opposite.has_scalar α R }
+  .. mul_opposite.has_smul α R }
 
 instance (R : Type*) [monoid R] [add_monoid α] [distrib_mul_action R α] :
   distrib_mul_action R αᵐᵒᵖ :=
@@ -42,23 +45,24 @@ instance (R : Type*) [monoid R] [monoid α] [mul_distrib_mul_action R α] :
   smul_one := λ r, unop_injective $ smul_one r,
   .. mul_opposite.mul_action α R }
 
-instance {M N} [has_scalar M N] [has_scalar M α] [has_scalar N α] [is_scalar_tower M N α] :
+@[to_additive]
+instance {M N} [has_smul M N] [has_smul M α] [has_smul N α] [is_scalar_tower M N α] :
   is_scalar_tower M N αᵐᵒᵖ :=
 ⟨λ x y z, unop_injective $ smul_assoc _ _ _⟩
 
-@[to_additive] instance {M N} [has_scalar M α] [has_scalar N α] [smul_comm_class M N α] :
+@[to_additive] instance {M N} [has_smul M α] [has_smul N α] [smul_comm_class M N α] :
   smul_comm_class M N αᵐᵒᵖ :=
 ⟨λ x y z, unop_injective $ smul_comm _ _ _⟩
 
-instance (R : Type*) [has_scalar R α] [has_scalar Rᵐᵒᵖ α] [is_central_scalar R α] :
+@[to_additive] instance (R : Type*) [has_smul R α] [has_smul Rᵐᵒᵖ α] [is_central_scalar R α] :
   is_central_scalar R αᵐᵒᵖ :=
 ⟨λ r m, unop_injective $ op_smul_eq_smul _ _⟩
 
-lemma op_smul_eq_op_smul_op {R : Type*} [has_scalar R α] [has_scalar Rᵐᵒᵖ α] [is_central_scalar R α]
+lemma op_smul_eq_op_smul_op {R : Type*} [has_smul R α] [has_smul Rᵐᵒᵖ α] [is_central_scalar R α]
   (r : R) (a : α) : op (r • a) = op r • op a :=
 (op_smul_eq_smul r (op a)).symm
 
-lemma unop_smul_eq_unop_smul_unop {R : Type*} [has_scalar R α] [has_scalar Rᵐᵒᵖ α]
+lemma unop_smul_eq_unop_smul_unop {R : Type*} [has_smul R α] [has_smul Rᵐᵒᵖ α]
   [is_central_scalar R α] (r : Rᵐᵒᵖ) (a : αᵐᵒᵖ) : unop (r • a) = unop r • unop a :=
 (unop_smul_eq_smul r (unop a)).symm
 
@@ -66,18 +70,20 @@ end mul_opposite
 
 /-! ### Actions _by_ the opposite type (right actions)
 
-In `has_mul.to_has_scalar` in another file, we define the left action `a₁ • a₂ = a₁ * a₂`. For the
+In `has_mul.to_has_smul` in another file, we define the left action `a₁ • a₂ = a₁ * a₂`. For the
 multiplicative opposite, we define `mul_opposite.op a₁ • a₂ = a₂ * a₁`, with the multiplication
 reversed.
 -/
 
 open mul_opposite
 
-/-- Like `has_mul.to_has_scalar`, but multiplies on the right.
+/-- Like `has_mul.to_has_smul`, but multiplies on the right.
 
 See also `monoid.to_opposite_mul_action` and `monoid_with_zero.to_opposite_mul_action_with_zero`. -/
-@[to_additive] instance has_mul.to_has_opposite_scalar [has_mul α] : has_scalar αᵐᵒᵖ α :=
-{ smul := λ c x, x * c.unop }
+@[to_additive "Like `has_add.to_has_vadd`, but adds on the right.
+
+See also `add_monoid.to_opposite_add_action`."]
+instance has_mul.to_has_opposite_smul [has_mul α] : has_smul αᵐᵒᵖ α := ⟨λ c x, x * c.unop⟩
 
 @[to_additive] lemma op_smul_eq_mul [has_mul α] {a a' : α} : op a • a' = a' * a := rfl
 
@@ -98,22 +104,24 @@ instance mul_action.opposite_regular.is_pretransitive {G : Type*} [group G] :
   smul_comm_class α αᵐᵒᵖ α :=
 smul_comm_class.symm _ _ _
 
+@[to_additive]
 instance comm_semigroup.is_central_scalar [comm_semigroup α] : is_central_scalar α α :=
 ⟨λ r m, mul_comm _ _⟩
 
 /-- Like `monoid.to_mul_action`, but multiplies on the right. -/
-@[to_additive] instance monoid.to_opposite_mul_action [monoid α] : mul_action αᵐᵒᵖ α :=
+@[to_additive "Like `add_monoid.to_add_action`, but adds on the right."]
+instance monoid.to_opposite_mul_action [monoid α] : mul_action αᵐᵒᵖ α :=
 { smul := (•),
   one_smul := mul_one,
   mul_smul := λ x y r, (mul_assoc _ _ _).symm }
 
-instance is_scalar_tower.opposite_mid {M N} [has_mul N] [has_scalar M N]
-  [smul_comm_class M N N] :
+@[to_additive]
+instance is_scalar_tower.opposite_mid {M N} [has_mul N] [has_smul M N] [smul_comm_class M N N] :
   is_scalar_tower M Nᵐᵒᵖ N :=
 ⟨λ x y z, mul_smul_comm _ _ _⟩
 
-instance smul_comm_class.opposite_mid {M N} [has_mul N] [has_scalar M N]
-  [is_scalar_tower M N N] :
+@[to_additive]
+instance smul_comm_class.opposite_mid {M N} [has_mul N] [has_smul M N] [is_scalar_tower M N N] :
   smul_comm_class M Nᵐᵒᵖ N :=
 ⟨λ x y z, by { induction y using mul_opposite.rec, simp [smul_mul_assoc] }⟩
 
@@ -122,11 +130,12 @@ instance smul_comm_class.opposite_mid {M N} [has_mul N] [has_scalar M N]
 example [monoid α] : monoid.to_mul_action αᵐᵒᵖ = mul_opposite.mul_action α αᵐᵒᵖ := rfl
 
 /-- `monoid.to_opposite_mul_action` is faithful on cancellative monoids. -/
-@[to_additive] instance left_cancel_monoid.to_has_faithful_opposite_scalar [left_cancel_monoid α] :
-  has_faithful_scalar αᵐᵒᵖ α :=
+@[to_additive "`add_monoid.to_opposite_add_action` is faithful on cancellative monoids."]
+instance left_cancel_monoid.to_has_faithful_opposite_scalar [left_cancel_monoid α] :
+  has_faithful_smul αᵐᵒᵖ α :=
 ⟨λ x y h, unop_injective $ mul_left_cancel (h 1)⟩
 
 /-- `monoid.to_opposite_mul_action` is faithful on nontrivial cancellative monoids with zero. -/
 instance cancel_monoid_with_zero.to_has_faithful_opposite_scalar
-  [cancel_monoid_with_zero α] [nontrivial α] : has_faithful_scalar αᵐᵒᵖ α :=
+  [cancel_monoid_with_zero α] [nontrivial α] : has_faithful_smul αᵐᵒᵖ α :=
 ⟨λ x y h, unop_injective $ mul_left_cancel₀ one_ne_zero (h 1)⟩
diff --git a/src/group_theory/group_action/option.lean b/src/group_theory/group_action/option.lean
new file mode 100644
index 0000000000000..9afd75f5ee9cc
--- /dev/null
+++ b/src/group_theory/group_action/option.lean
@@ -0,0 +1,58 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import group_theory.group_action.defs
+
+/-!
+# Option instances for additive and multiplicative actions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines instances for additive and multiplicative actions on `option` type. Scalar
+multiplication is defined by `a • some b = some (a • b)` and `a • none = none`.
+
+## See also
+
+* `group_theory.group_action.pi`
+* `group_theory.group_action.prod`
+* `group_theory.group_action.sigma`
+* `group_theory.group_action.sum`
+-/
+
+variables {M N α : Type*}
+
+namespace option
+
+section has_smul
+variables [has_smul M α] [has_smul N α] (a : M) (b : α) (x : option α)
+
+@[to_additive option.has_vadd] instance : has_smul M (option α) := ⟨λ a, option.map $ (•) a⟩
+
+@[to_additive] lemma smul_def : a • x = x.map ((•) a) := rfl
+@[simp, to_additive] lemma smul_none : a • (none : option α) = none := rfl
+@[simp, to_additive] lemma smul_some : a • some b = some (a • b) := rfl
+
+@[to_additive] instance [has_smul M N] [is_scalar_tower M N α] : is_scalar_tower M N (option α) :=
+⟨λ a b x, by { cases x, exacts [rfl, congr_arg some (smul_assoc _ _ _)] }⟩
+
+@[to_additive] instance [smul_comm_class M N α] : smul_comm_class M N (option α) :=
+⟨λ a b, function.commute.option_map $ smul_comm _ _⟩
+
+@[to_additive]
+instance [has_smul Mᵐᵒᵖ α] [is_central_scalar M α] : is_central_scalar M (option α) :=
+⟨λ a x, by { cases x, exacts [rfl, congr_arg some (op_smul_eq_smul _ _)] }⟩
+
+@[to_additive] instance [has_faithful_smul M α] : has_faithful_smul M (option α) :=
+⟨λ x y h, eq_of_smul_eq_smul $ λ b : α, by injection h (some b)⟩
+
+end has_smul
+
+instance [monoid M] [mul_action M α] : mul_action M (option α) :=
+{ smul := (•),
+  one_smul := λ b, by { cases b, exacts [rfl, congr_arg some (one_smul _ _)] },
+  mul_smul := λ a₁ a₂ b, by { cases b, exacts [rfl, congr_arg some (mul_smul _ _ _)] } }
+
+end option
diff --git a/src/group_theory/group_action/pi.lean b/src/group_theory/group_action/pi.lean
index 5c897d4f82343..f0cf07e8d94d5 100644
--- a/src/group_theory/group_action/pi.lean
+++ b/src/group_theory/group_action/pi.lean
@@ -9,7 +9,17 @@ import group_theory.group_action.defs
 /-!
 # Pi instances for multiplicative actions
 
-This file defines instances for mul_action and related structures on Pi Types
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines instances for mul_action and related structures on Pi types.
+
+## See also
+
+* `group_theory.group_action.option`
+* `group_theory.group_action.prod`
+* `group_theory.group_action.sigma`
+* `group_theory.group_action.sum`
 -/
 
 universes u v w
@@ -19,68 +29,64 @@ variables (x y : Π i, f i) (i : I)
 
 namespace pi
 
-@[to_additive pi.has_vadd]
-instance has_scalar {α : Type*} [Π i, has_scalar α $ f i] :
-  has_scalar α (Π i : I, f i) :=
-⟨λ s x, λ i, s • (x i)⟩
-
-@[to_additive]
-lemma smul_def {α : Type*} [Π i, has_scalar α $ f i] (s : α) : s • x = λ i, s • x i := rfl
-@[simp, to_additive]
-lemma smul_apply {α : Type*} [Π i, has_scalar α $ f i] (s : α) : (s • x) i = s • x i := rfl
-
 @[to_additive pi.has_vadd']
-instance has_scalar' {g : I → Type*} [Π i, has_scalar (f i) (g i)] :
-  has_scalar (Π i, f i) (Π i : I, g i) :=
+instance has_smul' {g : I → Type*} [Π i, has_smul (f i) (g i)] :
+  has_smul (Π i, f i) (Π i : I, g i) :=
 ⟨λ s x, λ i, (s i) • (x i)⟩
 
 @[simp, to_additive]
-lemma smul_apply' {g : I → Type*} [∀ i, has_scalar (f i) (g i)] (s : Π i, f i) (x : Π i, g i) :
+lemma smul_apply' {g : I → Type*} [∀ i, has_smul (f i) (g i)] (s : Π i, f i) (x : Π i, g i) :
   (s • x) i = s i • x i :=
 rfl
+
+@[to_additive]
 instance is_scalar_tower {α β : Type*}
-  [has_scalar α β] [Π i, has_scalar β $ f i] [Π i, has_scalar α $ f i]
+  [has_smul α β] [Π i, has_smul β $ f i] [Π i, has_smul α $ f i]
   [Π i, is_scalar_tower α β (f i)] : is_scalar_tower α β (Π i : I, f i) :=
 ⟨λ x y z, funext $ λ i, smul_assoc x y (z i)⟩
 
+@[to_additive]
 instance is_scalar_tower' {g : I → Type*} {α : Type*}
-  [Π i, has_scalar α $ f i] [Π i, has_scalar (f i) (g i)] [Π i, has_scalar α $ g i]
+  [Π i, has_smul α $ f i] [Π i, has_smul (f i) (g i)] [Π i, has_smul α $ g i]
   [Π i, is_scalar_tower α (f i) (g i)] : is_scalar_tower α (Π i : I, f i) (Π i : I, g i) :=
 ⟨λ x y z, funext $ λ i, smul_assoc x (y i) (z i)⟩
 
+@[to_additive]
 instance is_scalar_tower'' {g : I → Type*} {h : I → Type*}
-  [Π i, has_scalar (f i) (g i)] [Π i, has_scalar (g i) (h i)] [Π i, has_scalar (f i) (h i)]
+  [Π i, has_smul (f i) (g i)] [Π i, has_smul (g i) (h i)] [Π i, has_smul (f i) (h i)]
   [Π i, is_scalar_tower (f i) (g i) (h i)] : is_scalar_tower (Π i, f i) (Π i, g i) (Π i, h i) :=
 ⟨λ x y z, funext $ λ i, smul_assoc (x i) (y i) (z i)⟩
 
 @[to_additive]
 instance smul_comm_class {α β : Type*}
-  [Π i, has_scalar α $ f i] [Π i, has_scalar β $ f i] [∀ i, smul_comm_class α β (f i)] :
+  [Π i, has_smul α $ f i] [Π i, has_smul β $ f i] [∀ i, smul_comm_class α β (f i)] :
   smul_comm_class α β (Π i : I, f i) :=
 ⟨λ x y z, funext $ λ i, smul_comm x y (z i)⟩
 
 @[to_additive]
 instance smul_comm_class' {g : I → Type*} {α : Type*}
-  [Π i, has_scalar α $ g i] [Π i, has_scalar (f i) (g i)] [∀ i, smul_comm_class α (f i) (g i)] :
+  [Π i, has_smul α $ g i] [Π i, has_smul (f i) (g i)] [∀ i, smul_comm_class α (f i) (g i)] :
   smul_comm_class α (Π i : I, f i) (Π i : I, g i) :=
 ⟨λ x y z, funext $ λ i, smul_comm x (y i) (z i)⟩
 
 @[to_additive]
 instance smul_comm_class'' {g : I → Type*} {h : I → Type*}
-  [Π i, has_scalar (g i) (h i)] [Π i, has_scalar (f i) (h i)]
+  [Π i, has_smul (g i) (h i)] [Π i, has_smul (f i) (h i)]
   [∀ i, smul_comm_class (f i) (g i) (h i)] : smul_comm_class (Π i, f i) (Π i, g i) (Π i, h i) :=
 ⟨λ x y z, funext $ λ i, smul_comm (x i) (y i) (z i)⟩
 
-instance {α : Type*} [Π i, has_scalar α $ f i] [Π i, has_scalar αᵐᵒᵖ $ f i]
+@[to_additive]
+instance {α : Type*} [Π i, has_smul α $ f i] [Π i, has_smul αᵐᵒᵖ $ f i]
   [∀ i, is_central_scalar α (f i)] : is_central_scalar α (Π i, f i) :=
 ⟨λ r m, funext $ λ i, op_smul_eq_smul _ _⟩
 
 /-- If `f i` has a faithful scalar action for a given `i`, then so does `Π i, f i`. This is
 not an instance as `i` cannot be inferred. -/
-@[to_additive pi.has_faithful_vadd_at]
-lemma has_faithful_scalar_at {α : Type*}
-  [Π i, has_scalar α $ f i] [Π i, nonempty (f i)] (i : I) [has_faithful_scalar α (f i)] :
-  has_faithful_scalar α (Π i, f i) :=
+@[to_additive pi.has_faithful_vadd_at "If `f i` has a faithful additive action for a given `i`, then
+so does `Π i, f i`. This is not an instance as `i` cannot be inferred"]
+lemma has_faithful_smul_at {α : Type*}
+  [Π i, has_smul α $ f i] [Π i, nonempty (f i)] (i : I) [has_faithful_smul α (f i)] :
+  has_faithful_smul α (Π i, f i) :=
 ⟨λ x y h, eq_of_smul_eq_smul $ λ a : f i, begin
   classical,
   have := congr_fun (h $ function.update (λ j, classical.choice (‹Π i, nonempty (f i)› j)) i a) i,
@@ -88,10 +94,10 @@ lemma has_faithful_scalar_at {α : Type*}
 end⟩
 
 @[to_additive pi.has_faithful_vadd]
-instance has_faithful_scalar {α : Type*}
-  [nonempty I] [Π i, has_scalar α $ f i] [Π i, nonempty (f i)] [Π i, has_faithful_scalar α (f i)] :
-  has_faithful_scalar α (Π i, f i) :=
-let ⟨i⟩ := ‹nonempty I› in has_faithful_scalar_at i
+instance has_faithful_smul {α : Type*}
+  [nonempty I] [Π i, has_smul α $ f i] [Π i, nonempty (f i)] [Π i, has_faithful_smul α (f i)] :
+  has_faithful_smul α (Π i, f i) :=
+let ⟨i⟩ := ‹nonempty I› in has_faithful_smul_at i
 
 @[to_additive]
 instance mul_action (α) {m : monoid α} [Π i, mul_action α $ f i] :
@@ -107,18 +113,36 @@ instance mul_action' {g : I → Type*} {m : Π i, monoid (f i)} [Π i, mul_actio
   mul_smul := λ r s f, funext $ λ i, mul_smul _ _ _,
   one_smul := λ f, funext $ λ i, one_smul _ _ }
 
+instance smul_zero_class (α) {n : ∀ i, has_zero $ f i}
+  [∀ i, smul_zero_class α $ f i] :
+  @smul_zero_class α (Π i : I, f i) (@pi.has_zero I f n) :=
+{ smul_zero := λ c, funext $ λ i, smul_zero _ }
+
+instance smul_zero_class' {g : I → Type*} {n : Π i, has_zero $ g i}
+  [Π i, smul_zero_class (f i) (g i)] :
+  @smul_zero_class (Π i, f i) (Π i : I, g i) (@pi.has_zero I g n) :=
+{ smul_zero := by { intros, ext x, apply smul_zero } }
+
+instance distrib_smul (α) {n : ∀ i, add_zero_class $ f i} [∀ i, distrib_smul α $ f i] :
+  @distrib_smul α (Π i : I, f i) (@pi.add_zero_class I f n) :=
+{ smul_add := λ c f g, funext $ λ i, smul_add _ _ _ }
+
+instance distrib_smul' {g : I → Type*} {n : Π i, add_zero_class $ g i}
+  [Π i, distrib_smul (f i) (g i)] :
+  @distrib_smul (Π i, f i) (Π i : I, g i) (@pi.add_zero_class I g n) :=
+{ smul_add := by { intros, ext x, apply smul_add } }
+
 instance distrib_mul_action (α) {m : monoid α} {n : ∀ i, add_monoid $ f i}
   [∀ i, distrib_mul_action α $ f i] :
   @distrib_mul_action α (Π i : I, f i) m (@pi.add_monoid I f n) :=
-{ smul_zero := λ c, funext $ λ i, smul_zero _,
-  smul_add := λ c f g, funext $ λ i, smul_add _ _ _,
-  ..pi.mul_action _ }
+{ ..pi.mul_action _,
+  ..pi.distrib_smul _ }
 
 instance distrib_mul_action' {g : I → Type*} {m : Π i, monoid (f i)} {n : Π i, add_monoid $ g i}
   [Π i, distrib_mul_action (f i) (g i)] :
   @distrib_mul_action (Π i, f i) (Π i : I, g i) (@pi.monoid I f m) (@pi.add_monoid I g n) :=
-{ smul_add := by { intros, ext x, apply smul_add },
-  smul_zero := by { intros, ext x, apply smul_zero } }
+{ .. pi.mul_action',
+  .. pi.distrib_smul' }
 
 lemma single_smul {α} [monoid α] [Π i, add_monoid $ f i]
   [Π i, distrib_mul_action α $ f i] [decidable_eq I] (i : I) (r : α) (x : f i) :
@@ -154,23 +178,25 @@ end pi
 
 namespace function
 
-/-- Non-dependent version of `pi.has_scalar`. Lean gets confused by the dependent instance if this
+/-- Non-dependent version of `pi.has_smul`. Lean gets confused by the dependent instance if this
 is not present. -/
-@[to_additive has_vadd]
-instance has_scalar {ι R M : Type*} [has_scalar R M] :
-  has_scalar R (ι → M) :=
-pi.has_scalar
+@[to_additive "Non-dependent version of `pi.has_vadd`. Lean gets confused by the dependent instance
+if this is not present."]
+instance has_smul {ι R M : Type*} [has_smul R M] :
+  has_smul R (ι → M) :=
+pi.has_smul
 
 /-- Non-dependent version of `pi.smul_comm_class`. Lean gets confused by the dependent instance if
 this is not present. -/
-@[to_additive]
+@[to_additive "Non-dependent version of `pi.vadd_comm_class`. Lean gets confused by the dependent
+instance if this is not present."]
 instance smul_comm_class {ι α β M : Type*}
-  [has_scalar α M] [has_scalar β M] [smul_comm_class α β M] :
+  [has_smul α M] [has_smul β M] [smul_comm_class α β M] :
   smul_comm_class α β (ι → M) :=
 pi.smul_comm_class
 
 @[to_additive]
-lemma update_smul {α : Type*} [Π i, has_scalar α (f i)] [decidable_eq I]
+lemma update_smul {α : Type*} [Π i, has_smul α (f i)] [decidable_eq I]
   (c : α) (f₁ : Π i, f i) (i : I) (x₁ : f i) :
   update (c • f₁) i (c • x₁) = c • update f₁ i x₁ :=
 funext $ λ j, (apply_update (λ i, (•) c) f₁ i x₁ j).symm
@@ -180,7 +206,7 @@ end function
 namespace set
 
 @[to_additive]
-lemma piecewise_smul {α : Type*} [Π i, has_scalar α (f i)] (s : set I) [Π i, decidable (i ∈ s)]
+lemma piecewise_smul {α : Type*} [Π i, has_smul α (f i)] (s : set I) [Π i, decidable (i ∈ s)]
   (c : α) (f₁ g₁ : Π i, f i) :
   s.piecewise (c • f₁) (c • g₁) = c • s.piecewise f₁ g₁ :=
 s.piecewise_op _ _ (λ _, (•) c)
@@ -189,7 +215,7 @@ end set
 
 section extend
 
-@[to_additive] lemma function.extend_smul {R α β γ : Type*} [has_scalar R γ]
+@[to_additive] lemma function.extend_smul {R α β γ : Type*} [has_smul R γ]
   (r : R) (f : α → β) (g : α → γ) (e : β → γ) :
   function.extend f (r • g) (r • e) = r • function.extend f g e :=
 funext $ λ _, by convert (apply_dite ((•) r) _ _ _).symm
diff --git a/src/group_theory/group_action/prod.lean b/src/group_theory/group_action/prod.lean
index dc845b81552d2..d373216994e15 100644
--- a/src/group_theory/group_action/prod.lean
+++ b/src/group_theory/group_action/prod.lean
@@ -9,6 +9,9 @@ import group_theory.group_action.defs
 /-!
 # Prod instances for additive and multiplicative actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines instances for binary product of additive and multiplicative actions and provides
 scalar multiplication as a homomorphism from `α × β` to `β`.
 
@@ -16,17 +19,24 @@ scalar multiplication as a homomorphism from `α × β` to `β`.
 
 * `smul_mul_hom`/`smul_monoid_hom`: Scalar multiplication bundled as a multiplicative/monoid
   homomorphism.
+
+## See also
+
+* `group_theory.group_action.option`
+* `group_theory.group_action.pi`
+* `group_theory.group_action.sigma`
+* `group_theory.group_action.sum`
 -/
 
-variables {M N P α β : Type*}
+variables {M N P E α β : Type*}
 
 namespace prod
 
 section
 
-variables [has_scalar M α] [has_scalar M β] [has_scalar N α] [has_scalar N β] (a : M) (x : α × β)
+variables [has_smul M α] [has_smul M β] [has_smul N α] [has_smul N β] (a : M) (x : α × β)
 
-@[to_additive prod.has_vadd] instance : has_scalar M (α × β) := ⟨λa p, (a • p.1, a • p.2)⟩
+@[to_additive prod.has_vadd] instance : has_smul M (α × β) := ⟨λa p, (a • p.1, a • p.2)⟩
 
 @[simp, to_additive] theorem smul_fst : (a • x).1 = a • x.1 := rfl
 @[simp, to_additive] theorem smul_snd : (a • x).2 = a • x.2 := rfl
@@ -34,7 +44,33 @@ variables [has_scalar M α] [has_scalar M β] [has_scalar N α] [has_scalar N β
 @[to_additive] theorem smul_def (a : M) (x : α × β) : a • x = (a • x.1, a • x.2) := rfl
 @[simp, to_additive] theorem smul_swap : (a • x).swap = a • x.swap := rfl
 
-instance [has_scalar M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
+lemma smul_zero_mk {α : Type*} [monoid M] [add_monoid α] [distrib_mul_action M α] (a : M) (c : β) :
+  a • ((0 : α), c) = (0, a • c) :=
+by rw [prod.smul_mk, smul_zero]
+
+lemma smul_mk_zero {β : Type*} [monoid M] [add_monoid β] [distrib_mul_action M β] (a : M) (b : α) :
+  a • (b, (0 : β)) = (a • b, 0) :=
+by rw [prod.smul_mk, smul_zero]
+
+variables [has_pow α E] [has_pow β E]
+@[to_additive has_smul] instance has_pow : has_pow (α × β) E :=
+{ pow := λ p c, (p.1 ^ c, p.2 ^ c) }
+@[simp, to_additive smul_fst, to_additive_reorder 6]
+lemma pow_fst (p : α × β) (c : E) : (p ^ c).fst = p.fst ^ c := rfl
+@[simp, to_additive smul_snd, to_additive_reorder 6]
+lemma pow_snd (p : α × β) (c : E) : (p ^ c).snd = p.snd ^ c := rfl
+/- Note that the `c` arguments to this lemmas cannot be in the more natural right-most positions due
+to limitations in `to_additive` and `to_additive_reorder`, which will silently fail to reorder more
+than two adjacent arguments -/
+@[simp, to_additive smul_mk, to_additive_reorder 6]
+lemma pow_mk (c : E) (a : α) (b : β) : (prod.mk a b) ^ c = prod.mk (a ^ c) (b ^ c) := rfl
+@[to_additive smul_def, to_additive_reorder 6]
+lemma pow_def (p : α × β) (c : E) : p ^ c = (p.1 ^ c, p.2 ^ c) := rfl
+@[simp, to_additive smul_swap, to_additive_reorder 6]
+lemma pow_swap (p : α × β) (c : E) : (p ^ c).swap = p.swap ^ c := rfl
+
+@[to_additive]
+instance [has_smul M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
   is_scalar_tower M N (α × β) :=
 ⟨λ x y z, mk.inj_iff.mpr ⟨smul_assoc _ _ _, smul_assoc _ _ _⟩⟩
 
@@ -42,29 +78,30 @@ instance [has_scalar M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
   smul_comm_class M N (α × β) :=
 { smul_comm := λ r s x, mk.inj_iff.mpr ⟨smul_comm _ _ _, smul_comm _ _ _⟩ }
 
-instance [has_scalar Mᵐᵒᵖ α] [has_scalar Mᵐᵒᵖ β] [is_central_scalar M α] [is_central_scalar M β] :
+@[to_additive]
+instance [has_smul Mᵐᵒᵖ α] [has_smul Mᵐᵒᵖ β] [is_central_scalar M α] [is_central_scalar M β] :
   is_central_scalar M (α × β) :=
 ⟨λ r m, prod.ext (op_smul_eq_smul _ _) (op_smul_eq_smul _ _)⟩
 
-@[to_additive has_faithful_vadd_left]
-instance has_faithful_scalar_left [has_faithful_scalar M α] [nonempty β] :
-  has_faithful_scalar M (α × β) :=
+@[to_additive]
+instance has_faithful_smul_left [has_faithful_smul M α] [nonempty β] :
+  has_faithful_smul M (α × β) :=
 ⟨λ x y h, let ⟨b⟩ := ‹nonempty β› in eq_of_smul_eq_smul $ λ a : α, by injection h (a, b)⟩
 
-@[to_additive has_faithful_vadd_right]
-instance has_faithful_scalar_right [nonempty α] [has_faithful_scalar M β] :
-  has_faithful_scalar M (α × β) :=
+@[to_additive]
+instance has_faithful_smul_right [nonempty α] [has_faithful_smul M β] :
+  has_faithful_smul M (α × β) :=
 ⟨λ x y h, let ⟨a⟩ := ‹nonempty α› in eq_of_smul_eq_smul $ λ b : β, by injection h (a, b)⟩
 
 end
 
 @[to_additive]
-instance smul_comm_class_both [has_mul N] [has_mul P] [has_scalar M N] [has_scalar M P]
+instance smul_comm_class_both [has_mul N] [has_mul P] [has_smul M N] [has_smul M P]
   [smul_comm_class M N N] [smul_comm_class M P P] :
   smul_comm_class M (N × P) (N × P) :=
 ⟨λ c x y, by simp [smul_def, mul_def, mul_smul_comm]⟩
 
-instance is_scalar_tower_both [has_mul N] [has_mul P] [has_scalar M N] [has_scalar M P]
+instance is_scalar_tower_both [has_mul N] [has_mul P] [has_smul M N] [has_smul M P]
   [is_scalar_tower M N N] [is_scalar_tower M P P] :
   is_scalar_tower M (N × P) (N × P) :=
 ⟨λ c x y, by simp [smul_def, mul_def, smul_mul_assoc]⟩
@@ -73,10 +110,17 @@ instance is_scalar_tower_both [has_mul N] [has_mul P] [has_scalar M N] [has_scal
 { mul_smul  := λ a₁ a₂ p, mk.inj_iff.mpr ⟨mul_smul _ _ _, mul_smul _ _ _⟩,
   one_smul  := λ ⟨b, c⟩, mk.inj_iff.mpr ⟨one_smul _ _, one_smul _ _⟩ }
 
+instance {R M N : Type*} [has_zero M] [has_zero N]
+  [smul_zero_class R M] [smul_zero_class R N] : smul_zero_class R (M × N) :=
+{ smul_zero := λ a, mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩ }
+
+instance {R M N : Type*} [add_zero_class M] [add_zero_class N]
+  [distrib_smul R M] [distrib_smul R N] : distrib_smul R (M × N) :=
+{ smul_add  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩ }
+
 instance {R M N : Type*} {r : monoid R} [add_monoid M] [add_monoid N]
   [distrib_mul_action R M] [distrib_mul_action R N] : distrib_mul_action R (M × N) :=
-{ smul_add  := λ a p₁ p₂, mk.inj_iff.mpr ⟨smul_add _ _ _, smul_add _ _ _⟩,
-  smul_zero := λ a, mk.inj_iff.mpr ⟨smul_zero _, smul_zero _⟩ }
+{ ..prod.distrib_smul }
 
 instance {R M N : Type*} {r : monoid R} [monoid M] [monoid N]
   [mul_distrib_mul_action R M] [mul_distrib_mul_action R N] : mul_distrib_mul_action R (M × N) :=
diff --git a/src/group_theory/group_action/quotient.lean b/src/group_theory/group_action/quotient.lean
new file mode 100644
index 0000000000000..d9bd002eff0e8
--- /dev/null
+++ b/src/group_theory/group_action/quotient.lean
@@ -0,0 +1,313 @@
+/-
+Copyright (c) 2018 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes, Thomas Browning
+-/
+import algebra.hom.group_action
+import data.fintype.big_operators
+import dynamics.periodic_pts
+import group_theory.group_action.conj_act
+import group_theory.commutator
+import group_theory.coset
+
+/-!
+# Properties of group actions involving quotient groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves properties of group actions which use the quotient group construction, notably
+* the orbit-stabilizer theorem `card_orbit_mul_card_stabilizer_eq_card_group`
+* the class formula `card_eq_sum_card_group_div_card_stabilizer'`
+* Burnside's lemma `sum_card_fixed_by_eq_card_orbits_mul_card_group`
+-/
+
+universes u v w
+variables {α : Type u} {β : Type v} {γ : Type w}
+
+open function
+open_locale big_operators
+
+namespace mul_action
+
+variables [group α]
+
+section quotient_action
+
+open subgroup mul_opposite quotient_group
+
+variables (β) [monoid β] [mul_action β α] (H : subgroup α)
+
+/-- A typeclass for when a `mul_action β α` descends to the quotient `α ⧸ H`. -/
+class quotient_action : Prop :=
+(inv_mul_mem : ∀ (b : β) {a a' : α}, a⁻¹ * a' ∈ H → (b • a)⁻¹ * (b • a') ∈ H)
+
+/-- A typeclass for when an `add_action β α` descends to the quotient `α ⧸ H`. -/
+class _root_.add_action.quotient_action {α : Type*} (β : Type*) [add_group α] [add_monoid β]
+  [add_action β α] (H : add_subgroup α) : Prop :=
+(inv_mul_mem : ∀ (b : β) {a a' : α}, -a + a' ∈ H → -(b +ᵥ a) + (b +ᵥ a') ∈ H)
+
+attribute [to_additive add_action.quotient_action] mul_action.quotient_action
+
+@[to_additive] instance left_quotient_action : quotient_action α H :=
+⟨λ _ _ _ _, by rwa [smul_eq_mul, smul_eq_mul, mul_inv_rev, mul_assoc, inv_mul_cancel_left]⟩
+
+@[to_additive] instance right_quotient_action : quotient_action H.normalizer.opposite H :=
+⟨λ b c _ _, by rwa [smul_def, smul_def, smul_eq_mul_unop, smul_eq_mul_unop, mul_inv_rev, ←mul_assoc,
+  mem_normalizer_iff'.mp b.prop, mul_assoc, mul_inv_cancel_left]⟩
+
+@[to_additive] instance right_quotient_action' [hH : H.normal] : quotient_action αᵐᵒᵖ H :=
+⟨λ _ _ _ _, by rwa [smul_eq_mul_unop, smul_eq_mul_unop, mul_inv_rev, mul_assoc, hH.mem_comm_iff,
+  mul_assoc, mul_inv_cancel_right]⟩
+
+@[to_additive] instance quotient [quotient_action β H] : mul_action β (α ⧸ H) :=
+{ smul := λ b, quotient.map' ((•) b) (λ a a' h, left_rel_apply.mpr $
+    quotient_action.inv_mul_mem b $ left_rel_apply.mp h),
+  one_smul := λ q, quotient.induction_on' q (λ a, congr_arg quotient.mk' (one_smul β a)),
+  mul_smul := λ b b' q, quotient.induction_on' q (λ a, congr_arg quotient.mk' (mul_smul b b' a)) }
+
+variables {β}
+
+@[simp, to_additive] lemma quotient.smul_mk [quotient_action β H] (b : β) (a : α) :
+  (b • quotient_group.mk a : α ⧸ H) = quotient_group.mk (b • a) := rfl
+
+@[simp, to_additive] lemma quotient.smul_coe [quotient_action β H] (b : β) (a : α) :
+  (b • a : α ⧸ H) = ↑(b • a) := rfl
+
+@[simp, to_additive] lemma quotient.mk_smul_out' [quotient_action β H] (b : β) (q : α ⧸ H) :
+  quotient_group.mk (b • q.out') = b • q :=
+by rw [←quotient.smul_mk, quotient_group.out_eq']
+
+@[simp, to_additive] lemma quotient.coe_smul_out' [quotient_action β H] (b : β) (q : α ⧸ H) :
+  ↑(b • q.out') = b • q :=
+quotient.mk_smul_out' H b q
+
+lemma _root_.quotient_group.out'_conj_pow_minimal_period_mem
+  (a : α) (q : α ⧸ H) : q.out'⁻¹ * a ^ function.minimal_period ((•) a) q * q.out' ∈ H :=
+by rw [mul_assoc, ←quotient_group.eq', quotient_group.out_eq', ←smul_eq_mul, quotient.mk_smul_out',
+  eq_comm, pow_smul_eq_iff_minimal_period_dvd]
+
+end quotient_action
+
+open quotient_group
+
+/-- The canonical map to the left cosets. -/
+def _root_.mul_action_hom.to_quotient (H : subgroup α) : α →[α] α ⧸ H :=
+⟨coe, quotient.smul_coe H⟩
+
+@[simp] lemma _root_.mul_action_hom.to_quotient_apply (H : subgroup α) (g : α) :
+  mul_action_hom.to_quotient H g = g := rfl
+
+@[to_additive] instance mul_left_cosets_comp_subtype_val (H I : subgroup α) :
+  mul_action I (α ⧸ H) :=
+mul_action.comp_hom (α ⧸ H) (subgroup.subtype I)
+
+variables (α) {β} [mul_action α β] (x : β)
+
+/-- The canonical map from the quotient of the stabilizer to the set. -/
+@[to_additive "The canonical map from the quotient of the stabilizer to the set. "]
+def of_quotient_stabilizer (g : α ⧸ (mul_action.stabilizer α x)) : β :=
+quotient.lift_on' g (•x) $ λ g1 g2 H,
+calc  g1 • x
+    = g1 • (g1⁻¹ * g2) • x : congr_arg _ ((left_rel_apply.mp H).symm)
+... = g2 • x : by rw [smul_smul, mul_inv_cancel_left]
+
+@[simp, to_additive] theorem of_quotient_stabilizer_mk (g : α) :
+  of_quotient_stabilizer α x (quotient_group.mk g) = g • x :=
+rfl
+
+@[to_additive] theorem of_quotient_stabilizer_mem_orbit (g) :
+  of_quotient_stabilizer α x g ∈ orbit α x :=
+quotient.induction_on' g $ λ g, ⟨g, rfl⟩
+
+@[to_additive] theorem of_quotient_stabilizer_smul (g : α)
+  (g' : α ⧸ (mul_action.stabilizer α x)) :
+  of_quotient_stabilizer α x (g • g') = g • of_quotient_stabilizer α x g' :=
+quotient.induction_on' g' $ λ _, mul_smul _ _ _
+
+@[to_additive] theorem injective_of_quotient_stabilizer :
+  function.injective (of_quotient_stabilizer α x) :=
+λ y₁ y₂, quotient.induction_on₂' y₁ y₂ $ λ g₁ g₂ (H : g₁ • x = g₂ • x), quotient.sound' $
+by { rw [left_rel_apply], show (g₁⁻¹ * g₂) • x = x, rw [mul_smul, ← H, inv_smul_smul] }
+
+/-- Orbit-stabilizer theorem. -/
+@[to_additive "Orbit-stabilizer theorem."]
+noncomputable def orbit_equiv_quotient_stabilizer (b : β) :
+  orbit α b ≃ α ⧸ (stabilizer α b) :=
+equiv.symm $ equiv.of_bijective
+  (λ g, ⟨of_quotient_stabilizer α b g, of_quotient_stabilizer_mem_orbit α b g⟩)
+  ⟨λ x y hxy, injective_of_quotient_stabilizer α b (by convert congr_arg subtype.val hxy),
+  λ ⟨b, ⟨g, hgb⟩⟩, ⟨g, subtype.eq hgb⟩⟩
+
+/-- Orbit-stabilizer theorem. -/
+@[to_additive "Orbit-stabilizer theorem."]
+noncomputable def orbit_prod_stabilizer_equiv_group (b : β) :
+  orbit α b × stabilizer α b ≃ α :=
+(equiv.prod_congr (orbit_equiv_quotient_stabilizer α _) (equiv.refl _)).trans
+subgroup.group_equiv_quotient_times_subgroup.symm
+
+/-- Orbit-stabilizer theorem. -/
+@[to_additive "Orbit-stabilizer theorem."]
+lemma card_orbit_mul_card_stabilizer_eq_card_group (b : β) [fintype α] [fintype $ orbit α b]
+  [fintype $ stabilizer α b] :
+  fintype.card (orbit α b) * fintype.card (stabilizer α b) = fintype.card α :=
+by rw [← fintype.card_prod, fintype.card_congr (orbit_prod_stabilizer_equiv_group α b)]
+
+@[simp, to_additive] theorem orbit_equiv_quotient_stabilizer_symm_apply (b : β) (a : α) :
+  ((orbit_equiv_quotient_stabilizer α b).symm a : β) = a • b :=
+rfl
+
+@[simp, to_additive] lemma stabilizer_quotient {G} [group G] (H : subgroup G) :
+  mul_action.stabilizer G ((1 : G) : G ⧸ H) = H :=
+by { ext, simp [quotient_group.eq] }
+
+variable (β)
+
+local notation `Ω` := (quotient $ orbit_rel α β)
+
+/-- **Class formula** : given `G` a group acting on `X` and `φ` a function mapping each orbit of `X`
+under this action (that is, each element of the quotient of `X` by the relation `orbit_rel G X`) to
+an element in this orbit, this gives a (noncomputable) bijection between `X` and the disjoint union
+of `G/Stab(φ(ω))` over all orbits `ω`. In most cases you'll want `φ` to be `quotient.out'`, so we
+provide `mul_action.self_equiv_sigma_orbits_quotient_stabilizer` as a special case. -/
+@[to_additive "**Class formula** : given `G` an additive group acting on `X` and `φ` a function
+mapping each orbit of `X` under this action (that is, each element of the quotient of `X` by the
+relation `orbit_rel G X`) to an element in this orbit, this gives a (noncomputable) bijection
+between `X` and the disjoint union of `G/Stab(φ(ω))` over all orbits `ω`. In most cases you'll want
+`φ` to be `quotient.out'`, so we provide `add_action.self_equiv_sigma_orbits_quotient_stabilizer`
+as a special case. "]
+noncomputable def self_equiv_sigma_orbits_quotient_stabilizer' {φ : Ω → β}
+  (hφ : left_inverse quotient.mk' φ) : β ≃ Σ (ω : Ω), α ⧸ (stabilizer α (φ ω)) :=
+calc  β
+    ≃ Σ (ω : Ω), orbit_rel.quotient.orbit ω : self_equiv_sigma_orbits' α β
+... ≃ Σ (ω : Ω), α ⧸ (stabilizer α (φ ω)) :
+        equiv.sigma_congr_right (λ ω,
+          (equiv.set.of_eq $ orbit_rel.quotient.orbit_eq_orbit_out _ hφ).trans $
+            orbit_equiv_quotient_stabilizer α (φ ω))
+
+/-- **Class formula** for a finite group acting on a finite type. See
+`mul_action.card_eq_sum_card_group_div_card_stabilizer` for a specialized version using
+`quotient.out'`. -/
+@[to_additive "**Class formula** for a finite group acting on a finite type. See
+`add_action.card_eq_sum_card_add_group_div_card_stabilizer` for a specialized version using
+`quotient.out'`."]
+lemma card_eq_sum_card_group_div_card_stabilizer' [fintype α] [fintype β] [fintype Ω]
+  [Π (b : β), fintype $ stabilizer α b] {φ : Ω → β} (hφ : left_inverse quotient.mk' φ) :
+  fintype.card β = ∑ (ω : Ω), fintype.card α / fintype.card (stabilizer α (φ ω)) :=
+begin
+  classical,
+  have : ∀ ω : Ω, fintype.card α / fintype.card ↥(stabilizer α (φ ω)) =
+    fintype.card (α ⧸ stabilizer α (φ ω)),
+  { intro ω,
+    rw [fintype.card_congr (@subgroup.group_equiv_quotient_times_subgroup α _ (stabilizer α $ φ ω)),
+        fintype.card_prod, nat.mul_div_cancel],
+    exact fintype.card_pos_iff.mpr (by apply_instance) },
+  simp_rw [this, ← fintype.card_sigma, fintype.card_congr
+            (self_equiv_sigma_orbits_quotient_stabilizer' α β hφ)],
+end
+
+/-- **Class formula**. This is a special case of
+`mul_action.self_equiv_sigma_orbits_quotient_stabilizer'` with `φ = quotient.out'`. -/
+@[to_additive "**Class formula**. This is a special case of
+`add_action.self_equiv_sigma_orbits_quotient_stabilizer'` with `φ = quotient.out'`. "]
+noncomputable def self_equiv_sigma_orbits_quotient_stabilizer :
+  β ≃ Σ (ω : Ω), α ⧸ (stabilizer α ω.out') :=
+self_equiv_sigma_orbits_quotient_stabilizer' α β quotient.out_eq'
+
+/-- **Class formula** for a finite group acting on a finite type. -/
+@[to_additive "**Class formula** for a finite group acting on a finite type."]
+lemma card_eq_sum_card_group_div_card_stabilizer [fintype α] [fintype β] [fintype Ω]
+  [Π (b : β), fintype $ stabilizer α b] :
+  fintype.card β = ∑ (ω : Ω), fintype.card α / fintype.card (stabilizer α ω.out') :=
+card_eq_sum_card_group_div_card_stabilizer' α β quotient.out_eq'
+
+/-- **Burnside's lemma** : a (noncomputable) bijection between the disjoint union of all
+`{x ∈ X | g • x = x}` for `g ∈ G` and the product `G × X/G`, where `G` is a group acting on `X` and
+`X/G`denotes the quotient of `X` by the relation `orbit_rel G X`. -/
+@[to_additive "**Burnside's lemma** : a (noncomputable) bijection between the disjoint union of all
+`{x ∈ X | g • x = x}` for `g ∈ G` and the product `G × X/G`, where `G` is an additive group acting
+on `X` and `X/G`denotes the quotient of `X` by the relation `orbit_rel G X`. "]
+noncomputable def sigma_fixed_by_equiv_orbits_prod_group :
+  (Σ (a : α), (fixed_by α β a)) ≃ Ω × α :=
+calc  (Σ (a : α), fixed_by α β a)
+    ≃ {ab : α × β // ab.1 • ab.2 = ab.2} :
+        (equiv.subtype_prod_equiv_sigma_subtype _).symm
+... ≃ {ba : β × α // ba.2 • ba.1 = ba.1} :
+        (equiv.prod_comm α β).subtype_equiv (λ ab, iff.rfl)
+... ≃ Σ (b : β), stabilizer α b :
+        equiv.subtype_prod_equiv_sigma_subtype (λ (b : β) a, a ∈ stabilizer α b)
+... ≃ Σ (ωb : (Σ (ω : Ω), orbit α ω.out')), stabilizer α (ωb.2 : β) :
+        (self_equiv_sigma_orbits α β).sigma_congr_left'
+... ≃ Σ (ω : Ω), (Σ (b : orbit α ω.out'), stabilizer α (b : β)) :
+        equiv.sigma_assoc (λ (ω : Ω) (b : orbit α ω.out'), stabilizer α (b : β))
+... ≃ Σ (ω : Ω), (Σ (b : orbit α ω.out'), stabilizer α ω.out') :
+        equiv.sigma_congr_right (λ ω, equiv.sigma_congr_right $
+          λ ⟨b, hb⟩, (stabilizer_equiv_stabilizer_of_orbit_rel hb).to_equiv)
+... ≃ Σ (ω : Ω), orbit α ω.out' × stabilizer α ω.out' :
+        equiv.sigma_congr_right (λ ω, equiv.sigma_equiv_prod _ _)
+... ≃ Σ (ω : Ω), α :
+        equiv.sigma_congr_right (λ ω, orbit_prod_stabilizer_equiv_group α ω.out')
+... ≃ Ω × α :
+        equiv.sigma_equiv_prod Ω α
+
+/-- **Burnside's lemma** : given a finite group `G` acting on a set `X`, the average number of
+elements fixed by each `g ∈ G` is the number of orbits. -/
+@[to_additive "**Burnside's lemma** : given a finite additive group `G` acting on a set `X`,
+the average number of elements fixed by each `g ∈ G` is the number of orbits. "]
+lemma sum_card_fixed_by_eq_card_orbits_mul_card_group [fintype α] [Π a, fintype $ fixed_by α β a]
+  [fintype Ω] :
+  ∑ (a : α), fintype.card (fixed_by α β a) = fintype.card Ω * fintype.card α :=
+by rw [← fintype.card_prod, ← fintype.card_sigma,
+        fintype.card_congr (sigma_fixed_by_equiv_orbits_prod_group α β)]
+
+@[to_additive] instance is_pretransitive_quotient (G) [group G] (H : subgroup G) :
+  is_pretransitive G (G ⧸ H) :=
+{ exists_smul_eq := begin
+    rintros ⟨x⟩ ⟨y⟩,
+    refine ⟨y * x⁻¹, quotient_group.eq.mpr _⟩,
+    simp only [smul_eq_mul, H.one_mem, mul_left_inv, inv_mul_cancel_right],
+  end }
+
+end mul_action
+
+namespace subgroup
+
+variables {G : Type*} [group G] (H : subgroup G)
+
+lemma normal_core_eq_ker :
+  H.normal_core = (mul_action.to_perm_hom G (G ⧸ H)).ker :=
+begin
+  refine le_antisymm (λ g hg, equiv.perm.ext (λ q, quotient_group.induction_on q
+    (λ g', (mul_action.quotient.smul_mk H g g').trans (quotient_group.eq.mpr _))))
+    (subgroup.normal_le_normal_core.mpr (λ g hg, _)),
+  { rw [smul_eq_mul, mul_inv_rev, ←inv_inv g', inv_inv],
+    exact H.normal_core.inv_mem hg g'⁻¹ },
+  { rw [←H.inv_mem_iff, ←mul_one g⁻¹, ←quotient_group.eq, ←mul_one g],
+    exact (mul_action.quotient.smul_mk H g 1).symm.trans (equiv.perm.ext_iff.mp hg (1 : G)) },
+end
+
+open quotient_group
+
+/-- Cosets of the centralizer of an element embed into the set of commutators. -/
+noncomputable def quotient_centralizer_embedding (g : G) :
+  G ⧸ centralizer (zpowers (g : G) : set G) ↪ commutator_set G :=
+((mul_action.orbit_equiv_quotient_stabilizer (conj_act G) g).trans (quotient_equiv_of_eq
+  (conj_act.stabilizer_eq_centralizer g))).symm.to_embedding.trans ⟨λ x, ⟨x * g⁻¹,
+  let ⟨_, x, rfl⟩ := x in ⟨x, g, rfl⟩⟩, λ x y, subtype.ext ∘ mul_right_cancel ∘ subtype.ext_iff.mp⟩
+
+lemma quotient_centralizer_embedding_apply (g : G) (x : G) :
+  quotient_centralizer_embedding g x = ⟨⁅x, g⁆, x, g, rfl⟩ :=
+rfl
+
+/-- If `G` is generated by `S`, then the quotient by the center embeds into `S`-indexed sequences
+of commutators. -/
+noncomputable def quotient_center_embedding {S : set G} (hS : closure S = ⊤) :
+  G ⧸ center G ↪ S → commutator_set G :=
+(quotient_equiv_of_eq (center_eq_infi' S hS)).to_embedding.trans ((quotient_infi_embedding _).trans
+  (function.embedding.Pi_congr_right (λ g, quotient_centralizer_embedding g)))
+
+lemma quotient_center_embedding_apply {S : set G} (hS : closure S = ⊤) (g : G) (s : S) :
+  quotient_center_embedding hS g s = ⟨⁅g, s⁆, g, s, rfl⟩ :=
+rfl
+
+end subgroup
diff --git a/src/group_theory/group_action/sigma.lean b/src/group_theory/group_action/sigma.lean
new file mode 100644
index 0000000000000..fb5378455edc1
--- /dev/null
+++ b/src/group_theory/group_action/sigma.lean
@@ -0,0 +1,62 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import group_theory.group_action.defs
+
+/-!
+# Sigma instances for additive and multiplicative actions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines instances for arbitrary sum of additive and multiplicative actions.
+
+## See also
+
+* `group_theory.group_action.pi`
+* `group_theory.group_action.prod`
+* `group_theory.group_action.sum`
+-/
+
+variables {ι : Type*} {M N : Type*} {α : ι → Type*}
+
+namespace sigma
+
+section has_smul
+variables [Π i, has_smul M (α i)] [Π i, has_smul N (α i)] (a : M) (i : ι) (b : α i)
+  (x : Σ i, α i)
+
+@[to_additive sigma.has_vadd] instance : has_smul M (Σ i, α i) := ⟨λ a, sigma.map id $ λ i, (•) a⟩
+
+@[to_additive] lemma smul_def : a • x = x.map id (λ i, (•) a) := rfl
+@[simp, to_additive] lemma smul_mk : a • mk i b = ⟨i, a • b⟩ := rfl
+
+@[to_additive] instance [has_smul M N] [Π i, is_scalar_tower M N (α i)] :
+  is_scalar_tower M N (Σ i, α i) :=
+⟨λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, smul_assoc] }⟩
+
+@[to_additive] instance [Π i, smul_comm_class M N (α i)] : smul_comm_class M N (Σ i, α i) :=
+⟨λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, smul_mk, smul_comm] }⟩
+
+@[to_additive] instance [Π i, has_smul Mᵐᵒᵖ (α i)] [Π i, is_central_scalar M (α i)] :
+  is_central_scalar M (Σ i, α i) :=
+⟨λ a x, by { cases x, rw [smul_mk, smul_mk, op_smul_eq_smul] }⟩
+
+/-- This is not an instance because `i` becomes a metavariable. -/
+@[to_additive "This is not an instance because `i` becomes a metavariable."]
+protected lemma has_faithful_smul' [has_faithful_smul M (α i)] : has_faithful_smul M (Σ i, α i) :=
+⟨λ x y h, eq_of_smul_eq_smul $ λ a : α i, heq_iff_eq.1 (ext_iff.1 $ h $ mk i a).2⟩
+
+@[to_additive] instance [nonempty ι] [Π i, has_faithful_smul M (α i)] :
+  has_faithful_smul M (Σ i, α i) :=
+nonempty.elim ‹_› $ λ i, sigma.has_faithful_smul' i
+
+end has_smul
+
+@[to_additive] instance {m : monoid M} [Π i, mul_action M (α i)] : mul_action M (Σ i, α i) :=
+{ mul_smul := λ a b x, by { cases x, rw [smul_mk, smul_mk, smul_mk, mul_smul] },
+  one_smul := λ x, by { cases x, rw [smul_mk, one_smul] } }
+
+end sigma
diff --git a/src/group_theory/group_action/sub_mul_action.lean b/src/group_theory/group_action/sub_mul_action.lean
index cc8224d09a943..dc5001117801e 100644
--- a/src/group_theory/group_action/sub_mul_action.lean
+++ b/src/group_theory/group_action/sub_mul_action.lean
@@ -11,6 +11,9 @@ import group_theory.group_action.basic
 
 # Sets invariant to a `mul_action`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `sub_mul_action R M`; a subset of a `mul_action R M` which is closed with
 respect to scalar multiplication.
 
@@ -35,18 +38,75 @@ variables {S : Type u'} {T : Type u''} {R : Type u} {M : Type v}
 
 set_option old_structure_cmd true
 
+/-- `smul_mem_class S R M` says `S` is a type of subsets `s ≤ M` that are closed under the
+scalar action of `R` on `M`.
+
+Note that only `R` is marked as an `out_param` here, since `M` is supplied by the `set_like`
+class instead.
+-/
+class smul_mem_class (S : Type*) (R : out_param $ Type*) (M : Type*) [has_smul R M]
+  [set_like S M] :=
+(smul_mem : ∀ {s : S} (r : R) {m : M}, m ∈ s → r • m ∈ s)
+
+/-- `vadd_mem_class S R M` says `S` is a type of subsets `s ≤ M` that are closed under the
+additive action of `R` on `M`.
+
+Note that only `R` is marked as an `out_param` here, since `M` is supplied by the `set_like`
+class instead.
+-/
+class vadd_mem_class (S : Type*) (R : out_param $ Type*) (M : Type*) [has_vadd R M]
+  [set_like S M] :=
+(vadd_mem : ∀ {s : S} (r : R) {m : M}, m ∈ s → r +ᵥ m ∈ s)
+
+attribute [to_additive] smul_mem_class
+
+namespace set_like
+
+variables [has_smul R M] [set_like S M] [hS : smul_mem_class S R M] (s : S)
+include hS
+
+open smul_mem_class
+
+/-- A subset closed under the scalar action inherits that action. -/
+@[to_additive "A subset closed under the additive action inherits that action.",
+priority 900] -- lower priority so other instances are found first
+instance has_smul : has_smul R s := ⟨λ r x, ⟨r • x.1, smul_mem r x.2⟩⟩
+
+@[simp, norm_cast, to_additive, priority 900]
+-- lower priority so later simp lemmas are used first; to appease simp_nf
+protected lemma coe_smul (r : R) (x : s) : (↑(r • x) : M) = r • x := rfl
+
+@[simp, to_additive, priority 900]
+-- lower priority so later simp lemmas are used first; to appease simp_nf
+lemma mk_smul_mk (r : R) (x : M) (hx : x ∈ s) :
+  r • (⟨x, hx⟩ : s) = ⟨r • x, smul_mem r hx⟩ := rfl
+
+@[to_additive] lemma smul_def (r : R) (x : s) : r • x = ⟨r • x, smul_mem r x.2⟩ := rfl
+
+omit hS
+
+@[simp] lemma forall_smul_mem_iff {R M S : Type*} [monoid R] [mul_action R M]
+  [set_like S M] [smul_mem_class S R M] {N : S} {x : M} :
+  (∀ (a : R), a • x ∈ N) ↔ x ∈ N :=
+⟨λ h, by simpa using h 1, λ h a, smul_mem_class.smul_mem a h⟩
+
+end set_like
+
 /-- A sub_mul_action is a set which is closed under scalar multiplication.  -/
-structure sub_mul_action (R : Type u) (M : Type v) [has_scalar R M] : Type v :=
+structure sub_mul_action (R : Type u) (M : Type v) [has_smul R M] : Type v :=
 (carrier : set M)
 (smul_mem' : ∀ (c : R) {x : M}, x ∈ carrier → c • x ∈ carrier)
 
 namespace sub_mul_action
 
-variables [has_scalar R M]
+variables [has_smul R M]
 
 instance : set_like (sub_mul_action R M) M :=
 ⟨sub_mul_action.carrier, λ p q h, by cases p; cases q; congr'⟩
 
+instance : smul_mem_class (sub_mul_action R M) R M :=
+{ smul_mem := smul_mem' }
+
 @[simp] lemma mem_carrier {p : sub_mul_action R M} {x : M} : x ∈ p.carrier ↔ x ∈ (p : set M) :=
 iff.rfl
 
@@ -73,15 +133,15 @@ end sub_mul_action
 
 namespace sub_mul_action
 
-section has_scalar
+section has_smul
 
-variables [has_scalar R M]
+variables [has_smul R M]
 variables (p : sub_mul_action R M)
 variables {r : R} {x : M}
 
 lemma smul_mem (r : R) (h : x ∈ p) : r • x ∈ p := p.smul_mem' r h
 
-instance : has_scalar R p :=
+instance : has_smul R p :=
 { smul := λ c x, ⟨c • x.1, smul_mem _ c x.2⟩ }
 
 variables {p}
@@ -98,33 +158,56 @@ by refine {to_fun := coe, ..}; simp [coe_smul]
 
 lemma subtype_eq_val : ((sub_mul_action.subtype p) : p → M) = subtype.val := rfl
 
-end has_scalar
+end has_smul
+
+namespace smul_mem_class
+
+variables [monoid R] [mul_action R M] {A : Type*} [set_like A M]
+variables [hA : smul_mem_class A R M] (S' : A)
+
+include hA
+/-- A `sub_mul_action` of a `mul_action` is a `mul_action`.  -/
+@[priority 75] -- Prefer subclasses of `mul_action` over `smul_mem_class`.
+instance to_mul_action : mul_action R S' :=
+subtype.coe_injective.mul_action coe (set_like.coe_smul S')
+
+/-- The natural `mul_action_hom` over `R` from a `sub_mul_action` of `M` to `M`. -/
+protected def subtype : S' →[R] M := ⟨coe,  λ _ _, rfl⟩
+
+@[simp] protected theorem coe_subtype : (smul_mem_class.subtype S' : S' → M) = coe := rfl
+
+end smul_mem_class
 
 section mul_action_monoid
 
 variables [monoid R] [mul_action R M]
 
 section
-variables [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M]
+variables [has_smul S R] [has_smul S M] [is_scalar_tower S R M]
 variables (p : sub_mul_action R M)
 
 lemma smul_of_tower_mem (s : S) {x : M} (h : x ∈ p) : s • x ∈ p :=
 by { rw [←one_smul R x, ←smul_assoc], exact p.smul_mem _ h }
 
-instance has_scalar' : has_scalar S p :=
+instance has_smul' : has_smul S p :=
 { smul := λ c x, ⟨c • x.1, smul_of_tower_mem _ c x.2⟩ }
 
 instance : is_scalar_tower S R p :=
 { smul_assoc := λ s r x, subtype.ext $ smul_assoc s r ↑x }
 
+instance is_scalar_tower' {S' : Type*} [has_smul S' R] [has_smul S' S]
+  [has_smul S' M] [is_scalar_tower S' R M] [is_scalar_tower S' S M] :
+  is_scalar_tower S' S p :=
+{ smul_assoc := λ s r x, subtype.ext $ smul_assoc s r ↑x }
+
 @[simp, norm_cast] lemma coe_smul_of_tower (s : S) (x : p) : ((s • x : p) : M) = s • ↑x := rfl
 
-@[simp] lemma smul_mem_iff' {G} [group G] [has_scalar G R] [mul_action G M]
+@[simp] lemma smul_mem_iff' {G} [group G] [has_smul G R] [mul_action G M]
   [is_scalar_tower G R M] (g : G) {x : M} :
   g • x ∈ p ↔ x ∈ p :=
 ⟨λ h, inv_smul_smul g x ▸ p.smul_of_tower_mem g⁻¹ h, p.smul_of_tower_mem g⟩
 
-instance [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M]
+instance [has_smul Sᵐᵒᵖ R] [has_smul Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M]
   [is_central_scalar S M] : is_central_scalar S p :=
 { op_smul_eq_smul := λ r x, subtype.ext $ op_smul_eq_smul r x }
 
@@ -132,7 +215,7 @@ end
 
 section
 
-variables [monoid S] [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
+variables [monoid S] [has_smul S R] [mul_action S M] [is_scalar_tower S R M]
 variables (p : sub_mul_action R M)
 
 /-- If the scalar product forms a `mul_action`, then the subset inherits this action -/
@@ -220,7 +303,7 @@ end sub_mul_action
 namespace sub_mul_action
 
 variables [group_with_zero S] [monoid R] [mul_action R M]
-variables [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
+variables [has_smul S R] [mul_action S M] [is_scalar_tower S R M]
 variables (p : sub_mul_action R M) {s : S} {x y : M}
 
 theorem smul_mem_iff (s0 : s ≠ 0) : s • x ∈ p ↔ x ∈ p :=
diff --git a/src/group_theory/group_action/sub_mul_action/pointwise.lean b/src/group_theory/group_action/sub_mul_action/pointwise.lean
new file mode 100644
index 0000000000000..d09c82d903019
--- /dev/null
+++ b/src/group_theory/group_action/sub_mul_action/pointwise.lean
@@ -0,0 +1,117 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import group_theory.group_action.sub_mul_action
+
+/-!
+# Pointwise monoid structures on sub_mul_action
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides `sub_mul_action.monoid` and weaker typeclasses, which show that `sub_mul_action`s
+inherit the same pointwise multiplications as sets.
+
+To match `submodule.idem_semiring`, we do not put these in the `pointwise` locale.
+
+-/
+
+open_locale pointwise
+
+variables {R M : Type*}
+
+namespace sub_mul_action
+
+section has_one
+variables [monoid R] [mul_action R M] [has_one M]
+
+instance : has_one (sub_mul_action R M) :=
+{ one := { carrier := set.range (λ r : R, r • (1 : M)),
+           smul_mem' := λ r m ⟨r', hr'⟩, hr' ▸ ⟨r * r', mul_smul _ _ _⟩ } }
+
+lemma coe_one : ↑(1 : sub_mul_action R M) = set.range (λ r : R, r • (1 : M)) := rfl
+
+@[simp] lemma mem_one {x : M} : x ∈ (1 : sub_mul_action R M) ↔ ∃ r : R, r • 1 = x := iff.rfl
+
+lemma subset_coe_one : (1 : set M) ⊆ (1 : sub_mul_action R M) :=
+λ x hx, ⟨1, (one_smul _ _).trans hx.symm⟩
+
+end has_one
+
+section has_mul
+variables [monoid R] [mul_action R M] [has_mul M] [is_scalar_tower R M M]
+
+instance : has_mul (sub_mul_action R M) :=
+{ mul := λ p q, { carrier := set.image2 (*) p q,
+                  smul_mem' := λ r m ⟨m₁, m₂, hm₁, hm₂, h⟩,
+                    h ▸ smul_mul_assoc r m₁ m₂ ▸ set.mul_mem_mul (p.smul_mem _ hm₁) hm₂ } }
+
+@[norm_cast] lemma coe_mul (p q : sub_mul_action R M) : ↑(p * q) = (p * q : set M) := rfl
+
+lemma mem_mul {p q : sub_mul_action R M} {x : M} : x ∈ p * q ↔ ∃ y z, y ∈ p ∧ z ∈ q ∧ y * z = x :=
+set.mem_mul
+
+end has_mul
+
+section mul_one_class
+variables [monoid R] [mul_action R M] [mul_one_class M] [is_scalar_tower R M M]
+  [smul_comm_class R M M]
+
+instance : mul_one_class (sub_mul_action R M) :=
+{ mul := (*),
+  one := 1,
+  mul_one := λ a, begin
+    ext,
+    simp only [mem_mul, mem_one, mul_smul_comm, exists_and_distrib_left, exists_exists_eq_and,
+      mul_one],
+    split,
+    { rintros ⟨y, hy, r, rfl⟩,
+      exact smul_mem _ _ hy },
+    { intro hx,
+      exact ⟨x, hx, 1, one_smul _ _⟩ },
+  end,
+  one_mul := λ a, begin
+    ext,
+    simp only [mem_mul, mem_one, smul_mul_assoc, exists_and_distrib_left, exists_exists_eq_and,
+      one_mul],
+    refine ⟨_, λ hx, ⟨1, x, hx, one_smul _ _⟩⟩,
+    rintro ⟨r, y, hy, rfl⟩,
+    exact smul_mem _ _ hy,
+  end, }
+
+end mul_one_class
+
+section semigroup
+variables [monoid R] [mul_action R M] [semigroup M] [is_scalar_tower R M M]
+
+instance : semigroup (sub_mul_action R M) :=
+{ mul := (*),
+  mul_assoc := λ a b c, set_like.coe_injective (mul_assoc (_ : set _) _ _), }
+
+end semigroup
+
+section monoid
+variables [monoid R] [mul_action R M] [monoid M] [is_scalar_tower R M M] [smul_comm_class R M M]
+
+instance : monoid (sub_mul_action R M) :=
+{ mul := (*),
+  one := 1,
+  ..sub_mul_action.semigroup,
+  ..sub_mul_action.mul_one_class }
+
+lemma coe_pow (p : sub_mul_action R M) : ∀ {n : ℕ} (hn : n ≠ 0), ↑(p ^ n) = (p ^ n : set M)
+| 0 hn := (hn rfl).elim
+| 1 hn := by rw [pow_one, pow_one]
+| (n + 2) hn := by rw [pow_succ _ (n + 1), pow_succ _ (n + 1), coe_mul, coe_pow (n.succ_ne_zero)]
+
+lemma subset_coe_pow (p : sub_mul_action R M) : ∀ {n : ℕ},
+   (p ^ n : set M) ⊆ ↑(p ^ n)
+| 0 := by { rw [pow_zero, pow_zero], exact subset_coe_one }
+| (n + 1) := (coe_pow p n.succ_ne_zero).superset
+
+end monoid
+
+end sub_mul_action
diff --git a/src/group_theory/group_action/sum.lean b/src/group_theory/group_action/sum.lean
new file mode 100644
index 0000000000000..253eb5990aa13
--- /dev/null
+++ b/src/group_theory/group_action/sum.lean
@@ -0,0 +1,71 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import group_theory.group_action.defs
+
+/-!
+# Sum instances for additive and multiplicative actions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines instances for additive and multiplicative actions on the binary `sum` type.
+
+## See also
+
+* `group_theory.group_action.option`
+* `group_theory.group_action.pi`
+* `group_theory.group_action.prod`
+* `group_theory.group_action.sigma`
+-/
+
+variables {M N P α β γ : Type*}
+
+namespace sum
+
+section has_smul
+variables [has_smul M α] [has_smul M β] [has_smul N α] [has_smul N β] (a : M) (b : α)
+  (c : β) (x : α ⊕ β)
+
+@[to_additive sum.has_vadd] instance : has_smul M (α ⊕ β) := ⟨λ a, sum.map ((•) a) ((•) a)⟩
+
+@[to_additive] lemma smul_def : a • x = x.map ((•) a) ((•) a) := rfl
+@[simp, to_additive] lemma smul_inl : a • (inl b : α ⊕ β) = inl (a • b) := rfl
+@[simp, to_additive] lemma smul_inr : a • (inr c : α ⊕ β) = inr (a • c) := rfl
+@[simp, to_additive] lemma smul_swap : (a • x).swap = a • x.swap := by cases x; refl
+
+instance [has_smul M N] [is_scalar_tower M N α] [is_scalar_tower M N β] :
+  is_scalar_tower M N (α ⊕ β) :=
+⟨λ a b x,
+  by { cases x, exacts [congr_arg inl (smul_assoc _ _ _), congr_arg inr (smul_assoc _ _ _)] }⟩
+
+@[to_additive] instance [smul_comm_class M N α] [smul_comm_class M N β] :
+  smul_comm_class M N (α ⊕ β) :=
+⟨λ a b x,
+  by { cases x, exacts [congr_arg inl (smul_comm _ _ _), congr_arg inr (smul_comm _ _ _)] }⟩
+
+@[to_additive]
+instance [has_smul Mᵐᵒᵖ α] [has_smul Mᵐᵒᵖ β] [is_central_scalar M α] [is_central_scalar M β] :
+  is_central_scalar M (α ⊕ β) :=
+⟨λ a x,
+  by { cases x, exacts [congr_arg inl (op_smul_eq_smul _ _), congr_arg inr (op_smul_eq_smul _ _)] }⟩
+
+@[to_additive] instance has_faithful_smul_left [has_faithful_smul M α] :
+  has_faithful_smul M (α ⊕ β) :=
+⟨λ x y h, eq_of_smul_eq_smul $ λ a : α, by injection h (inl a)⟩
+
+@[to_additive] instance has_faithful_smul_right [has_faithful_smul M β] :
+  has_faithful_smul M (α ⊕ β) :=
+⟨λ x y h, eq_of_smul_eq_smul $ λ b : β, by injection h (inr b)⟩
+
+end has_smul
+
+@[to_additive] instance {m : monoid M} [mul_action M α] [mul_action M β] : mul_action M (α ⊕ β) :=
+{ mul_smul := λ a b x,
+    by { cases x, exacts [congr_arg inl (mul_smul _ _ _), congr_arg inr (mul_smul _ _ _)] },
+  one_smul := λ x,
+    by { cases x, exacts [congr_arg inl (one_smul _ _), congr_arg inr (one_smul _ _)] } }
+
+end sum
diff --git a/src/group_theory/group_action/support.lean b/src/group_theory/group_action/support.lean
new file mode 100644
index 0000000000000..5d85b3139c86f
--- /dev/null
+++ b/src/group_theory/group_action/support.lean
@@ -0,0 +1,56 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import data.set.pointwise.smul
+
+/-!
+# Support of an element under an action action
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given an action of a group `G` on a type `α`, we say that a set `s : set α` supports an element
+`a : α` if, for all `g` that fix `s` pointwise, `g` fixes `a`.
+
+This is crucial in Fourier-Motzkin constructions.
+-/
+
+open_locale pointwise
+
+variables {G H α β : Type*}
+
+namespace mul_action
+section has_smul
+variables (G) [has_smul G α] [has_smul G β]
+
+/-- A set `s` supports `b` if `g • b = b` whenever `g • a = a` for all `a ∈ s`. -/
+@[to_additive "A set `s` supports `b` if `g +ᵥ b = b` whenever `g +ᵥ a = a` for all `a ∈ s`."]
+def supports (s : set α) (b : β) := ∀ g : G, (∀ ⦃a⦄, a ∈ s → g • a = a) → g • b = b
+
+variables {s t : set α} {a : α} {b : β}
+
+@[to_additive] lemma supports_of_mem (ha : a ∈ s) : supports G s a := λ g h, h ha
+
+variables {G}
+
+@[to_additive] lemma supports.mono (h : s ⊆ t) (hs : supports G s b) : supports G t b :=
+λ g hg, hs _ $ λ a ha, hg $ h ha
+
+end has_smul
+
+variables [group H] [has_smul G α] [has_smul G β] [mul_action H α] [has_smul H β]
+  [smul_comm_class G H β] [smul_comm_class G H α] {s t : set α} {b : β}
+
+-- TODO: This should work without `smul_comm_class`
+@[to_additive] lemma supports.smul (g : H) (h : supports G s b) : supports G (g • s) (g • b) :=
+begin
+  rintro g' hg',
+  rw [smul_comm, h],
+  rintro a ha,
+  have := set.ball_image_iff.1 hg' a ha,
+  rwa [smul_comm, smul_left_cancel_iff] at this,
+end
+
+end mul_action
diff --git a/src/group_theory/group_action/units.lean b/src/group_theory/group_action/units.lean
index b21c464632f64..5aa1f4eaa86f7 100644
--- a/src/group_theory/group_action/units.lean
+++ b/src/group_theory/group_action/units.lean
@@ -7,8 +7,11 @@ import group_theory.group_action.defs
 
 /-! # Group actions on and by `Mˣ`
 
-This file provides the action of a unit on a type `α`, `has_scalar Mˣ α`, in the presence of
-`has_scalar M α`, with the obvious definition stated in `units.smul_def`. This definition preserves
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides the action of a unit on a type `α`, `has_smul Mˣ α`, in the presence of
+`has_smul M α`, with the obvious definition stated in `units.smul_def`. This definition preserves
 `mul_action` and `distrib_mul_action` structures too.
 
 Additionally, a `mul_action G M` for some group `G` satisfying some additional properties admits a
@@ -25,14 +28,14 @@ namespace units
 /-! ### Action of the units of `M` on a type `α` -/
 
 @[to_additive]
-instance [monoid M] [has_scalar M α] : has_scalar Mˣ α :=
+instance [monoid M] [has_smul M α] : has_smul Mˣ α :=
 { smul := λ m a, (m : M) • a }
 
 @[to_additive]
-lemma smul_def [monoid M] [has_scalar M α] (m : Mˣ) (a : α) :
+lemma smul_def [monoid M] [has_smul M α] (m : Mˣ) (a : α) :
   m • a = (m : M) • a := rfl
 
-@[simp] lemma smul_is_unit [monoid M] [has_scalar M α] {m : M} (hm : is_unit m) (a : α) :
+@[simp] lemma smul_is_unit [monoid M] [has_smul M α] {m : M} (hm : is_unit m) (a : α) :
   hm.unit • a = m • a :=
 rfl
 
@@ -41,7 +44,7 @@ lemma _root_.is_unit.inv_smul [monoid α] {a : α} (h : is_unit a) :
 h.coe_inv_mul
 
 @[to_additive]
-instance [monoid M] [has_scalar M α] [has_faithful_scalar M α] : has_faithful_scalar Mˣ α :=
+instance [monoid M] [has_smul M α] [has_faithful_smul M α] : has_faithful_smul Mˣ α :=
 { eq_of_smul_eq_smul := λ u₁ u₂ h, units.ext $ eq_of_smul_eq_smul h, }
 
 @[to_additive]
@@ -49,23 +52,29 @@ instance [monoid M] [mul_action M α] : mul_action Mˣ α :=
 { one_smul := (one_smul M : _),
   mul_smul := λ m n, mul_smul (m : M) n, }
 
+instance [monoid M] [has_zero α] [smul_zero_class M α] : smul_zero_class Mˣ α :=
+{ smul := (•),
+  smul_zero := λ m, smul_zero m }
+
+instance [monoid M] [add_zero_class α] [distrib_smul M α] : distrib_smul Mˣ α :=
+{ smul_add := λ m, smul_add (m : M) }
+
 instance [monoid M] [add_monoid α] [distrib_mul_action M α] : distrib_mul_action Mˣ α :=
-{ smul_add := λ m, smul_add (m : M),
-  smul_zero := λ m, smul_zero m, }
+{ .. units.distrib_smul }
 
 instance [monoid M] [monoid α] [mul_distrib_mul_action M α] : mul_distrib_mul_action Mˣ α :=
 { smul_mul := λ m, smul_mul' (m : M),
   smul_one := λ m, smul_one m, }
 
-instance smul_comm_class_left [monoid M] [has_scalar M α] [has_scalar N α]
+instance smul_comm_class_left [monoid M] [has_smul M α] [has_smul N α]
   [smul_comm_class M N α] : smul_comm_class Mˣ N α :=
 { smul_comm := λ m n, (smul_comm (m : M) n : _)}
 
-instance smul_comm_class_right [monoid N] [has_scalar M α] [has_scalar N α]
+instance smul_comm_class_right [monoid N] [has_smul M α] [has_smul N α]
   [smul_comm_class M N α] : smul_comm_class M Nˣ α :=
 { smul_comm := λ m n, (smul_comm m (n : N) : _)}
 
-instance [monoid M] [has_scalar M N] [has_scalar M α] [has_scalar N α] [is_scalar_tower M N α] :
+instance [monoid M] [has_smul M N] [has_smul M α] [has_smul N α] [is_scalar_tower M N α] :
   is_scalar_tower Mˣ N α :=
 { smul_assoc := λ m n, (smul_assoc (m : M) n : _)}
 
@@ -99,7 +108,7 @@ instance smul_comm_class' [group G] [group H] [monoid M]
 { smul_comm := λ g h m, units.ext $ smul_comm g h (m : M) }
 
 /-- Transfer `is_scalar_tower G H M` to `is_scalar_tower G H Mˣ` -/
-instance is_scalar_tower' [has_scalar G H] [group G] [group H] [monoid M]
+instance is_scalar_tower' [has_smul G H] [group G] [group H] [monoid M]
   [mul_action G M] [smul_comm_class G M M]
   [mul_action H M] [smul_comm_class H M M]
   [is_scalar_tower G M M] [is_scalar_tower H M M]
@@ -107,8 +116,8 @@ instance is_scalar_tower' [has_scalar G H] [group G] [group H] [monoid M]
 { smul_assoc := λ g h m, units.ext $ smul_assoc g h (m : M) }
 
 /-- Transfer `is_scalar_tower G M α` to `is_scalar_tower G Mˣ α` -/
-instance is_scalar_tower'_left [group G] [monoid M] [mul_action G M] [has_scalar M α]
-  [has_scalar G α] [smul_comm_class G M M] [is_scalar_tower G M M]
+instance is_scalar_tower'_left [group G] [monoid M] [mul_action G M] [has_smul M α]
+  [has_smul G α] [smul_comm_class G M M] [is_scalar_tower G M M]
   [is_scalar_tower G M α] :
   is_scalar_tower G Mˣ α :=
 { smul_assoc := λ g m, (smul_assoc g (m : M) : _)}
diff --git a/src/group_theory/index.lean b/src/group_theory/index.lean
index 79b83b7e5edc4..ce2d7fe11c151 100644
--- a/src/group_theory/index.lean
+++ b/src/group_theory/index.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning
 -/
 
-import group_theory.quotient_group
-import set_theory.cardinal.finite
+import data.finite.card
+import group_theory.finiteness
+import group_theory.group_action.quotient
 
 /-!
 # Index of a Subgroup
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the index of a subgroup, and prove several divisibility properties.
 Several theorems proved in this file are known as Lagrange's theorem.
 
@@ -33,7 +37,7 @@ Several theorems proved in this file are known as Lagrange's theorem.
 
 namespace subgroup
 
-open_locale cardinal
+open_locale big_operators cardinal
 
 variables {G : Type*} [group G] (H K L : subgroup G)
 
@@ -55,8 +59,9 @@ noncomputable def relindex : ℕ :=
 begin
   letI := quotient_group.left_rel H,
   letI := quotient_group.left_rel (H.comap f),
-  have key : ∀ x y : G', setoid.r x y ↔ setoid.r (f x) (f y) :=
-  λ x y, iff_of_eq (congr_arg (∈ H) (by rw [f.map_mul, f.map_inv])),
+  have key : ∀ x y : G', setoid.r x y ↔ setoid.r (f x) (f y),
+  { simp only [quotient_group.left_rel_apply],
+    exact λ x y, iff_of_eq (congr_arg (∈ H) (by rw [f.map_mul, f.map_inv])) },
   refine cardinal.to_nat_congr (equiv.of_bijective (quotient.map' f (λ x y, (key x y).mp)) ⟨_, _⟩),
   { simp_rw [←quotient.eq'] at key,
     refine quotient.ind' (λ x, _),
@@ -72,6 +77,10 @@ end
 eq.trans (congr_arg index (by refl))
   ((H.subgroup_of f.range).index_comap_of_surjective f.range_restrict_surjective)
 
+@[to_additive] lemma relindex_comap {G' : Type*} [group G'] (f : G' →* G) (K : subgroup G') :
+  relindex (comap f H) K = relindex H (map f K) :=
+by rw [relindex, subgroup_of, comap_comap, index_comap, ← f.map_range, K.subtype_range]
+
 variables {H K L}
 
 @[to_additive relindex_mul_index] lemma relindex_mul_index (h : H ≤ K) :
@@ -82,6 +91,9 @@ variables {H K L}
 @[to_additive] lemma index_dvd_of_le (h : H ≤ K) : K.index ∣ H.index :=
 dvd_of_mul_left_eq (H.relindex K) (relindex_mul_index h)
 
+@[to_additive] lemma relindex_dvd_index_of_le (h : H ≤ K) : H.relindex K ∣ H.index :=
+dvd_of_mul_right_eq K.index (relindex_mul_index h)
+
 @[to_additive] lemma relindex_subgroup_of (hKL : K ≤ L) :
   (H.subgroup_of L).relindex (K.subgroup_of L) = H.relindex K :=
 ((index_comap (H.subgroup_of L) (inclusion hKL)).trans (congr_arg _ (inclusion_range hKL))).symm
@@ -96,10 +108,7 @@ begin
 end
 
 @[to_additive] lemma inf_relindex_right : (H ⊓ K).relindex K = H.relindex K :=
-begin
-  rw [←subgroup_of_map_subtype, relindex, relindex, subgroup_of, comap_map_eq_self_of_injective],
-  exact subtype.coe_injective,
-end
+by rw [relindex, relindex, inf_subgroup_of_right]
 
 @[to_additive] lemma inf_relindex_left : (H ⊓ K).relindex H = K.relindex H :=
 by rw [inf_comm, inf_relindex_right]
@@ -109,22 +118,56 @@ lemma relindex_inf_mul_relindex : H.relindex (K ⊓ L) * K.relindex L = (H ⊓ K
 by rw [←inf_relindex_right H (K ⊓ L), ←inf_relindex_right K L, ←inf_relindex_right (H ⊓ K) L,
   inf_assoc, relindex_mul_relindex (H ⊓ (K ⊓ L)) (K ⊓ L) L inf_le_right inf_le_right]
 
-@[to_additive]
-lemma inf_relindex_eq_relindex_sup [K.normal] : (H ⊓ K).relindex H = K.relindex (H ⊔ K) :=
-cardinal.to_nat_congr (quotient_group.quotient_inf_equiv_prod_normal_quotient H K).to_equiv
+@[simp, to_additive]
+lemma relindex_sup_right [K.normal] : K.relindex (H ⊔ K) = K.relindex H  :=
+nat.card_congr (quotient_group.quotient_inf_equiv_prod_normal_quotient H K).to_equiv.symm
 
-@[to_additive] lemma relindex_eq_relindex_sup [K.normal] : K.relindex H = K.relindex (H ⊔ K) :=
-by rw [←inf_relindex_left, inf_relindex_eq_relindex_sup]
+@[simp, to_additive]
+lemma relindex_sup_left [K.normal] : K.relindex (K ⊔ H) = K.relindex H  :=
+by rw [sup_comm, relindex_sup_right]
+
+@[to_additive] lemma relindex_dvd_index_of_normal [H.normal] : H.relindex K ∣ H.index :=
+relindex_sup_right K H ▸ relindex_dvd_index_of_le le_sup_right
 
 variables {H K}
 
 @[to_additive] lemma relindex_dvd_of_le_left (hHK : H ≤ K) : K.relindex L ∣ H.relindex L :=
+inf_of_le_left hHK ▸ dvd_of_mul_left_eq _ (relindex_inf_mul_relindex _ _ _)
+
+/-- A subgroup has index two if and only if there exists `a` such that for all `b`, exactly one
+of `b * a` and `b` belong to `H`. -/
+@[to_additive "/-- An additive subgroup has index two if and only if there exists `a` such that for
+all `b`, exactly one of `b + a` and `b` belong to `H`. -/"]
+lemma index_eq_two_iff : H.index = 2 ↔ ∃ a, ∀ b, xor (b * a ∈ H) (b ∈ H) :=
 begin
-  apply dvd_of_mul_left_eq ((H ⊓ L).relindex (K ⊓ L)),
-  rw [←inf_relindex_right H L, ←inf_relindex_right K L],
-  exact relindex_mul_relindex (H ⊓ L) (K ⊓ L) L (inf_le_inf_right L hHK) inf_le_right,
+  simp only [index, nat.card_eq_two_iff' ((1 : G) : G ⧸ H), exists_unique, inv_mem_iff,
+    quotient_group.exists_coe, quotient_group.forall_coe, ne.def, quotient_group.eq, mul_one,
+    xor_iff_iff_not],
+  refine exists_congr (λ a, ⟨λ ha b, ⟨λ hba hb, _, λ hb, _⟩, λ ha, ⟨_, λ b hb, _⟩⟩),
+  { exact ha.1 ((mul_mem_cancel_left hb).1 hba) },
+  { exact inv_inv b ▸ ha.2 _ (mt inv_mem_iff.1 hb) },
+  { rw [← inv_mem_iff, ← ha, inv_mul_self], exact one_mem _ },
+  { rwa [ha, inv_mem_iff] }
 end
 
+@[to_additive] lemma mul_mem_iff_of_index_two (h : H.index = 2) {a b : G} :
+  a * b ∈ H ↔ (a ∈ H ↔ b ∈ H) :=
+begin
+  by_cases ha : a ∈ H, { simp only [ha, true_iff, mul_mem_cancel_left ha] },
+  by_cases hb : b ∈ H, { simp only [hb, iff_true, mul_mem_cancel_right hb] },
+  simp only [ha, hb, iff_self, iff_true],
+  rcases index_eq_two_iff.1 h with ⟨c, hc⟩,
+  refine (hc _).or.resolve_left _,
+  rwa [mul_assoc, mul_mem_cancel_right ((hc _).or.resolve_right hb)]
+end
+
+@[to_additive] lemma mul_self_mem_of_index_two (h : H.index = 2) (a : G) : a * a ∈ H :=
+by rw [mul_mem_iff_of_index_two h]
+
+@[to_additive two_smul_mem_of_index_two]
+lemma sq_mem_of_index_two (h : H.index = 2) (a : G) : a ^ 2 ∈ H :=
+(pow_two a).symm ▸ mul_self_mem_of_index_two h a
+
 variables (H K)
 
 @[simp, to_additive] lemma index_top : (⊤ : subgroup G).index = 1 :=
@@ -155,10 +198,39 @@ by rw [relindex, subgroup_of_bot_eq_top, index_top]
 @[simp, to_additive] lemma relindex_self : H.relindex H = 1 :=
 by rw [relindex, subgroup_of_self, index_top]
 
+@[to_additive] lemma index_ker {H} [group H] (f : G →* H) :
+  f.ker.index = nat.card (set.range f) :=
+by { rw [← monoid_hom.comap_bot, index_comap, relindex_bot_left], refl }
+
+@[to_additive] lemma relindex_ker {H} [group H] (f : G →* H) (K : subgroup G) :
+  f.ker.relindex K = nat.card (f '' K) :=
+by { rw [← monoid_hom.comap_bot, relindex_comap, relindex_bot_left], refl }
+
 @[simp, to_additive card_mul_index]
 lemma card_mul_index : nat.card H * H.index = nat.card G :=
 by { rw [←relindex_bot_left, ←index_bot], exact relindex_mul_index bot_le }
 
+@[to_additive] lemma nat_card_dvd_of_injective {G H : Type*} [group G] [group H] (f : G →* H)
+  (hf : function.injective f) : nat.card G ∣ nat.card H :=
+begin
+  rw nat.card_congr (monoid_hom.of_injective hf).to_equiv,
+  exact dvd.intro f.range.index f.range.card_mul_index,
+end
+
+@[to_additive] lemma nat_card_dvd_of_le (hHK : H ≤ K) : nat.card H ∣ nat.card K :=
+nat_card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)
+
+@[to_additive] lemma nat_card_dvd_of_surjective {G H : Type*} [group G] [group H] (f : G →* H)
+  (hf : function.surjective f) : nat.card H ∣ nat.card G :=
+begin
+  rw ← nat.card_congr (quotient_group.quotient_ker_equiv_of_surjective f hf).to_equiv,
+  exact dvd.intro_left (nat.card f.ker) f.ker.card_mul_index,
+end
+
+@[to_additive] lemma card_dvd_of_surjective {G H : Type*} [group G] [group H] [fintype G]
+  [fintype H] (f : G →* H) (hf : function.surjective f) : fintype.card H ∣ fintype.card G :=
+by simp only [←nat.card_eq_fintype_card, nat_card_dvd_of_surjective f hf]
+
 @[to_additive] lemma index_map {G' : Type*} [group G'] (f : G →* G') :
   (H.map f).index = (H ⊔ f.ker).index * f.range.index :=
 by rw [←comap_map_eq, index_comap, relindex_mul_index (H.map_le_range f)]
@@ -203,9 +275,10 @@ eq_zero_of_zero_dvd (hKL ▸ (relindex_dvd_of_le_left L hHK))
 
 @[to_additive]
 lemma relindex_eq_zero_of_le_right (hKL : K ≤ L) (hHK : H.relindex K = 0) : H.relindex L = 0 :=
-cardinal.to_nat_apply_of_omega_le (le_trans (le_of_not_lt (λ h, cardinal.mk_ne_zero _
-  ((cardinal.cast_to_nat_of_lt_omega h).symm.trans (cardinal.nat_cast_inj.mpr hHK))))
-    (quotient_subgroup_of_embedding_of_le H hKL).cardinal_le)
+finite.card_eq_zero_of_embedding (quotient_subgroup_of_embedding_of_le H hKL) hHK
+
+@[to_additive] lemma index_eq_zero_of_relindex_eq_zero (h : H.relindex K = 0) : H.index = 0 :=
+H.relindex_top_right.symm.trans (relindex_eq_zero_of_le_right le_top h)
 
 @[to_additive] lemma relindex_le_of_le_left (hHK : H ≤ K) (hHL : H.relindex L ≠ 0) :
   K.relindex L ≤ H.relindex L :=
@@ -213,8 +286,7 @@ nat.le_of_dvd (nat.pos_of_ne_zero hHL) (relindex_dvd_of_le_left L hHK)
 
 @[to_additive] lemma relindex_le_of_le_right (hKL : K ≤ L) (hHL : H.relindex L ≠ 0) :
   H.relindex K ≤ H.relindex L :=
-cardinal.to_nat_le_of_le_of_lt_omega (lt_of_not_ge (mt cardinal.to_nat_apply_of_omega_le hHL))
-  (cardinal.mk_le_of_injective (quotient_subgroup_of_embedding_of_le H hKL).2)
+finite.card_le_of_embedding' (quotient_subgroup_of_embedding_of_le H hKL) (λ h, (hHL h).elim)
 
 @[to_additive] lemma relindex_ne_zero_trans (hHK : H.relindex K ≠ 0) (hKL : K.relindex L ≠ 0) :
   H.relindex L ≠ 0 :=
@@ -248,20 +320,121 @@ end
 @[to_additive] lemma index_inf_le : (H ⊓ K).index ≤ H.index * K.index :=
 by simp_rw [←relindex_top_right, relindex_inf_le]
 
+@[to_additive] lemma relindex_infi_ne_zero {ι : Type*} [hι : finite ι] {f : ι → subgroup G}
+  (hf : ∀ i, (f i).relindex L ≠ 0) : (⨅ i, f i).relindex L ≠ 0 :=
+begin
+  haveI := fintype.of_finite ι,
+  exact finset.prod_ne_zero_iff.mpr (λ i hi, hf i) ∘ nat.card_pi.symm.trans ∘
+    finite.card_eq_zero_of_embedding (quotient_infi_subgroup_of_embedding f L),
+end
+
+@[to_additive] lemma relindex_infi_le {ι : Type*} [fintype ι] (f : ι → subgroup G) :
+  (⨅ i, f i).relindex L ≤ ∏ i, (f i).relindex L :=
+le_of_le_of_eq (finite.card_le_of_embedding' (quotient_infi_subgroup_of_embedding f L)
+  (λ h, let ⟨i, hi, h⟩ := finset.prod_eq_zero_iff.mp (nat.card_pi.symm.trans h) in
+    relindex_eq_zero_of_le_left (infi_le f i) h)) nat.card_pi
+
+@[to_additive] lemma index_infi_ne_zero {ι : Type*} [finite ι] {f : ι → subgroup G}
+  (hf : ∀ i, (f i).index ≠ 0) : (⨅ i, f i).index ≠ 0 :=
+begin
+  simp_rw ← relindex_top_right at hf ⊢,
+  exact relindex_infi_ne_zero hf,
+end
+
+@[to_additive] lemma index_infi_le {ι : Type*} [fintype ι] (f : ι → subgroup G) :
+  (⨅ i, f i).index ≤ ∏ i, (f i).index :=
+by simp_rw [←relindex_top_right, relindex_infi_le]
+
 @[simp, to_additive index_eq_one] lemma index_eq_one : H.index = 1 ↔ H = ⊤ :=
 ⟨λ h, quotient_group.subgroup_eq_top_of_subsingleton H (cardinal.to_nat_eq_one_iff_unique.mp h).1,
   λ h, (congr_arg index h).trans index_top⟩
 
-@[to_additive] lemma index_ne_zero_of_fintype [hH : fintype (G ⧸ H)] : H.index ≠ 0 :=
-by { rw index_eq_card, exact fintype.card_ne_zero }
+@[simp, to_additive relindex_eq_one] lemma relindex_eq_one : H.relindex K = 1 ↔ K ≤ H :=
+index_eq_one.trans subgroup_of_eq_top
+
+@[simp, to_additive card_eq_one] lemma card_eq_one : nat.card H = 1 ↔ H = ⊥ :=
+H.relindex_bot_left ▸ (relindex_eq_one.trans le_bot_iff)
+
+@[to_additive] lemma index_ne_zero_of_finite [hH : finite (G ⧸ H)] : H.index ≠ 0 :=
+by { casesI nonempty_fintype (G ⧸ H), rw index_eq_card, exact fintype.card_ne_zero }
 
 /-- Finite index implies finite quotient. -/
 @[to_additive "Finite index implies finite quotient."]
 noncomputable def fintype_of_index_ne_zero (hH : H.index ≠ 0) : fintype (G ⧸ H) :=
-(cardinal.lt_omega_iff_fintype.mp (lt_of_not_ge (mt cardinal.to_nat_apply_of_omega_le hH))).some
+(cardinal.lt_aleph_0_iff_fintype.mp (lt_of_not_ge (mt cardinal.to_nat_apply_of_aleph_0_le hH))).some
 
 @[to_additive one_lt_index_of_ne_top]
-lemma one_lt_index_of_ne_top [fintype (G ⧸ H)] (hH : H ≠ ⊤) : 1 < H.index :=
-nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨index_ne_zero_of_fintype, mt index_eq_one.mp hH⟩
+lemma one_lt_index_of_ne_top [finite (G ⧸ H)] (hH : H ≠ ⊤) : 1 < H.index :=
+nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨index_ne_zero_of_finite, mt index_eq_one.mp hH⟩
+
+section finite_index
+
+variables (H K)
+
+/-- Typeclass for finite index subgroups. -/
+class finite_index : Prop :=
+(finite_index : H.index ≠ 0)
+
+/-- Typeclass for finite index subgroups. -/
+class _root_.add_subgroup.finite_index {G : Type*} [add_group G] (H : add_subgroup G) : Prop :=
+(finite_index : H.index ≠ 0)
+
+/-- A finite index subgroup has finite quotient. -/
+@[to_additive "A finite index subgroup has finite quotient"]
+noncomputable def fintype_quotient_of_finite_index [finite_index H] :
+  fintype (G ⧸ H) :=
+fintype_of_index_ne_zero finite_index.finite_index
+
+@[to_additive] instance finite_quotient_of_finite_index
+  [finite_index H] : finite (G ⧸ H) :=
+H.fintype_quotient_of_finite_index.finite
+
+@[to_additive] lemma finite_index_of_finite_quotient [finite (G ⧸ H)] : finite_index H :=
+⟨index_ne_zero_of_finite⟩
+
+@[priority 100, to_additive] instance finite_index_of_finite [finite G] : finite_index H :=
+finite_index_of_finite_quotient H
+
+@[to_additive] instance : finite_index (⊤ : subgroup G) :=
+⟨ne_of_eq_of_ne index_top one_ne_zero⟩
+
+@[to_additive] instance [finite_index H] [finite_index K] : finite_index (H ⊓ K) :=
+⟨index_inf_ne_zero finite_index.finite_index finite_index.finite_index⟩
+
+variables {H K}
+
+@[to_additive] lemma finite_index_of_le [finite_index H] (h : H ≤ K) : finite_index K :=
+⟨ne_zero_of_dvd_ne_zero finite_index.finite_index (index_dvd_of_le h)⟩
+
+variables (H K)
+
+@[to_additive] instance finite_index_ker {G' : Type*} [group G'] (f : G →* G') [finite f.range] :
+  f.ker.finite_index :=
+@finite_index_of_finite_quotient G _ f.ker
+  (finite.of_equiv f.range (quotient_group.quotient_ker_equiv_range f).symm)
+
+instance finite_index_normal_core [H.finite_index] : H.normal_core.finite_index :=
+begin
+  rw normal_core_eq_ker,
+  apply_instance,
+end
+
+variables (G)
+
+instance finite_index_center [finite (commutator_set G)] [group.fg G] : finite_index (center G) :=
+begin
+  obtain ⟨S, -, hS⟩ := group.rank_spec G,
+  exact ⟨mt (finite.card_eq_zero_of_embedding (quotient_center_embedding hS)) finite.card_pos.ne'⟩,
+end
+
+lemma index_center_le_pow [finite (commutator_set G)] [group.fg G] :
+  (center G).index ≤ (nat.card (commutator_set G)) ^ group.rank G :=
+begin
+  obtain ⟨S, hS1, hS2⟩ := group.rank_spec G,
+  rw [←hS1, ←fintype.card_coe, ←nat.card_eq_fintype_card, ←finset.coe_sort_coe, ←nat.card_fun],
+  exact finite.card_le_of_embedding (quotient_center_embedding hS2),
+end
+
+end finite_index
 
 end subgroup
diff --git a/src/group_theory/is_free_group.lean b/src/group_theory/is_free_group.lean
index 528ee7e69965d..182863cda9e11 100644
--- a/src/group_theory/is_free_group.lean
+++ b/src/group_theory/is_free_group.lean
@@ -7,6 +7,9 @@ import group_theory.free_group
 /-!
 # Free groups structures on arbitrary types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a type class for type that are free groups, together with the usual operations.
 The type class can be instantiated by providing an isomorphim to the canonical free group, or by
 proving that the universal property holds.
diff --git a/src/group_theory/monoid_localization.lean b/src/group_theory/monoid_localization.lean
index 3b374a52e6ee8..3890cdfbe8f28 100644
--- a/src/group_theory/monoid_localization.lean
+++ b/src/group_theory/monoid_localization.lean
@@ -10,6 +10,9 @@ import algebra.group.units
 /-!
 # Localizations of commutative monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Localizing a commutative ring at one of its submonoids does not rely on the ring's addition, so
 we can generalize localizations to commutative monoids.
 
@@ -38,6 +41,9 @@ This defines the localization as a quotient type, `localization`, but the majori
 subsequent lemmas in the file are given in terms of localizations up to isomorphism, using maps
 which satisfy the characteristic predicate.
 
+The Grothendieck group construction corresponds to localizing at the top submonoid, namely making
+every element invertible.
+
 ## Implementation notes
 
 In maths it is natural to reason up to isomorphism, but in Lean we cannot naturally `rewrite` one
@@ -58,21 +64,30 @@ localization as a quotient type satisfies the characteristic predicate). The lem
 `mk_eq_monoid_of_mk'` hence gives you access to the results in the rest of the file, which are
 about the `localization_map.mk'` induced by any localization map.
 
+## TODO
+
+* Show that the localization at the top monoid is a group.
+* Generalise to (nonempty) subsemigroups.
+* If we acquire more bundlings, we can make `localization.mk_order_embedding` be an ordered monoid
+  embedding.
+
 ## Tags
 localization, monoid localization, quotient monoid, congruence relation, characteristic predicate,
-commutative monoid
+commutative monoid, grothendieck group
 -/
 
+open function
+
 namespace add_submonoid
 variables {M : Type*} [add_comm_monoid M] (S : add_submonoid M) (N : Type*) [add_comm_monoid N]
 
 /-- The type of add_monoid homomorphisms satisfying the characteristic predicate: if `f : M →+ N`
 satisfies this predicate, then `N` is isomorphic to the localization of `M` at `S`. -/
-@[nolint has_inhabited_instance] structure localization_map
+@[nolint has_nonempty_instance] structure localization_map
   extends add_monoid_hom M N :=
 (map_add_units' : ∀ y : S, is_add_unit (to_fun y))
 (surj' : ∀ z : N, ∃ x : M × S, z + to_fun x.2 = to_fun x.1)
-(eq_iff_exists' : ∀ x y, to_fun x = to_fun y ↔ ∃ c : S, x + c = y + c)
+(eq_iff_exists' : ∀ x y, to_fun x = to_fun y ↔ ∃ c : S, ↑c + x = ↑c + y)
 
 /-- The add_monoid hom underlying a `localization_map` of `add_comm_monoid`s. -/
 add_decl_doc localization_map.to_add_monoid_hom
@@ -88,11 +103,11 @@ namespace submonoid
 
 /-- The type of monoid homomorphisms satisfying the characteristic predicate: if `f : M →* N`
 satisfies this predicate, then `N` is isomorphic to the localization of `M` at `S`. -/
-@[nolint has_inhabited_instance] structure localization_map
+@[nolint has_nonempty_instance] structure localization_map
 extends monoid_hom M N :=
 (map_units' : ∀ y : S, is_unit (to_fun y))
 (surj' : ∀ z : N, ∃ x : M × S, z * to_fun x.2 = to_fun x.1)
-(eq_iff_exists' : ∀ x y, to_fun x = to_fun y ↔ ∃ c : S, x * c = y * c)
+(eq_iff_exists' : ∀ x y, to_fun x = to_fun y ↔ ∃ c : S, ↑c * x = c * y)
 
 attribute [to_additive add_submonoid.localization_map] submonoid.localization_map
 attribute [to_additive add_submonoid.localization_map.to_add_monoid_hom]
@@ -124,20 +139,21 @@ submonoid of `M`, whose quotient is the localization of `M` at `S`. -/
 `S` a submonoid of `M`, whose quotient is the localization of `M` at `S`."]
 def r' : con (M × S) :=
 begin
-  refine { r := λ a b : M × S, ∃ c : S, a.1 * b.2 * c = b.1 * a.2 * c,
+  -- note we multiply by `c` on the left so that we can later generalize to `•`
+  refine { r := λ a b : M × S, ∃ c : S, ↑c * (↑b.2 * a.1) = c * (a.2 * b.1),
     iseqv := ⟨λ a, ⟨1, rfl⟩, λ a b ⟨c, hc⟩, ⟨c, hc.symm⟩, _⟩,
     .. },
   { rintros a b c ⟨t₁, ht₁⟩ ⟨t₂, ht₂⟩,
-    use b.2 * t₁ * t₂,
+    use t₂ * t₁ * b.2,
     simp only [submonoid.coe_mul],
-    calc a.1 * c.2 * (b.2 * t₁ * t₂) = a.1 * b.2 * t₁ * c.2 * t₂ : by ac_refl
-    ... = b.1 * c.2 * t₂ * a.2 * t₁ : by { rw ht₁, ac_refl }
-    ... = c.1 * a.2 * (b.2 * t₁ * t₂) : by { rw ht₂, ac_refl } },
+    calc (t₂ * t₁ * b.2 : M) * (c.2 * a.1) = t₂ * c.2 * (t₁ * (b.2 * a.1)) : by ac_refl
+    ... = t₁ * a.2 * (t₂ * (c.2 * b.1)) : by { rw ht₁, ac_refl }
+    ... = t₂ * t₁ * b.2 * (a.2 * c.1) : by { rw ht₂, ac_refl } },
   { rintros a b c d ⟨t₁, ht₁⟩ ⟨t₂, ht₂⟩,
-    use t₁ * t₂,
-    calc (a.1 * c.1) * (b.2 * d.2) * (t₁ * t₂) = (a.1 * b.2 * t₁) * (c.1 * d.2 * t₂) :
+    use t₂ * t₁,
+    calc (t₂ * t₁ : M) * ((b.2 * d.2) * (a.1 * c.1)) = (t₂ * (d.2 * c.1)) * (t₁ * (b.2 * a.1)) :
       by ac_refl
-    ... = (b.1 * d.1) * (a.2 * c.2) * (t₁ * t₂) : by { rw [ht₁, ht₂], ac_refl } }
+    ... = (t₂ * t₁ : M) * ((a.2 * c.2) * (b.1 * d.1)) : by { rw [ht₁, ht₂], ac_refl } }
 end
 
 /-- The congruence relation used to localize a `comm_monoid` at a submonoid can be expressed
@@ -148,19 +164,19 @@ submonoid can be expressed equivalently as an infimum (see `add_localization.r`)
 explicitly (see `add_localization.r'`)."]
 theorem r_eq_r' : r S = r' S :=
 le_antisymm (Inf_le $ λ _, ⟨1, by simp⟩) $
-  le_Inf $ λ b H ⟨p, q⟩ y ⟨t, ht⟩,
+  le_Inf $ λ b H ⟨p, q⟩ ⟨x, y⟩ ⟨t, ht⟩,
     begin
-      rw [← mul_one (p, q), ← mul_one y],
-      refine b.trans (b.mul (b.refl _) (H (y.2 * t))) _,
-      convert b.symm (b.mul (b.refl y) (H (q * t))) using 1,
-      rw [prod.mk_mul_mk, submonoid.coe_mul, ← mul_assoc, ht, mul_left_comm, mul_assoc],
-      refl
+      rw [← one_mul (p, q), ← one_mul (x, y)],
+      refine b.trans (b.mul (H (t * y)) (b.refl _)) _,
+      convert b.symm (b.mul (H (t * q)) (b.refl (x, y))) using 1,
+      dsimp only [prod.mk_mul_mk, submonoid.coe_mul] at ⊢ ht,
+      simp_rw [mul_assoc, ht, mul_comm y q],
     end
 
 variables {S}
 
 @[to_additive]
-lemma r_iff_exists {x y : M × S} : r S x y ↔ ∃ c : S, x.1 * y.2 * c = y.1 * x.2 * c :=
+lemma r_iff_exists {x y : M × S} : r S x y ↔ ∃ c : S, ↑c * (↑y.2 * x.1) = c * (x.2 * y.1) :=
 by rw r_eq_r' S; refl
 
 end localization
@@ -241,11 +257,11 @@ def mk (x : M) (y : S) : localization S := (r S).mk' (x, y)
 universes u
 
 /-- Dependent recursion principle for localizations: given elements `f a b : p (mk a b)`
-for all `a b`, such that `r S (a, b) (c, d)` implies `f a b = f c d` (wih the correct coercions),
+for all `a b`, such that `r S (a, b) (c, d)` implies `f a b = f c d` (with the correct coercions),
 then `f` is defined on the whole `localization S`. -/
 @[elab_as_eliminator, to_additive
-"Dependent recursion principle for `add_localizations`: given elements `f a b : p (mk a b)`
-for all `a b`, such that `r S (a, b) (c, d)` implies `f a b = f c d` (wih the correct coercions),
+"Dependent recursion principle for `add_localization`s: given elements `f a b : p (mk a b)`
+for all `a b`, such that `r S (a, b) (c, d)` implies `f a b = f c d` (with the correct coercions),
 then `f` is defined on the whole `add_localization S`."]
 def rec {p : localization S → Sort u}
   (f : ∀ (a : M) (b : S), p (mk a b))
@@ -255,6 +271,16 @@ def rec {p : localization S → Sort u}
 quot.rec (λ y, eq.rec (f y.1 y.2) (prod.mk.eta : (y.1, y.2) = y))
   (λ y z h, by { cases y, cases z, exact H h }) x
 
+/-- Copy of `quotient.rec_on_subsingleton₂` for `localization` -/
+@[elab_as_eliminator, to_additive "Copy of `quotient.rec_on_subsingleton₂` for `add_localization`"]
+def rec_on_subsingleton₂ {r : localization S → localization S → Sort u}
+  [h : ∀ (a c : M) (b d : S), subsingleton (r (mk a b) (mk c d))]
+  (x y : localization S)
+  (f : Π (a c : M) (b d : S), r (mk a b) (mk c d)) : r x y :=
+@quotient.rec_on_subsingleton₂' _ _ _ _ r
+  (prod.rec $ by exact λ _ _, prod.rec $ by exact λ _ _, h _ _ _ _) x y
+  (prod.rec $ by exact λ _ _, prod.rec $ by exact λ _ _, f _ _ _ _)
+
 attribute [irreducible] localization
 
 @[to_additive] lemma mk_mul (a c : M) (b d : S) : mk a b * mk c d = mk (a * c) (b * d) := rfl
@@ -323,7 +349,7 @@ induction_on₂ x y $ λ x y, induction_on z $ H x y
 
 @[to_additive] lemma one_rel (y : S) : r S 1 (y, y) := λ b hb, hb y
 
-@[to_additive] theorem r_of_eq {x y : M × S} (h : y.1 * x.2 = x.1 * y.2) : r S x y :=
+@[to_additive] theorem r_of_eq {x y : M × S} (h : ↑y.2 * x.1 = ↑x.2 * y.1) : r S x y :=
 r_iff_exists.2 ⟨1, by rw h⟩
 
 @[to_additive] lemma mk_self (a : S) : mk (a : M) a = 1 :=
@@ -334,7 +360,7 @@ section scalar
 variables {R R₁ R₂ : Type*}
 
 /-- Scalar multiplication in a monoid localization is defined as `c • ⟨a, b⟩ = ⟨c • a, b⟩`. -/
-@[irreducible] protected def smul [has_scalar R M] [is_scalar_tower R M M]
+@[irreducible] protected def smul [has_smul R M] [is_scalar_tower R M M]
   (c : R) (z : localization S) : localization S :=
 localization.lift_on z (λ a b, mk (c • a) b) $
   λ a a' b b' h, mk_eq_mk_iff.2
@@ -344,40 +370,45 @@ begin
   rw r_eq_r' at h ⊢,
   cases h with t ht,
   use t,
-  simp only [smul_mul_assoc, ht]
+  dsimp only [subtype.coe_mk] at ht ⊢,
+  -- TODO: this definition should take `smul_comm_class R M M` instead of `is_scalar_tower R M M` if
+  -- we ever want to generalize to the non-commutative case.
+  haveI : smul_comm_class R M M :=
+    ⟨λ r m₁ m₂, by simp_rw [smul_eq_mul, mul_comm m₁, smul_mul_assoc]⟩,
+  simp only [mul_smul_comm, ht],
 end
 
-instance [has_scalar R M] [is_scalar_tower R M M] :
-  has_scalar R (localization S) :=
+instance [has_smul R M] [is_scalar_tower R M M] :
+  has_smul R (localization S) :=
 { smul := localization.smul }
 
-lemma smul_mk [has_scalar R M] [is_scalar_tower R M M] (c : R) (a b) :
+lemma smul_mk [has_smul R M] [is_scalar_tower R M M] (c : R) (a b) :
   c • (mk a b : localization S) = mk (c • a) b :=
-by { unfold has_scalar.smul localization.smul, apply lift_on_mk }
+by { unfold has_smul.smul localization.smul, apply lift_on_mk }
 
-instance [has_scalar R₁ M] [has_scalar R₂ M] [is_scalar_tower R₁ M M] [is_scalar_tower R₂ M M]
+instance [has_smul R₁ M] [has_smul R₂ M] [is_scalar_tower R₁ M M] [is_scalar_tower R₂ M M]
   [smul_comm_class R₁ R₂ M] : smul_comm_class R₁ R₂ (localization S) :=
 { smul_comm := λ s t, localization.ind $ prod.rec $ by exact λ r x,
     by simp only [smul_mk, smul_comm s t r] }
 
-instance [has_scalar R₁ M] [has_scalar R₂ M] [is_scalar_tower R₁ M M] [is_scalar_tower R₂ M M]
-  [has_scalar R₁ R₂] [is_scalar_tower R₁ R₂ M] : is_scalar_tower R₁ R₂ (localization S) :=
+instance [has_smul R₁ M] [has_smul R₂ M] [is_scalar_tower R₁ M M] [is_scalar_tower R₂ M M]
+  [has_smul R₁ R₂] [is_scalar_tower R₁ R₂ M] : is_scalar_tower R₁ R₂ (localization S) :=
 { smul_assoc := λ s t, localization.ind $ prod.rec $ by exact λ r x,
     by simp only [smul_mk, smul_assoc s t r] }
 
-instance smul_comm_class_right {R : Type*} [has_scalar R M] [is_scalar_tower R M M] :
+instance smul_comm_class_right {R : Type*} [has_smul R M] [is_scalar_tower R M M] :
   smul_comm_class R (localization S) (localization S) :=
 { smul_comm := λ s, localization.ind $ prod.rec $ by exact λ r₁ x₁,
                     localization.ind $ prod.rec $ by exact λ r₂ x₂,
     by simp only [smul_mk, smul_eq_mul, mk_mul, mul_comm r₁, smul_mul_assoc] }
 
-instance is_scalar_tower_right {R : Type*} [has_scalar R M] [is_scalar_tower R M M] :
+instance is_scalar_tower_right {R : Type*} [has_smul R M] [is_scalar_tower R M M] :
   is_scalar_tower R (localization S) (localization S) :=
 { smul_assoc := λ s, localization.ind $ prod.rec $ by exact λ r₁ x₁,
                      localization.ind $ prod.rec $ by exact λ r₂ x₂,
     by simp only [smul_mk, smul_eq_mul, mk_mul, smul_mul_assoc] }
 
-instance [has_scalar R M] [has_scalar Rᵐᵒᵖ M]  [is_scalar_tower R M M] [is_scalar_tower Rᵐᵒᵖ M M]
+instance [has_smul R M] [has_smul Rᵐᵒᵖ M]  [is_scalar_tower R M M] [is_scalar_tower Rᵐᵒᵖ M M]
   [is_central_scalar R M] : is_central_scalar R (localization S) :=
 { op_smul_eq_smul := λ s, localization.ind $ prod.rec $ by exact λ r x,
     by simp only [smul_mk, op_smul_eq_smul] }
@@ -406,7 +437,7 @@ namespace monoid_hom
 @[to_additive "Makes a localization map from an `add_comm_monoid` hom satisfying the characteristic
 predicate."]
 def to_localization_map (f : M →* N) (H1 : ∀ y : S, is_unit (f y))
-  (H2 : ∀ z, ∃ x : M × S, z * f x.2 = f x.1) (H3 : ∀ x y, f x = f y ↔ ∃ c : S, x * c = y * c) :
+  (H2 : ∀ z, ∃ x : M × S, z * f x.2 = f x.1) (H3 : ∀ x y, f x = f y ↔ ∃ c : S, ↑c * x = ↑c * y) :
   submonoid.localization_map S N :=
 { map_units' := H1,
   surj' := H2,
@@ -440,7 +471,7 @@ by { rcases f with ⟨⟨⟩⟩, rcases g with ⟨⟨⟩⟩, simp only, exact fu
   ∃ x : M × S, z * f.to_map x.2 = f.to_map x.1 := f.3 z
 
 @[to_additive] lemma eq_iff_exists (f : localization_map S N) {x y} :
-  f.to_map x = f.to_map y ↔ ∃ c : S, x * c = y * c := f.4 x y
+  f.to_map x = f.to_map y ↔ ∃ c : S, ↑c * x = c * y := f.4 x y
 
 /-- Given a localization map `f : M →* N`, a section function sending `z : N` to some
 `(x, y) : M × S` such that `f x * (f y)⁻¹ = z`. -/
@@ -462,16 +493,16 @@ by rw [mul_comm, sec_spec]
 @[to_additive "Given an add_monoid hom `f : M →+ N` and submonoid `S ⊆ M` such that
 `f(S) ⊆ add_units N`, for all `w : M, z : N` and `y ∈ S`, we have `w - f y = z ↔ w = f y + z`."]
 lemma mul_inv_left {f : M →* N} (h : ∀ y : S, is_unit (f y))
-  (y : S) (w z) : w * ↑(is_unit.lift_right (f.mrestrict S) h y)⁻¹ = z ↔ w = f y * z :=
+  (y : S) (w z) : w * ↑(is_unit.lift_right (f.restrict S) h y)⁻¹ = z ↔ w = f y * z :=
 by rw mul_comm; convert units.inv_mul_eq_iff_eq_mul _;
-  exact (is_unit.coe_lift_right (f.mrestrict S) h _).symm
+  exact (is_unit.coe_lift_right (f.restrict S) h _).symm
 
 /-- Given a monoid hom `f : M →* N` and submonoid `S ⊆ M` such that `f(S) ⊆ Nˣ`, for all
 `w : M, z : N` and `y ∈ S`, we have `z = w * (f y)⁻¹ ↔ z * f y = w`. -/
 @[to_additive "Given an add_monoid hom `f : M →+ N` and submonoid `S ⊆ M` such that
 `f(S) ⊆ add_units N`, for all `w : M, z : N` and `y ∈ S`, we have `z = w - f y ↔ z + f y = w`."]
 lemma mul_inv_right {f : M →* N} (h : ∀ y : S, is_unit (f y))
-  (y : S) (w z) : z = w * ↑(is_unit.lift_right (f.mrestrict S) h y)⁻¹ ↔ z * f y = w :=
+  (y : S) (w z) : z = w * ↑(is_unit.lift_right (f.restrict S) h y)⁻¹ ↔ z * f y = w :=
 by rw [eq_comm, mul_inv_left h, mul_comm, eq_comm]
 
 /-- Given a monoid hom `f : M →* N` and submonoid `S ⊆ M` such that
@@ -481,8 +512,8 @@ by rw [eq_comm, mul_inv_left h, mul_comm, eq_comm]
 `f(S) ⊆ add_units N`, for all `x₁ x₂ : M` and `y₁, y₂ ∈ S`, we have
 `f x₁ - f y₁ = f x₂ - f y₂ ↔ f (x₁ + y₂) = f (x₂ + y₁)`."]
 lemma mul_inv {f : M →* N} (h : ∀ y : S, is_unit (f y)) {x₁ x₂} {y₁ y₂ : S} :
-  f x₁ * ↑(is_unit.lift_right (f.mrestrict S) h y₁)⁻¹ =
-    f x₂ * ↑(is_unit.lift_right (f.mrestrict S) h y₂)⁻¹ ↔ f (x₁ * y₂) = f (x₂ * y₁) :=
+  f x₁ * ↑(is_unit.lift_right (f.restrict S) h y₁)⁻¹ =
+    f x₂ * ↑(is_unit.lift_right (f.restrict S) h y₂)⁻¹ ↔ f (x₁ * y₂) = f (x₂ * y₁) :=
 by rw [mul_inv_right h, mul_assoc, mul_comm _ (f y₂), ←mul_assoc, mul_inv_left h, mul_comm x₂,
   f.map_mul, f.map_mul]
 
@@ -491,17 +522,17 @@ by rw [mul_inv_right h, mul_assoc, mul_comm _ (f y₂), ←mul_assoc, mul_inv_le
 @[to_additive "Given an add_monoid hom `f : M →+ N` and submonoid `S ⊆ M` such that
 `f(S) ⊆ add_units N`, for all `y, z ∈ S`, we have `- (f y) = - (f z) → f y = f z`."]
 lemma inv_inj {f : M →* N} (hf : ∀ y : S, is_unit (f y)) {y z}
-  (h : (is_unit.lift_right (f.mrestrict S) hf y)⁻¹ = (is_unit.lift_right (f.mrestrict S) hf z)⁻¹) :
+  (h : (is_unit.lift_right (f.restrict S) hf y)⁻¹ = (is_unit.lift_right (f.restrict S) hf z)⁻¹) :
   f y = f z :=
 by rw [←mul_one (f y), eq_comm, ←mul_inv_left hf y (f z) 1, h];
-  convert units.inv_mul _; exact (is_unit.coe_lift_right (f.mrestrict S) hf _).symm
+  convert units.inv_mul _; exact (is_unit.coe_lift_right (f.restrict S) hf _).symm
 
 /-- Given a monoid hom `f : M →* N` and submonoid `S ⊆ M` such that `f(S) ⊆ Nˣ`, for all
 `y ∈ S`, `(f y)⁻¹` is unique. -/
 @[to_additive "Given an add_monoid hom `f : M →+ N` and submonoid `S ⊆ M` such that
 `f(S) ⊆ add_units N`, for all `y ∈ S`, `- (f y)` is unique."]
 lemma inv_unique {f : M →* N} (h : ∀ y : S, is_unit (f y)) {y : S}
-  {z} (H : f y * z = 1) : ↑(is_unit.lift_right (f.mrestrict S) h y)⁻¹ = z :=
+  {z} (H : f y * z = 1) : ↑(is_unit.lift_right (f.restrict S) h y)⁻¹ = z :=
 by rw [←one_mul ↑(_)⁻¹, mul_inv_left, ←H]
 
 variables (f : localization_map S N)
@@ -524,7 +555,7 @@ f.map_right_cancel $ by rw [mul_comm _ x, mul_comm _ y, h]
 @[to_additive "Given a localization map `f : M →+ N`, the surjection sending `(x, y) : M × S`
 to `f x - f y`."]
 noncomputable def mk' (f : localization_map S N) (x : M) (y : S) : N :=
-f.to_map x * ↑(is_unit.lift_right (f.to_map.mrestrict S) f.map_units y)⁻¹
+f.to_map x * ↑(is_unit.lift_right (f.to_map.restrict S) f.map_units y)⁻¹
 
 @[to_additive] lemma mk'_mul (x₁ x₂ : M) (y₁ y₂ : S) :
   f.mk' (x₁ * x₂) (y₁ * y₂) = f.mk' x₁ y₁ * f.mk' x₂ y₂ :=
@@ -565,14 +596,18 @@ by rw [mul_comm, mk'_spec]
 by rw [eq_comm, eq_mk'_iff_mul_eq, eq_comm]
 
 @[to_additive] lemma mk'_eq_iff_eq {x₁ x₂} {y₁ y₂ : S} :
-  f.mk' x₁ y₁ = f.mk' x₂ y₂ ↔ f.to_map (x₁ * y₂) = f.to_map (x₂ * y₁) :=
-⟨λ H, by rw [f.to_map.map_mul, f.mk'_eq_iff_eq_mul.1 H, mul_assoc,
-  mul_comm (f.to_map _), ←mul_assoc, mk'_spec, f.to_map.map_mul],
+  f.mk' x₁ y₁ = f.mk' x₂ y₂ ↔ f.to_map (y₂ * x₁) = f.to_map (y₁ * x₂) :=
+⟨λ H, by rw [f.to_map.map_mul,  f.to_map.map_mul, f.mk'_eq_iff_eq_mul.1 H, ←mul_assoc, mk'_spec',
+  mul_comm],
  λ H, by rw [mk'_eq_iff_eq_mul, mk', mul_assoc, mul_comm _ (f.to_map y₁), ←mul_assoc,
-  ←f.to_map.map_mul, ←H, f.to_map.map_mul, mul_inv_right f.map_units]⟩
+  ←f.to_map.map_mul, mul_comm x₂, ←H, ←mul_comm x₁, f.to_map.map_mul, mul_inv_right f.map_units]⟩
+
+@[to_additive] lemma mk'_eq_iff_eq' {x₁ x₂} {y₁ y₂ : S} :
+  f.mk' x₁ y₁ = f.mk' x₂ y₂ ↔ f.to_map (x₁ * y₂) = f.to_map (x₂ * y₁) :=
+by simp only [f.mk'_eq_iff_eq, mul_comm]
 
 @[to_additive] protected lemma eq {a₁ b₁} {a₂ b₂ : S} :
-  f.mk' a₁ a₂ = f.mk' b₁ b₂ ↔ ∃ c : S, a₁ * b₂ * c = b₁ * a₂ * c :=
+  f.mk' a₁ a₂ = f.mk' b₁ b₂ ↔ ∃ c : S, ↑c * (↑b₂ * a₁) = c * (a₂ * b₁) :=
 f.mk'_eq_iff_eq.trans $ f.eq_iff_exists
 
 @[to_additive] protected lemma eq' {a₁ b₁} {a₂ b₂ : S} :
@@ -594,13 +629,17 @@ such that `x₁ * y₂ * c = x₂ * y₁ * c`. -/
 and `y₁ ∈ S`, if `x₂ : M, y₂ ∈ S` are such that `(f x₁ - f y₁) + f y₂ = f x₂`, then there exists
 `c ∈ S` such that `x₁ + y₂ + c = x₂ + y₁ + c`."]
 lemma exists_of_sec_mk' (x) (y : S) :
-  ∃ c : S, x * (f.sec $ f.mk' x y).2 * c = (f.sec $ f.mk' x y).1 * y * c :=
+  ∃ c : S, ↑c * (↑(f.sec $ f.mk' x y).2 * x) = c * (y * (f.sec $ f.mk' x y).1) :=
 f.eq_iff_exists.1 $ f.mk'_eq_iff_eq.1 $ (mk'_sec _ _).symm
 
-@[to_additive] lemma mk'_eq_of_eq {a₁ b₁ : M} {a₂ b₂ : S} (H : b₁ * a₂ = a₁ * b₂) :
+@[to_additive] lemma mk'_eq_of_eq {a₁ b₁ : M} {a₂ b₂ : S} (H : ↑a₂ * b₁ = ↑b₂ * a₁) :
   f.mk' a₁ a₂ = f.mk' b₁ b₂ :=
 f.mk'_eq_iff_eq.2 $ H ▸ rfl
 
+@[to_additive] lemma mk'_eq_of_eq' {a₁ b₁ : M} {a₂ b₂ : S} (H : b₁ * ↑a₂ = a₁ * ↑b₂) :
+  f.mk' a₁ a₂ = f.mk' b₁ b₂ :=
+f.mk'_eq_of_eq $ by simpa only [mul_comm] using H
+
 @[simp, to_additive] lemma mk'_self' (y : S) :
   f.mk' (y : M) y = 1 :=
 show _ * _ = _, by rw [mul_inv_left, mul_one]
@@ -631,9 +670,9 @@ by rw [mul_comm, mk'_mul_cancel_right]
 
 @[to_additive] lemma is_unit_comp (j : N →* P) (y : S) :
   is_unit (j.comp f.to_map y) :=
-⟨units.map j $ is_unit.lift_right (f.to_map.mrestrict S) f.map_units y,
+⟨units.map j $ is_unit.lift_right (f.to_map.restrict S) f.map_units y,
   show j _ = j _, from congr_arg j $
-    (is_unit.coe_lift_right (f.to_map.mrestrict S) f.map_units _)⟩
+    (is_unit.coe_lift_right (f.to_map.restrict S) f.map_units _)⟩
 
 variables {g : M →* P}
 
@@ -646,9 +685,9 @@ lemma eq_of_eq (hg : ∀ y : S, is_unit (g y)) {x y} (h : f.to_map x = f.to_map
   g x = g y :=
 begin
   obtain ⟨c, hc⟩ := f.eq_iff_exists.1 h,
-  rw [←mul_one (g x), ←is_unit.mul_lift_right_inv (g.mrestrict S) hg c],
-  show _ * (g c * _) = _,
-  rw [←mul_assoc, ←g.map_mul, hc, mul_inv_left hg, g.map_mul, mul_comm],
+  rw [←one_mul (g x), ←is_unit.lift_right_inv_mul (g.restrict S) hg c],
+  show (_ * g c) * _ = _,
+  rw [mul_assoc, ←g.map_mul, hc, mul_comm, mul_inv_left hg, g.map_mul],
 end
 
 /-- Given `comm_monoid`s `M, P`, localization maps `f : M →* N, k : P →* Q` for submonoids
@@ -673,7 +712,7 @@ of `add_comm_monoid`s `g : M →+ P` such that `g y` is invertible for all `y :
 induced from `N` to `P` sending `z : N` to `g x - g y`, where `(x, y) : M × S` are such that
 `z = f x - f y`."]
 noncomputable def lift : N →* P :=
-{ to_fun := λ z, g (f.sec z).1 * ↑(is_unit.lift_right (g.mrestrict S) hg (f.sec z).2)⁻¹,
+{ to_fun := λ z, g (f.sec z).1 * ↑(is_unit.lift_right (g.restrict S) hg (f.sec z).2)⁻¹,
   map_one' := by rw [mul_inv_left, mul_one]; exact f.eq_of_eq hg
     (by rw [←sec_spec, one_mul]),
   map_mul' := λ x y,
@@ -693,7 +732,7 @@ variables {S g}
 of `add_comm_monoid`s `g : M →+ P` such that `g y` is invertible for all `y : S`, the homomorphism
 induced from `N` to `P` maps `f x - f y` to `g x - g y` for all `x : M, y ∈ S`."]
 lemma lift_mk' (x y) :
-  f.lift hg (f.mk' x y) = g x * ↑(is_unit.lift_right (g.mrestrict S) hg y)⁻¹ :=
+  f.lift hg (f.mk' x y) = g x * ↑(is_unit.lift_right (g.restrict S) hg y)⁻¹ :=
 (mul_inv hg).2 $ f.eq_of_eq hg $ by
   rw [f.to_map.map_mul, f.to_map.map_mul, sec_spec', mul_assoc, f.mk'_spec, mul_comm]
 
@@ -818,7 +857,7 @@ begin
     obtain ⟨x, hx⟩ := f.surj z,
     use x,
     rw [←hz, f.eq_mk'_iff_mul_eq.2 hx, lift_mk', mul_assoc, mul_comm _ (g ↑x.2)],
-    erw [is_unit.mul_lift_right_inv (g.mrestrict S) hg, mul_one] },
+    erw [is_unit.mul_lift_right_inv (g.restrict S) hg, mul_one] },
   { intros H v,
     obtain ⟨x, hx⟩ := H v,
     use f.mk' x.1 x.2,
@@ -1212,7 +1251,7 @@ def monoid_of : submonoid.localization_map S (localization S) :=
   surj' := λ z, induction_on z $ λ x, ⟨x,
     by rw [mk_mul, mul_comm x.fst, ← mk_mul, mk_self, one_mul]⟩,
   eq_iff_exists' := λ x y, mk_eq_mk_iff.trans $ r_iff_exists.trans $
-    show (∃ (c : S), x * 1 * c = y * 1 * c) ↔ _, by rw [mul_one, mul_one],
+    show (∃ (c : S), ↑c * (1 * x) = c * (1 * y)) ↔ _, by rw [one_mul, one_mul],
   ..(r S).mk'.comp $ monoid_hom.inl M S }
 
 variables {S}
@@ -1334,7 +1373,7 @@ namespace submonoid
 /-- The type of homomorphisms between monoids with zero satisfying the characteristic predicate:
 if `f : M →*₀ N` satisfies this predicate, then `N` is isomorphic to the localization of `M` at
 `S`. -/
-@[nolint has_inhabited_instance] structure localization_with_zero_map
+@[nolint has_nonempty_instance] structure localization_with_zero_map
   extends localization_map S N :=
 (map_zero' : to_fun 0 = 0)
 
@@ -1414,3 +1453,114 @@ end localization_with_zero_map
 end submonoid
 
 end comm_monoid_with_zero
+
+namespace localization
+variables {α : Type*} [cancel_comm_monoid α] {s : submonoid α} {a₁ b₁ : α} {a₂ b₂ : s}
+
+@[to_additive] lemma mk_left_injective (b : s) : injective (λ a, mk a b) :=
+λ c d h, by simpa [-mk_eq_monoid_of_mk', mk_eq_mk_iff, r_iff_exists] using h
+
+@[to_additive] lemma mk_eq_mk_iff' : mk a₁ a₂ = mk b₁ b₂ ↔ ↑b₂ * a₁ = a₂ * b₁ :=
+by simp_rw [mk_eq_mk_iff, r_iff_exists, mul_left_cancel_iff, exists_const]
+
+@[to_additive] instance decidable_eq [decidable_eq α] : decidable_eq (localization s) :=
+λ a b, localization.rec_on_subsingleton₂ a b $ λ a₁ a₂ b₁ b₂, decidable_of_iff' _ mk_eq_mk_iff'
+
+end localization
+
+/-! ### Order -/
+
+namespace localization
+variables {α : Type*}
+
+section ordered_cancel_comm_monoid
+variables [ordered_cancel_comm_monoid α] {s : submonoid α} {a₁ b₁ : α} {a₂ b₂ : s}
+
+@[to_additive] instance : has_le (localization s) :=
+⟨λ a b, localization.lift_on₂ a b (λ a₁ a₂ b₁ b₂, ↑b₂ * a₁ ≤ a₂ * b₁) $
+    λ a₁ b₁ a₂ b₂ c₁ d₁ c₂ d₂ hab hcd, propext begin
+    obtain ⟨e, he⟩ := r_iff_exists.1 hab,
+    obtain ⟨f, hf⟩ := r_iff_exists.1 hcd,
+    simp only [mul_right_inj] at he hf,
+    dsimp,
+    rw [←mul_le_mul_iff_right, mul_right_comm, ←hf, mul_right_comm, mul_right_comm ↑a₂,
+      mul_le_mul_iff_right, ←mul_le_mul_iff_left, mul_left_comm, he, mul_left_comm,
+      mul_left_comm ↑b₂, mul_le_mul_iff_left],
+  end⟩
+
+@[to_additive] instance : has_lt (localization s) :=
+⟨λ a b, localization.lift_on₂ a b (λ a₁ a₂ b₁ b₂, ↑b₂ * a₁ < a₂ * b₁) $
+    λ a₁ b₁ a₂ b₂ c₁ d₁ c₂ d₂ hab hcd, propext begin
+    obtain ⟨e, he⟩ := r_iff_exists.1 hab,
+    obtain ⟨f, hf⟩ := r_iff_exists.1 hcd,
+    simp only [mul_right_inj] at he hf,
+    dsimp,
+    rw [←mul_lt_mul_iff_right, mul_right_comm, ←hf, mul_right_comm, mul_right_comm ↑a₂,
+      mul_lt_mul_iff_right, ←mul_lt_mul_iff_left, mul_left_comm, he, mul_left_comm,
+      mul_left_comm ↑b₂, mul_lt_mul_iff_left],
+  end⟩
+
+@[to_additive] lemma mk_le_mk : mk a₁ a₂ ≤ mk b₁ b₂ ↔ ↑b₂ * a₁ ≤ a₂ * b₁ := iff.rfl
+@[to_additive] lemma mk_lt_mk : mk a₁ a₂ < mk b₁ b₂ ↔ ↑b₂ * a₁ < a₂ * b₁ := iff.rfl
+
+-- declaring this separately to the instance below makes things faster
+@[to_additive] instance : partial_order (localization s) :=
+{ le := (≤),
+  lt := (<),
+  le_refl := λ a, localization.induction_on a $ λ a, le_rfl,
+  le_trans := λ a b c, localization.induction_on₃ a b c $ λ a b c hab hbc, begin
+    simp only [mk_le_mk] at ⊢ hab hbc,
+    refine le_of_mul_le_mul_left' _,
+    { exact b.2 },
+    rw [mul_left_comm],
+    refine (mul_le_mul_left' hab _).trans _,
+    rwa [mul_left_comm, mul_left_comm ↑b.2, mul_le_mul_iff_left],
+  end,
+  le_antisymm := λ a b, begin
+    induction a with a₁ a₂,
+    induction b with b₁ b₂,
+    simp_rw [mk_le_mk, mk_eq_mk_iff, r_iff_exists],
+    exact λ hab hba, ⟨1, by rw [hab.antisymm hba]⟩,
+    all_goals { intros, refl },
+  end,
+  lt_iff_le_not_le := λ a b, localization.induction_on₂ a b $ λ a b, lt_iff_le_not_le }
+
+@[to_additive] instance : ordered_cancel_comm_monoid (localization s) :=
+{ mul_le_mul_left := λ a b, localization.induction_on₂ a b $ λ a b hab c,
+    localization.induction_on c $ λ c, begin
+      simp only [mk_mul, mk_le_mk, submonoid.coe_mul, mul_mul_mul_comm _ _ c.1] at ⊢ hab,
+      exact mul_le_mul_left' hab _,
+    end,
+  le_of_mul_le_mul_left := λ a b c, localization.induction_on₃ a b c $ λ a b c hab, begin
+      simp only [mk_mul, mk_le_mk, submonoid.coe_mul, mul_mul_mul_comm _ _ a.1] at ⊢ hab,
+      exact le_of_mul_le_mul_left' hab,
+    end,
+  ..localization.comm_monoid s, ..localization.partial_order }
+
+@[to_additive] instance decidable_le [decidable_rel ((≤) : α → α → Prop)] :
+  decidable_rel ((≤) : localization s → localization s → Prop) :=
+λ a b, localization.rec_on_subsingleton₂ a b $ λ a₁ a₂ b₁ b₂, decidable_of_iff' _ mk_le_mk
+
+@[to_additive] instance decidable_lt [decidable_rel ((<) : α → α → Prop)] :
+  decidable_rel ((<) : localization s → localization s → Prop) :=
+λ a b, localization.rec_on_subsingleton₂ a b $ λ a₁ a₂ b₁ b₂, decidable_of_iff' _ mk_lt_mk
+
+/-- An ordered cancellative monoid injects into its localization by sending `a` to `a / b`. -/
+@[to_additive "An ordered cancellative monoid injects into its localization by sending `a` to
+`a - b`.", simps] def mk_order_embedding (b : s) : α ↪o localization s :=
+{ to_fun := λ a, mk a b,
+  inj' := mk_left_injective _,
+  map_rel_iff' := λ a b, by simp [-mk_eq_monoid_of_mk', mk_le_mk] }
+
+end ordered_cancel_comm_monoid
+
+@[to_additive] instance [linear_ordered_cancel_comm_monoid α] {s : submonoid α} :
+  linear_ordered_cancel_comm_monoid (localization s) :=
+{ le_total := λ a b, localization.induction_on₂ a b $ λ _ _,
+    by { simp_rw mk_le_mk, exact le_total _ _ },
+  decidable_le := @localization.decidable_le α _ _ has_le.le.decidable,
+  decidable_lt := @localization.decidable_lt α _ _ has_lt.lt.decidable,
+  decidable_lt := localization.decidable_eq,
+  ..localization.ordered_cancel_comm_monoid }
+
+end localization
diff --git a/src/group_theory/nielsen_schreier.lean b/src/group_theory/nielsen_schreier.lean
index f9f646ce1c411..03c68bbb4ad18 100644
--- a/src/group_theory/nielsen_schreier.lean
+++ b/src/group_theory/nielsen_schreier.lean
@@ -10,6 +10,9 @@ import group_theory.is_free_group
 /-!
 # The Nielsen-Schreier theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves that a subgroup of a free group is itself free.
 
 ## Main result
@@ -56,7 +59,7 @@ open category_theory category_theory.action_category category_theory.single_obj
 /-- `is_free_groupoid.generators G` is a type synonym for `G`. We think of this as
 the vertices of the generating quiver of `G` when `G` is free. We can't use `G` directly,
 since `G` already has a quiver instance from being a groupoid. -/
-@[nolint unused_arguments has_inhabited_instance]
+@[nolint unused_arguments has_nonempty_instance]
 def is_free_groupoid.generators (G) [groupoid G] := G
 
 /-- A groupoid `G` is free when we have the following data:
@@ -71,7 +74,7 @@ class is_free_groupoid (G) [groupoid.{v} G] :=
 (quiver_generators : quiver.{v+1} (is_free_groupoid.generators G))
 (of : Π {a b : is_free_groupoid.generators G}, (a ⟶ b) → ((show G, from a) ⟶ b))
 (unique_lift : ∀ {X : Type v} [group X] (f : labelling (is_free_groupoid.generators G) X),
-                ∃! F : G ⥤ single_obj X, ∀ a b (g : a ⟶ b),
+                ∃! F : G ⥤ category_theory.single_obj X, ∀ a b (g : a ⟶ b),
                   F.map (of g) = f g)
 
 namespace is_free_groupoid
@@ -82,13 +85,13 @@ attribute [instance] quiver_generators
 quiver. -/
 @[ext]
 lemma ext_functor {G} [groupoid.{v} G] [is_free_groupoid G] {X : Type v} [group X]
-  (f g : G ⥤ single_obj X)
+  (f g : G ⥤ category_theory.single_obj X)
   (h : ∀ a b (e : a ⟶ b), f.map (of e) = g.map (of e)) :
   f = g :=
 let ⟨_, _, u⟩ := @unique_lift G _ _ X _ (λ (a b : generators G) (e : a ⟶ b), g.map (of e)) in
 trans (u _ h) (u _ (λ _ _ _, rfl)).symm
 
-/-- An action groupoid over a free froup is free. More generally, one could show that the groupoid
+/-- An action groupoid over a free group is free. More generally, one could show that the groupoid
 of elements over a free groupoid is free, but this version is easier to prove and suffices for our
 purposes.
 
@@ -174,7 +177,7 @@ end
 /-- Since a hom gives a loop, any homomorphism from the vertex group at the root
     extends to a functor on the whole groupoid. -/
 @[simps] def functor_of_monoid_hom {X} [monoid X] (f : End (root' T) →* X) :
-  G ⥤ single_obj X :=
+  G ⥤ category_theory.single_obj X :=
 { obj := λ _, (),
   map := λ a b p, f (loop_of_hom T p),
   map_id' := begin
@@ -190,8 +193,9 @@ end
 /-- Given a free groupoid and an arborescence of its generating quiver, the vertex
     group at the root is freely generated by loops coming from generating arrows
     in the complement of the tree. -/
-def End_is_free : is_free_group (End (root' T)) := is_free_group.of_unique_lift
-  (set.compl (wide_subquiver_equiv_set_total $ wide_subquiver_symmetrify T))
+def End_is_free : is_free_group (End (root' T)) :=
+is_free_group.of_unique_lift
+  ((wide_subquiver_equiv_set_total $ wide_subquiver_symmetrify T)ᶜ : set _)
   (λ e, loop_of_hom T (of e.val.hom))
   begin
     introsI X _ f,
@@ -207,7 +211,7 @@ def End_is_free : is_free_group (End (root' T)) := is_free_group.of_unique_lift
       intros,
       suffices : ∀ {a} (p : path (root' T) a), F'.map (hom_of_path T p) = 1,
       { simp only [this, tree_hom, comp_as_mul, inv_as_inv, loop_of_hom,
-        one_inv, mul_one, one_mul, functor.map_inv, functor.map_comp] },
+        inv_one, mul_one, one_mul, functor.map_inv, functor.map_comp] },
       intros a p, induction p with b c p e ih,
       { rw [hom_of_path, F'.map_id, id_as_one] },
       rw [hom_of_path, F'.map_comp, comp_as_mul, ih, mul_one],
@@ -244,10 +248,10 @@ begin
     ←free_group.of_injective.eq_iff, ←mul_inv_eq_one],
   let X := free_group (weakly_connected_component $ generators G),
   let f : G → X := λ g, free_group.of (weakly_connected_component.mk g),
-  let F : G ⥤ single_obj X := single_obj.difference_functor f,
+  let F : G ⥤ category_theory.single_obj X := single_obj.difference_functor f,
   change F.map p = ((category_theory.functor.const G).obj ()).map p,
   congr, ext,
-  rw [functor.const.obj_map, id_as_one, difference_functor_map, mul_inv_eq_one],
+  rw [functor.const_obj_map, id_as_one, difference_functor_map, mul_inv_eq_one],
   apply congr_arg free_group.of,
   apply (weakly_connected_component.eq _ _).mpr,
   exact ⟨hom.to_path (sum.inr e)⟩,
diff --git a/src/group_theory/nilpotent.lean b/src/group_theory/nilpotent.lean
index 77c70116bfa64..172bd1283a130 100644
--- a/src/group_theory/nilpotent.lean
+++ b/src/group_theory/nilpotent.lean
@@ -8,13 +8,16 @@ import group_theory.quotient_group
 import group_theory.solvable
 import group_theory.p_group
 import group_theory.sylow
-import data.nat.factorization
+import data.nat.factorization.basic
 import tactic.tfae
 
 /-!
 
 # Nilpotent groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 An API for nilpotent groups, that is, groups for which the upper central series
 reaches `⊤`.
 
@@ -513,7 +516,7 @@ begin
   rw nilpotent_iff_lower_central_series at *,
   rcases hH with ⟨n, hn⟩,
   use (n + 1),
-  refine lower_central_series_succ_eq_bot (le_trans ((map_eq_bot_iff _).mp _) hf1),
+  refine lower_central_series_succ_eq_bot (le_trans ((subgroup.map_eq_bot_iff _).mp _) hf1),
   exact eq_bot_iff.mpr (hn ▸ (lower_central_series.map f n)),
 end
 
@@ -524,7 +527,7 @@ lemma nilpotency_class_le_of_ker_le_center {H : Type*} [group H] (f : G →* H)
 begin
   rw ← lower_central_series_length_eq_nilpotency_class,
   apply nat.find_min',
-  refine lower_central_series_succ_eq_bot (le_trans ((map_eq_bot_iff _).mp _) hf1),
+  refine lower_central_series_succ_eq_bot (le_trans ((subgroup.map_eq_bot_iff _).mp _) hf1),
   apply eq_bot_iff.mpr,
   apply (le_trans (lower_central_series.map f _)),
   simp only [lower_central_series_nilpotency_class, le_bot_iff],
@@ -774,9 +777,9 @@ section finite_pi
 
 -- Now for finite products
 
-variables {η : Type*} [fintype η] {Gs : η → Type*} [∀ i, group (Gs i)]
+variables {η : Type*} {Gs : η → Type*} [∀ i, group (Gs i)]
 
-lemma lower_central_series_pi_of_fintype (n : ℕ):
+lemma lower_central_series_pi_of_finite [finite η] (n : ℕ) :
   lower_central_series (Π i, Gs i) n = subgroup.pi set.univ (λ i, lower_central_series (Gs i) n) :=
 begin
   let pi := λ (f : Π i, subgroup (Gs i)), subgroup.pi set.univ f,
@@ -786,17 +789,17 @@ begin
         = ⁅lower_central_series (Π i, Gs i) n, ⊤⁆          : rfl
     ... = ⁅pi (λ i, (lower_central_series (Gs i) n)), ⊤⁆   : by rw ih
     ... = ⁅pi (λ i, (lower_central_series (Gs i) n)), pi (λ i, ⊤)⁆ : by simp [pi, pi_top]
-    ... = pi (λ i, ⁅(lower_central_series (Gs i) n), ⊤⁆)   : commutator_pi_pi_of_fintype _ _
+    ... = pi (λ i, ⁅(lower_central_series (Gs i) n), ⊤⁆)   : commutator_pi_pi_of_finite _ _
     ... = pi (λ i, lower_central_series (Gs i) n.succ)     : rfl }
 end
 
 /-- n-ary products of nilpotent groups are nilpotent -/
-instance is_nilpotent_pi [∀ i, is_nilpotent (Gs i)] :
-  is_nilpotent (Π i, Gs i) :=
+instance is_nilpotent_pi [finite η] [∀ i, is_nilpotent (Gs i)] : is_nilpotent (Π i, Gs i) :=
 begin
+  casesI nonempty_fintype η,
   rw nilpotent_iff_lower_central_series,
   refine ⟨finset.univ.sup (λ i, group.nilpotency_class (Gs i)), _⟩,
-  rw [lower_central_series_pi_of_fintype, pi_eq_bot_iff],
+  rw [lower_central_series_pi_of_finite, pi_eq_bot_iff],
   intros i,
   apply lower_central_series_eq_bot_iff_nilpotency_class_le.mpr,
   exact @finset.le_sup _ _ _ _ finset.univ (λ i, group.nilpotency_class (Gs i)) _
@@ -804,13 +807,13 @@ begin
 end
 
 /-- The nilpotency class of an n-ary product is the sup of the nilpotency classes of the factors -/
-lemma nilpotency_class_pi [∀ i, is_nilpotent (Gs i)] :
+lemma nilpotency_class_pi [fintype η] [∀ i, is_nilpotent (Gs i)] :
   group.nilpotency_class (Π i, Gs i) = finset.univ.sup (λ i, group.nilpotency_class (Gs i)) :=
 begin
   apply eq_of_forall_ge_iff,
   intros k,
   simp only [finset.sup_le_iff, ← lower_central_series_eq_bot_iff_nilpotency_class_le,
-    lower_central_series_pi_of_fintype, pi_eq_bot_iff, finset.mem_univ, true_implies_iff ],
+    lower_central_series_pi_of_finite, pi_eq_bot_iff, finset.mem_univ, true_implies_iff ],
 end
 
 end finite_pi
@@ -829,11 +832,9 @@ lemma normalizer_condition_of_is_nilpotent [h : is_nilpotent G] : normalizer_con
 begin
   -- roughly based on https://groupprops.subwiki.org/wiki/Nilpotent_implies_normalizer_condition
   rw normalizer_condition_iff_only_full_group_self_normalizing,
-  unfreezingI
-  { induction h using nilpotent_center_quotient_ind with G' _ _ G' _ _ ih;
-    clear _inst_1 G; rename G' → G, },
-  { rintros H -, apply subsingleton.elim, },
-  { intros H hH,
+  apply nilpotent_center_quotient_ind G; unfreezingI { clear_dependent G },
+  { introsI G _ _ H _, apply subsingleton.elim, },
+  { introsI G _ _ ih H hH,
 
     have hch : center G ≤ H := subgroup.center_le_normalizer.trans (le_of_eq hH),
     have hkh : (mk' (center G)).ker ≤ H, by simpa using hch,
@@ -854,17 +855,18 @@ section with_finite_group
 
 open group fintype
 
-variables {G : Type*} [hG : group G] [hf : fintype G]
-include hG hf
+variables {G : Type*} [hG : group G]
+include hG
 
 /-- A p-group is nilpotent -/
-lemma is_p_group.is_nilpotent {p : ℕ} [hp : fact (nat.prime p)] (h : is_p_group p G) :
+lemma is_p_group.is_nilpotent [finite G] {p : ℕ} [hp : fact (nat.prime p)] (h : is_p_group p G) :
   is_nilpotent G :=
 begin
+  casesI nonempty_fintype G,
   classical,
   unfreezingI
   { revert hG,
-    induction hf using fintype.induction_subsingleton_or_nontrivial with G hG hS G hG hN ih },
+    induction val using fintype.induction_subsingleton_or_nontrivial with G hG hS G hG hN ih },
   { apply_instance, },
   { introI _, intro h,
     have hcq : fintype.card (G ⧸ center G) < fintype.card G,
@@ -876,6 +878,8 @@ begin
     exact (of_quotient_center_nilpotent hnq), }
 end
 
+variables [fintype G]
+
 /-- If a finite group is the direct product of its Sylow groups, it is nilpotent -/
 theorem is_nilpotent_of_product_of_sylow_group
   (e : (Π p : (fintype.card G).factorization.support, Π P : sylow p G, (↑P : subgroup G)) ≃* G) :
diff --git a/src/group_theory/noncomm_pi_coprod.lean b/src/group_theory/noncomm_pi_coprod.lean
index 5dd7f2871e239..602cb46e88539 100644
--- a/src/group_theory/noncomm_pi_coprod.lean
+++ b/src/group_theory/noncomm_pi_coprod.lean
@@ -5,11 +5,16 @@ Authors: Joachim Breitner
 -/
 import group_theory.order_of_element
 import data.finset.noncomm_prod
-import data.fintype.card
+import data.fintype.big_operators
+import data.nat.gcd.big_operators
+import order.sup_indep
 
 /-!
 # Canonical homomorphism from a finite family of monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the construction of the canonical homomorphism from a family of monoids.
 
 Given a family of morphisms `ϕ i : N i →* M` for each `i : ι` where elements in the
@@ -41,6 +46,44 @@ images of different morphisms commute, we obtain a canonical morphism
 
 open_locale big_operators
 
+namespace subgroup
+
+variables {G : Type*} [group G]
+
+/-- `finset.noncomm_prod` is “injective” in `f` if `f` maps into independent subgroups.  This
+generalizes (one direction of) `subgroup.disjoint_iff_mul_eq_one`. -/
+@[to_additive "`finset.noncomm_sum` is “injective” in `f` if `f` maps into independent subgroups.
+This generalizes (one direction of) `add_subgroup.disjoint_iff_add_eq_zero`. "]
+lemma eq_one_of_noncomm_prod_eq_one_of_independent {ι : Type*} (s : finset ι) (f : ι → G) (comm)
+  (K : ι → subgroup G) (hind : complete_lattice.independent K) (hmem : ∀ (x ∈ s), f x ∈ K x)
+  (heq1 : s.noncomm_prod f comm = 1) : ∀ (i ∈ s), f i = 1 :=
+begin
+  classical,
+  revert heq1,
+  induction s using finset.induction_on with i s hnmem ih,
+  { simp, },
+  { have hcomm := comm.mono (finset.coe_subset.2 $ finset.subset_insert _ _),
+    simp only [finset.forall_mem_insert] at hmem,
+    have hmem_bsupr: s.noncomm_prod f hcomm ∈ ⨆ (i ∈ (s : set ι)), K i,
+    { refine subgroup.noncomm_prod_mem _ _ _,
+      intros x hx,
+      have : K x ≤ ⨆ (i ∈ (s : set ι)), K i := le_supr₂ x hx,
+      exact this (hmem.2 x hx), },
+    intro heq1,
+    rw finset.noncomm_prod_insert_of_not_mem _ _ _ _ hnmem at heq1,
+    have hnmem' : i ∉ (s : set ι), by simpa,
+    obtain ⟨heq1i : f i = 1, heq1S : s.noncomm_prod f _ = 1⟩ :=
+      subgroup.disjoint_iff_mul_eq_one.mp (hind.disjoint_bsupr hnmem') hmem.1 hmem_bsupr heq1,
+    intros i h,
+    simp only [finset.mem_insert] at h,
+    rcases h with ⟨rfl | _⟩,
+    { exact heq1i },
+    { exact ih hcomm hmem.2 heq1S _ h } }
+end
+
+end subgroup
+
+
 section family_of_monoids
 
 variables {M : Type*} [monoid M]
@@ -54,7 +97,7 @@ variables {N : ι → Type*} [∀ i, monoid (N i)]
 variables (ϕ : Π (i : ι), N i →* M)
 
 -- We assume that the elements of different morphism commute
-variables (hcomm : ∀ (i j : ι), i ≠ j → ∀ (x : N i) (y : N j), commute (ϕ i x) (ϕ j y))
+variables (hcomm : pairwise $ λ i j, ∀ x y, commute (ϕ i x) (ϕ j y))
 include hcomm
 
 -- We use `f` and `g` to denote elements of `Π (i : ι), N i`
@@ -67,15 +110,14 @@ namespace monoid_hom
 
 See also `linear_map.lsum` for a linear version without the commutativity assumption."]
 def noncomm_pi_coprod : (Π (i : ι), N i) →* M :=
-{ to_fun := λ f, finset.univ.noncomm_prod (λ i, ϕ i (f i)) $
-    by { rintros i - j -, by_cases h : i = j, { subst h }, { exact hcomm _ _ h _ _ } },
+{ to_fun := λ f, finset.univ.noncomm_prod (λ i, ϕ i (f i)) $ λ i _ j _ h, hcomm h _ _,
   map_one' := by {apply (finset.noncomm_prod_eq_pow_card _ _ _ _ _).trans (one_pow _), simp},
   map_mul' := λ f g,
   begin
     classical,
     convert @finset.noncomm_prod_mul_distrib _ _ _ _ (λ i, ϕ i (f i)) (λ i, ϕ i (g i)) _ _ _,
     { ext i, exact map_mul (ϕ i) (f i) (g i), },
-    { rintros i - j - h, exact hcomm _ _ h _ _ },
+    { rintros i - j - h, exact hcomm h _ _ },
   end }
 
 variable {hcomm}
@@ -105,7 +147,7 @@ def noncomm_pi_coprod_equiv :
 { to_fun := λ ϕ, noncomm_pi_coprod ϕ.1 ϕ.2,
   inv_fun := λ f,
   ⟨ λ i, f.comp (monoid_hom.single N i),
-    λ i j hij x y, commute.map (pi.mul_single_commute i j hij x y) f ⟩,
+    λ i j hij x y, commute.map (pi.mul_single_commute hij x y) f ⟩,
   left_inv := λ ϕ, by { ext, simp, },
   right_inv := λ f, pi_ext (λ i x, by simp) }
 
@@ -185,13 +227,18 @@ end
 
 variable (hcomm)
 
+omit hfin
+
 @[to_additive]
-lemma independent_range_of_coprime_order [∀ i, fintype (H i)]
+lemma independent_range_of_coprime_order [finite ι] [Π i, fintype (H i)]
   (hcoprime : ∀ i j, i ≠ j → nat.coprime (fintype.card (H i)) (fintype.card (H j))) :
   complete_lattice.independent (λ i, (ϕ i).range) :=
 begin
+  casesI nonempty_fintype ι,
   classical,
-  rintros i f ⟨hxi, hxp⟩, dsimp at hxi hxp,
+  rintros i,
+  rw disjoint_iff_inf_le,
+  rintros f ⟨hxi, hxp⟩, dsimp at hxi hxp,
   rw [supr_subtype', ← noncomm_pi_coprod_range] at hxp,
   rotate, { intros _ _ hj, apply hcomm, exact hj ∘ subtype.ext },
   cases hxp with g hgf, cases hxi with g' hg'f,
@@ -263,14 +310,14 @@ end
 
 variable (hcomm)
 
+omit hfin
+
 @[to_additive]
-lemma independent_of_coprime_order [∀ i, fintype (H i)]
+lemma independent_of_coprime_order [finite ι] [∀ i, fintype (H i)]
   (hcoprime : ∀ i j, i ≠ j → nat.coprime (fintype.card (H i)) (fintype.card (H j))) :
   complete_lattice.independent H :=
-begin
-  simpa using monoid_hom.independent_range_of_coprime_order
-    (λ i, (H i).subtype) (commute_subtype_of_commute hcomm) hcoprime,
-end
+by simpa using monoid_hom.independent_range_of_coprime_order (λ i, (H i).subtype)
+  (commute_subtype_of_commute hcomm) hcoprime
 
 end commuting_subgroups
 
diff --git a/src/group_theory/order_of_element.lean b/src/group_theory/order_of_element.lean
index 32db327703a14..2f1065af425db 100644
--- a/src/group_theory/order_of_element.lean
+++ b/src/group_theory/order_of_element.lean
@@ -3,15 +3,20 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Julian Kuelshammer
 -/
+import algebra.gcd_monoid.finset
 import algebra.hom.iterate
-import data.nat.modeq
-import data.set.pointwise
+import data.int.modeq
+import data.set.pointwise.basic
+import data.set.intervals.infinite
 import dynamics.periodic_pts
 import group_theory.index
 
 /-!
 # Order of an element
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the order of an element of a finite group. For a finite group `G` the order of
 `x ∈ G` is the minimal `n ≥ 1` such that `x ^ n = 1`.
 
@@ -31,14 +36,11 @@ order of an element
 open function nat
 open_locale pointwise
 
-universes u v
-
-variables {G : Type u} {A : Type v}
-variables {x y : G} {a b : A} {n m : ℕ}
+variables {G H A α β : Type*}
 
 section monoid_add_monoid
 
-variables [monoid G] [add_monoid A]
+variables [monoid G] [add_monoid A] {x y : G} {a b : A} {n m : ℕ}
 
 section is_of_fin_order
 
@@ -68,8 +70,22 @@ lemma is_of_fin_order_iff_pow_eq_one (x : G) :
   is_of_fin_order x ↔ ∃ n, 0 < n ∧ x ^ n = 1 :=
 by { convert iff.rfl, simp [is_periodic_pt_mul_iff_pow_eq_one] }
 
+/-- See also `injective_pow_iff_not_is_of_fin_order`. -/
+@[to_additive not_is_of_fin_add_order_of_injective_nsmul "See also
+`injective_nsmul_iff_not_is_of_fin_add_order`."]
+lemma not_is_of_fin_order_of_injective_pow {x : G} (h : injective (λ (n : ℕ), x^n)) :
+  ¬ is_of_fin_order x :=
+begin
+  simp_rw [is_of_fin_order_iff_pow_eq_one, not_exists, not_and],
+  intros n hn_pos hnx,
+  rw ← pow_zero x at hnx,
+  rw h hnx at hn_pos,
+  exact irrefl 0 hn_pos,
+end
+
 /-- Elements of finite order are of finite order in submonoids.-/
-@[to_additive is_of_fin_add_order_iff_coe]
+@[to_additive is_of_fin_add_order_iff_coe "Elements of finite order are of finite order in
+submonoids."]
 lemma is_of_fin_order_iff_coe (H : submonoid G) (x : H) :
   is_of_fin_order x ↔ is_of_fin_order (x : G) :=
 by { rw [is_of_fin_order_iff_pow_eq_one, is_of_fin_order_iff_pow_eq_one], norm_cast }
@@ -77,8 +93,7 @@ by { rw [is_of_fin_order_iff_pow_eq_one, is_of_fin_order_iff_pow_eq_one], norm_c
 /-- The image of an element of finite order has finite order. -/
 @[to_additive add_monoid_hom.is_of_fin_order
   "The image of an element of finite additive order has finite additive order."]
-lemma monoid_hom.is_of_fin_order
-  {H : Type v} [monoid H] (f : G →* H) {x : G} (h : is_of_fin_order x) :
+lemma monoid_hom.is_of_fin_order [monoid H] (f : G →* H) {x : G} (h : is_of_fin_order x) :
   is_of_fin_order $ f x :=
 (is_of_fin_order_iff_pow_eq_one _).mpr $ begin
   rcases (is_of_fin_order_iff_pow_eq_one _).mp h with ⟨n, npos, hn⟩,
@@ -138,12 +153,26 @@ by rwa [order_of, minimal_period, dif_neg]
   order_of x = 0 ↔ ∀ n : ℕ, 0 < n → x ^ n ≠ 1 :=
 by simp_rw [order_of_eq_zero_iff, is_of_fin_order_iff_pow_eq_one, not_exists, not_and]
 
+@[to_additive add_order_of_eq_iff] lemma order_of_eq_iff {n} (h : 0 < n) :
+  order_of x = n ↔ x ^ n = 1 ∧ ∀ m, m < n → 0 < m → x ^ m ≠ 1 :=
+begin
+  simp_rw [ne, ← is_periodic_pt_mul_iff_pow_eq_one, order_of, minimal_period],
+  split_ifs with h1,
+  { rw [find_eq_iff, exists_prop_of_true h], push_neg, refl },
+  { rw iff_false_left h.ne, rintro ⟨h', -⟩, exact h1 ⟨n, h, h'⟩ },
+end
+
 /-- A group element has finite order iff its order is positive. -/
 @[to_additive add_order_of_pos_iff
   "A group element has finite additive order iff its order is positive."]
 lemma order_of_pos_iff : 0 < order_of x ↔ is_of_fin_order x :=
 by rwa [iff_not_comm.mp order_of_eq_zero_iff, pos_iff_ne_zero]
 
+@[to_additive is_of_fin_add_order.mono]
+lemma is_of_fin_order.mono [monoid β] {y : β} (hx : is_of_fin_order x)
+  (h : order_of y ∣ order_of x) : is_of_fin_order y :=
+by { rw ←order_of_pos_iff at ⊢ hx, exact nat.pos_of_dvd_of_pos h hx }
+
 @[to_additive nsmul_ne_zero_of_lt_add_order_of']
 lemma pow_ne_one_of_lt_order_of' (n0 : n ≠ 0) (h : n < order_of x) : x ^ n ≠ 1 :=
 λ j, not_is_periodic_pt_of_pos_of_lt_minimal_period n0 h
@@ -173,6 +202,10 @@ is_periodic_pt.minimal_period_dvd ((is_periodic_pt_mul_iff_pow_eq_one _).mpr h)
 lemma order_of_dvd_iff_pow_eq_one {n : ℕ} : order_of x ∣ n ↔ x ^ n = 1 :=
 ⟨λ h, by rw [pow_eq_mod_order_of, nat.mod_eq_zero_of_dvd h, pow_zero], order_of_dvd_of_pow_eq_one⟩
 
+@[to_additive add_order_of_smul_dvd]
+lemma order_of_pow_dvd (n : ℕ) : order_of (x ^ n) ∣ order_of x :=
+by rw [order_of_dvd_iff_pow_eq_one, pow_right_comm, pow_order_of_eq_one, one_pow]
+
 @[to_additive add_order_of_map_dvd]
 lemma order_of_map_dvd {H : Type*} [monoid H] (ψ : G →* H) (x : G) :
   order_of (ψ x) ∣ order_of x :=
@@ -192,11 +225,10 @@ begin
   exact ⟨m, by rw [←pow_mul, pow_eq_mod_order_of, hm, pow_one]⟩,
 end
 
-/--
-If `x^n = 1`, but `x^(n/p) ≠ 1` for all prime factors `p` of `r`,
-then `x` has order `n` in `G`.
+/-- If `x^n = 1`, but `x^(n/p) ≠ 1` for all prime factors `p` of `n`, then `x` has order `n` in `G`.
 -/
-@[to_additive add_order_of_eq_of_nsmul_and_div_prime_nsmul]
+@[to_additive add_order_of_eq_of_nsmul_and_div_prime_nsmul "If `n * x = 0`, but `n/p * x ≠ 0` for
+all prime factors `p` of `n`, then `x` has order `n` in `G`."]
 theorem order_of_eq_of_pow_and_pow_div_prime (hn : 0 < n) (hx : x^n = 1)
   (hd : ∀ p : ℕ, p.prime → p ∣ n → x^(n/p) ≠ 1) :
   order_of x = n :=
@@ -257,22 +289,44 @@ begin
   simp only [order_of, mul_left_iterate],
 end
 
+@[to_additive add_order_of_nsmul_coprime]
+lemma order_of_pow_coprime (h : (order_of y).coprime m) : order_of (y ^ m) = order_of y :=
+begin
+  by_cases hg : order_of y = 0,
+  { rw [m.coprime_zero_left.mp (hg ▸ h), pow_one] },
+  { rw [order_of_pow'' y m (hg.imp_symm order_of_eq_zero), h.gcd_eq_one, nat.div_one] },
+end
+
+namespace commute
+
+variables {x y} (h : commute x y)
+include h
+
 @[to_additive]
-lemma commute.order_of_mul_dvd_lcm {x y : G} (h : commute x y) :
-  order_of (x * y) ∣ nat.lcm (order_of x) (order_of y) :=
+lemma order_of_mul_dvd_lcm : order_of (x * y) ∣ nat.lcm (order_of x) (order_of y) :=
 begin
   convert function.commute.minimal_period_of_comp_dvd_lcm h.function_commute_mul_left,
   rw [order_of, comp_mul_left],
 end
 
+@[to_additive]
+lemma order_of_dvd_lcm_mul : order_of y ∣ nat.lcm (order_of x) (order_of (x * y)) :=
+begin
+  by_cases h0 : order_of x = 0,
+  { rw [h0, nat.lcm_zero_left], apply dvd_zero },
+  conv_lhs { rw [← one_mul y, ← pow_order_of_eq_one x,
+    ← succ_pred_eq_of_pos (nat.pos_of_ne_zero h0), pow_succ', mul_assoc] },
+  exact (((commute.refl x).mul_right h).pow_left _).order_of_mul_dvd_lcm.trans
+    (nat.lcm_dvd_iff.2 ⟨trans (order_of_pow_dvd _) (dvd_lcm_left _ _), dvd_lcm_right _ _⟩),
+end
+
 @[to_additive add_order_of_add_dvd_mul_add_order_of]
-lemma commute.order_of_mul_dvd_mul_order_of {x y : G} (h : commute x y) :
-  order_of (x * y) ∣ (order_of x) * (order_of y) :=
+lemma order_of_mul_dvd_mul_order_of : order_of (x * y) ∣ (order_of x) * (order_of y) :=
 dvd_trans h.order_of_mul_dvd_lcm (lcm_dvd_mul _ _)
 
 @[to_additive add_order_of_add_eq_mul_add_order_of_of_coprime]
-lemma commute.order_of_mul_eq_mul_order_of_of_coprime {x y : G} (h : commute x y)
-  (hco : nat.coprime (order_of x) (order_of y)) :
+lemma order_of_mul_eq_mul_order_of_of_coprime
+  (hco : (order_of x).coprime (order_of y)) :
   order_of (x * y) = (order_of x) * (order_of y) :=
 begin
   convert h.function_commute_mul_left.minimal_period_of_comp_eq_mul_of_coprime hco,
@@ -281,12 +335,35 @@ end
 
 /-- Commuting elements of finite order are closed under multiplication. -/
 @[to_additive "Commuting elements of finite additive order are closed under addition."]
-lemma commute.is_of_fin_order_mul
-  {x} (h : commute x y) (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
+lemma is_of_fin_order_mul
+  (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
   is_of_fin_order (x * y) :=
 order_of_pos_iff.mp $
   pos_of_dvd_of_pos h.order_of_mul_dvd_mul_order_of $ mul_pos (order_of_pos' hx) (order_of_pos' hy)
 
+/-- If each prime factor of `order_of x` has higher multiplicity in `order_of y`, and `x` commutes
+  with `y`, then `x * y` has the same order as `y`. -/
+@[to_additive add_order_of_add_eq_right_of_forall_prime_mul_dvd "If each prime factor of
+  `add_order_of x` has higher multiplicity in `add_order_of y`, and `x` commutes with `y`,
+  then `x + y` has the same order as `y`."]
+lemma order_of_mul_eq_right_of_forall_prime_mul_dvd
+  (hy : is_of_fin_order y)
+  (hdvd : ∀ p : ℕ, p.prime → p ∣ order_of x → (p * order_of x) ∣ order_of y) :
+  order_of (x * y) = order_of y :=
+begin
+  have hoy := order_of_pos' hy,
+  have hxy := dvd_of_forall_prime_mul_dvd hdvd,
+  apply order_of_eq_of_pow_and_pow_div_prime hoy; simp only [ne, ← order_of_dvd_iff_pow_eq_one],
+  { exact trans h.order_of_mul_dvd_lcm (lcm_dvd hxy dvd_rfl) },
+  refine λ p hp hpy hd, hp.ne_one _,
+  rw [← nat.dvd_one, ← mul_dvd_mul_iff_right hoy.ne', one_mul, ← dvd_div_iff hpy],
+  refine trans (order_of_dvd_lcm_mul h) (lcm_dvd ((dvd_div_iff hpy).2 _) hd),
+  by_cases p ∣ order_of x,
+  exacts [hdvd p hp h, (hp.coprime_iff_not_dvd.2 h).mul_dvd_of_dvd_of_dvd hpy hxy],
+end
+
+end commute
+
 section p_prime
 
 variables {a x n} {p : ℕ} [hp : fact p.prime]
@@ -305,50 +382,85 @@ begin
   rwa is_periodic_pt_mul_iff_pow_eq_one,
 end
 
-omit hp
--- An example on how to determine the order of an element of a finite group.
-example : order_of (-1 : ℤˣ) = 2 :=
-order_of_eq_prime (int.units_sq _) dec_trivial
+@[to_additive exists_add_order_of_eq_prime_pow_iff]
+lemma exists_order_of_eq_prime_pow_iff :
+  (∃ k : ℕ, order_of x = p ^ k) ↔ (∃ m : ℕ, x ^ (p : ℕ) ^ m = 1) :=
+⟨λ ⟨k, hk⟩, ⟨k, by rw [←hk, pow_order_of_eq_one]⟩, λ ⟨_, hm⟩,
+begin
+  obtain ⟨k, _, hk⟩ := (nat.dvd_prime_pow hp.elim).mp (order_of_dvd_of_pow_eq_one hm),
+  exact ⟨k, hk⟩,
+end⟩
 
 end p_prime
 
 end monoid_add_monoid
 
 section cancel_monoid
-variables [left_cancel_monoid G] (x y)
+variables [left_cancel_monoid G] (x y : G) {m n : ℕ}
 
 @[to_additive nsmul_injective_of_lt_add_order_of]
 lemma pow_injective_of_lt_order_of
   (hn : n < order_of x) (hm : m < order_of x) (eq : x ^ n = x ^ m) : n = m :=
-iterate_injective_of_lt_minimal_period hn hm (by simpa only [mul_left_iterate, mul_one])
+eq_of_lt_minimal_period_of_iterate_eq hn hm (by simpa only [mul_left_iterate, mul_one])
 
 @[to_additive mem_multiples_iff_mem_range_add_order_of']
 lemma mem_powers_iff_mem_range_order_of' [decidable_eq G] (hx : 0 < order_of x) :
   y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
 finset.mem_range_iff_mem_finset_range_of_mod_eq' hx (λ i, pow_eq_mod_order_of.symm)
 
+@[to_additive]
 lemma pow_eq_one_iff_modeq : x ^ n = 1 ↔ n ≡ 0 [MOD (order_of x)] :=
 by rw [modeq_zero_iff_dvd, order_of_dvd_iff_pow_eq_one]
 
+@[to_additive]
 lemma pow_eq_pow_iff_modeq : x ^ n = x ^ m ↔ n ≡ m [MOD (order_of x)] :=
 begin
-  wlog hmn : m ≤ n,
+  wlog hmn : m ≤ n generalizing m n,
+  { rw [eq_comm, modeq.comm, this (le_of_not_le hmn)], },
   obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn,
   rw [← mul_one (x ^ m), pow_add, mul_left_cancel_iff, pow_eq_one_iff_modeq],
   exact ⟨λ h, nat.modeq.add_left _ h, λ h, nat.modeq.add_left_cancel' _ h⟩,
 end
 
+@[simp, to_additive injective_nsmul_iff_not_is_of_fin_add_order]
+lemma injective_pow_iff_not_is_of_fin_order {x : G} :
+  injective (λ (n : ℕ), x^n) ↔ ¬ is_of_fin_order x :=
+begin
+  refine ⟨λ h, not_is_of_fin_order_of_injective_pow h, λ h n m hnm, _⟩,
+  rwa [pow_eq_pow_iff_modeq, order_of_eq_zero_iff.mpr h, modeq_zero_iff] at hnm,
+end
+
+@[to_additive infinite_not_is_of_fin_add_order]
+lemma infinite_not_is_of_fin_order {x : G} (h : ¬ is_of_fin_order x) :
+  {y : G | ¬ is_of_fin_order y}.infinite :=
+begin
+  let s := {n | 0 < n}.image (λ (n : ℕ), x^n),
+  have hs : s ⊆ {y : G | ¬ is_of_fin_order y},
+  { rintros - ⟨n, hn : 0 < n, rfl⟩ (contra : is_of_fin_order (x^n)),
+    apply h,
+    rw is_of_fin_order_iff_pow_eq_one at contra ⊢,
+    obtain ⟨m, hm, hm'⟩ := contra,
+    exact ⟨n * m, mul_pos hn hm, by rwa pow_mul⟩, },
+  suffices : s.infinite, { exact this.mono hs, },
+  contrapose! h,
+  have : ¬ injective (λ (n : ℕ), x^n),
+  { have := set.not_inj_on_infinite_finite_image (set.Ioi_infinite 0) (set.not_infinite.mp h),
+    contrapose! this,
+    exact set.inj_on_of_injective this _, },
+  rwa [injective_pow_iff_not_is_of_fin_order, not_not] at this,
+end
+
 end cancel_monoid
 
 section group
-variables [group G] [add_group A] {x a} {i : ℤ}
+variables [group G] {x y : G} {i : ℤ}
 
 /-- Inverses of elements of finite order have finite order. -/
 @[to_additive "Inverses of elements of finite additive order have finite additive order."]
 lemma is_of_fin_order.inv {x : G} (hx : is_of_fin_order x) : is_of_fin_order x⁻¹ :=
 (is_of_fin_order_iff_pow_eq_one _).mpr $ begin
   rcases (is_of_fin_order_iff_pow_eq_one x).mp hx with ⟨n, npos, hn⟩,
-  refine ⟨n, npos, by simp_rw [inv_pow, hn, one_inv]⟩,
+  refine ⟨n, npos, by simp_rw [inv_pow, hn, inv_one]⟩,
 end
 
 /-- Inverses of elements of finite order have finite order. -/
@@ -405,11 +517,52 @@ begin
   exact ⟨pow_injective_of_lt_order_of _ (nat.mod_lt _ hx) (nat.mod_lt _ hx), λ h, congr_arg _ h⟩
 end
 
+@[simp, to_additive zsmul_smul_order_of]
+lemma zpow_pow_order_of : (x^i)^order_of x = 1 :=
+begin
+  by_cases h : is_of_fin_order x,
+  { rw [← zpow_coe_nat, ← zpow_mul, mul_comm, zpow_mul, zpow_coe_nat, pow_order_of_eq_one,
+      one_zpow], },
+  { rw [order_of_eq_zero h, pow_zero], },
+end
+
+@[to_additive is_of_fin_add_order.zsmul]
+lemma is_of_fin_order.zpow (h : is_of_fin_order x) {i : ℤ} : is_of_fin_order (x^i) :=
+(is_of_fin_order_iff_pow_eq_one _).mpr ⟨order_of x, order_of_pos' h, zpow_pow_order_of⟩
+
+@[to_additive is_of_fin_add_order.of_mem_zmultiples]
+lemma is_of_fin_order.of_mem_zpowers (h : is_of_fin_order x) (h' : y ∈ subgroup.zpowers x) :
+  is_of_fin_order y :=
+by { obtain ⟨k, rfl⟩ := subgroup.mem_zpowers_iff.mp h', exact h.zpow, }
+
+@[to_additive add_order_of_dvd_of_mem_zmultiples]
+lemma order_of_dvd_of_mem_zpowers (h : y ∈ subgroup.zpowers x) : order_of y ∣ order_of x :=
+begin
+  obtain ⟨k, rfl⟩ := subgroup.mem_zpowers_iff.mp h,
+  rw order_of_dvd_iff_pow_eq_one,
+  exact zpow_pow_order_of,
+end
+
+lemma smul_eq_self_of_mem_zpowers {α : Type*} [mul_action G α]
+  (hx : x ∈ subgroup.zpowers y) {a : α} (hs : y • a = a) : x • a = a :=
+begin
+  obtain ⟨k, rfl⟩ := subgroup.mem_zpowers_iff.mp hx,
+  rw [← mul_action.to_perm_apply, ← mul_action.to_perm_hom_apply,
+    monoid_hom.map_zpow _ y k, mul_action.to_perm_hom_apply],
+  exact function.is_fixed_pt.perm_zpow hs k,
+end
+
+lemma vadd_eq_self_of_mem_zmultiples {α G : Type*} [add_group G] [add_action G α] {x y : G}
+  (hx : x ∈ add_subgroup.zmultiples y) {a : α} (hs : y +ᵥ a = a) : x +ᵥ a = a :=
+@smul_eq_self_of_mem_zpowers (multiplicative G) _ _ _ α _ hx a hs
+
+attribute [to_additive vadd_eq_self_of_mem_zmultiples] smul_eq_self_of_mem_zpowers
+
 end group
 
 section comm_monoid
 
-variables [comm_monoid G]
+variables [comm_monoid G] {x y : G}
 
 /-- Elements of finite order are closed under multiplication. -/
 @[to_additive "Elements of finite additive order are closed under addition."]
@@ -419,15 +572,12 @@ lemma is_of_fin_order.mul (hx : is_of_fin_order x) (hy : is_of_fin_order y) :
 
 end comm_monoid
 
-section fintype
-variables [fintype G] [fintype A]
-
 section finite_monoid
-variables [monoid G] [add_monoid A]
+variables [monoid G] {n : ℕ}
 open_locale big_operators
 
 @[to_additive sum_card_add_order_of_eq_card_nsmul_eq_zero]
-lemma sum_card_order_of_eq_card_pow_eq_one [decidable_eq G] (hn : 0 < n) :
+lemma sum_card_order_of_eq_card_pow_eq_one [fintype G] [decidable_eq G] (hn : n ≠ 0) :
   ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
   = (finset.univ.filter (λ x : G, x ^ n = 1)).card :=
 calc ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x : G, order_of x = m)).card
@@ -437,30 +587,26 @@ calc ∑ m in (finset.range n.succ).filter (∣ n), (finset.univ.filter (λ x :
   suffices : order_of x ≤ n ∧ order_of x ∣ n ↔ x ^ n = 1,
   { simpa [nat.lt_succ_iff], },
   exact ⟨λ h, let ⟨m, hm⟩ := h.2 in by rw [hm, pow_mul, pow_order_of_eq_one, one_pow],
-    λ h, ⟨order_of_le_of_pow_eq_one hn h, order_of_dvd_of_pow_eq_one h⟩⟩
+    λ h, ⟨order_of_le_of_pow_eq_one hn.bot_lt h, order_of_dvd_of_pow_eq_one h⟩⟩
 end))
 
 end finite_monoid
 
 section finite_cancel_monoid
 -- TODO: Of course everything also works for right_cancel_monoids.
-variables [left_cancel_monoid G] [add_left_cancel_monoid A]
+variables [left_cancel_monoid G] {x y : G} {n : ℕ}
 
 -- TODO: Use this to show that a finite left cancellative monoid is a group.
 @[to_additive]
-lemma exists_pow_eq_one (x : G) : is_of_fin_order x :=
+lemma exists_pow_eq_one [finite G] (x : G) : is_of_fin_order x :=
 begin
-  refine (is_of_fin_order_iff_pow_eq_one _).mpr _,
-  obtain ⟨i, j, a_eq, ne⟩ : ∃(i j : ℕ), x ^ i = x ^ j ∧ i ≠ j :=
-    by simpa only [not_forall, exists_prop, injective]
-      using (not_injective_infinite_fintype (λi:ℕ, x^i)),
-  wlog h'' : j ≤ i,
-  refine ⟨i - j, tsub_pos_of_lt (lt_of_le_of_ne h'' ne.symm), mul_right_injective (x^j) _⟩,
-  rw [mul_one, ← pow_add, ← a_eq, add_tsub_cancel_of_le h''],
+  have : (set.univ : set G).finite := set.univ.to_finite,
+  contrapose! this,
+  exact set.infinite.mono (set.subset_univ _) (infinite_not_is_of_fin_order this),
 end
 
 @[to_additive add_order_of_le_card_univ]
-lemma order_of_le_card_univ : order_of x ≤ fintype.card G :=
+lemma order_of_le_card_univ [fintype G] : order_of x ≤ fintype.card G :=
 finset.le_card_of_inj_on_range ((^) x)
   (assume n _, finset.mem_univ _)
   (assume i hi j hj, pow_injective_of_lt_order_of x hi hj)
@@ -470,7 +616,7 @@ finset.le_card_of_inj_on_range ((^) x)
 @[to_additive add_order_of_pos
 "This is the same as `add_order_of_pos' but with one fewer explicit assumption since this is
   automatic in case of a finite cancellative additive monoid."]
-lemma order_of_pos (x : G) : 0 < order_of x := order_of_pos' (exists_pow_eq_one x)
+lemma order_of_pos [finite G] (x : G) : 0 < order_of x := order_of_pos' (exists_pow_eq_one x)
 
 open nat
 
@@ -479,40 +625,35 @@ automatic in the case of a finite cancellative monoid.-/
 @[to_additive add_order_of_nsmul
 "This is the same as `add_order_of_nsmul'` and `add_order_of_nsmul` but with one assumption less
 which is automatic in the case of a finite cancellative additive monoid."]
-lemma order_of_pow (x : G) :
+lemma order_of_pow [finite G] (x : G) :
   order_of (x ^ n) = order_of x / gcd (order_of x) n := order_of_pow'' _ _ (exists_pow_eq_one _)
 
 @[to_additive mem_multiples_iff_mem_range_add_order_of]
-lemma mem_powers_iff_mem_range_order_of [decidable_eq G] :
+lemma mem_powers_iff_mem_range_order_of [finite G] [decidable_eq G] :
   y ∈ submonoid.powers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
 finset.mem_range_iff_mem_finset_range_of_mod_eq' (order_of_pos x)
   (assume i, pow_eq_mod_order_of.symm)
 
 @[to_additive decidable_multiples]
-noncomputable instance decidable_powers [decidable_eq G] :
-  decidable_pred (∈ submonoid.powers x) :=
-begin
-  assume y,
-  apply decidable_of_iff'
-    (y ∈ (finset.range (order_of x)).image ((^) x)),
-  exact mem_powers_iff_mem_range_order_of
-end
+noncomputable instance decidable_powers : decidable_pred (∈ submonoid.powers x) :=
+classical.dec_pred _
 
 /--The equivalence between `fin (order_of x)` and `submonoid.powers x`, sending `i` to `x ^ i`."-/
 @[to_additive fin_equiv_multiples "The equivalence between `fin (add_order_of a)` and
 `add_submonoid.multiples a`, sending `i` to `i • a`."]
-noncomputable def fin_equiv_powers (x : G) :
+noncomputable def fin_equiv_powers [finite G] (x : G) :
   fin (order_of x) ≃ (submonoid.powers x : set G) :=
-equiv.of_bijective (λ n, ⟨x ^ ↑n, ⟨n, rfl⟩⟩) ⟨λ ⟨i, hi⟩ ⟨j, hj⟩ ij,
-  subtype.mk_eq_mk.2 (pow_injective_of_lt_order_of x hi hj (subtype.mk_eq_mk.1 ij)),
-  λ ⟨_, i, rfl⟩, ⟨⟨i % order_of x, mod_lt i (order_of_pos x)⟩, subtype.eq pow_eq_mod_order_of.symm⟩⟩
+equiv.of_bijective (λ n, ⟨x ^ ↑n, ⟨n, rfl⟩⟩)
+  ⟨λ ⟨i, hi⟩ ⟨j, hj⟩ ij, fin.ext (pow_injective_of_lt_order_of x hi hj (subtype.mk_eq_mk.1 ij)),
+   λ ⟨_, i, rfl⟩, ⟨⟨i % order_of x, mod_lt i (order_of_pos x)⟩,
+    subtype.eq pow_eq_mod_order_of.symm⟩⟩
 
 @[simp, to_additive fin_equiv_multiples_apply]
-lemma fin_equiv_powers_apply {x : G} {n : fin (order_of x)} :
+lemma fin_equiv_powers_apply [finite G] {x : G} {n : fin (order_of x)} :
   fin_equiv_powers x n = ⟨x ^ ↑n, n, rfl⟩ := rfl
 
 @[simp, to_additive fin_equiv_multiples_symm_apply]
-lemma fin_equiv_powers_symm_apply (x : G) (n : ℕ)
+lemma fin_equiv_powers_symm_apply [finite G] (x : G) (n : ℕ)
   {hn : ∃ (m : ℕ), x ^ m = x ^ n} :
   ((fin_equiv_powers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
 by rw [equiv.symm_apply_eq, fin_equiv_powers_apply, subtype.mk_eq_mk,
@@ -523,12 +664,12 @@ by rw [equiv.symm_apply_eq, fin_equiv_powers_apply, subtype.mk_eq_mk,
 @[to_additive multiples_equiv_multiples
 "The equivalence between `submonoid.multiples` of two elements `a, b` of the same additive order,
   mapping `i • a` to `i • b`."]
-noncomputable def powers_equiv_powers (h : order_of x = order_of y) :
+noncomputable def powers_equiv_powers [finite G] (h : order_of x = order_of y) :
   (submonoid.powers x : set G) ≃ (submonoid.powers y : set G) :=
 (fin_equiv_powers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_powers y))
 
 @[simp, to_additive multiples_equiv_multiples_apply]
-lemma powers_equiv_powers_apply (h : order_of x = order_of y)
+lemma powers_equiv_powers_apply [finite G] (h : order_of x = order_of y)
   (n : ℕ) : powers_equiv_powers h ⟨x ^ n, n, rfl⟩ = ⟨y ^ n, n, rfl⟩ :=
 begin
   rw [powers_equiv_powers, equiv.trans_apply, equiv.trans_apply,
@@ -537,17 +678,16 @@ begin
 end
 
 @[to_additive add_order_of_eq_card_multiples]
-lemma order_eq_card_powers [decidable_eq G] :
-  order_of x = fintype.card (submonoid.powers x : set G) :=
+lemma order_eq_card_powers [fintype G] : order_of x = fintype.card (submonoid.powers x : set G) :=
 (fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_powers x⟩)
 
 end finite_cancel_monoid
 
 section finite_group
-variables [group G] [add_group A]
+variables [group G] {x y : G} {n : ℕ}
 
 @[to_additive]
-lemma exists_zpow_eq_one (x : G) : ∃ (i : ℤ) (H : i ≠ 0), x ^ (i : ℤ) = 1 :=
+lemma exists_zpow_eq_one [finite G] (x : G) : ∃ (i : ℤ) (H : i ≠ 0), x ^ (i : ℤ) = 1 :=
 begin
   rcases exists_pow_eq_one x with ⟨w, hw1, hw2⟩,
   refine ⟨w, int.coe_nat_ne_zero.mpr (ne_of_gt hw1), _⟩,
@@ -558,7 +698,7 @@ end
 open subgroup
 
 @[to_additive mem_multiples_iff_mem_zmultiples]
-lemma mem_powers_iff_mem_zpowers : y ∈ submonoid.powers x ↔ y ∈ zpowers x :=
+lemma mem_powers_iff_mem_zpowers [finite G] : y ∈ submonoid.powers x ↔ y ∈ zpowers x :=
 ⟨λ ⟨n, hn⟩, ⟨n, by simp * at *⟩,
 λ ⟨i, hi⟩, ⟨(i % order_of x).nat_abs,
   by rwa [← zpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
@@ -566,37 +706,49 @@ lemma mem_powers_iff_mem_zpowers : y ∈ submonoid.powers x ↔ y ∈ zpowers x
     ← zpow_eq_mod_order_of]⟩⟩
 
 @[to_additive multiples_eq_zmultiples]
-lemma powers_eq_zpowers (x : G) : (submonoid.powers x : set G) = zpowers x :=
+lemma powers_eq_zpowers [finite G] (x : G) : (submonoid.powers x : set G) = zpowers x :=
 set.ext $ λ x, mem_powers_iff_mem_zpowers
 
 @[to_additive mem_zmultiples_iff_mem_range_add_order_of]
-lemma mem_zpowers_iff_mem_range_order_of [decidable_eq G] :
+lemma mem_zpowers_iff_mem_range_order_of [finite G] [decidable_eq G] :
   y ∈ subgroup.zpowers x ↔ y ∈ (finset.range (order_of x)).image ((^) x : ℕ → G) :=
 by rw [← mem_powers_iff_mem_zpowers, mem_powers_iff_mem_range_order_of]
 
-@[to_additive decidable_zmultiples]
-noncomputable instance decidable_zpowers [decidable_eq G] :
-  decidable_pred (∈ subgroup.zpowers x) :=
+@[to_additive] lemma zpow_eq_one_iff_modeq {n : ℤ} : x ^ n = 1 ↔ n ≡ 0 [ZMOD (order_of x)] :=
+by rw [int.modeq_zero_iff_dvd, order_of_dvd_iff_zpow_eq_one]
+
+@[to_additive] lemma zpow_eq_zpow_iff_modeq {m n : ℤ} : x ^ m = x ^ n ↔ m ≡ n [ZMOD (order_of x)] :=
+by rw [←mul_inv_eq_one, ←zpow_sub, zpow_eq_one_iff_modeq, int.modeq_iff_dvd, int.modeq_iff_dvd,
+  zero_sub, neg_sub]
+
+@[simp, to_additive] lemma injective_zpow_iff_not_is_of_fin_order :
+  injective (λ n : ℤ, x ^ n) ↔ ¬ is_of_fin_order x :=
 begin
-  simp_rw ←set_like.mem_coe,
-  rw ← powers_eq_zpowers,
-  exact decidable_powers,
+  refine ⟨_, λ h n m hnm, _⟩,
+  { simp_rw is_of_fin_order_iff_pow_eq_one,
+    rintro h ⟨n, hn, hx⟩,
+    exact nat.cast_ne_zero.2 hn.ne' (h $ by simpa using hx) },
+  rwa [zpow_eq_zpow_iff_modeq, order_of_eq_zero_iff.2 h, nat.cast_zero, int.modeq_zero_iff] at hnm,
 end
 
+@[to_additive decidable_zmultiples]
+noncomputable instance decidable_zpowers : decidable_pred (∈ subgroup.zpowers x) :=
+classical.dec_pred _
+
 /-- The equivalence between `fin (order_of x)` and `subgroup.zpowers x`, sending `i` to `x ^ i`. -/
 @[to_additive fin_equiv_zmultiples
 "The equivalence between `fin (add_order_of a)` and `subgroup.zmultiples a`, sending `i`
 to `i • a`."]
-noncomputable def fin_equiv_zpowers (x : G) :
+noncomputable def fin_equiv_zpowers [finite G] (x : G) :
   fin (order_of x) ≃ (subgroup.zpowers x : set G) :=
 (fin_equiv_powers x).trans (equiv.set.of_eq (powers_eq_zpowers x))
 
 @[simp, to_additive fin_equiv_zmultiples_apply]
-lemma fin_equiv_zpowers_apply {n : fin (order_of x)} :
+lemma fin_equiv_zpowers_apply [finite G] {n : fin (order_of x)} :
   fin_equiv_zpowers x n = ⟨x ^ (n : ℕ), n, zpow_coe_nat x n⟩ := rfl
 
 @[simp, to_additive fin_equiv_zmultiples_symm_apply]
-lemma fin_equiv_zpowers_symm_apply (x : G) (n : ℕ)
+lemma fin_equiv_zpowers_symm_apply [finite G] (x : G) (n : ℕ)
   {hn : ∃ (m : ℤ), x ^ m = x ^ n} :
   ((fin_equiv_zpowers x).symm ⟨x ^ n, hn⟩) = ⟨n % order_of x, nat.mod_lt _ (order_of_pos x)⟩ :=
 by { rw [fin_equiv_zpowers, equiv.symm_trans_apply, equiv.set.of_eq_symm_apply],
@@ -607,12 +759,12 @@ by { rw [fin_equiv_zpowers, equiv.symm_trans_apply, equiv.set.of_eq_symm_apply],
 @[to_additive zmultiples_equiv_zmultiples
 "The equivalence between `subgroup.zmultiples` of two elements `a, b` of the same additive order,
   mapping `i • a` to `i • b`."]
-noncomputable def zpowers_equiv_zpowers (h : order_of x = order_of y) :
+noncomputable def zpowers_equiv_zpowers [finite G] (h : order_of x = order_of y) :
   (subgroup.zpowers x : set G) ≃ (subgroup.zpowers y : set G) :=
 (fin_equiv_zpowers x).symm.trans ((fin.cast h).to_equiv.trans (fin_equiv_zpowers y))
 
 @[simp, to_additive zmultiples_equiv_zmultiples_apply]
-lemma zpowers_equiv_zpowers_apply (h : order_of x = order_of y)
+lemma zpowers_equiv_zpowers_apply [finite G] (h : order_of x = order_of y)
   (n : ℕ) : zpowers_equiv_zpowers h ⟨x ^ n, n, zpow_coe_nat x n⟩ = ⟨y ^ n, n, zpow_coe_nat y n⟩ :=
 begin
   rw [zpowers_equiv_zpowers, equiv.trans_apply, equiv.trans_apply,
@@ -620,14 +772,15 @@ begin
   simp [h]
 end
 
-@[to_additive add_order_eq_card_zmultiples]
-lemma order_eq_card_zpowers [decidable_eq G] :
-  order_of x = fintype.card (subgroup.zpowers x : set G) :=
+variables [fintype G]
+
+/-- See also `nat.card_zpowers'`. -/
+@[to_additive add_order_eq_card_zmultiples "See also `nat.card_zmultiples`."]
+lemma order_eq_card_zpowers : order_of x = fintype.card (zpowers x) :=
 (fintype.card_fin (order_of x)).symm.trans (fintype.card_eq.2 ⟨fin_equiv_zpowers x⟩)
 
 open quotient_group
 
-/- TODO: use cardinal theory, introduce `card : set G → ℕ`, or setup decidability for cosets -/
 @[to_additive add_order_of_dvd_card_univ]
 lemma order_of_dvd_card_univ : order_of x ∣ fintype.card G :=
 begin
@@ -652,13 +805,25 @@ begin
           (by rw [eq₁, eq₂, mul_comm])
 end
 
-@[simp, to_additive card_nsmul_eq_zero] lemma pow_card_eq_one : x ^ fintype.card G = 1 :=
-let ⟨m, hm⟩ := @order_of_dvd_card_univ _ x _ _ in
-by simp [hm, pow_mul, pow_order_of_eq_one]
+@[to_additive add_order_of_dvd_nat_card]
+lemma order_of_dvd_nat_card {G : Type*} [group G] {x : G} : order_of x ∣ nat.card G :=
+begin
+  casesI fintype_or_infinite G with h h,
+  { simp only [nat.card_eq_fintype_card, order_of_dvd_card_univ] },
+  { simp only [card_eq_zero_of_infinite, dvd_zero] },
+end
+
+@[simp, to_additive card_nsmul_eq_zero']
+lemma pow_card_eq_one' {G : Type*} [group G] {x : G} : x ^ nat.card G = 1 :=
+order_of_dvd_iff_pow_eq_one.mp order_of_dvd_nat_card
+
+@[simp, to_additive card_nsmul_eq_zero]
+lemma pow_card_eq_one : x ^ fintype.card G = 1 :=
+by rw [←nat.card_eq_fintype_card, pow_card_eq_one']
 
 @[to_additive] lemma subgroup.pow_index_mem {G : Type*} [group G] (H : subgroup G)
-  [fintype (G ⧸ H)] [normal H] (g : G) : g ^ index H ∈ H :=
-by rw [←eq_one_iff, quotient_group.coe_pow H, index_eq_card, pow_card_eq_one]
+  [normal H] (g : G) : g ^ index H ∈ H :=
+by rw [←eq_one_iff, quotient_group.coe_pow H, index, pow_card_eq_one']
 
 @[to_additive] lemma pow_eq_mod_card (n : ℕ) :
   x ^ n = x ^ (n % fintype.card G) :=
@@ -672,23 +837,23 @@ by rw [zpow_eq_mod_order_of, ← int.mod_mod_of_dvd n (int.coe_nat_dvd.2 order_o
 
 /-- If `gcd(|G|,n)=1` then the `n`th power map is a bijection -/
 @[to_additive "If `gcd(|G|,n)=1` then the smul by `n` is a bijection", simps]
-  def pow_coprime (h : nat.coprime (fintype.card G) n) : G ≃ G :=
+noncomputable def pow_coprime {G : Type*} [group G] (h : (nat.card G).coprime n) : G ≃ G :=
 { to_fun := λ g, g ^ n,
-  inv_fun := λ g, g ^ (nat.gcd_b (fintype.card G) n),
+  inv_fun := λ g, g ^ ((nat.card G).gcd_b n),
   left_inv := λ g, by
-  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
+  { have key := congr_arg ((^) g) ((nat.card G).gcd_eq_gcd_ab n),
     rwa [zpow_add, zpow_mul, zpow_mul, zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
-      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key },
+      h.gcd_eq_one, pow_one, pow_card_eq_one', one_zpow, one_mul, eq_comm] at key },
   right_inv := λ g, by
-  { have key : g ^ _ = g ^ _ := congr_arg (λ n : ℤ, g ^ n) (nat.gcd_eq_gcd_ab (fintype.card G) n),
+  { have key := congr_arg ((^) g) ((nat.card G).gcd_eq_gcd_ab n),
     rwa [zpow_add, zpow_mul, zpow_mul', zpow_coe_nat, zpow_coe_nat, zpow_coe_nat,
-      h.gcd_eq_one, pow_one, pow_card_eq_one, one_zpow, one_mul, eq_comm] at key } }
+      h.gcd_eq_one, pow_one, pow_card_eq_one', one_zpow, one_mul, eq_comm] at key } }
 
-@[simp, to_additive] lemma pow_coprime_one (h : nat.coprime (fintype.card G) n) :
+@[simp, to_additive] lemma pow_coprime_one {G : Type*} [group G] (h : (nat.card G).coprime n) :
   pow_coprime h 1 = 1 := one_pow n
 
-@[simp, to_additive] lemma pow_coprime_inv (h : nat.coprime (fintype.card G) n) {g : G} :
-  pow_coprime h g⁻¹ = (pow_coprime h g)⁻¹ := inv_pow g n
+@[simp, to_additive] lemma pow_coprime_inv {G : Type*} [group G] (h : (nat.card G).coprime n)
+  {g : G} : pow_coprime h g⁻¹ = (pow_coprime h g)⁻¹ := inv_pow g n
 
 @[to_additive add_inf_eq_bot_of_coprime]
 lemma inf_eq_bot_of_coprime {G : Type*} [group G] {H K : subgroup G} [fintype H] [fintype K]
@@ -700,16 +865,14 @@ begin
     (congr_arg (∣ fintype.card K) (order_of_subgroup ⟨x, hx.2⟩)).mpr order_of_dvd_card_univ⟩,
 end
 
-variable (a)
-
 /-- TODO: Generalise to `submonoid.powers`.-/
-@[to_additive image_range_add_order_of]
+@[to_additive image_range_add_order_of, nolint to_additive_doc]
 lemma image_range_order_of [decidable_eq G] :
   finset.image (λ i, x ^ i) (finset.range (order_of x)) = (zpowers x : set G).to_finset :=
 by { ext x, rw [set.mem_to_finset, set_like.mem_coe, mem_zpowers_iff_mem_range_order_of] }
 
-/-- TODO: Generalise to `finite_cancel_monoid`. -/
-@[to_additive gcd_nsmul_card_eq_zero_iff]
+/-- TODO: Generalise to `finite` + `cancel_monoid`. -/
+@[to_additive gcd_nsmul_card_eq_zero_iff "TODO: Generalise to `finite` + `cancel_add_monoid`"]
 lemma pow_gcd_card_eq_one_iff : x ^ n = 1 ↔ x ^ (gcd n (fintype.card G)) = 1 :=
 ⟨λ h, pow_gcd_eq_one _ h $ pow_card_eq_one,
   λ h, let ⟨m, hm⟩ := gcd_dvd_left n (fintype.card G) in
@@ -717,8 +880,6 @@ lemma pow_gcd_card_eq_one_iff : x ^ n = 1 ↔ x ^ (gcd n (fintype.card G)) = 1 :
 
 end finite_group
 
-end fintype
-
 section pow_is_subgroup
 
 /-- A nonempty idempotent subset of a finite cancellative monoid is a submonoid -/
@@ -755,11 +916,9 @@ have one_mem : (1 : G) ∈ (S ^ fintype.card G) := by
   rw ← pow_card_eq_one,
   exact set.pow_mem_pow ha (fintype.card G) },
 subgroup_of_idempotent (S ^ (fintype.card G)) ⟨1, one_mem⟩ begin
-  classical,
-  refine (set.eq_of_subset_of_card_le
-    (λ b hb, (congr_arg (∈ _) (one_mul b)).mp (set.mul_mem_mul one_mem hb)) (ge_of_eq _)).symm,
-  change _ = fintype.card (_ * _ : set G),
-  rw [←pow_add, group.card_pow_eq_card_pow_card_univ S (fintype.card G) le_rfl,
+  classical!,
+  refine (set.eq_of_subset_of_card_le (set.subset_mul_left _ one_mem) (ge_of_eq _)).symm,
+  simp_rw [← pow_add, group.card_pow_eq_card_pow_card_univ S (fintype.card G) le_rfl,
       group.card_pow_eq_card_pow_card_univ S (fintype.card G + fintype.card G) le_add_self],
 end
 
@@ -767,7 +926,7 @@ end pow_is_subgroup
 
 section linear_ordered_ring
 
-variable [linear_ordered_ring G]
+variables [linear_ordered_ring G] {x : G}
 
 lemma order_of_abs_ne_one (h : |x| ≠ 1) : order_of x = 0 :=
 begin
@@ -789,3 +948,34 @@ begin
 end
 
 end linear_ordered_ring
+
+section prod
+variables [monoid α] [monoid β] {x : α × β} {a : α} {b : β}
+
+@[to_additive prod.add_order_of] protected lemma prod.order_of (x : α × β) :
+  order_of x = (order_of x.1).lcm (order_of x.2) :=
+minimal_period_prod_map _ _ _
+
+@[to_additive add_order_of_fst_dvd_add_order_of] lemma order_of_fst_dvd_order_of :
+  order_of x.1 ∣ order_of x :=
+minimal_period_fst_dvd
+
+@[to_additive add_order_of_snd_dvd_add_order_of] lemma order_of_snd_dvd_order_of :
+  order_of x.2 ∣ order_of x :=
+minimal_period_snd_dvd
+
+@[to_additive is_of_fin_add_order.fst]
+lemma is_of_fin_order.fst {x : α × β} (hx : is_of_fin_order x) : is_of_fin_order x.1 :=
+hx.mono order_of_fst_dvd_order_of
+
+@[to_additive is_of_fin_add_order.snd]
+lemma is_of_fin_order.snd {x : α × β} (hx : is_of_fin_order x) : is_of_fin_order x.2 :=
+hx.mono order_of_snd_dvd_order_of
+
+@[to_additive is_of_fin_add_order.prod_mk]
+lemma is_of_fin_order.prod_mk : is_of_fin_order a → is_of_fin_order b → is_of_fin_order (a, b) :=
+by simpa only [←order_of_pos_iff, prod.order_of] using nat.lcm_pos
+
+end prod
+
+-- TODO: Corresponding `pi` lemmas. We cannot currently state them here because of import cycles
diff --git a/src/group_theory/p_group.lean b/src/group_theory/p_group.lean
index cd1ac4f63fb67..0a4c8224a0536 100644
--- a/src/group_theory/p_group.lean
+++ b/src/group_theory/p_group.lean
@@ -7,12 +7,17 @@ Authors: Chris Hughes, Thomas Browning
 import data.zmod.basic
 import group_theory.index
 import group_theory.group_action.conj_act
-import group_theory.perm.cycle_type
-import group_theory.quotient_group
+import group_theory.group_action.quotient
+import group_theory.perm.cycle.type
+import group_theory.specific_groups.cyclic
+import tactic.interval_cases
 
 /-!
 # p-groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains a proof that if `G` is a `p`-group acting on a finite set `α`,
 then the number of fixed points of the action is congruent mod `p` to the cardinality of `α`.
 It also contains proofs of some corollaries of this lemma about existence of fixed points.
@@ -50,11 +55,11 @@ begin
   refine ⟨λ h, _, λ ⟨n, hn⟩, of_card hn⟩,
   suffices : ∀ q ∈ nat.factors (card G), q = p,
   { use (card G).factors.length,
-    rw [←list.prod_repeat, ←list.eq_repeat_of_mem this, nat.prod_factors hG] },
+    rw [←list.prod_replicate, ←list.eq_replicate_of_mem this, nat.prod_factors hG] },
   intros q hq,
   obtain ⟨hq1, hq2⟩ := (nat.mem_factors hG).mp hq,
   haveI : fact q.prime := ⟨hq1⟩,
-  obtain ⟨g, hg⟩ := equiv.perm.exists_prime_order_of_dvd_card q hq2,
+  obtain ⟨g, hg⟩ := exists_prime_order_of_dvd_card q hq2,
   obtain ⟨k, hk⟩ := (iff_order_of.mp h) g,
   exact (hq1.pow_eq_iff.mp (hg.symm.trans hk).symm).1.symm,
 end
@@ -89,19 +94,61 @@ hG.of_surjective (quotient_group.mk' H) quotient.surjective_quotient_mk'
 lemma of_equiv {H : Type*} [group H] (ϕ : G ≃* H) : is_p_group p H :=
 hG.of_surjective ϕ.to_monoid_hom ϕ.surjective
 
+lemma order_of_coprime {n : ℕ} (hn : p.coprime n) (g : G) : (order_of g).coprime n :=
+let ⟨k, hk⟩ := hG g in (hn.pow_left k).coprime_dvd_left (order_of_dvd_of_pow_eq_one hk)
+
+/-- If `gcd(p,n) = 1`, then the `n`th power map is a bijection. -/
+noncomputable def pow_equiv {n : ℕ} (hn : p.coprime n) : G ≃ G :=
+let h : ∀ g : G, (nat.card (subgroup.zpowers g)).coprime n :=
+  λ g, order_eq_card_zpowers' g ▸ hG.order_of_coprime hn g in
+{ to_fun := (^ n),
+  inv_fun := λ g, (pow_coprime (h g)).symm ⟨g, subgroup.mem_zpowers g⟩,
+  left_inv := λ g, subtype.ext_iff.1 $ (pow_coprime (h (g ^ n))).left_inv
+    ⟨g, _, subtype.ext_iff.1 $ (pow_coprime (h g)).left_inv ⟨g, subgroup.mem_zpowers g⟩⟩,
+  right_inv := λ g, subtype.ext_iff.1 $ (pow_coprime (h g)).right_inv ⟨g, subgroup.mem_zpowers g⟩ }
+
+@[simp] lemma pow_equiv_apply {n : ℕ} (hn : p.coprime n) (g : G) : hG.pow_equiv hn g = g ^ n :=
+rfl
+
+@[simp] lemma pow_equiv_symm_apply {n : ℕ} (hn : p.coprime n) (g : G) :
+  (hG.pow_equiv hn).symm g = g ^ (order_of g).gcd_b n :=
+by rw order_eq_card_zpowers'; refl
+
 variables [hp : fact p.prime]
 
 include hp
 
-lemma index (H : subgroup G) [fintype (G ⧸ H)] :
-  ∃ n : ℕ, H.index = p ^ n :=
+/-- If `p ∤ n`, then the `n`th power map is a bijection. -/
+@[reducible] noncomputable def pow_equiv' {n : ℕ} (hn : ¬ p ∣ n) : G ≃ G :=
+pow_equiv hG (hp.out.coprime_iff_not_dvd.mpr hn)
+
+lemma index (H : subgroup G) [H.finite_index] : ∃ n : ℕ, H.index = p ^ n :=
 begin
+  haveI := H.normal_core.fintype_quotient_of_finite_index,
   obtain ⟨n, hn⟩ := iff_card.mp (hG.to_quotient H.normal_core),
   obtain ⟨k, hk1, hk2⟩ := (nat.dvd_prime_pow hp.out).mp ((congr_arg _
     (H.normal_core.index_eq_card.trans hn)).mp (subgroup.index_dvd_of_le H.normal_core_le)),
   exact ⟨k, hk2⟩,
 end
 
+lemma card_eq_or_dvd : nat.card G = 1 ∨ p ∣ nat.card G :=
+begin
+  casesI fintype_or_infinite G,
+  { obtain ⟨n, hn⟩ := iff_card.mp hG,
+    rw [nat.card_eq_fintype_card, hn],
+    cases n,
+    { exact or.inl rfl },
+    { exact or.inr ⟨p ^ n, rfl⟩ } },
+  { rw nat.card_eq_zero_of_infinite,
+    exact or.inr ⟨0, rfl⟩ },
+end
+
+lemma nontrivial_iff_card [fintype G] : nontrivial G ↔ ∃ n > 0, card G = p ^ n :=
+⟨λ hGnt, let ⟨k, hk⟩ := iff_card.1 hG in ⟨k, nat.pos_of_ne_zero $ λ hk0,
+  by rw [hk0, pow_zero] at hk; exactI fintype.one_lt_card.ne' hk, hk⟩,
+λ ⟨k, hk0, hk⟩, one_lt_card_iff_nontrivial.1 $ hk.symm ▸
+  one_lt_pow (fact.out p.prime).one_lt (ne_of_gt hk0)⟩
+
 variables {α : Type*} [mul_action G α]
 
 lemma card_orbit (a : α) [fintype (orbit G a)] :
@@ -109,15 +156,17 @@ lemma card_orbit (a : α) [fintype (orbit G a)] :
 begin
   let ϕ := orbit_equiv_quotient_stabilizer G a,
   haveI := fintype.of_equiv (orbit G a) ϕ,
+  haveI := (stabilizer G a).finite_index_of_finite_quotient,
   rw [card_congr ϕ, ←subgroup.index_eq_card],
   exact hG.index (stabilizer G a),
 end
 
-variables (α) [fintype α] [fintype (fixed_points G α)]
+variables (α) [fintype α]
 
 /-- If `G` is a `p`-group acting on a finite set `α`, then the number of fixed points
   of the action is congruent mod `p` to the cardinality of `α` -/
-lemma card_modeq_card_fixed_points : card α ≡ card (fixed_points G α) [MOD p] :=
+lemma card_modeq_card_fixed_points [fintype (fixed_points G α)] :
+  card α ≡ card (fixed_points G α) [MOD p] :=
 begin
   classical,
   calc card α = card (Σ y : quotient (orbit_rel G α), {x // quotient.mk' x = y}) :
@@ -133,18 +182,21 @@ begin
       (λ b, quotient.induction_on' b (λ b _ hb, _)) (λ a ha _, by
       { rw [key, mem_fixed_points_iff_card_orbit_eq_one.mp a.2] })),
   obtain ⟨k, hk⟩ := hG.card_orbit b,
-  have : k = 0 := nat.le_zero_iff.1 (nat.le_of_lt_succ (lt_of_not_ge (mt (pow_dvd_pow p)
-    (by rwa [pow_one, ←hk, ←nat.modeq_zero_iff_dvd, ←zmod.eq_iff_modeq_nat, ←key])))),
+  have : k = 0 := le_zero_iff.1 (nat.le_of_lt_succ (lt_of_not_ge (mt (pow_dvd_pow p)
+    (by rwa [pow_one, ←hk, ←nat.modeq_zero_iff_dvd, ←zmod.eq_iff_modeq_nat, ←key,
+      nat.cast_zero])))),
   exact ⟨⟨b, mem_fixed_points_iff_card_orbit_eq_one.2 $ by rw [hk, this, pow_zero]⟩,
     finset.mem_univ _, (ne_of_eq_of_ne nat.cast_one one_ne_zero), rfl⟩,
 end
 
 /-- If a p-group acts on `α` and the cardinality of `α` is not a multiple
   of `p` then the action has a fixed point. -/
-lemma nonempty_fixed_point_of_prime_not_dvd_card (hpα : ¬ p ∣ card α) :
+lemma nonempty_fixed_point_of_prime_not_dvd_card (hpα : ¬ p ∣ card α)
+  [finite (fixed_points G α)] :
   (fixed_points G α).nonempty :=
 @set.nonempty_of_nonempty_subtype _ _ begin
-rw [←card_pos_iff, pos_iff_ne_zero],
+  casesI nonempty_fintype (fixed_points G α),
+  rw [←card_pos_iff, pos_iff_ne_zero],
   contrapose! hpα,
   rw [←nat.modeq_zero_iff_dvd, ←hpα],
   exact hG.card_modeq_card_fixed_points α,
@@ -155,30 +207,32 @@ end
 lemma exists_fixed_point_of_prime_dvd_card_of_fixed_point
   (hpα : p ∣ card α) {a : α} (ha : a ∈ fixed_points G α) :
   ∃ b, b ∈ fixed_points G α ∧ a ≠ b :=
-have hpf : p ∣ card (fixed_points G α) :=
-  nat.modeq_zero_iff_dvd.mp ((hG.card_modeq_card_fixed_points α).symm.trans hpα.modeq_zero_nat),
-have hα : 1 < card (fixed_points G α) :=
-  (fact.out p.prime).one_lt.trans_le (nat.le_of_dvd (card_pos_iff.2 ⟨⟨a, ha⟩⟩) hpf),
-let ⟨⟨b, hb⟩, hba⟩ := exists_ne_of_one_lt_card hα ⟨a, ha⟩ in
-⟨b, hb, λ hab, hba (by simp_rw [hab])⟩
-
-lemma center_nontrivial [nontrivial G] [fintype G] : nontrivial (subgroup.center G) :=
+begin
+  casesI nonempty_fintype (fixed_points G α),
+  have hpf : p ∣ card (fixed_points G α) :=
+    nat.modeq_zero_iff_dvd.mp ((hG.card_modeq_card_fixed_points α).symm.trans hpα.modeq_zero_nat),
+  have hα : 1 < card (fixed_points G α) :=
+    (fact.out p.prime).one_lt.trans_le (nat.le_of_dvd (card_pos_iff.2 ⟨⟨a, ha⟩⟩) hpf),
+  exact let ⟨⟨b, hb⟩, hba⟩ := exists_ne_of_one_lt_card hα ⟨a, ha⟩ in
+  ⟨b, hb, λ hab, hba (by simp_rw [hab])⟩
+end
+
+lemma center_nontrivial [nontrivial G] [finite G] : nontrivial (subgroup.center G) :=
 begin
   classical,
+  casesI nonempty_fintype G,
   have := (hG.of_equiv conj_act.to_conj_act).exists_fixed_point_of_prime_dvd_card_of_fixed_point G,
   rw conj_act.fixed_points_eq_center at this,
   obtain ⟨g, hg⟩ := this _ (subgroup.center G).one_mem,
   { exact ⟨⟨1, ⟨g, hg.1⟩, mt subtype.ext_iff.mp hg.2⟩⟩ },
-  { obtain ⟨n, hn⟩ := is_p_group.iff_card.mp hG,
-    rw hn,
-    apply dvd_pow_self,
-    rintro rfl,
-    exact (fintype.one_lt_card).ne' hn },
+  { obtain ⟨n, hn0, hn⟩ := hG.nontrivial_iff_card.mp infer_instance,
+    exact hn.symm ▸ dvd_pow_self _ (ne_of_gt hn0) },
 end
 
-lemma bot_lt_center [nontrivial G] [fintype G] : ⊥ < subgroup.center G :=
+lemma bot_lt_center [nontrivial G] [finite G] : ⊥ < subgroup.center G :=
 begin
   haveI := center_nontrivial hG,
+  casesI nonempty_fintype G,
   classical,
   exact bot_lt_iff_ne_bot.mpr ((subgroup.center G).one_lt_card_iff_ne_bot.mp fintype.one_lt_card),
 end
@@ -238,11 +292,11 @@ lemma to_sup_of_normal_left {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_
 
 lemma to_sup_of_normal_right' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
   (hHK : H ≤ K.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
-let hHK' := to_sup_of_normal_right (hH.of_equiv (subgroup.comap_subtype_equiv_of_le hHK).symm)
-  (hK.of_equiv (subgroup.comap_subtype_equiv_of_le subgroup.le_normalizer).symm) in
+let hHK' := to_sup_of_normal_right (hH.of_equiv (subgroup.subgroup_of_equiv_of_le hHK).symm)
+  (hK.of_equiv (subgroup.subgroup_of_equiv_of_le subgroup.le_normalizer).symm) in
 ((congr_arg (λ H : subgroup K.normalizer, is_p_group p H)
   (subgroup.sup_subgroup_of_eq hHK subgroup.le_normalizer)).mp hHK').of_equiv
-  (subgroup.comap_subtype_equiv_of_le (sup_le hHK subgroup.le_normalizer))
+  (subgroup.subgroup_of_equiv_of_le (sup_le hHK subgroup.le_normalizer))
 
 lemma to_sup_of_normal_left' {H K : subgroup G} (hH : is_p_group p H) (hK : is_p_group p K)
   (hHK : K ≤ H.normalizer) : is_p_group p (H ⊔ K : subgroup G) :=
@@ -265,18 +319,61 @@ lemma disjoint_of_ne (p₁ p₂ : ℕ) [hp₁ : fact p₁.prime] [hp₂ : fact p
   (H₁ H₂ : subgroup G) (hH₁ : is_p_group p₁ H₁) (hH₂ : is_p_group p₂ H₂) :
   disjoint H₁ H₂ :=
 begin
-  rintro x ⟨hx₁, hx₂⟩,
-  rw subgroup.mem_bot,
+  rw subgroup.disjoint_def,
+  intros x hx₁ hx₂,
   obtain ⟨n₁, hn₁⟩ := iff_order_of.mp hH₁ ⟨x, hx₁⟩,
   obtain ⟨n₂, hn₂⟩ := iff_order_of.mp hH₂ ⟨x, hx₂⟩,
   rw [← order_of_subgroup, subgroup.coe_mk] at hn₁ hn₂,
   have : p₁ ^ n₁ = p₂ ^ n₂, by rw [← hn₁, ← hn₂],
-  have : n₁ = 0,
-  { contrapose! hne with h,
-    rw ← associated_iff_eq at this ⊢,
-    exact associated.of_pow_associated_of_prime
-      (nat.prime_iff.mp hp₁.elim) (nat.prime_iff.mp hp₂.elim) (ne.bot_lt h) this },
-  simpa [this] using hn₁,
+  rcases n₁.eq_zero_or_pos with rfl|hn₁,
+  { simpa using hn₁ },
+  { exact absurd (eq_of_prime_pow_eq hp₁.out.prime hp₂.out.prime hn₁ this) hne }
 end
 
+section p2comm
+
+variables [fintype G] [fact p.prime] {n : ℕ} (hGpn : card G = p ^ n)
+include hGpn
+open subgroup
+
+/-- The cardinality of the `center` of a `p`-group is `p ^ k` where `k` is positive. -/
+lemma card_center_eq_prime_pow (hn : 0 < n) [fintype (center G)] :
+  ∃ k > 0, card (center G) = p ^ k :=
+begin
+  have hcG := to_subgroup (of_card hGpn) (center G),
+  rcases iff_card.1 hcG with ⟨k, hk⟩,
+  haveI : nontrivial G := (nontrivial_iff_card $ of_card hGpn).2 ⟨n, hn, hGpn⟩,
+  exact (nontrivial_iff_card hcG).mp (center_nontrivial (of_card hGpn)),
+end
+
+omit hGpn
+
+/-- The quotient by the center of a group of cardinality `p ^ 2` is cyclic. -/
+lemma cyclic_center_quotient_of_card_eq_prime_sq (hG : card G = p ^ 2) :
+  is_cyclic (G ⧸ (center G)) :=
+begin
+  classical,
+  rcases card_center_eq_prime_pow hG zero_lt_two with ⟨k, hk0, hk⟩,
+  rw [card_eq_card_quotient_mul_card_subgroup (center G), mul_comm, hk] at hG,
+  have hk2 := (nat.pow_dvd_pow_iff_le_right (fact.out p.prime).one_lt).1 ⟨_, hG.symm⟩,
+  interval_cases k,
+  { rw [sq, pow_one, mul_right_inj' (fact.out p.prime).ne_zero] at hG,
+    exact is_cyclic_of_prime_card hG },
+  { exact @is_cyclic_of_subsingleton _ _ ⟨fintype.card_le_one_iff.1 (mul_right_injective₀
+      (pow_ne_zero 2 (ne_zero.ne p)) (hG.trans (mul_one (p ^ 2)).symm)).le⟩ },
+end
+
+/-- A group of order `p ^ 2` is commutative. See also `is_p_group.commutative_of_card_eq_prime_sq`
+for just the proof that `∀ a b, a * b = b * a` -/
+def comm_group_of_card_eq_prime_sq (hG : card G = p ^ 2) : comm_group G :=
+@comm_group_of_cycle_center_quotient _ _ _ _ (cyclic_center_quotient_of_card_eq_prime_sq hG) _
+  (quotient_group.ker_mk (center G)).le
+
+/-- A group of order `p ^ 2` is commutative. See also `is_p_group.comm_group_of_card_eq_prime_sq`
+for the `comm_group` instance. -/
+lemma commutative_of_card_eq_prime_sq (hG : card G = p ^ 2) : ∀ a b : G, a * b = b * a :=
+(comm_group_of_card_eq_prime_sq hG).mul_comm
+
+end p2comm
+
 end is_p_group
diff --git a/src/group_theory/perm/basic.lean b/src/group_theory/perm/basic.lean
index 0e0e1c801dbe3..0f6b7a4f8c9ab 100644
--- a/src/group_theory/perm/basic.lean
+++ b/src/group_theory/perm/basic.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Mario Carneiro
 -/
 import algebra.group.pi
-import algebra.group_power.lemmas
-import logic.function.iterate
+import algebra.group.prod
+import algebra.hom.iterate
+import logic.equiv.set
 
 /-!
 # The group of permutations (self-equivalences) of a type `α`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the `group` structure on `equiv.perm α`.
 -/
 universes u v
@@ -29,6 +33,24 @@ instance perm_group : group (perm α) :=
   mul_one := refl_trans,
   mul_left_inv := self_trans_symm }
 
+@[simp] lemma default_eq : (default : perm α) = 1 := rfl
+
+/-- The permutation of a type is equivalent to the units group of the endomorphisms monoid of this
+type. -/
+@[simps] def equiv_units_End : perm α ≃* units (function.End α) :=
+{ to_fun := λ e, ⟨e, e.symm, e.self_comp_symm, e.symm_comp_self⟩,
+  inv_fun := λ u, ⟨(u : function.End α), (↑u⁻¹ : function.End α), congr_fun u.inv_val,
+    congr_fun u.val_inv⟩,
+  left_inv := λ e, ext $ λ x, rfl,
+  right_inv := λ u, units.ext rfl,
+  map_mul' := λ e₁ e₂, rfl }
+
+/-- Lift a monoid homomorphism `f : G →* function.End α` to a monoid homomorphism
+`f : G →* equiv.perm α`. -/
+@[simps] def _root_.monoid_hom.to_hom_perm {G : Type*} [group G] (f : G →* function.End α) :
+  G →* perm α :=
+equiv_units_End.symm.to_monoid_hom.comp f.to_hom_units
+
 theorem mul_apply (f g : perm α) (x) : (f * g) x = f (g x) :=
 equiv.trans_apply _ _ _
 
@@ -44,9 +66,11 @@ lemma mul_def (f g : perm α) : f * g = g.trans f := rfl
 
 lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl
 
-@[simp] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl
-
-@[simp] lemma coe_one : ⇑(1 : perm α) = id := rfl
+@[simp, norm_cast] lemma coe_one : ⇑(1 : perm α) = id := rfl
+@[simp, norm_cast] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl
+@[norm_cast] lemma coe_pow (f : perm α) (n : ℕ) : ⇑(f ^ n) = (f^[n]) :=
+hom_coe_pow _ rfl (λ _ _, rfl) _ _
+@[simp] lemma iterate_eq_pow (f : perm α) (n : ℕ) : (f^[n]) = ⇑(f ^ n) := (coe_pow _ _).symm
 
 lemma eq_inv_iff_eq {f : perm α} {x y : α} : x = f⁻¹ y ↔ f x = y := f.eq_symm_apply
 
@@ -56,9 +80,9 @@ lemma zpow_apply_comm {α : Type*} (σ : perm α) (m n : ℤ) {x : α} :
   (σ ^ m) ((σ ^ n) x) = (σ ^ n) ((σ ^ m) x) :=
 by rw [←equiv.perm.mul_apply, ←equiv.perm.mul_apply, zpow_mul_comm]
 
-@[simp] lemma iterate_eq_pow (f : perm α) : ∀ n, f^[n] = ⇑(f ^ n)
-| 0       := rfl
-| (n + 1) := by { rw [function.iterate_succ, pow_add, iterate_eq_pow], refl }
+@[simp] lemma image_inv (f : perm α) (s : set α) : ⇑f⁻¹ '' s = f ⁻¹' s := f⁻¹.image_eq_preimage _
+@[simp] lemma preimage_inv (f : perm α) (s : set α) : ⇑f⁻¹ ⁻¹' s = f '' s :=
+(f.image_eq_preimage _).symm
 
 /-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
 `equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
@@ -215,82 +239,106 @@ lemma extend_domain_hom_injective : function.injective (extend_domain_hom f) :=
   e.extend_domain f = 1 ↔ e = 1 :=
 (injective_iff_map_eq_one' (extend_domain_hom f)).mp (extend_domain_hom_injective f) e
 
+@[simp] lemma extend_domain_pow (n : ℕ) : (e ^ n).extend_domain f = e.extend_domain f ^ n :=
+map_pow (extend_domain_hom f) _ _
+
+@[simp] lemma extend_domain_zpow (n : ℤ) : (e ^ n).extend_domain f = e.extend_domain f ^ n :=
+map_zpow (extend_domain_hom f) _ _
+
 end extend_domain
 
+section subtype
+variables {p : α → Prop} {f : perm α}
+
 /-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
   on `{x // p x}` induced by `f`. -/
-def subtype_perm (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
+def subtype_perm (f : perm α) (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
 ⟨λ x, ⟨f x, (h _).1 x.2⟩, λ x, ⟨f⁻¹ x, (h (f⁻¹ x)).2 $ by simpa using x.2⟩,
   λ _, by simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk],
   λ _, by simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk]⟩
 
-@[simp] lemma subtype_perm_apply (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x))
+@[simp] lemma subtype_perm_apply (f : perm α) (h : ∀ x, p x ↔ p (f x))
   (x : {x // p x}) : subtype_perm f h x = ⟨f x, (h _).1 x.2⟩ := rfl
 
-@[simp] lemma subtype_perm_one (p : α → Prop) (h : ∀ x, p x ↔ p ((1 : perm α) x)) :
-  @subtype_perm α 1 p h = 1 :=
+@[simp] lemma subtype_perm_one (p : α → Prop) (h := λ _, iff.rfl) : @subtype_perm α p 1 h = 1 :=
 equiv.ext $ λ ⟨_, _⟩, rfl
 
+@[simp] lemma subtype_perm_mul (f g : perm α) (hf hg) :
+  (f.subtype_perm hf * g.subtype_perm hg : perm {x // p x}) =
+    (f * g).subtype_perm (λ x, (hg _).trans $ hf _) := rfl
+
+private lemma inv_aux : (∀ x, p x ↔ p (f x)) ↔ ∀ x, p x ↔ p (f⁻¹ x) :=
+f⁻¹.surjective.forall.trans $ by simp_rw [f.apply_inv_self, iff.comm]
+
+/-- See `equiv.perm.inv_subtype_perm`-/
+lemma subtype_perm_inv (f : perm α) (hf) :
+  f⁻¹.subtype_perm hf = (f.subtype_perm $ inv_aux.2 hf : perm {x // p x})⁻¹ := rfl
+
+/-- See `equiv.perm.subtype_perm_inv`-/
+@[simp] lemma inv_subtype_perm (f : perm α) (hf) :
+  (f.subtype_perm hf : perm {x // p x})⁻¹ = f⁻¹.subtype_perm (inv_aux.1 hf) := rfl
+
+private lemma pow_aux (hf : ∀ x, p x ↔ p (f x)) : ∀ {n : ℕ} x, p x ↔ p ((f ^ n) x)
+| 0 x := iff.rfl
+| (n + 1) x := (pow_aux _).trans (hf _)
+
+@[simp] lemma subtype_perm_pow (f : perm α) (n : ℕ) (hf) :
+  (f.subtype_perm hf : perm {x // p x}) ^ n = (f ^ n).subtype_perm (pow_aux hf) :=
+begin
+  induction n with n ih,
+  { simp },
+  { simp_rw [pow_succ', ih, subtype_perm_mul] }
+end
+
+private lemma zpow_aux (hf : ∀ x, p x ↔ p (f x)) : ∀ {n : ℤ} x, p x ↔ p ((f ^ n) x)
+| (int.of_nat n) := pow_aux hf
+| (int.neg_succ_of_nat n) := by { rw zpow_neg_succ_of_nat, exact inv_aux.1 (pow_aux hf) }
+
+@[simp] lemma subtype_perm_zpow (f : perm α) (n : ℤ) (hf) :
+  (f.subtype_perm hf ^ n : perm {x // p x}) = (f ^ n).subtype_perm (zpow_aux hf) :=
+begin
+  induction n with n ih,
+  { exact subtype_perm_pow _ _ _ },
+  { simp only [zpow_neg_succ_of_nat, subtype_perm_pow, subtype_perm_inv] }
+end
+
+variables [decidable_pred p] {a : α}
+
 /-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
   fixing the other points. -/
-def of_subtype {p : α → Prop} [decidable_pred p] : perm (subtype p) →* perm α :=
-{ to_fun := λ f,
-  ⟨λ x, if h : p x then f ⟨x, h⟩ else x, λ x, if h : p x then f⁻¹ ⟨x, h⟩ else x,
-  λ x, have h : ∀ h : p x, p (f ⟨x, h⟩), from λ h, (f ⟨x, h⟩).2,
-    by { simp only [], split_ifs at *;
-         simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * },
-  λ x, have h : ∀ h : p x, p (f⁻¹ ⟨x, h⟩), from λ h, (f⁻¹ ⟨x, h⟩).2,
-    by { simp only [], split_ifs at *;
-         simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * }⟩,
-  map_one' := begin ext, dsimp, split_ifs; refl, end,
-  map_mul' := λ f g, equiv.ext $ λ x, begin
-  by_cases h : p x,
-  { have h₁ : p (f (g ⟨x, h⟩)), from (f (g ⟨x, h⟩)).2,
-    have h₂ : p (g ⟨x, h⟩), from (g ⟨x, h⟩).2,
-    simp only [h, h₂, coe_fn_mk, perm.mul_apply, dif_pos, subtype.coe_eta] },
-  { simp only [h, coe_fn_mk, perm.mul_apply, dif_neg, not_false_iff] }
-end }
-
-lemma of_subtype_subtype_perm {f : perm α} {p : α → Prop} [decidable_pred p]
-  (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
+def of_subtype : perm (subtype p) →* perm α :=
+{ to_fun := λ f, extend_domain f (equiv.refl (subtype p)),
+  map_one' := equiv.perm.extend_domain_one _,
+  map_mul' := λ f g, (equiv.perm.extend_domain_mul _ f g).symm, }
+
+lemma of_subtype_subtype_perm {f : perm α} (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
   of_subtype (subtype_perm f h₁) = f :=
 equiv.ext $ λ x, begin
-  rw [of_subtype, subtype_perm],
   by_cases hx : p x,
-  { simp only [hx, coe_fn_mk, dif_pos, monoid_hom.coe_mk, subtype.coe_mk]},
-  { haveI := classical.prop_decidable,
-    simp only [hx, not_not.mp (mt (h₂ x) hx), coe_fn_mk, dif_neg, not_false_iff,
-      monoid_hom.coe_mk] }
+  { exact (subtype_perm f h₁).extend_domain_apply_subtype _ hx, },
+  { rw [of_subtype, monoid_hom.coe_mk, equiv.perm.extend_domain_apply_not_subtype],
+    { exact not_not.mp (λ h, hx (h₂ x (ne.symm h))),  },
+    { exact hx, }, }
 end
 
-lemma of_subtype_apply_of_mem {p : α → Prop} [decidable_pred p]
-  (f : perm (subtype p)) {x : α} (hx : p x) :
-  of_subtype f x = f ⟨x, hx⟩ :=
-dif_pos hx
+lemma of_subtype_apply_of_mem (f : perm (subtype p)) (ha : p a) : of_subtype f a = f ⟨a, ha⟩ :=
+extend_domain_apply_subtype _ _ _
 
-@[simp] lemma of_subtype_apply_coe {p : α → Prop} [decidable_pred p]
-  (f : perm (subtype p)) (x : subtype p)  :
-  of_subtype f x = f x :=
+@[simp] lemma of_subtype_apply_coe (f : perm (subtype p)) (x : subtype p) : of_subtype f x = f x :=
 subtype.cases_on x $ λ _, of_subtype_apply_of_mem f
 
-lemma of_subtype_apply_of_not_mem {p : α → Prop} [decidable_pred p]
-  (f : perm (subtype p)) {x : α} (hx : ¬ p x) :
-  of_subtype f x = x :=
-dif_neg hx
+lemma of_subtype_apply_of_not_mem (f : perm (subtype p)) (ha : ¬ p a) : of_subtype f a = a :=
+extend_domain_apply_not_subtype _ _ ha
 
-lemma mem_iff_of_subtype_apply_mem {p : α → Prop} [decidable_pred p]
-  (f : perm (subtype p)) (x : α) :
+lemma mem_iff_of_subtype_apply_mem (f : perm (subtype p)) (x : α) :
   p x ↔ p ((of_subtype f : α → α) x) :=
-if h : p x then by simpa only [of_subtype, h, coe_fn_mk, dif_pos, true_iff, monoid_hom.coe_mk]
-  using (f ⟨x, h⟩).2
+if h : p x then
+by simpa only [h, true_iff, monoid_hom.coe_mk, of_subtype_apply_of_mem f h] using (f ⟨x, h⟩).2
 else by simp [h, of_subtype_apply_of_not_mem f h]
 
-@[simp] lemma subtype_perm_of_subtype {p : α → Prop} [decidable_pred p] (f : perm (subtype p)) :
+@[simp] lemma subtype_perm_of_subtype (f : perm (subtype p)) :
   subtype_perm (of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
-equiv.ext $ λ ⟨x, hx⟩, by { dsimp [subtype_perm, of_subtype],
-  simp only [show p x, from hx, dif_pos, subtype.coe_eta] }
-
-@[simp] lemma default_perm {n : Type*} : (default : perm n) = 1 := rfl
+equiv.ext $ λ x, subtype.coe_injective (of_subtype_apply_coe f x)
 
 /-- Permutations on a subtype are equivalent to permutations on the original type that fix pointwise
 the rest. -/
@@ -304,40 +352,15 @@ the rest. -/
   right_inv := λ f,
     subtype.ext (equiv.perm.of_subtype_subtype_perm _ $ λ a, not.decidable_imp_symm $ f.prop a) }
 
-lemma subtype_equiv_subtype_perm_apply_of_mem {α : Type*} {p : α → Prop}
-  [decidable_pred p] (f : perm (subtype p)) {a : α} (h : p a) :
+lemma subtype_equiv_subtype_perm_apply_of_mem (f : perm (subtype p)) (h : p a) :
   perm.subtype_equiv_subtype_perm p f a = f ⟨a, h⟩ :=
 f.of_subtype_apply_of_mem h
 
-lemma subtype_equiv_subtype_perm_apply_of_not_mem {α : Type*} {p : α → Prop}
-  [decidable_pred p] (f : perm (subtype p)) {a : α} (h : ¬ p a) :
+lemma subtype_equiv_subtype_perm_apply_of_not_mem (f : perm (subtype p)) (h : ¬ p a) :
   perm.subtype_equiv_subtype_perm p f a = a :=
 f.of_subtype_apply_of_not_mem h
 
-variables (e : perm α) (ι : α ↪ β)
-
-open_locale classical
-
-/-- Noncomputable version of `equiv.perm.via_fintype_embedding` that does not assume `fintype` -/
-noncomputable def via_embedding : perm β :=
-extend_domain e (of_injective ι.1 ι.2)
-
-lemma via_embedding_apply (x : α) : e.via_embedding ι (ι x) = ι (e x) :=
-extend_domain_apply_image e (of_injective ι.1 ι.2) x
-
-lemma via_embedding_apply_of_not_mem (x : β) (hx : x ∉ _root_.set.range ι) :
-  e.via_embedding ι x = x :=
-extend_domain_apply_not_subtype e (of_injective ι.1 ι.2) hx
-
-/-- `via_embedding` as a group homomorphism -/
-noncomputable def via_embedding_hom : perm α →* perm β:=
-extend_domain_hom (of_injective ι.1 ι.2)
-
-lemma via_embedding_hom_apply : via_embedding_hom ι e = via_embedding e ι := rfl
-
-lemma via_embedding_hom_injective : function.injective (via_embedding_hom ι) :=
-extend_domain_hom_injective (of_injective ι.1 ι.2)
-
+end subtype
 end perm
 
 section swap
@@ -405,4 +428,92 @@ equiv.ext $ λ n, by { simp only [swap_apply_def, perm.mul_apply], split_ifs; cc
 
 end swap
 
+section add_group
+variables [add_group α] (a b : α)
+
+@[simp] lemma add_left_zero : equiv.add_left (0 : α) = 1 := ext zero_add
+@[simp] lemma add_right_zero : equiv.add_right (0 : α) = 1 := ext add_zero
+
+@[simp] lemma add_left_add : equiv.add_left (a + b) = equiv.add_left a * equiv.add_left b :=
+ext $ add_assoc _ _
+
+@[simp] lemma add_right_add : equiv.add_right (a + b) = equiv.add_right b * equiv.add_right a :=
+ext $ λ _, (add_assoc _ _ _).symm
+
+@[simp] lemma inv_add_left : (equiv.add_left a)⁻¹ =  equiv.add_left (-a) := equiv.coe_inj.1 rfl
+@[simp] lemma inv_add_right : (equiv.add_right a)⁻¹ =  equiv.add_right (-a) := equiv.coe_inj.1 rfl
+
+@[simp] lemma pow_add_left (n : ℕ) : equiv.add_left a ^ n = equiv.add_left (n • a) :=
+by { ext, simp [perm.coe_pow] }
+
+@[simp] lemma pow_add_right (n : ℕ) : equiv.add_right a ^ n = equiv.add_right (n • a) :=
+by { ext, simp [perm.coe_pow] }
+
+@[simp] lemma zpow_add_left (n : ℤ) : equiv.add_left a ^ n = equiv.add_left (n • a) :=
+(map_zsmul (⟨equiv.add_left, add_left_zero, add_left_add⟩ : α →+ additive (perm α)) _ _).symm
+
+@[simp] lemma zpow_add_right (n : ℤ) : equiv.add_right a ^ n = equiv.add_right (n • a) :=
+@zpow_add_left αᵃᵒᵖ _ _ _
+
+end add_group
+
+section group
+variables [group α] (a b : α)
+
+@[simp, to_additive] lemma mul_left_one : equiv.mul_left (1 : α) = 1 := ext one_mul
+@[simp, to_additive] lemma mul_right_one : equiv.mul_right (1 : α) = 1 := ext mul_one
+
+@[simp, to_additive]
+lemma mul_left_mul : equiv.mul_left (a * b) = equiv.mul_left a * equiv.mul_left b :=
+ext $ mul_assoc _ _
+
+@[simp, to_additive]
+lemma mul_right_mul : equiv.mul_right (a * b) = equiv.mul_right b * equiv.mul_right a :=
+ext $ λ _, (mul_assoc _ _ _).symm
+
+@[simp, to_additive inv_add_left]
+lemma inv_mul_left : (equiv.mul_left a)⁻¹ = equiv.mul_left a⁻¹ := equiv.coe_inj.1 rfl
+@[simp, to_additive inv_add_right]
+lemma inv_mul_right : (equiv.mul_right a)⁻¹ = equiv.mul_right a⁻¹ := equiv.coe_inj.1 rfl
+
+@[simp, to_additive pow_add_left]
+lemma pow_mul_left (n : ℕ) : equiv.mul_left a ^ n = equiv.mul_left (a ^ n)  :=
+by { ext, simp [perm.coe_pow] }
+
+@[simp, to_additive pow_add_right]
+lemma pow_mul_right (n : ℕ) : equiv.mul_right a ^ n = equiv.mul_right (a ^ n) :=
+by { ext, simp [perm.coe_pow] }
+
+@[simp, to_additive zpow_add_left]
+lemma zpow_mul_left (n : ℤ) : equiv.mul_left a ^ n = equiv.mul_left (a ^ n) :=
+(map_zpow (⟨equiv.mul_left, mul_left_one, mul_left_mul⟩ : α →* perm α) _ _).symm
+
+@[simp, to_additive zpow_add_right]
+lemma zpow_mul_right : ∀ n : ℤ, equiv.mul_right a ^ n = equiv.mul_right (a ^ n)
+| (int.of_nat n) := by simp
+| (int.neg_succ_of_nat n) := by simp
+
+end group
 end equiv
+
+open equiv function
+
+namespace set
+variables {α : Type*} {f : perm α} {s t : set α}
+
+@[simp] lemma bij_on_perm_inv : bij_on ⇑f⁻¹ t s ↔ bij_on f s t := equiv.bij_on_symm
+
+alias bij_on_perm_inv ↔ bij_on.of_perm_inv bij_on.perm_inv
+
+lemma maps_to.perm_pow : maps_to f s s → ∀ n : ℕ, maps_to ⇑(f ^ n) s s :=
+by { simp_rw equiv.perm.coe_pow, exact maps_to.iterate }
+lemma surj_on.perm_pow : surj_on f s s → ∀ n : ℕ, surj_on ⇑(f ^ n) s s :=
+by { simp_rw equiv.perm.coe_pow, exact surj_on.iterate }
+lemma bij_on.perm_pow : bij_on f s s → ∀ n : ℕ, bij_on ⇑(f ^ n) s s :=
+by { simp_rw equiv.perm.coe_pow, exact bij_on.iterate }
+
+lemma bij_on.perm_zpow (hf : bij_on f s s) : ∀ n : ℤ, bij_on ⇑(f ^ n) s s
+| (int.of_nat n) := hf.perm_pow _
+| (int.neg_succ_of_nat n) := by { rw zpow_neg_succ_of_nat, exact (hf.perm_pow _).perm_inv }
+
+end set
diff --git a/src/group_theory/perm/concrete_cycle.lean b/src/group_theory/perm/concrete_cycle.lean
deleted file mode 100644
index 7fa849d181429..0000000000000
--- a/src/group_theory/perm/concrete_cycle.lean
+++ /dev/null
@@ -1,535 +0,0 @@
-/-
-Copyright (c) 2021 Yakov Pechersky. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yakov Pechersky
--/
-import group_theory.perm.list
-import data.list.cycle
-import group_theory.perm.cycle_type
-
-/-!
-
-# Properties of cyclic permutations constructed from lists/cycles
-
-In the following, `{α : Type*} [fintype α] [decidable_eq α]`.
-
-## Main definitions
-
-* `cycle.form_perm`: the cyclic permutation created by looping over a `cycle α`
-* `equiv.perm.to_list`: the list formed by iterating application of a permutation
-* `equiv.perm.to_cycle`: the cycle formed by iterating application of a permutation
-* `equiv.perm.iso_cycle`: the equivalence between cyclic permutations `f : perm α`
-  and the terms of `cycle α` that correspond to them
-* `equiv.perm.iso_cycle'`: the same equivalence as `equiv.perm.iso_cycle`
-  but with evaluation via choosing over fintypes
-* The notation `c[1, 2, 3]` to emulate notation of cyclic permutations `(1 2 3)`
-* A `has_repr` instance for any `perm α`, by representing the `finset` of
-  `cycle α` that correspond to the cycle factors.
-
-## Main results
-
-* `list.is_cycle_form_perm`: a nontrivial list without duplicates, when interpreted as
-  a permutation, is cyclic
-* `equiv.perm.is_cycle.exists_unique_cycle`: there is only one nontrivial `cycle α`
-  corresponding to each cyclic `f : perm α`
-
-## Implementation details
-
-The forward direction of `equiv.perm.iso_cycle'` uses `fintype.choose` of the uniqueness
-result, relying on the `fintype` instance of a `cycle.nodup` subtype.
-It is unclear if this works faster than the `equiv.perm.to_cycle`, which relies
-on recursion over `finset.univ`.
-Running `#eval` on even a simple noncyclic permutation `c[(1 : fin 7), 2, 3] * c[0, 5]`
-to show it takes a long time. TODO: is this because computing the cycle factors is slow?
-
--/
-
-open equiv equiv.perm list
-
-namespace list
-
-variables {α : Type*} [decidable_eq α] {l l' : list α}
-
-lemma form_perm_disjoint_iff (hl : nodup l) (hl' : nodup l')
-  (hn : 2 ≤ l.length) (hn' : 2 ≤ l'.length) :
-  perm.disjoint (form_perm l) (form_perm l') ↔ l.disjoint l' :=
-begin
-  rw [disjoint_iff_eq_or_eq, list.disjoint],
-  split,
-  { rintro h x hx hx',
-    specialize h x,
-    rw [form_perm_apply_mem_eq_self_iff _ hl _ hx,
-        form_perm_apply_mem_eq_self_iff _ hl' _ hx'] at h,
-    rcases h with hl | hl'; linarith },
-  { intros h x,
-    by_cases hx : x ∈ l, by_cases hx' : x ∈ l',
-    { exact (h hx hx').elim },
-    all_goals { have := form_perm_eq_self_of_not_mem _ _ ‹_›, tauto } }
-end
-
-lemma is_cycle_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
-  is_cycle (form_perm l) :=
-begin
-  cases l with x l,
-  { norm_num at hn },
-  induction l with y l IH generalizing x,
-  { norm_num at hn },
-  { use x,
-    split,
-    { rwa form_perm_apply_mem_ne_self_iff _ hl _ (mem_cons_self _ _) },
-    { intros w hw,
-      have : w ∈ (x :: y :: l) := mem_of_form_perm_ne_self _ _ hw,
-      obtain ⟨k, hk, rfl⟩ := nth_le_of_mem this,
-      use k,
-      simp only [zpow_coe_nat, form_perm_pow_apply_head _ _ hl k, nat.mod_eq_of_lt hk] } }
-end
-
-lemma pairwise_same_cycle_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
-  pairwise (l.form_perm.same_cycle) l :=
-pairwise.imp_mem.mpr (pairwise_of_forall (λ x y hx hy, (is_cycle_form_perm hl hn).same_cycle
-  ((form_perm_apply_mem_ne_self_iff _ hl _ hx).mpr hn)
-  ((form_perm_apply_mem_ne_self_iff _ hl _ hy).mpr hn)))
-
-lemma cycle_of_form_perm (hl : nodup l) (hn : 2 ≤ l.length) (x) :
-  cycle_of l.attach.form_perm x = l.attach.form_perm :=
-have hn : 2 ≤ l.attach.length := by rwa ← length_attach at hn,
-have hl : l.attach.nodup := by rwa ← nodup_attach at hl,
-(is_cycle_form_perm hl hn).cycle_of_eq
-  ((form_perm_apply_mem_ne_self_iff _ hl _ (mem_attach _ _)).mpr hn)
-
-lemma cycle_type_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
-  cycle_type l.attach.form_perm = {l.length} :=
-begin
-  rw ←length_attach at hn,
-  rw ←nodup_attach at hl,
-  rw cycle_type_eq [l.attach.form_perm],
-  { simp only [map, function.comp_app],
-    rw [support_form_perm_of_nodup _ hl, card_to_finset, dedup_eq_self.mpr hl],
-    { simpa },
-    { intros x h,
-      simpa [h, nat.succ_le_succ_iff] using hn } },
-  { simp },
-  { simpa using is_cycle_form_perm hl hn },
-  { simp }
-end
-
-lemma form_perm_apply_mem_eq_next (hl : nodup l) (x : α) (hx : x ∈ l) :
-  form_perm l x = next l x hx :=
-begin
-  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
-  rw [next_nth_le _ hl, form_perm_apply_nth_le _ hl]
-end
-
-end list
-
-namespace cycle
-
-variables {α : Type*} [decidable_eq α] (s s' : cycle α)
-
-/--
-A cycle `s : cycle α` , given `nodup s` can be interpreted as a `equiv.perm α`
-where each element in the list is permuted to the next one, defined as `form_perm`.
--/
-def form_perm : Π (s : cycle α) (h : nodup s), equiv.perm α :=
-λ s, quot.hrec_on s (λ l h, form_perm l)
-  (λ l₁ l₂ (h : l₁ ~r l₂),
-    begin
-      ext,
-      { exact h.nodup_iff },
-      { intros h₁ h₂ _,
-        exact heq_of_eq (form_perm_eq_of_is_rotated h₁ h) }
-    end)
-
-@[simp] lemma form_perm_coe (l : list α) (hl : l.nodup) :
-  form_perm (l : cycle α) hl = l.form_perm := rfl
-
-lemma form_perm_subsingleton (s : cycle α) (h : subsingleton s) :
-  form_perm s h.nodup = 1 :=
-begin
-  induction s using quot.induction_on,
-  simp only [form_perm_coe, mk_eq_coe],
-  simp only [length_subsingleton_iff, length_coe, mk_eq_coe] at h,
-  cases s with hd tl,
-  { simp },
-  { simp only [length_eq_zero, add_le_iff_nonpos_left, list.length, nonpos_iff_eq_zero] at h,
-    simp [h] }
-end
-
-lemma is_cycle_form_perm (s : cycle α) (h : nodup s) (hn : nontrivial s) :
-  is_cycle (form_perm s h) :=
-begin
-  induction s using quot.induction_on,
-  exact list.is_cycle_form_perm h (length_nontrivial hn)
-end
-
-lemma support_form_perm [fintype α] (s : cycle α) (h : nodup s) (hn : nontrivial s) :
-  support (form_perm s h) = s.to_finset :=
-begin
-  induction s using quot.induction_on,
-  refine support_form_perm_of_nodup s h _,
-  rintro _ rfl,
-  simpa [nat.succ_le_succ_iff] using length_nontrivial hn
-end
-
-lemma form_perm_eq_self_of_not_mem (s : cycle α) (h : nodup s) (x : α) (hx : x ∉ s) :
-  form_perm s h x = x :=
-begin
-  induction s using quot.induction_on,
-  simpa using list.form_perm_eq_self_of_not_mem _ _ hx
-end
-
-lemma form_perm_apply_mem_eq_next (s : cycle α) (h : nodup s) (x : α) (hx : x ∈ s) :
-  form_perm s h x = next s h x hx :=
-begin
-  induction s using quot.induction_on,
-  simpa using list.form_perm_apply_mem_eq_next h _ _
-end
-
-lemma form_perm_reverse (s : cycle α) (h : nodup s) :
-  form_perm s.reverse (nodup_reverse_iff.mpr h) = (form_perm s h)⁻¹ :=
-begin
-  induction s using quot.induction_on,
-  simpa using form_perm_reverse _ h
-end
-
-lemma form_perm_eq_form_perm_iff {α : Type*} [decidable_eq α]
-  {s s' : cycle α} {hs : s.nodup} {hs' : s'.nodup} :
-  s.form_perm hs = s'.form_perm hs' ↔ s = s' ∨ s.subsingleton ∧ s'.subsingleton :=
-begin
-  rw [cycle.length_subsingleton_iff, cycle.length_subsingleton_iff],
-  revert s s',
-  intros s s',
-  apply quotient.induction_on₂' s s',
-  intros l l',
-  simpa using form_perm_eq_form_perm_iff
-end
-
-end cycle
-variables {α : Type*}
-
-namespace equiv.perm
-
-variables [fintype α] [decidable_eq α] (p : equiv.perm α) (x : α)
-
-/--
-`equiv.perm.to_list (f : perm α) (x : α)` generates the list `[x, f x, f (f x), ...]`
-until looping. That means when `f x = x`, `to_list f x = []`.
--/
-def to_list : list α :=
-(list.range (cycle_of p x).support.card).map (λ k, (p ^ k) x)
-
-@[simp] lemma to_list_one : to_list (1 : perm α) x = [] :=
-by simp [to_list, cycle_of_one]
-
-@[simp] lemma to_list_eq_nil_iff {p : perm α} {x} : to_list p x = [] ↔ x ∉ p.support :=
-by simp [to_list]
-
-@[simp] lemma length_to_list : length (to_list p x) = (cycle_of p x).support.card :=
-by simp [to_list]
-
-lemma to_list_ne_singleton (y : α) : to_list p x ≠ [y] :=
-begin
-  intro H,
-  simpa [card_support_ne_one] using congr_arg length H
-end
-
-lemma two_le_length_to_list_iff_mem_support {p : perm α} {x : α} :
-  2 ≤ length (to_list p x) ↔ x ∈ p.support :=
-by simp
-
-lemma length_to_list_pos_of_mem_support (h : x ∈ p.support) : 0 < length (to_list p x) :=
-zero_lt_two.trans_le (two_le_length_to_list_iff_mem_support.mpr h)
-
-lemma nth_le_to_list (n : ℕ) (hn : n < length (to_list p x)) :
-  nth_le (to_list p x) n hn = (p ^ n) x :=
-by simp [to_list]
-
-lemma to_list_nth_le_zero (h : x ∈ p.support) :
-  (to_list p x).nth_le 0 (length_to_list_pos_of_mem_support _ _ h) = x :=
-by simp [to_list]
-
-variables {p} {x}
-
-lemma mem_to_list_iff {y : α} :
-  y ∈ to_list p x ↔ same_cycle p x y ∧ x ∈ p.support :=
-begin
-  simp only [to_list, mem_range, mem_map],
-  split,
-  { rintro ⟨n, hx, rfl⟩,
-    refine ⟨⟨n, rfl⟩, _⟩,
-    contrapose! hx,
-    rw ←support_cycle_of_eq_nil_iff at hx,
-    simp [hx] },
-  { rintro ⟨h, hx⟩,
-    simpa using same_cycle.nat_of_mem_support _ h hx }
-end
-
-lemma nodup_to_list (p : perm α) (x : α) :
-  nodup (to_list p x) :=
-begin
-  by_cases hx : p x = x,
-  { rw [←not_mem_support, ←to_list_eq_nil_iff] at hx,
-    simp [hx] },
-  have hc : is_cycle (cycle_of p x) := is_cycle_cycle_of p hx,
-  rw nodup_iff_nth_le_inj,
-  rintros n m hn hm,
-  rw [length_to_list, ←order_of_is_cycle hc] at hm hn,
-  rw [←cycle_of_apply_self, ←ne.def, ←mem_support] at hx,
-  rw [nth_le_to_list, nth_le_to_list,
-      ←cycle_of_pow_apply_self p x n, ←cycle_of_pow_apply_self p x m],
-  cases n; cases m,
-  { simp },
-  { rw [←hc.mem_support_pos_pow_iff_of_lt_order_of m.zero_lt_succ hm,
-        mem_support, cycle_of_pow_apply_self] at hx,
-    simp [hx.symm] },
-  { rw [←hc.mem_support_pos_pow_iff_of_lt_order_of n.zero_lt_succ hn,
-        mem_support, cycle_of_pow_apply_self] at hx,
-    simp [hx] },
-  intro h,
-  have hn' : ¬ order_of (p.cycle_of x) ∣ n.succ := nat.not_dvd_of_pos_of_lt n.zero_lt_succ hn,
-  have hm' : ¬ order_of (p.cycle_of x) ∣ m.succ := nat.not_dvd_of_pos_of_lt m.zero_lt_succ hm,
-  rw ←hc.support_pow_eq_iff at hn' hm',
-  rw [←nat.mod_eq_of_lt hn, ←nat.mod_eq_of_lt hm, ←pow_inj_mod],
-  refine support_congr _ _,
-  { rw [hm', hn'],
-    exact finset.subset.refl _ },
-  { rw hm',
-    intros y hy,
-    obtain ⟨k, rfl⟩ := hc.exists_pow_eq (mem_support.mp hx) (mem_support.mp hy),
-    rw [←mul_apply, (commute.pow_pow_self _ _ _).eq, mul_apply, h, ←mul_apply, ←mul_apply,
-        (commute.pow_pow_self _ _ _).eq] }
-end
-
-lemma next_to_list_eq_apply (p : perm α) (x y : α) (hy : y ∈ to_list p x) :
-  next (to_list p x) y hy = p y :=
-begin
-  rw mem_to_list_iff at hy,
-  obtain ⟨k, hk, hk'⟩ := hy.left.nat_of_mem_support _ hy.right,
-  rw ←nth_le_to_list p x k (by simpa using hk) at hk',
-  simp_rw ←hk',
-  rw [next_nth_le _ (nodup_to_list _ _), nth_le_to_list, nth_le_to_list, ←mul_apply, ←pow_succ,
-      length_to_list, pow_apply_eq_pow_mod_order_of_cycle_of_apply p (k + 1), order_of_is_cycle],
-  exact is_cycle_cycle_of _ (mem_support.mp hy.right)
-end
-
-lemma to_list_pow_apply_eq_rotate (p : perm α) (x : α) (k : ℕ) :
-  p.to_list ((p ^ k) x) = (p.to_list x).rotate k :=
-begin
-  apply ext_le,
-  { simp },
-  { intros n hn hn',
-    rw [nth_le_to_list, nth_le_rotate, nth_le_to_list, length_to_list,
-        pow_mod_card_support_cycle_of_self_apply, pow_add, mul_apply] }
-end
-
-lemma same_cycle.to_list_is_rotated {f : perm α} {x y : α} (h : same_cycle f x y) :
-  to_list f x ~r to_list f y :=
-begin
-  by_cases hx : x ∈ f.support,
-  { obtain ⟨_ | k, hk, hy⟩ := h.nat_of_mem_support _ hx,
-    { simp only [coe_one, id.def, pow_zero] at hy,
-      simp [hy] },
-    use k.succ,
-    rw [←to_list_pow_apply_eq_rotate, hy] },
-  { rw [to_list_eq_nil_iff.mpr hx, is_rotated_nil_iff', eq_comm, to_list_eq_nil_iff],
-    rwa ←h.mem_support_iff }
-end
-
-lemma pow_apply_mem_to_list_iff_mem_support {n : ℕ} :
-  (p ^ n) x ∈ p.to_list x ↔ x ∈ p.support :=
-begin
-  rw [mem_to_list_iff, and_iff_right_iff_imp],
-  refine λ _, same_cycle.symm _,
-  rw same_cycle_pow_left_iff
-end
-
-lemma to_list_form_perm_nil (x : α) :
-  to_list (form_perm ([] : list α)) x = [] :=
-by simp
-
-lemma to_list_form_perm_singleton (x y : α) :
-  to_list (form_perm [x]) y = [] :=
-by simp
-
-lemma to_list_form_perm_nontrivial (l : list α) (hl : 2 ≤ l.length) (hn : nodup l) :
-  to_list (form_perm l) (l.nth_le 0 (zero_lt_two.trans_le hl)) = l :=
-begin
-  have hc : l.form_perm.is_cycle := list.is_cycle_form_perm hn hl,
-  have hs : l.form_perm.support = l.to_finset,
-  { refine support_form_perm_of_nodup _ hn _,
-    rintro _ rfl,
-    simpa [nat.succ_le_succ_iff] using hl },
-  rw [to_list, hc.cycle_of_eq (mem_support.mp _), hs, card_to_finset, dedup_eq_self.mpr hn],
-  { refine list.ext_le (by simp) (λ k hk hk', _),
-    simp [form_perm_pow_apply_nth_le _ hn, nat.mod_eq_of_lt hk'] },
-  { simpa [hs] using nth_le_mem _ _ _ }
-end
-
-lemma to_list_form_perm_is_rotated_self (l : list α) (hl : 2 ≤ l.length) (hn : nodup l)
-  (x : α) (hx : x ∈ l):
-  to_list (form_perm l) x ~r l :=
-begin
-  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
-  have hr : l ~r l.rotate k := ⟨k, rfl⟩,
-  rw form_perm_eq_of_is_rotated hn hr,
-  rw ←nth_le_rotate' l k k,
-  simp only [nat.mod_eq_of_lt hk, tsub_add_cancel_of_le hk.le, nat.mod_self],
-  rw [to_list_form_perm_nontrivial],
-  { simp },
-  { simpa using hl },
-  { simpa using hn }
-end
-
-lemma form_perm_to_list (f : perm α) (x : α) :
-  form_perm (to_list f x) = f.cycle_of x :=
-begin
-  by_cases hx : f x = x,
-  { rw [(cycle_of_eq_one_iff f).mpr hx, to_list_eq_nil_iff.mpr (not_mem_support.mpr hx),
-        form_perm_nil] },
-  ext y,
-  by_cases hy : same_cycle f x y,
-  { obtain ⟨k, hk, rfl⟩ := hy.nat_of_mem_support _ (mem_support.mpr hx),
-    rw [cycle_of_apply_apply_pow_self, list.form_perm_apply_mem_eq_next (nodup_to_list f x),
-        next_to_list_eq_apply, pow_succ, mul_apply],
-    rw mem_to_list_iff,
-    exact ⟨⟨k, rfl⟩, mem_support.mpr hx⟩ },
-  { rw [cycle_of_apply_of_not_same_cycle hy, form_perm_apply_of_not_mem],
-    simp [mem_to_list_iff, hy] }
-end
-
-lemma is_cycle.exists_unique_cycle {f : perm α} (hf : is_cycle f) :
-  ∃! (s : cycle α), ∃ (h : s.nodup), s.form_perm h = f :=
-begin
-  obtain ⟨x, hx, hy⟩ := id hf,
-  refine ⟨f.to_list x, ⟨nodup_to_list f x, _⟩, _⟩,
-  { simp [form_perm_to_list, hf.cycle_of_eq hx] },
-  { rintro ⟨l⟩ ⟨hn, rfl⟩,
-    simp only [cycle.mk_eq_coe, cycle.coe_eq_coe, subtype.coe_mk, cycle.form_perm_coe],
-    refine (to_list_form_perm_is_rotated_self _ _ hn _ _).symm,
-    { contrapose! hx,
-      suffices : form_perm l = 1,
-      { simp [this] },
-      rw form_perm_eq_one_iff _ hn,
-      exact nat.le_of_lt_succ hx },
-    { rw ←mem_to_finset,
-      refine support_form_perm_le l _,
-      simpa using hx } }
-end
-
-lemma is_cycle.exists_unique_cycle_subtype {f : perm α} (hf : is_cycle f) :
-  ∃! (s : {s : cycle α // s.nodup}), (s : cycle α).form_perm s.prop = f :=
-begin
-  obtain ⟨s, ⟨hs, rfl⟩, hs'⟩ := hf.exists_unique_cycle,
-  refine ⟨⟨s, hs⟩, rfl, _⟩,
-  rintro ⟨t, ht⟩ ht',
-  simpa using hs' _ ⟨ht, ht'⟩
-end
-
-lemma is_cycle.exists_unique_cycle_nontrivial_subtype {f : perm α} (hf : is_cycle f) :
-  ∃! (s : {s : cycle α // s.nodup ∧ s.nontrivial}), (s : cycle α).form_perm s.prop.left = f :=
-begin
-  obtain ⟨⟨s, hn⟩, hs, hs'⟩ := hf.exists_unique_cycle_subtype,
-  refine ⟨⟨s, hn, _⟩, _, _⟩,
-  { rw hn.nontrivial_iff,
-    subst f,
-    intro H,
-    refine hf.ne_one _,
-    simpa using cycle.form_perm_subsingleton _ H },
-  { simpa using hs },
-  { rintro ⟨t, ht, ht'⟩ ht'',
-    simpa using hs' ⟨t, ht⟩ ht'' }
-end
-
-/--
-Given a cyclic `f : perm α`, generate the `cycle α` in the order
-of application of `f`. Implemented by finding an element `x : α`
-in the support of `f` in `finset.univ`, and iterating on using
-`equiv.perm.to_list f x`.
--/
-def to_cycle (f : perm α) (hf : is_cycle f) : cycle α :=
-multiset.rec_on (finset.univ : finset α).val
-  (quot.mk _ [])
-  (λ x s l, if f x = x then l else to_list f x)
-  (by { intros x y m s,
-    refine heq_of_eq _,
-    split_ifs with hx hy hy; try { refl },
-    { have hc : same_cycle f x y := is_cycle.same_cycle hf hx hy,
-      exact quotient.sound' hc.to_list_is_rotated }})
-
-lemma to_cycle_eq_to_list (f : perm α) (hf : is_cycle f) (x : α) (hx : f x ≠ x) :
-  to_cycle f hf = to_list f x :=
-begin
-  have key : (finset.univ : finset α).val = x ::ₘ finset.univ.val.erase x,
-  { simp },
-  rw [to_cycle, key],
-  simp [hx]
-end
-
-lemma nodup_to_cycle (f : perm α) (hf : is_cycle f) : (to_cycle f hf).nodup :=
-begin
-  obtain ⟨x, hx, -⟩ := id hf,
-  simpa [to_cycle_eq_to_list f hf x hx] using nodup_to_list _ _
-end
-
-lemma nontrivial_to_cycle (f : perm α) (hf : is_cycle f) : (to_cycle f hf).nontrivial :=
-begin
-  obtain ⟨x, hx, -⟩ := id hf,
-  simp [to_cycle_eq_to_list f hf x hx, hx, cycle.nontrivial_coe_nodup_iff (nodup_to_list _ _)]
-end
-
-/--
-Any cyclic `f : perm α` is isomorphic to the nontrivial `cycle α`
-that corresponds to repeated application of `f`.
-The forward direction is implemented by `equiv.perm.to_cycle`.
--/
-def iso_cycle : {f : perm α // is_cycle f} ≃ {s : cycle α // s.nodup ∧ s.nontrivial} :=
-{ to_fun := λ f, ⟨to_cycle (f : perm α) f.prop, nodup_to_cycle f f.prop,
-    nontrivial_to_cycle _ f.prop⟩,
-  inv_fun := λ s, ⟨(s : cycle α).form_perm s.prop.left,
-    (s : cycle α).is_cycle_form_perm _ s.prop.right⟩,
-  left_inv := λ f, by
-  { obtain ⟨x, hx, -⟩ := id f.prop,
-    simpa [to_cycle_eq_to_list (f : perm α) f.prop x hx, form_perm_to_list, subtype.ext_iff]
-      using f.prop.cycle_of_eq hx },
-  right_inv := λ s, by
-  { rcases s with ⟨⟨s⟩, hn, ht⟩,
-    obtain ⟨x, -, -, hx, -⟩ := id ht,
-    have hl : 2 ≤ s.length := by simpa using cycle.length_nontrivial ht,
-    simp only [cycle.mk_eq_coe, cycle.nodup_coe_iff, cycle.mem_coe_iff, subtype.coe_mk,
-               cycle.form_perm_coe] at hn hx ⊢,
-    rw to_cycle_eq_to_list _ _ x,
-    { refine quotient.sound' _,
-      exact to_list_form_perm_is_rotated_self _ hl hn _ hx },
-    { rw [←mem_support, support_form_perm_of_nodup _ hn],
-      { simpa using hx },
-      { rintro _ rfl,
-        simpa [nat.succ_le_succ_iff] using hl } } } }
-
-/--
-Any cyclic `f : perm α` is isomorphic to the nontrivial `cycle α`
-that corresponds to repeated application of `f`.
-The forward direction is implemented by finding this `cycle α` using `fintype.choose`.
--/
-def iso_cycle' : {f : perm α // is_cycle f} ≃ {s : cycle α // s.nodup ∧ s.nontrivial} :=
-{ to_fun := λ f, fintype.choose _ f.prop.exists_unique_cycle_nontrivial_subtype,
-  inv_fun := λ s, ⟨(s : cycle α).form_perm s.prop.left,
-    (s : cycle α).is_cycle_form_perm _ s.prop.right⟩,
-  left_inv := λ f, by simpa [subtype.ext_iff]
-    using fintype.choose_spec _ f.prop.exists_unique_cycle_nontrivial_subtype,
-  right_inv := λ ⟨s, hs, ht⟩, by
-  { simp [subtype.coe_mk],
-    convert fintype.choose_subtype_eq (λ (s' : cycle α), s'.nodup ∧ s'.nontrivial) _,
-    ext ⟨s', hs', ht'⟩,
-    simp [cycle.form_perm_eq_form_perm_iff, (iff_not_comm.mp hs.nontrivial_iff),
-          (iff_not_comm.mp hs'.nontrivial_iff), ht] } }
-
-notation `c[` l:(foldr `, ` (h t, list.cons h t) list.nil `]`) :=
-  cycle.form_perm ↑l (cycle.nodup_coe_iff.mpr dec_trivial)
-
-instance repr_perm [has_repr α] : has_repr (perm α) :=
-⟨λ f, repr (multiset.pmap (λ (g : perm α) (hg : g.is_cycle),
-  iso_cycle ⟨g, hg⟩) -- to_cycle is faster?
-  (perm.cycle_factors_finset f).val
-  (λ g hg, (mem_cycle_factors_finset_iff.mp (finset.mem_def.mpr hg)).left))⟩
-
-end equiv.perm
diff --git a/src/group_theory/perm/cycle/basic.lean b/src/group_theory/perm/cycle/basic.lean
new file mode 100644
index 0000000000000..924ad2f62a9ac
--- /dev/null
+++ b/src/group_theory/perm/cycle/basic.lean
@@ -0,0 +1,1767 @@
+/-
+Copyright (c) 2019 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes, Yaël Dillies
+-/
+import algebra.module.big_operators
+import data.finset.noncomm_prod
+import data.fintype.perm
+import data.int.modeq
+import group_theory.perm.list
+import group_theory.perm.sign
+import logic.equiv.fintype
+/-!
+# Cyclic permutations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file develops the theory of cycles in permutations.
+
+## Main definitions
+
+In the following, `f : equiv.perm β`.
+
+* `equiv.perm.same_cycle`: `f.same_cycle x y` when `x` and `y` are in the same cycle of `f`.
+* `equiv.perm.is_cycle`: `f` is a cycle if any two nonfixed points of `f` are related by repeated
+  applications of `f`, and `f` is not the identity.
+* `equiv.perm.is_cycle_on`: `f` is a cycle on a set `s` when any two points of `s` are related by
+  repeated applications of `f`.
+
+The following two definitions require that `β` is a `fintype`:
+
+* `equiv.perm.cycle_of`: `f.cycle_of x` is the cycle of `f` that `x` belongs to.
+* `equiv.perm.cycle_factors`: `f.cycle_factors` is a list of disjoint cyclic permutations that
+  multiply to `f`.
+
+## Main results
+
+* This file contains several closure results:
+  - `closure_is_cycle` : The symmetric group is generated by cycles
+  - `closure_cycle_adjacent_swap` : The symmetric group is generated by
+    a cycle and an adjacent transposition
+  - `closure_cycle_coprime_swap` : The symmetric group is generated by
+    a cycle and a coprime transposition
+  - `closure_prime_cycle_swap` : The symmetric group is generated by
+    a prime cycle and a transposition
+
+## Notes
+
+`equiv.perm.is_cycle` and `equiv.perm.is_cycle_on` are different in three ways:
+* `is_cycle` is about the entire type while `is_cycle_on` is restricted to a set.
+* `is_cycle` forbids the identity while `is_cycle_on` allows it (if `s` is a subsingleton).
+* `is_cycle_on` forbids fixed points on `s` (if `s` is nontrivial), while `is_cycle` allows them.
+-/
+
+open equiv function finset
+open_locale big_operators
+
+variables {ι α β : Type*}
+
+namespace equiv.perm
+
+/-! ### `same_cycle` -/
+
+section same_cycle
+variables {f g : perm α} {p : α → Prop} {x y z : α}
+
+/-- The equivalence relation indicating that two points are in the same cycle of a permutation. -/
+def same_cycle (f : perm α) (x y : α) : Prop := ∃ i : ℤ, (f ^ i) x = y
+
+@[refl] lemma same_cycle.refl (f : perm α) (x : α) : same_cycle f x x := ⟨0, rfl⟩
+lemma same_cycle.rfl : same_cycle f x x := same_cycle.refl _ _
+
+protected lemma _root_.eq.same_cycle (h : x = y) (f : perm α) : f.same_cycle x y := by rw h
+
+@[symm] lemma same_cycle.symm : same_cycle f x y → same_cycle f y x :=
+λ ⟨i, hi⟩, ⟨-i, by rw [zpow_neg, ← hi, inv_apply_self]⟩
+
+lemma same_cycle_comm : same_cycle f x y ↔ same_cycle f y x := ⟨same_cycle.symm, same_cycle.symm⟩
+
+@[trans] lemma same_cycle.trans : same_cycle f x y → same_cycle f y z → same_cycle f x z :=
+λ ⟨i, hi⟩ ⟨j, hj⟩, ⟨j + i, by rw [zpow_add, mul_apply, hi, hj]⟩
+
+@[simp] lemma same_cycle_one : same_cycle 1 x y ↔ x = y := by simp [same_cycle]
+
+@[simp] lemma same_cycle_inv : same_cycle f⁻¹ x y ↔ same_cycle f x y :=
+(equiv.neg _).exists_congr_left.trans $ by simp [same_cycle]
+
+alias same_cycle_inv ↔ same_cycle.of_inv same_cycle.inv
+
+@[simp] lemma same_cycle_conj : same_cycle (g * f * g⁻¹) x y ↔ same_cycle f (g⁻¹ x) (g⁻¹ y) :=
+exists_congr $ λ i, by simp [conj_zpow, eq_inv_iff_eq]
+
+lemma same_cycle.conj : same_cycle f x y → same_cycle (g * f * g⁻¹) (g x) (g y) :=
+by simp [same_cycle_conj]
+
+lemma same_cycle.apply_eq_self_iff : same_cycle f x y → (f x = x ↔ f y = y) :=
+λ ⟨i, hi⟩, by rw [← hi, ← mul_apply, ← zpow_one_add, add_comm, zpow_add_one, mul_apply,
+    (f ^ i).injective.eq_iff]
+
+lemma same_cycle.eq_of_left (h : same_cycle f x y) (hx : is_fixed_pt f x) : x = y :=
+let ⟨n, hn⟩ := h in (hx.perm_zpow _).eq.symm.trans hn
+
+lemma same_cycle.eq_of_right (h : same_cycle f x y) (hy : is_fixed_pt f y) : x = y :=
+h.eq_of_left $ h.apply_eq_self_iff.2 hy
+
+@[simp] lemma same_cycle_apply_left : same_cycle f (f x) y ↔ same_cycle f x y :=
+(equiv.add_right 1).exists_congr_left.trans $ by simp [zpow_sub, same_cycle]
+
+@[simp] lemma same_cycle_apply_right : same_cycle f x (f y) ↔ same_cycle f x y :=
+by rw [same_cycle_comm, same_cycle_apply_left, same_cycle_comm]
+
+@[simp] lemma same_cycle_inv_apply_left : same_cycle f (f⁻¹ x) y ↔ same_cycle f x y :=
+by rw [←same_cycle_apply_left, apply_inv_self]
+
+@[simp] lemma same_cycle_inv_apply_right : same_cycle f x (f⁻¹ y) ↔ same_cycle f x y :=
+by rw [←same_cycle_apply_right, apply_inv_self]
+
+@[simp] lemma same_cycle_zpow_left {n : ℤ} : same_cycle f ((f ^ n) x) y ↔ same_cycle f x y :=
+(equiv.add_right (n : ℤ)).exists_congr_left.trans $ by simp [same_cycle, zpow_add]
+
+@[simp] lemma same_cycle_zpow_right {n : ℤ} : same_cycle f x ((f ^ n) y) ↔ same_cycle f x y :=
+by rw [same_cycle_comm, same_cycle_zpow_left, same_cycle_comm]
+
+@[simp] lemma same_cycle_pow_left {n : ℕ} : same_cycle f ((f ^ n) x) y ↔ same_cycle f x y :=
+by rw [←zpow_coe_nat, same_cycle_zpow_left]
+
+@[simp] lemma same_cycle_pow_right {n : ℕ} : same_cycle f x ((f ^ n) y) ↔ same_cycle f x y :=
+by rw [←zpow_coe_nat, same_cycle_zpow_right]
+
+alias same_cycle_apply_left ↔ same_cycle.of_apply_left same_cycle.apply_left
+alias same_cycle_apply_right ↔ same_cycle.of_apply_right same_cycle.apply_right
+alias same_cycle_inv_apply_left ↔ same_cycle.of_inv_apply_left same_cycle.inv_apply_left
+alias same_cycle_inv_apply_right ↔ same_cycle.of_inv_apply_right same_cycle.inv_apply_right
+alias same_cycle_pow_left ↔ same_cycle.of_pow_left same_cycle.pow_left
+alias same_cycle_pow_right ↔ same_cycle.of_pow_right same_cycle.pow_right
+alias same_cycle_zpow_left ↔ same_cycle.of_zpow_left same_cycle.zpow_left
+alias same_cycle_zpow_right ↔ same_cycle.of_zpow_right same_cycle.zpow_right
+
+lemma same_cycle.of_pow {n : ℕ} : same_cycle (f ^ n) x y → same_cycle f x y :=
+λ ⟨m, h⟩, ⟨n * m, by simp [zpow_mul, h]⟩
+
+lemma same_cycle.of_zpow {n : ℤ} : same_cycle (f ^ n) x y → same_cycle f x y :=
+λ ⟨m, h⟩, ⟨n * m, by simp [zpow_mul, h]⟩
+
+@[simp] lemma same_cycle_subtype_perm {h} {x y : {x // p x}} :
+  (f.subtype_perm h).same_cycle x y ↔ f.same_cycle x y :=
+exists_congr $ λ n, by simp [subtype.ext_iff]
+
+alias same_cycle_subtype_perm ↔ _ same_cycle.subtype_perm
+
+@[simp] lemma same_cycle_extend_domain {p : β → Prop} [decidable_pred p] {f : α ≃ subtype p} :
+  same_cycle (g.extend_domain f) (f x) (f y) ↔ g.same_cycle x y :=
+exists_congr $ λ n, by rw [←extend_domain_zpow, extend_domain_apply_image, subtype.coe_inj,
+  f.injective.eq_iff]
+
+alias same_cycle_extend_domain ↔ _ same_cycle.extend_domain
+
+lemma same_cycle.exists_pow_eq' [finite α] : same_cycle f x y → ∃ i < order_of f, (f ^ i) x = y :=
+begin
+  classical,
+  rintro ⟨k, rfl⟩,
+  use (k % order_of f).nat_abs,
+  have h₀ := int.coe_nat_pos.mpr (order_of_pos f),
+  have h₁ := int.mod_nonneg k h₀.ne',
+  rw [←zpow_coe_nat, int.nat_abs_of_nonneg h₁, ←zpow_eq_mod_order_of],
+  refine ⟨_, rfl⟩,
+  rw [←int.coe_nat_lt, int.nat_abs_of_nonneg h₁],
+  exact int.mod_lt_of_pos _ h₀,
+end
+
+lemma same_cycle.exists_pow_eq'' [finite α] (h : same_cycle f x y) :
+  ∃ (i : ℕ) (hpos : 0 < i) (h : i ≤ order_of f), (f ^ i) x = y :=
+begin
+  classical,
+  obtain ⟨_ | i, hi, rfl⟩ := h.exists_pow_eq',
+  { refine ⟨order_of f, order_of_pos f, le_rfl, _⟩,
+    rw [pow_order_of_eq_one, pow_zero] },
+  { exact ⟨i.succ, i.zero_lt_succ, hi.le, rfl⟩ }
+end
+
+instance [fintype α] [decidable_eq α] (f : perm α) : decidable_rel (same_cycle f) :=
+λ x y, decidable_of_iff (∃ n ∈ list.range (fintype.card (perm α)), (f ^ n) x = y)
+⟨λ ⟨n, _, hn⟩, ⟨n, hn⟩, λ ⟨i, hi⟩, ⟨(i % order_of f).nat_abs, list.mem_range.2
+  (int.coe_nat_lt.1 $
+    by { rw int.nat_abs_of_nonneg (int.mod_nonneg _ $ int.coe_nat_ne_zero.2 (order_of_pos _).ne'),
+      { refine (int.mod_lt _ $ int.coe_nat_ne_zero_iff_pos.2 $ order_of_pos _).trans_le _,
+        simp [order_of_le_card_univ] },
+      apply_instance }),
+  by { rw [← zpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _ $
+      int.coe_nat_ne_zero_iff_pos.2 $ order_of_pos _), ← zpow_eq_mod_order_of, hi],
+    apply_instance }⟩⟩
+
+end same_cycle
+
+/-!
+### `is_cycle`
+-/
+
+section is_cycle
+variables {f g : perm α} {x y : α}
+
+/-- A cycle is a non identity permutation where any two nonfixed points of the permutation are
+related by repeated application of the permutation. -/
+def is_cycle (f : perm α) : Prop := ∃ x, f x ≠ x ∧ ∀ ⦃y⦄, f y ≠ y → same_cycle f x y
+
+lemma is_cycle.ne_one (h : is_cycle f) : f ≠ 1 := λ hf, by simpa [hf, is_cycle] using h
+
+@[simp] lemma not_is_cycle_one : ¬ (1 : perm α).is_cycle := λ H, H.ne_one rfl
+
+protected lemma is_cycle.same_cycle (hf : is_cycle f) (hx : f x ≠ x) (hy : f y ≠ y) :
+  same_cycle f x y :=
+let ⟨g, hg⟩ := hf in
+let ⟨a, ha⟩ := hg.2 hx in
+let ⟨b, hb⟩ := hg.2 hy in
+⟨b - a, by rw [←ha, ←mul_apply, ←zpow_add, sub_add_cancel, hb]⟩
+
+lemma is_cycle.exists_zpow_eq : is_cycle f → f x ≠ x → f y ≠ y → ∃ i : ℤ, (f ^ i) x = y :=
+is_cycle.same_cycle
+
+lemma is_cycle.inv (hf : is_cycle f) : is_cycle f⁻¹ :=
+hf.imp $ λ x ⟨hx, h⟩, ⟨inv_eq_iff_eq.not.2 hx.symm, λ y hy, (h $ inv_eq_iff_eq.not.2 hy.symm).inv⟩
+
+@[simp] lemma is_cycle_inv : is_cycle f⁻¹ ↔ is_cycle f :=
+⟨λ h, by { convert h.inv, rw inv_inv }, is_cycle.inv⟩
+
+lemma is_cycle.conj : is_cycle f → is_cycle (g * f * g⁻¹) :=
+begin
+  rintro ⟨x, hx, h⟩,
+  refine ⟨g x, by simp [coe_mul, inv_apply_self, hx], λ y hy, _⟩,
+  rw ←apply_inv_self g y,
+  exact (h $ eq_inv_iff_eq.not.2 hy).conj,
+end
+
+protected lemma is_cycle.extend_domain {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p) :
+  is_cycle g → is_cycle (g.extend_domain f) :=
+begin
+  rintro ⟨a, ha, ha'⟩,
+  refine ⟨f a, _, λ b hb, _⟩,
+  { rw extend_domain_apply_image,
+    exact subtype.coe_injective.ne (f.injective.ne ha) },
+  have h : b = f (f.symm ⟨b, of_not_not $ hb ∘ extend_domain_apply_not_subtype _ _⟩),
+  { rw [apply_symm_apply, subtype.coe_mk] },
+  rw h at ⊢ hb,
+  simp only [extend_domain_apply_image, subtype.coe_injective.ne_iff, f.injective.ne_iff] at hb,
+  exact (ha' hb).extend_domain,
+end
+
+lemma is_cycle_iff_same_cycle (hx : f x ≠ x) : is_cycle f ↔ ∀ {y}, same_cycle f x y ↔ f y ≠ y :=
+⟨λ hf y, ⟨λ ⟨i, hi⟩ hy, hx $
+    by { rw [← zpow_apply_eq_self_of_apply_eq_self hy i, (f ^ i).injective.eq_iff] at hi,
+      rw [hi, hy] },
+  hf.exists_zpow_eq hx⟩,
+  λ h, ⟨x, hx, λ y hy, h.2 hy⟩⟩
+
+section finite
+variables [finite α]
+
+lemma is_cycle.exists_pow_eq (hf : is_cycle f) (hx : f x ≠ x) (hy : f y ≠ y) :
+  ∃ i : ℕ, (f ^ i) x = y :=
+let ⟨n, hn⟩ := hf.exists_zpow_eq hx hy in
+by classical; exact ⟨(n % order_of f).to_nat, by
+{ have := n.mod_nonneg (int.coe_nat_ne_zero.mpr (ne_of_gt (order_of_pos f))),
+  rwa [← zpow_coe_nat, int.to_nat_of_nonneg this, ← zpow_eq_mod_order_of] }⟩
+
+end finite
+
+variables [decidable_eq α]
+
+lemma is_cycle_swap (hxy : x ≠ y) : is_cycle (swap x y) :=
+⟨y, by rwa swap_apply_right,
+  λ a (ha : ite (a = x) y (ite (a = y) x a) ≠ a),
+    if hya : y = a then ⟨0, hya⟩
+    else ⟨1, by { rw [zpow_one, swap_apply_def], split_ifs at *; cc }⟩⟩
+
+protected lemma is_swap.is_cycle : is_swap f → is_cycle f :=
+by { rintro ⟨x, y, hxy, rfl⟩, exact is_cycle_swap hxy }
+
+variables [fintype α]
+
+lemma is_cycle.two_le_card_support (h : is_cycle f) : 2 ≤ f.support.card :=
+two_le_card_support_of_ne_one h.ne_one
+
+lemma is_cycle.exists_pow_eq_one [finite β] {f : perm β} (hf : is_cycle f) :
+  ∃ (k : ℕ) (hk : 1 < k), f ^ k = 1 :=
+begin
+  classical,
+  have : is_of_fin_order f := exists_pow_eq_one f,
+  rw is_of_fin_order_iff_pow_eq_one at this,
+  obtain ⟨x, hx, hx'⟩ := hf,
+  obtain ⟨_ | _ | k, hk, hk'⟩ := this,
+  { exact absurd hk (lt_asymm hk) },
+  { rw pow_one at hk',
+    simpa [hk'] using hx },
+  { exact ⟨k + 2, by simp, hk'⟩ }
+end
+
+/-- The subgroup generated by a cycle is in bijection with its support -/
+noncomputable def is_cycle.zpowers_equiv_support {σ : perm α} (hσ : is_cycle σ) :
+  (↑(subgroup.zpowers σ) : set (perm α)) ≃ (↑(σ.support) : set α) :=
+equiv.of_bijective (λ τ, ⟨τ (classical.some hσ),
+begin
+  obtain ⟨τ, n, rfl⟩ := τ,
+  rw [finset.mem_coe, coe_fn_coe_base', subtype.coe_mk, zpow_apply_mem_support, mem_support],
+  exact (classical.some_spec hσ).1,
+end⟩)
+begin
+  split,
+  { rintros ⟨a, m, rfl⟩ ⟨b, n, rfl⟩ h,
+    ext y,
+    by_cases hy : σ y = y,
+    { simp_rw [subtype.coe_mk, zpow_apply_eq_self_of_apply_eq_self hy] },
+    { obtain ⟨i, rfl⟩ := (classical.some_spec hσ).2 hy,
+      rw [subtype.coe_mk, subtype.coe_mk, zpow_apply_comm σ m i, zpow_apply_comm σ n i],
+      exact congr_arg _ (subtype.ext_iff.mp h) } }, by
+  { rintros ⟨y, hy⟩,
+    rw [finset.mem_coe, mem_support] at hy,
+    obtain ⟨n, rfl⟩ := (classical.some_spec hσ).2 hy,
+    exact ⟨⟨σ ^ n, n, rfl⟩, rfl⟩ },
+end
+
+@[simp] lemma is_cycle.zpowers_equiv_support_apply {σ : perm α} (hσ : is_cycle σ) {n : ℕ} :
+  hσ.zpowers_equiv_support ⟨σ ^ n, n, rfl⟩ = ⟨(σ ^ n) (classical.some hσ),
+    pow_apply_mem_support.2 (mem_support.2 (classical.some_spec hσ).1)⟩ :=
+rfl
+
+@[simp] lemma is_cycle.zpowers_equiv_support_symm_apply {σ : perm α} (hσ : is_cycle σ) (n : ℕ) :
+  hσ.zpowers_equiv_support.symm ⟨(σ ^ n) (classical.some hσ),
+    pow_apply_mem_support.2 (mem_support.2 (classical.some_spec hσ).1)⟩ =
+    ⟨σ ^ n, n, rfl⟩ :=
+(equiv.symm_apply_eq _).2 hσ.zpowers_equiv_support_apply
+
+protected lemma is_cycle.order_of (hf : is_cycle f) : order_of f = f.support.card :=
+begin
+  rw [order_eq_card_zpowers, ←fintype.card_coe],
+  convert fintype.card_congr (is_cycle.zpowers_equiv_support hf),
+end
+
+lemma is_cycle_swap_mul_aux₁ {α : Type*} [decidable_eq α] : ∀ (n : ℕ) {b x : α} {f : perm α}
+  (hb : (swap x (f x) * f) b ≠ b) (h : (f ^ n) (f x) = b),
+  ∃ i : ℤ, ((swap x (f x) * f) ^ i) (f x) = b
+| 0         := λ b x f hb h, ⟨0, h⟩
+| (n+1 : ℕ) := λ b x f hb h,
+  if hfbx : f x = b then ⟨0, hfbx⟩
+  else
+    have f b ≠ b ∧ b ≠ x, from ne_and_ne_of_swap_mul_apply_ne_self hb,
+    have hb' : (swap x (f x) * f) (f⁻¹ b) ≠ f⁻¹ b,
+      by { rw [mul_apply, apply_inv_self, swap_apply_of_ne_of_ne this.2 (ne.symm hfbx),
+          ne.def, ← f.injective.eq_iff, apply_inv_self],
+        exact this.1 },
+    let ⟨i, hi⟩ := is_cycle_swap_mul_aux₁ n hb'
+      (f.injective $ by { rw [apply_inv_self], rwa [pow_succ, mul_apply] at h }) in
+    ⟨i + 1, by rw [add_comm, zpow_add, mul_apply, hi, zpow_one, mul_apply, apply_inv_self,
+        swap_apply_of_ne_of_ne (ne_and_ne_of_swap_mul_apply_ne_self hb).2 (ne.symm hfbx)]⟩
+
+lemma is_cycle_swap_mul_aux₂ {α : Type*} [decidable_eq α] :
+  ∀ (n : ℤ) {b x : α} {f : perm α} (hb : (swap x (f x) * f) b ≠ b) (h : (f ^ n) (f x) = b),
+  ∃ i : ℤ, ((swap x (f x) * f) ^ i) (f x) = b
+| (n : ℕ) := λ b x f, is_cycle_swap_mul_aux₁ n
+| -[1+ n] := λ b x f hb h,
+  if hfbx' : f x = b then ⟨0, hfbx'⟩
+  else
+  have f b ≠ b ∧ b ≠ x := ne_and_ne_of_swap_mul_apply_ne_self hb,
+  have hb : (swap x (f⁻¹ x) * f⁻¹) (f⁻¹ b) ≠ f⁻¹ b,
+    by { rw [mul_apply, swap_apply_def],
+      split_ifs;
+      simp only [inv_eq_iff_eq, perm.mul_apply, zpow_neg_succ_of_nat, ne.def,
+        perm.apply_inv_self] at *;
+      cc },
+  let ⟨i, hi⟩ := is_cycle_swap_mul_aux₁ n hb
+    (show (f⁻¹ ^ n) (f⁻¹ x) = f⁻¹ b, by
+      rw [← zpow_coe_nat, ← h, ← mul_apply, ← mul_apply, ← mul_apply, zpow_neg_succ_of_nat,
+        ← inv_pow, pow_succ', mul_assoc, mul_assoc, inv_mul_self, mul_one, zpow_coe_nat,
+        ← pow_succ', ← pow_succ]) in
+  have h : (swap x (f⁻¹ x) * f⁻¹) (f x) = f⁻¹ x, by rw [mul_apply, inv_apply_self, swap_apply_left],
+  ⟨-i, by rw [← add_sub_cancel i 1, neg_sub, sub_eq_add_neg, zpow_add, zpow_one, zpow_neg,
+      ← inv_zpow, mul_inv_rev, swap_inv, mul_swap_eq_swap_mul, inv_apply_self, swap_comm _ x,
+      zpow_add, zpow_one, mul_apply, mul_apply (_ ^ i), h, hi, mul_apply, apply_inv_self,
+      swap_apply_of_ne_of_ne this.2 (ne.symm hfbx')]⟩
+
+lemma is_cycle.eq_swap_of_apply_apply_eq_self {α : Type*} [decidable_eq α]
+  {f : perm α} (hf : is_cycle f) {x : α}
+  (hfx : f x ≠ x) (hffx : f (f x) = x) : f = swap x (f x) :=
+equiv.ext $ λ y,
+let ⟨z, hz⟩ := hf in
+let ⟨i, hi⟩ := hz.2 hfx in
+if hyx : y = x then by simp [hyx]
+else if hfyx : y = f x then by simp [hfyx, hffx]
+else begin
+  rw [swap_apply_of_ne_of_ne hyx hfyx],
+  refine by_contradiction (λ hy, _),
+  cases hz.2 hy with j hj,
+  rw [← sub_add_cancel j i, zpow_add, mul_apply, hi] at hj,
+  cases zpow_apply_eq_of_apply_apply_eq_self hffx (j - i) with hji hji,
+  { rw [← hj, hji] at hyx, cc },
+  { rw [← hj, hji] at hfyx, cc }
+end
+
+lemma is_cycle.swap_mul {α : Type*} [decidable_eq α] {f : perm α} (hf : is_cycle f) {x : α}
+  (hx : f x ≠ x) (hffx : f (f x) ≠ x) : is_cycle (swap x (f x) * f) :=
+⟨f x, by { simp [swap_apply_def, mul_apply, if_neg hffx, f.injective.eq_iff, if_neg hx, hx], },
+  λ y hy,
+  let ⟨i, hi⟩ := hf.exists_zpow_eq hx (ne_and_ne_of_swap_mul_apply_ne_self hy).1 in
+  have hi : (f ^ (i - 1)) (f x) = y, from
+    calc (f ^ (i - 1)) (f x) = (f ^ (i - 1) * f ^ (1 : ℤ)) x : by rw [zpow_one, mul_apply]
+    ... = y : by rwa [← zpow_add, sub_add_cancel],
+  is_cycle_swap_mul_aux₂ (i - 1) hy hi⟩
+
+lemma is_cycle.sign : ∀ {f : perm α} (hf : is_cycle f),
+  sign f = -(-1) ^ f.support.card
+| f := λ hf,
+let ⟨x, hx⟩ := hf in
+calc sign f = sign (swap x (f x) * (swap x (f x) * f)) :
+  by rw [← mul_assoc, mul_def, mul_def, swap_swap, trans_refl]
+... = -(-1) ^ f.support.card :
+  if h1 : f (f x) = x
+  then
+    have h : swap x (f x) * f = 1,
+      begin
+        rw hf.eq_swap_of_apply_apply_eq_self hx.1 h1,
+        simp only [perm.mul_def, perm.one_def, swap_apply_left, swap_swap]
+      end,
+    by { rw [sign_mul, sign_swap hx.1.symm, h, sign_one, hf.eq_swap_of_apply_apply_eq_self hx.1 h1,
+      card_support_swap hx.1.symm], refl }
+  else
+    have h : card (support (swap x (f x) * f)) + 1 = card (support f),
+      by rw [← insert_erase (mem_support.2 hx.1), support_swap_mul_eq _ _ h1,
+        card_insert_of_not_mem (not_mem_erase _ _), sdiff_singleton_eq_erase],
+    have wf : card (support (swap x (f x) * f)) < card (support f),
+      from card_support_swap_mul hx.1,
+    by { rw [sign_mul, sign_swap hx.1.symm, (hf.swap_mul hx.1 h1).sign, ← h],
+      simp only [pow_add, mul_one, neg_neg, one_mul, mul_neg, eq_self_iff_true,
+        pow_one, neg_mul_neg] }
+using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ f, f.support.card)⟩]}
+
+lemma is_cycle.of_pow {n : ℕ} (h1 : is_cycle (f ^ n)) (h2 : f.support ⊆ (f ^ n).support) :
+  is_cycle f :=
+begin
+  have key : ∀ x : α, (f ^ n) x ≠ x ↔ f x ≠ x,
+  { simp_rw [←mem_support, ←finset.ext_iff],
+    exact (support_pow_le _ n).antisymm h2 },
+  obtain ⟨x, hx1, hx2⟩ := h1,
+  refine ⟨x, (key x).mp hx1, λ y hy, _⟩,
+  cases (hx2 ((key y).mpr hy)) with i _,
+  exact ⟨n * i, by rwa zpow_mul⟩
+end
+
+-- The lemma `support_zpow_le` is relevant. It means that `h2` is equivalent to
+-- `σ.support = (σ ^ n).support`, as well as to `σ.support.card ≤ (σ ^ n).support.card`.
+lemma is_cycle.of_zpow {n : ℤ} (h1 : is_cycle (f ^ n)) (h2 : f.support ⊆ (f ^ n).support) :
+  is_cycle f :=
+begin
+  cases n,
+  { exact h1.of_pow h2 },
+  { simp only [le_eq_subset, zpow_neg_succ_of_nat, perm.support_inv] at h1 h2,
+    simpa using h1.inv.of_pow h2 }
+end
+
+lemma nodup_of_pairwise_disjoint_cycles {l : list (perm β)} (h1 : ∀ f ∈ l, is_cycle f)
+  (h2 : l.pairwise disjoint) : l.nodup :=
+nodup_of_pairwise_disjoint (λ h, (h1 1 h).ne_one rfl) h2
+
+/-- Unlike `support_congr`, which assumes that `∀ (x ∈ g.support), f x = g x)`, here
+we have the weaker assumption that `∀ (x ∈ f.support), f x = g x`. -/
+lemma is_cycle.support_congr (hf : is_cycle f) (hg : is_cycle g) (h : f.support ⊆ g.support)
+ (h' : ∀ x ∈ f.support, f x = g x) : f = g :=
+begin
+  have : f.support = g.support,
+  { refine le_antisymm h _,
+    intros z hz,
+    obtain ⟨x, hx, hf'⟩ := id hf,
+    have hx' : g x ≠ x,
+    { rwa [←h' x (mem_support.mpr hx)] },
+    obtain ⟨m, hm⟩ := hg.exists_pow_eq hx' (mem_support.mp hz),
+    have h'' : ∀ (x ∈ f.support ∩ g.support), f x = g x,
+    { intros x hx,
+      exact h' x (mem_of_mem_inter_left hx) },
+    rwa [←hm, ←pow_eq_on_of_mem_support h'' _ x (mem_inter_of_mem (mem_support.mpr hx)
+          (mem_support.mpr hx')), pow_apply_mem_support, mem_support] },
+  refine support_congr h _,
+  simpa [←this] using h'
+end
+
+/-- If two cyclic permutations agree on all terms in their intersection,
+and that intersection is not empty, then the two cyclic permutations must be equal. -/
+lemma is_cycle.eq_on_support_inter_nonempty_congr (hf : is_cycle f) (hg : is_cycle g)
+  (h : ∀ x ∈ f.support ∩ g.support, f x = g x) (hx : f x = g x) (hx' : x ∈ f.support) :
+  f = g :=
+begin
+  have hx'' : x ∈ g.support,
+  { rwa [mem_support, ←hx, ←mem_support] },
+  have : f.support ⊆ g.support,
+  { intros y hy,
+    obtain ⟨k, rfl⟩ := hf.exists_pow_eq (mem_support.mp hx') (mem_support.mp hy),
+    rwa [pow_eq_on_of_mem_support h _ _ (mem_inter_of_mem hx' hx''), pow_apply_mem_support] },
+  rw (inter_eq_left_iff_subset _ _).mpr this at h,
+  exact hf.support_congr hg this h
+end
+
+lemma is_cycle.support_pow_eq_iff (hf : is_cycle f) {n : ℕ} :
+  support (f ^ n) = support f ↔ ¬ order_of f ∣ n :=
+begin
+  rw order_of_dvd_iff_pow_eq_one,
+  split,
+  { intros h H,
+    refine hf.ne_one _,
+    rw [←support_eq_empty_iff, ←h, H, support_one] },
+  { intro H,
+    apply le_antisymm (support_pow_le _ n) _,
+    intros x hx,
+    contrapose! H,
+    ext z,
+    by_cases hz : f z = z,
+    { rw [pow_apply_eq_self_of_apply_eq_self hz, one_apply] },
+    { obtain ⟨k, rfl⟩ := hf.exists_pow_eq hz (mem_support.mp hx),
+      apply (f ^ k).injective,
+      rw [←mul_apply, (commute.pow_pow_self _ _ _).eq, mul_apply],
+      simpa using H } }
+end
+
+lemma is_cycle.support_pow_of_pos_of_lt_order_of (hf : is_cycle f) {n : ℕ} (npos : 0 < n)
+  (hn : n < order_of f) :
+  (f ^ n).support = f.support :=
+hf.support_pow_eq_iff.2 $ nat.not_dvd_of_pos_of_lt npos hn
+
+lemma is_cycle.pow_iff [finite β] {f : perm β} (hf : is_cycle f) {n : ℕ} :
+  is_cycle (f ^ n) ↔ n.coprime (order_of f) :=
+begin
+  classical,
+  casesI nonempty_fintype β,
+  split,
+  { intro h,
+    have hr : support (f ^ n) = support f,
+    { rw hf.support_pow_eq_iff,
+      rintro ⟨k, rfl⟩,
+      refine h.ne_one _,
+      simp [pow_mul, pow_order_of_eq_one] },
+    have : order_of (f ^ n) = order_of f,
+    { rw [h.order_of, hr, hf.order_of] },
+    rw [order_of_pow, nat.div_eq_self] at this,
+    cases this,
+    { exact absurd this (order_of_pos _).ne' },
+    { rwa [nat.coprime_iff_gcd_eq_one, nat.gcd_comm] } },
+  { intro h,
+    obtain ⟨m, hm⟩ := exists_pow_eq_self_of_coprime h,
+    have hf' : is_cycle ((f ^ n) ^ m) := by rwa hm,
+    refine hf'.of_pow (λ x hx, _),
+    rw [hm],
+    exact support_pow_le _ n hx }
+end
+
+-- TODO: Define a `set`-valued support to get rid of the `finite β` assumption
+lemma is_cycle.pow_eq_one_iff [finite β] {f : perm β} (hf : is_cycle f) {n : ℕ} :
+  f ^ n = 1 ↔ ∃ x, f x ≠ x ∧ (f ^ n) x = x :=
+begin
+  classical,
+  casesI nonempty_fintype β,
+  split,
+  { intro h,
+    obtain ⟨x, hx, -⟩ := id hf,
+    exact ⟨x, hx, by simp [h]⟩ },
+  { rintro ⟨x, hx, hx'⟩,
+    by_cases h : support (f ^ n) = support f,
+    { rw [← mem_support, ← h, mem_support] at hx,
+      contradiction },
+    { rw [hf.support_pow_eq_iff, not_not] at h,
+      obtain ⟨k, rfl⟩ := h,
+      rw [pow_mul, pow_order_of_eq_one, one_pow] } }
+end
+
+-- TODO: Define a `set`-valued support to get rid of the `finite β` assumption
+lemma is_cycle.pow_eq_one_iff' [finite β] {f : perm β} (hf : is_cycle f) {n : ℕ} {x : β}
+  (hx : f x ≠ x) :
+  f ^ n = 1 ↔ (f ^ n) x = x :=
+⟨λ h, fun_like.congr_fun h x, λ h, hf.pow_eq_one_iff.2 ⟨x, hx, h⟩⟩
+
+-- TODO: Define a `set`-valued support to get rid of the `finite β` assumption
+lemma is_cycle.pow_eq_one_iff'' [finite β] {f : perm β} (hf : is_cycle f) {n : ℕ} :
+  f ^ n = 1 ↔ ∀ x, f x ≠ x → (f ^ n) x = x :=
+⟨λ h x hx, (hf.pow_eq_one_iff' hx).1 h, λ h, let ⟨x, hx, _⟩ := id hf in
+  (hf.pow_eq_one_iff' hx).2 (h _ hx)⟩
+
+-- TODO: Define a `set`-valued support to get rid of the `finite β` assumption
+lemma is_cycle.pow_eq_pow_iff [finite β] {f : perm β} (hf : is_cycle f) {a b : ℕ} :
+  f ^ a = f ^ b ↔ ∃ x, f x ≠ x ∧ (f ^ a) x = (f ^ b) x :=
+begin
+  classical,
+  casesI nonempty_fintype β,
+  split,
+  { intro h,
+    obtain ⟨x, hx, -⟩ := id hf,
+    exact ⟨x, hx, by simp [h]⟩ },
+  { rintro ⟨x, hx, hx'⟩,
+    wlog hab : a ≤ b generalizing a b,
+    { exact (this hx'.symm (le_of_not_le hab)).symm },
+    suffices : f ^ (b - a) = 1,
+    { rw [pow_sub _ hab, mul_inv_eq_one] at this,
+      rw this },
+    rw hf.pow_eq_one_iff,
+    by_cases hfa : (f ^ a) x ∈ f.support,
+    { refine ⟨(f ^ a) x, mem_support.mp hfa, _⟩,
+      simp only [pow_sub _ hab, equiv.perm.coe_mul, function.comp_app,
+        inv_apply_self, ← hx'] },
+    { have h := @equiv.perm.zpow_apply_comm _ f 1 a x,
+      simp only [zpow_one, zpow_coe_nat] at h,
+      rw [not_mem_support, h, function.injective.eq_iff (f ^ a).injective] at hfa,
+      contradiction }}
+end
+
+lemma is_cycle.is_cycle_pow_pos_of_lt_prime_order [finite β] {f : perm β} (hf : is_cycle f)
+  (hf' : (order_of f).prime) (n : ℕ) (hn : 0 < n) (hn' : n < order_of f) : is_cycle (f ^ n) :=
+begin
+  classical,
+  casesI nonempty_fintype β,
+  have : n.coprime (order_of f),
+  { refine nat.coprime.symm _,
+    rw nat.prime.coprime_iff_not_dvd hf',
+    exact nat.not_dvd_of_pos_of_lt hn hn' },
+  obtain ⟨m, hm⟩ := exists_pow_eq_self_of_coprime this,
+  have hf'' := hf,
+  rw ←hm at hf'',
+  refine hf''.of_pow _,
+  rw [hm],
+  exact support_pow_le f n
+end
+
+end is_cycle
+
+/-! ### `is_cycle_on` -/
+
+section is_cycle_on
+variables {f g : perm α} {s t : set α} {a b x y : α}
+
+/-- A permutation is a cycle on `s` when any two points of `s` are related by repeated application
+of the permutation. Note that this means the identity is a cycle of subsingleton sets. -/
+def is_cycle_on (f : perm α) (s : set α) : Prop :=
+set.bij_on f s s ∧ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → f.same_cycle x y
+
+@[simp] lemma is_cycle_on_empty : f.is_cycle_on ∅ := by simp [is_cycle_on]
+
+@[simp] lemma is_cycle_on_one : (1 : perm α).is_cycle_on s ↔ s.subsingleton :=
+by simp [is_cycle_on, set.bij_on_id, set.subsingleton]
+
+alias is_cycle_on_one ↔ is_cycle_on.subsingleton _root_.set.subsingleton.is_cycle_on_one
+
+@[simp] lemma is_cycle_on_singleton : f.is_cycle_on {a} ↔ f a = a :=
+by simp [is_cycle_on, same_cycle.rfl]
+
+lemma is_cycle_on_of_subsingleton [subsingleton α] (f : perm α) (s : set α) : f.is_cycle_on s :=
+⟨s.bij_on_of_subsingleton _, λ x _ y _, (subsingleton.elim x y).same_cycle _⟩
+
+@[simp] lemma is_cycle_on_inv : f⁻¹.is_cycle_on s ↔ f.is_cycle_on s :=
+by simp [is_cycle_on, set.bij_on_perm_inv]
+
+alias is_cycle_on_inv ↔ is_cycle_on.of_inv is_cycle_on.inv
+
+lemma is_cycle_on.conj (h : f.is_cycle_on s) : (g * f * g⁻¹).is_cycle_on ((g : perm α) '' s) :=
+⟨(g.bij_on_image.comp h.1).comp g.bij_on_symm_image,
+  λ x hx y hy, by { rw ←preimage_inv at hx hy, convert (h.2 hx hy).conj; rw apply_inv_self }⟩
+
+lemma is_cycle_on_swap [decidable_eq α] (hab : a ≠ b) : (swap a b).is_cycle_on {a, b} :=
+⟨bij_on_swap (by simp) (by simp), λ x hx y hy, begin
+  rw [set.mem_insert_iff, set.mem_singleton_iff] at hx hy,
+  obtain rfl | rfl := hx; obtain rfl | rfl := hy,
+  { exact ⟨0, by rw [zpow_zero, coe_one, id.def]⟩ },
+  { exact ⟨1, by rw [zpow_one, swap_apply_left]⟩ },
+  { exact ⟨1, by rw [zpow_one, swap_apply_right]⟩ },
+  { exact ⟨0, by rw [zpow_zero, coe_one, id.def]⟩ }
+end⟩
+
+protected lemma is_cycle_on.apply_ne (hf : f.is_cycle_on s) (hs : s.nontrivial) (ha : a ∈ s) :
+  f a ≠ a :=
+begin
+  obtain ⟨b, hb, hba⟩ := hs.exists_ne a,
+  obtain ⟨n, rfl⟩ := hf.2 ha hb,
+  exact λ h, hba (is_fixed_pt.perm_zpow h n),
+end
+
+protected lemma is_cycle.is_cycle_on (hf : f.is_cycle) : f.is_cycle_on {x | f x ≠ x} :=
+⟨f.bij_on $ λ x, f.apply_eq_iff_eq.not, λ a ha b, hf.same_cycle ha⟩
+
+/-- This lemma demonstrates the relation between `equiv.perm.is_cycle` and `equiv.perm.is_cycle_on`
+in non-degenerate cases. -/
+lemma is_cycle_iff_exists_is_cycle_on :
+  f.is_cycle ↔ ∃ s : set α, s.nontrivial ∧ f.is_cycle_on s ∧ ∀ ⦃x⦄, ¬ is_fixed_pt f x → x ∈ s :=
+begin
+  refine ⟨λ hf, ⟨{x | f x ≠ x}, _, hf.is_cycle_on, λ _, id⟩, _⟩,
+  { obtain ⟨a, ha⟩ := hf,
+    exact ⟨f a, f.injective.ne ha.1, a, ha.1, ha.1⟩ },
+  { rintro ⟨s, hs, hf, hsf⟩,
+   obtain ⟨a, ha⟩ := hs.nonempty,
+   exact ⟨a, hf.apply_ne hs ha, λ b hb, hf.2 ha $ hsf hb⟩ }
+end
+
+lemma is_cycle_on.apply_mem_iff (hf : f.is_cycle_on s) : f x ∈ s ↔ x ∈ s :=
+⟨λ hx, by { convert hf.1.perm_inv.1 hx, rw inv_apply_self }, λ hx, hf.1.maps_to hx⟩
+
+/-- Note that the identity satisfies `is_cycle_on` for any subsingleton set, but not `is_cycle`. -/
+lemma is_cycle_on.is_cycle_subtype_perm (hf : f.is_cycle_on s) (hs : s.nontrivial) :
+  (f.subtype_perm $ λ _, hf.apply_mem_iff.symm : perm s).is_cycle :=
+begin
+  obtain ⟨a, ha⟩ := hs.nonempty,
+  exact ⟨⟨a, ha⟩, ne_of_apply_ne (coe : s → α) (hf.apply_ne hs ha),
+    λ b hb, (hf.2 (⟨a, ha⟩ : s).prop b.prop).subtype_perm⟩,
+end
+
+/-- Note that the identity is a cycle on any subsingleton set, but not a cycle. -/
+protected lemma is_cycle_on.subtype_perm (hf : f.is_cycle_on s) :
+  (f.subtype_perm $ λ _, hf.apply_mem_iff.symm : perm s).is_cycle_on set.univ :=
+begin
+  obtain hs | hs := s.subsingleton_or_nontrivial,
+  { haveI := hs.coe_sort,
+    exact is_cycle_on_of_subsingleton _ _ },
+  convert (hf.is_cycle_subtype_perm hs).is_cycle_on,
+  rw [eq_comm, set.eq_univ_iff_forall],
+  exact λ x, ne_of_apply_ne (coe : s → α) (hf.apply_ne hs x.prop),
+end
+
+-- TODO: Theory of order of an element under an action
+lemma is_cycle_on.pow_apply_eq {s : finset α} (hf : f.is_cycle_on s) (ha : a ∈ s) {n : ℕ} :
+  (f ^ n) a = a ↔ s.card ∣ n :=
+begin
+  obtain rfl | hs := finset.eq_singleton_or_nontrivial ha,
+  { rw [coe_singleton, is_cycle_on_singleton] at hf,
+    simpa using is_fixed_pt.iterate hf n },
+  classical,
+  have h : ∀ x ∈ s.attach, ¬ f ↑x = ↑x := λ x hx, hf.apply_ne hs x.prop,
+  have := (hf.is_cycle_subtype_perm hs).order_of,
+  simp only [filter_true_of_mem h, support_subtype_perm, card_attach] at this,
+  rw [←this, order_of_dvd_iff_pow_eq_one, (hf.is_cycle_subtype_perm hs).pow_eq_one_iff'
+    (ne_of_apply_ne (coe : s → α) $ hf.apply_ne hs (⟨a, ha⟩ : s).prop)],
+  simp only [subtype.coe_mk, subtype_perm_pow, subtype_perm_apply],
+end
+
+lemma is_cycle_on.zpow_apply_eq {s : finset α} (hf : f.is_cycle_on s) (ha : a ∈ s) :
+  ∀ {n : ℤ}, (f ^ n) a = a ↔ (s.card : ℤ) ∣ n
+| (int.of_nat n) := (hf.pow_apply_eq ha).trans int.coe_nat_dvd.symm
+| (int.neg_succ_of_nat n) := by { rw [zpow_neg_succ_of_nat, ←inv_pow],
+    exact (hf.inv.pow_apply_eq ha).trans (dvd_neg.trans int.coe_nat_dvd).symm }
+
+lemma is_cycle_on.pow_apply_eq_pow_apply {s : finset α} (hf : f.is_cycle_on s) (ha : a ∈ s)
+  {m n : ℕ} : (f ^ m) a = (f ^ n) a ↔ m ≡ n [MOD s.card] :=
+begin
+  rw [nat.modeq_iff_dvd, ←hf.zpow_apply_eq ha],
+  simp [sub_eq_neg_add, zpow_add, eq_inv_iff_eq, eq_comm],
+end
+
+lemma is_cycle_on.zpow_apply_eq_zpow_apply {s : finset α} (hf : f.is_cycle_on s) (ha : a ∈ s)
+  {m n : ℤ} : (f ^ m) a = (f ^ n) a ↔ m ≡ n [ZMOD s.card] :=
+begin
+  rw [int.modeq_iff_dvd, ←hf.zpow_apply_eq ha],
+  simp [sub_eq_neg_add, zpow_add, eq_inv_iff_eq, eq_comm],
+end
+
+lemma is_cycle_on.pow_card_apply {s : finset α} (hf : f.is_cycle_on s) (ha : a ∈ s) :
+  (f ^ s.card) a = a :=
+(hf.pow_apply_eq ha).2 dvd_rfl
+
+lemma is_cycle_on.exists_pow_eq {s : finset α} (hf : f.is_cycle_on s) (ha : a ∈ s) (hb : b ∈ s) :
+  ∃ n < s.card, (f ^ n) a = b :=
+begin
+  classical,
+  obtain ⟨n, rfl⟩ := hf.2 ha hb,
+  obtain ⟨k, hk⟩ := (int.mod_modeq n s.card).symm.dvd,
+  refine ⟨n.nat_mod s.card, int.nat_mod_lt (nonempty.card_pos ⟨a, ha⟩).ne', _⟩,
+  rw [←zpow_coe_nat, int.nat_mod, int.to_nat_of_nonneg (int.mod_nonneg _ $ nat.cast_ne_zero.2
+    (nonempty.card_pos ⟨a, ha⟩).ne'), sub_eq_iff_eq_add'.1 hk, zpow_add, zpow_mul],
+  simp only [zpow_coe_nat, coe_mul, embedding_like.apply_eq_iff_eq],
+  exact is_fixed_pt.perm_zpow (hf.pow_card_apply ha) _,
+end
+
+lemma is_cycle_on.exists_pow_eq' (hs : s.finite) (hf : f.is_cycle_on s) (ha : a ∈ s) (hb : b ∈ s) :
+  ∃ n : ℕ, (f ^ n) a = b :=
+by { lift s to finset α using id hs, obtain ⟨n, -, hn⟩ := hf.exists_pow_eq ha hb, exact ⟨n, hn⟩ }
+
+lemma is_cycle_on.range_pow (hs : s.finite) (h : f.is_cycle_on s) (ha : a ∈ s) :
+  set.range (λ n, (f ^ n) a : ℕ → α) = s :=
+set.subset.antisymm (set.range_subset_iff.2 $ λ n, h.1.maps_to.perm_pow _ ha) $
+  λ x, h.exists_pow_eq' hs ha
+
+lemma is_cycle_on.range_zpow (h : f.is_cycle_on s) (ha : a ∈ s) :
+  set.range (λ n, (f ^ n) a : ℤ → α) = s :=
+set.subset.antisymm (set.range_subset_iff.2 $ λ n, (h.1.perm_zpow _).maps_to ha) $ h.2 ha
+
+lemma is_cycle_on.of_pow {n : ℕ} (hf : (f ^ n).is_cycle_on s) (h : set.bij_on f s s) :
+  f.is_cycle_on s :=
+⟨h, λ x hx y hy, (hf.2 hx hy).of_pow⟩
+
+lemma is_cycle_on.of_zpow {n : ℤ} (hf : (f ^ n).is_cycle_on s) (h : set.bij_on f s s) :
+  f.is_cycle_on s :=
+⟨h, λ x hx y hy, (hf.2 hx hy).of_zpow⟩
+
+lemma is_cycle_on.extend_domain {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p)
+  (h : g.is_cycle_on s) :
+  (g.extend_domain f).is_cycle_on (coe ∘ f '' s) :=
+⟨h.1.extend_domain, by { rintro _ ⟨a, ha, rfl⟩ _ ⟨b, hb, rfl⟩, exact (h.2 ha hb).extend_domain }⟩
+
+protected lemma is_cycle_on.countable (hs : f.is_cycle_on s) : s.countable :=
+begin
+  obtain rfl | ⟨a, ha⟩ := s.eq_empty_or_nonempty,
+  { exact set.countable_empty },
+  { exact (set.countable_range $ λ n : ℤ, (⇑(f ^ n) : α → α) a).mono (hs.2 ha) }
+end
+
+end is_cycle_on
+
+/-!
+### `cycle_of`
+-/
+
+section cycle_of
+variables [decidable_eq α] [fintype α] {f g : perm α} {x y : α}
+
+/-- `f.cycle_of x` is the cycle of the permutation `f` to which `x` belongs. -/
+def cycle_of (f : perm α) (x : α) : perm α :=
+of_subtype (subtype_perm f (λ _, same_cycle_apply_right.symm) : perm {y // same_cycle f x y})
+
+lemma cycle_of_apply (f : perm α) (x y : α) :
+  cycle_of f x y = if same_cycle f x y then f y else y :=
+begin
+  dsimp only [cycle_of],
+  split_ifs,
+  { apply of_subtype_apply_of_mem, exact h, },
+  { apply of_subtype_apply_of_not_mem, exact h },
+end
+
+lemma cycle_of_inv (f : perm α) (x : α) : (cycle_of f x)⁻¹ = cycle_of f⁻¹ x :=
+equiv.ext $ λ y, begin
+  rw [inv_eq_iff_eq, cycle_of_apply, cycle_of_apply],
+  split_ifs; simp [*, same_cycle_inv, same_cycle_inv_apply_right] at *
+end
+
+@[simp] lemma cycle_of_pow_apply_self (f : perm α) (x : α) :
+  ∀ n : ℕ, (cycle_of f x ^ n) x = (f ^ n) x
+| 0     := rfl
+| (n+1) := by { rw [pow_succ, mul_apply, cycle_of_apply,
+    cycle_of_pow_apply_self, if_pos, pow_succ, mul_apply],
+  exact ⟨n, rfl⟩ }
+
+@[simp] lemma cycle_of_zpow_apply_self (f : perm α) (x : α) :
+  ∀ n : ℤ, (cycle_of f x ^ n) x = (f ^ n) x
+| (n : ℕ) := cycle_of_pow_apply_self f x n
+| -[1+ n] := by rw [zpow_neg_succ_of_nat, ← inv_pow, cycle_of_inv,
+  zpow_neg_succ_of_nat, ← inv_pow, cycle_of_pow_apply_self]
+
+lemma same_cycle.cycle_of_apply : same_cycle f x y → cycle_of f x y = f y :=
+of_subtype_apply_of_mem _
+
+lemma cycle_of_apply_of_not_same_cycle : ¬ same_cycle f x y → cycle_of f x y = y :=
+of_subtype_apply_of_not_mem _
+
+lemma same_cycle.cycle_of_eq (h : same_cycle f x y) : cycle_of f x = cycle_of f y :=
+begin
+  ext z,
+  rw cycle_of_apply,
+  split_ifs with hz hz,
+  { exact (h.symm.trans hz).cycle_of_apply.symm },
+  { exact (cycle_of_apply_of_not_same_cycle (mt h.trans hz)).symm }
+end
+
+@[simp] lemma cycle_of_apply_apply_zpow_self (f : perm α) (x : α) (k : ℤ) :
+  cycle_of f x ((f ^ k) x) = (f ^ (k + 1)) x :=
+begin
+  rw same_cycle.cycle_of_apply,
+  { rw [add_comm, zpow_add, zpow_one, mul_apply] },
+  { exact ⟨k, rfl⟩ }
+end
+
+@[simp] lemma cycle_of_apply_apply_pow_self (f : perm α) (x : α) (k : ℕ) :
+  cycle_of f x ((f ^ k) x) = (f ^ (k + 1)) x :=
+by convert cycle_of_apply_apply_zpow_self f x k using 1
+
+@[simp] lemma cycle_of_apply_apply_self (f : perm α) (x : α) : cycle_of f x (f x) = f (f x) :=
+by convert cycle_of_apply_apply_pow_self f x 1 using 1
+
+@[simp] lemma cycle_of_apply_self (f : perm α) (x : α) : cycle_of f x x = f x :=
+same_cycle.rfl.cycle_of_apply
+
+lemma is_cycle.cycle_of_eq (hf : is_cycle f) (hx : f x ≠ x) : cycle_of f x = f :=
+equiv.ext $ λ y,
+  if h : same_cycle f x y then by rw [h.cycle_of_apply] else
+  by rw [cycle_of_apply_of_not_same_cycle h, not_not.1 (mt ((is_cycle_iff_same_cycle hx).1 hf).2 h)]
+
+@[simp] lemma cycle_of_eq_one_iff (f : perm α) : cycle_of f x = 1 ↔ f x = x :=
+begin
+  simp_rw [ext_iff, cycle_of_apply, one_apply],
+  refine ⟨λ h, (if_pos (same_cycle.refl f x)).symm.trans (h x), λ h y, _⟩,
+  by_cases hy : f y = y,
+  { rw [hy, if_t_t] },
+  { exact if_neg (mt same_cycle.apply_eq_self_iff (by tauto)) },
+end
+
+@[simp] lemma cycle_of_self_apply (f : perm α) (x : α) : cycle_of f (f x) = cycle_of f x :=
+(same_cycle_apply_right.2 same_cycle.rfl).symm.cycle_of_eq
+
+@[simp] lemma cycle_of_self_apply_pow (f : perm α) (n : ℕ) (x : α) :
+  cycle_of f ((f ^ n) x) = cycle_of f x :=
+same_cycle.rfl.pow_left.cycle_of_eq
+
+@[simp] lemma cycle_of_self_apply_zpow (f : perm α) (n : ℤ) (x : α) :
+  cycle_of f ((f ^ n) x) = cycle_of f x :=
+same_cycle.rfl.zpow_left.cycle_of_eq
+
+protected lemma is_cycle.cycle_of (hf : is_cycle f) : cycle_of f x = if f x = x then 1 else f :=
+begin
+  by_cases hx : f x = x,
+  { rwa [if_pos hx, cycle_of_eq_one_iff] },
+  { rwa [if_neg hx, hf.cycle_of_eq] },
+end
+
+lemma cycle_of_one (x : α) : cycle_of 1 x = 1 := (cycle_of_eq_one_iff 1).mpr rfl
+
+lemma is_cycle_cycle_of (f : perm α) (hx : f x ≠ x) : is_cycle (cycle_of f x) :=
+have cycle_of f x x ≠ x, by rwa [same_cycle.rfl.cycle_of_apply],
+(is_cycle_iff_same_cycle this).2 $ λ y,
+⟨λ h, mt h.apply_eq_self_iff.2 this,
+  λ h, if hxy : same_cycle f x y then
+  let ⟨i, hi⟩ := hxy in
+  ⟨i, by rw [cycle_of_zpow_apply_self, hi]⟩
+  else by { rw [cycle_of_apply_of_not_same_cycle hxy] at h, exact (h rfl).elim }⟩
+
+@[simp] lemma two_le_card_support_cycle_of_iff : 2 ≤ card (cycle_of f x).support ↔ f x ≠ x :=
+begin
+  refine ⟨λ h, _, λ h, by simpa using (is_cycle_cycle_of _ h).two_le_card_support⟩,
+  contrapose! h,
+  rw ←cycle_of_eq_one_iff at h,
+  simp [h]
+end
+
+@[simp] lemma card_support_cycle_of_pos_iff : 0 < card (cycle_of f x).support ↔ f x ≠ x :=
+begin
+  rw [←two_le_card_support_cycle_of_iff, ←nat.succ_le_iff],
+  exact ⟨λ h, or.resolve_left h.eq_or_lt (card_support_ne_one _).symm, zero_lt_two.trans_le⟩
+end
+
+lemma pow_apply_eq_pow_mod_order_of_cycle_of_apply (f : perm α) (n : ℕ) (x : α) :
+  (f ^ n) x = (f ^ (n % order_of (cycle_of f x))) x :=
+by rw [←cycle_of_pow_apply_self f, ←cycle_of_pow_apply_self f, pow_eq_mod_order_of]
+
+lemma cycle_of_mul_of_apply_right_eq_self (h : _root_.commute f g) (x : α) (hx : g x = x) :
+  (f * g).cycle_of x = f.cycle_of x :=
+begin
+  ext y,
+  by_cases hxy : (f * g).same_cycle x y,
+  { obtain ⟨z, rfl⟩ := hxy,
+    rw cycle_of_apply_apply_zpow_self,
+    simp [h.mul_zpow, zpow_apply_eq_self_of_apply_eq_self hx] },
+  { rw [cycle_of_apply_of_not_same_cycle hxy, cycle_of_apply_of_not_same_cycle],
+    contrapose! hxy,
+    obtain ⟨z, rfl⟩ := hxy,
+    refine ⟨z, _⟩,
+    simp [h.mul_zpow, zpow_apply_eq_self_of_apply_eq_self hx] }
+end
+
+lemma disjoint.cycle_of_mul_distrib (h : f.disjoint g) (x : α) :
+  (f * g).cycle_of x = (f.cycle_of x * g.cycle_of x) :=
+begin
+  cases (disjoint_iff_eq_or_eq.mp h) x with hfx hgx,
+  { simp [h.commute.eq, cycle_of_mul_of_apply_right_eq_self h.symm.commute, hfx] },
+  { simp [cycle_of_mul_of_apply_right_eq_self h.commute, hgx] }
+end
+
+lemma support_cycle_of_eq_nil_iff : (f.cycle_of x).support = ∅ ↔ x ∉ f.support := by simp
+
+lemma support_cycle_of_le (f : perm α) (x : α) : support (f.cycle_of x) ≤ support f :=
+begin
+  intros y hy,
+  rw [mem_support, cycle_of_apply] at hy,
+  split_ifs at hy,
+  { exact mem_support.mpr hy },
+  { exact absurd rfl hy }
+end
+
+lemma mem_support_cycle_of_iff : y ∈ support (f.cycle_of x) ↔ same_cycle f x y ∧ x ∈ support f :=
+begin
+  by_cases hx : f x = x,
+  { rw (cycle_of_eq_one_iff _).mpr hx,
+    simp [hx] },
+  { rw [mem_support, cycle_of_apply],
+    split_ifs with hy,
+    { simp only [hx, hy, iff_true, ne.def, not_false_iff, and_self, mem_support],
+      rcases hy with ⟨k, rfl⟩,
+      rw ←not_mem_support,
+      simpa using hx },
+    { simpa [hx] using hy } }
+end
+
+lemma mem_support_cycle_of_iff' (hx : f x ≠ x) : y ∈ support (f.cycle_of x) ↔ same_cycle f x y :=
+by rw [mem_support_cycle_of_iff, and_iff_left (mem_support.2 hx)]
+
+lemma same_cycle.mem_support_iff (h : same_cycle f x y) : x ∈ support f ↔ y ∈ support f :=
+⟨λ hx, support_cycle_of_le f x (mem_support_cycle_of_iff.mpr ⟨h, hx⟩),
+ λ hy, support_cycle_of_le f y (mem_support_cycle_of_iff.mpr ⟨h.symm, hy⟩)⟩
+
+lemma pow_mod_card_support_cycle_of_self_apply (f : perm α) (n : ℕ) (x : α) :
+  (f ^ (n % (f.cycle_of x).support.card)) x = (f ^ n) x :=
+begin
+  by_cases hx : f x = x,
+  { rw [pow_apply_eq_self_of_apply_eq_self hx, pow_apply_eq_self_of_apply_eq_self hx] },
+  { rw [←cycle_of_pow_apply_self, ←cycle_of_pow_apply_self f, ←(is_cycle_cycle_of f hx).order_of,
+      ←pow_eq_mod_order_of] }
+end
+
+/-- `x` is in the support of `f` iff `equiv.perm.cycle_of f x` is a cycle. -/
+lemma is_cycle_cycle_of_iff (f : perm α) : is_cycle (cycle_of f x) ↔ f x ≠ x :=
+begin
+  refine ⟨λ hx, _, f.is_cycle_cycle_of⟩,
+  rw [ne.def, ←cycle_of_eq_one_iff f],
+  exact hx.ne_one,
+end
+
+lemma is_cycle_on_support_cycle_of (f : perm α) (x : α) : f.is_cycle_on (f.cycle_of x).support :=
+⟨f.bij_on $ by simp [mem_support_cycle_of_iff], λ a ha b hb,
+  by { rw [mem_coe, mem_support_cycle_of_iff] at ha hb, exact ha.1.symm.trans hb.1 }⟩
+
+lemma same_cycle.exists_pow_eq_of_mem_support (h : same_cycle f x y) (hx : x ∈ f.support) :
+  ∃ (i : ℕ) (hi' : i < (f.cycle_of x).support.card), (f ^ i) x = y :=
+begin
+  rw mem_support at hx,
+  refine (f.is_cycle_on_support_cycle_of _).exists_pow_eq _ _;
+    rwa mem_support_cycle_of_iff' hx,
+end
+
+lemma same_cycle.exists_pow_eq (f : perm α) (h : same_cycle f x y) :
+  ∃ (i : ℕ) (hi : 0 < i) (hi' : i ≤ (f.cycle_of x).support.card + 1), (f ^ i) x = y :=
+begin
+  by_cases hx : x ∈ f.support,
+  { obtain ⟨k, hk, hk'⟩ := h.exists_pow_eq_of_mem_support hx,
+    cases k,
+    { refine ⟨(f.cycle_of x).support.card, _, self_le_add_right _ _, _⟩,
+      { refine zero_lt_one.trans (one_lt_card_support_of_ne_one _),
+        simpa using hx },
+      { simp only [perm.coe_one, id.def, pow_zero] at hk',
+        subst hk',
+        rw [←(is_cycle_cycle_of _ $ mem_support.1 hx).order_of,
+            ←cycle_of_pow_apply_self, pow_order_of_eq_one, one_apply] } },
+    { exact ⟨k + 1, by simp, nat.le_succ_of_le hk.le, hk'⟩ } },
+  { refine ⟨1, zero_lt_one, by simp, _⟩,
+    obtain ⟨k, rfl⟩ := h,
+    rw [not_mem_support] at hx,
+    rw [pow_apply_eq_self_of_apply_eq_self hx,
+        zpow_apply_eq_self_of_apply_eq_self hx] }
+end
+
+end cycle_of
+
+/-!
+### `cycle_factors`
+-/
+
+variables [decidable_eq α]
+
+/-- Given a list `l : list α` and a permutation `f : perm α` whose nonfixed points are all in `l`,
+  recursively factors `f` into cycles. -/
+def cycle_factors_aux [fintype α] : Π (l : list α) (f : perm α),
+  (∀ {x}, f x ≠ x → x ∈ l) →
+  {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint}
+| []     f h := ⟨[], by { simp only [imp_false, list.pairwise.nil, list.not_mem_nil, forall_const,
+    and_true, forall_prop_of_false, not_not, not_false_iff, list.prod_nil] at *,
+  ext, simp * }⟩
+| (x::l) f h :=
+if hx : f x = x then
+  cycle_factors_aux l f (λ y hy, list.mem_of_ne_of_mem (λ h, hy (by rwa h)) (h hy))
+else let ⟨m, hm₁, hm₂, hm₃⟩ := cycle_factors_aux l ((cycle_of f x)⁻¹ * f)
+  (λ y hy, list.mem_of_ne_of_mem
+    (λ h : y = x,
+      by { rw [h, mul_apply, ne.def, inv_eq_iff_eq, cycle_of_apply_self] at hy, exact hy rfl })
+    (h (λ h : f y = y, by { rw [mul_apply, h, ne.def, inv_eq_iff_eq, cycle_of_apply] at hy,
+        split_ifs at hy; cc }))) in
+    ⟨(cycle_of f x) :: m, by { rw [list.prod_cons, hm₁], simp },
+      λ g hg, ((list.mem_cons_iff _ _ _).1 hg).elim (λ hg, hg.symm ▸ is_cycle_cycle_of _ hx)
+        (hm₂ g),
+      list.pairwise_cons.2 ⟨λ g hg y,
+        or_iff_not_imp_left.2 (λ hfy,
+          have hxy : same_cycle f x y := not_not.1 (mt cycle_of_apply_of_not_same_cycle hfy),
+          have hgm : g :: m.erase g ~ m := list.cons_perm_iff_perm_erase.2 ⟨hg, list.perm.refl _⟩,
+          have ∀ h ∈ m.erase g, disjoint g h, from
+            (list.pairwise_cons.1 ((hgm.pairwise_iff (λ a b (h : disjoint a b), h.symm)).2 hm₃)).1,
+          classical.by_cases id $ λ hgy : g y ≠ y,
+            (disjoint_prod_right _ this y).resolve_right $
+            have hsc : same_cycle f⁻¹ x (f y), by rwa [same_cycle_inv, same_cycle_apply_right],
+            by { rw [disjoint_prod_perm hm₃ hgm.symm, list.prod_cons,
+                ← eq_inv_mul_iff_mul_eq] at hm₁,
+              rwa [hm₁, mul_apply, mul_apply, cycle_of_inv, hsc.cycle_of_apply,
+                inv_apply_self, inv_eq_iff_eq, eq_comm] }),
+        hm₃⟩⟩
+
+lemma mem_list_cycles_iff {α : Type*} [finite α] {l : list (perm α)}
+  (h1 : ∀ σ : perm α, σ ∈ l → σ.is_cycle)
+  (h2 : l.pairwise disjoint) {σ : perm α} :
+  σ ∈ l ↔ σ.is_cycle ∧ ∀ (a : α) (h4 : σ a ≠ a), σ a = l.prod a :=
+begin
+  suffices : σ.is_cycle → (σ ∈ l ↔ ∀ (a : α) (h4 : σ a ≠ a), σ a = l.prod a),
+  { exact ⟨λ hσ, ⟨h1 σ hσ, (this (h1 σ hσ)).mp hσ⟩, λ hσ, (this hσ.1).mpr hσ.2⟩ },
+  intro h3,
+  classical,
+  casesI nonempty_fintype α,
+  split,
+  { intros h a ha,
+    exact eq_on_support_mem_disjoint h h2 _ (mem_support.mpr ha) },
+  { intros h,
+    have hσl : σ.support ⊆ l.prod.support,
+    { intros x hx,
+      rw mem_support at hx,
+      rwa [mem_support, ←h _ hx] },
+    obtain ⟨a, ha, -⟩ := id h3,
+    rw ←mem_support at ha,
+    obtain ⟨τ, hτ, hτa⟩ := exists_mem_support_of_mem_support_prod (hσl ha),
+    have hτl : ∀ (x ∈ τ.support), τ x = l.prod x := eq_on_support_mem_disjoint hτ h2,
+    have key : ∀ (x ∈ σ.support ∩ τ.support), σ x = τ x,
+    { intros x hx,
+      rw [h x (mem_support.mp (mem_of_mem_inter_left hx)), hτl x (mem_of_mem_inter_right hx)] },
+    convert hτ,
+    refine h3.eq_on_support_inter_nonempty_congr (h1 _ hτ) key _ ha,
+    exact key a (mem_inter_of_mem ha hτa) }
+end
+
+lemma list_cycles_perm_list_cycles {α : Type*} [finite α] {l₁ l₂ : list (perm α)}
+  (h₀ : l₁.prod = l₂.prod)
+  (h₁l₁ : ∀ σ : perm α, σ ∈ l₁ → σ.is_cycle) (h₁l₂ : ∀ σ : perm α, σ ∈ l₂ → σ.is_cycle)
+  (h₂l₁ : l₁.pairwise disjoint) (h₂l₂ : l₂.pairwise disjoint) :
+  l₁ ~ l₂ :=
+begin
+  classical,
+  refine (list.perm_ext (nodup_of_pairwise_disjoint_cycles h₁l₁ h₂l₁)
+    (nodup_of_pairwise_disjoint_cycles h₁l₂ h₂l₂)).mpr (λ σ, _),
+  by_cases hσ : σ.is_cycle,
+  { obtain ⟨a, ha⟩ := not_forall.mp (mt ext hσ.ne_one),
+    rw [mem_list_cycles_iff h₁l₁ h₂l₁, mem_list_cycles_iff h₁l₂ h₂l₂, h₀] },
+  { exact iff_of_false (mt (h₁l₁ σ) hσ) (mt (h₁l₂ σ) hσ) }
+end
+
+/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`. -/
+def cycle_factors [fintype α] [linear_order α] (f : perm α) :
+  {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint} :=
+cycle_factors_aux (univ.sort (≤)) f (λ _ _, (mem_sort _).2 (mem_univ _))
+
+/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`,
+  without a linear order. -/
+def trunc_cycle_factors [fintype α] (f : perm α) :
+  trunc {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint} :=
+quotient.rec_on_subsingleton (@univ α _).1
+  (λ l h, trunc.mk (cycle_factors_aux l f h))
+  (show ∀ x, f x ≠ x → x ∈ (@univ α _).1, from λ _ _, mem_univ _)
+
+section cycle_factors_finset
+
+variables [fintype α] (f : perm α)
+
+/-- Factors a permutation `f` into a `finset` of disjoint cyclic permutations that multiply to `f`.
+-/
+def cycle_factors_finset : finset (perm α) :=
+(trunc_cycle_factors f).lift
+  (λ (l : {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint}),
+    l.val.to_finset) (λ ⟨l, hl⟩ ⟨l', hl'⟩, list.to_finset_eq_of_perm _ _
+      (list_cycles_perm_list_cycles (hl'.left.symm ▸ hl.left) hl.right.left (hl'.right.left)
+        hl.right.right hl'.right.right))
+
+lemma cycle_factors_finset_eq_list_to_finset {σ : perm α} {l : list (perm α)} (hn : l.nodup) :
+  σ.cycle_factors_finset = l.to_finset ↔ (∀ f : perm α, f ∈ l → f.is_cycle) ∧
+    l.pairwise disjoint ∧ l.prod = σ :=
+begin
+  obtain ⟨⟨l', hp', hc', hd'⟩, hl⟩ := trunc.exists_rep σ.trunc_cycle_factors,
+  have ht : cycle_factors_finset σ = l'.to_finset,
+  { rw [cycle_factors_finset, ←hl, trunc.lift_mk] },
+  rw ht,
+  split,
+  { intro h,
+    have hn' : l'.nodup := nodup_of_pairwise_disjoint_cycles hc' hd',
+    have hperm : l ~ l' := list.perm_of_nodup_nodup_to_finset_eq hn hn' h.symm,
+    refine ⟨_, _, _⟩,
+    { exact λ _ h, hc' _ (hperm.subset h) },
+    { rwa list.perm.pairwise_iff disjoint.symmetric hperm },
+    { rw [←hp', hperm.symm.prod_eq'],
+      refine hd'.imp _,
+      exact λ _ _, disjoint.commute } },
+  { rintro ⟨hc, hd, hp⟩,
+    refine list.to_finset_eq_of_perm _ _ _,
+    refine list_cycles_perm_list_cycles _ hc' hc hd' hd,
+    rw [hp, hp'] }
+end
+
+lemma cycle_factors_finset_eq_finset {σ : perm α} {s : finset (perm α)} :
+  σ.cycle_factors_finset = s ↔ (∀ f : perm α, f ∈ s → f.is_cycle) ∧
+    ∃ h : (s : set (perm α)).pairwise disjoint,
+      s.noncomm_prod id (h.mono' $ λ _ _, disjoint.commute) = σ :=
+begin
+  obtain ⟨l, hl, rfl⟩ := s.exists_list_nodup_eq,
+  simp [cycle_factors_finset_eq_list_to_finset, hl],
+end
+
+lemma cycle_factors_finset_pairwise_disjoint :
+  (cycle_factors_finset f : set (perm α)).pairwise disjoint :=
+(cycle_factors_finset_eq_finset.mp rfl).2.some
+
+lemma cycle_factors_finset_mem_commute :
+  (cycle_factors_finset f : set (perm α)).pairwise commute :=
+(cycle_factors_finset_pairwise_disjoint _).mono' $ λ _ _, disjoint.commute
+
+/-- The product of cycle factors is equal to the original `f : perm α`. -/
+lemma cycle_factors_finset_noncomm_prod
+  (comm : (cycle_factors_finset f : set (perm α)).pairwise commute :=
+    cycle_factors_finset_mem_commute f) :
+  f.cycle_factors_finset.noncomm_prod id comm = f :=
+(cycle_factors_finset_eq_finset.mp rfl).2.some_spec
+
+lemma mem_cycle_factors_finset_iff {f p : perm α} :
+  p ∈ cycle_factors_finset f ↔ p.is_cycle ∧ ∀ (a ∈ p.support), p a = f a :=
+begin
+  obtain ⟨l, hl, hl'⟩ := f.cycle_factors_finset.exists_list_nodup_eq,
+  rw ←hl',
+  rw [eq_comm, cycle_factors_finset_eq_list_to_finset hl] at hl',
+  simpa [list.mem_to_finset, ne.def, ←hl'.right.right]
+    using mem_list_cycles_iff hl'.left hl'.right.left
+end
+
+lemma cycle_of_mem_cycle_factors_finset_iff {f : perm α} {x : α} :
+  cycle_of f x ∈ cycle_factors_finset f ↔ x ∈ f.support :=
+begin
+  rw mem_cycle_factors_finset_iff,
+  split,
+  { rintro ⟨hc, h⟩,
+    contrapose! hc,
+    rw [not_mem_support, ←cycle_of_eq_one_iff] at hc,
+    simp [hc] },
+  { intros hx,
+    refine ⟨is_cycle_cycle_of _ (mem_support.mp hx), _⟩,
+    intros y hy,
+    rw mem_support at hy,
+    rw cycle_of_apply,
+    split_ifs with H,
+    { refl },
+    { rw cycle_of_apply_of_not_same_cycle H at hy,
+      contradiction } }
+end
+
+lemma mem_cycle_factors_finset_support_le {p f : perm α} (h : p ∈ cycle_factors_finset f) :
+  p.support ≤ f.support :=
+begin
+  rw mem_cycle_factors_finset_iff at h,
+  intros x hx,
+  rwa [mem_support, ←h.right x hx, ←mem_support]
+end
+
+lemma cycle_factors_finset_eq_empty_iff {f : perm α} :
+  cycle_factors_finset f = ∅ ↔ f = 1 :=
+by simpa [cycle_factors_finset_eq_finset] using eq_comm
+
+@[simp] lemma cycle_factors_finset_one :
+  cycle_factors_finset (1 : perm α) = ∅ :=
+by simp [cycle_factors_finset_eq_empty_iff]
+
+@[simp] lemma cycle_factors_finset_eq_singleton_self_iff {f : perm α} :
+  f.cycle_factors_finset = {f} ↔ f.is_cycle :=
+by simp [cycle_factors_finset_eq_finset]
+
+lemma is_cycle.cycle_factors_finset_eq_singleton {f : perm α} (hf : is_cycle f) :
+  f.cycle_factors_finset = {f} :=
+cycle_factors_finset_eq_singleton_self_iff.mpr hf
+
+lemma cycle_factors_finset_eq_singleton_iff {f g : perm α} :
+  f.cycle_factors_finset = {g} ↔ f.is_cycle ∧ f = g :=
+begin
+  suffices : f = g → (g.is_cycle ↔ f.is_cycle),
+  { simpa [cycle_factors_finset_eq_finset, eq_comm] },
+  rintro rfl,
+  exact iff.rfl
+end
+
+/-- Two permutations `f g : perm α` have the same cycle factors iff they are the same. -/
+lemma cycle_factors_finset_injective : function.injective (@cycle_factors_finset α _ _) :=
+begin
+  intros f g h,
+  rw ←cycle_factors_finset_noncomm_prod f,
+  simpa [h] using cycle_factors_finset_noncomm_prod g
+end
+
+lemma disjoint.disjoint_cycle_factors_finset {f g : perm α} (h : disjoint f g) :
+  _root_.disjoint (cycle_factors_finset f) (cycle_factors_finset g) :=
+begin
+  rw [disjoint_iff_disjoint_support] at h,
+  rw finset.disjoint_left,
+  intros x hx hy,
+  simp only [mem_cycle_factors_finset_iff, mem_support] at hx hy,
+  obtain ⟨⟨⟨a, ha, -⟩, hf⟩, -, hg⟩ := ⟨hx, hy⟩,
+  refine h.le_bot (_ : a ∈ f.support ∩ g.support),
+  simp [ha, ←hf a ha, ←hg a ha]
+end
+
+lemma disjoint.cycle_factors_finset_mul_eq_union {f g : perm α} (h : disjoint f g) :
+  cycle_factors_finset (f * g) = cycle_factors_finset f ∪ cycle_factors_finset g :=
+begin
+  rw cycle_factors_finset_eq_finset,
+  refine ⟨_, _, _⟩,
+  { simp [or_imp_distrib, mem_cycle_factors_finset_iff, forall_swap] },
+  { rw [coe_union, set.pairwise_union_of_symmetric disjoint.symmetric],
+    exact ⟨cycle_factors_finset_pairwise_disjoint _, cycle_factors_finset_pairwise_disjoint _,
+      λ x hx y hy hxy, h.mono (mem_cycle_factors_finset_support_le hx)
+        (mem_cycle_factors_finset_support_le hy)⟩ },
+  { rw noncomm_prod_union_of_disjoint h.disjoint_cycle_factors_finset,
+    rw [cycle_factors_finset_noncomm_prod, cycle_factors_finset_noncomm_prod] }
+end
+
+lemma disjoint_mul_inv_of_mem_cycle_factors_finset {f g : perm α} (h : f ∈ cycle_factors_finset g) :
+  disjoint (g * f⁻¹) f :=
+begin
+  rw mem_cycle_factors_finset_iff at h,
+  intro x,
+  by_cases hx : f x = x,
+  { exact or.inr hx },
+  { refine or.inl _,
+    rw [mul_apply, ←h.right, apply_inv_self],
+    rwa [←support_inv, apply_mem_support, support_inv, mem_support] }
+end
+
+/-- If c is a cycle, a ∈ c.support and c is a cycle of f, then `c = f.cycle_of a` -/
+lemma cycle_is_cycle_of {f c : equiv.perm α} {a : α}
+  (ha : a ∈ c.support) (hc : c ∈ f.cycle_factors_finset) : c = f.cycle_of a :=
+begin
+  suffices : f.cycle_of a = c.cycle_of a,
+  { rw this,
+    apply symm,
+    exact equiv.perm.is_cycle.cycle_of_eq
+     ((equiv.perm.mem_cycle_factors_finset_iff.mp hc).left)
+     (equiv.perm.mem_support.mp ha), },
+  let hfc := (equiv.perm.disjoint_mul_inv_of_mem_cycle_factors_finset hc).symm,
+  let hfc2 := (perm.disjoint.commute hfc),
+  rw ← equiv.perm.cycle_of_mul_of_apply_right_eq_self hfc2,
+  simp only [hfc2.eq, inv_mul_cancel_right],
+  -- a est dans le support de c, donc pas dans celui de g c⁻¹
+  exact equiv.perm.not_mem_support.mp
+    (finset.disjoint_left.mp (equiv.perm.disjoint.disjoint_support  hfc) ha),
+end
+
+end cycle_factors_finset
+
+@[elab_as_eliminator] lemma cycle_induction_on [finite β] (P : perm β → Prop) (σ : perm β)
+  (base_one : P 1) (base_cycles : ∀ σ : perm β, σ.is_cycle → P σ)
+  (induction_disjoint : ∀ σ τ : perm β, disjoint σ τ → is_cycle σ → P σ → P τ → P (σ * τ)) :
+  P σ :=
+begin
+  casesI nonempty_fintype β,
+  suffices :
+    ∀ l : list (perm β), (∀ τ : perm β, τ ∈ l → τ.is_cycle) → l.pairwise disjoint → P l.prod,
+  { classical,
+    let x := σ.trunc_cycle_factors.out,
+    exact (congr_arg P x.2.1).mp (this x.1 x.2.2.1 x.2.2.2) },
+  intro l,
+  induction l with σ l ih,
+  { exact λ _ _, base_one },
+  { intros h1 h2,
+    rw list.prod_cons,
+    exact induction_disjoint σ l.prod
+      (disjoint_prod_right _ (list.pairwise_cons.mp h2).1)
+      (h1 _ (list.mem_cons_self _ _))
+      (base_cycles σ (h1 σ (l.mem_cons_self σ)))
+      (ih (λ τ hτ, h1 τ (list.mem_cons_of_mem σ hτ)) h2.of_cons) }
+end
+
+lemma cycle_factors_finset_mul_inv_mem_eq_sdiff [fintype α] {f g : perm α}
+  (h : f ∈ cycle_factors_finset g) :
+  cycle_factors_finset (g * f⁻¹) = (cycle_factors_finset g) \ {f} :=
+begin
+  revert f,
+  apply cycle_induction_on _ g,
+  { simp },
+  { intros σ hσ f hf,
+    simp only [cycle_factors_finset_eq_singleton_self_iff.mpr hσ, mem_singleton] at hf ⊢,
+    simp [hf] },
+  { intros σ τ hd hc hσ hτ f,
+    simp_rw [hd.cycle_factors_finset_mul_eq_union, mem_union],
+    -- if only `wlog` could work here...
+    rintro (hf | hf),
+    { rw [hd.commute.eq, union_comm, union_sdiff_distrib, sdiff_singleton_eq_erase,
+          erase_eq_of_not_mem, mul_assoc, disjoint.cycle_factors_finset_mul_eq_union, hσ hf],
+      { rw mem_cycle_factors_finset_iff at hf,
+        intro x,
+        cases hd.symm x with hx hx,
+        { exact or.inl hx },
+        { refine or.inr _,
+          by_cases hfx : f x = x,
+          { rw ←hfx,
+            simpa [hx] using hfx.symm },
+          { rw mul_apply,
+            rw ←hf.right _ (mem_support.mpr hfx) at hx,
+            contradiction } } },
+      { exact λ H, hd.disjoint_cycle_factors_finset.le_bot (mem_inter_of_mem hf H) } },
+    { rw [union_sdiff_distrib, sdiff_singleton_eq_erase,
+          erase_eq_of_not_mem, mul_assoc, disjoint.cycle_factors_finset_mul_eq_union, hτ hf],
+      { rw mem_cycle_factors_finset_iff at hf,
+        intro x,
+        cases hd x with hx hx,
+        { exact or.inl hx },
+        { refine or.inr _,
+          by_cases hfx : f x = x,
+          { rw ←hfx,
+            simpa [hx] using hfx.symm },
+          { rw mul_apply,
+            rw ←hf.right _ (mem_support.mpr hfx) at hx,
+            contradiction } } },
+      { exact λ H, hd.disjoint_cycle_factors_finset.le_bot (mem_inter_of_mem H hf) } } }
+end
+
+section generation
+
+variables [finite β]
+
+open subgroup
+
+lemma closure_is_cycle : closure {σ : perm β | is_cycle σ} = ⊤ :=
+begin
+  classical,
+  casesI nonempty_fintype β,
+  exact top_le_iff.mp (le_trans (ge_of_eq closure_is_swap) (closure_mono (λ _, is_swap.is_cycle))),
+end
+
+variables [fintype α]
+
+lemma closure_cycle_adjacent_swap {σ : perm α} (h1 : is_cycle σ) (h2 : σ.support = ⊤) (x : α) :
+  closure ({σ, swap x (σ x)} : set (perm α)) = ⊤ :=
+begin
+  let H := closure ({σ, swap x (σ x)} : set (perm α)),
+  have h3 : σ ∈ H := subset_closure (set.mem_insert σ _),
+  have h4 : swap x (σ x) ∈ H := subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)),
+  have step1 : ∀ (n : ℕ), swap ((σ ^ n) x) ((σ^(n+1)) x) ∈ H,
+  { intro n,
+    induction n with n ih,
+    { exact subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)) },
+    { convert H.mul_mem (H.mul_mem h3 ih) (H.inv_mem h3),
+      simp_rw [mul_swap_eq_swap_mul, mul_inv_cancel_right, pow_succ], refl } },
+  have step2 : ∀ (n : ℕ), swap x ((σ ^ n) x) ∈ H,
+  { intro n,
+    induction n with n ih,
+    { convert H.one_mem,
+      exact swap_self x },
+    { by_cases h5 : x = (σ ^ n) x,
+      { rw [pow_succ, mul_apply, ←h5], exact h4 },
+      by_cases h6 : x = (σ^(n+1)) x,
+      { rw [←h6, swap_self], exact H.one_mem },
+      rw [swap_comm, ←swap_mul_swap_mul_swap h5 h6],
+      exact H.mul_mem (H.mul_mem (step1 n) ih) (step1 n) } },
+  have step3 : ∀ (y : α), swap x y ∈ H,
+  { intro y,
+    have hx : x ∈ (⊤ : finset α) := finset.mem_univ x,
+    rw [←h2, mem_support] at hx,
+    have hy : y ∈ (⊤ : finset α) := finset.mem_univ y,
+    rw [←h2, mem_support] at hy,
+    cases is_cycle.exists_pow_eq h1 hx hy with n hn,
+    rw ← hn,
+    exact step2 n },
+  have step4 : ∀ (y z : α), swap y z ∈ H,
+  { intros y z,
+    by_cases h5 : z = x,
+    { rw [h5, swap_comm], exact step3 y },
+    by_cases h6 : z = y,
+    { rw [h6, swap_self], exact H.one_mem },
+    rw [←swap_mul_swap_mul_swap h5 h6, swap_comm z x],
+    exact H.mul_mem (H.mul_mem (step3 y) (step3 z)) (step3 y) },
+  rw [eq_top_iff, ←closure_is_swap, closure_le],
+  rintros τ ⟨y, z, h5, h6⟩,
+  rw h6,
+  exact step4 y z,
+end
+
+lemma closure_cycle_coprime_swap {n : ℕ} {σ : perm α} (h0 : nat.coprime n (fintype.card α))
+  (h1 : is_cycle σ) (h2 : σ.support = finset.univ) (x : α) :
+  closure ({σ, swap x ((σ ^ n) x)} : set (perm α)) = ⊤ :=
+begin
+  rw [←finset.card_univ, ←h2, ←h1.order_of] at h0,
+  cases exists_pow_eq_self_of_coprime h0 with m hm,
+  have h2' : (σ ^ n).support = ⊤ := eq.trans (support_pow_coprime h0) h2,
+  have h1' : is_cycle ((σ ^ n) ^ (m : ℤ)) := by rwa ← hm at h1,
+  replace h1' : is_cycle (σ ^ n) := h1'.of_pow
+    (le_trans (support_pow_le σ n) (ge_of_eq (congr_arg support hm))),
+  rw [eq_top_iff, ←closure_cycle_adjacent_swap h1' h2' x, closure_le, set.insert_subset],
+  exact ⟨subgroup.pow_mem (closure _) (subset_closure (set.mem_insert σ _)) n,
+    set.singleton_subset_iff.mpr (subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)))⟩,
+end
+
+lemma closure_prime_cycle_swap {σ τ : perm α} (h0 : (fintype.card α).prime) (h1 : is_cycle σ)
+  (h2 : σ.support = finset.univ) (h3 : is_swap τ) : closure ({σ, τ} : set (perm α)) = ⊤ :=
+begin
+  obtain ⟨x, y, h4, h5⟩ := h3,
+  obtain ⟨i, hi⟩ := h1.exists_pow_eq (mem_support.mp
+  ((finset.ext_iff.mp h2 x).mpr (finset.mem_univ x)))
+    (mem_support.mp ((finset.ext_iff.mp h2 y).mpr (finset.mem_univ y))),
+  rw [h5, ←hi],
+  refine closure_cycle_coprime_swap (nat.coprime.symm
+    (h0.coprime_iff_not_dvd.mpr (λ h, h4 _))) h1 h2 x,
+  cases h with m hm,
+  rwa [hm, pow_mul, ←finset.card_univ, ←h2, ←h1.order_of,
+    pow_order_of_eq_one, one_pow, one_apply] at hi,
+end
+
+end generation
+
+section
+variables [fintype α] {σ τ : perm α}
+
+noncomputable theory
+
+lemma is_conj_of_support_equiv (f : {x // x ∈ (σ.support : set α)} ≃ {x // x ∈ (τ.support : set α)})
+  (hf : ∀ (x : α) (hx : x ∈ (σ.support : set α)), (f ⟨σ x, apply_mem_support.2 hx⟩ : α) =
+    τ ↑(f ⟨x,hx⟩)) :
+  is_conj σ τ :=
+begin
+  refine is_conj_iff.2 ⟨equiv.extend_subtype f, _⟩,
+  rw mul_inv_eq_iff_eq_mul,
+  ext,
+  simp only [perm.mul_apply],
+  by_cases hx : x ∈ σ.support,
+  { rw [equiv.extend_subtype_apply_of_mem, equiv.extend_subtype_apply_of_mem],
+    { exact hf x (finset.mem_coe.2 hx) } },
+  { rwa [not_not.1 ((not_congr mem_support).1 (equiv.extend_subtype_not_mem f _ _)),
+      not_not.1 ((not_congr mem_support).mp hx)] }
+end
+
+theorem is_cycle.is_conj (hσ : is_cycle σ) (hτ : is_cycle τ) (h : σ.support.card = τ.support.card) :
+  is_conj σ τ :=
+begin
+  refine is_conj_of_support_equiv (hσ.zpowers_equiv_support.symm.trans $
+    (zpowers_equiv_zpowers $ by rw [hσ.order_of, h, hτ.order_of]).trans hτ.zpowers_equiv_support) _,
+  intros x hx,
+  simp only [perm.mul_apply, equiv.trans_apply, equiv.sum_congr_apply],
+  obtain ⟨n, rfl⟩ := hσ.exists_pow_eq (classical.some_spec hσ).1 (mem_support.1 hx),
+  apply eq.trans _ (congr rfl (congr rfl (congr rfl
+    (congr rfl (hσ.zpowers_equiv_support_symm_apply n).symm)))),
+  apply (congr rfl (congr rfl (congr rfl (hσ.zpowers_equiv_support_symm_apply (n + 1))))).trans _,
+  simp only [ne.def, is_cycle.zpowers_equiv_support_apply,
+    subtype.coe_mk, zpowers_equiv_zpowers_apply],
+  rw [pow_succ, perm.mul_apply],
+end
+
+theorem is_cycle.is_conj_iff (hσ : is_cycle σ) (hτ : is_cycle τ) :
+  is_conj σ τ ↔ σ.support.card = τ.support.card :=
+⟨begin
+  intro h,
+  obtain ⟨π, rfl⟩ := is_conj_iff.1 h,
+  apply finset.card_congr (λ a ha, π a) (λ _ ha, _) (λ _ _ _ _ ab, π.injective ab) (λ b hb, _),
+  { simp [mem_support.1 ha] },
+  { refine ⟨π⁻¹ b, ⟨_, π.apply_inv_self b⟩⟩,
+    contrapose! hb,
+    rw [mem_support, not_not] at hb,
+    rw [mem_support, not_not, perm.mul_apply, perm.mul_apply, hb, perm.apply_inv_self] }
+end, hσ.is_conj hτ⟩
+
+@[simp]
+lemma support_conj : (σ * τ * σ⁻¹).support = τ.support.map σ.to_embedding :=
+begin
+  ext,
+  simp only [mem_map_equiv, perm.coe_mul, comp_app, ne.def, perm.mem_support, equiv.eq_symm_apply],
+  refl,
+end
+
+lemma card_support_conj : (σ * τ * σ⁻¹).support.card = τ.support.card :=
+by simp
+
+end
+
+theorem disjoint.is_conj_mul {α : Type*} [finite α] {σ τ π ρ : perm α}
+  (hc1 : is_conj σ π) (hc2 : is_conj τ ρ)
+  (hd1 : disjoint σ τ) (hd2 : disjoint π ρ) :
+  is_conj (σ * τ) (π * ρ) :=
+begin
+  classical,
+  casesI nonempty_fintype α,
+  obtain ⟨f, rfl⟩ := is_conj_iff.1 hc1,
+  obtain ⟨g, rfl⟩ := is_conj_iff.1 hc2,
+  have hd1' := coe_inj.2 hd1.support_mul,
+  have hd2' := coe_inj.2 hd2.support_mul,
+  rw [coe_union] at *,
+  have hd1'' := disjoint_coe.2 (disjoint_iff_disjoint_support.1 hd1),
+  have hd2'' := disjoint_coe.2 (disjoint_iff_disjoint_support.1 hd2),
+  refine is_conj_of_support_equiv _ _,
+  { refine ((equiv.set.of_eq hd1').trans (equiv.set.union hd1''.le_bot)).trans
+      ((equiv.sum_congr (subtype_equiv f (λ a, _)) (subtype_equiv g (λ a, _))).trans
+      ((equiv.set.of_eq hd2').trans (equiv.set.union hd2''.le_bot)).symm);
+    { simp only [set.mem_image, to_embedding_apply, exists_eq_right,
+        support_conj, coe_map, apply_eq_iff_eq] } },
+  { intros x hx,
+    simp only [trans_apply, symm_trans_apply, set.of_eq_apply,
+      set.of_eq_symm_apply, equiv.sum_congr_apply],
+    rw [hd1', set.mem_union] at hx,
+    cases hx with hxσ hxτ,
+    { rw [mem_coe, mem_support] at hxσ,
+      rw [set.union_apply_left hd1''.le_bot _, set.union_apply_left hd1''.le_bot _],
+      simp only [subtype_equiv_apply, perm.coe_mul, sum.map_inl, comp_app,
+        set.union_symm_apply_left, subtype.coe_mk, apply_eq_iff_eq],
+      { have h := (hd2 (f x)).resolve_left _,
+        { rw [mul_apply, mul_apply] at h,
+          rw [h, inv_apply_self, (hd1 x).resolve_left hxσ] },
+        { rwa [mul_apply, mul_apply, inv_apply_self, apply_eq_iff_eq] } },
+      { rwa [subtype.coe_mk, subtype.coe_mk, mem_coe, mem_support] },
+      { rwa [subtype.coe_mk, subtype.coe_mk, perm.mul_apply,
+          (hd1 x).resolve_left hxσ, mem_coe, apply_mem_support, mem_support] } },
+    { rw [mem_coe, ← apply_mem_support, mem_support] at hxτ,
+      rw [set.union_apply_right hd1''.le_bot _, set.union_apply_right hd1''.le_bot _],
+      simp only [subtype_equiv_apply, perm.coe_mul, sum.map_inr, comp_app,
+        set.union_symm_apply_right, subtype.coe_mk, apply_eq_iff_eq],
+      { have h := (hd2 (g (τ x))).resolve_right _,
+        { rw [mul_apply, mul_apply] at h,
+          rw [inv_apply_self, h, (hd1 (τ x)).resolve_right hxτ] },
+        { rwa [mul_apply, mul_apply, inv_apply_self, apply_eq_iff_eq] } },
+      { rwa [subtype.coe_mk, subtype.coe_mk, mem_coe, ← apply_mem_support, mem_support] },
+      { rwa [subtype.coe_mk, subtype.coe_mk, perm.mul_apply,
+          (hd1 (τ x)).resolve_right hxτ, mem_coe, mem_support] } } }
+end
+
+section fixed_points
+
+/-!
+### Fixed points
+-/
+
+lemma fixed_point_card_lt_of_ne_one [fintype α] {σ : perm α} (h : σ ≠ 1) :
+  (filter (λ x, σ x = x) univ).card < fintype.card α - 1 :=
+begin
+  rw [lt_tsub_iff_left, ← lt_tsub_iff_right, ← finset.card_compl,
+    finset.compl_filter],
+  exact one_lt_card_support_of_ne_one h
+end
+
+end fixed_points
+
+end equiv.perm
+
+open equiv
+
+namespace list
+variables [decidable_eq α] {l : list α}
+
+lemma nodup.is_cycle_on_form_perm (h : l.nodup) : l.form_perm.is_cycle_on {a | a ∈ l} :=
+begin
+  refine ⟨l.form_perm.bij_on (λ _, form_perm_mem_iff_mem), λ a ha b hb, _⟩,
+  rw [set.mem_set_of, ←index_of_lt_length] at ha hb,
+  rw [←index_of_nth_le ha, ←index_of_nth_le hb],
+  refine ⟨l.index_of b - l.index_of a, _⟩,
+  simp only [sub_eq_neg_add, zpow_add, zpow_neg, equiv.perm.inv_eq_iff_eq, zpow_coe_nat,
+    equiv.perm.coe_mul, form_perm_pow_apply_nth_le _ h],
+  rw add_comm,
+end
+
+end list
+
+namespace int
+open equiv
+
+lemma add_left_one_is_cycle : (equiv.add_left 1 : perm ℤ).is_cycle :=
+⟨0, one_ne_zero, λ n _, ⟨n, by simp⟩⟩
+
+lemma add_right_one_is_cycle : (equiv.add_right 1 : perm ℤ).is_cycle :=
+⟨0, one_ne_zero, λ n _, ⟨n, by simp⟩⟩
+
+end int
+
+namespace finset
+variables [decidable_eq α] [fintype α]
+
+lemma exists_cycle_on (s : finset α) : ∃ f : perm α, f.is_cycle_on s ∧ f.support ⊆ s :=
+begin
+  refine ⟨s.to_list.form_perm, _,
+    λ x hx, by simpa using list.mem_of_form_perm_apply_ne _ _ (perm.mem_support.1 hx)⟩,
+  convert s.nodup_to_list.is_cycle_on_form_perm,
+  simp,
+end
+
+end finset
+
+namespace set
+variables {f : perm α} {s : set α}
+
+lemma countable.exists_cycle_on (hs : s.countable) :
+  ∃ f : perm α, f.is_cycle_on s ∧ {x | f x ≠ x} ⊆ s :=
+begin
+  classical,
+  obtain hs' | hs' := s.finite_or_infinite,
+  { refine ⟨hs'.to_finset.to_list.form_perm, _,
+      λ x hx, by simpa using list.mem_of_form_perm_apply_ne _ _ hx⟩,
+    convert hs'.to_finset.nodup_to_list.is_cycle_on_form_perm,
+    simp },
+  haveI := hs.to_subtype,
+  haveI := hs'.to_subtype,
+  obtain ⟨f⟩ : nonempty (ℤ ≃ s) := infer_instance,
+  refine ⟨(equiv.add_right 1).extend_domain f, _, λ x hx, of_not_not $ λ h, hx $
+    perm.extend_domain_apply_not_subtype _ _ h⟩,
+  convert int.add_right_one_is_cycle.is_cycle_on.extend_domain _,
+  rw [image_comp, equiv.image_eq_preimage],
+  ext,
+  simp,
+end
+
+lemma prod_self_eq_Union_perm (hf : f.is_cycle_on s) :
+  s ×ˢ s = ⋃ n : ℤ, (λ a, (a, (f ^ n) a)) '' s :=
+begin
+  ext ⟨a, b⟩,
+  simp only [mem_prod, mem_Union, mem_image],
+  refine ⟨λ hx, _, _⟩,
+  { obtain ⟨n, rfl⟩ := hf.2 hx.1 hx.2,
+    exact ⟨_, _, hx.1, rfl⟩ },
+  { rintro ⟨n, a, ha, ⟨⟩⟩,
+    exact ⟨ha, (hf.1.perm_zpow _).maps_to ha⟩ }
+end
+
+end set
+
+namespace finset
+variables {f : perm α} {s : finset α}
+
+lemma product_self_eq_disj_Union_perm_aux (hf : f.is_cycle_on s) :
+  (range s.card : set ℕ).pairwise_disjoint
+    (λ k, s.map ⟨λ i, (i, (f ^ k) i), λ i j, congr_arg prod.fst⟩) :=
+begin
+  obtain hs | hs := (s : set α).subsingleton_or_nontrivial,
+  { refine set.subsingleton.pairwise _ _,
+    simp_rw [set.subsingleton, mem_coe, ←card_le_one] at ⊢ hs,
+    rwa card_range },
+  classical,
+  rintro m hm n hn hmn,
+  simp only [disjoint_left, function.on_fun, mem_map, function.embedding.coe_fn_mk, exists_prop,
+    not_exists, not_and, forall_exists_index, and_imp, prod.forall, prod.mk.inj_iff],
+  rintro _ _ _ - rfl rfl a ha rfl h,
+  rw [hf.pow_apply_eq_pow_apply ha] at h,
+  rw [mem_coe, mem_range] at hm hn,
+  exact hmn.symm (h.eq_of_lt_of_lt hn hm),
+end
+
+/--
+We can partition the square `s ×ˢ s` into shifted diagonals as such:
+```
+01234
+40123
+34012
+23401
+12340
+```
+
+The diagonals are given by the cycle `f`.
+-/
+lemma product_self_eq_disj_Union_perm (hf : f.is_cycle_on s) :
+  s ×ˢ s =
+    (range s.card).disj_Union (λ k, s.map ⟨λ i, (i, (f ^ k) i), λ i j, congr_arg prod.fst⟩)
+      (product_self_eq_disj_Union_perm_aux hf) :=
+begin
+  ext ⟨a, b⟩,
+  simp only [mem_product, equiv.perm.coe_pow, mem_disj_Union, mem_range, mem_map,
+    function.embedding.coe_fn_mk, prod.mk.inj_iff, exists_prop],
+  refine ⟨λ hx, _, _⟩,
+  { obtain ⟨n, hn, rfl⟩ := hf.exists_pow_eq hx.1 hx.2,
+    exact ⟨n, hn, a, hx.1, rfl, by rw f.iterate_eq_pow⟩ },
+  { rintro ⟨n, -, a, ha, rfl, rfl⟩,
+    exact ⟨ha, (hf.1.iterate _).maps_to ha⟩ }
+end
+
+end finset
+
+namespace finset
+variables [semiring α] [add_comm_monoid β] [module α β] {s : finset ι} {σ : perm ι}
+
+lemma sum_smul_sum_eq_sum_perm (hσ : σ.is_cycle_on s) (f : ι → α) (g : ι → β) :
+  (∑ i in s, f i) • ∑ i in s, g i = ∑ k in range s.card, ∑ i in s, f i • g ((σ ^ k) i) :=
+by { simp_rw [sum_smul_sum, product_self_eq_disj_Union_perm hσ, sum_disj_Union, sum_map], refl }
+
+lemma sum_mul_sum_eq_sum_perm (hσ : σ.is_cycle_on s) (f g : ι → α) :
+  (∑ i in s, f i) * ∑ i in s, g i = ∑ k in range s.card, ∑ i in s, f i * g ((σ ^ k) i) :=
+sum_smul_sum_eq_sum_perm hσ f g
+
+end finset
diff --git a/src/group_theory/perm/cycle/concrete.lean b/src/group_theory/perm/cycle/concrete.lean
new file mode 100644
index 0000000000000..8d4f2ac2b3d63
--- /dev/null
+++ b/src/group_theory/perm/cycle/concrete.lean
@@ -0,0 +1,549 @@
+/-
+Copyright (c) 2021 Yakov Pechersky. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yakov Pechersky
+-/
+import data.list.cycle
+import group_theory.perm.cycle.type
+import group_theory.perm.list
+
+/-!
+
+# Properties of cyclic permutations constructed from lists/cycles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In the following, `{α : Type*} [fintype α] [decidable_eq α]`.
+
+## Main definitions
+
+* `cycle.form_perm`: the cyclic permutation created by looping over a `cycle α`
+* `equiv.perm.to_list`: the list formed by iterating application of a permutation
+* `equiv.perm.to_cycle`: the cycle formed by iterating application of a permutation
+* `equiv.perm.iso_cycle`: the equivalence between cyclic permutations `f : perm α`
+  and the terms of `cycle α` that correspond to them
+* `equiv.perm.iso_cycle'`: the same equivalence as `equiv.perm.iso_cycle`
+  but with evaluation via choosing over fintypes
+* The notation `c[1, 2, 3]` to emulate notation of cyclic permutations `(1 2 3)`
+* A `has_repr` instance for any `perm α`, by representing the `finset` of
+  `cycle α` that correspond to the cycle factors.
+
+## Main results
+
+* `list.is_cycle_form_perm`: a nontrivial list without duplicates, when interpreted as
+  a permutation, is cyclic
+* `equiv.perm.is_cycle.exists_unique_cycle`: there is only one nontrivial `cycle α`
+  corresponding to each cyclic `f : perm α`
+
+## Implementation details
+
+The forward direction of `equiv.perm.iso_cycle'` uses `fintype.choose` of the uniqueness
+result, relying on the `fintype` instance of a `cycle.nodup` subtype.
+It is unclear if this works faster than the `equiv.perm.to_cycle`, which relies
+on recursion over `finset.univ`.
+Running `#eval` on even a simple noncyclic permutation `c[(1 : fin 7), 2, 3] * c[0, 5]`
+to show it takes a long time. TODO: is this because computing the cycle factors is slow?
+
+-/
+
+open equiv equiv.perm list
+
+variables {α : Type*}
+
+namespace list
+
+variables [decidable_eq α] {l l' : list α}
+
+lemma form_perm_disjoint_iff (hl : nodup l) (hl' : nodup l')
+  (hn : 2 ≤ l.length) (hn' : 2 ≤ l'.length) :
+  perm.disjoint (form_perm l) (form_perm l') ↔ l.disjoint l' :=
+begin
+  rw [disjoint_iff_eq_or_eq, list.disjoint],
+  split,
+  { rintro h x hx hx',
+    specialize h x,
+    rw [form_perm_apply_mem_eq_self_iff _ hl _ hx,
+        form_perm_apply_mem_eq_self_iff _ hl' _ hx'] at h,
+    rcases h with hl | hl'; linarith },
+  { intros h x,
+    by_cases hx : x ∈ l, by_cases hx' : x ∈ l',
+    { exact (h hx hx').elim },
+    all_goals { have := form_perm_eq_self_of_not_mem _ _ ‹_›, tauto } }
+end
+
+lemma is_cycle_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
+  is_cycle (form_perm l) :=
+begin
+  cases l with x l,
+  { norm_num at hn },
+  induction l with y l IH generalizing x,
+  { norm_num at hn },
+  { use x,
+    split,
+    { rwa form_perm_apply_mem_ne_self_iff _ hl _ (mem_cons_self _ _) },
+    { intros w hw,
+      have : w ∈ (x :: y :: l) := mem_of_form_perm_ne_self _ _ hw,
+      obtain ⟨k, hk, rfl⟩ := nth_le_of_mem this,
+      use k,
+      simp only [zpow_coe_nat, form_perm_pow_apply_head _ _ hl k, nat.mod_eq_of_lt hk] } }
+end
+
+lemma pairwise_same_cycle_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
+  pairwise (l.form_perm.same_cycle) l :=
+pairwise.imp_mem.mpr (pairwise_of_forall (λ x y hx hy, (is_cycle_form_perm hl hn).same_cycle
+  ((form_perm_apply_mem_ne_self_iff _ hl _ hx).mpr hn)
+  ((form_perm_apply_mem_ne_self_iff _ hl _ hy).mpr hn)))
+
+lemma cycle_of_form_perm (hl : nodup l) (hn : 2 ≤ l.length) (x) :
+  cycle_of l.attach.form_perm x = l.attach.form_perm :=
+have hn : 2 ≤ l.attach.length := by rwa ← length_attach at hn,
+have hl : l.attach.nodup := by rwa ← nodup_attach at hl,
+(is_cycle_form_perm hl hn).cycle_of_eq
+  ((form_perm_apply_mem_ne_self_iff _ hl _ (mem_attach _ _)).mpr hn)
+
+lemma cycle_type_form_perm (hl : nodup l) (hn : 2 ≤ l.length) :
+  cycle_type l.attach.form_perm = {l.length} :=
+begin
+  rw ←length_attach at hn,
+  rw ←nodup_attach at hl,
+  rw cycle_type_eq [l.attach.form_perm],
+  { simp only [map, function.comp_app],
+    rw [support_form_perm_of_nodup _ hl, card_to_finset, dedup_eq_self.mpr hl],
+    { simp },
+    { intros x h,
+      simpa [h, nat.succ_le_succ_iff] using hn } },
+  { simp },
+  { simpa using is_cycle_form_perm hl hn },
+  { simp }
+end
+
+lemma form_perm_apply_mem_eq_next (hl : nodup l) (x : α) (hx : x ∈ l) :
+  form_perm l x = next l x hx :=
+begin
+  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
+  rw [next_nth_le _ hl, form_perm_apply_nth_le _ hl]
+end
+
+end list
+
+namespace cycle
+
+variables [decidable_eq α] (s s' : cycle α)
+
+/--
+A cycle `s : cycle α` , given `nodup s` can be interpreted as a `equiv.perm α`
+where each element in the list is permuted to the next one, defined as `form_perm`.
+-/
+def form_perm : Π (s : cycle α) (h : nodup s), equiv.perm α :=
+λ s, quot.hrec_on s (λ l h, form_perm l)
+  (λ l₁ l₂ (h : l₁ ~r l₂),
+    begin
+      ext,
+      { exact h.nodup_iff },
+      { intros h₁ h₂ _,
+        exact heq_of_eq (form_perm_eq_of_is_rotated h₁ h) }
+    end)
+
+@[simp] lemma form_perm_coe (l : list α) (hl : l.nodup) :
+  form_perm (l : cycle α) hl = l.form_perm := rfl
+
+lemma form_perm_subsingleton (s : cycle α) (h : subsingleton s) :
+  form_perm s h.nodup = 1 :=
+begin
+  induction s using quot.induction_on,
+  simp only [form_perm_coe, mk_eq_coe],
+  simp only [length_subsingleton_iff, length_coe, mk_eq_coe] at h,
+  cases s with hd tl,
+  { simp },
+  { simp only [length_eq_zero, add_le_iff_nonpos_left, list.length, nonpos_iff_eq_zero] at h,
+    simp [h] }
+end
+
+lemma is_cycle_form_perm (s : cycle α) (h : nodup s) (hn : nontrivial s) :
+  is_cycle (form_perm s h) :=
+begin
+  induction s using quot.induction_on,
+  exact list.is_cycle_form_perm h (length_nontrivial hn)
+end
+
+lemma support_form_perm [fintype α] (s : cycle α) (h : nodup s) (hn : nontrivial s) :
+  support (form_perm s h) = s.to_finset :=
+begin
+  induction s using quot.induction_on,
+  refine support_form_perm_of_nodup s h _,
+  rintro _ rfl,
+  simpa [nat.succ_le_succ_iff] using length_nontrivial hn
+end
+
+lemma form_perm_eq_self_of_not_mem (s : cycle α) (h : nodup s) (x : α) (hx : x ∉ s) :
+  form_perm s h x = x :=
+begin
+  induction s using quot.induction_on,
+  simpa using list.form_perm_eq_self_of_not_mem _ _ hx
+end
+
+lemma form_perm_apply_mem_eq_next (s : cycle α) (h : nodup s) (x : α) (hx : x ∈ s) :
+  form_perm s h x = next s h x hx :=
+begin
+  induction s using quot.induction_on,
+  simpa using list.form_perm_apply_mem_eq_next h _ _
+end
+
+lemma form_perm_reverse (s : cycle α) (h : nodup s) :
+  form_perm s.reverse (nodup_reverse_iff.mpr h) = (form_perm s h)⁻¹ :=
+begin
+  induction s using quot.induction_on,
+  simpa using form_perm_reverse _ h
+end
+
+lemma form_perm_eq_form_perm_iff {α : Type*} [decidable_eq α]
+  {s s' : cycle α} {hs : s.nodup} {hs' : s'.nodup} :
+  s.form_perm hs = s'.form_perm hs' ↔ s = s' ∨ s.subsingleton ∧ s'.subsingleton :=
+begin
+  rw [cycle.length_subsingleton_iff, cycle.length_subsingleton_iff],
+  revert s s',
+  intros s s',
+  apply quotient.induction_on₂' s s',
+  intros l l',
+  simpa using form_perm_eq_form_perm_iff
+end
+
+end cycle
+
+namespace equiv.perm
+section fintype
+variables [fintype α] [decidable_eq α] (p : equiv.perm α) (x : α)
+
+/--
+`equiv.perm.to_list (f : perm α) (x : α)` generates the list `[x, f x, f (f x), ...]`
+until looping. That means when `f x = x`, `to_list f x = []`.
+-/
+def to_list : list α :=
+(list.range (cycle_of p x).support.card).map (λ k, (p ^ k) x)
+
+@[simp] lemma to_list_one : to_list (1 : perm α) x = [] :=
+by simp [to_list, cycle_of_one]
+
+@[simp] lemma to_list_eq_nil_iff {p : perm α} {x} : to_list p x = [] ↔ x ∉ p.support :=
+by simp [to_list]
+
+@[simp] lemma length_to_list : length (to_list p x) = (cycle_of p x).support.card :=
+by simp [to_list]
+
+lemma to_list_ne_singleton (y : α) : to_list p x ≠ [y] :=
+begin
+  intro H,
+  simpa [card_support_ne_one] using congr_arg length H
+end
+
+lemma two_le_length_to_list_iff_mem_support {p : perm α} {x : α} :
+  2 ≤ length (to_list p x) ↔ x ∈ p.support :=
+by simp
+
+lemma length_to_list_pos_of_mem_support (h : x ∈ p.support) : 0 < length (to_list p x) :=
+zero_lt_two.trans_le (two_le_length_to_list_iff_mem_support.mpr h)
+
+lemma nth_le_to_list (n : ℕ) (hn : n < length (to_list p x)) :
+  nth_le (to_list p x) n hn = (p ^ n) x :=
+by simp [to_list]
+
+lemma to_list_nth_le_zero (h : x ∈ p.support) :
+  (to_list p x).nth_le 0 (length_to_list_pos_of_mem_support _ _ h) = x :=
+by simp [to_list]
+
+variables {p} {x}
+
+lemma mem_to_list_iff {y : α} :
+  y ∈ to_list p x ↔ same_cycle p x y ∧ x ∈ p.support :=
+begin
+  simp only [to_list, mem_range, mem_map],
+  split,
+  { rintro ⟨n, hx, rfl⟩,
+    refine ⟨⟨n, rfl⟩, _⟩,
+    contrapose! hx,
+    rw ←support_cycle_of_eq_nil_iff at hx,
+    simp [hx] },
+  { rintro ⟨h, hx⟩,
+    simpa using h.exists_pow_eq_of_mem_support hx }
+end
+
+lemma nodup_to_list (p : perm α) (x : α) :
+  nodup (to_list p x) :=
+begin
+  by_cases hx : p x = x,
+  { rw [←not_mem_support, ←to_list_eq_nil_iff] at hx,
+    simp [hx] },
+  have hc : is_cycle (cycle_of p x) := is_cycle_cycle_of p hx,
+  rw nodup_iff_nth_le_inj,
+  rintros n m hn hm,
+  rw [length_to_list, ←hc.order_of] at hm hn,
+  rw [←cycle_of_apply_self, ←ne.def, ←mem_support] at hx,
+  rw [nth_le_to_list, nth_le_to_list,
+      ←cycle_of_pow_apply_self p x n, ←cycle_of_pow_apply_self p x m],
+  cases n; cases m,
+  { simp },
+  { rw [←hc.support_pow_of_pos_of_lt_order_of m.zero_lt_succ hm,
+        mem_support, cycle_of_pow_apply_self] at hx,
+    simp [hx.symm] },
+  { rw [←hc.support_pow_of_pos_of_lt_order_of n.zero_lt_succ hn,
+        mem_support, cycle_of_pow_apply_self] at hx,
+    simp [hx] },
+  intro h,
+  have hn' : ¬ order_of (p.cycle_of x) ∣ n.succ := nat.not_dvd_of_pos_of_lt n.zero_lt_succ hn,
+  have hm' : ¬ order_of (p.cycle_of x) ∣ m.succ := nat.not_dvd_of_pos_of_lt m.zero_lt_succ hm,
+  rw ←hc.support_pow_eq_iff at hn' hm',
+  rw [←nat.mod_eq_of_lt hn, ←nat.mod_eq_of_lt hm, ←pow_inj_mod],
+  refine support_congr _ _,
+  { rw [hm', hn'],
+    exact finset.subset.refl _ },
+  { rw hm',
+    intros y hy,
+    obtain ⟨k, rfl⟩ := hc.exists_pow_eq (mem_support.mp hx) (mem_support.mp hy),
+    rw [←mul_apply, (commute.pow_pow_self _ _ _).eq, mul_apply, h, ←mul_apply, ←mul_apply,
+        (commute.pow_pow_self _ _ _).eq] }
+end
+
+lemma next_to_list_eq_apply (p : perm α) (x y : α) (hy : y ∈ to_list p x) :
+  next (to_list p x) y hy = p y :=
+begin
+  rw mem_to_list_iff at hy,
+  obtain ⟨k, hk, hk'⟩ := hy.left.exists_pow_eq_of_mem_support hy.right,
+  rw ←nth_le_to_list p x k (by simpa using hk) at hk',
+  simp_rw ←hk',
+  rw [next_nth_le _ (nodup_to_list _ _), nth_le_to_list, nth_le_to_list, ←mul_apply, ←pow_succ,
+      length_to_list, pow_apply_eq_pow_mod_order_of_cycle_of_apply p (k + 1), is_cycle.order_of],
+  exact is_cycle_cycle_of _ (mem_support.mp hy.right)
+end
+
+lemma to_list_pow_apply_eq_rotate (p : perm α) (x : α) (k : ℕ) :
+  p.to_list ((p ^ k) x) = (p.to_list x).rotate k :=
+begin
+  apply ext_le,
+  { simp only [length_to_list, cycle_of_self_apply_pow, length_rotate]},
+  { intros n hn hn',
+    rw [nth_le_to_list, nth_le_rotate, nth_le_to_list, length_to_list,
+        pow_mod_card_support_cycle_of_self_apply, pow_add, mul_apply] }
+end
+
+lemma same_cycle.to_list_is_rotated {f : perm α} {x y : α} (h : same_cycle f x y) :
+  to_list f x ~r to_list f y :=
+begin
+  by_cases hx : x ∈ f.support,
+  { obtain ⟨_ | k, hk, hy⟩ := h.exists_pow_eq_of_mem_support hx,
+    { simp only [coe_one, id.def, pow_zero] at hy,
+      simp [hy] },
+    use k.succ,
+    rw [←to_list_pow_apply_eq_rotate, hy] },
+  { rw [to_list_eq_nil_iff.mpr hx, is_rotated_nil_iff', eq_comm, to_list_eq_nil_iff],
+    rwa ←h.mem_support_iff }
+end
+
+lemma pow_apply_mem_to_list_iff_mem_support {n : ℕ} :
+  (p ^ n) x ∈ p.to_list x ↔ x ∈ p.support :=
+begin
+  rw [mem_to_list_iff, and_iff_right_iff_imp],
+  refine λ _, same_cycle.symm _,
+  rw same_cycle_pow_left
+end
+
+lemma to_list_form_perm_nil (x : α) :
+  to_list (form_perm ([] : list α)) x = [] :=
+by simp
+
+lemma to_list_form_perm_singleton (x y : α) :
+  to_list (form_perm [x]) y = [] :=
+by simp
+
+lemma to_list_form_perm_nontrivial (l : list α) (hl : 2 ≤ l.length) (hn : nodup l) :
+  to_list (form_perm l) (l.nth_le 0 (zero_lt_two.trans_le hl)) = l :=
+begin
+  have hc : l.form_perm.is_cycle := list.is_cycle_form_perm hn hl,
+  have hs : l.form_perm.support = l.to_finset,
+  { refine support_form_perm_of_nodup _ hn _,
+    rintro _ rfl,
+    simpa [nat.succ_le_succ_iff] using hl },
+  rw [to_list, hc.cycle_of_eq (mem_support.mp _), hs, card_to_finset, dedup_eq_self.mpr hn],
+  { refine list.ext_le (by simp) (λ k hk hk', _),
+    simp [form_perm_pow_apply_nth_le _ hn, nat.mod_eq_of_lt hk'] },
+  { simpa [hs] using nth_le_mem _ _ _ }
+end
+
+lemma to_list_form_perm_is_rotated_self (l : list α) (hl : 2 ≤ l.length) (hn : nodup l)
+  (x : α) (hx : x ∈ l):
+  to_list (form_perm l) x ~r l :=
+begin
+  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem hx,
+  have hr : l ~r l.rotate k := ⟨k, rfl⟩,
+  rw form_perm_eq_of_is_rotated hn hr,
+  rw ←nth_le_rotate' l k k,
+  simp only [nat.mod_eq_of_lt hk, tsub_add_cancel_of_le hk.le, nat.mod_self],
+  rw [to_list_form_perm_nontrivial],
+  { simp },
+  { simpa using hl },
+  { simpa using hn }
+end
+
+lemma form_perm_to_list (f : perm α) (x : α) :
+  form_perm (to_list f x) = f.cycle_of x :=
+begin
+  by_cases hx : f x = x,
+  { rw [(cycle_of_eq_one_iff f).mpr hx, to_list_eq_nil_iff.mpr (not_mem_support.mpr hx),
+        form_perm_nil] },
+  ext y,
+  by_cases hy : same_cycle f x y,
+  { obtain ⟨k, hk, rfl⟩ := hy.exists_pow_eq_of_mem_support (mem_support.mpr hx),
+    rw [cycle_of_apply_apply_pow_self, list.form_perm_apply_mem_eq_next (nodup_to_list f x),
+        next_to_list_eq_apply, pow_succ, mul_apply],
+    rw mem_to_list_iff,
+    exact ⟨⟨k, rfl⟩, mem_support.mpr hx⟩ },
+  { rw [cycle_of_apply_of_not_same_cycle hy, form_perm_apply_of_not_mem],
+    simp [mem_to_list_iff, hy] }
+end
+
+/--
+Given a cyclic `f : perm α`, generate the `cycle α` in the order
+of application of `f`. Implemented by finding an element `x : α`
+in the support of `f` in `finset.univ`, and iterating on using
+`equiv.perm.to_list f x`.
+-/
+def to_cycle (f : perm α) (hf : is_cycle f) : cycle α :=
+multiset.rec_on (finset.univ : finset α).val
+  (quot.mk _ [])
+  (λ x s l, if f x = x then l else to_list f x)
+  (by { intros x y m s,
+    refine heq_of_eq _,
+    split_ifs with hx hy hy; try { refl },
+    { have hc : same_cycle f x y := is_cycle.same_cycle hf hx hy,
+      exact quotient.sound' hc.to_list_is_rotated }})
+
+lemma to_cycle_eq_to_list (f : perm α) (hf : is_cycle f) (x : α) (hx : f x ≠ x) :
+  to_cycle f hf = to_list f x :=
+begin
+  have key : (finset.univ : finset α).val = x ::ₘ finset.univ.val.erase x,
+  { simp },
+  rw [to_cycle, key],
+  simp [hx]
+end
+
+lemma nodup_to_cycle (f : perm α) (hf : is_cycle f) : (to_cycle f hf).nodup :=
+begin
+  obtain ⟨x, hx, -⟩ := id hf,
+  simpa [to_cycle_eq_to_list f hf x hx] using nodup_to_list _ _
+end
+
+lemma nontrivial_to_cycle (f : perm α) (hf : is_cycle f) : (to_cycle f hf).nontrivial :=
+begin
+  obtain ⟨x, hx, -⟩ := id hf,
+  simp [to_cycle_eq_to_list f hf x hx, hx, cycle.nontrivial_coe_nodup_iff (nodup_to_list _ _)]
+end
+
+/--
+Any cyclic `f : perm α` is isomorphic to the nontrivial `cycle α`
+that corresponds to repeated application of `f`.
+The forward direction is implemented by `equiv.perm.to_cycle`.
+-/
+def iso_cycle : {f : perm α // is_cycle f} ≃ {s : cycle α // s.nodup ∧ s.nontrivial} :=
+{ to_fun := λ f, ⟨to_cycle (f : perm α) f.prop, nodup_to_cycle f f.prop,
+    nontrivial_to_cycle _ f.prop⟩,
+  inv_fun := λ s, ⟨(s : cycle α).form_perm s.prop.left,
+    (s : cycle α).is_cycle_form_perm _ s.prop.right⟩,
+  left_inv := λ f, by
+  { obtain ⟨x, hx, -⟩ := id f.prop,
+    simpa [to_cycle_eq_to_list (f : perm α) f.prop x hx, form_perm_to_list, subtype.ext_iff]
+      using f.prop.cycle_of_eq hx },
+  right_inv := λ s, by
+  { rcases s with ⟨⟨s⟩, hn, ht⟩,
+    obtain ⟨x, -, -, hx, -⟩ := id ht,
+    have hl : 2 ≤ s.length := by simpa using cycle.length_nontrivial ht,
+    simp only [cycle.mk_eq_coe, cycle.nodup_coe_iff, cycle.mem_coe_iff, subtype.coe_mk,
+               cycle.form_perm_coe] at hn hx ⊢,
+    rw to_cycle_eq_to_list _ _ x,
+    { refine quotient.sound' _,
+      exact to_list_form_perm_is_rotated_self _ hl hn _ hx },
+    { rw [←mem_support, support_form_perm_of_nodup _ hn],
+      { simpa using hx },
+      { rintro _ rfl,
+        simpa [nat.succ_le_succ_iff] using hl } } } }
+
+end fintype
+
+section finite
+variables [finite α] [decidable_eq α]
+
+lemma is_cycle.exists_unique_cycle {f : perm α} (hf : is_cycle f) :
+  ∃! (s : cycle α), ∃ (h : s.nodup), s.form_perm h = f :=
+begin
+  casesI nonempty_fintype α,
+  obtain ⟨x, hx, hy⟩ := id hf,
+  refine ⟨f.to_list x, ⟨nodup_to_list f x, _⟩, _⟩,
+  { simp [form_perm_to_list, hf.cycle_of_eq hx] },
+  { rintro ⟨l⟩ ⟨hn, rfl⟩,
+    simp only [cycle.mk_eq_coe, cycle.coe_eq_coe, subtype.coe_mk, cycle.form_perm_coe],
+    refine (to_list_form_perm_is_rotated_self _ _ hn _ _).symm,
+    { contrapose! hx,
+      suffices : form_perm l = 1,
+      { simp [this] },
+      rw form_perm_eq_one_iff _ hn,
+      exact nat.le_of_lt_succ hx },
+    { rw ←mem_to_finset,
+      refine support_form_perm_le l _,
+      simpa using hx } }
+end
+
+lemma is_cycle.exists_unique_cycle_subtype {f : perm α} (hf : is_cycle f) :
+  ∃! (s : {s : cycle α // s.nodup}), (s : cycle α).form_perm s.prop = f :=
+begin
+  obtain ⟨s, ⟨hs, rfl⟩, hs'⟩ := hf.exists_unique_cycle,
+  refine ⟨⟨s, hs⟩, rfl, _⟩,
+  rintro ⟨t, ht⟩ ht',
+  simpa using hs' _ ⟨ht, ht'⟩
+end
+
+lemma is_cycle.exists_unique_cycle_nontrivial_subtype {f : perm α} (hf : is_cycle f) :
+  ∃! (s : {s : cycle α // s.nodup ∧ s.nontrivial}), (s : cycle α).form_perm s.prop.left = f :=
+begin
+  obtain ⟨⟨s, hn⟩, hs, hs'⟩ := hf.exists_unique_cycle_subtype,
+  refine ⟨⟨s, hn, _⟩, _, _⟩,
+  { rw hn.nontrivial_iff,
+    subst f,
+    intro H,
+    refine hf.ne_one _,
+    simpa using cycle.form_perm_subsingleton _ H },
+  { simpa using hs },
+  { rintro ⟨t, ht, ht'⟩ ht'',
+    simpa using hs' ⟨t, ht⟩ ht'' }
+end
+
+end finite
+
+variables [fintype α] [decidable_eq α]
+
+/--
+Any cyclic `f : perm α` is isomorphic to the nontrivial `cycle α`
+that corresponds to repeated application of `f`.
+The forward direction is implemented by finding this `cycle α` using `fintype.choose`.
+-/
+def iso_cycle' : {f : perm α // is_cycle f} ≃ {s : cycle α // s.nodup ∧ s.nontrivial} :=
+{ to_fun := λ f, fintype.choose _ f.prop.exists_unique_cycle_nontrivial_subtype,
+  inv_fun := λ s, ⟨(s : cycle α).form_perm s.prop.left,
+    (s : cycle α).is_cycle_form_perm _ s.prop.right⟩,
+  left_inv := λ f, by simpa [subtype.ext_iff]
+    using fintype.choose_spec _ f.prop.exists_unique_cycle_nontrivial_subtype,
+  right_inv := λ ⟨s, hs, ht⟩, by
+  { simp [subtype.coe_mk],
+    convert fintype.choose_subtype_eq (λ (s' : cycle α), s'.nodup ∧ s'.nontrivial) _,
+    ext ⟨s', hs', ht'⟩,
+    simp [cycle.form_perm_eq_form_perm_iff, (iff_not_comm.mp hs.nontrivial_iff),
+          (iff_not_comm.mp hs'.nontrivial_iff), ht] } }
+
+notation `c[` l:(foldr `, ` (h t, list.cons h t) list.nil `]`) :=
+  cycle.form_perm ↑l (cycle.nodup_coe_iff.mpr dec_trivial)
+
+meta instance repr_perm [has_repr α] : has_repr (perm α) :=
+⟨λ f, repr (multiset.pmap (λ (g : perm α) (hg : g.is_cycle),
+  iso_cycle ⟨g, hg⟩) -- to_cycle is faster?
+  (perm.cycle_factors_finset f).val
+  (λ g hg, (mem_cycle_factors_finset_iff.mp (finset.mem_def.mpr hg)).left))⟩
+
+end equiv.perm
diff --git a/src/group_theory/perm/cycle/type.lean b/src/group_theory/perm/cycle/type.lean
new file mode 100644
index 0000000000000..5dfacba2f3c54
--- /dev/null
+++ b/src/group_theory/perm/cycle/type.lean
@@ -0,0 +1,680 @@
+/-
+Copyright (c) 2020 Thomas Browning. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Thomas Browning
+-/
+
+import algebra.gcd_monoid.multiset
+import combinatorics.partition
+import data.list.rotate
+import group_theory.perm.cycle.basic
+import ring_theory.int.basic
+import tactic.linarith
+
+/-!
+# Cycle Types
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define the cycle type of a permutation.
+
+## Main definitions
+
+- `σ.cycle_type` where `σ` is a permutation of a `fintype`
+- `σ.partition` where `σ` is a permutation of a `fintype`
+
+## Main results
+
+- `sum_cycle_type` : The sum of `σ.cycle_type` equals `σ.support.card`
+- `lcm_cycle_type` : The lcm of `σ.cycle_type` equals `order_of σ`
+- `is_conj_iff_cycle_type_eq` : Two permutations are conjugate if and only if they have the same
+  cycle type.
+- `exists_prime_order_of_dvd_card`: For every prime `p` dividing the order of a finite group `G`
+  there exists an element of order `p` in `G`. This is known as Cauchy's theorem.
+-/
+
+namespace equiv.perm
+open equiv list multiset
+
+variables {α : Type*} [fintype α]
+
+section cycle_type
+
+variables [decidable_eq α]
+
+/-- The cycle type of a permutation -/
+def cycle_type (σ : perm α) : multiset ℕ :=
+σ.cycle_factors_finset.1.map (finset.card ∘ support)
+
+lemma cycle_type_def (σ : perm α) :
+  σ.cycle_type = σ.cycle_factors_finset.1.map (finset.card ∘ support) := rfl
+
+lemma cycle_type_eq' {σ : perm α} (s : finset (perm α))
+  (h1 : ∀ f : perm α, f ∈ s → f.is_cycle) (h2 : (s : set (perm α)).pairwise disjoint)
+  (h0 : s.noncomm_prod id (h2.imp $ λ _ _, disjoint.commute) = σ) :
+  σ.cycle_type = s.1.map (finset.card ∘ support) :=
+begin
+  rw cycle_type_def,
+  congr,
+  rw cycle_factors_finset_eq_finset,
+  exact ⟨h1, h2, h0⟩
+end
+
+lemma cycle_type_eq {σ : perm α} (l : list (perm α)) (h0 : l.prod = σ)
+  (h1 : ∀ σ : perm α, σ ∈ l → σ.is_cycle) (h2 : l.pairwise disjoint) :
+  σ.cycle_type = l.map (finset.card ∘ support) :=
+begin
+  have hl : l.nodup := nodup_of_pairwise_disjoint_cycles h1 h2,
+  rw cycle_type_eq' l.to_finset,
+  { simp [list.dedup_eq_self.mpr hl] },
+  { simpa using h1 },
+  { simpa [hl] using h0 },
+  { simpa [list.dedup_eq_self.mpr hl] using h2.forall disjoint.symmetric }
+end
+
+lemma cycle_type_one : (1 : perm α).cycle_type = 0 :=
+cycle_type_eq [] rfl (λ _, false.elim) pairwise.nil
+
+lemma cycle_type_eq_zero {σ : perm α} : σ.cycle_type = 0 ↔ σ = 1 :=
+by simp [cycle_type_def, cycle_factors_finset_eq_empty_iff]
+
+lemma card_cycle_type_eq_zero {σ : perm α} : σ.cycle_type.card = 0 ↔ σ = 1 :=
+by rw [card_eq_zero, cycle_type_eq_zero]
+
+lemma two_le_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : 2 ≤ n :=
+begin
+  simp only [cycle_type_def, ←finset.mem_def, function.comp_app, multiset.mem_map,
+    mem_cycle_factors_finset_iff] at h,
+  obtain ⟨_, ⟨hc, -⟩, rfl⟩ := h,
+  exact hc.two_le_card_support
+end
+
+lemma one_lt_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : 1 < n :=
+two_le_of_mem_cycle_type h
+
+lemma is_cycle.cycle_type {σ : perm α} (hσ : is_cycle σ) : σ.cycle_type = [σ.support.card] :=
+cycle_type_eq [σ] (mul_one σ) (λ τ hτ, (congr_arg is_cycle (list.mem_singleton.mp hτ)).mpr hσ)
+  (pairwise_singleton disjoint σ)
+
+lemma card_cycle_type_eq_one {σ : perm α} : σ.cycle_type.card = 1 ↔ σ.is_cycle :=
+begin
+  rw card_eq_one,
+  simp_rw [cycle_type_def, multiset.map_eq_singleton, ←finset.singleton_val,
+           finset.val_inj, cycle_factors_finset_eq_singleton_iff],
+  split,
+  { rintro ⟨_, _, ⟨h, -⟩, -⟩,
+    exact h },
+  { intro h,
+    use [σ.support.card, σ],
+    simp [h] }
+end
+
+lemma disjoint.cycle_type {σ τ : perm α} (h : disjoint σ τ) :
+  (σ * τ).cycle_type = σ.cycle_type + τ.cycle_type :=
+begin
+  rw [cycle_type_def, cycle_type_def, cycle_type_def, h.cycle_factors_finset_mul_eq_union,
+      ←multiset.map_add, finset.union_val, multiset.add_eq_union_iff_disjoint.mpr _],
+  exact finset.disjoint_val.2 h.disjoint_cycle_factors_finset
+end
+
+lemma cycle_type_inv (σ : perm α) : σ⁻¹.cycle_type = σ.cycle_type :=
+cycle_induction_on (λ τ : perm α, τ⁻¹.cycle_type = τ.cycle_type) σ rfl
+  (λ σ hσ, by rw [hσ.cycle_type, hσ.inv.cycle_type, support_inv])
+  (λ σ τ hστ hc hσ hτ, by rw [mul_inv_rev, hστ.cycle_type, ←hσ, ←hτ, add_comm,
+    disjoint.cycle_type (λ x, or.imp (λ h : τ x = x, inv_eq_iff_eq.mpr h.symm)
+    (λ h : σ x = x, inv_eq_iff_eq.mpr h.symm) (hστ x).symm)])
+
+lemma cycle_type_conj {σ τ : perm α} : (τ * σ * τ⁻¹).cycle_type = σ.cycle_type :=
+begin
+  revert τ,
+  apply cycle_induction_on _ σ,
+  { intro,
+    simp },
+  { intros σ hσ τ,
+    rw [hσ.cycle_type, hσ.conj.cycle_type, card_support_conj] },
+  { intros σ τ hd hc hσ hτ π,
+    rw [← conj_mul, hd.cycle_type, disjoint.cycle_type, hσ, hτ],
+    intro a,
+    apply (hd (π⁻¹ a)).imp _ _;
+    { intro h, rw [perm.mul_apply, perm.mul_apply, h, apply_inv_self] } }
+end
+
+lemma sum_cycle_type (σ : perm α) : σ.cycle_type.sum = σ.support.card :=
+cycle_induction_on (λ τ : perm α, τ.cycle_type.sum = τ.support.card) σ
+  (by rw [cycle_type_one, sum_zero, support_one, finset.card_empty])
+  (λ σ hσ, by rw [hσ.cycle_type, coe_sum, list.sum_singleton])
+  (λ σ τ hστ hc hσ hτ, by rw [hστ.cycle_type, sum_add, hσ, hτ, hστ.card_support_mul])
+
+lemma sign_of_cycle_type' (σ : perm α) :
+  sign σ = (σ.cycle_type.map (λ n, -(-1 : ℤˣ) ^ n)).prod :=
+cycle_induction_on (λ τ : perm α, sign τ = (τ.cycle_type.map (λ n, -(-1 : ℤˣ) ^ n)).prod) σ
+  (by rw [sign_one, cycle_type_one, multiset.map_zero, prod_zero])
+  (λ σ hσ, by rw [hσ.sign, hσ.cycle_type, coe_map, coe_prod,
+    list.map_singleton, list.prod_singleton])
+  (λ σ τ hστ hc hσ hτ, by rw [sign_mul, hσ, hτ, hστ.cycle_type, multiset.map_add, prod_add])
+
+lemma sign_of_cycle_type (f : perm α) :
+  sign f = (-1 : ℤˣ)^(f.cycle_type.sum + f.cycle_type.card) :=
+cycle_induction_on
+  (λ f : perm α, sign f = (-1 : ℤˣ)^(f.cycle_type.sum + f.cycle_type.card))
+  f
+  ( -- base_one
+    by rw [equiv.perm.cycle_type_one, sign_one, multiset.sum_zero, multiset.card_zero, pow_zero] )
+  ( -- base_cycles
+    λ f hf,
+      by rw [equiv.perm.is_cycle.cycle_type hf, hf.sign,
+      coe_sum, list.sum_cons, sum_nil, add_zero, coe_card, length_singleton,
+      pow_add, pow_one, mul_comm, neg_mul, one_mul] )
+  ( -- induction_disjoint
+    λ f g hfg hf Pf Pg,
+    by rw [equiv.perm.disjoint.cycle_type hfg,
+      multiset.sum_add, multiset.card_add,← add_assoc,
+      add_comm f.cycle_type.sum g.cycle_type.sum,
+      add_assoc g.cycle_type.sum _ _,
+      add_comm g.cycle_type.sum _,
+      add_assoc, pow_add,
+      ← Pf, ← Pg,
+      equiv.perm.sign_mul])
+
+lemma lcm_cycle_type (σ : perm α) : σ.cycle_type.lcm = order_of σ :=
+cycle_induction_on (λ τ : perm α, τ.cycle_type.lcm = order_of τ) σ
+  (by rw [cycle_type_one, lcm_zero, order_of_one])
+  (λ σ hσ, by rw [hσ.cycle_type, coe_singleton, lcm_singleton, hσ.order_of,
+    normalize_eq])
+  (λ σ τ hστ hc hσ hτ, by rw [hστ.cycle_type, lcm_add, lcm_eq_nat_lcm, hστ.order_of, hσ, hτ])
+
+lemma dvd_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : n ∣ order_of σ :=
+begin
+  rw ← lcm_cycle_type,
+  exact dvd_lcm h,
+end
+
+lemma order_of_cycle_of_dvd_order_of (f : perm α) (x : α) :
+  order_of (cycle_of f x) ∣ order_of f :=
+begin
+  by_cases hx : f x = x,
+  { rw ←cycle_of_eq_one_iff at hx,
+    simp [hx] },
+  { refine dvd_of_mem_cycle_type _,
+    rw [cycle_type, multiset.mem_map],
+    refine ⟨f.cycle_of x, _, _⟩,
+    { rwa [←finset.mem_def, cycle_of_mem_cycle_factors_finset_iff, mem_support] },
+    { simp [(is_cycle_cycle_of _ hx).order_of] } }
+end
+
+lemma two_dvd_card_support {σ : perm α} (hσ : σ ^ 2 = 1) : 2 ∣ σ.support.card :=
+(congr_arg (has_dvd.dvd 2) σ.sum_cycle_type).mp
+  (multiset.dvd_sum (λ n hn, by rw le_antisymm (nat.le_of_dvd zero_lt_two $
+  (dvd_of_mem_cycle_type hn).trans $ order_of_dvd_of_pow_eq_one hσ) (two_le_of_mem_cycle_type hn)))
+
+lemma cycle_type_prime_order {σ : perm α} (hσ : (order_of σ).prime) :
+  ∃ n : ℕ, σ.cycle_type = replicate (n + 1) (order_of σ) :=
+begin
+  rw eq_replicate_of_mem (λ n hn, or_iff_not_imp_left.mp
+    (hσ.eq_one_or_self_of_dvd n (dvd_of_mem_cycle_type hn)) (one_lt_of_mem_cycle_type hn).ne'),
+  use σ.cycle_type.card - 1,
+  rw tsub_add_cancel_of_le,
+  rw [nat.succ_le_iff, pos_iff_ne_zero, ne, card_cycle_type_eq_zero],
+  intro H,
+  rw [H, order_of_one] at hσ,
+  exact hσ.ne_one rfl,
+end
+
+lemma is_cycle_of_prime_order {σ : perm α} (h1 : (order_of σ).prime)
+  (h2 : σ.support.card < 2 * (order_of σ)) : σ.is_cycle :=
+begin
+  obtain ⟨n, hn⟩ := cycle_type_prime_order h1,
+  rw [←σ.sum_cycle_type, hn, multiset.sum_replicate, nsmul_eq_mul, nat.cast_id, mul_lt_mul_right
+      (order_of_pos σ), nat.succ_lt_succ_iff, nat.lt_succ_iff, le_zero_iff] at h2,
+  rw [←card_cycle_type_eq_one, hn, card_replicate, h2],
+end
+
+lemma cycle_type_le_of_mem_cycle_factors_finset {f g : perm α}
+  (hf : f ∈ g.cycle_factors_finset) :
+  f.cycle_type ≤ g.cycle_type :=
+begin
+  rw mem_cycle_factors_finset_iff at hf,
+  rw [cycle_type_def, cycle_type_def, hf.left.cycle_factors_finset_eq_singleton],
+  refine map_le_map _,
+  simpa [←finset.mem_def, mem_cycle_factors_finset_iff] using hf
+end
+
+lemma cycle_type_mul_mem_cycle_factors_finset_eq_sub {f g : perm α}
+  (hf : f ∈ g.cycle_factors_finset) :
+  (g * f⁻¹).cycle_type = g.cycle_type - f.cycle_type :=
+begin
+  suffices : (g * f⁻¹).cycle_type + f.cycle_type = g.cycle_type - f.cycle_type + f.cycle_type,
+  { rw tsub_add_cancel_of_le (cycle_type_le_of_mem_cycle_factors_finset hf) at this,
+    simp [←this] },
+  simp [←(disjoint_mul_inv_of_mem_cycle_factors_finset hf).cycle_type,
+    tsub_add_cancel_of_le (cycle_type_le_of_mem_cycle_factors_finset hf)]
+end
+
+theorem is_conj_of_cycle_type_eq {σ τ : perm α} (h : cycle_type σ = cycle_type τ) : is_conj σ τ :=
+begin
+  revert τ,
+  apply cycle_induction_on _ σ,
+  { intros τ h,
+    rw [cycle_type_one, eq_comm, cycle_type_eq_zero] at h,
+    rw h },
+  { intros σ hσ τ hστ,
+    have hτ := card_cycle_type_eq_one.2 hσ,
+    rw [hστ, card_cycle_type_eq_one] at hτ,
+    apply hσ.is_conj hτ,
+    rw [hσ.cycle_type, hτ.cycle_type, coe_eq_coe, singleton_perm] at hστ,
+    simp only [and_true, eq_self_iff_true] at hστ,
+    exact hστ },
+  { intros σ τ hστ hσ h1 h2 π hπ,
+    rw [hστ.cycle_type] at hπ,
+    { have h : σ.support.card ∈ map (finset.card ∘ perm.support) π.cycle_factors_finset.val,
+      { simp [←cycle_type_def, ←hπ, hσ.cycle_type] },
+      obtain ⟨σ', hσ'l, hσ'⟩ := multiset.mem_map.mp h,
+      have key : is_conj (σ' * (π * σ'⁻¹)) π,
+      { rw is_conj_iff,
+        use σ'⁻¹,
+        simp [mul_assoc] },
+      refine is_conj.trans _ key,
+      have hs : σ.cycle_type = σ'.cycle_type,
+      { rw [←finset.mem_def, mem_cycle_factors_finset_iff] at hσ'l,
+        rw [hσ.cycle_type, ←hσ', hσ'l.left.cycle_type] },
+      refine hστ.is_conj_mul (h1 hs) (h2 _) _,
+      { rw [cycle_type_mul_mem_cycle_factors_finset_eq_sub, ←hπ, add_comm, hs,
+            add_tsub_cancel_right],
+        rwa finset.mem_def },
+      { exact (disjoint_mul_inv_of_mem_cycle_factors_finset hσ'l).symm } } }
+end
+
+theorem is_conj_iff_cycle_type_eq {σ τ : perm α} :
+  is_conj σ τ ↔ σ.cycle_type = τ.cycle_type :=
+⟨λ h, begin
+  obtain ⟨π, rfl⟩ := is_conj_iff.1 h,
+  rw cycle_type_conj,
+end, is_conj_of_cycle_type_eq⟩
+
+@[simp] lemma cycle_type_extend_domain {β : Type*} [fintype β] [decidable_eq β]
+  {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p) {g : perm α} :
+  cycle_type (g.extend_domain f) = cycle_type g :=
+begin
+  apply cycle_induction_on _ g,
+  { rw [extend_domain_one, cycle_type_one, cycle_type_one] },
+  { intros σ hσ,
+    rw [(hσ.extend_domain f).cycle_type, hσ.cycle_type, card_support_extend_domain] },
+  { intros σ τ hd hc hσ hτ,
+    rw [hd.cycle_type, ← extend_domain_mul, (hd.extend_domain f).cycle_type, hσ, hτ] }
+end
+
+lemma cycle_type_of_subtype {p : α → Prop} [decidable_pred p] {g : perm (subtype p)}:
+  cycle_type (g.of_subtype) = cycle_type g := cycle_type_extend_domain (equiv.refl (subtype p))
+
+lemma mem_cycle_type_iff {n : ℕ} {σ : perm α} :
+  n ∈ cycle_type σ ↔ ∃ c τ : perm α, σ = c * τ ∧ disjoint c τ ∧ is_cycle c ∧ c.support.card = n :=
+begin
+  split,
+  { intro h,
+    obtain ⟨l, rfl, hlc, hld⟩ := trunc_cycle_factors σ,
+    rw cycle_type_eq _ rfl hlc hld at h,
+    obtain ⟨c, cl, rfl⟩ := list.exists_of_mem_map h,
+    rw (list.perm_cons_erase cl).pairwise_iff (λ _ _ hd, _) at hld,
+    swap, { exact hd.symm },
+    refine ⟨c, (l.erase c).prod, _, _, hlc _ cl, rfl⟩,
+    { rw [← list.prod_cons,
+        (list.perm_cons_erase cl).symm.prod_eq' (hld.imp (λ _ _, disjoint.commute))] },
+    { exact disjoint_prod_right _ (λ g, list.rel_of_pairwise_cons hld) } },
+  { rintros ⟨c, t, rfl, hd, hc, rfl⟩,
+    simp [hd.cycle_type, hc.cycle_type] }
+end
+
+lemma le_card_support_of_mem_cycle_type {n : ℕ} {σ : perm α} (h : n ∈ cycle_type σ) :
+  n ≤ σ.support.card :=
+(le_sum_of_mem h).trans (le_of_eq σ.sum_cycle_type)
+
+lemma cycle_type_of_card_le_mem_cycle_type_add_two {n : ℕ} {g : perm α}
+  (hn2 : fintype.card α < n + 2) (hng : n ∈ g.cycle_type) :
+  g.cycle_type = {n} :=
+begin
+  obtain ⟨c, g', rfl, hd, hc, rfl⟩ := mem_cycle_type_iff.1 hng,
+  by_cases g'1 : g' = 1,
+  { rw [hd.cycle_type, hc.cycle_type, coe_singleton, g'1, cycle_type_one, add_zero] },
+  contrapose! hn2,
+  apply le_trans _ (c * g').support.card_le_univ,
+  rw [hd.card_support_mul],
+  exact add_le_add_left (two_le_card_support_of_ne_one g'1) _,
+end
+
+end cycle_type
+
+lemma card_compl_support_modeq [decidable_eq α] {p n : ℕ} [hp : fact p.prime] {σ : perm α}
+  (hσ : σ ^ p ^ n = 1) : σ.supportᶜ.card ≡ fintype.card α [MOD p] :=
+begin
+  rw [nat.modeq_iff_dvd' σ.supportᶜ.card_le_univ, ←finset.card_compl, compl_compl],
+  refine (congr_arg _ σ.sum_cycle_type).mp (multiset.dvd_sum (λ k hk, _)),
+  obtain ⟨m, -, hm⟩ := (nat.dvd_prime_pow hp.out).mp (order_of_dvd_of_pow_eq_one hσ),
+  obtain ⟨l, -, rfl⟩ := (nat.dvd_prime_pow hp.out).mp
+    ((congr_arg _ hm).mp (dvd_of_mem_cycle_type hk)),
+  exact dvd_pow_self _ (λ h, (one_lt_of_mem_cycle_type hk).ne $ by rw [h, pow_zero]),
+end
+
+lemma exists_fixed_point_of_prime {p n : ℕ} [hp : fact p.prime] (hα : ¬ p ∣ fintype.card α)
+  {σ : perm α} (hσ : σ ^ p ^ n = 1) : ∃ a : α, σ a = a :=
+begin
+  classical,
+  contrapose! hα,
+  simp_rw ← mem_support at hα,
+  exact nat.modeq_zero_iff_dvd.mp ((congr_arg _ (finset.card_eq_zero.mpr (compl_eq_bot.mpr
+    (finset.eq_univ_iff_forall.mpr hα)))).mp (card_compl_support_modeq hσ).symm),
+end
+
+lemma exists_fixed_point_of_prime' {p n : ℕ} [hp : fact p.prime] (hα : p ∣ fintype.card α)
+  {σ : perm α} (hσ : σ ^ p ^ n = 1) {a : α} (ha : σ a = a) : ∃ b : α, σ b = b ∧ b ≠ a :=
+begin
+  classical,
+  have h : ∀ b : α, b ∈ σ.supportᶜ ↔ σ b = b :=
+  λ b, by rw [finset.mem_compl, mem_support, not_not],
+  obtain ⟨b, hb1, hb2⟩ := finset.exists_ne_of_one_lt_card (lt_of_lt_of_le hp.out.one_lt
+    (nat.le_of_dvd (finset.card_pos.mpr ⟨a, (h a).mpr ha⟩) (nat.modeq_zero_iff_dvd.mp
+    ((card_compl_support_modeq hσ).trans (nat.modeq_zero_iff_dvd.mpr hα))))) a,
+  exact ⟨b, (h b).mp hb1, hb2⟩,
+end
+
+lemma is_cycle_of_prime_order' {σ : perm α} (h1 : (order_of σ).prime)
+  (h2 : fintype.card α < 2 * (order_of σ)) : σ.is_cycle :=
+begin
+  classical,
+  exact is_cycle_of_prime_order h1 (lt_of_le_of_lt σ.support.card_le_univ h2),
+end
+
+lemma is_cycle_of_prime_order'' {σ : perm α} (h1 : (fintype.card α).prime)
+  (h2 : order_of σ = fintype.card α) : σ.is_cycle :=
+is_cycle_of_prime_order' ((congr_arg nat.prime h2).mpr h1)
+begin
+  classical,
+  rw [←one_mul (fintype.card α), ←h2, mul_lt_mul_right (order_of_pos σ)],
+  exact one_lt_two,
+end
+
+section cauchy
+
+variables (G : Type*) [group G] (n : ℕ)
+
+/-- The type of vectors with terms from `G`, length `n`, and product equal to `1:G`. -/
+def vectors_prod_eq_one : set (vector G n) :=
+{v | v.to_list.prod = 1}
+
+namespace vectors_prod_eq_one
+
+lemma mem_iff {n : ℕ} (v : vector G n) :
+v ∈ vectors_prod_eq_one G n ↔ v.to_list.prod = 1 := iff.rfl
+
+lemma zero_eq : vectors_prod_eq_one G 0 = {vector.nil} :=
+set.eq_singleton_iff_unique_mem.mpr ⟨eq.refl (1 : G), λ v hv, v.eq_nil⟩
+
+lemma one_eq : vectors_prod_eq_one G 1 = {vector.nil.cons 1} :=
+begin
+  simp_rw [set.eq_singleton_iff_unique_mem, mem_iff,
+    vector.to_list_singleton, list.prod_singleton, vector.head_cons],
+  exact ⟨rfl, λ v hv, v.cons_head_tail.symm.trans (congr_arg2 vector.cons hv v.tail.eq_nil)⟩,
+end
+
+instance zero_unique : unique (vectors_prod_eq_one G 0) :=
+by { rw zero_eq, exact set.unique_singleton vector.nil }
+
+instance one_unique : unique (vectors_prod_eq_one G 1) :=
+by { rw one_eq, exact set.unique_singleton (vector.nil.cons 1) }
+
+/-- Given a vector `v` of length `n`, make a vector of length `n + 1` whose product is `1`,
+by appending the inverse of the product of `v`. -/
+@[simps] def vector_equiv : vector G n ≃ vectors_prod_eq_one G (n + 1) :=
+{ to_fun := λ v, ⟨v.to_list.prod⁻¹ ::ᵥ v,
+    by rw [mem_iff, vector.to_list_cons, list.prod_cons, inv_mul_self]⟩,
+  inv_fun := λ v, v.1.tail,
+  left_inv := λ v, v.tail_cons v.to_list.prod⁻¹,
+  right_inv := λ v, subtype.ext ((congr_arg2 vector.cons (eq_inv_of_mul_eq_one_left (by
+  { rw [←list.prod_cons, ←vector.to_list_cons, v.1.cons_head_tail],
+    exact v.2 })).symm rfl).trans v.1.cons_head_tail) }
+
+/-- Given a vector `v` of length `n` whose product is 1, make a vector of length `n - 1`,
+by deleting the last entry of `v`. -/
+def equiv_vector : vectors_prod_eq_one G n ≃ vector G (n - 1) :=
+((vector_equiv G (n - 1)).trans (if hn : n = 0 then (show vectors_prod_eq_one G (n - 1 + 1) ≃
+  vectors_prod_eq_one G n, by { rw hn, apply equiv_of_unique })
+  else by rw tsub_add_cancel_of_le (nat.pos_of_ne_zero hn).nat_succ_le)).symm
+
+instance [fintype G] : fintype (vectors_prod_eq_one G n) :=
+fintype.of_equiv (vector G (n - 1)) (equiv_vector G n).symm
+
+lemma card [fintype G] :
+  fintype.card (vectors_prod_eq_one G n) = fintype.card G ^ (n - 1) :=
+(fintype.card_congr (equiv_vector G n)).trans (card_vector (n - 1))
+
+variables {G n} {g : G} (v : vectors_prod_eq_one G n) (j k : ℕ)
+
+/-- Rotate a vector whose product is 1. -/
+def rotate : vectors_prod_eq_one G n :=
+⟨⟨_, (v.1.1.length_rotate k).trans v.1.2⟩, list.prod_rotate_eq_one_of_prod_eq_one v.2 k⟩
+
+lemma rotate_zero : rotate v 0 = v :=
+subtype.ext (subtype.ext v.1.1.rotate_zero)
+
+lemma rotate_rotate : rotate (rotate v j) k = rotate v (j + k) :=
+subtype.ext (subtype.ext (v.1.1.rotate_rotate j k))
+
+lemma rotate_length : rotate v n = v :=
+subtype.ext (subtype.ext ((congr_arg _ v.1.2.symm).trans v.1.1.rotate_length))
+
+end vectors_prod_eq_one
+
+/-- For every prime `p` dividing the order of a finite group `G` there exists an element of order
+`p` in `G`. This is known as Cauchy's theorem. -/
+lemma _root_.exists_prime_order_of_dvd_card {G : Type*} [group G] [fintype G] (p : ℕ)
+  [hp : fact p.prime] (hdvd : p ∣ fintype.card G) : ∃ x : G, order_of x = p :=
+begin
+  have hp' : p - 1 ≠ 0 := mt tsub_eq_zero_iff_le.mp (not_le_of_lt hp.out.one_lt),
+  have Scard := calc p ∣ fintype.card G ^ (p - 1) : hdvd.trans (dvd_pow (dvd_refl _) hp')
+  ... = fintype.card (vectors_prod_eq_one G p) : (vectors_prod_eq_one.card G p).symm,
+  let f : ℕ → vectors_prod_eq_one G p → vectors_prod_eq_one G p :=
+  λ k v, vectors_prod_eq_one.rotate v k,
+  have hf1 : ∀ v, f 0 v = v := vectors_prod_eq_one.rotate_zero,
+  have hf2 : ∀ j k v, f k (f j v) = f (j + k) v :=
+  λ j k v, vectors_prod_eq_one.rotate_rotate v j k,
+  have hf3 : ∀ v, f p v = v := vectors_prod_eq_one.rotate_length,
+  let σ := equiv.mk (f 1) (f (p - 1))
+    (λ s, by rw [hf2, add_tsub_cancel_of_le hp.out.one_lt.le, hf3])
+    (λ s, by rw [hf2, tsub_add_cancel_of_le hp.out.one_lt.le, hf3]),
+  have hσ : ∀ k v, (σ ^ k) v = f k v :=
+  λ k v, nat.rec (hf1 v).symm (λ k hk, eq.trans (by exact congr_arg σ hk) (hf2 k 1 v)) k,
+  replace hσ : σ ^ (p ^ 1) = 1 := perm.ext (λ v, by rw [pow_one, hσ, hf3, one_apply]),
+  let v₀ : vectors_prod_eq_one G p :=
+    ⟨vector.replicate p 1, (list.prod_replicate p 1).trans (one_pow p)⟩,
+  have hv₀ : σ v₀ = v₀ := subtype.ext (subtype.ext (list.rotate_replicate (1 : G) p 1)),
+  obtain ⟨v, hv1, hv2⟩ := exists_fixed_point_of_prime' Scard hσ hv₀,
+  refine exists_imp_exists (λ g hg, order_of_eq_prime _ (λ hg', hv2 _))
+    (list.rotate_one_eq_self_iff_eq_replicate.mp (subtype.ext_iff.mp (subtype.ext_iff.mp hv1))),
+  { rw [←list.prod_replicate, ←v.1.2, ←hg, (show v.val.val.prod = 1, from v.2)] },
+  { rw [subtype.ext_iff_val, subtype.ext_iff_val, hg, hg', v.1.2],
+    refl },
+end
+
+/-- For every prime `p` dividing the order of a finite additive group `G` there exists an element of
+order `p` in `G`. This is the additive version of Cauchy's theorem. -/
+lemma _root_.exists_prime_add_order_of_dvd_card {G : Type*} [add_group G] [fintype G] (p : ℕ)
+  [hp : fact p.prime] (hdvd : p ∣ fintype.card G) : ∃ x : G, add_order_of x = p :=
+@exists_prime_order_of_dvd_card (multiplicative G) _ _ _ _ hdvd
+
+attribute [to_additive exists_prime_add_order_of_dvd_card] exists_prime_order_of_dvd_card
+
+end cauchy
+
+lemma subgroup_eq_top_of_swap_mem [decidable_eq α] {H : subgroup (perm α)}
+  [d : decidable_pred (∈ H)] {τ : perm α} (h0 : (fintype.card α).prime)
+  (h1 : fintype.card α ∣ fintype.card H) (h2 : τ ∈ H) (h3 : is_swap τ) :
+  H = ⊤ :=
+begin
+  haveI : fact (fintype.card α).prime := ⟨h0⟩,
+  obtain ⟨σ, hσ⟩ := exists_prime_order_of_dvd_card (fintype.card α) h1,
+  have hσ1 : order_of (σ : perm α) = fintype.card α := (order_of_subgroup σ).trans hσ,
+  have hσ2 : is_cycle ↑σ := is_cycle_of_prime_order'' h0 hσ1,
+  have hσ3 : (σ : perm α).support = ⊤ :=
+    finset.eq_univ_of_card (σ : perm α).support (hσ2.order_of.symm.trans hσ1),
+  have hσ4 : subgroup.closure {↑σ, τ} = ⊤ := closure_prime_cycle_swap h0 hσ2 hσ3 h3,
+  rw [eq_top_iff, ←hσ4, subgroup.closure_le, set.insert_subset, set.singleton_subset_iff],
+  exact ⟨subtype.mem σ, h2⟩,
+end
+
+section partition
+
+variables [decidable_eq α]
+
+/-- The partition corresponding to a permutation -/
+def partition (σ : perm α) : (fintype.card α).partition :=
+{ parts := σ.cycle_type + replicate (fintype.card α - σ.support.card) 1,
+  parts_pos := λ n hn,
+  begin
+    cases mem_add.mp hn with hn hn,
+    { exact zero_lt_one.trans (one_lt_of_mem_cycle_type hn) },
+    { exact lt_of_lt_of_le zero_lt_one (ge_of_eq (multiset.eq_of_mem_replicate hn)) },
+  end,
+  parts_sum := by rw [sum_add, sum_cycle_type, multiset.sum_replicate, nsmul_eq_mul,
+    nat.cast_id, mul_one, add_tsub_cancel_of_le σ.support.card_le_univ] }
+
+lemma parts_partition {σ : perm α} :
+  σ.partition.parts = σ.cycle_type + replicate (fintype.card α - σ.support.card) 1 := rfl
+
+lemma filter_parts_partition_eq_cycle_type {σ : perm α} :
+  (partition σ).parts.filter (λ n, 2 ≤ n) = σ.cycle_type :=
+begin
+  rw [parts_partition, filter_add, multiset.filter_eq_self.2 (λ _, two_le_of_mem_cycle_type),
+    multiset.filter_eq_nil.2 (λ a h, _), add_zero],
+  rw multiset.eq_of_mem_replicate h,
+  dec_trivial
+end
+
+lemma partition_eq_of_is_conj {σ τ : perm α} :
+  is_conj σ τ ↔ σ.partition = τ.partition :=
+begin
+  rw [is_conj_iff_cycle_type_eq],
+  refine ⟨λ h, _, λ h, _⟩,
+  { rw [nat.partition.ext_iff, parts_partition, parts_partition,
+      ← sum_cycle_type, ← sum_cycle_type, h] },
+  { rw [← filter_parts_partition_eq_cycle_type, ← filter_parts_partition_eq_cycle_type, h] }
+end
+
+end partition
+
+/-!
+### 3-cycles
+-/
+
+/-- A three-cycle is a cycle of length 3. -/
+def is_three_cycle [decidable_eq α] (σ : perm α) : Prop := σ.cycle_type = {3}
+
+namespace is_three_cycle
+
+variables [decidable_eq α] {σ : perm α}
+
+lemma cycle_type (h : is_three_cycle σ) : σ.cycle_type = {3} := h
+
+lemma card_support (h : is_three_cycle σ) : σ.support.card = 3 :=
+by rw [←sum_cycle_type, h.cycle_type, multiset.sum_singleton]
+
+lemma _root_.card_support_eq_three_iff : σ.support.card = 3 ↔ σ.is_three_cycle :=
+begin
+  refine ⟨λ h, _, is_three_cycle.card_support⟩,
+  by_cases h0 : σ.cycle_type = 0,
+  { rw [←sum_cycle_type, h0, sum_zero] at h,
+    exact (ne_of_lt zero_lt_three h).elim },
+  obtain ⟨n, hn⟩ := exists_mem_of_ne_zero h0,
+  by_cases h1 : σ.cycle_type.erase n = 0,
+  { rw [←sum_cycle_type, ←cons_erase hn, h1, cons_zero, multiset.sum_singleton] at h,
+    rw [is_three_cycle, ←cons_erase hn, h1, h, ←cons_zero] },
+  obtain ⟨m, hm⟩ := exists_mem_of_ne_zero h1,
+  rw [←sum_cycle_type, ←cons_erase hn, ←cons_erase hm, multiset.sum_cons, multiset.sum_cons] at h,
+  -- TODO: linarith [...] should solve this directly
+  have : ∀ {k}, 2 ≤ m → 2 ≤ n → n + (m + k) = 3 → false, { intros, linarith },
+  cases this (two_le_of_mem_cycle_type (mem_of_mem_erase hm)) (two_le_of_mem_cycle_type hn) h,
+end
+
+lemma is_cycle (h : is_three_cycle σ) : is_cycle σ :=
+by rw [←card_cycle_type_eq_one, h.cycle_type, card_singleton]
+
+lemma sign (h : is_three_cycle σ) : sign σ = 1 :=
+begin
+  rw [equiv.perm.sign_of_cycle_type, h.cycle_type],
+  refl,
+end
+
+lemma inv {f : perm α} (h : is_three_cycle f) : is_three_cycle (f⁻¹) :=
+by rwa [is_three_cycle, cycle_type_inv]
+
+@[simp] lemma inv_iff {f : perm α} : is_three_cycle (f⁻¹) ↔ is_three_cycle f :=
+⟨by { rw ← inv_inv f, apply inv }, inv⟩
+
+lemma order_of {g : perm α} (ht : is_three_cycle g) :
+  order_of g = 3 :=
+by rw [←lcm_cycle_type, ht.cycle_type, multiset.lcm_singleton, normalize_eq]
+
+lemma is_three_cycle_sq {g : perm α} (ht : is_three_cycle g) :
+  is_three_cycle (g * g) :=
+begin
+  rw [←pow_two, ←card_support_eq_three_iff, support_pow_coprime, ht.card_support],
+  rw [ht.order_of, nat.coprime_iff_gcd_eq_one],
+  norm_num,
+end
+
+end is_three_cycle
+
+section
+variable [decidable_eq α]
+
+lemma is_three_cycle_swap_mul_swap_same
+  {a b c : α} (ab : a ≠ b) (ac : a ≠ c) (bc : b ≠ c) :
+  is_three_cycle (swap a b * swap a c) :=
+begin
+  suffices h : support (swap a b * swap a c) = {a, b, c},
+  { rw [←card_support_eq_three_iff, h],
+    simp [ab, ac, bc] },
+  apply le_antisymm ((support_mul_le _ _).trans (λ x, _)) (λ x hx, _),
+  { simp [ab, ac, bc] },
+  { simp only [finset.mem_insert, finset.mem_singleton] at hx,
+    rw mem_support,
+    simp only [perm.coe_mul, function.comp_app, ne.def],
+    obtain rfl | rfl | rfl := hx,
+    { rw [swap_apply_left, swap_apply_of_ne_of_ne ac.symm bc.symm],
+      exact ac.symm },
+    { rw [swap_apply_of_ne_of_ne ab.symm bc, swap_apply_right],
+      exact ab },
+    { rw [swap_apply_right, swap_apply_left],
+      exact bc } }
+end
+
+open subgroup
+
+lemma swap_mul_swap_same_mem_closure_three_cycles
+  {a b c : α} (ab : a ≠ b) (ac : a ≠ c) :
+  (swap a b * swap a c) ∈ closure {σ : perm α | is_three_cycle σ } :=
+begin
+  by_cases bc : b = c,
+  { subst bc,
+    simp [one_mem] },
+  exact subset_closure (is_three_cycle_swap_mul_swap_same ab ac bc)
+end
+
+lemma is_swap.mul_mem_closure_three_cycles {σ τ : perm α}
+  (hσ : is_swap σ) (hτ : is_swap τ) :
+  σ * τ ∈ closure {σ : perm α | is_three_cycle σ } :=
+begin
+  obtain ⟨a, b, ab, rfl⟩ := hσ,
+  obtain ⟨c, d, cd, rfl⟩ := hτ,
+  by_cases ac : a = c,
+  { subst ac,
+    exact swap_mul_swap_same_mem_closure_three_cycles ab cd },
+  have h' : swap a b * swap c d = swap a b * swap a c * (swap c a * swap c d),
+  { simp [swap_comm c a, mul_assoc] },
+  rw h',
+  exact mul_mem (swap_mul_swap_same_mem_closure_three_cycles ab ac)
+    (swap_mul_swap_same_mem_closure_three_cycles (ne.symm ac) cd),
+end
+
+end
+
+end equiv.perm
diff --git a/src/group_theory/perm/cycle_type.lean b/src/group_theory/perm/cycle_type.lean
deleted file mode 100644
index 519190c9c6ec2..0000000000000
--- a/src/group_theory/perm/cycle_type.lean
+++ /dev/null
@@ -1,664 +0,0 @@
-/-
-Copyright (c) 2020 Thomas Browning. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Thomas Browning
--/
-
-import algebra.gcd_monoid.multiset
-import combinatorics.partition
-import group_theory.perm.cycles
-import ring_theory.int.basic
-import tactic.linarith
-
-/-!
-# Cycle Types
-
-In this file we define the cycle type of a permutation.
-
-## Main definitions
-
-- `σ.cycle_type` where `σ` is a permutation of a `fintype`
-- `σ.partition` where `σ` is a permutation of a `fintype`
-
-## Main results
-
-- `sum_cycle_type` : The sum of `σ.cycle_type` equals `σ.support.card`
-- `lcm_cycle_type` : The lcm of `σ.cycle_type` equals `order_of σ`
-- `is_conj_iff_cycle_type_eq` : Two permutations are conjugate if and only if they have the same
-  cycle type.
-* `exists_prime_order_of_dvd_card`: For every prime `p` dividing the order of a finite group `G`
-  there exists an element of order `p` in `G`. This is known as Cauchy`s theorem.
--/
-
-namespace equiv.perm
-open equiv list multiset
-
-variables {α : Type*} [fintype α]
-
-section cycle_type
-
-variables [decidable_eq α]
-
-/-- The cycle type of a permutation -/
-def cycle_type (σ : perm α) : multiset ℕ :=
-σ.cycle_factors_finset.1.map (finset.card ∘ support)
-
-lemma cycle_type_def (σ : perm α) :
-  σ.cycle_type = σ.cycle_factors_finset.1.map (finset.card ∘ support) := rfl
-
-lemma cycle_type_eq' {σ : perm α} (s : finset (perm α))
-  (h1 : ∀ f : perm α, f ∈ s → f.is_cycle) (h2 : ∀ (a ∈ s) (b ∈ s), a ≠ b → disjoint a b)
-  (h0 : s.noncomm_prod id
-    (λ a ha b hb, (em (a = b)).by_cases (λ h, h ▸ commute.refl a)
-      (set.pairwise.mono' (λ _ _, disjoint.commute) h2 ha hb)) = σ) :
-  σ.cycle_type = s.1.map (finset.card ∘ support) :=
-begin
-  rw cycle_type_def,
-  congr,
-  rw cycle_factors_finset_eq_finset,
-  exact ⟨h1, h2, h0⟩
-end
-
-lemma cycle_type_eq {σ : perm α} (l : list (perm α)) (h0 : l.prod = σ)
-  (h1 : ∀ σ : perm α, σ ∈ l → σ.is_cycle) (h2 : l.pairwise disjoint) :
-  σ.cycle_type = l.map (finset.card ∘ support) :=
-begin
-  have hl : l.nodup := nodup_of_pairwise_disjoint_cycles h1 h2,
-  rw cycle_type_eq' l.to_finset,
-  { simp [list.dedup_eq_self.mpr hl] },
-  { simpa using h1 },
-  { simpa [hl] using h0 },
-  { simpa [list.dedup_eq_self.mpr hl] using h2.forall disjoint.symmetric }
-end
-
-lemma cycle_type_one : (1 : perm α).cycle_type = 0 :=
-cycle_type_eq [] rfl (λ _, false.elim) pairwise.nil
-
-lemma cycle_type_eq_zero {σ : perm α} : σ.cycle_type = 0 ↔ σ = 1 :=
-by simp [cycle_type_def, cycle_factors_finset_eq_empty_iff]
-
-lemma card_cycle_type_eq_zero {σ : perm α} : σ.cycle_type.card = 0 ↔ σ = 1 :=
-by rw [card_eq_zero, cycle_type_eq_zero]
-
-lemma two_le_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : 2 ≤ n :=
-begin
-  simp only [cycle_type_def, ←finset.mem_def, function.comp_app, multiset.mem_map,
-    mem_cycle_factors_finset_iff] at h,
-  obtain ⟨_, ⟨hc, -⟩, rfl⟩ := h,
-  exact hc.two_le_card_support
-end
-
-lemma one_lt_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : 1 < n :=
-two_le_of_mem_cycle_type h
-
-lemma is_cycle.cycle_type {σ : perm α} (hσ : is_cycle σ) : σ.cycle_type = [σ.support.card] :=
-cycle_type_eq [σ] (mul_one σ) (λ τ hτ, (congr_arg is_cycle (list.mem_singleton.mp hτ)).mpr hσ)
-  (pairwise_singleton disjoint σ)
-
-lemma card_cycle_type_eq_one {σ : perm α} : σ.cycle_type.card = 1 ↔ σ.is_cycle :=
-begin
-  rw card_eq_one,
-  simp_rw [cycle_type_def, multiset.map_eq_singleton, ←finset.singleton_val,
-           finset.val_inj, cycle_factors_finset_eq_singleton_iff],
-  split,
-  { rintro ⟨_, _, ⟨h, -⟩, -⟩,
-    exact h },
-  { intro h,
-    use [σ.support.card, σ],
-    simp [h] }
-end
-
-lemma disjoint.cycle_type {σ τ : perm α} (h : disjoint σ τ) :
-  (σ * τ).cycle_type = σ.cycle_type + τ.cycle_type :=
-begin
-  rw [cycle_type_def, cycle_type_def, cycle_type_def, h.cycle_factors_finset_mul_eq_union,
-      ←multiset.map_add, finset.union_val, multiset.add_eq_union_iff_disjoint.mpr _],
-  rw [←finset.disjoint_val],
-  exact h.disjoint_cycle_factors_finset
-end
-
-lemma cycle_type_inv (σ : perm α) : σ⁻¹.cycle_type = σ.cycle_type :=
-cycle_induction_on (λ τ : perm α, τ⁻¹.cycle_type = τ.cycle_type) σ rfl
-  (λ σ hσ, by rw [hσ.cycle_type, hσ.inv.cycle_type, support_inv])
-  (λ σ τ hστ hc hσ hτ, by rw [mul_inv_rev, hστ.cycle_type, ←hσ, ←hτ, add_comm,
-    disjoint.cycle_type (λ x, or.imp (λ h : τ x = x, inv_eq_iff_eq.mpr h.symm)
-    (λ h : σ x = x, inv_eq_iff_eq.mpr h.symm) (hστ x).symm)])
-
-lemma cycle_type_conj {σ τ : perm α} : (τ * σ * τ⁻¹).cycle_type = σ.cycle_type :=
-begin
-  revert τ,
-  apply cycle_induction_on _ σ,
-  { intro,
-    simp },
-  { intros σ hσ τ,
-    rw [hσ.cycle_type, hσ.is_cycle_conj.cycle_type, card_support_conj] },
-  { intros σ τ hd hc hσ hτ π,
-    rw [← conj_mul, hd.cycle_type, disjoint.cycle_type, hσ, hτ],
-    intro a,
-    apply (hd (π⁻¹ a)).imp _ _;
-    { intro h, rw [perm.mul_apply, perm.mul_apply, h, apply_inv_self] } }
-end
-
-lemma sum_cycle_type (σ : perm α) : σ.cycle_type.sum = σ.support.card :=
-cycle_induction_on (λ τ : perm α, τ.cycle_type.sum = τ.support.card) σ
-  (by rw [cycle_type_one, sum_zero, support_one, finset.card_empty])
-  (λ σ hσ, by rw [hσ.cycle_type, coe_sum, list.sum_singleton])
-  (λ σ τ hστ hc hσ hτ, by rw [hστ.cycle_type, sum_add, hσ, hτ, hστ.card_support_mul])
-
-lemma sign_of_cycle_type' (σ : perm α) :
-  sign σ = (σ.cycle_type.map (λ n, -(-1 : ℤˣ) ^ n)).prod :=
-cycle_induction_on (λ τ : perm α, sign τ = (τ.cycle_type.map (λ n, -(-1 : ℤˣ) ^ n)).prod) σ
-  (by rw [sign_one, cycle_type_one, multiset.map_zero, prod_zero])
-  (λ σ hσ, by rw [hσ.sign, hσ.cycle_type, coe_map, coe_prod,
-    list.map_singleton, list.prod_singleton])
-  (λ σ τ hστ hc hσ hτ, by rw [sign_mul, hσ, hτ, hστ.cycle_type, multiset.map_add, prod_add])
-
-lemma sign_of_cycle_type (f : perm α) :
-  sign f = (-1 : ℤˣ)^(f.cycle_type.sum + f.cycle_type.card) :=
-cycle_induction_on
-  (λ f : perm α, sign f = (-1 : ℤˣ)^(f.cycle_type.sum + f.cycle_type.card))
-  f
-  ( -- base_one
-    by rw [equiv.perm.cycle_type_one, sign_one, multiset.sum_zero, multiset.card_zero, pow_zero] )
-  ( -- base_cycles
-    λ f hf,
-      by rw [equiv.perm.is_cycle.cycle_type hf, hf.sign,
-      coe_sum, list.sum_cons, sum_nil, add_zero, coe_card, length_singleton,
-      pow_add, pow_one, mul_comm, neg_mul, one_mul] )
-  ( -- induction_disjoint
-    λ f g hfg hf Pf Pg,
-    by rw [equiv.perm.disjoint.cycle_type hfg,
-      multiset.sum_add, multiset.card_add,← add_assoc,
-      add_comm f.cycle_type.sum g.cycle_type.sum,
-      add_assoc g.cycle_type.sum _ _,
-      add_comm g.cycle_type.sum _,
-      add_assoc, pow_add,
-      ← Pf, ← Pg,
-      equiv.perm.sign_mul])
-
-lemma lcm_cycle_type (σ : perm α) : σ.cycle_type.lcm = order_of σ :=
-cycle_induction_on (λ τ : perm α, τ.cycle_type.lcm = order_of τ) σ
-  (by rw [cycle_type_one, lcm_zero, order_of_one])
-  (λ σ hσ, by rw [hσ.cycle_type, ←singleton_coe, ←singleton_eq_cons, lcm_singleton,
-    order_of_is_cycle hσ, normalize_eq])
-  (λ σ τ hστ hc hσ hτ, by rw [hστ.cycle_type, lcm_add, lcm_eq_nat_lcm, hστ.order_of, hσ, hτ])
-
-lemma dvd_of_mem_cycle_type {σ : perm α} {n : ℕ} (h : n ∈ σ.cycle_type) : n ∣ order_of σ :=
-begin
-  rw ← lcm_cycle_type,
-  exact dvd_lcm h,
-end
-
-lemma order_of_cycle_of_dvd_order_of (f : perm α) (x : α) :
-  order_of (cycle_of f x) ∣ order_of f :=
-begin
-  by_cases hx : f x = x,
-  { rw ←cycle_of_eq_one_iff at hx,
-    simp [hx] },
-  { refine dvd_of_mem_cycle_type _,
-    rw [cycle_type, multiset.mem_map],
-    refine ⟨f.cycle_of x, _, _⟩,
-    { rwa [←finset.mem_def, cycle_of_mem_cycle_factors_finset_iff, mem_support] },
-    { simp [order_of_is_cycle (is_cycle_cycle_of _ hx)] } }
-end
-
-lemma two_dvd_card_support {σ : perm α} (hσ : σ ^ 2 = 1) : 2 ∣ σ.support.card :=
-(congr_arg (has_dvd.dvd 2) σ.sum_cycle_type).mp
-  (multiset.dvd_sum (λ n hn, by rw le_antisymm (nat.le_of_dvd zero_lt_two $
-  (dvd_of_mem_cycle_type hn).trans $ order_of_dvd_of_pow_eq_one hσ) (two_le_of_mem_cycle_type hn)))
-
-lemma cycle_type_prime_order {σ : perm α} (hσ : (order_of σ).prime) :
-  ∃ n : ℕ, σ.cycle_type = repeat (order_of σ) (n + 1) :=
-begin
-  rw eq_repeat_of_mem (λ n hn, or_iff_not_imp_left.mp
-    (hσ.eq_one_or_self_of_dvd n (dvd_of_mem_cycle_type hn)) (one_lt_of_mem_cycle_type hn).ne'),
-  use σ.cycle_type.card - 1,
-  rw tsub_add_cancel_of_le,
-  rw [nat.succ_le_iff, pos_iff_ne_zero, ne, card_cycle_type_eq_zero],
-  intro H,
-  rw [H, order_of_one] at hσ,
-  exact hσ.ne_one rfl,
-end
-
-lemma is_cycle_of_prime_order {σ : perm α} (h1 : (order_of σ).prime)
-  (h2 : σ.support.card < 2 * (order_of σ)) : σ.is_cycle :=
-begin
-  obtain ⟨n, hn⟩ := cycle_type_prime_order h1,
-  rw [←σ.sum_cycle_type, hn, multiset.sum_repeat, nsmul_eq_mul, nat.cast_id, mul_lt_mul_right
-      (order_of_pos σ), nat.succ_lt_succ_iff, nat.lt_succ_iff, nat.le_zero_iff] at h2,
-  rw [←card_cycle_type_eq_one, hn, card_repeat, h2],
-end
-
-lemma cycle_type_le_of_mem_cycle_factors_finset {f g : perm α}
-  (hf : f ∈ g.cycle_factors_finset) :
-  f.cycle_type ≤ g.cycle_type :=
-begin
-  rw mem_cycle_factors_finset_iff at hf,
-  rw [cycle_type_def, cycle_type_def, hf.left.cycle_factors_finset_eq_singleton],
-  refine map_le_map _,
-  simpa [←finset.mem_def, mem_cycle_factors_finset_iff] using hf
-end
-
-lemma cycle_type_mul_mem_cycle_factors_finset_eq_sub {f g : perm α}
-  (hf : f ∈ g.cycle_factors_finset) :
-  (g * f⁻¹).cycle_type = g.cycle_type - f.cycle_type :=
-begin
-  suffices : (g * f⁻¹).cycle_type + f.cycle_type = g.cycle_type - f.cycle_type + f.cycle_type,
-  { rw tsub_add_cancel_of_le (cycle_type_le_of_mem_cycle_factors_finset hf) at this,
-    simp [←this] },
-  simp [←(disjoint_mul_inv_of_mem_cycle_factors_finset hf).cycle_type,
-    tsub_add_cancel_of_le (cycle_type_le_of_mem_cycle_factors_finset hf)]
-end
-
-theorem is_conj_of_cycle_type_eq {σ τ : perm α} (h : cycle_type σ = cycle_type τ) : is_conj σ τ :=
-begin
-  revert τ,
-  apply cycle_induction_on _ σ,
-  { intros τ h,
-    rw [cycle_type_one, eq_comm, cycle_type_eq_zero] at h,
-    rw h },
-  { intros σ hσ τ hστ,
-    have hτ := card_cycle_type_eq_one.2 hσ,
-    rw [hστ, card_cycle_type_eq_one] at hτ,
-    apply hσ.is_conj hτ,
-    rw [hσ.cycle_type, hτ.cycle_type, coe_eq_coe, singleton_perm] at hστ,
-    simp only [and_true, eq_self_iff_true] at hστ,
-    exact hστ },
-  { intros σ τ hστ hσ h1 h2 π hπ,
-    rw [hστ.cycle_type] at hπ,
-    { have h : σ.support.card ∈ map (finset.card ∘ perm.support) π.cycle_factors_finset.val,
-      { simp [←cycle_type_def, ←hπ, hσ.cycle_type] },
-      obtain ⟨σ', hσ'l, hσ'⟩ := multiset.mem_map.mp h,
-      have key : is_conj (σ' * (π * σ'⁻¹)) π,
-      { rw is_conj_iff,
-        use σ'⁻¹,
-        simp [mul_assoc] },
-      refine is_conj.trans _ key,
-      have hs : σ.cycle_type = σ'.cycle_type,
-      { rw [←finset.mem_def, mem_cycle_factors_finset_iff] at hσ'l,
-        rw [hσ.cycle_type, ←hσ', hσ'l.left.cycle_type] },
-      refine hστ.is_conj_mul (h1 hs) (h2 _) _,
-      { rw [cycle_type_mul_mem_cycle_factors_finset_eq_sub, ←hπ, add_comm, hs,
-            add_tsub_cancel_right],
-        rwa finset.mem_def },
-      { exact (disjoint_mul_inv_of_mem_cycle_factors_finset hσ'l).symm } } }
-end
-
-theorem is_conj_iff_cycle_type_eq {σ τ : perm α} :
-  is_conj σ τ ↔ σ.cycle_type = τ.cycle_type :=
-⟨λ h, begin
-  obtain ⟨π, rfl⟩ := is_conj_iff.1 h,
-  rw cycle_type_conj,
-end, is_conj_of_cycle_type_eq⟩
-
-@[simp] lemma cycle_type_extend_domain {β : Type*} [fintype β] [decidable_eq β]
-  {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p) {g : perm α} :
-  cycle_type (g.extend_domain f) = cycle_type g :=
-begin
-  apply cycle_induction_on _ g,
-  { rw [extend_domain_one, cycle_type_one, cycle_type_one] },
-  { intros σ hσ,
-    rw [(hσ.extend_domain f).cycle_type, hσ.cycle_type, card_support_extend_domain] },
-  { intros σ τ hd hc hσ hτ,
-    rw [hd.cycle_type, ← extend_domain_mul, (hd.extend_domain f).cycle_type, hσ, hτ] }
-end
-
-lemma mem_cycle_type_iff {n : ℕ} {σ : perm α} :
-  n ∈ cycle_type σ ↔ ∃ c τ : perm α, σ = c * τ ∧ disjoint c τ ∧ is_cycle c ∧ c.support.card = n :=
-begin
-  split,
-  { intro h,
-    obtain ⟨l, rfl, hlc, hld⟩ := trunc_cycle_factors σ,
-    rw cycle_type_eq _ rfl hlc hld at h,
-    obtain ⟨c, cl, rfl⟩ := list.exists_of_mem_map h,
-    rw (list.perm_cons_erase cl).pairwise_iff (λ _ _ hd, _) at hld,
-    swap, { exact hd.symm },
-    refine ⟨c, (l.erase c).prod, _, _, hlc _ cl, rfl⟩,
-    { rw [← list.prod_cons,
-        (list.perm_cons_erase cl).symm.prod_eq' (hld.imp (λ _ _, disjoint.commute))] },
-    { exact disjoint_prod_right _ (λ g, list.rel_of_pairwise_cons hld) } },
-  { rintros ⟨c, t, rfl, hd, hc, rfl⟩,
-    simp [hd.cycle_type, hc.cycle_type] }
-end
-
-lemma le_card_support_of_mem_cycle_type {n : ℕ} {σ : perm α} (h : n ∈ cycle_type σ) :
-  n ≤ σ.support.card :=
-(le_sum_of_mem h).trans (le_of_eq σ.sum_cycle_type)
-
-lemma cycle_type_of_card_le_mem_cycle_type_add_two {n : ℕ} {g : perm α}
-  (hn2 : fintype.card α < n + 2) (hng : n ∈ g.cycle_type) :
-  g.cycle_type = {n} :=
-begin
-  obtain ⟨c, g', rfl, hd, hc, rfl⟩ := mem_cycle_type_iff.1 hng,
-  by_cases g'1 : g' = 1,
-  { rw [hd.cycle_type, hc.cycle_type, multiset.singleton_eq_cons, multiset.singleton_coe,
-      g'1, cycle_type_one, add_zero] },
-  contrapose! hn2,
-  apply le_trans _ (c * g').support.card_le_univ,
-  rw [hd.card_support_mul],
-  exact add_le_add_left (two_le_card_support_of_ne_one g'1) _,
-end
-
-end cycle_type
-
-lemma card_compl_support_modeq [decidable_eq α] {p n : ℕ} [hp : fact p.prime] {σ : perm α}
-  (hσ : σ ^ p ^ n = 1) : σ.supportᶜ.card ≡ fintype.card α [MOD p] :=
-begin
-  rw [nat.modeq_iff_dvd' σ.supportᶜ.card_le_univ, ←finset.card_compl, compl_compl],
-  refine (congr_arg _ σ.sum_cycle_type).mp (multiset.dvd_sum (λ k hk, _)),
-  obtain ⟨m, -, hm⟩ := (nat.dvd_prime_pow hp.out).mp (order_of_dvd_of_pow_eq_one hσ),
-  obtain ⟨l, -, rfl⟩ := (nat.dvd_prime_pow hp.out).mp
-    ((congr_arg _ hm).mp (dvd_of_mem_cycle_type hk)),
-  exact dvd_pow_self _ (λ h, (one_lt_of_mem_cycle_type hk).ne $ by rw [h, pow_zero]),
-end
-
-lemma exists_fixed_point_of_prime {p n : ℕ} [hp : fact p.prime] (hα : ¬ p ∣ fintype.card α)
-  {σ : perm α} (hσ : σ ^ p ^ n = 1) : ∃ a : α, σ a = a :=
-begin
-  classical,
-  contrapose! hα,
-  simp_rw ← mem_support at hα,
-  exact nat.modeq_zero_iff_dvd.mp ((congr_arg _ (finset.card_eq_zero.mpr (compl_eq_bot.mpr
-    (finset.eq_univ_iff_forall.mpr hα)))).mp (card_compl_support_modeq hσ).symm),
-end
-
-lemma exists_fixed_point_of_prime' {p n : ℕ} [hp : fact p.prime] (hα : p ∣ fintype.card α)
-  {σ : perm α} (hσ : σ ^ p ^ n = 1) {a : α} (ha : σ a = a) : ∃ b : α, σ b = b ∧ b ≠ a :=
-begin
-  classical,
-  have h : ∀ b : α, b ∈ σ.supportᶜ ↔ σ b = b :=
-  λ b, by rw [finset.mem_compl, mem_support, not_not],
-  obtain ⟨b, hb1, hb2⟩ := finset.exists_ne_of_one_lt_card (lt_of_lt_of_le hp.out.one_lt
-    (nat.le_of_dvd (finset.card_pos.mpr ⟨a, (h a).mpr ha⟩) (nat.modeq_zero_iff_dvd.mp
-    ((card_compl_support_modeq hσ).trans (nat.modeq_zero_iff_dvd.mpr hα))))) a,
-  exact ⟨b, (h b).mp hb1, hb2⟩,
-end
-
-lemma is_cycle_of_prime_order' {σ : perm α} (h1 : (order_of σ).prime)
-  (h2 : fintype.card α < 2 * (order_of σ)) : σ.is_cycle :=
-begin
-  classical,
-  exact is_cycle_of_prime_order h1 (lt_of_le_of_lt σ.support.card_le_univ h2),
-end
-
-lemma is_cycle_of_prime_order'' {σ : perm α} (h1 : (fintype.card α).prime)
-  (h2 : order_of σ = fintype.card α) : σ.is_cycle :=
-is_cycle_of_prime_order' ((congr_arg nat.prime h2).mpr h1)
-begin
-  classical,
-  rw [←one_mul (fintype.card α), ←h2, mul_lt_mul_right (order_of_pos σ)],
-  exact one_lt_two,
-end
-
-section cauchy
-
-variables (G : Type*) [group G] (n : ℕ)
-
-/-- The type of vectors with terms from `G`, length `n`, and product equal to `1:G`. -/
-def vectors_prod_eq_one : set (vector G n) :=
-{v | v.to_list.prod = 1}
-
-namespace vectors_prod_eq_one
-
-lemma mem_iff {n : ℕ} (v : vector G n) :
-v ∈ vectors_prod_eq_one G n ↔ v.to_list.prod = 1 := iff.rfl
-
-lemma zero_eq : vectors_prod_eq_one G 0 = {vector.nil} :=
-set.eq_singleton_iff_unique_mem.mpr ⟨eq.refl (1 : G), λ v hv, v.eq_nil⟩
-
-lemma one_eq : vectors_prod_eq_one G 1 = {vector.nil.cons 1} :=
-begin
-  simp_rw [set.eq_singleton_iff_unique_mem, mem_iff,
-    vector.to_list_singleton, list.prod_singleton, vector.head_cons],
-  exact ⟨rfl, λ v hv, v.cons_head_tail.symm.trans (congr_arg2 vector.cons hv v.tail.eq_nil)⟩,
-end
-
-instance zero_unique : unique (vectors_prod_eq_one G 0) :=
-by { rw zero_eq, exact set.unique_singleton vector.nil }
-
-instance one_unique : unique (vectors_prod_eq_one G 1) :=
-by { rw one_eq, exact set.unique_singleton (vector.nil.cons 1) }
-
-/-- Given a vector `v` of length `n`, make a vector of length `n + 1` whose product is `1`,
-by appending the inverse of the product of `v`. -/
-@[simps] def vector_equiv : vector G n ≃ vectors_prod_eq_one G (n + 1) :=
-{ to_fun := λ v, ⟨v.to_list.prod⁻¹ ::ᵥ v,
-    by rw [mem_iff, vector.to_list_cons, list.prod_cons, inv_mul_self]⟩,
-  inv_fun := λ v, v.1.tail,
-  left_inv := λ v, v.tail_cons v.to_list.prod⁻¹,
-  right_inv := λ v, subtype.ext ((congr_arg2 vector.cons (eq_inv_of_mul_eq_one (by
-  { rw [←list.prod_cons, ←vector.to_list_cons, v.1.cons_head_tail],
-    exact v.2 })).symm rfl).trans v.1.cons_head_tail) }
-
-/-- Given a vector `v` of length `n` whose product is 1, make a vector of length `n - 1`,
-by deleting the last entry of `v`. -/
-def equiv_vector : vectors_prod_eq_one G n ≃ vector G (n - 1) :=
-((vector_equiv G (n - 1)).trans (if hn : n = 0 then (show vectors_prod_eq_one G (n - 1 + 1) ≃
-  vectors_prod_eq_one G n, by { rw hn, exact equiv_of_unique_of_unique })
-  else by rw tsub_add_cancel_of_le (nat.pos_of_ne_zero hn).nat_succ_le)).symm
-
-instance [fintype G] : fintype (vectors_prod_eq_one G n) :=
-fintype.of_equiv (vector G (n - 1)) (equiv_vector G n).symm
-
-lemma card [fintype G] :
-  fintype.card (vectors_prod_eq_one G n) = fintype.card G ^ (n - 1) :=
-(fintype.card_congr (equiv_vector G n)).trans (card_vector (n - 1))
-
-variables {G n} {g : G} (v : vectors_prod_eq_one G n) (j k : ℕ)
-
-/-- Rotate a vector whose product is 1. -/
-def rotate : vectors_prod_eq_one G n :=
-⟨⟨_, (v.1.1.length_rotate k).trans v.1.2⟩, list.prod_rotate_eq_one_of_prod_eq_one v.2 k⟩
-
-lemma rotate_zero : rotate v 0 = v :=
-subtype.ext (subtype.ext v.1.1.rotate_zero)
-
-lemma rotate_rotate : rotate (rotate v j) k = rotate v (j + k) :=
-subtype.ext (subtype.ext (v.1.1.rotate_rotate j k))
-
-lemma rotate_length : rotate v n = v :=
-subtype.ext (subtype.ext ((congr_arg _ v.1.2.symm).trans v.1.1.rotate_length))
-
-end vectors_prod_eq_one
-
-lemma exists_prime_order_of_dvd_card {G : Type*} [group G] [fintype G] (p : ℕ) [hp : fact p.prime]
-  (hdvd : p ∣ fintype.card G) : ∃ x : G, order_of x = p :=
-begin
-  have hp' : p - 1 ≠ 0 := mt tsub_eq_zero_iff_le.mp (not_le_of_lt hp.out.one_lt),
-  have Scard := calc p ∣ fintype.card G ^ (p - 1) : hdvd.trans (dvd_pow (dvd_refl _) hp')
-  ... = fintype.card (vectors_prod_eq_one G p) : (vectors_prod_eq_one.card G p).symm,
-  let f : ℕ → vectors_prod_eq_one G p → vectors_prod_eq_one G p :=
-  λ k v, vectors_prod_eq_one.rotate v k,
-  have hf1 : ∀ v, f 0 v = v := vectors_prod_eq_one.rotate_zero,
-  have hf2 : ∀ j k v, f k (f j v) = f (j + k) v :=
-  λ j k v, vectors_prod_eq_one.rotate_rotate v j k,
-  have hf3 : ∀ v, f p v = v := vectors_prod_eq_one.rotate_length,
-  let σ := equiv.mk (f 1) (f (p - 1))
-    (λ s, by rw [hf2, add_tsub_cancel_of_le hp.out.one_lt.le, hf3])
-    (λ s, by rw [hf2, tsub_add_cancel_of_le hp.out.one_lt.le, hf3]),
-  have hσ : ∀ k v, (σ ^ k) v = f k v :=
-  λ k v, nat.rec (hf1 v).symm (λ k hk, eq.trans (by exact congr_arg σ hk) (hf2 k 1 v)) k,
-  replace hσ : σ ^ (p ^ 1) = 1 := perm.ext (λ v, by rw [pow_one, hσ, hf3, one_apply]),
-  let v₀ : vectors_prod_eq_one G p := ⟨vector.repeat 1 p, (list.prod_repeat 1 p).trans (one_pow p)⟩,
-  have hv₀ : σ v₀ = v₀ := subtype.ext (subtype.ext (list.rotate_repeat (1 : G) p 1)),
-  obtain ⟨v, hv1, hv2⟩ := exists_fixed_point_of_prime' Scard hσ hv₀,
-  refine exists_imp_exists (λ g hg, order_of_eq_prime _ (λ hg', hv2 _))
-    (list.rotate_one_eq_self_iff_eq_repeat.mp (subtype.ext_iff.mp (subtype.ext_iff.mp hv1))),
-  { rw [←list.prod_repeat, ←v.1.2, ←hg, (show v.val.val.prod = 1, from v.2)] },
-  { rw [subtype.ext_iff_val, subtype.ext_iff_val, hg, hg', v.1.2],
-    refl },
-end
-
-end cauchy
-
-lemma subgroup_eq_top_of_swap_mem [decidable_eq α] {H : subgroup (perm α)}
-  [d : decidable_pred (∈ H)] {τ : perm α} (h0 : (fintype.card α).prime)
-  (h1 : fintype.card α ∣ fintype.card H) (h2 : τ ∈ H) (h3 : is_swap τ) :
-  H = ⊤ :=
-begin
-  haveI : fact (fintype.card α).prime := ⟨h0⟩,
-  obtain ⟨σ, hσ⟩ := exists_prime_order_of_dvd_card (fintype.card α) h1,
-  have hσ1 : order_of (σ : perm α) = fintype.card α := (order_of_subgroup σ).trans hσ,
-  have hσ2 : is_cycle ↑σ := is_cycle_of_prime_order'' h0 hσ1,
-  have hσ3 : (σ : perm α).support = ⊤ :=
-    finset.eq_univ_of_card (σ : perm α).support ((order_of_is_cycle hσ2).symm.trans hσ1),
-  have hσ4 : subgroup.closure {↑σ, τ} = ⊤ := closure_prime_cycle_swap h0 hσ2 hσ3 h3,
-  rw [eq_top_iff, ←hσ4, subgroup.closure_le, set.insert_subset, set.singleton_subset_iff],
-  exact ⟨subtype.mem σ, h2⟩,
-end
-
-section partition
-
-variables [decidable_eq α]
-
-/-- The partition corresponding to a permutation -/
-def partition (σ : perm α) : (fintype.card α).partition :=
-{ parts := σ.cycle_type + repeat 1 (fintype.card α - σ.support.card),
-  parts_pos := λ n hn,
-  begin
-    cases mem_add.mp hn with hn hn,
-    { exact zero_lt_one.trans (one_lt_of_mem_cycle_type hn) },
-    { exact lt_of_lt_of_le zero_lt_one (ge_of_eq (multiset.eq_of_mem_repeat hn)) },
-  end,
-  parts_sum := by rw [sum_add, sum_cycle_type, multiset.sum_repeat, nsmul_eq_mul,
-    nat.cast_id, mul_one, add_tsub_cancel_of_le σ.support.card_le_univ] }
-
-lemma parts_partition {σ : perm α} :
-  σ.partition.parts = σ.cycle_type + repeat 1 (fintype.card α - σ.support.card) := rfl
-
-lemma filter_parts_partition_eq_cycle_type {σ : perm α} :
-  (partition σ).parts.filter (λ n, 2 ≤ n) = σ.cycle_type :=
-begin
-  rw [parts_partition, filter_add, multiset.filter_eq_self.2 (λ _, two_le_of_mem_cycle_type),
-    multiset.filter_eq_nil.2 (λ a h, _), add_zero],
-  rw multiset.eq_of_mem_repeat h,
-  dec_trivial
-end
-
-lemma partition_eq_of_is_conj {σ τ : perm α} :
-  is_conj σ τ ↔ σ.partition = τ.partition :=
-begin
-  rw [is_conj_iff_cycle_type_eq],
-  refine ⟨λ h, _, λ h, _⟩,
-  { rw [nat.partition.ext_iff, parts_partition, parts_partition,
-      ← sum_cycle_type, ← sum_cycle_type, h] },
-  { rw [← filter_parts_partition_eq_cycle_type, ← filter_parts_partition_eq_cycle_type, h] }
-end
-
-end partition
-
-/-!
-### 3-cycles
--/
-
-/-- A three-cycle is a cycle of length 3. -/
-def is_three_cycle [decidable_eq α] (σ : perm α) : Prop := σ.cycle_type = {3}
-
-namespace is_three_cycle
-
-variables [decidable_eq α] {σ : perm α}
-
-lemma cycle_type (h : is_three_cycle σ) : σ.cycle_type = {3} := h
-
-lemma card_support (h : is_three_cycle σ) : σ.support.card = 3 :=
-by rw [←sum_cycle_type, h.cycle_type, multiset.sum_singleton]
-
-lemma _root_.card_support_eq_three_iff : σ.support.card = 3 ↔ σ.is_three_cycle :=
-begin
-  refine ⟨λ h, _, is_three_cycle.card_support⟩,
-  by_cases h0 : σ.cycle_type = 0,
-  { rw [←sum_cycle_type, h0, sum_zero] at h,
-    exact (ne_of_lt zero_lt_three h).elim },
-  obtain ⟨n, hn⟩ := exists_mem_of_ne_zero h0,
-  by_cases h1 : σ.cycle_type.erase n = 0,
-  { rw [←sum_cycle_type, ←cons_erase hn, h1, ←singleton_eq_cons, multiset.sum_singleton] at h,
-    rw [is_three_cycle, ←cons_erase hn, h1, h, singleton_eq_cons] },
-  obtain ⟨m, hm⟩ := exists_mem_of_ne_zero h1,
-  rw [←sum_cycle_type, ←cons_erase hn, ←cons_erase hm, multiset.sum_cons, multiset.sum_cons] at h,
-  linarith [two_le_of_mem_cycle_type hn, two_le_of_mem_cycle_type (mem_of_mem_erase hm)],
-end
-
-lemma is_cycle (h : is_three_cycle σ) : is_cycle σ :=
-by rw [←card_cycle_type_eq_one, h.cycle_type, card_singleton]
-
-lemma sign (h : is_three_cycle σ) : sign σ = 1 :=
-begin
-  rw [equiv.perm.sign_of_cycle_type, h.cycle_type],
-  refl,
-end
-
-lemma inv {f : perm α} (h : is_three_cycle f) : is_three_cycle (f⁻¹) :=
-by rwa [is_three_cycle, cycle_type_inv]
-
-@[simp] lemma inv_iff {f : perm α} : is_three_cycle (f⁻¹) ↔ is_three_cycle f :=
-⟨by { rw ← inv_inv f, apply inv }, inv⟩
-
-lemma order_of {g : perm α} (ht : is_three_cycle g) :
-  order_of g = 3 :=
-by rw [←lcm_cycle_type, ht.cycle_type, multiset.lcm_singleton, normalize_eq]
-
-lemma is_three_cycle_sq {g : perm α} (ht : is_three_cycle g) :
-  is_three_cycle (g * g) :=
-begin
-  rw [←pow_two, ←card_support_eq_three_iff, support_pow_coprime, ht.card_support],
-  rw [ht.order_of, nat.coprime_iff_gcd_eq_one],
-  norm_num,
-end
-
-end is_three_cycle
-
-section
-variable [decidable_eq α]
-
-lemma is_three_cycle_swap_mul_swap_same
-  {a b c : α} (ab : a ≠ b) (ac : a ≠ c) (bc : b ≠ c) :
-  is_three_cycle (swap a b * swap a c) :=
-begin
-  suffices h : support (swap a b * swap a c) = {a, b, c},
-  { rw [←card_support_eq_three_iff, h],
-    simp [ab, ac, bc] },
-  apply le_antisymm ((support_mul_le _ _).trans (λ x, _)) (λ x hx, _),
-  { simp [ab, ac, bc] },
-  { simp only [finset.mem_insert, finset.mem_singleton] at hx,
-    rw mem_support,
-    simp only [perm.coe_mul, function.comp_app, ne.def],
-    obtain rfl | rfl | rfl := hx,
-    { rw [swap_apply_left, swap_apply_of_ne_of_ne ac.symm bc.symm],
-      exact ac.symm },
-    { rw [swap_apply_of_ne_of_ne ab.symm bc, swap_apply_right],
-      exact ab },
-    { rw [swap_apply_right, swap_apply_left],
-      exact bc } }
-end
-
-open subgroup
-
-lemma swap_mul_swap_same_mem_closure_three_cycles
-  {a b c : α} (ab : a ≠ b) (ac : a ≠ c) :
-  (swap a b * swap a c) ∈ closure {σ : perm α | is_three_cycle σ } :=
-begin
-  by_cases bc : b = c,
-  { subst bc,
-    simp [one_mem] },
-  exact subset_closure (is_three_cycle_swap_mul_swap_same ab ac bc)
-end
-
-lemma is_swap.mul_mem_closure_three_cycles {σ τ : perm α}
-  (hσ : is_swap σ) (hτ : is_swap τ) :
-  σ * τ ∈ closure {σ : perm α | is_three_cycle σ } :=
-begin
-  obtain ⟨a, b, ab, rfl⟩ := hσ,
-  obtain ⟨c, d, cd, rfl⟩ := hτ,
-  by_cases ac : a = c,
-  { subst ac,
-    exact swap_mul_swap_same_mem_closure_three_cycles ab cd },
-  have h' : swap a b * swap c d = swap a b * swap a c * (swap c a * swap c d),
-  { simp [swap_comm c a, mul_assoc] },
-  rw h',
-  exact mul_mem (swap_mul_swap_same_mem_closure_three_cycles ab ac)
-    (swap_mul_swap_same_mem_closure_three_cycles (ne.symm ac) cd),
-end
-
-end
-
-end equiv.perm
diff --git a/src/group_theory/perm/cycles.lean b/src/group_theory/perm/cycles.lean
deleted file mode 100644
index bfe3bb1ab39b5..0000000000000
--- a/src/group_theory/perm/cycles.lean
+++ /dev/null
@@ -1,1419 +0,0 @@
-/-
-Copyright (c) 2019 Chris Hughes. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Chris Hughes
--/
-import data.finset.noncomm_prod
-import group_theory.perm.sign
-import logic.equiv.fintype
-/-!
-# Cyclic permutations
-
-## Main definitions
-
-In the following, `f : equiv.perm β`.
-
-* `equiv.perm.is_cycle`: `f.is_cycle` when two nonfixed points of `β`
-  are related by repeated application of `f`.
-* `equiv.perm.same_cycle`: `f.same_cycle x y` when `x` and `y` are in the same cycle of `f`.
-
-The following two definitions require that `β` is a `fintype`:
-
-* `equiv.perm.cycle_of`: `f.cycle_of x` is the cycle of `f` that `x` belongs to.
-* `equiv.perm.cycle_factors`: `f.cycle_factors` is a list of disjoint cyclic permutations that
-  multiply to `f`.
-
-## Main results
-
-* This file contains several closure results:
-  - `closure_is_cycle` : The symmetric group is generated by cycles
-  - `closure_cycle_adjacent_swap` : The symmetric group is generated by
-    a cycle and an adjacent transposition
-  - `closure_cycle_coprime_swap` : The symmetric group is generated by
-    a cycle and a coprime transposition
-  - `closure_prime_cycle_swap` : The symmetric group is generated by
-    a prime cycle and a transposition
-
--/
-
-namespace equiv.perm
-open equiv function finset
-
-variables {α : Type*} {β : Type*} [decidable_eq α]
-
-section sign_cycle
-
-/-!
-### `is_cycle`
--/
-
-variables [fintype α]
-
-/-- A permutation is a cycle when any two nonfixed points of the permutation are related by repeated
-  application of the permutation. -/
-def is_cycle (f : perm β) : Prop := ∃ x, f x ≠ x ∧ ∀ y, f y ≠ y → ∃ i : ℤ, (f ^ i) x = y
-
-lemma is_cycle.ne_one {f : perm β} (h : is_cycle f) : f ≠ 1 :=
-λ hf, by simpa [hf, is_cycle] using h
-
-@[simp] lemma not_is_cycle_one : ¬ (1 : perm β).is_cycle :=
-λ H, H.ne_one rfl
-
-lemma is_cycle.two_le_card_support {f : perm α} (h : is_cycle f) :
-  2 ≤ f.support.card :=
-two_le_card_support_of_ne_one h.ne_one
-
-lemma is_cycle_swap {α : Type*} [decidable_eq α] {x y : α} (hxy : x ≠ y) : is_cycle (swap x y) :=
-⟨y, by rwa swap_apply_right,
-  λ a (ha : ite (a = x) y (ite (a = y) x a) ≠ a),
-    if hya : y = a then ⟨0, hya⟩
-    else ⟨1, by { rw [zpow_one, swap_apply_def], split_ifs at *; cc }⟩⟩
-
-lemma is_swap.is_cycle {α : Type*} [decidable_eq α] {f : perm α} (hf : is_swap f) : is_cycle f :=
-begin
-  obtain ⟨x, y, hxy, rfl⟩ := hf,
-  exact is_cycle_swap hxy,
-end
-
-lemma is_cycle.inv {f : perm β} (hf : is_cycle f) : is_cycle (f⁻¹) :=
-let ⟨x, hx⟩ := hf in
-⟨x, by { simp only [inv_eq_iff_eq, *, forall_prop_of_true, ne.def] at *, cc },
-  λ y hy, let ⟨i, hi⟩ := hx.2 y (by { simp only [inv_eq_iff_eq, *, forall_prop_of_true,
-      ne.def] at *, cc }) in
-    ⟨-i, by rwa [zpow_neg, inv_zpow, inv_inv]⟩⟩
-
-lemma is_cycle.is_cycle_conj {f g : perm β} (hf : is_cycle f) : is_cycle (g * f * g⁻¹) :=
-begin
-  obtain ⟨a, ha1, ha2⟩ := hf,
-  refine ⟨g a, by simp [ha1], λ b hb, _⟩,
-  obtain ⟨i, hi⟩ := ha2 (g⁻¹ b) _,
-  { refine ⟨i, _⟩,
-    rw conj_zpow,
-    simp [hi] },
-  { contrapose! hb,
-    rw [perm.mul_apply, perm.mul_apply, hb, apply_inv_self] }
-end
-
-lemma is_cycle.exists_zpow_eq {f : perm β} (hf : is_cycle f) {x y : β}
-  (hx : f x ≠ x) (hy : f y ≠ y) : ∃ i : ℤ, (f ^ i) x = y :=
-let ⟨g, hg⟩ := hf in
-let ⟨a, ha⟩ := hg.2 x hx in
-let ⟨b, hb⟩ := hg.2 y hy in
-⟨b - a, by rw [← ha, ← mul_apply, ← zpow_add, sub_add_cancel, hb]⟩
-
-lemma is_cycle.exists_pow_eq [fintype β] {f : perm β} (hf : is_cycle f) {x y : β}
-  (hx : f x ≠ x) (hy : f y ≠ y) : ∃ i : ℕ, (f ^ i) x = y :=
-let ⟨n, hn⟩ := hf.exists_zpow_eq hx hy in
-by classical; exact ⟨(n % order_of f).to_nat, by
-{ have := n.mod_nonneg (int.coe_nat_ne_zero.mpr (ne_of_gt (order_of_pos f))),
-  rwa [← zpow_coe_nat, int.to_nat_of_nonneg this, ← zpow_eq_mod_order_of] }⟩
-
-lemma is_cycle.exists_pow_eq_one [fintype β] {f : perm β} (hf : is_cycle f) :
-  ∃ (k : ℕ) (hk : 1 < k), f ^ k = 1 :=
-begin
-  classical,
-  have : is_of_fin_order f := exists_pow_eq_one f,
-  rw is_of_fin_order_iff_pow_eq_one at this,
-  obtain ⟨x, hx, hx'⟩ := hf,
-  obtain ⟨_ | _ | k, hk, hk'⟩ := this,
-  { exact absurd hk (lt_asymm hk) },
-  { rw pow_one at hk',
-    simpa [hk'] using hx },
-  { exact ⟨k + 2, by simp, hk'⟩ }
-end
-
-/-- The subgroup generated by a cycle is in bijection with its support -/
-noncomputable def is_cycle.zpowers_equiv_support {σ : perm α} (hσ : is_cycle σ) :
-  (↑(subgroup.zpowers σ) : set (perm α)) ≃ (↑(σ.support) : set α) :=
-equiv.of_bijective (λ τ, ⟨τ (classical.some hσ),
-begin
-  obtain ⟨τ, n, rfl⟩ := τ,
-  rw [finset.mem_coe, coe_fn_coe_base', subtype.coe_mk, zpow_apply_mem_support, mem_support],
-  exact (classical.some_spec hσ).1,
-end⟩)
-begin
-  split,
-  { rintros ⟨a, m, rfl⟩ ⟨b, n, rfl⟩ h,
-    ext y,
-    by_cases hy : σ y = y,
-    { simp_rw [subtype.coe_mk, zpow_apply_eq_self_of_apply_eq_self hy] },
-    { obtain ⟨i, rfl⟩ := (classical.some_spec hσ).2 y hy,
-      rw [subtype.coe_mk, subtype.coe_mk, zpow_apply_comm σ m i, zpow_apply_comm σ n i],
-      exact congr_arg _ (subtype.ext_iff.mp h) } }, by
-  { rintros ⟨y, hy⟩,
-    rw [finset.mem_coe, mem_support] at hy,
-    obtain ⟨n, rfl⟩ := (classical.some_spec hσ).2 y hy,
-    exact ⟨⟨σ ^ n, n, rfl⟩, rfl⟩ },
-end
-
-@[simp] lemma is_cycle.zpowers_equiv_support_apply {σ : perm α} (hσ : is_cycle σ) {n : ℕ} :
-  hσ.zpowers_equiv_support ⟨σ ^ n, n, rfl⟩ = ⟨(σ ^ n) (classical.some hσ),
-    pow_apply_mem_support.2 (mem_support.2 (classical.some_spec hσ).1)⟩ :=
-rfl
-
-@[simp] lemma is_cycle.zpowers_equiv_support_symm_apply {σ : perm α} (hσ : is_cycle σ) (n : ℕ) :
-  hσ.zpowers_equiv_support.symm ⟨(σ ^ n) (classical.some hσ),
-    pow_apply_mem_support.2 (mem_support.2 (classical.some_spec hσ).1)⟩ =
-    ⟨σ ^ n, n, rfl⟩ :=
-(equiv.symm_apply_eq _).2 hσ.zpowers_equiv_support_apply
-
-lemma order_of_is_cycle {σ : perm α} (hσ : is_cycle σ) : order_of σ = σ.support.card :=
-begin
-  rw [order_eq_card_zpowers, ←fintype.card_coe],
-  convert fintype.card_congr (is_cycle.zpowers_equiv_support hσ),
-end
-
-lemma is_cycle_swap_mul_aux₁ {α : Type*} [decidable_eq α] : ∀ (n : ℕ) {b x : α} {f : perm α}
-  (hb : (swap x (f x) * f) b ≠ b) (h : (f ^ n) (f x) = b),
-  ∃ i : ℤ, ((swap x (f x) * f) ^ i) (f x) = b
-| 0         := λ b x f hb h, ⟨0, h⟩
-| (n+1 : ℕ) := λ b x f hb h,
-  if hfbx : f x = b then ⟨0, hfbx⟩
-  else
-    have f b ≠ b ∧ b ≠ x, from ne_and_ne_of_swap_mul_apply_ne_self hb,
-    have hb' : (swap x (f x) * f) (f⁻¹ b) ≠ f⁻¹ b,
-      by { rw [mul_apply, apply_inv_self, swap_apply_of_ne_of_ne this.2 (ne.symm hfbx),
-          ne.def, ← f.injective.eq_iff, apply_inv_self],
-        exact this.1 },
-    let ⟨i, hi⟩ := is_cycle_swap_mul_aux₁ n hb'
-      (f.injective $ by { rw [apply_inv_self], rwa [pow_succ, mul_apply] at h }) in
-    ⟨i + 1, by rw [add_comm, zpow_add, mul_apply, hi, zpow_one, mul_apply, apply_inv_self,
-        swap_apply_of_ne_of_ne (ne_and_ne_of_swap_mul_apply_ne_self hb).2 (ne.symm hfbx)]⟩
-
-lemma is_cycle_swap_mul_aux₂ {α : Type*} [decidable_eq α] :
-  ∀ (n : ℤ) {b x : α} {f : perm α} (hb : (swap x (f x) * f) b ≠ b) (h : (f ^ n) (f x) = b),
-  ∃ i : ℤ, ((swap x (f x) * f) ^ i) (f x) = b
-| (n : ℕ) := λ b x f, is_cycle_swap_mul_aux₁ n
-| -[1+ n] := λ b x f hb h,
-  if hfbx' : f x = b then ⟨0, hfbx'⟩
-  else
-  have f b ≠ b ∧ b ≠ x := ne_and_ne_of_swap_mul_apply_ne_self hb,
-  have hb : (swap x (f⁻¹ x) * f⁻¹) (f⁻¹ b) ≠ f⁻¹ b,
-    by { rw [mul_apply, swap_apply_def],
-      split_ifs;
-      simp only [inv_eq_iff_eq, perm.mul_apply, zpow_neg_succ_of_nat, ne.def,
-        perm.apply_inv_self] at *;
-      cc },
-  let ⟨i, hi⟩ := is_cycle_swap_mul_aux₁ n hb
-    (show (f⁻¹ ^ n) (f⁻¹ x) = f⁻¹ b, by
-      rw [← zpow_coe_nat, ← h, ← mul_apply, ← mul_apply, ← mul_apply, zpow_neg_succ_of_nat,
-        ← inv_pow, pow_succ', mul_assoc, mul_assoc, inv_mul_self, mul_one, zpow_coe_nat,
-        ← pow_succ', ← pow_succ]) in
-  have h : (swap x (f⁻¹ x) * f⁻¹) (f x) = f⁻¹ x, by rw [mul_apply, inv_apply_self, swap_apply_left],
-  ⟨-i, by rw [← add_sub_cancel i 1, neg_sub, sub_eq_add_neg, zpow_add, zpow_one, zpow_neg,
-      ← inv_zpow, mul_inv_rev, swap_inv, mul_swap_eq_swap_mul, inv_apply_self, swap_comm _ x,
-      zpow_add, zpow_one, mul_apply, mul_apply (_ ^ i), h, hi, mul_apply, apply_inv_self,
-      swap_apply_of_ne_of_ne this.2 (ne.symm hfbx')]⟩
-
-lemma is_cycle.eq_swap_of_apply_apply_eq_self {α : Type*} [decidable_eq α]
-  {f : perm α} (hf : is_cycle f) {x : α}
-  (hfx : f x ≠ x) (hffx : f (f x) = x) : f = swap x (f x) :=
-equiv.ext $ λ y,
-let ⟨z, hz⟩ := hf in
-let ⟨i, hi⟩ := hz.2 x hfx in
-if hyx : y = x then by simp [hyx]
-else if hfyx : y = f x then by simp [hfyx, hffx]
-else begin
-  rw [swap_apply_of_ne_of_ne hyx hfyx],
-  refine by_contradiction (λ hy, _),
-  cases hz.2 y hy with j hj,
-  rw [← sub_add_cancel j i, zpow_add, mul_apply, hi] at hj,
-  cases zpow_apply_eq_of_apply_apply_eq_self hffx (j - i) with hji hji,
-  { rw [← hj, hji] at hyx, cc },
-  { rw [← hj, hji] at hfyx, cc }
-end
-
-lemma is_cycle.swap_mul {α : Type*} [decidable_eq α] {f : perm α} (hf : is_cycle f) {x : α}
-  (hx : f x ≠ x) (hffx : f (f x) ≠ x) : is_cycle (swap x (f x) * f) :=
-⟨f x, by { simp [swap_apply_def, mul_apply, if_neg hffx, f.injective.eq_iff, if_neg hx, hx], },
-  λ y hy,
-  let ⟨i, hi⟩ := hf.exists_zpow_eq hx (ne_and_ne_of_swap_mul_apply_ne_self hy).1 in
-  have hi : (f ^ (i - 1)) (f x) = y, from
-    calc (f ^ (i - 1)) (f x) = (f ^ (i - 1) * f ^ (1 : ℤ)) x : by rw [zpow_one, mul_apply]
-    ... = y : by rwa [← zpow_add, sub_add_cancel],
-  is_cycle_swap_mul_aux₂ (i - 1) hy hi⟩
-
-lemma is_cycle.sign : ∀ {f : perm α} (hf : is_cycle f),
-  sign f = -(-1) ^ f.support.card
-| f := λ hf,
-let ⟨x, hx⟩ := hf in
-calc sign f = sign (swap x (f x) * (swap x (f x) * f)) :
-  by rw [← mul_assoc, mul_def, mul_def, swap_swap, trans_refl]
-... = -(-1) ^ f.support.card :
-  if h1 : f (f x) = x
-  then
-    have h : swap x (f x) * f = 1,
-      begin
-        rw hf.eq_swap_of_apply_apply_eq_self hx.1 h1,
-        simp only [perm.mul_def, perm.one_def, swap_apply_left, swap_swap]
-      end,
-    by { rw [sign_mul, sign_swap hx.1.symm, h, sign_one, hf.eq_swap_of_apply_apply_eq_self hx.1 h1,
-      card_support_swap hx.1.symm], refl }
-  else
-    have h : card (support (swap x (f x) * f)) + 1 = card (support f),
-      by rw [← insert_erase (mem_support.2 hx.1), support_swap_mul_eq _ _ h1,
-        card_insert_of_not_mem (not_mem_erase _ _), sdiff_singleton_eq_erase],
-    have wf : card (support (swap x (f x) * f)) < card (support f),
-      from card_support_swap_mul hx.1,
-    by { rw [sign_mul, sign_swap hx.1.symm, (hf.swap_mul hx.1 h1).sign, ← h],
-      simp only [pow_add, mul_one, neg_neg, one_mul, mul_neg, eq_self_iff_true,
-        pow_one, neg_mul_neg] }
-using_well_founded {rel_tac := λ _ _, `[exact ⟨_, measure_wf (λ f, f.support.card)⟩]}
-
-lemma is_cycle_of_is_cycle_pow {σ : perm α} {n : ℕ}
-  (h1 : is_cycle (σ ^ n)) (h2 : σ.support ≤ (σ ^ n).support) : is_cycle σ :=
-begin
-  have key : ∀ x : α, (σ ^ n) x ≠ x ↔ σ x ≠ x,
-  { simp_rw [←mem_support],
-    exact finset.ext_iff.mp (le_antisymm (support_pow_le σ n) h2) },
-  obtain ⟨x, hx1, hx2⟩ := h1,
-  refine ⟨x, (key x).mp hx1, λ y hy, _⟩,
-  cases (hx2 y ((key y).mpr hy)) with i _,
-  exact ⟨n * i, by rwa zpow_mul⟩
-end
-
--- The lemma `support_zpow_le` is relevant. It means that `h2` is equivalent to
--- `σ.support = (σ ^ n).support`, as well as to `σ.support.card ≤ (σ ^ n).support.card`.
-lemma is_cycle_of_is_cycle_zpow {σ : perm α} {n : ℤ}
-  (h1 : is_cycle (σ ^ n)) (h2 : σ.support ≤ (σ ^ n).support) : is_cycle σ :=
-begin
-  cases n,
-  { exact is_cycle_of_is_cycle_pow h1 h2 },
-  { simp only [le_eq_subset, zpow_neg_succ_of_nat, perm.support_inv] at h1 h2,
-    simpa using is_cycle_of_is_cycle_pow h1.inv h2 }
-end
-
-lemma is_cycle.extend_domain {α : Type*} {p : β → Prop} [decidable_pred p]
-  (f : α ≃ subtype p) {g : perm α} (h : is_cycle g) :
-  is_cycle (g.extend_domain f) :=
-begin
-  obtain ⟨a, ha, ha'⟩ := h,
-  refine ⟨f a, _, λ b hb, _⟩,
-  { rw extend_domain_apply_image,
-    exact λ con, ha (f.injective (subtype.coe_injective con)) },
-  by_cases pb : p b,
-  { obtain ⟨i, hi⟩ := ha' (f.symm ⟨b, pb⟩) (λ con, hb _),
-    { refine ⟨i, _⟩,
-      have hnat : ∀ (k : ℕ) (a : α), (g.extend_domain f ^ k) ↑(f a) = f ((g ^ k) a),
-      { intros k a,
-        induction k with k ih, { refl },
-        rw [pow_succ, perm.mul_apply, ih, extend_domain_apply_image, pow_succ, perm.mul_apply] },
-      have hint : ∀ (k : ℤ) (a : α), (g.extend_domain f ^ k) ↑(f a) = f ((g ^ k) a),
-      { intros k a,
-        induction k with k k,
-        { rw [zpow_of_nat, zpow_of_nat, hnat] },
-        rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_eq_iff_eq, hnat, apply_inv_self] },
-      rw [hint, hi, apply_symm_apply, subtype.coe_mk] },
-    { rw [extend_domain_apply_subtype _ _ pb, con, apply_symm_apply, subtype.coe_mk] } },
-  { exact (hb (extend_domain_apply_not_subtype _ _ pb)).elim }
-end
-
-lemma nodup_of_pairwise_disjoint_cycles {l : list (perm β)} (h1 : ∀ f ∈ l, is_cycle f)
-  (h2 : l.pairwise disjoint) : l.nodup :=
-nodup_of_pairwise_disjoint (λ h, (h1 1 h).ne_one rfl) h2
-
-end sign_cycle
-
-/-!
-### `same_cycle`
--/
-
-/-- The equivalence relation indicating that two points are in the same cycle of a permutation. -/
-def same_cycle (f : perm β) (x y : β) : Prop := ∃ i : ℤ, (f ^ i) x = y
-
-@[refl] lemma same_cycle.refl (f : perm β) (x : β) : same_cycle f x x := ⟨0, rfl⟩
-
-@[symm] lemma same_cycle.symm {f : perm β} {x y : β} : same_cycle f x y → same_cycle f y x :=
-λ ⟨i, hi⟩, ⟨-i, by rw [zpow_neg, ← hi, inv_apply_self]⟩
-
-@[trans] lemma same_cycle.trans {f : perm β} {x y z : β} :
-  same_cycle f x y → same_cycle f y z → same_cycle f x z :=
-λ ⟨i, hi⟩ ⟨j, hj⟩, ⟨j + i, by rw [zpow_add, mul_apply, hi, hj]⟩
-
-lemma same_cycle.apply_eq_self_iff {f : perm β} {x y : β} :
-  same_cycle f x y → (f x = x ↔ f y = y) :=
-λ ⟨i, hi⟩, by rw [← hi, ← mul_apply, ← zpow_one_add, add_comm, zpow_add_one, mul_apply,
-    (f ^ i).injective.eq_iff]
-
-lemma is_cycle.same_cycle {f : perm β} (hf : is_cycle f) {x y : β}
-  (hx : f x ≠ x) (hy : f y ≠ y) : same_cycle f x y :=
-hf.exists_zpow_eq hx hy
-
-lemma same_cycle.nat' [fintype β] {f : perm β} {x y : β} (h : same_cycle f x y) :
-  ∃ (i : ℕ) (h : i < order_of f), (f ^ i) x = y :=
-begin
-  classical,
-  obtain ⟨k, rfl⟩ := h,
-  use ((k % order_of f).nat_abs),
-  have h₀ := int.coe_nat_pos.mpr (order_of_pos f),
-  have h₁ := int.mod_nonneg k h₀.ne',
-  rw [←zpow_coe_nat, int.nat_abs_of_nonneg h₁, ←zpow_eq_mod_order_of],
-  refine ⟨_, rfl⟩,
-  rw [←int.coe_nat_lt, int.nat_abs_of_nonneg h₁],
-  exact int.mod_lt_of_pos _ h₀,
-end
-
-lemma same_cycle.nat'' [fintype β] {f : perm β} {x y : β} (h : same_cycle f x y) :
-  ∃ (i : ℕ) (hpos : 0 < i) (h : i ≤ order_of f), (f ^ i) x = y :=
-begin
-  classical,
-  obtain ⟨_|i, hi, rfl⟩ := h.nat',
-  { refine ⟨order_of f, order_of_pos f, le_rfl, _⟩,
-    rw [pow_order_of_eq_one, pow_zero] },
-  { exact ⟨i.succ, i.zero_lt_succ, hi.le, rfl⟩ }
-end
-
-instance [fintype α] (f : perm α) : decidable_rel (same_cycle f) :=
-λ x y, decidable_of_iff (∃ n ∈ list.range (fintype.card (perm α)), (f ^ n) x = y)
-⟨λ ⟨n, _, hn⟩, ⟨n, hn⟩, λ ⟨i, hi⟩, ⟨(i % order_of f).nat_abs, list.mem_range.2
-  (int.coe_nat_lt.1 $
-    by { rw int.nat_abs_of_nonneg (int.mod_nonneg _
-        (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))),
-      { apply lt_of_lt_of_le (int.mod_lt _ (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))),
-        { simp [order_of_le_card_univ] },
-        exact fintype_perm },
-      exact fintype_perm, }),
-  by { rw [← zpow_coe_nat, int.nat_abs_of_nonneg (int.mod_nonneg _
-      (int.coe_nat_ne_zero_iff_pos.2 (order_of_pos _))), ← zpow_eq_mod_order_of, hi],
-    exact fintype_perm }⟩⟩
-
-lemma same_cycle_apply {f : perm β} {x y : β} : same_cycle f x (f y) ↔ same_cycle f x y :=
-⟨λ ⟨i, hi⟩, ⟨-1 + i, by rw [zpow_add, mul_apply, hi, zpow_neg_one, inv_apply_self]⟩,
- λ ⟨i, hi⟩, ⟨1 + i, by rw [zpow_add, mul_apply, hi, zpow_one]⟩⟩
-
-lemma same_cycle_cycle {f : perm β} {x : β} (hx : f x ≠ x) : is_cycle f ↔
-  (∀ {y}, same_cycle f x y ↔ f y ≠ y) :=
-⟨λ hf y, ⟨λ ⟨i, hi⟩ hy, hx $
-    by { rw [← zpow_apply_eq_self_of_apply_eq_self hy i, (f ^ i).injective.eq_iff] at hi,
-      rw [hi, hy] },
-  hf.exists_zpow_eq hx⟩,
-  λ h, ⟨x, hx, λ y hy, h.2 hy⟩⟩
-
-lemma same_cycle_inv (f : perm β) {x y : β} : same_cycle f⁻¹ x y ↔ same_cycle f x y :=
-⟨λ ⟨i, hi⟩, ⟨-i, by rw [zpow_neg, ← inv_zpow, hi]⟩,
- λ ⟨i, hi⟩, ⟨-i, by rw [zpow_neg, ← inv_zpow, inv_inv, hi]⟩ ⟩
-
-lemma same_cycle_inv_apply {f : perm β} {x y : β} : same_cycle f x (f⁻¹ y) ↔ same_cycle f x y :=
-by rw [← same_cycle_inv, same_cycle_apply, same_cycle_inv]
-
-@[simp] lemma same_cycle_pow_left_iff {f : perm β} {x y : β} {n : ℕ} :
-  same_cycle f ((f ^ n) x) y ↔ same_cycle f x y :=
-begin
-  split,
-  { rintro ⟨k, rfl⟩,
-    use (k + n),
-    simp [zpow_add] },
-  { rintro ⟨k, rfl⟩,
-    use (k - n),
-    rw [←zpow_coe_nat, ←mul_apply, ←zpow_add, int.sub_add_cancel] }
-end
-
-@[simp] lemma same_cycle_zpow_left_iff {f : perm β} {x y : β} {n : ℤ} :
-  same_cycle f ((f ^ n) x) y ↔ same_cycle f x y :=
-begin
-  cases n,
-  { exact same_cycle_pow_left_iff },
-  { rw [zpow_neg_succ_of_nat, ←inv_pow, ←same_cycle_inv, same_cycle_pow_left_iff, same_cycle_inv] }
-end
-
-/-- Unlike `support_congr`, which assumes that `∀ (x ∈ g.support), f x = g x)`, here
-we have the weaker assumption that `∀ (x ∈ f.support), f x = g x`. -/
-lemma is_cycle.support_congr [fintype α] {f g : perm α} (hf : is_cycle f) (hg : is_cycle g)
-  (h : f.support ⊆ g.support) (h' : ∀ (x ∈ f.support), f x = g x) : f = g :=
-begin
-  have : f.support = g.support,
-  { refine le_antisymm h _,
-    intros z hz,
-    obtain ⟨x, hx, hf'⟩ := id hf,
-    have hx' : g x ≠ x,
-    { rwa [←h' x (mem_support.mpr hx)] },
-    obtain ⟨m, hm⟩ := hg.exists_pow_eq hx' (mem_support.mp hz),
-    have h'' : ∀ (x ∈ f.support ∩ g.support), f x = g x,
-    { intros x hx,
-      exact h' x (mem_of_mem_inter_left hx) },
-    rwa [←hm, ←pow_eq_on_of_mem_support h'' _ x (mem_inter_of_mem (mem_support.mpr hx)
-          (mem_support.mpr hx')), pow_apply_mem_support, mem_support] },
-  refine support_congr h _,
-  simpa [←this] using h'
-end
-
-/-- If two cyclic permutations agree on all terms in their intersection,
-and that intersection is not empty, then the two cyclic permutations must be equal. -/
-lemma is_cycle.eq_on_support_inter_nonempty_congr [fintype α] {f g : perm α}
-  (hf : is_cycle f) (hg : is_cycle g) (h : ∀ (x ∈ f.support ∩ g.support), f x = g x) {x : α}
-  (hx : f x = g x) (hx' : x ∈ f.support) : f = g :=
-begin
-  have hx'' : x ∈ g.support,
-  { rwa [mem_support, ←hx, ←mem_support] },
-  have : f.support ⊆ g.support,
-  { intros y hy,
-    obtain ⟨k, rfl⟩ := hf.exists_pow_eq (mem_support.mp hx') (mem_support.mp hy),
-    rwa [pow_eq_on_of_mem_support h _ _ (mem_inter_of_mem hx' hx''), pow_apply_mem_support] },
-  rw (inter_eq_left_iff_subset _ _).mpr this at h,
-  exact hf.support_congr hg this h
-end
-
-lemma is_cycle.support_pow_eq_iff [fintype α] {f : perm α} (hf : is_cycle f) {n : ℕ} :
-  support (f ^ n) = support f ↔ ¬ order_of f ∣ n :=
-begin
-  rw order_of_dvd_iff_pow_eq_one,
-  split,
-  { intros h H,
-    refine hf.ne_one _,
-    rw [←support_eq_empty_iff, ←h, H, support_one] },
-  { intro H,
-    apply le_antisymm (support_pow_le _ n) _,
-    intros x hx,
-    contrapose! H,
-    ext z,
-    by_cases hz : f z = z,
-    { rw [pow_apply_eq_self_of_apply_eq_self hz, one_apply] },
-    { obtain ⟨k, rfl⟩ := hf.exists_pow_eq hz (mem_support.mp hx),
-      apply (f ^ k).injective,
-      rw [←mul_apply, (commute.pow_pow_self _ _ _).eq, mul_apply],
-      simpa using H } }
-end
-
-lemma is_cycle.pow_iff [fintype β] {f : perm β} (hf : is_cycle f) {n : ℕ} :
-  is_cycle (f ^ n) ↔ n.coprime (order_of f) :=
-begin
-  classical,
-  split,
-  { intro h,
-    have hr : support (f ^ n) = support f,
-    { rw hf.support_pow_eq_iff,
-      rintro ⟨k, rfl⟩,
-      refine h.ne_one _,
-      simp [pow_mul, pow_order_of_eq_one] },
-    have : order_of (f ^ n) = order_of f,
-    { rw [order_of_is_cycle h, hr, order_of_is_cycle hf] },
-    rw [order_of_pow, nat.div_eq_self] at this,
-    cases this,
-    { exact absurd this (order_of_pos _).ne' },
-    { rwa [nat.coprime_iff_gcd_eq_one, nat.gcd_comm] } },
-  { intro h,
-    obtain ⟨m, hm⟩ := exists_pow_eq_self_of_coprime h,
-    have hf' : is_cycle ((f ^ n) ^ m) := by rwa hm,
-    refine is_cycle_of_is_cycle_pow hf' _,
-    intros x hx,
-    rw [hm],
-    exact support_pow_le _ n hx }
-end
-
-lemma is_cycle.pow_eq_one_iff [fintype α] {f : perm α} (hf : is_cycle f) {n : ℕ} :
-  f ^ n = 1 ↔ ∃ (x ∈ f.support), (f ^ n) x = x :=
-begin
-  split,
-  { intro h,
-    obtain ⟨x, hx, -⟩ := id hf,
-    exact ⟨x, mem_support.mpr hx, by simp [h]⟩ },
-  { rintro ⟨x, hx, hx'⟩,
-    by_cases h : support (f ^ n) = support f,
-    { rw [←h, mem_support] at hx,
-      contradiction },
-    { rw [hf.support_pow_eq_iff, not_not] at h,
-      obtain ⟨k, rfl⟩ := h,
-      rw [pow_mul, pow_order_of_eq_one, one_pow] } }
-end
-
-lemma is_cycle.mem_support_pos_pow_iff_of_lt_order_of [fintype α] {f : perm α} (hf : is_cycle f)
-  {n : ℕ} (npos : 0 < n) (hn : n < order_of f) {x : α} :
-  x ∈ (f ^ n).support ↔ x ∈ f.support :=
-begin
-  have : ¬ order_of f ∣ n := nat.not_dvd_of_pos_of_lt npos hn,
-  rw ←hf.support_pow_eq_iff at this,
-  rw this
-end
-
-lemma is_cycle.is_cycle_pow_pos_of_lt_prime_order [fintype β] {f : perm β} (hf : is_cycle f)
-  (hf' : (order_of f).prime) (n : ℕ) (hn : 0 < n) (hn' : n < order_of f) : is_cycle (f ^ n) :=
-begin
-  classical,
-  have : n.coprime (order_of f),
-  { refine nat.coprime.symm _,
-    rw nat.prime.coprime_iff_not_dvd hf',
-    exact nat.not_dvd_of_pos_of_lt hn hn' },
-  obtain ⟨m, hm⟩ := exists_pow_eq_self_of_coprime this,
-  have hf'' := hf,
-  rw ←hm at hf'',
-  refine is_cycle_of_is_cycle_pow hf'' _,
-  rw [hm],
-  exact support_pow_le f n
-end
-
-
-/-!
-### `cycle_of`
--/
-
-/-- `f.cycle_of x` is the cycle of the permutation `f` to which `x` belongs. -/
-def cycle_of [fintype α] (f : perm α) (x : α) : perm α :=
-of_subtype (@subtype_perm _ f (same_cycle f x) (λ _, same_cycle_apply.symm))
-
-lemma cycle_of_apply [fintype α] (f : perm α) (x y : α) :
-  cycle_of f x y = if same_cycle f x y then f y else y := rfl
-
-lemma cycle_of_inv [fintype α] (f : perm α) (x : α) :
-  (cycle_of f x)⁻¹ = cycle_of f⁻¹ x :=
-equiv.ext $ λ y, begin
-  rw [inv_eq_iff_eq, cycle_of_apply, cycle_of_apply],
-  split_ifs; simp [*, same_cycle_inv, same_cycle_inv_apply] at *
-end
-
-@[simp] lemma cycle_of_pow_apply_self [fintype α] (f : perm α) (x : α) :
-  ∀ n : ℕ, (cycle_of f x ^ n) x = (f ^ n) x
-| 0     := rfl
-| (n+1) := by { rw [pow_succ, mul_apply, cycle_of_apply,
-    cycle_of_pow_apply_self, if_pos, pow_succ, mul_apply],
-  exact ⟨n, rfl⟩ }
-
-@[simp] lemma cycle_of_zpow_apply_self [fintype α] (f : perm α) (x : α) :
-  ∀ n : ℤ, (cycle_of f x ^ n) x = (f ^ n) x
-| (n : ℕ) := cycle_of_pow_apply_self f x n
-| -[1+ n] := by rw [zpow_neg_succ_of_nat, ← inv_pow, cycle_of_inv,
-  zpow_neg_succ_of_nat, ← inv_pow, cycle_of_pow_apply_self]
-
-lemma same_cycle.cycle_of_apply [fintype α] {f : perm α} {x y : α} (h : same_cycle f x y) :
-  cycle_of f x y = f y := dif_pos h
-
-lemma cycle_of_apply_of_not_same_cycle [fintype α] {f : perm α} {x y : α} (h : ¬same_cycle f x y) :
-  cycle_of f x y = y := dif_neg h
-
-lemma same_cycle.cycle_of_eq [fintype α] {f : perm α} {x y : α} (h : same_cycle f x y) :
-  cycle_of f x = cycle_of f y :=
-begin
-  ext z,
-  rw cycle_of_apply,
-  split_ifs with hz hz,
-  { exact (h.symm.trans hz).cycle_of_apply.symm },
-  { exact (cycle_of_apply_of_not_same_cycle (mt h.trans hz)).symm }
-end
-
-@[simp] lemma cycle_of_apply_apply_zpow_self [fintype α] (f : perm α) (x : α) (k : ℤ) :
-  cycle_of f x ((f ^ k) x) = (f ^ (k + 1)) x :=
-begin
-  rw same_cycle.cycle_of_apply,
-  { rw [add_comm, zpow_add, zpow_one, mul_apply] },
-  { exact ⟨k, rfl⟩ }
-end
-
-@[simp] lemma cycle_of_apply_apply_pow_self [fintype α] (f : perm α) (x : α) (k : ℕ) :
-  cycle_of f x ((f ^ k) x) = (f ^ (k + 1)) x :=
-by convert cycle_of_apply_apply_zpow_self f x k using 1
-
-@[simp] lemma cycle_of_apply_apply_self [fintype α] (f : perm α) (x : α) :
-  cycle_of f x (f x) = f (f x) :=
-by convert cycle_of_apply_apply_pow_self f x 1 using 1
-
-@[simp] lemma cycle_of_apply_self [fintype α] (f : perm α) (x : α) :
-  cycle_of f x x = f x := (same_cycle.refl _ _).cycle_of_apply
-
-lemma is_cycle.cycle_of_eq [fintype α] {f : perm α} (hf : is_cycle f) {x : α} (hx : f x ≠ x) :
-  cycle_of f x = f :=
-equiv.ext $ λ y,
-  if h : same_cycle f x y then by rw [h.cycle_of_apply]
-  else by rw [cycle_of_apply_of_not_same_cycle h, not_not.1 (mt ((same_cycle_cycle hx).1 hf).2 h)]
-
-@[simp] lemma cycle_of_eq_one_iff [fintype α] (f : perm α) {x : α} : cycle_of f x = 1 ↔ f x = x :=
-begin
-  simp_rw [ext_iff, cycle_of_apply, one_apply],
-  refine ⟨λ h, (if_pos (same_cycle.refl f x)).symm.trans (h x), λ h y, _⟩,
-  by_cases hy : f y = y,
-  { rw [hy, if_t_t] },
-  { exact if_neg (mt same_cycle.apply_eq_self_iff (by tauto)) },
-end
-
-@[simp] lemma cycle_of_self_apply [fintype α] (f : perm α) (x : α) :
-  cycle_of f (f x) = cycle_of f x :=
-(same_cycle_apply.mpr (same_cycle.refl _ _)).symm.cycle_of_eq
-
-@[simp] lemma cycle_of_self_apply_pow [fintype α] (f : perm α) (n : ℕ) (x : α) :
-  cycle_of f ((f ^ n) x) = cycle_of f x :=
-(same_cycle_pow_left_iff.mpr (same_cycle.refl _ _)).cycle_of_eq
-
-@[simp] lemma cycle_of_self_apply_zpow [fintype α] (f : perm α) (n : ℤ) (x : α) :
-  cycle_of f ((f ^ n) x) = cycle_of f x :=
-(same_cycle_zpow_left_iff.mpr (same_cycle.refl _ _)).cycle_of_eq
-
-lemma is_cycle.cycle_of [fintype α] {f : perm α} (hf : is_cycle f) {x : α} :
-  cycle_of f x = if f x = x then 1 else f :=
-begin
-  by_cases hx : f x = x,
-  { rwa [if_pos hx, cycle_of_eq_one_iff] },
-  { rwa [if_neg hx, hf.cycle_of_eq] },
-end
-
-lemma cycle_of_one [fintype α] (x : α) : cycle_of 1 x = 1 :=
-(cycle_of_eq_one_iff 1).mpr rfl
-
-lemma is_cycle_cycle_of [fintype α] (f : perm α) {x : α} (hx : f x ≠ x) : is_cycle (cycle_of f x) :=
-have cycle_of f x x ≠ x, by rwa [(same_cycle.refl _ _).cycle_of_apply],
-(same_cycle_cycle this).2 $ λ y,
-⟨λ h, mt h.apply_eq_self_iff.2 this,
-  λ h, if hxy : same_cycle f x y then
-  let ⟨i, hi⟩ := hxy in
-  ⟨i, by rw [cycle_of_zpow_apply_self, hi]⟩
-  else by { rw [cycle_of_apply_of_not_same_cycle hxy] at h, exact (h rfl).elim }⟩
-
-@[simp] lemma two_le_card_support_cycle_of_iff [fintype α] {f : perm α} {x : α} :
-  2 ≤ card (cycle_of f x).support ↔ f x ≠ x :=
-begin
-  refine ⟨λ h, _, λ h, by simpa using (is_cycle_cycle_of _ h).two_le_card_support⟩,
-  contrapose! h,
-  rw ←cycle_of_eq_one_iff at h,
-  simp [h]
-end
-
-@[simp] lemma card_support_cycle_of_pos_iff [fintype α] {f : perm α} {x : α} :
-  0 < card (cycle_of f x).support ↔ f x ≠ x :=
-begin
-  rw [←two_le_card_support_cycle_of_iff, ←nat.succ_le_iff],
-  exact ⟨λ h, or.resolve_left h.eq_or_lt (card_support_ne_one _).symm, zero_lt_two.trans_le⟩
-end
-
-lemma pow_apply_eq_pow_mod_order_of_cycle_of_apply [fintype α] (f : perm α) (n : ℕ) (x : α) :
-  (f ^ n) x = (f ^ (n % order_of (cycle_of f x))) x :=
-by rw [←cycle_of_pow_apply_self f, ←cycle_of_pow_apply_self f, pow_eq_mod_order_of]
-
-lemma cycle_of_mul_of_apply_right_eq_self [fintype α] {f g : perm α}
-  (h : _root_.commute f g) (x : α) (hx : g x = x) : (f * g).cycle_of x = f.cycle_of x :=
-begin
-  ext y,
-  by_cases hxy : (f * g).same_cycle x y,
-  { obtain ⟨z, rfl⟩ := hxy,
-    rw cycle_of_apply_apply_zpow_self,
-    simp [h.mul_zpow, zpow_apply_eq_self_of_apply_eq_self hx] },
-  { rw [cycle_of_apply_of_not_same_cycle hxy, cycle_of_apply_of_not_same_cycle],
-    contrapose! hxy,
-    obtain ⟨z, rfl⟩ := hxy,
-    refine ⟨z, _⟩,
-    simp [h.mul_zpow, zpow_apply_eq_self_of_apply_eq_self hx] }
-end
-
-lemma disjoint.cycle_of_mul_distrib [fintype α] {f g : perm α} (h : f.disjoint g) (x : α) :
-  (f * g).cycle_of x = (f.cycle_of x * g.cycle_of x) :=
-begin
-  cases (disjoint_iff_eq_or_eq.mp h) x with hfx hgx,
-  { simp [h.commute.eq, cycle_of_mul_of_apply_right_eq_self h.symm.commute, hfx] },
-  { simp [cycle_of_mul_of_apply_right_eq_self h.commute, hgx] }
-end
-
-lemma support_cycle_of_eq_nil_iff [fintype α] {f : perm α} {x : α} :
-  (f.cycle_of x).support = ∅ ↔ x ∉ f.support :=
-by simp
-
-lemma support_cycle_of_le [fintype α] (f : perm α) (x : α) :
-  support (f.cycle_of x) ≤ support f :=
-begin
-  intros y hy,
-  rw [mem_support, cycle_of_apply] at hy,
-  split_ifs at hy,
-  { exact mem_support.mpr hy },
-  { exact absurd rfl hy }
-end
-
-lemma mem_support_cycle_of_iff [fintype α] {f : perm α} {x y : α} :
-  y ∈ support (f.cycle_of x) ↔ same_cycle f x y ∧ x ∈ support f :=
-begin
-  by_cases hx : f x = x,
-  { rw (cycle_of_eq_one_iff _).mpr hx,
-    simp [hx] },
-  { rw [mem_support, cycle_of_apply],
-    split_ifs with hy,
-    { simp only [hx, hy, iff_true, ne.def, not_false_iff, and_self, mem_support],
-      rcases hy with ⟨k, rfl⟩,
-      rw ←not_mem_support,
-      simpa using hx },
-    { simpa [hx] using hy } }
-end
-
-lemma same_cycle.mem_support_iff [fintype α] {f : perm α} {x y : α} (h : same_cycle f x y) :
-  x ∈ support f ↔ y ∈ support f :=
-⟨λ hx, support_cycle_of_le f x (mem_support_cycle_of_iff.mpr ⟨h, hx⟩),
- λ hy, support_cycle_of_le f y (mem_support_cycle_of_iff.mpr ⟨h.symm, hy⟩)⟩
-
-lemma pow_mod_card_support_cycle_of_self_apply [fintype α] (f : perm α) (n : ℕ) (x : α) :
-  (f ^ (n % (f.cycle_of x).support.card)) x = (f ^ n) x :=
-begin
-  by_cases hx : f x = x,
-  { rw [pow_apply_eq_self_of_apply_eq_self hx, pow_apply_eq_self_of_apply_eq_self hx] },
-  { rw [←cycle_of_pow_apply_self, ←cycle_of_pow_apply_self f,
-        ←order_of_is_cycle (is_cycle_cycle_of f hx), ←pow_eq_mod_order_of] }
-end
-
-/-- x is in the support of f iff cycle_of f x is a cycle.-/
-lemma is_cycle_cycle_of_iff [fintype α] (f : perm α) {x : α} :
-  is_cycle (cycle_of f x) ↔ (f x ≠ x) :=
-begin
-  split,
-  { intro hx, rw ne.def, rw ← cycle_of_eq_one_iff f,
-    exact equiv.perm.is_cycle.ne_one hx, },
-  { intro hx,
-    apply equiv.perm.is_cycle_cycle_of, exact hx }
-end
-
-
-/-!
-### `cycle_factors`
--/
-
-/-- Given a list `l : list α` and a permutation `f : perm α` whose nonfixed points are all in `l`,
-  recursively factors `f` into cycles. -/
-def cycle_factors_aux [fintype α] : Π (l : list α) (f : perm α),
-  (∀ {x}, f x ≠ x → x ∈ l) →
-  {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint}
-| []     f h := ⟨[], by { simp only [imp_false, list.pairwise.nil, list.not_mem_nil, forall_const,
-    and_true, forall_prop_of_false, not_not, not_false_iff, list.prod_nil] at *,
-  ext, simp * }⟩
-| (x::l) f h :=
-if hx : f x = x then
-  cycle_factors_aux l f (λ y hy, list.mem_of_ne_of_mem (λ h, hy (by rwa h)) (h hy))
-else let ⟨m, hm₁, hm₂, hm₃⟩ := cycle_factors_aux l ((cycle_of f x)⁻¹ * f)
-  (λ y hy, list.mem_of_ne_of_mem
-    (λ h : y = x,
-      by { rw [h, mul_apply, ne.def, inv_eq_iff_eq, cycle_of_apply_self] at hy, exact hy rfl })
-    (h (λ h : f y = y, by { rw [mul_apply, h, ne.def, inv_eq_iff_eq, cycle_of_apply] at hy,
-        split_ifs at hy; cc }))) in
-    ⟨(cycle_of f x) :: m, by { rw [list.prod_cons, hm₁], simp },
-      λ g hg, ((list.mem_cons_iff _ _ _).1 hg).elim (λ hg, hg.symm ▸ is_cycle_cycle_of _ hx)
-        (hm₂ g),
-      list.pairwise_cons.2 ⟨λ g hg y,
-        or_iff_not_imp_left.2 (λ hfy,
-          have hxy : same_cycle f x y := not_not.1 (mt cycle_of_apply_of_not_same_cycle hfy),
-          have hgm : g :: m.erase g ~ m := list.cons_perm_iff_perm_erase.2 ⟨hg, list.perm.refl _⟩,
-          have ∀ h ∈ m.erase g, disjoint g h, from
-            (list.pairwise_cons.1 ((hgm.pairwise_iff (λ a b (h : disjoint a b), h.symm)).2 hm₃)).1,
-          classical.by_cases id $ λ hgy : g y ≠ y,
-            (disjoint_prod_right _ this y).resolve_right $
-            have hsc : same_cycle f⁻¹ x (f y), by rwa [same_cycle_inv, same_cycle_apply],
-            by { rw [disjoint_prod_perm hm₃ hgm.symm, list.prod_cons,
-                ← eq_inv_mul_iff_mul_eq] at hm₁,
-              rwa [hm₁, mul_apply, mul_apply, cycle_of_inv, hsc.cycle_of_apply,
-                inv_apply_self, inv_eq_iff_eq, eq_comm] }),
-        hm₃⟩⟩
-
-lemma mem_list_cycles_iff {α : Type*} [fintype α] {l : list (perm α)}
-  (h1 : ∀ σ : perm α, σ ∈ l → σ.is_cycle)
-  (h2 : l.pairwise disjoint) {σ : perm α} :
-  σ ∈ l ↔ σ.is_cycle ∧ ∀ (a : α) (h4 : σ a ≠ a), σ a = l.prod a :=
-begin
-  suffices : σ.is_cycle → (σ ∈ l ↔ ∀ (a : α) (h4 : σ a ≠ a), σ a = l.prod a),
-  { exact ⟨λ hσ, ⟨h1 σ hσ, (this (h1 σ hσ)).mp hσ⟩, λ hσ, (this hσ.1).mpr hσ.2⟩ },
-  intro h3,
-  classical,
-  split,
-  { intros h a ha,
-    exact eq_on_support_mem_disjoint h h2 _ (mem_support.mpr ha) },
-  { intros h,
-    have hσl : σ.support ⊆ l.prod.support,
-    { intros x hx,
-      rw mem_support at hx,
-      rwa [mem_support, ←h _ hx] },
-    obtain ⟨a, ha, -⟩ := id h3,
-    rw ←mem_support at ha,
-    obtain ⟨τ, hτ, hτa⟩ := exists_mem_support_of_mem_support_prod (hσl ha),
-    have hτl : ∀ (x ∈ τ.support), τ x = l.prod x := eq_on_support_mem_disjoint hτ h2,
-    have key : ∀ (x ∈ σ.support ∩ τ.support), σ x = τ x,
-    { intros x hx,
-      rw [h x (mem_support.mp (mem_of_mem_inter_left hx)), hτl x (mem_of_mem_inter_right hx)] },
-    convert hτ,
-    refine h3.eq_on_support_inter_nonempty_congr (h1 _ hτ) key _ ha,
-    exact key a (mem_inter_of_mem ha hτa) }
-end
-
-lemma list_cycles_perm_list_cycles {α : Type*} [fintype α] {l₁ l₂ : list (perm α)}
-  (h₀ : l₁.prod = l₂.prod)
-  (h₁l₁ : ∀ σ : perm α, σ ∈ l₁ → σ.is_cycle) (h₁l₂ : ∀ σ : perm α, σ ∈ l₂ → σ.is_cycle)
-  (h₂l₁ : l₁.pairwise disjoint) (h₂l₂ : l₂.pairwise disjoint) :
-  l₁ ~ l₂ :=
-begin
-  classical,
-  refine (list.perm_ext (nodup_of_pairwise_disjoint_cycles h₁l₁ h₂l₁)
-    (nodup_of_pairwise_disjoint_cycles h₁l₂ h₂l₂)).mpr (λ σ, _),
-  by_cases hσ : σ.is_cycle,
-  { obtain ⟨a, ha⟩ := not_forall.mp (mt ext hσ.ne_one),
-    rw [mem_list_cycles_iff h₁l₁ h₂l₁, mem_list_cycles_iff h₁l₂ h₂l₂, h₀] },
-  { exact iff_of_false (mt (h₁l₁ σ) hσ) (mt (h₁l₂ σ) hσ) }
-end
-
-/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`. -/
-def cycle_factors [fintype α] [linear_order α] (f : perm α) :
-  {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint} :=
-cycle_factors_aux (univ.sort (≤)) f (λ _ _, (mem_sort _).2 (mem_univ _))
-
-/-- Factors a permutation `f` into a list of disjoint cyclic permutations that multiply to `f`,
-  without a linear order. -/
-def trunc_cycle_factors [fintype α] (f : perm α) :
-  trunc {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint} :=
-quotient.rec_on_subsingleton (@univ α _).1
-  (λ l h, trunc.mk (cycle_factors_aux l f h))
-  (show ∀ x, f x ≠ x → x ∈ (@univ α _).1, from λ _ _, mem_univ _)
-
-section cycle_factors_finset
-
-variables [fintype α] (f : perm α)
-
-/-- Factors a permutation `f` into a `finset` of disjoint cyclic permutations that multiply to `f`.
--/
-def cycle_factors_finset : finset (perm α) :=
-(trunc_cycle_factors f).lift
-  (λ (l : {l : list (perm α) // l.prod = f ∧ (∀ g ∈ l, is_cycle g) ∧ l.pairwise disjoint}),
-    l.val.to_finset) (λ ⟨l, hl⟩ ⟨l', hl'⟩, list.to_finset_eq_of_perm _ _
-      (list_cycles_perm_list_cycles (hl'.left.symm ▸ hl.left) hl.right.left (hl'.right.left)
-        hl.right.right hl'.right.right))
-
-lemma cycle_factors_finset_eq_list_to_finset {σ : perm α} {l : list (perm α)} (hn : l.nodup) :
-  σ.cycle_factors_finset = l.to_finset ↔ (∀ f : perm α, f ∈ l → f.is_cycle) ∧
-    l.pairwise disjoint ∧ l.prod = σ :=
-begin
-  obtain ⟨⟨l', hp', hc', hd'⟩, hl⟩ := trunc.exists_rep σ.trunc_cycle_factors,
-  have ht : cycle_factors_finset σ = l'.to_finset,
-  { rw [cycle_factors_finset, ←hl, trunc.lift_mk] },
-  rw ht,
-  split,
-  { intro h,
-    have hn' : l'.nodup := nodup_of_pairwise_disjoint_cycles hc' hd',
-    have hperm : l ~ l' := list.perm_of_nodup_nodup_to_finset_eq hn hn' h.symm,
-    refine ⟨_, _, _⟩,
-    { exact λ _ h, hc' _ (hperm.subset h)},
-    { rwa list.perm.pairwise_iff disjoint.symmetric hperm },
-    { rw [←hp', hperm.symm.prod_eq'],
-      refine hd'.imp _,
-      exact λ _ _, disjoint.commute } },
-  { rintro ⟨hc, hd, hp⟩,
-    refine list.to_finset_eq_of_perm _ _ _,
-    refine list_cycles_perm_list_cycles _ hc' hc hd' hd,
-    rw [hp, hp'] }
-end
-
-lemma cycle_factors_finset_eq_finset {σ : perm α} {s : finset (perm α)} :
-  σ.cycle_factors_finset = s ↔ (∀ f : perm α, f ∈ s → f.is_cycle) ∧
-    (∃ h : (∀ (a ∈ s) (b ∈ s), a ≠ b → disjoint a b), s.noncomm_prod id
-      (λ a ha b hb, (em (a = b)).by_cases (λ h, h ▸ commute.refl a)
-        (set.pairwise.mono' (λ _ _, disjoint.commute) h ha hb)) = σ) :=
-begin
-  obtain ⟨l, hl, rfl⟩ := s.exists_list_nodup_eq,
-  rw cycle_factors_finset_eq_list_to_finset hl,
-  simp only [noncomm_prod_to_finset, hl, exists_prop, list.mem_to_finset, and.congr_left_iff,
-             and.congr_right_iff, list.map_id, ne.def],
-  intros,
-  exact ⟨list.pairwise.forall disjoint.symmetric, hl.pairwise_of_forall_ne⟩
-end
-
-lemma cycle_factors_finset_pairwise_disjoint (p : perm α) (hp : p ∈ cycle_factors_finset f)
-  (q : perm α) (hq : q ∈ cycle_factors_finset f) (h : p ≠ q) :
-  disjoint p q :=
-begin
-  have : f.cycle_factors_finset = f.cycle_factors_finset := rfl,
-  obtain ⟨-, hd, -⟩ := cycle_factors_finset_eq_finset.mp this,
-  exact hd p hp q hq h
-end
-
-lemma cycle_factors_finset_mem_commute (p : perm α) (hp : p ∈ cycle_factors_finset f)
-  (q : perm α) (hq : q ∈ cycle_factors_finset f) :
-  _root_.commute p q :=
-begin
-  by_cases h : p = q,
-  { exact h ▸ commute.refl _ },
-  { exact (cycle_factors_finset_pairwise_disjoint _ _ hp _ hq h).commute }
-end
-
-/-- The product of cycle factors is equal to the original `f : perm α`. -/
-lemma cycle_factors_finset_noncomm_prod
-  (comm : ∀ (g ∈ f.cycle_factors_finset) (h ∈ f.cycle_factors_finset),
-    commute (id g) (id h) := cycle_factors_finset_mem_commute f) :
-  f.cycle_factors_finset.noncomm_prod id (comm) = f :=
-begin
-  have : f.cycle_factors_finset = f.cycle_factors_finset := rfl,
-  obtain ⟨-, hd, hp⟩ := cycle_factors_finset_eq_finset.mp this,
-  exact hp
-end
-
-lemma mem_cycle_factors_finset_iff {f p : perm α} :
-  p ∈ cycle_factors_finset f ↔ p.is_cycle ∧ ∀ (a ∈ p.support), p a = f a :=
-begin
-  obtain ⟨l, hl, hl'⟩ := f.cycle_factors_finset.exists_list_nodup_eq,
-  rw ←hl',
-  rw [eq_comm, cycle_factors_finset_eq_list_to_finset hl] at hl',
-  simpa [list.mem_to_finset, ne.def, ←hl'.right.right]
-    using mem_list_cycles_iff hl'.left hl'.right.left
-end
-
-lemma cycle_of_mem_cycle_factors_finset_iff {f : perm α} {x : α} :
-  cycle_of f x ∈ cycle_factors_finset f ↔ x ∈ f.support :=
-begin
-  rw mem_cycle_factors_finset_iff,
-  split,
-  { rintro ⟨hc, h⟩,
-    contrapose! hc,
-    rw [not_mem_support, ←cycle_of_eq_one_iff] at hc,
-    simp [hc] },
-  { intros hx,
-    refine ⟨is_cycle_cycle_of _ (mem_support.mp hx), _⟩,
-    intros y hy,
-    rw mem_support at hy,
-    rw cycle_of_apply,
-    split_ifs with H,
-    { refl },
-    { rw cycle_of_apply_of_not_same_cycle H at hy,
-      contradiction } }
-end
-
-lemma mem_cycle_factors_finset_support_le {p f : perm α} (h : p ∈ cycle_factors_finset f) :
-  p.support ≤ f.support :=
-begin
-  rw mem_cycle_factors_finset_iff at h,
-  intros x hx,
-  rwa [mem_support, ←h.right x hx, ←mem_support]
-end
-
-lemma cycle_factors_finset_eq_empty_iff {f : perm α} :
-  cycle_factors_finset f = ∅ ↔ f = 1 :=
-by simpa [cycle_factors_finset_eq_finset] using eq_comm
-
-@[simp] lemma cycle_factors_finset_one :
-  cycle_factors_finset (1 : perm α) = ∅ :=
-by simp [cycle_factors_finset_eq_empty_iff]
-
-@[simp] lemma cycle_factors_finset_eq_singleton_self_iff {f : perm α} :
-  f.cycle_factors_finset = {f} ↔ f.is_cycle :=
-by simp [cycle_factors_finset_eq_finset]
-
-lemma is_cycle.cycle_factors_finset_eq_singleton {f : perm α} (hf : is_cycle f) :
-  f.cycle_factors_finset = {f} :=
-cycle_factors_finset_eq_singleton_self_iff.mpr hf
-
-lemma cycle_factors_finset_eq_singleton_iff {f g : perm α} :
-  f.cycle_factors_finset = {g} ↔ f.is_cycle ∧ f = g :=
-begin
-  suffices : f = g → (g.is_cycle ↔ f.is_cycle),
-  { simpa [cycle_factors_finset_eq_finset, eq_comm] },
-  rintro rfl,
-  exact iff.rfl
-end
-
-/-- Two permutations `f g : perm α` have the same cycle factors iff they are the same. -/
-lemma cycle_factors_finset_injective : function.injective (@cycle_factors_finset α _ _) :=
-begin
-  intros f g h,
-  rw ←cycle_factors_finset_noncomm_prod f,
-  simpa [h] using cycle_factors_finset_noncomm_prod g
-end
-
-lemma disjoint.disjoint_cycle_factors_finset {f g : perm α} (h : disjoint f g) :
-  _root_.disjoint (cycle_factors_finset f) (cycle_factors_finset g) :=
-begin
-  rw disjoint_iff_disjoint_support at h,
-  intros x hx,
-  simp only [mem_cycle_factors_finset_iff, inf_eq_inter, mem_inter, mem_support] at hx,
-  obtain ⟨⟨⟨a, ha, -⟩, hf⟩, -, hg⟩ := hx,
-  refine h (_ : a ∈ f.support ∩ g.support),
-  simp [ha, ←hf a ha, ←hg a ha]
-end
-
-lemma disjoint.cycle_factors_finset_mul_eq_union {f g : perm α} (h : disjoint f g) :
-  cycle_factors_finset (f * g) = cycle_factors_finset f ∪ cycle_factors_finset g :=
-begin
-  rw cycle_factors_finset_eq_finset,
-  split,
-  { simp only [mem_cycle_factors_finset_iff, mem_union],
-    rintro _ (⟨h, -⟩ | ⟨h, -⟩);
-    exact h },
-  { refine ⟨_, _⟩,
-    { simp_rw mem_union,
-      rintros x (hx | hx) y (hy | hy) hxy,
-      { exact cycle_factors_finset_pairwise_disjoint _ _ hx _ hy hxy },
-      { exact h.mono (mem_cycle_factors_finset_support_le hx)
-          (mem_cycle_factors_finset_support_le hy) },
-      { exact h.symm.mono (mem_cycle_factors_finset_support_le hx)
-          (mem_cycle_factors_finset_support_le hy) },
-      { exact cycle_factors_finset_pairwise_disjoint _ _ hx _ hy hxy } },
-    { rw noncomm_prod_union_of_disjoint h.disjoint_cycle_factors_finset,
-      rw [cycle_factors_finset_noncomm_prod, cycle_factors_finset_noncomm_prod] } }
-end
-
-lemma disjoint_mul_inv_of_mem_cycle_factors_finset {f g : perm α} (h : f ∈ cycle_factors_finset g) :
-  disjoint (g * f⁻¹) f :=
-begin
-  rw mem_cycle_factors_finset_iff at h,
-  intro x,
-  by_cases hx : f x = x,
-  { exact or.inr hx },
-  { refine or.inl _,
-    rw [mul_apply, ←h.right, apply_inv_self],
-    rwa [←support_inv, apply_mem_support, support_inv, mem_support] }
-end
-
-/-- If c is a cycle, a ∈ c.support and c is a cycle of f, then `c = f.cycle_of a` -/
-lemma cycle_is_cycle_of {f c : equiv.perm α} {a : α}
-  (ha : a ∈ c.support) (hc : c ∈ f.cycle_factors_finset) : c = f.cycle_of a :=
-begin
-  suffices : f.cycle_of a = c.cycle_of a,
-  { rw this,
-    apply symm,
-    exact equiv.perm.is_cycle.cycle_of_eq
-     ((equiv.perm.mem_cycle_factors_finset_iff.mp hc).left)
-     (equiv.perm.mem_support.mp ha), },
-  let hfc := (equiv.perm.disjoint_mul_inv_of_mem_cycle_factors_finset hc).symm,
-  let hfc2 := (perm.disjoint.commute hfc),
-  rw ← equiv.perm.cycle_of_mul_of_apply_right_eq_self hfc2,
-  simp only [hfc2.eq, inv_mul_cancel_right],
-  -- a est dans le support de c, donc pas dans celui de g c⁻¹
-  exact equiv.perm.not_mem_support.mp
-    (finset.disjoint_left.mp (equiv.perm.disjoint.disjoint_support  hfc) ha),
-end
-
-end cycle_factors_finset
-
-@[elab_as_eliminator] lemma cycle_induction_on [fintype β] (P : perm β → Prop) (σ : perm β)
-  (base_one : P 1) (base_cycles : ∀ σ : perm β, σ.is_cycle → P σ)
-  (induction_disjoint : ∀ σ τ : perm β, disjoint σ τ → is_cycle σ → P σ → P τ → P (σ * τ)) :
-  P σ :=
-begin
-  suffices :
-    ∀ l : list (perm β), (∀ τ : perm β, τ ∈ l → τ.is_cycle) → l.pairwise disjoint → P l.prod,
-  { classical,
-    let x := σ.trunc_cycle_factors.out,
-    exact (congr_arg P x.2.1).mp (this x.1 x.2.2.1 x.2.2.2) },
-  intro l,
-  induction l with σ l ih,
-  { exact λ _ _, base_one },
-  { intros h1 h2,
-    rw list.prod_cons,
-    exact induction_disjoint σ l.prod
-      (disjoint_prod_right _ (list.pairwise_cons.mp h2).1)
-      (h1 _ (list.mem_cons_self _ _))
-      (base_cycles σ (h1 σ (l.mem_cons_self σ)))
-      (ih (λ τ hτ, h1 τ (list.mem_cons_of_mem σ hτ)) h2.of_cons) }
-end
-
-lemma cycle_factors_finset_mul_inv_mem_eq_sdiff [fintype α] {f g : perm α}
-  (h : f ∈ cycle_factors_finset g) :
-  cycle_factors_finset (g * f⁻¹) = (cycle_factors_finset g) \ {f} :=
-begin
-  revert f,
-  apply cycle_induction_on _ g,
-  { simp },
-  { intros σ hσ f hf,
-    simp only [cycle_factors_finset_eq_singleton_self_iff.mpr hσ, mem_singleton] at hf ⊢,
-    simp [hf] },
-  { intros σ τ hd hc hσ hτ f,
-    simp_rw [hd.cycle_factors_finset_mul_eq_union, mem_union],
-    -- if only `wlog` could work here...
-    rintro (hf | hf),
-    { rw [hd.commute.eq, union_comm, union_sdiff_distrib, sdiff_singleton_eq_erase,
-          erase_eq_of_not_mem, mul_assoc, disjoint.cycle_factors_finset_mul_eq_union, hσ hf],
-      { rw mem_cycle_factors_finset_iff at hf,
-        intro x,
-        cases hd.symm x with hx hx,
-        { exact or.inl hx },
-        { refine or.inr _,
-          by_cases hfx : f x = x,
-          { rw ←hfx,
-            simpa [hx] using hfx.symm },
-          { rw mul_apply,
-            rw ←hf.right _ (mem_support.mpr hfx) at hx,
-            contradiction } } },
-      { exact λ H, hd.disjoint_cycle_factors_finset (mem_inter_of_mem hf H) } },
-    { rw [union_sdiff_distrib, sdiff_singleton_eq_erase,
-          erase_eq_of_not_mem, mul_assoc, disjoint.cycle_factors_finset_mul_eq_union, hτ hf],
-      { rw mem_cycle_factors_finset_iff at hf,
-        intro x,
-        cases hd x with hx hx,
-        { exact or.inl hx },
-        { refine or.inr _,
-          by_cases hfx : f x = x,
-          { rw ←hfx,
-            simpa [hx] using hfx.symm },
-          { rw mul_apply,
-            rw ←hf.right _ (mem_support.mpr hfx) at hx,
-            contradiction } } },
-      { exact λ H, hd.disjoint_cycle_factors_finset (mem_inter_of_mem H hf) } } }
-end
-
-lemma same_cycle.nat_of_mem_support [fintype α] (f : perm α) {x y : α} (h : same_cycle f x y)
-  (hx : x ∈ f.support) :
-  ∃ (i : ℕ) (hi' : i < (f.cycle_of x).support.card), (f ^ i) x = y :=
-begin
-  revert f,
-  intro f,
-  apply cycle_induction_on _ f,
-  { simp },
-  { intros g hg H hx,
-    rw mem_support at hx,
-    rw [hg.cycle_of_eq hx, ←order_of_is_cycle hg],
-    exact H.nat' },
-  { rintros g h hd hg IH IH' ⟨m, rfl⟩ hx,
-    cases (disjoint_iff_eq_or_eq.mp hd) x with hgx hhx,
-    { have hpow : ∀ (k : ℤ), ((g * h) ^ k) x = (h ^ k) x,
-      { intro k,
-        suffices : (g ^ k) x = x,
-        { simpa [hd.commute.eq, hd.commute.symm.mul_zpow] },
-        rw zpow_apply_eq_self_of_apply_eq_self,
-        simpa using hgx },
-      obtain ⟨k, hk, hk'⟩ := IH' _ _,
-      { refine ⟨k, _, _⟩,
-        { rw [←cycle_of_eq_one_iff] at hgx,
-          rwa [hd.cycle_of_mul_distrib, hgx, one_mul] },
-        { simpa [←zpow_coe_nat, hpow] using hk' } },
-      { use m,
-        simp [hpow] },
-      { rw [mem_support, hd.commute.eq] at hx,
-        simpa [hgx] using hx } },
-    { have hpow : ∀ (k : ℤ), ((g * h) ^ k) x = (g ^ k) x,
-      { intro k,
-        suffices : (h ^ k) x = x,
-        { simpa [hd.commute.mul_zpow] },
-        rw zpow_apply_eq_self_of_apply_eq_self,
-        simpa using hhx },
-      obtain ⟨k, hk, hk'⟩ := IH _ _,
-      { refine ⟨k, _, _⟩,
-        { rw [←cycle_of_eq_one_iff] at hhx,
-          rwa [hd.cycle_of_mul_distrib, hhx, mul_one] },
-        { simpa [←zpow_coe_nat, hpow] using hk' } },
-      { use m,
-        simp [hpow] },
-      { simpa [hhx] using hx } } }
-end
-
-lemma same_cycle.nat [fintype α] (f : perm α) {x y : α} (h : same_cycle f x y) :
-  ∃ (i : ℕ) (hi : 0 < i) (hi' : i ≤ (f.cycle_of x).support.card + 1), (f ^ i) x = y :=
-begin
-  by_cases hx : x ∈ f.support,
-  { obtain ⟨k, hk, hk'⟩ := same_cycle.nat_of_mem_support f h hx,
-    cases k,
-    { refine ⟨(f.cycle_of x).support.card, _, self_le_add_right _ _, _⟩,
-      { refine zero_lt_one.trans (one_lt_card_support_of_ne_one _),
-        simpa using hx },
-      { simp only [perm.coe_one, id.def, pow_zero] at hk',
-        subst hk',
-        rw [←order_of_is_cycle (is_cycle_cycle_of _ (mem_support.mp hx)),
-            ←cycle_of_pow_apply_self, pow_order_of_eq_one, one_apply] } },
-    { exact ⟨k + 1, by simp, nat.le_succ_of_le hk.le, hk'⟩ } },
-  { refine ⟨1, zero_lt_one, by simp, _⟩,
-    obtain ⟨k, rfl⟩ := h,
-    rw [not_mem_support] at hx,
-    rw [pow_apply_eq_self_of_apply_eq_self hx,
-        zpow_apply_eq_self_of_apply_eq_self hx] }
-end
-
-section generation
-
-variables [fintype α] [fintype β]
-
-open subgroup
-
-lemma closure_is_cycle : closure {σ : perm β | is_cycle σ} = ⊤ :=
-begin
-  classical,
-  exact top_le_iff.mp (le_trans (ge_of_eq closure_is_swap) (closure_mono (λ _, is_swap.is_cycle))),
-end
-
-lemma closure_cycle_adjacent_swap {σ : perm α} (h1 : is_cycle σ) (h2 : σ.support = ⊤) (x : α) :
-  closure ({σ, swap x (σ x)} : set (perm α)) = ⊤ :=
-begin
-  let H := closure ({σ, swap x (σ x)} : set (perm α)),
-  have h3 : σ ∈ H := subset_closure (set.mem_insert σ _),
-  have h4 : swap x (σ x) ∈ H := subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)),
-  have step1 : ∀ (n : ℕ), swap ((σ ^ n) x) ((σ^(n+1)) x) ∈ H,
-  { intro n,
-    induction n with n ih,
-    { exact subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)) },
-    { convert H.mul_mem (H.mul_mem h3 ih) (H.inv_mem h3),
-      rw [mul_swap_eq_swap_mul, mul_inv_cancel_right], refl } },
-  have step2 : ∀ (n : ℕ), swap x ((σ ^ n) x) ∈ H,
-  { intro n,
-    induction n with n ih,
-    { convert H.one_mem,
-      exact swap_self x },
-    { by_cases h5 : x = (σ ^ n) x,
-      { rw [pow_succ, mul_apply, ←h5], exact h4 },
-      by_cases h6 : x = (σ^(n+1)) x,
-      { rw [←h6, swap_self], exact H.one_mem },
-      rw [swap_comm, ←swap_mul_swap_mul_swap h5 h6],
-      exact H.mul_mem (H.mul_mem (step1 n) ih) (step1 n) } },
-  have step3 : ∀ (y : α), swap x y ∈ H,
-  { intro y,
-    have hx : x ∈ (⊤ : finset α) := finset.mem_univ x,
-    rw [←h2, mem_support] at hx,
-    have hy : y ∈ (⊤ : finset α) := finset.mem_univ y,
-    rw [←h2, mem_support] at hy,
-    cases is_cycle.exists_pow_eq h1 hx hy with n hn,
-    rw ← hn,
-    exact step2 n },
-  have step4 : ∀ (y z : α), swap y z ∈ H,
-  { intros y z,
-    by_cases h5 : z = x,
-    { rw [h5, swap_comm], exact step3 y },
-    by_cases h6 : z = y,
-    { rw [h6, swap_self], exact H.one_mem },
-    rw [←swap_mul_swap_mul_swap h5 h6, swap_comm z x],
-    exact H.mul_mem (H.mul_mem (step3 y) (step3 z)) (step3 y) },
-  rw [eq_top_iff, ←closure_is_swap, closure_le],
-  rintros τ ⟨y, z, h5, h6⟩,
-  rw h6,
-  exact step4 y z,
-end
-
-lemma closure_cycle_coprime_swap {n : ℕ} {σ : perm α} (h0 : nat.coprime n (fintype.card α))
-  (h1 : is_cycle σ) (h2 : σ.support = finset.univ) (x : α) :
-  closure ({σ, swap x ((σ ^ n) x)} : set (perm α)) = ⊤ :=
-begin
-  rw [←finset.card_univ, ←h2, ←order_of_is_cycle h1] at h0,
-  cases exists_pow_eq_self_of_coprime h0 with m hm,
-  have h2' : (σ ^ n).support = ⊤ := eq.trans (support_pow_coprime h0) h2,
-  have h1' : is_cycle ((σ ^ n) ^ (m : ℤ)) := by rwa ← hm at h1,
-  replace h1' : is_cycle (σ ^ n) := is_cycle_of_is_cycle_pow h1'
-    (le_trans (support_pow_le σ n) (ge_of_eq (congr_arg support hm))),
-  rw [eq_top_iff, ←closure_cycle_adjacent_swap h1' h2' x, closure_le, set.insert_subset],
-  exact ⟨subgroup.pow_mem (closure _) (subset_closure (set.mem_insert σ _)) n,
-    set.singleton_subset_iff.mpr (subset_closure (set.mem_insert_of_mem _ (set.mem_singleton _)))⟩,
-end
-
-lemma closure_prime_cycle_swap {σ τ : perm α} (h0 : (fintype.card α).prime) (h1 : is_cycle σ)
-  (h2 : σ.support = finset.univ) (h3 : is_swap τ) : closure ({σ, τ} : set (perm α)) = ⊤ :=
-begin
-  obtain ⟨x, y, h4, h5⟩ := h3,
-  obtain ⟨i, hi⟩ := h1.exists_pow_eq (mem_support.mp
-  ((finset.ext_iff.mp h2 x).mpr (finset.mem_univ x)))
-    (mem_support.mp ((finset.ext_iff.mp h2 y).mpr (finset.mem_univ y))),
-  rw [h5, ←hi],
-  refine closure_cycle_coprime_swap (nat.coprime.symm
-    (h0.coprime_iff_not_dvd.mpr (λ h, h4 _))) h1 h2 x,
-  cases h with m hm,
-  rwa [hm, pow_mul, ←finset.card_univ, ←h2, ←order_of_is_cycle h1,
-    pow_order_of_eq_one, one_pow, one_apply] at hi,
-end
-
-end generation
-
-section
-variables [fintype α] {σ τ : perm α}
-
-noncomputable theory
-
-lemma is_conj_of_support_equiv (f : {x // x ∈ (σ.support : set α)} ≃ {x // x ∈ (τ.support : set α)})
-  (hf : ∀ (x : α) (hx : x ∈ (σ.support : set α)), (f ⟨σ x, apply_mem_support.2 hx⟩ : α) =
-    τ ↑(f ⟨x,hx⟩)) :
-  is_conj σ τ :=
-begin
-  refine is_conj_iff.2 ⟨equiv.extend_subtype f, _⟩,
-  rw mul_inv_eq_iff_eq_mul,
-  ext,
-  simp only [perm.mul_apply],
-  by_cases hx : x ∈ σ.support,
-  { rw [equiv.extend_subtype_apply_of_mem, equiv.extend_subtype_apply_of_mem],
-    { exact hf x (finset.mem_coe.2 hx) } },
-  { rwa [not_not.1 ((not_congr mem_support).1 (equiv.extend_subtype_not_mem f _ _)),
-      not_not.1 ((not_congr mem_support).mp hx)] }
-end
-
-theorem is_cycle.is_conj (hσ : is_cycle σ) (hτ : is_cycle τ) (h : σ.support.card = τ.support.card) :
-  is_conj σ τ :=
-begin
-  refine is_conj_of_support_equiv (hσ.zpowers_equiv_support.symm.trans
-    ((zpowers_equiv_zpowers begin
-      rw [order_of_is_cycle hσ, h, order_of_is_cycle hτ],
-  end).trans hτ.zpowers_equiv_support)) _,
-  intros x hx,
-  simp only [perm.mul_apply, equiv.trans_apply, equiv.sum_congr_apply],
-  obtain ⟨n, rfl⟩ := hσ.exists_pow_eq (classical.some_spec hσ).1 (mem_support.1 hx),
-  apply eq.trans _ (congr rfl (congr rfl (congr rfl
-    (congr rfl (hσ.zpowers_equiv_support_symm_apply n).symm)))),
-  apply (congr rfl (congr rfl (congr rfl (hσ.zpowers_equiv_support_symm_apply (n + 1))))).trans _,
-  simp only [ne.def, is_cycle.zpowers_equiv_support_apply,
-    subtype.coe_mk, zpowers_equiv_zpowers_apply],
-  rw [pow_succ, perm.mul_apply],
-end
-
-theorem is_cycle.is_conj_iff (hσ : is_cycle σ) (hτ : is_cycle τ) :
-  is_conj σ τ ↔ σ.support.card = τ.support.card :=
-⟨begin
-  intro h,
-  obtain ⟨π, rfl⟩ := is_conj_iff.1 h,
-  apply finset.card_congr (λ a ha, π a) (λ _ ha, _) (λ _ _ _ _ ab, π.injective ab) (λ b hb, _),
-  { simp [mem_support.1 ha] },
-  { refine ⟨π⁻¹ b, ⟨_, π.apply_inv_self b⟩⟩,
-    contrapose! hb,
-    rw [mem_support, not_not] at hb,
-    rw [mem_support, not_not, perm.mul_apply, perm.mul_apply, hb, perm.apply_inv_self] }
-end, hσ.is_conj hτ⟩
-
-@[simp]
-lemma support_conj : (σ * τ * σ⁻¹).support = τ.support.map σ.to_embedding :=
-begin
-  ext,
-  simp only [mem_map_equiv, perm.coe_mul, comp_app, ne.def, perm.mem_support, equiv.eq_symm_apply],
-  refl,
-end
-
-lemma card_support_conj : (σ * τ * σ⁻¹).support.card = τ.support.card :=
-by simp
-
-end
-
-theorem disjoint.is_conj_mul {α : Type*} [fintype α] {σ τ π ρ : perm α}
-  (hc1 : is_conj σ π) (hc2 : is_conj τ ρ)
-  (hd1 : disjoint σ τ) (hd2 : disjoint π ρ) :
-  is_conj (σ * τ) (π * ρ) :=
-begin
-  classical,
-  obtain ⟨f, rfl⟩ := is_conj_iff.1 hc1,
-  obtain ⟨g, rfl⟩ := is_conj_iff.1 hc2,
-  have hd1' := coe_inj.2 hd1.support_mul,
-  have hd2' := coe_inj.2 hd2.support_mul,
-  rw [coe_union] at *,
-  have hd1'' := disjoint_iff_disjoint_coe.1 (disjoint_iff_disjoint_support.1 hd1),
-  have hd2'' := disjoint_iff_disjoint_coe.1 (disjoint_iff_disjoint_support.1 hd2),
-  refine is_conj_of_support_equiv _ _,
-  { refine ((equiv.set.of_eq hd1').trans (equiv.set.union hd1'')).trans
-      ((equiv.sum_congr (subtype_equiv f (λ a, _)) (subtype_equiv g (λ a, _))).trans
-      ((equiv.set.of_eq hd2').trans (equiv.set.union hd2'')).symm);
-    { simp only [set.mem_image, to_embedding_apply, exists_eq_right,
-        support_conj, coe_map, apply_eq_iff_eq] } },
-  { intros x hx,
-    simp only [trans_apply, symm_trans_apply, set.of_eq_apply,
-      set.of_eq_symm_apply, equiv.sum_congr_apply],
-    rw [hd1', set.mem_union] at hx,
-    cases hx with hxσ hxτ,
-    { rw [mem_coe, mem_support] at hxσ,
-      rw [set.union_apply_left hd1'' _, set.union_apply_left hd1'' _],
-      simp only [subtype_equiv_apply, perm.coe_mul, sum.map_inl, comp_app,
-        set.union_symm_apply_left, subtype.coe_mk, apply_eq_iff_eq],
-      { have h := (hd2 (f x)).resolve_left _,
-        { rw [mul_apply, mul_apply] at h,
-          rw [h, inv_apply_self, (hd1 x).resolve_left hxσ] },
-        { rwa [mul_apply, mul_apply, inv_apply_self, apply_eq_iff_eq] } },
-      { rwa [subtype.coe_mk, subtype.coe_mk, mem_coe, mem_support] },
-      { rwa [subtype.coe_mk, subtype.coe_mk, perm.mul_apply,
-          (hd1 x).resolve_left hxσ, mem_coe, apply_mem_support, mem_support] } },
-    { rw [mem_coe, ← apply_mem_support, mem_support] at hxτ,
-      rw [set.union_apply_right hd1'' _, set.union_apply_right hd1'' _],
-      simp only [subtype_equiv_apply, perm.coe_mul, sum.map_inr, comp_app,
-        set.union_symm_apply_right, subtype.coe_mk, apply_eq_iff_eq],
-      { have h := (hd2 (g (τ x))).resolve_right _,
-        { rw [mul_apply, mul_apply] at h,
-          rw [inv_apply_self, h, (hd1 (τ x)).resolve_right hxτ] },
-        { rwa [mul_apply, mul_apply, inv_apply_self, apply_eq_iff_eq] } },
-      { rwa [subtype.coe_mk, subtype.coe_mk, mem_coe, ← apply_mem_support, mem_support] },
-      { rwa [subtype.coe_mk, subtype.coe_mk, perm.mul_apply,
-          (hd1 (τ x)).resolve_right hxτ, mem_coe, mem_support] } } }
-end
-
-section fixed_points
-
-/-!
-### Fixed points
--/
-
-lemma fixed_point_card_lt_of_ne_one [fintype α] {σ : perm α} (h : σ ≠ 1) :
-  (filter (λ x, σ x = x) univ).card < fintype.card α - 1 :=
-begin
-  rw [lt_tsub_iff_left, ← lt_tsub_iff_right, ← finset.card_compl,
-    finset.compl_filter],
-  exact one_lt_card_support_of_ne_one h
-end
-
-end fixed_points
-
-end equiv.perm
diff --git a/src/group_theory/perm/fin.lean b/src/group_theory/perm/fin.lean
index 8873c22971ebb..57ce537a6db18 100644
--- a/src/group_theory/perm/fin.lean
+++ b/src/group_theory/perm/fin.lean
@@ -3,13 +3,16 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import group_theory.perm.cycle_type
+import group_theory.perm.cycle.type
 import group_theory.perm.option
 import logic.equiv.fin
 import logic.equiv.fintype
 
 /-!
 # Permutations of `fin n`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 open equiv
 
diff --git a/src/group_theory/perm/list.lean b/src/group_theory/perm/list.lean
index 72889079344dd..04aa0067202ee 100644
--- a/src/group_theory/perm/list.lean
+++ b/src/group_theory/perm/list.lean
@@ -10,6 +10,9 @@ import group_theory.perm.support
 /-!
 # Permutations from a list
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A list `l : list α` can be interpreted as a `equiv.perm α` where each element in the list
 is permuted to the next one, defined as `form_perm`. When we have that `nodup l`,
 we prove that `equiv.perm.support (form_perm l) = l.to_finset`, and that
@@ -56,6 +59,8 @@ prod_cons
 
 lemma form_perm_pair (x y : α) : form_perm [x, y] = swap x y := rfl
 
+variables {l} {x : α}
+
 lemma form_perm_apply_of_not_mem (x : α) (l : list α) (h : x ∉ l) :
   form_perm l x = x :=
 begin
@@ -68,6 +73,9 @@ begin
     simp [IH, swap_apply_of_ne_of_ne, h] }
 end
 
+lemma mem_of_form_perm_apply_ne (x : α) (l : list α) : l.form_perm x ≠ x → x ∈ l :=
+not_imp_comm.2 $ list.form_perm_apply_of_not_mem _ _
+
 lemma form_perm_apply_mem_of_mem (x : α) (l : list α) (h : x ∈ l) :
   form_perm l x ∈ l :=
 begin
@@ -83,6 +91,29 @@ begin
       simp [form_perm_apply_of_not_mem _ _ hx, ←h] } }
 end
 
+lemma mem_of_form_perm_apply_mem (x : α) (l : list α) (h : l.form_perm x ∈ l) : x ∈ l :=
+begin
+  cases l with y l,
+  { simpa },
+  induction l with z l IH generalizing x y,
+  { simpa using h },
+  { by_cases hx : (z :: l).form_perm x ∈ z :: l,
+    { rw [list.form_perm_cons_cons, mul_apply, swap_apply_def] at h,
+      split_ifs at h;
+      simp [IH _ _ hx] },
+    { replace hx := (function.injective.eq_iff (equiv.injective _)).mp
+        (list.form_perm_apply_of_not_mem _ _ hx),
+      simp only [list.form_perm_cons_cons, hx, equiv.perm.coe_mul, function.comp_app,
+        list.mem_cons_iff, swap_apply_def, ite_eq_left_iff] at h,
+      simp only [list.mem_cons_iff],
+      obtain h | h | h := h;
+      { split_ifs at h;
+        cc }}}
+end
+
+lemma form_perm_mem_iff_mem : l.form_perm x ∈ l ↔ x ∈ l :=
+⟨l.mem_of_form_perm_apply_mem x, l.form_perm_apply_mem_of_mem x⟩
+
 @[simp] lemma form_perm_cons_concat_apply_last (x y : α) (xs : list α) :
   form_perm (x :: (xs ++ [y])) y = x :=
 begin
@@ -100,7 +131,7 @@ end
 
 @[simp] lemma form_perm_apply_nth_le_length (x : α) (xs : list α) :
   form_perm (x :: xs) ((x :: xs).nth_le xs.length (by simp)) = x :=
-by rw [nth_le_cons_length, form_perm_apply_last]
+by rw [nth_le_cons_length, form_perm_apply_last]; refl
 
 lemma form_perm_apply_head (x y : α) (xs : list α) (h : nodup (x :: y :: xs)) :
   form_perm (x :: y :: xs) x = y :=
@@ -115,6 +146,8 @@ begin
   { simpa using form_perm_apply_head _ _ _ h }
 end
 
+variables (l)
+
 lemma form_perm_eq_head_iff_eq_last (x y : α) :
   form_perm (y :: l) x = y ↔ x = last (y :: l) (cons_ne_nil _ _) :=
 iff.trans (by rw form_perm_apply_last) (form_perm (y :: l)).injective.eq_iff
diff --git a/src/group_theory/perm/option.lean b/src/group_theory/perm/option.lean
index 1cfa369403d7c..0d04828bf0728 100644
--- a/src/group_theory/perm/option.lean
+++ b/src/group_theory/perm/option.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
+import data.fintype.perm
 import group_theory.perm.sign
 import logic.equiv.option
 
 /-!
 # Permutations of `option α`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 open equiv
 
diff --git a/src/group_theory/perm/sign.lean b/src/group_theory/perm/sign.lean
index 125aab8691161..03ccd2082eb5b 100644
--- a/src/group_theory/perm/sign.lean
+++ b/src/group_theory/perm/sign.lean
@@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
 import group_theory.perm.support
-import data.fintype.basic
 import group_theory.order_of_element
-import tactic.norm_swap
-import data.finset.sort
+import data.finset.fin
+import data.int.order.units
 
 /-!
 # Sign of a permutation
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The main definition of this file is `equiv.perm.sign`, associating a `ℤˣ` sign with a
 permutation.
 
@@ -25,6 +27,10 @@ open equiv function fintype finset
 open_locale big_operators
 variables {α : Type u} {β : Type v}
 
+-- An example on how to determine the order of an element of a finite group.
+example : order_of (-1 : ℤˣ) = 2 :=
+order_of_eq_prime (int.units_sq _) dec_trivial
+
 namespace equiv.perm
 
 /--
@@ -54,30 +60,27 @@ begin
   simp only [inv_apply_self]
 end
 
-lemma perm_inv_maps_to_of_maps_to (f : perm α) {s : set α} [fintype s]
-  (h : set.maps_to f s s) : set.maps_to (f⁻¹ : _) s s :=
-λ x hx, set.mem_to_finset.mp $
+lemma perm_inv_maps_to_of_maps_to (f : perm α) {s : set α} [finite s] (h : set.maps_to f s s) :
+  set.maps_to (f⁻¹ : _) s s :=
+by casesI nonempty_fintype s; exact λ x hx, set.mem_to_finset.mp $
   perm_inv_on_of_perm_on_finset
    (λ a ha, set.mem_to_finset.mpr (h (set.mem_to_finset.mp ha)))
    (set.mem_to_finset.mpr hx)
 
-@[simp] lemma perm_inv_maps_to_iff_maps_to {f : perm α} {s : set α} [fintype s] :
+@[simp] lemma perm_inv_maps_to_iff_maps_to {f : perm α} {s : set α} [finite s] :
   set.maps_to (f⁻¹ : _) s s ↔ set.maps_to f s s :=
 ⟨perm_inv_maps_to_of_maps_to f⁻¹, perm_inv_maps_to_of_maps_to f⟩
 
-lemma perm_inv_on_of_perm_on_fintype {f : perm α} {p : α → Prop} [fintype {x // p x}]
+lemma perm_inv_on_of_perm_on_finite {f : perm α} {p : α → Prop} [finite {x // p x}]
   (h : ∀ x, p x → p (f x)) {x : α} (hx : p x) : p (f⁻¹ x) :=
-begin
-  letI : fintype ↥(show set α, from p) := ‹fintype {x // p x}›,
-  exact perm_inv_maps_to_of_maps_to f h hx
-end
+perm_inv_maps_to_of_maps_to f h hx
 
 /-- If the permutation `f` maps `{x // p x}` into itself, then this returns the permutation
   on `{x // p x}` induced by `f`. Note that the `h` hypothesis is weaker than for
   `equiv.perm.subtype_perm`. -/
 abbreviation subtype_perm_of_fintype (f : perm α) {p : α → Prop} [fintype {x // p x}]
   (h : ∀ x, p x → p (f x)) : perm {x // p x} :=
-f.subtype_perm (λ x, ⟨h x, λ h₂, f.inv_apply_self x ▸ perm_inv_on_of_perm_on_fintype h h₂⟩)
+f.subtype_perm (λ x, ⟨h x, λ h₂, f.inv_apply_self x ▸ perm_inv_on_of_perm_on_finite h h₂⟩)
 
 @[simp] lemma subtype_perm_of_fintype_apply (f : perm α) {p : α → Prop} [fintype {x // p x}]
   (h : ∀ x, p x → p (f x)) (x : {x // p x}) : subtype_perm_of_fintype f h x = ⟨f x, h x x.2⟩ := rfl
@@ -86,11 +89,12 @@ f.subtype_perm (λ x, ⟨h x, λ h₂, f.inv_apply_self x ▸ perm_inv_on_of_per
   (h : ∀ x, p x → p ((1 : perm α) x)) : @subtype_perm_of_fintype α 1 p _ h = 1 :=
 equiv.ext $ λ ⟨_, _⟩, rfl
 
-lemma perm_maps_to_inl_iff_maps_to_inr {m n : Type*} [fintype m] [fintype n]
-  (σ : equiv.perm (m ⊕ n)) :
+lemma perm_maps_to_inl_iff_maps_to_inr {m n : Type*} [finite m] [finite n] (σ : perm (m ⊕ n)) :
   set.maps_to σ (set.range sum.inl) (set.range sum.inl) ↔
   set.maps_to σ (set.range sum.inr) (set.range sum.inr) :=
 begin
+  casesI nonempty_fintype m,
+  casesI nonempty_fintype n,
   split; id
   { intros h,
     classical,
@@ -109,10 +113,12 @@ begin
     exact absurd hy sum.inr_ne_inl},
 end
 
-lemma mem_sum_congr_hom_range_of_perm_maps_to_inl {m n : Type*} [fintype m] [fintype n]
+lemma mem_sum_congr_hom_range_of_perm_maps_to_inl {m n : Type*} [finite m] [finite n]
   {σ : perm (m ⊕ n)} (h : set.maps_to σ (set.range sum.inl) (set.range sum.inl)) :
   σ ∈ (sum_congr_hom m n).range :=
 begin
+  casesI nonempty_fintype m,
+  casesI nonempty_fintype n,
   classical,
   have h1 : ∀ (x : m ⊕ n), (∃ (a : m), sum.inl a = x) → (∃ (a : m), sum.inl a = σ x),
   { rintros x ⟨a, ha⟩, apply h, rw ← ha, exact ⟨a, rfl⟩ },
@@ -212,9 +218,10 @@ quotient.rec_on_subsingleton (@univ α _).1
 
 /-- An induction principle for permutations. If `P` holds for the identity permutation, and
 is preserved under composition with a non-trivial swap, then `P` holds for all permutations. -/
-@[elab_as_eliminator] lemma swap_induction_on [fintype α] {P : perm α → Prop} (f : perm α) :
+@[elab_as_eliminator] lemma swap_induction_on [finite α] {P : perm α → Prop} (f : perm α) :
   P 1 → (∀ f x y, x ≠ y → P f → P (swap x y * f)) → P f :=
 begin
+  casesI nonempty_fintype α,
   cases (trunc_swap_factors f).out with l hl,
   induction l with g l ih generalizing f,
   { simp only [hl.left.symm, list.prod_nil, forall_true_iff] {contextual := tt} },
@@ -225,8 +232,9 @@ begin
       (ih _ ⟨rfl, λ v hv, hl.2 _ (list.mem_cons_of_mem _ hv)⟩ h1 hmul_swap) }
 end
 
-lemma closure_is_swap [fintype α] : subgroup.closure {σ : perm α | is_swap σ} = ⊤ :=
+lemma closure_is_swap [finite α] : subgroup.closure {σ : perm α | is_swap σ} = ⊤ :=
 begin
+  casesI nonempty_fintype α,
   refine eq_top_iff.mpr (λ x hx, _),
   obtain ⟨h1, h2⟩ := subtype.mem (trunc_swap_factors x).out,
   rw ← h1,
@@ -237,7 +245,7 @@ end
 
 An induction principle for permutations. If `P` holds for the identity permutation, and
 is preserved under composition with a non-trivial swap, then `P` holds for all permutations. -/
-@[elab_as_eliminator] lemma swap_induction_on' [fintype α] {P : perm α → Prop} (f : perm α) :
+@[elab_as_eliminator] lemma swap_induction_on' [finite α] {P : perm α → Prop} (f : perm α) :
   P 1 → (∀ f x y, x ≠ y → P f → P (f * swap x y)) → P f :=
 λ h1 IH, inv_inv f ▸ swap_induction_on f⁻¹ h1 (λ f, IH f⁻¹)
 
@@ -513,11 +521,11 @@ sign_symm_trans_trans f e.symm
 
 lemma sign_prod_list_swap {l : list (perm α)}
   (hl : ∀ g ∈ l, is_swap g) : sign l.prod = (-1) ^ l.length :=
-have h₁ : l.map sign = list.repeat (-1) l.length :=
-  list.eq_repeat.2 ⟨by simp, λ u hu,
+have h₁ : l.map sign = list.replicate l.length (-1) :=
+  list.eq_replicate.2 ⟨by simp, λ u hu,
   let ⟨g, hg⟩ := list.mem_map.1 hu in
   hg.2 ▸ (hl _ hg.1).sign_eq⟩,
-by rw [← list.prod_repeat, ← h₁, list.prod_hom _ (@sign α _ _)]
+by rw [← list.prod_replicate, ← h₁, list.prod_hom _ (@sign α _ _)]
 
 variable (α)
 
@@ -540,15 +548,15 @@ have ∀ {f}, is_swap f → s f = -1 :=
   have ∀ a ∈ l.map s, a = (1 : ℤˣ) := λ a ha,
     let ⟨g, hg⟩ := list.mem_map.1 ha in hg.2 ▸ this _ (hl.2 _ hg.1),
   have s l.prod = 1,
-    by rw [← l.prod_hom s, list.eq_repeat'.2 this, list.prod_repeat, one_pow],
+    by rw [← l.prod_hom s, list.eq_replicate_length.2 this, list.prod_replicate, one_pow],
   by { rw [hl.1, hg] at this,
     exact absurd this dec_trivial }),
 monoid_hom.ext $ λ f,
 let ⟨l, hl₁, hl₂⟩ := (trunc_swap_factors f).out in
 have hsl : ∀ a ∈ l.map s, a = (-1 : ℤˣ) := λ a ha,
   let ⟨g, hg⟩ := list.mem_map.1 ha in hg.2 ▸  this (hl₂ _ hg.1),
-by rw [← hl₁, ← l.prod_hom s, list.eq_repeat'.2 hsl, list.length_map,
-     list.prod_repeat, sign_prod_list_swap hl₂]
+by rw [← hl₁, ← l.prod_hom s, list.eq_replicate_length.2 hsl, list.length_map,
+     list.prod_replicate, sign_prod_list_swap hl₂]
 
 lemma sign_subtype_perm (f : perm α) {p : α → Prop} [decidable_pred p]
   (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) : sign (subtype_perm f h₁) = sign f :=
@@ -562,11 +570,6 @@ have hl'₂ : (l.1.map of_subtype).prod = f,
 by { conv { congr, rw ← l.2.1, skip, rw ← hl'₂ },
   rw [sign_prod_list_swap l.2.2, sign_prod_list_swap hl', list.length_map] }
 
-@[simp] lemma sign_of_subtype {p : α → Prop} [decidable_pred p]
-  (f : perm (subtype p)) : sign (of_subtype f) = sign f :=
-have ∀ x, of_subtype f x ≠ x → p x, from λ x, not_imp_comm.1 (of_subtype_apply_of_not_mem f),
-by conv {to_rhs, rw [← subtype_perm_of_subtype f, sign_subtype_perm _ _ this]}
-
 lemma sign_eq_sign_of_equiv [decidable_eq β] [fintype β] (f : perm α) (g : perm β)
   (e : α ≃ β) (h : ∀ x, e (f x) = g (e x)) : sign f = sign g :=
 have hg : g = (e.symm.trans f).trans e, from equiv.ext $ by simp [h],
@@ -578,9 +581,9 @@ lemma sign_bij [decidable_eq β] [fintype β]
   (hi : ∀ x₁ x₂ hx₁ hx₂, i x₁ hx₁ = i x₂ hx₂ → x₁ = x₂)
   (hg : ∀ y, g y ≠ y → ∃ x hx, i x hx = y) :
   sign f = sign g :=
-calc sign f = sign (@subtype_perm _ f (λ x, f x ≠ x) (by simp)) :
+calc sign f = sign (subtype_perm f $ by simp : perm {x // f x ≠ x}) :
   (sign_subtype_perm _ _ (λ _, id)).symm
-... = sign (@subtype_perm _ g (λ x, g x ≠ x) (by simp)) :
+... = sign (subtype_perm g $ by simp : perm {x // g x ≠ x}) :
   sign_eq_sign_of_equiv _ _
     (equiv.of_bijective (λ x : {x // f x ≠ x},
         (⟨i x.1 x.2, have f (f x) ≠ f x, from mt (λ h, f.injective h) x.2,
@@ -636,7 +639,7 @@ sign_bij (λ (ab : α × β) _, ab.snd)
 lemma sign_prod_congr_right (σ : α → perm β) :
   sign (prod_congr_right σ) = ∏ k, (σ k).sign :=
 begin
-  obtain ⟨l, hl, mem_l⟩ := fintype.exists_univ_list α,
+  obtain ⟨l, hl, mem_l⟩ := finite.exists_univ_list α,
   have l_to_finset : l.to_finset = finset.univ,
   { apply eq_top_iff.mpr,
     intros b _,
@@ -683,7 +686,11 @@ by simp [subtype_congr]
 @[simp] lemma sign_extend_domain (e : perm α)
   {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p) :
   equiv.perm.sign (e.extend_domain f) = equiv.perm.sign e :=
-by simp [equiv.perm.extend_domain]
+by simp only [equiv.perm.extend_domain, sign_subtype_congr, sign_perm_congr, sign_refl, mul_one]
+
+@[simp] lemma sign_of_subtype {p : α → Prop} [decidable_pred p]
+  (f : equiv.perm (subtype p)) : equiv.perm.sign (f.of_subtype) = equiv.perm.sign f :=
+sign_extend_domain f (equiv.refl (subtype p))
 
 end congr
 
diff --git a/src/group_theory/perm/subgroup.lean b/src/group_theory/perm/subgroup.lean
index 740de3bd942c7..77db74a606c95 100644
--- a/src/group_theory/perm/subgroup.lean
+++ b/src/group_theory/perm/subgroup.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
 import group_theory.perm.basic
-import data.fintype.basic
-import group_theory.subgroup.basic
+import data.fintype.perm
+import group_theory.subgroup.finite
 /-!
 # Lemmas about subgroups within the permutations (self-equivalences) of a type `α`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides extra lemmas about some `subgroup`s that exist within `equiv.perm α`.
 `group_theory.subgroup` depends on `group_theory.perm.basic`, so these need to be in a separate
 file.
@@ -59,9 +62,9 @@ fintype.card_eq.mpr ⟨(of_injective (subtype_congr_hom p) (subtype_congr_hom_in
 
 /-- **Cayley's theorem**: Every group G is isomorphic to a subgroup of the symmetric group acting on
 `G`. Note that we generalize this to an arbitrary "faithful" group action by `G`. Setting `H = G`
-recovers the usual statement of Cayley's theorem via `right_cancel_monoid.to_has_faithful_scalar` -/
+recovers the usual statement of Cayley's theorem via `right_cancel_monoid.to_has_faithful_smul` -/
 noncomputable def subgroup_of_mul_action (G H : Type*) [group G] [mul_action G H]
-  [has_faithful_scalar G H] : G ≃* (mul_action.to_perm_hom G H).range :=
+  [has_faithful_smul G H] : G ≃* (mul_action.to_perm_hom G H).range :=
 mul_equiv.of_left_inverse' _ (classical.some_spec mul_action.to_perm_injective.has_left_inverse)
 
 end perm
diff --git a/src/group_theory/perm/support.lean b/src/group_theory/perm/support.lean
index 8d2e19a333fc1..78fa4c4dc079a 100644
--- a/src/group_theory/perm/support.lean
+++ b/src/group_theory/perm/support.lean
@@ -10,6 +10,9 @@ import group_theory.perm.basic
 /-!
 # Support of a permutation
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 In the following, `f g : equiv.perm α`.
@@ -41,6 +44,8 @@ by simp only [disjoint, or.comm, imp_self]
 lemma disjoint.symmetric : symmetric (@disjoint α) :=
 λ _ _, disjoint.symm
 
+instance : is_symm (perm α) disjoint := ⟨disjoint.symmetric⟩
+
 lemma disjoint_comm : disjoint f g ↔ disjoint g f :=
 ⟨disjoint.symm, disjoint.symm⟩
 
@@ -172,16 +177,28 @@ variable [decidable_eq α]
 /-- `f.is_swap` indicates that the permutation `f` is a transposition of two elements. -/
 def is_swap (f : perm α) : Prop := ∃ x y, x ≠ y ∧ f = swap x y
 
+@[simp] lemma of_subtype_swap_eq {p : α → Prop} [decidable_pred p]
+  (x y : subtype p) :
+  (equiv.swap x y).of_subtype = equiv.swap ↑x ↑y :=
+equiv.ext $ λ z, begin
+  by_cases hz : p z,
+  { rw [swap_apply_def, of_subtype_apply_of_mem _ hz],
+    split_ifs with hzx hzy,
+    { simp_rw [hzx, subtype.coe_eta, swap_apply_left], },
+    { simp_rw [hzy, subtype.coe_eta, swap_apply_right], },
+    { rw swap_apply_of_ne_of_ne, refl,
+      intro h, apply hzx, rw ← h, refl,
+      intro h, apply hzy, rw ← h, refl, } },
+  { rw [of_subtype_apply_of_not_mem _ hz, swap_apply_of_ne_of_ne],
+    intro h, apply hz, rw h, exact subtype.prop x,
+    intro h, apply hz, rw h, exact subtype.prop y, }
+end
+
 lemma is_swap.of_subtype_is_swap {p : α → Prop} [decidable_pred p]
   {f : perm (subtype p)} (h : f.is_swap) : (of_subtype f).is_swap :=
 let ⟨⟨x, hx⟩, ⟨y, hy⟩, hxy⟩ := h in
 ⟨x, y, by { simp only [ne.def] at hxy, exact hxy.1 },
-  equiv.ext $ λ z, begin
-    rw [hxy.2, of_subtype],
-    simp only [swap_apply_def, coe_fn_mk, swap_inv, subtype.mk_eq_mk, monoid_hom.coe_mk],
-    split_ifs;
-    rw subtype.coe_mk <|> cc,
-  end⟩
+  by { simp only [hxy.2, of_subtype_swap_eq], refl, }⟩
 
 lemma ne_and_ne_of_swap_mul_apply_ne_self {f : perm α} {x y : α}
   (hy : (swap x (f x) * f) y ≠ y) : f y ≠ y ∧ y ≠ x :=
@@ -225,7 +242,7 @@ lemma set_support_mul_subset :
   {x | (p * q) x ≠ x} ⊆ {x | p x ≠ x} ∪ {x | q x ≠ x} :=
 begin
   intro x,
-  simp only [perm.coe_mul, function.comp_app, ne.def, set.mem_union_eq, set.mem_set_of_eq],
+  simp only [perm.coe_mul, function.comp_app, ne.def, set.mem_union, set.mem_set_of_eq],
   by_cases hq : q x = x;
   simp [hq]
 end
@@ -381,7 +398,7 @@ lemma support_swap_iff (x y : α) :
 begin
   refine ⟨λ h H, _, support_swap⟩,
   subst H,
-  simp only [swap_self, support_refl, insert_singleton_self_eq] at h,
+  simp only [swap_self, support_refl, pair_eq_singleton] at h,
   have : x ∈ ∅,
   { rw h,
     exact mem_singleton.mpr rfl },
@@ -444,7 +461,7 @@ end
 
 lemma disjoint.mem_imp (h : disjoint f g) {x : α} (hx : x ∈ f.support) :
   x ∉ g.support :=
-λ H, h.disjoint_support (mem_inter_of_mem hx H)
+disjoint_left.mp h.disjoint_support hx
 
 lemma eq_on_support_mem_disjoint {l : list (perm α)} (h : f ∈ l) (hl : l.pairwise disjoint) :
   ∀ (x ∈ f.support), f x = l.prod x :=
@@ -467,8 +484,7 @@ lemma disjoint.mono {x y : perm α} (h : disjoint f g)
   disjoint x y :=
 begin
   rw disjoint_iff_disjoint_support at h ⊢,
-  intros a ha,
-  exact h (mem_inter_of_mem (hf (mem_of_mem_inter_left ha)) (hg (mem_of_mem_inter_right ha)))
+  exact h.mono hf hg,
 end
 
 lemma support_le_prod_of_mem {l : list (perm α)} (h : f ∈ l) (hl : l.pairwise disjoint) :
@@ -539,7 +555,7 @@ begin
 end
 
 @[simp] lemma card_support_le_one {f : perm α} : f.support.card ≤ 1 ↔ f = 1 :=
-by rw [le_iff_lt_or_eq, nat.lt_succ_iff, nat.le_zero_iff, card_support_eq_zero,
+by rw [le_iff_lt_or_eq, nat.lt_succ_iff, le_zero_iff, card_support_eq_zero,
   or_iff_not_imp_right, imp_iff_right f.card_support_ne_one]
 
 lemma two_le_card_support_of_ne_one {f : perm α} (h : f ≠ 1) :
@@ -602,4 +618,8 @@ end card
 
 end support
 
+@[simp] lemma support_subtype_perm [decidable_eq α] {s : finset α} (f : perm α) (h) :
+  (f.subtype_perm h : perm {x // x ∈ s}).support = s.attach.filter (λ x, f x ≠ x) :=
+by { ext, simp [subtype.ext_iff] }
+
 end equiv.perm
diff --git a/src/group_theory/perm/via_embedding.lean b/src/group_theory/perm/via_embedding.lean
new file mode 100644
index 0000000000000..d1b4dbc15c0e6
--- /dev/null
+++ b/src/group_theory/perm/via_embedding.lean
@@ -0,0 +1,48 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Mario Carneiro
+-/
+import group_theory.perm.basic
+import logic.equiv.set
+
+/-!
+# `equiv.perm.via_embedding`, a noncomputable analogue of `equiv.perm.via_fintype_embedding`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α β : Type*}
+
+namespace equiv
+
+namespace perm
+
+variables (e : perm α) (ι : α ↪ β)
+
+open_locale classical
+
+/-- Noncomputable version of `equiv.perm.via_fintype_embedding` that does not assume `fintype` -/
+noncomputable def via_embedding : perm β :=
+extend_domain e (of_injective ι.1 ι.2)
+
+lemma via_embedding_apply (x : α) : e.via_embedding ι (ι x) = ι (e x) :=
+extend_domain_apply_image e (of_injective ι.1 ι.2) x
+
+lemma via_embedding_apply_of_not_mem (x : β) (hx : x ∉ _root_.set.range ι) :
+  e.via_embedding ι x = x :=
+extend_domain_apply_not_subtype e (of_injective ι.1 ι.2) hx
+
+/-- `via_embedding` as a group homomorphism -/
+noncomputable def via_embedding_hom : perm α →* perm β:=
+extend_domain_hom (of_injective ι.1 ι.2)
+
+lemma via_embedding_hom_apply : via_embedding_hom ι e = via_embedding e ι := rfl
+
+lemma via_embedding_hom_injective : function.injective (via_embedding_hom ι) :=
+extend_domain_hom_injective (of_injective ι.1 ι.2)
+
+end perm
+
+end equiv
diff --git a/src/group_theory/presented_group.lean b/src/group_theory/presented_group.lean
index e1c6eb448ef22..853596283152a 100644
--- a/src/group_theory/presented_group.lean
+++ b/src/group_theory/presented_group.lean
@@ -9,6 +9,9 @@ import group_theory.quotient_group
 /-!
 # Defining a group given by generators and relations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a subset `rels` of relations of the free group on a type `α`, this file constructs the group
 given by generators `x : α` and relations `r ∈ rels`.
 
@@ -25,11 +28,11 @@ given by generators `x : α` and relations `r ∈ rels`.
 generators, relations, group presentations
 -/
 
-variables {α : Type}
+variables {α : Type*}
 
 /-- Given a set of relations, rels, over a type `α`, presented_group constructs the group with
 generators `x : α` and relations `rels` as a quotient of free_group `α`.-/
-def presented_group (rels : set (free_group α)) : Type :=
+def presented_group (rels : set (free_group α)) :=
 free_group α ⧸ subgroup.normal_closure rels
 
 namespace presented_group
@@ -50,7 +53,7 @@ the images of `f` satisfy all the given relations, then `f` extends uniquely to
 from `presented_group rels` to `G`.
 -/
 
-variables {G : Type} [group G] {f : α → G} {rels : set (free_group α)}
+variables {G : Type*} [group G] {f : α → G} {rels : set (free_group α)}
 
 local notation `F` := free_group.lift f
 
diff --git a/src/group_theory/quotient_group.lean b/src/group_theory/quotient_group.lean
index 111c54db10530..f4145c16e1f07 100644
--- a/src/group_theory/quotient_group.lean
+++ b/src/group_theory/quotient_group.lean
@@ -5,12 +5,17 @@ Authors: Kevin Buzzard, Patrick Massot
 
 This file is to a certain extent based on `quotient_module.lean` by Johannes Hölzl.
 -/
-import group_theory.coset
 import group_theory.congruence
+import group_theory.coset
+import group_theory.subgroup.finite
+import group_theory.subgroup.pointwise
 
 /-!
 # Quotients of groups by normal subgroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files develops the basic theory of quotients of groups by normal subgroups. In particular it
 proves Noether's first and second isomorphism theorems.
 
@@ -37,6 +42,7 @@ proves Noether's first and second isomorphism theorems.
 isomorphism theorems, quotient groups
 -/
 
+open function
 universes u v
 
 namespace quotient_group
@@ -48,17 +54,17 @@ include nN
 @[to_additive "The additive congruence relation generated by a normal additive subgroup."]
 protected def con : con G :=
 { to_setoid := left_rel N,
-  mul' := λ a b c d (hab : a⁻¹ * b ∈ N) (hcd : c⁻¹ * d ∈ N),
+  mul' := λ a b c d hab hcd, begin
+    rw [left_rel_eq] at hab hcd ⊢,
     calc (a * c)⁻¹ * (b * d) = c⁻¹ * (a⁻¹ * b) * c⁻¹⁻¹ * (c⁻¹ * d) :
       by simp only [mul_inv_rev, mul_assoc, inv_mul_cancel_left]
-    ... ∈ N : N.mul_mem (nN.conj_mem _ hab _) hcd }
+    ... ∈ N : N.mul_mem (nN.conj_mem _ hab _) hcd
+  end }
 
-@[to_additive quotient_add_group.add_group]
-instance quotient.group : group (G ⧸ N) :=
-(quotient_group.con N).group
+@[to_additive] instance quotient.group : group (G ⧸ N) := (quotient_group.con N).group
 
 /-- The group homomorphism from `G` to `G/N`. -/
-@[to_additive quotient_add_group.mk' "The additive group homomorphism from `G` to `G/N`."]
+@[to_additive "The additive group homomorphism from `G` to `G/N`."]
 def mk' : G →* G ⧸ N := monoid_hom.mk' (quotient_group.mk) (λ _ _, rfl)
 
 @[simp, to_additive]
@@ -68,7 +74,12 @@ lemma coe_mk' : (mk' N : G → G ⧸ N) = coe := rfl
 lemma mk'_apply (x : G) : mk' N x = x := rfl
 
 @[to_additive]
-lemma mk'_surjective : function.surjective $ mk' N := @mk_surjective _ _ N
+lemma mk'_surjective : surjective $ mk' N := @mk_surjective _ _ N
+
+@[to_additive]
+lemma mk'_eq_mk' {x y : G} : mk' N x = mk' N y ↔ ∃ z ∈ N, x * z = y :=
+quotient_group.eq'.trans $
+  by simp only [← _root_.eq_inv_mul_iff_mul_eq, exists_prop, exists_eq_right]
 
 /-- Two `monoid_hom`s from a quotient group are equal if their compositions with
 `quotient_group.mk'` are equal.
@@ -81,19 +92,18 @@ See note [partially-applied ext lemmas]. "-/]
 lemma monoid_hom_ext ⦃f g : G ⧸ N →* H⦄ (h : f.comp (mk' N) = g.comp (mk' N)) : f = g :=
 monoid_hom.ext $ λ x, quotient_group.induction_on x $ (monoid_hom.congr_fun h : _)
 
-@[simp, to_additive quotient_add_group.eq_zero_iff]
+@[simp, to_additive]
 lemma eq_one_iff {N : subgroup G} [nN : N.normal] (x : G) : (x : G ⧸ N) = 1 ↔ x ∈ N :=
 begin
   refine quotient_group.eq.trans _,
   rw [mul_one, subgroup.inv_mem_iff],
 end
 
-@[simp, to_additive quotient_add_group.ker_mk]
-lemma ker_mk :
-  monoid_hom.ker (quotient_group.mk' N : G →* G ⧸ N) = N :=
+@[simp, to_additive]
+lemma ker_mk : monoid_hom.ker (quotient_group.mk' N : G →* G ⧸ N) = N :=
 subgroup.ext eq_one_iff
 
-@[to_additive quotient_add_group.eq_iff_sub_mem]
+@[to_additive]
 lemma eq_iff_div_mem {N : subgroup G} [nN : N.normal] {x y : G} :
   (x : G ⧸ N) = y ↔ x / y ∈ N :=
 begin
@@ -104,8 +114,8 @@ end
 -- for commutative groups we don't need normality assumption
 omit nN
 
-@[to_additive quotient_add_group.add_comm_group]
-instance {G : Type*} [comm_group G] (N : subgroup G) : comm_group (G ⧸ N) :=
+@[to_additive]
+instance quotient.comm_group {G : Type*} [comm_group G] (N : subgroup G) : comm_group (G ⧸ N) :=
 { mul_comm := λ a b, quotient.induction_on₂' a b
     (λ a b, congr_arg mk (mul_comm a b)),
   .. @quotient_group.quotient.group _ _ N N.normal_of_comm }
@@ -114,48 +124,37 @@ include nN
 
 local notation ` Q ` := G ⧸ N
 
-@[simp, to_additive quotient_add_group.coe_zero]
-lemma coe_one : ((1 : G) : Q) = 1 := rfl
-
-@[simp, to_additive quotient_add_group.coe_add]
-lemma coe_mul (a b : G) : ((a * b : G) : Q) = a * b := rfl
-
-@[simp, to_additive quotient_add_group.coe_neg]
-lemma coe_inv (a : G) : ((a⁻¹ : G) : Q) = a⁻¹ := rfl
-
-@[simp, to_additive quotient_add_group.coe_sub]
-lemma coe_div (a b : G) : ((a / b : G) : Q) = a / b := rfl
-
-@[simp, to_additive quotient_add_group.coe_nsmul]
-lemma coe_pow (a : G) (n : ℕ) : ((a ^ n : G) : Q) = a ^ n := rfl
-
-@[simp, to_additive quotient_add_group.coe_zsmul]
-lemma coe_zpow (a : G) (n : ℤ) : ((a ^ n : G) : Q) = a ^ n := rfl
+@[simp, to_additive] lemma coe_one : ((1 : G) : Q) = 1 := rfl
+@[simp, to_additive] lemma coe_mul (a b : G) : ((a * b : G) : Q) = a * b := rfl
+@[simp, to_additive] lemma coe_inv (a : G) : ((a⁻¹ : G) : Q) = a⁻¹ := rfl
+@[simp, to_additive] lemma coe_div (a b : G) : ((a / b : G) : Q) = a / b := rfl
+@[simp, to_additive] lemma coe_pow (a : G) (n : ℕ) : ((a ^ n : G) : Q) = a ^ n := rfl
+@[simp, to_additive] lemma coe_zpow (a : G) (n : ℤ) : ((a ^ n : G) : Q) = a ^ n := rfl
 
 /-- A group homomorphism `φ : G →* H` with `N ⊆ ker(φ)` descends (i.e. `lift`s) to a
 group homomorphism `G/N →* H`. -/
-@[to_additive quotient_add_group.lift "An `add_group` homomorphism `φ : G →+ H` with `N ⊆ ker(φ)`
-descends (i.e. `lift`s) to a group homomorphism `G/N →* H`."]
+@[to_additive "An `add_group` homomorphism `φ : G →+ H` with `N ⊆ ker(φ)` descends (i.e. `lift`s)
+to a group homomorphism `G/N →* H`."]
 def lift (φ : G →* H) (HN : ∀x∈N, φ x = 1) : Q →* H :=
-(quotient_group.con N).lift φ $ λ x y (h : x⁻¹ * y ∈ N),
+(quotient_group.con N).lift φ $ λ x y h, begin
+  simp only [quotient_group.con, left_rel_apply, con.rel_mk] at h,
   calc φ x = φ (y * (x⁻¹ * y)⁻¹) : by rw [mul_inv_rev, inv_inv, mul_inv_cancel_left]
        ... = φ y                 : by rw [φ.map_mul, HN _ (N.inv_mem h), mul_one]
+  end
 
-@[simp, to_additive quotient_add_group.lift_mk]
-lemma lift_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
-  lift N φ HN (g : Q) = φ g := rfl
+@[simp, to_additive]
+lemma lift_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) : lift N φ HN (g : Q) = φ g := rfl
 
-@[simp, to_additive quotient_add_group.lift_mk']
-lemma lift_mk' {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
-  lift N φ HN (mk g : Q) = φ g := rfl
+@[simp, to_additive]
+lemma lift_mk' {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) : lift N φ HN (mk g : Q) = φ g := rfl
 
-@[simp, to_additive quotient_add_group.lift_quot_mk]
+@[simp, to_additive]
 lemma lift_quot_mk {φ : G →* H} (HN : ∀x∈N, φ x = 1) (g : G) :
   lift N φ HN (quot.mk _ g : Q) = φ g := rfl
 
 /-- A group homomorphism `f : G →* H` induces a map `G/N →* H/M` if `N ⊆ f⁻¹(M)`. -/
-@[to_additive quotient_add_group.map "An `add_group` homomorphism `f : G →+ H` induces a map
-`G/N →+ H/M` if `N ⊆ f⁻¹(M)`."]
+@[to_additive "An `add_group` homomorphism `f : G →+ H` induces a map `G/N →+ H/M` if
+`N ⊆ f⁻¹(M)`."]
 def map (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) :
   G ⧸ N →* H ⧸ M :=
 begin
@@ -166,59 +165,126 @@ begin
   exact h hx,
 end
 
-@[simp, to_additive quotient_add_group.map_coe] lemma map_coe
-  (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
+@[simp, to_additive] lemma map_coe (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f)
+  (x : G) :
   map N M f h ↑x = ↑(f x) :=
-lift_mk' _ _ x
+rfl
 
-@[to_additive quotient_add_group.map_mk'] lemma map_mk'
-  (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
+@[to_additive] lemma map_mk' (M : subgroup H) [M.normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
   map N M f h (mk' _ x) = ↑(f x) :=
-quotient_group.lift_mk' _ _ x
+rfl
+
+@[to_additive]
+lemma map_id_apply (h : N ≤ subgroup.comap (monoid_hom.id _) N := (subgroup.comap_id N).le) (x) :
+  map N N (monoid_hom.id _) h x = x :=
+induction_on' x $ λ x, rfl
+
+@[simp, to_additive]
+lemma map_id (h : N ≤ subgroup.comap (monoid_hom.id _) N := (subgroup.comap_id N).le) :
+  map N N (monoid_hom.id _) h = monoid_hom.id _ :=
+monoid_hom.ext (map_id_apply N h)
+
+@[simp, to_additive]
+lemma map_map {I : Type*} [group I] (M : subgroup H) (O : subgroup I)
+  [M.normal] [O.normal]
+  (f : G →* H) (g : H →* I) (hf : N ≤ subgroup.comap f M) (hg : M ≤ subgroup.comap g O)
+  (hgf : N ≤ subgroup.comap (g.comp f) O :=
+    hf.trans ((subgroup.comap_mono hg).trans_eq (subgroup.comap_comap _ _ _))) (x : G ⧸ N) :
+  map M O g hg (map N M f hf x) = map N O (g.comp f) hgf x :=
+begin
+  refine induction_on' x (λ x, _),
+  simp only [map_coe, monoid_hom.comp_apply]
+end
+
+@[simp, to_additive]
+lemma map_comp_map {I : Type*} [group I] (M : subgroup H) (O : subgroup I)
+  [M.normal] [O.normal]
+  (f : G →* H) (g : H →* I) (hf : N ≤ subgroup.comap f M) (hg : M ≤ subgroup.comap g O)
+  (hgf : N ≤ subgroup.comap (g.comp f) O :=
+    hf.trans ((subgroup.comap_mono hg).trans_eq (subgroup.comap_comap _ _ _))) :
+  (map M O g hg).comp (map N M f hf) = map N O (g.comp f) hgf :=
+monoid_hom.ext (map_map N M O f g hf hg hgf)
 
 omit nN
+
+section congr
+
+variables (G' : subgroup G) (H' : subgroup H) [subgroup.normal G'] [subgroup.normal H']
+
+/-- `quotient_group.congr` lifts the isomorphism `e : G ≃ H` to `G ⧸ G' ≃ H ⧸ H'`,
+given that `e` maps `G` to `H`. -/
+@[to_additive "`quotient_add_group.congr` lifts the isomorphism `e : G ≃ H` to `G ⧸ G' ≃ H ⧸ H'`,
+given that `e` maps `G` to `H`."]
+def congr (e : G ≃* H) (he : G'.map ↑e = H') : G ⧸ G' ≃* H ⧸ H' :=
+{ to_fun := map G' H' ↑e (he ▸ G'.le_comap_map e),
+  inv_fun := map H' G' ↑e.symm (he ▸ (G'.map_equiv_eq_comap_symm e).le),
+  left_inv := λ x, by rw map_map; -- `simp` doesn't like this lemma...
+    simp only [map_map, ← mul_equiv.coe_monoid_hom_trans, mul_equiv.self_trans_symm,
+        mul_equiv.coe_monoid_hom_refl, map_id_apply],
+  right_inv := λ x, by rw map_map; -- `simp` doesn't like this lemma...
+    simp only [← mul_equiv.coe_monoid_hom_trans, mul_equiv.symm_trans_self,
+        mul_equiv.coe_monoid_hom_refl, map_id_apply],
+  .. map G' H' ↑e (he ▸ G'.le_comap_map e) }
+
+@[simp] lemma congr_mk (e : G ≃* H) (he : G'.map ↑e = H')
+  (x) : congr G' H' e he (mk x) = e x :=
+rfl
+
+lemma congr_mk' (e : G ≃* H) (he : G'.map ↑e = H')
+  (x) : congr G' H' e he (mk' G' x) = mk' H' (e x) :=
+rfl
+
+@[simp] lemma congr_apply (e : G ≃* H) (he : G'.map ↑e = H')
+  (x : G) : congr G' H' e he x = mk' H' (e x) :=
+rfl
+
+@[simp] lemma congr_refl (he : G'.map (mul_equiv.refl G : G →* G) = G' := subgroup.map_id G') :
+  congr G' G' (mul_equiv.refl G) he = mul_equiv.refl (G ⧸ G') :=
+by { ext ⟨x⟩, refl }
+
+@[simp] lemma congr_symm (e : G ≃* H) (he : G'.map ↑e = H') :
+  (congr G' H' e he).symm = congr H' G' e.symm ((subgroup.map_symm_eq_iff_map_eq _).mpr he) :=
+rfl
+
+end congr
+
 variables (φ : G →* H)
 
-open function monoid_hom
+open monoid_hom
 
 /-- The induced map from the quotient by the kernel to the codomain. -/
-@[to_additive quotient_add_group.ker_lift "The induced map from the quotient by the kernel to the
-codomain."]
+@[to_additive "The induced map from the quotient by the kernel to the codomain."]
 def ker_lift : G ⧸ ker φ →* H :=
 lift _ φ $ λ g, φ.mem_ker.mp
 
-@[simp, to_additive quotient_add_group.ker_lift_mk]
-lemma ker_lift_mk (g : G) : (ker_lift φ) g = φ g :=
-lift_mk _ _ _
+@[simp, to_additive]
+lemma ker_lift_mk (g : G) : (ker_lift φ) g = φ g := lift_mk _ _ _
 
-@[simp, to_additive quotient_add_group.ker_lift_mk']
-lemma ker_lift_mk' (g : G) : (ker_lift φ) (mk g) = φ g :=
-lift_mk' _ _ _
+@[simp, to_additive]
+lemma ker_lift_mk' (g : G) : (ker_lift φ) (mk g) = φ g := lift_mk' _ _ _
 
-@[to_additive quotient_add_group.ker_lift_injective]
+@[to_additive]
 lemma ker_lift_injective : injective (ker_lift φ) :=
 assume a b, quotient.induction_on₂' a b $
   assume a b (h : φ a = φ b), quotient.sound' $
-show a⁻¹ * b ∈ ker φ, by rw [mem_ker,
-  φ.map_mul, ← h, φ.map_inv, inv_mul_self]
+  by rw [left_rel_apply, mem_ker, φ.map_mul, ← h, φ.map_inv, inv_mul_self]
 
 -- Note that `ker φ` isn't definitionally `ker (φ.range_restrict)`
 -- so there is a bit of annoying code duplication here
 
 /-- The induced map from the quotient by the kernel to the range. -/
-@[to_additive quotient_add_group.range_ker_lift "The induced map from the quotient by the kernel to
-the range."]
+@[to_additive "The induced map from the quotient by the kernel to the range."]
 def range_ker_lift : G ⧸ ker φ →* φ.range :=
-lift _ φ.range_restrict $ λ g hg, (mem_ker _).mp $ by rwa range_restrict_ker
+lift _ φ.range_restrict $ λ g hg, (mem_ker _).mp $ by rwa ker_range_restrict
 
-@[to_additive quotient_add_group.range_ker_lift_injective]
+@[to_additive]
 lemma range_ker_lift_injective : injective (range_ker_lift φ) :=
 assume a b, quotient.induction_on₂' a b $
   assume a b (h : φ.range_restrict a = φ.range_restrict b), quotient.sound' $
-show a⁻¹ * b ∈ ker φ, by rw [←range_restrict_ker, mem_ker,
+  by rw [left_rel_apply, ←ker_range_restrict, mem_ker,
   φ.range_restrict.map_mul, ← h, φ.range_restrict.map_inv, inv_mul_self]
 
-@[to_additive quotient_add_group.range_ker_lift_surjective]
+@[to_additive]
 lemma range_ker_lift_surjective : surjective (range_ker_lift φ) :=
 begin
   rintro ⟨_, g, rfl⟩,
@@ -228,26 +294,25 @@ end
 
 /-- **Noether's first isomorphism theorem** (a definition): the canonical isomorphism between
 `G/(ker φ)` to `range φ`. -/
-@[to_additive quotient_add_group.quotient_ker_equiv_range "The first isomorphism theorem
-(a definition): the canonical isomorphism between `G/(ker φ)` to `range φ`."]
+@[to_additive "The first isomorphism theorem (a definition): the canonical isomorphism between
+`G/(ker φ)` to `range φ`."]
 noncomputable def quotient_ker_equiv_range : G ⧸ ker φ ≃* range φ :=
 mul_equiv.of_bijective (range_ker_lift φ) ⟨range_ker_lift_injective φ, range_ker_lift_surjective φ⟩
 
 /-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a homomorphism `φ : G →* H`
 with a right inverse `ψ : H → G`. -/
-@[to_additive quotient_add_group.quotient_ker_equiv_of_right_inverse "The canonical isomorphism
-`G/(ker φ) ≃+ H` induced by a homomorphism `φ : G →+ H` with a right inverse `ψ : H → G`.",
-  simps]
-def quotient_ker_equiv_of_right_inverse (ψ : H → G) (hφ : function.right_inverse ψ φ) :
+@[to_additive "The canonical isomorphism `G/(ker φ) ≃+ H` induced by a homomorphism `φ : G →+ H`
+with a right inverse `ψ : H → G`.", simps]
+def quotient_ker_equiv_of_right_inverse (ψ : H → G) (hφ : right_inverse ψ φ) :
   G ⧸ ker φ ≃* H :=
 { to_fun := ker_lift φ,
   inv_fun := mk ∘ ψ,
-  left_inv := λ x, ker_lift_injective φ (by rw [function.comp_app, ker_lift_mk', hφ]),
+  left_inv := λ x, ker_lift_injective φ (by rw [comp_app, ker_lift_mk', hφ]),
   right_inv := hφ,
   .. ker_lift φ }
 
 /-- The canonical isomorphism `G/⊥ ≃* G`. -/
-@[to_additive quotient_add_group.quotient_bot "The canonical isomorphism `G/⊥ ≃+ G`.", simps]
+@[to_additive "The canonical isomorphism `G/⊥ ≃+ G`.", simps]
 def quotient_bot : G ⧸ (⊥ : subgroup G) ≃* G :=
 quotient_ker_equiv_of_right_inverse (monoid_hom.id G) id (λ x, rfl)
 
@@ -255,11 +320,10 @@ quotient_ker_equiv_of_right_inverse (monoid_hom.id G) id (λ x, rfl)
 
 For a `computable` version, see `quotient_group.quotient_ker_equiv_of_right_inverse`.
 -/
-@[to_additive quotient_add_group.quotient_ker_equiv_of_surjective "The canonical isomorphism
-`G/(ker φ) ≃+ H` induced by a surjection `φ : G →+ H`.
+@[to_additive "The canonical isomorphism `G/(ker φ) ≃+ H` induced by a surjection `φ : G →+ H`.
 
 For a `computable` version, see `quotient_add_group.quotient_ker_equiv_of_right_inverse`."]
-noncomputable def quotient_ker_equiv_of_surjective (hφ : function.surjective φ) :
+noncomputable def quotient_ker_equiv_of_surjective (hφ : surjective φ) :
   G ⧸ (ker φ) ≃* H :=
 quotient_ker_equiv_of_right_inverse φ _ hφ.has_right_inverse.some_spec
 
@@ -267,17 +331,14 @@ quotient_ker_equiv_of_right_inverse φ _ hφ.has_right_inverse.some_spec
 isomorphic. -/
 @[to_additive "If two normal subgroups `M` and `N` of `G` are the same, their quotient groups are
 isomorphic."]
-def equiv_quotient_of_eq {M N : subgroup G} [M.normal] [N.normal] (h : M = N) :
+def quotient_mul_equiv_of_eq {M N : subgroup G} [M.normal] [N.normal] (h : M = N) :
   G ⧸ M ≃* G ⧸ N :=
-{ to_fun := (lift M (mk' N) (λ m hm, quotient_group.eq.mpr (by simpa [← h] using M.inv_mem hm))),
-  inv_fun := (lift N (mk' M) (λ n hn, quotient_group.eq.mpr (by simpa [← h] using N.inv_mem hn))),
-  left_inv := λ x, x.induction_on' $ by { intro, refl },
-  right_inv := λ x, x.induction_on' $ by { intro, refl },
-  map_mul' := λ x y, by rw monoid_hom.map_mul }
+{ map_mul' := λ q r, quotient.induction_on₂' q r (λ g h, rfl),
+  .. subgroup.quotient_equiv_of_eq h }
 
 @[simp, to_additive]
-lemma equiv_quotient_of_eq_mk {M N : subgroup G} [M.normal] [N.normal] (h : M = N) (x : G) :
-  quotient_group.equiv_quotient_of_eq h (quotient_group.mk x) = (quotient_group.mk x) :=
+lemma quotient_mul_equiv_of_eq_mk {M N : subgroup G} [M.normal] [N.normal] (h : M = N) (x : G) :
+  quotient_group.quotient_mul_equiv_of_eq h (quotient_group.mk x) = (quotient_group.mk x) :=
 rfl
 
 /-- Let `A', A, B', B` be subgroups of `G`. If `A' ≤ B'` and `A ≤ B`,
@@ -288,8 +349,7 @@ def quotient_map_subgroup_of_of_le {A' A B' B : subgroup G}
   [hAN : (A'.subgroup_of A).normal] [hBN : (B'.subgroup_of B).normal]
   (h' : A' ≤ B') (h : A ≤ B) :
   A ⧸ (A'.subgroup_of A) →* B ⧸ (B'.subgroup_of B) :=
-map _ _ (subgroup.inclusion h) $
-  by simp [subgroup.subgroup_of, subgroup.comap_comap]; exact subgroup.comap_mono h'
+map _ _ (subgroup.inclusion h) $ subgroup.comap_mono h'
 
 @[simp, to_additive]
 lemma quotient_map_subgroup_of_of_le_coe {A' A B' B : subgroup G}
@@ -320,29 +380,57 @@ monoid_hom.to_mul_equiv
 
 section zpow
 
-variables {G' H' : Type u} [comm_group G'] [comm_group H']
-variables (φ' : G' →* H') (ψ' : H' →* G') (χ : G' ≃* H')
+variables {A B C : Type u} [comm_group A] [comm_group B] [comm_group C]
+variables (f : A →* B) (g : B →* A) (e : A ≃* B) (d : B ≃* C) (n : ℤ)
 
 /-- The map of quotients by powers of an integer induced by a group homomorphism. -/
 @[to_additive "The map of quotients by multiples of an integer induced by an additive group
 homomorphism."]
-def hom_quotient_zpow_of_hom (n : ℤ) :
-  G' ⧸ (zpow_group_hom n : G' →* G').range →* H' ⧸ (zpow_group_hom n : H' →* H').range :=
-lift _ ((mk' _).comp φ') $
+def hom_quotient_zpow_of_hom :
+  A ⧸ (zpow_group_hom n : A →* A).range →* B ⧸ (zpow_group_hom n : B →* B).range :=
+lift _ ((mk' _).comp f) $
   λ g ⟨h, (hg : h ^ n = g)⟩, (eq_one_iff _).mpr ⟨_, by simpa only [← hg, map_zpow]⟩
 
-@[to_additive, simp]
-lemma hom_quotient_zpow_of_hom_right_inverse (h : function.right_inverse ψ' φ') (n : ℤ) :
-  (hom_quotient_zpow_of_hom φ' n).comp (hom_quotient_zpow_of_hom ψ' n) = monoid_hom.id _ :=
-monoid_hom_ext _ $ monoid_hom.ext $ λ g, congr_arg coe $ h g
+@[simp, to_additive]
+lemma hom_quotient_zpow_of_hom_id :
+  hom_quotient_zpow_of_hom (monoid_hom.id A) n = monoid_hom.id _ :=
+monoid_hom_ext _ rfl
+
+@[simp, to_additive]
+lemma hom_quotient_zpow_of_hom_comp :
+  hom_quotient_zpow_of_hom (f.comp g) n
+    = (hom_quotient_zpow_of_hom f n).comp (hom_quotient_zpow_of_hom g n) :=
+monoid_hom_ext _ rfl
+
+@[simp, to_additive]
+lemma hom_quotient_zpow_of_hom_comp_of_right_inverse (i : function.right_inverse g f) :
+  (hom_quotient_zpow_of_hom f n).comp (hom_quotient_zpow_of_hom g n) = monoid_hom.id _ :=
+monoid_hom_ext _ $ monoid_hom.ext $ λ x, congr_arg coe $ i x
 
 /-- The equivalence of quotients by powers of an integer induced by a group isomorphism. -/
 @[to_additive "The equivalence of quotients by multiples of an integer induced by an additive group
 isomorphism."]
-def equiv_quotient_zpow_of_equiv (χ : G' ≃* H') (n : ℤ) :
-  G' ⧸ (zpow_group_hom n : G' →* G').range ≃* H' ⧸ (zpow_group_hom n : H' →* H').range :=
-monoid_hom.to_mul_equiv _ _ (hom_quotient_zpow_of_hom_right_inverse χ.symm χ χ.left_inv n)
-  (hom_quotient_zpow_of_hom_right_inverse χ χ.symm χ.right_inv n)
+def equiv_quotient_zpow_of_equiv :
+  A ⧸ (zpow_group_hom n : A →* A).range ≃* B ⧸ (zpow_group_hom n : B →* B).range :=
+monoid_hom.to_mul_equiv _ _ (hom_quotient_zpow_of_hom_comp_of_right_inverse e.symm e n e.left_inv)
+  (hom_quotient_zpow_of_hom_comp_of_right_inverse e e.symm n e.right_inv)
+
+@[simp, to_additive]
+lemma equiv_quotient_zpow_of_equiv_refl :
+  mul_equiv.refl (A ⧸ (zpow_group_hom n : A →* A).range)
+    = equiv_quotient_zpow_of_equiv (mul_equiv.refl A) n :=
+by { ext x, rw [← quotient.out_eq' x], refl }
+
+@[simp, to_additive]
+lemma equiv_quotient_zpow_of_equiv_symm :
+  (equiv_quotient_zpow_of_equiv e n).symm = equiv_quotient_zpow_of_equiv e.symm n :=
+rfl
+
+@[simp, to_additive]
+lemma equiv_quotient_zpow_of_equiv_trans :
+  (equiv_quotient_zpow_of_equiv e n).trans (equiv_quotient_zpow_of_equiv d n)
+    = equiv_quotient_zpow_of_equiv (e.trans d) n :=
+by { ext x, rw [← quotient.out_eq' x], refl }
 
 end zpow
 
@@ -355,18 +443,21 @@ open _root_.subgroup
 @[to_additive "The second isomorphism theorem: given two subgroups `H` and `N` of a group `G`,
 where `N` is normal, defines an isomorphism between `H/(H ∩ N)` and `(H + N)/N`"]
 noncomputable def quotient_inf_equiv_prod_normal_quotient (H N : subgroup G) [N.normal] :
-  H ⧸ ((H ⊓ N).comap H.subtype) ≃* _ ⧸ (N.comap (H ⊔ N).subtype) :=
+  H ⧸ (N.subgroup_of H) ≃* _ ⧸ (N.subgroup_of (H ⊔ N)) :=
 /- φ is the natural homomorphism H →* (HN)/N. -/
-let φ : H →* _ ⧸ (N.comap (H ⊔ N).subtype) :=
-  (mk' $ N.comap (H ⊔ N).subtype).comp (inclusion le_sup_left) in
-have φ_surjective : function.surjective φ := λ x, x.induction_on' $
+let φ : H →* _ ⧸ (N.subgroup_of (H ⊔ N)) :=
+  (mk' $ N.subgroup_of (H ⊔ N)).comp (inclusion le_sup_left) in
+have φ_surjective : surjective φ := λ x, x.induction_on' $
   begin
     rintro ⟨y, (hy : y ∈ ↑(H ⊔ N))⟩, rw mul_normal H N at hy,
     rcases hy with ⟨h, n, hh, hn, rfl⟩,
-    use [h, hh], apply quotient.eq.mpr, change h⁻¹ * (h * n) ∈ N,
+    use [h, hh], apply quotient.eq.mpr,
+    change setoid.r _ _,
+    rw left_rel_apply,
+    change h⁻¹ * (h * n) ∈ N,
     rwa [←mul_assoc, inv_mul_self, one_mul],
   end,
-(equiv_quotient_of_eq (by simp [comap_comap, ←comap_ker])).trans
+(quotient_mul_equiv_of_eq (by simp [← comap_ker])).trans
   (quotient_ker_equiv_of_surjective φ φ_surjective)
 
 end snd_isomorphism_thm
@@ -377,19 +468,14 @@ variables (M : subgroup G) [nM : M.normal]
 
 include nM nN
 
-@[to_additive quotient_add_group.map_normal]
-instance map_normal : (M.map (quotient_group.mk' N)).normal :=
-{ conj_mem := begin
-    rintro _ ⟨x, hx, rfl⟩ y,
-    refine induction_on' y (λ y, ⟨y * x * y⁻¹, subgroup.normal.conj_mem nM x hx y, _⟩),
-    simp only [mk'_apply, coe_mul, coe_inv]
-  end }
+@[to_additive] instance map_normal : (M.map (quotient_group.mk' N)).normal :=
+nM.map _ mk_surjective
 
 variables (h : N ≤ M)
 
 /-- The map from the third isomorphism theorem for groups: `(G / N) / (M / N) → G / M`. -/
-@[to_additive quotient_add_group.quotient_quotient_equiv_quotient_aux
-"The map from the third isomorphism theorem for additive groups: `(A / N) / (M / N) → A / M`."]
+@[to_additive "The map from the third isomorphism theorem for additive groups:
+`(A / N) / (M / N) → A / M`."]
 def quotient_quotient_equiv_quotient_aux :
   (G ⧸ N) ⧸ (M.map (mk' N)) →* G ⧸ M :=
 lift (M.map (mk' N))
@@ -397,20 +483,20 @@ lift (M.map (mk' N))
   (by { rintro _ ⟨x, hx, rfl⟩, rw map_mk' N M _ _ x,
         exact (quotient_group.eq_one_iff _).mpr hx })
 
-@[simp, to_additive quotient_add_group.quotient_quotient_equiv_quotient_aux_coe]
+@[simp, to_additive]
 lemma quotient_quotient_equiv_quotient_aux_coe (x : G ⧸ N) :
   quotient_quotient_equiv_quotient_aux N M h x = quotient_group.map N M (monoid_hom.id G) h x :=
 quotient_group.lift_mk' _ _ x
 
-@[to_additive quotient_add_group.quotient_quotient_equiv_quotient_aux_coe_coe]
+@[to_additive]
 lemma quotient_quotient_equiv_quotient_aux_coe_coe (x : G) :
   quotient_quotient_equiv_quotient_aux N M h (x : G ⧸ N) =
     x :=
 quotient_group.lift_mk' _ _ x
 
-/-- **Noether's third isomorphism theorem** for groups: `(G / N) / (M / N) ≃ G / M`. -/
-@[to_additive quotient_add_group.quotient_quotient_equiv_quotient
-"**Noether's third isomorphism theorem** for additive groups: `(A / N) / (M / N) ≃ A / M`."]
+/-- **Noether's third isomorphism theorem** for groups: `(G / N) / (M / N) ≃* G / M`. -/
+@[to_additive "**Noether's third isomorphism theorem** for additive groups:
+`(A / N) / (M / N) ≃+ A / M`."]
 def quotient_quotient_equiv_quotient :
   (G ⧸ N) ⧸ (M.map (quotient_group.mk' N)) ≃* G ⧸ M :=
 monoid_hom.to_mul_equiv
@@ -425,7 +511,11 @@ section trivial
 
 @[to_additive] lemma subsingleton_quotient_top :
   subsingleton (G ⧸ (⊤ : subgroup G)) :=
-trunc.subsingleton
+begin
+  dsimp [has_quotient.quotient, subgroup.has_quotient, quotient],
+  rw left_rel_eq,
+  exact @trunc.subsingleton G,
+end
 
 /-- If the quotient by a subgroup gives a singleton then the subgroup is the whole group. -/
 @[to_additive "If the quotient by an additive subgroup gives a singleton then the additive subgroup
@@ -433,22 +523,18 @@ is the whole additive group."] lemma subgroup_eq_top_of_subsingleton (H : subgro
   (h : subsingleton (G ⧸ H)) : H = ⊤ :=
 top_unique $ λ x _,
   have this : 1⁻¹ * x ∈ H := quotient_group.eq.1 (subsingleton.elim _ _),
-  by rwa [one_inv, one_mul] at this
+  by rwa [inv_one, one_mul] at this
 
 end trivial
 
-@[to_additive quotient_add_group.comap_comap_center]
+@[to_additive]
 lemma comap_comap_center {H₁ : subgroup G} [H₁.normal] {H₂ : subgroup (G ⧸ H₁)} [H₂.normal] :
   (((subgroup.center ((G ⧸ H₁) ⧸ H₂))).comap (mk' H₂)).comap (mk' H₁) =
   (subgroup.center (G ⧸ H₂.comap (mk' H₁))).comap (mk' (H₂.comap (mk' H₁))) :=
 begin
   ext x,
-  simp only [mk'_apply, subgroup.mem_comap, subgroup.mem_center_iff, forall_coe],
-  apply forall_congr,
-  change ∀ (y : G), (↑↑(y * x) = ↑↑(x * y) ↔ ↑(y * x) = ↑(x * y)),
-  intro y,
-  repeat { rw [eq_iff_div_mem] },
-  simp,
+  simp only [mk'_apply, subgroup.mem_comap, subgroup.mem_center_iff, forall_coe,
+    ← coe_mul, eq_iff_div_mem, coe_div]
 end
 
 end quotient_group
diff --git a/src/group_theory/schreier.lean b/src/group_theory/schreier.lean
index 4381c2e8449d0..b13b3323c061d 100644
--- a/src/group_theory/schreier.lean
+++ b/src/group_theory/schreier.lean
@@ -4,15 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning
 -/
 
-import data.finset.pointwise
-import group_theory.complement
-import group_theory.finiteness
-import group_theory.index
-import tactic.group
+import group_theory.abelianization
+import group_theory.exponent
+import group_theory.transfer
 
 /-!
 # Schreier's Lemma
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove Schreier's lemma.
 
 ## Main results
@@ -22,6 +23,8 @@ In this file we prove Schreier's lemma.
   then `H` is generated by the `set` `(R * S).image (λ g, g * (to_fun hR g)⁻¹)`.
 - `fg_of_index_ne_zero` : **Schreier's Lemma**: A finite index subgroup of a finitely generated
   group is finitely generated.
+- `card_commutator_le_of_finite_commutator_set`: A theorem of Schur: The size of the commutator
+  subgroup is bounded in terms of the number of commutators.
 -/
 
 open_locale pointwise
@@ -76,7 +79,7 @@ begin
   apply (mem_right_transversals_iff_exists_unique_mul_inv_mem.mp hR r).unique,
   { rw [subtype.coe_mk, mul_inv_self],
     exact H.one_mem },
-  { rw [subtype.coe_mk, one_inv, mul_one],
+  { rw [subtype.coe_mk, inv_one, mul_one],
     exact (H.mul_mem_cancel_left (hU hg)).mp hh },
 end
 
@@ -103,19 +106,21 @@ begin
   exact closure_mul_image_eq_top hR hR1 hS,
 end
 
-lemma exists_finset_card_le_mul (hH : H.index ≠ 0) {S : finset G} (hS : closure (S : set G) = ⊤) :
+variables (H)
+
+lemma exists_finset_card_le_mul [finite_index H] {S : finset G} (hS : closure (S : set G) = ⊤) :
   ∃ T : finset H, T.card ≤ H.index * S.card ∧ closure (T : set H) = ⊤ :=
 begin
+  letI := H.fintype_quotient_of_finite_index,
   haveI : decidable_eq G := classical.dec_eq G,
   obtain ⟨R₀, hR : R₀ ∈ right_transversals (H : set G), hR1⟩ := exists_right_transversal (1 : G),
-  haveI : fintype (G ⧸ H) := fintype_of_index_ne_zero hH,
   haveI : fintype R₀ := fintype.of_equiv _ (mem_right_transversals.to_equiv hR),
   let R : finset G := set.to_finset R₀,
   replace hR : (R : set G) ∈ right_transversals (H : set G) := by rwa set.coe_to_finset,
   replace hR1 : (1 : G) ∈ R := by rwa set.mem_to_finset,
   refine ⟨_, _, closure_mul_image_eq_top' hR hR1 hS⟩,
   calc _ ≤ (R * S).card : finset.card_image_le
-  ... ≤ (R.product S).card : finset.card_image_le
+  ... ≤ (R ×ˢ S).card : finset.card_image_le
   ... = R.card * S.card : R.card_product S
   ... = H.index * S.card : congr_arg (* S.card) _,
   calc R.card = fintype.card R : (fintype.card_coe R).symm
@@ -126,24 +131,85 @@ end
 
 /-- **Schreier's Lemma**: A finite index subgroup of a finitely generated
   group is finitely generated. -/
-lemma fg_of_index_ne_zero [hG : group.fg G] (hH : H.index ≠ 0) : group.fg H :=
+instance fg_of_index_ne_zero [hG : group.fg G] [finite_index H] : group.fg H :=
 begin
   obtain ⟨S, hS⟩ := hG.1,
-  obtain ⟨T, -, hT⟩ := exists_finset_card_le_mul hH hS,
+  obtain ⟨T, -, hT⟩ := exists_finset_card_le_mul H hS,
   exact ⟨⟨T, hT⟩⟩,
 end
 
-lemma rank_le_index_mul_rank [hG : group.fg G] {H : subgroup G} (hH : H.index ≠ 0)
-  [decidable_pred (λ n, ∃ (S : finset G), S.card = n ∧ subgroup.closure (S : set G) = ⊤)]
-  [decidable_pred (λ n, ∃ (S : finset H), S.card = n ∧ subgroup.closure (S : set H) = ⊤)] :
-  @group.rank H _ (fg_of_index_ne_zero hH) _ ≤ H.index * group.rank G :=
+lemma rank_le_index_mul_rank [hG : group.fg G] [finite_index H] :
+  group.rank H ≤ H.index * group.rank G :=
 begin
-  haveI := fg_of_index_ne_zero hH,
+  haveI := H.fg_of_index_ne_zero,
   obtain ⟨S, hS₀, hS⟩ := group.rank_spec G,
-  obtain ⟨T, hT₀, hT⟩ := exists_finset_card_le_mul hH hS,
+  obtain ⟨T, hT₀, hT⟩ := exists_finset_card_le_mul H hS,
   calc group.rank H ≤ T.card : group.rank_le H hT
   ... ≤ H.index * S.card : hT₀
   ... = H.index * group.rank G : congr_arg ((*) H.index) hS₀,
 end
 
+variables (G)
+
+/-- If `G` has `n` commutators `[g₁, g₂]`, then `|G'| ∣ [G : Z(G)] ^ ([G : Z(G)] * n + 1)`,
+where `G'` denotes the commutator of `G`. -/
+lemma card_commutator_dvd_index_center_pow [finite (commutator_set G)] :
+  nat.card (commutator G) ∣
+    (center G).index ^ ((center G).index * nat.card (commutator_set G) + 1) :=
+begin
+  -- First handle the case when `Z(G)` has infinite index and `[G : Z(G)]` is defined to be `0`
+  by_cases hG : (center G).index = 0,
+  { simp_rw [hG, zero_mul, zero_add, pow_one, dvd_zero] },
+  haveI : finite_index (center G) := ⟨hG⟩,
+  -- Rewrite as `|Z(G) ∩ G'| * [G' : Z(G) ∩ G'] ∣ [G : Z(G)] ^ ([G : Z(G)] * n) * [G : Z(G)]`
+  rw [←((center G).subgroup_of (commutator G)).card_mul_index, pow_succ'],
+  -- We have `h1 : [G' : Z(G) ∩ G'] ∣ [G : Z(G)]`
+  have h1 := relindex_dvd_index_of_normal (center G) (commutator G),
+  -- So we can reduce to proving `|Z(G) ∩ G'| ∣ [G : Z(G)] ^ ([G : Z(G)] * n)`
+  refine mul_dvd_mul _ h1,
+  -- We know that `[G' : Z(G) ∩ G'] < ∞` by `h1` and `hG`
+  haveI : finite_index ((center G).subgroup_of (commutator G)) := ⟨ne_zero_of_dvd_ne_zero hG h1⟩,
+  -- We have `h2 : rank (Z(G) ∩ G') ≤ [G' : Z(G) ∩ G'] * rank G'` by Schreier's lemma
+  have h2 := rank_le_index_mul_rank ((center G).subgroup_of (commutator G)),
+  -- We have `h3 : [G' : Z(G) ∩ G'] * rank G' ≤ [G : Z(G)] * n` by `h1` and `rank G' ≤ n`
+  have h3 := nat.mul_le_mul (nat.le_of_dvd (nat.pos_of_ne_zero hG) h1) (rank_commutator_le_card G),
+  -- So we can reduce to proving `|Z(G) ∩ G'| ∣ [G : Z(G)] ^ rank (Z(G) ∩ G')`
+  refine dvd_trans _ (pow_dvd_pow (center G).index (h2.trans h3)),
+  -- `Z(G) ∩ G'` is abelian, so it enough to prove that `g ^ [G : Z(G)] = 1` for `g ∈ Z(G) ∩ G'`
+  apply card_dvd_exponent_pow_rank' _ (λ g, _),
+  -- `Z(G)` is abelian, so `g ∈ Z(G) ∩ G' ≤ G' ≤ ker (transfer : G → Z(G))`
+  have := abelianization.commutator_subset_ker (monoid_hom.transfer_center_pow G) g.1.2,
+  -- `transfer g` is defeq to `g ^ [G : Z(G)]`, so we are done
+  simpa only [monoid_hom.mem_ker, subtype.ext_iff] using this,
+end
+
+/-- A bound for the size of the commutator subgroup in terms of the number of commutators. -/
+def card_commutator_bound (n : ℕ) := (n ^ (2 * n)) ^ (n ^ (2 * n + 1) + 1)
+
+/-- A theorem of Schur: The size of the commutator subgroup is bounded in terms of the number of
+  commutators. -/
+lemma card_commutator_le_of_finite_commutator_set [finite (commutator_set G)] :
+  nat.card (commutator G) ≤ card_commutator_bound (nat.card (commutator_set G)) :=
+begin
+  have h1 := index_center_le_pow (closure_commutator_representatives G),
+  have h2 := card_commutator_dvd_index_center_pow (closure_commutator_representatives G),
+  rw card_commutator_set_closure_commutator_representatives at h1 h2,
+  rw card_commutator_closure_commutator_representatives at h2,
+  replace h1 := h1.trans (nat.pow_le_pow_of_le_right finite.card_pos
+    (rank_closure_commutator_representations_le G)),
+  replace h2 := h2.trans (pow_dvd_pow _ (add_le_add_right (mul_le_mul_right' h1 _) 1)),
+  rw ← pow_succ' at h2,
+  refine (nat.le_of_dvd _ h2).trans (nat.pow_le_pow_of_le_left h1 _),
+  exact pow_pos (nat.pos_of_ne_zero finite_index.finite_index) _,
+end
+
+/-- A theorem of Schur: A group with finitely many commutators has finite commutator subgroup. -/
+instance [finite (commutator_set G)] : finite (commutator G) :=
+begin
+  have h2 := card_commutator_dvd_index_center_pow (closure_commutator_representatives G),
+  refine nat.finite_of_card_ne_zero (λ h, _),
+  rw [card_commutator_closure_commutator_representatives, h, zero_dvd_iff] at h2,
+  exact finite_index.finite_index (pow_eq_zero h2),
+end
+
 end subgroup
diff --git a/src/group_theory/schur_zassenhaus.lean b/src/group_theory/schur_zassenhaus.lean
index 7810c3ef324b0..fffa1ed9e956b 100644
--- a/src/group_theory/schur_zassenhaus.lean
+++ b/src/group_theory/schur_zassenhaus.lean
@@ -10,6 +10,9 @@ import group_theory.transfer
 /-!
 # The Schur-Zassenhaus Theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the Schur-Zassenhaus theorem.
 
 ## Main results
@@ -30,13 +33,13 @@ section schur_zassenhaus_abelian
 
 open mul_opposite mul_action subgroup.left_transversals mem_left_transversals
 
-variables {G : Type*} [group G] (H : subgroup G) [is_commutative H] [fintype (G ⧸ H)]
+variables {G : Type*} [group G] (H : subgroup G) [is_commutative H] [finite_index H]
   (α β : left_transversals (H : set G))
 
 /-- The quotient of the transversals of an abelian normal `N` by the `diff` relation. -/
 def quotient_diff :=
 quotient (setoid.mk (λ α β, diff (monoid_hom.id H) α β = 1) ⟨λ α, diff_self (monoid_hom.id H) α,
-  λ α β h, by rw [←diff_inv, h, one_inv], λ α β γ h h', by rw [←diff_mul_diff, h, h', one_mul]⟩)
+  λ α β h, by rw [←diff_inv, h, inv_one], λ α β γ h h', by rw [←diff_mul_diff, h, h', one_mul]⟩)
 
 instance : inhabited H.quotient_diff := quotient.inhabited _
 
@@ -44,6 +47,7 @@ lemma smul_diff_smul' [hH : normal H] (g : Gᵐᵒᵖ) :
   diff (monoid_hom.id H) (g • α) (g • β) = ⟨g.unop⁻¹ * (diff (monoid_hom.id H) α β : H) * g.unop,
     hH.mem_comm ((congr_arg (∈ H) (mul_inv_cancel_left _ _)).mpr (set_like.coe_mem _))⟩ :=
 begin
+  letI := H.fintype_quotient_of_finite_index,
   let ϕ : H →* H :=
   { to_fun := λ h, ⟨g.unop⁻¹ * h * g.unop,
       hH.mem_comm ((congr_arg (∈ H) (mul_inv_cancel_left _ _)).mpr (set_like.coe_mem _))⟩,
@@ -65,11 +69,12 @@ instance : mul_action G H.quotient_diff :=
   mul_smul := λ g₁ g₂ q, quotient.induction_on' q (λ T, congr_arg quotient.mk'
     (by rw mul_inv_rev; exact mul_smul (op g₁⁻¹) (op g₂⁻¹) T)),
   one_smul := λ q, quotient.induction_on' q (λ T, congr_arg quotient.mk'
-    (by rw one_inv; apply one_smul Gᵐᵒᵖ T)) }
+    (by rw inv_one; apply one_smul Gᵐᵒᵖ T)) }
 
 lemma smul_diff' (h : H) :
   diff (monoid_hom.id H) α ((op (h : G)) • β) = diff (monoid_hom.id H) α β * h ^ H.index :=
 begin
+  letI := H.fintype_quotient_of_finite_index,
   rw [diff, diff, index_eq_card, ←finset.card_univ, ←finset.prod_const, ←finset.prod_mul_distrib],
   refine finset.prod_congr rfl (λ q _, _),
   simp_rw [subtype.ext_iff, monoid_hom.id_apply, coe_mul, coe_mk, mul_assoc, mul_right_inj],
@@ -78,16 +83,14 @@ begin
   exact self_eq_mul_right.mpr ((quotient_group.eq_one_iff _).mpr h.2),
 end
 
-variables [fintype H]
-
-lemma eq_one_of_smul_eq_one (hH : nat.coprime (fintype.card H) H.index)
+lemma eq_one_of_smul_eq_one (hH : nat.coprime (nat.card H) H.index)
   (α : H.quotient_diff) (h : H) : h • α = α → h = 1 :=
 quotient.induction_on' α $ λ α hα, (pow_coprime hH).injective $
   calc h ^ H.index = diff (monoid_hom.id H) ((op ((h⁻¹ : H) : G)) • α) α :
     by rw [←diff_inv, smul_diff', diff_self, one_mul, inv_pow, inv_inv]
   ... = 1 ^ H.index : (quotient.exact' hα).trans (one_pow H.index).symm
 
-lemma exists_smul_eq (hH : nat.coprime (fintype.card H) H.index)
+lemma exists_smul_eq (hH : nat.coprime (nat.card H) H.index)
   (α β : H.quotient_diff) : ∃ h : H, h • α = β :=
 quotient.induction_on' α (quotient.induction_on' β (λ β α, exists_imp_exists (λ n, quotient.sound')
   ⟨(pow_coprime hH).symm (diff (monoid_hom.id H) β α), (diff_inv _ _ _).symm.trans
@@ -95,12 +98,12 @@ quotient.induction_on' α (quotient.induction_on' β (λ β α, exists_imp_exist
   (by rw [inv_pow, ←pow_coprime_apply hH, equiv.apply_symm_apply, mul_inv_self])))⟩))
 
 lemma is_complement'_stabilizer_of_coprime {α : H.quotient_diff}
-  (hH : nat.coprime (fintype.card H) H.index) : is_complement' H (stabilizer G α) :=
+  (hH : nat.coprime (nat.card H) H.index) : is_complement' H (stabilizer G α) :=
 is_complement'_stabilizer α (eq_one_of_smul_eq_one hH α) (λ g, exists_smul_eq hH (g • α) α)
 
 /-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
 private lemma exists_right_complement'_of_coprime_aux
-  (hH : nat.coprime (fintype.card H) H.index) : ∃ K : subgroup G, is_complement' H K :=
+  (hH : nat.coprime (nat.card H) H.index) : ∃ K : subgroup G, is_complement' H K :=
 nonempty_of_inhabited.elim (λ α, ⟨stabilizer G α, is_complement'_stabilizer_of_coprime hH⟩)
 
 end schur_zassenhaus_abelian
@@ -151,7 +154,7 @@ begin
   contrapose! h3,
   have h4 : (N.comap K.subtype).index = N.index,
   { rw [←N.relindex_top_right, ←hK],
-    exact relindex_eq_relindex_sup K N },
+    exact (relindex_sup_right K N).symm },
   have h5 : fintype.card K < fintype.card G,
   { rw ← K.index_mul_card,
     exact lt_mul_of_one_lt_left fintype.card_pos (one_lt_index_of_ne_top h3) },
@@ -160,8 +163,9 @@ begin
     exact h1.coprime_dvd_left (card_comap_dvd_of_injective N K.subtype subtype.coe_injective) },
   obtain ⟨H, hH⟩ := h2 K h5 h6,
   replace hH : fintype.card (H.map K.subtype) = N.index :=
-  ((set.card_image_of_injective _ subtype.coe_injective).trans (nat.mul_left_injective
-    fintype.card_pos (hH.symm.card_mul.trans (N.comap K.subtype).index_mul_card.symm))).trans h4,
+    ((set.card_image_of_injective _ subtype.coe_injective).trans (mul_left_injective₀
+      fintype.card_ne_zero (hH.symm.card_mul.trans (N.comap K.subtype).index_mul_card.symm))).trans
+      h4,
   have h7 : fintype.card N * fintype.card (H.map K.subtype) = fintype.card G,
   { rw [hH, ←N.index_mul_card, mul_comm] },
   have h8 : (fintype.card N).coprime (fintype.card (H.map K.subtype)),
@@ -177,12 +181,12 @@ begin
   contrapose! h4,
   have h5 : fintype.card (G ⧸ K) < fintype.card G,
   { rw [←index_eq_card, ←K.index_mul_card],
-    refine lt_mul_of_one_lt_right (nat.pos_of_ne_zero index_ne_zero_of_fintype)
+    refine lt_mul_of_one_lt_right (nat.pos_of_ne_zero index_ne_zero_of_finite)
       (K.one_lt_card_iff_ne_bot.mpr h4.1) },
   have h6 : nat.coprime (fintype.card (N.map (quotient_group.mk' K)))
     (N.map (quotient_group.mk' K)).index,
   { have index_map := N.index_map_eq this (by rwa quotient_group.ker_mk),
-    have index_pos : 0 < N.index := nat.pos_of_ne_zero index_ne_zero_of_fintype,
+    have index_pos : 0 < N.index := nat.pos_of_ne_zero index_ne_zero_of_finite,
     rw index_map,
     refine h1.coprime_dvd_left _,
     rw [←nat.mul_dvd_mul_iff_left index_pos, index_mul_card, ←index_map, index_mul_card],
@@ -206,7 +210,7 @@ begin
   have key := step2 h1 h2 h3 (K.map N.subtype) K.map_subtype_le,
   rw ← map_bot N.subtype at key,
   conv at key { congr, skip, to_rhs, rw [←N.subtype_range, N.subtype.range_eq_map] },
-  have inj := map_injective (show function.injective N.subtype, from subtype.coe_injective),
+  have inj := map_injective N.subtype_injective,
   rwa [inj.eq_iff, inj.eq_iff] at key,
 end
 
@@ -256,6 +260,7 @@ begin
   refine not_forall_not.mp (λ h3, _),
   haveI := by exactI
     schur_zassenhaus_induction.step7 hN (λ G' _ _ hG', by { apply ih _ hG', refl }) h3,
+  rw ← nat.card_eq_fintype_card at hN,
   exact not_exists_of_forall_not h3 (exists_right_complement'_of_coprime_aux hN),
 end
 
@@ -286,8 +291,8 @@ begin
   have hN3 : nat.card G ≠ 0,
   { rw ← N.card_mul_index,
     exact mul_ne_zero hN1 hN2 },
-  haveI := (cardinal.lt_omega_iff_fintype.mp
-    (lt_of_not_ge (mt cardinal.to_nat_apply_of_omega_le hN3))).some,
+  haveI := (cardinal.lt_aleph_0_iff_fintype.mp
+    (lt_of_not_ge (mt cardinal.to_nat_apply_of_aleph_0_le hN3))).some,
   rw nat.card_eq_fintype_card at hN,
   exact exists_right_complement'_of_coprime_of_fintype hN,
 end
diff --git a/src/group_theory/semidirect_product.lean b/src/group_theory/semidirect_product.lean
index 3b42805cfb898..86238ac809660 100644
--- a/src/group_theory/semidirect_product.lean
+++ b/src/group_theory/semidirect_product.lean
@@ -10,6 +10,9 @@ import group_theory.subgroup.basic
 /-!
 # Semidirect product
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines semidirect products of groups, and the canonical maps in and out of the
 semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
 `G` to the automorphism group of `N` is the product of sets with the group
@@ -46,27 +49,14 @@ namespace semidirect_product
 
 variables {N G} {φ : G →* mul_aut N}
 
-private def one_aux : N ⋊[φ] G := ⟨1, 1⟩
-private def mul_aux (a b : N ⋊[φ] G) : N ⋊[φ] G := ⟨a.1 * φ a.2 b.1, a.right * b.right⟩
-private def inv_aux (a : N ⋊[φ] G) : N ⋊[φ] G := let i := a.2⁻¹ in ⟨φ i a.1⁻¹, i⟩
-private lemma mul_assoc_aux (a b c : N ⋊[φ] G) :
-  mul_aux (mul_aux a b) c = mul_aux a (mul_aux b c) :=
-by simp [mul_aux, mul_assoc, mul_equiv.map_mul]
-private lemma mul_one_aux (a : N ⋊[φ] G) : mul_aux a one_aux = a :=
-by cases a; simp [mul_aux, one_aux]
-private lemma one_mul_aux (a : N ⋊[φ] G) : mul_aux one_aux a = a :=
-by cases a; simp [mul_aux, one_aux]
-private lemma mul_left_inv_aux (a : N ⋊[φ] G) : mul_aux (inv_aux a) a = one_aux :=
-by simp only [mul_aux, inv_aux, one_aux, ← mul_equiv.map_mul, mul_left_inv]; simp
-
 instance : group (N ⋊[φ] G) :=
-{ one := one_aux,
-  inv := inv_aux,
-  mul := mul_aux,
-  mul_assoc := mul_assoc_aux,
-  one_mul := one_mul_aux,
-  mul_one := mul_one_aux,
-  mul_left_inv := mul_left_inv_aux }
+{ one := ⟨1, 1⟩,
+  mul := λ a b, ⟨a.1 * φ a.2 b.1, a.2 * b.2⟩,
+  inv := λ x, ⟨φ x.2⁻¹ x.1⁻¹, x.2⁻¹⟩,
+  mul_assoc := λ a b c, by ext; simp [mul_assoc],
+  one_mul := λ a, ext _ _ (by simp) (one_mul a.2),
+  mul_one := λ a, ext _ _ (by simp) (mul_one _),
+  mul_left_inv := λ ⟨a, b⟩, ext _ _ (show φ b⁻¹ a⁻¹ * φ b⁻¹ a = 1, by simp) (mul_left_inv b) }
 
 instance : inhabited (N ⋊[φ] G) := ⟨1⟩
 
@@ -117,7 +107,6 @@ by rw [← monoid_hom.map_inv, inl_aut, inv_inv]
 by ext; simp
 
 @[simp] lemma inl_left_mul_inr_right (x : N ⋊[φ] G) : inl x.left * inr x.right = x :=
-
 by ext; simp
 
 /-- The canonical projection map `N ⋊[φ] G →* G`, as a group hom. -/
diff --git a/src/group_theory/solvable.lean b/src/group_theory/solvable.lean
index 32a39b4b8e698..8169f21daf71c 100644
--- a/src/group_theory/solvable.lean
+++ b/src/group_theory/solvable.lean
@@ -6,11 +6,16 @@ Authors: Jordan Brown, Thomas Browning, Patrick Lutz
 
 import data.fin.vec_notation
 import group_theory.abelianization
+import group_theory.perm.via_embedding
+import group_theory.subgroup.simple
 import set_theory.cardinal.basic
 
 /-!
 # Solvable Groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we introduce the notion of a solvable group. We define a solvable group as one whose
 derived series is eventually trivial. This requires defining the commutator of two subgroups and
 the derived series of a group.
@@ -136,7 +141,7 @@ lemma solvable_of_solvable_injective (hf : function.injective f) [h : is_solvabl
 solvable_of_ker_le_range (1 : G' →* G) f ((f.ker_eq_bot_iff.mpr hf).symm ▸ bot_le)
 
 instance subgroup_solvable_of_solvable (H : subgroup G) [h : is_solvable G] : is_solvable H :=
-solvable_of_solvable_injective (show function.injective (subtype H), from subtype.val_injective)
+solvable_of_solvable_injective H.subtype_injective
 
 lemma solvable_of_surjective (hf : function.surjective f) [h : is_solvable G] :
   is_solvable G' :=
diff --git a/src/group_theory/specific_groups/alternating.lean b/src/group_theory/specific_groups/alternating.lean
index 8e21bef327ee7..89f6761f9cde4 100644
--- a/src/group_theory/specific_groups/alternating.lean
+++ b/src/group_theory/specific_groups/alternating.lean
@@ -4,12 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
 
+import algebra.group.conj_finite
 import group_theory.perm.fin
+import group_theory.subgroup.simple
 import tactic.interval_cases
 
 /-!
 # Alternating Groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The alternating group on a finite type `α` is the subgroup of the permutation group `perm α`
 consisting of the even permutations.
 
@@ -259,10 +264,9 @@ lemma is_conj_swap_mul_swap_of_cycle_type_two {g : perm (fin 5)}
   is_conj (swap 0 4 * swap 1 3) g :=
 begin
   have h := g.support.card_le_univ,
-  rw [← sum_cycle_type, multiset.eq_repeat_of_mem h2, multiset.sum_repeat, smul_eq_mul] at h,
-  rw [← multiset.eq_repeat'] at h2,
-  have h56 : 5 ≤ 3 * 2 := nat.le_succ 5,
-  have h := le_of_mul_le_mul_right (le_trans h h56) dec_trivial,
+  rw [← multiset.eq_replicate_card] at h2,
+  rw [← sum_cycle_type, h2, multiset.sum_replicate, smul_eq_mul] at h,
+  have h : g.cycle_type.card ≤ 3 := le_of_mul_le_mul_right (le_trans h dec_trivial) dec_trivial,
   rw [mem_alternating_group, sign_of_cycle_type, h2] at ha,
   norm_num at ha,
   rw [pow_add, pow_mul, int.units_pow_two,one_mul,
diff --git a/src/group_theory/specific_groups/cyclic.lean b/src/group_theory/specific_groups/cyclic.lean
index 295dcd23fe6b8..c86f41fd18079 100644
--- a/src/group_theory/specific_groups/cyclic.lean
+++ b/src/group_theory/specific_groups/cyclic.lean
@@ -7,12 +7,16 @@ Authors: Johannes Hölzl
 import algebra.big_operators.order
 import data.nat.totient
 import group_theory.order_of_element
+import group_theory.subgroup.simple
 import tactic.group
 import group_theory.exponent
 
 /-!
 # Cyclic groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A group `G` is called cyclic if there exists an element `g : G` such that every element of `G` is of
 the form `g ^ n` for some `n : ℕ`. This file only deals with the predicate on a group to be cyclic.
 For the concrete cyclic group of order `n`, see `data.zmod.basic`.
@@ -37,6 +41,8 @@ For the concrete cyclic group of order `n`, see `data.zmod.basic`.
 cyclic group
 -/
 
+
+
 universe u
 variables {α : Type u} {a : α}
 
@@ -92,12 +98,12 @@ begin
   classical,
   use x,
   simp_rw [← set_like.mem_coe, ← set.eq_univ_iff_forall],
-  apply set.eq_of_subset_of_card_le (set.subset_univ _),
-  rw [fintype.card_congr (equiv.set.univ α), ← hx, order_eq_card_zpowers],
+  rw [←fintype.card_congr (equiv.set.univ α), order_eq_card_zpowers] at hx,
+  exact set.eq_of_subset_of_card_le (set.subset_univ _) (ge_of_eq hx),
 end
 
 /-- A finite group of prime order is cyclic. -/
-@[to_additive is_add_cyclic_of_prime_card]
+@[to_additive is_add_cyclic_of_prime_card "A finite group of prime order is cyclic."]
 lemma is_cyclic_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
   (h : fintype.card α = p) : is_cyclic α :=
 ⟨begin
@@ -128,7 +134,7 @@ lemma order_of_eq_card_of_forall_mem_zpowers [fintype α]
   {g : α} (hx : ∀ x, x ∈ zpowers g) : order_of g = fintype.card α :=
 begin
   classical,
-  simp_rw [order_eq_card_zpowers, set_like.coe_sort_coe],
+  rw order_eq_card_zpowers,
   apply fintype.card_of_finset',
   simpa using hx
 end
@@ -233,8 +239,8 @@ calc (univ.filter (λ a : α, a ^ n = 1)).card
   have hm0 : 0 < m, from nat.pos_of_ne_zero $
     λ hm0, by { rw [hm0, mul_zero, fintype.card_eq_zero_iff] at hm, exact hm.elim' 1 },
   begin
-    rw [← fintype.card_of_finset' _ (λ _, set.mem_to_finset), ← order_eq_card_zpowers,
-        order_of_pow g, order_of_eq_card_of_forall_mem_zpowers hg],
+    simp only [set.to_finset_card, set_like.coe_sort_coe],
+    rw [←order_eq_card_zpowers, order_of_pow g, order_of_eq_card_of_forall_mem_zpowers hg],
     rw [hm] {occs := occurrences.pos [2,3]},
     rw [nat.mul_div_cancel_left _  (gcd_pos_of_pos_left _ hn0), gcd_mul_left_left,
       hm, nat.mul_div_cancel _ hm0],
@@ -244,8 +250,8 @@ calc (univ.filter (λ a : α, a ^ n = 1)).card
 end classical
 
 @[to_additive]
-lemma is_cyclic.exists_monoid_generator [fintype α]
-[is_cyclic α] : ∃ x : α, ∀ y : α, y ∈ submonoid.powers x :=
+lemma is_cyclic.exists_monoid_generator [finite α] [is_cyclic α] :
+  ∃ x : α, ∀ y : α, y ∈ submonoid.powers x :=
 by { simp_rw [mem_powers_iff_mem_zpowers], exact is_cyclic.exists_generator α }
 
 section
@@ -293,77 +299,56 @@ open_locale nat -- use φ for nat.totient
 
 private lemma card_order_of_eq_totient_aux₁ :
   ∀ {d : ℕ}, d ∣ fintype.card α → 0 < (univ.filter (λ a : α, order_of a = d)).card →
-  (univ.filter (λ a : α, order_of a = d)).card = φ d
-| 0     := λ hd hd0,
-let ⟨a, ha⟩ := card_pos.1 hd0 in absurd (mem_filter.1 ha).2 $ ne_of_gt $ order_of_pos a
-| (d+1) := λ hd hd0,
-let ⟨a, ha⟩ := card_pos.1 hd0 in
-have ha : order_of a = d.succ, from (mem_filter.1 ha).2,
-have h : ∑ m in (range d.succ).filter (∣ d.succ),
-    (univ.filter (λ a : α, order_of a = m)).card =
-    ∑ m in (range d.succ).filter (∣ d.succ), φ m, from
-  finset.sum_congr rfl
-    (λ m hm, have hmd : m < d.succ, from mem_range.1 (mem_filter.1 hm).1,
-      have hm : m ∣ d.succ, from (mem_filter.1 hm).2,
-      card_order_of_eq_totient_aux₁ (hm.trans hd) (finset.card_pos.2
-        ⟨a ^ (d.succ / m), mem_filter.2 ⟨mem_univ _,
-          by { rw [order_of_pow a, ha, nat.gcd_eq_right (div_dvd_of_dvd hm),
-                nat.div_div_self hm (succ_pos _)] }⟩⟩)),
-have hinsert : insert d.succ ((range d.succ).filter (∣ d.succ))
-    = (range d.succ.succ).filter (∣ d.succ),
-  from (finset.ext $ λ x, ⟨λ h, (mem_insert.1 h).elim (λ h, by simp [h, range_succ])
-    (by clear _let_match; simp [range_succ]; tauto),
-     by clear _let_match; simp [range_succ] {contextual := tt}; tauto⟩),
-have hinsert₁ : d.succ ∉ (range d.succ).filter (∣ d.succ),
-  by simp [mem_range, zero_le_one, le_succ],
-(add_left_inj (∑ m in (range d.succ).filter (∣ d.succ),
-  (univ.filter (λ a : α, order_of a = m)).card)).1
-  (calc _ = ∑ m in insert d.succ (filter (∣ d.succ) (range d.succ)),
-        (univ.filter (λ a : α, order_of a = m)).card :
-    eq.symm (finset.sum_insert (by simp [mem_range, zero_le_one, le_succ]))
-  ... = ∑ m in (range d.succ.succ).filter (∣ d.succ),
-      (univ.filter (λ a : α, order_of a = m)).card :
-    sum_congr hinsert (λ _ _, rfl)
-  ... = (univ.filter (λ a : α, a ^ d.succ = 1)).card :
-    sum_card_order_of_eq_card_pow_eq_one (succ_pos d)
-  ... = ∑ m in (range d.succ.succ).filter (∣ d.succ), φ m :
-    ha ▸ (card_pow_eq_one_eq_order_of_aux hn a).symm ▸ (sum_totient _).symm
-  ... = _ : by rw [h, ← sum_insert hinsert₁];
-      exact finset.sum_congr hinsert.symm (λ _ _, rfl))
+  (univ.filter (λ a : α, order_of a = d)).card = φ d :=
+begin
+  intros d hd hpos,
+  induction d using nat.strong_rec' with d IH,
+  rcases decidable.eq_or_ne d 0 with rfl | hd0,
+  { cases fintype.card_ne_zero (eq_zero_of_zero_dvd hd) },
+  rcases card_pos.1 hpos with ⟨a, ha'⟩,
+  have ha : order_of a = d := (mem_filter.1 ha').2,
+  have h1 : ∑ m in d.proper_divisors, (univ.filter (λ a : α, order_of a = m)).card =
+    ∑ m in d.proper_divisors, φ m,
+  { refine finset.sum_congr rfl (λ m hm, _),
+    simp only [mem_filter, mem_range, mem_proper_divisors] at hm,
+    refine IH m hm.2 (hm.1.trans hd) (finset.card_pos.2 ⟨a ^ (d / m), _⟩),
+    simp only [mem_filter, mem_univ, order_of_pow a, ha, true_and,
+      nat.gcd_eq_right (div_dvd_of_dvd hm.1), nat.div_div_self hm.1 hd0] },
+  have h2 : ∑ m in d.divisors, (univ.filter (λ a : α, order_of a = m)).card =
+    ∑ m in d.divisors, φ m,
+    { rw [←filter_dvd_eq_divisors hd0, sum_card_order_of_eq_card_pow_eq_one hd0,
+      filter_dvd_eq_divisors hd0, sum_totient, ←ha, card_pow_eq_one_eq_order_of_aux hn a] },
+  simpa [← cons_self_proper_divisors hd0, ←h1] using h2,
+end
 
 lemma card_order_of_eq_totient_aux₂ {d : ℕ} (hd : d ∣ fintype.card α) :
   (univ.filter (λ a : α, order_of a = d)).card = φ d :=
-by_contradiction $ λ h,
-have h0 : (univ.filter (λ a : α , order_of a = d)).card = 0 :=
-  not_not.1 (mt pos_iff_ne_zero.2 (mt (card_order_of_eq_totient_aux₁ hn hd) h)),
-let c := fintype.card α in
-have hc0 : 0 < c, from fintype.card_pos_iff.2 ⟨1⟩,
-lt_irrefl c $
-  calc c = (univ.filter (λ a : α, a ^ c = 1)).card :
-    congr_arg card $ by simp [finset.ext_iff, c]
-  ... = ∑ m in (range c.succ).filter (∣ c),
-      (univ.filter (λ a : α, order_of a = m)).card :
-    (sum_card_order_of_eq_card_pow_eq_one hc0).symm
-  ... = ∑ m in ((range c.succ).filter (∣ c)).erase d,
-      (univ.filter (λ a : α, order_of a = m)).card :
-    eq.symm (sum_subset (erase_subset _ _) (λ m hm₁ hm₂,
-      have m = d, by simp at *; cc,
-      by simp [*, finset.ext_iff] at *; exact h0))
-  ... ≤ ∑ m in ((range c.succ).filter (∣ c)).erase d, φ m :
-    sum_le_sum (λ m hm,
-      have hmc : m ∣ c, by simp at hm; tauto,
-      (imp_iff_not_or.1 (card_order_of_eq_totient_aux₁ hn hmc)).elim
-        (λ h, by simp [nat.le_zero_iff.1 (le_of_not_gt h), nat.zero_le])
-        (λ h, by rw h))
-  ... < φ d + ∑ m in ((range c.succ).filter (∣ c)).erase d, φ m :
-    lt_add_of_pos_left _ (totient_pos (nat.pos_of_ne_zero
-      (λ h, pos_iff_ne_zero.1 hc0 (eq_zero_of_zero_dvd $ h ▸ hd))))
-  ... = ∑ m in insert d (((range c.succ).filter (∣ c)).erase d), φ m :
-    eq.symm (sum_insert (by simp))
-  ... = ∑ m in (range c.succ).filter (∣ c), φ m : finset.sum_congr
-      (finset.insert_erase (mem_filter.2 ⟨mem_range.2 (lt_succ_of_le (le_of_dvd hc0 hd)), hd⟩))
-                           (λ _ _, rfl)
-  ... = c : sum_totient _
+begin
+  let c := fintype.card α,
+  have hc0 : 0 < c := fintype.card_pos_iff.2 ⟨1⟩,
+  apply card_order_of_eq_totient_aux₁ hn hd,
+  by_contradiction h0,
+  simp only [not_lt, _root_.le_zero_iff, card_eq_zero] at h0,
+  apply lt_irrefl c,
+  calc
+    c = ∑ m in c.divisors, (univ.filter (λ a : α, order_of a = m)).card : by
+  { simp only [←filter_dvd_eq_divisors hc0.ne', sum_card_order_of_eq_card_pow_eq_one hc0.ne'],
+    apply congr_arg card,
+    simp }
+  ... = ∑ m in c.divisors.erase d, (univ.filter (λ a : α, order_of a = m)).card : by
+  { rw eq_comm,
+    refine (sum_subset (erase_subset _ _) (λ m hm₁ hm₂, _)),
+    have : m = d, by { contrapose! hm₂, exact mem_erase_of_ne_of_mem hm₂ hm₁ },
+    simp [this, h0] }
+  ... ≤ ∑ m in c.divisors.erase d, φ m : by
+  { refine sum_le_sum (λ m hm, _),
+    have hmc : m ∣ c, { simp only [mem_erase, mem_divisors] at hm, tauto },
+    rcases (filter (λ (a : α), order_of a = m) univ).card.eq_zero_or_pos with h1 | h1,
+    { simp [h1] }, { simp [card_order_of_eq_totient_aux₁ hn hmc h1] } }
+  ... < ∑ m in c.divisors, φ m :
+  sum_erase_lt_of_pos (mem_divisors.2 ⟨hd, hc0.ne'⟩) (totient_pos (pos_of_dvd_of_pos hd hc0))
+   ... = c : sum_totient _
+end
 
 lemma is_cyclic_of_card_pow_eq_one_le : is_cyclic α :=
 have (univ.filter (λ a : α, order_of a = fintype.card α)).nonempty,
@@ -401,7 +386,7 @@ end
 attribute [to_additive is_cyclic.card_order_of_eq_totient] is_add_cyclic.card_order_of_eq_totient
 
 /-- A finite group of prime order is simple. -/
-@[to_additive]
+@[to_additive "A finite group of prime order is simple."]
 lemma is_simple_group_of_prime_card {α : Type u} [group α] [fintype α] {p : ℕ} [hp : fact p.prime]
   (h : fintype.card α = p) : is_simple_group α :=
 ⟨begin
diff --git a/src/group_theory/specific_groups/dihedral.lean b/src/group_theory/specific_groups/dihedral.lean
index 3ab5aedac3eb7..889f538502344 100644
--- a/src/group_theory/specific_groups/dihedral.lean
+++ b/src/group_theory/specific_groups/dihedral.lean
@@ -3,14 +3,15 @@ Copyright (c) 2020 Shing Tak Lam. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Shing Tak Lam
 -/
-import data.fintype.card
 import data.zmod.basic
 import group_theory.exponent
-import data.int.parity
 
 /-!
 # Dihedral Groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the dihedral groups `dihedral_group n`, with elements `r i` and `sr i` for `i : zmod n`.
 
 For `n ≠ 0`, `dihedral_group n` represents the symmetry group of the regular `n`-gon. `r i`
@@ -107,20 +108,20 @@ private def fintype_helper : (zmod n ⊕ zmod n) ≃ dihedral_group n :=
 /--
 If `0 < n`, then `dihedral_group n` is a finite group.
 -/
-instance [fact (0 < n)] : fintype (dihedral_group n) := fintype.of_equiv _ fintype_helper
+instance [ne_zero n] : fintype (dihedral_group n) := fintype.of_equiv _ fintype_helper
 
 instance : nontrivial (dihedral_group n) := ⟨⟨r 0, sr 0, dec_trivial⟩⟩
 
 /--
 If `0 < n`, then `dihedral_group n` has `2n` elements.
 -/
-lemma card [fact (0 < n)] : fintype.card (dihedral_group n) = 2 * n :=
+lemma card [ne_zero n] : fintype.card (dihedral_group n) = 2 * n :=
 by rw [← fintype.card_eq.mpr ⟨fintype_helper⟩, fintype.card_sum, zmod.card, two_mul]
 
 @[simp] lemma r_one_pow (k : ℕ) : (r 1 : dihedral_group n) ^ k = r k :=
 begin
   induction k with k IH,
-  { refl },
+  { rw nat.cast_zero, refl },
   { rw [pow_succ, IH, r_mul_r],
     congr' 1,
     norm_cast,
@@ -152,14 +153,15 @@ If `0 < n`, then `r 1` has order `n`.
 -/
 @[simp] lemma order_of_r_one : order_of (r 1 : dihedral_group n) = n :=
 begin
-  rcases n.eq_zero_or_pos with rfl | hn,
+  rcases eq_zero_or_ne_zero n with rfl | hn,
   { rw order_of_eq_zero_iff',
     intros n hn,
     rw [r_one_pow, one_def],
     apply mt r.inj,
     simpa using hn.ne' },
-  { haveI := fact.mk hn,
-    apply (nat.le_of_dvd hn $ order_of_dvd_of_pow_eq_one $ @r_one_pow_n n).lt_or_eq.resolve_left,
+  { resetI,
+    apply (nat.le_of_dvd (ne_zero.pos n) $ order_of_dvd_of_pow_eq_one $ @r_one_pow_n n)
+      .lt_or_eq.resolve_left,
     intro h,
     have h1 : (r 1 : dihedral_group n)^(order_of (r 1)) = 1,
     { exact pow_order_of_eq_one _ },
@@ -172,7 +174,7 @@ end
 /--
 If `0 < n`, then `i : zmod n` has order `n / gcd n i`.
 -/
-lemma order_of_r [fact (0 < n)] (i : zmod n) : order_of (r i) = n / nat.gcd n i.val :=
+lemma order_of_r [ne_zero n] (i : zmod n) : order_of (r i) = n / nat.gcd n i.val :=
 begin
   conv_lhs { rw ←zmod.nat_cast_zmod_val i },
   rw [←r_one_pow, order_of_pow, order_of_r_one]
@@ -180,9 +182,9 @@ end
 
 lemma exponent : monoid.exponent (dihedral_group n) = lcm n 2 :=
 begin
-  rcases n.eq_zero_or_pos with rfl | hn,
+  rcases eq_zero_or_ne_zero n with rfl | hn,
   { exact monoid.exponent_eq_zero_of_order_zero order_of_r_one },
-  haveI := fact.mk hn,
+  resetI,
   apply nat.dvd_antisymm,
   { apply monoid.exponent_dvd_of_forall_pow_eq_one,
     rintro (m | m),
diff --git a/src/group_theory/specific_groups/quaternion.lean b/src/group_theory/specific_groups/quaternion.lean
index 8efd4b9431144..0af5ef908c007 100644
--- a/src/group_theory/specific_groups/quaternion.lean
+++ b/src/group_theory/specific_groups/quaternion.lean
@@ -12,6 +12,9 @@ import group_theory.specific_groups.cyclic
 /-!
 # Quaternion Groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the (generalised) quaternion groups `quaternion_group n` of order `4n`, also known as
 dicyclic groups, with elements `a i` and `xa i` for `i : zmod n`. The (generalised) quaternion
 groups can be defined by the presentation
@@ -148,24 +151,17 @@ def quaternion_group_zero_equiv_dihedral_group_zero : quaternion_group 0 ≃* di
   right_inv := by rintro (k | k); refl,
   map_mul' := by { rintros (k | k) (l | l); { dsimp, simp, }, } }
 
-/-- Some of the lemmas on `zmod m` require that `m` is positive, as `m = 2 * n` is the case relevant
-in this file but we don't want to write `[fact (0 < 2 * n)]` we make this lemma a local instance. -/
-private lemma succ_mul_pos_fact {m : ℕ} [hn : fact (0 < n)] : fact (0 < (nat.succ m) * n) :=
-⟨nat.succ_mul_pos m hn.1⟩
-
-local attribute [instance] succ_mul_pos_fact
-
 /--
 If `0 < n`, then `quaternion_group n` is a finite group.
 -/
-instance [fact (0 < n)] : fintype (quaternion_group n) := fintype.of_equiv _ fintype_helper
+instance [ne_zero n] : fintype (quaternion_group n) := fintype.of_equiv _ fintype_helper
 
 instance : nontrivial (quaternion_group n) := ⟨⟨a 0, xa 0, dec_trivial⟩⟩
 
 /--
 If `0 < n`, then `quaternion_group n` has `4n` elements.
 -/
-lemma card [fact (0 < n)] : fintype.card (quaternion_group n) = 4 * n :=
+lemma card [ne_zero n] : fintype.card (quaternion_group n) = 4 * n :=
 begin
   rw [← fintype.card_eq.mpr ⟨fintype_helper⟩, fintype.card_sum, zmod.card, two_mul],
   ring
@@ -174,7 +170,7 @@ end
 @[simp] lemma a_one_pow (k : ℕ) : (a 1 : quaternion_group n) ^ k = a k :=
 begin
   induction k with k IH,
-  { refl },
+  { rw nat.cast_zero, refl },
   { rw [pow_succ, IH, a_mul_a],
     congr' 1,
     norm_cast,
@@ -205,7 +201,7 @@ end
 /--
 If `0 < n`, then `xa i` has order 4.
 -/
-@[simp] lemma order_of_xa [hpos : fact (0 < n)] (i : zmod (2 * n)) : order_of (xa i) = 4 :=
+@[simp] lemma order_of_xa [ne_zero n] (i : zmod (2 * n)) : order_of (xa i) = 4 :=
 begin
   change _ = 2^2,
   haveI : fact(nat.prime 2) := fact.mk (nat.prime_two),
@@ -216,7 +212,7 @@ begin
     apply_fun zmod.val at h',
     apply_fun ( / n) at h',
     simp only [zmod.val_nat_cast, zmod.val_zero, nat.zero_div, nat.mod_mul_left_div_self,
-             nat.div_self hpos.1] at h',
+               nat.div_self (ne_zero.pos n)] at h',
     norm_num at h' },
   { norm_num }
 end
@@ -234,14 +230,15 @@ If `0 < n`, then `a 1` has order `2 * n`.
 -/
 @[simp] lemma order_of_a_one : order_of (a 1 : quaternion_group n) = 2 * n :=
 begin
-  rcases n.eq_zero_or_pos with rfl | hn,
-  { simp_rw [mul_zero, order_of_eq_zero_iff'],
-    intros n hn,
+  casesI eq_zero_or_ne_zero n with hn hn,
+  { subst hn,
+    simp_rw [mul_zero, order_of_eq_zero_iff'],
+    intros n h,
     rw [one_def, a_one_pow],
     apply mt a.inj,
-    simpa using hn.ne' },
-  haveI := fact.mk hn,
-  apply (nat.le_of_dvd (nat.succ_mul_pos _ hn)
+    haveI : char_zero (zmod (2 * 0)) := zmod.char_zero,
+    simpa using h.ne' },
+  apply (nat.le_of_dvd (ne_zero.pos _)
                        (order_of_dvd_of_pow_eq_one (@a_one_pow_n n))).lt_or_eq.resolve_left,
   intro h,
   have h1 : (a 1 : quaternion_group n)^(order_of (a 1)) = 1 := pow_order_of_eq_one _,
@@ -254,7 +251,7 @@ end
 /--
 If `0 < n`, then `a i` has order `(2 * n) / gcd (2 * n) i`.
 -/
-lemma order_of_a [fact (0 < n)] (i : zmod (2 * n)) :
+lemma order_of_a [ne_zero n] (i : zmod (2 * n)) :
   order_of (a i) = (2 * n) / nat.gcd (2 * n) i.val :=
 begin
   conv_lhs { rw ← zmod.nat_cast_zmod_val i },
@@ -265,10 +262,10 @@ lemma exponent : monoid.exponent (quaternion_group n) = 2 * lcm n 2 :=
 begin
   rw [←normalize_eq 2, ←lcm_mul_left, normalize_eq],
   norm_num,
-  rcases n.eq_zero_or_pos with rfl | hn,
-  { simp only [lcm_zero_left, mul_zero],
+  casesI eq_zero_or_ne_zero n with hn hn,
+  { subst hn,
+    simp only [lcm_zero_left, mul_zero],
     exact monoid.exponent_eq_zero_of_order_zero order_of_a_one },
-  haveI := fact.mk hn,
   apply nat.dvd_antisymm,
   { apply monoid.exponent_dvd_of_forall_pow_eq_one,
     rintro (m | m),
diff --git a/src/group_theory/subgroup/actions.lean b/src/group_theory/subgroup/actions.lean
new file mode 100644
index 0000000000000..53a3f2a0e46f0
--- /dev/null
+++ b/src/group_theory/subgroup/actions.lean
@@ -0,0 +1,74 @@
+/-
+Copyright (c) 2021 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import group_theory.subgroup.basic
+
+/-!
+# Actions by `subgroup`s
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+These are just copies of the definitions about `submonoid` starting from `submonoid.mul_action`.
+
+## Tags
+subgroup, subgroups
+
+-/
+
+namespace subgroup
+
+variables {G : Type*} [group G]
+variables {α β : Type*}
+
+/-- The action by a subgroup is the action by the underlying group. -/
+@[to_additive /-"The additive action by an add_subgroup is the action by the underlying
+add_group. "-/]
+instance [mul_action G α] (S : subgroup G) : mul_action S α :=
+S.to_submonoid.mul_action
+
+@[to_additive]
+lemma smul_def [mul_action G α] {S : subgroup G} (g : S) (m : α) : g • m = (g : G) • m := rfl
+
+@[to_additive]
+instance smul_comm_class_left
+  [mul_action G β] [has_smul α β] [smul_comm_class G α β] (S : subgroup G) :
+  smul_comm_class S α β :=
+S.to_submonoid.smul_comm_class_left
+
+@[to_additive]
+instance smul_comm_class_right
+  [has_smul α β] [mul_action G β] [smul_comm_class α G β] (S : subgroup G) :
+  smul_comm_class α S β :=
+S.to_submonoid.smul_comm_class_right
+
+/-- Note that this provides `is_scalar_tower S G G` which is needed by `smul_mul_assoc`. -/
+instance
+  [has_smul α β] [mul_action G α] [mul_action G β] [is_scalar_tower G α β] (S : subgroup G) :
+  is_scalar_tower S α β :=
+S.to_submonoid.is_scalar_tower
+
+instance [mul_action G α] [has_faithful_smul G α] (S : subgroup G) :
+  has_faithful_smul S α :=
+S.to_submonoid.has_faithful_smul
+
+/-- The action by a subgroup is the action by the underlying group. -/
+instance [add_monoid α] [distrib_mul_action G α] (S : subgroup G) : distrib_mul_action S α :=
+S.to_submonoid.distrib_mul_action
+
+/-- The action by a subgroup is the action by the underlying group. -/
+instance [monoid α] [mul_distrib_mul_action G α] (S : subgroup G) : mul_distrib_mul_action S α :=
+S.to_submonoid.mul_distrib_mul_action
+
+/-- The center of a group acts commutatively on that group. -/
+instance center.smul_comm_class_left : smul_comm_class (center G) G G :=
+submonoid.center.smul_comm_class_left
+
+/-- The center of a group acts commutatively on that group. -/
+instance center.smul_comm_class_right : smul_comm_class G (center G) G :=
+submonoid.center.smul_comm_class_right
+
+end subgroup
diff --git a/src/group_theory/subgroup/basic.lean b/src/group_theory/subgroup/basic.lean
index 50088d9db5624..26cf2cc379965 100644
--- a/src/group_theory/subgroup/basic.lean
+++ b/src/group_theory/subgroup/basic.lean
@@ -3,17 +3,21 @@ Copyright (c) 2020 Kexing Ying. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kexing Ying
 -/
-import group_theory.submonoid.pointwise
-import group_theory.submonoid.membership
-import group_theory.submonoid.centralizer
 import algebra.group.conj
 import algebra.module.basic
+import algebra.order.group.inj_surj
+import data.countable.basic
+import group_theory.submonoid.centralizer
+import logic.encodable.basic
 import order.atoms
-import order.sup_indep
+import tactic.apply_fun
 
 /-!
 # Subgroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines multiplicative and additive subgroups as an extension of submonoids, in a bundled
 form (unbundled subgroups are in `deprecated/subgroups.lean`).
 
@@ -73,8 +77,6 @@ Definitions in the file:
 * `monoid_hom.eq_locus f g` : given group homomorphisms `f`, `g`, the elements of `G` such that
   `f x = g x` form a subgroup of `G`
 
-* `is_simple_group G` : a class indicating that a group has exactly two normal subgroups
-
 ## Implementation notes
 
 Subgroup inclusion is denoted `≤` rather than `⊆`, although `∈` is defined as
@@ -84,46 +86,43 @@ membership of a subgroup's underlying set.
 subgroup, subgroups
 -/
 
-open_locale big_operators pointwise
+open function
 
-variables {G : Type*} [group G]
+variables {G G' : Type*} [group G] [group G']
 variables {A : Type*} [add_group A]
 
 section subgroup_class
 
 /-- `inv_mem_class S G` states `S` is a type of subsets `s ⊆ G` closed under inverses. -/
-class inv_mem_class (S G : Type*) [has_inv G] [set_like S G] :=
+class inv_mem_class (S G : Type*) [has_inv G] [set_like S G] : Prop :=
 (inv_mem : ∀ {s : S} {x}, x ∈ s → x⁻¹ ∈ s)
 
 export inv_mem_class (inv_mem)
 
 /-- `neg_mem_class S G` states `S` is a type of subsets `s ⊆ G` closed under negation. -/
-class neg_mem_class (S G : Type*) [has_neg G] [set_like S G] :=
+class neg_mem_class (S G : Type*) [has_neg G] [set_like S G] : Prop :=
 (neg_mem : ∀ {s : S} {x}, x ∈ s → -x ∈ s)
 
 export neg_mem_class (neg_mem)
 
 /-- `subgroup_class S G` states `S` is a type of subsets `s ⊆ G` that are subgroups of `G`. -/
 class subgroup_class (S G : Type*) [div_inv_monoid G] [set_like S G]
-  extends submonoid_class S G :=
-(inv_mem : ∀ {s : S} {x}, x ∈ s → x⁻¹ ∈ s)
+  extends submonoid_class S G, inv_mem_class S G : Prop
 
 /-- `add_subgroup_class S G` states `S` is a type of subsets `s ⊆ G` that are
 additive subgroups of `G`. -/
 class add_subgroup_class (S G : Type*) [sub_neg_monoid G] [set_like S G]
-  extends add_submonoid_class S G :=
-(neg_mem : ∀ {s : S} {x}, x ∈ s → -x ∈ s)
+  extends add_submonoid_class S G, neg_mem_class S G : Prop
 
 attribute [to_additive] inv_mem_class subgroup_class
 
-variables (M S : Type*) [div_inv_monoid M] [set_like S M] [hSM : subgroup_class S M]
-include hSM
-
-@[to_additive, priority 100] -- See note [lower instance priority]
-instance subgroup_class.to_inv_mem_class : inv_mem_class S M :=
-{ .. hSM }
+@[simp, to_additive]
+theorem inv_mem_iff {S G} [has_involutive_inv G] [set_like S G] [inv_mem_class S G] {H : S}
+  {x : G} : x⁻¹ ∈ H ↔ x ∈ H :=
+⟨λ h, inv_inv x ▸ inv_mem h, inv_mem⟩
 
-variables {S M} {H K : S}
+variables {M S : Type*} [div_inv_monoid M] [set_like S M] [hSM : subgroup_class S M] {H K : S}
+include hSM
 
 /-- A subgroup is closed under division. -/
 @[to_additive "An additive subgroup is closed under subtraction."]
@@ -139,16 +138,9 @@ omit hSM
 variables [set_like S G] [hSG : subgroup_class S G]
 include hSG
 
-@[simp, to_additive] theorem inv_mem_iff {x : G} : x⁻¹ ∈ H ↔ x ∈ H :=
-⟨λ h, inv_inv x ▸ inv_mem h, inv_mem⟩
-
 @[to_additive] lemma div_mem_comm_iff {a b : G} : a / b ∈ H ↔ b / a ∈ H :=
 by rw [← inv_mem_iff, div_eq_mul_inv, div_eq_mul_inv, mul_inv_rev, inv_inv]
 
-@[simp, to_additive]
-theorem inv_coe_set : (H : set G)⁻¹ = H :=
-by { ext, simp }
-
 @[simp, to_additive]
 lemma exists_inv_mem_iff_exists_mem {P : G → Prop} :
   (∃ (x : G), x ∈ H ∧ P x⁻¹) ↔ ∃ x ∈ H, P x :=
@@ -178,7 +170,7 @@ instance has_div : has_div H := ⟨λ a b, ⟨a / b, div_mem a.2 b.2⟩⟩
 omit hSM
 /-- An additive subgroup of an `add_group` inherits an integer scaling. -/
 instance _root_.add_subgroup_class.has_zsmul {M S} [sub_neg_monoid M] [set_like S M]
-  [add_subgroup_class S M] {H : S} : has_scalar ℤ H :=
+  [add_subgroup_class S M] {H : S} : has_smul ℤ H :=
 ⟨λ n a, ⟨n • a, zsmul_mem a.2 n⟩⟩
 include hSM
 
@@ -223,24 +215,24 @@ subtype.coe_injective.ordered_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _
 instance to_linear_ordered_comm_group {G : Type*} [linear_ordered_comm_group G] [set_like S G]
   [subgroup_class S G] : linear_ordered_comm_group H :=
 subtype.coe_injective.linear_ordered_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
 include hSG
 
 /-- The natural group hom from a subgroup of group `G` to `G`. -/
 @[to_additive "The natural group hom from an additive subgroup of `add_group` `G` to `G`."]
-def subtype : H →* G := ⟨coe, rfl, λ _ _, rfl⟩
+protected def subtype : H →* G := ⟨coe, rfl, λ _ _, rfl⟩
 
-@[simp, to_additive] theorem coe_subtype : (subtype H : H → G) = coe := rfl
+@[simp, to_additive] theorem coe_subtype : (subgroup_class.subtype H : H → G) = coe := rfl
 
 variables {H}
 
 @[simp, norm_cast, to_additive coe_smul]
 lemma coe_pow (x : H) (n : ℕ) : ((x ^ n : H) : G) = x ^ n :=
-(subtype H : H →* G).map_pow _ _
+(subgroup_class.subtype H : H →* G).map_pow _ _
 
 @[simp, norm_cast, to_additive] lemma coe_zpow (x : H) (n : ℤ) : ((x ^ n : H) : G) = x ^ n :=
-(subtype H : H →* G).map_zpow _ _
+(subgroup_class.subtype H : H →* G).map_zpow _ _
 
 /-- The inclusion homomorphism from a subgroup `H` contained in `K` to `K`. -/
 @[to_additive "The inclusion homomorphism from a additive subgroup `H` contained in `K` to `K`."]
@@ -265,7 +257,7 @@ by { cases a, simp only [inclusion, set_like.coe_mk, monoid_hom.mk'_apply] }
 
 @[simp, to_additive]
 lemma subtype_comp_inclusion {H K : S} (hH : H ≤ K) :
-  (subtype K).comp (inclusion hH) = subtype H :=
+  (subgroup_class.subtype K).comp (inclusion hH) = subgroup_class.subtype H :=
 by { ext, simp only [monoid_hom.comp_apply, coe_subtype, coe_inclusion] }
 
 end subgroup_class
@@ -334,10 +326,6 @@ lemma coe_to_submonoid (K : subgroup G) : (K.to_submonoid : set G) = K := rfl
 @[simp, to_additive]
 lemma mem_to_submonoid (K : subgroup G) (x : G) : x ∈ K.to_submonoid ↔ x ∈ K := iff.rfl
 
-@[to_additive]
-instance (K : subgroup G) [d : decidable_pred (∈ K)] [fintype G] : fintype K :=
-show fintype {g : G // g ∈ K}, from infer_instance
-
 @[to_additive]
 theorem to_submonoid_injective :
   function.injective (to_submonoid : subgroup G → submonoid G) :=
@@ -373,10 +361,10 @@ section mul_add
 @[simps]
 def subgroup.to_add_subgroup : subgroup G ≃o add_subgroup (additive G) :=
 { to_fun := λ S,
-  { neg_mem' := S.inv_mem',
+  { neg_mem' := λ _, S.inv_mem',
     ..S.to_submonoid.to_add_submonoid },
   inv_fun := λ S,
-  { inv_mem' := S.neg_mem',
+  { inv_mem' := λ _, S.neg_mem',
     ..S.to_add_submonoid.to_submonoid' },
   left_inv := λ x, by cases x; refl,
   right_inv := λ x, by cases x; refl,
@@ -391,10 +379,10 @@ subgroup.to_add_subgroup.symm
 @[simps]
 def add_subgroup.to_subgroup : add_subgroup A ≃o subgroup (multiplicative A) :=
 { to_fun := λ S,
-  { inv_mem' := S.neg_mem',
+  { inv_mem' := λ _, S.neg_mem',
     ..S.to_add_submonoid.to_submonoid },
   inv_fun := λ S,
-  { neg_mem' := S.inv_mem',
+  { neg_mem' := λ _, S.inv_mem',
     ..S.to_submonoid.to_add_submonoid' },
   left_inv := λ x, by cases x; refl,
   right_inv := λ x, by cases x; refl,
@@ -418,8 +406,8 @@ Useful to fix definitional equalities"]
 protected def copy (K : subgroup G) (s : set G) (hs : s = K) : subgroup G :=
 { carrier := s,
   one_mem' := hs.symm ▸ K.one_mem',
-  mul_mem' := hs.symm ▸ K.mul_mem',
-  inv_mem' := hs.symm ▸ K.inv_mem' }
+  mul_mem' := λ _ _, hs.symm ▸ K.mul_mem',
+  inv_mem' := λ _, hs.symm ▸ K.inv_mem' }
 
 @[simp, to_additive] lemma coe_copy (K : subgroup G) (s : set G) (hs : s = ↑K) :
   (K.copy s hs : set G) = s := rfl
@@ -453,8 +441,6 @@ protected theorem div_mem {x y : G} (hx : x ∈ H) (hy : y ∈ H) : x / y ∈ H
 @[to_additive] protected lemma div_mem_comm_iff {a b : G} : a / b ∈ H ↔ b / a ∈ H :=
 div_mem_comm_iff
 
-@[to_additive] protected theorem inv_coe_set : (H : set G)⁻¹ = H := by { ext, simp }
-
 @[to_additive] protected lemma exists_inv_mem_iff_exists_mem  (K : subgroup G) {P : G → Prop} :
   (∃ (x : G), x ∈ K ∧ P x⁻¹) ↔ ∃ x ∈ K, P x :=
 exists_inv_mem_iff_exists_mem
@@ -465,39 +451,6 @@ mul_mem_cancel_right h
 @[to_additive] protected lemma mul_mem_cancel_left {x y : G} (h : x ∈ H) : x * y ∈ H ↔ y ∈ H :=
 mul_mem_cancel_left h
 
-/-- Product of a list of elements in a subgroup is in the subgroup. -/
-@[to_additive "Sum of a list of elements in an `add_subgroup` is in the `add_subgroup`."]
-protected lemma list_prod_mem {l : list G} : (∀ x ∈ l, x ∈ K) → l.prod ∈ K :=
-list_prod_mem
-
-/-- Product of a multiset of elements in a subgroup of a `comm_group` is in the subgroup. -/
-@[to_additive "Sum of a multiset of elements in an `add_subgroup` of an `add_comm_group`
-is in the `add_subgroup`."]
-protected lemma multiset_prod_mem {G} [comm_group G] (K : subgroup G) (g : multiset G) :
-  (∀ a ∈ g, a ∈ K) → g.prod ∈ K := multiset_prod_mem g
-
-@[to_additive]
-lemma multiset_noncomm_prod_mem (K : subgroup G) (g : multiset G)
-  (comm : ∀ (x ∈ g) (y ∈ g), commute x y) :
-  (∀ a ∈ g, a ∈ K) → g.noncomm_prod comm ∈ K :=
-K.to_submonoid.multiset_noncomm_prod_mem g comm
-
-/-- Product of elements of a subgroup of a `comm_group` indexed by a `finset` is in the
-    subgroup. -/
-@[to_additive "Sum of elements in an `add_subgroup` of an `add_comm_group` indexed by a `finset`
-is in the `add_subgroup`."]
-protected lemma prod_mem {G : Type*} [comm_group G] (K : subgroup G)
-  {ι : Type*} {t : finset ι} {f : ι → G} (h : ∀ c ∈ t, f c ∈ K) :
-  ∏ c in t, f c ∈ K :=
-prod_mem h
-
-@[to_additive]
-lemma noncomm_prod_mem (K : subgroup G)
-  {ι : Type*} {t : finset ι} {f : ι → G} (comm : ∀ (x ∈ t) (y ∈ t), commute (f x) (f y)) :
-  (∀ c ∈ t, f c ∈ K) → t.noncomm_prod f comm ∈ K :=
-K.to_submonoid.noncomm_prod_mem t f comm
-
-
 @[to_additive add_subgroup.nsmul_mem]
 protected lemma pow_mem {x : G} (hx : x ∈ K) : ∀ n : ℕ, x ^ n ∈ K := pow_mem hx
 
@@ -531,7 +484,7 @@ instance has_inv : has_inv H := ⟨λ a, ⟨a⁻¹, H.inv_mem a.2⟩⟩
 instance has_div : has_div H := ⟨λ a b, ⟨a / b, H.div_mem a.2 b.2⟩⟩
 
 /-- An `add_subgroup` of an `add_group` inherits a natural scaling. -/
-instance _root_.add_subgroup.has_nsmul {G} [add_group G] {H : add_subgroup G} : has_scalar ℕ H :=
+instance _root_.add_subgroup.has_nsmul {G} [add_group G] {H : add_subgroup G} : has_smul ℕ H :=
 ⟨λ n a, ⟨n • a, H.nsmul_mem a.2 n⟩⟩
 
 /-- A subgroup of a group inherits a natural power -/
@@ -539,7 +492,7 @@ instance _root_.add_subgroup.has_nsmul {G} [add_group G] {H : add_subgroup G} :
 instance has_npow : has_pow H ℕ := ⟨λ a n, ⟨a ^ n, H.pow_mem a.2 n⟩⟩
 
 /-- An `add_subgroup` of an `add_group` inherits an integer scaling. -/
-instance _root_.add_subgroup.has_zsmul {G} [add_group G] {H : add_subgroup G} : has_scalar ℤ H :=
+instance _root_.add_subgroup.has_zsmul {G} [add_group G] {H : add_subgroup G} : has_smul ℤ H :=
 ⟨λ n a, ⟨n • a, H.zsmul_mem a.2 n⟩⟩
 
 /-- A subgroup of a group inherits an integer power -/
@@ -554,6 +507,9 @@ instance has_zpow : has_pow H ℤ := ⟨λ a n, ⟨a ^ n, H.zpow_mem a.2 n⟩⟩
 @[simp, norm_cast, to_additive] lemma coe_pow (x : H) (n : ℕ) : ((x ^ n : H) : G) = x ^ n := rfl
 @[simp, norm_cast, to_additive] lemma coe_zpow (x : H) (n : ℤ) : ((x ^ n : H) : G) = x ^ n := rfl
 
+@[simp, to_additive] lemma mk_eq_one_iff {g : G} {h} : (⟨g, h⟩ : H) = 1 ↔ g = 1 :=
+show (⟨g, h⟩ : H) = (⟨1, H.one_mem⟩ : H) ↔ g = 1, by simp
+
 /-- A subgroup of a group inherits a group structure. -/
 @[to_additive "An `add_subgroup` of an `add_group` inherits an `add_group` structure."]
 instance to_group {G : Type*} [group G] (H : subgroup G) : group H :=
@@ -578,26 +534,15 @@ subtype.coe_injective.ordered_comm_group _
 instance to_linear_ordered_comm_group {G : Type*} [linear_ordered_comm_group G]
   (H : subgroup G) : linear_ordered_comm_group H :=
 subtype.coe_injective.linear_ordered_comm_group _
-  rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
 /-- The natural group hom from a subgroup of group `G` to `G`. -/
 @[to_additive "The natural group hom from an `add_subgroup` of `add_group` `G` to `G`."]
-def subtype : H →* G := ⟨coe, rfl, λ _ _, rfl⟩
+protected def subtype : H →* G := ⟨coe, rfl, λ _ _, rfl⟩
 
 @[simp, to_additive] theorem coe_subtype : ⇑H.subtype = coe := rfl
 
-@[simp, norm_cast, to_additive] theorem coe_list_prod (l : list H) :
-  (l.prod : G) = (l.map coe).prod :=
-submonoid_class.coe_list_prod l
-
-@[simp, norm_cast, to_additive] theorem coe_multiset_prod {G} [comm_group G] (H : subgroup G)
-  (m : multiset H) : (m.prod : G) = (m.map coe).prod :=
-submonoid_class.coe_multiset_prod m
-
-@[simp, norm_cast, to_additive] theorem coe_finset_prod {ι G} [comm_group G] (H : subgroup G)
-  (f : ι → H) (s : finset ι) :
-  ↑(∏ i in s, f i) = (∏ i in s, f i : G) :=
-submonoid_class.coe_finset_prod f s
+@[to_additive] lemma subtype_injective : injective (subgroup.subtype H) := subtype.coe_injective
 
 /-- The inclusion homomorphism from a subgroup `H` contained in `K` to `K`. -/
 @[to_additive "The inclusion homomorphism from a additive subgroup `H` contained in `K` to `K`."]
@@ -615,7 +560,7 @@ set.inclusion_injective h
 @[simp, to_additive]
 lemma subtype_comp_inclusion {H K : subgroup G} (hH : H ≤ K) :
   K.subtype.comp (inclusion hH) = H.subtype :=
-by { ext, simp }
+rfl
 
 /-- The subgroup `G` of the group `G`. -/
 @[to_additive "The `add_subgroup G` of the `add_group G`."]
@@ -648,11 +593,12 @@ instance : inhabited (subgroup G) := ⟨⊥⟩
 
 @[to_additive] instance : unique (⊥ : subgroup G) := ⟨⟨1⟩, λ g, subtype.ext g.2⟩
 
+@[simp, to_additive] lemma top_to_submonoid : (⊤ : subgroup G).to_submonoid = ⊤ := rfl
+
+@[simp, to_additive] lemma bot_to_submonoid : (⊥ : subgroup G).to_submonoid = ⊥ := rfl
+
 @[to_additive] lemma eq_bot_iff_forall : H = ⊥ ↔ ∀ x ∈ H, x = (1 : G) :=
-begin
-  rw set_like.ext'_iff,
-  simp only [coe_bot, set.eq_singleton_iff_unique_mem, set_like.mem_coe, H.one_mem, true_and],
-end
+to_submonoid_injective.eq_iff.symm.trans $ submonoid.eq_bot_iff_forall _
 
 @[to_additive] lemma eq_bot_of_subsingleton [subsingleton H] : H = ⊥ :=
 begin
@@ -668,41 +614,13 @@ end
 ⟨λ ⟨g, hg⟩, by { haveI : subsingleton (H : set G) := by { rw hg, apply_instance },
   exact H.eq_bot_of_subsingleton }, λ h, ⟨1, set_like.ext'_iff.mp h⟩⟩
 
-@[to_additive] instance fintype_bot : fintype (⊥ : subgroup G) := ⟨{1},
-by {rintro ⟨x, ⟨hx⟩⟩, exact finset.mem_singleton_self _}⟩
-
-/- curly brackets `{}` are used here instead of instance brackets `[]` because
-  the instance in a goal is often not the same as the one inferred by type class inference.  -/
-@[simp, to_additive] lemma card_bot {_ : fintype ↥(⊥ : subgroup G)} :
-  fintype.card (⊥ : subgroup G)  = 1 :=
-fintype.card_eq_one_iff.2
-  ⟨⟨(1 : G), set.mem_singleton 1⟩, λ ⟨y, hy⟩, subtype.eq $ subgroup.mem_bot.1 hy⟩
-
-@[to_additive] lemma eq_top_of_card_eq [fintype H] [fintype G]
-  (h : fintype.card H = fintype.card G) : H = ⊤ :=
-begin
-  haveI : fintype (H : set G) := ‹fintype H›,
-  rw [set_like.ext'_iff, coe_top, ← finset.coe_univ, ← (H : set G).coe_to_finset, finset.coe_inj,
-    ← finset.card_eq_iff_eq_univ, ← h, set.to_finset_card],
-  congr
-end
-
-@[to_additive] lemma eq_top_of_le_card [fintype H] [fintype G]
-  (h : fintype.card G ≤ fintype.card H) : H = ⊤ :=
-eq_top_of_card_eq H (le_antisymm (fintype.card_le_of_injective coe subtype.coe_injective) h)
-
-@[to_additive] lemma eq_bot_of_card_le [fintype H] (h : fintype.card H ≤ 1) : H = ⊥ :=
-let _ := fintype.card_le_one_iff_subsingleton.mp h in by exactI eq_bot_of_subsingleton H
-
-@[to_additive] lemma eq_bot_of_card_eq [fintype H] (h : fintype.card H = 1) : H = ⊥ :=
-H.eq_bot_of_card_le (le_of_eq h)
-
 @[to_additive] lemma nontrivial_iff_exists_ne_one (H : subgroup G) :
   nontrivial H ↔ ∃ x ∈ H, x ≠ (1:G) :=
 subtype.nontrivial_iff_exists_ne (λ x, x ∈ H) (1 : H)
 
 /-- A subgroup is either the trivial subgroup or nontrivial. -/
-@[to_additive] lemma bot_or_nontrivial (H : subgroup G) : H = ⊥ ∨ nontrivial H :=
+@[to_additive "A subgroup is either the trivial subgroup or nontrivial."]
+lemma bot_or_nontrivial (H : subgroup G) : H = ⊥ ∨ nontrivial H :=
 begin
   classical,
   by_cases h : ∀ x ∈ H, x = (1 : G),
@@ -713,21 +631,14 @@ begin
     simpa only [nontrivial_iff_exists_ne_one] }
 end
 
-/-- A subgroup is either the trivial subgroup or contains a nonzero element. -/
-@[to_additive] lemma bot_or_exists_ne_one (H : subgroup G) : H = ⊥ ∨ ∃ x ∈ H, x ≠ (1:G) :=
+/-- A subgroup is either the trivial subgroup or contains a non-identity element. -/
+@[to_additive "A subgroup is either the trivial subgroup or contains a nonzero element."]
+lemma bot_or_exists_ne_one (H : subgroup G) : H = ⊥ ∨ ∃ x ∈ H, x ≠ (1:G) :=
 begin
   convert H.bot_or_nontrivial,
   rw nontrivial_iff_exists_ne_one
 end
 
-@[to_additive] lemma card_le_one_iff_eq_bot [fintype H] : fintype.card H ≤ 1 ↔ H = ⊥ :=
-⟨λ h, (eq_bot_iff_forall _).2
-    (λ x hx, by simpa [subtype.ext_iff] using fintype.card_le_one_iff.1 h ⟨x, hx⟩ 1),
-  λ h, by simp [h]⟩
-
-@[to_additive] lemma one_lt_card_iff_ne_bot [fintype H] : 1 < fintype.card H ↔ H ≠ ⊥ :=
-lt_iff_not_le.trans H.card_le_one_iff_eq_bot.not
-
 /-- The inf of two subgroups is their intersection. -/
 @[to_additive "The inf of two `add_subgroups`s is their intersection."]
 instance : has_inf (subgroup G) :=
@@ -989,91 +900,13 @@ end
 lemma closure_singleton_one : closure ({1} : set G) = ⊥ :=
 by simp [eq_bot_iff_forall, mem_closure_singleton]
 
-@[simp, to_additive] lemma inv_subset_closure (S : set G) : S⁻¹ ⊆ closure S :=
-begin
-  intros s hs,
-  rw [set_like.mem_coe, ←subgroup.inv_mem_iff],
-  exact subset_closure (mem_inv.mp hs),
-end
-
-@[simp, to_additive] lemma closure_inv (S : set G) : closure S⁻¹ = closure S :=
-begin
-  refine le_antisymm ((subgroup.closure_le _).2 _) ((subgroup.closure_le _).2 _),
-  { exact inv_subset_closure S },
-  { simpa only [inv_inv] using inv_subset_closure S⁻¹ },
-end
-
 @[to_additive]
-lemma closure_to_submonoid (S : set G) :
-  (closure S).to_submonoid = submonoid.closure (S ∪ S⁻¹) :=
-begin
-  refine le_antisymm _ (submonoid.closure_le.2 _),
-  { intros x hx,
-    refine closure_induction hx (λ x hx, submonoid.closure_mono (subset_union_left S S⁻¹)
-      (submonoid.subset_closure hx)) (submonoid.one_mem _) (λ x y hx hy, submonoid.mul_mem _ hx hy)
-      (λ x hx, _),
-    rwa [←submonoid.mem_closure_inv, set.union_inv, inv_inv, set.union_comm] },
-  { simp only [true_and, coe_to_submonoid, union_subset_iff, subset_closure, inv_subset_closure] }
-end
+lemma le_closure_to_submonoid (S : set G) : submonoid.closure S ≤ (closure S).to_submonoid :=
+submonoid.closure_le.2 subset_closure
 
-@[to_additive] lemma closure_induction_left {p : G → Prop} {x : G}
-  (h : x ∈ closure k) (H1 : p 1) (Hmul : ∀ (x ∈ k) y, p y → p (x * y))
-  (Hinv : ∀ (x ∈ k) y, p y → p (x⁻¹ * y)) : p x :=
-let key := le_of_eq (closure_to_submonoid k) in submonoid.closure_induction_left (key h) H1
-  (λ x hx, hx.elim (Hmul x) (λ hx y hy, (congr_arg _ (inv_inv x)).mp (Hinv x⁻¹ hx y hy)))
-
-@[to_additive] lemma closure_induction_right {p : G → Prop} {x : G}
-  (h : x ∈ closure k) (H1 : p 1) (Hmul : ∀ x (y ∈ k), p x → p (x * y))
-  (Hinv : ∀ x (y ∈ k), p x → p (x * y⁻¹)) : p x :=
-let key := le_of_eq (closure_to_submonoid k) in submonoid.closure_induction_right (key h) H1
-  (λ x y hy, hy.elim (Hmul x y) (λ hy hx, (congr_arg _ (inv_inv y)).mp (Hinv x y⁻¹ hy hx)))
-
-/-- An induction principle for closure membership. If `p` holds for `1` and all elements of
-`k` and their inverse, and is preserved under multiplication, then `p` holds for all elements of
-the closure of `k`. -/
-@[to_additive "An induction principle for additive closure membership. If `p` holds for `0` and all
-elements of `k` and their negation, and is preserved under addition, then `p` holds for all
-elements of the additive closure of `k`."]
-lemma closure_induction'' {p : G → Prop} {x} (h : x ∈ closure k)
-  (Hk : ∀ x ∈ k, p x) (Hk_inv : ∀ x ∈ k, p x⁻¹) (H1 : p 1)
-  (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
-closure_induction_left h H1 (λ x hx y hy, Hmul x y (Hk x hx) hy)
-  (λ x hx y hy, Hmul x⁻¹ y (Hk_inv x hx) hy)
-
-/-- An induction principle for elements of `⨆ i, S i`.
-If `C` holds for `1` and all elements of `S i` for all `i`, and is preserved under multiplication,
-then it holds for all elements of the supremum of `S`. -/
-@[elab_as_eliminator, to_additive /-" An induction principle for elements of `⨆ i, S i`.
-If `C` holds for `0` and all elements of `S i` for all `i`, and is preserved under addition,
-then it holds for all elements of the supremum of `S`. "-/]
-lemma supr_induction {ι : Sort*} (S : ι → subgroup G) {C : G → Prop} {x : G} (hx : x ∈ ⨆ i, S i)
-  (hp : ∀ i (x ∈ S i), C x)
-  (h1 : C 1)
-  (hmul : ∀ x y, C x → C y → C (x * y)) : C x :=
-begin
-  rw supr_eq_closure at hx,
-  refine closure_induction'' hx (λ x hx, _) (λ x hx, _) h1 hmul,
-  { obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
-    exact hp _ _ hi, },
-  { obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
-    exact hp _ _ (inv_mem hi), },
-end
-
-/-- A dependent version of `subgroup.supr_induction`. -/
-@[elab_as_eliminator, to_additive /-"A dependent version of `add_subgroup.supr_induction`. "-/]
-lemma supr_induction' {ι : Sort*} (S : ι → subgroup G) {C : Π x, (x ∈ ⨆ i, S i) → Prop}
-  (hp : ∀ i (x ∈ S i), C x (mem_supr_of_mem i ‹_›))
-  (h1 : C 1 (one_mem _))
-  (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›))
-  {x : G} (hx : x ∈ ⨆ i, S i) : C x hx :=
-begin
-  refine exists.elim _ (λ (hx : x ∈ ⨆ i, S i) (hc : C x hx), hc),
-  refine supr_induction S hx (λ i x hx, _) _ (λ x y, _),
-  { exact ⟨_, hp _ _ hx⟩ },
-  { exact ⟨_, h1⟩ },
-  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
-    refine ⟨_, hmul _ _ _ _ Cx Cy⟩ },
-end
+@[to_additive] lemma closure_eq_top_of_mclosure_eq_top {S : set G} (h : submonoid.closure S = ⊤) :
+  closure S = ⊤ :=
+(eq_top_iff' _).2 $ λ x, le_closure_to_submonoid _ $ h.symm ▸ trivial
 
 @[to_additive]
 lemma mem_supr_of_directed {ι} [hι : nonempty ι] {K : ι → subgroup G} (hK : directed (≤) K)
@@ -1132,6 +965,10 @@ lemma comap_comap (K : subgroup P) (g : N →* P) (f : G →* N) :
   (K.comap g).comap f = K.comap (g.comp f) :=
 rfl
 
+@[simp, to_additive] lemma comap_id (K : subgroup N) :
+  K.comap (monoid_hom.id _) = K :=
+by { ext, refl }
+
 /-- The image of a subgroup along a monoid homomorphism is a subgroup. -/
 @[to_additive "The image of an `add_subgroup` along an `add_monoid` homomorphism
 is an `add_subgroup`."]
@@ -1193,6 +1030,17 @@ lemma comap_equiv_eq_map_symm (f : N ≃* G) (K : subgroup G) :
   K.comap f.to_monoid_hom = K.map f.symm.to_monoid_hom :=
 (map_equiv_eq_comap_symm f.symm K).symm
 
+@[to_additive]
+lemma map_symm_eq_iff_map_eq {H : subgroup N} {e : G ≃* N} :
+  H.map ↑e.symm = K ↔ K.map ↑e = H :=
+begin
+  split; rintro rfl,
+  { rw [map_map, ← mul_equiv.coe_monoid_hom_trans, mul_equiv.symm_trans_self,
+        mul_equiv.coe_monoid_hom_refl, map_id] },
+  { rw [map_map, ← mul_equiv.coe_monoid_hom_trans, mul_equiv.self_trans_symm,
+        mul_equiv.coe_monoid_hom_refl, map_id] },
+end
+
 @[to_additive]
 lemma map_le_iff_le_comap {f : G →* N} {K : subgroup G} {H : subgroup N} :
   K.map f ≤ H ↔ K ≤ H.comap f :=
@@ -1249,30 +1097,27 @@ by {rw eq_top_iff, intros x hx, obtain ⟨y, hy⟩ := (h x), exact ⟨y, trivial
 @[simp, to_additive] lemma comap_top (f : G →* N) : (⊤ : subgroup N).comap f = ⊤ :=
 (gc_map_comap f).u_top
 
-@[simp, to_additive] lemma comap_subtype_self_eq_top {G : Type*} [group G] {H : subgroup G} :
-  comap H.subtype H = ⊤ := by { ext, simp }
-
-@[simp, to_additive]
-lemma comap_subtype_inf_left {H K : subgroup G} : comap H.subtype (H ⊓ K) = comap H.subtype K :=
-ext $ λ x, and_iff_right_of_imp (λ _, x.prop)
-
-@[simp, to_additive]
-lemma comap_subtype_inf_right {H K : subgroup G} : comap K.subtype (H ⊓ K) = comap K.subtype H :=
-ext $ λ x, and_iff_left_of_imp (λ _, x.prop)
+/-- For any subgroups `H` and `K`, view `H ⊓ K` as a subgroup of `K`. -/
+@[to_additive "For any subgroups `H` and `K`, view `H ⊓ K` as a subgroup of `K`."]
+def subgroup_of (H K : subgroup G) : subgroup K := H.comap K.subtype
 
 /-- If `H ≤ K`, then `H` as a subgroup of `K` is isomorphic to `H`. -/
 @[to_additive "If `H ≤ K`, then `H` as a subgroup of `K` is isomorphic to `H`.", simps]
-def comap_subtype_equiv_of_le {G : Type*} [group G] {H K : subgroup G} (h : H ≤ K) :
-  H.comap K.subtype ≃* H :=
+def subgroup_of_equiv_of_le {G : Type*} [group G] {H K : subgroup G} (h : H ≤ K) :
+  H.subgroup_of K ≃* H :=
 { to_fun := λ g, ⟨g.1, g.2⟩,
   inv_fun := λ g, ⟨⟨g.1, h g.2⟩, g.2⟩,
   left_inv := λ g, subtype.ext (subtype.ext rfl),
   right_inv := λ g, subtype.ext rfl,
   map_mul' := λ g h, rfl }
 
-/-- For any subgroups `H` and `K`, view `H ⊓ K` as a subgroup of `K`. -/
-@[to_additive "For any subgroups `H` and `K`, view `H ⊓ K` as a subgroup of `K`."]
-def subgroup_of (H K : subgroup G) : subgroup K := H.comap K.subtype
+@[simp, to_additive]
+lemma comap_subtype (H K : subgroup G) : H.comap K.subtype = H.subgroup_of K := rfl
+
+@[simp, to_additive]
+lemma comap_inclusion_subgroup_of {K₁ K₂ : subgroup G} (h : K₁ ≤ K₂) (H : subgroup G) :
+  (H.subgroup_of K₂).comap (inclusion h) = H.subgroup_of K₁ :=
+rfl
 
 @[to_additive] lemma coe_subgroup_of (H K : subgroup G) :
   (H.subgroup_of K : set K) = K.subtype ⁻¹' H := rfl
@@ -1281,13 +1126,9 @@ def subgroup_of (H K : subgroup G) : subgroup K := H.comap K.subtype
   h ∈ H.subgroup_of K ↔ (h : G) ∈ H :=
 iff.rfl
 
-@[to_additive] lemma subgroup_of_map_subtype (H K : subgroup G) :
-  (H.subgroup_of K).map K.subtype = H ⊓ K := set_like.ext'
-begin
-  convert set.image_preimage_eq_inter_range,
-  simp only [subtype.range_coe_subtype, coe_subtype, coe_inf],
-  refl,
-end
+@[simp, to_additive] lemma subgroup_of_map_subtype (H K : subgroup G) :
+  (H.subgroup_of K).map K.subtype = H ⊓ K :=
+set_like.ext' $ subtype.image_preimage_coe _ _
 
 @[simp, to_additive] lemma bot_subgroup_of : (⊥ : subgroup G).subgroup_of H = ⊥ :=
 eq.symm (subgroup.ext (λ g, subtype.ext_iff))
@@ -1301,8 +1142,26 @@ subsingleton.elim _ _
 @[to_additive] lemma subgroup_of_bot_eq_top : H.subgroup_of ⊥ = ⊤ :=
 subsingleton.elim _ _
 
-@[simp, to_additive] lemma subgroup_of_self : H.subgroup_of H = ⊤ :=
-top_le_iff.mp (λ g hg, g.2)
+@[simp, to_additive] lemma subgroup_of_self : H.subgroup_of H = ⊤ := top_unique (λ g hg, g.2)
+
+@[simp, to_additive] lemma subgroup_of_inj {H₁ H₂ K : subgroup G} :
+  H₁.subgroup_of K = H₂.subgroup_of K ↔ H₁ ⊓ K = H₂ ⊓ K :=
+by simpa only [set_like.ext_iff, mem_inf, mem_subgroup_of, and.congr_left_iff] using subtype.forall
+
+@[simp, to_additive] lemma inf_subgroup_of_right (H K : subgroup G) :
+  (H ⊓ K).subgroup_of K = H.subgroup_of K :=
+subgroup_of_inj.2 inf_right_idem
+
+@[simp, to_additive] lemma inf_subgroup_of_left (H K : subgroup G) :
+  (K ⊓ H).subgroup_of K = H.subgroup_of K :=
+by rw [inf_comm, inf_subgroup_of_right]
+
+@[simp, to_additive] lemma subgroup_of_eq_bot {H K : subgroup G} :
+  H.subgroup_of K = ⊥ ↔ disjoint H K :=
+by rw [disjoint_iff, ← bot_subgroup_of, subgroup_of_inj, bot_inf_eq]
+
+@[simp, to_additive] lemma subgroup_of_eq_top {H K : subgroup G} : H.subgroup_of K = ⊤ ↔ K ≤ H :=
+by rw [← top_subgroup_of, subgroup_of_inj, top_inf_eq, inf_eq_right]
 
 /-- Given `subgroup`s `H`, `K` of groups `G`, `N` respectively, `H × K` as a subgroup of `G × N`. -/
 @[to_additive prod "Given `add_subgroup`s `H`, `K` of `add_group`s `A`, `B` respectively, `H × K`
@@ -1312,8 +1171,7 @@ def prod (H : subgroup G) (K : subgroup N) : subgroup (G × N) :=
   .. submonoid.prod H.to_submonoid K.to_submonoid}
 
 @[to_additive coe_prod]
-lemma coe_prod (H : subgroup G) (K : subgroup N) :
-  (H.prod K : set (G × N)) = (H : set G) ×ˢ (K : set N) := rfl
+lemma coe_prod (H : subgroup G) (K : subgroup N) : (H.prod K : set (G × N)) = H ×ˢ K := rfl
 
 @[to_additive mem_prod]
 lemma mem_prod {H : subgroup G} {K : subgroup N} {p : G × N} :
@@ -1437,50 +1295,6 @@ begin
     { simp [heq, one_mem], }, }
 end
 
-@[to_additive]
-lemma pi_mem_of_mul_single_mem_aux [decidable_eq η] (I : finset η) {H : subgroup (Π i, f i) }
-  (x : Π i, f i) (h1 : ∀ i, i ∉ I → x i = 1) (h2 : ∀ i, i ∈ I → pi.mul_single i (x i) ∈ H ) :
-  x ∈ H :=
-begin
-  induction I using finset.induction_on with i I hnmem ih generalizing x,
-  { convert one_mem H,
-    ext i,
-    exact (h1 i (not_mem_empty i)) },
-  { have : x = function.update x i 1 * pi.mul_single i (x i),
-    { ext j,
-      by_cases heq : j = i,
-      { subst heq, simp, },
-      { simp [heq], }, },
-    rw this, clear this,
-    apply mul_mem,
-    { apply ih; clear ih,
-      { intros j hj,
-        by_cases heq : j = i,
-        { subst heq, simp, },
-        { simp [heq], apply h1 j, simpa [heq] using hj, } },
-      { intros j hj,
-        have : j ≠ i, by { rintro rfl, contradiction },
-        simp [this],
-        exact h2 _ (finset.mem_insert_of_mem hj), }, },
-    { apply h2, simp, } }
-end
-
-@[to_additive]
-lemma pi_mem_of_mul_single_mem [fintype η] [decidable_eq η] {H : subgroup (Π i, f i)}
-  (x : Π i, f i) (h : ∀ i, pi.mul_single i (x i) ∈ H) : x ∈ H :=
-pi_mem_of_mul_single_mem_aux finset.univ x (by simp) (λ i _, h i)
-
-/-- For finite index types, the `subgroup.pi` is generated by the embeddings of the groups.  -/
-@[to_additive "For finite index types, the `subgroup.pi` is generated by the embeddings of the
-additive groups."]
-lemma pi_le_iff [decidable_eq η] [fintype η] {H : Π i, subgroup (f i)} {J : subgroup (Π i, f i)} :
-  pi univ H ≤ J ↔ (∀ i : η, map (monoid_hom.single f i) (H i) ≤ J) :=
-begin
-  split,
-  { rintros h i _ ⟨x, hx, rfl⟩, apply h, simpa using hx },
-  { exact λ h x hx, pi_mem_of_mul_single_mem  x (λ i, h i (mem_map_of_mem _ (hx i trivial))), }
-end
-
 @[to_additive]
 lemma pi_eq_bot_iff (H : Π i, subgroup (f i)) :
   pi set.univ H = ⊥ ↔ ∀ i, H i = ⊥ :=
@@ -1630,8 +1444,8 @@ variable {G}
 
 @[to_additive] lemma mem_center_iff {z : G} : z ∈ center G ↔ ∀ g, g * z = z * g := iff.rfl
 
-instance decidable_mem_center [decidable_eq G] [fintype G] : decidable_pred (∈ center G) :=
-λ _, decidable_of_iff' _ mem_center_iff
+instance decidable_mem_center (z : G) [decidable (∀ g, g * z = z * g)] : decidable (z ∈ center G) :=
+decidable_of_iff' _ mem_center_iff
 
 @[to_additive] instance center_characteristic : (center G).characteristic :=
 begin
@@ -1675,16 +1489,6 @@ def set_normalizer (S : set G) : subgroup G :=
   inv_mem' := λ a (ha : ∀ n, n ∈ S ↔ a * n * a⁻¹ ∈ S) n,
     by { rw [ha (a⁻¹ * n * a⁻¹⁻¹)], simp [mul_assoc] } }
 
-lemma mem_normalizer_fintype {S : set G} [fintype S] {x : G}
-  (h : ∀ n, n ∈ S → x * n * x⁻¹ ∈ S) : x ∈ subgroup.set_normalizer S :=
-by haveI := classical.prop_decidable;
-haveI := set.fintype_image S (λ n, x * n * x⁻¹); exact
-λ n, ⟨h n, λ h₁,
-have heq : (λ n, x * n * x⁻¹) '' S = S := set.eq_of_subset_of_card_le
-  (λ n ⟨y, hy⟩, hy.2 ▸ h y hy.1) (by rw set.card_image_of_injective S conj_injective),
-have x * n * x⁻¹ ∈ (λ n, x * n * x⁻¹) '' S := heq.symm ▸ h₁,
-let ⟨y, hy⟩ := this in conj_injective hy.2 ▸ hy.1⟩
-
 variable {H}
 @[to_additive] lemma mem_normalizer_iff {g : G} :
   g ∈ H.normalizer ↔ ∀ h, h ∈ H ↔ g * h * g⁻¹ ∈ H :=
@@ -1702,7 +1506,7 @@ by rw [←inv_mem_iff, mem_normalizer_iff, inv_inv]
 λ x xH n, by rw [H.mul_mem_cancel_right (H.inv_mem xH), H.mul_mem_cancel_left xH]
 
 @[priority 100, to_additive]
-instance normal_in_normalizer : (H.comap H.normalizer.subtype).normal :=
+instance normal_in_normalizer : (H.subgroup_of H.normalizer).normal :=
 ⟨λ x xH g, by simpa using (g.2 x).1 xH⟩
 
 @[to_additive] lemma normalizer_eq_top : H.normalizer = ⊤ ↔ H.normal :=
@@ -1715,9 +1519,9 @@ eq_top_iff.trans ⟨λ h, ⟨λ a ha b, (h (mem_top b) a).mp ha⟩, λ h a ha b,
 open_locale classical
 
 @[to_additive]
-lemma le_normalizer_of_normal [hK : (H.comap K.subtype).normal] (HK : H ≤ K) : K ≤ H.normalizer :=
+lemma le_normalizer_of_normal [hK : (H.subgroup_of K).normal] (HK : H ≤ K) : K ≤ H.normalizer :=
 λ x hx y, ⟨λ yH, hK.conj_mem ⟨y, HK yH⟩ yH ⟨x, hx⟩,
-  λ yH, by simpa [mem_comap, mul_assoc] using
+  λ yH, by simpa [mem_subgroup_of, mul_assoc] using
              hK.conj_mem ⟨x * y * x⁻¹, HK yH⟩ yH ⟨x⁻¹, K.inv_mem hx⟩⟩
 
 variables {N : Type*} [group N]
@@ -1776,27 +1580,42 @@ normalizer_eq_top.mp (hmax.2 _ (hnc H (lt_top_iff_ne_top.mpr hmax.1)))
 end normalizer
 
 section centralizer
+variables {H}
 
 /-- The `centralizer` of `H` is the subgroup of `g : G` commuting with every `h : H`. -/
 @[to_additive "The `centralizer` of `H` is the additive subgroup of `g : G` commuting with
 every `h : H`."]
-def centralizer : subgroup G :=
-{ carrier := set.centralizer H,
+def centralizer (s : set G) : subgroup G :=
+{ carrier := set.centralizer s,
   inv_mem' := λ g, set.inv_mem_centralizer,
-  .. submonoid.centralizer ↑H }
+  .. submonoid.centralizer s }
 
-@[to_additive] lemma mem_centralizer_iff {g : G} : g ∈ H.centralizer ↔ ∀ h ∈ H, h * g = g * h :=
+@[to_additive] lemma mem_centralizer_iff {g : G} {s : set G} :
+  g ∈ centralizer s ↔ ∀ h ∈ s, h * g = g * h :=
 iff.rfl
 
-@[to_additive] lemma mem_centralizer_iff_commutator_eq_one {g : G} :
-  g ∈ H.centralizer ↔ ∀ h ∈ H, h * g * h⁻¹ * g⁻¹ = 1 :=
+@[to_additive] lemma mem_centralizer_iff_commutator_eq_one {g : G} {s : set G} :
+  g ∈ centralizer s ↔ ∀ h ∈ s, h * g * h⁻¹ * g⁻¹ = 1 :=
 by simp only [mem_centralizer_iff, mul_inv_eq_iff_eq_mul, one_mul]
 
-@[to_additive] lemma centralizer_top : centralizer ⊤ = center G :=
+@[to_additive] lemma centralizer_univ : centralizer set.univ = center G :=
 set_like.ext' (set.centralizer_univ G)
 
+@[to_additive] lemma le_centralizer_iff : H ≤ centralizer K ↔ K ≤ centralizer H :=
+⟨λ h x hx y hy, (h hy x hx).symm, λ h x hx y hy, (h hy x hx).symm⟩
+
+@[to_additive] lemma center_le_centralizer (s) : center G ≤ centralizer s :=
+set.center_subset_centralizer s
+
+@[to_additive] lemma centralizer_le {s t : set G} (h : s ⊆ t) : centralizer t ≤ centralizer s :=
+submonoid.centralizer_le h
+
+@[simp, to_additive] lemma centralizer_eq_top_iff_subset {s : set G} :
+  centralizer s = ⊤ ↔ s ⊆ center G :=
+set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset
+
 @[to_additive] instance subgroup.centralizer.characteristic [hH : H.characteristic] :
-  H.centralizer.characteristic :=
+  (centralizer (H : set G)).characteristic :=
 begin
   refine subgroup.characteristic_iff_comap_le.mpr (λ ϕ g hg h hh, ϕ.injective _),
   rw [map_mul, map_mul],
@@ -1818,13 +1637,39 @@ structure _root_.add_subgroup.is_commutative (H : add_subgroup A) : Prop :=
 attribute [to_additive add_subgroup.is_commutative] subgroup.is_commutative
 attribute [class] add_subgroup.is_commutative
 
-/-- A commutative subgroup is commutative -/
-@[to_additive] instance is_commutative.comm_group [h : H.is_commutative] : comm_group H :=
+/-- A commutative subgroup is commutative. -/
+@[to_additive "A commutative subgroup is commutative."]
+instance is_commutative.comm_group [h : H.is_commutative] : comm_group H :=
 { mul_comm := h.is_comm.comm, .. H.to_group }
 
 instance center.is_commutative : (center G).is_commutative :=
 ⟨⟨λ a b, subtype.ext (b.2 a)⟩⟩
 
+@[to_additive] instance map_is_commutative (f : G →* G') [H.is_commutative] :
+  (H.map f).is_commutative :=
+⟨⟨begin
+  rintros ⟨-, a, ha, rfl⟩ ⟨-, b, hb, rfl⟩,
+  rw [subtype.ext_iff, coe_mul, coe_mul, subtype.coe_mk, subtype.coe_mk, ←map_mul, ←map_mul],
+  exact congr_arg f (subtype.ext_iff.mp (mul_comm ⟨a, ha⟩ ⟨b, hb⟩)),
+end⟩⟩
+
+@[to_additive] lemma comap_injective_is_commutative {f : G' →* G} (hf : injective f)
+  [H.is_commutative] : (H.comap f).is_commutative :=
+⟨⟨λ a b, subtype.ext begin
+  have := mul_comm (⟨f a, a.2⟩ : H) (⟨f b, b.2⟩ : H),
+  rwa [subtype.ext_iff, coe_mul, coe_mul, coe_mk, coe_mk, ←map_mul, ←map_mul, hf.eq_iff] at this,
+end⟩⟩
+
+@[to_additive] instance subgroup_of_is_commutative [H.is_commutative] :
+  (H.subgroup_of K).is_commutative :=
+H.comap_injective_is_commutative subtype.coe_injective
+
+@[to_additive] lemma le_centralizer_iff_is_commutative : K ≤ centralizer K ↔ K.is_commutative :=
+⟨λ h, ⟨⟨λ x y, subtype.ext (h y.2 x x.2)⟩⟩, λ h x hx y hy, congr_arg coe (h.1.1 ⟨y, hy⟩ ⟨x, hx⟩)⟩
+
+@[to_additive] lemma le_centralizer [h : H.is_commutative] : H ≤ centralizer H :=
+le_centralizer_iff_is_commutative.mpr h
+
 end subgroup
 
 namespace group
@@ -1942,7 +1787,7 @@ def normal_core (H : subgroup G) : subgroup G :=
   mul_mem' := λ a b ha hb c, (congr_arg (∈ H) conj_mul).mp (H.mul_mem (ha c) (hb c)) }
 
 lemma normal_core_le (H : subgroup G) : H.normal_core ≤ H :=
-λ a h, by { rw [←mul_one a, ←one_inv, ←one_mul a], exact h 1 }
+λ a h, by { rw [←mul_one a, ←inv_one, ←one_mul a], exact h 1 }
 
 instance normal_core_normal (H : subgroup G) : H.normal_core.normal :=
 ⟨λ a h b c, by rw [mul_assoc, mul_assoc, ←mul_inv_rev, ←mul_assoc, ←mul_assoc]; exact h (c * b)⟩
@@ -1980,11 +1825,6 @@ open subgroup
 def range (f : G →* N) : subgroup N :=
 subgroup.copy ((⊤ : subgroup G).map f) (set.range f) (by simp [set.ext_iff])
 
-@[to_additive]
-instance decidable_mem_range (f : G →* N) [fintype G] [decidable_eq N] :
-  decidable_pred (∈ f.range) :=
-λ x, fintype.decidable_exists_fintype
-
 @[simp, to_additive] lemma coe_range (f : G →* N) :
   (f.range : set N) = set.range f := rfl
 
@@ -1995,16 +1835,29 @@ iff.rfl
 @[to_additive] lemma range_eq_map (f : G →* N) : f.range = (⊤ : subgroup G).map f :=
 by ext; simp
 
+@[simp, to_additive] lemma restrict_range (f : G →* N) : (f.restrict K).range = K.map f :=
+by simp_rw [set_like.ext_iff, mem_range, mem_map, restrict_apply, set_like.exists, subtype.coe_mk,
+  iff_self, forall_const]
+
 /-- The canonical surjective group homomorphism `G →* f(G)` induced by a group
 homomorphism `G →* N`. -/
 @[to_additive "The canonical surjective `add_group` homomorphism `G →+ f(G)` induced by a group
 homomorphism `G →+ N`."]
 def range_restrict (f : G →* N) : G →* f.range :=
-monoid_hom.mk' (λ g, ⟨f g, ⟨g, rfl⟩⟩) $ λ a b, by {ext, exact f.map_mul' _ _}
+cod_restrict f _ $ λ x, ⟨x, rfl⟩
 
 @[simp, to_additive]
 lemma coe_range_restrict (f : G →* N) (g : G) : (f.range_restrict g : N) = f g := rfl
 
+@[to_additive]
+lemma coe_comp_range_restrict (f : G →* N) :
+  (coe : f.range → N) ∘ (⇑(f.range_restrict) : G → f.range) = f :=
+rfl
+
+@[to_additive]
+lemma subtype_comp_range_restrict (f : G →* N) : f.range.subtype.comp (f.range_restrict) = f :=
+ext $ f.coe_range_restrict
+
 @[to_additive]
 lemma range_restrict_surjective (f : G →* N) : function.surjective f.range_restrict :=
 λ ⟨_, g, rfl⟩, ⟨g, rfl⟩
@@ -2024,6 +1877,10 @@ lemma range_top_of_surjective {N} [group N] (f : G →* N) (hf : function.surjec
   f.range = (⊤ : subgroup N) :=
 range_top_iff_surjective.2 hf
 
+@[simp, to_additive]
+lemma range_one : (1 : G →* N).range = ⊥ :=
+set_like.ext $ λ x, by simpa using @comm _ (=) _ 1 x
+
 @[simp, to_additive] lemma _root_.subgroup.subtype_range (H : subgroup G) : H.subtype.range = H :=
 by { rw [range_eq_map, ← set_like.coe_set_eq, coe_map, subgroup.coe_subtype], ext, simp }
 
@@ -2031,27 +1888,6 @@ by { rw [range_eq_map, ← set_like.coe_set_eq, coe_map, subgroup.coe_subtype],
   (inclusion h_le).range = H.subgroup_of K :=
 subgroup.ext (λ g, set.ext_iff.mp (set.range_inclusion h_le) g)
 
-/-- Restriction of a group hom to a subgroup of the domain. -/
-@[to_additive "Restriction of an `add_group` hom to an `add_subgroup` of the domain."]
-def restrict (f : G →* N) (H : subgroup G) : H →* N :=
-f.comp H.subtype
-
-@[simp, to_additive]
-lemma restrict_apply {H : subgroup G} (f : G →* N) (x : H) :
-  f.restrict H x = f (x : G) := rfl
-
-/-- Restriction of a group hom to a subgroup of the codomain. -/
-@[to_additive "Restriction of an `add_group` hom to an `add_subgroup` of the codomain."]
-def cod_restrict (f : G →* N) (S : subgroup N) (h : ∀ x, f x ∈ S) : G →* S :=
-{ to_fun := λ n, ⟨f n, h n⟩,
-  map_one' := subtype.eq f.map_one,
-  map_mul' := λ x y, subtype.eq (f.map_mul x y) }
-
-@[simp, to_additive]
-lemma cod_restrict_apply {G : Type*} [group G] {N : Type*} [group N] (f : G →* N)
-  (S : subgroup N) (h : ∀ (x : G), f x ∈ S) {x : G} :
-    f.cod_restrict S h x = ⟨f x, h x⟩ := rfl
-
 @[to_additive] lemma subgroup_of_range_eq_of_le {G₁ G₂ : Type*} [group G₁] [group G₂]
   {K : subgroup G₂} (f : G₁ →* G₂) (h : f.range ≤ K) :
   f.range.subgroup_of K = (f.cod_restrict K (λ x, h ⟨x, rfl⟩)).range :=
@@ -2103,9 +1939,7 @@ such that `f x = 0`"]
 def ker (f : G →* M) : subgroup G :=
 { inv_mem' := λ x (hx : f x = 1),
     calc f x⁻¹ = f x * f x⁻¹ : by rw [hx, one_mul]
-           ... = f (x * x⁻¹) : by rw [f.map_mul]
-           ... = f 1 :         by rw [mul_right_inv]
-           ... = 1 :           f.map_one,
+           ... = 1           : by rw [← map_mul, mul_inv_self, map_one],
   ..f.mker }
 
 @[to_additive]
@@ -2114,9 +1948,17 @@ lemma mem_ker (f : G →* M) {x : G} : x ∈ f.ker ↔ f x = 1 := iff.rfl
 @[to_additive]
 lemma coe_ker (f : G →* M) : (f.ker : set G) = (f : G → M) ⁻¹' {1} := rfl
 
+@[simp, to_additive]
+lemma ker_to_hom_units {M} [monoid M] (f : G →* M) : f.to_hom_units.ker = f.ker :=
+by { ext x, simp [mem_ker, units.ext_iff] }
+
 @[to_additive]
-lemma eq_iff (f : G →* N) {x y : G} : f x = f y ↔ y⁻¹ * x ∈ f.ker :=
-by rw [f.mem_ker, f.map_mul, f.map_inv, inv_mul_eq_one, eq_comm]
+lemma eq_iff (f : G →* M) {x y : G} : f x = f y ↔ y⁻¹ * x ∈ f.ker :=
+begin
+  split; intro h,
+  { rw [mem_ker, map_mul, h, ← map_mul, inv_mul_self, map_one] },
+  { rw [← one_mul x, ← mul_inv_self y, mul_assoc, map_mul, f.mem_ker.1 h, mul_one] }
+end
 
 @[to_additive]
 instance decidable_mem_ker [decidable_eq M] (f : G →* M) :
@@ -2129,24 +1971,22 @@ lemma comap_ker (g : N →* P) (f : G →* N) : g.ker.comap f = (g.comp f).ker :
 @[simp, to_additive] lemma comap_bot (f : G →* N) :
   (⊥ : subgroup N).comap f = f.ker := rfl
 
-@[to_additive] lemma range_restrict_ker  (f : G →* N) : ker (range_restrict f) = ker f :=
-begin
-  ext,
-  change (⟨f x, _⟩ : range f) = ⟨1, _⟩ ↔ f x = 1,
-  simp only [],
-end
+@[simp, to_additive] lemma ker_restrict (f : G →* N) : (f.restrict K).ker = f.ker.subgroup_of K :=
+rfl
 
-@[simp, to_additive]
-lemma ker_one : (1 : G →* M).ker = ⊤ :=
-by { ext, simp [mem_ker] }
+@[simp, to_additive] lemma ker_cod_restrict {S} [set_like S N] [submonoid_class S N] (f : G →* N)
+  (s : S) (h : ∀ x, f x ∈ s) : (f.cod_restrict s h).ker = f.ker :=
+set_like.ext $ λ x, subtype.ext_iff
 
-@[to_additive] lemma ker_eq_bot_iff (f : G →* N) : f.ker = ⊥ ↔ function.injective f :=
-begin
-  split,
-  { intros h x y hxy,
-    rwa [←mul_inv_eq_one, ←map_inv, ←map_mul, ←mem_ker, h, mem_bot, mul_inv_eq_one] at hxy },
-  { exact λ h, le_bot_iff.mp (λ x hx, h (hx.trans f.map_one.symm)) },
-end
+@[simp, to_additive] lemma ker_range_restrict  (f : G →* N) : ker (range_restrict f) = ker f :=
+ker_cod_restrict _ _ _
+
+@[simp, to_additive] lemma ker_one : (1 : G →* M).ker = ⊤ := set_like.ext $ λ x, eq_self_iff_true _
+@[simp, to_additive] lemma ker_id : (monoid_hom.id G).ker = ⊥ := rfl
+
+@[to_additive] lemma ker_eq_bot_iff (f : G →* M) : f.ker = ⊥ ↔ function.injective f :=
+⟨λ h x y hxy, by rwa [eq_iff, h, mem_bot, inv_mul_eq_one, eq_comm] at hxy,
+  λ h, bot_unique $ λ x hx, h (hx.trans f.map_one.symm)⟩
 
 @[simp, to_additive] lemma _root_.subgroup.ker_subtype (H : subgroup G) : H.subtype.ker = ⊥ :=
 H.subtype.ker_eq_bot_iff.mpr subtype.coe_injective
@@ -2166,32 +2006,46 @@ lemma ker_prod_map {G' : Type*} {N' : Type*} [group G'] [group N'] (f : G →* N
   (prod_map f g).ker = f.ker.prod g.ker :=
 by rw [←comap_bot, ←comap_bot, ←comap_bot, ←prod_map_comap_prod, bot_prod_bot]
 
+@[priority 100, to_additive]
+instance normal_ker (f : G →* M) : f.ker.normal :=
+⟨λ x hx y, by rw [mem_ker, map_mul, map_mul, f.mem_ker.1 hx, mul_one,
+  map_mul_eq_one f (mul_inv_self y)]⟩
+
 end ker
 
+section eq_locus
+
+variables {M : Type*} [monoid M]
+
 /-- The subgroup of elements `x : G` such that `f x = g x` -/
 @[to_additive "The additive subgroup of elements `x : G` such that `f x = g x`"]
-def eq_locus (f g : G →* N) : subgroup G :=
-{ inv_mem' := λ x (hx : f x = g x), show f x⁻¹ = g x⁻¹, by rw [f.map_inv, g.map_inv, hx],
+def eq_locus (f g : G →* M) : subgroup G :=
+{ inv_mem' := λ x, eq_on_inv f g,
   .. eq_mlocus f g}
 
+@[simp, to_additive] lemma eq_locus_same (f : G →* N) : f.eq_locus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two monoid homomorphisms are equal on a set, then they are equal on its subgroup closure. -/
-@[to_additive]
-lemma eq_on_closure {f g : G →* N} {s : set G} (h : set.eq_on f g s) :
-  set.eq_on f g (closure s) :=
+@[to_additive "If two monoid homomorphisms are equal on a set, then they are equal on its subgroup
+closure."]
+lemma eq_on_closure {f g : G →* M} {s : set G} (h : set.eq_on f g s) : set.eq_on f g (closure s) :=
 show closure s ≤ f.eq_locus g, from (closure_le _).2 h
 
 @[to_additive]
-lemma eq_of_eq_on_top {f g : G →* N} (h : set.eq_on f g (⊤ : subgroup G)) :
+lemma eq_of_eq_on_top {f g : G →* M} (h : set.eq_on f g (⊤ : subgroup G)) :
   f = g :=
 ext $ λ x, h trivial
 
 @[to_additive]
-lemma eq_of_eq_on_dense {s : set G} (hs : closure s = ⊤) {f g : G →* N} (h : s.eq_on f g) :
+lemma eq_of_eq_on_dense {s : set G} (hs : closure s = ⊤) {f g : G →* M} (h : s.eq_on f g) :
   f = g :=
 eq_of_eq_on_top $ hs ▸ eq_on_closure h
 
+end eq_locus
+
 @[to_additive]
-lemma gclosure_preimage_le (f : G →* N) (s : set N) :
+lemma closure_preimage_le (f : G →* N) (s : set N) :
   closure (f ⁻¹' s) ≤ (closure s).comap f :=
 (closure_le _).2 $ λ x hx, by rw [set_like.mem_coe, mem_comap]; exact subset_closure hx
 
@@ -2202,33 +2056,7 @@ the `add_subgroup` generated by the image of the set."]
 lemma map_closure (f : G →* N) (s : set G) :
   (closure s).map f = closure (f '' s) :=
 set.image_preimage.l_comm_of_u_comm
-  (gc_map_comap f) (subgroup.gi N).gc (subgroup.gi G).gc (λ t, rfl)
-
--- this instance can't go just after the definition of `mrange` because `fintype` is
--- not imported at that stage
-
-/-- The range of a finite monoid under a monoid homomorphism is finite.
-Note: this instance can form a diamond with `subtype.fintype` in the
-presence of `fintype N`. -/
-@[to_additive "The range of a finite additive monoid under an additive monoid homomorphism is
-finite.
-
-Note: this instance can form a diamond with `subtype.fintype` or `subgroup.fintype` in the
-presence of `fintype N`."]
-instance fintype_mrange {M N : Type*} [monoid M] [monoid N] [fintype M] [decidable_eq N]
-  (f : M →* N) : fintype (mrange f) :=
-set.fintype_range f
-
-/-- The range of a finite group under a group homomorphism is finite.
-
-Note: this instance can form a diamond with `subtype.fintype` or `subgroup.fintype` in the
-presence of `fintype N`. -/
-@[to_additive "The range of a finite additive group under an additive group homomorphism is finite.
-
-Note: this instance can form a diamond with `subtype.fintype` or `subgroup.fintype` in the
-presence of `fintype N`."]
-instance fintype_range  [fintype G] [decidable_eq N] (f : G →* N) : fintype (range f) :=
-set.fintype_range f
+  (subgroup.gc_map_comap f) (subgroup.gi N).gc (subgroup.gi G).gc (λ t, rfl)
 
 end monoid_hom
 
@@ -2236,16 +2064,18 @@ namespace subgroup
 
 variables {N : Type*} [group N] (H : subgroup G)
 
-@[to_additive] lemma map_eq_bot_iff {f : G →* N} : H.map f = ⊥ ↔ H ≤ f.ker :=
+@[to_additive]
+lemma normal.map {H : subgroup G} (h : H.normal) (f : G →* N) (hf : function.surjective f) :
+  (H.map f).normal :=
 begin
-  rw eq_bot_iff,
-  split,
-  { exact λ h x hx, h ⟨x, hx, rfl⟩ },
-  { intros h x hx,
-    obtain ⟨y, hy, rfl⟩ := hx,
-    exact h hy },
+  rw [← normalizer_eq_top, ← top_le_iff, ← f.range_top_of_surjective hf, f.range_eq_map,
+    ← normalizer_eq_top.2 h],
+  exact le_normalizer_map _
 end
 
+@[to_additive] lemma map_eq_bot_iff {f : G →* N} : H.map f = ⊥ ↔ H ≤ f.ker :=
+(gc_map_comap f).l_eq_bot
+
 @[to_additive]
 lemma map_eq_bot_iff_of_injective {f : G →* N} (hf : function.injective f) : H.map f = ⊥ ↔ H = ⊥ :=
 by rw [map_eq_bot_iff, f.ker_eq_bot_iff.mpr hf, le_bot_iff]
@@ -2281,10 +2111,8 @@ lemma le_comap_map (H : subgroup G) : H ≤ comap f (map f H) :=
 @[to_additive]
 lemma map_comap_eq (H : subgroup N) :
   map f (comap f H) = f.range ⊓ H :=
-set_like.ext' begin
-  convert set.image_preimage_eq_inter_range,
-  simp [set.inter_comm],
-end
+set_like.ext' $ by rw [coe_map, coe_comap, set.image_preimage_eq_inter_range, coe_inf, coe_range,
+  set.inter_comm]
 
 @[to_additive]
 lemma comap_map_eq (H : subgroup G) : comap f (map f H) = H ⊔ f.ker :=
@@ -2306,9 +2134,24 @@ lemma map_comap_eq_self_of_surjective {f : G →* N} (h : function.surjective f)
   map f (comap f H) = H :=
 map_comap_eq_self ((range_top_of_surjective _ h).symm ▸ le_top)
 
+@[to_additive]
+lemma comap_le_comap_of_le_range {f : G →* N} {K L : subgroup N} (hf : K ≤ f.range) :
+  K.comap f ≤ L.comap f ↔ K ≤ L :=
+⟨(map_comap_eq_self hf).ge.trans ∘ map_le_iff_le_comap.mpr, comap_mono⟩
+
+@[to_additive]
+lemma comap_le_comap_of_surjective {f : G →* N} {K L : subgroup N} (hf : function.surjective f) :
+  K.comap f ≤ L.comap f ↔ K ≤ L :=
+comap_le_comap_of_le_range (le_top.trans (f.range_top_of_surjective hf).ge)
+
+@[to_additive]
+lemma comap_lt_comap_of_surjective {f : G →* N} {K L : subgroup N} (hf : function.surjective f) :
+  K.comap f < L.comap f ↔ K < L :=
+by simp_rw [lt_iff_le_not_le, comap_le_comap_of_surjective hf]
+
 @[to_additive]
 lemma comap_injective {f : G →* N} (h : function.surjective f) : function.injective (comap f) :=
-λ K L hKL, by { apply_fun map f at hKL, simpa [map_comap_eq_self_of_surjective h] using hKL }
+λ K L, by simp only [le_antisymm_iff, comap_le_comap_of_surjective h, imp_self]
 
 @[to_additive]
 lemma comap_map_eq_self {f : G →* N} {H : subgroup G} (h : f.ker ≤ H) :
@@ -2320,11 +2163,26 @@ lemma comap_map_eq_self_of_injective {f : G →* N} (h : function.injective f) (
   comap f (map f H) = H :=
 comap_map_eq_self (((ker_eq_bot_iff _).mpr h).symm ▸ bot_le)
 
+@[to_additive]
+lemma map_le_map_iff {f : G →* N} {H K : subgroup G} : H.map f ≤ K.map f ↔ H ≤ K ⊔ f.ker :=
+by rw [map_le_iff_le_comap, comap_map_eq]
+
+@[to_additive] lemma map_le_map_iff' {f : G →* N} {H K : subgroup G} :
+  H.map f ≤ K.map f ↔ H ⊔ f.ker ≤ K ⊔ f.ker :=
+by simp only [map_le_map_iff, sup_le_iff, le_sup_right, and_true]
+
+@[to_additive] lemma map_eq_map_iff {f : G →* N} {H K : subgroup G} :
+  H.map f = K.map f ↔ H ⊔ f.ker = K ⊔ f.ker :=
+by simp only [le_antisymm_iff, map_le_map_iff']
+
+@[to_additive] lemma map_eq_range_iff {f : G →* N} {H : subgroup G} :
+  H.map f = f.range ↔ codisjoint H f.ker :=
+by rw [f.range_eq_map, map_eq_map_iff, codisjoint_iff, top_sup_eq]
+
 @[to_additive]
 lemma map_le_map_iff_of_injective {f : G →* N} (hf : function.injective f) {H K : subgroup G} :
   H.map f ≤ K.map f ↔ H ≤ K :=
-⟨(congr_arg2 (≤) (H.comap_map_eq_self_of_injective hf)
-  (K.comap_map_eq_self_of_injective hf)).mp ∘ comap_mono, map_mono⟩
+by rw [map_le_iff_le_comap, comap_map_eq_self_of_injective hf]
 
 @[simp, to_additive]
 lemma map_subtype_le_map_subtype {G' : subgroup G} {H K : subgroup G'} :
@@ -2333,15 +2191,16 @@ map_le_map_iff_of_injective subtype.coe_injective
 
 @[to_additive]
 lemma map_injective {f : G →* N} (h : function.injective f) : function.injective (map f) :=
-λ K L hKL, by { apply_fun comap f at hKL, simpa [comap_map_eq_self_of_injective h] using hKL }
+function.left_inverse.injective $ comap_map_eq_self_of_injective h
 
 @[to_additive]
 lemma map_eq_comap_of_inverse {f : G →* N} {g : N →* G} (hl : function.left_inverse g f)
   (hr : function.right_inverse g f) (H : subgroup G) : map f H = comap g H :=
 set_like.ext' $ by rw [coe_map, coe_comap, set.image_eq_preimage_of_inverse hl hr]
 
-/-- Given `f(A) = f(B)`, `ker f ≤ A`, and `ker f ≤ B`, deduce that `A = B`  -/
-@[to_additive] lemma map_injective_of_ker_le
+/-- Given `f(A) = f(B)`, `ker f ≤ A`, and `ker f ≤ B`, deduce that `A = B`. -/
+@[to_additive "Given `f(A) = f(B)`, `ker f ≤ A`, and `ker f ≤ B`, deduce that `A = B`."]
+lemma map_injective_of_ker_le
   {H K : subgroup G} (hH : f.ker ≤ H) (hK : f.ker ≤ K) (hf : map f H = map f K) :
   H = K :=
 begin
@@ -2349,6 +2208,16 @@ begin
   rwa [comap_map_eq, comap_map_eq, sup_of_le_left hH, sup_of_le_left hK] at hf,
 end
 
+@[to_additive] lemma closure_preimage_eq_top (s : set G) :
+  closure ((closure s).subtype ⁻¹' s) = ⊤ :=
+begin
+  apply map_injective (closure s).subtype_injective,
+  rwa [monoid_hom.map_closure, ←monoid_hom.range_eq_map, subtype_range,
+    set.image_preimage_eq_of_subset],
+  rw [coe_subtype, subtype.range_coe_subtype],
+  exact subset_closure,
+end
+
 @[to_additive] lemma comap_sup_eq_of_le_range
   {H K : subgroup N} (hH : H ≤ f.range) (hK : K ≤ f.range) :
   comap f H ⊔ comap f K = comap f (H ⊔ K) :=
@@ -2363,11 +2232,16 @@ comap_sup_eq_of_le_range f (le_top.trans (ge_of_eq (f.range_top_of_surjective hf
 
 @[to_additive] lemma sup_subgroup_of_eq {H K L : subgroup G} (hH : H ≤ L) (hK : K ≤ L) :
   H.subgroup_of L ⊔ K.subgroup_of L = (H ⊔ K).subgroup_of L :=
-comap_sup_eq_of_le_range L.subtype (hH.trans (ge_of_eq L.subtype_range))
-  (hK.trans (ge_of_eq L.subtype_range))
+comap_sup_eq_of_le_range L.subtype (hH.trans L.subtype_range.ge) (hK.trans L.subtype_range.ge)
+
+@[to_additive] lemma codisjoint_subgroup_of_sup (H K : subgroup G) :
+  codisjoint (H.subgroup_of (H ⊔ K)) (K.subgroup_of (H ⊔ K)) :=
+by { rw [codisjoint_iff, sup_subgroup_of_eq, subgroup_of_self], exacts [le_sup_left, le_sup_right] }
 
-/-- A subgroup is isomorphic to its image under an injective function -/
-@[to_additive  "An additive subgroup is isomorphic to its image under an injective function"]
+/-- A subgroup is isomorphic to its image under an injective function. If you have an isomorphism,
+use `mul_equiv.subgroup_map` for better definitional equalities. -/
+@[to_additive  "An additive subgroup is isomorphic to its image under an injective function. If you
+have an isomorphism, use `add_equiv.add_subgroup_map` for better definitional equalities."]
 noncomputable def equiv_map_of_injective (H : subgroup G)
   (f : G →* N) (hf : function.injective f) : H ≃* H.map f :=
 { map_mul' := λ _ _, subtype.ext (f.map_mul _ _), ..equiv.set.image f H hf }
@@ -2407,8 +2281,8 @@ begin
 end
 
 @[to_additive]
-lemma comap_subtype_normalizer_eq {H N : subgroup G} (h : H.normalizer ≤ N) :
-  comap N.subtype H.normalizer = (comap N.subtype H).normalizer :=
+lemma subgroup_of_normalizer_eq {H N : subgroup G} (h : H.normalizer ≤ N) :
+  H.normalizer.subgroup_of N = (H.subgroup_of N).normalizer :=
 begin
   apply comap_normalizer_eq_of_injective_of_le_range,
   exact subtype.coe_injective,
@@ -2561,122 +2435,19 @@ lemma subgroup.normal.comap {H : subgroup N} (hH : H.normal) (f : G →* N) :
 instance subgroup.normal_comap {H : subgroup N}
   [nH : H.normal] (f : G →* N) :  (H.comap f).normal := nH.comap _
 
-@[priority 100, to_additive]
-instance monoid_hom.normal_ker (f : G →* N) : f.ker.normal :=
-by { rw [←f.comap_bot], apply_instance }
+-- Here `H.normal` is an explicit argument so we can use dot notation with `subgroup_of`.
+@[to_additive]
+lemma subgroup.normal.subgroup_of {H : subgroup G} (hH : H.normal) (K : subgroup G) :
+  (H.subgroup_of K).normal :=
+hH.comap _
 
 @[priority 100, to_additive]
-instance subgroup.normal_inf (H N : subgroup G) [hN : N.normal] :
-  ((H ⊓ N).comap H.subtype).normal :=
-⟨λ x hx g, begin
-  simp only [subgroup.mem_inf, coe_subtype, subgroup.mem_comap] at hx,
-  simp only [subgroup.coe_mul, subgroup.mem_inf, coe_subtype, subgroup.coe_inv, subgroup.mem_comap],
-  exact ⟨H.mul_mem (H.mul_mem g.2 hx.1) (H.inv_mem g.2), hN.1 x hx.2 g⟩,
-end⟩
-
-namespace subgroup
-
-/-- The subgroup generated by an element. -/
-def zpowers (g : G) : subgroup G :=
-subgroup.copy (zpowers_hom G g).range (set.range ((^) g : ℤ → G)) rfl
-
-@[simp] lemma mem_zpowers (g : G) : g ∈ zpowers g := ⟨1, zpow_one _⟩
-
-lemma zpowers_eq_closure (g : G) : zpowers g = closure {g} :=
-by { ext, exact mem_closure_singleton.symm }
-
-@[simp] lemma range_zpowers_hom (g : G) : (zpowers_hom G g).range = zpowers g := rfl
-
-lemma zpowers_subset {a : G} {K : subgroup G} (h : a ∈ K) : zpowers a ≤ K :=
-λ x hx, match x, hx with _, ⟨i, rfl⟩ := K.zpow_mem h i end
-
-lemma mem_zpowers_iff {g h : G} :
-  h ∈ zpowers g ↔ ∃ (k : ℤ), g ^ k = h :=
-iff.rfl
-
-@[simp] lemma forall_zpowers {x : G} {p : zpowers x → Prop} :
-  (∀ g, p g) ↔ ∀ m : ℤ, p ⟨x ^ m, m, rfl⟩ :=
-set.forall_subtype_range_iff
-
-@[simp] lemma exists_zpowers {x : G} {p : zpowers x → Prop} :
-  (∃ g, p g) ↔ ∃ m : ℤ, p ⟨x ^ m, m, rfl⟩ :=
-set.exists_subtype_range_iff
-
-lemma forall_mem_zpowers {x : G} {p : G → Prop} :
-  (∀ g ∈ zpowers x, p g) ↔ ∀ m : ℤ, p (x ^ m) :=
-set.forall_range_iff
-
-lemma exists_mem_zpowers {x : G} {p : G → Prop} :
-  (∃ g ∈ zpowers x, p g) ↔ ∃ m : ℤ, p (x ^ m) :=
-set.exists_range_iff
-
-end subgroup
-
-namespace add_subgroup
-
-/-- The subgroup generated by an element. -/
-def zmultiples (a : A) : add_subgroup A :=
-add_subgroup.copy (zmultiples_hom A a).range (set.range ((• a) : ℤ → A)) rfl
+instance subgroup.normal_subgroup_of {H N : subgroup G} [N.normal] : (N.subgroup_of H).normal :=
+subgroup.normal_comap _
 
-@[simp] lemma range_zmultiples_hom (a : A) : (zmultiples_hom A a).range = zmultiples a := rfl
-
-attribute [to_additive add_subgroup.zmultiples] subgroup.zpowers
-attribute [to_additive add_subgroup.mem_zmultiples] subgroup.mem_zpowers
-attribute [to_additive add_subgroup.zmultiples_eq_closure] subgroup.zpowers_eq_closure
-attribute [to_additive add_subgroup.range_zmultiples_hom] subgroup.range_zpowers_hom
-attribute [to_additive add_subgroup.zmultiples_subset] subgroup.zpowers_subset
-attribute [to_additive add_subgroup.mem_zmultiples_iff] subgroup.mem_zpowers_iff
-attribute [to_additive add_subgroup.forall_zmultiples] subgroup.forall_zpowers
-attribute [to_additive add_subgroup.forall_mem_zmultiples] subgroup.forall_mem_zpowers
-attribute [to_additive add_subgroup.exists_zmultiples] subgroup.exists_zpowers
-attribute [to_additive add_subgroup.exists_mem_zmultiples] subgroup.exists_mem_zpowers
-
-end add_subgroup
-
-lemma int.mem_zmultiples_iff {a b : ℤ} :
-  b ∈ add_subgroup.zmultiples a ↔ a ∣ b :=
-exists_congr (λ k, by rw [mul_comm, eq_comm, ← smul_eq_mul])
-
-lemma of_mul_image_zpowers_eq_zmultiples_of_mul { x : G } :
-  additive.of_mul '' ((subgroup.zpowers x) : set G) = add_subgroup.zmultiples (additive.of_mul x) :=
-begin
-  ext y,
-  split,
-  { rintro ⟨z, ⟨m, hm⟩, hz2⟩,
-    use m,
-    simp only,
-    rwa [← of_mul_zpow, hm] },
-  { rintros ⟨n, hn⟩,
-    refine ⟨x ^ n, ⟨n, rfl⟩, _⟩,
-    rwa of_mul_zpow }
-end
-
-lemma of_add_image_zmultiples_eq_zpowers_of_add {x : A} :
-  multiplicative.of_add '' ((add_subgroup.zmultiples x) : set A) =
-  subgroup.zpowers (multiplicative.of_add x) :=
-begin
-  symmetry,
-  rw equiv.eq_image_iff_symm_image_eq,
-  exact of_mul_image_zpowers_eq_zmultiples_of_mul,
-end
-
-namespace subgroup
-
-@[to_additive zmultiples_is_commutative]
-instance zpowers_is_commutative (g : G) : (zpowers g).is_commutative :=
-⟨⟨λ ⟨_, _, h₁⟩ ⟨_, _, h₂⟩, by rw [subtype.ext_iff, coe_mul, coe_mul,
-  subtype.coe_mk, subtype.coe_mk, ←h₁, ←h₂, zpow_mul_comm]⟩⟩
-
-@[simp, to_additive zmultiples_le, simp]
-lemma zpowers_le {g : G} {H : subgroup G} : zpowers g ≤ H ↔ g ∈ H :=
-by rw [zpowers_eq_closure, closure_le, set.singleton_subset_iff, set_like.mem_coe]
-
-end subgroup
 
 namespace monoid_hom
 
-variables {G' : Type*} [group G']
-
 /-- The `monoid_hom` from the preimage of a subgroup to itself. -/
 @[to_additive "the `add_monoid_hom` from the preimage of an additive subgroup to itself.", simps]
 def subgroup_comap (f : G →* G') (H' : subgroup G') : H'.comap f →* H' :=
@@ -2695,7 +2466,6 @@ f.submonoid_map_surjective H.to_submonoid
 end monoid_hom
 
 namespace mul_equiv
-
 variables {H K : subgroup G}
 
 /-- Makes the identity isomorphism from a proof two subgroups of a multiplicative
@@ -2705,20 +2475,30 @@ two subgroups of an additive group are equal."]
 def subgroup_congr (h : H = K) : H ≃* K :=
 { map_mul' :=  λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }
 
-/-- A `mul_equiv` `φ` between two groups `G` and `G'` induces a `mul_equiv` between
-a subgroup `H ≤ G` and the subgroup `φ(H) ≤ G'`. -/
-@[to_additive "An `add_equiv` `φ` between two additive groups `G` and `G'` induces an `add_equiv`
-between a subgroup `H ≤ G` and the subgroup `φ(H) ≤ G'`. "]
-def subgroup_map {G'} [group G'] (e : G ≃* G') (H : subgroup G) :
-  H ≃* H.map e.to_monoid_hom :=
-e.submonoid_map H.to_submonoid
+/-- A subgroup is isomorphic to its image under an isomorphism. If you only have an injective map,
+use `subgroup.equiv_map_of_injective`. -/
+@[to_additive  "An additive subgroup is isomorphic to its image under an an isomorphism. If you only
+have an injective map, use `add_subgroup.equiv_map_of_injective`."]
+def subgroup_map (e : G ≃* G') (H : subgroup G) : H ≃* H.map (e : G →* G') :=
+mul_equiv.submonoid_map (e : G ≃* G') H.to_submonoid
 
-end mul_equiv
+@[simp, to_additive]
+lemma coe_subgroup_map_apply (e : G ≃* G') (H : subgroup G) (g : H) :
+  ((subgroup_map e H g : H.map (e : G →* G')) : G') = e g := rfl
 
--- TODO : ↥(⊤ : subgroup H) ≃* H ?
+@[simp, to_additive]
+lemma subgroup_map_symm_apply (e : G ≃* G') (H : subgroup G) (g : H.map (e : G →* G')) :
+  (e.subgroup_map H).symm g = ⟨e.symm g, set_like.mem_coe.1 $ set.mem_image_equiv.1 g.2⟩ := rfl
+
+end mul_equiv
 
 namespace subgroup
 
+@[simp, to_additive]
+lemma equiv_map_of_injective_coe_mul_equiv (H : subgroup G) (e : G ≃* G') :
+  H.equiv_map_of_injective (e : G →* G') (equiv_like.injective e) = e.subgroup_map H :=
+by { ext, refl }
+
 variables {C : Type*} [comm_group C] {s t : subgroup C} {x : C}
 
 @[to_additive]
@@ -2753,149 +2533,13 @@ instance : is_modular_lattice (subgroup C) :=
   rw [mem_inf, mem_sup] at ha,
   rcases ha with ⟨⟨b, hb, c, hc, rfl⟩, haz⟩,
   rw mem_sup,
-  refine ⟨b, hb, c, mem_inf.2 ⟨hc, _⟩, rfl⟩,
-  rw ← inv_mul_cancel_left b c,
-  apply z.mul_mem (z.inv_mem (xz hb)) haz,
+  exact ⟨b, hb, c, mem_inf.2 ⟨hc, (mul_mem_cancel_left (xz hb)).1 haz⟩, rfl⟩
 end⟩
 
 end subgroup
 
-section
-variables (G) (A)
-
-/-- A `group` is simple when it has exactly two normal `subgroup`s. -/
-class is_simple_group extends nontrivial G : Prop :=
-(eq_bot_or_eq_top_of_normal : ∀ H : subgroup G, H.normal → H = ⊥ ∨ H = ⊤)
-
-/-- An `add_group` is simple when it has exactly two normal `add_subgroup`s. -/
-class is_simple_add_group extends nontrivial A : Prop :=
-(eq_bot_or_eq_top_of_normal : ∀ H : add_subgroup A, H.normal → H = ⊥ ∨ H = ⊤)
-
-attribute [to_additive] is_simple_group
-
-variables {G} {A}
-
-@[to_additive]
-lemma subgroup.normal.eq_bot_or_eq_top [is_simple_group G] {H : subgroup G} (Hn : H.normal) :
-  H = ⊥ ∨ H = ⊤ :=
-is_simple_group.eq_bot_or_eq_top_of_normal H Hn
-
-namespace is_simple_group
-
-@[to_additive]
-instance {C : Type*} [comm_group C] [is_simple_group C] :
-  is_simple_order (subgroup C) :=
-⟨λ H, H.normal_of_comm.eq_bot_or_eq_top⟩
-
-open _root_.subgroup
-
-@[to_additive]
-lemma is_simple_group_of_surjective {H : Type*} [group H] [is_simple_group G]
-  [nontrivial H] (f : G →* H) (hf : function.surjective f) :
-  is_simple_group H :=
-⟨nontrivial.exists_pair_ne, λ H iH, begin
-  refine ((iH.comap f).eq_bot_or_eq_top).imp (λ h, _) (λ h, _),
-  { rw [←map_bot f, ←h, map_comap_eq_self_of_surjective hf] },
-  { rw [←comap_top f] at h, exact comap_injective hf h }
-end⟩
-
-end is_simple_group
-
-end
-
 namespace subgroup
 
-section pointwise
-
-@[to_additive]
-lemma closure_mul_le (S T : set G) : closure (S * T) ≤ closure S ⊔ closure T :=
-Inf_le $ λ x ⟨s, t, hs, ht, hx⟩, hx ▸ (closure S ⊔ closure T).mul_mem
-    (set_like.le_def.mp le_sup_left $ subset_closure hs)
-    (set_like.le_def.mp le_sup_right $ subset_closure ht)
-
-@[to_additive]
-lemma sup_eq_closure (H K : subgroup G) : H ⊔ K = closure (H * K) :=
-le_antisymm
-  (sup_le
-    (λ h hh, subset_closure ⟨h, 1, hh, K.one_mem, mul_one h⟩)
-    (λ k hk, subset_closure ⟨1, k, H.one_mem, hk, one_mul k⟩))
-  (by conv_rhs { rw [← closure_eq H, ← closure_eq K] }; apply closure_mul_le)
-
-@[to_additive]
-private def mul_normal_aux (H N : subgroup G) [hN : N.normal] : subgroup G :=
-{ carrier := (H : set G) * N,
-  one_mem' := ⟨1, 1, H.one_mem, N.one_mem, by rw mul_one⟩,
-  mul_mem' := λ a b ⟨h, n, hh, hn, ha⟩ ⟨h', n', hh', hn', hb⟩,
-    ⟨h * h', h'⁻¹ * n * h' * n',
-    H.mul_mem hh hh', N.mul_mem (by simpa using hN.conj_mem _ hn h'⁻¹) hn',
-    by simp [← ha, ← hb, mul_assoc]⟩,
-  inv_mem' := λ x ⟨h, n, hh, hn, hx⟩,
-    ⟨h⁻¹, h * n⁻¹ * h⁻¹, H.inv_mem hh, hN.conj_mem _ (N.inv_mem hn) h,
-    by rw [mul_assoc h, inv_mul_cancel_left, ← hx, mul_inv_rev]⟩ }
-
-/-- The carrier of `H ⊔ N` is just `↑H * ↑N` (pointwise set product) when `N` is normal. -/
-@[to_additive "The carrier of `H ⊔ N` is just `↑H + ↑N` (pointwise set addition)
-when `N` is normal."]
-lemma mul_normal (H N : subgroup G) [N.normal] : (↑(H ⊔ N) : set G) = H * N :=
-set.subset.antisymm
-  (show H ⊔ N ≤ mul_normal_aux H N,
-    by { rw sup_eq_closure, apply Inf_le _, dsimp, refl })
-  ((sup_eq_closure H N).symm ▸ subset_closure)
-
-@[to_additive]
-private def normal_mul_aux (N H : subgroup G) [hN : N.normal] : subgroup G :=
-{ carrier := (N : set G) * H,
-  one_mem' := ⟨1, 1, N.one_mem, H.one_mem, by rw mul_one⟩,
-  mul_mem' := λ a b ⟨n, h, hn, hh, ha⟩ ⟨n', h', hn', hh', hb⟩,
-    ⟨n * (h * n' * h⁻¹), h * h',
-    N.mul_mem hn (hN.conj_mem _ hn' _), H.mul_mem hh hh',
-    by simp [← ha, ← hb, mul_assoc]⟩,
-  inv_mem' := λ x ⟨n, h, hn, hh, hx⟩,
-    ⟨h⁻¹ * n⁻¹ * h, h⁻¹,
-    by simpa using hN.conj_mem _ (N.inv_mem hn) h⁻¹, H.inv_mem hh,
-    by rw [mul_inv_cancel_right, ← mul_inv_rev, hx]⟩ }
-
-/-- The carrier of `N ⊔ H` is just `↑N * ↑H` (pointwise set product) when `N` is normal. -/
-@[to_additive "The carrier of `N ⊔ H` is just `↑N + ↑H` (pointwise set addition)
-when `N` is normal."]
-lemma normal_mul (N H : subgroup G) [N.normal] : (↑(N ⊔ H) : set G) = N * H :=
-set.subset.antisymm
-  (show N ⊔ H ≤ normal_mul_aux N H,
-    by { rw sup_eq_closure, apply Inf_le _, dsimp, refl })
-  ((sup_eq_closure N H).symm ▸ subset_closure)
-
-@[to_additive] lemma mul_inf_assoc (A B C : subgroup G) (h : A ≤ C) :
-  (A : set G) * ↑(B ⊓ C) = (A * B) ⊓ C :=
-begin
-  ext,
-  simp only [coe_inf, set.inf_eq_inter, set.mem_mul, set.mem_inter_iff],
-  split,
-  { rintros ⟨y, z, hy, ⟨hzB, hzC⟩, rfl⟩,
-    refine ⟨_, mul_mem (h hy) hzC⟩,
-    exact ⟨y, z, hy, hzB, rfl⟩ },
-  rintros ⟨⟨y, z, hy, hz, rfl⟩, hyz⟩,
-  refine ⟨y, z, hy, ⟨hz, _⟩, rfl⟩,
-  suffices : y⁻¹ * (y * z) ∈ C, { simpa },
-  exact mul_mem (inv_mem (h hy)) hyz
-end
-
-@[to_additive] lemma inf_mul_assoc (A B C : subgroup G) (h : C ≤ A) :
-  ((A ⊓ B : subgroup G) : set G) * C = A ⊓ (B * C) :=
-begin
-  ext,
-  simp only [coe_inf, set.inf_eq_inter, set.mem_mul, set.mem_inter_iff],
-  split,
-  { rintros ⟨y, z, ⟨hyA, hyB⟩, hz, rfl⟩,
-    refine ⟨A.mul_mem hyA (h hz), _⟩,
-    exact ⟨y, z, hyB, hz, rfl⟩ },
-  rintros ⟨hyz, y, z, hy, hz, rfl⟩,
-  refine ⟨y, z, ⟨_, hy⟩, hz, rfl⟩,
-  suffices : (y * z) * z⁻¹ ∈ A, { simpa },
-  exact mul_mem hyz (inv_mem (h hz))
-end
-
-end pointwise
-
 section subgroup_normal
 
 @[to_additive] lemma normal_subgroup_of_iff {H K : subgroup G} (hHK : H ≤ K) :
@@ -2934,21 +2578,9 @@ section subgroup_normal
     ⟨(normal_subgroup_of_iff hA).mp hN n g hn.1  (mem_inf.mp g.2).1,
     mul_mem (mul_mem (mem_inf.1 g.2).2 (mem_inf.1 n.2).2) (inv_mem (mem_inf.1 g.2).2)⟩ }
 
-instance sup_normal (H K : subgroup G) [hH : H.normal] [hK : K.normal] : (H ⊔ K).normal :=
-{ conj_mem := λ n hmem g,
-  begin
-    change n ∈ ↑(H ⊔ K) at hmem,
-    change g * n * g⁻¹ ∈ ↑(H ⊔ K),
-    rw [normal_mul, set.mem_mul] at *,
-    rcases hmem with ⟨h, k, hh, hk, rfl⟩,
-    refine ⟨g * h * g⁻¹, g * k * g⁻¹, hH.conj_mem h hh g, hK.conj_mem k hk g, _⟩,
-    simp
-  end }
-
 @[to_additive] instance normal_inf_normal (H K : subgroup G) [hH : H.normal] [hK : K.normal] :
   (H ⊓ K).normal :=
-{ conj_mem := λ n hmem g,
-  by { rw mem_inf at *, exact ⟨hH.conj_mem n hmem.1 g, hK.conj_mem n hmem.2 g⟩ } }
+⟨λ n hmem g, ⟨hH.conj_mem n hmem.1 g, hK.conj_mem n hmem.2 g⟩⟩
 
 @[to_additive] lemma subgroup_of_sup (A A' B : subgroup G) (hA : A ≤ B) (hA' : A' ≤ B) :
   (A ⊔ A').subgroup_of B = A.subgroup_of B ⊔ A'.subgroup_of B :=
@@ -2967,15 +2599,15 @@ begin
   rwa [mul_assoc, mul_assoc, mul_right_inv, mul_one] at this,
 end
 
-/-- Elements of disjoint, normal subgroups commute -/
-@[to_additive] lemma commute_of_normal_of_disjoint
+/-- Elements of disjoint, normal subgroups commute. -/
+@[to_additive "Elements of disjoint, normal subgroups commute."] lemma commute_of_normal_of_disjoint
   (H₁ H₂ : subgroup G) (hH₁ : H₁.normal) (hH₂ : H₂.normal) (hdis : disjoint H₁ H₂)
   (x y : G) (hx : x ∈ H₁) (hy : y ∈ H₂) :
   commute x y :=
 begin
   suffices : x * y * x⁻¹ * y⁻¹ = 1,
   { show x * y = y * x, by { rw [mul_assoc, mul_eq_one_iff_eq_inv] at this, simpa } },
-  apply hdis, split,
+  apply hdis.le_bot, split,
   { suffices : x * (y * x⁻¹ * y⁻¹) ∈ H₁, by simpa [mul_assoc],
     exact H₁.mul_mem hx (hH₁.conj_mem _ (H₁.inv_mem hx) _) },
   { show x * y * x⁻¹ * y⁻¹ ∈ H₂,
@@ -2988,13 +2620,12 @@ end subgroup_normal
 @[to_additive]
 lemma disjoint_def {H₁ H₂ : subgroup G} :
   disjoint H₁ H₂ ↔ ∀ {x : G}, x ∈ H₁ → x ∈ H₂ → x = 1 :=
-show (∀ x, x ∈ H₁ ∧ x ∈ H₂ → x ∈ ({1} : set G)) ↔ _, by simp
+disjoint_iff_inf_le.trans $ by simp only [disjoint, set_like.le_def, mem_inf, mem_bot, and_imp]
 
 @[to_additive]
 lemma disjoint_def' {H₁ H₂ : subgroup G} :
   disjoint H₁ H₂ ↔ ∀ {x y : G}, x ∈ H₁ → y ∈ H₂ → x = y → x = 1 :=
-disjoint_def.trans ⟨λ h x y hx hy hxy, h hx $ hxy.symm ▸ hy,
-  λ h x hx hx', h hx hx' rfl⟩
+disjoint_def.trans ⟨λ h x y hx hy hxy, h hx $ hxy.symm ▸ hy, λ h x hx hx', h hx hx' rfl⟩
 
 @[to_additive]
 lemma disjoint_iff_mul_eq_one {H₁ H₂ : subgroup G} :
@@ -3002,39 +2633,17 @@ lemma disjoint_iff_mul_eq_one {H₁ H₂ : subgroup G} :
 disjoint_def'.trans ⟨λ h x y hx hy hxy,
   let hx1 : x = 1 := h hx (H₂.inv_mem hy) (eq_inv_iff_mul_eq_one.mpr hxy) in
   ⟨hx1, by simpa [hx1] using hxy⟩,
-  λ h x y hx hy hxy, (h hx (H₂.inv_mem hy) (mul_inv_eq_one.mpr hxy)).1 ⟩
-
-/-- `finset.noncomm_prod` is “injective” in `f` if `f` maps into independent subgroups.  This
-generalizes (one direction of) `subgroup.disjoint_iff_mul_eq_one`. -/
-@[to_additive "`finset.noncomm_sum` is “injective” in `f` if `f` maps into independent subgroups.
-This generalizes (one direction of) `add_subgroup.disjoint_iff_add_eq_zero`. "]
-lemma eq_one_of_noncomm_prod_eq_one_of_independent {ι : Type*}
-  (s : finset ι) (f : ι → G) (comm : ∀ (x ∈ s) (y ∈ s), commute (f x) (f y))
-  (K : ι → subgroup G) (hind : complete_lattice.independent K) (hmem : ∀ (x ∈ s), f x ∈ K x)
-  (heq1 : s.noncomm_prod f comm = 1) : ∀ (i ∈ s), f i = 1 :=
+  λ h x y hx hy hxy, (h hx (H₂.inv_mem hy) (mul_inv_eq_one.mpr hxy)).1⟩
+
+@[to_additive]
+lemma mul_injective_of_disjoint {H₁ H₂ : subgroup G} (h : disjoint H₁ H₂) :
+  function.injective (λ g, g.1 * g.2 : H₁ × H₂ → G) :=
 begin
-  classical,
-  revert heq1,
-  induction s using finset.induction_on with i s hnmem ih,
-  { simp, },
-  { simp only [finset.forall_mem_insert] at comm hmem,
-    specialize ih (λ x hx, (comm.2 x hx).2) hmem.2,
-    have hmem_bsupr: s.noncomm_prod f (λ x hx, (comm.2 x hx).2) ∈ ⨆ (i ∈ (s : set ι)), K i,
-    { refine subgroup.noncomm_prod_mem _ _ _,
-      intros x hx,
-      have : K x ≤ ⨆ (i ∈ (s : set ι)), K i := le_supr₂ x hx,
-      exact this (hmem.2 x hx), },
-    intro heq1,
-    rw finset.noncomm_prod_insert_of_not_mem _ _ _ _ hnmem at heq1,
-    have hnmem' : i ∉ (s : set ι), by simpa,
-    obtain ⟨heq1i : f i = 1, heq1S : s.noncomm_prod f _ = 1⟩ :=
-      subgroup.disjoint_iff_mul_eq_one.mp (hind.disjoint_bsupr hnmem') hmem.1 hmem_bsupr heq1,
-    specialize ih heq1S,
-    intros i h,
-    simp only [finset.mem_insert] at h,
-    rcases h with ⟨rfl | _⟩,
-    { exact heq1i },
-    { exact (ih _ h), } }
+  intros x y hxy,
+  rw [←inv_mul_eq_iff_eq_mul, ←mul_assoc, ←mul_inv_eq_one, mul_assoc] at hxy,
+  replace hxy := disjoint_iff_mul_eq_one.mp h (y.1⁻¹ * x.1).prop (x.2 * y.2⁻¹).prop hxy,
+  rwa [coe_mul, coe_mul, coe_inv, coe_inv, inv_mul_eq_one, mul_inv_eq_one,
+    ←subtype.ext_iff, ←subtype.ext_iff, eq_comm, ←prod.ext_iff] at hxy,
 end
 
 end subgroup
@@ -3068,142 +2677,16 @@ begin
   exact subset_normal_closure (set.mem_singleton _),
 end
 
-end is_conj
+variables {M : Type*} [monoid M]
 
-/-! ### Actions by `subgroup`s
-
-These are just copies of the definitions about `submonoid` starting from `submonoid.mul_action`.
--/
-section actions
+lemma eq_of_left_mem_center {g h : M} (H : is_conj g h) (Hg : g ∈ set.center M) :
+  g = h :=
+by { rcases H with ⟨u, hu⟩, rwa [← u.mul_left_inj, ← Hg u], }
 
-namespace subgroup
-
-variables {α β : Type*}
-
-/-- The action by a subgroup is the action by the underlying group. -/
-@[to_additive /-"The additive action by an add_subgroup is the action by the underlying
-add_group. "-/]
-instance [mul_action G α] (S : subgroup G) : mul_action S α :=
-S.to_submonoid.mul_action
-
-@[to_additive]
-lemma smul_def [mul_action G α] {S : subgroup G} (g : S) (m : α) : g • m = (g : G) • m := rfl
-
-@[to_additive]
-instance smul_comm_class_left
-  [mul_action G β] [has_scalar α β] [smul_comm_class G α β] (S : subgroup G) :
-  smul_comm_class S α β :=
-S.to_submonoid.smul_comm_class_left
-
-@[to_additive]
-instance smul_comm_class_right
-  [has_scalar α β] [mul_action G β] [smul_comm_class α G β] (S : subgroup G) :
-  smul_comm_class α S β :=
-S.to_submonoid.smul_comm_class_right
+lemma eq_of_right_mem_center {g h : M} (H : is_conj g h) (Hh : h ∈ set.center M) :
+  g = h :=
+(H.symm.eq_of_left_mem_center Hh).symm
 
-/-- Note that this provides `is_scalar_tower S G G` which is needed by `smul_mul_assoc`. -/
-instance
-  [has_scalar α β] [mul_action G α] [mul_action G β] [is_scalar_tower G α β] (S : subgroup G) :
-  is_scalar_tower S α β :=
-S.to_submonoid.is_scalar_tower
-
-instance [mul_action G α] [has_faithful_scalar G α] (S : subgroup G) :
-  has_faithful_scalar S α :=
-S.to_submonoid.has_faithful_scalar
-
-/-- The action by a subgroup is the action by the underlying group. -/
-instance [add_monoid α] [distrib_mul_action G α] (S : subgroup G) : distrib_mul_action S α :=
-S.to_submonoid.distrib_mul_action
-
-/-- The action by a subgroup is the action by the underlying group. -/
-instance [monoid α] [mul_distrib_mul_action G α] (S : subgroup G) : mul_distrib_mul_action S α :=
-S.to_submonoid.mul_distrib_mul_action
-
-end subgroup
-
-end actions
-
-/-! ### Mul-opposite subgroups -/
-
-section mul_opposite
-
-namespace subgroup
-
-/-- A subgroup `H` of `G` determines a subgroup `H.opposite` of the opposite group `Gᵐᵒᵖ`. -/
-@[to_additive "An additive subgroup `H` of `G` determines an additive subgroup `H.opposite` of the
-  opposite additive group `Gᵃᵒᵖ`."]
-def opposite (H : subgroup G) : subgroup Gᵐᵒᵖ :=
-{ carrier := mul_opposite.unop ⁻¹' (H : set G),
-  one_mem' := H.one_mem,
-  mul_mem' := λ a b ha hb, H.mul_mem hb ha,
-  inv_mem' := λ a, H.inv_mem }
-
-/-- Bijection between a subgroup `H` and its opposite. -/
-@[to_additive "Bijection between an additive subgroup `H` and its opposite.", simps]
-def opposite_equiv (H : subgroup G) : H ≃ H.opposite :=
-mul_opposite.op_equiv.subtype_equiv $ λ _, iff.rfl
-
-@[to_additive] instance (H : subgroup G) [encodable H] : encodable H.opposite :=
-encodable.of_equiv H H.opposite_equiv.symm
-
-@[to_additive] lemma smul_opposite_mul {H : subgroup G} (x g : G) (h : H.opposite) :
-  h • (g * x) = g * (h • x) :=
-begin
-  cases h,
-  simp [(•), mul_assoc],
-end
-
-@[to_additive] lemma smul_opposite_image_mul_preimage {H : subgroup G} (g : G) (h : H.opposite)
-  (s : set G) : (λ y, h • y) '' (has_mul.mul g ⁻¹' s) = has_mul.mul g ⁻¹' ((λ y, h • y) '' s) :=
-by { ext x, cases h, simp [(•), mul_assoc] }
-
-end subgroup
-
-end mul_opposite
-
-/-! ### Saturated subgroups -/
-
-section saturated
-
-namespace subgroup
-
-/-- A subgroup `H` of `G` is *saturated* if for all `n : ℕ` and `g : G` with `g^n ∈ H`
-we have `n = 0` or `g ∈ H`. -/
-@[to_additive "An additive subgroup `H` of `G` is *saturated* if
-for all `n : ℕ` and `g : G` with `n•g ∈ H` we have `n = 0` or `g ∈ H`."]
-def saturated (H : subgroup G) : Prop := ∀ ⦃n g⦄, g ^ n ∈ H → n = 0 ∨ g ∈ H
-
-@[to_additive] lemma saturated_iff_npow {H : subgroup G} :
-  saturated H ↔ (∀ (n : ℕ) (g : G), g ^ n ∈ H → n = 0 ∨ g ∈ H) := iff.rfl
-
-@[to_additive] lemma saturated_iff_zpow {H : subgroup G} :
-  saturated H ↔ (∀ (n : ℤ) (g : G), g ^ n ∈ H → n = 0 ∨ g ∈ H) :=
-begin
-  split,
-  { rintros hH ⟨n⟩ g hgn,
-    { simp only [int.coe_nat_eq_zero, int.of_nat_eq_coe, zpow_coe_nat] at hgn ⊢,
-      exact hH hgn },
-    { suffices : g ^ (n+1) ∈ H,
-      { refine (hH this).imp _ id, simp only [forall_false_left, nat.succ_ne_zero], },
-      simpa only [inv_mem_iff, zpow_neg_succ_of_nat] using hgn, } },
-  { intros h n g hgn,
-    specialize h n g,
-    simp only [int.coe_nat_eq_zero, zpow_coe_nat] at h,
-    apply h hgn }
-end
-
-end subgroup
-
-namespace add_subgroup
-
-lemma ker_saturated {A₁ A₂ : Type*} [add_comm_group A₁] [add_comm_group A₂]
-  [no_zero_smul_divisors ℕ A₂] (f : A₁ →+ A₂) :
-  (f.ker).saturated :=
-begin
-  intros n g hg,
-  simpa only [f.mem_ker, nsmul_eq_smul, f.map_nsmul, smul_eq_zero] using hg
-end
-
-end add_subgroup
+end is_conj
 
-end saturated
+assert_not_exists multiset
diff --git a/src/group_theory/subgroup/finite.lean b/src/group_theory/subgroup/finite.lean
new file mode 100644
index 0000000000000..a5ab6c826172f
--- /dev/null
+++ b/src/group_theory/subgroup/finite.lean
@@ -0,0 +1,241 @@
+/-
+Copyright (c) 2020 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+
+import data.set.finite
+import group_theory.subgroup.basic
+import group_theory.submonoid.membership
+
+/-!
+# Subgroups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides some result on multiplicative and additive subgroups in the finite context.
+
+## Tags
+subgroup, subgroups
+-/
+
+open_locale big_operators
+
+variables {G : Type*} [group G]
+variables {A : Type*} [add_group A]
+
+namespace subgroup
+
+@[to_additive]
+instance (K : subgroup G) [d : decidable_pred (∈ K)] [fintype G] : fintype K :=
+show fintype {g : G // g ∈ K}, from infer_instance
+
+@[to_additive]
+instance (K : subgroup G) [finite G] : finite K :=
+subtype.finite
+
+end subgroup
+
+/-!
+### Conversion to/from `additive`/`multiplicative`
+-/
+namespace subgroup
+
+variables (H K : subgroup G)
+
+/-- Product of a list of elements in a subgroup is in the subgroup. -/
+@[to_additive "Sum of a list of elements in an `add_subgroup` is in the `add_subgroup`."]
+protected lemma list_prod_mem {l : list G} : (∀ x ∈ l, x ∈ K) → l.prod ∈ K :=
+list_prod_mem
+
+/-- Product of a multiset of elements in a subgroup of a `comm_group` is in the subgroup. -/
+@[to_additive "Sum of a multiset of elements in an `add_subgroup` of an `add_comm_group`
+is in the `add_subgroup`."]
+protected lemma multiset_prod_mem {G} [comm_group G] (K : subgroup G) (g : multiset G) :
+  (∀ a ∈ g, a ∈ K) → g.prod ∈ K := multiset_prod_mem g
+
+@[to_additive]
+lemma multiset_noncomm_prod_mem (K : subgroup G) (g : multiset G) (comm) :
+  (∀ a ∈ g, a ∈ K) → g.noncomm_prod comm ∈ K :=
+K.to_submonoid.multiset_noncomm_prod_mem g comm
+
+/-- Product of elements of a subgroup of a `comm_group` indexed by a `finset` is in the
+    subgroup. -/
+@[to_additive "Sum of elements in an `add_subgroup` of an `add_comm_group` indexed by a `finset`
+is in the `add_subgroup`."]
+protected lemma prod_mem {G : Type*} [comm_group G] (K : subgroup G)
+  {ι : Type*} {t : finset ι} {f : ι → G} (h : ∀ c ∈ t, f c ∈ K) :
+  ∏ c in t, f c ∈ K :=
+prod_mem h
+
+@[to_additive]
+lemma noncomm_prod_mem (K : subgroup G) {ι : Type*} {t : finset ι} {f : ι → G} (comm) :
+  (∀ c ∈ t, f c ∈ K) → t.noncomm_prod f comm ∈ K :=
+K.to_submonoid.noncomm_prod_mem t f comm
+
+@[simp, norm_cast, to_additive] theorem coe_list_prod (l : list H) :
+  (l.prod : G) = (l.map coe).prod :=
+submonoid_class.coe_list_prod l
+
+@[simp, norm_cast, to_additive] theorem coe_multiset_prod {G} [comm_group G] (H : subgroup G)
+  (m : multiset H) : (m.prod : G) = (m.map coe).prod :=
+submonoid_class.coe_multiset_prod m
+
+@[simp, norm_cast, to_additive] theorem coe_finset_prod {ι G} [comm_group G] (H : subgroup G)
+  (f : ι → H) (s : finset ι) :
+  ↑(∏ i in s, f i) = (∏ i in s, f i : G) :=
+submonoid_class.coe_finset_prod f s
+
+@[to_additive] instance fintype_bot : fintype (⊥ : subgroup G) := ⟨{1},
+by {rintro ⟨x, ⟨hx⟩⟩, exact finset.mem_singleton_self _}⟩
+
+/- curly brackets `{}` are used here instead of instance brackets `[]` because
+  the instance in a goal is often not the same as the one inferred by type class inference.  -/
+@[simp, to_additive] lemma card_bot {_ : fintype ↥(⊥ : subgroup G)} :
+  fintype.card (⊥ : subgroup G)  = 1 :=
+fintype.card_eq_one_iff.2
+  ⟨⟨(1 : G), set.mem_singleton 1⟩, λ ⟨y, hy⟩, subtype.eq $ subgroup.mem_bot.1 hy⟩
+
+@[to_additive] lemma eq_top_of_card_eq [fintype H] [fintype G]
+  (h : fintype.card H = fintype.card G) : H = ⊤ :=
+begin
+  haveI : fintype (H : set G) := ‹fintype H›,
+  rw [set_like.ext'_iff, coe_top, ← finset.coe_univ, ← (H : set G).coe_to_finset, finset.coe_inj,
+    ← finset.card_eq_iff_eq_univ, ← h, set.to_finset_card],
+  congr
+end
+
+@[to_additive] lemma eq_top_of_le_card [fintype H] [fintype G]
+  (h : fintype.card G ≤ fintype.card H) : H = ⊤ :=
+eq_top_of_card_eq H (le_antisymm (fintype.card_le_of_injective coe subtype.coe_injective) h)
+
+@[to_additive] lemma eq_bot_of_card_le [fintype H] (h : fintype.card H ≤ 1) : H = ⊥ :=
+let _ := fintype.card_le_one_iff_subsingleton.mp h in by exactI eq_bot_of_subsingleton H
+
+@[to_additive] lemma eq_bot_of_card_eq [fintype H] (h : fintype.card H = 1) : H = ⊥ :=
+H.eq_bot_of_card_le (le_of_eq h)
+
+@[to_additive] lemma card_le_one_iff_eq_bot [fintype H] : fintype.card H ≤ 1 ↔ H = ⊥ :=
+⟨λ h, (eq_bot_iff_forall _).2
+    (λ x hx, by simpa [subtype.ext_iff] using fintype.card_le_one_iff.1 h ⟨x, hx⟩ 1),
+  λ h, by simp [h]⟩
+
+@[to_additive] lemma one_lt_card_iff_ne_bot [fintype H] : 1 < fintype.card H ↔ H ≠ ⊥ :=
+lt_iff_not_le.trans H.card_le_one_iff_eq_bot.not
+
+end subgroup
+
+namespace subgroup
+
+section pi
+
+open set
+
+variables {η : Type*} {f : η → Type*} [∀ i, group (f i)]
+
+@[to_additive]
+lemma pi_mem_of_mul_single_mem_aux [decidable_eq η] (I : finset η) {H : subgroup (Π i, f i) }
+  (x : Π i, f i) (h1 : ∀ i, i ∉ I → x i = 1) (h2 : ∀ i, i ∈ I → pi.mul_single i (x i) ∈ H ) :
+  x ∈ H :=
+begin
+  induction I using finset.induction_on with i I hnmem ih generalizing x,
+  { convert one_mem H,
+    ext i,
+    exact (h1 i (not_mem_empty i)) },
+  { have : x = function.update x i 1 * pi.mul_single i (x i),
+    { ext j,
+      by_cases heq : j = i,
+      { subst heq, simp, },
+      { simp [heq], }, },
+    rw this, clear this,
+    apply mul_mem,
+    { apply ih; clear ih,
+      { intros j hj,
+        by_cases heq : j = i,
+        { subst heq, simp, },
+        { simp [heq], apply h1 j, simpa [heq] using hj, } },
+      { intros j hj,
+        have : j ≠ i, by { rintro rfl, contradiction },
+        simp [this],
+        exact h2 _ (finset.mem_insert_of_mem hj), }, },
+    { apply h2, simp, } }
+end
+
+@[to_additive]
+lemma pi_mem_of_mul_single_mem [finite η] [decidable_eq η] {H : subgroup (Π i, f i)}
+  (x : Π i, f i) (h : ∀ i, pi.mul_single i (x i) ∈ H) : x ∈ H :=
+by { casesI nonempty_fintype η,
+   exact pi_mem_of_mul_single_mem_aux finset.univ x (by simp) (λ i _, h i) }
+
+/-- For finite index types, the `subgroup.pi` is generated by the embeddings of the groups.  -/
+@[to_additive "For finite index types, the `subgroup.pi` is generated by the embeddings of the
+additive groups."]
+lemma pi_le_iff [decidable_eq η] [finite η] {H : Π i, subgroup (f i)} {J : subgroup (Π i, f i)} :
+  pi univ H ≤ J ↔ ∀ i : η, map (monoid_hom.single f i) (H i) ≤ J :=
+begin
+  split,
+  { rintros h i _ ⟨x, hx, rfl⟩, apply h, simpa using hx },
+  { exact λ h x hx, pi_mem_of_mul_single_mem  x (λ i, h i (mem_map_of_mem _ (hx i trivial))), }
+end
+
+end pi
+
+end subgroup
+
+namespace subgroup
+
+section normalizer
+
+lemma mem_normalizer_fintype {S : set G} [finite S] {x : G}
+  (h : ∀ n, n ∈ S → x * n * x⁻¹ ∈ S) : x ∈ subgroup.set_normalizer S :=
+by haveI := classical.prop_decidable; casesI nonempty_fintype S;
+haveI := set.fintype_image S (λ n, x * n * x⁻¹); exact
+λ n, ⟨h n, λ h₁,
+have heq : (λ n, x * n * x⁻¹) '' S = S := set.eq_of_subset_of_card_le
+  (λ n ⟨y, hy⟩, hy.2 ▸ h y hy.1) (by rw set.card_image_of_injective S conj_injective),
+have x * n * x⁻¹ ∈ (λ n, x * n * x⁻¹) '' S := heq.symm ▸ h₁,
+let ⟨y, hy⟩ := this in conj_injective hy.2 ▸ hy.1⟩
+
+end normalizer
+
+end subgroup
+
+namespace monoid_hom
+
+variables {N : Type*} [group N]
+
+open subgroup
+
+@[to_additive]
+instance decidable_mem_range (f : G →* N) [fintype G] [decidable_eq N] :
+  decidable_pred (∈ f.range) :=
+λ x, fintype.decidable_exists_fintype
+
+-- this instance can't go just after the definition of `mrange` because `fintype` is
+-- not imported at that stage
+
+/-- The range of a finite monoid under a monoid homomorphism is finite.
+Note: this instance can form a diamond with `subtype.fintype` in the
+presence of `fintype N`. -/
+@[to_additive "The range of a finite additive monoid under an additive monoid homomorphism is
+finite.
+
+Note: this instance can form a diamond with `subtype.fintype` or `subgroup.fintype` in the
+presence of `fintype N`."]
+instance fintype_mrange {M N : Type*} [monoid M] [monoid N] [fintype M] [decidable_eq N]
+  (f : M →* N) : fintype (mrange f) :=
+set.fintype_range f
+
+/-- The range of a finite group under a group homomorphism is finite.
+
+Note: this instance can form a diamond with `subtype.fintype` or `subgroup.fintype` in the
+presence of `fintype N`. -/
+@[to_additive "The range of a finite additive group under an additive group homomorphism is finite.
+
+Note: this instance can form a diamond with `subtype.fintype` or `subgroup.fintype` in the
+presence of `fintype N`."]
+instance fintype_range  [fintype G] [decidable_eq N] (f : G →* N) : fintype (range f) :=
+set.fintype_range f
+
+end monoid_hom
diff --git a/src/group_theory/subgroup/mul_opposite.lean b/src/group_theory/subgroup/mul_opposite.lean
new file mode 100644
index 0000000000000..acc7c3d591f76
--- /dev/null
+++ b/src/group_theory/subgroup/mul_opposite.lean
@@ -0,0 +1,57 @@
+/-
+Copyright (c) 2022 Alex Kontorovich. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alex Kontorovich
+-/
+
+import group_theory.subgroup.actions
+
+/-!
+# Mul-opposite subgroups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Tags
+subgroup, subgroups
+
+-/
+
+variables {G : Type*} [group G]
+
+namespace subgroup
+
+/-- A subgroup `H` of `G` determines a subgroup `H.opposite` of the opposite group `Gᵐᵒᵖ`. -/
+@[to_additive "An additive subgroup `H` of `G` determines an additive subgroup `H.opposite` of the
+  opposite additive group `Gᵃᵒᵖ`."]
+def opposite : subgroup G ≃ subgroup Gᵐᵒᵖ :=
+{ to_fun := λ H, { carrier := mul_opposite.unop ⁻¹' (H : set G),
+                   one_mem' := H.one_mem,
+                   mul_mem' := λ a b ha hb, H.mul_mem hb ha,
+                   inv_mem' := λ a, H.inv_mem },
+  inv_fun := λ H, { carrier := mul_opposite.op ⁻¹' (H : set Gᵐᵒᵖ),
+                   one_mem' := H.one_mem,
+                   mul_mem' := λ a b ha hb, H.mul_mem hb ha,
+                   inv_mem' := λ a, H.inv_mem },
+  left_inv := λ H, set_like.coe_injective rfl,
+  right_inv := λ H, set_like.coe_injective rfl }
+
+/-- Bijection between a subgroup `H` and its opposite. -/
+@[to_additive "Bijection between an additive subgroup `H` and its opposite.", simps]
+def opposite_equiv (H : subgroup G) : H ≃ H.opposite :=
+mul_opposite.op_equiv.subtype_equiv $ λ _, iff.rfl
+
+@[to_additive] instance (H : subgroup G) [encodable H] : encodable H.opposite :=
+encodable.of_equiv H H.opposite_equiv.symm
+
+@[to_additive] instance (H : subgroup G) [countable H] : countable H.opposite :=
+countable.of_equiv H H.opposite_equiv
+
+@[to_additive] lemma smul_opposite_mul {H : subgroup G} (x g : G) (h : H.opposite) :
+  h • (g * x) = g * (h • x) :=
+begin
+  cases h,
+  simp [(•), mul_assoc],
+end
+
+end subgroup
diff --git a/src/group_theory/subgroup/pointwise.lean b/src/group_theory/subgroup/pointwise.lean
index 210cb0ae7059d..8b31a7d37c61d 100644
--- a/src/group_theory/subgroup/pointwise.lean
+++ b/src/group_theory/subgroup/pointwise.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import group_theory.subgroup.basic
+import group_theory.subgroup.mul_opposite
 import group_theory.submonoid.pointwise
+import group_theory.group_action.conj_act
 
 /-! # Pointwise instances on `subgroup` and `add_subgroup`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides the actions
 
 * `subgroup.pointwise_mul_action`
@@ -19,14 +23,207 @@ These actions are available in the `pointwise` locale.
 
 ## Implementation notes
 
-This file is almost identical to `group_theory/submonoid/pointwise.lean`. Where possible, try to
-keep them in sync.
+The pointwise section of this file is almost identical to `group_theory/submonoid/pointwise.lean`.
+Where possible, try to keep them in sync.
 -/
 
-variables {α : Type*} {G : Type*} {A : Type*} [group G] [add_group A]
+open set
+open_locale pointwise
+
+variables {α G A S : Type*}
+
+@[simp, to_additive]
+lemma inv_coe_set [has_involutive_inv G] [set_like S G] [inv_mem_class S G] {H : S} :
+  (H : set G)⁻¹ = H :=
+set.ext $ λ _, inv_mem_iff
+
+variables [group G] [add_group A] {s : set G}
 
 namespace subgroup
 
+@[simp, to_additive] lemma inv_subset_closure (S : set G) : S⁻¹ ⊆ closure S :=
+λ s hs, by { rw [set_like.mem_coe, ←subgroup.inv_mem_iff], exact subset_closure (mem_inv.mp hs) }
+
+@[to_additive]
+lemma closure_to_submonoid (S : set G) : (closure S).to_submonoid = submonoid.closure (S ∪ S⁻¹) :=
+begin
+  refine le_antisymm (λ x hx, _) (submonoid.closure_le.2 _),
+  { refine closure_induction hx (λ x hx, submonoid.closure_mono (subset_union_left S S⁻¹)
+      (submonoid.subset_closure hx)) (submonoid.one_mem _) (λ x y hx hy, submonoid.mul_mem _ hx hy)
+      (λ x hx, _),
+    rwa [←submonoid.mem_closure_inv, set.union_inv, inv_inv, set.union_comm] },
+  { simp only [true_and, coe_to_submonoid, union_subset_iff, subset_closure, inv_subset_closure] }
+end
+
+/-- For subgroups generated by a single element, see the simpler `zpow_induction_left`. -/
+@[to_additive "For additive subgroups generated by a single element, see the simpler
+`zsmul_induction_left`."]
+lemma closure_induction_left {p : G → Prop} {x : G} (h : x ∈ closure s) (H1 : p 1)
+  (Hmul : ∀ (x ∈ s) y, p y → p (x * y)) (Hinv : ∀ (x ∈ s) y, p y → p (x⁻¹ * y)) : p x :=
+let key := (closure_to_submonoid s).le in submonoid.closure_induction_left (key h) H1 $
+  λ x hx, hx.elim (Hmul x) $ λ hx y hy, (congr_arg _ $ inv_inv x).mp $ Hinv x⁻¹ hx y hy
+
+/-- For subgroups generated by a single element, see the simpler `zpow_induction_right`. -/
+@[to_additive "For additive subgroups generated by a single element, see the simpler
+`zsmul_induction_right`."]
+lemma closure_induction_right {p : G → Prop} {x : G} (h : x ∈ closure s) (H1 : p 1)
+  (Hmul : ∀ x (y ∈ s), p x → p (x * y)) (Hinv : ∀ x (y ∈ s), p x → p (x * y⁻¹)) : p x :=
+let key := (closure_to_submonoid s).le in submonoid.closure_induction_right (key h) H1 $
+  λ x y hy, hy.elim (Hmul x y) $ λ hy hx, (congr_arg _ $ inv_inv y).mp $ Hinv x y⁻¹ hy hx
+
+@[simp, to_additive] lemma closure_inv (s : set G) : closure s⁻¹ = closure s :=
+by simp only [← to_submonoid_eq, closure_to_submonoid, inv_inv, union_comm]
+
+/-- An induction principle for closure membership. If `p` holds for `1` and all elements of
+`k` and their inverse, and is preserved under multiplication, then `p` holds for all elements of
+the closure of `k`. -/
+@[to_additive "An induction principle for additive closure membership. If `p` holds for `0` and all
+elements of `k` and their negation, and is preserved under addition, then `p` holds for all
+elements of the additive closure of `k`."]
+lemma closure_induction'' {p : G → Prop} {x} (h : x ∈ closure s) (Hk : ∀ x ∈ s, p x)
+  (Hk_inv : ∀ x ∈ s, p x⁻¹) (H1 : p 1) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
+closure_induction_left h H1 (λ x hx y hy, Hmul x y (Hk x hx) hy) $ λ x hx y,
+  Hmul x⁻¹ y $ Hk_inv x hx
+
+/-- An induction principle for elements of `⨆ i, S i`.
+If `C` holds for `1` and all elements of `S i` for all `i`, and is preserved under multiplication,
+then it holds for all elements of the supremum of `S`. -/
+@[elab_as_eliminator, to_additive /-" An induction principle for elements of `⨆ i, S i`.
+If `C` holds for `0` and all elements of `S i` for all `i`, and is preserved under addition,
+then it holds for all elements of the supremum of `S`. "-/]
+lemma supr_induction {ι : Sort*} (S : ι → subgroup G) {C : G → Prop} {x : G} (hx : x ∈ ⨆ i, S i)
+  (hp : ∀ i (x ∈ S i), C x)
+  (h1 : C 1)
+  (hmul : ∀ x y, C x → C y → C (x * y)) : C x :=
+begin
+  rw supr_eq_closure at hx,
+  refine closure_induction'' hx (λ x hx, _) (λ x hx, _) h1 hmul,
+  { obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
+    exact hp _ _ hi, },
+  { obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
+    exact hp _ _ (inv_mem hi), },
+end
+
+/-- A dependent version of `subgroup.supr_induction`. -/
+@[elab_as_eliminator, to_additive /-"A dependent version of `add_subgroup.supr_induction`. "-/]
+lemma supr_induction' {ι : Sort*} (S : ι → subgroup G) {C : Π x, (x ∈ ⨆ i, S i) → Prop}
+  (hp : ∀ i (x ∈ S i), C x (mem_supr_of_mem i ‹_›))
+  (h1 : C 1 (one_mem _))
+  (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›))
+  {x : G} (hx : x ∈ ⨆ i, S i) : C x hx :=
+begin
+  refine exists.elim _ (λ (hx : x ∈ ⨆ i, S i) (hc : C x hx), hc),
+  refine supr_induction S hx (λ i x hx, _) _ (λ x y, _),
+  { exact ⟨_, hp _ _ hx⟩ },
+  { exact ⟨_, h1⟩ },
+  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
+    refine ⟨_, hmul _ _ _ _ Cx Cy⟩ },
+end
+
+@[to_additive]
+lemma closure_mul_le (S T : set G) : closure (S * T) ≤ closure S ⊔ closure T :=
+Inf_le $ λ x ⟨s, t, hs, ht, hx⟩, hx ▸ (closure S ⊔ closure T).mul_mem
+    (set_like.le_def.mp le_sup_left $ subset_closure hs)
+    (set_like.le_def.mp le_sup_right $ subset_closure ht)
+
+@[to_additive]
+lemma sup_eq_closure (H K : subgroup G) : H ⊔ K = closure (H * K) :=
+le_antisymm
+  (sup_le
+    (λ h hh, subset_closure ⟨h, 1, hh, K.one_mem, mul_one h⟩)
+    (λ k hk, subset_closure ⟨1, k, H.one_mem, hk, one_mul k⟩))
+  (by conv_rhs { rw [← closure_eq H, ← closure_eq K] }; apply closure_mul_le)
+
+@[to_additive]
+private def mul_normal_aux (H N : subgroup G) [hN : N.normal] : subgroup G :=
+{ carrier := (H : set G) * N,
+  one_mem' := ⟨1, 1, H.one_mem, N.one_mem, by rw mul_one⟩,
+  mul_mem' := λ a b ⟨h, n, hh, hn, ha⟩ ⟨h', n', hh', hn', hb⟩,
+    ⟨h * h', h'⁻¹ * n * h' * n',
+    H.mul_mem hh hh', N.mul_mem (by simpa using hN.conj_mem _ hn h'⁻¹) hn',
+    by simp [← ha, ← hb, mul_assoc]⟩,
+  inv_mem' := λ x ⟨h, n, hh, hn, hx⟩,
+    ⟨h⁻¹, h * n⁻¹ * h⁻¹, H.inv_mem hh, hN.conj_mem _ (N.inv_mem hn) h,
+    by rw [mul_assoc h, inv_mul_cancel_left, ← hx, mul_inv_rev]⟩ }
+
+/-- The carrier of `H ⊔ N` is just `↑H * ↑N` (pointwise set product) when `N` is normal. -/
+@[to_additive "The carrier of `H ⊔ N` is just `↑H + ↑N` (pointwise set addition)
+when `N` is normal."]
+lemma mul_normal (H N : subgroup G) [N.normal] : (↑(H ⊔ N) : set G) = H * N :=
+set.subset.antisymm
+  (show H ⊔ N ≤ mul_normal_aux H N,
+    by { rw sup_eq_closure, apply Inf_le _, dsimp, refl })
+  ((sup_eq_closure H N).symm ▸ subset_closure)
+
+@[to_additive]
+private def normal_mul_aux (N H : subgroup G) [hN : N.normal] : subgroup G :=
+{ carrier := (N : set G) * H,
+  one_mem' := ⟨1, 1, N.one_mem, H.one_mem, by rw mul_one⟩,
+  mul_mem' := λ a b ⟨n, h, hn, hh, ha⟩ ⟨n', h', hn', hh', hb⟩,
+    ⟨n * (h * n' * h⁻¹), h * h',
+    N.mul_mem hn (hN.conj_mem _ hn' _), H.mul_mem hh hh',
+    by simp [← ha, ← hb, mul_assoc]⟩,
+  inv_mem' := λ x ⟨n, h, hn, hh, hx⟩,
+    ⟨h⁻¹ * n⁻¹ * h, h⁻¹,
+    by simpa using hN.conj_mem _ (N.inv_mem hn) h⁻¹, H.inv_mem hh,
+    by rw [mul_inv_cancel_right, ← mul_inv_rev, hx]⟩ }
+
+/-- The carrier of `N ⊔ H` is just `↑N * ↑H` (pointwise set product) when `N` is normal. -/
+@[to_additive "The carrier of `N ⊔ H` is just `↑N + ↑H` (pointwise set addition)
+when `N` is normal."]
+lemma normal_mul (N H : subgroup G) [N.normal] : (↑(N ⊔ H) : set G) = N * H :=
+set.subset.antisymm
+  (show N ⊔ H ≤ normal_mul_aux N H,
+    by { rw sup_eq_closure, apply Inf_le _, dsimp, refl })
+  ((sup_eq_closure N H).symm ▸ subset_closure)
+
+@[to_additive] lemma mul_inf_assoc (A B C : subgroup G) (h : A ≤ C) :
+  (A : set G) * ↑(B ⊓ C) = (A * B) ⊓ C :=
+begin
+  ext,
+  simp only [coe_inf, set.inf_eq_inter, set.mem_mul, set.mem_inter_iff],
+  split,
+  { rintros ⟨y, z, hy, ⟨hzB, hzC⟩, rfl⟩,
+    refine ⟨_, mul_mem (h hy) hzC⟩,
+    exact ⟨y, z, hy, hzB, rfl⟩ },
+  rintros ⟨⟨y, z, hy, hz, rfl⟩, hyz⟩,
+  refine ⟨y, z, hy, ⟨hz, _⟩, rfl⟩,
+  suffices : y⁻¹ * (y * z) ∈ C, { simpa },
+  exact mul_mem (inv_mem (h hy)) hyz
+end
+
+@[to_additive] lemma inf_mul_assoc (A B C : subgroup G) (h : C ≤ A) :
+  ((A ⊓ B : subgroup G) : set G) * C = A ⊓ (B * C) :=
+begin
+  ext,
+  simp only [coe_inf, set.inf_eq_inter, set.mem_mul, set.mem_inter_iff],
+  split,
+  { rintros ⟨y, z, ⟨hyA, hyB⟩, hz, rfl⟩,
+    refine ⟨A.mul_mem hyA (h hz), _⟩,
+    exact ⟨y, z, hyB, hz, rfl⟩ },
+  rintros ⟨hyz, y, z, hy, hz, rfl⟩,
+  refine ⟨y, z, ⟨_, hy⟩, hz, rfl⟩,
+  suffices : (y * z) * z⁻¹ ∈ A, { simpa },
+  exact mul_mem hyz (inv_mem (h hz))
+end
+
+instance sup_normal (H K : subgroup G) [hH : H.normal] [hK : K.normal] : (H ⊔ K).normal :=
+{ conj_mem := λ n hmem g,
+  begin
+    change n ∈ ↑(H ⊔ K) at hmem,
+    change g * n * g⁻¹ ∈ ↑(H ⊔ K),
+    rw [normal_mul, set.mem_mul] at *,
+    rcases hmem with ⟨h, k, hh, hk, rfl⟩,
+    refine ⟨g * h * g⁻¹, g * k * g⁻¹, hH.conj_mem h hh g, hK.conj_mem k hk g, _⟩,
+    simp
+  end }
+
+@[to_additive] lemma smul_opposite_image_mul_preimage {H : subgroup G} (g : G) (h : H.opposite)
+  (s : set G) : (λ y, h • y) '' (has_mul.mul g ⁻¹' s) = has_mul.mul g ⁻¹' ((λ y, h • y) '' s) :=
+by { ext x, cases h, simp [(•), mul_assoc] }
+
+/-! ### Pointwise action -/
+
 section monoid
 variables [monoid α] [mul_distrib_mul_action α G]
 
@@ -57,10 +254,33 @@ lemma mem_smul_pointwise_iff_exists (m : G) (a : α) (S : subgroup G) :
   m ∈ a • S ↔ ∃ (s : G), s ∈ S ∧ a • s = m :=
 (set.mem_smul_set : m ∈ a • (S : set G) ↔ _)
 
+@[simp] lemma smul_bot (a : α) : a • (⊥ : subgroup G) = ⊥ := map_bot _
+lemma smul_sup (a : α) (S T : subgroup G) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : α) (s : set G) : a • closure s = closure (a • s) :=
+monoid_hom.map_closure _ _
+
 instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ G] [is_central_scalar α G] :
   is_central_scalar α (subgroup G) :=
 ⟨λ a S, congr_arg (λ f, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩
 
+lemma conj_smul_le_of_le {P H : subgroup G} (hP : P ≤ H) (h : H) :
+  mul_aut.conj (h : G) • P ≤ H :=
+begin
+  rintro - ⟨g, hg, rfl⟩,
+  exact H.mul_mem (H.mul_mem h.2 (hP hg)) (H.inv_mem h.2),
+end
+
+lemma conj_smul_subgroup_of {P H : subgroup G} (hP : P ≤ H) (h : H) :
+  mul_aut.conj h • P.subgroup_of H = (mul_aut.conj (h : G) • P).subgroup_of H :=
+begin
+  refine le_antisymm _ _,
+  { rintro - ⟨g, hg, rfl⟩,
+    exact ⟨g, hg, rfl⟩ },
+  { rintro p ⟨g, hg, hp⟩,
+    exact ⟨⟨g, hP hg⟩, hg, subtype.ext hp⟩ },
+end
+
 end monoid
 
 section group
@@ -89,6 +309,9 @@ set_smul_subset_iff
 lemma subset_pointwise_smul_iff {a : α} {S T : subgroup G} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
 subset_set_smul_iff
 
+@[simp] lemma smul_inf (a : α) (S T : subgroup G) : a • (S ⊓ T) = a • S ⊓ a • T :=
+by simp [set_like.ext_iff, mem_pointwise_smul_iff_inv_smul_mem]
+
 /-- Applying a `mul_distrib_mul_action` results in an isomorphic subgroup -/
 @[simps] def equiv_smul (a : α) (H : subgroup G) : H ≃* (a • H : subgroup G) :=
 (mul_distrib_mul_action.to_mul_equiv G a).subgroup_map H
@@ -111,6 +334,30 @@ begin
   exact H.mul_mem hh hh',
 end
 
+lemma normal.conj_act {G : Type*} [group G] {H : subgroup G} (hH : H.normal ) (g : conj_act G) :
+  g • H = H :=
+begin
+  ext,
+  split,
+  { intro h,
+    have := hH.conj_mem (g⁻¹ • x) _ (conj_act.of_conj_act g),
+    rw subgroup.mem_pointwise_smul_iff_inv_smul_mem at h,
+    dsimp at *,
+    rw conj_act.smul_def at *,
+    simp only [conj_act.of_conj_act_inv, conj_act.of_conj_act_to_conj_act, inv_inv] at *,
+    convert this,
+    simp only [←mul_assoc, mul_right_inv, one_mul, mul_inv_cancel_right],
+    rw subgroup.mem_pointwise_smul_iff_inv_smul_mem at h,
+    exact h},
+  { intro h,
+    rw [subgroup.mem_pointwise_smul_iff_inv_smul_mem, conj_act.smul_def],
+    apply hH.conj_mem,
+    exact h}
+end
+
+@[simp] lemma smul_normal (g : G) (H : subgroup G) [h : normal H] : mul_aut.conj g • H = H :=
+h.conj_act g
+
 end group
 
 section group_with_zero
diff --git a/src/group_theory/subgroup/saturated.lean b/src/group_theory/subgroup/saturated.lean
new file mode 100644
index 0000000000000..b3594a30926f0
--- /dev/null
+++ b/src/group_theory/subgroup/saturated.lean
@@ -0,0 +1,61 @@
+/-
+Copyright (c) 2021 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+
+import group_theory.subgroup.basic
+
+/-!
+# Saturated subgroups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Tags
+subgroup, subgroups
+
+-/
+
+namespace subgroup
+
+variables {G : Type*} [group G]
+
+/-- A subgroup `H` of `G` is *saturated* if for all `n : ℕ` and `g : G` with `g^n ∈ H`
+we have `n = 0` or `g ∈ H`. -/
+@[to_additive "An additive subgroup `H` of `G` is *saturated* if
+for all `n : ℕ` and `g : G` with `n•g ∈ H` we have `n = 0` or `g ∈ H`."]
+def saturated (H : subgroup G) : Prop := ∀ ⦃n g⦄, g ^ n ∈ H → n = 0 ∨ g ∈ H
+
+@[to_additive] lemma saturated_iff_npow {H : subgroup G} :
+  saturated H ↔ (∀ (n : ℕ) (g : G), g ^ n ∈ H → n = 0 ∨ g ∈ H) := iff.rfl
+
+@[to_additive] lemma saturated_iff_zpow {H : subgroup G} :
+  saturated H ↔ (∀ (n : ℤ) (g : G), g ^ n ∈ H → n = 0 ∨ g ∈ H) :=
+begin
+  split,
+  { rintros hH ⟨n⟩ g hgn,
+    { simp only [int.coe_nat_eq_zero, int.of_nat_eq_coe, zpow_coe_nat] at hgn ⊢,
+      exact hH hgn },
+    { suffices : g ^ (n+1) ∈ H,
+      { refine (hH this).imp _ id, simp only [is_empty.forall_iff, nat.succ_ne_zero], },
+      simpa only [inv_mem_iff, zpow_neg_succ_of_nat] using hgn, } },
+  { intros h n g hgn,
+    specialize h n g,
+    simp only [int.coe_nat_eq_zero, zpow_coe_nat] at h,
+    apply h hgn }
+end
+
+end subgroup
+
+namespace add_subgroup
+
+lemma ker_saturated {A₁ A₂ : Type*} [add_comm_group A₁] [add_comm_group A₂]
+  [no_zero_smul_divisors ℕ A₂] (f : A₁ →+ A₂) :
+  (f.ker).saturated :=
+begin
+  intros n g hg,
+  simpa only [f.mem_ker, nsmul_eq_smul, f.map_nsmul, smul_eq_zero] using hg
+end
+
+end add_subgroup
diff --git a/src/group_theory/subgroup/simple.lean b/src/group_theory/subgroup/simple.lean
new file mode 100644
index 0000000000000..b629a87b9ab54
--- /dev/null
+++ b/src/group_theory/subgroup/simple.lean
@@ -0,0 +1,73 @@
+/-
+Copyright (c) 2021 Aaron Anderson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Aaron Anderson
+-/
+
+import group_theory.subgroup.actions
+
+/-!
+# Simple groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `is_simple_group G`, a class indicating that a group has exactly two normal
+subgroups.
+
+## Main definitions
+
+- `is_simple_group G`, a class indicating that a group has exactly two normal subgroups.
+
+## Tags
+subgroup, subgroups
+
+-/
+
+set_option old_structure_cmd true
+
+variables {G : Type*} [group G]
+variables {A : Type*} [add_group A]
+
+section
+variables (G) (A)
+
+/-- A `group` is simple when it has exactly two normal `subgroup`s. -/
+class is_simple_group extends nontrivial G : Prop :=
+(eq_bot_or_eq_top_of_normal : ∀ H : subgroup G, H.normal → H = ⊥ ∨ H = ⊤)
+
+/-- An `add_group` is simple when it has exactly two normal `add_subgroup`s. -/
+class is_simple_add_group extends nontrivial A : Prop :=
+(eq_bot_or_eq_top_of_normal : ∀ H : add_subgroup A, H.normal → H = ⊥ ∨ H = ⊤)
+
+attribute [to_additive] is_simple_group
+
+variables {G} {A}
+
+@[to_additive]
+lemma subgroup.normal.eq_bot_or_eq_top [is_simple_group G] {H : subgroup G} (Hn : H.normal) :
+  H = ⊥ ∨ H = ⊤ :=
+is_simple_group.eq_bot_or_eq_top_of_normal H Hn
+
+namespace is_simple_group
+
+@[to_additive]
+instance {C : Type*} [comm_group C] [is_simple_group C] :
+  is_simple_order (subgroup C) :=
+⟨λ H, H.normal_of_comm.eq_bot_or_eq_top⟩
+
+open _root_.subgroup
+
+@[to_additive]
+lemma is_simple_group_of_surjective {H : Type*} [group H] [is_simple_group G]
+  [nontrivial H] (f : G →* H) (hf : function.surjective f) :
+  is_simple_group H :=
+⟨nontrivial.exists_pair_ne, λ H iH, begin
+  refine ((iH.comap f).eq_bot_or_eq_top).imp (λ h, _) (λ h, _),
+  { rw [←map_bot f, ←h, map_comap_eq_self_of_surjective hf] },
+  { rw [←comap_top f] at h, exact comap_injective hf h }
+end⟩
+
+end is_simple_group
+
+end
diff --git a/src/group_theory/subgroup/zpowers.lean b/src/group_theory/subgroup/zpowers.lean
new file mode 100644
index 0000000000000..f3456efdf70d3
--- /dev/null
+++ b/src/group_theory/subgroup/zpowers.lean
@@ -0,0 +1,184 @@
+/-
+Copyright (c) 2020 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes
+-/
+
+import group_theory.subgroup.basic
+
+/-!
+# Subgroups generated by an element
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Tags
+subgroup, subgroups
+
+-/
+
+variables {G : Type*} [group G]
+variables {A : Type*} [add_group A]
+variables {N : Type*} [group N]
+
+namespace subgroup
+
+/-- The subgroup generated by an element. -/
+def zpowers (g : G) : subgroup G :=
+subgroup.copy (zpowers_hom G g).range (set.range ((^) g : ℤ → G)) rfl
+
+@[simp] lemma mem_zpowers (g : G) : g ∈ zpowers g := ⟨1, zpow_one _⟩
+
+@[norm_cast] lemma coe_zpowers (g : G) : ↑(zpowers g) = set.range (λ n : ℤ, g ^ n) := rfl
+
+lemma zpowers_eq_closure (g : G) : zpowers g = closure {g} :=
+by { ext, exact mem_closure_singleton.symm }
+
+@[simp] lemma range_zpowers_hom (g : G) : (zpowers_hom G g).range = zpowers g := rfl
+
+lemma mem_zpowers_iff {g h : G} :
+  h ∈ zpowers g ↔ ∃ (k : ℤ), g ^ k = h :=
+iff.rfl
+
+@[simp] lemma zpow_mem_zpowers (g : G) (k : ℤ) : g^k ∈ zpowers g :=
+mem_zpowers_iff.mpr ⟨k, rfl⟩
+
+@[simp] lemma npow_mem_zpowers (g : G) (k : ℕ) : g^k ∈ zpowers g :=
+(zpow_coe_nat g k) ▸ zpow_mem_zpowers g k
+
+@[simp] lemma forall_zpowers {x : G} {p : zpowers x → Prop} :
+  (∀ g, p g) ↔ ∀ m : ℤ, p ⟨x ^ m, m, rfl⟩ :=
+set.forall_subtype_range_iff
+
+@[simp] lemma exists_zpowers {x : G} {p : zpowers x → Prop} :
+  (∃ g, p g) ↔ ∃ m : ℤ, p ⟨x ^ m, m, rfl⟩ :=
+set.exists_subtype_range_iff
+
+lemma forall_mem_zpowers {x : G} {p : G → Prop} :
+  (∀ g ∈ zpowers x, p g) ↔ ∀ m : ℤ, p (x ^ m) :=
+set.forall_range_iff
+
+lemma exists_mem_zpowers {x : G} {p : G → Prop} :
+  (∃ g ∈ zpowers x, p g) ↔ ∃ m : ℤ, p (x ^ m) :=
+set.exists_range_iff
+
+instance (a : G) : countable (zpowers a) :=
+((zpowers_hom G a).range_restrict_surjective.comp multiplicative.of_add.surjective).countable
+
+end subgroup
+
+namespace add_subgroup
+
+/-- The subgroup generated by an element. -/
+def zmultiples (a : A) : add_subgroup A :=
+add_subgroup.copy (zmultiples_hom A a).range (set.range ((• a) : ℤ → A)) rfl
+
+@[simp] lemma range_zmultiples_hom (a : A) : (zmultiples_hom A a).range = zmultiples a := rfl
+
+attribute [to_additive add_subgroup.zmultiples] subgroup.zpowers
+attribute [to_additive add_subgroup.mem_zmultiples] subgroup.mem_zpowers
+attribute [to_additive add_subgroup.coe_zmultiples] subgroup.coe_zpowers
+attribute [to_additive add_subgroup.zmultiples_eq_closure] subgroup.zpowers_eq_closure
+attribute [to_additive add_subgroup.range_zmultiples_hom] subgroup.range_zpowers_hom
+attribute [to_additive add_subgroup.mem_zmultiples_iff] subgroup.mem_zpowers_iff
+attribute [to_additive add_subgroup.zsmul_mem_zmultiples] subgroup.zpow_mem_zpowers
+attribute [to_additive add_subgroup.nsmul_mem_zmultiples] subgroup.npow_mem_zpowers
+attribute [to_additive add_subgroup.forall_zmultiples] subgroup.forall_zpowers
+attribute [to_additive add_subgroup.forall_mem_zmultiples] subgroup.forall_mem_zpowers
+attribute [to_additive add_subgroup.exists_zmultiples] subgroup.exists_zpowers
+attribute [to_additive add_subgroup.exists_mem_zmultiples] subgroup.exists_mem_zpowers
+
+instance (a : A) : countable (zmultiples a) :=
+(zmultiples_hom A a).range_restrict_surjective.countable
+
+section ring
+
+variables {R : Type*} [ring R] (r : R) (k : ℤ)
+
+@[simp] lemma int_cast_mul_mem_zmultiples :
+  ↑(k : ℤ) * r ∈ zmultiples r :=
+by simpa only [← zsmul_eq_mul] using zsmul_mem_zmultiples r k
+
+@[simp] lemma int_cast_mem_zmultiples_one :
+  ↑(k : ℤ) ∈ zmultiples (1 : R) :=
+mem_zmultiples_iff.mp ⟨k, by simp⟩
+
+end ring
+
+end add_subgroup
+
+@[simp, to_additive map_zmultiples] lemma monoid_hom.map_zpowers (f : G →* N) (x : G) :
+  (subgroup.zpowers x).map f = subgroup.zpowers (f x) :=
+by rw [subgroup.zpowers_eq_closure, subgroup.zpowers_eq_closure, f.map_closure, set.image_singleton]
+
+lemma int.mem_zmultiples_iff {a b : ℤ} :
+  b ∈ add_subgroup.zmultiples a ↔ a ∣ b :=
+exists_congr (λ k, by rw [mul_comm, eq_comm, ← smul_eq_mul])
+
+lemma of_mul_image_zpowers_eq_zmultiples_of_mul { x : G } :
+  additive.of_mul '' ((subgroup.zpowers x) : set G) = add_subgroup.zmultiples (additive.of_mul x) :=
+begin
+  ext y,
+  split,
+  { rintro ⟨z, ⟨m, hm⟩, hz2⟩,
+    use m,
+    simp only,
+    rwa [← of_mul_zpow, hm] },
+  { rintros ⟨n, hn⟩,
+    refine ⟨x ^ n, ⟨n, rfl⟩, _⟩,
+    rwa of_mul_zpow }
+end
+
+lemma of_add_image_zmultiples_eq_zpowers_of_add {x : A} :
+  multiplicative.of_add '' ((add_subgroup.zmultiples x) : set A) =
+  subgroup.zpowers (multiplicative.of_add x) :=
+begin
+  symmetry,
+  rw equiv.eq_image_iff_symm_image_eq,
+  exact of_mul_image_zpowers_eq_zmultiples_of_mul,
+end
+
+namespace subgroup
+variables {s : set G} {g : G}
+
+@[to_additive zmultiples_is_commutative]
+instance zpowers_is_commutative (g : G) : (zpowers g).is_commutative :=
+⟨⟨λ ⟨_, _, h₁⟩ ⟨_, _, h₂⟩, by rw [subtype.ext_iff, coe_mul, coe_mul,
+  subtype.coe_mk, subtype.coe_mk, ←h₁, ←h₂, zpow_mul_comm]⟩⟩
+
+@[simp, to_additive zmultiples_le]
+lemma zpowers_le {g : G} {H : subgroup G} : zpowers g ≤ H ↔ g ∈ H :=
+by rw [zpowers_eq_closure, closure_le, set.singleton_subset_iff, set_like.mem_coe]
+
+alias zpowers_le ↔ _ zpowers_le_of_mem
+alias add_subgroup.zmultiples_le ↔ _ _root_.add_subgroup.zmultiples_le_of_mem
+
+attribute [to_additive zmultiples_le_of_mem] zpowers_le_of_mem
+
+@[simp, to_additive zmultiples_eq_bot] lemma zpowers_eq_bot {g : G} : zpowers g = ⊥ ↔ g = 1 :=
+by rw [eq_bot_iff, zpowers_le, mem_bot]
+
+@[to_additive zmultiples_ne_bot] lemma zpowers_ne_bot : zpowers g ≠ ⊥ ↔ g ≠ 1 :=
+zpowers_eq_bot.not
+
+@[simp, to_additive zmultiples_zero_eq_bot] lemma zpowers_one_eq_bot :
+   subgroup.zpowers (1 : G) = ⊥ :=
+subgroup.zpowers_eq_bot.mpr rfl
+
+@[to_additive] lemma centralizer_closure (S : set G) :
+  centralizer (closure S : set G) = ⨅ g ∈ S, centralizer (zpowers g : set G) :=
+le_antisymm
+  (le_infi $ λ g, le_infi $ λ hg, centralizer_le $ set_like.coe_subset_coe.2 $
+    zpowers_le.2 $ subset_closure hg)
+  $ le_centralizer_iff.1 $ (closure_le _).2
+  $ λ g, set_like.mem_coe.2 ∘ zpowers_le.1 ∘ le_centralizer_iff.1 ∘ infi_le_of_le g ∘ infi_le _
+
+@[to_additive] lemma center_eq_infi (S : set G) (hS : closure S = ⊤) :
+  center G = ⨅ g ∈ S, centralizer (zpowers g) :=
+by rw [←centralizer_univ, ←coe_top, ←hS, centralizer_closure]
+
+@[to_additive] lemma center_eq_infi' (S : set G) (hS : closure S = ⊤) :
+  center G = ⨅ g : S, centralizer (zpowers (g : G) : set G) :=
+by rw [center_eq_infi S hS, ←infi_subtype'']
+
+end subgroup
diff --git a/src/group_theory/submonoid/basic.lean b/src/group_theory/submonoid/basic.lean
index 625fa2d15baa6..34d40b22dea98 100644
--- a/src/group_theory/submonoid/basic.lean
+++ b/src/group_theory/submonoid/basic.lean
@@ -4,16 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
 Amelia Livingston, Yury Kudryashov
 -/
+import algebra.hom.group  -- Only needed for notation
+import algebra.group.units
 import group_theory.subsemigroup.basic
 
 /-!
 # Submonoids: definition and `complete_lattice` structure
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines bundled multiplicative and additive submonoids. We also define
 a `complete_lattice` structure on `submonoid`s, define the closure of a set as the minimal submonoid
 that includes this set, and prove a few results about extending properties from a dense set (i.e.
 a set with `closure s = ⊤`) to the whole monoid, see `submonoid.dense_induction` and
-`monoid_hom.of_mdense`.
+`monoid_hom.of_mclosure_eq_top_left`/`monoid_hom.of_mclosure_eq_top_right`.
 
 ## Main definitions
 
@@ -30,10 +35,10 @@ definition in the `add_submonoid` namespace.
 * `submonoid.gi` : `closure : set M → submonoid M` and coercion `coe : submonoid M → set M`
   form a `galois_insertion`;
 * `monoid_hom.eq_mlocus`: the submonoid of elements `x : M` such that `f x = g x`;
-* `monoid_hom.of_mdense`:  if a map `f : M → N` between two monoids satisfies `f 1 = 1` and
-  `f (x * y) = f x * f y` for `y` from some dense set `s`, then `f` is a monoid homomorphism.
-  E.g., if `f : ℕ → M` satisfies `f 0 = 0` and `f (x + 1) = f x + f 1`, then `f` is an additive
-  monoid homomorphism.
+* `monoid_hom.of_mclosure_eq_top_right`:  if a map `f : M → N` between two monoids satisfies
+  `f 1 = 1` and `f (x * y) = f x * f y` for `y` from some dense set `s`, then `f` is a monoid
+  homomorphism. E.g., if `f : ℕ → M` satisfies `f 0 = 0` and `f (x + 1) = f x + f 1`, then `f` is
+  an additive monoid homomorphism.
 
 ## Implementation notes
 
@@ -58,13 +63,13 @@ variables [mul_one_class M] {s : set M}
 variables [add_zero_class A] {t : set A}
 
 /-- `one_mem_class S M` says `S` is a type of subsets `s ≤ M`, such that `1 ∈ s` for all `s`. -/
-class one_mem_class (S : Type*) (M : out_param $ Type*) [has_one M] [set_like S M] :=
+class one_mem_class (S M : Type*) [has_one M] [set_like S M] : Prop :=
 (one_mem : ∀ (s : S), (1 : M) ∈ s)
 
 export one_mem_class (one_mem)
 
 /-- `zero_mem_class S M` says `S` is a type of subsets `s ≤ M`, such that `0 ∈ s` for all `s`. -/
-class zero_mem_class (S : Type*) (M : out_param $ Type*) [has_zero M] [set_like S M] :=
+class zero_mem_class (S M : Type*) [has_zero M] [set_like S M] : Prop :=
 (zero_mem : ∀ (s : S), (0 : M) ∈ s)
 
 export zero_mem_class (zero_mem)
@@ -76,6 +81,7 @@ section
 set_option old_structure_cmd true
 
 /-- A submonoid of a monoid `M` is a subset containing 1 and closed under multiplication. -/
+@[ancestor subsemigroup]
 structure submonoid (M : Type*) [mul_one_class M] extends subsemigroup M :=
 (one_mem' : (1 : M) ∈ carrier)
 
@@ -86,9 +92,8 @@ add_decl_doc submonoid.to_subsemigroup
 
 /-- `submonoid_class S M` says `S` is a type of subsets `s ≤ M` that contain `1`
 and are closed under `(*)` -/
-class submonoid_class (S : Type*) (M : out_param $ Type*) [mul_one_class M] [set_like S M]
-  extends mul_mem_class S M :=
-(one_mem : ∀ (s : S), (1 : M) ∈ s)
+class submonoid_class (S M : Type*) [mul_one_class M] [set_like S M]
+  extends mul_mem_class S M, one_mem_class S M : Prop
 
 section
 
@@ -96,6 +101,7 @@ set_option old_structure_cmd true
 
 /-- An additive submonoid of an additive monoid `M` is a subset containing 0 and
   closed under addition. -/
+@[ancestor add_subsemigroup]
 structure add_submonoid (M : Type*) [add_zero_class M] extends add_subsemigroup M :=
 (zero_mem' : (0 : M) ∈ carrier)
 
@@ -107,17 +113,11 @@ add_decl_doc add_submonoid.to_add_subsemigroup
 
 /-- `add_submonoid_class S M` says `S` is a type of subsets `s ≤ M` that contain `0`
 and are closed under `(+)` -/
-class add_submonoid_class (S : Type*) (M : out_param $ Type*) [add_zero_class M] [set_like S M]
-  extends add_mem_class S M :=
-(zero_mem : ∀ (s : S), (0 : M) ∈ s)
+class add_submonoid_class (S M : Type*) [add_zero_class M] [set_like S M]
+  extends add_mem_class S M, zero_mem_class S M : Prop
 
 attribute [to_additive] submonoid submonoid_class
 
-@[to_additive, priority 100] -- See note [lower instance priority]
-instance submonoid_class.to_one_mem_class (S : Type*) (M : out_param $ Type*) [mul_one_class M]
-  [set_like S M] [h : submonoid_class S M] : one_mem_class S M :=
-{ ..h }
-
 @[to_additive]
 lemma pow_mem {M} [monoid M] {A : Type*} [set_like A M] [submonoid_class A M] {S : A} {x : M}
   (hx : x ∈ S) : ∀ (n : ℕ), x ^ n ∈ S
@@ -166,7 +166,7 @@ theorem ext {S T : submonoid M}
 protected def copy (S : submonoid M) (s : set M) (hs : s = S) : submonoid M :=
 { carrier := s,
   one_mem' := hs.symm ▸ S.one_mem',
-  mul_mem' := hs.symm ▸ S.mul_mem' }
+  mul_mem' := λ _ _, hs.symm ▸ S.mul_mem' }
 
 variable {S : submonoid M}
 
@@ -423,7 +423,7 @@ by simp_rw [submonoid.closure_Union, submonoid.closure_eq]
 @[to_additive]
 lemma disjoint_def {p₁ p₂ : submonoid M} :
   disjoint p₁ p₂ ↔ ∀ {x : M}, x ∈ p₁ → x ∈ p₂ → x = 1 :=
-show (∀ x, x ∈ p₁ ∧ x ∈ p₂ → x ∈ ({1} : set M)) ↔ _, by simp
+by simp_rw [disjoint_iff_inf_le, set_like.le_def, mem_inf, and_imp, mem_bot]
 
 @[to_additive]
 lemma disjoint_def' {p₁ p₂ : submonoid M} :
@@ -446,8 +446,12 @@ def eq_mlocus (f g : M →* N) : submonoid M :=
   one_mem' := by rw [set.mem_set_of_eq, f.map_one, g.map_one],
   mul_mem' := λ x y (hx : _ = _) (hy : _ = _), by simp [*] }
 
+@[simp, to_additive] lemma eq_mlocus_same (f : M →* N) : f.eq_mlocus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two monoid homomorphisms are equal on a set, then they are equal on its submonoid closure. -/
-@[to_additive]
+@[to_additive "If two monoid homomorphisms are equal on a set, then they are equal on its submonoid
+closure."]
 lemma eq_on_mclosure {f g : M →* N} {s : set M} (h : set.eq_on f g s) :
   set.eq_on f g (closure s) :=
 show closure s ≤ f.eq_mlocus g, from closure_le.2 h
@@ -495,24 +499,40 @@ namespace monoid_hom
 open submonoid
 
 /-- Let `s` be a subset of a monoid `M` such that the closure of `s` is the whole monoid.
-Then `monoid_hom.of_mdense` defines a monoid homomorphism from `M` asking for a proof
-of `f (x * y) = f x * f y` only for `y ∈ s`. -/
-@[to_additive]
-def of_mdense {M N} [monoid M] [monoid N] {s : set M} (f : M → N) (hs : closure s = ⊤)
-  (h1 : f 1 = 1) (hmul : ∀ x (y ∈ s), f (x * y) = f x * f y) :
+Then `monoid_hom.of_mclosure_eq_top_left` defines a monoid homomorphism from `M` asking for
+a proof of `f (x * y) = f x * f y` only for `x ∈ s`. -/
+@[to_additive "/-- Let `s` be a subset of an additive monoid `M` such that the closure of `s` is
+the whole monoid. Then `add_monoid_hom.of_mclosure_eq_top_left` defines an additive monoid
+homomorphism from `M` asking for a proof of `f (x + y) = f x + f y` only for `x ∈ s`. -/"]
+def of_mclosure_eq_top_left {M N} [monoid M] [monoid N] {s : set M} (f : M → N)
+  (hs : closure s = ⊤) (h1 : f 1 = 1) (hmul : ∀ (x ∈ s) y, f (x * y) = f x * f y) :
+  M →* N :=
+{ to_fun := f,
+  map_one' := h1,
+  map_mul' := λ x, dense_induction x hs hmul (λ y, by rw [one_mul, h1, one_mul]) $ λ a b ha hb y,
+    by rw [mul_assoc, ha, ha, hb, mul_assoc] }
+
+@[simp, norm_cast, to_additive] lemma coe_of_mclosure_eq_top_left (f : M → N) (hs : closure s = ⊤)
+  (h1 hmul) : ⇑(of_mclosure_eq_top_left f hs h1 hmul) = f :=
+rfl
+
+/-- Let `s` be a subset of a monoid `M` such that the closure of `s` is the whole monoid.
+Then `monoid_hom.of_mclosure_eq_top_right` defines a monoid homomorphism from `M` asking for
+a proof of `f (x * y) = f x * f y` only for `y ∈ s`. -/
+@[to_additive "/-- Let `s` be a subset of an additive monoid `M` such that the closure of `s` is
+the whole monoid. Then `add_monoid_hom.of_mclosure_eq_top_right` defines an additive monoid
+homomorphism from `M` asking for a proof of `f (x + y) = f x + f y` only for `y ∈ s`. -/"]
+def of_mclosure_eq_top_right {M N} [monoid M] [monoid N] {s : set M} (f : M → N)
+  (hs : closure s = ⊤) (h1 : f 1 = 1) (hmul : ∀ x (y ∈ s), f (x * y) = f x * f y) :
   M →* N :=
 { to_fun := f,
   map_one' := h1,
   map_mul' := λ x y, dense_induction y hs (λ y hy x, hmul x y hy) (by simp [h1])
     (λ y₁ y₂ h₁ h₂ x, by simp only [← mul_assoc, h₁, h₂]) x }
 
-/-- Let `s` be a subset of an additive monoid `M` such that the closure of `s` is the whole monoid.
-Then `add_monoid_hom.of_mdense` defines an additive monoid homomorphism from `M` asking for a proof
-of `f (x + y) = f x + f y` only for `y ∈ s`. -/
-add_decl_doc add_monoid_hom.of_mdense
-
-@[simp, norm_cast, to_additive] lemma coe_of_mdense (f : M → N) (hs : closure s = ⊤) (h1 hmul) :
-  ⇑(of_mdense f hs h1 hmul) = f := rfl
+@[simp, norm_cast, to_additive] lemma coe_of_mclosure_eq_top_right (f : M → N) (hs : closure s = ⊤)
+  (h1 hmul) : ⇑(of_mclosure_eq_top_right f hs h1 hmul) = f :=
+rfl
 
 end monoid_hom
 
diff --git a/src/group_theory/submonoid/center.lean b/src/group_theory/submonoid/center.lean
index 725ccc143d9df..5e101f7bb870f 100644
--- a/src/group_theory/submonoid/center.lean
+++ b/src/group_theory/submonoid/center.lean
@@ -5,11 +5,13 @@ Authors: Eric Wieser
 -/
 import group_theory.submonoid.operations
 import group_theory.subsemigroup.center
-import data.fintype.basic
 
 /-!
 # Centers of monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `submonoid.center`: the center of a monoid
@@ -33,18 +35,39 @@ def center : submonoid M :=
 
 @[to_additive] lemma coe_center : ↑(center M) = set.center M := rfl
 
+@[simp]
+lemma center_to_subsemigroup : (center M).to_subsemigroup = subsemigroup.center M := rfl
+
+lemma _root_.add_submonoid.center_to_add_subsemigroup (M) [add_monoid M] :
+  (add_submonoid.center M).to_add_subsemigroup = add_subsemigroup.center M := rfl
+
+attribute [to_additive add_submonoid.center_to_add_subsemigroup] submonoid.center_to_subsemigroup
+
 variables {M}
 
 @[to_additive] lemma mem_center_iff {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl
 
-instance decidable_mem_center [decidable_eq M] [fintype M] : decidable_pred (∈ center M) :=
-λ _, decidable_of_iff' _ mem_center_iff
+@[to_additive] instance decidable_mem_center (a) [decidable $ ∀ b : M, b * a = a * b] :
+  decidable (a ∈ center M) :=
+decidable_of_iff' _ mem_center_iff
 
 /-- The center of a monoid is commutative. -/
 instance : comm_monoid (center M) :=
 { mul_comm := λ a b, subtype.ext $ b.prop _,
   .. (center M).to_monoid }
 
+/-- The center of a monoid acts commutatively on that monoid. -/
+instance center.smul_comm_class_left : smul_comm_class (center M) M M :=
+{ smul_comm := λ m x y, (commute.left_comm (m.prop x) y).symm }
+
+/-- The center of a monoid acts commutatively on that monoid. -/
+instance center.smul_comm_class_right : smul_comm_class M (center M) M :=
+smul_comm_class.symm _ _ _
+
+/-! Note that `smul_comm_class (center M) (center M) M` is already implied by
+`submonoid.smul_comm_class_right` -/
+example : smul_comm_class (center M) (center M) M := by apply_instance
+
 end
 
 section
@@ -56,3 +79,6 @@ set_like.coe_injective (set.center_eq_univ M)
 end
 
 end submonoid
+
+-- Guard against import creep
+assert_not_exists finset
diff --git a/src/group_theory/submonoid/centralizer.lean b/src/group_theory/submonoid/centralizer.lean
index c3bac6cd6511c..23c2c3fb1e0e5 100644
--- a/src/group_theory/submonoid/centralizer.lean
+++ b/src/group_theory/submonoid/centralizer.lean
@@ -9,6 +9,9 @@ import group_theory.submonoid.center
 /-!
 # Centralizers of magmas and monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `submonoid.centralizer`: the centralizer of a subset of a monoid
@@ -32,19 +35,36 @@ def centralizer : submonoid M :=
 
 @[simp, norm_cast, to_additive] lemma coe_centralizer : ↑(centralizer S) = S.centralizer := rfl
 
+lemma centralizer_to_subsemigroup : (centralizer S).to_subsemigroup = subsemigroup.centralizer S :=
+rfl
+
+lemma _root_.add_submonoid.centralizer_to_add_subsemigroup {M} [add_monoid M] (S : set M) :
+  (add_submonoid.centralizer S).to_add_subsemigroup = add_subsemigroup.centralizer S :=
+rfl
+
+attribute [to_additive add_submonoid.centralizer_to_add_subsemigroup]
+  submonoid.centralizer_to_subsemigroup
+
 variables {S}
 
 @[to_additive] lemma mem_centralizer_iff {z : M} : z ∈ centralizer S ↔ ∀ g ∈ S, g * z = z * g :=
 iff.rfl
 
-@[to_additive] instance decidable_mem_centralizer [decidable_eq M] [fintype M]
-  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
-λ _, decidable_of_iff' _ mem_centralizer_iff
+@[to_additive] lemma center_le_centralizer (s) : center M ≤ centralizer s :=
+s.center_subset_centralizer
+
+@[to_additive] instance decidable_mem_centralizer (a) [decidable $ ∀ b ∈ S, b * a = a * b] :
+  decidable (a ∈ centralizer S) :=
+decidable_of_iff' _ mem_centralizer_iff
 
 @[to_additive]
 lemma centralizer_le (h : S ⊆ T) : centralizer T ≤ centralizer S :=
 set.centralizer_subset h
 
+@[simp, to_additive] lemma centralizer_eq_top_iff_subset {s : set M} :
+  centralizer s = ⊤ ↔ s ⊆ center M :=
+set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset
+
 variables (M)
 
 @[simp, to_additive]
@@ -54,3 +74,6 @@ set_like.ext' (set.centralizer_univ M)
 end
 
 end submonoid
+
+-- Guard against import creep
+assert_not_exists finset
diff --git a/src/group_theory/submonoid/default.lean b/src/group_theory/submonoid/default.lean
deleted file mode 100644
index da25bc98ded11..0000000000000
--- a/src/group_theory/submonoid/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import group_theory.submonoid.membership
diff --git a/src/group_theory/submonoid/inverses.lean b/src/group_theory/submonoid/inverses.lean
index 0f5fad76af0e1..c2ff17a5c081b 100644
--- a/src/group_theory/submonoid/inverses.lean
+++ b/src/group_theory/submonoid/inverses.lean
@@ -10,6 +10,9 @@ import group_theory.submonoid.pointwise
 
 # Submonoid of inverses
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a submonoid `N` of a monoid `M`, we define the submonoid `N.left_inv` as the submonoid of
 left inverses of `N`. When `M` is commutative, we may define `from_comm_left_inv : N.left_inv →* N`
 since the inverses are unique. When `N ≤ is_unit.submonoid M`, this is precisely
@@ -169,7 +172,7 @@ open_locale pointwise
 
 @[to_additive] lemma left_inv_eq_inv : S.left_inv = S⁻¹ :=
 submonoid.ext $ λ x,
-  ⟨λ h, submonoid.mem_inv.mpr ((inv_eq_of_mul_eq_one h.some_spec).symm ▸ h.some.prop),
+  ⟨λ h, submonoid.mem_inv.mpr ((inv_eq_of_mul_eq_one_right h.some_spec).symm ▸ h.some.prop),
     λ h, ⟨⟨_, h⟩, mul_right_inv _⟩⟩
 
 @[simp, to_additive] lemma from_left_inv_eq_inv (x : S.left_inv) :
diff --git a/src/group_theory/submonoid/membership.lean b/src/group_theory/submonoid/membership.lean
index b0cf537610c25..d25b78b2e4ce6 100644
--- a/src/group_theory/submonoid/membership.lean
+++ b/src/group_theory/submonoid/membership.lean
@@ -6,12 +6,15 @@ Amelia Livingston, Yury Kudryashov
 -/
 import group_theory.submonoid.operations
 import algebra.big_operators.basic
-import algebra.free_monoid
+import algebra.free_monoid.basic
 import data.finset.noncomm_prod
 
 /-!
 # Submonoids: membership criteria
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove various facts about membership in a submonoid:
 
 * `list_prod_mem`, `multiset_prod_mem`, `prod_mem`: if each element of a collection belongs
@@ -109,8 +112,7 @@ lemma multiset_prod_mem {M} [comm_monoid M] (S : submonoid M) (m : multiset M)
 by { lift m to multiset S using hm, rw ← coe_multiset_prod, exact m.prod.coe_prop }
 
 @[to_additive]
-lemma multiset_noncomm_prod_mem (S : submonoid M) (m : multiset M)
-  (comm : ∀ (x ∈ m) (y ∈ m), commute x y) (h : ∀ (x ∈ m), x ∈ S) :
+lemma multiset_noncomm_prod_mem (S : submonoid M) (m : multiset M) (comm) (h : ∀ (x ∈ m), x ∈ S) :
   m.noncomm_prod comm ∈ S :=
 begin
   induction m using quotient.induction_on with l,
@@ -128,8 +130,8 @@ lemma prod_mem {M : Type*} [comm_monoid M] (S : submonoid M)
 S.multiset_prod_mem (t.1.map f) $ λ x hx, let ⟨i, hi, hix⟩ := multiset.mem_map.1 hx in hix ▸ h i hi
 
 @[to_additive]
-lemma noncomm_prod_mem (S : submonoid M) {ι : Type*} (t : finset ι) (f : ι → M)
-  (comm : ∀ (x ∈ t) (y ∈ t), commute (f x) (f y)) (h : ∀ c ∈ t, f c ∈ S) :
+lemma noncomm_prod_mem (S : submonoid M) {ι : Type*} (t : finset ι) (f : ι → M) (comm)
+  (h : ∀ c ∈ t, f c ∈ S) :
   t.noncomm_prod f comm ∈ S :=
 begin
   apply multiset_noncomm_prod_mem,
@@ -280,16 +282,20 @@ mem_closure_singleton.2 ⟨1, pow_one y⟩
 lemma closure_singleton_one : closure ({1} : set M) = ⊥ :=
 by simp [eq_bot_iff_forall, mem_closure_singleton]
 
+@[to_additive] lemma _root_.free_monoid.mrange_lift {α} (f : α → M) :
+  (free_monoid.lift f).mrange = closure (set.range f) :=
+by rw [mrange_eq_map, ← free_monoid.closure_range_of, map_mclosure, ← set.range_comp,
+  free_monoid.lift_comp_of]
+
 @[to_additive]
 lemma closure_eq_mrange (s : set M) : closure s = (free_monoid.lift (coe : s → M)).mrange :=
-by rw [mrange_eq_map, ← free_monoid.closure_range_of, map_mclosure, ← set.range_comp,
-  free_monoid.lift_comp_of, subtype.range_coe]
+by rw [free_monoid.mrange_lift, subtype.range_coe]
 
 @[to_additive] lemma closure_eq_image_prod (s : set M) :
   (closure s : set M) = list.prod '' {l : list M | ∀ x ∈ l, x ∈ s} :=
 begin
-  rw [closure_eq_mrange, coe_mrange, ← list.range_map_coe, ← set.range_comp],
-  refl
+  rw [closure_eq_mrange, coe_mrange, ← set.range_list_map_coe, ← set.range_comp],
+  exact congr_arg _ (funext $ free_monoid.lift_apply _)
 end
 
 @[to_additive]
@@ -316,6 +322,11 @@ begin
   { simpa only [map_mul, free_monoid.lift_eval_of] using Hmul _ x.prop _ ih }
 end
 
+@[elab_as_eliminator, to_additive]
+lemma induction_of_closure_eq_top_left {s : set M} {p : M → Prop} (hs : closure s = ⊤) (x : M)
+  (H1 : p 1) (Hmul : ∀ (x ∈ s) y, p y → p (x * y)) : p x :=
+closure_induction_left (by { rw [hs], exact mem_top _ }) H1 Hmul
+
 @[to_additive]
 lemma closure_induction_right {s : set M} {p : M → Prop} {x : M} (h : x ∈ closure s) (H1 : p 1)
   (Hmul : ∀ x (y ∈ s), p x → p (x * y)) : p x :=
@@ -323,6 +334,11 @@ lemma closure_induction_right {s : set M} {p : M → Prop} {x : M} (h : x ∈ cl
   (closure_induction h (λ x hx, subset_closure hx) (one_mem _) (λ x y hx hy, mul_mem hy hx))
   H1 (λ x hx y, Hmul _ _ hx)
 
+@[elab_as_eliminator, to_additive]
+lemma induction_of_closure_eq_top_right {s : set M} {p : M → Prop} (hs : closure s = ⊤) (x : M)
+  (H1 : p 1) (Hmul : ∀ x (y ∈ s), p x → p (x * y)) : p x :=
+closure_induction_right (by { rw [hs], exact mem_top _ }) H1 Hmul
+
 /-- The submonoid generated by an element. -/
 def powers (n : M) : submonoid M :=
 submonoid.copy (powers_hom M n).mrange (set.range ((^) n : ℕ → M)) $
@@ -330,6 +346,8 @@ set.ext (λ n, exists_congr $ λ i, by simp; refl)
 
 @[simp] lemma mem_powers (n : M) : n ∈ powers n := ⟨1, pow_one _⟩
 
+@[norm_cast] lemma coe_powers (x : M) : ↑(powers x) = set.range (λ n : ℕ, x ^ n) := rfl
+
 lemma mem_powers_iff (x z : M) : x ∈ powers z ↔ ∃ n : ℕ, z ^ n = x := iff.rfl
 
 lemma powers_eq_closure (n : M) : powers n = closure {n} :=
@@ -338,6 +356,8 @@ by { ext, exact mem_closure_singleton.symm }
 lemma powers_subset {n : M} {P : submonoid M} (h : n ∈ P) : powers n ≤ P :=
 λ x hx, match x, hx with _, ⟨i, rfl⟩ := pow_mem h i end
 
+@[simp] lemma powers_one : powers (1 : M) = ⊥ := bot_unique $ powers_subset (one_mem _)
+
 /-- Exponentiation map from natural numbers to powers. -/
 @[simps] def pow (n : M) (m : ℕ) : powers n :=
 (powers_hom M n).mrange_restrict (multiplicative.of_add m)
@@ -376,29 +396,46 @@ lemma log_mul [decidable_eq M] {n : M} (h : function.injective (λ m : ℕ, n ^
 theorem log_pow_int_eq_self {x : ℤ} (h : 1 < x.nat_abs) (m : ℕ) : log (pow x m) = m :=
 (pow_log_equiv (int.pow_right_injective h)).symm_apply_apply _
 
-@[simp] lemma map_powers {N : Type*} [monoid N] (f : M →* N) (m : M) :
-  (powers m).map f = powers (f m) :=
-by simp only [powers_eq_closure, f.map_mclosure, set.image_singleton]
+@[simp] lemma map_powers {N : Type*} {F : Type*} [monoid N] [monoid_hom_class F M N]
+  (f : F) (m : M) : (powers m).map f = powers (f m) :=
+by simp only [powers_eq_closure, map_mclosure f, set.image_singleton]
 
 /-- If all the elements of a set `s` commute, then `closure s` is a commutative monoid. -/
 @[to_additive "If all the elements of a set `s` commute, then `closure s` forms an additive
 commutative monoid."]
-def closure_comm_monoid_of_comm {s : set M} (hcomm : ∀ (a ∈ s) (b ∈ s), a * b = b * a) :
+def closure_comm_monoid_of_comm {s : set M} (hcomm : ∀ a b ∈ s, a * b = b * a) :
   comm_monoid (closure s) :=
 { mul_comm := λ x y,
   begin
     ext,
     simp only [submonoid.coe_mul],
-    exact closure_induction₂ x.prop y.prop hcomm
-      (λ x, by simp only [mul_one, one_mul])
-      (λ x, by simp only [mul_one, one_mul])
-      (λ x y z h₁ h₂, by rw [mul_assoc, h₂, ←mul_assoc, h₁, mul_assoc])
-      (λ x y z h₁ h₂, by rw [←mul_assoc, h₁, mul_assoc, h₂, ←mul_assoc]),
+    exact closure_induction₂ x.prop y.prop hcomm commute.one_left commute.one_right
+      (λ x y z, commute.mul_left) (λ x y z, commute.mul_right),
   end,
-  ..(closure s).to_monoid }
+  .. (closure s).to_monoid }
 
 end submonoid
 
+@[to_additive] lemma is_scalar_tower.of_mclosure_eq_top {N α} [monoid M] [mul_action M N]
+  [has_smul N α] [mul_action M α] {s : set M} (htop : submonoid.closure s = ⊤)
+  (hs : ∀ (x ∈ s) (y : N) (z : α), (x • y) • z = x • (y • z)) :
+  is_scalar_tower M N α :=
+begin
+  refine ⟨λ x, submonoid.induction_of_closure_eq_top_left htop x _ _⟩,
+  { intros y z, rw [one_smul, one_smul] },
+  { clear x, intros x hx x' hx' y z, rw [mul_smul, mul_smul, hs x hx, hx'] }
+end
+
+@[to_additive] lemma smul_comm_class.of_mclosure_eq_top {N α} [monoid M]
+  [has_smul N α] [mul_action M α] {s : set M} (htop : submonoid.closure s = ⊤)
+  (hs : ∀ (x ∈ s) (y : N) (z : α), x • y • z = y • x • z) :
+  smul_comm_class M N α :=
+begin
+  refine ⟨λ x, submonoid.induction_of_closure_eq_top_left htop x _ _⟩,
+  { intros y z, rw [one_smul, one_smul] },
+  { clear x, intros x hx x' hx' y z, rw [mul_smul, mul_smul, hx', hs x hx] }
+end
+
 namespace submonoid
 
 variables {N : Type*} [comm_monoid N]
@@ -442,21 +479,13 @@ def multiples (x : A) : add_submonoid A :=
 add_submonoid.copy (multiples_hom A x).mrange (set.range (λ i, i • x : ℕ → A)) $
 set.ext (λ n, exists_congr $ λ i, by simp; refl)
 
-@[simp] lemma mem_multiples (x : A) : x ∈ multiples x := ⟨1, one_nsmul _⟩
-
-lemma mem_multiples_iff (x z : A) : x ∈ multiples z ↔ ∃ n : ℕ, n • z = x := iff.rfl
-
-lemma multiples_eq_closure (x : A) : multiples x = closure {x} :=
-by { ext, exact mem_closure_singleton.symm }
-
-lemma multiples_subset {x : A} {P : add_submonoid A} (h : x ∈ P) : multiples x ≤ P :=
-λ x hx, match x, hx with _, ⟨i, rfl⟩ := nsmul_mem h i end
-
-attribute [to_additive add_submonoid.multiples] submonoid.powers
-attribute [to_additive add_submonoid.mem_multiples] submonoid.mem_powers
-attribute [to_additive add_submonoid.mem_multiples_iff] submonoid.mem_powers_iff
-attribute [to_additive add_submonoid.multiples_eq_closure] submonoid.powers_eq_closure
-attribute [to_additive add_submonoid.multiples_subset] submonoid.powers_subset
+attribute [to_additive multiples] submonoid.powers
+attribute [to_additive mem_multiples] submonoid.mem_powers
+attribute [to_additive coe_multiples] submonoid.coe_powers
+attribute [to_additive mem_multiples_iff] submonoid.mem_powers_iff
+attribute [to_additive multiples_eq_closure] submonoid.powers_eq_closure
+attribute [to_additive multiples_subset] submonoid.powers_subset
+attribute [to_additive multiples_zero] submonoid.powers_one
 
 end add_submonoid
 
diff --git a/src/group_theory/submonoid/operations.lean b/src/group_theory/submonoid/operations.lean
index 22b580214bbbb..6226d6e25dc76 100644
--- a/src/group_theory/submonoid/operations.lean
+++ b/src/group_theory/submonoid/operations.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
 Amelia Livingston, Yury Kudryashov
 -/
+import algebra.order.monoid.cancel.basic
 import group_theory.group_action.defs
 import group_theory.submonoid.basic
 import group_theory.subsemigroup.operations
@@ -11,6 +12,9 @@ import group_theory.subsemigroup.operations
 /-!
 # Operations on `submonoid`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define various operations on `submonoid`s and `monoid_hom`s.
 
 ## Main definitions
@@ -52,8 +56,8 @@ In this file we define various operations on `submonoid`s and `monoid_hom`s.
 
 * `monoid_hom.mrange`: range of a monoid homomorphism as a submonoid of the codomain;
 * `monoid_hom.mker`: kernel of a monoid homomorphism as a submonoid of the domain;
-* `monoid_hom.mrestrict`: restrict a monoid homomorphism to a submonoid;
-* `monoid_hom.cod_mrestrict`: restrict the codomain of a monoid homomorphism to a submonoid;
+* `monoid_hom.restrict`: restrict a monoid homomorphism to a submonoid;
+* `monoid_hom.cod_restrict`: restrict the codomain of a monoid homomorphism to a submonoid;
 * `monoid_hom.mrange_restrict`: restrict a monoid homomorphism to its range;
 
 ## Tags
@@ -75,11 +79,11 @@ def submonoid.to_add_submonoid : submonoid M ≃o add_submonoid (additive M) :=
 { to_fun := λ S,
   { carrier := additive.to_mul ⁻¹' S,
     zero_mem' := S.one_mem',
-    add_mem' := S.mul_mem' },
+    add_mem' := λ _ _, S.mul_mem' },
   inv_fun := λ S,
   { carrier := additive.of_mul ⁻¹' S,
     one_mem' := S.zero_mem',
-    mul_mem' := S.add_mem' },
+    mul_mem' := λ _ _, S.add_mem' },
   left_inv := λ x, by cases x; refl,
   right_inv := λ x, by cases x; refl,
   map_rel_iff' := λ a b, iff.rfl, }
@@ -115,11 +119,11 @@ def add_submonoid.to_submonoid : add_submonoid A ≃o submonoid (multiplicative
 { to_fun := λ S,
   { carrier := multiplicative.to_add ⁻¹' S,
     one_mem' := S.zero_mem',
-    mul_mem' := S.add_mem' },
+    mul_mem' := λ _ _, S.add_mem' },
   inv_fun := λ S,
   { carrier := multiplicative.of_add ⁻¹' S,
     zero_mem' := S.one_mem',
-    add_mem' := S.mul_mem' },
+    add_mem' := λ _ _, S.mul_mem' },
   left_inv := λ x, by cases x; refl,
   right_inv := λ x, by cases x; refl,
   map_rel_iff' := λ a b, iff.rfl, }
@@ -145,6 +149,7 @@ le_antisymm
 end
 
 namespace submonoid
+variables {F : Type*} [mc : monoid_hom_class F M N]
 
 open set
 
@@ -152,20 +157,22 @@ open set
 ### `comap` and `map`
 -/
 
+include mc
 /-- The preimage of a submonoid along a monoid homomorphism is a submonoid. -/
 @[to_additive "The preimage of an `add_submonoid` along an `add_monoid` homomorphism is an
 `add_submonoid`."]
-def comap (f : M →* N) (S : submonoid N) : submonoid M :=
+def comap (f : F) (S : submonoid N) : submonoid M :=
 { carrier := (f ⁻¹' S),
-  one_mem' := show f 1 ∈ S, by rw f.map_one; exact S.one_mem,
+  one_mem' := show f 1 ∈ S, by rw map_one; exact S.one_mem,
   mul_mem' := λ a b ha hb,
-    show f (a * b) ∈ S, by rw f.map_mul; exact S.mul_mem ha hb }
+    show f (a * b) ∈ S, by rw map_mul; exact S.mul_mem ha hb }
 
 @[simp, to_additive]
-lemma coe_comap (S : submonoid N) (f : M →* N) : (S.comap f : set M) = f ⁻¹' S := rfl
+lemma coe_comap (S : submonoid N) (f : F) : (S.comap f : set M) = f ⁻¹' S := rfl
 
 @[simp, to_additive]
-lemma mem_comap {S : submonoid N} {f : M →* N} {x : M} : x ∈ S.comap f ↔ f x ∈ S := iff.rfl
+lemma mem_comap {S : submonoid N} {f : F} {x : M} : x ∈ S.comap f ↔ f x ∈ S := iff.rfl
+omit mc
 
 @[to_additive]
 lemma comap_comap (S : submonoid P) (g : N →* P) (f : M →* N) :
@@ -173,115 +180,119 @@ lemma comap_comap (S : submonoid P) (g : N →* P) (f : M →* N) :
 rfl
 
 @[simp, to_additive]
-lemma comap_id (S : submonoid P) : S.comap (monoid_hom.id _) = S :=
+lemma comap_id (S : submonoid P) : S.comap (monoid_hom.id P) = S :=
 ext (by simp)
 
+include mc
 /-- The image of a submonoid along a monoid homomorphism is a submonoid. -/
 @[to_additive "The image of an `add_submonoid` along an `add_monoid` homomorphism is
 an `add_submonoid`."]
-def map (f : M →* N) (S : submonoid M) : submonoid N :=
+def map (f : F) (S : submonoid M) : submonoid N :=
 { carrier := (f '' S),
-  one_mem' := ⟨1, S.one_mem, f.map_one⟩,
+  one_mem' := ⟨1, S.one_mem, map_one f⟩,
   mul_mem' := begin rintros _ _ ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩, exact ⟨x * y, S.mul_mem hx hy,
-    by rw f.map_mul; refl⟩ end }
+    by rw map_mul; refl⟩ end }
 
 @[simp, to_additive]
-lemma coe_map (f : M →* N) (S : submonoid M) :
+lemma coe_map (f : F) (S : submonoid M) :
   (S.map f : set N) = f '' S := rfl
 
 @[simp, to_additive]
-lemma mem_map {f : M →* N} {S : submonoid M} {y : N} :
+lemma mem_map {f : F} {S : submonoid M} {y : N} :
   y ∈ S.map f ↔ ∃ x ∈ S, f x = y :=
 mem_image_iff_bex
 
 @[to_additive]
-lemma mem_map_of_mem (f : M →* N) {S : submonoid M} {x : M} (hx : x ∈ S) : f x ∈ S.map f :=
+lemma mem_map_of_mem (f : F) {S : submonoid M} {x : M} (hx : x ∈ S) : f x ∈ S.map f :=
 mem_image_of_mem f hx
 
 @[to_additive]
-lemma apply_coe_mem_map (f : M →* N) (S : submonoid M) (x : S) : f x ∈ S.map f :=
+lemma apply_coe_mem_map (f : F) (S : submonoid M) (x : S) : f x ∈ S.map f :=
 mem_map_of_mem f x.prop
+omit mc
 
 @[to_additive]
 lemma map_map (g : N →* P) (f : M →* N) : (S.map f).map g = S.map (g.comp f) :=
 set_like.coe_injective $ image_image _ _ _
 
+include mc
 @[to_additive]
-lemma mem_map_iff_mem {f : M →* N} (hf : function.injective f) {S : submonoid M} {x : M} :
+lemma mem_map_iff_mem {f : F} (hf : function.injective f) {S : submonoid M} {x : M} :
   f x ∈ S.map f ↔ x ∈ S :=
 hf.mem_set_image
 
 @[to_additive]
-lemma map_le_iff_le_comap {f : M →* N} {S : submonoid M} {T : submonoid N} :
+lemma map_le_iff_le_comap {f : F} {S : submonoid M} {T : submonoid N} :
   S.map f ≤ T ↔ S ≤ T.comap f :=
 image_subset_iff
 
 @[to_additive]
-lemma gc_map_comap (f : M →* N) : galois_connection (map f) (comap f) :=
+lemma gc_map_comap (f : F) : galois_connection (map f) (comap f) :=
 λ S T, map_le_iff_le_comap
 
 @[to_additive]
-lemma map_le_of_le_comap {T : submonoid N} {f : M →* N} : S ≤ T.comap f → S.map f ≤ T :=
+lemma map_le_of_le_comap {T : submonoid N} {f : F} : S ≤ T.comap f → S.map f ≤ T :=
 (gc_map_comap f).l_le
 
 @[to_additive]
-lemma le_comap_of_map_le {T : submonoid N} {f : M →* N} : S.map f ≤ T → S ≤ T.comap f :=
+lemma le_comap_of_map_le {T : submonoid N} {f : F} : S.map f ≤ T → S ≤ T.comap f :=
 (gc_map_comap f).le_u
 
 @[to_additive]
-lemma le_comap_map {f : M →* N} : S ≤ (S.map f).comap f :=
+lemma le_comap_map {f : F} : S ≤ (S.map f).comap f :=
 (gc_map_comap f).le_u_l _
 
 @[to_additive]
-lemma map_comap_le {S : submonoid N} {f : M →* N} : (S.comap f).map f ≤ S :=
+lemma map_comap_le {S : submonoid N} {f : F} : (S.comap f).map f ≤ S :=
 (gc_map_comap f).l_u_le _
 
 @[to_additive]
-lemma monotone_map {f : M →* N} : monotone (map f) :=
+lemma monotone_map {f : F} : monotone (map f) :=
 (gc_map_comap f).monotone_l
 
 @[to_additive]
-lemma monotone_comap {f : M →* N} : monotone (comap f) :=
+lemma monotone_comap {f : F} : monotone (comap f) :=
 (gc_map_comap f).monotone_u
 
 @[simp, to_additive]
-lemma map_comap_map {f : M →* N} : ((S.map f).comap f).map f = S.map f :=
+lemma map_comap_map {f : F} : ((S.map f).comap f).map f = S.map f :=
 (gc_map_comap f).l_u_l_eq_l _
 
 @[simp, to_additive]
-lemma comap_map_comap {S : submonoid N} {f : M →* N} : ((S.comap f).map f).comap f = S.comap f :=
+lemma comap_map_comap {S : submonoid N} {f : F} : ((S.comap f).map f).comap f = S.comap f :=
 (gc_map_comap f).u_l_u_eq_u _
 
 @[to_additive]
-lemma map_sup (S T : submonoid M) (f : M →* N) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
-(gc_map_comap f).l_sup
+lemma map_sup (S T : submonoid M) (f : F) : (S ⊔ T).map f = S.map f ⊔ T.map f :=
+(gc_map_comap f : galois_connection (map f) (comap f)).l_sup
 
 @[to_additive]
-lemma map_supr {ι : Sort*} (f : M →* N) (s : ι → submonoid M) :
+lemma map_supr {ι : Sort*} (f : F) (s : ι → submonoid M) :
   (supr s).map f = ⨆ i, (s i).map f :=
-(gc_map_comap f).l_supr
+(gc_map_comap f : galois_connection (map f) (comap f)).l_supr
 
 @[to_additive]
-lemma comap_inf (S T : submonoid N) (f : M →* N) : (S ⊓ T).comap f = S.comap f ⊓ T.comap f :=
-(gc_map_comap f).u_inf
+lemma comap_inf (S T : submonoid N) (f : F) : (S ⊓ T).comap f = S.comap f ⊓ T.comap f :=
+(gc_map_comap f : galois_connection (map f) (comap f)).u_inf
 
 @[to_additive]
-lemma comap_infi {ι : Sort*} (f : M →* N) (s : ι → submonoid N) :
+lemma comap_infi {ι : Sort*} (f : F) (s : ι → submonoid N) :
   (infi s).comap f = ⨅ i, (s i).comap f :=
-(gc_map_comap f).u_infi
+(gc_map_comap f : galois_connection (map f) (comap f)).u_infi
 
-@[simp, to_additive] lemma map_bot (f : M →* N) : (⊥ : submonoid M).map f = ⊥ :=
+@[simp, to_additive] lemma map_bot (f : F) : (⊥ : submonoid M).map f = ⊥ :=
 (gc_map_comap f).l_bot
 
-@[simp, to_additive] lemma comap_top (f : M →* N) : (⊤ : submonoid N).comap f = ⊤ :=
+@[simp, to_additive] lemma comap_top (f : F) : (⊤ : submonoid N).comap f = ⊤ :=
 (gc_map_comap f).u_top
+omit mc
 
 @[simp, to_additive] lemma map_id (S : submonoid M) : S.map (monoid_hom.id M) = S :=
 ext (λ x, ⟨λ ⟨_, h, rfl⟩, h, λ h, ⟨_, h, rfl⟩⟩)
 
 section galois_coinsertion
 
-variables {ι : Type*} {f : M →* N} (hf : function.injective f)
+variables {ι : Type*} {f : F} (hf : function.injective f)
 
 include hf
 
@@ -331,7 +342,7 @@ end galois_coinsertion
 
 section galois_insertion
 
-variables {ι : Type*} {f : M →* N} (hf : function.surjective f)
+variables {ι : Type*} {f : F} (hf : function.surjective f)
 
 include hf
 
@@ -381,30 +392,34 @@ end galois_insertion
 
 end submonoid
 
-namespace submonoid_class
+namespace one_mem_class
 
-variables {A : Type*} [set_like A M] [hA : submonoid_class A M] (S' : A)
+variables {A M₁ : Type*} [set_like A M₁] [has_one M₁] [hA : one_mem_class A M₁] (S' : A)
 include hA
 
 /-- A submonoid of a monoid inherits a 1. -/
 @[to_additive "An `add_submonoid` of an `add_monoid` inherits a zero."]
-instance has_one : has_one S' := ⟨⟨_, one_mem S'⟩⟩
+instance has_one : has_one S' := ⟨⟨1, one_mem_class.one_mem S'⟩⟩
 
-@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S') : M) = 1 := rfl
+@[simp, norm_cast, to_additive] lemma coe_one : ((1 : S') : M₁) = 1 := rfl
 
 variables {S'}
-@[simp, norm_cast, to_additive] lemma coe_eq_one {x : S'} : (↑x : M) = 1 ↔ x = 1 :=
-(subtype.ext_iff.symm : (x : M) = (1 : S') ↔ x = 1)
+@[simp, norm_cast, to_additive] lemma coe_eq_one {x : S'} : (↑x : M₁) = 1 ↔ x = 1 :=
+(subtype.ext_iff.symm : (x : M₁) = (1 : S') ↔ x = 1)
 variables (S')
 
-@[to_additive] lemma one_def : (1 : S') = ⟨1, one_mem S'⟩ := rfl
+@[to_additive] lemma one_def : (1 : S') = ⟨1, one_mem_class.one_mem S'⟩ := rfl
+
+end one_mem_class
+
+namespace submonoid_class
 
-omit hA
+variables {A : Type*} [set_like A M] [hA : submonoid_class A M] (S' : A)
 
 /-- An `add_submonoid` of an `add_monoid` inherits a scalar multiplication. -/
 instance _root_.add_submonoid_class.has_nsmul {M} [add_monoid M] {A : Type*} [set_like A M]
   [add_submonoid_class A M] (S : A) :
-  has_scalar ℕ S :=
+  has_smul ℕ S :=
 ⟨λ n a, ⟨n • a.1, nsmul_mem a.2 n⟩⟩
 
 /-- A submonoid of a monoid inherits a power operator. -/
@@ -464,6 +479,7 @@ instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] {A : T
   [set_like A M] [submonoid_class A M] (S : A) :
   linear_ordered_comm_monoid S :=
 subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl)
 
 /-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
 @[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
@@ -482,6 +498,7 @@ priority 75] -- Prefer subclasses of `monoid` over subclasses of `submonoid_clas
 instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
   {A : Type*} [set_like A M] [submonoid_class A M] (S : A) : linear_ordered_cancel_comm_monoid S :=
 subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl)
 
 include hA
 
@@ -550,7 +567,8 @@ subtype.coe_injective.ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
 a `linear_ordered_add_comm_monoid`."]
 instance to_linear_ordered_comm_monoid {M} [linear_ordered_comm_monoid M] (S : submonoid M) :
   linear_ordered_comm_monoid S :=
-subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.linear_ordered_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 /-- A submonoid of an `ordered_cancel_comm_monoid` is an `ordered_cancel_comm_monoid`. -/
 @[to_additive "An `add_submonoid` of an `ordered_cancel_add_comm_monoid` is
@@ -566,6 +584,7 @@ a `linear_ordered_cancel_add_comm_monoid`."]
 instance to_linear_ordered_cancel_comm_monoid {M} [linear_ordered_cancel_comm_monoid M]
   (S : submonoid M) : linear_ordered_cancel_comm_monoid S :=
 subtype.coe_injective.linear_ordered_cancel_comm_monoid coe rfl (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl)
 
 /-- The natural monoid hom from a submonoid of monoid `M` to `M`. -/
 @[to_additive "The natural monoid hom from an `add_submonoid` of `add_monoid` `M` to `M`."]
@@ -586,8 +605,10 @@ def top_equiv : (⊤ : submonoid M) ≃* M :=
   (top_equiv : _ ≃* M).to_monoid_hom = (⊤ : submonoid M).subtype :=
 rfl
 
-/-- A submonoid is isomorphic to its image under an injective function -/
-@[to_additive "An additive submonoid is isomorphic to its image under an injective function"]
+/-- A subgroup is isomorphic to its image under an injective function. If you have an isomorphism,
+use `mul_equiv.submonoid_map` for better definitional equalities. -/
+@[to_additive  "An additive subgroup is isomorphic to its image under an injective function. If you
+have an isomorphism, use `add_equiv.add_submonoid_map` for better definitional equalities."]
 noncomputable def equiv_map_of_injective
   (f : M →* N) (hf : function.injective f) : S ≃* S.map f :=
 { map_mul' := λ _ _, subtype.ext (f.map_mul _ _), ..equiv.set.image f S hf }
@@ -610,14 +631,12 @@ of `M × N`. -/
 @[to_additive prod "Given `add_submonoid`s `s`, `t` of `add_monoid`s `A`, `B` respectively, `s × t`
 as an `add_submonoid` of `A × B`."]
 def prod (s : submonoid M) (t : submonoid N) : submonoid (M × N) :=
-{ carrier := (s : set M) ×ˢ (t : set N),
+{ carrier := s ×ˢ t,
   one_mem' := ⟨s.one_mem, t.one_mem⟩,
   mul_mem' := λ p q hp hq, ⟨s.mul_mem hp.1 hq.1, t.mul_mem hp.2 hq.2⟩ }
 
 @[to_additive coe_prod]
-lemma coe_prod (s : submonoid M) (t : submonoid N) :
- (s.prod t : set (M × N)) = (s : set M) ×ˢ (t : set N) :=
-rfl
+lemma coe_prod (s : submonoid M) (t : submonoid N) : (s.prod t : set (M × N)) = s ×ˢ t := rfl
 
 @[to_additive mem_prod]
 lemma mem_prod {s : submonoid M} {t : submonoid N} {p : M × N} :
@@ -720,6 +739,7 @@ end
 end submonoid
 
 namespace monoid_hom
+variables {F : Type*} [mc : monoid_hom_class F M N]
 
 open submonoid
 
@@ -754,40 +774,43 @@ def mrange (f : M →* N) : submonoid N :=
 -/
 library_note "range copy pattern"
 
+include mc
 /-- The range of a monoid homomorphism is a submonoid. See Note [range copy pattern]. -/
 @[to_additive "The range of an `add_monoid_hom` is an `add_submonoid`."]
-def mrange (f : M →* N) : submonoid N :=
+def mrange (f : F) : submonoid N :=
 ((⊤ : submonoid M).map f).copy (set.range f) set.image_univ.symm
 
 @[simp, to_additive]
-lemma coe_mrange (f : M →* N) :
-  (f.mrange : set N) = set.range f :=
+lemma coe_mrange (f : F) :
+  (mrange f : set N) = set.range f :=
 rfl
 
-@[simp, to_additive] lemma mem_mrange {f : M →* N} {y : N} :
-  y ∈ f.mrange ↔ ∃ x, f x = y :=
+@[simp, to_additive] lemma mem_mrange {f : F} {y : N} :
+  y ∈ mrange f ↔ ∃ x, f x = y :=
 iff.rfl
 
-@[to_additive] lemma mrange_eq_map (f : M →* N) : f.mrange = (⊤ : submonoid M).map f :=
-copy_eq _
+@[to_additive] lemma mrange_eq_map (f : F) : mrange f = (⊤ : submonoid M).map f :=
+submonoid.copy_eq _
+omit mc
 
 @[to_additive]
 lemma map_mrange (g : N →* P) (f : M →* N) : f.mrange.map g = (g.comp f).mrange :=
 by simpa only [mrange_eq_map] using (⊤ : submonoid M).map_map g f
 
+include mc
 @[to_additive]
-lemma mrange_top_iff_surjective {N} [mul_one_class N] {f : M →* N} :
-  f.mrange = (⊤ : submonoid N) ↔ function.surjective f :=
+lemma mrange_top_iff_surjective {f : F} :
+  mrange f = (⊤ : submonoid N) ↔ function.surjective f :=
 set_like.ext'_iff.trans $ iff.trans (by rw [coe_mrange, coe_top]) set.range_iff_surjective
 
 /-- The range of a surjective monoid hom is the whole of the codomain. -/
 @[to_additive "The range of a surjective `add_monoid` hom is the whole of the codomain."]
-lemma mrange_top_of_surjective {N} [mul_one_class N] (f : M →* N) (hf : function.surjective f) :
-  f.mrange = (⊤ : submonoid N) :=
+lemma mrange_top_of_surjective (f : F) (hf : function.surjective f) :
+  mrange f = (⊤ : submonoid N) :=
 mrange_top_iff_surjective.2 hf
 
 @[to_additive]
-lemma mclosure_preimage_le (f : M →* N) (s : set N) :
+lemma mclosure_preimage_le (f : F) (s : set N) :
   closure (f ⁻¹' s) ≤ (closure s).comap f :=
 closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx
 
@@ -795,25 +818,34 @@ closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx
     by the image of the set. -/
 @[to_additive "The image under an `add_monoid` hom of the `add_submonoid` generated by a set equals
 the `add_submonoid` generated by the image of the set."]
-lemma map_mclosure (f : M →* N) (s : set M) :
+lemma map_mclosure (f : F) (s : set M) :
   (closure s).map f = closure (f '' s) :=
 le_antisymm
   (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
     (mclosure_preimage_le _ _))
   (closure_le.2 $ set.image_subset _ subset_closure)
+omit mc
 
 /-- Restriction of a monoid hom to a submonoid of the domain. -/
 @[to_additive "Restriction of an add_monoid hom to an `add_submonoid` of the domain."]
-def mrestrict {N : Type*} [mul_one_class N] (f : M →* N) (S : submonoid M) : S →* N :=
-f.comp S.subtype
+def restrict {N S : Type*} [mul_one_class N] [set_like S M] [submonoid_class S M]
+  (f : M →* N) (s : S) : s →* N :=
+f.comp (submonoid_class.subtype _)
 
 @[simp, to_additive]
-lemma mrestrict_apply {N : Type*} [mul_one_class N] (f : M →* N) (x : S) : f.mrestrict S x = f x :=
+lemma restrict_apply {N S : Type*} [mul_one_class N] [set_like S M] [submonoid_class S M]
+  (f : M →* N) (s : S) (x : s) : f.restrict s x = f x :=
 rfl
 
+@[simp, to_additive] lemma restrict_mrange (f : M →* N) : (f.restrict S).mrange = S.map f :=
+by simp_rw [set_like.ext_iff, mem_mrange, mem_map, restrict_apply, set_like.exists, subtype.coe_mk,
+  iff_self, forall_const]
+
 /-- Restriction of a monoid hom to a submonoid of the codomain. -/
-@[to_additive "Restriction of an `add_monoid` hom to an `add_submonoid` of the codomain.", simps]
-def cod_mrestrict (f : M →* N) (S : submonoid N) (h : ∀ x, f x ∈ S) : M →* S :=
+@[to_additive "Restriction of an `add_monoid` hom to an `add_submonoid` of the codomain.",
+  simps apply]
+def cod_restrict {S} [set_like S N] [submonoid_class S N] (f : M →* N) (s : S)
+  (h : ∀ x, f x ∈ s) : M →* s :=
 { to_fun := λ n, ⟨f n, h n⟩,
   map_one' := subtype.eq f.map_one,
   map_mul' := λ x y, subtype.eq (f.map_mul x y) }
@@ -821,7 +853,7 @@ def cod_mrestrict (f : M →* N) (S : submonoid N) (h : ∀ x, f x ∈ S) : M 
 /-- Restriction of a monoid hom to its range interpreted as a submonoid. -/
 @[to_additive "Restriction of an `add_monoid` hom to its range interpreted as a submonoid."]
 def mrange_restrict {N} [mul_one_class N] (f : M →* N) : M →* f.mrange :=
-f.cod_mrestrict f.mrange $ λ x, ⟨x, rfl⟩
+f.cod_restrict f.mrange $ λ x, ⟨x, rfl⟩
 
 @[simp, to_additive]
 lemma coe_mrange_restrict {N} [mul_one_class N] (f : M →* N) (x : M) :
@@ -832,28 +864,36 @@ rfl
 lemma mrange_restrict_surjective (f : M →* N) : function.surjective f.mrange_restrict :=
 λ ⟨_, ⟨x, rfl⟩⟩, ⟨x, rfl⟩
 
+include mc
 /-- The multiplicative kernel of a monoid homomorphism is the submonoid of elements `x : G` such
 that `f x = 1` -/
 @[to_additive "The additive kernel of an `add_monoid` homomorphism is the `add_submonoid` of
 elements such that `f x = 0`"]
-def mker (f : M →* N) : submonoid M := (⊥ : submonoid N).comap f
+def mker (f : F) : submonoid M := (⊥ : submonoid N).comap f
 
 @[to_additive]
-lemma mem_mker (f : M →* N) {x : M} : x ∈ f.mker ↔ f x = 1 := iff.rfl
+lemma mem_mker (f : F) {x : M} : x ∈ mker f ↔ f x = 1 := iff.rfl
 
 @[to_additive]
-lemma coe_mker (f : M →* N) : (f.mker : set M) = (f : M → N) ⁻¹' {1} := rfl
+lemma coe_mker (f : F) : (mker f : set M) = (f : M → N) ⁻¹' {1} := rfl
 
 @[to_additive]
-instance decidable_mem_mker [decidable_eq N] (f : M →* N) :
-  decidable_pred (∈ f.mker) :=
-λ x, decidable_of_iff (f x = 1) f.mem_mker
+instance decidable_mem_mker [decidable_eq N] (f : F) :
+  decidable_pred (∈ mker f) :=
+λ x, decidable_of_iff (f x = 1) (mem_mker f)
+omit mc
 
 @[to_additive]
 lemma comap_mker (g : N →* P) (f : M →* N) : g.mker.comap f = (g.comp f).mker := rfl
 
-@[simp, to_additive] lemma comap_bot' (f : M →* N) :
-  (⊥ : submonoid N).comap f = f.mker := rfl
+include mc
+@[simp, to_additive] lemma comap_bot' (f : F) :
+  (⊥ : submonoid N).comap f = mker f := rfl
+omit mc
+
+@[simp, to_additive]
+lemma restrict_mker (f : M →* N) : (f.restrict S).mker = f.mker.comap S.subtype :=
+rfl
 
 @[to_additive] lemma range_restrict_mker (f : M →* N) : mker (mrange_restrict f) = mker f :=
 begin
@@ -927,11 +967,11 @@ lemma mrange_inr' : (inr M N).mrange = comap (fst M N) ⊥ := mrange_inr.trans (
 
 @[simp, to_additive]
 lemma mrange_fst : (fst M N).mrange = ⊤ :=
-(fst M N).mrange_top_of_surjective $ @prod.fst_surjective _ _ ⟨1⟩
+mrange_top_of_surjective (fst M N) $ @prod.fst_surjective _ _ ⟨1⟩
 
 @[simp, to_additive]
 lemma mrange_snd : (snd M N).mrange = ⊤ :=
-(snd M N).mrange_top_of_surjective $ @prod.snd_surjective _ _ ⟨1⟩
+mrange_top_of_surjective (snd M N) $ @prod.snd_surjective _ _ ⟨1⟩
 
 @[to_additive]
 lemma prod_eq_bot_iff {s : submonoid M} {t : submonoid N} :
@@ -951,7 +991,7 @@ by simp only [mrange_inl, mrange_inr, prod_bot_sup_bot_prod, top_prod_top]
 /-- The monoid hom associated to an inclusion of submonoids. -/
 @[to_additive "The `add_monoid` hom associated to an inclusion of submonoids."]
 def inclusion {S T : submonoid M} (h : S ≤ T) : S →* T :=
-S.subtype.cod_mrestrict _ (λ x, h x.2)
+S.subtype.cod_restrict _ (λ x, h x.2)
 
 @[simp, to_additive]
 lemma range_subtype (s : submonoid M) : s.subtype.mrange = s :=
@@ -1017,15 +1057,25 @@ a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`.
 See `monoid_hom.submonoid_map` for a variant for `monoid_hom`s. -/
 @[to_additive "An `add_equiv` `φ` between two additive monoids `M` and `N` induces an `add_equiv`
 between a submonoid `S ≤ M` and the submonoid `φ(S) ≤ N`. See `add_monoid_hom.add_submonoid_map`
-for a variant for `add_monoid_hom`s.", simps]
+for a variant for `add_monoid_hom`s."]
 def submonoid_map (e : M ≃* N) (S : submonoid M) : S ≃* S.map e.to_monoid_hom :=
-{ to_fun := λ x, ⟨e x, _⟩,
-  inv_fun := λ x, ⟨e.symm x, _⟩, -- we restate this for `simps` to avoid `⇑e.symm.to_equiv x`
-  ..e.to_monoid_hom.submonoid_map S,
-  ..e.to_equiv.image S }
+{ map_mul' := λ _ _, subtype.ext (map_mul e _ _), ..(e : M ≃ N).image S }
+
+@[simp, to_additive]
+lemma coe_submonoid_map_apply (e : M ≃* N) (S : submonoid M) (g : S) :
+  ((submonoid_map e S g : S.map (e : M →* N)) : N) = e g := rfl
+
+@[simp, to_additive add_equiv.add_submonoid_map_symm_apply]
+lemma submonoid_map_symm_apply (e : M ≃* N) (S : submonoid M) (g : S.map (e : M →* N)) :
+  (e.submonoid_map S).symm g = ⟨e.symm g, set_like.mem_coe.1 $ set.mem_image_equiv.1 g.2⟩ := rfl
 
 end mul_equiv
 
+@[simp, to_additive]
+lemma submonoid.equiv_map_of_injective_coe_mul_equiv (e : M ≃* N) :
+  S.equiv_map_of_injective (e : M →* N) (equiv_like.injective e) = e.submonoid_map S :=
+by { ext, refl }
+
 section actions
 /-! ### Actions by `submonoid`s
 
@@ -1043,31 +1093,31 @@ section mul_one_class
 variables [mul_one_class M']
 
 @[to_additive]
-instance [has_scalar M' α] (S : submonoid M') : has_scalar S α := has_scalar.comp _ S.subtype
+instance [has_smul M' α] (S : submonoid M') : has_smul S α := has_smul.comp _ S.subtype
 
 @[to_additive]
 instance smul_comm_class_left
-  [has_scalar M' β] [has_scalar α β] [smul_comm_class M' α β] (S : submonoid M') :
+  [has_smul M' β] [has_smul α β] [smul_comm_class M' α β] (S : submonoid M') :
   smul_comm_class S α β :=
 ⟨λ a, (smul_comm (a : M') : _)⟩
 
 @[to_additive]
 instance smul_comm_class_right
-  [has_scalar α β] [has_scalar M' β] [smul_comm_class α M' β] (S : submonoid M') :
+  [has_smul α β] [has_smul M' β] [smul_comm_class α M' β] (S : submonoid M') :
   smul_comm_class α S β :=
 ⟨λ a s, (smul_comm a (s : M') : _)⟩
 
 /-- Note that this provides `is_scalar_tower S M' M'` which is needed by `smul_mul_assoc`. -/
 instance
-  [has_scalar α β] [has_scalar M' α] [has_scalar M' β] [is_scalar_tower M' α β] (S : submonoid M') :
+  [has_smul α β] [has_smul M' α] [has_smul M' β] [is_scalar_tower M' α β] (S : submonoid M') :
   is_scalar_tower S α β :=
 ⟨λ a, (smul_assoc (a : M') : _)⟩
 
 @[to_additive]
-lemma smul_def [has_scalar M' α] {S : submonoid M'} (g : S) (m : α) : g • m = (g : M') • m := rfl
+lemma smul_def [has_smul M' α] {S : submonoid M'} (g : S) (m : α) : g • m = (g : M') • m := rfl
 
-instance [has_scalar M' α] [has_faithful_scalar M' α] (S : submonoid M') :
-  has_faithful_scalar S α :=
+instance [has_smul M' α] [has_faithful_smul M' α] (S : submonoid M') :
+  has_faithful_smul S α :=
 ⟨λ x y h, subtype.ext $ eq_of_smul_eq_smul h⟩
 
 end mul_one_class
diff --git a/src/group_theory/submonoid/pointwise.lean b/src/group_theory/submonoid/pointwise.lean
index 70c9ecdfb7c44..db1c25a50e117 100644
--- a/src/group_theory/submonoid/pointwise.lean
+++ b/src/group_theory/submonoid/pointwise.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import data.set.pointwise
-import group_theory.submonoid.operations
+import data.set.pointwise.smul
+import group_theory.submonoid.membership
+import order.well_founded_set
 
 /-! # Pointwise instances on `submonoid`s and `add_submonoid`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides:
 
 * `submonoid.has_inv`
@@ -22,8 +26,13 @@ which matches the action of `mul_action_set`.
 
 These are all available in the `pointwise` locale.
 
-Additionally, it provides `add_submonoid.has_mul`, which is available globally to match
-`submodule.has_mul`.
+Additionally, it provides various degrees of monoid structure:
+* `add_submonoid.has_one`
+* `add_submonoid.has_mul`
+* `add_submonoid.mul_one_class`
+* `add_submonoid.semigroup`
+* `add_submonoid.monoid`
+which is available globally to match the monoid structure implied by `submodule.idem_semiring`.
 
 ## Implementation notes
 
@@ -34,10 +43,65 @@ on `set`s.
 
 -/
 
+open set
+
 variables {α : Type*} {G : Type*} {M : Type*} {R : Type*} {A : Type*}
 variables [monoid M] [add_monoid A]
 
+
+/-! Some lemmas about pointwise multiplication and submonoids. Ideally we put these in
+  `group_theory.submonoid.basic`, but currently we cannot because that file is imported by this. -/
 namespace submonoid
+open_locale pointwise
+
+variables {s t u : set M}
+
+@[to_additive]
+lemma mul_subset {S : submonoid M} (hs : s ⊆ S) (ht : t ⊆ S) : s * t ⊆ S :=
+by { rintro _ ⟨p, q, hp, hq, rfl⟩, exact submonoid.mul_mem _ (hs hp) (ht hq) }
+
+@[to_additive]
+lemma mul_subset_closure (hs : s ⊆ u) (ht : t ⊆ u) : s * t ⊆ submonoid.closure u :=
+mul_subset (subset.trans hs submonoid.subset_closure) (subset.trans ht submonoid.subset_closure)
+
+@[to_additive]
+lemma coe_mul_self_eq (s : submonoid M) : (s : set M) * s = s :=
+begin
+  ext x,
+  refine ⟨_, λ h, ⟨x, 1, h, s.one_mem, mul_one x⟩⟩,
+  rintro ⟨a, b, ha, hb, rfl⟩,
+  exact s.mul_mem ha hb
+end
+
+@[to_additive]
+lemma closure_mul_le (S T : set M) : closure (S * T) ≤ closure S ⊔ closure T :=
+Inf_le $ λ x ⟨s, t, hs, ht, hx⟩, hx ▸ (closure S ⊔ closure T).mul_mem
+    (set_like.le_def.mp le_sup_left $ subset_closure hs)
+    (set_like.le_def.mp le_sup_right $ subset_closure ht)
+
+@[to_additive]
+lemma sup_eq_closure (H K : submonoid M) : H ⊔ K = closure (H * K) :=
+le_antisymm
+  (sup_le
+    (λ h hh, subset_closure ⟨h, 1, hh, K.one_mem, mul_one h⟩)
+    (λ k hk, subset_closure ⟨1, k, H.one_mem, hk, one_mul k⟩))
+  (by conv_rhs { rw [← closure_eq H, ← closure_eq K] }; apply closure_mul_le)
+
+@[to_additive]
+lemma pow_smul_mem_closure_smul {N : Type*} [comm_monoid N] [mul_action M N]
+  [is_scalar_tower M N N] (r : M) (s : set N) {x : N} (hx : x ∈ closure s) :
+  ∃ n : ℕ, r ^ n • x ∈ closure (r • s) :=
+begin
+  apply @closure_induction N _ s
+    (λ (x : N), ∃ n : ℕ, r ^ n • x ∈ closure (r • s)) _ hx,
+  { intros x hx,
+    exact ⟨1, subset_closure ⟨_, hx, by rw pow_one⟩⟩ },
+  { exact ⟨0, by simpa using one_mem _⟩ },
+  { rintro x y ⟨nx, hx⟩ ⟨ny, hy⟩,
+    use nx + ny,
+    convert mul_mem hx hy,
+    rw [pow_add, smul_mul_assoc, mul_smul, mul_comm, ← smul_mul_assoc, mul_comm] }
+end
 
 variables [group G]
 
@@ -45,10 +109,10 @@ open_locale pointwise
 
 /-- The submonoid with every element inverted. -/
 @[to_additive /-" The additive submonoid with every element negated. "-/]
-protected def has_inv : has_inv (submonoid G):=
+protected def has_inv : has_inv (submonoid G) :=
 { inv := λ S,
   { carrier := (S : set G)⁻¹,
-    one_mem' := show (1 : G)⁻¹ ∈ S, by { rw one_inv, exact S.one_mem },
+    one_mem' := show (1 : G)⁻¹ ∈ S, by { rw inv_one, exact S.one_mem },
     mul_mem' := λ a b (ha : a⁻¹ ∈ S) (hb : b⁻¹ ∈ S), show (a * b)⁻¹ ∈ S,
       by { rw mul_inv_rev, exact S.mul_mem hb ha } } }
 
@@ -59,10 +123,8 @@ open_locale pointwise
 
 @[simp, to_additive] lemma mem_inv {g : G} {S : submonoid G} : g ∈ S⁻¹ ↔ g⁻¹ ∈ S := iff.rfl
 
-@[to_additive]
-instance : has_involutive_inv (submonoid G) :=
-{ inv := has_inv.inv,
-  inv_inv := λ S, set_like.coe_injective $ inv_inv _ }
+@[to_additive] instance : has_involutive_inv (submonoid G) :=
+set_like.coe_injective.has_involutive_inv _ $ λ _, rfl
 
 @[simp, to_additive] lemma inv_le_inv (S T : submonoid G) : S⁻¹ ≤ T⁻¹ ↔ S ≤ T :=
 set_like.coe_subset_coe.symm.trans set.inv_subset_inv
@@ -95,7 +157,7 @@ lemma inv_sup (S T : submonoid G) : (S ⊔ T)⁻¹ = S⁻¹ ⊔ T⁻¹ :=
 
 @[simp, to_additive]
 lemma inv_bot : (⊥ : submonoid G)⁻¹ = ⊥ :=
-set_like.coe_injective $ (set.inv_singleton 1).trans $ congr_arg _ one_inv
+set_like.coe_injective $ (set.inv_singleton 1).trans $ congr_arg _ inv_one
 
 @[simp, to_additive]
 lemma inv_top : (⊤ : submonoid G)⁻¹ = ⊤ :=
@@ -120,10 +182,11 @@ variables [monoid α] [mul_distrib_mul_action α M]
 
 This is available as an instance in the `pointwise` locale. -/
 protected def pointwise_mul_action : mul_action α (submonoid M) :=
-{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ _ a),
-  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
+{ smul := λ a S, S.map (mul_distrib_mul_action.to_monoid_End _ M a),
+  one_smul := λ S, by { ext, simp, },
   mul_smul := λ a₁ a₂ S,
-    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}
+    (congr_arg (λ f : monoid.End M, S.map f) (monoid_hom.map_mul _ _ _)).trans
+      (S.map_map _ _).symm,}
 
 localized "attribute [instance] submonoid.pointwise_mul_action" in pointwise
 open_locale pointwise
@@ -137,9 +200,15 @@ lemma mem_smul_pointwise_iff_exists (m : M) (a : α) (S : submonoid M) :
   m ∈ a • S ↔ ∃ (s : M), s ∈ S ∧ a • s = m :=
 (set.mem_smul_set : m ∈ a • (S : set M) ↔ _)
 
+@[simp] lemma smul_bot (a : α) : a • (⊥ : submonoid M) = ⊥ := map_bot _
+lemma smul_sup (a : α) (S T : submonoid M) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : α) (s : set M) : a • closure s = closure (a • s) :=
+monoid_hom.map_mclosure _ _
+
 instance pointwise_central_scalar [mul_distrib_mul_action αᵐᵒᵖ M] [is_central_scalar α M] :
   is_central_scalar α (submonoid M) :=
-⟨λ a S, congr_arg (λ f, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩
+⟨λ a S, congr_arg (λ f : monoid.End M, S.map f) $ monoid_hom.ext $ by exact op_smul_eq_smul _⟩
 
 end monoid
 
@@ -218,10 +287,12 @@ variables [monoid α] [distrib_mul_action α A]
 
 This is available as an instance in the `pointwise` locale. -/
 protected def pointwise_mul_action : mul_action α (add_submonoid A) :=
-{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ _ a),
-  one_smul := λ S, (congr_arg (λ f, S.map f) (monoid_hom.map_one _)).trans S.map_id,
+{ smul := λ a S, S.map (distrib_mul_action.to_add_monoid_End _ A a),
+  one_smul := λ S, (congr_arg (λ f : add_monoid.End A, S.map f)
+    (monoid_hom.map_one _)).trans S.map_id,
   mul_smul := λ a₁ a₂ S,
-    (congr_arg (λ f, S.map f) (monoid_hom.map_mul _ _ _)).trans (S.map_map _ _).symm,}
+    (congr_arg (λ f : add_monoid.End A, S.map f) (monoid_hom.map_mul _ _ _)).trans
+      (S.map_map _ _).symm,}
 
 localized "attribute [instance] add_submonoid.pointwise_mul_action" in pointwise
 open_locale pointwise
@@ -231,9 +302,20 @@ open_locale pointwise
 lemma smul_mem_pointwise_smul (m : A) (a : α) (S : add_submonoid A) : m ∈ S → a • m ∈ a • S :=
 (set.smul_mem_smul_set : _ → _ ∈ a • (S : set A))
 
+lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_submonoid A) :
+  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
+(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)
+
+@[simp] lemma smul_bot (a : α) : a • (⊥ : add_submonoid A) = ⊥ := map_bot _
+lemma smul_sup (a : α) (S T : add_submonoid A) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+@[simp] lemma smul_closure (a : α) (s : set A) : a • closure s = closure (a • s) :=
+add_monoid_hom.map_mclosure _ _
+
 instance pointwise_central_scalar [distrib_mul_action αᵐᵒᵖ A] [is_central_scalar α A] :
   is_central_scalar α (add_submonoid A) :=
-⟨λ a S, congr_arg (λ f, S.map f) $ add_monoid_hom.ext $ by exact op_smul_eq_smul _⟩
+⟨λ a S, congr_arg (λ f : add_monoid.End A, S.map f) $
+  add_monoid_hom.ext $ by exact op_smul_eq_smul _⟩
 
 end monoid
 
@@ -250,10 +332,6 @@ lemma mem_pointwise_smul_iff_inv_smul_mem {a : α} {S : add_submonoid A} {x : A}
   x ∈ a • S ↔ a⁻¹ • x ∈ S :=
 mem_smul_set_iff_inv_smul_mem
 
-lemma mem_smul_pointwise_iff_exists (m : A) (a : α) (S : add_submonoid A) :
-  m ∈ a • S ↔ ∃ (s : A), s ∈ S ∧ a • s = m :=
-(set.mem_smul_set : m ∈ a • (S : set A) ↔ _)
-
 lemma mem_inv_pointwise_smul_iff {a : α} {S : add_submonoid A} {x : A} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
 mem_inv_smul_set_iff
 
@@ -300,16 +378,40 @@ subset_set_smul_iff₀ ha
 
 end group_with_zero
 
-open_locale pointwise
-
 end add_submonoid
 
-/-! ### Elementwise multiplication of two additive submonoids
+/-! ### Elementwise monoid structure of additive submonoids
 
 These definitions are a cut-down versions of the ones around `submodule.has_mul`, as that API is
 usually more useful. -/
 namespace add_submonoid
 
+open_locale pointwise
+
+section add_monoid_with_one
+variables [add_monoid_with_one R]
+
+instance : has_one (add_submonoid R) :=
+⟨(nat.cast_add_monoid_hom R).mrange⟩
+
+theorem one_eq_mrange :
+  (1 : add_submonoid R) = (nat.cast_add_monoid_hom R).mrange := rfl
+
+lemma nat_cast_mem_one (n : ℕ) : (n : R) ∈ (1 : add_submonoid R) := ⟨_, rfl⟩
+
+@[simp] lemma mem_one {x : R} : x ∈ (1 : add_submonoid R) ↔ ∃ n : ℕ, ↑n = x := iff.rfl
+
+theorem one_eq_closure : (1 : add_submonoid R) = closure {1} :=
+begin
+  simp only [closure_singleton_eq, mul_one, one_eq_mrange],
+  congr' 1 with n,
+  simp,
+end
+
+theorem one_eq_closure_one_set : (1 : add_submonoid R) = closure 1 := one_eq_closure
+end add_monoid_with_one
+
+section non_unital_non_assoc_semiring
 variables [non_unital_non_assoc_semiring R]
 
 /-- Multiplication of additive submonoids of a semiring R. The additive submonoid `S * T` is the
@@ -333,7 +435,6 @@ theorem mul_le {M N P : add_submonoid R} : M * N ≤ P ↔ ∀ (m ∈ M) (n ∈
 
 open_locale pointwise
 
-variables R
 -- this proof is copied directly from `submodule.span_mul_span`
 theorem closure_mul_closure (S T : set R) : closure S * closure T = closure (S * T) :=
 begin
@@ -343,13 +444,15 @@ begin
     work_on_goal 1 { intros, apply closure_induction hb,
       work_on_goal 1 { intros, exact subset_closure ⟨_, _, ‹_›, ‹_›, rfl⟩ } },
     all_goals { intros, simp only [mul_zero, zero_mul, zero_mem,
-        left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc],
+        left_distrib, right_distrib, mul_smul_comm, smul_mul_assoc];
       solve_by_elim [add_mem _ _, zero_mem _]
         { max_depth := 4, discharger := tactic.interactive.apply_instance } } },
   { rw closure_le, rintros _ ⟨a, b, ha, hb, rfl⟩,
     exact mul_mem_mul (subset_closure ha) (subset_closure hb) }
 end
-variables {R}
+
+lemma mul_eq_closure_mul_set (M N : add_submonoid R) : M * N = closure (M * N) :=
+by rw [←closure_mul_closure, closure_eq, closure_eq]
 
 @[simp] theorem mul_bot (S : add_submonoid R) : S * ⊥ = ⊥ :=
 eq_bot_iff.2 $ mul_le.2 $ λ m hm n hn, by rw [add_submonoid.mem_bot] at hn ⊢; rw [hn, mul_zero]
@@ -370,4 +473,99 @@ mul_le_mul (le_refl M) h
 lemma mul_subset_mul {M N : add_submonoid R} : (↑M : set R) * (↑N : set R) ⊆ (↑(M * N) : set R) :=
 by { rintros _ ⟨i, j, hi, hj, rfl⟩, exact mul_mem_mul hi hj }
 
+end non_unital_non_assoc_semiring
+
+section non_unital_non_assoc_ring
+variables [non_unital_non_assoc_ring R]
+
+/-- `add_submonoid.has_pointwise_neg` distributes over multiplication.
+
+This is available as an instance in the `pointwise` locale. -/
+protected def has_distrib_neg : has_distrib_neg (add_submonoid R) :=
+{ neg := has_neg.neg,
+  neg_mul := λ x y, begin
+    refine le_antisymm
+      (mul_le.2 $ λ m hm n hn, _)
+      ((add_submonoid.neg_le _ _).2 $ mul_le.2 $ λ m hm n hn, _);
+    simp only [add_submonoid.mem_neg, ←neg_mul] at *,
+    { exact mul_mem_mul hm hn },
+    { exact mul_mem_mul (neg_mem_neg.2 hm) hn },
+  end,
+  mul_neg := λ x y, begin
+    refine le_antisymm
+      (mul_le.2 $ λ m hm n hn, _)
+      ((add_submonoid.neg_le _ _).2 $ mul_le.2 $ λ m hm n hn, _);
+    simp only [add_submonoid.mem_neg, ←mul_neg] at *,
+    { exact mul_mem_mul hm hn,},
+    { exact mul_mem_mul hm (neg_mem_neg.2 hn) },
+  end,
+  ..add_submonoid.has_involutive_neg }
+
+localized "attribute [instance] add_submonoid.has_distrib_neg" in pointwise
+
+end non_unital_non_assoc_ring
+
+section non_assoc_semiring
+variables [non_assoc_semiring R]
+
+instance : mul_one_class (add_submonoid R) :=
+{ one := 1,
+  mul := (*),
+  one_mul := λ M, by rw [one_eq_closure_one_set, ←closure_eq M, closure_mul_closure, one_mul],
+  mul_one := λ M, by rw [one_eq_closure_one_set, ←closure_eq M, closure_mul_closure, mul_one] }
+
+end non_assoc_semiring
+
+section non_unital_semiring
+variables [non_unital_semiring R]
+
+instance : semigroup (add_submonoid R) :=
+{ mul := (*),
+  mul_assoc := λ M N P,
+    le_antisymm (mul_le.2 $ λ mn hmn p hp,
+      suffices M * N ≤ (M * (N * P)).comap (add_monoid_hom.mul_right p), from this hmn,
+      mul_le.2 $ λ m hm n hn, show m * n * p ∈ M * (N * P), from
+      (mul_assoc m n p).symm ▸ mul_mem_mul hm (mul_mem_mul hn hp))
+    (mul_le.2 $ λ m hm np hnp,
+      suffices N * P ≤ (M * N * P).comap (add_monoid_hom.mul_left m), from this hnp,
+      mul_le.2 $ λ n hn p hp, show m * (n * p) ∈ M * N * P, from
+      mul_assoc m n p ▸ mul_mem_mul (mul_mem_mul hm hn) hp) }
+
+end non_unital_semiring
+
+section semiring
+variables [semiring R]
+
+instance : monoid (add_submonoid R) :=
+{ one := 1,
+  mul := (*),
+  ..add_submonoid.semigroup,
+  ..add_submonoid.mul_one_class }
+
+lemma closure_pow (s : set R) : ∀ n : ℕ, closure s ^ n = closure (s ^ n)
+| 0 := by rw [pow_zero, pow_zero, one_eq_closure_one_set]
+| (n + 1) := by rw [pow_succ, pow_succ, closure_pow, closure_mul_closure]
+
+lemma pow_eq_closure_pow_set (s : add_submonoid R) (n : ℕ) : s ^ n = closure ((s : set R) ^ n) :=
+by rw [←closure_pow, closure_eq]
+
+lemma pow_subset_pow {s : add_submonoid R} {n : ℕ} : (↑s : set R)^n ⊆ ↑(s^n) :=
+(pow_eq_closure_pow_set s n).symm ▸ subset_closure
+
+end semiring
+
 end add_submonoid
+
+namespace set.is_pwo
+variables [ordered_cancel_comm_monoid α] {s : set α}
+
+@[to_additive]
+lemma submonoid_closure (hpos : ∀ x : α, x ∈ s → 1 ≤ x) (h : s.is_pwo) :
+  is_pwo ((submonoid.closure s) : set α) :=
+begin
+  rw submonoid.closure_eq_image_prod,
+  refine (h.partially_well_ordered_on_sublist_forall₂ (≤)).image_of_monotone_on _,
+  exact λ l1 hl1 l2 hl2 h12, h12.prod_le_prod' (λ x hx, hpos x $ hl2 x hx)
+end
+
+end set.is_pwo
diff --git a/src/group_theory/subsemigroup/basic.lean b/src/group_theory/subsemigroup/basic.lean
index a454a84451711..a380ec63b600b 100644
--- a/src/group_theory/subsemigroup/basic.lean
+++ b/src/group_theory/subsemigroup/basic.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
 Amelia Livingston, Yury Kudryashov, Yakov Pechersky
 -/
+import algebra.hom.group  -- Only needed for notation
 import data.set.lattice
 import data.set_like.basic
 
 /-!
 # Subsemigroups: definition and `complete_lattice` structure
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines bundled multiplicative and additive subsemigroups. We also define
 a `complete_lattice` structure on `subsemigroup`s,
 and define the closure of a set as the minimal subsemigroup that includes this set.
@@ -53,13 +57,13 @@ variables [has_mul M] {s : set M}
 variables [has_add A] {t : set A}
 
 /-- `mul_mem_class S M` says `S` is a type of subsets `s ≤ M` that are closed under `(*)` -/
-class mul_mem_class (S : Type*) (M : out_param $ Type*) [has_mul M] [set_like S M] :=
+class mul_mem_class (S M : Type*) [has_mul M] [set_like S M] : Prop :=
 (mul_mem : ∀ {s : S} {a b : M}, a ∈ s → b ∈ s → a * b ∈ s)
 
 export mul_mem_class (mul_mem)
 
 /-- `add_mem_class S M` says `S` is a type of subsets `s ≤ M` that are closed under `(+)` -/
-class add_mem_class (S : Type*) (M : out_param $ Type*) [has_add M] [set_like S M] :=
+class add_mem_class (S M : Type*) [has_add M] [set_like S M] : Prop :=
 (add_mem : ∀ {s : S} {a b : M}, a ∈ s → b ∈ s → a + b ∈ s)
 
 export add_mem_class (add_mem)
@@ -118,7 +122,7 @@ theorem ext {S T : subsemigroup M}
 it."]
 protected def copy (S : subsemigroup M) (s : set M) (hs : s = S) : subsemigroup M :=
 { carrier := s,
-  mul_mem' := hs.symm ▸ S.mul_mem' }
+  mul_mem' := λ _ _, hs.symm ▸ S.mul_mem' }
 
 variable {S : subsemigroup M}
 
diff --git a/src/group_theory/subsemigroup/center.lean b/src/group_theory/subsemigroup/center.lean
index c3f70b658919f..46cd73116a996 100644
--- a/src/group_theory/subsemigroup/center.lean
+++ b/src/group_theory/subsemigroup/center.lean
@@ -3,16 +3,21 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser, Jireh Loreaux
 -/
+import algebra.ring.defs
 import group_theory.subsemigroup.operations
-import data.fintype.basic
 
 /-!
 # Centers of magmas and semigroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `set.center`: the center of a magma
+* `subsemigroup.center`: the center of a semigroup
 * `set.add_center`: the center of an additive magma
+* `add_subsemigroup.center`: the center of an additive semigroup
 
 We provide `submonoid.center`, `add_submonoid.center`, `subgroup.center`, `add_subgroup.center`,
 `subsemiring.center`, and `subring.center` in other files.
@@ -31,7 +36,7 @@ def center [has_mul M] : set M := {z | ∀ m, m * z = z * m}
 @[to_additive mem_add_center]
 lemma mem_center_iff [has_mul M] {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl
 
-instance decidable_mem_center [has_mul M] [decidable_eq M] [fintype M] :
+instance decidable_mem_center [has_mul M]  [∀ a : M, decidable $ ∀ b : M, b * a = a * b] :
   decidable_pred (∈ center M) :=
 λ _, decidable_of_iff' _ (mem_center_iff M)
 
@@ -85,7 +90,7 @@ begin
   obtain rfl | ha0 := eq_or_ne a 0,
   { rw inv_zero, exact zero_mem_center M },
   rcases is_unit.mk0 _ ha0 with ⟨a, rfl⟩,
-  rw ←units.coe_inv',
+  rw ←units.coe_inv,
   exact center_units_subset (inv_mem_center (subset_center_units ha)),
 end
 
@@ -112,3 +117,46 @@ lemma center_eq_univ [comm_semigroup M] : center M = set.univ :=
 subset.antisymm (subset_univ _) $ λ x _ y, mul_comm y x
 
 end set
+
+namespace subsemigroup
+section
+variables (M) [semigroup M]
+
+/-- The center of a semigroup `M` is the set of elements that commute with everything in `M` -/
+@[to_additive "The center of a semigroup `M` is the set of elements that commute with everything in
+`M`"]
+def center : subsemigroup M :=
+{ carrier := set.center M,
+  mul_mem' := λ a b, set.mul_mem_center }
+
+@[to_additive] lemma coe_center : ↑(center M) = set.center M := rfl
+
+variables {M}
+
+@[to_additive] lemma mem_center_iff {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl
+
+@[to_additive]
+instance decidable_mem_center (a) [decidable $ ∀ b : M, b * a = a * b] :
+  decidable (a ∈ center M) :=
+decidable_of_iff' _ mem_center_iff
+
+/-- The center of a semigroup is commutative. -/
+@[to_additive "The center of an additive semigroup is commutative."]
+instance : comm_semigroup (center M) :=
+{ mul_comm := λ a b, subtype.ext $ b.prop _,
+  .. mul_mem_class.to_semigroup (center M) }
+
+end
+
+section
+variables (M) [comm_semigroup M]
+
+@[simp, to_additive] lemma center_eq_top : center M = ⊤ :=
+set_like.coe_injective (set.center_eq_univ M)
+
+end
+
+end subsemigroup
+
+-- Guard against import creep
+assert_not_exists finset
diff --git a/src/group_theory/subsemigroup/centralizer.lean b/src/group_theory/subsemigroup/centralizer.lean
index 031c3120cc819..2d979f0c20cfe 100644
--- a/src/group_theory/subsemigroup/centralizer.lean
+++ b/src/group_theory/subsemigroup/centralizer.lean
@@ -4,14 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Thomas Browning, Jireh Loreaux
 -/
 import group_theory.subsemigroup.center
+import algebra.group_with_zero.units.lemmas
 
 /-!
 # Centralizers of magmas and semigroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `set.centralizer`: the centralizer of a subset of a magma
+* `subsemigroup.centralizer`: the centralizer of a subset of a semigroup
 * `set.add_centralizer`: the centralizer of a subset of an additive magma
+* `add_subsemigroup.centralizer`: the centralizer of a subset of an additive semigroup
 
 We provide `monoid.centralizer`, `add_monoid.centralizer`, `subgroup.centralizer`, and
 `add_subgroup.centralizer` in other files.
@@ -34,8 +40,8 @@ lemma mem_centralizer_iff [has_mul M] {c : M} : c ∈ centralizer S ↔ ∀ m 
 iff.rfl
 
 @[to_additive decidable_mem_add_centralizer]
-instance decidable_mem_centralizer [has_mul M] [decidable_eq M] [fintype M]
-  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
+instance decidable_mem_centralizer [has_mul M] [∀ a : M, decidable $ ∀ b ∈ S, b * a = a * b] :
+  decidable_pred (∈ centralizer S) :=
 λ _, decidable_of_iff' _ (mem_centralizer_iff)
 
 variables (S)
@@ -94,6 +100,16 @@ end
 lemma centralizer_subset [has_mul M] (h : S ⊆ T) : centralizer T ⊆ centralizer S :=
 λ t ht s hs, ht s (h hs)
 
+@[to_additive add_center_subset_add_centralizer]
+lemma center_subset_centralizer [has_mul M] (S : set M) : set.center M ⊆ S.centralizer :=
+λ x hx m _, hx m
+
+@[simp, to_additive add_centralizer_eq_top_iff_subset]
+lemma centralizer_eq_top_iff_subset {s : set M} [has_mul M] :
+  centralizer s = set.univ ↔ s ⊆ center M :=
+eq_top_iff.trans $ ⟨λ h x hx g, (h trivial _ hx).symm,
+                    λ h x _ m hm, (h hm x).symm⟩
+
 variables (M)
 
 @[simp, to_additive add_centralizer_univ]
@@ -106,4 +122,50 @@ variables {M} (S)
 lemma centralizer_eq_univ [comm_semigroup M] : centralizer S = univ :=
 subset.antisymm (subset_univ _) $ λ x hx y hy, mul_comm y x
 
+
 end set
+
+namespace subsemigroup
+section
+variables {M} [semigroup M] (S)
+
+/-- The centralizer of a subset of a semigroup `M`. -/
+@[to_additive "The centralizer of a subset of an additive semigroup."]
+def centralizer : subsemigroup M :=
+{ carrier := S.centralizer,
+  mul_mem' := λ a b, set.mul_mem_centralizer }
+
+@[simp, norm_cast, to_additive] lemma coe_centralizer : ↑(centralizer S) = S.centralizer := rfl
+
+variables {S}
+
+@[to_additive] lemma mem_centralizer_iff {z : M} : z ∈ centralizer S ↔ ∀ g ∈ S, g * z = z * g :=
+iff.rfl
+
+@[to_additive] instance decidable_mem_centralizer (a) [decidable $ ∀ b ∈ S, b * a = a * b] :
+  decidable (a ∈ centralizer S) :=
+decidable_of_iff' _ mem_centralizer_iff
+
+@[to_additive]
+lemma center_le_centralizer (S) : center M ≤ centralizer S := S.center_subset_centralizer
+
+@[to_additive]
+lemma centralizer_le (h : S ⊆ T) : centralizer T ≤ centralizer S :=
+set.centralizer_subset h
+
+@[simp, to_additive]
+lemma centralizer_eq_top_iff_subset {s : set M} : centralizer s = ⊤ ↔ s ⊆ center M :=
+set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset
+
+variables (M)
+
+@[simp, to_additive]
+lemma centralizer_univ : centralizer set.univ = center M :=
+set_like.ext' (set.centralizer_univ M)
+
+end
+
+end subsemigroup
+
+-- Guard against import creep
+assert_not_exists finset
diff --git a/src/group_theory/subsemigroup/membership.lean b/src/group_theory/subsemigroup/membership.lean
new file mode 100644
index 0000000000000..90d4d0e144b89
--- /dev/null
+++ b/src/group_theory/subsemigroup/membership.lean
@@ -0,0 +1,129 @@
+/-
+Copyright (c) 2022 Jireh Loreaux. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jireh Loreaux
+-/
+import group_theory.subsemigroup.basic
+
+/-!
+# Subsemigroups: membership criteria
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove various facts about membership in a subsemigroup.
+The intent is to mimic `group_theory/submonoid/membership`, but currently this file is mostly a
+stub and only provides rudimentary support.
+
+* `mem_supr_of_directed`, `coe_supr_of_directed`, `mem_Sup_of_directed_on`,
+  `coe_Sup_of_directed_on`: the supremum of a directed collection of subsemigroup is their union.
+
+## TODO
+
+* Define the `free_semigroup` generated by a set. This might require some rather substantial
+  additions to low-level API. For example, developing the subtype of nonempty lists, then defining
+  a product on nonempty lists, powers where the exponent is a positive natural, et cetera.
+  Another option would be to define the `free_semigroup` as the subsemigroup (pushed to be a
+  semigroup) of the `free_monoid` consisting of non-identity elements.
+
+## Tags
+subsemigroup
+-/
+
+variables {ι : Sort*} {M A B : Type*}
+
+section non_assoc
+variables [has_mul M]
+
+open set
+
+namespace subsemigroup
+
+-- TODO: this section can be generalized to `[mul_mem_class B M] [complete_lattice B]`
+-- such that `complete_lattice.le` coincides with `set_like.le`
+
+@[to_additive]
+lemma mem_supr_of_directed {S : ι → subsemigroup M} (hS : directed (≤) S) {x : M} :
+  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
+begin
+  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
+  suffices : x ∈ closure (⋃ i, (S i : set M)) → ∃ i, x ∈ S i,
+    by simpa only [closure_Union, closure_eq (S _)] using this,
+  refine (λ hx, closure_induction hx (λ y hy, mem_Union.mp hy) _),
+  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
+    rcases hS i j with ⟨k, hki, hkj⟩,
+    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩ }
+end
+
+@[to_additive]
+lemma coe_supr_of_directed {S : ι → subsemigroup M} (hS : directed (≤) S) :
+  ((⨆ i, S i : subsemigroup M) : set M) = ⋃ i, ↑(S i) :=
+set.ext $ λ x, by simp [mem_supr_of_directed hS]
+
+@[to_additive]
+lemma mem_Sup_of_directed_on {S : set (subsemigroup M)}
+  (hS : directed_on (≤) S) {x : M} :
+  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
+by simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
+
+@[to_additive]
+lemma coe_Sup_of_directed_on {S : set (subsemigroup M)}
+  (hS : directed_on (≤) S) :
+  (↑(Sup S) : set M) = ⋃ s ∈ S, ↑s :=
+set.ext $ λ x, by simp [mem_Sup_of_directed_on hS]
+
+@[to_additive]
+lemma mem_sup_left {S T : subsemigroup M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
+show S ≤ S ⊔ T, from le_sup_left
+
+@[to_additive]
+lemma mem_sup_right {S T : subsemigroup M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
+show T ≤ S ⊔ T, from le_sup_right
+
+@[to_additive]
+lemma mul_mem_sup {S T : subsemigroup M} {x y : M} (hx : x ∈ S) (hy : y ∈ T) : x * y ∈ S ⊔ T :=
+mul_mem (mem_sup_left hx) (mem_sup_right hy)
+
+@[to_additive]
+lemma mem_supr_of_mem {S : ι → subsemigroup M} (i : ι) :
+  ∀ {x : M}, x ∈ S i → x ∈ supr S :=
+show S i ≤ supr S, from le_supr _ _
+
+@[to_additive]
+lemma mem_Sup_of_mem {S : set (subsemigroup M)} {s : subsemigroup M}
+  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
+show s ≤ Sup S, from le_Sup hs
+
+/-- An induction principle for elements of `⨆ i, S i`.
+If `C` holds all elements of `S i` for all `i`, and is preserved under multiplication,
+then it holds for all elements of the supremum of `S`. -/
+@[elab_as_eliminator, to_additive /-" An induction principle for elements of `⨆ i, S i`.
+If `C` holds all elements of `S i` for all `i`, and is preserved under addition,
+then it holds for all elements of the supremum of `S`. "-/]
+lemma supr_induction (S : ι → subsemigroup M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, S i)
+  (hp : ∀ i (x ∈ S i), C x)
+  (hmul : ∀ x y, C x → C y → C (x * y)) : C x :=
+begin
+  rw supr_eq_closure at hx,
+  refine closure_induction hx (λ x hx, _) hmul,
+  obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
+  exact hp _ _ hi,
+end
+
+/-- A dependent version of `subsemigroup.supr_induction`. -/
+@[elab_as_eliminator, to_additive /-"A dependent version of `add_subsemigroup.supr_induction`. "-/]
+lemma supr_induction' (S : ι → subsemigroup M) {C : Π x, (x ∈ ⨆ i, S i) → Prop}
+  (hp : ∀ i (x ∈ S i), C x (mem_supr_of_mem i ‹_›))
+  (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem ‹_› ‹_›))
+  {x : M} (hx : x ∈ ⨆ i, S i) : C x hx :=
+begin
+  refine exists.elim _ (λ (hx : x ∈ ⨆ i, S i) (hc : C x hx), hc),
+  refine supr_induction S hx (λ i x hx, _) (λ x y, _),
+  { exact ⟨_, hp _ _ hx⟩ },
+  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
+    exact ⟨_, hmul _ _ _ _ Cx Cy⟩ },
+end
+
+end subsemigroup
+
+end non_assoc
diff --git a/src/group_theory/subsemigroup/operations.lean b/src/group_theory/subsemigroup/operations.lean
index bb6b6af81a710..3046644562618 100644
--- a/src/group_theory/subsemigroup/operations.lean
+++ b/src/group_theory/subsemigroup/operations.lean
@@ -5,10 +5,15 @@ Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzza
 Amelia Livingston, Yury Kudryashov, Yakov Pechersky, Jireh Loreaux
 -/
 import group_theory.subsemigroup.basic
+import algebra.group.prod
+import algebra.group.type_tags
 
 /-!
 # Operations on `subsemigroup`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define various operations on `subsemigroup`s and `mul_hom`s.
 
 ## Main definitions
@@ -46,8 +51,8 @@ In this file we define various operations on `subsemigroup`s and `mul_hom`s.
 ### Operations on `mul_hom`s
 
 * `mul_hom.srange`: range of a semigroup homomorphism as a subsemigroup of the codomain;
-* `mul_hom.srestrict`: restrict a semigroup homomorphism to a subsemigroup;
-* `mul_hom.cod_srestrict`: restrict the codomain of a semigroup homomorphism to a subsemigroup;
+* `mul_hom.restrict`: restrict a semigroup homomorphism to a subsemigroup;
+* `mul_hom.cod_restrict`: restrict the codomain of a semigroup homomorphism to a subsemigroup;
 * `mul_hom.srange_restrict`: restrict a semigroup homomorphism to its range;
 
 ### Implementation notes
@@ -60,7 +65,7 @@ necessary.
 subsemigroup, range, product, map, comap
 -/
 
-variables {M N P : Type*}
+variables {M N P σ : Type*}
 
 /-!
 ### Conversion to/from `additive`/`multiplicative`
@@ -75,10 +80,10 @@ variables [has_mul M]
 def subsemigroup.to_add_subsemigroup : subsemigroup M ≃o add_subsemigroup (additive M) :=
 { to_fun := λ S,
   { carrier := additive.to_mul ⁻¹' S,
-    add_mem' := S.mul_mem' },
+    add_mem' := λ _ _, S.mul_mem' },
   inv_fun := λ S,
   { carrier := additive.of_mul ⁻¹' S,
-    mul_mem' := S.add_mem' },
+    mul_mem' := λ _ _, S.add_mem' },
   left_inv := λ x, by cases x; refl,
   right_inv := λ x, by cases x; refl,
   map_rel_iff' := λ a b, iff.rfl, }
@@ -115,10 +120,10 @@ multiplicative subsemigroups of `multiplicative A`. -/
 def add_subsemigroup.to_subsemigroup : add_subsemigroup A ≃o subsemigroup (multiplicative A) :=
 { to_fun := λ S,
   { carrier := multiplicative.to_add ⁻¹' S,
-    mul_mem' := S.add_mem' },
+    mul_mem' := λ _ _, S.add_mem' },
   inv_fun := λ S,
   { carrier := multiplicative.of_add ⁻¹' S,
-    add_mem' := S.mul_mem' },
+    add_mem' := λ _ _, S.mul_mem' },
   left_inv := λ x, by cases x; refl,
   right_inv := λ x, by cases x; refl,
   map_rel_iff' := λ a b, iff.rfl, }
@@ -470,13 +475,11 @@ of `M × N`. -/
 @[to_additive prod "Given `add_subsemigroup`s `s`, `t` of `add_semigroup`s `A`, `B` respectively,
 `s × t` as an `add_subsemigroup` of `A × B`."]
 def prod (s : subsemigroup M) (t : subsemigroup N) : subsemigroup (M × N) :=
-{ carrier := (s : set M) ×ˢ (t : set N),
+{ carrier := s ×ˢ t,
   mul_mem' := λ p q hp hq, ⟨s.mul_mem hp.1 hq.1, t.mul_mem hp.2 hq.2⟩ }
 
 @[to_additive coe_prod]
-lemma coe_prod (s : subsemigroup M) (t : subsemigroup N) :
- (s.prod t : set (M × N)) = (s : set M) ×ˢ (t : set N) :=
-rfl
+lemma coe_prod (s : subsemigroup M) (t : subsemigroup N) : (s.prod t : set (M × N)) = s ×ˢ t := rfl
 
 @[to_additive mem_prod]
 lemma mem_prod {s : subsemigroup M} {t : subsemigroup N} {p : M × N} :
@@ -601,24 +604,27 @@ le_antisymm
 
 /-- Restriction of a semigroup hom to a subsemigroup of the domain. -/
 @[to_additive "Restriction of an add_semigroup hom to an `add_subsemigroup` of the domain."]
-def srestrict {N : Type*} [has_mul N] (f : M →ₙ* N) (S : subsemigroup M) : S →ₙ* N :=
+def restrict {N : Type*} [has_mul N] [set_like σ M] [mul_mem_class σ M] (f : M →ₙ* N) (S : σ) :
+  S →ₙ* N :=
 f.comp (mul_mem_class.subtype S)
 
 @[simp, to_additive]
-lemma srestrict_apply {N : Type*} [has_mul N] (f : M →ₙ* N) (x : S) : f.srestrict S x = f x :=
+lemma restrict_apply {N : Type*} [has_mul N] [set_like σ M] [mul_mem_class σ M] (f : M →ₙ* N)
+  {S : σ} (x : S) : f.restrict S x = f x :=
 rfl
 
 /-- Restriction of a semigroup hom to a subsemigroup of the codomain. -/
 @[to_additive "Restriction of an `add_semigroup` hom to an `add_subsemigroup` of the
 codomain.", simps]
-def cod_srestrict (f : M →ₙ* N) (S : subsemigroup N) (h : ∀ x, f x ∈ S) : M →ₙ* S :=
+def cod_restrict [set_like σ N] [mul_mem_class σ N] (f : M →ₙ* N) (S : σ) (h : ∀ x, f x ∈ S) :
+  M →ₙ* S :=
 { to_fun := λ n, ⟨f n, h n⟩,
   map_mul' := λ x y, subtype.eq (map_mul f x y) }
 
 /-- Restriction of a semigroup hom to its range interpreted as a subsemigroup. -/
 @[to_additive "Restriction of an `add_semigroup` hom to its range interpreted as a subsemigroup."]
 def srange_restrict {N} [has_mul N] (f : M →ₙ* N) : M →ₙ* f.srange :=
-f.cod_srestrict f.srange $ λ x, ⟨x, rfl⟩
+f.cod_restrict f.srange $ λ x, ⟨x, rfl⟩
 
 @[simp, to_additive]
 lemma coe_srange_restrict {N} [has_mul N] (f : M →ₙ* N) (x : M) :
@@ -680,7 +686,7 @@ by simp only [eq_top_iff, le_prod_iff, ← (gc_map_comap _).le_iff_le, ← srang
 /-- The semigroup hom associated to an inclusion of subsemigroups. -/
 @[to_additive "The `add_semigroup` hom associated to an inclusion of subsemigroups."]
 def inclusion {S T : subsemigroup M} (h : S ≤ T) : S →ₙ* T :=
-(mul_mem_class.subtype S).cod_srestrict _ (λ x, h x.2)
+(mul_mem_class.subtype S).cod_restrict _ (λ x, h x.2)
 
 @[simp, to_additive]
 lemma range_subtype (s : subsemigroup M) : (mul_mem_class.subtype s).srange = s :=
diff --git a/src/group_theory/sylow.lean b/src/group_theory/sylow.lean
index 6162d38e67c71..1560211d6a95c 100644
--- a/src/group_theory/sylow.lean
+++ b/src/group_theory/sylow.lean
@@ -4,15 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes, Thomas Browning
 -/
 
-import data.nat.factorization
+import data.nat.factorization.basic
 import data.set_like.fintype
 import group_theory.group_action.conj_act
 import group_theory.p_group
 import group_theory.noncomm_pi_coprod
+import order.atoms.finite
 
 /-!
 # Sylow theorems
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Sylow theorems are the following results for every finite group `G` and every prime number `p`.
 
 * There exists a Sylow `p`-subgroup of `G`.
@@ -32,6 +36,8 @@ The Sylow theorems are the following results for every finite group `G` and ever
   there exists a subgroup of `G` of order `pⁿ`.
 * `is_p_group.exists_le_sylow`: A generalization of Sylow's first theorem:
   Every `p`-subgroup is contained in a Sylow `p`-subgroup.
+* `sylow.card_eq_multiplicity`: The cardinality of a Sylow subgroup is `p ^ n`
+ where `n` is the multiplicity of `p` in the group order.
 * `sylow_conjugate`: A generalization of Sylow's second theorem:
   If the number of Sylow `p`-subgroups is finite, then all Sylow `p`-subgroups are conjugate.
 * `card_sylow_modeq_one`: A generalization of Sylow's third theorem:
@@ -68,9 +74,48 @@ instance : set_like (sylow p G) G :=
   coe_injective' := λ P Q h, ext (set_like.coe_injective h) }
 
 instance : subgroup_class (sylow p G) G :=
-{ mul_mem := λ s, s.mul_mem',
+{ mul_mem := λ s _ _, s.mul_mem',
   one_mem := λ s, s.one_mem',
-  inv_mem := λ s, s.inv_mem' }
+  inv_mem := λ s _, s.inv_mem' }
+
+variables (P : sylow p G)
+
+/-- The action by a Sylow subgroup is the action by the underlying group. -/
+instance mul_action_left {α : Type*} [mul_action G α] : mul_action P α :=
+subgroup.mul_action ↑P
+
+variables {K : Type*} [group K] (ϕ : K →* G) {N : subgroup G}
+
+/-- The preimage of a Sylow subgroup under a p-group-kernel homomorphism is a Sylow subgroup. -/
+def comap_of_ker_is_p_group (hϕ : is_p_group p ϕ.ker) (h : ↑P ≤ ϕ.range) : sylow p K :=
+{ P.1.comap ϕ with
+  is_p_group' := P.2.comap_of_ker_is_p_group ϕ hϕ,
+  is_maximal' := λ Q hQ hle, by
+  { rw ← P.3 (hQ.map ϕ) (le_trans (ge_of_eq (map_comap_eq_self h)) (map_mono hle)),
+    exact (comap_map_eq_self ((P.1.ker_le_comap ϕ).trans hle)).symm }, }
+
+@[simp] lemma coe_comap_of_ker_is_p_group (hϕ : is_p_group p ϕ.ker) (h : ↑P ≤ ϕ.range) :
+  ↑(P.comap_of_ker_is_p_group ϕ hϕ h) = subgroup.comap ϕ ↑P := rfl
+
+/-- The preimage of a Sylow subgroup under an injective homomorphism is a Sylow subgroup. -/
+def comap_of_injective (hϕ : function.injective ϕ) (h : ↑P ≤ ϕ.range) : sylow p K :=
+P.comap_of_ker_is_p_group ϕ (is_p_group.ker_is_p_group_of_injective hϕ) h
+
+@[simp] lemma coe_comap_of_injective (hϕ : function.injective ϕ) (h : ↑P ≤ ϕ.range) :
+  ↑(P.comap_of_injective ϕ hϕ h) = subgroup.comap ϕ ↑P := rfl
+
+/-- A sylow subgroup of G is also a sylow subgroup of a subgroup of G. -/
+protected def subtype (h : ↑P ≤ N) : sylow p N :=
+P.comap_of_injective N.subtype subtype.coe_injective (by rwa [subtype_range])
+
+@[simp] lemma coe_subtype (h : ↑P ≤ N) : ↑(P.subtype h) = subgroup_of ↑P N := rfl
+
+lemma subtype_injective {P Q : sylow p G} {hP : ↑P ≤ N} {hQ : ↑Q ≤ N}
+  (h : P.subtype hP = Q.subtype hQ) : P = Q :=
+begin
+  rw set_like.ext_iff at h ⊢,
+  exact λ g, ⟨λ hg, (h ⟨g, hP hg⟩).mp hg, λ hg, (h ⟨g, hQ hg⟩).mpr hg⟩,
+end
 
 end sylow
 
@@ -96,16 +141,16 @@ noncomputable instance sylow.inhabited : inhabited (sylow p G) :=
 classical.inhabited_of_nonempty sylow.nonempty
 
 lemma sylow.exists_comap_eq_of_ker_is_p_group {H : Type*} [group H] (P : sylow p H)
-  {f : H →* G} (hf : is_p_group p f.ker) : ∃ Q : sylow p G, Q.1.comap f = P :=
+  {f : H →* G} (hf : is_p_group p f.ker) : ∃ Q : sylow p G, (Q : subgroup G).comap f = P :=
 exists_imp_exists (λ Q hQ, P.3 (Q.2.comap_of_ker_is_p_group f hf) (map_le_iff_le_comap.mp hQ))
   (P.2.map f).exists_le_sylow
 
 lemma sylow.exists_comap_eq_of_injective {H : Type*} [group H] (P : sylow p H)
-  {f : H →* G} (hf : function.injective f) : ∃ Q : sylow p G, Q.1.comap f = P :=
+  {f : H →* G} (hf : function.injective f) : ∃ Q : sylow p G, (Q : subgroup G).comap f = P :=
 P.exists_comap_eq_of_ker_is_p_group (is_p_group.ker_is_p_group_of_injective hf)
 
 lemma sylow.exists_comap_subtype_eq {H : subgroup G} (P : sylow p H) :
-  ∃ Q : sylow p G, Q.1.comap H.subtype = P :=
+  ∃ Q : sylow p G, (Q : subgroup G).comap H.subtype = P :=
 P.exists_comap_eq_of_injective subtype.coe_injective
 
 /-- If the kernel of `f : H →* G` is a `p`-group,
@@ -124,7 +169,11 @@ sylow.fintype_of_ker_is_p_group (is_p_group.ker_is_p_group_of_injective hf)
 
 /-- If `H` is a subgroup of `G`, then `fintype (sylow p G)` implies `fintype (sylow p H)`. -/
 noncomputable instance (H : subgroup G) [fintype (sylow p G)] : fintype (sylow p H) :=
-sylow.fintype_of_injective (show function.injective H.subtype, from subtype.coe_injective)
+sylow.fintype_of_injective H.subtype_injective
+
+/-- If `H` is a subgroup of `G`, then `finite (sylow p G)` implies `finite (sylow p H)`. -/
+instance (H : subgroup G) [finite (sylow p G)] : finite (sylow p H) :=
+by { casesI nonempty_fintype (sylow p G), apply_instance }
 
 open_locale pointwise
 
@@ -151,6 +200,13 @@ lemma sylow.coe_subgroup_smul {g : G} {P : sylow p G} :
 lemma sylow.coe_smul {g : G} {P : sylow p G} :
   ↑(g • P) = mul_aut.conj g • (P : set G) := rfl
 
+lemma sylow.smul_le {P : sylow p G} {H : subgroup G} (hP : ↑P ≤ H) (h : H) : ↑(h • P) ≤ H :=
+subgroup.conj_smul_le_of_le hP h
+
+lemma sylow.smul_subtype {P : sylow p G} {H : subgroup G} (hP : ↑P ≤ H) (h : H) :
+  h • P.subtype hP = (h • P).subtype (sylow.smul_le hP h) :=
+sylow.ext (subgroup.conj_smul_subgroup_of hP h)
+
 lemma sylow.smul_eq_iff_mem_normalizer {g : G} {P : sylow p G} :
   g • P = P ↔ g ∈ (P : subgroup G).normalizer :=
 begin
@@ -180,9 +236,10 @@ by rw [P.sylow_mem_fixed_points_iff, ←inf_eq_left, hP.inf_normalizer_sylow, in
 
 /-- A generalization of **Sylow's second theorem**.
   If the number of Sylow `p`-subgroups is finite, then all Sylow `p`-subgroups are conjugate. -/
-instance [hp : fact p.prime] [fintype (sylow p G)] : is_pretransitive G (sylow p G) :=
+instance [hp : fact p.prime] [finite (sylow p G)] : is_pretransitive G (sylow p G) :=
 ⟨λ P Q, by
 { classical,
+  casesI nonempty_fintype (sylow p G),
   have H := λ {R : sylow p G} {S : orbit G P},
   calc S ∈ fixed_points R (orbit G P)
       ↔ S.1 ∈ fixed_points R (sylow p G) : forall_congr (λ a, subtype.ext_iff)
@@ -217,55 +274,117 @@ begin
   exact (P.2.card_modeq_card_fixed_points (sylow p G)).trans (by rw this),
 end
 
+lemma not_dvd_card_sylow [hp : fact p.prime] [fintype (sylow p G)] : ¬ p ∣ card (sylow p G) :=
+λ h, hp.1.ne_one (nat.dvd_one.mp ((nat.modeq_iff_dvd' zero_le_one).mp
+  ((nat.modeq_zero_iff_dvd.mpr h).symm.trans (card_sylow_modeq_one p G))))
+
 variables {p} {G}
 
 /-- Sylow subgroups are isomorphic -/
 def sylow.equiv_smul (P : sylow p G) (g : G) : P ≃* (g • P : sylow p G) :=
-equiv_smul (mul_aut.conj g) P.1
+equiv_smul (mul_aut.conj g) ↑P
 
 /-- Sylow subgroups are isomorphic -/
-noncomputable def sylow.equiv [fact p.prime] [fintype (sylow p G)] (P Q : sylow p G) :
+noncomputable def sylow.equiv [fact p.prime] [finite (sylow p G)] (P Q : sylow p G) :
   P ≃* Q :=
 begin
   rw ← classical.some_spec (exists_smul_eq G P Q),
   exact P.equiv_smul (classical.some (exists_smul_eq G P Q)),
 end
 
-@[simp] lemma sylow.orbit_eq_top [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
+@[simp] lemma sylow.orbit_eq_top [fact p.prime] [finite (sylow p G)] (P : sylow p G) :
   orbit G P = ⊤ :=
 top_le_iff.mp (λ Q hQ, exists_smul_eq G P Q)
 
-lemma sylow.stabilizer_eq_normalizer (P : sylow p G) : stabilizer G P = P.1.normalizer :=
+lemma sylow.stabilizer_eq_normalizer (P : sylow p G) :
+  stabilizer G P = (P : subgroup G).normalizer :=
 ext (λ g, sylow.smul_eq_iff_mem_normalizer)
 
+lemma sylow.conj_eq_normalizer_conj_of_mem_centralizer
+  [fact p.prime] [finite (sylow p G)] (P : sylow p G) (x g : G)
+  (hx : x ∈ centralizer (P : set G)) (hy : g⁻¹ * x * g ∈ centralizer (P : set G)) :
+  ∃ n ∈ (P : subgroup G).normalizer, g⁻¹ * x * g = n⁻¹ * x * n :=
+begin
+  have h1 : ↑P ≤ centralizer (zpowers x : set G),
+  { rwa [le_centralizer_iff, zpowers_le] },
+  have h2 : ↑(g • P) ≤ centralizer (zpowers x : set G),
+  { rw [le_centralizer_iff, zpowers_le],
+    rintros - ⟨z, hz, rfl⟩,
+    specialize hy z hz,
+    rwa [←mul_assoc, ←eq_mul_inv_iff_mul_eq, mul_assoc, mul_assoc, mul_assoc, ←mul_assoc,
+      eq_inv_mul_iff_mul_eq, ←mul_assoc, ←mul_assoc] at hy },
+  obtain ⟨h, hh⟩ :=
+    exists_smul_eq (centralizer (zpowers x : set G)) ((g • P).subtype h2) (P.subtype h1),
+  simp_rw [sylow.smul_subtype, smul_def, smul_smul] at hh,
+  refine ⟨h * g, sylow.smul_eq_iff_mem_normalizer.mp (sylow.subtype_injective hh), _⟩,
+  rw [←mul_assoc, commute.right_comm (h.prop x (mem_zpowers x)), mul_inv_rev, inv_mul_cancel_right]
+end
+
+lemma sylow.conj_eq_normalizer_conj_of_mem [fact p.prime] [finite (sylow p G)] (P : sylow p G)
+  [hP : (P : subgroup G).is_commutative] (x g : G) (hx : x ∈ P) (hy : g⁻¹ * x * g ∈ P) :
+  ∃ n ∈ (P : subgroup G).normalizer, g⁻¹ * x * g = n⁻¹ * x * n :=
+P.conj_eq_normalizer_conj_of_mem_centralizer x g
+  (le_centralizer (P : subgroup G) hx : _) (le_centralizer (P : subgroup G) hy : _)
+
 /-- Sylow `p`-subgroups are in bijection with cosets of the normalizer of a Sylow `p`-subgroup -/
 noncomputable def sylow.equiv_quotient_normalizer [fact p.prime] [fintype (sylow p G)]
-  (P : sylow p G) : sylow p G ≃ G ⧸ P.1.normalizer :=
+  (P : sylow p G) : sylow p G ≃ G ⧸ (P : subgroup G).normalizer :=
 calc sylow p G ≃ (⊤ : set (sylow p G)) : (equiv.set.univ (sylow p G)).symm
 ... ≃ orbit G P : by rw P.orbit_eq_top
 ... ≃ G ⧸ (stabilizer G P) : orbit_equiv_quotient_stabilizer G P
-... ≃ G ⧸ P.1.normalizer : by rw P.stabilizer_eq_normalizer
+... ≃ G ⧸ (P : subgroup G).normalizer : by rw P.stabilizer_eq_normalizer
 
 noncomputable instance [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
-  fintype (G ⧸ P.1.normalizer) :=
+  fintype (G ⧸ (P : subgroup G).normalizer) :=
 of_equiv (sylow p G) P.equiv_quotient_normalizer
 
 lemma card_sylow_eq_card_quotient_normalizer [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
-  card (sylow p G) = card (G ⧸ P.1.normalizer) :=
+  card (sylow p G) = card (G ⧸ (P : subgroup G).normalizer) :=
 card_congr P.equiv_quotient_normalizer
 
 lemma card_sylow_eq_index_normalizer [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
-  card (sylow p G) = P.1.normalizer.index :=
-(card_sylow_eq_card_quotient_normalizer P).trans P.1.normalizer.index_eq_card.symm
+  card (sylow p G) = (P : subgroup G).normalizer.index :=
+(card_sylow_eq_card_quotient_normalizer P).trans (P : subgroup G).normalizer.index_eq_card.symm
 
 lemma card_sylow_dvd_index [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
-  card (sylow p G) ∣ P.1.index :=
+  card (sylow p G) ∣ (P : subgroup G).index :=
 ((congr_arg _ (card_sylow_eq_index_normalizer P)).mp dvd_rfl).trans (index_dvd_of_le le_normalizer)
 
-/-- Frattini's Argument: If `N` is a normal subgroup of `G`, and if `P` is a Sylow `p`-subgroup
+lemma not_dvd_index_sylow' [hp : fact p.prime] (P : sylow p G) [(P : subgroup G).normal]
+  [finite_index (P : subgroup G)] : ¬ p ∣ (P : subgroup G).index :=
+begin
+  intro h,
+  haveI := (P : subgroup G).fintype_quotient_of_finite_index,
+  rw index_eq_card at h,
+  obtain ⟨x, hx⟩ := exists_prime_order_of_dvd_card p h,
+  have h := is_p_group.of_card ((order_eq_card_zpowers.symm.trans hx).trans (pow_one p).symm),
+  let Q := (zpowers x).comap (quotient_group.mk' (P : subgroup G)),
+  have hQ : is_p_group p Q,
+  { apply h.comap_of_ker_is_p_group,
+    rw [quotient_group.ker_mk],
+    exact P.2 },
+  replace hp := mt order_of_eq_one_iff.mpr (ne_of_eq_of_ne hx hp.1.ne_one),
+  rw [←zpowers_eq_bot, ←ne, ←bot_lt_iff_ne_bot, ←comap_lt_comap_of_surjective
+    (quotient_group.mk'_surjective _), monoid_hom.comap_bot, quotient_group.ker_mk] at hp,
+  exact hp.ne' (P.3 hQ hp.le),
+end
+
+lemma not_dvd_index_sylow [hp : fact p.prime] [finite (sylow p G)] (P : sylow p G)
+  (hP : relindex ↑P (P : subgroup G).normalizer ≠ 0) : ¬ p ∣ (P : subgroup G).index :=
+begin
+  casesI nonempty_fintype (sylow p G),
+  rw [←relindex_mul_index le_normalizer, ←card_sylow_eq_index_normalizer],
+  haveI : (P.subtype le_normalizer : subgroup (P : subgroup G).normalizer).normal :=
+  subgroup.normal_in_normalizer,
+  haveI : finite_index ↑(P.subtype le_normalizer) := ⟨hP⟩,
+  replace hP := not_dvd_index_sylow' (P.subtype le_normalizer),
+  exact hp.1.not_dvd_mul hP (not_dvd_card_sylow p G),
+end
+
+/-- **Frattini's Argument**: If `N` is a normal subgroup of `G`, and if `P` is a Sylow `p`-subgroup
   of `N`, then `N_G(P) ⊔ N = G`. -/
 lemma sylow.normalizer_sup_eq_top {p : ℕ} [fact p.prime] {N : subgroup G} [N.normal]
-  [fintype (sylow p N)] (P : sylow p N) : ((↑P : subgroup N).map N.subtype).normalizer ⊔ N = ⊤ :=
+  [finite (sylow p N)] (P : sylow p N) : ((↑P : subgroup N).map N.subtype).normalizer ⊔ N = ⊤ :=
 begin
   refine top_le_iff.mp (λ g hg, _),
   obtain ⟨n, hn⟩ := exists_smul_eq N ((mul_aut.conj_normal g : mul_aut N) • P) P,
@@ -279,6 +398,13 @@ begin
   refl,
 end
 
+/-- **Frattini's Argument**: If `N` is a normal subgroup of `G`, and if `P` is a Sylow `p`-subgroup
+  of `N`, then `N_G(P) ⊔ N = G`. -/
+lemma sylow.normalizer_sup_eq_top' {p : ℕ} [fact p.prime] {N : subgroup G} [N.normal]
+  [finite (sylow p N)] (P : sylow p G) (hP : ↑P ≤ N) : (P : subgroup G).normalizer ⊔ N = ⊤ :=
+by rw [← sylow.normalizer_sup_eq_top (P.subtype hP), P.coe_subtype, subgroup_of_map_subtype,
+  inf_of_le_left hP]
+
 end infinite_sylow
 
 open equiv equiv.perm finset function list quotient_group
@@ -298,12 +424,12 @@ namespace sylow
 
 open subgroup submonoid mul_action
 
-lemma mem_fixed_points_mul_left_cosets_iff_mem_normalizer {H : subgroup G}
-  [fintype ((H : set G) : Type u)] {x : G} :
+lemma mem_fixed_points_mul_left_cosets_iff_mem_normalizer {H : subgroup G} [finite ↥(H : set G)]
+  {x : G} :
   (x : G ⧸ H) ∈ fixed_points H (G ⧸ H) ↔ x ∈ normalizer H :=
 ⟨λ hx, have ha : ∀ {y : G ⧸ H}, y ∈ orbit H (x : G ⧸ H) → y = x,
   from λ _, ((mem_fixed_points' _).1 hx _),
-  inv_mem_iff.1 (@mem_normalizer_fintype _ _ _ _inst_2 _ (λ n (hn : n ∈ H),
+  inv_mem_iff.1 (mem_normalizer_fintype (λ n (hn : n ∈ H),
     have (n⁻¹ * x)⁻¹ * x ∈ H := quotient_group.eq.1 (ha (mem_orbit _ ⟨n⁻¹, H.inv_mem hn⟩)),
     show _ ∈ H, by {rw [mul_inv_rev, inv_inv] at this, convert this, rw inv_inv}
     )),
@@ -315,12 +441,13 @@ lemma mem_fixed_points_mul_left_cosets_iff_mem_normalizer {H : subgroup G}
   $ by rw hx at hb₂;
     simpa [mul_inv_rev, mul_assoc] using hb₂)⟩
 
-def fixed_points_mul_left_cosets_equiv_quotient (H : subgroup G) [fintype (H : set G)] :
+/-- The fixed points of the action of `H` on its cosets correspond to `normalizer H / H`. -/
+def fixed_points_mul_left_cosets_equiv_quotient (H : subgroup G) [finite (H : set G)] :
   mul_action.fixed_points H (G ⧸ H) ≃
   normalizer H ⧸ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H) :=
 @subtype_quotient_equiv_quotient_subtype G (normalizer H : set G) (id _) (id _) (fixed_points _ _)
-  (λ a, (@mem_fixed_points_mul_left_cosets_iff_mem_normalizer _ _ _ _inst_2 _).symm)
-  (by intros; refl)
+  (λ a, (@mem_fixed_points_mul_left_cosets_iff_mem_normalizer _ _ _ ‹_› _).symm)
+  (by { intros, rw setoid_has_equiv, simp only [left_rel_apply], refl })
 
 /-- If `H` is a `p`-subgroup of `G`, then the index of `H` inside its normalizer is congruent
   mod `p` to the index of `H`.  -/
@@ -338,14 +465,10 @@ end
 lemma card_normalizer_modeq_card [fintype G] {p : ℕ} {n : ℕ} [hp : fact p.prime]
   {H : subgroup G} (hH : fintype.card H = p ^ n) :
   card (normalizer H) ≡ card G [MOD p ^ (n + 1)] :=
-have subgroup.comap ((normalizer H).subtype : normalizer H →* G) H ≃ H,
-  from set.bij_on.equiv (normalizer H).subtype
-    ⟨λ _, id, λ _ _ _ _ h, subtype.val_injective h,
-      λ x hx, ⟨⟨x, le_normalizer hx⟩, hx, rfl⟩⟩,
+have H.subgroup_of (normalizer H) ≃ H, from (subgroup_of_equiv_of_le le_normalizer).to_equiv,
 begin
   rw [card_eq_card_quotient_mul_card_subgroup H,
-      card_eq_card_quotient_mul_card_subgroup
-        (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H),
+      card_eq_card_quotient_mul_card_subgroup (H.subgroup_of (normalizer H)),
       fintype.card_congr this, hH, pow_succ],
   exact (card_quotient_normalizer_modeq_card_quotient hH).mul_right' _
 end
@@ -357,8 +480,7 @@ lemma prime_dvd_card_quotient_normalizer [fintype G] {p : ℕ} {n : ℕ} [hp : f
   p ∣ card (normalizer H ⧸ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H)) :=
 let ⟨s, hs⟩ := exists_eq_mul_left_of_dvd hdvd in
 have hcard : card (G ⧸ H) = s * p :=
-  (nat.mul_left_inj (show card H > 0, from fintype.card_pos_iff.2
-      ⟨⟨1, H.one_mem⟩⟩)).1
+  (mul_left_inj' (show card H ≠ 0, from fintype.card_ne_zero)).1
     (by rwa [← card_eq_card_quotient_mul_card_subgroup H, hH, hs,
       pow_succ', mul_assoc, mul_comm p]),
 have hm : s * p % p =
@@ -383,31 +505,29 @@ theorem exists_subgroup_card_pow_succ [fintype G] {p : ℕ} {n : ℕ} [hp : fact
   ∃ K : subgroup G, fintype.card K = p ^ (n + 1) ∧ H ≤ K :=
 let ⟨s, hs⟩ := exists_eq_mul_left_of_dvd hdvd in
 have hcard : card (G ⧸ H) = s * p :=
-  (nat.mul_left_inj (show card H > 0, from fintype.card_pos_iff.2
-      ⟨⟨1, H.one_mem⟩⟩)).1
+  (mul_left_inj' (show card H ≠ 0, from fintype.card_ne_zero)).1
     (by rwa [← card_eq_card_quotient_mul_card_subgroup H, hH, hs,
       pow_succ', mul_assoc, mul_comm p]),
 have hm : s * p % p =
-  card (normalizer H ⧸ (subgroup.comap (normalizer H).subtype H)) % p :=
+  card (normalizer H ⧸ (H.subgroup_of H.normalizer)) % p :=
   card_congr (fixed_points_mul_left_cosets_equiv_quotient H) ▸ hcard ▸
     (is_p_group.of_card hH).card_modeq_card_fixed_points _,
-have hm' : p ∣ card (normalizer H ⧸ (subgroup.comap (normalizer H).subtype H)) :=
+have hm' : p ∣ card (normalizer H ⧸ (H.subgroup_of H.normalizer)) :=
   nat.dvd_of_mod_eq_zero
     (by rwa [nat.mod_eq_zero_of_dvd (dvd_mul_left _ _), eq_comm] at hm),
 let ⟨x, hx⟩ := @exists_prime_order_of_dvd_card _ (quotient_group.quotient.group _) _ _ hp hm' in
-have hequiv : H ≃ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H) :=
-  ⟨λ a, ⟨⟨a.1, le_normalizer a.2⟩, a.2⟩, λ a, ⟨a.1.1, a.2⟩,
-    λ ⟨_, _⟩, rfl, λ ⟨⟨_, _⟩, _⟩, rfl⟩,
-⟨subgroup.map ((normalizer H).subtype) (subgroup.comap
-  (quotient_group.mk' (comap H.normalizer.subtype H)) (zpowers x)),
+have hequiv : H ≃ (H.subgroup_of H.normalizer) :=
+  (subgroup_of_equiv_of_le le_normalizer).symm.to_equiv,
+⟨subgroup.map ((normalizer H).subtype)
+  (subgroup.comap (mk' (H.subgroup_of H.normalizer)) (zpowers x)),
 begin
   show card ↥(map H.normalizer.subtype
-    (comap (mk' (comap H.normalizer.subtype H)) (subgroup.zpowers x))) = p ^ (n + 1),
-  suffices : card ↥(subtype.val '' ((subgroup.comap (mk' (comap H.normalizer.subtype H))
+    (comap (mk' (H.subgroup_of H.normalizer)) (subgroup.zpowers x))) = p ^ (n + 1),
+  suffices : card ↥(subtype.val '' ((subgroup.comap (mk' (H.subgroup_of H.normalizer))
     (zpowers x)) : set (↥(H.normalizer)))) = p^(n+1),
   { convert this using 2 },
   rw [set.card_image_of_injective
-        (subgroup.comap (mk' (comap H.normalizer.subtype H)) (zpowers x) : set (H.normalizer))
+        (subgroup.comap (mk' (H.subgroup_of H.normalizer)) (zpowers x) : set (H.normalizer))
         subtype.val_injective,
       pow_succ', ← hH, fintype.card_congr hequiv, ← hx, order_eq_card_zpowers,
       ← fintype.card_prod],
@@ -447,16 +567,10 @@ theorem exists_subgroup_card_pow_prime [fintype G] (p : ℕ) {n : ℕ} [fact p.p
 let ⟨K, hK⟩ := exists_subgroup_card_pow_prime_le p hdvd ⊥ (by simp) n.zero_le in
 ⟨K, hK.1⟩
 
-lemma pow_dvd_card_of_pow_dvd_card [fintype G] {p n : ℕ} [fact p.prime] (P : sylow p G)
+lemma pow_dvd_card_of_pow_dvd_card [fintype G] {p n : ℕ} [hp : fact p.prime] (P : sylow p G)
   (hdvd : p ^ n ∣ card G) : p ^ n ∣ card P :=
-begin
-  obtain ⟨Q, hQ⟩ := exists_subgroup_card_pow_prime p hdvd,
-  obtain ⟨R, hR⟩ := (is_p_group.of_card hQ).exists_le_sylow,
-  obtain ⟨g, rfl⟩ := exists_smul_eq G R P,
-  calc p ^ n = card Q : hQ.symm
-  ... ∣ card R : card_dvd_of_le hR
-  ... = card (g • R) : card_congr (R.equiv_smul g).to_equiv
-end
+(hp.1.coprime_pow_of_not_dvd (not_dvd_index_sylow P
+  index_ne_zero_of_finite)).symm.dvd_of_dvd_mul_left ((index_mul_card P.1).symm ▸ hdvd)
 
 lemma dvd_card_of_dvd_card [fintype G] {p : ℕ} [fact p.prime] (P : sylow p G)
   (hdvd : p ∣ card G) : p ∣ card P :=
@@ -466,6 +580,12 @@ begin
   rwa pow_one at key,
 end
 
+/-- Sylow subgroups are Hall subgroups. -/
+lemma card_coprime_index [fintype G] {p : ℕ} [hp : fact p.prime] (P : sylow p G) :
+  (card P).coprime (index (P : subgroup G)) :=
+let ⟨n, hn⟩ := is_p_group.iff_card.mp P.2 in
+hn.symm ▸ (hp.1.coprime_pow_of_not_dvd (not_dvd_index_sylow P index_ne_zero_of_finite)).symm
+
 lemma ne_bot_of_dvd_card [fintype G] {p : ℕ} [hp : fact p.prime] (P : sylow p G)
   (hdvd : p ∣ card G) : (P : subgroup G) ≠ ⊥ :=
 begin
@@ -474,18 +594,33 @@ begin
   rwa [h, card_bot] at key,
 end
 
-/-- The cardinality of a Sylow group is `p ^ n`
+/-- The cardinality of a Sylow subgroup is `p ^ n`
  where `n` is the multiplicity of `p` in the group order. -/
 lemma card_eq_multiplicity [fintype G] {p : ℕ} [hp : fact p.prime] (P : sylow p G) :
   card P = p ^ nat.factorization (card G) p :=
 begin
   obtain ⟨n, heq : card P = _⟩ := is_p_group.iff_card.mp (P.is_p_group'),
-  refine nat.dvd_antisymm _ (P.pow_dvd_card_of_pow_dvd_card (nat.pow_factorization_dvd _ p)),
-  rw [heq, ←hp.out.pow_dvd_iff_dvd_pow_factorization (show card G ≠ 0, from card_ne_zero), ←heq],
+  refine nat.dvd_antisymm _ (P.pow_dvd_card_of_pow_dvd_card (nat.ord_proj_dvd _ p)),
+  rw [heq, ←hp.out.pow_dvd_iff_dvd_ord_proj (show card G ≠ 0, from card_ne_zero), ←heq],
   exact P.1.card_subgroup_dvd_card,
 end
 
-lemma subsingleton_of_normal {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G)
+/-- A subgroup with cardinality `p ^ n` is a Sylow subgroup
+ where `n` is the multiplicity of `p` in the group order. -/
+def of_card [fintype G] {p : ℕ} [hp : fact p.prime] (H : subgroup G) [fintype H]
+  (card_eq : card H = p ^ (card G).factorization p) : sylow p G :=
+{ to_subgroup := H,
+  is_p_group' := is_p_group.of_card card_eq,
+  is_maximal' := begin
+    obtain ⟨P, hHP⟩ := (is_p_group.of_card card_eq).exists_le_sylow,
+    exact set_like.ext' (set.eq_of_subset_of_card_le hHP
+      (P.card_eq_multiplicity.trans card_eq.symm).le).symm ▸ λ _, P.3,
+  end }
+
+@[simp, norm_cast] lemma coe_of_card [fintype G] {p : ℕ} [hp : fact p.prime] (H : subgroup G)
+  [fintype H] (card_eq : card H = p ^ (card G).factorization p) : ↑(of_card H card_eq) = H := rfl
+
+lemma subsingleton_of_normal {p : ℕ} [fact p.prime] [finite (sylow p G)] (P : sylow p G)
   (h : (P : subgroup G).normal) : subsingleton (sylow p G) :=
 begin
   apply subsingleton.intro,
@@ -500,7 +635,7 @@ section pointwise
 
 open_locale pointwise
 
-lemma characteristic_of_normal {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G)
+lemma characteristic_of_normal {p : ℕ} [fact p.prime] [finite (sylow p G)] (P : sylow p G)
   (h : (P : subgroup G).normal) :
   (P : subgroup G).characteristic :=
 begin
@@ -513,84 +648,44 @@ end
 
 end pointwise
 
-/-- The preimage of a Sylow subgroup under a homomorphism with p-group-kernel is a Sylow subgroup -/
-def comap_of_ker_is_p_group {p : ℕ} (P : sylow p G)
-  {K : Type*} [group K] (ϕ : K →* G) (hϕ : is_p_group p ϕ.ker) (h : P.1 ≤ ϕ.range) :
-  sylow p K :=
-{ P.1.comap ϕ with
-  is_p_group' := P.2.comap_of_ker_is_p_group ϕ hϕ,
-  is_maximal' := λ Q hQ hle, by
-  { rw ← P.3 (hQ.map ϕ) (le_trans (ge_of_eq (map_comap_eq_self h)) (map_mono hle)),
-    exact (comap_map_eq_self ((P.1.ker_le_comap ϕ).trans hle)).symm }, }
-
-@[simp]
-lemma coe_comap_of_ker_is_p_group {p : ℕ} {P : sylow p G}
-  {K : Type*} [group K] (ϕ : K →* G) (hϕ : is_p_group p ϕ.ker) (h : P.1 ≤ ϕ.range) :
-  ↑(P.comap_of_ker_is_p_group ϕ hϕ h) = subgroup.comap ϕ ↑P := rfl
-
-/-- The preimage of a Sylow subgroup under an injective homomorphism is a Sylow subgroup -/
-def comap_of_injective {p : ℕ} (P : sylow p G)
-  {K : Type*} [group K] (ϕ : K →* G) (hϕ : function.injective ϕ) (h : P.1 ≤ ϕ.range) :
-  sylow p K :=
-P.comap_of_ker_is_p_group ϕ (is_p_group.ker_is_p_group_of_injective hϕ) h
-
-@[simp]
-lemma coe_comap_of_injective {p : ℕ} {P : sylow p G}
-  {K : Type*} [group K] (ϕ : K →* G) (hϕ : function.injective ϕ) (h : P.1 ≤ ϕ.range)  :
-  ↑(P.comap_of_injective ϕ hϕ h) = subgroup.comap ϕ ↑P := rfl
-
-/-- A sylow subgroup in G is also a sylow subgroup in a subgroup of G. -/
-def subtype {p : ℕ} (P : sylow p G) (N : subgroup G) (h : ↑P ≤ N) : sylow p N :=
-P.comap_of_injective N.subtype subtype.coe_injective (by simp [h])
-
-@[simp]
-lemma coe_subtype {p : ℕ} {P : sylow p G} {N : subgroup G} {h : P.1 ≤ N} :
-  ↑(P.subtype N h) = subgroup.comap N.subtype ↑P := rfl
-
-lemma normal_of_normalizer_normal {p : ℕ} [fact p.prime] [fintype (sylow p G)]
+lemma normal_of_normalizer_normal {p : ℕ} [fact p.prime] [finite (sylow p G)]
   (P : sylow p G) (hn : (↑P : subgroup G).normalizer.normal) :
   (↑P : subgroup G).normal :=
-by rw [←normalizer_eq_top, ←normalizer_sup_eq_top (P.subtype _ le_normalizer), coe_subtype,
-  map_comap_eq_self (le_normalizer.trans (ge_of_eq (subtype_range _))), sup_idem]
+by rw [← normalizer_eq_top, ← normalizer_sup_eq_top' P le_normalizer, sup_idem]
 
-@[simp] lemma normalizer_normalizer {p : ℕ} [fact p.prime] [fintype (sylow p G)]
- (P : sylow p G) :
+@[simp] lemma normalizer_normalizer {p : ℕ} [fact p.prime] [finite (sylow p G)] (P : sylow p G) :
  (↑P : subgroup G).normalizer.normalizer = (↑P : subgroup G).normalizer :=
 begin
-  have := normal_of_normalizer_normal (P.subtype _ (le_normalizer.trans le_normalizer)),
-  simp_rw [←normalizer_eq_top, coe_subtype, ←comap_subtype_normalizer_eq le_normalizer,
-    ←comap_subtype_normalizer_eq le_rfl, comap_subtype_self_eq_top] at this,
+  have := normal_of_normalizer_normal (P.subtype (le_normalizer.trans le_normalizer)),
+  simp_rw [←normalizer_eq_top, coe_subtype, ← subgroup_of_normalizer_eq le_normalizer,
+    ← subgroup_of_normalizer_eq le_rfl, subgroup_of_self] at this,
   rw [←subtype_range (P : subgroup G).normalizer.normalizer, monoid_hom.range_eq_map, ←this rfl],
   exact map_comap_eq_self (le_normalizer.trans (ge_of_eq (subtype_range _))),
 end
 
-lemma normal_of_all_max_subgroups_normal [fintype G]
+lemma normal_of_all_max_subgroups_normal [finite G]
   (hnc : ∀ (H : subgroup G), is_coatom H → H.normal)
-  {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
+  {p : ℕ} [fact p.prime] [finite (sylow p G)] (P : sylow p G) :
   (↑P : subgroup G).normal :=
 normalizer_eq_top.mp begin
   rcases eq_top_or_exists_le_coatom ((↑P : subgroup G).normalizer) with heq | ⟨K, hK, hNK⟩,
   { exact heq },
   { haveI := hnc _ hK,
-    have hPK := le_trans le_normalizer hNK,
-    let P' := P.subtype K hPK,
-    exfalso,
-    apply hK.1,
-    calc K = (↑P : subgroup G).normalizer ⊔ K : by { rw sup_eq_right.mpr, exact hNK }
-    ... = (map K.subtype (↑P' : subgroup K)).normalizer ⊔ K : by simp [map_comap_eq_self, hPK]
-    ... = ⊤ : normalizer_sup_eq_top P' },
+    have hPK : ↑P ≤ K := le_trans le_normalizer hNK,
+    refine (hK.1 _).elim,
+    rw [← sup_of_le_right hNK, P.normalizer_sup_eq_top' hPK] },
 end
 
 lemma normal_of_normalizer_condition (hnc : normalizer_condition G)
- {p : ℕ} [fact p.prime] [fintype (sylow p G)] (P : sylow p G) :
+ {p : ℕ} [fact p.prime] [finite (sylow p G)] (P : sylow p G) :
  (↑P : subgroup G).normal :=
 normalizer_eq_top.mp $ normalizer_condition_iff_only_full_group_self_normalizing.mp hnc _ $
   normalizer_normalizer _
 
 open_locale big_operators
 
-/-- If all its sylow groups are normal, then a finite group is isomorphic to the direct product
-of these sylow groups.
+/-- If all its Sylow subgroups are normal, then a finite group is isomorphic to the direct product
+of these Sylow subgroups.
 -/
 noncomputable
 def direct_product_of_normal [fintype G]
@@ -599,8 +694,8 @@ def direct_product_of_normal [fintype G]
 begin
   set ps := (fintype.card G).factorization.support,
 
-  -- “The” sylow group for p
-  let P : Π p, sylow p G := λ _, default,
+  -- “The” Sylow subgroup for p
+  let P : Π p, sylow p G := default,
 
   have hcomm : pairwise (λ (p₁ p₂ : ps), ∀ (x y : G), x ∈ P p₁ → y ∈ P p₂ → commute x y),
   { rintros ⟨p₁, hp₁⟩ ⟨p₂, hp₂⟩ hne,
@@ -611,7 +706,7 @@ begin
     apply is_p_group.disjoint_of_ne p₁ p₂ hne' _ _ (P p₁).is_p_group' (P p₂).is_p_group', },
 
   refine mul_equiv.trans _ _,
-  -- There is only one sylow group for each p, so the inner product is trivial
+  -- There is only one Sylow subgroup for each p, so the inner product is trivial
   show (Π p : ps, Π P : sylow p G, P) ≃* (Π p : ps, P p),
   { -- here we need to help the elaborator with an explicit instantiation
     apply @mul_equiv.Pi_congr_right ps (λ p, (Π P : sylow p G, P)) (λ p, P p) _ _ ,
diff --git a/src/group_theory/torsion.lean b/src/group_theory/torsion.lean
index 405dbf5396758..343ef3612fce0 100644
--- a/src/group_theory/torsion.lean
+++ b/src/group_theory/torsion.lean
@@ -6,12 +6,16 @@ Authors: Julian Berman
 
 import group_theory.exponent
 import group_theory.order_of_element
+import group_theory.p_group
 import group_theory.quotient_group
 import group_theory.submonoid.operations
 
 /-!
 # Torsion groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines torsion groups, i.e. groups where all elements have finite order.
 
 ## Main definitions
@@ -133,9 +137,9 @@ exponent_exists_iff_ne_zero.mpr $
   (exponent_ne_zero_iff_range_order_of_finite (λ g, order_of_pos' (tG g))).mpr bounded
 
 /-- Finite groups are torsion groups. -/
-@[to_additive is_add_torsion_of_fintype "Finite additive groups are additive torsion groups."]
-lemma is_torsion_of_fintype [fintype G] : is_torsion G :=
-exponent_exists.is_torsion $ exponent_exists_iff_ne_zero.mpr exponent_ne_zero_of_fintype
+@[to_additive is_add_torsion_of_finite "Finite additive groups are additive torsion groups."]
+lemma is_torsion_of_finite [finite G] : is_torsion G :=
+exponent_exists.is_torsion $ exponent_exists_iff_ne_zero.mpr exponent_ne_zero_of_finite
 
 end group
 
@@ -154,8 +158,8 @@ is_torsion M := λ f, (is_of_fin_add_order_iff_nsmul_eq_zero _).mpr $ begin
 end
 
 /-- A module with a finite ring of scalars is additively torsion. -/
-lemma is_torsion.module_of_fintype [ring R] [fintype R] [module R M] : is_torsion M :=
-(is_add_torsion_of_fintype : is_torsion R).module_of_torsion _ _
+lemma is_torsion.module_of_finite [ring R] [finite R] [module R M] : is_torsion M :=
+(is_add_torsion_of_finite : is_torsion R).module_of_torsion _ _
 
 end add_monoid
 
@@ -188,6 +192,43 @@ lemma torsion.is_torsion : is_torsion $ torsion G :=
     by rw [mul_left_iterate, _root_.mul_one, submonoid.coe_pow,
            subtype.coe_mk, submonoid.coe_one, (is_periodic_pt_mul_iff_pow_eq_one _).mp hn]⟩
 
+variables (G) (p : ℕ) [hp : fact p.prime]
+include hp
+
+/-- The `p`-primary component is the submonoid of elements with order prime-power of `p`. -/
+@[to_additive
+  "The `p`-primary component is the submonoid of elements with additive order prime-power of `p`.",
+  simps]
+def primary_component : submonoid G :=
+{ carrier := {g | ∃ n : ℕ, order_of g = p ^ n},
+  one_mem' := ⟨0, by rw [pow_zero, order_of_one]⟩,
+  mul_mem' := λ g₁ g₂ hg₁ hg₂, exists_order_of_eq_prime_pow_iff.mpr $ begin
+    obtain ⟨m, hm⟩ := exists_order_of_eq_prime_pow_iff.mp hg₁,
+    obtain ⟨n, hn⟩ := exists_order_of_eq_prime_pow_iff.mp hg₂,
+    exact ⟨m + n, by rw [mul_pow, pow_add, pow_mul, hm, one_pow, monoid.one_mul,
+                         mul_comm, pow_mul, hn, one_pow]⟩,
+  end }
+
+variables {G} {p}
+
+/-- Elements of the `p`-primary component have order `p^n` for some `n`. -/
+@[to_additive "Elements of the `p`-primary component have additive order `p^n` for some `n`"]
+lemma primary_component.exists_order_of_eq_prime_pow (g : comm_monoid.primary_component G p) :
+  ∃ n : ℕ, order_of g = p ^ n :=
+by simpa [primary_component] using g.property
+
+/-- The `p`- and `q`-primary components are disjoint for `p ≠ q`. -/
+@[to_additive "The `p`- and `q`-primary components are disjoint for `p ≠ q`."]
+lemma primary_component.disjoint {p' : ℕ} [hp' : fact p'.prime] (hne : p ≠ p') :
+  disjoint (comm_monoid.primary_component G p) (comm_monoid.primary_component G p') :=
+submonoid.disjoint_def.mpr $
+begin
+  rintro g ⟨(_|n), hn⟩ ⟨n', hn'⟩,
+  { rwa [pow_zero, order_of_eq_one_iff] at hn },
+  { exact absurd (eq_of_prime_pow_eq hp.out.prime hp'.out.prime n.succ_pos
+      (hn.symm.trans hn')) hne }
+end
+
 end comm_monoid
 
 open comm_monoid (torsion)
@@ -201,9 +242,15 @@ variable {G}
 lemma torsion_eq_top (tG : is_torsion G) : torsion G = ⊤ := by ext; tauto
 
 /-- A torsion monoid is isomorphic to its torsion submonoid. -/
-@[to_additive "An additive torsion monoid is isomorphic to its torsion submonoid.", simps]
+@[to_additive "An additive torsion monoid is isomorphic to its torsion submonoid."]
 def torsion_mul_equiv (tG : is_torsion G) : torsion G ≃* G :=
- (mul_equiv.submonoid_congr tG.torsion_eq_top).trans submonoid.top_equiv
+(mul_equiv.submonoid_congr tG.torsion_eq_top).trans submonoid.top_equiv
+
+@[to_additive] lemma torsion_mul_equiv_apply (tG : is_torsion G) (a : torsion G) :
+  tG.torsion_mul_equiv a = mul_equiv.submonoid_congr tG.torsion_eq_top a := rfl
+
+@[to_additive] lemma torsion_mul_equiv_symm_apply_coe (tG : is_torsion G) (a : G) :
+  tG.torsion_mul_equiv.symm a = ⟨submonoid.top_equiv.symm a, tG _⟩ := rfl
 
 end monoid.is_torsion
 
@@ -219,8 +266,10 @@ section comm_group
 
 variables (G) [comm_group G]
 
+namespace comm_group
+
 /-- The torsion subgroup of an abelian group. -/
-@[to_additive add_torsion "The torsion subgroup of an additive abelian group."]
+@[to_additive "The torsion subgroup of an additive abelian group."]
 def torsion : subgroup G := { comm_monoid.torsion G with inv_mem' := λ x, is_of_fin_order.inv }
 
 /-- The torsion submonoid of an abelian group equals the torsion subgroup as a submonoid. -/
@@ -228,6 +277,25 @@ def torsion : subgroup G := { comm_monoid.torsion G with inv_mem' := λ x, is_of
   "The additive torsion submonoid of an abelian group equals the torsion subgroup as a submonoid."]
 lemma torsion_eq_torsion_submonoid : comm_monoid.torsion G = (torsion G).to_submonoid := rfl
 
+variables (p : ℕ) [hp : fact p.prime]
+include hp
+
+/-- The `p`-primary component is the subgroup of elements with order prime-power of `p`. -/
+@[to_additive
+  "The `p`-primary component is the subgroup of elements with additive order prime-power of `p`.",
+  simps]
+def primary_component : subgroup G :=
+{ comm_monoid.primary_component G p with inv_mem' := λ g ⟨n, hn⟩, ⟨n, (order_of_inv g).trans hn⟩ }
+
+variables {G} {p}
+
+/-- The `p`-primary component is a `p` group. -/
+lemma primary_component.is_p_group : is_p_group p $ primary_component G p :=
+λ g, (propext exists_order_of_eq_prime_pow_iff.symm).mpr
+  (comm_monoid.primary_component.exists_order_of_eq_prime_pow g)
+
+end comm_group
+
 end comm_group
 
 namespace monoid
@@ -289,13 +357,14 @@ end group
 section comm_group
 
 open monoid (is_torsion_free)
+open comm_group (torsion)
 
 variables (G) [comm_group G]
 
 /-- Quotienting a group by its torsion subgroup yields a torsion free group. -/
 @[to_additive add_is_torsion_free.quotient_torsion
   "Quotienting a group by its additive torsion subgroup yields an additive torsion free group."]
-lemma is_torsion_free.quotient_torsion : is_torsion_free $ G ⧸ (torsion G) :=
+lemma is_torsion_free.quotient_torsion : is_torsion_free $ G ⧸ torsion G :=
 λ g hne hfin, hne $ begin
   induction g using quotient_group.induction_on',
   obtain ⟨m, mpos, hm⟩ := (is_of_fin_order_iff_pow_eq_one _).mp hfin,
diff --git a/src/group_theory/transfer.lean b/src/group_theory/transfer.lean
index e64ff5bf7670a..1202268a0a7b7 100644
--- a/src/group_theory/transfer.lean
+++ b/src/group_theory/transfer.lean
@@ -5,18 +5,27 @@ Authors: Thomas Browning
 -/
 
 import group_theory.complement
-import group_theory.group_action.basic
-import group_theory.index
+import group_theory.sylow
 
 /-!
 # The Transfer Homomorphism
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we construct the transfer homomorphism.
 
 ## Main definitions
 
 - `diff ϕ S T` : The difference of two left transversals `S` and `T` under the homomorphism `ϕ`.
 - `transfer ϕ` : The transfer homomorphism induced by `ϕ`.
+- `transfer_center_pow`: The transfer homomorphism `G →* center G`.
+
+## Main results
+- `transfer_center_pow_apply`:
+  The transfer homomorphism `G →* center G` is given by `g ↦ g ^ (center G).index`.
+- `ker_transfer_sylow_is_complement'`: Burnside's transfer (or normal `p`-complement) theorem:
+  If `hP : N(P) ≤ C(P)`, then `(transfer P hP).ker` is a normal `p`-complement.
 -/
 
 open_locale big_operators
@@ -31,13 +40,15 @@ open finset mul_action
 
 open_locale pointwise
 
-variables (R S T : left_transversals (H : set G)) [fintype (G ⧸ H)]
+variables (R S T : left_transversals (H : set G)) [finite_index H]
 
 /-- The difference of two left transversals -/
 @[to_additive "The difference of two left transversals"]
 noncomputable def diff : A :=
 let α := mem_left_transversals.to_equiv S.2, β := mem_left_transversals.to_equiv T.2 in
-∏ q, ϕ ⟨(α q)⁻¹ * β q, quotient.exact' ((α.symm_apply_apply q).trans (β.symm_apply_apply q).symm)⟩
+(@finset.univ (G ⧸ H) H.fintype_quotient_of_finite_index).prod $
+  λ q, ϕ ⟨(α q)⁻¹ * β q, quotient_group.left_rel_apply.mp $
+  quotient.exact' ((α.symm_apply_apply q).trans (β.symm_apply_apply q).symm)⟩
 
 @[to_additive] lemma diff_mul_diff : diff ϕ R S * diff ϕ S T = diff ϕ R T :=
 prod_mul_distrib.symm.trans (prod_congr rfl (λ q hq, (ϕ.map_mul _ _).symm.trans (congr_arg ϕ
@@ -47,9 +58,10 @@ prod_mul_distrib.symm.trans (prod_congr rfl (λ q hq, (ϕ.map_mul _ _).symm.tran
 mul_right_eq_self.mp (diff_mul_diff ϕ T T T)
 
 @[to_additive] lemma diff_inv : (diff ϕ S T)⁻¹ = diff ϕ T S :=
-inv_eq_of_mul_eq_one ((diff_mul_diff ϕ S T S).trans (diff_self ϕ S))
+inv_eq_of_mul_eq_one_right $ (diff_mul_diff ϕ S T S).trans $ diff_self ϕ S
 
 @[to_additive] lemma smul_diff_smul (g : G) : diff ϕ (g • S) (g • T) = diff ϕ S T :=
+let h := H.fintype_quotient_of_finite_index in by exactI
 prod_bij' (λ q _, g⁻¹ • q) (λ _ _, mem_univ _) (λ _ _, congr_arg ϕ (by simp_rw [coe_mk,
   smul_apply_eq_smul_apply_inv_smul, smul_eq_mul, mul_inv_rev, mul_assoc, inv_mul_cancel_left]))
   (λ q _, g • q) (λ _ _, mem_univ _) (λ q _, smul_inv_smul g q) (λ q _, inv_smul_smul g q)
@@ -60,15 +72,13 @@ end subgroup
 
 namespace monoid_hom
 
-variables [fintype (G ⧸ H)]
-
-open subgroup subgroup.left_transversals
+open mul_action subgroup subgroup.left_transversals
 
 /-- Given `ϕ : H →* A` from `H : subgroup G` to a commutative group `A`,
 the transfer homomorphism is `transfer ϕ : G →* A`. -/
 @[to_additive "Given `ϕ : H →+ A` from `H : add_subgroup G` to an additive commutative group `A`,
 the transfer homomorphism is `transfer ϕ : G →+ A`."]
-noncomputable def transfer : G →* A :=
+noncomputable def transfer [finite_index H] : G →* A :=
 let T : left_transversals (H : set G) := inhabited.default in
 { to_fun := λ g, diff ϕ T (g • T),
   map_one' := by rw [one_smul, diff_self],
@@ -76,7 +86,146 @@ let T : left_transversals (H : set G) := inhabited.default in
 
 variables (T : left_transversals (H : set G))
 
-@[to_additive] lemma transfer_def (g : G) : transfer ϕ g = diff ϕ T (g • T) :=
+@[to_additive] lemma transfer_def [finite_index H] (g : G) : transfer ϕ g = diff ϕ T (g • T) :=
 by rw [transfer, ←diff_mul_diff, ←smul_diff_smul, mul_comm, diff_mul_diff]; refl
 
+/-- Explicit computation of the transfer homomorphism. -/
+lemma transfer_eq_prod_quotient_orbit_rel_zpowers_quot [finite_index H]
+  (g : G) [fintype (quotient (orbit_rel (zpowers g) (G ⧸ H)))] :
+  transfer ϕ g = ∏ (q : quotient (orbit_rel (zpowers g) (G ⧸ H))),
+    ϕ ⟨q.out'.out'⁻¹ * g ^ function.minimal_period ((•) g) q.out' * q.out'.out',
+      quotient_group.out'_conj_pow_minimal_period_mem H g q.out'⟩ :=
+begin
+  classical,
+  letI := H.fintype_quotient_of_finite_index,
+  calc transfer ϕ g = ∏ (q : G ⧸ H), _ : transfer_def ϕ (transfer_transversal H g) g
+  ... = _ : ((quotient_equiv_sigma_zmod H g).symm.prod_comp _).symm
+  ... = _ : finset.prod_sigma _ _ _
+  ... = _ : fintype.prod_congr _ _ (λ q, _),
+  simp only [quotient_equiv_sigma_zmod_symm_apply,
+    transfer_transversal_apply', transfer_transversal_apply''],
+  rw fintype.prod_eq_single (0 : zmod (function.minimal_period ((•) g) q.out')) (λ k hk, _),
+  { simp only [if_pos, zmod.cast_zero, zpow_zero, one_mul, mul_assoc] },
+  { simp only [if_neg hk, inv_mul_self],
+    exact map_one ϕ },
+end
+
+/-- Auxillary lemma in order to state `transfer_eq_pow`. -/
+lemma transfer_eq_pow_aux (g : G)
+  (key : ∀ (k : ℕ) (g₀ : G), g₀⁻¹ * g ^ k * g₀ ∈ H → g₀⁻¹ * g ^ k * g₀ = g ^ k) :
+  g ^ H.index ∈ H :=
+begin
+  by_cases hH : H.index = 0,
+  { rw [hH, pow_zero],
+    exact H.one_mem },
+  letI := fintype_of_index_ne_zero hH,
+  classical,
+  replace key : ∀ (k : ℕ) (g₀ : G), g₀⁻¹ * g ^ k * g₀ ∈ H → g ^ k ∈ H :=
+  λ k g₀ hk, (_root_.congr_arg (∈ H) (key k g₀ hk)).mp hk,
+  replace key : ∀ q : G ⧸ H, g ^ function.minimal_period ((•) g) q ∈ H :=
+  λ q, key (function.minimal_period ((•) g) q) q.out'
+    (quotient_group.out'_conj_pow_minimal_period_mem H g q),
+  let f : quotient (orbit_rel (zpowers g) (G ⧸ H)) → zpowers g :=
+  λ q, (⟨g, mem_zpowers g⟩ : zpowers g) ^ function.minimal_period ((•) g) q.out',
+  have hf : ∀ q, f q ∈ H.subgroup_of (zpowers g) := λ q, key q.out',
+  replace key := subgroup.prod_mem (H.subgroup_of (zpowers g)) (λ q (hq : q ∈ finset.univ), hf q),
+  simpa only [minimal_period_eq_card, finset.prod_pow_eq_pow_sum, fintype.card_sigma,
+    fintype.card_congr (self_equiv_sigma_orbits (zpowers g) (G ⧸ H)), index_eq_card] using key,
+end
+
+lemma transfer_eq_pow [finite_index H] (g : G)
+  (key : ∀ (k : ℕ) (g₀ : G), g₀⁻¹ * g ^ k * g₀ ∈ H → g₀⁻¹ * g ^ k * g₀ = g ^ k) :
+  transfer ϕ g = ϕ ⟨g ^ H.index, transfer_eq_pow_aux g key⟩ :=
+begin
+  classical,
+  letI := H.fintype_quotient_of_finite_index,
+  change ∀ k g₀ (hk : g₀⁻¹ * g ^ k * g₀ ∈ H), ↑(⟨g₀⁻¹ * g ^ k * g₀, hk⟩ : H) = g ^ k at key,
+  rw [transfer_eq_prod_quotient_orbit_rel_zpowers_quot, ←finset.prod_to_list, list.prod_map_hom],
+  refine congr_arg ϕ (subtype.coe_injective _),
+  rw [H.coe_mk, ←(zpowers g).coe_mk g (mem_zpowers g), ←(zpowers g).coe_pow, (zpowers g).coe_mk,
+      index_eq_card, fintype.card_congr (self_equiv_sigma_orbits (zpowers g) (G ⧸ H)),
+      fintype.card_sigma, ←finset.prod_pow_eq_pow_sum, ←finset.prod_to_list],
+  simp only [coe_list_prod, list.map_map, ←minimal_period_eq_card],
+  congr' 2,
+  funext,
+  apply key,
+end
+
+lemma transfer_center_eq_pow [finite_index (center G)] (g : G) :
+  transfer (monoid_hom.id (center G)) g = ⟨g ^ (center G).index, (center G).pow_index_mem g⟩ :=
+transfer_eq_pow (id (center G)) g (λ k _ hk, by rw [←mul_right_inj, hk, mul_inv_cancel_right])
+
+variables (G)
+
+/-- The transfer homomorphism `G →* center G`. -/
+noncomputable def transfer_center_pow [finite_index (center G)] : G →* center G :=
+{ to_fun := λ g, ⟨g ^ (center G).index, (center G).pow_index_mem g⟩,
+  map_one' := subtype.ext (one_pow (center G).index),
+  map_mul' := λ a b, by simp_rw [←show ∀ g, (_ : center G) = _,
+    from transfer_center_eq_pow, map_mul] }
+
+variables {G}
+
+@[simp] lemma transfer_center_pow_apply [finite_index (center G)] (g : G) :
+  ↑(transfer_center_pow G g) = g ^ (center G).index :=
+rfl
+
+section burnside_transfer
+
+variables {p : ℕ} (P : sylow p G) (hP : (P : subgroup G).normalizer ≤ centralizer (P : set G))
+
+include hP
+
+/-- The homomorphism `G →* P` in Burnside's transfer theorem. -/
+noncomputable def transfer_sylow [finite_index (P : subgroup G)] : G →* (P : subgroup G) :=
+@transfer G _ P P (@subgroup.is_commutative.comm_group G _ P
+  ⟨⟨λ a b, subtype.ext (hP (le_normalizer b.2) a a.2)⟩⟩) (monoid_hom.id P) _
+
+variables [fact p.prime] [finite (sylow p G)]
+
+/-- Auxillary lemma in order to state `transfer_sylow_eq_pow`. -/
+lemma transfer_sylow_eq_pow_aux (g : G) (hg : g ∈ P) (k : ℕ) (g₀ : G) (h : g₀⁻¹ * g ^ k * g₀ ∈ P) :
+  g₀⁻¹ * g ^ k * g₀ = g ^ k :=
+begin
+  haveI : (P : subgroup G).is_commutative := ⟨⟨λ a b, subtype.ext (hP (le_normalizer b.2) a a.2)⟩⟩,
+  replace hg := (P : subgroup G).pow_mem hg k,
+  obtain ⟨n, hn, h⟩ := P.conj_eq_normalizer_conj_of_mem (g ^ k) g₀ hg h,
+  exact h.trans (commute.inv_mul_cancel (hP hn (g ^ k) hg).symm),
+end
+
+variables [finite_index (P : subgroup G)]
+
+lemma transfer_sylow_eq_pow (g : G) (hg : g ∈ P) : transfer_sylow P hP g =
+  ⟨g ^ (P : subgroup G).index, transfer_eq_pow_aux g (transfer_sylow_eq_pow_aux P hP g hg)⟩ :=
+by apply transfer_eq_pow
+
+lemma transfer_sylow_restrict_eq_pow :
+  ⇑((transfer_sylow P hP).restrict (P : subgroup G)) = (^ (P : subgroup G).index) :=
+funext (λ g, transfer_sylow_eq_pow P hP g g.2)
+
+/-- Burnside's normal p-complement theorem: If `N(P) ≤ C(P)`, then `P` has a normal complement. -/
+lemma ker_transfer_sylow_is_complement' : is_complement' (transfer_sylow P hP).ker P :=
+begin
+  have hf : function.bijective ((transfer_sylow P hP).restrict (P : subgroup G)) :=
+  (transfer_sylow_restrict_eq_pow P hP).symm ▸ (P.2.pow_equiv' (not_dvd_index_sylow P
+    (mt index_eq_zero_of_relindex_eq_zero index_ne_zero_of_finite))).bijective,
+  rw [function.bijective, ←range_top_iff_surjective, restrict_range] at hf,
+  have := range_top_iff_surjective.mp (top_le_iff.mp (hf.2.ge.trans (map_le_range _ P))),
+  rw [←(comap_injective this).eq_iff, comap_top, comap_map_eq, sup_comm, set_like.ext'_iff,
+      normal_mul, ←ker_eq_bot_iff, ←(map_injective (P : subgroup G).subtype_injective).eq_iff,
+      ker_restrict, subgroup_of_map_subtype, subgroup.map_bot, coe_top] at hf,
+  exact is_complement'_of_disjoint_and_mul_eq_univ (disjoint_iff.2 hf.1) hf.2,
+end
+
+lemma not_dvd_card_ker_transfer_sylow : ¬ p ∣ nat.card (transfer_sylow P hP).ker :=
+(ker_transfer_sylow_is_complement' P hP).index_eq_card ▸ not_dvd_index_sylow P $
+  mt index_eq_zero_of_relindex_eq_zero index_ne_zero_of_finite
+
+lemma ker_transfer_sylow_disjoint (Q : subgroup G) (hQ : is_p_group p Q) :
+  disjoint (transfer_sylow P hP).ker Q :=
+disjoint_iff.mpr $ card_eq_one.mp $ (hQ.to_le inf_le_right).card_eq_or_dvd.resolve_right $
+  λ h, not_dvd_card_ker_transfer_sylow P hP $ h.trans $ nat_card_dvd_of_le _ _ inf_le_left
+
+end burnside_transfer
+
 end monoid_hom
diff --git a/src/information_theory/hamming.lean b/src/information_theory/hamming.lean
new file mode 100644
index 0000000000000..dcda8324f0b19
--- /dev/null
+++ b/src/information_theory/hamming.lean
@@ -0,0 +1,312 @@
+/-
+Copyright (c) 2022 Wrenna Robson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Wrenna Robson
+-/
+
+import analysis.normed.group.basic
+
+/-!
+# Hamming spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The Hamming metric counts the number of places two members of a (finite) Pi type
+differ. The Hamming norm is the same as the Hamming metric over additive groups, and
+counts the number of places a member of a (finite) Pi type differs from zero.
+
+This is a useful notion in various applications, but in particular it is relevant
+in coding theory, in which it is fundamental for defining the minimum distance of a
+code.
+
+## Main definitions
+* `hamming_dist x y`: the Hamming distance between `x` and `y`, the number of entries which differ.
+* `hamming_norm x`: the Hamming norm of `x`, the number of non-zero entries.
+* `hamming β`: a type synonym for `Π i, β i` with `dist` and `norm` provided by the above.
+* `hamming.to_hamming`, `hamming.of_hamming`: functions for casting between `hamming β` and
+`Π i, β i`.
+* `hamming.normed_add_comm_group`: the Hamming norm forms a normed group on `hamming β`.
+-/
+section hamming_dist_norm
+
+open finset function
+
+variables {α ι : Type*} {β : ι → Type*} [fintype ι] [Π i, decidable_eq (β i)]
+variables {γ : ι → Type*} [Π i, decidable_eq (γ i)]
+
+/-- The Hamming distance function to the naturals. -/
+def hamming_dist (x y : Π i, β i) : ℕ := (univ.filter (λ i, x i ≠ y i)).card
+
+/-- Corresponds to `dist_self`. -/
+@[simp] lemma hamming_dist_self (x : Π i, β i) : hamming_dist x x = 0 :=
+by { rw [hamming_dist, card_eq_zero, filter_eq_empty_iff], exact λ _ _ H, H rfl }
+
+/-- Corresponds to `dist_nonneg`. -/
+lemma hamming_dist_nonneg {x y : Π i, β i} : 0 ≤ hamming_dist x y := zero_le _
+
+/-- Corresponds to `dist_comm`. -/
+lemma hamming_dist_comm (x y : Π i, β i) : hamming_dist x y = hamming_dist y x :=
+by simp_rw [hamming_dist, ne_comm]
+
+/-- Corresponds to `dist_triangle`. -/
+lemma hamming_dist_triangle (x y z : Π i, β i) :
+  hamming_dist x z ≤ hamming_dist x y + hamming_dist y z :=
+begin
+  classical, simp_rw hamming_dist, refine le_trans (card_mono _) (card_union_le _ _),
+  rw ← filter_or, refine monotone_filter_right _ _, intros i h,
+  by_contra' H, exact h (eq.trans H.1 H.2)
+end
+
+/-- Corresponds to `dist_triangle_left`. -/
+lemma hamming_dist_triangle_left (x y z : Π i, β i) :
+  hamming_dist x y ≤ hamming_dist z x + hamming_dist z y :=
+by { rw hamming_dist_comm z, exact hamming_dist_triangle _ _ _ }
+
+/-- Corresponds to `dist_triangle_right`. -/
+lemma hamming_dist_triangle_right (x y z : Π i, β i) :
+  hamming_dist x y ≤ hamming_dist x z + hamming_dist y z :=
+by { rw hamming_dist_comm y, exact hamming_dist_triangle _ _ _ }
+
+/-- Corresponds to `swap_dist`. -/
+theorem swap_hamming_dist : swap (@hamming_dist _ β _ _) = hamming_dist :=
+by { funext x y, exact hamming_dist_comm _ _ }
+
+/-- Corresponds to `eq_of_dist_eq_zero`. -/
+lemma eq_of_hamming_dist_eq_zero {x y : Π i, β i} : hamming_dist x y = 0 → x = y :=
+by simp_rw [hamming_dist, card_eq_zero, filter_eq_empty_iff, not_not,
+            funext_iff,  mem_univ, forall_true_left, imp_self]
+
+/-- Corresponds to `dist_eq_zero`. -/
+@[simp] lemma hamming_dist_eq_zero {x y : Π i, β i} : hamming_dist x y = 0 ↔ x = y :=
+⟨eq_of_hamming_dist_eq_zero, (λ H, by {rw H, exact hamming_dist_self _})⟩
+
+/-- Corresponds to `zero_eq_dist`. -/
+@[simp] lemma hamming_zero_eq_dist {x y : Π i, β i} : 0 = hamming_dist x y ↔ x = y :=
+by rw [eq_comm, hamming_dist_eq_zero]
+
+/-- Corresponds to `dist_ne_zero`. -/
+lemma hamming_dist_ne_zero {x y : Π i, β i} : hamming_dist x y ≠ 0 ↔ x ≠ y :=
+hamming_dist_eq_zero.not
+
+/-- Corresponds to `dist_pos`. -/
+@[simp] lemma hamming_dist_pos {x y : Π i, β i} : 0 < hamming_dist x y ↔ x ≠ y :=
+by rw [←hamming_dist_ne_zero, iff_not_comm, not_lt, le_zero_iff]
+
+@[simp] lemma hamming_dist_lt_one {x y : Π i, β i} : hamming_dist x y < 1 ↔ x = y :=
+by rw [nat.lt_one_iff, hamming_dist_eq_zero]
+
+lemma hamming_dist_le_card_fintype {x y : Π i, β i} :
+  hamming_dist x y ≤ fintype.card ι := card_le_univ _
+
+lemma hamming_dist_comp_le_hamming_dist (f : Π i, γ i → β i) {x y : Π i, γ i} :
+  hamming_dist (λ i, f i (x i)) (λ i, f i (y i)) ≤ hamming_dist x y :=
+card_mono (monotone_filter_right _ $ λ i H1 H2, H1 $ congr_arg (f i) H2)
+
+lemma hamming_dist_comp (f : Π i, γ i → β i) {x y : Π i, γ i} (hf : Π i, injective (f i)) :
+  hamming_dist (λ i, f i (x i)) (λ i, f i (y i)) = hamming_dist x y :=
+begin
+  refine le_antisymm (hamming_dist_comp_le_hamming_dist _) _,
+  exact card_mono (monotone_filter_right _ $ λ i H1 H2, H1 $ hf i H2)
+end
+
+lemma hamming_dist_smul_le_hamming_dist [Π i, has_smul α (β i)] {k : α} {x y : Π i, β i} :
+  hamming_dist (k • x) (k • y) ≤ hamming_dist x y :=
+hamming_dist_comp_le_hamming_dist $ λ i, (•) k
+
+/-- Corresponds to `dist_smul` with the discrete norm on `α`. -/
+lemma hamming_dist_smul [Π i, has_smul α (β i)] {k : α} {x y : Π i, β i}
+  (hk : Π i, is_smul_regular (β i) k) : hamming_dist (k • x) (k • y) = hamming_dist x y :=
+hamming_dist_comp (λ i, (•) k) hk
+
+section has_zero
+
+variables [Π i, has_zero (β i)] [Π i, has_zero (γ i)]
+
+/-- The Hamming weight function to the naturals. -/
+def hamming_norm (x : Π i, β i) : ℕ := (univ.filter (λ i, x i ≠ 0)).card
+
+/-- Corresponds to `dist_zero_right`. -/
+@[simp] lemma hamming_dist_zero_right (x : Π i, β i) : hamming_dist x 0 = hamming_norm x := rfl
+
+/-- Corresponds to `dist_zero_left`. -/
+@[simp] lemma hamming_dist_zero_left : hamming_dist (0 : Π i, β i) = hamming_norm :=
+funext $ λ x, by rw [hamming_dist_comm, hamming_dist_zero_right]
+
+/-- Corresponds to `norm_nonneg`. -/
+@[simp] lemma hamming_norm_nonneg {x : Π i, β i} : 0 ≤ hamming_norm x := zero_le _
+
+/-- Corresponds to `norm_zero`. -/
+@[simp] lemma hamming_norm_zero : hamming_norm (0 : Π i, β i) = 0 := hamming_dist_self _
+
+/-- Corresponds to `norm_eq_zero`. -/
+@[simp] lemma hamming_norm_eq_zero {x : Π i, β i} : hamming_norm x = 0 ↔ x = 0 :=
+hamming_dist_eq_zero
+
+/-- Corresponds to `norm_ne_zero_iff`. -/
+lemma hamming_norm_ne_zero_iff {x : Π i, β i} : hamming_norm x ≠ 0 ↔ x ≠ 0 :=
+hamming_norm_eq_zero.not
+
+/-- Corresponds to `norm_pos_iff`. -/
+@[simp] lemma hamming_norm_pos_iff {x : Π i, β i} : 0 < hamming_norm x ↔ x ≠ 0 := hamming_dist_pos
+
+@[simp] lemma hamming_norm_lt_one {x : Π i, β i} : hamming_norm x < 1 ↔ x = 0 := hamming_dist_lt_one
+
+lemma hamming_norm_le_card_fintype {x : Π i, β i} : hamming_norm x ≤ fintype.card ι :=
+hamming_dist_le_card_fintype
+
+lemma hamming_norm_comp_le_hamming_norm (f : Π i, γ i → β i) {x : Π i, γ i} (hf : Π i, f i 0 = 0) :
+  hamming_norm (λ i, f i (x i)) ≤ hamming_norm x :=
+by {convert hamming_dist_comp_le_hamming_dist f, simp_rw hf, refl}
+
+lemma hamming_norm_comp (f : Π i, γ i → β i) {x : Π i, γ i} (hf₁ : Π i, injective (f i))
+  (hf₂ : Π i, f i 0 = 0) : hamming_norm (λ i, f i (x i)) = hamming_norm x :=
+by {convert hamming_dist_comp f hf₁, simp_rw hf₂, refl}
+
+lemma hamming_norm_smul_le_hamming_norm [has_zero α] [Π i, smul_with_zero α (β i)] {k : α}
+  {x : Π i, β i} : hamming_norm (k • x) ≤ hamming_norm x :=
+hamming_norm_comp_le_hamming_norm (λ i (c : β i), k • c) (λ i, by simp_rw smul_zero)
+
+lemma hamming_norm_smul [has_zero α] [Π i, smul_with_zero α (β i)] {k : α}
+  (hk : ∀ i, is_smul_regular (β i) k) (x : Π i, β i) : hamming_norm (k • x) = hamming_norm x :=
+hamming_norm_comp (λ i (c : β i), k • c) hk (λ i, by simp_rw smul_zero)
+
+end has_zero
+
+/-- Corresponds to `dist_eq_norm`. -/
+lemma hamming_dist_eq_hamming_norm [Π i, add_group (β i)] (x y : Π i, β i) :
+  hamming_dist x y = hamming_norm (x - y) :=
+by simp_rw [hamming_norm, hamming_dist, pi.sub_apply, sub_ne_zero]
+
+end hamming_dist_norm
+
+/-! ### The `hamming` type synonym -/
+
+/-- Type synonym for a Pi type which inherits the usual algebraic instances, but is equipped with
+the Hamming metric and norm, instead of `pi.normed_add_comm_group` which uses the sup norm. -/
+def hamming {ι : Type*} (β : ι → Type*) : Type* := Π i, β i
+
+namespace hamming
+
+variables {α ι : Type*} {β : ι → Type*}
+
+/-! Instances inherited from normal Pi types. -/
+
+instance [Π i, inhabited (β i)] : inhabited (hamming β) := ⟨λ i, default⟩
+instance [decidable_eq ι] [fintype ι] [Π i, fintype (β i)] : fintype (hamming β) := pi.fintype
+instance [inhabited ι] [∀ i, nonempty (β i)] [nontrivial (β default)] :
+  nontrivial (hamming β) := pi.nontrivial
+instance [fintype ι] [Π i, decidable_eq (β i)] : decidable_eq (hamming β) :=
+fintype.decidable_pi_fintype
+
+instance [Π i, has_zero (β i)]    : has_zero (hamming β) := pi.has_zero
+instance [Π i, has_neg (β i)]     : has_neg (hamming β) := pi.has_neg
+instance [Π i, has_add (β i)]     : has_add (hamming β) := pi.has_add
+instance [Π i, has_sub (β i)]     : has_sub (hamming β) := pi.has_sub
+instance [Π i, has_smul α (β i)]  : has_smul α (hamming β) := pi.has_smul
+
+instance [has_zero α] [Π i, has_zero (β i)] [Π i, smul_with_zero α (β i)] :
+  smul_with_zero α (hamming β) := pi.smul_with_zero _
+instance [Π i, add_monoid (β i)] : add_monoid (hamming β) := pi.add_monoid
+instance [Π i, add_comm_monoid (β i)] : add_comm_monoid (hamming β) := pi.add_comm_monoid
+instance [Π i, add_comm_group (β i)] : add_comm_group (hamming β) := pi.add_comm_group
+instance (α) [semiring α] (β : ι → Type*) [Π i, add_comm_monoid (β i)]
+  [Π i, module α (β i)] : module α (hamming β) := pi.module _ _ _
+
+/-! API to/from the type synonym. -/
+
+/-- `to_hamming` is the identity function to the `hamming` of a type.  -/
+@[pattern] def to_hamming : (Π i, β i) ≃ hamming β := equiv.refl _
+
+/-- `of_hamming` is the identity function from the `hamming` of a type.  -/
+@[pattern] def of_hamming : hamming β ≃ Π i, β i := equiv.refl _
+
+@[simp] lemma to_hamming_symm_eq : (@to_hamming _ β).symm = of_hamming := rfl
+@[simp] lemma of_hamming_symm_eq : (@of_hamming _ β).symm = to_hamming := rfl
+@[simp] lemma to_hamming_of_hamming (x : hamming β) : to_hamming (of_hamming x) = x := rfl
+@[simp] lemma of_hamming_to_hamming (x : Π i, β i) : of_hamming (to_hamming x) = x := rfl
+@[simp] lemma to_hamming_inj {x y : Π i, β i} : to_hamming x = to_hamming y ↔ x = y := iff.rfl
+@[simp] lemma of_hamming_inj {x y : hamming β} : of_hamming x = of_hamming y ↔ x = y := iff.rfl
+
+@[simp] lemma to_hamming_zero [Π i, has_zero (β i)] : to_hamming (0 : Π i, β i) = 0 := rfl
+@[simp] lemma of_hamming_zero [Π i, has_zero (β i)] : of_hamming (0 : hamming β) = 0 := rfl
+@[simp] lemma to_hamming_neg [Π i, has_neg (β i)] {x : Π i, β i} :
+  to_hamming (-x) = - to_hamming x := rfl
+@[simp] lemma of_hamming_neg [Π i, has_neg (β i)] {x : hamming β} :
+  of_hamming (-x)  = - of_hamming x := rfl
+@[simp] lemma to_hamming_add [Π i, has_add (β i)] {x y : Π i, β i} :
+  to_hamming (x + y) = to_hamming x + to_hamming y := rfl
+@[simp] lemma of_hamming_add [Π i, has_add (β i)] {x y : hamming β} :
+  of_hamming (x + y) = of_hamming x + of_hamming y := rfl
+@[simp] lemma to_hamming_sub [Π i, has_sub (β i)] {x y : Π i, β i} :
+  to_hamming (x - y) = to_hamming x - to_hamming y := rfl
+@[simp] lemma of_hamming_sub [Π i, has_sub (β i)] {x y : hamming β} :
+  of_hamming (x - y) = of_hamming x - of_hamming y := rfl
+@[simp] lemma to_hamming_smul [Π i, has_smul α (β i)] {r : α} {x : Π i, β i} :
+  to_hamming (r • x) = r • to_hamming x := rfl
+@[simp] lemma of_hamming_smul [Π i, has_smul α (β i)] {r : α} {x : hamming β} :
+  of_hamming (r • x) = r • of_hamming x := rfl
+
+section
+
+/-! Instances equipping `hamming` with `hamming_norm` and `hamming_dist`. -/
+
+variables [fintype ι] [Π i, decidable_eq (β i)]
+
+instance : has_dist (hamming β) := ⟨λ x y, hamming_dist (of_hamming x) (of_hamming y)⟩
+
+@[simp, push_cast] lemma dist_eq_hamming_dist (x y : hamming β) :
+  dist x y = hamming_dist (of_hamming x) (of_hamming y) := rfl
+
+instance : pseudo_metric_space (hamming β) :=
+{ dist_self        := by { push_cast, exact_mod_cast hamming_dist_self },
+  dist_comm        := by { push_cast, exact_mod_cast hamming_dist_comm },
+  dist_triangle    := by { push_cast, exact_mod_cast hamming_dist_triangle },
+  to_uniform_space := ⊥,
+  uniformity_dist  := uniformity_dist_of_mem_uniformity _ _ $ λ s, begin
+    push_cast,
+    split,
+    { refine λ hs, ⟨1, zero_lt_one, λ _ _ hab, _⟩,
+      rw_mod_cast [hamming_dist_lt_one] at hab,
+      rw [of_hamming_inj, ← mem_id_rel] at hab,
+      exact hs hab },
+    { rintros ⟨_, hε, hs⟩ ⟨_, _⟩ hab,
+      rw mem_id_rel at hab,
+      rw hab,
+      refine hs (lt_of_eq_of_lt _ hε),
+      exact_mod_cast hamming_dist_self _ }
+  end,
+  to_bornology     := ⟨⊥, bot_le⟩,
+  cobounded_sets   := begin
+    ext,
+    push_cast,
+    refine iff_of_true (filter.mem_sets.mpr filter.mem_bot) ⟨fintype.card ι, λ _ _ _ _, _⟩,
+    exact_mod_cast hamming_dist_le_card_fintype
+  end,
+  ..hamming.has_dist }
+
+@[simp, push_cast] lemma nndist_eq_hamming_dist (x y : hamming β) :
+  nndist x y = hamming_dist (of_hamming x) (of_hamming y) := rfl
+
+instance : metric_space (hamming β) :=
+{ eq_of_dist_eq_zero  :=
+  by { push_cast, exact_mod_cast @eq_of_hamming_dist_eq_zero _ _ _ _ },
+  ..hamming.pseudo_metric_space }
+
+instance [Π i, has_zero (β i)] : has_norm (hamming β) := ⟨λ x, hamming_norm (of_hamming x)⟩
+
+@[simp, push_cast] lemma norm_eq_hamming_norm [Π i, has_zero (β i)] (x : hamming β) :
+  ‖x‖ = hamming_norm (of_hamming x) := rfl
+
+instance [Π i, add_comm_group (β i)] : seminormed_add_comm_group (hamming β) :=
+{ dist_eq := by { push_cast, exact_mod_cast hamming_dist_eq_hamming_norm }, ..pi.add_comm_group }
+
+@[simp, push_cast] lemma nnnorm_eq_hamming_norm [Π i, add_comm_group (β i)] (x : hamming β) :
+  ‖x‖₊ = hamming_norm (of_hamming x) := rfl
+
+instance [Π i, add_comm_group (β i)] : normed_add_comm_group (hamming β) :=
+{ ..hamming.seminormed_add_comm_group }
+
+end
+
+end hamming
diff --git a/src/linear_algebra/adic_completion.lean b/src/linear_algebra/adic_completion.lean
index 63aec8e3625a8..3f73138ad4edd 100644
--- a/src/linear_algebra/adic_completion.lean
+++ b/src/linear_algebra/adic_completion.lean
@@ -6,12 +6,14 @@ Authors: Kenny Lau
 
 import algebra.geom_sum
 import linear_algebra.smodeq
-import ring_theory.ideal.quotient
 import ring_theory.jacobson_ideal
 
 /-!
 # Completion of a module with respect to an ideal.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the notions of Hausdorff, precomplete, and complete for an `R`-module `M`
 with respect to an ideal `I`:
 
@@ -118,7 +120,7 @@ instance : is_Hausdorff I (Hausdorffification I M) :=
 ⟨λ x, quotient.induction_on' x $ λ x hx, (quotient.mk_eq_zero _).2 $ (mem_infi _).2 $ λ n, begin
   have := comap_map_mkq (⨅ n : ℕ, I ^ n • ⊤ : submodule R M) (I ^ n • ⊤),
   simp only [sup_of_le_right (infi_le (λ n, (I ^ n • ⊤ : submodule R M)) n)] at this,
-  rw [← this, map_smul'', mem_comap, map_top, range_mkq, ← smodeq.zero], exact hx n
+  rw [← this, map_smul'', mem_comap, submodule.map_top, range_mkq, ← smodeq.zero], exact hx n
 end⟩
 
 variables {M} [h : is_Hausdorff I N]
@@ -211,6 +213,7 @@ h.1.subsingleton
 @[priority 100] instance of_subsingleton [subsingleton M] : is_adic_complete I M := {}
 
 open_locale big_operators
+open finset
 
 lemma le_jacobson_bot [is_adic_complete I R] : I ≤ (⊥ : ideal R).jacobson :=
 begin
@@ -218,10 +221,10 @@ begin
   rw [← ideal.neg_mem_iff, ideal.mem_jacobson_bot],
   intros y,
   rw add_comm,
-  let f : ℕ → R := geom_sum (x * y),
+  let f : ℕ → R := λ n, ∑ i in range n, (x * y) ^ i,
   have hf : ∀ m n, m ≤ n → f m ≡ f n [SMOD I ^ m • (⊤ : submodule R R)],
   { intros m n h,
-    simp only [f, geom_sum_def, algebra.id.smul_eq_mul, ideal.mul_top, smodeq.sub_mem],
+    simp only [f, algebra.id.smul_eq_mul, ideal.mul_top, smodeq.sub_mem],
     rw [← add_tsub_cancel_of_le h, finset.sum_range_add, ← sub_sub, sub_self, zero_sub,
       neg_mem_iff],
     apply submodule.sum_mem,
diff --git a/src/linear_algebra/affine_space/affine_equiv.lean b/src/linear_algebra/affine_space/affine_equiv.lean
index 2024106fa25d9..c81fc970ecac9 100644
--- a/src/linear_algebra/affine_space/affine_equiv.lean
+++ b/src/linear_algebra/affine_space/affine_equiv.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import linear_algebra.affine_space.affine_map
+import linear_algebra.general_linear_group
 import algebra.invertible
 
 /-!
 # Affine equivalences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
 equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
 affine maps.
@@ -39,7 +43,7 @@ and inverse maps are affine.
 
 We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
 to allow affine equivalences with good definitional equalities. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure affine_equiv (k P₁ P₂ : Type*) {V₁ V₂ : Type*} [ring k]
   [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
   [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂] extends P₁ ≃ P₂ :=
@@ -58,71 +62,60 @@ namespace affine_equiv
 
 include V₁ V₂
 
-instance : has_coe_to_fun (P₁ ≃ᵃ[k] P₂) (λ _, P₁ → P₂) := ⟨λ e, e.to_fun⟩
-
-instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ ≃ P₂) := ⟨affine_equiv.to_equiv⟩
+/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
+def to_affine_map (e : P₁ ≃ᵃ[k] P₂) : P₁ →ᵃ[k] P₂ := { .. e }
 
-variables (k P₁)
+@[simp] lemma to_affine_map_mk (f : P₁ ≃ P₂) (f' : V₁ ≃ₗ[k] V₂) (h) :
+  to_affine_map (mk f f' h) = ⟨f, f', h⟩ :=
+rfl
 
-omit V₂
+@[simp] lemma linear_to_affine_map (e : P₁ ≃ᵃ[k] P₂) : e.to_affine_map.linear = e.linear := rfl
 
-/-- Identity map as an `affine_equiv`. -/
-@[refl] def refl : P₁ ≃ᵃ[k] P₁ :=
-{ to_equiv := equiv.refl P₁,
-  linear := linear_equiv.refl k V₁,
-  map_vadd' := λ _ _, rfl }
+lemma to_affine_map_injective : injective (to_affine_map : (P₁ ≃ᵃ[k] P₂) → (P₁ →ᵃ[k] P₂)) :=
+begin
+  rintros ⟨e, el, h⟩ ⟨e', el', h'⟩ H,
+  simp only [to_affine_map_mk, equiv.coe_inj, linear_equiv.to_linear_map_inj] at H,
+  congr,
+  exacts [H.1, H.2]
+end
 
-@[simp] lemma coe_refl : ⇑(refl k P₁) = id := rfl
+@[simp] lemma to_affine_map_inj {e e' : P₁ ≃ᵃ[k] P₂} :
+  e.to_affine_map = e'.to_affine_map ↔ e = e' :=
+to_affine_map_injective.eq_iff
 
-@[simp] lemma refl_apply (x : P₁) : refl k P₁ x = x := rfl
+instance equiv_like : equiv_like (P₁ ≃ᵃ[k] P₂) P₁ P₂ :=
+{ coe := λ f, f.to_fun,
+  inv := λ f, f.inv_fun,
+  left_inv := λ f, f.left_inv,
+  right_inv := λ f, f.right_inv,
+  coe_injective' := λ f g h _, to_affine_map_injective (fun_like.coe_injective h) }
 
-@[simp] lemma to_equiv_refl : (refl k P₁).to_equiv = equiv.refl P₁ := rfl
+instance : has_coe_to_fun (P₁ ≃ᵃ[k] P₂) (λ _, P₁ → P₂) := fun_like.has_coe_to_fun
 
-@[simp] lemma linear_refl : (refl k P₁).linear = linear_equiv.refl k V₁ := rfl
+instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ ≃ P₂) := ⟨affine_equiv.to_equiv⟩
 
 variables {k P₁}
 
-include V₂
-
 @[simp] lemma map_vadd (e : P₁ ≃ᵃ[k] P₂) (p : P₁) (v : V₁) : e (v +ᵥ p) = e.linear v +ᵥ e p :=
 e.map_vadd' p v
 
 @[simp] lemma coe_to_equiv (e : P₁ ≃ᵃ[k] P₂) : ⇑e.to_equiv = e := rfl
 
-/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
-def to_affine_map (e : P₁ ≃ᵃ[k] P₂) : P₁ →ᵃ[k] P₂ := { to_fun := e, .. e }
-
 instance : has_coe (P₁ ≃ᵃ[k] P₂) (P₁ →ᵃ[k] P₂) := ⟨to_affine_map⟩
 
 @[simp] lemma coe_to_affine_map (e : P₁ ≃ᵃ[k] P₂) :
   (e.to_affine_map : P₁ → P₂) = (e : P₁ → P₂) :=
 rfl
 
-@[simp] lemma to_affine_map_mk (f : P₁ ≃ P₂) (f' : V₁ ≃ₗ[k] V₂) (h) :
-  to_affine_map (mk f f' h) = ⟨f, f', h⟩ :=
-rfl
-
 @[norm_cast, simp] lemma coe_coe (e : P₁ ≃ᵃ[k] P₂) : ((e : P₁ →ᵃ[k] P₂) : P₁ → P₂) = e := rfl
 
-@[simp] lemma linear_to_affine_map (e : P₁ ≃ᵃ[k] P₂) : e.to_affine_map.linear = e.linear := rfl
-
-lemma to_affine_map_injective : injective (to_affine_map : (P₁ ≃ᵃ[k] P₂) → (P₁ →ᵃ[k] P₂)) :=
-begin
-  rintros ⟨e, el, h⟩ ⟨e', el', h'⟩ H,
-  simp only [to_affine_map_mk, equiv.coe_inj, linear_equiv.to_linear_map_inj] at H,
-  congr,
-  exacts [H.1, H.2]
-end
-
-@[simp] lemma to_affine_map_inj {e e' : P₁ ≃ᵃ[k] P₂} :
-  e.to_affine_map = e'.to_affine_map ↔ e = e' :=
-to_affine_map_injective.eq_iff
+@[simp] lemma coe_linear (e : P₁ ≃ᵃ[k] P₂) : (e : P₁ →ᵃ[k] P₂).linear = e.linear := rfl
 
 @[ext] lemma ext {e e' : P₁ ≃ᵃ[k] P₂} (h : ∀ x, e x = e' x) : e = e' :=
-to_affine_map_injective $ affine_map.ext h
+fun_like.ext _ _ h
 
 lemma coe_fn_injective : @injective (P₁ ≃ᵃ[k] P₂) (P₁ → P₂) coe_fn :=
-λ e e' H, ext $ congr_fun H
+fun_like.coe_injective
 
 @[simp, norm_cast] lemma coe_fn_inj {e e' : P₁ ≃ᵃ[k] P₂} : (e : P₁ → P₂) = e' ↔ e = e' :=
 coe_fn_injective.eq_iff
@@ -178,6 +171,16 @@ protected lemma bijective (e : P₁ ≃ᵃ[k] P₂) : bijective e := e.to_equiv.
 protected lemma surjective (e : P₁ ≃ᵃ[k] P₂) : surjective e := e.to_equiv.surjective
 protected lemma injective (e : P₁ ≃ᵃ[k] P₂) : injective e := e.to_equiv.injective
 
+/-- Bijective affine maps are affine isomorphisms. -/
+@[simps]
+noncomputable def of_bijective {φ : P₁ →ᵃ[k] P₂} (hφ : function.bijective φ) : P₁ ≃ᵃ[k] P₂ :=
+{ linear := linear_equiv.of_bijective φ.linear (φ.linear_bijective_iff.mpr hφ),
+  map_vadd' := φ.map_vadd,
+  ..(equiv.of_bijective _ hφ) }
+
+lemma of_bijective.symm_eq {φ : P₁ →ᵃ[k] P₂} (hφ : function.bijective φ) :
+  (of_bijective hφ).symm.to_equiv = (equiv.of_bijective _ hφ).symm := rfl
+
 @[simp] lemma range_eq (e : P₁ ≃ᵃ[k] P₂) : range e = univ := e.surjective.range_eq
 
 @[simp] lemma apply_symm_apply (e : P₁ ≃ᵃ[k] P₂) (p : P₂) : e (e.symm p) = p :=
@@ -192,10 +195,35 @@ e.to_equiv.apply_eq_iff_eq_symm_apply
 @[simp] lemma apply_eq_iff_eq (e : P₁ ≃ᵃ[k] P₂) {p₁ p₂ : P₁} : e p₁ = e p₂ ↔ p₁ = p₂ :=
 e.to_equiv.apply_eq_iff_eq
 
+@[simp] lemma image_symm (f : P₁ ≃ᵃ[k] P₂) (s : set P₂) : f.symm '' s = f ⁻¹' s :=
+f.symm.to_equiv.image_eq_preimage _
+
+@[simp] lemma preimage_symm (f : P₁ ≃ᵃ[k] P₂) (s : set P₁) : f.symm ⁻¹' s = f '' s :=
+(f.symm.image_symm _).symm
+
+variables (k P₁)
+
 omit V₂
 
+/-- Identity map as an `affine_equiv`. -/
+@[refl] def refl : P₁ ≃ᵃ[k] P₁ :=
+{ to_equiv := equiv.refl P₁,
+  linear := linear_equiv.refl k V₁,
+  map_vadd' := λ _ _, rfl }
+
+@[simp] lemma coe_refl : ⇑(refl k P₁) = id := rfl
+
+@[simp] lemma coe_refl_to_affine_map : ↑(refl k P₁) = affine_map.id k P₁ := rfl
+
+@[simp] lemma refl_apply (x : P₁) : refl k P₁ x = x := rfl
+
+@[simp] lemma to_equiv_refl : (refl k P₁).to_equiv = equiv.refl P₁ := rfl
+
+@[simp] lemma linear_refl : (refl k P₁).linear = linear_equiv.refl k V₁ := rfl
+
 @[simp] lemma symm_refl : (refl k P₁).symm = refl k P₁ := rfl
 
+variables {k P₁}
 include V₂ V₃
 
 /-- Composition of two `affine_equiv`alences, applied left to right. -/
@@ -207,6 +235,10 @@ include V₂ V₃
 
 @[simp] lemma coe_trans (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) : ⇑(e.trans e') = e' ∘ e := rfl
 
+@[simp] lemma coe_trans_to_affine_map (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) :
+  (e.trans e' : P₁ →ᵃ[k] P₃) = (e' : P₂ →ᵃ[k] P₃).comp e :=
+rfl
+
 @[simp]
 lemma trans_apply (e : P₁ ≃ᵃ[k] P₂) (e' : P₂ ≃ᵃ[k] P₃) (p : P₁) : e.trans e' p = e' (e p) := rfl
 
@@ -300,13 +332,37 @@ def const_vsub (p : P₁) : P₁ ≃ᵃ[k] V₁ :=
 
 variable (P₁)
 
-/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space. -/
-@[simps]
+/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space.
+
+Note that there is no need for an `affine_map.const_vadd` as it is always an equivalence.
+This is roughly to `distrib_mul_action.to_linear_equiv` as `+ᵥ` is to `•`. -/
+@[simps apply linear]
 def const_vadd (v : V₁) : P₁ ≃ᵃ[k] P₁ :=
 { to_equiv := equiv.const_vadd P₁ v,
   linear := linear_equiv.refl _ _,
   map_vadd' := λ p w, vadd_comm _ _ _ }
 
+@[simp] lemma const_vadd_zero : const_vadd k P₁ 0 = affine_equiv.refl _ _ := ext $ zero_vadd _
+
+@[simp] lemma const_vadd_add (v w : V₁) :
+  const_vadd k P₁ (v + w) = (const_vadd k P₁ w).trans (const_vadd k P₁ v) := ext $ add_vadd _ _
+
+@[simp] lemma const_vadd_symm (v : V₁) : (const_vadd k P₁ v).symm = const_vadd k P₁ (-v) :=
+ext $ λ _, rfl
+
+/-- A more bundled version of `affine_equiv.const_vadd`. -/
+@[simps]
+def const_vadd_hom : multiplicative V₁ →* P₁ ≃ᵃ[k] P₁ :=
+{ to_fun := λ v, const_vadd k P₁ v.to_add,
+  map_one' := const_vadd_zero _ _,
+  map_mul' := const_vadd_add _ _ }
+
+lemma const_vadd_nsmul (n : ℕ) (v : V₁) : const_vadd k P₁ (n • v) = (const_vadd k P₁ v)^n :=
+(const_vadd_hom k P₁).map_pow _ _
+
+lemma const_vadd_zsmul (z : ℤ) (v : V₁) : const_vadd k P₁ (z • v) = (const_vadd k P₁ v)^z :=
+(const_vadd_hom k P₁).map_zpow _ _
+
 section homothety
 
 omit V₁
diff --git a/src/linear_algebra/affine_space/affine_map.lean b/src/linear_algebra/affine_space/affine_map.lean
index bb3fa4390f21f..3714083f07b4f 100644
--- a/src/linear_algebra/affine_space/affine_map.lean
+++ b/src/linear_algebra/affine_space/affine_map.lean
@@ -3,17 +3,18 @@ Copyright (c) 2020 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers
 -/
-import algebra.add_torsor
-import data.set.intervals.unordered_interval
+import data.set.pointwise.interval
 import linear_algebra.affine_space.basic
 import linear_algebra.bilinear_map
 import linear_algebra.pi
 import linear_algebra.prod
-import tactic.abel
 
 /-!
 # Affine maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines affine maps.
 
 ## Main definitions
@@ -58,11 +59,24 @@ structure affine_map (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Ty
 
 notation P1 ` →ᵃ[`:25 k:25 `] `:0 P2:0 := affine_map k P1 P2
 
-instance (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Type*)
-    [ring k]
-    [add_comm_group V1] [module k V1] [affine_space V1 P1]
-    [add_comm_group V2] [module k V2] [affine_space V2 P2]:
-    has_coe_to_fun (P1 →ᵃ[k] P2) (λ _, P1 → P2) := ⟨affine_map.to_fun⟩
+instance affine_map.fun_like (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Type*)
+  [ring k]
+  [add_comm_group V1] [module k V1] [affine_space V1 P1]
+  [add_comm_group V2] [module k V2] [affine_space V2 P2]:
+  fun_like (P1 →ᵃ[k] P2) P1 (λ _, P2) :=
+{ coe := affine_map.to_fun,
+  coe_injective' := λ ⟨f, f_linear, f_add⟩ ⟨g, g_linear, g_add⟩ (h : f = g), begin
+    cases (add_torsor.nonempty : nonempty P1) with p,
+    congr' with v,
+    apply vadd_right_cancel (f p),
+    erw [← f_add, h, ← g_add]
+  end }
+
+instance affine_map.has_coe_to_fun (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Type*)
+  [ring k]
+  [add_comm_group V1] [module k V1] [affine_space V1 P1]
+  [add_comm_group V2] [module k V2] [affine_space V2 P2] :
+  has_coe_to_fun (P1 →ᵃ[k] P2) (λ _, P1 → P2) := fun_like.has_coe_to_fun
 
 namespace linear_map
 
@@ -114,20 +128,12 @@ by conv_rhs { rw [←vsub_vadd p1 p2, map_vadd, vadd_vsub] }
 
 /-- Two affine maps are equal if they coerce to the same function. -/
 @[ext] lemma ext {f g : P1 →ᵃ[k] P2} (h : ∀ p, f p = g p) : f = g :=
-begin
-  rcases f with ⟨f, f_linear, f_add⟩,
-  rcases g with ⟨g, g_linear, g_add⟩,
-  obtain rfl : f = g := funext h,
-  congr' with v,
-  cases (add_torsor.nonempty : nonempty P1) with p,
-  apply vadd_right_cancel (f p),
-  erw [← f_add, ← g_add]
-end
+fun_like.ext _ _ h
 
 lemma ext_iff {f g : P1 →ᵃ[k] P2} : f = g ↔ ∀ p, f p = g p := ⟨λ h p, h ▸ rfl, ext⟩
 
 lemma coe_fn_injective : @function.injective (P1 →ᵃ[k] P2) (P1 → P2) coe_fn :=
-λ f g H, ext $ congr_fun H
+fun_like.coe_injective
 
 protected lemma congr_arg (f : P1 →ᵃ[k] P2) {x y : P1} (h : x = y) : f x = f y :=
 congr_arg _ h
@@ -177,7 +183,7 @@ def mk' (f : P1 → P2) (f' : V1 →ₗ[k] V2) (p : P1) (h : ∀ p' : P1, f p' =
 
 @[simp] lemma mk'_linear (f : P1 → P2) (f' : V1 →ₗ[k] V2) (p h) : (mk' f f' p h).linear = f' := rfl
 
-section has_scalar
+section has_smul
 variables {R : Type*} [monoid R] [distrib_mul_action R V2] [smul_comm_class k R V2]
 
 /-- The space of affine maps to a module inherits an `R`-action from the action on its codomain. -/
@@ -194,7 +200,7 @@ instance [distrib_mul_action Rᵐᵒᵖ V2] [is_central_scalar R V2] :
   is_central_scalar R (P1 →ᵃ[k] V2) :=
 { op_smul_eq_smul := λ r x, ext $ λ _, op_smul_eq_smul _ _ }
 
-end has_scalar
+end has_smul
 
 instance : has_zero (P1 →ᵃ[k] V2) := { zero := ⟨0, 0, λ p v, (zero_vadd _ _).symm⟩ }
 instance : has_add (P1 →ᵃ[k] V2) :=
@@ -330,7 +336,7 @@ instance : monoid (P1 →ᵃ[k] P1) :=
 
 include V2
 
-@[simp] lemma injective_iff_linear_injective (f : P1 →ᵃ[k] P2) :
+@[simp] lemma linear_injective_iff (f : P1 →ᵃ[k] P2) :
   function.injective f.linear ↔ function.injective f :=
 begin
   obtain ⟨p⟩ := (infer_instance : nonempty P1),
@@ -339,7 +345,7 @@ begin
   rw [h, equiv.comp_injective, equiv.injective_comp],
 end
 
-@[simp] lemma surjective_iff_linear_surjective (f : P1 →ᵃ[k] P2) :
+@[simp] lemma linear_surjective_iff (f : P1 →ᵃ[k] P2) :
   function.surjective f.linear ↔ function.surjective f :=
 begin
   obtain ⟨p⟩ := (infer_instance : nonempty P1),
@@ -348,6 +354,10 @@ begin
   rw [h, equiv.comp_surjective, equiv.surjective_comp],
 end
 
+@[simp] lemma linear_bijective_iff (f : P1 →ᵃ[k] P2) :
+  function.bijective f.linear ↔ function.bijective f :=
+and_congr f.linear_injective_iff f.linear_surjective_iff
+
 lemma image_vsub_image {s t : set P1} (f : P1 →ᵃ[k] P2) :
   (f '' s) -ᵥ (f '' t) = f.linear '' (s -ᵥ t) :=
 begin
@@ -407,6 +417,27 @@ by simp [line_map_apply]
 @[simp] lemma line_map_apply_one (p₀ p₁ : P1) : line_map p₀ p₁ (1:k) = p₁ :=
 by simp [line_map_apply]
 
+@[simp] lemma line_map_eq_line_map_iff [no_zero_smul_divisors k V1] {p₀ p₁ : P1} {c₁ c₂ : k} :
+  line_map p₀ p₁ c₁ = line_map p₀ p₁ c₂ ↔ p₀ = p₁ ∨ c₁ = c₂ :=
+by rw [line_map_apply, line_map_apply, ←@vsub_eq_zero_iff_eq V1, vadd_vsub_vadd_cancel_right,
+       ←sub_smul, smul_eq_zero, sub_eq_zero, vsub_eq_zero_iff_eq, or_comm, eq_comm]
+
+@[simp] lemma line_map_eq_left_iff [no_zero_smul_divisors k V1] {p₀ p₁ : P1} {c : k} :
+  line_map p₀ p₁ c = p₀ ↔ p₀ = p₁ ∨ c = 0 :=
+by rw [←@line_map_eq_line_map_iff k V1, line_map_apply_zero]
+
+@[simp] lemma line_map_eq_right_iff [no_zero_smul_divisors k V1] {p₀ p₁ : P1} {c : k} :
+  line_map p₀ p₁ c = p₁ ↔ p₀ = p₁ ∨ c = 1 :=
+by rw [←@line_map_eq_line_map_iff k V1, line_map_apply_one]
+
+variables (k)
+
+lemma line_map_injective [no_zero_smul_divisors k V1] {p₀ p₁ : P1} (h : p₀ ≠ p₁) :
+  function.injective (line_map p₀ p₁ : k → P1) :=
+λ c₁ c₂ hc, (line_map_eq_line_map_iff.mp hc).resolve_left h
+
+variables {k}
+
 include V2
 
 @[simp] lemma apply_line_map (f : P1 →ᵃ[k] P2) (p₀ p₁ : P1) (c : k) :
@@ -478,9 +509,9 @@ by rw decomp ; simp only [linear_map.map_zero, pi.add_apply, add_sub_cancel, zer
 
 omit V1
 
-lemma image_interval {k : Type*} [linear_ordered_field k] (f : k →ᵃ[k] k)
+lemma image_uIcc {k : Type*} [linear_ordered_field k] (f : k →ᵃ[k] k)
   (a b : k) :
-  f '' set.interval a b = set.interval (f a) (f b) :=
+  f '' set.uIcc a b = set.uIcc (f a) (f b) :=
 begin
   have : ⇑f = (λ x, x + f 0) ∘ λ x, x * (f 1 - f 0),
   { ext x,
@@ -488,7 +519,7 @@ begin
     rw [← f.linear_map_vsub, ← f.linear.map_smul, ← f.map_vadd],
     simp only [vsub_eq_sub, add_zero, mul_one, vadd_eq_add, sub_zero, smul_eq_mul] },
   rw [this, set.image_comp],
-  simp only [set.image_add_const_interval, set.image_mul_const_interval]
+  simp only [set.image_add_const_uIcc, set.image_mul_const_uIcc]
 end
 
 section
@@ -621,3 +652,14 @@ rfl
 end comm_ring
 
 end affine_map
+
+section
+variables {𝕜 E F : Type*} [ring 𝕜] [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F]
+
+/-- Applying an affine map to an affine combination of two points yields an affine combination of
+the images. -/
+lemma convex.combo_affine_apply {x y : E} {a b : 𝕜} {f : E →ᵃ[𝕜] F} (h : a + b = 1) :
+  f (a • x + b • y) = a • f x + b • f y :=
+by { simp only [convex.combo_eq_smul_sub_add h, ←vsub_eq_sub], exact f.apply_line_map _ _ _ }
+
+end
diff --git a/src/linear_algebra/affine_space/affine_subspace.lean b/src/linear_algebra/affine_space/affine_subspace.lean
index 4734343bc9d4a..321ca954d5a12 100644
--- a/src/linear_algebra/affine_space/affine_subspace.lean
+++ b/src/linear_algebra/affine_space/affine_subspace.lean
@@ -3,12 +3,14 @@ Copyright (c) 2020 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers
 -/
-import data.set.intervals.unordered_interval
 import linear_algebra.affine_space.affine_equiv
 
 /-!
 # Affine spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines affine subspaces (over modules) and the affine span of a set of points.
 
 ## Main definitions
@@ -23,6 +25,8 @@ This file defines affine subspaces (over modules) and the affine span of a set o
   various lemmas relating to the set of vectors in the `direction`,
   and relating the lattice structure on affine subspaces to that on
   their directions.
+* `affine_subspace.parallel`, notation `∥`, gives the property of two affine subspaces being
+  parallel (one being a translate of the other).
 * `affine_span` gives the affine subspace spanned by a set of points,
   with `vector_span` giving its direction.  `affine_span` is defined
   in terms of `span_points`, which gives an explicit description of
@@ -52,7 +56,7 @@ Those depending on analysis or topology are defined elsewhere; see
 -/
 
 noncomputable theory
-open_locale big_operators classical affine
+open_locale big_operators affine
 
 open set
 
@@ -177,9 +181,9 @@ variables (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V] [modul
           [affine_space V P]
 include V
 
--- TODO Refactor to use `instance : set_like (affine_subspace k P) P :=` instead
-instance : has_coe (affine_subspace k P) (set P) := ⟨carrier⟩
-instance : has_mem P (affine_subspace k P) := ⟨λ p s, p ∈ (s : set P)⟩
+instance : set_like (affine_subspace k P) P :=
+{ coe := carrier,
+  coe_injective' := λ p q _, by cases p; cases q; congr' }
 
 /-- A point is in an affine subspace coerced to a set if and only if
 it is in that affine subspace. -/
@@ -276,6 +280,16 @@ lemma vadd_mem_iff_mem_direction {s : affine_subspace k P} (v : V) {p : P} (hp :
   v +ᵥ p ∈ s ↔ v ∈ s.direction :=
 ⟨λ h, by simpa using vsub_mem_direction h hp, λ h, vadd_mem_of_mem_direction h hp⟩
 
+/-- Adding a vector in the direction to a point produces a point in the subspace if and only if
+the original point is in the subspace. -/
+lemma vadd_mem_iff_mem_of_mem_direction {s : affine_subspace k P} {v : V} (hv : v ∈ s.direction)
+  {p : P} : v +ᵥ p ∈ s ↔ p ∈ s :=
+begin
+  refine ⟨λ h, _, λ h, vadd_mem_of_mem_direction hv h⟩,
+  convert vadd_mem_of_mem_direction (submodule.neg_mem _ hv) h,
+  simp
+end
+
 /-- Given a point in an affine subspace, the set of vectors in its
 direction equals the set of vectors subtracting that point on the
 right. -/
@@ -343,17 +357,15 @@ begin
 end
 
 /-- Two affine subspaces are equal if they have the same points. -/
-@[ext] lemma coe_injective : function.injective (coe : affine_subspace k P → set P) :=
-λ s1 s2 h, begin
-  cases s1,
-  cases s2,
-  congr,
-  exact h
-end
+lemma coe_injective : function.injective (coe : affine_subspace k P → set P) :=
+set_like.coe_injective
+
+@[ext] theorem ext {p q : affine_subspace k P} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q :=
+set_like.ext h
 
 @[simp] lemma ext_iff (s₁ s₂ : affine_subspace k P) :
   (s₁ : set P) = s₂ ↔ s₁ = s₂ :=
-⟨λ h, coe_injective h, by tidy⟩
+set_like.ext'_iff.symm
 
 /-- Two affine subspaces with the same direction and nonempty
 intersection are equal. -/
@@ -376,7 +388,9 @@ begin
     exact vsub_mem_direction hp hq2 }
 end
 
-instance to_add_torsor (s : affine_subspace k P) [nonempty s] : add_torsor s.direction s :=
+/-- This is not an instance because it loops with `add_torsor.nonempty`. -/
+@[reducible] -- See note [reducible non instances]
+def to_add_torsor (s : affine_subspace k P) [nonempty s] : add_torsor s.direction s :=
 { vadd := λ a b, ⟨(a:V) +ᵥ (b:P), vadd_mem_of_mem_direction a.2 b.2⟩,
   zero_vadd := by simp,
   add_vadd := λ a b c, by { ext, apply add_vadd },
@@ -385,6 +399,8 @@ instance to_add_torsor (s : affine_subspace k P) [nonempty s] : add_torsor s.dir
   vsub_vadd' := λ a b, by { ext, apply add_torsor.vsub_vadd' },
   vadd_vsub' := λ a b, by { ext, apply add_torsor.vadd_vsub' } }
 
+local attribute [instance] to_add_torsor
+
 @[simp, norm_cast] lemma coe_vsub (s : affine_subspace k P) [nonempty s] (a b : s) :
   ↑(a -ᵥ b) = (a:P) -ᵥ (b:P) :=
 rfl
@@ -393,6 +409,25 @@ rfl
   ↑(a +ᵥ b) = (a:V) +ᵥ (b:P) :=
 rfl
 
+/-- Embedding of an affine subspace to the ambient space, as an affine map. -/
+protected def subtype (s : affine_subspace k P) [nonempty s] : s →ᵃ[k] P :=
+{ to_fun := coe,
+  linear := s.direction.subtype,
+  map_vadd' := λ p v, rfl }
+
+@[simp] lemma subtype_linear (s : affine_subspace k P) [nonempty s] :
+  s.subtype.linear = s.direction.subtype :=
+rfl
+
+lemma subtype_apply (s : affine_subspace k P) [nonempty s] (p : s) : s.subtype p = p :=
+rfl
+
+@[simp] lemma coe_subtype (s : affine_subspace k P) [nonempty s] : (s.subtype : s → P) = coe :=
+rfl
+
+lemma injective_subtype (s : affine_subspace k P) [nonempty s] : function.injective s.subtype :=
+subtype.coe_injective
+
 /-- Two affine subspaces with nonempty intersection are equal if and
 only if their directions are equal. -/
 lemma eq_iff_direction_eq_of_mem {s₁ s₂ : affine_subspace k P} {p : P} (h₁ : p ∈ s₁)
@@ -443,6 +478,18 @@ begin
                  self_mem_mk' _ _, (vadd_vsub _ _).symm⟩ }
 end
 
+/-- A point lies in an affine subspace constructed from another point and a direction if and only
+if their difference is in that direction. -/
+lemma mem_mk'_iff_vsub_mem {p₁ p₂ : P} {direction : submodule k V} :
+  p₂ ∈ mk' p₁ direction ↔ p₂ -ᵥ p₁ ∈ direction :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { rw ←direction_mk' p₁ direction,
+    exact vsub_mem_direction h (self_mem_mk' _ _) },
+  { rw ← vsub_vadd p₂ p₁,
+    exact vadd_mem_mk' p₁ h }
+end
+
 /-- Constructing an affine subspace from a point in a subspace and
 that subspace's direction yields the original subspace. -/
 @[simp] lemma mk'_eq {s : affine_subspace k P} {p : P} (hp : p ∈ s) : mk' p s.direction = s :=
@@ -629,7 +676,7 @@ lemma _root_.affine_span_le {s : set P} {Q : affine_subspace k P} :
   affine_span k s ≤ Q ↔ s ⊆ (Q : set P) :=
 (affine_subspace.gi k V P).gc _ _
 
-variables (k V) {P}
+variables (k V) {P} {p₁ p₂ : P}
 
 /-- The affine span of a single point, coerced to a set, contains just
 that point. -/
@@ -643,10 +690,13 @@ end
 
 /-- A point is in the affine span of a single point if and only if
 they are equal. -/
-@[simp] lemma mem_affine_span_singleton (p1 p2 : P) :
-  p1 ∈ affine_span k ({p2} : set P) ↔ p1 = p2 :=
+@[simp] lemma mem_affine_span_singleton : p₁ ∈ affine_span k ({p₂} : set P) ↔ p₁ = p₂ :=
 by simp [←mem_coe]
 
+@[simp] lemma preimage_coe_affine_span_singleton (x : P) :
+  (coe : affine_span k ({x} : set P) → P) ⁻¹' {x} = univ :=
+eq_univ_of_forall $ λ y, (affine_subspace.mem_affine_span_singleton _ _).1 y.2
+
 /-- The span of a union of sets is the sup of their spans. -/
 lemma span_union (s t : set P) : affine_span k (s ∪ t) = affine_span k s ⊔ affine_span k t :=
 (affine_subspace.gi k V P).gc.l_sup
@@ -697,7 +747,7 @@ instance : nontrivial (affine_subspace k P) := ⟨⟨⊥, ⊤, bot_ne_top k V P
 
 lemma nonempty_of_affine_span_eq_top {s : set P} (h : affine_span k s = ⊤) : s.nonempty :=
 begin
-  rw ← set.ne_empty_iff_nonempty,
+  rw set.nonempty_iff_ne_empty,
   rintros rfl,
   rw affine_subspace.span_empty at h,
   exact bot_ne_top k V P h,
@@ -759,7 +809,7 @@ coe_injective.eq_iff' (bot_coe _ _ _)
 coe_injective.eq_iff' (top_coe _ _ _)
 
 lemma nonempty_iff_ne_bot (Q : affine_subspace k P) : (Q : set P).nonempty ↔ Q ≠ ⊥ :=
-by { rw ← ne_empty_iff_nonempty, exact not_congr Q.coe_eq_bot_iff }
+by { rw nonempty_iff_ne_empty, exact not_congr Q.coe_eq_bot_iff }
 
 lemma eq_bot_or_nonempty (Q : affine_subspace k P) : Q = ⊥ ∨ (Q : set P).nonempty :=
 by { rw nonempty_iff_ne_bot, apply eq_or_ne }
@@ -999,7 +1049,8 @@ end
 /-- The `vector_span` is the span of the pairwise subtractions with a
 given point on the right, excluding the subtraction of that point from
 itself. -/
-lemma vector_span_eq_span_vsub_finset_right_ne {s : finset P} {p : P} (hp : p ∈ s) :
+lemma vector_span_eq_span_vsub_finset_right_ne [decidable_eq P] [decidable_eq V] {s : finset P}
+  {p : P} (hp : p ∈ s) :
   vector_span k (s : set P) = submodule.span k ((s.erase p).image (-ᵥ p)) :=
 by simp [vector_span_eq_span_vsub_set_right_ne _ (finset.mem_coe.mpr hp)]
 
@@ -1071,18 +1122,72 @@ begin
   { exact λ ⟨i₁, hi₁, hv⟩, ⟨p i₁, ⟨i₁, ⟨set.mem_univ _, hi₁⟩, rfl⟩, hv⟩ }
 end
 
-/-- The affine span of a set is nonempty if and only if that set
-is. -/
-lemma affine_span_nonempty (s : set P) :
-  (affine_span k s : set P).nonempty ↔ s.nonempty :=
+section
+variables {s : set P}
+
+/-- The affine span of a set is nonempty if and only if that set is. -/
+lemma affine_span_nonempty : (affine_span k s : set P).nonempty ↔ s.nonempty :=
 span_points_nonempty k s
 
+alias affine_span_nonempty ↔ _ _root_.set.nonempty.affine_span
+
 /-- The affine span of a nonempty set is nonempty. -/
-instance {s : set P} [nonempty s] : nonempty (affine_span k s) :=
-((affine_span_nonempty k s).mpr (nonempty_subtype.mp ‹_›)).to_subtype
+instance [nonempty s] : nonempty (affine_span k s) :=
+((nonempty_coe_sort.1 ‹_›).affine_span _).to_subtype
+
+/-- The affine span of a set is `⊥` if and only if that set is empty. -/
+@[simp] lemma affine_span_eq_bot : affine_span k s = ⊥ ↔ s = ∅ :=
+by rw [←not_iff_not, ←ne.def, ←ne.def, ←nonempty_iff_ne_bot, affine_span_nonempty,
+       nonempty_iff_ne_empty]
+
+@[simp] lemma bot_lt_affine_span : ⊥ < affine_span k s ↔ s.nonempty :=
+by { rw [bot_lt_iff_ne_bot, nonempty_iff_ne_empty], exact (affine_span_eq_bot _).not }
+
+end
 
 variables {k}
 
+/--
+An induction principle for span membership. If `p` holds for all elements of `s` and is
+preserved under certain affine combinations, then `p` holds for all elements of the span of `s`.
+-/
+lemma affine_span_induction {x : P} {s : set P} {p : P → Prop} (h : x ∈ affine_span k s)
+  (Hs : ∀ x : P, x ∈ s → p x)
+  (Hc : ∀ (c : k) (u v w : P), p u → p v → p w → p (c • (u -ᵥ v) +ᵥ w)) : p x :=
+(@affine_span_le _ _ _ _ _ _ _ _ ⟨p, Hc⟩).mpr Hs h
+
+/-- A dependent version of `affine_span_induction`. -/
+lemma affine_span_induction' {s : set P} {p : Π x, x ∈ affine_span k s → Prop}
+  (Hs : ∀ y (hys : y ∈ s), p y (subset_affine_span k _ hys))
+  (Hc : ∀ (c : k) u hu v hv w hw, p u hu → p v hv → p w hw →
+    p (c • (u -ᵥ v) +ᵥ w) (affine_subspace.smul_vsub_vadd_mem _ _ hu hv hw))
+  {x : P} (h : x ∈ affine_span k s) : p x h :=
+begin
+  refine exists.elim _ (λ (hx : x ∈ affine_span k s) (hc : p x hx), hc),
+  refine @affine_span_induction k V P _ _ _ _ _ _ _ h _ _,
+  { exact (λ y hy, ⟨subset_affine_span _ _ hy, Hs y hy⟩) },
+  { exact (λ c u v w hu hv hw, exists.elim hu $ λ hu' hu, exists.elim hv $ λ hv' hv,
+      exists.elim hw $ λ hw' hw,
+        ⟨affine_subspace.smul_vsub_vadd_mem _ _ hu' hv' hw', Hc _ _ _ _ _ _ _ hu hv hw⟩) },
+end
+
+section with_local_instance
+
+local attribute [instance] affine_subspace.to_add_torsor
+
+/-- A set, considered as a subset of its spanned affine subspace, spans the whole subspace. -/
+@[simp] lemma affine_span_coe_preimage_eq_top (A : set P) [nonempty A] :
+  affine_span k ((coe : affine_span k A → P) ⁻¹' A) = ⊤ :=
+begin
+  rw [eq_top_iff],
+  rintro ⟨x, hx⟩ -,
+  refine affine_span_induction' (λ y hy, _) (λ c u hu v hv w hw, _) hx,
+  { exact subset_affine_span _ _ hy },
+  { exact affine_subspace.smul_vsub_vadd_mem _ _ },
+end
+
+end with_local_instance
+
 /-- Suppose a set of vectors spans `V`.  Then a point `p`, together
 with those vectors added to `p`, spans `P`. -/
 lemma affine_span_singleton_union_vadd_eq_top_of_span_eq_top {s : set V} (p : P)
@@ -1104,6 +1209,121 @@ end
 
 variables (k)
 
+/-- The `vector_span` of two points is the span of their difference. -/
+lemma vector_span_pair (p₁ p₂ : P) : vector_span k ({p₁, p₂} : set P) = k ∙ (p₁ -ᵥ p₂) :=
+by rw [vector_span_eq_span_vsub_set_left k (mem_insert p₁ _), image_pair, vsub_self,
+       submodule.span_insert_zero]
+
+/-- The `vector_span` of two points is the span of their difference (reversed). -/
+lemma vector_span_pair_rev (p₁ p₂ : P) : vector_span k ({p₁, p₂} : set P) = k ∙ (p₂ -ᵥ p₁) :=
+by rw [pair_comm, vector_span_pair]
+
+/-- The difference between two points lies in their `vector_span`. -/
+lemma vsub_mem_vector_span_pair (p₁ p₂ : P) : p₁ -ᵥ p₂ ∈ vector_span k ({p₁, p₂} : set P) :=
+vsub_mem_vector_span _ (set.mem_insert _ _) (set.mem_insert_of_mem _ (set.mem_singleton _))
+
+/-- The difference between two points (reversed) lies in their `vector_span`. -/
+lemma vsub_rev_mem_vector_span_pair (p₁ p₂ : P) : p₂ -ᵥ p₁ ∈ vector_span k ({p₁, p₂} : set P) :=
+vsub_mem_vector_span _ (set.mem_insert_of_mem _ (set.mem_singleton _)) (set.mem_insert _ _)
+
+variables {k}
+
+/-- A multiple of the difference between two points lies in their `vector_span`. -/
+lemma smul_vsub_mem_vector_span_pair (r : k) (p₁ p₂ : P) :
+  r • (p₁ -ᵥ p₂) ∈ vector_span k ({p₁, p₂} : set P) :=
+submodule.smul_mem _ _ (vsub_mem_vector_span_pair k p₁ p₂)
+
+/-- A multiple of the difference between two points (reversed) lies in their `vector_span`. -/
+lemma smul_vsub_rev_mem_vector_span_pair (r : k) (p₁ p₂ : P) :
+  r • (p₂ -ᵥ p₁) ∈ vector_span k ({p₁, p₂} : set P) :=
+submodule.smul_mem _ _ (vsub_rev_mem_vector_span_pair k p₁ p₂)
+
+/-- A vector lies in the `vector_span` of two points if and only if it is a multiple of their
+difference. -/
+lemma mem_vector_span_pair {p₁ p₂ : P} {v : V} :
+  v ∈ vector_span k ({p₁, p₂} : set P) ↔ ∃ r : k, r • (p₁ -ᵥ p₂) = v :=
+by rw [vector_span_pair, submodule.mem_span_singleton]
+
+/-- A vector lies in the `vector_span` of two points if and only if it is a multiple of their
+difference (reversed). -/
+lemma mem_vector_span_pair_rev {p₁ p₂ : P} {v : V} :
+  v ∈ vector_span k ({p₁, p₂} : set P) ↔ ∃ r : k, r • (p₂ -ᵥ p₁) = v :=
+by rw [vector_span_pair_rev, submodule.mem_span_singleton]
+
+variables (k)
+
+notation `line[` k `, ` p₁ `, ` p₂ `]` :=
+affine_span k (insert p₁ (@singleton _ _ set.has_singleton p₂))
+
+/-- The first of two points lies in their affine span. -/
+lemma left_mem_affine_span_pair (p₁ p₂ : P) : p₁ ∈ line[k, p₁, p₂] :=
+mem_affine_span _ (set.mem_insert _ _)
+
+/-- The second of two points lies in their affine span. -/
+lemma right_mem_affine_span_pair (p₁ p₂ : P) : p₂ ∈ line[k, p₁, p₂] :=
+mem_affine_span _ (set.mem_insert_of_mem _ (set.mem_singleton _))
+
+variables {k}
+
+/-- A combination of two points expressed with `line_map` lies in their affine span. -/
+lemma affine_map.line_map_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
+  affine_map.line_map p₁ p₂ r ∈ line[k, p₁, p₂] :=
+affine_map.line_map_mem _ (left_mem_affine_span_pair _ _ _) (right_mem_affine_span_pair _ _ _)
+
+/-- A combination of two points expressed with `line_map` (with the two points reversed) lies in
+their affine span. -/
+lemma affine_map.line_map_rev_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
+  affine_map.line_map p₂ p₁ r ∈ line[k, p₁, p₂] :=
+affine_map.line_map_mem _ (right_mem_affine_span_pair _ _ _) (left_mem_affine_span_pair _ _ _)
+
+/-- A multiple of the difference of two points added to the first point lies in their affine
+span. -/
+lemma smul_vsub_vadd_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
+  r • (p₂ -ᵥ p₁) +ᵥ p₁ ∈ line[k, p₁, p₂] :=
+affine_map.line_map_mem_affine_span_pair _ _ _
+
+/-- A multiple of the difference of two points added to the second point lies in their affine
+span. -/
+lemma smul_vsub_rev_vadd_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
+  r • (p₁ -ᵥ p₂) +ᵥ p₂ ∈ line[k, p₁, p₂] :=
+affine_map.line_map_rev_mem_affine_span_pair _ _ _
+
+/-- A vector added to the first point lies in the affine span of two points if and only if it is
+a multiple of their difference. -/
+lemma vadd_left_mem_affine_span_pair {p₁ p₂ : P} {v : V} :
+  v +ᵥ p₁ ∈ line[k, p₁, p₂] ↔ ∃ r : k, r • (p₂ -ᵥ p₁) = v :=
+by rw [vadd_mem_iff_mem_direction _ (left_mem_affine_span_pair _ _ _), direction_affine_span,
+       mem_vector_span_pair_rev]
+
+/-- A vector added to the second point lies in the affine span of two points if and only if it is
+a multiple of their difference. -/
+lemma vadd_right_mem_affine_span_pair {p₁ p₂ : P} {v : V} :
+  v +ᵥ p₂ ∈ line[k, p₁, p₂] ↔ ∃ r : k, r • (p₁ -ᵥ p₂) = v :=
+by rw [vadd_mem_iff_mem_direction _ (right_mem_affine_span_pair _ _ _), direction_affine_span,
+       mem_vector_span_pair]
+
+/-- The span of two points that lie in an affine subspace is contained in that subspace. -/
+lemma affine_span_pair_le_of_mem_of_mem {p₁ p₂ : P} {s : affine_subspace k P} (hp₁ : p₁ ∈ s)
+  (hp₂ : p₂ ∈ s) : line[k, p₁, p₂] ≤ s :=
+begin
+  rw [affine_span_le, set.insert_subset, set.singleton_subset_iff],
+  exact ⟨hp₁, hp₂⟩
+end
+
+/-- One line is contained in another differing in the first point if the first point of the first
+line is contained in the second line. -/
+lemma affine_span_pair_le_of_left_mem {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
+  line[k, p₁, p₃] ≤ line[k, p₂, p₃] :=
+affine_span_pair_le_of_mem_of_mem h (right_mem_affine_span_pair _ _ _)
+
+/-- One line is contained in another differing in the second point if the second point of the
+first line is contained in the second line. -/
+lemma affine_span_pair_le_of_right_mem {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
+  line[k, p₂, p₁] ≤ line[k, p₂, p₃] :=
+affine_span_pair_le_of_mem_of_mem (left_mem_affine_span_pair _ _ _) h
+
+variables (k)
+
 /-- `affine_span` is monotone. -/
 @[mono]
 lemma affine_span_mono {s₁ s₂ : set P} (h : s₁ ⊆ s₂) : affine_span k s₁ ≤ affine_span k s₂ :=
@@ -1125,6 +1345,14 @@ begin
   rw [←affine_span_insert_affine_span, set.insert_eq_of_mem h, affine_span_coe]
 end
 
+variables {k}
+
+/-- If a point is in the affine span of a set, adding it to that set
+does not change the vector span. -/
+lemma vector_span_insert_eq_vector_span {p : P} {ps : set P} (h : p ∈ affine_span k ps) :
+  vector_span k (insert p ps) = vector_span k ps :=
+by simp_rw [←direction_affine_span, affine_span_insert_eq_affine_span _ h]
+
 end affine_space'
 
 namespace affine_subspace
@@ -1238,9 +1466,23 @@ def map (s : affine_subspace k P₁) : affine_subspace k P₂ :=
 @[simp] lemma mem_map {f : P₁ →ᵃ[k] P₂} {x : P₂} {s : affine_subspace k P₁} :
   x ∈ s.map f ↔ ∃ y ∈ s, f y = x := mem_image_iff_bex
 
+lemma mem_map_of_mem {x : P₁} {s : affine_subspace k P₁} (h : x ∈ s) : f x ∈ s.map f :=
+set.mem_image_of_mem _ h
+
+lemma mem_map_iff_mem_of_injective {f : P₁ →ᵃ[k] P₂} {x : P₁} {s : affine_subspace k P₁}
+  (hf : function.injective f) : f x ∈ s.map f ↔ x ∈ s :=
+hf.mem_set_image
+
 @[simp] lemma map_bot : (⊥ : affine_subspace k P₁).map f = ⊥ :=
 coe_injective $ image_empty f
 
+@[simp] lemma map_eq_bot_iff {s : affine_subspace k P₁} : s.map f = ⊥ ↔ s = ⊥ :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { rwa [←coe_eq_bot_iff, coe_map, image_eq_empty, coe_eq_bot_iff] at h },
+  { rw [h, map_bot] }
+end
+
 omit V₂
 
 @[simp] lemma map_id (s : affine_subspace k P₁) : s.map (affine_map.id k P₁) = s :=
@@ -1285,7 +1527,9 @@ by rw [← affine_subspace.map_span, h, map_top_of_surjective f hf]
 
 end affine_map
 
-lemma affine_equiv.span_eq_top_iff {s : set P₁} (e : P₁ ≃ᵃ[k] P₂) :
+namespace affine_equiv
+
+lemma span_eq_top_iff {s : set P₁} (e : P₁ ≃ᵃ[k] P₂) :
   affine_span k s = ⊤ ↔ affine_span k (e '' s) = ⊤ :=
 begin
   refine ⟨(e : P₁ →ᵃ[k] P₂).span_eq_top_of_surjective e.surjective, _⟩,
@@ -1295,6 +1539,8 @@ begin
   exact (e.symm : P₂ →ᵃ[k] P₁).span_eq_top_of_surjective e.symm.surjective h,
 end
 
+end affine_equiv
+
 end
 
 namespace affine_subspace
@@ -1363,6 +1609,117 @@ lemma comap_supr {ι : Sort*} (f : P₁ →ᵃ[k] P₂) (s : ι → affine_subsp
   (infi s).comap f = ⨅ i, (s i).comap f :=
 (gc_map_comap f).u_infi
 
+@[simp] lemma comap_symm (e : P₁ ≃ᵃ[k] P₂) (s : affine_subspace k P₁) :
+  s.comap (e.symm : P₂ →ᵃ[k] P₁) = s.map e :=
+coe_injective $ e.preimage_symm _
+
+@[simp] lemma map_symm (e : P₁ ≃ᵃ[k] P₂) (s : affine_subspace k P₂) :
+  s.map (e.symm : P₂ →ᵃ[k] P₁) = s.comap e :=
+coe_injective $ e.image_symm _
+
+lemma comap_span (f : P₁ ≃ᵃ[k] P₂) (s : set P₂) :
+  (affine_span k s).comap (f : P₁ →ᵃ[k] P₂) = affine_span k (f ⁻¹' s) :=
+by rw [←map_symm, map_span, affine_equiv.coe_coe, f.image_symm]
+
 end affine_subspace
 
 end map_comap
+
+namespace affine_subspace
+
+open affine_equiv
+
+variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
+variables [affine_space V P]
+include V
+
+/-- Two affine subspaces are parallel if one is related to the other by adding the same vector
+to all points. -/
+def parallel (s₁ s₂ : affine_subspace k P) : Prop :=
+∃ v : V, s₂ = s₁.map (const_vadd k P v)
+
+localized "infix (name := affine_subspace.parallel) ` ∥ `:50 := affine_subspace.parallel" in affine
+
+@[symm] lemma parallel.symm {s₁ s₂ : affine_subspace k P} (h : s₁ ∥ s₂) : s₂ ∥ s₁ :=
+begin
+  rcases h with ⟨v, rfl⟩,
+  refine ⟨-v, _⟩,
+  rw [map_map, ←coe_trans_to_affine_map, ←const_vadd_add, neg_add_self, const_vadd_zero,
+      coe_refl_to_affine_map, map_id]
+end
+
+lemma parallel_comm {s₁ s₂ : affine_subspace k P} : s₁ ∥ s₂ ↔ s₂ ∥ s₁ :=
+⟨parallel.symm, parallel.symm⟩
+
+@[refl] lemma parallel.refl (s : affine_subspace k P) : s ∥ s :=
+⟨0, by simp⟩
+
+@[trans] lemma parallel.trans {s₁ s₂ s₃ : affine_subspace k P} (h₁₂ : s₁ ∥ s₂) (h₂₃ : s₂ ∥ s₃) :
+  s₁ ∥ s₃ :=
+begin
+  rcases h₁₂ with ⟨v₁₂, rfl⟩,
+  rcases h₂₃ with ⟨v₂₃, rfl⟩,
+  refine ⟨v₂₃ + v₁₂, _⟩,
+  rw [map_map, ←coe_trans_to_affine_map, ←const_vadd_add]
+end
+
+lemma parallel.direction_eq {s₁ s₂ : affine_subspace k P} (h : s₁ ∥ s₂) :
+  s₁.direction = s₂.direction :=
+begin
+  rcases h with ⟨v, rfl⟩,
+  simp
+end
+
+@[simp] lemma parallel_bot_iff_eq_bot {s : affine_subspace k P} :
+  s ∥ ⊥ ↔ s = ⊥ :=
+begin
+  refine ⟨λ h, _, λ h, h ▸ parallel.refl _⟩,
+  rcases h with ⟨v, h⟩,
+  rwa [eq_comm, map_eq_bot_iff] at h
+end
+
+@[simp] lemma bot_parallel_iff_eq_bot {s : affine_subspace k P} :
+  ⊥ ∥ s ↔ s = ⊥ :=
+by rw [parallel_comm, parallel_bot_iff_eq_bot]
+
+lemma parallel_iff_direction_eq_and_eq_bot_iff_eq_bot {s₁ s₂ : affine_subspace k P} :
+  s₁ ∥ s₂ ↔ s₁.direction = s₂.direction ∧ (s₁ = ⊥ ↔ s₂ = ⊥) :=
+begin
+  refine ⟨λ h, ⟨h.direction_eq, _, _⟩, λ h, _⟩,
+  { rintro rfl, exact bot_parallel_iff_eq_bot.1 h },
+  { rintro rfl, exact parallel_bot_iff_eq_bot.1 h },
+  { rcases h with ⟨hd, hb⟩,
+    by_cases hs₁ : s₁ = ⊥,
+    { rw [hs₁, bot_parallel_iff_eq_bot],
+      exact hb.1 hs₁ },
+    { have hs₂ : s₂ ≠ ⊥ := hb.not.1 hs₁,
+      rcases (nonempty_iff_ne_bot s₁).2 hs₁ with ⟨p₁, hp₁⟩,
+      rcases (nonempty_iff_ne_bot s₂).2 hs₂ with ⟨p₂, hp₂⟩,
+      refine ⟨p₂ -ᵥ p₁, (eq_iff_direction_eq_of_mem hp₂ _).2 _⟩,
+      { rw mem_map,
+        refine ⟨p₁, hp₁, _⟩,
+        simp },
+      { simpa using hd.symm } } }
+end
+
+lemma parallel.vector_span_eq {s₁ s₂ : set P} (h : affine_span k s₁ ∥ affine_span k s₂) :
+  vector_span k s₁ = vector_span k s₂ :=
+begin
+  simp_rw ←direction_affine_span,
+  exact h.direction_eq
+end
+
+lemma affine_span_parallel_iff_vector_span_eq_and_eq_empty_iff_eq_empty {s₁ s₂ : set P} :
+  affine_span k s₁ ∥ affine_span k s₂ ↔ vector_span k s₁ = vector_span k s₂ ∧ (s₁ = ∅ ↔ s₂ = ∅) :=
+begin
+  simp_rw [←direction_affine_span, ←affine_span_eq_bot k],
+  exact parallel_iff_direction_eq_and_eq_bot_iff_eq_bot
+end
+
+lemma affine_span_pair_parallel_iff_vector_span_eq {p₁ p₂ p₃ p₄ : P} :
+  line[k, p₁, p₂] ∥ line[k, p₃, p₄] ↔
+    vector_span k ({p₁, p₂} : set P) = vector_span k ({p₃, p₄} : set P) :=
+by simp [affine_span_parallel_iff_vector_span_eq_and_eq_empty_iff_eq_empty,
+         ←not_nonempty_iff_eq_empty]
+
+end affine_subspace
diff --git a/src/linear_algebra/affine_space/basic.lean b/src/linear_algebra/affine_space/basic.lean
index dc2f712962af6..091f47b8114c5 100644
--- a/src/linear_algebra/affine_space/basic.lean
+++ b/src/linear_algebra/affine_space/basic.lean
@@ -8,6 +8,9 @@ import algebra.add_torsor
 /-!
 # Affine space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we introduce the following notation:
 
 * `affine_space V P` is an alternative notation for `add_torsor V P` introduced at the end of this
@@ -37,4 +40,4 @@ Some key definitions are not yet present.
   coordinates, with appropriate proofs of existence when `k` is a field.
  -/
 
-localized "notation `affine_space` := add_torsor" in affine
+localized "notation (name := add_torsor) `affine_space` := add_torsor" in affine
diff --git a/src/linear_algebra/affine_space/basis.lean b/src/linear_algebra/affine_space/basis.lean
index f599bb429dfeb..2dbba32d15418 100644
--- a/src/linear_algebra/affine_space/basis.lean
+++ b/src/linear_algebra/affine_space/basis.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Oliver Nash
 -/
 import linear_algebra.affine_space.independent
-import linear_algebra.affine_space.finite_dimensional
-import linear_algebra.determinant
+import linear_algebra.basis
 
 /-!
 # Affine bases and barycentric coordinates
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Suppose `P` is an affine space modelled on the module `V` over the ring `k`, and `p : ι → P` is an
 affine-independent family of points spanning `P`. Given this data, each point `q : P` may be written
 uniquely as an affine combination: `q = w₀ p₀ + w₁ p₁ + ⋯` for some (finitely-supported) weights
@@ -28,7 +30,7 @@ barycentric coordinate of `q : P` is `1 - fᵢ (q -ᵥ p i)`.
  * `affine_basis`: a structure representing an affine basis of an affine space.
  * `affine_basis.coord`: the map `P →ᵃ[k] k` corresponding to `i : ι`.
  * `affine_basis.coord_apply_eq`: the behaviour of `affine_basis.coord i` on `p i`.
- * `affine_basis.coord_apply_neq`: the behaviour of `affine_basis.coord i` on `p j` when `j ≠ i`.
+ * `affine_basis.coord_apply_ne`: the behaviour of `affine_basis.coord i` on `p j` when `j ≠ i`.
  * `affine_basis.coord_apply`: the behaviour of `affine_basis.coord i` on `p j` for general `j`.
  * `affine_basis.coord_apply_combination`: the characterisation of `affine_basis.coord i` in terms
     of affine combinations, i.e., `affine_basis.coord i (w₀ p₀ + w₁ p₁ + ⋯) = wᵢ`.
@@ -39,58 +41,89 @@ barycentric coordinate of `q : P` is `1 - fᵢ (q -ᵥ p i)`.
 
 -/
 
-open_locale affine big_operators matrix
+open_locale affine big_operators
 open set
 
 universes u₁ u₂ u₃ u₄
 
 /-- An affine basis is a family of affine-independent points whose span is the top subspace. -/
+@[protect_proj]
 structure affine_basis (ι : Type u₁) (k : Type u₂) {V : Type u₃} (P : Type u₄)
   [add_comm_group V] [affine_space V P] [ring k] [module k V] :=
-(points : ι → P)
-(ind : affine_independent k points)
-(tot : affine_span k (range points) = ⊤)
+(to_fun : ι → P)
+(ind' : affine_independent k to_fun)
+(tot' : affine_span k (range to_fun) = ⊤)
 
-variables {ι : Type u₁} {k : Type u₂} {V : Type u₃} {P : Type u₄}
-variables [add_comm_group V] [affine_space V P]
+variables {ι ι' k V P : Type*} [add_comm_group V] [affine_space V P]
 
 namespace affine_basis
 
 section ring
 
-variables [ring k] [module k V] (b : affine_basis ι k P)
+variables [ring k] [module k V] (b : affine_basis ι k P) {s : finset ι} {i j : ι} (e : ι ≃ ι')
 
 /-- The unique point in a single-point space is the simplest example of an affine basis. -/
 instance : inhabited (affine_basis punit k punit) :=
-⟨{ points := id,
-   ind    := affine_independent_of_subsingleton k id,
-   tot    := by simp }⟩
+⟨⟨id, affine_independent_of_subsingleton k id, by simp⟩⟩
+
+include V
+
+instance fun_like : fun_like (affine_basis ι k P) ι (λ _, P) :=
+{ coe := affine_basis.to_fun,
+  coe_injective' := λ f g h, by cases f; cases g; congr' }
+
+@[ext]
+lemma ext {b₁ b₂ : affine_basis ι k P} (h : (b₁ : ι → P) = b₂) : b₁ = b₂ := fun_like.coe_injective h
+
+lemma ind : affine_independent k b := b.ind'
+lemma tot : affine_span k (range b) = ⊤ := b.tot'
+
+include b
+
+protected lemma nonempty : nonempty ι :=
+not_is_empty_iff.mp $ λ hι,
+  by simpa only [@range_eq_empty _ _ hι, affine_subspace.span_empty, bot_ne_top] using b.tot
+
+/-- Composition of an affine basis and an equivalence of index types. -/
+def reindex (e : ι ≃ ι') : affine_basis ι' k P :=
+⟨b ∘ e.symm, b.ind.comp_embedding e.symm.to_embedding,
+  by { rw [e.symm.surjective.range_comp], exact b.3 }⟩
+
+@[simp, norm_cast] lemma coe_reindex : ⇑(b.reindex e) = b ∘ e.symm := rfl
+@[simp] lemma reindex_apply (i' : ι') : b.reindex e i' = b (e.symm i') := rfl
+
+@[simp] lemma reindex_refl : b.reindex (equiv.refl _) = b := ext rfl
 
 /-- Given an affine basis for an affine space `P`, if we single out one member of the family, we
 obtain a linear basis for the model space `V`.
 
-The linear basis correpsonding to the singled-out member `i : ι` is indexed by `{j : ι // j ≠ i}`
-and its `j`th element is `points j -ᵥ points i`. (See `basis_of_apply`.) -/
+The linear basis corresponding to the singled-out member `i : ι` is indexed by `{j : ι // j ≠ i}`
+and its `j`th element is `b j -ᵥ b i`. (See `basis_of_apply`.) -/
 noncomputable def basis_of (i : ι) : basis {j : ι // j ≠ i} k V :=
-basis.mk ((affine_independent_iff_linear_independent_vsub k b.points i).mp b.ind)
+basis.mk ((affine_independent_iff_linear_independent_vsub k b i).mp b.ind)
 begin
-  suffices : submodule.span k (range (λ (j : {x // x ≠ i}), b.points ↑j -ᵥ b.points i)) =
-             vector_span k (range b.points),
-  { rw [this, ← direction_affine_span, b.tot, affine_subspace.direction_top], },
+  suffices : submodule.span k (range (λ (j : {x // x ≠ i}), b ↑j -ᵥ b i)) =
+             vector_span k (range b),
+  { rw [this, ← direction_affine_span, b.tot, affine_subspace.direction_top], exact le_rfl },
   conv_rhs { rw ← image_univ, },
-  rw vector_span_image_eq_span_vsub_set_right_ne k b.points (mem_univ i),
+  rw vector_span_image_eq_span_vsub_set_right_ne k b (mem_univ i),
   congr,
   ext v,
   simp,
 end
 
 @[simp] lemma basis_of_apply (i : ι) (j : {j : ι // j ≠ i}) :
-  b.basis_of i j = b.points ↑j -ᵥ b.points i :=
+  b.basis_of i j = b ↑j -ᵥ b i :=
 by simp [basis_of]
 
+@[simp] lemma basis_of_reindex (i : ι') :
+  (b.reindex e).basis_of i =
+    (b.basis_of $ e.symm i).reindex (e.subtype_equiv $ λ _, e.eq_symm_apply.not) :=
+by { ext j, simp }
+
 /-- The `i`th barycentric coordinate of a point. -/
 noncomputable def coord (i : ι) : P →ᵃ[k] k :=
-{ to_fun    := λ q, 1 - (b.basis_of i).sum_coords (q -ᵥ b.points i),
+{ to_fun    := λ q, 1 - (b.basis_of i).sum_coords (q -ᵥ b i),
   linear    := -(b.basis_of i).sum_coords,
   map_vadd' := λ q v, by rw [vadd_vsub_assoc, linear_map.map_add, vadd_eq_add, linear_map.neg_apply,
     sub_add_eq_sub_sub_swap, add_comm, sub_eq_add_neg], }
@@ -99,42 +132,41 @@ noncomputable def coord (i : ι) : P →ᵃ[k] k :=
   (b.coord i).linear = -(b.basis_of i).sum_coords :=
 rfl
 
-@[simp] lemma coord_apply_eq (i : ι) :
-  b.coord i (b.points i) = 1 :=
+@[simp] lemma coord_reindex (i : ι') :
+  (b.reindex e).coord i = b.coord (e.symm i) :=
+by { ext, classical, simp [affine_basis.coord] }
+
+@[simp] lemma coord_apply_eq (i : ι) : b.coord i (b i) = 1 :=
 by simp only [coord, basis.coe_sum_coords, linear_equiv.map_zero, linear_equiv.coe_coe,
   sub_zero, affine_map.coe_mk, finsupp.sum_zero_index, vsub_self]
 
-@[simp] lemma coord_apply_neq (i j : ι) (h : j ≠ i) :
-  b.coord i (b.points j) = 0 :=
-by rw [coord, affine_map.coe_mk, ← subtype.coe_mk j h, ← b.basis_of_apply i ⟨j, h⟩,
+@[simp] lemma coord_apply_ne (h : i ≠ j) : b.coord i (b j) = 0 :=
+by rw [coord, affine_map.coe_mk, ← subtype.coe_mk j h.symm, ← b.basis_of_apply,
   basis.sum_coords_self_apply, sub_self]
 
-lemma coord_apply [decidable_eq ι] (i j : ι) :
-  b.coord i (b.points j) = if i = j then 1 else 0 :=
-by { cases eq_or_ne i j; simp [h.symm], simp [h], }
+lemma coord_apply [decidable_eq ι] (i j : ι) : b.coord i (b j) = if i = j then 1 else 0 :=
+by cases eq_or_ne i j; simp [h]
 
-@[simp] lemma coord_apply_combination_of_mem
-  {s : finset ι} {i : ι} (hi : i ∈ s) {w : ι → k} (hw : s.sum w = 1) :
-  b.coord i (s.affine_combination b.points w) = w i :=
+@[simp] lemma coord_apply_combination_of_mem (hi : i ∈ s) {w : ι → k} (hw : s.sum w = 1) :
+  b.coord i (s.affine_combination k b w) = w i :=
 begin
   classical,
   simp only [coord_apply, hi, finset.affine_combination_eq_linear_combination, if_true, mul_boole,
-    hw, function.comp_app, smul_eq_mul, s.sum_ite_eq, s.map_affine_combination b.points w hw],
+    hw, function.comp_app, smul_eq_mul, s.sum_ite_eq, s.map_affine_combination b w hw],
 end
 
-@[simp] lemma coord_apply_combination_of_not_mem
-  {s : finset ι} {i : ι} (hi : i ∉ s) {w : ι → k} (hw : s.sum w = 1) :
-  b.coord i (s.affine_combination b.points w) = 0 :=
+@[simp] lemma coord_apply_combination_of_not_mem (hi : i ∉ s) {w : ι → k} (hw : s.sum w = 1) :
+  b.coord i (s.affine_combination k b w) = 0 :=
 begin
   classical,
   simp only [coord_apply, hi, finset.affine_combination_eq_linear_combination, if_false, mul_boole,
-    hw, function.comp_app, smul_eq_mul, s.sum_ite_eq, s.map_affine_combination b.points w hw],
+    hw, function.comp_app, smul_eq_mul, s.sum_ite_eq, s.map_affine_combination b w hw],
 end
 
 @[simp] lemma sum_coord_apply_eq_one [fintype ι] (q : P) :
   ∑ i, b.coord i q = 1 :=
 begin
-  have hq : q ∈ affine_span k (range b.points), { rw b.tot, exact affine_subspace.mem_top k V q, },
+  have hq : q ∈ affine_span k (range b), { rw b.tot, exact affine_subspace.mem_top k V q, },
   obtain ⟨w, hw, rfl⟩ := eq_affine_combination_of_mem_affine_span_of_fintype hq,
   convert hw,
   ext i,
@@ -142,9 +174,9 @@ begin
 end
 
 @[simp] lemma affine_combination_coord_eq_self [fintype ι] (q : P) :
-  finset.univ.affine_combination b.points (λ i, b.coord i q) = q :=
+  finset.univ.affine_combination k b (λ i, b.coord i q) = q :=
 begin
-  have hq : q ∈ affine_span k (range b.points), { rw b.tot, exact affine_subspace.mem_top k V q, },
+  have hq : q ∈ affine_span k (range b), { rw b.tot, exact affine_subspace.mem_top k V q, },
   obtain ⟨w, hw, rfl⟩ := eq_affine_combination_of_mem_affine_span_of_fintype hq,
   congr,
   ext i,
@@ -154,14 +186,15 @@ end
 /-- A variant of `affine_basis.affine_combination_coord_eq_self` for the special case when the
 affine space is a module so we can talk about linear combinations. -/
 @[simp] lemma linear_combination_coord_eq_self [fintype ι] (b : affine_basis ι k V) (v : V) :
-  ∑ i, (b.coord i v) • (b.points i) = v :=
+  ∑ i, b.coord i v • b i = v :=
 begin
   have hb := b.affine_combination_coord_eq_self v,
   rwa finset.univ.affine_combination_eq_linear_combination _ _ (b.sum_coord_apply_eq_one v) at hb,
 end
 
-lemma ext_elem [fintype ι] {q₁ q₂ : P} (h : ∀ i, b.coord i q₁ = b.coord i q₂) : q₁ = q₂ :=
+lemma ext_elem [finite ι] {q₁ q₂ : P} (h : ∀ i, b.coord i q₁ = b.coord i q₂) : q₁ = q₂ :=
 begin
+  casesI nonempty_fintype ι,
   rw [← b.affine_combination_coord_eq_self q₁, ← b.affine_combination_coord_eq_self q₂],
   simp only [h],
 end
@@ -170,7 +203,7 @@ end
   (b.coord i : P → k) = 1 :=
 begin
   ext q,
-  have hp : (range b.points).subsingleton,
+  have hp : (range b).subsingleton,
   { rw ← image_univ,
     apply subsingleton.image,
     apply subsingleton_of_subsingleton, },
@@ -178,7 +211,7 @@ begin
   let s : finset ι := {i},
   have hi : i ∈ s, { simp, },
   have hw : s.sum (function.const ι (1 : k)) = 1, { simp, },
-  have hq : q = s.affine_combination b.points (function.const ι (1 : k)), { simp, },
+  have hq : q = s.affine_combination k b (function.const ι (1 : k)), { simp, },
   rw [pi.one_apply, hq, b.coord_apply_combination_of_mem hi hw],
 end
 
@@ -193,7 +226,7 @@ begin
   have hj : j ∈ s, { simp, },
   let w : ι → k := λ j', if j' = i then x else 1-x,
   have hw : s.sum w = 1, { simp [hij, finset.sum_ite, finset.filter_insert, finset.filter_eq'], },
-  use s.affine_combination b.points w,
+  use s.affine_combination k b w,
   simp [b.coord_apply_combination_of_mem hi hw],
 end
 
@@ -213,179 +246,31 @@ noncomputable def coords : P →ᵃ[k] ι → k :=
   b.coords q i = b.coord i q :=
 rfl
 
-/-- Given an affine basis `p`, and a family of points `q : ι' → P`, this is the matrix whose
-rows are the barycentric coordinates of `q` with respect to `p`.
-
-It is an affine equivalent of `basis.to_matrix`. -/
-noncomputable def to_matrix {ι' : Type*} (q : ι' → P) : matrix ι' ι k :=
-λ i j, b.coord j (q i)
-
-@[simp] lemma to_matrix_apply {ι' : Type*} (q : ι' → P) (i : ι') (j : ι) :
-  b.to_matrix q i j = b.coord j (q i) :=
-rfl
-
-@[simp] lemma to_matrix_self [decidable_eq ι] :
-  b.to_matrix b.points = (1 : matrix ι ι k) :=
-begin
-  ext i j,
-  rw [to_matrix_apply, coord_apply, matrix.one_eq_pi_single, pi.single_apply],
-end
-
-variables {ι' : Type*} [fintype ι'] [fintype ι] (b₂ : affine_basis ι k P)
-
-lemma to_matrix_row_sum_one {ι' : Type*} (q : ι' → P) (i : ι') :
-  ∑ j, b.to_matrix q i j = 1 :=
-by simp
-
-/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
-coordinates of `p` with respect `b` has a right inverse, then `p` is affine independent. -/
-lemma affine_independent_of_to_matrix_right_inv [decidable_eq ι']
-  (p : ι' → P) {A : matrix ι ι' k} (hA : (b.to_matrix p) ⬝ A = 1) : affine_independent k p :=
-begin
-  rw affine_independent_iff_eq_of_fintype_affine_combination_eq,
-  intros w₁ w₂ hw₁ hw₂ hweq,
-  have hweq' : (b.to_matrix p).vec_mul w₁ = (b.to_matrix p).vec_mul w₂,
-  { ext j,
-    change ∑ i, (w₁ i) • (b.coord j (p i)) = ∑ i, (w₂ i) • (b.coord j (p i)),
-    rw [← finset.univ.affine_combination_eq_linear_combination _ _ hw₁,
-        ← finset.univ.affine_combination_eq_linear_combination _ _ hw₂,
-        ← finset.univ.map_affine_combination p w₁ hw₁,
-        ← finset.univ.map_affine_combination p w₂ hw₂, hweq], },
-  replace hweq' := congr_arg (λ w, A.vec_mul w) hweq',
-  simpa only [matrix.vec_mul_vec_mul, ← matrix.mul_eq_mul, hA, matrix.vec_mul_one] using hweq',
-end
-
-/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
-coordinates of `p` with respect `b` has a left inverse, then `p` spans the entire space. -/
-lemma affine_span_eq_top_of_to_matrix_left_inv [decidable_eq ι] [nontrivial k]
-  (p : ι' → P) {A : matrix ι ι' k} (hA : A ⬝ b.to_matrix p = 1) : affine_span k (range p) = ⊤ :=
-begin
-  suffices : ∀ i, b.points i ∈ affine_span k (range p),
-  { rw [eq_top_iff, ← b.tot, affine_span_le],
-    rintros q ⟨i, rfl⟩,
-    exact this i, },
-  intros i,
-  have hAi : ∑ j, A i j = 1,
-  { calc ∑ j, A i j = ∑ j, (A i j) * ∑ l, b.to_matrix p j l : by simp
-                ... = ∑ j, ∑ l, (A i j) * b.to_matrix p j l : by simp_rw finset.mul_sum
-                ... = ∑ l, ∑ j, (A i j) * b.to_matrix p j l : by rw finset.sum_comm
-                ... = ∑ l, (A ⬝ b.to_matrix p) i l : rfl
-                ... = 1 : by simp [hA, matrix.one_apply, finset.filter_eq], },
-  have hbi : b.points i = finset.univ.affine_combination p (A i),
-  { apply b.ext_elem,
-    intros j,
-    rw [b.coord_apply, finset.univ.map_affine_combination _ _ hAi,
-      finset.univ.affine_combination_eq_linear_combination _ _ hAi],
-    change _ = (A ⬝ b.to_matrix p) i j,
-    simp_rw [hA, matrix.one_apply, @eq_comm _ i j] },
-  rw hbi,
-  exact affine_combination_mem_affine_span hAi p,
-end
-
-/-- A change of basis formula for barycentric coordinates.
-
-See also `affine_basis.to_matrix_inv_mul_affine_basis_to_matrix`. -/
-@[simp] lemma to_matrix_vec_mul_coords (x : P) :
-  (b.to_matrix b₂.points).vec_mul (b₂.coords x) = b.coords x :=
-begin
-  ext j,
-  change _ = b.coord j x,
-  conv_rhs { rw ← b₂.affine_combination_coord_eq_self x, },
-  rw finset.map_affine_combination _ _ _ (b₂.sum_coord_apply_eq_one x),
-  simp [matrix.vec_mul, matrix.dot_product, to_matrix_apply, coords],
-end
-
-variables [decidable_eq ι]
-
-lemma to_matrix_mul_to_matrix :
-  (b.to_matrix b₂.points) ⬝ (b₂.to_matrix b.points) = 1 :=
-begin
-  ext l m,
-  change (b₂.to_matrix b.points).vec_mul (b.coords (b₂.points l)) m = _,
-  rw [to_matrix_vec_mul_coords, coords_apply, ← to_matrix_apply, to_matrix_self],
-end
-
-lemma is_unit_to_matrix :
-  is_unit (b.to_matrix b₂.points) :=
-⟨{ val     := b.to_matrix b₂.points,
-   inv     := b₂.to_matrix b.points,
-   val_inv := b.to_matrix_mul_to_matrix b₂,
-   inv_val := b₂.to_matrix_mul_to_matrix b, }, rfl⟩
-
-lemma is_unit_to_matrix_iff [nontrivial k] (p : ι → P) :
-  is_unit (b.to_matrix p) ↔ affine_independent k p ∧ affine_span k (range p) = ⊤ :=
-begin
-  split,
-  { rintros ⟨⟨B, A, hA, hA'⟩, (rfl : B = b.to_matrix p)⟩,
-    rw matrix.mul_eq_mul at hA hA',
-    exact ⟨b.affine_independent_of_to_matrix_right_inv p hA,
-           b.affine_span_eq_top_of_to_matrix_left_inv p hA'⟩, },
-  { rintros ⟨h_tot, h_ind⟩,
-    let b' : affine_basis ι k P := ⟨p, h_tot, h_ind⟩,
-    change is_unit (b.to_matrix b'.points),
-    exact b.is_unit_to_matrix b', },
-end
-
 end ring
 
-section comm_ring
-
-variables [comm_ring k] [module k V] [decidable_eq ι] [fintype ι]
-variables (b b₂ : affine_basis ι k P)
-
-/-- A change of basis formula for barycentric coordinates.
-
-See also `affine_basis.to_matrix_vec_mul_coords`. -/
-@[simp] lemma to_matrix_inv_vec_mul_to_matrix (x : P) :
-  (b.to_matrix b₂.points)⁻¹.vec_mul (b.coords x) = b₂.coords x :=
-begin
-  have hu := b.is_unit_to_matrix b₂,
-  rw matrix.is_unit_iff_is_unit_det at hu,
-  rw [← b.to_matrix_vec_mul_coords b₂, matrix.vec_mul_vec_mul, matrix.mul_nonsing_inv _ hu,
-    matrix.vec_mul_one],
-end
-
-/-- If we fix a background affine basis `b`, then for any other basis `b₂`, we can characterise
-the barycentric coordinates provided by `b₂` in terms of determinants relative to `b`. -/
-lemma det_smul_coords_eq_cramer_coords (x : P) :
-  (b.to_matrix b₂.points).det • b₂.coords x = (b.to_matrix b₂.points)ᵀ.cramer (b.coords x) :=
-begin
-  have hu := b.is_unit_to_matrix b₂,
-  rw matrix.is_unit_iff_is_unit_det at hu,
-  rw [← b.to_matrix_inv_vec_mul_to_matrix, matrix.det_smul_inv_vec_mul_eq_cramer_transpose _ _ hu],
-end
-
-end comm_ring
-
 section division_ring
 
 variables [division_ring k] [module k V]
 include V
 
-variables (k V P)
+@[simp] lemma coord_apply_centroid [char_zero k] (b : affine_basis ι k P) {s : finset ι} {i : ι}
+  (hi : i ∈ s) :
+  b.coord i (s.centroid k b) = (s.card : k) ⁻¹ :=
+by rw [finset.centroid, b.coord_apply_combination_of_mem hi
+  (s.sum_centroid_weights_eq_one_of_nonempty _ ⟨i, hi⟩), finset.centroid_weights]
 
-lemma exists_affine_basis : ∃ (s : set P), nonempty (affine_basis ↥s k P) :=
+lemma exists_affine_subbasis {t : set P} (ht : affine_span k t = ⊤) :
+  ∃ (s ⊆ t) (b : affine_basis ↥s k P), ⇑b = coe :=
 begin
-  obtain ⟨s, -, h_tot, h_ind⟩ := exists_affine_independent k V (set.univ : set P),
-  refine ⟨s, ⟨⟨(coe : s → P), h_ind, _⟩⟩⟩,
-  rw [subtype.range_coe, h_tot, affine_subspace.span_univ],
+  obtain ⟨s, hst, h_tot, h_ind⟩ := exists_affine_independent k V t,
+  refine ⟨s, hst, ⟨coe, h_ind, _⟩, rfl⟩,
+  rw [subtype.range_coe, h_tot, ht]
 end
 
-variables {k V P}
+variables (k V P)
 
-lemma exists_affine_basis_of_finite_dimensional {ι : Type*} [fintype ι] [finite_dimensional k V]
-  (h : fintype.card ι = finite_dimensional.finrank k V + 1) :
-  nonempty (affine_basis ι k P) :=
-begin
-  obtain ⟨s, ⟨⟨incl, h_ind, h_tot⟩⟩⟩ := affine_basis.exists_affine_basis k V P,
-  haveI : fintype s := fintype_of_fin_dim_affine_independent k h_ind,
-  have hs : fintype.card ι = fintype.card s,
-  { rw h, exact (h_ind.affine_span_eq_top_iff_card_eq_finrank_add_one.mp h_tot).symm, },
-  rw ← affine_independent_equiv (fintype.equiv_of_card_eq hs) at h_ind,
-  refine ⟨⟨_, h_ind, _⟩⟩,
-  rw range_comp,
-  simp [h_tot],
-end
+lemma exists_affine_basis : ∃ (s : set P) (b : affine_basis ↥s k P), ⇑b = coe :=
+let ⟨s, _, hs⟩ := exists_affine_subbasis (affine_subspace.span_univ k V P) in ⟨s, hs⟩
 
 end division_ring
 
diff --git a/src/linear_algebra/affine_space/combination.lean b/src/linear_algebra/affine_space/combination.lean
index 3035bb01e3519..119e009c1ea41 100644
--- a/src/linear_algebra/affine_space/combination.lean
+++ b/src/linear_algebra/affine_space/combination.lean
@@ -5,6 +5,8 @@ Authors: Joseph Myers
 -/
 import algebra.invertible
 import algebra.indicator_function
+import algebra.module.big_operators
+import data.fintype.big_operators
 import linear_algebra.affine_space.affine_map
 import linear_algebra.affine_space.affine_subspace
 import linear_algebra.finsupp
@@ -13,6 +15,9 @@ import tactic.fin_cases
 /-!
 # Affine combinations of points
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines affine combinations of points.
 
 ## Main definitions
@@ -40,7 +45,7 @@ These definitions are for sums over a `finset`; versions for a
 -/
 
 noncomputable theory
-open_locale big_operators classical affine
+open_locale big_operators affine
 
 namespace finset
 
@@ -72,6 +77,17 @@ by simp [weighted_vsub_of_point, linear_map.sum_apply]
   s.weighted_vsub_of_point (λ _, p) b w = (∑ i in s, w i) • (p -ᵥ b) :=
 by rw [weighted_vsub_of_point_apply, sum_smul]
 
+/-- `weighted_vsub_of_point` gives equal results for two families of weights and two families of
+points that are equal on `s`. -/
+lemma weighted_vsub_of_point_congr {w₁ w₂ : ι → k} (hw : ∀ i ∈ s, w₁ i = w₂ i) {p₁ p₂ : ι → P}
+  (hp : ∀ i ∈ s, p₁ i = p₂ i) (b : P) :
+  s.weighted_vsub_of_point p₁ b w₁ = s.weighted_vsub_of_point p₂ b w₂ :=
+begin
+  simp_rw weighted_vsub_of_point_apply,
+  convert sum_congr rfl (λ i hi, _),
+  rw [hw i hi, hp i hi]
+end
+
 /-- Given a family of points, if we use a member of the family as a base point, the
 `weighted_vsub_of_point` does not depend on the value of the weights at this point. -/
 lemma weighted_vsub_of_point_eq_of_weights_eq
@@ -122,7 +138,7 @@ end
 
 /-- The weighted sum is unaffected by removing the base point, if
 present, from the set of points. -/
-@[simp] lemma weighted_vsub_of_point_erase (w : ι → k) (p : ι → P) (i : ι) :
+@[simp] lemma weighted_vsub_of_point_erase [decidable_eq ι] (w : ι → k) (p : ι → P) (i : ι) :
   (s.erase i).weighted_vsub_of_point p (p i) w = s.weighted_vsub_of_point p (p i) w :=
 begin
   rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply],
@@ -179,6 +195,44 @@ lemma sum_smul_const_vsub_eq_sub_weighted_vsub_of_point (w : ι → k) (p₂ : 
   ∑ i in s, w i • (p₁ -ᵥ p₂ i) = (∑ i in s, w i) • (p₁ -ᵥ b) - s.weighted_vsub_of_point p₂ b w :=
 by rw [sum_smul_vsub_eq_weighted_vsub_of_point_sub, weighted_vsub_of_point_apply_const]
 
+/-- A weighted sum may be split into such sums over two subsets. -/
+lemma weighted_vsub_of_point_sdiff [decidable_eq ι] {s₂ : finset ι} (h : s₂ ⊆ s) (w : ι → k)
+  (p : ι → P) (b : P) : (s \ s₂).weighted_vsub_of_point p b w + s₂.weighted_vsub_of_point p b w =
+    s.weighted_vsub_of_point p b w :=
+by simp_rw [weighted_vsub_of_point_apply, sum_sdiff h]
+
+/-- A weighted sum may be split into a subtraction of such sums over two subsets. -/
+lemma weighted_vsub_of_point_sdiff_sub [decidable_eq ι] {s₂ : finset ι} (h : s₂ ⊆ s) (w : ι → k)
+  (p : ι → P) (b : P) : (s \ s₂).weighted_vsub_of_point p b w - s₂.weighted_vsub_of_point p b (-w) =
+    s.weighted_vsub_of_point p b w :=
+by rw [map_neg, sub_neg_eq_add, s.weighted_vsub_of_point_sdiff h]
+
+/-- A weighted sum over `s.subtype pred` equals one over `s.filter pred`. -/
+lemma weighted_vsub_of_point_subtype_eq_filter (w : ι → k) (p : ι → P) (b : P)
+  (pred : ι → Prop) [decidable_pred pred] :
+  (s.subtype pred).weighted_vsub_of_point (λ i, p i) b (λ i, w i) =
+    (s.filter pred).weighted_vsub_of_point p b w :=
+by rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply, ←sum_subtype_eq_sum_filter]
+
+/-- A weighted sum over `s.filter pred` equals one over `s` if all the weights at indices in `s`
+not satisfying `pred` are zero. -/
+lemma weighted_vsub_of_point_filter_of_ne (w : ι → k) (p : ι → P) (b : P) {pred : ι → Prop}
+  [decidable_pred pred] (h : ∀ i ∈ s, w i ≠ 0 → pred i) :
+  (s.filter pred).weighted_vsub_of_point p b w = s.weighted_vsub_of_point p b w :=
+begin
+  rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply, sum_filter_of_ne],
+  intros i hi hne,
+  refine h i hi _,
+  intro hw,
+  simpa [hw] using hne,
+end
+
+/-- A constant multiplier of the weights in `weighted_vsub_of_point` may be moved outside the
+sum. -/
+lemma weighted_vsub_of_point_const_smul (w : ι → k) (p : ι → P) (b : P) (c : k) :
+  s.weighted_vsub_of_point p b (c • w) = c • s.weighted_vsub_of_point p b w :=
+by simp_rw [weighted_vsub_of_point_apply, smul_sum, pi.smul_apply, smul_smul, smul_eq_mul]
+
 /-- A weighted sum of the results of subtracting a default base point
 from the given points, as a linear map on the weights.  This is
 intended to be used when the sum of the weights is 0; that condition
@@ -213,6 +267,12 @@ by rw [weighted_vsub, weighted_vsub_of_point_apply_const, h, zero_smul]
   (∅ : finset ι).weighted_vsub p w = (0:V) :=
 by simp [weighted_vsub_apply]
 
+/-- `weighted_vsub` gives equal results for two families of weights and two families of points
+that are equal on `s`. -/
+lemma weighted_vsub_congr {w₁ w₂ : ι → k} (hw : ∀ i ∈ s, w₁ i = w₂ i) {p₁ p₂ : ι → P}
+  (hp : ∀ i ∈ s, p₁ i = p₂ i) : s.weighted_vsub p₁ w₁ = s.weighted_vsub p₂ w₂ :=
+s.weighted_vsub_of_point_congr hw hp _
+
 /-- The weighted sum is unaffected by changing the weights to the
 corresponding indicator function and adding points to the set. -/
 lemma weighted_vsub_indicator_subset (w : ι → k) (p : ι → P) {s₁ s₂ : finset ι} (h : s₁ ⊆ s₂) :
@@ -246,6 +306,36 @@ lemma sum_smul_const_vsub_eq_neg_weighted_vsub (w : ι → k) (p₂ : ι → P)
   ∑ i in s, w i • (p₁ -ᵥ p₂ i) = -s.weighted_vsub p₂ w :=
 by rw [sum_smul_vsub_eq_weighted_vsub_sub, s.weighted_vsub_apply_const _ _ h, zero_sub]
 
+/-- A weighted sum may be split into such sums over two subsets. -/
+lemma weighted_vsub_sdiff [decidable_eq ι] {s₂ : finset ι} (h : s₂ ⊆ s) (w : ι → k)
+  (p : ι → P) : (s \ s₂).weighted_vsub p w + s₂.weighted_vsub p w = s.weighted_vsub p w :=
+s.weighted_vsub_of_point_sdiff h _ _ _
+
+/-- A weighted sum may be split into a subtraction of such sums over two subsets. -/
+lemma weighted_vsub_sdiff_sub [decidable_eq ι] {s₂ : finset ι} (h : s₂ ⊆ s) (w : ι → k)
+  (p : ι → P) : (s \ s₂).weighted_vsub p w - s₂.weighted_vsub p (-w) = s.weighted_vsub p w :=
+s.weighted_vsub_of_point_sdiff_sub h _ _ _
+
+/-- A weighted sum over `s.subtype pred` equals one over `s.filter pred`. -/
+lemma weighted_vsub_subtype_eq_filter (w : ι → k) (p : ι → P) (pred : ι → Prop)
+  [decidable_pred pred] :
+  (s.subtype pred).weighted_vsub (λ i, p i) (λ i, w i) = (s.filter pred).weighted_vsub p w :=
+s.weighted_vsub_of_point_subtype_eq_filter _ _ _ _
+
+/-- A weighted sum over `s.filter pred` equals one over `s` if all the weights at indices in `s`
+not satisfying `pred` are zero. -/
+lemma weighted_vsub_filter_of_ne (w : ι → k) (p : ι → P) {pred : ι → Prop}
+  [decidable_pred pred] (h : ∀ i ∈ s, w i ≠ 0 → pred i) :
+  (s.filter pred).weighted_vsub p w = s.weighted_vsub p w :=
+s.weighted_vsub_of_point_filter_of_ne _ _ _ h
+
+/-- A constant multiplier of the weights in `weighted_vsub_of` may be moved outside the sum. -/
+lemma weighted_vsub_const_smul (w : ι → k) (p : ι → P) (c : k) :
+  s.weighted_vsub p (c • w) = c • s.weighted_vsub p w :=
+s.weighted_vsub_of_point_const_smul _ _ _ _
+
+variables (k)
+
 /-- A weighted sum of the results of subtracting a default base point
 from the given points, added to that base point, as an affine map on
 the weights.  This is intended to be used when the sum of the weights
@@ -261,9 +351,11 @@ def affine_combination (p : ι → P) : (ι → k) →ᵃ[k] P :=
 /-- The linear map corresponding to `affine_combination` is
 `weighted_vsub`. -/
 @[simp] lemma affine_combination_linear (p : ι → P) :
-  (s.affine_combination p : (ι → k) →ᵃ[k] P).linear = s.weighted_vsub p :=
+  (s.affine_combination k p).linear = s.weighted_vsub p :=
 rfl
 
+variables {k}
+
 /-- Applying `affine_combination` with given weights.  This is for the
 case where a result involving a default base point is OK (for example,
 when that base point will cancel out later); a more typical use case
@@ -272,35 +364,41 @@ point with
 `affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one` and
 then using `weighted_vsub_of_point_apply`. -/
 lemma affine_combination_apply (w : ι → k) (p : ι → P) :
-  s.affine_combination p w =
+  s.affine_combination k p w =
     s.weighted_vsub_of_point p (classical.choice S.nonempty) w +ᵥ (classical.choice S.nonempty) :=
 rfl
 
 /-- The value of `affine_combination`, where the given points are equal. -/
 @[simp] lemma affine_combination_apply_const (w : ι → k) (p : P) (h : ∑ i in s, w i = 1) :
-  s.affine_combination (λ _, p) w = p :=
+  s.affine_combination k (λ _, p) w = p :=
 by rw [affine_combination_apply, s.weighted_vsub_of_point_apply_const, h, one_smul, vsub_vadd]
 
+/-- `affine_combination` gives equal results for two families of weights and two families of
+points that are equal on `s`. -/
+lemma affine_combination_congr {w₁ w₂ : ι → k} (hw : ∀ i ∈ s, w₁ i = w₂ i) {p₁ p₂ : ι → P}
+  (hp : ∀ i ∈ s, p₁ i = p₂ i) : s.affine_combination k p₁ w₁ = s.affine_combination k p₂ w₂ :=
+by simp_rw [affine_combination_apply, s.weighted_vsub_of_point_congr hw hp]
+
 /-- `affine_combination` gives the sum with any base point, when the
 sum of the weights is 1. -/
 lemma affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one (w : ι → k) (p : ι → P)
     (h : ∑ i in s, w i = 1) (b : P) :
-  s.affine_combination p w = s.weighted_vsub_of_point p b w +ᵥ b :=
+  s.affine_combination k p w = s.weighted_vsub_of_point p b w +ᵥ b :=
 s.weighted_vsub_of_point_vadd_eq_of_sum_eq_one w p h _ _
 
 /-- Adding a `weighted_vsub` to an `affine_combination`. -/
 lemma weighted_vsub_vadd_affine_combination (w₁ w₂ : ι → k) (p : ι → P) :
-  s.weighted_vsub p w₁ +ᵥ s.affine_combination p w₂ = s.affine_combination p (w₁ + w₂) :=
+  s.weighted_vsub p w₁ +ᵥ s.affine_combination k p w₂ = s.affine_combination k p (w₁ + w₂) :=
 by rw [←vadd_eq_add, affine_map.map_vadd, affine_combination_linear]
 
 /-- Subtracting two `affine_combination`s. -/
 lemma affine_combination_vsub (w₁ w₂ : ι → k) (p : ι → P) :
-  s.affine_combination p w₁ -ᵥ s.affine_combination p w₂ = s.weighted_vsub p (w₁ - w₂) :=
+  s.affine_combination k p w₁ -ᵥ s.affine_combination k p w₂ = s.weighted_vsub p (w₁ - w₂) :=
 by rw [←affine_map.linear_map_vsub, affine_combination_linear, vsub_eq_sub]
 
-lemma attach_affine_combination_of_injective
+lemma attach_affine_combination_of_injective [decidable_eq P]
   (s : finset P) (w : P → k) (f : s → P) (hf : function.injective f) :
-  s.attach.affine_combination f (w ∘ f) = (image f univ).affine_combination id w :=
+  s.attach.affine_combination k f (w ∘ f) = (image f univ).affine_combination k id w :=
 begin
   simp only [affine_combination, weighted_vsub_of_point_apply, id.def, vadd_right_cancel_iff,
     function.comp_app, affine_map.coe_mk],
@@ -313,17 +411,24 @@ begin
 end
 
 lemma attach_affine_combination_coe (s : finset P) (w : P → k) :
-  s.attach.affine_combination (coe : s → P) (w ∘ coe) = s.affine_combination id w :=
-by rw [attach_affine_combination_of_injective s w (coe : s → P) subtype.coe_injective,
+  s.attach.affine_combination k (coe : s → P) (w ∘ coe) = s.affine_combination k id w :=
+by classical; rw [attach_affine_combination_of_injective s w (coe : s → P) subtype.coe_injective,
   univ_eq_attach, attach_image_coe]
 
 omit S
 
+/-- Viewing a module as an affine space modelled on itself, a `weighted_vsub` is just a linear
+combination. -/
+@[simp] lemma weighted_vsub_eq_linear_combination
+  {ι} (s : finset ι) {w : ι → k} {p : ι → V} (hw : s.sum w = 0) :
+  s.weighted_vsub p w = ∑ i in s, w i • p i :=
+by simp [s.weighted_vsub_apply, vsub_eq_sub, smul_sub, ← finset.sum_smul, hw]
+
 /-- Viewing a module as an affine space modelled on itself, affine combinations are just linear
 combinations. -/
 @[simp] lemma affine_combination_eq_linear_combination (s : finset ι) (p : ι → V) (w : ι → k)
   (hw : ∑ i in s, w i = 1) :
-  s.affine_combination p w = ∑ i in s, w i • p i :=
+  s.affine_combination k p w = ∑ i in s, w i • p i :=
 by simp [s.affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w p hw 0]
 
 include S
@@ -332,7 +437,7 @@ include S
 and has weight 1 and the other points in the set have weight 0. -/
 @[simp] lemma affine_combination_of_eq_one_of_eq_zero (w : ι → k) (p : ι → P) {i : ι}
     (his : i ∈ s) (hwi : w i = 1) (hw0 : ∀ i2 ∈ s, i2 ≠ i → w i2 = 0) :
-  s.affine_combination p w = p i :=
+  s.affine_combination k p w = p i :=
 begin
   have h1 : ∑ i in s, w i = 1 := hwi ▸ sum_eq_single i hw0 (λ h, false.elim (h his)),
   rw [s.affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w p h1 (p i),
@@ -349,7 +454,7 @@ end
 corresponding indicator function and adding points to the set. -/
 lemma affine_combination_indicator_subset (w : ι → k) (p : ι → P) {s₁ s₂ : finset ι}
     (h : s₁ ⊆ s₂) :
-  s₁.affine_combination p w = s₂.affine_combination p (set.indicator ↑s₁ w) :=
+  s₁.affine_combination k p w = s₂.affine_combination k p (set.indicator ↑s₁ w) :=
 by rw [affine_combination_apply, affine_combination_apply,
        weighted_vsub_of_point_indicator_subset _ _ _ h]
 
@@ -357,13 +462,13 @@ by rw [affine_combination_apply, affine_combination_apply,
 affine combination with the same points and weights over the original
 `finset`. -/
 lemma affine_combination_map (e : ι₂ ↪ ι) (w : ι → k) (p : ι → P) :
-  (s₂.map e).affine_combination p w = s₂.affine_combination (p ∘ e) (w ∘ e) :=
+  (s₂.map e).affine_combination k p w = s₂.affine_combination k (p ∘ e) (w ∘ e) :=
 by simp_rw [affine_combination_apply, weighted_vsub_of_point_map]
 
 /-- A weighted sum of pairwise subtractions, expressed as a subtraction of two `affine_combination`
 expressions. -/
 lemma sum_smul_vsub_eq_affine_combination_vsub (w : ι → k) (p₁ p₂ : ι → P) :
-  ∑ i in s, w i • (p₁ i -ᵥ p₂ i) = s.affine_combination p₁ w -ᵥ s.affine_combination p₂ w :=
+  ∑ i in s, w i • (p₁ i -ᵥ p₂ i) = s.affine_combination k p₁ w -ᵥ s.affine_combination k p₂ w :=
 begin
   simp_rw [affine_combination_apply, vadd_vsub_vadd_cancel_right],
   exact s.sum_smul_vsub_eq_weighted_vsub_of_point_sub _ _ _ _
@@ -373,16 +478,56 @@ end
 sum of the weights is 1. -/
 lemma sum_smul_vsub_const_eq_affine_combination_vsub (w : ι → k) (p₁ : ι → P) (p₂ : P)
   (h : ∑ i in s, w i = 1) :
-  ∑ i in s, w i • (p₁ i -ᵥ p₂) = s.affine_combination p₁ w -ᵥ p₂ :=
+  ∑ i in s, w i • (p₁ i -ᵥ p₂) = s.affine_combination k p₁ w -ᵥ p₂ :=
 by rw [sum_smul_vsub_eq_affine_combination_vsub, affine_combination_apply_const _ _ _ h]
 
 /-- A weighted sum of pairwise subtractions, where the point on the left is constant and the
 sum of the weights is 1. -/
 lemma sum_smul_const_vsub_eq_vsub_affine_combination (w : ι → k) (p₂ : ι → P) (p₁ : P)
   (h : ∑ i in s, w i = 1) :
-  ∑ i in s, w i • (p₁ -ᵥ p₂ i) = p₁ -ᵥ s.affine_combination p₂ w :=
+  ∑ i in s, w i • (p₁ -ᵥ p₂ i) = p₁ -ᵥ s.affine_combination k p₂ w :=
 by rw [sum_smul_vsub_eq_affine_combination_vsub, affine_combination_apply_const _ _ _ h]
 
+/-- A weighted sum may be split into a subtraction of affine combinations over two subsets. -/
+lemma affine_combination_sdiff_sub [decidable_eq ι] {s₂ : finset ι} (h : s₂ ⊆ s) (w : ι → k)
+  (p : ι → P) :
+  (s \ s₂).affine_combination k p w -ᵥ s₂.affine_combination k p (-w) = s.weighted_vsub p w :=
+begin
+  simp_rw [affine_combination_apply, vadd_vsub_vadd_cancel_right],
+  exact s.weighted_vsub_sdiff_sub h _ _
+end
+
+/-- If a weighted sum is zero and one of the weights is `-1`, the corresponding point is
+the affine combination of the other points with the given weights. -/
+lemma affine_combination_eq_of_weighted_vsub_eq_zero_of_eq_neg_one {w : ι → k} {p : ι → P}
+  (hw : s.weighted_vsub p w = (0 : V)) {i : ι} [decidable_pred (≠ i)] (his : i ∈ s)
+  (hwi : w i = -1) : (s.filter (≠ i)).affine_combination k p w = p i :=
+begin
+  classical,
+  rw [←@vsub_eq_zero_iff_eq V, ←hw,
+      ←s.affine_combination_sdiff_sub (singleton_subset_iff.2 his), sdiff_singleton_eq_erase,
+      ←filter_ne'],
+  congr,
+  refine (affine_combination_of_eq_one_of_eq_zero _ _ _ (mem_singleton_self _) _ _).symm,
+  { simp [hwi] },
+  { simp }
+end
+
+/-- An affine combination over `s.subtype pred` equals one over `s.filter pred`. -/
+lemma affine_combination_subtype_eq_filter (w : ι → k) (p : ι → P) (pred : ι → Prop)
+  [decidable_pred pred] :
+  (s.subtype pred).affine_combination k (λ i, p i) (λ i, w i) =
+  (s.filter pred).affine_combination k p w :=
+by rw [affine_combination_apply, affine_combination_apply, weighted_vsub_of_point_subtype_eq_filter]
+
+/-- An affine combination over `s.filter pred` equals one over `s` if all the weights at indices
+in `s` not satisfying `pred` are zero. -/
+lemma affine_combination_filter_of_ne (w : ι → k) (p : ι → P) {pred : ι → Prop}
+  [decidable_pred pred] (h : ∀ i ∈ s, w i ≠ 0 → pred i) :
+  (s.filter pred).affine_combination k p w = s.affine_combination k p w :=
+by rw [affine_combination_apply, affine_combination_apply,
+       s.weighted_vsub_of_point_filter_of_ne _ _ _ h]
+
 variables {V}
 
 /-- Suppose an indexed family of points is given, along with a subset
@@ -399,6 +544,7 @@ lemma eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype {v
   ∃ (fs : finset s) (w : s → k) (hw : ∑ i in fs, w i = x),
     v = fs.weighted_vsub_of_point (λ (i : s), p i) b w :=
 begin
+  classical,
   simp_rw weighted_vsub_of_point_apply,
   split,
   { rintros ⟨fs, hfs, w, rfl, rfl⟩,
@@ -436,9 +582,9 @@ subset. -/
 lemma eq_affine_combination_subset_iff_eq_affine_combination_subtype {p0 : P} {s : set ι}
     {p : ι → P} :
   (∃ (fs : finset ι) (hfs : ↑fs ⊆ s) (w : ι → k) (hw : ∑ i in fs, w i = 1),
-    p0 = fs.affine_combination p w) ↔
+    p0 = fs.affine_combination k p w) ↔
   ∃ (fs : finset s) (w : s → k) (hw : ∑ i in fs, w i = 1),
-    p0 = fs.affine_combination (λ (i : s), p i) w :=
+    p0 = fs.affine_combination k (λ (i : s), p i) w :=
 begin
   simp_rw [affine_combination_apply, eq_vadd_iff_vsub_eq],
   exact eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype
@@ -449,7 +595,7 @@ variables {k V}
 /-- Affine maps commute with affine combinations. -/
 lemma map_affine_combination {V₂ P₂ : Type*} [add_comm_group V₂] [module k V₂] [affine_space V₂ P₂]
   (p : ι → P) (w : ι → k) (hw : s.sum w = 1) (f : P →ᵃ[k] P₂) :
-  f (s.affine_combination p w) = s.affine_combination (f ∘ p) w :=
+  f (s.affine_combination k p w) = s.affine_combination k (f ∘ p) w :=
 begin
   have b := classical.choice (infer_instance : affine_space V P).nonempty,
   have b₂ := classical.choice (infer_instance : affine_space V₂ P₂).nonempty,
@@ -460,6 +606,120 @@ begin
     linear_map.map_smulₛₗ, affine_map.linear_map_vsub, linear_map.map_sum],
 end
 
+variables (k)
+
+omit S
+
+/-- Weights for expressing a single point as an affine combination. -/
+def affine_combination_single_weights [decidable_eq ι] (i : ι) : ι → k :=
+function.update (function.const ι 0) i 1
+
+@[simp] lemma affine_combination_single_weights_apply_self [decidable_eq ι] (i : ι) :
+  affine_combination_single_weights k i i = 1 :=
+by simp [affine_combination_single_weights]
+
+@[simp] lemma affine_combination_single_weights_apply_of_ne [decidable_eq ι] {i j : ι} (h : j ≠ i) :
+  affine_combination_single_weights k i j = 0 :=
+by simp [affine_combination_single_weights, h]
+
+@[simp] lemma sum_affine_combination_single_weights [decidable_eq ι] {i : ι} (h : i ∈ s) :
+  ∑ j in s, affine_combination_single_weights k i j = 1 :=
+begin
+  rw ←affine_combination_single_weights_apply_self k i,
+  exact sum_eq_single_of_mem i h (λ j _ hj, affine_combination_single_weights_apply_of_ne k hj)
+end
+
+/-- Weights for expressing the subtraction of two points as a `weighted_vsub`. -/
+def weighted_vsub_vsub_weights [decidable_eq ι] (i j : ι) : ι → k :=
+affine_combination_single_weights k i - affine_combination_single_weights k j
+
+@[simp] lemma weighted_vsub_vsub_weights_self [decidable_eq ι] (i : ι) :
+  weighted_vsub_vsub_weights k i i = 0 :=
+by simp [weighted_vsub_vsub_weights]
+
+@[simp] lemma weighted_vsub_vsub_weights_apply_left [decidable_eq ι] {i j : ι} (h : i ≠ j) :
+  weighted_vsub_vsub_weights k i j i = 1 :=
+by simp [weighted_vsub_vsub_weights, h]
+
+@[simp] lemma weighted_vsub_vsub_weights_apply_right [decidable_eq ι] {i j : ι} (h : i ≠ j) :
+  weighted_vsub_vsub_weights k i j j = -1 :=
+by simp [weighted_vsub_vsub_weights, h.symm]
+
+@[simp] lemma weighted_vsub_vsub_weights_apply_of_ne [decidable_eq ι] {i j t : ι} (hi : t ≠ i)
+  (hj : t ≠ j) : weighted_vsub_vsub_weights k i j t = 0 :=
+by simp [weighted_vsub_vsub_weights, hi, hj]
+
+@[simp] lemma sum_weighted_vsub_vsub_weights [decidable_eq ι] {i j : ι} (hi : i ∈ s) (hj : j ∈ s) :
+  ∑ t in s, weighted_vsub_vsub_weights k i j t = 0 :=
+begin
+  simp_rw [weighted_vsub_vsub_weights, pi.sub_apply, sum_sub_distrib],
+  simp [hi, hj]
+end
+
+variables {k}
+
+/-- Weights for expressing `line_map` as an affine combination. -/
+def affine_combination_line_map_weights [decidable_eq ι] (i j : ι) (c : k) : ι → k :=
+c • weighted_vsub_vsub_weights k j i + affine_combination_single_weights k i
+
+@[simp] lemma affine_combination_line_map_weights_self [decidable_eq ι] (i : ι) (c : k) :
+  affine_combination_line_map_weights i i c = affine_combination_single_weights k i :=
+by simp [affine_combination_line_map_weights]
+
+@[simp] lemma affine_combination_line_map_weights_apply_left [decidable_eq ι] {i j : ι}
+  (h : i ≠ j) (c : k) : affine_combination_line_map_weights i j c i = 1 - c :=
+by simp [affine_combination_line_map_weights, h.symm, sub_eq_neg_add]
+
+@[simp] lemma affine_combination_line_map_weights_apply_right [decidable_eq ι] {i j : ι}
+  (h : i ≠ j) (c : k) : affine_combination_line_map_weights i j c j = c :=
+by simp [affine_combination_line_map_weights, h.symm]
+
+@[simp] lemma affine_combination_line_map_weights_apply_of_ne [decidable_eq ι] {i j t : ι}
+  (hi : t ≠ i) (hj : t ≠ j) (c : k) : affine_combination_line_map_weights i j c t = 0 :=
+by simp [affine_combination_line_map_weights, hi, hj]
+
+@[simp] lemma sum_affine_combination_line_map_weights [decidable_eq ι] {i j : ι} (hi : i ∈ s)
+  (hj : j ∈ s) (c : k) : ∑ t in s, affine_combination_line_map_weights i j c t = 1 :=
+begin
+  simp_rw [affine_combination_line_map_weights, pi.add_apply, sum_add_distrib],
+  simp [hi, hj, ←mul_sum]
+end
+
+include S
+
+variables (k)
+
+/-- An affine combination with `affine_combination_single_weights` gives the specified point. -/
+@[simp] lemma affine_combination_affine_combination_single_weights [decidable_eq ι] (p : ι → P)
+  {i : ι} (hi : i ∈ s) : s.affine_combination k p (affine_combination_single_weights k i) = p i :=
+begin
+  refine s.affine_combination_of_eq_one_of_eq_zero _ _ hi (by simp) _,
+  rintro j - hj,
+  simp [hj]
+end
+
+/-- A weighted subtraction with `weighted_vsub_vsub_weights` gives the result of subtracting the
+specified points. -/
+@[simp] lemma weighted_vsub_weighted_vsub_vsub_weights [decidable_eq ι] (p : ι → P) {i j : ι}
+  (hi : i ∈ s) (hj : j ∈ s) : s.weighted_vsub p (weighted_vsub_vsub_weights k i j) = p i -ᵥ p j :=
+begin
+  rw [weighted_vsub_vsub_weights, ←affine_combination_vsub,
+      s.affine_combination_affine_combination_single_weights k p hi,
+      s.affine_combination_affine_combination_single_weights k p hj]
+end
+
+variables {k}
+
+/-- An affine combination with `affine_combination_line_map_weights` gives the result of
+`line_map`. -/
+@[simp] lemma affine_combination_affine_combination_line_map_weights [decidable_eq ι] (p : ι → P)
+  {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (c : k) :
+  s.affine_combination k p (affine_combination_line_map_weights i j c) =
+    affine_map.line_map (p i) (p j) c :=
+by rw [affine_combination_line_map_weights, ←weighted_vsub_vadd_affine_combination,
+       weighted_vsub_const_smul, s.affine_combination_affine_combination_single_weights k p hi,
+       s.weighted_vsub_weighted_vsub_vsub_weights k p hj hi, affine_map.line_map_apply]
+
 end finset
 
 namespace finset
@@ -513,11 +773,11 @@ include V
 is intended to be used in the case where the number of points,
 converted to `k`, is not zero. -/
 def centroid (p : ι → P) : P :=
-s.affine_combination p (s.centroid_weights k)
+s.affine_combination k p (s.centroid_weights k)
 
 /-- The definition of the centroid. -/
 lemma centroid_def (p : ι → P) :
-  s.centroid k p = s.affine_combination p (s.centroid_weights k) :=
+  s.centroid k p = s.affine_combination k p (s.centroid_weights k) :=
 rfl
 
 lemma centroid_univ (s : finset P) :
@@ -531,7 +791,7 @@ by simp [centroid_def, affine_combination_apply]
 
 /-- The centroid of two points, expressed directly as adding a vector
 to a point. -/
-lemma centroid_insert_singleton [invertible (2 : k)] (p : ι → P) (i₁ i₂ : ι) :
+lemma centroid_pair [decidable_eq ι] [invertible (2 : k)] (p : ι → P) (i₁ i₂ : ι) :
   ({i₁, i₂} : finset ι).centroid k p = (2 ⁻¹ : k) • (p i₂ -ᵥ p i₁) +ᵥ p i₁ :=
 begin
   by_cases h : i₁ = i₂,
@@ -548,11 +808,11 @@ end
 
 /-- The centroid of two points indexed by `fin 2`, expressed directly
 as adding a vector to the first point. -/
-lemma centroid_insert_singleton_fin [invertible (2 : k)] (p : fin 2 → P) :
+lemma centroid_pair_fin [invertible (2 : k)] (p : fin 2 → P) :
   univ.centroid k p = (2 ⁻¹ : k) • (p 1 -ᵥ p 0) +ᵥ p 0 :=
 begin
   rw univ_fin2,
-  convert centroid_insert_singleton k p 0 1
+  convert centroid_pair k p 0 1
 end
 
 /-- A centroid, over the image of an embedding, equals a centroid with
@@ -612,7 +872,7 @@ include V
 
 /-- The centroid as an affine combination over a `fintype`. -/
 lemma centroid_eq_affine_combination_fintype [fintype ι] (p : ι → P) :
-  s.centroid k p = univ.affine_combination p (s.centroid_weights_indicator k) :=
+  s.centroid k p = univ.affine_combination k p (s.centroid_weights_indicator k) :=
 affine_combination_indicator_subset _ _ (subset_univ _)
 
 /-- An indexed family of points that is injective on the given
@@ -655,8 +915,8 @@ have the same centroid. -/
 lemma centroid_eq_of_inj_on_of_image_eq {p : ι → P} (hi : ∀ i j ∈ s, p i = p j → i = j)
   {p₂ : ι₂ → P} (hi₂ : ∀ i j ∈ s₂, p₂ i = p₂ j → i = j) (he : p '' ↑s = p₂ '' ↑s₂) :
   s.centroid k p = s₂.centroid k p₂ :=
-by rw [s.centroid_eq_centroid_image_of_inj_on k hi rfl,
-       s₂.centroid_eq_centroid_image_of_inj_on k hi₂ he]
+by classical; rw [s.centroid_eq_centroid_image_of_inj_on k hi rfl,
+                  s₂.centroid_eq_centroid_image_of_inj_on k hi₂ he]
 
 end finset
 
@@ -673,6 +933,7 @@ lemma weighted_vsub_mem_vector_span {s : finset ι} {w : ι → k}
     (h : ∑ i in s, w i = 0) (p : ι → P) :
     s.weighted_vsub p w ∈ vector_span k (set.range p) :=
 begin
+  classical,
   rcases is_empty_or_nonempty ι with hι|⟨⟨i0⟩⟩,
   { resetI, simp [finset.eq_empty_of_is_empty s] },
   { rw [vector_span_range_eq_span_range_vsub_right k p i0, ←set.image_univ,
@@ -694,22 +955,23 @@ end
 nontrivial. -/
 lemma affine_combination_mem_affine_span [nontrivial k] {s : finset ι} {w : ι → k}
     (h : ∑ i in s, w i = 1) (p : ι → P) :
-  s.affine_combination p w ∈ affine_span k (set.range p) :=
+  s.affine_combination k p w ∈ affine_span k (set.range p) :=
 begin
+  classical,
   have hnz : ∑ i in s, w i ≠ 0 := h.symm ▸ one_ne_zero,
   have hn : s.nonempty := finset.nonempty_of_sum_ne_zero hnz,
   cases hn with i1 hi1,
   let w1 : ι → k := function.update (function.const ι 0) i1 1,
   have hw1 : ∑ i in s, w1 i = 1,
   { rw [finset.sum_update_of_mem hi1, finset.sum_const_zero, add_zero] },
-  have hw1s : s.affine_combination p w1 = p i1 :=
+  have hw1s : s.affine_combination k p w1 = p i1 :=
     s.affine_combination_of_eq_one_of_eq_zero w1 p hi1 (function.update_same _ _ _)
                                               (λ _ _ hne, function.update_noteq hne _ _),
-  have hv : s.affine_combination p w -ᵥ p i1 ∈ (affine_span k (set.range p)).direction,
+  have hv : s.affine_combination k p w -ᵥ p i1 ∈ (affine_span k (set.range p)).direction,
   { rw [direction_affine_span, ←hw1s, finset.affine_combination_vsub],
     apply weighted_vsub_mem_vector_span,
     simp [pi.sub_apply, h, hw1] },
-  rw ←vsub_vadd (s.affine_combination p w) (p i1),
+  rw ←vsub_vadd (s.affine_combination k p w) (p i1),
   exact affine_subspace.vadd_mem_of_mem_direction hv (mem_affine_span k (set.mem_range_self _))
 end
 
@@ -721,6 +983,7 @@ lemma mem_vector_span_iff_eq_weighted_vsub {v : V} {p : ι → P} :
   v ∈ vector_span k (set.range p) ↔
     ∃ (s : finset ι) (w : ι → k) (h : ∑ i in s, w i = 0), v = s.weighted_vsub p w :=
 begin
+  classical,
   split,
   { rcases is_empty_or_nonempty ι with hι|⟨⟨i0⟩⟩, swap,
     { rw [vector_span_range_eq_span_range_vsub_right k p i0, ←set.image_univ,
@@ -763,8 +1026,9 @@ variables {k}
 `eq_affine_combination_of_mem_affine_span_of_fintype`. -/
 lemma eq_affine_combination_of_mem_affine_span {p1 : P} {p : ι → P}
     (h : p1 ∈ affine_span k (set.range p)) :
-  ∃ (s : finset ι) (w : ι → k) (hw : ∑ i in s, w i = 1), p1 = s.affine_combination p w :=
+  ∃ (s : finset ι) (w : ι → k) (hw : ∑ i in s, w i = 1), p1 = s.affine_combination k p w :=
 begin
+  classical,
   have hn : ((affine_span k (set.range p)) : set P).nonempty := ⟨p1, h⟩,
   rw [affine_span_nonempty, set.range_nonempty_iff_nonempty] at hn,
   cases hn with i0,
@@ -783,7 +1047,7 @@ begin
   let w0 : ι → k := function.update (function.const ι 0) i0 1,
   have hw0 : ∑ i in s', w0 i = 1,
   { rw [finset.sum_update_of_mem (finset.mem_insert_self _ _), finset.sum_const_zero, add_zero] },
-  have hw0s : s'.affine_combination p w0 = p i0 :=
+  have hw0s : s'.affine_combination k p w0 = p i0 :=
     s'.affine_combination_of_eq_one_of_eq_zero w0 p
                                                (finset.mem_insert_self _ _)
                                                (function.update_same _ _ _)
@@ -796,8 +1060,9 @@ end
 
 lemma eq_affine_combination_of_mem_affine_span_of_fintype [fintype ι] {p1 : P} {p : ι → P}
   (h : p1 ∈ affine_span k (set.range p)) :
-  ∃ (w : ι → k) (hw : ∑ i, w i = 1), p1 = finset.univ.affine_combination p w :=
+  ∃ (w : ι → k) (hw : ∑ i, w i = 1), p1 = finset.univ.affine_combination k p w :=
 begin
+  classical,
   obtain ⟨s, w, hw, rfl⟩ := eq_affine_combination_of_mem_affine_span h,
   refine ⟨(s : set ι).indicator w, _, finset.affine_combination_indicator_subset w p s.subset_univ⟩,
   simp only [finset.mem_coe, set.indicator_apply, ← hw],
@@ -811,7 +1076,7 @@ if it is an `affine_combination` with sum of weights 1, provided the
 underlying ring is nontrivial. -/
 lemma mem_affine_span_iff_eq_affine_combination [nontrivial k] {p1 : P} {p : ι → P} :
   p1 ∈ affine_span k (set.range p) ↔
-    ∃ (s : finset ι) (w : ι → k) (hw : ∑ i in s, w i = 1), p1 = s.affine_combination p w :=
+    ∃ (s : finset ι) (w : ι → k) (hw : ∑ i in s, w i = 1), p1 = s.affine_combination k p w :=
 begin
   split,
   { exact eq_affine_combination_of_mem_affine_span },
diff --git a/src/linear_algebra/affine_space/finite_dimensional.lean b/src/linear_algebra/affine_space/finite_dimensional.lean
index f782f009cb68a..07ff73f8731ca 100644
--- a/src/linear_algebra/affine_space/finite_dimensional.lean
+++ b/src/linear_algebra/affine_space/finite_dimensional.lean
@@ -3,12 +3,15 @@ Copyright (c) 2020 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers
 -/
-import linear_algebra.affine_space.independent
+import linear_algebra.affine_space.basis
 import linear_algebra.finite_dimensional
 
 /-!
 # Finite-dimensional subspaces of affine spaces.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides a few results relating to finite-dimensional
 subspaces of affine spaces.
 
@@ -20,7 +23,7 @@ subspaces of affine spaces.
 -/
 
 noncomputable theory
-open_locale big_operators classical affine
+open_locale big_operators affine
 
 section affine_space'
 
@@ -39,15 +42,15 @@ span_of_finite k $ h.vsub h
 
 /-- The `vector_span` of a family indexed by a `fintype` is
 finite-dimensional. -/
-instance finite_dimensional_vector_span_of_fintype [fintype ι] (p : ι → P) :
+instance finite_dimensional_vector_span_range [_root_.finite ι] (p : ι → P) :
   finite_dimensional k (vector_span k (set.range p)) :=
 finite_dimensional_vector_span_of_finite k (set.finite_range _)
 
 /-- The `vector_span` of a subset of a family indexed by a `fintype`
 is finite-dimensional. -/
-instance finite_dimensional_vector_span_image_of_fintype [fintype ι] (p : ι → P)
+instance finite_dimensional_vector_span_image_of_finite [_root_.finite ι] (p : ι → P)
   (s : set ι) : finite_dimensional k (vector_span k (p '' s)) :=
-finite_dimensional_vector_span_of_finite k ((set.finite.of_fintype _).image _)
+finite_dimensional_vector_span_of_finite k (set.to_finite _)
 
 /-- The direction of the affine span of a finite set is
 finite-dimensional. -/
@@ -57,32 +60,33 @@ lemma finite_dimensional_direction_affine_span_of_finite {s : set P} (h : set.fi
 
 /-- The direction of the affine span of a family indexed by a
 `fintype` is finite-dimensional. -/
-instance finite_dimensional_direction_affine_span_of_fintype [fintype ι] (p : ι → P) :
+instance finite_dimensional_direction_affine_span_range [_root_.finite ι] (p : ι → P) :
   finite_dimensional k (affine_span k (set.range p)).direction :=
 finite_dimensional_direction_affine_span_of_finite k (set.finite_range _)
 
 /-- The direction of the affine span of a subset of a family indexed
 by a `fintype` is finite-dimensional. -/
-instance finite_dimensional_direction_affine_span_image_of_fintype [fintype ι] (p : ι → P)
+instance finite_dimensional_direction_affine_span_image_of_finite [_root_.finite ι] (p : ι → P)
   (s : set ι) : finite_dimensional k (affine_span k (p '' s)).direction :=
-finite_dimensional_direction_affine_span_of_finite k ((set.finite.of_fintype _).image _)
+finite_dimensional_direction_affine_span_of_finite k (set.to_finite _)
 
 /-- An affine-independent family of points in a finite-dimensional affine space is finite. -/
-noncomputable def fintype_of_fin_dim_affine_independent [finite_dimensional k V]
-  {p : ι → P} (hi : affine_independent k p) : fintype ι :=
-if hι : is_empty ι then (@fintype.of_is_empty _ hι) else
+lemma finite_of_fin_dim_affine_independent [finite_dimensional k V] {p : ι → P}
+  (hi : affine_independent k p) : _root_.finite ι :=
 begin
-  let q := (not_is_empty_iff.mp hι).some,
-  rw affine_independent_iff_linear_independent_vsub k p q at hi,
+  nontriviality ι, inhabit ι,
+  rw affine_independent_iff_linear_independent_vsub k p default at hi,
   letI : is_noetherian k V := is_noetherian.iff_fg.2 infer_instance,
-  exact fintype_of_fintype_ne _ (fintype_of_is_noetherian_linear_independent hi)
+  exact (set.finite_singleton default).finite_of_compl
+    (set.finite_coe_iff.1 hi.finite_of_is_noetherian)
 end
 
 /-- An affine-independent subset of a finite-dimensional affine space is finite. -/
-lemma finite_of_fin_dim_affine_independent [finite_dimensional k V]
-  {s : set P} (hi : affine_independent k (coe : s → P)) : s.finite :=
-⟨fintype_of_fin_dim_affine_independent k hi⟩
+lemma finite_set_of_fin_dim_affine_independent [finite_dimensional k V] {s : set ι} {f : s → P}
+  (hi : affine_independent k f) : s.finite :=
+@set.to_finite _ s (finite_of_fin_dim_affine_independent k hi)
 
+open_locale classical
 variables {k}
 
 /-- The `vector_span` of a finite subset of an affinely independent
@@ -226,9 +230,9 @@ lemma affine_independent.affine_span_image_finset_eq_of_le_of_card_eq_finrank_ad
   [finite_dimensional k sp.direction] (hle : affine_span k (s.image p : set P) ≤ sp)
   (hc : finset.card s = finrank k sp.direction + 1) : affine_span k (s.image p : set P) = sp :=
 begin
-  have hn : (s.image p).nonempty,
-  { rw [finset.nonempty.image_iff, ← finset.card_pos, hc], apply nat.succ_pos },
-  refine eq_of_direction_eq_of_nonempty_of_le _ ((affine_span_nonempty k _).2 hn) hle,
+  have hn : s.nonempty,
+  { rw [←finset.card_pos, hc], apply nat.succ_pos },
+  refine eq_of_direction_eq_of_nonempty_of_le _ ((hn.image _).to_set.affine_span _)hle,
   have hd := direction_le hle,
   rw direction_affine_span at ⊢ hd,
   exact hi.vector_span_image_finset_eq_of_le_of_card_eq_finrank_add_one hd hc
@@ -265,33 +269,92 @@ begin
     exact hi.affine_span_eq_of_le_of_card_eq_finrank_add_one le_top hc, },
 end
 
+lemma affine.simplex.span_eq_top [finite_dimensional k V] {n : ℕ} (T : affine.simplex k V n)
+  (hrank : finrank k V = n) :
+  affine_span k (set.range T.points) = ⊤ :=
+by rw [affine_independent.affine_span_eq_top_iff_card_eq_finrank_add_one T.independent,
+  fintype.card_fin, hrank]
+
+/-- The `vector_span` of adding a point to a finite-dimensional subspace is finite-dimensional. -/
+instance finite_dimensional_vector_span_insert (s : affine_subspace k P)
+  [finite_dimensional k s.direction] (p : P) :
+  finite_dimensional k (vector_span k (insert p (s : set P))) :=
+begin
+  rw [←direction_affine_span, ←affine_span_insert_affine_span],
+  rcases (s : set P).eq_empty_or_nonempty with hs | ⟨p₀, hp₀⟩,
+  { rw coe_eq_bot_iff at hs,
+    rw [hs, bot_coe, span_empty, bot_coe, direction_affine_span],
+    convert finite_dimensional_bot _ _;
+      simp },
+  { rw [affine_span_coe, direction_affine_span_insert hp₀],
+    apply_instance }
+end
+
+/-- The direction of the affine span of adding a point to a finite-dimensional subspace is
+finite-dimensional. -/
+instance finite_dimensional_direction_affine_span_insert (s : affine_subspace k P)
+  [finite_dimensional k s.direction] (p : P) :
+  finite_dimensional k (affine_span k (insert p (s : set P))).direction :=
+(direction_affine_span k (insert p (s : set P))).symm ▸ finite_dimensional_vector_span_insert s p
+
 variables (k)
 
+/-- The `vector_span` of adding a point to a set with a finite-dimensional `vector_span` is
+finite-dimensional. -/
+instance finite_dimensional_vector_span_insert_set (s : set P)
+  [finite_dimensional k (vector_span k s)] (p : P) :
+  finite_dimensional k (vector_span k (insert p s)) :=
+begin
+  haveI : finite_dimensional k (affine_span k s).direction :=
+    (direction_affine_span k s).symm ▸ infer_instance,
+  rw [←direction_affine_span, ←affine_span_insert_affine_span, direction_affine_span],
+  exact finite_dimensional_vector_span_insert (affine_span k s) p
+end
+
 /-- A set of points is collinear if their `vector_span` has dimension
 at most `1`. -/
 def collinear (s : set P) : Prop := module.rank k (vector_span k s) ≤ 1
 
 /-- The definition of `collinear`. -/
-lemma collinear_iff_dim_le_one (s : set P) : collinear k s ↔ module.rank k (vector_span k s) ≤ 1 :=
+lemma collinear_iff_rank_le_one (s : set P) : collinear k s ↔ module.rank k (vector_span k s) ≤ 1 :=
 iff.rfl
 
+variables {k}
+
 /-- A set of points, whose `vector_span` is finite-dimensional, is
 collinear if and only if their `vector_span` has dimension at most
 `1`. -/
-lemma collinear_iff_finrank_le_one (s : set P) [finite_dimensional k (vector_span k s)] :
+lemma collinear_iff_finrank_le_one {s : set P} [finite_dimensional k (vector_span k s)] :
   collinear k s ↔ finrank k (vector_span k s) ≤ 1 :=
 begin
-  have h := collinear_iff_dim_le_one k s,
-  rw ←finrank_eq_dim at h,
+  have h := collinear_iff_rank_le_one k s,
+  rw ←finrank_eq_rank at h,
   exact_mod_cast h
 end
 
-variables (P)
+alias collinear_iff_finrank_le_one ↔ collinear.finrank_le_one _
+
+/-- A subset of a collinear set is collinear. -/
+lemma collinear.subset {s₁ s₂ : set P} (hs : s₁ ⊆ s₂) (h : collinear k s₂) : collinear k s₁ :=
+(rank_le_of_submodule (vector_span k s₁) (vector_span k s₂) (vector_span_mono k hs)).trans h
+
+/-- The `vector_span` of collinear points is finite-dimensional. -/
+lemma collinear.finite_dimensional_vector_span {s : set P} (h : collinear k s) :
+  finite_dimensional k (vector_span k s) :=
+is_noetherian.iff_fg.1
+  (is_noetherian.iff_rank_lt_aleph_0.2 (lt_of_le_of_lt h cardinal.one_lt_aleph_0))
+
+/-- The direction of the affine span of collinear points is finite-dimensional. -/
+lemma collinear.finite_dimensional_direction_affine_span {s : set P} (h : collinear k s) :
+  finite_dimensional k (affine_span k s).direction :=
+(direction_affine_span k s).symm ▸ h.finite_dimensional_vector_span
+
+variables (k P)
 
 /-- The empty set is collinear. -/
 lemma collinear_empty : collinear k (∅ : set P) :=
 begin
-  rw [collinear_iff_dim_le_one, vector_span_empty],
+  rw [collinear_iff_rank_le_one, vector_span_empty],
   simp
 end
 
@@ -300,17 +363,19 @@ variables {P}
 /-- A single point is collinear. -/
 lemma collinear_singleton (p : P) : collinear k ({p} : set P) :=
 begin
-  rw [collinear_iff_dim_le_one, vector_span_singleton],
+  rw [collinear_iff_rank_le_one, vector_span_singleton],
   simp
 end
 
+variables {k}
+
 /-- Given a point `p₀` in a set of points, that set is collinear if and
 only if the points can all be expressed as multiples of the same
 vector, added to `p₀`. -/
 lemma collinear_iff_of_mem {s : set P} {p₀ : P} (h : p₀ ∈ s) :
   collinear k s ↔ ∃ v : V, ∀ p ∈ s, ∃ r : k, p = r • v +ᵥ p₀ :=
 begin
-  simp_rw [collinear_iff_dim_le_one, dim_submodule_le_one_iff', submodule.le_span_singleton_iff],
+  simp_rw [collinear_iff_rank_le_one, rank_submodule_le_one_iff', submodule.le_span_singleton_iff],
   split,
   { rintro ⟨v₀, hv⟩,
     use v₀,
@@ -343,7 +408,7 @@ lemma collinear_iff_exists_forall_eq_smul_vadd (s : set P) :
 begin
   rcases set.eq_empty_or_nonempty s with rfl | ⟨⟨p₁, hp₁⟩⟩,
   { simp [collinear_empty] },
-  { rw collinear_iff_of_mem k hp₁,
+  { rw collinear_iff_of_mem hp₁,
     split,
     { exact λ h, ⟨p₁, h⟩ },
     { rintros ⟨p, v, hv⟩,
@@ -355,8 +420,10 @@ begin
       simp [vadd_vadd, ←add_smul] } }
 end
 
+variables (k)
+
 /-- Two points are collinear. -/
-lemma collinear_insert_singleton (p₁ p₂ : P) : collinear k ({p₁, p₂} : set P) :=
+lemma collinear_pair (p₁ p₂ : P) : collinear k ({p₁, p₂} : set P) :=
 begin
   rw collinear_iff_exists_forall_eq_smul_vadd,
   use [p₁, p₂ -ᵥ p₁],
@@ -369,18 +436,348 @@ begin
     simp [hp] }
 end
 
+variables {k}
+
 /-- Three points are affinely independent if and only if they are not
 collinear. -/
-lemma affine_independent_iff_not_collinear (p : fin 3 → P) :
+lemma affine_independent_iff_not_collinear {p : fin 3 → P} :
   affine_independent k p ↔ ¬ collinear k (set.range p) :=
 by rw [collinear_iff_finrank_le_one,
        affine_independent_iff_not_finrank_vector_span_le k p (fintype.card_fin 3)]
 
 /-- Three points are collinear if and only if they are not affinely
 independent. -/
-lemma collinear_iff_not_affine_independent (p : fin 3 → P) :
+lemma collinear_iff_not_affine_independent {p : fin 3 → P} :
   collinear k (set.range p) ↔ ¬ affine_independent k p :=
 by rw [collinear_iff_finrank_le_one,
        finrank_vector_span_le_iff_not_affine_independent k p (fintype.card_fin 3)]
 
+/-- Three points are affinely independent if and only if they are not collinear. -/
+lemma affine_independent_iff_not_collinear_set {p₁ p₂ p₃ : P} :
+  affine_independent k ![p₁, p₂, p₃] ↔ ¬collinear k ({p₁, p₂, p₃} : set P) :=
+by simp [affine_independent_iff_not_collinear, -set.union_singleton]
+
+/-- Three points are collinear if and only if they are not affinely independent. -/
+lemma collinear_iff_not_affine_independent_set {p₁ p₂ p₃ : P} :
+  collinear k ({p₁, p₂, p₃} : set P) ↔ ¬affine_independent k ![p₁, p₂, p₃] :=
+affine_independent_iff_not_collinear_set.not_left.symm
+
+/-- Three points are affinely independent if and only if they are not collinear. -/
+lemma affine_independent_iff_not_collinear_of_ne {p : fin 3 → P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
+  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  affine_independent k p ↔ ¬collinear k ({p i₁, p i₂, p i₃} : set P) :=
+begin
+  have hu : (finset.univ : finset (fin 3)) = {i₁, i₂, i₃}, by dec_trivial!,
+  rw [affine_independent_iff_not_collinear, ←set.image_univ, ←finset.coe_univ, hu,
+      finset.coe_insert, finset.coe_insert, finset.coe_singleton, set.image_insert_eq,
+      set.image_pair]
+end
+
+/-- Three points are collinear if and only if they are not affinely independent. -/
+lemma collinear_iff_not_affine_independent_of_ne {p : fin 3 → P} {i₁ i₂ i₃ : fin 3} (h₁₂ : i₁ ≠ i₂)
+  (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) :
+  collinear k ({p i₁, p i₂, p i₃} : set P) ↔ ¬affine_independent k p:=
+(affine_independent_iff_not_collinear_of_ne h₁₂ h₁₃ h₂₃).not_left.symm
+
+/-- If three points are not collinear, the first and second are different. -/
+lemma ne₁₂_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₁ ≠ p₂ :=
+by { rintro rfl, simpa [collinear_pair] using h }
+
+/-- If three points are not collinear, the first and third are different. -/
+lemma ne₁₃_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₁ ≠ p₃ :=
+by { rintro rfl, simpa [collinear_pair] using h }
+
+/-- If three points are not collinear, the second and third are different. -/
+lemma ne₂₃_of_not_collinear {p₁ p₂ p₃ : P} (h : ¬collinear k ({p₁, p₂, p₃} : set P)) : p₂ ≠ p₃ :=
+by { rintro rfl, simpa [collinear_pair] using h }
+
+/-- A point in a collinear set of points lies in the affine span of any two distinct points of
+that set. -/
+lemma collinear.mem_affine_span_of_mem_of_ne {s : set P} (h : collinear k s) {p₁ p₂ p₃ : P}
+  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₁p₂ : p₁ ≠ p₂) :
+  p₃ ∈ line[k, p₁, p₂] :=
+begin
+  rw collinear_iff_of_mem hp₁ at h,
+  rcases h with ⟨v, h⟩,
+  rcases h p₂ hp₂ with ⟨r₂, rfl⟩,
+  rcases h p₃ hp₃ with ⟨r₃, rfl⟩,
+  rw vadd_left_mem_affine_span_pair,
+  refine ⟨r₃ / r₂, _⟩,
+  have h₂ : r₂ ≠ 0,
+  { rintro rfl,
+    simpa using hp₁p₂ },
+  simp [smul_smul, h₂]
+end
+
+/-- The affine span of any two distinct points of a collinear set of points equals the affine
+span of the whole set. -/
+lemma collinear.affine_span_eq_of_ne {s : set P} (h : collinear k s) {p₁ p₂ : P}
+  (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₁p₂ : p₁ ≠ p₂) :
+  line[k, p₁, p₂] = affine_span k s :=
+le_antisymm (affine_span_mono _
+  (set.insert_subset.2 ⟨hp₁, set.singleton_subset_iff.2 hp₂⟩))
+  (affine_span_le.2 (λ p hp, h.mem_affine_span_of_mem_of_ne hp₁ hp₂ hp hp₁p₂))
+
+/-- Given a collinear set of points, and two distinct points `p₂` and `p₃` in it, a point `p₁` is
+collinear with the set if and only if it is collinear with `p₂` and `p₃`. -/
+lemma collinear.collinear_insert_iff_of_ne {s : set P} (h : collinear k s) {p₁ p₂ p₃ : P}
+  (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) (hp₂p₃ : p₂ ≠ p₃) :
+  collinear k (insert p₁ s) ↔ collinear k ({p₁, p₂, p₃} : set P) :=
+begin
+  have hv : vector_span k (insert p₁ s) = vector_span k ({p₁, p₂, p₃} : set P),
+  { conv_lhs { rw [←direction_affine_span, ←affine_span_insert_affine_span] },
+    conv_rhs { rw [←direction_affine_span, ←affine_span_insert_affine_span] },
+    rw h.affine_span_eq_of_ne hp₂ hp₃ hp₂p₃ },
+  rw [collinear, collinear, hv]
+end
+
+/-- Adding a point in the affine span of a set does not change whether that set is collinear. -/
+lemma collinear_insert_iff_of_mem_affine_span {s : set P} {p : P} (h : p ∈ affine_span k s) :
+  collinear k (insert p s) ↔ collinear k s :=
+by rw [collinear, collinear, vector_span_insert_eq_vector_span h]
+
+/-- If a point lies in the affine span of two points, those three points are collinear. -/
+lemma collinear_insert_of_mem_affine_span_pair {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
+  collinear k ({p₁, p₂, p₃} : set P) :=
+begin
+  rw collinear_insert_iff_of_mem_affine_span h,
+  exact collinear_pair _ _ _
+end
+
+/-- If two points lie in the affine span of two points, those four points are collinear. -/
+lemma collinear_insert_insert_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ : P}
+  (h₁ : p₁ ∈ line[k, p₃, p₄]) (h₂ : p₂ ∈ line[k, p₃, p₄]) :
+  collinear k ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  rw [collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
+        (affine_span_mono k (set.subset_insert _ _)) _ h₁),
+      collinear_insert_iff_of_mem_affine_span h₂],
+  exact collinear_pair _ _ _
+end
+
+/-- If three points lie in the affine span of two points, those five points are collinear. -/
+lemma collinear_insert_insert_insert_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
+  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
+  collinear k ({p₁, p₂, p₃, p₄, p₅} : set P) :=
+begin
+  rw [collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
+        (affine_span_mono k ((set.subset_insert _ _).trans (set.subset_insert _ _))) _ h₁),
+      collinear_insert_iff_of_mem_affine_span ((affine_subspace.le_def' _ _).1
+        (affine_span_mono k (set.subset_insert _ _)) _ h₂),
+      collinear_insert_iff_of_mem_affine_span h₃],
+  exact collinear_pair _ _ _
+end
+
+/-- If three points lie in the affine span of two points, the first four points are collinear. -/
+lemma collinear_insert_insert_insert_left_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
+  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
+  collinear k ({p₁, p₂, p₃, p₄} : set P) :=
+begin
+  refine (collinear_insert_insert_insert_of_mem_affine_span_pair h₁ h₂ h₃).subset _,
+  simp [set.insert_subset_insert]
+end
+
+/-- If three points lie in the affine span of two points, the first three points are collinear. -/
+lemma collinear_triple_of_mem_affine_span_pair {p₁ p₂ p₃ p₄ p₅ : P}
+  (h₁ : p₁ ∈ line[k, p₄, p₅]) (h₂ : p₂ ∈ line[k, p₄, p₅]) (h₃ : p₃ ∈ line[k, p₄, p₅]) :
+  collinear k ({p₁, p₂, p₃} : set P) :=
+begin
+  refine (collinear_insert_insert_insert_left_of_mem_affine_span_pair h₁ h₂ h₃).subset _,
+  simp [set.insert_subset_insert]
+end
+
+variables (k)
+
+/-- A set of points is coplanar if their `vector_span` has dimension at most `2`. -/
+def coplanar (s : set P) : Prop := module.rank k (vector_span k s) ≤ 2
+
+variables {k}
+
+/-- The `vector_span` of coplanar points is finite-dimensional. -/
+lemma coplanar.finite_dimensional_vector_span {s : set P} (h : coplanar k s) :
+  finite_dimensional k (vector_span k s) :=
+begin
+  refine is_noetherian.iff_fg.1 (is_noetherian.iff_rank_lt_aleph_0.2 (lt_of_le_of_lt h _)),
+  simp,
+end
+
+/-- The direction of the affine span of coplanar points is finite-dimensional. -/
+lemma coplanar.finite_dimensional_direction_affine_span {s : set P} (h : coplanar k s) :
+  finite_dimensional k (affine_span k s).direction :=
+(direction_affine_span k s).symm ▸ h.finite_dimensional_vector_span
+
+/-- A set of points, whose `vector_span` is finite-dimensional, is coplanar if and only if their
+`vector_span` has dimension at most `2`. -/
+lemma coplanar_iff_finrank_le_two {s : set P} [finite_dimensional k (vector_span k s)] :
+  coplanar k s ↔ finrank k (vector_span k s) ≤ 2 :=
+begin
+  have h : coplanar k s ↔ module.rank k (vector_span k s) ≤ 2 := iff.rfl,
+  rw ←finrank_eq_rank at h,
+  exact_mod_cast h
+end
+
+alias coplanar_iff_finrank_le_two ↔ coplanar.finrank_le_two _
+
+/-- A subset of a coplanar set is coplanar. -/
+lemma coplanar.subset {s₁ s₂ : set P} (hs : s₁ ⊆ s₂) (h : coplanar k s₂) : coplanar k s₁ :=
+(rank_le_of_submodule (vector_span k s₁) (vector_span k s₂) (vector_span_mono k hs)).trans h
+
+/-- Collinear points are coplanar. -/
+lemma collinear.coplanar {s : set P} (h : collinear k s) : coplanar k s :=
+le_trans h one_le_two
+
+variables (k) (P)
+
+/-- The empty set is coplanar. -/
+lemma coplanar_empty : coplanar k (∅ : set P) :=
+(collinear_empty k P).coplanar
+
+variables {P}
+
+/-- A single point is coplanar. -/
+lemma coplanar_singleton (p : P) : coplanar k ({p} : set P) :=
+(collinear_singleton k p).coplanar
+
+/-- Two points are coplanar. -/
+lemma coplanar_pair (p₁ p₂ : P) : coplanar k ({p₁, p₂} : set P) :=
+(collinear_pair k p₁ p₂).coplanar
+
+variables {k}
+
+/-- Adding a point in the affine span of a set does not change whether that set is coplanar. -/
+lemma coplanar_insert_iff_of_mem_affine_span {s : set P} {p : P} (h : p ∈ affine_span k s) :
+  coplanar k (insert p s) ↔ coplanar k s :=
+by rw [coplanar, coplanar, vector_span_insert_eq_vector_span h]
+
 end affine_space'
+
+section division_ring
+
+variables {k : Type*} {V : Type*} {P : Type*}
+include V
+
+open affine_subspace finite_dimensional module
+
+variables [division_ring k] [add_comm_group V] [module k V] [affine_space V P]
+
+/-- Adding a point to a finite-dimensional subspace increases the dimension by at most one. -/
+lemma finrank_vector_span_insert_le (s : affine_subspace k P) (p : P) :
+  finrank k (vector_span k (insert p (s : set P))) ≤ finrank k s.direction + 1 :=
+begin
+  by_cases hf : finite_dimensional k s.direction, swap,
+  { have hf' : ¬finite_dimensional k (vector_span k (insert p (s : set P))),
+    { intro h,
+      have h' : s.direction ≤ vector_span k (insert p (s : set P)),
+      { conv_lhs { rw [←affine_span_coe s, direction_affine_span] },
+        exact vector_span_mono k (set.subset_insert _ _) },
+      exactI hf (submodule.finite_dimensional_of_le h') },
+    rw [finrank_of_infinite_dimensional hf, finrank_of_infinite_dimensional hf', zero_add],
+    exact zero_le_one },
+  haveI := hf,
+  rw [←direction_affine_span, ←affine_span_insert_affine_span],
+  rcases (s : set P).eq_empty_or_nonempty with hs | ⟨p₀, hp₀⟩,
+  { rw coe_eq_bot_iff at hs,
+    rw [hs, bot_coe, span_empty, bot_coe, direction_affine_span, direction_bot, finrank_bot,
+        zero_add],
+    convert zero_le_one' ℕ,
+    rw ←finrank_bot k V,
+    convert rfl;
+      simp },
+  { rw [affine_span_coe, direction_affine_span_insert hp₀, add_comm],
+    refine (submodule.finrank_add_le_finrank_add_finrank _ _).trans (add_le_add_right _ _),
+    refine finrank_le_one ⟨p -ᵥ p₀, submodule.mem_span_singleton_self _⟩ (λ v, _),
+    have h := v.property,
+    rw submodule.mem_span_singleton at h,
+    rcases h with ⟨c, hc⟩,
+    refine ⟨c, _⟩,
+    ext,
+    exact hc }
+end
+
+variables (k)
+
+/-- Adding a point to a set with a finite-dimensional span increases the dimension by at most
+one. -/
+lemma finrank_vector_span_insert_le_set (s : set P) (p : P) :
+  finrank k (vector_span k (insert p s)) ≤ finrank k (vector_span k s) + 1 :=
+begin
+  rw [←direction_affine_span, ←affine_span_insert_affine_span, direction_affine_span],
+  refine (finrank_vector_span_insert_le _ _).trans (add_le_add_right _ _),
+  rw direction_affine_span
+end
+
+variables {k}
+
+/-- Adding a point to a collinear set produces a coplanar set. -/
+lemma collinear.coplanar_insert {s : set P} (h : collinear k s) (p : P) :
+  coplanar k (insert p s) :=
+begin
+  haveI := h.finite_dimensional_vector_span,
+  rw [coplanar_iff_finrank_le_two],
+  exact (finrank_vector_span_insert_le_set k s p).trans (add_le_add_right h.finrank_le_one _)
+end
+
+/-- A set of points in a two-dimensional space is coplanar. -/
+lemma coplanar_of_finrank_eq_two (s : set P) (h : finrank k V = 2) : coplanar k s :=
+begin
+  haveI := finite_dimensional_of_finrank_eq_succ h,
+  rw [coplanar_iff_finrank_le_two, ←h],
+  exact submodule.finrank_le _
+end
+
+/-- A set of points in a two-dimensional space is coplanar. -/
+lemma coplanar_of_fact_finrank_eq_two (s : set P) [h : fact (finrank k V = 2)] : coplanar k s :=
+coplanar_of_finrank_eq_two s h.out
+
+variables (k)
+
+/-- Three points are coplanar. -/
+lemma coplanar_triple (p₁ p₂ p₃ : P) : coplanar k ({p₁, p₂, p₃} : set P) :=
+(collinear_pair k p₂ p₃).coplanar_insert p₁
+
+end division_ring
+
+namespace affine_basis
+
+universes u₁ u₂ u₃ u₄
+
+variables {ι : Type u₁} {k : Type u₂} {V : Type u₃} {P : Type u₄}
+variables [add_comm_group V] [affine_space V P]
+
+section division_ring
+
+variables [division_ring k] [module k V]
+include V
+
+protected lemma finite_dimensional [finite ι] (b : affine_basis ι k P) : finite_dimensional k V :=
+let ⟨i⟩ := b.nonempty in finite_dimensional.of_fintype_basis (b.basis_of i)
+
+protected lemma finite [finite_dimensional k V] (b : affine_basis ι k P) : finite ι :=
+finite_of_fin_dim_affine_independent k b.ind
+
+protected lemma finite_set [finite_dimensional k V] {s : set ι} (b : affine_basis s k P) :
+  s.finite :=
+finite_set_of_fin_dim_affine_independent k b.ind
+
+lemma card_eq_finrank_add_one [fintype ι] (b : affine_basis ι k P) :
+  fintype.card ι = finite_dimensional.finrank k V + 1 :=
+begin
+  haveI := b.finite_dimensional,
+  exact b.ind.affine_span_eq_top_iff_card_eq_finrank_add_one.mp b.tot
+end
+
+variables {k V P}
+
+lemma exists_affine_basis_of_finite_dimensional [fintype ι] [finite_dimensional k V]
+  (h : fintype.card ι = finite_dimensional.finrank k V + 1) :
+  nonempty (affine_basis ι k P) :=
+begin
+  obtain ⟨s, b, hb⟩ := affine_basis.exists_affine_basis k V P,
+  lift s to finset P using b.finite_set,
+  refine ⟨b.reindex $ fintype.equiv_of_card_eq _⟩,
+  rw [h, ← b.card_eq_finrank_add_one]
+end
+
+end division_ring
+
+end affine_basis
diff --git a/src/linear_algebra/affine_space/independent.lean b/src/linear_algebra/affine_space/independent.lean
index 14e34c0e048f4..7918c3ff4d4a8 100644
--- a/src/linear_algebra/affine_space/independent.lean
+++ b/src/linear_algebra/affine_space/independent.lean
@@ -5,6 +5,7 @@ Authors: Joseph Myers
 -/
 import data.finset.sort
 import data.fin.vec_notation
+import data.sign
 import linear_algebra.affine_space.combination
 import linear_algebra.affine_space.affine_equiv
 import linear_algebra.basis
@@ -12,6 +13,9 @@ import linear_algebra.basis
 /-!
 # Affine independence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines affinely independent families of points.
 
 ## Main definitions
@@ -32,7 +36,7 @@ This file defines affinely independent families of points.
 -/
 
 noncomputable theory
-open_locale big_operators classical affine
+open_locale big_operators affine
 open function
 
 section affine_independent
@@ -81,6 +85,7 @@ from a base point in that family are linearly independent. -/
 lemma affine_independent_iff_linear_independent_vsub (p : ι → P) (i1 : ι) :
   affine_independent k p ↔ linear_independent k (λ i : {x // x ≠ i1}, (p i -ᵥ p i1 : V)) :=
 begin
+  classical,
   split,
   { intro h,
     rw linear_independent_iff',
@@ -174,9 +179,10 @@ combinations (with sum of weights 1) that evaluate to the same point
 have equal `set.indicator`. -/
 lemma affine_independent_iff_indicator_eq_of_affine_combination_eq (p : ι → P) :
   affine_independent k p ↔ ∀ (s1 s2 : finset ι) (w1 w2 : ι → k), ∑ i in s1, w1 i = 1 →
-    ∑ i in s2, w2 i = 1 → s1.affine_combination p w1 = s2.affine_combination p w2 →
+    ∑ i in s2, w2 i = 1 → s1.affine_combination k p w1 = s2.affine_combination k p w2 →
       set.indicator ↑s1 w1 = set.indicator ↑s2 w2 :=
 begin
+  classical,
   split,
   { intros ha s1 s2 w1 w2 hw1 hw2 heq,
     ext i,
@@ -196,13 +202,13 @@ begin
     let w1 : ι → k := function.update (function.const ι 0) i0 1,
     have hw1 : ∑ i in s, w1 i = 1,
     { rw [finset.sum_update_of_mem hi0, finset.sum_const_zero, add_zero] },
-    have hw1s : s.affine_combination p w1 = p i0 :=
+    have hw1s : s.affine_combination k p w1 = p i0 :=
       s.affine_combination_of_eq_one_of_eq_zero w1 p hi0 (function.update_same _ _ _)
                                                 (λ _ _ hne, function.update_noteq hne _ _),
     let w2 := w + w1,
     have hw2 : ∑ i in s, w2 i = 1,
     { simp [w2, finset.sum_add_distrib, hw, hw1] },
-    have hw2s : s.affine_combination p w2 = p i0,
+    have hw2s : s.affine_combination k p w2 = p i0,
     { simp [w2, ←finset.weighted_vsub_vadd_affine_combination, hs, hw1s] },
     replace ha := ha s s w2 w1 hw2 hw1 (hw1s.symm ▸ hw2s),
     have hws : w2 i0 - w1 i0 = 0,
@@ -215,7 +221,7 @@ end
 combinations (with sum of weights 1) that evaluate to the same point are equal. -/
 lemma affine_independent_iff_eq_of_fintype_affine_combination_eq [fintype ι] (p : ι → P) :
   affine_independent k p ↔ ∀ (w1 w2 : ι → k), ∑ i, w1 i = 1 → ∑ i, w2 i = 1 →
-    finset.univ.affine_combination p w1 = finset.univ.affine_combination p w2 → w1 = w2 :=
+    finset.univ.affine_combination k p w1 = finset.univ.affine_combination k p w2 → w1 = w2 :=
 begin
   rw affine_independent_iff_indicator_eq_of_affine_combination_eq,
   split,
@@ -249,7 +255,7 @@ end
 
 lemma affine_independent.indicator_eq_of_affine_combination_eq {p : ι → P}
   (ha : affine_independent k p) (s₁ s₂ : finset ι) (w₁ w₂ : ι → k) (hw₁ : ∑ i in s₁, w₁ i = 1)
-  (hw₂ : ∑ i in s₂, w₂ i = 1) (h : s₁.affine_combination p w₁ = s₂.affine_combination p w₂) :
+  (hw₂ : ∑ i in s₂, w₂ i = 1) (h : s₁.affine_combination k p w₁ = s₂.affine_combination k p w₂) :
   set.indicator ↑s₁ w₁ = set.indicator ↑s₂ w₂ :=
 (affine_independent_iff_indicator_eq_of_affine_combination_eq k p).1 ha s₁ s₂ w₁ w₂ hw₁ hw₂ h
 
@@ -271,6 +277,7 @@ family. -/
 lemma affine_independent.comp_embedding {ι2 : Type*} (f : ι2 ↪ ι) {p : ι → P}
     (ha : affine_independent k p) : affine_independent k (p ∘ f) :=
 begin
+  classical,
   intros fs w hw hs i0 hi0,
   let fs' := fs.map f,
   let w' := λ i, if h : ∃ i2, f i2 = i then w h.some else 0,
@@ -361,7 +368,7 @@ begin
   rw affine_independent_iff_linear_independent_vsub k p i at hai,
   simp_rw [affine_independent_iff_linear_independent_vsub k (f ∘ p) i, function.comp_app,
     ← f.linear_map_vsub],
-  have hf' : f.linear.ker = ⊥, { rwa [linear_map.ker_eq_bot, f.injective_iff_linear_injective], },
+  have hf' : f.linear.ker = ⊥, { rwa [linear_map.ker_eq_bot, f.linear_injective_iff], },
   exact linear_independent.map' hai f.linear hf',
 end
 
@@ -411,15 +418,12 @@ end
 by disjoint subsets of the index type are disjoint, if the underlying
 ring is nontrivial. -/
 lemma affine_independent.affine_span_disjoint_of_disjoint [nontrivial k] {p : ι → P}
-    (ha : affine_independent k p) {s1 s2 : set ι} (hd : s1 ∩ s2 = ∅) :
-  (affine_span k (p '' s1) : set P) ∩ affine_span k (p '' s2) = ∅ :=
+    (ha : affine_independent k p) {s1 s2 : set ι} (hd : disjoint s1 s2) :
+  disjoint (affine_span k (p '' s1) : set P) (affine_span k (p '' s2)) :=
 begin
-  by_contradiction hne,
-  change (affine_span k (p '' s1) : set P) ∩ affine_span k (p '' s2) ≠ ∅ at hne,
-  rw set.ne_empty_iff_nonempty at hne,
-  rcases hne with ⟨p0, hp0s1, hp0s2⟩,
+  refine set.disjoint_left.2 (λ p0 hp0s1 hp0s2, _),
   cases ha.exists_mem_inter_of_exists_mem_inter_affine_span hp0s1 hp0s2 with i hi,
-  exact set.not_mem_empty i (hd ▸ hi)
+  exact set.disjoint_iff.1 hd hi,
 end
 
 /-- If a family is affinely independent, a point in the family is in
@@ -464,6 +468,62 @@ begin
   { simp only [finset.sum_dite_of_true (λx h, h), subtype.val_eq_coe, finset.mk_coe, f, hwt, hw], },
 end
 
+/-- Viewing a module as an affine space modelled on itself, we can characterise affine independence
+in terms of linear combinations. -/
+lemma affine_independent_iff {ι} {p : ι → V} :
+  affine_independent k p ↔
+  ∀ (s : finset ι) (w : ι → k), s.sum w = 0 → ∑ e in s, w e • p e = 0 → ∀ (e ∈ s), w e = 0 :=
+forall₃_congr (λ s w hw, by simp [s.weighted_vsub_eq_linear_combination hw])
+
+/-- Given an affinely independent family of points, a weighted subtraction lies in the
+`vector_span` of two points given as affine combinations if and only if it is a weighted
+subtraction with weights a multiple of the difference between the weights of the two points. -/
+lemma weighted_vsub_mem_vector_span_pair {p : ι → P} (h : affine_independent k p)
+  {w w₁ w₂ : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 0) (hw₁ : ∑ i in s, w₁ i = 1)
+  (hw₂ : ∑ i in s, w₂ i = 1) :
+  s.weighted_vsub p w ∈
+    vector_span k ({s.affine_combination k p w₁, s.affine_combination k p w₂} : set P) ↔
+    ∃ r : k, ∀ i ∈ s, w i = r * (w₁ i - w₂ i) :=
+begin
+  rw mem_vector_span_pair,
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with ⟨r, hr⟩,
+    refine ⟨r, λ i hi, _⟩,
+    rw [s.affine_combination_vsub, ←s.weighted_vsub_const_smul, ←sub_eq_zero, ←map_sub] at hr,
+    have hw' : ∑ j in s, (r • (w₁ - w₂) - w) j = 0,
+    { simp_rw [pi.sub_apply, pi.smul_apply, pi.sub_apply, smul_sub, finset.sum_sub_distrib,
+               ←finset.smul_sum, hw, hw₁, hw₂, sub_self] },
+    have hr' := h s _ hw' hr i hi,
+    rw [eq_comm, ←sub_eq_zero, ←smul_eq_mul],
+    exact hr' },
+  { rcases h with ⟨r, hr⟩,
+    refine ⟨r, _⟩,
+    let w' := λ i, r * (w₁ i - w₂ i),
+    change ∀ i ∈ s, w i = w' i at hr,
+    rw [s.weighted_vsub_congr hr (λ _ _, rfl), s.affine_combination_vsub,
+        ←s.weighted_vsub_const_smul],
+    congr }
+end
+
+/-- Given an affinely independent family of points, an affine combination lies in the
+span of two points given as affine combinations if and only if it is an affine combination
+with weights those of one point plus a multiple of the difference between the weights of the
+two points. -/
+lemma affine_combination_mem_affine_span_pair {p : ι → P} (h : affine_independent k p)
+  {w w₁ w₂ : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 1) (hw₁ : ∑ i in s, w₁ i = 1)
+  (hw₂ : ∑ i in s, w₂ i = 1) :
+  s.affine_combination k p w ∈
+    line[k, s.affine_combination k p w₁, s.affine_combination k p w₂] ↔
+    ∃ r : k, ∀ i ∈ s, w i = r * (w₂ i - w₁ i) + w₁ i :=
+begin
+  rw [←vsub_vadd (s.affine_combination k p w) (s.affine_combination k p w₁),
+      affine_subspace.vadd_mem_iff_mem_direction _ (left_mem_affine_span_pair _ _ _),
+      direction_affine_span, s.affine_combination_vsub, set.pair_comm,
+      weighted_vsub_mem_vector_span_pair h _ hw₂ hw₁],
+  { simp only [pi.sub_apply, sub_eq_iff_eq_add] },
+  { simp_rw [pi.sub_apply, finset.sum_sub_distrib, hw, hw₁, sub_self] }
+end
+
 end affine_independent
 
 section division_ring
@@ -527,7 +587,7 @@ begin
       rw [set.image_insert_eq, ← set.image_comp],
       simp, },
     { use p,
-      simp only [equiv.coe_vadd_const, set.singleton_union, set.mem_inter_eq, coe_affine_span],
+      simp only [equiv.coe_vadd_const, set.singleton_union, set.mem_inter_iff, coe_affine_span],
       exact ⟨mem_span_points k _ _ (set.mem_insert p _), mem_span_points k _ _ hp⟩, }, },
 end
 
@@ -549,8 +609,156 @@ begin
   exact linear_independent_unique _ hz
 end
 
+variables {k V P}
+
+/-- If all but one point of a family are affinely independent, and that point does not lie in
+the affine span of that family, the family is affinely independent. -/
+lemma affine_independent.affine_independent_of_not_mem_span {p : ι → P} {i : ι}
+  (ha : affine_independent k (λ x : {y // y ≠ i}, p x))
+  (hi : p i ∉ affine_span k (p '' {x | x ≠ i})) : affine_independent k p :=
+begin
+  classical,
+  intros s w hw hs,
+  let s' : finset {y // y ≠ i} := s.subtype (≠ i),
+  let p' : {y // y ≠ i} → P := λ x, p x,
+  by_cases his : i ∈ s ∧ w i ≠ 0,
+  { refine false.elim (hi _),
+    let wm : ι → k := -(w i)⁻¹ • w,
+    have hms : s.weighted_vsub p wm = (0 : V), { simp [wm, hs] },
+    have hwm : ∑ i in s, wm i = 0, { simp [wm, ←finset.mul_sum, hw] },
+    have hwmi : wm i = -1, { simp [wm, his.2] },
+    let w' : {y // y ≠ i} → k := λ x, wm x,
+    have hw' : ∑ x in s', w' x = 1,
+    { simp_rw [w', finset.sum_subtype_eq_sum_filter],
+      rw ←s.sum_filter_add_sum_filter_not (≠ i) at hwm,
+      simp_rw [not_not, finset.filter_eq', if_pos his.1, finset.sum_singleton, ←wm, hwmi,
+               ←sub_eq_add_neg, sub_eq_zero] at hwm,
+      exact hwm },
+    rw [←s.affine_combination_eq_of_weighted_vsub_eq_zero_of_eq_neg_one hms his.1 hwmi,
+        ←(subtype.range_coe : _ = {x | x ≠ i}), ←set.range_comp,
+        ←s.affine_combination_subtype_eq_filter],
+    exact affine_combination_mem_affine_span hw' p' },
+  { rw [not_and_distrib, not_not] at his,
+    let w' : {y // y ≠ i} → k := λ x, w x,
+    have hw' : ∑ x in s', w' x = 0,
+    { simp_rw [finset.sum_subtype_eq_sum_filter],
+      rw [finset.sum_filter_of_ne, hw],
+      rintro x hxs hwx rfl,
+      exact hwx (his.neg_resolve_left hxs) },
+    have hs' : s'.weighted_vsub p' w' = (0 : V),
+    { simp_rw finset.weighted_vsub_subtype_eq_filter,
+      rw [finset.weighted_vsub_filter_of_ne, hs],
+      rintro x hxs hwx rfl,
+      exact hwx (his.neg_resolve_left hxs) },
+    intros j hj,
+    by_cases hji : j = i,
+    { rw hji at hj,
+      exact hji.symm ▸ (his.neg_resolve_left hj) },
+    { exact ha s' w' hw' hs' ⟨j, hji⟩ (finset.mem_subtype.2 hj) } }
+end
+
+/-- If distinct points `p₁` and `p₂` lie in `s` but `p₃` does not, the three points are affinely
+independent. -/
+lemma affine_independent_of_ne_of_mem_of_mem_of_not_mem {s : affine_subspace k P} {p₁ p₂ p₃ : P}
+  (hp₁p₂ : p₁ ≠ p₂) (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∉ s) :
+  affine_independent k ![p₁, p₂, p₃] :=
+begin
+  have ha : affine_independent k (λ x : {x : fin 3 // x ≠ 2}, ![p₁, p₂, p₃] x),
+  { rw ←affine_independent_equiv ((fin_succ_above_equiv (2 : fin 3)).to_equiv),
+    convert affine_independent_of_ne k hp₁p₂,
+    ext x,
+    fin_cases x;
+      refl },
+  refine ha.affine_independent_of_not_mem_span _,
+  intro h,
+  refine hp₃ ((affine_subspace.le_def' _ s).1 _ p₃ h),
+  simp_rw [affine_span_le, set.image_subset_iff, set.subset_def, set.mem_preimage],
+  intro x,
+  fin_cases x;
+    simp [hp₁, hp₂]
+end
+
+/-- If distinct points `p₁` and `p₃` lie in `s` but `p₂` does not, the three points are affinely
+independent. -/
+lemma affine_independent_of_ne_of_mem_of_not_mem_of_mem {s : affine_subspace k P} {p₁ p₂ p₃ : P}
+  (hp₁p₃ : p₁ ≠ p₃) (hp₁ : p₁ ∈ s) (hp₂ : p₂ ∉ s) (hp₃ : p₃ ∈ s) :
+  affine_independent k ![p₁, p₂, p₃] :=
+begin
+  rw ←affine_independent_equiv (equiv.swap (1 : fin 3) 2),
+  convert affine_independent_of_ne_of_mem_of_mem_of_not_mem hp₁p₃ hp₁ hp₃ hp₂ using 1,
+  ext x,
+  fin_cases x;
+    refl
+end
+
+/-- If distinct points `p₂` and `p₃` lie in `s` but `p₁` does not, the three points are affinely
+independent. -/
+lemma affine_independent_of_ne_of_not_mem_of_mem_of_mem {s : affine_subspace k P} {p₁ p₂ p₃ : P}
+  (hp₂p₃ : p₂ ≠ p₃) (hp₁ : p₁ ∉ s) (hp₂ : p₂ ∈ s) (hp₃ : p₃ ∈ s) :
+  affine_independent k ![p₁, p₂, p₃] :=
+begin
+  rw ←affine_independent_equiv (equiv.swap (0 : fin 3) 2),
+  convert affine_independent_of_ne_of_mem_of_mem_of_not_mem hp₂p₃.symm hp₃ hp₂ hp₁ using 1,
+  ext x,
+  fin_cases x;
+    refl
+end
+
 end division_ring
 
+section ordered
+
+variables {k : Type*} {V : Type*} {P : Type*} [linear_ordered_ring k] [add_comm_group V]
+variables [module k V] [affine_space V P] {ι : Type*}
+include V
+
+local attribute [instance] linear_ordered_ring.decidable_lt
+
+/-- Given an affinely independent family of points, suppose that an affine combination lies in
+the span of two points given as affine combinations, and suppose that, for two indices, the
+coefficients in the first point in the span are zero and those in the second point in the span
+have the same sign. Then the coefficients in the combination lying in the span have the same
+sign. -/
+lemma sign_eq_of_affine_combination_mem_affine_span_pair {p : ι → P} (h : affine_independent k p)
+  {w w₁ w₂ : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 1) (hw₁ : ∑ i in s, w₁ i = 1)
+  (hw₂ : ∑ i in s, w₂ i = 1)
+  (hs : s.affine_combination k p w ∈
+    line[k, s.affine_combination k p w₁, s.affine_combination k p w₂])
+  {i j : ι} (hi : i ∈ s) (hj : j ∈ s) (hi0 : w₁ i = 0) (hj0 : w₁ j = 0)
+  (hij : sign (w₂ i) = sign (w₂ j)) : sign (w i) = sign (w j) :=
+begin
+  rw affine_combination_mem_affine_span_pair h hw hw₁ hw₂ at hs,
+  rcases hs with ⟨r, hr⟩,
+  dsimp only at hr,
+  rw [hr i hi, hr j hj, hi0, hj0, add_zero, add_zero, sub_zero, sub_zero, sign_mul, sign_mul, hij]
+end
+
+/-- Given an affinely independent family of points, suppose that an affine combination lies in
+the span of one point of that family and a combination of another two points of that family given
+by `line_map` with coefficient between 0 and 1. Then the coefficients of those two points in the
+combination lying in the span have the same sign. -/
+lemma sign_eq_of_affine_combination_mem_affine_span_single_line_map {p : ι → P}
+  (h : affine_independent k p) {w : ι → k} {s : finset ι} (hw : ∑ i in s, w i = 1)
+  {i₁ i₂ i₃ : ι} (h₁ : i₁ ∈ s) (h₂ : i₂ ∈ s) (h₃ : i₃ ∈ s) (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃)
+  (h₂₃ : i₂ ≠ i₃) {c : k} (hc0 : 0 < c) (hc1 : c < 1)
+  (hs : s.affine_combination k p w ∈ line[k, p i₁, affine_map.line_map (p i₂) (p i₃) c]) :
+  sign (w i₂) = sign (w i₃) :=
+begin
+  classical,
+  rw [←s.affine_combination_affine_combination_single_weights k p h₁,
+      ←s.affine_combination_affine_combination_line_map_weights p h₂ h₃ c] at hs,
+  refine sign_eq_of_affine_combination_mem_affine_span_pair h hw
+    (s.sum_affine_combination_single_weights k h₁)
+    (s.sum_affine_combination_line_map_weights h₂ h₃ c) hs h₂ h₃
+    (finset.affine_combination_single_weights_apply_of_ne k h₁₂.symm)
+    (finset.affine_combination_single_weights_apply_of_ne k h₁₃.symm) _,
+  rw [finset.affine_combination_line_map_weights_apply_left h₂₃,
+      finset.affine_combination_line_map_weights_apply_right h₂₃],
+  simp [hc0, sub_pos.2 hc1]
+end
+
+end ordered
+
 namespace affine
 
 variables (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V] [module k V]
@@ -629,6 +837,37 @@ by { ext, simp [face_points] }
   {m : ℕ} (h : fs.card = m + 1) : set.range (s.face h).points = s.points '' ↑fs :=
 by rw [face_points', set.range_comp, finset.range_order_emb_of_fin]
 
+/-- Remap a simplex along an `equiv` of index types. -/
+@[simps]
+def reindex {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) : simplex k P n :=
+⟨s.points ∘ e.symm, (affine_independent_equiv e.symm).2 s.independent⟩
+
+/-- Reindexing by `equiv.refl` yields the original simplex. -/
+@[simp] lemma reindex_refl {n : ℕ} (s : simplex k P n) :
+  s.reindex (equiv.refl (fin (n + 1))) = s :=
+ext $ λ _, rfl
+
+/-- Reindexing by the composition of two equivalences is the same as reindexing twice. -/
+@[simp] lemma reindex_trans {n₁ n₂ n₃ : ℕ} (e₁₂ : fin (n₁ + 1) ≃ fin (n₂ + 1))
+  (e₂₃ : fin (n₂ + 1) ≃ fin (n₃ + 1)) (s : simplex k P n₁) :
+  s.reindex (e₁₂.trans e₂₃) = (s.reindex e₁₂).reindex e₂₃ :=
+rfl
+
+/-- Reindexing by an equivalence and its inverse yields the original simplex. -/
+@[simp] lemma reindex_reindex_symm {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  (s.reindex e).reindex e.symm = s :=
+by rw [←reindex_trans, equiv.self_trans_symm, reindex_refl]
+
+/-- Reindexing by the inverse of an equivalence and that equivalence yields the original simplex. -/
+@[simp] lemma reindex_symm_reindex {m n : ℕ} (s : simplex k P m) (e : fin (n + 1) ≃ fin (m + 1)) :
+  (s.reindex e.symm).reindex e = s :=
+by rw [←reindex_trans, equiv.symm_trans_self, reindex_refl]
+
+/-- Reindexing a simplex produces one with the same set of points. -/
+@[simp] lemma reindex_range_points {m n : ℕ} (s : simplex k P m) (e : fin (m + 1) ≃ fin (n + 1)) :
+  set.range (s.reindex e).points = set.range s.points :=
+by rw [reindex, set.range_comp, equiv.range_eq_univ, set.image_univ]
+
 end simplex
 
 end affine
diff --git a/src/linear_algebra/affine_space/matrix.lean b/src/linear_algebra/affine_space/matrix.lean
new file mode 100644
index 0000000000000..fd7eb1c686749
--- /dev/null
+++ b/src/linear_algebra/affine_space/matrix.lean
@@ -0,0 +1,175 @@
+/-
+Copyright (c) 2021 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import linear_algebra.affine_space.basis
+import linear_algebra.determinant
+
+/-!
+# Matrix results for barycentric co-ordinates
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Results about the matrix of barycentric co-ordinates for a family of points in an affine space, with
+respect to some affine basis.
+-/
+
+open_locale affine big_operators matrix
+open set
+
+universes u₁ u₂ u₃ u₄
+
+variables {ι : Type u₁} {k : Type u₂} {V : Type u₃} {P : Type u₄}
+variables [add_comm_group V] [affine_space V P]
+
+namespace affine_basis
+
+section ring
+
+variables [ring k] [module k V] (b : affine_basis ι k P)
+
+/-- Given an affine basis `p`, and a family of points `q : ι' → P`, this is the matrix whose
+rows are the barycentric coordinates of `q` with respect to `p`.
+
+It is an affine equivalent of `basis.to_matrix`. -/
+noncomputable def to_matrix {ι' : Type*} (q : ι' → P) : matrix ι' ι k :=
+λ i j, b.coord j (q i)
+
+@[simp] lemma to_matrix_apply {ι' : Type*} (q : ι' → P) (i : ι') (j : ι) :
+  b.to_matrix q i j = b.coord j (q i) :=
+rfl
+
+@[simp] lemma to_matrix_self [decidable_eq ι] :
+  b.to_matrix b = (1 : matrix ι ι k) :=
+begin
+  ext i j,
+  rw [to_matrix_apply, coord_apply, matrix.one_eq_pi_single, pi.single_apply],
+end
+
+variables {ι' : Type*} [fintype ι'] [fintype ι] (b₂ : affine_basis ι k P)
+
+lemma to_matrix_row_sum_one {ι' : Type*} (q : ι' → P) (i : ι') :
+  ∑ j, b.to_matrix q i j = 1 :=
+by simp
+
+/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
+coordinates of `p` with respect `b` has a right inverse, then `p` is affine independent. -/
+lemma affine_independent_of_to_matrix_right_inv [decidable_eq ι']
+  (p : ι' → P) {A : matrix ι ι' k} (hA : (b.to_matrix p) ⬝ A = 1) : affine_independent k p :=
+begin
+  rw affine_independent_iff_eq_of_fintype_affine_combination_eq,
+  intros w₁ w₂ hw₁ hw₂ hweq,
+  have hweq' : (b.to_matrix p).vec_mul w₁ = (b.to_matrix p).vec_mul w₂,
+  { ext j,
+    change ∑ i, (w₁ i) • (b.coord j (p i)) = ∑ i, (w₂ i) • (b.coord j (p i)),
+    rw [← finset.univ.affine_combination_eq_linear_combination _ _ hw₁,
+        ← finset.univ.affine_combination_eq_linear_combination _ _ hw₂,
+        ← finset.univ.map_affine_combination p w₁ hw₁,
+        ← finset.univ.map_affine_combination p w₂ hw₂, hweq], },
+  replace hweq' := congr_arg (λ w, A.vec_mul w) hweq',
+  simpa only [matrix.vec_mul_vec_mul, ← matrix.mul_eq_mul, hA, matrix.vec_mul_one] using hweq',
+end
+
+/-- Given a family of points `p : ι' → P` and an affine basis `b`, if the matrix whose rows are the
+coordinates of `p` with respect `b` has a left inverse, then `p` spans the entire space. -/
+lemma affine_span_eq_top_of_to_matrix_left_inv [decidable_eq ι] [nontrivial k]
+  (p : ι' → P) {A : matrix ι ι' k} (hA : A ⬝ b.to_matrix p = 1) : affine_span k (range p) = ⊤ :=
+begin
+  suffices : ∀ i, b i ∈ affine_span k (range p),
+  { rw [eq_top_iff, ← b.tot, affine_span_le],
+    rintros q ⟨i, rfl⟩,
+    exact this i, },
+  intros i,
+  have hAi : ∑ j, A i j = 1,
+  { calc ∑ j, A i j = ∑ j, (A i j) * ∑ l, b.to_matrix p j l : by simp
+                ... = ∑ j, ∑ l, (A i j) * b.to_matrix p j l : by simp_rw finset.mul_sum
+                ... = ∑ l, ∑ j, (A i j) * b.to_matrix p j l : by rw finset.sum_comm
+                ... = ∑ l, (A ⬝ b.to_matrix p) i l : rfl
+                ... = 1 : by simp [hA, matrix.one_apply, finset.filter_eq], },
+  have hbi : b i = finset.univ.affine_combination k p (A i),
+  { apply b.ext_elem,
+    intros j,
+    rw [b.coord_apply, finset.univ.map_affine_combination _ _ hAi,
+      finset.univ.affine_combination_eq_linear_combination _ _ hAi],
+    change _ = (A ⬝ b.to_matrix p) i j,
+    simp_rw [hA, matrix.one_apply, @eq_comm _ i j] },
+  rw hbi,
+  exact affine_combination_mem_affine_span hAi p,
+end
+
+/-- A change of basis formula for barycentric coordinates.
+
+See also `affine_basis.to_matrix_inv_mul_affine_basis_to_matrix`. -/
+@[simp] lemma to_matrix_vec_mul_coords (x : P) :
+  (b.to_matrix b₂).vec_mul (b₂.coords x) = b.coords x :=
+begin
+  ext j,
+  change _ = b.coord j x,
+  conv_rhs { rw ← b₂.affine_combination_coord_eq_self x, },
+  rw finset.map_affine_combination _ _ _ (b₂.sum_coord_apply_eq_one x),
+  simp [matrix.vec_mul, matrix.dot_product, to_matrix_apply, coords],
+end
+
+variables [decidable_eq ι]
+
+lemma to_matrix_mul_to_matrix :
+  (b.to_matrix b₂) ⬝ (b₂.to_matrix b) = 1 :=
+begin
+  ext l m,
+  change (b₂.to_matrix b).vec_mul (b.coords (b₂ l)) m = _,
+  rw [to_matrix_vec_mul_coords, coords_apply, ← to_matrix_apply, to_matrix_self],
+end
+
+lemma is_unit_to_matrix :
+  is_unit (b.to_matrix b₂) :=
+⟨{ val     := b.to_matrix b₂,
+   inv     := b₂.to_matrix b,
+   val_inv := b.to_matrix_mul_to_matrix b₂,
+   inv_val := b₂.to_matrix_mul_to_matrix b, }, rfl⟩
+
+lemma is_unit_to_matrix_iff [nontrivial k] (p : ι → P) :
+  is_unit (b.to_matrix p) ↔ affine_independent k p ∧ affine_span k (range p) = ⊤ :=
+begin
+  split,
+  { rintros ⟨⟨B, A, hA, hA'⟩, (rfl : B = b.to_matrix p)⟩,
+    rw matrix.mul_eq_mul at hA hA',
+    exact ⟨b.affine_independent_of_to_matrix_right_inv p hA,
+           b.affine_span_eq_top_of_to_matrix_left_inv p hA'⟩, },
+  { rintros ⟨h_tot, h_ind⟩,
+    let b' : affine_basis ι k P := ⟨p, h_tot, h_ind⟩,
+    change is_unit (b.to_matrix b'),
+    exact b.is_unit_to_matrix b', },
+end
+
+end ring
+
+section comm_ring
+variables [comm_ring k] [module k V] [decidable_eq ι] [fintype ι]
+variables (b b₂ : affine_basis ι k P)
+
+/-- A change of basis formula for barycentric coordinates.
+
+See also `affine_basis.to_matrix_vec_mul_coords`. -/
+@[simp] lemma to_matrix_inv_vec_mul_to_matrix (x : P) :
+  (b.to_matrix b₂)⁻¹.vec_mul (b.coords x) = b₂.coords x :=
+begin
+  have hu := b.is_unit_to_matrix b₂,
+  rw matrix.is_unit_iff_is_unit_det at hu,
+  rw [← b.to_matrix_vec_mul_coords b₂, matrix.vec_mul_vec_mul, matrix.mul_nonsing_inv _ hu,
+    matrix.vec_mul_one],
+end
+
+/-- If we fix a background affine basis `b`, then for any other basis `b₂`, we can characterise
+the barycentric coordinates provided by `b₂` in terms of determinants relative to `b`. -/
+lemma det_smul_coords_eq_cramer_coords (x : P) :
+  (b.to_matrix b₂).det • b₂.coords x = (b.to_matrix b₂)ᵀ.cramer (b.coords x) :=
+begin
+  have hu := b.is_unit_to_matrix b₂,
+  rw matrix.is_unit_iff_is_unit_det at hu,
+  rw [← b.to_matrix_inv_vec_mul_to_matrix, matrix.det_smul_inv_vec_mul_eq_cramer_transpose _ _ hu],
+end
+end comm_ring
+
+end affine_basis
diff --git a/src/linear_algebra/affine_space/midpoint.lean b/src/linear_algebra/affine_space/midpoint.lean
index 8072c8c35a2fa..686bc7ebb701a 100644
--- a/src/linear_algebra/affine_space/midpoint.lean
+++ b/src/linear_algebra/affine_space/midpoint.lean
@@ -3,12 +3,15 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import algebra.char_p.invertible
+import algebra.invertible
 import linear_algebra.affine_space.affine_equiv
 
 /-!
 # Midpoint of a segment
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `midpoint R x y`: midpoint of the segment `[x, y]`. We define it for `x` and `y`
@@ -93,6 +96,17 @@ left_vsub_line_map _ _ _
 @[simp] lemma right_vsub_midpoint (p₁ p₂ : P) : p₂ -ᵥ midpoint R p₁ p₂ = (⅟2:R) • (p₂ -ᵥ p₁) :=
 by rw [midpoint_comm, left_vsub_midpoint]
 
+lemma midpoint_vsub (p₁ p₂ p : P) :
+  midpoint R p₁ p₂ -ᵥ p = (⅟2:R) • (p₁ -ᵥ p) + (⅟2:R) • (p₂ -ᵥ p) :=
+by rw [←vsub_sub_vsub_cancel_right p₁ p p₂, smul_sub, sub_eq_add_neg, ←smul_neg,
+       neg_vsub_eq_vsub_rev, add_assoc, inv_of_two_smul_add_inv_of_two_smul, ←vadd_vsub_assoc,
+       midpoint_comm, midpoint, line_map_apply]
+
+lemma vsub_midpoint (p₁ p₂ p : P) :
+  p -ᵥ midpoint R p₁ p₂ = (⅟2:R) • (p -ᵥ p₁) + (⅟2:R) • (p -ᵥ p₂) :=
+by rw [←neg_vsub_eq_vsub_rev, midpoint_vsub, neg_add, ←smul_neg, ←smul_neg,
+       neg_vsub_eq_vsub_rev, neg_vsub_eq_vsub_rev]
+
 @[simp] lemma midpoint_sub_left (v₁ v₂ : V) : midpoint R v₁ v₂ - v₁ = (⅟2:R) • (v₂ - v₁) :=
 midpoint_vsub_left v₁ v₂
 
@@ -107,10 +121,22 @@ right_vsub_midpoint v₁ v₂
 
 variable (R)
 
+@[simp] lemma midpoint_eq_left_iff {x y : P} : midpoint R x y = x ↔ x = y :=
+by rw [midpoint_eq_iff, point_reflection_self]
+
+@[simp] lemma left_eq_midpoint_iff {x y : P} : x = midpoint R x y ↔ x = y :=
+by rw [eq_comm, midpoint_eq_left_iff]
+
+@[simp] lemma midpoint_eq_right_iff {x y : P} : midpoint R x y = y ↔ x = y :=
+by rw [midpoint_comm, midpoint_eq_left_iff, eq_comm]
+
+@[simp] lemma right_eq_midpoint_iff {x y : P} : y = midpoint R x y ↔ x = y :=
+by rw [eq_comm, midpoint_eq_right_iff]
+
 lemma midpoint_eq_midpoint_iff_vsub_eq_vsub {x x' y y' : P} :
   midpoint R x y = midpoint R x' y' ↔ x -ᵥ x' = y' -ᵥ y :=
 by rw [← @vsub_eq_zero_iff_eq V, midpoint_vsub_midpoint, midpoint_eq_iff, point_reflection_apply,
-  vsub_eq_sub, zero_sub, vadd_eq_add, add_zero, neg_eq_iff_neg_eq, neg_vsub_eq_vsub_rev, eq_comm]
+  vsub_eq_sub, zero_sub, vadd_eq_add, add_zero, neg_eq_iff_eq_neg, neg_vsub_eq_vsub_rev]
 
 lemma midpoint_eq_iff' {x y z : P} : midpoint R x y = z ↔ equiv.point_reflection z x = y :=
 midpoint_eq_iff
@@ -152,36 +178,6 @@ by rw midpoint_comm; simp
 
 end
 
-lemma line_map_inv_two {R : Type*} {V P : Type*} [division_ring R] [char_zero R]
-  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
-  line_map a b (2⁻¹:R) = midpoint R a b :=
-rfl
-
-lemma line_map_one_half {R : Type*} {V P : Type*} [division_ring R] [char_zero R]
-  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
-  line_map a b (1/2:R) = midpoint R a b :=
-by rw [one_div, line_map_inv_two]
-
-lemma homothety_inv_of_two {R : Type*} {V P : Type*} [comm_ring R] [invertible (2:R)]
-  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
-  homothety a (⅟2:R) b = midpoint R a b :=
-rfl
-
-lemma homothety_inv_two {k : Type*} {V P : Type*} [field k] [char_zero k]
-  [add_comm_group V] [module k V] [add_torsor V P] (a b : P) :
-  homothety a (2⁻¹:k) b = midpoint k a b :=
-rfl
-
-lemma homothety_one_half {k : Type*} {V P : Type*} [field k] [char_zero k]
-  [add_comm_group V] [module k V] [add_torsor V P] (a b : P) :
-  homothety a (1/2:k) b = midpoint k a b :=
-by rw [one_div, homothety_inv_two]
-
-@[simp] lemma pi_midpoint_apply {k ι : Type*} {V : Π i : ι, Type*} {P : Π i : ι, Type*} [field k]
-  [invertible (2:k)] [Π i, add_comm_group (V i)] [Π i, module k (V i)]
-  [Π i, add_torsor (V i) (P i)] (f g : Π i, P i) (i : ι) :
-  midpoint k f g i = midpoint k (f i) (g i) := rfl
-
 namespace add_monoid_hom
 
 variables (R R' : Type*) {E F : Type*}
diff --git a/src/linear_algebra/affine_space/midpoint_zero.lean b/src/linear_algebra/affine_space/midpoint_zero.lean
new file mode 100644
index 0000000000000..a93b8c2d3bb5c
--- /dev/null
+++ b/src/linear_algebra/affine_space/midpoint_zero.lean
@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import algebra.char_p.invertible
+import linear_algebra.affine_space.midpoint
+
+/-!
+# Midpoint of a segment for characteristic zero
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We collect lemmas that require that the underlying ring has characteristic zero.
+
+## Tags
+
+midpoint
+-/
+
+open affine_map affine_equiv
+
+lemma line_map_inv_two {R : Type*} {V P : Type*} [division_ring R] [char_zero R]
+  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
+  line_map a b (2⁻¹:R) = midpoint R a b :=
+rfl
+
+lemma line_map_one_half {R : Type*} {V P : Type*} [division_ring R] [char_zero R]
+  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
+  line_map a b (1/2:R) = midpoint R a b :=
+by rw [one_div, line_map_inv_two]
+
+lemma homothety_inv_of_two {R : Type*} {V P : Type*} [comm_ring R] [invertible (2:R)]
+  [add_comm_group V] [module R V] [add_torsor V P] (a b : P) :
+  homothety a (⅟2:R) b = midpoint R a b :=
+rfl
+
+lemma homothety_inv_two {k : Type*} {V P : Type*} [field k] [char_zero k]
+  [add_comm_group V] [module k V] [add_torsor V P] (a b : P) :
+  homothety a (2⁻¹:k) b = midpoint k a b :=
+rfl
+
+lemma homothety_one_half {k : Type*} {V P : Type*} [field k] [char_zero k]
+  [add_comm_group V] [module k V] [add_torsor V P] (a b : P) :
+  homothety a (1/2:k) b = midpoint k a b :=
+by rw [one_div, homothety_inv_two]
+
+@[simp] lemma pi_midpoint_apply {k ι : Type*} {V : Π i : ι, Type*} {P : Π i : ι, Type*} [field k]
+  [invertible (2:k)] [Π i, add_comm_group (V i)] [Π i, module k (V i)]
+  [Π i, add_torsor (V i) (P i)] (f g : Π i, P i) (i : ι) :
+  midpoint k f g i = midpoint k (f i) (g i) := rfl
diff --git a/src/linear_algebra/affine_space/ordered.lean b/src/linear_algebra/affine_space/ordered.lean
index 833ef73fbcd54..6c746a980acb7 100644
--- a/src/linear_algebra/affine_space/ordered.lean
+++ b/src/linear_algebra/affine_space/ordered.lean
@@ -5,13 +5,16 @@ Authors: Yury G. Kudryashov
 -/
 import algebra.order.invertible
 import algebra.order.module
-import linear_algebra.affine_space.midpoint
+import linear_algebra.affine_space.midpoint_zero
 import linear_algebra.affine_space.slope
 import tactic.field_simp
 
 /-!
 # Ordered modules as affine spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove some theorems about `slope` and `line_map` in the case when the module `E`
 acting on the codomain `PE` of a function is an ordered module over its domain `k`. We also prove
 inequalities that can be used to link convexity of a function on an interval to monotonicity of the
@@ -202,8 +205,8 @@ begin
   rw [line_map_apply, line_map_apply, slope, slope,
   vsub_eq_sub, vsub_eq_sub, vsub_eq_sub, vadd_eq_add, vadd_eq_add,
   smul_eq_mul, add_sub_cancel, smul_sub, smul_sub, smul_sub,
-  sub_le_iff_le_add, mul_inv_rev₀, mul_smul, mul_smul, ←smul_sub, ←smul_sub, ←smul_add, smul_smul,
-  ← mul_inv_rev₀, smul_le_iff_of_pos (inv_pos.2 h), inv_inv, smul_smul,
+  sub_le_iff_le_add, mul_inv_rev, mul_smul, mul_smul, ←smul_sub, ←smul_sub, ←smul_add, smul_smul,
+  ← mul_inv_rev, inv_smul_le_iff h, smul_smul,
   mul_inv_cancel_right₀ (right_ne_zero_of_mul h.ne'), smul_add,
   smul_inv_smul₀ (left_ne_zero_of_mul h.ne')],
   apply_instance
@@ -236,11 +239,10 @@ begin
   rw [← line_map_apply_one_sub, ← line_map_apply_one_sub _ _ r],
   revert h, generalize : 1 - r = r', clear r, intro h,
   simp_rw [line_map_apply, slope, vsub_eq_sub, vadd_eq_add, smul_eq_mul],
-  rw [sub_add_eq_sub_sub_swap, sub_self, zero_sub, le_smul_iff_of_pos, inv_inv, smul_smul,
-    neg_mul_eq_mul_neg, neg_sub, mul_inv_cancel_right₀, le_sub, ← neg_sub (f b), smul_neg,
-    neg_add_eq_sub],
+  rw [sub_add_eq_sub_sub_swap, sub_self, zero_sub, neg_mul_eq_mul_neg, neg_sub, le_inv_smul_iff h,
+    smul_smul, mul_inv_cancel_right₀, le_sub_comm, ← neg_sub (f b), smul_neg, neg_add_eq_sub],
   { exact right_ne_zero_of_mul h.ne' },
-  { simpa [mul_sub] using h }
+  { apply_instance }
 end
 
 /-- Given `c = line_map a b r`, `c < b`, the point `(c, f c)` is non-strictly above the
diff --git a/src/linear_algebra/affine_space/pointwise.lean b/src/linear_algebra/affine_space/pointwise.lean
new file mode 100644
index 0000000000000..8dc1c4153421a
--- /dev/null
+++ b/src/linear_algebra/affine_space/pointwise.lean
@@ -0,0 +1,82 @@
+/-
+Copyright (c) 2022 Hanting Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Hanting Zhang
+-/
+import linear_algebra.affine_space.affine_subspace
+
+
+/-! # Pointwise instances on `affine_subspace`s
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides the additive action `affine_subspace.pointwise_add_action` in the
+`pointwise` locale.
+
+-/
+
+open_locale affine pointwise
+
+open set
+
+namespace affine_subspace
+
+variables {k : Type*} [ring k]
+variables {V P V₁ P₁ V₂ P₂ : Type*}
+
+variables [add_comm_group V] [module k V] [affine_space V P]
+variables [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
+variables [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]
+
+include V
+
+/-- The additive action on an affine subspace corresponding to applying the action to every element.
+
+This is available as an instance in the `pointwise` locale. -/
+protected def pointwise_add_action : add_action V (affine_subspace k P) :=
+{ vadd := λ x S, S.map (affine_equiv.const_vadd k P x),
+  zero_vadd := λ p,
+    (congr_arg (λ f, p.map f) $ affine_map.ext $ by exact zero_vadd _).trans (p.map_id),
+  add_vadd := λ x y p,
+    (congr_arg (λ f, p.map f) $ affine_map.ext $ by exact add_vadd _ _).trans (p.map_map _ _).symm }
+
+localized "attribute [instance] affine_subspace.pointwise_add_action" in pointwise
+open_locale pointwise
+
+@[simp] lemma coe_pointwise_vadd (v : V) (s : affine_subspace k P) :
+  ((v +ᵥ s : affine_subspace k P) : set P) = v +ᵥ s := rfl
+
+lemma vadd_mem_pointwise_vadd_iff {v : V} {s : affine_subspace k P} {p : P} :
+  v +ᵥ p ∈ v +ᵥ s ↔ p ∈ s :=
+vadd_mem_vadd_set_iff
+
+lemma pointwise_vadd_bot (v : V) : v +ᵥ (⊥ : affine_subspace k P) = ⊥ :=
+by simp [set_like.ext'_iff]
+
+lemma pointwise_vadd_direction (v : V) (s : affine_subspace k P) :
+  (v +ᵥ s).direction = s.direction :=
+begin
+  unfold has_vadd.vadd,
+  rw map_direction,
+  exact submodule.map_id _,
+end
+
+lemma pointwise_vadd_span (v : V) (s : set P) :
+  v +ᵥ affine_span k s = affine_span k (v +ᵥ s) :=
+map_span _ s
+
+omit V
+include V₁ V₂
+
+lemma map_pointwise_vadd (f : P₁ →ᵃ[k] P₂) (v : V₁) (s : affine_subspace k P₁) :
+  (v +ᵥ s).map f = f.linear v +ᵥ s.map f :=
+begin
+  unfold has_vadd.vadd,
+  rw [map_map, map_map],
+  congr' 1,
+  ext,
+  exact f.map_vadd _ _,
+end
+
+end affine_subspace
diff --git a/src/linear_algebra/affine_space/restrict.lean b/src/linear_algebra/affine_space/restrict.lean
new file mode 100644
index 0000000000000..b115879676dcf
--- /dev/null
+++ b/src/linear_algebra/affine_space/restrict.lean
@@ -0,0 +1,110 @@
+/-
+Copyright (c) 2022 Paul Reichert. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Paul Reichert
+-/
+import linear_algebra.affine_space.affine_subspace
+
+/-!
+# Affine map restrictions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines restrictions of affine maps.
+
+## Main definitions
+
+* The domain and codomain of an affine map can be restricted using
+  `affine_map.restrict`.
+
+## Main theorems
+
+* The associated linear map of the restriction is the restriction of the
+  linear map associated to the original affine map.
+* The restriction is injective if the original map is injective.
+* The restriction in surjective if the codomain is the image of the domain.
+-/
+
+variables {k V₁ P₁ V₂ P₂ : Type*} [ring k]
+  [add_comm_group V₁] [add_comm_group V₂]
+  [module k V₁] [module k V₂]
+  [add_torsor V₁ P₁] [add_torsor V₂ P₂]
+
+include V₁ V₂
+
+/- not an instance because it loops with `nonempty` -/
+lemma affine_subspace.nonempty_map {E : affine_subspace k P₁} [Ene : nonempty E]
+  {φ : P₁ →ᵃ[k] P₂} : nonempty (E.map φ) :=
+begin
+  obtain ⟨x, hx⟩ := id Ene,
+  refine ⟨⟨φ x, affine_subspace.mem_map.mpr ⟨x, hx, rfl⟩⟩⟩,
+end
+
+local attribute [instance, nolint fails_quickly] affine_subspace.nonempty_map
+local attribute [instance, nolint fails_quickly] affine_subspace.to_add_torsor
+
+/-- Restrict domain and codomain of an affine map to the given subspaces. -/
+def affine_map.restrict
+  (φ : P₁ →ᵃ[k] P₂) {E : affine_subspace k P₁} {F : affine_subspace k P₂}
+  [nonempty E] [nonempty F]
+  (hEF : E.map φ ≤ F) : E →ᵃ[k] F :=
+begin
+  refine ⟨_, _, _⟩,
+  { exact λ x, ⟨φ x, hEF $ affine_subspace.mem_map.mpr ⟨x, x.property, rfl⟩⟩ },
+  { refine φ.linear.restrict (_ : E.direction ≤ F.direction.comap φ.linear),
+    rw [←submodule.map_le_iff_le_comap, ←affine_subspace.map_direction],
+    exact affine_subspace.direction_le hEF },
+  { intros p v,
+    simp only [subtype.ext_iff, subtype.coe_mk, affine_subspace.coe_vadd],
+    apply affine_map.map_vadd },
+end
+
+lemma affine_map.restrict.coe_apply
+  (φ : P₁ →ᵃ[k] P₂) {E : affine_subspace k P₁} {F : affine_subspace k P₂}
+  [nonempty E] [nonempty F]
+  (hEF : E.map φ ≤ F) (x : E) :
+  ↑(φ.restrict hEF x) = φ x := rfl
+
+lemma affine_map.restrict.linear_aux
+  {φ : P₁ →ᵃ[k] P₂} {E : affine_subspace k P₁} {F : affine_subspace k P₂}
+  (hEF : E.map φ ≤ F) : E.direction ≤ F.direction.comap φ.linear :=
+begin
+  rw [←submodule.map_le_iff_le_comap, ←affine_subspace.map_direction],
+  exact affine_subspace.direction_le hEF,
+end
+
+lemma affine_map.restrict.linear
+  (φ : P₁ →ᵃ[k] P₂) {E : affine_subspace k P₁} {F : affine_subspace k P₂}
+  [nonempty E] [nonempty F]
+  (hEF : E.map φ ≤ F) :
+  (φ.restrict hEF).linear = φ.linear.restrict (affine_map.restrict.linear_aux hEF) := rfl
+
+lemma affine_map.restrict.injective
+  {φ : P₁ →ᵃ[k] P₂}
+  (hφ : function.injective φ) {E : affine_subspace k P₁} {F : affine_subspace k P₂}
+  [nonempty E] [nonempty F]
+  (hEF : E.map φ ≤ F) :
+  function.injective (affine_map.restrict φ hEF) :=
+begin
+  intros x y h,
+  simp only [subtype.ext_iff, subtype.coe_mk, affine_map.restrict.coe_apply] at h ⊢,
+  exact hφ h,
+end
+
+lemma affine_map.restrict.surjective
+  (φ : P₁ →ᵃ[k] P₂) {E : affine_subspace k P₁} {F : affine_subspace k P₂}
+  [nonempty E] [nonempty F] (h : E.map φ = F) :
+  function.surjective (affine_map.restrict φ (le_of_eq h)) :=
+begin
+  rintro ⟨x, hx : x ∈ F⟩,
+  rw [←h, affine_subspace.mem_map] at hx,
+  obtain ⟨y, hy, rfl⟩ := hx,
+  exact ⟨⟨y, hy⟩, rfl⟩,
+end
+
+lemma affine_map.restrict.bijective
+  {E : affine_subspace k P₁} [nonempty E]
+  {φ : P₁ →ᵃ[k] P₂} (hφ : function.injective φ) :
+  function.bijective (φ.restrict (le_refl (E.map φ))) :=
+⟨affine_map.restrict.injective hφ _, affine_map.restrict.surjective _ rfl⟩
diff --git a/src/linear_algebra/affine_space/slope.lean b/src/linear_algebra/affine_space/slope.lean
index 1534fe1435c3e..768a9857022b2 100644
--- a/src/linear_algebra/affine_space/slope.lean
+++ b/src/linear_algebra/affine_space/slope.lean
@@ -3,13 +3,15 @@ Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import algebra.order.module
 import linear_algebra.affine_space.affine_map
 import tactic.field_simp
 
 /-!
 # Slope of a function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the slope of a function `f : k → PE` taking values in an affine space over
 `k` and prove some basic theorems about `slope`. The `slope` function naturally appears in the Mean
 Value Theorem, and in the proof of the fact that a function with nonnegative second derivative on an
@@ -34,7 +36,10 @@ lemma slope_fun_def (f : k → PE) : slope f = λ a b, (b - a)⁻¹ • (f b -
 omit E
 
 lemma slope_def_field (f : k → k) (a b : k) : slope f a b = (f b - f a) / (b - a) :=
-div_eq_inv_mul.symm
+(div_eq_inv_mul _ _).symm
+
+lemma slope_fun_def_field (f : k → k) (a : k) : slope f a = λ b, (f b - f a) / (b - a) :=
+(div_eq_inv_mul _ _).symm
 
 @[simp] lemma slope_same (f : k → PE) (a : k) : (slope f a a : E) = 0 :=
 by rw [slope, sub_self, inv_zero, zero_smul]
diff --git a/src/linear_algebra/alternating.lean b/src/linear_algebra/alternating.lean
index 29e6fd7c71939..4f23645d2b111 100644
--- a/src/linear_algebra/alternating.lean
+++ b/src/linear_algebra/alternating.lean
@@ -4,17 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser, Zhangir Azerbayev
 -/
 
+import group_theory.group_action.quotient
 import group_theory.perm.sign
 import group_theory.perm.subgroup
-import group_theory.quotient_group
 import linear_algebra.linear_independent
 import linear_algebra.multilinear.basis
 import linear_algebra.multilinear.tensor_product
-import logic.equiv.fin
 
 /-!
 # Alternating Maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct the bundled function `alternating_map`, which extends `multilinear_map` with all the
 arguments of the same type.
 
@@ -25,8 +27,11 @@ arguments of the same type.
 * `f.map_perm` expresses how `f` varies by a sign change under a permutation of its inputs.
 * An `add_comm_monoid`, `add_comm_group`, and `module` structure over `alternating_map`s that
   matches the definitions over `multilinear_map`s.
+* `multilinear_map.dom_dom_congr`, for permutating the elements within a family.
 * `multilinear_map.alternatization`, which makes an alternating map out of a non-alternating one.
 * `alternating_map.dom_coprod`, which behaves as a product between two alternating maps.
+* `alternating_map.curry_left`, for binding the leftmost argument of an alternating map indexed
+  by `fin n.succ`.
 
 ## Implementation notes
 `alternating_map` is defined in terms of `map_eq_zero_of_eq`, as this is easier to work with than
@@ -46,12 +51,13 @@ using `map_swap` as a definition, and does not require `has_neg N`.
 variables {R : Type*} [semiring R]
 variables {M : Type*} [add_comm_monoid M] [module R M]
 variables {N : Type*} [add_comm_monoid N] [module R N]
+variables {P : Type*} [add_comm_monoid P] [module R P]
 
 -- semiring / add_comm_group
 variables {M' : Type*} [add_comm_group M'] [module R M']
 variables {N' : Type*} [add_comm_group N'] [module R N']
 
-variables {ι : Type*} [decidable_eq ι]
+variables {ι ι' ι'' : Type*}
 
 set_option old_structure_cmd true
 
@@ -78,7 +84,12 @@ open function
 /-! Basic coercion simp lemmas, largely copied from `ring_hom` and `multilinear_map` -/
 section coercions
 
-instance : has_coe_to_fun (alternating_map R M N ι) (λ _, (ι → M) → N) := ⟨λ x, x.to_fun⟩
+instance fun_like : fun_like (alternating_map R M N ι) (ι → M) (λ _, N) :=
+{ coe := alternating_map.to_fun,
+  coe_injective' := λ f g h, by { cases f, cases g, congr' } }
+
+-- shortcut instance
+instance : has_coe_to_fun (alternating_map R M N ι) (λ _, (ι → M) → N) := ⟨fun_like.coe⟩
 
 initialize_simps_projections alternating_map (to_fun → apply)
 
@@ -94,14 +105,14 @@ theorem congr_arg (f : alternating_map R M N ι) {x y : ι → M} (h : x = y) :
 congr_arg (λ x : ι → M, f x) h
 
 theorem coe_injective : injective (coe_fn : alternating_map R M N ι → ((ι → M) → N)) :=
-λ f g h, by { cases f, cases g, cases h, refl }
+fun_like.coe_injective
 
 @[simp, norm_cast] theorem coe_inj {f g : alternating_map R M N ι} :
   (f : (ι → M) → N) = g ↔ f = g :=
 coe_injective.eq_iff
 
 @[ext] theorem ext {f f' : alternating_map R M N ι} (H : ∀ x, f x = f' x) : f = f' :=
-coe_injective (funext H)
+fun_like.ext _ _ H
 
 theorem ext_iff {f g : alternating_map R M N ι} : f = g ↔ ∀ x, f x = g x :=
 ⟨λ h x, h ▸ rfl, λ h, ext h⟩
@@ -118,7 +129,8 @@ lemma coe_multilinear_map_injective :
 @[simp] lemma to_multilinear_map_eq_coe : f.to_multilinear_map = f := rfl
 
 @[simp] lemma coe_multilinear_map_mk (f : (ι → M) → N) (h₁ h₂ h₃) :
-  ((⟨f, h₁, h₂, h₃⟩ : alternating_map R M N ι) :  multilinear_map R (λ i : ι, M) N) = ⟨f, h₁, h₂⟩ :=
+  ((⟨f, h₁, h₂, h₃⟩ : alternating_map R M N ι) : multilinear_map R (λ i : ι, M) N)
+    = ⟨f, @h₁, @h₂⟩ :=
 rfl
 
 end coercions
@@ -128,19 +140,19 @@ end coercions
 
 These are expressed in terms of `⇑f` instead of `f.to_fun`.
 -/
-@[simp] lemma map_add (i : ι) (x y : M) :
+@[simp] lemma map_add [decidable_eq ι] (i : ι) (x y : M) :
   f (update v i (x + y)) = f (update v i x) + f (update v i y) :=
 f.to_multilinear_map.map_add' v i x y
 
-@[simp] lemma map_sub (i : ι) (x y : M') :
+@[simp] lemma map_sub [decidable_eq ι] (i : ι) (x y : M') :
   g' (update v' i (x - y)) = g' (update v' i x) - g' (update v' i y) :=
 g'.to_multilinear_map.map_sub v' i x y
 
-@[simp] lemma map_neg (i : ι) (x : M') :
+@[simp] lemma map_neg [decidable_eq ι] (i : ι) (x : M') :
   g' (update v' i (-x)) = -g' (update v' i x) :=
 g'.to_multilinear_map.map_neg v' i x
 
-@[simp] lemma map_smul (i : ι) (r : R) (x : M) :
+@[simp] lemma map_smul [decidable_eq ι] (i : ι) (r : R) (x : M) :
   f (update v i (r • x)) = r • f (update v i x) :=
 f.to_multilinear_map.map_smul' v i r x
 
@@ -151,7 +163,7 @@ f.map_eq_zero_of_eq' v i j h hij
 lemma map_coord_zero {m : ι → M} (i : ι) (h : m i = 0) : f m = 0 :=
 f.to_multilinear_map.map_coord_zero i h
 
-@[simp] lemma map_update_zero (m : ι → M) (i : ι) : f (update m i 0) = 0 :=
+@[simp] lemma map_update_zero [decidable_eq ι] (m : ι → M) (i : ι) : f (update m i 0) = 0 :=
 f.to_multilinear_map.map_update_zero m i
 
 @[simp] lemma map_zero [nonempty ι] : f 0 = 0 :=
@@ -172,11 +184,11 @@ end
 as `multilinear_map`
 -/
 
-section has_scalar
+section has_smul
 
 variables {S : Type*} [monoid S] [distrib_mul_action S N] [smul_comm_class R S N]
 
-instance : has_scalar S (alternating_map R M N ι) :=
+instance : has_smul S (alternating_map R M N ι) :=
 ⟨λ c f,
   { map_eq_zero_of_eq' := λ v i j h hij, by simp [f.map_eq_zero_of_eq v h hij],
     ..((c • f : multilinear_map R (λ i : ι, M) N)) }⟩
@@ -190,7 +202,54 @@ instance : has_scalar S (alternating_map R M N ι) :=
 lemma coe_fn_smul (c : S) (f : alternating_map R M N ι) : ⇑(c • f) = c • f :=
 rfl
 
-end has_scalar
+instance [distrib_mul_action Sᵐᵒᵖ N] [is_central_scalar S N] :
+  is_central_scalar S (alternating_map R M N ι) :=
+⟨λ c f, ext $ λ x, op_smul_eq_smul _ _⟩
+
+end has_smul
+
+/-- The cartesian product of two alternating maps, as a multilinear map. -/
+@[simps { simp_rhs := tt }]
+def prod (f : alternating_map R M N ι) (g : alternating_map R M P ι) :
+  alternating_map R M (N × P) ι :=
+{ map_eq_zero_of_eq' := λ v i j h hne, prod.ext (f.map_eq_zero_of_eq _ h hne)
+    (g.map_eq_zero_of_eq _ h hne),
+  .. f.to_multilinear_map.prod g.to_multilinear_map }
+
+@[simp]
+lemma coe_prod (f : alternating_map R M N ι) (g : alternating_map R M P ι) :
+  (f.prod g : multilinear_map R (λ _ : ι, M) (N × P)) = multilinear_map.prod f g :=
+rfl
+
+/-- Combine a family of alternating maps with the same domain and codomains `N i` into an
+alternating map taking values in the space of functions `Π i, N i`. -/
+@[simps { simp_rhs := tt }]
+def pi {ι' : Type*} {N : ι' → Type*} [∀ i, add_comm_monoid (N i)] [∀ i, module R (N i)]
+  (f : ∀ i, alternating_map R M (N i) ι) : alternating_map R M (∀ i, N i) ι :=
+{ map_eq_zero_of_eq' := λ v i j h hne, funext $ λ a, (f a).map_eq_zero_of_eq _ h hne,
+  .. multilinear_map.pi (λ a, (f a).to_multilinear_map) }
+
+@[simp]
+lemma coe_pi {ι' : Type*} {N : ι' → Type*} [∀ i, add_comm_monoid (N i)]
+  [∀ i, module R (N i)] (f : ∀ i, alternating_map R M (N i) ι) :
+  (pi f : multilinear_map R (λ _ : ι, M) (∀ i, N i)) = multilinear_map.pi (λ a, f a) :=
+rfl
+
+/-- Given an alternating `R`-multilinear map `f` taking values in `R`, `f.smul_right z` is the map
+sending `m` to `f m • z`. -/
+@[simps { simp_rhs := tt }]
+def smul_right {R M₁ M₂ ι : Type*} [comm_semiring R]
+  [add_comm_monoid M₁] [add_comm_monoid M₂] [module R M₁] [module R M₂]
+  (f : alternating_map R M₁ R ι) (z : M₂) : alternating_map R M₁ M₂ ι :=
+{ map_eq_zero_of_eq' := λ v i j h hne, by simp [f.map_eq_zero_of_eq v h hne],
+  .. f.to_multilinear_map.smul_right z }
+
+@[simp]
+lemma coe_smul_right {R M₁ M₂ ι : Type*} [comm_semiring R]
+  [add_comm_monoid M₁] [add_comm_monoid M₂] [module R M₁] [module R M₂]
+  (f : alternating_map R M₁ R ι) (z : M₂) :
+  (f.smul_right z : multilinear_map R (λ _ : ι, M₁) M₂) = multilinear_map.smul_right f z :=
+rfl
 
 instance : has_add (alternating_map R M N ι) :=
 ⟨λ a b,
@@ -268,18 +327,35 @@ coe_injective.no_zero_smul_divisors _ rfl coe_fn_smul
 end module
 
 section
-variables (R N)
+variables (R M)
 
-/-- The evaluation map from `ι → N` to `N` at a given `i` is alternating when `ι` is subsingleton.
+/-- The evaluation map from `ι → M` to `M` at a given `i` is alternating when `ι` is subsingleton.
 -/
 @[simps]
-def of_subsingleton [subsingleton ι] (i : ι) : alternating_map R N N ι :=
+def of_subsingleton [subsingleton ι] (i : ι) : alternating_map R M M ι :=
 { to_fun := function.eval i,
   map_eq_zero_of_eq' := λ v i j hv hij, (hij $ subsingleton.elim _ _).elim,
-  ..multilinear_map.of_subsingleton R N i }
+  ..multilinear_map.of_subsingleton R M i }
+
+variable (ι)
+
+/-- The constant map is alternating when `ι` is empty. -/
+@[simps {fully_applied := ff}]
+def const_of_is_empty [is_empty ι] (m : N) : alternating_map R M N ι :=
+{ to_fun := function.const _ m,
+  map_eq_zero_of_eq' := λ v, is_empty_elim,
+  ..multilinear_map.const_of_is_empty R _ m }
 
 end
 
+/-- Restrict the codomain of an alternating map to a submodule. -/
+@[simps]
+def cod_restrict (f : alternating_map R M N ι) (p : submodule R N) (h : ∀ v, f v ∈ p) :
+  alternating_map R M p ι :=
+{ to_fun := λ v, ⟨f v, h v⟩,
+  map_eq_zero_of_eq' := λ v i j hv hij, subtype.ext $ map_eq_zero_of_eq _ _ hv hij,
+  ..f.to_multilinear_map.cod_restrict p h }
+
 end alternating_map
 
 /-!
@@ -301,9 +377,29 @@ def comp_alternating_map (g : N →ₗ[R] N₂) : alternating_map R M N ι →+
 @[simp] lemma coe_comp_alternating_map (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) :
   ⇑(g.comp_alternating_map f) = g ∘ f := rfl
 
+@[simp]
 lemma comp_alternating_map_apply (g : N →ₗ[R] N₂) (f : alternating_map R M N ι) (m : ι → M) :
   g.comp_alternating_map f m = g (f m) := rfl
 
+lemma smul_right_eq_comp {R M₁ M₂ ι : Type*} [comm_semiring R]
+  [add_comm_monoid M₁] [add_comm_monoid M₂] [module R M₁] [module R M₂]
+  (f : alternating_map R M₁ R ι) (z : M₂) :
+  f.smul_right z = (linear_map.id.smul_right z).comp_alternating_map f :=
+rfl
+
+@[simp]
+lemma subtype_comp_alternating_map_cod_restrict (f : alternating_map R M N ι) (p : submodule R N)
+  (h) :
+  p.subtype.comp_alternating_map (f.cod_restrict p h) = f :=
+alternating_map.ext $ λ v, rfl
+
+@[simp]
+lemma comp_alternating_map_cod_restrict (g : N →ₗ[R] N₂) (f : alternating_map R M N ι)
+  (p : submodule R N₂) (h) :
+  (g.cod_restrict p h).comp_alternating_map f =
+    (g.comp_alternating_map f).cod_restrict p (λ v, h (f v)):=
+alternating_map.ext $ λ v, rfl
+
 end linear_map
 
 namespace alternating_map
@@ -406,7 +502,7 @@ section
 
 open_locale big_operators
 
-lemma map_update_sum {α : Type*} (t : finset α) (i : ι) (g : α → M) (m : ι → M):
+lemma map_update_sum {α : Type*} [decidable_eq ι] (t : finset α) (i : ι) (g : α → M) (m : ι → M) :
   f (update m i (∑ a in t, g a)) = ∑ a in t, f (update m i (g a)) :=
 f.to_multilinear_map.map_update_sum t i g m
 
@@ -419,16 +515,16 @@ Various properties of reordered and repeated inputs which follow from
 `alternating_map.map_eq_zero_of_eq`.
 -/
 
-lemma map_update_self {i j : ι} (hij : i ≠ j) :
+lemma map_update_self [decidable_eq ι] {i j : ι} (hij : i ≠ j) :
   f (function.update v i (v j)) = 0 :=
 f.map_eq_zero_of_eq _ (by rw [function.update_same, function.update_noteq hij.symm]) hij
 
-lemma map_update_update {i j : ι} (hij : i ≠ j) (m : M) :
+lemma map_update_update [decidable_eq ι] {i j : ι} (hij : i ≠ j) (m : M) :
   f (function.update (function.update v i m) j m) = 0 :=
 f.map_eq_zero_of_eq _
   (by rw [function.update_same, function.update_noteq hij, function.update_same]) hij
 
-lemma map_swap_add {i j : ι} (hij : i ≠ j) :
+lemma map_swap_add [decidable_eq ι] {i j : ι} (hij : i ≠ j) :
   f (v ∘ equiv.swap i j) + f v = 0 :=
 begin
   rw equiv.comp_swap_eq_update,
@@ -439,15 +535,14 @@ begin
         function.update_comm hij.symm (v i) (v i) v],
 end
 
-lemma map_add_swap {i j : ι} (hij : i ≠ j) :
+lemma map_add_swap [decidable_eq ι] {i j : ι} (hij : i ≠ j) :
   f v + f (v ∘ equiv.swap i j) = 0 :=
 by { rw add_comm, exact f.map_swap_add v hij }
 
-lemma map_swap {i j : ι} (hij : i ≠ j) :
-  g (v ∘ equiv.swap i j) = - g v  :=
-eq_neg_of_add_eq_zero (g.map_swap_add v hij)
+lemma map_swap [decidable_eq ι] {i j : ι} (hij : i ≠ j) : g (v ∘ equiv.swap i j) = - g v :=
+eq_neg_of_add_eq_zero_left $ g.map_swap_add v hij
 
-lemma map_perm [fintype ι] (v : ι → M) (σ : equiv.perm ι) :
+lemma map_perm [decidable_eq ι] [fintype ι] (v : ι → M) (σ : equiv.perm ι) :
   g (v ∘ σ) = σ.sign • g v :=
 begin
   apply equiv.perm.swap_induction_on' σ,
@@ -456,14 +551,96 @@ begin
     simpa [g.map_swap (v ∘ s) hxy, equiv.perm.sign_swap hxy] using hI, }
 end
 
-lemma map_congr_perm [fintype ι] (σ : equiv.perm ι) :
+lemma map_congr_perm [decidable_eq ι] [fintype ι] (σ : equiv.perm ι) :
   g v = σ.sign • g (v ∘ σ) :=
 by { rw [g.map_perm, smul_smul], simp }
 
-lemma coe_dom_dom_congr [fintype ι] (σ : equiv.perm ι) :
-  (g : multilinear_map R (λ _ : ι, M) N').dom_dom_congr σ
-    = σ.sign • (g : multilinear_map R (λ _ : ι, M) N') :=
-multilinear_map.ext $ λ v, g.map_perm v σ
+section dom_dom_congr
+
+/-- Transfer the arguments to a map along an equivalence between argument indices.
+
+This is the alternating version of `multilinear_map.dom_dom_congr`. -/
+@[simps]
+def dom_dom_congr (σ : ι ≃ ι') (f : alternating_map R M N ι) : alternating_map R M N ι' :=
+{ to_fun := λ v, f (v ∘ σ),
+  map_eq_zero_of_eq' := λ v i j hv hij,
+    f.map_eq_zero_of_eq (v ∘ σ) (by simpa using hv) (σ.symm.injective.ne hij),
+  .. f.to_multilinear_map.dom_dom_congr σ }
+
+@[simp] lemma dom_dom_congr_refl (f : alternating_map R M N ι) :
+  f.dom_dom_congr (equiv.refl ι) = f := ext $ λ v, rfl
+
+lemma dom_dom_congr_trans (σ₁ : ι ≃ ι') (σ₂ : ι' ≃ ι'') (f : alternating_map R M N ι) :
+  f.dom_dom_congr (σ₁.trans σ₂) = (f.dom_dom_congr σ₁).dom_dom_congr σ₂ := rfl
+
+@[simp] lemma dom_dom_congr_zero (σ : ι ≃ ι') :
+  (0 : alternating_map R M N ι).dom_dom_congr σ = 0 :=
+rfl
+
+@[simp] lemma dom_dom_congr_add (σ : ι ≃ ι') (f g : alternating_map R M N ι) :
+  (f + g).dom_dom_congr σ = f.dom_dom_congr σ + g.dom_dom_congr σ :=
+rfl
+
+@[simp] lemma dom_dom_congr_smul {S : Type*}
+  [monoid S] [distrib_mul_action S N] [smul_comm_class R S N] (σ : ι ≃ ι') (c : S)
+  (f : alternating_map R M N ι) :
+  (c • f).dom_dom_congr σ = c • f.dom_dom_congr σ :=
+rfl
+
+/-- `alternating_map.dom_dom_congr` as an equivalence.
+
+This is declared separately because it does not work with dot notation. -/
+@[simps apply symm_apply]
+def dom_dom_congr_equiv (σ : ι ≃ ι') :
+  alternating_map R M N ι ≃+ alternating_map R M N ι' :=
+{ to_fun := dom_dom_congr σ,
+  inv_fun := dom_dom_congr σ.symm,
+  left_inv := λ f, by { ext, simp [function.comp] },
+  right_inv := λ m, by { ext, simp [function.comp] },
+  map_add' := dom_dom_congr_add σ }
+
+section dom_dom_lcongr
+variables (S : Type*) [semiring S] [module S N] [smul_comm_class R S N]
+
+/-- `alternating_map.dom_dom_congr` as a linear equivalence. -/
+@[simps apply symm_apply]
+def dom_dom_lcongr (σ : ι ≃ ι') : alternating_map R M N ι ≃ₗ[S] alternating_map R M N ι' :=
+{ to_fun := dom_dom_congr σ,
+  inv_fun := dom_dom_congr σ.symm,
+  left_inv := λ f, by { ext, simp [function.comp] },
+  right_inv := λ m, by { ext, simp [function.comp] },
+  map_add' := dom_dom_congr_add σ,
+  map_smul' := dom_dom_congr_smul σ }
+
+@[simp] lemma dom_dom_lcongr_refl :
+  (dom_dom_lcongr S (equiv.refl ι) : alternating_map R M N ι ≃ₗ[S] alternating_map R M N ι) =
+    linear_equiv.refl _ _ :=
+linear_equiv.ext dom_dom_congr_refl
+
+@[simp] lemma dom_dom_lcongr_to_add_equiv (σ : ι ≃ ι') :
+  (dom_dom_lcongr S σ : alternating_map R M N ι ≃ₗ[S] alternating_map R M N ι').to_add_equiv
+    = dom_dom_congr_equiv σ := rfl
+
+end dom_dom_lcongr
+
+/-- The results of applying `dom_dom_congr` to two maps are equal if and only if those maps are. -/
+@[simp] lemma dom_dom_congr_eq_iff (σ : ι ≃ ι') (f g : alternating_map R M N ι) :
+  f.dom_dom_congr σ = g.dom_dom_congr σ ↔ f = g :=
+(dom_dom_congr_equiv σ : _ ≃+ alternating_map R M N ι').apply_eq_iff_eq
+
+@[simp] lemma dom_dom_congr_eq_zero_iff (σ : ι ≃ ι') (f : alternating_map R M N ι) :
+  f.dom_dom_congr σ = 0 ↔ f = 0 :=
+(dom_dom_congr_equiv σ : alternating_map R M N ι ≃+ alternating_map R M N ι').map_eq_zero_iff
+
+lemma dom_dom_congr_perm [fintype ι] [decidable_eq ι] (σ : equiv.perm ι) :
+  g.dom_dom_congr σ = σ.sign • g :=
+alternating_map.ext $ λ v, g.map_perm v σ
+
+@[norm_cast] lemma coe_dom_dom_congr (σ : ι ≃ ι') :
+  ↑(f.dom_dom_congr σ) = (f : multilinear_map R (λ _ : ι, M) N).dom_dom_congr σ :=
+multilinear_map.ext $ λ v, rfl
+
+end dom_dom_congr
 
 /-- If the arguments are linearly dependent then the result is `0`. -/
 lemma map_linear_dependent
@@ -475,6 +652,7 @@ lemma map_linear_dependent
   f v = 0 :=
 begin
   obtain ⟨s, g, h, i, hi, hz⟩ := not_linear_independent_iff.mp h,
+  letI := classical.dec_eq ι,
   suffices : f (update v i (g i • v i)) = 0,
   { rw [f.map_smul, function.update_eq_self, smul_eq_zero] at this,
     exact or.resolve_left this hz, },
@@ -487,6 +665,22 @@ begin
   rw [f.map_smul, f.map_update_self _ hij.symm, smul_zero],
 end
 
+section fin
+open fin
+
+/-- A version of `multilinear_map.cons_add` for `alternating_map`. -/
+lemma map_vec_cons_add {n : ℕ} (f : alternating_map R M N (fin n.succ)) (m : fin n → M) (x y : M) :
+  f (matrix.vec_cons (x+y) m) = f (matrix.vec_cons x m) + f (matrix.vec_cons y m) :=
+f.to_multilinear_map.cons_add _ _ _
+
+/-- A version of `multilinear_map.cons_smul` for `alternating_map`. -/
+lemma map_vec_cons_smul {n : ℕ} (f : alternating_map R M N (fin n.succ)) (m : fin n → M)
+  (c : R) (x : M) :
+  f (matrix.vec_cons (c • x) m) = c • f (matrix.vec_cons x m) :=
+f.to_multilinear_map.cons_smul _ _ _
+
+end fin
+
 end alternating_map
 
 open_locale big_operators
@@ -495,7 +689,7 @@ namespace multilinear_map
 
 open equiv
 
-variables [fintype ι]
+variables [fintype ι] [decidable_eq ι]
 
 private lemma alternization_map_eq_zero_of_eq_aux
   (m : multilinear_map R (λ i : ι, M) N')
@@ -549,12 +743,12 @@ namespace alternating_map
 
 /-- Alternatizing a multilinear map that is already alternating results in a scale factor of `n!`,
 where `n` is the number of inputs. -/
-lemma coe_alternatization [fintype ι] (a : alternating_map R M N' ι) :
+lemma coe_alternatization [decidable_eq ι] [fintype ι] (a : alternating_map R M N' ι) :
   (↑a : multilinear_map R (λ ι, M) N').alternatization = nat.factorial (fintype.card ι) • a :=
 begin
   apply alternating_map.coe_injective,
-  simp_rw [multilinear_map.alternatization_def, coe_dom_dom_congr, smul_smul,
-    int.units_mul_self, one_smul, finset.sum_const, finset.card_univ, fintype.card_perm,
+  simp_rw [multilinear_map.alternatization_def, ←coe_dom_dom_congr, dom_dom_congr_perm, coe_smul,
+    smul_smul, int.units_mul_self, one_smul, finset.sum_const, finset.card_univ, fintype.card_perm,
     ←coe_multilinear_map, coe_smul],
 end
 
@@ -562,7 +756,7 @@ end alternating_map
 
 namespace linear_map
 
-variables {N'₂ : Type*} [add_comm_group N'₂] [module R N'₂] [fintype ι]
+variables {N'₂ : Type*} [add_comm_group N'₂] [module R N'₂] [decidable_eq ι] [fintype ι]
 
 /-- Composition with a linear map before and after alternatization are equivalent. -/
 lemma comp_multilinear_map_alternatization (g : N' →ₗ[R] N'₂)
@@ -577,7 +771,7 @@ section coprod
 open_locale big_operators
 open_locale tensor_product
 
-variables {ιa ιb : Type*} [decidable_eq ιa] [decidable_eq ιb] [fintype ιa] [fintype ιb]
+variables {ιa ιb : Type*}[fintype ιa] [fintype ιb]
 
 variables
   {R' : Type*} {Mᵢ N₁ N₂ : Type*}
@@ -593,7 +787,7 @@ abbreviation mod_sum_congr (α β : Type*) :=
 _ ⧸ (equiv.perm.sum_congr_hom α β).range
 
 lemma mod_sum_congr.swap_smul_involutive {α β : Type*} [decidable_eq (α ⊕ β)] (i j : α ⊕ β) :
-  function.involutive (has_scalar.smul (equiv.swap i j) : mod_sum_congr α β → mod_sum_congr α β) :=
+  function.involutive (has_smul.smul (equiv.swap i j) : mod_sum_congr α β → mod_sum_congr α β) :=
 λ σ, begin
   apply σ.induction_on' (λ σ, _),
   exact _root_.congr_arg quotient.mk' (equiv.swap_mul_involutive i j σ)
@@ -603,6 +797,7 @@ end equiv.perm
 
 namespace alternating_map
 open equiv
+variables [decidable_eq ιa] [decidable_eq ιb]
 
 /-- summand used in `alternating_map.dom_coprod` -/
 def dom_coprod.summand
@@ -613,11 +808,13 @@ quotient.lift_on' σ
   (λ σ,
     σ.sign •
       (multilinear_map.dom_coprod ↑a ↑b : multilinear_map R' (λ _, Mᵢ) (N₁ ⊗ N₂)).dom_dom_congr σ)
-  (λ σ₁ σ₂ ⟨⟨sl, sr⟩, h⟩, begin
+  (λ σ₁ σ₂ H, begin
+    rw quotient_group.left_rel_apply at H,
+    obtain ⟨⟨sl, sr⟩, h⟩ := H,
     ext v,
     simp only [multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply,
       coe_multilinear_map, multilinear_map.smul_apply],
-    replace h := inv_mul_eq_iff_eq_mul.mp h.symm,
+    replace h := inv_mul_eq_iff_eq_mul.mp (h.symm),
     have : (σ₁ * perm.sum_congr_hom _ _ (sl, sr)).sign = σ₁.sign * (sl.sign * sr.sign) :=
       by simp,
     rw [h, this, mul_smul, mul_smul, smul_left_cancel_iff,
@@ -664,22 +861,25 @@ begin
   dsimp only [quotient.lift_on'_mk', quotient.map'_mk', multilinear_map.smul_apply,
     multilinear_map.dom_dom_congr_apply, multilinear_map.dom_coprod_apply, dom_coprod.summand],
   intro hσ,
-  with_cases
-  { cases hi : σ⁻¹ i;
-      cases hj : σ⁻¹ j;
-      rw perm.inv_eq_iff_eq at hi hj;
-      substs hi hj, },
-  case [sum.inl sum.inr : i' j', sum.inr sum.inl : i' j']
+  cases hi : σ⁻¹ i;
+    cases hj : σ⁻¹ j;
+    rw perm.inv_eq_iff_eq at hi hj;
+  substs hi hj; revert val val_1,
+  case [sum.inl sum.inr, sum.inr sum.inl]
   { -- the term pairs with and cancels another term
-    all_goals { obtain ⟨⟨sl, sr⟩, hσ⟩ := quotient.exact' hσ, },
+    all_goals {
+      intros i' j' hv hij hσ,
+      obtain ⟨⟨sl, sr⟩, hσ⟩ := quotient_group.left_rel_apply.mp (quotient.exact' hσ), },
     work_on_goal 1 { replace hσ := equiv.congr_fun hσ (sum.inl i'), },
     work_on_goal 2 { replace hσ := equiv.congr_fun hσ (sum.inr i'), },
     all_goals
     { rw [smul_eq_mul, ←mul_swap_eq_swap_mul, mul_inv_rev, swap_inv, inv_mul_cancel_right] at hσ,
       simpa using hσ, }, },
-  case [sum.inr sum.inr : i' j', sum.inl sum.inl : i' j']
+  case [sum.inr sum.inr, sum.inl sum.inl]
   { -- the term does not pair but is zero
-    all_goals { convert smul_zero _, },
+    all_goals {
+      intros i' j' hv hij hσ,
+      convert smul_zero _, },
     work_on_goal 1 { convert tensor_product.tmul_zero _ _, },
     work_on_goal 2 { convert tensor_product.zero_tmul _ _, },
     all_goals { exact alternating_map.map_eq_zero_of_eq _ _ hv (λ hij', hij (hij' ▸ rfl)), } },
@@ -703,7 +903,7 @@ Here, we generalize this by replacing:
 * the additions in the subscripts of $\sigma$ with an index of type `sum`
 
 The specialized version can be obtained by combining this definition with `fin_sum_fin_equiv` and
-`algebra.lmul'`.
+`linear_map.mul'`.
 -/
 @[simps]
 def dom_coprod
@@ -755,14 +955,14 @@ tensor_product.lift $ by
 lemma dom_coprod'_apply
   (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
   dom_coprod' (a ⊗ₜ[R'] b) = dom_coprod a b :=
-by simp only [dom_coprod', tensor_product.lift.tmul, linear_map.mk₂_apply]
+rfl
 
 end alternating_map
 
 open equiv
 
 /-- A helper lemma for `multilinear_map.dom_coprod_alternization`. -/
-lemma multilinear_map.dom_coprod_alternization_coe
+lemma multilinear_map.dom_coprod_alternization_coe [decidable_eq ιa] [decidable_eq ιb]
   (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
   multilinear_map.dom_coprod ↑a.alternatization ↑b.alternatization =
     ∑ (σa : perm ιa) (σb : perm ιb), σa.sign • σb.sign •
@@ -778,7 +978,7 @@ open alternating_map
 /-- Computing the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` is the same
 as computing the `alternating_map.dom_coprod` of the `multilinear_map.alternatization`s.
 -/
-lemma multilinear_map.dom_coprod_alternization
+lemma multilinear_map.dom_coprod_alternization [decidable_eq ιa] [decidable_eq ιb]
   (a : multilinear_map R' (λ _ : ιa, Mᵢ) N₁) (b : multilinear_map R' (λ _ : ιb, Mᵢ) N₂) :
   (multilinear_map.dom_coprod a b).alternatization =
     a.alternatization.dom_coprod b.alternatization :=
@@ -793,22 +993,13 @@ begin
   -- unfold the quotient mess left by `finset.sum_partition`
   conv in (_ = quotient.mk' _)
   { change quotient.mk' _ = quotient.mk' _,
-    rw quotient.eq',
-    rw [quotient_group.left_rel],
-    dsimp only [setoid.r] },
+    rw quotient_group.eq' },
 
   -- eliminate a multiplication
-  have : @finset.univ (perm (ιa ⊕ ιb)) _ = finset.univ.image ((*) σ) :=
-    (finset.eq_univ_iff_forall.mpr $ λ a, let ⟨a', ha'⟩ := mul_left_surjective σ a in
-      finset.mem_image.mpr ⟨a', finset.mem_univ _, ha'⟩).symm,
-  rw [this, finset.image_filter],
-  simp only [function.comp, mul_inv_rev, inv_mul_cancel_right, subgroup.inv_mem_iff],
-  simp only [monoid_hom.mem_range], -- needs to be separate from the above `simp only`
-  rw [finset.filter_congr_decidable,
-    finset.univ_filter_exists (perm.sum_congr_hom ιa ιb),
-    finset.sum_image (λ x _ y _ (h : _ = _), mul_right_injective _ h),
-    finset.sum_image (λ x _ y _ (h : _ = _), perm.sum_congr_hom_injective h)],
-  dsimp only,
+  rw [← finset.map_univ_equiv (equiv.mul_left σ), finset.filter_map, finset.sum_map],
+  simp_rw [equiv.coe_to_embedding, equiv.coe_mul_left, (∘), mul_inv_rev, inv_mul_cancel_right,
+    subgroup.inv_mem_iff, monoid_hom.mem_range, finset.univ_filter_exists,
+    finset.sum_image (perm.sum_congr_hom_injective.inj_on _)],
 
   -- now we're ready to clean up the RHS, pulling out the summation
   rw [dom_coprod.summand_mk', multilinear_map.dom_coprod_alternization_coe,
@@ -834,7 +1025,7 @@ end
 /-- Taking the `multilinear_map.alternatization` of the `multilinear_map.dom_coprod` of two
 `alternating_map`s gives a scaled version of the `alternating_map.coprod` of those maps.
 -/
-lemma multilinear_map.dom_coprod_alternization_eq
+lemma multilinear_map.dom_coprod_alternization_eq [decidable_eq ιa] [decidable_eq ιb]
   (a : alternating_map R' Mᵢ N₁ ιa) (b : alternating_map R' Mᵢ N₂ ιb) :
   (multilinear_map.dom_coprod a b : multilinear_map R' (λ _ : ιa ⊕ ιb, Mᵢ) (N₁ ⊗ N₂))
     .alternatization =
@@ -853,7 +1044,7 @@ section basis
 
 open alternating_map
 
-variables {ι₁ : Type*} [fintype ι]
+variables {ι₁ : Type*} [finite ι]
 variables {R' : Type*} {N₁ N₂ : Type*} [comm_semiring R'] [add_comm_monoid N₁] [add_comm_monoid N₂]
 variables [module R' N₁] [module R' N₂]
 
@@ -862,6 +1053,7 @@ are distinct basis vectors. -/
 lemma basis.ext_alternating {f g : alternating_map R' N₁ N₂ ι} (e : basis ι₁ R' N₁)
   (h : ∀ v : ι → ι₁, function.injective v → f (λ i, e (v i)) = g (λ i, e (v i))) : f = g :=
 begin
+  classical,
   refine alternating_map.coe_multilinear_map_injective (basis.ext_multilinear e $ λ v, _),
   by_cases hi : function.injective v,
   { exact h v hi },
@@ -871,3 +1063,84 @@ begin
 end
 
 end basis
+
+/-! ### Currying -/
+
+section currying
+
+variables
+  {R' : Type*} {M'' M₂'' N'' N₂'': Type*}
+  [comm_semiring R']
+  [add_comm_monoid M''] [add_comm_monoid M₂''] [add_comm_monoid N''] [add_comm_monoid N₂'']
+  [module R' M''] [module R' M₂''] [module R' N''] [module R' N₂'']
+
+namespace alternating_map
+
+/-- Given an alternating map `f` in `n+1` variables, split the first variable to obtain
+a linear map into alternating maps in `n` variables, given by `x ↦ (m ↦ f (matrix.vec_cons x m))`.
+It can be thought of as a map $Hom(\bigwedge^{n+1} M, N) \to Hom(M, Hom(\bigwedge^n M, N))$.
+
+This is `multilinear_map.curry_left` for `alternating_map`. See also
+`alternating_map.curry_left_linear_map`. -/
+@[simps]
+def curry_left {n : ℕ} (f : alternating_map R' M'' N'' (fin n.succ)) :
+  M'' →ₗ[R'] alternating_map R' M'' N'' (fin n) :=
+{ to_fun := λ m,
+  { to_fun    := λ v, f (matrix.vec_cons m v),
+    map_eq_zero_of_eq' := λ v i j hv hij, f.map_eq_zero_of_eq _
+      (by rwa [matrix.cons_val_succ, matrix.cons_val_succ]) ((fin.succ_injective _).ne hij),
+    .. f.to_multilinear_map.curry_left m },
+  map_add' := λ m₁ m₂, ext $ λ v, f.map_vec_cons_add _ _ _,
+  map_smul' := λ r m, ext $ λ v, f.map_vec_cons_smul _ _ _ }
+
+@[simp] lemma curry_left_zero {n : ℕ} :
+  curry_left (0 : alternating_map R' M'' N'' (fin n.succ)) = 0 := rfl
+
+@[simp] lemma curry_left_add {n : ℕ} (f g : alternating_map R' M'' N'' (fin n.succ)) :
+  curry_left (f + g) = curry_left f + curry_left g := rfl
+
+@[simp] lemma curry_left_smul {n : ℕ} (r : R') (f : alternating_map R' M'' N'' (fin n.succ)) :
+  curry_left (r • f) = r • curry_left f := rfl
+
+/-- `alternating_map.curry_left` as a `linear_map`. This is a separate definition as dot notation
+does not work for this version. -/
+@[simps]
+def curry_left_linear_map {n : ℕ} :
+  alternating_map R' M'' N'' (fin n.succ) →ₗ[R'] M'' →ₗ[R'] alternating_map R' M'' N'' (fin n) :=
+{ to_fun := λ f, f.curry_left,
+  map_add' := curry_left_add,
+  map_smul' := curry_left_smul }
+
+/-- Currying with the same element twice gives the zero map. -/
+@[simp] lemma curry_left_same {n : ℕ} (f : alternating_map R' M'' N'' (fin n.succ.succ)) (m : M'') :
+  (f.curry_left m).curry_left m = 0 :=
+ext $ λ x, f.map_eq_zero_of_eq _ (by simp) fin.zero_ne_one
+
+@[simp] lemma curry_left_comp_alternating_map {n : ℕ} (g : N'' →ₗ[R'] N₂'')
+  (f : alternating_map R' M'' N'' (fin n.succ)) (m : M'') :
+  (g.comp_alternating_map f).curry_left m = g.comp_alternating_map (f.curry_left m) :=
+rfl
+
+@[simp] lemma curry_left_comp_linear_map {n : ℕ} (g : M₂'' →ₗ[R'] M'')
+  (f : alternating_map R' M'' N'' (fin n.succ)) (m : M₂'') :
+  (f.comp_linear_map g).curry_left m = (f.curry_left (g m)).comp_linear_map g :=
+ext $ λ v, congr_arg f $ funext $ begin
+  refine fin.cases _ _,
+  { refl },
+  { simp }
+end
+
+/-- The space of constant maps is equivalent to the space of maps that are alternating with respect
+to an empty family. -/
+@[simps] def const_linear_equiv_of_is_empty [is_empty ι] :
+  N'' ≃ₗ[R'] alternating_map R' M'' N'' ι :=
+{ to_fun    := alternating_map.const_of_is_empty R' M'' ι,
+  map_add'  := λ x y, rfl,
+  map_smul' := λ t x, rfl,
+  inv_fun   := λ f, f 0,
+  left_inv  := λ _, rfl,
+  right_inv := λ f, ext $ λ x, alternating_map.congr_arg f $ subsingleton.elim _ _ }
+
+end alternating_map
+
+end currying
diff --git a/src/linear_algebra/annihilating_polynomial.lean b/src/linear_algebra/annihilating_polynomial.lean
new file mode 100644
index 0000000000000..26a8531effd23
--- /dev/null
+++ b/src/linear_algebra/annihilating_polynomial.lean
@@ -0,0 +1,179 @@
+/-
+Copyright (c) 2022 Justin Thomas. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Justin Thomas
+-/
+import field_theory.minpoly.field
+import ring_theory.principal_ideal_domain
+
+/-!
+# Annihilating Ideal
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a commutative ring `R` and an `R`-algebra `A`
+Every element `a : A` defines
+an ideal `polynomial.ann_ideal a ⊆ R[X]`.
+Simply put, this is the set of polynomials `p` where
+the polynomial evaluation `p(a)` is 0.
+
+## Special case where the ground ring is a field
+
+In the special case that `R` is a field, we use the notation `R = 𝕜`.
+Here `𝕜[X]` is a PID, so there is a polynomial `g ∈ polynomial.ann_ideal a`
+which generates the ideal. We show that if this generator is
+chosen to be monic, then it is the minimal polynomial of `a`,
+as defined in `field_theory.minpoly`.
+
+## Special case: endomorphism algebra
+
+Given an `R`-module `M` (`[add_comm_group M] [module R M]`)
+there are some common specializations which may be more familiar.
+* Example 1: `A = M →ₗ[R] M`, the endomorphism algebra of an `R`-module M.
+* Example 2: `A = n × n` matrices with entries in `R`.
+-/
+
+open_locale polynomial
+
+namespace polynomial
+
+section semiring
+
+variables {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
+
+variables (R)
+
+/-- `ann_ideal R a` is the *annihilating ideal* of all `p : R[X]` such that `p(a) = 0`.
+
+The informal notation `p(a)` stand for `polynomial.aeval a p`.
+Again informally, the annihilating ideal of `a` is
+`{ p ∈ R[X] | p(a) = 0 }`. This is an ideal in `R[X]`.
+The formal definition uses the kernel of the aeval map. -/
+noncomputable def ann_ideal (a : A) : ideal R[X] :=
+((aeval a).to_ring_hom : R[X] →+* A).ker
+
+variables {R}
+
+/-- It is useful to refer to ideal membership sometimes
+ and the annihilation condition other times. -/
+lemma mem_ann_ideal_iff_aeval_eq_zero {a : A} {p : R[X]} :
+  p ∈ ann_ideal R a ↔ aeval a p = 0 :=
+iff.rfl
+
+end semiring
+
+section field
+
+variables {𝕜 A : Type*} [field 𝕜] [ring A] [algebra 𝕜 A]
+variable (𝕜)
+
+open submodule
+
+/-- `ann_ideal_generator 𝕜 a` is the monic generator of `ann_ideal 𝕜 a`
+if one exists, otherwise `0`.
+
+Since `𝕜[X]` is a principal ideal domain there is a polynomial `g` such that
+ `span 𝕜 {g} = ann_ideal a`. This picks some generator.
+ We prefer the monic generator of the ideal. -/
+noncomputable def ann_ideal_generator (a : A) : 𝕜[X] :=
+let g := is_principal.generator $ ann_ideal 𝕜 a
+  in g * (C g.leading_coeff⁻¹)
+
+section
+
+variables {𝕜}
+
+@[simp] lemma ann_ideal_generator_eq_zero_iff {a : A} :
+  ann_ideal_generator 𝕜 a = 0 ↔ ann_ideal 𝕜 a = ⊥ :=
+by simp only [ann_ideal_generator, mul_eq_zero, is_principal.eq_bot_iff_generator_eq_zero,
+  polynomial.C_eq_zero, inv_eq_zero, polynomial.leading_coeff_eq_zero, or_self]
+end
+
+/-- `ann_ideal_generator 𝕜 a` is indeed a generator. -/
+@[simp] lemma span_singleton_ann_ideal_generator (a : A) :
+  ideal.span {ann_ideal_generator 𝕜 a} = ann_ideal 𝕜 a :=
+begin
+  by_cases h : ann_ideal_generator 𝕜 a = 0,
+  { rw [h, ann_ideal_generator_eq_zero_iff.mp h, set.singleton_zero, ideal.span_zero] },
+  { rw [ann_ideal_generator, ideal.span_singleton_mul_right_unit, ideal.span_singleton_generator],
+    apply polynomial.is_unit_C.mpr,
+    apply is_unit.mk0,
+    apply inv_eq_zero.not.mpr,
+    apply polynomial.leading_coeff_eq_zero.not.mpr,
+    apply (mul_ne_zero_iff.mp h).1 }
+end
+
+/-- The annihilating ideal generator is a member of the annihilating ideal. -/
+lemma ann_ideal_generator_mem (a : A) : ann_ideal_generator 𝕜 a ∈ ann_ideal 𝕜 a :=
+ideal.mul_mem_right _ _ (submodule.is_principal.generator_mem _)
+
+lemma mem_iff_eq_smul_ann_ideal_generator {p : 𝕜[X]} (a : A) :
+  p ∈ ann_ideal 𝕜 a ↔ ∃ s : 𝕜[X], p = s • ann_ideal_generator 𝕜 a :=
+by simp_rw [@eq_comm _ p, ← mem_span_singleton, ← span_singleton_ann_ideal_generator 𝕜 a,
+ ideal.span]
+
+/-- The generator we chose for the annihilating ideal is monic when the ideal is non-zero. -/
+lemma monic_ann_ideal_generator (a : A) (hg : ann_ideal_generator 𝕜 a ≠ 0) :
+  monic (ann_ideal_generator 𝕜 a) :=
+monic_mul_leading_coeff_inv (mul_ne_zero_iff.mp hg).1
+
+/-! We are working toward showing the generator of the annihilating ideal
+in the field case is the minimal polynomial. We are going to use a uniqueness
+theorem of the minimal polynomial.
+
+This is the first condition: it must annihilate the original element `a : A`. -/
+lemma ann_ideal_generator_aeval_eq_zero (a : A) :
+  aeval a (ann_ideal_generator 𝕜 a) = 0 :=
+mem_ann_ideal_iff_aeval_eq_zero.mp (ann_ideal_generator_mem 𝕜 a)
+
+variables {𝕜}
+
+lemma mem_iff_ann_ideal_generator_dvd {p : 𝕜[X]} {a : A} :
+  p ∈ ann_ideal 𝕜 a ↔ ann_ideal_generator 𝕜 a ∣ p :=
+by rw [← ideal.mem_span_singleton, span_singleton_ann_ideal_generator]
+
+/-- The generator of the annihilating ideal has minimal degree among
+ the non-zero members of the annihilating ideal -/
+lemma degree_ann_ideal_generator_le_of_mem (a : A) (p : 𝕜[X])
+  (hp : p ∈ ann_ideal 𝕜 a) (hpn0 : p ≠ 0) :
+  degree (ann_ideal_generator 𝕜 a) ≤ degree p :=
+degree_le_of_dvd (mem_iff_ann_ideal_generator_dvd.1 hp) hpn0
+
+variables (𝕜)
+
+/-- The generator of the annihilating ideal is the minimal polynomial. -/
+lemma ann_ideal_generator_eq_minpoly (a : A) :
+  ann_ideal_generator 𝕜 a = minpoly 𝕜 a :=
+begin
+  by_cases h : ann_ideal_generator 𝕜 a = 0,
+  { rw [h, minpoly.eq_zero],
+    rintro ⟨p, p_monic, (hp : aeval a p = 0)⟩,
+    refine p_monic.ne_zero (ideal.mem_bot.mp _),
+    simpa only [ann_ideal_generator_eq_zero_iff.mp h]
+      using mem_ann_ideal_iff_aeval_eq_zero.mpr hp },
+  { exact minpoly.unique _ _
+      (monic_ann_ideal_generator _ _ h)
+      (ann_ideal_generator_aeval_eq_zero _ _)
+      (λ q q_monic hq, (degree_ann_ideal_generator_le_of_mem a q
+        (mem_ann_ideal_iff_aeval_eq_zero.mpr hq)
+        q_monic.ne_zero)) }
+end
+
+/-- If a monic generates the annihilating ideal, it must match our choice
+ of the annihilating ideal generator. -/
+lemma monic_generator_eq_minpoly (a : A) (p : 𝕜[X])
+  (p_monic : p.monic) (p_gen : ideal.span {p} = ann_ideal 𝕜 a) :
+  ann_ideal_generator 𝕜 a = p :=
+begin
+  by_cases h : p = 0,
+  { rwa [h, ann_ideal_generator_eq_zero_iff, ← p_gen, ideal.span_singleton_eq_bot.mpr], },
+  { rw [← span_singleton_ann_ideal_generator, ideal.span_singleton_eq_span_singleton] at p_gen,
+    rw eq_comm,
+    apply eq_of_monic_of_associated p_monic _ p_gen,
+    { apply monic_ann_ideal_generator _ _ ((associated.ne_zero_iff p_gen).mp h), }, },
+end
+
+end field
+
+end polynomial
diff --git a/src/linear_algebra/basic.lean b/src/linear_algebra/basic.lean
index 0ced615b7222f..75b5ff14f46e1 100644
--- a/src/linear_algebra/basic.lean
+++ b/src/linear_algebra/basic.lean
@@ -7,14 +7,16 @@ Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Fréd
 import algebra.big_operators.pi
 import algebra.module.hom
 import algebra.module.prod
-import algebra.module.submodule_lattice
+import algebra.module.submodule.lattice
 import data.dfinsupp.basic
 import data.finsupp.basic
-import order.compactly_generated
 
 /-!
 # Linear algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the basics of linear algebra. It sets up the "categorical/lattice structure" of
 modules over a ring, submodules, and linear maps.
 
@@ -26,7 +28,6 @@ Many of the relevant definitions, including `module`, `submodule`, and `linear_m
 * Many constructors for (semi)linear maps
 * The kernel `ker` and range `range` of a linear map are submodules of the domain and codomain
   respectively.
-* The general linear group is defined to be the group of invertible linear maps from `M` to itself.
 
 See `linear_algebra.span` for the span of a set (as a submodule),
 and `linear_algebra.quotient` for quotients by submodules.
@@ -69,7 +70,7 @@ variables {V : Type*} {V₂ : Type*}
 namespace finsupp
 
 lemma smul_sum {α : Type*} {β : Type*} {R : Type*} {M : Type*}
-  [has_zero β] [monoid R] [add_comm_monoid M] [distrib_mul_action R M]
+  [has_zero β] [add_comm_monoid M] [distrib_smul R M]
   {v : α →₀ β} {c : R} {h : α → β → M} :
   c • (v.sum h) = v.sum (λa b, c • h a b) :=
 finset.smul_sum
@@ -81,54 +82,57 @@ lemma sum_smul_index_linear_map' {α : Type*} {R : Type*} {M : Type*} {M₂ : Ty
   (c • v).sum (λ a, h a) = c • (v.sum (λ a, h a)) :=
 begin
   rw [finsupp.sum_smul_index', finsupp.smul_sum],
-  { simp only [linear_map.map_smul], },
+  { simp only [map_smul], },
   { intro i, exact (h i).map_zero },
 end
 
-variables (α : Type*) [fintype α]
+variables (α : Type*) [finite α]
 variables (R M) [add_comm_monoid M] [semiring R] [module R M]
 
-/-- Given `fintype α`, `linear_equiv_fun_on_fintype R` is the natural `R`-linear equivalence between
+/-- Given `finite α`, `linear_equiv_fun_on_finite R` is the natural `R`-linear equivalence between
 `α →₀ β` and `α → β`. -/
-@[simps apply] noncomputable def linear_equiv_fun_on_fintype :
+@[simps apply] noncomputable def linear_equiv_fun_on_finite :
   (α →₀ M) ≃ₗ[R] (α → M) :=
 { to_fun := coe_fn,
-  map_add' := λ f g, by { ext, refl },
-  map_smul' := λ c f, by { ext, refl },
-  .. equiv_fun_on_fintype }
+  map_add' := λ f g, rfl,
+  map_smul' := λ c f, rfl,
+  .. equiv_fun_on_finite }
 
-@[simp] lemma linear_equiv_fun_on_fintype_single [decidable_eq α] (x : α) (m : M) :
-  (linear_equiv_fun_on_fintype R M α) (single x m) = pi.single x m :=
-begin
-  ext a,
-  change (equiv_fun_on_fintype (single x m)) a = _,
-  convert _root_.congr_fun (equiv_fun_on_fintype_single x m) a,
-end
+@[simp] lemma linear_equiv_fun_on_finite_single [decidable_eq α] (x : α) (m : M) :
+  (linear_equiv_fun_on_finite R M α) (single x m) = pi.single x m :=
+equiv_fun_on_finite_single x m
 
-@[simp] lemma linear_equiv_fun_on_fintype_symm_single [decidable_eq α]
-  (x : α) (m : M) : (linear_equiv_fun_on_fintype R M α).symm (pi.single x m) = single x m :=
-begin
-  ext a,
-  change (equiv_fun_on_fintype.symm (pi.single x m)) a = _,
-  convert congr_fun (equiv_fun_on_fintype_symm_single x m) a,
-end
+@[simp] lemma linear_equiv_fun_on_finite_symm_single [decidable_eq α]
+  (x : α) (m : M) : (linear_equiv_fun_on_finite R M α).symm (pi.single x m) = single x m :=
+equiv_fun_on_finite_symm_single x m
 
-@[simp] lemma linear_equiv_fun_on_fintype_symm_coe (f : α →₀ M) :
-  (linear_equiv_fun_on_fintype R M α).symm f = f :=
-by { ext, simp [linear_equiv_fun_on_fintype], }
+@[simp] lemma linear_equiv_fun_on_finite_symm_coe (f : α →₀ M) :
+  (linear_equiv_fun_on_finite R M α).symm f = f :=
+(linear_equiv_fun_on_finite R M α).symm_apply_apply f
 
-end finsupp
+/-- If `α` has a unique term, then the type of finitely supported functions `α →₀ M` is
+`R`-linearly equivalent to `M`. -/
+noncomputable def linear_equiv.finsupp_unique (α : Type*) [unique α] : (α →₀ M) ≃ₗ[R] M :=
+{ map_add' := λ x y, rfl,
+  map_smul' := λ r x, rfl,
+  ..finsupp.equiv_fun_on_finite.trans (equiv.fun_unique α M) }
 
-section
-open_locale classical
+variables {R M α}
+
+@[simp] lemma linear_equiv.finsupp_unique_apply (α : Type*) [unique α] (f : α →₀ M) :
+  linear_equiv.finsupp_unique R M α f = f default := rfl
+
+@[simp] lemma linear_equiv.finsupp_unique_symm_apply {α : Type*} [unique α] (m : M) :
+  (linear_equiv.finsupp_unique R M α).symm m = finsupp.single default m :=
+by ext; simp [linear_equiv.finsupp_unique]
+
+end finsupp
 
 /-- decomposing `x : ι → R` as a sum along the canonical basis -/
-lemma pi_eq_sum_univ {ι : Type*} [fintype ι] {R : Type*} [semiring R] (x : ι → R) :
+lemma pi_eq_sum_univ {ι : Type*} [fintype ι] [decidable_eq ι] {R : Type*} [semiring R] (x : ι → R) :
   x = ∑ i, x i • (λj, if i = j then 1 else 0) :=
 by { ext, simp }
 
-end
-
 /-! ### Properties of linear maps -/
 namespace linear_map
 
@@ -144,6 +148,10 @@ variables [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄] [ring_hom_comp_tripl
 variables (f : M →ₛₗ[σ₁₂] M₂) (g : M₂ →ₛₗ[σ₂₃] M₃)
 include R R₂
 
+@[simp] lemma map_sum {ι : Type*} {t : finset ι} {g : ι → M} :
+  f (∑ i in t, g i) = (∑ i in t, f (g i)) :=
+f.to_add_monoid_hom.map_sum _ _
+
 theorem comp_assoc (h : M₃ →ₛₗ[σ₃₄] M₄) :
   ((h.comp g : M₂ →ₛₗ[σ₂₄] M₄).comp f : M →ₛₗ[σ₁₄] M₄)
   = h.comp (g.comp f : M →ₛₗ[σ₁₃] M₃) := rfl
@@ -173,24 +181,29 @@ ext $ assume b, rfl
   p.subtype.comp (cod_restrict p f h) = f :=
 ext $ assume b, rfl
 
-/-- Restrict domain and codomain of an endomorphism. -/
-def restrict (f : M →ₗ[R] M) {p : submodule R M} (hf : ∀ x ∈ p, f x ∈ p) : p →ₗ[R] p :=
-(f.dom_restrict p).cod_restrict p $ set_like.forall.2 hf
+/-- Restrict domain and codomain of a linear map. -/
+def restrict (f : M →ₗ[R] M₁) {p : submodule R M} {q : submodule R M₁} (hf : ∀ x ∈ p, f x ∈ q) :
+  p →ₗ[R] q :=
+(f.dom_restrict p).cod_restrict q $ set_like.forall.2 hf
+
+@[simp] lemma restrict_coe_apply (f : M →ₗ[R] M₁) {p : submodule R M} {q : submodule R M₁}
+  (hf : ∀ x ∈ p, f x ∈ q) (x : p) : ↑(f.restrict hf x) = f x := rfl
 
 lemma restrict_apply
-  {f : M →ₗ[R] M} {p : submodule R M} (hf : ∀ x ∈ p, f x ∈ p) (x : p) :
+  {f : M →ₗ[R] M₁} {p : submodule R M} {q : submodule R M₁} (hf : ∀ x ∈ p, f x ∈ q) (x : p) :
   f.restrict hf x = ⟨f x, hf x.1 x.2⟩ := rfl
 
-lemma subtype_comp_restrict {f : M →ₗ[R] M} {p : submodule R M} (hf : ∀ x ∈ p, f x ∈ p) :
-  p.subtype.comp (f.restrict hf) = f.dom_restrict p := rfl
+lemma subtype_comp_restrict {f : M →ₗ[R] M₁} {p : submodule R M} {q : submodule R M₁}
+  (hf : ∀ x ∈ p, f x ∈ q) :
+  q.subtype.comp (f.restrict hf) = f.dom_restrict p := rfl
 
 lemma restrict_eq_cod_restrict_dom_restrict
-  {f : M →ₗ[R] M} {p : submodule R M} (hf : ∀ x ∈ p, f x ∈ p) :
-  f.restrict hf = (f.dom_restrict p).cod_restrict p (λ x, hf x.1 x.2) := rfl
+  {f : M →ₗ[R] M₁} {p : submodule R M} {q : submodule R M₁} (hf : ∀ x ∈ p, f x ∈ q) :
+  f.restrict hf = (f.dom_restrict p).cod_restrict q (λ x, hf x.1 x.2) := rfl
 
 lemma restrict_eq_dom_restrict_cod_restrict
-  {f : M →ₗ[R] M} {p : submodule R M} (hf : ∀ x, f x ∈ p) :
-  f.restrict (λ x _, hf x) = (f.cod_restrict p hf).dom_restrict p := rfl
+  {f : M →ₗ[R] M₁} {p : submodule R M} {q : submodule R M₁} (hf : ∀ x, f x ∈ q) :
+  f.restrict (λ x _, hf x) = (f.cod_restrict q hf).dom_restrict p := rfl
 
 instance unique_of_left [subsingleton M] : unique (M →ₛₗ[σ₁₂] M₂) :=
 { uniq := λ f, ext $ λ x, by rw [subsingleton.elim x 0, map_zero, map_zero],
@@ -223,7 +236,7 @@ variables [semiring S] [module R S] [module S M] [is_scalar_tower R S M]
 def smul_right (f : M₁ →ₗ[R] S) (x : M) : M₁ →ₗ[R] M :=
 { to_fun := λb, f b • x,
   map_add' := λ x y, by rw [f.map_add, add_smul],
-  map_smul' := λ b y, by dsimp; rw [f.map_smul, smul_assoc] }
+  map_smul' := λ b y, by dsimp; rw [map_smul, smul_assoc] }
 
 @[simp] theorem coe_smul_right (f : M₁ →ₗ[R] S) (x : M) :
   (smul_right f x : M₁ → M) = λ c, f c • x := rfl
@@ -315,21 +328,34 @@ begin
   exact surjective.of_comp h,
 end
 
+lemma pow_apply_mem_of_forall_mem {p : submodule R M}
+  (n : ℕ) (h : ∀ x ∈ p, f' x ∈ p) (x : M) (hx : x ∈ p) :
+  (f'^n) x ∈ p :=
+begin
+  induction n with n ih generalizing x, { simpa, },
+  simpa only [iterate_succ, coe_comp, function.comp_app, restrict_apply] using ih _ (h _ hx),
 end
 
-section
-open_locale classical
+lemma pow_restrict {p : submodule R M} (n : ℕ)
+  (h : ∀ x ∈ p, f' x ∈ p) (h' := pow_apply_mem_of_forall_mem n h) :
+  (f'.restrict h)^n = (f'^n).restrict h' :=
+begin
+  induction n with n ih;
+  ext,
+  { simp [restrict_apply], },
+  { simp [restrict_apply, linear_map.iterate_succ, -linear_map.pow_apply, ih], },
+end
+
+end
 
 /-- A linear map `f` applied to `x : ι → R` can be computed using the image under `f` of elements
 of the canonical basis. -/
-lemma pi_apply_eq_sum_univ [fintype ι] (f : (ι → R) →ₗ[R] M) (x : ι → R) :
+lemma pi_apply_eq_sum_univ [fintype ι] [decidable_eq ι] (f : (ι → R) →ₗ[R] M) (x : ι → R) :
   f x = ∑ i, x i • (f (λj, if i = j then 1 else 0)) :=
 begin
   conv_lhs { rw [pi_eq_sum_univ x, f.map_sum] },
   apply finset.sum_congr rfl (λl hl, _),
-  rw f.map_smul
-end
-
+  rw map_smul
 end
 
 end add_comm_monoid
@@ -391,8 +417,8 @@ include R
 to the space of linear maps `M₂ → M₃`. -/
 def comp_right (f : M₂ →ₗ[R] M₃) : (M →ₗ[R] M₂) →ₗ[R] (M →ₗ[R] M₃) :=
 { to_fun := f.comp,
-  map_add' := λ _ _, linear_map.ext $ λ _, f.map_add _ _,
-  map_smul' := λ _ _, linear_map.ext $ λ _, f.map_smul _ _ }
+  map_add' := λ _ _, linear_map.ext $ λ _, map_add f _ _,
+  map_smul' := λ _ _, linear_map.ext $ λ _, map_smul f _ _ }
 
 @[simp]
 lemma comp_right_apply (f : M₂ →ₗ[R] M₃) (g : M →ₗ[R] M₂) :
@@ -405,7 +431,7 @@ This is the `linear_map` version of `add_monoid_hom.eval`. -/
 @[simps]
 def applyₗ : M →ₗ[R] (M →ₗ[R] M₂) →ₗ[R] M₂ :=
 { to_fun := λ v, { to_fun := λ f, f v, ..applyₗ' R v },
-  map_smul' := λ x y, linear_map.ext $ λ f, f.map_smul _ _,
+  map_smul' := λ x y, linear_map.ext $ λ f, map_smul f _ _,
   ..applyₗ' R }
 
 /-- Alternative version of `dom_restrict` as a linear map. -/
@@ -418,12 +444,6 @@ def dom_restrict'
 @[simp] lemma dom_restrict'_apply (f : M →ₗ[R] M₂) (p : submodule R M) (x : p) :
   dom_restrict' p f x = f x := rfl
 
-end comm_semiring
-
-section comm_ring
-variables [comm_ring R] [add_comm_group M] [add_comm_group M₂] [add_comm_group M₃]
-variables [module R M] [module R M₂] [module R M₃]
-
 /--
 The family of linear maps `M₂ → M` parameterised by `f ∈ M₂ → R`, `x ∈ M`, is linear in `f`, `x`.
 -/
@@ -438,7 +458,7 @@ def smul_rightₗ : (M₂ →ₗ[R] R) →ₗ[R] M →ₗ[R] M₂ →ₗ[R] M :=
 @[simp] lemma smul_rightₗ_apply (f : M₂ →ₗ[R] R) (x : M) (c : M₂) :
   (smul_rightₗ : (M₂ →ₗ[R] R) →ₗ[R] M →ₗ[R] M₂ →ₗ[R] M) f x c = (f c) • x := rfl
 
-end comm_ring
+end comm_semiring
 
 end linear_map
 
@@ -541,34 +561,42 @@ theorem mem_left_iff_eq_zero_of_disjoint {p p' : submodule R M} (h : disjoint p
 ⟨λ hx, coe_eq_zero.1 $ disjoint_def.1 h x hx x.2, λ h, h.symm ▸ p.zero_mem⟩
 
 section
-variables [ring_hom_surjective σ₁₂]
+variables [ring_hom_surjective σ₁₂] {F : Type*} [sc : semilinear_map_class F σ₁₂ M M₂]
+include sc
 
 /-- The pushforward of a submodule `p ⊆ M` by `f : M → M₂` -/
-def map (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R M) : submodule R₂ M₂ :=
+def map (f : F) (p : submodule R M) : submodule R₂ M₂ :=
 { carrier   := f '' p,
   smul_mem' :=
   begin
     rintro c x ⟨y, hy, rfl⟩,
     obtain ⟨a, rfl⟩ := σ₁₂.is_surjective c,
-    exact ⟨_, p.smul_mem a hy, f.map_smulₛₗ _ _⟩,
+    exact ⟨_, p.smul_mem a hy, map_smulₛₗ f _ _⟩,
   end,
-  .. p.to_add_submonoid.map f.to_add_monoid_hom }
+  .. p.to_add_submonoid.map f }
 
-@[simp] lemma map_coe (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R M) :
+@[simp] lemma map_coe (f : F) (p : submodule R M) :
   (map f p : set M₂) = f '' p := rfl
+omit sc
 
 lemma map_to_add_submonoid (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R M) :
+  (p.map f).to_add_submonoid = p.to_add_submonoid.map (f : M →+ M₂) :=
+set_like.coe_injective rfl
+
+lemma map_to_add_submonoid' (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R M) :
   (p.map f).to_add_submonoid = p.to_add_submonoid.map f :=
 set_like.coe_injective rfl
 
-@[simp] lemma mem_map {f : M →ₛₗ[σ₁₂] M₂} {p : submodule R M} {x : M₂} :
+include sc
+@[simp] lemma mem_map {f : F} {p : submodule R M} {x : M₂} :
   x ∈ map f p ↔ ∃ y, y ∈ p ∧ f y = x := iff.rfl
 
-theorem mem_map_of_mem {f : M →ₛₗ[σ₁₂] M₂} {p : submodule R M} {r} (h : r ∈ p) :
+theorem mem_map_of_mem {f : F} {p : submodule R M} {r} (h : r ∈ p) :
   f r ∈ map f p := set.mem_image_of_mem _ h
 
-lemma apply_coe_mem_map (f : M →ₛₗ[σ₁₂] M₂) {p : submodule R M} (r : p) :
+lemma apply_coe_mem_map (f : F) {p : submodule R M} (r : p) :
   f r ∈ map f p := mem_map_of_mem r.prop
+omit sc
 
 @[simp] lemma map_id : map (linear_map.id : M →ₗ[R] M) p = p :=
 submodule.ext $ λ a, by simp
@@ -576,10 +604,12 @@ submodule.ext $ λ a, by simp
 lemma map_comp [ring_hom_surjective σ₂₃] [ring_hom_surjective σ₁₃]
   (f : M →ₛₗ[σ₁₂] M₂) (g : M₂ →ₛₗ[σ₂₃] M₃)
   (p : submodule R M) : map (g.comp f : M →ₛₗ[σ₁₃] M₃) p = map g (map f p) :=
-set_like.coe_injective $ by simp [map_coe]; rw ← image_comp
+set_like.coe_injective $ by simp only [← image_comp, map_coe, linear_map.coe_comp, comp_app]
 
-lemma map_mono {f : M →ₛₗ[σ₁₂] M₂} {p p' : submodule R M} :
+include sc
+lemma map_mono {f : F} {p p' : submodule R M} :
   p ≤ p' → map f p ≤ map f p' := image_subset _
+omit sc
 
 @[simp] lemma map_zero : map (0 : M →ₛₗ[σ₁₂] M₂) p = ⊥ :=
 have ∃ (x : M), x ∈ p := ⟨0, p.zero_mem⟩,
@@ -597,42 +627,49 @@ lemma range_map_nonempty (N : submodule R M) :
 
 end
 
-include σ₂₁
+variables {F : Type*} [sc : semilinear_map_class F σ₁₂ M M₂]
+
+include σ₂₁ sc
 /-- The pushforward of a submodule by an injective linear map is
 linearly equivalent to the original submodule. See also `linear_equiv.submodule_map` for a
 computable version when `f` has an explicit inverse. -/
-noncomputable def equiv_map_of_injective (f : M →ₛₗ[σ₁₂] M₂) (i : injective f)
+noncomputable def equiv_map_of_injective (f : F) (i : injective f)
   (p : submodule R M) : p ≃ₛₗ[σ₁₂] p.map f :=
-{ map_add' := by { intros, simp, refl, },
-  map_smul' := by { intros, simp, refl, },
+{ map_add' := by { intros, simp only [coe_add, map_add, equiv.to_fun_as_coe, equiv.set.image_apply],
+                   refl },
+  map_smul' := by { intros, simp only [coe_smul_of_tower, map_smulₛₗ, equiv.to_fun_as_coe,
+                    equiv.set.image_apply], refl },
   ..(equiv.set.image f p i) }
 
-@[simp] lemma coe_equiv_map_of_injective_apply (f : M →ₛₗ[σ₁₂] M₂) (i : injective f)
+@[simp] lemma coe_equiv_map_of_injective_apply (f : F) (i : injective f)
   (p : submodule R M) (x : p) :
   (equiv_map_of_injective f i p x : M₂) = f x := rfl
 omit σ₂₁
 
 /-- The pullback of a submodule `p ⊆ M₂` along `f : M → M₂` -/
-def comap (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R₂ M₂) : submodule R M :=
+def comap (f : F) (p : submodule R₂ M₂) : submodule R M :=
 { carrier   := f ⁻¹' p,
   smul_mem' := λ a x h, by simp [p.smul_mem _ h],
-  .. p.to_add_submonoid.comap f.to_add_monoid_hom }
+  .. p.to_add_submonoid.comap f }
 
-@[simp] lemma comap_coe (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R₂ M₂) :
+@[simp] lemma comap_coe (f : F) (p : submodule R₂ M₂) :
   (comap f p : set M) = f ⁻¹' p := rfl
 
-@[simp] lemma mem_comap {f : M →ₛₗ[σ₁₂] M₂} {p : submodule R₂ M₂} :
+@[simp] lemma mem_comap {f : F} {p : submodule R₂ M₂} :
   x ∈ comap f p ↔ f x ∈ p := iff.rfl
+omit sc
 
-@[simp] lemma comap_id : comap linear_map.id p = p :=
+@[simp] lemma comap_id : comap (linear_map.id : M →ₗ[R] M) p = p :=
 set_like.coe_injective rfl
 
 lemma comap_comp (f : M →ₛₗ[σ₁₂] M₂) (g : M₂ →ₛₗ[σ₂₃] M₃)
   (p : submodule R₃ M₃) : comap (g.comp f : M →ₛₗ[σ₁₃] M₃) p = comap f (comap g p) :=
 rfl
 
-lemma comap_mono {f : M →ₛₗ[σ₁₂] M₂} {q q' : submodule R₂ M₂} :
+include sc
+lemma comap_mono {f : F} {q q' : submodule R₂ M₂} :
   q ≤ q' → comap f q ≤ comap f q' := preimage_mono
+omit sc
 
 lemma le_comap_pow_of_le_comap (p : submodule R M) {f : M →ₗ[R] M} (h : p ≤ p.comap f) (k : ℕ) :
   p ≤ p.comap (f^k) :=
@@ -645,46 +682,50 @@ end
 section
 variables [ring_hom_surjective σ₁₂]
 
-lemma map_le_iff_le_comap {f : M →ₛₗ[σ₁₂] M₂} {p : submodule R M} {q : submodule R₂ M₂} :
+include sc
+lemma map_le_iff_le_comap {f : F} {p : submodule R M} {q : submodule R₂ M₂} :
   map f p ≤ q ↔ p ≤ comap f q := image_subset_iff
 
-lemma gc_map_comap (f : M →ₛₗ[σ₁₂] M₂) : galois_connection (map f) (comap f)
+lemma gc_map_comap (f : F) : galois_connection (map f) (comap f)
 | p q := map_le_iff_le_comap
 
-@[simp] lemma map_bot (f : M →ₛₗ[σ₁₂] M₂) : map f ⊥ = ⊥ :=
+@[simp] lemma map_bot (f : F) : map f ⊥ = ⊥ :=
 (gc_map_comap f).l_bot
 
-@[simp] lemma map_sup (f : M →ₛₗ[σ₁₂] M₂) : map f (p ⊔ p') = map f p ⊔ map f p' :=
-(gc_map_comap f).l_sup
+@[simp] lemma map_sup (f : F) : map f (p ⊔ p') = map f p ⊔ map f p' :=
+(gc_map_comap f : galois_connection (map f) (comap f)).l_sup
 
-@[simp] lemma map_supr {ι : Sort*} (f : M →ₛₗ[σ₁₂] M₂) (p : ι → submodule R M) :
+@[simp] lemma map_supr {ι : Sort*} (f : F) (p : ι → submodule R M) :
   map f (⨆i, p i) = (⨆i, map f (p i)) :=
-(gc_map_comap f).l_supr
+(gc_map_comap f : galois_connection (map f) (comap f)).l_supr
 
 end
 
-@[simp] lemma comap_top (f : M →ₛₗ[σ₁₂] M₂) : comap f ⊤ = ⊤ := rfl
+include sc
+@[simp] lemma comap_top (f : F) : comap f ⊤ = ⊤ := rfl
 
-@[simp] lemma comap_inf (f : M →ₛₗ[σ₁₂] M₂) : comap f (q ⊓ q') = comap f q ⊓ comap f q' := rfl
+@[simp] lemma comap_inf (f : F) : comap f (q ⊓ q') = comap f q ⊓ comap f q' := rfl
 
-@[simp] lemma comap_infi [ring_hom_surjective σ₁₂] {ι : Sort*} (f : M →ₛₗ[σ₁₂] M₂)
+@[simp] lemma comap_infi [ring_hom_surjective σ₁₂] {ι : Sort*} (f : F)
   (p : ι → submodule R₂ M₂) :
   comap f (⨅i, p i) = (⨅i, comap f (p i)) :=
-(gc_map_comap f).u_infi
+(gc_map_comap f : galois_connection (map f) (comap f)).u_infi
+omit sc
 
 @[simp] lemma comap_zero : comap (0 : M →ₛₗ[σ₁₂] M₂) q = ⊤ :=
 ext $ by simp
 
-lemma map_comap_le [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (q : submodule R₂ M₂) :
+include sc
+lemma map_comap_le [ring_hom_surjective σ₁₂] (f : F) (q : submodule R₂ M₂) :
   map f (comap f q) ≤ q :=
 (gc_map_comap f).l_u_le _
 
-lemma le_comap_map [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (p : submodule R M) :
+lemma le_comap_map [ring_hom_surjective σ₁₂] (f : F) (p : submodule R M) :
   p ≤ comap f (map f p) :=
 (gc_map_comap f).le_u_l _
 
 section galois_insertion
-variables {f : M →ₛₗ[σ₁₂] M₂} (hf : surjective f)
+variables {f : F} (hf : surjective f)
 variables [ring_hom_surjective σ₁₂]
 include hf
 
@@ -732,7 +773,7 @@ lemma comap_strict_mono_of_surjective : strict_mono (comap f) :=
 end galois_insertion
 
 section galois_coinsertion
-variables [ring_hom_surjective σ₁₂] {f : M →ₛₗ[σ₁₂] M₂} (hf : injective f)
+variables [ring_hom_surjective σ₁₂] {f : F} (hf : injective f)
 include hf
 
 /-- `map f` and `comap f` form a `galois_coinsertion` when `f` is injective. -/
@@ -771,14 +812,31 @@ lemma map_strict_mono_of_injective : strict_mono (map f) :=
 
 end galois_coinsertion
 
+section order_iso
+omit sc
+include σ₁₂ σ₂₁
+variables [semilinear_equiv_class F σ₁₂ M M₂]
+
+/-- A linear isomorphism induces an order isomorphism of submodules. -/
+@[simps symm_apply apply] def order_iso_map_comap (f : F) : submodule R M ≃o submodule R₂ M₂ :=
+{ to_fun := map f,
+  inv_fun := comap f,
+  left_inv := comap_map_eq_of_injective $ equiv_like.injective f,
+  right_inv := map_comap_eq_of_surjective $ equiv_like.surjective f,
+  map_rel_iff' := map_le_map_iff_of_injective $ equiv_like.injective f }
+
+end order_iso
+
 --TODO(Mario): is there a way to prove this from order properties?
-lemma map_inf_eq_map_inf_comap [ring_hom_surjective σ₁₂] {f : M →ₛₗ[σ₁₂] M₂}
+lemma map_inf_eq_map_inf_comap [ring_hom_surjective σ₁₂] {f : F}
   {p : submodule R M} {p' : submodule R₂ M₂} :
   map f p ⊓ p' = map f (p ⊓ comap f p') :=
 le_antisymm
   (by rintro _ ⟨⟨x, h₁, rfl⟩, h₂⟩; exact ⟨_, ⟨h₁, h₂⟩, rfl⟩)
   (le_inf (map_mono inf_le_left) (map_le_iff_le_comap.2 inf_le_right))
 
+omit sc
+
 lemma map_comap_subtype : map p.subtype (comap p.subtype p') = p ⊓ p' :=
 ext $ λ x, ⟨by rintro ⟨⟨_, h₁⟩, h₂, rfl⟩; exact ⟨h₁, h₂⟩, λ ⟨h₁, h₂⟩, ⟨⟨_, h₁⟩, h₂, rfl⟩⟩
 
@@ -806,7 +864,8 @@ section add_comm_group
 variables [ring R] [add_comm_group M] [module R M] (p : submodule R M)
 variables [add_comm_group M₂] [module R M₂]
 
-@[simp] lemma neg_coe : -(p : set M) = p := set.ext $ λ x, p.neg_mem_iff
+-- See `neg_coe_set`
+lemma neg_coe : -(p : set M) = p := set.ext $ λ x, p.neg_mem_iff
 
 @[simp] protected lemma map_neg (f : M →ₗ[R] M₂) : map (-f) p = map f p :=
 ext $ λ y, ⟨λ ⟨x, hx, hy⟩, hy ▸ ⟨-x, show -x ∈ p, from neg_mem hx, map_neg f x⟩,
@@ -912,27 +971,33 @@ submodule.ext $ λ x, ⟨λ h, ⟨⟨_, hf x⟩, h, rfl⟩, by rintro ⟨⟨_, _
 
 section
 
+variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
+
+include sc
 /-- The range of a linear map `f : M → M₂` is a submodule of `M₂`.
 See Note [range copy pattern]. -/
-def range [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) : submodule R₂ M₂ :=
+def range [ring_hom_surjective τ₁₂] (f : F) : submodule R₂ M₂ :=
 (map f ⊤).copy (set.range f) set.image_univ.symm
 
-theorem range_coe [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) :
+theorem range_coe [ring_hom_surjective τ₁₂] (f : F) :
   (range f : set M₂) = set.range f := rfl
+omit sc
 
 lemma range_to_add_submonoid [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) :
   f.range.to_add_submonoid = f.to_add_monoid_hom.mrange := rfl
 
+include sc
 @[simp] theorem mem_range [ring_hom_surjective τ₁₂]
-  {f : M →ₛₗ[τ₁₂] M₂} {x} : x ∈ range f ↔ ∃ y, f y = x :=
+  {f : F} {x} : x ∈ range f ↔ ∃ y, f y = x :=
 iff.rfl
 
 lemma range_eq_map [ring_hom_surjective τ₁₂]
-  (f : M →ₛₗ[τ₁₂] M₂) : f.range = map f ⊤ :=
+  (f : F) : range f = map f ⊤ :=
 by { ext, simp }
 
 theorem mem_range_self [ring_hom_surjective τ₁₂]
-  (f : M →ₛₗ[τ₁₂] M₂) (x : M) : f x ∈ f.range := ⟨x, rfl⟩
+  (f : F) (x : M) : f x ∈ range f := ⟨x, rfl⟩
+omit sc
 
 @[simp] theorem range_id : range (linear_map.id : M →ₗ[R] M) = ⊤ :=
 set_like.coe_injective set.range_id
@@ -947,17 +1012,19 @@ theorem range_comp_le_range [ring_hom_surjective τ₂₃] [ring_hom_surjective
   range (g.comp f : M →ₛₗ[τ₁₃] M₃) ≤ range g :=
 set_like.coe_mono (set.range_comp_subset_range f g)
 
-theorem range_eq_top [ring_hom_surjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} :
+include sc
+theorem range_eq_top [ring_hom_surjective τ₁₂] {f : F} :
   range f = ⊤ ↔ surjective f :=
 by rw [set_like.ext'_iff, range_coe, top_coe, set.range_iff_surjective]
 
-lemma range_le_iff_comap [ring_hom_surjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R₂ M₂} :
+lemma range_le_iff_comap [ring_hom_surjective τ₁₂] {f : F} {p : submodule R₂ M₂} :
   range f ≤ p ↔ comap f p = ⊤ :=
 by rw [range_eq_map, map_le_iff_le_comap, eq_top_iff]
 
-lemma map_le_range [ring_hom_surjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R M} :
+lemma map_le_range [ring_hom_surjective τ₁₂] {f : F} {p : submodule R M} :
   map f p ≤ range f :=
 set_like.coe_mono (set.image_subset_range f p)
+omit sc
 
 @[simp] lemma range_neg {R : Type*} {R₂ : Type*} {M : Type*} {M₂ : Type*}
   [semiring R] [ring R₂] [add_comm_monoid M] [add_comm_group M₂] [module R M] [module R₂ M₂]
@@ -968,6 +1035,23 @@ begin
   rw [range_comp, submodule.map_neg, submodule.map_id],
 end
 
+/-- A linear map version of `add_monoid_hom.eq_locus` -/
+def eq_locus (f g : M →ₛₗ[τ₁₂] M₂) : submodule R M :=
+{ carrier := {x | f x = g x},
+  smul_mem' := λ r x (hx : _ = _), show _ = _,
+    by simpa only [linear_map.map_smulₛₗ] using congr_arg ((•) (τ₁₂ r)) hx,
+  .. f.to_add_monoid_hom.eq_mlocus g.to_add_monoid_hom }
+
+@[simp] lemma mem_eq_locus {x : M} {f g : M →ₛₗ[τ₁₂] M₂} : x ∈ f.eq_locus g ↔ f x = g x :=
+iff.rfl
+
+lemma eq_locus_to_add_submonoid (f g : M →ₛₗ[τ₁₂] M₂) :
+  (f.eq_locus g).to_add_submonoid = (f : M →+ M₂).eq_mlocus g :=
+rfl
+
+@[simp] lemma eq_locus_same (f : M →ₛₗ[τ₁₂] M₂) : f.eq_locus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 end
 
 /--
@@ -997,15 +1081,21 @@ instance fintype_range [fintype M] [decidable_eq M₂] [ring_hom_surjective τ
   (f : M →ₛₗ[τ₁₂] M₂) : fintype (range f) :=
 set.fintype_range f
 
+variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
+
+include sc
 /-- The kernel of a linear map `f : M → M₂` is defined to be `comap f ⊥`. This is equivalent to the
 set of `x : M` such that `f x = 0`. The kernel is a submodule of `M`. -/
-def ker (f : M →ₛₗ[τ₁₂] M₂) : submodule R M := comap f ⊥
+def ker (f : F) : submodule R M := comap f ⊥
 
-@[simp] theorem mem_ker {f : M →ₛₗ[τ₁₂] M₂} {y} : y ∈ ker f ↔ f y = 0 := mem_bot R₂
+@[simp] theorem mem_ker {f : F} {y} : y ∈ ker f ↔ f y = 0 := mem_bot R₂
+omit sc
 
 @[simp] theorem ker_id : ker (linear_map.id : M →ₗ[R] M) = ⊥ := rfl
 
-@[simp] theorem map_coe_ker (f : M →ₛₗ[τ₁₂] M₂) (x : ker f) : f x = 0 := mem_ker.1 x.2
+include sc
+@[simp] theorem map_coe_ker (f : F) (x : ker f) : f x = 0 := mem_ker.1 x.2
+omit sc
 
 lemma ker_to_add_submonoid (f : M →ₛₗ[τ₁₂] M₂) :
   f.ker.to_add_submonoid = f.to_add_monoid_hom.mker := rfl
@@ -1020,44 +1110,52 @@ theorem ker_le_ker_comp (f : M →ₛₗ[τ₁₂] M₂) (g : M₂ →ₛₗ[τ
   ker f ≤ ker (g.comp f : M →ₛₗ[τ₁₃] M₃) :=
 by rw ker_comp; exact comap_mono bot_le
 
-theorem disjoint_ker {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R M} :
+include sc
+theorem disjoint_ker {f : F} {p : submodule R M} :
   disjoint p (ker f) ↔ ∀ x ∈ p, f x = 0 → x = 0 :=
 by simp [disjoint_def]
 
-theorem ker_eq_bot' {f : M →ₛₗ[τ₁₂] M₂} :
+theorem ker_eq_bot' {f : F} :
   ker f = ⊥ ↔ (∀ m, f m = 0 → m = 0) :=
-by simpa [disjoint] using @disjoint_ker _ _ _ _ _ _ _ _ _ _ _ f ⊤
+by simpa [disjoint_iff_inf_le] using @disjoint_ker _ _ _ _ _ _ _ _ _ _ _ _ _ f ⊤
+omit sc
 
 theorem ker_eq_bot_of_inverse {τ₂₁ : R₂ →+* R} [ring_hom_inv_pair τ₁₂ τ₂₁]
   {f : M →ₛₗ[τ₁₂] M₂} {g : M₂ →ₛₗ[τ₂₁] M} (h : (g.comp f : M →ₗ[R] M) = id) :
   ker f = ⊥ :=
 ker_eq_bot'.2 $ λ m hm, by rw [← id_apply m, ← h, comp_apply, hm, g.map_zero]
 
-lemma le_ker_iff_map [ring_hom_surjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R M} :
+include sc
+lemma le_ker_iff_map [ring_hom_surjective τ₁₂] {f : F} {p : submodule R M} :
   p ≤ ker f ↔ map f p = ⊥ :=
 by rw [ker, eq_bot_iff, map_le_iff_le_comap]
+omit sc
 
 lemma ker_cod_restrict {τ₂₁ : R₂ →+* R} (p : submodule R M) (f : M₂ →ₛₗ[τ₂₁] M) (hf) :
   ker (cod_restrict p f hf) = ker f :=
-by rw [ker, comap_cod_restrict, map_bot]; refl
+by rw [ker, comap_cod_restrict, submodule.map_bot]; refl
 
 lemma range_cod_restrict {τ₂₁ : R₂ →+* R} [ring_hom_surjective τ₂₁] (p : submodule R M)
   (f : M₂ →ₛₗ[τ₂₁] M) (hf) :
   range (cod_restrict p f hf) = comap p.subtype f.range :=
 by simpa only [range_eq_map] using map_cod_restrict _ _ _ _
 
-lemma ker_restrict {p : submodule R M} {f : M →ₗ[R] M} (hf : ∀ x : M, x ∈ p → f x ∈ p) :
+lemma ker_restrict [add_comm_monoid M₁] [module R M₁]
+  {p : submodule R M} {q : submodule R M₁} {f : M →ₗ[R] M₁}
+  (hf : ∀ x : M, x ∈ p → f x ∈ q) :
   ker (f.restrict hf) = (f.dom_restrict p).ker :=
 by rw [restrict_eq_cod_restrict_dom_restrict, ker_cod_restrict]
 
+include sc
 lemma _root_.submodule.map_comap_eq [ring_hom_surjective τ₁₂]
-  (f : M →ₛₗ[τ₁₂] M₂) (q : submodule R₂ M₂) : map f (comap f q) = range f ⊓ q :=
+  (f : F) (q : submodule R₂ M₂) : map f (comap f q) = range f ⊓ q :=
 le_antisymm (le_inf map_le_range (map_comap_le _ _)) $
 by rintro _ ⟨⟨x, _, rfl⟩, hx⟩; exact ⟨x, hx, rfl⟩
 
 lemma _root_.submodule.map_comap_eq_self [ring_hom_surjective τ₁₂]
-  {f : M →ₛₗ[τ₁₂] M₂} {q : submodule R₂ M₂} (h : q ≤ range f) : map f (comap f q) = q :=
+  {f : F} {q : submodule R₂ M₂} (h : q ≤ range f) : map f (comap f q) = q :=
 by rwa [submodule.map_comap_eq, inf_eq_right]
+omit sc
 
 @[simp] theorem ker_zero : ker (0 : M →ₛₗ[τ₁₂] M₂) = ⊤ :=
 eq_top_iff'.2 $ λ x, by simp
@@ -1082,21 +1180,24 @@ lemma range_le_ker_iff {f : M →ₛₗ[τ₁₂] M₂} {g : M₂ →ₛₗ[τ
 ⟨λ h, ker_eq_top.1 $ eq_top_iff'.2 $ λ x, h $ ⟨_, rfl⟩,
  λ h x hx, mem_ker.2 $ exists.elim hx $ λ y hy, by rw [←hy, ←comp_apply, h, zero_apply]⟩
 
-theorem comap_le_comap_iff {f : M →ₛₗ[τ₁₂] M₂} (hf : range f = ⊤) {p p'} :
+include sc
+theorem comap_le_comap_iff {f : F} (hf : range f = ⊤) {p p'} :
   comap f p ≤ comap f p' ↔ p ≤ p' :=
 ⟨λ H x hx, by rcases range_eq_top.1 hf x with ⟨y, hy, rfl⟩; exact H hx, comap_mono⟩
 
-theorem comap_injective {f : M →ₛₗ[τ₁₂] M₂} (hf : range f = ⊤) : injective (comap f) :=
+theorem comap_injective {f : F} (hf : range f = ⊤) : injective (comap f) :=
 λ p p' h, le_antisymm ((comap_le_comap_iff hf).1 (le_of_eq h))
   ((comap_le_comap_iff hf).1 (ge_of_eq h))
 
 end
 
-theorem ker_eq_bot_of_injective {f : M →ₛₗ[τ₁₂] M₂} (hf : injective f) : ker f = ⊥ :=
+include sc
+theorem ker_eq_bot_of_injective {f : F} (hf : injective f) : ker f = ⊥ :=
 begin
-  have : disjoint ⊤ f.ker, by { rw [disjoint_ker, ← map_zero f], exact λ x hx H, hf H },
-  simpa [disjoint]
+  have : disjoint ⊤ (ker f), by { rw [disjoint_ker, ← map_zero f], exact λ x hx H, hf H },
+  simpa [disjoint_iff_inf_le]
 end
+omit sc
 
 /--
 The increasing sequence of submodules consisting of the kernels of the iterates of a linear map.
@@ -1118,7 +1219,8 @@ variables [add_comm_group M] [add_comm_group M₂] [add_comm_group M₃]
 variables [module R M] [module R₂ M₂] [module R₃ M₃]
 variables {τ₁₂ : R →+* R₂} {τ₂₃ : R₂ →+* R₃} {τ₁₃ : R →+* R₃}
 variables [ring_hom_comp_triple τ₁₂ τ₂₃ τ₁₃]
-variables {f : M →ₛₗ[τ₁₂] M₂}
+variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
+variables {f : F}
 include R
 open submodule
 
@@ -1128,7 +1230,11 @@ lemma range_to_add_subgroup [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ
 lemma ker_to_add_subgroup (f : M →ₛₗ[τ₁₂] M₂) :
   f.ker.to_add_subgroup = f.to_add_monoid_hom.ker := rfl
 
-theorem sub_mem_ker_iff {x y} : x - y ∈ f.ker ↔ f x = f y :=
+lemma eq_locus_eq_ker_sub (f g : M →ₛₗ[τ₁₂] M₂) : f.eq_locus g = (f - g).ker :=
+set_like.ext $ λ v, sub_eq_zero.symm
+
+include sc
+theorem sub_mem_ker_iff {x y} : x - y ∈ ker f ↔ f x = f y :=
 by rw [mem_ker, map_sub, sub_eq_zero]
 
 theorem disjoint_ker' {p : submodule R M} :
@@ -1137,27 +1243,35 @@ disjoint_ker.trans
 ⟨λ H x hx y hy h, eq_of_sub_eq_zero $ H _ (sub_mem hx hy) (by simp [h]),
  λ H x h₁ h₂, H x h₁ 0 (zero_mem _) (by simpa using h₂)⟩
 
-theorem inj_of_disjoint_ker {p : submodule R M}
+theorem inj_on_of_disjoint_ker {p : submodule R M}
   {s : set M} (h : s ⊆ p) (hd : disjoint p (ker f)) :
-  ∀ x y ∈ s, f x = f y → x = y :=
+  set.inj_on f s :=
 λ x hx y hy, disjoint_ker'.1 hd _ (h hx) _ (h hy)
 
-theorem ker_eq_bot : ker f = ⊥ ↔ injective f :=
-by simpa [disjoint] using @disjoint_ker' _ _ _ _ _ _ _ _ _ _ _ f ⊤
+variables (F)
+theorem _root_.linear_map_class.ker_eq_bot : ker f = ⊥ ↔ injective f :=
+by simpa [disjoint_iff_inf_le] using @disjoint_ker' _ _ _ _ _ _ _ _ _ _ _ _ _ f ⊤
+variables {F}
+
+omit sc
+theorem ker_eq_bot {f : M →ₛₗ[τ₁₂] M₂} : ker f = ⊥ ↔ injective f :=
+linear_map_class.ker_eq_bot _
+include sc
 
 lemma ker_le_iff [ring_hom_surjective τ₁₂] {p : submodule R M} :
   ker f ≤ p ↔ ∃ (y ∈ range f), f ⁻¹' {y} ⊆ p :=
 begin
   split,
-  { intros h, use 0, rw [← set_like.mem_coe, f.range_coe], exact ⟨⟨0, map_zero f⟩, h⟩, },
+  { intros h, use 0, rw [← set_like.mem_coe, range_coe], exact ⟨⟨0, map_zero f⟩, h⟩, },
   { rintros ⟨y, h₁, h₂⟩,
     rw set_like.le_def, intros z hz, simp only [mem_ker, set_like.mem_coe] at hz,
-    rw [← set_like.mem_coe, f.range_coe, set.mem_range] at h₁, obtain ⟨x, hx⟩ := h₁,
+    rw [← set_like.mem_coe, range_coe, set.mem_range] at h₁, obtain ⟨x, hx⟩ := h₁,
     have hx' : x ∈ p, { exact h₂ hx, },
     have hxz : z + x ∈ p, { apply h₂, simp [hx, hz], },
     suffices : z + x - x ∈ p, { simpa only [this, add_sub_cancel], },
     exact p.sub_mem hxz hx', },
 end
+omit sc
 
 end ring
 
@@ -1183,7 +1297,6 @@ end field
 
 end linear_map
 
-
 namespace is_linear_map
 
 lemma is_linear_map_add [semiring R] [add_comm_monoid M] [module R M] :
@@ -1191,7 +1304,7 @@ lemma is_linear_map_add [semiring R] [add_comm_monoid M] [module R M] :
 begin
   apply is_linear_map.mk,
   { intros x y,
-    simp, cc },
+    simp only [prod.fst_add, prod.snd_add], cc },
   { intros x y,
     simp [smul_add] }
 end
@@ -1216,12 +1329,15 @@ variables [semiring R] [semiring R₂] [add_comm_monoid M] [add_comm_monoid M₂
 variables [module R M] [module R₂ M₂]
 variables (p p' : submodule R M) (q : submodule R₂ M₂)
 variables {τ₁₂ : R →+* R₂}
+variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
 open linear_map
 
-@[simp] theorem map_top [ring_hom_surjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) : map f ⊤ = range f :=
-f.range_eq_map.symm
+include sc
+@[simp] theorem map_top [ring_hom_surjective τ₁₂] (f : F) : map f ⊤ = range f :=
+(range_eq_map f).symm
 
-@[simp] theorem comap_bot (f : M →ₛₗ[τ₁₂] M₂) : comap f ⊥ = ker f := rfl
+@[simp] theorem comap_bot (f : F) : comap f ⊥ = ker f := rfl
+omit sc
 
 @[simp] theorem ker_subtype : p.subtype.ker = ⊥ :=
 ker_eq_bot_of_injective $ λ x y, subtype.ext_val
@@ -1358,20 +1474,27 @@ end linear_map
   f.range_restrict.range = ⊤ :=
 by simp [f.range_cod_restrict _]
 
+@[simp] lemma linear_map.ker_range_restrict [semiring R] [add_comm_monoid M]
+  [add_comm_monoid M₂] [module R M] [module R M₂] (f : M →ₗ[R] M₂) :
+  f.range_restrict.ker = f.ker :=
+linear_map.ker_cod_restrict _ _ _
+
 /-! ### Linear equivalences -/
 namespace linear_equiv
 
 section add_comm_monoid
 
 section subsingleton
-variables [semiring R] [semiring R₂] [semiring R₃] [semiring R₄]
-variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄]
+variables [semiring R] [semiring R₂]
+variables [add_comm_monoid M] [add_comm_monoid M₂]
 variables [module R M] [module R₂ M₂]
-variables [subsingleton M] [subsingleton M₂]
 variables {σ₁₂ : R →+* R₂} {σ₂₁ : R₂ →+* R}
 variables [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂]
 
 include σ₂₁
+section module
+variables [subsingleton M] [subsingleton M₂]
+
 /-- Between two zero modules, the zero map is an equivalence. -/
 instance : has_zero (M ≃ₛₗ[σ₁₂] M₂) :=
 ⟨{ to_fun := 0,
@@ -1394,6 +1517,11 @@ instance : unique (M ≃ₛₗ[σ₁₂] M₂) :=
   default := 0 }
 omit σ₂₁
 
+end module
+
+instance unique_of_subsingleton [subsingleton R] [subsingleton R₂] : unique (M ≃ₛₗ[σ₁₂] M₂) :=
+by { haveI := module.subsingleton R M, haveI := module.subsingleton R₂ M₂, apply_instance }
+
 end subsingleton
 
 section
@@ -1404,6 +1532,9 @@ variables {σ₁₂ : R →+* R₂} {σ₂₁ : R₂ →+* R}
 variables {re₁₂ : ring_hom_inv_pair σ₁₂ σ₂₁} {re₂₁ : ring_hom_inv_pair σ₂₁ σ₁₂}
 variables (e e' : M ≃ₛₗ[σ₁₂] M₂)
 
+@[simp] lemma map_sum {s : finset ι} (u : ι → M) : e (∑ i in s, u i) = ∑ i in s, e (u i) :=
+e.to_linear_map.map_sum
+
 lemma map_eq_comap {p : submodule R M} :
   (p.map (e : M →ₛₗ[σ₁₂] M₂) : submodule R₂ M₂) = p.comap (e.symm : M₂ →ₛₗ[σ₂₁] M) :=
 set_like.coe_injective $ by simp [e.image_eq_preimage]
@@ -1519,8 +1650,8 @@ def of_eq (h : p = q) : p ≃ₗ[R] q :=
 variables {p q}
 
 @[simp] lemma coe_of_eq_apply (h : p = q) (x : p) : (of_eq p q h x : M) = x := rfl
-
 @[simp] lemma of_eq_symm (h : p = q) : (of_eq p q h).symm = of_eq q p h.symm := rfl
+@[simp] lemma of_eq_rfl : of_eq p p rfl = linear_equiv.refl R p := by ext; refl
 
 include σ₂₁
 /-- A linear equivalence which maps a submodule of one module onto another, restricts to a linear
@@ -1600,6 +1731,10 @@ omit σ₂₁ re₁₂ re₂₁
 linear_map.range_eq_top.2 e.to_equiv.surjective
 
 include σ₂₁ re₁₂ re₂₁
+@[simp] protected theorem _root_.linear_equiv_class.range [module R M] [module R₂ M₂] {F : Type*}
+  [semilinear_equiv_class F σ₁₂ M M₂] (e : F) : linear_map.range e = ⊤ :=
+linear_map.range_eq_top.2 (equiv_like.surjective e)
+
 lemma eq_bot_of_equiv [module R₂ M₂] (e : p ≃ₛₗ[σ₁₂] (⊥ : submodule R₂ M₂)) : p = ⊥ :=
 begin
   refine bot_unique (set_like.le_def.2 $ assume b hb, (submodule.mem_bot R).2 _),
@@ -1664,11 +1799,11 @@ of_left_inverse $ classical.some_spec h.has_left_inverse
 
 /-- A bijective linear map is a linear equivalence. -/
 noncomputable def of_bijective [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂]
-  (hf₁ : injective f) (hf₂ : surjective f) : M ≃ₛₗ[σ₁₂] M₂ :=
-(of_injective f hf₁).trans (of_top _ $ linear_map.range_eq_top.2 hf₂)
+  (hf : bijective f) : M ≃ₛₗ[σ₁₂] M₂ :=
+(of_injective f hf.injective).trans (of_top _ $ linear_map.range_eq_top.2 hf.surjective)
 
 @[simp] theorem of_bijective_apply [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂]
-  {hf₁ hf₂} (x : M) : of_bijective f hf₁ hf₂ x = f x := rfl
+  {hf} (x : M) : of_bijective f hf x = f x := rfl
 
 end
 
@@ -1730,7 +1865,8 @@ def arrow_congr {R M₁ M₂ M₂₁ M₂₂ : Sort*} [comm_semiring R]
   left_inv := λ f, by { ext x, simp only [symm_apply_apply, comp_app, coe_comp, coe_coe]},
   right_inv := λ f, by { ext x, simp only [comp_app, apply_symm_apply, coe_comp, coe_coe]},
   map_add' := λ f g, by { ext x, simp only [map_add, add_apply, comp_app, coe_comp, coe_coe]},
-  map_smul' := λ c f, by { ext x, simp only [smul_apply, comp_app, coe_comp, map_smulₛₗ, coe_coe]} }
+  map_smul' := λ c f, by { ext x, simp only [smul_apply, comp_app, coe_comp, map_smulₛₗ e₂,
+                                             coe_coe]} }
 
 @[simp] lemma arrow_congr_apply {R M₁ M₂ M₂₁ M₂₂ : Sort*} [comm_semiring R]
   [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₂₁] [add_comm_monoid M₂₂]
@@ -1773,6 +1909,9 @@ def conj (e : M ≃ₗ[R] M₂) : (module.End R M) ≃ₗ[R] (module.End R M₂)
 lemma conj_apply (e : M ≃ₗ[R] M₂) (f : module.End R M) :
   e.conj f = ((↑e : M →ₗ[R] M₂).comp f).comp (e.symm : M₂ →ₗ[R] M) := rfl
 
+lemma conj_apply_apply (e : M ≃ₗ[R] M₂) (f : module.End R M) (x : M₂) :
+  e.conj f x = e (f (e.symm x)) := rfl
+
 lemma symm_conj_apply (e : M ≃ₗ[R] M₂) (f : module.End R M₂) :
   e.symm.conj f = ((↑e.symm : M₂ →ₗ[R] M).comp f).comp (e : M →ₗ[R] M₂) := rfl
 
@@ -1883,6 +2022,27 @@ lemma comap_equiv_eq_map_symm (e : M ≃ₛₗ[τ₁₂] M₂) (K : submodule R
   K.comap (e : M →ₛₗ[τ₁₂] M₂) = K.map (e.symm : M₂ →ₛₗ[τ₂₁] M) :=
 (map_equiv_eq_comap_symm e.symm K).symm
 
+variables {p}
+include τ₂₁
+lemma map_symm_eq_iff (e : M ≃ₛₗ[τ₁₂] M₂) {K : submodule R₂ M₂} :
+  K.map e.symm = p ↔ p.map e = K :=
+begin
+  split; rintro rfl,
+  { calc map e (map e.symm K) = comap e.symm (map e.symm K) : map_equiv_eq_comap_symm _ _
+    ... = K : comap_map_eq_of_injective e.symm.injective _ },
+  { calc map e.symm (map e p) = comap e (map e p) : (comap_equiv_eq_map_symm _ _).symm
+    ... = p : comap_map_eq_of_injective e.injective _ },
+end
+
+lemma order_iso_map_comap_apply' (e : M ≃ₛₗ[τ₁₂] M₂) (p : submodule R M) :
+  order_iso_map_comap e p = comap e.symm p :=
+p.map_equiv_eq_comap_symm _
+
+lemma order_iso_map_comap_symm_apply' (e : M ≃ₛₗ[τ₁₂] M₂) (p : submodule R₂ M₂) :
+  (order_iso_map_comap e).symm p = map e.symm p :=
+p.comap_equiv_eq_map_symm _
+omit τ₂₁
+
 lemma comap_le_comap_smul (fₗ : N →ₗ[R] N₂) (c : R) :
   comap fₗ qₗ ≤ comap (c • fₗ) qₗ :=
 begin
@@ -1907,7 +2067,7 @@ end
 the set of maps $\{f ∈ Hom(M, M₂) | f(p) ⊆ q \}$ is a submodule of `Hom(M, M₂)`. -/
 def compatible_maps : submodule R (N →ₗ[R] N₂) :=
 { carrier   := {fₗ | pₗ ≤ comap fₗ qₗ},
-  zero_mem' := by { change pₗ ≤ comap 0 qₗ, rw comap_zero, refine le_top, },
+  zero_mem' := by { change pₗ ≤ comap (0 : N →ₗ[R] N₂) qₗ, rw comap_zero, refine le_top, },
   add_mem'  := λ f₁ f₂ h₁ h₂, by { apply le_trans _ (inf_comap_le_comap_add qₗ f₁ f₂),
                                  rw le_inf_iff, exact ⟨h₁, h₂⟩, },
   smul_mem' := λ c fₗ h, le_trans h (comap_le_comap_smul qₗ fₗ c), }
@@ -2003,55 +2163,3 @@ rfl
 end linear_equiv
 
 end fun_left
-
-namespace linear_map
-
-variables [semiring R] [add_comm_monoid M] [module R M]
-variables (R M)
-
-/-- The group of invertible linear maps from `M` to itself -/
-@[reducible] def general_linear_group := (M →ₗ[R] M)ˣ
-
-namespace general_linear_group
-variables {R M}
-
-instance : has_coe_to_fun (general_linear_group R M) (λ _, M → M) := by apply_instance
-
-/-- An invertible linear map `f` determines an equivalence from `M` to itself. -/
-def to_linear_equiv (f : general_linear_group R M) : (M ≃ₗ[R] M) :=
-{ inv_fun := f.inv.to_fun,
-  left_inv := λ m, show (f.inv * f.val) m = m,
-    by erw f.inv_val; simp,
-  right_inv := λ m, show (f.val * f.inv) m = m,
-    by erw f.val_inv; simp,
-  ..f.val }
-
-/-- An equivalence from `M` to itself determines an invertible linear map. -/
-def of_linear_equiv (f : (M ≃ₗ[R] M)) : general_linear_group R M :=
-{ val := f,
-  inv := (f.symm : M →ₗ[R] M),
-  val_inv := linear_map.ext $ λ _, f.apply_symm_apply _,
-  inv_val := linear_map.ext $ λ _, f.symm_apply_apply _ }
-
-variables (R M)
-
-/-- The general linear group on `R` and `M` is multiplicatively equivalent to the type of linear
-equivalences between `M` and itself. -/
-def general_linear_equiv : general_linear_group R M ≃* (M ≃ₗ[R] M) :=
-{ to_fun := to_linear_equiv,
-  inv_fun := of_linear_equiv,
-  left_inv := λ f, by { ext, refl },
-  right_inv := λ f, by { ext, refl },
-  map_mul' := λ x y, by {ext, refl} }
-
-@[simp] lemma general_linear_equiv_to_linear_map (f : general_linear_group R M) :
-  (general_linear_equiv R M f : M →ₗ[R] M) = f :=
-by {ext, refl}
-
-@[simp] lemma coe_fn_general_linear_equiv (f : general_linear_group R M) :
-  ⇑(general_linear_equiv R M f) = (f : M → M) :=
-rfl
-
-end general_linear_group
-
-end linear_map
diff --git a/src/linear_algebra/basis.lean b/src/linear_algebra/basis.lean
index b0564cf382f04..c7f2f38be3cd7 100644
--- a/src/linear_algebra/basis.lean
+++ b/src/linear_algebra/basis.lean
@@ -5,7 +5,7 @@ Authors: Johannes Hölzl, Mario Carneiro, Alexander Bentkamp
 -/
 import algebra.big_operators.finsupp
 import algebra.big_operators.finprod
-import data.fintype.card
+import data.fintype.big_operators
 import linear_algebra.finsupp
 import linear_algebra.linear_independent
 import linear_algebra.linear_pmap
@@ -15,6 +15,9 @@ import linear_algebra.projection
 
 # Bases
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines bases in a module or vector space.
 
 It is inspired by Isabelle/HOL's linear algebra, and hence indirectly by HOL Light.
@@ -66,9 +69,9 @@ noncomputable theory
 universe u
 
 open function set submodule
-open_locale classical big_operators
+open_locale big_operators
 
-variables {ι : Type*} {ι' : Type*} {R : Type*} {K : Type*}
+variables {ι : Type*} {ι' : Type*} {R : Type*} {R₂ : Type*} {K : Type*}
 variables {M : Type*} {M' M'' : Type*} {V : Type u} {V' : Type*}
 
 section module
@@ -90,6 +93,9 @@ structure basis := of_repr :: (repr : M ≃ₗ[R] (ι →₀ R))
 
 end
 
+instance unique_basis [subsingleton R] : unique (basis ι R M) :=
+⟨⟨⟨default⟩⟩, λ ⟨b⟩, by rw subsingleton.elim b⟩
+
 namespace basis
 
 instance : inhabited (basis ι R (ι →₀ R)) := ⟨basis.of_repr (linear_equiv.refl _ _)⟩
@@ -98,9 +104,20 @@ variables (b b₁ : basis ι R M) (i : ι) (c : R) (x : M)
 
 section repr
 
+lemma repr_injective : injective (repr : basis ι R M → M ≃ₗ[R] (ι →₀ R)) :=
+λ f g h, by cases f; cases g; congr'
+
 /-- `b i` is the `i`th basis vector. -/
-instance : has_coe_to_fun (basis ι R M) (λ _, ι → M) :=
-{ coe := λ b i, b.repr.symm (finsupp.single i 1) }
+instance fun_like : fun_like (basis ι R M) ι (λ _, M) :=
+{ coe := λ b i, b.repr.symm (finsupp.single i 1),
+  coe_injective' := λ f g h, repr_injective $ linear_equiv.symm_bijective.injective begin
+    ext x,
+    rw [←finsupp.sum_single x, map_finsupp_sum, map_finsupp_sum],
+    congr' with i r,
+    have := congr_fun h i,
+    dsimp at this,
+    rw [←mul_one r, ←finsupp.smul_single', linear_equiv.map_smul, linear_equiv.map_smul, this],
+  end }
 
 @[simp] lemma coe_of_repr (e : M ≃ₗ[R] (ι →₀ R)) :
   ⇑(of_repr e) = λ i, e.symm (finsupp.single i 1) :=
@@ -146,6 +163,13 @@ lemma mem_span_repr_support {ι : Type*} (b : basis ι R M) (m : M) :
   m ∈ span R (b '' (b.repr m).support) :=
 (finsupp.mem_span_image_iff_total _).2 ⟨b.repr m, (by simp [finsupp.mem_supported_support])⟩
 
+lemma repr_support_subset_of_mem_span {ι : Type*}
+  (b : basis ι R M) (s : set ι) {m : M} (hm : m ∈ span R (b '' s)) : ↑(b.repr m).support ⊆ s :=
+begin
+  rcases (finsupp.mem_span_image_iff_total _).1 hm with ⟨l, hl, hlm⟩,
+  rwa [←hlm, repr_total, ←finsupp.mem_supported R l]
+end
+
 end repr
 
 section coord
@@ -193,6 +217,13 @@ end
 by simp only [basis.sum_coords, linear_map.id_coe, linear_equiv.coe_coe, id.def, basis.repr_self,
   function.comp_app, finsupp.coe_lsum, linear_map.coe_comp, finsupp.sum_single_index]
 
+lemma dvd_coord_smul (i : ι) (m : M) (r : R) : r ∣ b.coord i (r • m) :=
+⟨b.coord i m, by simp⟩
+
+lemma coord_repr_symm (b : basis ι R M) (i : ι) (f : ι →₀  R) :
+  b.coord i (b.repr.symm f) = f i :=
+by simp only [repr_symm_apply, coord_apply, repr_total]
+
 end coord
 
 section ext
@@ -217,10 +248,12 @@ by { ext x,
 
 omit σ'
 
-/-- Two elements are equal if their coordinates are equal. -/
-theorem ext_elem {x y : M}
-  (h : ∀ i, b.repr x i = b.repr y i) : x = y :=
-by { rw [← b.total_repr x, ← b.total_repr y], congr' 1, ext i, exact h i }
+/-- Two elements are equal iff their coordinates are equal. -/
+lemma ext_elem_iff {x y : M} :
+   x = y ↔ (∀ i, b.repr x i = b.repr y i) :=
+by simp only [← finsupp.ext_iff, embedding_like.apply_eq_iff_eq]
+
+alias ext_elem_iff ↔ _ _root_.basis.ext_elem
 
 lemma repr_eq_iff {b : basis ι R M} {f : M →ₗ[R] ι →₀ R} :
   ↑b.repr = f ↔ ∀ i, f (b i) = finsupp.single i 1 :=
@@ -256,15 +289,11 @@ begin
 end
 
 /-- Two bases are equal if they assign the same coordinates. -/
-lemma eq_of_repr_eq_repr {b₁ b₂ : basis ι R M} (h : ∀ x i, b₁.repr x i = b₂.repr x i) :
-  b₁ = b₂ :=
-have b₁.repr = b₂.repr, by { ext, apply h },
-by { cases b₁, cases b₂, simpa }
+lemma eq_of_repr_eq_repr {b₁ b₂ : basis ι R M} (h : ∀ x i, b₁.repr x i = b₂.repr x i) : b₁ = b₂ :=
+repr_injective $ by { ext, apply h }
 
 /-- Two bases are equal if their basis vectors are the same. -/
-@[ext] lemma eq_of_apply_eq {b₁ b₂ : basis ι R M} (h : ∀ i, b₁ i = b₂ i) : b₁ = b₂ :=
-suffices b₁.repr = b₂.repr, by { cases b₁, cases b₂, simpa },
-repr_eq_iff'.mpr (λ i, by rw [h, b₂.repr_self])
+@[ext] lemma eq_of_apply_eq {b₁ b₂ : basis ι R M} : (∀ i, b₁ i = b₂ i) → b₁ = b₂ := fun_like.ext _ _
 
 end ext
 
@@ -286,7 +315,7 @@ variables {R' : Type*} [semiring R'] [module R' M] (f : R ≃+* R') (h : ∀ c (
 
 include f h b
 
-local attribute [instance] has_scalar.comp.is_scalar_tower
+local attribute [instance] has_smul.comp.is_scalar_tower
 
 /-- If `R` and `R'` are isomorphic rings that act identically on a module `M`,
 then a basis for `M` as `R`-module is also a basis for `M` as `R'`-module.
@@ -328,38 +357,35 @@ by rw [linear_equiv.symm_trans_apply, finsupp.dom_lcongr_symm, finsupp.dom_lcong
 @[simp] lemma coe_reindex : (b.reindex e : ι' → M) = b ∘ e.symm :=
 funext (b.reindex_apply e)
 
-@[simp] lemma coe_reindex_repr : ((b.reindex e).repr x : ι' → R) = b.repr x ∘ e.symm :=
-funext $ λ i',
-show (finsupp.dom_lcongr e : _ ≃ₗ[R] _) (b.repr x) i' = _,
-by simp
+lemma repr_reindex_apply (i' : ι') : (b.reindex e).repr x i' = b.repr x (e.symm i') :=
+show (finsupp.dom_lcongr e : _ ≃ₗ[R] _) (b.repr x) i' = _, by simp
 
-@[simp] lemma reindex_repr (i' : ι') : (b.reindex e).repr x i' = b.repr x (e.symm i') :=
-by rw coe_reindex_repr
+@[simp] lemma repr_reindex : (b.reindex e).repr x = (b.repr x).map_domain e :=
+fun_like.ext _ _ $ by simp [repr_reindex_apply]
 
 @[simp] lemma reindex_refl : b.reindex (equiv.refl ι) = b :=
 eq_of_apply_eq $ λ i, by simp
 
-/-- `simp` normal form version of `range_reindex` -/
-@[simp] lemma range_reindex' : set.range (b ∘ e.symm) = set.range b :=
-by rw [range_comp, equiv.range_eq_univ, set.image_univ]
-
+/-- `simp` can prove this as `basis.coe_reindex` + `equiv_like.range_comp` -/
 lemma range_reindex : set.range (b.reindex e) = set.range b :=
-by rw [coe_reindex, range_reindex']
+by rw [coe_reindex, equiv_like.range_comp]
+
+@[simp] lemma sum_coords_reindex : (b.reindex e).sum_coords = b.sum_coords :=
+begin
+  ext x,
+  simp only [coe_sum_coords, repr_reindex],
+  exact finsupp.sum_map_domain_index (λ _, rfl) (λ _ _ _, rfl),
+end
 
 /-- `b.reindex_range` is a basis indexed by `range b`, the basis vectors themselves. -/
 def reindex_range : basis (range b) R M :=
+by haveI := classical.dec (nontrivial R); exact
 if h : nontrivial R then
   by letI := h; exact b.reindex (equiv.of_injective b (basis.injective b))
 else
   by letI : subsingleton R := not_nontrivial_iff_subsingleton.mp h; exact
     basis.of_repr (module.subsingleton_equiv R M (range b))
 
-lemma finsupp.single_apply_left {α β γ : Type*} [has_zero γ]
-  {f : α → β} (hf : function.injective f)
-  (x z : α) (y : γ) :
-  finsupp.single (f x) y (f z) = finsupp.single x y z :=
-by simp [finsupp.single_apply, hf.eq_iff]
-
 lemma reindex_range_self (i : ι) (h := set.mem_range_self i) :
   b.reindex_range ⟨b i, h⟩ = b i :=
 begin
@@ -406,7 +432,7 @@ b.reindex_range_repr' _ rfl
 
 section fintype
 
-variables [fintype ι]
+variables [fintype ι] [decidable_eq M]
 
 /-- `b.reindex_finset_range` is a basis indexed by `finset.univ.image b`,
 the finite set of basis vectors themselves. -/
@@ -427,7 +453,7 @@ lemma reindex_finset_range_repr_self (i : ι) :
     finsupp.single ⟨b i, finset.mem_image_of_mem b (finset.mem_univ i)⟩ 1 :=
 begin
   ext ⟨bi, hbi⟩,
-  rw [reindex_finset_range, reindex_repr, reindex_range_repr_self],
+  rw [reindex_finset_range, repr_reindex, finsupp.map_domain_equiv_apply, reindex_range_repr_self],
   convert finsupp.single_apply_left ((equiv.refl M).subtype_equiv _).symm.injective _ _ _,
   refl
 end
@@ -459,10 +485,19 @@ eq_top_iff.mpr $ λ x _, b.mem_span x
 lemma index_nonempty (b : basis ι R M) [nontrivial M] : nonempty ι :=
 begin
   obtain ⟨x, y, ne⟩ : ∃ (x y : M), x ≠ y := nontrivial.exists_pair_ne,
-  obtain ⟨i, _⟩ := not_forall.mp (mt b.ext_elem ne),
+  obtain ⟨i, _⟩ := not_forall.mp (mt b.ext_elem_iff.2 ne),
   exact ⟨i⟩
 end
 
+/-- If the submodule `P` has a basis, `x ∈ P` iff it is a linear combination of basis vectors. -/
+lemma mem_submodule_iff {P : submodule R M} (b : basis ι R P) {x : M} :
+  x ∈ P ↔ ∃ (c : ι →₀ R), x = finsupp.sum c (λ i x, x • b i) :=
+begin
+  conv_lhs { rw [← P.range_subtype, ← submodule.map_top, ← b.span_eq, submodule.map_span,
+    ← set.range_comp, ← finsupp.range_total] },
+  simpa only [@eq_comm _ x],
+end
+
 section constr
 
 variables (S : Type*) [semiring S] [module S M']
@@ -554,7 +589,8 @@ section prod
 variables (b' : basis ι' R M')
 
 /-- `basis.prod` maps a `ι`-indexed basis for `M` and a `ι'`-indexed basis for `M'`
-to a `ι ⊕ ι'`-index basis for `M × M'`. -/
+to a `ι ⊕ ι'`-index basis for `M × M'`.
+For the specific case of `R × R`, see also `basis.fin_two_prod`. -/
 protected def prod : basis (ι ⊕ ι') R (M × M') :=
 of_repr ((b.repr.prod b'.repr).trans (finsupp.sum_finsupp_lequiv_prod_finsupp R).symm)
 
@@ -724,14 +760,16 @@ linear_equiv.trans b.repr
   ({ to_fun := coe_fn,
      map_add' := finsupp.coe_add,
      map_smul' := finsupp.coe_smul,
-     ..finsupp.equiv_fun_on_fintype } : (ι →₀ R) ≃ₗ[R] (ι → R))
+     ..finsupp.equiv_fun_on_finite } : (ι →₀ R) ≃ₗ[R] (ι → R))
 
 /-- A module over a finite ring that admits a finite basis is finite. -/
-def module.fintype_of_fintype [fintype R] : fintype M :=
-fintype.of_equiv _ b.equiv_fun.to_equiv.symm
+def module.fintype_of_fintype (b : basis ι R M) [fintype R] : fintype M :=
+by haveI := classical.dec_eq ι; exact
+  fintype.of_equiv _ b.equiv_fun.to_equiv.symm
 
-theorem module.card_fintype [fintype R] [fintype M] :
+theorem module.card_fintype (b : basis ι R M) [fintype R] [fintype M] :
   card M = (card R) ^ (card ι) :=
+by classical; exact
 calc card M = card (ι → R)    : card_congr b.equiv_fun.to_equiv
         ... = card R ^ card ι : card_fun
 
@@ -758,18 +796,29 @@ lemma basis.sum_repr (u : M) : ∑ i, b.repr u i • b i = u :=
 b.sum_equiv_fun u
 
 @[simp]
-lemma basis.equiv_fun_self (i j : ι) : b.equiv_fun (b i) j = if i = j then 1 else 0 :=
+lemma basis.equiv_fun_self [decidable_eq ι] (i j : ι) :
+  b.equiv_fun (b i) j = if i = j then 1 else 0 :=
 by { rw [b.equiv_fun_apply, b.repr_self_apply] }
 
+lemma basis.repr_sum_self (c : ι → R) : ⇑(b.repr (∑ i, c i • b i)) = c :=
+begin
+  ext j,
+  simp only [map_sum, linear_equiv.map_smul, repr_self, finsupp.smul_single, smul_eq_mul,
+             mul_one, finset.sum_apply'],
+  rw [finset.sum_eq_single j, finsupp.single_eq_same],
+  { rintros i - hi, exact finsupp.single_eq_of_ne hi },
+  { intros, have := finset.mem_univ j, contradiction }
+end
+
 /-- Define a basis by mapping each vector `x : M` to its coordinates `e x : ι → R`,
 as long as `ι` is finite. -/
 def basis.of_equiv_fun (e : M ≃ₗ[R] (ι → R)) : basis ι R M :=
-basis.of_repr $ e.trans $ linear_equiv.symm $ finsupp.linear_equiv_fun_on_fintype R R ι
+basis.of_repr $ e.trans $ linear_equiv.symm $ finsupp.linear_equiv_fun_on_finite R R ι
 
 @[simp] lemma basis.of_equiv_fun_repr_apply (e : M ≃ₗ[R] (ι → R)) (x : M) (i : ι) :
   (basis.of_equiv_fun e).repr x i = e x i := rfl
 
-@[simp] lemma basis.coe_of_equiv_fun (e : M ≃ₗ[R] (ι → R)) :
+@[simp] lemma basis.coe_of_equiv_fun [decidable_eq ι] (e : M ≃ₗ[R] (ι → R)) :
   (basis.of_equiv_fun e : ι → M) = λ i, e.symm (function.update 0 i 1) :=
 funext $ λ i, e.injective $ funext $ λ j,
   by simp [basis.of_equiv_fun, ←finsupp.single_eq_pi_single, finsupp.single_eq_update]
@@ -777,12 +826,20 @@ funext $ λ i, e.injective $ funext $ λ j,
 @[simp] lemma basis.of_equiv_fun_equiv_fun
   (v : basis ι R M) : basis.of_equiv_fun v.equiv_fun = v :=
 begin
+  classical,
   ext j,
   simp only [basis.equiv_fun_symm_apply, basis.coe_of_equiv_fun],
   simp_rw [function.update_apply, ite_smul],
   simp only [finset.mem_univ, if_true, pi.zero_apply, one_smul, finset.sum_ite_eq', zero_smul],
 end
 
+@[simp] lemma basis.equiv_fun_of_equiv_fun (e : M ≃ₗ[R] (ι → R)) :
+  (basis.of_equiv_fun e).equiv_fun = e :=
+begin
+  ext j,
+  simp_rw [basis.equiv_fun_apply, basis.of_equiv_fun_repr_apply],
+end
+
 variables (S : Type*) [semiring S] [module S M']
 variables [smul_comm_class R S M']
 
@@ -790,6 +847,16 @@ variables [smul_comm_class R S M']
   (b.constr S f : M → M') x = ∑ i, (b.equiv_fun x i) • f i :=
 by simp [b.constr_apply, b.equiv_fun_apply, finsupp.sum_fintype]
 
+/-- If the submodule `P` has a finite basis,
+`x ∈ P` iff it is a linear combination of basis vectors. -/
+lemma basis.mem_submodule_iff' {P : submodule R M} (b : basis ι R P) {x : M} :
+  x ∈ P ↔ ∃ (c : ι → R), x = ∑ i, c i • b i :=
+b.mem_submodule_iff.trans $ finsupp.equiv_fun_on_finite.exists_congr_left.trans $ exists_congr $
+λ c, by simp [finsupp.sum_fintype]
+
+lemma basis.coord_equiv_fun_symm (i : ι) (f : ι → R) : b.coord i (b.equiv_fun.symm f) = f i :=
+b.coord_repr_symm i (finsupp.equiv_fun_on_finite.symm f)
+
 end fintype
 
 end module
@@ -851,8 +918,8 @@ section module
 open linear_map
 
 variables {v : ι → M}
-variables [ring R] [add_comm_group M] [add_comm_group M'] [add_comm_group M'']
-variables [module R M] [module R M'] [module R M'']
+variables [ring R] [comm_ring R₂] [add_comm_group M] [add_comm_group M'] [add_comm_group M'']
+variables [module R M] [module R₂ M] [module R M'] [module R M'']
 variables {c d : R} {x y : M}
 variables (b : basis ι R M)
 
@@ -890,7 +957,7 @@ end
 
 section mk
 
-variables (hli : linear_independent R v) (hsp : span R (range v) = ⊤)
+variables (hli : linear_independent R v) (hsp : ⊤ ≤ span R (range v))
 
 /-- A linear independent family of vectors spanning the whole module is a basis. -/
 protected noncomputable def mk : basis ι R M :=
@@ -898,10 +965,10 @@ basis.of_repr
 { inv_fun := finsupp.total _ _ _ v,
   left_inv := λ x, hli.total_repr ⟨x, _⟩,
   right_inv := λ x, hli.repr_eq rfl,
-  .. hli.repr.comp (linear_map.id.cod_restrict _ (λ h, hsp.symm ▸ submodule.mem_top)) }
+  .. hli.repr.comp (linear_map.id.cod_restrict _ (λ h, hsp submodule.mem_top)) }
 
 @[simp] lemma mk_repr :
-  (basis.mk hli hsp).repr x = hli.repr ⟨x, hsp.symm ▸ submodule.mem_top⟩ :=
+  (basis.mk hli hsp).repr x = hli.repr ⟨x, hsp submodule.mem_top⟩ :=
 rfl
 
 lemma mk_apply (i : ι) : basis.mk hli hsp i = v i :=
@@ -928,7 +995,7 @@ by simp [hli.repr_eq_single j, h]
 
 /-- Given a basis, the `i`th element of the dual basis evaluates to the Kronecker delta on the
 `j`th element of the basis. -/
-lemma mk_coord_apply {i j : ι} :
+lemma mk_coord_apply [decidable_eq ι] {i j : ι} :
   (basis.mk hli hsp).coord i (v j) = if j = i then 1 else 0 :=
 begin
   cases eq_or_ne j i,
@@ -946,15 +1013,15 @@ variables (hli : linear_independent R v)
 protected noncomputable def span : basis ι R (span R (range v)) :=
 basis.mk (linear_independent_span hli) $
 begin
-  rw eq_top_iff,
   intros x _,
   have h₁ : (coe : span R (range v) → M) '' set.range (λ i, subtype.mk (v i) _) = range v,
   { rw ← set.range_comp,
     refl },
-  have h₂ : map (submodule.subtype _) (span R (set.range (λ i, subtype.mk (v i) _)))
-    = span R (range v),
+  have h₂ : map (submodule.subtype (span R (range v)))
+    (span R (set.range (λ i, subtype.mk (v i) _))) = span R (range v),
   { rw [← span_image, submodule.coe_subtype, h₁] },
-  have h₃ : (x : M) ∈ map (submodule.subtype _) (span R (set.range (λ i, subtype.mk (v i) _))),
+  have h₃ : (x : M) ∈ map (submodule.subtype (span R (range v)))
+    (span R (set.range (λ i, subtype.mk (v i) _))),
   { rw h₂, apply subtype.mem x },
   rcases mem_map.1 h₃ with ⟨y, hy₁, hy₂⟩,
   have h_x_eq_y : x = y,
@@ -962,6 +1029,9 @@ begin
   rwa h_x_eq_y
 end
 
+protected lemma span_apply (i : ι) : (basis.span hli i : M) = v i :=
+congr_arg (coe : span R (range v) → M) $ basis.mk_apply (linear_independent_span hli) _ i
+
 end span
 
 lemma group_smul_span_eq_top
@@ -985,13 +1055,13 @@ def group_smul {G : Type*} [group G] [distrib_mul_action G R] [distrib_mul_actio
   [is_scalar_tower G R M] [smul_comm_class G R M] (v : basis ι R M) (w : ι → G) :
   basis ι R M :=
 @basis.mk ι R M (w • v) _ _ _
-  (v.linear_independent.group_smul w) (group_smul_span_eq_top v.span_eq)
+  (v.linear_independent.group_smul w) (group_smul_span_eq_top v.span_eq).ge
 
 lemma group_smul_apply {G : Type*} [group G] [distrib_mul_action G R] [distrib_mul_action G M]
   [is_scalar_tower G R M] [smul_comm_class G R M] {v : basis ι R M} {w : ι → G} (i : ι) :
   v.group_smul w i = (w • v : ι → M) i :=
 mk_apply
-  (v.linear_independent.group_smul w) (group_smul_span_eq_top v.span_eq) i
+  (v.linear_independent.group_smul w) (group_smul_span_eq_top v.span_eq).ge i
 
 lemma units_smul_span_eq_top {v : ι → M} (hv : submodule.span R (set.range v) = ⊤)
   {w : ι → Rˣ} : submodule.span R (set.range (w • v)) = ⊤ :=
@@ -1002,12 +1072,32 @@ provides the basis corresponding to `w • v`. -/
 def units_smul (v : basis ι R M) (w : ι → Rˣ) :
   basis ι R M :=
 @basis.mk ι R M (w • v) _ _ _
-  (v.linear_independent.units_smul w) (units_smul_span_eq_top v.span_eq)
+  (v.linear_independent.units_smul w) (units_smul_span_eq_top v.span_eq).ge
 
 lemma units_smul_apply {v : basis ι R M} {w : ι → Rˣ} (i : ι) :
   v.units_smul w i = w i • v i :=
 mk_apply
-  (v.linear_independent.units_smul w) (units_smul_span_eq_top v.span_eq) i
+  (v.linear_independent.units_smul w) (units_smul_span_eq_top v.span_eq).ge i
+
+@[simp] lemma coord_units_smul (e : basis ι R₂ M) (w : ι → R₂ˣ) (i : ι) :
+  (e.units_smul w).coord i = (w i)⁻¹ • e.coord i :=
+begin
+  classical,
+  apply e.ext,
+  intros j,
+  transitivity ((e.units_smul w).coord i) ((w j)⁻¹ • (e.units_smul w) j),
+  { congr,
+    simp [basis.units_smul, ← mul_smul], },
+  simp only [basis.coord_apply, linear_map.smul_apply, basis.repr_self, units.smul_def,
+    smul_hom_class.map_smul, finsupp.single_apply],
+  split_ifs with h h,
+  { simp [h] },
+  { simp }
+end
+
+@[simp] lemma repr_units_smul (e : basis ι R₂ M) (w : ι → R₂ˣ) (v : M) (i : ι) :
+  (e.units_smul w).repr v i = (w i)⁻¹ • e.repr v i :=
+congr_arg (λ f : M →ₗ[R₂] R₂, f v) (e.coord_units_smul w i)
 
 /-- A version of `smul_of_units` that uses `is_unit`. -/
 def is_unit_smul (v : basis ι R M) {w : ι → R} (hw : ∀ i, is_unit (w i)):
@@ -1032,8 +1122,7 @@ have span_b : submodule.span R (set.range (N.subtype ∘ b)) = N,
 @basis.mk _ _ _ (fin.cons y (N.subtype ∘ b) : fin (n + 1) → M) _ _ _
   ((b.linear_independent.map' N.subtype (submodule.ker_subtype _)) .fin_cons' _ _ $
     by { rintros c ⟨x, hx⟩ hc, rw span_b at hx, exact hli c x hx hc })
-  (eq_top_iff.mpr (λ x _,
-    by { rw [fin.range_cons, submodule.mem_span_insert', span_b], exact hsp x }))
+  (λ x _, by { rw [fin.range_cons, submodule.mem_span_insert', span_b], exact hsp x })
 
 @[simp] lemma coe_mk_fin_cons {n : ℕ} {N : submodule R M} (y : M) (b : basis (fin n) R N)
   (hli : ∀ (c : R) (x ∈ N), c • y + x = 0 → c = 0)
@@ -1061,6 +1150,20 @@ mk_fin_cons ⟨y, yO⟩ (b.map (submodule.comap_subtype_equiv_of_le hNO).symm)
     fin.cons ⟨y, yO⟩ (submodule.of_le hNO ∘ b) :=
 coe_mk_fin_cons _ _ _ _
 
+/-- The basis of `R × R` given by the two vectors `(1, 0)` and `(0, 1)`. -/
+protected def fin_two_prod (R : Type*) [semiring R] : basis (fin 2) R (R × R) :=
+basis.of_equiv_fun (linear_equiv.fin_two_arrow R R).symm
+
+@[simp] lemma fin_two_prod_zero (R : Type*) [semiring R] : basis.fin_two_prod R 0 = (1, 0) :=
+by simp [basis.fin_two_prod]
+
+@[simp] lemma fin_two_prod_one (R : Type*) [semiring R] : basis.fin_two_prod R 1 = (0, 1) :=
+by simp [basis.fin_two_prod]
+
+@[simp] lemma coe_fin_two_prod_repr {R : Type*} [semiring R] (x : R × R) :
+  ⇑((basis.fin_two_prod R).repr x) = ![x.fst, x.snd] :=
+rfl
+
 end fin
 
 end basis
@@ -1092,7 +1195,7 @@ begin
   induction n with n rank_ih generalizing N,
   { suffices : N = ⊥,
     { rwa this },
-    apply eq_bot_of_rank_eq_zero b _ (λ m v hv, nat.le_zero_iff.mp (rank_le v hv)) },
+    apply eq_bot_of_rank_eq_zero b _ (λ m v hv, le_zero_iff.mp (rank_le v hv)) },
   apply ih,
   intros N' N'_le x x_mem x_ortho,
   apply rank_ih,
@@ -1126,8 +1229,7 @@ noncomputable def extend (hs : linear_independent K (coe : s → V)) :
   basis _ K V :=
 basis.mk
   (@linear_independent.restrict_of_comp_subtype _ _ _ id _ _ _ _ (hs.linear_independent_extend _))
-  (eq_top_iff.mpr $ set_like.coe_subset_coe.mp $
-    by simpa using hs.subset_span_extend (subset_univ s))
+  (set_like.coe_subset_coe.mp $ by simpa using hs.subset_span_extend (subset_univ s))
 
 lemma extend_apply_self (hs : linear_independent K (coe : s → V))
   (x : hs.extend _) :
@@ -1150,7 +1252,9 @@ let s := set.range v,
     b := hs.to_subtype_range.extend (subset_univ (set.range v)) in
 (basis.extend hs.to_subtype_range).reindex $ equiv.symm $
   calc ι ⊕ (b \ s : set V) ≃ s ⊕ (b \ s : set V) : equiv.sum_congr e (equiv.refl _)
-  ... ≃ b                   : equiv.set.sum_diff_subset (hs.to_subtype_range.subset_extend _)
+  ... ≃ b                   :
+    by haveI := classical.dec_pred (∈ s); exact
+      equiv.set.sum_diff_subset (hs.to_subtype_range.subset_extend _)
 
 lemma subset_extend {s : set V} (hs : linear_independent K (coe : s → V)) :
   s ⊆ hs.extend (set.subset_univ _) :=
@@ -1198,14 +1302,58 @@ variables (K V)
 
 theorem vector_space.card_fintype [fintype K] [fintype V] :
   ∃ n : ℕ, card V = (card K) ^ n :=
-⟨card (basis.of_vector_space_index K V), module.card_fintype (basis.of_vector_space K V)⟩
+by classical; exact
+  ⟨card (basis.of_vector_space_index K V), module.card_fintype (basis.of_vector_space K V)⟩
 
-end division_ring
+section atoms_of_submodule_lattice
 
-section field
+variables {K V}
 
-variables [field K] [add_comm_group V] [add_comm_group V'] [module K V] [module K V']
-variables {v : ι → V} {s t : set V} {x y z : V}
+/-- For a module over a division ring, the span of a nonzero element is an atom of the
+lattice of submodules. -/
+lemma nonzero_span_atom (v : V) (hv : v ≠ 0) : is_atom (span K {v} : submodule K V) :=
+begin
+  split,
+  { rw submodule.ne_bot_iff, exact ⟨v, ⟨mem_span_singleton_self v, hv⟩⟩ },
+  { intros T hT, by_contra, apply hT.2,
+    change (span K {v}) ≤ T,
+    simp_rw [span_singleton_le_iff_mem, ← ne.def, submodule.ne_bot_iff] at *,
+    rcases h with ⟨s, ⟨hs, hz⟩⟩,
+    cases (mem_span_singleton.1 (hT.1 hs)) with a ha,
+    have h : a ≠ 0, by { intro h, rw [h, zero_smul] at ha, exact hz ha.symm },
+    apply_fun (λ x, a⁻¹ • x) at ha,
+    simp_rw [← mul_smul, inv_mul_cancel h, one_smul, ha] at *, exact smul_mem T _ hs},
+end
+
+/-- The atoms of the lattice of submodules of a module over a division ring are the
+submodules equal to the span of a nonzero element of the module. -/
+lemma atom_iff_nonzero_span (W : submodule K V) :
+  is_atom W ↔ ∃ (v : V) (hv : v ≠ 0), W = span K {v} :=
+begin
+  refine ⟨λ h, _, λ h, _ ⟩,
+  { cases h with hbot h,
+    rcases ((submodule.ne_bot_iff W).1 hbot) with ⟨v, ⟨hW, hv⟩⟩,
+    refine ⟨v, ⟨hv, _⟩⟩,
+    by_contra heq,
+    specialize h (span K {v}),
+    rw [span_singleton_eq_bot, lt_iff_le_and_ne] at h,
+    exact hv (h ⟨(span_singleton_le_iff_mem v W).2 hW, ne.symm heq⟩) },
+  { rcases h with ⟨v, ⟨hv, rfl⟩⟩, exact nonzero_span_atom v hv },
+end
+
+/-- The lattice of submodules of a module over a division ring is atomistic. -/
+instance : is_atomistic (submodule K V) :=
+{ eq_Sup_atoms :=
+  begin
+    intro W,
+    use {T : submodule K V | ∃ (v : V) (hv : v ∈ W) (hz : v ≠ 0), T = span K {v}},
+    refine ⟨submodule_eq_Sup_le_nonzero_spans W, _⟩,
+    rintros _ ⟨w, ⟨_, ⟨hw, rfl⟩⟩⟩, exact nonzero_span_atom w hw
+  end }
+
+end atoms_of_submodule_lattice
+
+variables {K V}
 
 lemma linear_map.exists_left_inverse_of_injective (f : V →ₗ[K] V')
   (hf_inj : f.ker = ⊥) : ∃g:V' →ₗ[K] V, g.comp f = linear_map.id :=
@@ -1222,7 +1370,7 @@ begin
   have BC := this.subset_extend (subset_univ _),
   let hC := basis.extend this,
   haveI : inhabited V := ⟨0⟩,
-  refine ⟨hC.constr K (C.restrict (inv_fun f)), hB.ext (λ b, _)⟩,
+  refine ⟨hC.constr ℕ (C.restrict (inv_fun f)), hB.ext (λ b, _)⟩,
   rw image_subset_iff at BC,
   have fb_eq : f b = hC ⟨f b, BC b.2⟩,
   { change f b = basis.extend this _,
@@ -1236,7 +1384,7 @@ lemma submodule.exists_is_compl (p : submodule K V) : ∃ q : submodule K V, is_
 let ⟨f, hf⟩ := p.subtype.exists_left_inverse_of_injective p.ker_subtype in
 ⟨f.ker, linear_map.is_compl_of_proj $ linear_map.ext_iff.1 hf⟩
 
-instance module.submodule.is_complemented : is_complemented (submodule K V) :=
+instance module.submodule.complemented_lattice : complemented_lattice (submodule K V) :=
 ⟨submodule.exists_is_compl⟩
 
 lemma linear_map.exists_right_inverse_of_surjective (f : V →ₗ[K] V')
@@ -1245,7 +1393,7 @@ begin
   let C := basis.of_vector_space_index K V',
   let hC := basis.of_vector_space K V',
   haveI : inhabited V := ⟨0⟩,
-  use hC.constr K (C.restrict (inv_fun f)),
+  use hC.constr ℕ (C.restrict (inv_fun f)),
   refine hC.ext (λ c, _),
   rw [linear_map.comp_apply, hC.constr_basis],
   simp [right_inverse_inv_fun (linear_map.range_eq_top.1 hf_surj) c]
@@ -1282,4 +1430,53 @@ let ⟨q, hq⟩ := p.exists_is_compl in nonempty.intro $
 ((quotient_equiv_of_is_compl p q hq).prod (linear_equiv.refl _ _)).trans
   (prod_equiv_of_is_compl q p hq.symm)
 
-end field
+end division_ring
+
+section restrict_scalars
+
+variables {S : Type*} [comm_ring R] [ring S] [nontrivial S] [add_comm_group M]
+variables [algebra R S] [module S M] [module R M]
+variables [is_scalar_tower R S M] [no_zero_smul_divisors R S] (b : basis ι S M)
+variables (R)
+
+open submodule
+
+/-- Let `b` be a `S`-basis of `M`. Let `R` be a comm_ring such that `algebra R S` with no zero
+smul divisors, then the submodule of `M` spanned by `b` over `R` admits `b` as a `R`-basis. -/
+noncomputable def basis.restrict_scalars : basis ι R (span R (set.range b)) :=
+basis.span (b.linear_independent.restrict_scalars (smul_left_injective R one_ne_zero))
+
+@[simp]
+lemma basis.restrict_scalars_apply (i : ι) : (b.restrict_scalars R i : M) = b i :=
+by simp only [basis.restrict_scalars, basis.span_apply]
+
+@[simp]
+lemma basis.restrict_scalars_repr_apply (m : span R (set.range b)) (i : ι) :
+  algebra_map R S ((b.restrict_scalars R).repr m i) = b.repr m i :=
+begin
+  suffices : finsupp.map_range.linear_map (algebra.linear_map R S) ∘ₗ
+      (b.restrict_scalars R).repr.to_linear_map
+      = ((b.repr : M →ₗ[S] (ι →₀ S)).restrict_scalars R).dom_restrict _,
+  { exact finsupp.congr_fun (linear_map.congr_fun this m) i, },
+  refine basis.ext (b.restrict_scalars R) (λ _, _),
+  simp only [linear_map.coe_comp, linear_equiv.coe_to_linear_map, function.comp_app, map_one,
+    basis.repr_self, finsupp.map_range.linear_map_apply, finsupp.map_range_single,
+    algebra.linear_map_apply, linear_map.dom_restrict_apply, linear_equiv.coe_coe,
+    basis.restrict_scalars_apply, linear_map.coe_restrict_scalars_eq_coe],
+end
+
+/-- Let `b` be a `S`-basis of `M`. Then `m : M` lies in the `R`-module spanned by `b` iff all the
+coordinates of `m` on the basis `b` are in `R` (see `basis.mem_span` for the case `R = S`). -/
+lemma basis.mem_span_iff_repr_mem (m : M) :
+  m ∈ span R (set.range b) ↔ ∀ i, b.repr m i ∈ set.range (algebra_map R S) :=
+begin
+  refine ⟨λ hm i, ⟨(b.restrict_scalars R).repr ⟨m, hm⟩ i,
+    (b.restrict_scalars_repr_apply R ⟨m, hm⟩ i)⟩, λ h, _⟩,
+  rw [← b.total_repr m, finsupp.total_apply S _],
+  refine sum_mem (λ i _, _),
+  obtain ⟨_, h⟩ := h i,
+  simp_rw [← h, algebra_map_smul],
+  exact smul_mem _ _ (subset_span (set.mem_range_self i)),
+end
+
+end restrict_scalars
diff --git a/src/linear_algebra/basis/bilinear.lean b/src/linear_algebra/basis/bilinear.lean
new file mode 100644
index 0000000000000..59232b8c26998
--- /dev/null
+++ b/src/linear_algebra/basis/bilinear.lean
@@ -0,0 +1,64 @@
+/-
+Copyright (c) 2022 Moritz Doll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Moritz Doll
+-/
+import linear_algebra.basis
+import linear_algebra.bilinear_map
+
+/-!
+# Lemmas about bilinear maps with a basis over each argument
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+namespace linear_map
+
+variables {ι₁ ι₂ : Type*}
+variables {R R₂ S S₂ M N P : Type*}
+variables {Mₗ Nₗ Pₗ : Type*}
+variables [comm_semiring R] [comm_semiring S] [comm_semiring R₂] [comm_semiring S₂]
+
+section add_comm_monoid
+
+variables [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
+variables [add_comm_monoid Mₗ] [add_comm_monoid Nₗ] [add_comm_monoid Pₗ]
+variables [module R M] [module S N] [module R₂ P] [module S₂ P]
+variables [module R Mₗ] [module R Nₗ] [module R Pₗ]
+variables [smul_comm_class S₂ R₂ P]
+variables {ρ₁₂ : R →+* R₂} {σ₁₂ : S →+* S₂}
+variables (b₁ : basis ι₁ R M) (b₂ : basis ι₂ S N) (b₁' : basis ι₁ R Mₗ) (b₂' : basis ι₂ R Nₗ)
+
+
+/-- Two bilinear maps are equal when they are equal on all basis vectors. -/
+lemma ext_basis {B B' : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P}
+  (h : ∀ i j, B (b₁ i) (b₂ j) = B' (b₁ i) (b₂ j)) : B = B' :=
+b₁.ext $ λ i, b₂.ext $ λ j, h i j
+
+/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis.
+
+Version for semi-bilinear maps, see `sum_repr_mul_repr_mul` for the bilinear version. -/
+lemma sum_repr_mul_repr_mulₛₗ {B : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (x y) :
+  (b₁.repr x).sum (λ i xi, (b₂.repr y).sum (λ j yj, (ρ₁₂ xi) • (σ₁₂ yj) • B (b₁ i) (b₂ j))) =
+  B x y :=
+begin
+  conv_rhs { rw [← b₁.total_repr x, ← b₂.total_repr y] },
+  simp_rw [finsupp.total_apply, finsupp.sum, map_sum₂, map_sum,
+    linear_map.map_smulₛₗ₂, linear_map.map_smulₛₗ],
+end
+
+/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis.
+
+Version for bilinear maps, see `sum_repr_mul_repr_mulₛₗ` for the semi-bilinear version. -/
+lemma sum_repr_mul_repr_mul {B : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ} (x y) :
+  (b₁'.repr x).sum (λ i xi, (b₂'.repr y).sum (λ j yj, xi • yj • B (b₁' i) (b₂' j))) =
+  B x y :=
+begin
+  conv_rhs { rw [← b₁'.total_repr x, ← b₂'.total_repr y] },
+  simp_rw [finsupp.total_apply, finsupp.sum, map_sum₂, map_sum,
+    linear_map.map_smul₂, linear_map.map_smul],
+end
+
+end add_comm_monoid
+
+end linear_map
diff --git a/src/linear_algebra/bilinear_form.lean b/src/linear_algebra/bilinear_form.lean
index 153cdf854b69e..c2aff4436f65f 100644
--- a/src/linear_algebra/bilinear_form.lean
+++ b/src/linear_algebra/bilinear_form.lean
@@ -5,12 +5,14 @@ Authors: Andreas Swerdlow, Kexing Ying
 -/
 
 import linear_algebra.dual
-import linear_algebra.matrix.to_lin
-import linear_algebra.tensor_product
+import linear_algebra.free_module.finite.matrix
 
 /-!
 # Bilinear form
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a bilinear form over a module. Basic ideas
 such as orthogonality are also introduced, as well as reflexivive,
 symmetric, non-degenerate and alternating bilinear forms. Adjoints of
@@ -114,79 +116,102 @@ by rw [sub_eq_add_neg, sub_eq_add_neg, add_left, neg_left]
 lemma sub_right (x y z : M₁) : B₁ x (y - z) = B₁ x y - B₁ x z :=
 by rw [sub_eq_add_neg, sub_eq_add_neg, add_right, neg_right]
 
-variable {D : bilin_form R M}
+variables {D : bilin_form R M} {D₁ : bilin_form R₁ M₁}
+
+-- TODO: instantiate `fun_like`
+lemma coe_injective : function.injective (coe_fn : bilin_form R M → (M → M → R)) :=
+λ B D h, by { cases B, cases D, congr' }
 
 @[ext] lemma ext (H : ∀ (x y : M), B x y = D x y) : B = D :=
-by { cases B, cases D, congr, funext, exact H _ _ }
+coe_injective $ by { funext, exact H _ _ }
 
 lemma congr_fun (h : B = D) (x y : M) : B x y = D x y := h ▸ rfl
 
 lemma ext_iff : B = D ↔ (∀ x y, B x y = D x y) := ⟨congr_fun, ext⟩
 
-instance : add_comm_monoid (bilin_form R M) :=
-{ add := λ B D, { bilin := λ x y, B x y + D x y,
-                  bilin_add_left := λ x y z, by rw [add_left, add_left, add_add_add_comm],
-                  bilin_smul_left := λ a x y, by rw [smul_left, smul_left, mul_add],
-                  bilin_add_right := λ x y z, by rw [add_right, add_right, add_add_add_comm],
-                  bilin_smul_right := λ a x y, by rw [smul_right, smul_right, mul_add] },
-  add_assoc := by { intros, ext, unfold bilin coe_fn has_coe_to_fun.coe bilin, rw add_assoc },
-  zero := { bilin := λ x y, 0,
+instance : has_zero (bilin_form R M) :=
+{ zero := { bilin := λ x y, 0,
             bilin_add_left := λ x y z, (add_zero 0).symm,
             bilin_smul_left := λ a x y, (mul_zero a).symm,
             bilin_add_right := λ x y z, (zero_add 0).symm,
-            bilin_smul_right := λ a x y, (mul_zero a).symm },
-  zero_add := by { intros, ext, unfold coe_fn has_coe_to_fun.coe bilin, rw zero_add },
-  add_zero := by { intros, ext, unfold coe_fn has_coe_to_fun.coe bilin, rw add_zero },
-  add_comm := by { intros, ext, unfold coe_fn has_coe_to_fun.coe bilin, rw add_comm } }
+            bilin_smul_right := λ a x y, (mul_zero a).symm } }
 
-instance : add_comm_group (bilin_form R₁ M₁) :=
-{ neg := λ B, { bilin := λ x y, - (B.1 x y),
-                bilin_add_left := λ x y z, by rw [bilin_add_left, neg_add],
-                bilin_smul_left := λ a x y, by rw [bilin_smul_left, mul_neg],
-                bilin_add_right := λ x y z, by rw [bilin_add_right, neg_add],
-                bilin_smul_right := λ a x y, by rw [bilin_smul_right, mul_neg] },
-  add_left_neg := by { intros, ext, unfold coe_fn has_coe_to_fun.coe bilin, rw neg_add_self },
-  .. bilin_form.add_comm_monoid }
+@[simp] lemma coe_zero : ⇑(0 : bilin_form R M) = 0 := rfl
+@[simp] lemma zero_apply (x y : M) : (0 : bilin_form R M) x y = 0 := rfl
 
-@[simp]
-lemma add_apply (x y : M) : (B + D) x y = B x y + D x y := rfl
-
-@[simp]
-lemma zero_apply (x y : M) : (0 : bilin_form R M) x y = 0 := rfl
+variables (B D B₁ D₁)
 
-@[simp]
-lemma neg_apply (x y : M₁) : (-B₁) x y = -(B₁ x y) := rfl
-
-instance : inhabited (bilin_form R M) := ⟨0⟩
+instance : has_add (bilin_form R M) :=
+{ add := λ B D, { bilin := λ x y, B x y + D x y,
+                  bilin_add_left := λ x y z, by rw [add_left, add_left, add_add_add_comm],
+                  bilin_smul_left := λ a x y, by rw [smul_left, smul_left, mul_add],
+                  bilin_add_right := λ x y z, by rw [add_right, add_right, add_add_add_comm],
+                  bilin_smul_right := λ a x y, by rw [smul_right, smul_right, mul_add] } }
 
-section
+@[simp] lemma coe_add : ⇑(B + D) = B + D := rfl
+@[simp] lemma add_apply (x y : M) : (B + D) x y = B x y + D x y := rfl
 
-/-- `bilin_form R M` inherits the scalar action from any commutative subalgebra `R₂` of `R`.
+/-- `bilin_form R M` inherits the scalar action by `α` on `R` if this is compatible with
+multiplication.
 
 When `R` itself is commutative, this provides an `R`-action via `algebra.id`. -/
-instance [algebra R₂ R] : module R₂ (bilin_form R M) :=
+instance {α} [monoid α] [distrib_mul_action α R] [smul_comm_class α R R] :
+  has_smul α (bilin_form R M) :=
 { smul := λ c B,
   { bilin := λ x y, c • B x y,
-    bilin_add_left := λ x y z,
-      by { unfold coe_fn has_coe_to_fun.coe bilin, rw [bilin_add_left, smul_add] },
-    bilin_smul_left := λ a x y, by { unfold coe_fn has_coe_to_fun.coe bilin,
-      rw [bilin_smul_left, ←algebra.mul_smul_comm] },
-    bilin_add_right := λ x y z, by { unfold coe_fn has_coe_to_fun.coe bilin,
-      rw [bilin_add_right, smul_add] },
-    bilin_smul_right := λ a x y, by { unfold coe_fn has_coe_to_fun.coe bilin,
-      rw [bilin_smul_right, ←algebra.mul_smul_comm] } },
-  smul_add := λ c B D, by { ext, unfold coe_fn has_coe_to_fun.coe bilin, rw smul_add },
-  add_smul := λ c B D, by { ext, unfold coe_fn has_coe_to_fun.coe bilin, rw add_smul },
-  mul_smul := λ a c D, by { ext, unfold coe_fn has_coe_to_fun.coe bilin, rw ←smul_assoc, refl },
-  one_smul := λ B, by { ext, unfold coe_fn has_coe_to_fun.coe bilin, rw one_smul },
-  zero_smul := λ B, by { ext, unfold coe_fn has_coe_to_fun.coe bilin, rw zero_smul },
-  smul_zero := λ B, by { ext, unfold coe_fn has_coe_to_fun.coe bilin, rw smul_zero } }
-
-@[simp] lemma smul_apply [algebra R₂ R] (B : bilin_form R M) (a : R₂) (x y : M) :
+    bilin_add_left := λ x y z, by { rw [add_left, smul_add] },
+    bilin_smul_left := λ a x y, by { rw [smul_left, ←mul_smul_comm] },
+    bilin_add_right := λ x y z, by { rw [add_right, smul_add] },
+    bilin_smul_right := λ a x y, by { rw [smul_right, ←mul_smul_comm] } } }
+
+@[simp] lemma coe_smul {α} [monoid α] [distrib_mul_action α R] [smul_comm_class α R R]
+  (a : α) (B : bilin_form R M) : ⇑(a • B) = a • B := rfl
+
+@[simp] lemma smul_apply {α} [monoid α] [distrib_mul_action α R] [smul_comm_class α R R]
+  (a : α) (B : bilin_form R M) (x y : M) :
   (a • B) x y = a • (B x y) :=
 rfl
 
-end
+instance : add_comm_monoid (bilin_form R M) :=
+function.injective.add_comm_monoid _ coe_injective coe_zero coe_add (λ n x, coe_smul _ _)
+
+instance : has_neg (bilin_form R₁ M₁) :=
+{ neg := λ B, { bilin := λ x y, -(B x y),
+                bilin_add_left := λ x y z, by rw [add_left, neg_add],
+                bilin_smul_left := λ a x y, by rw [smul_left, mul_neg],
+                bilin_add_right := λ x y z, by rw [add_right, neg_add],
+                bilin_smul_right := λ a x y, by rw [smul_right, mul_neg] } }
+
+@[simp] lemma coe_neg : ⇑(-B₁) = -B₁ := rfl
+@[simp] lemma neg_apply (x y : M₁) : (-B₁) x y = -(B₁ x y) := rfl
+
+instance : has_sub (bilin_form R₁ M₁) :=
+{ sub := λ B D, { bilin := λ x y, B x y - D x y,
+                  bilin_add_left := λ x y z, by rw [add_left, add_left, add_sub_add_comm],
+                  bilin_smul_left := λ a x y, by rw [smul_left, smul_left, mul_sub],
+                  bilin_add_right := λ x y z, by rw [add_right, add_right, add_sub_add_comm],
+                  bilin_smul_right := λ a x y, by rw [smul_right, smul_right, mul_sub] } }
+
+@[simp] lemma coe_sub : ⇑(B₁ - D₁) = B₁ - D₁ := rfl
+@[simp] lemma sub_apply (x y : M₁) : (B₁ - D₁) x y = B₁ x y - D₁ x y := rfl
+
+instance : add_comm_group (bilin_form R₁ M₁) :=
+function.injective.add_comm_group _ coe_injective coe_zero coe_add coe_neg coe_sub
+  (λ n x, coe_smul _ _) (λ n x, coe_smul _ _)
+
+instance : inhabited (bilin_form R M) := ⟨0⟩
+
+/-- `coe_fn` as an `add_monoid_hom` -/
+def coe_fn_add_monoid_hom : bilin_form R M →+ (M → M → R) :=
+{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add }
+
+instance {α} [monoid α] [distrib_mul_action α R] [smul_comm_class α R R] :
+  distrib_mul_action α (bilin_form R M) :=
+function.injective.distrib_mul_action coe_fn_add_monoid_hom coe_injective coe_smul
+
+instance {α} [semiring α] [module α R] [smul_comm_class α R R] :
+  module α (bilin_form R M) :=
+function.injective.module _ coe_fn_add_monoid_hom coe_injective coe_smul
 
 section flip
 
@@ -381,6 +406,23 @@ lemma bilin_form.to_lin_apply (x : M₂) : ⇑(bilin_form.to_lin B₂ x) = B₂
 
 end equiv_lin
 
+namespace linear_map
+
+variables {R' : Type*} [comm_semiring R'] [algebra R' R] [module R' M] [is_scalar_tower R' R M]
+
+/-- Apply a linear map on the output of a bilinear form. -/
+@[simps]
+def comp_bilin_form (f : R →ₗ[R'] R') (B : bilin_form R M) : bilin_form R' M :=
+{ bilin := λ x y, f (B x y),
+  bilin_add_left := λ x y z, by rw [bilin_form.add_left, map_add],
+  bilin_smul_left := λ r x y, by rw [←smul_one_smul R r (_ : M), bilin_form.smul_left,
+                                     smul_one_mul r (_ : R), map_smul, smul_eq_mul],
+  bilin_add_right := λ x y z, by rw [bilin_form.add_right, map_add],
+  bilin_smul_right := λ r x y, by rw [←smul_one_smul R r (_ : M), bilin_form.smul_right,
+                                      smul_one_mul r (_ : R), map_smul, smul_eq_mul] }
+
+end linear_map
+
 namespace bilin_form
 
 section comp
@@ -616,24 +658,26 @@ end
 
 section basis
 
-variables {B₃ F₃ : bilin_form R₃ M₃}
-variables {ι : Type*} (b : basis ι R₃ M₃)
+variables {F₂ : bilin_form R₂ M₂}
+variables {ι : Type*} (b : basis ι R₂ M₂)
 
 /-- Two bilinear forms are equal when they are equal on all basis vectors. -/
-lemma ext_basis (h : ∀ i j, B₃ (b i) (b j) = F₃ (b i) (b j)) : B₃ = F₃ :=
+lemma ext_basis (h : ∀ i j, B₂ (b i) (b j) = F₂ (b i) (b j)) : B₂ = F₂ :=
 to_lin.injective $ b.ext $ λ i, b.ext $ λ j, h i j
 
 /-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis. -/
-lemma sum_repr_mul_repr_mul (x y : M₃) :
-  (b.repr x).sum (λ i xi, (b.repr y).sum (λ j yj, xi • yj • B₃ (b i) (b j))) = B₃ x y :=
+lemma sum_repr_mul_repr_mul (x y : M₂) :
+  (b.repr x).sum (λ i xi, (b.repr y).sum (λ j yj, xi • yj • B₂ (b i) (b j))) = B₂ x y :=
 begin
   conv_rhs { rw [← b.total_repr x, ← b.total_repr y] },
   simp_rw [finsupp.total_apply, finsupp.sum, sum_left, sum_right,
-    smul_left, smul_right, smul_eq_mul]
+    smul_left, smul_right, smul_eq_mul],
 end
 
 end basis
 
+/-! ### Reflexivity, symmetry, and alternativity -/
+
 /-- The proposition that a bilinear form is reflexive -/
 def is_refl (B : bilin_form R M) : Prop := ∀ (x y : M), B x y = 0 → B y x = 0
 
@@ -646,8 +690,26 @@ lemma eq_zero : ∀ {x y : M}, B x y = 0 → B y x = 0 := λ x y, H x y
 lemma ortho_comm {x y : M} :
   is_ortho B x y ↔ is_ortho B y x := ⟨eq_zero H, eq_zero H⟩
 
+protected lemma neg {B : bilin_form R₁ M₁} (hB : B.is_refl) : (-B).is_refl :=
+λ x y, neg_eq_zero.mpr ∘ hB x y ∘ neg_eq_zero.mp
+
+protected lemma smul {α} [semiring α] [module α R] [smul_comm_class α R R]
+  [no_zero_smul_divisors α R] (a : α) {B : bilin_form R M} (hB : B.is_refl) : (a • B).is_refl :=
+λ x y h, (smul_eq_zero.mp h).elim
+  (λ ha, smul_eq_zero_of_left ha _)
+  (λ hBz, smul_eq_zero_of_right _ (hB _ _ hBz))
+
+protected lemma group_smul {α} [group α] [distrib_mul_action α R] [smul_comm_class α R R]
+  (a : α) {B : bilin_form R M} (hB : B.is_refl) : (a • B).is_refl :=
+λ x y, (smul_eq_zero_iff_eq _).mpr ∘ hB x y ∘ (smul_eq_zero_iff_eq _).mp
+
 end is_refl
 
+@[simp] lemma is_refl_zero : (0 : bilin_form R M).is_refl := λ _ _ _, rfl
+
+@[simp] lemma is_refl_neg {B : bilin_form R₁ M₁} : (-B).is_refl ↔ B.is_refl :=
+⟨λ h, neg_neg B ▸ h.neg, is_refl.neg⟩
+
 /-- The proposition that a bilinear form is symmetric -/
 def is_symm (B : bilin_form R M) : Prop := ∀ (x y : M), B x y = B y x
 
@@ -662,8 +724,30 @@ lemma is_refl : B.is_refl := λ x y H1, H x y ▸ H1
 lemma ortho_comm {x y : M} :
   is_ortho B x y ↔ is_ortho B y x := H.is_refl.ortho_comm
 
+protected lemma add {B₁ B₂ : bilin_form R M} (hB₁ : B₁.is_symm) (hB₂ : B₂.is_symm) :
+  (B₁ + B₂).is_symm :=
+λ x y, (congr_arg2 (+) (hB₁ x y) (hB₂ x y) : _)
+
+protected lemma sub {B₁ B₂ : bilin_form R₁ M₁} (hB₁ : B₁.is_symm) (hB₂ : B₂.is_symm) :
+  (B₁ - B₂).is_symm :=
+λ x y, (congr_arg2 has_sub.sub (hB₁ x y) (hB₂ x y) : _)
+
+protected lemma neg {B : bilin_form R₁ M₁} (hB : B.is_symm) :
+  (-B).is_symm :=
+λ x y, congr_arg has_neg.neg (hB x y)
+
+protected lemma smul {α} [monoid α] [distrib_mul_action α R] [smul_comm_class α R R]
+  (a : α) {B : bilin_form R M} (hB : B.is_symm) :
+  (a • B).is_symm :=
+λ x y, congr_arg ((•) a) (hB x y)
+
 end is_symm
 
+@[simp] lemma is_symm_zero : (0 : bilin_form R M).is_symm := λ _ _, rfl
+
+@[simp] lemma is_symm_neg {B : bilin_form R₁ M₁} : (-B).is_symm ↔ B.is_symm :=
+⟨λ h, neg_neg B ▸ h.neg, is_symm.neg⟩
+
 lemma is_symm_iff_flip' [algebra R₂ R] : B.is_symm ↔ flip_hom R₂ B = B :=
 begin
   split,
@@ -682,7 +766,7 @@ namespace is_alt
 
 lemma self_eq_zero (H : B.is_alt) (x : M) : B x x = 0 := H x
 
-lemma neg (H : B₁.is_alt) (x y : M₁) :
+lemma neg_eq (H : B₁.is_alt) (x y : M₁) :
   - B₁ x y = B₁ y x :=
 begin
   have H1 : B₁ (x + y) (x + y) = 0,
@@ -696,14 +780,38 @@ end
 lemma is_refl (H : B₁.is_alt) : B₁.is_refl :=
 begin
   intros x y h,
-  rw [←neg H, h, neg_zero],
+  rw [←neg_eq H, h, neg_zero],
 end
 
 lemma ortho_comm (H : B₁.is_alt) {x y : M₁} :
   is_ortho B₁ x y ↔ is_ortho B₁ y x := H.is_refl.ortho_comm
 
+protected lemma add {B₁ B₂ : bilin_form R M} (hB₁ : B₁.is_alt) (hB₂ : B₂.is_alt) :
+  (B₁ + B₂).is_alt :=
+λ x, (congr_arg2 (+) (hB₁ x) (hB₂ x) : _).trans $ add_zero _
+
+protected lemma sub {B₁ B₂ : bilin_form R₁ M₁} (hB₁ : B₁.is_alt) (hB₂ : B₂.is_alt) :
+  (B₁ - B₂).is_alt :=
+λ x, (congr_arg2 has_sub.sub (hB₁ x) (hB₂ x)).trans $ sub_zero _
+
+protected lemma neg {B : bilin_form R₁ M₁} (hB : B.is_alt) :
+  (-B).is_alt :=
+λ x, neg_eq_zero.mpr $ hB x
+
+protected lemma smul {α} [monoid α] [distrib_mul_action α R] [smul_comm_class α R R]
+  (a : α) {B : bilin_form R M} (hB : B.is_alt) :
+  (a • B).is_alt :=
+λ x, (congr_arg ((•) a) (hB x)).trans $ smul_zero _
+
 end is_alt
 
+@[simp] lemma is_alt_zero : (0 : bilin_form R M).is_alt := λ _, rfl
+
+@[simp] lemma is_alt_neg {B : bilin_form R₁ M₁} : (-B).is_alt ↔ B.is_alt :=
+⟨λ h, neg_neg B ▸ h.neg, is_alt.neg⟩
+
+/-! ### Linear adjoints -/
+
 section linear_adjoints
 
 variables (B) (F : bilin_form R M)
@@ -781,18 +889,15 @@ def is_pair_self_adjoint_submodule : submodule R₂ (module.End R₂ M₂) :=
   f ∈ is_pair_self_adjoint_submodule B₂ F₂ ↔ is_pair_self_adjoint B₂ F₂ f :=
 by refl
 
-variables {M₃' : Type*} [add_comm_group M₃'] [module R₃ M₃']
-variables (B₃ F₃ : bilin_form R₃ M₃)
-
-lemma is_pair_self_adjoint_equiv (e : M₃' ≃ₗ[R₃] M₃) (f : module.End R₃ M₃) :
-  is_pair_self_adjoint B₃ F₃ f ↔
-    is_pair_self_adjoint (B₃.comp ↑e ↑e) (F₃.comp ↑e ↑e) (e.symm.conj f) :=
+lemma is_pair_self_adjoint_equiv (e : M₂' ≃ₗ[R₂] M₂) (f : module.End R₂ M₂) :
+  is_pair_self_adjoint B₂ F₂ f ↔
+    is_pair_self_adjoint (B₂.comp ↑e ↑e) (F₂.comp ↑e ↑e) (e.symm.conj f) :=
 begin
-  have hₗ : (F₃.comp ↑e ↑e).comp_left (e.symm.conj f) = (F₃.comp_left f).comp ↑e ↑e :=
+  have hₗ : (F₂.comp ↑e ↑e).comp_left (e.symm.conj f) = (F₂.comp_left f).comp ↑e ↑e :=
     by { ext, simp [linear_equiv.symm_conj_apply], },
-  have hᵣ : (B₃.comp ↑e ↑e).comp_right (e.symm.conj f) = (B₃.comp_right f).comp ↑e ↑e :=
+  have hᵣ : (B₂.comp ↑e ↑e).comp_right (e.symm.conj f) = (B₂.comp_right f).comp ↑e ↑e :=
     by { ext, simp [linear_equiv.conj_apply], },
-  have he : function.surjective (⇑(↑e : M₃' →ₗ[R₃] M₃) : M₃' → M₃) := e.surjective,
+  have he : function.surjective (⇑(↑e : M₂' →ₗ[R₂] M₂) : M₂' → M₂) := e.surjective,
   show bilin_form.is_adjoint_pair _ _ _ _  ↔ bilin_form.is_adjoint_pair _ _ _ _,
   rw [is_adjoint_pair_iff_comp_left_eq_comp_right, is_adjoint_pair_iff_comp_left_eq_comp_right,
       hᵣ, hₗ, comp_inj _ _ he he],
@@ -818,6 +923,8 @@ def self_adjoint_submodule := is_pair_self_adjoint_submodule B₂ B₂
 @[simp] lemma mem_self_adjoint_submodule (f : module.End R₂ M₂) :
   f ∈ B₂.self_adjoint_submodule ↔ B₂.is_self_adjoint f := iff.rfl
 
+variables (B₃ : bilin_form R₃ M₃)
+
 /-- The set of skew-adjoint endomorphisms of a module with bilinear form is a submodule. (In fact
 it is a Lie subalgebra.) -/
 def skew_adjoint_submodule := is_pair_self_adjoint_submodule (-B₃) B₃
@@ -906,8 +1013,8 @@ end
   is complement to its orthogonal complement. -/
 lemma is_compl_span_singleton_orthogonal {B : bilin_form K V}
   {x : V} (hx : ¬ B.is_ortho x x) : is_compl (K ∙ x) (B.orthogonal $ K ∙ x) :=
-{ inf_le_bot := eq_bot_iff.1 $ span_singleton_inf_orthogonal_eq_bot hx,
-  top_le_sup := eq_top_iff.1 $ span_singleton_sup_orthogonal_eq_top hx }
+{ disjoint := disjoint_iff.2 $ span_singleton_inf_orthogonal_eq_bot hx,
+  codisjoint := codisjoint_iff.2 $ span_singleton_sup_orthogonal_eq_top hx }
 
 end orthogonal
 
@@ -985,7 +1092,7 @@ lemma nondegenerate_restrict_of_disjoint_orthogonal
 begin
   rintro ⟨x, hx⟩ b₁,
   rw [submodule.mk_eq_zero, ← submodule.mem_bot R₁],
-  refine hW ⟨hx, λ y hy, _⟩,
+  refine hW.le_bot ⟨hx, λ y hy, _⟩,
   specialize b₁ ⟨y, hy⟩,
   rw [restrict_apply, submodule.coe_mk, submodule.coe_mk] at b₁,
   exact is_ortho_def.mpr (b x y b₁),
@@ -1008,7 +1115,7 @@ begin
   convert mul_zero _ using 2,
   obtain rfl | hij := eq_or_ne i j,
   { exact ho },
-  { exact h i j hij },
+  { exact h hij },
 end
 
 /-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is nondegenerate
@@ -1026,7 +1133,7 @@ begin
   simp_rw [basis.repr_symm_apply, finsupp.total_apply, finsupp.sum, sum_left, smul_left] at hB,
   rw finset.sum_eq_single i at hB,
   { exact eq_zero_of_ne_zero_of_mul_right_eq_zero (ho i) hB, },
-  { intros j hj hij, convert mul_zero _ using 2, exact hO j i hij, },
+  { intros j hj hij, convert mul_zero _ using 2, exact hO hij, },
   { intros hi, convert zero_mul _ using 2, exact finsupp.not_mem_support_iff.mp hi }
 end
 
@@ -1052,15 +1159,15 @@ begin
     exact hx.2 _ submodule.mem_top }
 end
 
-lemma to_lin_restrict_range_dual_annihilator_comap_eq_orthogonal
+lemma to_lin_restrict_range_dual_coannihilator_eq_orthogonal
   (B : bilin_form K V) (W : subspace K V) :
-  (B.to_lin.dom_restrict W).range.dual_annihilator_comap = B.orthogonal W :=
+  (B.to_lin.dom_restrict W).range.dual_coannihilator = B.orthogonal W :=
 begin
   ext x, split; rw [mem_orthogonal_iff]; intro hx,
   { intros y hy,
-    rw submodule.mem_dual_annihilator_comap_iff at hx,
+    rw submodule.mem_dual_coannihilator at hx,
     refine hx (B.to_lin.dom_restrict W ⟨y, hy⟩) ⟨⟨y, hy⟩, rfl⟩ },
-  { rw submodule.mem_dual_annihilator_comap_iff,
+  { rw submodule.mem_dual_coannihilator,
     rintro _ ⟨⟨w, hw⟩, rfl⟩,
     exact hx w hw }
 end
@@ -1075,9 +1182,9 @@ lemma finrank_add_finrank_orthogonal
   finrank K V + finrank K (W ⊓ B.orthogonal ⊤ : subspace K V) :=
 begin
   rw [← to_lin_restrict_ker_eq_inf_orthogonal _ _ b₁,
-      ← to_lin_restrict_range_dual_annihilator_comap_eq_orthogonal _ _,
-      finrank_map_subtype_eq],
-  conv_rhs { rw [← @subspace.finrank_add_finrank_dual_annihilator_comap_eq K V _ _ _ _
+      ← to_lin_restrict_range_dual_coannihilator_eq_orthogonal _ _,
+      submodule.finrank_map_subtype_eq],
+  conv_rhs { rw [← @subspace.finrank_add_finrank_dual_coannihilator_eq K V _ _ _ _
                   (B.to_lin.dom_restrict W).range,
                  add_comm, ← add_assoc, add_comm (finrank K ↥((B.to_lin.dom_restrict W).ker)),
                  linear_map.finrank_range_add_finrank_ker] },
@@ -1098,14 +1205,11 @@ begin
     rintro ⟨n, hn⟩,
     rw [restrict_apply, submodule.coe_mk, submodule.coe_mk, b₁],
     exact hx₂ n hn },
-  refine ⟨this ▸ le_rfl, _⟩,
-  { rw top_le_iff,
-    refine eq_top_of_finrank_eq _,
-    refine le_antisymm (submodule.finrank_le _) _,
-    conv_rhs { rw ← add_zero (finrank K _) },
-    rw [← finrank_bot K V, ← this, submodule.dim_sup_add_dim_inf_eq,
-        finrank_add_finrank_orthogonal b₁],
-    exact nat.le.intro rfl }
+  refine is_compl.of_eq this (eq_top_of_finrank_eq $ (submodule.finrank_le _).antisymm _),
+  conv_rhs { rw ← add_zero (finrank K _) },
+  rw [← finrank_bot K V, ← this, submodule.finrank_sup_add_finrank_inf_eq,
+      finrank_add_finrank_orthogonal b₁],
+  exact le_self_add,
 end
 
 /-- A subspace is complement to its orthogonal complement with respect to some reflexive bilinear
diff --git a/src/linear_algebra/bilinear_form/tensor_product.lean b/src/linear_algebra/bilinear_form/tensor_product.lean
new file mode 100644
index 0000000000000..47f45b2f6360a
--- /dev/null
+++ b/src/linear_algebra/bilinear_form/tensor_product.lean
@@ -0,0 +1,85 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import linear_algebra.bilinear_form
+import linear_algebra.tensor_product
+
+/-!
+# The bilinear form on a tensor product
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `bilin_form.tensor_distrib (B₁ ⊗ₜ B₂)`: the bilinear form on `M₁ ⊗ M₂` constructed by applying
+  `B₁` on `M₁` and `B₂` on `M₂`.
+* `bilin_form.tensor_distrib_equiv`: `bilin_form.tensor_distrib` as an equivalence on finite free
+  modules.
+
+-/
+
+universes u v w
+variables {ι : Type*} {R : Type*} {M₁ M₂ : Type*}
+
+open_locale tensor_product
+
+namespace bilin_form
+
+section comm_semiring
+variables [comm_semiring R]
+variables [add_comm_monoid M₁] [add_comm_monoid M₂]
+variables [module R M₁] [module R M₂]
+
+/-- The tensor product of two bilinear forms injects into bilinear forms on tensor products. -/
+def tensor_distrib : bilin_form R M₁ ⊗[R] bilin_form R M₂ →ₗ[R] bilin_form R (M₁ ⊗[R] M₂) :=
+((tensor_product.tensor_tensor_tensor_comm R _ _ _ _).dual_map
+  ≪≫ₗ (tensor_product.lift.equiv R _ _ _).symm
+  ≪≫ₗ linear_map.to_bilin).to_linear_map
+  ∘ₗ tensor_product.dual_distrib R _ _
+  ∘ₗ (tensor_product.congr
+    (bilin_form.to_lin ≪≫ₗ tensor_product.lift.equiv R _ _ _)
+    (bilin_form.to_lin ≪≫ₗ tensor_product.lift.equiv R _ _ _)).to_linear_map
+
+@[simp] lemma tensor_distrib_tmul (B₁ : bilin_form R M₁) (B₂ : bilin_form R M₂)
+  (m₁ : M₁) (m₂ : M₂) (m₁' : M₁) (m₂' : M₂) :
+  tensor_distrib (B₁ ⊗ₜ B₂) (m₁ ⊗ₜ m₂) (m₁' ⊗ₜ m₂') = B₁ m₁ m₁' * B₂ m₂ m₂' :=
+rfl
+
+/-- The tensor product of two bilinear forms, a shorthand for dot notation. -/
+@[reducible]
+protected def tmul (B₁ : bilin_form R M₁) (B₂ : bilin_form R M₂) : bilin_form R (M₁ ⊗[R] M₂) :=
+tensor_distrib (B₁ ⊗ₜ[R] B₂)
+
+end comm_semiring
+
+section comm_ring
+variables [comm_ring R]
+variables [add_comm_group M₁] [add_comm_group M₂]
+variables [module R M₁] [module R M₂]
+variables [module.free R M₁] [module.finite R M₁]
+variables [module.free R M₂] [module.finite R M₂]
+variables [nontrivial R]
+
+/-- `tensor_distrib` as an equivalence. -/
+noncomputable def tensor_distrib_equiv :
+  bilin_form R M₁ ⊗[R] bilin_form R M₂ ≃ₗ[R] bilin_form R (M₁ ⊗[R] M₂) :=
+-- the same `linear_equiv`s as from `tensor_distrib`, but with the inner linear map also as an
+-- equiv
+tensor_product.congr
+    (bilin_form.to_lin ≪≫ₗ tensor_product.lift.equiv R _ _ _)
+    (bilin_form.to_lin ≪≫ₗ tensor_product.lift.equiv R _ _ _)
+  ≪≫ₗ tensor_product.dual_distrib_equiv R (M₁ ⊗ M₁) (M₂ ⊗ M₂)
+  ≪≫ₗ (tensor_product.tensor_tensor_tensor_comm R _ _ _ _).dual_map
+  ≪≫ₗ (tensor_product.lift.equiv R _ _ _).symm
+  ≪≫ₗ linear_map.to_bilin
+
+@[simp]
+lemma tensor_distrib_equiv_apply (B : bilin_form R M₁ ⊗ bilin_form R M₂) :
+  tensor_distrib_equiv B = tensor_distrib B := rfl
+
+end comm_ring
+
+end bilin_form
diff --git a/src/linear_algebra/bilinear_map.lean b/src/linear_algebra/bilinear_map.lean
index 84cd7d4333f22..164757c87cb16 100644
--- a/src/linear_algebra/bilinear_map.lean
+++ b/src/linear_algebra/bilinear_map.lean
@@ -5,11 +5,13 @@ Authors: Kenny Lau, Mario Carneiro
 -/
 
 import linear_algebra.basic
-import linear_algebra.basis
 
 /-!
 # Basics on bilinear maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides basics on bilinear maps. The most general form considered are maps that are
 semilinear in both arguments. They are of type `M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P`, where `M` and `N`
 are modules over `R` and `S` respectively, `P` is a module over both `R₂` and `S₂` with
@@ -30,7 +32,6 @@ commuting actions, and `ρ₁₂ : R →+* R₂` and `σ₁₂ : S →+* S₂`.
 bilinear
 -/
 
-variables {ι₁ ι₂ : Type*}
 
 namespace linear_map
 
@@ -148,7 +149,7 @@ def dom_restrict₂ (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (q : sub
   M →ₛₗ[ρ₁₂] q →ₛₗ[σ₁₂] P :=
 { to_fun := λ m, (f m).dom_restrict q,
   map_add' := λ m₁ m₂, linear_map.ext $ λ _, by simp only [map_add, dom_restrict_apply, add_apply],
-  map_smul' := λ c m, linear_map.ext $ λ _, by simp only [map_smulₛₗ, dom_restrict_apply,
+  map_smul' := λ c m, linear_map.ext $ λ _, by simp only [f.map_smulₛₗ, dom_restrict_apply,
     smul_apply]}
 
 lemma dom_restrict₂_apply (f : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P) (q : submodule S N) (x : M) (y : q) :
@@ -256,6 +257,9 @@ include σ₄₃
   f.compl₂ g m q = f m (g q) := rfl
 omit σ₄₃
 
+@[simp] theorem compl₂_id : f.compl₂ linear_map.id = f :=
+by { ext, rw [compl₂_apply, id_coe, id.def] }
+
 /-- Composing linear maps `Q → M` and `Q' → N` with a bilinear map `M → N → P` to
 form a bilinear map `Q → Q' → P`. -/
 def compl₁₂ (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Qₗ →ₗ[R] Mₗ) (g' : Qₗ' →ₗ[R] Nₗ) :
@@ -265,6 +269,10 @@ def compl₁₂ (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Qₗ →ₗ[R] M
 @[simp] theorem compl₁₂_apply (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) (g : Qₗ →ₗ[R] Mₗ) (g' : Qₗ' →ₗ[R] Nₗ)
   (x : Qₗ) (y : Qₗ') : f.compl₁₂ g g' x y = f (g x) (g' y) := rfl
 
+@[simp] theorem compl₁₂_id_id (f : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ) :
+  f.compl₁₂ (linear_map.id) (linear_map.id) = f :=
+by { ext, simp_rw [compl₁₂_apply, id_coe, id.def] }
+
 lemma compl₁₂_inj {f₁ f₂ : Mₗ →ₗ[R] Nₗ →ₗ[R] Pₗ} {g : Qₗ →ₗ[R] Mₗ} {g' : Qₗ' →ₗ[R] Nₗ}
   (hₗ : function.surjective g) (hᵣ : function.surjective g') :
   f₁.compl₁₂ g g' = f₂.compl₁₂ g g' ↔ f₁ = f₂ :=
@@ -301,12 +309,13 @@ end comm_semiring
 section comm_ring
 
 variables {R R₂ S S₂ M N P : Type*}
+variables {Mₗ Nₗ Pₗ : Type*}
 variables [comm_ring R] [comm_ring S] [comm_ring R₂] [comm_ring S₂]
+
+section add_comm_group
+
 variables [add_comm_group M] [add_comm_group N] [add_comm_group P]
 variables [module R M] [module S N] [module R₂ P] [module S₂ P]
-variables [smul_comm_class S₂ R₂ P]
-variables {ρ₁₂ : R →+* R₂} {σ₁₂ : S →+* S₂}
-variables (b₁ : basis ι₁ R M) (b₂ : basis ι₂ S N)
 
 lemma lsmul_injective [no_zero_smul_divisors R M] {x : R} (hx : x ≠ 0) :
   function.injective (lsmul R M x) :=
@@ -316,21 +325,7 @@ lemma ker_lsmul [no_zero_smul_divisors R M] {a : R} (ha : a ≠ 0) :
   (linear_map.lsmul R M a).ker = ⊥ :=
 linear_map.ker_eq_bot_of_injective (linear_map.lsmul_injective ha)
 
-
-/-- Two bilinear maps are equal when they are equal on all basis vectors. -/
-lemma ext_basis {B B' : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P}
-  (h : ∀ i j, B (b₁ i) (b₂ j) = B' (b₁ i) (b₂ j)) : B = B' :=
-b₁.ext $ λ i, b₂.ext $ λ j, h i j
-
-/-- Write out `B x y` as a sum over `B (b i) (b j)` if `b` is a basis. -/
-lemma sum_repr_mul_repr_mul {B : M →ₛₗ[ρ₁₂] N →ₛₗ[σ₁₂] P} (x y) :
-  (b₁.repr x).sum (λ i xi, (b₂.repr y).sum (λ j yj, (ρ₁₂ xi) • (σ₁₂ yj) • B (b₁ i) (b₂ j))) =
-  B x y :=
-begin
-  conv_rhs { rw [← b₁.total_repr x, ← b₂.total_repr y] },
-  simp_rw [finsupp.total_apply, finsupp.sum, map_sum₂, map_sum, map_smulₛₗ₂, map_smulₛₗ],
-end
-
+end add_comm_group
 
 end comm_ring
 
diff --git a/src/linear_algebra/charpoly/basic.lean b/src/linear_algebra/charpoly/basic.lean
index 630f07ee36211..7fc3fd13a2b60 100644
--- a/src/linear_algebra/charpoly/basic.lean
+++ b/src/linear_algebra/charpoly/basic.lean
@@ -6,12 +6,15 @@ Authors: Riccardo Brasca
 
 import linear_algebra.free_module.finite.basic
 import linear_algebra.matrix.charpoly.coeff
-import field_theory.minpoly
+import field_theory.minpoly.field
 
 /-!
 
 # Characteristic polynomial
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the characteristic polynomial of `f : M →ₗ[R] M`, where `M` is a finite and
 free `R`-module. The proof that `f.charpoly` is the characteristic polynomial of the matrix of `f`
 in any basis is in `linear_algebra/charpoly/to_matrix`.
@@ -61,7 +64,7 @@ to the linear map itself, is zero.
 See `matrix.aeval_self_charpoly` for the equivalent statement about matrices. -/
 lemma aeval_self_charpoly : aeval f f.charpoly = 0 :=
 begin
-  apply (linear_equiv.map_eq_zero_iff (alg_equiv_matrix _).to_linear_equiv).1,
+  apply (linear_equiv.map_eq_zero_iff (alg_equiv_matrix (choose_basis R M)).to_linear_equiv).1,
   rw [alg_equiv.to_linear_equiv_apply, ← alg_equiv.coe_alg_hom,
     ← polynomial.aeval_alg_hom_apply _ _ _, charpoly_def],
   exact aeval_self_charpoly _,
diff --git a/src/linear_algebra/charpoly/to_matrix.lean b/src/linear_algebra/charpoly/to_matrix.lean
index b350386871b16..5a4dc9d1a2a3a 100644
--- a/src/linear_algebra/charpoly/to_matrix.lean
+++ b/src/linear_algebra/charpoly/to_matrix.lean
@@ -11,6 +11,9 @@ import linear_algebra.matrix.basis
 
 # Characteristic polynomial
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main result
 
 * `linear_map.charpoly_to_matrix f` : `charpoly f` is the characteristic polynomial of the matrix
diff --git a/src/linear_algebra/clifford_algebra/basic.lean b/src/linear_algebra/clifford_algebra/basic.lean
index 8b62307638848..45eada9e874ed 100644
--- a/src/linear_algebra/clifford_algebra/basic.lean
+++ b/src/linear_algebra/clifford_algebra/basic.lean
@@ -6,23 +6,25 @@ Authors: Eric Wieser, Utensil Song
 
 import algebra.ring_quot
 import linear_algebra.tensor_algebra.basic
-import linear_algebra.exterior_algebra.basic
-import linear_algebra.quadratic_form.basic
+import linear_algebra.quadratic_form.isometry
 
 /-!
 # Clifford Algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct the Clifford algebra of a module `M` over a commutative ring `R`, equipped with
 a quadratic_form `Q`.
 
 ## Notation
 
-The Clifford algebra of the `R`-module `M` equipped with a quadratic_form `Q` is denoted as
-`clifford_algebra Q`.
+The Clifford algebra of the `R`-module `M` equipped with a quadratic_form `Q` is
+an `R`-algebra denoted `clifford_algebra Q`.
 
 Given a linear morphism `f : M → A` from a module `M` to another `R`-algebra `A`, such that
 `cond : ∀ m, f m * f m = algebra_map _ _ (Q m)`, there is a (unique) lift of `f` to an `R`-algebra
-morphism, which is denoted `clifford_algebra.lift Q f cond`.
+morphism from `clifford_algebra Q` to `A`, which is denoted `clifford_algebra.lift Q f cond`.
 
 The canonical linear map `M → clifford_algebra Q` is denoted `clifford_algebra.ι Q`.
 
@@ -164,6 +166,8 @@ end
 
 /-- If `C` holds for the `algebra_map` of `r : R` into `clifford_algebra Q`, the `ι` of `x : M`,
 and is preserved under addition and muliplication, then it holds for all of `clifford_algebra Q`.
+
+See also the stronger `clifford_algebra.left_induction` and `clifford_algebra.right_induction`.
 -/
 -- This proof closely follows `tensor_algebra.induction`
 @[elab_as_eliminator]
@@ -193,26 +197,6 @@ begin
   exact alg_hom.congr_fun of_id a,
 end
 
-/-- A Clifford algebra with a zero quadratic form is isomorphic to an `exterior_algebra` -/
-def as_exterior : clifford_algebra (0 : quadratic_form R M) ≃ₐ[R] exterior_algebra R M :=
-alg_equiv.of_alg_hom
-  (clifford_algebra.lift 0 ⟨(exterior_algebra.ι R),
-    by simp only [forall_const, ring_hom.map_zero,
-                  exterior_algebra.ι_sq_zero, quadratic_form.zero_apply]⟩)
-  (exterior_algebra.lift R ⟨(ι (0 : quadratic_form R M)),
-    by simp only [forall_const, ring_hom.map_zero,
-                  quadratic_form.zero_apply, ι_sq_scalar]⟩)
-  (exterior_algebra.hom_ext $ linear_map.ext $
-    by simp only [alg_hom.comp_to_linear_map, linear_map.coe_comp,
-                  function.comp_app, alg_hom.to_linear_map_apply,
-                  exterior_algebra.lift_ι_apply, clifford_algebra.lift_ι_apply,
-                  alg_hom.to_linear_map_id, linear_map.id_comp, eq_self_iff_true, forall_const])
-  (clifford_algebra.hom_ext $ linear_map.ext $
-    by simp only [alg_hom.comp_to_linear_map, linear_map.coe_comp,
-                  function.comp_app, alg_hom.to_linear_map_apply,
-                  clifford_algebra.lift_ι_apply, exterior_algebra.lift_ι_apply,
-                  alg_hom.to_linear_map_id, linear_map.id_comp, eq_self_iff_true, forall_const])
-
 /-- The symmetric product of vectors is a scalar -/
 lemma ι_mul_ι_add_swap (a b : M) :
   ι Q a * ι Q b + ι Q b * ι Q a = algebra_map R _ (quadratic_form.polar Q a b) :=
@@ -225,6 +209,16 @@ calc  ι Q a * ι Q b + ι Q b * ι Q a
         by rw [←ring_hom.map_sub, ←ring_hom.map_sub]
 ... = algebra_map R _ (quadratic_form.polar Q a b) : rfl
 
+lemma ι_mul_comm (a b : M) :
+  ι Q a * ι Q b = algebra_map R _ (quadratic_form.polar Q a b) - ι Q b * ι Q a :=
+eq_sub_of_add_eq (ι_mul_ι_add_swap a b)
+
+/-- $aba$ is a vector. -/
+lemma ι_mul_ι_mul_ι  (a b : M) :
+  ι Q a * ι Q b * ι Q a = ι Q (quadratic_form.polar Q a b • a - Q a • b) :=
+by rw [ι_mul_comm, sub_mul, mul_assoc, ι_sq_scalar, ←algebra.smul_def, ←algebra.commutes,
+  ←algebra.smul_def, ←map_smul, ←map_smul, ←map_sub]
+
 @[simp]
 lemma ι_range_map_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = algebra_map _ _ (Q m)) :
   (ι Q).range.map (lift Q ⟨f, cond⟩).to_linear_map = f.range :=
@@ -312,6 +306,42 @@ by { ext x, exact alg_hom.congr_fun (map_id Q₁) x }
 
 end map
 
+variables (Q)
+
+/-- If the quadratic form of a vector is invertible, then so is that vector. -/
+def invertible_ι_of_invertible (m : M) [invertible (Q m)] : invertible (ι Q m) :=
+{ inv_of := ι Q (⅟(Q m) • m),
+  inv_of_mul_self := by rw [map_smul, smul_mul_assoc, ι_sq_scalar, algebra.smul_def, ←map_mul,
+    inv_of_mul_self, map_one],
+  mul_inv_of_self := by rw [map_smul, mul_smul_comm, ι_sq_scalar, algebra.smul_def, ←map_mul,
+    inv_of_mul_self, map_one] }
+
+/-- For a vector with invertible quadratic form, $v^{-1} = \frac{v}{Q(v)}$ -/
+lemma inv_of_ι (m : M) [invertible (Q m)] [invertible (ι Q m)] : ⅟(ι Q m) = ι Q (⅟(Q m) • m) :=
+begin
+  letI := invertible_ι_of_invertible Q m,
+  convert (rfl : ⅟(ι Q m) = _),
+end
+
+lemma is_unit_ι_of_is_unit {m : M} (h : is_unit (Q m)) : is_unit (ι Q m) :=
+begin
+  casesI h.nonempty_invertible,
+  letI := invertible_ι_of_invertible Q m,
+  exactI is_unit_of_invertible (ι Q m),
+end
+
+/-- $aba^{-1}$ is a vector. -/
+lemma ι_mul_ι_mul_inv_of_ι (a b : M) [invertible (ι Q a)] [invertible (Q a)] :
+  ι Q a * ι Q b * ⅟(ι Q a) = ι Q ((⅟(Q a) * quadratic_form.polar Q a b) • a - b) :=
+by rw [inv_of_ι, map_smul, mul_smul_comm, ι_mul_ι_mul_ι, ←map_smul, smul_sub, smul_smul, smul_smul,
+  inv_of_mul_self, one_smul]
+
+/-- $a^{-1}ba$ is a vector. -/
+lemma inv_of_ι_mul_ι_mul_ι (a b : M) [invertible (ι Q a)] [invertible (Q a)] :
+  ⅟(ι Q a) * ι Q b * ι Q a = ι Q ((⅟(Q a) * quadratic_form.polar Q a b) • a - b) :=
+by rw [inv_of_ι, map_smul, smul_mul_assoc, smul_mul_assoc, ι_mul_ι_mul_ι, ←map_smul, smul_sub,
+  smul_smul, smul_smul, inv_of_mul_self, one_smul]
+
 end clifford_algebra
 
 namespace tensor_algebra
diff --git a/src/linear_algebra/clifford_algebra/conjugation.lean b/src/linear_algebra/clifford_algebra/conjugation.lean
index b873ea112f1c2..f25611184e923 100644
--- a/src/linear_algebra/clifford_algebra/conjugation.lean
+++ b/src/linear_algebra/clifford_algebra/conjugation.lean
@@ -9,6 +9,9 @@ import algebra.module.opposites
 /-!
 # Conjugations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the grade reversal and grade involution functions on multivectors, `reverse` and
 `involute`.
 Together, these operations compose to form the "Clifford conjugate", hence the name of this file.
@@ -163,21 +166,28 @@ variables (Q)
 section involute
 
 lemma submodule_map_involute_eq_comap (p : submodule R (clifford_algebra Q)) :
-  p.map involute.to_linear_map = p.comap involute.to_linear_map :=
+  p.map (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
+    = p.comap (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map :=
 (submodule.map_equiv_eq_comap_symm involute_equiv.to_linear_equiv _)
 
-@[simp] lemma ι_range_map_involute : (ι Q).range.map involute.to_linear_map = (ι Q).range :=
+@[simp] lemma ι_range_map_involute :
+  (ι Q).range.map (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
+    = (ι Q).range :=
 (ι_range_map_lift _ _).trans (linear_map.range_neg _)
 
-@[simp] lemma ι_range_comap_involute : (ι Q).range.comap involute.to_linear_map = (ι Q).range :=
+@[simp] lemma ι_range_comap_involute :
+  (ι Q).range.comap (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
+    = (ι Q).range :=
 by rw [←submodule_map_involute_eq_comap, ι_range_map_involute]
 
 @[simp] lemma even_odd_map_involute (n : zmod 2) :
-  (even_odd Q n).map involute.to_linear_map = (even_odd Q n) :=
+  (even_odd Q n).map (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
+    = (even_odd Q n) :=
 by simp_rw [even_odd, submodule.map_supr, submodule.map_pow, ι_range_map_involute]
 
 @[simp] lemma even_odd_comap_involute (n : zmod 2) :
-  (even_odd Q n).comap involute.to_linear_map = even_odd Q n :=
+  (even_odd Q n).comap (involute : clifford_algebra Q →ₐ[R] clifford_algebra Q).to_linear_map
+    = even_odd Q n :=
 by rw [←submodule_map_involute_eq_comap, even_odd_map_involute]
 
 end involute
@@ -185,42 +195,53 @@ end involute
 section reverse
 
 lemma submodule_map_reverse_eq_comap (p : submodule R (clifford_algebra Q)) :
-  p.map reverse = p.comap reverse :=
+  p.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+    = p.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q):=
 (submodule.map_equiv_eq_comap_symm (reverse_equiv : _ ≃ₗ[R] _) _)
 
-@[simp] lemma ι_range_map_reverse : (ι Q).range.map reverse = (ι Q).range :=
+@[simp] lemma ι_range_map_reverse :
+  (ι Q).range.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = (ι Q).range :=
 begin
   rw [reverse, submodule.map_comp, ι_range_map_lift, linear_map.range_comp, ←submodule.map_comp],
   exact submodule.map_id _,
 end
 
-@[simp] lemma ι_range_comap_reverse : (ι Q).range.comap reverse = (ι Q).range :=
+@[simp] lemma ι_range_comap_reverse :
+  (ι Q).range.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = (ι Q).range :=
 by rw [←submodule_map_reverse_eq_comap, ι_range_map_reverse]
 
 /-- Like `submodule.map_mul`, but with the multiplication reversed. -/
 lemma submodule_map_mul_reverse (p q : submodule R (clifford_algebra Q)) :
-  (p * q).map reverse = q.map reverse * p.map reverse :=
+  (p * q).map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+    = q.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+      * p.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) :=
 by simp_rw [reverse, submodule.map_comp, linear_equiv.to_linear_map_eq_coe, submodule.map_mul,
   submodule.map_unop_mul]
 
 lemma submodule_comap_mul_reverse (p q : submodule R (clifford_algebra Q)) :
-  (p * q).comap reverse = q.comap reverse * p.comap reverse :=
+  (p * q).comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+    = q.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+      * p.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) :=
 by simp_rw [←submodule_map_reverse_eq_comap, submodule_map_mul_reverse]
 
 /-- Like `submodule.map_pow` -/
 lemma submodule_map_pow_reverse (p : submodule R (clifford_algebra Q)) (n : ℕ) :
-  (p ^ n).map reverse = p.map reverse ^ n :=
+  (p ^ n).map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+    = p.map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) ^ n :=
 by simp_rw [reverse, submodule.map_comp, linear_equiv.to_linear_map_eq_coe, submodule.map_pow,
   submodule.map_unop_pow]
 
 lemma submodule_comap_pow_reverse  (p : submodule R (clifford_algebra Q)) (n : ℕ) :
-  (p ^ n).comap reverse = p.comap reverse ^ n :=
+  (p ^ n).comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q)
+    = p.comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) ^ n :=
 by simp_rw [←submodule_map_reverse_eq_comap, submodule_map_pow_reverse]
 
-@[simp] lemma even_odd_map_reverse (n : zmod 2) : (even_odd Q n).map reverse = even_odd Q n :=
+@[simp] lemma even_odd_map_reverse (n : zmod 2) :
+  (even_odd Q n).map (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = even_odd Q n :=
 by simp_rw [even_odd, submodule.map_supr, submodule_map_pow_reverse, ι_range_map_reverse]
 
-@[simp] lemma even_odd_comap_reverse (n : zmod 2) : (even_odd Q n).comap reverse = even_odd Q n :=
+@[simp] lemma even_odd_comap_reverse (n : zmod 2) :
+  (even_odd Q n).comap (reverse : clifford_algebra Q →ₗ[R] clifford_algebra Q) = even_odd Q n :=
 by rw [←submodule_map_reverse_eq_comap, even_odd_map_reverse]
 
 end reverse
diff --git a/src/linear_algebra/clifford_algebra/contraction.lean b/src/linear_algebra/clifford_algebra/contraction.lean
new file mode 100644
index 0000000000000..6384379fe7097
--- /dev/null
+++ b/src/linear_algebra/clifford_algebra/contraction.lean
@@ -0,0 +1,353 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import linear_algebra.exterior_algebra.basic
+import linear_algebra.clifford_algebra.fold
+import linear_algebra.clifford_algebra.conjugation
+
+/-!
+# Contraction in Clifford Algebras
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains some of the results from [grinberg_clifford_2016][].
+The key result is `clifford_algebra.equiv_exterior`.
+
+## Main definitions
+
+* `clifford_algebra.contract_left`: contract a multivector by a `module.dual R M` on the left.
+* `clifford_algebra.contract_right`: contract a multivector by a `module.dual R M` on the right.
+* `clifford_algebra.change_form`: convert between two algebras of different quadratic form, sending
+  vectors to vectors. The difference of the quadratic forms must be a bilinear form.
+* `clifford_algebra.equiv_exterior`: in characteristic not-two, the `clifford_algebra Q` is
+  isomorphic as a module to the exterior algebra.
+
+## Implementation notes
+
+This file somewhat follows [grinberg_clifford_2016][], although we are missing some of the induction
+principles needed to prove many of the results. Here, we avoid the quotient-based approach described
+in [grinberg_clifford_2016][], instead directly constructing our objects using the universal
+property.
+
+Note that [grinberg_clifford_2016][] concludes that its contents are not novel, and are in fact just
+a rehash of parts of [bourbaki2007][]; we should at some point consider swapping our references to
+refer to the latter.
+
+Within this file, we use the local notation
+* `x ⌊ d` for `contract_right x d`
+* `d ⌋ x` for `contract_left d x`
+
+-/
+
+universes u1 u2 u3
+
+variables {R : Type u1} [comm_ring R]
+variables {M : Type u2} [add_comm_group M] [module R M]
+variables (Q : quadratic_form R M)
+
+namespace clifford_algebra
+
+section contract_left
+
+variables (d d' : module.dual R M)
+
+/-- Auxiliary construction for `clifford_algebra.contract_left` -/
+@[simps]
+def contract_left_aux (d : module.dual R M) :
+  M →ₗ[R] clifford_algebra Q × clifford_algebra Q →ₗ[R] clifford_algebra Q :=
+begin
+  have v_mul := (algebra.lmul R (clifford_algebra Q)).to_linear_map ∘ₗ (ι Q),
+  exact d.smul_right (linear_map.fst _ (clifford_algebra Q) (clifford_algebra Q)) -
+        v_mul.compl₂ (linear_map.snd _ (clifford_algebra Q) _),
+end
+
+lemma contract_left_aux_contract_left_aux (v : M) (x : clifford_algebra Q)
+  (fx : clifford_algebra Q) :
+  contract_left_aux Q d v (ι Q v * x, contract_left_aux Q d v (x, fx)) = Q v • fx :=
+begin
+  simp only [contract_left_aux_apply_apply],
+  rw [mul_sub, ←mul_assoc, ι_sq_scalar, ←algebra.smul_def, ←sub_add, mul_smul_comm, sub_self,
+    zero_add],
+end
+
+variables {Q}
+
+/-- Contract an element of the clifford algebra with an element `d : module.dual R M` from the left.
+
+Note that $v ⌋ x$ is spelt `contract_left (Q.associated v) x`.
+
+This includes [grinberg_clifford_2016][] Theorem 10.75 -/
+def contract_left : module.dual R M →ₗ[R] clifford_algebra Q →ₗ[R] clifford_algebra Q :=
+{ to_fun := λ d, foldr' Q (contract_left_aux Q d) (contract_left_aux_contract_left_aux Q d) 0,
+  map_add' := λ d₁ d₂, linear_map.ext $ λ x, begin
+    rw linear_map.add_apply,
+    induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+    { simp_rw [foldr'_algebra_map, smul_zero, zero_add] },
+    { rw [map_add, map_add, map_add, add_add_add_comm, hx, hy] },
+    { rw [foldr'_ι_mul, foldr'_ι_mul, foldr'_ι_mul, hx],
+      dsimp only [contract_left_aux_apply_apply],
+      rw [sub_add_sub_comm, mul_add, linear_map.add_apply, add_smul] }
+  end,
+  map_smul' := λ c d, linear_map.ext $ λ x,  begin
+    rw [linear_map.smul_apply, ring_hom.id_apply],
+    induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+    { simp_rw [foldr'_algebra_map, smul_zero] },
+    { rw [map_add, map_add, smul_add, hx, hy] },
+    { rw [foldr'_ι_mul, foldr'_ι_mul, hx],
+      dsimp only [contract_left_aux_apply_apply],
+      rw [linear_map.smul_apply, smul_assoc, mul_smul_comm, smul_sub], }
+  end }
+
+/-- Contract an element of the clifford algebra with an element `d : module.dual R M` from the
+right.
+
+Note that $x ⌊ v$ is spelt `contract_right x (Q.associated v)`.
+
+This includes [grinberg_clifford_2016][] Theorem 16.75 -/
+def contract_right : clifford_algebra Q →ₗ[R] module.dual R M →ₗ[R] clifford_algebra Q :=
+linear_map.flip (linear_map.compl₂ (linear_map.compr₂ contract_left reverse) reverse)
+
+lemma contract_right_eq (x : clifford_algebra Q) :
+  contract_right x d = reverse (contract_left d $ reverse x) := rfl
+
+local infix `⌋`:70 := contract_left
+local infix `⌊`:70 := contract_right
+
+/-- This is [grinberg_clifford_2016][] Theorem 6  -/
+lemma contract_left_ι_mul (a : M) (b : clifford_algebra Q) :
+  d ⌋ (ι Q a * b) = d a • b - ι Q a * (d ⌋ b) :=
+foldr'_ι_mul _ _ _ _ _ _
+
+/-- This is [grinberg_clifford_2016][] Theorem 12  -/
+lemma contract_right_mul_ι (a : M) (b : clifford_algebra Q) :
+  (b * ι Q a) ⌊ d = d a • b - (b ⌊ d) * ι Q a :=
+by rw [contract_right_eq, reverse.map_mul, reverse_ι, contract_left_ι_mul, map_sub, map_smul,
+    reverse_reverse, reverse.map_mul, reverse_ι, contract_right_eq]
+
+lemma contract_left_algebra_map_mul (r : R) (b : clifford_algebra Q) :
+  d ⌋ (algebra_map _ _ r * b) = algebra_map _ _ r * (d ⌋ b) :=
+by rw [←algebra.smul_def, map_smul, algebra.smul_def]
+
+lemma contract_left_mul_algebra_map (a : clifford_algebra Q) (r : R) :
+  d ⌋ (a * algebra_map _ _ r) = (d ⌋ a) * algebra_map _ _ r :=
+by rw [←algebra.commutes, contract_left_algebra_map_mul, algebra.commutes]
+
+lemma contract_right_algebra_map_mul (r : R) (b : clifford_algebra Q) :
+  (algebra_map _ _ r * b) ⌊ d = algebra_map _ _ r * (b ⌊ d) :=
+by rw [←algebra.smul_def, linear_map.map_smul₂, algebra.smul_def]
+
+lemma contract_right_mul_algebra_map (a : clifford_algebra Q) (r : R) :
+  (a * algebra_map _ _ r) ⌊ d = (a ⌊ d) * algebra_map _ _ r :=
+by rw [←algebra.commutes, contract_right_algebra_map_mul, algebra.commutes]
+
+variables (Q)
+
+@[simp] lemma contract_left_ι (x : M) : d ⌋ ι Q x = algebra_map R _ (d x) :=
+(foldr'_ι _ _ _ _ _).trans $
+  by simp_rw [contract_left_aux_apply_apply, mul_zero, sub_zero, algebra.algebra_map_eq_smul_one]
+
+@[simp] lemma contract_right_ι (x : M) : ι Q x ⌊ d = algebra_map R _ (d x) :=
+by rw [contract_right_eq, reverse_ι, contract_left_ι, reverse.commutes]
+
+@[simp] lemma contract_left_algebra_map (r : R) :
+  d ⌋ (algebra_map R (clifford_algebra Q) r) = 0 :=
+(foldr'_algebra_map _ _ _ _ _).trans $ smul_zero _
+
+@[simp] lemma contract_right_algebra_map (r : R) :
+  (algebra_map R (clifford_algebra Q) r) ⌊ d = 0 :=
+by rw [contract_right_eq, reverse.commutes, contract_left_algebra_map, map_zero]
+
+@[simp] lemma contract_left_one : d ⌋ (1 : clifford_algebra Q) = 0 :=
+by simpa only [map_one] using contract_left_algebra_map Q d 1
+
+@[simp] lemma contract_right_one : (1 : clifford_algebra Q) ⌊ d = 0 :=
+by simpa only [map_one] using contract_right_algebra_map Q d 1
+
+variables {Q}
+
+/-- This is [grinberg_clifford_2016][] Theorem 7 -/
+lemma contract_left_contract_left (x : clifford_algebra Q) :
+  d ⌋ (d ⌋ x) = 0 :=
+begin
+  induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+  { simp_rw [contract_left_algebra_map, map_zero] },
+  { rw [map_add, map_add, hx, hy, add_zero] },
+  { rw [contract_left_ι_mul, map_sub, contract_left_ι_mul, hx, linear_map.map_smul, mul_zero,
+      sub_zero, sub_self], }
+end
+
+/-- This is [grinberg_clifford_2016][] Theorem 13 -/
+lemma contract_right_contract_right (x : clifford_algebra Q) :
+  (x ⌊ d) ⌊ d = 0 :=
+by rw [contract_right_eq, contract_right_eq, reverse_reverse, contract_left_contract_left,
+  map_zero]
+
+/-- This is [grinberg_clifford_2016][] Theorem 8 -/
+lemma contract_left_comm (x : clifford_algebra Q) : d ⌋ (d' ⌋ x) = -(d' ⌋ (d ⌋ x)) :=
+begin
+  induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+  { simp_rw [contract_left_algebra_map, map_zero, neg_zero] },
+  { rw [map_add, map_add, map_add, map_add, hx, hy, neg_add] },
+  { simp only [contract_left_ι_mul, map_sub, linear_map.map_smul],
+    rw [neg_sub, sub_sub_eq_add_sub, hx, mul_neg, ←sub_eq_add_neg] }
+end
+
+/-- This is [grinberg_clifford_2016][] Theorem 14 -/
+lemma contract_right_comm (x : clifford_algebra Q) : (x ⌊ d) ⌊ d' = -((x ⌊ d') ⌊ d) :=
+by rw [contract_right_eq, contract_right_eq, contract_right_eq, contract_right_eq,
+  reverse_reverse, reverse_reverse, contract_left_comm, map_neg]
+
+/- TODO:
+lemma contract_right_contract_left (x : clifford_algebra Q) : (d ⌋ x) ⌊ d' = d ⌋ (x ⌊ d') :=
+-/
+
+end contract_left
+
+local infix `⌋`:70 := contract_left
+local infix `⌊`:70 := contract_right
+
+/-- Auxiliary construction for `clifford_algebra.change_form` -/
+@[simps]
+def change_form_aux (B : bilin_form R M) : M →ₗ[R] clifford_algebra Q →ₗ[R] clifford_algebra Q :=
+begin
+  have v_mul := (algebra.lmul R (clifford_algebra Q)).to_linear_map ∘ₗ ι Q,
+  exact v_mul - (contract_left ∘ₗ B.to_lin) ,
+end
+
+lemma change_form_aux_change_form_aux (B : bilin_form R M) (v : M) (x : clifford_algebra Q) :
+  change_form_aux Q B v (change_form_aux Q B v x) = (Q v - B v v) • x :=
+begin
+  simp only [change_form_aux_apply_apply],
+  rw [mul_sub, ←mul_assoc, ι_sq_scalar, map_sub, contract_left_ι_mul, ←sub_add, sub_sub_sub_comm,
+    ←algebra.smul_def, bilin_form.to_lin_apply, sub_self, sub_zero, contract_left_contract_left,
+    add_zero, sub_smul],
+end
+
+variables {Q}
+
+variables {Q' Q'' : quadratic_form R M} {B B' : bilin_form R M}
+variables (h : B.to_quadratic_form = Q' - Q) (h' : B'.to_quadratic_form = Q'' - Q')
+
+/-- Convert between two algebras of different quadratic form, sending vector to vectors, scalars to
+scalars, and adjusting products by a contraction term.
+
+This is $\lambda_B$ from [bourbaki2007][] $9 Lemma 2. -/
+def change_form (h : B.to_quadratic_form = Q' - Q) :
+  clifford_algebra Q →ₗ[R] clifford_algebra Q' :=
+foldr Q (change_form_aux Q' B) (λ m x, (change_form_aux_change_form_aux Q' B m x).trans $
+  begin
+    dsimp [←bilin_form.to_quadratic_form_apply],
+    rw [h, quadratic_form.sub_apply, sub_sub_cancel],
+  end) 1
+
+/-- Auxiliary lemma used as an argument to `clifford_algebra.change_form` -/
+lemma change_form.zero_proof : (0 : bilin_form R M).to_quadratic_form = Q - Q :=
+(sub_self _).symm
+
+/-- Auxiliary lemma used as an argument to `clifford_algebra.change_form` -/
+lemma change_form.add_proof : (B + B').to_quadratic_form = Q'' - Q :=
+(congr_arg2 (+) h h').trans $ sub_add_sub_cancel' _ _ _
+
+/-- Auxiliary lemma used as an argument to `clifford_algebra.change_form` -/
+lemma change_form.neg_proof : (-B).to_quadratic_form = Q - Q' :=
+(congr_arg has_neg.neg h).trans $ neg_sub _ _
+
+lemma change_form.associated_neg_proof [invertible (2 : R)] :
+  (-Q).associated.to_quadratic_form = 0 - Q :=
+by simp [quadratic_form.to_quadratic_form_associated]
+
+@[simp]
+lemma change_form_algebra_map (r : R) : change_form h (algebra_map R _ r) = algebra_map R _ r :=
+(foldr_algebra_map _ _ _ _ _).trans $ eq.symm $ algebra.algebra_map_eq_smul_one r
+
+@[simp] lemma change_form_one : change_form h (1 : clifford_algebra Q) = 1 :=
+by simpa using change_form_algebra_map h (1 : R)
+
+@[simp]
+lemma change_form_ι (m : M) : change_form h (ι _ m) = ι _ m :=
+(foldr_ι _ _ _ _ _).trans $ eq.symm $
+  by rw [change_form_aux_apply_apply, mul_one, contract_left_one, sub_zero]
+
+lemma change_form_ι_mul (m : M) (x : clifford_algebra Q) :
+  change_form h (ι _ m * x) = ι _ m * change_form h x - bilin_form.to_lin B m ⌋ change_form h x :=
+(foldr_mul _ _ _ _ _ _).trans $ begin rw foldr_ι, refl, end
+
+lemma change_form_ι_mul_ι (m₁ m₂ : M) :
+  change_form h (ι _ m₁ * ι _ m₂) = ι _ m₁ * ι _ m₂ - algebra_map _ _ (B m₁ m₂) :=
+by rw [change_form_ι_mul, change_form_ι, contract_left_ι, bilin_form.to_lin_apply]
+
+/-- Theorem 23 of [grinberg_clifford_2016][] -/
+lemma change_form_contract_left (d : module.dual R M) (x : clifford_algebra Q) :
+  change_form h (d ⌋ x) = d ⌋ change_form h x :=
+begin
+  induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+  { simp only [contract_left_algebra_map, change_form_algebra_map, map_zero] },
+  { rw [map_add, map_add, map_add, map_add, hx, hy] },
+  { simp only [contract_left_ι_mul, change_form_ι_mul, map_sub, linear_map.map_smul],
+    rw [←hx, contract_left_comm, ←sub_add, sub_neg_eq_add, ←hx] }
+end
+
+lemma change_form_self_apply (x : clifford_algebra Q) :
+  change_form (change_form.zero_proof) x = x :=
+begin
+  induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+  { simp_rw [change_form_algebra_map] },
+  { rw [map_add, hx, hy] },
+  { rw [change_form_ι_mul, hx, map_zero, linear_map.zero_apply, map_zero, linear_map.zero_apply,
+        sub_zero] }
+end
+
+@[simp]
+lemma change_form_self  :
+  change_form change_form.zero_proof = (linear_map.id : clifford_algebra Q →ₗ[R] _) :=
+linear_map.ext $ change_form_self_apply
+
+/-- This is [bourbaki2007][] $9 Lemma 3. -/
+lemma change_form_change_form (x : clifford_algebra Q) :
+  change_form h' (change_form h x) = change_form (change_form.add_proof h h') x :=
+begin
+  induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+  { simp_rw [change_form_algebra_map] },
+  { rw [map_add, map_add, map_add, hx, hy] },
+  { rw [change_form_ι_mul, map_sub, change_form_ι_mul, change_form_ι_mul, hx, sub_sub, map_add,
+    linear_map.add_apply, map_add, linear_map.add_apply, change_form_contract_left, hx,
+    add_comm (_ : clifford_algebra Q'')] }
+end
+
+lemma change_form_comp_change_form :
+  (change_form h').comp (change_form h) = change_form (change_form.add_proof h h') :=
+linear_map.ext $ change_form_change_form _ _
+
+/-- Any two algebras whose quadratic forms differ by a bilinear form are isomorphic as modules.
+
+This is $\bar \lambda_B$ from [bourbaki2007][] $9 Proposition 3. -/
+@[simps apply]
+def change_form_equiv : clifford_algebra Q ≃ₗ[R] clifford_algebra Q' :=
+{ to_fun := change_form h,
+  inv_fun := change_form (change_form.neg_proof h),
+  left_inv := λ x, (change_form_change_form _ _ x).trans $
+    by simp_rw [add_right_neg, change_form_self_apply],
+  right_inv := λ x, (change_form_change_form _ _ x).trans $
+    by simp_rw [add_left_neg, change_form_self_apply],
+  ..change_form h }
+
+@[simp]
+lemma change_form_equiv_symm :
+  (change_form_equiv h).symm = change_form_equiv (change_form.neg_proof h) :=
+linear_equiv.ext $ λ x, (rfl : change_form _ x = change_form _ x)
+
+variables (Q)
+
+/-- The module isomorphism to the exterior algebra.
+
+Note that this holds more generally when `Q` is divisible by two, rather than only when `1` is
+divisible by two; but that would be more awkward to use. -/
+@[simp]
+def equiv_exterior [invertible (2 : R)] : clifford_algebra Q ≃ₗ[R] exterior_algebra R M :=
+change_form_equiv change_form.associated_neg_proof
+
+end clifford_algebra
diff --git a/src/linear_algebra/clifford_algebra/default.lean b/src/linear_algebra/clifford_algebra/default.lean
deleted file mode 100644
index 0157342a1887e..0000000000000
--- a/src/linear_algebra/clifford_algebra/default.lean
+++ /dev/null
@@ -1,2 +0,0 @@
-import linear_algebra.clifford_algebra.basic
-import linear_algebra.clifford_algebra.conjugation
diff --git a/src/linear_algebra/clifford_algebra/equivs.lean b/src/linear_algebra/clifford_algebra/equivs.lean
index 97143343bc02f..2c5bf524e78a8 100644
--- a/src/linear_algebra/clifford_algebra/equivs.lean
+++ b/src/linear_algebra/clifford_algebra/equivs.lean
@@ -3,15 +3,19 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
+import algebra.dual_number
 import algebra.quaternion_basis
 import data.complex.module
 import linear_algebra.clifford_algebra.conjugation
-import algebra.dual_number
+import linear_algebra.clifford_algebra.star
 import linear_algebra.quadratic_form.prod
 
 /-!
 # Other constructions isomorphic to Clifford Algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains isomorphisms showing that other types are equivalent to some `clifford_algebra`.
 
 ## Rings
@@ -46,8 +50,8 @@ is the same as `clifford_algebra.involute`.
 We show additionally that this equivalence sends `quaternion_algebra.conj` to the clifford conjugate
 and vice-versa:
 
-* `clifford_algebra_quaternion.to_quaternion_involute_reverse`
-* `clifford_algebra_quaternion.of_quaternion_conj`
+* `clifford_algebra_quaternion.to_quaternion_star`
+* `clifford_algebra_quaternion.of_quaternion_star`
 
 ## Dual numbers
 
@@ -270,22 +274,22 @@ lemma to_quaternion_ι (v : R × R) :
   to_quaternion (ι (Q c₁ c₂) v) = (⟨0, v.1, v.2, 0⟩ : ℍ[R,c₁,c₂]) :=
 clifford_algebra.lift_ι_apply _ _ v
 
-/-- The "clifford conjugate" (aka `involute ∘ reverse = reverse ∘ involute`) maps to the quaternion
-conjugate. -/
-lemma to_quaternion_involute_reverse (c : clifford_algebra (Q c₁ c₂)) :
-  to_quaternion (involute (reverse c)) = quaternion_algebra.conj (to_quaternion c) :=
+/-- The "clifford conjugate" maps to the quaternion conjugate. -/
+lemma to_quaternion_star (c : clifford_algebra (Q c₁ c₂)) :
+  to_quaternion (star c) = star (to_quaternion c) :=
 begin
+  simp only [clifford_algebra.star_def'],
   induction c using clifford_algebra.induction,
   case h_grade0 : r
   { simp only [reverse.commutes, alg_hom.commutes, quaternion_algebra.coe_algebra_map,
-      quaternion_algebra.conj_coe], },
+      quaternion_algebra.star_coe], },
   case h_grade1 : x
   { rw [reverse_ι, involute_ι, to_quaternion_ι, alg_hom.map_neg, to_quaternion_ι,
-      quaternion_algebra.neg_mk, conj_mk, neg_zero], },
+      quaternion_algebra.neg_mk, star_mk, neg_zero], },
   case h_mul : x₁ x₂ hx₁ hx₂
-  { simp only [reverse.map_mul, alg_hom.map_mul, hx₁, hx₂, quaternion_algebra.conj_mul] },
+  { simp only [reverse.map_mul, alg_hom.map_mul, hx₁, hx₂, star_mul] },
   case h_add : x₁ x₂ hx₁ hx₂
-  { simp only [reverse.map_add, alg_hom.map_add, hx₁, hx₂, quaternion_algebra.conj_add] },
+  { simp only [reverse.map_add, alg_hom.map_add, hx₁, hx₂, star_add] },
 end
 
 /-- Map a quaternion into the clifford algebra. -/
@@ -337,12 +341,11 @@ alg_equiv.of_alg_hom to_quaternion of_quaternion
   to_quaternion_comp_of_quaternion
   of_quaternion_comp_to_quaternion
 
-/-- The quaternion conjugate maps to the "clifford conjugate" (aka
-`involute ∘ reverse = reverse ∘ involute`). -/
-@[simp] lemma of_quaternion_conj (q : ℍ[R,c₁,c₂]) :
-  of_quaternion (q.conj) = (of_quaternion q).reverse.involute :=
+/-- The quaternion conjugate maps to the "clifford conjugate" (aka `star`). -/
+@[simp] lemma of_quaternion_star (q : ℍ[R,c₁,c₂]) :
+  of_quaternion (star q) = star (of_quaternion q) :=
 clifford_algebra_quaternion.equiv.injective $
-  by rw [equiv_apply, equiv_apply, to_quaternion_involute_reverse, to_quaternion_of_quaternion,
+  by rw [equiv_apply, equiv_apply, to_quaternion_star, to_quaternion_of_quaternion,
     to_quaternion_of_quaternion]
 
 -- this name is too short for us to want it visible after `open clifford_algebra_quaternion`
diff --git a/src/linear_algebra/clifford_algebra/even.lean b/src/linear_algebra/clifford_algebra/even.lean
new file mode 100644
index 0000000000000..a374a0ead8693
--- /dev/null
+++ b/src/linear_algebra/clifford_algebra/even.lean
@@ -0,0 +1,244 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import linear_algebra.clifford_algebra.fold
+import linear_algebra.clifford_algebra.grading
+
+/-!
+# The universal property of the even subalgebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `clifford_algebra.even Q`: The even subalgebra of `clifford_algebra Q`.
+* `clifford_algebra.even_hom`: The type of bilinear maps that satisfy the universal property of the
+  even subalgebra
+* `clifford_algebra.even.lift`: The universal property of the even subalgebra, which states
+  that every bilinear map `f` with `f v v = Q v` and `f u v * f v w = Q v • f u w` is in unique
+  correspondence with an algebra morphism from `clifford_algebra.even Q`.
+
+## Implementation notes
+
+The approach here is outlined in "Computing with the universal properties of the Clifford algebra
+and the even subalgebra" (to appear).
+
+The broad summary is that we have two tricks available to us for implementing complex recursors on
+top of `clifford_algebra.lift`: the first is to use morphisms as the output type, such as
+`A = module.End R N` which is how we obtained `clifford_algebra.foldr`; and the second is to use
+`N = (N', S)` where `N'` is the value we wish to compute, and `S` is some auxiliary state passed
+between one recursor invocation and the next.
+For the universal property of the even subalgebra, we apply a variant of the first trick again by
+choosing `S` to itself be a submodule of morphisms.
+-/
+
+namespace clifford_algebra
+
+variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
+variables {Q : quadratic_form R M}
+-- put this after `Q` since we want to talk about morphisms from `clifford_algebra Q` to `A` and
+-- that order is more natural
+variables {A B : Type*} [ring A] [ring B] [algebra R A] [algebra R B]
+
+open_locale direct_sum
+
+variables (Q)
+
+/-- The even submodule `clifford_algebra.even_odd Q 0` is also a subalgebra. -/
+def even : subalgebra R (clifford_algebra Q) :=
+(even_odd Q 0).to_subalgebra
+  set_like.graded_monoid.one_mem
+  (λ x y hx hy, add_zero (0 : zmod 2) ▸ set_like.graded_monoid.mul_mem hx hy)
+
+@[simp] lemma even_to_submodule : (even Q).to_submodule = even_odd Q 0 :=
+rfl
+
+variables (A)
+
+/-- The type of bilinear maps which are accepted by `clifford_algebra.even.lift`. -/
+@[ext]
+structure even_hom : Type (max u_2 u_3) :=
+(bilin : M →ₗ[R] M →ₗ[R] A)
+(contract (m : M) : bilin m m = algebra_map R A (Q m))
+(contract_mid (m₁ m₂ m₃ : M) : bilin m₁ m₂ * bilin m₂ m₃ = Q m₂ • bilin m₁ m₃)
+
+variables {A Q}
+
+/-- Compose an `even_hom` with an `alg_hom` on the output. -/
+@[simps]
+def even_hom.compr₂ (g : even_hom Q A) (f : A →ₐ[R] B) : even_hom Q B :=
+{ bilin := g.bilin.compr₂ f.to_linear_map,
+  contract := λ m, (f.congr_arg $ g.contract _).trans $ f.commutes _,
+  contract_mid := λ m₁ m₂ m₃, (f.map_mul _ _).symm.trans $
+    (f.congr_arg $ g.contract_mid _ _ _).trans $ f.map_smul _ _ }
+
+variables (Q)
+
+/-- The embedding of pairs of vectors into the even subalgebra, as a bilinear map. -/
+@[simps bilin_apply_apply_coe]
+def even.ι : even_hom Q (even Q) :=
+{ bilin := linear_map.mk₂ R (λ m₁ m₂, ⟨ι Q m₁ * ι Q m₂, ι_mul_ι_mem_even_odd_zero _ _ _⟩)
+             (λ _ _ _, by { simp only [linear_map.map_add, add_mul], refl })
+             (λ _ _ _, by { simp only [linear_map.map_smul, smul_mul_assoc], refl })
+             (λ _ _ _, by { simp only [linear_map.map_add, mul_add], refl })
+             (λ _ _ _, by { simp only [linear_map.map_smul, mul_smul_comm], refl }),
+  contract := λ m, subtype.ext $ ι_sq_scalar Q m,
+  contract_mid := λ m₁ m₂ m₃, subtype.ext $
+    calc  ι Q m₁ * ι Q m₂ * (ι Q m₂ * ι Q m₃)
+        = ι Q m₁ * ((ι Q m₂ * ι Q m₂) * ι Q m₃) : by simp only [mul_assoc]
+    ... = Q m₂ • (ι Q m₁ * ι Q m₃) : by rw [algebra.smul_def, ι_sq_scalar, algebra.left_comm] }
+
+instance : inhabited (even_hom Q (even Q)) := ⟨even.ι Q⟩
+
+variables (f : even_hom Q A)
+
+/-- Two algebra morphisms from the even subalgebra are equal if they agree on pairs of generators.
+
+See note [partially-applied ext lemmas]. -/
+@[ext]
+lemma even.alg_hom_ext ⦃f g : even Q →ₐ[R] A⦄
+  (h : (even.ι Q).compr₂ f = (even.ι Q).compr₂ g) :
+  f = g :=
+begin
+  rw even_hom.ext_iff at h,
+  ext ⟨x, hx⟩,
+  refine even_induction _ _ _ _ _ hx,
+  { intro r,
+    exact (f.commutes r).trans (g.commutes r).symm },
+  { intros x y hx hy ihx ihy,
+    have := congr_arg2 (+) ihx ihy,
+    exact (f.map_add _ _).trans (this.trans $ (g.map_add _ _).symm) },
+  { intros m₁ m₂ x hx ih,
+    have := congr_arg2 (*) (linear_map.congr_fun (linear_map.congr_fun h m₁) m₂) ih,
+    exact (f.map_mul _ _).trans (this.trans $ (g.map_mul _ _).symm) },
+end
+
+variables {Q}
+
+namespace even.lift
+
+/-- An auxiliary submodule used to store the half-applied values of `f`.
+This is the span of elements `f'` such that `∃ x m₂, ∀ m₁, f' m₁ = f m₁ m₂ * x`.  -/
+private def S : submodule R (M →ₗ[R] A) :=
+submodule.span R
+  {f' | ∃ x m₂, f' = linear_map.lcomp R _ (f.bilin.flip m₂) (linear_map.mul_right R x)}
+
+/-- An auxiliary bilinear map that is later passed into `clifford_algebra.fold`. Our desired result
+is stored in the `A` part of the accumulator, while auxiliary recursion state is stored in the `S f`
+part. -/
+private def f_fold : M →ₗ[R] (A × S f) →ₗ[R] (A × S f) :=
+linear_map.mk₂ R (λ m acc,
+  /- We could write this `snd` term in a point-free style as follows, but it wouldn't help as we
+  don't have any prod or subtype combinators to deal with n-linear maps of this degree.
+  ```lean
+  (linear_map.lcomp R _ (algebra.lmul R A).to_linear_map.flip).comp $
+    (linear_map.llcomp R M A A).flip.comp f.flip : M →ₗ[R] A →ₗ[R] M →ₗ[R] A)
+  ```
+  -/
+  (acc.2 m, ⟨(linear_map.mul_right R acc.1).comp (f.bilin.flip m),
+    submodule.subset_span $ ⟨_, _, rfl⟩⟩))
+  (λ m₁ m₂ a, prod.ext
+    (linear_map.map_add _ m₁ m₂)
+    (subtype.ext $ linear_map.ext $ λ m₃,
+      show f.bilin m₃ (m₁ + m₂) * a.1 = f.bilin m₃ m₁ * a.1 + f.bilin m₃ m₂ * a.1,
+      by rw [map_add, add_mul]))
+  (λ c m a, prod.ext
+    (linear_map.map_smul _ c m)
+    (subtype.ext $ linear_map.ext $ λ m₃,
+      show f.bilin m₃ (c • m) * a.1 = c • (f.bilin m₃ m * a.1),
+      by rw [linear_map.map_smul, smul_mul_assoc]))
+  (λ m a₁ a₂, prod.ext rfl (subtype.ext $ linear_map.ext $ λ m₃, mul_add _ _ _))
+  (λ c m a, prod.ext rfl (subtype.ext $ linear_map.ext $ λ m₃, mul_smul_comm _ _ _))
+
+@[simp] private lemma fst_f_fold_f_fold (m₁ m₂ : M) (x : A × S f) :
+  (f_fold f m₁ (f_fold f m₂ x)).fst = f.bilin m₁ m₂ * x.fst := rfl
+
+@[simp] private lemma snd_f_fold_f_fold (m₁ m₂ m₃ : M) (x : A × S f) :
+  ((f_fold f m₁ (f_fold f m₂ x)).snd : M →ₗ[R] A) m₃ = f.bilin m₃ m₁ * (x.snd : M →ₗ[R] A) m₂ := rfl
+
+private lemma f_fold_f_fold (m : M) (x : A × S f) :
+  f_fold f m (f_fold f m x) = Q m • x :=
+begin
+  obtain ⟨a, ⟨g, hg⟩⟩ := x,
+  ext : 2,
+  { change f.bilin m m * a = Q m • a,
+    rw [algebra.smul_def, f.contract] },
+  { ext m₁,
+    change f.bilin _ _ * g m = Q m • g m₁,
+    apply submodule.span_induction' _ _ _ _ hg,
+    { rintros _ ⟨b, m₃, rfl⟩,
+      change f.bilin _ _ * (f.bilin _ _ * b) = Q m • (f.bilin _ _ * b),
+      rw [←smul_mul_assoc, ←mul_assoc, f.contract_mid] },
+    { change f.bilin m₁ m * 0 = Q m • 0,
+      rw [mul_zero, smul_zero] },
+    { rintros x hx y hy ihx ihy,
+      rw [linear_map.add_apply, linear_map.add_apply, mul_add, smul_add, ihx, ihy] },
+    { rintros x hx c ihx,
+      rw [linear_map.smul_apply, linear_map.smul_apply, mul_smul_comm, ihx, smul_comm] } },
+end
+
+/-- The final auxiliary construction for `clifford_algebra.even.lift`. This map is the forwards
+direction of that equivalence, but not in the fully-bundled form. -/
+@[simps apply {attrs := []}] def aux (f : even_hom Q A) : clifford_algebra.even Q →ₗ[R] A :=
+begin
+  refine _ ∘ₗ (even Q).val.to_linear_map,
+  exact linear_map.fst _ _ _ ∘ₗ foldr Q (f_fold f) (f_fold_f_fold f) (1, 0),
+end
+
+@[simp] lemma aux_one : aux f 1 = 1 :=
+(congr_arg prod.fst (foldr_one _ _ _ _))
+
+@[simp] lemma aux_ι (m₁ m₂ : M) : aux f ((even.ι Q).bilin m₁ m₂) = f.bilin m₁ m₂ :=
+(congr_arg prod.fst (foldr_mul _ _ _ _ _ _)).trans begin
+  rw [foldr_ι, foldr_ι],
+  exact mul_one _,
+end
+
+@[simp] lemma aux_algebra_map (r) (hr) :
+  aux f ⟨algebra_map R _ r, hr⟩ = algebra_map R _ r :=
+(congr_arg prod.fst (foldr_algebra_map _ _ _ _ _)).trans (algebra.algebra_map_eq_smul_one r).symm
+
+@[simp] lemma aux_mul (x y : even Q) :
+  aux f (x * y) = aux f x * aux f y :=
+begin
+  cases x,
+  cases y,
+  refine (congr_arg prod.fst (foldr_mul _ _ _ _ _ _)).trans _,
+  dsimp only,
+  refine even_induction Q _ _ _ _ x_property,
+  { intros r,
+    rw [foldr_algebra_map, aux_algebra_map],
+    exact (algebra.smul_def r _), },
+  { intros x y hx hy ihx ihy,
+    rw [linear_map.map_add, prod.fst_add, ihx, ihy, ←add_mul, ←linear_map.map_add],
+    refl, },
+  { rintros m₁ m₂ x (hx : x ∈ even Q) ih,
+    rw [aux_apply, foldr_mul, foldr_mul, foldr_ι, foldr_ι, fst_f_fold_f_fold, ih,
+      ←mul_assoc, subtype.coe_mk, foldr_mul, foldr_mul, foldr_ι, foldr_ι, fst_f_fold_f_fold],
+      refl }
+end
+
+end even.lift
+
+open even.lift
+
+variables (Q) {A}
+
+/-- Every algebra morphism from the even subalgebra is in one-to-one correspondence with a
+bilinear map that sends duplicate arguments to the quadratic form, and contracts across
+multiplication. -/
+@[simps symm_apply_bilin]
+def even.lift : even_hom Q A ≃ (clifford_algebra.even Q →ₐ[R] A) :=
+{ to_fun := λ f, alg_hom.of_linear_map (aux f) (aux_one f) (aux_mul f),
+  inv_fun := λ F, (even.ι Q).compr₂ F,
+  left_inv := λ f, even_hom.ext _ _ $ linear_map.ext₂ $ even.lift.aux_ι f,
+  right_inv := λ F, even.alg_hom_ext Q $ even_hom.ext _ _ $ linear_map.ext₂ $ even.lift.aux_ι _ }
+
+@[simp] lemma even.lift_ι (f : even_hom Q A) (m₁ m₂ : M) :
+  even.lift Q f ((even.ι Q).bilin m₁ m₂) = f.bilin m₁ m₂ :=
+even.lift.aux_ι _ _ _
+
+end clifford_algebra
diff --git a/src/linear_algebra/clifford_algebra/even_equiv.lean b/src/linear_algebra/clifford_algebra/even_equiv.lean
new file mode 100644
index 0000000000000..55e8ea60c4c02
--- /dev/null
+++ b/src/linear_algebra/clifford_algebra/even_equiv.lean
@@ -0,0 +1,250 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import linear_algebra.clifford_algebra.conjugation
+import linear_algebra.clifford_algebra.even
+import linear_algebra.quadratic_form.prod
+/-!
+# Isomorphisms with the even subalgebra of a Clifford algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides some notable isomorphisms regarding the even subalgebra, `clifford_algebra.even`.
+
+## Main definitions
+
+* `clifford_algebra.equiv_even`: Every Clifford algebra is isomorphic as an algebra to the even
+  subalgebra of a Clifford algebra with one more dimension.
+  * `clifford_algebra.even_equiv.Q'`: The quadratic form used by this "one-up" algebra.
+  * `clifford_algebra.to_even`: The simp-normal form of the forward direction of this isomorphism.
+  * `clifford_algebra.of_even`: The simp-normal form of the reverse direction of this isomorphism.
+
+* `clifford_algebra.even_equiv_even_neg`: Every even subalgebra is isomorphic to the even subalgebra
+  of the Clifford algebra with negated quadratic form.
+  * `clifford_algebra.even_to_neg`: The simp-normal form of each direction of this isomorphism.
+
+## Main results
+
+* `clifford_algebra.coe_to_even_reverse_involute`: the behavior of `clifford_algebra.to_even` on the
+  "Clifford conjugate", that is `clifford_algebra.reverse` composed with
+  `clifford_algebra.involute`.
+-/
+
+namespace clifford_algebra
+
+variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
+variables (Q : quadratic_form R M)
+
+/-! ### Constructions needed for `clifford_algebra.equiv_even` -/
+
+namespace equiv_even
+
+/-- The quadratic form on the augmented vector space `M × R` sending `v + r•e0` to `Q v - r^2`. -/
+@[reducible]
+def Q' : quadratic_form R (M × R) := (Q.prod $ -@quadratic_form.sq R _)
+
+lemma Q'_apply (m : M × R) : Q' Q m = Q m.1 - m.2 * m.2 := (sub_eq_add_neg _ _).symm
+
+/-- The unit vector in the new dimension -/
+def e0 : clifford_algebra (Q' Q) := ι (Q' Q) (0, 1)
+
+/-- The embedding from the existing vector space -/
+def v : M →ₗ[R] clifford_algebra (Q' Q) := (ι (Q' Q)) ∘ₗ linear_map.inl _ _ _
+
+lemma ι_eq_v_add_smul_e0 (m : M) (r : R) : ι (Q' Q) (m, r) = v Q m + r • e0 Q :=
+by rw [e0, v, linear_map.comp_apply, linear_map.inl_apply, ←linear_map.map_smul, prod.smul_mk,
+  smul_zero, smul_eq_mul, mul_one, ←linear_map.map_add, prod.mk_add_mk, zero_add, add_zero]
+
+lemma e0_mul_e0 : e0 Q * e0 Q = -1 :=
+(ι_sq_scalar _ _).trans $ by simp
+
+lemma v_sq_scalar (m : M) : v Q m * v Q m = algebra_map _ _ (Q m) :=
+(ι_sq_scalar _ _).trans $ by simp
+
+lemma neg_e0_mul_v (m : M) : -(e0 Q * v Q m) = v Q m * e0 Q :=
+begin
+  refine neg_eq_of_add_eq_zero_right ((ι_mul_ι_add_swap _ _).trans _),
+  dsimp [quadratic_form.polar],
+  simp only [add_zero, mul_zero, mul_one, zero_add, neg_zero, quadratic_form.map_zero,
+    add_sub_cancel, sub_self, map_zero, zero_sub],
+end
+
+lemma neg_v_mul_e0 (m : M) : -(v Q m * e0 Q) = e0 Q * v Q m :=
+begin
+  rw neg_eq_iff_eq_neg,
+  exact (neg_e0_mul_v _ m).symm
+end
+
+@[simp] lemma e0_mul_v_mul_e0 (m : M) : e0 Q * v Q m * e0 Q = v Q m :=
+by rw [←neg_v_mul_e0, ←neg_mul, mul_assoc, e0_mul_e0, mul_neg_one, neg_neg]
+
+@[simp] lemma reverse_v (m : M) : reverse (v Q m) = v Q m := reverse_ι _
+@[simp] lemma involute_v (m : M) : involute (v Q m) = -v Q m := involute_ι _
+
+@[simp] lemma reverse_e0 : reverse (e0 Q) = e0 Q := reverse_ι _
+@[simp] lemma involute_e0 : involute (e0 Q) = -e0 Q := involute_ι _
+
+end equiv_even
+
+open equiv_even
+
+/-- The embedding from the smaller algebra into the new larger one. -/
+def to_even : clifford_algebra Q →ₐ[R] clifford_algebra.even (Q' Q) :=
+begin
+  refine clifford_algebra.lift Q ⟨_, λ m, _⟩,
+  { refine linear_map.cod_restrict _ _ (λ m, submodule.mem_supr_of_mem ⟨2, rfl⟩ _),
+    exact (linear_map.mul_left R $ e0 Q).comp (v Q),
+    rw [subtype.coe_mk, pow_two],
+    exact submodule.mul_mem_mul (linear_map.mem_range_self _ _) (linear_map.mem_range_self _ _), },
+  { ext1,
+    dsimp only [subalgebra.coe_mul, linear_map.cod_restrict_apply, linear_map.comp_apply,
+      linear_map.mul_left_apply, linear_map.inl_apply, subalgebra.coe_algebra_map],
+    rw [←mul_assoc, e0_mul_v_mul_e0, v_sq_scalar] }
+end
+
+@[simp]
+lemma to_even_ι (m : M) : (to_even Q (ι Q m) : clifford_algebra (Q' Q)) = e0 Q * v Q m :=
+begin
+  rw [to_even, clifford_algebra.lift_ι_apply, linear_map.cod_restrict_apply],
+  refl,
+end
+
+/-- The embedding from the even subalgebra with an extra dimension into the original algebra. -/
+def of_even : clifford_algebra.even (Q' Q) →ₐ[R] clifford_algebra Q :=
+begin
+  /-
+  Recall that we need:
+   * `f ⟨0,1⟩ ⟨x,0⟩ = ι x`
+   * `f ⟨x,0⟩ ⟨0,1⟩ = -ι x`
+   * `f ⟨x,0⟩ ⟨y,0⟩ = ι x * ι y`
+   * `f ⟨0,1⟩ ⟨0,1⟩ = -1`
+  -/
+  let f : (M × R) →ₗ[R] (M × R) →ₗ[R] clifford_algebra Q :=
+  ((algebra.lmul R (clifford_algebra Q)).to_linear_map.comp
+    $ ((ι Q).comp (linear_map.fst _ _ _)) +
+      (algebra.linear_map R _).comp (linear_map.snd _ _ _)).compl₂
+    (((ι Q).comp (linear_map.fst _ _ _)) - (algebra.linear_map R _).comp (linear_map.snd _ _ _)),
+  have f_apply :
+    ∀ x y, f x y = (ι Q x.1 + algebra_map R _ x.2) * (ι Q y.1 - algebra_map R _ y.2) :=
+    λ x y, rfl,
+  have hc : ∀ (r : R) (x : clifford_algebra Q), commute (algebra_map _ _ r) x := algebra.commutes,
+  have hm : ∀ m : M × R,
+    ι Q m.1 * ι Q m.1 - algebra_map R _ m.2 * algebra_map R _ m.2 = algebra_map R _ (Q' Q m),
+  { intro m,
+    rw [ι_sq_scalar, ←ring_hom.map_mul, ←ring_hom.map_sub,
+      sub_eq_add_neg, Q'_apply, sub_eq_add_neg] },
+  refine even.lift (Q' Q) ⟨f, _, _⟩; simp_rw [f_apply],
+  { intro m,
+    rw [←(hc _ _).symm.mul_self_sub_mul_self_eq, hm] },
+  { intros m₁ m₂ m₃,
+    rw [←mul_smul_comm, ←mul_assoc, mul_assoc(_ + _), ←(hc _ _).symm.mul_self_sub_mul_self_eq',
+      algebra.smul_def, ←mul_assoc, hm] },
+end
+
+lemma of_even_ι (x y : M × R) :
+  of_even Q ((even.ι _).bilin x y) =
+    (ι Q x.1 + algebra_map R _ x.2) * (ι Q y.1 - algebra_map R _ y.2) :=
+even.lift_ι _ _ _ _
+
+lemma to_even_comp_of_even : (to_even Q).comp (of_even Q) = alg_hom.id R _ :=
+even.alg_hom_ext (Q' Q) $ even_hom.ext _ _ $ linear_map.ext $ λ m₁, linear_map.ext $ λ m₂,
+  subtype.ext $
+  let ⟨m₁, r₁⟩ := m₁, ⟨m₂, r₂⟩ := m₂ in
+  calc  ↑(to_even Q (of_even Q ((even.ι (Q' Q)).bilin (m₁, r₁) (m₂, r₂))))
+      = (e0 Q * v Q m₁ + algebra_map R _ r₁) * (e0 Q * v Q m₂ - algebra_map R _ r₂) :
+        by rw [of_even_ι, alg_hom.map_mul, alg_hom.map_add, alg_hom.map_sub, alg_hom.commutes,
+             alg_hom.commutes, subalgebra.coe_mul, subalgebra.coe_add, subalgebra.coe_sub,
+             to_even_ι, to_even_ι, subalgebra.coe_algebra_map, subalgebra.coe_algebra_map]
+  ... = e0 Q * v Q m₁ * (e0 Q * v Q m₂) + r₁ • e0 Q * v Q m₂ - r₂ • e0 Q * v Q m₁
+          - algebra_map R _ (r₁ * r₂) :
+        by rw [mul_sub, add_mul, add_mul, ←algebra.commutes, ←algebra.smul_def, ←map_mul,
+               ←algebra.smul_def, sub_add_eq_sub_sub, smul_mul_assoc, smul_mul_assoc]
+  ... = v Q m₁ * v Q m₂ + r₁ • e0 Q * v Q m₂ + v Q m₁ * r₂ • e0 Q + (r₁ • e0 Q) * r₂ • e0 Q :
+        have h1 : e0 Q * v Q m₁ * (e0 Q * v Q m₂) = v Q m₁ * v Q m₂,
+          by rw [←mul_assoc, e0_mul_v_mul_e0],
+        have h2 : -(r₂ • e0 Q * v Q m₁) = v Q m₁ * r₂ • e0 Q,
+          by rw [mul_smul_comm, smul_mul_assoc, ←smul_neg, neg_e0_mul_v],
+        have h3 : - algebra_map R _ (r₁ * r₂) = (r₁ • e0 Q) * r₂ • e0 Q,
+          by rw [algebra.algebra_map_eq_smul_one, smul_mul_smul, e0_mul_e0, smul_neg],
+        by rw [sub_eq_add_neg, sub_eq_add_neg, h1, h2, h3]
+  ... = ι _ (m₁, r₁) * ι _ (m₂, r₂) :
+        by rw [ι_eq_v_add_smul_e0, ι_eq_v_add_smul_e0, mul_add, add_mul, add_mul, add_assoc]
+
+lemma of_even_comp_to_even :
+  (of_even Q).comp (to_even Q) = alg_hom.id R _ :=
+clifford_algebra.hom_ext $ linear_map.ext $ λ m,
+  calc  of_even Q (to_even Q (ι Q m))
+      = of_even Q ⟨_, (to_even Q (ι Q m)).prop⟩ : by rw subtype.coe_eta
+  ... = (ι Q 0 + algebra_map R _ 1) * (ι Q m - algebra_map R _ 0) : begin
+          simp_rw to_even_ι,
+          exact of_even_ι Q _ _,
+        end
+  ... = ι Q m : by rw [map_one, map_zero, map_zero, sub_zero, zero_add, one_mul]
+
+/-- Any clifford algebra is isomorphic to the even subalgebra of a clifford algebra with an extra
+dimension (that is, with vector space `M × R`), with a quadratic form evaluating to `-1` on that new
+basis vector. -/
+@[simps]
+def equiv_even : clifford_algebra Q ≃ₐ[R] clifford_algebra.even (Q' Q) :=
+alg_equiv.of_alg_hom
+  (to_even Q)
+  (of_even Q)
+  (to_even_comp_of_even Q)
+  (of_even_comp_to_even Q)
+
+/-- The representation of the clifford conjugate (i.e. the reverse of the involute) in the even
+subalgebra is just the reverse of the representation. -/
+lemma coe_to_even_reverse_involute (x : clifford_algebra Q) :
+  ↑(to_even Q (reverse (involute x))) = reverse (to_even Q x : clifford_algebra (Q' Q)) :=
+begin
+  induction x using clifford_algebra.induction,
+  case h_grade0 : r { simp only [alg_hom.commutes, subalgebra.coe_algebra_map, reverse.commutes] },
+  case h_grade1 : m
+  { simp only [involute_ι, subalgebra.coe_neg, to_even_ι, reverse.map_mul,
+      reverse_v, reverse_e0, reverse_ι, neg_e0_mul_v, map_neg] },
+  case h_mul : x y hx hy { simp only [map_mul, subalgebra.coe_mul, reverse.map_mul, hx, hy] },
+  case h_add : x y hx hy { simp only [map_add, subalgebra.coe_add, hx, hy] },
+end
+
+/-! ### Constructions needed for `clifford_algebra.even_equiv_even_neg` -/
+
+/-- One direction of `clifford_algebra.even_equiv_even_neg` -/
+def even_to_neg (Q' : quadratic_form R M) (h : Q' = -Q) :
+  clifford_algebra.even Q →ₐ[R] clifford_algebra.even Q' :=
+even.lift Q
+  { bilin := -(even.ι Q' : _).bilin,
+    contract := λ m, by simp_rw [linear_map.neg_apply, even_hom.contract, h,
+                                 quadratic_form.neg_apply, map_neg, neg_neg],
+    contract_mid := λ m₁ m₂ m₃,
+      by simp_rw [linear_map.neg_apply, neg_mul_neg, even_hom.contract_mid, h,
+                  quadratic_form.neg_apply, smul_neg, neg_smul] }
+
+@[simp] lemma even_to_neg_ι (Q' : quadratic_form R M) (h : Q' = -Q) (m₁ m₂ : M) :
+  even_to_neg Q Q' h ((even.ι Q).bilin m₁ m₂) = -(even.ι Q').bilin m₁ m₂ :=
+even.lift_ι _ _ m₁ m₂
+
+lemma even_to_neg_comp_even_to_neg (Q' : quadratic_form R M)
+  (h : Q' = -Q) (h' : Q = -Q') :
+  (even_to_neg Q' Q h').comp (even_to_neg Q Q' h) = alg_hom.id R _ :=
+begin
+  ext m₁ m₂ : 4,
+  dsimp only [even_hom.compr₂_bilin, linear_map.compr₂_apply, alg_hom.to_linear_map_apply,
+              alg_hom.comp_apply, alg_hom.id_apply],
+  rw [even_to_neg_ι, map_neg, even_to_neg_ι, neg_neg]
+end
+
+/-- The even subalgebras of the algebras with quadratic form `Q` and `-Q` are isomorphic.
+
+Stated another way, `𝒞ℓ⁺(p,q,r)` and `𝒞ℓ⁺(q,p,r)` are isomorphic. -/
+@[simps]
+def even_equiv_even_neg : clifford_algebra.even Q ≃ₐ[R] clifford_algebra.even (-Q) :=
+alg_equiv.of_alg_hom
+  (even_to_neg Q _ rfl)
+  (even_to_neg (-Q) _ (neg_neg _).symm)
+  (even_to_neg_comp_even_to_neg _ _ _ _)
+  (even_to_neg_comp_even_to_neg _ _ _ _)
+
+end clifford_algebra
diff --git a/src/linear_algebra/clifford_algebra/fold.lean b/src/linear_algebra/clifford_algebra/fold.lean
new file mode 100644
index 0000000000000..353aed894e0f3
--- /dev/null
+++ b/src/linear_algebra/clifford_algebra/fold.lean
@@ -0,0 +1,212 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import linear_algebra.clifford_algebra.conjugation
+
+/-!
+# Recursive computation rules for the Clifford algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides API for a special case `clifford_algebra.foldr` of the universal property
+`clifford_algebra.lift` with `A = module.End R N` for some arbitrary module `N`. This specialization
+resembles the `list.foldr` operation, allowing a bilinear map to be "folded" along the generators.
+
+For convenience, this file also provides `clifford_algebra.foldl`, implemented via
+`clifford_algebra.reverse`
+
+## Main definitions
+
+* `clifford_algebra.foldr`: a computation rule for building linear maps out of the clifford
+  algebra starting on the right, analogous to using `list.foldr` on the generators.
+* `clifford_algebra.foldl`: a computation rule for building linear maps out of the clifford
+  algebra starting on the left, analogous to using `list.foldl` on the generators.
+
+## Main statements
+
+* `clifford_algebra.right_induction`: an induction rule that adds generators from the right.
+* `clifford_algebra.left_induction`: an induction rule that adds generators from the left.
+-/
+
+universes u1 u2 u3
+
+variables {R M N : Type*}
+variables [comm_ring R] [add_comm_group M] [add_comm_group N]
+variables [module R M] [module R N]
+variables (Q : quadratic_form R M)
+
+namespace clifford_algebra
+
+section foldr
+
+/-- Fold a bilinear map along the generators of a term of the clifford algebra, with the rule
+given by `foldr Q f hf n (ι Q m * x) = f m (foldr Q f hf n x)`.
+
+For example, `foldr f hf n (r • ι R u + ι R v * ι R w) = r • f u n + f v (f w n)`. -/
+def foldr (f : M →ₗ[R] N →ₗ[R] N) (hf : ∀ m x, f m (f m x) = Q m • x) :
+  N →ₗ[R] clifford_algebra Q →ₗ[R] N :=
+(clifford_algebra.lift Q ⟨f, λ v, linear_map.ext $ hf v⟩).to_linear_map.flip
+
+@[simp] lemma foldr_ι (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (m : M) :
+  foldr Q f hf n (ι Q m) = f m n :=
+linear_map.congr_fun (lift_ι_apply _ _ _) n
+
+@[simp] lemma foldr_algebra_map (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (r : R) :
+  foldr Q f hf n (algebra_map R _ r) = r • n :=
+linear_map.congr_fun (alg_hom.commutes _ r) n
+
+@[simp] lemma foldr_one (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) :
+  foldr Q f hf n 1 = n :=
+linear_map.congr_fun (alg_hom.map_one _) n
+
+@[simp] lemma foldr_mul (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (a b : clifford_algebra Q) :
+  foldr Q f hf n (a * b) = foldr Q f hf (foldr Q f hf n b) a :=
+linear_map.congr_fun (alg_hom.map_mul _ _ _) n
+
+
+/-- This lemma demonstrates the origin of the `foldr` name. -/
+lemma foldr_prod_map_ι (l : list M) (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N):
+  foldr Q f hf n (l.map $ ι Q).prod = list.foldr (λ m n, f m n) n l :=
+begin
+  induction l with hd tl ih,
+  { rw [list.map_nil, list.prod_nil, list.foldr_nil, foldr_one] },
+  { rw [list.map_cons, list.prod_cons, list.foldr_cons, foldr_mul, foldr_ι, ih] },
+end
+
+end foldr
+
+section foldl
+
+/-- Fold a bilinear map along the generators of a term of the clifford algebra, with the rule
+given by `foldl Q f hf n (ι Q m * x) = f m (foldl Q f hf n x)`.
+
+For example, `foldl f hf n (r • ι R u + ι R v * ι R w) = r • f u n + f v (f w n)`. -/
+def foldl (f : M →ₗ[R] N →ₗ[R] N) (hf : ∀ m x, f m (f m x) = Q m • x) :
+  N →ₗ[R] clifford_algebra Q →ₗ[R] N :=
+linear_map.compl₂ (foldr Q f hf) reverse
+
+@[simp] lemma foldl_reverse (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (x : clifford_algebra Q) :
+  foldl Q f hf n (reverse x) = foldr Q f hf n x :=
+fun_like.congr_arg (foldr Q f hf n) $ reverse_reverse _
+
+@[simp] lemma foldr_reverse (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (x : clifford_algebra Q) :
+  foldr Q f hf n (reverse x) = foldl Q f hf n x := rfl
+
+@[simp] lemma foldl_ι (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (m : M) :
+  foldl Q f hf n (ι Q m) = f m n :=
+by rw [←foldr_reverse, reverse_ι, foldr_ι]
+
+@[simp] lemma foldl_algebra_map (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (r : R) :
+  foldl Q f hf n (algebra_map R _ r) = r • n :=
+by rw [←foldr_reverse, reverse.commutes, foldr_algebra_map]
+
+@[simp] lemma foldl_one (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) :
+  foldl Q f hf n 1 = n :=
+by rw [←foldr_reverse, reverse.map_one, foldr_one]
+
+@[simp] lemma foldl_mul (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N) (a b : clifford_algebra Q) :
+  foldl Q f hf n (a * b) = foldl Q f hf (foldl Q f hf n a) b :=
+by rw [←foldr_reverse, ←foldr_reverse, ←foldr_reverse, reverse.map_mul, foldr_mul]
+
+/-- This lemma demonstrates the origin of the `foldl` name. -/
+lemma foldl_prod_map_ι (l : list M) (f : M →ₗ[R] N →ₗ[R] N) (hf) (n : N):
+  foldl Q f hf n (l.map $ ι Q).prod = list.foldl (λ m n, f n m) n l :=
+by rw [←foldr_reverse, reverse_prod_map_ι, ←list.map_reverse, foldr_prod_map_ι, list.foldr_reverse]
+
+end foldl
+
+lemma right_induction {P : clifford_algebra Q → Prop}
+  (hr : ∀ r : R, P (algebra_map _ _ r))
+  (h_add : ∀ x y, P x → P y → P (x + y))
+  (h_ι_mul : ∀ m x, P x → P (x * ι Q m)) : ∀ x, P x :=
+begin
+  /- It would be neat if we could prove this via `foldr` like how we prove
+  `clifford_algebra.induction`, but going via the grading seems easier. -/
+  intro x,
+  have : x ∈ ⊤ := submodule.mem_top,
+  rw ←supr_ι_range_eq_top at this,
+  apply submodule.supr_induction _ this (λ i x hx, _) _ h_add,
+  { refine submodule.pow_induction_on_right _ hr h_add (λ x px m, _) hx,
+    rintro ⟨m, rfl⟩,
+    exact h_ι_mul _ _ px },
+  { simpa only [map_zero] using hr 0}
+end
+
+lemma left_induction {P : clifford_algebra Q → Prop}
+  (hr : ∀ r : R, P (algebra_map _ _ r))
+  (h_add : ∀ x y, P x → P y → P (x + y))
+  (h_mul_ι : ∀ x m, P x → P (ι Q m * x)) : ∀ x, P x :=
+begin
+  refine reverse_involutive.surjective.forall.2 _,
+  intro x,
+  induction x using clifford_algebra.right_induction with r x y hx hy m x hx,
+  { simpa only [reverse.commutes] using hr r },
+  { simpa only [map_add] using h_add _ _ hx hy },
+  { simpa only [reverse.map_mul, reverse_ι] using h_mul_ι _ _ hx },
+end
+
+/-! ### Versions with extra state -/
+/-- Auxiliary definition for `clifford_algebra.foldr'` -/
+def foldr'_aux (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N) :
+  M →ₗ[R] module.End R (clifford_algebra Q × N) :=
+begin
+  have v_mul := (algebra.lmul R (clifford_algebra Q)).to_linear_map ∘ₗ (ι Q),
+  have l := v_mul.compl₂ (linear_map.fst _ _ N),
+  exact { to_fun := λ m, (l m).prod (f m),
+          map_add' := λ v₂ v₂, linear_map.ext $ λ x, prod.ext
+            (linear_map.congr_fun (l.map_add _ _) x) (linear_map.congr_fun (f.map_add _ _) x),
+          map_smul' := λ c v, linear_map.ext $ λ x, prod.ext
+            (linear_map.congr_fun (l.map_smul _ _) x) (linear_map.congr_fun (f.map_smul _ _) x), },
+end
+
+lemma foldr'_aux_apply_apply (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N) (m : M) (x_fx) :
+    foldr'_aux Q f m x_fx = (ι Q m * x_fx.1, f m x_fx) := rfl
+
+lemma foldr'_aux_foldr'_aux (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N)
+  (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx)
+  (v : M) (x_fx) :
+  foldr'_aux Q f v (foldr'_aux Q f v x_fx) = Q v • x_fx :=
+begin
+  cases x_fx with x fx,
+  simp only [foldr'_aux_apply_apply],
+  rw [←mul_assoc, ι_sq_scalar, ← algebra.smul_def, hf, prod.smul_mk],
+end
+
+/-- Fold a bilinear map along the generators of a term of the clifford algebra, with the rule
+given by `foldr' Q f hf n (ι Q m * x) = f m (x, foldr' Q f hf n x)`.
+Note this is like `clifford_algebra.foldr`, but with an extra `x` argument.
+Implement the recursion scheme `F[n0](m * x) = f(m, (x, F[n0](x)))`. -/
+def foldr' (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N)
+  (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx)
+  (n : N) :
+  clifford_algebra Q →ₗ[R] N :=
+linear_map.snd _ _ _ ∘ₗ foldr Q (foldr'_aux Q f) (foldr'_aux_foldr'_aux Q _ hf) (1, n)
+
+lemma foldr'_algebra_map (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N)
+  (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n r) :
+  foldr' Q f hf n (algebra_map R _ r) = r • n :=
+congr_arg prod.snd (foldr_algebra_map _ _ _ _ _)
+
+lemma foldr'_ι (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N)
+  (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n m) :
+  foldr' Q f hf n (ι Q m) = f m (1, n) :=
+congr_arg prod.snd (foldr_ι _ _ _ _ _)
+
+lemma foldr'_ι_mul (f : M →ₗ[R] clifford_algebra Q × N →ₗ[R] N)
+  (hf : ∀ m x fx, f m (ι Q m * x, f m (x, fx)) = Q m • fx) (n m) (x) :
+  foldr' Q f hf n (ι Q m * x) = f m (x, foldr' Q f hf n x) :=
+begin
+  dsimp [foldr'],
+  rw [foldr_mul, foldr_ι, foldr'_aux_apply_apply],
+  refine congr_arg (f m) (prod.mk.eta.symm.trans _),
+  congr' 1,
+  induction x using clifford_algebra.left_induction with r x y hx hy m x hx,
+  { simp_rw [foldr_algebra_map, prod.smul_mk, algebra.algebra_map_eq_smul_one] },
+  { rw [map_add, prod.fst_add, hx, hy] },
+  { rw [foldr_mul, foldr_ι, foldr'_aux_apply_apply, hx], },
+end
+
+end clifford_algebra
diff --git a/src/linear_algebra/clifford_algebra/grading.lean b/src/linear_algebra/clifford_algebra/grading.lean
index 9e1ce9f27a662..6e9f3a429a818 100644
--- a/src/linear_algebra/clifford_algebra/grading.lean
+++ b/src/linear_algebra/clifford_algebra/grading.lean
@@ -10,6 +10,9 @@ import ring_theory.graded_algebra.basic
 /-!
 # Results about the grading structure of the clifford algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The main result is `clifford_algebra.graded_algebra`, which says that the clifford algebra is a
 ℤ₂-graded algebra (or "superalgebra").
 -/
@@ -46,7 +49,8 @@ lemma ι_mul_ι_mem_even_odd_zero (m₁ m₂ : M) :
   ι Q m₁ * ι Q m₂ ∈ even_odd Q 0 :=
 submodule.mem_supr_of_mem ⟨2, rfl⟩ begin
   rw [subtype.coe_mk, pow_two],
-  exact submodule.mul_mem_mul ((ι Q).mem_range_self m₁) ((ι Q).mem_range_self m₂),
+  exact submodule.mul_mem_mul (linear_map.mem_range_self (ι Q) m₁)
+    (linear_map.mem_range_self (ι Q) m₂)
 end
 
 lemma even_odd_mul_le (i j : zmod 2) : even_odd Q i * even_odd Q j ≤ even_odd Q (i + j) :=
@@ -78,48 +82,53 @@ rfl
 lemma graded_algebra.ι_sq_scalar (m : M) :
   graded_algebra.ι Q m * graded_algebra.ι Q m = algebra_map R _ (Q m) :=
 begin
-  rw [graded_algebra.ι_apply, direct_sum.of_mul_of, direct_sum.algebra_map_apply],
+  rw [graded_algebra.ι_apply Q, direct_sum.of_mul_of, direct_sum.algebra_map_apply],
   refine direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext rfl $ ι_sq_scalar _ _),
 end
 
+lemma graded_algebra.lift_ι_eq (i' : zmod 2) (x' : even_odd Q i') :
+  lift Q ⟨by apply graded_algebra.ι Q, graded_algebra.ι_sq_scalar Q⟩ x' =
+    direct_sum.of (λ i, even_odd Q i) i' x' :=
+begin
+  cases x' with x' hx',
+  dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
+  refine submodule.supr_induction' _ (λ i x hx, _) _ (λ x y hx hy ihx ihy, _) hx',
+  { obtain ⟨i, rfl⟩ := i,
+    dsimp only [subtype.coe_mk] at hx,
+    refine submodule.pow_induction_on_left' _
+      (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
+    { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
+    { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
+    { obtain ⟨_, rfl⟩ := hm,
+      rw [alg_hom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply Q, direct_sum.of_mul_of],
+      refine direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext _ _);
+        dsimp only [graded_monoid.mk, subtype.coe_mk],
+      { rw [nat.succ_eq_add_one, add_comm, nat.cast_add, nat.cast_one] },
+      refl } },
+  { rw alg_hom.map_zero,
+    apply eq.symm,
+    apply dfinsupp.single_eq_zero.mpr, refl, },
+  { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
+end
+
 /-- The clifford algebra is graded by the even and odd parts. -/
 instance graded_algebra : graded_algebra (even_odd Q) :=
-graded_algebra.of_alg_hom _
-  (lift _ $ ⟨graded_algebra.ι Q, graded_algebra.ι_sq_scalar Q⟩)
+graded_algebra.of_alg_hom (even_odd Q)
+  -- while not necessary, the `by apply` makes this elaborate faster
+  (lift Q ⟨by apply graded_algebra.ι Q, graded_algebra.ι_sq_scalar Q⟩)
   -- the proof from here onward is mostly similar to the `tensor_algebra` case, with some extra
   -- handling for the `supr` in `even_odd`.
   (begin
     ext m,
     dsimp only [linear_map.comp_apply, alg_hom.to_linear_map_apply, alg_hom.comp_apply,
       alg_hom.id_apply],
-    rw [lift_ι_apply, graded_algebra.ι_apply, direct_sum.submodule_coe_alg_hom_of, subtype.coe_mk],
-  end)
-  (λ i' x', begin
-    cases x' with x' hx',
-    dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
-    refine submodule.supr_induction' _ (λ i x hx, _) _ (λ x y hx hy ihx ihy, _) hx',
-    { obtain ⟨i, rfl⟩ := i,
-      dsimp only [subtype.coe_mk] at hx,
-      refine submodule.pow_induction_on' _
-        (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
-      { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
-      { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
-      { obtain ⟨_, rfl⟩ := hm,
-        rw [alg_hom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply, direct_sum.of_mul_of],
-        refine direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext _ _),
-          dsimp only [graded_monoid.mk, subtype.coe_mk],
-        { rw [nat.succ_eq_add_one, add_comm], refl },
-        refl } },
-    { rw alg_hom.map_zero,
-      apply eq.symm,
-      apply dfinsupp.single_eq_zero.mpr, refl, },
-    { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
+    rw [lift_ι_apply, graded_algebra.ι_apply Q, direct_sum.coe_alg_hom_of, subtype.coe_mk],
   end)
+  (by apply graded_algebra.lift_ι_eq Q)
 
 lemma supr_ι_range_eq_top : (⨆ i : ℕ, (ι Q).range ^ i) = ⊤ :=
 begin
-  rw [← (graded_algebra.is_internal $ λ i, even_odd Q i).supr_eq_top, eq_comm],
-  dunfold even_odd,
+  rw [← (direct_sum.decomposition.is_internal (even_odd Q)).submodule_supr_eq_top, eq_comm],
   calc    (⨆ (i : zmod 2) (j : {n // ↑n = i}), (ι Q).range ^ ↑j)
         = (⨆ (i : Σ i : zmod 2, {n : ℕ // ↑n = i}), (ι Q).range ^ (i.2 : ℕ)) : by rw supr_sigma
     ... = (⨆ (i : ℕ), (ι Q).range ^ i)
@@ -127,7 +136,7 @@ begin
 end
 
 lemma even_odd_is_compl : is_compl (even_odd Q 0) (even_odd Q 1) :=
-(graded_algebra.is_internal (even_odd Q)).is_compl zero_ne_one $ begin
+(direct_sum.decomposition.is_internal (even_odd Q)).is_compl zero_ne_one $ begin
   have : (finset.univ : finset (zmod 2)) = {0, 1} := rfl,
   simpa using congr_arg (coe : finset (zmod 2) → set (zmod 2)) this,
 end
@@ -141,7 +150,7 @@ lemma even_odd_induction (n : zmod 2) {P : Π x, x ∈ even_odd Q n → Prop}
     P v (submodule.mem_supr_of_mem ⟨n.val, n.nat_cast_zmod_val⟩ h))
   (hadd : ∀ {x y hx hy}, P x hx → P y hy → P (x + y) (submodule.add_mem _ hx hy))
   (hιι_mul : ∀ m₁ m₂ {x hx}, P x hx → P (ι Q m₁ * ι Q m₂ * x)
-    (zero_add n ▸ set_like.graded_monoid.mul_mem (ι_mul_ι_mem_even_odd_zero Q m₁ m₂) hx))
+    (zero_add n ▸ set_like.mul_mem_graded (ι_mul_ι_mem_even_odd_zero Q m₁ m₂) hx))
   (x : clifford_algebra Q) (hx : x ∈ even_odd Q n) : P x hx :=
 begin
   apply submodule.supr_induction' _ _ (hr 0 (submodule.zero_mem _)) @hadd,
@@ -151,7 +160,7 @@ begin
   simp_rw [pow_add, pow_mul],
   refine submodule.mul_induction_on' _ _,
   { intros a ha b hb,
-    refine submodule.pow_induction_on' ((ι Q).range ^ 2) _ _ _ ha,
+    refine submodule.pow_induction_on_left' ((ι Q).range ^ 2) _ _ _ ha,
     { intro r,
       simp_rw ←algebra.smul_def,
       exact hr _ (submodule.smul_mem _ _ hb), },
@@ -177,10 +186,10 @@ end
 scalars, closed under addition, and under left-multiplication by a pair of vectors. -/
 @[elab_as_eliminator]
 lemma even_induction  {P : Π x, x ∈ even_odd Q 0 → Prop}
-  (hr : ∀ r : R, P (algebra_map _ _ r) (set_like.has_graded_one.algebra_map_mem _ _))
+  (hr : ∀ r : R, P (algebra_map _ _ r) (set_like.algebra_map_mem_graded _ _))
   (hadd : ∀ {x y hx hy}, P x hx → P y hy → P (x + y) (submodule.add_mem _ hx hy))
   (hιι_mul : ∀ m₁ m₂ {x hx}, P x hx → P (ι Q m₁ * ι Q m₂ * x)
-    (zero_add 0 ▸ set_like.graded_monoid.mul_mem (ι_mul_ι_mem_even_odd_zero Q m₁ m₂) hx))
+    (zero_add 0 ▸ set_like.mul_mem_graded (ι_mul_ι_mem_even_odd_zero Q m₁ m₂) hx))
   (x : clifford_algebra Q) (hx : x ∈ even_odd Q 0) : P x hx :=
 begin
   refine even_odd_induction Q 0 (λ rx, _) @hadd hιι_mul x hx,
@@ -196,7 +205,7 @@ lemma odd_induction {P : Π x, x ∈ even_odd Q 1 → Prop}
   (hι : ∀ v, P (ι Q v) (ι_mem_even_odd_one _ _))
   (hadd : ∀ {x y hx hy}, P x hx → P y hy → P (x + y) (submodule.add_mem _ hx hy))
   (hιι_mul : ∀ m₁ m₂ {x hx}, P x hx → P (ι Q m₁ * ι Q m₂ * x)
-    (zero_add (1 : zmod 2) ▸ set_like.graded_monoid.mul_mem (ι_mul_ι_mem_even_odd_zero Q m₁ m₂) hx))
+    (zero_add (1 : zmod 2) ▸ set_like.mul_mem_graded (ι_mul_ι_mem_even_odd_zero Q m₁ m₂) hx))
   (x : clifford_algebra Q) (hx : x ∈ even_odd Q 1) : P x hx :=
 begin
   refine even_odd_induction Q 1 (λ ιv, _) @hadd hιι_mul x hx,
diff --git a/src/linear_algebra/clifford_algebra/star.lean b/src/linear_algebra/clifford_algebra/star.lean
new file mode 100644
index 0000000000000..697a4b2f4464d
--- /dev/null
+++ b/src/linear_algebra/clifford_algebra/star.lean
@@ -0,0 +1,58 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import linear_algebra.clifford_algebra.conjugation
+
+/-!
+# Star structure on `clifford_algebra`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the "clifford conjugation", equal to `reverse (involute x)`, and assigns it the
+`star` notation.
+
+This choice is somewhat non-canonical; a star structure is also possible under `reverse` alone.
+However, defining it gives us access to constructions like `unitary`.
+
+Most results about `star` can be obtained by unfolding it via `clifford_algebra.star_def`.
+
+## Main definitions
+
+* `clifford_algebra.star_ring`
+
+-/
+
+variables {R : Type*} [comm_ring R]
+variables {M : Type*} [add_comm_group M] [module R M]
+variables {Q : quadratic_form R M}
+
+namespace clifford_algebra
+
+instance : star_ring (clifford_algebra Q) :=
+{ star := λ x, reverse (involute x),
+  star_involutive := λ x,
+    by simp only [reverse_involute_commute.eq, reverse_reverse, involute_involute],
+  star_mul := λ x y, by simp only [map_mul, reverse.map_mul],
+  star_add := λ x y, by simp only [map_add] }
+
+lemma star_def (x : clifford_algebra Q) : star x = reverse (involute x) := rfl
+lemma star_def' (x : clifford_algebra Q) : star x = involute (reverse x) := reverse_involute _
+
+@[simp] lemma star_ι (m : M) : star (ι Q m) = -ι Q m :=
+by rw [star_def, involute_ι, map_neg, reverse_ι]
+
+/-- Note that this not match the `star_smul` implied by `star_module`; it certainly could if we
+also conjugated all the scalars, but there appears to be nothing in the literature that advocates
+doing this. -/
+@[simp] lemma star_smul (r : R) (x : clifford_algebra Q) :
+  star (r • x) = r • star x :=
+by rw [star_def, star_def, map_smul, map_smul]
+
+@[simp] lemma star_algebra_map (r : R) :
+  star (algebra_map R (clifford_algebra Q) r) = algebra_map R (clifford_algebra Q) r :=
+by rw [star_def, involute.commutes, reverse.commutes]
+
+end clifford_algebra
diff --git a/src/linear_algebra/coevaluation.lean b/src/linear_algebra/coevaluation.lean
index 32dcc3dd480c5..31abc9c6cc8e8 100644
--- a/src/linear_algebra/coevaluation.lean
+++ b/src/linear_algebra/coevaluation.lean
@@ -10,6 +10,9 @@ import linear_algebra.dual
 /-!
 # The coevaluation map on finite dimensional vector spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a finite dimensional vector space `V` over a field `K` this describes the canonical linear map
 from `K` to `V ⊗ dual K V` which corresponds to the identity function on `V`.
 
diff --git a/src/linear_algebra/contraction.lean b/src/linear_algebra/contraction.lean
index 423c0d771bab4..cbaa519592cdf 100644
--- a/src/linear_algebra/contraction.lean
+++ b/src/linear_algebra/contraction.lean
@@ -5,12 +5,13 @@ Authors: Oliver Nash, Antoine Labelle
 -/
 import linear_algebra.dual
 import linear_algebra.matrix.to_lin
-import linear_algebra.tensor_product_basis
-import linear_algebra.free_module.finite.rank
 
 /-!
 # Contractions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given modules $M, N$ over a commutative ring $R$, this file defines the natural linear maps:
 $M^* \otimes M \to R$, $M \otimes M^* \to R$, and $M^* \otimes N → Hom(M, N)$, as well as proving
 some basic properties of these maps.
@@ -20,17 +21,20 @@ some basic properties of these maps.
 contraction, dual module, tensor product
 -/
 
-section contraction
+variables {ι : Type*} (R M N P Q : Type*)
 
-open tensor_product linear_map matrix
-open_locale tensor_product big_operators
+local attribute [ext] tensor_product.ext
 
-variables (R M N P : Type*) [add_comm_group M] [add_comm_group N] [add_comm_group P]
+section contraction
 
-section comm_ring
+open tensor_product linear_map matrix module
+open_locale tensor_product big_operators
 
-variables [comm_ring R] [module R M] [module R N] [module R P]
-variables {ι : Type*} [decidable_eq ι] [fintype ι] (b : basis ι R M)
+section comm_semiring
+variables [comm_semiring R]
+variables [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P] [add_comm_monoid Q]
+variables [module R M] [module R N] [module R P] [module R Q]
+variables [decidable_eq ι] [fintype ι] (b : basis ι R M)
 
 /-- The natural left-handed pairing between a module and its dual. -/
 def contract_left : (module.dual R M) ⊗ M →ₗ[R] R := (uncurry _ _ _ _).to_fun linear_map.id
@@ -44,24 +48,50 @@ def dual_tensor_hom : (module.dual R M) ⊗ N →ₗ[R] M →ₗ[R] N :=
   let M' := module.dual R M in
   (uncurry R M' N (M →ₗ[R] N) : _ → M' ⊗ N →ₗ[R] M →ₗ[R] N) linear_map.smul_rightₗ
 
-variables {R M N P}
+variables {R M N P Q}
 
 @[simp] lemma contract_left_apply (f : module.dual R M) (m : M) :
-  contract_left R M (f ⊗ₜ m) = f m := by apply uncurry_apply
+  contract_left R M (f ⊗ₜ m) = f m := rfl
 
 @[simp] lemma contract_right_apply (f : module.dual R M) (m : M) :
-  contract_right R M (m ⊗ₜ f) = f m := by apply uncurry_apply
+  contract_right R M (m ⊗ₜ f) = f m := rfl
 
 @[simp] lemma dual_tensor_hom_apply (f : module.dual R M) (m : M) (n : N) :
   dual_tensor_hom R M N (f ⊗ₜ n) m = (f m) • n :=
-by { dunfold dual_tensor_hom, rw uncurry_apply, refl, }
+rfl
+
+@[simp] lemma transpose_dual_tensor_hom (f : module.dual R M) (m : M) :
+  dual.transpose (dual_tensor_hom R M M (f ⊗ₜ m)) = dual_tensor_hom R _ _ (dual.eval R M m ⊗ₜ f) :=
+by { ext f' m', simp only [dual.transpose_apply, coe_comp, function.comp_app, dual_tensor_hom_apply,
+  linear_map.map_smulₛₗ, ring_hom.id_apply, algebra.id.smul_eq_mul, dual.eval_apply, smul_apply],
+  exact mul_comm _ _ }
+
+@[simp] lemma dual_tensor_hom_prod_map_zero (f : module.dual R M) (p : P) :
+  ((dual_tensor_hom R M P) (f ⊗ₜ[R] p)).prod_map (0 : N →ₗ[R] Q) =
+  dual_tensor_hom R (M × N) (P × Q) ((f ∘ₗ fst R M N) ⊗ₜ inl R P Q p) :=
+by {ext; simp only [coe_comp, coe_inl, function.comp_app, prod_map_apply, dual_tensor_hom_apply,
+fst_apply, prod.smul_mk, zero_apply, smul_zero]}
+
+@[simp] lemma zero_prod_map_dual_tensor_hom (g : module.dual R N) (q : Q) :
+  (0 : M →ₗ[R] P).prod_map ((dual_tensor_hom R N Q) (g ⊗ₜ[R] q)) =
+  dual_tensor_hom R (M × N) (P × Q) ((g ∘ₗ snd R M N) ⊗ₜ inr R P Q q) :=
+by {ext; simp only [coe_comp, coe_inr, function.comp_app, prod_map_apply, dual_tensor_hom_apply,
+  snd_apply, prod.smul_mk, zero_apply, smul_zero]}
+
+lemma map_dual_tensor_hom (f : module.dual R M) (p : P) (g : module.dual R N) (q : Q) :
+  tensor_product.map (dual_tensor_hom R M P (f ⊗ₜ[R] p)) (dual_tensor_hom R N Q (g ⊗ₜ[R] q)) =
+  dual_tensor_hom R (M ⊗[R] N) (P ⊗[R] Q) (dual_distrib R M N (f ⊗ₜ g) ⊗ₜ[R] (p ⊗ₜ[R] q)) :=
+begin
+  ext m n, simp only [compr₂_apply, mk_apply, map_tmul, dual_tensor_hom_apply,
+  dual_distrib_apply, ←smul_tmul_smul],
+end
 
 @[simp] lemma comp_dual_tensor_hom (f : module.dual R M) (n : N) (g : module.dual R N) (p : P) :
   (dual_tensor_hom R N P (g ⊗ₜ[R] p)) ∘ₗ (dual_tensor_hom R M N (f ⊗ₜ[R] n)) =
   g n • dual_tensor_hom R M P (f ⊗ₜ p) :=
 begin
-  ext m, simp only [coe_comp, function.comp_app, dual_tensor_hom_apply, map_smulₛₗ,
-  ring_hom.id_apply, smul_apply], rw smul_comm,
+  ext m, simp only [coe_comp, function.comp_app, dual_tensor_hom_apply, linear_map.map_smul,
+                    ring_hom.id_apply, smul_apply], rw smul_comm,
 end
 
 /-- As a matrix, `dual_tensor_hom` evaluated on a basis element of `M* ⊗ N` is a matrix with a
@@ -77,13 +107,20 @@ begin
   rw [and_iff_not_or_not, not_not] at hij, cases hij; simp [hij],
 end
 
-local attribute [ext] tensor_product.ext
+end comm_semiring
+
+section comm_ring
+variables [comm_ring R]
+variables [add_comm_group M] [add_comm_group N] [add_comm_group P] [add_comm_group Q]
+variables [module R M] [module R N] [module R P] [module R Q]
+variables [decidable_eq ι] [fintype ι] (b : basis ι R M)
+
+variables {R M N P Q}
 
 /-- If `M` is free, the natural linear map $M^* ⊗ N → Hom(M, N)$ is an equivalence. This function
 provides this equivalence in return for a basis of `M`. -/
-@[simps]
-noncomputable def dual_tensor_hom_equiv_of_basis
-  {ι : Type*} [decidable_eq ι] [fintype ι] (b : basis ι R M) :
+@[simps apply]
+noncomputable def dual_tensor_hom_equiv_of_basis :
   (module.dual R M) ⊗[R] N ≃ₗ[R] M →ₗ[R] N :=
 linear_equiv.of_linear
   (dual_tensor_hom R M N)
@@ -106,7 +143,15 @@ end)
   dual_tensor_hom R M N :=
 rfl
 
-variables (R M N)
+@[simp] lemma dual_tensor_hom_equiv_of_basis_symm_cancel_left (x : (module.dual R M) ⊗[R] N) :
+  (dual_tensor_hom_equiv_of_basis b).symm (dual_tensor_hom R M N x) = x :=
+by rw [←dual_tensor_hom_equiv_of_basis_apply b, linear_equiv.symm_apply_apply]
+
+@[simp] lemma dual_tensor_hom_equiv_of_basis_symm_cancel_right (x : M →ₗ[R] N) :
+  dual_tensor_hom R M N ((dual_tensor_hom_equiv_of_basis b).symm x)  = x :=
+by rw [←dual_tensor_hom_equiv_of_basis_apply b, linear_equiv.apply_symm_apply]
+
+variables (R M N P Q)
 
 variables [module.free R M] [module.finite R M] [nontrivial R]
 
@@ -120,3 +165,107 @@ dual_tensor_hom_equiv_of_basis (module.free.choose_basis R M)
 end comm_ring
 
 end contraction
+
+section hom_tensor_hom
+
+open_locale tensor_product
+
+open module tensor_product linear_map
+
+section comm_ring
+
+variables [comm_ring R]
+variables [add_comm_group M] [add_comm_group N] [add_comm_group P] [add_comm_group Q]
+variables [module R M] [module R N] [module R P] [module R Q]
+variables [free R M] [finite R M] [free R N] [finite R N] [nontrivial R]
+
+/-- When `M` is a finite free module, the map `ltensor_hom_to_hom_ltensor` is an equivalence. Note
+that `ltensor_hom_equiv_hom_ltensor` is not defined directly in terms of
+`ltensor_hom_to_hom_ltensor`, but the equivalence between the two is given by
+`ltensor_hom_equiv_hom_ltensor_to_linear_map` and `ltensor_hom_equiv_hom_ltensor_apply`. -/
+noncomputable def ltensor_hom_equiv_hom_ltensor : P ⊗[R] (M →ₗ[R] Q) ≃ₗ[R] (M →ₗ[R] P ⊗[R] Q) :=
+congr (linear_equiv.refl R P) (dual_tensor_hom_equiv R M Q).symm ≪≫ₗ
+  tensor_product.left_comm R P _ Q ≪≫ₗ dual_tensor_hom_equiv R M _
+
+/-- When `M` is a finite free module, the map `rtensor_hom_to_hom_rtensor` is an equivalence. Note
+that `rtensor_hom_equiv_hom_rtensor` is not defined directly in terms of
+`rtensor_hom_to_hom_rtensor`, but the equivalence between the two is given by
+`rtensor_hom_equiv_hom_rtensor_to_linear_map` and `rtensor_hom_equiv_hom_rtensor_apply`. -/
+noncomputable def rtensor_hom_equiv_hom_rtensor : (M →ₗ[R] P) ⊗[R] Q ≃ₗ[R] (M →ₗ[R] P ⊗[R] Q) :=
+congr (dual_tensor_hom_equiv R M P).symm (linear_equiv.refl R Q) ≪≫ₗ
+  tensor_product.assoc R _ P Q ≪≫ₗ dual_tensor_hom_equiv R M _
+
+@[simp] lemma ltensor_hom_equiv_hom_ltensor_to_linear_map :
+  (ltensor_hom_equiv_hom_ltensor R M P Q).to_linear_map = ltensor_hom_to_hom_ltensor R M P Q :=
+begin
+  let e := congr (linear_equiv.refl R P) (dual_tensor_hom_equiv R M Q),
+  have h : function.surjective e.to_linear_map := e.surjective,
+  refine (cancel_right h).1 _,
+  ext p f q m,
+  dsimp [ltensor_hom_equiv_hom_ltensor],
+  simp only [ltensor_hom_equiv_hom_ltensor, dual_tensor_hom_equiv, compr₂_apply, mk_apply, coe_comp,
+  linear_equiv.coe_to_linear_map, function.comp_app, map_tmul, linear_equiv.coe_coe,
+  dual_tensor_hom_equiv_of_basis_apply, linear_equiv.trans_apply, congr_tmul,
+  linear_equiv.refl_apply, dual_tensor_hom_equiv_of_basis_symm_cancel_left, left_comm_tmul,
+  dual_tensor_hom_apply, ltensor_hom_to_hom_ltensor_apply, tmul_smul],
+end
+
+@[simp] lemma rtensor_hom_equiv_hom_rtensor_to_linear_map :
+  (rtensor_hom_equiv_hom_rtensor R M P Q).to_linear_map = rtensor_hom_to_hom_rtensor R M P Q :=
+begin
+  let e := congr (dual_tensor_hom_equiv R M P) (linear_equiv.refl R Q),
+  have h : function.surjective e.to_linear_map := e.surjective,
+  refine (cancel_right h).1 _,
+  ext f p q m,
+  simp only [rtensor_hom_equiv_hom_rtensor, dual_tensor_hom_equiv, compr₂_apply, mk_apply, coe_comp,
+  linear_equiv.coe_to_linear_map, function.comp_app, map_tmul, linear_equiv.coe_coe,
+  dual_tensor_hom_equiv_of_basis_apply, linear_equiv.trans_apply, congr_tmul,
+  dual_tensor_hom_equiv_of_basis_symm_cancel_left, linear_equiv.refl_apply, assoc_tmul,
+  dual_tensor_hom_apply, rtensor_hom_to_hom_rtensor_apply, smul_tmul'],
+end
+
+variables {R M N P Q}
+
+@[simp] lemma ltensor_hom_equiv_hom_ltensor_apply (x : P ⊗[R] (M →ₗ[R] Q)) :
+  ltensor_hom_equiv_hom_ltensor R M P Q x = ltensor_hom_to_hom_ltensor R M P Q x :=
+by rw [←linear_equiv.coe_to_linear_map, ltensor_hom_equiv_hom_ltensor_to_linear_map]
+
+@[simp] lemma rtensor_hom_equiv_hom_rtensor_apply (x : (M →ₗ[R] P) ⊗[R] Q) :
+  rtensor_hom_equiv_hom_rtensor R M P Q x = rtensor_hom_to_hom_rtensor R M P Q x :=
+by rw [←linear_equiv.coe_to_linear_map, rtensor_hom_equiv_hom_rtensor_to_linear_map]
+
+variables (R M N P Q)
+
+/--
+When `M` and `N` are free `R` modules, the map `hom_tensor_hom_map` is an equivalence. Note that
+`hom_tensor_hom_equiv` is not defined directly in terms of `hom_tensor_hom_map`, but the equivalence
+between the two is given by `hom_tensor_hom_equiv_to_linear_map` and `hom_tensor_hom_equiv_apply`.
+-/
+noncomputable
+def hom_tensor_hom_equiv : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q) ≃ₗ[R] (M ⊗[R] N →ₗ[R] P ⊗[R] Q) :=
+rtensor_hom_equiv_hom_rtensor R M P _ ≪≫ₗ
+  (linear_equiv.refl R M).arrow_congr (ltensor_hom_equiv_hom_ltensor R N _ Q) ≪≫ₗ
+  lift.equiv R M N _
+
+@[simp]
+lemma hom_tensor_hom_equiv_to_linear_map :
+  (hom_tensor_hom_equiv R M N P Q).to_linear_map = hom_tensor_hom_map R M N P Q :=
+begin
+  ext f g m n,
+  simp only [hom_tensor_hom_equiv, compr₂_apply, mk_apply, linear_equiv.coe_to_linear_map,
+  linear_equiv.trans_apply, lift.equiv_apply, linear_equiv.arrow_congr_apply,
+  linear_equiv.refl_symm, linear_equiv.refl_apply, rtensor_hom_equiv_hom_rtensor_apply,
+  ltensor_hom_equiv_hom_ltensor_apply, ltensor_hom_to_hom_ltensor_apply,
+  rtensor_hom_to_hom_rtensor_apply, hom_tensor_hom_map_apply, map_tmul],
+end
+
+variables {R M N P Q}
+
+@[simp]
+lemma hom_tensor_hom_equiv_apply (x : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q)) :
+  hom_tensor_hom_equiv R M N P Q x = hom_tensor_hom_map R M N P Q x :=
+by rw [←linear_equiv.coe_to_linear_map, hom_tensor_hom_equiv_to_linear_map]
+
+end comm_ring
+
+end hom_tensor_hom
diff --git a/src/linear_algebra/cross_product.lean b/src/linear_algebra/cross_product.lean
index 66e126dd97a93..524459f749110 100644
--- a/src/linear_algebra/cross_product.lean
+++ b/src/linear_algebra/cross_product.lean
@@ -12,6 +12,9 @@ import algebra.lie.basic
 /-!
 # Cross products
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This module defines the cross product of vectors in $R^3$ for $R$ a commutative ring,
 as a bilinear map.
 
@@ -58,7 +61,7 @@ begin
     simp [smul_vec3 (_ : R) (_ : R), mul_comm, mul_assoc, mul_left_comm, mul_add, sub_eq_add_neg] },
 end
 
-localized "infixl ` ×₃ `: 74 := cross_product" in matrix
+localized "infixl (name := cross_product) ` ×₃ `: 74 := cross_product" in matrix
 
 lemma cross_apply (a b : fin 3 → R) :
   a ×₃ b = ![a 1 * b 2 - a 2 * b 1,
@@ -96,8 +99,8 @@ lemma triple_product_permutation (u v w : fin 3 → R) :
   u ⬝ᵥ (v ×₃ w) = v ⬝ᵥ (w ×₃ u) :=
 begin
   simp only [cross_apply, vec3_dot_product,
-    matrix.head_cons, matrix.cons_vec_bit0_eq_alt0, matrix.empty_append, matrix.cons_val_one,
-    matrix.cons_vec_alt0, matrix.cons_append, matrix.cons_val_zero],
+    matrix.head_cons, matrix.cons_vec_bit0_eq_alt0, matrix.empty_vec_append, matrix.cons_val_one,
+    matrix.cons_vec_alt0, matrix.cons_vec_append, matrix.cons_val_zero],
   ring,
 end
 
@@ -108,8 +111,8 @@ theorem triple_product_eq_det (u v w : fin 3 → R) :
 begin
   simp only [vec3_dot_product, cross_apply, matrix.det_fin_three,
     matrix.head_cons, matrix.cons_vec_bit0_eq_alt0, matrix.empty_vec_alt0, matrix.cons_vec_alt0,
-    matrix.vec_head_vec_alt0, fin.fin_append_apply_zero, matrix.empty_append, matrix.cons_append,
-    matrix.cons_val', matrix.cons_val_one, matrix.cons_val_zero],
+    matrix.vec_head_vec_alt0, matrix.vec_append_apply_zero, matrix.empty_vec_append,
+    matrix.cons_vec_append, matrix.cons_val', matrix.cons_val_one, matrix.cons_val_zero],
   ring,
 end
 
@@ -117,8 +120,8 @@ end
 theorem cross_dot_cross (u v w x : fin 3 → R) :
   (u ×₃ v) ⬝ᵥ (w ×₃ x) = (u ⬝ᵥ w) * (v ⬝ᵥ x) - (u ⬝ᵥ x) * (v ⬝ᵥ w) :=
 begin
-  simp only [vec3_dot_product, cross_apply, cons_append, cons_vec_bit0_eq_alt0,
-    cons_val_one, cons_vec_alt0, linear_map.mk₂_apply, cons_val_zero, head_cons, empty_append],
+  simp only [vec3_dot_product, cross_apply, cons_vec_append, cons_vec_bit0_eq_alt0,
+    cons_val_one, cons_vec_alt0, linear_map.mk₂_apply, cons_val_zero, head_cons, empty_vec_append],
   ring_nf,
 end
 
diff --git a/src/linear_algebra/default.lean b/src/linear_algebra/default.lean
deleted file mode 100644
index c33b018f641d8..0000000000000
--- a/src/linear_algebra/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import linear_algebra.basic
diff --git a/src/linear_algebra/determinant.lean b/src/linear_algebra/determinant.lean
index 2ff658c34c9d5..c005163173ff9 100644
--- a/src/linear_algebra/determinant.lean
+++ b/src/linear_algebra/determinant.lean
@@ -3,9 +3,9 @@ Copyright (c) 2019 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
-import linear_algebra.multilinear.basis
+import linear_algebra.finite_dimensional
+import linear_algebra.general_linear_group
 import linear_algebra.matrix.reindex
-import ring_theory.algebra_tower
 import tactic.field_simp
 import linear_algebra.matrix.nonsingular_inverse
 import linear_algebra.matrix.basis
@@ -13,6 +13,9 @@ import linear_algebra.matrix.basis
 /-!
 # Determinant of families of vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the determinant of an endomorphism, and of a family of vectors
 with respect to some basis. For the determinant of a matrix, see the file
 `linear_algebra.matrix.determinant`.
@@ -89,8 +92,8 @@ begin
   -- Although `m` and `n` are different a priori, we will show they have the same cardinality.
   -- This turns the problem into one for square matrices, which is easy.
   let e := index_equiv_of_inv hMM' hM'M,
-  rw [← det_minor_equiv_self e, ← minor_mul_equiv _ _ _ (equiv.refl n) _, det_comm,
-    minor_mul_equiv, equiv.coe_refl, minor_id_id]
+  rw [← det_submatrix_equiv_self e, ← submatrix_mul_equiv _ _ _ (equiv.refl n) _, det_comm,
+    submatrix_mul_equiv, equiv.coe_refl, submatrix_id_id]
 end
 
 /-- If `M'` is a two-sided inverse for `M` (indexed differently), `det (M ⬝ N ⬝ M') = det N`.
@@ -130,7 +133,7 @@ there is no good way to generalize over universe parameters, so we can't fully s
 type that it does not depend on the choice of basis. Instead you can use the `det_aux_def'` lemma,
 or avoid mentioning a basis at all using `linear_map.det`.
 -/
-def det_aux : trunc (basis ι A M) → (M →ₗ[A] M) →* A :=
+@[irreducible] def det_aux : trunc (basis ι A M) → (M →ₗ[A] M) →* A :=
 trunc.lift
   (λ b : basis ι A M,
     (det_monoid_hom).comp (to_matrix_alg_equiv b : (M →ₗ[A] M) →* matrix ι ι A))
@@ -142,10 +145,7 @@ See also `det_aux_def'` which allows you to vary the basis.
 -/
 lemma det_aux_def (b : basis ι A M) (f : M →ₗ[A] M) :
   linear_map.det_aux (trunc.mk b) f = matrix.det (linear_map.to_matrix b b f) :=
-rfl
-
--- Discourage the elaborator from unfolding `det_aux` and producing a huge term.
-attribute [irreducible] linear_map.det_aux
+by  { rw [det_aux], refl }
 
 lemma det_aux_def' {ι' : Type*} [fintype ι'] [decidable_eq ι']
   (tb : trunc $ basis ι A M) (b' : basis ι' A M) (f : M →ₗ[A] M) :
@@ -206,6 +206,14 @@ by { haveI := classical.dec_eq M,
   det f.to_matrix' = f.det :=
 by simp [← to_matrix_eq_to_matrix']
 
+@[simp] lemma det_to_lin (b : basis ι R M) (f : matrix ι ι R) :
+  linear_map.det (matrix.to_lin b b f) = f.det :=
+by rw [← linear_map.det_to_matrix b, linear_map.to_matrix_to_lin]
+
+@[simp] lemma det_to_lin' (f : matrix ι ι R) :
+  linear_map.det (f.to_lin') = f.det :=
+by simp only [← to_lin_eq_to_lin', det_to_lin]
+
 /-- To show `P f.det` it suffices to consider `P (to_matrix _ _ f).det` and `P 1`. -/
 @[elab_as_eliminator]
 lemma det_cases [decidable_eq M] {P : A → Prop} (f : M →ₗ[A] M)
@@ -234,7 +242,7 @@ linear_map.det.map_one
 begin
   by_cases H : ∃ (s : finset M), nonempty (basis s 𝕜 M),
   { haveI : finite_dimensional 𝕜 M,
-    { rcases H with ⟨s, ⟨hs⟩⟩, exact finite_dimensional.of_finset_basis hs },
+    { rcases H with ⟨s, ⟨hs⟩⟩, exact finite_dimensional.of_fintype_basis hs },
     simp only [← det_to_matrix (finite_dimensional.fin_basis 𝕜 M), linear_equiv.map_smul,
               fintype.card_fin, det_smul] },
   { classical,
@@ -242,11 +250,10 @@ begin
     simp [coe_det, H, this] }
 end
 
-lemma det_zero' {ι : Type*} [fintype ι] [nonempty ι] (b : basis ι A M) :
+lemma det_zero' {ι : Type*} [finite ι] [nonempty ι] (b : basis ι A M) :
   linear_map.det (0 : M →ₗ[A] M) = 0 :=
-by { haveI := classical.dec_eq ι,
-     rw [← det_to_matrix b, linear_equiv.map_zero, det_zero],
-     assumption }
+by { haveI := classical.dec_eq ι, casesI nonempty_fintype ι,
+     rwa [← det_to_matrix b, linear_equiv.map_zero, det_zero] }
 
 /-- In a finite-dimensional vector space, the zero map has determinant `1` in dimension `0`,
 and `0` otherwise. We give a formula that also works in infinite dimension, where we define
@@ -255,6 +262,26 @@ the determinant to be `1`. -/
   linear_map.det (0 : M →ₗ[𝕜] M) = (0 : 𝕜) ^ (finite_dimensional.finrank 𝕜 M) :=
 by simp only [← zero_smul 𝕜 (1 : M →ₗ[𝕜] M), det_smul, mul_one, monoid_hom.map_one]
 
+lemma det_eq_one_of_subsingleton [subsingleton M] (f : M →ₗ[R] M) : (f : M →ₗ[R] M).det = 1 :=
+begin
+  have b : basis (fin 0) R M := basis.empty M,
+  rw ← f.det_to_matrix b,
+  exact matrix.det_is_empty,
+end
+
+lemma det_eq_one_of_finrank_eq_zero {𝕜 : Type*} [field 𝕜] {M : Type*} [add_comm_group M]
+  [module 𝕜 M] (h : finite_dimensional.finrank 𝕜 M = 0) (f : M →ₗ[𝕜] M) :
+  (f : M →ₗ[𝕜] M).det = 1 :=
+begin
+  classical,
+  refine @linear_map.det_cases M  _ 𝕜 _ _ _ (λ t, t = 1) f _ rfl,
+  intros s b,
+  haveI : is_empty s,
+  { rw ← fintype.card_eq_zero_iff,
+    exact (finite_dimensional.finrank_eq_card_basis b).symm.trans h },
+  exact matrix.det_is_empty
+end
+
 /-- Conjugating a linear map by a linear equiv does not change its determinant. -/
 @[simp] lemma det_conj {N : Type*} [add_comm_group N] [module A N]
   (f : M →ₗ[A] M) (e : M ≃ₗ[A] N) :
@@ -291,7 +318,7 @@ lemma finite_dimensional_of_det_ne_one {𝕜 : Type*} [field 𝕜] [module 𝕜
   (f : M →ₗ[𝕜] M) (hf : f.det ≠ 1) : finite_dimensional 𝕜 M :=
 begin
   by_cases H : ∃ (s : finset M), nonempty (basis s 𝕜 M),
-  { rcases H with ⟨s, ⟨hs⟩⟩, exact finite_dimensional.of_finset_basis hs },
+  { rcases H with ⟨s, ⟨hs⟩⟩, exact finite_dimensional.of_fintype_basis hs },
   { classical,
     simp [linear_map.coe_det, H] at hf,
     exact hf.elim }
@@ -405,17 +432,38 @@ have is_unit (linear_map.to_matrix (finite_dimensional.fin_basis 𝕜 M)
     by simp only [linear_map.det_to_matrix, is_unit_iff_ne_zero.2 hf],
 linear_equiv.of_is_unit_det this
 
+lemma linear_map.associated_det_of_eq_comp (e : M ≃ₗ[R] M) (f f' : M →ₗ[R] M)
+  (h : ∀ x, f x = f' (e x)) : associated f.det f'.det :=
+begin
+  suffices : associated (f' ∘ₗ ↑e).det f'.det,
+  { convert this using 2, ext x, exact h x },
+  rw [← mul_one f'.det, linear_map.det_comp],
+  exact associated.mul_left _ (associated_one_iff_is_unit.mpr e.is_unit_det')
+end
+
+lemma linear_map.associated_det_comp_equiv {N : Type*} [add_comm_group N] [module R N]
+  (f : N →ₗ[R] M) (e e' : M ≃ₗ[R] N) :
+  associated (f ∘ₗ ↑e).det (f ∘ₗ ↑e').det :=
+begin
+  refine linear_map.associated_det_of_eq_comp (e.trans e'.symm) _ _ _,
+  intro x,
+  simp only [linear_map.comp_apply, linear_equiv.coe_coe, linear_equiv.trans_apply,
+             linear_equiv.apply_symm_apply],
+end
+
 /-- The determinant of a family of vectors with respect to some basis, as an alternating
 multilinear map. -/
 def basis.det : alternating_map R M R ι :=
 { to_fun := λ v, det (e.to_matrix v),
   map_add' := begin
-    intros v i x y,
-    simp only [e.to_matrix_update, linear_equiv.map_add],
-    apply det_update_column_add
+    intros inst v i x y,
+    cases subsingleton.elim inst ‹_›,
+    simp only [e.to_matrix_update, linear_equiv.map_add, finsupp.coe_add],
+    exact det_update_column_add _ _ _ _,
   end,
   map_smul' := begin
-    intros u i c x,
+    intros inst u i c x,
+    cases subsingleton.elim inst ‹_›,
     simp only [e.to_matrix_update, algebra.id.smul_eq_mul, linear_equiv.map_smul],
     apply det_update_column_smul
   end,
@@ -432,6 +480,12 @@ lemma basis.det_apply (v : ι → M) : e.det v = det (e.to_matrix v) := rfl
 lemma basis.det_self : e.det e = 1 :=
 by simp [e.det_apply]
 
+@[simp] lemma basis.det_is_empty [is_empty ι] : e.det = alternating_map.const_of_is_empty R M ι 1 :=
+begin
+  ext v,
+  exact matrix.det_is_empty,
+end
+
 /-- `basis.det` is not the zero map. -/
 lemma basis.det_ne_zero [nontrivial R] : e.det ≠ 0 :=
 λ h, by simpa [h] using e.det_self
@@ -441,7 +495,7 @@ lemma is_basis_iff_det {v : ι → M} :
 begin
   split,
   { rintro ⟨hli, hspan⟩,
-    set v' := basis.mk hli hspan with v'_eq,
+    set v' := basis.mk hli hspan.ge with v'_eq,
     rw e.det_apply,
     convert linear_equiv.is_unit_det (linear_equiv.refl _ _) v' e using 2,
     ext i j,
@@ -463,16 +517,22 @@ map with respect to that basis, multiplied by the value of that alternating map
 lemma alternating_map.eq_smul_basis_det (f : alternating_map R M R ι) : f = f e • e.det :=
 begin
   refine basis.ext_alternating e (λ i h, _),
-  let σ : equiv.perm ι := equiv.of_bijective i (fintype.injective_iff_bijective.1 h),
+  let σ : equiv.perm ι := equiv.of_bijective i (finite.injective_iff_bijective.1 h),
   change f (e ∘ σ) = (f e • e.det) (e ∘ σ),
   simp [alternating_map.map_perm, basis.det_self]
 end
 
-@[simp] lemma alternating_map.map_basis_eq_zero_iff (f : alternating_map R M R ι) :
+@[simp] lemma alternating_map.map_basis_eq_zero_iff {ι : Type*} [finite ι]
+  (e : basis ι R M) (f : alternating_map R M R ι) :
   f e = 0 ↔ f = 0 :=
-⟨λ h, by simpa [h] using f.eq_smul_basis_det e, λ h, h.symm ▸ alternating_map.zero_apply _⟩
-
-lemma alternating_map.map_basis_ne_zero_iff (f : alternating_map R M R ι) :
+⟨λ h, begin
+  casesI nonempty_fintype ι,
+  letI := classical.dec_eq ι,
+  simpa [h] using f.eq_smul_basis_det e
+end, λ h, h.symm ▸ alternating_map.zero_apply _⟩
+
+lemma alternating_map.map_basis_ne_zero_iff {ι : Type*} [finite ι]
+  (e : basis ι R M) (f : alternating_map R M R ι) :
   f e ≠ 0 ↔ f ≠ 0 :=
 not_congr $ f.map_basis_eq_zero_iff e
 
@@ -484,11 +544,26 @@ by { rw [basis.det_apply, basis.det_apply, ← f.det_to_matrix e, ← matrix.det
          e.to_matrix_eq_to_matrix_constr (f ∘ v), e.to_matrix_eq_to_matrix_constr v,
          ← to_matrix_comp, e.constr_comp] }
 
+@[simp] lemma basis.det_comp_basis [module A M']
+  (b : basis ι A M) (b' : basis ι A M') (f : M →ₗ[A] M') :
+  b'.det (f ∘ b) = linear_map.det (f ∘ₗ (b'.equiv b (equiv.refl ι) : M' →ₗ[A] M)) :=
+begin
+  rw [basis.det_apply, ← linear_map.det_to_matrix b', linear_map.to_matrix_comp _ b,
+      matrix.det_mul, linear_map.to_matrix_basis_equiv, matrix.det_one, mul_one],
+  congr' 1, ext i j,
+  rw [basis.to_matrix_apply, linear_map.to_matrix_apply]
+end
+
 lemma basis.det_reindex {ι' : Type*} [fintype ι'] [decidable_eq ι']
   (b : basis ι R M) (v : ι' → M) (e : ι ≃ ι') :
   (b.reindex e).det v = b.det (v ∘ e) :=
 by rw [basis.det_apply, basis.to_matrix_reindex', det_reindex_alg_equiv, basis.det_apply]
 
+lemma basis.det_reindex' {ι' : Type*} [fintype ι'] [decidable_eq ι']
+  (b : basis ι R M) (e : ι ≃ ι') :
+  (b.reindex e).det = b.det.dom_dom_congr e :=
+alternating_map.ext $ λ _, basis.det_reindex _ _ _
+
 lemma basis.det_reindex_symm {ι' : Type*} [fintype ι'] [decidable_eq ι']
   (b : basis ι R M) (v : ι → M) (e : ι' ≃ ι) :
   (b.reindex e.symm).det (v ∘ e) = b.det v :=
@@ -512,7 +587,7 @@ end
 /-- If we fix a background basis `e`, then for any other basis `v`, we can characterise the
 coordinates provided by `v` in terms of determinants relative to `e`. -/
 lemma basis.det_smul_mk_coord_eq_det_update {v : ι → M}
-  (hli : linear_independent R v) (hsp : span R (range v) = ⊤) (i : ι) :
+  (hli : linear_independent R v) (hsp : ⊤ ≤ span R (range v)) (i : ι) :
   (e.det v) • (basis.mk hli hsp).coord i = e.det.to_multilinear_map.to_linear_map v i :=
 begin
   apply (basis.mk hli hsp).ext,
@@ -525,11 +600,24 @@ begin
     exact e.det.map_eq_zero_of_eq _ (by simp [hik, function.update_apply]) hik, },
 end
 
+/-- If a basis is multiplied columnwise by scalars `w : ι → Rˣ`, then the determinant with respect
+to this basis is multiplied by the product of the inverse of these scalars. -/
+lemma basis.det_units_smul (e : basis ι R M) (w : ι → Rˣ) :
+  (e.units_smul w).det = (↑(∏ i, w i)⁻¹ : R) • e.det :=
+begin
+  ext f,
+  change matrix.det (λ i j, (e.units_smul w).repr (f j) i)
+    = (↑(∏ i, w i)⁻¹ : R) • matrix.det (λ i j, e.repr (f j) i),
+  simp only [e.repr_units_smul],
+  convert matrix.det_mul_column (λ i, (↑((w i)⁻¹) : R)) (λ i j, e.repr (f j) i),
+  simp [← finset.prod_inv_distrib]
+end
+
 /-- The determinant of a basis constructed by `units_smul` is the product of the given units. -/
-@[simp] lemma basis.det_units_smul (w : ι → Rˣ) : e.det (e.units_smul w) = ∏ i, w i :=
+@[simp] lemma basis.det_units_smul_self (w : ι → Rˣ) : e.det (e.units_smul w) = ∏ i, w i :=
 by simp [basis.det_apply]
 
 /-- The determinant of a basis constructed by `is_unit_smul` is the product of the given units. -/
 @[simp] lemma basis.det_is_unit_smul {w : ι → R} (hw : ∀ i, is_unit (w i)) :
   e.det (e.is_unit_smul hw) = ∏ i, w i :=
-e.det_units_smul _
+e.det_units_smul_self _
diff --git a/src/linear_algebra/dfinsupp.lean b/src/linear_algebra/dfinsupp.lean
index 230147f10ca12..eaa222ea678ab 100644
--- a/src/linear_algebra/dfinsupp.lean
+++ b/src/linear_algebra/dfinsupp.lean
@@ -9,6 +9,9 @@ import linear_algebra.basis
 /-!
 # Properties of the module `Π₀ i, M i`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given an indexed collection of `R`-modules `M i`, the `R`-module structure on `Π₀ i, M i`
 is defined in `data.dfinsupp`.
 
@@ -206,6 +209,25 @@ lemma map_range.linear_equiv_symm (e : Π i, β₁ i ≃ₗ[R] β₂ i) :
 
 end map_range
 
+section coprod_map
+
+variables [decidable_eq ι] [Π (x : N), decidable (x ≠ 0)]
+
+/-- Given a family of linear maps `f i : M i  →ₗ[R] N`, we can form a linear map
+`(Π₀ i, M i) →ₗ[R] N` which sends `x : Π₀ i, M i` to the sum over `i` of `f i` applied to `x i`.
+This is the map coming from the universal property of `Π₀ i, M i` as the coproduct of the `M i`.
+See also `linear_map.coprod` for the binary product version. -/
+noncomputable def coprod_map (f : Π (i : ι), M i  →ₗ[R] N) : (Π₀ i, M i) →ₗ[R] N :=
+finsupp.lsum ℕ (λ i : ι, linear_map.id) ∘ₗ
+(@finsupp_lequiv_dfinsupp ι R N _ _ _ _ _).symm.to_linear_map ∘ₗ
+(dfinsupp.map_range.linear_map f)
+
+lemma coprod_map_apply (f : Π (i : ι), M i  →ₗ[R] N) (x : Π₀ i, M i) :
+  coprod_map f x =
+  finsupp.sum (map_range (λ i, f i) (λ i, linear_map.map_zero _) x).to_finsupp (λ i, id) := rfl
+
+end coprod_map
+
 section basis
 
 /-- The direct sum of free modules is free.
@@ -291,6 +313,30 @@ lemma mem_bsupr_iff_exists_dfinsupp (p : ι → Prop) [decidable_pred p] (S : ι
     ∃ f : Π₀ i, S i, dfinsupp.lsum ℕ (λ i, (S i).subtype) (f.filter p) = x :=
 set_like.ext_iff.mp (bsupr_eq_range_dfinsupp_lsum p S) x
 
+open_locale big_operators
+omit dec_ι
+lemma mem_supr_finset_iff_exists_sum {s : finset ι} (p : ι → submodule R N) (a : N) :
+  a ∈ (⨆ i ∈ s, p i) ↔ ∃ μ : Π i, p i, ∑ i in s, (μ i : N) = a :=
+begin
+  classical,
+  rw submodule.mem_supr_iff_exists_dfinsupp',
+  split; rintro ⟨μ, hμ⟩,
+  { use λ i, ⟨μ i, (supr_const_le : _ ≤ p i) (coe_mem $ μ i)⟩,
+    rw ← hμ, symmetry, apply finset.sum_subset,
+    { intro x, contrapose, intro hx,
+      rw [mem_support_iff, not_ne_iff],
+      ext, rw [coe_zero, ← mem_bot R], convert coe_mem (μ x),
+      symmetry, exact supr_neg hx },
+    { intros x _ hx, rw [mem_support_iff, not_ne_iff] at hx, rw hx, refl } },
+  { refine ⟨dfinsupp.mk s _, _⟩,
+    { rintro ⟨i, hi⟩, refine ⟨μ i, _⟩,
+      rw supr_pos, { exact coe_mem _ }, { exact hi } },
+    simp only [dfinsupp.sum],
+    rw [finset.sum_subset support_mk_subset, ← hμ],
+    exact finset.sum_congr rfl (λ x hx, congr_arg coe $ mk_of_mem hx),
+    { intros x _ hx, rw [mem_support_iff, not_ne_iff] at hx, rw hx, refl } }
+end
+
 end submodule
 
 namespace complete_lattice
@@ -419,10 +465,13 @@ lemma independent_iff_dfinsupp_sum_add_hom_injective (p : ι → add_subgroup N)
 ⟨independent.dfinsupp_sum_add_hom_injective, independent_of_dfinsupp_sum_add_hom_injective' p⟩
 
 omit dec_ι
+
 /-- If a family of submodules is `independent`, then a choice of nonzero vector from each submodule
-forms a linearly independent family. -/
+forms a linearly independent family.
+
+See also `complete_lattice.independent.linear_independent'`. -/
 lemma independent.linear_independent [no_zero_smul_divisors R N] (p : ι → submodule R N)
-  (hp : complete_lattice.independent p) {v : ι → N} (hv : ∀ i, v i ∈ p i) (hv' : ∀ i, v i ≠ 0) :
+  (hp : independent p) {v : ι → N} (hv : ∀ i, v i ∈ p i) (hv' : ∀ i, v i ≠ 0) :
   linear_independent R v :=
 begin
   classical,
@@ -439,6 +488,12 @@ begin
   simp [this, ha],
 end
 
+lemma independent_iff_linear_independent_of_ne_zero [no_zero_smul_divisors R N] {v : ι → N}
+  (h_ne_zero : ∀ i, v i ≠ 0) :
+  independent (λ i, R ∙ v i) ↔ linear_independent R v :=
+⟨λ hv, hv.linear_independent _ (λ i, submodule.mem_span_singleton_self $ v i) h_ne_zero,
+ λ hv, hv.independent_span_singleton⟩
+
 end ring
 
 end complete_lattice
diff --git a/src/linear_algebra/dimension.lean b/src/linear_algebra/dimension.lean
index 0cbb22c2e9ce9..f9ac316b7a86a 100644
--- a/src/linear_algebra/dimension.lean
+++ b/src/linear_algebra/dimension.lean
@@ -3,7 +3,9 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Johannes Hölzl, Sander Dahmen, Scott Morrison
 -/
+import algebra.module.big_operators
 import linear_algebra.dfinsupp
+import linear_algebra.free_module.basic
 import linear_algebra.invariant_basis_number
 import linear_algebra.isomorphisms
 import linear_algebra.std_basis
@@ -12,6 +14,9 @@ import set_theory.cardinal.cofinality
 /-!
 # Dimension of modules and vector spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * The rank of a module is defined as `module.rank : cardinal`.
@@ -21,9 +26,9 @@ import set_theory.cardinal.cofinality
 
 ## Main statements
 
-* `linear_map.dim_le_of_injective`: the source of an injective linear map has dimension
+* `linear_map.rank_le_of_injective`: the source of an injective linear map has dimension
   at most that of the target.
-* `linear_map.dim_le_of_surjective`: the target of a surjective linear map has dimension
+* `linear_map.rank_le_of_surjective`: the target of a surjective linear map has dimension
   at most that of that source.
 * `basis_fintype_of_finite_spans`:
   the existence of a finite spanning set implies that any basis is finite.
@@ -56,16 +61,12 @@ For modules over rings with invariant basis number
 
 For vector spaces (i.e. modules over a field), we have
 
-* `dim_quotient_add_dim`: if `V₁` is a submodule of `V`, then
+* `rank_quotient_add_rank`: if `V₁` is a submodule of `V`, then
   `module.rank (V/V₁) + module.rank V₁ = module.rank V`.
-* `dim_range_add_dim_ker`: the rank-nullity theorem.
+* `rank_range_add_rank_ker`: the rank-nullity theorem.
 
 ## Implementation notes
 
-There is a naming discrepancy: most of the theorem names refer to `dim`,
-even though the definition is of `module.rank`.
-This reflects that `module.rank` was originally called `dim`, and only defined for vector spaces.
-
 Many theorems in this file are not universe-generic when they relate dimensions
 in different universes. They should be as general as they can be without
 inserting `lift`s. The types `V`, `V'`, ... all live in different universes,
@@ -104,8 +105,8 @@ In particular this agrees with the usual notion of the dimension of a vector spa
 The definition is marked as protected to avoid conflicts with `_root_.rank`,
 the rank of a linear map.
 -/
-protected def module.rank : cardinal :=
-cardinal.sup.{v v} (λ ι : {s : set V // linear_independent K (coe : s → V)}, #ι.1)
+@[irreducible] protected def module.rank : cardinal :=
+⨆ ι : {s : set V // linear_independent K (coe : s → V)}, #ι.1
 
 end
 
@@ -115,176 +116,198 @@ variables {M : Type v} [add_comm_group M] [module R M]
 variables {M' : Type v'} [add_comm_group M'] [module R M']
 variables {M₁ : Type v} [add_comm_group M₁] [module R M₁]
 
-theorem linear_map.lift_dim_le_of_injective (f : M →ₗ[R] M') (i : injective f) :
-  cardinal.lift.{v'} (module.rank R M) ≤ cardinal.lift.{ v} (module.rank R M') :=
+theorem linear_map.lift_rank_le_of_injective (f : M →ₗ[R] M') (i : injective f) :
+  cardinal.lift.{v'} (module.rank R M) ≤ cardinal.lift.{v} (module.rank R M') :=
 begin
   dsimp [module.rank],
-  fapply cardinal.lift_sup_le_lift_sup',
-  { rintro ⟨s, li⟩,
-    use f '' s,
-    convert (li.map' f (linear_map.ker_eq_bot.mpr i)).comp
-      (equiv.set.image ⇑f s i).symm (equiv.injective _),
-    ext ⟨-, ⟨x, ⟨h, rfl⟩⟩⟩,
-    simp, },
-  { rintro ⟨s, li⟩,
-    exact cardinal.lift_mk_le'.mpr ⟨(equiv.set.image f s i).to_embedding⟩, }
+  rw [cardinal.lift_supr (cardinal.bdd_above_range.{v' v'} _),
+    cardinal.lift_supr (cardinal.bdd_above_range.{v v} _)],
+  apply csupr_mono' (cardinal.bdd_above_range.{v' v} _),
+  rintro ⟨s, li⟩,
+  refine ⟨⟨f '' s, _⟩, cardinal.lift_mk_le'.mpr ⟨(equiv.set.image f s i).to_embedding⟩⟩,
+  exact (li.map' _ $ linear_map.ker_eq_bot.mpr i).image,
 end
 
-theorem linear_map.dim_le_of_injective (f : M →ₗ[R] M₁) (i : injective f) :
+theorem linear_map.rank_le_of_injective (f : M →ₗ[R] M₁) (i : injective f) :
   module.rank R M ≤ module.rank R M₁ :=
-cardinal.lift_le.1 (f.lift_dim_le_of_injective i)
+cardinal.lift_le.1 (f.lift_rank_le_of_injective i)
 
-theorem dim_le {n : ℕ}
+theorem rank_le {n : ℕ}
   (H : ∀ s : finset M, linear_independent R (λ i : s, (i : M)) → s.card ≤ n) :
   module.rank R M ≤ n :=
 begin
-  apply cardinal.sup_le,
+  rw module.rank,
+  apply csupr_le',
   rintro ⟨s, li⟩,
   exact linear_independent_bounded_of_finset_linear_independent_bounded H _ li,
 end
 
-lemma lift_dim_range_le (f : M →ₗ[R] M') :
+lemma lift_rank_range_le (f : M →ₗ[R] M') :
   cardinal.lift.{v} (module.rank R f.range) ≤ cardinal.lift.{v'} (module.rank R M) :=
 begin
   dsimp [module.rank],
-  apply cardinal.lift_sup_le,
+  rw [cardinal.lift_supr (cardinal.bdd_above_range.{v' v'} _)],
+  apply csupr_le',
   rintro ⟨s, li⟩,
   apply le_trans,
   swap 2,
   apply cardinal.lift_le.mpr,
-  refine (cardinal.le_sup _ ⟨range_splitting f '' s, _⟩),
+  refine (le_csupr (cardinal.bdd_above_range.{v v} _) ⟨range_splitting f '' s, _⟩),
   { apply linear_independent.of_comp f.range_restrict,
     convert li.comp (equiv.set.range_splitting_image_equiv f s) (equiv.injective _) using 1, },
   { exact (cardinal.lift_mk_eq'.mpr ⟨equiv.set.range_splitting_image_equiv f s⟩).ge, },
 end
 
-lemma dim_range_le (f : M →ₗ[R] M₁) : module.rank R f.range ≤ module.rank R M :=
-by simpa using lift_dim_range_le f
+lemma rank_range_le (f : M →ₗ[R] M₁) : module.rank R f.range ≤ module.rank R M :=
+by simpa using lift_rank_range_le f
 
-lemma lift_dim_map_le (f : M →ₗ[R] M') (p : submodule R M) :
+lemma lift_rank_map_le (f : M →ₗ[R] M') (p : submodule R M) :
   cardinal.lift.{v} (module.rank R (p.map f)) ≤ cardinal.lift.{v'} (module.rank R p) :=
 begin
-  have h := lift_dim_range_le (f.comp (submodule.subtype p)),
+  have h := lift_rank_range_le (f.comp (submodule.subtype p)),
   rwa [linear_map.range_comp, range_subtype] at h,
 end
 
-lemma dim_map_le (f : M →ₗ[R] M₁) (p : submodule R M) : module.rank R (p.map f) ≤ module.rank R p :=
-by simpa using lift_dim_map_le f p
+lemma rank_map_le (f : M →ₗ[R] M₁) (p : submodule R M) :
+  module.rank R (p.map f) ≤ module.rank R p :=
+by simpa using lift_rank_map_le f p
 
-lemma dim_le_of_submodule (s t : submodule R M) (h : s ≤ t) :
+lemma rank_le_of_submodule (s t : submodule R M) (h : s ≤ t) :
   module.rank R s ≤ module.rank R t :=
-(of_le h).dim_le_of_injective $ assume ⟨x, hx⟩ ⟨y, hy⟩ eq,
+(of_le h).rank_le_of_injective $ assume ⟨x, hx⟩ ⟨y, hy⟩ eq,
   subtype.eq $ show x = y, from subtype.ext_iff_val.1 eq
 
 /-- Two linearly equivalent vector spaces have the same dimension, a version with different
 universes. -/
-theorem linear_equiv.lift_dim_eq (f : M ≃ₗ[R] M') :
+theorem linear_equiv.lift_rank_eq (f : M ≃ₗ[R] M') :
   cardinal.lift.{v'} (module.rank R M) = cardinal.lift.{v} (module.rank R M') :=
 begin
   apply le_antisymm,
-  { exact f.to_linear_map.lift_dim_le_of_injective f.injective, },
-  { exact f.symm.to_linear_map.lift_dim_le_of_injective f.symm.injective, },
+  { exact f.to_linear_map.lift_rank_le_of_injective f.injective, },
+  { exact f.symm.to_linear_map.lift_rank_le_of_injective f.symm.injective, },
 end
 
 /-- Two linearly equivalent vector spaces have the same dimension. -/
-theorem linear_equiv.dim_eq (f : M ≃ₗ[R] M₁) :
+theorem linear_equiv.rank_eq (f : M ≃ₗ[R] M₁) :
   module.rank R M = module.rank R M₁ :=
-cardinal.lift_inj.1 f.lift_dim_eq
+cardinal.lift_inj.1 f.lift_rank_eq
 
-lemma dim_eq_of_injective (f : M →ₗ[R] M₁) (h : injective f) :
+lemma rank_eq_of_injective (f : M →ₗ[R] M₁) (h : injective f) :
   module.rank R M = module.rank R f.range :=
-(linear_equiv.of_injective f h).dim_eq
+(linear_equiv.of_injective f h).rank_eq
 
 /-- Pushforwards of submodules along a `linear_equiv` have the same dimension. -/
-lemma linear_equiv.dim_map_eq (f : M ≃ₗ[R] M₁) (p : submodule R M) :
+lemma linear_equiv.rank_map_eq (f : M ≃ₗ[R] M₁) (p : submodule R M) :
   module.rank R (p.map (f : M →ₗ[R] M₁)) = module.rank R p :=
-(f.submodule_map p).dim_eq.symm
+(f.submodule_map p).rank_eq.symm
 
 variables (R M)
 
-@[simp] lemma dim_top : module.rank R (⊤ : submodule R M) = module.rank R M :=
+@[simp] lemma rank_top : module.rank R (⊤ : submodule R M) = module.rank R M :=
 begin
   have : (⊤ : submodule R M) ≃ₗ[R] M := linear_equiv.of_top ⊤ rfl,
-  rw this.dim_eq,
+  rw this.rank_eq,
 end
 
 variables {R M}
 
-lemma dim_range_of_surjective (f : M →ₗ[R] M') (h : surjective f) :
+lemma rank_range_of_surjective (f : M →ₗ[R] M') (h : surjective f) :
   module.rank R f.range = module.rank R M' :=
-by rw [linear_map.range_eq_top.2 h, dim_top]
+by rw [linear_map.range_eq_top.2 h, rank_top]
 
-lemma dim_submodule_le (s : submodule R M) : module.rank R s ≤ module.rank R M :=
+lemma rank_submodule_le (s : submodule R M) : module.rank R s ≤ module.rank R M :=
 begin
-  rw ←dim_top R M,
-  exact dim_le_of_submodule _ _ le_top,
+  rw ←rank_top R M,
+  exact rank_le_of_submodule _ _ le_top,
 end
 
-lemma linear_map.dim_le_of_surjective (f : M →ₗ[R] M₁) (h : surjective f) :
+lemma linear_map.rank_le_of_surjective (f : M →ₗ[R] M₁) (h : surjective f) :
   module.rank R M₁ ≤ module.rank R M :=
 begin
-  rw ←dim_range_of_surjective f h,
-  apply dim_range_le,
+  rw ←rank_range_of_surjective f h,
+  apply rank_range_le,
 end
 
-theorem dim_quotient_le (p : submodule R M) :
+theorem rank_quotient_le (p : submodule R M) :
   module.rank R (M ⧸ p) ≤ module.rank R M :=
-(mkq p).dim_le_of_surjective (surjective_quot_mk _)
+(mkq p).rank_le_of_surjective (surjective_quot_mk _)
 
 variables [nontrivial R]
 
-lemma {m} cardinal_lift_le_dim_of_linear_independent
+lemma {m} cardinal_lift_le_rank_of_linear_independent
   {ι : Type w} {v : ι → M} (hv : linear_independent R v) :
-  cardinal.lift.{(max v m)} (#ι) ≤ cardinal.lift.{(max w m)} (module.rank R M) :=
+  cardinal.lift.{max v m} (#ι) ≤ cardinal.lift.{max w m} (module.rank R M) :=
 begin
   apply le_trans,
   { exact cardinal.lift_mk_le.mpr
       ⟨(equiv.of_injective _ hv.injective).to_embedding⟩, },
-  { simp only [cardinal.lift_le],
+  { simp only [cardinal.lift_le, module.rank],
     apply le_trans,
     swap,
-    exact cardinal.le_sup _ ⟨range v, hv.coe_range⟩,
+    exact le_csupr (cardinal.bdd_above_range.{v v} _) ⟨range v, hv.coe_range⟩,
     exact le_rfl, },
 end
 
-lemma cardinal_lift_le_dim_of_linear_independent'
+lemma cardinal_lift_le_rank_of_linear_independent'
   {ι : Type w} {v : ι → M} (hv : linear_independent R v) :
   cardinal.lift.{v} (#ι) ≤ cardinal.lift.{w} (module.rank R M) :=
-cardinal_lift_le_dim_of_linear_independent.{u v w 0} hv
+cardinal_lift_le_rank_of_linear_independent.{u v w 0} hv
 
-lemma cardinal_le_dim_of_linear_independent
+lemma cardinal_le_rank_of_linear_independent
   {ι : Type v} {v : ι → M} (hv : linear_independent R v) :
   #ι ≤ module.rank R M :=
-by simpa using cardinal_lift_le_dim_of_linear_independent hv
+by simpa using cardinal_lift_le_rank_of_linear_independent hv
 
-lemma cardinal_le_dim_of_linear_independent'
+lemma cardinal_le_rank_of_linear_independent'
   {s : set M} (hs : linear_independent R (λ x, x : s → M)) :
   #s ≤ module.rank R M :=
-cardinal_le_dim_of_linear_independent hs
+cardinal_le_rank_of_linear_independent hs
 
 variables (R M)
 
-@[simp] lemma dim_punit : module.rank R punit = 0 :=
+@[simp] lemma rank_punit : module.rank R punit = 0 :=
 begin
   apply le_bot_iff.mp,
-  apply cardinal.sup_le,
+  rw module.rank,
+  apply csupr_le',
   rintro ⟨s, li⟩,
   apply le_bot_iff.mpr,
   apply cardinal.mk_emptyc_iff.mpr,
   simp only [subtype.coe_mk],
   by_contradiction h,
-  have ne : s.nonempty := ne_empty_iff_nonempty.mp h,
-  simpa using linear_independent.ne_zero (⟨_, ne.some_mem⟩ : s) li,
+  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h,
+  simpa using linear_independent.ne_zero (⟨a, ha⟩ : s) li,
 end
 
-@[simp] lemma dim_bot : module.rank R (⊥ : submodule R M) = 0 :=
+@[simp] lemma rank_bot : module.rank R (⊥ : submodule R M) = 0 :=
 begin
   have : (⊥ : submodule R M) ≃ₗ[R] punit := bot_equiv_punit,
-  rw [this.dim_eq, dim_punit],
+  rw [this.rank_eq, rank_punit],
 end
 
 variables {R M}
 
+lemma exists_mem_ne_zero_of_rank_pos {s : submodule R M} (h : 0 < module.rank R s) :
+  ∃ b : M, b ∈ s ∧ b ≠ 0 :=
+exists_mem_ne_zero_of_ne_bot $ assume eq, by rw [eq, rank_bot] at h; exact lt_irrefl _ h
+
+/-- A linearly-independent family of vectors in a module over a non-trivial ring must be finite if
+the module is Noetherian. -/
+lemma linear_independent.finite_of_is_noetherian [is_noetherian R M]
+  {v : ι → M} (hv : linear_independent R v) : finite ι :=
+begin
+  have hwf := is_noetherian_iff_well_founded.mp (by apply_instance : is_noetherian R M),
+  refine complete_lattice.well_founded.finite_of_independent hwf
+    hv.independent_span_singleton (λ i contra, _),
+  apply hv.ne_zero i,
+  have : v i ∈ R ∙ v i := submodule.mem_span_singleton_self (v i),
+  rwa [contra, submodule.mem_bot] at this,
+end
+
+lemma linear_independent.set_finite_of_is_noetherian [is_noetherian R M]
+  {s : set M} (hi : linear_independent R (coe : s → M)) : s.finite :=
+@set.to_finite _ _ hi.finite_of_is_noetherian
+
 /--
 Over any nontrivial ring, the existence of a finite spanning set implies that any basis is finite.
 -/
@@ -372,7 +395,7 @@ begin
     -- by expressing the `v i` in the basis `b`, and using that the `v i` have no `b b'` term.
     have l₀ : l none = 0,
     { rw ←eq_neg_iff_add_eq_zero at z,
-      replace z := eq_neg_of_eq_neg z,
+      replace z := neg_eq_iff_eq_neg.mpr z,
       apply_fun (λ x, b.repr x b') at z,
       simp only [repr_self, linear_equiv.map_smul, mul_one, finsupp.single_eq_same, pi.neg_apply,
         finsupp.smul_single', linear_equiv.map_neg, finsupp.coe_neg] at z,
@@ -436,8 +459,8 @@ begin
     exact i.prop },
   choose v hvV hv using hI,
   have : linear_independent R v,
-  { exact (hV.comp _ subtype.coe_injective).linear_independent _ hvV hv },
-  exact cardinal_lift_le_dim_of_linear_independent' this
+  { exact (hV.comp subtype.coe_injective).linear_independent _ hvV hv },
+  exact cardinal_lift_le_rank_of_linear_independent' this
 end
 
 end
@@ -445,37 +468,64 @@ end
 section rank_zero
 
 variables {R : Type u} {M : Type v}
-variables [ring R] [nontrivial R] [add_comm_group M] [module R M] [no_zero_smul_divisors R M]
+variables [ring R] [add_comm_group M] [module R M]
 
-lemma dim_zero_iff_forall_zero : module.rank R M = 0 ↔ ∀ x : M, x = 0 :=
+@[simp] lemma rank_subsingleton [subsingleton R] : module.rank R M = 1 :=
+begin
+  haveI := module.subsingleton R M,
+  haveI : nonempty {s : set M // linear_independent R (coe : s → M)},
+  { exact ⟨⟨∅, linear_independent_empty _ _⟩⟩ },
+  rw [module.rank, csupr_eq_of_forall_le_of_forall_lt_exists_gt],
+  { rintros ⟨s, hs⟩,
+    rw cardinal.mk_le_one_iff_set_subsingleton,
+    apply subsingleton_of_subsingleton },
+  intros w hw,
+  refine ⟨⟨{0}, _⟩, _⟩,
+  { rw linear_independent_iff',
+    intros,
+    exact subsingleton.elim _ _ },
+  { exact hw.trans_eq (cardinal.mk_singleton _).symm },
+end
+
+variables [no_zero_smul_divisors R M]
+
+lemma rank_pos [nontrivial M] : 0 < module.rank R M :=
+begin
+  obtain ⟨x, hx⟩ := exists_ne (0 : M),
+  suffices : 1 ≤ module.rank R M,
+  { exact zero_lt_one.trans_le this },
+  letI := module.nontrivial R M,
+  suffices : linear_independent R (λ (y : ({x} : set M)), ↑y),
+  { simpa using (cardinal_le_rank_of_linear_independent this), },
+  exact linear_independent_singleton hx
+end
+
+variables [nontrivial R]
+
+lemma rank_zero_iff_forall_zero : module.rank R M = 0 ↔ ∀ x : M, x = 0 :=
 begin
   refine ⟨λ h, _, λ h, _⟩,
   { contrapose! h,
     obtain ⟨x, hx⟩ := h,
-    suffices : 1 ≤ module.rank R M,
-    { intro h, exact lt_irrefl _ (lt_of_lt_of_le cardinal.zero_lt_one (h ▸ this)) },
-    suffices : linear_independent R (λ (y : ({x} : set M)), ↑y),
-    { simpa using (cardinal_le_dim_of_linear_independent this), },
-    exact linear_independent_singleton hx },
+    letI : nontrivial M := nontrivial_of_ne _ _ hx,
+    exact rank_pos.ne' },
   { have : (⊤ : submodule R M) = ⊥,
     { ext x, simp [h x] },
-    rw [←dim_top, this, dim_bot] }
+    rw [←rank_top, this, rank_bot] }
 end
 
-lemma dim_zero_iff : module.rank R M = 0 ↔ subsingleton M :=
-dim_zero_iff_forall_zero.trans (subsingleton_iff_forall_eq 0).symm
+/-- See `rank_subsingleton` for the reason that `nontrivial R` is needed. -/
+lemma rank_zero_iff : module.rank R M = 0 ↔ subsingleton M :=
+rank_zero_iff_forall_zero.trans (subsingleton_iff_forall_eq 0).symm
 
-lemma dim_pos_iff_exists_ne_zero : 0 < module.rank R M ↔ ∃ x : M, x ≠ 0 :=
+lemma rank_pos_iff_exists_ne_zero : 0 < module.rank R M ↔ ∃ x : M, x ≠ 0 :=
 begin
   rw ←not_iff_not,
-  simpa using dim_zero_iff_forall_zero
+  simpa using rank_zero_iff_forall_zero
 end
 
-lemma dim_pos_iff_nontrivial : 0 < module.rank R M ↔ nontrivial M :=
-dim_pos_iff_exists_ne_zero.trans (nontrivial_iff_exists_ne 0).symm
-
-lemma dim_pos [h : nontrivial M] : 0 < module.rank R M :=
-dim_pos_iff_nontrivial.2 h
+lemma rank_pos_iff_nontrivial : 0 < module.rank R M ↔ nontrivial M :=
+rank_pos_iff_exists_ne_zero.trans (nontrivial_iff_exists_ne 0).symm
 
 end rank_zero
 
@@ -490,41 +540,34 @@ theorem mk_eq_mk_of_basis (v : basis ι R M) (v' : basis ι' R M) :
   cardinal.lift.{w'} (#ι) = cardinal.lift.{w} (#ι') :=
 begin
   haveI := nontrivial_of_invariant_basis_number R,
-  by_cases h : #ι < ω,
+  casesI fintype_or_infinite ι,
   { -- `v` is a finite basis, so by `basis_fintype_of_finite_spans` so is `v'`.
-    haveI : fintype ι := (cardinal.lt_omega_iff_fintype.mp h).some,
-    haveI : fintype (range v) := set.fintype_range ⇑v,
+    haveI : fintype (range v) := set.fintype_range v,
     haveI := basis_fintype_of_finite_spans _ v.span_eq v',
     -- We clean up a little:
     rw [cardinal.mk_fintype, cardinal.mk_fintype],
     simp only [cardinal.lift_nat_cast, cardinal.nat_cast_inj],
     -- Now we can use invariant basis number to show they have the same cardinality.
     apply card_eq_of_lequiv R,
-    exact (((finsupp.linear_equiv_fun_on_fintype R R ι).symm.trans v.repr.symm) ≪≫ₗ
-      v'.repr) ≪≫ₗ (finsupp.linear_equiv_fun_on_fintype R R ι'), },
+    exact (((finsupp.linear_equiv_fun_on_finite R R ι).symm.trans v.repr.symm) ≪≫ₗ
+      v'.repr) ≪≫ₗ (finsupp.linear_equiv_fun_on_finite R R ι'), },
   { -- `v` is an infinite basis,
     -- so by `infinite_basis_le_maximal_linear_independent`, `v'` is at least as big,
     -- and then applying `infinite_basis_le_maximal_linear_independent` again
     -- we see they have the same cardinality.
-    simp only [not_lt] at h,
-    haveI : infinite ι := cardinal.infinite_iff.mpr h,
     have w₁ :=
       infinite_basis_le_maximal_linear_independent' v _ v'.linear_independent v'.maximal,
-    haveI : infinite ι' := cardinal.infinite_iff.mpr (begin
-      apply cardinal.lift_le.{w' w}.mp,
-      have p := (cardinal.lift_le.mpr h).trans w₁,
-      rw cardinal.lift_omega at ⊢ p,
-      exact p,
-    end),
+    rcases cardinal.lift_mk_le'.mp w₁ with ⟨f⟩,
+    haveI : infinite ι' := infinite.of_injective f f.2,
     have w₂ :=
       infinite_basis_le_maximal_linear_independent' v' _ v.linear_independent v.maximal,
     exact le_antisymm w₁ w₂, }
 end
 
-/-- Given two basis indexed by `ι` and `ι'` of an `R`-module, where `R` satisfies the invariant
+/-- Given two bases indexed by `ι` and `ι'` of an `R`-module, where `R` satisfies the invariant
 basis number property, an equiv `ι ≃ ι' `. -/
 def basis.index_equiv (v : basis ι R M) (v' : basis ι' R M) : ι ≃ ι' :=
-nonempty.some (cardinal.lift_mk_eq.1 (cardinal.lift_max.2 (mk_eq_mk_of_basis v v')))
+nonempty.some (cardinal.lift_mk_eq.1 (cardinal.lift_umax_eq.2 (mk_eq_mk_of_basis v v')))
 
 theorem mk_eq_mk_of_basis' {ι' : Type w} (v : basis ι R M) (v' : basis ι' R M) :
   #ι = #ι' :=
@@ -599,7 +642,7 @@ begin
       rw hJ at this,
       replace : v.repr (v i) ∈ (finsupp.supported R R (⋃ j, S j)) := this trivial,
       rw [v.repr_self, finsupp.mem_supported,
-        finsupp.support_single_ne_zero one_ne_zero] at this,
+        finsupp.support_single_ne_zero _ one_ne_zero] at this,
       { subst b,
         rcases mem_Union.1 (this (finset.mem_singleton_self _)) with ⟨j, hj⟩,
         exact mem_Union.2 ⟨j, (mem_image _ _ _).2 ⟨i, hj, rfl⟩⟩ },
@@ -608,8 +651,8 @@ begin
     suffices : #(⋃ j, S' j) < #(range v),
     { exact not_le_of_lt this ⟨set.embedding_of_subset _ _ hs⟩ },
     refine lt_of_le_of_lt (le_trans cardinal.mk_Union_le_sum_mk
-      (cardinal.sum_le_sum _ (λ _, ω) _)) _,
-    { exact λ j, le_of_lt (cardinal.lt_omega_iff_finite.2 $ (finset.finite_to_set _).image _) },
+      (cardinal.sum_le_sum _ (λ _, ℵ₀) _)) _,
+    { exact λ j, (cardinal.lt_aleph_0_of_finite _).le },
     { simpa } },
 end
 
@@ -690,25 +733,11 @@ begin
   exact le_top,
 end
 
-/-- A linearly-independent family of vectors in a module over a ring satisfying the strong rank
-condition must be finite if the module is Noetherian. -/
-noncomputable def fintype_of_is_noetherian_linear_independent [is_noetherian R M]
-  {v : ι → M} (hi : linear_independent R v) : fintype ι :=
-begin
-  have hfg : (⊤ : submodule R M).fg,
-  { exact is_noetherian_def.mp infer_instance ⊤, },
-  rw submodule.fg_def at hfg,
-  choose s hs hs' using hfg,
-  haveI : fintype s := hs.fintype,
-  apply linear_independent_fintype_of_le_span_fintype v hi s,
-  simp only [hs', set.subset_univ, submodule.top_coe, set.le_eq_subset],
-end
-
-/-- A linearly-independent subset of a module over a ring satisfying the strong rank condition
-must be finite if the module is Noetherian. -/
-lemma finite_of_is_noetherian_linear_independent [is_noetherian R M]
-  {s : set M} (hi : linear_independent R (coe : s → M)) : s.finite :=
-⟨fintype_of_is_noetherian_linear_independent hi⟩
+/-- A version of `linear_independent_le_span` for `finset`. -/
+lemma linear_independent_le_span_finset {ι : Type*} (v : ι → M) (i : linear_independent R v)
+  (w : finset M) (s : span R (w : set M) = ⊤) :
+  #ι ≤ w.card :=
+by simpa only [finset.coe_sort_coe, fintype.card_coe] using linear_independent_le_span v i w s
 
 /--
 An auxiliary lemma for `linear_independent_le_basis`:
@@ -720,7 +749,7 @@ lemma linear_independent_le_infinite_basis
   #κ ≤ #ι :=
 begin
   by_contradiction,
-  rw [not_le, ← cardinal.mk_finset_eq_mk ι] at h,
+  rw [not_le, ← cardinal.mk_finset_of_infinite ι] at h,
   let Φ := λ k : κ, (b.repr (v k)).support,
   obtain ⟨s, w : infinite ↥(Φ ⁻¹' {s})⟩ := cardinal.exists_infinite_fiber Φ h (by apply_instance),
   let v' := λ k : Φ ⁻¹' {s}, v k,
@@ -782,43 +811,40 @@ begin
     exact infinite_basis_le_maximal_linear_independent b v i m, }
 end
 
-theorem basis.mk_eq_dim'' {ι : Type v} (v : basis ι R M) :
+theorem basis.mk_eq_rank'' {ι : Type v} (v : basis ι R M) :
   #ι = module.rank R M :=
 begin
   haveI := nontrivial_of_invariant_basis_number R,
+  rw module.rank,
   apply le_antisymm,
   { transitivity,
     swap,
-    apply cardinal.le_sup,
+    apply le_csupr (cardinal.bdd_above_range.{v v} _),
     exact ⟨set.range v, by { convert v.reindex_range.linear_independent, ext, simp }⟩,
     exact (cardinal.mk_range_eq v v.injective).ge, },
-  { apply cardinal.sup_le,
+  { apply csupr_le',
     rintro ⟨s, li⟩,
     apply linear_independent_le_basis v _ li, },
 end
 
--- By this stage we want to have a complete API for `module.rank`,
--- so we set it `irreducible` here, to keep ourselves honest.
-attribute [irreducible] module.rank
-
-theorem basis.mk_range_eq_dim (v : basis ι R M) :
+theorem basis.mk_range_eq_rank (v : basis ι R M) :
   #(range v) = module.rank R M :=
-v.reindex_range.mk_eq_dim''
+v.reindex_range.mk_eq_rank''
 
 /-- If a vector space has a finite basis, then its dimension (seen as a cardinal) is equal to the
 cardinality of the basis. -/
-lemma dim_eq_card_basis {ι : Type w} [fintype ι] (h : basis ι R M) :
+lemma rank_eq_card_basis {ι : Type w} [fintype ι] (h : basis ι R M) :
   module.rank R M = fintype.card ι :=
 by {haveI := nontrivial_of_invariant_basis_number R,
-  rw [←h.mk_range_eq_dim, cardinal.mk_fintype, set.card_range_of_injective h.injective] }
+  rw [←h.mk_range_eq_rank, cardinal.mk_fintype, set.card_range_of_injective h.injective] }
 
 lemma basis.card_le_card_of_linear_independent {ι : Type*} [fintype ι]
   (b : basis ι R M) {ι' : Type*} [fintype ι'] {v : ι' → M} (hv : linear_independent R v) :
   fintype.card ι' ≤ fintype.card ι :=
 begin
   letI := nontrivial_of_invariant_basis_number R,
-  simpa [dim_eq_card_basis b, cardinal.mk_fintype] using
-    cardinal_lift_le_dim_of_linear_independent' hv
+  simpa [rank_eq_card_basis b, cardinal.mk_fintype] using
+    cardinal_lift_le_rank_of_linear_independent' hv
 end
 
 lemma basis.card_le_card_of_submodule (N : submodule R M) [fintype ι] (b : basis ι R M)
@@ -831,49 +857,47 @@ lemma basis.card_le_card_of_le
 b.card_le_card_of_linear_independent
   (b'.linear_independent.map' (submodule.of_le hNO) (N.ker_of_le O _))
 
-theorem basis.mk_eq_dim (v : basis ι R M) :
+theorem basis.mk_eq_rank (v : basis ι R M) :
   cardinal.lift.{v} (#ι) = cardinal.lift.{w} (module.rank R M) :=
 begin
   haveI := nontrivial_of_invariant_basis_number R,
-  rw [←v.mk_range_eq_dim, cardinal.mk_range_eq_of_injective v.injective]
+  rw [←v.mk_range_eq_rank, cardinal.mk_range_eq_of_injective v.injective]
 end
 
-theorem {m} basis.mk_eq_dim' (v : basis ι R M) :
-  cardinal.lift.{(max v m)} (#ι) = cardinal.lift.{(max w m)} (module.rank R M) :=
-by simpa using v.mk_eq_dim
+theorem {m} basis.mk_eq_rank' (v : basis ι R M) :
+  cardinal.lift.{max v m} (#ι) = cardinal.lift.{max w m} (module.rank R M) :=
+by simpa using v.mk_eq_rank
 
 /-- If a module has a finite dimension, all bases are indexed by a finite type. -/
-lemma basis.nonempty_fintype_index_of_dim_lt_omega {ι : Type*}
-  (b : basis ι R M) (h : module.rank R M < ω) :
+lemma basis.nonempty_fintype_index_of_rank_lt_aleph_0 {ι : Type*}
+  (b : basis ι R M) (h : module.rank R M < ℵ₀) :
   nonempty (fintype ι) :=
-by rwa [← cardinal.lift_lt, ← b.mk_eq_dim,
-        -- ensure `omega` has the correct universe
-        cardinal.lift_omega, ← cardinal.lift_omega.{u_1 v},
-        cardinal.lift_lt, cardinal.lt_omega_iff_fintype] at h
+by rwa [← cardinal.lift_lt, ← b.mk_eq_rank, cardinal.lift_aleph_0, cardinal.lift_lt_aleph_0,
+        cardinal.lt_aleph_0_iff_fintype] at h
 
 /-- If a module has a finite dimension, all bases are indexed by a finite type. -/
-noncomputable def basis.fintype_index_of_dim_lt_omega {ι : Type*}
-  (b : basis ι R M) (h : module.rank R M < ω) :
+noncomputable def basis.fintype_index_of_rank_lt_aleph_0 {ι : Type*}
+  (b : basis ι R M) (h : module.rank R M < ℵ₀) :
   fintype ι :=
-classical.choice (b.nonempty_fintype_index_of_dim_lt_omega h)
+classical.choice (b.nonempty_fintype_index_of_rank_lt_aleph_0 h)
 
 /-- If a module has a finite dimension, all bases are indexed by a finite set. -/
-lemma basis.finite_index_of_dim_lt_omega {ι : Type*} {s : set ι}
-  (b : basis s R M) (h : module.rank R M < ω) :
+lemma basis.finite_index_of_rank_lt_aleph_0 {ι : Type*} {s : set ι}
+  (b : basis s R M) (h : module.rank R M < ℵ₀) :
   s.finite :=
-finite_def.2 (b.nonempty_fintype_index_of_dim_lt_omega h)
+finite_def.2 (b.nonempty_fintype_index_of_rank_lt_aleph_0 h)
 
-lemma dim_span {v : ι → M} (hv : linear_independent R v) :
+lemma rank_span {v : ι → M} (hv : linear_independent R v) :
   module.rank R ↥(span R (range v)) = #(range v) :=
 begin
   haveI := nontrivial_of_invariant_basis_number R,
-  rw [←cardinal.lift_inj, ← (basis.span hv).mk_eq_dim,
+  rw [←cardinal.lift_inj, ← (basis.span hv).mk_eq_rank,
     cardinal.mk_range_eq_of_injective (@linear_independent.injective ι R M v _ _ _ _ hv)]
 end
 
-lemma dim_span_set {s : set M} (hs : linear_independent R (λ x, x : s → M)) :
+lemma rank_span_set {s : set M} (hs : linear_independent R (λ x, x : s → M)) :
   module.rank R ↥(span R s) = #s :=
-by { rw [← @set_of_mem_eq _ s, ← subtype.range_coe_subtype], exact dim_span hs }
+by { rw [← @set_of_mem_eq _ s, ← subtype.range_coe_subtype], exact rank_span hs }
 
 /-- If `N` is a submodule in a free, finitely generated module,
 do induction on adjoining a linear independent element to a submodule. -/
@@ -909,156 +933,191 @@ end
 
 variables (R)
 
-@[simp] lemma dim_self : module.rank R R = 1 :=
-by rw [←cardinal.lift_inj, ← (basis.singleton punit R).mk_eq_dim, cardinal.mk_punit]
+@[simp] lemma rank_self : module.rank R R = 1 :=
+by rw [←cardinal.lift_inj, ← (basis.singleton punit R).mk_eq_rank, cardinal.mk_punit]
 
 end strong_rank_condition
 
-section division_ring
-variables [division_ring K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
+section free
+variables [ring K] [strong_rank_condition K]
+variables [add_comm_group V] [module K V] [module.free K V]
+variables [add_comm_group V'] [module K V'] [module.free K V']
+variables [add_comm_group V₁] [module K V₁] [module.free K V₁]
 variables {K V}
 
-/-- If a vector space has a finite dimension, the index set of `basis.of_vector_space` is finite. -/
-lemma basis.finite_of_vector_space_index_of_dim_lt_omega (h : module.rank K V < ω) :
-  (basis.of_vector_space_index K V).finite :=
-finite_def.2 $ (basis.of_vector_space K V).nonempty_fintype_index_of_dim_lt_omega h
 
-variables [add_comm_group V'] [module K V']
+namespace module.free
+variables (K V)
+
+/-- The rank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
+lemma rank_eq_card_choose_basis_index : module.rank K V = #(choose_basis_index K V) :=
+(choose_basis K V).mk_eq_rank''.symm
+
+end module.free
+
+open module.free
+open cardinal
 
 /-- Two vector spaces are isomorphic if they have the same dimension. -/
-theorem nonempty_linear_equiv_of_lift_dim_eq
+theorem nonempty_linear_equiv_of_lift_rank_eq
   (cond : cardinal.lift.{v'} (module.rank K V) = cardinal.lift.{v} (module.rank K V')) :
   nonempty (V ≃ₗ[K] V') :=
 begin
-  let B := basis.of_vector_space K V,
-  let B' := basis.of_vector_space K V',
+  obtain ⟨⟨_, B⟩⟩ := module.free.exists_basis K V,
+  obtain ⟨⟨_, B'⟩⟩ := module.free.exists_basis K V',
   have : cardinal.lift.{v' v} (#_) = cardinal.lift.{v v'} (#_),
-    by rw [B.mk_eq_dim'', cond, B'.mk_eq_dim''],
+    by rw [B.mk_eq_rank'', cond, B'.mk_eq_rank''],
   exact (cardinal.lift_mk_eq.{v v' 0}.1 this).map (B.equiv B')
 end
 
 /-- Two vector spaces are isomorphic if they have the same dimension. -/
-theorem nonempty_linear_equiv_of_dim_eq (cond : module.rank K V = module.rank K V₁) :
+theorem nonempty_linear_equiv_of_rank_eq
+  (cond : module.rank K V = module.rank K V₁) :
   nonempty (V ≃ₗ[K] V₁) :=
-nonempty_linear_equiv_of_lift_dim_eq $ congr_arg _ cond
+nonempty_linear_equiv_of_lift_rank_eq $ congr_arg _ cond
 
 section
 
 variables (V V' V₁)
 
 /-- Two vector spaces are isomorphic if they have the same dimension. -/
-def linear_equiv.of_lift_dim_eq
+def linear_equiv.of_lift_rank_eq
   (cond : cardinal.lift.{v'} (module.rank K V) = cardinal.lift.{v} (module.rank K V')) :
   V ≃ₗ[K] V' :=
-classical.choice (nonempty_linear_equiv_of_lift_dim_eq cond)
+classical.choice (nonempty_linear_equiv_of_lift_rank_eq cond)
 
 /-- Two vector spaces are isomorphic if they have the same dimension. -/
-def linear_equiv.of_dim_eq (cond : module.rank K V = module.rank K V₁) : V ≃ₗ[K] V₁ :=
-classical.choice (nonempty_linear_equiv_of_dim_eq cond)
+def linear_equiv.of_rank_eq (cond : module.rank K V = module.rank K V₁) : V ≃ₗ[K] V₁ :=
+classical.choice (nonempty_linear_equiv_of_rank_eq cond)
 
 end
 
 /-- Two vector spaces are isomorphic if and only if they have the same dimension. -/
-theorem linear_equiv.nonempty_equiv_iff_lift_dim_eq :
+theorem linear_equiv.nonempty_equiv_iff_lift_rank_eq :
   nonempty (V ≃ₗ[K] V') ↔
     cardinal.lift.{v'} (module.rank K V) = cardinal.lift.{v} (module.rank K V') :=
-⟨λ ⟨h⟩, linear_equiv.lift_dim_eq h, λ h, nonempty_linear_equiv_of_lift_dim_eq h⟩
+⟨λ ⟨h⟩, linear_equiv.lift_rank_eq h, λ h, nonempty_linear_equiv_of_lift_rank_eq h⟩
 
 /-- Two vector spaces are isomorphic if and only if they have the same dimension. -/
-theorem linear_equiv.nonempty_equiv_iff_dim_eq :
+theorem linear_equiv.nonempty_equiv_iff_rank_eq :
   nonempty (V ≃ₗ[K] V₁) ↔ module.rank K V = module.rank K V₁ :=
-⟨λ ⟨h⟩, linear_equiv.dim_eq h, λ h, nonempty_linear_equiv_of_dim_eq h⟩
-
--- TODO how far can we generalise this?
--- When `s` is finite, we could prove this for any ring satisfying the strong rank condition
--- using `linear_independent_le_span'`
-lemma dim_span_le (s : set V) : module.rank K (span K s) ≤ #s :=
-begin
-  obtain ⟨b, hb, hsab, hlib⟩ := exists_linear_independent K s,
-  convert cardinal.mk_le_mk_of_subset hb,
-  rw [← hsab, dim_span_set hlib]
-end
+⟨λ ⟨h⟩, linear_equiv.rank_eq h, λ h, nonempty_linear_equiv_of_rank_eq h⟩
 
-lemma dim_span_of_finset (s : finset V) :
-  module.rank K (span K (↑s : set V)) < ω :=
-calc module.rank K (span K (↑s : set V)) ≤ #(↑s : set V) : dim_span_le ↑s
-                             ... = s.card : by rw [finset.coe_sort_coe, cardinal.mk_finset]
-                             ... < ω : cardinal.nat_lt_omega _
+/-- The rank of `M × N` is `(module.rank R M).lift + (module.rank R N).lift`. -/
+@[simp] lemma rank_prod :
+  module.rank K (V × V') =
+    cardinal.lift.{v'} (module.rank K V) + cardinal.lift.{v v'} (module.rank K V') :=
+by simpa [rank_eq_card_choose_basis_index K V, rank_eq_card_choose_basis_index K V',
+  lift_umax, lift_umax'] using ((choose_basis K V).prod (choose_basis K V')).mk_eq_rank.symm
 
-theorem dim_prod : module.rank K (V × V₁) = module.rank K V + module.rank K V₁ :=
-begin
-  let b := basis.of_vector_space K V,
-  let c := basis.of_vector_space K V₁,
-  rw [← cardinal.lift_inj,
-      ← (basis.prod b c).mk_eq_dim,
-      cardinal.lift_add, ← cardinal.mk_ulift,
-      ← b.mk_eq_dim, ← c.mk_eq_dim,
-      ← cardinal.mk_ulift, ← cardinal.mk_ulift,
-      cardinal.add_def (ulift _)],
-  exact cardinal.lift_inj.1 (cardinal.lift_mk_eq.2
-      ⟨equiv.ulift.trans (equiv.sum_congr equiv.ulift equiv.ulift).symm ⟩),
-end
+/-- If `M` and `N` lie in the same universe, the rank of `M × N` is
+  `(module.rank R M) + (module.rank R N)`. -/
+theorem rank_prod' : module.rank K (V × V₁) = module.rank K V + module.rank K V₁ :=
+by simp
 
 section fintype
-variable [fintype η]
-variables [∀i, add_comm_group (φ i)] [∀i, module K (φ i)]
+variables [∀i, add_comm_group (φ i)] [∀i, module K (φ i)] [∀i, module.free K (φ i)]
 
 open linear_map
 
-lemma dim_pi : module.rank K (Πi, φ i) = cardinal.sum (λi, module.rank K (φ i)) :=
+/-- The rank of a finite product is the sum of the ranks. -/
+@[simp] lemma rank_pi [finite η] :
+  module.rank K (Πi, φ i) = cardinal.sum (λi, module.rank K (φ i)) :=
 begin
-  let b := assume i, basis.of_vector_space K (φ i),
-  let this : basis (Σ j, _) K (Π j, φ j) := pi.basis b,
-  rw [← cardinal.lift_inj, ← this.mk_eq_dim],
-  simp [← (b _).mk_range_eq_dim]
+  casesI nonempty_fintype η,
+  let B := λ i, choose_basis K (φ i),
+  let b : basis _ K (Π i, φ i) := pi.basis (λ i, B i),
+  simp [← b.mk_eq_rank'', λ i, (B i).mk_eq_rank''],
 end
 
-lemma dim_fun {V η : Type u} [fintype η] [add_comm_group V] [module K V] :
+variable [fintype η]
+
+lemma rank_fun {V η : Type u} [fintype η] [add_comm_group V] [module K V]
+  [module.free K V] :
   module.rank K (η → V) = fintype.card η * module.rank K V :=
-by rw [dim_pi, cardinal.sum_const', cardinal.mk_fintype]
+by rw [rank_pi, cardinal.sum_const', cardinal.mk_fintype]
 
-lemma dim_fun_eq_lift_mul :
+lemma rank_fun_eq_lift_mul :
   module.rank K (η → V) = (fintype.card η : cardinal.{max u₁' v}) *
     cardinal.lift.{u₁'} (module.rank K V) :=
-by rw [dim_pi, cardinal.sum_const, cardinal.mk_fintype, cardinal.lift_nat_cast]
+by rw [rank_pi, cardinal.sum_const, cardinal.mk_fintype, cardinal.lift_nat_cast]
 
-lemma dim_fun' : module.rank K (η → K) = fintype.card η :=
-by rw [dim_fun_eq_lift_mul, dim_self, cardinal.lift_one, mul_one, cardinal.nat_cast_inj]
+lemma rank_fun' : module.rank K (η → K) = fintype.card η :=
+by rw [rank_fun_eq_lift_mul, rank_self, cardinal.lift_one, mul_one, cardinal.nat_cast_inj]
 
-lemma dim_fin_fun (n : ℕ) : module.rank K (fin n → K) = n :=
-by simp [dim_fun']
+lemma rank_fin_fun (n : ℕ) : module.rank K (fin n → K) = n :=
+by simp [rank_fun']
 
 end fintype
 
-end division_ring
+-- TODO: merge with the `finrank` content
+/-- An `n`-dimensional `K`-vector space is equivalent to `fin n → K`. -/
+def fin_dim_vectorspace_equiv (n : ℕ)
+  (hn : (module.rank K V) = n) : V ≃ₗ[K] (fin n → K) :=
+begin
+  haveI := nontrivial_of_invariant_basis_number K,
+  have : cardinal.lift.{u} (n : cardinal.{v}) = cardinal.lift.{v} (n : cardinal.{u}),
+    by simp,
+  have hn := cardinal.lift_inj.{v u}.2 hn,
+  rw this at hn,
+  rw ←@rank_fin_fun K _ _ n at hn,
+  haveI : module.free K (fin n → K) := module.free.pi _ _,
+  exact classical.choice (nonempty_linear_equiv_of_lift_rank_eq hn),
+end
+
+end free
 
-section field
-variables [field K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
+section division_ring
+variables [division_ring K]
+variables [add_comm_group V] [module K V]
 variables [add_comm_group V'] [module K V']
+variables [add_comm_group V₁] [module K V₁]
+variables {K V}
+
+/-- If a vector space has a finite dimension, the index set of `basis.of_vector_space` is finite. -/
+lemma basis.finite_of_vector_space_index_of_rank_lt_aleph_0 (h : module.rank K V < ℵ₀) :
+  (basis.of_vector_space_index K V).finite :=
+finite_def.2 $ (basis.of_vector_space K V).nonempty_fintype_index_of_rank_lt_aleph_0 h
 
-theorem dim_quotient_add_dim (p : submodule K V) :
+-- TODO how far can we generalise this?
+-- When `s` is finite, we could prove this for any ring satisfying the strong rank condition
+-- using `linear_independent_le_span'`
+lemma rank_span_le (s : set V) : module.rank K (span K s) ≤ #s :=
+begin
+  obtain ⟨b, hb, hsab, hlib⟩ := exists_linear_independent K s,
+  convert cardinal.mk_le_mk_of_subset hb,
+  rw [← hsab, rank_span_set hlib]
+end
+
+lemma rank_span_of_finset (s : finset V) :
+  module.rank K (span K (↑s : set V)) < ℵ₀ :=
+calc module.rank K (span K (↑s : set V)) ≤ #(↑s : set V) : rank_span_le ↑s
+                             ... = s.card : by rw [finset.coe_sort_coe, cardinal.mk_coe_finset]
+                             ... < ℵ₀ : cardinal.nat_lt_aleph_0 _
+
+theorem rank_quotient_add_rank (p : submodule K V) :
   module.rank K (V ⧸ p) + module.rank K p = module.rank K V :=
-by classical; exact let ⟨f⟩ := quotient_prod_linear_equiv p in dim_prod.symm.trans f.dim_eq
+by classical; exact let ⟨f⟩ := quotient_prod_linear_equiv p in rank_prod'.symm.trans f.rank_eq
 
 /-- rank-nullity theorem -/
-theorem dim_range_add_dim_ker (f : V →ₗ[K] V₁) :
+theorem rank_range_add_rank_ker (f : V →ₗ[K] V₁) :
   module.rank K f.range + module.rank K f.ker = module.rank K V :=
 begin
   haveI := λ (p : submodule K V), classical.dec_eq (V ⧸ p),
-  rw [← f.quot_ker_equiv_range.dim_eq, dim_quotient_add_dim]
+  rw [← f.quot_ker_equiv_range.rank_eq, rank_quotient_add_rank]
 end
 
-lemma dim_eq_of_surjective (f : V →ₗ[K] V₁) (h : surjective f) :
+lemma rank_eq_of_surjective (f : V →ₗ[K] V₁) (h : surjective f) :
   module.rank K V = module.rank K V₁ + module.rank K f.ker :=
-by rw [← dim_range_add_dim_ker f, ← dim_range_of_surjective f h]
+by rw [← rank_range_add_rank_ker f, ← rank_range_of_surjective f h]
 
 section
 variables [add_comm_group V₂] [module K V₂]
 variables [add_comm_group V₃] [module K V₃]
 open linear_map
 
-/-- This is mostly an auxiliary lemma for `dim_sup_add_dim_inf_eq`. -/
-lemma dim_add_dim_split
+/-- This is mostly an auxiliary lemma for `submodule.rank_sup_add_rank_inf_eq`. -/
+lemma rank_add_rank_split
   (db : V₂ →ₗ[K] V) (eb : V₃ →ₗ[K] V) (cd : V₁ →ₗ[K] V₂) (ce : V₁ →ₗ[K] V₃)
   (hde : ⊤ ≤ db.range ⊔ eb.range)
   (hgd : ker cd = ⊥)
@@ -1068,10 +1127,10 @@ lemma dim_add_dim_split
 have hf : surjective (coprod db eb),
 by rwa [←range_eq_top, range_coprod, eq_top_iff],
 begin
-  conv {to_rhs, rw [← dim_prod, dim_eq_of_surjective _ hf] },
+  conv {to_rhs, rw [← rank_prod', rank_eq_of_surjective _ hf] },
   congr' 1,
-  apply linear_equiv.dim_eq,
-  refine linear_equiv.of_bijective _ _ _,
+  apply linear_equiv.rank_eq,
+  refine linear_equiv.of_bijective _ ⟨_, _⟩,
   { refine cod_restrict _ (prod cd (- ce)) _,
     { assume c,
       simp only [add_eq_zero_iff_eq_neg, linear_map.prod_apply, mem_ker, pi.prod,
@@ -1079,7 +1138,7 @@ begin
       exact linear_map.ext_iff.1 eq c } },
   { rw [← ker_eq_bot, ker_cod_restrict, ker_prod, hgd, bot_inf_eq] },
   { rw [← range_eq_top, eq_top_iff, range_cod_restrict, ← map_le_iff_le_comap,
-      map_top, range_subtype],
+      submodule.map_top, range_subtype],
     rintros ⟨d, e⟩,
     have h := eq₂ d (-e),
     simp only [add_eq_zero_iff_eq_neg, linear_map.prod_apply, mem_ker, set_like.mem_coe,
@@ -1090,12 +1149,13 @@ begin
     rw [h₂, _root_.neg_neg] }
 end
 
-lemma dim_sup_add_dim_inf_eq (s t : submodule K V) :
+lemma submodule.rank_sup_add_rank_inf_eq (s t : submodule K V) :
   module.rank K (s ⊔ t : submodule K V) + module.rank K (s ⊓ t : submodule K V) =
     module.rank K s + module.rank K t :=
-dim_add_dim_split (of_le le_sup_left) (of_le le_sup_right) (of_le inf_le_left) (of_le inf_le_right)
+rank_add_rank_split
+  (of_le le_sup_left) (of_le le_sup_right) (of_le inf_le_left) (of_le inf_le_right)
   begin
-    rw [← map_le_map_iff' (ker_subtype $ s ⊔ t), map_sup, map_top,
+    rw [← map_le_map_iff' (ker_subtype $ s ⊔ t), submodule.map_sup, submodule.map_top,
       ← linear_map.range_comp, ← linear_map.range_comp, subtype_comp_of_le, subtype_comp_of_le,
       range_subtype, range_subtype, range_subtype],
     exact le_rfl
@@ -1108,112 +1168,52 @@ dim_add_dim_split (of_le le_sup_left) (of_le le_sup_right) (of_le inf_le_left) (
     exact ⟨⟨b₁, hb₁, hb₂⟩, rfl, rfl⟩
   end
 
-lemma dim_add_le_dim_add_dim (s t : submodule K V) :
+lemma submodule.rank_add_le_rank_add_rank (s t : submodule K V) :
   module.rank K (s ⊔ t : submodule K V) ≤ module.rank K s + module.rank K t :=
-by { rw [← dim_sup_add_dim_inf_eq], exact self_le_add_right _ _ }
+by { rw [← submodule.rank_sup_add_rank_inf_eq], exact self_le_add_right _ _ }
 
 end
 
-lemma exists_mem_ne_zero_of_dim_pos {s : submodule K V} (h : 0 < module.rank K s) :
-  ∃ b : V, b ∈ s ∧ b ≠ 0 :=
-exists_mem_ne_zero_of_ne_bot $ assume eq, by rw [eq, dim_bot] at h; exact lt_irrefl _ h
-
-end field
-
-section rank
-
-section
-variables [ring K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
-variables [add_comm_group V'] [module K V']
-
-/-- `rank f` is the rank of a `linear_map f`, defined as the dimension of `f.range`. -/
-def rank (f : V →ₗ[K] V') : cardinal := module.rank K f.range
-
-lemma rank_le_range (f : V →ₗ[K] V₁) : rank f ≤ module.rank K V₁ :=
-dim_submodule_le _
-
-@[simp] lemma rank_zero [nontrivial K] : rank (0 : V →ₗ[K] V') = 0 :=
-by rw [rank, linear_map.range_zero, dim_bot]
-
-variables [add_comm_group V''] [module K V'']
-
-lemma rank_comp_le1 (g : V →ₗ[K] V') (f : V' →ₗ[K] V'') : rank (f.comp g) ≤ rank f :=
-begin
-  refine dim_le_of_submodule _ _ _,
-  rw [linear_map.range_comp],
-  exact linear_map.map_le_range,
-end
-
-variables [add_comm_group V'₁] [module K V'₁]
-
-lemma rank_comp_le2 (g : V →ₗ[K] V') (f : V' →ₗ[K] V'₁) : rank (f.comp g) ≤ rank g :=
-by rw [rank, rank, linear_map.range_comp]; exact dim_map_le _ _
-
-end
-
-section field
-variables [field K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
-variables [add_comm_group V'] [module K V']
-
-lemma rank_le_domain (f : V →ₗ[K] V₁) : rank f ≤ module.rank K V :=
-by { rw [← dim_range_add_dim_ker f], exact self_le_add_right _ _ }
-
-lemma rank_add_le (f g : V →ₗ[K] V') : rank (f + g) ≤ rank f + rank g :=
-calc rank (f + g) ≤ module.rank K (f.range ⊔ g.range : submodule K V') :
-  begin
-    refine dim_le_of_submodule _ _ _,
-    exact (linear_map.range_le_iff_comap.2 $ eq_top_iff'.2 $
-      assume x, show f x + g x ∈ (f.range ⊔ g.range : submodule K V'), from
-        mem_sup.2 ⟨_, ⟨x, rfl⟩, _, ⟨x, rfl⟩, rfl⟩)
-  end
-  ... ≤ rank f + rank g : dim_add_le_dim_add_dim _ _
-
-lemma rank_finset_sum_le {η} (s : finset η) (f : η → V →ₗ[K] V') :
-  rank (∑ d in s, f d) ≤ ∑ d in s, rank (f d) :=
-@finset.sum_hom_rel _ _ _ _ _ (λa b, rank a ≤ b) f (λ d, rank (f d)) s (le_of_eq rank_zero)
-      (λ i g c h, le_trans (rank_add_le _ _) (add_le_add_left h _))
-
-end field
-
-end rank
+end division_ring
 
 section division_ring
-variables [division_ring K] [add_comm_group V] [module K V] [add_comm_group V'] [module K V']
+variables [division_ring K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
+variables [add_comm_group V'] [module K V']
 
 /-- The `ι` indexed basis on `V`, where `ι` is an empty type and `V` is zero-dimensional.
 
 See also `finite_dimensional.fin_basis`.
 -/
-def basis.of_dim_eq_zero {ι : Type*} [is_empty ι] (hV : module.rank K V = 0) :
+def basis.of_rank_eq_zero {ι : Type*} [is_empty ι] (hV : module.rank K V = 0) :
   basis ι K V :=
 begin
-  haveI : subsingleton V := dim_zero_iff.1 hV,
+  haveI : subsingleton V := rank_zero_iff.1 hV,
   exact basis.empty _
 end
 
-@[simp] lemma basis.of_dim_eq_zero_apply {ι : Type*} [is_empty ι]
+@[simp] lemma basis.of_rank_eq_zero_apply {ι : Type*} [is_empty ι]
   (hV : module.rank K V = 0) (i : ι) :
-  basis.of_dim_eq_zero hV i = 0 :=
+  basis.of_rank_eq_zero hV i = 0 :=
 rfl
 
-lemma le_dim_iff_exists_linear_independent {c : cardinal} :
+lemma le_rank_iff_exists_linear_independent {c : cardinal} :
   c ≤ module.rank K V ↔ ∃ s : set V, #s = c ∧ linear_independent K (coe : s → V) :=
 begin
   split,
   { intro h,
     let t := basis.of_vector_space K V,
-    rw [← t.mk_eq_dim'', cardinal.le_mk_iff_exists_subset] at h,
+    rw [← t.mk_eq_rank'', cardinal.le_mk_iff_exists_subset] at h,
     rcases h with ⟨s, hst, hsc⟩,
     exact ⟨s, hsc, (of_vector_space_index.linear_independent K V).mono hst⟩ },
   { rintro ⟨s, rfl, si⟩,
-    exact cardinal_le_dim_of_linear_independent si }
+    exact cardinal_le_rank_of_linear_independent si }
 end
 
-lemma le_dim_iff_exists_linear_independent_finset {n : ℕ} :
+lemma le_rank_iff_exists_linear_independent_finset {n : ℕ} :
   ↑n ≤ module.rank K V ↔
     ∃ s : finset V, s.card = n ∧ linear_independent K (coe : (s : set V) → V) :=
 begin
-  simp only [le_dim_iff_exists_linear_independent, cardinal.mk_eq_nat_iff_finset],
+  simp only [le_rank_iff_exists_linear_independent, cardinal.mk_set_eq_nat_iff_finset],
   split,
   { rintro ⟨s, ⟨t, rfl, rfl⟩, si⟩,
     exact ⟨t, rfl, si⟩ },
@@ -1223,12 +1223,12 @@ end
 
 /-- A vector space has dimension at most `1` if and only if there is a
 single vector of which all vectors are multiples. -/
-lemma dim_le_one_iff : module.rank K V ≤ 1 ↔ ∃ v₀ : V, ∀ v, ∃ r : K, r • v₀ = v :=
+lemma rank_le_one_iff : module.rank K V ≤ 1 ↔ ∃ v₀ : V, ∀ v, ∃ r : K, r • v₀ = v :=
 begin
   let b := basis.of_vector_space K V,
   split,
   { intro hd,
-    rw [← b.mk_eq_dim'', cardinal.le_one_iff_subsingleton, subsingleton_coe] at hd,
+    rw [← b.mk_eq_rank'', cardinal.le_one_iff_subsingleton, subsingleton_coe] at hd,
     rcases eq_empty_or_nonempty (of_vector_space_index K V) with hb | ⟨⟨v₀, hv₀⟩⟩,
     { use 0,
       have h' : ∀ v : V, v = 0, { simpa [hb, submodule.eq_bot_iff] using b.span_eq.symm },
@@ -1242,17 +1242,17 @@ begin
   { rintros ⟨v₀, hv₀⟩,
     have h : (K ∙ v₀) = ⊤,
     { ext, simp [mem_span_singleton, hv₀] },
-    rw [←dim_top, ←h],
-    convert dim_span_le _,
+    rw [←rank_top, ←h],
+    refine (rank_span_le _).trans_eq _,
     simp }
 end
 
 /-- A submodule has dimension at most `1` if and only if there is a
 single vector in the submodule such that the submodule is contained in
 its span. -/
-lemma dim_submodule_le_one_iff (s : submodule K V) : module.rank K s ≤ 1 ↔ ∃ v₀ ∈ s, s ≤ K ∙ v₀ :=
+lemma rank_submodule_le_one_iff (s : submodule K V) : module.rank K s ≤ 1 ↔ ∃ v₀ ∈ s, s ≤ K ∙ v₀ :=
 begin
-  simp_rw [dim_le_one_iff, le_span_singleton_iff],
+  simp_rw [rank_le_one_iff, le_span_singleton_iff],
   split,
   { rintro ⟨⟨v₀, hv₀⟩, h⟩,
     use [v₀, hv₀],
@@ -1273,9 +1273,9 @@ end
 /-- A submodule has dimension at most `1` if and only if there is a
 single vector, not necessarily in the submodule, such that the
 submodule is contained in its span. -/
-lemma dim_submodule_le_one_iff' (s : submodule K V) : module.rank K s ≤ 1 ↔ ∃ v₀, s ≤ K ∙ v₀ :=
+lemma rank_submodule_le_one_iff' (s : submodule K V) : module.rank K s ≤ 1 ↔ ∃ v₀, s ≤ K ∙ v₀ :=
 begin
-  rw dim_submodule_le_one_iff,
+  rw rank_submodule_le_one_iff,
   split,
   { rintros ⟨v₀, hv₀, h⟩,
     exact ⟨v₀, h⟩ },
@@ -1293,10 +1293,99 @@ begin
       simp [hw] } }
 end
 
+lemma submodule.rank_le_one_iff_is_principal (W : submodule K V) :
+  module.rank K W ≤ 1 ↔ W.is_principal :=
+begin
+  simp only [rank_le_one_iff, submodule.is_principal_iff, le_antisymm_iff,
+    le_span_singleton_iff, span_singleton_le_iff_mem],
+  split,
+  { rintro ⟨⟨m, hm⟩, hm'⟩,
+    choose f hf using hm',
+    exact ⟨m, ⟨λ v hv, ⟨f ⟨v, hv⟩, congr_arg coe (hf ⟨v, hv⟩)⟩, hm⟩⟩ },
+  { rintro ⟨a, ⟨h, ha⟩⟩,
+    choose f hf using h,
+    exact ⟨⟨a, ha⟩, λ v, ⟨f v.1 v.2, subtype.ext (hf v.1 v.2)⟩⟩ }
+end
+
+lemma module.rank_le_one_iff_top_is_principal :
+  module.rank K V ≤ 1 ↔ (⊤ : submodule K V).is_principal :=
+by rw [← submodule.rank_le_one_iff_is_principal, rank_top]
+
 end division_ring
 
-section field
-variables [field K] [add_comm_group V] [module K V] [add_comm_group V'] [module K V']
+end module
+
+/-! ### The rank of a linear map -/
+
+namespace linear_map
+
+section ring
+variables [ring K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
+variables [add_comm_group V'] [module K V']
+
+/-- `rank f` is the rank of a `linear_map` `f`, defined as the dimension of `f.range`. -/
+def rank (f : V →ₗ[K] V') : cardinal := module.rank K f.range
+
+lemma rank_le_range (f : V →ₗ[K] V') : rank f ≤ module.rank K V' :=
+rank_submodule_le _
+
+lemma rank_le_domain (f : V →ₗ[K] V₁) : rank f ≤ module.rank K V :=
+rank_range_le _
+
+@[simp] lemma rank_zero [nontrivial K] : rank (0 : V →ₗ[K] V') = 0 :=
+by rw [rank, linear_map.range_zero, rank_bot]
+
+variables [add_comm_group V''] [module K V'']
+
+lemma rank_comp_le_left (g : V →ₗ[K] V') (f : V' →ₗ[K] V'') : rank (f.comp g) ≤ rank f :=
+begin
+  refine rank_le_of_submodule _ _ _,
+  rw [linear_map.range_comp],
+  exact linear_map.map_le_range,
+end
+
+lemma lift_rank_comp_le_right (g : V →ₗ[K] V') (f : V' →ₗ[K] V'') :
+  cardinal.lift.{v'} (rank (f.comp g)) ≤ cardinal.lift.{v''} (rank g) :=
+by rw [rank, rank, linear_map.range_comp]; exact lift_rank_map_le _ _
+
+/-- The rank of the composition of two maps is less than the minimum of their ranks. -/
+lemma lift_rank_comp_le (g : V →ₗ[K] V') (f : V' →ₗ[K] V'') :
+  cardinal.lift.{v'} (rank (f.comp g)) ≤
+    min (cardinal.lift.{v'} (rank f)) (cardinal.lift.{v''} (rank g)) :=
+le_min (cardinal.lift_le.mpr $ rank_comp_le_left _ _) (lift_rank_comp_le_right _ _)
+
+variables [add_comm_group V'₁] [module K V'₁]
+
+lemma rank_comp_le_right (g : V →ₗ[K] V') (f : V' →ₗ[K] V'₁) : rank (f.comp g) ≤ rank g :=
+by simpa only [cardinal.lift_id] using lift_rank_comp_le_right g f
+
+/-- The rank of the composition of two maps is less than the minimum of their ranks.
+
+See `lift_rank_comp_le` for the universe-polymorphic version. -/
+lemma rank_comp_le (g : V →ₗ[K] V') (f : V' →ₗ[K] V'₁) :
+  rank (f.comp g) ≤ min (rank f) (rank g) :=
+by simpa only [cardinal.lift_id] using lift_rank_comp_le g f
+
+end ring
+
+section division_ring
+variables [division_ring K] [add_comm_group V] [module K V] [add_comm_group V₁] [module K V₁]
+variables [add_comm_group V'] [module K V']
+
+lemma rank_add_le (f g : V →ₗ[K] V') : rank (f + g) ≤ rank f + rank g :=
+calc rank (f + g) ≤ module.rank K (f.range ⊔ g.range : submodule K V') :
+  begin
+    refine rank_le_of_submodule _ _ _,
+    exact (linear_map.range_le_iff_comap.2 $ eq_top_iff'.2 $
+      assume x, show f x + g x ∈ (f.range ⊔ g.range : submodule K V'), from
+        mem_sup.2 ⟨_, ⟨x, rfl⟩, _, ⟨x, rfl⟩, rfl⟩)
+  end
+  ... ≤ rank f + rank g : submodule.rank_add_le_rank_add_rank _ _
+
+lemma rank_finset_sum_le {η} (s : finset η) (f : η → V →ₗ[K] V') :
+  rank (∑ d in s, f d) ≤ ∑ d in s, rank (f d) :=
+@finset.sum_hom_rel _ _ _ _ _ (λa b, rank a ≤ b) f (λ d, rank (f d)) s (le_of_eq rank_zero)
+      (λ i g c h, le_trans (rank_add_le _ _) (add_le_add_left h _))
 
 lemma le_rank_iff_exists_linear_independent {c : cardinal} {f : V →ₗ[K] V'} :
   c ≤ rank f ↔
@@ -1306,7 +1395,7 @@ begin
   rcases f.range_restrict.exists_right_inverse_of_surjective f.range_range_restrict with ⟨g, hg⟩,
   have fg : left_inverse f.range_restrict g, from linear_map.congr_fun hg,
   refine ⟨λ h, _, _⟩,
-  { rcases le_dim_iff_exists_linear_independent.1 h with ⟨s, rfl, si⟩,
+  { rcases le_rank_iff_exists_linear_independent.1 h with ⟨s, rfl, si⟩,
     refine ⟨g '' s, cardinal.mk_image_eq_lift _ _ fg.injective, _⟩,
     replace fg : ∀ x, f (g x) = x, by { intro x, convert congr_arg subtype.val (fg x) },
     replace si : linear_independent K (λ x : s, f (g x)),
@@ -1315,7 +1404,7 @@ begin
   { rintro ⟨s, hsc, si⟩,
     have : linear_independent K (λ x : s, f.range_restrict x),
       from linear_independent.of_comp (f.range.subtype) (by convert si),
-    convert cardinal_le_dim_of_linear_independent this.image,
+    convert cardinal_le_rank_of_linear_independent this.image,
     rw [← cardinal.lift_inj, ← hsc, cardinal.mk_image_eq_of_inj_on_lift],
     exact inj_on_iff_injective.2 this.injective }
 end
@@ -1324,7 +1413,7 @@ lemma le_rank_iff_exists_linear_independent_finset {n : ℕ} {f : V →ₗ[K] V'
   ↑n ≤ rank f ↔ ∃ s : finset V, s.card = n ∧ linear_independent K (λ x : (s : set V), f x) :=
 begin
   simp only [le_rank_iff_exists_linear_independent, cardinal.lift_nat_cast,
-    cardinal.lift_eq_nat_iff, cardinal.mk_eq_nat_iff_finset],
+    cardinal.lift_eq_nat_iff, cardinal.mk_set_eq_nat_iff_finset],
   split,
   { rintro ⟨s, ⟨t, rfl, rfl⟩, si⟩,
     exact ⟨t, rfl, si⟩ },
@@ -1332,6 +1421,6 @@ begin
     exact ⟨s, ⟨s, rfl, rfl⟩, si⟩ }
 end
 
-end field
+end division_ring
 
-end module
+end linear_map
diff --git a/src/linear_algebra/direct_sum/finsupp.lean b/src/linear_algebra/direct_sum/finsupp.lean
index 759b6cb8c6c38..5a369c076c87c 100644
--- a/src/linear_algebra/direct_sum/finsupp.lean
+++ b/src/linear_algebra/direct_sum/finsupp.lean
@@ -6,11 +6,13 @@ Authors: Johannes Hölzl
 import algebra.direct_sum.finsupp
 import linear_algebra.finsupp
 import linear_algebra.direct_sum.tensor_product
-import data.finsupp.to_dfinsupp
 
 /-!
 # Results on finitely supported functions.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The tensor product of ι →₀ M and κ →₀ N is linearly equivalent to (ι × κ) →₀ (M ⊗ N).
 -/
 
@@ -33,7 +35,7 @@ def finsupp_tensor_finsupp (R M N ι κ : Sort*) [comm_ring R]
   [add_comm_group M] [module R M] [add_comm_group N] [module R N] :
   (ι →₀ M) ⊗[R] (κ →₀ N) ≃ₗ[R] (ι × κ) →₀ (M ⊗[R] N) :=
 (tensor_product.congr (finsupp_lequiv_direct_sum R M ι) (finsupp_lequiv_direct_sum R N κ))
-  ≪≫ₗ ((tensor_product.direct_sum R ι κ (λ _, M) (λ _, N))
+  ≪≫ₗ ((tensor_product.direct_sum R (λ _ : ι, M) (λ _ : κ, N))
   ≪≫ₗ (finsupp_lequiv_direct_sum R (M ⊗[R] N) (ι × κ)).symm)
 
 @[simp] theorem finsupp_tensor_finsupp_single (R M N ι κ : Sort*) [comm_ring R]
@@ -57,7 +59,7 @@ begin
     { intros g₁ g₂ hg₁ hg₂, simp [tmul_add, hg₁, hg₂], },
     { intros k' n,
       simp only [finsupp_tensor_finsupp_single],
-      simp only [finsupp.single, finsupp.coe_mk],
+      simp only [finsupp.single_apply],
       -- split_ifs; finish can close the goal from here
       by_cases h1 : (i', k') = (i, k),
       { simp only [prod.mk.inj_iff] at h1, simp [h1] },
@@ -89,6 +91,6 @@ by simp [finsupp_tensor_finsupp']
 @[simp] lemma finsupp_tensor_finsupp'_single_tmul_single (a : α) (b : β) (r₁ r₂ : S) :
   finsupp_tensor_finsupp' S α β (finsupp.single a r₁ ⊗ₜ[S] finsupp.single b r₂) =
     finsupp.single (a, b) (r₁ * r₂) :=
-by { ext ⟨a', b'⟩, simp [finsupp.single, ite_and] }
+by { ext ⟨a', b'⟩, simp [finsupp.single_apply, ite_and] }
 
 end tensor_product
diff --git a/src/linear_algebra/direct_sum/tensor_product.lean b/src/linear_algebra/direct_sum/tensor_product.lean
index 384cd8fc38511..174207abfb52c 100644
--- a/src/linear_algebra/direct_sum/tensor_product.lean
+++ b/src/linear_algebra/direct_sum/tensor_product.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kenny Lau, Mario Carneiro
+Authors: Kenny Lau, Mario Carneiro, Eric Wieser
 -/
 
 import linear_algebra.tensor_product
@@ -10,7 +10,16 @@ import algebra.direct_sum.module
 /-!
 # Tensor products of direct sums
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file shows that taking `tensor_product`s commutes with taking `direct_sum`s in both arguments.
+
+## Main results
+
+* `tensor_product.direct_sum`
+* `tensor_product.direct_sum_left`
+* `tensor_product.direct_sum_right`
 -/
 
 section ring
@@ -23,15 +32,16 @@ open linear_map
 local attribute [ext] tensor_product.ext
 
 variables (R : Type*) [comm_ring R]
-variables (ι₁ : Type*) (ι₂ : Type*)
+variables {ι₁ : Type*} {ι₂ : Type*}
 variables [decidable_eq ι₁] [decidable_eq ι₂]
-variables (M₁ : ι₁ → Type*) (M₂ : ι₂ → Type*)
-variables [Π i₁, add_comm_group (M₁ i₁)] [Π i₂, add_comm_group (M₂ i₂)]
-variables [Π i₁, module R (M₁ i₁)] [Π i₂, module R (M₂ i₂)]
+variables (M₁ : ι₁ → Type*) (M₁' : Type*) (M₂ : ι₂ → Type*) (M₂' : Type*)
+variables [Π i₁, add_comm_group (M₁ i₁)] [add_comm_group M₁']
+variables [Π i₂, add_comm_group (M₂ i₂)] [add_comm_group M₂']
+variables [Π i₁, module R (M₁ i₁)] [module R M₁'] [Π i₂, module R (M₂ i₂)] [module R M₂']
 
 /-- The linear equivalence `(⨁ i₁, M₁ i₁) ⊗ (⨁ i₂, M₂ i₂) ≃ (⨁ i₁, ⨁ i₂, M₁ i₁ ⊗ M₂ i₂)`, i.e.
 "tensor product distributes over direct sum". -/
-def direct_sum :
+protected def direct_sum :
   (⨁ i₁, M₁ i₁) ⊗[R] (⨁ i₂, M₂ i₂) ≃ₗ[R] (⨁ (i : ι₁ × ι₂), M₁ i.1 ⊗[R] M₂ i.2) :=
 begin
   refine linear_equiv.of_linear
@@ -44,10 +54,62 @@ begin
     rw curry_apply },
 end
 
+/-- Tensor products distribute over a direct sum on the left . -/
+def direct_sum_left : (⨁ i₁, M₁ i₁) ⊗[R] M₂' ≃ₗ[R] (⨁ i, M₁ i ⊗[R] M₂') :=
+linear_equiv.of_linear
+  (lift $ direct_sum.to_module R _ _ $ λ i, (mk R _ _).compr₂ $
+    (direct_sum.lof R ι₁ (λ i, M₁ i ⊗[R] M₂') _))
+  (direct_sum.to_module R _ _ $ λ i, rtensor _ (direct_sum.lof R ι₁ _ _))
+  (direct_sum.linear_map_ext R $ λ i, tensor_product.ext $ linear_map.ext₂ $ λ m₁ m₂, begin
+    dsimp only [comp_apply, compr₂_apply, id_apply, mk_apply],
+    simp_rw [direct_sum.to_module_lof, rtensor_tmul, lift.tmul, direct_sum.to_module_lof,
+      compr₂_apply, mk_apply],
+  end)
+  (tensor_product.ext $ direct_sum.linear_map_ext R $ λ i, linear_map.ext₂ $ λ m₁ m₂, begin
+    dsimp only [comp_apply, compr₂_apply, id_apply, mk_apply],
+    simp_rw [direct_sum.to_module_lof, lift.tmul, direct_sum.to_module_lof, compr₂_apply, mk_apply,
+      direct_sum.to_module_lof, rtensor_tmul],
+  end)
+
+/-- Tensor products distribute over a direct sum on the right. -/
+def direct_sum_right : M₁' ⊗[R] (⨁ i, M₂ i) ≃ₗ[R] (⨁ i, M₁' ⊗[R] M₂ i) :=
+(tensor_product.comm R _ _) ≪≫ₗ (direct_sum_left R M₂ M₁') ≪≫ₗ
+  (dfinsupp.map_range.linear_equiv $ λ i, (tensor_product.comm R _ _))
+
+variables {M₁ M₁' M₂ M₂'}
+
 @[simp] theorem direct_sum_lof_tmul_lof (i₁ : ι₁) (m₁ : M₁ i₁) (i₂ : ι₂) (m₂ : M₂ i₂) :
-  direct_sum R ι₁ ι₂ M₁ M₂ (direct_sum.lof R ι₁ M₁ i₁ m₁ ⊗ₜ direct_sum.lof R ι₂ M₂ i₂ m₂) =
-  direct_sum.lof R (ι₁ × ι₂) (λ i, M₁ i.1 ⊗[R] M₂ i.2) (i₁, i₂) (m₁ ⊗ₜ m₂) :=
-by simp [direct_sum]
+  tensor_product.direct_sum R M₁ M₂ (direct_sum.lof R ι₁ M₁ i₁ m₁ ⊗ₜ direct_sum.lof R ι₂ M₂ i₂ m₂) =
+    direct_sum.lof R (ι₁ × ι₂) (λ i, M₁ i.1 ⊗[R] M₂ i.2) (i₁, i₂) (m₁ ⊗ₜ m₂) :=
+by simp [tensor_product.direct_sum]
+
+@[simp] lemma direct_sum_left_tmul_lof (i : ι₁) (x : M₁ i) (y : M₂') :
+  direct_sum_left R M₁ M₂' (direct_sum.lof R _ _ i x ⊗ₜ[R] y)
+    = direct_sum.lof R _ _ i (x ⊗ₜ[R] y) :=
+begin
+  dsimp only [direct_sum_left, linear_equiv.of_linear_apply, lift.tmul],
+  rw direct_sum.to_module_lof R i,
+  refl,
+end
+
+@[simp] lemma direct_sum_left_symm_lof_tmul (i : ι₁) (x : M₁ i) (y : M₂') :
+  (direct_sum_left R M₁ M₂').symm (direct_sum.lof R _ _ i (x ⊗ₜ[R] y))
+    = direct_sum.lof R _ _ i x ⊗ₜ[R] y :=
+by rw [linear_equiv.symm_apply_eq, direct_sum_left_tmul_lof]
+
+@[simp] lemma direct_sum_right_tmul_lof (x : M₁') (i : ι₂) (y : M₂ i) :
+  direct_sum_right R M₁' M₂ (x ⊗ₜ[R] direct_sum.lof R _ _ i y)
+    = direct_sum.lof R _ _ i (x ⊗ₜ[R] y) :=
+begin
+  dsimp only [direct_sum_right, linear_equiv.trans_apply, tensor_product.comm_tmul],
+  rw direct_sum_left_tmul_lof,
+  exact dfinsupp.map_range_single,
+end
+
+@[simp] lemma direct_sum_right_symm_lof_tmul (x : M₁') (i : ι₂) (y : M₂ i):
+  (direct_sum_right R M₁' M₂).symm (direct_sum.lof R _ _ i (x ⊗ₜ[R] y))
+    = x ⊗ₜ[R] direct_sum.lof R _ _ i y :=
+by rw [linear_equiv.symm_apply_eq, direct_sum_right_tmul_lof]
 
 end tensor_product
 
diff --git a/src/linear_algebra/dual.lean b/src/linear_algebra/dual.lean
index 5ec63c6bb7c54..fc9421636e75a 100644
--- a/src/linear_algebra/dual.lean
+++ b/src/linear_algebra/dual.lean
@@ -1,38 +1,88 @@
 /-
 Copyright (c) 2019 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin, Fabian Glöckle
+Authors: Johan Commelin, Fabian Glöckle, Kyle Miller
 -/
 import linear_algebra.finite_dimensional
 import linear_algebra.projection
 import linear_algebra.sesquilinear_form
 import ring_theory.finiteness
-import linear_algebra.free_module.finite.rank
+import linear_algebra.free_module.finite.basic
 
 /-!
 # Dual vector spaces
 
-The dual space of an R-module M is the R-module of linear maps `M → R`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The dual space of an $R$-module $M$ is the $R$-module of $R$-linear maps $M \to R$.
 
 ## Main definitions
 
-* `dual R M` defines the dual space of M over R.
-* Given a basis for an `R`-module `M`, `basis.to_dual` produces a map from `M` to `dual R M`.
-* Given families of vectors `e` and `ε`, `dual_pair e ε` states that these families have the
-  characteristic properties of a basis and a dual.
-* `dual_annihilator W` is the submodule of `dual R M` where every element annihilates `W`.
+* Duals and transposes:
+  * `module.dual R M` defines the dual space of the `R`-module `M`, as `M →ₗ[R] R`.
+  * `module.dual_pairing R M` is the canonical pairing between `dual R M` and `M`.
+  * `module.dual.eval R M : M →ₗ[R] dual R (dual R)` is the canonical map to the double dual.
+  * `module.dual.transpose` is the linear map from `M →ₗ[R] M'` to `dual R M' →ₗ[R] dual R M`.
+  * `linear_map.dual_map` is `module.dual.transpose` of a given linear map, for dot notation.
+  * `linear_equiv.dual_map` is for the dual of an equivalence.
+* Bases:
+  * `basis.to_dual` produces the map `M →ₗ[R] dual R M` associated to a basis for an `R`-module `M`.
+  * `basis.to_dual_equiv` is the equivalence `M ≃ₗ[R] dual R M` associated to a finite basis.
+  * `basis.dual_basis` is a basis for `dual R M` given a finite basis for `M`.
+  * `module.dual_bases e ε` is the proposition that the families `e` of vectors and `ε` of dual
+    vectors have the characteristic properties of a basis and a dual.
+* Submodules:
+  * `submodule.dual_restrict W` is the transpose `dual R M →ₗ[R] dual R W` of the inclusion map.
+  * `submodule.dual_annihilator W` is the kernel of `W.dual_restrict`. That is, it is the submodule
+    of `dual R M` whose elements all annihilate `W`.
+  * `submodule.dual_restrict_comap W'` is the dual annihilator of `W' : submodule R (dual R M)`,
+    pulled back along `module.dual.eval R M`.
+  * `submodule.dual_copairing W` is the canonical pairing between `W.dual_annihilator` and `M ⧸ W`.
+    It is nondegenerate for vector spaces (`subspace.dual_copairing_nondegenerate`).
+  * `submodule.dual_pairing W` is the canonical pairing between `dual R M ⧸ W.dual_annihilator`
+    and `W`. It is nondegenerate for vector spaces (`subspace.dual_pairing_nondegenerate`).
+* Vector spaces:
+  * `subspace.dual_lift W` is an arbitrary section (using choice) of `submodule.dual_restrict W`.
 
 ## Main results
 
-* `to_dual_equiv` : the linear equivalence between the dual module and primal module,
-  given a finite basis.
-* `dual_pair.basis` and `dual_pair.eq_dual`: if `e` and `ε` form a dual pair, `e` is a basis and
-  `ε` is its dual basis.
-* `quot_equiv_annihilator`: the quotient by a subspace is isomorphic to its dual annihilator.
-
-## Notation
-
-We sometimes use `V'` as local notation for `dual K V`.
+* Bases:
+  * `module.dual_basis.basis` and `module.dual_basis.coe_basis`: if `e` and `ε` form a dual pair,
+    then `e` is a basis.
+  * `module.dual_basis.coe_dual_basis`: if `e` and `ε` form a dual pair,
+    then `ε` is a basis.
+* Annihilators:
+  * `module.dual_annihilator_gc R M` is the antitone Galois correspondence between
+    `submodule.dual_annihilator` and `submodule.dual_coannihilator`.
+  * `linear_map.ker_dual_map_eq_dual_annihilator_range` says that
+    `f.dual_map.ker = f.range.dual_annihilator`
+  * `linear_map.range_dual_map_eq_dual_annihilator_ker_of_subtype_range_surjective` says that
+    `f.dual_map.range = f.ker.dual_annihilator`; this is specialized to vector spaces in
+    `linear_map.range_dual_map_eq_dual_annihilator_ker`.
+  * `submodule.dual_quot_equiv_dual_annihilator` is the equivalence
+    `dual R (M ⧸ W) ≃ₗ[R] W.dual_annihilator`
+* Vector spaces:
+  * `subspace.dual_annihilator_dual_coannihilator_eq` says that the double dual annihilator,
+    pulled back ground `module.dual.eval`, is the original submodule.
+  * `subspace.dual_annihilator_gci` says that `module.dual_annihilator_gc R M` is an
+    antitone Galois coinsertion.
+  * `subspace.quot_annihilator_equiv` is the equivalence
+    `dual K V ⧸ W.dual_annihilator ≃ₗ[K] dual K W`.
+  * `linear_map.dual_pairing_nondegenerate` says that `module.dual_pairing` is nondegenerate.
+  * `subspace.is_compl_dual_annihilator` says that the dual annihilator carries complementary
+    subspaces to complementary subspaces.
+* Finite-dimensional vector spaces:
+  * `module.eval_equiv` is the equivalence `V ≃ₗ[K] dual K (dual K V)`
+  * `module.map_eval_equiv` is the order isomorphism between subspaces of `V` and
+    subspaces of `dual K (dual K V)`.
+  * `subspace.quot_dual_equiv_annihilator W` is the equivalence
+    `(dual K V ⧸ W.dual_lift.range) ≃ₗ[K] W.dual_annihilator`, where `W.dual_lift.range` is a copy
+    of `dual K W` inside `dual K V`.
+  * `subspace.quot_equiv_annihilator W` is the equivalence `(V ⧸ W) ≃ₗ[K] W.dual_annihilator`
+  * `subspace.dual_quot_distrib W` is an equivalence
+    `dual K (V₁ ⧸ W) ≃ₗ[K] dual K V₁ ⧸ W.dual_lift.range` from an arbitrary choice of
+    splitting of `V₁`.
 
 ## TODO
 
@@ -47,13 +97,7 @@ variables (R : Type*) (M : Type*)
 variables [comm_semiring R] [add_comm_monoid M] [module R M]
 
 /-- The dual space of an R-module M is the R-module of linear maps `M → R`. -/
-@[derive [add_comm_monoid, module R]] def dual := M →ₗ[R] R
-
-instance {S : Type*} [comm_ring S] {N : Type*} [add_comm_group N] [module S N] :
-  add_comm_group (dual S N) := linear_map.add_comm_group
-
-instance : add_monoid_hom_class (dual R M) M R :=
-linear_map.add_monoid_hom_class
+@[reducible] def dual := M →ₗ[R] R
 
 /-- The canonical pairing of a vector space and its algebraic dual. -/
 def dual_pairing (R M) [comm_semiring R] [add_comm_monoid M] [module R M] :
@@ -71,11 +115,7 @@ instance : has_coe_to_fun (dual R M) (λ _, M → R) := ⟨linear_map.to_fun⟩
 `module.eval_equiv`. -/
 def eval : M →ₗ[R] (dual R (dual R M)) := linear_map.flip linear_map.id
 
-@[simp] lemma eval_apply (v : M) (a : dual R M) : eval R M v a = a v :=
-begin
-  dunfold eval,
-  rw [linear_map.flip_apply, linear_map.id_apply]
-end
+@[simp] lemma eval_apply (v : M) (a : dual R M) : eval R M v a = a v := rfl
 
 variables {R M} {M' : Type*} [add_comm_monoid M'] [module R M']
 
@@ -93,8 +133,93 @@ lemma transpose_comp (u : M' →ₗ[R] M'') (v : M →ₗ[R] M') :
 
 end dual
 
+section prod
+variables (M' : Type*) [add_comm_monoid M'] [module R M']
+
+/-- Taking duals distributes over products. -/
+@[simps] def dual_prod_dual_equiv_dual :
+  (module.dual R M × module.dual R M') ≃ₗ[R] module.dual R (M × M') :=
+linear_map.coprod_equiv R
+
+@[simp] lemma dual_prod_dual_equiv_dual_apply (φ : module.dual R M) (ψ : module.dual R M') :
+  dual_prod_dual_equiv_dual R M M' (φ, ψ) = φ.coprod ψ := rfl
+
+end prod
+
 end module
 
+section dual_map
+open module
+
+variables {R : Type*} [comm_semiring R] {M₁ : Type*} {M₂ : Type*}
+variables [add_comm_monoid M₁] [module R M₁] [add_comm_monoid M₂] [module R M₂]
+
+/-- Given a linear map `f : M₁ →ₗ[R] M₂`, `f.dual_map` is the linear map between the dual of
+`M₂` and `M₁` such that it maps the functional `φ` to `φ ∘ f`. -/
+def linear_map.dual_map (f : M₁ →ₗ[R] M₂) : dual R M₂ →ₗ[R] dual R M₁ :=
+module.dual.transpose f
+
+lemma linear_map.dual_map_def (f : M₁ →ₗ[R] M₂) : f.dual_map = module.dual.transpose f := rfl
+
+lemma linear_map.dual_map_apply' (f : M₁ →ₗ[R] M₂) (g : dual R M₂) :
+  f.dual_map g = g.comp f := rfl
+
+@[simp] lemma linear_map.dual_map_apply (f : M₁ →ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
+  f.dual_map g x = g (f x) := rfl
+
+@[simp] lemma linear_map.dual_map_id :
+  (linear_map.id : M₁ →ₗ[R] M₁).dual_map = linear_map.id :=
+by { ext, refl }
+
+lemma linear_map.dual_map_comp_dual_map {M₃ : Type*} [add_comm_group M₃] [module R M₃]
+  (f : M₁ →ₗ[R] M₂) (g : M₂ →ₗ[R] M₃) :
+  f.dual_map.comp g.dual_map = (g.comp f).dual_map :=
+rfl
+
+/-- If a linear map is surjective, then its dual is injective. -/
+lemma linear_map.dual_map_injective_of_surjective {f : M₁ →ₗ[R] M₂} (hf : function.surjective f) :
+  function.injective f.dual_map :=
+begin
+  intros φ ψ h,
+  ext x,
+  obtain ⟨y, rfl⟩ := hf x,
+  exact congr_arg (λ (g : module.dual R M₁), g y) h,
+end
+
+/-- The `linear_equiv` version of `linear_map.dual_map`. -/
+def linear_equiv.dual_map (f : M₁ ≃ₗ[R] M₂) : dual R M₂ ≃ₗ[R] dual R M₁ :=
+{ inv_fun := f.symm.to_linear_map.dual_map,
+  left_inv :=
+    begin
+      intro φ, ext x,
+      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
+                 linear_map.to_fun_eq_coe, linear_equiv.apply_symm_apply]
+    end,
+  right_inv :=
+    begin
+      intro φ, ext x,
+      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
+                 linear_map.to_fun_eq_coe, linear_equiv.symm_apply_apply]
+    end,
+  .. f.to_linear_map.dual_map }
+
+@[simp] lemma linear_equiv.dual_map_apply (f : M₁ ≃ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
+  f.dual_map g x = g (f x) := rfl
+
+@[simp] lemma linear_equiv.dual_map_refl :
+  (linear_equiv.refl R M₁).dual_map = linear_equiv.refl R (dual R M₁) :=
+by { ext, refl }
+
+@[simp] lemma linear_equiv.dual_map_symm {f : M₁ ≃ₗ[R] M₂} :
+  (linear_equiv.dual_map f).symm = linear_equiv.dual_map f.symm := rfl
+
+lemma linear_equiv.dual_map_trans {M₃ : Type*} [add_comm_group M₃] [module R M₃]
+  (f : M₁ ≃ₗ[R] M₂) (g : M₂ ≃ₗ[R] M₃) :
+  g.dual_map.trans f.dual_map = (f.trans g).dual_map :=
+rfl
+
+end dual_map
+
 namespace basis
 
 universes u v w
@@ -171,19 +296,15 @@ end
 theorem to_dual_ker : b.to_dual.ker = ⊥ :=
 ker_eq_bot'.mpr b.to_dual_inj
 
-theorem to_dual_range [fin : fintype ι] : b.to_dual.range = ⊤ :=
+theorem to_dual_range [_root_.finite ι] : b.to_dual.range = ⊤ :=
 begin
-  rw eq_top_iff',
-  intro f,
+  casesI nonempty_fintype ι,
+  refine eq_top_iff'.2 (λ f, _),
   rw linear_map.mem_range,
-  let lin_comb : ι →₀ R := finsupp.on_finset fin.elems (λ i, f.to_fun (b i)) _,
-  { use finsupp.total ι M R b lin_comb,
-    apply b.ext,
-    { intros i,
-      rw [b.to_dual_eq_repr _ i, repr_total b],
-      { refl } } },
-  { intros a _,
-    apply fin.complete }
+  let lin_comb : ι →₀ R := finsupp.equiv_fun_on_finite.symm (λ i, f.to_fun (b i)),
+  refine ⟨finsupp.total ι M R b lin_comb, b.ext $ λ i, _⟩,
+  rw [b.to_dual_eq_repr _ i, repr_total b],
+  refl,
 end
 
 end comm_semiring
@@ -207,53 +328,54 @@ section comm_ring
 variables [comm_ring R] [add_comm_group M] [module R M] [decidable_eq ι]
 variables (b : basis ι R M)
 
+section finite
+variables [_root_.finite ι]
+
 /-- A vector space is linearly equivalent to its dual space. -/
-@[simps]
-def to_dual_equiv [fintype ι] : M ≃ₗ[R] (dual R M) :=
+def to_dual_equiv : M ≃ₗ[R] dual R M :=
 linear_equiv.of_bijective b.to_dual
-  (ker_eq_bot.mp b.to_dual_ker) (range_eq_top.mp b.to_dual_range)
+  ⟨ker_eq_bot.mp b.to_dual_ker, range_eq_top.mp b.to_dual_range⟩
+
+-- `simps` times out when generating this
+@[simp] lemma to_dual_equiv_apply (m : M) : b.to_dual_equiv m = b.to_dual m := rfl
 
 /-- Maps a basis for `V` to a basis for the dual space. -/
-def dual_basis [fintype ι] : basis ι R (dual R M) :=
-b.map b.to_dual_equiv
+def dual_basis : basis ι R (dual R M) := b.map b.to_dual_equiv
 
 -- We use `j = i` to match `basis.repr_self`
-lemma dual_basis_apply_self [fintype ι] (i j : ι) :
-  b.dual_basis i (b j) = if j = i then 1 else 0 :=
+lemma dual_basis_apply_self (i j : ι) : b.dual_basis i (b j) = if j = i then 1 else 0 :=
 by { convert b.to_dual_apply i j using 2, rw @eq_comm _ j i }
 
-lemma total_dual_basis [fintype ι] (f : ι →₀ R) (i : ι) :
+lemma total_dual_basis (f : ι →₀ R) (i : ι) :
   finsupp.total ι (dual R M) R b.dual_basis f (b i) = f i :=
 begin
+  casesI nonempty_fintype ι,
   rw [finsupp.total_apply, finsupp.sum_fintype, linear_map.sum_apply],
   { simp_rw [linear_map.smul_apply, smul_eq_mul, dual_basis_apply_self, mul_boole,
       finset.sum_ite_eq, if_pos (finset.mem_univ i)] },
   { intro, rw zero_smul },
 end
 
-lemma dual_basis_repr [fintype ι] (l : dual R M) (i : ι) :
-  b.dual_basis.repr l i = l (b i) :=
+lemma dual_basis_repr (l : dual R M) (i : ι) : b.dual_basis.repr l i = l (b i) :=
 by rw [← total_dual_basis b, basis.total_repr b.dual_basis l]
 
-lemma dual_basis_equiv_fun [fintype ι] (l : dual R M) (i : ι) :
-  b.dual_basis.equiv_fun l i = l (b i) :=
-by rw [basis.equiv_fun_apply, dual_basis_repr]
+lemma dual_basis_apply (i : ι) (m : M) : b.dual_basis i m = b.repr m i := b.to_dual_apply_right i m
 
-lemma dual_basis_apply [fintype ι] (i : ι) (m : M) : b.dual_basis i m = b.repr m i :=
-b.to_dual_apply_right i m
+@[simp] lemma coe_dual_basis : ⇑b.dual_basis = b.coord := by { ext i x, apply dual_basis_apply }
 
-@[simp] lemma coe_dual_basis [fintype ι] :
-  ⇑b.dual_basis = b.coord :=
-by { ext i x, apply dual_basis_apply }
-
-@[simp] lemma to_dual_to_dual [fintype ι] :
-  b.dual_basis.to_dual.comp b.to_dual = dual.eval R M :=
+@[simp] lemma to_dual_to_dual : b.dual_basis.to_dual.comp b.to_dual = dual.eval R M :=
 begin
   refine b.ext (λ i, b.dual_basis.ext (λ j, _)),
   rw [linear_map.comp_apply, to_dual_apply_left, coe_to_dual_self, ← coe_dual_basis,
       dual.eval_apply, basis.repr_self, finsupp.single_apply, dual_basis_apply_self]
 end
 
+end finite
+
+lemma dual_basis_equiv_fun [fintype ι] (l : dual R M) (i : ι) :
+  b.dual_basis.equiv_fun l i = l (b i) :=
+by rw [basis.equiv_fun_apply, dual_basis_repr]
+
 theorem eval_ker {ι : Type*} (b : basis ι R M) :
   (dual.eval R M).ker = ⊥ :=
 begin
@@ -263,20 +385,20 @@ begin
   exact (basis.forall_coord_eq_zero_iff _).mp (λ i, hm (b.coord i))
 end
 
-lemma eval_range {ι : Type*} [fintype ι] (b : basis ι R M) :
-  (eval R M).range = ⊤ :=
+lemma eval_range {ι : Type*} [_root_.finite ι] (b : basis ι R M) : (eval R M).range = ⊤ :=
 begin
   classical,
-  rw [← b.to_dual_to_dual, range_comp, b.to_dual_range, map_top, to_dual_range _],
+  casesI nonempty_fintype ι,
+  rw [← b.to_dual_to_dual, range_comp, b.to_dual_range, submodule.map_top, to_dual_range _],
   apply_instance
 end
 
 /-- A module with a basis is linearly equivalent to the dual of its dual space. -/
-def eval_equiv  {ι : Type*} [fintype ι] (b : basis ι R M) : M ≃ₗ[R] dual R (dual R M) :=
+def eval_equiv  {ι : Type*} [_root_.finite ι] (b : basis ι R M) : M ≃ₗ[R] dual R (dual R M) :=
 linear_equiv.of_bijective (eval R M)
-  (ker_eq_bot.mp b.eval_ker) (range_eq_top.mp b.eval_range)
+  ⟨ker_eq_bot.mp b.eval_ker, range_eq_top.mp b.eval_range⟩
 
-@[simp] lemma eval_equiv_to_linear_map {ι : Type*} [fintype ι] (b : basis ι R M) :
+@[simp] lemma eval_equiv_to_linear_map {ι : Type*} [_root_.finite ι] (b : basis ι R M) :
   (b.eval_equiv).to_linear_map = dual.eval R M := rfl
 
 section
@@ -294,17 +416,18 @@ end
 end comm_ring
 
 /-- `simp` normal form version of `total_dual_basis` -/
-@[simp] lemma total_coord [comm_ring R] [add_comm_group M] [module R M] [fintype ι]
+@[simp] lemma total_coord [comm_ring R] [add_comm_group M] [module R M] [_root_.finite ι]
   (b : basis ι R M) (f : ι →₀ R) (i : ι) :
   finsupp.total ι (dual R M) R b.coord f (b i) = f i :=
 by { haveI := classical.dec_eq ι, rw [← coe_dual_basis, total_dual_basis] }
 
--- TODO(jmc): generalize to rings, once `module.rank` is generalized
-theorem dual_dim_eq [field K] [add_comm_group V] [module K V] [fintype ι] (b : basis ι K V) :
+lemma dual_rank_eq [comm_ring K] [add_comm_group V] [module K V] [_root_.finite ι]
+  (b : basis ι K V) :
   cardinal.lift (module.rank K V) = module.rank K (dual K V) :=
 begin
   classical,
-  have := linear_equiv.lift_dim_eq b.to_dual_equiv,
+  casesI nonempty_fintype ι,
+  have := linear_equiv.lift_rank_eq b.to_dual_equiv,
   simp only [cardinal.lift_umax] at this,
   rw [this, ← cardinal.lift_umax],
   apply cardinal.lift_id,
@@ -318,13 +441,46 @@ variables {K V : Type*}
 variables [field K] [add_comm_group V] [module K V]
 open module module.dual submodule linear_map cardinal basis finite_dimensional
 
+section
+variables (K) (V)
+
 theorem eval_ker : (eval K V).ker = ⊥ :=
 by { classical, exact (basis.of_vector_space K V).eval_ker }
 
+theorem map_eval_injective : (submodule.map (eval K V)).injective :=
+begin
+  apply submodule.map_injective_of_injective,
+  rw ← linear_map.ker_eq_bot,
+  apply eval_ker K V, -- elaborates faster than `exact`
+end
+
+theorem comap_eval_surjective : (submodule.comap (eval K V)).surjective :=
+begin
+  apply submodule.comap_surjective_of_injective,
+  rw ← linear_map.ker_eq_bot,
+  apply eval_ker K V, -- elaborates faster than `exact`
+end
+
+end
+
+section
+variable (K)
+
+theorem eval_apply_eq_zero_iff (v : V) : (eval K V) v = 0 ↔ v = 0 :=
+by simpa only using set_like.ext_iff.mp (eval_ker K V) v
+
+theorem eval_apply_injective : function.injective (eval K V) :=
+(injective_iff_map_eq_zero' (eval K V)).mpr (eval_apply_eq_zero_iff K)
+
+theorem forall_dual_apply_eq_zero_iff (v : V) : (∀ (φ : module.dual K V), φ v = 0) ↔ v = 0 :=
+by { rw [← eval_apply_eq_zero_iff K v, linear_map.ext_iff], refl }
+
+end
+
 -- TODO(jmc): generalize to rings, once `module.rank` is generalized
-theorem dual_dim_eq [finite_dimensional K V] :
+theorem dual_rank_eq [finite_dimensional K V] :
   cardinal.lift (module.rank K V) = module.rank K (dual K V) :=
-(basis.of_vector_space K V).dual_dim_eq
+(basis.of_vector_space K V).dual_rank_eq
 
 lemma erange_coe [finite_dimensional K V] : (eval K V).range = ⊤ :=
 begin
@@ -337,32 +493,49 @@ variables (K V)
 /-- A vector space is linearly equivalent to the dual of its dual space. -/
 def eval_equiv [finite_dimensional K V] : V ≃ₗ[K] dual K (dual K V) :=
 linear_equiv.of_bijective (eval K V)
-  (ker_eq_bot.mp eval_ker) (range_eq_top.mp erange_coe)
+  -- 60x faster elaboration than using `ker_eq_bot.mp eval_ker` directly:
+  ⟨by { rw ← ker_eq_bot, apply eval_ker K V }, range_eq_top.mp erange_coe⟩
+
+/-- The isomorphism `module.eval_equiv` induces an order isomorphism on subspaces. -/
+def map_eval_equiv [finite_dimensional K V] : subspace K V ≃o subspace K (dual K (dual K V)) :=
+submodule.order_iso_map_comap (eval_equiv K V)
 
 variables {K V}
 
 @[simp] lemma eval_equiv_to_linear_map [finite_dimensional K V] :
   (eval_equiv K V).to_linear_map = dual.eval K V := rfl
 
+@[simp] lemma map_eval_equiv_apply [finite_dimensional K V] (W : subspace K V) :
+  map_eval_equiv K V W = W.map (eval K V) := rfl
+
+@[simp] lemma map_eval_equiv_symm_apply [finite_dimensional K V]
+  (W'' : subspace K (dual K (dual K V))) :
+  (map_eval_equiv K V).symm W'' = W''.comap (eval K V) := rfl
+
 end module
 
-section dual_pair
+section dual_bases
 
 open module
 
 variables {R M ι : Type*}
-variables [comm_ring R] [add_comm_group M] [module R M] [decidable_eq ι]
+variables [comm_semiring R] [add_comm_monoid M] [module R M] [decidable_eq ι]
+
+/-- Try using `set.to_finite` to dispatch a `set.finite` goal. -/
+-- TODO: In Lean 4 we can remove this and use `by { intros; exact Set.toFinite _ }` as a default
+-- argument.
+meta def use_finite_instance : tactic unit := `[intros, exact set.to_finite _]
 
 /-- `e` and `ε` have characteristic properties of a basis and its dual -/
-@[nolint has_inhabited_instance]
-structure dual_pair (e : ι → M) (ε : ι → (dual R M)) :=
+@[nolint has_nonempty_instance]
+structure module.dual_bases (e : ι → M) (ε : ι → (dual R M)) : Prop :=
 (eval : ∀ i j : ι, ε i (e j) = if i = j then 1 else 0)
 (total : ∀ {m : M}, (∀ i, ε i m = 0) → m = 0)
-[finite : ∀ m : M, fintype {i | ε i m ≠ 0}]
+(finite : ∀ m : M, {i | ε i m ≠ 0}.finite . use_finite_instance)
 
-end dual_pair
+end dual_bases
 
-namespace dual_pair
+namespace module.dual_bases
 
 open module module.dual linear_map function
 
@@ -371,12 +544,12 @@ variables [comm_ring R] [add_comm_group M] [module R M]
 variables {e : ι → M} {ε : ι → dual R M}
 
 /-- The coefficients of `v` on the basis `e` -/
-def coeffs [decidable_eq ι] (h : dual_pair e ε) (m : M) : ι →₀ R :=
+def coeffs [decidable_eq ι] (h : dual_bases e ε) (m : M) : ι →₀ R :=
 { to_fun := λ i, ε i m,
-  support := by { haveI := h.finite m, exact {i : ι | ε i m ≠ 0}.to_finset },
-  mem_support_to_fun := by {intro i, rw set.mem_to_finset, exact iff.rfl } }
+  support := (h.finite m).to_finset,
+  mem_support_to_fun := by { intro i, rw [set.finite.mem_to_finset, set.mem_set_of_eq] } }
 
-@[simp] lemma coeffs_apply [decidable_eq ι] (h : dual_pair e ε) (m : M) (i : ι) :
+@[simp] lemma coeffs_apply [decidable_eq ι] (h : dual_bases e ε) (m : M) (i : ι) :
   h.coeffs m i = ε i m := rfl
 
 /-- linear combinations of elements of `e`.
@@ -385,10 +558,12 @@ def lc {ι} (e : ι → M) (l : ι →₀ R) : M := l.sum (λ (i : ι) (a : R),
 
 lemma lc_def (e : ι → M) (l : ι →₀ R) : lc e l = finsupp.total _ _ _ e l := rfl
 
-variables [decidable_eq ι] (h : dual_pair e ε)
+open module
+
+variables [decidable_eq ι] (h : dual_bases e ε)
 include h
 
-lemma dual_lc (l : ι →₀ R) (i : ι) : ε i (dual_pair.lc e l) = l i :=
+lemma dual_lc (l : ι →₀ R) (i : ι) : ε i (dual_bases.lc e l) = l i :=
 begin
   erw linear_map.map_sum,
   simp only [h.eval, map_smul, smul_eq_mul],
@@ -401,19 +576,19 @@ begin
 end
 
 @[simp]
-lemma coeffs_lc (l : ι →₀ R) : h.coeffs (dual_pair.lc e l) = l :=
+lemma coeffs_lc (l : ι →₀ R) : h.coeffs (dual_bases.lc e l) = l :=
 by { ext i, rw [h.coeffs_apply, h.dual_lc] }
 
 /-- For any m : M n, \sum_{p ∈ Q n} (ε p m) • e p = m -/
 @[simp]
-lemma lc_coeffs (m : M) : dual_pair.lc e (h.coeffs m) = m :=
+lemma lc_coeffs (m : M) : dual_bases.lc e (h.coeffs m) = m :=
 begin
   refine eq_of_sub_eq_zero (h.total _),
   intros i,
   simp [-sub_eq_add_neg, linear_map.map_sub, h.dual_lc, sub_eq_zero]
 end
 
-/-- `(h : dual_pair e ε).basis` shows the family of vectors `e` forms a basis. -/
+/-- `(h : dual_bases e ε).basis` shows the family of vectors `e` forms a basis. -/
 @[simps]
 def basis : basis ι R M :=
 basis.of_repr
@@ -442,13 +617,13 @@ lemma coe_dual_basis [fintype ι] : ⇑h.basis.dual_basis = ε :=
 funext (λ i, h.basis.ext (λ j, by rw [h.basis.dual_basis_apply_self, h.coe_basis, h.eval,
                                       if_congr eq_comm rfl rfl]))
 
-end dual_pair
+end module.dual_bases
 
 namespace submodule
 
 universes u v w
 
-variables {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M]
+variables {R : Type u} {M : Type v} [comm_semiring R] [add_comm_monoid M] [module R M]
 variable {W : submodule R M}
 
 /-- The `dual_restrict` of a submodule `W` of `M` is the linear map from the
@@ -458,13 +633,15 @@ def dual_restrict (W : submodule R M) :
   module.dual R M →ₗ[R] module.dual R W :=
 linear_map.dom_restrict' W
 
+lemma dual_restrict_def (W : submodule R M) : W.dual_restrict = W.subtype.dual_map := rfl
+
 @[simp] lemma dual_restrict_apply
   (W : submodule R M) (φ : module.dual R M) (x : W) :
   W.dual_restrict φ x = φ (x : M) := rfl
 
 /-- The `dual_annihilator` of a submodule `W` is the set of linear maps `φ` such
   that `φ w = 0` for all `w ∈ W`. -/
-def dual_annihilator {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M]
+def dual_annihilator {R : Type u} {M : Type v} [comm_semiring R] [add_comm_monoid M]
   [module R M] (W : submodule R M) : submodule R $ module.dual R M :=
 W.dual_restrict.ker
 
@@ -476,32 +653,116 @@ begin
   exact ⟨λ h w hw, h ⟨w, hw⟩, λ h w, h w.1 w.2⟩
 end
 
+/-- That $\operatorname{ker}(\iota^* : V^* \to W^*) = \operatorname{ann}(W)$.
+This is the definition of the dual annihilator of the submodule $W$. -/
 lemma dual_restrict_ker_eq_dual_annihilator (W : submodule R M) :
   W.dual_restrict.ker = W.dual_annihilator :=
 rfl
 
-lemma dual_annihilator_sup_eq_inf_dual_annihilator (U V : submodule R M) :
+/-- The `dual_annihilator` of a submodule of the dual space pulled back along the evaluation map
+`module.dual.eval`. -/
+def dual_coannihilator (Φ : submodule R (module.dual R M)) : submodule R M :=
+Φ.dual_annihilator.comap (module.dual.eval R M)
+
+lemma mem_dual_coannihilator {Φ : submodule R (module.dual R M)} (x : M) :
+  x ∈ Φ.dual_coannihilator ↔ ∀ φ ∈ Φ, (φ x : R) = 0 :=
+by simp_rw [dual_coannihilator, mem_comap, mem_dual_annihilator, module.dual.eval_apply]
+
+lemma dual_annihilator_gc (R M : Type*) [comm_semiring R] [add_comm_monoid M] [module R M] :
+  galois_connection
+    (order_dual.to_dual ∘ (dual_annihilator : submodule R M → submodule R (module.dual R M)))
+    (dual_coannihilator ∘ order_dual.of_dual) :=
+begin
+  intros a b,
+  induction b using order_dual.rec,
+  simp only [function.comp_app, order_dual.to_dual_le_to_dual, order_dual.of_dual_to_dual],
+  split;
+  { intros h x hx,
+    simp only [mem_dual_annihilator, mem_dual_coannihilator],
+    intros y hy,
+    have := h hy,
+    simp only [mem_dual_annihilator, mem_dual_coannihilator] at this,
+    exact this x hx },
+end
+
+lemma le_dual_annihilator_iff_le_dual_coannihilator
+  {U : submodule R (module.dual R M)} {V : submodule R M} :
+  U ≤ V.dual_annihilator ↔ V ≤ U.dual_coannihilator :=
+(dual_annihilator_gc R M).le_iff_le
+
+@[simp] lemma dual_annihilator_bot : (⊥ : submodule R M).dual_annihilator = ⊤ :=
+(dual_annihilator_gc R M).l_bot
+
+@[simp] lemma dual_annihilator_top : (⊤ : submodule R M).dual_annihilator = ⊥ :=
+begin
+  rw eq_bot_iff,
+  intro v,
+  simp_rw [mem_dual_annihilator, mem_bot, mem_top, forall_true_left],
+  exact λ h, linear_map.ext h,
+end
+
+@[simp] lemma dual_coannihilator_bot :
+  (⊥ : submodule R (module.dual R M)).dual_coannihilator = ⊤ :=
+(dual_annihilator_gc R M).u_top
+
+@[mono] lemma dual_annihilator_anti {U V : submodule R M} (hUV : U ≤ V) :
+  V.dual_annihilator ≤ U.dual_annihilator :=
+(dual_annihilator_gc R M).monotone_l hUV
+
+@[mono] lemma dual_coannihilator_anti {U V : submodule R (module.dual R M)} (hUV : U ≤ V) :
+  V.dual_coannihilator ≤ U.dual_coannihilator :=
+(dual_annihilator_gc R M).monotone_u hUV
+
+lemma le_dual_annihilator_dual_coannihilator (U : submodule R M) :
+  U ≤ U.dual_annihilator.dual_coannihilator :=
+(dual_annihilator_gc R M).le_u_l U
+
+lemma le_dual_coannihilator_dual_annihilator (U : submodule R (module.dual R M)) :
+  U ≤ U.dual_coannihilator.dual_annihilator :=
+(dual_annihilator_gc R M).l_u_le U
+
+lemma dual_annihilator_dual_coannihilator_dual_annihilator
+  (U : submodule R M) :
+  U.dual_annihilator.dual_coannihilator.dual_annihilator = U.dual_annihilator :=
+(dual_annihilator_gc R M).l_u_l_eq_l U
+
+lemma dual_coannihilator_dual_annihilator_dual_coannihilator
+  (U : submodule R (module.dual R M)) :
+  U.dual_coannihilator.dual_annihilator.dual_coannihilator = U.dual_coannihilator :=
+(dual_annihilator_gc R M).u_l_u_eq_u U
+
+lemma dual_annihilator_sup_eq (U V : submodule R M) :
   (U ⊔ V).dual_annihilator = U.dual_annihilator ⊓ V.dual_annihilator :=
+(dual_annihilator_gc R M).l_sup
+
+lemma dual_coannihilator_sup_eq (U V : submodule R (module.dual R M)) :
+  (U ⊔ V).dual_coannihilator = U.dual_coannihilator ⊓ V.dual_coannihilator :=
+(dual_annihilator_gc R M).u_inf
+
+lemma dual_annihilator_supr_eq {ι : Type*} (U : ι → submodule R M) :
+  (⨆ (i : ι), U i).dual_annihilator = ⨅ (i : ι), (U i).dual_annihilator :=
+(dual_annihilator_gc R M).l_supr
+
+lemma dual_coannihilator_supr_eq {ι : Type*} (U : ι → submodule R (module.dual R M)) :
+  (⨆ (i : ι), U i).dual_coannihilator = ⨅ (i : ι), (U i).dual_coannihilator :=
+(dual_annihilator_gc R M).u_infi
+
+/-- See also `subspace.dual_annihilator_inf_eq` for vector subspaces. -/
+lemma sup_dual_annihilator_le_inf (U V : submodule R M) :
+  U.dual_annihilator ⊔ V.dual_annihilator ≤ (U ⊓ V).dual_annihilator :=
 begin
-  ext φ,
-  rw [mem_inf, mem_dual_annihilator, mem_dual_annihilator, mem_dual_annihilator],
-  split; intro h,
-  { refine ⟨_, _⟩;
-    intros x hx,
-    exact h x (mem_sup.2 ⟨x, hx, 0, zero_mem _, add_zero _⟩),
-    exact h x (mem_sup.2 ⟨0, zero_mem _, x, hx, zero_add _⟩) },
-  { simp_rw mem_sup,
-    rintro _ ⟨x, hx, y, hy, rfl⟩,
-    rw [linear_map.map_add, h.1 _ hx, h.2 _ hy, add_zero] }
-end
-
-/-- The pullback of a submodule in the dual space along the evaluation map. -/
-def dual_annihilator_comap (Φ : submodule R (module.dual R M)) : submodule R M :=
-Φ.dual_annihilator.comap (module.dual.eval R M)
+  rw [le_dual_annihilator_iff_le_dual_coannihilator, dual_coannihilator_sup_eq],
+  apply' inf_le_inf; exact le_dual_annihilator_dual_coannihilator _,
+end
 
-lemma mem_dual_annihilator_comap_iff {Φ : submodule R (module.dual R M)} (x : M) :
-  x ∈ Φ.dual_annihilator_comap ↔ ∀ φ ∈ Φ, (φ x : R) = 0 :=
-by simp_rw [dual_annihilator_comap, mem_comap, mem_dual_annihilator, module.dual.eval_apply]
+/-- See also `subspace.dual_annihilator_infi_eq` for vector subspaces when `ι` is finite. -/
+lemma supr_dual_annihilator_le_infi {ι : Type*} (U : ι → submodule R M) :
+  (⨆ (i : ι), (U i).dual_annihilator) ≤ (⨅ (i : ι), U i).dual_annihilator :=
+begin
+  rw [le_dual_annihilator_iff_le_dual_coannihilator, dual_coannihilator_supr_eq],
+  apply' infi_mono,
+  exact λ (i : ι), le_dual_annihilator_dual_coannihilator (U i),
+end
 
 end submodule
 
@@ -514,9 +775,63 @@ universes u v w
 -- We work in vector spaces because `exists_is_compl` only hold for vector spaces
 variables {K : Type u} {V : Type v} [field K] [add_comm_group V] [module K V]
 
+@[simp] lemma dual_coannihilator_top (W : subspace K V) :
+  (⊤ : subspace K (module.dual K W)).dual_coannihilator = ⊥ :=
+by rw [dual_coannihilator, dual_annihilator_top, comap_bot, module.eval_ker]
+
+lemma dual_annihilator_dual_coannihilator_eq {W : subspace K V} :
+  W.dual_annihilator.dual_coannihilator = W :=
+begin
+  refine le_antisymm _ (le_dual_annihilator_dual_coannihilator _),
+  intro v,
+  simp only [mem_dual_annihilator, mem_dual_coannihilator],
+  contrapose!,
+  intro hv,
+  obtain ⟨W', hW⟩ := submodule.exists_is_compl W,
+  obtain ⟨⟨w, w'⟩, rfl, -⟩ := exists_unique_add_of_is_compl_prod hW v,
+  have hw'n : (w' : V) ∉ W := by { contrapose! hv, exact submodule.add_mem W w.2 hv },
+  have hw'nz : w' ≠ 0 := by { rintro rfl, exact hw'n (submodule.zero_mem W) },
+  rw [ne.def, ← module.forall_dual_apply_eq_zero_iff K w'] at hw'nz,
+  push_neg at hw'nz,
+  obtain ⟨φ, hφ⟩ := hw'nz,
+  existsi ((linear_map.of_is_compl_prod hW).comp (linear_map.inr _ _ _)) φ,
+  simp only [coe_comp, coe_inr, function.comp_app, of_is_compl_prod_apply, map_add,
+    of_is_compl_left_apply, zero_apply, of_is_compl_right_apply, zero_add, ne.def],
+  refine ⟨_, hφ⟩,
+  intros v hv,
+  apply linear_map.of_is_compl_left_apply hW ⟨v, hv⟩, -- exact elaborates slowly
+end
+
+theorem forall_mem_dual_annihilator_apply_eq_zero_iff (W : subspace K V) (v : V) :
+  (∀ (φ : module.dual K V), φ ∈ W.dual_annihilator → φ v = 0) ↔ v ∈ W :=
+by rw [← set_like.ext_iff.mp dual_annihilator_dual_coannihilator_eq v,
+       mem_dual_coannihilator]
+
+/-- `submodule.dual_annihilator` and `submodule.dual_coannihilator` form a Galois coinsertion. -/
+def dual_annihilator_gci (K V : Type*) [field K] [add_comm_group V] [module K V] :
+  galois_coinsertion
+    (order_dual.to_dual ∘ (dual_annihilator : subspace K V → subspace K (module.dual K V)))
+    (dual_coannihilator ∘ order_dual.of_dual) :=
+{ choice := λ W h, dual_coannihilator W,
+  gc := dual_annihilator_gc K V,
+  u_l_le := λ W, dual_annihilator_dual_coannihilator_eq.le,
+  choice_eq := λ W h, rfl }
+
+lemma dual_annihilator_le_dual_annihilator_iff {W W' : subspace K V} :
+  W.dual_annihilator ≤ W'.dual_annihilator ↔ W' ≤ W :=
+(dual_annihilator_gci K V).l_le_l_iff
+
+lemma dual_annihilator_inj {W W' : subspace K V} :
+  W.dual_annihilator = W'.dual_annihilator ↔ W = W' :=
+begin
+  split,
+  { apply (dual_annihilator_gci K V).l_injective },
+  { rintro rfl, refl },
+end
+
 /-- Given a subspace `W` of `V` and an element of its dual `φ`, `dual_lift W φ` is
-the natural extension of `φ` to an element of the dual of `V`.
-That is, `dual_lift W φ` sends `w ∈ W` to `φ x` and `x` in the complement of `W` to `0`. -/
+an arbitrary extension of `φ` to an element of the dual of `V`.
+That is, `dual_lift W φ` sends `w ∈ W` to `φ x` and `x` in a chosen complement of `W` to `0`. -/
 noncomputable def dual_lift (W : subspace K V) :
   module.dual K W →ₗ[K] module.dual K V :=
 let h := classical.indefinite_description _ W.exists_is_compl in
@@ -530,7 +845,7 @@ by { erw of_is_compl_left_apply _ w, refl }
 
 lemma dual_lift_of_mem {φ : module.dual K W} {w : V} (hw : w ∈ W) :
   W.dual_lift φ w = φ ⟨w, hw⟩ :=
-dual_lift_of_subtype ⟨w, hw⟩
+by convert dual_lift_of_subtype ⟨w, hw⟩
 
 @[simp] lemma dual_restrict_comp_dual_lift (W : subspace K V) :
   W.dual_restrict.comp W.dual_lift = 1 :=
@@ -559,7 +874,11 @@ noncomputable def quot_annihilator_equiv (W : subspace K V) :
 (quot_equiv_of_eq _ _ W.dual_restrict_ker_eq_dual_annihilator).symm.trans $
   W.dual_restrict.quot_ker_equiv_of_surjective dual_restrict_surjective
 
-/-- The natural isomorphism forom the dual of a subspace `W` to `W.dual_lift.range`. -/
+@[simp] lemma quot_annihilator_equiv_apply (W : subspace K V) (φ : module.dual K V) :
+  W.quot_annihilator_equiv (submodule.quotient.mk φ) = W.dual_restrict φ :=
+by { ext, refl }
+
+/-- The natural isomorphism from the dual of a subspace `W` to `W.dual_lift.range`. -/
 noncomputable def dual_equiv_dual (W : subspace K V) :
   module.dual K W ≃ₗ[K] W.dual_lift.range :=
 linear_equiv.of_injective _ dual_lift_injective
@@ -583,6 +902,15 @@ by apply_instance
 
 variables [finite_dimensional K V] [finite_dimensional K V₁]
 
+lemma dual_annihilator_dual_annihilator_eq (W : subspace K V) :
+  W.dual_annihilator.dual_annihilator = module.map_eval_equiv K V W :=
+begin
+  have : _ = W := subspace.dual_annihilator_dual_coannihilator_eq,
+  rw [dual_coannihilator, ← module.map_eval_equiv_symm_apply] at this,
+  rwa ← order_iso.symm_apply_eq,
+end
+
+-- TODO(kmill): https://github.com/leanprover-community/mathlib/pull/17521#discussion_r1083241963
 @[simp] lemma dual_finrank_eq :
   finrank K (module.dual K V) = finrank K V :=
 linear_equiv.finrank_eq (basis.of_vector_space K V).to_dual_equiv.symm
@@ -605,18 +933,18 @@ end
 open finite_dimensional
 
 @[simp]
-lemma finrank_dual_annihilator_comap_eq {Φ : subspace K (module.dual K V)} :
-  finrank K Φ.dual_annihilator_comap = finrank K Φ.dual_annihilator :=
+lemma finrank_dual_coannihilator_eq {Φ : subspace K (module.dual K V)} :
+  finrank K Φ.dual_coannihilator = finrank K Φ.dual_annihilator :=
 begin
-  rw [submodule.dual_annihilator_comap, ← module.eval_equiv_to_linear_map],
+  rw [submodule.dual_coannihilator, ← module.eval_equiv_to_linear_map],
   exact linear_equiv.finrank_eq (linear_equiv.of_submodule' _ _),
 end
 
-lemma finrank_add_finrank_dual_annihilator_comap_eq
+lemma finrank_add_finrank_dual_coannihilator_eq
   (W : subspace K (module.dual K V)) :
-  finrank K W + finrank K W.dual_annihilator_comap = finrank K V :=
+  finrank K W + finrank K W.dual_coannihilator = finrank K V :=
 begin
-  rw [finrank_dual_annihilator_comap_eq, W.quot_equiv_annihilator.finrank_eq.symm, add_comm,
+  rw [finrank_dual_coannihilator_eq, W.quot_equiv_annihilator.finrank_eq.symm, add_comm,
       submodule.finrank_quotient_add_finrank, subspace.dual_finrank_eq],
 end
 
@@ -624,63 +952,11 @@ end
 
 end subspace
 
-variables {R : Type*} [comm_ring R] {M₁ : Type*} {M₂ : Type*}
-variables [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]
-
 open module
 
-/-- Given a linear map `f : M₁ →ₗ[R] M₂`, `f.dual_map` is the linear map between the dual of
-`M₂` and `M₁` such that it maps the functional `φ` to `φ ∘ f`. -/
-def linear_map.dual_map (f : M₁ →ₗ[R] M₂) : dual R M₂ →ₗ[R] dual R M₁ :=
-linear_map.lcomp R R f
-
-@[simp] lemma linear_map.dual_map_apply (f : M₁ →ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
-  f.dual_map g x = g (f x) :=
-linear_map.lcomp_apply f g x
-
-@[simp] lemma linear_map.dual_map_id :
-  (linear_map.id : M₁ →ₗ[R] M₁).dual_map = linear_map.id :=
-by { ext, refl }
-
-lemma linear_map.dual_map_comp_dual_map {M₃ : Type*} [add_comm_group M₃] [module R M₃]
-  (f : M₁ →ₗ[R] M₂) (g : M₂ →ₗ[R] M₃) :
-  f.dual_map.comp g.dual_map = (g.comp f).dual_map :=
-rfl
-
-/-- The `linear_equiv` version of `linear_map.dual_map`. -/
-def linear_equiv.dual_map (f : M₁ ≃ₗ[R] M₂) : dual R M₂ ≃ₗ[R] dual R M₁ :=
-{ inv_fun := f.symm.to_linear_map.dual_map,
-  left_inv :=
-    begin
-      intro φ, ext x,
-      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
-                 linear_map.to_fun_eq_coe, linear_equiv.apply_symm_apply]
-    end,
-  right_inv :=
-    begin
-      intro φ, ext x,
-      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
-                 linear_map.to_fun_eq_coe, linear_equiv.symm_apply_apply]
-    end,
-  .. f.to_linear_map.dual_map }
-
-@[simp] lemma linear_equiv.dual_map_apply (f : M₁ ≃ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
-  f.dual_map g x = g (f x) :=
-linear_map.lcomp_apply f g x
-
-@[simp] lemma linear_equiv.dual_map_refl :
-  (linear_equiv.refl R M₁).dual_map = linear_equiv.refl R (dual R M₁) :=
-by { ext, refl }
-
-@[simp] lemma linear_equiv.dual_map_symm {f : M₁ ≃ₗ[R] M₂} :
-  (linear_equiv.dual_map f).symm = linear_equiv.dual_map f.symm := rfl
-
-lemma linear_equiv.dual_map_trans {M₃ : Type*} [add_comm_group M₃] [module R M₃]
-  (f : M₁ ≃ₗ[R] M₂) (g : M₂ ≃ₗ[R] M₃) :
-  g.dual_map.trans f.dual_map = (f.trans g).dual_map :=
-rfl
-
 namespace linear_map
+variables {R : Type*} [comm_semiring R] {M₁ : Type*} {M₂ : Type*}
+variables [add_comm_monoid M₁] [module R M₁] [add_comm_monoid M₂] [module R M₂]
 
 variable (f : M₁ →ₗ[R] M₂)
 
@@ -707,15 +983,257 @@ begin
   rw [dual_map_apply, hx, map_zero]
 end
 
-section finite_dimensional
+end linear_map
+
+section comm_ring
+
+variables {R M M' : Type*}
+variables [comm_ring R] [add_comm_group M] [module R M] [add_comm_group M'] [module R M']
+
+namespace submodule
+
+/-- Given a submodule, corestrict to the pairing on `M ⧸ W` by
+simultaneously restricting to `W.dual_annihilator`.
+
+See `subspace.dual_copairing_nondegenerate`. -/
+def dual_copairing (W : submodule R M) :
+  W.dual_annihilator →ₗ[R] M ⧸ W →ₗ[R] R :=
+linear_map.flip $ W.liftq ((module.dual_pairing R M).dom_restrict W.dual_annihilator).flip
+  (by { intros w hw, ext ⟨φ, hφ⟩, exact (mem_dual_annihilator φ).mp hφ w hw })
+
+@[simp] lemma dual_copairing_apply {W : submodule R M} (φ : W.dual_annihilator) (x : M) :
+  W.dual_copairing φ (quotient.mk x) = φ x := rfl
+
+/-- Given a submodule, restrict to the pairing on `W` by
+simultaneously corestricting to `module.dual R M ⧸ W.dual_annihilator`.
+This is `submodule.dual_restrict` factored through the quotient by its kernel (which
+is `W.dual_annihilator` by definition).
+
+See `subspace.dual_pairing_nondegenerate`. -/
+def dual_pairing (W : submodule R M) :
+  module.dual R M ⧸ W.dual_annihilator →ₗ[R] W →ₗ[R] R :=
+W.dual_annihilator.liftq W.dual_restrict le_rfl
+
+@[simp] lemma dual_pairing_apply {W : submodule R M} (φ : module.dual R M) (x : W) :
+  W.dual_pairing (quotient.mk φ) x = φ x := rfl
+
+/-- That $\operatorname{im}(q^* : (V/W)^* \to V^*) = \operatorname{ann}(W)$. -/
+lemma range_dual_map_mkq_eq (W : submodule R M) :
+  W.mkq.dual_map.range = W.dual_annihilator :=
+begin
+  ext φ,
+  rw linear_map.mem_range,
+  split,
+  { rintro ⟨ψ, rfl⟩,
+    have := linear_map.mem_range_self W.mkq.dual_map ψ,
+    simpa only [ker_mkq] using linear_map.range_dual_map_le_dual_annihilator_ker W.mkq this, },
+  { intro hφ,
+    existsi W.dual_copairing ⟨φ, hφ⟩,
+    ext,
+    refl, }
+end
+
+/-- Equivalence $(M/W)^* \approx \operatorname{ann}(W)$. That is, there is a one-to-one
+correspondence between the dual of `M ⧸ W` and those elements of the dual of `M` that
+vanish on `W`.
+
+The inverse of this is `submodule.dual_copairing`. -/
+def dual_quot_equiv_dual_annihilator (W : submodule R M) :
+  module.dual R (M ⧸ W) ≃ₗ[R] W.dual_annihilator :=
+linear_equiv.of_linear
+  (W.mkq.dual_map.cod_restrict W.dual_annihilator $
+    λ φ, W.range_dual_map_mkq_eq ▸ W.mkq.dual_map.mem_range_self φ)
+  W.dual_copairing
+  (by { ext, refl}) (by { ext, refl })
+
+@[simp] lemma dual_quot_equiv_dual_annihilator_apply (W : submodule R M)
+  (φ : module.dual R (M ⧸ W)) (x : M) :
+  dual_quot_equiv_dual_annihilator W φ x = φ (quotient.mk x) := rfl
+
+lemma dual_copairing_eq (W : submodule R M) :
+  W.dual_copairing = (dual_quot_equiv_dual_annihilator W).symm.to_linear_map := rfl
+
+@[simp] lemma dual_quot_equiv_dual_annihilator_symm_apply_mk (W : submodule R M)
+  (φ : W.dual_annihilator) (x : M) :
+  (dual_quot_equiv_dual_annihilator W).symm φ (quotient.mk x) = φ x := rfl
+
+end submodule
+
+namespace linear_map
+open submodule
+
+lemma range_dual_map_eq_dual_annihilator_ker_of_surjective
+  (f : M →ₗ[R] M') (hf : function.surjective f) :
+  f.dual_map.range = f.ker.dual_annihilator :=
+begin
+  rw ← f.ker.range_dual_map_mkq_eq,
+  let f' := linear_map.quot_ker_equiv_of_surjective f hf,
+  transitivity linear_map.range (f.dual_map.comp f'.symm.dual_map.to_linear_map),
+  { rw linear_map.range_comp_of_range_eq_top,
+    apply linear_equiv.range },
+  { apply congr_arg,
+    ext φ x,
+    simp only [linear_map.coe_comp, linear_equiv.coe_to_linear_map, linear_map.dual_map_apply,
+      linear_equiv.dual_map_apply, mkq_apply, f', linear_map.quot_ker_equiv_of_surjective,
+      linear_equiv.trans_symm, linear_equiv.trans_apply, linear_equiv.of_top_symm_apply,
+      linear_map.quot_ker_equiv_range_symm_apply_image, mkq_apply], }
+end
+
+-- Note, this can be specialized to the case where `R` is an injective `R`-module, or when
+-- `f.coker` is a projective `R`-module.
+lemma range_dual_map_eq_dual_annihilator_ker_of_subtype_range_surjective
+  (f : M →ₗ[R] M') (hf : function.surjective f.range.subtype.dual_map) :
+  f.dual_map.range = f.ker.dual_annihilator :=
+begin
+  have rr_surj : function.surjective f.range_restrict,
+  { rw [← linear_map.range_eq_top, linear_map.range_range_restrict] },
+  have := range_dual_map_eq_dual_annihilator_ker_of_surjective f.range_restrict rr_surj,
+  convert this using 1,
+  { change ((submodule.subtype f.range).comp f.range_restrict).dual_map.range = _,
+    rw [← linear_map.dual_map_comp_dual_map, linear_map.range_comp_of_range_eq_top],
+    rwa linear_map.range_eq_top, },
+  { apply congr_arg,
+    exact (linear_map.ker_range_restrict f).symm, },
+end
+
+end linear_map
+
+end comm_ring
+
+section vector_space
 
 variables {K : Type*} [field K] {V₁ : Type*} {V₂ : Type*}
 variables [add_comm_group V₁] [module K V₁] [add_comm_group V₂] [module K V₂]
 
-open finite_dimensional
+namespace linear_map
+
+lemma dual_pairing_nondegenerate : (dual_pairing K V₁).nondegenerate :=
+⟨separating_left_iff_ker_eq_bot.mpr ker_id, λ x, (forall_dual_apply_eq_zero_iff K x).mp⟩
+
+lemma dual_map_surjective_of_injective {f : V₁ →ₗ[K] V₂} (hf : function.injective f) :
+  function.surjective f.dual_map :=
+begin
+  intro φ,
+  let f' := linear_equiv.of_injective f hf,
+  use subspace.dual_lift (range f) (f'.symm.dual_map φ),
+  ext x,
+  rw [linear_map.dual_map_apply, subspace.dual_lift_of_mem (mem_range_self f x),
+    linear_equiv.dual_map_apply],
+  congr' 1,
+  exact linear_equiv.symm_apply_apply f' x,
+end
+
+lemma range_dual_map_eq_dual_annihilator_ker (f : V₁ →ₗ[K] V₂) :
+  f.dual_map.range = f.ker.dual_annihilator :=
+range_dual_map_eq_dual_annihilator_ker_of_subtype_range_surjective f $
+  dual_map_surjective_of_injective (range f).injective_subtype
+
+/-- For vector spaces, `f.dual_map` is surjective if and only if `f` is injective -/
+@[simp] lemma dual_map_surjective_iff {f : V₁ →ₗ[K] V₂} :
+  function.surjective f.dual_map ↔ function.injective f :=
+by rw [← linear_map.range_eq_top, range_dual_map_eq_dual_annihilator_ker,
+       ← submodule.dual_annihilator_bot, subspace.dual_annihilator_inj, linear_map.ker_eq_bot]
+
+end linear_map
+
+namespace subspace
+open submodule
+
+lemma dual_pairing_eq (W : subspace K V₁) :
+  W.dual_pairing = W.quot_annihilator_equiv.to_linear_map :=
+by { ext, refl }
+
+lemma dual_pairing_nondegenerate (W : subspace K V₁) : W.dual_pairing.nondegenerate :=
+begin
+  split,
+  { rw [linear_map.separating_left_iff_ker_eq_bot, dual_pairing_eq],
+    apply linear_equiv.ker, },
+  { intros x h,
+    rw ← forall_dual_apply_eq_zero_iff K x,
+    intro φ,
+    simpa only [submodule.dual_pairing_apply, dual_lift_of_subtype]
+      using h (submodule.quotient.mk (W.dual_lift φ)), }
+end
+
+lemma dual_copairing_nondegenerate (W : subspace K V₁) : W.dual_copairing.nondegenerate :=
+begin
+  split,
+  { rw [linear_map.separating_left_iff_ker_eq_bot, dual_copairing_eq],
+    apply linear_equiv.ker, },
+  { rintro ⟨x⟩,
+    simp only [quotient.quot_mk_eq_mk, dual_copairing_apply, quotient.mk_eq_zero],
+    rw [← forall_mem_dual_annihilator_apply_eq_zero_iff, set_like.forall],
+    exact id, }
+end
+
+-- Argument from https://math.stackexchange.com/a/2423263/172988
+lemma dual_annihilator_inf_eq (W W' : subspace K V₁) :
+  (W ⊓ W').dual_annihilator = W.dual_annihilator ⊔ W'.dual_annihilator :=
+begin
+  refine le_antisymm _ (sup_dual_annihilator_le_inf W W'),
+  let F : V₁ →ₗ[K] (V₁ ⧸ W) × (V₁ ⧸ W') := (submodule.mkq W).prod (submodule.mkq W'),
+  have : F.ker = W ⊓ W' := by simp only [linear_map.ker_prod, ker_mkq],
+  rw [← this, ← linear_map.range_dual_map_eq_dual_annihilator_ker],
+  intro φ,
+  rw [linear_map.mem_range],
+  rintro ⟨x, rfl⟩,
+  rw [submodule.mem_sup],
+  obtain ⟨⟨a, b⟩, rfl⟩ := (dual_prod_dual_equiv_dual K (V₁ ⧸ W) (V₁ ⧸ W')).surjective x,
+  obtain ⟨a', rfl⟩ := (dual_quot_equiv_dual_annihilator W).symm.surjective a,
+  obtain ⟨b', rfl⟩ := (dual_quot_equiv_dual_annihilator W').symm.surjective b,
+  use [a', a'.property, b', b'.property],
+  refl,
+end
+
+-- This is also true if `V₁` is finite dimensional since one can restrict `ι` to some subtype
+-- for which the infi and supr are the same.
+--
+-- The obstruction to the `dual_annihilator_inf_eq` argument carrying through is that we need
+-- for `module.dual R (Π (i : ι), V ⧸ W i) ≃ₗ[K] Π (i : ι), module.dual R (V ⧸ W i)`, which is not
+-- true for infinite `ι`. One would need to add additional hypothesis on `W` (for example, it might
+-- be true when the family is inf-closed).
+lemma dual_annihilator_infi_eq {ι : Type*} [_root_.finite ι] (W : ι → subspace K V₁) :
+  (⨅ (i : ι), W i).dual_annihilator = (⨆ (i : ι), (W i).dual_annihilator) :=
+begin
+  unfreezingI { revert ι },
+  refine finite.induction_empty_option _ _ _,
+  { intros α β h hyp W,
+    rw [← h.infi_comp, hyp (W ∘ h), ← h.supr_comp], },
+  { intro W,
+    rw [supr_of_empty', infi_of_empty', Inf_empty, Sup_empty, dual_annihilator_top], },
+  { introsI α _ h W,
+    rw [infi_option, supr_option, dual_annihilator_inf_eq, h], }
+end
+
+/-- For vector spaces, dual annihilators carry direct sum decompositions
+to direct sum decompositions. -/
+lemma is_compl_dual_annihilator {W W' : subspace K V₁} (h : is_compl W W') :
+  is_compl W.dual_annihilator W'.dual_annihilator :=
+begin
+  rw [is_compl_iff, disjoint_iff, codisjoint_iff] at h ⊢,
+  rw [← dual_annihilator_inf_eq, ← dual_annihilator_sup_eq, h.1, h.2,
+    dual_annihilator_top, dual_annihilator_bot],
+  exact ⟨rfl, rfl⟩
+end
+
+/-- For finite-dimensional vector spaces, one can distribute duals over quotients by identifying
+`W.dual_lift.range` with `W`. Note that this depends on a choice of splitting of `V₁`. -/
+def dual_quot_distrib [finite_dimensional K V₁] (W : subspace K V₁) :
+  module.dual K (V₁ ⧸ W) ≃ₗ[K] (module.dual K V₁ ⧸ W.dual_lift.range) :=
+W.dual_quot_equiv_dual_annihilator.trans W.quot_dual_equiv_annihilator.symm
+
+end subspace
+
+section finite_dimensional
+
+open finite_dimensional linear_map
 
 variable [finite_dimensional K V₂]
 
+namespace linear_map
+
+-- TODO(kmill) remove finite_dimensional if possible
+-- see https://github.com/leanprover-community/mathlib/pull/17521#discussion_r1083242551
 @[simp] lemma finrank_range_dual_map_eq_finrank_range (f : V₁ →ₗ[K] V₂) :
   finrank K f.dual_map.range = finrank K f.range :=
 begin
@@ -728,39 +1246,124 @@ begin
   rw [finrank_range_add_finrank_ker f.dual_map, add_comm, this],
 end
 
-lemma range_dual_map_eq_dual_annihilator_ker [finite_dimensional K V₁] (f : V₁ →ₗ[K] V₂) :
-  f.dual_map.range = f.ker.dual_annihilator :=
+/-- `f.dual_map` is injective if and only if `f` is surjective -/
+@[simp] lemma dual_map_injective_iff {f : V₁ →ₗ[K] V₂} :
+  function.injective f.dual_map ↔ function.surjective f :=
 begin
-  refine eq_of_le_of_finrank_eq f.range_dual_map_le_dual_annihilator_ker _,
-  have := submodule.finrank_quotient_add_finrank f.ker,
-  rw (subspace.quot_equiv_annihilator f.ker).finrank_eq at this,
-  refine add_left_injective (finrank K f.ker) _,
-  simp_rw [this, finrank_range_dual_map_eq_finrank_range],
-  exact finrank_range_add_finrank_ker f,
+  refine ⟨_, λ h, dual_map_injective_of_surjective h⟩,
+  rw [← range_eq_top, ← ker_eq_bot],
+  intro h,
+  apply finite_dimensional.eq_top_of_finrank_eq,
+  rw ← finrank_eq_zero at h,
+  rw [← add_zero (finite_dimensional.finrank K f.range), ← h,
+      ← linear_map.finrank_range_dual_map_eq_finrank_range,
+      linear_map.finrank_range_add_finrank_ker, subspace.dual_finrank_eq],
 end
 
+/-- `f.dual_map` is bijective if and only if `f` is -/
+@[simp] lemma dual_map_bijective_iff {f : V₁ →ₗ[K] V₂} :
+  function.bijective f.dual_map ↔ function.bijective f :=
+by simp_rw [function.bijective, dual_map_surjective_iff, dual_map_injective_iff, and.comm]
+
+end linear_map
+
 end finite_dimensional
 
-section field
+end vector_space
 
-variables {K V : Type*}
-variables [field K] [add_comm_group V] [module K V]
+namespace tensor_product
+
+variables (R : Type*) (M : Type*) (N : Type*)
+
+variables {ι κ : Type*}
+variables [decidable_eq ι] [decidable_eq κ]
+variables [fintype ι] [fintype κ]
+
+open_locale big_operators
+open_locale tensor_product
+
+local attribute [ext] tensor_product.ext
+
+open tensor_product
+open linear_map
+
+section
+variables [comm_semiring R] [add_comm_monoid M] [add_comm_monoid N]
+variables [module R M] [module R N]
+
+/--
+The canonical linear map from `dual M ⊗ dual N` to `dual (M ⊗ N)`,
+sending `f ⊗ g` to the composition of `tensor_product.map f g` with
+the natural isomorphism `R ⊗ R ≃ R`.
+-/
+def dual_distrib : (dual R M) ⊗[R] (dual R N) →ₗ[R] dual R (M ⊗[R] N) :=
+(comp_right ↑(tensor_product.lid R R)) ∘ₗ hom_tensor_hom_map R M N R R
 
-lemma dual_pairing_nondegenerate : (dual_pairing K V).nondegenerate :=
+variables {R M N}
+
+@[simp]
+lemma dual_distrib_apply (f : dual R M) (g : dual R N) (m : M) (n : N) :
+  dual_distrib R M N (f ⊗ₜ g) (m ⊗ₜ n) = f m * g n :=
+rfl
+
+end
+
+variables {R M N}
+variables [comm_ring R] [add_comm_group M] [add_comm_group N]
+variables [module R M] [module R N]
+
+/--
+An inverse to `dual_tensor_dual_map` given bases.
+-/
+noncomputable
+def dual_distrib_inv_of_basis (b : basis ι R M) (c : basis κ R N) :
+  dual R (M ⊗[R] N) →ₗ[R] (dual R M) ⊗[R] (dual R N) :=
+∑ i j, (ring_lmap_equiv_self R ℕ _).symm (b.dual_basis i ⊗ₜ c.dual_basis j)
+    ∘ₗ applyₗ (c j) ∘ₗ applyₗ (b i) ∘ₗ (lcurry R M N R)
+
+@[simp]
+lemma dual_distrib_inv_of_basis_apply (b : basis ι R M) (c : basis κ R N)
+  (f : dual R (M ⊗[R] N)) : dual_distrib_inv_of_basis b c f =
+  ∑ i j, (f (b i ⊗ₜ c j)) • (b.dual_basis i ⊗ₜ c.dual_basis j) :=
+by simp [dual_distrib_inv_of_basis]
+
+/--
+A linear equivalence between `dual M ⊗ dual N` and `dual (M ⊗ N)` given bases for `M` and `N`.
+It sends `f ⊗ g` to the composition of `tensor_product.map f g` with the natural
+isomorphism `R ⊗ R ≃ R`.
+-/
+@[simps]
+noncomputable def dual_distrib_equiv_of_basis (b : basis ι R M) (c : basis κ R N) :
+  (dual R M) ⊗[R] (dual R N) ≃ₗ[R] dual R (M ⊗[R] N) :=
 begin
-  refine ⟨separating_left_iff_ker_eq_bot.mpr ker_id, _⟩,
-  intros x,
-  contrapose,
-  rintros hx : x ≠ 0,
-  rw [not_forall],
-  let f : V →ₗ[K] K := classical.some (linear_pmap.mk_span_singleton x 1 hx).to_fun.exists_extend,
-  use [f],
-  refine ne_zero_of_eq_one _,
-  have h : f.comp (K ∙ x).subtype = (linear_pmap.mk_span_singleton x 1 hx).to_fun :=
-    classical.some_spec (linear_pmap.mk_span_singleton x (1 : K) hx).to_fun.exists_extend,
-  exact (fun_like.congr_fun h _).trans (linear_pmap.mk_span_singleton_apply _ hx _),
+  refine linear_equiv.of_linear
+    (dual_distrib R M N) (dual_distrib_inv_of_basis b c) _ _,
+  { ext f m n,
+    have h : ∀ (r s : R), r • s = s • r := is_commutative.comm,
+    simp only [compr₂_apply, mk_apply, comp_apply, id_apply, dual_distrib_inv_of_basis_apply,
+      linear_map.map_sum, map_smul, sum_apply, smul_apply, dual_distrib_apply, h (f _) _,
+      ← f.map_smul, ←f.map_sum, ←smul_tmul_smul, ←tmul_sum, ←sum_tmul, basis.coe_dual_basis,
+      basis.coord_apply, basis.sum_repr] },
+  { ext f g,
+    simp only [compr₂_apply, mk_apply, comp_apply, id_apply, dual_distrib_inv_of_basis_apply,
+      dual_distrib_apply, ←smul_tmul_smul, ←tmul_sum, ←sum_tmul, basis.coe_dual_basis,
+      basis.sum_dual_apply_smul_coord] }
 end
 
-end field
+variables (R M N)
+variables [module.finite R M] [module.finite R N] [module.free R M] [module.free R N]
+variables [nontrivial R]
 
-end linear_map
+open_locale classical
+
+/--
+A linear equivalence between `dual M ⊗ dual N` and `dual (M ⊗ N)` when `M` and `N` are finite free
+modules. It sends `f ⊗ g` to the composition of `tensor_product.map f g` with the natural
+isomorphism `R ⊗ R ≃ R`.
+-/
+@[simp]
+noncomputable
+def dual_distrib_equiv : (dual R M) ⊗[R] (dual R N) ≃ₗ[R] dual R (M ⊗[R] N) :=
+dual_distrib_equiv_of_basis (module.free.choose_basis R M) (module.free.choose_basis R N)
+
+end tensor_product
diff --git a/src/linear_algebra/eigenspace.lean b/src/linear_algebra/eigenspace.lean
deleted file mode 100644
index b6ffa6d59f007..0000000000000
--- a/src/linear_algebra/eigenspace.lean
+++ /dev/null
@@ -1,596 +0,0 @@
-/-
-Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Alexander Bentkamp
--/
-
-import linear_algebra.charpoly.basic
-import linear_algebra.finsupp
-import linear_algebra.matrix.to_lin
-import algebra.algebra.spectrum
-import order.hom.basic
-
-/-!
-# Eigenvectors and eigenvalues
-
-This file defines eigenspaces, eigenvalues, and eigenvalues, as well as their generalized
-counterparts. We follow Axler's approach [axler2015] because it allows us to derive many properties
-without choosing a basis and without using matrices.
-
-An eigenspace of a linear map `f` for a scalar `μ` is the kernel of the map `(f - μ • id)`. The
-nonzero elements of an eigenspace are eigenvectors `x`. They have the property `f x = μ • x`. If
-there are eigenvectors for a scalar `μ`, the scalar `μ` is called an eigenvalue.
-
-There is no consensus in the literature whether `0` is an eigenvector. Our definition of
-`has_eigenvector` permits only nonzero vectors. For an eigenvector `x` that may also be `0`, we
-write `x ∈ f.eigenspace μ`.
-
-A generalized eigenspace of a linear map `f` for a natural number `k` and a scalar `μ` is the kernel
-of the map `(f - μ • id) ^ k`. The nonzero elements of a generalized eigenspace are generalized
-eigenvectors `x`. If there are generalized eigenvectors for a natural number `k` and a scalar `μ`,
-the scalar `μ` is called a generalized eigenvalue.
-
-## References
-
-* [Sheldon Axler, *Linear Algebra Done Right*][axler2015]
-* https://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors
-
-## Tags
-
-eigenspace, eigenvector, eigenvalue, eigen
--/
-
-universes u v w
-
-namespace module
-namespace End
-
-open module principal_ideal_ring polynomial finite_dimensional
-open_locale polynomial
-
-variables {K R : Type v} {V M : Type w}
-  [comm_ring R] [add_comm_group M] [module R M] [field K] [add_comm_group V] [module K V]
-
-/-- The submodule `eigenspace f μ` for a linear map `f` and a scalar `μ` consists of all vectors `x`
-    such that `f x = μ • x`. (Def 5.36 of [axler2015])-/
-def eigenspace (f : End R M) (μ : R) : submodule R M :=
-(f - algebra_map R (End R M) μ).ker
-
-/-- A nonzero element of an eigenspace is an eigenvector. (Def 5.7 of [axler2015]) -/
-def has_eigenvector (f : End R M) (μ : R) (x : M) : Prop :=
-x ∈ eigenspace f μ ∧ x ≠ 0
-
-/-- A scalar `μ` is an eigenvalue for a linear map `f` if there are nonzero vectors `x`
-    such that `f x = μ • x`. (Def 5.5 of [axler2015]) -/
-def has_eigenvalue (f : End R M) (a : R) : Prop :=
-eigenspace f a ≠ ⊥
-
-/-- The eigenvalues of the endomorphism `f`, as a subtype of `R`. -/
-def eigenvalues (f : End R M) : Type* := {μ : R // f.has_eigenvalue μ}
-
-instance (f : End R M) : has_coe f.eigenvalues R := coe_subtype
-
-lemma has_eigenvalue_of_has_eigenvector {f : End R M} {μ : R} {x : M} (h : has_eigenvector f μ x) :
-  has_eigenvalue f μ :=
-begin
-  rw [has_eigenvalue, submodule.ne_bot_iff],
-  use x, exact h,
-end
-
-lemma mem_eigenspace_iff {f : End R M} {μ : R} {x : M} : x ∈ eigenspace f μ ↔ f x = μ • x :=
-by rw [eigenspace, linear_map.mem_ker, linear_map.sub_apply, algebra_map_End_apply,
-  sub_eq_zero]
-
-lemma has_eigenvector.apply_eq_smul {f : End R M} {μ : R} {x : M} (hx : f.has_eigenvector μ x) :
-  f x = μ • x :=
-mem_eigenspace_iff.mp hx.1
-
-lemma has_eigenvalue.exists_has_eigenvector {f : End R M} {μ : R} (hμ : f.has_eigenvalue μ) :
-  ∃ v, f.has_eigenvector μ v :=
-submodule.exists_mem_ne_zero_of_ne_bot hμ
-
-lemma mem_spectrum_of_has_eigenvalue {f : End R M} {μ : R} (hμ : has_eigenvalue f μ) :
-  μ ∈ spectrum R f :=
-begin
-  refine spectrum.mem_iff.mpr (λ h_unit, _),
-  set f' := linear_map.general_linear_group.to_linear_equiv h_unit.unit,
-  rcases hμ.exists_has_eigenvector with ⟨v, hv⟩,
-  refine hv.2 ((linear_map.ker_eq_bot'.mp f'.ker) v (_ : μ • v - f v = 0)),
-  rw [hv.apply_eq_smul, sub_self]
-end
-
-lemma has_eigenvalue_iff_mem_spectrum [finite_dimensional K V] {f : End K V} {μ : K} :
-  f.has_eigenvalue μ ↔ μ ∈ spectrum K f :=
-iff.intro mem_spectrum_of_has_eigenvalue
-  (λ h, by rwa [spectrum.mem_iff, is_unit.sub_iff, linear_map.is_unit_iff_ker_eq_bot] at h)
-
-lemma eigenspace_div (f : End K V) (a b : K) (hb : b ≠ 0) :
-  eigenspace f (a / b) = (b • f - algebra_map K (End K V) a).ker :=
-calc
-  eigenspace f (a / b) = eigenspace f (b⁻¹ * a) : by { rw [div_eq_mul_inv, mul_comm] }
-  ... = (f - (b⁻¹ * a) • linear_map.id).ker : rfl
-  ... = (f - b⁻¹ • a • linear_map.id).ker : by rw smul_smul
-  ... = (f - b⁻¹ • algebra_map K (End K V) a).ker : rfl
-  ... = (b • (f - b⁻¹ • algebra_map K (End K V) a)).ker : by rw linear_map.ker_smul _ b hb
-  ... = (b • f - algebra_map K (End K V) a).ker : by rw [smul_sub, smul_inv_smul₀ hb]
-
-lemma eigenspace_aeval_polynomial_degree_1
-  (f : End K V) (q : K[X]) (hq : degree q = 1) :
-  eigenspace f (- q.coeff 0 / q.leading_coeff) = (aeval f q).ker :=
-calc
-  eigenspace f (- q.coeff 0 / q.leading_coeff)
-      = (q.leading_coeff • f - algebra_map K (End K V) (- q.coeff 0)).ker
-    : by { rw eigenspace_div, intro h, rw leading_coeff_eq_zero_iff_deg_eq_bot.1 h at hq, cases hq }
-  ... = (aeval f (C q.leading_coeff * X + C (q.coeff 0))).ker
-    : by { rw [C_mul', aeval_def], simp [algebra_map, algebra.to_ring_hom], }
-  ... = (aeval f q).ker
-     : by { congr, apply (eq_X_add_C_of_degree_eq_one hq).symm }
-
-lemma ker_aeval_ring_hom'_unit_polynomial
-  (f : End K V) (c : (K[X])ˣ) :
-  (aeval f (c : K[X])).ker = ⊥ :=
-begin
-  rw polynomial.eq_C_of_degree_eq_zero (degree_coe_units c),
-  simp only [aeval_def, eval₂_C],
-  apply ker_algebra_map_End,
-  apply coeff_coe_units_zero_ne_zero c
-end
-
-theorem aeval_apply_of_has_eigenvector {f : End K V}
-  {p : K[X]} {μ : K} {x : V} (h : f.has_eigenvector μ x) :
-  aeval f p x = (p.eval μ) • x :=
-begin
-  apply p.induction_on,
-  { intro a, simp [module.algebra_map_End_apply] },
-  { intros p q hp hq, simp [hp, hq, add_smul] },
-  { intros n a hna,
-    rw [mul_comm, pow_succ, mul_assoc, alg_hom.map_mul, linear_map.mul_apply, mul_comm, hna],
-    simp only [mem_eigenspace_iff.1 h.1, smul_smul, aeval_X, eval_mul, eval_C, eval_pow, eval_X,
-      linear_map.map_smulₛₗ, ring_hom.id_apply, mul_comm] }
-end
-
-section minpoly
-
-theorem is_root_of_has_eigenvalue {f : End K V} {μ : K} (h : f.has_eigenvalue μ) :
-  (minpoly K f).is_root μ :=
-begin
-  rcases (submodule.ne_bot_iff _).1 h with ⟨w, ⟨H, ne0⟩⟩,
-  refine or.resolve_right (smul_eq_zero.1 _) ne0,
-  simp [← aeval_apply_of_has_eigenvector ⟨H, ne0⟩, minpoly.aeval K f],
-end
-
-variables [finite_dimensional K V] (f : End K V)
-
-variables {f} {μ : K}
-
-theorem has_eigenvalue_of_is_root (h : (minpoly K f).is_root μ) :
-  f.has_eigenvalue μ :=
-begin
-  cases dvd_iff_is_root.2 h with p hp,
-  rw [has_eigenvalue, eigenspace],
-  intro con,
-  cases (linear_map.is_unit_iff_ker_eq_bot _).2 con with u hu,
-  have p_ne_0 : p ≠ 0,
-  { intro con,
-    apply minpoly.ne_zero f.is_integral,
-    rw [hp, con, mul_zero] },
-  have h_deg := minpoly.degree_le_of_ne_zero K f p_ne_0 _,
-  { rw [hp, degree_mul, degree_X_sub_C, polynomial.degree_eq_nat_degree p_ne_0] at h_deg,
-    norm_cast at h_deg,
-    linarith, },
-  { have h_aeval := minpoly.aeval K f,
-    revert h_aeval,
-    simp [hp, ← hu] },
-end
-
-theorem has_eigenvalue_iff_is_root :
-  f.has_eigenvalue μ ↔ (minpoly K f).is_root μ :=
-⟨is_root_of_has_eigenvalue, has_eigenvalue_of_is_root⟩
-
-/-- An endomorphism of a finite-dimensional vector space has finitely many eigenvalues. -/
-noncomputable instance (f : End K V) : fintype f.eigenvalues :=
-set.finite.fintype
-begin
-  have h : minpoly K f ≠ 0 := minpoly.ne_zero f.is_integral,
-  convert (minpoly K f).root_set_finite K,
-  ext μ,
-  have : (μ ∈ {μ : K | f.eigenspace μ = ⊥ → false}) ↔ ¬f.eigenspace μ = ⊥ := by tauto,
-  convert rfl.mpr this,
-  simp [polynomial.root_set_def, polynomial.mem_roots h, ← has_eigenvalue_iff_is_root,
-    has_eigenvalue]
-end
-
-end minpoly
-
-/-- Every linear operator on a vector space over an algebraically closed field has
-    an eigenvalue. -/
--- This is Lemma 5.21 of [axler2015], although we are no longer following that proof.
-lemma exists_eigenvalue [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
-  ∃ (c : K), f.has_eigenvalue c :=
-by { simp_rw has_eigenvalue_iff_mem_spectrum,
-     exact spectrum.nonempty_of_is_alg_closed_of_finite_dimensional K f }
-
-noncomputable instance [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
-  inhabited f.eigenvalues :=
-⟨⟨f.exists_eigenvalue.some, f.exists_eigenvalue.some_spec⟩⟩
-
-/-- The eigenspaces of a linear operator form an independent family of subspaces of `V`.  That is,
-any eigenspace has trivial intersection with the span of all the other eigenspaces. -/
-lemma eigenspaces_independent (f : End K V) : complete_lattice.independent f.eigenspace :=
-begin
-  classical,
-  -- Define an operation from `Π₀ μ : K, f.eigenspace μ`, the vector space of of finitely-supported
-  -- choices of an eigenvector from each eigenspace, to `V`, by sending a collection to its sum.
-  let S : @linear_map K K _ _ (ring_hom.id K) (Π₀ μ : K, f.eigenspace μ) V
-    (@dfinsupp.add_comm_monoid K (λ μ, f.eigenspace μ) _) _
-    (@dfinsupp.module K _ (λ μ, f.eigenspace μ) _ _ _) _ :=
-    @dfinsupp.lsum K K ℕ _ V _ _ _ _ _ _ _ _ _
-    (λ μ, (f.eigenspace μ).subtype),
-  -- We need to show that if a finitely-supported collection `l` of representatives of the
-  -- eigenspaces has sum `0`, then it itself is zero.
-  suffices : ∀ l : Π₀ μ, f.eigenspace μ, S l = 0 → l = 0,
-  { rw complete_lattice.independent_iff_dfinsupp_lsum_injective,
-    change function.injective S,
-    rw ← @linear_map.ker_eq_bot K K (Π₀ μ, (f.eigenspace μ)) V _ _
-      (@dfinsupp.add_comm_group K (λ μ, f.eigenspace μ) _),
-    rw eq_bot_iff,
-    exact this },
-  intros l hl,
-  -- We apply induction on the finite set of eigenvalues from which `l` selects a nonzero
-  -- eigenvector, i.e. on the support of `l`.
-  induction h_l_support : l.support using finset.induction with μ₀ l_support' hμ₀ ih generalizing l,
-  -- If the support is empty, all coefficients are zero and we are done.
-  { exact dfinsupp.support_eq_empty.1 h_l_support },
-  -- Now assume that the support of `l` contains at least one eigenvalue `μ₀`. We define a new
-  -- collection of representatives `l'` to apply the induction hypothesis on later. The collection
-  -- of representatives `l'` is derived from `l` by multiplying the coefficient of the eigenvector
-  -- with eigenvalue `μ` by `μ - μ₀`.
-  { let l' := dfinsupp.map_range.linear_map
-      (λ μ, (μ - μ₀) • @linear_map.id K (f.eigenspace μ) _ _ _) l,
-    -- The support of `l'` is the support of `l` without `μ₀`.
-    have h_l_support' : l'.support = l_support',
-    { rw [← finset.erase_insert hμ₀, ← h_l_support],
-      ext a,
-      have : ¬(a = μ₀ ∨ l a = 0) ↔ ¬a = μ₀ ∧ ¬l a = 0 := not_or_distrib,
-      simp only [l', dfinsupp.map_range.linear_map_apply, dfinsupp.map_range_apply,
-        dfinsupp.mem_support_iff, finset.mem_erase, id.def, linear_map.id_coe,
-        linear_map.smul_apply, ne.def, smul_eq_zero, sub_eq_zero, this] },
-    -- The entries of `l'` add up to `0`.
-    have total_l' : S l' = 0,
-    { let g := f - algebra_map K (End K V) μ₀,
-      let a : Π₀ μ : K, V := dfinsupp.map_range.linear_map (λ μ, (f.eigenspace μ).subtype) l,
-      calc S l'
-          = dfinsupp.lsum ℕ (λ μ, (f.eigenspace μ).subtype.comp ((μ - μ₀) • linear_map.id)) l : _
-      ... = dfinsupp.lsum ℕ (λ μ, g.comp (f.eigenspace μ).subtype) l : _
-      ... = dfinsupp.lsum ℕ (λ μ, g) a : _
-      ... = g (dfinsupp.lsum ℕ (λ μ, (linear_map.id : V →ₗ[K] V)) a) : _
-      ... = g (S l) : _
-      ... = 0 : by rw [hl, g.map_zero],
-      { exact dfinsupp.sum_map_range_index.linear_map },
-      { congr,
-        ext μ v,
-        simp only [g, eq_self_iff_true, function.comp_app, id.def, linear_map.coe_comp,
-          linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply,
-          module.algebra_map_End_apply, sub_left_inj, sub_smul, submodule.coe_smul_of_tower,
-          submodule.coe_sub, submodule.subtype_apply, mem_eigenspace_iff.1 v.prop], },
-      { rw dfinsupp.sum_map_range_index.linear_map },
-      { simp only [dfinsupp.sum_add_hom_apply, linear_map.id_coe, linear_map.map_dfinsupp_sum,
-          id.def, linear_map.to_add_monoid_hom_coe, dfinsupp.lsum_apply_apply], },
-      { congr,
-        simp only [S, a, dfinsupp.sum_map_range_index.linear_map, linear_map.id_comp] } },
-    -- Therefore, by the induction hypothesis, all entries of `l'` are zero.
-    have l'_eq_0 := ih l' total_l' h_l_support',
-    -- By the definition of `l'`, this means that `(μ - μ₀) • l μ = 0` for all `μ`.
-    have h_smul_eq_0 : ∀ μ, (μ - μ₀) • l μ = 0,
-    { intro μ,
-      calc (μ - μ₀) • l μ = l' μ : by simp only [l', linear_map.id_coe, id.def,
-        linear_map.smul_apply, dfinsupp.map_range_apply, dfinsupp.map_range.linear_map_apply]
-      ... = 0 : by { rw [l'_eq_0], refl } },
-    -- Thus, the eigenspace-representatives in `l` for all `μ ≠ μ₀` are `0`.
-    have h_lμ_eq_0 : ∀ μ : K, μ ≠ μ₀ → l μ = 0,
-    { intros μ hμ,
-      apply or_iff_not_imp_left.1 (smul_eq_zero.1 (h_smul_eq_0 μ)),
-      rwa [sub_eq_zero] },
-    -- So if we sum over all these representatives, we obtain `0`.
-    have h_sum_l_support'_eq_0 : finset.sum l_support' (λ μ, (l μ : V)) = 0,
-    { rw ←finset.sum_const_zero,
-      apply finset.sum_congr rfl,
-      intros μ hμ,
-      rw [submodule.coe_eq_zero, h_lμ_eq_0],
-      rintro rfl,
-      exact hμ₀ hμ },
-    -- The only potentially nonzero eigenspace-representative in `l` is the one corresponding to
-    -- `μ₀`. But since the overall sum is `0` by assumption, this representative must also be `0`.
-    have : l μ₀ = 0,
-    { simp only [S, dfinsupp.lsum_apply_apply, dfinsupp.sum_add_hom_apply,
-        linear_map.to_add_monoid_hom_coe, dfinsupp.sum, h_l_support, submodule.subtype_apply,
-        submodule.coe_eq_zero, finset.sum_insert hμ₀, h_sum_l_support'_eq_0, add_zero] at hl,
-      exact hl },
-    -- Thus, all coefficients in `l` are `0`.
-    show l = 0,
-    { ext μ,
-      by_cases h_cases : μ = μ₀,
-      { rwa [h_cases, set_like.coe_eq_coe, dfinsupp.coe_zero, pi.zero_apply] },
-      exact congr_arg (coe : _ → V) (h_lμ_eq_0 μ h_cases) }}
-end
-
-/-- Eigenvectors corresponding to distinct eigenvalues of a linear operator are linearly
-    independent. (Lemma 5.10 of [axler2015])
-
-    We use the eigenvalues as indexing set to ensure that there is only one eigenvector for each
-    eigenvalue in the image of `xs`. -/
-lemma eigenvectors_linear_independent (f : End K V) (μs : set K) (xs : μs → V)
-  (h_eigenvec : ∀ μ : μs, f.has_eigenvector μ (xs μ)) :
-  linear_independent K xs :=
-complete_lattice.independent.linear_independent _
-  (f.eigenspaces_independent.comp (coe : μs → K) subtype.coe_injective)
-  (λ μ, (h_eigenvec μ).1) (λ μ, (h_eigenvec μ).2)
-
-/-- The generalized eigenspace for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
-kernel of `(f - μ • id) ^ k`. (Def 8.10 of [axler2015]). Furthermore, a generalized eigenspace for
-some exponent `k` is contained in the generalized eigenspace for exponents larger than `k`. -/
-def generalized_eigenspace (f : End R M) (μ : R) : ℕ →o submodule R M :=
-{ to_fun    := λ k, ((f - algebra_map R (End R M) μ) ^ k).ker,
-  monotone' := λ k m hm,
-  begin
-    simp only [← pow_sub_mul_pow _ hm],
-    exact linear_map.ker_le_ker_comp
-      ((f - algebra_map R (End R M) μ) ^ k) ((f - algebra_map R (End R M) μ) ^ (m - k)),
-  end }
-
-@[simp] lemma mem_generalized_eigenspace (f : End R M) (μ : R) (k : ℕ) (m : M) :
-  m ∈ f.generalized_eigenspace μ k ↔ ((f - μ • 1)^k) m = 0 :=
-iff.rfl
-
-/-- A nonzero element of a generalized eigenspace is a generalized eigenvector.
-    (Def 8.9 of [axler2015])-/
-def has_generalized_eigenvector (f : End R M) (μ : R) (k : ℕ) (x : M) : Prop :=
-x ≠ 0 ∧ x ∈ generalized_eigenspace f μ k
-
-/-- A scalar `μ` is a generalized eigenvalue for a linear map `f` and an exponent `k ∈ ℕ` if there
-    are generalized eigenvectors for `f`, `k`, and `μ`. -/
-def has_generalized_eigenvalue (f : End R M) (μ : R) (k : ℕ) : Prop :=
-generalized_eigenspace f μ k ≠ ⊥
-
-/-- The generalized eigenrange for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
-    range of `(f - μ • id) ^ k`. -/
-def generalized_eigenrange (f : End R M) (μ : R) (k : ℕ) : submodule R M :=
-((f - algebra_map R (End R M) μ) ^ k).range
-
-/-- The exponent of a generalized eigenvalue is never 0. -/
-lemma exp_ne_zero_of_has_generalized_eigenvalue {f : End R M} {μ : R} {k : ℕ}
-  (h : f.has_generalized_eigenvalue μ k) : k ≠ 0 :=
-begin
-  rintro rfl,
-  exact h linear_map.ker_id
-end
-
-/-- The union of the kernels of `(f - μ • id) ^ k` over all `k`. -/
-def maximal_generalized_eigenspace (f : End R M) (μ : R) : submodule R M :=
-⨆ k, f.generalized_eigenspace μ k
-
-lemma generalized_eigenspace_le_maximal (f : End R M) (μ : R) (k : ℕ) :
-  f.generalized_eigenspace μ k ≤ f.maximal_generalized_eigenspace μ :=
-le_supr _ _
-
-@[simp] lemma mem_maximal_generalized_eigenspace (f : End R M) (μ : R) (m : M) :
-  m ∈ f.maximal_generalized_eigenspace μ ↔ ∃ (k : ℕ), ((f - μ • 1)^k) m = 0 :=
-by simp only [maximal_generalized_eigenspace, ← mem_generalized_eigenspace,
-  submodule.mem_supr_of_chain]
-
-/-- If there exists a natural number `k` such that the kernel of `(f - μ • id) ^ k` is the
-maximal generalized eigenspace, then this value is the least such `k`. If not, this value is not
-meaningful. -/
-noncomputable def maximal_generalized_eigenspace_index (f : End R M) (μ : R) :=
-monotonic_sequence_limit_index (f.generalized_eigenspace μ)
-
-/-- For an endomorphism of a Noetherian module, the maximal eigenspace is always of the form kernel
-`(f - μ • id) ^ k` for some `k`. -/
-lemma maximal_generalized_eigenspace_eq [h : is_noetherian R M] (f : End R M) (μ : R) :
-  maximal_generalized_eigenspace f μ =
-  f.generalized_eigenspace μ (maximal_generalized_eigenspace_index f μ) :=
-begin
-  rw is_noetherian_iff_well_founded at h,
-  exact (well_founded.supr_eq_monotonic_sequence_limit h (f.generalized_eigenspace μ) : _),
-end
-
-/-- A generalized eigenvalue for some exponent `k` is also
-    a generalized eigenvalue for exponents larger than `k`. -/
-lemma has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le
-  {f : End R M} {μ : R} {k : ℕ} {m : ℕ} (hm : k ≤ m) (hk : f.has_generalized_eigenvalue μ k) :
-  f.has_generalized_eigenvalue μ m :=
-begin
-  unfold has_generalized_eigenvalue at *,
-  contrapose! hk,
-  rw [←le_bot_iff, ←hk],
-  exact (f.generalized_eigenspace μ).monotone hm,
-end
-
-/-- The eigenspace is a subspace of the generalized eigenspace. -/
-lemma eigenspace_le_generalized_eigenspace {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
-  f.eigenspace μ ≤ f.generalized_eigenspace μ k :=
-(f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk)
-
-/-- All eigenvalues are generalized eigenvalues. -/
-lemma has_generalized_eigenvalue_of_has_eigenvalue
-  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) (hμ : f.has_eigenvalue μ) :
-  f.has_generalized_eigenvalue μ k :=
-begin
-  apply has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le hk,
-  rw [has_generalized_eigenvalue, generalized_eigenspace, order_hom.coe_fun_mk, pow_one],
-  exact hμ,
-end
-
-/-- All generalized eigenvalues are eigenvalues. -/
-lemma has_eigenvalue_of_has_generalized_eigenvalue
-  {f : End R M} {μ : R} {k : ℕ} (hμ : f.has_generalized_eigenvalue μ k) :
-  f.has_eigenvalue μ :=
-begin
-  intros contra, apply hμ,
-  erw linear_map.ker_eq_bot at ⊢ contra, rw linear_map.coe_pow,
-  exact function.injective.iterate contra k,
-end
-
-/-- Generalized eigenvalues are actually just eigenvalues. -/
-@[simp] lemma has_generalized_eigenvalue_iff_has_eigenvalue
-  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
-  f.has_generalized_eigenvalue μ k ↔ f.has_eigenvalue μ :=
-⟨has_eigenvalue_of_has_generalized_eigenvalue, has_generalized_eigenvalue_of_has_eigenvalue hk⟩
-
-/-- Every generalized eigenvector is a generalized eigenvector for exponent `finrank K V`.
-    (Lemma 8.11 of [axler2015]) -/
-lemma generalized_eigenspace_le_generalized_eigenspace_finrank
-  [finite_dimensional K V] (f : End K V) (μ : K) (k : ℕ) :
-  f.generalized_eigenspace μ k ≤ f.generalized_eigenspace μ (finrank K V) :=
-ker_pow_le_ker_pow_finrank _ _
-
-/-- Generalized eigenspaces for exponents at least `finrank K V` are equal to each other. -/
-lemma generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le [finite_dimensional K V]
-  (f : End K V) (μ : K) {k : ℕ} (hk : finrank K V ≤ k) :
-  f.generalized_eigenspace μ k = f.generalized_eigenspace μ (finrank K V) :=
-ker_pow_eq_ker_pow_finrank_of_le hk
-
-/-- If `f` maps a subspace `p` into itself, then the generalized eigenspace of the restriction
-    of `f` to `p` is the part of the generalized eigenspace of `f` that lies in `p`. -/
-lemma generalized_eigenspace_restrict
-  (f : End R M) (p : submodule R M) (k : ℕ) (μ : R) (hfp : ∀ (x : M), x ∈ p → f x ∈ p) :
-  generalized_eigenspace (linear_map.restrict f hfp) μ k =
-    submodule.comap p.subtype (f.generalized_eigenspace μ k) :=
-begin
-  simp only [generalized_eigenspace, order_hom.coe_fun_mk, ← linear_map.ker_comp],
-  induction k with k ih,
-  { rw [pow_zero, pow_zero, linear_map.one_eq_id],
-    apply (submodule.ker_subtype _).symm },
-  { erw [pow_succ', pow_succ', linear_map.ker_comp, linear_map.ker_comp, ih,
-      ← linear_map.ker_comp, linear_map.comp_assoc] },
-end
-
-/-- If `p` is an invariant submodule of an endomorphism `f`, then the `μ`-eigenspace of the
-restriction of `f` to `p` is a submodule of the `μ`-eigenspace of `f`. -/
-lemma eigenspace_restrict_le_eigenspace (f : End R M) {p : submodule R M}
-  (hfp : ∀ x ∈ p, f x ∈ p) (μ : R) :
-  (eigenspace (f.restrict hfp) μ).map p.subtype ≤ f.eigenspace μ :=
-begin
-  rintros a ⟨x, hx, rfl⟩,
-  simp only [set_like.mem_coe, mem_eigenspace_iff, linear_map.restrict_apply] at hx ⊢,
-  exact congr_arg coe hx
-end
-
-/-- Generalized eigenrange and generalized eigenspace for exponent `finrank K V` are disjoint. -/
-lemma generalized_eigenvec_disjoint_range_ker [finite_dimensional K V] (f : End K V) (μ : K) :
-  disjoint (f.generalized_eigenrange μ (finrank K V)) (f.generalized_eigenspace μ (finrank K V))  :=
-begin
-  have h := calc
-    submodule.comap ((f - algebra_map _ _ μ) ^ finrank K V)
-        (f.generalized_eigenspace μ (finrank K V))
-      = ((f - algebra_map _ _ μ) ^ finrank K V *
-          (f - algebra_map K (End K V) μ) ^ finrank K V).ker :
-        by { simpa only [generalized_eigenspace, order_hom.coe_fun_mk, ← linear_map.ker_comp] }
-  ... = f.generalized_eigenspace μ (finrank K V + finrank K V) :
-        by { rw ←pow_add, refl }
-  ... = f.generalized_eigenspace μ (finrank K V) :
-        by { rw generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le, linarith },
-  rw [disjoint, generalized_eigenrange, linear_map.range_eq_map, submodule.map_inf_eq_map_inf_comap,
-    top_inf_eq, h],
-  apply submodule.map_comap_le
-end
-
-/-- If an invariant subspace `p` of an endomorphism `f` is disjoint from the `μ`-eigenspace of `f`,
-then the restriction of `f` to `p` has trivial `μ`-eigenspace. -/
-lemma eigenspace_restrict_eq_bot {f : End R M} {p : submodule R M}
-  (hfp : ∀ x ∈ p, f x ∈ p) {μ : R} (hμp : disjoint (f.eigenspace μ) p) :
-  eigenspace (f.restrict hfp) μ = ⊥ :=
-begin
-  rw eq_bot_iff,
-  intros x hx,
-  simpa using hμp ⟨eigenspace_restrict_le_eigenspace f hfp μ ⟨x, hx, rfl⟩, x.prop⟩,
-end
-
-/-- The generalized eigenspace of an eigenvalue has positive dimension for positive exponents. -/
-lemma pos_finrank_generalized_eigenspace_of_has_eigenvalue [finite_dimensional K V]
-  {f : End K V} {k : ℕ} {μ : K} (hx : f.has_eigenvalue μ) (hk : 0 < k):
-  0 < finrank K (f.generalized_eigenspace μ k) :=
-calc
-    0 = finrank K (⊥ : submodule K V) : by rw finrank_bot
-  ... < finrank K (f.eigenspace μ) : submodule.finrank_lt_finrank_of_lt (bot_lt_iff_ne_bot.2 hx)
-  ... ≤ finrank K (f.generalized_eigenspace μ k) :
-    submodule.finrank_mono ((f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk))
-
-/-- A linear map maps a generalized eigenrange into itself. -/
-lemma map_generalized_eigenrange_le {f : End K V} {μ : K} {n : ℕ} :
-  submodule.map f (f.generalized_eigenrange μ n) ≤ f.generalized_eigenrange μ n :=
-calc submodule.map f (f.generalized_eigenrange μ n)
-       = (f * ((f - algebra_map _ _ μ) ^ n)).range : (linear_map.range_comp _ _).symm
-   ... = (((f - algebra_map _ _ μ) ^ n) * f).range : by rw algebra.mul_sub_algebra_map_pow_commutes
-   ... = submodule.map ((f - algebra_map _ _ μ) ^ n) f.range : linear_map.range_comp _ _
-   ... ≤ f.generalized_eigenrange μ n : linear_map.map_le_range
-
-/-- The generalized eigenvectors span the entire vector space (Lemma 8.21 of [axler2015]). -/
-lemma supr_generalized_eigenspace_eq_top [is_alg_closed K] [finite_dimensional K V] (f : End K V) :
-  (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤ :=
-begin
-  -- We prove the claim by strong induction on the dimension of the vector space.
-  unfreezingI { induction h_dim : finrank K V using nat.strong_induction_on
-  with n ih generalizing V },
-  cases n,
-  -- If the vector space is 0-dimensional, the result is trivial.
-  { rw ←top_le_iff,
-    simp only [finrank_eq_zero.1 (eq.trans finrank_top h_dim), bot_le] },
-  -- Otherwise the vector space is nontrivial.
-  { haveI : nontrivial V := finrank_pos_iff.1 (by { rw h_dim, apply nat.zero_lt_succ }),
-    -- Hence, `f` has an eigenvalue `μ₀`.
-    obtain ⟨μ₀, hμ₀⟩ : ∃ μ₀, f.has_eigenvalue μ₀ := exists_eigenvalue f,
-    -- We define `ES` to be the generalized eigenspace
-    let ES := f.generalized_eigenspace μ₀ (finrank K V),
-    -- and `ER` to be the generalized eigenrange.
-    let ER := f.generalized_eigenrange μ₀ (finrank K V),
-    -- `f` maps `ER` into itself.
-    have h_f_ER : ∀ (x : V), x ∈ ER → f x ∈ ER,
-      from λ x hx, map_generalized_eigenrange_le (submodule.mem_map_of_mem hx),
-    -- Therefore, we can define the restriction `f'` of `f` to `ER`.
-    let f' : End K ER := f.restrict h_f_ER,
-    -- The dimension of `ES` is positive
-    have h_dim_ES_pos : 0 < finrank K ES,
-    { dsimp only [ES],
-      rw h_dim,
-      apply pos_finrank_generalized_eigenspace_of_has_eigenvalue hμ₀ (nat.zero_lt_succ n) },
-    -- and the dimensions of `ES` and `ER` add up to `finrank K V`.
-    have h_dim_add : finrank K ER + finrank K ES = finrank K V,
-    { apply linear_map.finrank_range_add_finrank_ker },
-    -- Therefore the dimension `ER` mus be smaller than `finrank K V`.
-    have h_dim_ER : finrank K ER < n.succ, by linarith,
-    -- This allows us to apply the induction hypothesis on `ER`:
-    have ih_ER : (⨆ (μ : K) (k : ℕ), f'.generalized_eigenspace μ k) = ⊤,
-      from ih (finrank K ER) h_dim_ER f' rfl,
-    -- The induction hypothesis gives us a statement about subspaces of `ER`. We can transfer this
-    -- to a statement about subspaces of `V` via `submodule.subtype`:
-    have ih_ER' : (⨆ (μ : K) (k : ℕ), (f'.generalized_eigenspace μ k).map ER.subtype) = ER,
-      by simp only [(submodule.map_supr _ _).symm, ih_ER, submodule.map_subtype_top ER],
-    -- Moreover, every generalized eigenspace of `f'` is contained in the corresponding generalized
-    -- eigenspace of `f`.
-    have hff' : ∀ μ k,
-        (f'.generalized_eigenspace μ k).map ER.subtype ≤ f.generalized_eigenspace μ k,
-    { intros,
-      rw generalized_eigenspace_restrict,
-      apply submodule.map_comap_le },
-    -- It follows that `ER` is contained in the span of all generalized eigenvectors.
-    have hER : ER ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
-    { rw ← ih_ER',
-      exact supr₂_mono hff' },
-    -- `ES` is contained in this span by definition.
-    have hES : ES ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
-      from le_trans
-        (le_supr (λ k, f.generalized_eigenspace μ₀ k) (finrank K V))
-        (le_supr (λ (μ : K), ⨆ (k : ℕ), f.generalized_eigenspace μ k) μ₀),
-    -- Moreover, we know that `ER` and `ES` are disjoint.
-    have h_disjoint : disjoint ER ES,
-      from generalized_eigenvec_disjoint_range_ker f μ₀,
-    -- Since the dimensions of `ER` and `ES` add up to the dimension of `V`, it follows that the
-    -- span of all generalized eigenvectors is all of `V`.
-    show (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤,
-    { rw [←top_le_iff, ←submodule.eq_top_of_disjoint ER ES h_dim_add h_disjoint],
-      apply sup_le hER hES } }
-end
-
-end End
-end module
diff --git a/src/linear_algebra/eigenspace/basic.lean b/src/linear_algebra/eigenspace/basic.lean
new file mode 100644
index 0000000000000..8de6594e40b3b
--- /dev/null
+++ b/src/linear_algebra/eigenspace/basic.lean
@@ -0,0 +1,444 @@
+/-
+Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+
+import algebra.algebra.spectrum
+import linear_algebra.general_linear_group
+import linear_algebra.finite_dimensional
+
+
+/-!
+# Eigenvectors and eigenvalues
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines eigenspaces, eigenvalues, and eigenvalues, as well as their generalized
+counterparts. We follow Axler's approach [axler2015] because it allows us to derive many properties
+without choosing a basis and without using matrices.
+
+An eigenspace of a linear map `f` for a scalar `μ` is the kernel of the map `(f - μ • id)`. The
+nonzero elements of an eigenspace are eigenvectors `x`. They have the property `f x = μ • x`. If
+there are eigenvectors for a scalar `μ`, the scalar `μ` is called an eigenvalue.
+
+There is no consensus in the literature whether `0` is an eigenvector. Our definition of
+`has_eigenvector` permits only nonzero vectors. For an eigenvector `x` that may also be `0`, we
+write `x ∈ f.eigenspace μ`.
+
+A generalized eigenspace of a linear map `f` for a natural number `k` and a scalar `μ` is the kernel
+of the map `(f - μ • id) ^ k`. The nonzero elements of a generalized eigenspace are generalized
+eigenvectors `x`. If there are generalized eigenvectors for a natural number `k` and a scalar `μ`,
+the scalar `μ` is called a generalized eigenvalue.
+
+The fact that the eigenvalues are the roots of the minimal polynomial is proved in
+`linear_algebra.eigenspace.minpoly`.
+
+The existence of eigenvalues over an algebraically closed field
+(and the fact that the generalized eigenspaces then span) is deferred to
+`linear_algebra.eigenspace.is_alg_closed`.
+
+## References
+
+* [Sheldon Axler, *Linear Algebra Done Right*][axler2015]
+* https://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors
+
+## Tags
+
+eigenspace, eigenvector, eigenvalue, eigen
+-/
+
+universes u v w
+
+namespace module
+namespace End
+
+open finite_dimensional
+
+variables {K R : Type v} {V M : Type w}
+  [comm_ring R] [add_comm_group M] [module R M] [field K] [add_comm_group V] [module K V]
+
+/-- The submodule `eigenspace f μ` for a linear map `f` and a scalar `μ` consists of all vectors `x`
+    such that `f x = μ • x`. (Def 5.36 of [axler2015])-/
+def eigenspace (f : End R M) (μ : R) : submodule R M :=
+(f - algebra_map R (End R M) μ).ker
+
+@[simp] lemma eigenspace_zero (f : End R M) : f.eigenspace 0 = f.ker :=
+by simp [eigenspace]
+
+/-- A nonzero element of an eigenspace is an eigenvector. (Def 5.7 of [axler2015]) -/
+def has_eigenvector (f : End R M) (μ : R) (x : M) : Prop :=
+x ∈ eigenspace f μ ∧ x ≠ 0
+
+/-- A scalar `μ` is an eigenvalue for a linear map `f` if there are nonzero vectors `x`
+    such that `f x = μ • x`. (Def 5.5 of [axler2015]) -/
+def has_eigenvalue (f : End R M) (a : R) : Prop :=
+eigenspace f a ≠ ⊥
+
+/-- The eigenvalues of the endomorphism `f`, as a subtype of `R`. -/
+def eigenvalues (f : End R M) : Type* := {μ : R // f.has_eigenvalue μ}
+
+instance (f : End R M) : has_coe f.eigenvalues R := coe_subtype
+
+lemma has_eigenvalue_of_has_eigenvector {f : End R M} {μ : R} {x : M} (h : has_eigenvector f μ x) :
+  has_eigenvalue f μ :=
+begin
+  rw [has_eigenvalue, submodule.ne_bot_iff],
+  use x, exact h,
+end
+
+lemma mem_eigenspace_iff {f : End R M} {μ : R} {x : M} : x ∈ eigenspace f μ ↔ f x = μ • x :=
+by rw [eigenspace, linear_map.mem_ker, linear_map.sub_apply, algebra_map_End_apply,
+  sub_eq_zero]
+
+lemma has_eigenvector.apply_eq_smul {f : End R M} {μ : R} {x : M} (hx : f.has_eigenvector μ x) :
+  f x = μ • x :=
+mem_eigenspace_iff.mp hx.1
+
+lemma has_eigenvalue.exists_has_eigenvector {f : End R M} {μ : R} (hμ : f.has_eigenvalue μ) :
+  ∃ v, f.has_eigenvector μ v :=
+submodule.exists_mem_ne_zero_of_ne_bot hμ
+
+lemma mem_spectrum_of_has_eigenvalue {f : End R M} {μ : R} (hμ : has_eigenvalue f μ) :
+  μ ∈ spectrum R f :=
+begin
+  refine spectrum.mem_iff.mpr (λ h_unit, _),
+  set f' := linear_map.general_linear_group.to_linear_equiv h_unit.unit,
+  rcases hμ.exists_has_eigenvector with ⟨v, hv⟩,
+  refine hv.2 ((linear_map.ker_eq_bot'.mp f'.ker) v (_ : μ • v - f v = 0)),
+  rw [hv.apply_eq_smul, sub_self]
+end
+
+lemma has_eigenvalue_iff_mem_spectrum [finite_dimensional K V] {f : End K V} {μ : K} :
+  f.has_eigenvalue μ ↔ μ ∈ spectrum K f :=
+iff.intro mem_spectrum_of_has_eigenvalue
+  (λ h, by rwa [spectrum.mem_iff, is_unit.sub_iff, linear_map.is_unit_iff_ker_eq_bot] at h)
+
+lemma eigenspace_div (f : End K V) (a b : K) (hb : b ≠ 0) :
+  eigenspace f (a / b) = (b • f - algebra_map K (End K V) a).ker :=
+calc
+  eigenspace f (a / b) = eigenspace f (b⁻¹ * a) : by { rw [div_eq_mul_inv, mul_comm] }
+  ... = (f - (b⁻¹ * a) • linear_map.id).ker : rfl
+  ... = (f - b⁻¹ • a • linear_map.id).ker : by rw smul_smul
+  ... = (f - b⁻¹ • algebra_map K (End K V) a).ker : rfl
+  ... = (b • (f - b⁻¹ • algebra_map K (End K V) a)).ker : by rw linear_map.ker_smul _ b hb
+  ... = (b • f - algebra_map K (End K V) a).ker : by rw [smul_sub, smul_inv_smul₀ hb]
+
+/-- The eigenspaces of a linear operator form an independent family of subspaces of `V`.  That is,
+any eigenspace has trivial intersection with the span of all the other eigenspaces. -/
+lemma eigenspaces_independent (f : End K V) : complete_lattice.independent f.eigenspace :=
+begin
+  classical,
+  -- Define an operation from `Π₀ μ : K, f.eigenspace μ`, the vector space of of finitely-supported
+  -- choices of an eigenvector from each eigenspace, to `V`, by sending a collection to its sum.
+  let S : @linear_map K K _ _ (ring_hom.id K) (Π₀ μ : K, f.eigenspace μ) V
+    (@dfinsupp.add_comm_monoid K (λ μ, f.eigenspace μ) _) _
+    (@dfinsupp.module K _ (λ μ, f.eigenspace μ) _ _ _) _ :=
+    @dfinsupp.lsum K K ℕ _ V _ _ _ _ _ _ _ _ _
+    (λ μ, (f.eigenspace μ).subtype),
+  -- We need to show that if a finitely-supported collection `l` of representatives of the
+  -- eigenspaces has sum `0`, then it itself is zero.
+  suffices : ∀ l : Π₀ μ, f.eigenspace μ, S l = 0 → l = 0,
+  { rw complete_lattice.independent_iff_dfinsupp_lsum_injective,
+    change function.injective S,
+    rw ← @linear_map.ker_eq_bot K K (Π₀ μ, (f.eigenspace μ)) V _ _
+      (@dfinsupp.add_comm_group K (λ μ, f.eigenspace μ) _),
+    rw eq_bot_iff,
+    exact this },
+  intros l hl,
+  -- We apply induction on the finite set of eigenvalues from which `l` selects a nonzero
+  -- eigenvector, i.e. on the support of `l`.
+  induction h_l_support : l.support using finset.induction with μ₀ l_support' hμ₀ ih generalizing l,
+  -- If the support is empty, all coefficients are zero and we are done.
+  { exact dfinsupp.support_eq_empty.1 h_l_support },
+  -- Now assume that the support of `l` contains at least one eigenvalue `μ₀`. We define a new
+  -- collection of representatives `l'` to apply the induction hypothesis on later. The collection
+  -- of representatives `l'` is derived from `l` by multiplying the coefficient of the eigenvector
+  -- with eigenvalue `μ` by `μ - μ₀`.
+  { let l' := dfinsupp.map_range.linear_map
+      (λ μ, (μ - μ₀) • @linear_map.id K (f.eigenspace μ) _ _ _) l,
+    -- The support of `l'` is the support of `l` without `μ₀`.
+    have h_l_support' : l'.support = l_support',
+    { rw [← finset.erase_insert hμ₀, ← h_l_support],
+      ext a,
+      have : ¬(a = μ₀ ∨ l a = 0) ↔ ¬a = μ₀ ∧ ¬l a = 0 := not_or_distrib,
+      simp only [l', dfinsupp.map_range.linear_map_apply, dfinsupp.map_range_apply,
+        dfinsupp.mem_support_iff, finset.mem_erase, id.def, linear_map.id_coe,
+        linear_map.smul_apply, ne.def, smul_eq_zero, sub_eq_zero, this] },
+    -- The entries of `l'` add up to `0`.
+    have total_l' : S l' = 0,
+    { let g := f - algebra_map K (End K V) μ₀,
+      let a : Π₀ μ : K, V := dfinsupp.map_range.linear_map (λ μ, (f.eigenspace μ).subtype) l,
+      calc S l'
+          = dfinsupp.lsum ℕ (λ μ, (f.eigenspace μ).subtype.comp ((μ - μ₀) • linear_map.id)) l : _
+      ... = dfinsupp.lsum ℕ (λ μ, g.comp (f.eigenspace μ).subtype) l : _
+      ... = dfinsupp.lsum ℕ (λ μ, g) a : _
+      ... = g (dfinsupp.lsum ℕ (λ μ, (linear_map.id : V →ₗ[K] V)) a) : _
+      ... = g (S l) : _
+      ... = 0 : by rw [hl, g.map_zero],
+      { exact dfinsupp.sum_map_range_index.linear_map },
+      { congr,
+        ext μ v,
+        simp only [g, eq_self_iff_true, function.comp_app, id.def, linear_map.coe_comp,
+          linear_map.id_coe, linear_map.smul_apply, linear_map.sub_apply,
+          module.algebra_map_End_apply, sub_left_inj, sub_smul, submodule.coe_smul_of_tower,
+          submodule.coe_sub, submodule.subtype_apply, mem_eigenspace_iff.1 v.prop], },
+      { rw dfinsupp.sum_map_range_index.linear_map },
+      { simp only [dfinsupp.sum_add_hom_apply, linear_map.id_coe, linear_map.map_dfinsupp_sum,
+          id.def, linear_map.to_add_monoid_hom_coe, dfinsupp.lsum_apply_apply], },
+      { congr,
+        simp only [S, a, dfinsupp.sum_map_range_index.linear_map, linear_map.id_comp] } },
+    -- Therefore, by the induction hypothesis, all entries of `l'` are zero.
+    have l'_eq_0 := ih l' total_l' h_l_support',
+    -- By the definition of `l'`, this means that `(μ - μ₀) • l μ = 0` for all `μ`.
+    have h_smul_eq_0 : ∀ μ, (μ - μ₀) • l μ = 0,
+    { intro μ,
+      calc (μ - μ₀) • l μ = l' μ : by simp only [l', linear_map.id_coe, id.def,
+        linear_map.smul_apply, dfinsupp.map_range_apply, dfinsupp.map_range.linear_map_apply]
+      ... = 0 : by { rw [l'_eq_0], refl } },
+    -- Thus, the eigenspace-representatives in `l` for all `μ ≠ μ₀` are `0`.
+    have h_lμ_eq_0 : ∀ μ : K, μ ≠ μ₀ → l μ = 0,
+    { intros μ hμ,
+      apply or_iff_not_imp_left.1 (smul_eq_zero.1 (h_smul_eq_0 μ)),
+      rwa [sub_eq_zero] },
+    -- So if we sum over all these representatives, we obtain `0`.
+    have h_sum_l_support'_eq_0 : finset.sum l_support' (λ μ, (l μ : V)) = 0,
+    { rw ←finset.sum_const_zero,
+      apply finset.sum_congr rfl,
+      intros μ hμ,
+      rw [submodule.coe_eq_zero, h_lμ_eq_0],
+      rintro rfl,
+      exact hμ₀ hμ },
+    -- The only potentially nonzero eigenspace-representative in `l` is the one corresponding to
+    -- `μ₀`. But since the overall sum is `0` by assumption, this representative must also be `0`.
+    have : l μ₀ = 0,
+    { simp only [S, dfinsupp.lsum_apply_apply, dfinsupp.sum_add_hom_apply,
+        linear_map.to_add_monoid_hom_coe, dfinsupp.sum, h_l_support, submodule.subtype_apply,
+        submodule.coe_eq_zero, finset.sum_insert hμ₀, h_sum_l_support'_eq_0, add_zero] at hl,
+      exact hl },
+    -- Thus, all coefficients in `l` are `0`.
+    show l = 0,
+    { ext μ,
+      by_cases h_cases : μ = μ₀,
+      { rwa [h_cases, set_like.coe_eq_coe, dfinsupp.coe_zero, pi.zero_apply] },
+      exact congr_arg (coe : _ → V) (h_lμ_eq_0 μ h_cases) }}
+end
+
+/-- Eigenvectors corresponding to distinct eigenvalues of a linear operator are linearly
+    independent. (Lemma 5.10 of [axler2015])
+
+    We use the eigenvalues as indexing set to ensure that there is only one eigenvector for each
+    eigenvalue in the image of `xs`. -/
+lemma eigenvectors_linear_independent (f : End K V) (μs : set K) (xs : μs → V)
+  (h_eigenvec : ∀ μ : μs, f.has_eigenvector μ (xs μ)) :
+  linear_independent K xs :=
+complete_lattice.independent.linear_independent _
+  (f.eigenspaces_independent.comp subtype.coe_injective)
+  (λ μ, (h_eigenvec μ).1) (λ μ, (h_eigenvec μ).2)
+
+/-- The generalized eigenspace for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
+kernel of `(f - μ • id) ^ k`. (Def 8.10 of [axler2015]). Furthermore, a generalized eigenspace for
+some exponent `k` is contained in the generalized eigenspace for exponents larger than `k`. -/
+def generalized_eigenspace (f : End R M) (μ : R) : ℕ →o submodule R M :=
+{ to_fun    := λ k, ((f - algebra_map R (End R M) μ) ^ k).ker,
+  monotone' := λ k m hm,
+  begin
+    simp only [← pow_sub_mul_pow _ hm],
+    exact linear_map.ker_le_ker_comp
+      ((f - algebra_map R (End R M) μ) ^ k) ((f - algebra_map R (End R M) μ) ^ (m - k)),
+  end }
+
+@[simp] lemma mem_generalized_eigenspace (f : End R M) (μ : R) (k : ℕ) (m : M) :
+  m ∈ f.generalized_eigenspace μ k ↔ ((f - μ • 1)^k) m = 0 :=
+iff.rfl
+
+@[simp] lemma generalized_eigenspace_zero (f : End R M) (k : ℕ) :
+  f.generalized_eigenspace 0 k = (f^k).ker :=
+by simp [module.End.generalized_eigenspace]
+
+/-- A nonzero element of a generalized eigenspace is a generalized eigenvector.
+    (Def 8.9 of [axler2015])-/
+def has_generalized_eigenvector (f : End R M) (μ : R) (k : ℕ) (x : M) : Prop :=
+x ≠ 0 ∧ x ∈ generalized_eigenspace f μ k
+
+/-- A scalar `μ` is a generalized eigenvalue for a linear map `f` and an exponent `k ∈ ℕ` if there
+    are generalized eigenvectors for `f`, `k`, and `μ`. -/
+def has_generalized_eigenvalue (f : End R M) (μ : R) (k : ℕ) : Prop :=
+generalized_eigenspace f μ k ≠ ⊥
+
+/-- The generalized eigenrange for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
+    range of `(f - μ • id) ^ k`. -/
+def generalized_eigenrange (f : End R M) (μ : R) (k : ℕ) : submodule R M :=
+((f - algebra_map R (End R M) μ) ^ k).range
+
+/-- The exponent of a generalized eigenvalue is never 0. -/
+lemma exp_ne_zero_of_has_generalized_eigenvalue {f : End R M} {μ : R} {k : ℕ}
+  (h : f.has_generalized_eigenvalue μ k) : k ≠ 0 :=
+begin
+  rintro rfl,
+  exact h linear_map.ker_id
+end
+
+/-- The union of the kernels of `(f - μ • id) ^ k` over all `k`. -/
+def maximal_generalized_eigenspace (f : End R M) (μ : R) : submodule R M :=
+⨆ k, f.generalized_eigenspace μ k
+
+lemma generalized_eigenspace_le_maximal (f : End R M) (μ : R) (k : ℕ) :
+  f.generalized_eigenspace μ k ≤ f.maximal_generalized_eigenspace μ :=
+le_supr _ _
+
+@[simp] lemma mem_maximal_generalized_eigenspace (f : End R M) (μ : R) (m : M) :
+  m ∈ f.maximal_generalized_eigenspace μ ↔ ∃ (k : ℕ), ((f - μ • 1)^k) m = 0 :=
+by simp only [maximal_generalized_eigenspace, ← mem_generalized_eigenspace,
+  submodule.mem_supr_of_chain]
+
+/-- If there exists a natural number `k` such that the kernel of `(f - μ • id) ^ k` is the
+maximal generalized eigenspace, then this value is the least such `k`. If not, this value is not
+meaningful. -/
+noncomputable def maximal_generalized_eigenspace_index (f : End R M) (μ : R) :=
+monotonic_sequence_limit_index (f.generalized_eigenspace μ)
+
+/-- For an endomorphism of a Noetherian module, the maximal eigenspace is always of the form kernel
+`(f - μ • id) ^ k` for some `k`. -/
+lemma maximal_generalized_eigenspace_eq [h : is_noetherian R M] (f : End R M) (μ : R) :
+  maximal_generalized_eigenspace f μ =
+  f.generalized_eigenspace μ (maximal_generalized_eigenspace_index f μ) :=
+begin
+  rw is_noetherian_iff_well_founded at h,
+  exact (well_founded.supr_eq_monotonic_sequence_limit h (f.generalized_eigenspace μ) : _),
+end
+
+/-- A generalized eigenvalue for some exponent `k` is also
+    a generalized eigenvalue for exponents larger than `k`. -/
+lemma has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le
+  {f : End R M} {μ : R} {k : ℕ} {m : ℕ} (hm : k ≤ m) (hk : f.has_generalized_eigenvalue μ k) :
+  f.has_generalized_eigenvalue μ m :=
+begin
+  unfold has_generalized_eigenvalue at *,
+  contrapose! hk,
+  rw [←le_bot_iff, ←hk],
+  exact (f.generalized_eigenspace μ).monotone hm,
+end
+
+/-- The eigenspace is a subspace of the generalized eigenspace. -/
+lemma eigenspace_le_generalized_eigenspace {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
+  f.eigenspace μ ≤ f.generalized_eigenspace μ k :=
+(f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk)
+
+/-- All eigenvalues are generalized eigenvalues. -/
+lemma has_generalized_eigenvalue_of_has_eigenvalue
+  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) (hμ : f.has_eigenvalue μ) :
+  f.has_generalized_eigenvalue μ k :=
+begin
+  apply has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le hk,
+  rw [has_generalized_eigenvalue, generalized_eigenspace, order_hom.coe_fun_mk, pow_one],
+  exact hμ,
+end
+
+/-- All generalized eigenvalues are eigenvalues. -/
+lemma has_eigenvalue_of_has_generalized_eigenvalue
+  {f : End R M} {μ : R} {k : ℕ} (hμ : f.has_generalized_eigenvalue μ k) :
+  f.has_eigenvalue μ :=
+begin
+  intros contra, apply hμ,
+  erw linear_map.ker_eq_bot at ⊢ contra, rw linear_map.coe_pow,
+  exact function.injective.iterate contra k,
+end
+
+/-- Generalized eigenvalues are actually just eigenvalues. -/
+@[simp] lemma has_generalized_eigenvalue_iff_has_eigenvalue
+  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
+  f.has_generalized_eigenvalue μ k ↔ f.has_eigenvalue μ :=
+⟨has_eigenvalue_of_has_generalized_eigenvalue, has_generalized_eigenvalue_of_has_eigenvalue hk⟩
+
+/-- Every generalized eigenvector is a generalized eigenvector for exponent `finrank K V`.
+    (Lemma 8.11 of [axler2015]) -/
+lemma generalized_eigenspace_le_generalized_eigenspace_finrank
+  [finite_dimensional K V] (f : End K V) (μ : K) (k : ℕ) :
+  f.generalized_eigenspace μ k ≤ f.generalized_eigenspace μ (finrank K V) :=
+ker_pow_le_ker_pow_finrank _ _
+
+/-- Generalized eigenspaces for exponents at least `finrank K V` are equal to each other. -/
+lemma generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le [finite_dimensional K V]
+  (f : End K V) (μ : K) {k : ℕ} (hk : finrank K V ≤ k) :
+  f.generalized_eigenspace μ k = f.generalized_eigenspace μ (finrank K V) :=
+ker_pow_eq_ker_pow_finrank_of_le hk
+
+/-- If `f` maps a subspace `p` into itself, then the generalized eigenspace of the restriction
+    of `f` to `p` is the part of the generalized eigenspace of `f` that lies in `p`. -/
+lemma generalized_eigenspace_restrict
+  (f : End R M) (p : submodule R M) (k : ℕ) (μ : R) (hfp : ∀ (x : M), x ∈ p → f x ∈ p) :
+  generalized_eigenspace (linear_map.restrict f hfp) μ k =
+    submodule.comap p.subtype (f.generalized_eigenspace μ k) :=
+begin
+  simp only [generalized_eigenspace, order_hom.coe_fun_mk, ← linear_map.ker_comp],
+  induction k with k ih,
+  { rw [pow_zero, pow_zero, linear_map.one_eq_id],
+    apply (submodule.ker_subtype _).symm },
+  { erw [pow_succ', pow_succ', linear_map.ker_comp, linear_map.ker_comp, ih,
+      ← linear_map.ker_comp, linear_map.comp_assoc] },
+end
+
+/-- If `p` is an invariant submodule of an endomorphism `f`, then the `μ`-eigenspace of the
+restriction of `f` to `p` is a submodule of the `μ`-eigenspace of `f`. -/
+lemma eigenspace_restrict_le_eigenspace (f : End R M) {p : submodule R M}
+  (hfp : ∀ x ∈ p, f x ∈ p) (μ : R) :
+  (eigenspace (f.restrict hfp) μ).map p.subtype ≤ f.eigenspace μ :=
+begin
+  rintros a ⟨x, hx, rfl⟩,
+  simp only [set_like.mem_coe, mem_eigenspace_iff, linear_map.restrict_apply] at hx ⊢,
+  exact congr_arg coe hx
+end
+
+/-- Generalized eigenrange and generalized eigenspace for exponent `finrank K V` are disjoint. -/
+lemma generalized_eigenvec_disjoint_range_ker [finite_dimensional K V] (f : End K V) (μ : K) :
+  disjoint (f.generalized_eigenrange μ (finrank K V)) (f.generalized_eigenspace μ (finrank K V))  :=
+begin
+  have h := calc
+    submodule.comap ((f - algebra_map _ _ μ) ^ finrank K V)
+        (f.generalized_eigenspace μ (finrank K V))
+      = ((f - algebra_map _ _ μ) ^ finrank K V *
+          (f - algebra_map K (End K V) μ) ^ finrank K V).ker :
+        by { simpa only [generalized_eigenspace, order_hom.coe_fun_mk, ← linear_map.ker_comp] }
+  ... = f.generalized_eigenspace μ (finrank K V + finrank K V) :
+        by { rw ←pow_add, refl }
+  ... = f.generalized_eigenspace μ (finrank K V) :
+        by { rw generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le, linarith },
+  rw [disjoint_iff_inf_le, generalized_eigenrange, linear_map.range_eq_map,
+    submodule.map_inf_eq_map_inf_comap, top_inf_eq, h],
+  apply submodule.map_comap_le
+end
+
+/-- If an invariant subspace `p` of an endomorphism `f` is disjoint from the `μ`-eigenspace of `f`,
+then the restriction of `f` to `p` has trivial `μ`-eigenspace. -/
+lemma eigenspace_restrict_eq_bot {f : End R M} {p : submodule R M}
+  (hfp : ∀ x ∈ p, f x ∈ p) {μ : R} (hμp : disjoint (f.eigenspace μ) p) :
+  eigenspace (f.restrict hfp) μ = ⊥ :=
+begin
+  rw eq_bot_iff,
+  intros x hx,
+  simpa using hμp.le_bot ⟨eigenspace_restrict_le_eigenspace f hfp μ ⟨x, hx, rfl⟩, x.prop⟩,
+end
+
+/-- The generalized eigenspace of an eigenvalue has positive dimension for positive exponents. -/
+lemma pos_finrank_generalized_eigenspace_of_has_eigenvalue [finite_dimensional K V]
+  {f : End K V} {k : ℕ} {μ : K} (hx : f.has_eigenvalue μ) (hk : 0 < k):
+  0 < finrank K (f.generalized_eigenspace μ k) :=
+calc
+    0 = finrank K (⊥ : submodule K V) : by rw finrank_bot
+  ... < finrank K (f.eigenspace μ) : submodule.finrank_lt_finrank_of_lt (bot_lt_iff_ne_bot.2 hx)
+  ... ≤ finrank K (f.generalized_eigenspace μ k) :
+    submodule.finrank_mono ((f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk))
+
+/-- A linear map maps a generalized eigenrange into itself. -/
+lemma map_generalized_eigenrange_le {f : End K V} {μ : K} {n : ℕ} :
+  submodule.map f (f.generalized_eigenrange μ n) ≤ f.generalized_eigenrange μ n :=
+calc submodule.map f (f.generalized_eigenrange μ n)
+       = (f * ((f - algebra_map _ _ μ) ^ n)).range : (linear_map.range_comp _ _).symm
+   ... = (((f - algebra_map _ _ μ) ^ n) * f).range : by rw algebra.mul_sub_algebra_map_pow_commutes
+   ... = submodule.map ((f - algebra_map _ _ μ) ^ n) f.range : linear_map.range_comp _ _
+   ... ≤ f.generalized_eigenrange μ n : linear_map.map_le_range
+
+end End
+end module
diff --git a/src/linear_algebra/eigenspace/is_alg_closed.lean b/src/linear_algebra/eigenspace/is_alg_closed.lean
new file mode 100644
index 0000000000000..1b896aa946d82
--- /dev/null
+++ b/src/linear_algebra/eigenspace/is_alg_closed.lean
@@ -0,0 +1,118 @@
+/-
+Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+
+import linear_algebra.eigenspace.basic
+import field_theory.is_alg_closed.spectrum
+
+/-!
+# Eigenvectors and eigenvalues over algebraically closed fields.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+* Every linear operator on a vector space over an algebraically closed field has an eigenvalue.
+* The generalized eigenvectors span the entire vector space.
+
+## References
+
+* [Sheldon Axler, *Linear Algebra Done Right*][axler2015]
+* https://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors
+
+## Tags
+
+eigenspace, eigenvector, eigenvalue, eigen
+-/
+
+universes u v w
+
+namespace module
+namespace End
+
+open finite_dimensional
+
+variables {K : Type v} {V : Type w} [field K] [add_comm_group V] [module K V]
+
+/-- Every linear operator on a vector space over an algebraically closed field has
+    an eigenvalue. -/
+-- This is Lemma 5.21 of [axler2015], although we are no longer following that proof.
+lemma exists_eigenvalue [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
+  ∃ (c : K), f.has_eigenvalue c :=
+by { simp_rw has_eigenvalue_iff_mem_spectrum,
+     exact spectrum.nonempty_of_is_alg_closed_of_finite_dimensional K f }
+
+noncomputable instance [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
+  inhabited f.eigenvalues :=
+⟨⟨f.exists_eigenvalue.some, f.exists_eigenvalue.some_spec⟩⟩
+
+/-- The generalized eigenvectors span the entire vector space (Lemma 8.21 of [axler2015]). -/
+lemma supr_generalized_eigenspace_eq_top [is_alg_closed K] [finite_dimensional K V] (f : End K V) :
+  (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤ :=
+begin
+  -- We prove the claim by strong induction on the dimension of the vector space.
+  unfreezingI { induction h_dim : finrank K V using nat.strong_induction_on
+  with n ih generalizing V },
+  cases n,
+  -- If the vector space is 0-dimensional, the result is trivial.
+  { rw ←top_le_iff,
+    simp only [finrank_eq_zero.1 (eq.trans (finrank_top _ _) h_dim), bot_le] },
+  -- Otherwise the vector space is nontrivial.
+  { haveI : nontrivial V := finrank_pos_iff.1 (by { rw h_dim, apply nat.zero_lt_succ }),
+    -- Hence, `f` has an eigenvalue `μ₀`.
+    obtain ⟨μ₀, hμ₀⟩ : ∃ μ₀, f.has_eigenvalue μ₀ := exists_eigenvalue f,
+    -- We define `ES` to be the generalized eigenspace
+    let ES := f.generalized_eigenspace μ₀ (finrank K V),
+    -- and `ER` to be the generalized eigenrange.
+    let ER := f.generalized_eigenrange μ₀ (finrank K V),
+    -- `f` maps `ER` into itself.
+    have h_f_ER : ∀ (x : V), x ∈ ER → f x ∈ ER,
+      from λ x hx, map_generalized_eigenrange_le (submodule.mem_map_of_mem hx),
+    -- Therefore, we can define the restriction `f'` of `f` to `ER`.
+    let f' : End K ER := f.restrict h_f_ER,
+    -- The dimension of `ES` is positive
+    have h_dim_ES_pos : 0 < finrank K ES,
+    { dsimp only [ES],
+      rw h_dim,
+      apply pos_finrank_generalized_eigenspace_of_has_eigenvalue hμ₀ (nat.zero_lt_succ n) },
+    -- and the dimensions of `ES` and `ER` add up to `finrank K V`.
+    have h_dim_add : finrank K ER + finrank K ES = finrank K V,
+    { apply linear_map.finrank_range_add_finrank_ker },
+    -- Therefore the dimension `ER` mus be smaller than `finrank K V`.
+    have h_dim_ER : finrank K ER < n.succ, by linarith,
+    -- This allows us to apply the induction hypothesis on `ER`:
+    have ih_ER : (⨆ (μ : K) (k : ℕ), f'.generalized_eigenspace μ k) = ⊤,
+      from ih (finrank K ER) h_dim_ER f' rfl,
+    -- The induction hypothesis gives us a statement about subspaces of `ER`. We can transfer this
+    -- to a statement about subspaces of `V` via `submodule.subtype`:
+    have ih_ER' : (⨆ (μ : K) (k : ℕ), (f'.generalized_eigenspace μ k).map ER.subtype) = ER,
+      by simp only [(submodule.map_supr _ _).symm, ih_ER, submodule.map_subtype_top ER],
+    -- Moreover, every generalized eigenspace of `f'` is contained in the corresponding generalized
+    -- eigenspace of `f`.
+    have hff' : ∀ μ k,
+        (f'.generalized_eigenspace μ k).map ER.subtype ≤ f.generalized_eigenspace μ k,
+    { intros,
+      rw generalized_eigenspace_restrict,
+      apply submodule.map_comap_le },
+    -- It follows that `ER` is contained in the span of all generalized eigenvectors.
+    have hER : ER ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
+    { rw ← ih_ER',
+      exact supr₂_mono hff' },
+    -- `ES` is contained in this span by definition.
+    have hES : ES ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
+      from le_trans
+        (le_supr (λ k, f.generalized_eigenspace μ₀ k) (finrank K V))
+        (le_supr (λ (μ : K), ⨆ (k : ℕ), f.generalized_eigenspace μ k) μ₀),
+    -- Moreover, we know that `ER` and `ES` are disjoint.
+    have h_disjoint : disjoint ER ES,
+      from generalized_eigenvec_disjoint_range_ker f μ₀,
+    -- Since the dimensions of `ER` and `ES` add up to the dimension of `V`, it follows that the
+    -- span of all generalized eigenvectors is all of `V`.
+    show (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤,
+    { rw [←top_le_iff, ←submodule.eq_top_of_disjoint ER ES h_dim_add h_disjoint],
+      apply sup_le hER hES } }
+end
+
+end End
+end module
diff --git a/src/linear_algebra/eigenspace/minpoly.lean b/src/linear_algebra/eigenspace/minpoly.lean
new file mode 100644
index 0000000000000..ada135c892033
--- /dev/null
+++ b/src/linear_algebra/eigenspace/minpoly.lean
@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+
+import linear_algebra.eigenspace.basic
+import field_theory.minpoly.field
+
+/-!
+# Eigenvalues are the roots of the minimal polynomial.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Tags
+
+eigenvalue, minimal polynomial
+-/
+
+universes u v w
+
+namespace module
+namespace End
+
+open polynomial finite_dimensional
+open_locale polynomial
+
+variables {K : Type v} {V : Type w} [field K] [add_comm_group V] [module K V]
+
+lemma eigenspace_aeval_polynomial_degree_1
+  (f : End K V) (q : K[X]) (hq : degree q = 1) :
+  eigenspace f (- q.coeff 0 / q.leading_coeff) = (aeval f q).ker :=
+calc
+  eigenspace f (- q.coeff 0 / q.leading_coeff)
+      = (q.leading_coeff • f - algebra_map K (End K V) (- q.coeff 0)).ker
+    : by { rw eigenspace_div, intro h, rw leading_coeff_eq_zero_iff_deg_eq_bot.1 h at hq, cases hq }
+  ... = (aeval f (C q.leading_coeff * X + C (q.coeff 0))).ker
+    : by { rw [C_mul', aeval_def], simp [algebra_map, algebra.to_ring_hom], }
+  ... = (aeval f q).ker
+    : by rwa ← eq_X_add_C_of_degree_eq_one
+
+lemma ker_aeval_ring_hom'_unit_polynomial
+  (f : End K V) (c : (K[X])ˣ) :
+  (aeval f (c : K[X])).ker = ⊥ :=
+begin
+  rw polynomial.eq_C_of_degree_eq_zero (degree_coe_units c),
+  simp only [aeval_def, eval₂_C],
+  apply ker_algebra_map_End,
+  apply coeff_coe_units_zero_ne_zero c
+end
+
+theorem aeval_apply_of_has_eigenvector {f : End K V}
+  {p : K[X]} {μ : K} {x : V} (h : f.has_eigenvector μ x) :
+  aeval f p x = (p.eval μ) • x :=
+begin
+  apply p.induction_on,
+  { intro a, simp [module.algebra_map_End_apply] },
+  { intros p q hp hq, simp [hp, hq, add_smul] },
+  { intros n a hna,
+    rw [mul_comm, pow_succ, mul_assoc, alg_hom.map_mul, linear_map.mul_apply, mul_comm, hna],
+    simp only [mem_eigenspace_iff.1 h.1, smul_smul, aeval_X, eval_mul, eval_C, eval_pow, eval_X,
+      linear_map.map_smulₛₗ, ring_hom.id_apply, mul_comm] }
+end
+
+theorem is_root_of_has_eigenvalue {f : End K V} {μ : K} (h : f.has_eigenvalue μ) :
+  (minpoly K f).is_root μ :=
+begin
+  rcases (submodule.ne_bot_iff _).1 h with ⟨w, ⟨H, ne0⟩⟩,
+  refine or.resolve_right (smul_eq_zero.1 _) ne0,
+  simp [← aeval_apply_of_has_eigenvector ⟨H, ne0⟩, minpoly.aeval K f],
+end
+
+variables [finite_dimensional K V] (f : End K V)
+
+variables {f} {μ : K}
+
+theorem has_eigenvalue_of_is_root (h : (minpoly K f).is_root μ) :
+  f.has_eigenvalue μ :=
+begin
+  cases dvd_iff_is_root.2 h with p hp,
+  rw [has_eigenvalue, eigenspace],
+  intro con,
+  cases (linear_map.is_unit_iff_ker_eq_bot _).2 con with u hu,
+  have p_ne_0 : p ≠ 0,
+  { intro con,
+    apply minpoly.ne_zero f.is_integral,
+    rw [hp, con, mul_zero] },
+  have h_deg := minpoly.degree_le_of_ne_zero K f p_ne_0 _,
+  { rw [hp, degree_mul, degree_X_sub_C, polynomial.degree_eq_nat_degree p_ne_0] at h_deg,
+    norm_cast at h_deg,
+    linarith, },
+  { have h_aeval := minpoly.aeval K f,
+    revert h_aeval,
+    simp [hp, ← hu] },
+end
+
+theorem has_eigenvalue_iff_is_root :
+  f.has_eigenvalue μ ↔ (minpoly K f).is_root μ :=
+⟨is_root_of_has_eigenvalue, has_eigenvalue_of_is_root⟩
+
+/-- An endomorphism of a finite-dimensional vector space has finitely many eigenvalues. -/
+noncomputable instance (f : End K V) : fintype f.eigenvalues :=
+set.finite.fintype $ show {μ | eigenspace f μ ≠ ⊥}.finite,
+begin
+  have h : minpoly K f ≠ 0 := minpoly.ne_zero f.is_integral,
+  convert (minpoly K f).root_set_finite K using 1,
+  ext μ,
+  classical,
+  simp [polynomial.root_set_def, polynomial.mem_roots h, ← has_eigenvalue_iff_is_root,
+    has_eigenvalue],
+end
+
+end End
+end module
diff --git a/src/linear_algebra/exterior_algebra/basic.lean b/src/linear_algebra/exterior_algebra/basic.lean
index 649695e8e36e9..ddde814780643 100644
--- a/src/linear_algebra/exterior_algebra/basic.lean
+++ b/src/linear_algebra/exterior_algebra/basic.lean
@@ -4,14 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhangir Azerbayev, Adam Topaz, Eric Wieser
 -/
 
-import algebra.ring_quot
-import linear_algebra.tensor_algebra.basic
+import linear_algebra.clifford_algebra.basic
 import linear_algebra.alternating
-import group_theory.perm.sign
 
 /-!
 # Exterior Algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct the exterior algebra of a module `M` over a commutative semiring `R`.
 
 ## Notation
@@ -38,58 +39,36 @@ of the exterior algebra.
 
 ## Implementation details
 
-The exterior algebra of `M` is constructed as a quotient of the tensor algebra, as follows.
-1. We define a relation `exterior_algebra.rel R M` on `tensor_algebra R M`.
-   This is the smallest relation which identifies squares of elements of `M` with `0`.
-2. The exterior algebra is the quotient of the tensor algebra by this relation.
-
+The exterior algebra of `M` is constructed as simply `clifford_algebra (0 : quadratic_form R M)`,
+as this avoids us having to duplicate API.
 -/
 
 universes u1 u2 u3
 
-variables (R : Type u1) [comm_semiring R]
-variables (M : Type u2) [add_comm_monoid M] [module R M]
-
-namespace exterior_algebra
-open tensor_algebra
-
-/-- `rel` relates each `ι m * ι m`, for `m : M`, with `0`.
-
-The exterior algebra of `M` is defined as the quotient modulo this relation.
--/
-inductive rel : tensor_algebra R M → tensor_algebra R M → Prop
-| of (m : M) : rel ((ι R m) * (ι R m)) 0
-
-end exterior_algebra
+variables (R : Type u1) [comm_ring R]
+variables (M : Type u2) [add_comm_group M] [module R M]
 
 /--
 The exterior algebra of an `R`-module `M`.
 -/
-@[derive [inhabited, semiring, algebra R]]
-def exterior_algebra := ring_quot (exterior_algebra.rel R M)
+@[reducible]
+def exterior_algebra := clifford_algebra (0 : quadratic_form R M)
 
 namespace exterior_algebra
 
 variables {M}
 
-instance {S : Type u3} [comm_ring S] [module S M] : ring (exterior_algebra S M) :=
-ring_quot.ring (exterior_algebra.rel S M)
-
 /--
 The canonical linear map `M →ₗ[R] exterior_algebra R M`.
 -/
-def ι : M →ₗ[R] exterior_algebra R M :=
-(ring_quot.mk_alg_hom R _).to_linear_map.comp (tensor_algebra.ι R)
-
+@[reducible] def ι : M →ₗ[R] exterior_algebra R M := by exact clifford_algebra.ι _
 
 variables {R}
 
 /-- As well as being linear, `ι m` squares to zero -/
 @[simp]
 theorem ι_sq_zero (m : M) : (ι R m) * (ι R m) = 0 :=
-begin
-  erw [←alg_hom.map_mul, ring_quot.mk_alg_hom_rel R (rel.of m), alg_hom.map_zero _],
-end
+(clifford_algebra.ι_sq_scalar _ m).trans $ map_zero _
 
 variables {A : Type*} [semiring A] [algebra R A]
 
@@ -107,65 +86,39 @@ from `exterior_algebra R M` to `A`.
 -/
 @[simps symm_apply]
 def lift : {f : M →ₗ[R] A // ∀ m, f m * f m = 0} ≃ (exterior_algebra R M →ₐ[R] A) :=
-{ to_fun := λ f,
-  ring_quot.lift_alg_hom R ⟨tensor_algebra.lift R (f : M →ₗ[R] A),
-    λ x y (h : rel R M x y), by
-    { induction h,
-      rw [alg_hom.map_zero, alg_hom.map_mul, tensor_algebra.lift_ι_apply, f.prop] }⟩,
-  inv_fun := λ F, ⟨F.to_linear_map.comp (ι R), λ m, by rw [
-    linear_map.comp_apply, alg_hom.to_linear_map_apply, comp_ι_sq_zero]⟩,
-  left_inv := λ f, by { ext, simp [ι] },
-  right_inv := λ F, by { ext, simp [ι] } }
+equiv.trans (equiv.subtype_equiv (equiv.refl _) $ by simp) $ clifford_algebra.lift _
 
 @[simp]
 theorem ι_comp_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0) :
   (lift R ⟨f, cond⟩).to_linear_map.comp (ι R) = f :=
-(subtype.mk_eq_mk.mp $ (lift R).symm_apply_apply ⟨f, cond⟩)
+clifford_algebra.ι_comp_lift f _
 
 @[simp]
 theorem lift_ι_apply (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0) (x) :
   lift R ⟨f, cond⟩ (ι R x) = f x :=
-(linear_map.ext_iff.mp $ ι_comp_lift R f cond) x
+clifford_algebra.lift_ι_apply f _ x
 
 @[simp]
 theorem lift_unique (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0)
   (g : exterior_algebra R M →ₐ[R] A) : g.to_linear_map.comp (ι R) = f ↔ g = lift R ⟨f, cond⟩ :=
-begin
-  convert (lift R).symm_apply_eq,
-  rw lift_symm_apply,
-  simp only,
-end
-
-attribute [irreducible] ι lift
--- Marking `exterior_algebra` irreducible makes our `ring` instances inaccessible.
--- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/algebra.2Esemiring_to_ring.20breaks.20semimodule.20typeclass.20lookup/near/212580241
--- For now, we avoid this by not marking it irreducible.
+clifford_algebra.lift_unique f _ _
 
 variables {R M}
 
 @[simp]
 theorem lift_comp_ι (g : exterior_algebra R M →ₐ[R] A) :
   lift R ⟨g.to_linear_map.comp (ι R), comp_ι_sq_zero _⟩ = g :=
-begin
-  convert (lift R).apply_symm_apply g,
-  rw lift_symm_apply,
-  refl,
-end
+clifford_algebra.lift_comp_ι g
 
 /-- See note [partially-applied ext lemmas]. -/
 @[ext]
 theorem hom_ext {f g : exterior_algebra R M →ₐ[R] A}
   (h : f.to_linear_map.comp (ι R) = g.to_linear_map.comp (ι R)) : f = g :=
-begin
-  apply (lift R).symm.injective,
-  rw [lift_symm_apply, lift_symm_apply],
-  simp only [h],
-end
+clifford_algebra.hom_ext h
 
 /-- If `C` holds for the `algebra_map` of `r : R` into `exterior_algebra R M`, the `ι` of `x : M`,
 and is preserved under addition and muliplication, then it holds for all of `exterior_algebra R M`.
 -/
--- This proof closely follows `tensor_algebra.induction`
 @[elab_as_eliminator]
 lemma induction {C : exterior_algebra R M → Prop}
   (h_grade0 : ∀ r, C (algebra_map R (exterior_algebra R M) r))
@@ -174,24 +127,7 @@ lemma induction {C : exterior_algebra R M → Prop}
   (h_add : ∀ a b, C a → C b → C (a + b))
   (a : exterior_algebra R M) :
   C a :=
-begin
-  -- the arguments are enough to construct a subalgebra, and a mapping into it from M
-  let s : subalgebra R (exterior_algebra R M) :=
-  { carrier := C,
-    mul_mem' := h_mul,
-    add_mem' := h_add,
-    algebra_map_mem' := h_grade0, },
-  let of : { f : M →ₗ[R] s // ∀ m, f m * f m = 0 } :=
-  ⟨(ι R).cod_restrict s.to_submodule h_grade1,
-    λ m, subtype.eq $ ι_sq_zero m ⟩,
-  -- the mapping through the subalgebra is the identity
-  have of_id : alg_hom.id R (exterior_algebra R M) = s.val.comp (lift R of),
-  { ext,
-    simp [of], },
-  -- finding a proof is finding an element of the subalgebra
-  convert subtype.prop (lift R of a),
-  exact alg_hom.congr_fun of_id a,
-end
+clifford_algebra.induction h_grade0 h_grade1 h_mul h_add a
 
 /-- The left-inverse of `algebra_map`. -/
 def algebra_map_inv : exterior_algebra R M →ₐ[R] R :=
@@ -214,14 +150,24 @@ map_eq_zero_iff (algebra_map _ _) (algebra_map_left_inverse _).injective
 @[simp] lemma algebra_map_eq_one_iff (x : R) : algebra_map R (exterior_algebra R M) x = 1 ↔ x = 1 :=
 map_eq_one_iff (algebra_map _ _) (algebra_map_left_inverse _).injective
 
+lemma is_unit_algebra_map (r : R) : is_unit (algebra_map R (exterior_algebra R M) r) ↔ is_unit r :=
+is_unit_map_of_left_inverse _ (algebra_map_left_inverse M)
+
+/-- Invertibility in the exterior algebra is the same as invertibility of the base ring. -/
+@[simps]
+def invertible_algebra_map_equiv (r : R) :
+  invertible (algebra_map R (exterior_algebra R M) r) ≃ invertible r :=
+invertible_equiv_of_left_inverse _ _ _ (algebra_map_left_inverse M)
+
 variables {M}
 
 /-- The canonical map from `exterior_algebra R M` into `triv_sq_zero_ext R M` that sends
 `exterior_algebra.ι` to `triv_sq_zero_ext.inr`. -/
-def to_triv_sq_zero_ext : exterior_algebra R M →ₐ[R] triv_sq_zero_ext R M :=
+def to_triv_sq_zero_ext [module Rᵐᵒᵖ M] [is_central_scalar R M] :
+  exterior_algebra R M →ₐ[R] triv_sq_zero_ext R M :=
 lift R ⟨triv_sq_zero_ext.inr_hom R M, λ m, triv_sq_zero_ext.inr_mul_inr R m m⟩
 
-@[simp] lemma to_triv_sq_zero_ext_ι (x : M) :
+@[simp] lemma to_triv_sq_zero_ext_ι [module Rᵐᵒᵖ M] [is_central_scalar R M] (x : M) :
   to_triv_sq_zero_ext (ι R x) = triv_sq_zero_ext.inr x :=
 lift_ι_apply _ _ _ _
 
@@ -230,7 +176,11 @@ lift_ι_apply _ _ _ _
 As an implementation detail, we implement this using `triv_sq_zero_ext` which has a suitable
 algebra structure. -/
 def ι_inv : exterior_algebra R M →ₗ[R] M :=
-(triv_sq_zero_ext.snd_hom R M).comp to_triv_sq_zero_ext.to_linear_map
+begin
+  letI : module Rᵐᵒᵖ M := module.comp_hom _ ((ring_hom.id R).from_opposite mul_comm),
+  haveI : is_central_scalar R M := ⟨λ r m, rfl⟩,
+  exact (triv_sq_zero_ext.snd_hom R M).comp to_triv_sq_zero_ext.to_linear_map
+end
 
 lemma ι_left_inverse : function.left_inverse ι_inv (ι R : M → exterior_algebra R M) :=
 λ x, by simp [ι_inv]
@@ -248,7 +198,9 @@ by rw [←ι_inj R x 0, linear_map.map_zero]
 @[simp] lemma ι_eq_algebra_map_iff (x : M) (r : R) : ι R x = algebra_map R _ r ↔ x = 0 ∧ r = 0 :=
 begin
   refine ⟨λ h, _, _⟩,
-  { have hf0 : to_triv_sq_zero_ext (ι R x) = (0, x), from to_triv_sq_zero_ext_ι _,
+  { letI : module Rᵐᵒᵖ M := module.comp_hom _ ((ring_hom.id R).from_opposite mul_comm),
+    haveI : is_central_scalar R M := ⟨λ r m, rfl⟩,
+    have hf0 : to_triv_sq_zero_ext (ι R x) = (0, x), from to_triv_sq_zero_ext_ι _,
     rw [h, alg_hom.commutes] at hf0,
     have : r = 0 ∧ 0 = x := prod.ext_iff.1 hf0,
     exact this.symm.imp_left eq.symm, },
@@ -263,7 +215,9 @@ begin
 end
 
 /-- The generators of the exterior algebra are disjoint from its scalars. -/
-lemma ι_range_disjoint_one : disjoint (ι R).range (1 : submodule R (exterior_algebra R M)) :=
+lemma ι_range_disjoint_one :
+  disjoint (linear_map.range (ι R : M →ₗ[R] exterior_algebra R M))
+    (1 : submodule R (exterior_algebra R M)) :=
 begin
   rw submodule.disjoint_def,
   rintros _ ⟨x, hx⟩ ⟨r, (rfl : algebra_map _ _ _ = _)⟩,
@@ -294,16 +248,18 @@ end
 variables (R)
 /-- The product of `n` terms of the form `ι R m` is an alternating map.
 
-This is a special case of `multilinear_map.mk_pi_algebra_fin` -/
-def ι_multi (n : ℕ) :
-  alternating_map R M (exterior_algebra R M) (fin n) :=
+This is a special case of `multilinear_map.mk_pi_algebra_fin`, and the exterior algebra version of
+`tensor_algebra.tprod`. -/
+def ι_multi (n : ℕ) : alternating_map R M (exterior_algebra R M) (fin n) :=
 let F := (multilinear_map.mk_pi_algebra_fin R n (exterior_algebra R M)).comp_linear_map (λ i, ι R)
 in
 { map_eq_zero_of_eq' := λ f x y hfxy hxy, begin
     rw [multilinear_map.comp_linear_map_apply, multilinear_map.mk_pi_algebra_fin_apply],
-    wlog h : x < y := lt_or_gt_of_ne hxy using x y,
+    clear F,
+    wlog h : x < y,
+    { exact this n f y x hfxy.symm hxy.symm (hxy.lt_or_lt.resolve_left h), },
     clear hxy,
-    induction n with n hn generalizing x y,
+    induction n with n hn,
     { exact x.elim0, },
     { rw [list.of_fn_succ, list.prod_cons],
       by_cases hx : x = 0,
@@ -314,8 +270,8 @@ in
       -- ignore the left-most term and induct on the remaining ones, decrementing indices
       { convert mul_zero _,
         refine hn (λ i, f $ fin.succ i)
-          (x.pred hx) (y.pred (ne_of_lt $ lt_of_le_of_lt x.zero_le h).symm)
-          (fin.pred_lt_pred_iff.mpr h) _,
+          (x.pred hx) (y.pred (ne_of_lt $ lt_of_le_of_lt x.zero_le h).symm) _
+          (fin.pred_lt_pred_iff.mpr h),
         simp only [fin.succ_pred],
         exact hfxy, } }
   end,
@@ -325,6 +281,20 @@ variables {R}
 lemma ι_multi_apply {n : ℕ} (v : fin n → M) :
   ι_multi R n v = (list.of_fn $ λ i, ι R (v i)).prod := rfl
 
+@[simp] lemma ι_multi_zero_apply (v : fin 0 → M) : ι_multi R 0 v = 1 := rfl
+
+@[simp] lemma ι_multi_succ_apply {n : ℕ} (v : fin n.succ → M) :
+  ι_multi R _ v = ι R (v 0) * ι_multi R _ (matrix.vec_tail v):=
+(congr_arg list.prod (list.of_fn_succ _)).trans list.prod_cons
+
+lemma ι_multi_succ_curry_left {n : ℕ} (m : M) :
+  (ι_multi R n.succ).curry_left m =
+    (linear_map.mul_left R (ι R m)).comp_alternating_map (ι_multi R n) :=
+alternating_map.ext $ λ v, (ι_multi_succ_apply _).trans $ begin
+  simp_rw matrix.tail_cons,
+  refl,
+end
+
 end exterior_algebra
 
 namespace tensor_algebra
@@ -334,7 +304,7 @@ variables {R M}
 /-- The canonical image of the `tensor_algebra` in the `exterior_algebra`, which maps
 `tensor_algebra.ι R x` to `exterior_algebra.ι R x`. -/
 def to_exterior : tensor_algebra R M →ₐ[R] exterior_algebra R M :=
-tensor_algebra.lift R (exterior_algebra.ι R)
+tensor_algebra.lift R (exterior_algebra.ι R : M →ₗ[R] exterior_algebra R M)
 
 @[simp] lemma to_exterior_ι (m : M) : (tensor_algebra.ι R m).to_exterior = exterior_algebra.ι R m :=
 by simp [to_exterior]
diff --git a/src/linear_algebra/exterior_algebra/grading.lean b/src/linear_algebra/exterior_algebra/grading.lean
index ee7e87b9b61ff..0f5089ccbee07 100644
--- a/src/linear_algebra/exterior_algebra/grading.lean
+++ b/src/linear_algebra/exterior_algebra/grading.lean
@@ -9,6 +9,9 @@ import ring_theory.graded_algebra.basic
 /-!
 # Results about the grading structure of the exterior algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Many of these results are copied with minimal modification from the tensor algebra.
 
 The main result is `exterior_algebra.graded_algebra`, which says that the exterior algebra is a
@@ -16,7 +19,7 @@ The main result is `exterior_algebra.graded_algebra`, which says that the exteri
 -/
 
 namespace exterior_algebra
-variables {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]
+variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
 variables (R M)
 
 open_locale direct_sum
@@ -38,31 +41,44 @@ begin
   refine dfinsupp.single_eq_zero.mpr (subtype.ext $ ι_sq_zero _),
 end
 
-variables {R M}
+/-- `exterior_algebra.graded_algebra.ι` lifted to exterior algebra. This is
+primarily an auxiliary construction used to provide `exterior_algebra.graded_algebra`. -/
+def graded_algebra.lift_ι : exterior_algebra R M →ₐ[R]
+  ⨁ (i : ℕ), ↥((ι R).range ^ i : submodule R (exterior_algebra R M)) :=
+lift R ⟨by apply graded_algebra.ι R M, graded_algebra.ι_sq_zero R M⟩
+
+variables (R M)
+
+lemma graded_algebra.lift_ι_eq (i : ℕ)
+  (x : ((ι R : M →ₗ[R] exterior_algebra R M).range ^ i : submodule R (exterior_algebra R M))) :
+  graded_algebra.lift_ι R M x =
+    direct_sum.of (λ i, ↥((ι R).range ^ i : submodule R (exterior_algebra R M))) i x :=
+begin
+  cases x with x hx,
+  dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
+  refine submodule.pow_induction_on_left' _
+    (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
+  { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
+  { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
+  { obtain ⟨_, rfl⟩ := hm,
+    rw [alg_hom.map_mul, ih, graded_algebra.lift_ι, lift_ι_apply,
+      graded_algebra.ι_apply R M, direct_sum.of_mul_of],
+    exact direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext (add_comm _ _) rfl) },
+end
 
 /-- The exterior algebra is graded by the powers of the submodule `(exterior_algebra.ι R).range`. -/
 instance graded_algebra :
-  graded_algebra
-    ((^) (ι R : M →ₗ[R] exterior_algebra R M).range : ℕ → submodule R (exterior_algebra R M)) :=
+  graded_algebra ((^) (ι R : M →ₗ[R] exterior_algebra R M).range : ℕ → submodule R _) :=
 graded_algebra.of_alg_hom _
-  (lift _ $ ⟨graded_algebra.ι R M, graded_algebra.ι_sq_zero R M⟩)
+  -- while not necessary, the `by apply` makes this elaborate faster
+  (by apply graded_algebra.lift_ι R M)
   -- the proof from here onward is identical to the `tensor_algebra` case
   (begin
     ext m,
     dsimp only [linear_map.comp_apply, alg_hom.to_linear_map_apply, alg_hom.comp_apply,
-      alg_hom.id_apply],
-    rw [lift_ι_apply, graded_algebra.ι_apply, direct_sum.submodule_coe_alg_hom_of, subtype.coe_mk],
-  end)
-  (λ i x, begin
-    cases x with x hx,
-    dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
-    refine submodule.pow_induction_on' _
-      (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
-    { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
-    { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
-    { obtain ⟨_, rfl⟩ := hm,
-      rw [alg_hom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply, direct_sum.of_mul_of],
-      exact direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext (add_comm _ _) rfl) }
+      alg_hom.id_apply, graded_algebra.lift_ι],
+    rw [lift_ι_apply, graded_algebra.ι_apply R M, direct_sum.coe_alg_hom_of, subtype.coe_mk],
   end)
+  (by apply graded_algebra.lift_ι_eq R M)
 
 end exterior_algebra
diff --git a/src/linear_algebra/exterior_algebra/of_alternating.lean b/src/linear_algebra/exterior_algebra/of_alternating.lean
new file mode 100644
index 0000000000000..ad0ae0b28a5be
--- /dev/null
+++ b/src/linear_algebra/exterior_algebra/of_alternating.lean
@@ -0,0 +1,167 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import linear_algebra.clifford_algebra.fold
+import linear_algebra.exterior_algebra.basic
+
+/-!
+# Extending an alternating map to the exterior algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `exterior_algebra.lift_alternating`: construct a linear map out of the exterior algebra
+  given alternating maps (corresponding to maps out of the exterior powers).
+* `exterior_algebra.lift_alternating_equiv`: the above as a linear equivalence
+
+## Main results
+
+* `exterior_algebra.lhom_ext`: linear maps from the exterior algebra agree if they agree on the
+  exterior powers.
+
+-/
+
+variables {R M N N' : Type*}
+variables [comm_ring R] [add_comm_group M] [add_comm_group N] [add_comm_group N']
+variables [module R M] [module R N] [module R N']
+
+-- This instance can't be found where it's needed if we don't remind lean that it exists.
+instance alternating_map.module_add_comm_group {ι : Type*} :
+  module R (alternating_map R M N ι) :=
+by apply_instance
+
+namespace exterior_algebra
+open clifford_algebra (hiding ι)
+
+/-- Build a map out of the exterior algebra given a collection of alternating maps acting on each
+exterior power -/
+def lift_alternating : (Π i, alternating_map R M N (fin i)) →ₗ[R] exterior_algebra R M →ₗ[R] N :=
+begin
+  suffices :
+    (Π i, alternating_map R M N (fin i))
+      →ₗ[R] exterior_algebra R M
+      →ₗ[R] (Π i, alternating_map R M N (fin i)),
+  { refine linear_map.compr₂ this _,
+    refine linear_equiv.to_linear_map _ ∘ₗ linear_map.proj 0,
+    exact alternating_map.const_linear_equiv_of_is_empty.symm },
+  refine clifford_algebra.foldl _ _ _,
+  { refine linear_map.mk₂ R
+      (λ m f i, (f i.succ).curry_left m) (λ m₁ m₂ f, _) (λ c m f, _) (λ m f₁ f₂, _) (λ c m f, _),
+    all_goals {
+      ext i : 1,
+      simp only [map_smul, map_add, pi.add_apply, pi.smul_apply, alternating_map.curry_left_add,
+        alternating_map.curry_left_smul, map_add, map_smul, linear_map.add_apply,
+        linear_map.smul_apply] } },
+  { -- when applied twice with the same `m`, this recursive step produces 0
+    intros m x,
+    dsimp only [linear_map.mk₂_apply, quadratic_form.coe_fn_zero, pi.zero_apply],
+    simp_rw zero_smul,
+    ext i : 1,
+    exact alternating_map.curry_left_same _ _, }
+end
+
+@[simp]
+lemma lift_alternating_ι (f : Π i, alternating_map R M N (fin i)) (m : M) :
+  lift_alternating f (ι R m) = f 1 ![m] :=
+begin
+  dsimp [lift_alternating],
+  rw [foldl_ι, linear_map.mk₂_apply, alternating_map.curry_left_apply_apply],
+  congr,
+end
+
+lemma lift_alternating_ι_mul (f : Π i, alternating_map R M N (fin i)) (m : M)
+  (x : exterior_algebra R M):
+  lift_alternating f (ι R m * x) = lift_alternating (λ i, (f i.succ).curry_left m) x :=
+begin
+  dsimp [lift_alternating],
+  rw [foldl_mul, foldl_ι],
+  refl,
+end
+
+@[simp]
+lemma lift_alternating_one (f : Π i, alternating_map R M N (fin i)) :
+  lift_alternating f (1 : exterior_algebra R M) = f 0 0 :=
+begin
+  dsimp [lift_alternating],
+  rw foldl_one,
+end
+
+@[simp]
+lemma lift_alternating_algebra_map (f : Π i, alternating_map R M N (fin i)) (r : R) :
+  lift_alternating f (algebra_map _ (exterior_algebra R M) r) = r • f 0 0 :=
+by rw [algebra.algebra_map_eq_smul_one, map_smul, lift_alternating_one]
+
+@[simp]
+lemma lift_alternating_apply_ι_multi {n : ℕ} (f : Π i, alternating_map R M N (fin i))
+  (v : fin n → M) :
+  lift_alternating f (ι_multi R n v) = f n v :=
+begin
+  rw ι_multi_apply,
+  induction n with n ih generalizing f v,
+  { rw [list.of_fn_zero, list.prod_nil, lift_alternating_one, subsingleton.elim 0 v] },
+  { rw [list.of_fn_succ, list.prod_cons, lift_alternating_ι_mul, ih,
+      alternating_map.curry_left_apply_apply],
+    congr',
+    exact matrix.cons_head_tail _ }
+end
+
+@[simp]
+lemma lift_alternating_comp_ι_multi {n : ℕ} (f : Π i, alternating_map R M N (fin i)) :
+  (lift_alternating f).comp_alternating_map (ι_multi R n) = f n :=
+alternating_map.ext $ lift_alternating_apply_ι_multi f
+
+@[simp]
+lemma lift_alternating_comp (g : N →ₗ[R] N') (f : Π i, alternating_map R M N (fin i)) :
+  lift_alternating (λ i, g.comp_alternating_map (f i)) = g ∘ₗ lift_alternating f :=
+begin
+  ext v,
+  rw linear_map.comp_apply,
+  induction v using clifford_algebra.left_induction with r x y hx hy x m hx generalizing f,
+  { rw [lift_alternating_algebra_map, lift_alternating_algebra_map, map_smul,
+      linear_map.comp_alternating_map_apply] },
+  { rw [map_add, map_add, map_add, hx, hy] },
+  { rw [lift_alternating_ι_mul, lift_alternating_ι_mul, ←hx],
+    simp_rw alternating_map.curry_left_comp_alternating_map },
+end
+
+@[simp]
+lemma lift_alternating_ι_multi :
+  lift_alternating (by exact (ι_multi R)) =
+    (linear_map.id : exterior_algebra R M →ₗ[R] exterior_algebra R M) :=
+begin
+  ext v,
+  dsimp,
+  induction v using clifford_algebra.left_induction with r x y hx hy x m hx,
+  { rw [lift_alternating_algebra_map, ι_multi_zero_apply, algebra.algebra_map_eq_smul_one] },
+  { rw [map_add, hx, hy] },
+  { simp_rw [lift_alternating_ι_mul, ι_multi_succ_curry_left, lift_alternating_comp,
+      linear_map.comp_apply, linear_map.mul_left_apply, hx] },
+end
+
+/-- `exterior_algebra.lift_alternating` is an equivalence. -/
+@[simps apply symm_apply]
+def lift_alternating_equiv :
+  (Π i, alternating_map R M N (fin i)) ≃ₗ[R] exterior_algebra R M →ₗ[R] N :=
+{ to_fun := lift_alternating,
+  map_add' := map_add _,
+  map_smul' := map_smul _,
+  inv_fun := λ F i, F.comp_alternating_map (ι_multi R i),
+  left_inv := λ f, funext $ λ i, lift_alternating_comp_ι_multi _,
+  right_inv := λ F, (lift_alternating_comp _ _).trans $
+    by rw [lift_alternating_ι_multi, linear_map.comp_id]}
+
+/-- To show that two linear maps from the exterior algebra agree, it suffices to show they agree on
+the exterior powers.
+
+See note [partially-applied ext lemmas] -/
+@[ext]
+lemma lhom_ext ⦃f g : exterior_algebra R M →ₗ[R] N⦄
+  (h : ∀ i, f.comp_alternating_map (ι_multi R i) = g.comp_alternating_map (ι_multi R i)) : f = g :=
+lift_alternating_equiv.symm.injective $ funext h
+
+end exterior_algebra
diff --git a/src/linear_algebra/finite_dimensional.lean b/src/linear_algebra/finite_dimensional.lean
index de89d6e85bdc2..a85cdf9c428b7 100644
--- a/src/linear_algebra/finite_dimensional.lean
+++ b/src/linear_algebra/finite_dimensional.lean
@@ -5,17 +5,22 @@ Authors: Chris Hughes
 -/
 import algebra.algebra.subalgebra.basic
 import field_theory.finiteness
+import linear_algebra.free_module.finite.rank
+import tactic.interval_cases
 
 /-!
 # Finite dimensional vector spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Definition and basic properties of finite dimensional vector spaces, of their dimensions, and
 of linear maps on such spaces.
 
 ## Main definitions
 
-Assume `V` is a vector space over a field `K`. There are (at least) three equivalent definitions of
-finite-dimensionality of `V`:
+Assume `V` is a vector space over a division ring `K`. There are (at least) three equivalent
+definitions of finite-dimensionality of `V`:
 
 - it admits a finite basis.
 - it is finitely generated.
@@ -33,21 +38,20 @@ that all these points of view are equivalent, with the following lemmas
   is `fin`
 - `of_fintype_basis` states that the existence of a basis indexed by a
   finite type implies finite-dimensionality
-- `of_finset_basis` states that the existence of a basis indexed by a
-  `finset` implies finite-dimensionality
 - `of_finite_basis` states that the existence of a basis indexed by a
   finite set implies finite-dimensionality
 - `is_noetherian.iff_fg` states that the space is finite-dimensional if and only if
   it is noetherian
 
-Also defined is `finrank`, the dimension of a finite dimensional space, returning a `nat`,
-as opposed to `module.rank`, which returns a `cardinal`. When the space has infinite dimension, its
-`finrank` is by convention set to `0`.
+We make use of `finrank`, the dimension of a finite dimensional space, returning a `nat`, as
+opposed to `module.rank`, which returns a `cardinal`. When the space has infinite dimension, its
+`finrank` is by convention set to `0`. `finrank` is not defined using `finite_dimensional`.
+For basic results that do not need the `finite_dimensional` class, import `linear_algebra.finrank`.
 
 Preservation of finite-dimensionality and formulas for the dimension are given for
 - submodules
 - quotients (for the dimension of a quotient, see `finrank_quotient_add_finrank`)
-- linear equivs, in `linear_equiv.finite_dimensional` and `linear_equiv.finrank_eq`
+- linear equivs, in `linear_equiv.finite_dimensional`
 - image under a linear map (the rank-nullity formula is in `finrank_range_add_finrank_ker`)
 
 Basic properties of linear maps of a finite-dimensional vector space are given. Notably, the
@@ -60,7 +64,6 @@ and `linear_map.comp_eq_id_comm`.
 Most results are deduced from the corresponding results for the general dimension (as a cardinal),
 in `dimension.lean`. Not all results have been ported yet.
 
-Much of this file could be generalised away from fields or division rings.
 You should not assume that there has been any effort to state lemmas as generally as possible.
 
 One of the characterizations of finite-dimensionality is in terms of finite generation. This
@@ -105,10 +108,10 @@ module.finite.of_surjective f w
 
 variables (K V)
 
-instance finite_dimensional_pi {ι} [fintype ι] : finite_dimensional K (ι → K) :=
+instance finite_dimensional_pi {ι : Type*} [_root_.finite ι] : finite_dimensional K (ι → K) :=
 iff_fg.1 is_noetherian_pi
 
-instance finite_dimensional_pi' {ι} [fintype ι] (M : ι → Type*)
+instance finite_dimensional_pi' {ι : Type*} [_root_.finite ι] (M : ι → Type*)
   [∀ i, add_comm_group (M i)] [∀ i, module K (M i)] [I : ∀ i, finite_dimensional K (M i)] :
   finite_dimensional K (Π i, M i) :=
 begin
@@ -120,12 +123,14 @@ end
 noncomputable def fintype_of_fintype [fintype K] [finite_dimensional K V] : fintype V :=
 module.fintype_of_fintype (@finset_basis K V _ _ _ (iff_fg.2 infer_instance))
 
+lemma finite_of_finite [_root_.finite K] [finite_dimensional K V] : _root_.finite V :=
+by { casesI nonempty_fintype K, haveI := fintype_of_fintype K V, apply_instance }
+
 variables {K V}
 
 /-- If a vector space has a finite basis, then it is finite-dimensional. -/
-lemma of_fintype_basis {ι : Type w} [fintype ι] (h : basis ι K V) :
-  finite_dimensional K V :=
-⟨⟨finset.univ.image h, by { convert h.span_eq, simp } ⟩⟩
+lemma of_fintype_basis {ι : Type w} [_root_.finite ι] (h : basis ι K V) : finite_dimensional K V :=
+by { casesI nonempty_fintype ι, exact ⟨⟨finset.univ.image h, by { convert h.span_eq, simp } ⟩⟩ }
 
 /-- If a vector space is `finite_dimensional`, all bases are indexed by a finite type -/
 noncomputable
@@ -149,91 +154,51 @@ lemma of_finite_basis {ι : Type w} {s : set ι} (h : basis s K V) (hs : set.fin
   finite_dimensional K V :=
 by haveI := hs.fintype; exact of_fintype_basis h
 
-/-- If a vector space has a finite basis, then it is finite-dimensional, finset style. -/
-lemma of_finset_basis {ι : Type w} {s : finset ι} (h : basis s K V) :
-  finite_dimensional K V :=
-of_finite_basis h s.finite_to_set
-
 /-- A subspace of a finite-dimensional space is also finite-dimensional. -/
 instance finite_dimensional_submodule [finite_dimensional K V] (S : submodule K V) :
   finite_dimensional K S :=
 begin
   letI : is_noetherian K V := iff_fg.2 _,
   exact iff_fg.1
-    (is_noetherian.iff_dim_lt_omega.2 (lt_of_le_of_lt (dim_submodule_le _) (dim_lt_omega K V))),
+    (is_noetherian.iff_rank_lt_aleph_0.2
+      (lt_of_le_of_lt (rank_submodule_le _) (rank_lt_aleph_0 K V))),
   apply_instance,
 end
 
 /-- A quotient of a finite-dimensional space is also finite-dimensional. -/
 instance finite_dimensional_quotient [finite_dimensional K V] (S : submodule K V) :
   finite_dimensional K (V ⧸ S) :=
-finite.of_surjective (submodule.mkq S) $ surjective_quot_mk _
-
-/-- The rank of a module as a natural number.
-
-Defined by convention to be `0` if the space has infinite rank.
-
-For a vector space `V` over a field `K`, this is the same as the finite dimension
-of `V` over `K`.
--/
-noncomputable def finrank (R V : Type*) [semiring R]
-  [add_comm_group V] [module R V] : ℕ :=
-(module.rank R V).to_nat
+module.finite.of_surjective (submodule.mkq S) $ surjective_quot_mk _
 
+variables (K V)
 /-- In a finite-dimensional space, its dimension (seen as a cardinal) coincides with its
-`finrank`. -/
-lemma finrank_eq_dim (K : Type u) (V : Type v) [division_ring K]
-  [add_comm_group V] [module K V] [finite_dimensional K V] :
+`finrank`. This is a copy of `finrank_eq_rank _ _` which creates easier typeclass searches. -/
+lemma finrank_eq_rank' [finite_dimensional K V] :
   (finrank K V : cardinal.{v}) = module.rank K V :=
-begin
-  letI : is_noetherian K V := iff_fg.2 infer_instance,
-  rw [finrank, cast_to_nat_of_lt_omega (dim_lt_omega K V)]
-end
-
-lemma finrank_eq_of_dim_eq {n : ℕ} (h : module.rank K V = ↑ n) : finrank K V = n :=
-begin
-  apply_fun to_nat at h,
-  rw to_nat_cast at h,
-  exact_mod_cast h,
-end
+finrank_eq_rank _ _
+variables {K V}
 
-lemma finrank_of_infinite_dimensional
-  {K V : Type*} [division_ring K] [add_comm_group V] [module K V]
-  (h : ¬finite_dimensional K V) : finrank K V = 0 :=
-dif_neg $ mt is_noetherian.iff_dim_lt_omega.2 $ (not_iff_not.2 iff_fg).2 h
+lemma finrank_of_infinite_dimensional (h : ¬finite_dimensional K V) : finrank K V = 0 :=
+dif_neg $ mt is_noetherian.iff_rank_lt_aleph_0.2 $ (not_iff_not.2 iff_fg).2 h
 
-lemma finite_dimensional_of_finrank {K V : Type*} [division_ring K] [add_comm_group V] [module K V]
-  (h : 0 < finrank K V) : finite_dimensional K V :=
+lemma finite_dimensional_of_finrank (h : 0 < finrank K V) : finite_dimensional K V :=
 by { contrapose h, simp [finrank_of_infinite_dimensional h] }
 
-lemma finite_dimensional_of_finrank_eq_succ {K V : Type*} [field K] [add_comm_group V] [module K V]
+lemma finite_dimensional_of_finrank_eq_succ
   {n : ℕ} (hn : finrank K V = n.succ) : finite_dimensional K V :=
 finite_dimensional_of_finrank $ by rw hn; exact n.succ_pos
 
 /-- We can infer `finite_dimensional K V` in the presence of `[fact (finrank K V = n + 1)]`. Declare
 this as a local instance where needed. -/
-lemma fact_finite_dimensional_of_finrank_eq_succ {K V : Type*} [field K] [add_comm_group V]
-  [module K V] (n : ℕ) [fact (finrank K V = n + 1)] :
-  finite_dimensional K V :=
+lemma fact_finite_dimensional_of_finrank_eq_succ
+  (n : ℕ) [fact (finrank K V = n + 1)] : finite_dimensional K V :=
 finite_dimensional_of_finrank $ by convert nat.succ_pos n; apply fact.out
 
-lemma finite_dimensional_iff_of_rank_eq_nsmul
-  {K V W : Type*} [field K] [add_comm_group V] [add_comm_group W] [module K V] [module K W]
+lemma finite_dimensional_iff_of_rank_eq_nsmul {W} [add_comm_group W] [module K W]
   {n : ℕ} (hn : n ≠ 0) (hVW : module.rank K V = n • module.rank K W) :
   finite_dimensional K V ↔ finite_dimensional K W :=
-by simp only [finite_dimensional, ← is_noetherian.iff_fg, is_noetherian.iff_dim_lt_omega, hVW,
-  cardinal.nsmul_lt_omega_iff_of_ne_zero hn]
-
-/-- If a vector space has a finite basis, then its dimension is equal to the cardinality of the
-basis. -/
-lemma finrank_eq_card_basis {ι : Type w} [fintype ι] (h : basis ι K V) :
-  finrank K V = fintype.card ι :=
-begin
-  haveI : finite_dimensional K V := of_fintype_basis h,
-  have := dim_eq_card_basis h,
-  rw ← finrank_eq_dim at this,
-  exact_mod_cast this
-end
+by simp only [finite_dimensional, ← is_noetherian.iff_fg, is_noetherian.iff_rank_lt_aleph_0, hVW,
+  cardinal.nsmul_lt_aleph_0_iff_of_ne_zero hn]
 
 /-- If a vector space is finite-dimensional, then the cardinality of any basis is equal to its
 `finrank`. -/
@@ -245,12 +210,14 @@ begin
   rw [cardinal.mk_fintype, finrank_eq_card_basis h]
 end
 
-/-- If a vector space has a finite basis, then its dimension is equal to the cardinality of the
-basis. This lemma uses a `finset` instead of indexed types. -/
-lemma finrank_eq_card_finset_basis {ι : Type w} {b : finset ι}
-  (h : basis.{w} b K V) :
-  finrank K V = finset.card b :=
-by rw [finrank_eq_card_basis h, fintype.card_coe]
+/-- Given a basis of a division ring over itself indexed by a type `ι`, then `ι` is `unique`. -/
+noncomputable def _root_.basis.unique {ι : Type*} (b : basis ι K K) : unique ι :=
+begin
+  have A : cardinal.mk ι = ↑(finite_dimensional.finrank K K) :=
+    (finite_dimensional.finrank_eq_card_basis' b).symm,
+  simp only [cardinal.eq_one_iff_unique, finite_dimensional.finrank_self, algebra_map.coe_one] at A,
+  exact nonempty.some ((unique_iff_subsingleton_and_nonempty _).2 A),
+end
 
 variables (K V)
 
@@ -272,7 +239,7 @@ noncomputable def basis_unique (ι : Type*) [unique ι] (h : finrank K V = 1) :
   basis ι K V :=
 begin
   haveI := finite_dimensional_of_finrank (_root_.zero_lt_one.trans_le h.symm.le),
-  exact (fin_basis_of_finrank_eq K V h).reindex equiv_of_unique_of_unique
+  exact (fin_basis_of_finrank_eq K V h).reindex (equiv.equiv_of_unique _ _)
 end
 
 @[simp]
@@ -286,8 +253,8 @@ lemma cardinal_mk_le_finrank_of_linear_independent
   #ι ≤ finrank K V :=
 begin
   rw ← lift_le.{_ (max v w)},
-  simpa [← finrank_eq_dim K V] using
-    cardinal_lift_le_dim_of_linear_independent.{_ _ _ (max v w)} h
+  simpa [← finrank_eq_rank', -finrank_eq_rank] using
+    cardinal_lift_le_rank_of_linear_independent.{_ _ _ (max v w)} h
 end
 
 lemma fintype_card_le_finrank_of_linear_independent
@@ -303,64 +270,47 @@ begin
   exact fintype_card_le_finrank_of_linear_independent h,
 end
 
-lemma lt_omega_of_linear_independent {ι : Type w} [finite_dimensional K V]
+lemma lt_aleph_0_of_linear_independent {ι : Type w} [finite_dimensional K V]
   {v : ι → V} (h : linear_independent K v) :
-  #ι < ω :=
+  #ι < ℵ₀ :=
 begin
   apply cardinal.lift_lt.1,
   apply lt_of_le_of_lt,
-  apply cardinal_lift_le_dim_of_linear_independent h,
-  rw [←finrank_eq_dim, cardinal.lift_omega, cardinal.lift_nat_cast],
-  apply cardinal.nat_lt_omega,
+  apply cardinal_lift_le_rank_of_linear_independent h,
+  rw [←finrank_eq_rank, cardinal.lift_aleph_0, cardinal.lift_nat_cast],
+  apply cardinal.nat_lt_aleph_0,
 end
 
+lemma _root_.linear_independent.finite [finite_dimensional K V] {b : set V}
+  (h : linear_independent K (λ (x:b), (x:V))) : b.finite :=
+cardinal.lt_aleph_0_iff_set_finite.mp (finite_dimensional.lt_aleph_0_of_linear_independent h)
+
 lemma not_linear_independent_of_infinite {ι : Type w} [inf : infinite ι] [finite_dimensional K V]
   (v : ι → V) : ¬ linear_independent K v :=
 begin
   intro h_lin_indep,
-  have : ¬ ω ≤ #ι := not_le.mpr (lt_omega_of_linear_independent h_lin_indep),
-  have : ω ≤ #ι := infinite_iff.mp inf,
+  have : ¬ ℵ₀ ≤ #ι := not_le.mpr (lt_aleph_0_of_linear_independent h_lin_indep),
+  have : ℵ₀ ≤ #ι := infinite_iff.mp inf,
   contradiction
 end
 
 /-- A finite dimensional space has positive `finrank` iff it has a nonzero element. -/
 lemma finrank_pos_iff_exists_ne_zero [finite_dimensional K V] : 0 < finrank K V ↔ ∃ x : V, x ≠ 0 :=
-iff.trans (by { rw ← finrank_eq_dim, norm_cast }) (@dim_pos_iff_exists_ne_zero K V _ _ _ _ _)
+iff.trans (by { rw ← finrank_eq_rank, norm_cast }) (@rank_pos_iff_exists_ne_zero K V _ _ _ _ _)
 
 /-- A finite dimensional space has positive `finrank` iff it is nontrivial. -/
 lemma finrank_pos_iff [finite_dimensional K V] : 0 < finrank K V ↔ nontrivial V :=
-iff.trans (by { rw ← finrank_eq_dim, norm_cast }) (@dim_pos_iff_nontrivial K V _ _ _ _ _)
-
-/-- A finite dimensional space is nontrivial if it has positive `finrank`. -/
-lemma nontrivial_of_finrank_pos (h : 0 < finrank K V) : nontrivial V :=
-begin
-  haveI : finite_dimensional K V := finite_dimensional_of_finrank h,
-  rwa finrank_pos_iff at h
-end
-
-/-- A finite dimensional space is nontrivial if it has `finrank` equal to the successor of a
-natural number. -/
-lemma nontrivial_of_finrank_eq_succ {n : ℕ} (hn : finrank K V = n.succ) : nontrivial V :=
-nontrivial_of_finrank_pos (by rw hn; exact n.succ_pos)
+iff.trans (by { rw ← finrank_eq_rank, norm_cast }) (@rank_pos_iff_nontrivial K V _ _ _ _ _)
 
 /-- A nontrivial finite dimensional space has positive `finrank`. -/
 lemma finrank_pos [finite_dimensional K V] [h : nontrivial V] : 0 < finrank K V :=
 finrank_pos_iff.mpr h
 
 /-- A finite dimensional space has zero `finrank` iff it is a subsingleton.
-This is the `finrank` version of `dim_zero_iff`. -/
+This is the `finrank` version of `rank_zero_iff`. -/
 lemma finrank_zero_iff [finite_dimensional K V] :
   finrank K V = 0 ↔ subsingleton V :=
-iff.trans (by { rw ← finrank_eq_dim, norm_cast }) (@dim_zero_iff K V _ _ _ _ _)
-
-/-- A finite dimensional space that is a subsingleton has zero `finrank`. -/
-lemma finrank_zero_of_subsingleton [h : subsingleton V] :
-  finrank K V = 0 :=
-finrank_zero_iff.2 h
-
-lemma basis.subset_extend {s : set V} (hs : linear_independent K (coe : s → V)) :
-  s ⊆ hs.extend (set.subset_univ _) :=
-hs.subset_extend _
+iff.trans (by { rw ← finrank_eq_rank, norm_cast }) (@rank_zero_iff K V _ _ _ _ _)
 
 /-- If a submodule has maximal dimension in a finite dimensional space, then it is equal to the
 whole space. -/
@@ -391,29 +341,10 @@ begin
 end
 
 variable (K)
-/-- A division_ring is one-dimensional as a vector space over itself. -/
-@[simp] lemma finrank_self : finrank K K = 1 :=
-begin
-  have := dim_self K,
-  rw [←finrank_eq_dim] at this,
-  exact_mod_cast this
-end
 
 instance finite_dimensional_self : finite_dimensional K K :=
 by apply_instance
 
-/-- The vector space of functions on a fintype ι has finrank equal to the cardinality of ι. -/
-@[simp] lemma finrank_fintype_fun_eq_card {ι : Type v} [fintype ι] :
-  finrank K (ι → K) = fintype.card ι :=
-begin
-  have : module.rank K (ι → K) = fintype.card ι := dim_fun',
-  rwa [← finrank_eq_dim, nat_cast_inj] at this,
-end
-
-/-- The vector space of functions on `fin n` has finrank equal to `n`. -/
-@[simp] lemma finrank_fin_fun {n : ℕ} : finrank K (fin n → K) = n :=
-by simp
-
 /-- The submodule generated by a finite set is finite-dimensional. -/
 theorem span_of_finite {A : set V} (hA : set.finite A) :
   finite_dimensional K (submodule.span K A) :=
@@ -430,18 +361,7 @@ span_of_finite K $ s.finite_to_set
 /-- Pushforwards of finite-dimensional submodules are finite-dimensional. -/
 instance (f : V →ₗ[K] V₂) (p : submodule K V) [h : finite_dimensional K p] :
   finite_dimensional K (p.map f) :=
-begin
-  unfreezingI { rw [finite_dimensional, ← iff_fg, is_noetherian.iff_dim_lt_omega] at h ⊢ },
-  rw [← cardinal.lift_lt.{v' v}],
-  rw [← cardinal.lift_lt.{v v'}] at h,
-  rw [cardinal.lift_omega] at h ⊢,
-  exact (lift_dim_map_le f p).trans_lt h
-end
-
-/-- Pushforwards of finite-dimensional submodules have a smaller finrank. -/
-lemma finrank_map_le (f : V →ₗ[K] V₂) (p : submodule K V) [finite_dimensional K p] :
-  finrank K (p.map f) ≤ finrank K p :=
-by simpa [← finrank_eq_dim] using lift_dim_map_le f p
+module.finite.map _ _
 
 variable {K}
 
@@ -453,7 +373,7 @@ begin
   { rwa cardinal.lift_le at this },
   calc cardinal.lift.{v} (# {i // p i ≠ ⊥})
       ≤ cardinal.lift.{w} (module.rank K V) : hp.subtype_ne_bot_le_rank
-  ... = cardinal.lift.{w} (finrank K V : cardinal.{v}) : by rw finrank_eq_dim
+  ... = cardinal.lift.{w} (finrank K V : cardinal.{v}) : by rw finrank_eq_rank
   ... = cardinal.lift.{v} (finrank K V : cardinal.{w}) : by simp
 end
 
@@ -464,11 +384,11 @@ noncomputable def _root_.complete_lattice.independent.fintype_ne_bot_of_finite_d
   (hp : complete_lattice.independent p) :
   fintype {i : ι // p i ≠ ⊥} :=
 begin
-  suffices : #{i // p i ≠ ⊥} < (ω : cardinal.{w}),
-  { rw cardinal.lt_omega_iff_fintype at this,
+  suffices : #{i // p i ≠ ⊥} < (ℵ₀ : cardinal.{w}),
+  { rw cardinal.lt_aleph_0_iff_fintype at this,
     exact this.some },
   refine lt_of_le_of_lt hp.subtype_ne_bot_le_finrank_aux _,
-  simp [cardinal.nat_lt_omega],
+  simp [cardinal.nat_lt_aleph_0],
 end
 
 /-- If `p` is an independent family of subspaces of a finite-dimensional space `V`, then the
@@ -490,7 +410,7 @@ open finset
 If a finset has cardinality larger than the dimension of the space,
 then there is a nontrivial linear relation amongst its elements.
 -/
-lemma exists_nontrivial_relation_of_dim_lt_card
+lemma exists_nontrivial_relation_of_rank_lt_card
   [finite_dimensional K V] {t : finset V} (h : finrank K V < t.card) :
   ∃ f : V → K, ∑ e in t, f e • e = 0 ∧ ∃ x ∈ t, f x ≠ 0 :=
 begin
@@ -525,7 +445,7 @@ If a finset has cardinality larger than `finrank + 1`,
 then there is a nontrivial linear relation amongst its elements,
 such that the coefficients of the relation sum to zero.
 -/
-lemma exists_nontrivial_relation_sum_zero_of_dim_succ_lt_card
+lemma exists_nontrivial_relation_sum_zero_of_rank_succ_lt_card
   [finite_dimensional K V] {t : finset V} (h : finrank K V + 1 < t.card) :
   ∃ f : V → K, ∑ e in t, f e • e = 0 ∧ ∑ e in t, f e = 0 ∧ ∃ x ∈ t, f x ≠ 0 :=
 begin
@@ -539,7 +459,7 @@ begin
   { simp only [t', card_map, finset.card_erase_of_mem m],
     exact nat.lt_pred_iff.mpr h, },
   -- to obtain a function `g`.
-  obtain ⟨g, gsum, x₁, x₁_mem, nz⟩ := exists_nontrivial_relation_of_dim_lt_card h',
+  obtain ⟨g, gsum, x₁, x₁_mem, nz⟩ := exists_nontrivial_relation_of_rank_lt_card h',
   -- Then obtain `f` by translating back by `x₀`,
   -- and setting the value of `f` at `x₀` to ensure `∑ e in t, f e = 0`.
   let f : V → K := λ z, if z = x₀ then - ∑ z in (t.erase x₀), g (z - x₀) else g (z - x₀),
@@ -591,15 +511,15 @@ variables {L : Type*} [linear_ordered_field L]
 variables {W : Type v} [add_comm_group W] [module L W]
 
 /--
-A slight strengthening of `exists_nontrivial_relation_sum_zero_of_dim_succ_lt_card`
+A slight strengthening of `exists_nontrivial_relation_sum_zero_of_rank_succ_lt_card`
 available when working over an ordered field:
 we can ensure a positive coefficient, not just a nonzero coefficient.
 -/
-lemma exists_relation_sum_zero_pos_coefficient_of_dim_succ_lt_card
+lemma exists_relation_sum_zero_pos_coefficient_of_rank_succ_lt_card
   [finite_dimensional L W] {t : finset W} (h : finrank L W + 1 < t.card) :
   ∃ f : W → L, ∑ e in t, f e • e = 0 ∧ ∑ e in t, f e = 0 ∧ ∃ x ∈ t, 0 < f x :=
 begin
-  obtain ⟨f, sum, total, nonzero⟩ := exists_nontrivial_relation_sum_zero_of_dim_succ_lt_card h,
+  obtain ⟨f, sum, total, nonzero⟩ := exists_nontrivial_relation_sum_zero_of_rank_succ_lt_card h,
   exact ⟨f, sum, total, exists_pos_of_sum_zero_of_exists_nonzero f total nonzero⟩,
 end
 
@@ -649,84 +569,57 @@ end finite_dimensional
 
 variables {K V}
 
-section zero_dim
+section zero_rank
 
 variables [division_ring K] [add_comm_group V] [module K V]
 
 open finite_dimensional
 
-lemma finite_dimensional_of_dim_eq_zero (h : module.rank K V = 0) : finite_dimensional K V :=
+lemma finite_dimensional_of_rank_eq_nat {n : ℕ} (h : module.rank K V = n) :
+  finite_dimensional K V :=
 begin
-  dsimp [finite_dimensional],
-  rw [← is_noetherian.iff_fg, is_noetherian.iff_dim_lt_omega, h],
-  exact cardinal.omega_pos
+  rw [finite_dimensional, ← is_noetherian.iff_fg, is_noetherian.iff_rank_lt_aleph_0, h],
+  exact nat_lt_aleph_0 n,
 end
+/- TODO: generalize to free modules over general rings. -/
 
-lemma finite_dimensional_of_dim_eq_one (h : module.rank K V = 1) : finite_dimensional K V :=
-begin
-  dsimp [finite_dimensional],
-  rw [← is_noetherian.iff_fg, is_noetherian.iff_dim_lt_omega, h],
-  exact one_lt_omega
-end
+lemma finite_dimensional_of_rank_eq_zero (h : module.rank K V = 0) : finite_dimensional K V :=
+finite_dimensional_of_rank_eq_nat $ h.trans nat.cast_zero.symm
 
-lemma finrank_eq_zero_of_dim_eq_zero [finite_dimensional K V] (h : module.rank K V = 0) :
+lemma finite_dimensional_of_rank_eq_one (h : module.rank K V = 1) : finite_dimensional K V :=
+finite_dimensional_of_rank_eq_nat $ h.trans nat.cast_one.symm
+
+lemma finrank_eq_zero_of_rank_eq_zero [finite_dimensional K V] (h : module.rank K V = 0) :
   finrank K V = 0 :=
 begin
-  convert finrank_eq_dim K V,
+  convert finrank_eq_rank K V,
   rw h, norm_cast
 end
 
-lemma finrank_eq_zero_of_basis_imp_not_finite
-  (h : ∀ s : set V, basis.{v} (s : set V) K V → ¬ s.finite) : finrank K V = 0 :=
-dif_neg (λ dim_lt,
-  h _ (basis.of_vector_space K V) ((basis.of_vector_space K V).finite_index_of_dim_lt_omega dim_lt))
-
-lemma finrank_eq_zero_of_basis_imp_false
-  (h : ∀ s : finset V, basis.{v} (s : set V) K V → false) : finrank K V = 0 :=
-finrank_eq_zero_of_basis_imp_not_finite (λ s b hs, h hs.to_finset (by { convert b, simp }))
-
-lemma finrank_eq_zero_of_not_exists_basis
-  (h : ¬ (∃ s : finset V, nonempty (basis (s : set V) K V))) : finrank K V = 0 :=
-finrank_eq_zero_of_basis_imp_false (λ s b, h ⟨s, ⟨b⟩⟩)
-
-lemma finrank_eq_zero_of_not_exists_basis_finite
-  (h : ¬ ∃ (s : set V) (b : basis.{v} (s : set V) K V), s.finite) : finrank K V = 0 :=
-finrank_eq_zero_of_basis_imp_not_finite (λ s b hs, h ⟨s, b, hs⟩)
-
-lemma finrank_eq_zero_of_not_exists_basis_finset
-  (h : ¬ ∃ (s : finset V), nonempty (basis s K V)) : finrank K V = 0 :=
-finrank_eq_zero_of_basis_imp_false (λ s b, h ⟨s, ⟨b⟩⟩)
-
 variables (K V)
 
 instance finite_dimensional_bot : finite_dimensional K (⊥ : submodule K V) :=
-finite_dimensional_of_dim_eq_zero $ by simp
-
-@[simp] lemma finrank_bot : finrank K (⊥ : submodule K V) = 0 :=
-begin
-  convert finrank_eq_dim K (⊥ : submodule K V),
-  rw dim_bot, norm_cast
-end
+finite_dimensional_of_rank_eq_zero $ by simp
 
 variables {K V}
 
-lemma bot_eq_top_of_dim_eq_zero (h : module.rank K V = 0) : (⊥ : submodule K V) = ⊤ :=
+lemma bot_eq_top_of_rank_eq_zero (h : module.rank K V = 0) : (⊥ : submodule K V) = ⊤ :=
 begin
-  haveI := finite_dimensional_of_dim_eq_zero h,
+  haveI := finite_dimensional_of_rank_eq_zero h,
   apply eq_top_of_finrank_eq,
-  rw [finrank_bot, finrank_eq_zero_of_dim_eq_zero h]
+  rw [finrank_bot, finrank_eq_zero_of_rank_eq_zero h]
 end
 
-@[simp] theorem dim_eq_zero {S : submodule K V} : module.rank K S = 0 ↔ S = ⊥ :=
+@[simp] theorem rank_eq_zero {S : submodule K V} : module.rank K S = 0 ↔ S = ⊥ :=
 ⟨λ h, (submodule.eq_bot_iff _).2 $ λ x hx, congr_arg subtype.val $
-  ((submodule.eq_bot_iff _).1 $ eq.symm $ bot_eq_top_of_dim_eq_zero h) ⟨x, hx⟩ submodule.mem_top,
-λ h, by rw [h, dim_bot]⟩
+  ((submodule.eq_bot_iff _).1 $ eq.symm $ bot_eq_top_of_rank_eq_zero h) ⟨x, hx⟩ submodule.mem_top,
+λ h, by rw [h, rank_bot]⟩
 
 @[simp] theorem finrank_eq_zero {S : submodule K V} [finite_dimensional K S] :
   finrank K S = 0 ↔ S = ⊥ :=
-by rw [← dim_eq_zero, ← finrank_eq_dim, ← @nat.cast_zero cardinal, cardinal.nat_cast_inj]
+by rw [← rank_eq_zero, ← finrank_eq_rank, ← @nat.cast_zero cardinal, cardinal.nat_cast_inj]
 
-end zero_dim
+end zero_rank
 
 namespace submodule
 open is_noetherian finite_dimensional
@@ -745,8 +638,8 @@ lemma finite_dimensional_of_le {S₁ S₂ : submodule K V} [finite_dimensional K
   finite_dimensional K S₁ :=
 begin
   haveI : is_noetherian K S₂ := iff_fg.2 infer_instance,
-  exact iff_fg.1 (is_noetherian.iff_dim_lt_omega.2
-    (lt_of_le_of_lt (dim_le_of_submodule _ _ h) (dim_lt_omega K S₂))),
+  exact iff_fg.1 (is_noetherian.iff_rank_lt_aleph_0.2
+    (lt_of_le_of_lt (rank_le_of_submodule _ _ h) (finite_dimensional.rank_lt_aleph_0 K S₂))),
 end
 
 /-- The inf of two submodules, the first finite-dimensional, is
@@ -786,49 +679,22 @@ begin
 end
 
 /-- The submodule generated by a supremum of finite dimensional submodules, indexed by a finite
-type is finite-dimensional. -/
-instance finite_dimensional_supr {ι : Type*} [fintype ι] (S : ι → submodule K V)
+sort is finite-dimensional. -/
+instance finite_dimensional_supr {ι : Sort*} [_root_.finite ι] (S : ι → submodule K V)
   [Π i, finite_dimensional K (S i)] : finite_dimensional K ↥(⨆ i, S i) :=
 begin
-  rw ←finset.sup_univ_eq_supr,
+  casesI nonempty_fintype (plift ι),
+  rw [←supr_plift_down, ← finset.sup_univ_eq_supr],
   exact submodule.finite_dimensional_finset_sup _ _,
 end
 
-/-- The submodule generated by a supremum indexed by a proposition is finite-dimensional if
-the submodule is. -/
-instance finite_dimensional_supr_prop {P : Prop} (S : P → submodule K V)
-  [Π h, finite_dimensional K (S h)] : finite_dimensional K ↥(⨆ h, S h) :=
-begin
-  by_cases hp : P,
-  { rw supr_pos hp,
-    apply_instance },
-  { rw supr_neg hp,
-    apply_instance },
-end
-
-/-- The dimension of a submodule is bounded by the dimension of the ambient space. -/
-lemma finrank_le [finite_dimensional K V] (s : submodule K V) : finrank K s ≤ finrank K V :=
-by simpa only [cardinal.nat_cast_le, ←finrank_eq_dim] using
-  s.subtype.dim_le_of_injective (injective_subtype s)
-
-/-- The dimension of a quotient is bounded by the dimension of the ambient space. -/
-lemma finrank_quotient_le [finite_dimensional K V] (s : submodule K V) :
-  finrank K (V ⧸ s) ≤ finrank K V :=
-by simpa only [cardinal.nat_cast_le, ←finrank_eq_dim] using
-  (mkq s).dim_le_of_surjective (surjective_quot_mk _)
-
-end division_ring
-
-section field
-variables [field K] [add_comm_group V] [module K V]
-
 /-- In a finite-dimensional vector space, the dimensions of a submodule and of the corresponding
 quotient add up to the dimension of the space. -/
 theorem finrank_quotient_add_finrank [finite_dimensional K V] (s : submodule K V) :
   finrank K (V ⧸ s) + finrank K s = finrank K V :=
 begin
-  have := dim_quotient_add_dim s,
-  rw [← finrank_eq_dim, ← finrank_eq_dim, ← finrank_eq_dim] at this,
+  have := rank_quotient_add_rank s,
+  rw [← finrank_eq_rank, ← finrank_eq_rank, ← finrank_eq_rank] at this,
   exact_mod_cast this
 end
 
@@ -842,32 +708,37 @@ begin
 end
 
 /-- The sum of the dimensions of s + t and s ∩ t is the sum of the dimensions of s and t -/
-theorem dim_sup_add_dim_inf_eq (s t : submodule K V)
+theorem finrank_sup_add_finrank_inf_eq (s t : submodule K V)
   [finite_dimensional K s] [finite_dimensional K t] :
   finrank K ↥(s ⊔ t) + finrank K ↥(s ⊓ t) = finrank K ↥s + finrank K ↥t :=
 begin
   have key : module.rank K ↥(s ⊔ t) + module.rank K ↥(s ⊓ t) =
-    module.rank K s + module.rank K t := dim_sup_add_dim_inf_eq s t,
-  repeat { rw ←finrank_eq_dim at key },
+    module.rank K s + module.rank K t := rank_sup_add_rank_inf_eq s t,
+  repeat { rw ←finrank_eq_rank at key },
   norm_cast at key,
   exact key
 end
 
+lemma finrank_add_le_finrank_add_finrank (s t : submodule K V)
+  [finite_dimensional K s] [finite_dimensional K t] :
+  finrank K (s ⊔ t : submodule K V) ≤ finrank K s + finrank K t :=
+by { rw [← finrank_sup_add_finrank_inf_eq], exact self_le_add_right _ _ }
+
 lemma eq_top_of_disjoint [finite_dimensional K V] (s t : submodule K V)
   (hdim : finrank K s + finrank K t = finrank K V)
   (hdisjoint : disjoint s t) : s ⊔ t = ⊤ :=
 begin
   have h_finrank_inf : finrank K ↥(s ⊓ t) = 0,
-  { rw [disjoint, le_bot_iff] at hdisjoint,
+  { rw [disjoint_iff_inf_le, le_bot_iff] at hdisjoint,
     rw [hdisjoint, finrank_bot] },
   apply eq_top_of_finrank_eq,
   rw ←hdim,
-  convert s.dim_sup_add_dim_inf_eq t,
+  convert s.finrank_sup_add_finrank_inf_eq t,
   rw h_finrank_inf,
   refl,
 end
 
-end field
+end division_ring
 
 end submodule
 
@@ -885,26 +756,14 @@ module.finite.equiv f
 variables {R M M₂ : Type*} [ring R] [add_comm_group M] [add_comm_group M₂]
 variables [module R M] [module R M₂]
 
-/-- The dimension of a finite dimensional space is preserved under linear equivalence. -/
-theorem finrank_eq (f : M ≃ₗ[R] M₂) : finrank R M = finrank R M₂ :=
-by { unfold finrank, rw [← cardinal.to_nat_lift, f.lift_dim_eq, cardinal.to_nat_lift] }
-
-/-- Pushforwards of finite-dimensional submodules along a `linear_equiv` have the same finrank. -/
-lemma finrank_map_eq (f : M ≃ₗ[R] M₂) (p : submodule R M) :
-  finrank R (p.map (f : M →ₗ[R] M₂)) = finrank R p :=
-(f.submodule_map p).finrank_eq.symm
-
 end linear_equiv
 
 section
 variables [division_ring K] [add_comm_group V] [module K V]
 
-instance finite_dimensional_finsupp {ι : Type*} [fintype ι] [h : finite_dimensional K V] :
+instance finite_dimensional_finsupp {ι : Type*} [_root_.finite ι] [h : finite_dimensional K V] :
   finite_dimensional K (ι →₀ V) :=
-begin
-  letI : is_noetherian K V := is_noetherian.iff_fg.2 infer_instance,
-  exact (finsupp.linear_equiv_fun_on_fintype K V ι).symm.finite_dimensional
-end
+(finsupp.linear_equiv_fun_on_finite K V ι).symm.finite_dimensional
 
 end
 
@@ -914,32 +773,6 @@ section division_ring
 variables [division_ring K] [add_comm_group V] [module K V]
 {V₂ : Type v'} [add_comm_group V₂] [module K V₂]
 
-/--
-Two finite-dimensional vector spaces are isomorphic if they have the same (finite) dimension.
--/
-theorem nonempty_linear_equiv_of_finrank_eq [finite_dimensional K V] [finite_dimensional K V₂]
-  (cond : finrank K V = finrank K V₂) : nonempty (V ≃ₗ[K] V₂) :=
-nonempty_linear_equiv_of_lift_dim_eq $ by simp only [← finrank_eq_dim, cond, lift_nat_cast]
-
-/--
-Two finite-dimensional vector spaces are isomorphic if and only if they have the same (finite)
-dimension.
--/
-theorem nonempty_linear_equiv_iff_finrank_eq [finite_dimensional K V] [finite_dimensional K V₂] :
-   nonempty (V ≃ₗ[K] V₂) ↔ finrank K V = finrank K V₂ :=
-⟨λ ⟨h⟩, h.finrank_eq, λ h, nonempty_linear_equiv_of_finrank_eq h⟩
-
-variables (V V₂)
-
-/--
-Two finite-dimensional vector spaces are isomorphic if they have the same (finite) dimension.
--/
-noncomputable def linear_equiv.of_finrank_eq [finite_dimensional K V] [finite_dimensional K V₂]
-  (cond : finrank K V = finrank K V₂) : V ≃ₗ[K] V₂ :=
-classical.choice $ nonempty_linear_equiv_of_finrank_eq cond
-
-variables {V}
-
 lemma eq_of_le_of_finrank_le {S₁ S₂ : submodule K V} [finite_dimensional K S₂] (hle : S₁ ≤ S₂)
   (hd : finrank K S₂ ≤ finrank K S₁) : S₁ = S₂ :=
 begin
@@ -954,17 +787,6 @@ lemma eq_of_le_of_finrank_eq {S₁ S₂ : submodule K V} [finite_dimensional K S
   (hd : finrank K S₁ = finrank K S₂) : S₁ = S₂ :=
 eq_of_le_of_finrank_le hle hd.ge
 
-@[simp]
-lemma finrank_map_subtype_eq (p : submodule K V) (q : submodule K p) :
-  finite_dimensional.finrank K (q.map p.subtype) = finite_dimensional.finrank K q :=
-(submodule.equiv_subtype_map p q).symm.finrank_eq
-
-end division_ring
-
-section field
-variables [field K] [add_comm_group V] [module K V]
-{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
-
 variables [finite_dimensional K V] [finite_dimensional K V₂]
 
 /-- Given isomorphic subspaces `p q` of vector spaces `V` and `V₁` respectively,
@@ -974,21 +796,19 @@ noncomputable def linear_equiv.quot_equiv_of_equiv
   (f₁ : p ≃ₗ[K] q) (f₂ : V ≃ₗ[K] V₂) : (V ⧸ p) ≃ₗ[K] (V₂ ⧸ q) :=
 linear_equiv.of_finrank_eq _ _
 begin
-  rw [← @add_right_cancel_iff _ _ (finrank K p), submodule.finrank_quotient_add_finrank,
+  rw [← @add_right_cancel_iff _ _ _ (finrank K p), submodule.finrank_quotient_add_finrank,
       linear_equiv.finrank_eq f₁, submodule.finrank_quotient_add_finrank,
       linear_equiv.finrank_eq f₂],
 end
+/- TODO: generalize to the case where one of `p` and `q` is finite-dimensional. -/
 
 /-- Given the subspaces `p q`, if `p.quotient ≃ₗ[K] q`, then `q.quotient ≃ₗ[K] p` -/
 noncomputable def linear_equiv.quot_equiv_of_quot_equiv
   {p q : subspace K V} (f : (V ⧸ p) ≃ₗ[K] q) : (V ⧸ q) ≃ₗ[K] p :=
-linear_equiv.of_finrank_eq _ _
-begin
-  rw [← @add_right_cancel_iff _ _ (finrank K q), submodule.finrank_quotient_add_finrank,
-      ← linear_equiv.finrank_eq f, add_comm, submodule.finrank_quotient_add_finrank]
-end
+linear_equiv.of_finrank_eq _ _ $ add_right_cancel $ by rw [submodule.finrank_quotient_add_finrank,
+  ← linear_equiv.finrank_eq f, add_comm, submodule.finrank_quotient_add_finrank]
 
-end field
+end division_ring
 
 end finite_dimensional
 
@@ -1003,31 +823,20 @@ variables [division_ring K] [add_comm_group V] [module K V]
 lemma surjective_of_injective [finite_dimensional K V] {f : V →ₗ[K] V}
   (hinj : injective f) : surjective f :=
 begin
-  have h := dim_eq_of_injective _ hinj,
-  rw [← finrank_eq_dim, ← finrank_eq_dim, nat_cast_inj] at h,
+  have h := rank_eq_of_injective _ hinj,
+  rw [← finrank_eq_rank, ← finrank_eq_rank, nat_cast_inj] at h,
   exact range_eq_top.1 (eq_top_of_finrank_eq h.symm)
 end
 
 /-- The image under an onto linear map of a finite-dimensional space is also finite-dimensional. -/
-lemma finite_dimensional_of_surjective [h : finite_dimensional K V]
+lemma finite_dimensional_of_surjective [finite_dimensional K V]
   (f : V →ₗ[K] V₂) (hf : f.range = ⊤) : finite_dimensional K V₂ :=
 module.finite.of_surjective f $ range_eq_top.1 hf
 
 /-- The range of a linear map defined on a finite-dimensional space is also finite-dimensional. -/
-instance finite_dimensional_range [h : finite_dimensional K V] (f : V →ₗ[K] V₂) :
+instance finite_dimensional_range [finite_dimensional K V] (f : V →ₗ[K] V₂) :
   finite_dimensional K f.range :=
-f.quot_ker_equiv_range.finite_dimensional
-
-/-- The dimensions of the domain and range of an injective linear map are equal. -/
-lemma finrank_range_of_inj {f : V →ₗ[K] V₂} (hf : function.injective f) :
-  finrank K f.range = finrank K V :=
-by rw (linear_equiv.of_injective f hf).finrank_eq
-
-end division_ring
-
-section field
-variables [field K] [add_comm_group V] [module K V]
-{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+module.finite.range f
 
 /-- On a finite-dimensional space, a linear map is injective if and only if it is surjective. -/
 lemma injective_iff_surjective [finite_dimensional K V] {f : V →ₗ[K] V} :
@@ -1069,18 +878,18 @@ theorem finrank_range_add_finrank_ker [finite_dimensional K V] (f : V →ₗ[K]
   finrank K f.range + finrank K f.ker = finrank K V :=
 by { rw [← f.quot_ker_equiv_range.finrank_eq], exact submodule.finrank_quotient_add_finrank _ }
 
-end field
+end division_ring
 end linear_map
 
 namespace linear_equiv
 open finite_dimensional
 
-variables [field K] [add_comm_group V] [module K V]
+variables [division_ring K] [add_comm_group V] [module K V]
 variables [finite_dimensional K V]
 
 /-- The linear equivalence corresponging to an injective endomorphism. -/
 noncomputable def of_injective_endo (f : V →ₗ[K] V) (h_inj : injective f) : V ≃ₗ[K] V :=
-linear_equiv.of_bijective f h_inj $ linear_map.injective_iff_surjective.mp h_inj
+linear_equiv.of_bijective f ⟨h_inj, linear_map.injective_iff_surjective.mp h_inj⟩
 
 @[simp] lemma coe_of_injective_endo (f : V →ₗ[K] V) (h_inj : injective f) :
   ⇑(of_injective_endo f h_inj) = f := rfl
@@ -1097,7 +906,7 @@ end linear_equiv
 
 namespace linear_map
 
-variables [field K] [add_comm_group V] [module K V]
+variables [division_ring K] [add_comm_group V] [module K V]
 
 lemma is_unit_iff_ker_eq_bot [finite_dimensional K V] (f : V →ₗ[K] V): is_unit f ↔ f.ker = ⊥ :=
 begin
@@ -1120,14 +929,6 @@ open module finite_dimensional
 section
 variables [division_ring K] [add_comm_group V] [module K V]
 
-section top
-
-@[simp]
-theorem finrank_top : finrank K (⊤ : submodule K V) = finrank K V :=
-by { unfold finrank, simp [dim_top] }
-
-end top
-
 lemma finrank_zero_iff_forall_zero [finite_dimensional K V] :
   finrank K V = 0 ↔ ∀ x : V, x = 0 :=
 finrank_zero_iff.trans (subsingleton_iff_forall_eq 0)
@@ -1145,7 +946,7 @@ end
 
 namespace linear_map
 
-variables [field K] [add_comm_group V] [module K V]
+variables [division_ring K] [add_comm_group V] [module K V]
 {V₂ : Type v'} [add_comm_group V₂] [module K V₂]
 
 theorem injective_iff_surjective_of_finrank_eq_finrank [finite_dimensional K V]
@@ -1163,21 +964,14 @@ lemma ker_eq_bot_iff_range_eq_top_of_finrank_eq_finrank [finite_dimensional K V]
   f.ker = ⊥ ↔ f.range = ⊤ :=
 by rw [range_eq_top, ker_eq_bot, injective_iff_surjective_of_finrank_eq_finrank H]
 
-theorem finrank_le_finrank_of_injective [finite_dimensional K V] [finite_dimensional K V₂]
-  {f : V →ₗ[K] V₂} (hf : function.injective f) : finrank K V ≤ finrank K V₂ :=
-calc  finrank K V
-    = finrank K f.range + finrank K f.ker : (finrank_range_add_finrank_ker f).symm
-... = finrank K f.range : by rw [ker_eq_bot.2 hf, finrank_bot, add_zero]
-... ≤ finrank K V₂ : submodule.finrank_le _
-
 /-- Given a linear map `f` between two vector spaces with the same dimension, if
 `ker f = ⊥` then `linear_equiv_of_injective` is the induced isomorphism
 between the two vector spaces. -/
 noncomputable def linear_equiv_of_injective
   [finite_dimensional K V] [finite_dimensional K V₂]
   (f : V →ₗ[K] V₂) (hf : injective f) (hdim : finrank K V = finrank K V₂) : V ≃ₗ[K] V₂ :=
-linear_equiv.of_bijective f hf $
-  (linear_map.injective_iff_surjective_of_finrank_eq_finrank hdim).mp hf
+linear_equiv.of_bijective f ⟨hf,
+  (linear_map.injective_iff_surjective_of_finrank_eq_finrank hdim).mp hf⟩
 
 @[simp] lemma linear_equiv_of_injective_apply
   [finite_dimensional K V] [finite_dimensional K V₂]
@@ -1186,23 +980,6 @@ linear_equiv.of_bijective f hf $
 
 end linear_map
 
-namespace alg_hom
-
-lemma bijective {F : Type*} [field F] {E : Type*} [field E] [algebra F E]
-  [finite_dimensional F E] (ϕ : E →ₐ[F] E) : function.bijective ϕ :=
-have inj : function.injective ϕ.to_linear_map := ϕ.to_ring_hom.injective,
-⟨inj, (linear_map.injective_iff_surjective_of_finrank_eq_finrank rfl).mp inj⟩
-
-end alg_hom
-
-/-- Bijection between algebra equivalences and algebra homomorphisms -/
-noncomputable def alg_equiv_equiv_alg_hom (F : Type u) [field F] (E : Type v) [field E]
-  [algebra F E] [finite_dimensional F E] : (E ≃ₐ[F] E) ≃ (E →ₐ[F] E) :=
-{ to_fun := λ ϕ, ϕ.to_alg_hom,
-  inv_fun := λ ϕ, alg_equiv.of_bijective ϕ ϕ.bijective,
-  left_inv := λ _, by {ext, refl},
-  right_inv := λ _, by {ext, refl} }
-
 section
 
 /-- A domain that is module-finite as an algebra over a field is a division ring. -/
@@ -1210,10 +987,10 @@ noncomputable def division_ring_of_finite_dimensional
   (F K : Type*) [field F] [ring K] [is_domain K]
   [algebra F K] [finite_dimensional F K] : division_ring K :=
 { inv := λ x, if H : x = 0 then 0 else classical.some $
-    (show function.surjective (algebra.lmul_left F x), from
+    (show function.surjective (linear_map.mul_left F x), from
       linear_map.injective_iff_surjective.1 $ λ _ _, (mul_right_inj' H).1) 1,
   mul_inv_cancel := λ x hx, show x * dite _ _ _ = _, by { rw dif_neg hx,
-    exact classical.some_spec ((show function.surjective (algebra.lmul_left F x), from
+    exact classical.some_spec ((show function.surjective (linear_map.mul_left F x), from
       linear_map.injective_iff_surjective.1 $ λ _ _, (mul_right_inj' hx).1) 1) },
   inv_zero := dif_pos rfl,
   .. ‹is_domain K›,
@@ -1234,119 +1011,42 @@ section division_ring
 variables [division_ring K] [add_comm_group V] [module K V]
 {V₂ : Type v'} [add_comm_group V₂] [module K V₂]
 
-lemma lt_of_le_of_finrank_lt_finrank {s t : submodule K V}
-  (le : s ≤ t) (lt : finrank K s < finrank K t) : s < t :=
-lt_of_le_of_ne le (λ h, ne_of_lt lt (by rw h))
-
-lemma lt_top_of_finrank_lt_finrank {s : submodule K V}
-  (lt : finrank K s < finrank K V) : s < ⊤ :=
-begin
-  rw ← @finrank_top K V at lt,
-  exact lt_of_le_of_finrank_lt_finrank le_top lt
-end
+lemma eq_top_of_finrank_eq [finite_dimensional K V] {S : submodule K V}
+  (h : finrank K S = finrank K V) :
+  S = ⊤ := finite_dimensional.eq_of_le_of_finrank_eq le_top (by simp [h, finrank_top])
 
 lemma finrank_mono [finite_dimensional K V] :
   monotone (λ (s : submodule K V), finrank K s) :=
-λ s t hst,
-calc finrank K s = finrank K (comap t.subtype s)
-  : linear_equiv.finrank_eq (comap_subtype_equiv_of_le hst).symm
-... ≤ finrank K t : submodule.finrank_le _
-
-end division_ring
+λ s t, finrank_le_finrank_of_le
 
-section field
-variables [field K] [add_comm_group V] [module K V]
-{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+lemma finrank_lt_finrank_of_lt {s t : submodule K V} [finite_dimensional K t]
+  (hst : s < t) : finrank K s < finrank K t :=
+(comap_subtype_equiv_of_le hst.le).finrank_eq.symm.trans_lt $
+  finrank_lt (le_top.lt_of_ne $ hst.not_le ∘ comap_subtype_eq_top.1)
 
-lemma finrank_lt_finrank_of_lt [finite_dimensional K V] {s t : submodule K V} (hst : s < t) :
-  finrank K s < finrank K t :=
-begin
-  rw linear_equiv.finrank_eq (comap_subtype_equiv_of_le (le_of_lt hst)).symm,
-  refine finrank_lt (lt_of_le_of_ne le_top _),
-  intro h_eq_top,
-  rw comap_subtype_eq_top at h_eq_top,
-  apply not_le_of_lt hst h_eq_top,
-end
+lemma finrank_strict_mono [finite_dimensional K V] :
+  strict_mono (λ s : submodule K V, finrank K s) :=
+λ s t, finrank_lt_finrank_of_lt
 
 lemma finrank_add_eq_of_is_compl
   [finite_dimensional K V] {U W : submodule K V} (h : is_compl U W) :
   finrank K U + finrank K W = finrank K V :=
 begin
-  rw [← submodule.dim_sup_add_dim_inf_eq, top_le_iff.1 h.2, le_bot_iff.1 h.1,
-      finrank_bot, add_zero],
-  exact finrank_top
+  rw [← finrank_sup_add_finrank_inf_eq, h.codisjoint.eq_top, h.disjoint.eq_bot, finrank_bot,
+    add_zero],
+  exact finrank_top _ _
 end
 
-end field
+end division_ring
 
 end submodule
 
-section span
-
-open submodule
-
 section division_ring
-variables [division_ring K] [add_comm_group V] [module K V]
-
-variable (K)
-
-/-- The rank of a set of vectors as a natural number. -/
-protected noncomputable def set.finrank (s : set V) : ℕ := finrank K (span K s)
-
-variable {K}
-
-lemma finrank_span_le_card (s : set V) [fin : fintype s] :
-  finrank K (span K s) ≤ s.to_finset.card :=
-begin
-  haveI := span_of_finite K ⟨fin⟩,
-  have : module.rank K (span K s) ≤ #s := dim_span_le s,
-  rw [←finrank_eq_dim, cardinal.mk_fintype, ←set.to_finset_card] at this,
-  exact_mod_cast this,
-end
-
-lemma finrank_span_finset_le_card (s : finset V)  :
-  (s : set V).finrank K ≤ s.card :=
-calc (s : set V).finrank K ≤ (s : set V).to_finset.card : finrank_span_le_card s
-                                ... = s.card : by simp
-
-lemma finrank_span_eq_card {ι : Type*} [fintype ι] {b : ι → V}
-  (hb : linear_independent K b) :
-  finrank K (span K (set.range b)) = fintype.card ι :=
-begin
-  haveI : finite_dimensional K (span K (set.range b)) := span_of_finite K (set.finite_range b),
-  have : module.rank K (span K (set.range b)) = #(set.range b) := dim_span hb,
-  rwa [←finrank_eq_dim, ←lift_inj, mk_range_eq_of_injective hb.injective,
-    cardinal.mk_fintype, lift_nat_cast, lift_nat_cast, nat_cast_inj] at this,
-end
-
-lemma finrank_span_set_eq_card (s : set V) [fin : fintype s]
-  (hs : linear_independent K (coe : s → V)) :
-  finrank K (span K s) = s.to_finset.card :=
-begin
-  haveI := span_of_finite K ⟨fin⟩,
-  have : module.rank K (span K s) = #s := dim_span_set hs,
-  rw [←finrank_eq_dim, cardinal.mk_fintype, ←set.to_finset_card] at this,
-  exact_mod_cast this,
-end
-
-lemma finrank_span_finset_eq_card (s : finset V)
-  (hs : linear_independent K (coe : s → V)) :
-  finrank K (span K (s : set V)) = s.card :=
-begin
-  convert finrank_span_set_eq_card ↑s hs,
-  ext,
-  simp,
-end
 
-lemma span_lt_of_subset_of_card_lt_finrank {s : set V} [fintype s] {t : submodule K V}
-  (subset : s ⊆ t) (card_lt : s.to_finset.card < finrank K t) : span K s < t :=
-lt_of_le_of_finrank_lt_finrank
-  (span_le.mpr subset)
-  (lt_of_le_of_lt (finrank_span_le_card _) card_lt)
+variables [division_ring K] [add_comm_group V] [module K V]
 
-lemma span_lt_top_of_card_lt_finrank {s : set V} [fintype s]
-  (card_lt : s.to_finset.card < finrank K V) : span K s < ⊤ :=
-lt_top_of_finrank_lt_finrank (lt_of_le_of_lt (finrank_span_le_card _) card_lt)
+section span
+open submodule
 
 lemma finrank_span_singleton {v : V} (hv : v ≠ 0) : finrank K (K ∙ v) = 1 :=
 begin
@@ -1357,129 +1057,13 @@ begin
     simp [hv] }
 end
 
-end division_ring
-
-section field
-variables [field K] [add_comm_group V] [module K V]
-
 lemma set.finrank_mono [finite_dimensional K V] {s t : set V} (h : s ⊆ t) :
   s.finrank K ≤ t.finrank K := finrank_mono (span_mono h)
 
-end field
-
 end span
 
 section basis
 
-section division_ring
-variables [division_ring K] [add_comm_group V] [module K V]
-
-lemma linear_independent_of_span_eq_top_of_card_eq_finrank {ι : Type*} [fintype ι] {b : ι → V}
-  (span_eq : span K (set.range b) = ⊤) (card_eq : fintype.card ι = finrank K V) :
-  linear_independent K b :=
-linear_independent_iff'.mpr $ λ s g dependent i i_mem_s,
-begin
-  by_contra gx_ne_zero,
-  -- We'll derive a contradiction by showing `b '' (univ \ {i})` of cardinality `n - 1`
-  -- spans a vector space of dimension `n`.
-  refine ne_of_lt (span_lt_top_of_card_lt_finrank
-    (show (b '' (set.univ \ {i})).to_finset.card < finrank K V, from _)) _,
-  { calc (b '' (set.univ \ {i})).to_finset.card = ((set.univ \ {i}).to_finset.image b).card
-      : by rw [set.to_finset_card, fintype.card_of_finset]
-    ... ≤ (set.univ \ {i}).to_finset.card : finset.card_image_le
-    ... = (finset.univ.erase i).card : congr_arg finset.card (finset.ext (by simp [and_comm]))
-    ... < finset.univ.card : finset.card_erase_lt_of_mem (finset.mem_univ i)
-    ... = finrank K V : card_eq },
-
-  -- We already have that `b '' univ` spans the whole space,
-  -- so we only need to show that the span of `b '' (univ \ {i})` contains each `b j`.
-  refine trans (le_antisymm (span_mono (set.image_subset_range _ _)) (span_le.mpr _)) span_eq,
-  rintros _ ⟨j, rfl, rfl⟩,
-  -- The case that `j ≠ i` is easy because `b j ∈ b '' (univ \ {i})`.
-  by_cases j_eq : j = i,
-  swap,
-  { refine subset_span ⟨j, (set.mem_diff _).mpr ⟨set.mem_univ _, _⟩, rfl⟩,
-    exact mt set.mem_singleton_iff.mp j_eq },
-
-  -- To show `b i ∈ span (b '' (univ \ {i}))`, we use that it's a weighted sum
-  -- of the other `b j`s.
-  rw [j_eq, set_like.mem_coe, show b i = -((g i)⁻¹ • (s.erase i).sum (λ j, g j • b j)), from _],
-  { refine neg_mem (smul_mem _ _ (sum_mem (λ k hk, _))),
-    obtain ⟨k_ne_i, k_mem⟩ := finset.mem_erase.mp hk,
-    refine smul_mem _ _ (subset_span ⟨k, _, rfl⟩),
-    simpa using k_mem },
-
-  -- To show `b i` is a weighted sum of the other `b j`s, we'll rewrite this sum
-  -- to have the form of the assumption `dependent`.
-  apply eq_neg_of_add_eq_zero,
-  calc b i + (g i)⁻¹ • (s.erase i).sum (λ j, g j • b j)
-      = (g i)⁻¹ • (g i • b i + (s.erase i).sum (λ j, g j • b j))
-    : by rw [smul_add, ←mul_smul, inv_mul_cancel gx_ne_zero, one_smul]
-  ... = (g i)⁻¹ • 0 : congr_arg _ _
-  ... = 0           : smul_zero _,
-  -- And then it's just a bit of manipulation with finite sums.
-  rwa [← finset.insert_erase i_mem_s, finset.sum_insert (finset.not_mem_erase _ _)] at dependent
-end
-
-/-- A finite family of vectors is linearly independent if and only if
-its cardinality equals the dimension of its span. -/
-lemma linear_independent_iff_card_eq_finrank_span {ι : Type*} [fintype ι] {b : ι → V} :
-  linear_independent K b ↔ fintype.card ι = (set.range b).finrank K :=
-begin
-  split,
-  { intro h,
-    exact (finrank_span_eq_card h).symm },
-  { intro hc,
-    let f := (submodule.subtype (span K (set.range b))),
-    let b' : ι → span K (set.range b) :=
-      λ i, ⟨b i, mem_span.2 (λ p hp, hp (set.mem_range_self _))⟩,
-    have hs : span K (set.range b') = ⊤,
-    { rw eq_top_iff',
-      intro x,
-      have h : span K (f '' (set.range b')) = map f (span K (set.range b')) := span_image f,
-      have hf : f '' (set.range b') = set.range b, { ext x, simp [set.mem_image, set.mem_range] },
-      rw hf at h,
-      have hx : (x : V) ∈ span K (set.range b) := x.property,
-      conv at hx { congr, skip, rw h },
-      simpa [mem_map] using hx },
-    have hi : f.ker = ⊥ := ker_subtype _,
-    convert (linear_independent_of_span_eq_top_of_card_eq_finrank hs hc).map' _ hi }
-end
-
-/-- A family of `finrank K V` vectors forms a basis if they span the whole space. -/
-noncomputable def basis_of_span_eq_top_of_card_eq_finrank {ι : Type*} [fintype ι] (b : ι → V)
-  (span_eq : span K (set.range b) = ⊤) (card_eq : fintype.card ι = finrank K V) :
-  basis ι K V :=
-basis.mk (linear_independent_of_span_eq_top_of_card_eq_finrank span_eq card_eq) span_eq
-
-@[simp] lemma coe_basis_of_span_eq_top_of_card_eq_finrank {ι : Type*} [fintype ι] (b : ι → V)
-  (span_eq : span K (set.range b) = ⊤) (card_eq : fintype.card ι = finrank K V) :
-   ⇑(basis_of_span_eq_top_of_card_eq_finrank b span_eq card_eq) = b :=
-basis.coe_mk _ _
-
-/-- A finset of `finrank K V` vectors forms a basis if they span the whole space. -/
-@[simps]
-noncomputable def finset_basis_of_span_eq_top_of_card_eq_finrank {s : finset V}
-  (span_eq : span K (s : set V) = ⊤) (card_eq : s.card = finrank K V) :
-  basis (s : set V) K V :=
-basis_of_span_eq_top_of_card_eq_finrank (coe : (s : set V) → V)
-  ((@subtype.range_coe_subtype _ (λ x, x ∈ s)).symm ▸ span_eq)
-  (trans (fintype.card_coe _) card_eq)
-
-/-- A set of `finrank K V` vectors forms a basis if they span the whole space. -/
-@[simps]
-noncomputable def set_basis_of_span_eq_top_of_card_eq_finrank {s : set V} [fintype s]
-  (span_eq : span K s = ⊤) (card_eq : s.to_finset.card = finrank K V) :
-  basis s K V :=
-basis_of_span_eq_top_of_card_eq_finrank (coe : s → V)
-  ((@subtype.range_coe_subtype _ s).symm ▸ span_eq)
-  (trans s.to_finset_card.symm card_eq)
-
-end division_ring
-
-section field
-variables [field K] [add_comm_group V] [module K V]
-
 lemma span_eq_top_of_linear_independent_of_card_eq_finrank
   {ι : Type*} [hι : nonempty ι] [fintype ι] {b : ι → V}
   (lin_ind : linear_independent K b) (card_eq : fintype.card ι = finrank K V) :
@@ -1495,7 +1079,7 @@ begin
     symmetry,
     replace fin := (not_iff_not.2 is_noetherian.iff_fg).2 fin,
     calc fintype.card ι = finrank K V : card_eq
-                    ... = 0 : dif_neg (mt is_noetherian.iff_dim_lt_omega.mpr fin) }
+                    ... = 0 : dif_neg (mt is_noetherian.iff_rank_lt_aleph_0.mpr fin) }
 end
 
 /-- A linear independent family of `finrank K V` vectors forms a basis. -/
@@ -1505,7 +1089,7 @@ noncomputable def basis_of_linear_independent_of_card_eq_finrank
   (lin_ind : linear_independent K b) (card_eq : fintype.card ι = finrank K V) :
   basis ι K V :=
 basis.mk lin_ind $
-span_eq_top_of_linear_independent_of_card_eq_finrank lin_ind card_eq
+(span_eq_top_of_linear_independent_of_card_eq_finrank lin_ind card_eq).ge
 
 @[simp] lemma coe_basis_of_linear_independent_of_card_eq_finrank
   {ι : Type*} [nonempty ι] [fintype ι] {b : ι → V}
@@ -1544,8 +1128,6 @@ basis_of_linear_independent_of_card_eq_finrank lin_ind (trans s.to_finset_card.s
   ⇑(set_basis_of_linear_independent_of_card_eq_finrank lin_ind card_eq) = coe :=
 basis.coe_mk _ _
 
-end field
-
 end basis
 
 /-!
@@ -1553,31 +1135,6 @@ We now give characterisations of `finrank K V = 1` and `finrank K V ≤ 1`.
 -/
 section finrank_eq_one
 
-variables [division_ring K] [add_comm_group V] [module K V]
-
-/-- If there is a nonzero vector and every other vector is a multiple of it,
-then the module has dimension one. -/
-lemma finrank_eq_one (v : V) (n : v ≠ 0) (h : ∀ w : V, ∃ c : K, c • v = w) :
-  finrank K V = 1 :=
-begin
-  obtain ⟨b⟩ := (basis.basis_singleton_iff punit).mpr ⟨v, n, h⟩,
-  rw [finrank_eq_card_basis b, fintype.card_punit]
-end
-
-/--
-If every vector is a multiple of some `v : V`, then `V` has dimension at most one.
--/
-lemma finrank_le_one (v : V) (h : ∀ w : V, ∃ c : K, c • v = w) :
-  finrank K V ≤ 1 :=
-begin
-  by_cases n : v = 0,
-  { subst n,
-    convert zero_le_one,
-    haveI := subsingleton_of_forall_eq (0 : V) (λ w, by { obtain ⟨c, rfl⟩ := h w, simp, }),
-    exact finrank_zero_of_subsingleton, },
-  { exact (finrank_eq_one v n h).le, }
-end
-
 /--
 A vector space with a nonzero vector `v` has dimension 1 iff `v` spans.
 -/
@@ -1642,13 +1199,20 @@ begin
     exact finrank_le_one v p, }
 end
 
+lemma submodule.finrank_le_one_iff_is_principal (W : submodule K V) [finite_dimensional K W] :
+  finrank K W ≤ 1 ↔ W.is_principal :=
+by rw [← W.rank_le_one_iff_is_principal, ← finrank_eq_rank, ← cardinal.nat_cast_le, nat.cast_one]
+
+lemma module.finrank_le_one_iff_top_is_principal [finite_dimensional K V] :
+  finrank K V ≤ 1 ↔ (⊤ : submodule K V).is_principal :=
+by rw [← module.rank_le_one_iff_top_is_principal, ← finrank_eq_rank,
+  ← cardinal.nat_cast_le, nat.cast_one]
+
 -- We use the `linear_map.compatible_smul` typeclass here, to encompass two situations:
 -- * `A = K`
 -- * `[field K] [algebra K A] [is_scalar_tower K A V] [is_scalar_tower K A W]`
-lemma surjective_of_nonzero_of_finrank_eq_one
-  {K : Type*} [division_ring K] {A : Type*} [semiring A]
-  [module K V] [module A V]
-  {W : Type*} [add_comm_group W] [module K W] [module A W] [linear_map.compatible_smul V W K A]
+lemma surjective_of_nonzero_of_finrank_eq_one {W A : Type*} [semiring A]
+  [module A V] [add_comm_group W] [module K W] [module A W] [linear_map.compatible_smul V W K A]
   (h : finrank K W = 1) {f : V →ₗ[A] W} (w : f ≠ 0) : surjective f :=
 begin
   change surjective (f.restrict_scalars K),
@@ -1658,107 +1222,105 @@ begin
   exact ⟨c • v, by simp⟩,
 end
 
-end finrank_eq_one
-
-section subalgebra_dim
-open module
-variables {F E : Type*} [field F] [field E] [algebra F E]
-
-lemma subalgebra.dim_eq_one_of_eq_bot {S : subalgebra F E} (h : S = ⊥) : module.rank F S = 1 :=
+/-- Any `K`-algebra module that is 1-dimensional over `K` is simple. -/
+lemma is_simple_module_of_finrank_eq_one {A} [semiring A] [module A V] [has_smul K A]
+  [is_scalar_tower K A V] (h : finrank K V = 1) : is_simple_order (submodule A V) :=
 begin
-  rw [← S.to_submodule_equiv.dim_eq, h,
-    (linear_equiv.of_eq (⊥ : subalgebra F E).to_submodule _ algebra.to_submodule_bot).dim_eq,
-    dim_span_set],
-  exacts [mk_singleton _, linear_independent_singleton one_ne_zero]
+  haveI := nontrivial_of_finrank_eq_succ h,
+  refine ⟨λ S, or_iff_not_imp_left.2 (λ hn, _)⟩,
+  rw ← restrict_scalars_inj K at hn ⊢,
+  haveI := finite_dimensional_of_finrank_eq_succ h,
+  refine eq_top_of_finrank_eq ((submodule.finrank_le _).antisymm _),
+  simpa only [h, finrank_bot] using submodule.finrank_strict_mono (ne.bot_lt hn),
 end
 
-@[simp]
-lemma subalgebra.dim_bot : module.rank F (⊥ : subalgebra F E) = 1 :=
-subalgebra.dim_eq_one_of_eq_bot rfl
-
-lemma subalgebra_top_dim_eq_submodule_top_dim :
-  module.rank F (⊤ : subalgebra F E) = module.rank F (⊤ : submodule F E) :=
-by { rw ← algebra.top_to_submodule, refl }
+end finrank_eq_one
 
-lemma subalgebra_top_finrank_eq_submodule_top_finrank :
-  finrank F (⊤ : subalgebra F E) = finrank F (⊤ : submodule F E) :=
-by { rw ← algebra.top_to_submodule, refl }
+end division_ring
 
-lemma subalgebra.dim_top : module.rank F (⊤ : subalgebra F E) = module.rank F E :=
-by { rw subalgebra_top_dim_eq_submodule_top_dim, exact dim_top F E }
+section subalgebra_rank
+open module
+variables {F E : Type*} [field F] [ring E] [algebra F E]
 
-instance subalgebra.finite_dimensional_bot : finite_dimensional F (⊥ : subalgebra F E) :=
-finite_dimensional_of_dim_eq_one subalgebra.dim_bot
+/-- A `subalgebra` is `finite_dimensional` iff it is finite_dimensional as a submodule. -/
+lemma subalgebra.finite_dimensional_to_submodule {S : subalgebra F E} :
+  finite_dimensional F S.to_submodule ↔ finite_dimensional F S := iff.rfl
 
-@[simp]
-lemma subalgebra.finrank_bot : finrank F (⊥ : subalgebra F E) = 1 :=
-begin
-  have : module.rank F (⊥ : subalgebra F E) = 1 := subalgebra.dim_bot,
-  rw ← finrank_eq_dim at this,
-  norm_cast at *,
-  simp *,
-end
+alias subalgebra.finite_dimensional_to_submodule ↔
+  finite_dimensional.of_subalgebra_to_submodule finite_dimensional.subalgebra_to_submodule
 
-lemma subalgebra.finrank_eq_one_of_eq_bot {S : subalgebra F E} (h : S = ⊥) : finrank F S = 1 :=
-by { rw h, exact subalgebra.finrank_bot }
+instance finite_dimensional.finite_dimensional_subalgebra [finite_dimensional F E]
+  (S : subalgebra F E) : finite_dimensional F S :=
+finite_dimensional.of_subalgebra_to_submodule infer_instance
 
-lemma subalgebra.eq_bot_of_finrank_one {S : subalgebra F E} (h : finrank F S = 1) : S = ⊥ :=
-begin
-  rw eq_bot_iff,
-  let b : set S := {1},
-  have : fintype b := unique.fintype,
-  have b_lin_ind : linear_independent F (coe : b → S) := linear_independent_singleton one_ne_zero,
-  have b_card : fintype.card b = 1 := fintype.card_of_subsingleton _,
-  let hb := set_basis_of_linear_independent_of_card_eq_finrank
-    b_lin_ind (by simp only [*, set.to_finset_card]),
-  have b_spans := hb.span_eq,
-  intros x hx,
-  rw [algebra.mem_bot],
-  have x_in_span_b : (⟨x, hx⟩ : S) ∈ submodule.span F b,
-  { rw [coe_set_basis_of_linear_independent_of_card_eq_finrank, subtype.range_coe] at b_spans,
-    rw b_spans,
-    exact submodule.mem_top, },
-  obtain ⟨a, ha⟩ := submodule.mem_span_singleton.mp x_in_span_b,
-  replace ha : a • 1 = x := by injections with ha,
-  exact ⟨a, by rw [← ha, algebra.smul_def, mul_one]⟩,
-end
-
-lemma subalgebra.eq_bot_of_dim_one {S : subalgebra F E} (h : module.rank F S = 1) : S = ⊥ :=
-begin
-  haveI : finite_dimensional F S := finite_dimensional_of_dim_eq_one h,
-  rw ← finrank_eq_dim at h,
-  norm_cast at h,
-  exact subalgebra.eq_bot_of_finrank_one h,
-end
+instance subalgebra.finite_dimensional_bot : finite_dimensional F (⊥ : subalgebra F E) :=
+by { nontriviality E, exact finite_dimensional_of_rank_eq_one subalgebra.rank_bot }
 
-@[simp]
-lemma subalgebra.bot_eq_top_of_dim_eq_one (h : module.rank F E = 1) : (⊥ : subalgebra F E) = ⊤ :=
+lemma subalgebra.eq_bot_of_rank_le_one {S : subalgebra F E} (h : module.rank F S ≤ 1) : S = ⊥ :=
 begin
-  rw [← dim_top, ← subalgebra_top_dim_eq_submodule_top_dim] at h,
-  exact eq.symm (subalgebra.eq_bot_of_dim_one h),
+  nontriviality E,
+  obtain ⟨m, hm, he⟩ := cardinal.exists_nat_eq_of_le_nat (h.trans_eq nat.cast_one.symm),
+  haveI := finite_dimensional_of_rank_eq_nat he,
+  rw [← not_bot_lt_iff, ← subalgebra.to_submodule.lt_iff_lt],
+  haveI := (S.to_submodule_equiv).symm.finite_dimensional,
+  refine λ hl, (submodule.finrank_lt_finrank_of_lt hl).not_le (nat_cast_le.1 _),
+  iterate 2 { rw [subalgebra.finrank_to_submodule, finrank_eq_rank] },
+  exact h.trans_eq subalgebra.rank_bot.symm,
 end
 
-@[simp]
-lemma subalgebra.bot_eq_top_of_finrank_eq_one (h : finrank F E = 1) : (⊥ : subalgebra F E) = ⊤ :=
-begin
-  rw [← finrank_top, ← subalgebra_top_finrank_eq_submodule_top_finrank] at h,
-  exact eq.symm (subalgebra.eq_bot_of_finrank_one h),
-end
+lemma subalgebra.eq_bot_of_finrank_one {S : subalgebra F E} (h : finrank F S = 1) : S = ⊥ :=
+subalgebra.eq_bot_of_rank_le_one $
+  by { haveI := finite_dimensional_of_finrank_eq_succ h, rw [← finrank_eq_rank, h, nat.cast_one] }
 
 @[simp]
-theorem subalgebra.dim_eq_one_iff {S : subalgebra F E} : module.rank F S = 1 ↔ S = ⊥ :=
-⟨subalgebra.eq_bot_of_dim_one, subalgebra.dim_eq_one_of_eq_bot⟩
+theorem subalgebra.rank_eq_one_iff [nontrivial E] {S : subalgebra F E} :
+  module.rank F S = 1 ↔ S = ⊥ :=
+⟨λ h, subalgebra.eq_bot_of_rank_le_one h.le, λ h, h.symm ▸ subalgebra.rank_bot⟩
 
 @[simp]
-theorem subalgebra.finrank_eq_one_iff {S : subalgebra F E} : finrank F S = 1 ↔ S = ⊥ :=
-⟨subalgebra.eq_bot_of_finrank_one, subalgebra.finrank_eq_one_of_eq_bot⟩
-
-end subalgebra_dim
+theorem subalgebra.finrank_eq_one_iff [nontrivial E] {S : subalgebra F E} :
+  finrank F S = 1 ↔ S = ⊥ :=
+⟨subalgebra.eq_bot_of_finrank_one, λ h, h.symm ▸ subalgebra.finrank_bot⟩
+
+lemma subalgebra.bot_eq_top_iff_rank_eq_one [nontrivial E] :
+  (⊥ : subalgebra F E) = ⊤ ↔ module.rank F E = 1 :=
+by rw [← rank_top, ← subalgebra_top_rank_eq_submodule_top_rank, subalgebra.rank_eq_one_iff, eq_comm]
+
+lemma subalgebra.bot_eq_top_iff_finrank_eq_one [nontrivial E] :
+  (⊥ : subalgebra F E) = ⊤ ↔ finrank F E = 1 :=
+by rw [← finrank_top, ← subalgebra_top_finrank_eq_submodule_top_finrank,
+       subalgebra.finrank_eq_one_iff, eq_comm]
+
+alias subalgebra.bot_eq_top_iff_rank_eq_one ↔ _ subalgebra.bot_eq_top_of_rank_eq_one
+alias subalgebra.bot_eq_top_iff_finrank_eq_one ↔ _ subalgebra.bot_eq_top_of_finrank_eq_one
+attribute [simp] subalgebra.bot_eq_top_of_finrank_eq_one subalgebra.bot_eq_top_of_rank_eq_one
+
+lemma subalgebra.is_simple_order_of_finrank (hr : finrank F E = 2) :
+  is_simple_order (subalgebra F E) :=
+let i := nontrivial_of_finrank_pos (zero_lt_two.trans_eq hr.symm) in by exactI
+{ to_nontrivial :=
+    ⟨⟨⊥, ⊤, λ h, by cases hr.symm.trans (subalgebra.bot_eq_top_iff_finrank_eq_one.1 h)⟩⟩,
+  eq_bot_or_eq_top :=
+  begin
+    intro S,
+    haveI : finite_dimensional F E := finite_dimensional_of_finrank_eq_succ hr,
+    haveI : finite_dimensional F S :=
+      finite_dimensional.finite_dimensional_submodule S.to_submodule,
+    have : finrank F S ≤ 2 := hr ▸ S.to_submodule.finrank_le,
+    have : 0 < finrank F S := finrank_pos_iff.mpr infer_instance,
+    interval_cases (finrank F S),
+    { left, exact subalgebra.eq_bot_of_finrank_one h, },
+    { right, rw ← hr at h,
+      rw ← algebra.to_submodule_eq_top,
+      exact submodule.eq_top_of_finrank_eq h, },
+  end }
+
+end subalgebra_rank
 
 namespace module
 namespace End
 
-variables [field K] [add_comm_group V] [module K V]
+variables [division_ring K] [add_comm_group V] [module K V]
 
 lemma exists_ker_pow_eq_ker_pow_succ [finite_dimensional K V] (f : End K V) :
   ∃ (k : ℕ), k ≤ finrank K V ∧ (f ^ k).ker = (f ^ k.succ).ker :=
@@ -1829,3 +1391,33 @@ end
 
 end End
 end module
+
+section module
+
+open module
+
+open_locale cardinal
+
+lemma cardinal_mk_eq_cardinal_mk_field_pow_rank
+  (K V : Type u) [division_ring K] [add_comm_group V] [module K V] [finite_dimensional K V] :
+  #V = #K ^ module.rank K V :=
+begin
+  let s := basis.of_vector_space_index K V,
+  let hs := basis.of_vector_space K V,
+  calc #V = #(s →₀ K) : quotient.sound ⟨hs.repr.to_equiv⟩
+    ... = #(s → K) : quotient.sound ⟨finsupp.equiv_fun_on_finite⟩
+    ... = _ : by rw [← cardinal.lift_inj.1 hs.mk_eq_rank, cardinal.power_def]
+end
+
+lemma cardinal_lt_aleph_0_of_finite_dimensional
+  (K V : Type u) [division_ring K] [add_comm_group V] [module K V]
+  [_root_.finite K] [finite_dimensional K V] :
+  #V < ℵ₀ :=
+begin
+  letI : is_noetherian K V := is_noetherian.iff_fg.2 infer_instance,
+  rw cardinal_mk_eq_cardinal_mk_field_pow_rank K V,
+  exact cardinal.power_lt_aleph_0 (cardinal.lt_aleph_0_of_finite K)
+    (is_noetherian.rank_lt_aleph_0 K V),
+end
+
+end module
diff --git a/src/linear_algebra/finrank.lean b/src/linear_algebra/finrank.lean
new file mode 100644
index 0000000000000..5ff06c9f2cf74
--- /dev/null
+++ b/src/linear_algebra/finrank.lean
@@ -0,0 +1,534 @@
+/-
+Copyright (c) 2019 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes, Anne Baanen
+-/
+import linear_algebra.dimension
+
+/-!
+# Finite dimension of vector spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Definition of the rank of a module, or dimension of a vector space, as a natural number.
+
+## Main definitions
+
+Defined is `finite_dimensional.finrank`, the dimension of a finite dimensional space, returning a
+`nat`, as opposed to `module.rank`, which returns a `cardinal`. When the space has infinite
+dimension, its `finrank` is by convention set to `0`.
+
+The definition of `finrank` does not assume a `finite_dimensional` instance, but lemmas might.
+Import `linear_algebra.finite_dimensional` to get access to these additional lemmas.
+
+Formulas for the dimension are given for linear equivs, in `linear_equiv.finrank_eq`
+
+## Implementation notes
+
+Most results are deduced from the corresponding results for the general dimension (as a cardinal),
+in `dimension.lean`. Not all results have been ported yet.
+
+You should not assume that there has been any effort to state lemmas as generally as possible.
+-/
+
+universes u v v' w
+open_locale classical cardinal
+
+open cardinal submodule module function
+
+variables {K : Type u} {V : Type v}
+
+namespace finite_dimensional
+
+open is_noetherian
+
+section ring
+variables [ring K] [add_comm_group V] [module K V]
+{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+
+/-- The rank of a module as a natural number.
+
+Defined by convention to be `0` if the space has infinite rank.
+
+For a vector space `V` over a field `K`, this is the same as the finite dimension
+of `V` over `K`.
+-/
+noncomputable def finrank (R V : Type*) [semiring R]
+  [add_comm_group V] [module R V] : ℕ :=
+(module.rank R V).to_nat
+
+lemma finrank_eq_of_rank_eq {n : ℕ} (h : module.rank K V = ↑ n) : finrank K V = n :=
+begin
+  apply_fun to_nat at h,
+  rw to_nat_cast at h,
+  exact_mod_cast h,
+end
+
+lemma finrank_le_of_rank_le {n : ℕ} (h : module.rank K V ≤ ↑ n) : finrank K V ≤ n :=
+begin
+  rwa [← cardinal.to_nat_le_iff_le_of_lt_aleph_0, to_nat_cast] at h,
+  { exact h.trans_lt (nat_lt_aleph_0 n) },
+  { exact nat_lt_aleph_0 n },
+end
+
+lemma finrank_lt_of_rank_lt {n : ℕ} (h : module.rank K V < ↑ n) : finrank K V < n :=
+begin
+  rwa [← cardinal.to_nat_lt_iff_lt_of_lt_aleph_0, to_nat_cast] at h,
+  { exact h.trans (nat_lt_aleph_0 n) },
+  { exact nat_lt_aleph_0 n },
+end
+
+lemma rank_lt_of_finrank_lt {n : ℕ} (h : n < finrank K V) : ↑n < module.rank K V :=
+begin
+  rwa [← cardinal.to_nat_lt_iff_lt_of_lt_aleph_0, to_nat_cast],
+  { exact nat_lt_aleph_0 n },
+  { contrapose! h,
+    rw [finrank, cardinal.to_nat_apply_of_aleph_0_le h],
+    exact n.zero_le },
+end
+
+lemma finrank_le_finrank_of_rank_le_rank
+  (h : lift.{v'} (module.rank K V) ≤ cardinal.lift.{v} (module.rank K V₂))
+  (h' : module.rank K V₂ < ℵ₀) :
+    finrank K V ≤ finrank K V₂ :=
+by simpa only [to_nat_lift] using to_nat_le_of_le_of_lt_aleph_0 (lift_lt_aleph_0.mpr h') h
+
+section
+variables [nontrivial K] [no_zero_smul_divisors K V]
+
+/-- A finite dimensional space is nontrivial if it has positive `finrank`. -/
+lemma nontrivial_of_finrank_pos (h : 0 < finrank K V) :
+  nontrivial V :=
+rank_pos_iff_nontrivial.mp (rank_lt_of_finrank_lt h)
+
+/-- A finite dimensional space is nontrivial if it has `finrank` equal to the successor of a
+natural number. -/
+lemma nontrivial_of_finrank_eq_succ {n : ℕ}
+  (hn : finrank K V = n.succ) : nontrivial V :=
+nontrivial_of_finrank_pos (by rw hn; exact n.succ_pos)
+
+/-- A (finite dimensional) space that is a subsingleton has zero `finrank`. -/
+lemma finrank_zero_of_subsingleton [h : subsingleton V] :
+  finrank K V = 0 :=
+begin
+  by_contra h0,
+  obtain ⟨x, y, hxy⟩ := (nontrivial_of_finrank_pos (nat.pos_of_ne_zero h0)),
+  exact hxy (subsingleton.elim _ _)
+end
+
+end
+
+section
+variables [strong_rank_condition K]
+
+/-- If a vector space (or module) has a finite basis, then its dimension (or rank) is equal to the
+cardinality of the basis. -/
+lemma finrank_eq_card_basis {ι : Type w} [fintype ι] (h : basis ι K V) :
+  finrank K V = fintype.card ι :=
+finrank_eq_of_rank_eq (rank_eq_card_basis h)
+
+/-- If a vector space (or module) has a finite basis, then its dimension (or rank) is equal to the
+cardinality of the basis. This lemma uses a `finset` instead of indexed types. -/
+lemma finrank_eq_card_finset_basis {ι : Type w} {b : finset ι}
+  (h : basis.{w} b K V) :
+  finrank K V = finset.card b :=
+by rw [finrank_eq_card_basis h, fintype.card_coe]
+
+variable (K)
+
+/-- A ring satisfying `strong_rank_condition` (such as a `division_ring`) is one-dimensional as a
+module over itself. -/
+@[simp] lemma finrank_self : finrank K K = 1 :=
+finrank_eq_of_rank_eq (by simp)
+
+/-- The vector space of functions on a fintype ι has finrank equal to the cardinality of ι. -/
+@[simp] lemma finrank_fintype_fun_eq_card {ι : Type v} [fintype ι] :
+  finrank K (ι → K) = fintype.card ι :=
+finrank_eq_of_rank_eq rank_fun'
+
+/-- The vector space of functions on `fin n` has finrank equal to `n`. -/
+@[simp] lemma finrank_fin_fun {n : ℕ} : finrank K (fin n → K) = n :=
+by simp
+
+end
+
+end ring
+
+section division_ring
+
+variables [division_ring K] [add_comm_group V] [module K V]
+{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+
+lemma basis.subset_extend {s : set V} (hs : linear_independent K (coe : s → V)) :
+  s ⊆ hs.extend (set.subset_univ _) :=
+hs.subset_extend _
+
+end division_ring
+
+end finite_dimensional
+
+variables {K V}
+
+section zero_rank
+
+variables [ring K] [strong_rank_condition K] [add_comm_group V] [module K V] [module.free K V]
+
+open finite_dimensional
+
+lemma finrank_eq_zero_of_basis_imp_not_finite
+  (h : ∀ s : set V, basis.{v} (s : set V) K V → ¬ s.finite) : finrank K V = 0 :=
+begin
+  obtain ⟨_, ⟨b⟩⟩ := (module.free_iff_set K V).mp ‹_›,
+  exact dif_neg (λ rank_lt, h _ b (b.finite_index_of_rank_lt_aleph_0 rank_lt))
+end
+
+lemma finrank_eq_zero_of_basis_imp_false
+  (h : ∀ s : finset V, basis.{v} (s : set V) K V → false) : finrank K V = 0 :=
+finrank_eq_zero_of_basis_imp_not_finite (λ s b hs, h hs.to_finset (by { convert b, simp }))
+
+lemma finrank_eq_zero_of_not_exists_basis
+  (h : ¬ (∃ s : finset V, nonempty (basis (s : set V) K V))) : finrank K V = 0 :=
+finrank_eq_zero_of_basis_imp_false (λ s b, h ⟨s, ⟨b⟩⟩)
+
+lemma finrank_eq_zero_of_not_exists_basis_finite
+  (h : ¬ ∃ (s : set V) (b : basis.{v} (s : set V) K V), s.finite) : finrank K V = 0 :=
+finrank_eq_zero_of_basis_imp_not_finite (λ s b hs, h ⟨s, b, hs⟩)
+
+lemma finrank_eq_zero_of_not_exists_basis_finset
+  (h : ¬ ∃ (s : finset V), nonempty (basis s K V)) : finrank K V = 0 :=
+finrank_eq_zero_of_basis_imp_false (λ s b, h ⟨s, ⟨b⟩⟩)
+
+end zero_rank
+
+namespace linear_equiv
+open finite_dimensional
+
+variables [ring K] [add_comm_group V] [module K V]
+{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+
+variables {R M M₂ : Type*} [ring R] [add_comm_group M] [add_comm_group M₂]
+variables [module R M] [module R M₂]
+
+/-- The dimension of a finite dimensional space is preserved under linear equivalence. -/
+theorem finrank_eq (f : M ≃ₗ[R] M₂) : finrank R M = finrank R M₂ :=
+by { unfold finrank, rw [← cardinal.to_nat_lift, f.lift_rank_eq, cardinal.to_nat_lift] }
+
+/-- Pushforwards of finite-dimensional submodules along a `linear_equiv` have the same finrank. -/
+lemma finrank_map_eq (f : M ≃ₗ[R] M₂) (p : submodule R M) :
+  finrank R (p.map (f : M →ₗ[R] M₂)) = finrank R p :=
+(f.submodule_map p).finrank_eq.symm
+
+end linear_equiv
+
+namespace linear_map
+open finite_dimensional
+
+section ring
+variables [ring K] [add_comm_group V] [module K V]
+{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+
+/-- The dimensions of the domain and range of an injective linear map are equal. -/
+lemma finrank_range_of_inj {f : V →ₗ[K] V₂} (hf : function.injective f) :
+  finrank K f.range = finrank K V :=
+by rw (linear_equiv.of_injective f hf).finrank_eq
+
+end ring
+
+end linear_map
+
+open module finite_dimensional
+
+section
+variables [ring K] [add_comm_group V] [module K V]
+
+variables (K V)
+
+@[simp] lemma finrank_bot [nontrivial K] : finrank K (⊥ : submodule K V) = 0 :=
+finrank_eq_of_rank_eq (rank_bot _ _)
+
+@[simp]
+theorem finrank_top : finrank K (⊤ : submodule K V) = finrank K V :=
+by { unfold finrank, simp [rank_top] }
+
+end
+
+namespace submodule
+
+section ring
+variables [ring K] [add_comm_group V] [module K V]
+{V₂ : Type v'} [add_comm_group V₂] [module K V₂]
+
+lemma lt_of_le_of_finrank_lt_finrank {s t : submodule K V}
+  (le : s ≤ t) (lt : finrank K s < finrank K t) : s < t :=
+lt_of_le_of_ne le (λ h, ne_of_lt lt (by rw h))
+
+lemma lt_top_of_finrank_lt_finrank {s : submodule K V}
+  (lt : finrank K s < finrank K V) : s < ⊤ :=
+begin
+  rw ← finrank_top K V at lt,
+  exact lt_of_le_of_finrank_lt_finrank le_top lt
+end
+
+end ring
+
+end submodule
+
+section span
+
+open submodule
+
+section division_ring
+variables [division_ring K] [add_comm_group V] [module K V]
+
+variable (K)
+
+/-- The rank of a set of vectors as a natural number. -/
+protected noncomputable def set.finrank (s : set V) : ℕ := finrank K (span K s)
+
+variable {K}
+
+lemma finrank_span_le_card (s : set V) [fintype s] :
+  finrank K (span K s) ≤ s.to_finset.card :=
+finrank_le_of_rank_le (by simpa using rank_span_le s)
+
+lemma finrank_span_finset_le_card (s : finset V)  :
+  (s : set V).finrank K ≤ s.card :=
+calc (s : set V).finrank K ≤ (s : set V).to_finset.card : finrank_span_le_card s
+                                ... = s.card : by simp
+
+lemma finrank_range_le_card {ι : Type*} [fintype ι] {b : ι → V} :
+  (set.range b).finrank K ≤ fintype.card ι :=
+(finrank_span_le_card _).trans $ by { rw set.to_finset_range, exact finset.card_image_le }
+
+lemma finrank_span_eq_card {ι : Type*} [fintype ι] {b : ι → V}
+  (hb : linear_independent K b) :
+  finrank K (span K (set.range b)) = fintype.card ι :=
+finrank_eq_of_rank_eq
+begin
+  have : module.rank K (span K (set.range b)) = #(set.range b) := rank_span hb,
+  rwa [←lift_inj, mk_range_eq_of_injective hb.injective, cardinal.mk_fintype, lift_nat_cast,
+       lift_eq_nat_iff] at this,
+end
+
+lemma finrank_span_set_eq_card (s : set V) [fintype s]
+  (hs : linear_independent K (coe : s → V)) :
+  finrank K (span K s) = s.to_finset.card :=
+finrank_eq_of_rank_eq
+begin
+  have : module.rank K (span K s) = #s := rank_span_set hs,
+  rwa [cardinal.mk_fintype, ←set.to_finset_card] at this,
+end
+
+lemma finrank_span_finset_eq_card (s : finset V)
+  (hs : linear_independent K (coe : s → V)) :
+  finrank K (span K (s : set V)) = s.card :=
+begin
+  convert finrank_span_set_eq_card ↑s hs,
+  ext,
+  simp,
+end
+
+lemma span_lt_of_subset_of_card_lt_finrank {s : set V} [fintype s] {t : submodule K V}
+  (subset : s ⊆ t) (card_lt : s.to_finset.card < finrank K t) : span K s < t :=
+lt_of_le_of_finrank_lt_finrank
+  (span_le.mpr subset)
+  (lt_of_le_of_lt (finrank_span_le_card _) card_lt)
+
+lemma span_lt_top_of_card_lt_finrank {s : set V} [fintype s]
+  (card_lt : s.to_finset.card < finrank K V) : span K s < ⊤ :=
+lt_top_of_finrank_lt_finrank (lt_of_le_of_lt (finrank_span_le_card _) card_lt)
+
+end division_ring
+
+end span
+
+section basis
+
+section division_ring
+variables [division_ring K] [add_comm_group V] [module K V]
+
+lemma linear_independent_of_top_le_span_of_card_eq_finrank {ι : Type*} [fintype ι] {b : ι → V}
+  (spans : ⊤ ≤ span K (set.range b)) (card_eq : fintype.card ι = finrank K V) :
+  linear_independent K b :=
+linear_independent_iff'.mpr $ λ s g dependent i i_mem_s,
+begin
+  by_contra gx_ne_zero,
+  -- We'll derive a contradiction by showing `b '' (univ \ {i})` of cardinality `n - 1`
+  -- spans a vector space of dimension `n`.
+  refine not_le_of_gt (span_lt_top_of_card_lt_finrank
+    (show (b '' (set.univ \ {i})).to_finset.card < finrank K V, from _)) _,
+  { calc (b '' (set.univ \ {i})).to_finset.card = ((set.univ \ {i}).to_finset.image b).card
+      : by rw [set.to_finset_card, fintype.card_of_finset]
+    ... ≤ (set.univ \ {i}).to_finset.card : finset.card_image_le
+    ... = (finset.univ.erase i).card : congr_arg finset.card (finset.ext (by simp [and_comm]))
+    ... < finset.univ.card : finset.card_erase_lt_of_mem (finset.mem_univ i)
+    ... = finrank K V : card_eq },
+
+  -- We already have that `b '' univ` spans the whole space,
+  -- so we only need to show that the span of `b '' (univ \ {i})` contains each `b j`.
+  refine spans.trans (span_le.mpr _),
+  rintros _ ⟨j, rfl, rfl⟩,
+  -- The case that `j ≠ i` is easy because `b j ∈ b '' (univ \ {i})`.
+  by_cases j_eq : j = i,
+  swap,
+  { refine subset_span ⟨j, (set.mem_diff _).mpr ⟨set.mem_univ _, _⟩, rfl⟩,
+    exact mt set.mem_singleton_iff.mp j_eq },
+
+  -- To show `b i ∈ span (b '' (univ \ {i}))`, we use that it's a weighted sum
+  -- of the other `b j`s.
+  rw [j_eq, set_like.mem_coe, show b i = -((g i)⁻¹ • (s.erase i).sum (λ j, g j • b j)), from _],
+  { refine neg_mem (smul_mem _ _ (sum_mem (λ k hk, _))),
+    obtain ⟨k_ne_i, k_mem⟩ := finset.mem_erase.mp hk,
+    refine smul_mem _ _ (subset_span ⟨k, _, rfl⟩),
+    simpa using k_mem },
+
+  -- To show `b i` is a weighted sum of the other `b j`s, we'll rewrite this sum
+  -- to have the form of the assumption `dependent`.
+  apply eq_neg_of_add_eq_zero_left,
+  calc b i + (g i)⁻¹ • (s.erase i).sum (λ j, g j • b j)
+      = (g i)⁻¹ • (g i • b i + (s.erase i).sum (λ j, g j • b j))
+    : by rw [smul_add, ←mul_smul, inv_mul_cancel gx_ne_zero, one_smul]
+  ... = (g i)⁻¹ • 0 : congr_arg _ _
+  ... = 0           : smul_zero _,
+  -- And then it's just a bit of manipulation with finite sums.
+  rwa [← finset.insert_erase i_mem_s, finset.sum_insert (finset.not_mem_erase _ _)] at dependent
+end
+
+/-- A finite family of vectors is linearly independent if and only if
+its cardinality equals the dimension of its span. -/
+lemma linear_independent_iff_card_eq_finrank_span {ι : Type*} [fintype ι] {b : ι → V} :
+  linear_independent K b ↔ fintype.card ι = (set.range b).finrank K :=
+begin
+  split,
+  { intro h,
+    exact (finrank_span_eq_card h).symm },
+  { intro hc,
+    let f := (submodule.subtype (span K (set.range b))),
+    let b' : ι → span K (set.range b) :=
+      λ i, ⟨b i, mem_span.2 (λ p hp, hp (set.mem_range_self _))⟩,
+    have hs : ⊤ ≤ span K (set.range b'),
+    { intro x,
+      have h : span K (f '' (set.range b')) = map f (span K (set.range b')) := span_image f,
+      have hf : f '' (set.range b') = set.range b, { ext x, simp [set.mem_image, set.mem_range] },
+      rw hf at h,
+      have hx : (x : V) ∈ span K (set.range b) := x.property,
+      conv at hx { congr, skip, rw h },
+      simpa [mem_map] using hx },
+    have hi : f.ker = ⊥ := ker_subtype _,
+    convert (linear_independent_of_top_le_span_of_card_eq_finrank hs hc).map' _ hi }
+end
+
+lemma linear_independent_iff_card_le_finrank_span {ι : Type*} [fintype ι] {b : ι → V} :
+  linear_independent K b ↔ fintype.card ι ≤ (set.range b).finrank K :=
+by rw [linear_independent_iff_card_eq_finrank_span, finrank_range_le_card.le_iff_eq]
+
+/-- A family of `finrank K V` vectors forms a basis if they span the whole space. -/
+noncomputable def basis_of_top_le_span_of_card_eq_finrank {ι : Type*} [fintype ι] (b : ι → V)
+  (le_span : ⊤ ≤ span K (set.range b)) (card_eq : fintype.card ι = finrank K V) :
+  basis ι K V :=
+basis.mk (linear_independent_of_top_le_span_of_card_eq_finrank le_span card_eq) le_span
+
+@[simp] lemma coe_basis_of_top_le_span_of_card_eq_finrank {ι : Type*} [fintype ι] (b : ι → V)
+  (le_span : ⊤ ≤ span K (set.range b)) (card_eq : fintype.card ι = finrank K V) :
+   ⇑(basis_of_top_le_span_of_card_eq_finrank b le_span card_eq) = b :=
+basis.coe_mk _ _
+
+/-- A finset of `finrank K V` vectors forms a basis if they span the whole space. -/
+@[simps repr_apply]
+noncomputable def finset_basis_of_top_le_span_of_card_eq_finrank {s : finset V}
+  (le_span : ⊤ ≤ span K (s : set V)) (card_eq : s.card = finrank K V) :
+  basis (s : set V) K V :=
+basis_of_top_le_span_of_card_eq_finrank (coe : (s : set V) → V)
+  ((@subtype.range_coe_subtype _ (λ x, x ∈ s)).symm ▸ le_span)
+  (trans (fintype.card_coe _) card_eq)
+
+/-- A set of `finrank K V` vectors forms a basis if they span the whole space. -/
+@[simps repr_apply]
+noncomputable def set_basis_of_top_le_span_of_card_eq_finrank {s : set V} [fintype s]
+  (le_span : ⊤ ≤ span K s) (card_eq : s.to_finset.card = finrank K V) :
+  basis s K V :=
+basis_of_top_le_span_of_card_eq_finrank (coe : s → V)
+  ((@subtype.range_coe_subtype _ s).symm ▸ le_span)
+  (trans s.to_finset_card.symm card_eq)
+
+end division_ring
+
+end basis
+
+/-!
+We now give characterisations of `finrank K V = 1` and `finrank K V ≤ 1`.
+-/
+section finrank_eq_one
+
+variables [ring K] [add_comm_group V] [module K V]
+variables [no_zero_smul_divisors K V] [strong_rank_condition K]
+
+/-- If there is a nonzero vector and every other vector is a multiple of it,
+then the module has dimension one. -/
+lemma finrank_eq_one
+  (v : V) (n : v ≠ 0) (h : ∀ w : V, ∃ c : K, c • v = w) :
+  finrank K V = 1 :=
+begin
+  haveI := nontrivial_of_invariant_basis_number K,
+  obtain ⟨b⟩ := (basis.basis_singleton_iff punit).mpr ⟨v, n, h⟩,
+  rw [finrank_eq_card_basis b, fintype.card_punit]
+end
+
+/--
+If every vector is a multiple of some `v : V`, then `V` has dimension at most one.
+-/
+lemma finrank_le_one (v : V) (h : ∀ w : V, ∃ c : K, c • v = w) :
+  finrank K V ≤ 1 :=
+begin
+  haveI := nontrivial_of_invariant_basis_number K,
+  rcases eq_or_ne v 0 with rfl | hn,
+  { haveI := subsingleton_of_forall_eq (0 : V) (λ w, by { obtain ⟨c, rfl⟩ := h w, simp }),
+    rw finrank_zero_of_subsingleton,
+    exact zero_le_one },
+  { exact (finrank_eq_one v hn h).le }
+end
+
+end finrank_eq_one
+
+section subalgebra_rank
+open module
+
+variables {F E : Type*} [comm_ring F] [ring E] [algebra F E]
+
+@[simp] lemma subalgebra.rank_to_submodule (S : subalgebra F E) :
+  module.rank F S.to_submodule = module.rank F S := rfl
+
+@[simp] lemma subalgebra.finrank_to_submodule (S : subalgebra F E) :
+  finrank F S.to_submodule = finrank F S := rfl
+
+lemma subalgebra_top_rank_eq_submodule_top_rank :
+  module.rank F (⊤ : subalgebra F E) = module.rank F (⊤ : submodule F E) :=
+by { rw ← algebra.top_to_submodule, refl }
+
+lemma subalgebra_top_finrank_eq_submodule_top_finrank :
+  finrank F (⊤ : subalgebra F E) = finrank F (⊤ : submodule F E) :=
+by { rw ← algebra.top_to_submodule, refl }
+
+lemma subalgebra.rank_top : module.rank F (⊤ : subalgebra F E) = module.rank F E :=
+by { rw subalgebra_top_rank_eq_submodule_top_rank, exact rank_top F E }
+
+section
+variables [strong_rank_condition F] [no_zero_smul_divisors F E] [nontrivial E]
+
+@[simp] lemma subalgebra.rank_bot :
+  module.rank F (⊥ : subalgebra F E) = 1 :=
+((subalgebra.to_submodule_equiv (⊥ : subalgebra F E)).symm.trans $
+  linear_equiv.of_eq _ _ algebra.to_submodule_bot).rank_eq.trans $ begin
+    letI := module.nontrivial F E,
+    rw rank_span_set,
+    exacts [mk_singleton _, linear_independent_singleton one_ne_zero]
+  end
+
+@[simp]
+lemma subalgebra.finrank_bot : finrank F (⊥ : subalgebra F E) = 1 :=
+finrank_eq_of_rank_eq (by simp)
+
+end
+
+end subalgebra_rank
diff --git a/src/linear_algebra/finsupp.lean b/src/linear_algebra/finsupp.lean
index 9587014561904..e97cbe551801f 100644
--- a/src/linear_algebra/finsupp.lean
+++ b/src/linear_algebra/finsupp.lean
@@ -3,13 +3,16 @@ Copyright (c) 2019 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import data.finsupp.basic
+import data.finsupp.defs
 import linear_algebra.pi
 import linear_algebra.span
 
 /-!
 # Properties of the module `α →₀ M`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given an `R`-module `M`, the `R`-module structure on `α →₀ M` is defined in
 `data.finsupp.basic`.
 
@@ -86,6 +89,15 @@ lhom_ext $ λ a, linear_map.congr_fun (h a)
 def lapply (a : α) : (α →₀ M) →ₗ[R] M :=
 { map_smul' := assume a b, rfl, ..finsupp.apply_add_hom a }
 
+/-- Forget that a function is finitely supported.
+
+This is the linear version of `finsupp.to_fun`. -/
+@[simps]
+def lcoe_fun : (α →₀ M) →ₗ[R] α → M :=
+{ to_fun := coe_fn,
+  map_add' := λ x y, by { ext, simp },
+  map_smul' := λ x y, by { ext, simp } }
+
 section lsubtype_domain
 variables (s : set α)
 
@@ -110,12 +122,12 @@ rfl
 ker_eq_bot_of_injective (single_injective a)
 
 lemma lsingle_range_le_ker_lapply (s t : set α) (h : disjoint s t) :
-  (⨆a∈s, (lsingle a : M →ₗ[R] (α →₀ M)).range) ≤ (⨅a∈t, ker (lapply a)) :=
+  (⨆a∈s, (lsingle a : M →ₗ[R] (α →₀ M)).range) ≤ (⨅a∈t, ker (lapply a : (α →₀ M) →ₗ[R] M)) :=
 begin
   refine supr_le (assume a₁, supr_le $ assume h₁, range_le_iff_comap.2 _),
   simp only [(ker_comp _ _).symm, eq_top_iff, set_like.le_def, mem_ker, comap_infi, mem_infi],
   assume b hb a₂ h₂,
-  have : a₁ ≠ a₂ := assume eq, h ⟨h₁, eq.symm ▸ h₂⟩,
+  have : a₁ ≠ a₂ := assume eq, h.le_bot ⟨h₁, eq.symm ▸ h₂⟩,
   exact single_eq_of_ne this
 end
 
@@ -133,22 +145,24 @@ begin
 end
 
 lemma disjoint_lsingle_lsingle (s t : set α) (hs : disjoint s t) :
-  disjoint (⨆a∈s, (lsingle a : M →ₗ[R] (α →₀ M)).range) (⨆a∈t, (lsingle a).range) :=
+  disjoint (⨆a∈s, (lsingle a : M →ₗ[R] (α →₀ M)).range)
+    (⨆a∈t, (lsingle a : M →ₗ[R] (α →₀ M)).range) :=
 begin
-  refine disjoint.mono
+  refine (disjoint.mono
     (lsingle_range_le_ker_lapply _ _ $ disjoint_compl_right)
-    (lsingle_range_le_ker_lapply _ _ $ disjoint_compl_right)
-    (le_trans (le_infi $ assume i, _) infi_ker_lapply_le_bot),
+    (lsingle_range_le_ker_lapply _ _ $ disjoint_compl_right)) _,
+  rw disjoint_iff_inf_le,
+  refine (le_trans (le_infi $ assume i, _) infi_ker_lapply_le_bot),
   classical,
   by_cases his : i ∈ s,
   { by_cases hit : i ∈ t,
-    { exact (hs ⟨his, hit⟩).elim },
+    { exact (hs.le_bot ⟨his, hit⟩).elim },
     exact inf_le_of_right_le (infi_le_of_le i $ infi_le _ hit) },
   exact inf_le_of_left_le (infi_le_of_le i $ infi_le _ his)
 end
 
 lemma span_single_image (s : set M) (a : α) :
-  submodule.span R (single a '' s) = (submodule.span R s).map (lsingle a) :=
+  submodule.span R (single a '' s) = (submodule.span R s).map (lsingle a : M →ₗ[R] (α →₀ M)) :=
 by rw ← span_image; refl
 
 variables (M R)
@@ -246,7 +260,7 @@ begin
   haveI := classical.dec_pred (λ x, x ∈ (⋃ i, s i)),
   suffices : ((submodule.subtype _).comp (restrict_dom M R (⋃ i, s i))).range ≤
     ⨆ i, supported M R (s i),
-  { rwa [linear_map.range_comp, range_restrict_dom, map_top, range_subtype] at this },
+  { rwa [linear_map.range_comp, range_restrict_dom, submodule.map_top, range_subtype] at this },
   rw [range_le_iff_comap, eq_top_iff],
   rintro l ⟨⟩,
   apply finsupp.induction l, { exact zero_mem _ },
@@ -275,9 +289,9 @@ disjoint_iff.2 $ by rw [← supported_inter, disjoint_iff_inter_eq_empty.1 h, su
 theorem disjoint_supported_supported_iff [nontrivial M] {s t : set α} :
   disjoint (supported M R s) (supported M R t) ↔ disjoint s t :=
 begin
-  refine ⟨λ h x hx, _, disjoint_supported_supported⟩,
+  refine ⟨λ h, set.disjoint_left.mpr $ λ x hx1 hx2, _, disjoint_supported_supported⟩,
   rcases exists_ne (0 : M) with ⟨y, hy⟩,
-  have := h ⟨single_mem_supported R y hx.1, single_mem_supported R y hx.2⟩,
+  have := h.le_bot ⟨single_mem_supported R y hx1, single_mem_supported R y hx2⟩,
   rw [mem_bot, single_eq_zero] at this,
   exact hy this
 end
@@ -330,7 +344,7 @@ theorem lsum_symm_apply (f : (α →₀ M) →ₗ[R] N) (x : α) :
 end lsum
 
 section
-variables (M) (R) (X : Type*)
+variables (M) (R) (X : Type*) (S) [module S M] [smul_comm_class R S M]
 
 /--
 A slight rearrangement from `lsum` gives us
@@ -348,6 +362,24 @@ lemma lift_apply (f) (g) :
   ((lift M R X) f) g = g.sum (λ x r, r • f x) :=
 rfl
 
+/-- Given compatible `S` and `R`-module structures on `M` and a type `X`, the set of functions
+`X → M` is `S`-linearly equivalent to the `R`-linear maps from the free `R`-module
+on `X` to `M`. -/
+noncomputable def llift : (X → M) ≃ₗ[S] ((X →₀ R) →ₗ[R] M) :=
+{ map_smul' :=
+  begin
+    intros,
+    dsimp,
+    ext,
+    simp only [coe_comp, function.comp_app, lsingle_apply, lift_apply, pi.smul_apply,
+      sum_single_index, zero_smul, one_smul, linear_map.smul_apply],
+  end, ..lift M R X }
+
+@[simp] lemma llift_apply (f : X → M) (x : X →₀ R) :
+  llift M R S X f x = lift M R X f x := rfl
+
+@[simp] lemma llift_symm_apply (f : (X →₀ R) →ₗ[R] M) (x : X) :
+  (llift M R S X).symm f x = f (single x 1) := rfl
 end
 
 section lmap_domain
@@ -395,6 +427,7 @@ theorem lmap_domain_disjoint_ker (f : α → α') {s : set α}
   (H : ∀ a b ∈ s, f a = f b → a = b) :
   disjoint (supported M R s) (lmap_domain M R f).ker :=
 begin
+  rw disjoint_iff_inf_le,
   rintro l ⟨h₁, h₂⟩,
   rw [set_like.mem_coe, mem_ker, lmap_domain_apply, map_domain] at h₂,
   simp, ext x,
@@ -410,6 +443,23 @@ end
 
 end lmap_domain
 
+section lcomap_domain
+
+variables {β : Type*} {R M}
+
+/-- Given `f : α → β` and a proof `hf` that `f` is injective, `lcomap_domain f hf` is the linear map
+sending  `l : β →₀ M` to the finitely supported function from `α` to `M` given by composing
+`l` with `f`.
+
+This is the linear version of `finsupp.comap_domain`. -/
+def lcomap_domain (f : α → β) (hf : function.injective f) :
+  (β →₀ M) →ₗ[R] α →₀ M:=
+{ to_fun := λ l, finsupp.comap_domain f l (hf.inj_on _),
+  map_add' := λ x y, by { ext, simp },
+  map_smul' := λ c x, by { ext, simp } }
+
+end lcomap_domain
+
 section total
 variables (α) {α' : Type*} (M) {M' : Type*} (R)
           [add_comm_monoid M'] [module R M']
@@ -433,6 +483,17 @@ finset.sum_subset hs $ λ x _ hxg, show l x • v x = 0, by rw [not_mem_support_
   finsupp.total α M R v (single a c) = c • (v a) :=
 by simp [total_apply, sum_single_index]
 
+lemma total_zero_apply (x : α →₀ R) :
+  (finsupp.total α M R 0) x = 0 := by simp [finsupp.total_apply]
+
+variables (α M)
+
+@[simp] lemma total_zero :
+  finsupp.total α M R 0 = 0 :=
+linear_map.ext (total_zero_apply R)
+
+variables {α M}
+
 theorem apply_total (f : M →ₗ[R] M') (v) (l : α →₀ R) :
   f (finsupp.total α M R v l) = finsupp.total α M' R (f ∘ v) l :=
 by apply finsupp.induction_linear l; simp { contextual := tt, }
@@ -479,23 +540,21 @@ theorem lmap_domain_total (f : α → α') (g : M →ₗ[R] M') (h : ∀ i, g (v
   (finsupp.total α' M' R v').comp (lmap_domain R R f) = g.comp (finsupp.total α M R v) :=
 by ext l; simp [total_apply, finsupp.sum_map_domain_index, add_smul, h]
 
+theorem total_comp_lmap_domain (f : α → α') :
+  (finsupp.total α' M' R v').comp (finsupp.lmap_domain R R f) = (finsupp.total α M' R (v' ∘ f)) :=
+by { ext, simp }
+
 @[simp] theorem total_emb_domain (f : α ↪ α') (l : α →₀ R) :
   (finsupp.total α' M' R v') (emb_domain f l) = (finsupp.total α M' R (v' ∘ f)) l :=
 by simp [total_apply, finsupp.sum, support_emb_domain, emb_domain_apply]
 
-theorem total_map_domain (f : α → α') (hf : function.injective f) (l : α →₀ R) :
+@[simp] theorem total_map_domain (f : α → α') (l : α →₀ R) :
   (finsupp.total α' M' R v') (map_domain f l) = (finsupp.total α M' R (v' ∘ f)) l :=
-begin
-  have : map_domain f l = emb_domain ⟨f, hf⟩ l,
-  { rw emb_domain_eq_map_domain ⟨f, hf⟩,
-    refl },
-  rw this,
-  apply total_emb_domain R ⟨f, hf⟩ l
-end
+linear_map.congr_fun (total_comp_lmap_domain _ _) l
 
 @[simp] theorem total_equiv_map_domain (f : α ≃ α') (l : α →₀ R) :
   (finsupp.total α' M' R v') (equiv_map_domain f l) = (finsupp.total α M' R (v' ∘ f)) l :=
-by rw [equiv_map_domain_eq_map_domain, total_map_domain _ _ f.injective]
+by rw [equiv_map_domain_eq_map_domain, total_map_domain]
 
 /-- A version of `finsupp.range_total` which is useful for going in the other direction -/
 theorem span_eq_range_total (s : set M) :
@@ -506,6 +565,14 @@ theorem mem_span_iff_total (s : set M) (x : M) :
   x ∈ span R s ↔ ∃ l : s →₀ R, finsupp.total s M R coe l = x :=
 (set_like.ext_iff.1 $ span_eq_range_total _ _) x
 
+variables {R}
+
+lemma mem_span_range_iff_exists_finsupp {v : α → M} {x : M} :
+  x ∈ span R (range v) ↔ ∃ (c : α →₀ R), c.sum (λ i a, a • v i) = x :=
+by simp only [←finsupp.range_total, linear_map.mem_range, finsupp.total_apply]
+
+variables (R)
+
 theorem span_image_eq_map_total (s : set α):
   span R (v '' s) = submodule.map (finsupp.total α M R v) (supported R R s) :=
 begin
@@ -566,7 +633,8 @@ variables {α} {M} {v}
 theorem total_on_range (s : set α) : (finsupp.total_on α M R v s).range = ⊤ :=
 begin
   rw [finsupp.total_on, linear_map.range_eq_map, linear_map.map_cod_restrict,
-    ← linear_map.range_le_iff_comap, range_subtype, map_top, linear_map.range_comp, range_subtype],
+    ← linear_map.range_le_iff_comap, range_subtype, submodule.map_top, linear_map.range_comp,
+    range_subtype],
   exact (span_image_eq_map_total _ _).le
 end
 
@@ -718,17 +786,7 @@ end
 
 @[simp] lemma lcongr_symm {ι κ : Sort*} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) :
   (lcongr e₁ e₂).symm = lcongr e₁.symm e₂.symm :=
-begin
-  ext f i,
-  simp only [equiv.symm_symm, finsupp.lcongr_apply_apply],
-  apply finsupp.induction_linear f,
-  { simp, },
-  { intros f g hf hg, simp [map_add, hf, hg], },
-  { intros k m,
-    simp only [finsupp.lcongr_symm_single],
-    simp only [finsupp.single, equiv.symm_apply_eq, finsupp.coe_mk],
-    split_ifs; simp, },
-end
+by { ext, refl }
 
 section sum
 
@@ -822,6 +880,92 @@ end prod
 
 end finsupp
 
+section fintype
+
+variables {α M : Type*} (R : Type*) [fintype α] [semiring R] [add_comm_monoid M] [module R M]
+variables (S : Type*) [semiring S] [module S M] [smul_comm_class R S M]
+variable (v : α → M)
+
+/-- `fintype.total R S v f` is the linear combination of vectors in `v` with weights in `f`.
+This variant of `finsupp.total` is defined on fintype indexed vectors.
+
+This map is linear in `v` if `R` is commutative, and always linear in `f`.
+See note [bundled maps over different rings] for why separate `R` and `S` semirings are used.
+-/
+protected def fintype.total : (α → M) →ₗ[S] (α → R) →ₗ[R] M :=
+{ to_fun := λ v, { to_fun := λ f, ∑ i, f i • v i,
+    map_add' := λ f g, by { simp_rw [← finset.sum_add_distrib, ← add_smul], refl },
+    map_smul' := λ r f, by { simp_rw [finset.smul_sum, smul_smul], refl } },
+  map_add' := λ u v, by { ext, simp [finset.sum_add_distrib, pi.add_apply, smul_add] },
+  map_smul' := λ r v, by { ext, simp [finset.smul_sum, smul_comm _ r] } }
+
+variables {S}
+
+lemma fintype.total_apply (f) : fintype.total R S v f = ∑ i, f i • v i := rfl
+
+@[simp]
+lemma fintype.total_apply_single (i : α) (r : R) :
+  fintype.total R S v (pi.single i r) = r • v i :=
+begin
+  simp_rw [fintype.total_apply, pi.single_apply, ite_smul, zero_smul],
+  rw [finset.sum_ite_eq', if_pos (finset.mem_univ _)]
+end
+
+variables (S)
+
+lemma finsupp.total_eq_fintype_total_apply (x : α → R) :
+  finsupp.total α M R v ((finsupp.linear_equiv_fun_on_finite R R α).symm x) =
+    fintype.total R S v x :=
+begin
+  apply finset.sum_subset,
+  { exact finset.subset_univ _ },
+  { intros x _ hx,
+    rw finsupp.not_mem_support_iff.mp hx,
+    exact zero_smul _ _ }
+end
+
+lemma finsupp.total_eq_fintype_total :
+  (finsupp.total α M R v).comp (finsupp.linear_equiv_fun_on_finite R R α).symm.to_linear_map =
+    fintype.total R S v :=
+linear_map.ext $ finsupp.total_eq_fintype_total_apply R S v
+
+variables {S}
+
+@[simp]
+lemma fintype.range_total : (fintype.total R S v).range = submodule.span R (set.range v) :=
+by rw [← finsupp.total_eq_fintype_total, linear_map.range_comp,
+  linear_equiv.to_linear_map_eq_coe, linear_equiv.range, submodule.map_top, finsupp.range_total]
+
+section span_range
+
+variables {v} {x : M}
+
+/--
+An element `x` lies in the span of `v` iff it can be written as sum `∑ cᵢ • vᵢ = x`.
+-/
+lemma mem_span_range_iff_exists_fun :
+  x ∈ span R (range v) ↔ ∃ (c : α → R), ∑ i, c i • v i = x :=
+begin
+  simp only [finsupp.mem_span_range_iff_exists_finsupp,
+    finsupp.equiv_fun_on_finite.surjective.exists, finsupp.equiv_fun_on_finite_apply],
+  exact exists_congr (λ c, eq.congr_left $ finsupp.sum_fintype _ _ $ λ i, zero_smul _ _)
+end
+
+/--
+A family `v : α → V` is generating `V` iff every element `(x : V)`
+can be written as sum `∑ cᵢ • vᵢ = x`.
+-/
+theorem top_le_span_range_iff_forall_exists_fun :
+  ⊤ ≤ span R (range v) ↔ ∀ x, ∃ (c : α → R), ∑ i, (c i) • (v i) = x :=
+begin
+  simp_rw ←mem_span_range_iff_exists_fun,
+  exact ⟨λ h x, h trivial, λ h x _, h x⟩,
+end
+
+end span_range
+
+end fintype
+
 variables {R : Type*} {M : Type*} {N : Type*}
 variables [semiring R] [add_comm_monoid M] [module R M] [add_comm_monoid N] [module R N]
 
@@ -831,14 +975,16 @@ variables (R)
 Pick some representation of `x : span R w` as a linear combination in `w`,
 using the axiom of choice.
 -/
-def span.repr (w : set M) (x : span R w) : w →₀ R :=
+@[irreducible] def span.repr (w : set M) (x : span R w) : w →₀ R :=
 ((finsupp.mem_span_iff_total _ _ _).mp x.2).some
 
 @[simp] lemma span.finsupp_total_repr {w : set M} (x : span R w) :
   finsupp.total w M R coe (span.repr R w x) = x :=
-((finsupp.mem_span_iff_total _ _ _).mp x.2).some_spec
+begin
+  rw span.repr,
+  exact ((finsupp.mem_span_iff_total _ _ _).mp x.2).some_spec
+end
 
-attribute [irreducible] span.repr
 
 end
 
@@ -855,27 +1001,10 @@ lemma submodule.exists_finset_of_mem_supr
   {ι : Sort*} (p : ι → submodule R M) {m : M} (hm : m ∈ ⨆ i, p i) :
   ∃ s : finset ι, m ∈ ⨆ i ∈ s, p i :=
 begin
-  obtain ⟨f, hf, rfl⟩ : ∃ f ∈ finsupp.supported R R (⋃ i, ↑(p i)), finsupp.total M M R id f = m,
-  { have aux : (id : M → M) '' (⋃ (i : ι), ↑(p i)) = (⋃ (i : ι), ↑(p i)) := set.image_id _,
-    rwa [supr_eq_span, ← aux, finsupp.mem_span_image_iff_total R] at hm },
-  let t : finset M := f.support,
-  have ht : ∀ x : {x // x ∈ t}, ∃ i, ↑x ∈ p i,
-  { intros x,
-    rw finsupp.mem_supported at hf,
-    specialize hf x.2,
-    rwa set.mem_Union at hf },
-  choose g hg using ht,
-  let s : finset ι := finset.univ.image g,
-  use s,
-  simp only [mem_supr, supr_le_iff],
-  assume N hN,
-  rw [finsupp.total_apply, finsupp.sum, ← set_like.mem_coe],
-  apply N.sum_mem,
-  assume x hx,
-  apply submodule.smul_mem,
-  let i : ι := g ⟨x, hx⟩,
-  have hi : i ∈ s, { rw finset.mem_image, exact ⟨⟨x, hx⟩, finset.mem_univ _, rfl⟩ },
-  exact hN i hi (hg _),
+  have := complete_lattice.is_compact_element.exists_finset_of_le_supr (submodule R M)
+    (submodule.singleton_span_is_compact_element m) p,
+  simp only [submodule.span_singleton_le_iff_mem] at this,
+  exact this hm,
 end
 
 /-- `submodule.exists_finset_of_mem_supr` as an `iff` -/
@@ -948,7 +1077,7 @@ lemma splitting_of_finsupp_surjective_injective (f : M →ₗ[R] (α →₀ R))
 def splitting_of_fun_on_fintype_surjective [fintype α] (f : M →ₗ[R] (α → R)) (s : surjective f) :
   (α → R) →ₗ[R] M :=
 (finsupp.lift _ _ _ (λ x : α, (s (finsupp.single x 1)).some)).comp
-  (linear_equiv_fun_on_fintype R R α).symm.to_linear_map
+  (linear_equiv_fun_on_finite R R α).symm.to_linear_map
 
 lemma splitting_of_fun_on_fintype_surjective_splits
   [fintype α] (f : M →ₗ[R] (α → R)) (s : surjective f) :
@@ -956,7 +1085,7 @@ lemma splitting_of_fun_on_fintype_surjective_splits
 begin
   ext x y,
   dsimp [splitting_of_fun_on_fintype_surjective],
-  rw [linear_equiv_fun_on_fintype_symm_single, finsupp.sum_single_index, one_smul,
+  rw [linear_equiv_fun_on_finite_symm_single, finsupp.sum_single_index, one_smul,
     (s (finsupp.single x 1)).some_spec, finsupp.single_eq_pi_single],
   rw [zero_smul],
 end
diff --git a/src/linear_algebra/finsupp_vector_space.lean b/src/linear_algebra/finsupp_vector_space.lean
index 4e820134ef5ea..30f725e375198 100644
--- a/src/linear_algebra/finsupp_vector_space.lean
+++ b/src/linear_algebra/finsupp_vector_space.lean
@@ -4,22 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 
-import linear_algebra.dimension
-import linear_algebra.finite_dimensional
 import linear_algebra.std_basis
 
 /-!
 # Linear structures on function with finite support `ι →₀ M`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains results on the `R`-module structure on functions of finite support from a type
 `ι` to an `R`-module `M`, in particular in the case that `R` is a field.
 
-Furthermore, it contains some facts about isomorphisms of vector spaces from equality of dimension
-as well as the cardinality of finite dimensional vector spaces.
-
-## TODO
-
-Move the second half of this file to more appropriate other files.
 -/
 
 noncomputable theory
@@ -57,6 +52,12 @@ begin
       apply range_comp_subset_range } }
 end
 
+end ring
+
+section semiring
+variables {R : Type*} {M : Type*} {ι : Type*}
+variables [semiring R] [add_comm_monoid M] [module R M]
+
 open linear_map submodule
 
 /-- The basis on `ι →₀ M` with basis vectors `λ ⟨i, x⟩, single i (b i x)`. -/
@@ -102,7 +103,7 @@ begin
   by_cases h : i = j,
   { cases h,
     simp only [basis_repr, single_eq_same, basis.repr_self,
-               basis.finsupp.single_apply_left sigma_mk_injective] },
+               finsupp.single_apply_left sigma_mk_injective] },
   simp only [basis_repr, single_apply, h, false_and, if_false, linear_equiv.map_zero, zero_apply]
 end
 
@@ -116,91 +117,44 @@ basis.of_repr (linear_equiv.refl _ _)
   (finsupp.basis_single_one : ι → (ι →₀ R)) = λ i, finsupp.single i 1 :=
 funext $ λ i, basis.apply_eq_iff.mpr rfl
 
-end ring
-
-section dim
-variables {K : Type u} {V : Type v} {ι : Type v}
-variables [field K] [add_comm_group V] [module K V]
-
-lemma dim_eq : module.rank K (ι →₀ V) = #ι * module.rank K V :=
-begin
-  let bs := basis.of_vector_space K V,
-  rw [← bs.mk_eq_dim'', ← (finsupp.basis (λa:ι, bs)).mk_eq_dim'',
-    cardinal.mk_sigma, cardinal.sum_const']
-end
-
-end dim
+end semiring
 
 end finsupp
 
-section module
-variables {K : Type u} {V V₁ V₂ : Type v} {V' : Type w}
-variables [field K]
-variables [add_comm_group V] [module K V]
-variables [add_comm_group V₁] [module K V₁]
-variables [add_comm_group V₂] [module K V₂]
-variables [add_comm_group V'] [module K V']
-
-open module
-
-lemma equiv_of_dim_eq_lift_dim
-  (h : cardinal.lift.{w} (module.rank K V) = cardinal.lift.{v} (module.rank K V')) :
-  nonempty (V ≃ₗ[K] V') :=
-begin
-  haveI := classical.dec_eq V,
-  haveI := classical.dec_eq V',
-  let m := basis.of_vector_space K V,
-  let m' := basis.of_vector_space K V',
-  rw [←cardinal.lift_inj.1 m.mk_eq_dim, ←cardinal.lift_inj.1 m'.mk_eq_dim] at h,
-  rcases quotient.exact h with ⟨e⟩,
-  let e := (equiv.ulift.symm.trans e).trans equiv.ulift,
-  exact ⟨(m.repr ≪≫ₗ (finsupp.dom_lcongr e)) ≪≫ₗ m'.repr.symm⟩
-end
-
-/-- Two `K`-vector spaces are equivalent if their dimension is the same. -/
-def equiv_of_dim_eq_dim (h : module.rank K V₁ = module.rank K V₂) : V₁ ≃ₗ[K] V₂ :=
-begin
-  classical,
-  exact classical.choice (equiv_of_dim_eq_lift_dim (cardinal.lift_inj.2 h))
-end
-
-/-- An `n`-dimensional `K`-vector space is equivalent to `fin n → K`. -/
-def fin_dim_vectorspace_equiv (n : ℕ)
-  (hn : (module.rank K V) = n) : V ≃ₗ[K] (fin n → K) :=
-begin
-  have : cardinal.lift.{u} (n : cardinal.{v}) = cardinal.lift.{v} (n : cardinal.{u}),
-    by simp,
-  have hn := cardinal.lift_inj.{v u}.2 hn,
-  rw this at hn,
-  rw ←@dim_fin_fun K _ n at hn,
-  exact classical.choice (equiv_of_dim_eq_lift_dim hn),
-end
-
-end module
-
-section module
+/-! TODO: move this section to an earlier file. -/
 
-open module
+namespace basis
 
-variables (K V : Type u) [field K] [add_comm_group V] [module K V]
+variables {R M n : Type*}
+variables [decidable_eq n] [fintype n]
+variables [semiring R] [add_comm_monoid M] [module R M]
 
-lemma cardinal_mk_eq_cardinal_mk_field_pow_dim [finite_dimensional K V] :
-  #V = #K ^ module.rank K V :=
+lemma _root_.finset.sum_single_ite (a : R) (i : n) :
+  finset.univ.sum (λ (x : n), finsupp.single x (ite (i = x) a 0)) = finsupp.single i a :=
 begin
-  let s := basis.of_vector_space_index K V,
-  let hs := basis.of_vector_space K V,
-  calc #V = #(s →₀ K) : quotient.sound ⟨hs.repr.to_equiv⟩
-    ... = #(s → K) : quotient.sound ⟨finsupp.equiv_fun_on_fintype⟩
-    ... = _ : by rw [← cardinal.lift_inj.1 hs.mk_eq_dim, cardinal.power_def]
+  rw finset.sum_congr_set {i} (λ (x : n), finsupp.single x (ite (i = x) a 0))
+    (λ _, finsupp.single i a),
+  { simp },
+  { intros x hx,
+    rw set.mem_singleton_iff at hx,
+    simp [hx] },
+  intros x hx,
+  have hx' : ¬i = x :=
+  begin
+    refine ne_comm.mp _,
+    rwa mem_singleton_iff at hx,
+  end,
+  simp [hx'],
 end
 
-lemma cardinal_lt_omega_of_finite_dimensional [fintype K] [finite_dimensional K V] :
-  #V < ω :=
+@[simp] lemma equiv_fun_symm_std_basis (b : basis n R M) (i : n) :
+  b.equiv_fun.symm (linear_map.std_basis R (λ _, R) i 1) = b i :=
 begin
-  letI : is_noetherian K V := is_noetherian.iff_fg.2 infer_instance,
-  rw cardinal_mk_eq_cardinal_mk_field_pow_dim K V,
-  exact cardinal.power_lt_omega (cardinal.lt_omega_of_fintype K)
-    (is_noetherian.dim_lt_omega K V),
+  have := equiv_like.injective b.repr,
+  apply_fun b.repr,
+  simp only [equiv_fun_symm_apply, std_basis_apply', linear_equiv.map_sum,
+    linear_equiv.map_smulₛₗ, ring_hom.id_apply, repr_self, finsupp.smul_single', boole_mul],
+  exact finset.sum_single_ite 1 i,
 end
 
-end module
+end basis
diff --git a/src/linear_algebra/free_algebra.lean b/src/linear_algebra/free_algebra.lean
index 720c977291e64..846d10b1f393c 100644
--- a/src/linear_algebra/free_algebra.lean
+++ b/src/linear_algebra/free_algebra.lean
@@ -5,10 +5,14 @@ Authors: Eric Wieser
 -/
 import linear_algebra.basis
 import algebra.free_algebra
+import linear_algebra.dimension
 import linear_algebra.finsupp_vector_space
 /-!
 # Linear algebra properties of `free_algebra R X`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides a `free_monoid X` basis on the `free_algebra R X`, and uses it to show the
 dimension of the algebra is the cardinality of `list X`
 -/
@@ -26,8 +30,8 @@ finsupp.basis_single_one.map
   (equiv_monoid_algebra_free_monoid.symm.to_linear_equiv : _ ≃ₗ[R] free_algebra R X)
 
 -- TODO: generalize to `X : Type v`
-lemma dim_eq {K : Type u} {X : Type (max u v)} [field K] :
+lemma rank_eq {K : Type u} {X : Type (max u v)} [field K] :
   module.rank K (free_algebra K X) = cardinal.mk (list X) :=
-(cardinal.lift_inj.mp (basis_free_monoid K X).mk_eq_dim).symm
+(cardinal.lift_inj.mp (basis_free_monoid K X).mk_eq_rank).symm
 
 end free_algebra
diff --git a/src/linear_algebra/free_module/basic.lean b/src/linear_algebra/free_module/basic.lean
index 3550663fab514..da064229d8fdf 100644
--- a/src/linear_algebra/free_module/basic.lean
+++ b/src/linear_algebra/free_module/basic.lean
@@ -5,13 +5,18 @@ Authors: Riccardo Brasca
 -/
 
 import linear_algebra.direct_sum.finsupp
-import logic.small
+import logic.small.basic
 import linear_algebra.std_basis
+import linear_algebra.finsupp_vector_space
+import linear_algebra.tensor_product_basis
 
 /-!
 
 # Free modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We introduce a class `module.free R M`, for `R` a `semiring` and `M` an `R`-module and we provide
 several basic instances for this class.
 
@@ -25,7 +30,7 @@ Use `finsupp.total_id_surjective` to prove that any module is the quotient of a
 
 universes u v w z
 
-variables (R : Type u) (M : Type v) (N : Type z)
+variables {ι : Type*} (R : Type u) (M : Type v) (N : Type z)
 
 open_locale tensor_product direct_sum big_operators
 
@@ -67,7 +72,7 @@ variables [add_comm_monoid N] [module R N]
 
 /-- If `module.free R M` then `choose_basis_index R M` is the `ι` which indexes the basis
   `ι → M`. -/
-@[nolint has_inhabited_instance] def choose_basis_index := (exists_basis R M).some.1
+def choose_basis_index := (exists_basis R M).some.1
 
 /-- If `module.free R M` then `choose_basis : ι → M` is the basis.
 Here `ι = choose_basis_index R M`. -/
@@ -91,14 +96,8 @@ noncomputable def constr {S : Type z} [semiring S] [module S N] [smul_comm_class
 instance no_zero_smul_divisors [no_zero_divisors R] : no_zero_smul_divisors R M :=
 let ⟨⟨_, b⟩⟩ := exists_basis R M in b.no_zero_smul_divisors
 
-/-- The product of finitely many free modules is free. -/
-instance pi {ι : Type*} [fintype ι] {M : ι → Type*} [Π (i : ι), add_comm_group (M i)]
-  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π i, M i) :=
-of_basis $ pi.basis $ λ i, choose_basis R (M i)
-
-/-- The module of finite matrices is free. -/
-instance matrix {m n : Type*} [fintype m] [fintype n] : module.free R (matrix m n R) :=
-of_basis $ matrix.std_basis R m n
+instance [nontrivial M] : nonempty (module.free.choose_basis_index R M) :=
+(module.free.choose_basis R M).index_nonempty
 
 variables {R M N}
 
@@ -113,21 +112,40 @@ of_equiv e
 
 variables (R M N)
 
-instance {ι : Type v} : module.free R (ι →₀ R) :=
-of_basis (basis.of_repr (linear_equiv.refl _ _))
-
-instance {ι : Type v} [fintype ι] : module.free R (ι → R) :=
-of_equiv (basis.of_repr $ linear_equiv.refl _ _).equiv_fun
+/-- The module structure provided by `semiring.to_module` is free. -/
+instance self : module.free R R := of_basis (basis.singleton unit R)
 
 instance prod [module.free R N] : module.free R (M × N) :=
 of_basis $ (choose_basis R M).prod (choose_basis R N)
 
-instance self : module.free R R := of_basis $ basis.singleton unit R
+/-- The product of finitely many free modules is free. -/
+instance pi (M : ι → Type*) [finite ι] [Π (i : ι), add_comm_monoid (M i)]
+  [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π i, M i) :=
+let ⟨_⟩ := nonempty_fintype ι in by exactI (of_basis $ pi.basis $ λ i, choose_basis R (M i))
+
+/-- The module of finite matrices is free. -/
+instance matrix {m n : Type*} [finite m] [finite n] : module.free R (matrix m n M) :=
+module.free.pi R _
+
+variables (ι)
+
+/-- The product of finitely many free modules is free (non-dependent version to help with typeclass
+search). -/
+instance function [finite ι] : module.free R (ι → M) := free.pi _ _
+
+instance finsupp : module.free R (ι →₀ M) :=
+of_basis (finsupp.basis $ λ i, choose_basis R M)
+
+variables {ι}
 
 @[priority 100]
 instance of_subsingleton [subsingleton N] : module.free R N :=
 of_basis (basis.empty N : basis pempty R N)
 
+@[priority 100]
+instance of_subsingleton' [subsingleton R] : module.free R N :=
+by letI := module.subsingleton R N; exact module.free.of_subsingleton R N
+
 instance dfinsupp {ι : Type*} (M : ι → Type*) [Π (i : ι), add_comm_monoid (M i)]
   [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] : module.free R (Π₀ i, M i) :=
 of_basis $ dfinsupp.basis $ λ i, choose_basis R (M i)
@@ -144,8 +162,7 @@ variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
 variables [add_comm_group N] [module R N] [module.free R N]
 
 instance tensor : module.free R (M ⊗[R] N) :=
-of_equiv' (of_equiv' (finsupp.free R) (finsupp_tensor_finsupp' R _ _).symm)
-  (tensor_product.congr (choose_basis R M).repr (choose_basis R N).repr).symm
+let ⟨bM⟩ := exists_basis R M, ⟨bN⟩ := exists_basis R N in of_basis (bM.2.tensor_product bN.2)
 
 end comm_ring
 
diff --git a/src/linear_algebra/free_module/determinant.lean b/src/linear_algebra/free_module/determinant.lean
new file mode 100644
index 0000000000000..a9bc68de15a2d
--- /dev/null
+++ b/src/linear_algebra/free_module/determinant.lean
@@ -0,0 +1,33 @@
+/-
+Copyright (c) 2022 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen, Alex J. Best
+-/
+
+import linear_algebra.determinant
+import linear_algebra.free_module.finite.basic
+
+/-!
+# Determinants in free (finite) modules
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Quite a lot of our results on determinants (that you might know in vector spaces) will work for all
+free (finite) modules over any commutative ring.
+
+## Main results
+
+ * `linear_map.det_zero''`: The determinant of the constant zero map is zero, in a finite free
+   nontrivial module.
+-/
+
+@[simp] lemma linear_map.det_zero'' {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
+  [module.free R M] [module.finite R M] [nontrivial M] :
+  linear_map.det (0 : M →ₗ[R] M) = 0 :=
+begin
+  letI : nonempty (module.free.choose_basis_index R M) :=
+    (module.free.choose_basis R M).index_nonempty,
+  nontriviality R,
+  exact linear_map.det_zero' (module.free.choose_basis R M)
+end
diff --git a/src/linear_algebra/free_module/finite/basic.lean b/src/linear_algebra/free_module/finite/basic.lean
index eb8a3f782eae8..e46f75d83b35e 100644
--- a/src/linear_algebra/free_module/finite/basic.lean
+++ b/src/linear_algebra/free_module/finite/basic.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
+import linear_algebra.dimension
 import linear_algebra.free_module.basic
-import linear_algebra.matrix.to_lin
 import ring_theory.finiteness
 
 /-!
 # Finite and free modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We provide some instances for finite and free modules.
 
 ## Main results
@@ -18,7 +21,6 @@ We provide some instances for finite and free modules.
 * `module.free.choose_basis_index.fintype` : If a free module is finite, then any basis is
   finite.
 * `module.free.linear_map.free ` : if `M` and `N` are finite and free, then `M →ₗ[R] N` is free.
-* `module.finite.of_basis` : A free module with a basis indexed by a `fintype` is finite.
 * `module.free.linear_map.module.finite` : if `M` and `N` are finite and free, then `M →ₗ[R] N`
   is finite.
 -/
@@ -50,49 +52,23 @@ section comm_ring
 variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
 variables [add_comm_group N] [module R N] [module.free R N]
 
-instance [nontrivial R] [module.finite R M] [module.finite R N] : module.free R (M →ₗ[R] N) :=
-begin
-  classical,
-  exact of_equiv
-    (linear_map.to_matrix (module.free.choose_basis R M) (module.free.choose_basis R N)).symm,
-end
-
-variables {R M}
+variables {R}
 
 /-- A free module with a basis indexed by a `fintype` is finite. -/
-lemma _root_.module.finite.of_basis {R : Type*} {M : Type*} {ι : Type*} [comm_ring R]
-  [add_comm_group M] [module R M] [fintype ι] (b : basis ι R M) : module.finite R M :=
+lemma _root_.module.finite.of_basis {R M ι : Type*} [comm_ring R] [add_comm_group M] [module R M]
+  [finite ι] (b : basis ι R M) : module.finite R M :=
 begin
+  casesI nonempty_fintype ι,
   classical,
   refine ⟨⟨finset.univ.image b, _⟩⟩,
   simp only [set.image_univ, finset.coe_univ, finset.coe_image, basis.span_eq],
 end
 
-instance _root_.module.finite.matrix {ι₁ : Type*} [fintype ι₁] {ι₂ : Type*} [fintype ι₂] :
+instance _root_.module.finite.matrix {ι₁ ι₂ : Type*} [finite ι₁] [finite ι₂] :
   module.finite R (matrix ι₁ ι₂ R) :=
-module.finite.of_basis $ pi.basis $ λ i, pi.basis_fun R _
-
-instance [nontrivial R] [module.finite R M] [module.finite R N] :
-  module.finite R (M →ₗ[R] N) :=
-begin
-  classical,
-  have f := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)).symm,
-  exact module.finite.of_surjective f.to_linear_map (linear_equiv.surjective f),
-end
+by { casesI nonempty_fintype ι₁, casesI nonempty_fintype ι₂,
+  exact module.finite.of_basis (pi.basis $ λ i, pi.basis_fun R _) }
 
 end comm_ring
 
-section integer
-
-variables [add_comm_group M] [module.finite ℤ M] [module.free ℤ M]
-variables [add_comm_group N] [module.finite ℤ N] [module.free ℤ N]
-
-instance : module.finite ℤ (M →+ N) :=
-module.finite.equiv (add_monoid_hom_lequiv_int ℤ).symm
-
-instance : module.free ℤ (M →+ N) :=
-module.free.of_equiv (add_monoid_hom_lequiv_int ℤ).symm
-
-end integer
-
 end module.free
diff --git a/src/linear_algebra/free_module/finite/matrix.lean b/src/linear_algebra/free_module/finite/matrix.lean
new file mode 100644
index 0000000000000..330c3b24583d0
--- /dev/null
+++ b/src/linear_algebra/free_module/finite/matrix.lean
@@ -0,0 +1,106 @@
+/-
+Copyright (c) 2021 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca
+-/
+
+import linear_algebra.finrank
+import linear_algebra.free_module.finite.rank
+import linear_algebra.matrix.to_lin
+
+/-!
+# Finite and free modules using matrices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We provide some instances for finite and free modules involving matrices.
+
+## Main results
+
+* `module.free.linear_map` : if `M` and `N` are finite and free, then `M →ₗ[R] N` is free.
+* `module.finite.of_basis` : A free module with a basis indexed by a `fintype` is finite.
+* `module.finite.linear_map` : if `M` and `N` are finite and free, then `M →ₗ[R] N`
+  is finite.
+-/
+
+universes u v w
+
+variables (R : Type u) (M : Type v) (N : Type w)
+
+open module.free (choose_basis)
+open finite_dimensional (finrank)
+
+section comm_ring
+
+variables [comm_ring R] [add_comm_group M] [module R M] [module.free R M]
+variables [add_comm_group N] [module R N] [module.free R N]
+
+instance module.free.linear_map [module.finite R M] [module.finite R N] :
+  module.free R (M →ₗ[R] N) :=
+begin
+  casesI subsingleton_or_nontrivial R,
+  { apply module.free.of_subsingleton' },
+  classical,
+  exact module.free.of_equiv (linear_map.to_matrix (choose_basis R M) (choose_basis R N)).symm,
+end
+
+variables {R}
+
+instance module.finite.linear_map [module.finite R M] [module.finite R N] :
+  module.finite R (M →ₗ[R] N) :=
+begin
+  casesI subsingleton_or_nontrivial R,
+  { apply_instance },
+  classical,
+  have f := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)).symm,
+  exact module.finite.of_surjective f.to_linear_map (linear_equiv.surjective f),
+end
+
+end comm_ring
+
+section integer
+
+variables [add_comm_group M] [module.finite ℤ M] [module.free ℤ M]
+variables [add_comm_group N] [module.finite ℤ N] [module.free ℤ N]
+
+instance module.finite.add_monoid_hom : module.finite ℤ (M →+ N) :=
+module.finite.equiv (add_monoid_hom_lequiv_int ℤ).symm
+
+instance module.free.add_monoid_hom : module.free ℤ (M →+ N) :=
+begin
+  letI : module.free ℤ (M →ₗ[ℤ] N) := module.free.linear_map _ _ _,
+  exact module.free.of_equiv (add_monoid_hom_lequiv_int ℤ).symm
+end
+
+end integer
+
+section comm_ring
+
+variables [comm_ring R] [strong_rank_condition R]
+variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
+variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]
+
+/-- The finrank of `M →ₗ[R] N` is `(finrank R M) * (finrank R N)`. -/
+lemma finite_dimensional.finrank_linear_map :
+  finrank R (M →ₗ[R] N) = (finrank R M) * (finrank R N) :=
+begin
+  classical,
+  letI := nontrivial_of_invariant_basis_number R,
+  have h := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)),
+  simp_rw [h.finrank_eq, finite_dimensional.finrank_matrix,
+    finite_dimensional.finrank_eq_card_choose_basis_index, mul_comm],
+end
+
+end comm_ring
+
+lemma matrix.rank_vec_mul_vec {K m n : Type u}
+  [comm_ring K] [strong_rank_condition K] [fintype n] [decidable_eq n]
+  (w : m → K) (v : n → K) :
+  (matrix.vec_mul_vec w v).to_lin'.rank ≤ 1 :=
+begin
+  rw [matrix.vec_mul_vec_eq, matrix.to_lin'_mul],
+  refine le_trans (linear_map.rank_comp_le_left _ _) _,
+  refine (linear_map.rank_le_domain _).trans_eq _,
+  rw [rank_fun', fintype.card_unit, nat.cast_one]
+end
diff --git a/src/linear_algebra/free_module/finite/rank.lean b/src/linear_algebra/free_module/finite/rank.lean
index e82c8e6b8d928..0de26d8d1ba11 100644
--- a/src/linear_algebra/free_module/finite/rank.lean
+++ b/src/linear_algebra/free_module/finite/rank.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
+import linear_algebra.finrank
 import linear_algebra.free_module.rank
 import linear_algebra.free_module.finite.basic
 
@@ -11,12 +12,14 @@ import linear_algebra.free_module.finite.basic
 
 # Rank of finite free modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This is a basic API for the rank of finite free modules.
 
 -/
 
---TODO: `linear_algebra/finite_dimensional` should import this file, and a lot of results should
---be moved here.
+--TODO: many results from `linear_algebra/finite_dimensional` should be moved here.
 
 universes u v w
 
@@ -26,25 +29,48 @@ open_locale tensor_product direct_sum big_operators cardinal
 
 open cardinal finite_dimensional fintype
 
-namespace module.free
+namespace finite_dimensional
+open module.free
 
 section ring
+variables [ring R]
+variables [add_comm_group M] [module R M]
+variables [add_comm_group N] [module R N]
+
+@[simp]
+lemma submodule.finrank_map_subtype_eq (p : submodule R M) (q : submodule R p) :
+  finrank R (q.map p.subtype) = finrank R q :=
+(submodule.equiv_subtype_map p q).symm.finrank_eq
+
+end ring
+
+section ring_finite
 
 variables [ring R] [strong_rank_condition R]
-variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
-variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]
+variables [add_comm_group M] [module R M] [module.finite R M]
+variables [add_comm_group N] [module R N] [module.finite R N]
 
-/-- The rank of a finite and free module is finite. -/
-lemma rank_lt_omega : module.rank R M < ω :=
+/-- The rank of a finite module is finite. -/
+lemma rank_lt_aleph_0 : module.rank R M < ℵ₀ :=
 begin
+  dunfold module.rank,
   letI := nontrivial_of_invariant_basis_number R,
-  rw [← (choose_basis R M).mk_eq_dim'', lt_omega_iff_fintype],
-  exact nonempty.intro infer_instance
+  obtain ⟨S, hS⟩ := module.finite_def.mp ‹_›,
+  refine (csupr_le' $ λ i, _).trans_lt (nat_lt_aleph_0 S.card),
+  exact linear_independent_le_span_finset _ i.prop S hS,
 end
 
-/-- If `M` is finite and free, `finrank M = rank M`. -/
+/-- If `M` is finite, `finrank M = rank M`. -/
 @[simp] lemma finrank_eq_rank : ↑(finrank R M) = module.rank R M :=
-by { rw [finrank, cast_to_nat_of_lt_omega (rank_lt_omega R M)] }
+by { rw [finrank, cast_to_nat_of_lt_aleph_0 (rank_lt_aleph_0 R M)] }
+
+end ring_finite
+
+section ring_free
+
+variables [ring R] [strong_rank_condition R]
+variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
+variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]
 
 /-- The finrank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
 lemma finrank_eq_card_choose_basis_index : finrank R M = @card (choose_basis_index R M)
@@ -56,7 +82,7 @@ end
 
 /-- The finrank of `(ι →₀ R)` is `fintype.card ι`. -/
 @[simp] lemma finrank_finsupp {ι : Type v} [fintype ι] : finrank R (ι →₀ R) = card ι :=
-by { rw [finrank, rank_finsupp, ← mk_to_nat_eq_card, to_nat_lift] }
+by { rw [finrank, rank_finsupp_self, ← mk_to_nat_eq_card, to_nat_lift] }
 
 /-- The finrank of `(ι → R)` is `fintype.card ι`. -/
 lemma finrank_pi {ι : Type v} [fintype ι] : finrank R (ι → R) = card ι :=
@@ -74,7 +100,7 @@ end
 
 /-- The finrank of `M × N` is `(finrank R M) + (finrank R N)`. -/
 @[simp] lemma finrank_prod : finrank R (M × N) = (finrank R M) + (finrank R N) :=
-by { simp [finrank, rank_lt_omega R M, rank_lt_omega R N] }
+by { simp [finrank, rank_lt_aleph_0 R M, rank_lt_aleph_0 R N] }
 
 /-- The finrank of a finite product is the sum of the finranks. -/
 --TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
@@ -83,17 +109,36 @@ lemma finrank_pi_fintype {ι : Type v} [fintype ι] {M : ι → Type w}
   [Π (i : ι), module.finite R (M i)] : finrank R (Π i, M i) = ∑ i, finrank R (M i) :=
 begin
   letI := nontrivial_of_invariant_basis_number R,
-  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_pi_fintype,
+  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_pi,
     ← mk_sigma, mk_to_nat_eq_card, card_sigma],
 end
 
 /-- If `m` and `n` are `fintype`, the finrank of `m × n` matrices is
   `(fintype.card m) * (fintype.card n)`. -/
-lemma finrank_matrix (m n : Type v) [fintype m] [fintype n] :
+lemma finrank_matrix (m n : Type*) [fintype m] [fintype n] :
   finrank R (matrix m n R) = (card m) * (card n) :=
 by { simp [finrank] }
 
-end ring
+variables {R M N}
+
+/-- Two finite and free modules are isomorphic if they have the same (finite) rank. -/
+theorem nonempty_linear_equiv_of_finrank_eq
+  (cond : finrank R M = finrank R N) : nonempty (M ≃ₗ[R] N) :=
+nonempty_linear_equiv_of_lift_rank_eq $ by simp only [← finrank_eq_rank, cond, lift_nat_cast]
+
+/-- Two finite and free modules are isomorphic if and only if they have the same (finite) rank. -/
+theorem nonempty_linear_equiv_iff_finrank_eq :
+  nonempty (M ≃ₗ[R] N) ↔ finrank R M = finrank R N :=
+⟨λ ⟨h⟩, h.finrank_eq, λ h, nonempty_linear_equiv_of_finrank_eq h⟩
+
+variables (M N)
+
+/-- Two finite and free modules are isomorphic if they have the same (finite) rank. -/
+noncomputable def _root_.linear_equiv.of_finrank_eq (cond : finrank R M = finrank R N) :
+  M ≃ₗ[R] N :=
+classical.choice $ nonempty_linear_equiv_of_finrank_eq cond
+
+end ring_free
 
 section comm_ring
 
@@ -101,25 +146,54 @@ variables [comm_ring R] [strong_rank_condition R]
 variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
 variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]
 
-/-- The finrank of `M →ₗ[R] N` is `(finrank R M) * (finrank R N)`. -/
---TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
-lemma finrank_linear_hom : finrank R (M →ₗ[R] N) = (finrank R M) * (finrank R N) :=
-begin
-  classical,
-  letI := nontrivial_of_invariant_basis_number R,
-  have h := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)),
-  let b := (matrix.std_basis _ _ _).map h.symm,
-  rw [finrank, dim_eq_card_basis b, ← mk_fintype, mk_to_nat_eq_card, finrank, finrank,
-    rank_eq_card_choose_basis_index, rank_eq_card_choose_basis_index, mk_to_nat_eq_card,
-    mk_to_nat_eq_card, card_prod, mul_comm]
-end
-
 /-- The finrank of `M ⊗[R] N` is `(finrank R M) * (finrank R N)`. -/
 @[simp] lemma finrank_tensor_product (M : Type v) (N : Type w) [add_comm_group M] [module R M]
   [module.free R M] [add_comm_group N] [module R N] [module.free R N] :
-finrank R (M ⊗[R] N) = (finrank R M) * (finrank R N) :=
+  finrank R (M ⊗[R] N) = (finrank R M) * (finrank R N) :=
 by { simp [finrank] }
 
 end comm_ring
 
-end module.free
+end finite_dimensional
+
+section
+open finite_dimensional
+
+variables {R M N}
+variables [ring R] [strong_rank_condition R]
+variables [add_comm_group M] [module R M]
+variables [add_comm_group N] [module R N]
+
+lemma linear_map.finrank_le_finrank_of_injective [module.finite R N] {f : M →ₗ[R] N}
+  (hf : function.injective f) : finrank R M ≤ finrank R N :=
+finrank_le_finrank_of_rank_le_rank
+  (linear_map.lift_rank_le_of_injective _ hf) (rank_lt_aleph_0 _ _)
+
+lemma linear_map.finrank_range_le [module.finite R M] (f : M →ₗ[R] N) :
+  finrank R f.range ≤ finrank R M :=
+finrank_le_finrank_of_rank_le_rank (lift_rank_range_le f) (rank_lt_aleph_0 _ _)
+
+/-- The dimension of a submodule is bounded by the dimension of the ambient space. -/
+lemma submodule.finrank_le [module.finite R M] (s : submodule R M) :
+  finrank R s ≤ finrank R M :=
+by simpa only [cardinal.to_nat_lift] using to_nat_le_of_le_of_lt_aleph_0
+  (rank_lt_aleph_0 _ _) (rank_submodule_le s)
+
+/-- The dimension of a quotient is bounded by the dimension of the ambient space. -/
+lemma submodule.finrank_quotient_le [module.finite R M] (s : submodule R M) :
+  finrank R (M ⧸ s) ≤ finrank R M :=
+by simpa only [cardinal.to_nat_lift] using to_nat_le_of_le_of_lt_aleph_0
+  (rank_lt_aleph_0 _ _) ((submodule.mkq s).rank_le_of_surjective (surjective_quot_mk _))
+
+/-- Pushforwards of finite submodules have a smaller finrank. -/
+lemma submodule.finrank_map_le (f : M →ₗ[R] N) (p : submodule R M) [module.finite R p] :
+  finrank R (p.map f) ≤ finrank R p :=
+finrank_le_finrank_of_rank_le_rank (lift_rank_map_le _ _) (rank_lt_aleph_0 _ _)
+
+lemma submodule.finrank_le_finrank_of_le {s t : submodule R M} [module.finite R t]
+  (hst : s ≤ t) : finrank R s ≤ finrank R t :=
+calc finrank R s = finrank R (s.comap t.subtype)
+      : (submodule.comap_subtype_equiv_of_le hst).finrank_eq.symm
+... ≤ finrank R t : submodule.finrank_le _
+
+end
diff --git a/src/linear_algebra/free_module/ideal_quotient.lean b/src/linear_algebra/free_module/ideal_quotient.lean
new file mode 100644
index 0000000000000..e41849fa71da7
--- /dev/null
+++ b/src/linear_algebra/free_module/ideal_quotient.lean
@@ -0,0 +1,136 @@
+/-
+Copyright (c) 2022 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+
+import data.zmod.quotient
+import linear_algebra.free_module.finite.rank
+import linear_algebra.free_module.pid
+import linear_algebra.free_module.strong_rank_condition
+import linear_algebra.quotient_pi
+
+/-! # Ideals in free modules over PIDs
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main results
+
+ - `ideal.quotient_equiv_pi_span`: `S ⧸ I`, if `S` is finite free as a module over a PID `R`,
+   can be written as a product of quotients of `R` by principal ideals.
+
+-/
+
+namespace ideal
+
+open_locale big_operators direct_sum polynomial
+
+variables {R S ι : Type*} [comm_ring R] [comm_ring S] [algebra R S]
+variables [is_domain R] [is_principal_ideal_ring R] [is_domain S] [finite ι]
+
+/-- We can write the quotient of an ideal over a PID as a product of quotients by principal ideals.
+-/
+noncomputable def quotient_equiv_pi_span
+  (I : ideal S) (b : basis ι R S) (hI : I ≠ ⊥) :
+  (S ⧸ I) ≃ₗ[R] Π i, (R ⧸ span ({I.smith_coeffs b hI i} : set R)) :=
+begin
+  haveI := fintype.of_finite ι,
+  -- Choose `e : S ≃ₗ I` and a basis `b'` for `S` that turns the map
+  -- `f := ((submodule.subtype I).restrict_scalars R).comp e` into a diagonal matrix:
+  -- there is an `a : ι → ℤ` such that `f (b' i) = a i • b' i`.
+  let a := I.smith_coeffs b hI,
+  let b' := I.ring_basis b hI,
+  let ab := I.self_basis b hI,
+  have ab_eq := I.self_basis_def b hI,
+  let e : S ≃ₗ[R] I := b'.equiv ab (equiv.refl _),
+  let f : S →ₗ[R] S := (I.subtype.restrict_scalars R).comp (e : S →ₗ[R] I),
+  let f_apply : ∀ x, f x = b'.equiv ab (equiv.refl _) x := λ x, rfl,
+  have ha : ∀ i, f (b' i) = a i • b' i,
+  { intro i, rw [f_apply, b'.equiv_apply, equiv.refl_apply, ab_eq] },
+  have mem_I_iff : ∀ x, x ∈ I ↔ ∀ i, a i ∣ b'.repr x i,
+  { intro x, simp_rw [ab.mem_ideal_iff', ab_eq],
+    have : ∀ (c : ι → R) i, b'.repr (∑ (j : ι), c j • a j • b' j) i = a i * c i,
+    { intros c i,
+      simp only [← mul_action.mul_smul, b'.repr_sum_self, mul_comm] },
+    split,
+    { rintro ⟨c, rfl⟩ i, exact ⟨c i, this c i⟩ },
+    { rintros ha,
+      choose c hc using ha, exact ⟨c, b'.ext_elem (λ i, trans (hc i) (this c i).symm)⟩ } },
+
+  -- Now we map everything through the linear equiv `S ≃ₗ (ι → R)`,
+  -- which maps `I` to `I' := Π i, a i ℤ`.
+  let I' : submodule R (ι → R) := submodule.pi set.univ (λ i, span ({a i} : set R)),
+  have : submodule.map (b'.equiv_fun : S →ₗ[R] (ι → R)) (I.restrict_scalars R) = I',
+  { ext x,
+    simp only [submodule.mem_map, submodule.mem_pi, mem_span_singleton, set.mem_univ,
+               submodule.restrict_scalars_mem, mem_I_iff, smul_eq_mul, forall_true_left,
+               linear_equiv.coe_coe, basis.equiv_fun_apply],
+    split,
+    { rintros ⟨y, hy, rfl⟩ i, exact hy i },
+    { rintros hdvd,
+      refine ⟨∑ i, x i • b' i, λ i, _, _⟩; rwa b'.repr_sum_self,
+      { exact hdvd i } } },
+  refine ((submodule.quotient.restrict_scalars_equiv R I).restrict_scalars R).symm.trans _,
+  any_goals { apply ring_hom.id }, any_goals { apply_instance },
+  refine (submodule.quotient.equiv (I.restrict_scalars R) I' b'.equiv_fun this).trans _,
+  any_goals { apply ring_hom.id }, any_goals { apply_instance },
+  classical,
+  let := submodule.quotient_pi (show Π i, submodule R R, from λ i, span ({a i} : set R)),
+  exact this
+end
+
+/-- Ideal quotients over a free finite extension of `ℤ` are isomorphic to a direct product of
+`zmod`. -/
+noncomputable def quotient_equiv_pi_zmod
+  (I : ideal S) (b : basis ι ℤ S) (hI : I ≠ ⊥) :
+  (S ⧸ I) ≃+ Π i, (zmod (I.smith_coeffs b hI i).nat_abs) :=
+let a := I.smith_coeffs b hI,
+    e := I.quotient_equiv_pi_span b hI,
+    e' : (Π (i : ι), (ℤ ⧸ span ({a i} : set ℤ))) ≃+ Π (i : ι), zmod (a i).nat_abs :=
+  add_equiv.Pi_congr_right (λ i, ↑(int.quotient_span_equiv_zmod (a i)))
+in (↑(e : (S ⧸ I) ≃ₗ[ℤ] _) : (S ⧸ I ≃+ _)).trans e'
+
+/-- A nonzero ideal over a free finite extension of `ℤ` has a finite quotient.
+
+Can't be an instance because of the side condition `I ≠ ⊥`, and more importantly,
+because the choice of `fintype` instance is non-canonical.
+-/
+noncomputable def fintype_quotient_of_free_of_ne_bot [module.free ℤ S] [module.finite ℤ S]
+  (I : ideal S) (hI : I ≠ ⊥) :
+  fintype (S ⧸ I) :=
+let b := module.free.choose_basis ℤ S,
+    a := I.smith_coeffs b hI,
+    e := I.quotient_equiv_pi_zmod b hI
+in by haveI : ∀ i, ne_zero (a i).nat_abs :=
+    (λ i, ⟨int.nat_abs_ne_zero_of_ne_zero (smith_coeffs_ne_zero b I hI i)⟩); classical;
+  exact fintype.of_equiv (Π i, zmod (a i).nat_abs) e.symm
+
+variables (F : Type*) [comm_ring F] [algebra F R] [algebra F S] [is_scalar_tower F R S]
+  (b : basis ι R S) {I : ideal S} (hI : I ≠ ⊥)
+
+/-- Decompose `S⧸I` as a direct sum of cyclic `R`-modules
+  (quotients by the ideals generated by Smith coefficients of `I`). -/
+noncomputable def quotient_equiv_direct_sum :
+  (S ⧸ I) ≃ₗ[F] ⨁ i, R ⧸ span ({I.smith_coeffs b hI i} : set R) :=
+begin
+  haveI := fintype.of_finite ι,
+  apply ((I.quotient_equiv_pi_span b _).restrict_scalars F).trans
+    (direct_sum.linear_equiv_fun_on_fintype _ _ _).symm,
+  exact linear_map.is_scalar_tower.compatible_smul
+  -- why doesn't it automatically apply?
+  -- even after `change linear_map.compatible_smul _ (Π i, R ⧸ span _) F R`
+end
+
+lemma finrank_quotient_eq_sum {ι} [fintype ι] (b : basis ι R S) [nontrivial F]
+  [∀ i, module.free F (R ⧸ span ({I.smith_coeffs b hI i} : set R))]
+  [∀ i, module.finite F (R ⧸ span ({I.smith_coeffs b hI i} : set R))] :
+  finite_dimensional.finrank F (S ⧸ I)
+    = ∑ i, finite_dimensional.finrank F (R ⧸ span ({I.smith_coeffs b hI i} : set R)) :=
+begin
+  rw [linear_equiv.finrank_eq $ quotient_equiv_direct_sum F b hI,
+      finite_dimensional.finrank_direct_sum]
+  -- slow, and dot notation doesn't work
+end
+
+end ideal
diff --git a/src/linear_algebra/free_module/norm.lean b/src/linear_algebra/free_module/norm.lean
new file mode 100644
index 0000000000000..f9366158ef8a6
--- /dev/null
+++ b/src/linear_algebra/free_module/norm.lean
@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2023 Junyan Xu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Junyan Xu
+-/
+
+import linear_algebra.free_module.ideal_quotient
+import ring_theory.norm
+
+/-!
+# Norms on free modules over principal ideal domains
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open ideal polynomial
+
+open_locale big_operators polynomial
+
+variables {R S ι : Type*} [comm_ring R] [is_domain R] [is_principal_ideal_ring R] [comm_ring S]
+  [is_domain S] [algebra R S]
+
+section comm_ring
+
+variables (F : Type*) [comm_ring F] [algebra F R] [algebra F S] [is_scalar_tower F R S]
+
+/-- For a nonzero element `f` in an algebra `S` over a principal ideal domain `R` that is finite and
+free as an `R`-module, the norm of `f` relative to `R` is associated to the product of the Smith
+coefficients of the ideal generated by `f`. -/
+lemma associated_norm_prod_smith [fintype ι] (b : basis ι R S) {f : S} (hf : f ≠ 0) :
+  associated (algebra.norm R f) (∏ i, smith_coeffs b _ (span_singleton_eq_bot.not.2 hf) i) :=
+begin
+  have hI := span_singleton_eq_bot.not.2 hf,
+  let b' := ring_basis b (span {f}) hI,
+  classical,
+  rw [← matrix.det_diagonal, ← linear_map.det_to_lin b'],
+  let e := (b'.equiv ((span {f}).self_basis b hI) $ equiv.refl _).trans
+    ((linear_equiv.coord S S f hf).restrict_scalars R),
+  refine (linear_map.associated_det_of_eq_comp e _ _ _).symm,
+  dsimp only [e, linear_equiv.trans_apply],
+  simp_rw [← linear_equiv.coe_to_linear_map, ← linear_map.comp_apply, ← linear_map.ext_iff],
+  refine b'.ext (λ i, _),
+  simp_rw [linear_map.comp_apply, linear_equiv.coe_to_linear_map, matrix.to_lin_apply,
+    basis.repr_self, finsupp.single_eq_pi_single, matrix.diagonal_mul_vec_single, pi.single_apply,
+    ite_smul, zero_smul, finset.sum_ite_eq', mul_one, if_pos (finset.mem_univ _), b'.equiv_apply],
+  change _ = f * _,
+  rw [mul_comm, ← smul_eq_mul, linear_equiv.restrict_scalars_apply, linear_equiv.coord_apply_smul,
+    ideal.self_basis_def],
+  refl
+end
+
+end comm_ring
+
+section field
+
+variables {F : Type*} [field F] [algebra F[X] S] [finite ι]
+
+instance (b : basis ι F[X] S) {I : ideal S} (hI : I ≠ ⊥) (i : ι) :
+  finite_dimensional F (F[X] ⧸ span ({I.smith_coeffs b hI i} : set F[X])) :=
+(adjoin_root.power_basis $ I.smith_coeffs_ne_zero b hI i).finite_dimensional
+
+/-- For a nonzero element `f` in a `F[X]`-module `S`, the dimension of $S/\langle f \rangle$ as an
+`F`-vector space is the degree of the norm of `f` relative to `F[X]`. -/
+lemma finrank_quotient_span_eq_nat_degree_norm [algebra F S] [is_scalar_tower F F[X] S]
+  (b : basis ι F[X] S) {f : S} (hf : f ≠ 0) :
+  finite_dimensional.finrank F (S ⧸ span ({f} : set S)) = (algebra.norm F[X] f).nat_degree :=
+begin
+  haveI := fintype.of_finite ι,
+  have h := span_singleton_eq_bot.not.2 hf,
+  rw [nat_degree_eq_of_degree_eq (degree_eq_degree_of_associated $ associated_norm_prod_smith b hf),
+      nat_degree_prod _ _ (λ i _, smith_coeffs_ne_zero b _ h i), finrank_quotient_eq_sum F h b],
+  -- finrank_quotient_eq_sum slow
+  congr' with i,
+  exact (adjoin_root.power_basis $ smith_coeffs_ne_zero b _ h i).finrank
+end
+
+end field
diff --git a/src/linear_algebra/free_module/pid.lean b/src/linear_algebra/free_module/pid.lean
index 5f1726359916b..a54dbec23e0bb 100644
--- a/src/linear_algebra/free_module/pid.lean
+++ b/src/linear_algebra/free_module/pid.lean
@@ -5,11 +5,15 @@ Authors: Anne Baanen
 -/
 
 import linear_algebra.dimension
+import linear_algebra.free_module.basic
 import ring_theory.principal_ideal_domain
 import ring_theory.finiteness
 
 /-! # Free modules over PID
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A free `R`-module `M` is a module with a basis over `R`,
 equivalently it is an `R`-module linearly equivalent to `ι →₀ R` for some `ι`.
 
@@ -58,21 +62,21 @@ variables {ι : Type*} (b : basis ι R M)
 open submodule.is_principal submodule
 
 lemma eq_bot_of_generator_maximal_map_eq_zero (b : basis ι R M) {N : submodule R M}
-  {ϕ : M →ₗ[R] R} (hϕ : ∀ (ψ : M →ₗ[R] R), N.map ϕ ≤ N.map ψ → N.map ψ = N.map ϕ)
-  [(N.map ϕ).is_principal] (hgen : generator (N.map ϕ) = 0) : N = ⊥ :=
+  {ϕ : M →ₗ[R] R} (hϕ : ∀ (ψ : M →ₗ[R] R), ¬ N.map ϕ < N.map ψ)
+  [(N.map ϕ).is_principal] (hgen : generator (N.map ϕ) = (0 : R)) : N = ⊥ :=
 begin
   rw submodule.eq_bot_iff,
   intros x hx,
   refine b.ext_elem (λ i, _),
   rw (eq_bot_iff_generator_eq_zero _).mpr hgen at hϕ,
   rw [linear_equiv.map_zero, finsupp.zero_apply],
-  exact (submodule.eq_bot_iff _).mp (hϕ ((finsupp.lapply i) ∘ₗ ↑b.repr) bot_le) _ ⟨x, hx, rfl⟩
+  exact (submodule.eq_bot_iff _).mp (not_bot_lt_iff.1 $ hϕ ((finsupp.lapply i) ∘ₗ ↑b.repr)) _
+    ⟨x, hx, rfl⟩
 end
 
 lemma eq_bot_of_generator_maximal_submodule_image_eq_zero {N O : submodule R M} (b : basis ι R O)
   (hNO : N ≤ O)
-  {ϕ : O →ₗ[R] R} (hϕ : ∀ (ψ : O →ₗ[R] R), ϕ.submodule_image N ≤ ψ.submodule_image N →
-    ψ.submodule_image N = ϕ.submodule_image N)
+  {ϕ : O →ₗ[R] R} (hϕ : ∀ (ψ : O →ₗ[R] R), ¬ ϕ.submodule_image N < ψ.submodule_image N)
   [(ϕ.submodule_image N).is_principal] (hgen : generator (ϕ.submodule_image N) = 0) :
   N = ⊥ :=
 begin
@@ -81,7 +85,7 @@ begin
   refine congr_arg coe (show (⟨x, hNO hx⟩ : O) = 0, from b.ext_elem (λ i, _)),
   rw (eq_bot_iff_generator_eq_zero _).mpr hgen at hϕ,
   rw [linear_equiv.map_zero, finsupp.zero_apply],
-  refine (submodule.eq_bot_iff _).mp (hϕ ((finsupp.lapply i) ∘ₗ ↑b.repr) bot_le) _ _,
+  refine (submodule.eq_bot_iff _).mp (not_bot_lt_iff.1 $ hϕ ((finsupp.lapply i) ∘ₗ ↑b.repr)) _ _,
   exact (linear_map.mem_submodule_image_of_le hNO).mpr ⟨x, hx, rfl⟩
 end
 
@@ -114,8 +118,7 @@ variables {M : Type*} [add_comm_group M] [module R M] {b : ι → M}
 open submodule.is_principal
 
 lemma generator_maximal_submodule_image_dvd {N O : submodule R M} (hNO : N ≤ O)
-  {ϕ : O →ₗ[R] R} (hϕ : ∀ (ψ : O →ₗ[R] R), ϕ.submodule_image N ≤ ψ.submodule_image N →
-    ψ.submodule_image N = ϕ.submodule_image N)
+  {ϕ : O →ₗ[R] R} (hϕ : ∀ (ψ : O →ₗ[R] R), ¬ ϕ.submodule_image N < ψ.submodule_image N)
   [(ϕ.submodule_image N).is_principal]
   (y : M) (yN : y ∈ N) (ϕy_eq : ϕ ⟨y, hNO yN⟩ = generator (ϕ.submodule_image N))
   (ψ : O →ₗ[R] R) : generator (ϕ.submodule_image N) ∣ ψ ⟨y, hNO yN⟩ :=
@@ -143,7 +146,7 @@ begin
   refine le_antisymm (this.trans (le_of_eq _))
     (ideal.span_singleton_le_span_singleton.mpr d_dvd_left),
   rw span_singleton_generator,
-  refine hϕ ψ' (le_trans _ this),
+  apply (le_trans _ this).eq_of_not_gt (hϕ ψ'),
   rw [← span_singleton_generator (ϕ.submodule_image N)],
   exact ideal.span_singleton_le_span_singleton.mpr d_dvd_left,
   { exact subset_span (mem_insert _ _) }
@@ -160,7 +163,7 @@ For `basis_of_pid` we only need the first half and can fix `M = ⊤`,
 for `smith_normal_form` we need the full statement,
 but must also feed in a basis for `M` using `basis_of_pid` to keep the induction going.
 -/
-lemma submodule.basis_of_pid_aux [fintype ι] {O : Type*} [add_comm_group O] [module R O]
+lemma submodule.basis_of_pid_aux [finite ι] {O : Type*} [add_comm_group O] [module R O]
   (M N : submodule R O) (b'M : basis ι R M) (N_bot : N ≠ ⊥) (N_le_M : N ≤ M) :
   ∃ (y ∈ M) (a : R) (hay : a • y ∈ N) (M' ≤ M) (N' ≤ N) (N'_le_M' : N' ≤ M')
     (y_ortho_M' : ∀ (c : R) (z : O), z ∈ M' → c • y + z = 0 → c = 0)
@@ -174,8 +177,7 @@ lemma submodule.basis_of_pid_aux [fintype ι] {O : Type*} [add_comm_group O] [mo
 begin
   -- Let `ϕ` be a maximal projection of `M` onto `R`, in the sense that there is
   -- no `ψ` whose image of `N` is larger than `ϕ`'s image of `N`.
-  have : ∃ ϕ : M →ₗ[R] R, ∀ (ψ : M →ₗ[R] R),
-    ϕ.submodule_image N ≤ ψ.submodule_image N → ψ.submodule_image N = ϕ.submodule_image N,
+  have : ∃ ϕ : M →ₗ[R] R, ∀ (ψ : M →ₗ[R] R), ¬ ϕ.submodule_image N < ψ.submodule_image N,
   { obtain ⟨P, P_eq, P_max⟩ := set_has_maximal_iff_noetherian.mpr
         (infer_instance : is_noetherian R R) _
         (show (set.range (λ ψ : M →ₗ[R] R, ψ.submodule_image N)).nonempty,
@@ -201,6 +203,7 @@ begin
   have hdvd : ∀ i, a ∣ b'M.coord i ⟨y, N_le_M yN⟩ :=
     λ i, generator_maximal_submodule_image_dvd N_le_M ϕ_max y yN ϕy_eq (b'M.coord i),
   choose c hc using hdvd,
+  casesI nonempty_fintype ι,
   let y' : O := ∑ i, c i • b'M i,
   have y'M : y' ∈ M := M.sum_mem (λ i _, M.smul_mem (c i) (b'M i).2),
   have mk_y' : (⟨y', y'M⟩ : M) = ∑ i, c i • b'M i :=
@@ -289,11 +292,12 @@ see `submodule.basis_of_pid`.
 
 See also the stronger version `submodule.smith_normal_form`.
 -/
-lemma submodule.nonempty_basis_of_pid {ι : Type*} [fintype ι]
+lemma submodule.nonempty_basis_of_pid {ι : Type*} [finite ι]
   (b : basis ι R M) (N : submodule R M) :
   ∃ (n : ℕ), nonempty (basis (fin n) R N) :=
 begin
   haveI := classical.dec_eq M,
+  casesI nonempty_fintype ι,
   refine N.induction_on_rank b _ _,
   intros N ih,
   let b' := (b.reindex (fintype.equiv_fin ι)).map (linear_equiv.of_top _ rfl).symm,
@@ -311,12 +315,12 @@ if `R` is a principal ideal domain.
 
 See also the stronger version `submodule.smith_normal_form`.
 -/
-noncomputable def submodule.basis_of_pid {ι : Type*} [fintype ι]
+noncomputable def submodule.basis_of_pid {ι : Type*} [finite ι]
   (b : basis ι R M) (N : submodule R M) :
   Σ (n : ℕ), (basis (fin n) R N) :=
 ⟨_, (N.nonempty_basis_of_pid b).some_spec.some⟩
 
-lemma submodule.basis_of_pid_bot {ι : Type*} [fintype ι] (b : basis ι R M) :
+lemma submodule.basis_of_pid_bot {ι : Type*} [finite ι] (b : basis ι R M) :
   submodule.basis_of_pid b ⊥ = ⟨0, basis.empty _⟩ :=
 begin
   obtain ⟨n, b'⟩ := submodule.basis_of_pid b ⊥,
@@ -330,7 +334,7 @@ if `R` is a principal ideal domain.
 
 See also the stronger version `submodule.smith_normal_form_of_le`.
 -/
-noncomputable def submodule.basis_of_pid_of_le {ι : Type*} [fintype ι]
+noncomputable def submodule.basis_of_pid_of_le {ι : Type*} [finite ι]
   {N O : submodule R M} (hNO : N ≤ O) (b : basis ι R O) :
   Σ (n : ℕ), basis (fin n) R N :=
 let ⟨n, bN'⟩ := submodule.basis_of_pid b (N.comap O.subtype)
@@ -339,15 +343,15 @@ in ⟨n, bN'.map (submodule.comap_subtype_equiv_of_le hNO)⟩
 /-- A submodule inside the span of a linear independent family is a free `R`-module of finite rank,
 if `R` is a principal ideal domain. -/
 noncomputable def submodule.basis_of_pid_of_le_span
-  {ι : Type*} [fintype ι] {b : ι → M} (hb : linear_independent R b)
+  {ι : Type*} [finite ι] {b : ι → M} (hb : linear_independent R b)
   {N : submodule R M} (le : N ≤ submodule.span R (set.range b)) :
   Σ (n : ℕ), basis (fin n) R N :=
 submodule.basis_of_pid_of_le le (basis.span hb)
 
 variable {M}
 
-/-- A finite type torsion free module over a PID is free. -/
-noncomputable def module.free_of_finite_type_torsion_free [fintype ι] {s : ι → M}
+/-- A finite type torsion free module over a PID admits a basis. -/
+noncomputable def module.basis_of_finite_type_torsion_free [fintype ι] {s : ι → M}
   (hs : span R (range s) = ⊤) [no_zero_smul_divisors R M] :
   Σ (n : ℕ), basis (fin n) R M :=
 begin
@@ -394,18 +398,35 @@ begin
   exact ⟨n, b.map ψ.symm⟩
 end
 
-/-- A finite type torsion free module over a PID is free. -/
-noncomputable def module.free_of_finite_type_torsion_free' [module.finite R M]
+lemma module.free_of_finite_type_torsion_free [finite ι] {s : ι → M}
+  (hs : span R (range s) = ⊤) [no_zero_smul_divisors R M] :
+  module.free R M :=
+begin
+  casesI nonempty_fintype ι,
+  obtain ⟨n, b⟩ : Σ n, basis (fin n) R M := module.basis_of_finite_type_torsion_free hs,
+  exact module.free.of_basis b,
+end
+
+/-- A finite type torsion free module over a PID admits a basis. -/
+noncomputable def module.basis_of_finite_type_torsion_free' [module.finite R M]
   [no_zero_smul_divisors R M] :
   Σ (n : ℕ), basis (fin n) R M :=
-module.free_of_finite_type_torsion_free module.finite.exists_fin.some_spec.some_spec
+module.basis_of_finite_type_torsion_free module.finite.exists_fin.some_spec.some_spec
+
+lemma module.free_of_finite_type_torsion_free' [module.finite R M]
+  [no_zero_smul_divisors R M] :
+  module.free R M :=
+begin
+  obtain ⟨n, b⟩ : Σ n, basis (fin n) R M := module.basis_of_finite_type_torsion_free',
+  exact module.free.of_basis b,
+end
 
 section smith_normal
 
 /-- A Smith normal form basis for a submodule `N` of a module `M` consists of
 bases for `M` and `N` such that the inclusion map `N → M` can be written as a
 (rectangular) matrix with `a` along the diagonal: in Smith normal form. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure basis.smith_normal_form (N : submodule R M) (ι : Type*) (n : ℕ) :=
 (bM : basis ι R M)
 (bN : basis (fin n) R N)
@@ -422,11 +443,12 @@ a `basis.smith_normal_form`.
 
 This is a strengthening of `submodule.basis_of_pid_of_le`.
 -/
-theorem submodule.exists_smith_normal_form_of_le [fintype ι]
+theorem submodule.exists_smith_normal_form_of_le [finite ι]
   (b : basis ι R M) (N O : submodule R M) (N_le_O : N ≤ O) :
   ∃ (n o : ℕ) (hno : n ≤ o) (bO : basis (fin o) R O) (bN : basis (fin n) R N) (a : fin n → R),
     ∀ i, (bN i : M) = a i • bO (fin.cast_le hno i) :=
 begin
+  casesI nonempty_fintype ι,
   revert N,
   refine induction_on_rank b _ _ O,
   intros M ih N N_le_M,
@@ -453,7 +475,7 @@ need to map `N` into a submodule of `O`.
 
 This is a strengthening of `submodule.basis_of_pid_of_le`.
 -/
-noncomputable def submodule.smith_normal_form_of_le [fintype ι]
+noncomputable def submodule.smith_normal_form_of_le [finite ι]
   (b : basis ι R M) (N O : submodule R M) (N_le_O : N ≤ O) :
   Σ (o n : ℕ), basis.smith_normal_form (N.comap O.subtype) (fin o) n :=
 begin
@@ -474,7 +496,7 @@ This is a strengthening of `submodule.basis_of_pid`.
 See also `ideal.smith_normal_form`, which moreover proves that the dimension of
 an ideal is the same as the dimension of the whole ring.
 -/
-noncomputable def submodule.smith_normal_form [fintype ι] (b : basis ι R M) (N : submodule R M) :
+noncomputable def submodule.smith_normal_form [finite ι] (b : basis ι R M) (N : submodule R M) :
   Σ (n : ℕ), basis.smith_normal_form N ι n :=
 let ⟨m, n, bM, bN, f, a, snf⟩ := N.smith_normal_form_of_le b ⊤ le_top,
     bM' := bM.map (linear_equiv.of_top _ rfl),
@@ -485,6 +507,10 @@ let ⟨m, n, bM, bN, f, a, snf⟩ := N.smith_normal_form_of_le b ⊤ le_top,
                     equiv.to_embedding_apply, function.embedding.trans_apply,
                     equiv.symm_apply_apply]⟩
 
+section ideal
+
+variables {S : Type*} [comm_ring S] [is_domain S] [algebra R S]
+
 /-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
 then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
 find a basis for `S` and `I` such that the inclusion map is a square diagonal
@@ -496,8 +522,7 @@ need to map `I` into a submodule of `R`.
 This is a strengthening of `submodule.basis_of_pid`.
 -/
 noncomputable def ideal.smith_normal_form
-  [fintype ι] {S : Type*} [comm_ring S] [is_domain S] [algebra R S]
-  (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) :
+  [fintype ι] (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) :
   basis.smith_normal_form (I.restrict_scalars R) ι (fintype.card ι) :=
 let ⟨n, bS, bI, f, a, snf⟩ := (I.restrict_scalars R).smith_normal_form b in
 have eq : _ := ideal.rank_eq bS hI (bI.map ((restrict_scalars_equiv R S S I).restrict_scalars _)),
@@ -505,6 +530,8 @@ let e : fin n ≃ fin (fintype.card ι) := fintype.equiv_of_card_eq (by rw [eq,
 ⟨bS, bI.reindex e, e.symm.to_embedding.trans f, a ∘ e.symm, λ i,
   by simp only [snf, basis.coe_reindex, function.embedding.trans_apply, equiv.to_embedding_apply]⟩
 
+variables [finite ι]
+
 /-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
 then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
 find a basis for `S` and `I` such that the inclusion map is a square diagonal
@@ -512,13 +539,15 @@ matrix.
 
 See also `ideal.smith_normal_form` for a version of this theorem that returns
 a `basis.smith_normal_form`.
+
+The definitions `ideal.ring_basis`, `ideal.self_basis`, `ideal.smith_coeffs` are (noncomputable)
+choices of values for this existential quantifier.
 -/
 theorem ideal.exists_smith_normal_form
-  [fintype ι] {S : Type*} [comm_ring S] [is_domain S] [algebra R S]
   (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) :
   ∃ (b' : basis ι R S) (a : ι → R) (ab' : basis ι R I),
   ∀ i, (ab' i : S) = a i • b' i :=
-let ⟨bS, bI, f, a, snf⟩ := I.smith_normal_form b hI,
+ by casesI nonempty_fintype ι; exact let ⟨bS, bI, f, a, snf⟩ := I.smith_normal_form b hI,
     e : fin (fintype.card ι) ≃ ι := equiv.of_bijective f
       ((fintype.bijective_iff_injective_and_card f).mpr ⟨f.injective, fintype.card_fin _⟩) in
 have fe : ∀ i, f (e.symm i) = i := e.apply_symm_apply,
@@ -526,6 +555,65 @@ have fe : ∀ i, f (e.symm i) = i := e.apply_symm_apply,
   by simp only [snf, fe, basis.map_apply, linear_equiv.restrict_scalars_apply,
     submodule.restrict_scalars_equiv_apply, basis.coe_reindex]⟩
 
+/-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
+then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
+find a basis for `S` and `I` such that the inclusion map is a square diagonal
+matrix; this is the basis for `S`.
+See `ideal.self_basis` for the basis on `I`,
+see `ideal.smith_coeffs` for the entries of the diagonal matrix
+and `ideal.self_basis_def` for the proof that the inclusion map forms a square diagonal matrix.
+-/
+noncomputable def ideal.ring_basis (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) : basis ι R S :=
+(ideal.exists_smith_normal_form b I hI).some
+
+/-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
+then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
+find a basis for `S` and `I` such that the inclusion map is a square diagonal
+matrix; this is the basis for `I`.
+See `ideal.ring_basis` for the basis on `S`,
+see `ideal.smith_coeffs` for the entries of the diagonal matrix
+and `ideal.self_basis_def` for the proof that the inclusion map forms a square diagonal matrix.
+-/
+noncomputable def ideal.self_basis (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) : basis ι R I :=
+(ideal.exists_smith_normal_form b I hI).some_spec.some_spec.some
+
+/-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
+then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
+find a basis for `S` and `I` such that the inclusion map is a square diagonal
+matrix; these are the entries of the diagonal matrix.
+See `ideal.ring_basis` for the basis on `S`,
+see `ideal.self_basis` for the basis on `I`,
+and `ideal.self_basis_def` for the proof that the inclusion map forms a square diagonal matrix.
+-/
+noncomputable def ideal.smith_coeffs (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) : ι → R :=
+(ideal.exists_smith_normal_form b I hI).some_spec.some
+
+/-- If `S` a finite-dimensional ring extension of a PID `R` which is free as an `R`-module,
+then any nonzero `S`-ideal `I` is free as an `R`-submodule of `S`, and we can
+find a basis for `S` and `I` such that the inclusion map is a square diagonal
+matrix.
+-/
+@[simp]
+lemma ideal.self_basis_def (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) :
+  ∀ i, (ideal.self_basis b I hI i : S) = ideal.smith_coeffs b I hI i • ideal.ring_basis b I hI i :=
+(ideal.exists_smith_normal_form b I hI).some_spec.some_spec.some_spec
+
+@[simp]
+lemma ideal.smith_coeffs_ne_zero (b : basis ι R S) (I : ideal S) (hI : I ≠ ⊥) (i) :
+  ideal.smith_coeffs b I hI i ≠ 0 :=
+begin
+  intro hi,
+  apply basis.ne_zero (ideal.self_basis b I hI) i,
+  refine subtype.coe_injective _,
+  simp [hi]
+end
+
+instance (F : Type u) [comm_ring F] [algebra F R] (b : basis ι R S) {I : ideal S} (hI : I ≠ ⊥) (i) :
+  module F (R ⧸ ideal.span ({I.smith_coeffs b hI i} : set R)) :=
+by apply_instance -- quotient.module' _
+
+end ideal
+
 end smith_normal
 
 end principal_ideal_domain
diff --git a/src/linear_algebra/free_module/rank.lean b/src/linear_algebra/free_module/rank.lean
index f4457a08efbbe..0910b9caf26f9 100644
--- a/src/linear_algebra/free_module/rank.lean
+++ b/src/linear_algebra/free_module/rank.lean
@@ -4,14 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
-import linear_algebra.free_module.basic
-import linear_algebra.finsupp_vector_space
+import linear_algebra.dimension
 
 /-!
 
-# Rank of free modules
+# Extra results about `module.rank`
 
-This is a basic API for the rank of free modules.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains some extra results not in `linear_algebra.dimension`.
 
 -/
 
@@ -23,36 +25,31 @@ open_locale tensor_product direct_sum big_operators cardinal
 
 open cardinal
 
-namespace module.free
-
 section ring
 
 variables [ring R] [strong_rank_condition R]
 variables [add_comm_group M] [module R M] [module.free R M]
 variables [add_comm_group N] [module R N] [module.free R N]
 
-/-- The rank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
-lemma rank_eq_card_choose_basis_index : module.rank R M = #(choose_basis_index R M) :=
-(choose_basis R M).mk_eq_dim''.symm
+open module.free
 
-/-- The rank of `(ι →₀ R)` is `(# ι).lift`. -/
-@[simp] lemma rank_finsupp {ι : Type v} : module.rank R (ι →₀ R) = (# ι).lift :=
-by simpa [lift_id', lift_umax] using
-  (basis.of_repr (linear_equiv.refl _ (ι →₀ R))).mk_eq_dim.symm
+@[simp] lemma rank_finsupp (ι : Type w) :
+  module.rank R (ι →₀ M) = cardinal.lift.{v} #ι * cardinal.lift.{w} (module.rank R M) :=
+begin
+  obtain ⟨⟨_, bs⟩⟩ := module.free.exists_basis R M,
+  rw [← bs.mk_eq_rank'', ← (finsupp.basis (λa:ι, bs)).mk_eq_rank'',
+    cardinal.mk_sigma, cardinal.sum_const]
+end
 
-/-- If `R` and `ι` lie in the same universe, the rank of `(ι →₀ R)` is `# ι`. -/
-lemma rank_finsupp' {ι : Type u} : module.rank R (ι →₀ R) = # ι := by simp
+lemma rank_finsupp' (ι : Type v) : module.rank R (ι →₀ M) = #ι * module.rank R M :=
+by simp [rank_finsupp]
 
-/-- The rank of `M × N` is `(module.rank R M).lift + (module.rank R N).lift`. -/
-@[simp] lemma rank_prod :
-  module.rank R (M × N) = lift.{w v} (module.rank R M) + lift.{v w} (module.rank R N) :=
-by simpa [rank_eq_card_choose_basis_index R M, rank_eq_card_choose_basis_index R N,
-  lift_umax, lift_umax'] using ((choose_basis R M).prod (choose_basis R N)).mk_eq_dim.symm
+/-- The rank of `(ι →₀ R)` is `(# ι).lift`. -/
+@[simp] lemma rank_finsupp_self (ι : Type w) : module.rank R (ι →₀ R) = (# ι).lift :=
+by simp [rank_finsupp]
 
-/-- If `M` and `N` lie in the same universe, the rank of `M × N` is
-  `(module.rank R M) + (module.rank R N)`. -/
-lemma rank_prod' (N : Type v) [add_comm_group N] [module R N] [module.free R N] :
-  module.rank R (M × N) = (module.rank R M) + (module.rank R N) := by simp
+/-- If `R` and `ι` lie in the same universe, the rank of `(ι →₀ R)` is `# ι`. -/
+lemma rank_finsupp_self' {ι : Type u} : module.rank R (ι →₀ R) = # ι := by simp
 
 /-- The rank of the direct sum is the sum of the ranks. -/
 @[simp] lemma rank_direct_sum  {ι : Type v} (M : ι → Type w) [Π (i : ι), add_comm_group (M i)]
@@ -61,33 +58,29 @@ lemma rank_prod' (N : Type v) [add_comm_group N] [module R N] [module.free R N]
 begin
   let B := λ i, choose_basis R (M i),
   let b : basis _ R (⨁ i, M i) := dfinsupp.basis (λ i, B i),
-  simp [← b.mk_eq_dim'', λ i, (B i).mk_eq_dim''],
+  simp [← b.mk_eq_rank'', λ i, (B i).mk_eq_rank''],
 end
 
-/-- The rank of a finite product is the sum of the ranks. -/
-@[simp] lemma rank_pi_fintype {ι : Type v} [fintype ι] {M : ι → Type w}
-  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)] :
-  module.rank R (Π i, M i) = cardinal.sum (λ i, module.rank R (M i)) :=
-by { rw [← (direct_sum.linear_equiv_fun_on_fintype _ _ M).dim_eq, rank_direct_sum] }
-
 /-- If `m` and `n` are `fintype`, the rank of `m × n` matrices is `(# m).lift * (# n).lift`. -/
-@[simp] lemma rank_matrix (m : Type v) (n : Type w) [fintype m] [fintype n] :
+@[simp] lemma rank_matrix (m : Type v) (n : Type w) [finite m] [finite n] :
   module.rank R (matrix m n R) = (lift.{(max v w u) v} (# m)) * (lift.{(max v w u) w} (# n)) :=
 begin
-  have h := (matrix.std_basis R m n).mk_eq_dim,
+  casesI nonempty_fintype m,
+  casesI nonempty_fintype n,
+  have h := (matrix.std_basis R m n).mk_eq_rank,
   rw [← lift_lift.{(max v w u) (max v w)}, lift_inj] at h,
   simpa using h.symm,
 end
 
 /-- If `m` and `n` are `fintype` that lie in the same universe, the rank of `m × n` matrices is
   `(# n * # m).lift`. -/
-@[simp] lemma rank_matrix' (m n : Type v) [fintype m] [fintype n] :
+@[simp] lemma rank_matrix' (m n : Type v) [finite m] [finite n] :
   module.rank R (matrix m n R) =  (# m * # n).lift :=
 by rw [rank_matrix, lift_mul, lift_umax]
 
 /-- If `m` and `n` are `fintype` that lie in the same universe as `R`, the rank of `m × n` matrices
   is `# m * # n`. -/
-@[simp] lemma rank_matrix'' (m n : Type u) [fintype m] [fintype n] :
+@[simp] lemma rank_matrix'' (m n : Type u) [finite m] [finite n] :
   module.rank R (matrix m n R) =  # m * # n := by simp
 
 end ring
@@ -98,17 +91,15 @@ variables [comm_ring R] [strong_rank_condition R]
 variables [add_comm_group M] [module R M] [module.free R M]
 variables [add_comm_group N] [module R N] [module.free R N]
 
+open module.free
+
 /-- The rank of `M ⊗[R] N` is `(module.rank R M).lift * (module.rank R N).lift`. -/
 @[simp] lemma rank_tensor_product : module.rank R (M ⊗[R] N) = lift.{w v} (module.rank R M) *
   lift.{v w} (module.rank R N) :=
 begin
-  let ιM := choose_basis_index R M,
-  let ιN := choose_basis_index R N,
-
-  have h₁ := linear_equiv.lift_dim_eq (tensor_product.congr (repr R M) (repr R N)),
-  let b : basis (ιM × ιN) R (_ →₀ R) := finsupp.basis_single_one,
-  rw [linear_equiv.dim_eq (finsupp_tensor_finsupp' R ιM ιN), ← b.mk_eq_dim, mk_prod] at h₁,
-  rw [lift_inj.1 h₁, rank_eq_card_choose_basis_index R M, rank_eq_card_choose_basis_index R N],
+  obtain ⟨⟨_, bM⟩⟩ := module.free.exists_basis R M,
+  obtain ⟨⟨_, bN⟩⟩ := module.free.exists_basis R N,
+  rw [← bM.mk_eq_rank'', ← bN.mk_eq_rank'', ← (bM.tensor_product bN).mk_eq_rank'', cardinal.mk_prod]
 end
 
 /-- If `M` and `N` lie in the same universe, the rank of `M ⊗[R] N` is
@@ -117,5 +108,3 @@ lemma rank_tensor_product' (N : Type v) [add_comm_group N] [module R N] [module.
   module.rank R (M ⊗[R] N) = (module.rank R M) * (module.rank R N) := by simp
 
 end comm_ring
-
-end module.free
diff --git a/src/linear_algebra/free_module/strong_rank_condition.lean b/src/linear_algebra/free_module/strong_rank_condition.lean
index be1fc84203653..26fa94a29741c 100644
--- a/src/linear_algebra/free_module/strong_rank_condition.lean
+++ b/src/linear_algebra/free_module/strong_rank_condition.lean
@@ -11,6 +11,9 @@ import linear_algebra.invariant_basis_number
 
 # Strong rank condition for commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We prove that any nontrivial commutative ring satisfies `strong_rank_condition`, meaning that
 if there is an injective linear map `(fin n → R) →ₗ[R] fin m → R`, then `n ≤ m`. This implies that
 any commutative ring satisfies `invariant_basis_number`: the rank of a finitely generated free
@@ -43,9 +46,10 @@ begin
   { rwa strong_rank_condition_iff_succ R },
   intros n f, by_contradiction hf,
 
-  -- Lean is unable to find this instance without help, either via this `letI`, or via a duplicate
-  -- instance with unecessarily strong typeclasses on `R` and `M`.
+  -- Lean is unable to find these instances without help, either via this `letI`, or via duplicate
+  -- instances with unecessarily strong typeclasses on `R` and `M`.
   letI : module.finite R (fin n.succ → R) := module.finite.pi,
+  letI : module.free R (fin n.succ → R) := module.free.pi _ _,
 
   let g : (fin (n + 1) → R) →ₗ[R] fin (n + 1) → R :=
     (extend_by_zero.linear_map R cast_succ).comp f,
diff --git a/src/linear_algebra/general_linear_group.lean b/src/linear_algebra/general_linear_group.lean
index c06fd53a381f8..f4629219b1ec4 100644
--- a/src/linear_algebra/general_linear_group.lean
+++ b/src/linear_algebra/general_linear_group.lean
@@ -1,241 +1,76 @@
 /-
-Copyright (c) 2021 Chris Birkbeck. All rights reserved.
+Copyright (c) 2019 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Chris Birkbeck
+Authors: Johan Commelin
 -/
-import linear_algebra.matrix.nonsingular_inverse
-import linear_algebra.special_linear_group
+import algebra.module.equiv
 
 /-!
-# The General Linear group $GL(n, R)$
+# The general linear group of linear maps
 
-This file defines the elements of the General Linear group `general_linear_group n R`,
-consisting of all invertible `n` by `n` `R`-matrices.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-## Main definitions
+The general linear group is defined to be the group of invertible linear maps from `M` to itself.
+
+See also `matrix.general_linear_group`
 
-* `matrix.general_linear_group` is the type of matrices over R which are units in the matrix ring.
-* `matrix.GL_pos` gives the subgroup of matrices with
-  positive determinant (over a linear ordered ring).
+## Main definitions
 
-## Tags
+* `linear_map.general_linear_group`
 
-matrix group, group, matrix inverse
 -/
 
-namespace matrix
-universes u v
-open_locale matrix
-open linear_map
+variables (R M : Type*)
 
--- disable this instance so we do not accidentally use it in lemmas.
-local attribute [-instance] special_linear_group.has_coe_to_fun
+namespace linear_map
 
-/-- `GL n R` is the group of `n` by `n` `R`-matrices with unit determinant.
-Defined as a subtype of matrices-/
-abbreviation general_linear_group (n : Type u) (R : Type v)
-  [decidable_eq n] [fintype n] [comm_ring R] : Type* := (matrix n n R)ˣ
+variables [semiring R] [add_comm_monoid M] [module R M]
+variables (R M)
 
-notation `GL` := general_linear_group
+/-- The group of invertible linear maps from `M` to itself -/
+@[reducible] def general_linear_group := (M →ₗ[R] M)ˣ
 
 namespace general_linear_group
-
-variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
-
-/-- The determinant of a unit matrix is itself a unit. -/
-@[simps]
-def det : GL n R →* Rˣ :=
-{ to_fun := λ A,
-  { val := (↑A : matrix n n R).det,
-    inv := (↑(A⁻¹) : matrix n n R).det,
-    val_inv := by rw [←det_mul, ←mul_eq_mul, A.mul_inv, det_one],
-    inv_val := by rw [←det_mul, ←mul_eq_mul, A.inv_mul, det_one]},
-  map_one' := units.ext det_one,
-  map_mul' := λ A B, units.ext $ det_mul _ _ }
-
-/--The `GL n R` and `general_linear_group R n` groups are multiplicatively equivalent-/
-def to_lin : (GL n R) ≃* (linear_map.general_linear_group R (n → R)) :=
-units.map_equiv to_lin_alg_equiv'.to_mul_equiv
-
-/--Given a matrix with invertible determinant we get an element of `GL n R`-/
-def mk' (A : matrix n n R) (h : invertible (matrix.det A)) : GL n R :=
-unit_of_det_invertible A
-
-/--Given a matrix with unit determinant we get an element of `GL n R`-/
-noncomputable def mk'' (A : matrix n n R) (h : is_unit (matrix.det A)) : GL n R :=
-nonsing_inv_unit A h
-
-/--Given a matrix with non-zero determinant over a field, we get an element of `GL n K`-/
-def mk_of_det_ne_zero {K : Type*} [field K] (A : matrix n n K) (h : matrix.det A ≠ 0) :
-  GL n K :=
-mk' A (invertible_of_nonzero h)
-
-lemma ext_iff (A B : GL n R) : A = B ↔ (∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :=
-units.ext_iff.trans matrix.ext_iff.symm
-
-/-- Not marked `@[ext]` as the `ext` tactic already solves this. -/
-lemma ext ⦃A B : GL n R⦄ (h : ∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :
-  A = B :=
-units.ext $ matrix.ext h
-
-section coe_lemmas
-
-variables (A B : GL n R)
-
-@[simp] lemma coe_mul : ↑(A * B) = (↑A : matrix n n R) ⬝ (↑B : matrix n n R) := rfl
-
-@[simp] lemma coe_one : ↑(1 : GL n R) = (1 : matrix n n R) := rfl
-
-lemma coe_inv : ↑(A⁻¹) = (↑A : matrix n n R)⁻¹ :=
-begin
-  letI := A.invertible,
-  exact inv_of_eq_nonsing_inv (↑A : matrix n n R),
-end
-
-/-- An element of the matrix general linear group on `(n) [fintype n]` can be considered as an
-element of the endomorphism general linear group on `n → R`. -/
-def to_linear : general_linear_group n R ≃* linear_map.general_linear_group R (n → R) :=
-units.map_equiv matrix.to_lin_alg_equiv'.to_ring_equiv.to_mul_equiv
-
--- Note that without the `@` and `‹_›`, lean infers `λ a b, _inst_1 a b` instead of `_inst_1` as the
--- decidability argument, which prevents `simp` from obtaining the instance by unification.
--- These `λ a b, _inst a b` terms also appear in the type of `A`, but simp doesn't get confused by
--- them so for now we do not care.
-@[simp] lemma coe_to_linear :
-  (@to_linear n ‹_› ‹_› _ _ A : (n → R) →ₗ[R] (n → R)) = matrix.mul_vec_lin A :=
-rfl
-
-@[simp] lemma to_linear_apply (v : n → R) :
-  (@to_linear n ‹_› ‹_› _ _ A) v = matrix.mul_vec_lin ↑A v :=
-rfl
-
-end coe_lemmas
-
-end general_linear_group
-
-namespace special_linear_group
-
-variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
-
-instance has_coe_to_general_linear_group : has_coe (special_linear_group n R) (GL n R) :=
-⟨λ A, ⟨↑A, ↑(A⁻¹), congr_arg coe (mul_right_inv A), congr_arg coe (mul_left_inv A)⟩⟩
-
-@[simp] lemma coe_to_GL_det (g : special_linear_group n R) : (g : GL n R).det = 1 :=
-units.ext g.prop
-
-end special_linear_group
-
-section
-
-variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
-
-section
-variables (n R)
-
-/-- This is the subgroup of `nxn` matrices with entries over a
-linear ordered ring and positive determinant. -/
-def GL_pos : subgroup (GL n R) :=
-(units.pos_subgroup R).comap general_linear_group.det
-end
-
-@[simp] lemma mem_GL_pos (A : GL n R) : A ∈ GL_pos n R ↔ 0 < (A.det : R) := iff.rfl
-end
-
-section has_neg
-
-variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
-[fact (even (fintype.card n))]
-
-/-- Formal operation of negation on general linear group on even cardinality `n` given by negating
-each element. -/
-instance : has_neg (GL_pos n R) :=
-⟨λ g, ⟨-g, begin
-    rw [mem_GL_pos, general_linear_group.coe_det_apply, units.coe_neg, det_neg,
-      (fact.out $ even $ fintype.card n).neg_one_pow, one_mul],
-    exact g.prop,
-  end⟩⟩
-
-instance : has_distrib_neg (GL_pos n R) :=
-{ neg := has_neg.neg,
-  neg_neg := λ x, subtype.ext $ neg_neg _,
-  neg_mul := λ x y, subtype.ext $ neg_mul _ _,
-  mul_neg := λ x y, subtype.ext $ mul_neg _ _ }
-
-@[simp] lemma GL_pos.coe_neg (g : GL_pos n R) : ↑(- g) = - (↑g : matrix n n R) :=
+variables {R M}
+
+instance : has_coe_to_fun (general_linear_group R M) (λ _, M → M) := by apply_instance
+
+/-- An invertible linear map `f` determines an equivalence from `M` to itself. -/
+def to_linear_equiv (f : general_linear_group R M) : (M ≃ₗ[R] M) :=
+{ inv_fun := f.inv.to_fun,
+  left_inv := λ m, show (f.inv * f.val) m = m,
+    by erw f.inv_val; simp,
+  right_inv := λ m, show (f.val * f.inv) m = m,
+    by erw f.val_inv; simp,
+  ..f.val }
+
+/-- An equivalence from `M` to itself determines an invertible linear map. -/
+def of_linear_equiv (f : (M ≃ₗ[R] M)) : general_linear_group R M :=
+{ val := f,
+  inv := (f.symm : M →ₗ[R] M),
+  val_inv := linear_map.ext $ λ _, f.apply_symm_apply _,
+  inv_val := linear_map.ext $ λ _, f.symm_apply_apply _ }
+
+variables (R M)
+
+/-- The general linear group on `R` and `M` is multiplicatively equivalent to the type of linear
+equivalences between `M` and itself. -/
+def general_linear_equiv : general_linear_group R M ≃* (M ≃ₗ[R] M) :=
+{ to_fun := to_linear_equiv,
+  inv_fun := of_linear_equiv,
+  left_inv := λ f, by { ext, refl },
+  right_inv := λ f, by { ext, refl },
+  map_mul' := λ x y, by {ext, refl} }
+
+@[simp] lemma general_linear_equiv_to_linear_map (f : general_linear_group R M) :
+  (general_linear_equiv R M f : M →ₗ[R] M) = f :=
+by {ext, refl}
+
+@[simp] lemma coe_fn_general_linear_equiv (f : general_linear_group R M) :
+  ⇑(general_linear_equiv R M f) = (f : M → M) :=
 rfl
 
-@[simp] lemma GL_pos.coe_neg_apply (g : GL_pos n R) (i j : n) :
-  (↑(-g) : matrix n n R) i j = -((↑g : matrix n n R) i j) :=
-rfl
-
-end has_neg
-
-namespace special_linear_group
-
-variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [linear_ordered_comm_ring R]
-
-/-- `special_linear_group n R` embeds into `GL_pos n R` -/
-def to_GL_pos : special_linear_group n R →* GL_pos n R :=
-{ to_fun := λ A, ⟨(A : GL n R), show 0 < (↑A : matrix n n R).det, from A.prop.symm ▸ zero_lt_one⟩,
-  map_one' := subtype.ext $ units.ext $ rfl,
-  map_mul' := λ A₁ A₂, subtype.ext $ units.ext $ rfl }
-
-instance : has_coe (special_linear_group n R) (GL_pos n R) := ⟨to_GL_pos⟩
-
-lemma coe_eq_to_GL_pos : (coe : special_linear_group n R → GL_pos n R) = to_GL_pos := rfl
-
-lemma to_GL_pos_injective :
-  function.injective (to_GL_pos : special_linear_group n R → GL_pos n R) :=
-(show function.injective ((coe : GL_pos n R → matrix n n R) ∘ to_GL_pos),
- from subtype.coe_injective).of_comp
-
-/-- Coercing a `special_linear_group` via `GL_pos` and `GL` is the same as coercing striaght to a
-matrix. -/
-@[simp]
-lemma coe_GL_pos_coe_GL_coe_matrix (g : special_linear_group n R) :
-    (↑(↑(↑g : GL_pos n R) : GL n R) : matrix n n R) = ↑g := rfl
-
-@[simp] lemma coe_to_GL_pos_to_GL_det (g : special_linear_group n R) :
-  ((g : GL_pos n R) : GL n R).det = 1 :=
-units.ext g.prop
-
-variable [fact (even (fintype.card n))]
-
-@[norm_cast] lemma coe_GL_pos_neg (g : special_linear_group n R) :
-  ↑(-g) = -(↑g : GL_pos n R) := subtype.ext $ units.ext rfl
-
-end special_linear_group
-
-section examples
-
-/-- The matrix [a, -b; b, a] (inspired by multiplication by a complex number); it is an element of
-$GL_2(R)$ if `a ^ 2 + b ^ 2` is nonzero. -/
-@[simps coe {fully_applied := ff}]
-def plane_conformal_matrix {R} [field R] (a b : R) (hab : a ^ 2 + b ^ 2 ≠ 0) :
-  matrix.general_linear_group (fin 2) R :=
-general_linear_group.mk_of_det_ne_zero ![![a, -b], ![b, a]]
-  (by simpa [det_fin_two, sq] using hab)
-
-/- TODO: Add Iwasawa matrices `n_x=![![1,x],![0,1]]`, `a_t=![![exp(t/2),0],![0,exp(-t/2)]]` and
-  `k_θ==![![cos θ, sin θ],![-sin θ, cos θ]]`
--/
-
-end examples
-
-namespace general_linear_group
-variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
-
--- this section should be last to ensure we do not use it in lemmas
-section coe_fn_instance
-
-/-- This instance is here for convenience, but is not the simp-normal form. -/
-instance : has_coe_to_fun (GL n R) (λ _, n → n → R) :=
-{ coe := λ A, A.val }
-
-@[simp] lemma coe_fn_eq_coe (A : GL n R) : ⇑A = (↑A : matrix n n R) := rfl
-
-end coe_fn_instance
-
 end general_linear_group
 
-end matrix
+end linear_map
diff --git a/src/linear_algebra/invariant_basis_number.lean b/src/linear_algebra/invariant_basis_number.lean
index 8662cb7fb0912..ef9b54e5dcfbe 100644
--- a/src/linear_algebra/invariant_basis_number.lean
+++ b/src/linear_algebra/invariant_basis_number.lean
@@ -9,6 +9,9 @@ import ring_theory.principal_ideal_domain
 /-!
 # Invariant basis number property
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that a ring `R` satisfies the invariant basis number property if there is a well-defined
 notion of the rank of a finitely generated free (left) `R`-module. Since a finitely generated free
 module with a basis consisting of `n` elements is linearly equivalent to `fin n → R`, it is
@@ -69,7 +72,7 @@ open function
 universes u v w
 
 section
-variables (R : Type u) [ring R]
+variables (R : Type u) [semiring R]
 
 /-- We say that `R` satisfies the strong rank condition if `(fin n → R) →ₗ[R] (fin m → R)` injective
     implies `n ≤ m`. -/
@@ -106,8 +109,8 @@ end
 lemma card_le_of_injective' [strong_rank_condition R] {α β : Type*} [fintype α] [fintype β]
   (f : (α →₀ R) →ₗ[R] (β →₀ R)) (i : injective f) : fintype.card α ≤ fintype.card β :=
 begin
-  let P := (finsupp.linear_equiv_fun_on_fintype R R β),
-  let Q := (finsupp.linear_equiv_fun_on_fintype R R α).symm,
+  let P := (finsupp.linear_equiv_fun_on_finite R R β),
+  let Q := (finsupp.linear_equiv_fun_on_finite R R α).symm,
   exact card_le_of_injective R ((P.to_linear_map.comp f).comp Q.to_linear_map)
     ((P.injective.comp i).comp Q.injective)
 end
@@ -133,8 +136,8 @@ end
 lemma card_le_of_surjective' [rank_condition R] {α β : Type*} [fintype α] [fintype β]
   (f : (α →₀ R) →ₗ[R] (β →₀ R)) (i : surjective f) : fintype.card β ≤ fintype.card α :=
 begin
-  let P := (finsupp.linear_equiv_fun_on_fintype R R β),
-  let Q := (finsupp.linear_equiv_fun_on_fintype R R α).symm,
+  let P := (finsupp.linear_equiv_fun_on_finite R R β),
+  let Q := (finsupp.linear_equiv_fun_on_finite R R α).symm,
   exact card_le_of_surjective R ((P.to_linear_map.comp f).comp Q.to_linear_map)
     ((P.surjective.comp i).comp Q.surjective)
 end
@@ -164,7 +167,7 @@ instance invariant_basis_number_of_rank_condition [rank_condition R] : invariant
 end
 
 section
-variables (R : Type u) [ring R] [invariant_basis_number R]
+variables (R : Type u) [semiring R] [invariant_basis_number R]
 
 lemma eq_of_fin_equiv {n m : ℕ} : ((fin n → R) ≃ₗ[R] (fin m → R)) → n = m :=
 invariant_basis_number.eq_of_fin_equiv
@@ -252,8 +255,10 @@ private def induced_equiv [fintype ι'] (I : ideal R) (e : (ι → R) ≃ₗ[R]
 begin
   refine { to_fun := induced_map I e, inv_fun := induced_map I e.symm, .. },
   all_goals { rintro ⟨a⟩ ⟨b⟩ <|> rintro ⟨a⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
-    congr, simp }
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    congr,
+    simp only [map_add, linear_equiv.coe_coe, linear_equiv.map_smulₛₗ, ring_hom.id_apply,
+               linear_equiv.symm_apply_apply, linear_equiv.apply_symm_apply] }
 end
 
 end
@@ -261,15 +266,11 @@ end
 section
 local attribute [instance] ideal.quotient.field
 
--- TODO: in fact, any nontrivial commutative ring satisfies the strong rank condition.
--- To see this, consider `f : (fin m → R) →ₗ[R] (fin n → R)`,
--- and consider the subring `A` of `R` generated by the matrix entries.
--- That subring is noetherian, and `f` induces a new linear map `f' : (fin m → A) →ₗ[R] (fin n → A)`
--- which is injective if `f` is.
--- Since we've already established the strong rank condition for noetherian rings,
--- this gives the result.
+/-- Nontrivial commutative rings have the invariant basis number property.
 
-/-- Nontrivial commutative rings have the invariant basis number property. -/
+In fact, any nontrivial commutative ring satisfies the strong rank condition, see
+`comm_ring_strong_rank_condition`. We prove this instance separately to avoid dependency on
+`linear_algebra.charpoly.basic`. -/
 @[priority 100]
 instance invariant_basis_number_of_nontrivial_of_comm_ring {R : Type u} [comm_ring R]
   [nontrivial R] : invariant_basis_number R :=
diff --git a/src/linear_algebra/isomorphisms.lean b/src/linear_algebra/isomorphisms.lean
index 1efb9e39a16a5..94799845bdfa5 100644
--- a/src/linear_algebra/isomorphisms.lean
+++ b/src/linear_algebra/isomorphisms.lean
@@ -8,6 +8,9 @@ import linear_algebra.quotient
 /-!
 # Isomorphism theorems for modules.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 * The Noether's first, second, and third isomorphism theorems for modules are proved as
   `linear_map.quot_ker_equiv_range`, `linear_map.quotient_inf_equiv_sup_quotient` and
   `submodule.quotient_quotient_equiv_quotient`.
@@ -54,7 +57,7 @@ Canonical linear map from the quotient `p/(p ∩ p')` to `(p+p')/p'`, mapping `x
 to `x + p'`, where `p` and `p'` are submodules of an ambient module.
 -/
 def quotient_inf_to_sup_quotient (p p' : submodule R M) :
-  p ⧸ (comap p.subtype (p ⊓ p')) →ₗ[R] _ ⧸ (comap (p ⊔ p').subtype p') :=
+  p ⧸ (comap p.subtype (p ⊓ p')) →ₗ[R] _ ⧸ (comap (p ⊔ p').subtype p') := by exact
 (comap p.subtype (p ⊓ p')).liftq
   ((comap (p ⊔ p').subtype p').mkq.comp (of_le le_sup_left)) begin
 rw [ker_comp, of_le, comap_cod_restrict, ker_mkq, map_comap_subtype],
@@ -64,20 +67,20 @@ exact comap_mono (inf_le_inf_right _ le_sup_left) end
 Second Isomorphism Law : the canonical map from `p/(p ∩ p')` to `(p+p')/p'` as a linear isomorphism.
 -/
 noncomputable def quotient_inf_equiv_sup_quotient (p p' : submodule R M) :
-  (p ⧸ (comap p.subtype (p ⊓ p'))) ≃ₗ[R] _ ⧸ (comap (p ⊔ p').subtype p') :=
+  (p ⧸ (comap p.subtype (p ⊓ p'))) ≃ₗ[R] _ ⧸ (comap (p ⊔ p').subtype p') := by exact
 linear_equiv.of_bijective (quotient_inf_to_sup_quotient p p')
-  begin
+  ⟨begin
     rw [← ker_eq_bot, quotient_inf_to_sup_quotient, ker_liftq_eq_bot],
     rw [ker_comp, ker_mkq],
     exact λ ⟨x, hx1⟩ hx2, ⟨hx1, hx2⟩
-  end
+  end,
   begin
     rw [← range_eq_top, quotient_inf_to_sup_quotient, range_liftq, eq_top_iff'],
     rintros ⟨x, hx⟩, rcases mem_sup.1 hx with ⟨y, hy, z, hz, rfl⟩,
     use [⟨y, hy⟩], apply (submodule.quotient.eq _).2,
     change y - (y + z) ∈ p',
     rwa [sub_add_eq_sub_sub, sub_self, zero_sub, neg_mem_iff]
-  end
+  end⟩
 
 @[simp] lemma coe_quotient_inf_to_sup_quotient (p p' : submodule R M) :
   ⇑(quotient_inf_to_sup_quotient p p') = quotient_inf_equiv_sup_quotient p p' := rfl
@@ -113,8 +116,8 @@ namespace submodule
 variables (S T : submodule R M) (h : S ≤ T)
 
 /-- The map from the third isomorphism theorem for modules: `(M / S) / (T / S) → M / T`. -/
-def quotient_quotient_equiv_quotient_aux :
-  (M ⧸ S) ⧸ (T.map S.mkq) →ₗ[R] M ⧸ T :=
+def quotient_quotient_equiv_quotient_aux (h : S ≤ T) :
+  (M ⧸ S) ⧸ (T.map S.mkq) →ₗ[R] M ⧸ T := by exact
 liftq _ (mapq S T linear_map.id h)
   (by { rintro _ ⟨x, hx, rfl⟩, rw [linear_map.mem_ker, mkq_apply, mapq_apply],
         exact (quotient.mk_eq_zero _).mpr hx })
@@ -136,4 +139,11 @@ def quotient_quotient_equiv_quotient :
   right_inv := λ x, quotient.induction_on' x $ λ x, by simp,
   .. quotient_quotient_equiv_quotient_aux S T h }
 
+/-- Corollary of the third isomorphism theorem: `[S : T] [M : S] = [M : T]` -/
+lemma card_quotient_mul_card_quotient (S T : submodule R M) (hST : T ≤ S)
+  [decidable_pred (λ x, x ∈ S.map T.mkq)] [fintype (M ⧸ S)] [fintype (M ⧸ T)] :
+  fintype.card (S.map T.mkq) * fintype.card (M ⧸ S) = fintype.card (M ⧸ T) :=
+by rw [submodule.card_eq_card_quotient_mul_card (map T.mkq S),
+       fintype.card_eq.mpr ⟨(quotient_quotient_equiv_quotient T S hST).to_equiv⟩]
+
 end submodule
diff --git a/src/linear_algebra/lagrange.lean b/src/linear_algebra/lagrange.lean
index fae4f3c345c35..1a0948723dd8f 100644
--- a/src/linear_algebra/lagrange.lean
+++ b/src/linear_algebra/lagrange.lean
@@ -1,224 +1,568 @@
 /-
 Copyright (c) 2020 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kenny Lau
+Authors: Kenny Lau, Wrenna Robson
 -/
 
 import algebra.big_operators.basic
+import linear_algebra.vandermonde
 import ring_theory.polynomial.basic
 
 /-!
 # Lagrange interpolation
 
-## Main definitions
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-* `lagrange.basis s x` where `s : finset F` and `x : F`: the Lagrange basis polynomial
-  that evaluates to `1` at `x` and `0` at other elements of `s`.
-* `lagrange.interpolate s f` where `s : finset F` and `f : F → F`: the Lagrange interpolant
-  that evaluates to `f x` at `x` for `x ∈ s`.
+## Main definitions
+* In everything that follows, `s : finset ι` is a finite set of indexes, with `v : ι → F` an
+indexing of the field over some type. We call the image of v on s the interpolation nodes,
+though strictly unique nodes are only defined when v is injective on s.
+* `lagrange.basis_divisor x y`, with `x y : F`. These are the normalised irreducible factors of
+the Lagrange basis polynomials. They evaluate to `1` at `x` and `0` at `y` when `x` and `y`
+are distinct.
+* `lagrange.basis v i` with `i : ι`: the Lagrange basis polynomial that evaluates to `1` at `v i`
+and `0` at `v j` for `i ≠ j`.
+* `lagrange.interpolate v r` where `r : ι → F` is a function from the fintype to the field: the
+Lagrange interpolant that evaluates to `r i` at `x i` for all `i : ι`. The `r i` are the _values_
+associated with the _nodes_`x i`.
+* `lagrange.interpolate_at v f`, where `v : ι ↪ F` and `ι` is a fintype, and `f : F → F` is a
+function from the field to itself: this is the Lagrange interpolant that evaluates to `f (x i)`
+at `x i`, and so approximates the function `f`. This is just a special case of the general
+interpolation, where the values are given by a known function `f`.
 -/
 
-noncomputable theory
-open_locale big_operators classical polynomial
+open_locale polynomial big_operators
 
-universe u
+section polynomial_determination
 
-namespace lagrange
+namespace polynomial
+variables {R : Type*} [comm_ring R] [is_domain R] {f g : R[X]}
 
-variables {F : Type u} [decidable_eq F] [field F] (s : finset F)
-variables {F' : Type u} [field F'] (s' : finset F')
+section finset
+open function fintype
+variables (s : finset R)
 
-open polynomial
+theorem eq_zero_of_degree_lt_of_eval_finset_eq_zero (degree_f_lt : f.degree < s.card)
+  (eval_f : ∀ x ∈ s, f.eval x = 0) : f = 0 :=
+begin
+  rw ← mem_degree_lt at degree_f_lt,
+  simp_rw eval_eq_sum_degree_lt_equiv degree_f_lt at eval_f,
+  rw ← degree_lt_equiv_eq_zero_iff_eq_zero degree_f_lt,
+  exact matrix.eq_zero_of_forall_index_sum_mul_pow_eq_zero
+    (injective.comp (embedding.subtype _).inj' (equiv_fin_of_card_eq (card_coe _)).symm.injective)
+    (λ _, eval_f _ (finset.coe_mem _))
+end
+
+theorem eq_of_degree_sub_lt_of_eval_finset_eq (degree_fg_lt : (f - g).degree < s.card)
+  (eval_fg : ∀ x ∈ s, f.eval x = g.eval x) : f = g :=
+begin
+  rw ← sub_eq_zero,
+  refine eq_zero_of_degree_lt_of_eval_finset_eq_zero _ degree_fg_lt _,
+  simp_rw [eval_sub, sub_eq_zero],
+  exact eval_fg
+end
+
+theorem eq_of_degrees_lt_of_eval_finset_eq (degree_f_lt : f.degree < s.card)
+  (degree_g_lt : g.degree < s.card) (eval_fg : ∀ x ∈ s, f.eval x = g.eval x) : f = g :=
+begin
+  rw ← mem_degree_lt at degree_f_lt degree_g_lt,
+  refine eq_of_degree_sub_lt_of_eval_finset_eq _ _ eval_fg,
+  rw ← mem_degree_lt, exact submodule.sub_mem _ degree_f_lt degree_g_lt
+end
+
+end finset
+
+section indexed
+open finset
+variables {ι : Type*} {v : ι → R} (s : finset ι)
+
+theorem eq_zero_of_degree_lt_of_eval_index_eq_zero (hvs : set.inj_on v s)
+  (degree_f_lt : f.degree < s.card) (eval_f : ∀ i ∈ s, f.eval (v i) = 0) : f = 0 :=
+begin
+  classical,
+  rw ← card_image_of_inj_on hvs at degree_f_lt,
+  refine eq_zero_of_degree_lt_of_eval_finset_eq_zero _ degree_f_lt _,
+  intros x hx,
+  rcases mem_image.mp hx with ⟨_, hj, rfl⟩,
+  exact eval_f _ hj
+end
+
+theorem eq_of_degree_sub_lt_of_eval_index_eq (hvs : set.inj_on v s)
+  (degree_fg_lt : (f - g).degree < s.card) (eval_fg : ∀ i ∈ s, f.eval (v i) = g.eval (v i)) :
+  f = g :=
+begin
+  rw ← sub_eq_zero,
+  refine eq_zero_of_degree_lt_of_eval_index_eq_zero _ hvs degree_fg_lt _,
+  simp_rw [eval_sub, sub_eq_zero],
+  exact eval_fg
+end
+
+theorem eq_of_degrees_lt_of_eval_index_eq (hvs : set.inj_on v s) (degree_f_lt : f.degree < s.card)
+  (degree_g_lt : g.degree < s.card) (eval_fg : ∀ i ∈ s, f.eval (v i) = g.eval (v i)) : f = g :=
+begin
+  refine eq_of_degree_sub_lt_of_eval_index_eq _ hvs _ eval_fg,
+  rw ← mem_degree_lt at degree_f_lt degree_g_lt ⊢,
+  exact submodule.sub_mem _ degree_f_lt degree_g_lt
+end
+
+end indexed
+
+end polynomial
+
+end polynomial_determination
+
+noncomputable theory
 
-/-- Lagrange basis polynomials that evaluate to 1 at `x` and 0 at other elements of `s`. -/
-def basis (x : F) : F[X] :=
-∏ y in s.erase x, C (x - y)⁻¹ * (X - C y)
+namespace lagrange
+open polynomial
+variables {F : Type*} [field F]
 
-@[simp] theorem basis_empty (x : F) : basis ∅ x = 1 :=
-rfl
+section basis_divisor
+variables {x y : F}
+/-- `basis_divisor x y` is the unique linear or constant polynomial such that
+when evaluated at `x` it gives `1` and `y` it gives `0` (where when `x = y` it is identically `0`).
+Such polynomials are the building blocks for the Lagrange interpolants. -/
+def basis_divisor (x y : F) : F[X] := C ((x - y)⁻¹) * (X - C (y))
 
-@[simp] theorem basis_singleton_self (x : F) : basis {x} x = 1 :=
-by rw [basis, finset.erase_singleton, finset.prod_empty]
+lemma basis_divisor_self : basis_divisor x x = 0 :=
+by simp only [basis_divisor, sub_self, inv_zero, map_zero, zero_mul]
 
-@[simp] theorem eval_basis_self (x : F) : (basis s x).eval x = 1 :=
+lemma basis_divisor_inj (hxy : basis_divisor x y = 0) : x = y :=
 begin
-  rw [basis, ← coe_eval_ring_hom, (eval_ring_hom x).map_prod, coe_eval_ring_hom,
-    finset.prod_eq_one],
-  intros y hy, simp_rw [eval_mul, eval_sub, eval_C, eval_X],
-  exact inv_mul_cancel (sub_ne_zero_of_ne (finset.ne_of_mem_erase hy).symm)
+  simp_rw [basis_divisor, mul_eq_zero, X_sub_C_ne_zero, or_false,
+            C_eq_zero, inv_eq_zero, sub_eq_zero] at hxy,
+  exact hxy
 end
 
-@[simp] theorem eval_basis_ne (x y : F) (h1 : y ∈ s) (h2 : y ≠ x) : (basis s x).eval y = 0 :=
+@[simp] lemma basis_divisor_eq_zero_iff : basis_divisor x y = 0 ↔ x = y :=
+⟨basis_divisor_inj, λ H, H ▸ basis_divisor_self⟩
+
+lemma basis_divisor_ne_zero_iff : basis_divisor x y ≠ 0 ↔ x ≠ y :=
+by rw [ne.def, basis_divisor_eq_zero_iff]
+
+lemma degree_basis_divisor_of_ne (hxy : x ≠ y) : (basis_divisor x y).degree = 1 :=
 begin
-  rw [basis,
-  ← coe_eval_ring_hom, (eval_ring_hom y).map_prod, coe_eval_ring_hom,
-    finset.prod_eq_zero (finset.mem_erase.2 ⟨h2, h1⟩)],
-  simp_rw [eval_mul, eval_sub, eval_C, eval_X, sub_self, mul_zero]
+  rw [basis_divisor, degree_mul, degree_X_sub_C, degree_C, zero_add],
+  exact inv_ne_zero (sub_ne_zero_of_ne hxy)
 end
 
-theorem eval_basis (x y : F) (h : y ∈ s) : (basis s x).eval y = if y = x then 1 else 0 :=
-by { split_ifs with H, { subst H, apply eval_basis_self }, { exact eval_basis_ne s x y h H } }
+@[simp] lemma degree_basis_divisor_self : (basis_divisor x x).degree = ⊥ :=
+by rw [basis_divisor_self, degree_zero]
+
+lemma nat_degree_basis_divisor_self : (basis_divisor x x).nat_degree = 0 :=
+by rw [basis_divisor_self, nat_degree_zero]
+
+lemma nat_degree_basis_divisor_of_ne (hxy : x ≠ y) : (basis_divisor x y).nat_degree = 1 :=
+nat_degree_eq_of_degree_eq_some (degree_basis_divisor_of_ne hxy)
 
-@[simp] theorem nat_degree_basis (x : F) (hx : x ∈ s) : (basis s x).nat_degree = s.card - 1 :=
+@[simp] lemma eval_basis_divisor_right : eval y (basis_divisor x y) = 0 :=
+by simp only [basis_divisor, eval_mul, eval_C, eval_sub, eval_X, sub_self, mul_zero]
+
+lemma eval_basis_divisor_left_of_ne (hxy : x ≠ y) : eval x (basis_divisor x y) = 1 :=
 begin
-  unfold basis, generalize hsx : s.erase x = sx,
-  have : x ∉ sx := hsx ▸ finset.not_mem_erase x s,
-  rw [← finset.insert_erase hx, hsx, finset.card_insert_of_not_mem this, add_tsub_cancel_right],
-  clear hx hsx s, revert this, apply sx.induction_on,
-  { intros hx, rw [finset.prod_empty, nat_degree_one], refl },
-  { intros y s hys ih hx, rw [finset.mem_insert, not_or_distrib] at hx,
-    have h1 : C (x - y)⁻¹ ≠ C 0 := λ h, hx.1 (eq_of_sub_eq_zero $ inv_eq_zero.1 $ C_inj.1 h),
-    have h2 : X ^ 1 - C y ≠ 0 := by convert X_pow_sub_C_ne_zero zero_lt_one y,
-    rw C_0 at h1, rw pow_one at h2,
-    rw [finset.prod_insert hys, nat_degree_mul (mul_ne_zero h1 h2), ih hx.2,
-        finset.card_insert_of_not_mem hys, nat_degree_mul h1 h2,
-        nat_degree_C, zero_add, nat_degree, degree_X_sub_C, add_comm], refl,
-    rw [ne, finset.prod_eq_zero_iff], rintro ⟨z, hzs, hz⟩,
-    rw mul_eq_zero at hz, cases hz with hz hz,
-    { rw [← C_0, C_inj, inv_eq_zero, sub_eq_zero] at hz, exact hx.2 (hz.symm ▸ hzs) },
-    { rw ← pow_one (X : F[X]) at hz, exact X_pow_sub_C_ne_zero zero_lt_one _ hz } }
+  simp only [basis_divisor, eval_mul, eval_C, eval_sub, eval_X],
+  exact inv_mul_cancel (sub_ne_zero_of_ne hxy)
 end
 
-variables (f : F → F)
+end basis_divisor
+
+section basis
+open finset
+variables {ι : Type*} [decidable_eq ι] {s : finset ι} {v : ι → F} {i j : ι}
+
+/-- Lagrange basis polynomials indexed by `s : finset ι`, defined at nodes `v i` for a
+map `v : ι → F`. For `i, j ∈ s`, `basis s v i` evaluates to 0 at `v j` for `i ≠ j`. When
+`v` is injective on `s`, `basis s v i` evaluates to 1 at `v i`. -/
+protected def basis (s : finset ι) (v : ι → F) (i : ι) : F[X] :=
+∏ j in s.erase i, basis_divisor (v i) (v j)
+
+@[simp] theorem basis_empty : lagrange.basis ∅ v i = 1 := rfl
+
+@[simp] theorem basis_singleton (i : ι) : lagrange.basis {i} v i = 1 :=
+by rw [lagrange.basis, erase_singleton, prod_empty]
+
+@[simp] theorem basis_pair_left (hij : i ≠ j) :
+  lagrange.basis {i, j} v i = basis_divisor (v i) (v j) :=
+by simp only [lagrange.basis, hij, erase_insert_eq_erase, erase_eq_of_not_mem,
+              mem_singleton, not_false_iff, prod_singleton]
+
+@[simp] theorem basis_pair_right (hij : i ≠ j) :
+  lagrange.basis {i, j} v j = basis_divisor (v j) (v i) :=
+by { rw pair_comm, exact basis_pair_left hij.symm }
 
-/-- Lagrange interpolation: given a finset `s` and a function `f : F → F`,
-`interpolate s f` is the unique polynomial of degree `< s.card`
-that takes value `f x` on all `x` in `s`. -/
-def interpolate : F[X] :=
-∑ x in s, C (f x) * basis s x
+lemma basis_ne_zero (hvs : set.inj_on v s) (hi : i ∈ s) : lagrange.basis s v i ≠ 0 :=
+begin
+  simp_rw [lagrange.basis, prod_ne_zero_iff, ne.def, mem_erase],
+  rintros j ⟨hij, hj⟩,
+  rw [basis_divisor_eq_zero_iff, hvs.eq_iff hi hj],
+  exact hij.symm
+end
 
-@[simp] theorem interpolate_empty (f) : interpolate (∅ : finset F) f = 0 :=
-rfl
+@[simp] theorem eval_basis_self (hvs : set.inj_on v s) (hi : i ∈ s) :
+  (lagrange.basis s v i).eval (v i) = 1 :=
+begin
+  rw [lagrange.basis, eval_prod],
+  refine prod_eq_one (λ j H, _),
+  rw eval_basis_divisor_left_of_ne,
+  rcases mem_erase.mp H with ⟨hij, hj⟩,
+  exact mt (hvs hi hj) hij.symm
+end
 
-@[simp] theorem interpolate_singleton (f) (x : F) : interpolate {x} f = C (f x) :=
-by rw [interpolate, finset.sum_singleton, basis_singleton_self, mul_one]
+@[simp] theorem eval_basis_of_ne (hij : i ≠ j) (hj : j ∈ s) :
+  (lagrange.basis s v i).eval (v j) = 0 :=
+begin
+  simp_rw [lagrange.basis, eval_prod, prod_eq_zero_iff],
+  exact ⟨j, ⟨mem_erase.mpr ⟨hij.symm, hj⟩, eval_basis_divisor_right⟩⟩
+end
 
-@[simp] theorem eval_interpolate (x) (H : x ∈ s) : eval x (interpolate s f) = f x :=
+@[simp] theorem nat_degree_basis (hvs : set.inj_on v s) (hi : i ∈ s) :
+  (lagrange.basis s v i).nat_degree = s.card - 1 :=
 begin
-  rw [interpolate, ←coe_eval_ring_hom, ring_hom.map_sum, coe_eval_ring_hom, finset.sum_eq_single x],
-  { simp },
-  { intros y hy hxy, simp [eval_basis_ne s y x H hxy.symm] },
-  { intro h, exact (h H).elim }
+  have H : ∀ j, j ∈ s.erase i → basis_divisor (v i) (v j) ≠ 0,
+  { simp_rw [ne.def, mem_erase, basis_divisor_eq_zero_iff],
+    exact λ j ⟨hij₁, hj⟩ hij₂, hij₁ (hvs hj hi hij₂.symm) },
+  rw [← card_erase_of_mem hi, card_eq_sum_ones],
+  convert nat_degree_prod _ _ H using 1,
+  refine sum_congr rfl (λ j hj, (nat_degree_basis_divisor_of_ne _).symm),
+  rw [ne.def, ← basis_divisor_eq_zero_iff],
+  exact H _ hj
 end
 
-theorem degree_interpolate_lt : (interpolate s f).degree < s.card :=
-if H : s = ∅ then by { subst H, rw [interpolate_empty, degree_zero], exact with_bot.bot_lt_coe _ }
-else (degree_sum_le _ _).trans_lt $ (finset.sup_lt_iff $ with_bot.bot_lt_coe s.card).2 $ λ b _,
-calc  (C (f b) * basis s b).degree
-    ≤ (C (f b)).degree + (basis s b).degree : degree_mul_le _ _
-... ≤ 0 + (basis s b).degree : add_le_add_right degree_C_le _
-... = (basis s b).degree : zero_add _
-... ≤ (basis s b).nat_degree : degree_le_nat_degree
-... = (s.card - 1 : ℕ) : by { rwa nat_degree_basis }
-... < s.card : with_bot.coe_lt_coe.2 (nat.pred_lt $ mt finset.card_eq_zero.1 H)
+theorem degree_basis (hvs : set.inj_on v s) (hi : i ∈ s) :
+  (lagrange.basis s v i).degree = ↑(s.card - 1) :=
+by rw [degree_eq_nat_degree (basis_ne_zero hvs hi), nat_degree_basis hvs hi]
 
-theorem degree_interpolate_erase {x} (hx : x ∈ s) :
-  (interpolate (s.erase x) f).degree < (s.card - 1 : ℕ) :=
+lemma sum_basis (hvs : set.inj_on v s) (hs : s.nonempty) : ∑ j in s, (lagrange.basis s v j) = 1 :=
 begin
-  convert degree_interpolate_lt (s.erase x) f,
-  rw finset.card_erase_of_mem hx,
+  refine eq_of_degrees_lt_of_eval_index_eq s hvs (lt_of_le_of_lt (degree_sum_le _ _) _) _ _,
+  { rw finset.sup_lt_iff (with_bot.bot_lt_coe s.card),
+    intros i hi,
+    rw [degree_basis hvs hi, with_bot.coe_lt_coe],
+    exact nat.pred_lt (card_ne_zero_of_mem hi) },
+  { rw [degree_one, ← with_bot.coe_zero, with_bot.coe_lt_coe],
+    exact nonempty.card_pos hs },
+  { intros i hi,
+    rw [eval_finset_sum, eval_one, ← add_sum_erase _ _ hi,
+        eval_basis_self hvs hi, add_right_eq_self],
+    refine sum_eq_zero (λ j hj, _),
+    rcases mem_erase.mp hj with ⟨hij, hj⟩,
+    rw eval_basis_of_ne hij hi }
 end
 
-theorem interpolate_eq_of_eval_eq (f g : F → F) {s : finset F} (hs : ∀ x ∈ s, f x = g x) :
-  interpolate s f = interpolate s g :=
+lemma basis_divisor_add_symm {x y : F} (hxy : x ≠ y) : basis_divisor x y + basis_divisor y x = 1 :=
 begin
-  rw [interpolate, interpolate],
-  refine finset.sum_congr rfl (λ x hx, _),
-  rw hs x hx,
+  classical,
+  rw [←sum_basis (set.inj_on_of_injective function.injective_id _) ⟨x, mem_insert_self _ {y}⟩,
+      sum_insert (not_mem_singleton.mpr hxy), sum_singleton, basis_pair_left hxy,
+      basis_pair_right hxy, id, id]
 end
 
-/-- Linear version of `interpolate`. -/
-def linterpolate : (F → F) →ₗ[F] polynomial F :=
-{ to_fun := interpolate s,
-  map_add' := λ f g, by { simp_rw [interpolate, ← finset.sum_add_distrib, ← add_mul, ← C_add],
-    refl },
-  map_smul' := λ c f, by { simp_rw [interpolate, finset.smul_sum, C_mul', smul_smul], refl } }
+end basis
+
+section interpolate
+open finset
+variables {ι : Type*} [decidable_eq ι] {s t : finset ι} {i j : ι} {v : ι → F} (r r' : ι → F)
 
-@[simp] lemma interpolate_add (f g) : interpolate s (f + g) = interpolate s f + interpolate s g :=
-(linterpolate s).map_add f g
+/-- Lagrange interpolation: given a finset `s : finset ι`, a nodal map  `v : ι → F` injective on
+`s` and a value function `r : ι → F`,  `interpolate s v r` is the unique
+polynomial of degree `< s.card` that takes value `r i` on `v i` for all `i` in `s`. -/
+@[simps]
+def interpolate (s : finset ι) (v : ι → F) : (ι → F) →ₗ[F] F[X] :=
+{ to_fun := λ r, ∑ i in s, C (r i) * (lagrange.basis s v i),
+  map_add' := λ f g, by simp_rw [← finset.sum_add_distrib, ← add_mul,
+                                 ← C_add, pi.add_apply],
+  map_smul' := λ c f, by simp_rw [finset.smul_sum, C_mul', smul_smul,
+                                  pi.smul_apply, ring_hom.id_apply, smul_eq_mul] }
 
-@[simp] lemma interpolate_zero : interpolate s 0 = 0 :=
-(linterpolate s).map_zero
+@[simp] theorem interpolate_empty : interpolate ∅ v r = 0 :=
+by rw [interpolate_apply, sum_empty]
 
-@[simp] lemma interpolate_neg (f) : interpolate s (-f) = -interpolate s f :=
-(linterpolate s).map_neg f
+@[simp] theorem interpolate_singleton : interpolate {i} v r = C (r i) :=
+by rw [interpolate_apply, sum_singleton, basis_singleton, mul_one]
+
+theorem interpolate_one (hvs : set.inj_on v s) (hs : s.nonempty) : interpolate s v 1 = 1 :=
+by { simp_rw [interpolate_apply, pi.one_apply, map_one, one_mul], exact sum_basis hvs hs }
+
+theorem eval_interpolate_at_node (hvs : set.inj_on v s) (hi : i ∈ s) :
+  eval (v i) (interpolate s v r) = r i :=
+begin
+  rw [interpolate_apply, eval_finset_sum, ← add_sum_erase _ _ hi],
+  simp_rw [eval_mul, eval_C, eval_basis_self hvs hi, mul_one, add_right_eq_self],
+  refine sum_eq_zero (λ j H, _),
+  rw [eval_basis_of_ne (mem_erase.mp H).1 hi, mul_zero]
+end
+
+theorem degree_interpolate_le (hvs : set.inj_on v s) : (interpolate s v r).degree ≤ ↑(s.card - 1) :=
+begin
+  refine (degree_sum_le _ _).trans _,
+  rw finset.sup_le_iff,
+  intros i hi,
+  rw [degree_mul, degree_basis hvs hi],
+  by_cases hr : r i = 0,
+  { simpa only [hr, map_zero, degree_zero, with_bot.bot_add] using bot_le },
+  { rw [degree_C hr, zero_add, with_bot.coe_le_coe] }
+end
 
-@[simp] lemma interpolate_sub (f g) : interpolate s (f - g) = interpolate s f - interpolate s g :=
-(linterpolate s).map_sub f g
+theorem degree_interpolate_lt (hvs : set.inj_on v s) : (interpolate s v r).degree < s.card :=
+begin
+  rcases eq_empty_or_nonempty s with rfl | h,
+  { rw [interpolate_empty, degree_zero, card_empty],
+    exact with_bot.bot_lt_coe _ },
+  { refine lt_of_le_of_lt (degree_interpolate_le _ hvs) _,
+    rw with_bot.coe_lt_coe,
+    exact nat.sub_lt (nonempty.card_pos h) zero_lt_one }
+end
 
-@[simp] lemma interpolate_smul (c : F) (f) : interpolate s (c • f) = c • interpolate s f :=
-(linterpolate s).map_smul c f
-
-theorem eq_zero_of_eval_eq_zero {f : F'[X]} (hf1 : f.degree < s'.card)
-  (hf2 : ∀ x ∈ s', f.eval x = 0) : f = 0 :=
-by_contradiction $ λ hf3, not_le_of_lt hf1 $
-calc  (s'.card : with_bot ℕ)
-    ≤ f.roots.to_finset.card : with_bot.coe_le_coe.2 $ finset.card_le_of_subset $ λ x hx,
-        (multiset.mem_to_finset).mpr $ (mem_roots hf3).2 $ hf2 x hx
-... ≤ f.roots.card : with_bot.coe_le_coe.2 $ f.roots.to_finset_card_le
-... ≤ f.degree : card_roots hf3
-
-theorem eq_of_eval_eq {f g : F'[X]} (hf : f.degree < s'.card) (hg : g.degree < s'.card)
-  (hfg : ∀ x ∈ s', f.eval x = g.eval x) : f = g :=
-eq_of_sub_eq_zero $ eq_zero_of_eval_eq_zero s'
-  (lt_of_le_of_lt (degree_sub_le f g) $ max_lt hf hg)
-  (λ x hx, by rw [eval_sub, hfg x hx, sub_self])
-
-theorem eq_interpolate_of_eval_eq {g : F[X]} (hg : g.degree < s.card)
-  (hgf : ∀ x ∈ s, g.eval x = f x) : interpolate s f = g :=
-eq_of_eval_eq s (degree_interpolate_lt _ _) hg $ λ x hx, begin
-  rw hgf x hx,
-  exact eval_interpolate _ _ _ hx,
+theorem degree_interpolate_erase_lt (hvs : set.inj_on v s) (hi : i ∈ s) :
+  (interpolate (s.erase i) v r).degree < ↑(s.card - 1) :=
+begin
+  rw ← finset.card_erase_of_mem hi,
+  exact degree_interpolate_lt _ (set.inj_on.mono (coe_subset.mpr (erase_subset _ _)) hvs),
 end
 
-theorem eq_interpolate (f : F[X]) (hf : f.degree < s.card) :
-  interpolate s (λ x, f.eval x) = f :=
-eq_of_eval_eq s (degree_interpolate_lt s _) hf $ λ x hx, eval_interpolate s _ x hx
+theorem values_eq_on_of_interpolate_eq (hvs : set.inj_on v s)
+  (hrr' : interpolate s v r = interpolate s v r') : ∀ i ∈ s, r i = r' i :=
+λ _ hi, by rw [← eval_interpolate_at_node r hvs hi, hrr', eval_interpolate_at_node r' hvs hi]
+
+theorem interpolate_eq_of_values_eq_on (hrr' : ∀ i ∈ s, r i = r' i) :
+  interpolate s v r = interpolate s v r' :=
+sum_congr rfl (λ i hi, (by rw hrr' _ hi))
+
+theorem interpolate_eq_iff_values_eq_on (hvs : set.inj_on v s) :
+  interpolate s v r = interpolate s v r' ↔ ∀ i ∈ s, r i = r' i :=
+⟨values_eq_on_of_interpolate_eq _ _ hvs, interpolate_eq_of_values_eq_on _ _⟩
+
+theorem eq_interpolate {f : F[X]} (hvs : set.inj_on v s) (degree_f_lt : f.degree < s.card) :
+  f = interpolate s v (λ i, f.eval (v i)) :=
+eq_of_degrees_lt_of_eval_index_eq _ hvs degree_f_lt (degree_interpolate_lt _ hvs) $
+λ i hi, (eval_interpolate_at_node _ hvs hi).symm
+
+theorem eq_interpolate_of_eval_eq {f : F[X]} (hvs : set.inj_on v s)
+  (degree_f_lt : f.degree < s.card) (eval_f : ∀ i ∈ s, f.eval (v i) = r i) :
+  f = interpolate s v r :=
+by { rw eq_interpolate hvs degree_f_lt, exact interpolate_eq_of_values_eq_on _ _ eval_f }
 
-/-- Lagrange interpolation induces isomorphism between functions from `s` and polynomials
-of degree less than `s.card`. -/
-def fun_equiv_degree_lt : degree_lt F s.card ≃ₗ[F] (s → F) :=
-{ to_fun := λ f x, f.1.eval x,
-  map_add' := λ f g, funext $ λ x, eval_add,
+/--
+This is the characteristic property of the interpolation: the interpolation is the
+unique polynomial of `degree < fintype.card ι` which takes the value of the `r i` on the `v i`.
+-/
+theorem eq_interpolate_iff {f : F[X]} (hvs : set.inj_on v s) :
+  (f.degree < s.card ∧ ∀ i ∈ s, eval (v i) f = r i) ↔ f = interpolate s v r :=
+begin
+  split; intro h,
+  { exact eq_interpolate_of_eval_eq _ hvs h.1 h.2 },
+  { rw h, exact ⟨degree_interpolate_lt _ hvs, λ _ hi, eval_interpolate_at_node _ hvs hi⟩ }
+end
+
+/-- Lagrange interpolation induces isomorphism between functions from `s`
+and polynomials of degree less than `fintype.card ι`.-/
+def fun_equiv_degree_lt (hvs : set.inj_on v s) : degree_lt F s.card ≃ₗ[F] (s → F) :=
+{ to_fun := λ f i, f.1.eval (v i),
+  map_add' := λ f g, funext $ λ v, eval_add,
   map_smul' := λ c f, funext $ by simp,
-  inv_fun := λ f, ⟨interpolate s (λ x, if hx : x ∈ s then f ⟨x, hx⟩ else 0),
-    mem_degree_lt.2 $ degree_interpolate_lt _ _⟩,
-  left_inv := λ f, begin apply subtype.eq,
-    simp only [subtype.coe_mk, subtype.val_eq_coe, dite_eq_ite],
-    convert eq_interpolate s f (mem_degree_lt.1 f.2) using 1,
-    rw interpolate_eq_of_eval_eq,
-    intros x hx,
-    rw if_pos hx end,
-  right_inv := λ f, funext $ λ ⟨x, hx⟩, begin
-    convert eval_interpolate s _ x hx,
-    simp_rw dif_pos hx end }
-
-theorem interpolate_eq_interpolate_erase_add {x y : F} (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y) :
-  interpolate s f =
-  C (y - x)⁻¹ * ((X - C x) * interpolate (s.erase x) f + (C y - X) * interpolate (s.erase y) f) :=
-begin
-  refine eq_interpolate_of_eval_eq _ _ _ (λ z hz, _),
-  { rw [degree_mul, degree_C (inv_ne_zero (sub_ne_zero.2 hxy.symm)), zero_add],
-    refine lt_of_le_of_lt (degree_add_le _ _) (max_lt _ _),
-    { rw [degree_mul, degree_X_sub_C],
-      convert (with_bot.add_lt_add_iff_left with_bot.coe_ne_bot).2
-        (degree_interpolate_erase s f hx),
-      simp [nat.one_add, nat.sub_one, nat.succ_pred_eq_of_pos (finset.card_pos.2 ⟨x, hx⟩)] },
-    { rw [degree_mul, ←neg_sub, degree_neg, degree_X_sub_C],
-      convert (with_bot.add_lt_add_iff_left with_bot.coe_ne_bot).2
-        (degree_interpolate_erase s f hy),
-      simp [nat.one_add, nat.sub_one, nat.succ_pred_eq_of_pos (finset.card_pos.2 ⟨y, hy⟩)] } },
-  { by_cases hzx : z = x,
-    { simp [hzx, eval_interpolate (s.erase y) f x (finset.mem_erase_of_ne_of_mem hxy hx),
-            inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm)] },
-    { by_cases hzy : z = y,
-      { simp [hzy, eval_interpolate (s.erase x) f y (finset.mem_erase_of_ne_of_mem hxy.symm hy),
-              inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm)] },
-      { simp only [eval_interpolate (s.erase x) f z (finset.mem_erase_of_ne_of_mem hzx hz),
-                   eval_interpolate (s.erase y) f z (finset.mem_erase_of_ne_of_mem hzy hz),
-                   inv_mul_eq_iff_eq_mul₀ (sub_ne_zero_of_ne hxy.symm), eval_mul, eval_C, eval_add,
-                   eval_sub, eval_X],
-        ring } } }
+  inv_fun := λ r, ⟨interpolate s v (λ x, if hx : x ∈ s then r ⟨x, hx⟩ else 0),
+                   mem_degree_lt.2 $ degree_interpolate_lt _ hvs⟩,
+  left_inv :=
+  begin
+    rintros ⟨f, hf⟩,
+    simp only [subtype.mk_eq_mk, subtype.coe_mk, dite_eq_ite],
+    rw mem_degree_lt at hf,
+    nth_rewrite_rhs 0 eq_interpolate hvs hf,
+    exact interpolate_eq_of_values_eq_on _ _ (λ _ hi, if_pos hi)
+  end,
+  right_inv :=
+  begin
+    intro f,
+    ext ⟨i, hi⟩,
+    simp only [subtype.coe_mk, eval_interpolate_at_node _ hvs hi],
+    exact dif_pos hi,
+  end }
+
+theorem interpolate_eq_sum_interpolate_insert_sdiff (hvt : set.inj_on v t) (hs : s.nonempty)
+  (hst : s ⊆ t) : interpolate t v r =
+  ∑ i in s, (interpolate (insert i (t \ s)) v r) * lagrange.basis s v i :=
+begin
+  symmetry,
+  refine eq_interpolate_of_eval_eq _ hvt (lt_of_le_of_lt (degree_sum_le _ _) _) (λ i hi, _),
+  { simp_rw [(finset.sup_lt_iff (with_bot.bot_lt_coe t.card)), degree_mul],
+    intros i hi,
+    have hs : 1 ≤ s.card := nonempty.card_pos ⟨_, hi⟩,
+    have hst' : s.card ≤ t.card := card_le_of_subset hst,
+    have H : t.card = (1 + (t.card - s.card)) + (s.card - 1),
+    { rw [add_assoc, tsub_add_tsub_cancel hst' hs, ← add_tsub_assoc_of_le (hs.trans hst'),
+          nat.succ_add_sub_one, zero_add] },
+    rw [degree_basis (set.inj_on.mono hst hvt) hi, H, with_bot.coe_add,
+        with_bot.add_lt_add_iff_right (@with_bot.coe_ne_bot _ (s.card - 1))],
+    convert degree_interpolate_lt _ (hvt.mono (coe_subset.mpr (insert_subset.mpr
+      ⟨hst hi, sdiff_subset _ _⟩))),
+    rw [card_insert_of_not_mem (not_mem_sdiff_of_mem_right hi), card_sdiff hst, add_comm] },
+
+  { simp_rw [eval_finset_sum, eval_mul],
+    by_cases hi' : i ∈ s,
+    { rw [← add_sum_erase _ _ hi', eval_basis_self (hvt.mono hst) hi',
+          eval_interpolate_at_node _ (hvt.mono (coe_subset.mpr
+            (insert_subset.mpr ⟨hi, sdiff_subset _ _⟩))) (mem_insert_self _ _),
+          mul_one, add_right_eq_self],
+      refine sum_eq_zero (λ j hj, _),
+      rcases mem_erase.mp hj with ⟨hij, hj⟩,
+      rw [eval_basis_of_ne hij hi', mul_zero] },
+    { have H : ∑ j in s, eval (v i) (lagrange.basis s v j) = 1,
+      { rw [← eval_finset_sum, sum_basis (hvt.mono hst) hs, eval_one] },
+      rw [← mul_one (r i), ← H, mul_sum],
+      refine sum_congr rfl (λ j hj, _),
+      congr,
+      exact eval_interpolate_at_node _ (hvt.mono (insert_subset.mpr ⟨hst hj, sdiff_subset _ _⟩))
+                                (mem_insert.mpr (or.inr (mem_sdiff.mpr ⟨hi, hi'⟩))) } }
+end
+
+theorem interpolate_eq_add_interpolate_erase (hvs : set.inj_on v s) (hi : i ∈ s) (hj : j ∈ s)
+  (hij : i ≠ j) : interpolate s v r = interpolate (s.erase j) v r * basis_divisor (v i) (v j) +
+  interpolate (s.erase i) v r * basis_divisor (v j) (v i) :=
+begin
+  rw [interpolate_eq_sum_interpolate_insert_sdiff _ hvs ⟨i, (mem_insert_self i {j})⟩ _,
+      sum_insert (not_mem_singleton.mpr hij), sum_singleton, basis_pair_left hij,
+      basis_pair_right hij,
+      sdiff_insert_insert_of_mem_of_not_mem hi (not_mem_singleton.mpr hij),
+      sdiff_singleton_eq_erase, pair_comm,
+      sdiff_insert_insert_of_mem_of_not_mem hj (not_mem_singleton.mpr hij.symm),
+      sdiff_singleton_eq_erase],
+  { exact insert_subset.mpr ⟨hi, singleton_subset_iff.mpr hj⟩ },
+end
+
+end interpolate
+
+section nodal
+open finset polynomial
+variables {ι : Type*} {s : finset ι} {v : ι → F} {i : ι} (r : ι → F) {x : F}
+
+/--
+`nodal s v` is the unique monic polynomial whose roots are the nodes defined by `v` and `s`.
+
+That is, the roots of `nodal s v` are exactly the image of `v` on `s`,
+with appropriate multiplicity.
+
+We can use `nodal` to define the barycentric forms of the evaluated interpolant.
+-/
+def nodal (s : finset ι) (v : ι → F) : F[X] := ∏ i in s, (X - C (v i))
+
+lemma nodal_eq (s : finset ι) (v : ι → F) : nodal s v = ∏ i in s, (X - C (v i)) := rfl
+
+@[simp] lemma nodal_empty : nodal ∅ v = 1 := rfl
+
+lemma degree_nodal : (nodal s v).degree = s.card :=
+by simp_rw [nodal, degree_prod, degree_X_sub_C, sum_const, nat.smul_one_eq_coe]
+
+lemma eval_nodal {x : F} : (nodal s v).eval x = ∏ i in s, (x - v i) :=
+by simp_rw [nodal, eval_prod, eval_sub, eval_X, eval_C]
+
+lemma eval_nodal_at_node (hi : i ∈ s) : eval (v i) (nodal s v) = 0 :=
+by { rw [eval_nodal, prod_eq_zero_iff], exact ⟨i, hi, sub_eq_zero_of_eq rfl⟩ }
+
+lemma eval_nodal_not_at_node (hx : ∀ i ∈ s, x ≠ v i) : eval x (nodal s v) ≠ 0 :=
+by { simp_rw [nodal, eval_prod, prod_ne_zero_iff, eval_sub, eval_X, eval_C, sub_ne_zero], exact hx }
+
+lemma nodal_eq_mul_nodal_erase [decidable_eq ι] (hi : i ∈ s) :
+  nodal s v = (X - C (v i)) * nodal (s.erase i) v := by simp_rw [nodal, mul_prod_erase _ _ hi]
+
+lemma X_sub_C_dvd_nodal (v : ι → F) (hi : i ∈ s) : (X - C (v i)) ∣ nodal s v :=
+⟨_, by { classical, exact nodal_eq_mul_nodal_erase hi }⟩
+
+variable [decidable_eq ι]
+
+lemma nodal_erase_eq_nodal_div (hi : i ∈ s) :
+  nodal (s.erase i) v = nodal s v / (X - C (v i)) :=
+begin
+  rw [nodal_eq_mul_nodal_erase hi, euclidean_domain.mul_div_cancel_left],
+  exact X_sub_C_ne_zero _
+end
+
+lemma nodal_insert_eq_nodal (hi : i ∉ s) :
+  nodal (insert i s) v = (X - C (v i)) * (nodal s v) := by simp_rw [nodal, prod_insert hi]
+
+lemma derivative_nodal : (nodal s v).derivative = ∑ i in s, nodal (s.erase i) v :=
+begin
+  refine finset.induction_on s _ (λ _ _ hit IH, _),
+  { rw [nodal_empty, derivative_one, sum_empty] },
+  { rw [nodal_insert_eq_nodal hit, derivative_mul, IH, derivative_sub,
+        derivative_X, derivative_C, sub_zero, one_mul, sum_insert hit,
+        mul_sum, erase_insert hit, add_right_inj],
+    refine sum_congr rfl (λ j hjt, _),
+    rw [nodal_erase_eq_nodal_div (mem_insert_of_mem hjt), nodal_insert_eq_nodal hit,
+        euclidean_domain.mul_div_assoc _ (X_sub_C_dvd_nodal v hjt),
+        nodal_erase_eq_nodal_div hjt] }
+end
+
+lemma eval_nodal_derivative_eval_node_eq (hi : i ∈ s) :
+  eval (v i) (nodal s v).derivative = eval (v i) (nodal (s.erase i) v) :=
+begin
+  rw [derivative_nodal, eval_finset_sum, ← add_sum_erase _ _ hi, add_right_eq_self],
+  refine sum_eq_zero (λ j hj, _),
+  simp_rw [nodal, eval_prod, eval_sub, eval_X, eval_C, prod_eq_zero_iff, mem_erase],
+  exact ⟨i, ⟨(mem_erase.mp hj).1.symm, hi⟩, sub_eq_zero_of_eq rfl⟩
+end
+
+/-- This defines the nodal weight for a given set of node indexes and node mapping function `v`. -/
+def nodal_weight (s : finset ι) (v : ι → F) (i : ι) := ∏ j in s.erase i, (v i - v j)⁻¹
+
+lemma nodal_weight_eq_eval_nodal_erase_inv : nodal_weight s v i =
+  (eval (v i) (nodal (s.erase i) v))⁻¹ :=
+by rw [eval_nodal, nodal_weight, prod_inv_distrib]
+
+lemma nodal_weight_eq_eval_nodal_derative (hi : i ∈ s) : nodal_weight s v i =
+  (eval (v i) (nodal s v).derivative)⁻¹ :=
+by rw [eval_nodal_derivative_eval_node_eq hi, nodal_weight_eq_eval_nodal_erase_inv]
+
+lemma nodal_weight_ne_zero (hvs : set.inj_on v s) (hi : i ∈ s) : nodal_weight s v i ≠ 0 :=
+begin
+  rw [nodal_weight, prod_ne_zero_iff],
+  intros j hj,
+  rcases mem_erase.mp hj with ⟨hij, hj⟩,
+  refine inv_ne_zero (sub_ne_zero_of_ne (mt (hvs.eq_iff hi hj).mp hij.symm)),
+end
+
+lemma basis_eq_prod_sub_inv_mul_nodal_div (hi : i ∈ s) :
+  lagrange.basis s v i = C (nodal_weight s v i) * ( nodal s v / (X - C (v i)) )  :=
+by simp_rw [lagrange.basis, basis_divisor, nodal_weight, prod_mul_distrib,
+            map_prod, ← nodal_erase_eq_nodal_div hi, nodal]
+
+lemma eval_basis_not_at_node (hi : i ∈ s) (hxi : x ≠ v i) :
+  eval x (lagrange.basis s v i) = (eval x (nodal s v)) * (nodal_weight s v i * (x - v i)⁻¹)  :=
+by rw [mul_comm, basis_eq_prod_sub_inv_mul_nodal_div hi, eval_mul, eval_C,
+       ← nodal_erase_eq_nodal_div hi, eval_nodal, eval_nodal, mul_assoc, ← mul_prod_erase _ _ hi,
+       ← mul_assoc (x - v i)⁻¹, inv_mul_cancel (sub_ne_zero_of_ne hxi), one_mul]
+
+lemma interpolate_eq_nodal_weight_mul_nodal_div_X_sub_C :
+  interpolate s v r = ∑ i in s, C (nodal_weight s v i) * (nodal s v / (X - C (v i))) * C (r i) :=
+sum_congr rfl (λ j hj, by rw [mul_comm, basis_eq_prod_sub_inv_mul_nodal_div hj])
+
+/-- This is the first barycentric form of the Lagrange interpolant. -/
+lemma eval_interpolate_not_at_node (hx : ∀ i ∈ s, x ≠ v i) : eval x (interpolate s v r) =
+  eval x (nodal s v) * ∑ i in s, nodal_weight s v i * (x - v i)⁻¹ * r i :=
+begin
+  simp_rw [interpolate_apply, mul_sum, eval_finset_sum, eval_mul, eval_C],
+  refine sum_congr rfl (λ i hi, _),
+  rw [← mul_assoc, mul_comm, eval_basis_not_at_node hi (hx _ hi)]
 end
 
+lemma sum_nodal_weight_mul_inv_sub_ne_zero (hvs : set.inj_on v s)
+  (hx : ∀ i ∈ s, x ≠ v i) (hs : s.nonempty) :
+  ∑ i in s, nodal_weight s v i * (x - v i)⁻¹ ≠ 0 :=
+@right_ne_zero_of_mul_eq_one  _ _ _ (eval x (nodal s v)) _ $
+  by simpa only [pi.one_apply, interpolate_one hvs hs, eval_one, mul_one]
+    using (eval_interpolate_not_at_node 1 hx).symm
+
+/-- This is the second barycentric form of the Lagrange interpolant. -/
+lemma eval_interpolate_not_at_node' (hvs : set.inj_on v s) (hs : s.nonempty)
+  (hx : ∀ i ∈ s, x ≠ v i) : eval x (interpolate s v r) =
+  (∑ i in s, nodal_weight s v i * (x - v i)⁻¹ * r i) /
+  ∑ i in s, nodal_weight s v i * (x - v i)⁻¹ :=
+begin
+  rw [← div_one (eval x (interpolate s v r)), ← @eval_one _ _ x, ← interpolate_one hvs hs,
+      eval_interpolate_not_at_node r hx, eval_interpolate_not_at_node 1 hx],
+  simp only [mul_div_mul_left _ _ (eval_nodal_not_at_node hx), pi.one_apply, mul_one]
+end
+
+end nodal
+
 end lagrange
diff --git a/src/linear_algebra/linear_independent.lean b/src/linear_algebra/linear_independent.lean
index 6909aa5e94a1d..7242efa4e2256 100644
--- a/src/linear_algebra/linear_independent.lean
+++ b/src/linear_algebra/linear_independent.lean
@@ -3,15 +3,18 @@ Copyright (c) 2020 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Alexander Bentkamp, Anne Baanen
 -/
+import algebra.big_operators.fin
 import linear_algebra.finsupp
 import linear_algebra.prod
-import logic.equiv.fin
 import set_theory.cardinal.basic
 
 /-!
 
 # Linear independence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines linear independence in a module or vector space.
 
 It is inspired by Isabelle/HOL's linear algebra, and hence indirectly by HOL Light.
@@ -144,7 +147,7 @@ end
 theorem fintype.linear_independent_iff' [fintype ι] :
   linear_independent R v ↔
     (linear_map.lsum R (λ i : ι, R) ℕ (λ i, linear_map.id.smul_right (v i))).ker = ⊥ :=
-by simp [fintype.linear_independent_iff, linear_map.ker_eq_bot', funext_iff]
+by simp [fintype.linear_independent_iff, linear_map.ker_eq_bot', funext_iff]; skip
 
 lemma fintype.not_linear_independent_iff [fintype ι] :
   ¬linear_independent R v ↔ ∃ g : ι → R, (∑ i, g i • v i) = 0 ∧ (∃ i, g i ≠ 0) :=
@@ -155,7 +158,7 @@ linear_independent_iff.mpr $ λ v hv, subsingleton.elim v 0
 
 lemma linear_independent.ne_zero [nontrivial R]
   (i : ι) (hv : linear_independent R v) : v i ≠ 0 :=
-λ h, @zero_ne_one R _ _ $ eq.symm begin
+λ h, zero_ne_one' R $ eq.symm begin
   suffices : (finsupp.single i 1 : ι →₀ R) i = 0, {simpa},
   rw linear_independent_iff.1 hv (finsupp.single i 1),
   { simp },
@@ -186,7 +189,8 @@ family of vectors. See also `linear_independent.map'` for a special case assumin
 lemma linear_independent.map (hv : linear_independent R v) {f : M →ₗ[R] M'}
   (hf_inj : disjoint (span R (range v)) f.ker) : linear_independent R (f ∘ v) :=
 begin
-  rw [disjoint, ← set.image_univ, finsupp.span_image_eq_map_total, map_inf_eq_map_inf_comap,
+  rw [disjoint_iff_inf_le, ← set.image_univ, finsupp.span_image_eq_map_total,
+    map_inf_eq_map_inf_comap,
     map_le_iff_le_comap, comap_bot, finsupp.supported_univ, top_inf_eq] at hf_inj,
   unfold linear_independent at hv ⊢,
   rw [hv, le_bot_iff] at hf_inj,
@@ -253,19 +257,12 @@ lemma linear_independent.fin_cons' {m : ℕ} (x : M) (v : fin m → M)
 begin
   rw fintype.linear_independent_iff at hli ⊢,
   rintros g total_eq j,
-  have zero_not_mem : (0 : fin m.succ) ∉ finset.univ.image (fin.succ : fin m → fin m.succ),
-  { rw finset.mem_image,
-    rintro ⟨x, hx, succ_eq⟩,
-    exact fin.succ_ne_zero _ succ_eq },
-  simp only [submodule.coe_mk, fin.univ_succ, finset.sum_insert zero_not_mem,
-  fin.cons_zero, fin.cons_succ,
-  forall_true_iff, imp_self, fin.succ_inj, finset.sum_image] at total_eq,
+  simp_rw [fin.sum_univ_succ, fin.cons_zero, fin.cons_succ] at total_eq,
   have : g 0 = 0,
   { refine x_ortho (g 0) ⟨∑ (i : fin m), g i.succ • v i, _⟩ total_eq,
     exact sum_mem (λ i _, smul_mem _ _ (subset_span ⟨i, rfl⟩)) },
-  refine fin.cases this (λ j, _) j,
-  apply hli (λ i, g i.succ),
-  simpa only [this, zero_smul, zero_add] using total_eq
+  rw [this, zero_smul, zero_add] at total_eq,
+  exact fin.cases this (hli _ total_eq) j,
 end
 
 /-- A set of linearly independent vectors in a module `M` over a semiring `K` is also linearly
@@ -368,9 +365,9 @@ by apply @linear_independent_comp_subtype_disjoint _ _ _ id
 
 theorem linear_independent_iff_total_on {s : set M} :
   linear_independent R (λ x, x : s → M) ↔ (finsupp.total_on M M R id s).ker = ⊥ :=
-by rw [finsupp.total_on, linear_map.ker, linear_map.comap_cod_restrict, map_bot, comap_bot,
-  linear_map.ker_comp, linear_independent_subtype_disjoint, disjoint, ← map_comap_subtype,
-  map_le_iff_le_comap, comap_bot, ker_subtype, le_bot_iff]
+by rw [finsupp.total_on, linear_map.ker, linear_map.comap_cod_restrict, submodule.map_bot,
+  comap_bot, linear_map.ker_comp, linear_independent_subtype_disjoint, disjoint_iff_inf_le,
+  ← map_comap_subtype, map_le_iff_le_comap, comap_bot, ker_subtype, le_bot_iff]
 
 lemma linear_independent.restrict_of_comp_subtype {s : set ι}
   (hs : linear_independent R (v ∘ coe : s → M)) :
@@ -390,7 +387,7 @@ begin
 end
 
 lemma linear_independent_of_finite (s : set M)
-  (H : ∀ t ⊆ s, finite t → linear_independent R (λ x, x : t → M)) :
+  (H : ∀ t ⊆ s, set.finite t → linear_independent R (λ x, x : t → M)) :
   linear_independent R (λ x, x : s → M) :=
 linear_independent_subtype.2 $
   λ l hl, linear_independent_subtype.1 (H _ hl (finset.finite_to_set _)) l (subset.refl _)
@@ -579,7 +576,8 @@ begin
   simp only [disjoint_def, finsupp.mem_span_image_iff_total],
   rintros _ ⟨l₁, hl₁, rfl⟩ ⟨l₂, hl₂, H⟩,
   rw [hv.injective_total.eq_iff] at H, subst l₂,
-  have : l₁ = 0 := finsupp.disjoint_supported_supported hs (submodule.mem_inf.2 ⟨hl₁, hl₂⟩),
+  have : l₁ = 0 :=
+    submodule.disjoint_def.mp (finsupp.disjoint_supported_supported hs) _ hl₁ hl₂,
   simp [this]
 end
 
@@ -624,7 +622,8 @@ begin
     ∑ i in s.preimage sum.inr (sum.inr_injective.inj_on _), (λ x, g x • v x) (sum.inr i) = 0,
   { rw [finset.sum_preimage', finset.sum_preimage', ← finset.sum_union, ← finset.filter_or],
     { simpa only [← mem_union, range_inl_union_range_inr, mem_univ, finset.filter_true] },
-    { exact finset.disjoint_filter.2 (λ x hx, disjoint_left.1 is_compl_range_inl_range_inr.1) } },
+    { exact finset.disjoint_filter.2
+        (λ x _ hx, disjoint_left.1 is_compl_range_inl_range_inr.1 hx) } },
   { rw ← eq_neg_iff_add_eq_zero at this,
     rw [disjoint_def'] at hlr,
     have A := hlr _ (sum_mem $ λ i hi, _) _ (neg_mem $ sum_mem $ λ i hi, _) this,
@@ -650,7 +649,7 @@ lemma linear_independent.union {s t : set M}
 
 lemma linear_independent_Union_finite_subtype {ι : Type*} {f : ι → set M}
   (hl : ∀i, linear_independent R (λ x, x : f i → M))
-  (hd : ∀i, ∀t:set ι, finite t → i ∉ t → disjoint (span R (f i)) (⨆i∈t, span R (f i))) :
+  (hd : ∀i, ∀t:set ι, t.finite → i ∉ t → disjoint (span R (f i)) (⨆i∈t, span R (f i))) :
   linear_independent R (λ x, x : (⋃i, f i) → M) :=
 begin
   rw [Union_eq_Union_finset f],
@@ -670,7 +669,7 @@ end
 lemma linear_independent_Union_finite {η : Type*} {ιs : η → Type*}
   {f : Π j : η, ιs j → M}
   (hindep : ∀j, linear_independent R (f j))
-  (hd : ∀i, ∀t:set η, finite t → i ∉ t →
+  (hd : ∀i, ∀t:set η, t.finite → i ∉ t →
       disjoint (span R (range (f i))) (⨆i∈t, span R (range (f i)))) :
   linear_independent R (λ ji : Σ j, ιs j, f ji.1 ji.2) :=
 begin
@@ -707,10 +706,11 @@ def linear_independent.total_equiv (hv : linear_independent R v) :
 begin
   apply linear_equiv.of_bijective
     (linear_map.cod_restrict (span R (range v)) (finsupp.total ι M R v) _),
+  split,
   { rw [← linear_map.ker_eq_bot, linear_map.ker_cod_restrict],
     apply hv },
   { rw [← linear_map.range_eq_top, linear_map.range_eq_map, linear_map.map_cod_restrict,
-      ← linear_map.range_le_iff_comap, range_subtype, map_top],
+      ← linear_map.range_le_iff_comap, range_subtype, submodule.map_top],
     rw finsupp.range_total,
     exact le_rfl },
   { intro l,
@@ -797,6 +797,22 @@ end, λ H, linear_independent_iff.2 $ λ l hl, begin
   { simp [hl] }
 end⟩
 
+/-- See also `complete_lattice.independent_iff_linear_independent_of_ne_zero`. -/
+lemma linear_independent.independent_span_singleton (hv : linear_independent R v) :
+  complete_lattice.independent $ λ i, R ∙ v i :=
+begin
+  refine complete_lattice.independent_def.mp (λ i, _),
+  rw disjoint_iff_inf_le,
+  intros m hm,
+  simp only [mem_inf, mem_span_singleton, supr_subtype', ← span_range_eq_supr] at hm,
+  obtain ⟨⟨r, rfl⟩, hm⟩ := hm,
+  suffices : r = 0, { simp [this], },
+  apply linear_independent_iff_not_smul_mem_span.mp hv i,
+  convert hm,
+  ext,
+  simp,
+end
+
 variable (R)
 
 lemma exists_maximal_independent' (s : ι → M) :
@@ -870,8 +886,7 @@ begin
   { dsimp only [l],
     rw finsupp.total_map_domain,
     rw (hv.comp f f.injective).total_repr,
-    { refl },
-    { exact f.injective } },
+    { refl } },
   have h_total_eq : (finsupp.total ι M R v) l = (finsupp.total ι M R v) (finsupp.single i 1),
     by rw [h_total_l, finsupp.total_single, one_smul],
   have l_eq : l = _ := linear_map.ker_eq_bot.1 hv h_total_eq,
@@ -1278,11 +1293,11 @@ begin
 end
 
 lemma exists_finite_card_le_of_finite_of_linear_independent_of_span
-  (ht : finite t) (hs : linear_independent K (λ x, x : s → V)) (hst : s ⊆ span K t) :
-  ∃h : finite s, h.to_finset.card ≤ ht.to_finset.card :=
+  (ht : t.finite) (hs : linear_independent K (λ x, x : s → V)) (hst : s ⊆ span K t) :
+  ∃h : s.finite, h.to_finset.card ≤ ht.to_finset.card :=
 have s ⊆ (span K ↑(ht.to_finset) : submodule K V), by simp; assumption,
 let ⟨u, hust, hsu, eq⟩ := exists_of_linear_independent_of_finite_span hs this in
-have finite s, from u.finite_to_set.subset hsu,
+have s.finite, from u.finite_to_set.subset hsu,
 ⟨this, by rw [←eq]; exact (finset.card_le_of_subset $ finset.coe_subset.mp $ by simp [hsu])⟩
 
 end module
diff --git a/src/linear_algebra/linear_pmap.lean b/src/linear_algebra/linear_pmap.lean
index d97de7ec18a05..a20d1d6a41afb 100644
--- a/src/linear_algebra/linear_pmap.lean
+++ b/src/linear_algebra/linear_pmap.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2020 Yury Kudryashov All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yury Kudryashov
+Authors: Yury Kudryashov, Moritz Doll
 -/
 import linear_algebra.basic
 import linear_algebra.prod
@@ -9,8 +9,11 @@ import linear_algebra.prod
 /-!
 # Partially defined linear maps
 
-A `linear_pmap R E F` is a linear map from a submodule of `E` to `F`. We define
-a `semilattice_inf` with `order_bot` instance on this this, and define three operations:
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A `linear_pmap R E F` or `E →ₗ.[R] F` is a linear map from a submodule of `E` to `F`.
+We define a `semilattice_inf` with `order_bot` instance on this this, and define three operations:
 
 * `mk_span_singleton` defines a partial linear map defined on the span of a singleton.
 * `sup` takes two partial linear maps `f`, `g` that agree on the intersection of their
@@ -19,23 +22,28 @@ a `semilattice_inf` with `order_bot` instance on this this, and define three ope
 * `Sup` takes a `directed_on (≤)` set of partial linear maps, and returns the unique
   partial linear map on the `Sup` of their domains that extends all these maps.
 
+Moreover, we define
+* `linear_pmap.graph` is the graph of the partial linear map viewed as a submodule of `E × F`.
+
 Partially defined maps are currently used in `mathlib` to prove Hahn-Banach theorem
 and its variations. Namely, `linear_pmap.Sup` implies that every chain of `linear_pmap`s
 is bounded above.
+They are also the basis for the theory of unbounded operators.
 
-Another possible use (not yet in `mathlib`) would be the theory of unbounded linear operators.
 -/
 
 open set
 
 universes u v w
 
-/-- A `linear_pmap R E F` is a linear map from a submodule of `E` to `F`. -/
+/-- A `linear_pmap R E F` or `E →ₗ.[R] F` is a linear map from a submodule of `E` to `F`. -/
 structure linear_pmap (R : Type u) [ring R] (E : Type v) [add_comm_group E] [module R E]
   (F : Type w) [add_comm_group F] [module R F] :=
 (domain : submodule R E)
 (to_fun : domain →ₗ[R] F)
 
+notation E ` →ₗ.[`:25 R:25 `] `:0 F:0 := linear_pmap R E F
+
 variables {R : Type*} [ring R] {E : Type*} [add_comm_group E] [module R E]
   {F : Type*} [add_comm_group F] [module R F]
   {G : Type*} [add_comm_group G] [module R G]
@@ -44,24 +52,42 @@ namespace linear_pmap
 
 open submodule
 
-instance : has_coe_to_fun (linear_pmap R E F) (λ f : linear_pmap R E F, f.domain → F) :=
+instance : has_coe_to_fun (E →ₗ.[R] F) (λ f : E →ₗ.[R] F, f.domain → F) :=
 ⟨λ f, f.to_fun⟩
 
-@[simp] lemma to_fun_eq_coe (f : linear_pmap R E F) (x : f.domain) :
+@[simp] lemma to_fun_eq_coe (f : E →ₗ.[R] F) (x : f.domain) :
   f.to_fun x = f x := rfl
 
-@[simp] lemma map_zero (f : linear_pmap R E F) : f 0 = 0 := f.to_fun.map_zero
+@[ext] lemma ext {f g : E →ₗ.[R] F} (h : f.domain = g.domain)
+  (h' : ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (h : (x:E) = y), f x = g y) : f = g :=
+begin
+  rcases f with ⟨f_dom, f⟩,
+  rcases g with ⟨g_dom, g⟩,
+  obtain rfl : f_dom = g_dom := h,
+  obtain rfl : f = g := linear_map.ext (λ x, h' rfl),
+  refl,
+end
+
+@[simp] lemma map_zero (f : E →ₗ.[R] F) : f 0 = 0 := f.to_fun.map_zero
+
+lemma ext_iff {f g : E →ₗ.[R] F} :
+  f = g ↔
+  ∃ (domain_eq : f.domain = g.domain),
+    ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (h : (x:E) = y), f x = g y :=
+⟨λ EQ, EQ ▸ ⟨rfl, λ x y h, by { congr, exact_mod_cast h }⟩, λ ⟨deq, feq⟩, ext deq feq⟩
 
-lemma map_add (f : linear_pmap R E F) (x y : f.domain) : f (x + y) = f x + f y :=
+lemma ext' {s : submodule R E} {f g : s →ₗ[R] F} (h : f = g) : mk s f = mk s g := h ▸ rfl
+
+lemma map_add (f : E →ₗ.[R] F) (x y : f.domain) : f (x + y) = f x + f y :=
 f.to_fun.map_add x y
 
-lemma map_neg (f : linear_pmap R E F) (x : f.domain) : f (-x) = -f x :=
+lemma map_neg (f : E →ₗ.[R] F) (x : f.domain) : f (-x) = -f x :=
 f.to_fun.map_neg x
 
-lemma map_sub (f : linear_pmap R E F) (x y : f.domain) : f (x - y) = f x - f y :=
+lemma map_sub (f : E →ₗ.[R] F) (x y : f.domain) : f (x - y) = f x - f y :=
 f.to_fun.map_sub x y
 
-lemma map_smul (f : linear_pmap R E F) (c : R) (x : f.domain) : f (c • x) = c • f x :=
+lemma map_smul (f : E →ₗ.[R] F) (c : R) (x : f.domain) : f (c • x) = c • f x :=
 f.to_fun.map_smul c x
 
 @[simp] lemma mk_apply (p : submodule R E) (f : p →ₗ[R] F) (x : p) :
@@ -70,7 +96,7 @@ f.to_fun.map_smul c x
 /-- The unique `linear_pmap` on `R ∙ x` that sends `x` to `y`. This version works for modules
 over rings, and requires a proof of `∀ c, c • x = 0 → c • y = 0`. -/
 noncomputable def mk_span_singleton' (x : E) (y : F) (H : ∀ c : R, c • x = 0 → c • y = 0) :
-  linear_pmap R E F :=
+  E →ₗ.[R] F :=
 { domain := R ∙ x,
   to_fun :=
   have H : ∀ c₁ c₂ : R, c₁ • x = c₂ • x → c₁ • y = c₂ • y,
@@ -114,7 +140,7 @@ by convert mk_span_singleton'_apply x y H 1 _; rwa one_smul
 This version works for modules over division rings. -/
 @[reducible] noncomputable def mk_span_singleton {K E F : Type*} [division_ring K]
   [add_comm_group E] [module K E] [add_comm_group F] [module K F] (x : E) (y : F) (hx : x ≠ 0) :
-  linear_pmap K E F :=
+  E →ₗ.[K] F :=
 mk_span_singleton' x y $ λ c hc, (smul_eq_zero.1 hc).elim
   (λ hc, by rw [hc, zero_smul]) (λ hx', absurd hx' hx)
 
@@ -125,7 +151,7 @@ lemma mk_span_singleton_apply (K : Type*) {E F : Type*} [division_ring K]
 linear_pmap.mk_span_singleton'_apply_self _ _ _ _
 
 /-- Projection to the first coordinate as a `linear_pmap` -/
-protected def fst (p : submodule R E) (p' : submodule R F) : linear_pmap R (E × F) E :=
+protected def fst (p : submodule R E) (p' : submodule R F) : (E × F) →ₗ.[R] E :=
 { domain := p.prod p',
   to_fun := (linear_map.fst R E F).comp (p.prod p').subtype }
 
@@ -133,35 +159,36 @@ protected def fst (p : submodule R E) (p' : submodule R F) : linear_pmap R (E ×
   linear_pmap.fst p p' x = (x : E × F).1 := rfl
 
 /-- Projection to the second coordinate as a `linear_pmap` -/
-protected def snd (p : submodule R E) (p' : submodule R F) : linear_pmap R (E × F) F :=
+protected def snd (p : submodule R E) (p' : submodule R F) : (E × F) →ₗ.[R] F :=
 { domain := p.prod p',
   to_fun := (linear_map.snd R E F).comp (p.prod p').subtype }
 
 @[simp] lemma snd_apply (p : submodule R E) (p' : submodule R F) (x : p.prod p') :
   linear_pmap.snd p p' x = (x : E × F).2 := rfl
 
-instance : has_neg (linear_pmap R E F) :=
+instance : has_neg (E →ₗ.[R] F) :=
 ⟨λ f, ⟨f.domain, -f.to_fun⟩⟩
 
-@[simp] lemma neg_apply (f : linear_pmap R E F) (x) : (-f) x = -(f x) := rfl
+@[simp] lemma neg_apply (f : E →ₗ.[R] F) (x) : (-f) x = -(f x) := rfl
 
-instance : has_le (linear_pmap R E F) :=
+instance : has_le (E →ₗ.[R] F) :=
 ⟨λ f g, f.domain ≤ g.domain ∧ ∀ ⦃x : f.domain⦄ ⦃y : g.domain⦄ (h : (x:E) = y), f x = g y⟩
 
-lemma eq_of_le_of_domain_eq {f g : linear_pmap R E F} (hle : f ≤ g) (heq : f.domain = g.domain) :
+lemma apply_comp_of_le {T S : E →ₗ.[R] F} (h : T ≤ S) (x : T.domain) :
+  T x = S (submodule.of_le h.1 x) :=
+h.2 rfl
+
+lemma exists_of_le {T S : E →ₗ.[R] F} (h : T ≤ S) (x : T.domain) :
+  ∃ (y : S.domain), (x : E) = y ∧ T x = S y :=
+⟨⟨x.1, h.1 x.2⟩, ⟨rfl, h.2 rfl⟩⟩
+
+lemma eq_of_le_of_domain_eq {f g : E →ₗ.[R] F} (hle : f ≤ g) (heq : f.domain = g.domain) :
   f = g :=
-begin
-  rcases f with ⟨f_dom, f⟩,
-  rcases g with ⟨g_dom, g⟩,
-  change f_dom = g_dom at heq,
-  subst g_dom,
-  obtain rfl : f = g := linear_map.ext (λ x, hle.2 rfl),
-  refl,
-end
+ext heq hle.2
 
 /-- Given two partial linear maps `f`, `g`, the set of points `x` such that
 both `f` and `g` are defined at `x` and `f x = g x` form a submodule. -/
-def eq_locus (f g : linear_pmap R E F) : submodule R E :=
+def eq_locus (f g : E →ₗ.[R] F) : submodule R E :=
 { carrier   := {x | ∃ (hf : x ∈ f.domain) (hg : x ∈ g.domain), f ⟨x, hf⟩ = g ⟨x, hg⟩},
   zero_mem' := ⟨zero_mem _, zero_mem _, f.map_zero.trans g.map_zero.symm⟩,
   add_mem'  := λ x y ⟨hfx, hgx, hx⟩ ⟨hfy, hgy, hy⟩, ⟨add_mem hfx hfy, add_mem hgx hgy,
@@ -169,14 +196,14 @@ def eq_locus (f g : linear_pmap R E F) : submodule R E :=
   smul_mem' := λ c x ⟨hfx, hgx, hx⟩, ⟨smul_mem _ c hfx, smul_mem _ c hgx,
     by erw [f.map_smul c ⟨x, hfx⟩, g.map_smul c ⟨x, hgx⟩, hx]⟩ }
 
-instance : has_inf (linear_pmap R E F) :=
+instance : has_inf (E →ₗ.[R] F) :=
 ⟨λ f g, ⟨f.eq_locus g, f.to_fun.comp $ of_le $ λ x hx, hx.fst⟩⟩
 
-instance : has_bot (linear_pmap R E F) := ⟨⟨⊥, 0⟩⟩
+instance : has_bot (E →ₗ.[R] F) := ⟨⟨⊥, 0⟩⟩
 
-instance : inhabited (linear_pmap R E F) := ⟨⊥⟩
+instance : inhabited (E →ₗ.[R] F) := ⟨⊥⟩
 
-instance : semilattice_inf (linear_pmap R E F) :=
+instance : semilattice_inf (E →ₗ.[R] F) :=
 { le := (≤),
   le_refl := λ f, ⟨le_refl f.domain, λ x y h, subtype.eq h ▸ rfl⟩,
   le_trans := λ f g h ⟨fg_le, fg_eq⟩ ⟨gh_le, gh_eq⟩,
@@ -194,14 +221,14 @@ instance : semilattice_inf (linear_pmap R E F) :=
   inf_le_right := λ f g, ⟨λ x hx, hx.snd.fst,
     λ ⟨x, xf, xg, hx⟩ y h, hx.trans $ congr_arg g $ subtype.eq $ by exact h⟩ }
 
-instance : order_bot (linear_pmap R E F) :=
+instance : order_bot (E →ₗ.[R] F) :=
 { bot := ⊥,
   bot_le := λ f, ⟨bot_le, λ x y h,
     have hx : x = 0, from subtype.eq ((mem_bot R).1 x.2),
     have hy : y = 0, from subtype.eq (h.symm.trans (congr_arg _ hx)),
     by rw [hx, hy, map_zero, map_zero]⟩ }
 
-lemma le_of_eq_locus_ge {f g : linear_pmap R E F} (H : f.domain ≤ f.eq_locus g) :
+lemma le_of_eq_locus_ge {f g : E →ₗ.[R] F} (H : f.domain ≤ f.eq_locus g) :
   f ≤ g :=
 suffices f ≤ f ⊓ g, from le_trans this inf_le_right,
 ⟨H, λ x y hxy, ((inf_le_left : f ⊓ g ≤ f).2 hxy.symm).symm⟩
@@ -210,7 +237,7 @@ lemma domain_mono : strict_mono (@domain R _ E _ _ F _ _) :=
 λ f g hlt, lt_of_le_of_ne hlt.1.1 $ λ heq, ne_of_lt hlt $
 eq_of_le_of_domain_eq (le_of_lt hlt) heq
 
-private lemma sup_aux (f g : linear_pmap R E F)
+private lemma sup_aux (f g : E →ₗ.[R] F)
   (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
   ∃ fg : ↥(f.domain ⊔ g.domain) →ₗ[R] F,
     ∀ (x : f.domain) (y : g.domain) (z),
@@ -243,23 +270,23 @@ end
 /-- Given two partial linear maps that agree on the intersection of their domains,
 `f.sup g h` is the unique partial linear map on `f.domain ⊔ g.domain` that agrees
 with `f` and `g`. -/
-protected noncomputable def sup (f g : linear_pmap R E F)
+protected noncomputable def sup (f g : E →ₗ.[R] F)
   (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
-  linear_pmap R E F :=
+  E →ₗ.[R] F :=
 ⟨_, classical.some (sup_aux f g h)⟩
 
-@[simp] lemma domain_sup (f g : linear_pmap R E F)
+@[simp] lemma domain_sup (f g : E →ₗ.[R] F)
   (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
   (f.sup g h).domain = f.domain ⊔ g.domain :=
 rfl
 
-lemma sup_apply {f g : linear_pmap R E F}
+lemma sup_apply {f g : E →ₗ.[R] F}
   (H : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y)
   (x y z) (hz : (↑x:E) + ↑y = ↑z) :
   f.sup g H z = f x + g y :=
 classical.some_spec (sup_aux f g H) x y z hz
 
-protected lemma left_le_sup (f g : linear_pmap R E F)
+protected lemma left_le_sup (f g : E →ₗ.[R] F)
   (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
   f ≤ f.sup g h :=
 begin
@@ -269,7 +296,7 @@ begin
   simpa
 end
 
-protected lemma right_le_sup (f g : linear_pmap R E F)
+protected lemma right_le_sup (f g : E →ₗ.[R] F)
   (h : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y) :
   g ≤ f.sup g h :=
 begin
@@ -279,7 +306,7 @@ begin
   simpa
 end
 
-protected lemma sup_le {f g h : linear_pmap R E F}
+protected lemma sup_le {f g h : E →ₗ.[R] F}
   (H : ∀ (x : f.domain) (y : g.domain), (x:E) = y → f x = g y)
   (fh : f ≤ h) (gh : g ≤ h) :
   f.sup g H ≤ h :=
@@ -288,7 +315,7 @@ have Hg : g ≤ (f.sup g H) ⊓ h, from le_inf (f.right_le_sup g H) gh,
 le_of_eq_locus_ge $ sup_le Hf.1 Hg.1
 
 /-- Hypothesis for `linear_pmap.sup` holds, if `f.domain` is disjoint with `g.domain`. -/
-lemma sup_h_of_disjoint (f g : linear_pmap R E F) (h : disjoint f.domain g.domain)
+lemma sup_h_of_disjoint (f g : E →ₗ.[R] F) (h : disjoint f.domain g.domain)
   (x : f.domain) (y : g.domain) (hxy : (x:E) = y) :
   f x = g y :=
 begin
@@ -298,21 +325,73 @@ begin
   simp [*]
 end
 
+section smul
+
+variables {M N : Type*} [monoid M] [distrib_mul_action M F] [smul_comm_class R M F]
+variables [monoid N] [distrib_mul_action N F] [smul_comm_class R N F]
+
+instance : has_smul M (E →ₗ.[R] F) :=
+⟨λ a f,
+  { domain := f.domain,
+    to_fun := a • f.to_fun }⟩
+
+@[simp] lemma smul_domain (a : M) (f : E →ₗ.[R] F) : (a • f).domain = f.domain := rfl
+
+lemma smul_apply (a : M) (f : E →ₗ.[R] F) (x : ((a • f).domain)) :
+  (a • f) x = a • f x := rfl
+
+@[simp] lemma coe_smul (a : M) (f : E →ₗ.[R] F) : ⇑(a • f) = a • f := rfl
+
+instance [smul_comm_class M N F] : smul_comm_class M N (E →ₗ.[R] F) :=
+⟨λ a b f, ext' $ smul_comm a b f.to_fun⟩
+
+instance [has_smul M N] [is_scalar_tower M N F] : is_scalar_tower M N (E →ₗ.[R] F) :=
+⟨λ a b f, ext' $ smul_assoc a b f.to_fun⟩
+
+instance : mul_action M (E →ₗ.[R] F) :=
+{ smul := (•),
+  one_smul := λ ⟨s, f⟩, ext' $ one_smul M f,
+  mul_smul := λ a b f, ext' $ mul_smul a b f.to_fun }
+
+end smul
+
+section vadd
+
+instance : has_vadd (E →ₗ[R] F) (E →ₗ.[R] F) :=
+⟨λ f g,
+  { domain := g.domain,
+    to_fun := f.comp g.domain.subtype + g.to_fun }⟩
+
+@[simp] lemma vadd_domain (f : E →ₗ[R] F) (g : E →ₗ.[R] F) : (f +ᵥ g).domain = g.domain := rfl
+
+lemma vadd_apply (f : E →ₗ[R] F) (g : E →ₗ.[R] F) (x : (f +ᵥ g).domain) :
+  (f +ᵥ g) x = f x + g x := rfl
+
+@[simp] lemma coe_vadd (f : E →ₗ[R] F) (g : E →ₗ.[R] F) :
+  ⇑(f +ᵥ g) = f.comp g.domain.subtype + g := rfl
+
+instance : add_action (E →ₗ[R] F) (E →ₗ.[R] F) :=
+{ vadd := (+ᵥ),
+  zero_vadd := λ ⟨s, f⟩, ext' $ zero_add _,
+  add_vadd := λ f₁ f₂ ⟨s, g⟩, ext' $ linear_map.ext $ λ x, add_assoc _ _ _ }
+
+end vadd
+
 section
 
 variables {K : Type*} [division_ring K] [module K E] [module K F]
 
 /-- Extend a `linear_pmap` to `f.domain ⊔ K ∙ x`. -/
-noncomputable def sup_span_singleton (f : linear_pmap K E F) (x : E) (y : F) (hx : x ∉ f.domain) :
-  linear_pmap K E F :=
+noncomputable def sup_span_singleton (f : E →ₗ.[K] F) (x : E) (y : F) (hx : x ∉ f.domain) :
+  E →ₗ.[K] F :=
 f.sup (mk_span_singleton x y (λ h₀, hx $ h₀.symm ▸ f.domain.zero_mem)) $
   sup_h_of_disjoint _ _ $ by simpa [disjoint_span_singleton]
 
-@[simp] lemma domain_sup_span_singleton (f : linear_pmap K E F) (x : E) (y : F)
+@[simp] lemma domain_sup_span_singleton (f : E →ₗ.[K] F) (x : E) (y : F)
   (hx : x ∉ f.domain) :
   (f.sup_span_singleton x y hx).domain = f.domain ⊔ K ∙ x := rfl
 
-@[simp] lemma sup_span_singleton_apply_mk (f : linear_pmap K E F) (x : E) (y : F)
+@[simp] lemma sup_span_singleton_apply_mk (f : E →ₗ.[K] F) (x : E) (y : F)
   (hx : x ∉ f.domain) (x' : E) (hx' : x' ∈ f.domain) (c : K) :
   f.sup_span_singleton x y hx ⟨x' + c • x,
     mem_sup.2 ⟨x', hx', _, mem_span_singleton.2 ⟨c, rfl⟩, rfl⟩⟩ = f ⟨x', hx'⟩ + c • y :=
@@ -324,8 +403,8 @@ end
 
 end
 
-private lemma Sup_aux (c : set (linear_pmap R E F)) (hc : directed_on (≤) c) :
-  ∃ f : ↥(Sup (domain '' c)) →ₗ[R] F, (⟨_, f⟩ : linear_pmap R E F) ∈ upper_bounds c :=
+private lemma Sup_aux (c : set (E →ₗ.[R] F)) (hc : directed_on (≤) c) :
+  ∃ f : ↥(Sup (domain '' c)) →ₗ[R] F, (⟨_, f⟩ : E →ₗ.[R] F) ∈ upper_bounds c :=
 begin
   cases c.eq_empty_or_nonempty with ceq cne, { subst c, simp },
   have hdir : directed_on (≤) (domain '' c),
@@ -357,37 +436,48 @@ end
 
 /-- Glue a collection of partially defined linear maps to a linear map defined on `Sup`
 of these submodules. -/
-protected noncomputable def Sup (c : set (linear_pmap R E F)) (hc : directed_on (≤) c) :
-  linear_pmap R E F :=
+protected noncomputable def Sup (c : set (E →ₗ.[R] F)) (hc : directed_on (≤) c) :
+  E →ₗ.[R] F :=
 ⟨_, classical.some $ Sup_aux c hc⟩
 
-protected lemma le_Sup {c : set (linear_pmap R E F)} (hc : directed_on (≤) c)
-  {f : linear_pmap R E F} (hf : f ∈ c) : f ≤ linear_pmap.Sup c hc :=
+protected lemma le_Sup {c : set (E →ₗ.[R] F)} (hc : directed_on (≤) c)
+  {f : E →ₗ.[R] F} (hf : f ∈ c) : f ≤ linear_pmap.Sup c hc :=
 classical.some_spec (Sup_aux c hc) hf
 
-protected lemma Sup_le {c : set (linear_pmap R E F)} (hc : directed_on (≤) c)
-  {g : linear_pmap R E F} (hg : ∀ f ∈ c, f ≤ g) : linear_pmap.Sup c hc ≤ g :=
+protected lemma Sup_le {c : set (E →ₗ.[R] F)} (hc : directed_on (≤) c)
+  {g : E →ₗ.[R] F} (hg : ∀ f ∈ c, f ≤ g) : linear_pmap.Sup c hc ≤ g :=
 le_of_eq_locus_ge $ Sup_le $ λ _ ⟨f, hf, eq⟩, eq ▸
 have f ≤ (linear_pmap.Sup c hc) ⊓ g, from le_inf (linear_pmap.le_Sup _ hf) (hg f hf),
 this.1
 
+protected lemma Sup_apply {c : set (E →ₗ.[R] F)} (hc : directed_on (≤) c)
+  {l : E →ₗ.[R] F} (hl : l ∈ c) (x : l.domain) :
+  (linear_pmap.Sup c hc) ⟨x, (linear_pmap.le_Sup hc hl).1 x.2⟩ = l x :=
+begin
+  symmetry,
+  apply (classical.some_spec (Sup_aux c hc) hl).2,
+  refl,
+end
+
 end linear_pmap
 
 namespace linear_map
 
 /-- Restrict a linear map to a submodule, reinterpreting the result as a `linear_pmap`. -/
-def to_pmap (f : E →ₗ[R] F) (p : submodule R E) : linear_pmap R E F :=
+def to_pmap (f : E →ₗ[R] F) (p : submodule R E) : E →ₗ.[R] F :=
 ⟨p, f.comp p.subtype⟩
 
 @[simp] lemma to_pmap_apply (f : E →ₗ[R] F) (p : submodule R E) (x : p) :
   f.to_pmap p x = f x := rfl
 
+@[simp] lemma to_pmap_domain (f : E →ₗ[R] F) (p : submodule R E) : (f.to_pmap p).domain = p := rfl
+
 /-- Compose a linear map with a `linear_pmap` -/
-def comp_pmap (g : F →ₗ[R] G) (f : linear_pmap R E F) : linear_pmap R E G :=
+def comp_pmap (g : F →ₗ[R] G) (f : E →ₗ.[R] F) : E →ₗ.[R] G :=
 { domain := f.domain,
   to_fun := g.comp f.to_fun }
 
-@[simp] lemma comp_pmap_apply (g : F →ₗ[R] G) (f : linear_pmap R E F) (x) :
+@[simp] lemma comp_pmap_apply (g : F →ₗ[R] G) (f : E →ₗ.[R] F) (x) :
   g.comp_pmap f x = g (f x) := rfl
 
 end linear_map
@@ -395,27 +485,313 @@ end linear_map
 namespace linear_pmap
 
 /-- Restrict codomain of a `linear_pmap` -/
-def cod_restrict (f : linear_pmap R E F) (p : submodule R F) (H : ∀ x, f x ∈ p) :
-  linear_pmap R E p :=
+def cod_restrict (f : E →ₗ.[R] F) (p : submodule R F) (H : ∀ x, f x ∈ p) : E →ₗ.[R] p :=
 { domain := f.domain,
   to_fun := f.to_fun.cod_restrict p H }
 
 /-- Compose two `linear_pmap`s -/
-def comp (g : linear_pmap R F G) (f : linear_pmap R E F)
-  (H : ∀ x : f.domain, f x ∈ g.domain) :
-  linear_pmap R E G :=
+def comp (g : F →ₗ.[R] G) (f : E →ₗ.[R] F)
+  (H : ∀ x : f.domain, f x ∈ g.domain) : E →ₗ.[R] G :=
 g.to_fun.comp_pmap $ f.cod_restrict _ H
 
 /-- `f.coprod g` is the partially defined linear map defined on `f.domain × g.domain`,
 and sending `p` to `f p.1 + g p.2`. -/
-def coprod (f : linear_pmap R E G) (g : linear_pmap R F G) :
-  linear_pmap R (E × F) G :=
+def coprod (f : E →ₗ.[R] G) (g : F →ₗ.[R] G) : (E × F) →ₗ.[R] G :=
 { domain := f.domain.prod g.domain,
   to_fun := (f.comp (linear_pmap.fst f.domain g.domain) (λ x, x.2.1)).to_fun +
     (g.comp (linear_pmap.snd f.domain g.domain) (λ x, x.2.2)).to_fun }
 
-@[simp] lemma coprod_apply (f : linear_pmap R E G) (g : linear_pmap R F G) (x) :
+@[simp] lemma coprod_apply (f : E →ₗ.[R] G) (g : F →ₗ.[R] G) (x) :
   f.coprod g x = f ⟨(x : E × F).1, x.2.1⟩ + g ⟨(x : E × F).2, x.2.2⟩ :=
 rfl
 
+/-- Restrict a partially defined linear map to a submodule of `E` contained in `f.domain`. -/
+def dom_restrict (f : E →ₗ.[R] F) (S : submodule R E) :
+  E →ₗ.[R] F :=
+⟨S ⊓ f.domain, f.to_fun.comp (submodule.of_le (by simp))⟩
+
+@[simp] lemma dom_restrict_domain (f : E →ₗ.[R] F) {S : submodule R E} :
+  (f.dom_restrict S).domain = S ⊓ f.domain := rfl
+
+lemma dom_restrict_apply {f : E →ₗ.[R] F} {S : submodule R E}
+  ⦃x : S ⊓ f.domain⦄ ⦃y : f.domain⦄ (h : (x : E) = y) :
+  f.dom_restrict S x = f y :=
+begin
+  have : submodule.of_le (by simp) x = y :=
+  by { ext, simp[h] },
+  rw ←this,
+  exact linear_pmap.mk_apply _ _ _,
+end
+
+lemma dom_restrict_le {f : E →ₗ.[R] F} {S : submodule R E} : f.dom_restrict S ≤ f :=
+⟨by simp, λ x y hxy, dom_restrict_apply hxy⟩
+
+/-! ### Graph -/
+section graph
+
+/-- The graph of a `linear_pmap` viewed as a submodule on `E × F`. -/
+def graph (f : E →ₗ.[R] F) : submodule R (E × F) :=
+f.to_fun.graph.map (f.domain.subtype.prod_map (linear_map.id : F →ₗ[R] F))
+
+lemma mem_graph_iff' (f : E →ₗ.[R] F) {x : E × F} :
+  x ∈ f.graph ↔ ∃ y : f.domain, (↑y, f y) = x :=
+by simp [graph]
+
+@[simp] lemma mem_graph_iff (f : E →ₗ.[R] F) {x : E × F} :
+  x ∈ f.graph ↔ ∃ y : f.domain, (↑y : E) = x.1 ∧ f y = x.2 :=
+by { cases x, simp_rw [mem_graph_iff', prod.mk.inj_iff] }
+
+/-- The tuple `(x, f x)` is contained in the graph of `f`. -/
+lemma mem_graph (f : E →ₗ.[R] F) (x : domain f) : ((x : E), f x) ∈ f.graph :=
+by simp
+
+variables {M : Type*} [monoid M] [distrib_mul_action M F] [smul_comm_class R M F] (y : M)
+
+/-- The graph of `z • f` as a pushforward. -/
+lemma smul_graph (f : E →ₗ.[R] F) (z : M) :
+  (z • f).graph =
+    f.graph.map ((linear_map.id : E →ₗ[R] E).prod_map (z • (linear_map.id : F →ₗ[R] F))) :=
+begin
+  ext x, cases x,
+  split; intros h,
+  { rw mem_graph_iff at h,
+    rcases h with ⟨y, hy, h⟩,
+    rw linear_pmap.smul_apply at h,
+    rw submodule.mem_map,
+    simp only [mem_graph_iff, linear_map.prod_map_apply, linear_map.id_coe, id.def,
+      linear_map.smul_apply, prod.mk.inj_iff, prod.exists, exists_exists_and_eq_and],
+    use [x_fst, y],
+    simp [hy, h] },
+  rw submodule.mem_map at h,
+  rcases h with ⟨x', hx', h⟩,
+  cases x',
+  simp only [linear_map.prod_map_apply, linear_map.id_coe, id.def, linear_map.smul_apply,
+    prod.mk.inj_iff] at h,
+  rw mem_graph_iff at hx' ⊢,
+  rcases hx' with ⟨y, hy, hx'⟩,
+  use y,
+  rw [←h.1, ←h.2],
+  simp[hy, hx'],
+end
+
+/-- The graph of `-f` as a pushforward. -/
+lemma neg_graph (f : E →ₗ.[R] F) :
+  (-f).graph = f.graph.map ((linear_map.id : E →ₗ[R] E).prod_map (-(linear_map.id : F →ₗ[R] F))) :=
+begin
+  ext, cases x,
+  split; intros h,
+  { rw mem_graph_iff at h,
+    rcases h with ⟨y, hy, h⟩,
+    rw linear_pmap.neg_apply at h,
+    rw submodule.mem_map,
+    simp only [mem_graph_iff, linear_map.prod_map_apply, linear_map.id_coe, id.def,
+      linear_map.neg_apply, prod.mk.inj_iff, prod.exists, exists_exists_and_eq_and],
+    use [x_fst, y],
+    simp [hy, h] },
+  rw submodule.mem_map at h,
+  rcases h with ⟨x', hx', h⟩,
+  cases x',
+  simp only [linear_map.prod_map_apply, linear_map.id_coe, id.def, linear_map.neg_apply,
+    prod.mk.inj_iff] at h,
+  rw mem_graph_iff at hx' ⊢,
+  rcases hx' with ⟨y, hy, hx'⟩,
+  use y,
+  rw [←h.1, ←h.2],
+  simp [hy, hx'],
+end
+
+lemma mem_graph_snd_inj (f : E →ₗ.[R] F) {x y : E} {x' y' : F} (hx : (x,x') ∈ f.graph)
+  (hy : (y,y') ∈ f.graph) (hxy : x = y) : x' = y' :=
+begin
+  rw [mem_graph_iff] at hx hy,
+  rcases hx with ⟨x'', hx1, hx2⟩,
+  rcases hy with ⟨y'', hy1, hy2⟩,
+  simp only at hx1 hx2 hy1 hy2,
+  rw [←hx1, ←hy1, set_like.coe_eq_coe] at hxy,
+  rw [←hx2, ←hy2, hxy],
+end
+
+lemma mem_graph_snd_inj' (f : E →ₗ.[R] F) {x y : E × F} (hx : x ∈ f.graph) (hy : y ∈ f.graph)
+  (hxy : x.1 = y.1) : x.2 = y.2 :=
+by { cases x, cases y, exact f.mem_graph_snd_inj hx hy hxy }
+
+/-- The property that `f 0 = 0` in terms of the graph. -/
+lemma graph_fst_eq_zero_snd (f : E →ₗ.[R] F) {x : E} {x' : F} (h : (x,x') ∈ f.graph)
+  (hx : x = 0) : x' = 0 :=
+f.mem_graph_snd_inj h f.graph.zero_mem hx
+
+lemma mem_domain_iff {f : E →ₗ.[R] F} {x : E} : x ∈ f.domain ↔ ∃ y : F, (x,y) ∈ f.graph :=
+begin
+  split; intro h,
+  { use f ⟨x, h⟩,
+    exact f.mem_graph ⟨x, h⟩ },
+  cases h with y h,
+  rw mem_graph_iff at h,
+  cases h with x' h,
+  simp only at h,
+  rw ←h.1,
+  simp,
+end
+
+lemma mem_domain_of_mem_graph {f : E →ₗ.[R] F} {x : E} {y : F} (h : (x,y) ∈ f.graph) :
+  x ∈ f.domain :=
+by { rw mem_domain_iff, exact ⟨y, h⟩ }
+
+lemma image_iff {f : E →ₗ.[R] F} {x : E} {y : F} (hx : x ∈ f.domain) :
+  y = f ⟨x, hx⟩ ↔ (x, y) ∈ f.graph :=
+begin
+  rw mem_graph_iff,
+  split; intro h,
+  { use ⟨x, hx⟩,
+    simp [h] },
+  rcases h with ⟨⟨x', hx'⟩, ⟨h1, h2⟩⟩,
+  simp only [submodule.coe_mk] at h1 h2,
+  simp only [←h2, h1],
+end
+
+lemma mem_range_iff {f : E →ₗ.[R] F} {y : F} : y ∈ set.range f ↔ ∃ x : E, (x,y) ∈ f.graph :=
+begin
+  split; intro h,
+  { rw set.mem_range at h,
+    rcases h with ⟨⟨x, hx⟩, h⟩,
+    use x,
+    rw ←h,
+    exact f.mem_graph ⟨x, hx⟩ },
+  cases h with x h,
+  rw mem_graph_iff at h,
+  cases h with x h,
+  rw set.mem_range,
+  use x,
+  simp only at h,
+  rw h.2,
+end
+
+lemma mem_domain_iff_of_eq_graph {f g : E →ₗ.[R] F} (h : f.graph = g.graph) {x : E} :
+  x ∈ f.domain ↔ x ∈ g.domain :=
+by simp_rw [mem_domain_iff, h]
+
+lemma le_of_le_graph {f g : E →ₗ.[R] F} (h : f.graph ≤ g.graph) : f ≤ g :=
+begin
+  split,
+  { intros x hx,
+    rw mem_domain_iff at hx ⊢,
+    cases hx with y hx,
+    use y,
+    exact h hx },
+  rintros ⟨x, hx⟩ ⟨y, hy⟩ hxy,
+  rw image_iff,
+  refine h _,
+  simp only [submodule.coe_mk] at hxy,
+  rw hxy at hx,
+  rw ←image_iff hx,
+  simp [hxy],
+end
+
+lemma le_graph_of_le {f g : E →ₗ.[R] F} (h : f ≤ g) : f.graph ≤ g.graph :=
+begin
+  intros x hx,
+  rw mem_graph_iff at hx ⊢,
+  cases hx with y hx,
+  use y,
+  { exact h.1 y.2 },
+  simp only [hx, submodule.coe_mk, eq_self_iff_true, true_and],
+  convert hx.2,
+  refine (h.2 _).symm,
+  simp only [hx.1, submodule.coe_mk],
+end
+
+lemma le_graph_iff {f g : E →ₗ.[R] F} : f.graph ≤ g.graph ↔ f ≤ g :=
+⟨le_of_le_graph, le_graph_of_le⟩
+
+lemma eq_of_eq_graph {f g : E →ₗ.[R] F} (h : f.graph = g.graph) : f = g :=
+by {ext, exact mem_domain_iff_of_eq_graph h, exact (le_of_le_graph h.le).2 }
+
+end graph
+
 end linear_pmap
+
+namespace submodule
+
+section submodule_to_linear_pmap
+
+lemma exists_unique_from_graph {g : submodule R (E × F)}
+  (hg : ∀ {x : E × F} (hx : x ∈ g) (hx' : x.fst = 0), x.snd = 0) {a : E}
+  (ha : a ∈ g.map (linear_map.fst R E F)) :
+  ∃! (b : F), (a,b) ∈ g :=
+begin
+  refine exists_unique_of_exists_of_unique _ _,
+  { convert ha, simp },
+  intros y₁ y₂ hy₁ hy₂,
+  have hy : ((0 : E), y₁ - y₂) ∈ g :=
+  begin
+    convert g.sub_mem hy₁ hy₂,
+    exact (sub_self _).symm,
+  end,
+  exact sub_eq_zero.mp (hg hy (by simp)),
+end
+
+/-- Auxiliary definition to unfold the existential quantifier. -/
+noncomputable
+def val_from_graph {g : submodule R (E × F)}
+  (hg : ∀ (x : E × F) (hx : x ∈ g) (hx' : x.fst = 0), x.snd = 0) {a : E}
+  (ha : a ∈ g.map (linear_map.fst R E F)) : F :=
+(exists_of_exists_unique (exists_unique_from_graph hg ha)).some
+
+lemma val_from_graph_mem {g : submodule R (E × F)}
+  (hg : ∀ (x : E × F) (hx : x ∈ g) (hx' : x.fst = 0), x.snd = 0) {a : E}
+  (ha : a ∈ g.map (linear_map.fst R E F)) : (a, val_from_graph hg ha) ∈ g :=
+(exists_of_exists_unique (exists_unique_from_graph hg ha)).some_spec
+
+/-- Define a `linear_pmap` from its graph. -/
+noncomputable
+def to_linear_pmap (g : submodule R (E × F))
+  (hg : ∀ (x : E × F) (hx : x ∈ g) (hx' : x.fst = 0), x.snd = 0) : E →ₗ.[R] F :=
+{ domain := g.map (linear_map.fst R E F),
+  to_fun :=
+  { to_fun := λ x, val_from_graph hg x.2,
+    map_add' := λ v w, begin
+      have hadd := (g.map (linear_map.fst R E F)).add_mem v.2 w.2,
+      have hvw := val_from_graph_mem hg hadd,
+      have hvw' := g.add_mem (val_from_graph_mem hg v.2) (val_from_graph_mem hg w.2),
+      rw [prod.mk_add_mk] at hvw',
+      exact (exists_unique_from_graph hg hadd).unique hvw hvw',
+    end,
+    map_smul' := λ a v, begin
+      have hsmul := (g.map (linear_map.fst R E F)).smul_mem a v.2,
+      have hav := val_from_graph_mem hg hsmul,
+      have hav' := g.smul_mem a (val_from_graph_mem hg v.2),
+      rw [prod.smul_mk] at hav',
+      exact (exists_unique_from_graph hg hsmul).unique hav hav',
+    end } }
+
+lemma mem_graph_to_linear_pmap (g : submodule R (E × F))
+  (hg : ∀ (x : E × F) (hx : x ∈ g) (hx' : x.fst = 0), x.snd = 0)
+  (x : g.map (linear_map.fst R E F)) : (x.val, g.to_linear_pmap hg x) ∈ g :=
+val_from_graph_mem hg x.2
+
+@[simp] lemma to_linear_pmap_graph_eq (g : submodule R (E × F))
+  (hg : ∀ (x : E × F) (hx : x ∈ g) (hx' : x.fst = 0), x.snd = 0) :
+  (g.to_linear_pmap hg).graph = g :=
+begin
+  ext,
+  split; intro hx,
+  { rw [linear_pmap.mem_graph_iff] at hx,
+    rcases hx with ⟨y,hx1,hx2⟩,
+    convert g.mem_graph_to_linear_pmap hg y,
+    rw [subtype.val_eq_coe],
+    exact prod.ext hx1.symm hx2.symm },
+  rw linear_pmap.mem_graph_iff,
+  cases x,
+  have hx_fst : x_fst ∈ g.map (linear_map.fst R E F) :=
+  begin
+    simp only [mem_map, linear_map.fst_apply, prod.exists, exists_and_distrib_right,
+      exists_eq_right],
+    exact ⟨x_snd, hx⟩,
+  end,
+  refine ⟨⟨x_fst, hx_fst⟩, subtype.coe_mk x_fst hx_fst, _⟩,
+  exact (exists_unique_from_graph hg hx_fst).unique (val_from_graph_mem hg hx_fst) hx,
+end
+
+end submodule_to_linear_pmap
+
+end submodule
diff --git a/src/linear_algebra/matrix/absolute_value.lean b/src/linear_algebra/matrix/absolute_value.lean
index 3ebb90dbc68eb..38a7a0881fffe 100644
--- a/src/linear_algebra/matrix/absolute_value.lean
+++ b/src/linear_algebra/matrix/absolute_value.lean
@@ -9,6 +9,9 @@ import linear_algebra.matrix.determinant
 /-!
 # Absolute values and matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves some bounds on matrices involving absolute values.
 
 ## Main results
diff --git a/src/linear_algebra/matrix/adjugate.lean b/src/linear_algebra/matrix/adjugate.lean
index bb95ae9e35f13..d2877ef3ef6fa 100644
--- a/src/linear_algebra/matrix/adjugate.lean
+++ b/src/linear_algebra/matrix/adjugate.lean
@@ -3,17 +3,17 @@ Copyright (c) 2019 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
-import algebra.associated
 import algebra.regular.basic
 import linear_algebra.matrix.mv_polynomial
 import linear_algebra.matrix.polynomial
 import ring_theory.polynomial.basic
-import tactic.linarith
-import tactic.ring_exp
 
 /-!
 # Cramer's rule and adjugate matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The adjugate matrix is the transpose of the cofactor matrix.
 It is calculated with Cramer's rule, which we introduce first.
 The vectors returned by Cramer's rule are given by the linear map `cramer`,
@@ -21,10 +21,10 @@ which sends a matrix `A` and vector `b` to the vector consisting of the
 determinant of replacing the `i`th column of `A` with `b` at index `i`
 (written as `(A.update_column i b).det`).
 Using Cramer's rule, we can compute for each matrix `A` the matrix `adjugate A`.
-The entries of the adjugate are the determinants of each minor of `A`.
-Instead of defining a minor to be `A` with row `i` and column `j` deleted, we
-replace the `i`th row of `A` with the `j`th basis vector; this has the same
-determinant as the minor but more importantly equals Cramer's rule applied
+The entries of the adjugate are the minors of `A`.
+Instead of defining a minor by deleting row `i` and column `j` of `A`, we
+replace the `i`th row of `A` with the `j`th basis vector; the resulting matrix
+has the same determinant but more importantly equals Cramer's rule applied
 to `A` and the `j`th basis vector, simplifying the subsequent proofs.
 We prove the adjugate behaves like `det A • A⁻¹`.
 
@@ -43,8 +43,9 @@ cramer, cramer's rule, adjugate
 -/
 
 namespace matrix
-universes u v
-variables {n : Type u} [decidable_eq n] [fintype n] {α : Type v} [comm_ring α]
+universes u v w
+variables {m : Type u} {n : Type v} {α : Type w}
+variables [decidable_eq n] [fintype n] [decidable_eq m] [fintype m] [comm_ring α]
 open_locale matrix big_operators polynomial
 open equiv equiv.perm finset
 
@@ -101,7 +102,7 @@ begin
   split_ifs with h,
   { -- i = j: this entry should be `A.det`
     subst h,
-    simp only [update_column_transpose, det_transpose, update_row, function.update_eq_self] },
+    simp only [update_column_transpose, det_transpose, update_row_eq_self] },
   { -- i ≠ j: this entry should be 0
     rw [update_column_transpose, det_transpose],
     apply det_zero_of_row_eq h,
@@ -154,6 +155,18 @@ calc ∑ x in s, cramer A (λ j, f j x) i
 ... = cramer A (λ (j : n), ∑ x in s, f j x) i :
   by { rw [sum_cramer, cramer_apply], congr' with j, apply finset.sum_apply }
 
+lemma cramer_submatrix_equiv (A : matrix m m α) (e : n ≃ m) (b : n → α) :
+  cramer (A.submatrix e e) b = cramer A (b ∘ e.symm) ∘ e :=
+begin
+  ext i,
+  simp_rw [function.comp_apply, cramer_apply, update_column_submatrix_equiv,
+    det_submatrix_equiv_self e],
+end
+
+lemma cramer_reindex (e : m ≃ n) (A : matrix m m α) (b : n → α) :
+  cramer (reindex e e A) b = cramer A (b ∘ e) ∘ e.symm :=
+cramer_submatrix_equiv _ _ _
+
 end cramer
 
 section adjugate
@@ -166,20 +179,21 @@ These will hold for any matrix over a commutative ring.
 
 /-- The adjugate matrix is the transpose of the cofactor matrix.
 
-  Typically, the cofactor matrix is defined by taking the determinant of minors,
-  i.e. the matrix with a row and column removed.
-  However, the proof of `mul_adjugate` becomes a lot easier if we define the
-  minor as replacing a column with a basis vector, since it allows us to use
+  Typically, the cofactor matrix is defined by taking minors,
+  i.e. the determinant of the matrix with a row and column removed.
+  However, the proof of `mul_adjugate` becomes a lot easier if we use the
+  matrix replacing a column with a basis vector, since it allows us to use
   facts about the `cramer` map.
 -/
-def adjugate (A : matrix n n α) : matrix n n α := λ i, cramer Aᵀ (pi.single i 1)
+def adjugate (A : matrix n n α) : matrix n n α :=
+of $ λ i, cramer Aᵀ (pi.single i 1)
 
 lemma adjugate_def (A : matrix n n α) :
-  adjugate A = λ i, cramer Aᵀ (pi.single i 1) := rfl
+  adjugate A = of (λ i, cramer Aᵀ (pi.single i 1)) := rfl
 
 lemma adjugate_apply (A : matrix n n α) (i j : n) :
   adjugate A i j = (A.update_row j (pi.single i 1)).det :=
-by { rw adjugate_def, simp only, rw [cramer_apply, update_column_transpose, det_transpose], }
+by rw [adjugate_def, of_apply, cramer_apply, update_column_transpose, det_transpose]
 
 lemma adjugate_transpose (A : matrix n n α) : (adjugate A)ᵀ = adjugate (Aᵀ) :=
 begin
@@ -212,6 +226,20 @@ begin
     exact h ((symm_apply_eq σ).mp h') }
 end
 
+@[simp] lemma adjugate_submatrix_equiv_self (e : n ≃ m) (A : matrix m m α) :
+  adjugate (A.submatrix e e) = (adjugate A).submatrix e e :=
+begin
+  ext i j,
+  rw [adjugate_apply, submatrix_apply, adjugate_apply, ← det_submatrix_equiv_self e,
+    update_row_submatrix_equiv],
+  congr,
+  exact function.update_comp_equiv _ e.symm _ _,
+end
+
+lemma adjugate_reindex (e : m ≃ n) (A : matrix m m α) :
+  adjugate (reindex e e A) = reindex e e (adjugate A) :=
+adjugate_submatrix_equiv_self _ _
+
 /-- Since the map `b ↦ cramer A b` is linear in `b`, it must be multiplication by some matrix. This
 matrix is `A.adjugate`. -/
 lemma cramer_eq_adjugate_mul_vec (A : matrix n n α) (b : n → α) :
@@ -220,7 +248,7 @@ begin
   nth_rewrite 1 ← A.transpose_transpose,
   rw [← adjugate_transpose, adjugate_def],
   have : b = ∑ i, (b i) • (pi.single i 1),
-  { refine (pi_eq_sum_univ b).trans _, congr' with j, simp [pi.single_apply, eq_comm], congr, },
+  { refine (pi_eq_sum_univ b).trans _, congr' with j, simp [pi.single_apply, eq_comm] },
   nth_rewrite 0 this, ext k,
   simp [mul_vec, dot_product, mul_comm],
 end
@@ -285,7 +313,7 @@ by { ext, simp [adjugate_def, matrix.one_apply, pi.single_apply, eq_comm] }
   adjugate (diagonal v) = diagonal (λ i, ∏ j in finset.univ.erase i, v j) :=
 begin
   ext,
-  simp only [adjugate_def, cramer_apply, diagonal_transpose],
+  simp only [adjugate_def, cramer_apply, diagonal_transpose, of_apply],
   obtain rfl | hij := eq_or_ne i j,
   { rw [diagonal_apply_eq, diagonal_update_column_single, det_diagonal,
       prod_update_of_mem (finset.mem_univ _), sdiff_singleton_eq_erase, one_mul] },
@@ -312,7 +340,6 @@ lemma _root_.alg_hom.map_adjugate {R A B : Type*} [comm_semiring R] [comm_ring A
   (M : matrix n n A) : f.map_matrix M.adjugate = matrix.adjugate (f.map_matrix M) :=
 f.to_ring_hom.map_adjugate _
 
-
 lemma det_adjugate (A : matrix n n α) : (adjugate A).det = A.det ^ (fintype.card n - 1) :=
 begin
   -- get rid of the `- 1`
@@ -336,26 +363,56 @@ begin
 end
 
 @[simp] lemma adjugate_fin_zero (A : matrix (fin 0) (fin 0) α) : adjugate A = 0 :=
-@subsingleton.elim _ matrix.subsingleton_of_empty_left _ _
+subsingleton.elim _ _
 
 @[simp] lemma adjugate_fin_one (A : matrix (fin 1) (fin 1) α) : adjugate A = 1 :=
 adjugate_subsingleton A
 
 lemma adjugate_fin_two (A : matrix (fin 2) (fin 2) α) :
-  adjugate A = ![![A 1 1, -A 0 1], ![-A 1 0, A 0 0]] :=
+  adjugate A = !![A 1 1, -A 0 1; -A 1 0, A 0 0] :=
 begin
   ext i j,
   rw [adjugate_apply, det_fin_two],
-  fin_cases i with [0, 1]; fin_cases j with [0, 1];
-  simp only [nat.one_ne_zero, one_mul, fin.one_eq_zero_iff, pi.single_eq_same, zero_mul,
-    fin.zero_eq_one_iff, sub_zero, pi.single_eq_of_ne, ne.def, not_false_iff, update_row_self,
-    update_row_ne, cons_val_zero, mul_zero, mul_one, zero_sub, cons_val_one, head_cons],
+  fin_cases i; fin_cases j;
+  simp only [one_mul, fin.one_eq_zero_iff, pi.single_eq_same, mul_zero, sub_zero,
+    pi.single_eq_of_ne, ne.def, not_false_iff, update_row_self, update_row_ne, cons_val_zero,
+    of_apply, nat.succ_succ_ne_one, pi.single_eq_of_ne, update_row_self, pi.single_eq_of_ne, ne.def,
+    fin.zero_eq_one_iff, nat.succ_succ_ne_one, not_false_iff, update_row_ne, fin.one_eq_zero_iff,
+    zero_mul, pi.single_eq_same, one_mul, zero_sub, of_apply, cons_val', cons_val_fin_one,
+    cons_val_one, head_fin_const, neg_inj, eq_self_iff_true, cons_val_zero, head_cons, mul_one]
 end
 
-@[simp] lemma adjugate_fin_two' (a b c d : α) :
-  adjugate ![![a, b], ![c, d]] = ![![d, -b], ![-c, a]] :=
+@[simp] lemma adjugate_fin_two_of (a b c d : α) :
+  adjugate !![a, b; c, d] = !![d, -b; -c, a] :=
 adjugate_fin_two _
 
+lemma adjugate_fin_succ_eq_det_submatrix {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) α) (i j) :
+  adjugate A i j = (-1)^(j + i : ℕ) * det (A.submatrix j.succ_above i.succ_above) :=
+begin
+  simp_rw [adjugate_apply, det_succ_row _ j, update_row_self, submatrix_update_row_succ_above],
+  rw [fintype.sum_eq_single i (λ h hjk, _), pi.single_eq_same, mul_one],
+  rw [pi.single_eq_of_ne hjk, mul_zero, zero_mul],
+end
+
+lemma det_eq_sum_mul_adjugate_row (A : matrix n n α) (i : n) :
+  det A = ∑ j : n, A i j * adjugate A j i :=
+begin
+  haveI : nonempty n := ⟨i⟩,
+  obtain ⟨n', hn'⟩ := nat.exists_eq_succ_of_ne_zero (fintype.card_ne_zero : fintype.card n ≠ 0),
+  obtain ⟨e⟩ := fintype.trunc_equiv_fin_of_card_eq hn',
+  let A' := reindex e e A,
+  suffices : det A' = ∑ j : fin n'.succ, A' (e i) j * adjugate A' j (e i),
+  { simp_rw [A', det_reindex_self, adjugate_reindex, reindex_apply, submatrix_apply, ←e.sum_comp,
+      equiv.symm_apply_apply] at this,
+    exact this },
+  rw det_succ_row A' (e i),
+  simp_rw [mul_assoc, mul_left_comm _ (A' _ _), ←adjugate_fin_succ_eq_det_submatrix],
+end
+
+lemma det_eq_sum_mul_adjugate_col (A : matrix n n α) (j : n) :
+  det A = ∑ i : n, A i j * adjugate A j i :=
+by simpa only [det_transpose, ←adjugate_transpose] using det_eq_sum_mul_adjugate_row Aᵀ j
+
 lemma adjugate_conj_transpose [star_ring α] (A : matrix n n α) : A.adjugateᴴ = adjugate (Aᴴ) :=
 begin
   dsimp only [conj_transpose],
@@ -442,7 +499,7 @@ begin
   -- get rid of the `- 2`
   cases h_card : (fintype.card n) with n',
   { haveI : is_empty n := fintype.card_eq_zero_iff.mp h_card,
-    exact @subsingleton.elim _ (matrix.subsingleton_of_empty_left) _ _, },
+    apply subsingleton.elim, },
   cases n',
   { exact (h h_card).elim },
   rw ←h_card,
diff --git a/src/linear_algebra/matrix/basis.lean b/src/linear_algebra/matrix/basis.lean
index c5656aa7ad44e..972b50dded8c5 100644
--- a/src/linear_algebra/matrix/basis.lean
+++ b/src/linear_algebra/matrix/basis.lean
@@ -9,6 +9,9 @@ import linear_algebra.matrix.to_lin
 /-!
 # Bases and matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the map `basis.to_matrix` that sends a family of vectors to
 the matrix of their coordinates with respect to some basis.
 
@@ -38,7 +41,8 @@ open_locale matrix
 section basis_to_matrix
 
 variables {ι ι' κ κ' : Type*}
-variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
+variables {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]
+variables {R₂ M₂ : Type*} [comm_ring R₂] [add_comm_group M₂] [module R₂ M₂]
 
 open function matrix
 
@@ -70,7 +74,7 @@ by { ext M i j, refl, }
 begin
   rw basis.to_matrix,
   ext i j,
-  simp [basis.equiv_fun, matrix.one_apply, finsupp.single, eq_comm]
+  simp [basis.equiv_fun, matrix.one_apply, finsupp.single_apply, eq_comm]
 end
 
 lemma to_matrix_update [decidable_eq ι'] (x : M) :
@@ -84,7 +88,7 @@ begin
 end
 
 /-- The basis constructed by `units_smul` has vectors given by a diagonal matrix. -/
-@[simp] lemma to_matrix_units_smul [decidable_eq ι] (w : ι → Rˣ) :
+@[simp] lemma to_matrix_units_smul [decidable_eq ι] (e : basis ι R₂ M₂) (w : ι → R₂ˣ) :
   e.to_matrix (e.units_smul w) = diagonal (coe ∘ w) :=
 begin
   ext i j,
@@ -94,7 +98,8 @@ begin
 end
 
 /-- The basis constructed by `is_unit_smul` has vectors given by a diagonal matrix. -/
-@[simp] lemma to_matrix_is_unit_smul [decidable_eq ι] {w : ι → R} (hw : ∀ i, is_unit (w i)) :
+@[simp] lemma to_matrix_is_unit_smul [decidable_eq ι] (e : basis ι R₂ M₂) {w : ι → R₂}
+  (hw : ∀ i, is_unit (w i)) :
   e.to_matrix (e.is_unit_smul hw) = diagonal w :=
 e.to_matrix_units_smul _
 
@@ -147,7 +152,7 @@ end basis
 
 section mul_linear_map_to_matrix
 
-variables {N : Type*} [add_comm_group N] [module R N]
+variables {N : Type*} [add_comm_monoid N] [module R N]
 variables (b : basis ι R M) (b' : basis ι' R M) (c : basis κ R N) (c' : basis κ' R N)
 variables (f : M →ₗ[R] N)
 
@@ -175,6 +180,32 @@ lemma basis_to_matrix_mul_linear_map_to_matrix_mul_basis_to_matrix
   c.to_matrix c' ⬝ linear_map.to_matrix b' c' f ⬝ b'.to_matrix b = linear_map.to_matrix b c f :=
 by rw [basis_to_matrix_mul_linear_map_to_matrix, linear_map_to_matrix_mul_basis_to_matrix]
 
+lemma basis_to_matrix_mul [decidable_eq κ]
+    (b₁ : basis ι R M) (b₂ : basis ι' R M) (b₃ : basis κ R N) (A : matrix ι' κ R) :
+  b₁.to_matrix b₂ ⬝ A = linear_map.to_matrix b₃ b₁ (to_lin b₃ b₂ A) :=
+begin
+  have := basis_to_matrix_mul_linear_map_to_matrix b₃ b₁ b₂ (matrix.to_lin b₃ b₂ A),
+  rwa [linear_map.to_matrix_to_lin] at this
+end
+
+lemma mul_basis_to_matrix [decidable_eq ι] [decidable_eq ι']
+    (b₁ : basis ι R M) (b₂ : basis ι' R M) (b₃ : basis κ R N) (A : matrix κ ι R) :
+  A ⬝ b₁.to_matrix b₂ = linear_map.to_matrix b₂ b₃ (to_lin b₁ b₃ A) :=
+begin
+  have := linear_map_to_matrix_mul_basis_to_matrix b₂ b₁ b₃ (matrix.to_lin b₁ b₃ A),
+  rwa [linear_map.to_matrix_to_lin] at this
+end
+
+lemma basis_to_matrix_basis_fun_mul (b : basis ι R (ι → R)) (A : matrix ι ι R) :
+  b.to_matrix (pi.basis_fun R ι) ⬝ A = of (λ i j, b.repr (Aᵀ j) i) :=
+begin
+  classical,
+  simp only [basis_to_matrix_mul _ _ (pi.basis_fun R ι), matrix.to_lin_eq_to_lin'],
+  ext i j,
+  rw [linear_map.to_matrix_apply, matrix.to_lin'_apply, pi.basis_fun_apply,
+    matrix.mul_vec_std_basis_apply, matrix.of_apply]
+end
+
 /-- A generalization of `linear_map.to_matrix_id`. -/
 @[simp] lemma linear_map.to_matrix_id_eq_basis_to_matrix [decidable_eq ι] :
   linear_map.to_matrix b b' id = b'.to_matrix b :=
@@ -185,8 +216,9 @@ by { haveI := classical.dec_eq ι',
 lemma basis.to_matrix_reindex' [decidable_eq ι] [decidable_eq ι']
   (b : basis ι R M) (v : ι' → M) (e : ι ≃ ι') :
   (b.reindex e).to_matrix v = matrix.reindex_alg_equiv _ e (b.to_matrix (v ∘ e)) :=
-by { ext, simp only [basis.to_matrix_apply, basis.reindex_repr, matrix.reindex_alg_equiv_apply,
-        matrix.reindex_apply, matrix.minor_apply, function.comp_app, e.apply_symm_apply] }
+by { ext, simp only [basis.to_matrix_apply, basis.repr_reindex, matrix.reindex_alg_equiv_apply,
+        matrix.reindex_apply, matrix.submatrix_apply, function.comp_app, e.apply_symm_apply,
+        finsupp.map_domain_equiv_apply] }
 
 end fintype
 
@@ -206,11 +238,17 @@ lemma basis.to_matrix_mul_to_matrix_flip [decidable_eq ι] [fintype ι'] :
   b.to_matrix b' ⬝ b'.to_matrix b = 1 :=
 by rw [basis.to_matrix_mul_to_matrix, basis.to_matrix_self]
 
+/-- A matrix whose columns form a basis `b'`, expressed w.r.t. a basis `b`, is invertible. -/
+def basis.invertible_to_matrix [decidable_eq ι] [fintype ι] (b b' : basis ι R₂ M₂) :
+  invertible (b.to_matrix b') :=
+⟨b'.to_matrix b, basis.to_matrix_mul_to_matrix_flip _ _, basis.to_matrix_mul_to_matrix_flip _ _⟩
+
 @[simp]
 lemma basis.to_matrix_reindex
   (b : basis ι R M) (v : ι' → M) (e : ι ≃ ι') :
-  (b.reindex e).to_matrix v = (b.to_matrix v).minor e.symm id :=
-by { ext, simp only [basis.to_matrix_apply, basis.reindex_repr, matrix.minor_apply, id.def] }
+  (b.reindex e).to_matrix v = (b.to_matrix v).submatrix e.symm id :=
+by { ext, simp only [basis.to_matrix_apply, basis.repr_reindex, matrix.submatrix_apply, id.def,
+  finsupp.map_domain_equiv_apply] }
 
 @[simp]
 lemma basis.to_matrix_map (b : basis ι R M) (f : M ≃ₗ[R] N) (v : ι → N) :
diff --git a/src/linear_algebra/matrix/bilinear_form.lean b/src/linear_algebra/matrix/bilinear_form.lean
index 29f68aba76bd8..ea6878ba4f3d3 100644
--- a/src/linear_algebra/matrix/bilinear_form.lean
+++ b/src/linear_algebra/matrix/bilinear_form.lean
@@ -9,10 +9,14 @@ import linear_algebra.matrix.nondegenerate
 import linear_algebra.matrix.nonsingular_inverse
 import linear_algebra.matrix.to_linear_equiv
 import linear_algebra.bilinear_form
+import linear_algebra.matrix.sesquilinear_form
 
 /-!
 # Bilinear form
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the conversion between bilinear forms and matrices.
 
 ## Main definitions
@@ -87,54 +91,58 @@ end
 
 This is an auxiliary definition for the equivalence `matrix.to_bilin_form'`. -/
 def bilin_form.to_matrix_aux (b : n → M₂) : bilin_form R₂ M₂ →ₗ[R₂] matrix n n R₂ :=
-{ to_fun := λ B i j, B (b i) (b j),
+{ to_fun := λ B, of $ λ i j, B (b i) (b j),
   map_add' := λ f g, rfl,
   map_smul' := λ f g, rfl }
 
+@[simp] lemma bilin_form.to_matrix_aux_apply (B : bilin_form R₂ M₂) (b : n → M₂) (i j : n) :
+  bilin_form.to_matrix_aux b B i j = B (b i) (b j) := rfl
+
 variables [fintype n] [fintype o]
 
-lemma to_bilin'_aux_to_matrix_aux [decidable_eq n] (B₃ : bilin_form R₃ (n → R₃)) :
-  matrix.to_bilin'_aux (bilin_form.to_matrix_aux (λ j, std_basis R₃ (λ _, R₃) j 1) B₃) = B₃ :=
+lemma to_bilin'_aux_to_matrix_aux [decidable_eq n] (B₂ : bilin_form R₂ (n → R₂)) :
+  matrix.to_bilin'_aux (bilin_form.to_matrix_aux (λ j, std_basis R₂ (λ _, R₂) j 1) B₂) = B₂ :=
 begin
-  refine ext_basis (pi.basis_fun R₃ n) (λ i j, _),
-  rw [bilin_form.to_matrix_aux, linear_map.coe_mk, pi.basis_fun_apply, pi.basis_fun_apply,
-      matrix.to_bilin'_aux_std_basis]
+  refine ext_basis (pi.basis_fun R₂ n) (λ i j, _),
+  rw [pi.basis_fun_apply, pi.basis_fun_apply, matrix.to_bilin'_aux_std_basis,
+    bilin_form.to_matrix_aux_apply]
 end
 
 section to_matrix'
 
 /-! ### `to_matrix'` section
 
-This section deals with the conversion between matrices and bilinear forms on `n → R₃`.
+This section deals with the conversion between matrices and bilinear forms on `n → R₂`.
 -/
 
 variables [decidable_eq n] [decidable_eq o]
 
 /-- The linear equivalence between bilinear forms on `n → R` and `n × n` matrices -/
-def bilin_form.to_matrix' : bilin_form R₃ (n → R₃) ≃ₗ[R₃] matrix n n R₃ :=
+def bilin_form.to_matrix' : bilin_form R₂ (n → R₂) ≃ₗ[R₂] matrix n n R₂ :=
 { inv_fun := matrix.to_bilin'_aux,
   left_inv := by convert to_bilin'_aux_to_matrix_aux,
   right_inv := λ M,
-    by { ext i j, simp only [bilin_form.to_matrix_aux, matrix.to_bilin'_aux_std_basis] },
-  ..bilin_form.to_matrix_aux (λ j, std_basis R₃ (λ _, R₃) j 1) }
+    by { ext i j, simp only [to_fun_eq_coe, bilin_form.to_matrix_aux_apply,
+      matrix.to_bilin'_aux_std_basis] },
+  ..bilin_form.to_matrix_aux (λ j, std_basis R₂ (λ _, R₂) j 1) }
 
-@[simp] lemma bilin_form.to_matrix_aux_std_basis (B : bilin_form R₃ (n → R₃)) :
-  bilin_form.to_matrix_aux (λ j, std_basis R₃ (λ _, R₃) j 1) B =
+@[simp] lemma bilin_form.to_matrix_aux_std_basis (B : bilin_form R₂ (n → R₂)) :
+  bilin_form.to_matrix_aux (λ j, std_basis R₂ (λ _, R₂) j 1) B =
     bilin_form.to_matrix' B :=
 rfl
 
 /-- The linear equivalence between `n × n` matrices and bilinear forms on `n → R` -/
-def matrix.to_bilin' : matrix n n R₃ ≃ₗ[R₃] bilin_form R₃ (n → R₃) :=
+def matrix.to_bilin' : matrix n n R₂ ≃ₗ[R₂] bilin_form R₂ (n → R₂) :=
 bilin_form.to_matrix'.symm
 
-@[simp] lemma matrix.to_bilin'_aux_eq (M : matrix n n R₃) :
+@[simp] lemma matrix.to_bilin'_aux_eq (M : matrix n n R₂) :
   matrix.to_bilin'_aux M = matrix.to_bilin' M :=
 rfl
 
-lemma matrix.to_bilin'_apply (M : matrix n n R₃) (x y : n → R₃) :
+lemma matrix.to_bilin'_apply (M : matrix n n R₂) (x y : n → R₂) :
   matrix.to_bilin' M x y = ∑ i j, x i * M i j * y j := rfl
 
-lemma matrix.to_bilin'_apply' (M : matrix n n R₃) (v w : n → R₃) :
+lemma matrix.to_bilin'_apply' (M : matrix n n R₂) (v w : n → R₂) :
   matrix.to_bilin' M v w = matrix.dot_product v (M.mul_vec w) :=
 begin
   simp_rw [matrix.to_bilin'_apply, matrix.dot_product,
@@ -145,41 +153,41 @@ begin
   rw ← mul_assoc,
 end
 
-@[simp] lemma matrix.to_bilin'_std_basis (M : matrix n n R₃) (i j : n) :
-  matrix.to_bilin' M (std_basis R₃ (λ _, R₃) i 1) (std_basis R₃ (λ _, R₃) j 1) =
+@[simp] lemma matrix.to_bilin'_std_basis (M : matrix n n R₂) (i j : n) :
+  matrix.to_bilin' M (std_basis R₂ (λ _, R₂) i 1) (std_basis R₂ (λ _, R₂) j 1) =
     M i j :=
 matrix.to_bilin'_aux_std_basis M i j
 
 @[simp] lemma bilin_form.to_matrix'_symm :
-  (bilin_form.to_matrix'.symm : matrix n n R₃ ≃ₗ[R₃] _) = matrix.to_bilin' :=
+  (bilin_form.to_matrix'.symm : matrix n n R₂ ≃ₗ[R₂] _) = matrix.to_bilin' :=
 rfl
 
 @[simp] lemma matrix.to_bilin'_symm :
-  (matrix.to_bilin'.symm : _ ≃ₗ[R₃] matrix n n R₃) = bilin_form.to_matrix' :=
+  (matrix.to_bilin'.symm : _ ≃ₗ[R₂] matrix n n R₂) = bilin_form.to_matrix' :=
 bilin_form.to_matrix'.symm_symm
 
-@[simp] lemma matrix.to_bilin'_to_matrix' (B : bilin_form R₃ (n → R₃)) :
+@[simp] lemma matrix.to_bilin'_to_matrix' (B : bilin_form R₂ (n → R₂)) :
   matrix.to_bilin' (bilin_form.to_matrix' B) = B :=
 matrix.to_bilin'.apply_symm_apply B
 
-@[simp] lemma bilin_form.to_matrix'_to_bilin' (M : matrix n n R₃) :
+@[simp] lemma bilin_form.to_matrix'_to_bilin' (M : matrix n n R₂) :
   bilin_form.to_matrix' (matrix.to_bilin' M) = M :=
 bilin_form.to_matrix'.apply_symm_apply M
 
-@[simp] lemma bilin_form.to_matrix'_apply (B : bilin_form R₃ (n → R₃)) (i j : n) :
+@[simp] lemma bilin_form.to_matrix'_apply (B : bilin_form R₂ (n → R₂)) (i j : n) :
   bilin_form.to_matrix' B i j =
-    B (std_basis R₃ (λ _, R₃) i 1) (std_basis R₃ (λ _, R₃) j 1) :=
+    B (std_basis R₂ (λ _, R₂) i 1) (std_basis R₂ (λ _, R₂) j 1) :=
 rfl
 
-@[simp] lemma bilin_form.to_matrix'_comp (B : bilin_form R₃ (n → R₃))
-  (l r : (o → R₃) →ₗ[R₃] (n → R₃)) :
+@[simp] lemma bilin_form.to_matrix'_comp (B : bilin_form R₂ (n → R₂))
+  (l r : (o → R₂) →ₗ[R₂] (n → R₂)) :
   (B.comp l r).to_matrix' = l.to_matrix'ᵀ ⬝ B.to_matrix' ⬝ r.to_matrix' :=
 begin
   ext i j,
   simp only [bilin_form.to_matrix'_apply, bilin_form.comp_apply, transpose_apply, matrix.mul_apply,
     linear_map.to_matrix', linear_equiv.coe_mk, sum_mul],
   rw sum_comm,
-  conv_lhs { rw ← bilin_form.sum_repr_mul_repr_mul (pi.basis_fun R₃ n) (l _) (r _) },
+  conv_lhs { rw ← bilin_form.sum_repr_mul_repr_mul (pi.basis_fun R₂ n) (l _) (r _) },
   rw finsupp.sum_fintype,
   { apply sum_congr rfl,
     rintros i' -,
@@ -187,34 +195,34 @@ begin
     { apply sum_congr rfl,
       rintros j' -,
       simp only [smul_eq_mul, pi.basis_fun_repr, mul_assoc, mul_comm, mul_left_comm,
-                 pi.basis_fun_apply] },
+                 pi.basis_fun_apply, of_apply] },
     { intros, simp only [zero_smul, smul_zero] } },
   { intros, simp only [zero_smul, finsupp.sum_zero] }
 end
 
-lemma bilin_form.to_matrix'_comp_left (B : bilin_form R₃ (n → R₃))
-  (f : (n → R₃) →ₗ[R₃] (n → R₃)) : (B.comp_left f).to_matrix' = f.to_matrix'ᵀ ⬝ B.to_matrix' :=
+lemma bilin_form.to_matrix'_comp_left (B : bilin_form R₂ (n → R₂))
+  (f : (n → R₂) →ₗ[R₂] (n → R₂)) : (B.comp_left f).to_matrix' = f.to_matrix'ᵀ ⬝ B.to_matrix' :=
 by simp only [bilin_form.comp_left, bilin_form.to_matrix'_comp, to_matrix'_id, matrix.mul_one]
 
-lemma bilin_form.to_matrix'_comp_right (B : bilin_form R₃ (n → R₃))
-  (f : (n → R₃) →ₗ[R₃] (n → R₃)) : (B.comp_right f).to_matrix' = B.to_matrix' ⬝ f.to_matrix' :=
+lemma bilin_form.to_matrix'_comp_right (B : bilin_form R₂ (n → R₂))
+  (f : (n → R₂) →ₗ[R₂] (n → R₂)) : (B.comp_right f).to_matrix' = B.to_matrix' ⬝ f.to_matrix' :=
 by simp only [bilin_form.comp_right, bilin_form.to_matrix'_comp, to_matrix'_id,
               transpose_one, matrix.one_mul]
 
-lemma bilin_form.mul_to_matrix'_mul (B : bilin_form R₃ (n → R₃))
-  (M : matrix o n R₃) (N : matrix n o R₃) :
+lemma bilin_form.mul_to_matrix'_mul (B : bilin_form R₂ (n → R₂))
+  (M : matrix o n R₂) (N : matrix n o R₂) :
   M ⬝ B.to_matrix' ⬝ N = (B.comp Mᵀ.to_lin' N.to_lin').to_matrix' :=
 by simp only [B.to_matrix'_comp, transpose_transpose, to_matrix'_to_lin']
 
-lemma bilin_form.mul_to_matrix' (B : bilin_form R₃ (n → R₃)) (M : matrix n n R₃) :
+lemma bilin_form.mul_to_matrix' (B : bilin_form R₂ (n → R₂)) (M : matrix n n R₂) :
   M ⬝ B.to_matrix' = (B.comp_left Mᵀ.to_lin').to_matrix' :=
 by simp only [B.to_matrix'_comp_left, transpose_transpose, to_matrix'_to_lin']
 
-lemma bilin_form.to_matrix'_mul (B : bilin_form R₃ (n → R₃)) (M : matrix n n R₃) :
+lemma bilin_form.to_matrix'_mul (B : bilin_form R₂ (n → R₂)) (M : matrix n n R₂) :
   B.to_matrix' ⬝ M = (B.comp_right M.to_lin').to_matrix' :=
 by simp only [B.to_matrix'_comp_right, to_matrix'_to_lin']
 
-lemma matrix.to_bilin'_comp (M : matrix n n R₃) (P Q : matrix n o R₃) :
+lemma matrix.to_bilin'_comp (M : matrix n n R₂) (P Q : matrix n o R₂) :
   M.to_bilin'.comp P.to_lin' Q.to_lin' = (Pᵀ ⬝ M ⬝ Q).to_bilin' :=
 bilin_form.to_matrix'.injective
   (by simp only [bilin_form.to_matrix'_comp, bilin_form.to_matrix'_to_bilin', to_matrix'_to_lin'])
@@ -229,36 +237,24 @@ This section deals with the conversion between matrices and bilinear forms on
 a module with a fixed basis.
 -/
 
-variables [decidable_eq n] (b : basis n R₃ M₃)
+variables [decidable_eq n] (b : basis n R₂ M₂)
 
 /-- `bilin_form.to_matrix b` is the equivalence between `R`-bilinear forms on `M` and
 `n`-by-`n` matrices with entries in `R`, if `b` is an `R`-basis for `M`. -/
-noncomputable def bilin_form.to_matrix : bilin_form R₃ M₃ ≃ₗ[R₃] matrix n n R₃ :=
+noncomputable def bilin_form.to_matrix : bilin_form R₂ M₂ ≃ₗ[R₂] matrix n n R₂ :=
 (bilin_form.congr b.equiv_fun).trans bilin_form.to_matrix'
 
 /-- `bilin_form.to_matrix b` is the equivalence between `R`-bilinear forms on `M` and
 `n`-by-`n` matrices with entries in `R`, if `b` is an `R`-basis for `M`. -/
-noncomputable def matrix.to_bilin : matrix n n R₃ ≃ₗ[R₃] bilin_form R₃ M₃ :=
+noncomputable def matrix.to_bilin : matrix n n R₂ ≃ₗ[R₂] bilin_form R₂ M₂ :=
 (bilin_form.to_matrix b).symm
 
-@[simp] lemma basis.equiv_fun_symm_std_basis (i : n) :
-  b.equiv_fun.symm (std_basis R₃ (λ _, R₃) i 1) = b i :=
-begin
-  rw [b.equiv_fun_symm_apply, finset.sum_eq_single i],
-  { rw [std_basis_same, one_smul] },
-  { rintros j - hj,
-    rw [std_basis_ne _ _ _ _ hj, zero_smul] },
-  { intro,
-    have := mem_univ i,
-    contradiction }
-end
-
-@[simp] lemma bilin_form.to_matrix_apply (B : bilin_form R₃ M₃) (i j : n) :
+@[simp] lemma bilin_form.to_matrix_apply (B : bilin_form R₂ M₂) (i j : n) :
   bilin_form.to_matrix b B i j = B (b i) (b j) :=
 by rw [bilin_form.to_matrix, linear_equiv.trans_apply, bilin_form.to_matrix'_apply, congr_apply,
        b.equiv_fun_symm_std_basis, b.equiv_fun_symm_std_basis]
 
-@[simp] lemma matrix.to_bilin_apply (M : matrix n n R₃) (x y : M₃) :
+@[simp] lemma matrix.to_bilin_apply (M : matrix n n R₂) (x y : M₂) :
   matrix.to_bilin b M x y = ∑ i j, b.repr x i * M i j * b.repr y j :=
 begin
   rw [matrix.to_bilin, bilin_form.to_matrix, linear_equiv.symm_trans_apply, ← matrix.to_bilin'],
@@ -267,9 +263,9 @@ begin
 end
 
 -- Not a `simp` lemma since `bilin_form.to_matrix` needs an extra argument
-lemma bilinear_form.to_matrix_aux_eq (B : bilin_form R₃ M₃) :
+lemma bilinear_form.to_matrix_aux_eq (B : bilin_form R₂ M₂) :
   bilin_form.to_matrix_aux b B = bilin_form.to_matrix b B :=
-ext (λ i j, by rw [bilin_form.to_matrix_apply, bilin_form.to_matrix_aux, linear_map.coe_mk])
+ext (λ i j, by rw [bilin_form.to_matrix_apply, bilin_form.to_matrix_aux_apply])
 
 @[simp] lemma bilin_form.to_matrix_symm :
   (bilin_form.to_matrix b).symm = matrix.to_bilin b :=
@@ -280,29 +276,29 @@ rfl
 (bilin_form.to_matrix b).symm_symm
 
 lemma matrix.to_bilin_basis_fun :
-  matrix.to_bilin (pi.basis_fun R₃ n) = matrix.to_bilin' :=
+  matrix.to_bilin (pi.basis_fun R₂ n) = matrix.to_bilin' :=
 by { ext M, simp only [matrix.to_bilin_apply, matrix.to_bilin'_apply, pi.basis_fun_repr] }
 
 lemma bilin_form.to_matrix_basis_fun :
-  bilin_form.to_matrix (pi.basis_fun R₃ n) = bilin_form.to_matrix' :=
+  bilin_form.to_matrix (pi.basis_fun R₂ n) = bilin_form.to_matrix' :=
 by { ext B, rw [bilin_form.to_matrix_apply, bilin_form.to_matrix'_apply,
                 pi.basis_fun_apply, pi.basis_fun_apply] }
 
-@[simp] lemma matrix.to_bilin_to_matrix (B : bilin_form R₃ M₃) :
+@[simp] lemma matrix.to_bilin_to_matrix (B : bilin_form R₂ M₂) :
   matrix.to_bilin b (bilin_form.to_matrix b B) = B :=
 (matrix.to_bilin b).apply_symm_apply B
 
-@[simp] lemma bilin_form.to_matrix_to_bilin (M : matrix n n R₃) :
+@[simp] lemma bilin_form.to_matrix_to_bilin (M : matrix n n R₂) :
   bilin_form.to_matrix b (matrix.to_bilin b M) = M :=
 (bilin_form.to_matrix b).apply_symm_apply M
 
-variables {M₃' : Type*} [add_comm_group M₃'] [module R₃ M₃']
-variables (c : basis o R₃ M₃')
+variables {M₂' : Type*} [add_comm_monoid M₂'] [module R₂ M₂']
+variables (c : basis o R₂ M₂')
 variables [decidable_eq o]
 
 -- Cannot be a `simp` lemma because `b` must be inferred.
 lemma bilin_form.to_matrix_comp
-  (B : bilin_form R₃ M₃) (l r : M₃' →ₗ[R₃] M₃) :
+  (B : bilin_form R₂ M₂) (l r : M₂' →ₗ[R₂] M₂) :
   bilin_form.to_matrix c (B.comp l r) =
     (to_matrix c b l)ᵀ ⬝ bilin_form.to_matrix b B ⬝ to_matrix c b r :=
 begin
@@ -323,38 +319,38 @@ begin
   { intros, simp only [zero_smul, finsupp.sum_zero] }
 end
 
-lemma bilin_form.to_matrix_comp_left (B : bilin_form R₃ M₃) (f : M₃ →ₗ[R₃] M₃) :
+lemma bilin_form.to_matrix_comp_left (B : bilin_form R₂ M₂) (f : M₂ →ₗ[R₂] M₂) :
   bilin_form.to_matrix b (B.comp_left f) = (to_matrix b b f)ᵀ ⬝ bilin_form.to_matrix b B :=
 by simp only [comp_left, bilin_form.to_matrix_comp b b, to_matrix_id, matrix.mul_one]
 
-lemma bilin_form.to_matrix_comp_right (B : bilin_form R₃ M₃) (f : M₃ →ₗ[R₃] M₃) :
+lemma bilin_form.to_matrix_comp_right (B : bilin_form R₂ M₂) (f : M₂ →ₗ[R₂] M₂) :
   bilin_form.to_matrix b (B.comp_right f) = bilin_form.to_matrix b B ⬝ (to_matrix b b f) :=
 by simp only [bilin_form.comp_right, bilin_form.to_matrix_comp b b, to_matrix_id,
               transpose_one, matrix.one_mul]
 
 @[simp]
-lemma bilin_form.to_matrix_mul_basis_to_matrix (c : basis o R₃ M₃) (B : bilin_form R₃ M₃) :
+lemma bilin_form.to_matrix_mul_basis_to_matrix (c : basis o R₂ M₂) (B : bilin_form R₂ M₂) :
   (b.to_matrix c)ᵀ ⬝ bilin_form.to_matrix b B ⬝ b.to_matrix c = bilin_form.to_matrix c B :=
 by rw [← linear_map.to_matrix_id_eq_basis_to_matrix, ← bilin_form.to_matrix_comp,
        bilin_form.comp_id_id]
 
-lemma bilin_form.mul_to_matrix_mul (B : bilin_form R₃ M₃)
-  (M : matrix o n R₃) (N : matrix n o R₃) :
+lemma bilin_form.mul_to_matrix_mul (B : bilin_form R₂ M₂)
+  (M : matrix o n R₂) (N : matrix n o R₂) :
   M ⬝ bilin_form.to_matrix b B ⬝ N =
     bilin_form.to_matrix c (B.comp (to_lin c b Mᵀ) (to_lin c b N)) :=
 by simp only [B.to_matrix_comp b c, to_matrix_to_lin, transpose_transpose]
 
-lemma bilin_form.mul_to_matrix (B : bilin_form R₃ M₃) (M : matrix n n R₃) :
+lemma bilin_form.mul_to_matrix (B : bilin_form R₂ M₂) (M : matrix n n R₂) :
   M ⬝ bilin_form.to_matrix b B =
     bilin_form.to_matrix b (B.comp_left (to_lin b b Mᵀ)) :=
 by rw [B.to_matrix_comp_left b, to_matrix_to_lin, transpose_transpose]
 
-lemma bilin_form.to_matrix_mul (B : bilin_form R₃ M₃) (M : matrix n n R₃) :
+lemma bilin_form.to_matrix_mul (B : bilin_form R₂ M₂) (M : matrix n n R₂) :
   bilin_form.to_matrix b B ⬝ M =
     bilin_form.to_matrix b (B.comp_right (to_lin b b M)) :=
 by rw [B.to_matrix_comp_right b, to_matrix_to_lin]
 
-lemma matrix.to_bilin_comp (M : matrix n n R₃) (P Q : matrix n o R₃) :
+lemma matrix.to_bilin_comp (M : matrix n n R₂) (P Q : matrix n o R₂) :
   (matrix.to_bilin b M).comp (to_lin c b P) (to_lin c b Q) = matrix.to_bilin c (Pᵀ ⬝ M ⬝ Q) :=
 (bilin_form.to_matrix c).injective
   (by simp only [bilin_form.to_matrix_comp b c, bilin_form.to_matrix_to_bilin, to_matrix_to_lin])
@@ -369,18 +365,6 @@ variables {n : Type*} [fintype n]
 variables (b : basis n R₃ M₃)
 variables (J J₃ A A' : matrix n n R₃)
 
-/-- The condition for the square matrices `A`, `A'` to be an adjoint pair with respect to the square
-matrices `J`, `J₃`. -/
-def matrix.is_adjoint_pair := Aᵀ ⬝ J₃ = J ⬝ A'
-
-/-- The condition for a square matrix `A` to be self-adjoint with respect to the square matrix
-`J`. -/
-def matrix.is_self_adjoint := matrix.is_adjoint_pair J J A A
-
-/-- The condition for a square matrix `A` to be skew-adjoint with respect to the square matrix
-`J`. -/
-def matrix.is_skew_adjoint := matrix.is_adjoint_pair J J A (-A)
-
 @[simp] lemma is_adjoint_pair_to_bilin' [decidable_eq n] :
   bilin_form.is_adjoint_pair (matrix.to_bilin' J) (matrix.to_bilin' J₃)
       (matrix.to_lin' A) (matrix.to_lin' A') ↔
@@ -417,7 +401,7 @@ begin
   refl,
 end
 
-lemma matrix.is_adjoint_pair_equiv [decidable_eq n] (P : matrix n n R₃) (h : is_unit P) :
+lemma matrix.is_adjoint_pair_equiv' [decidable_eq n] (P : matrix n n R₃) (h : is_unit P) :
   (Pᵀ ⬝ J ⬝ P).is_adjoint_pair (Pᵀ ⬝ J ⬝ P) A A' ↔
     J.is_adjoint_pair J (P ⬝ A ⬝ P⁻¹) (P ⬝ A' ⬝ P⁻¹) :=
 have h' : is_unit P.det := P.is_unit_iff_is_unit_det.mp h,
@@ -440,45 +424,32 @@ variables [decidable_eq n]
 
 /-- The submodule of pair-self-adjoint matrices with respect to bilinear forms corresponding to
 given matrices `J`, `J₂`. -/
-def pair_self_adjoint_matrices_submodule : submodule R₃ (matrix n n R₃) :=
+def pair_self_adjoint_matrices_submodule' : submodule R₃ (matrix n n R₃) :=
 (bilin_form.is_pair_self_adjoint_submodule (matrix.to_bilin' J) (matrix.to_bilin' J₃)).map
   ((linear_map.to_matrix' : ((n → R₃) →ₗ[R₃] (n → R₃)) ≃ₗ[R₃] matrix n n R₃) :
   ((n → R₃) →ₗ[R₃] (n → R₃)) →ₗ[R₃] matrix n n R₃)
 
-@[simp] lemma mem_pair_self_adjoint_matrices_submodule :
+lemma mem_pair_self_adjoint_matrices_submodule' :
   A ∈ (pair_self_adjoint_matrices_submodule J J₃) ↔ matrix.is_adjoint_pair J J₃ A A :=
-begin
-  simp only [pair_self_adjoint_matrices_submodule, linear_equiv.coe_coe,
-    linear_map.to_matrix'_apply, submodule.mem_map, bilin_form.mem_is_pair_self_adjoint_submodule],
-  split,
-  { rintros ⟨f, hf, hA⟩,
-    have hf' : f = A.to_lin' := by rw [←hA, matrix.to_lin'_to_matrix'], rw hf' at hf,
-    rw ← is_adjoint_pair_to_bilin',
-    exact hf, },
-  { intros h, refine ⟨A.to_lin', _, linear_map.to_matrix'_to_lin' _⟩,
-    exact (is_adjoint_pair_to_bilin' _ _ _ _).mpr h, },
-end
+by simp only [mem_pair_self_adjoint_matrices_submodule]
 
 /-- The submodule of self-adjoint matrices with respect to the bilinear form corresponding to
 the matrix `J`. -/
-def self_adjoint_matrices_submodule : submodule R₃ (matrix n n R₃) :=
+def self_adjoint_matrices_submodule' : submodule R₃ (matrix n n R₃) :=
   pair_self_adjoint_matrices_submodule J J
 
-@[simp] lemma mem_self_adjoint_matrices_submodule :
+lemma mem_self_adjoint_matrices_submodule' :
   A ∈ self_adjoint_matrices_submodule J ↔ J.is_self_adjoint A :=
-by { erw mem_pair_self_adjoint_matrices_submodule, refl, }
+by simp only [mem_self_adjoint_matrices_submodule]
 
 /-- The submodule of skew-adjoint matrices with respect to the bilinear form corresponding to
 the matrix `J`. -/
-def skew_adjoint_matrices_submodule : submodule R₃ (matrix n n R₃) :=
+def skew_adjoint_matrices_submodule' : submodule R₃ (matrix n n R₃) :=
   pair_self_adjoint_matrices_submodule (-J) J
 
-@[simp] lemma mem_skew_adjoint_matrices_submodule :
+lemma mem_skew_adjoint_matrices_submodule' :
   A ∈ skew_adjoint_matrices_submodule J ↔ J.is_skew_adjoint A :=
-begin
-  erw mem_pair_self_adjoint_matrices_submodule,
-  simp [matrix.is_skew_adjoint, matrix.is_adjoint_pair],
-end
+by simp only [mem_skew_adjoint_matrices_submodule]
 
 end matrix_adjoints
 
@@ -492,8 +463,8 @@ open matrix
 variables {A : Type*} [comm_ring A] [is_domain A] [module A M₃] (B₃ : bilin_form A M₃)
 variables {ι : Type*} [decidable_eq ι] [fintype ι]
 
-lemma _root_.matrix.nondegenerate_to_bilin'_iff_nondegenerate_to_bilin {M : matrix ι ι R₃}
-  (b : basis ι R₃ M₃) : M.to_bilin'.nondegenerate ↔ (matrix.to_bilin b M).nondegenerate :=
+lemma _root_.matrix.nondegenerate_to_bilin'_iff_nondegenerate_to_bilin {M : matrix ι ι R₂}
+  (b : basis ι R₂ M₂) : M.to_bilin'.nondegenerate ↔ (matrix.to_bilin b M).nondegenerate :=
 (nondegenerate_congr_iff b.equiv_fun.symm).symm
 
 -- Lemmas transferring nondegeneracy between a matrix and its associated bilinear form
diff --git a/src/linear_algebra/matrix/block.lean b/src/linear_algebra/matrix/block.lean
index 459bb5a21b7f7..0b79438b9f1e0 100644
--- a/src/linear_algebra/matrix/block.lean
+++ b/src/linear_algebra/matrix/block.lean
@@ -4,24 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
 import linear_algebra.matrix.determinant
+import linear_algebra.matrix.nonsingular_inverse
 import tactic.fin_cases
 
 /-!
 # Block matrices and their determinant
 
-This file defines a predicate `matrix.block_triangular_matrix` saying a matrix
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines a predicate `matrix.block_triangular` saying a matrix
 is block triangular, and proves the value of the determinant for various
 matrices built out of blocks.
 
 ## Main definitions
 
- * `matrix.block_triangular_matrix` expresses that a `o` by `o` matrix is block triangular,
-   if the rows and columns are ordered according to some order `b : o → ℕ`
+ * `matrix.block_triangular` expresses that a `o` by `o` matrix is block triangular,
+   if the rows and columns are ordered according to some order `b : o → α`
 
 ## Main results
-  * `det_of_block_triangular_matrix`: the determinant of a block triangular matrix
+  * `matrix.det_of_block_triangular`: the determinant of a block triangular matrix
     is equal to the product of the determinants of all the blocks
-  * `det_of_upper_triangular` and `det_of_lower_triangular`: the determinant of
+  * `matrix.det_of_upper_triangular` and `matrix.det_of_lower_triangular`: the determinant of
     a triangular matrix is the product of the entries along the diagonal
 
 ## Tags
@@ -30,20 +34,124 @@ matrix, diagonal, det, block triangular
 
 -/
 
-open_locale big_operators
+open finset function order_dual
+open_locale big_operators matrix
 
 universes v
 
-variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
-variables {R : Type v} [comm_ring R]
+variables {α β m n o : Type*} {m' n' : α → Type*}
+variables {R : Type v} [comm_ring R] {M N : matrix m m R} {b : m → α}
 
 namespace matrix
 
+section has_lt
+variables [has_lt α]
+
+/-- Let `b` map rows and columns of a square matrix `M` to blocks indexed by `α`s. Then
+`block_triangular M n b` says the matrix is block triangular. -/
+def block_triangular (M : matrix m m R) (b : m → α) : Prop := ∀ ⦃i j⦄, b j < b i → M i j = 0
+
+@[simp] protected lemma block_triangular.submatrix {f : n → m} (h : M.block_triangular b) :
+  (M.submatrix f f).block_triangular (b ∘ f) :=
+λ i j hij, h hij
+
+lemma block_triangular_reindex_iff {b : n → α} {e : m ≃ n} :
+  (reindex e e M).block_triangular b ↔ M.block_triangular (b ∘ e) :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { convert h.submatrix,
+    simp only [reindex_apply, submatrix_submatrix, submatrix_id_id, equiv.symm_comp_self] },
+  { convert h.submatrix,
+    simp only [comp.assoc b e e.symm, equiv.self_comp_symm, comp.right_id] }
+end
+
+protected lemma block_triangular.transpose :
+  M.block_triangular b → Mᵀ.block_triangular (to_dual ∘ b) := swap
+
+@[simp] protected lemma block_triangular_transpose_iff {b : m → αᵒᵈ} :
+  Mᵀ.block_triangular b ↔ M.block_triangular (of_dual ∘ b) := forall_swap
+
+@[simp] lemma block_triangular_zero : block_triangular (0 : matrix m m R) b := λ i j h, rfl
+
+protected lemma block_triangular.neg (hM : block_triangular M b) : block_triangular (-M) b :=
+λ i j h, neg_eq_zero.2 $ hM h
+
+lemma block_triangular.add (hM : block_triangular M b) (hN : block_triangular N b) :
+  block_triangular (M + N) b :=
+λ i j h, by simp_rw [pi.add_apply, hM h, hN h, zero_add]
+
+lemma block_triangular.sub (hM : block_triangular M b) (hN : block_triangular N b) :
+  block_triangular (M - N) b :=
+λ i j h, by simp_rw [pi.sub_apply, hM h, hN h, sub_zero]
+
+end has_lt
+
+section preorder
+variables [preorder α]
+
+lemma block_triangular_diagonal [decidable_eq m] (d : m → R) :
+  block_triangular (diagonal d) b :=
+λ i j h, diagonal_apply_ne' d (λ h', ne_of_lt h (congr_arg _ h'))
+
+lemma block_triangular_block_diagonal' [decidable_eq α] (d : Π (i : α), matrix (m' i) (m' i) R) :
+  block_triangular (block_diagonal' d) sigma.fst :=
+begin
+  rintros ⟨i, i'⟩ ⟨j, j'⟩ h,
+  apply block_diagonal'_apply_ne d i' j' (λ h', ne_of_lt h h'.symm),
+end
+
+lemma block_triangular_block_diagonal [decidable_eq α] (d : α → matrix m m R) :
+  block_triangular (block_diagonal d) prod.snd :=
+begin
+  rintros ⟨i, i'⟩ ⟨j, j'⟩ h,
+  rw [block_diagonal'_eq_block_diagonal, block_triangular_block_diagonal'],
+  exact h
+end
+
+end preorder
+
+section linear_order
+variables [linear_order α]
+
+lemma block_triangular.mul [fintype m]
+  {M N : matrix m m R} (hM : block_triangular M b) (hN : block_triangular N b):
+  block_triangular (M * N) b :=
+begin
+  intros i j hij,
+  apply finset.sum_eq_zero,
+  intros k hk,
+  by_cases hki : b k < b i,
+  { simp_rw [hM hki, zero_mul] },
+  { simp_rw [hN (lt_of_lt_of_le hij (le_of_not_lt hki)), mul_zero] },
+end
+
+end linear_order
+
+lemma upper_two_block_triangular [preorder α]
+  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) {a b : α} (hab : a < b) :
+  block_triangular (from_blocks A B 0 D) (sum.elim (λ i, a) (λ j, b)) :=
+by rintro (c | c) (d | d) hcd; simpa [hab.not_lt] using hcd <|> simp
+
+/-! ### Determinant -/
+
+variables [decidable_eq m] [fintype m] [decidable_eq n] [fintype n]
+
+lemma equiv_block_det (M : matrix m m R) {p q : m → Prop} [decidable_pred p] [decidable_pred q]
+  (e : ∀ x, q x ↔ p x) : (to_square_block_prop M p).det = (to_square_block_prop M q).det :=
+by convert matrix.det_reindex_self (equiv.subtype_equiv_right e) (to_square_block_prop M q)
+
+@[simp] lemma det_to_square_block_id (M : matrix m m R) (i : m) :
+  (M.to_square_block id i).det = M i i :=
+begin
+  letI : unique {a // id a = i} := ⟨⟨⟨i, rfl⟩⟩, λ j, subtype.ext j.property⟩,
+  exact (det_unique _).trans rfl,
+end
+
 lemma det_to_block (M : matrix m m R) (p : m → Prop) [decidable_pred p] :
-  M.det = (matrix.from_blocks (to_block M p p) (to_block M p (λ j, ¬p j))
-    (to_block M (λ j, ¬p j) p) (to_block M (λ j, ¬p j) (λ j, ¬p j))).det :=
+  M.det = (from_blocks (to_block M p p) (to_block M p $ λ j, ¬p j)
+    (to_block M (λ j, ¬p j) p) $ to_block M (λ j, ¬p j) $ λ j, ¬p j).det :=
 begin
-  rw ← matrix.det_reindex_self (equiv.sum_compl p).symm M,
+  rw ←matrix.det_reindex_self (equiv.sum_compl p).symm M,
   rw [det_apply', det_apply'],
   congr, ext σ, congr, ext,
   generalize hy : σ x = y,
@@ -51,19 +159,11 @@ begin
   simp only [matrix.reindex_apply, to_block_apply, equiv.symm_symm,
     equiv.sum_compl_apply_inr, equiv.sum_compl_apply_inl,
     from_blocks_apply₁₁, from_blocks_apply₁₂, from_blocks_apply₂₁, from_blocks_apply₂₂,
-    matrix.minor_apply],
+    matrix.submatrix_apply],
 end
 
-lemma det_to_square_block (M : matrix m m R) {n : nat} (b : m → fin n) (k : fin n) :
-  (to_square_block M b k).det = (to_square_block_prop M (λ i, b i = k)).det :=
-by simp
-
-lemma det_to_square_block' (M : matrix m m R) (b : m → ℕ) (k : ℕ) :
-  (to_square_block' M b k).det = (to_square_block_prop M (λ i, b i = k)).det :=
-by simp
-
 lemma two_block_triangular_det (M : matrix m m R) (p : m → Prop) [decidable_pred p]
-  (h : ∀ i (h1 : ¬p i) j (h2 : p j), M i j = 0) :
+  (h : ∀ i, ¬ p i → ∀ j, p j → M i j = 0) :
   M.det = (to_square_block_prop M p).det * (to_square_block_prop M (λ i, ¬p i)).det :=
 begin
   rw det_to_block M p,
@@ -73,172 +173,145 @@ begin
   exact h ↑i i.2 ↑j j.2
 end
 
-lemma equiv_block_det (M : matrix m m R) {p q : m → Prop} [decidable_pred p] [decidable_pred q]
-  (e : ∀x, q x ↔ p x) : (to_square_block_prop M p).det = (to_square_block_prop M q).det :=
-by convert matrix.det_reindex_self (equiv.subtype_equiv_right e) (to_square_block_prop M q)
-
-lemma to_square_block_det'' (M : matrix m m R) {n : nat} (b : m → fin n) (k : fin n) :
-  (to_square_block M b k).det = (to_square_block' M (λ i, ↑(b i)) ↑k).det :=
+lemma two_block_triangular_det' (M : matrix m m R) (p : m → Prop) [decidable_pred p]
+  (h : ∀ i, p i → ∀ j, ¬ p j → M i j = 0) :
+  M.det = (to_square_block_prop M p).det * (to_square_block_prop M (λ i, ¬p i)).det :=
 begin
-  rw [to_square_block_def', to_square_block_def],
-  apply equiv_block_det,
-  intro x,
-  apply (fin.ext_iff _ _).symm
+  rw [M.two_block_triangular_det (λ i, ¬ p i), mul_comm],
+  simp_rw not_not,
+  congr' 1,
+  exact equiv_block_det _ (λ _, not_not.symm),
+  simpa only [not_not] using h,
 end
 
-/-- Let `b` map rows and columns of a square matrix `M` to `n` blocks. Then
-  `block_triangular_matrix' M n b` says the matrix is block triangular. -/
-def block_triangular_matrix' {o : Type*} (M : matrix o o R) {n : ℕ}
-  (b : o → fin n) : Prop :=
-∀ i j, b j < b i → M i j = 0
-
-lemma upper_two_block_triangular' {m n : Type*}
-  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
-  block_triangular_matrix' (from_blocks A B 0 D) (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) :=
+protected lemma block_triangular.det [decidable_eq α] [linear_order α] (hM : block_triangular M b) :
+  M.det = ∏ a in univ.image b, (M.to_square_block b a).det :=
 begin
-  intros k1 k2 hk12,
-  have h0 : ∀ (k : m ⊕ n), sum.elim (λ i, (0 : fin 2)) (λ j, 1) k = 0 → ∃ i, k = sum.inl i,
-  { simp },
-  have h1 : ∀ (k : m ⊕ n), sum.elim (λ i, (0 : fin 2)) (λ j, 1) k = 1 → ∃ j, k = sum.inr j,
+  unfreezingI { induction hs : univ.image b using finset.strong_induction
+    with s ih generalizing m },
+  subst hs,
+  casesI is_empty_or_nonempty m,
   { simp },
-  set mk1 := (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) k1 with hmk1,
-  set mk2 := (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) k2 with hmk2,
-  fin_cases mk1 using h; fin_cases mk2 using h_1; rw [h, h_1] at hk12,
-  { exact absurd hk12 (nat.not_lt_zero 0) },
-  { exact absurd hk12 (by norm_num) },
-  { rw hmk1 at h,
-    obtain ⟨i, hi⟩ := h1 k1 h,
-    rw hmk2 at h_1,
-    obtain ⟨j, hj⟩ := h0 k2 h_1,
-    rw [hi, hj], simp },
-  { exact absurd hk12 (irrefl 1) }
+  let k := (univ.image b).max' (univ_nonempty.image _),
+  rw two_block_triangular_det' M (λ i, b i = k),
+  { have : univ.image b = insert k ((univ.image b).erase k),
+    { rw insert_erase, apply max'_mem },
+    rw [this, prod_insert (not_mem_erase _ _)],
+    refine congr_arg _ _,
+    let b' := λ i : {a // b a ≠ k}, b ↑i,
+    have h' :  block_triangular (M.to_square_block_prop (λ i, b i ≠ k)) b' := hM.submatrix,
+    have hb' : image b' univ = (image b univ).erase k,
+    { convert image_subtype_ne_univ_eq_image_erase k b },
+    rw ih _ (erase_ssubset $ max'_mem _ _) h' hb',
+    refine finset.prod_congr rfl (λ l hl, _),
+    let he : {a // b' a = l} ≃ {a // b a = l},
+    { have hc : ∀ i, b i = l → b i ≠ k := λ i hi, ne_of_eq_of_ne hi (ne_of_mem_erase hl),
+      exact equiv.subtype_subtype_equiv_subtype hc },
+    simp only [to_square_block_def],
+    rw ← matrix.det_reindex_self he.symm (λ (i j : {a // b a = l}), M ↑i ↑j),
+    refl },
+  { intros i hi j hj,
+    apply hM,
+    rw hi,
+    apply lt_of_le_of_ne _ hj,
+    exact finset.le_max' (univ.image b) _ (mem_image_of_mem _ (mem_univ _)) }
 end
 
-/-- Let `b` map rows and columns of a square matrix `M` to blocks indexed by `ℕ`s. Then
-  `block_triangular_matrix M n b` says the matrix is block triangular. -/
-def block_triangular_matrix {o : Type*} (M : matrix o o R) (b : o → ℕ) : Prop :=
-∀ i j, b j < b i → M i j = 0
-
-lemma upper_two_block_triangular {m n : Type*}
-  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
-  block_triangular_matrix (from_blocks A B 0 D) (sum.elim (λ i, 0) (λ j, 1)) :=
+lemma block_triangular.det_fintype [decidable_eq α] [fintype α] [linear_order α]
+  (h : block_triangular M b) :
+  M.det = ∏ k : α, (M.to_square_block b k).det :=
 begin
-  intros k1 k2 hk12,
-  have h01 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 0 ∨ sum.elim (λ i, 0) (λ j, 1) k = 1,
-  { simp },
-  have h0 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 0 → ∃ i, k = sum.inl i, { simp },
-  have h1 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 1 → ∃ j, k = sum.inr j, { simp },
-  cases (h01 k1) with hk1 hk1; cases (h01 k2) with hk2 hk2; rw [hk1, hk2] at hk12,
-  { exact absurd hk12 (nat.not_lt_zero 0) },
-  { exact absurd hk12 (nat.not_lt_zero 1) },
-  { obtain ⟨i, hi⟩ := h1 k1 hk1,
-    obtain ⟨j, hj⟩ := h0 k2 hk2,
-    rw [hi, hj], simp },
-  { exact absurd hk12 (irrefl 1) }
+  refine h.det.trans (prod_subset (subset_univ _) $ λ a _ ha, _),
+  have : is_empty {i // b i = a} := ⟨λ i, ha $ mem_image.2 ⟨i, mem_univ _, i.2⟩⟩,
+  exactI det_is_empty,
 end
 
-lemma det_of_block_triangular_matrix (M : matrix m m R) (b : m → ℕ)
-  (h : block_triangular_matrix M b) :
-  ∀ (n : ℕ) (hn : ∀ i, b i < n), M.det = ∏ k in finset.range n, (to_square_block' M b k).det :=
+lemma det_of_upper_triangular [linear_order m] (h : M.block_triangular id) :
+  M.det = ∏ i : m, M i i :=
 begin
-  intros n hn,
-  unfreezingI { induction n with n hi generalizing m M b },
-  { rw finset.prod_range_zero,
-    apply det_eq_one_of_card_eq_zero,
-    apply fintype.card_eq_zero_iff.mpr,
-    exact ⟨λ i, nat.not_lt_zero (b i) (hn i)⟩ },
-  { rw [finset.prod_range_succ_comm],
-    have h2 : (M.to_square_block_prop (λ (i : m), b i = n.succ)).det =
-      (M.to_square_block' b n.succ).det,
-    { dunfold to_square_block', dunfold to_square_block_prop, refl },
-    rw two_block_triangular_det M (λ i, ¬(b i = n)),
-    { rw mul_comm,
-      apply congr (congr_arg has_mul.mul _),
-      { let m' := {a // ¬b a = n },
-        let b' := (λ (i : m'), b ↑i),
-        have h' :
-          block_triangular_matrix (M.to_square_block_prop (λ (i : m), ¬b i = n)) b',
-        { intros i j, apply h ↑i ↑j },
-        have hni : ∀ (i : {a // ¬b a = n}), b' i < n,
-        { exact λ i, (ne.le_iff_lt i.property).mp (nat.lt_succ_iff.mp (hn ↑i)) },
-        have h1 := hi (M.to_square_block_prop (λ (i : m), ¬b i = n)) b' h' hni,
-        rw ←fin.prod_univ_eq_prod_range at h1 ⊢,
-        convert h1,
-        ext k,
-        simp only [to_square_block_def', to_square_block_def],
-        let he : {a // b' a = ↑k} ≃ {a // b a = ↑k},
-        { have hc : ∀ (i : m), (λ a, b a = ↑k) i → (λ a, ¬b a = n) i,
-          { intros i hbi, rw hbi, exact ne_of_lt (fin.is_lt k) },
-          exact equiv.subtype_subtype_equiv_subtype hc },
-        exact matrix.det_reindex_self he (λ (i j : {a // b' a = ↑k}), M ↑i ↑j) },
-      { rw det_to_square_block' M b n,
-        have hh : ∀ a, b a = n ↔ ¬(λ (i : m), ¬b i = n) a,
-        { intro i, simp only [not_not] },
-        exact equiv_block_det M hh }},
-    { intros i hi j hj,
-      apply (h i), simp only [not_not] at hi,
-      rw hi,
-      exact (ne.le_iff_lt hj).mp (nat.lt_succ_iff.mp (hn j)) }}
+  haveI : decidable_eq R := classical.dec_eq _,
+  simp_rw [h.det, image_id, det_to_square_block_id],
 end
 
-lemma det_of_block_triangular_matrix'' (M : matrix m m R) (b : m → ℕ)
-  (h : block_triangular_matrix M b) :
-  M.det = ∏ k in finset.image b finset.univ, (to_square_block' M b k).det :=
-begin
-  let n : ℕ := (Sup (finset.image b finset.univ : set ℕ)).succ,
-  have hn : ∀ i, b i < n,
-  { have hbi : ∀ i, b i ∈ finset.image b finset.univ, { simp },
-    intro i,
-    dsimp only [n],
-    apply nat.lt_succ_iff.mpr,
-    exact le_cSup (finset.bdd_above _) (hbi i) },
-  rw det_of_block_triangular_matrix M b h n hn,
-  refine (finset.prod_subset _ _).symm,
-  { intros a ha, apply finset.mem_range.mpr,
-    obtain ⟨i, ⟨hi, hbi⟩⟩ := finset.mem_image.mp ha,
-    rw ←hbi,
-    exact hn i },
-  { intros k hk hbk,
-    apply det_eq_one_of_card_eq_zero,
-    apply fintype.card_eq_zero_iff.mpr,
-    constructor,
-    simp only [subtype.forall],
-    intros a hba, apply hbk,
-    apply finset.mem_image.mpr,
-    use a,
-    exact ⟨finset.mem_univ a, hba⟩ }
-end
+lemma det_of_lower_triangular [linear_order m] (M : matrix m m R) (h : M.block_triangular to_dual) :
+  M.det = ∏ i : m, M i i :=
+by { rw ←det_transpose, exact det_of_upper_triangular h.transpose }
 
-lemma det_of_block_triangular_matrix' (M : matrix m m R) {n : ℕ} (b : m → fin n)
-  (h : block_triangular_matrix' M b) :
-  M.det = ∏ (k : fin n), (to_square_block M b k).det :=
+/-! ### Invertible -/
+
+lemma block_triangular.to_block_inverse_mul_to_block_eq_one [linear_order α] [invertible M]
+  (hM : block_triangular M b) (k : α) :
+  M⁻¹.to_block (λ i, b i < k) (λ i, b i < k) ⬝ M.to_block (λ i, b i < k) (λ i, b i < k) = 1 :=
 begin
-  let b2 : m → ℕ := λ i, ↑(b i),
-  simp_rw to_square_block_det'',
-  rw fin.prod_univ_eq_prod_range (λ (k : ℕ), (M.to_square_block' b2 k).det) n,
-  apply det_of_block_triangular_matrix,
-  { intros i j hij, exact h i j (fin.coe_fin_lt.mp hij) },
-  { intro i, exact fin.is_lt (b i) }
+  let p := (λ i, b i < k),
+  have h_sum : M⁻¹.to_block p p ⬝ M.to_block p p +
+      M⁻¹.to_block p (λ i, ¬ p i) ⬝ M.to_block (λ i, ¬ p i) p = 1,
+    by rw [←to_block_mul_eq_add, inv_mul_of_invertible M, to_block_one_self],
+  have h_zero : M.to_block (λ i, ¬ p i) p = 0,
+  { ext i j,
+    simpa using hM (lt_of_lt_of_le j.2 (le_of_not_lt i.2)) },
+  simpa [h_zero] using h_sum
 end
 
-lemma det_of_upper_triangular {n : ℕ} (M : matrix (fin n) (fin n) R)
-  (h : ∀ (i j : fin n), j < i → M i j = 0) :
-  M.det = ∏ i : (fin n), M i i :=
+/-- The inverse of an upper-left subblock of a block-triangular matrix `M` is the upper-left
+subblock of `M⁻¹`. -/
+lemma block_triangular.inv_to_block [linear_order α] [invertible M]
+  (hM : block_triangular M b) (k : α) :
+  (M.to_block (λ i, b i < k) (λ i, b i < k))⁻¹ = M⁻¹.to_block (λ i, b i < k) (λ i, b i < k) :=
+inv_eq_left_inv $ hM.to_block_inverse_mul_to_block_eq_one k
+
+/-- An upper-left subblock of an invertible block-triangular matrix is invertible. -/
+def block_triangular.invertible_to_block [linear_order α] [invertible M]
+ (hM : block_triangular M b) (k : α) :
+  invertible (M.to_block (λ i, b i < k) (λ i, b i < k)) :=
+invertible_of_left_inverse _ ((⅟M).to_block (λ i, b i < k) (λ i, b i < k)) $
+  by simpa only [inv_of_eq_nonsing_inv] using hM.to_block_inverse_mul_to_block_eq_one k
+
+/-- A lower-left subblock of the inverse of a block-triangular matrix is zero. This is a first step
+towards `block_triangular.inv_to_block` below. -/
+lemma to_block_inverse_eq_zero [linear_order α] [invertible M] (hM : block_triangular M b) (k : α) :
+  M⁻¹.to_block (λ i, k ≤ b i) (λ i, b i < k) = 0 :=
 begin
-  convert det_of_block_triangular_matrix' M id h,
-  ext i,
-  have h2 : ∀ (j : {a // id a = i}), j = ⟨i, rfl⟩ :=
-    λ (j : {a // id a = i}), subtype.ext j.property,
-  haveI : unique {a // id a = i} := ⟨⟨⟨i, rfl⟩⟩, h2⟩,
-  simp [h2 default]
+  let p := λ i, b i < k,
+  let q := λ i, ¬ b i < k,
+  have h_sum : M⁻¹.to_block q p ⬝ M.to_block p p + M⁻¹.to_block q q ⬝ M.to_block q p = 0,
+  { rw [←to_block_mul_eq_add, inv_mul_of_invertible M, to_block_one_disjoint],
+    rw disjoint_iff_inf_le,
+    exact λ i h, h.1 h.2 },
+  have h_zero : M.to_block q p = 0,
+  { ext i j,
+    simpa using hM (lt_of_lt_of_le j.2 $ le_of_not_lt i.2) },
+  have h_mul_eq_zero : M⁻¹.to_block q p ⬝ M.to_block p p = 0 := by simpa [h_zero] using h_sum,
+  haveI : invertible (M.to_block p p) := hM.invertible_to_block k,
+  have : (λ i, k ≤ b i) = q := by { ext, exact not_lt.symm },
+  rw [this, ← matrix.zero_mul (M.to_block p p)⁻¹, ← h_mul_eq_zero,
+    mul_inv_cancel_right_of_invertible],
 end
 
-lemma det_of_lower_triangular {n : ℕ} (M : matrix (fin n) (fin n) R)
-  (h : ∀ (i j : fin n), i < j → M i j = 0) :
-  M.det = ∏ i : (fin n), M i i :=
+/-- The inverse of a block-triangular matrix is block-triangular. -/
+lemma block_triangular_inv_of_block_triangular [linear_order α] [invertible M]
+  (hM : block_triangular M b) :
+  block_triangular M⁻¹ b :=
 begin
-  rw ← det_transpose,
-  exact det_of_upper_triangular _ (λ (i j : fin n) (hji : j < i), h j i hji)
+  unfreezingI { induction hs : univ.image b using finset.strong_induction
+    with s ih generalizing m },
+  subst hs,
+  intros i j hij,
+  haveI : inhabited m := ⟨i⟩,
+  let k := (univ.image b).max' (univ_nonempty.image _),
+  let b' := λ i : {a // b a < k}, b ↑i,
+  let A := M.to_block (λ i, b i < k) (λ j, b j < k),
+  obtain hbi | hi : b i = k ∨ _ := (le_max' _ (b i) $ mem_image_of_mem _ $ mem_univ _).eq_or_lt,
+  { have : M⁻¹.to_block (λ i, k ≤ b i) (λ i, b i < k) ⟨i, hbi.ge⟩ ⟨j, hbi ▸ hij⟩ = 0,
+    { simp only [to_block_inverse_eq_zero hM k, pi.zero_apply] },
+    simp [this.symm] },
+  haveI : invertible A := hM.invertible_to_block _,
+  have hA : A.block_triangular b' := hM.submatrix,
+  have hb' : image b' univ ⊂ image b univ,
+  { convert image_subtype_univ_ssubset_image_univ k b _ (λ a, a < k) (lt_irrefl _),
+    convert max'_mem _ _ },
+  have hij' : b' ⟨j, hij.trans hi⟩ < b' ⟨i, hi⟩, by simp_rw [b', subtype.coe_mk, hij],
+  simp [hM.inv_to_block k, (ih (image b' univ) hb' hA rfl hij').symm],
 end
 
 end matrix
diff --git a/src/linear_algebra/matrix/charpoly/basic.lean b/src/linear_algebra/matrix/charpoly/basic.lean
index 9527ee1bc89f7..f402becdd93d6 100644
--- a/src/linear_algebra/matrix/charpoly/basic.lean
+++ b/src/linear_algebra/matrix/charpoly/basic.lean
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 import linear_algebra.matrix.adjugate
-import ring_theory.matrix_algebra
 import ring_theory.polynomial_algebra
 import tactic.apply_fun
 import tactic.squeeze
@@ -12,6 +11,9 @@ import tactic.squeeze
 /-!
 # Characteristic polynomials and the Cayley-Hamilton theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define characteristic polynomials of matrices and
 prove the Cayley–Hamilton theorem over arbitrary commutative rings.
 
@@ -46,6 +48,9 @@ The determinant of this matrix is the characteristic polynomial.
 def charmatrix (M : matrix n n R) : matrix n n R[X] :=
 matrix.scalar n (X : R[X]) - (C : R →+* R[X]).map_matrix M
 
+lemma charmatrix_apply (M : matrix n n R) (i j : n) :
+  charmatrix M i j = X * (1 : matrix n n R[X]) i j - C (M i j) := rfl
+
 @[simp] lemma charmatrix_apply_eq (M : matrix n n R) (i : n) :
   charmatrix M i i = (X : R[X]) - C (M i i) :=
 by simp only [charmatrix, sub_left_inj, pi.sub_apply, scalar_apply_eq,
diff --git a/src/linear_algebra/matrix/charpoly/coeff.lean b/src/linear_algebra/matrix/charpoly/coeff.lean
index 023aab0177aa1..834300d00a30b 100644
--- a/src/linear_algebra/matrix/charpoly/coeff.lean
+++ b/src/linear_algebra/matrix/charpoly/coeff.lean
@@ -10,6 +10,9 @@ import linear_algebra.matrix.charpoly.basic
 /-!
 # Characteristic polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We give methods for computing coefficients of the characteristic polynomial.
 
 ## Main definitions
@@ -190,3 +193,26 @@ lemma pow_eq_aeval_mod_charpoly (M : matrix n n R) (k : ℕ) : M^k = aeval M (X^
 by rw [←aeval_eq_aeval_mod_charpoly, map_pow, aeval_X]
 
 end matrix
+
+section ideal
+
+lemma coeff_charpoly_mem_ideal_pow {I : ideal R} (h : ∀ i j, M i j ∈ I) (k : ℕ) :
+  M.charpoly.coeff k ∈ I ^ (fintype.card n - k) :=
+begin
+  delta charpoly,
+  rw [matrix.det_apply, finset_sum_coeff],
+  apply sum_mem,
+  rintro c -,
+  rw [coeff_smul, submodule.smul_mem_iff'],
+  have : ∑ (x : n), 1 = fintype.card n := by rw [finset.sum_const, card_univ, smul_eq_mul, mul_one],
+  rw ← this,
+  apply coeff_prod_mem_ideal_pow_tsub,
+  rintro i - (_|k),
+  { rw [tsub_zero, pow_one, charmatrix_apply, coeff_sub, coeff_X_mul_zero, coeff_C_zero, zero_sub,
+      neg_mem_iff],
+    exact h (c i) i },
+  { rw [nat.succ_eq_one_add, tsub_self_add, pow_zero, ideal.one_eq_top],
+    exact submodule.mem_top }
+end
+
+end ideal
diff --git a/src/linear_algebra/matrix/charpoly/eigs.lean b/src/linear_algebra/matrix/charpoly/eigs.lean
new file mode 100644
index 0000000000000..684f1bb8e94be
--- /dev/null
+++ b/src/linear_algebra/matrix/charpoly/eigs.lean
@@ -0,0 +1,87 @@
+/-
+Copyright (c) 2023 Mohanad Ahmed. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mohanad Ahmed
+-/
+
+import data.polynomial.basic
+import field_theory.is_alg_closed.basic
+
+/-!
+# Eigenvalues are characteristic polynomial roots.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In fields we show that:
+
+* `matrix.det_eq_prod_roots_charpoly_of_splits`: the determinant (in the field of the matrix)
+  is the product of the roots of the characteristic polynomial if the polynomial splits in the field
+  of the matrix.
+* `matrix.trace_eq_sum_roots_charpoly_of_splits`: the trace is the sum of the roots of the
+  characteristic polynomial if the polynomial splits in the field of the matrix.
+
+In an algebraically closed field we show that:
+
+* `matrix.det_eq_prod_roots_charpoly`: the determinant is the product of the roots of the
+  characteristic polynomial.
+* `matrix.trace_eq_sum_roots_charpoly`: the trace is the sum of the roots of the
+  characteristic polynomial.
+
+Note that over other fields such as `ℝ`, these results can be used by using
+`A.map (algebra_map ℝ ℂ)` as the matrix, and then applying `ring_hom.map_det`.
+
+The two lemmas `matrix.det_eq_prod_roots_charpoly` and `matrix.trace_eq_sum_roots_charpoly` are more
+commonly stated as trace is the sum of eigenvalues and determinant is the product of eigenvalues.
+Mathlib has already defined eigenvalues in `linear_algebra.eigenspace` as the roots of the minimal
+polynomial of a linear endomorphism. These do not have correct multiplicity and cannot be used in
+the theorems above. Hence we express these theorems in terms of the roots of the characteristic
+polynomial directly.
+
+## TODO
+
+The proofs of `det_eq_prod_roots_charpoly_of_splits` and
+`trace_eq_sum_roots_charpoly_of_splits` closely resemble
+`norm_gen_eq_prod_roots` and `trace_gen_eq_sum_roots` respectively, but the
+dependencies are not general enough to unify them. We should refactor
+`polynomial.prod_roots_eq_coeff_zero_of_monic_of_split` and
+`polynomial.sum_roots_eq_next_coeff_of_monic_of_split` to assume splitting over an arbitrary map.
+-/
+variables {n : Type*} [fintype n] [decidable_eq n]
+variables {R : Type*} [field R]
+variables {A : matrix n n R}
+
+open matrix polynomial
+open_locale matrix big_operators
+
+namespace matrix
+
+lemma det_eq_prod_roots_charpoly_of_splits (hAps : A.charpoly.splits (ring_hom.id R)) :
+  A.det = (matrix.charpoly A).roots.prod :=
+begin
+  rw [det_eq_sign_charpoly_coeff, ← (charpoly_nat_degree_eq_dim A),
+    polynomial.prod_roots_eq_coeff_zero_of_monic_of_split A.charpoly_monic (hAps),
+    ← mul_assoc, ← pow_two, pow_right_comm, neg_one_sq, one_pow, one_mul],
+end
+
+lemma trace_eq_sum_roots_charpoly_of_splits (hAps : A.charpoly.splits (ring_hom.id R)) :
+  A.trace = (matrix.charpoly A).roots.sum :=
+begin
+  casesI is_empty_or_nonempty n,
+  { rw [matrix.trace, fintype.sum_empty, matrix.charpoly,
+      det_eq_one_of_card_eq_zero (fintype.card_eq_zero_iff.2 h), polynomial.roots_one,
+      multiset.empty_eq_zero, multiset.sum_zero], },
+  { rw [trace_eq_neg_charpoly_coeff, neg_eq_iff_eq_neg,
+      ← polynomial.sum_roots_eq_next_coeff_of_monic_of_split A.charpoly_monic (hAps),
+      next_coeff, charpoly_nat_degree_eq_dim,
+      if_neg (fintype.card_ne_zero : fintype.card n ≠ 0)], },
+end
+variables (A)
+
+lemma det_eq_prod_roots_charpoly [is_alg_closed R] : A.det = (matrix.charpoly A).roots.prod :=
+det_eq_prod_roots_charpoly_of_splits (is_alg_closed.splits A.charpoly)
+
+lemma trace_eq_sum_roots_charpoly [is_alg_closed R] : A.trace = (matrix.charpoly A).roots.sum :=
+trace_eq_sum_roots_charpoly_of_splits (is_alg_closed.splits A.charpoly)
+
+end matrix
diff --git a/src/linear_algebra/matrix/charpoly/finite_field.lean b/src/linear_algebra/matrix/charpoly/finite_field.lean
index e701a3d07ed0d..429b18e1a6f64 100644
--- a/src/linear_algebra/matrix/charpoly/finite_field.lean
+++ b/src/linear_algebra/matrix/charpoly/finite_field.lean
@@ -10,6 +10,9 @@ import data.matrix.char_p
 
 /-!
 # Results on characteristic polynomials and traces over finite fields.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 noncomputable theory
@@ -37,9 +40,7 @@ begin
     rw [alg_equiv.map_pow, mat_poly_equiv_charmatrix, hk, sub_pow_char_pow_of_commute, ← C_pow],
     { exact (id (mat_poly_equiv_eq_X_pow_sub_C (p ^ k) M) : _) },
     { exact (C M).commute_X } },
-  { -- TODO[gh-6025]: remove this `haveI` once `subsingleton_of_empty_right` is a global instance
-    haveI : subsingleton (matrix n n K) := subsingleton_of_empty_right,
-    exact congr_arg _ (subsingleton.elim _ _), },
+  { exact congr_arg _ (subsingleton.elim _ _), },
 end
 
 @[simp] lemma zmod.charpoly_pow_card {p : ℕ} [fact p.prime] (M : matrix n n (zmod p)) :
diff --git a/src/linear_algebra/matrix/charpoly/linear_map.lean b/src/linear_algebra/matrix/charpoly/linear_map.lean
new file mode 100644
index 0000000000000..d37988acc241b
--- /dev/null
+++ b/src/linear_algebra/matrix/charpoly/linear_map.lean
@@ -0,0 +1,249 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import linear_algebra.matrix.charpoly.coeff
+import linear_algebra.matrix.to_lin
+
+/-!
+
+# Calyley-Hamilton theorem for f.g. modules.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a fixed finite spanning set `b : ι → M` of a `R`-module `M`, we say that a matrix `M`
+represents an endomorphism `f : M →ₗ[R] M` if the matrix as an endomorphism of `ι → R` commutes
+with `f` via the projection `(ι → R) →ₗ[R] M` given by `b`.
+
+We show that every endomorphism has a matrix representation, and if `f.range ≤ I • ⊤` for some
+ideal `I`, we may furthermore obtain a matrix representation whose entries fall in `I`.
+
+This is used to conclude the Cayley-Hamilton theorem for f.g. modules over arbitrary rings.
+-/
+
+variables {ι : Type*} [fintype ι]
+variables {M : Type*} [add_comm_group M] (R : Type*) [comm_ring R] [module R M] (I : ideal R)
+variables (b : ι → M) (hb : submodule.span R (set.range b) = ⊤)
+
+open_locale big_operators
+open_locale polynomial
+
+/-- The composition of a matrix (as an endomporphism of `ι → R`) with the projection
+`(ι → R) →ₗ[R] M`.  -/
+def pi_to_module.from_matrix [decidable_eq ι] : matrix ι ι R →ₗ[R] (ι → R) →ₗ[R] M :=
+(linear_map.llcomp R _ _ _ (fintype.total R R b)).comp alg_equiv_matrix'.symm.to_linear_map
+
+lemma pi_to_module.from_matrix_apply [decidable_eq ι] (A : matrix ι ι R) (w : ι → R) :
+  pi_to_module.from_matrix R b A w = fintype.total R R b (A.mul_vec w) := rfl
+
+lemma pi_to_module.from_matrix_apply_single_one [decidable_eq ι] (A : matrix ι ι R) (j : ι) :
+  pi_to_module.from_matrix R b A (pi.single j 1) = ∑ (i : ι), A i j • b i :=
+begin
+  rw [pi_to_module.from_matrix_apply, fintype.total_apply, matrix.mul_vec_single],
+  simp_rw [mul_one]
+end
+
+/-- The endomorphisms of `M` acts on `(ι → R) →ₗ[R] M`, and takes the projection
+to a `(ι → R) →ₗ[R] M`. -/
+def pi_to_module.from_End : (module.End R M) →ₗ[R] (ι → R) →ₗ[R] M :=
+linear_map.lcomp _ _ (fintype.total R R b)
+
+lemma pi_to_module.from_End_apply (f : module.End R M) (w : ι → R) :
+  pi_to_module.from_End R b f w = f (fintype.total R R b w) := rfl
+
+lemma pi_to_module.from_End_apply_single_one [decidable_eq ι] (f : module.End R M) (i : ι) :
+  pi_to_module.from_End R b f (pi.single i 1) = f (b i) :=
+begin
+  rw pi_to_module.from_End_apply,
+  congr,
+  convert fintype.total_apply_single R b i 1,
+  rw one_smul,
+end
+
+lemma pi_to_module.from_End_injective (hb : submodule.span R (set.range b) = ⊤) :
+  function.injective (pi_to_module.from_End R b) :=
+begin
+  intros x y e,
+  ext m,
+  obtain ⟨m, rfl⟩ : m ∈ (fintype.total R R b).range,
+  { rw (fintype.range_total R b).trans hb, trivial },
+  exact (linear_map.congr_fun e m : _)
+end
+
+section
+
+variables {R} [decidable_eq ι]
+
+/-- We say that a matrix represents an endomorphism of `M` if the matrix acting on `ι → R` is
+equal to `f` via the projection `(ι → R) →ₗ[R] M` given by a fixed (spanning) set.  -/
+def matrix.represents (A : matrix ι ι R) (f : module.End R M) : Prop :=
+pi_to_module.from_matrix R b A = pi_to_module.from_End R b f
+
+variables {b}
+
+lemma matrix.represents.congr_fun {A : matrix ι ι R} {f : module.End R M}
+  (h : A.represents b f) (x) :
+  fintype.total R R b (A.mul_vec x) = f (fintype.total R R b x) :=
+linear_map.congr_fun h x
+
+lemma matrix.represents_iff {A : matrix ι ι R} {f : module.End R M} :
+  A.represents b f ↔
+    ∀ x, fintype.total R R b (A.mul_vec x) = f (fintype.total R R b x) :=
+⟨λ e x, e.congr_fun x, λ H, linear_map.ext $ λ x, H x⟩
+
+lemma matrix.represents_iff' {A : matrix ι ι R} {f : module.End R M} :
+  A.represents b f ↔ ∀ j, ∑ (i : ι), A i j • b i = f (b j) :=
+begin
+  split,
+  { intros h i,
+    have := linear_map.congr_fun h (pi.single i 1),
+    rwa [pi_to_module.from_End_apply_single_one,
+      pi_to_module.from_matrix_apply_single_one] at this },
+  { intros h,
+    ext,
+    simp_rw [linear_map.comp_apply, linear_map.coe_single, pi_to_module.from_End_apply_single_one,
+      pi_to_module.from_matrix_apply_single_one],
+    apply h }
+end
+
+lemma matrix.represents.mul {A A' : matrix ι ι R} {f f' : module.End R M}
+  (h : A.represents b f) (h' : matrix.represents b A' f') :
+  (A * A').represents b (f * f') :=
+begin
+  delta matrix.represents pi_to_module.from_matrix at ⊢,
+  rw [linear_map.comp_apply, alg_equiv.to_linear_map_apply, map_mul],
+  ext,
+  dsimp [pi_to_module.from_End],
+  rw [← h'.congr_fun, ← h.congr_fun],
+  refl,
+end
+
+lemma matrix.represents.one : (1 : matrix ι ι R).represents b 1 :=
+begin
+  delta matrix.represents pi_to_module.from_matrix,
+  rw [linear_map.comp_apply, alg_equiv.to_linear_map_apply, map_one],
+  ext,
+  refl
+end
+
+lemma matrix.represents.add {A A' : matrix ι ι R} {f f' : module.End R M}
+  (h : A.represents b f) (h' : matrix.represents b A' f') :
+  (A + A').represents b (f + f') :=
+begin
+  delta matrix.represents at ⊢ h h', rw [map_add, map_add, h, h'],
+end
+
+lemma matrix.represents.zero :
+  (0 : matrix ι ι R).represents b 0 :=
+begin
+  delta matrix.represents, rw [map_zero, map_zero],
+end
+
+lemma matrix.represents.smul {A : matrix ι ι R} {f : module.End R M}
+  (h : A.represents b f) (r : R) :
+  (r • A).represents b (r • f) :=
+begin
+  delta matrix.represents at ⊢ h, rw [map_smul, map_smul, h],
+end
+
+lemma matrix.represents.eq {A : matrix ι ι R} {f f' : module.End R M}
+  (h : A.represents b f) (h' : A.represents b f') : f = f' :=
+pi_to_module.from_End_injective R b hb (h.symm.trans h')
+
+variables (b R)
+
+/-- The subalgebra of `matrix ι ι R` that consists of matrices that actually represent
+endomorphisms on `M`. -/
+def matrix.is_representation : subalgebra R (matrix ι ι R) :=
+{ carrier := { A | ∃ f : module.End R M, A.represents b f },
+  mul_mem' := λ A₁ A₂ ⟨f₁, e₁⟩ ⟨f₂, e₂⟩, ⟨f₁ * f₂, e₁.mul e₂⟩,
+  one_mem' := ⟨1, matrix.represents.one⟩,
+  add_mem' := λ A₁ A₂ ⟨f₁, e₁⟩ ⟨f₂, e₂⟩, ⟨f₁ + f₂, e₁.add e₂⟩,
+  zero_mem' := ⟨0, matrix.represents.zero⟩,
+  algebra_map_mem' := λ r, ⟨r • 1, matrix.represents.one.smul r⟩ }
+
+/-- The map sending a matrix to the endomorphism it represents. This is an `R`-algebra morphism. -/
+noncomputable
+def matrix.is_representation.to_End : matrix.is_representation R b →ₐ[R] module.End R M :=
+{ to_fun := λ A, A.2.some,
+  map_one' := (1 : matrix.is_representation R b).2.some_spec.eq hb matrix.represents.one,
+  map_mul' := λ A₁ A₂, (A₁ * A₂).2.some_spec.eq hb (A₁.2.some_spec.mul A₂.2.some_spec),
+  map_zero' := (0 : matrix.is_representation R b).2.some_spec.eq hb matrix.represents.zero,
+  map_add' := λ A₁ A₂, (A₁ + A₂).2.some_spec.eq hb (A₁.2.some_spec.add A₂.2.some_spec),
+  commutes' := λ r, (r • 1 : matrix.is_representation R b).2.some_spec.eq
+    hb (matrix.represents.one.smul r) }
+
+lemma matrix.is_representation.to_End_represents (A : matrix.is_representation R b) :
+  (A : matrix ι ι R).represents b (matrix.is_representation.to_End R b hb A) :=
+A.2.some_spec
+
+lemma matrix.is_representation.eq_to_End_of_represents (A : matrix.is_representation R b)
+  {f : module.End R M} (h : (A : matrix ι ι R).represents b f) :
+    matrix.is_representation.to_End R b hb A = f :=
+A.2.some_spec.eq hb h
+
+lemma matrix.is_representation.to_End_exists_mem_ideal
+  (f : module.End R M) (I : ideal R) (hI : f.range ≤ I • ⊤) :
+  ∃ M, matrix.is_representation.to_End R b hb M = f ∧ ∀ i j, M.1 i j ∈ I :=
+begin
+  have : ∀ x, f x ∈ (ideal.finsupp_total ι M I b).range,
+  { rw [ideal.range_finsupp_total, hb], exact λ x, hI (f.mem_range_self x) },
+  choose bM' hbM',
+  let A : matrix ι ι R := λ i j, bM' (b j) i,
+  have : A.represents b f,
+  { rw matrix.represents_iff',
+    dsimp [A],
+    intro j,
+    specialize hbM' (b j),
+    rwa ideal.finsupp_total_apply_eq_of_fintype at hbM' },
+  exact ⟨⟨A, f, this⟩, matrix.is_representation.eq_to_End_of_represents R b hb ⟨A, f, this⟩ this,
+    λ i j, (bM' (b j) i).prop⟩,
+end
+
+lemma matrix.is_representation.to_End_surjective :
+  function.surjective (matrix.is_representation.to_End R b hb) :=
+begin
+  intro f,
+  obtain ⟨M, e, -⟩ := matrix.is_representation.to_End_exists_mem_ideal R b hb f ⊤ _,
+  exact ⟨M, e⟩,
+  simp,
+end
+
+end
+
+/--
+The **Cayley-Hamilton Theorem** for f.g. modules over arbitrary rings states that for each
+`R`-endomorphism `φ` of an `R`-module `M` such that `φ(M) ≤ I • M` for some ideal `I`, there
+exists some `n` and some `aᵢ ∈ Iⁱ` such that `φⁿ + a₁ φⁿ⁻¹ + ⋯ + aₙ = 0`.
+
+This is the version found in Eisenbud 4.3, which is slightly weaker than Matsumura 2.1
+(this lacks the constraint on `n`), and is slightly stronger than Atiyah-Macdonald 2.4.
+-/
+lemma linear_map.exists_monic_and_coeff_mem_pow_and_aeval_eq_zero_of_range_le_smul
+  [module.finite R M] (f : module.End R M) (I : ideal R) (hI : f.range ≤ I • ⊤) :
+  ∃ p : R[X],
+    p.monic ∧ (∀ k, p.coeff k ∈ I ^ (p.nat_degree - k)) ∧ polynomial.aeval f p = 0 :=
+begin
+  classical,
+  casesI subsingleton_or_nontrivial R,
+  { exactI ⟨0, polynomial.monic_of_subsingleton _, by simp⟩ },
+  obtain ⟨s : finset M, hs : submodule.span R (s : set M) = ⊤⟩ := module.finite.out,
+  obtain ⟨A, rfl, h⟩ := matrix.is_representation.to_End_exists_mem_ideal R (coe : s → M)
+    (by rw [subtype.range_coe_subtype, finset.set_of_mem, hs]) f I hI,
+  refine ⟨A.1.charpoly, A.1.charpoly_monic, _, _⟩,
+  { rw A.1.charpoly_nat_degree_eq_dim,
+    exact coeff_charpoly_mem_ideal_pow h },
+  { rw [polynomial.aeval_alg_hom_apply, ← map_zero (matrix.is_representation.to_End R coe _)],
+    congr' 1,
+    ext1,
+    rw [polynomial.aeval_subalgebra_coe, subtype.val_eq_coe, matrix.aeval_self_charpoly,
+      subalgebra.coe_zero] },
+  { apply_instance }
+end
+
+lemma linear_map.exists_monic_and_aeval_eq_zero [module.finite R M]
+  (f : module.End R M) : ∃ p : R[X], p.monic ∧ polynomial.aeval f p = 0 :=
+(linear_map.exists_monic_and_coeff_mem_pow_and_aeval_eq_zero_of_range_le_smul R f ⊤ (by simp)).imp
+  (λ p h, h.imp_right and.elim_right)
diff --git a/src/linear_algebra/matrix/charpoly/minpoly.lean b/src/linear_algebra/matrix/charpoly/minpoly.lean
index d65cfc36474c3..ca0ffecda79b6 100644
--- a/src/linear_algebra/matrix/charpoly/minpoly.lean
+++ b/src/linear_algebra/matrix/charpoly/minpoly.lean
@@ -1,30 +1,44 @@
 /-
 Copyright (c) 2020 Aaron Anderson, Jalex Stark. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Aaron Anderson, Jalex Stark
+Authors: Aaron Anderson, Jalex Stark, Eric Wieser
 -/
 
 import linear_algebra.matrix.charpoly.coeff
+import linear_algebra.matrix.to_lin
 import ring_theory.power_basis
 
 /-!
 # The minimal polynomial divides the characteristic polynomial of a matrix.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This also includes some miscellaneous results about `minpoly` on matrices.
 -/
 
 noncomputable theory
 
-universes u v
+universes u v w
 
 open polynomial matrix
 
 variables {R : Type u} [comm_ring R]
 variables {n : Type v} [decidable_eq n] [fintype n]
+variables {N : Type w} [add_comm_group N] [module R N]
 
 open finset
 
-variable {M : matrix n n R}
-
 namespace matrix
+open_locale matrix
+variables (M : matrix n n R)
+
+@[simp] theorem minpoly_to_lin' : minpoly R M.to_lin' = minpoly R M :=
+minpoly.minpoly_alg_equiv (to_lin_alg_equiv' : matrix n n R ≃ₐ[R] _) M
+
+@[simp] theorem minpoly_to_lin (b : basis n R N) (M : matrix n n R) :
+  minpoly R (to_lin b b M) = minpoly R M :=
+minpoly.minpoly_alg_equiv (to_lin_alg_equiv b : matrix n n R ≃ₐ[R] _) M
 
 theorem is_integral : is_integral R M := ⟨M.charpoly, ⟨charpoly_monic M, aeval_self_charpoly M⟩⟩
 
@@ -34,6 +48,18 @@ minpoly.dvd _ _ (aeval_self_charpoly M)
 
 end matrix
 
+namespace linear_map
+
+@[simp] theorem minpoly_to_matrix' (f : (n → R) →ₗ[R] (n → R)) :
+  minpoly R f.to_matrix' = minpoly R f :=
+minpoly.minpoly_alg_equiv (to_matrix_alg_equiv' : _ ≃ₐ[R] matrix n n R) f
+
+@[simp] theorem minpoly_to_matrix (b : basis n R N) (f : N →ₗ[R] N) :
+  minpoly R (to_matrix b b f) = minpoly R f :=
+minpoly.minpoly_alg_equiv (to_matrix_alg_equiv b : _ ≃ₐ[R] matrix n n R) f
+
+end linear_map
+
 section power_basis
 
 open algebra
@@ -44,18 +70,16 @@ In combination with `det_eq_sign_charpoly_coeff` or `trace_eq_neg_charpoly_coeff
 and a bit of rewriting, this will allow us to conclude the
 field norm resp. trace of `x` is the product resp. sum of `x`'s conjugates.
 -/
-lemma charpoly_left_mul_matrix {K S : Type*} [field K] [comm_ring S] [algebra K S]
-  (h : power_basis K S) :
-  (left_mul_matrix h.basis h.gen).charpoly = minpoly K h.gen :=
+lemma charpoly_left_mul_matrix {S : Type*} [ring S] [algebra R S] (h : power_basis R S) :
+  (left_mul_matrix h.basis h.gen).charpoly = minpoly R h.gen :=
 begin
-  apply minpoly.unique,
-  { apply matrix.charpoly_monic },
+  casesI subsingleton_or_nontrivial R, { apply subsingleton.elim },
+  apply minpoly.unique' R h.gen (charpoly_monic _),
   { apply (injective_iff_map_eq_zero (left_mul_matrix _)).mp (left_mul_matrix_injective h.basis),
     rw [← polynomial.aeval_alg_hom_apply, aeval_self_charpoly] },
-  { intros q q_monic root_q,
-    rw [matrix.charpoly_degree_eq_dim, fintype.card_fin, degree_eq_nat_degree q_monic.ne_zero],
-    apply with_bot.some_le_some.mpr,
-    exact h.dim_le_nat_degree_of_root q_monic.ne_zero root_q }
+  refine λ q hq, or_iff_not_imp_left.2 (λ h0, _),
+  rw [matrix.charpoly_degree_eq_dim, fintype.card_fin] at hq,
+  contrapose! hq, exact h.dim_le_degree_of_root h0 hq,
 end
 
 end power_basis
diff --git a/src/linear_algebra/matrix/circulant.lean b/src/linear_algebra/matrix/circulant.lean
index 99feb26996f5b..8ee4942ac5a66 100644
--- a/src/linear_algebra/matrix/circulant.lean
+++ b/src/linear_algebra/matrix/circulant.lean
@@ -8,6 +8,9 @@ import linear_algebra.matrix.symmetric
 /-!
 # Circulant matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the definition and basic results about circulant matrices.
 Given a vector `v : n → α` indexed by a type that is endowed with subtraction,
 `matrix.circulant v` is the matrix whose `(i, j)`th entry is `v (i - j)`.
@@ -39,9 +42,12 @@ open_locale matrix big_operators
 /-- Given the condition `[has_sub n]` and a vector `v : n → α`,
     we define `circulant v` to be the circulant matrix generated by `v` of type `matrix n n α`.
     The `(i,j)`th entry is defined to be `v (i - j)`. -/
+def circulant [has_sub n] (v : n → α) : matrix n n α :=
+of $ λ i j, v (i - j)
+
+-- TODO: set as an equation lemma for `circulant`, see mathlib4#3024
 @[simp]
-def circulant [has_sub n] (v : n → α) : matrix n n α
-| i j := v (i - j)
+lemma circulant_apply [has_sub n] (v : n → α) (i j) : circulant v i j = v (i - j) := rfl
 
 lemma circulant_col_zero_eq [add_group n] (v : n → α) (i : n) : circulant v i 0 = v i :=
 congr_arg v (sub_zero _)
@@ -108,7 +114,7 @@ lemma circulant_mul [semiring α] [fintype n] [add_group n] (v w : n → α) :
   circulant v ⬝ circulant w = circulant (mul_vec (circulant v) w) :=
 begin
   ext i j,
-  simp only [mul_apply, mul_vec, circulant, dot_product],
+  simp only [mul_apply, mul_vec, circulant_apply, dot_product],
   refine fintype.sum_equiv (equiv.sub_right j) _ _ _,
   intro x,
   simp only [equiv.sub_right_apply, sub_sub_sub_cancel_right],
@@ -125,7 +131,7 @@ lemma circulant_mul_comm
   circulant v ⬝ circulant w = circulant w ⬝ circulant v :=
 begin
   ext i j,
-  simp only [mul_apply, circulant, mul_comm],
+  simp only [mul_apply, circulant_apply, mul_comm],
   refine fintype.sum_equiv ((equiv.sub_left i).trans (equiv.add_right j)) _ _ _,
   intro x,
   congr' 2,
@@ -141,7 +147,7 @@ lemma fin.circulant_mul_comm [comm_semigroup α] [add_comm_monoid α] :
 | (n+1) := circulant_mul_comm
 
 /-- `k • circulant v` is another circulant matrix `circulant (k • v)`. -/
-lemma circulant_smul [has_sub n] [has_scalar R α] (k : R) (v : n → α) :
+lemma circulant_smul [has_sub n] [has_smul R α] (k : R) (v : n → α) :
   circulant (k • v) = k • circulant v :=
 by ext; simp
 
diff --git a/src/linear_algebra/matrix/default.lean b/src/linear_algebra/matrix/default.lean
deleted file mode 100644
index 6ac169c9a9c9d..0000000000000
--- a/src/linear_algebra/matrix/default.lean
+++ /dev/null
@@ -1,8 +0,0 @@
-import linear_algebra.determinant
-import linear_algebra.matrix.basis
-import linear_algebra.matrix.block
-import linear_algebra.matrix.diagonal
-import linear_algebra.matrix.dot_product
-import linear_algebra.matrix.to_linear_equiv
-import linear_algebra.matrix.reindex
-import linear_algebra.trace
diff --git a/src/linear_algebra/matrix/determinant.lean b/src/linear_algebra/matrix/determinant.lean
index a8c5563a6fc1c..fa527c57a6b8c 100644
--- a/src/linear_algebra/matrix/determinant.lean
+++ b/src/linear_algebra/matrix/determinant.lean
@@ -5,7 +5,8 @@ Authors: Kenny Lau, Chris Hughes, Tim Baanen
 -/
 import data.matrix.pequiv
 import data.matrix.block
-import data.fintype.card
+import data.matrix.notation
+import data.fintype.big_operators
 import group_theory.perm.fin
 import group_theory.perm.sign
 import algebra.algebra.basic
@@ -16,6 +17,9 @@ import linear_algebra.pi
 /-!
 # Determinant of a matrix
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the determinant of a matrix, `matrix.det`, and its essential properties.
 
 ## Main definitions
@@ -46,7 +50,7 @@ open_locale matrix big_operators
 variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
 variables {R : Type v} [comm_ring R]
 
-local notation `ε` σ:max := ((sign σ : ℤ ) : R)
+local notation `ε ` σ:max := ((sign σ : ℤ) : R)
 
 
 /-- `det` is an `alternating_map` in the rows of the matrix. -/
@@ -124,7 +128,7 @@ lemma det_mul_aux {M N : matrix n n R} {p : n → n} (H : ¬bijective p) :
   ∑ σ : perm n, (ε σ) * ∏ x, (M (σ x) (p x) * N (p x) x) = 0 :=
 begin
   obtain ⟨i, j, hpij, hij⟩ : ∃ i j, p i = p j ∧ i ≠ j,
-  { rw [← fintype.injective_iff_bijective, injective] at H,
+  { rw [← finite.injective_iff_bijective, injective] at H,
     push_neg at H,
     exact H },
   exact sum_involution
@@ -213,8 +217,8 @@ lemma det_permute (σ : perm n) (M : matrix n n R) : matrix.det (λ i, M (σ i))
 
 /-- Permuting rows and columns with the same equivalence has no effect. -/
 @[simp]
-lemma det_minor_equiv_self (e : n ≃ m) (A : matrix m m R) :
-  det (A.minor e e) = det A :=
+lemma det_submatrix_equiv_self (e : n ≃ m) (A : matrix m m R) :
+  det (A.submatrix e e) = det A :=
 begin
   rw [det_apply', det_apply'],
   apply fintype.sum_equiv (equiv.perm_congr e),
@@ -223,16 +227,16 @@ begin
   congr' 1,
   apply fintype.prod_equiv e,
   intro i,
-  rw [equiv.perm_congr_apply, equiv.symm_apply_apply, minor_apply],
+  rw [equiv.perm_congr_apply, equiv.symm_apply_apply, submatrix_apply],
 end
 
 /-- Reindexing both indices along the same equivalence preserves the determinant.
 
-For the `simp` version of this lemma, see `det_minor_equiv_self`; this one is unsuitable because
+For the `simp` version of this lemma, see `det_submatrix_equiv_self`; this one is unsuitable because
 `matrix.reindex_apply` unfolds `reindex` first.
 -/
 lemma det_reindex_self (e : m ≃ n) (A : matrix m m R) : det (reindex e e A) = det A :=
-det_minor_equiv_self e.symm A
+det_submatrix_equiv_self e.symm A
 
 /-- The determinant of a permutation matrix equals its sign. -/
 @[simp] lemma det_permutation (σ : perm n) :
@@ -261,14 +265,15 @@ by rw [←det_smul_of_tower, units.neg_smul, one_smul]
 /-- Multiplying each row by a fixed `v i` multiplies the determinant by
 the product of the `v`s. -/
 lemma det_mul_row (v : n → R) (A : matrix n n R) :
-  det (λ i j, v j * A i j) = (∏ i, v i) * det A :=
-calc det (λ i j, v j * A i j) = det (A ⬝ diagonal v) : congr_arg det $ by { ext, simp [mul_comm] }
-                          ... = (∏ i, v i) * det A : by rw [det_mul, det_diagonal, mul_comm]
+  det (of $ λ i j, v j * A i j) = (∏ i, v i) * det A :=
+calc  det (of $ λ i j, v j * A i j)
+    = det (A ⬝ diagonal v) : congr_arg det $ by { ext, simp [mul_comm] }
+... = (∏ i, v i) * det A : by rw [det_mul, det_diagonal, mul_comm]
 
 /-- Multiplying each column by a fixed `v j` multiplies the determinant by
 the product of the `v`s. -/
 lemma det_mul_column (v : n → R) (A : matrix n n R) :
-  det (λ i j, v i * A i j) = (∏ i, v i) * det A :=
+  det (of $ λ i j, v i * A i j) = (∏ i, v i) * det A :=
 multilinear_map.map_smul_univ _ v A
 
 @[simp] lemma det_pow (M : matrix m m R) (n : ℕ) : det (M ^ n) = (det M) ^ n :=
@@ -640,16 +645,16 @@ by rw [←det_transpose, from_blocks_transpose, transpose_zero, det_from_blocks_
 /-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column 0. -/
 lemma det_succ_column_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
   det A = ∑ i : fin n.succ, (-1) ^ (i : ℕ) * A i 0 *
-    det (A.minor i.succ_above fin.succ) :=
+    det (A.submatrix i.succ_above fin.succ) :=
 begin
   rw [matrix.det_apply, finset.univ_perm_fin_succ, ← finset.univ_product_univ],
-  simp only [finset.sum_map, equiv.to_embedding_apply, finset.sum_product, matrix.minor],
+  simp only [finset.sum_map, equiv.to_embedding_apply, finset.sum_product, matrix.submatrix],
   refine finset.sum_congr rfl (λ i _, fin.cases _ (λ i, _) i),
   { simp only [fin.prod_univ_succ, matrix.det_apply, finset.mul_sum,
         equiv.perm.decompose_fin_symm_apply_zero, fin.coe_zero, one_mul,
         equiv.perm.decompose_fin.symm_sign, equiv.swap_self, if_true, id.def, eq_self_iff_true,
         equiv.perm.decompose_fin_symm_apply_succ, fin.succ_above_zero, equiv.coe_refl, pow_zero,
-        mul_smul_comm] },
+        mul_smul_comm, of_apply] },
   -- `univ_perm_fin_succ` gives a different embedding of `perm (fin n)` into
   -- `perm (fin n.succ)` than the determinant of the submatrix we want,
   -- permute `A` so that we get the correct one.
@@ -674,16 +679,16 @@ end
 /-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row 0. -/
 lemma det_succ_row_zero {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) :
   det A = ∑ j : fin n.succ, (-1) ^ (j : ℕ) * A 0 j *
-    det (A.minor fin.succ j.succ_above) :=
+    det (A.submatrix fin.succ j.succ_above) :=
 by { rw [← det_transpose A, det_succ_column_zero],
      refine finset.sum_congr rfl (λ i _, _),
      rw [← det_transpose],
-     simp only [transpose_apply, transpose_minor, transpose_transpose] }
+     simp only [transpose_apply, transpose_submatrix, transpose_transpose] }
 
 /-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along row `i`. -/
 lemma det_succ_row {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (i : fin n.succ) :
   det A = ∑ j : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
-    det (A.minor i.succ_above j.succ_above) :=
+    det (A.submatrix i.succ_above j.succ_above) :=
 begin
   simp_rw [pow_add, mul_assoc, ← mul_sum],
   have : det A = (-1 : R) ^ (i : ℕ) * (i.cycle_range⁻¹).sign * det A,
@@ -695,7 +700,7 @@ begin
   congr,
   rw [← det_permute, det_succ_row_zero],
   refine finset.sum_congr rfl (λ j _, _),
-  rw [mul_assoc, matrix.minor, matrix.minor],
+  rw [mul_assoc, matrix.submatrix, matrix.submatrix],
   congr,
   { rw [equiv.perm.inv_def, fin.cycle_range_symm_zero] },
   { ext i' j',
@@ -705,10 +710,10 @@ end
 /-- Laplacian expansion of the determinant of an `n+1 × n+1` matrix along column `j`. -/
 lemma det_succ_column {n : ℕ} (A : matrix (fin n.succ) (fin n.succ) R) (j : fin n.succ) :
   det A = ∑ i : fin n.succ, (-1) ^ (i + j : ℕ) * A i j *
-    det (A.minor i.succ_above j.succ_above) :=
+    det (A.submatrix i.succ_above j.succ_above) :=
 by { rw [← det_transpose, det_succ_row _ j],
      refine finset.sum_congr rfl (λ i _, _),
-     rw [add_comm, ← det_transpose, transpose_apply, transpose_minor, transpose_transpose] }
+     rw [add_comm, ← det_transpose, transpose_apply, transpose_submatrix, transpose_transpose] }
 
 
 /-- Determinant of 0x0 matrix -/
@@ -718,6 +723,8 @@ det_is_empty
 /-- Determinant of 1x1 matrix -/
 lemma det_fin_one (A : matrix (fin 1) (fin 1) R) : det A = A 0 0  := det_unique A
 
+lemma det_fin_one_of (a : R) : det !![a] = a := det_fin_one _
+
 /-- Determinant of 2x2 matrix -/
 lemma det_fin_two (A : matrix (fin 2) (fin 2) R) :
   det A = A 0 0 * A 1 1 - A 0 1 * A 1 0 :=
@@ -726,6 +733,10 @@ begin
   ring
 end
 
+@[simp] lemma det_fin_two_of (a b c d : R) :
+  matrix.det !![a, b; c, d] = a * d - b * c :=
+det_fin_two _
+
 /-- Determinant of 3x3 matrix -/
 lemma det_fin_three (A : matrix (fin 3) (fin 3) R) :
   det A = A 0 0 * A 1 1 * A 2 2 - A 0 0 * A 1 2 * A 2 1 - A 0 1 * A 1 0 * A 2 2
diff --git a/src/linear_algebra/matrix/diagonal.lean b/src/linear_algebra/matrix/diagonal.lean
index 646c9da5c390e..107f7f51f388f 100644
--- a/src/linear_algebra/matrix/diagonal.lean
+++ b/src/linear_algebra/matrix/diagonal.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
 import linear_algebra.matrix.to_lin
+import linear_algebra.free_module.rank
 
 /-!
 # Diagonal matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some results on the linear map corresponding to a
 diagonal matrix (`range`, `ker` and `rank`).
 
@@ -32,23 +36,16 @@ variables {n : Type*} [fintype n] [decidable_eq n] {R : Type v} [comm_ring R]
 
 lemma proj_diagonal (i : n) (w : n → R) :
   (proj i).comp (to_lin' (diagonal w)) = (w i) • proj i :=
-by ext j; simp [mul_vec_diagonal]
+linear_map.ext $ λ j, mul_vec_diagonal _ _ _
 
 lemma diagonal_comp_std_basis (w : n → R) (i : n) :
   (diagonal w).to_lin'.comp (linear_map.std_basis R (λ_:n, R) i) =
   (w i) • linear_map.std_basis R (λ_:n, R) i :=
-begin
-  ext j,
-  simp_rw [linear_map.comp_apply, to_lin'_apply, mul_vec_diagonal, linear_map.smul_apply,
-           pi.smul_apply, algebra.id.smul_eq_mul],
-  by_cases i = j,
-  { subst h },
-  { rw [std_basis_ne R (λ_:n, R) _ _ (ne.symm h), _root_.mul_zero, _root_.mul_zero] }
-end
+linear_map.ext $ λ x, (diagonal_mul_vec_single w _ _).trans (pi.single_smul' i (w i) x)
 
 lemma diagonal_to_lin' (w : n → R) :
   (diagonal w).to_lin' = linear_map.pi (λi, w i • linear_map.proj i) :=
-by ext v j; simp [mul_vec_diagonal]
+linear_map.ext $ λ v, funext $ λ i, mul_vec_diagonal _ _ _
 
 end comm_ring
 
@@ -65,14 +62,14 @@ begin
   simp only [comap_infi, ← this, proj_diagonal, ker_smul'],
   have : univ ⊆ {i : m | w i = 0} ∪ {i : m | w i = 0}ᶜ, { rw set.union_compl_self },
   exact (supr_range_std_basis_eq_infi_ker_proj K (λi:m, K)
-    disjoint_compl_right this (finite.of_fintype _)).symm
+    disjoint_compl_right this (set.to_finite _)).symm
 end
 
 lemma range_diagonal [decidable_eq m] (w : m → K) :
   (diagonal w).to_lin'.range = (⨆ i ∈ {i | w i ≠ 0}, (linear_map.std_basis K (λi, K) i).range) :=
 begin
   dsimp only [mem_set_of_eq],
-  rw [← map_top, ← supr_range_std_basis, map_supr],
+  rw [← submodule.map_top, ← supr_range_std_basis, submodule.map_supr],
   congr, funext i,
   rw [← linear_map.range_comp, diagonal_comp_std_basis, ← range_smul']
 end
@@ -82,10 +79,10 @@ lemma rank_diagonal [decidable_eq m] [decidable_eq K] (w : m → K) :
 begin
   have hu : univ ⊆ {i : m | w i = 0}ᶜ ∪ {i : m | w i = 0}, { rw set.compl_union_self },
   have hd : disjoint {i : m | w i ≠ 0} {i : m | w i = 0} := disjoint_compl_left,
-  have B₁ := supr_range_std_basis_eq_infi_ker_proj K (λi:m, K) hd hu (finite.of_fintype _),
+  have B₁ := supr_range_std_basis_eq_infi_ker_proj K (λi:m, K) hd hu (set.to_finite _),
   have B₂ := @infi_ker_proj_equiv K _ _ (λi:m, K) _ _ _ _ (by simp; apply_instance) hd hu,
-  rw [rank, range_diagonal, B₁, ←@dim_fun' K],
-  apply linear_equiv.dim_eq,
+  rw [rank, range_diagonal, B₁, ←@rank_fun' K],
+  apply linear_equiv.rank_eq,
   apply B₂,
 end
 
diff --git a/src/linear_algebra/matrix/dot_product.lean b/src/linear_algebra/matrix/dot_product.lean
index c6b916b3ff7eb..e3c81c8f65d16 100644
--- a/src/linear_algebra/matrix/dot_product.lean
+++ b/src/linear_algebra/matrix/dot_product.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
 
+import algebra.star.order
 import data.matrix.basic
 import linear_algebra.std_basis
 
 /-!
 # Dot product of two vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some results on the map `matrix.dot_product`, which maps two
 vectors `v w : n → R` to the sum of the entrywise products `v i * w i`.
 
@@ -27,10 +31,12 @@ matrix, reindex
 -/
 
 universes v w
+variables {R : Type v} {n : Type w}
 
 namespace matrix
 
-variables {R : Type v} [semiring R] {n : Type w} [fintype n]
+section semiring
+variables [semiring R] [fintype n]
 
 @[simp] lemma dot_product_std_basis_eq_mul [decidable_eq n] (v : n → R) (c : R) (i : n) :
   dot_product v (linear_map.std_basis R (λ _, R) i c) = v i * c :=
@@ -62,4 +68,30 @@ dot_product_eq _ _ $ λ u, (h u).symm ▸ (zero_dot_product u).symm
 lemma dot_product_eq_zero_iff {v : n → R} : (∀ w, dot_product v w = 0) ↔ v = 0 :=
 ⟨λ h, dot_product_eq_zero v h, λ h w, h.symm ▸ zero_dot_product w⟩
 
+end semiring
+
+section self
+variables [fintype n]
+
+@[simp] lemma dot_product_self_eq_zero [linear_ordered_ring R] {v : n → R} :
+  dot_product v v = 0 ↔ v = 0 :=
+(finset.sum_eq_zero_iff_of_nonneg $ λ i _, mul_self_nonneg (v i)).trans $
+  by simp [function.funext_iff]
+
+/-- Note that this applies to `ℂ` via `complex.strict_ordered_comm_ring`. -/
+@[simp] lemma dot_product_star_self_eq_zero
+  [partial_order R] [non_unital_ring R] [star_ordered_ring R] [no_zero_divisors R] {v : n → R} :
+  dot_product (star v) v = 0 ↔ v = 0 :=
+(finset.sum_eq_zero_iff_of_nonneg $ λ i _, (@star_mul_self_nonneg _ _ _ _ (v i) : _)).trans $
+  by simp [function.funext_iff, mul_eq_zero]
+
+/-- Note that this applies to `ℂ` via `complex.strict_ordered_comm_ring`. -/
+@[simp] lemma dot_product_self_star_eq_zero
+  [partial_order R] [non_unital_ring R] [star_ordered_ring R] [no_zero_divisors R] {v : n → R} :
+  dot_product v (star v) = 0 ↔ v = 0 :=
+(finset.sum_eq_zero_iff_of_nonneg $ λ i _, (@star_mul_self_nonneg' _ _ _ _ (v i) : _)).trans $
+  by simp [function.funext_iff, mul_eq_zero]
+
+end self
+
 end matrix
diff --git a/src/linear_algebra/matrix/dual.lean b/src/linear_algebra/matrix/dual.lean
index 46fc198a39498..4d112dd3c56d3 100644
--- a/src/linear_algebra/matrix/dual.lean
+++ b/src/linear_algebra/matrix/dual.lean
@@ -8,6 +8,9 @@ import linear_algebra.matrix.to_lin
 /-!
 # Dual space, linear maps and matrices.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some results on the matrix corresponding to the
 transpose of a linear map (in the dual space).
 
diff --git a/src/linear_algebra/matrix/finite_dimensional.lean b/src/linear_algebra/matrix/finite_dimensional.lean
index aaeefb583faa5..1930c3fab027c 100644
--- a/src/linear_algebra/matrix/finite_dimensional.lean
+++ b/src/linear_algebra/matrix/finite_dimensional.lean
@@ -5,17 +5,23 @@ Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
 import data.matrix.basic
 import linear_algebra.finite_dimensional
+import linear_algebra.free_module.finite.matrix
+import linear_algebra.matrix.to_lin
 
 /-!
 # The finite-dimensional space of matrices
 
-This file shows that `m` by `n` matrices form a finite-dimensional space,
-and proves the `finrank` of that space is equal to `card m * card n`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file shows that `m` by `n` matrices form a finite-dimensional space.
+Note that this is proven more generally elsewhere over modules as `module.finite.matrix`; this file
+exists only to provide an entry in the instance list for `finite_dimensional`.
 
 ## Main definitions
 
  * `matrix.finite_dimensional`: matrices form a finite dimensional vector space over a field `K`
- * `matrix.finrank_matrix`: the `finrank` of `matrix m n R` is `card m * card n`
+ * `linear_map.finite_dimensional`
 
 ## Tags
 
@@ -29,21 +35,31 @@ namespace matrix
 
 section finite_dimensional
 
-variables {m n : Type*} [fintype m] [fintype n]
-variables {R : Type v} [field R]
-
-instance : finite_dimensional R (matrix m n R) :=
-linear_equiv.finite_dimensional (linear_equiv.curry R m n)
+variables {m n : Type*} {R : Type v} [field R]
 
-/--
-The dimension of the space of finite dimensional matrices
-is the product of the number of rows and columns.
--/
-@[simp] lemma finrank_matrix :
-  finite_dimensional.finrank R (matrix m n R) = fintype.card m * fintype.card n :=
-by rw [@linear_equiv.finrank_eq R (matrix m n R) _ _ _ _ _ _ (linear_equiv.curry R m n).symm,
-       finite_dimensional.finrank_fintype_fun_eq_card, fintype.card_prod]
+instance [finite m] [finite n] : finite_dimensional R (matrix m n R) :=
+module.finite.matrix
 
 end finite_dimensional
 
 end matrix
+
+namespace linear_map
+
+variables {K : Type*} [field K]
+variables {V : Type*} [add_comm_group V] [module K V] [finite_dimensional K V]
+variables {W : Type*} [add_comm_group W] [module K W] [finite_dimensional K W]
+
+instance finite_dimensional : finite_dimensional K (V →ₗ[K] W) :=
+module.finite.linear_map _ _
+
+variables {A : Type*} [ring A] [algebra K A] [module A V] [is_scalar_tower K A V]
+  [module A W] [is_scalar_tower K A W]
+
+/-- Linear maps over a `k`-algebra are finite dimensional (over `k`) if both the source and
+target are, as they form a subspace of all `k`-linear maps. -/
+instance finite_dimensional' : finite_dimensional K (V →ₗ[A] W) :=
+finite_dimensional.of_injective (restrict_scalars_linear_map K A V W)
+  (restrict_scalars_injective _)
+
+end linear_map
diff --git a/src/linear_algebra/matrix/general_linear_group.lean b/src/linear_algebra/matrix/general_linear_group.lean
new file mode 100644
index 0000000000000..659ad251c659e
--- /dev/null
+++ b/src/linear_algebra/matrix/general_linear_group.lean
@@ -0,0 +1,245 @@
+/-
+Copyright (c) 2021 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck
+-/
+import linear_algebra.general_linear_group
+import linear_algebra.matrix.nonsingular_inverse
+import linear_algebra.matrix.special_linear_group
+
+/-!
+# The General Linear group $GL(n, R)$
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the elements of the General Linear group `general_linear_group n R`,
+consisting of all invertible `n` by `n` `R`-matrices.
+
+## Main definitions
+
+* `matrix.general_linear_group` is the type of matrices over R which are units in the matrix ring.
+* `matrix.GL_pos` gives the subgroup of matrices with
+  positive determinant (over a linear ordered ring).
+
+## Tags
+
+matrix group, group, matrix inverse
+-/
+
+namespace matrix
+universes u v
+open_locale matrix
+open linear_map
+
+-- disable this instance so we do not accidentally use it in lemmas.
+local attribute [-instance] special_linear_group.has_coe_to_fun
+
+/-- `GL n R` is the group of `n` by `n` `R`-matrices with unit determinant.
+Defined as a subtype of matrices-/
+abbreviation general_linear_group (n : Type u) (R : Type v)
+  [decidable_eq n] [fintype n] [comm_ring R] : Type* := (matrix n n R)ˣ
+
+notation `GL` := general_linear_group
+
+namespace general_linear_group
+
+variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
+
+/-- The determinant of a unit matrix is itself a unit. -/
+@[simps]
+def det : GL n R →* Rˣ :=
+{ to_fun := λ A,
+  { val := (↑A : matrix n n R).det,
+    inv := (↑(A⁻¹) : matrix n n R).det,
+    val_inv := by rw [←det_mul, ←mul_eq_mul, A.mul_inv, det_one],
+    inv_val := by rw [←det_mul, ←mul_eq_mul, A.inv_mul, det_one]},
+  map_one' := units.ext det_one,
+  map_mul' := λ A B, units.ext $ det_mul _ _ }
+
+/--The `GL n R` and `general_linear_group R n` groups are multiplicatively equivalent-/
+def to_lin : (GL n R) ≃* (linear_map.general_linear_group R (n → R)) :=
+units.map_equiv to_lin_alg_equiv'.to_mul_equiv
+
+/--Given a matrix with invertible determinant we get an element of `GL n R`-/
+def mk' (A : matrix n n R) (h : invertible (matrix.det A)) : GL n R :=
+unit_of_det_invertible A
+
+/--Given a matrix with unit determinant we get an element of `GL n R`-/
+noncomputable def mk'' (A : matrix n n R) (h : is_unit (matrix.det A)) : GL n R :=
+nonsing_inv_unit A h
+
+/--Given a matrix with non-zero determinant over a field, we get an element of `GL n K`-/
+def mk_of_det_ne_zero {K : Type*} [field K] (A : matrix n n K) (h : matrix.det A ≠ 0) :
+  GL n K :=
+mk' A (invertible_of_nonzero h)
+
+lemma ext_iff (A B : GL n R) : A = B ↔ (∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :=
+units.ext_iff.trans matrix.ext_iff.symm
+
+/-- Not marked `@[ext]` as the `ext` tactic already solves this. -/
+lemma ext ⦃A B : GL n R⦄ (h : ∀ i j, (A : matrix n n R) i j = (B : matrix n n R) i j) :
+  A = B :=
+units.ext $ matrix.ext h
+
+section coe_lemmas
+
+variables (A B : GL n R)
+
+@[simp] lemma coe_mul : ↑(A * B) = (↑A : matrix n n R) ⬝ (↑B : matrix n n R) := rfl
+
+@[simp] lemma coe_one : ↑(1 : GL n R) = (1 : matrix n n R) := rfl
+
+lemma coe_inv : ↑(A⁻¹) = (↑A : matrix n n R)⁻¹ :=
+begin
+  letI := A.invertible,
+  exact inv_of_eq_nonsing_inv (↑A : matrix n n R),
+end
+
+/-- An element of the matrix general linear group on `(n) [fintype n]` can be considered as an
+element of the endomorphism general linear group on `n → R`. -/
+def to_linear : general_linear_group n R ≃* linear_map.general_linear_group R (n → R) :=
+units.map_equiv matrix.to_lin_alg_equiv'.to_ring_equiv.to_mul_equiv
+
+-- Note that without the `@` and `‹_›`, lean infers `λ a b, _inst a b` instead of `_inst` as the
+-- decidability argument, which prevents `simp` from obtaining the instance by unification.
+-- These `λ a b, _inst a b` terms also appear in the type of `A`, but simp doesn't get confused by
+-- them so for now we do not care.
+@[simp] lemma coe_to_linear :
+  (@to_linear n ‹_› ‹_› _ _ A : (n → R) →ₗ[R] (n → R)) = matrix.mul_vec_lin A :=
+rfl
+
+@[simp] lemma to_linear_apply (v : n → R) :
+  (@to_linear n ‹_› ‹_› _ _ A) v = matrix.mul_vec_lin ↑A v :=
+rfl
+
+end coe_lemmas
+
+end general_linear_group
+
+namespace special_linear_group
+
+variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
+
+instance has_coe_to_general_linear_group : has_coe (special_linear_group n R) (GL n R) :=
+⟨λ A, ⟨↑A, ↑(A⁻¹), congr_arg coe (mul_right_inv A), congr_arg coe (mul_left_inv A)⟩⟩
+
+@[simp] lemma coe_to_GL_det (g : special_linear_group n R) : (g : GL n R).det = 1 :=
+units.ext g.prop
+
+end special_linear_group
+
+section
+
+variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
+
+section
+variables (n R)
+
+/-- This is the subgroup of `nxn` matrices with entries over a
+linear ordered ring and positive determinant. -/
+def GL_pos : subgroup (GL n R) :=
+(units.pos_subgroup R).comap general_linear_group.det
+end
+
+@[simp] lemma mem_GL_pos (A : GL n R) : A ∈ GL_pos n R ↔ 0 < (A.det : R) := iff.rfl
+
+lemma GL_pos.det_ne_zero (A : GL_pos n R) : (A : matrix n n R).det ≠ 0 := ne_of_gt A.prop
+
+end
+
+section has_neg
+
+variables {n : Type u} {R : Type v} [decidable_eq n] [fintype n] [linear_ordered_comm_ring R ]
+[fact (even (fintype.card n))]
+
+/-- Formal operation of negation on general linear group on even cardinality `n` given by negating
+each element. -/
+instance : has_neg (GL_pos n R) :=
+⟨λ g, ⟨-g, begin
+    rw [mem_GL_pos, general_linear_group.coe_det_apply, units.coe_neg, det_neg,
+      (fact.out $ even $ fintype.card n).neg_one_pow, one_mul],
+    exact g.prop,
+  end⟩⟩
+
+@[simp] lemma GL_pos.coe_neg_GL (g : GL_pos n R) : ↑(-g) = -(g : GL n R) := rfl
+@[simp] lemma GL_pos.coe_neg (g : GL_pos n R) : ↑(-g) = -(g : matrix n n R) := rfl
+
+@[simp] lemma GL_pos.coe_neg_apply (g : GL_pos n R) (i j : n) :
+  (↑(-g) : matrix n n R) i j = -((↑g : matrix n n R) i j) :=
+rfl
+
+instance : has_distrib_neg (GL_pos n R) :=
+subtype.coe_injective.has_distrib_neg _ GL_pos.coe_neg_GL (GL_pos n R).coe_mul
+
+end has_neg
+
+namespace special_linear_group
+
+variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [linear_ordered_comm_ring R]
+
+/-- `special_linear_group n R` embeds into `GL_pos n R` -/
+def to_GL_pos : special_linear_group n R →* GL_pos n R :=
+{ to_fun := λ A, ⟨(A : GL n R), show 0 < (↑A : matrix n n R).det, from A.prop.symm ▸ zero_lt_one⟩,
+  map_one' := subtype.ext $ units.ext $ rfl,
+  map_mul' := λ A₁ A₂, subtype.ext $ units.ext $ rfl }
+
+instance : has_coe (special_linear_group n R) (GL_pos n R) := ⟨to_GL_pos⟩
+
+lemma coe_eq_to_GL_pos : (coe : special_linear_group n R → GL_pos n R) = to_GL_pos := rfl
+
+lemma to_GL_pos_injective :
+  function.injective (to_GL_pos : special_linear_group n R → GL_pos n R) :=
+(show function.injective ((coe : GL_pos n R → matrix n n R) ∘ to_GL_pos),
+ from subtype.coe_injective).of_comp
+
+/-- Coercing a `special_linear_group` via `GL_pos` and `GL` is the same as coercing striaght to a
+matrix. -/
+@[simp]
+lemma coe_GL_pos_coe_GL_coe_matrix (g : special_linear_group n R) :
+    (↑(↑(↑g : GL_pos n R) : GL n R) : matrix n n R) = ↑g := rfl
+
+@[simp] lemma coe_to_GL_pos_to_GL_det (g : special_linear_group n R) :
+  ((g : GL_pos n R) : GL n R).det = 1 :=
+units.ext g.prop
+
+variable [fact (even (fintype.card n))]
+
+@[norm_cast] lemma coe_GL_pos_neg (g : special_linear_group n R) :
+  ↑(-g) = -(↑g : GL_pos n R) := subtype.ext $ units.ext rfl
+
+end special_linear_group
+
+section examples
+
+/-- The matrix [a, -b; b, a] (inspired by multiplication by a complex number); it is an element of
+$GL_2(R)$ if `a ^ 2 + b ^ 2` is nonzero. -/
+@[simps coe {fully_applied := ff}]
+def plane_conformal_matrix {R} [field R] (a b : R) (hab : a ^ 2 + b ^ 2 ≠ 0) :
+  matrix.general_linear_group (fin 2) R :=
+general_linear_group.mk_of_det_ne_zero !![a, -b; b, a]
+  (by simpa [det_fin_two, sq] using hab)
+
+/- TODO: Add Iwasawa matrices `n_x=!![1,x; 0,1]`, `a_t=!![exp(t/2),0;0,exp(-t/2)]` and
+  `k_θ=!![cos θ, sin θ; -sin θ, cos θ]`
+-/
+
+end examples
+
+namespace general_linear_group
+variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
+
+-- this section should be last to ensure we do not use it in lemmas
+section coe_fn_instance
+
+/-- This instance is here for convenience, but is not the simp-normal form. -/
+instance : has_coe_to_fun (GL n R) (λ _, n → n → R) :=
+{ coe := λ A, A.val }
+
+@[simp] lemma coe_fn_eq_coe (A : GL n R) : ⇑A = (↑A : matrix n n R) := rfl
+
+end coe_fn_instance
+
+end general_linear_group
+
+end matrix
diff --git a/src/linear_algebra/matrix/hermitian.lean b/src/linear_algebra/matrix/hermitian.lean
new file mode 100644
index 0000000000000..eb070688eae94
--- /dev/null
+++ b/src/linear_algebra/matrix/hermitian.lean
@@ -0,0 +1,260 @@
+/-
+Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+import analysis.inner_product_space.pi_L2
+
+/-! # Hermitian matrices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines hermitian matrices and some basic results about them.
+
+See also `is_self_adjoint`, which generalizes this definition to other star rings.
+
+## Main definition
+
+ * `matrix.is_hermitian` : a matrix `A : matrix n n α` is hermitian if `Aᴴ = A`.
+
+## Tags
+
+self-adjoint matrix, hermitian matrix
+
+-/
+
+namespace matrix
+
+variables {α β : Type*} {m n : Type*} {A : matrix n n α}
+
+open_locale matrix
+
+local notation `⟪`x`, `y`⟫` := @inner α _ _ x y
+
+section has_star
+variables [has_star α] [has_star β]
+
+/-- A matrix is hermitian if it is equal to its conjugate transpose. On the reals, this definition
+captures symmetric matrices. -/
+def is_hermitian (A : matrix n n α) : Prop := Aᴴ = A
+
+lemma is_hermitian.eq {A : matrix n n α} (h : A.is_hermitian) : Aᴴ = A := h
+
+protected lemma is_hermitian.is_self_adjoint {A : matrix n n α} (h : A.is_hermitian) :
+  is_self_adjoint A := h
+
+@[ext]
+lemma is_hermitian.ext {A : matrix n n α} : (∀ i j, star (A j i) = A i j) → A.is_hermitian :=
+by { intros h, ext i j, exact h i j }
+
+lemma is_hermitian.apply {A : matrix n n α} (h : A.is_hermitian) (i j : n) : star (A j i) = A i j :=
+congr_fun (congr_fun h _) _
+
+lemma is_hermitian.ext_iff {A : matrix n n α} : A.is_hermitian ↔ ∀ i j, star (A j i) = A i j :=
+⟨is_hermitian.apply, is_hermitian.ext⟩
+
+@[simp] lemma is_hermitian.map {A : matrix n n α} (h : A.is_hermitian) (f : α → β)
+  (hf : function.semiconj f star star) :
+  (A.map f).is_hermitian :=
+(conj_transpose_map f hf).symm.trans $ h.eq.symm ▸ rfl
+
+lemma is_hermitian.transpose {A : matrix n n α} (h : A.is_hermitian) :
+  Aᵀ.is_hermitian :=
+by { rw [is_hermitian, conj_transpose, transpose_map], congr, exact h }
+
+@[simp] lemma is_hermitian_transpose_iff (A : matrix n n α) :
+  Aᵀ.is_hermitian ↔ A.is_hermitian :=
+⟨by { intro h, rw [← transpose_transpose A], exact is_hermitian.transpose h },
+  is_hermitian.transpose⟩
+
+lemma is_hermitian.conj_transpose {A : matrix n n α} (h : A.is_hermitian) :
+  Aᴴ.is_hermitian :=
+h.transpose.map _ $ λ _, rfl
+
+@[simp] lemma is_hermitian.submatrix {A : matrix n n α} (h : A.is_hermitian) (f : m → n) :
+  (A.submatrix f f).is_hermitian :=
+(conj_transpose_submatrix _ _ _).trans (h.symm ▸ rfl)
+
+@[simp] lemma is_hermitian_submatrix_equiv {A : matrix n n α} (e : m ≃ n) :
+  (A.submatrix e e).is_hermitian ↔ A.is_hermitian :=
+⟨λ h, by simpa using h.submatrix e.symm, λ h, h.submatrix _⟩
+
+end has_star
+
+section has_involutive_star
+variables [has_involutive_star α]
+
+@[simp] lemma is_hermitian_conj_transpose_iff (A : matrix n n α) :
+  Aᴴ.is_hermitian ↔ A.is_hermitian :=
+is_self_adjoint.star_iff
+
+/-- A block matrix `A.from_blocks B C D` is hermitian,
+    if `A` and `D` are hermitian and `Bᴴ = C`. -/
+lemma is_hermitian.from_blocks
+  {A : matrix m m α} {B : matrix m n α} {C : matrix n m α} {D : matrix n n α}
+  (hA : A.is_hermitian) (hBC : Bᴴ = C) (hD : D.is_hermitian) :
+  (A.from_blocks B C D).is_hermitian :=
+begin
+  have hCB : Cᴴ = B,
+  { rw [← hBC, conj_transpose_conj_transpose] },
+  unfold matrix.is_hermitian,
+  rw from_blocks_conj_transpose,
+  congr;
+  assumption
+end
+
+/-- This is the `iff` version of `matrix.is_hermitian.from_blocks`. -/
+lemma is_hermitian_from_blocks_iff
+  {A : matrix m m α} {B : matrix m n α} {C : matrix n m α} {D : matrix n n α} :
+  (A.from_blocks B C D).is_hermitian ↔ A.is_hermitian ∧ Bᴴ = C ∧ Cᴴ = B ∧ D.is_hermitian :=
+⟨λ h, ⟨congr_arg to_blocks₁₁ h, congr_arg to_blocks₂₁ h,
+       congr_arg to_blocks₁₂ h, congr_arg to_blocks₂₂ h⟩,
+ λ ⟨hA, hBC, hCB, hD⟩, is_hermitian.from_blocks hA hBC hD⟩
+
+end has_involutive_star
+
+section add_monoid
+variables [add_monoid α] [star_add_monoid α] [add_monoid β] [star_add_monoid β]
+
+/-- A diagonal matrix is hermitian if the entries are self-adjoint -/
+lemma is_hermitian_diagonal_of_self_adjoint [decidable_eq n]
+  (v : n → α) (h : is_self_adjoint v) :
+  (diagonal v).is_hermitian :=
+-- TODO: add a `pi.has_trivial_star` instance and remove the `funext`
+(diagonal_conj_transpose v).trans $ congr_arg _ h
+
+/-- A diagonal matrix is hermitian if the entries have the trivial `star` operation
+(such as on the reals). -/
+@[simp] lemma is_hermitian_diagonal [has_trivial_star α] [decidable_eq n] (v : n → α) :
+  (diagonal v).is_hermitian :=
+is_hermitian_diagonal_of_self_adjoint _ (is_self_adjoint.all _)
+
+@[simp] lemma is_hermitian_zero :
+  (0 : matrix n n α).is_hermitian :=
+is_self_adjoint_zero _
+
+@[simp] lemma is_hermitian.add {A B : matrix n n α} (hA : A.is_hermitian) (hB : B.is_hermitian) :
+  (A + B).is_hermitian :=
+is_self_adjoint.add hA hB
+
+end add_monoid
+
+section add_comm_monoid
+variables [add_comm_monoid α] [star_add_monoid α]
+
+lemma is_hermitian_add_transpose_self (A : matrix n n α) :
+  (A + Aᴴ).is_hermitian :=
+is_self_adjoint_add_star_self A
+
+lemma is_hermitian_transpose_add_self (A : matrix n n α) :
+  (Aᴴ + A).is_hermitian :=
+is_self_adjoint_star_add_self A
+
+end add_comm_monoid
+
+section add_group
+variables [add_group α] [star_add_monoid α]
+
+@[simp] lemma is_hermitian.neg {A : matrix n n α} (h : A.is_hermitian) :
+  (-A).is_hermitian :=
+is_self_adjoint.neg h
+
+@[simp] lemma is_hermitian.sub {A B : matrix n n α} (hA : A.is_hermitian) (hB : B.is_hermitian) :
+  (A - B).is_hermitian :=
+is_self_adjoint.sub hA hB
+
+end add_group
+
+section non_unital_semiring
+variables [non_unital_semiring α] [star_ring α] [non_unital_semiring β] [star_ring β]
+
+/-- Note this is more general than `is_self_adjoint.mul_star_self` as `B` can be rectangular. -/
+lemma is_hermitian_mul_conj_transpose_self [fintype n] (A : matrix m n α) :
+  (A ⬝ Aᴴ).is_hermitian :=
+by rw [is_hermitian, conj_transpose_mul, conj_transpose_conj_transpose]
+
+/-- Note this is more general than `is_self_adjoint.star_mul_self` as `B` can be rectangular. -/
+lemma is_hermitian_transpose_mul_self [fintype m] (A : matrix m n α) :
+  (Aᴴ ⬝ A).is_hermitian :=
+by rw [is_hermitian, conj_transpose_mul, conj_transpose_conj_transpose]
+
+/-- Note this is more general than `is_self_adjoint.conjugate'` as `B` can be rectangular. -/
+lemma is_hermitian_conj_transpose_mul_mul [fintype m] {A : matrix m m α} (B : matrix m n α)
+  (hA : A.is_hermitian) : (Bᴴ ⬝ A ⬝ B).is_hermitian :=
+by simp only [is_hermitian, conj_transpose_mul, conj_transpose_conj_transpose, hA.eq,
+  matrix.mul_assoc]
+
+/-- Note this is more general than `is_self_adjoint.conjugate` as `B` can be rectangular. -/
+lemma is_hermitian_mul_mul_conj_transpose [fintype m] {A : matrix m m α} (B : matrix n m α)
+  (hA : A.is_hermitian) : (B ⬝ A ⬝ Bᴴ).is_hermitian :=
+by simp only [is_hermitian, conj_transpose_mul, conj_transpose_conj_transpose, hA.eq,
+  matrix.mul_assoc]
+
+end non_unital_semiring
+
+section semiring
+
+variables [semiring α] [star_ring α] [semiring β] [star_ring β]
+
+/-- Note this is more general for matrices than `is_self_adjoint_one` as it does not
+require `fintype n`, which is necessary for `monoid (matrix n n R)`. -/
+@[simp] lemma is_hermitian_one [decidable_eq n] :
+  (1 : matrix n n α).is_hermitian :=
+conj_transpose_one
+
+end semiring
+
+section comm_ring
+variables [comm_ring α] [star_ring α]
+
+lemma is_hermitian.inv [fintype m] [decidable_eq m] {A : matrix m m α}
+  (hA : A.is_hermitian) : A⁻¹.is_hermitian :=
+by simp [is_hermitian, conj_transpose_nonsing_inv, hA.eq]
+
+@[simp] lemma is_hermitian_inv [fintype m] [decidable_eq m] (A : matrix m m α) [invertible A]:
+  (A⁻¹).is_hermitian ↔ A.is_hermitian :=
+⟨λ h, by {rw [← inv_inv_of_invertible A], exact is_hermitian.inv h }, is_hermitian.inv⟩
+
+lemma is_hermitian.adjugate [fintype m] [decidable_eq m] {A : matrix m m α}
+  (hA : A.is_hermitian) : A.adjugate.is_hermitian :=
+by simp [is_hermitian, adjugate_conj_transpose, hA.eq]
+
+end comm_ring
+
+section is_R_or_C
+open is_R_or_C
+
+variables [is_R_or_C α] [is_R_or_C β]
+
+/-- The diagonal elements of a complex hermitian matrix are real. -/
+lemma is_hermitian.coe_re_apply_self {A : matrix n n α} (h : A.is_hermitian) (i : n) :
+  (re (A i i) : α) = A i i :=
+by rw [←conj_eq_iff_re, ←star_def, ←conj_transpose_apply, h.eq]
+
+/-- The diagonal elements of a complex hermitian matrix are real. -/
+lemma is_hermitian.coe_re_diag {A : matrix n n α} (h : A.is_hermitian) :
+  (λ i, (re (A.diag i) : α)) = A.diag :=
+funext h.coe_re_apply_self
+
+/-- A matrix is hermitian iff the corresponding linear map is self adjoint. -/
+lemma is_hermitian_iff_is_symmetric [fintype n] [decidable_eq n] {A : matrix n n α} :
+  is_hermitian A ↔ A.to_euclidean_lin.is_symmetric :=
+begin
+  rw [linear_map.is_symmetric, (pi_Lp.equiv 2 (λ _ : n, α)).symm.surjective.forall₂],
+  simp only [to_euclidean_lin_pi_Lp_equiv_symm, euclidean_space.inner_pi_Lp_equiv_symm,
+    to_lin'_apply, star_mul_vec, dot_product_mul_vec],
+  split,
+  { rintro (h : Aᴴ = A) x y,
+    rw h },
+  { intro h,
+    ext i j,
+    simpa only [(pi.single_star i 1).symm, ← star_mul_vec, mul_one, dot_product_single,
+      single_vec_mul, star_one, one_mul] using
+        h (@pi.single _ _ _ (λ i, add_zero_class.to_has_zero α) i 1)
+          (@pi.single _ _ _ (λ i, add_zero_class.to_has_zero α) j 1) }
+end
+
+end is_R_or_C
+
+end matrix
diff --git a/src/linear_algebra/matrix/invariant_basis_number.lean b/src/linear_algebra/matrix/invariant_basis_number.lean
new file mode 100644
index 0000000000000..de2c532e57ac4
--- /dev/null
+++ b/src/linear_algebra/matrix/invariant_basis_number.lean
@@ -0,0 +1,24 @@
+/-
+Copyright (c) 2022 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Scott Morrison
+-/
+import linear_algebra.matrix.to_lin
+import linear_algebra.invariant_basis_number
+
+/-!
+# Invertible matrices over a ring with invariant basis number are square.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {n m : Type*} [fintype n] [decidable_eq n] [fintype m] [decidable_eq m]
+variables {R : Type*} [semiring R] [invariant_basis_number R]
+
+open_locale matrix
+
+lemma matrix.square_of_invertible
+  (M : matrix n m R) (N : matrix m n R) (h : M ⬝ N = 1) (h' : N ⬝ M = 1) :
+  fintype.card n = fintype.card m :=
+card_eq_of_lequiv R (matrix.to_linear_equiv_right'_of_inv h' h)
diff --git a/src/linear_algebra/matrix/is_diag.lean b/src/linear_algebra/matrix/is_diag.lean
index f4c75fe90ec93..4616127392c31 100644
--- a/src/linear_algebra/matrix/is_diag.lean
+++ b/src/linear_algebra/matrix/is_diag.lean
@@ -10,6 +10,9 @@ import data.matrix.kronecker
 /-!
 # Diagonal matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the definition and basic results about diagonal matrices.
 
 ## Main results
@@ -110,9 +113,9 @@ ha.transpose.map (star_zero _)
   Aᴴ.is_diag ↔ A.is_diag :=
 ⟨ λ ha, by {convert ha.conj_transpose, simp}, is_diag.conj_transpose ⟩
 
-lemma is_diag.minor [has_zero α]
+lemma is_diag.submatrix [has_zero α]
   {A : matrix n n α} (ha : A.is_diag) {f : m → n} (hf : injective f) :
-  (A.minor f f).is_diag :=
+  (A.submatrix f f).is_diag :=
 λ i j h, ha (hf.ne h)
 
 /-- `(A ⊗ B).is_diag` if both `A` and `B` are diagonal. -/
diff --git a/src/linear_algebra/matrix/ldl.lean b/src/linear_algebra/matrix/ldl.lean
new file mode 100644
index 0000000000000..55458ac40f91d
--- /dev/null
+++ b/src/linear_algebra/matrix/ldl.lean
@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+import analysis.inner_product_space.gram_schmidt_ortho
+import linear_algebra.matrix.pos_def
+
+/-! # LDL decomposition
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves the LDL-decomposition of matricies: Any positive definite matrix `S` can be
+decomposed as `S = LDLᴴ` where `L` is a lower-triangular matrix and `D` is a diagonal matrix.
+
+## Main definitions
+
+ * `LDL.lower` is the lower triangular matrix `L`.
+ * `LDL.lower_inv` is the inverse of the lower triangular matrix `L`.
+ * `LDL.diag` is the diagonal matrix `D`.
+
+## Main result
+
+* `ldl_decomposition` states that any positive definite matrix can be decomposed as `LDLᴴ`.
+
+## TODO
+
+* Prove that `LDL.lower` is lower triangular from `LDL.lower_inv_triangular`.
+
+-/
+
+variables {𝕜 : Type*} [is_R_or_C 𝕜]
+variables {n : Type*} [linear_order n] [is_well_order n (<)] [locally_finite_order_bot n]
+
+local notation `⟪`x`, `y`⟫ₑ` := @inner 𝕜 _ _ ((pi_Lp.equiv 2 _).symm x) ((pi_Lp.equiv _ _).symm y)
+
+open matrix
+open_locale matrix
+variables {S : matrix n n 𝕜} [fintype n] (hS : S.pos_def)
+
+/-- The inverse of the lower triangular matrix `L` of the LDL-decomposition. It is obtained by
+applying Gram-Schmidt-Orthogonalization w.r.t. the inner product induced by `Sᵀ` on the standard
+basis vectors `pi.basis_fun`. -/
+noncomputable def LDL.lower_inv : matrix n n 𝕜 :=
+@gram_schmidt
+  𝕜 (n → 𝕜) _
+  (_ : _)
+  (inner_product_space.of_matrix hS.transpose) n _ _ _ (pi.basis_fun 𝕜 n)
+
+lemma LDL.lower_inv_eq_gram_schmidt_basis :
+  LDL.lower_inv hS = ((pi.basis_fun 𝕜 n).to_matrix
+    (@gram_schmidt_basis 𝕜 (n → 𝕜) _ (_ : _)
+    (inner_product_space.of_matrix hS.transpose) n _ _ _ (pi.basis_fun 𝕜 n)))ᵀ :=
+begin
+  ext i j,
+  rw [LDL.lower_inv, basis.coe_pi_basis_fun.to_matrix_eq_transpose, coe_gram_schmidt_basis],
+  refl
+end
+
+noncomputable instance LDL.invertible_lower_inv : invertible (LDL.lower_inv hS) :=
+begin
+  rw [LDL.lower_inv_eq_gram_schmidt_basis],
+  haveI := basis.invertible_to_matrix (pi.basis_fun 𝕜 n)
+    (@gram_schmidt_basis 𝕜 (n → 𝕜) _ (_ : _) (inner_product_space.of_matrix hS.transpose)
+      n _ _ _ (pi.basis_fun 𝕜 n)),
+  apply_instance
+end
+
+lemma LDL.lower_inv_orthogonal {i j : n} (h₀ : i ≠ j) :
+  ⟪(LDL.lower_inv hS i), Sᵀ.mul_vec (LDL.lower_inv hS j)⟫ₑ = 0 :=
+@gram_schmidt_orthogonal 𝕜 _ _ (_ : _) (inner_product_space.of_matrix hS.transpose) _ _ _ _ _ _ _ h₀
+
+/-- The entries of the diagonal matrix `D` of the LDL decomposition. -/
+noncomputable def LDL.diag_entries : n → 𝕜 :=
+λ i, ⟪star (LDL.lower_inv hS i), S.mul_vec (star (LDL.lower_inv hS i))⟫ₑ
+
+/-- The diagonal matrix `D` of the LDL decomposition. -/
+noncomputable def LDL.diag : matrix n n 𝕜 := matrix.diagonal (LDL.diag_entries hS)
+
+lemma LDL.lower_inv_triangular {i j : n} (hij : i < j) :
+  LDL.lower_inv hS i j = 0 :=
+by rw [← @gram_schmidt_triangular
+    𝕜 (n → 𝕜) _ (_ : _) (inner_product_space.of_matrix hS.transpose) n _ _ _
+    i j hij (pi.basis_fun 𝕜 n), pi.basis_fun_repr, LDL.lower_inv]
+
+/-- Inverse statement of **LDL decomposition**: we can conjugate a positive definite matrix
+by some lower triangular matrix and get a diagonal matrix. -/
+lemma LDL.diag_eq_lower_inv_conj : LDL.diag hS = LDL.lower_inv hS ⬝ S ⬝ (LDL.lower_inv hS)ᴴ :=
+begin
+  ext i j,
+  by_cases hij : i = j,
+  { simpa only [hij, LDL.diag, diagonal_apply_eq, LDL.diag_entries, matrix.mul_assoc,
+      euclidean_space.inner_pi_Lp_equiv_symm, star_star] },
+  { simp only [LDL.diag, hij, diagonal_apply_ne, ne.def, not_false_iff, mul_mul_apply],
+    rw [conj_transpose, transpose_map, transpose_transpose, dot_product_mul_vec,
+      (LDL.lower_inv_orthogonal hS (λ h : j = i, hij h.symm)).symm,
+      ← inner_conj_symm, mul_vec_transpose, euclidean_space.inner_pi_Lp_equiv_symm,
+      ← is_R_or_C.star_def, ← star_dot_product_star, dot_product_comm, star_star],
+    refl }
+end
+
+/-- The lower triangular matrix `L` of the LDL decomposition. -/
+noncomputable def LDL.lower := (LDL.lower_inv hS)⁻¹
+
+/-- **LDL decomposition**: any positive definite matrix `S` can be
+decomposed as `S = LDLᴴ` where `L` is a lower-triangular matrix and `D` is a diagonal matrix.  -/
+theorem LDL.lower_conj_diag :
+  LDL.lower hS ⬝ LDL.diag hS ⬝ (LDL.lower hS)ᴴ = S :=
+begin
+  rw [LDL.lower, conj_transpose_nonsing_inv, matrix.mul_assoc,
+    matrix.inv_mul_eq_iff_eq_mul_of_invertible (LDL.lower_inv hS),
+    matrix.mul_inv_eq_iff_eq_mul_of_invertible],
+  exact LDL.diag_eq_lower_inv_conj hS,
+end
diff --git a/src/linear_algebra/matrix/mv_polynomial.lean b/src/linear_algebra/matrix/mv_polynomial.lean
index a850ba8f9809b..64a648d3bd5de 100644
--- a/src/linear_algebra/matrix/mv_polynomial.lean
+++ b/src/linear_algebra/matrix/mv_polynomial.lean
@@ -10,6 +10,9 @@ import data.mv_polynomial.comm_ring
 /-!
 # Matrices of multivariate polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we prove results about matrices over an mv_polynomial ring.
 In particular, we provide `matrix.mv_polynomial_X` which associates every entry of a matrix with a
 unique variable.
@@ -25,8 +28,13 @@ namespace matrix
 variables (m n R)
 
 /-- The matrix with variable `X (i,j)` at location `(i,j)`. -/
-@[simp] noncomputable def mv_polynomial_X [comm_semiring R] : matrix m n (mv_polynomial (m × n) R)
-| i j := mv_polynomial.X (i, j)
+noncomputable def mv_polynomial_X [comm_semiring R] : matrix m n (mv_polynomial (m × n) R) :=
+of $ λ i j, mv_polynomial.X (i, j)
+
+-- TODO: set as an equation lemma for `mv_polynomial_X`, see mathlib4#3024
+@[simp]
+lemma mv_polynomial_X_apply [comm_semiring R] (i j) :
+  mv_polynomial_X m n R i j = mv_polynomial.X (i, j) := rfl
 
 variables {m n R S}
 
diff --git a/src/linear_algebra/matrix/nondegenerate.lean b/src/linear_algebra/matrix/nondegenerate.lean
index 5dfbf769f0461..9c76a186f0680 100644
--- a/src/linear_algebra/matrix/nondegenerate.lean
+++ b/src/linear_algebra/matrix/nondegenerate.lean
@@ -10,6 +10,9 @@ import linear_algebra.matrix.adjugate
 /-!
 # Matrices associated with non-degenerate bilinear forms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `matrix.nondegenerate A`: the proposition that when interpreted as a bilinear form, the matrix `A`
diff --git a/src/linear_algebra/matrix/nonsingular_inverse.lean b/src/linear_algebra/matrix/nonsingular_inverse.lean
index c84571d57cdd1..8a13e1a7fa31a 100644
--- a/src/linear_algebra/matrix/nonsingular_inverse.lean
+++ b/src/linear_algebra/matrix/nonsingular_inverse.lean
@@ -3,13 +3,15 @@ Copyright (c) 2019 Tim Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Tim Baanen, Lu-Ming Zhang
 -/
-import algebra.regular.smul
+import data.matrix.invertible
 import linear_algebra.matrix.adjugate
-import linear_algebra.matrix.polynomial
 
 /-!
 # Nonsingular inverses
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define an inverse for square matrices of invertible determinant.
 
 For matrices that are not square or not of full rank, there is a more general notion of
@@ -50,7 +52,7 @@ matrix inverse, cramer, cramer's rule, adjugate
 
 namespace matrix
 universes u u' v
-variables {m : Type u} {n : Type u'} {α : Type v}
+variables {l : Type*} {m : Type u} {n : Type u'} {α : Type v}
 open_locale matrix big_operators
 open equiv equiv.perm finset
 
@@ -59,31 +61,6 @@ open equiv equiv.perm finset
 section invertible
 variables [fintype n] [decidable_eq n] [comm_ring α]
 
-/-- A copy of `inv_of_mul_self` using `⬝` not `*`. -/
-protected lemma inv_of_mul_self (A : matrix n n α) [invertible A] : ⅟A ⬝ A = 1 := inv_of_mul_self A
-
-/-- A copy of `mul_inv_of_self` using `⬝` not `*`. -/
-protected lemma mul_inv_of_self (A : matrix n n α) [invertible A] : A ⬝ ⅟A = 1 := mul_inv_of_self A
-
-/-- A copy of `inv_of_mul_self_assoc` using `⬝` not `*`. -/
-protected lemma inv_of_mul_self_assoc (A : matrix n n α) (B : matrix n m α) [invertible A] :
-  ⅟A ⬝ (A ⬝ B) = B :=
-by rw [←matrix.mul_assoc, matrix.inv_of_mul_self, matrix.one_mul]
-
-/-- A copy of `mul_inv_of_self_assoc` using `⬝` not `*`. -/
-protected lemma mul_inv_of_self_assoc (A : matrix n n α) (B : matrix n m α) [invertible A] :
-  A ⬝ (⅟A ⬝ B) = B :=
-by rw [←matrix.mul_assoc, matrix.mul_inv_of_self, matrix.one_mul]
-
-/-- A copy of `mul_inv_of_mul_self_cancel` using `⬝` not `*`. -/
-protected lemma mul_inv_of_mul_self_cancel (A : matrix m n α) (B : matrix n n α)
-  [invertible B] : A ⬝ ⅟B ⬝ B = A :=
-by rw [matrix.mul_assoc, matrix.inv_of_mul_self, matrix.mul_one]
-
-/-- A copy of `mul_mul_inv_of_self_cancel` using `⬝` not `*`. -/
-protected lemma mul_mul_inv_of_self_cancel (A : matrix m n α) (B : matrix n n α)
-  [invertible B] : A ⬝ B ⬝ ⅟B = A :=
-by rw [matrix.mul_assoc, matrix.mul_inv_of_self, matrix.mul_one]
 
 variables (A : matrix n n α) (B : matrix n n α)
 
@@ -149,6 +126,29 @@ def invertible_of_left_inverse (h : B ⬝ A = 1) : invertible A :=
 def invertible_of_right_inverse (h : A ⬝ B = 1) : invertible A :=
 ⟨B, mul_eq_one_comm.mp h, h⟩
 
+/-- The transpose of an invertible matrix is invertible. -/
+instance invertible_transpose [invertible A] : invertible Aᵀ :=
+begin
+  haveI : invertible Aᵀ.det,
+    by simpa using det_invertible_of_invertible A,
+  exact invertible_of_det_invertible Aᵀ
+end
+
+/-- A matrix is invertible if the transpose is invertible. -/
+def invertible__of_invertible_transpose [invertible Aᵀ] : invertible A :=
+begin
+  rw ←transpose_transpose A,
+  apply_instance
+end
+
+/-- A matrix is invertible if the conjugate transpose is invertible. -/
+def invertible_of_invertible_conj_transpose [star_ring α] [invertible Aᴴ] :
+  invertible A :=
+begin
+  rw ←conj_transpose_conj_transpose A,
+  apply_instance
+end
+
 /-- Given a proof that `A.det` has a constructive inverse, lift `A` to `(matrix n n α)ˣ`-/
 def unit_of_det_invertible [invertible A.det] : (matrix n n α)ˣ :=
 @unit_of_invertible _ _ A (invertible_of_det_invertible A)
@@ -164,6 +164,12 @@ lemma is_unit_det_of_invertible [invertible A] : is_unit A.det :=
 
 variables {A B}
 
+lemma is_unit_of_left_inverse (h : B ⬝ A = 1) : is_unit A :=
+⟨⟨A, B, mul_eq_one_comm.mp h, h⟩, rfl⟩
+
+lemma is_unit_of_right_inverse (h : A ⬝ B = 1) : is_unit A :=
+⟨⟨A, B, h, mul_eq_one_comm.mp h⟩, rfl⟩
+
 lemma is_unit_det_of_left_inverse (h : B ⬝ A = 1) : is_unit A.det :=
 @is_unit_of_invertible _ _ _ (det_invertible_of_left_inverse _ _ h)
 
@@ -178,7 +184,7 @@ lemma det_ne_zero_of_right_inverse [nontrivial α] (h : A ⬝ B = 1) : A.det ≠
 
 end invertible
 
-variables [fintype m] [fintype n] [decidable_eq m] [decidable_eq n] [comm_ring α]
+variables [fintype n] [decidable_eq n] [comm_ring α]
 variables (A : matrix n n α) (B : matrix n n α)
 
 lemma is_unit_det_transpose (h : is_unit A.det) : is_unit Aᵀ.det :=
@@ -246,12 +252,60 @@ begin
   rw [←inv_of_eq_nonsing_inv, matrix.inv_of_mul_self],
 end
 
+instance [invertible A] : invertible A⁻¹ :=
+by { rw ← inv_of_eq_nonsing_inv, apply_instance }
+
+@[simp] lemma inv_inv_of_invertible [invertible A] : A⁻¹⁻¹ = A :=
+by simp only [← inv_of_eq_nonsing_inv, inv_of_inv_of]
+
+@[simp] lemma mul_nonsing_inv_cancel_right (B : matrix m n α) (h : is_unit A.det) :
+  B ⬝ A ⬝ A⁻¹ = B :=
+by simp [matrix.mul_assoc, mul_nonsing_inv A h]
+
+@[simp] lemma mul_nonsing_inv_cancel_left (B : matrix n m α) (h : is_unit A.det) :
+  A ⬝ (A⁻¹ ⬝ B) = B :=
+by simp [←matrix.mul_assoc, mul_nonsing_inv A h]
+
+@[simp] lemma nonsing_inv_mul_cancel_right (B : matrix m n α) (h : is_unit A.det) :
+  B ⬝ A⁻¹ ⬝ A = B :=
+by simp [matrix.mul_assoc, nonsing_inv_mul A h]
+
+@[simp] lemma nonsing_inv_mul_cancel_left (B : matrix n m α) (h : is_unit A.det) :
+  A⁻¹ ⬝ (A ⬝ B) = B :=
+by simp [←matrix.mul_assoc, nonsing_inv_mul A h]
+
 @[simp] lemma mul_inv_of_invertible [invertible A] : A ⬝ A⁻¹ = 1 :=
 mul_nonsing_inv A (is_unit_det_of_invertible A)
 
 @[simp] lemma inv_mul_of_invertible [invertible A] : A⁻¹ ⬝ A = 1 :=
 nonsing_inv_mul A (is_unit_det_of_invertible A)
 
+@[simp] lemma mul_inv_cancel_right_of_invertible (B : matrix m n α) [invertible A] :
+  B ⬝ A ⬝ A⁻¹ = B :=
+mul_nonsing_inv_cancel_right A B (is_unit_det_of_invertible A)
+
+@[simp] lemma mul_inv_cancel_left_of_invertible (B : matrix n m α) [invertible A] :
+  A ⬝ (A⁻¹ ⬝ B) = B :=
+mul_nonsing_inv_cancel_left A B (is_unit_det_of_invertible A)
+
+@[simp] lemma inv_mul_cancel_right_of_invertible (B : matrix m n α) [invertible A] :
+  B ⬝ A⁻¹ ⬝ A = B :=
+nonsing_inv_mul_cancel_right A B (is_unit_det_of_invertible A)
+
+@[simp] lemma inv_mul_cancel_left_of_invertible (B : matrix n m α) [invertible A] :
+  A⁻¹ ⬝ (A ⬝ B) = B :=
+nonsing_inv_mul_cancel_left A B (is_unit_det_of_invertible A)
+
+lemma inv_mul_eq_iff_eq_mul_of_invertible (A B C : matrix n n α) [invertible A] :
+  A⁻¹ ⬝ B = C ↔ B = A ⬝ C :=
+⟨λ h, by rw [←h, mul_inv_cancel_left_of_invertible],
+ λ h, by rw [h, inv_mul_cancel_left_of_invertible]⟩
+
+lemma mul_inv_eq_iff_eq_mul_of_invertible (A B C : matrix n n α) [invertible A] :
+  B ⬝ A⁻¹ = C ↔ B = C ⬝ A :=
+⟨λ h, by rw [←h, inv_mul_cancel_right_of_invertible],
+ λ h, by rw [h, mul_inv_cancel_right_of_invertible]⟩
+
 lemma nonsing_inv_cancel_or_zero :
   (A⁻¹ ⬝ A = 1 ∧ A ⬝ A⁻¹ = 1) ∨ A⁻¹ = 0 :=
 begin
@@ -358,8 +412,10 @@ begin
     simp [hn] },
 end
 
-@[simp] lemma inv_one : (1 : matrix n n α)⁻¹ = 1 :=
-inv_eq_left_inv (by simp)
+noncomputable instance : inv_one_class (matrix n n α) :=
+{ inv_one := inv_eq_left_inv (by simp),
+  ..matrix.has_one,
+  ..matrix.has_inv }
 
 lemma inv_smul (k : α) [invertible k] (h : is_unit A.det) : (k • A)⁻¹ = ⅟k • A⁻¹ :=
 inv_eq_left_inv (by simp [h, smul_smul])
@@ -374,6 +430,8 @@ begin
   rw [smul_mul, mul_adjugate, units.smul_def, smul_smul, h.coe_inv_mul, one_smul]
 end
 
+section diagonal
+
 /-- `diagonal v` is invertible if `v` is -/
 def diagonal_invertible {α} [non_assoc_semiring α] (v : n → α) [invertible v] :
   invertible (diagonal v) :=
@@ -381,7 +439,11 @@ invertible.map (diagonal_ring_hom n α) v
 
 lemma inv_of_diagonal_eq {α} [semiring α] (v : n → α) [invertible v] [invertible (diagonal v)] :
   ⅟(diagonal v) = diagonal (⅟v) :=
-by { letI := diagonal_invertible v, convert (rfl : ⅟(diagonal v) = _) }
+begin
+  letI := diagonal_invertible v,
+  haveI := invertible.subsingleton (diagonal v),
+  convert (rfl : ⅟(diagonal v) = _),
+end
 
 /-- `v` is invertible if `diagonal v` is -/
 def invertible_of_diagonal_invertible (v : n → α) [invertible (diagonal v)] : invertible v :=
@@ -427,6 +489,8 @@ begin
     rw [ring.inverse_non_unit _ h, pi.zero_def, diagonal_zero, ring.inverse_non_unit _ this] }
 end
 
+end diagonal
+
 @[simp] lemma inv_inv_inv (A : matrix n n α) : A⁻¹⁻¹⁻¹ = A⁻¹ :=
 begin
   by_cases h : is_unit A.det,
@@ -462,8 +526,79 @@ end
 by rw [← (A⁻¹).transpose_transpose, vec_mul_transpose, transpose_nonsing_inv, ← det_transpose,
     Aᵀ.det_smul_inv_mul_vec_eq_cramer _ (is_unit_det_transpose A h)]
 
+/-! ### Inverses of permutated matrices
+
+Note that the simp-normal form of `matrix.reindex` is `matrix.submatrix`, so we prove most of these
+results about only the latter.
+-/
+
+section submatrix
+variables [fintype m]
+variables [decidable_eq m]
+
+/-- `A.submatrix e₁ e₂` is invertible if `A` is -/
+def submatrix_equiv_invertible (A : matrix m m α) (e₁ e₂ : n ≃ m) [invertible A] :
+  invertible (A.submatrix e₁ e₂) :=
+invertible_of_right_inverse _ ((⅟A).submatrix e₂ e₁) $
+  by rw [matrix.submatrix_mul_equiv, matrix.mul_inv_of_self, submatrix_one_equiv]
+
+/-- `A` is invertible if `A.submatrix e₁ e₂` is -/
+def invertible_of_submatrix_equiv_invertible (A : matrix m m α) (e₁ e₂ : n ≃ m)
+  [invertible (A.submatrix e₁ e₂)] : invertible A :=
+invertible_of_right_inverse _ ((⅟(A.submatrix e₁ e₂)).submatrix e₂.symm e₁.symm) $ begin
+  have : A = (A.submatrix e₁ e₂).submatrix e₁.symm e₂.symm := by simp,
+  conv in (_ ⬝ _) { congr, rw this },
+  rw [matrix.submatrix_mul_equiv, matrix.mul_inv_of_self, submatrix_one_equiv]
+end
+
+lemma inv_of_submatrix_equiv_eq (A : matrix m m α) (e₁ e₂ : n ≃ m)
+  [invertible A] [invertible (A.submatrix e₁ e₂)] :
+  ⅟(A.submatrix e₁ e₂) = (⅟A).submatrix e₂ e₁ :=
+begin
+  letI := submatrix_equiv_invertible A e₁ e₂,
+  haveI := invertible.subsingleton (A.submatrix e₁ e₂),
+  convert (rfl : ⅟(A.submatrix e₁ e₂) = _),
+end
+
+/-- Together `matrix.submatrix_equiv_invertible` and
+`matrix.invertible_of_submatrix_equiv_invertible` form an equivalence, although both sides of the
+equiv are subsingleton anyway. -/
+@[simps]
+def submatrix_equiv_invertible_equiv_invertible (A : matrix m m α) (e₁ e₂ : n ≃ m) :
+  invertible (A.submatrix e₁ e₂) ≃ invertible A :=
+{ to_fun := λ _, by exactI invertible_of_submatrix_equiv_invertible A e₁ e₂,
+  inv_fun := λ _, by exactI submatrix_equiv_invertible A e₁ e₂,
+  left_inv := λ _, subsingleton.elim _ _,
+  right_inv := λ _, subsingleton.elim _ _ }
+
+/-- When lowered to a prop, `matrix.invertible_of_submatrix_equiv_invertible` forms an `iff`. -/
+@[simp] lemma is_unit_submatrix_equiv {A : matrix m m α} (e₁ e₂ : n ≃ m) :
+  is_unit (A.submatrix e₁ e₂) ↔ is_unit A :=
+by simp only [← nonempty_invertible_iff_is_unit,
+  (submatrix_equiv_invertible_equiv_invertible A _ _).nonempty_congr]
+
+@[simp] lemma inv_submatrix_equiv (A : matrix m m α) (e₁ e₂ : n ≃ m) :
+  (A.submatrix e₁ e₂)⁻¹ = (A⁻¹).submatrix e₂ e₁ :=
+begin
+  by_cases h : is_unit A,
+  { casesI h.nonempty_invertible,
+    letI := submatrix_equiv_invertible A e₁ e₂,
+    rw [←inv_of_eq_nonsing_inv, ←inv_of_eq_nonsing_inv, inv_of_submatrix_equiv_eq] },
+  { have := (is_unit_submatrix_equiv e₁ e₂).not.mpr h,
+    simp_rw [nonsing_inv_eq_ring_inverse, ring.inverse_non_unit _ h, ring.inverse_non_unit _ this,
+      submatrix_zero, pi.zero_apply] }
+end
+
+lemma inv_reindex (e₁ e₂ : n ≃ m) (A : matrix n n α) : (reindex e₁ e₂ A)⁻¹ = reindex e₂ e₁ (A⁻¹) :=
+inv_submatrix_equiv A e₁.symm e₂.symm
+
+end submatrix
+
 /-! ### More results about determinants -/
 
+section det
+variables [fintype m] [decidable_eq m]
+
 /-- A variant of `matrix.det_units_conj`. -/
 lemma det_conj {M : matrix m m α} (h : is_unit M) (N : matrix m m α) :
   det (M ⬝ N ⬝ M⁻¹) = det N :=
@@ -474,67 +609,6 @@ lemma det_conj' {M : matrix m m α} (h : is_unit M) (N : matrix m m α) :
   det (M⁻¹ ⬝ N ⬝ M) = det N :=
 by rw [←h.unit_spec, ←coe_units_inv, det_units_conj']
 
-/-- Determinant of a 2×2 block matrix, expanded around an invertible top left element in terms of
-the Schur complement. -/
-lemma det_from_blocks₁₁ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
-  [invertible A] : (matrix.from_blocks A B C D).det = det A * det (D - C ⬝ (⅟A) ⬝ B) :=
-begin
-  have : from_blocks A B C D =
-    from_blocks 1 0 (C ⬝ ⅟A) 1 ⬝ from_blocks A 0 0 (D - C ⬝ (⅟A) ⬝ B) ⬝ from_blocks 1 (⅟A ⬝ B) 0 1,
-  { simp only [from_blocks_multiply, matrix.mul_zero, matrix.zero_mul, add_zero, zero_add,
-      matrix.one_mul, matrix.mul_one, matrix.inv_of_mul_self, matrix.mul_inv_of_self_assoc,
-        matrix.mul_inv_of_mul_self_cancel, matrix.mul_assoc, add_sub_cancel'_right] },
-  rw [this, det_mul, det_mul, det_from_blocks_zero₂₁, det_from_blocks_zero₂₁,
-    det_from_blocks_zero₁₂, det_one, det_one, one_mul, one_mul, mul_one],
-end
-
-@[simp] lemma det_from_blocks_one₁₁ (B : matrix m n α) (C : matrix n m α) (D : matrix n n α) :
-  (matrix.from_blocks 1 B C D).det = det (D - C ⬝ B) :=
-begin
-  haveI : invertible (1 : matrix m m α) := invertible_one,
-  rw [det_from_blocks₁₁, inv_of_one, matrix.mul_one, det_one, one_mul],
-end
-
-/-- Determinant of a 2×2 block matrix, expanded around an invertible bottom right element in terms
-of the Schur complement. -/
-lemma det_from_blocks₂₂ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
-  [invertible D] : (matrix.from_blocks A B C D).det = det D * det (A - B ⬝ (⅟D) ⬝ C) :=
-begin
-  have : from_blocks A B C D = (from_blocks D C B A).minor (sum_comm _ _) (sum_comm _ _),
-  { ext i j,
-    cases i; cases j; refl },
-  rw [this, det_minor_equiv_self, det_from_blocks₁₁],
-end
-
-@[simp] lemma det_from_blocks_one₂₂ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) :
-  (matrix.from_blocks A B C 1).det = det (A - B ⬝ C) :=
-begin
-  haveI : invertible (1 : matrix n n α) := invertible_one,
-  rw [det_from_blocks₂₂, inv_of_one, matrix.mul_one, det_one, one_mul],
-end
-
-/-- The **Weinstein–Aronszajn identity**. Note the `1` on the LHS is of shape m×m, while the `1` on
-the RHS is of shape n×n. -/
-lemma det_one_add_mul_comm (A : matrix m n α) (B : matrix n m α) :
-  det (1 + A ⬝ B) = det (1 + B ⬝ A) :=
-calc  det (1 + A ⬝ B)
-    = det (from_blocks 1 (-A) B 1) : by rw [det_from_blocks_one₂₂, matrix.neg_mul, sub_neg_eq_add]
-... = det (1 + B ⬝ A)              : by rw [det_from_blocks_one₁₁, matrix.mul_neg, sub_neg_eq_add]
-
-/-- Alternate statement of the **Weinstein–Aronszajn identity** -/
-lemma det_mul_add_one_comm (A : matrix m n α) (B : matrix n m α) :
-  det (A ⬝ B + 1) = det (B ⬝ A + 1) :=
-by rw [add_comm, det_one_add_mul_comm, add_comm]
-
-lemma det_one_sub_mul_comm (A : matrix m n α) (B : matrix n m α) :
-  det (1 - A ⬝ B) = det (1 - B ⬝ A) :=
-by rw [sub_eq_add_neg, ←matrix.neg_mul, det_one_add_mul_comm, matrix.mul_neg, ←sub_eq_add_neg]
-
-/-- A special case of the **Matrix determinant lemma** for when `A = I`.
-
-TODO: show this more generally. -/
-lemma det_one_add_col_mul_row (u v : m → α) : det (1 + col u ⬝ row v) = 1 + v ⬝ᵥ u :=
-by rw [det_one_add_mul_comm, det_unique, pi.add_apply, pi.add_apply, matrix.one_apply_eq,
-       matrix.row_mul_col_apply]
+end det
 
 end matrix
diff --git a/src/linear_algebra/matrix/orthogonal.lean b/src/linear_algebra/matrix/orthogonal.lean
index 8ac01b340accc..561aa1d1c46ae 100644
--- a/src/linear_algebra/matrix/orthogonal.lean
+++ b/src/linear_algebra/matrix/orthogonal.lean
@@ -8,6 +8,9 @@ import data.matrix.basic
 /-!
 # Orthogonal
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains definitions and properties concerning orthogonality of rows and columns.
 
 ## Main results
diff --git a/src/linear_algebra/matrix/polynomial.lean b/src/linear_algebra/matrix/polynomial.lean
index 008382638c9ea..4045bbe16a2cb 100644
--- a/src/linear_algebra/matrix/polynomial.lean
+++ b/src/linear_algebra/matrix/polynomial.lean
@@ -5,13 +5,14 @@ Authors: Yakov Pechersky
 -/
 import algebra.polynomial.big_operators
 import data.polynomial.degree.lemmas
-import data.polynomial.eval
-import data.polynomial.monic
 import linear_algebra.matrix.determinant
 
 /-!
 # Matrices of polynomials and polynomials of matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we prove results about matrices over a polynomial ring.
 In particular, we give results about the polynomial given by
 `det (t * I + A)`.
diff --git a/src/linear_algebra/matrix/pos_def.lean b/src/linear_algebra/matrix/pos_def.lean
new file mode 100644
index 0000000000000..8a06f1f566eb2
--- /dev/null
+++ b/src/linear_algebra/matrix/pos_def.lean
@@ -0,0 +1,173 @@
+/-
+Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+import linear_algebra.matrix.spectrum
+import linear_algebra.quadratic_form.basic
+
+/-! # Positive Definite Matrices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+This file defines positive (semi)definite matrices and connects the notion to positive definiteness
+of quadratic forms.
+## Main definition
+ * `matrix.pos_def` : a matrix `M : matrix n n 𝕜` is positive definite if it is hermitian and `xᴴMx`
+   is greater than zero for all nonzero `x`.
+ * `matrix.pos_semidef` : a matrix `M : matrix n n 𝕜` is positive semidefinite if it is hermitian
+   and `xᴴMx` is nonnegative for all `x`.
+-/
+
+namespace matrix
+
+variables {𝕜 : Type*} [is_R_or_C 𝕜] {m n : Type*} [fintype m] [fintype n]
+
+open_locale matrix
+
+/-- A matrix `M : matrix n n 𝕜` is positive definite if it is hermitian
+   and `xᴴMx` is greater than zero for all nonzero `x`. -/
+def pos_def (M : matrix n n 𝕜) :=
+M.is_hermitian ∧ ∀ x : n → 𝕜, x ≠ 0 → 0 < is_R_or_C.re (dot_product (star x) (M.mul_vec x))
+
+lemma pos_def.is_hermitian {M : matrix n n 𝕜} (hM : M.pos_def) : M.is_hermitian := hM.1
+
+/-- A matrix `M : matrix n n 𝕜` is positive semidefinite if it is hermitian
+   and `xᴴMx` is nonnegative for all `x`. -/
+def pos_semidef (M : matrix n n 𝕜) :=
+M.is_hermitian ∧ ∀ x : n → 𝕜, 0 ≤ is_R_or_C.re (dot_product (star x) (M.mul_vec x))
+
+lemma pos_def.pos_semidef {M : matrix n n 𝕜} (hM : M.pos_def) : M.pos_semidef :=
+begin
+  refine ⟨hM.1, _⟩,
+  intros x,
+  by_cases hx : x = 0,
+  { simp only [hx, zero_dot_product, star_zero, is_R_or_C.zero_re'] },
+  { exact le_of_lt (hM.2 x hx) }
+end
+
+lemma pos_semidef.submatrix {M : matrix n n 𝕜} (hM : M.pos_semidef) (e : m ≃ n):
+  (M.submatrix e e).pos_semidef :=
+begin
+  refine ⟨hM.1.submatrix e, λ x, _⟩,
+  have : (M.submatrix ⇑e ⇑e).mul_vec x = M.mul_vec (λ (i : n), x (e.symm i)) ∘ e,
+  { ext i,
+    dsimp only [(∘), mul_vec, dot_product],
+    rw finset.sum_bij' (λ i _, e i) _ _ (λ i _, e.symm i);
+    simp only [eq_self_iff_true, implies_true_iff, equiv.symm_apply_apply, finset.mem_univ,
+      submatrix_apply, equiv.apply_symm_apply] },
+  rw this,
+  convert hM.2 (λ i, x (e.symm i)) using 3,
+  unfold dot_product,
+  rw [finset.sum_bij' (λ i _, e i) _ _ (λ i _, e.symm i)];
+  simp only [eq_self_iff_true, implies_true_iff, equiv.symm_apply_apply, finset.mem_univ,
+    submatrix_apply, equiv.apply_symm_apply, pi.star_apply],
+end
+
+@[simp] lemma pos_semidef_submatrix_equiv {M : matrix n n 𝕜} (e : m ≃ n) :
+  (M.submatrix e e).pos_semidef ↔ M.pos_semidef :=
+⟨λ h, by simpa using h.submatrix e.symm, λ h, h.submatrix _⟩
+
+lemma pos_def.transpose {M : matrix n n 𝕜} (hM : M.pos_def) : Mᵀ.pos_def :=
+begin
+  refine ⟨is_hermitian.transpose hM.1, λ x hx, _⟩,
+  convert hM.2 (star x) (star_ne_zero.2 hx) using 2,
+  rw [mul_vec_transpose, matrix.dot_product_mul_vec, star_star, dot_product_comm]
+end
+
+lemma pos_def_of_to_quadratic_form' [decidable_eq n] {M : matrix n n ℝ}
+  (hM : M.is_symm) (hMq : M.to_quadratic_form'.pos_def) :
+  M.pos_def :=
+begin
+  refine ⟨hM, λ x hx, _⟩,
+  simp only [to_quadratic_form', quadratic_form.pos_def, bilin_form.to_quadratic_form_apply,
+    matrix.to_bilin'_apply'] at hMq,
+  apply hMq x hx,
+end
+
+lemma pos_def_to_quadratic_form' [decidable_eq n] {M : matrix n n ℝ} (hM : M.pos_def) :
+  M.to_quadratic_form'.pos_def :=
+begin
+  intros x hx,
+  simp only [to_quadratic_form', bilin_form.to_quadratic_form_apply, matrix.to_bilin'_apply'],
+  apply hM.2 x hx,
+end
+
+namespace pos_def
+
+variables {M : matrix n n ℝ} (hM : M.pos_def)
+include hM
+
+lemma det_pos [decidable_eq n] : 0 < det M :=
+begin
+  rw hM.is_hermitian.det_eq_prod_eigenvalues,
+  apply finset.prod_pos,
+  intros i _,
+  rw hM.is_hermitian.eigenvalues_eq,
+  apply hM.2 _ (λ h, _),
+  have h_det : (hM.is_hermitian.eigenvector_matrix)ᵀ.det = 0,
+    from matrix.det_eq_zero_of_row_eq_zero i (λ j, congr_fun h j),
+  simpa only [h_det, not_is_unit_zero] using
+    is_unit_det_of_invertible hM.is_hermitian.eigenvector_matrixᵀ,
+end
+
+end pos_def
+
+end matrix
+
+namespace quadratic_form
+
+variables {n : Type*} [fintype n]
+
+lemma pos_def_of_to_matrix'
+  [decidable_eq n] {Q : quadratic_form ℝ (n → ℝ)} (hQ : Q.to_matrix'.pos_def) :
+  Q.pos_def :=
+begin
+  rw [←to_quadratic_form_associated ℝ Q,
+      ←bilin_form.to_matrix'.left_inv ((associated_hom _) Q)],
+  apply matrix.pos_def_to_quadratic_form' hQ
+end
+
+lemma pos_def_to_matrix' [decidable_eq n] {Q : quadratic_form ℝ (n → ℝ)} (hQ : Q.pos_def) :
+  Q.to_matrix'.pos_def :=
+begin
+  rw [←to_quadratic_form_associated ℝ Q,
+    ←bilin_form.to_matrix'.left_inv ((associated_hom _) Q)] at hQ,
+  apply matrix.pos_def_of_to_quadratic_form' (is_symm_to_matrix' Q) hQ,
+end
+
+end quadratic_form
+
+namespace matrix
+
+variables {𝕜 : Type*} [is_R_or_C 𝕜] {n : Type*} [fintype n]
+
+/-- A positive definite matrix `M` induces a norm `‖x‖ = sqrt (re xᴴMx)`. -/
+@[reducible]
+noncomputable def normed_add_comm_group.of_matrix {M : matrix n n 𝕜} (hM : M.pos_def) :
+  normed_add_comm_group (n → 𝕜) :=
+@inner_product_space.core.to_normed_add_comm_group _ _ _ _ _
+{ inner := λ x y, dot_product (star x) (M.mul_vec y),
+  conj_symm := λ x y, by dsimp only [has_inner.inner];
+    rw [star_dot_product, star_ring_end_apply, star_star, star_mul_vec,
+      dot_product_mul_vec, hM.is_hermitian.eq],
+  nonneg_re := λ x,
+    begin
+      by_cases h : x = 0,
+      { simp [h] },
+      { exact le_of_lt (hM.2 x h) }
+    end,
+  definite := λ x (hx : dot_product _ _ = 0),
+    begin
+      by_contra' h,
+      simpa [hx, lt_irrefl] using hM.2 x h,
+    end,
+  add_left := by simp only [star_add, add_dot_product, eq_self_iff_true, forall_const],
+  smul_left := λ x y r, by rw [← smul_eq_mul, ←smul_dot_product, star_ring_end_apply, ← star_smul] }
+
+/-- A positive definite matrix `M` induces an inner product `⟪x, y⟫ = xᴴMy`. -/
+def inner_product_space.of_matrix {M : matrix n n 𝕜} (hM : M.pos_def) :
+  @inner_product_space 𝕜 (n → 𝕜) _ (normed_add_comm_group.of_matrix hM) :=
+inner_product_space.of_core _
+
+end matrix
diff --git a/src/linear_algebra/matrix/reindex.lean b/src/linear_algebra/matrix/reindex.lean
index cb94fdbc88ff3..10513e866f552 100644
--- a/src/linear_algebra/matrix/reindex.lean
+++ b/src/linear_algebra/matrix/reindex.lean
@@ -9,6 +9,9 @@ import linear_algebra.matrix.determinant
 /-!
 # Changing the index type of a matrix
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file concerns the map `matrix.reindex`, mapping a `m` by `n` matrix
 to an `m'` by `n'` matrix, as long as `m ≃ m'` and `n ≃ n'`.
 
@@ -73,11 +76,11 @@ lemma reindex_linear_equiv_comp_apply (e₁ : m ≃ m') (e₂ : n ≃ n') (e₁'
   (e₂' : n' ≃ n'') (M : matrix m n A) :
   (reindex_linear_equiv R A e₁' e₂') (reindex_linear_equiv R A e₁ e₂ M) =
     reindex_linear_equiv R A (e₁.trans e₁') (e₂.trans e₂') M :=
-minor_minor _ _ _ _ _
+submatrix_submatrix _ _ _ _ _
 
 lemma reindex_linear_equiv_one [decidable_eq m] [decidable_eq m'] [has_one A]
   (e : m ≃ m') : (reindex_linear_equiv R A e e (1 : matrix m m A)) = 1 :=
-minor_one_equiv e.symm
+submatrix_one_equiv e.symm
 
 end add_comm_monoid
 
@@ -88,12 +91,12 @@ lemma reindex_linear_equiv_mul [fintype n] [fintype n']
   (eₘ : m ≃ m') (eₙ : n ≃ n') (eₒ : o ≃ o') (M : matrix m n A) (N : matrix n o A) :
   reindex_linear_equiv R A eₘ eₙ M ⬝ reindex_linear_equiv R A eₙ eₒ N =
     reindex_linear_equiv R A eₘ eₒ (M ⬝ N) :=
-minor_mul_equiv M N _ _ _
+submatrix_mul_equiv M N _ _ _
 
-lemma mul_reindex_linear_equiv_one [fintype n] [fintype o] [decidable_eq o] (e₁ : o ≃ n)
+lemma mul_reindex_linear_equiv_one [fintype n] [decidable_eq o] (e₁ : o ≃ n)
   (e₂ : o ≃ n') (M : matrix m n A) : M.mul (reindex_linear_equiv R A e₁ e₂ 1) =
     reindex_linear_equiv R A (equiv.refl m) (e₁.symm.trans e₂) M :=
-mul_minor_one _ _ _
+by { haveI := fintype.of_equiv _ e₁.symm, exact mul_submatrix_one _ _ _ }
 
 end semiring
 
@@ -108,7 +111,7 @@ a matrix's rows and columns with equivalent types, `matrix.reindex`, is an equiv
 def reindex_alg_equiv (e : m ≃ n) : matrix m m R ≃ₐ[R] matrix n n R :=
 { to_fun    := reindex e e,
   map_mul'  := λ a b, (reindex_linear_equiv_mul R R e e e a b).symm,
-  commutes' := λ r, by simp [algebra_map, algebra.to_ring_hom, minor_smul],
+  commutes' := λ r, by simp [algebra_map, algebra.to_ring_hom, submatrix_smul],
   ..(reindex_linear_equiv R R e e) }
 
 @[simp] lemma reindex_alg_equiv_apply (e : m ≃ n) (M : matrix m m R) :
@@ -130,7 +133,7 @@ end algebra
 
 /-- Reindexing both indices along the same equivalence preserves the determinant.
 
-For the `simp` version of this lemma, see `det_minor_equiv_self`.
+For the `simp` version of this lemma, see `det_submatrix_equiv_self`.
 -/
 lemma det_reindex_linear_equiv_self [comm_ring R] [fintype m] [decidable_eq m]
   [fintype n] [decidable_eq n] (e : m ≃ n) (M : matrix m m R) :
@@ -139,7 +142,7 @@ det_reindex_self e M
 
 /-- Reindexing both indices along the same equivalence preserves the determinant.
 
-For the `simp` version of this lemma, see `det_minor_equiv_self`.
+For the `simp` version of this lemma, see `det_submatrix_equiv_self`.
 -/
 lemma det_reindex_alg_equiv [comm_ring R] [fintype m] [decidable_eq m] [fintype n] [decidable_eq n]
   (e : m ≃ n) (A : matrix m m R) :
diff --git a/src/linear_algebra/matrix/schur_complement.lean b/src/linear_algebra/matrix/schur_complement.lean
new file mode 100644
index 0000000000000..4e3cc43ea1180
--- /dev/null
+++ b/src/linear_algebra/matrix/schur_complement.lean
@@ -0,0 +1,535 @@
+/-
+Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp, Eric Wieser, Jeremy Avigad, Johan Commelin
+-/
+import data.matrix.invertible
+import linear_algebra.matrix.nonsingular_inverse
+import linear_algebra.matrix.pos_def
+
+/-! # 2×2 block matrices and the Schur complement
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves properties of 2×2 block matrices `[A B; C D]` that relate to the Schur complement
+`D - C⬝A⁻¹⬝B`.
+
+Some of the results here generalize to 2×2 matrices in a category, rather than just a ring. A few
+results in this direction can be found in the the file `cateogry_theory.preadditive.biproducts`,
+especially the declarations `category_theory.biprod.gaussian` and `category_theory.biprod.iso_elim`.
+Compare with `matrix.invertible_of_from_blocks₁₁_invertible`.
+
+## Main results
+
+ * `matrix.det_from_blocks₁₁`, `matrix.det_from_blocks₂₂`: determinant of a block matrix in terms of
+   the Schur complement.
+ * `matrix.inv_of_from_blocks_zero₂₁_eq`, `matrix.inv_of_from_blocks_zero₁₂_eq`: the inverse of a
+   block triangular matrix.
+ * `matrix.is_unit_from_blocks_zero₂₁`, `matrix.is_unit_from_blocks_zero₁₂`: invertibility of a
+   block triangular matrix.
+ * `matrix.det_one_add_mul_comm`: the **Weinstein–Aronszajn identity**.
+ * `matrix.schur_complement_pos_semidef_iff` : If a matrix `A` is positive definite, then
+  `[A B; Bᴴ D]` is postive semidefinite if and only if `D - Bᴴ A⁻¹ B` is postive semidefinite.
+
+-/
+
+variables {l m n α : Type*}
+
+namespace matrix
+open_locale matrix
+
+section comm_ring
+variables [fintype l] [fintype m] [fintype n]
+variables [decidable_eq l] [decidable_eq m] [decidable_eq n]
+variables [comm_ring α]
+
+/-- LDU decomposition of a block matrix with an invertible top-left corner, using the
+Schur complement. -/
+lemma from_blocks_eq_of_invertible₁₁
+  (A : matrix m m α) (B : matrix m n α) (C : matrix l m α) (D : matrix l n α) [invertible A] :
+  from_blocks A B C D =
+    from_blocks 1 0 (C⬝⅟A) 1 ⬝ from_blocks A 0 0 (D - C⬝(⅟A)⬝B) ⬝ from_blocks 1 (⅟A⬝B) 0 1 :=
+by simp only [from_blocks_multiply, matrix.mul_zero, matrix.zero_mul, add_zero, zero_add,
+      matrix.one_mul, matrix.mul_one, matrix.inv_of_mul_self, matrix.mul_inv_of_self_assoc,
+        matrix.mul_inv_of_mul_self_cancel, matrix.mul_assoc, add_sub_cancel'_right]
+
+/-- LDU decomposition of a block matrix with an invertible bottom-right corner, using the
+Schur complement. -/
+lemma from_blocks_eq_of_invertible₂₂
+  (A : matrix l m α) (B : matrix l n α) (C : matrix n m α) (D : matrix n n α) [invertible D] :
+  from_blocks A B C D =
+    from_blocks 1 (B⬝⅟D) 0 1 ⬝ from_blocks (A - B⬝⅟D⬝C) 0 0 D ⬝ from_blocks 1 0 (⅟D ⬝ C) 1 :=
+(matrix.reindex (equiv.sum_comm _ _) (equiv.sum_comm _ _)).injective $ by
+  simpa [reindex_apply, equiv.sum_comm_symm,
+    ←submatrix_mul_equiv _ _ _ (equiv.sum_comm n m),
+    ←submatrix_mul_equiv _ _ _ (equiv.sum_comm n l),
+    equiv.sum_comm_apply, from_blocks_submatrix_sum_swap_sum_swap]
+    using from_blocks_eq_of_invertible₁₁ D C B A
+
+section triangular
+
+/-! #### Block triangular matrices -/
+
+/-- An upper-block-triangular matrix is invertible if its diagonal is. -/
+def from_blocks_zero₂₁_invertible (A : matrix m m α) (B : matrix m n α) (D : matrix n n α)
+  [invertible A] [invertible D] : invertible (from_blocks A B 0 D) :=
+invertible_of_left_inverse _ (from_blocks (⅟A) (-(⅟A⬝B⬝⅟D)) 0 (⅟D)) $
+  by simp_rw [from_blocks_multiply, matrix.mul_zero, matrix.zero_mul, zero_add, add_zero,
+    matrix.neg_mul, matrix.inv_of_mul_self, matrix.mul_inv_of_mul_self_cancel, add_right_neg,
+    from_blocks_one]
+
+/-- A lower-block-triangular matrix is invertible if its diagonal is. -/
+def from_blocks_zero₁₂_invertible (A : matrix m m α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] [invertible D] : invertible (from_blocks A 0 C D) :=
+invertible_of_left_inverse _ (from_blocks (⅟A) 0 (-(⅟D⬝C⬝⅟A)) (⅟D)) $
+  -- a symmetry argument is more work than just copying the proof
+  by simp_rw [from_blocks_multiply, matrix.mul_zero, matrix.zero_mul, zero_add, add_zero,
+    matrix.neg_mul, matrix.inv_of_mul_self, matrix.mul_inv_of_mul_self_cancel, add_left_neg,
+    from_blocks_one]
+
+lemma inv_of_from_blocks_zero₂₁_eq
+  (A : matrix m m α) (B : matrix m n α) (D : matrix n n α)
+  [invertible A] [invertible D] [invertible (from_blocks A B 0 D)] :
+  ⅟(from_blocks A B 0 D) = from_blocks (⅟A) (-(⅟A⬝B⬝⅟D)) 0 (⅟D) :=
+begin
+  letI := from_blocks_zero₂₁_invertible A B D,
+  convert (rfl : ⅟(from_blocks A B 0 D) = _),
+end
+
+lemma inv_of_from_blocks_zero₁₂_eq
+  (A : matrix m m α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] [invertible D] [invertible (from_blocks A 0 C D)] :
+  ⅟(from_blocks A 0 C D) = from_blocks (⅟A) 0 (-(⅟D⬝C⬝⅟A)) (⅟D) :=
+begin
+  letI := from_blocks_zero₁₂_invertible A C D,
+  convert (rfl : ⅟(from_blocks A 0 C D) = _),
+end
+
+/-- Both diagonal entries of an invertible upper-block-triangular matrix are invertible (by reading
+off the diagonal entries of the inverse). -/
+def invertible_of_from_blocks_zero₂₁_invertible
+  (A : matrix m m α) (B : matrix m n α) (D : matrix n n α)
+  [invertible (from_blocks A B 0 D)] : invertible A × invertible D :=
+{ fst := invertible_of_left_inverse _ (⅟(from_blocks A B 0 D)).to_blocks₁₁ $ begin
+    have := matrix.inv_of_mul_self (from_blocks A B 0 D),
+    rw [←from_blocks_to_blocks (⅟(from_blocks A B 0 D)), from_blocks_multiply] at this,
+    replace := congr_arg matrix.to_blocks₁₁ this,
+    simpa only [matrix.to_blocks_from_blocks₁₁, matrix.mul_zero, add_zero, ←from_blocks_one]
+      using this,
+  end,
+  snd := invertible_of_right_inverse _ (⅟(from_blocks A B 0 D)).to_blocks₂₂ $ begin
+    have := matrix.mul_inv_of_self (from_blocks A B 0 D),
+    rw [←from_blocks_to_blocks (⅟(from_blocks A B 0 D)), from_blocks_multiply] at this,
+    replace := congr_arg matrix.to_blocks₂₂ this,
+    simpa only [matrix.to_blocks_from_blocks₂₂, matrix.zero_mul, zero_add, ←from_blocks_one]
+      using this,
+  end }
+
+/-- Both diagonal entries of an invertible lower-block-triangular matrix are invertible (by reading
+off the diagonal entries of the inverse). -/
+def invertible_of_from_blocks_zero₁₂_invertible
+  (A : matrix m m α) (C : matrix n m α) (D : matrix n n α)
+  [invertible (from_blocks A 0 C D)] : invertible A × invertible D :=
+{ fst := invertible_of_right_inverse _ (⅟(from_blocks A 0 C D)).to_blocks₁₁ $ begin
+    have := matrix.mul_inv_of_self (from_blocks A 0 C D),
+    rw [←from_blocks_to_blocks (⅟(from_blocks A 0 C D)), from_blocks_multiply] at this,
+    replace := congr_arg matrix.to_blocks₁₁ this,
+    simpa only [matrix.to_blocks_from_blocks₁₁, matrix.zero_mul, add_zero, ←from_blocks_one]
+      using this,
+  end,
+  snd := invertible_of_left_inverse _ (⅟(from_blocks A 0 C D)).to_blocks₂₂ $ begin
+    have := matrix.inv_of_mul_self (from_blocks A 0 C D),
+    rw [←from_blocks_to_blocks (⅟(from_blocks A 0 C D)), from_blocks_multiply] at this,
+    replace := congr_arg matrix.to_blocks₂₂ this,
+    simpa only [matrix.to_blocks_from_blocks₂₂, matrix.mul_zero, zero_add, ←from_blocks_one]
+      using this,
+  end }
+
+/-- `invertible_of_from_blocks_zero₂₁_invertible` and `from_blocks_zero₂₁_invertible` form
+an equivalence. -/
+def from_blocks_zero₂₁_invertible_equiv (A : matrix m m α) (B : matrix m n α) (D : matrix n n α) :
+  invertible (from_blocks A B 0 D) ≃ invertible A × invertible D :=
+{ to_fun := λ _, by exactI invertible_of_from_blocks_zero₂₁_invertible A B D,
+  inv_fun := λ i, by letI := i.1; letI := i.2; exact from_blocks_zero₂₁_invertible A B D,
+  left_inv := λ _, subsingleton.elim _ _,
+  right_inv := λ _, subsingleton.elim _ _ }
+
+/-- `invertible_of_from_blocks_zero₁₂_invertible` and `from_blocks_zero₁₂_invertible` form
+an equivalence. -/
+def from_blocks_zero₁₂_invertible_equiv (A : matrix m m α) (C : matrix n m α) (D : matrix n n α) :
+  invertible (from_blocks A 0 C D) ≃ invertible A × invertible D :=
+{ to_fun := λ _, by exactI invertible_of_from_blocks_zero₁₂_invertible A C D,
+  inv_fun := λ i, by letI := i.1; letI := i.2; exact from_blocks_zero₁₂_invertible A C D,
+  left_inv := λ _, subsingleton.elim _ _,
+  right_inv := λ _, subsingleton.elim _ _ }
+
+/-- An upper block-triangular matrix is invertible iff both elements of its diagonal are.
+
+This is a propositional form of `matrix.from_blocks_zero₂₁_invertible_equiv`. -/
+@[simp] lemma is_unit_from_blocks_zero₂₁ {A : matrix m m α} {B : matrix m n α} {D : matrix n n α} :
+  is_unit (from_blocks A B 0 D) ↔ is_unit A ∧ is_unit D :=
+by simp only [← nonempty_invertible_iff_is_unit, ←nonempty_prod,
+  (from_blocks_zero₂₁_invertible_equiv _ _ _).nonempty_congr]
+
+/-- A lower block-triangular matrix is invertible iff both elements of its diagonal are.
+
+This is a propositional form of  `matrix.from_blocks_zero₁₂_invertible_equiv` forms an `iff`. -/
+@[simp] lemma is_unit_from_blocks_zero₁₂ {A : matrix m m α} {C : matrix n m α} {D : matrix n n α} :
+  is_unit (from_blocks A 0 C D) ↔ is_unit A ∧ is_unit D :=
+by simp only [← nonempty_invertible_iff_is_unit, ←nonempty_prod,
+  (from_blocks_zero₁₂_invertible_equiv _ _ _).nonempty_congr]
+
+/-- An expression for the inverse of an upper block-triangular matrix, when either both elements of
+diagonal are invertible, or both are not. -/
+lemma inv_from_blocks_zero₂₁_of_is_unit_iff
+  (A : matrix m m α) (B : matrix m n α) (D : matrix n n α)
+  (hAD : is_unit A ↔ is_unit D) :
+  (from_blocks A B 0 D)⁻¹ = from_blocks A⁻¹ (-(A⁻¹⬝B⬝D⁻¹)) 0 D⁻¹ :=
+begin
+  by_cases hA : is_unit A,
+  { have hD := hAD.mp hA,
+    casesI hA.nonempty_invertible,
+    casesI hD.nonempty_invertible,
+    letI := from_blocks_zero₂₁_invertible A B D,
+    simp_rw [←inv_of_eq_nonsing_inv, inv_of_from_blocks_zero₂₁_eq] },
+  { have hD := hAD.not.mp hA,
+    have : ¬is_unit (from_blocks A B 0 D) :=
+      is_unit_from_blocks_zero₂₁.not.mpr (not_and'.mpr $ λ _, hA),
+    simp_rw [nonsing_inv_eq_ring_inverse,
+      ring.inverse_non_unit _ hA, ring.inverse_non_unit _ hD, ring.inverse_non_unit _ this,
+      matrix.zero_mul, neg_zero, from_blocks_zero] }
+end
+
+/-- An expression for the inverse of a lower block-triangular matrix, when either both elements of
+diagonal are invertible, or both are not. -/
+lemma inv_from_blocks_zero₁₂_of_is_unit_iff
+  (A : matrix m m α) (C : matrix n m α) (D : matrix n n α)
+  (hAD : is_unit A ↔ is_unit D) :
+  (from_blocks A 0 C D)⁻¹ = from_blocks A⁻¹ 0 (-(D⁻¹⬝C⬝A⁻¹)) D⁻¹ :=
+begin
+  by_cases hA : is_unit A,
+  { have hD := hAD.mp hA,
+    casesI hA.nonempty_invertible,
+    casesI hD.nonempty_invertible,
+    letI := from_blocks_zero₁₂_invertible A C D,
+    simp_rw [←inv_of_eq_nonsing_inv, inv_of_from_blocks_zero₁₂_eq] },
+  { have hD := hAD.not.mp hA,
+    have : ¬is_unit (from_blocks A 0 C D) :=
+      is_unit_from_blocks_zero₁₂.not.mpr (not_and'.mpr $ λ _, hA),
+    simp_rw [nonsing_inv_eq_ring_inverse,
+      ring.inverse_non_unit _ hA, ring.inverse_non_unit _ hD, ring.inverse_non_unit _ this,
+      matrix.zero_mul, neg_zero, from_blocks_zero] }
+end
+
+end triangular
+
+/-! ### 2×2 block matrices -/
+
+section block
+
+/-! #### General 2×2 block matrices-/
+
+/-- A block matrix is invertible if the bottom right corner and the corresponding schur complement
+is. -/
+def from_blocks₂₂_invertible
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible D] [invertible (A - B⬝⅟D⬝C)] :
+  invertible (from_blocks A B C D) :=
+begin
+  -- factor `from_blocks` via `from_blocks_eq_of_invertible₂₂`, and state the inverse we expect
+  refine invertible.copy' _ _
+    (from_blocks
+      (⅟(A - B⬝⅟D⬝C))         (-(⅟(A - B⬝⅟D⬝C)⬝B⬝⅟D))
+      (-(⅟D⬝C⬝⅟(A - B⬝⅟D⬝C))) (⅟D + ⅟D⬝C⬝⅟(A - B⬝⅟D⬝C)⬝B⬝⅟D))
+    (from_blocks_eq_of_invertible₂₂ _ _ _ _) _,
+  { -- the product is invertible because all the factors are
+    letI : invertible (1 : matrix n n α) := invertible_one,
+    letI : invertible (1 : matrix m m α) := invertible_one,
+    refine invertible.matrix_mul _ (from_blocks_zero₁₂_invertible _ _ _),
+    exact invertible.matrix_mul (from_blocks_zero₂₁_invertible _ _ _)
+      (from_blocks_zero₂₁_invertible _ _ _) },
+  { -- unfold the `invertible` instances to get the raw factors
+    show _ = from_blocks 1 0 (-(1 ⬝ (⅟ D ⬝ C) ⬝ 1)) 1
+           ⬝ (from_blocks (⅟ (A - B ⬝ ⅟ D ⬝ C)) (-(⅟ (A - B ⬝ ⅟ D ⬝ C) ⬝ 0 ⬝ ⅟ D)) 0 (⅟ D)
+             ⬝ from_blocks 1 (-(1 ⬝ (B ⬝ ⅟ D) ⬝ 1)) 0 1),
+    -- combine into a single block matrix
+    simp only [from_blocks_multiply, inv_of_one, matrix.one_mul, matrix.mul_one, matrix.zero_mul,
+      matrix.mul_zero, add_zero, zero_add, neg_zero, matrix.mul_neg, matrix.neg_mul, neg_neg,
+      ←matrix.mul_assoc, add_comm], },
+end
+
+/-- A block matrix is invertible if the top left corner and the corresponding schur complement
+is. -/
+def from_blocks₁₁_invertible
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] [invertible (D - C⬝⅟A⬝B)] :
+  invertible (from_blocks A B C D) :=
+begin
+  -- we argue by symmetry
+  letI := from_blocks₂₂_invertible D C B A,
+  letI iDCBA
+   :=
+    submatrix_equiv_invertible (from_blocks D C B A) (equiv.sum_comm _ _) (equiv.sum_comm _ _),
+  exact iDCBA.copy' _
+    (from_blocks
+      (⅟A + ⅟A⬝B⬝⅟(D - C⬝⅟A⬝B)⬝C⬝⅟A) (-(⅟A⬝B⬝⅟(D - C⬝⅟A⬝B)))
+      (-(⅟(D - C⬝⅟A⬝B)⬝C⬝⅟A))        (⅟(D - C⬝⅟A⬝B)))
+    (from_blocks_submatrix_sum_swap_sum_swap _ _ _ _).symm
+    (from_blocks_submatrix_sum_swap_sum_swap _ _ _ _).symm,
+end
+
+lemma inv_of_from_blocks₂₂_eq
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible D] [invertible (A - B⬝⅟D⬝C)] [invertible (from_blocks A B C D)] :
+  ⅟(from_blocks A B C D) = from_blocks
+      (⅟(A - B⬝⅟D⬝C))          (-(⅟(A - B⬝⅟D⬝C)⬝B⬝⅟D))
+      (-(⅟D⬝C⬝⅟(A - B⬝⅟D⬝C))) (⅟D + ⅟D⬝C⬝⅟(A - B⬝⅟D⬝C)⬝B⬝⅟D):=
+begin
+  letI := from_blocks₂₂_invertible A B C D,
+  convert (rfl : ⅟(from_blocks A B C D) = _),
+end
+
+lemma inv_of_from_blocks₁₁_eq
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] [invertible (D - C⬝⅟A⬝B)] [invertible (from_blocks A B C D)] :
+  ⅟(from_blocks A B C D) = from_blocks
+      (⅟A + ⅟A⬝B⬝⅟(D - C⬝⅟A⬝B)⬝C⬝⅟A) (-(⅟A⬝B⬝⅟(D - C⬝⅟A⬝B)))
+      (-(⅟(D - C⬝⅟A⬝B)⬝C⬝⅟A))        (⅟(D - C⬝⅟A⬝B)) :=
+begin
+  letI := from_blocks₁₁_invertible A B C D,
+  convert (rfl : ⅟(from_blocks A B C D) = _),
+end
+
+/-- If a block matrix is invertible and so is its bottom left element, then so is the corresponding
+Schur complement. -/
+def invertible_of_from_blocks₂₂_invertible
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible D] [invertible (from_blocks A B C D)] : invertible (A - B⬝⅟D⬝C) :=
+begin
+  suffices : invertible (from_blocks (A - B ⬝ ⅟ D ⬝ C) 0 0 D),
+  { exactI (invertible_of_from_blocks_zero₁₂_invertible (A - B ⬝ ⅟ D ⬝ C) 0 D).1 },
+  letI : invertible (1 : matrix n n α) := invertible_one,
+  letI : invertible (1 : matrix m m α) := invertible_one,
+  letI iDC : invertible (from_blocks 1 0 (⅟ D ⬝ C) 1 : matrix (m ⊕ n) (m ⊕ n) α) :=
+    from_blocks_zero₁₂_invertible _ _ _,
+  letI iBD : invertible (from_blocks 1 (B ⬝ ⅟ D) 0 1 : matrix(m ⊕ n) (m ⊕ n) α) :=
+    from_blocks_zero₂₁_invertible _ _ _,
+  letI iBDC := invertible.copy ‹_› _ (from_blocks_eq_of_invertible₂₂ A B C D).symm,
+  refine (iBD.matrix_mul_left _).symm _,
+  refine (iDC.matrix_mul_right _).symm iBDC,
+end
+
+/-- If a block matrix is invertible and so is its bottom left element, then so is the corresponding
+Schur complement. -/
+def invertible_of_from_blocks₁₁_invertible
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] [invertible (from_blocks A B C D)] : invertible (D - C⬝⅟A⬝B) :=
+begin
+  -- another symmetry argument
+  letI iABCD' :=
+    submatrix_equiv_invertible (from_blocks A B C D) (equiv.sum_comm _ _) (equiv.sum_comm _ _),
+  letI iDCBA := iABCD'.copy _ (from_blocks_submatrix_sum_swap_sum_swap _ _ _ _).symm,
+  refine invertible_of_from_blocks₂₂_invertible D C B A,
+end
+
+/-- `matrix.invertible_of_from_blocks₂₂_invertible` and `matrix.from_blocks₂₂_invertible` as an
+equivalence. -/
+def invertible_equiv_from_blocks₂₂_invertible
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible D] : invertible (from_blocks A B C D) ≃ invertible (A - B⬝⅟D⬝C) :=
+{ to_fun := λ iABCD, by exactI invertible_of_from_blocks₂₂_invertible _ _ _ _,
+  inv_fun := λ i_schur,by exactI from_blocks₂₂_invertible _ _ _ _,
+  left_inv := λ iABCD, subsingleton.elim _ _,
+  right_inv := λ i_schur, subsingleton.elim _ _ }
+
+/-- `matrix.invertible_of_from_blocks₁₁_invertible` and `matrix.from_blocks₁₁_invertible` as an
+equivalence. -/
+def invertible_equiv_from_blocks₁₁_invertible
+  (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] : invertible (from_blocks A B C D) ≃ invertible (D - C⬝⅟A⬝B) :=
+{ to_fun := λ iABCD, by exactI invertible_of_from_blocks₁₁_invertible _ _ _ _,
+  inv_fun := λ i_schur,by exactI from_blocks₁₁_invertible _ _ _ _,
+  left_inv := λ iABCD, subsingleton.elim _ _,
+  right_inv := λ i_schur, subsingleton.elim _ _ }
+
+/-- If the bottom-left element of a block matrix is invertible, then the whole matrix is invertible
+iff the corresponding schur complement is. -/
+lemma is_unit_from_blocks_iff_of_invertible₂₂
+  {A : matrix m m α} {B : matrix m n α} {C : matrix n m α} {D : matrix n n α} [invertible D] :
+  is_unit (from_blocks A B C D) ↔ is_unit (A - B⬝⅟D⬝C) :=
+by simp only [← nonempty_invertible_iff_is_unit,
+  (invertible_equiv_from_blocks₂₂_invertible A B C D).nonempty_congr]
+
+/-- If the top-right element of a block matrix is invertible, then the whole matrix is invertible
+iff the corresponding schur complement is. -/
+lemma is_unit_from_blocks_iff_of_invertible₁₁
+  {A : matrix m m α} {B : matrix m n α} {C : matrix n m α} {D : matrix n n α} [invertible A] :
+  is_unit (from_blocks A B C D) ↔ is_unit (D - C⬝⅟A⬝B) :=
+by simp only [← nonempty_invertible_iff_is_unit,
+  (invertible_equiv_from_blocks₁₁_invertible A B C D).nonempty_congr]
+
+end block
+
+/-! ### Lemmas about `matrix.det` -/
+
+section det
+
+/-- Determinant of a 2×2 block matrix, expanded around an invertible top left element in terms of
+the Schur complement. -/
+lemma det_from_blocks₁₁ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible A] : (matrix.from_blocks A B C D).det = det A * det (D - C ⬝ (⅟A) ⬝ B) :=
+by rw [from_blocks_eq_of_invertible₁₁, det_mul, det_mul, det_from_blocks_zero₂₁,
+  det_from_blocks_zero₂₁, det_from_blocks_zero₁₂, det_one, det_one, one_mul, one_mul, mul_one]
+
+@[simp] lemma det_from_blocks_one₁₁ (B : matrix m n α) (C : matrix n m α) (D : matrix n n α) :
+  (matrix.from_blocks 1 B C D).det = det (D - C ⬝ B) :=
+begin
+  haveI : invertible (1 : matrix m m α) := invertible_one,
+  rw [det_from_blocks₁₁, inv_of_one, matrix.mul_one, det_one, one_mul],
+end
+
+/-- Determinant of a 2×2 block matrix, expanded around an invertible bottom right element in terms
+of the Schur complement. -/
+lemma det_from_blocks₂₂ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) (D : matrix n n α)
+  [invertible D] : (matrix.from_blocks A B C D).det = det D * det (A - B ⬝ (⅟D) ⬝ C) :=
+begin
+  have : from_blocks A B C D
+    = (from_blocks D C B A).submatrix (equiv.sum_comm _ _) (equiv.sum_comm _ _),
+  { ext i j,
+    cases i; cases j; refl },
+  rw [this, det_submatrix_equiv_self, det_from_blocks₁₁],
+end
+
+@[simp] lemma det_from_blocks_one₂₂ (A : matrix m m α) (B : matrix m n α) (C : matrix n m α) :
+  (matrix.from_blocks A B C 1).det = det (A - B ⬝ C) :=
+begin
+  haveI : invertible (1 : matrix n n α) := invertible_one,
+  rw [det_from_blocks₂₂, inv_of_one, matrix.mul_one, det_one, one_mul],
+end
+
+/-- The **Weinstein–Aronszajn identity**. Note the `1` on the LHS is of shape m×m, while the `1` on
+the RHS is of shape n×n. -/
+lemma det_one_add_mul_comm (A : matrix m n α) (B : matrix n m α) :
+  det (1 + A ⬝ B) = det (1 + B ⬝ A) :=
+calc  det (1 + A ⬝ B)
+    = det (from_blocks 1 (-A) B 1) : by rw [det_from_blocks_one₂₂, matrix.neg_mul, sub_neg_eq_add]
+... = det (1 + B ⬝ A)              : by rw [det_from_blocks_one₁₁, matrix.mul_neg, sub_neg_eq_add]
+
+/-- Alternate statement of the **Weinstein–Aronszajn identity** -/
+lemma det_mul_add_one_comm (A : matrix m n α) (B : matrix n m α) :
+  det (A ⬝ B + 1) = det (B ⬝ A + 1) :=
+by rw [add_comm, det_one_add_mul_comm, add_comm]
+
+lemma det_one_sub_mul_comm (A : matrix m n α) (B : matrix n m α) :
+  det (1 - A ⬝ B) = det (1 - B ⬝ A) :=
+by rw [sub_eq_add_neg, ←matrix.neg_mul, det_one_add_mul_comm, matrix.mul_neg, ←sub_eq_add_neg]
+
+/-- A special case of the **Matrix determinant lemma** for when `A = I`.
+
+TODO: show this more generally. -/
+lemma det_one_add_col_mul_row (u v : m → α) : det (1 + col u ⬝ row v) = 1 + v ⬝ᵥ u :=
+by rw [det_one_add_mul_comm, det_unique, pi.add_apply, pi.add_apply, matrix.one_apply_eq,
+       matrix.row_mul_col_apply]
+
+end det
+
+end comm_ring
+
+/-! ### Lemmas about `ℝ` and `ℂ`-/
+
+section is_R_or_C
+
+open_locale matrix
+variables {𝕜 : Type*} [is_R_or_C 𝕜]
+
+localized "infix ` ⊕ᵥ `:65 := sum.elim" in matrix
+
+lemma schur_complement_eq₁₁ [fintype m] [decidable_eq m] [fintype n]
+  {A : matrix m m 𝕜} (B : matrix m n 𝕜) (D : matrix n n 𝕜) (x : m → 𝕜) (y : n → 𝕜)
+  [invertible A] (hA : A.is_hermitian) :
+vec_mul (star (x ⊕ᵥ y)) (from_blocks A B Bᴴ D) ⬝ᵥ (x ⊕ᵥ y) =
+  vec_mul (star (x + (A⁻¹ ⬝ B).mul_vec y)) A ⬝ᵥ (x + (A⁻¹ ⬝ B).mul_vec y) +
+    vec_mul (star y) (D - Bᴴ ⬝ A⁻¹ ⬝ B) ⬝ᵥ y :=
+begin
+  simp [function.star_sum_elim, from_blocks_mul_vec, vec_mul_from_blocks, add_vec_mul,
+    dot_product_mul_vec, vec_mul_sub, matrix.mul_assoc, vec_mul_mul_vec, hA.eq,
+    conj_transpose_nonsing_inv, star_mul_vec],
+  abel
+end
+
+lemma schur_complement_eq₂₂ [fintype m] [fintype n] [decidable_eq n]
+  (A : matrix m m 𝕜) (B : matrix m n 𝕜) {D : matrix n n 𝕜} (x : m → 𝕜) (y : n → 𝕜)
+  [invertible D] (hD : D.is_hermitian) :
+vec_mul (star (x ⊕ᵥ y)) (from_blocks A B Bᴴ D) ⬝ᵥ (x ⊕ᵥ y) =
+  vec_mul (star ((D⁻¹ ⬝ Bᴴ).mul_vec x + y)) D ⬝ᵥ ((D⁻¹ ⬝ Bᴴ).mul_vec x + y) +
+    vec_mul (star x) (A - B ⬝ D⁻¹ ⬝ Bᴴ) ⬝ᵥ x :=
+begin
+  simp [function.star_sum_elim, from_blocks_mul_vec, vec_mul_from_blocks, add_vec_mul,
+    dot_product_mul_vec, vec_mul_sub, matrix.mul_assoc, vec_mul_mul_vec, hD.eq,
+    conj_transpose_nonsing_inv, star_mul_vec],
+  abel
+end
+
+lemma is_hermitian.from_blocks₁₁ [fintype m] [decidable_eq m]
+  {A : matrix m m 𝕜} (B : matrix m n 𝕜) (D : matrix n n 𝕜)
+  (hA : A.is_hermitian) :
+  (from_blocks A B Bᴴ D).is_hermitian ↔ (D - Bᴴ ⬝ A⁻¹ ⬝ B).is_hermitian :=
+begin
+  have hBAB : (Bᴴ ⬝ A⁻¹ ⬝ B).is_hermitian,
+  { apply is_hermitian_conj_transpose_mul_mul,
+    apply hA.inv },
+  rw [is_hermitian_from_blocks_iff],
+  split,
+  { intro h,
+    apply is_hermitian.sub h.2.2.2 hBAB },
+  { intro h,
+    refine ⟨hA, rfl, conj_transpose_conj_transpose B, _⟩,
+    rw ← sub_add_cancel D,
+    apply is_hermitian.add h hBAB }
+end
+
+lemma is_hermitian.from_blocks₂₂ [fintype n] [decidable_eq n]
+  (A : matrix m m 𝕜) (B : matrix m n 𝕜) {D : matrix n n 𝕜}
+  (hD : D.is_hermitian) :
+  (from_blocks A B Bᴴ D).is_hermitian ↔ (A - B ⬝ D⁻¹ ⬝ Bᴴ).is_hermitian :=
+begin
+  rw [←is_hermitian_submatrix_equiv (equiv.sum_comm n m), equiv.sum_comm_apply,
+    from_blocks_submatrix_sum_swap_sum_swap],
+  convert is_hermitian.from_blocks₁₁ _ _ hD; simp
+end
+
+lemma pos_semidef.from_blocks₁₁ [fintype m] [decidable_eq m] [fintype n]
+  {A : matrix m m 𝕜} (B : matrix m n 𝕜) (D : matrix n n 𝕜)
+  (hA : A.pos_def) [invertible A] :
+  (from_blocks A B Bᴴ D).pos_semidef ↔ (D - Bᴴ ⬝ A⁻¹ ⬝ B).pos_semidef :=
+begin
+  rw [pos_semidef, is_hermitian.from_blocks₁₁ _ _ hA.1],
+  split,
+  { refine λ h, ⟨h.1, λ x, _⟩,
+    have := h.2 (- ((A⁻¹ ⬝ B).mul_vec x) ⊕ᵥ x),
+    rw [dot_product_mul_vec, schur_complement_eq₁₁ B D _ _ hA.1, neg_add_self,
+      dot_product_zero, zero_add] at this,
+    rw [dot_product_mul_vec], exact this },
+  { refine λ h, ⟨h.1, λ x, _⟩,
+    rw [dot_product_mul_vec, ← sum.elim_comp_inl_inr x, schur_complement_eq₁₁ B D _ _ hA.1,
+      map_add],
+    apply le_add_of_nonneg_of_le,
+    { rw ← dot_product_mul_vec,
+      apply hA.pos_semidef.2, },
+    { rw ← dot_product_mul_vec, apply h.2 } }
+end
+
+lemma pos_semidef.from_blocks₂₂ [fintype m] [fintype n] [decidable_eq n]
+  (A : matrix m m 𝕜) (B : matrix m n 𝕜) {D : matrix n n 𝕜}
+  (hD : D.pos_def) [invertible D] :
+  (from_blocks A B Bᴴ D).pos_semidef ↔ (A - B ⬝ D⁻¹ ⬝ Bᴴ).pos_semidef :=
+begin
+  rw [←pos_semidef_submatrix_equiv (equiv.sum_comm n m), equiv.sum_comm_apply,
+    from_blocks_submatrix_sum_swap_sum_swap],
+  convert pos_semidef.from_blocks₁₁ _ _ hD; apply_instance <|> simp
+end
+
+end is_R_or_C
+
+end matrix
diff --git a/src/linear_algebra/matrix/sesquilinear_form.lean b/src/linear_algebra/matrix/sesquilinear_form.lean
new file mode 100644
index 0000000000000..380bb004a4175
--- /dev/null
+++ b/src/linear_algebra/matrix/sesquilinear_form.lean
@@ -0,0 +1,640 @@
+/-
+Copyright (c) 2020 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen, Kexing Ying, Moritz Doll
+-/
+
+import linear_algebra.finsupp_vector_space
+import linear_algebra.matrix.basis
+import linear_algebra.matrix.nondegenerate
+import linear_algebra.matrix.nonsingular_inverse
+import linear_algebra.matrix.to_linear_equiv
+import linear_algebra.sesquilinear_form
+
+/-!
+# Sesquilinear form
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the conversion between sesquilinear forms and matrices.
+
+## Main definitions
+
+ * `matrix.to_linear_map₂` given a basis define a bilinear form
+ * `matrix.to_linear_map₂'` define the bilinear form on `n → R`
+ * `linear_map.to_matrix₂`: calculate the matrix coefficients of a bilinear form
+ * `linear_map.to_matrix₂'`: calculate the matrix coefficients of a bilinear form on `n → R`
+
+## Todos
+
+At the moment this is quite a literal port from `matrix.bilinear_form`. Everything should be
+generalized to fully semibilinear forms.
+
+## Tags
+
+sesquilinear_form, matrix, basis
+
+-/
+
+variables {R R₁ R₂ M M₁ M₂ M₁' M₂' n m n' m' ι : Type*}
+
+open_locale big_operators
+open finset linear_map matrix
+open_locale matrix
+
+section aux_to_linear_map
+
+variables [comm_semiring R] [comm_semiring R₁] [comm_semiring R₂]
+variables [fintype n] [fintype m]
+
+variables (σ₁ : R₁ →+* R) (σ₂ : R₂ →+* R)
+
+
+/-- The map from `matrix n n R` to bilinear forms on `n → R`.
+
+This is an auxiliary definition for the equivalence `matrix.to_linear_map₂'`. -/
+def matrix.to_linear_map₂'_aux  (f : matrix n m R) :
+  (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R :=
+mk₂'ₛₗ σ₁ σ₂ (λ (v : n → R₁) (w : m → R₂), ∑ i j, σ₁ (v i) * f i j * σ₂ (w j))
+  (λ _ _ _, by simp only [pi.add_apply, map_add, add_mul, sum_add_distrib] )
+  (λ _ _ _, by simp only [pi.smul_apply, smul_eq_mul, ring_hom.map_mul, mul_assoc, mul_sum] )
+  (λ _ _ _, by simp only [pi.add_apply, map_add, mul_add, sum_add_distrib] )
+  (λ _ _ _, by
+    simp only [pi.smul_apply, smul_eq_mul, ring_hom.map_mul, mul_assoc, mul_left_comm, mul_sum] )
+
+variables [decidable_eq n] [decidable_eq m]
+
+lemma matrix.to_linear_map₂'_aux_std_basis (f : matrix n m R) (i : n) (j : m) :
+  f.to_linear_map₂'_aux σ₁ σ₂ (std_basis R₁ (λ _, R₁) i 1) (std_basis R₂ (λ _, R₂) j 1) = f i j :=
+begin
+  rw [matrix.to_linear_map₂'_aux, mk₂'ₛₗ_apply],
+  have : (∑ i' j', (if i = i' then 1 else 0) * f i' j' * (if j = j' then 1 else 0)) = f i j :=
+  begin
+    simp_rw [mul_assoc, ←finset.mul_sum],
+    simp only [boole_mul, finset.sum_ite_eq, finset.mem_univ, if_true, mul_comm (f _ _)],
+  end,
+  rw ←this,
+  exact finset.sum_congr rfl (λ _ _, finset.sum_congr rfl (λ _ _, by simp)),
+end
+
+end aux_to_linear_map
+
+section aux_to_matrix
+
+section comm_semiring
+
+variables [comm_semiring R] [comm_semiring R₁] [comm_semiring R₂]
+variables [add_comm_monoid M₁] [module R₁ M₁] [add_comm_monoid M₂] [module R₂ M₂]
+
+variables {σ₁ : R₁ →+* R} {σ₂ : R₂ →+* R}
+
+/-- The linear map from sesquilinear forms to `matrix n m R` given an `n`-indexed basis for `M₁`
+and an `m`-indexed basis for `M₂`.
+
+This is an auxiliary definition for the equivalence `matrix.to_linear_mapₛₗ₂'`. -/
+def linear_map.to_matrix₂_aux (b₁ : n → M₁) (b₂ : m → M₂) :
+  (M₁ →ₛₗ[σ₁] M₂ →ₛₗ[σ₂] R) →ₗ[R] matrix n m R :=
+{ to_fun := λ f, of $ λ i j, f (b₁ i) (b₂ j),
+  map_add' := λ f g, rfl,
+  map_smul' := λ f g, rfl }
+
+@[simp] lemma linear_map.to_matrix₂_aux_apply (f : M₁ →ₛₗ[σ₁] M₂ →ₛₗ[σ₂] R)
+  (b₁ : n → M₁) (b₂ : m → M₂) (i : n) (j : m) :
+  linear_map.to_matrix₂_aux b₁ b₂ f i j = f (b₁ i) (b₂ j) := rfl
+
+end comm_semiring
+
+section comm_ring
+
+variables [comm_ring R] [comm_ring R₁] [comm_ring R₂]
+variables [add_comm_monoid M₁] [module R₁ M₁] [add_comm_monoid M₂] [module R₂ M₂]
+variables [fintype n] [fintype m]
+variables [decidable_eq n] [decidable_eq m]
+
+variables {σ₁ : R₁ →+* R} {σ₂ : R₂ →+* R}
+
+lemma linear_map.to_linear_map₂'_aux_to_matrix₂_aux (f : (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) :
+  matrix.to_linear_map₂'_aux σ₁ σ₂ (linear_map.to_matrix₂_aux
+    (λ i, std_basis R₁ (λ _, R₁) i 1) (λ j, std_basis R₂ (λ _, R₂) j 1) f) = f :=
+begin
+  refine ext_basis (pi.basis_fun R₁ n) (pi.basis_fun R₂ m) (λ i j, _),
+  simp_rw [pi.basis_fun_apply, matrix.to_linear_map₂'_aux_std_basis,
+    linear_map.to_matrix₂_aux_apply],
+end
+
+lemma matrix.to_matrix₂_aux_to_linear_map₂'_aux (f : matrix n m R) :
+  linear_map.to_matrix₂_aux (λ i, std_basis R₁ (λ _, R₁) i 1) (λ j, std_basis R₂ (λ _, R₂) j 1)
+    (f.to_linear_map₂'_aux σ₁ σ₂) = f :=
+by { ext i j, simp_rw [linear_map.to_matrix₂_aux_apply, matrix.to_linear_map₂'_aux_std_basis] }
+
+end comm_ring
+
+end aux_to_matrix
+
+section to_matrix'
+
+/-! ### Bilinear forms over `n → R`
+
+This section deals with the conversion between matrices and sesquilinear forms on `n → R`.
+-/
+
+variables [comm_ring R] [comm_ring R₁] [comm_ring R₂]
+variables [fintype n] [fintype m]
+variables [decidable_eq n] [decidable_eq m]
+
+variables {σ₁ : R₁ →+* R} {σ₂ : R₂ →+* R}
+
+/-- The linear equivalence between sesquilinear forms and `n × m` matrices -/
+def linear_map.to_matrixₛₗ₂' : ((n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) ≃ₗ[R] matrix n m R :=
+{ to_fun := linear_map.to_matrix₂_aux _ _,
+  inv_fun := matrix.to_linear_map₂'_aux σ₁ σ₂,
+  left_inv := linear_map.to_linear_map₂'_aux_to_matrix₂_aux,
+  right_inv := matrix.to_matrix₂_aux_to_linear_map₂'_aux,
+  ..linear_map.to_matrix₂_aux (λ i, std_basis R₁ (λ _, R₁) i 1) (λ j, std_basis R₂ (λ _, R₂) j 1) }
+
+/-- The linear equivalence between bilinear forms and `n × m` matrices -/
+def linear_map.to_matrix₂' : ((n → R) →ₗ[R] (m → R) →ₗ[R] R) ≃ₗ[R] matrix n m R :=
+linear_map.to_matrixₛₗ₂'
+
+variables (σ₁ σ₂)
+
+/-- The linear equivalence between `n × n` matrices and sesquilinear forms on `n → R` -/
+def matrix.to_linear_mapₛₗ₂' : matrix n m R ≃ₗ[R] ((n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) :=
+linear_map.to_matrixₛₗ₂'.symm
+
+/-- The linear equivalence between `n × n` matrices and bilinear forms on `n → R` -/
+def matrix.to_linear_map₂' : matrix n m R ≃ₗ[R] ((n → R) →ₗ[R] (m → R) →ₗ[R] R) :=
+linear_map.to_matrix₂'.symm
+
+lemma matrix.to_linear_mapₛₗ₂'_aux_eq (M : matrix n m R) :
+  matrix.to_linear_map₂'_aux σ₁ σ₂ M = matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M := rfl
+
+lemma matrix.to_linear_mapₛₗ₂'_apply (M : matrix n m R) (x : n → R₁) (y : m → R₂) :
+  matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M x y = ∑ i j, σ₁ (x i) * M i j * σ₂ (y j) := rfl
+
+lemma matrix.to_linear_map₂'_apply (M : matrix n m R) (x : n → R) (y : m → R) :
+  matrix.to_linear_map₂' M x y = ∑ i j, x i * M i j * y j := rfl
+
+lemma matrix.to_linear_map₂'_apply' (M : matrix n m R) (v : n → R) (w : m → R) :
+  matrix.to_linear_map₂' M v w = matrix.dot_product v (M.mul_vec w) :=
+begin
+  simp_rw [matrix.to_linear_map₂'_apply, matrix.dot_product,
+           matrix.mul_vec, matrix.dot_product],
+  refine finset.sum_congr rfl (λ _ _, _),
+  rw finset.mul_sum,
+  refine finset.sum_congr rfl (λ _ _, _),
+  rw ← mul_assoc,
+end
+
+@[simp] lemma matrix.to_linear_mapₛₗ₂'_std_basis (M : matrix n m R) (i : n) (j : m) :
+  matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M (std_basis R₁ (λ _, R₁) i 1) (std_basis R₂ (λ _, R₂) j 1) =
+    M i j :=
+matrix.to_linear_map₂'_aux_std_basis σ₁ σ₂ M i j
+
+@[simp] lemma matrix.to_linear_map₂'_std_basis (M : matrix n m R) (i : n) (j : m) :
+  matrix.to_linear_map₂' M (std_basis R (λ _, R) i 1) (std_basis R (λ _, R) j 1) =
+    M i j :=
+matrix.to_linear_map₂'_aux_std_basis _ _ M i j
+
+@[simp] lemma linear_map.to_matrixₛₗ₂'_symm :
+  (linear_map.to_matrixₛₗ₂'.symm : matrix n m R ≃ₗ[R] _) = matrix.to_linear_mapₛₗ₂' σ₁ σ₂ :=
+rfl
+
+@[simp] lemma matrix.to_linear_mapₛₗ₂'_symm :
+  ((matrix.to_linear_mapₛₗ₂' σ₁ σ₂).symm : _ ≃ₗ[R] matrix n m R) = linear_map.to_matrixₛₗ₂' :=
+linear_map.to_matrixₛₗ₂'.symm_symm
+
+@[simp] lemma matrix.to_linear_mapₛₗ₂'_to_matrix' (B : (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) :
+  matrix.to_linear_mapₛₗ₂' σ₁ σ₂ (linear_map.to_matrixₛₗ₂' B) = B :=
+(matrix.to_linear_mapₛₗ₂' σ₁ σ₂).apply_symm_apply B
+
+@[simp] lemma matrix.to_linear_map₂'_to_matrix' (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) :
+  matrix.to_linear_map₂' (linear_map.to_matrix₂' B) = B :=
+matrix.to_linear_map₂'.apply_symm_apply B
+
+@[simp] lemma linear_map.to_matrix'_to_linear_mapₛₗ₂' (M : matrix n m R) :
+  linear_map.to_matrixₛₗ₂' (matrix.to_linear_mapₛₗ₂' σ₁ σ₂ M) = M :=
+linear_map.to_matrixₛₗ₂'.apply_symm_apply M
+
+@[simp] lemma linear_map.to_matrix'_to_linear_map₂' (M : matrix n m R) :
+  linear_map.to_matrix₂' (matrix.to_linear_map₂' M) = M :=
+linear_map.to_matrixₛₗ₂'.apply_symm_apply M
+
+@[simp] lemma linear_map.to_matrixₛₗ₂'_apply (B : (n → R₁) →ₛₗ[σ₁] (m → R₂) →ₛₗ[σ₂] R) (i : n)
+  (j : m): linear_map.to_matrixₛₗ₂' B i j =
+    B (std_basis R₁ (λ _, R₁) i 1) (std_basis R₂ (λ _, R₂) j 1) :=
+rfl
+
+@[simp] lemma linear_map.to_matrix₂'_apply (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) (i : n) (j : m):
+  linear_map.to_matrix₂' B i j =
+    B (std_basis R (λ _, R) i 1) (std_basis R (λ _, R) j 1) :=
+rfl
+
+variables [fintype n'] [fintype m']
+variables [decidable_eq n'] [decidable_eq m']
+
+@[simp] lemma linear_map.to_matrix₂'_compl₁₂ (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
+  (l : (n' → R) →ₗ[R] (n → R)) (r : (m' → R) →ₗ[R] (m → R)) :
+  (B.compl₁₂ l r).to_matrix₂' = l.to_matrix'ᵀ ⬝ B.to_matrix₂' ⬝ r.to_matrix' :=
+begin
+  ext i j,
+  simp only [linear_map.to_matrix₂'_apply, linear_map.compl₁₂_apply, transpose_apply,
+    matrix.mul_apply, linear_map.to_matrix', linear_equiv.coe_mk, sum_mul],
+  rw sum_comm,
+  conv_lhs { rw ←linear_map.sum_repr_mul_repr_mul (pi.basis_fun R n) (pi.basis_fun R m)
+    (l _) (r _) },
+  rw finsupp.sum_fintype,
+  { apply sum_congr rfl,
+    rintros i' -,
+    rw finsupp.sum_fintype,
+    { apply sum_congr rfl,
+      rintros j' -,
+      simp only [smul_eq_mul, pi.basis_fun_repr, mul_assoc, mul_comm, mul_left_comm,
+                 pi.basis_fun_apply, of_apply] },
+    { intros, simp only [zero_smul, smul_zero] } },
+  { intros, simp only [zero_smul, finsupp.sum_zero] }
+end
+
+lemma linear_map.to_matrix₂'_comp (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
+  (f : (n' → R) →ₗ[R] (n → R)) : (B.comp f).to_matrix₂' = f.to_matrix'ᵀ ⬝ B.to_matrix₂' :=
+by { rw [←linear_map.compl₂_id (B.comp f), ←linear_map.compl₁₂], simp }
+
+lemma linear_map.to_matrix₂'_compl₂ (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
+  (f : (m' → R) →ₗ[R] (m → R)) : (B.compl₂ f).to_matrix₂' = B.to_matrix₂' ⬝ f.to_matrix' :=
+by { rw [←linear_map.comp_id B, ←linear_map.compl₁₂], simp }
+
+lemma linear_map.mul_to_matrix₂'_mul (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R)
+  (M : matrix n' n R) (N : matrix m m' R) :
+  M ⬝ B.to_matrix₂' ⬝ N = (B.compl₁₂ Mᵀ.to_lin' N.to_lin').to_matrix₂' :=
+by simp
+
+lemma linear_map.mul_to_matrix' (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) (M : matrix n' n R) :
+  M ⬝ B.to_matrix₂' = (B.comp Mᵀ.to_lin').to_matrix₂' :=
+by simp only [B.to_matrix₂'_comp, transpose_transpose, to_matrix'_to_lin']
+
+lemma linear_map.to_matrix₂'_mul (B : (n → R) →ₗ[R] (m → R) →ₗ[R] R) (M : matrix m m' R) :
+  B.to_matrix₂' ⬝ M = (B.compl₂ M.to_lin').to_matrix₂' :=
+by simp only [B.to_matrix₂'_compl₂, to_matrix'_to_lin']
+
+lemma matrix.to_linear_map₂'_comp (M : matrix n m R) (P : matrix n n' R) (Q : matrix m m' R) :
+  M.to_linear_map₂'.compl₁₂ P.to_lin' Q.to_lin' = (Pᵀ ⬝ M ⬝ Q).to_linear_map₂' :=
+linear_map.to_matrix₂'.injective (by simp)
+
+end to_matrix'
+
+section to_matrix
+
+/-! ### Bilinear forms over arbitrary vector spaces
+
+This section deals with the conversion between matrices and bilinear forms on
+a module with a fixed basis.
+-/
+
+variables [comm_ring R]
+variables [add_comm_monoid M₁] [module R M₁] [add_comm_monoid M₂] [module R M₂]
+
+variables [decidable_eq n] [fintype n]
+variables [decidable_eq m] [fintype m]
+variables (b₁ : basis n R M₁) (b₂ : basis m R M₂)
+
+/-- `linear_map.to_matrix₂ b₁ b₂` is the equivalence between `R`-bilinear forms on `M` and
+`n`-by-`n` matrices with entries in `R`, if `b` is an `R`-basis for `M`. -/
+noncomputable def linear_map.to_matrix₂ : (M₁ →ₗ[R] M₂ →ₗ[R] R) ≃ₗ[R] matrix n m R :=
+(b₁.equiv_fun.arrow_congr (b₂.equiv_fun.arrow_congr (linear_equiv.refl R R))).trans
+  linear_map.to_matrix₂'
+
+/-- `bilin_form.to_matrix b` is the equivalence between `R`-bilinear forms on `M` and
+`n`-by-`n` matrices with entries in `R`, if `b` is an `R`-basis for `M`. -/
+noncomputable def matrix.to_linear_map₂ : matrix n m R ≃ₗ[R] (M₁ →ₗ[R] M₂ →ₗ[R] R) :=
+(linear_map.to_matrix₂ b₁ b₂).symm
+
+-- We make this and not `linear_map.to_matrix₂` a `simp` lemma to avoid timeouts
+@[simp] lemma linear_map.to_matrix₂_apply (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (i : n) (j : m) :
+  linear_map.to_matrix₂ b₁ b₂ B i j = B (b₁ i) (b₂ j) :=
+by simp only [linear_map.to_matrix₂, linear_equiv.trans_apply, linear_map.to_matrix₂'_apply,
+  linear_equiv.trans_apply, linear_map.to_matrix₂'_apply, linear_equiv.arrow_congr_apply,
+  basis.equiv_fun_symm_std_basis, linear_equiv.refl_apply]
+
+@[simp] lemma matrix.to_linear_map₂_apply (M : matrix n m R) (x : M₁) (y : M₂) :
+  matrix.to_linear_map₂ b₁ b₂ M x y = ∑ i j, b₁.repr x i * M i j * b₂.repr y j :=
+rfl
+
+-- Not a `simp` lemma since `linear_map.to_matrix₂` needs an extra argument
+lemma linear_map.to_matrix₂_aux_eq (B : M₁ →ₗ[R] M₂ →ₗ[R] R) :
+  linear_map.to_matrix₂_aux b₁ b₂ B = linear_map.to_matrix₂ b₁ b₂ B :=
+ext (λ i j, by rw [linear_map.to_matrix₂_apply, linear_map.to_matrix₂_aux_apply])
+
+@[simp] lemma linear_map.to_matrix₂_symm :
+  (linear_map.to_matrix₂ b₁ b₂).symm = matrix.to_linear_map₂ b₁ b₂ :=
+rfl
+
+@[simp] lemma matrix.to_linear_map₂_symm :
+  (matrix.to_linear_map₂ b₁ b₂).symm = linear_map.to_matrix₂ b₁ b₂ :=
+(linear_map.to_matrix₂ b₁ b₂).symm_symm
+
+lemma matrix.to_linear_map₂_basis_fun :
+  matrix.to_linear_map₂ (pi.basis_fun R n) (pi.basis_fun R m) = matrix.to_linear_map₂' :=
+by { ext M, simp only [matrix.to_linear_map₂_apply, matrix.to_linear_map₂'_apply, pi.basis_fun_repr,
+  coe_comp, function.comp_app]}
+
+lemma linear_map.to_matrix₂_basis_fun :
+  linear_map.to_matrix₂ (pi.basis_fun R n) (pi.basis_fun R m) = linear_map.to_matrix₂' :=
+by { ext B, rw [linear_map.to_matrix₂_apply, linear_map.to_matrix₂'_apply,
+                pi.basis_fun_apply, pi.basis_fun_apply] }
+
+@[simp] lemma matrix.to_linear_map₂_to_matrix₂ (B : M₁ →ₗ[R] M₂ →ₗ[R] R) :
+  matrix.to_linear_map₂ b₁ b₂ (linear_map.to_matrix₂ b₁ b₂ B) = B :=
+(matrix.to_linear_map₂ b₁ b₂).apply_symm_apply B
+
+@[simp] lemma linear_map.to_matrix₂_to_linear_map₂ (M : matrix n m R) :
+  linear_map.to_matrix₂ b₁ b₂ (matrix.to_linear_map₂ b₁ b₂ M) = M :=
+(linear_map.to_matrix₂ b₁ b₂).apply_symm_apply M
+
+variables [add_comm_monoid M₁'] [module R M₁']
+variables [add_comm_monoid M₂'] [module R M₂']
+variables (b₁' : basis n' R M₁')
+variables (b₂' : basis m' R M₂')
+variables [fintype n'] [fintype m']
+variables [decidable_eq n'] [decidable_eq m']
+
+-- Cannot be a `simp` lemma because `b₁` and `b₂` must be inferred.
+lemma linear_map.to_matrix₂_compl₁₂
+  (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (l : M₁' →ₗ[R] M₁) (r : M₂' →ₗ[R] M₂) :
+  linear_map.to_matrix₂ b₁' b₂' (B.compl₁₂ l r) =
+    (to_matrix b₁' b₁ l)ᵀ ⬝ linear_map.to_matrix₂ b₁ b₂ B ⬝ to_matrix b₂' b₂ r :=
+begin
+  ext i j,
+  simp only [linear_map.to_matrix₂_apply, compl₁₂_apply, transpose_apply, matrix.mul_apply,
+    linear_map.to_matrix_apply, linear_equiv.coe_mk, sum_mul],
+  rw sum_comm,
+  conv_lhs { rw ←linear_map.sum_repr_mul_repr_mul b₁ b₂ },
+  rw finsupp.sum_fintype,
+  { apply sum_congr rfl,
+    rintros i' -,
+    rw finsupp.sum_fintype,
+    { apply sum_congr rfl,
+      rintros j' -,
+      simp only [smul_eq_mul, linear_map.to_matrix_apply,
+        basis.equiv_fun_apply, mul_assoc, mul_comm, mul_left_comm] },
+    { intros, simp only [zero_smul, smul_zero] } },
+  { intros, simp only [zero_smul, finsupp.sum_zero] }
+end
+
+lemma linear_map.to_matrix₂_comp (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (f : M₁' →ₗ[R] M₁) :
+  linear_map.to_matrix₂ b₁' b₂ (B.comp f) = (to_matrix b₁' b₁ f)ᵀ ⬝ linear_map.to_matrix₂ b₁ b₂ B :=
+begin
+  rw [←linear_map.compl₂_id (B.comp f), ←linear_map.compl₁₂, linear_map.to_matrix₂_compl₁₂ b₁ b₂],
+  simp,
+end
+
+lemma linear_map.to_matrix₂_compl₂ (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (f : M₂' →ₗ[R] M₂) :
+  linear_map.to_matrix₂ b₁ b₂' (B.compl₂ f) =
+  linear_map.to_matrix₂ b₁ b₂ B ⬝ (to_matrix b₂' b₂ f) :=
+by { rw [←linear_map.comp_id B, ←linear_map.compl₁₂, linear_map.to_matrix₂_compl₁₂ b₁ b₂], simp }
+
+@[simp]
+lemma linear_map.to_matrix₂_mul_basis_to_matrix (c₁ : basis n' R M₁) (c₂ : basis m' R M₂)
+  (B : M₁ →ₗ[R] M₂ →ₗ[R] R) : (b₁.to_matrix c₁)ᵀ ⬝ linear_map.to_matrix₂ b₁ b₂ B ⬝ b₂.to_matrix c₂ =
+  linear_map.to_matrix₂ c₁ c₂ B :=
+begin
+  simp_rw ←linear_map.to_matrix_id_eq_basis_to_matrix,
+  rw [←linear_map.to_matrix₂_compl₁₂, linear_map.compl₁₂_id_id],
+end
+
+lemma linear_map.mul_to_matrix₂_mul (B : M₁ →ₗ[R] M₂ →ₗ[R] R)
+  (M : matrix n' n R) (N : matrix m m' R) :
+  M ⬝ linear_map.to_matrix₂ b₁ b₂ B ⬝ N =
+    linear_map.to_matrix₂ b₁' b₂' (B.compl₁₂ (to_lin b₁' b₁ Mᵀ) (to_lin b₂' b₂ N)) :=
+by simp_rw [linear_map.to_matrix₂_compl₁₂ b₁ b₂, to_matrix_to_lin, transpose_transpose]
+
+lemma linear_map.mul_to_matrix₂ (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (M : matrix n' n R) :
+  M ⬝ linear_map.to_matrix₂ b₁ b₂ B =
+    linear_map.to_matrix₂ b₁' b₂ (B.comp (to_lin b₁' b₁ Mᵀ)) :=
+by rw [linear_map.to_matrix₂_comp b₁, to_matrix_to_lin, transpose_transpose]
+
+lemma linear_map.to_matrix₂_mul (B : M₁ →ₗ[R] M₂ →ₗ[R] R) (M : matrix m m' R) :
+  linear_map.to_matrix₂ b₁ b₂ B ⬝ M =
+    linear_map.to_matrix₂ b₁ b₂' (B.compl₂ (to_lin b₂' b₂ M)) :=
+by rw [linear_map.to_matrix₂_compl₂ b₁, to_matrix_to_lin]
+
+lemma matrix.to_linear_map₂_compl₁₂ (M : matrix n m R) (P : matrix n n' R) (Q : matrix m m' R) :
+  (matrix.to_linear_map₂ b₁ b₂ M).compl₁₂ (to_lin b₁' b₁ P) (to_lin b₂' b₂ Q) =
+  matrix.to_linear_map₂ b₁' b₂' (Pᵀ ⬝ M ⬝ Q) :=
+(linear_map.to_matrix₂ b₁' b₂').injective
+  (by simp only [linear_map.to_matrix₂_compl₁₂ b₁ b₂, linear_map.to_matrix₂_to_linear_map₂,
+    to_matrix_to_lin])
+
+end to_matrix
+
+/-! ### Adjoint pairs-/
+
+section matrix_adjoints
+open_locale matrix
+
+variables [comm_ring R]
+variables [add_comm_monoid M₁] [module R M₁] [add_comm_monoid M₂] [module R M₂]
+variables [fintype n] [fintype n']
+
+variables (b₁ : basis n R M₁) (b₂ : basis n' R M₂)
+variables (J J₂ : matrix n n R) (J' : matrix n' n' R)
+variables (A : matrix n' n R) (A' : matrix n n' R)
+variables (A₁ : matrix n n R)
+
+/-- The condition for the matrices `A`, `A'` to be an adjoint pair with respect to the square
+matrices `J`, `J₃`. -/
+def matrix.is_adjoint_pair := Aᵀ ⬝ J' = J ⬝ A'
+
+/-- The condition for a square matrix `A` to be self-adjoint with respect to the square matrix
+`J`. -/
+def matrix.is_self_adjoint := matrix.is_adjoint_pair J J A₁ A₁
+
+/-- The condition for a square matrix `A` to be skew-adjoint with respect to the square matrix
+`J`. -/
+def matrix.is_skew_adjoint := matrix.is_adjoint_pair J J A₁ (-A₁)
+
+variables [decidable_eq n] [decidable_eq n']
+
+@[simp] lemma is_adjoint_pair_to_linear_map₂' :
+  is_adjoint_pair (matrix.to_linear_map₂' J) (matrix.to_linear_map₂' J')
+      (matrix.to_lin' A) (matrix.to_lin' A') ↔
+    matrix.is_adjoint_pair J J' A A' :=
+begin
+  rw is_adjoint_pair_iff_comp_eq_compl₂,
+  have h : ∀ (B B' : (n → R) →ₗ[R] (n' → R) →ₗ[R] R), B = B' ↔
+    (linear_map.to_matrix₂' B) = (linear_map.to_matrix₂' B') :=
+  begin
+    intros B B',
+    split; intros h,
+    { rw h },
+    { exact linear_map.to_matrix₂'.injective h },
+  end,
+  simp_rw [h, linear_map.to_matrix₂'_comp, linear_map.to_matrix₂'_compl₂,
+    linear_map.to_matrix'_to_lin', linear_map.to_matrix'_to_linear_map₂'],
+  refl,
+end
+
+@[simp] lemma is_adjoint_pair_to_linear_map₂ :
+  is_adjoint_pair (matrix.to_linear_map₂ b₁ b₁ J) (matrix.to_linear_map₂ b₂ b₂ J')
+      (matrix.to_lin b₁ b₂ A) (matrix.to_lin b₂ b₁ A') ↔
+    matrix.is_adjoint_pair J J' A A' :=
+begin
+  rw is_adjoint_pair_iff_comp_eq_compl₂,
+  have h : ∀ (B B' : M₁ →ₗ[R] M₂ →ₗ[R] R), B = B' ↔
+    (linear_map.to_matrix₂ b₁ b₂ B) = (linear_map.to_matrix₂ b₁ b₂ B') :=
+  begin
+    intros B B',
+    split; intros h,
+    { rw h },
+    { exact (linear_map.to_matrix₂ b₁ b₂).injective h },
+  end,
+  simp_rw [h, linear_map.to_matrix₂_comp b₂ b₂, linear_map.to_matrix₂_compl₂ b₁ b₁,
+    linear_map.to_matrix_to_lin, linear_map.to_matrix₂_to_linear_map₂],
+  refl,
+end
+
+lemma matrix.is_adjoint_pair_equiv (P : matrix n n R) (h : is_unit P) :
+  (Pᵀ ⬝ J ⬝ P).is_adjoint_pair (Pᵀ ⬝ J ⬝ P) A₁ A₁ ↔
+    J.is_adjoint_pair J (P ⬝ A₁ ⬝ P⁻¹) (P ⬝ A₁ ⬝ P⁻¹) :=
+have h' : is_unit P.det := P.is_unit_iff_is_unit_det.mp h,
+begin
+  let u := P.nonsing_inv_unit h',
+  let v := Pᵀ.nonsing_inv_unit (P.is_unit_det_transpose h'),
+  let x := A₁ᵀ * Pᵀ * J,
+  let y := J * P * A₁,
+  suffices : x * ↑u = ↑v * y ↔ ↑v⁻¹ * x = y * ↑u⁻¹,
+  { dunfold matrix.is_adjoint_pair,
+    repeat { rw matrix.transpose_mul, },
+    simp only [←matrix.mul_eq_mul, ←mul_assoc, P.transpose_nonsing_inv],
+    conv_lhs { to_rhs, rw [mul_assoc, mul_assoc], congr, skip, rw ←mul_assoc, },
+    conv_rhs { rw [mul_assoc, mul_assoc], conv { to_lhs, congr, skip, rw ←mul_assoc }, },
+    exact this, },
+  rw units.eq_mul_inv_iff_mul_eq, conv_rhs { rw mul_assoc, }, rw v.inv_mul_eq_iff_eq_mul,
+end
+
+/-- The submodule of pair-self-adjoint matrices with respect to bilinear forms corresponding to
+given matrices `J`, `J₂`. -/
+def pair_self_adjoint_matrices_submodule : submodule R (matrix n n R) :=
+(is_pair_self_adjoint_submodule (matrix.to_linear_map₂' J) (matrix.to_linear_map₂' J₂)).map
+  ((linear_map.to_matrix' : ((n → R) →ₗ[R] (n → R)) ≃ₗ[R] matrix n n R) :
+  ((n → R) →ₗ[R] (n → R)) →ₗ[R] matrix n n R)
+
+@[simp] lemma mem_pair_self_adjoint_matrices_submodule :
+  A₁ ∈ (pair_self_adjoint_matrices_submodule J J₂) ↔ matrix.is_adjoint_pair J J₂ A₁ A₁ :=
+begin
+  simp only [pair_self_adjoint_matrices_submodule, linear_equiv.coe_coe,
+    linear_map.to_matrix'_apply, submodule.mem_map, mem_is_pair_self_adjoint_submodule],
+  split,
+  { rintros ⟨f, hf, hA⟩,
+    have hf' : f = A₁.to_lin' := by rw [←hA, matrix.to_lin'_to_matrix'], rw hf' at hf,
+    rw ← is_adjoint_pair_to_linear_map₂',
+    exact hf, },
+  { intros h, refine ⟨A₁.to_lin', _, linear_map.to_matrix'_to_lin' _⟩,
+    exact (is_adjoint_pair_to_linear_map₂' _ _ _ _).mpr h, },
+end
+
+/-- The submodule of self-adjoint matrices with respect to the bilinear form corresponding to
+the matrix `J`. -/
+def self_adjoint_matrices_submodule : submodule R (matrix n n R) :=
+  pair_self_adjoint_matrices_submodule J J
+
+@[simp] lemma mem_self_adjoint_matrices_submodule :
+  A₁ ∈ self_adjoint_matrices_submodule J ↔ J.is_self_adjoint A₁ :=
+by { erw mem_pair_self_adjoint_matrices_submodule, refl, }
+
+/-- The submodule of skew-adjoint matrices with respect to the bilinear form corresponding to
+the matrix `J`. -/
+def skew_adjoint_matrices_submodule : submodule R (matrix n n R) :=
+  pair_self_adjoint_matrices_submodule (-J) J
+
+@[simp] lemma mem_skew_adjoint_matrices_submodule :
+  A₁ ∈ skew_adjoint_matrices_submodule J ↔ J.is_skew_adjoint A₁ :=
+begin
+  erw mem_pair_self_adjoint_matrices_submodule,
+  simp [matrix.is_skew_adjoint, matrix.is_adjoint_pair],
+end
+
+end matrix_adjoints
+
+namespace linear_map
+
+/-! ### Nondegenerate bilinear forms-/
+
+section det
+
+open matrix
+
+variables [comm_ring R₁] [add_comm_monoid M₁] [module R₁ M₁]
+variables [decidable_eq ι] [fintype ι]
+
+lemma _root_.matrix.separating_left_to_linear_map₂'_iff_separating_left_to_linear_map₂
+  {M : matrix ι ι R₁} (b : basis ι R₁ M₁) : M.to_linear_map₂'.separating_left ↔
+  (matrix.to_linear_map₂ b b M).separating_left :=
+(separating_left_congr_iff b.equiv_fun.symm b.equiv_fun.symm).symm
+
+variables (B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁)
+
+-- Lemmas transferring nondegeneracy between a matrix and its associated bilinear form
+
+theorem _root_.matrix.nondegenerate.to_linear_map₂' {M : matrix ι ι R₁} (h : M.nondegenerate) :
+  M.to_linear_map₂'.separating_left :=
+λ x hx, h.eq_zero_of_ortho $ λ y, by simpa only [to_linear_map₂'_apply'] using hx y
+
+@[simp] lemma _root_.matrix.separating_left_to_linear_map₂'_iff {M : matrix ι ι R₁} :
+  M.to_linear_map₂'.separating_left ↔ M.nondegenerate :=
+⟨λ h v hv, h v $ λ w, (M.to_linear_map₂'_apply' _ _).trans $ hv w,
+  matrix.nondegenerate.to_linear_map₂'⟩
+
+theorem _root_.matrix.nondegenerate.to_linear_map₂ {M : matrix ι ι R₁} (h : M.nondegenerate)
+  (b : basis ι R₁ M₁) : (to_linear_map₂ b b M).separating_left :=
+(matrix.separating_left_to_linear_map₂'_iff_separating_left_to_linear_map₂ b).mp h.to_linear_map₂'
+
+@[simp] lemma _root_.matrix.separating_left_to_linear_map₂_iff {M : matrix ι ι R₁}
+  (b : basis ι R₁ M₁) : (to_linear_map₂ b b M).separating_left ↔ M.nondegenerate :=
+by rw [←matrix.separating_left_to_linear_map₂'_iff_separating_left_to_linear_map₂,
+       matrix.separating_left_to_linear_map₂'_iff]
+
+-- Lemmas transferring nondegeneracy between a bilinear form and its associated matrix
+
+@[simp] theorem nondegenerate_to_matrix₂'_iff {B : (ι → R₁) →ₗ[R₁] (ι → R₁) →ₗ[R₁] R₁} :
+  B.to_matrix₂'.nondegenerate ↔ B.separating_left :=
+matrix.separating_left_to_linear_map₂'_iff.symm.trans $
+  (matrix.to_linear_map₂'_to_matrix' B).symm ▸ iff.rfl
+
+theorem separating_left.to_matrix₂' {B : (ι → R₁) →ₗ[R₁] (ι → R₁) →ₗ[R₁] R₁}
+  (h : B.separating_left) : B.to_matrix₂'.nondegenerate :=
+nondegenerate_to_matrix₂'_iff.mpr h
+
+@[simp] theorem nondegenerate_to_matrix_iff {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁}
+  (b : basis ι R₁ M₁) : (to_matrix₂ b b B).nondegenerate ↔ B.separating_left :=
+(matrix.separating_left_to_linear_map₂_iff b).symm.trans $
+  (matrix.to_linear_map₂_to_matrix₂ b b B).symm ▸ iff.rfl
+
+theorem separating_left.to_matrix₂ {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁} (h : B.separating_left)
+  (b : basis ι R₁ M₁) : (to_matrix₂ b b B).nondegenerate :=
+(nondegenerate_to_matrix_iff b).mpr h
+
+-- Some shorthands for combining the above with `matrix.nondegenerate_of_det_ne_zero`
+
+variables [is_domain R₁]
+
+lemma separating_left_to_linear_map₂'_iff_det_ne_zero {M : matrix ι ι R₁} :
+  M.to_linear_map₂'.separating_left ↔ M.det ≠ 0 :=
+by rw [matrix.separating_left_to_linear_map₂'_iff, matrix.nondegenerate_iff_det_ne_zero]
+
+theorem separating_left_to_linear_map₂'_of_det_ne_zero' (M : matrix ι ι R₁) (h : M.det ≠ 0) :
+  M.to_linear_map₂'.separating_left :=
+separating_left_to_linear_map₂'_iff_det_ne_zero.mpr h
+
+lemma separating_left_iff_det_ne_zero {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁}
+  (b : basis ι R₁ M₁) : B.separating_left ↔ (to_matrix₂ b b B).det ≠ 0 :=
+by rw [←matrix.nondegenerate_iff_det_ne_zero, nondegenerate_to_matrix_iff]
+
+theorem separating_left_of_det_ne_zero {B : M₁ →ₗ[R₁] M₁ →ₗ[R₁] R₁} (b : basis ι R₁ M₁)
+  (h : (to_matrix₂ b b B).det ≠ 0) :
+  B.separating_left :=
+(separating_left_iff_det_ne_zero b).mpr h
+
+end det
+
+end linear_map
diff --git a/src/linear_algebra/matrix/special_linear_group.lean b/src/linear_algebra/matrix/special_linear_group.lean
new file mode 100644
index 0000000000000..1fcb0587bf398
--- /dev/null
+++ b/src/linear_algebra/matrix/special_linear_group.lean
@@ -0,0 +1,321 @@
+/-
+Copyright (c) 2020 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+import linear_algebra.general_linear_group
+import linear_algebra.matrix.adjugate
+import linear_algebra.matrix.to_lin
+
+/-!
+# The Special Linear group $SL(n, R)$
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the elements of the Special Linear group `special_linear_group n R`, consisting
+of all square `R`-matrices with determinant `1` on the fintype `n` by `n`.  In addition, we define
+the group structure on `special_linear_group n R` and the embedding into the general linear group
+`general_linear_group R (n → R)`.
+
+## Main definitions
+
+ * `matrix.special_linear_group` is the type of matrices with determinant 1
+ * `matrix.special_linear_group.group` gives the group structure (under multiplication)
+ * `matrix.special_linear_group.to_GL` is the embedding `SLₙ(R) → GLₙ(R)`
+
+## Notation
+
+For `m : ℕ`, we introduce the notation `SL(m,R)` for the special linear group on the fintype
+`n = fin m`, in the locale `matrix_groups`.
+
+## Implementation notes
+The inverse operation in the `special_linear_group` is defined to be the adjugate
+matrix, so that `special_linear_group n R` has a group structure for all `comm_ring R`.
+
+We define the elements of `special_linear_group` to be matrices, since we need to
+compute their determinant. This is in contrast with `general_linear_group R M`,
+which consists of invertible `R`-linear maps on `M`.
+
+We provide `matrix.special_linear_group.has_coe_to_fun` for convenience, but do not state any
+lemmas about it, and use `matrix.special_linear_group.coe_fn_eq_coe` to eliminate it `⇑` in favor
+of a regular `↑` coercion.
+
+## References
+
+ * https://en.wikipedia.org/wiki/Special_linear_group
+
+## Tags
+
+matrix group, group, matrix inverse
+-/
+
+namespace matrix
+universes u v
+open_locale matrix
+open linear_map
+
+
+section
+
+variables (n : Type u) [decidable_eq n] [fintype n] (R : Type v) [comm_ring R]
+
+/-- `special_linear_group n R` is the group of `n` by `n` `R`-matrices with determinant equal to 1.
+-/
+def special_linear_group := { A : matrix n n R // A.det = 1 }
+
+end
+
+localized "notation (name := special_linear_group.fin)
+  `SL(`n`, `R`)`:= matrix.special_linear_group (fin n) R" in matrix_groups
+
+namespace special_linear_group
+
+variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
+
+instance has_coe_to_matrix : has_coe (special_linear_group n R) (matrix n n R) :=
+⟨λ A, A.val⟩
+
+/- In this file, Lean often has a hard time working out the values of `n` and `R` for an expression
+like `det ↑A`. Rather than writing `(A : matrix n n R)` everywhere in this file which is annoyingly
+verbose, or `A.val` which is not the simp-normal form for subtypes, we create a local notation
+`↑ₘA`. This notation references the local `n` and `R` variables, so is not valid as a global
+notation. -/
+local prefix `↑ₘ`:1024 := @coe _ (matrix n n R) _
+
+lemma ext_iff (A B : special_linear_group n R) : A = B ↔ (∀ i j, ↑ₘA i j = ↑ₘB i j) :=
+subtype.ext_iff.trans matrix.ext_iff.symm
+
+@[ext] lemma ext (A B : special_linear_group n R) : (∀ i j, ↑ₘA i j = ↑ₘB i j) → A = B :=
+(special_linear_group.ext_iff A B).mpr
+
+instance has_inv : has_inv (special_linear_group n R) :=
+⟨λ A, ⟨adjugate A, by rw [det_adjugate, A.prop, one_pow]⟩⟩
+
+instance has_mul : has_mul (special_linear_group n R) :=
+⟨λ A B, ⟨A.1 ⬝ B.1, by erw [det_mul, A.2, B.2, one_mul]⟩⟩
+
+instance has_one : has_one (special_linear_group n R) :=
+⟨⟨1, det_one⟩⟩
+
+instance : has_pow (special_linear_group n R) ℕ :=
+{ pow := λ x n, ⟨x ^ n, (det_pow _ _).trans $ x.prop.symm ▸ one_pow _⟩}
+
+instance : inhabited (special_linear_group n R) := ⟨1⟩
+
+section coe_lemmas
+
+variables (A B : special_linear_group n R)
+
+@[simp] lemma coe_mk (A : matrix n n R) (h : det A = 1) :
+  ↑(⟨A, h⟩ : special_linear_group n R) = A :=
+rfl
+
+@[simp] lemma coe_inv : ↑ₘ(A⁻¹) = adjugate A := rfl
+
+@[simp] lemma coe_mul : ↑ₘ(A * B) = ↑ₘA ⬝ ↑ₘB := rfl
+
+@[simp] lemma coe_one : ↑ₘ(1 : special_linear_group n R) = (1 : matrix n n R) := rfl
+
+@[simp] lemma det_coe : det ↑ₘA = 1 := A.2
+
+@[simp] lemma coe_pow (m : ℕ) : ↑ₘ(A ^ m) = ↑ₘA ^ m := rfl
+
+lemma det_ne_zero [nontrivial R] (g : special_linear_group n R) :
+  det ↑ₘg ≠ 0 :=
+by { rw g.det_coe, norm_num }
+
+lemma row_ne_zero [nontrivial R] (g : special_linear_group n R) (i : n):
+  ↑ₘg i ≠ 0 :=
+λ h, g.det_ne_zero $ det_eq_zero_of_row_eq_zero i $ by simp [h]
+
+end coe_lemmas
+
+instance : monoid (special_linear_group n R) :=
+function.injective.monoid coe subtype.coe_injective coe_one coe_mul coe_pow
+
+instance : group (special_linear_group n R) :=
+{ mul_left_inv := λ A, by { ext1, simp [adjugate_mul] },
+  ..special_linear_group.monoid,
+  ..special_linear_group.has_inv }
+
+/-- A version of `matrix.to_lin' A` that produces linear equivalences. -/
+def to_lin' : special_linear_group n R →* (n → R) ≃ₗ[R] (n → R) :=
+{ to_fun := λ A, linear_equiv.of_linear (matrix.to_lin' ↑ₘA) (matrix.to_lin' ↑ₘ(A⁻¹))
+    (by rw [←to_lin'_mul, ←coe_mul, mul_right_inv, coe_one, to_lin'_one])
+    (by rw [←to_lin'_mul, ←coe_mul, mul_left_inv, coe_one, to_lin'_one]),
+  map_one' := linear_equiv.to_linear_map_injective matrix.to_lin'_one,
+  map_mul' := λ A B, linear_equiv.to_linear_map_injective $ matrix.to_lin'_mul A B }
+
+lemma to_lin'_apply (A : special_linear_group n R) (v : n → R) :
+  special_linear_group.to_lin' A v = matrix.to_lin' ↑ₘA v := rfl
+
+lemma to_lin'_to_linear_map (A : special_linear_group n R) :
+  ↑(special_linear_group.to_lin' A) = matrix.to_lin' ↑ₘA := rfl
+
+lemma to_lin'_symm_apply (A : special_linear_group n R) (v : n → R) :
+  A.to_lin'.symm v = matrix.to_lin' ↑ₘ(A⁻¹) v := rfl
+
+lemma to_lin'_symm_to_linear_map (A : special_linear_group n R) :
+  ↑(A.to_lin'.symm) = matrix.to_lin' ↑ₘ(A⁻¹) := rfl
+
+lemma to_lin'_injective :
+  function.injective ⇑(to_lin' : special_linear_group n R →* (n → R) ≃ₗ[R] (n → R)) :=
+λ A B h, subtype.coe_injective $ matrix.to_lin'.injective $
+  linear_equiv.to_linear_map_injective.eq_iff.mpr h
+
+/-- `to_GL` is the map from the special linear group to the general linear group -/
+def to_GL : special_linear_group n R →* general_linear_group R (n → R) :=
+(general_linear_group.general_linear_equiv _ _).symm.to_monoid_hom.comp to_lin'
+
+lemma coe_to_GL (A : special_linear_group n R) : ↑A.to_GL = A.to_lin'.to_linear_map := rfl
+
+variables {S : Type*} [comm_ring S]
+
+/-- A ring homomorphism from `R` to `S` induces a group homomorphism from
+`special_linear_group n R` to `special_linear_group n S`. -/
+@[simps] def map (f : R →+* S) : special_linear_group n R →* special_linear_group n S :=
+{ to_fun := λ g, ⟨f.map_matrix ↑g, by { rw ← f.map_det, simp [g.2] }⟩,
+  map_one' := subtype.ext $ f.map_matrix.map_one,
+  map_mul' := λ x y, subtype.ext $ f.map_matrix.map_mul x y }
+
+section cast
+
+/-- Coercion of SL `n` `ℤ` to SL `n` `R` for a commutative ring `R`. -/
+instance : has_coe (special_linear_group n ℤ) (special_linear_group n R) :=
+⟨λ x, map (int.cast_ring_hom R) x⟩
+
+@[simp] lemma coe_matrix_coe (g : special_linear_group n ℤ) :
+  ↑(g : special_linear_group n R)
+  = (↑g : matrix n n ℤ).map (int.cast_ring_hom R) :=
+map_apply_coe (int.cast_ring_hom R) g
+
+end cast
+
+section has_neg
+
+variables [fact (even (fintype.card n))]
+
+/-- Formal operation of negation on special linear group on even cardinality `n` given by negating
+each element. -/
+instance : has_neg (special_linear_group n R) :=
+⟨λ g,
+  ⟨- g, by simpa [(fact.out $ even $ fintype.card n).neg_one_pow, g.det_coe] using
+  det_smul ↑ₘg (-1)⟩⟩
+
+@[simp] lemma coe_neg (g : special_linear_group n R) : ↑(- g) = - (g : matrix n n R) := rfl
+
+instance : has_distrib_neg (special_linear_group n R) :=
+function.injective.has_distrib_neg _ subtype.coe_injective coe_neg coe_mul
+
+@[simp] lemma coe_int_neg (g : special_linear_group n ℤ) :
+  ↑(-g) = (-↑g : special_linear_group n R) :=
+subtype.ext $ (@ring_hom.map_matrix n _ _ _ _ _ _ (int.cast_ring_hom R)).map_neg ↑g
+
+end has_neg
+
+section special_cases
+
+lemma SL2_inv_expl_det (A : SL(2,R)) : det ![![A.1 1 1, -A.1 0 1], ![-A.1 1 0 , A.1 0 0]] = 1 :=
+begin
+  rw [matrix.det_fin_two, mul_comm],
+  simp only [subtype.val_eq_coe, cons_val_zero, cons_val_one, head_cons, mul_neg, neg_mul, neg_neg],
+  have := A.2,
+  rw matrix.det_fin_two at this,
+  convert this,
+end
+
+lemma SL2_inv_expl (A : SL(2, R)) : A⁻¹ = ⟨![![A.1 1 1, -A.1 0 1], ![-A.1 1 0 , A.1 0 0]],
+    SL2_inv_expl_det A⟩ :=
+begin
+  ext,
+  have := matrix.adjugate_fin_two A.1,
+  simp only [subtype.val_eq_coe] at this,
+  rw [coe_inv, this],
+  refl,
+end
+
+lemma fin_two_induction (P : SL(2, R) → Prop)
+  (h : ∀ (a b c d : R) (hdet : a * d - b * c = 1), P ⟨!![a, b; c, d], by rwa [det_fin_two_of]⟩)
+  (g : SL(2, R)) : P g :=
+begin
+  obtain ⟨m, hm⟩ := g,
+  convert h (m 0 0) (m 0 1) (m 1 0) (m 1 1) (by rwa det_fin_two at hm),
+  ext i j, fin_cases i; fin_cases j; refl,
+end
+
+lemma fin_two_exists_eq_mk_of_apply_zero_one_eq_zero {R : Type*} [field R]
+  (g : SL(2, R)) (hg : (g : matrix (fin 2) (fin 2) R) 1 0 = 0) :
+  ∃ (a b : R) (h : a ≠ 0),
+    g = (⟨!![a, b; 0, a⁻¹], by simp [h]⟩ : SL(2, R)) :=
+begin
+  induction g using matrix.special_linear_group.fin_two_induction with a b c d h_det,
+  replace hg : c = 0 := by simpa using hg,
+  have had : a * d = 1 := by rwa [hg, mul_zero, sub_zero] at h_det,
+  refine ⟨a, b, left_ne_zero_of_mul_eq_one had, _⟩,
+  simp_rw [eq_inv_of_mul_eq_one_right had, hg],
+end
+
+end special_cases
+
+-- this section should be last to ensure we do not use it in lemmas
+section coe_fn_instance
+
+/-- This instance is here for convenience, but is not the simp-normal form. -/
+instance : has_coe_to_fun (special_linear_group n R) (λ _, n → n → R) :=
+{ coe := λ A, A.val }
+
+@[simp]
+lemma coe_fn_eq_coe (s : special_linear_group n R) : ⇑s = ↑ₘs := rfl
+
+end coe_fn_instance
+
+end special_linear_group
+
+end matrix
+
+namespace modular_group
+
+open_locale matrix_groups
+open matrix matrix.special_linear_group
+
+local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) ℤ) _
+
+/-- The matrix `S = [[0, -1], [1, 0]]` as an element of `SL(2, ℤ)`.
+
+This element acts naturally on the Euclidean plane as a rotation about the origin by `π / 2`.
+
+This element also acts naturally on the hyperbolic plane as rotation about `i` by `π`. It
+represents the Mobiüs transformation `z ↦ -1/z` and is an involutive elliptic isometry. -/
+def S : SL(2, ℤ) := ⟨!![0, -1; 1, 0], by norm_num [matrix.det_fin_two_of]⟩
+
+/-- The matrix `T = [[1, 1], [0, 1]]` as an element of `SL(2, ℤ)` -/
+def T : SL(2, ℤ) := ⟨!![1, 1; 0, 1], by norm_num [matrix.det_fin_two_of]⟩
+
+lemma coe_S : ↑ₘS = !![0, -1; 1, 0] := rfl
+
+lemma coe_T : ↑ₘT = !![1, 1; 0, 1] := rfl
+
+lemma coe_T_inv : ↑ₘ(T⁻¹) = !![1, -1; 0, 1] := by simp [coe_inv, coe_T, adjugate_fin_two]
+
+lemma coe_T_zpow (n : ℤ) : ↑ₘ(T ^ n) = !![1, n; 0, 1] :=
+begin
+  induction n using int.induction_on with n h n h,
+  { rw [zpow_zero, coe_one, matrix.one_fin_two] },
+  { simp_rw [zpow_add, zpow_one, coe_mul, h, coe_T, matrix.mul_fin_two],
+    congrm !![_, _; _, _],
+    rw [mul_one, mul_one, add_comm] },
+  { simp_rw [zpow_sub, zpow_one, coe_mul, h, coe_T_inv, matrix.mul_fin_two],
+    congrm !![_, _; _, _]; ring },
+end
+
+@[simp] lemma T_pow_mul_apply_one (n : ℤ) (g : SL(2, ℤ)) : ↑ₘ(T ^ n * g) 1 = ↑ₘg 1 :=
+by simp [coe_T_zpow, matrix.mul, matrix.dot_product, fin.sum_univ_succ]
+
+@[simp] lemma T_mul_apply_one (g : SL(2, ℤ)) : ↑ₘ(T * g) 1 = ↑ₘg 1 :=
+by simpa using T_pow_mul_apply_one 1 g
+
+@[simp] lemma T_inv_mul_apply_one (g : SL(2, ℤ)) : ↑ₘ(T⁻¹ * g) 1 = ↑ₘg 1 :=
+by simpa using T_pow_mul_apply_one (-1) g
+
+end modular_group
diff --git a/src/linear_algebra/matrix/spectrum.lean b/src/linear_algebra/matrix/spectrum.lean
new file mode 100644
index 0000000000000..e7f85b320877c
--- /dev/null
+++ b/src/linear_algebra/matrix/spectrum.lean
@@ -0,0 +1,132 @@
+/-
+Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alexander Bentkamp
+-/
+import analysis.inner_product_space.spectrum
+import linear_algebra.matrix.hermitian
+
+/-! # Spectral theory of hermitian matrices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves the spectral theorem for matrices. The proof of the spectral theorem is based on
+the spectral theorem for linear maps (`diagonalization_basis_apply_self_apply`).
+
+## Tags
+
+spectral theorem, diagonalization theorem
+
+-/
+
+namespace matrix
+
+variables {𝕜 : Type*} [is_R_or_C 𝕜] [decidable_eq 𝕜] {n : Type*} [fintype n] [decidable_eq n]
+variables {A : matrix n n 𝕜}
+
+open_locale matrix
+open_locale big_operators
+
+namespace is_hermitian
+
+variables (hA : A.is_hermitian)
+
+/-- The eigenvalues of a hermitian matrix, indexed by `fin (fintype.card n)` where `n` is the index
+type of the matrix. -/
+noncomputable def eigenvalues₀ : fin (fintype.card n) → ℝ :=
+(is_hermitian_iff_is_symmetric.1 hA).eigenvalues finrank_euclidean_space
+
+/-- The eigenvalues of a hermitian matrix, reusing the index `n` of the matrix entries. -/
+noncomputable def eigenvalues : n → ℝ :=
+λ i, hA.eigenvalues₀ $ (fintype.equiv_of_card_eq (fintype.card_fin _)).symm i
+
+/-- A choice of an orthonormal basis of eigenvectors of a hermitian matrix. -/
+noncomputable def eigenvector_basis : orthonormal_basis n 𝕜 (euclidean_space 𝕜 n) :=
+((is_hermitian_iff_is_symmetric.1 hA).eigenvector_basis finrank_euclidean_space).reindex
+  (fintype.equiv_of_card_eq (fintype.card_fin _))
+
+/-- A matrix whose columns are an orthonormal basis of eigenvectors of a hermitian matrix. -/
+noncomputable def eigenvector_matrix : matrix n n 𝕜 :=
+(pi_Lp.basis_fun _ 𝕜 n).to_matrix (eigenvector_basis hA).to_basis
+
+/-- The inverse of `eigenvector_matrix` -/
+noncomputable def eigenvector_matrix_inv : matrix n n 𝕜 :=
+(eigenvector_basis hA).to_basis.to_matrix (pi_Lp.basis_fun _ 𝕜 n)
+
+lemma eigenvector_matrix_mul_inv :
+  hA.eigenvector_matrix ⬝ hA.eigenvector_matrix_inv = 1 :=
+by apply basis.to_matrix_mul_to_matrix_flip
+
+noncomputable instance : invertible hA.eigenvector_matrix_inv :=
+invertible_of_left_inverse _ _ hA.eigenvector_matrix_mul_inv
+
+noncomputable instance : invertible hA.eigenvector_matrix :=
+invertible_of_right_inverse _ _ hA.eigenvector_matrix_mul_inv
+
+lemma eigenvector_matrix_apply (i j : n) : hA.eigenvector_matrix i j = hA.eigenvector_basis j i :=
+by simp_rw [eigenvector_matrix, basis.to_matrix_apply, orthonormal_basis.coe_to_basis,
+    pi_Lp.basis_fun_repr]
+
+lemma eigenvector_matrix_inv_apply (i j : n) :
+  hA.eigenvector_matrix_inv i j = star (hA.eigenvector_basis i j) :=
+begin
+  rw [eigenvector_matrix_inv, basis.to_matrix_apply, orthonormal_basis.coe_to_basis_repr_apply,
+    orthonormal_basis.repr_apply_apply, pi_Lp.basis_fun_apply, pi_Lp.equiv_symm_single,
+    euclidean_space.inner_single_right, one_mul, is_R_or_C.star_def],
+end
+
+lemma conj_transpose_eigenvector_matrix_inv : hA.eigenvector_matrix_invᴴ = hA.eigenvector_matrix :=
+by { ext i j,
+  rw [conj_transpose_apply, eigenvector_matrix_inv_apply, eigenvector_matrix_apply, star_star] }
+
+lemma conj_transpose_eigenvector_matrix : hA.eigenvector_matrixᴴ = hA.eigenvector_matrix_inv :=
+by rw [← conj_transpose_eigenvector_matrix_inv, conj_transpose_conj_transpose]
+
+/-- *Diagonalization theorem*, *spectral theorem* for matrices; A hermitian matrix can be
+diagonalized by a change of basis.
+
+For the spectral theorem on linear maps, see `diagonalization_basis_apply_self_apply`. -/
+theorem spectral_theorem :
+  hA.eigenvector_matrix_inv ⬝ A =
+    diagonal (coe ∘ hA.eigenvalues) ⬝ hA.eigenvector_matrix_inv :=
+begin
+  rw [eigenvector_matrix_inv, pi_Lp.basis_to_matrix_basis_fun_mul],
+  ext i j,
+  have := is_hermitian_iff_is_symmetric.1 hA,
+  convert this.diagonalization_basis_apply_self_apply finrank_euclidean_space
+    (euclidean_space.single j 1)
+    ((fintype.equiv_of_card_eq (fintype.card_fin _)).symm i) using 1,
+  { dsimp only [euclidean_space.single, to_euclidean_lin_pi_Lp_equiv_symm, to_lin'_apply,
+      matrix.of_apply, is_hermitian.eigenvector_basis],
+    simp_rw [mul_vec_single, mul_one, orthonormal_basis.coe_to_basis_repr_apply,
+      orthonormal_basis.repr_reindex],
+    refl },
+  { simp only [diagonal_mul, (∘), eigenvalues],
+    rw [eigenvector_basis, basis.to_matrix_apply,
+      orthonormal_basis.coe_to_basis_repr_apply, orthonormal_basis.repr_reindex,
+      eigenvalues₀, pi_Lp.basis_fun_apply, pi_Lp.equiv_symm_single] }
+end
+
+lemma eigenvalues_eq (i : n) :
+  hA.eigenvalues i =
+    is_R_or_C.re ((star (hA.eigenvector_matrixᵀ i) ⬝ᵥ (A.mul_vec (hA.eigenvector_matrixᵀ i)))) :=
+begin
+  have := hA.spectral_theorem,
+  rw [←matrix.mul_inv_eq_iff_eq_mul_of_invertible] at this,
+  have := congr_arg is_R_or_C.re (congr_fun (congr_fun this i) i),
+  rw [diagonal_apply_eq, is_R_or_C.of_real_re, inv_eq_left_inv hA.eigenvector_matrix_mul_inv,
+    ← conj_transpose_eigenvector_matrix, mul_mul_apply] at this,
+  exact this.symm,
+end
+
+/-- The determinant of a hermitian matrix is the product of its eigenvalues. -/
+lemma det_eq_prod_eigenvalues : det A = ∏ i, hA.eigenvalues i :=
+begin
+  apply mul_left_cancel₀ (det_ne_zero_of_left_inverse (eigenvector_matrix_mul_inv hA)),
+  rw [←det_mul, spectral_theorem, det_mul, mul_comm, det_diagonal]
+end
+
+end is_hermitian
+
+end matrix
diff --git a/src/linear_algebra/matrix/symmetric.lean b/src/linear_algebra/matrix/symmetric.lean
index 8533144a3d85d..108fb0f1d3e67 100644
--- a/src/linear_algebra/matrix/symmetric.lean
+++ b/src/linear_algebra/matrix/symmetric.lean
@@ -8,6 +8,9 @@ import data.matrix.block
 /-!
 # Symmetric matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the definition and basic results about symmetric matrices.
 
 ## Main definition
@@ -90,13 +93,13 @@ h.transpose.map _
   (A - B).is_symm :=
 (transpose_sub _ _).trans (hA.symm ▸ hB.symm ▸ rfl)
 
-@[simp] lemma is_symm.smul [has_scalar R α] {A : matrix n n α} (h : A.is_symm) (k : R) :
+@[simp] lemma is_symm.smul [has_smul R α] {A : matrix n n α} (h : A.is_symm) (k : R) :
   (k • A).is_symm :=
 (transpose_smul _ _).trans (congr_arg _ h)
 
-@[simp] lemma is_symm.minor {A : matrix n n α} (h : A.is_symm) (f : m → n) :
-  (A.minor f f).is_symm :=
-(transpose_minor _ _ _).trans (h.symm ▸ rfl)
+@[simp] lemma is_symm.submatrix {A : matrix n n α} (h : A.is_symm) (f : m → n) :
+  (A.submatrix f f).is_symm :=
+(transpose_submatrix _ _ _).trans (h.symm ▸ rfl)
 
 /-- The diagonal matrix `diagonal v` is symmetric. -/
 @[simp] lemma is_symm_diagonal [decidable_eq n] [has_zero α] (v : n → α) :
@@ -121,8 +124,8 @@ end
 lemma is_symm_from_blocks_iff
   {A : matrix m m α} {B : matrix m n α} {C : matrix n m α} {D : matrix n n α} :
   (A.from_blocks B C D).is_symm ↔ A.is_symm ∧ Bᵀ = C ∧ Cᵀ = B ∧ D.is_symm :=
-⟨λ h, ⟨congr_arg to_blocks₁₁ h, congr_arg to_blocks₂₁ h,
-       congr_arg to_blocks₁₂ h, congr_arg to_blocks₂₂ h⟩,
+⟨λ h, ⟨(congr_arg to_blocks₁₁ h : _), (congr_arg to_blocks₂₁ h : _),
+       (congr_arg to_blocks₁₂ h : _), (congr_arg to_blocks₂₂ h : _)⟩,
  λ ⟨hA, hBC, hCB, hD⟩, is_symm.from_blocks hA hBC hD⟩
 
 end matrix
diff --git a/src/linear_algebra/matrix/to_lin.lean b/src/linear_algebra/matrix/to_lin.lean
index bfceaddb01a3a..949323d8d408f 100644
--- a/src/linear_algebra/matrix/to_lin.lean
+++ b/src/linear_algebra/matrix/to_lin.lean
@@ -4,14 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
 import data.matrix.block
-import linear_algebra.matrix.finite_dimensional
+import data.matrix.notation
 import linear_algebra.std_basis
 import ring_theory.algebra_tower
 import algebra.module.algebra
+import algebra.algebra.subalgebra.tower
 
 /-!
 # Linear maps and matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the maps to send matrices to a linear map,
 and to send linear maps between modules with a finite bases
 to matrices. This defines a linear equivalence between linear maps
@@ -33,6 +37,28 @@ types used for indexing.
  * `alg_equiv_matrix`: given a basis indexed by `n`, the `R`-algebra equivalence between
    `R`-endomorphisms of `M` and `matrix n n R`
 
+## Issues
+
+This file was originally written without attention to non-commutative rings,
+and so mostly only works in the commutative setting. This should be fixed.
+
+In particular, `matrix.mul_vec` gives us a linear equivalence
+`matrix m n R ≃ₗ[R] (n → R) →ₗ[Rᵐᵒᵖ] (m → R)`
+while `matrix.vec_mul` gives us a linear equivalence
+`matrix m n R ≃ₗ[Rᵐᵒᵖ] (m → R) →ₗ[R] (n → R)`.
+At present, the first equivalence is developed in detail but only for commutative rings
+(and we omit the distinction between `Rᵐᵒᵖ` and `R`),
+while the second equivalence is developed only in brief, but for not-necessarily-commutative rings.
+
+Naming is slightly inconsistent between the two developments.
+In the original (commutative) development `linear` is abbreviated to `lin`,
+although this is not consistent with the rest of mathlib.
+In the new (non-commutative) development `linear` is not abbreviated, and declarations use `_right`
+to indicate they use the right action of matrices on vectors (via `matrix.vec_mul`).
+When the two developments are made uniform, the names should be made uniform, too,
+by choosing between `linear` and `lin` consistently,
+and (presumably) adding `_left` where necessary.
+
 ## Tags
 
 linear_map, matrix, linear_equiv, diagonal, det, trace
@@ -46,14 +72,102 @@ open_locale matrix
 
 universes u v w
 
-section to_matrix'
-
 instance {n m} [fintype m] [decidable_eq m] [fintype n] [decidable_eq n] (R) [fintype R] :
   fintype (matrix m n R) := by unfold matrix; apply_instance
 
-variables {R : Type*} [comm_ring R]
+section to_matrix_right
+
+variables {R : Type*} [semiring R]
 variables {l m n : Type*}
 
+/-- `matrix.vec_mul M` is a linear map. -/
+@[simps] def matrix.vec_mul_linear [fintype m] (M : matrix m n R) : (m → R) →ₗ[R] (n → R) :=
+{ to_fun := λ x, M.vec_mul x,
+  map_add' := λ v w, funext (λ i, add_dot_product _ _ _),
+  map_smul' := λ c v, funext (λ i, smul_dot_product _ _ _) }
+
+variables [fintype m] [decidable_eq m]
+
+@[simp] lemma matrix.vec_mul_std_basis (M : matrix m n R) (i j) :
+  M.vec_mul (std_basis R (λ _, R) i 1) j = M i j :=
+begin
+  have : (∑ i', (if i = i' then 1 else 0) * M i' j) = M i j,
+  { simp_rw [boole_mul, finset.sum_ite_eq, finset.mem_univ, if_true] },
+  convert this,
+  ext,
+  split_ifs with h; simp only [std_basis_apply],
+  { rw [h, function.update_same] },
+  { rw [function.update_noteq (ne.symm h), pi.zero_apply] }
+end
+
+/--
+Linear maps `(m → R) →ₗ[R] (n → R)` are linearly equivalent over `Rᵐᵒᵖ` to `matrix m n R`,
+by having matrices act by right multiplication.
+ -/
+def linear_map.to_matrix_right' : ((m → R) →ₗ[R] (n → R)) ≃ₗ[Rᵐᵒᵖ] matrix m n R :=
+{ to_fun := λ f i j, f (std_basis R (λ _, R) i 1) j,
+  inv_fun := matrix.vec_mul_linear,
+  right_inv := λ M, by
+  { ext i j, simp only [matrix.vec_mul_std_basis, matrix.vec_mul_linear_apply] },
+  left_inv := λ f, begin
+    apply (pi.basis_fun R m).ext,
+    intro j, ext i,
+    simp only [pi.basis_fun_apply, matrix.vec_mul_std_basis, matrix.vec_mul_linear_apply]
+  end,
+  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply] },
+  map_smul' := λ c f, by { ext i j, simp only [pi.smul_apply, linear_map.smul_apply,
+                                               ring_hom.id_apply] } }
+
+/-- A `matrix m n R` is linearly equivalent over `Rᵐᵒᵖ` to a linear map `(m → R) →ₗ[R] (n → R)`,
+by having matrices act by right multiplication. -/
+abbreviation matrix.to_linear_map_right' : matrix m n R ≃ₗ[Rᵐᵒᵖ] ((m → R) →ₗ[R] (n → R)) :=
+linear_map.to_matrix_right'.symm
+
+@[simp] lemma matrix.to_linear_map_right'_apply (M : matrix m n R) (v : m → R) :
+  matrix.to_linear_map_right' M v = M.vec_mul v := rfl
+
+@[simp] lemma matrix.to_linear_map_right'_mul [fintype l] [decidable_eq l] (M : matrix l m R)
+  (N : matrix m n R) : matrix.to_linear_map_right' (M ⬝ N) =
+  (matrix.to_linear_map_right' N).comp (matrix.to_linear_map_right' M) :=
+linear_map.ext $ λ x, (vec_mul_vec_mul _ M N).symm
+
+lemma matrix.to_linear_map_right'_mul_apply [fintype l] [decidable_eq l] (M : matrix l m R)
+  (N : matrix m n R) (x) : matrix.to_linear_map_right' (M ⬝ N) x =
+    (matrix.to_linear_map_right' N (matrix.to_linear_map_right' M x)) :=
+(vec_mul_vec_mul _ M N).symm
+
+@[simp] lemma matrix.to_linear_map_right'_one :
+  matrix.to_linear_map_right' (1 : matrix m m R) = id :=
+by { ext, simp [linear_map.one_apply, std_basis_apply] }
+
+/-- If `M` and `M'` are each other's inverse matrices, they provide an equivalence between `n → A`
+and `m → A` corresponding to `M.vec_mul` and `M'.vec_mul`. -/
+@[simps]
+def matrix.to_linear_equiv_right'_of_inv [fintype n] [decidable_eq n]
+  {M : matrix m n R} {M' : matrix n m R}
+  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
+  (n → R) ≃ₗ[R] (m → R) :=
+{ to_fun := M'.to_linear_map_right',
+  inv_fun := M.to_linear_map_right',
+  left_inv := λ x, by
+    rw [← matrix.to_linear_map_right'_mul_apply, hM'M, matrix.to_linear_map_right'_one, id_apply],
+  right_inv := λ x, by
+    rw [← matrix.to_linear_map_right'_mul_apply, hMM', matrix.to_linear_map_right'_one, id_apply],
+  ..linear_map.to_matrix_right'.symm M' }
+
+end to_matrix_right
+
+/-!
+From this point on, we only work with commutative rings,
+and fail to distinguish between `Rᵐᵒᵖ` and `R`.
+This should eventually be remedied.
+-/
+
+section to_matrix'
+
+variables {R : Type*} [comm_semiring R]
+variables {k l m n : Type*}
+
 /-- `matrix.mul_vec M` is a linear map. -/
 def matrix.mul_vec_lin [fintype n] (M : matrix m n R) : (n → R) →ₗ[R] (m → R) :=
 { to_fun := M.mul_vec,
@@ -61,40 +175,84 @@ def matrix.mul_vec_lin [fintype n] (M : matrix m n R) : (n → R) →ₗ[R] (m 
   map_smul' := λ c v, funext (λ i, dot_product_smul _ _ _) }
 
 @[simp] lemma matrix.mul_vec_lin_apply [fintype n] (M : matrix m n R) (v : n → R) :
-  matrix.mul_vec_lin M v = M.mul_vec v := rfl
+  M.mul_vec_lin v = M.mul_vec v := rfl
+
+@[simp] lemma matrix.mul_vec_lin_zero [fintype n] : matrix.mul_vec_lin (0 : matrix m n R) = 0 :=
+linear_map.ext zero_mul_vec
+
+@[simp] lemma matrix.mul_vec_lin_add [fintype n] (M N : matrix m n R) :
+  (M + N).mul_vec_lin = M.mul_vec_lin + N.mul_vec_lin :=
+linear_map.ext $ λ _, add_mul_vec _ _ _
+
+lemma matrix.mul_vec_lin_submatrix [fintype n] [fintype l] (f₁ : m → k) (e₂ : n ≃ l)
+  (M : matrix k l R) :
+  (M.submatrix f₁ e₂).mul_vec_lin = fun_left R R f₁ ∘ₗ M.mul_vec_lin ∘ₗ fun_left _ _ e₂.symm :=
+linear_map.ext $ λ x, submatrix_mul_vec_equiv _ _ _ _
+
+/-- A variant of `matrix.mul_vec_lin_submatrix` that keeps around `linear_equiv`s. -/
+lemma matrix.mul_vec_lin_reindex [fintype n] [fintype l] (e₁ : k ≃ m) (e₂ : l ≃ n)
+  (M : matrix k l R) :
+  (reindex e₁ e₂ M).mul_vec_lin = ↑(linear_equiv.fun_congr_left R R e₁.symm)
+      ∘ₗ M.mul_vec_lin ∘ₗ ↑(linear_equiv.fun_congr_left R R e₂) :=
+matrix.mul_vec_lin_submatrix _ _ _
 
-variables [fintype n] [decidable_eq n]
+variables [fintype n]
 
-@[simp] lemma matrix.mul_vec_std_basis (M : matrix m n R) (i j) :
+@[simp] lemma matrix.mul_vec_lin_one [decidable_eq n] :
+  matrix.mul_vec_lin (1 : matrix n n R) = id :=
+by { ext, simp [linear_map.one_apply, std_basis_apply] }
+
+@[simp] lemma matrix.mul_vec_lin_mul [fintype m] (M : matrix l m R)
+  (N : matrix m n R) :
+  matrix.mul_vec_lin (M ⬝ N) = (matrix.mul_vec_lin M).comp (matrix.mul_vec_lin N) :=
+linear_map.ext $ λ x, (mul_vec_mul_vec _ _ _).symm
+
+lemma matrix.ker_mul_vec_lin_eq_bot_iff {M : matrix n n R} :
+  M.mul_vec_lin.ker = ⊥ ↔ ∀ v, M.mul_vec v = 0 → v = 0 :=
+by simp only [submodule.eq_bot_iff, linear_map.mem_ker, matrix.mul_vec_lin_apply]
+
+lemma matrix.mul_vec_std_basis [decidable_eq n] (M : matrix m n R) (i j) :
   M.mul_vec (std_basis R (λ _, R) j 1) i = M i j :=
+(congr_fun (matrix.mul_vec_single _ _ (1 : R)) i).trans $ mul_one _
+
+@[simp] lemma matrix.mul_vec_std_basis_apply [decidable_eq n] (M : matrix m n R) (j) :
+  M.mul_vec (std_basis R (λ _, R) j 1) = Mᵀ j :=
+funext $ λ i, matrix.mul_vec_std_basis M i j
+
+lemma matrix.range_mul_vec_lin (M : matrix m n R) : M.mul_vec_lin.range = span R (range Mᵀ) :=
 begin
-  have : (∑ j', M i j' * if j = j' then 1 else 0) = M i j,
-  { simp_rw [mul_boole, finset.sum_ite_eq, finset.mem_univ, if_true] },
-  convert this,
-  ext,
-  split_ifs with h; simp only [std_basis_apply],
-  { rw [h, function.update_same] },
-  { rw [function.update_noteq (ne.symm h), pi.zero_apply] }
+  letI := classical.dec_eq n,
+  simp_rw [range_eq_map, ←supr_range_std_basis, submodule.map_supr, range_eq_map,
+    ←ideal.span_singleton_one, ideal.span, submodule.map_span, image_image, image_singleton,
+    matrix.mul_vec_lin_apply, M.mul_vec_std_basis_apply, supr_span, range_eq_Union]
 end
 
+variables [decidable_eq n]
+
 /-- Linear maps `(n → R) →ₗ[R] (m → R)` are linearly equivalent to `matrix m n R`. -/
 def linear_map.to_matrix' : ((n → R) →ₗ[R] (m → R)) ≃ₗ[R] matrix m n R :=
-{ to_fun := λ f i j, f (std_basis R (λ _, R) j 1) i,
+{ to_fun := λ f, of (λ i j, f (std_basis R (λ _, R) j 1) i),
   inv_fun := matrix.mul_vec_lin,
-  right_inv := λ M, by { ext i j, simp only [matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply] },
+  right_inv := λ M, by { ext i j, simp only [matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply,
+                                             of_apply] },
   left_inv := λ f, begin
     apply (pi.basis_fun R n).ext,
     intro j, ext i,
-    simp only [pi.basis_fun_apply, matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply]
+    simp only [pi.basis_fun_apply, matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply,
+      of_apply]
   end,
-  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply] },
+  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply, of_apply] },
   map_smul' := λ c f, by { ext i j, simp only [pi.smul_apply, linear_map.smul_apply,
-                                               ring_hom.id_apply] } }
+                                               ring_hom.id_apply, of_apply] } }
+
+/-- A `matrix m n R` is linearly equivalent to a linear map `(n → R) →ₗ[R] (m → R)`.
 
-/-- A `matrix m n R` is linearly equivalent to a linear map `(n → R) →ₗ[R] (m → R)`. -/
+Note that the forward-direction does not require `decidable_eq` and is `matrix.vec_mul_lin`. -/
 def matrix.to_lin' : matrix m n R ≃ₗ[R] ((n → R) →ₗ[R] (m → R)) :=
 linear_map.to_matrix'.symm
 
+lemma matrix.to_lin'_apply' (M : matrix m n R) : matrix.to_lin' M = M.mul_vec_lin := rfl
+
 @[simp] lemma linear_map.to_matrix'_symm :
   (linear_map.to_matrix'.symm : matrix m n R ≃ₗ[R] _) = matrix.to_lin' :=
 rfl
@@ -114,7 +272,7 @@ matrix.to_lin'.apply_symm_apply f
 @[simp] lemma linear_map.to_matrix'_apply (f : (n → R) →ₗ[R] (m → R)) (i j) :
   linear_map.to_matrix' f i j = f (λ j', if j' = j then 1 else 0) i :=
 begin
-  simp only [linear_map.to_matrix', linear_equiv.coe_mk],
+  simp only [linear_map.to_matrix', linear_equiv.coe_mk, of_apply],
   congr,
   ext j',
   split_ifs with h,
@@ -126,8 +284,7 @@ end
   matrix.to_lin' M v = M.mul_vec v := rfl
 
 @[simp] lemma matrix.to_lin'_one :
-  matrix.to_lin' (1 : matrix n n R) = id :=
-by { ext, simp [linear_map.one_apply, std_basis_apply] }
+  matrix.to_lin' (1 : matrix n n R) = id := matrix.mul_vec_lin_one
 
 @[simp] lemma linear_map.to_matrix'_id :
   (linear_map.to_matrix' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
@@ -135,7 +292,19 @@ by { ext, rw [matrix.one_apply, linear_map.to_matrix'_apply, id_apply] }
 
 @[simp] lemma matrix.to_lin'_mul [fintype m] [decidable_eq m] (M : matrix l m R)
   (N : matrix m n R) : matrix.to_lin' (M ⬝ N) = (matrix.to_lin' M).comp (matrix.to_lin' N) :=
-by { ext, simp }
+matrix.mul_vec_lin_mul _ _
+
+@[simp] lemma matrix.to_lin'_submatrix [fintype l] [decidable_eq l] (f₁ : m → k) (e₂ : n ≃ l)
+  (M : matrix k l R) :
+  (M.submatrix f₁ e₂).to_lin' = fun_left R R f₁ ∘ₗ M.to_lin' ∘ₗ fun_left _ _ e₂.symm :=
+matrix.mul_vec_lin_submatrix _ _ _
+
+/-- A variant of `matrix.to_lin'_submatrix` that keeps around `linear_equiv`s. -/
+lemma matrix.to_lin'_reindex [fintype l] [decidable_eq l] (e₁ : k ≃ m) (e₂ : l ≃ n)
+  (M : matrix k l R) :
+  (reindex e₁ e₂ M).to_lin' = ↑(linear_equiv.fun_congr_left R R e₁.symm)
+      ∘ₗ M.to_lin' ∘ₗ ↑(linear_equiv.fun_congr_left R R e₂) :=
+matrix.mul_vec_lin_reindex _ _ _
 
 /-- Shortcut lemma for `matrix.to_lin'_mul` and `linear_map.comp_apply` -/
 lemma matrix.to_lin'_mul_apply [fintype m] [decidable_eq m] (M : matrix l m R)
@@ -160,7 +329,10 @@ by simp [module.algebra_map_End_eq_smul_id]
 
 lemma matrix.ker_to_lin'_eq_bot_iff {M : matrix n n R} :
   M.to_lin'.ker = ⊥ ↔ ∀ v, M.mul_vec v = 0 → v = 0 :=
-by simp only [submodule.eq_bot_iff, linear_map.mem_ker, matrix.to_lin'_apply]
+matrix.ker_mul_vec_lin_eq_bot_iff
+
+lemma matrix.range_to_lin' (M : matrix m n R) : M.to_lin'.range = span R (range Mᵀ) :=
+matrix.range_mul_vec_lin _
 
 /-- If `M` and `M'` are each other's inverse matrices, they provide an equivalence between `m → A`
 and `n → A` corresponding to `M.mul_vec` and `M'.mul_vec`. -/
@@ -210,46 +382,33 @@ by simp [linear_map.to_matrix_alg_equiv']
 
 @[simp] lemma matrix.to_lin_alg_equiv'_one :
   matrix.to_lin_alg_equiv' (1 : matrix n n R) = id :=
-by { ext, simp [matrix.one_apply, std_basis_apply] }
+matrix.to_lin'_one
 
 @[simp] lemma linear_map.to_matrix_alg_equiv'_id :
   (linear_map.to_matrix_alg_equiv' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
-by { ext, rw [matrix.one_apply, linear_map.to_matrix_alg_equiv'_apply, id_apply] }
+linear_map.to_matrix'_id
 
 @[simp] lemma matrix.to_lin_alg_equiv'_mul (M N : matrix n n R) :
   matrix.to_lin_alg_equiv' (M ⬝ N) =
     (matrix.to_lin_alg_equiv' M).comp (matrix.to_lin_alg_equiv' N) :=
-by { ext, simp }
+matrix.to_lin'_mul _ _
 
 lemma linear_map.to_matrix_alg_equiv'_comp (f g : (n → R) →ₗ[R] (n → R)) :
   (f.comp g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
-suffices (f.comp g) = (f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv').to_lin_alg_equiv',
-  by rw [this, linear_map.to_matrix_alg_equiv'_to_lin_alg_equiv'],
-by rw [matrix.to_lin_alg_equiv'_mul, matrix.to_lin_alg_equiv'_to_matrix_alg_equiv',
-       matrix.to_lin_alg_equiv'_to_matrix_alg_equiv']
+linear_map.to_matrix'_comp _ _
 
 lemma linear_map.to_matrix_alg_equiv'_mul
   (f g : (n → R) →ₗ[R] (n → R)) :
   (f * g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
 linear_map.to_matrix_alg_equiv'_comp f g
 
-lemma matrix.rank_vec_mul_vec {K m n : Type u} [field K] [fintype n] [decidable_eq n]
-  (w : m → K) (v : n → K) :
-  rank (vec_mul_vec w v).to_lin' ≤ 1 :=
-begin
-  rw [vec_mul_vec_eq, matrix.to_lin'_mul],
-  refine le_trans (rank_comp_le1 _ _) _,
-  refine (rank_le_domain _).trans_eq _,
-  rw [dim_fun', fintype.card_unit, nat.cast_one]
-end
-
 end to_matrix'
 
 section to_matrix
 
-variables {R : Type*} [comm_ring R]
+variables {R : Type*} [comm_semiring R]
 variables {l m n : Type*} [fintype n] [fintype m] [decidable_eq n]
-variables {M₁ M₂ : Type*} [add_comm_group M₁] [add_comm_group M₂] [module R M₁] [module R M₂]
+variables {M₁ M₂ : Type*} [add_comm_monoid M₁] [add_comm_monoid M₂] [module R M₁] [module R M₂]
 variables (v₁ : basis n R M₁) (v₂ : basis m R M₂)
 
 /-- Given bases of two modules `M₁` and `M₂` over a commutative ring `R`, we get a linear
@@ -336,7 +495,7 @@ end
 lemma linear_map.to_matrix_id : linear_map.to_matrix v₁ v₁ id = 1 :=
 begin
   ext i j,
-  simp [linear_map.to_matrix_apply, matrix.one_apply, finsupp.single, eq_comm]
+  simp [linear_map.to_matrix_apply, matrix.one_apply, finsupp.single_apply, eq_comm]
 end
 
 lemma linear_map.to_matrix_one : linear_map.to_matrix v₁ v₁ 1 = 1 :=
@@ -353,7 +512,7 @@ theorem linear_map.to_matrix_reindex_range [decidable_eq M₁] [decidable_eq M
     linear_map.to_matrix v₁ v₂ f k i :=
 by simp_rw [linear_map.to_matrix_apply, basis.reindex_range_self, basis.reindex_range_repr]
 
-variables {M₃ : Type*} [add_comm_group M₃] [module R M₃] (v₃ : basis l R M₃)
+variables {M₃ : Type*} [add_comm_monoid M₃] [module R M₃] (v₃ : basis l R M₃)
 
 lemma linear_map.to_matrix_comp [fintype l] [decidable_eq m] (f : M₂ →ₗ[R] M₃) (g : M₁ →ₗ[R] M₂) :
   linear_map.to_matrix v₁ v₃ (f.comp g) =
@@ -379,6 +538,14 @@ by { ext i,
      congr,
      exact v₁.equiv_fun.symm_apply_apply x }
 
+@[simp] lemma linear_map.to_matrix_basis_equiv [fintype l] [decidable_eq l]
+  (b : basis l R M₁) (b' : basis l R M₂) :
+  linear_map.to_matrix b' b (b'.equiv b (equiv.refl l) : M₂ →ₗ[R] M₁) = 1 :=
+begin
+  ext i j,
+  simp [linear_map.to_matrix_apply, matrix.one_apply, finsupp.single_apply, eq_comm],
+end
+
 lemma matrix.to_lin_mul [fintype l] [decidable_eq m] (A : matrix l m R) (B : matrix m n R) :
   matrix.to_lin v₁ v₃ (A ⬝ B) =
   (matrix.to_lin v₂ v₃ A).comp (matrix.to_lin v₁ v₂ B) :=
@@ -494,34 +661,48 @@ lemma matrix.to_lin_alg_equiv_mul (A B : matrix n n R) :
   (matrix.to_lin_alg_equiv v₁ A).comp (matrix.to_lin_alg_equiv v₁ B) :=
 by convert matrix.to_lin_mul v₁ v₁ v₁ A B
 
+@[simp] lemma matrix.to_lin_fin_two_prod_apply (a b c d : R) (x : R × R) :
+  matrix.to_lin (basis.fin_two_prod R) (basis.fin_two_prod R) !![a, b; c, d] x =
+    (a * x.fst + b * x.snd, c * x.fst + d * x.snd) :=
+by simp [matrix.to_lin_apply, matrix.mul_vec, matrix.dot_product]
+
+lemma matrix.to_lin_fin_two_prod (a b c d : R) :
+  matrix.to_lin (basis.fin_two_prod R) (basis.fin_two_prod R) !![a, b; c, d] =
+    (a • linear_map.fst R R R + b • linear_map.snd R R R).prod
+    (c • linear_map.fst R R R + d • linear_map.snd R R R) :=
+linear_map.ext $ matrix.to_lin_fin_two_prod_apply _ _ _ _
+
+@[simp] lemma to_matrix_distrib_mul_action_to_linear_map (x : R) :
+  linear_map.to_matrix v₁ v₁ (distrib_mul_action.to_linear_map R M₁ x) = matrix.diagonal (λ _, x) :=
+begin
+  ext,
+  rw [linear_map.to_matrix_apply, distrib_mul_action.to_linear_map_apply, linear_equiv.map_smul,
+    basis.repr_self, finsupp.smul_single_one, finsupp.single_eq_pi_single, matrix.diagonal_apply,
+    pi.single_apply],
+end
+
 end to_matrix
 
 namespace algebra
 
 section lmul
 
-variables {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
-variables [algebra R S] [algebra S T] [algebra R T] [is_scalar_tower R S T]
-variables {m n : Type*} [fintype m] [decidable_eq m] [decidable_eq n]
-variables (b : basis m R S) (c : basis n S T)
-
-open algebra
+variables {R S : Type*} [comm_ring R] [ring S] [algebra R S]
+variables {m : Type*} [fintype m] [decidable_eq m] (b : basis m R S)
 
 lemma to_matrix_lmul' (x : S) (i j) :
   linear_map.to_matrix b b (lmul R S x) i j = b.repr (x * b j) i :=
-by rw [linear_map.to_matrix_apply', lmul_apply]
+by simp only [linear_map.to_matrix_apply', coe_lmul_eq_mul, linear_map.mul_apply']
 
-@[simp] lemma to_matrix_lsmul (x : R) (i j) :
-  linear_map.to_matrix b b (algebra.lsmul R S x) i j = if i = j then x else 0 :=
-by { rw [linear_map.to_matrix_apply', algebra.lsmul_coe, linear_equiv.map_smul, finsupp.smul_apply,
-         b.repr_self_apply, smul_eq_mul, mul_boole],
-     congr' 1; simp only [eq_comm] }
+@[simp] lemma to_matrix_lsmul (x : R) :
+  linear_map.to_matrix b b (algebra.lsmul R S x) = matrix.diagonal (λ _, x) :=
+to_matrix_distrib_mul_action_to_linear_map b x
 
 /-- `left_mul_matrix b x` is the matrix corresponding to the linear map `λ y, x * y`.
 
 `left_mul_matrix_eq_repr_mul` gives a formula for the entries of `left_mul_matrix`.
 
-This definition is useful for doing (more) explicit computations with `algebra.lmul`,
+This definition is useful for doing (more) explicit computations with `linear_map.mul_left`,
 such as the trace form or norm map for algebras.
 -/
 noncomputable def left_mul_matrix : S →ₐ[R] matrix m m R :=
@@ -530,8 +711,8 @@ noncomputable def left_mul_matrix : S →ₐ[R] matrix m m R :=
   map_one' := by rw [alg_hom.map_one, linear_map.to_matrix_one],
   map_add' := λ x y, by rw [alg_hom.map_add, linear_equiv.map_add],
   map_mul' := λ x y, by rw [alg_hom.map_mul, linear_map.to_matrix_mul, matrix.mul_eq_mul],
-  commutes' := λ r, by { ext, rw [lmul_algebra_map, to_matrix_lsmul,
-                                  algebra_map_matrix_apply, id.map_eq_self] } }
+  commutes' := λ r, by { ext, rw [lmul_algebra_map, to_matrix_lsmul, algebra_map_eq_diagonal,
+                                  pi.algebra_map_def, algebra.id.map_eq_self] } }
 
 lemma left_mul_matrix_apply (x : S) :
   left_mul_matrix b x = linear_map.to_matrix b b (lmul R S x) := rfl
@@ -544,10 +725,10 @@ by rw [left_mul_matrix_apply, to_matrix_lmul' b x i j]
 
 lemma left_mul_matrix_mul_vec_repr (x y : S) :
   (left_mul_matrix b x).mul_vec (b.repr y) = b.repr (x * y) :=
-linear_map.to_matrix_mul_vec_repr b b (algebra.lmul R S x) y
+(linear_map.mul_left R x).to_matrix_mul_vec_repr b b y
 
 @[simp] lemma to_matrix_lmul_eq (x : S) :
-  linear_map.to_matrix b b (lmul R S x) = left_mul_matrix b x :=
+  linear_map.to_matrix b b (linear_map.mul_left R x) = left_mul_matrix b x :=
 rfl
 
 lemma left_mul_matrix_injective : function.injective (left_mul_matrix b) :=
@@ -555,14 +736,21 @@ lemma left_mul_matrix_injective : function.injective (left_mul_matrix b) :=
              ... = algebra.lmul R S x' 1 : by rw (linear_map.to_matrix b b).injective h
              ... = x' : mul_one x'
 
-variable [fintype n]
+end lmul
+
+section lmul_tower
+
+variables {R S T : Type*} [comm_ring R] [comm_ring S] [ring T]
+variables [algebra R S] [algebra S T] [algebra R T] [is_scalar_tower R S T]
+variables {m n : Type*} [fintype m] [fintype n] [decidable_eq m] [decidable_eq n]
+variables (b : basis m R S) (c : basis n S T)
 
 lemma smul_left_mul_matrix (x) (ik jk) :
   left_mul_matrix (b.smul c) x ik jk =
     left_mul_matrix b (left_mul_matrix c x ik.2 jk.2) ik.1 jk.1 :=
 by simp only [left_mul_matrix_apply, linear_map.to_matrix_apply, mul_comm, basis.smul_apply,
-              basis.smul_repr, finsupp.smul_apply, algebra.lmul_apply, id.smul_eq_mul,
-              linear_equiv.map_smul, mul_smul_comm]
+  basis.smul_repr, finsupp.smul_apply, id.smul_eq_mul, linear_equiv.map_smul, mul_smul_comm,
+  coe_lmul_eq_mul, linear_map.mul_apply']
 
 lemma smul_left_mul_matrix_algebra_map (x : S) :
   left_mul_matrix (b.smul c) (algebra_map _ _ x) = block_diagonal (λ k, left_mul_matrix b x) :=
@@ -580,55 +768,10 @@ lemma smul_left_mul_matrix_algebra_map_ne (x : S) (i j) {k k'}
   (h : k ≠ k') : left_mul_matrix (b.smul c) (algebra_map _ _ x) (i, k) (j, k') = 0 :=
 by rw [smul_left_mul_matrix_algebra_map, block_diagonal_apply_ne _ _ _ h]
 
-end lmul
+end lmul_tower
 
 end algebra
 
-namespace linear_map
-
-section finite_dimensional
-
-open_locale classical
-
-variables {K : Type*} [field K]
-variables {V : Type*} [add_comm_group V] [module K V] [finite_dimensional K V]
-variables {W : Type*} [add_comm_group W] [module K W] [finite_dimensional K W]
-
-instance finite_dimensional : finite_dimensional K (V →ₗ[K] W) :=
-linear_equiv.finite_dimensional
-  (linear_map.to_matrix (basis.of_vector_space K V) (basis.of_vector_space K W)).symm
-
-section
-
-variables {A : Type*} [ring A] [algebra K A] [module A V] [is_scalar_tower K A V]
-  [module A W] [is_scalar_tower K A W]
-
-/-- Linear maps over a `k`-algebra are finite dimensional (over `k`) if both the source and
-target are, since they form a subspace of all `k`-linear maps. -/
-instance finite_dimensional' : finite_dimensional K (V →ₗ[A] W) :=
-finite_dimensional.of_injective (restrict_scalars_linear_map K A V W)
-  (restrict_scalars_injective _)
-
-end
-
-/--
-The dimension of the space of linear transformations is the product of the dimensions of the
-domain and codomain.
--/
-@[simp] lemma finrank_linear_map :
-  finite_dimensional.finrank K (V →ₗ[K] W) =
-  (finite_dimensional.finrank K V) * (finite_dimensional.finrank K W) :=
-begin
-  let hbV := basis.of_vector_space K V,
-  let hbW := basis.of_vector_space K W,
-  rw [linear_equiv.finrank_eq (linear_map.to_matrix hbV hbW), matrix.finrank_matrix,
-    finite_dimensional.finrank_eq_card_basis hbV, finite_dimensional.finrank_eq_card_basis hbW,
-    mul_comm],
-end
-
-end finite_dimensional
-end linear_map
-
 section
 
 variables {R : Type v} [comm_ring R] {n : Type*} [decidable_eq n]
diff --git a/src/linear_algebra/matrix/to_linear_equiv.lean b/src/linear_algebra/matrix/to_linear_equiv.lean
index 3f13a36442902..d11f840052bdb 100644
--- a/src/linear_algebra/matrix/to_linear_equiv.lean
+++ b/src/linear_algebra/matrix/to_linear_equiv.lean
@@ -3,6 +3,8 @@ Copyright (c) 2019 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
 -/
+import linear_algebra.finite_dimensional
+import linear_algebra.matrix.general_linear_group
 import linear_algebra.matrix.nondegenerate
 import linear_algebra.matrix.nonsingular_inverse
 import linear_algebra.matrix.to_lin
@@ -12,6 +14,9 @@ import ring_theory.localization.integer
 /-!
 # Matrices and linear equivalences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file gives the map `matrix.to_linear_equiv` from matrices with invertible determinant,
 to linear equivs.
 
@@ -45,21 +50,15 @@ variables [decidable_eq n]
 See `matrix.to_linear_equiv` for the same map on arbitrary modules.
 -/
 def to_linear_equiv' (P : matrix n n R) (h : invertible P) : (n → R) ≃ₗ[R] (n → R) :=
-{ inv_fun   := (⅟P).to_lin',
-  left_inv  := λ v,
-    show ((⅟P).to_lin'.comp P.to_lin') v = v,
-    by rw [← matrix.to_lin'_mul, P.inv_of_mul_self, matrix.to_lin'_one, linear_map.id_apply],
-  right_inv := λ v,
-    show (P.to_lin'.comp (⅟P).to_lin') v = v,
-    by rw [← matrix.to_lin'_mul, P.mul_inv_of_self, matrix.to_lin'_one, linear_map.id_apply],
-  ..P.to_lin' }
+general_linear_group.general_linear_equiv _ _ $
+  matrix.general_linear_group.to_linear $ unit_of_invertible P
 
 @[simp] lemma to_linear_equiv'_apply (P : matrix n n R) (h : invertible P) :
   (↑(P.to_linear_equiv' h) : module.End R (n → R)) = P.to_lin' := rfl
 
 @[simp] lemma to_linear_equiv'_symm_apply (P : matrix n n R) (h : invertible P) :
-  (↑(P.to_linear_equiv' h).symm : module.End R (n → R)) = P⁻¹.to_lin' :=
-show (⅟P).to_lin' = _, from congr_arg _ P.inv_of_eq_nonsing_inv
+  (↑(P.to_linear_equiv' h).symm : module.End R (n → R)) = (⅟P).to_lin' :=
+rfl
 
 end to_linear_equiv'
 
@@ -188,8 +187,7 @@ begin
     simpa only [dot_product_mul_vec, dot_product_single, mul_one] using hv (pi.single i 1) }
 end
 
-alias nondegenerate_iff_det_ne_zero ↔
-  matrix.nondegenerate.det_ne_zero matrix.nondegenerate.of_det_ne_zero
+alias nondegenerate_iff_det_ne_zero ↔ nondegenerate.det_ne_zero nondegenerate.of_det_ne_zero
 
 end nondegenerate
 
diff --git a/src/linear_algebra/matrix/trace.lean b/src/linear_algebra/matrix/trace.lean
index f4953a34463cc..b46f3b834f19b 100644
--- a/src/linear_algebra/matrix/trace.lean
+++ b/src/linear_algebra/matrix/trace.lean
@@ -8,6 +8,9 @@ import data.matrix.basic
 /-!
 # Trace of a matrix
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the trace of a matrix, the map sending a matrix to the sum of its diagonal
 entries.
 
@@ -89,7 +92,7 @@ finset.sum_neg_distrib
 end add_comm_group
 
 section one
-variables [decidable_eq n]  [add_comm_monoid R] [has_one R]
+variables [decidable_eq n] [add_comm_monoid_with_one R]
 
 @[simp] lemma trace_one : trace (1 : matrix n n R) = fintype.card n :=
 by simp_rw [trace, diag_one, pi.one_def, finset.sum_const, nsmul_one, finset.card_univ]
diff --git a/src/linear_algebra/matrix/transvection.lean b/src/linear_algebra/matrix/transvection.lean
index 0f5f266db9a49..8c0daac3129b6 100644
--- a/src/linear_algebra/matrix/transvection.lean
+++ b/src/linear_algebra/matrix/transvection.lean
@@ -6,13 +6,15 @@ Authors: Sébastien Gouëzel
 import data.matrix.basis
 import data.matrix.dmatrix
 import linear_algebra.matrix.determinant
-import linear_algebra.matrix.trace
 import linear_algebra.matrix.reindex
 import tactic.field_simp
 
 /-!
 # Transvections
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Transvections are matrices of the form `1 + std_basis_matrix i j c`, where `std_basis_matrix i j c`
 is the basic matrix with a `c` at position `(i, j)`. Multiplying by such a transvection on the left
 (resp. on the right) amounts to adding `c` times the `j`-th row to to the `i`-th row
@@ -81,26 +83,28 @@ def transvection (c : R) : matrix n n R := 1 + matrix.std_basis_matrix i j c
 by simp [transvection]
 
 section
-variable [fintype n]
 
 /-- A transvection matrix is obtained from the identity by adding `c` times the `j`-th row to
 the `i`-th row. -/
-lemma update_row_eq_transvection (c : R) :
+lemma update_row_eq_transvection [finite n] (c : R) :
   update_row (1 : matrix n n R) i (((1 : matrix n n R)) i + c • (1 : matrix n n R) j) =
     transvection i j c :=
 begin
+  casesI nonempty_fintype n,
   ext a b,
   by_cases ha : i = a, by_cases hb : j = b,
-  { simp only [update_row, transvection, ha, hb, function.update_same, std_basis_matrix.apply_same,
-      pi.add_apply, one_apply_eq, pi.smul_apply, mul_one, algebra.id.smul_eq_mul], },
-  { simp only [update_row, transvection, ha, hb, std_basis_matrix.apply_of_ne, function.update_same,
-      pi.add_apply, ne.def, not_false_iff, pi.smul_apply, and_false, one_apply_ne,
+  { simp only [update_row_self, transvection, ha, hb, pi.add_apply,
+      std_basis_matrix.apply_same, one_apply_eq, pi.smul_apply, mul_one, algebra.id.smul_eq_mul], },
+  { simp only [update_row_self, transvection, ha, hb, std_basis_matrix.apply_of_ne, pi.add_apply,
+      ne.def, not_false_iff, pi.smul_apply, and_false, one_apply_ne,
       algebra.id.smul_eq_mul, mul_zero] },
-  { simp only [update_row, transvection, ha, ne.symm ha, std_basis_matrix.apply_of_ne, add_zero,
-      algebra.id.smul_eq_mul, function.update_noteq, ne.def, not_false_iff, dmatrix.add_apply,
+  { simp only [update_row_ne, transvection, ha, ne.symm ha, std_basis_matrix.apply_of_ne, add_zero,
+      algebra.id.smul_eq_mul, ne.def, not_false_iff, dmatrix.add_apply,
       pi.smul_apply, mul_zero, false_and] },
 end
 
+variables [fintype n]
+
 lemma transvection_mul_transvection_same (h : i ≠ j) (c d : R) :
   transvection i j c ⬝ transvection i j d = transvection i j (c + d) :=
 by simp [transvection, matrix.add_mul, matrix.mul_add, h, h.symm, add_smul, add_assoc,
@@ -132,7 +136,7 @@ variables (R n)
 /-- A structure containing all the information from which one can build a nontrivial transvection.
 This structure is easier to manipulate than transvections as one has a direct access to all the
 relevant fields. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure transvection_struct :=
 (i j : n)
 (hij : i ≠ j)
@@ -269,7 +273,7 @@ begin
   cases t,
   ext a b,
   simp only [reindex_equiv, transvection, mul_boole, algebra.id.smul_eq_mul, to_matrix_mk,
-    minor_apply, reindex_apply, dmatrix.add_apply, pi.smul_apply, reindex_alg_equiv_apply],
+    submatrix_apply, reindex_apply, dmatrix.add_apply, pi.smul_apply, reindex_alg_equiv_apply],
   by_cases ha : e t_i = a; by_cases hb : e t_j = b; by_cases hab : a = b;
   simp [ha, hb, hab, ← e.apply_eq_iff_eq_symm_apply, std_basis_matrix]
 end
@@ -362,7 +366,7 @@ begin
     simp only [matrix.mul_assoc, A, matrix.mul_eq_mul, list.prod_cons],
     by_cases h : n' = i,
     { have hni : n = i,
-      { cases i, simp only [subtype.mk_eq_mk] at h, simp [h] },
+      { cases i, simp only [fin.mk_eq_mk] at h, simp [h] },
       rw [h, transvection_mul_apply_same, IH, list_transvec_col_mul_last_row_drop _ _ hn, ← hni],
       field_simp [hM] },
     { have hni : n ≠ i,
@@ -411,7 +415,7 @@ begin
     if k ≤ i then M (inr star) (inl i) else 0,
   { have A : (list_transvec_row M).length = r, by simp [list_transvec_row],
     rw [← list.take_length (list_transvec_row M), A],
-    have : ¬ (r ≤ i), by simpa using i.2,
+    have : ¬ (r ≤ i), by simp,
     simpa only [this, ite_eq_right_iff] using H r le_rfl },
   assume k hk,
   induction k with n IH,
@@ -425,7 +429,7 @@ begin
       matrix.mul_eq_mul, list.prod_cons, list.prod_nil, option.to_list_some],
     by_cases h : n' = i,
     { have hni : n = i,
-      { cases i, simp only [subtype.mk_eq_mk] at h, simp only [h, coe_mk] },
+      { cases i, simp only [fin.mk_eq_mk] at h, simp only [h, coe_mk] },
       have : ¬ (n.succ ≤ i), by simp only [← hni, n.lt_succ_self, not_le],
       simp only [h, mul_transvection_apply_same, list.take, if_false,
         mul_list_transvec_row_last_col_take _ _ hnr.le, hni.le, this, if_true, IH hnr.le],
@@ -515,17 +519,15 @@ begin
   -- last column, we will first put this nonzero coefficient in last position, and then argue as
   -- above.
   push_neg at hM,
-  simp [not_and_distrib, is_two_block_diagonal, to_blocks₁₂, to_blocks₂₁] at H,
+  simp [not_and_distrib, is_two_block_diagonal, to_blocks₁₂, to_blocks₂₁, ←matrix.ext_iff] at H,
   have : ∃ (i : fin r), M (inl i) (inr star) ≠ 0 ∨ M (inr star) (inl i) ≠ 0,
   { cases H,
     { contrapose! H,
-      ext i j,
-      convert (H i).1,
-      simp only [eq_iff_true_of_subsingleton] },
+      rintros i ⟨⟩,
+      exact (H i).1 },
     { contrapose! H,
-      ext i j,
-      convert (H j).2,
-      simp only [eq_iff_true_of_subsingleton] } },
+      rintros ⟨⟩ j,
+      exact (H j).2, } },
   rcases this with ⟨i, h|h⟩,
   { let M' := transvection (inr unit.star) (inl i) 1 ⬝ M,
     have hM' : M' (inr star) (inr star) ≠ 0, by simpa [M', hM],
@@ -569,7 +571,7 @@ begin
     congr,
     { exact hM.1 },
     { exact hM.2 },
-    { ext i j,  rw [hc, to_blocks₂₂], congr } },
+    { ext ⟨⟩ ⟨⟩, rw [hc, to_blocks₂₂, of_apply], refl, } },
   rw this,
   simp [h₀],
 end
@@ -587,12 +589,12 @@ begin
   rcases H with ⟨L₀, L₀', D₀, h₀⟩,
   refine ⟨L₀.map (reindex_equiv e.symm), L₀'.map (reindex_equiv e.symm), D₀ ∘ e, _⟩,
   have : M = reindex_alg_equiv 𝕜 e.symm (reindex_alg_equiv 𝕜 e M),
-    by simp only [equiv.symm_symm, minor_minor, reindex_apply, minor_id_id, equiv.symm_comp_self,
-      reindex_alg_equiv_apply],
+    by simp only [equiv.symm_symm, submatrix_submatrix, reindex_apply, submatrix_id_id,
+      equiv.symm_comp_self, reindex_alg_equiv_apply],
   rw this,
   simp only [to_matrix_reindex_equiv_prod, list.map_map, reindex_alg_equiv_apply],
   simp only [← reindex_alg_equiv_apply, ← reindex_alg_equiv_mul, h₀],
-  simp only [equiv.symm_symm, reindex_apply, minor_diagonal_equiv, reindex_alg_equiv_apply],
+  simp only [equiv.symm_symm, reindex_apply, submatrix_diagonal_equiv, reindex_alg_equiv_apply],
 end
 
 /-- Any matrix can be reduced to diagonal form by elementary operations. Formulated here on `Type 0`
diff --git a/src/linear_algebra/matrix/zpow.lean b/src/linear_algebra/matrix/zpow.lean
index 8e31e3d706ec6..fb7ff4cc6d15f 100644
--- a/src/linear_algebra/matrix/zpow.lean
+++ b/src/linear_algebra/matrix/zpow.lean
@@ -8,6 +8,9 @@ import linear_algebra.matrix.nonsingular_inverse
 /-!
 # Integer powers of square matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define integer power of matrices, relying on
 the nonsingular inverse definition for negative powers.
 
@@ -123,12 +126,11 @@ lemma is_unit_det_zpow_iff {A : M} {z : ℤ} :
 begin
   induction z using int.induction_on with z IH z IH,
   { simp },
-  { rw [←int.coe_nat_succ, zpow_coe_nat, det_pow, is_unit_pos_pow_iff (z.zero_lt_succ),
-        ←int.coe_nat_zero, int.coe_nat_eq_coe_nat_iff],
-    simp },
-  { rw [←neg_add', ←int.coe_nat_succ, zpow_neg_coe_nat, is_unit_nonsing_inv_det_iff,
-        det_pow, is_unit_pos_pow_iff (z.zero_lt_succ), neg_eq_zero, ←int.coe_nat_zero,
+  { rw [←int.coe_nat_succ, zpow_coe_nat, det_pow, is_unit_pow_succ_iff, ←int.coe_nat_zero,
         int.coe_nat_eq_coe_nat_iff],
+    simp },
+  { rw [←neg_add', ←int.coe_nat_succ, zpow_neg_coe_nat, is_unit_nonsing_inv_det_iff, det_pow,
+        is_unit_pow_succ_iff, neg_eq_zero, ←int.coe_nat_zero, int.coe_nat_eq_coe_nat_iff],
     simp }
 end
 
@@ -144,7 +146,7 @@ lemma inv_zpow' {A : M} (h : is_unit A.det) (n : ℤ) :
 by rw [zpow_neg h, inv_zpow]
 
 lemma zpow_add_one {A : M} (h : is_unit A.det) : ∀ n : ℤ, A ^ (n + 1) = A ^ n * A
-| (n : ℕ)        := by simp [← int.coe_nat_succ, pow_succ']
+| (n : ℕ)        := by simp only [← nat.cast_succ, pow_succ', zpow_coe_nat]
 | -((n : ℕ) + 1) :=
 calc  A ^ (-(n + 1) + 1 : ℤ)
     = (A ^ n)⁻¹ : by rw [neg_add, neg_add_cancel_right, zpow_neg h, zpow_coe_nat]
@@ -239,7 +241,7 @@ begin
 end
 
 lemma zpow_add_one_of_ne_neg_one {A : M} : ∀ (n : ℤ), n ≠ -1 → A ^ (n + 1) = A ^ n * A
-| (n : ℕ) _ := by simp [← int.coe_nat_succ, pow_succ']
+| (n : ℕ) _ := by simp only [pow_succ', ← nat.cast_succ, zpow_coe_nat]
 | (-1) h := absurd rfl h
 | (-((n : ℕ) + 2)) _ := begin
   rcases nonsing_inv_cancel_or_zero A with ⟨h, h'⟩ | h,
diff --git a/src/linear_algebra/multilinear/basic.lean b/src/linear_algebra/multilinear/basic.lean
index 093262a52f2f0..1bc50a50377a7 100644
--- a/src/linear_algebra/multilinear/basic.lean
+++ b/src/linear_algebra/multilinear/basic.lean
@@ -4,17 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import linear_algebra.basic
-import linear_algebra.matrix.to_lin
 import algebra.algebra.basic
 import algebra.big_operators.order
 import algebra.big_operators.ring
-import data.fin.tuple
-import data.fintype.card
+import data.list.fin_range
+import data.fintype.big_operators
 import data.fintype.sort
 
 /-!
 # Multilinear maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define multilinear maps as maps from `Π(i : ι), M₁ i` to `M₂` which are linear in each
 coordinate. Here, `M₁ i` and `M₂` are modules over a ring `R`, and `ι` is an arbitrary type
 (although some statements will require it to be a fintype). This space, denoted by
@@ -46,11 +48,29 @@ in linear functions), called respectively `multilinear_curry_left_equiv` and
 
 Expressing that a map is linear along the `i`-th coordinate when all other coordinates are fixed
 can be done in two (equivalent) different ways:
+
 * fixing a vector `m : Π(j : ι - i), M₁ j.val`, and then choosing separately the `i`-th coordinate
 * fixing a vector `m : Πj, M₁ j`, and then modifying its `i`-th coordinate
+
 The second way is more artificial as the value of `m` at `i` is not relevant, but it has the
 advantage of avoiding subtype inclusion issues. This is the definition we use, based on
 `function.update` that allows to change the value of `m` at `i`.
+
+Note that the use of `function.update` requires a `decidable_eq ι` term to appear somewhere in the
+statement of `multilinear_map.map_add'` and `multilinear_map.map_smul'`. Three possible choices
+are:
+
+1. Requiring `decidable_eq ι` as an argument to `multilinear_map` (as we did originally).
+2. Using `classical.dec_eq ι` in the statement of `map_add'` and `map_smul'`.
+3. Quantifying over all possible `decidable_eq ι` instances in the statement of `map_add'` and
+   `map_smul'`.
+
+Option 1 works fine, but puts unecessary constraints on the user (the zero map certainly does not
+need decidability). Option 2 looks great at first, but in the common case when `ι = fin n` it
+introduces non-defeq decidability instance diamonds within the context of proving `map_add'` and
+`map_smul'`, of the form `fin.decidable_eq n = classical.dec_eq (fin n)`. Option 3 of course does
+something similar, but of the form `fin.decidable_eq n = _inst`, which is much easier to clean up
+since `_inst` is a free variable and so the equality can just be substituted.
 -/
 
 open function fin set
@@ -59,17 +79,16 @@ open_locale big_operators
 universes u v v' v₁ v₂ v₃ w u'
 variables {R : Type u} {ι : Type u'} {n : ℕ}
 {M : fin n.succ → Type v} {M₁ : ι → Type v₁} {M₂ : Type v₂} {M₃ : Type v₃} {M' : Type v'}
-[decidable_eq ι]
 
 /-- Multilinear maps over the ring `R`, from `Πi, M₁ i` to `M₂` where `M₁ i` and `M₂` are modules
 over `R`. -/
 structure multilinear_map (R : Type u) {ι : Type u'} (M₁ : ι → Type v) (M₂ : Type w)
-  [decidable_eq ι] [semiring R] [∀i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
+  [semiring R] [∀i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
   [∀i, module R (M₁ i)] [module R M₂] :=
 (to_fun : (Πi, M₁ i) → M₂)
-(map_add' : ∀(m : Πi, M₁ i) (i : ι) (x y : M₁ i),
+(map_add' : ∀ [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (x y : M₁ i), by exactI
   to_fun (update m i (x + y)) = to_fun (update m i x) + to_fun (update m i y))
-(map_smul' : ∀(m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i),
+(map_smul' : ∀ [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i), by exactI
   to_fun (update m i (c • x)) = c • to_fun (update m i x))
 
 namespace multilinear_map
@@ -115,21 +134,22 @@ theorem ext_iff {f g : multilinear_map R M₁ M₂} : f = g ↔ ∀ x, f x = g x
   (⟨f, h₁, h₂⟩ : multilinear_map R M₁ M₂) = f :=
 by { ext, refl, }
 
-@[simp] protected lemma map_add (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
+@[simp] protected lemma map_add [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
   f (update m i (x + y)) = f (update m i x) + f (update m i y) :=
 f.map_add' m i x y
 
-@[simp] lemma map_smul (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i) :
+@[simp] protected lemma map_smul [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i) :
   f (update m i (c • x)) = c • f (update m i x) :=
 f.map_smul' m i c x
 
 lemma map_coord_zero {m : Πi, M₁ i} (i : ι) (h : m i = 0) : f m = 0 :=
 begin
+  classical,
   have : (0 : R) • (0 : M₁ i) = 0, by simp,
   rw [← update_eq_self i m, h, ← this, f.map_smul, zero_smul]
 end
 
-@[simp] lemma map_update_zero (m : Πi, M₁ i) (i : ι) : f (update m i 0) = 0 :=
+@[simp] lemma map_update_zero [decidable_eq ι] (m : Πi, M₁ i) (i : ι) : f (update m i 0) = 0 :=
 f.map_coord_zero i (update_same i 0 m)
 
 @[simp] lemma map_zero [nonempty ι] : f 0 = 0 :=
@@ -140,23 +160,23 @@ end
 
 instance : has_add (multilinear_map R M₁ M₂) :=
 ⟨λf f', ⟨λx, f x + f' x, λm i x y, by simp [add_left_comm, add_assoc],
-  λm i c x, by simp [smul_add]⟩⟩
+  λ _ m i c x, by simp [smul_add]⟩⟩
 
 @[simp] lemma add_apply (m : Πi, M₁ i) : (f + f') m = f m + f' m := rfl
 
 instance : has_zero (multilinear_map R M₁ M₂) :=
-⟨⟨λ _, 0, λm i x y, by simp, λm i c x, by simp⟩⟩
+⟨⟨λ _, 0, λ _ m i x y, by simp, λ _ m i c x, by simp⟩⟩
 
 instance : inhabited (multilinear_map R M₁ M₂) := ⟨0⟩
 
 @[simp] lemma zero_apply (m : Πi, M₁ i) : (0 : multilinear_map R M₁ M₂) m = 0 := rfl
 
-section has_scalar
+section has_smul
 variables {R' A : Type*} [monoid R'] [semiring A]
   [Π i, module A (M₁ i)] [distrib_mul_action R' M₂] [module A M₂] [smul_comm_class A R' M₂]
 
-instance : has_scalar R' (multilinear_map A M₁ M₂) := ⟨λ c f,
-  ⟨λ m, c • f m, λm i x y, by simp [smul_add], λl i x d, by simp [←smul_comm x c] ⟩⟩
+instance : has_smul R' (multilinear_map A M₁ M₂) := ⟨λ c f,
+  ⟨λ m, c • f m, λ _ m i x y, by simp [smul_add], λ _ l i x d, by simp [←smul_comm x c] ⟩⟩
 
 @[simp] lemma smul_apply (f : multilinear_map A M₁ M₂) (c : R') (m : Πi, M₁ i) :
   (c • f) m = c • f m := rfl
@@ -164,7 +184,7 @@ instance : has_scalar R' (multilinear_map A M₁ M₂) := ⟨λ c f,
 lemma coe_smul (c : R') (f : multilinear_map A M₁ M₂) : ⇑(c • f) = c • f :=
 rfl
 
-end has_scalar
+end has_smul
 
 instance : add_comm_monoid (multilinear_map R M₁ M₂) :=
 coe_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)
@@ -180,17 +200,17 @@ end
 
 /-- If `f` is a multilinear map, then `f.to_linear_map m i` is the linear map obtained by fixing all
 coordinates but `i` equal to those of `m`, and varying the `i`-th coordinate. -/
-@[simps] def to_linear_map (m : Πi, M₁ i) (i : ι) : M₁ i →ₗ[R] M₂ :=
+@[simps] def to_linear_map [decidable_eq ι] (m : Πi, M₁ i) (i : ι) : M₁ i →ₗ[R] M₂ :=
 { to_fun    := λx, f (update m i x),
   map_add'  := λx y, by simp,
   map_smul' := λc x, by simp }
 
 /-- The cartesian product of two multilinear maps, as a multilinear map. -/
-def prod (f : multilinear_map R M₁ M₂) (g : multilinear_map R M₁ M₃) :
+@[simps] def prod (f : multilinear_map R M₁ M₂) (g : multilinear_map R M₁ M₃) :
   multilinear_map R M₁ (M₂ × M₃) :=
 { to_fun    := λ m, (f m, g m),
-  map_add'  := λ m i x y, by simp,
-  map_smul' := λ m i c x, by simp }
+  map_add'  := λ _ m i x y, by simp,
+  map_smul' := λ _ m i c x, by simp }
 
 /-- Combine a family of multilinear maps with the same domain and codomains `M' i` into a
 multilinear map taking values in the space of functions `Π i, M' i`. -/
@@ -198,8 +218,8 @@ multilinear map taking values in the space of functions `Π i, M' i`. -/
   [Π i, module R (M' i)] (f : Π i, multilinear_map R M₁ (M' i)) :
   multilinear_map R M₁ (Π i, M' i) :=
 { to_fun := λ m i, f i m,
-  map_add' := λ m i x y, funext $ λ j, (f j).map_add _ _ _ _,
-  map_smul' := λ m i c x, funext $ λ j, (f j).map_smul _ _ _ _ }
+  map_add' := λ _ m i x y, by exactI (funext $ λ j, (f j).map_add _ _ _ _),
+  map_smul' := λ _ m i c x, by exactI (funext $ λ j, (f j).map_smul _ _ _ _) }
 
 section
 variables (R M₂)
@@ -209,19 +229,19 @@ variables (R M₂)
 @[simps]
 def of_subsingleton [subsingleton ι] (i' : ι) : multilinear_map R (λ _ : ι, M₂) M₂ :=
 { to_fun := function.eval i',
-  map_add' := λ m i x y, by
+  map_add' := λ _ m i x y, by
   { rw subsingleton.elim i i', simp only [function.eval, function.update_same], },
-  map_smul' := λ m i r x, by
+  map_smul' := λ _ m i r x, by
   { rw subsingleton.elim i i', simp only [function.eval, function.update_same], } }
 
-variables {M₂}
+variables (M₁) {M₂}
 
 /-- The constant map is multilinear when `ι` is empty. -/
 @[simps {fully_applied := ff}]
 def const_of_is_empty [is_empty ι] (m : M₂) : multilinear_map R M₁ M₂ :=
 { to_fun := function.const _ m,
-  map_add' := λ m, is_empty_elim,
-  map_smul' := λ m, is_empty_elim }
+  map_add' := λ _ m, is_empty_elim,
+  map_smul' := λ _ m, is_empty_elim }
 
 end
 
@@ -234,9 +254,9 @@ def restr {k n : ℕ} (f : multilinear_map R (λ i : fin n, M') M₂) (s : finse
   (hk : s.card = k) (z : M') :
   multilinear_map R (λ i : fin k, M') M₂ :=
 { to_fun    := λ v, f (λ j, if h : j ∈ s then v ((s.order_iso_of_fin hk).symm ⟨j, h⟩) else z),
-  map_add'  := λ v i x y,
+  map_add'  := λ _ v i x y,
     by { erw [dite_comp_equiv_update, dite_comp_equiv_update, dite_comp_equiv_update], simp },
-  map_smul' := λ v i c x, by { erw [dite_comp_equiv_update, dite_comp_equiv_update], simp } }
+  map_smul' := λ _ v i c x, by { erw [dite_comp_equiv_update, dite_comp_equiv_update], simp } }
 variable {R}
 
 /-- In the specific case of multilinear maps on spaces indexed by `fin (n+1)`, where one can build
@@ -279,14 +299,16 @@ then `g (f₁ m₁, ..., fₙ mₙ)` is again a multilinear map, that we call
 def comp_linear_map (g : multilinear_map R M₁' M₂) (f : Π i, M₁ i →ₗ[R] M₁' i) :
   multilinear_map R M₁ M₂ :=
 { to_fun := λ m, g $ λ i, f i (m i),
-  map_add' := λ m i x y,
-    have ∀ j z, f j (update m i z j) = update (λ k, f k (m k)) i (f i z) j :=
+  map_add' := λ _ m i x y, by
+  { resetI,
+    have : ∀ j z, f j (update m i z j) = update (λ k, f k (m k)) i (f i z) j :=
       λ j z, function.apply_update (λ k, f k) _ _ _ _,
-    by simp [this],
-  map_smul' := λ m i c x,
-    have ∀ j z, f j (update m i z j) = update (λ k, f k (m k)) i (f i z) j :=
+    by simp [this] },
+  map_smul' := λ _ m i c x, by
+  { resetI,
+    have : ∀ j z, f j (update m i z j) = update (λ k, f k (m k)) i (f i z) j :=
       λ j z, function.apply_update (λ k, f k) _ _ _ _,
-    by simp [this] }
+    by simp [this] } }
 
 @[simp] lemma comp_linear_map_apply (g : multilinear_map R M₁' M₂) (f : Π i, M₁ i →ₗ[R] M₁' i)
   (m : Π i, M₁ i) :
@@ -336,7 +358,7 @@ the image under a multilinear map `f` is the sum of `f (s.piecewise m m')` along
 `t`. This is mainly an auxiliary statement to prove the result when `t = univ`, given in
 `map_add_univ`, although it can be useful in its own right as it does not require the index set `ι`
 to be finite.-/
-lemma map_piecewise_add (m m' : Πi, M₁ i) (t : finset ι) :
+lemma map_piecewise_add [decidable_eq ι] (m m' : Πi, M₁ i) (t : finset ι) :
   f (t.piecewise (m + m') m') = ∑ s in t.powerset, f (s.piecewise m m') :=
 begin
   revert m',
@@ -368,7 +390,7 @@ end
 
 /-- Additivity of a multilinear map along all coordinates at the same time,
 writing `f (m + m')` as the sum  of `f (s.piecewise m m')` over all sets `s`. -/
-lemma map_add_univ [fintype ι] (m m' : Πi, M₁ i) :
+lemma map_add_univ [decidable_eq ι] [fintype ι] (m m' : Πi, M₁ i) :
   f (m + m') = ∑ s : finset ι, f (s.piecewise m m') :=
 by simpa using f.map_piecewise_add m m' finset.univ
 
@@ -376,7 +398,6 @@ section apply_sum
 
 variables {α : ι → Type*} (g : Π i, α i → M₁ i) (A : Π i, finset (α i))
 
-open_locale classical
 open fintype finset
 
 /-- If `f` is multilinear, then `f (Σ_{j₁ ∈ A₁} g₁ j₁, ..., Σ_{jₙ ∈ Aₙ} gₙ jₙ)` is the sum of
@@ -384,9 +405,10 @@ open fintype finset
 `r n ∈ Aₙ`. This follows from multilinearity by expanding successively with respect to each
 coordinate. Here, we give an auxiliary statement tailored for an inductive proof. Use instead
 `map_sum_finset`. -/
-lemma map_sum_finset_aux [fintype ι] {n : ℕ} (h : ∑ i, (A i).card = n) :
+lemma map_sum_finset_aux [decidable_eq ι] [fintype ι] {n : ℕ} (h : ∑ i, (A i).card = n) :
   f (λ i, ∑ j in A i, g i j) = ∑ r in pi_finset A, f (λ i, g i (r i)) :=
 begin
+  letI := λ i, classical.dec_eq (α i),
   induction n using nat.strong_induction_on with n IH generalizing A,
   -- If one of the sets is empty, then all the sums are zero
   by_cases Ai_empty : ∃ i, A i = ∅,
@@ -520,20 +542,22 @@ end
 `f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions with `r 1 ∈ A₁`, ...,
 `r n ∈ Aₙ`. This follows from multilinearity by expanding successively with respect to each
 coordinate. -/
-lemma map_sum_finset [fintype ι] :
+lemma map_sum_finset [decidable_eq ι] [fintype ι] :
   f (λ i, ∑ j in A i, g i j) = ∑ r in pi_finset A, f (λ i, g i (r i)) :=
 f.map_sum_finset_aux _ _ rfl
 
 /-- If `f` is multilinear, then `f (Σ_{j₁} g₁ j₁, ..., Σ_{jₙ} gₙ jₙ)` is the sum of
 `f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions `r`. This follows from
 multilinearity by expanding successively with respect to each coordinate. -/
-lemma map_sum [fintype ι] [∀ i, fintype (α i)] :
+lemma map_sum [decidable_eq ι] [fintype ι] [∀ i, fintype (α i)] :
   f (λ i, ∑ j, g i j) = ∑ r : Π i, α i, f (λ i, g i (r i)) :=
 f.map_sum_finset g (λ i, finset.univ)
 
-lemma map_update_sum {α : Type*} (t : finset α) (i : ι) (g : α → M₁ i) (m : Π i, M₁ i):
+lemma map_update_sum {α : Type*} [decidable_eq ι] (t : finset α) (i : ι) (g : α → M₁ i)
+  (m : Π i, M₁ i) :
   f (update m i (∑ a in t, g a)) = ∑ a in t, f (update m i (g a)) :=
 begin
+  classical,
   induction t using finset.induction with a t has ih h,
   { simp },
   { simp [finset.sum_insert has, ih] }
@@ -541,17 +565,27 @@ end
 
 end apply_sum
 
+/-- Restrict the codomain of a multilinear map to a submodule.
+
+This is the multilinear version of `linear_map.cod_restrict`. -/
+@[simps]
+def cod_restrict (f : multilinear_map R M₁ M₂) (p : submodule R M₂) (h : ∀ v, f v ∈ p) :
+  multilinear_map R M₁ p :=
+{ to_fun := λ v, ⟨f v, h v⟩,
+  map_add' := λ _ v i x y, subtype.ext $ by exactI multilinear_map.map_add _ _ _ _ _,
+  map_smul' := λ _ v i c x, subtype.ext $ by exactI multilinear_map.map_smul _ _ _ _ _ }
+
 section restrict_scalar
 
-variables (R) {A : Type*} [semiring A] [has_scalar R A] [Π (i : ι), module A (M₁ i)]
+variables (R) {A : Type*} [semiring A] [has_smul R A] [Π (i : ι), module A (M₁ i)]
   [module A M₂] [∀ i, is_scalar_tower R A (M₁ i)] [is_scalar_tower R A M₂]
 
 /-- Reinterpret an `A`-multilinear map as an `R`-multilinear map, if `A` is an algebra over `R`
 and their actions on all involved modules agree with the action of `R` on `A`. -/
 def restrict_scalars (f : multilinear_map A M₁ M₂) : multilinear_map R M₁ M₂ :=
 { to_fun := f,
-  map_add' := f.map_add,
-  map_smul' := λ m i, (f.to_linear_map m i).map_smul_of_tower }
+  map_add' := λ _, by exactI f.map_add,
+  map_smul' := λ _ m i, by exactI (f.to_linear_map m i).map_smul_of_tower }
 
 @[simp] lemma coe_restrict_scalars (f : multilinear_map A M₁ M₂) :
   ⇑(f.restrict_scalars R) = f := rfl
@@ -561,7 +595,7 @@ end restrict_scalar
 
 section
 
-variables {ι₁ ι₂ ι₃ : Type*} [decidable_eq ι₁] [decidable_eq ι₂] [decidable_eq ι₃]
+variables {ι₁ ι₂ ι₃ : Type*}
 
 /-- Transfer the arguments to a map along an equivalence between argument indices.
 
@@ -571,8 +605,12 @@ domain of the domain. -/
 def dom_dom_congr (σ : ι₁ ≃ ι₂) (m : multilinear_map R (λ i : ι₁, M₂) M₃) :
   multilinear_map R (λ i : ι₂, M₂) M₃ :=
 { to_fun := λ v, m (λ i, v (σ i)),
-  map_add' := λ v i a b, by { simp_rw function.update_apply_equiv_apply v, rw m.map_add, },
-  map_smul' := λ v i a b, by { simp_rw function.update_apply_equiv_apply v, rw m.map_smul, }, }
+  map_add' := λ _ v i a b, by
+  { resetI, letI := σ.injective.decidable_eq,
+    simp_rw function.update_apply_equiv_apply v, rw m.map_add, },
+  map_smul' := λ _ v i a b, by
+  { resetI, letI := σ.injective.decidable_eq,
+    simp_rw function.update_apply_equiv_apply v, rw m.map_smul, }, }
 
 lemma dom_dom_congr_trans (σ₁ : ι₁ ≃ ι₂) (σ₂ : ι₂ ≃ ι₃) (m : multilinear_map R (λ i : ι₁, M₂) M₃) :
   m.dom_dom_congr (σ₁.trans σ₂) = (m.dom_dom_congr σ₁).dom_dom_congr σ₂ := rfl
@@ -620,10 +658,25 @@ def comp_multilinear_map (g : M₂ →ₗ[R] M₃) (f : multilinear_map R M₁ M
 @[simp] lemma coe_comp_multilinear_map (g : M₂ →ₗ[R] M₃) (f : multilinear_map R M₁ M₂) :
   ⇑(g.comp_multilinear_map f) = g ∘ f := rfl
 
+@[simp]
 lemma comp_multilinear_map_apply (g : M₂ →ₗ[R] M₃) (f : multilinear_map R M₁ M₂) (m : Π i, M₁ i) :
   g.comp_multilinear_map f m = g (f m) := rfl
 
-variables {ι₁ ι₂ : Type*} [decidable_eq ι₁] [decidable_eq ι₂]
+/-- The multilinear version of `linear_map.subtype_comp_cod_restrict` -/
+@[simp]
+lemma subtype_comp_multilinear_map_cod_restrict (f : multilinear_map R M₁ M₂) (p : submodule R M₂)
+  (h) : p.subtype.comp_multilinear_map (f.cod_restrict p h) = f :=
+multilinear_map.ext $ λ v, rfl
+
+/-- The multilinear version of `linear_map.comp_cod_restrict` -/
+@[simp]
+lemma comp_multilinear_map_cod_restrict (g : M₂ →ₗ[R] M₃) (f : multilinear_map R M₁ M₂)
+  (p : submodule R M₃) (h) :
+  (g.cod_restrict p h).comp_multilinear_map f =
+    (g.comp_multilinear_map f).cod_restrict p (λ v, h (f v)):=
+multilinear_map.ext $ λ v, rfl
+
+variables {ι₁ ι₂ : Type*}
 
 @[simp] lemma comp_multilinear_map_dom_dom_congr (σ : ι₁ ≃ ι₂) (g : M₂ →ₗ[R] M₃)
   (f : multilinear_map R (λ i : ι₁, M') M₂) :
@@ -644,7 +697,7 @@ variables [comm_semiring R] [∀i, add_comm_monoid (M₁ i)] [∀i, add_comm_mon
 map is multiplied by `∏ i in s, c i`. This is mainly an auxiliary statement to prove the result when
 `s = univ`, given in `map_smul_univ`, although it can be useful in its own right as it does not
 require the index set `ι` to be finite. -/
-lemma map_piecewise_smul (c : ι → R) (m : Πi, M₁ i) (s : finset ι) :
+lemma map_piecewise_smul [decidable_eq ι] (c : ι → R) (m : Πi, M₁ i) (s : finset ι) :
   f (s.piecewise (λi, c i • m i) m) = (∏ i in s, c i) • f m :=
 begin
   refine s.induction_on (by simp) _,
@@ -663,9 +716,10 @@ end
 writing `f (λi, c i • m i)` as `(∏ i, c i) • f m`. -/
 lemma map_smul_univ [fintype ι] (c : ι → R) (m : Πi, M₁ i) :
   f (λi, c i • m i) = (∏ i, c i) • f m :=
-by simpa using map_piecewise_smul f c m finset.univ
+by {classical, simpa using map_piecewise_smul f c m finset.univ}
 
-@[simp] lemma map_update_smul [fintype ι] (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i) :
+@[simp] lemma map_update_smul [decidable_eq ι] [fintype ι] (m : Πi, M₁ i) (i : ι) (c : R)
+  (x : M₁ i) :
   f (update (c • m) i x) = c^(fintype.card ι - 1) • f (update m i x) :=
 begin
   have : f ((finset.univ.erase i).piecewise (c • update m i x) (update m i x))
@@ -705,42 +759,49 @@ variables (M₂ M₃ R' A)
 
 /-- `multilinear_map.dom_dom_congr` as a `linear_equiv`. -/
 @[simps apply symm_apply]
-def dom_dom_congr_linear_equiv {ι₁ ι₂} [decidable_eq ι₁] [decidable_eq ι₂] (σ : ι₁ ≃ ι₂) :
+def dom_dom_congr_linear_equiv {ι₁ ι₂} (σ : ι₁ ≃ ι₂) :
   multilinear_map A (λ i : ι₁, M₂) M₃ ≃ₗ[R'] multilinear_map A (λ i : ι₂, M₂) M₃ :=
 { map_smul' := λ c f, by { ext, simp },
   .. (dom_dom_congr_equiv σ : multilinear_map A (λ i : ι₁, M₂) M₃ ≃+
         multilinear_map A (λ i : ι₂, M₂) M₃) }
 
 variables (R M₁)
-
 /-- The dependent version of `multilinear_map.dom_dom_congr_linear_equiv`. -/
 @[simps apply symm_apply]
-def dom_dom_congr_linear_equiv' {ι' : Type*} [decidable_eq ι'] (σ : ι ≃ ι') :
+def dom_dom_congr_linear_equiv' {ι' : Type*} (σ : ι ≃ ι') :
   multilinear_map R M₁ M₂ ≃ₗ[R] multilinear_map R (λ i, M₁ (σ.symm i)) M₂ :=
 { to_fun    := λ f,
   { to_fun    := f ∘ (σ.Pi_congr_left' M₁).symm,
-    map_add'  := λ m i,
+    map_add'  := λ _ m i,
       begin
+        resetI,
+        letI := σ.decidable_eq,
         rw ← σ.apply_symm_apply i,
         intros x y,
         simp only [comp_app, Pi_congr_left'_symm_update, f.map_add],
       end,
-    map_smul' := λ m i c,
+    map_smul' := λ _ m i c,
       begin
+        resetI,
+        letI := σ.decidable_eq,
         rw ← σ.apply_symm_apply i,
         intros x,
         simp only [comp_app, Pi_congr_left'_symm_update, f.map_smul],
       end, },
   inv_fun   := λ f,
   { to_fun    := f ∘ (σ.Pi_congr_left' M₁),
-    map_add'  := λ m i,
+    map_add'  := λ _ m i,
     begin
+      resetI,
+      letI := σ.symm.decidable_eq,
       rw ← σ.symm_apply_apply i,
       intros x y,
       simp only [comp_app, Pi_congr_left'_update, f.map_add],
     end,
-    map_smul' := λ m i c,
+    map_smul' := λ _ m i c,
     begin
+      resetI,
+      letI := σ.symm.decidable_eq,
       rw ← σ.symm_apply_apply i,
       intros x,
       simp only [comp_app, Pi_congr_left'_update, f.map_smul],
@@ -753,7 +814,7 @@ def dom_dom_congr_linear_equiv' {ι' : Type*} [decidable_eq ι'] (σ : ι ≃ ι
 /-- The space of constant maps is equivalent to the space of maps that are multilinear with respect
 to an empty family. -/
 @[simps] def const_linear_equiv_of_is_empty [is_empty ι] : M₂ ≃ₗ[R] multilinear_map R M₁ M₂ :=
-{ to_fun    := multilinear_map.const_of_is_empty R,
+{ to_fun    := multilinear_map.const_of_is_empty R _,
   map_add'  := λ x y, rfl,
   map_smul' := λ t x, rfl,
   inv_fun   := λ f, f 0,
@@ -797,7 +858,8 @@ protected def mk_pi_algebra_fin : multilinear_map R (λ i : fin n, A) A :=
 { to_fun := λ m, (list.of_fn m).prod,
   map_add' :=
     begin
-      intros m i x y,
+      intros dec m i x y,
+      rw subsingleton.elim dec (by apply_instance),
       have : (list.fin_range n).index_of i < n,
         by simpa using list.index_of_lt_length.2 (list.mem_fin_range i),
       simp [list.of_fn_eq_map, (list.nodup_fin_range n).map_update, list.prod_update_nth, add_mul,
@@ -805,7 +867,8 @@ protected def mk_pi_algebra_fin : multilinear_map R (λ i : fin n, A) A :=
     end,
   map_smul' :=
     begin
-      intros m i c x,
+      intros dec m i c x,
+      rw subsingleton.elim dec (by apply_instance),
       have : (list.fin_range n).index_of i < n,
         by simpa using list.index_of_lt_length.2 (list.mem_fin_range i),
       simp [list.of_fn_eq_map, (list.nodup_fin_range n).map_update, list.prod_update_nth, this]
@@ -854,6 +917,23 @@ begin
   refl
 end
 
+lemma mk_pi_ring_eq_iff [fintype ι] {z₁ z₂ : M₂} :
+  multilinear_map.mk_pi_ring R ι z₁ = multilinear_map.mk_pi_ring R ι z₂ ↔ z₁ = z₂ :=
+begin
+  simp_rw [multilinear_map.ext_iff, mk_pi_ring_apply],
+  split; intro h,
+  { simpa using h (λ _, 1) },
+  { intro x, simp [h] }
+end
+
+lemma mk_pi_ring_zero [fintype ι] :
+  multilinear_map.mk_pi_ring R ι (0 : M₂) = 0 :=
+by ext; rw [mk_pi_ring_apply, smul_zero, multilinear_map.zero_apply]
+
+lemma mk_pi_ring_eq_zero_iff [fintype ι] (z : M₂) :
+  multilinear_map.mk_pi_ring R ι z = 0 ↔ z = 0 :=
+by rw [← mk_pi_ring_zero, mk_pi_ring_eq_iff]
+
 end comm_semiring
 
 section range_add_comm_group
@@ -863,32 +943,33 @@ variables [semiring R] [∀i, add_comm_monoid (M₁ i)] [add_comm_group M₂]
 (f g : multilinear_map R M₁ M₂)
 
 instance : has_neg (multilinear_map R M₁ M₂) :=
-⟨λ f, ⟨λ m, - f m, λm i x y, by simp [add_comm], λm i c x, by simp⟩⟩
+⟨λ f, ⟨λ m, - f m, λ _ m i x y, by simp [add_comm], λ _ m i c x, by simp⟩⟩
 
 @[simp] lemma neg_apply (m : Πi, M₁ i) : (-f) m = - (f m) := rfl
 
 instance : has_sub (multilinear_map R M₁ M₂) :=
 ⟨λ f g,
   ⟨λ m, f m - g m,
-   λ m i x y, by { simp only [multilinear_map.map_add, sub_eq_add_neg, neg_add], cc },
-   λ m i c x, by { simp only [map_smul, smul_sub] }⟩⟩
+   λ _ m i x y, by { simp only [multilinear_map.map_add, sub_eq_add_neg, neg_add], cc },
+   λ _ m i c x, by { simp only [multilinear_map.map_smul, smul_sub] }⟩⟩
 
 @[simp] lemma sub_apply (m : Πi, M₁ i) : (f - g) m = f m - g m := rfl
 
 instance : add_comm_group (multilinear_map R M₁ M₂) :=
-by refine
 { zero := (0 : multilinear_map R M₁ M₂),
   add := (+),
   neg := has_neg.neg,
   sub := has_sub.sub,
-  sub_eq_add_neg := _,
-  nsmul := λ n f, ⟨λ m, n • f m, λm i x y, by simp [smul_add], λl i x d, by simp [←smul_comm x n] ⟩,
-  zsmul := λ n f, ⟨λ m, n • f m, λm i x y, by simp [smul_add], λl i x d, by simp [←smul_comm x n] ⟩,
-  zsmul_zero' := _,
-  zsmul_succ' := _,
-  zsmul_neg' := _,
-  .. multilinear_map.add_comm_monoid, .. };
-intros; ext; simp [add_comm, add_left_comm, sub_eq_add_neg, add_smul, nat.succ_eq_add_one]
+  add_left_neg := λ a, multilinear_map.ext $ λ v, add_left_neg _,
+  sub_eq_add_neg := λ a b, multilinear_map.ext $ λ v, sub_eq_add_neg _ _,
+  zsmul := λ n f,
+  { to_fun := λ m, n • f m,
+    map_add' := λ _ m i x y, by simp [smul_add],
+    map_smul' := λ _ l i x d, by simp [←smul_comm x n]},
+  zsmul_zero' := λ a, multilinear_map.ext $ λ v, add_comm_group.zsmul_zero' _,
+  zsmul_succ' := λ z a, multilinear_map.ext $ λ v, add_comm_group.zsmul_succ' _ _,
+  zsmul_neg' := λ z a, multilinear_map.ext $ λ v, add_comm_group.zsmul_neg' _ _,
+  .. multilinear_map.add_comm_monoid }
 
 end range_add_comm_group
 
@@ -898,12 +979,12 @@ variables [semiring R] [∀i, add_comm_group (M₁ i)] [add_comm_group M₂]
 [∀i, module R (M₁ i)] [module R M₂]
 (f : multilinear_map R M₁ M₂)
 
-@[simp] lemma map_neg (m : Πi, M₁ i) (i : ι) (x : M₁ i) :
+@[simp] lemma map_neg [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (x : M₁ i) :
   f (update m i (-x)) = -f (update m i x) :=
-eq_neg_of_add_eq_zero $ by rw [←multilinear_map.map_add, add_left_neg,
+eq_neg_of_add_eq_zero_left $ by rw [←multilinear_map.map_add, add_left_neg,
   f.map_coord_zero i (update_same i 0 m)]
 
-@[simp] lemma map_sub (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
+@[simp] lemma map_sub [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
   f (update m i (x - y)) = f (update m i x) - f (update m i y) :=
 by rw [sub_eq_add_neg, sub_eq_add_neg, multilinear_map.map_add, map_neg]
 
@@ -958,7 +1039,8 @@ def linear_map.uncurry_left
   (f : M 0 →ₗ[R] (multilinear_map R (λ(i : fin n), M i.succ) M₂)) :
   multilinear_map R M M₂ :=
 { to_fun := λm, f (m 0) (tail m),
-  map_add' := λm i x y, begin
+  map_add' := λ dec m i x y, begin
+    rw subsingleton.elim dec (by apply_instance),
     by_cases h : i = 0,
     { subst i,
       rw [update_same, update_same, update_same, f.map_add, add_apply,
@@ -969,7 +1051,8 @@ def linear_map.uncurry_left
       assume x y,
       rw [tail_update_succ, multilinear_map.map_add, tail_update_succ, tail_update_succ] }
   end,
-  map_smul' := λm i c x, begin
+  map_smul' := λ dec m i c x, begin
+    rw subsingleton.elim dec (by apply_instance),
     by_cases h : i = 0,
     { subst i,
       rw [update_same, update_same, tail_update_zero, tail_update_zero,
@@ -978,7 +1061,7 @@ def linear_map.uncurry_left
       revert x,
       rw ← succ_pred i h,
       assume x,
-      rw [tail_update_succ, tail_update_succ, map_smul] }
+      rw [tail_update_succ, tail_update_succ, multilinear_map.map_smul] }
   end }
 
 @[simp] lemma linear_map.uncurry_left_apply
@@ -991,9 +1074,9 @@ def multilinear_map.curry_left
   (f : multilinear_map R M M₂) :
   M 0 →ₗ[R] (multilinear_map R (λ(i : fin n), M i.succ) M₂) :=
 { to_fun := λx,
-  { to_fun    := λm, f (cons x m),
-    map_add'  := λm i y y', by simp,
-    map_smul' := λm i y c, by simp },
+  { to_fun    := λ m, f (cons x m),
+    map_add'  := λ dec m i y y', by { rw subsingleton.elim dec (by apply_instance), simp },
+    map_smul' := λ dec m i y c,  by { rw subsingleton.elim dec (by apply_instance), simp }, },
   map_add' := λx y, by { ext m, exact cons_add f m x y },
   map_smul' := λc x, by { ext m, exact cons_smul f m c x } }
 
@@ -1044,7 +1127,8 @@ def multilinear_map.uncurry_right
   (f : (multilinear_map R (λ(i : fin n), M i.cast_succ) (M (last n) →ₗ[R] M₂))) :
   multilinear_map R M M₂ :=
 { to_fun := λm, f (init m) (m (last n)),
-  map_add' := λm i x y, begin
+  map_add' := λ dec m i x y, begin
+    rw subsingleton.elim dec (by apply_instance),
     by_cases h : i.val < n,
     { have : last n ≠ i := ne.symm (ne_of_lt h),
       rw [update_noteq this, update_noteq this, update_noteq this],
@@ -1059,19 +1143,20 @@ def multilinear_map.uncurry_right
       rw [init_update_last, init_update_last, init_update_last,
           update_same, update_same, update_same, linear_map.map_add] }
   end,
-  map_smul' := λm i c x, begin
+  map_smul' := λ dec m i c x, begin
+    rw subsingleton.elim dec (by apply_instance),
     by_cases h : i.val < n,
     { have : last n ≠ i := ne.symm (ne_of_lt h),
       rw [update_noteq this, update_noteq this],
       revert x,
       rw [(cast_succ_cast_lt i h).symm],
       assume x,
-      rw [init_update_cast_succ, init_update_cast_succ, map_smul, linear_map.smul_apply] },
+      rw [init_update_cast_succ, init_update_cast_succ, multilinear_map.map_smul,
+          linear_map.smul_apply] },
     { revert x,
       rw eq_last_of_not_lt h,
       assume x,
-      rw [update_same, update_same, init_update_last, init_update_last,
-          linear_map.map_smul] }
+      rw [update_same, update_same, init_update_last, init_update_last, map_smul] }
   end }
 
 @[simp] lemma multilinear_map.uncurry_right_apply
@@ -1087,13 +1172,15 @@ def multilinear_map.curry_right (f : multilinear_map R M M₂) :
   { to_fun    := λx, f (snoc m x),
     map_add'  := λx y, by rw f.snoc_add,
     map_smul' := λc x, by simp only [f.snoc_smul, ring_hom.id_apply] },
-  map_add' := λm i x y, begin
+  map_add' := λ dec m i x y, begin
+    rw subsingleton.elim dec (by apply_instance),
     ext z,
     change f (snoc (update m i (x + y)) z)
       = f (snoc (update m i x) z) + f (snoc (update m i y) z),
     rw [snoc_update, snoc_update, snoc_update, f.map_add]
   end,
-  map_smul' := λm i c x, begin
+  map_smul' := λ dec m i c x, begin
+    rw subsingleton.elim dec (by apply_instance),
     ext z,
     change f (snoc (update m i (c • x)) z) = c • f (snoc (update m i x) z),
     rw [snoc_update, snoc_update, f.map_smul]
@@ -1137,7 +1224,7 @@ def multilinear_curry_right_equiv :
 
 namespace multilinear_map
 
-variables {ι' : Type*} [decidable_eq ι'] [decidable_eq (ι ⊕ ι')] {R M₂}
+variables {ι' : Type*} {R M₂}
 
 /-- A multilinear map on `Π i : ι ⊕ ι', M'` defines a multilinear map on `Π i : ι, M'`
 taking values in the space of multilinear maps on `Π i : ι', M'`. -/
@@ -1145,12 +1232,18 @@ def curry_sum (f : multilinear_map R (λ x : ι ⊕ ι', M') M₂) :
   multilinear_map R (λ x : ι, M') (multilinear_map R (λ x : ι', M') M₂) :=
 { to_fun := λ u,
   { to_fun := λ v, f (sum.elim u v),
-    map_add' := λ v i x y, by simp only [← sum.update_elim_inr, f.map_add],
-    map_smul' := λ v i c x, by simp only [← sum.update_elim_inr, f.map_smul] },
-  map_add' := λ u i x y, ext $ λ v,
-    by simp only [multilinear_map.coe_mk, add_apply, ← sum.update_elim_inl, f.map_add],
-  map_smul' := λ u i c x, ext $ λ v,
-    by simp only [multilinear_map.coe_mk, smul_apply, ← sum.update_elim_inl, f.map_smul] }
+    map_add' := λ _ v i x y, by
+    { resetI, letI := classical.dec_eq ι,
+      simp only [← sum.update_elim_inr, f.map_add] },
+    map_smul' := λ _ v i c x, by
+    { resetI, letI := classical.dec_eq ι,
+      simp only [← sum.update_elim_inr, f.map_smul] } },
+  map_add' := λ _ u i x y, ext $ λ v, by
+  { resetI, letI := classical.dec_eq ι',
+    simp only [multilinear_map.coe_mk, add_apply, ← sum.update_elim_inl, f.map_add] },
+  map_smul' := λ _ u i c x, ext $ λ v, by
+  { resetI, letI := classical.dec_eq ι',
+    simp only [multilinear_map.coe_mk, smul_apply, ← sum.update_elim_inl, f.map_smul] } }
 
 @[simp] lemma curry_sum_apply (f : multilinear_map R (λ x : ι ⊕ ι', M') M₂)
   (u : ι → M') (v : ι' → M') :
@@ -1162,12 +1255,20 @@ on `Π i : ι', M'` defines a multilinear map on `Π i : ι ⊕ ι', M'`. -/
 def uncurry_sum (f : multilinear_map R (λ x : ι, M') (multilinear_map R (λ x : ι', M') M₂)) :
   multilinear_map R (λ x : ι ⊕ ι', M') M₂ :=
 { to_fun := λ u, f (u ∘ sum.inl) (u ∘ sum.inr),
-  map_add' := λ u i x y, by cases i;
-    simp only [multilinear_map.map_add, add_apply, sum.update_inl_comp_inl, sum.update_inl_comp_inr,
-      sum.update_inr_comp_inl, sum.update_inr_comp_inr],
-  map_smul' := λ u i c x, by cases i;
-    simp only [map_smul, smul_apply, sum.update_inl_comp_inl, sum.update_inl_comp_inr,
-      sum.update_inr_comp_inl, sum.update_inr_comp_inr] }
+  map_add' := λ _ u i x y, by
+  { resetI,
+    letI := (@sum.inl_injective ι ι').decidable_eq,
+    letI := (@sum.inr_injective ι ι').decidable_eq,
+    cases i;
+    simp only [multilinear_map.map_add, add_apply, sum.update_inl_comp_inl,
+      sum.update_inl_comp_inr, sum.update_inr_comp_inl, sum.update_inr_comp_inr] },
+  map_smul' := λ _ u i c x, by
+  { resetI,
+    letI := (@sum.inl_injective ι ι').decidable_eq,
+    letI := (@sum.inr_injective ι ι').decidable_eq,
+    cases i;
+    simp only [multilinear_map.map_smul, smul_apply, sum.update_inl_comp_inl,
+      sum.update_inl_comp_inr, sum.update_inr_comp_inl, sum.update_inr_comp_inr] } }
 
 @[simp] lemma uncurry_sum_aux_apply
   (f : multilinear_map R (λ x : ι, M') (multilinear_map R (λ x : ι', M') M₂)) (u : ι ⊕ ι' → M') :
@@ -1271,7 +1372,8 @@ def map [nonempty ι] (f : multilinear_map R M₁ M₂) (p : Π i, submodule R (
   sub_mul_action R M₂ :=
 { carrier   := f '' { v | ∀ i, v i ∈ p i},
   smul_mem' := λ c _ ⟨x, hx, hf⟩, let ⟨i⟩ := ‹nonempty ι› in by
-  { refine ⟨update x i (c • x i), λ j, if hij : j = i then _ else _, hf ▸ _⟩,
+  { letI := classical.dec_eq ι,
+    refine ⟨update x i (c • x i), λ j, if hij : j = i then _ else _, hf ▸ _⟩,
     { rw [hij, update_same], exact (p i).smul_mem _ (hx i) },
     { rw [update_noteq hij], exact hx j },
     { rw [f.map_smul, update_eq_self] } } }
@@ -1287,28 +1389,4 @@ f.map (λ i, ⊤)
 
 end submodule
 
-section finite_dimensional
-
-variables [fintype ι] [field R] [add_comm_group M₂] [module R M₂] [finite_dimensional R M₂]
-variables [∀ i, add_comm_group (M₁ i)] [∀ i, module R (M₁ i)] [∀ i, finite_dimensional R (M₁ i)]
-
-instance : finite_dimensional R (multilinear_map R M₁ M₂) :=
-begin
-  suffices : ∀ n (N : fin n → Type*) [∀ i, add_comm_group (N i)],
-    by exactI ∀ [∀ i, module R (N i)], by exactI ∀ [∀ i, finite_dimensional R (N i)],
-    finite_dimensional R (multilinear_map R N M₂),
-  { haveI := this _ (M₁ ∘ (fintype.equiv_fin ι).symm),
-    have e := dom_dom_congr_linear_equiv' R M₁ M₂ (fintype.equiv_fin ι),
-    exact e.symm.finite_dimensional, },
-  intros,
-  induction n with n ih,
-  { exactI (const_linear_equiv_of_is_empty R N M₂ : _).finite_dimensional, },
-  { resetI,
-    suffices : finite_dimensional R (N 0 →ₗ[R] multilinear_map R (λ (i : fin n), N i.succ) M₂),
-    { exact (multilinear_curry_left_equiv R N M₂).finite_dimensional, },
-    apply linear_map.finite_dimensional, },
-end
-
-end finite_dimensional
-
 end multilinear_map
diff --git a/src/linear_algebra/multilinear/basis.lean b/src/linear_algebra/multilinear/basis.lean
index ac96a198b15ec..14f7477bac1da 100644
--- a/src/linear_algebra/multilinear/basis.lean
+++ b/src/linear_algebra/multilinear/basis.lean
@@ -9,6 +9,9 @@ import linear_algebra.multilinear.basic
 /-!
 # Multilinear maps in relation to bases.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves lemmas about the action of multilinear maps on basis vectors.
 
 ## TODO
@@ -51,8 +54,8 @@ end
 are basis vectors. Unlike `basis.ext_multilinear_fin`, this only uses a single basis; a
 dependently-typed version would still be true, but the proof would need a dependently-typed
 version of `dom_dom_congr`. -/
-lemma basis.ext_multilinear [decidable_eq ι] [fintype ι] {f g : multilinear_map R (λ i : ι, M₂) M₃}
+lemma basis.ext_multilinear [finite ι] {f g : multilinear_map R (λ i : ι, M₂) M₃}
   {ι₁ : Type*} (e : basis ι₁ R M₂) (h : ∀ v : ι → ι₁, f (λ i, e (v i)) = g (λ i, e (v i))) :
   f = g :=
-(dom_dom_congr_eq_iff (fintype.equiv_fin ι) f g).mp $
-  basis.ext_multilinear_fin (λ i, e) (λ i, h (i ∘ _))
+by { casesI nonempty_fintype ι, exact (dom_dom_congr_eq_iff (fintype.equiv_fin ι) f g).mp
+    (basis.ext_multilinear_fin (λ i, e) $ λ i, h (i ∘ _)) }
diff --git a/src/linear_algebra/multilinear/finite_dimensional.lean b/src/linear_algebra/multilinear/finite_dimensional.lean
new file mode 100644
index 0000000000000..aa328791e6c38
--- /dev/null
+++ b/src/linear_algebra/multilinear/finite_dimensional.lean
@@ -0,0 +1,66 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import linear_algebra.multilinear.basic
+import linear_algebra.free_module.finite.matrix
+
+/-! # Multilinear maps over finite dimensional spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The main results are that multilinear maps over finitely-generated, free modules are
+finitely-generated and free.
+
+* `module.finite.multilinear_map`
+* `module.free.multilinear_map`
+
+We do not put this in `linear_algebra/multilinear_map/basic` to avoid making the imports too large
+there.
+-/
+
+namespace multilinear_map
+
+variables {ι R M₂ : Type*} {M₁ : ι → Type*}
+variables [finite ι]
+variables [comm_ring R] [add_comm_group M₂] [module R M₂]
+variables [Π i, add_comm_group (M₁ i)] [Π i, module R (M₁ i)]
+variables [module.finite R M₂] [module.free R M₂]
+variables [∀ i, module.finite R (M₁ i)] [∀ i, module.free R (M₁ i)]
+
+-- the induction requires us to show both at once
+private lemma free_and_finite :
+  module.free R (multilinear_map R M₁ M₂) ∧ module.finite R (multilinear_map R M₁ M₂) :=
+begin
+  -- the `fin n` case is sufficient
+  suffices : ∀ n (N : fin n → Type*) [Π i, add_comm_group (N i)],
+    by exactI ∀ [Π i, module R (N i)],
+    by exactI ∀ [∀ i, module.finite R (N i)] [∀ i, module.free R (N i)],
+      module.free R (multilinear_map R N M₂) ∧ module.finite R (multilinear_map R N M₂),
+  { casesI nonempty_fintype ι,
+    casesI this _ (M₁ ∘ (fintype.equiv_fin ι).symm),
+    have e := dom_dom_congr_linear_equiv' R M₁ M₂ (fintype.equiv_fin ι),
+    exact ⟨module.free.of_equiv e.symm, module.finite.equiv e.symm⟩, },
+  introsI n N _ _ _ _,
+  unfreezingI { induction n with n ih },
+  { exact ⟨module.free.of_equiv (const_linear_equiv_of_is_empty R N M₂),
+           module.finite.equiv (const_linear_equiv_of_is_empty R N M₂)⟩ },
+  { suffices :
+      module.free R (N 0 →ₗ[R] multilinear_map R (λ (i : fin n), N i.succ) M₂) ∧
+      module.finite R (N 0 →ₗ[R] multilinear_map R (λ (i : fin n), N i.succ) M₂),
+    { casesI this,
+      exact ⟨module.free.of_equiv (multilinear_curry_left_equiv R N M₂),
+            module.finite.equiv (multilinear_curry_left_equiv R N M₂)⟩ },
+    casesI ih (λ i, N i.succ),
+    exact ⟨module.free.linear_map _ _ _, module.finite.linear_map _ _⟩ },
+end
+
+instance _root_.module.finite.multilinear_map : module.finite R (multilinear_map R M₁ M₂) :=
+free_and_finite.2
+
+instance _root_.module.free.multilinear_map : module.free R (multilinear_map R M₁ M₂) :=
+free_and_finite.1
+
+end multilinear_map
diff --git a/src/linear_algebra/multilinear/tensor_product.lean b/src/linear_algebra/multilinear/tensor_product.lean
index 184a514b7acc2..9047597e1e612 100644
--- a/src/linear_algebra/multilinear/tensor_product.lean
+++ b/src/linear_algebra/multilinear/tensor_product.lean
@@ -8,6 +8,9 @@ import linear_algebra.tensor_product
 
 /-!
 # Constructions relating multilinear maps and tensor products.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 namespace multilinear_map
@@ -18,7 +21,6 @@ open_locale tensor_product
 
 variables {R ι₁ ι₂ ι₃ ι₄ : Type*}
 variables [comm_semiring R]
-variables [decidable_eq ι₁] [decidable_eq ι₂][decidable_eq ι₃] [decidable_eq ι₄]
 variables {N₁ : Type*} [add_comm_monoid N₁] [module R N₁]
 variables {N₂ : Type*} [add_comm_monoid N₂] [module R N₂]
 variables {N : Type*} [add_comm_monoid N] [module R N]
@@ -41,8 +43,16 @@ def dom_coprod
   (a : multilinear_map R (λ _ : ι₁, N) N₁) (b : multilinear_map R (λ _ : ι₂, N) N₂) :
   multilinear_map R (λ _ : ι₁ ⊕ ι₂, N) (N₁ ⊗[R] N₂) :=
 { to_fun := λ v, a (λ i, v (sum.inl i)) ⊗ₜ b (λ i, v (sum.inr i)),
-  map_add' := λ v i p q, by cases i; simp [tensor_product.add_tmul, tensor_product.tmul_add],
-  map_smul' := λ v i c p, by cases i; simp [tensor_product.smul_tmul', tensor_product.tmul_smul] }
+  map_add' := λ _ v i p q, by
+  { resetI,
+    letI := (@sum.inl_injective ι₁ ι₂).decidable_eq,
+    letI := (@sum.inr_injective ι₁ ι₂).decidable_eq,
+    cases i; simp [tensor_product.add_tmul, tensor_product.tmul_add] },
+  map_smul' := λ _ v i c p, by
+  { resetI,
+    letI := (@sum.inl_injective ι₁ ι₂).decidable_eq,
+    letI := (@sum.inr_injective ι₁ ι₂).decidable_eq,
+    cases i; simp [tensor_product.smul_tmul', tensor_product.tmul_smul] } }
 
 /-- A more bundled version of `multilinear_map.dom_coprod` that maps
 `((ι₁ → N) → N₁) ⊗ ((ι₂ → N) → N₂)` to `(ι₁ ⊕ ι₂ → N) → N₁ ⊗ N₂`. -/
diff --git a/src/linear_algebra/orientation.lean b/src/linear_algebra/orientation.lean
index 3864278e92a7f..107bd5f34b839 100644
--- a/src/linear_algebra/orientation.lean
+++ b/src/linear_algebra/orientation.lean
@@ -9,6 +9,9 @@ import linear_algebra.determinant
 /-!
 # Orientations of modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines orientations of modules.
 
 ## Main definitions
@@ -37,10 +40,10 @@ open_locale big_operators
 
 section ordered_comm_semiring
 
-variables (R : Type*) [ordered_comm_semiring R]
+variables (R : Type*) [strict_ordered_comm_semiring R]
 variables (M : Type*) [add_comm_monoid M] [module R M]
 variables {N : Type*} [add_comm_monoid N] [module R N]
-variables (ι : Type*) [decidable_eq ι]
+variables (ι ι' : Type*)
 
 /-- An orientation of a module, intended to be used when `ι` is a `fintype` with the same
 cardinality as a basis. -/
@@ -50,6 +53,8 @@ abbreviation orientation := module.ray R (alternating_map R M R ι)
 class module.oriented :=
 (positive_orientation : orientation R M ι)
 
+export module.oriented (positive_orientation)
+
 variables {R M}
 
 /-- An equivalence between modules implies an equivalence between orientations. -/
@@ -68,30 +73,77 @@ by rw [orientation.map, alternating_map.dom_lcongr_refl, module.ray.map_refl]
 @[simp] lemma orientation.map_symm (e : M ≃ₗ[R] N) :
   (orientation.map ι e).symm = orientation.map ι e.symm := rfl
 
+section reindex
+variables (R M) {ι ι'}
+
+/-- An equivalence between indices implies an equivalence between orientations. -/
+def orientation.reindex (e : ι ≃ ι') : orientation R M ι ≃ orientation R M ι' :=
+module.ray.map $ alternating_map.dom_dom_lcongr R e
+
+@[simp] lemma orientation.reindex_apply (e : ι ≃ ι') (v : alternating_map R M R ι)
+  (hv : v ≠ 0) :
+  orientation.reindex R M e (ray_of_ne_zero _ v hv) = ray_of_ne_zero _ (v.dom_dom_congr e)
+      (mt (v.dom_dom_congr_eq_zero_iff e).mp hv) := rfl
+
+@[simp] lemma orientation.reindex_refl :
+  (orientation.reindex R M $ equiv.refl ι) = equiv.refl _ :=
+by rw [orientation.reindex, alternating_map.dom_dom_lcongr_refl, module.ray.map_refl]
+
+@[simp] lemma orientation.reindex_symm (e : ι ≃ ι') :
+  (orientation.reindex R M e).symm = orientation.reindex R M e.symm := rfl
+
+end reindex
+
+/-- A module is canonically oriented with respect to an empty index type. -/
+@[priority 100] instance is_empty.oriented [nontrivial R] [is_empty ι] :
+  module.oriented R M ι :=
+{ positive_orientation := ray_of_ne_zero R (alternating_map.const_linear_equiv_of_is_empty 1) $
+    alternating_map.const_linear_equiv_of_is_empty.injective.ne (by simp) }
+
+@[simp] lemma orientation.map_positive_orientation_of_is_empty [nontrivial R] [is_empty ι]
+  (f : M ≃ₗ[R] N) :
+  orientation.map ι f positive_orientation = positive_orientation :=
+rfl
+
+@[simp] lemma orientation.map_of_is_empty [is_empty ι] (x : orientation R M ι) (f : M ≃ₗ[R] M) :
+  orientation.map ι f x = x :=
+begin
+  induction x using module.ray.ind with g hg,
+  rw orientation.map_apply,
+  congr,
+  ext i,
+  rw alternating_map.comp_linear_map_apply,
+  congr,
+end
+
 end ordered_comm_semiring
 
 section ordered_comm_ring
 
-variables {R : Type*} [ordered_comm_ring R]
+variables {R : Type*} [strict_ordered_comm_ring R]
 variables {M N : Type*} [add_comm_group M] [add_comm_group N] [module R M] [module R N]
 
-namespace basis
+@[simp] protected lemma orientation.map_neg {ι : Type*} (f : M ≃ₗ[R] N)
+  (x : orientation R M ι) :
+  orientation.map ι f (-x) = - orientation.map ι f x :=
+module.ray.map_neg _ x
 
-variables {ι : Type*} [fintype ι] [decidable_eq ι]
+@[simp] protected lemma orientation.reindex_neg {ι ι' : Type*} (e : ι ≃ ι')
+  (x : orientation R M ι) :
+  orientation.reindex R M e (-x) = - orientation.reindex R M e x :=
+module.ray.map_neg _ x
 
-/-- The orientation given by a basis. -/
-protected def orientation [nontrivial R] (e : basis ι R M) : orientation R M ι :=
-ray_of_ne_zero R _ e.det_ne_zero
+namespace basis
 
-lemma orientation_map [nontrivial R] (e : basis ι R M)
-  (f : M ≃ₗ[R] N) : (e.map f).orientation = orientation.map ι f e.orientation :=
-by simp_rw [basis.orientation, orientation.map_apply, basis.det_map']
+variables {ι ι' : Type*}
 
 /-- The value of `orientation.map` when the index type has the cardinality of a basis, in terms
 of `f.det`. -/
-lemma map_orientation_eq_det_inv_smul (e : basis ι R M)
+lemma map_orientation_eq_det_inv_smul [finite ι] (e : basis ι R M)
   (x : orientation R M ι) (f : M ≃ₗ[R] M) : orientation.map ι f x = (f.det)⁻¹ • x :=
 begin
+  casesI nonempty_fintype ι,
+  letI := classical.dec_eq ι,
   induction x using module.ray.ind with g hg,
   rw [orientation.map_apply, smul_ray_of_ne_zero, ray_eq_iff, units.smul_def,
       (g.comp_linear_map ↑f.symm).eq_smul_basis_det e, g.eq_smul_basis_det e,
@@ -99,17 +151,38 @@ begin
       basis.det_self, mul_one, smul_eq_mul, mul_comm, mul_smul, linear_equiv.coe_inv_det],
 end
 
+variables [fintype ι] [decidable_eq ι] [fintype ι'] [decidable_eq ι']
+
+/-- The orientation given by a basis. -/
+protected def orientation [nontrivial R] (e : basis ι R M) : orientation R M ι :=
+ray_of_ne_zero R _ e.det_ne_zero
+
+lemma orientation_map [nontrivial R] (e : basis ι R M)
+  (f : M ≃ₗ[R] N) : (e.map f).orientation = orientation.map ι f e.orientation :=
+by simp_rw [basis.orientation, orientation.map_apply, basis.det_map']
+
+lemma orientation_reindex [nontrivial R] (e : basis ι R M)
+  (eι : ι ≃ ι') : (e.reindex eι).orientation = orientation.reindex R M eι e.orientation :=
+by simp_rw [basis.orientation, orientation.reindex_apply, basis.det_reindex']
+
 /-- The orientation given by a basis derived using `units_smul`, in terms of the product of those
 units. -/
 lemma orientation_units_smul [nontrivial R] (e : basis ι R M) (w : ι → units R) :
   (e.units_smul w).orientation = (∏ i, w i)⁻¹ • e.orientation :=
 begin
   rw [basis.orientation, basis.orientation, smul_ray_of_ne_zero, ray_eq_iff,
-      e.det.eq_smul_basis_det (e.units_smul w), det_units_smul, units.smul_def, smul_smul],
+      e.det.eq_smul_basis_det (e.units_smul w), det_units_smul_self, units.smul_def, smul_smul],
   norm_cast,
   simp
 end
 
+@[simp] lemma orientation_is_empty [nontrivial R] [is_empty ι] (b : basis ι R M) :
+  b.orientation = positive_orientation :=
+begin
+  congrm ray_of_ne_zero _ _ _,
+  convert b.det_is_empty,
+end
+
 end basis
 
 end ordered_comm_ring
@@ -118,11 +191,36 @@ section linear_ordered_comm_ring
 
 variables {R : Type*} [linear_ordered_comm_ring R]
 variables {M : Type*} [add_comm_group M] [module R M]
-variables {ι : Type*} [decidable_eq ι]
+variables {ι : Type*}
+
+namespace orientation
+
+/-- A module `M` over a linearly ordered commutative ring has precisely two "orientations" with
+respect to an empty index type. (Note that these are only orientations of `M` of in the conventional
+mathematical sense if `M` is zero-dimensional.) -/
+lemma eq_or_eq_neg_of_is_empty [nontrivial R] [is_empty ι] (o : orientation R M ι) :
+  o = positive_orientation ∨ o = - positive_orientation :=
+begin
+  induction o using module.ray.ind with x hx,
+  dsimp [positive_orientation],
+  simp only [ray_eq_iff, same_ray_neg_swap],
+  rw same_ray_or_same_ray_neg_iff_not_linear_independent,
+  intros h,
+  let a : R := alternating_map.const_linear_equiv_of_is_empty.symm x,
+  have H : linear_independent R ![a, 1],
+  { convert h.map' ↑alternating_map.const_linear_equiv_of_is_empty.symm (linear_equiv.ker _),
+    ext i,
+    fin_cases i;
+    simp [a] },
+  rw linear_independent_iff' at H,
+  simpa using H finset.univ ![1, -a] (by simp [fin.sum_univ_succ]) 0 (by simp),
+end
+
+end orientation
 
 namespace basis
 
-variables [fintype ι]
+variables [fintype ι] [decidable_eq ι]
 
 /-- The orientations given by two bases are equal if and only if the determinant of one basis
 with respect to the other is positive. -/
@@ -204,6 +302,26 @@ begin
       simp [units_smul_apply, hi] }
 end
 
+lemma det_adjust_to_orientation [nontrivial R] [nonempty ι] (e : basis ι R M)
+  (x : orientation R M ι) :
+  (e.adjust_to_orientation x).det = e.det ∨ (e.adjust_to_orientation x).det = - e.det :=
+begin
+  dsimp [basis.adjust_to_orientation],
+  split_ifs,
+  { left,
+    refl },
+  { right,
+    simp [e.det_units_smul, ← units.coe_prod, finset.prod_update_of_mem] }
+end
+
+@[simp] lemma abs_det_adjust_to_orientation [nontrivial R] [nonempty ι] (e : basis ι R M)
+  (x : orientation R M ι) (v : ι → M) :
+  |(e.adjust_to_orientation x).det v| = |e.det v| :=
+begin
+  cases e.det_adjust_to_orientation x with h h;
+  simp [h]
+end
+
 end basis
 
 end linear_ordered_comm_ring
@@ -212,20 +330,23 @@ section linear_ordered_field
 
 variables {R : Type*} [linear_ordered_field R]
 variables {M : Type*} [add_comm_group M] [module R M]
-variables {ι : Type*} [decidable_eq ι]
+variables {ι : Type*}
 
 namespace orientation
 
-variables [fintype ι] [finite_dimensional R M]
+variables [fintype ι] [_i : finite_dimensional R M]
 
 open finite_dimensional
 
+include _i
+
 /-- If the index type has cardinality equal to the finite dimension, any two orientations are
 equal or negations. -/
 lemma eq_or_eq_neg (x₁ x₂ : orientation R M ι) (h : fintype.card ι = finrank R M) :
   x₁ = x₂ ∨ x₁ = -x₂ :=
 begin
   have e := (fin_basis R M).reindex (fintype.equiv_fin_of_card_eq h).symm,
+  letI := classical.dec_eq ι,
   rcases e.orientation_eq_or_eq_neg x₁ with h₁|h₁;
     rcases e.orientation_eq_or_eq_neg x₂ with h₂|h₂;
     simp [h₁, h₂]
@@ -247,13 +368,27 @@ begin
   exact e.map_orientation_eq_det_inv_smul x f
 end
 
+omit _i
+
 /-- If the index type has cardinality equal to the finite dimension, composing an alternating
 map with the same linear equiv on each argument gives the same orientation if and only if the
 determinant is positive. -/
 lemma map_eq_iff_det_pos (x : orientation R M ι) (f : M ≃ₗ[R] M)
   (h : fintype.card ι = finrank R M) :
-  orientation.map ι f x = x ↔  0 < (f : M →ₗ[R] M).det :=
-by rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_self_iff, linear_equiv.coe_det]
+  orientation.map ι f x = x ↔ 0 < (f : M →ₗ[R] M).det :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { have H : finrank R M = 0,
+    { refine h.symm.trans _,
+      convert fintype.card_of_is_empty,
+      apply_instance },
+    simp [linear_map.det_eq_one_of_finrank_eq_zero H] },
+  have H : 0 < finrank R M,
+  { rw ← h,
+    exact fintype.card_pos },
+  haveI : finite_dimensional R M := finite_dimensional_of_finrank H,
+  rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_self_iff, linear_equiv.coe_det]
+end
 
 /-- If the index type has cardinality equal to the finite dimension, composing an alternating
 map with the same linear equiv on each argument gives the negation of that orientation if and
@@ -261,16 +396,31 @@ only if the determinant is negative. -/
 lemma map_eq_neg_iff_det_neg (x : orientation R M ι) (f : M ≃ₗ[R] M)
   (h : fintype.card ι = finrank R M) :
   orientation.map ι f x = -x ↔ (f : M →ₗ[R] M).det < 0 :=
-by rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_neg_iff, linear_equiv.coe_det]
+begin
+  casesI is_empty_or_nonempty ι,
+  { have H : finrank R M = 0,
+    { refine h.symm.trans _,
+      convert fintype.card_of_is_empty,
+      apply_instance },
+    simp [linear_map.det_eq_one_of_finrank_eq_zero H, module.ray.ne_neg_self x] },
+  have H : 0 < finrank R M,
+  { rw ← h,
+    exact fintype.card_pos },
+  haveI : finite_dimensional R M := finite_dimensional_of_finrank H,
+  rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_neg_iff, linear_equiv.coe_det]
+end
+
+include _i
 
 /-- If the index type has cardinality equal to the finite dimension, a basis with the given
 orientation. -/
-def some_basis [nonempty ι] (x : orientation R M ι) (h : fintype.card ι = finrank R M) :
+def some_basis [nonempty ι] [decidable_eq ι] (x : orientation R M ι)
+  (h : fintype.card ι = finrank R M) :
   basis ι R M :=
 ((fin_basis R M).reindex (fintype.equiv_fin_of_card_eq h).symm).adjust_to_orientation x
 
 /-- `some_basis` gives a basis with the required orientation. -/
-@[simp] lemma some_basis_orientation [nonempty ι] (x : orientation R M ι)
+@[simp] lemma some_basis_orientation [nonempty ι] [decidable_eq ι] (x : orientation R M ι)
   (h : fintype.card ι = finrank R M) : (x.some_basis h).orientation = x :=
 basis.orientation_adjust_to_orientation _ _
 
diff --git a/src/linear_algebra/pi.lean b/src/linear_algebra/pi.lean
index 17521b57d695f..d7126156e85c6 100644
--- a/src/linear_algebra/pi.lean
+++ b/src/linear_algebra/pi.lean
@@ -9,6 +9,9 @@ import logic.equiv.fin
 /-!
 # Pi types of modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines constructors for linear maps whose domains or codomains are pi types.
 
 It contains theorems relating these to each other, as well as to `linear_map.ker`.
@@ -39,10 +42,10 @@ variables [semiring R] [add_comm_monoid M₂] [module R M₂] [add_comm_monoid M
 
 /-- `pi` construction for linear functions. From a family of linear functions it produces a linear
 function into a family of modules. -/
-def pi (f : Πi, M₂ →ₗ[R] φ i) : M₂ →ₗ[R] (Πi, φ i) :=
+def pi (f : Π i, M₂ →ₗ[R] φ i) : M₂ →ₗ[R] (Π i, φ i) :=
 { to_fun := λ c i, f i c,
-  map_add' := λ c d, funext $ λ i, (f i).map_add _ _,
-  map_smul' := λ c d, funext $ λ i, (f i).map_smul _ _ }
+  map_smul' := λ c d, funext $ λ i, (f i).map_smul _ _,
+  .. pi.add_hom (λ i, (f i).to_add_hom) }
 
 @[simp] lemma pi_apply (f : Πi, M₂ →ₗ[R] φ i) (c : M₂) (i : ι) :
   pi f c i = f i c := rfl
@@ -73,7 +76,7 @@ lemma proj_apply (i : ι) (b : Πi, φ i) : (proj i : (Πi, φ i) →ₗ[R] φ i
 lemma proj_pi (f : Πi, M₂ →ₗ[R] φ i) (i : ι) : (proj i).comp (pi f) = f i :=
 ext $ assume c, rfl
 
-lemma infi_ker_proj : (⨅i, ker (proj i) : submodule R (Πi, φ i)) = ⊥ :=
+lemma infi_ker_proj : (⨅i, ker (proj i : (Πi, φ i) →ₗ[R] φ i) : submodule R (Πi, φ i)) = ⊥ :=
 bot_unique $ set_like.le_def.2 $ assume a h,
 begin
   simp only [mem_infi, mem_ker, proj_apply] at h,
@@ -120,11 +123,16 @@ families of functions on these modules. See note [bundled maps over different ri
       rw finset.univ_sum_single
     end }
 
+@[simp] lemma lsum_single {ι R : Type*} [fintype ι] [decidable_eq ι] [comm_ring R]
+  {M : ι → Type*} [∀ i, add_comm_group (M i)] [∀ i, module R (M i)] :
+  linear_map.lsum R M R linear_map.single = linear_map.id :=
+linear_map.ext (λ x, by simp [finset.univ_sum_single])
+
 variables {R φ}
 
 section ext
 
-variables [fintype ι] [decidable_eq ι] [add_comm_monoid M] [module R M]
+variables [finite ι] [decidable_eq ι] [add_comm_monoid M] [module R M]
   {f g : (Π i, φ i) →ₗ[R] M}
 
 lemma pi_ext (h : ∀ i x, f (pi.single i x) = g (pi.single i x)) :
@@ -154,7 +162,7 @@ variables (R φ)
 `φ` is linearly equivalent to the product over `I`. -/
 def infi_ker_proj_equiv {I J : set ι} [decidable_pred (λi, i ∈ I)]
   (hd : disjoint I J) (hu : set.univ ⊆ I ∪ J) :
-  (⨅i ∈ J, ker (proj i) : submodule R (Πi, φ i)) ≃ₗ[R] (Πi:I, φ i) :=
+  (⨅i ∈ J, ker (proj i : (Πi, φ i) →ₗ[R] φ i) : submodule R (Πi, φ i)) ≃ₗ[R] (Πi:I, φ i) :=
 begin
   refine linear_equiv.of_linear
     (pi $ λi, (proj (i:ι)).comp (submodule.subtype _))
@@ -162,7 +170,7 @@ begin
   { assume b,
     simp only [mem_infi, mem_ker, funext_iff, proj_apply, pi_apply],
     assume j hjJ,
-    have : j ∉ I := assume hjI, hd ⟨hjI, hjJ⟩,
+    have : j ∉ I := assume hjI, hd.le_bot ⟨hjI, hjJ⟩,
     rw [dif_neg this, zero_apply] },
   { simp only [pi_comp, comp_assoc, subtype_comp_cod_restrict, proj_pi, subtype.coe_prop],
     ext b ⟨j, hj⟩,
@@ -230,15 +238,16 @@ set_like.coe_injective $ set.pi_univ _
 lemma pi_mono {s : set ι} (h : ∀ i ∈ s, p i ≤ q i) : pi s p ≤ pi s q :=
 set.pi_mono h
 
-lemma binfi_comap_proj : (⨅ i ∈ I, comap (proj i) (p i)) = pi I p :=
+lemma binfi_comap_proj : (⨅ i ∈ I, comap (proj i : (Πi, φ i) →ₗ[R] φ i) (p i)) = pi I p :=
 by { ext x, simp }
 
-lemma infi_comap_proj : (⨅ i, comap (proj i) (p i)) = pi set.univ p :=
+lemma infi_comap_proj : (⨅ i, comap (proj i : (Πi, φ i) →ₗ[R] φ i) (p i)) = pi set.univ p :=
 by { ext x, simp }
 
-lemma supr_map_single [decidable_eq ι] [fintype ι] :
-  (⨆ i, map (linear_map.single i) (p i)) = pi set.univ p :=
+lemma supr_map_single [decidable_eq ι] [finite ι] :
+  (⨆ i, map (linear_map.single i : φ i →ₗ[R] (Πi, φ i)) (p i)) = pi set.univ p :=
 begin
+  casesI nonempty_fintype ι,
   refine (supr_le $ λ i, _).antisymm _,
   { rintro _ ⟨x, hx : x ∈ p i, rfl⟩ j -,
     rcases em (j = i) with rfl|hj; simp * },
@@ -247,6 +256,17 @@ begin
     exact sum_mem_supr (λ i, mem_map_of_mem (hx i trivial)) }
 end
 
+lemma le_comap_single_pi [decidable_eq ι] (p : Π i, submodule R (φ i)) {i} :
+  p i ≤ submodule.comap (linear_map.single i : φ i →ₗ[R] _) (submodule.pi set.univ p) :=
+begin
+  intros x hx,
+  rw [submodule.mem_comap, submodule.mem_pi],
+  rintros j -,
+  by_cases h : j = i,
+  { rwa [h, linear_map.coe_single, pi.single_eq_same] },
+  { rw [linear_map.coe_single, pi.single_eq_of_ne h], exact (p j).zero_mem }
+end
+
 end submodule
 
 namespace linear_equiv
diff --git a/src/linear_algebra/pi_tensor_product.lean b/src/linear_algebra/pi_tensor_product.lean
index 2173c91696c5c..11fbb0d2578f3 100644
--- a/src/linear_algebra/pi_tensor_product.lean
+++ b/src/linear_algebra/pi_tensor_product.lean
@@ -10,6 +10,9 @@ import linear_algebra.multilinear.tensor_product
 /-!
 # Tensor product of an indexed family of modules over commutative semirings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the tensor product of an indexed family `s : ι → Type*` of modules over commutative
 semirings. We denote this space by `⨂[R] i, s i` and define it as `free_add_monoid (R × Π i, s i)`
 quotiented by the appropriate equivalence relation. The treatment follows very closely that of the
@@ -42,6 +45,10 @@ binary tensor product in `linear_algebra/tensor_product.lean`.
 * We have not restricted the index type `ι` to be a `fintype`, as nothing we do here strictly
   requires it. However, problems may arise in the case where `ι` is infinite; use at your own
   caution.
+* Instead of requiring `decidable_eq ι` as an argument to `pi_tensor_product` itself, we include it
+  as an argument in the constructors of the relation. A decidability isntance still has to come
+  from somewhere due to the use of `function.update`, but this hides it from the downstream user.
+  See the implementation notes for `multilinear_map` for an extended discussion of this choice.
 
 ## TODO
 
@@ -60,7 +67,7 @@ open function
 
 section semiring
 
-variables {ι ι₂ ι₃ : Type*} [decidable_eq ι] [decidable_eq ι₂] [decidable_eq ι₃]
+variables {ι ι₂ ι₃ : Type*}
 variables {R : Type*} [comm_semiring R]
 variables {R₁ R₂ : Type*}
 variables {s : ι → Type*} [∀ i, add_comm_monoid (s i)] [∀ i, module R (s i)]
@@ -77,13 +84,13 @@ the tensor product. -/
 inductive eqv : free_add_monoid (R × Π i, s i) → free_add_monoid (R × Π i, s i) → Prop
 | of_zero : ∀ (r : R) (f : Π i, s i) (i : ι) (hf : f i = 0), eqv (free_add_monoid.of (r, f)) 0
 | of_zero_scalar : ∀ (f : Π i, s i), eqv (free_add_monoid.of (0, f)) 0
-| of_add : ∀ (r : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i), eqv
+| of_add : ∀ (inst : decidable_eq ι) (r : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i), eqv
     (free_add_monoid.of (r, update f i m₁) + free_add_monoid.of (r, update f i m₂))
     (free_add_monoid.of (r, update f i (m₁ + m₂)))
 | of_add_scalar : ∀ (r r' : R) (f : Π i, s i), eqv
     (free_add_monoid.of (r, f) + free_add_monoid.of (r', f))
     (free_add_monoid.of (r + r', f))
-| of_smul : ∀ (r : R) (f : Π i, s i) (i : ι) (r' : R), eqv
+| of_smul : ∀ (inst : decidable_eq ι) (r : R) (f : Π i, s i) (i : ι) (r' : R), eqv
     (free_add_monoid.of (r, update f i (r' • (f i))))
     (free_add_monoid.of (r' * r, f))
 | add_comm : ∀ x y, eqv (x + y) (y + x)
@@ -100,8 +107,8 @@ def pi_tensor_product : Type* :=
 variables {R}
 
 /- This enables the notation `⨂[R] i : ι, s i` for the pi tensor product, given `s : ι → Type*`. -/
-localized "notation `⨂[`:100 R `] ` binders `, ` r:(scoped:67 f, pi_tensor_product R f) := r"
-  in tensor_product
+localized "notation (name := pi_tensor_product)
+  `⨂[`:100 R `] ` binders `, ` r:(scoped:67 f, pi_tensor_product R f) := r" in tensor_product
 
 open_locale tensor_product
 
@@ -131,21 +138,21 @@ quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_zero_scalar _
 lemma zero_tprod_coeff' (z : R) (f : Π i, s i) (i : ι) (hf: f i = 0) : tprod_coeff R z f = 0 :=
 quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_zero _ _ i hf
 
-lemma add_tprod_coeff (z : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i) :
+lemma add_tprod_coeff [decidable_eq ι] (z : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i) :
   tprod_coeff R z (update f i m₁) + tprod_coeff R z (update f i m₂) =
     tprod_coeff R z (update f i (m₁ + m₂)) :=
-quotient.sound' $ add_con_gen.rel.of _ _ (eqv.of_add z f i m₁ m₂)
+quotient.sound' $ add_con_gen.rel.of _ _ (eqv.of_add _ z f i m₁ m₂)
 
 lemma add_tprod_coeff' (z₁ z₂ : R) (f : Π i, s i) :
   tprod_coeff R z₁ f + tprod_coeff R z₂ f = tprod_coeff R (z₁ + z₂) f :=
 quotient.sound' $ add_con_gen.rel.of _ _ (eqv.of_add_scalar z₁ z₂ f)
 
-lemma smul_tprod_coeff_aux (z : R) (f : Π i, s i) (i : ι) (r : R) :
+lemma smul_tprod_coeff_aux [decidable_eq ι] (z : R) (f : Π i, s i) (i : ι) (r : R) :
   tprod_coeff R z (update f i (r • f i)) = tprod_coeff R (r * z) f :=
- quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_smul _ _ _ _
+ quotient.sound' $ add_con_gen.rel.of _ _ $ eqv.of_smul _ _ _ _ _
 
-lemma smul_tprod_coeff (z : R) (f : Π i, s i) (i : ι) (r : R₁)
-  [has_scalar R₁ R] [is_scalar_tower R₁ R R] [has_scalar R₁ (s i)] [is_scalar_tower R₁ R (s i)] :
+lemma smul_tprod_coeff [decidable_eq ι] (z : R) (f : Π i, s i) (i : ι) (r : R₁)
+  [has_smul R₁ R] [is_scalar_tower R₁ R R] [has_smul R₁ (s i)] [is_scalar_tower R₁ R (s i)] :
   tprod_coeff R z (update f i (r • f i)) = tprod_coeff R (r • z) f :=
 begin
   have h₁ : r • z = (r • (1 : R)) * z := by rw [smul_mul_assoc, one_mul],
@@ -159,11 +166,11 @@ end
 def lift_add_hom (φ : (R × Π i, s i) → F)
   (C0 : ∀ (r : R) (f : Π i, s i) (i : ι) (hf : f i = 0), φ (r, f) = 0)
   (C0' : ∀ (f : Π i, s i), φ (0, f) = 0)
-  (C_add : ∀ (r : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i),
+  (C_add : ∀ [decidable_eq ι] (r : R) (f : Π i, s i) (i : ι) (m₁ m₂ : s i), by exactI
     φ (r, update f i m₁) + φ (r, update f i m₂) = φ (r, update f i (m₁ + m₂)))
   (C_add_scalar : ∀ (r r' : R) (f : Π i, s i),
     φ (r , f) + φ (r', f) = φ (r + r', f))
-  (C_smul : ∀ (r : R) (f : Π i, s i) (i : ι) (r' : R),
+  (C_smul : ∀ [decidable_eq ι] (r : R) (f : Π i, s i) (i : ι) (r' : R), by exactI
     φ (r, update f i (r' • (f i))) = φ (r' * r, f))
 : (⨂[R] i, s i) →+ F :=
 (add_con_gen (pi_tensor_product.eqv R s)).lift (free_add_monoid.lift φ) $ add_con.add_con_gen_le $
@@ -172,12 +179,12 @@ def lift_add_hom (φ : (R × Π i, s i) → F)
     by simp [free_add_monoid.lift_eval_of, C0 r' f i hf]
 | _, _, (eqv.of_zero_scalar f)        := (add_con.ker_rel _).2 $
     by simp [free_add_monoid.lift_eval_of, C0']
-| _, _, (eqv.of_add z f i m₁ m₂)      := (add_con.ker_rel _).2 $
-    by simp [free_add_monoid.lift_eval_of, C_add]
+| _, _, (eqv.of_add inst z f i m₁ m₂)      := (add_con.ker_rel _).2 $
+    by simp [free_add_monoid.lift_eval_of, @C_add inst]
 | _, _, (eqv.of_add_scalar z₁ z₂ f)      := (add_con.ker_rel _).2 $
     by simp [free_add_monoid.lift_eval_of, C_add_scalar]
-| _, _, (eqv.of_smul z f i r')     := (add_con.ker_rel _).2 $
-    by simp [free_add_monoid.lift_eval_of, C_smul]
+| _, _, (eqv.of_smul inst z f i r')     := (add_con.ker_rel _).2 $
+    by simp [free_add_monoid.lift_eval_of, @C_smul inst]
 | _, _, (eqv.add_comm x y)         := (add_con.ker_rel _).2 $
     by simp_rw [add_monoid_hom.map_add, add_comm]
 end
@@ -205,7 +212,7 @@ variables [monoid R₂] [distrib_mul_action R₂ R] [smul_comm_class R₂ R R]
 
 -- Most of the time we want the instance below this one, which is easier for typeclass resolution
 -- to find.
-instance has_scalar' : has_scalar R₁ (⨂[R] i, s i) :=
+instance has_smul' : has_smul R₁ (⨂[R] i, s i) :=
 ⟨λ r, lift_add_hom (λ f : R × Π i, s i, tprod_coeff R (r • f.1) f.2)
   (λ r' f i hf, by simp_rw [zero_tprod_coeff' _ f i hf])
   (λ f, by simp [zero_tprod_coeff])
@@ -213,7 +220,7 @@ instance has_scalar' : has_scalar R₁ (⨂[R] i, s i) :=
   (λ r' r'' f, by simp [add_tprod_coeff', mul_add])
   (λ z f i r', by simp [smul_tprod_coeff, mul_smul_comm])⟩
 
-instance : has_scalar R (⨂[R] i, s i) := pi_tensor_product.has_scalar'
+instance : has_smul R (⨂[R] i, s i) := pi_tensor_product.has_smul'
 
 lemma smul_tprod_coeff' (r : R₁) (z : R) (f : Π i, s i) :
   r • (tprod_coeff R z f) = tprod_coeff R (r • z) f := rfl
@@ -238,7 +245,7 @@ instance smul_comm_class' [smul_comm_class R₁ R₂ R] : smul_comm_class R₁ R
   (λ xr xf, by simp only [smul_tprod_coeff', smul_comm])
   (λ z y ihz ihy, by simp_rw [pi_tensor_product.smul_add, ihz, ihy])⟩
 
-instance is_scalar_tower' [has_scalar R₁ R₂] [is_scalar_tower R₁ R₂ R] :
+instance is_scalar_tower' [has_smul R₁ R₂] [is_scalar_tower R₁ R₂ R] :
   is_scalar_tower R₁ R₂ (⨂[R] i, s i) :=
 ⟨λ r' r'' x, pi_tensor_product.induction_on' x
   (λ xr xf, by simp only [smul_tprod_coeff', smul_assoc])
@@ -269,9 +276,9 @@ variables (R)
 /-- The canonical `multilinear_map R s (⨂[R] i, s i)`. -/
 def tprod : multilinear_map R s (⨂[R] i, s i) :=
 { to_fun := tprod_coeff R 1,
-  map_add' := λ f i x y, (add_tprod_coeff (1 : R) f i x y).symm,
-  map_smul' := λ f i r x,
-    by simp_rw [smul_tprod_coeff', ←smul_tprod_coeff (1 : R) _ i, update_idem, update_same] }
+  map_add' := λ _ f i x y, by exactI (add_tprod_coeff (1 : R) f i x y).symm,
+  map_smul' := λ _ f i r x, by
+    resetI; simp_rw [smul_tprod_coeff', ←smul_tprod_coeff (1 : R) _ i, update_idem, update_same] }
 
 variables {R}
 
@@ -323,9 +330,9 @@ def lift_aux (φ : multilinear_map R s E) : (⨂[R] i, s i) →+ E :=
   lift_add_hom (λ (p : R × Π i, s i), p.1 • (φ p.2))
     (λ z f i hf, by rw [map_coord_zero φ i hf, smul_zero])
     (λ f, by rw [zero_smul])
-    (λ z f i m₁ m₂, by rw [←smul_add, φ.map_add])
+    (λ _ z f i m₁ m₂, by { resetI, rw [←smul_add, φ.map_add] })
     (λ z₁ z₂ f, by rw [←add_smul])
-    (λ z f i r, by simp [φ.map_smul, smul_smul, mul_comm])
+    (λ _ z f i r, by { resetI, simp [φ.map_smul, smul_smul, mul_comm] })
 
 lemma lift_aux_tprod (φ : multilinear_map R s E) (f : Π i, s i) : lift_aux φ (tprod R f) = φ f :=
 by simp only [lift_aux, lift_add_hom, tprod, multilinear_map.coe_mk, tprod_coeff,
@@ -397,7 +404,7 @@ end
 
 @[simp] lemma reindex_tprod (e : ι ≃ ι₂) (f : Π i, M) :
   reindex R M e (tprod R f) = tprod R (λ i, f (e.symm i)) :=
-lift.tprod f
+lift_aux_tprod _ f
 
 @[simp] lemma reindex_comp_tprod (e : ι ≃ ι₂) :
   (reindex R M e : ⨂[R] i : ι, M →ₗ[R] ⨂[R] i : ι₂, M).comp_multilinear_map (tprod R) =
@@ -444,7 +451,7 @@ variables (ι)
 /-- The tensor product over an empty index type `ι` is isomorphic to the base ring. -/
 @[simps symm_apply]
 def is_empty_equiv [is_empty ι] : ⨂[R] i : ι, M ≃ₗ[R] R :=
-{ to_fun := lift (const_of_is_empty R 1),
+{ to_fun := lift (const_of_is_empty R _ 1),
   inv_fun := λ r, r • tprod R (@is_empty_elim _ _ _),
   left_inv := λ x, by
   { apply x.induction_on,
@@ -479,7 +486,7 @@ def subsingleton_equiv [subsingleton ι] (i₀ : ι) : ⨂[R] i : ι, M ≃ₗ[R
     apply x.induction_on,
     { intros r f,
       simp only [linear_map.map_smul, lift.tprod, of_subsingleton_apply, function.eval,
-                 this f, map_smul, update_eq_self], },
+                 this f, multilinear_map.map_smul, update_eq_self], },
     { intros x y hx hy,
       simp only [multilinear_map.map_add, this 0 (_ + _), linear_map.map_add, ←this 0 (lift _ _),
         hx, hy] } },
@@ -558,7 +565,7 @@ namespace pi_tensor_product
 open pi_tensor_product
 open_locale tensor_product
 
-variables {ι : Type*} [decidable_eq ι] {R : Type*} [comm_ring R]
+variables {ι : Type*} {R : Type*} [comm_ring R]
 variables {s : ι → Type*} [∀ i, add_comm_group (s i)] [∀ i, module R (s i)]
 
 /- Unlike for the binary tensor product, we require `R` to be a `comm_ring` here, otherwise
diff --git a/src/linear_algebra/prod.lean b/src/linear_algebra/prod.lean
index a2898792568a7..546d089982d5b 100644
--- a/src/linear_algebra/prod.lean
+++ b/src/linear_algebra/prod.lean
@@ -5,10 +5,13 @@ Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Eric W
 -/
 import linear_algebra.span
 import order.partial_sups
-import algebra.algebra.basic
+import algebra.algebra.prod
 
 /-! ### Products of modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines constructors for linear maps whose domains or codomains are products.
 
 It contains theorems relating these to each other, as well as to `submodule.prod`, `submodule.map`,
@@ -222,6 +225,9 @@ prod_ext_iff.2 ⟨hl, hr⟩
 def prod_map (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₄) : (M × M₂) →ₗ[R] (M₃ × M₄) :=
 (f.comp (fst R M M₂)).prod (g.comp (snd R M M₂))
 
+lemma coe_prod_map (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₄) :
+  ⇑(f.prod_map g) = prod.map f g := rfl
+
 @[simp] theorem prod_map_apply (f : M →ₗ[R] M₃) (g : M₂ →ₗ[R] M₄) (x) :
   f.prod_map g x = (f x.1, g x.2) := rfl
 
@@ -331,17 +337,19 @@ submodule.ext $ λ x, by simp [mem_sup]
 lemma is_compl_range_inl_inr : is_compl (inl R M M₂).range (inr R M M₂).range :=
 begin
   split,
-  { rintros ⟨_, _⟩ ⟨⟨x, hx⟩, ⟨y, hy⟩⟩,
+  { rw disjoint_def,
+    rintros ⟨_, _⟩ ⟨x, hx⟩ ⟨y, hy⟩,
     simp only [prod.ext_iff, inl_apply, inr_apply, mem_bot] at hx hy ⊢,
     exact ⟨hy.1.symm, hx.2.symm⟩ },
-  { rintros ⟨x, y⟩ -,
+  { rw codisjoint_iff_le_sup,
+    rintros ⟨x, y⟩ -,
     simp only [mem_sup, mem_range, exists_prop],
     refine ⟨(x, 0), ⟨x, rfl⟩, (0, y), ⟨y, rfl⟩, _⟩,
     simp }
 end
 
 lemma sup_range_inl_inr : (inl R M M₂).range ⊔ (inr R M M₂).range = ⊤ :=
-is_compl_range_inl_inr.sup_eq_top
+is_compl.sup_eq_top is_compl_range_inl_inr
 
 lemma disjoint_inl_inr : disjoint (inl R M M₂).range (inr R M M₂).range :=
 by simp [disjoint_def, @eq_comm M 0, @eq_comm M₂ 0] {contextual := tt}; intros; refl
@@ -551,6 +559,28 @@ def prod_comm (R M N : Type*) [semiring R] [add_comm_monoid M] [add_comm_monoid
   map_smul' := λ r ⟨m, n⟩, rfl,
   ..add_equiv.prod_comm }
 
+section
+variables (R M M₂ M₃ M₄)
+variables [semiring R]
+variables [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [add_comm_monoid M₄]
+variables [module R M] [module R M₂] [module R M₃] [module R M₄]
+
+/-- Four-way commutativity of `prod`. The name matches `mul_mul_mul_comm`. -/
+@[simps apply]
+def prod_prod_prod_comm : ((M × M₂) × (M₃ × M₄)) ≃ₗ[R] (M × M₃) × (M₂ × M₄) :=
+{ to_fun := λ mnmn, ((mnmn.1.1, mnmn.2.1), (mnmn.1.2, mnmn.2.2)),
+  inv_fun := λ mmnn, ((mmnn.1.1, mmnn.2.1), (mmnn.1.2, mmnn.2.2)),
+  map_smul' := λ c mnmn, rfl,
+  ..add_equiv.prod_prod_prod_comm M M₂ M₃ M₄ }
+
+@[simp] lemma prod_prod_prod_comm_symm :
+  (prod_prod_prod_comm R M M₂ M₃ M₄).symm = prod_prod_prod_comm R M M₃ M₂ M₄ := rfl
+
+@[simp] lemma prod_prod_prod_comm_to_add_equiv :
+  (prod_prod_prod_comm R M M₂ M₃ M₄).to_add_equiv = add_equiv.prod_prod_prod_comm M M₂ M₃ M₄ := rfl
+
+end
+
 section
 
 variables [semiring R]
@@ -562,9 +592,8 @@ variables (e₁ : M ≃ₗ[R] M₂) (e₂ : M₃ ≃ₗ[R] M₄)
 /-- Product of linear equivalences; the maps come from `equiv.prod_congr`. -/
 protected def prod :
   (M × M₃) ≃ₗ[R] (M₂ × M₄) :=
-{ map_add'  := λ x y, prod.ext (e₁.map_add _ _) (e₂.map_add _ _),
-  map_smul' := λ c x, prod.ext (e₁.map_smulₛₗ c _) (e₂.map_smulₛₗ c _),
-  .. equiv.prod_congr e₁.to_equiv e₂.to_equiv }
+{ map_smul' := λ c x, prod.ext (e₁.map_smulₛₗ c _) (e₂.map_smulₛₗ c _),
+  .. e₁.to_add_equiv.prod_congr e₂.to_add_equiv }
 
 lemma prod_symm : (e₁.prod e₂).symm = e₁.symm.prod e₂.symm := rfl
 
@@ -623,9 +652,8 @@ begin
   have : y - x ∈ ker f ⊔ ker g, { simp only [h, mem_top] },
   rcases mem_sup.1 this with ⟨x', hx', y', hy', H⟩,
   refine ⟨x' + x, _, _⟩,
-  { rwa add_sub_cancel },
-  { rwa [← eq_sub_iff_add_eq.1 H, add_sub_add_right_eq_sub, ← neg_mem_iff, neg_sub,
-      add_sub_cancel'] }
+  { simp only [mem_ker.mp hx', map_add, zero_add]},
+  { simp [←eq_sub_iff_add_eq.1 H, map_add, add_left_inj, self_eq_add_right, mem_ker.mp hy'] }
 end
 
 end linear_map
@@ -687,7 +715,7 @@ Give an injective map `f : M × N →ₗ[R] M` we can find a nested sequence of
 all isomorphic to `M`.
 -/
 def tunnel (f : M × N →ₗ[R] M) (i : injective f) : ℕ →o (submodule R M)ᵒᵈ :=
-⟨λ n, (tunnel' f i n).1, monotone_nat_of_le_succ (λ n, begin
+⟨λ n, order_dual.to_dual (tunnel' f i n).1, monotone_nat_of_le_succ (λ n, begin
     dsimp [tunnel', tunnel_aux],
     rw [submodule.map_comp, submodule.map_comp],
     apply submodule.map_subtype_le,
@@ -706,7 +734,7 @@ def tailing_linear_equiv (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
   (tunnel_aux_injective f i (tunnel' f i n))).symm.trans (submodule.snd_equiv R M N)
 
 lemma tailing_le_tunnel (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
-  tailing f i n ≤ tunnel f i n :=
+  tailing f i n ≤ (tunnel f i n).of_dual :=
 begin
   dsimp [tailing, tunnel_aux],
   rw [submodule.map_comp, submodule.map_comp],
@@ -714,7 +742,7 @@ begin
 end
 
 lemma tailing_disjoint_tunnel_succ (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
-  disjoint (tailing f i n) (tunnel f i (n+1)) :=
+  disjoint (tailing f i n) (tunnel f i (n+1)).of_dual :=
 begin
   rw disjoint_iff,
   dsimp [tailing, tunnel, tunnel'],
@@ -724,7 +752,7 @@ begin
 end
 
 lemma tailing_sup_tunnel_succ_le_tunnel (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
-  tailing f i n ⊔ tunnel f i (n+1) ≤ tunnel f i n :=
+  tailing f i n ⊔ (tunnel f i (n+1)).of_dual ≤ (tunnel f i n).of_dual :=
 begin
   dsimp [tailing, tunnel, tunnel', tunnel_aux],
   rw [←submodule.map_sup, sup_comm, submodule.fst_sup_snd, submodule.map_comp, submodule.map_comp],
@@ -744,7 +772,7 @@ by simp [tailings]
 by simp [tailings]
 
 lemma tailings_disjoint_tunnel (f : M × N →ₗ[R] M) (i : injective f) (n : ℕ) :
-  disjoint (tailings f i n) (tunnel f i (n+1)) :=
+  disjoint (tailings f i n) (tunnel f i (n+1)).of_dual :=
 begin
   induction n with n ih,
   { simp only [tailings_zero],
@@ -762,4 +790,42 @@ disjoint.mono_right (tailing_le_tunnel f i _) (tailings_disjoint_tunnel f i _)
 
 end tunnel
 
+section graph
+
+variables [semiring R] [add_comm_monoid M] [add_comm_monoid M₂]
+  [add_comm_group M₃] [add_comm_group M₄] [module R M] [module R M₂]
+  [module R M₃] [module R M₄] (f : M →ₗ[R] M₂) (g : M₃ →ₗ[R] M₄)
+
+/-- Graph of a linear map. -/
+def graph : submodule R (M × M₂) :=
+{ carrier := {p | p.2 = f p.1},
+  add_mem' := λ a b (ha : _ = _) (hb : _ = _),
+  begin
+    change _ + _ = f (_ + _),
+    rw [map_add, ha, hb]
+  end,
+  zero_mem' := eq.symm (map_zero f),
+  smul_mem' := λ c x (hx : _ = _),
+  begin
+    change _ • _ = f (_ • _),
+    rw [map_smul, hx]
+  end }
+
+@[simp] lemma mem_graph_iff (x : M × M₂) : x ∈ f.graph ↔ x.2 = f x.1 := iff.rfl
+
+lemma graph_eq_ker_coprod : g.graph = ((-g).coprod linear_map.id).ker :=
+begin
+  ext x,
+  change _ = _ ↔ -(g x.1) + x.2 = _,
+  rw [add_comm, add_neg_eq_zero]
+end
+
+lemma graph_eq_range_prod : f.graph = (linear_map.id.prod f).range :=
+begin
+  ext x,
+  exact ⟨λ hx, ⟨x.1, prod.ext rfl hx.symm⟩, λ ⟨u, hu⟩, hu ▸ rfl⟩
+end
+
+end graph
+
 end linear_map
diff --git a/src/linear_algebra/projection.lean b/src/linear_algebra/projection.lean
index 5d6657a36b8fe..d8f56f520278e 100644
--- a/src/linear_algebra/projection.lean
+++ b/src/linear_algebra/projection.lean
@@ -9,6 +9,9 @@ import linear_algebra.prod
 /-!
 # Projection to a subspace
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define
 * `linear_proj_of_is_compl (p q : submodule R E) (h : is_compl p q)`: the projection of a module `E`
   to a submodule `p` along its complement `q`; it is the unique linear map `f : E → p` such that
@@ -23,9 +26,13 @@ We also provide some lemmas justifying correctness of our definitions.
 projection, complement subspace
 -/
 
+section ring
+
 variables {R : Type*} [ring R] {E : Type*} [add_comm_group E] [module R E]
   {F : Type*} [add_comm_group F] [module R F]
   {G : Type*} [add_comm_group G] [module R G] (p q : submodule R E)
+variables {S : Type*} [semiring S] {M : Type*} [add_comm_monoid M] [module S M] (m : submodule S M)
+
 
 noncomputable theory
 
@@ -51,10 +58,12 @@ lemma is_compl_of_proj {f : E →ₗ[R] p} (hf : ∀ x : p, f x = x) :
   is_compl p f.ker :=
 begin
   split,
-  { rintros x ⟨hpx, hfx⟩,
+  { rw disjoint_iff_inf_le,
+    rintros x ⟨hpx, hfx⟩,
     erw [set_like.mem_coe, mem_ker, hf ⟨x, hpx⟩, mk_eq_zero] at hfx,
     simp only [hfx, set_like.mem_coe, zero_mem] },
-  { intros x hx,
+  { rw codisjoint_iff_le_sup,
+    intros x hx,
     rw [mem_sup'],
     refine ⟨f x, ⟨x - f x, _⟩, add_sub_cancel'_right _ _⟩,
     rw [mem_ker, linear_map.map_sub, hf, sub_self] }
@@ -69,8 +78,8 @@ open linear_map
 /-- If `q` is a complement of `p`, then `M/p ≃ q`. -/
 def quotient_equiv_of_is_compl (h : is_compl p q) : (E ⧸ p) ≃ₗ[R] q :=
 linear_equiv.symm $ linear_equiv.of_bijective (p.mkq.comp q.subtype)
-  (by simp only [← ker_eq_bot, ker_comp, ker_mkq, disjoint_iff_comap_eq_bot.1 h.symm.disjoint])
-  (by simp only [← range_eq_top, range_comp, range_subtype, map_mkq_eq_top, h.sup_eq_top])
+  ⟨by rw [← ker_eq_bot, ker_comp, ker_mkq, disjoint_iff_comap_eq_bot.1 h.symm.disjoint],
+   by rw [← range_eq_top, range_comp, range_subtype, map_mkq_eq_top, h.sup_eq_top]⟩
 
 @[simp] lemma quotient_equiv_of_is_compl_symm_apply (h : is_compl p q) (x : q) :
   (quotient_equiv_of_is_compl p q h).symm x = quotient.mk x := rfl
@@ -88,13 +97,10 @@ linear map `f : E → p` such that `f x = x` for `x ∈ p` and `f x = 0` for `x
 def prod_equiv_of_is_compl (h : is_compl p q) : (p × q) ≃ₗ[R] E :=
 begin
   apply linear_equiv.of_bijective (p.subtype.coprod q.subtype),
-  { simp only [←ker_eq_bot, ker_eq_bot', prod.forall, subtype_apply, prod.mk_eq_zero, coprod_apply],
-    -- TODO: if I add `submodule.forall`, it unfolds the outer `∀` but not the inner one.
-    rintros ⟨x, hx⟩ ⟨y, hy⟩,
-    simp only [coe_mk, mk_eq_zero, ← eq_neg_iff_add_eq_zero],
-    rintro rfl,
-    rw [neg_mem_iff] at hx,
-    simp [disjoint_def.1 h.disjoint y hx hy] },
+  split,
+  { rw [← ker_eq_bot, ker_coprod_of_disjoint_range, ker_subtype, ker_subtype, prod_bot],
+    rw [range_subtype, range_subtype],
+    exact h.1 },
   { rw [← range_eq_top, ← sup_eq_range, h.sup_eq_top] }
 end
 
@@ -295,8 +301,8 @@ a linear equivalence `E ≃ₗ[R] F × G`. -/
 def equiv_prod_of_surjective_of_is_compl (f : E →ₗ[R] F) (g : E →ₗ[R] G) (hf : f.range = ⊤)
   (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) :
   E ≃ₗ[R] F × G :=
-linear_equiv.of_bijective (f.prod g) (by simp [← ker_eq_bot, hfg.inf_eq_bot])
-  (by simp [← range_eq_top, range_prod_eq hfg.sup_eq_top, *])
+linear_equiv.of_bijective (f.prod g) ⟨by simp [← ker_eq_bot, hfg.inf_eq_bot],
+  by { rw [←range_eq_top], simp [range_prod_eq hfg.sup_eq_top, *] }⟩
 
 @[simp] lemma coe_equiv_prod_of_surjective_of_is_compl {f : E →ₗ[R] F} {g : E →ₗ[R] G}
   (hf : f.range = ⊤) (hg : g.range = ⊤) (hfg : is_compl f.ker g.ker) :
@@ -330,3 +336,89 @@ def is_compl_equiv_proj :
   (p.is_compl_equiv_proj.symm f : submodule R E) = (f : E →ₗ[R] p).ker := rfl
 
 end submodule
+
+namespace linear_map
+
+open submodule
+
+/--
+A linear endomorphism of a module `E` is a projection onto a submodule `p` if it sends every element
+of `E` to `p` and fixes every element of `p`.
+The definition allow more generally any `fun_like` type and not just linear maps, so that it can be
+used for example with `continuous_linear_map` or `matrix`.
+-/
+structure is_proj {F : Type*} [fun_like F M (λ _, M)] (f : F) : Prop :=
+(map_mem : ∀ x, f x ∈ m)
+(map_id : ∀ x ∈ m, f x = x)
+
+lemma is_proj_iff_idempotent (f : M →ₗ[S] M) : (∃ p : submodule S M, is_proj p f) ↔ f ∘ₗ f = f :=
+begin
+  split,
+  { intro h, obtain ⟨p, hp⟩ := h, ext, rw comp_apply, exact hp.map_id (f x) (hp.map_mem x), },
+  { intro h, use f.range, split,
+    { intro x, exact mem_range_self f x, },
+    { intros x hx, obtain ⟨y, hy⟩ := mem_range.1 hx, rw [←hy, ←comp_apply, h], }, },
+end
+
+namespace is_proj
+
+variables {p m}
+
+/--
+Restriction of the codomain of a projection of onto a subspace `p` to `p` instead of the whole
+space.
+-/
+def cod_restrict {f : M →ₗ[S] M} (h : is_proj m f) : M →ₗ[S] m :=
+f.cod_restrict m h.map_mem
+
+@[simp]
+lemma cod_restrict_apply {f : M →ₗ[S] M} (h : is_proj m f) (x : M) :
+  ↑(h.cod_restrict x) = f x := f.cod_restrict_apply m x
+
+@[simp]
+lemma cod_restrict_apply_cod {f : M →ₗ[S] M} (h : is_proj m f) (x : m) :
+  h.cod_restrict x = x :=
+by {ext, rw [cod_restrict_apply], exact h.map_id x x.2}
+
+lemma cod_restrict_ker {f : M →ₗ[S] M} (h : is_proj m f) :
+  h.cod_restrict.ker = f.ker := f.ker_cod_restrict m _
+
+lemma is_compl {f : E →ₗ[R] E} (h : is_proj p f) : is_compl p f.ker :=
+by { rw ←cod_restrict_ker, exact is_compl_of_proj h.cod_restrict_apply_cod, }
+
+lemma eq_conj_prod_map' {f : E →ₗ[R] E} (h : is_proj p f) :
+  f = (p.prod_equiv_of_is_compl f.ker h.is_compl).to_linear_map ∘ₗ prod_map id 0 ∘ₗ
+    (p.prod_equiv_of_is_compl f.ker h.is_compl).symm.to_linear_map :=
+begin
+  refine (linear_map.cancel_right
+    (p.prod_equiv_of_is_compl f.ker h.is_compl).surjective).1 _,
+  ext,
+  { simp only [coe_comp, linear_equiv.coe_to_linear_map, coe_inl, function.comp_app,
+  linear_equiv.of_top_apply, linear_equiv.of_injective_apply, coprod_apply, submodule.coe_subtype,
+  coe_zero, add_zero, prod_equiv_of_is_compl_symm_apply_left, prod_map_apply, id_coe, id.def,
+  zero_apply, coe_prod_equiv_of_is_compl', h.map_id x x.2], },
+  {simp only [coe_comp, linear_equiv.coe_to_linear_map, coe_inr, function.comp_app,
+  linear_equiv.of_top_apply, linear_equiv.of_injective_apply, coprod_apply, submodule.coe_subtype,
+  coe_zero, zero_add, map_coe_ker, prod_equiv_of_is_compl_symm_apply_right, prod_map_apply, id_coe,
+  id.def, zero_apply, coe_prod_equiv_of_is_compl'], }
+end
+
+end is_proj
+
+end linear_map
+
+end ring
+
+section comm_ring
+
+namespace linear_map
+
+variables {R : Type*} [comm_ring R] {E : Type*} [add_comm_group E] [module R E]  {p : submodule R E}
+
+lemma is_proj.eq_conj_prod_map {f : E →ₗ[R] E} (h : is_proj p f) :
+  f = (p.prod_equiv_of_is_compl f.ker h.is_compl).conj (prod_map id 0) :=
+by {rw linear_equiv.conj_apply, exact h.eq_conj_prod_map'}
+
+end linear_map
+
+end comm_ring
diff --git a/src/linear_algebra/projective_space/basic.lean b/src/linear_algebra/projective_space/basic.lean
index b5b6228c1f277..78593079ab34d 100644
--- a/src/linear_algebra/projective_space/basic.lean
+++ b/src/linear_algebra/projective_space/basic.lean
@@ -9,6 +9,9 @@ import linear_algebra.finite_dimensional
 
 # Projective Spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the definition of the projectivization of a vector space over a field,
 as well as the bijection between said projectivization and the collection of all one
 dimensional subspaces of the vector space.
@@ -28,14 +31,9 @@ We have three ways to construct terms of `ℙ K V`:
   and `{ H : submodule K V // finrank H = 1 }`.
 - For `v : ℙ K V`, `v.rep : V` is a representative of `v`.
 
-## Projects
-Everything in this file can be done for `division_ring`s instead of `field`s, but
-this would require a significant refactor of the results from
-`linear_algebra.finite_dimensional` and its imports.
-
 -/
 
-variables (K V : Type*) [field K] [add_comm_group V] [module K V]
+variables (K V : Type*) [division_ring K] [add_comm_group V] [module K V]
 
 /-- The setoid whose quotient is the projectivization of `V`. -/
 def projectivization_setoid : setoid { v : V // v ≠ 0 } :=
@@ -43,7 +41,7 @@ def projectivization_setoid : setoid { v : V // v ≠ 0 } :=
 
 /-- The projectivization of the `K`-vector space `V`.
 The notation `ℙ K V` is preferred. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def projectivization := quotient (projectivization_setoid K V)
 
 notation `ℙ` := projectivization
@@ -92,6 +90,17 @@ lemma mk_eq_mk_iff (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) :
   mk K v hv = mk K w hw ↔ ∃ (a : Kˣ), a • w = v :=
 quotient.eq'
 
+/-- Two nonzero vectors go to the same point in projective space if and only if one is
+a scalar multiple of the other. -/
+lemma mk_eq_mk_iff' (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) : mk K v hv = mk K w hw ↔
+  ∃ (a : K), a • w = v :=
+begin
+  rw mk_eq_mk_iff K v w hv hw,
+  split,
+  { rintro ⟨a, ha⟩, exact ⟨a, ha⟩ },
+  { rintro ⟨a, ha⟩, refine ⟨units.mk0 a (λ c, hv.symm _), ha⟩, rwa [c, zero_smul] at ha }
+end
+
 lemma exists_smul_eq_mk_rep
   (v : V) (hv : v ≠ 0) : ∃ (a : Kˣ), a • v = (mk K v hv).rep :=
 show (projectivization_setoid K V).rel _ _, from quotient.mk_out' ⟨v, hv⟩
@@ -150,7 +159,7 @@ begin
     use mk K v this,
     symmetry,
     ext x, revert x, erw ← set.ext_iff, ext x,
-    dsimp,
+    dsimp [-set_like.mem_coe],
     rw [submodule.span_singleton_eq_range],
     refine ⟨λ hh, _, _⟩,
     { obtain ⟨c,hc⟩ := h ⟨x,hh⟩,
@@ -180,7 +189,7 @@ show (equiv_submodule K V).symm (equiv_submodule K V _) = _, by simp
 
 section map
 
-variables {L W : Type*} [field L] [add_comm_group W] [module L W]
+variables {L W : Type*} [division_ring L] [add_comm_group W] [module L W]
 
 /-- An injective semilinear map of vector spaces induces a map on projective spaces. -/
 def map {σ : K →+* L} (f : V →ₛₗ[σ] W) (hf : function.injective f) :
diff --git a/src/linear_algebra/projective_space/independence.lean b/src/linear_algebra/projective_space/independence.lean
new file mode 100644
index 0000000000000..201eb9155d050
--- /dev/null
+++ b/src/linear_algebra/projective_space/independence.lean
@@ -0,0 +1,119 @@
+/-
+Copyright (c) 2022 Michael Blyth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Blyth
+-/
+
+import linear_algebra.projective_space.basic
+
+/-!
+# Independence in Projective Space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define independence and dependence of families of elements in projective space.
+
+## Implementation Details
+
+We use an inductive definition to define the independence of points in projective
+space, where the only constructor assumes an independent family of vectors from the
+ambient vector space. Similarly for the definition of dependence.
+
+## Results
+
+- A family of elements is dependent if and only if it is not independent.
+- Two elements are dependent if and only if they are equal.
+
+# Future Work
+
+- Define collinearity in projective space.
+- Prove the axioms of a projective geometry are satisfied by the dependence relation.
+- Define projective linear subspaces.
+-/
+
+
+variables {ι K V : Type*} [field K] [add_comm_group V] [module K V] {f : ι → ℙ K V}
+
+namespace projectivization
+
+/-- A linearly independent family of nonzero vectors gives an independent family of points
+in projective space. -/
+inductive independent : (ι → ℙ K V) → Prop
+| mk (f : ι → V) (hf : ∀ i : ι, f i ≠ 0) (hl : linear_independent K f) :
+    independent (λ i, mk K (f i) (hf i))
+
+/-- A family of points in a projective space is independent if and only if the representative
+vectors determined by the family are linearly independent. -/
+lemma independent_iff : independent f ↔ linear_independent K (projectivization.rep ∘ f) :=
+begin
+  refine ⟨_, λ h, _⟩,
+  { rintros ⟨ff, hff, hh⟩,
+    choose a ha using λ (i : ι), exists_smul_eq_mk_rep K (ff i) (hff i),
+    convert hh.units_smul a,
+    ext i, exact (ha i).symm },
+  { convert independent.mk _ _ h,
+    { ext, simp only [mk_rep] },
+    { intro i, apply rep_nonzero } }
+end
+
+/-- A family of points in projective space is independent if and only if the family of
+submodules which the points determine is independent in the lattice-theoretic sense. -/
+lemma independent_iff_complete_lattice_independent :
+  independent f ↔ (complete_lattice.independent $ λ i, (f i).submodule) :=
+begin
+  refine ⟨_, λ h, _⟩,
+  { rintros ⟨f, hf, hi⟩,
+    simpa [submodule_mk, complete_lattice.independent_iff_linear_independent_of_ne_zero hf] },
+  { rw independent_iff,
+    refine h.linear_independent (projectivization.submodule ∘ f) (λ i, _) (λ i, _),
+    { simpa only [function.comp_app, submodule_eq] using submodule.mem_span_singleton_self _, },
+    { exact rep_nonzero (f i) } },
+end
+
+/-- A linearly dependent family of nonzero vectors gives a dependent family of points
+in projective space. -/
+inductive dependent : (ι → ℙ K V) → Prop
+| mk (f : ι → V) (hf : ∀ i : ι, f i ≠ 0) (h : ¬linear_independent K f) :
+    dependent (λ i, mk K (f i) (hf i))
+
+/-- A family of points in a projective space is dependent if and only if their
+representatives are linearly dependent. -/
+lemma dependent_iff : dependent f ↔ ¬ linear_independent K (projectivization.rep ∘ f) :=
+begin
+  refine ⟨_, λ h, _⟩,
+  { rintros ⟨ff, hff, hh1⟩,
+    contrapose! hh1,
+    choose a ha using λ (i : ι), exists_smul_eq_mk_rep K (ff i) (hff i),
+    convert hh1.units_smul a⁻¹,
+    ext i,
+    simp only [← ha, inv_smul_smul, pi.smul_apply', pi.inv_apply, function.comp_app] },
+  { convert dependent.mk _ _ h,
+    { ext i, simp only [mk_rep] },
+    { exact λ i, rep_nonzero (f i) } }
+end
+
+/-- Dependence is the negation of independence. -/
+lemma dependent_iff_not_independent : dependent f ↔ ¬ independent f :=
+by rw [dependent_iff, independent_iff]
+
+/-- Independence is the negation of dependence. -/
+lemma independent_iff_not_dependent : independent f ↔ ¬ dependent f :=
+by rw [dependent_iff_not_independent, not_not]
+
+/-- Two points in a projective space are dependent if and only if they are equal. -/
+@[simp] lemma dependent_pair_iff_eq (u v : ℙ K V) : dependent ![u, v] ↔ u = v :=
+begin
+  simp_rw [dependent_iff_not_independent, independent_iff, linear_independent_fin2,
+    function.comp_app, matrix.cons_val_one, matrix.head_cons,
+    ne.def, matrix.cons_val_zero, not_and, not_forall, not_not,
+    ← mk_eq_mk_iff' K _ _ (rep_nonzero u) (rep_nonzero v), mk_rep,
+    imp_iff_right_iff],
+  exact or.inl (rep_nonzero v),
+end
+
+/-- Two points in a projective space are independent if and only if the points are not equal. -/
+@[simp] lemma independent_pair_iff_neq (u v : ℙ K V) : independent ![u, v] ↔ u ≠ v :=
+by rw [independent_iff_not_dependent, dependent_pair_iff_eq u v]
+
+end projectivization
diff --git a/src/linear_algebra/projective_space/subspace.lean b/src/linear_algebra/projective_space/subspace.lean
new file mode 100644
index 0000000000000..aadabc860d9d3
--- /dev/null
+++ b/src/linear_algebra/projective_space/subspace.lean
@@ -0,0 +1,193 @@
+/-
+Copyright (c) 2022 Michael Blyth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Blyth
+-/
+
+import linear_algebra.projective_space.basic
+
+/-!
+# Subspaces of Projective Space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define subspaces of a projective space, and show that the subspaces of a projective
+space form a complete lattice under inclusion.
+
+## Implementation Details
+
+A subspace of a projective space ℙ K V is defined to be a structure consisting of a subset of
+ℙ K V such that if two nonzero vectors in V determine points in ℙ K V which are in the subset, and
+the sum of the two vectors is nonzero, then the point determined by the sum of the two vectors is
+also in the subset.
+
+## Results
+
+- There is a Galois insertion between the subsets of points of a projective space
+  and the subspaces of the projective space, which is given by taking the span of the set of points.
+- The subspaces of a projective space form a complete lattice under inclusion.
+
+# Future Work
+- Show that there is a one-to-one order-preserving correspondence between subspaces of a
+  projective space and the submodules of the underlying vector space.
+-/
+
+variables (K V : Type*) [field K] [add_comm_group V] [module K V]
+
+namespace projectivization
+
+/-- A subspace of a projective space is a structure consisting of a set of points such that:
+If two nonzero vectors determine points which are in the set, and the sum of the two vectors is
+nonzero, then the point determined by the sum is also in the set. -/
+@[ext] structure subspace :=
+(carrier : set (ℙ K V))
+(mem_add' (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
+  mk K v hv ∈ carrier → mk K w hw ∈ carrier → mk K (v + w) (hvw) ∈ carrier)
+
+namespace subspace
+
+variables {K V}
+
+instance : set_like (subspace K V) (ℙ K V) :=
+{ coe := carrier,
+  coe_injective' := λ A B, by { cases A, cases B, simp } }
+
+@[simp]
+lemma mem_carrier_iff (A : subspace K V) (x : ℙ K V) : x ∈ A.carrier ↔ x ∈ A := iff.refl _
+
+lemma mem_add (T : subspace K V) (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
+  projectivization.mk K v hv ∈ T → projectivization.mk K w hw ∈ T →
+  projectivization.mk K (v + w) (hvw) ∈ T :=
+  T.mem_add' v w hv hw hvw
+
+/-- The span of a set of points in a projective space is defined inductively to be the set of points
+which contains the original set, and contains all points determined by the (nonzero) sum of two
+nonzero vectors, each of which determine points in the span. -/
+inductive span_carrier (S : set (ℙ K V)) : set (ℙ K V)
+| of (x : ℙ K V) (hx : x ∈ S) : span_carrier x
+| mem_add (v w : V) (hv : v ≠ 0) (hw : w ≠ 0) (hvw : v + w ≠ 0) :
+    span_carrier (projectivization.mk K v hv) → span_carrier (projectivization.mk K w hw) →
+    span_carrier (projectivization.mk K (v + w) (hvw))
+
+/-- The span of a set of points in projective space is a subspace. -/
+def span (S : set (ℙ K V)) : subspace K V :=
+{ carrier := span_carrier S,
+  mem_add' := λ v w hv hw hvw,
+    span_carrier.mem_add v w hv hw hvw }
+
+/-- The span of a set of points contains the set of points. -/
+lemma subset_span (S : set (ℙ K V)) : S ⊆ span S := λ x hx, span_carrier.of _ hx
+
+/-- The span of a set of points is a Galois insertion between sets of points of a projective space
+and subspaces of the projective space. -/
+def gi : galois_insertion (span : set (ℙ K V) → subspace K V) coe :=
+{ choice := λ S hS, span S,
+  gc := λ A B, ⟨λ h, le_trans (subset_span _) h, begin
+    intros h x hx,
+    induction hx,
+    { apply h, assumption },
+    { apply B.mem_add, assumption' }
+  end⟩,
+  le_l_u := λ S, subset_span _,
+  choice_eq := λ _ _, rfl }
+
+/-- The span of a subspace is the subspace. -/
+@[simp] lemma span_coe (W : subspace K V) : span ↑W = W := galois_insertion.l_u_eq gi W
+
+/-- The infimum of two subspaces exists. -/
+instance has_inf : has_inf (subspace K V) :=
+⟨λ A B, ⟨A ⊓ B, λ v w hv hw hvw h1 h2,
+  ⟨A.mem_add _ _ hv hw _ h1.1 h2.1, B.mem_add _ _ hv hw _ h1.2 h2.2⟩⟩⟩
+
+/-- Infimums of arbitrary collections of subspaces exist. -/
+instance has_Inf : has_Inf (subspace K V) :=
+⟨λ A, ⟨Inf (coe '' A), λ v w hv hw hvw h1 h2 t, begin
+  rintro ⟨s, hs, rfl⟩,
+  exact s.mem_add v w hv hw _ (h1 s ⟨s, hs, rfl⟩) (h2 s ⟨s, hs, rfl⟩),
+end⟩⟩
+
+/-- The subspaces of a projective space form a complete lattice. -/
+instance : complete_lattice (subspace K V) :=
+{ inf_le_left := λ A B x hx, by exact hx.1,
+  inf_le_right := λ A B x hx, by exact hx.2,
+  le_inf := λ A B C h1 h2 x hx, ⟨h1 hx, h2 hx⟩,
+  ..(infer_instance : has_inf _),
+  ..complete_lattice_of_Inf (subspace K V)
+  begin
+    refine λ s, ⟨λ a ha x hx, (hx _ ⟨a, ha, rfl⟩), λ a ha x hx E, _⟩,
+    rintros ⟨E, hE, rfl⟩,
+    exact (ha hE hx)
+  end }
+
+instance subspace_inhabited : inhabited (subspace K V) :=
+{ default := ⊤ }
+
+/-- The span of the empty set is the bottom of the lattice of subspaces. -/
+@[simp] lemma span_empty : span (∅ : set (ℙ K V)) = ⊥ := gi.gc.l_bot
+
+/-- The span of the entire projective space is the top of the lattice of subspaces. -/
+@[simp] lemma span_univ : span (set.univ : set (ℙ K V)) = ⊤ :=
+by { rw [eq_top_iff, set_like.le_def], intros x hx, exact subset_span _ (set.mem_univ x) }
+
+/-- The span of a set of points is contained in a subspace if and only if the set of points is
+contained in the subspace. -/
+lemma span_le_subspace_iff {S : set (ℙ K V)} {W : subspace K V} : span S ≤ W ↔ S ⊆ W :=
+gi.gc S W
+
+/-- If a set of points is a subset of another set of points, then its span will be contained in the
+span of that set. -/
+@[mono] lemma monotone_span : monotone (span : set (ℙ K V) → subspace K V) := gi.gc.monotone_l
+
+lemma subset_span_trans {S T U : set (ℙ K V)} (hST : S ⊆ span T) (hTU : T ⊆ span U) :
+  S ⊆ span U :=
+gi.gc.le_u_l_trans hST hTU
+
+/-- The supremum of two subspaces is equal to the span of their union. -/
+lemma span_union (S T : set (ℙ K V)) : span (S ∪ T) = span S ⊔ span T := (@gi K V _ _ _).gc.l_sup
+
+/-- The supremum of a collection of subspaces is equal to the span of the union of the
+collection. -/
+lemma span_Union {ι} (s : ι → set (ℙ K V)) : span (⋃ i, s i) = ⨆ i, span (s i) :=
+(@gi K V _ _ _).gc.l_supr
+
+/-- The supremum of a subspace and the span of a set of points is equal to the span of the union of
+the subspace and the set of points. -/
+lemma sup_span {S : set (ℙ K V)} {W : subspace K V} : W ⊔ span S = span (W ∪ S) :=
+by rw [span_union, span_coe]
+
+lemma span_sup {S : set (ℙ K V)} {W : subspace K V}: span S ⊔ W = span (S ∪ W) :=
+by rw [span_union, span_coe]
+
+/-- A point in a projective space is contained in the span of a set of points if and only if the
+point is contained in all subspaces of the projective space which contain the set of points. -/
+lemma mem_span {S : set (ℙ K V)} (u : ℙ K V) : u ∈ span S ↔ ∀ (W : subspace K V), S ⊆ W → u ∈ W :=
+by { simp_rw ← span_le_subspace_iff, exact ⟨λ hu W hW, hW hu, λ W, W (span S) (le_refl _)⟩ }
+
+/-- The span of a set of points in a projective space is equal to the infimum of the collection of
+subspaces which contain the set. -/
+lemma span_eq_Inf {S : set (ℙ K V)} : span S = Inf {W | S ⊆ W} :=
+begin
+  ext,
+  simp_rw [mem_carrier_iff, mem_span x],
+  refine ⟨λ hx, _, λ hx W hW, _⟩,
+  { rintros W ⟨T, ⟨hT, rfl⟩⟩, exact (hx T hT) },
+  { exact (@Inf_le _ _ {W : subspace K V | S ⊆ ↑W} W hW) x hx },
+end
+
+/-- If a set of points in projective space is contained in a subspace, and that subspace is
+contained in the span of the set of points, then the span of the set of points is equal to
+the subspace. -/
+lemma span_eq_of_le {S : set (ℙ K V)} {W : subspace K V} (hS : S ⊆ W) (hW : W ≤ span S) :
+  span S = W :=
+le_antisymm (span_le_subspace_iff.mpr hS) hW
+
+/-- The spans of two sets of points in a projective space are equal if and only if each set of
+points is contained in the span of the other set. -/
+lemma span_eq_span_iff {S T : set (ℙ K V)} : span S = span T ↔ S ⊆ span T ∧ T ⊆ span S :=
+⟨λ h, ⟨h ▸ subset_span S, h.symm ▸ subset_span T⟩,
+  λ h, le_antisymm (span_le_subspace_iff.2 h.1) (span_le_subspace_iff.2 h.2)⟩
+
+end subspace
+
+end projectivization
diff --git a/src/linear_algebra/quadratic_form/basic.lean b/src/linear_algebra/quadratic_form/basic.lean
index cc81cb334b3c0..663a7df5eafb5 100644
--- a/src/linear_algebra/quadratic_form/basic.lean
+++ b/src/linear_algebra/quadratic_form/basic.lean
@@ -7,19 +7,33 @@ Authors: Anne Baanen, Kexing Ying, Eric Wieser
 import algebra.invertible
 import linear_algebra.matrix.determinant
 import linear_algebra.matrix.bilinear_form
+import linear_algebra.matrix.symmetric
 
 /-!
 # Quadratic forms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines quadratic forms over a `R`-module `M`.
-A quadratic form is a map `Q : M → R` such that
-  (`to_fun_smul`) `Q (a • x) = a * a * Q x`
-  (`polar_...`) The map `polar Q := λ x y, Q (x + y) - Q x - Q y` is bilinear.
-They come with a scalar multiplication, `(a • Q) x = Q (a • x) = a * a * Q x`,
+A quadratic form on a ring `R` is a map `Q : M → R` such that:
+* `quadratic_form.map_smul`: `Q (a • x) = a * a * Q x`
+* `quadratic_form.polar_add_left`, `quadratic_form.polar_add_right`,
+  `quadratic_form.polar_smul_left`, `quadratic_form.polar_smul_right`:
+  the map `quadratic_form.polar Q := λ x y, Q (x + y) - Q x - Q y` is bilinear.
+
+This notion generalizes to semirings using the approach in [izhakian2016][] which requires that
+there be a (possibly non-unique) companion bilinear form `B` such that
+`∀ x y, Q (x + y) = Q x + Q y + B x y`. Over a ring, this `B` is precisely `quadratic_form.polar Q`.
+
+To build a `quadratic_form` from the `polar` axioms, use `quadratic_form.of_polar`.
+
+Quadratic forms come with a scalar multiplication, `(a • Q) x = Q (a • x) = a * a * Q x`,
 and composition with linear maps `f`, `Q.comp f x = Q (f x)`.
 
 ## Main definitions
 
+ * `quadratic_form.of_polar`: a more familiar constructor that works on rings
  * `quadratic_form.associated`: associated bilinear form
  * `quadratic_form.pos_def`: positive definite quadratic forms
  * `quadratic_form.anisotropic`: anisotropic quadratic forms
@@ -55,11 +69,16 @@ quadratic form, homogeneous polynomial, quadratic polynomial
 
 universes u v w
 variables {S : Type*}
-variables {R : Type*} {M : Type*} [add_comm_group M] [ring R]
-variables {R₁ : Type*} [comm_ring R₁]
+variables {R R₁: Type*} {M : Type*}
+
+open_locale big_operators
+
+section polar
+variables [ring R] [comm_ring R₁] [add_comm_group M]
 
 namespace quadratic_form
-/-- Up to a factor 2, `Q.polar` is the associated bilinear form for a quadratic form `Q`.d
+
+/-- Up to a factor 2, `Q.polar` is the associated bilinear form for a quadratic form `Q`.
 
 Source of this name: https://en.wikipedia.org/wiki/Quadratic_form#Generalization
 -/
@@ -81,27 +100,39 @@ by { simp only [polar, pi.smul_apply, smul_sub] }
 lemma polar_comm (f : M → R) (x y : M) : polar f x y = polar f y x :=
 by rw [polar, polar, add_comm, sub_sub, sub_sub, add_comm (f x) (f y)]
 
+/-- Auxiliary lemma to express bilinearity of `quadratic_form.polar` without subtraction. -/
+lemma polar_add_left_iff {f : M → R} {x x' y : M} :
+  polar f (x + x') y = polar f x y + polar f x' y ↔
+    f (x + x' + y) + (f x + f x' + f y) = f (x + x') + f (x' + y) + f (y + x) :=
+begin
+  simp only [←add_assoc],
+  simp only [polar, sub_eq_iff_eq_add, eq_sub_iff_add_eq, sub_add_eq_add_sub, add_sub],
+  simp only [add_right_comm _ (f y) _, add_right_comm _ (f x') (f x)],
+  rw [add_comm y x, add_right_comm _ _ (f (x + y)), add_comm _ (f (x + y)),
+    add_right_comm (f (x + y)), add_left_inj],
+end
+
 lemma polar_comp {F : Type*} [ring S] [add_monoid_hom_class F R S] (f : M → R) (g : F) (x y : M) :
   polar (g ∘ f) x y = g (polar f x y) :=
 by simp only [polar, pi.smul_apply, function.comp_apply, map_sub]
 
 end quadratic_form
 
-variables [module R M] [module R₁ M]
+end polar
 
-open quadratic_form
-/-- A quadratic form over a module. -/
-structure quadratic_form (R : Type u) (M : Type v) [ring R] [add_comm_group M] [module R M] :=
+/-- A quadratic form over a module.
+
+For a more familiar constructor when `R` is a ring, see `quadratic_form.of_polar`. -/
+structure quadratic_form (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M] [module R M] :=
 (to_fun : M → R)
 (to_fun_smul : ∀ (a : R) (x : M), to_fun (a • x) = a * a * to_fun x)
-(polar_add_left' : ∀ (x x' y : M), polar to_fun (x + x') y = polar to_fun x y + polar to_fun x' y)
-(polar_smul_left' : ∀ (a : R) (x y : M), polar to_fun (a • x) y = a • polar to_fun x y)
-(polar_add_right' : ∀ (x y y' : M), polar to_fun x (y + y') = polar to_fun x y + polar to_fun x y')
-(polar_smul_right' : ∀ (a : R) (x y : M), polar to_fun x (a • y) = a • polar to_fun x y)
+(exists_companion' : ∃ B : bilin_form R M, ∀ x y, to_fun (x + y) = to_fun x + to_fun y + B x y)
 
 namespace quadratic_form
 
-variables {Q : quadratic_form R M}
+section fun_like
+variables [semiring R] [add_comm_monoid M] [module R M]
+variables {Q Q' : quadratic_form R M}
 
 instance fun_like : fun_like (quadratic_form R M) M (λ _, R) :=
 { coe := to_fun,
@@ -111,11 +142,55 @@ instance fun_like : fun_like (quadratic_form R M) M (λ _, R) :=
 `fun_like.has_coe_to_fun` directly. -/
 instance : has_coe_to_fun (quadratic_form R M) (λ _, M → R) := ⟨to_fun⟩
 
+variables (Q)
+
 /-- The `simp` normal form for a quadratic form is `coe_fn`, not `to_fun`. -/
-@[simp] lemma to_fun_eq_coe : Q.to_fun = ⇑ Q := rfl
+@[simp] lemma to_fun_eq_coe : Q.to_fun = ⇑Q := rfl
+
+-- this must come after the coe_to_fun definition
+initialize_simps_projections quadratic_form (to_fun → apply)
+
+variables {Q}
+
+@[ext] lemma ext (H : ∀ (x : M), Q x = Q' x) : Q = Q' := fun_like.ext _ _ H
+
+lemma congr_fun (h : Q = Q') (x : M) : Q x = Q' x := fun_like.congr_fun h _
+
+lemma ext_iff : Q = Q' ↔ (∀ x, Q x = Q' x) := fun_like.ext_iff
+
+/-- Copy of a `quadratic_form` with a new `to_fun` equal to the old one. Useful to fix definitional
+equalities. -/
+protected def copy (Q : quadratic_form R M) (Q' : M → R) (h : Q' = ⇑Q) : quadratic_form R M :=
+{ to_fun := Q',
+  to_fun_smul := h.symm ▸ Q.to_fun_smul,
+  exists_companion' := h.symm ▸ Q.exists_companion' }
+
+@[simp]
+lemma coe_copy (Q : quadratic_form R M) (Q' : M → R) (h : Q' = ⇑Q) : ⇑(Q.copy Q' h) = Q' := rfl
+
+lemma copy_eq (Q : quadratic_form R M) (Q' : M → R) (h : Q' = ⇑Q) : Q.copy Q' h = Q :=
+fun_like.ext' h
+
+end fun_like
+
+section semiring
+variables [semiring R] [add_comm_monoid M] [module R M]
+variables (Q : quadratic_form R M)
 
 lemma map_smul (a : R) (x : M) : Q (a • x) = a * a * Q x := Q.to_fun_smul a x
 
+lemma exists_companion : ∃ B : bilin_form R M, ∀ x y, Q (x + y) = Q x + Q y + B x y :=
+Q.exists_companion'
+
+lemma map_add_add_add_map (x y z : M) :
+  Q (x + y + z) + (Q x + Q y + Q z) = Q (x + y) + Q (y + z) + Q (z + x) :=
+begin
+  obtain ⟨B, h⟩ := Q.exists_companion,
+  rw [add_comm z x],
+  simp [h],
+  abel,
+end
+
 lemma map_add_self (x : M) : Q (x + x) = 4 * Q x :=
 by { rw [←one_smul R x, ←add_smul, map_smul], norm_num }
 
@@ -123,9 +198,20 @@ by { rw [←one_smul R x, ←add_smul, map_smul], norm_num }
 by rw [←@zero_smul R _ _ _ _ (0 : M), map_smul, zero_mul, zero_mul]
 
 instance zero_hom_class : zero_hom_class (quadratic_form R M) M R :=
-{ map_zero := λ _, map_zero,
+{ map_zero := map_zero,
   ..quadratic_form.fun_like }
 
+lemma map_smul_of_tower [comm_semiring S] [algebra S R] [module S M] [is_scalar_tower S R M]
+  (a : S) (x : M) :
+  Q (a • x) = (a * a) • Q x :=
+by rw [←is_scalar_tower.algebra_map_smul R a x, map_smul, ←ring_hom.map_mul, algebra.smul_def]
+
+end semiring
+
+section ring
+variables [ring R] [comm_ring R₁] [add_comm_group M]
+variables [module R M] (Q : quadratic_form R M)
+
 @[simp] lemma map_neg (x : M) : Q (-x) = Q x :=
 by rw [←@neg_one_smul R _ _ _ _ x, map_smul, neg_one_mul, neg_neg, one_mul]
 
@@ -139,12 +225,15 @@ by simp only [polar, zero_add, quadratic_form.map_zero, sub_zero, sub_self]
 @[simp]
 lemma polar_add_left (x x' y : M) :
   polar Q (x + x') y = polar Q x y + polar Q x' y :=
-Q.polar_add_left' x x' y
+polar_add_left_iff.mpr $ Q.map_add_add_add_map x x' y
 
 @[simp]
 lemma polar_smul_left (a : R) (x y : M) :
   polar Q (a • x) y = a * polar Q x y :=
-Q.polar_smul_left' a x y
+begin
+  obtain ⟨B, h⟩ := Q.exists_companion,
+  simp_rw [polar, h, Q.map_smul, bilin_form.smul_left, sub_sub, add_sub_cancel'],
+end
 
 @[simp]
 lemma polar_neg_left (x y : M) :
@@ -163,12 +252,12 @@ by simp only [add_zero, polar, quadratic_form.map_zero, sub_self]
 @[simp]
 lemma polar_add_right (x y y' : M) :
   polar Q x (y + y') = polar Q x y + polar Q x y' :=
-Q.polar_add_right' x y y'
+by rw [polar_comm Q x, polar_comm Q x, polar_comm Q x, polar_add_left]
 
 @[simp]
 lemma polar_smul_right (a : R) (x y : M) :
   polar Q x (a • y) = a * polar Q x y :=
-Q.polar_smul_right' a x y
+by rw [polar_comm Q x, polar_comm Q x, polar_smul_left]
 
 @[simp]
 lemma polar_neg_right (x y : M) :
@@ -187,15 +276,17 @@ begin
   norm_num
 end
 
-section of_tower
+/-- `quadratic_form.polar` as a bilinear form -/
+@[simps]
+def polar_bilin : bilin_form R M :=
+{ bilin := polar Q,
+  bilin_add_left := polar_add_left Q,
+  bilin_smul_left := polar_smul_left Q,
+  bilin_add_right := λ x y z, by simp_rw [polar_comm _ x, polar_add_left Q],
+  bilin_smul_right := λ r x y, by simp_rw [polar_comm _ x, polar_smul_left Q] }
 
 variables [comm_semiring S] [algebra S R] [module S M] [is_scalar_tower S R M]
 
-variables (Q)
-
-lemma map_smul_of_tower (a : S) (x : M) : Q (a • x) = (a * a) • Q x :=
-by rw [←is_scalar_tower.algebra_map_smul R a x, map_smul, ←ring_hom.map_mul, algebra.smul_def]
-
 @[simp]
 lemma polar_smul_left_of_tower (a : S) (x y : M) :
   polar Q (a • x) y = a • polar Q x y :=
@@ -206,60 +297,57 @@ lemma polar_smul_right_of_tower (a : S) (x y : M) :
   polar Q x (a • y) = a • polar Q x y :=
 by rw [←is_scalar_tower.algebra_map_smul R a y, polar_smul_right, algebra.smul_def]
 
-end of_tower
-
-variable {Q' : quadratic_form R M}
+/-- An alternative constructor to `quadratic_form.mk`, for rings where `polar` can be used. -/
+@[simps]
+def of_polar (to_fun : M → R) (to_fun_smul : ∀ (a : R) (x : M), to_fun (a • x) = a * a * to_fun x)
+  (polar_add_left : ∀ (x x' y : M), polar to_fun (x + x') y = polar to_fun x y + polar to_fun x' y)
+  (polar_smul_left : ∀ (a : R) (x y : M), polar to_fun (a • x) y = a • polar to_fun x y) :
+  quadratic_form R M :=
+{ to_fun := to_fun,
+  to_fun_smul := to_fun_smul,
+  exists_companion' := ⟨
+    { bilin := polar to_fun,
+      bilin_add_left := polar_add_left,
+      bilin_smul_left := polar_smul_left,
+      bilin_add_right := λ x y z, by simp_rw [polar_comm _ x, polar_add_left],
+      bilin_smul_right := λ r x y, by simp_rw [polar_comm _ x, polar_smul_left, smul_eq_mul] },
+    λ x y, by rw [bilin_form.coe_fn_mk, polar, sub_sub, add_sub_cancel'_right]⟩ }
+
+/-- In a ring the companion bilinear form is unique and equal to `quadratic_form.polar`. -/
+lemma some_exists_companion : Q.exists_companion.some = polar_bilin Q :=
+bilin_form.ext $ λ x y,
+  by rw [polar_bilin_apply, polar, Q.exists_companion.some_spec, sub_sub, add_sub_cancel']
 
-@[ext] lemma ext (H : ∀ (x : M), Q x = Q' x) : Q = Q' := fun_like.ext _ _ H
+end ring
 
-lemma congr_fun (h : Q = Q') (x : M) : Q x = Q' x := fun_like.congr_fun h _
+section semiring_operators
+variables [semiring R] [add_comm_monoid M] [module R M]
 
-lemma ext_iff : Q = Q' ↔ (∀ x, Q x = Q' x) := fun_like.ext_iff
-
-/-- Copy of a `quadratic_form` with a new `to_fun` equal to the old one. Useful to fix definitional
-equalities. -/
-protected def copy (Q : quadratic_form R M) (Q' : M → R) (h : Q' = ⇑Q) : quadratic_form R M :=
-{ to_fun := Q',
-  to_fun_smul := h.symm ▸ Q.to_fun_smul,
-  polar_add_left' := h.symm ▸ Q.polar_add_left',
-  polar_smul_left' := h.symm ▸ Q.polar_smul_left',
-  polar_add_right' := h.symm ▸ Q.polar_add_right',
-  polar_smul_right' := h.symm ▸ Q.polar_smul_right' }
-
-section has_scalar
+section has_smul
 
 variables [monoid S] [distrib_mul_action S R] [smul_comm_class S R R]
 
 /-- `quadratic_form R M` inherits the scalar action from any algebra over `R`.
 
 When `R` is commutative, this provides an `R`-action via `algebra.id`. -/
-instance : has_scalar S (quadratic_form R M) :=
+instance : has_smul S (quadratic_form R M) :=
 ⟨ λ a Q,
   { to_fun := a • Q,
     to_fun_smul := λ b x, by rw [pi.smul_apply, map_smul, pi.smul_apply, mul_smul_comm],
-    polar_add_left' := λ x x' y, by simp only [polar_smul, polar_add_left, smul_add],
-    polar_smul_left' := λ b x y, begin
-      simp only [polar_smul, polar_smul_left, ←mul_smul_comm, smul_eq_mul],
-    end,
-    polar_add_right' := λ x y y', by simp only [polar_smul, polar_add_right, smul_add],
-    polar_smul_right' := λ b x y, begin
-      simp only [polar_smul, polar_smul_right, ←mul_smul_comm, smul_eq_mul],
-    end } ⟩
+    exists_companion' := let ⟨B, h⟩ := Q.exists_companion in ⟨a • B,
+      by simp [h]⟩ } ⟩
 
 @[simp] lemma coe_fn_smul (a : S) (Q : quadratic_form R M) : ⇑(a • Q) = a • Q := rfl
 
 @[simp] lemma smul_apply (a : S) (Q : quadratic_form R M) (x : M) :
   (a • Q) x = a • Q x := rfl
 
-end has_scalar
+end has_smul
 
 instance : has_zero (quadratic_form R M) :=
 ⟨ { to_fun := λ x, 0,
     to_fun_smul := λ a x, by simp only [mul_zero],
-    polar_add_left' := λ x x' y, by simp only [add_zero, polar, sub_self],
-    polar_smul_left' := λ a x y, by simp only [polar, smul_zero, sub_self],
-    polar_add_right' := λ x y y', by simp only [add_zero, polar, sub_self],
-    polar_smul_right' := λ a x y, by simp only [polar, smul_zero, sub_self]} ⟩
+    exists_companion' := ⟨0, λ x y, by simp only [add_zero, bilin_form.zero_apply]⟩ } ⟩
 
 @[simp] lemma coe_fn_zero : ⇑(0 : quadratic_form R M) = 0 := rfl
 
@@ -272,47 +360,16 @@ instance : has_add (quadratic_form R M) :=
   { to_fun := Q + Q',
     to_fun_smul := λ a x,
       by simp only [pi.add_apply, map_smul, mul_add],
-    polar_add_left' := λ x x' y,
-      by simp only [polar_add, polar_add_left, add_assoc, add_left_comm],
-    polar_smul_left' := λ a x y,
-      by simp only [polar_add, smul_eq_mul, mul_add, polar_smul_left],
-    polar_add_right' := λ x y y',
-      by simp only [polar_add, polar_add_right, add_assoc, add_left_comm],
-    polar_smul_right' := λ a x y,
-      by simp only [polar_add, smul_eq_mul, mul_add, polar_smul_right] } ⟩
+    exists_companion' :=
+      let ⟨B, h⟩ := Q.exists_companion, ⟨B', h'⟩ := Q'.exists_companion in
+      ⟨B + B', λ x y, by simp_rw [pi.add_apply, h, h', bilin_form.add_apply, add_add_add_comm] ⟩ } ⟩
 
 @[simp] lemma coe_fn_add (Q Q' : quadratic_form R M) : ⇑(Q + Q') = Q + Q' := rfl
 
 @[simp] lemma add_apply (Q Q' : quadratic_form R M) (x : M) : (Q + Q') x = Q x + Q' x := rfl
 
-instance : has_neg (quadratic_form R M) :=
-⟨ λ Q,
-  { to_fun := -Q,
-    to_fun_smul := λ a x,
-      by simp only [pi.neg_apply, map_smul, mul_neg],
-    polar_add_left' := λ x x' y,
-      by simp only [polar_neg, polar_add_left, neg_add],
-    polar_smul_left' := λ a x y,
-      by simp only [polar_neg, polar_smul_left, mul_neg, smul_eq_mul],
-    polar_add_right' := λ x y y',
-      by simp only [polar_neg, polar_add_right, neg_add],
-    polar_smul_right' := λ a x y,
-      by simp only [polar_neg, polar_smul_right, mul_neg, smul_eq_mul] } ⟩
-
-@[simp] lemma coe_fn_neg (Q : quadratic_form R M) : ⇑(-Q) = -Q := rfl
-
-@[simp] lemma neg_apply (Q : quadratic_form R M) (x : M) : (-Q) x = -Q x := rfl
-
-instance : has_sub (quadratic_form R M) :=
-⟨ λ Q Q', (Q + -Q').copy (Q - Q') (sub_eq_add_neg _ _) ⟩
-
-@[simp] lemma coe_fn_sub (Q Q' : quadratic_form R M) : ⇑(Q - Q') = Q - Q' := rfl
-
-@[simp] lemma sub_apply (Q Q' : quadratic_form R M) (x : M) : (Q - Q') x = Q x - Q' x := rfl
-
-instance : add_comm_group (quadratic_form R M) :=
-fun_like.coe_injective.add_comm_group _
-  coe_fn_zero coe_fn_add coe_fn_neg coe_fn_sub (λ _ _, coe_fn_smul _ _) (λ _ _, coe_fn_smul _ _)
+instance : add_comm_monoid (quadratic_form R M) :=
+fun_like.coe_injective.add_comm_monoid _ coe_fn_zero coe_fn_add (λ _ _, coe_fn_smul _ _)
 
 /-- `@coe_fn (quadratic_form R M)` as an `add_monoid_hom`.
 
@@ -328,8 +385,6 @@ def eval_add_monoid_hom (m : M) : quadratic_form R M →+ R :=
 
 section sum
 
-open_locale big_operators
-
 @[simp] lemma coe_fn_sum {ι : Type*} (Q : ι → quadratic_form R M) (s : finset ι) :
   ⇑(∑ i in s, Q i) = ∑ i in s, Q i :=
 (coe_fn_add_monoid_hom : _ →+ (M → R)).map_sum Q s
@@ -340,47 +395,61 @@ open_locale big_operators
 
 end sum
 
-section distrib_mul_action
-
-variables [monoid S] [distrib_mul_action S R] [smul_comm_class S R R]
-
-instance : distrib_mul_action S (quadratic_form R M) :=
+instance [monoid S] [distrib_mul_action S R] [smul_comm_class S R R] :
+  distrib_mul_action S (quadratic_form R M) :=
 { mul_smul := λ a b Q, ext (λ x, by simp only [smul_apply, mul_smul]),
   one_smul := λ Q, ext (λ x, by simp only [quadratic_form.smul_apply, one_smul]),
   smul_add := λ a Q Q', by { ext, simp only [add_apply, smul_apply, smul_add] },
   smul_zero := λ a, by { ext, simp only [zero_apply, smul_apply, smul_zero] }, }
 
-end distrib_mul_action
-
-section module
-
 instance [semiring S] [module S R] [smul_comm_class S R R] : module S (quadratic_form R M) :=
 { zero_smul := λ Q, by { ext, simp only [zero_apply, smul_apply, zero_smul] },
   add_smul := λ a b Q, by { ext, simp only [add_apply, smul_apply, add_smul] } }
 
-end module
+end semiring_operators
+
+section ring_operators
+variables [ring R] [add_comm_group M] [module R M]
+
+instance : has_neg (quadratic_form R M) :=
+⟨ λ Q,
+  { to_fun := -Q,
+    to_fun_smul := λ a x,
+      by simp only [pi.neg_apply, map_smul, mul_neg],
+    exists_companion' :=
+      let ⟨B, h⟩ := Q.exists_companion in
+      ⟨-B, λ x y, by simp_rw [pi.neg_apply, h, bilin_form.neg_apply, neg_add] ⟩ } ⟩
+
+@[simp] lemma coe_fn_neg (Q : quadratic_form R M) : ⇑(-Q) = -Q := rfl
+
+@[simp] lemma neg_apply (Q : quadratic_form R M) (x : M) : (-Q) x = -Q x := rfl
+
+instance : has_sub (quadratic_form R M) :=
+⟨ λ Q Q', (Q + -Q').copy (Q - Q') (sub_eq_add_neg _ _) ⟩
+
+@[simp] lemma coe_fn_sub (Q Q' : quadratic_form R M) : ⇑(Q - Q') = Q - Q' := rfl
+
+@[simp] lemma sub_apply (Q Q' : quadratic_form R M) (x : M) : (Q - Q') x = Q x - Q' x := rfl
+
+instance : add_comm_group (quadratic_form R M) :=
+fun_like.coe_injective.add_comm_group _
+  coe_fn_zero coe_fn_add coe_fn_neg coe_fn_sub (λ _ _, coe_fn_smul _ _) (λ _ _, coe_fn_smul _ _)
+
+end ring_operators
 
 section comp
 
-variables {N : Type v} [add_comm_group N] [module R N]
+variables [semiring R] [add_comm_monoid M] [module R M]
+variables {N : Type v} [add_comm_monoid N] [module R N]
 
 /-- Compose the quadratic form with a linear function. -/
 def comp (Q : quadratic_form R N) (f : M →ₗ[R] N) :
   quadratic_form R M :=
 { to_fun := λ x, Q (f x),
   to_fun_smul := λ a x, by simp only [map_smul, f.map_smul],
-  polar_add_left' := λ x x' y,
-    by convert polar_add_left (f x) (f x') (f y) using 1;
-      simp only [polar, f.map_add],
-  polar_smul_left' := λ a x y,
-    by convert polar_smul_left a (f x) (f y) using 1;
-      simp only [polar, f.map_smul, f.map_add, smul_eq_mul],
-  polar_add_right' := λ x y y',
-    by convert polar_add_right (f x) (f y) (f y') using 1;
-      simp only [polar, f.map_add],
-  polar_smul_right' := λ a x y,
-    by convert polar_smul_right a (f x) (f y) using 1;
-      simp only [polar, f.map_smul, f.map_add, smul_eq_mul] }
+  exists_companion' :=
+    let ⟨B, h⟩ := Q.exists_companion in
+    ⟨B.comp f f, λ x y, by simp_rw [f.map_add, h, bilin_form.comp_apply]⟩ }
 
 @[simp] lemma comp_apply (Q : quadratic_form R N) (f : M →ₗ[R] N) (x : M) :
   (Q.comp f) x = Q (f x) := rfl
@@ -388,63 +457,45 @@ def comp (Q : quadratic_form R N) (f : M →ₗ[R] N) :
 /-- Compose a quadratic form with a linear function on the left. -/
 @[simps {simp_rhs := tt}]
 def _root_.linear_map.comp_quadratic_form {S : Type*}
-  [comm_ring S] [algebra S R] [module S M] [is_scalar_tower S R M]
+  [comm_semiring S] [algebra S R] [module S M] [is_scalar_tower S R M]
   (f : R →ₗ[S] S) (Q : quadratic_form R M) :
   quadratic_form S M :=
-{ to_fun := f ∘ Q,
-  to_fun_smul := λ b x, by rw [function.comp_apply, Q.map_smul_of_tower b x, f.map_smul,
-                               smul_eq_mul],
-  polar_add_left' := λ x x' y, by simp only [polar_comp, f.map_add, polar_add_left],
-  polar_smul_left' := λ b x y, by simp only [polar_comp, f.map_smul, polar_smul_left_of_tower],
-  polar_add_right' := λ x y y', by simp only [polar_comp, f.map_add, polar_add_right],
-  polar_smul_right' := λ b x y, by simp only [polar_comp, f.map_smul, polar_smul_right_of_tower], }
+{ to_fun := λ x, f (Q x),
+  to_fun_smul := λ b x, by rw [Q.map_smul_of_tower b x, f.map_smul, smul_eq_mul],
+  exists_companion' :=
+    let ⟨B, h⟩ := Q.exists_companion in
+    ⟨f.comp_bilin_form B, λ x y, by simp_rw [h, f.map_add, linear_map.comp_bilin_form_apply]⟩ }
 
 end comp
 
 section comm_ring
-
-/-- Create a quadratic form in a commutative ring by proving only one side of the bilinearity. -/
-def mk_left (f : M → R₁)
-  (to_fun_smul : ∀ a x, f (a • x) = a * a * f x)
-  (polar_add_left : ∀ x x' y, polar f (x + x') y = polar f x y + polar f x' y)
-  (polar_smul_left : ∀ a x y, polar f (a • x) y = a * polar f x y) :
-  quadratic_form R₁ M :=
-{ to_fun := f,
-  to_fun_smul := to_fun_smul,
-  polar_add_left' := polar_add_left,
-  polar_smul_left' := polar_smul_left,
-  polar_add_right' :=
-    λ x y y', by rw [polar_comm, polar_add_left, polar_comm f y x, polar_comm f y' x],
-  polar_smul_right' :=
-    λ a x y, by rw [polar_comm, polar_smul_left, polar_comm f y x, smul_eq_mul] }
+variables [comm_semiring R] [add_comm_monoid M] [module R M]
 
 /-- The product of linear forms is a quadratic form. -/
-def lin_mul_lin (f g : M →ₗ[R₁] R₁) : quadratic_form R₁ M :=
-mk_left (f * g)
-  (λ a x,
-    by { simp only [smul_eq_mul, ring_hom.id_apply, pi.mul_apply, linear_map.map_smulₛₗ], ring })
-  (λ x x' y, by { simp only [polar, pi.mul_apply, linear_map.map_add], ring })
-  (λ a x y, begin
-      simp only [polar, pi.mul_apply, linear_map.map_add, linear_map.map_smul, smul_eq_mul], ring
-    end)
+def lin_mul_lin (f g : M →ₗ[R] R) : quadratic_form R M :=
+{ to_fun := f * g,
+  to_fun_smul := λ a x,
+    by { simp only [smul_eq_mul, ring_hom.id_apply, pi.mul_apply, linear_map.map_smulₛₗ], ring },
+  exists_companion' := ⟨
+    bilin_form.lin_mul_lin f g + bilin_form.lin_mul_lin g f, λ x y, by { simp, ring }⟩ }
 
 @[simp]
-lemma lin_mul_lin_apply (f g : M →ₗ[R₁] R₁) (x) : lin_mul_lin f g x = f x * g x := rfl
+lemma lin_mul_lin_apply (f g : M →ₗ[R] R) (x) : lin_mul_lin f g x = f x * g x := rfl
 
 @[simp]
-lemma add_lin_mul_lin (f g h : M →ₗ[R₁] R₁) :
+lemma add_lin_mul_lin (f g h : M →ₗ[R] R) :
   lin_mul_lin (f + g) h = lin_mul_lin f h + lin_mul_lin g h :=
 ext (λ x, add_mul _ _ _)
 
 @[simp]
-lemma lin_mul_lin_add (f g h : M →ₗ[R₁] R₁) :
+lemma lin_mul_lin_add (f g h : M →ₗ[R] R) :
   lin_mul_lin f (g + h) = lin_mul_lin f g + lin_mul_lin f h :=
 ext (λ x, mul_add _ _ _)
 
-variables {N : Type v} [add_comm_group N] [module R₁ N]
+variables {N : Type v} [add_comm_monoid N] [module R N]
 
 @[simp]
-lemma lin_mul_lin_comp (f g : M →ₗ[R₁] R₁) (h : N →ₗ[R₁] M) :
+lemma lin_mul_lin_comp (f g : M →ₗ[R] R) (h : N →ₗ[R] M) :
   (lin_mul_lin f g).comp h = lin_mul_lin (f.comp h) (g.comp h) :=
 rfl
 
@@ -452,15 +503,15 @@ variables {n : Type*}
 
 /-- `sq` is the quadratic form mapping the vector `x : R₁` to `x * x` -/
 @[simps]
-def sq : quadratic_form R₁ R₁ :=
+def sq : quadratic_form R R :=
 lin_mul_lin linear_map.id linear_map.id
 
 /-- `proj i j` is the quadratic form mapping the vector `x : n → R₁` to `x i * x j` -/
-def proj (i j : n) : quadratic_form R₁ (n → R₁) :=
-lin_mul_lin (@linear_map.proj _ _ _ (λ _, R₁) _ _ i) (@linear_map.proj _ _ _ (λ _, R₁) _ _ j)
+def proj (i j : n) : quadratic_form R (n → R) :=
+lin_mul_lin (@linear_map.proj _ _ _ (λ _, R) _ _ i) (@linear_map.proj _ _ _ (λ _, R) _ _ j)
 
 @[simp]
-lemma proj_apply (i j : n) (x : n → R₁) : proj i j x = x i * x j := rfl
+lemma proj_apply (i j : n) (x : n → R) : proj i j x = x i * x j := rfl
 
 end comm_ring
 
@@ -475,27 +526,21 @@ forms to bilinear forms giving this identification is called the `associated`
 quadratic form.
 -/
 
-variables {B : bilin_form R M}
 
 namespace bilin_form
 open quadratic_form
 
-lemma polar_to_quadratic_form (x y : M) : polar (λ x, B x x) x y = B x y + B y x :=
-by { simp only [add_assoc, add_sub_cancel', add_right, polar, add_left_inj, add_neg_cancel_left,
-  add_left, sub_eq_add_neg _ (B y y), add_comm (B y x) _] }
+section semiring
+
+variables [semiring R] [add_comm_monoid M] [module R M]
+variables {B : bilin_form R M}
 
 /-- A bilinear form gives a quadratic form by applying the argument twice. -/
 def to_quadratic_form (B : bilin_form R M) : quadratic_form R M :=
-⟨ λ x, B x x,
-  λ a x, by simp only [mul_assoc, smul_right, smul_left],
-  λ x x' y, by simp only [add_assoc, add_right, add_left_inj, polar_to_quadratic_form, add_left,
-    add_left_comm],
-  λ a x y, by simp only [smul_add, add_left_inj, polar_to_quadratic_form,
-    smul_right, smul_eq_mul, smul_left, smul_right, mul_add],
-  λ x y y', by simp only [add_assoc, add_right, add_left_inj,
-    polar_to_quadratic_form, add_left, add_left_comm],
-  λ a x y, by simp only [smul_add, add_left_inj, polar_to_quadratic_form,
-    smul_right, smul_eq_mul, smul_left, smul_right, mul_add]⟩
+{ to_fun := λ x, B x x,
+  to_fun_smul := λ a x, by simp only [mul_assoc, smul_right, smul_left],
+  exists_companion' :=
+    ⟨B + bilin_form.flip_hom ℕ B, λ x y, by { simp [add_add_add_comm, add_comm] }⟩ }
 
 @[simp] lemma to_quadratic_form_apply (B : bilin_form R M) (x : M) :
   B.to_quadratic_form x = B x x :=
@@ -506,12 +551,63 @@ variables (R M)
 @[simp] lemma to_quadratic_form_zero : (0 : bilin_form R M).to_quadratic_form = 0 := rfl
 end
 
+@[simp] lemma to_quadratic_form_add (B₁ B₂ : bilin_form R M) :
+  (B₁ + B₂).to_quadratic_form = B₁.to_quadratic_form + B₂.to_quadratic_form := rfl
+
+@[simp] lemma to_quadratic_form_smul [monoid S] [distrib_mul_action S R] [smul_comm_class S R R]
+  (a : S) (B : bilin_form R M) :
+  (a • B).to_quadratic_form = a • B.to_quadratic_form := rfl
+
+section
+variables (R M)
+/-- `bilin_form.to_quadratic_form` as an additive homomorphism -/
+@[simps] def to_quadratic_form_add_monoid_hom : bilin_form R M →+ quadratic_form R M :=
+{ to_fun := to_quadratic_form,
+  map_zero' := to_quadratic_form_zero _ _,
+  map_add' := to_quadratic_form_add }
+end
+
+@[simp] lemma to_quadratic_form_list_sum (B : list (bilin_form R M)) :
+  B.sum.to_quadratic_form = (B.map to_quadratic_form).sum :=
+map_list_sum (to_quadratic_form_add_monoid_hom R M) B
+
+@[simp] lemma to_quadratic_form_multiset_sum (B : multiset (bilin_form R M)) :
+  B.sum.to_quadratic_form = (B.map to_quadratic_form).sum :=
+map_multiset_sum (to_quadratic_form_add_monoid_hom R M) B
+
+@[simp] lemma to_quadratic_form_sum {ι : Type*} (s : finset ι) (B : ι → bilin_form R M) :
+  (∑ i in s, B i).to_quadratic_form = ∑ i in s, (B i).to_quadratic_form :=
+map_sum (to_quadratic_form_add_monoid_hom R M) B s
+
+@[simp] lemma to_quadratic_form_eq_zero {B : bilin_form R M} :
+  B.to_quadratic_form = 0 ↔ B.is_alt :=
+quadratic_form.ext_iff
+
+end semiring
+
+section ring
+variables [ring R] [add_comm_group M] [module R M]
+variables {B : bilin_form R M}
+
+lemma polar_to_quadratic_form (x y : M) : polar (λ x, B x x) x y = B x y + B y x :=
+by { simp only [add_assoc, add_sub_cancel', add_right, polar, add_left_inj, add_neg_cancel_left,
+  add_left, sub_eq_add_neg _ (B y y), add_comm (B y x) _] }
+
+@[simp] lemma to_quadratic_form_neg (B : bilin_form R M) :
+  (-B).to_quadratic_form = -B.to_quadratic_form := rfl
+
+@[simp] lemma to_quadratic_form_sub (B₁ B₂ : bilin_form R M) :
+  (B₁ - B₂).to_quadratic_form = B₁.to_quadratic_form - B₂.to_quadratic_form := rfl
+
+end ring
+
 end bilin_form
 
 namespace quadratic_form
 open bilin_form
 
 section associated_hom
+variables [ring R] [comm_ring R₁] [add_comm_group M] [module R M] [module R₁ M]
 variables (S) [comm_semiring S] [algebra S R]
 variables [invertible (2 : R)] {B₁ : bilin_form R M}
 
@@ -524,21 +620,12 @@ no nontrivial distinguished commutative subring, use `associated'`, which gives
 homomorphism (or more precisely a `ℤ`-linear map.) -/
 def associated_hom : quadratic_form R M →ₗ[S] bilin_form R M :=
 { to_fun := λ Q,
-  { bilin := λ x y, ⅟2 * polar Q x y,
-    bilin_add_left := λ x y z, by rw [← mul_add, polar_add_left],
-    bilin_smul_left := λ x y z, begin
-      have htwo : x * ⅟2 = ⅟2 * x := (commute.one_right x).bit0_right.inv_of_right,
-      simp only [polar_smul_left, ← mul_assoc, htwo]
-    end,
-    bilin_add_right := λ x y z, by rw [← mul_add, polar_add_right],
-    bilin_smul_right := λ x y z, begin
-      have htwo : x * ⅟2 = ⅟2 * x := (commute.one_right x).bit0_right.inv_of_right,
-      simp only [polar_smul_right, ← mul_assoc, htwo]
-    end },
-  map_add' := λ Q Q', by { ext, simp only [bilin_form.add_apply, coe_fn_mk, polar_add, coe_fn_add,
-    mul_add] },
-  map_smul' := λ s Q, by { ext, simp only [ring_hom.id_apply, polar_smul, algebra.mul_smul_comm,
-    coe_fn_mk, coe_fn_smul, bilin_form.smul_apply] } }
+  ((•) : submonoid.center R → bilin_form R M → bilin_form R M)
+    (⟨⅟2, λ x, (commute.one_right x).bit0_right.inv_of_right⟩) Q.polar_bilin,
+  map_add' := λ Q Q', by { ext, simp only [bilin_form.add_apply, bilin_form.smul_apply, coe_fn_mk,
+    polar_bilin_apply, polar_add, coe_fn_add, smul_add] },
+  map_smul' := λ s Q, by { ext, simp only [ring_hom.id_apply, polar_smul, smul_comm s,
+    polar_bilin_apply, coe_fn_mk, coe_fn_smul, bilin_form.smul_apply] } }
 
 variables (Q : quadratic_form R M) (S)
 
@@ -593,10 +680,9 @@ abbreviation associated' : quadratic_form R M →ₗ[ℤ] bilin_form R M :=
 associated_hom ℤ
 
 /-- Symmetric bilinear forms can be lifted to quadratic forms -/
-instance : can_lift (bilin_form R M) (quadratic_form R M) :=
-{ coe := associated_hom ℕ,
-  cond := bilin_form.is_symm,
-  prf := λ B hB, ⟨B.to_quadratic_form, associated_left_inverse _ hB⟩ }
+instance can_lift :
+  can_lift (bilin_form R M) (quadratic_form R M) (associated_hom ℕ) bilin_form.is_symm :=
+{ prf := λ B hB, ⟨B.to_quadratic_form, associated_left_inverse _ hB⟩ }
 
 /-- There exists a non-null vector with respect to any quadratic form `Q` whose associated
 bilinear form is non-zero, i.e. there exists `x` such that `Q x ≠ 0`. -/
@@ -612,6 +698,7 @@ end
 end associated_hom
 
 section associated
+variables [comm_ring R₁] [add_comm_group M] [module R₁ M]
 variables [invertible (2 : R₁)]
 
 -- Note:  When possible, rather than writing lemmas about `associated`, write a lemma applying to
@@ -619,7 +706,7 @@ variables [invertible (2 : R₁)]
 
 /-- `associated` is the linear map that sends a quadratic form over a commutative ring to its
 associated symmetric bilinear form. -/
-abbreviation associated : quadratic_form R₁ M →ₗ[R₁] bilin_form R₁ M :=
+@[reducible] def associated : quadratic_form R₁ M →ₗ[R₁] bilin_form R₁ M :=
 associated_hom R₁
 
 @[simp] lemma associated_lin_mul_lin (f g : M →ₗ[R₁] R₁) :
@@ -632,6 +719,8 @@ by { ext, simp only [smul_add, algebra.id.smul_eq_mul, bilin_form.lin_mul_lin_ap
 end associated
 
 section anisotropic
+section semiring
+variables [semiring R] [add_comm_monoid M] [module R M]
 
 /-- An anisotropic quadratic form is zero only on zero vectors. -/
 def anisotropic (Q : quadratic_form R M) : Prop := ∀ x, Q x = 0 → x = 0
@@ -642,7 +731,11 @@ by simp only [anisotropic, not_forall, exists_prop, and_comm]
 
 lemma anisotropic.eq_zero_iff {Q : quadratic_form R M} (h : anisotropic Q) {x : M} :
   Q x = 0 ↔ x = 0 :=
-⟨h x, λ h, h.symm ▸ map_zero⟩
+⟨h x, λ h, h.symm ▸ map_zero Q⟩
+
+end semiring
+section ring
+variables [ring R] [add_comm_group M] [module R M]
 
 /-- The associated bilinear form of an anisotropic quadratic form is nondegenerate. -/
 lemma nondegenerate_of_anisotropic [invertible (2 : R)] (Q : quadratic_form R M)
@@ -654,11 +747,14 @@ begin
   exact (associated_eq_self_apply _ _ x).symm,
 end
 
+end ring
+
 end anisotropic
 
 section pos_def
 
-variables {R₂ : Type u} [ordered_ring R₂] [module R₂ M] {Q₂ : quadratic_form R₂ M}
+variables {R₂ : Type u} [ordered_ring R₂] [add_comm_monoid M] [module R₂ M]
+variables {Q₂ : quadratic_form R₂ M}
 
 /-- A positive definite quadratic form is positive on nonzero vectors. -/
 def pos_def (Q₂ : quadratic_form R₂ M) : Prop := ∀ x ≠ 0, 0 < Q₂ x
@@ -671,7 +767,7 @@ variables {n : Type*}
 
 lemma pos_def.nonneg {Q : quadratic_form R₂ M} (hQ : pos_def Q) (x : M) :
   0 ≤ Q x :=
-(eq_or_ne x 0).elim (λ h, h.symm ▸ (map_zero).symm.le) (λ h, (hQ _ h).le)
+(eq_or_ne x 0).elim (λ h, h.symm ▸ (map_zero Q).symm.le) (λ h, (hQ _ h).le)
 
 lemma pos_def.anisotropic {Q : quadratic_form R₂ M} (hQ : Q.pos_def) : Q.anisotropic :=
 λ x hQx, classical.by_contradiction $ λ hx, lt_irrefl (0 : R₂) $ begin
@@ -695,7 +791,7 @@ lemma pos_def.add (Q Q' : quadratic_form R₂ M) (hQ : pos_def Q) (hQ' : pos_def
 lemma lin_mul_lin_self_pos_def {R} [linear_ordered_comm_ring R] [module R M]
   (f : M →ₗ[R] R) (hf : linear_map.ker f = ⊥) :
   pos_def (lin_mul_lin f f) :=
-λ x hx, mul_self_pos.2 (λ h, hx (linear_map.ker_eq_bot.mp hf (by rw [h, linear_map.map_zero])))
+λ x hx, mul_self_pos.2 (λ h, hx $ linear_map.ker_eq_bot'.mp hf _ h)
 
 end pos_def
 end quadratic_form
@@ -711,6 +807,7 @@ The determinant of the matrix is the discriminant of the quadratic form.
 -/
 
 variables {n : Type w} [fintype n] [decidable_eq n]
+variables [comm_ring R₁] [add_comm_monoid M] [module R₁ M]
 
 /-- `M.to_quadratic_form` is the map `λ x, col x ⬝ M ⬝ row x` as a quadratic form. -/
 def matrix.to_quadratic_form' (M : matrix n n R₁) :
@@ -728,12 +825,19 @@ lemma quadratic_form.to_matrix'_smul (a : R₁) (Q : quadratic_form R₁ (n →
   (a • Q).to_matrix' = a • Q.to_matrix' :=
 by simp only [to_matrix', linear_equiv.map_smul, linear_map.map_smul]
 
+lemma quadratic_form.is_symm_to_matrix' (Q : quadratic_form R₁ (n → R₁)) :
+  Q.to_matrix'.is_symm :=
+begin
+  ext i j,
+  rw [to_matrix', bilin_form.to_matrix'_apply, bilin_form.to_matrix'_apply, associated_is_symm]
+end
+
 end
 
 namespace quadratic_form
 
 variables {n : Type w} [fintype n]
-variables [decidable_eq n] [invertible (2 : R₁)]
+variables [comm_ring R₁] [decidable_eq n] [invertible (2 : R₁)]
 variables {m : Type w} [decidable_eq m] [fintype m]
 open_locale matrix
 
@@ -762,79 +866,19 @@ end quadratic_form
 
 namespace quadratic_form
 
-variables {M₁ : Type*} {M₂ : Type*} {M₃ : Type*}
-variables [add_comm_group M₁] [add_comm_group M₂] [add_comm_group M₃]
-variables [module R M₁] [module R M₂] [module R M₃]
-
-/-- An isometry between two quadratic spaces `M₁, Q₁` and `M₂, Q₂` over a ring `R`,
-is a linear equivalence between `M₁` and `M₂` that commutes with the quadratic forms. -/
-@[nolint has_inhabited_instance] structure isometry
-  (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) extends M₁ ≃ₗ[R] M₂ :=
-(map_app' : ∀ m, Q₂ (to_fun m) = Q₁ m)
-
-/-- Two quadratic forms over a ring `R` are equivalent
-if there exists an isometry between them:
-a linear equivalence that transforms one quadratic form into the other. -/
-def equivalent (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) := nonempty (Q₁.isometry Q₂)
-
-namespace isometry
-
-variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}
-
-instance : has_coe (Q₁.isometry Q₂) (M₁ ≃ₗ[R] M₂) := ⟨isometry.to_linear_equiv⟩
-
-@[simp] lemma to_linear_equiv_eq_coe (f : Q₁.isometry Q₂) : f.to_linear_equiv = f := rfl
-
-instance : has_coe_to_fun (Q₁.isometry Q₂) (λ _, M₁ → M₂) := ⟨λ f, ⇑(f : M₁ ≃ₗ[R] M₂)⟩
-
-@[simp] lemma coe_to_linear_equiv (f : Q₁.isometry Q₂) : ⇑(f : M₁ ≃ₗ[R] M₂) = f := rfl
-
-@[simp] lemma map_app (f : Q₁.isometry Q₂) (m : M₁) : Q₂ (f m) = Q₁ m := f.map_app' m
-
-/-- The identity isometry from a quadratic form to itself. -/
-@[refl]
-def refl (Q : quadratic_form R M) : Q.isometry Q :=
-{ map_app' := λ m, rfl,
-  .. linear_equiv.refl R M }
-
-/-- The inverse isometry of an isometry between two quadratic forms. -/
-@[symm]
-def symm (f : Q₁.isometry Q₂) : Q₂.isometry Q₁ :=
-{ map_app' := by { intro m, rw ← f.map_app, congr, exact f.to_linear_equiv.apply_symm_apply m },
-  .. (f : M₁ ≃ₗ[R] M₂).symm }
-
-/-- The composition of two isometries between quadratic forms. -/
-@[trans]
-def trans (f : Q₁.isometry Q₂) (g : Q₂.isometry Q₃) : Q₁.isometry Q₃ :=
-{ map_app' := by { intro m, rw [← f.map_app, ← g.map_app], refl },
-  .. (f : M₁ ≃ₗ[R] M₂).trans (g : M₂ ≃ₗ[R] M₃) }
-
-end isometry
-
-namespace equivalent
-
-variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}
-
-@[refl]
-lemma refl (Q : quadratic_form R M) : Q.equivalent Q := ⟨isometry.refl Q⟩
-
-@[symm]
-lemma symm (h : Q₁.equivalent Q₂) : Q₂.equivalent Q₁ := h.elim $ λ f, ⟨f.symm⟩
-
-@[trans]
-lemma trans (h : Q₁.equivalent Q₂) (h' : Q₂.equivalent Q₃) : Q₁.equivalent Q₃ :=
-h'.elim $ h.elim $ λ f g, ⟨f.trans g⟩
-
-end equivalent
-
 end quadratic_form
 
 namespace bilin_form
+section semiring
+variables [semiring R] [add_comm_monoid M] [module R M]
 
 /-- A bilinear form is nondegenerate if the quadratic form it is associated with is anisotropic. -/
 lemma nondegenerate_of_anisotropic
   {B : bilin_form R M} (hB : B.to_quadratic_form.anisotropic) : B.nondegenerate :=
 λ x hx, hB _ (hx x)
+end semiring
+
+variables [ring R] [add_comm_group M] [module R M]
 
 /-- There exists a non-null vector with respect to any symmetric, nonzero bilinear form `B`
 on a module `M` over a ring `R` with invertible `2`, i.e. there exists some
@@ -898,31 +942,19 @@ begin
     { rw [is_ortho, hB₂],
       exact (v' j).prop _ (submodule.mem_span_singleton_self x) },
     { exact (v' i).prop _ (submodule.mem_span_singleton_self x) },
-    { exact hv₁ _ _ (ne_of_apply_ne _ hij), }, }
+    { exact hv₁ (ne_of_apply_ne _ hij), }, }
 end
 
 end bilin_form
 
 namespace quadratic_form
 
-open_locale big_operators
-
 open finset bilin_form
 
-variables {M₁ : Type*} [add_comm_group M₁] [module R M₁]
+variables {M₁ : Type*} [semiring R] [comm_semiring R₁] [add_comm_monoid M] [add_comm_monoid M₁]
+variables [module R M] [module R M₁]
 variables {ι : Type*} [fintype ι] {v : basis ι R M}
 
-/-- A quadratic form composed with a `linear_equiv` is isometric to itself. -/
-def isometry_of_comp_linear_equiv (Q : quadratic_form R M) (f : M₁ ≃ₗ[R] M) :
-  Q.isometry (Q.comp (f : M₁ →ₗ[R] M)) :=
-{ map_app' :=
-  begin
-    intro,
-    simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.to_fun_eq_coe,
-               linear_equiv.apply_symm_apply, f.apply_symm_apply],
-  end,
-  .. f.symm }
-
 /-- Given a quadratic form `Q` and a basis, `basis_repr` is the basis representation of `Q`. -/
 noncomputable def basis_repr (Q : quadratic_form R M) (v : basis ι R M) :
   quadratic_form R (ι → R) :=
@@ -933,20 +965,16 @@ lemma basis_repr_apply (Q : quadratic_form R M) (w : ι → R) :
   Q.basis_repr v w = Q (∑ i : ι, w i • v i) :=
 by { rw ← v.equiv_fun_symm_apply, refl }
 
-/-- A quadratic form is isometric to its bases representations. -/
-noncomputable def isometry_basis_repr (Q : quadratic_form R M) (v : basis ι R M):
-  isometry Q (Q.basis_repr v) :=
-isometry_of_comp_linear_equiv Q v.equiv_fun.symm
-
 section
 
-variable (R₁)
+variables (R₁)
 
 /-- The weighted sum of squares with respect to some weight as a quadratic form.
 
 The weights are applied using `•`; typically this definition is used either with `S = R₁` or
 `[algebra S R₁]`, although this is stated more generally. -/
-def weighted_sum_squares [monoid S] [distrib_mul_action S R₁] [smul_comm_class S R₁ R₁]
+def weighted_sum_squares [monoid S] [distrib_mul_action S R₁]
+  [smul_comm_class S R₁ R₁]
   (w : ι → S) : quadratic_form R₁ (ι → R₁) :=
 ∑ i : ι, w i • proj i i
 
@@ -959,7 +987,8 @@ lemma weighted_sum_squares_apply [monoid S] [distrib_mul_action S R₁] [smul_co
 quadratic_form.sum_apply _ _ _
 
 /-- On an orthogonal basis, the basis representation of `Q` is just a sum of squares. -/
-lemma basis_repr_eq_of_is_Ortho [invertible (2 : R₁)]
+lemma basis_repr_eq_of_is_Ortho
+  {R₁ M} [comm_ring R₁] [add_comm_group M] [module R₁ M] [invertible (2 : R₁)]
   (Q : quadratic_form R₁ M) (v : basis ι R₁ M) (hv₂ : (associated Q).is_Ortho v) :
   Q.basis_repr v = weighted_sum_squares _ (λ i, Q (v i)) :=
 begin
@@ -970,41 +999,8 @@ begin
   { rw [smul_left, smul_right, smul_eq_mul], ring },
   { intros i _ hij,
     rw [smul_left, smul_right,
-        show associated_hom R₁ Q (v j) (v i) = 0, from hv₂ j i hij.symm,
+        show associated_hom R₁ Q (v j) (v i) = 0, from hv₂ hij.symm,
         mul_zero, mul_zero] },
 end
 
-variables {V : Type*} {K : Type*} [field K] [invertible (2 : K)]
-variables [add_comm_group V] [module K V]
-
-/-- Given an orthogonal basis, a quadratic form is isometric with a weighted sum of squares. -/
-noncomputable def isometry_weighted_sum_squares (Q : quadratic_form K V)
-  (v : basis (fin (finite_dimensional.finrank K V)) K V)
-  (hv₁ : (associated Q).is_Ortho v):
-  Q.isometry (weighted_sum_squares K (λ i, Q (v i))) :=
-begin
-  let iso := Q.isometry_basis_repr v,
-  refine ⟨iso, λ m, _⟩,
-  convert iso.map_app m,
-  rw basis_repr_eq_of_is_Ortho _ _ hv₁,
-end
-
-variables [finite_dimensional K V]
-
-lemma equivalent_weighted_sum_squares (Q : quadratic_form K V) :
-  ∃ w : fin (finite_dimensional.finrank K V) → K, equivalent Q (weighted_sum_squares K w) :=
-let ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q) in
-  ⟨_, ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩
-
-lemma equivalent_weighted_sum_squares_units_of_nondegenerate'
-  (Q : quadratic_form K V) (hQ : (associated Q).nondegenerate) :
-  ∃ w : fin (finite_dimensional.finrank K V) → Kˣ,
-    equivalent Q (weighted_sum_squares K w) :=
-begin
-  obtain ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q),
-  have hv₂ := hv₁.not_is_ortho_basis_self_of_nondegenerate hQ,
-  simp_rw [is_ortho, associated_eq_self_apply] at hv₂,
-  exact ⟨λ i, units.mk0 _ (hv₂ i), ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩,
-end
-
 end quadratic_form
diff --git a/src/linear_algebra/quadratic_form/complex.lean b/src/linear_algebra/quadratic_form/complex.lean
index 63190d440fec2..9a42c8445a840 100644
--- a/src/linear_algebra/quadratic_form/complex.lean
+++ b/src/linear_algebra/quadratic_form/complex.lean
@@ -3,12 +3,15 @@ Copyright (c) 2020 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen, Kexing Ying, Eric Wieser
 -/
-import linear_algebra.quadratic_form.basic
-import analysis.special_functions.pow
+import linear_algebra.quadratic_form.isometry
+import analysis.special_functions.pow.complex
 
 /-!
 # Quadratic forms over the complex numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 `equivalent_sum_squares`: A nondegenerate quadratic form over the complex numbers is equivalent to
 a sum of squares.
 
@@ -56,7 +59,7 @@ begin
   change v j * v j = ↑(w j) * ((v j * ↑(w j) ^ -(1 / 2 : ℂ)) * (v j * ↑(w j) ^ -(1 / 2 : ℂ))),
   suffices : v j * v j = w j ^ - (1 / 2 : ℂ) * w j ^ - (1 / 2 : ℂ) * w j * v j * v j,
   { rw [this], ring },
-  rw [← complex.cpow_add _ _ (w j).ne_zero, show - (1 / 2 : ℂ) + - (1 / 2) = -1, by ring,
+  rw [← complex.cpow_add _ _ (w j).ne_zero, show -(1 / 2 : ℂ) + -(1 / 2) = -1, by simp [← two_mul],
       complex.cpow_neg_one, inv_mul_cancel (w j).ne_zero, one_mul],
 end
 
diff --git a/src/linear_algebra/quadratic_form/dual.lean b/src/linear_algebra/quadratic_form/dual.lean
new file mode 100644
index 0000000000000..68ed89fab74cb
--- /dev/null
+++ b/src/linear_algebra/quadratic_form/dual.lean
@@ -0,0 +1,151 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import linear_algebra.quadratic_form.isometry
+import linear_algebra.quadratic_form.prod
+/-!
+# Quadratic form structures related to `module.dual`
+
+## Main definitions
+
+* `bilin_form.dual_prod R M`, the bilinear form on `(f, x) : module.dual R M × M` defined as
+  `f x`.
+* `quadratic_form.dual_prod R M`, the quadratic form on `(f, x) : module.dual R M × M` defined as
+  `f x`.
+* `quadratic_form.to_dual_prod : M × M →ₗ[R] module.dual R M × M` a form-preserving map from
+  `(Q.prod $ -Q)` to `quadratic_form.dual_prod R M`. Note that we do not have the morphism
+  version of `quadratic_form.isometry`, so for now this is stated without full bundling.
+
+-/
+
+variables (R M N : Type*)
+
+namespace bilin_form
+
+section semiring
+variables [comm_semiring R] [add_comm_monoid M] [module R M]
+
+/-- The symmetric bilinear form on `module.dual R M × M` defined as
+`B (f, x) (g, y) = f y + g x`. -/
+@[simps]
+def dual_prod : bilin_form R (module.dual R M × M) :=
+linear_map.to_bilin $
+  (linear_map.applyₗ.comp (linear_map.snd R (module.dual R M) M)).compl₂
+    (linear_map.fst R (module.dual R M) M) +
+  ((linear_map.applyₗ.comp (linear_map.snd R (module.dual R M) M)).compl₂
+    (linear_map.fst R (module.dual R M) M)).flip
+
+lemma is_symm_dual_prod : (dual_prod R M).is_symm :=
+λ x y, add_comm _ _
+
+end semiring
+
+section ring
+variables [comm_ring R] [add_comm_group M] [module R M]
+
+lemma nondenerate_dual_prod :
+  (dual_prod R M).nondegenerate ↔ function.injective (module.dual.eval R M) :=
+begin
+  classical,
+  rw nondegenerate_iff_ker_eq_bot,
+  rw linear_map.ker_eq_bot,
+  let e := linear_equiv.prod_comm R _ _
+    ≪≫ₗ module.dual_prod_dual_equiv_dual R (module.dual R M) M,
+  let h_d := e.symm.to_linear_map.comp (dual_prod R M).to_lin,
+  refine (function.injective.of_comp_iff e.symm.injective (dual_prod R M).to_lin).symm.trans _,
+  rw [←linear_equiv.coe_to_linear_map, ←linear_map.coe_comp],
+  change function.injective h_d ↔ _,
+  have : h_d = linear_map.prod_map (linear_map.id) (module.dual.eval R M),
+  { refine linear_map.ext (λ x, prod.ext _ _),
+    { ext,
+      dsimp [h_d, module.dual.eval, linear_equiv.prod_comm],
+      simp },
+    { ext,
+      dsimp [h_d, module.dual.eval, linear_equiv.prod_comm],
+      simp } },
+  rw [this, linear_map.coe_prod_map],
+  refine prod.map_injective.trans _,
+  exact and_iff_right function.injective_id,
+end
+
+end ring
+
+end bilin_form
+
+namespace quadratic_form
+
+section semiring
+variables [comm_semiring R] [add_comm_monoid M] [add_comm_monoid N] [module R M] [module R N]
+
+/-- The quadratic form on `module.dual R M × M` defined as `Q (f, x) = f x`. -/
+@[simps]
+def dual_prod : quadratic_form R (module.dual R M × M) :=
+{ to_fun := λ p, p.1 p.2,
+  to_fun_smul := λ a p, by rw [prod.smul_fst, prod.smul_snd, linear_map.smul_apply,
+                               linear_map.map_smul, smul_eq_mul, smul_eq_mul, mul_assoc],
+  exists_companion' := ⟨bilin_form.dual_prod R M, λ p q, begin
+    rw [bilin_form.dual_prod_apply, prod.fst_add, prod.snd_add, linear_map.add_apply, map_add,
+      map_add, add_right_comm _ (q.1 q.2), add_comm (q.1 p.2) (p.1 q.2), ←add_assoc, ←add_assoc],
+  end⟩ }
+
+@[simp]
+lemma _root_.bilin_form.dual_prod.to_quadratic_form :
+  (bilin_form.dual_prod R M).to_quadratic_form = 2 • dual_prod R M :=
+ext $ λ a, (two_nsmul _).symm
+
+variables {R M N}
+
+/-- Any module isomorphism induces a quadratic isomorphism between the corresponding `dual_prod.` -/
+@[simps]
+def dual_prod_isometry (f : M ≃ₗ[R] N) :
+  (dual_prod R M).isometry (dual_prod R N) :=
+{ to_linear_equiv := f.dual_map.symm.prod f,
+  map_app' := λ x, fun_like.congr_arg x.fst $ f.symm_apply_apply _ }
+
+/-- `quadratic_form.dual_prod` commutes (isometrically) with `quadratic_form.prod`. -/
+@[simps]
+def dual_prod_prod_isometry :
+  (dual_prod R (M × N)).isometry ((dual_prod R M).prod (dual_prod R N)) :=
+{ to_linear_equiv :=
+  ((module.dual_prod_dual_equiv_dual R M N).symm.prod (linear_equiv.refl R (M × N)))
+    ≪≫ₗ linear_equiv.prod_prod_prod_comm R _ _ M N,
+  map_app' := λ m,
+    (m.fst.map_add _ _).symm.trans $ fun_like.congr_arg m.fst $ prod.ext (add_zero _) (zero_add _) }
+
+end semiring
+
+section ring
+variables [comm_ring R] [add_comm_group M] [module R M]
+
+variables {R M}
+
+/-- The isometry sending `(Q.prod $ -Q)` to `(quadratic_form.dual_prod R M)`.
+
+This is `σ` from Proposition 4.8, page 84 of
+[*Hermitian K-Theory and Geometric Applications*][hyman1973]; though we swap the order of the pairs.
+-/
+@[simps]
+def to_dual_prod (Q : quadratic_form R M) [invertible (2 : R)] :
+  M × M →ₗ[R] module.dual R M × M :=
+linear_map.prod
+  (Q.associated.to_lin.comp (linear_map.fst _ _ _)
+    + Q.associated.to_lin.comp (linear_map.snd _ _ _))
+  ((linear_map.fst _ _ _ - linear_map.snd _ _ _))
+
+lemma to_dual_prod_isometry [invertible (2 : R)] (Q : quadratic_form R M) (x : M × M) :
+  quadratic_form.dual_prod R M (to_dual_prod Q x) = (Q.prod $ -Q) x :=
+begin
+  dsimp only [to_dual_prod, associated, associated_hom],
+  dsimp,
+  simp [polar_comm _ x.1 x.2, ←sub_add, mul_sub, sub_mul, smul_sub, submonoid.smul_def,
+    ←sub_eq_add_neg (Q x.1) (Q x.2)],
+end
+
+-- TODO: show that `to_dual_prod` is an equivalence
+
+end ring
+
+end quadratic_form
diff --git a/src/linear_algebra/quadratic_form/isometry.lean b/src/linear_algebra/quadratic_form/isometry.lean
new file mode 100644
index 0000000000000..7c97543e99937
--- /dev/null
+++ b/src/linear_algebra/quadratic_form/isometry.lean
@@ -0,0 +1,147 @@
+/-
+Copyright (c) 2020 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying, Eric Wieser
+-/
+
+import linear_algebra.quadratic_form.basic
+
+/-!
+# Isometries with respect to quadratic forms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `quadratic_form.isometry`: `linear_equiv`s which map between two different quadratic forms
+* `quadratic_form.equvialent`: propositional version of the above
+
+## Main results
+
+* `equivalent_weighted_sum_squares`: in finite dimensions, any quadratic form is equivalent to a
+  parametrization of `quadratic_form.weighted_sum_squares`.
+-/
+
+variables {ι R K M M₁ M₂ M₃ V : Type*}
+
+namespace quadratic_form
+
+variables [semiring R]
+variables [add_comm_monoid M] [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M₃]
+variables [module R M] [module R M₁] [module R M₂] [module R M₃]
+
+/-- An isometry between two quadratic spaces `M₁, Q₁` and `M₂, Q₂` over a ring `R`,
+is a linear equivalence between `M₁` and `M₂` that commutes with the quadratic forms. -/
+@[nolint has_nonempty_instance] structure isometry
+  (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) extends M₁ ≃ₗ[R] M₂ :=
+(map_app' : ∀ m, Q₂ (to_fun m) = Q₁ m)
+
+/-- Two quadratic forms over a ring `R` are equivalent
+if there exists an isometry between them:
+a linear equivalence that transforms one quadratic form into the other. -/
+def equivalent (Q₁ : quadratic_form R M₁) (Q₂ : quadratic_form R M₂) := nonempty (Q₁.isometry Q₂)
+
+namespace isometry
+
+variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}
+
+instance : has_coe (Q₁.isometry Q₂) (M₁ ≃ₗ[R] M₂) := ⟨isometry.to_linear_equiv⟩
+
+@[simp] lemma to_linear_equiv_eq_coe (f : Q₁.isometry Q₂) : f.to_linear_equiv = f := rfl
+
+instance : has_coe_to_fun (Q₁.isometry Q₂) (λ _, M₁ → M₂) := ⟨λ f, ⇑(f : M₁ ≃ₗ[R] M₂)⟩
+
+@[simp] lemma coe_to_linear_equiv (f : Q₁.isometry Q₂) : ⇑(f : M₁ ≃ₗ[R] M₂) = f := rfl
+
+@[simp] lemma map_app (f : Q₁.isometry Q₂) (m : M₁) : Q₂ (f m) = Q₁ m := f.map_app' m
+
+/-- The identity isometry from a quadratic form to itself. -/
+@[refl]
+def refl (Q : quadratic_form R M) : Q.isometry Q :=
+{ map_app' := λ m, rfl,
+  .. linear_equiv.refl R M }
+
+/-- The inverse isometry of an isometry between two quadratic forms. -/
+@[symm]
+def symm (f : Q₁.isometry Q₂) : Q₂.isometry Q₁ :=
+{ map_app' := by { intro m, rw ← f.map_app, congr, exact f.to_linear_equiv.apply_symm_apply m },
+  .. (f : M₁ ≃ₗ[R] M₂).symm }
+
+/-- The composition of two isometries between quadratic forms. -/
+@[trans]
+def trans (f : Q₁.isometry Q₂) (g : Q₂.isometry Q₃) : Q₁.isometry Q₃ :=
+{ map_app' := by { intro m, rw [← f.map_app, ← g.map_app], refl },
+  .. (f : M₁ ≃ₗ[R] M₂).trans (g : M₂ ≃ₗ[R] M₃) }
+
+end isometry
+
+namespace equivalent
+
+variables {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} {Q₃ : quadratic_form R M₃}
+
+@[refl]
+lemma refl (Q : quadratic_form R M) : Q.equivalent Q := ⟨isometry.refl Q⟩
+
+@[symm]
+lemma symm (h : Q₁.equivalent Q₂) : Q₂.equivalent Q₁ := h.elim $ λ f, ⟨f.symm⟩
+
+@[trans]
+lemma trans (h : Q₁.equivalent Q₂) (h' : Q₂.equivalent Q₃) : Q₁.equivalent Q₃ :=
+h'.elim $ h.elim $ λ f g, ⟨f.trans g⟩
+
+end equivalent
+
+variables [fintype ι] {v : basis ι R M}
+
+/-- A quadratic form composed with a `linear_equiv` is isometric to itself. -/
+def isometry_of_comp_linear_equiv (Q : quadratic_form R M) (f : M₁ ≃ₗ[R] M) :
+  Q.isometry (Q.comp (f : M₁ →ₗ[R] M)) :=
+{ map_app' :=
+  begin
+    intro,
+    simp only [comp_apply, linear_equiv.coe_coe, linear_equiv.to_fun_eq_coe,
+               linear_equiv.apply_symm_apply, f.apply_symm_apply],
+  end,
+  .. f.symm }
+
+/-- A quadratic form is isometric to its bases representations. -/
+noncomputable def isometry_basis_repr (Q : quadratic_form R M) (v : basis ι R M) :
+  isometry Q (Q.basis_repr v) :=
+isometry_of_comp_linear_equiv Q v.equiv_fun.symm
+
+variables [field K] [invertible (2 : K)] [add_comm_group V] [module K V]
+
+/-- Given an orthogonal basis, a quadratic form is isometric with a weighted sum of squares. -/
+noncomputable def isometry_weighted_sum_squares (Q : quadratic_form K V)
+  (v : basis (fin (finite_dimensional.finrank K V)) K V)
+  (hv₁ : (associated Q).is_Ortho v) :
+  Q.isometry (weighted_sum_squares K (λ i, Q (v i))) :=
+begin
+  let iso := Q.isometry_basis_repr v,
+  refine ⟨iso, λ m, _⟩,
+  convert iso.map_app m,
+  rw basis_repr_eq_of_is_Ortho _ _ hv₁,
+end
+
+variables [finite_dimensional K V]
+
+open bilin_form
+
+lemma equivalent_weighted_sum_squares (Q : quadratic_form K V) :
+  ∃ w : fin (finite_dimensional.finrank K V) → K, equivalent Q (weighted_sum_squares K w) :=
+let ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q) in
+  ⟨_, ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩
+
+lemma equivalent_weighted_sum_squares_units_of_nondegenerate'
+  (Q : quadratic_form K V) (hQ : (associated Q).nondegenerate) :
+  ∃ w : fin (finite_dimensional.finrank K V) → Kˣ,
+    equivalent Q (weighted_sum_squares K w) :=
+begin
+  obtain ⟨v, hv₁⟩ := exists_orthogonal_basis (associated_is_symm _ Q),
+  have hv₂ := hv₁.not_is_ortho_basis_self_of_nondegenerate hQ,
+  simp_rw [is_ortho, associated_eq_self_apply] at hv₂,
+  exact ⟨λ i, units.mk0 _ (hv₂ i), ⟨Q.isometry_weighted_sum_squares v hv₁⟩⟩,
+end
+
+end quadratic_form
diff --git a/src/linear_algebra/quadratic_form/prod.lean b/src/linear_algebra/quadratic_form/prod.lean
index ff99ce8080efc..5b7d0039b76c5 100644
--- a/src/linear_algebra/quadratic_form/prod.lean
+++ b/src/linear_algebra/quadratic_form/prod.lean
@@ -3,10 +3,13 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import linear_algebra.quadratic_form.basic
+import linear_algebra.quadratic_form.isometry
 
 /-! # Quadratic form on product and pi types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `quadratic_form.prod Q₁ Q₂`: the quadratic form constructed elementwise on a product
@@ -31,10 +34,10 @@ forms specifically.
 
 universes u v w
 variables {ι : Type*} {R : Type*} {M₁ M₂ N₁ N₂ : Type*} {Mᵢ Nᵢ : ι → Type*}
-variables [ring R]
-variables [add_comm_group M₁] [add_comm_group M₂] [add_comm_group N₁] [add_comm_group N₂]
+variables [semiring R]
+variables [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid N₁] [add_comm_monoid N₂]
 variables [module R M₁] [module R M₂] [module R N₁] [module R N₂]
-variables [Π i, add_comm_group (Mᵢ i)] [Π i, add_comm_group (Nᵢ i)]
+variables [Π i, add_comm_monoid (Mᵢ i)] [Π i, add_comm_monoid (Nᵢ i)]
 variables [Π i, module R (Mᵢ i)] [Π i, module R (Nᵢ i)]
 
 namespace quadratic_form
@@ -64,7 +67,7 @@ lemma anisotropic_of_prod {R} [ordered_ring R] [module R M₁] [module R M₂]
   {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} (h : (Q₁.prod Q₂).anisotropic) :
   Q₁.anisotropic ∧ Q₂.anisotropic :=
 begin
-  simp_rw [anisotropic, prod_to_fun, prod.forall, prod.mk_eq_zero] at h,
+  simp_rw [anisotropic, prod_apply, prod.forall, prod.mk_eq_zero] at h,
   split,
   { intros x hx,
     refine (h x 0 _).1,
@@ -78,7 +81,7 @@ lemma nonneg_prod_iff {R} [ordered_ring R] [module R M₁] [module R M₂]
   {Q₁ : quadratic_form R M₁} {Q₂ : quadratic_form R M₂} :
   (∀ x, 0 ≤ (Q₁.prod Q₂) x) ↔ (∀ x, 0 ≤ Q₁ x) ∧ (∀ x, 0 ≤ Q₂ x) :=
 begin
-  simp_rw [prod.forall, prod_to_fun],
+  simp_rw [prod.forall, prod_apply],
   split,
   { intro h,
     split,
diff --git a/src/linear_algebra/quadratic_form/real.lean b/src/linear_algebra/quadratic_form/real.lean
index 757b98001d69a..f3ae98248de69 100644
--- a/src/linear_algebra/quadratic_form/real.lean
+++ b/src/linear_algebra/quadratic_form/real.lean
@@ -3,13 +3,16 @@ Copyright (c) 2020 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen, Kexing Ying, Eric Wieser
 -/
-import linear_algebra.quadratic_form.basic
-import analysis.special_functions.pow
+import linear_algebra.quadratic_form.isometry
+import analysis.special_functions.pow.real
 import data.real.sign
 
 /-!
 # Real quadratic forms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Sylvester's law of inertia `equivalent_one_neg_one_weighted_sum_squared`:
 A real quadratic form is equivalent to a weighted
 sum of squares with the weights being ±1 or 0.
@@ -55,7 +58,7 @@ begin
   erw [hsum],
   simp only [u, function.comp, smul_eq_mul],
   split_ifs,
-  { simp only [h, zero_smul, zero_mul, sign_zero] },
+  { simp only [h, zero_smul, zero_mul, real.sign_zero] },
   have hwu : w j = u j,
   { simp only [u, dif_neg h, units.coe_mk0] },
   simp only [hwu, units.coe_mk0],
@@ -63,7 +66,7 @@ begin
     (sign (u j) * u j) ^ - (1 / 2 : ℝ) * u j * v j * v j,
   { erw [← mul_assoc, this], ring },
   rw [← real.rpow_add (sign_mul_pos_of_ne_zero _ $ units.ne_zero _),
-      show - (1 / 2 : ℝ) + - (1 / 2) = -1, by ring, real.rpow_neg_one, mul_inv₀,
+      show - (1 / 2 : ℝ) + - (1 / 2) = -1, by ring, real.rpow_neg_one, mul_inv,
       inv_sign, mul_assoc (sign (u j)) (u j)⁻¹,
       inv_mul_cancel (units.ne_zero _), mul_one],
   apply_instance
diff --git a/src/linear_algebra/quotient.lean b/src/linear_algebra/quotient.lean
index 2cc88bc86ad98..e76a86d7e1d91 100644
--- a/src/linear_algebra/quotient.lean
+++ b/src/linear_algebra/quotient.lean
@@ -3,11 +3,15 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov
 -/
+import group_theory.quotient_group
 import linear_algebra.span
 
 /-!
 # Quotients by submodules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 * If `p` is a submodule of `M`, `M ⧸ p` is the quotient of `M` with respect to `p`:
   that is, elements of `M` are identified if their difference is in `p`. This is itself a module.
 
@@ -21,7 +25,7 @@ namespace submodule
 variables {R M : Type*} {r : R} {x y : M} [ring R] [add_comm_group M] [module R M]
 variables (p p' : submodule R M)
 
-open linear_map
+open linear_map quotient_add_group
 
 /-- The equivalence relation associated to a submodule `p`, defined by `x ≈ y` iff `-x + y ∈ p`.
 
@@ -31,7 +35,7 @@ def quotient_rel : setoid M :=
 quotient_add_group.left_rel p.to_add_subgroup
 
 lemma quotient_rel_r_def {x y : M} : @setoid.r _ (p.quotient_rel) x y ↔ x - y ∈ p :=
-iff.trans (by { rw [sub_eq_add_neg, neg_add, neg_neg], refl }) neg_mem_iff
+iff.trans (by { rw [left_rel_apply, sub_eq_add_neg, neg_add, neg_neg], refl }) neg_mem_iff
 
 /-- The quotient of a module `M` by a submodule `p ⊆ M`. -/
 instance has_quotient : has_quotient M (submodule R M) := ⟨λ p, quotient (quotient_rel p)⟩
@@ -47,10 +51,10 @@ def mk {p : submodule R M} : M → M ⧸ p := quotient.mk'
 @[simp] theorem mk'_eq_mk {p : submodule R M} (x : M) : (quotient.mk' x : M ⧸ p) = mk x := rfl
 @[simp] theorem quot_mk_eq_mk {p : submodule R M} (x : M) : (quot.mk _ x : M ⧸ p) = mk x := rfl
 
-protected theorem eq' {x y : M} : (mk x : M ⧸ p) = mk y ↔ -x + y ∈ p := quotient.eq'
+protected theorem eq' {x y : M} : (mk x : M ⧸ p) = mk y ↔ -x + y ∈ p := quotient_add_group.eq
 
 protected theorem eq {x y : M} : (mk x : M ⧸ p) = mk y ↔ x - y ∈ p :=
-(p^.quotient.eq').trans p.quotient_rel_r_def
+(p^.quotient.eq').trans (left_rel_apply.symm.trans p.quotient_rel_r_def)
 
 instance : has_zero (M ⧸ p) := ⟨mk 0⟩
 instance : inhabited (M ⧸ p) := ⟨0⟩
@@ -61,7 +65,7 @@ instance : inhabited (M ⧸ p) := ⟨0⟩
 by simpa using (quotient.eq p : mk x = 0 ↔ _)
 
 instance add_comm_group : add_comm_group (M ⧸ p) :=
-quotient_add_group.add_comm_group p.to_add_subgroup
+quotient_add_group.quotient.add_comm_group p.to_add_subgroup
 
 @[simp] theorem mk_add : (mk (x + y) : M ⧸ p) = mk x + mk y := rfl
 
@@ -69,45 +73,63 @@ quotient_add_group.add_comm_group p.to_add_subgroup
 
 @[simp] theorem mk_sub : (mk (x - y) : M ⧸ p) = mk x - mk y := rfl
 
-section has_scalar
+section has_smul
 
-variables {S : Type*} [has_scalar S R] [has_scalar S M] [is_scalar_tower S R M] (P : submodule R M)
+variables {S : Type*} [has_smul S R] [has_smul S M] [is_scalar_tower S R M] (P : submodule R M)
 
-instance has_scalar' : has_scalar S (M ⧸ P) :=
-⟨λ a, quotient.map' ((•) a) $ λ x y h, by simpa [smul_sub] using P.smul_mem (a • 1 : R) h⟩
+instance has_smul' : has_smul S (M ⧸ P) :=
+⟨λ a, quotient.map' ((•) a) $ λ x y h, left_rel_apply.mpr $
+  by simpa [smul_sub] using P.smul_mem (a • 1 : R) (left_rel_apply.mp h)⟩
 
 /-- Shortcut to help the elaborator in the common case. -/
-instance has_scalar : has_scalar R (M ⧸ P) :=
-quotient.has_scalar' P
+instance has_smul : has_smul R (M ⧸ P) :=
+quotient.has_smul' P
 
 @[simp] theorem mk_smul (r : S) (x : M) : (mk (r • x) : M ⧸ p) = r • mk x := rfl
 
-instance smul_comm_class (T : Type*) [has_scalar T R] [has_scalar T M] [is_scalar_tower T R M]
+instance smul_comm_class (T : Type*) [has_smul T R] [has_smul T M] [is_scalar_tower T R M]
   [smul_comm_class S T M] : smul_comm_class S T (M ⧸ P) :=
 { smul_comm := λ x y, quotient.ind' $ by exact λ z, congr_arg mk (smul_comm _ _ _) }
 
-instance is_scalar_tower (T : Type*) [has_scalar T R] [has_scalar T M] [is_scalar_tower T R M]
-  [has_scalar S T] [is_scalar_tower S T M] : is_scalar_tower S T (M ⧸ P) :=
+instance is_scalar_tower (T : Type*) [has_smul T R] [has_smul T M] [is_scalar_tower T R M]
+  [has_smul S T] [is_scalar_tower S T M] : is_scalar_tower S T (M ⧸ P) :=
 { smul_assoc := λ x y, quotient.ind' $ by exact λ z, congr_arg mk (smul_assoc _ _ _) }
 
-instance is_central_scalar [has_scalar Sᵐᵒᵖ R] [has_scalar Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M]
+instance is_central_scalar [has_smul Sᵐᵒᵖ R] [has_smul Sᵐᵒᵖ M] [is_scalar_tower Sᵐᵒᵖ R M]
   [is_central_scalar S M] : is_central_scalar S (M ⧸ P) :=
 { op_smul_eq_smul := λ x, quotient.ind' $ by exact λ z, congr_arg mk $ op_smul_eq_smul _ _ }
 
-end has_scalar
+end has_smul
 
 section module
 
 variables {S : Type*}
 
-instance mul_action' [monoid S] [has_scalar S R] [mul_action S M] [is_scalar_tower S R M]
+instance mul_action' [monoid S] [has_smul S R] [mul_action S M] [is_scalar_tower S R M]
   (P : submodule R M) : mul_action S (M ⧸ P) :=
 function.surjective.mul_action mk (surjective_quot_mk _) P^.quotient.mk_smul
 
 instance mul_action (P : submodule R M) : mul_action R (M ⧸ P) :=
 quotient.mul_action' P
 
-instance distrib_mul_action' [monoid S] [has_scalar S R] [distrib_mul_action S M]
+instance smul_zero_class' [has_smul S R] [smul_zero_class S M]
+  [is_scalar_tower S R M]
+  (P : submodule R M) : smul_zero_class S (M ⧸ P) :=
+zero_hom.smul_zero_class ⟨mk, mk_zero _⟩ P^.quotient.mk_smul
+
+instance smul_zero_class (P : submodule R M) : smul_zero_class R (M ⧸ P) :=
+quotient.smul_zero_class' P
+
+instance distrib_smul' [has_smul S R] [distrib_smul S M]
+  [is_scalar_tower S R M]
+  (P : submodule R M) : distrib_smul S (M ⧸ P) :=
+function.surjective.distrib_smul
+  ⟨mk, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) P^.quotient.mk_smul
+
+instance distrib_smul (P : submodule R M) : distrib_smul R (M ⧸ P) :=
+quotient.distrib_smul' P
+
+instance distrib_mul_action' [monoid S] [has_smul S R] [distrib_mul_action S M]
   [is_scalar_tower S R M]
   (P : submodule R M) : distrib_mul_action S (M ⧸ P) :=
 function.surjective.distrib_mul_action
@@ -116,7 +138,7 @@ function.surjective.distrib_mul_action
 instance distrib_mul_action (P : submodule R M) : distrib_mul_action R (M ⧸ P) :=
 quotient.distrib_mul_action' P
 
-instance module' [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M]
+instance module' [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M]
   (P : submodule R M) : module S (M ⧸ P) :=
 function.surjective.module _
   ⟨mk, rfl, λ _ _, rfl⟩ (surjective_quot_mk _) P^.quotient.mk_smul
@@ -129,7 +151,7 @@ variables (S)
 /-- The quotient of `P` as an `S`-submodule is the same as the quotient of `P` as an `R`-submodule,
 where `P : submodule R M`.
 -/
-def restrict_scalars_equiv [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M]
+def restrict_scalars_equiv [ring S] [has_smul S R] [module S M] [is_scalar_tower S R M]
   (P : submodule R M) :
   (M ⧸ P.restrict_scalars S) ≃ₗ[S] M ⧸ P :=
 { map_add' := λ x y, quotient.induction_on₂' x y (λ x' y', rfl),
@@ -137,12 +159,12 @@ def restrict_scalars_equiv [ring S] [has_scalar S R] [module S M] [is_scalar_tow
   ..quotient.congr_right $ λ _ _, iff.rfl }
 
 @[simp] lemma restrict_scalars_equiv_mk
-  [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
+  [ring S] [has_smul S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
   (x : M) : restrict_scalars_equiv S P (mk x) = mk x :=
 rfl
 
 @[simp] lemma restrict_scalars_equiv_symm_mk
-  [ring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
+  [ring S] [has_smul S R] [module S M] [is_scalar_tower S R M] (P : submodule R M)
   (x : M) : (restrict_scalars_equiv S P).symm (mk x) = mk x :=
 rfl
 
@@ -161,6 +183,45 @@ end
 
 end quotient
 
+instance quotient_bot.infinite [infinite M] : infinite (M ⧸ (⊥ : submodule R M)) :=
+infinite.of_injective submodule.quotient.mk $ λ x y h, sub_eq_zero.mp $
+  (submodule.quotient.eq ⊥).mp h
+
+instance quotient_top.unique : unique (M ⧸ (⊤ : submodule R M)) :=
+{ default := 0,
+  uniq := λ x, quotient.induction_on' x $ λ x, (submodule.quotient.eq ⊤).mpr submodule.mem_top }
+
+instance quotient_top.fintype : fintype (M ⧸ (⊤ : submodule R M)) :=
+fintype.of_subsingleton 0
+
+variables {p}
+
+lemma subsingleton_quotient_iff_eq_top : subsingleton (M ⧸ p) ↔ p = ⊤ :=
+begin
+  split,
+  { rintro h,
+    refine eq_top_iff.mpr (λ x _, _),
+    have this : x - 0 ∈ p := (submodule.quotient.eq p).mp (by exactI subsingleton.elim _ _),
+    rwa sub_zero at this },
+  { rintro rfl,
+    apply_instance }
+end
+
+lemma unique_quotient_iff_eq_top : nonempty (unique (M ⧸ p)) ↔ p = ⊤ :=
+⟨λ ⟨h⟩, subsingleton_quotient_iff_eq_top.mp (@@unique.subsingleton h),
+ by { rintro rfl, exact ⟨quotient_top.unique⟩ }⟩
+
+variables (p)
+
+noncomputable instance quotient.fintype [fintype M] (S : submodule R M) :
+  fintype (M ⧸ S) :=
+@@quotient.fintype _ _ (λ _ _, classical.dec _)
+
+lemma card_eq_card_quotient_mul_card [fintype M] (S : submodule R M) [decidable_pred (∈ S)]  :
+  fintype.card M = fintype.card S * fintype.card (M ⧸ S) :=
+by { rw [mul_comm, ← fintype.card_prod],
+     exact fintype.card_congr add_subgroup.add_group_equiv_quotient_times_add_subgroup }
+
 section
 
 variables {M₂ : Type*} [add_comm_group M₂] [module R M₂]
@@ -175,6 +236,9 @@ def mkq : M →ₗ[R] M ⧸ p :=
 
 @[simp] theorem mkq_apply (x : M) : p.mkq x = quotient.mk x := rfl
 
+lemma mkq_surjective (A : submodule R M) : function.surjective A.mkq :=
+by rintro ⟨x⟩; exact ⟨x, rfl⟩
+
 end
 
 variables {R₂ M₂ : Type*} [ring R₂] [add_comm_group M₂] [module R₂ M₂] {τ₁₂ : R →+* R₂}
@@ -199,6 +263,14 @@ def liftq (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ f.ker) : M ⧸ p →ₛₗ
 @[simp] theorem liftq_mkq (f : M →ₛₗ[τ₁₂] M₂) (h) : (p.liftq f h).comp p.mkq = f :=
 by ext; refl
 
+/--Special case of `liftq` when `p` is the span of `x`. In this case, the condition on `f` simply
+becomes vanishing at `x`.-/
+def liftq_span_singleton (x : M) (f : M →ₛₗ[τ₁₂] M₂) (h : f x = 0) : (M ⧸ R ∙ x) →ₛₗ[τ₁₂] M₂ :=
+(R ∙ x).liftq f $ by rw [span_singleton_le_iff_mem, linear_map.mem_ker, h]
+
+@[simp] lemma liftq_span_singleton_apply (x : M) (f : M →ₛₗ[τ₁₂] M₂) (h : f x = 0) (y : M) :
+liftq_span_singleton x f h (quotient.mk y) = f y := rfl
+
 @[simp] theorem range_mkq : p.mkq.range = ⊤ :=
 eq_top_iff'.2 $ by rintro ⟨x⟩; exact ⟨x, rfl⟩
 
@@ -246,7 +318,7 @@ lemma mapq_comp {R₃ M₃ : Type*} [ring R₃] [add_comm_group M₃] [module R
   p.mapq p₃ (g.comp f) h = (p₂.mapq p₃ g hg).comp (p.mapq p₂ f hf) :=
 by { ext, simp, }
 
-@[simp] lemma mapq_id (h : p ≤ p.comap linear_map.id := by simp) :
+@[simp] lemma mapq_id (h : p ≤ p.comap linear_map.id := by { rw comap_id, exact le_refl _ }) :
   p.mapq p linear_map.id h = linear_map.id :=
 by { ext, simp, }
 
@@ -316,6 +388,43 @@ begin
   exact inf_le_right,
 end
 
+/-- If `P` is a submodule of `M` and `Q` a submodule of `N`,
+and `f : M ≃ₗ N` maps `P` to `Q`, then `M ⧸ P` is equivalent to `N ⧸ Q`. -/
+@[simps] def quotient.equiv {N : Type*} [add_comm_group N] [module R N]
+  (P : submodule R M) (Q : submodule R N)
+  (f : M ≃ₗ[R] N) (hf : P.map f = Q) : (M ⧸ P) ≃ₗ[R] N ⧸ Q :=
+{ to_fun := P.mapq Q (f : M →ₗ[R] N) (λ x hx, hf ▸ submodule.mem_map_of_mem hx),
+  inv_fun := Q.mapq P (f.symm : N →ₗ[R] M) (λ x hx, begin
+    rw [← hf, submodule.mem_map] at hx,
+    obtain ⟨y, hy, rfl⟩ := hx,
+    simpa
+  end),
+  left_inv := λ x, quotient.induction_on' x (by simp),
+  right_inv := λ x, quotient.induction_on' x (by simp),
+  .. P.mapq Q (f : M →ₗ[R] N) (λ x hx, hf ▸ submodule.mem_map_of_mem hx) }
+
+@[simp] lemma quotient.equiv_symm {R M N : Type*} [comm_ring R]
+  [add_comm_group M] [module R M] [add_comm_group N] [module R N]
+  (P : submodule R M) (Q : submodule R N)
+  (f : M ≃ₗ[R] N) (hf : P.map f = Q) :
+  (quotient.equiv P Q f hf).symm =
+    quotient.equiv Q P f.symm ((submodule.map_symm_eq_iff f).mpr hf) :=
+rfl
+
+@[simp] lemma quotient.equiv_trans {N O : Type*} [add_comm_group N] [module R N]
+  [add_comm_group O] [module R O]
+  (P : submodule R M) (Q : submodule R N) (S : submodule R O)
+  (e : M ≃ₗ[R] N) (f : N ≃ₗ[R] O)
+  (he : P.map e = Q) (hf : Q.map f = S) (hef : P.map (e.trans f) = S) :
+  quotient.equiv P S (e.trans f) hef = (quotient.equiv P Q e he).trans (quotient.equiv Q S f hf) :=
+begin
+  ext,
+  -- `simp` can deal with `hef` depending on `e` and `f`
+  simp only [quotient.equiv_apply, linear_equiv.trans_apply, linear_equiv.coe_trans],
+  -- `rw` can deal with `mapq_comp` needing extra hypotheses coming from the RHS
+  rw [mapq_comp, linear_map.comp_apply]
+end
+
 end submodule
 
 open submodule
@@ -383,6 +492,11 @@ lemma quot_equiv_of_eq_mk (h : p = p') (x : M) :
   submodule.quot_equiv_of_eq p p' h (submodule.quotient.mk x) = submodule.quotient.mk x :=
 rfl
 
+@[simp] lemma quotient.equiv_refl (P : submodule R M) (Q : submodule R M)
+  (hf : P.map (linear_equiv.refl R M : M →ₗ[R] M) = Q) :
+  quotient.equiv P Q (linear_equiv.refl R M) hf = quot_equiv_of_eq _ _ (by simpa using hf) :=
+rfl
+
 end submodule
 
 end ring
diff --git a/src/linear_algebra/quotient_pi.lean b/src/linear_algebra/quotient_pi.lean
new file mode 100644
index 0000000000000..7ec75b10ca9a4
--- /dev/null
+++ b/src/linear_algebra/quotient_pi.lean
@@ -0,0 +1,100 @@
+/-
+Copyright (c) 2022 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen, Alex J. Best
+-/
+import linear_algebra.pi
+import linear_algebra.quotient
+
+/-!
+# Submodule quotients and direct sums
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains some results on the quotient of a module by a direct sum of submodules,
+and the direct sum of quotients of modules by submodules.
+
+# Main definitions
+
+ * `submodule.pi_quotient_lift`: create a map out of the direct sum of quotients
+ * `submodule.quotient_pi_lift`: create a map out of the quotient of a direct sum
+ * `submodule.quotient_pi`: the quotient of a direct sum is the direct sum of quotients.
+
+-/
+
+namespace submodule
+
+open linear_map
+
+variables {ι R : Type*} [comm_ring R]
+variables {Ms : ι → Type*} [∀ i, add_comm_group (Ms i)] [∀ i, module R (Ms i)]
+variables {N : Type*} [add_comm_group N] [module R N]
+variables {Ns : ι → Type*} [∀ i, add_comm_group (Ns i)] [∀ i, module R (Ns i)]
+
+/-- Lift a family of maps to the direct sum of quotients. -/
+def pi_quotient_lift [fintype ι] [decidable_eq ι]
+  (p : ∀ i, submodule R (Ms i)) (q : submodule R N)
+  (f : Π i, Ms i →ₗ[R] N) (hf : ∀ i, p i ≤ q.comap (f i)) :
+  (Π i, (Ms i ⧸ p i)) →ₗ[R] (N ⧸ q) :=
+lsum R (λ i, (Ms i ⧸ (p i))) R (λ i, (p i).mapq q (f i) (hf i))
+
+@[simp] lemma pi_quotient_lift_mk [fintype ι] [decidable_eq ι]
+  (p : ∀ i, submodule R (Ms i)) (q : submodule R N)
+  (f : Π i, Ms i →ₗ[R] N) (hf : ∀ i, p i ≤ q.comap (f i)) (x : Π i, Ms i) :
+  pi_quotient_lift p q f hf (λ i, quotient.mk (x i)) =
+    quotient.mk (lsum _ _ R f x) :=
+by rw [pi_quotient_lift, lsum_apply, sum_apply, ← mkq_apply, lsum_apply, sum_apply, _root_.map_sum];
+   simp only [coe_proj, mapq_apply, mkq_apply, comp_apply]
+
+@[simp] lemma pi_quotient_lift_single [fintype ι] [decidable_eq ι]
+  (p : ∀ i, submodule R (Ms i)) (q : submodule R N)
+  (f : Π i, Ms i →ₗ[R] N) (hf : ∀ i, p i ≤ q.comap (f i)) (i) (x : Ms i ⧸ p i) :
+  pi_quotient_lift p q f hf (pi.single i x) =
+    mapq _ _ (f i) (hf i) x :=
+begin
+  simp_rw [pi_quotient_lift, lsum_apply, sum_apply,
+           comp_apply, proj_apply],
+  rw finset.sum_eq_single i,
+  { rw pi.single_eq_same },
+  { rintros j - hj, rw [pi.single_eq_of_ne hj, _root_.map_zero] },
+  { intros, have := finset.mem_univ i, contradiction },
+end
+
+/-- Lift a family of maps to a quotient of direct sums. -/
+def quotient_pi_lift
+  (p : ∀ i, submodule R (Ms i))
+  (f : Π i, Ms i →ₗ[R] Ns i) (hf : ∀ i, p i ≤ ker (f i)) :
+  ((Π i, Ms i) ⧸ pi set.univ p) →ₗ[R] Π i, Ns i :=
+(pi set.univ p).liftq (linear_map.pi (λ i, (f i).comp (proj i))) $
+λ x hx, mem_ker.mpr $
+by { ext i, simpa using hf i (mem_pi.mp hx i (set.mem_univ i)) }
+
+@[simp] lemma quotient_pi_lift_mk
+  (p : ∀ i, submodule R (Ms i))
+  (f : Π i, Ms i →ₗ[R] Ns i) (hf : ∀ i, p i ≤ ker (f i)) (x : Π i, Ms i) :
+  quotient_pi_lift p f hf (quotient.mk x) = λ i, f i (x i) :=
+rfl
+
+/-- The quotient of a direct sum is the direct sum of quotients. -/
+@[simps] def quotient_pi [fintype ι] [decidable_eq ι]
+  (p : ∀ i, submodule R (Ms i)) :
+  ((Π i, Ms i) ⧸ pi set.univ p) ≃ₗ[R] Π i, Ms i ⧸ p i :=
+{ to_fun := quotient_pi_lift p (λ i, (p i).mkq) (λ i, by simp),
+  inv_fun := pi_quotient_lift p (pi set.univ p)
+    single (λ i, le_comap_single_pi p),
+  left_inv := λ x, quotient.induction_on' x (λ x',
+    by simp_rw [quotient.mk'_eq_mk, quotient_pi_lift_mk, mkq_apply,
+                pi_quotient_lift_mk, lsum_single, id_apply]),
+  right_inv := begin
+    rw [function.right_inverse_iff_comp, ← coe_comp, ← @id_coe R],
+    refine congr_arg _ (pi_ext (λ i x, quotient.induction_on' x (λ x', funext $ λ j, _))),
+    rw [comp_apply, pi_quotient_lift_single, quotient.mk'_eq_mk, mapq_apply,
+        quotient_pi_lift_mk, id_apply],
+    by_cases hij : i = j; simp only [mkq_apply, coe_single],
+    { subst hij, simp only [pi.single_eq_same] },
+    { simp only [pi.single_eq_of_ne (ne.symm hij), quotient.mk_zero] },
+  end,
+  .. quotient_pi_lift p (λ i, (p i).mkq) (λ i, by simp) }
+
+end submodule
diff --git a/src/linear_algebra/ray.lean b/src/linear_algebra/ray.lean
index e6637cf101f87..503db73e8a277 100644
--- a/src/linear_algebra/ray.lean
+++ b/src/linear_algebra/ray.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Joseph Myers. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Myers
 -/
-import linear_algebra.basic
+import group_theory.subgroup.actions
+import linear_algebra.linear_independent
 
 /-!
 # Rays in modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines rays in modules.
 
 ## Main definitions
@@ -23,9 +27,9 @@ noncomputable theory
 
 open_locale big_operators
 
-section ordered_comm_semiring
+section strict_ordered_comm_semiring
 
-variables (R : Type*) [ordered_comm_semiring R]
+variables (R : Type*) [strict_ordered_comm_semiring R]
 variables {M : Type*} [add_comm_monoid M] [module R M]
 variables {N : Type*} [add_comm_monoid N] [module R N]
 variables (ι : Type*) [decidable_eq ι]
@@ -126,10 +130,16 @@ lemma map (f : M →ₗ[R] N) (h : same_ray R x y) : same_ray R (f x) (f y) :=
 h.imp (λ hx, by rw [hx, map_zero]) $ or.imp (λ hy, by rw [hy, map_zero]) $
   λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₁, r₂, hr₁, hr₂, by rw [←f.map_smul, ←f.map_smul, h]⟩
 
+/-- The images of two vectors under an injective linear map are on the same ray if and only if the
+original vectors are on the same ray. -/
+lemma _root_.function.injective.same_ray_map_iff {F : Type*} [linear_map_class F R M N] {f : F}
+  (hf : function.injective f) : same_ray R (f x) (f y) ↔ same_ray R x y :=
+by simp only [same_ray, map_zero, ← hf.eq_iff, map_smul]
+
 /-- The images of two vectors under a linear equivalence are on the same ray if and only if the
 original vectors are on the same ray. -/
 @[simp] lemma _root_.same_ray_map_iff (e : M ≃ₗ[R] N) : same_ray R (e x) (e y) ↔ same_ray R x y :=
-⟨λ h, by simpa using same_ray.map e.symm.to_linear_map h, same_ray.map e.to_linear_map⟩
+function.injective.same_ray_map_iff (equiv_like.injective e)
 
 /-- If two vectors are on the same ray then both scaled by the same action are also on the same
 ray. -/
@@ -159,7 +169,7 @@ end same_ray
 
 /-- Nonzero vectors, as used to define rays. This type depends on an unused argument `R` so that
 `ray_vector.setoid` can be an instance. -/
-@[nolint unused_arguments has_inhabited_instance]
+@[nolint unused_arguments has_nonempty_instance]
 def ray_vector (R M : Type*) [has_zero M] := {v : M // v ≠ 0}
 
 instance ray_vector.has_coe {R M : Type*} [has_zero M] :
@@ -177,7 +187,7 @@ instance : setoid (ray_vector R M) :=
     λ x y z hxy hyz, hxy.trans hyz $ λ hy, (y.2 hy).elim⟩ }
 
 /-- A ray (equivalence class of nonzero vectors with common positive multiples) in a module. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def module.ray := quotient (ray_vector.setoid R M)
 
 variables {R M}
@@ -291,11 +301,11 @@ x.some_ray_vector.property
 
 end module.ray
 
-end ordered_comm_semiring
+end strict_ordered_comm_semiring
 
-section ordered_comm_ring
+section strict_ordered_comm_ring
 
-variables {R : Type*} [ordered_comm_ring R]
+variables {R : Type*} [strict_ordered_comm_ring R]
 variables {M N : Type*} [add_comm_group M] [add_comm_group N] [module R M] [module R N] {x y : M}
 
 /-- `same_ray.neg` as an `iff`. -/
@@ -324,7 +334,7 @@ lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] (h : same_ray R x
   x = 0 :=
 begin
   nontriviality M, haveI : nontrivial R := module.nontrivial R M,
-  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (@one_pos R _ _)) _,
+  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (zero_lt_one' R)) _,
   rwa [neg_one_smul]
 end
 
@@ -391,9 +401,15 @@ begin
   rwa [units.coe_neg, right.neg_pos_iff]
 end
 
+@[simp] protected lemma map_neg (f : M ≃ₗ[R] N) (v : module.ray R M) : map f (-v) = - map f v :=
+begin
+  induction v using module.ray.ind with g hg,
+  simp,
+end
+
 end module.ray
 
-end ordered_comm_ring
+end strict_ordered_comm_ring
 
 section linear_ordered_comm_ring
 
@@ -467,6 +483,53 @@ end
 by rw [← neg_inj, neg_neg, ← module.ray.neg_units_smul, units_smul_eq_self_iff, units.coe_neg,
   neg_pos]
 
+/-- Two vectors are in the same ray, or the first is in the same ray as the negation of the
+second, if and only if they are not linearly independent. -/
+lemma same_ray_or_same_ray_neg_iff_not_linear_independent {x y : M} :
+  (same_ray R x y ∨ same_ray R x (-y)) ↔ ¬ linear_independent R ![x, y] :=
+begin
+  by_cases hx : x = 0, { simp [hx, λ h : linear_independent R ![0, y], h.ne_zero 0 rfl] },
+  by_cases hy : y = 0, { simp [hy, λ h : linear_independent R ![x, 0], h.ne_zero 1 rfl] },
+  simp_rw [fintype.not_linear_independent_iff, fin.sum_univ_two, fin.exists_fin_two],
+  refine ⟨λ h, _, λ h, _⟩,
+  { rcases h with (hx0|hy0|⟨r₁, r₂, hr₁, hr₂, h⟩)|(hx0|hy0|⟨r₁, r₂, hr₁, hr₂, h⟩),
+    { exact false.elim (hx hx0) },
+    { exact false.elim (hy hy0) },
+    { refine ⟨![r₁, -r₂], _⟩, simp [h, hr₁.ne.symm] },
+    { exact false.elim (hx hx0) },
+    { exact false.elim (hy (neg_eq_zero.1 hy0)) },
+    { refine ⟨![r₁, r₂], _⟩, simp [h, hr₁.ne.symm] } },
+  { rcases h with ⟨m, hm, hmne⟩,
+    change m 0 • x + m 1 • y = 0 at hm,
+    rw add_eq_zero_iff_eq_neg at hm,
+    rcases lt_trichotomy (m 0) 0 with hm0|hm0|hm0; rcases lt_trichotomy (m 1) 0 with hm1|hm1|hm1,
+    { refine or.inr (or.inr (or.inr ⟨-(m 0), -(m 1), left.neg_pos_iff.2 hm0,
+                                     left.neg_pos_iff.2 hm1, _⟩)),
+      simp [hm] },
+    { exfalso, simpa [hm1, hx, hm0.ne] using hm },
+    { refine or.inl (or.inr (or.inr ⟨-(m 0), m 1, left.neg_pos_iff.2 hm0, hm1, _⟩)),
+      simp [hm] },
+    { exfalso, simpa [hm0, hy, hm1.ne] using hm },
+    { refine false.elim (not_and_distrib.2 hmne ⟨hm0, hm1⟩) },
+    { exfalso, simpa [hm0, hy, hm1.ne.symm] using hm },
+    { refine or.inl (or.inr (or.inr ⟨m 0, -(m 1), hm0, left.neg_pos_iff.2 hm1, _⟩)),
+      simp [hm] },
+    { exfalso, simpa [hm1, hx, hm0.ne.symm] using hm },
+    { refine or.inr (or.inr (or.inr ⟨m 0, m 1, hm0, hm1, _⟩)),
+      simp [hm] } }
+end
+
+/-- Two vectors are in the same ray, or they are nonzero and the first is in the same ray as the
+negation of the second, if and only if they are not linearly independent. -/
+lemma same_ray_or_ne_zero_and_same_ray_neg_iff_not_linear_independent {x y : M} :
+  (same_ray R x y ∨ x ≠ 0 ∧ y ≠ 0 ∧ same_ray R x (-y)) ↔ ¬ linear_independent R ![x, y] :=
+begin
+  rw ←same_ray_or_same_ray_neg_iff_not_linear_independent,
+  by_cases hx : x = 0, { simp [hx] },
+  by_cases hy : y = 0;
+    simp [hx, hy]
+end
+
 end
 
 end linear_ordered_comm_ring
@@ -524,3 +587,48 @@ lemma exists_eq_smul (h : same_ray R v₁ v₂) :
 ⟨v₁ + v₂, h.exists_eq_smul_add⟩
 
 end same_ray
+
+section linear_ordered_field
+
+variables {R : Type*} [linear_ordered_field R]
+variables {M : Type*} [add_comm_group M] [module R M] {x y : M}
+
+lemma exists_pos_left_iff_same_ray (hx : x ≠ 0) (hy : y ≠ 0) :
+  (∃ r : R, 0 < r ∧ r • x = y) ↔ same_ray R x y :=
+begin
+  refine ⟨λ h, _, λ h, h.exists_pos_left hx hy⟩,
+  rcases h with ⟨r, hr, rfl⟩,
+  exact same_ray_pos_smul_right x hr
+end
+
+lemma exists_pos_left_iff_same_ray_and_ne_zero (hx : x ≠ 0) :
+  (∃ r : R, 0 < r ∧ r • x = y) ↔ (same_ray R x y ∧ y ≠ 0) :=
+begin
+  split,
+  { rintro ⟨r, hr, rfl⟩,
+    simp [hx, hr.le, hr.ne'] },
+  { rintro ⟨hxy, hy⟩,
+    exact (exists_pos_left_iff_same_ray hx hy).2 hxy }
+end
+
+lemma exists_nonneg_left_iff_same_ray (hx : x ≠ 0) :
+  (∃ r : R, 0 ≤ r ∧ r • x = y) ↔ same_ray R x y :=
+begin
+  refine ⟨λ h, _, λ h, h.exists_nonneg_left hx⟩,
+  rcases h with ⟨r, hr, rfl⟩,
+  exact same_ray_nonneg_smul_right x hr
+end
+
+lemma exists_pos_right_iff_same_ray (hx : x ≠ 0) (hy : y ≠ 0) :
+  (∃ r : R, 0 < r ∧ x = r • y) ↔ same_ray R x y :=
+by simpa only [same_ray_comm, eq_comm] using exists_pos_left_iff_same_ray hy hx
+
+lemma exists_pos_right_iff_same_ray_and_ne_zero (hy : y ≠ 0) :
+  (∃ r : R, 0 < r ∧ x = r • y) ↔ (same_ray R x y ∧ x ≠ 0) :=
+by simpa only [same_ray_comm, eq_comm] using exists_pos_left_iff_same_ray_and_ne_zero hy
+
+lemma exists_nonneg_right_iff_same_ray (hy : y ≠ 0) :
+  (∃ r : R, 0 ≤ r ∧ x = r • y) ↔ same_ray R x y :=
+by simpa only [same_ray_comm, eq_comm] using exists_nonneg_left_iff_same_ray hy
+
+end linear_ordered_field
diff --git a/src/linear_algebra/sesquilinear_form.lean b/src/linear_algebra/sesquilinear_form.lean
index 2c505cca3a049..b9e8e550fb951 100644
--- a/src/linear_algebra/sesquilinear_form.lean
+++ b/src/linear_algebra/sesquilinear_form.lean
@@ -4,13 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Andreas Swerdlow
 -/
 import algebra.module.linear_map
+import linear_algebra.basis.bilinear
 import linear_algebra.bilinear_map
-import linear_algebra.matrix.basis
-import linear_algebra.linear_pmap
+import algebra.euclidean_domain.instances
+import ring_theory.non_zero_divisors
 
 /-!
 # Sesquilinear form
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files provides properties about sesquilinear forms. The maps considered are of the form
 `M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R`, where `I₁ : R₁ →+* R` and `I₂ : R₂ →+* R` are ring homomorphisms and
 `M₁` is a module over `R₁` and `M₂` is a module over `R₂`.
@@ -37,7 +41,7 @@ Sesquilinear form,
 
 open_locale big_operators
 
-variables {R R₁ R₂ R₃ M M₁ M₂ K K₁ K₂ V V₁ V₂ n: Type*}
+variables {R R₁ R₂ R₃ M M₁ M₂ Mₗ₁ Mₗ₁' Mₗ₂ Mₗ₂' K K₁ K₂ V V₁ V₂ n : Type*}
 
 namespace linear_map
 
@@ -102,7 +106,7 @@ begin
   { rw [map_smulₛₗ₂, H, smul_zero]},
   { rw [map_smulₛₗ₂, smul_eq_zero] at H,
     cases H,
-    { rw I₁.map_eq_zero at H, trivial },
+    { rw map_eq_zero I₁ at H, trivial },
     { exact H }}
 end
 
@@ -136,7 +140,7 @@ begin
     intros j hj hij,
     rw [is_Ortho_def.1 hv₁ _ _ hij, mul_zero], },
   simp_rw [B.map_sum₂, map_smulₛₗ₂, smul_eq_mul, hsum] at this,
-  apply I₁.map_eq_zero.mp,
+  apply (map_eq_zero I₁).mp,
   exact eq_zero_of_ne_zero_of_mul_right_eq_zero (hv₂ i) this,
 end
 
@@ -372,9 +376,8 @@ end
   is complement to its orthogonal complement. -/
 lemma is_compl_span_singleton_orthogonal {B : V →ₗ[K] V →ₗ[K] K}
   {x : V} (hx : ¬ B.is_ortho x x) : is_compl (K ∙ x) (submodule.orthogonal_bilin (K ∙ x) B) :=
-{ inf_le_bot := eq_bot_iff.1 $
-    (span_singleton_inf_orthogonal_eq_bot B x hx),
-  top_le_sup := eq_top_iff.1 $ span_singleton_sup_orthogonal_eq_top hx }
+{ disjoint := disjoint_iff.2 $ span_singleton_inf_orthogonal_eq_bot B x hx,
+  codisjoint := codisjoint_iff.2 $ span_singleton_sup_orthogonal_eq_top hx }
 
 end orthogonal
 
@@ -388,7 +391,8 @@ variables [comm_semiring R]
 variables [add_comm_monoid M] [module R M]
 variables [add_comm_monoid M₁] [module R M₁]
 variables [add_comm_monoid M₂] [module R M₂]
-variables {B F : M →ₗ[R] M →ₗ[R] R} {B' : M₁ →ₗ[R] M₁ →ₗ[R] R} {B'' : M₂ →ₗ[R] M₂ →ₗ[R] R}
+variables {I : R →+* R}
+variables {B F : M →ₗ[R] M →ₛₗ[I] R} {B' : M₁ →ₗ[R] M₁ →ₛₗ[I] R} {B'' : M₂ →ₗ[R] M₂ →ₛₗ[I] R}
 variables {f f' : M →ₗ[R] M₁} {g g' : M₁ →ₗ[R] M}
 
 variables (B B' f g)
@@ -456,7 +460,8 @@ section add_comm_monoid
 
 variables [comm_semiring R]
 variables [add_comm_monoid M] [module R M]
-variables (B F : M →ₗ[R] M →ₗ[R] R)
+variables {I : R →+* R}
+variables (B F : M →ₗ[R] M →ₛₗ[I] R)
 
 /-- The condition for an endomorphism to be "self-adjoint" with respect to a pair of bilinear forms
 on the underlying module. In the case that these two forms are identical, this is the usual concept
@@ -550,6 +555,46 @@ for every nonzero `x` in `M₁`, there exists `y` in `M₂` with `B x y ≠ 0`.-
 def separating_left (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
 ∀ x : M₁, (∀ y : M₂, B x y = 0) → x = 0
 
+variables (M₁ M₂ I₁ I₂)
+
+/-- In a non-trivial module, zero is not non-degenerate. -/
+lemma not_separating_left_zero [nontrivial M₁] : ¬(0 : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R).separating_left :=
+let ⟨m, hm⟩ := exists_ne (0 : M₁) in λ h, hm (h m $ λ n, rfl)
+
+variables {M₁ M₂ I₁ I₂}
+
+lemma separating_left.ne_zero [nontrivial M₁] {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R}
+  (h : B.separating_left) : B ≠ 0 :=
+λ h0, not_separating_left_zero M₁ M₂ I₁ I₂ $ h0 ▸ h
+
+section linear
+
+variables [add_comm_monoid Mₗ₁] [add_comm_monoid Mₗ₂] [add_comm_monoid Mₗ₁'] [add_comm_monoid Mₗ₂']
+variables [module R Mₗ₁] [module R Mₗ₂] [module R Mₗ₁'] [module R Mₗ₂']
+variables {B : Mₗ₁ →ₗ[R] Mₗ₂ →ₗ[R] R} (e₁ : Mₗ₁ ≃ₗ[R] Mₗ₁') (e₂ : Mₗ₂ ≃ₗ[R] Mₗ₂')
+
+lemma separating_left.congr (h : B.separating_left) :
+  (e₁.arrow_congr (e₂.arrow_congr (linear_equiv.refl R R)) B).separating_left :=
+begin
+  intros x hx,
+  rw ←e₁.symm.map_eq_zero_iff,
+  refine h (e₁.symm x) (λ y, _),
+  specialize hx (e₂ y),
+  simp only [linear_equiv.arrow_congr_apply, linear_equiv.symm_apply_apply,
+    linear_equiv.map_eq_zero_iff] at hx,
+  exact hx,
+end
+
+@[simp] lemma separating_left_congr_iff :
+  (e₁.arrow_congr (e₂.arrow_congr (linear_equiv.refl R R)) B).separating_left ↔ B.separating_left :=
+⟨λ h, begin
+  convert h.congr e₁.symm e₂.symm,
+  ext x y,
+  simp,
+end, separating_left.congr e₁ e₂⟩
+
+end linear
+
 /-- A bilinear form is called right-separating if
 the only element that is right-orthogonal to every other element is `0`; i.e.,
 for every nonzero `y` in `M₂`, there exists `x` in `M₁` with `B x y ≠ 0`.-/
@@ -628,7 +673,7 @@ begin
   refine (hB.dom_restrict_refl W).nondegenerate_of_separating_left  _,
   rintro ⟨x, hx⟩ b₁,
   rw [submodule.mk_eq_zero, ← submodule.mem_bot R],
-  refine hW ⟨hx, λ y hy, _⟩,
+  refine hW.le_bot ⟨hx, λ y hy, _⟩,
   specialize b₁ ⟨y, hy⟩,
   simp_rw [dom_restrict₁₂_apply, submodule.coe_mk] at b₁,
   rw hB.ortho_comm,
@@ -651,7 +696,7 @@ begin
   convert mul_zero _ using 2,
   obtain rfl | hij := eq_or_ne i j,
   { exact ho },
-  { exact h i j hij },
+  { exact h hij },
 end
 
 /-- An orthogonal basis with respect to a right-separating bilinear form has no self-orthogonal
@@ -681,7 +726,7 @@ begin
     smul_eq_mul] at hB,
   rw finset.sum_eq_single i at hB,
   { exact eq_zero_of_ne_zero_of_mul_right_eq_zero (h i) hB, },
-  { intros j hj hij, convert mul_zero _ using 2, exact hO j i hij, },
+  { intros j hj hij, convert mul_zero _ using 2, exact hO hij, },
   { intros hi, convert zero_mul _ using 2, exact finsupp.not_mem_support_iff.mp hi }
 end
 
diff --git a/src/linear_algebra/smodeq.lean b/src/linear_algebra/smodeq.lean
index 7e74a8766c504..36269e80e2407 100644
--- a/src/linear_algebra/smodeq.lean
+++ b/src/linear_algebra/smodeq.lean
@@ -9,6 +9,9 @@ import ring_theory.ideal.quotient
 
 /-!
 # modular equivalence for submodule
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 open submodule
@@ -44,7 +47,11 @@ by rw [smodeq.def, submodule.quotient.eq, mem_bot, sub_eq_zero]
 @[mono] theorem mono (HU : U₁ ≤ U₂) (hxy : x ≡ y [SMOD U₁]) : x ≡ y [SMOD U₂] :=
 (submodule.quotient.eq U₂).2 $ HU $ (submodule.quotient.eq U₁).1 hxy
 
-@[refl] theorem refl : x ≡ x [SMOD U] := eq.refl _
+@[refl] protected theorem refl (x : M) : x ≡ x [SMOD U] := @rfl _ _
+
+protected theorem rfl : x ≡ x [SMOD U] := smodeq.refl _
+
+instance : is_refl _ (smodeq U) := ⟨smodeq.refl⟩
 
 @[symm] theorem symm (hxy : x ≡ y [SMOD U]) : y ≡ x [SMOD U] := hxy.symm
 
diff --git a/src/linear_algebra/span.lean b/src/linear_algebra/span.lean
index 1b35892df4ab6..56abfe2cb5545 100644
--- a/src/linear_algebra/span.lean
+++ b/src/linear_algebra/span.lean
@@ -5,11 +5,15 @@ Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Fréd
   Heather Macbeth
 -/
 import linear_algebra.basic
+import order.compactly_generated
 import order.omega_complete_partial_order
 
 /-!
 # The span of a set of vectors, as a submodule
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 * `submodule.span s` is defined to be the smallest submodule containing the set `s`.
 
 ## Notations
@@ -51,15 +55,21 @@ lemma span_le {p} : span R s ≤ p ↔ s ⊆ p :=
 lemma span_mono (h : s ⊆ t) : span R s ≤ span R t :=
 span_le.2 $ subset.trans h subset_span
 
+lemma span_monotone : monotone (span R : set M → submodule R M) :=
+λ _ _, span_mono
+
 lemma span_eq_of_le (h₁ : s ⊆ p) (h₂ : p ≤ span R s) : span R s = p :=
 le_antisymm (span_le.2 h₁) h₂
 
 lemma span_eq : span R (p : set M) = p :=
 span_eq_of_le _ (subset.refl _) subset_span
 
+lemma span_eq_span (hs : s ⊆ span R t) (ht : t ⊆ span R s) : span R s = span R t :=
+le_antisymm (span_le.2 hs) (span_le.2 ht)
+
 /-- A version of `submodule.span_eq` for when the span is by a smaller ring. -/
 @[simp] lemma span_coe_eq_restrict_scalars
-  [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] :
+  [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M] :
   span S (p : set M) = p.restrict_scalars S :=
 span_eq (p.restrict_scalars S)
 
@@ -68,7 +78,7 @@ lemma map_span [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (
 eq.symm $ span_eq_of_le _ (set.image_subset f subset_span) $
 map_le_iff_le_comap.2 $ span_le.2 $ λ x hx, subset_span ⟨x, hx, rfl⟩
 
-alias submodule.map_span ← linear_map.map_span
+alias submodule.map_span ← _root_.linear_map.map_span
 
 lemma map_span_le [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M)
   (N : submodule R₂ M₂) : map f (span R s) ≤ N ↔ ∀ m ∈ s, f m ∈ N :=
@@ -77,7 +87,7 @@ begin
   exact iff.rfl
 end
 
-alias submodule.map_span_le ← linear_map.map_span_le
+alias submodule.map_span_le ← _root_.linear_map.map_span_le
 
 @[simp] lemma span_insert_zero : span R (insert (0 : M) s) = span R s :=
 begin
@@ -91,7 +101,18 @@ lemma span_preimage_le (f : M →ₛₗ[σ₁₂] M₂) (s : set M₂) :
   span R (f ⁻¹' s) ≤ (span R₂ s).comap f :=
 by { rw [span_le, comap_coe], exact preimage_mono (subset_span), }
 
-alias submodule.span_preimage_le  ← linear_map.span_preimage_le
+alias submodule.span_preimage_le ← _root_.linear_map.span_preimage_le
+
+lemma closure_subset_span {s : set M} :
+  (add_submonoid.closure s : set M) ⊆ span R s :=
+(@add_submonoid.closure_le _ _ _ (span R s).to_add_submonoid).mpr subset_span
+
+lemma closure_le_to_add_submonoid_span {s : set M} :
+  add_submonoid.closure s ≤ (span R s).to_add_submonoid :=
+closure_subset_span
+
+@[simp] lemma span_closure {s : set M} : span R (add_submonoid.closure s : set M) = span R s :=
+le_antisymm (span_le.mpr closure_subset_span) (span_mono add_submonoid.subset_closure)
 
 /-- An induction principle for span membership. If `p` holds for 0 and all elements of `s`, and is
 preserved under addition and scalar multiplication, then `p` holds for all elements of the span of
@@ -186,9 +207,16 @@ by rw [submodule.span_union, p.span_eq]
 lemma span_sup : span R s ⊔ p = span R (s ∪ p) :=
 by rw [submodule.span_union, p.span_eq]
 
-lemma span_eq_supr_of_singleton_spans (s : set M) : span R s = ⨆ x ∈ s, span R {x} :=
+/- Note that the character `∙` U+2219 used below is different from the scalar multiplication
+character `•` U+2022 and the matrix multiplication character `⬝` U+2B1D. -/
+notation R` ∙ `:1000 x := span R (@singleton _ _ set.has_singleton x)
+
+lemma span_eq_supr_of_singleton_spans (s : set M) : span R s = ⨆ x ∈ s, R ∙ x :=
 by simp only [←span_Union, set.bUnion_of_singleton s]
 
+lemma span_range_eq_supr {ι : Type*} {v : ι → M} : span R (range v) = ⨆ i, R ∙ v i :=
+by rw [span_eq_supr_of_singleton_spans, supr_range]
+
 lemma span_smul_le (s : set M) (r : R) :
   span R (r • s) ≤ span R s :=
 begin
@@ -306,10 +334,6 @@ end
 
 end
 
-/- This is the character `∙`, with escape sequence `\.`, and is thus different from the scalar
-multiplication character `•`, with escape sequence `\bub`. -/
-notation R`∙`:1000 x := span R (@singleton _ _ set.has_singleton x)
-
 lemma mem_span_singleton_self (x : M) : x ∈ R ∙ x := subset_span rfl
 
 lemma nontrivial_span_singleton {x : M} (h : x ≠ 0) : nontrivial (R ∙ x) :=
@@ -348,14 +372,14 @@ by { ext, simp [mem_span_singleton, eq_comm] }
 lemma span_singleton_eq_range (y : M) : ↑(R ∙ y) = range ((• y) : R → M) :=
 set.ext $ λ x, mem_span_singleton
 
-lemma span_singleton_smul_le {S} [monoid S] [has_scalar S R] [mul_action S M]
+lemma span_singleton_smul_le {S} [monoid S] [has_smul S R] [mul_action S M]
   [is_scalar_tower S R M] (r : S) (x : M) : (R ∙ (r • x)) ≤ R ∙ x :=
 begin
   rw [span_le, set.singleton_subset_iff, set_like.mem_coe],
   exact smul_of_tower_mem _ _ (mem_span_singleton_self _)
 end
 
-lemma span_singleton_group_smul_eq {G} [group G] [has_scalar G R] [mul_action G M]
+lemma span_singleton_group_smul_eq {G} [group G] [has_smul G R] [mul_action G M]
   [is_scalar_tower G R M] (g : G) (x : M) : (R ∙ (g • x)) = R ∙ x :=
 begin
   refine le_antisymm (span_singleton_smul_le R g x) _,
@@ -405,6 +429,9 @@ begin
   simp only [eq_comm, add_comm, exists_and_distrib_left]
 end
 
+lemma mem_span_pair {x y z : M} : z ∈ span R ({x, y} : set M) ↔ ∃ a b : R, a • x + b • y = z :=
+by simp_rw [mem_span_insert, mem_span_singleton, exists_prop, exists_exists_eq_and, eq_comm]
+
 lemma span_insert (x) (s : set M) : span R (insert x s) = span R ({x} : set M) ⊔ span R s :=
 by rw [insert_eq, span_union]
 
@@ -416,18 +443,18 @@ lemma span_span : span R (span R s : set M) = span R s := span_eq _
 variables (R S s)
 
 /-- If `R` is "smaller" ring than `S` then the span by `R` is smaller than the span by `S`. -/
-lemma span_le_restrict_scalars [semiring S] [has_scalar R S] [module S M] [is_scalar_tower R S M] :
+lemma span_le_restrict_scalars [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
   span R s ≤ (span S s).restrict_scalars R :=
 submodule.span_le.2 submodule.subset_span
 
 /-- A version of `submodule.span_le_restrict_scalars` with coercions. -/
-@[simp] lemma span_subset_span [semiring S] [has_scalar R S] [module S M] [is_scalar_tower R S M] :
+@[simp] lemma span_subset_span [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
   ↑(span R s) ⊆ (span S s : set M) :=
 span_le_restrict_scalars R S s
 
 /-- Taking the span by a large ring of the span by the small ring is the same as taking the span
 by just the large ring. -/
-lemma span_span_of_tower [semiring S] [has_scalar R S] [module S M] [is_scalar_tower R S M] :
+lemma span_span_of_tower [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
   span S (span R s : set M) = span S s :=
 le_antisymm (span_le.2 $ span_subset_span R S s) (span_mono subset_span)
 
@@ -488,11 +515,12 @@ lemma not_mem_span_of_apply_not_mem_span_image
    x ∉ submodule.span R s :=
 h.imp (apply_mem_span_image_of_mem_span f)
 
-lemma supr_eq_span {ι : Sort*} (p : ι → submodule R M) :
-  (⨆ (i : ι), p i) = submodule.span R (⋃ (i : ι), ↑(p i)) :=
-le_antisymm
-  (supr_le $ assume i, subset.trans (assume m hm, set.mem_Union.mpr ⟨i, hm⟩) subset_span)
-  (span_le.mpr $ Union_subset_iff.mpr $ assume i m hm, mem_supr_of_mem i hm)
+lemma supr_span {ι : Sort*} (p : ι → set M) : (⨆ i, span R (p i)) = span R (⋃ i, p i) :=
+le_antisymm (supr_le $ λ i, span_mono $ subset_Union _ i) $
+  span_le.mpr $ Union_subset $ λ i m hm, mem_supr_of_mem i $ subset_span hm
+
+lemma supr_eq_span {ι : Sort*} (p : ι → submodule R M) : (⨆ i, p i) = span R (⋃ i, ↑(p i)) :=
+by simp_rw [← supr_span, span_eq]
 
 lemma supr_to_add_submonoid {ι : Sort*} (p : ι → submodule R M) :
   (⨆ i, p i).to_add_submonoid = ⨆ i, (p i).to_add_submonoid :=
@@ -579,6 +607,18 @@ instance : is_compactly_generated (submodule R M) :=
   apply singleton_span_is_compact_element,
 end, by rw [Sup_eq_supr, supr_image, ←span_eq_supr_of_singleton_spans, span_eq]⟩⟩⟩
 
+/-- A submodule is equal to the supremum of the spans of the submodule's nonzero elements. -/
+lemma submodule_eq_Sup_le_nonzero_spans (p : submodule R M) :
+  p = Sup {T : submodule R M | ∃ (m : M) (hm : m ∈ p) (hz : m ≠ 0), T = span R {m}} :=
+begin
+  let S := {T : submodule R M | ∃ (m : M) (hm : m ∈ p) (hz : m ≠ 0), T = span R {m}},
+  apply le_antisymm,
+  { intros m hm, by_cases h : m = 0,
+    { rw h, simp },
+    { exact @le_Sup _ _ S _ ⟨m, ⟨hm, ⟨h, rfl⟩⟩⟩ m (mem_span_singleton_self m) } },
+  { rw Sup_le_iff, rintros S ⟨_, ⟨_, ⟨_, rfl⟩⟩⟩, rwa span_singleton_le_iff_mem }
+end
+
 lemma lt_sup_iff_not_mem {I : submodule R M} {a : M} : I < I ⊔ (R ∙ a) ↔ a ∉ I :=
 begin
   split,
@@ -638,12 +678,11 @@ variables {M' : Type*} [add_comm_monoid M'] [module R M'] (q₁ q₁' : submodul
 
 /-- The product of two submodules is a submodule. -/
 def prod : submodule R (M × M') :=
-{ carrier   := (p : set M) ×ˢ (q₁ : set M'),
+{ carrier   := p ×ˢ q₁,
   smul_mem' := by rintro a ⟨x, y⟩ ⟨hx, hy⟩; exact ⟨smul_mem _ a hx, smul_mem _ a hy⟩,
   .. p.to_add_submonoid.prod q₁.to_add_submonoid }
 
-@[simp] lemma prod_coe :
-  (prod p q₁ : set (M × M')) = (p : set M) ×ˢ (q₁ : set M') := rfl
+@[simp] lemma prod_coe : (prod p q₁ : set (M × M')) = p ×ˢ q₁ := rfl
 
 @[simp] lemma mem_prod {p : submodule R M} {q : submodule R M'} {x : M × M'} :
   x ∈ prod p q ↔ x.1 ∈ p ∧ x.2 ∈ q := set.mem_prod
@@ -710,18 +749,21 @@ section add_comm_group
 variables [semiring R] [semiring R₂]
 variables [add_comm_group M] [module R M] [add_comm_group M₂] [module R₂ M₂]
 variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]
+variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
 
-lemma comap_map_eq (f : M →ₛₗ[τ₁₂] M₂) (p : submodule R M) :
-  comap f (map f p) = p ⊔ f.ker :=
+include sc
+lemma comap_map_eq (f : F) (p : submodule R M) :
+  comap f (map f p) = p ⊔ (linear_map.ker f) :=
 begin
   refine le_antisymm _ (sup_le (le_comap_map _ _) (comap_mono bot_le)),
   rintro x ⟨y, hy, e⟩,
   exact mem_sup.2 ⟨y, hy, x - y, by simpa using sub_eq_zero.2 e.symm, by simp⟩
 end
 
-lemma comap_map_eq_self {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R M} (h : f.ker ≤ p) :
+lemma comap_map_eq_self {f : F} {p : submodule R M} (h : linear_map.ker f ≤ p) :
   comap f (map f p) = p :=
 by rw [submodule.comap_map_eq, sup_of_le_left h]
+omit sc
 
 end add_comm_group
 
@@ -737,20 +779,22 @@ variables [semiring R] [semiring R₂]
 variables [add_comm_group M] [add_comm_group M₂]
 variables [module R M] [module R₂ M₂]
 variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]
+variables {F : Type*} [sc : semilinear_map_class F τ₁₂ M M₂]
 include R
 
-protected lemma map_le_map_iff (f : M →ₛₗ[τ₁₂] M₂) {p p'} : map f p ≤ map f p' ↔ p ≤ p' ⊔ ker f :=
+include sc
+protected lemma map_le_map_iff (f : F) {p p'} : map f p ≤ map f p' ↔ p ≤ p' ⊔ ker f :=
 by rw [map_le_iff_le_comap, submodule.comap_map_eq]
 
-theorem map_le_map_iff' {f : M →ₛₗ[τ₁₂] M₂} (hf : ker f = ⊥) {p p'} :
+theorem map_le_map_iff' {f : F} (hf : ker f = ⊥) {p p'} :
   map f p ≤ map f p' ↔ p ≤ p' :=
 by rw [linear_map.map_le_map_iff, hf, sup_bot_eq]
 
-theorem map_injective {f : M →ₛₗ[τ₁₂] M₂} (hf : ker f = ⊥) : injective (map f) :=
+theorem map_injective {f : F} (hf : ker f = ⊥) : injective (map f) :=
 λ p p' h, le_antisymm ((map_le_map_iff' hf).1 (le_of_eq h)) ((map_le_map_iff' hf).1 (ge_of_eq h))
 
-theorem map_eq_top_iff {f : M →ₛₗ[τ₁₂] M₂} (hf : range f = ⊤) {p : submodule R M} :
-  p.map f = ⊤ ↔ p ⊔ f.ker = ⊤ :=
+theorem map_eq_top_iff {f : F} (hf : range f = ⊤) {p : submodule R M} :
+  p.map f = ⊤ ↔ p ⊔ linear_map.ker f = ⊤ :=
 by simp_rw [← top_le_iff, ← hf, range_eq_map, linear_map.map_le_map_iff]
 
 end add_comm_group
@@ -766,7 +810,9 @@ variables (R) (M) [semiring R] [add_comm_monoid M] [module R M]
 lemma span_singleton_eq_range (x : M) : (R ∙ x) = (to_span_singleton R M x).range :=
 submodule.ext $ λ y, by {refine iff.trans _ linear_map.mem_range.symm, exact mem_span_singleton }
 
-lemma to_span_singleton_one (x : M) : to_span_singleton R M x 1 = x := one_smul _ _
+@[simp] lemma to_span_singleton_one (x : M) : to_span_singleton R M x 1 = x := one_smul _ _
+
+@[simp] lemma to_span_singleton_zero : to_span_singleton R M 0 = 0 := by { ext, simp, }
 
 end
 
@@ -805,6 +851,15 @@ ext_on hv (set.forall_range_iff.2 h)
 
 end add_comm_monoid
 
+section no_zero_divisors
+
+variables (R M) [ring R] [add_comm_group M] [module R M] [no_zero_smul_divisors R M]
+
+lemma ker_to_span_singleton {x : M} (h : x ≠ 0) : (to_span_singleton R M x).ker = ⊥ :=
+set_like.ext $ λ c, smul_eq_zero.trans $ or_iff_left_of_imp $ λ h', (h h').elim
+
+end no_zero_divisors
+
 section field
 
 variables {K V} [field K] [add_comm_group V] [module K V]
@@ -821,20 +876,6 @@ eq_top_iff.2 (λ y hy, submodule.mem_sup.2 ⟨(f y * (f x)⁻¹) • x,
              inv_mul_cancel hx, mul_one, sub_self],
       by simp only [add_sub_cancel'_right]⟩⟩)
 
-variables (K V)
-
-lemma ker_to_span_singleton {x : V} (h : x ≠ 0) : (to_span_singleton K V x).ker = ⊥ :=
-begin
-  ext c, split,
-  { intros hc, rw submodule.mem_bot, rw mem_ker at hc, by_contra hc',
-    have : x = 0,
-      calc x = c⁻¹ • (c • x) : by rw [← mul_smul, inv_mul_cancel hc', one_smul]
-      ... = c⁻¹ • ((to_span_singleton K V x) c) : rfl
-      ... = 0 : by rw [hc, smul_zero],
-    tauto },
-  { rw [mem_ker, submodule.mem_bot], intros h, rw h, simp }
-end
-
 end field
 
 end linear_map
@@ -843,38 +884,35 @@ open linear_map
 
 namespace linear_equiv
 
-section field
-
-variables (K V) [field K] [add_comm_group V] [module K V]
+variables (R M) [ring R] [add_comm_group M] [module R M] [no_zero_smul_divisors R M]
+  (x : M) (h : x ≠ 0)
 
-/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural
-    map from `K` to the span of `x`, with invertibility check to consider it as an
-    isomorphism.-/
-def to_span_nonzero_singleton (x : V) (h : x ≠ 0) : K ≃ₗ[K] (K ∙ x) :=
+/-- Given a nonzero element `x` of a torsion-free module `M` over a ring `R`, the natural
+isomorphism from `R` to the span of `x` given by $r \mapsto r \cdot x$. -/
+def to_span_nonzero_singleton : R ≃ₗ[R] R ∙ x :=
 linear_equiv.trans
   (linear_equiv.of_injective
-    (linear_map.to_span_singleton K V x) (ker_eq_bot.1 $ linear_map.ker_to_span_singleton K V h))
-  (linear_equiv.of_eq (to_span_singleton K V x).range (K ∙ x)
-    (span_singleton_eq_range K V x).symm)
+    (linear_map.to_span_singleton R M x) (ker_eq_bot.1 $ ker_to_span_singleton R M h))
+    (linear_equiv.of_eq (to_span_singleton R M x).range (R ∙ x)
+      (span_singleton_eq_range R M x).symm)
 
-lemma to_span_nonzero_singleton_one (x : V) (h : x ≠ 0) :
-  linear_equiv.to_span_nonzero_singleton K V x h 1 =
-    (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) :=
+lemma to_span_nonzero_singleton_one :
+  linear_equiv.to_span_nonzero_singleton R M x h 1 =
+    (⟨x, submodule.mem_span_singleton_self x⟩ : R ∙ x) :=
 begin
   apply set_like.coe_eq_coe.mp,
-  have : ↑(to_span_nonzero_singleton K V x h 1) = to_span_singleton K V x 1 := rfl,
+  have : ↑(to_span_nonzero_singleton R M x h 1) = to_span_singleton R M x 1 := rfl,
   rw [this, to_span_singleton_one, submodule.coe_mk],
 end
 
-/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural map
-    from the span of `x` to `K`.-/
-abbreviation coord (x : V) (h : x ≠ 0) : (K ∙ x) ≃ₗ[K] K :=
-(to_span_nonzero_singleton K V x h).symm
+/-- Given a nonzero element `x` of a torsion-free module `M` over a ring `R`, the natural
+isomorphism from the span of `x` to `R` given by $r \cdot x \mapsto r$. -/
+abbreviation coord : (R ∙ x) ≃ₗ[R] R := (to_span_nonzero_singleton R M x h).symm
 
-lemma coord_self (x : V) (h : x ≠ 0) :
-  (coord K V x h) (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) = 1 :=
-by rw [← to_span_nonzero_singleton_one K V x h, linear_equiv.symm_apply_apply]
+lemma coord_self : (coord R M x h) (⟨x, submodule.mem_span_singleton_self x⟩ : R ∙ x) = 1 :=
+by rw [← to_span_nonzero_singleton_one R M x h, linear_equiv.symm_apply_apply]
 
-end field
+lemma coord_apply_smul (y : submodule.span R ({x} : set M)) : coord R M x h y • x = y :=
+subtype.ext_iff.1 $ (to_span_nonzero_singleton R M x h).apply_symm_apply _
 
 end linear_equiv
diff --git a/src/linear_algebra/special_linear_group.lean b/src/linear_algebra/special_linear_group.lean
deleted file mode 100644
index 36209babd43d4..0000000000000
--- a/src/linear_algebra/special_linear_group.lean
+++ /dev/null
@@ -1,231 +0,0 @@
-/-
-Copyright (c) 2020 Anne Baanen. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Anne Baanen
--/
-import linear_algebra.matrix.adjugate
-import linear_algebra.matrix.to_lin
-
-/-!
-# The Special Linear group $SL(n, R)$
-
-This file defines the elements of the Special Linear group `special_linear_group n R`, consisting
-of all square `R`-matrices with determinant `1` on the fintype `n` by `n`.  In addition, we define
-the group structure on `special_linear_group n R` and the embedding into the general linear group
-`general_linear_group R (n → R)`.
-
-## Main definitions
-
- * `matrix.special_linear_group` is the type of matrices with determinant 1
- * `matrix.special_linear_group.group` gives the group structure (under multiplication)
- * `matrix.special_linear_group.to_GL` is the embedding `SLₙ(R) → GLₙ(R)`
-
-## Notation
-
-For `m : ℕ`, we introduce the notation `SL(m,R)` for the special linear group on the fintype
-`n = fin m`, in the locale `matrix_groups`.
-
-## Implementation notes
-The inverse operation in the `special_linear_group` is defined to be the adjugate
-matrix, so that `special_linear_group n R` has a group structure for all `comm_ring R`.
-
-We define the elements of `special_linear_group` to be matrices, since we need to
-compute their determinant. This is in contrast with `general_linear_group R M`,
-which consists of invertible `R`-linear maps on `M`.
-
-We provide `matrix.special_linear_group.has_coe_to_fun` for convenience, but do not state any
-lemmas about it, and use `matrix.special_linear_group.coe_fn_eq_coe` to eliminate it `⇑` in favor
-of a regular `↑` coercion.
-
-## References
-
- * https://en.wikipedia.org/wiki/Special_linear_group
-
-## Tags
-
-matrix group, group, matrix inverse
--/
-
-namespace matrix
-universes u v
-open_locale matrix
-open linear_map
-
-
-section
-
-variables (n : Type u) [decidable_eq n] [fintype n] (R : Type v) [comm_ring R]
-
-/-- `special_linear_group n R` is the group of `n` by `n` `R`-matrices with determinant equal to 1.
--/
-def special_linear_group := { A : matrix n n R // A.det = 1 }
-
-end
-
-localized "notation `SL(` n `,` R `)`:= matrix.special_linear_group (fin n) R" in matrix_groups
-
-namespace special_linear_group
-
-variables {n : Type u} [decidable_eq n] [fintype n] {R : Type v} [comm_ring R]
-
-instance has_coe_to_matrix : has_coe (special_linear_group n R) (matrix n n R) :=
-⟨λ A, A.val⟩
-
-/- In this file, Lean often has a hard time working out the values of `n` and `R` for an expression
-like `det ↑A`. Rather than writing `(A : matrix n n R)` everywhere in this file which is annoyingly
-verbose, or `A.val` which is not the simp-normal form for subtypes, we create a local notation
-`↑ₘA`. This notation references the local `n` and `R` variables, so is not valid as a global
-notation. -/
-local prefix `↑ₘ`:1024 := @coe _ (matrix n n R) _
-
-lemma ext_iff (A B : special_linear_group n R) : A = B ↔ (∀ i j, ↑ₘA i j = ↑ₘB i j) :=
-subtype.ext_iff.trans matrix.ext_iff.symm
-
-@[ext] lemma ext (A B : special_linear_group n R) : (∀ i j, ↑ₘA i j = ↑ₘB i j) → A = B :=
-(special_linear_group.ext_iff A B).mpr
-
-instance has_inv : has_inv (special_linear_group n R) :=
-⟨λ A, ⟨adjugate A, by rw [det_adjugate, A.prop, one_pow]⟩⟩
-
-instance has_mul : has_mul (special_linear_group n R) :=
-⟨λ A B, ⟨A.1 ⬝ B.1, by erw [det_mul, A.2, B.2, one_mul]⟩⟩
-
-instance has_one : has_one (special_linear_group n R) :=
-⟨⟨1, det_one⟩⟩
-
-instance : has_pow (special_linear_group n R) ℕ :=
-{ pow := λ x n, ⟨x ^ n, (det_pow _ _).trans $ x.prop.symm ▸ one_pow _⟩}
-
-instance : inhabited (special_linear_group n R) := ⟨1⟩
-
-section coe_lemmas
-
-variables (A B : special_linear_group n R)
-
-@[simp] lemma coe_mk (A : matrix n n R) (h : det A = 1) :
-  ↑(⟨A, h⟩ : special_linear_group n R) = A :=
-rfl
-
-@[simp] lemma coe_inv : ↑ₘ(A⁻¹) = adjugate A := rfl
-
-@[simp] lemma coe_mul : ↑ₘ(A * B) = ↑ₘA ⬝ ↑ₘB := rfl
-
-@[simp] lemma coe_one : ↑ₘ(1 : special_linear_group n R) = (1 : matrix n n R) := rfl
-
-@[simp] lemma det_coe : det ↑ₘA = 1 := A.2
-
-@[simp] lemma coe_pow (m : ℕ) : ↑ₘ(A ^ m) = ↑ₘA ^ m := rfl
-
-lemma det_ne_zero [nontrivial R] (g : special_linear_group n R) :
-  det ↑ₘg ≠ 0 :=
-by { rw g.det_coe, norm_num }
-
-lemma row_ne_zero [nontrivial R] (g : special_linear_group n R) (i : n):
-  ↑ₘg i ≠ 0 :=
-λ h, g.det_ne_zero $ det_eq_zero_of_row_eq_zero i $ by simp [h]
-
-end coe_lemmas
-
-instance : monoid (special_linear_group n R) :=
-function.injective.monoid coe subtype.coe_injective coe_one coe_mul coe_pow
-
-instance : group (special_linear_group n R) :=
-{ mul_left_inv := λ A, by { ext1, simp [adjugate_mul] },
-  ..special_linear_group.monoid,
-  ..special_linear_group.has_inv }
-
-/-- A version of `matrix.to_lin' A` that produces linear equivalences. -/
-def to_lin' : special_linear_group n R →* (n → R) ≃ₗ[R] (n → R) :=
-{ to_fun := λ A, linear_equiv.of_linear (matrix.to_lin' ↑ₘA) (matrix.to_lin' ↑ₘ(A⁻¹))
-    (by rw [←to_lin'_mul, ←coe_mul, mul_right_inv, coe_one, to_lin'_one])
-    (by rw [←to_lin'_mul, ←coe_mul, mul_left_inv, coe_one, to_lin'_one]),
-  map_one' := linear_equiv.to_linear_map_injective matrix.to_lin'_one,
-  map_mul' := λ A B, linear_equiv.to_linear_map_injective $ matrix.to_lin'_mul A B }
-
-lemma to_lin'_apply (A : special_linear_group n R) (v : n → R) :
-  special_linear_group.to_lin' A v = matrix.to_lin' ↑ₘA v := rfl
-
-lemma to_lin'_to_linear_map (A : special_linear_group n R) :
-  ↑(special_linear_group.to_lin' A) = matrix.to_lin' ↑ₘA := rfl
-
-lemma to_lin'_symm_apply (A : special_linear_group n R) (v : n → R) :
-  A.to_lin'.symm v = matrix.to_lin' ↑ₘ(A⁻¹) v := rfl
-
-lemma to_lin'_symm_to_linear_map (A : special_linear_group n R) :
-  ↑(A.to_lin'.symm) = matrix.to_lin' ↑ₘ(A⁻¹) := rfl
-
-lemma to_lin'_injective :
-  function.injective ⇑(to_lin' : special_linear_group n R →* (n → R) ≃ₗ[R] (n → R)) :=
-λ A B h, subtype.coe_injective $ matrix.to_lin'.injective $
-  linear_equiv.to_linear_map_injective.eq_iff.mpr h
-
-/-- `to_GL` is the map from the special linear group to the general linear group -/
-def to_GL : special_linear_group n R →* general_linear_group R (n → R) :=
-(general_linear_group.general_linear_equiv _ _).symm.to_monoid_hom.comp to_lin'
-
-lemma coe_to_GL (A : special_linear_group n R) : ↑A.to_GL = A.to_lin'.to_linear_map := rfl
-
-variables {S : Type*} [comm_ring S]
-
-/-- A ring homomorphism from `R` to `S` induces a group homomorphism from
-`special_linear_group n R` to `special_linear_group n S`. -/
-@[simps] def map (f : R →+* S) : special_linear_group n R →* special_linear_group n S :=
-{ to_fun := λ g, ⟨f.map_matrix ↑g, by { rw ← f.map_det, simp [g.2] }⟩,
-  map_one' := subtype.ext $ f.map_matrix.map_one,
-  map_mul' := λ x y, subtype.ext $ f.map_matrix.map_mul x y }
-
-section cast
-
-/-- Coercion of SL `n` `ℤ` to SL `n` `R` for a commutative ring `R`. -/
-instance : has_coe (special_linear_group n ℤ) (special_linear_group n R) :=
-⟨λ x, map (int.cast_ring_hom R) x⟩
-
-@[simp] lemma coe_matrix_coe (g : special_linear_group n ℤ) :
-  ↑(g : special_linear_group n R)
-  = (↑g : matrix n n ℤ).map (int.cast_ring_hom R) :=
-map_apply_coe (int.cast_ring_hom R) g
-
-end cast
-
-section has_neg
-
-variables [fact (even (fintype.card n))]
-
-/-- Formal operation of negation on special linear group on even cardinality `n` given by negating
-each element. -/
-instance : has_neg (special_linear_group n R) :=
-⟨λ g,
-  ⟨- g, by simpa [(fact.out $ even $ fintype.card n).neg_one_pow, g.det_coe] using
-  det_smul ↑ₘg (-1)⟩⟩
-
-@[simp] lemma coe_neg (g : special_linear_group n R) :
-  ↑(- g) = - (↑g : matrix n n R) :=
-rfl
-
-instance : has_distrib_neg (special_linear_group n R) :=
-{ neg := has_neg.neg,
-  neg_neg := λ x, subtype.ext $ neg_neg _,
-  neg_mul := λ x y, subtype.ext $ neg_mul _ _,
-  mul_neg := λ x y, subtype.ext $ mul_neg _ _ }
-
-@[simp] lemma coe_int_neg (g : (special_linear_group n ℤ)) :
-  ↑(-g) = (-↑g : special_linear_group n R) :=
-subtype.ext $ (@ring_hom.map_matrix n _ _ _ _ _ _ (int.cast_ring_hom R)).map_neg ↑g
-
-end has_neg
-
--- this section should be last to ensure we do not use it in lemmas
-section coe_fn_instance
-
-/-- This instance is here for convenience, but is not the simp-normal form. -/
-instance : has_coe_to_fun (special_linear_group n R) (λ _, n → n → R) :=
-{ coe := λ A, A.val }
-
-@[simp]
-lemma coe_fn_eq_coe (s : special_linear_group n R) : ⇑s = ↑ₘs := rfl
-
-end coe_fn_instance
-
-end special_linear_group
-
-end matrix
diff --git a/src/linear_algebra/std_basis.lean b/src/linear_algebra/std_basis.lean
index 152612e47dd6d..56f2224deb91e 100644
--- a/src/linear_algebra/std_basis.lean
+++ b/src/linear_algebra/std_basis.lean
@@ -10,8 +10,11 @@ import linear_algebra.pi
 /-!
 # The standard basis
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the standard basis `pi.basis (s : ∀ j, basis (ι j) R (M j))`,
-which is the `Σ j, ι j`-indexed basis of Π j, M j`. The basis vectors are given by
+which is the `Σ j, ι j`-indexed basis of `Π j, M j`. The basis vectors are given by
 `pi.basis s ⟨j, i⟩ j' = linear_map.std_basis R M j' (s j) i = if j = j' then s i else 0`.
 
 The standard basis on `R^η`, i.e. `η → R` is called `pi.basis_fun`.
@@ -34,7 +37,6 @@ this is a basis over `fin 3 → R`.
 
 open function submodule
 open_locale big_operators
-open_locale big_operators
 
 namespace linear_map
 
@@ -47,14 +49,21 @@ def std_basis : Π (i : ι), φ i →ₗ[R] (Πi, φ i) := single
 lemma std_basis_apply (i : ι) (b : φ i) : std_basis R φ i b = update 0 i b :=
 rfl
 
+@[simp] lemma std_basis_apply' (i i' : ι) : (std_basis R (λ (_x : ι), R) i) 1 i' =
+  ite (i = i') 1 0  :=
+begin
+  rw [linear_map.std_basis_apply, function.update_apply, pi.zero_apply],
+  congr' 1, rw [eq_iff_iff, eq_comm],
+end
+
 lemma coe_std_basis (i : ι) : ⇑(std_basis R φ i) = pi.single i :=
-funext $ std_basis_apply R φ i
+rfl
 
 @[simp] lemma std_basis_same (i : ι) (b : φ i) : std_basis R φ i b i = b :=
-by rw [std_basis_apply, update_same]
+pi.single_eq_same i b
 
 lemma std_basis_ne (i j : ι) (h : j ≠ i) (b : φ i) : std_basis R φ i b j = 0 :=
-by rw [std_basis_apply, update_noteq h]; refl
+pi.single_eq_of_ne h b
 
 lemma std_basis_eq_pi_diag (i : ι) : std_basis R φ i = pi (diag i) :=
 begin
@@ -64,32 +73,30 @@ begin
 end
 
 lemma ker_std_basis (i : ι) : ker (std_basis R φ i) = ⊥ :=
-ker_eq_bot_of_injective $ assume f g hfg,
-  have std_basis R φ i f i = std_basis R φ i g i := hfg ▸ rfl,
-  by simpa only [std_basis_same]
+ker_eq_bot_of_injective $ pi.single_injective _ _
 
 lemma proj_comp_std_basis (i j : ι) : (proj i).comp (std_basis R φ j) = diag j i :=
 by rw [std_basis_eq_pi_diag, proj_pi]
 
 lemma proj_std_basis_same (i : ι) : (proj i).comp (std_basis R φ i) = id :=
-by ext b; simp
+linear_map.ext $ std_basis_same R φ i
 
 lemma proj_std_basis_ne (i j : ι) (h : i ≠ j) : (proj i).comp (std_basis R φ j) = 0 :=
-by ext b; simp [std_basis_ne R φ _ _ h]
+linear_map.ext $ std_basis_ne R φ _ _ h
 
 lemma supr_range_std_basis_le_infi_ker_proj (I J : set ι) (h : disjoint I J) :
-  (⨆i∈I, range (std_basis R φ i)) ≤ (⨅i∈J, ker (proj i)) :=
+  (⨆i∈I, range (std_basis R φ i)) ≤ (⨅i∈J, ker (proj i : (Πi, φ i) →ₗ[R] φ i)) :=
 begin
   refine (supr_le $ λ i, supr_le $ λ hi, range_le_iff_comap.2 _),
   simp only [(ker_comp _ _).symm, eq_top_iff, set_like.le_def, mem_ker, comap_infi, mem_infi],
   rintro b - j hj,
   rw [proj_std_basis_ne R φ j i, zero_apply],
   rintro rfl,
-  exact h ⟨hi, hj⟩
+  exact h.le_bot ⟨hi, hj⟩
 end
 
 lemma infi_ker_proj_le_supr_range_std_basis {I : finset ι} {J : set ι} (hu : set.univ ⊆ ↑I ∪ J) :
-  (⨅ i∈J, ker (proj i)) ≤ (⨆i∈I, range (std_basis R φ i)) :=
+  (⨅ i∈J, ker (proj i : (Πi, φ i) →ₗ[R] φ i)) ≤ (⨆i∈I, range (std_basis R φ i)) :=
 set_like.le_def.2
 begin
   assume b hb,
@@ -101,13 +108,12 @@ begin
     assume hiI,
     rw [std_basis_same],
     exact hb _ ((hu trivial).resolve_left hiI) },
-  exact sum_mem (assume i hiI, mem_supr_of_mem i $ mem_supr_of_mem hiI $
-    (std_basis R φ i).mem_range_self (b i))
+  exact sum_mem_bsupr (λ i hi, mem_range_self (std_basis R φ i) (b i))
 end
 
 lemma supr_range_std_basis_eq_infi_ker_proj {I J : set ι}
   (hd : disjoint I J) (hu : set.univ ⊆ I ∪ J) (hI : set.finite I) :
-  (⨆i∈I, range (std_basis R φ i)) = (⨅i∈J, ker (proj i)) :=
+  (⨆i∈I, range (std_basis R φ i)) = (⨅i∈J, ker (proj i : (Πi, φ i) →ₗ[R] φ i)) :=
 begin
   refine le_antisymm (supr_range_std_basis_le_infi_ker_proj _ _ _ _ hd) _,
   have : set.univ ⊆ ↑hI.to_finset ∪ J, { rwa [hI.coe_to_finset] },
@@ -116,13 +122,12 @@ begin
   exact le_rfl
 end
 
-lemma supr_range_std_basis [fintype ι] : (⨆i:ι, range (std_basis R φ i)) = ⊤ :=
-have (set.univ : set ι) ⊆ ↑(finset.univ : finset ι) ∪ ∅ := by rw [finset.coe_univ, set.union_empty],
+lemma supr_range_std_basis [finite ι] : (⨆ i, range (std_basis R φ i)) = ⊤ :=
 begin
-  apply top_unique,
-  convert (infi_ker_proj_le_supr_range_std_basis R φ this),
-  exact infi_emptyset.symm,
-  exact (funext $ λi, (@supr_pos _ _ _ (λh, range (std_basis R φ i)) $ finset.mem_univ i).symm)
+  casesI nonempty_fintype ι,
+  convert top_unique (infi_emptyset.ge.trans $ infi_ker_proj_le_supr_range_std_basis R φ _),
+  { exact funext (λ i, (@supr_pos _ _ _ (λ h, range $ std_basis R φ i) $ finset.mem_univ i).symm) },
+  { rw [finset.coe_univ, set.union_empty] }
 end
 
 lemma disjoint_std_basis_std_basis (I J : set ι) (h : disjoint I J) :
@@ -131,26 +136,20 @@ begin
   refine disjoint.mono
     (supr_range_std_basis_le_infi_ker_proj _ _ _ _ $ disjoint_compl_right)
     (supr_range_std_basis_le_infi_ker_proj _ _ _ _ $ disjoint_compl_right) _,
-  simp only [disjoint, set_like.le_def, mem_infi, mem_inf, mem_ker, mem_bot, proj_apply,
+  simp only [disjoint_iff_inf_le, set_like.le_def, mem_infi, mem_inf, mem_ker, mem_bot, proj_apply,
     funext_iff],
   rintros b ⟨hI, hJ⟩ i,
   classical,
   by_cases hiI : i ∈ I,
   { by_cases hiJ : i ∈ J,
-    { exact (h ⟨hiI, hiJ⟩).elim },
+    { exact (h.le_bot ⟨hiI, hiJ⟩).elim },
     { exact hJ i hiJ } },
   { exact hI i hiI }
 end
 
 lemma std_basis_eq_single {a : R} :
   (λ (i : ι), (std_basis R (λ _ : ι, R) i) a) = λ (i : ι), (finsupp.single i a) :=
-begin
-  ext i j,
-  rw [std_basis_apply, finsupp.single_apply],
-  split_ifs,
-  { rw [h, function.update_same] },
-  { rw [function.update_noteq (ne.symm h)], refl },
-end
+funext $ λ i, (finsupp.single_eq_pi_single i a).symm
 
 end linear_map
 
@@ -199,7 +198,10 @@ section
 open linear_equiv
 
 /-- `pi.basis (s : ∀ j, basis (ιs j) R (Ms j))` is the `Σ j, ιs j`-indexed basis on `Π j, Ms j`
-given by `s j` on each component. -/
+given by `s j` on each component.
+
+For the standard basis over `R` on the finite-dimensional space `η → R` see `pi.basis_fun`.
+-/
 protected noncomputable def basis (s : ∀ j, basis (ιs j) R (Ms j)) :
   basis (Σ j, ιs j) R (Π j, Ms j) :=
 -- The `add_comm_monoid (Π j, Ms j)` instance was hard to find.
@@ -216,7 +218,7 @@ begin
     simp only [pi.basis, linear_equiv.trans_apply, basis.repr_self, std_basis_same,
         linear_equiv.Pi_congr_right_apply, finsupp.sigma_finsupp_lequiv_pi_finsupp_symm_apply],
     symmetry,
-    exact basis.finsupp.single_apply_left
+    exact finsupp.single_apply_left
       (λ i i' (h : (⟨j, i⟩ : Σ j, ιs j) = ⟨j, i'⟩), eq_of_heq (sigma.mk.inj h).2) _ _ _ },
   simp only [pi.basis, linear_equiv.trans_apply, finsupp.sigma_finsupp_lequiv_pi_finsupp_symm_apply,
       linear_equiv.Pi_congr_right_apply],
@@ -247,13 +249,15 @@ basis.of_equiv_fun (linear_equiv.refl _ _)
 @[simp] lemma basis_fun_apply [decidable_eq η] (i) :
   basis_fun R η i = std_basis R (λ (i : η), R) i 1 :=
 by { simp only [basis_fun, basis.coe_of_equiv_fun, linear_equiv.refl_symm,
-                linear_equiv.refl_apply, std_basis_apply],
-     congr /- Get rid of a `decidable_eq` mismatch. -/ }
+                linear_equiv.refl_apply, std_basis_apply] }
 
 @[simp] lemma basis_fun_repr (x : η → R) (i : η) :
   (pi.basis_fun R η).repr x i = x i :=
 by simp [basis_fun]
 
+@[simp] lemma basis_fun_equiv_fun : (pi.basis_fun R η).equiv_fun = linear_equiv.refl _ _ :=
+basis.equiv_fun_of_equiv_fun _
+
 end
 
 end module
diff --git a/src/linear_algebra/symplectic_group.lean b/src/linear_algebra/symplectic_group.lean
new file mode 100644
index 0000000000000..895a077101aae
--- /dev/null
+++ b/src/linear_algebra/symplectic_group.lean
@@ -0,0 +1,211 @@
+/-
+Copyright (c) 2022 Matej Penciak. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Matej Penciak, Moritz Doll, Fabien Clery
+-/
+
+import linear_algebra.matrix.nonsingular_inverse
+
+/-!
+# The Symplectic Group
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the symplectic group and proves elementary properties.
+
+## Main Definitions
+
+`matrix.J`: the canonical `2n × 2n` skew-symmetric matrix
+`symplectic_group`: the group of symplectic matrices
+
+## TODO
+* Every symplectic matrix has determinant 1.
+* For `n = 1` the symplectic group coincides with the special linear group.
+-/
+
+open_locale matrix
+
+variables {l R : Type*}
+
+namespace matrix
+
+variables (l) [decidable_eq l] (R) [comm_ring R]
+
+section J_matrix_lemmas
+
+/-- The matrix defining the canonical skew-symmetric bilinear form. -/
+def J : matrix (l ⊕ l) (l ⊕ l) R := matrix.from_blocks 0 (-1) 1 0
+
+@[simp] lemma J_transpose : (J l R)ᵀ = - (J l R) :=
+begin
+  rw [J, from_blocks_transpose, ←neg_one_smul R (from_blocks _ _ _ _), from_blocks_smul,
+    matrix.transpose_zero, matrix.transpose_one, transpose_neg],
+  simp [from_blocks],
+end
+
+variables [fintype l]
+
+lemma J_squared : (J l R) ⬝ (J l R) = -1 :=
+begin
+  rw [J, from_blocks_multiply],
+  simp only [matrix.zero_mul, matrix.neg_mul, zero_add, neg_zero, matrix.one_mul, add_zero],
+  rw [← neg_zero, ← matrix.from_blocks_neg, ← from_blocks_one],
+end
+
+lemma J_inv : (J l R)⁻¹ = -(J l R) :=
+begin
+  refine matrix.inv_eq_right_inv _,
+  rw [matrix.mul_neg, J_squared],
+  exact neg_neg 1,
+end
+
+lemma J_det_mul_J_det : (det (J l R)) * (det (J l R)) = 1 :=
+begin
+  rw [←det_mul, J_squared],
+  rw [←one_smul R (-1 : matrix _ _ R)],
+  rw [smul_neg, ←neg_smul, det_smul],
+  simp only [fintype.card_sum, det_one, mul_one],
+  apply even.neg_one_pow,
+  exact even_add_self _
+end
+
+lemma is_unit_det_J : is_unit (det (J l R)) :=
+is_unit_iff_exists_inv.mpr ⟨det (J l R), J_det_mul_J_det _ _⟩
+
+end J_matrix_lemmas
+
+variable [fintype l]
+
+/-- The group of symplectic matrices over a ring `R`. -/
+def symplectic_group : submonoid (matrix (l ⊕ l) (l ⊕ l)  R) :=
+{ carrier := { A | A ⬝ (J l R) ⬝ Aᵀ = J l R},
+  mul_mem' :=
+  begin
+    intros a b ha hb,
+    simp only [mul_eq_mul, set.mem_set_of_eq, transpose_mul] at *,
+    rw [←matrix.mul_assoc, a.mul_assoc, a.mul_assoc, hb],
+    exact ha,
+  end,
+  one_mem' := by simp }
+
+end matrix
+
+namespace symplectic_group
+
+variables {l} {R} [decidable_eq l] [fintype l] [comm_ring R]
+
+open matrix
+
+lemma mem_iff {A : matrix (l ⊕ l) (l ⊕ l)  R} :
+  A ∈ symplectic_group l R ↔ A ⬝ (J l R) ⬝ Aᵀ = J l R :=
+by simp [symplectic_group]
+
+instance coe_matrix : has_coe (symplectic_group l R) (matrix (l ⊕ l) (l ⊕ l)  R)
+:= by apply_instance
+
+section symplectic_J
+
+variables (l) (R)
+
+lemma J_mem : (J l R) ∈ symplectic_group l R :=
+begin
+  rw [mem_iff, J, from_blocks_multiply, from_blocks_transpose, from_blocks_multiply],
+  simp,
+end
+
+/-- The canonical skew-symmetric matrix as an element in the symplectic group. -/
+def sym_J : symplectic_group l R := ⟨J l R, J_mem l R⟩
+
+variables {l} {R}
+
+@[simp] lemma coe_J : ↑(sym_J l R) = J l R := rfl
+
+end symplectic_J
+
+variables {R} {A : matrix (l ⊕ l) (l ⊕ l) R}
+
+lemma neg_mem (h : A ∈ symplectic_group l R) : -A ∈ symplectic_group l R :=
+begin
+  rw mem_iff at h ⊢,
+  simp [h],
+end
+
+lemma symplectic_det (hA : A ∈ symplectic_group l R) : is_unit $ det A :=
+begin
+  rw is_unit_iff_exists_inv,
+  use A.det,
+  refine (is_unit_det_J l R).mul_left_cancel _,
+  rw [mul_one],
+  rw mem_iff at hA,
+  apply_fun det at hA,
+  simp only [det_mul, det_transpose] at hA,
+  rw [mul_comm A.det, mul_assoc] at hA,
+  exact hA,
+end
+
+lemma transpose_mem (hA : A ∈ symplectic_group l R) :
+  Aᵀ ∈ symplectic_group l R :=
+begin
+  rw mem_iff at ⊢ hA,
+  rw transpose_transpose,
+  have huA := symplectic_det hA,
+  have huAT : is_unit (Aᵀ).det :=
+  begin
+    rw matrix.det_transpose,
+    exact huA,
+  end,
+  calc Aᵀ ⬝ J l R ⬝ A
+      = - Aᵀ ⬝ (J l R)⁻¹ ⬝ A  : by {rw J_inv, simp}
+  ... = - Aᵀ ⬝ (A ⬝ J l R ⬝ Aᵀ)⁻¹ ⬝ A : by rw hA
+  ... = - (Aᵀ ⬝ (Aᵀ⁻¹ ⬝ (J l R)⁻¹)) ⬝ A⁻¹ ⬝ A : by simp only [matrix.mul_inv_rev,
+                                                              matrix.mul_assoc, matrix.neg_mul]
+  ... = - (J l R)⁻¹ : by rw [mul_nonsing_inv_cancel_left _ _ huAT,
+                             nonsing_inv_mul_cancel_right _ _ huA]
+  ... = (J l R) : by simp [J_inv]
+end
+
+@[simp] lemma transpose_mem_iff : Aᵀ ∈ symplectic_group l R ↔ A ∈ symplectic_group l R :=
+⟨λ hA, by simpa using transpose_mem hA , transpose_mem⟩
+
+lemma mem_iff' : A ∈ symplectic_group l R ↔ Aᵀ ⬝ (J l R) ⬝ A = J l R :=
+by rw [←transpose_mem_iff, mem_iff, transpose_transpose]
+
+instance : has_inv (symplectic_group l R) :=
+{ inv := λ A, ⟨- (J l R) ⬝ (A : matrix (l ⊕ l) (l ⊕ l) R)ᵀ ⬝ (J l R),
+  mul_mem (mul_mem (neg_mem $ J_mem _ _) $ transpose_mem A.2) $ J_mem _ _⟩ }
+
+lemma coe_inv (A : symplectic_group l R) :
+  (↑(A⁻¹) : matrix _ _ _) = - J l R ⬝ (↑A)ᵀ ⬝ J l R := rfl
+
+lemma inv_left_mul_aux (hA : A ∈ symplectic_group l R) :
+  -(J l R ⬝ Aᵀ ⬝ J l R ⬝ A) = 1 :=
+calc -(J l R ⬝ Aᵀ ⬝ J l R ⬝ A)
+    = - J l R ⬝ (Aᵀ ⬝ J l R ⬝ A) : by simp only [matrix.mul_assoc, matrix.neg_mul]
+... = - J l R ⬝ J l R : by {rw mem_iff' at hA, rw hA}
+... = (-1 : R) • (J l R ⬝ J l R) : by simp only [matrix.neg_mul, neg_smul, one_smul]
+... = (-1 : R) • -1 : by rw J_squared
+... = 1 : by simp only [neg_smul_neg, one_smul]
+
+lemma coe_inv' (A : symplectic_group l R) : (↑(A⁻¹) : matrix (l ⊕ l) (l ⊕ l) R) = A⁻¹ :=
+begin
+  refine (coe_inv A).trans (inv_eq_left_inv _).symm,
+  simp [inv_left_mul_aux, coe_inv],
+end
+
+lemma inv_eq_symplectic_inv (A : matrix (l ⊕ l) (l ⊕ l) R) (hA : A ∈ symplectic_group l R) :
+  A⁻¹ = - (J l R) ⬝ Aᵀ ⬝ (J l R) :=
+inv_eq_left_inv (by simp only [matrix.neg_mul, inv_left_mul_aux hA])
+
+instance : group (symplectic_group l R) :=
+{ mul_left_inv := λ A,
+  begin
+    apply subtype.ext,
+    simp only [submonoid.coe_one, submonoid.coe_mul, matrix.neg_mul, coe_inv],
+    rw [matrix.mul_eq_mul, matrix.neg_mul],
+    exact inv_left_mul_aux A.2,
+  end,
+  .. symplectic_group.has_inv,
+  .. submonoid.to_monoid _ }
+
+end symplectic_group
diff --git a/src/linear_algebra/tensor_algebra/basic.lean b/src/linear_algebra/tensor_algebra/basic.lean
index 4df29b1a02748..099b0a0344048 100644
--- a/src/linear_algebra/tensor_algebra/basic.lean
+++ b/src/linear_algebra/tensor_algebra/basic.lean
@@ -7,10 +7,14 @@ import algebra.free_algebra
 import algebra.ring_quot
 import algebra.triv_sq_zero_ext
 import algebra.algebra.operations
+import linear_algebra.multilinear.basic
 
 /-!
 # Tensor Algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a commutative semiring `R`, and an `R`-module `M`, we construct the tensor algebra of `M`.
 This is the free `R`-algebra generated (`R`-linearly) by the module `M`.
 
@@ -69,45 +73,56 @@ variables {M}
 /--
 The canonical linear map `M →ₗ[R] tensor_algebra R M`.
 -/
-def ι : M →ₗ[R] (tensor_algebra R M) :=
+@[irreducible] def ι : M →ₗ[R] (tensor_algebra R M) :=
 { to_fun := λ m, (ring_quot.mk_alg_hom R _ (free_algebra.ι R m)),
   map_add' := λ x y, by { rw [←alg_hom.map_add], exact ring_quot.mk_alg_hom_rel R rel.add, },
   map_smul' := λ r x, by { rw [←alg_hom.map_smul], exact ring_quot.mk_alg_hom_rel R rel.smul, } }
 
 lemma ring_quot_mk_alg_hom_free_algebra_ι_eq_ι (m : M) :
-  ring_quot.mk_alg_hom R (rel R M) (free_algebra.ι R m) = ι R m := rfl
+  ring_quot.mk_alg_hom R (rel R M) (free_algebra.ι R m) = ι R m :=
+by { rw [ι], refl }
 
 /--
 Given a linear map `f : M → A` where `A` is an `R`-algebra, `lift R f` is the unique lift
 of `f` to a morphism of `R`-algebras `tensor_algebra R M → A`.
 -/
-@[simps symm_apply]
+@[irreducible, simps symm_apply]
 def lift {A : Type*} [semiring A] [algebra R A] : (M →ₗ[R] A) ≃ (tensor_algebra R M →ₐ[R] A) :=
 { to_fun := ring_quot.lift_alg_hom R ∘ λ f,
-    ⟨free_algebra.lift R ⇑f, λ x y (h : rel R M x y), by induction h; simp [algebra.smul_def]⟩,
+    ⟨free_algebra.lift R ⇑f, λ x y (h : rel R M x y), by induction h;
+        simp only [algebra.smul_def, free_algebra.lift_ι_apply, linear_map.map_smulₛₗ,
+          ring_hom.id_apply, map_mul, alg_hom.commutes, map_add]⟩,
   inv_fun := λ F, F.to_linear_map.comp (ι R),
-  left_inv := λ f, by { ext, simp [ι], },
-  right_inv := λ F, by { ext, simp [ι], } }
+  left_inv := λ f, begin
+    rw [ι],
+    ext1 x,
+    exact (ring_quot.lift_alg_hom_mk_alg_hom_apply _ _ _ _).trans (free_algebra.lift_ι_apply f x),
+  end,
+  right_inv := λ F, ring_quot.ring_quot_ext' _ _ _ $ free_algebra.hom_ext $ funext $ λ x, begin
+    rw [ι],
+    exact (ring_quot.lift_alg_hom_mk_alg_hom_apply _ _ _ _).trans (free_algebra.lift_ι_apply _ _)
+  end }
 
 variables {R}
 
 @[simp]
 theorem ι_comp_lift {A : Type*} [semiring A] [algebra R A] (f : M →ₗ[R] A) :
-  (lift R f).to_linear_map.comp (ι R) = f := (lift R).symm_apply_apply f
+  (lift R f).to_linear_map.comp (ι R) = f :=
+by { convert (lift R).symm_apply_apply f, simp only [lift, equiv.coe_fn_symm_mk] }
 
 @[simp]
 theorem lift_ι_apply {A : Type*} [semiring A] [algebra R A] (f : M →ₗ[R] A) (x) :
-  lift R f (ι R x) = f x := by { dsimp [lift, ι], refl, }
+  lift R f (ι R x) = f x :=
+by { conv_rhs { rw ← ι_comp_lift f}, refl }
 
 @[simp]
 theorem lift_unique {A : Type*} [semiring A] [algebra R A] (f : M →ₗ[R] A)
   (g : tensor_algebra R M →ₐ[R] A) : g.to_linear_map.comp (ι R) = f ↔ g = lift R f :=
-(lift R).symm_apply_eq
+by { rw ← (lift R).symm_apply_eq, simp only [lift, equiv.coe_fn_symm_mk] }
 
 -- Marking `tensor_algebra` irreducible makes `ring` instances inaccessible on quotients.
 -- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/algebra.2Esemiring_to_ring.20breaks.20semimodule.20typeclass.20lookup/near/212580241
 -- For now, we avoid this by not marking it irreducible.
-attribute [irreducible] ι lift
 
 @[simp]
 theorem lift_comp_ι {A : Type*} [semiring A] [algebra R A] (g : tensor_algebra R M →ₐ[R] A) :
@@ -176,10 +191,11 @@ variables {M}
 
 /-- The canonical map from `tensor_algebra R M` into `triv_sq_zero_ext R M` that sends
 `tensor_algebra.ι` to `triv_sq_zero_ext.inr`. -/
-def to_triv_sq_zero_ext : tensor_algebra R M →ₐ[R] triv_sq_zero_ext R M :=
+def to_triv_sq_zero_ext [module Rᵐᵒᵖ M] [is_central_scalar R M] :
+  tensor_algebra R M →ₐ[R] triv_sq_zero_ext R M :=
 lift R (triv_sq_zero_ext.inr_hom R M)
 
-@[simp] lemma to_triv_sq_zero_ext_ι (x : M) :
+@[simp] lemma to_triv_sq_zero_ext_ι (x : M) [module Rᵐᵒᵖ M] [is_central_scalar R M] :
    to_triv_sq_zero_ext (ι R x) = triv_sq_zero_ext.inr x :=
 lift_ι_apply _ _
 
@@ -188,7 +204,11 @@ lift_ι_apply _ _
 As an implementation detail, we implement this using `triv_sq_zero_ext` which has a suitable
 algebra structure. -/
 def ι_inv : tensor_algebra R M →ₗ[R] M :=
-(triv_sq_zero_ext.snd_hom R M).comp to_triv_sq_zero_ext.to_linear_map
+begin
+  letI : module Rᵐᵒᵖ M := module.comp_hom _ ((ring_hom.id R).from_opposite mul_comm),
+  haveI : is_central_scalar R M := ⟨λ r m, rfl⟩,
+  exact (triv_sq_zero_ext.snd_hom R M).comp to_triv_sq_zero_ext.to_linear_map
+end
 
 lemma ι_left_inverse : function.left_inverse ι_inv (ι R : M → tensor_algebra R M) :=
 λ x, by simp [ι_inv]
@@ -206,7 +226,9 @@ variables {R}
 @[simp] lemma ι_eq_algebra_map_iff (x : M) (r : R) : ι R x = algebra_map R _ r ↔ x = 0 ∧ r = 0 :=
 begin
   refine ⟨λ h, _, _⟩,
-  { have hf0 : to_triv_sq_zero_ext (ι R x) = (0, x), from lift_ι_apply _ _,
+  { letI : module Rᵐᵒᵖ M := module.comp_hom _ ((ring_hom.id R).from_opposite mul_comm),
+    haveI : is_central_scalar R M := ⟨λ r m, rfl⟩,
+    have hf0 : to_triv_sq_zero_ext (ι R x) = (0, x), from lift_ι_apply _ _,
     rw [h, alg_hom.commutes] at hf0,
     have : r = 0 ∧ 0 = x := prod.ext_iff.1 hf0,
     exact this.symm.imp_left eq.symm, },
@@ -221,7 +243,8 @@ begin
 end
 
 /-- The generators of the tensor algebra are disjoint from its scalars. -/
-lemma ι_range_disjoint_one : disjoint (ι R).range (1 : submodule R (tensor_algebra R M)) :=
+lemma ι_range_disjoint_one : disjoint (linear_map.range (ι R : M →ₗ[R] tensor_algebra R M))
+  (1 : submodule R (tensor_algebra R M)) :=
 begin
   rw submodule.disjoint_def,
   rintros _ ⟨x, hx⟩ ⟨r, (rfl : algebra_map _ _ _ = _)⟩,
@@ -229,6 +252,19 @@ begin
   rw [hx.2, ring_hom.map_zero]
 end
 
+variables (R M)
+
+/-- Construct a product of `n` elements of the module within the tensor algebra.
+
+See also `pi_tensor_product.tprod`. -/
+def tprod (n : ℕ) : multilinear_map R (λ i : fin n, M) (tensor_algebra R M) :=
+(multilinear_map.mk_pi_algebra_fin R n (tensor_algebra R M)).comp_linear_map $ λ _, ι R
+
+@[simp] lemma tprod_apply {n : ℕ} (x : fin n → M) :
+  tprod R M n x = (list.of_fn (λ i, ι R (x i))).prod := rfl
+
+variables {R M}
+
 end tensor_algebra
 
 namespace free_algebra
diff --git a/src/linear_algebra/tensor_algebra/grading.lean b/src/linear_algebra/tensor_algebra/grading.lean
index 9d8a8252284eb..9452c252cb44c 100644
--- a/src/linear_algebra/tensor_algebra/grading.lean
+++ b/src/linear_algebra/tensor_algebra/grading.lean
@@ -9,6 +9,9 @@ import ring_theory.graded_algebra.basic
 /-!
 # Results about the grading structure of the tensor algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The main result is `tensor_algebra.graded_algebra`, which says that the tensor algebra is a
 ℕ-graded algebra.
 -/
@@ -37,22 +40,22 @@ variables {R M}
 instance graded_algebra :
   graded_algebra ((^) (ι R : M →ₗ[R] tensor_algebra R M).range : ℕ → submodule R _) :=
 graded_algebra.of_alg_hom _
-  (lift _ $ graded_algebra.ι R M)
+  (lift R $ graded_algebra.ι R M)
   (begin
     ext m,
     dsimp only [linear_map.comp_apply, alg_hom.to_linear_map_apply, alg_hom.comp_apply,
       alg_hom.id_apply],
-    rw [lift_ι_apply, graded_algebra.ι_apply, direct_sum.submodule_coe_alg_hom_of, subtype.coe_mk],
+    rw [lift_ι_apply, graded_algebra.ι_apply R M, direct_sum.coe_alg_hom_of, subtype.coe_mk],
   end)
   (λ i x, begin
     cases x with x hx,
     dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
-    refine submodule.pow_induction_on' _
+    refine submodule.pow_induction_on_left' _
       (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
     { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
     { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
     { obtain ⟨_, rfl⟩ := hm,
-      rw [alg_hom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply, direct_sum.of_mul_of],
+      rw [alg_hom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply R M, direct_sum.of_mul_of],
       exact direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext (add_comm _ _) rfl) }
   end)
 
diff --git a/src/linear_algebra/tensor_algebra/to_tensor_power.lean b/src/linear_algebra/tensor_algebra/to_tensor_power.lean
new file mode 100644
index 0000000000000..d79a8e426472b
--- /dev/null
+++ b/src/linear_algebra/tensor_algebra/to_tensor_power.lean
@@ -0,0 +1,166 @@
+/-
+Copyright (c) 2021 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import linear_algebra.tensor_algebra.basic
+import linear_algebra.tensor_power
+/-!
+# Tensor algebras as direct sums of tensor powers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we show that `tensor_algebra R M` is isomorphic to a direct sum of tensor powers, as
+`tensor_algebra.equiv_direct_sum`.
+-/
+open_locale direct_sum tensor_product
+
+variables {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]
+
+namespace tensor_power
+
+/-- The canonical embedding from a tensor power to the tensor algebra -/
+def to_tensor_algebra {n} : ⨂[R]^n M →ₗ[R] tensor_algebra R M :=
+pi_tensor_product.lift (tensor_algebra.tprod R M n)
+
+@[simp]
+lemma to_tensor_algebra_tprod {n} (x : fin n → M) :
+  tensor_power.to_tensor_algebra (pi_tensor_product.tprod R x) = tensor_algebra.tprod R M n x :=
+pi_tensor_product.lift.tprod _
+
+@[simp]
+lemma to_tensor_algebra_ghas_one :
+  (@graded_monoid.ghas_one.one _ (λ n, ⨂[R]^n M) _ _).to_tensor_algebra = 1 :=
+tensor_power.to_tensor_algebra_tprod _
+
+@[simp]
+lemma to_tensor_algebra_ghas_mul {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) :
+  (@graded_monoid.ghas_mul.mul _ (λ n, ⨂[R]^n M) _ _ _ _ a b).to_tensor_algebra
+    = a.to_tensor_algebra * b.to_tensor_algebra :=
+begin
+  -- change `a` and `b` to `tprod R a` and `tprod R b`
+  rw [tensor_power.ghas_mul_eq_coe_linear_map, ←linear_map.compr₂_apply,
+    ←@linear_map.mul_apply' R, ←linear_map.compl₂_apply, ←linear_map.comp_apply],
+  refine linear_map.congr_fun (linear_map.congr_fun _ a) b,
+  clear a b,
+  ext a b,
+  simp only [linear_map.compr₂_apply, linear_map.mul_apply',
+    linear_map.compl₂_apply, linear_map.comp_apply, linear_map.comp_multilinear_map_apply,
+    pi_tensor_product.lift.tprod, tensor_power.tprod_mul_tprod,
+    tensor_power.to_tensor_algebra_tprod, tensor_algebra.tprod_apply, ←ghas_mul_eq_coe_linear_map],
+  refine eq.trans _ list.prod_append,
+  congr',
+  rw [←list.map_of_fn _ (tensor_algebra.ι R), ←list.map_of_fn _ (tensor_algebra.ι R),
+    ←list.map_of_fn _ (tensor_algebra.ι R), ←list.map_append, list.of_fn_fin_append],
+end
+
+@[simp]
+lemma to_tensor_algebra_galgebra_to_fun (r : R) :
+  (@direct_sum.galgebra.to_fun _ R (λ n, ⨂[R]^n M) _ _ _ _ _ _ _ r).to_tensor_algebra
+    = algebra_map _ _ r :=
+by rw [tensor_power.galgebra_to_fun_def, tensor_power.algebra_map₀_eq_smul_one, linear_map.map_smul,
+    tensor_power.to_tensor_algebra_ghas_one, algebra.algebra_map_eq_smul_one]
+
+end tensor_power
+
+namespace tensor_algebra
+
+/-- The canonical map from a direct sum of tensor powers to the tensor algebra. -/
+def of_direct_sum : (⨁ n, ⨂[R]^n M) →ₐ[R] tensor_algebra R M :=
+direct_sum.to_algebra _ _ (λ n, tensor_power.to_tensor_algebra)
+  tensor_power.to_tensor_algebra_ghas_one
+  (λ i j, tensor_power.to_tensor_algebra_ghas_mul)
+  (tensor_power.to_tensor_algebra_galgebra_to_fun)
+
+@[simp] lemma of_direct_sum_of_tprod {n} (x : fin n → M) :
+  of_direct_sum (direct_sum.of _ n (pi_tensor_product.tprod R x)) = tprod R M n x :=
+(direct_sum.to_add_monoid_of _ _ _).trans (tensor_power.to_tensor_algebra_tprod _)
+
+/-- The canonical map from the tensor algebra to a direct sum of tensor powers. -/
+def to_direct_sum : tensor_algebra R M →ₐ[R] ⨁ n, ⨂[R]^n M :=
+tensor_algebra.lift R $
+  direct_sum.lof R ℕ (λ n, ⨂[R]^n M) _ ∘ₗ
+    (linear_equiv.symm $ pi_tensor_product.subsingleton_equiv (0 : fin 1) : M ≃ₗ[R] _).to_linear_map
+
+@[simp] lemma to_direct_sum_ι (x : M) :
+  to_direct_sum (ι R x) =
+    direct_sum.of (λ n, ⨂[R]^n M) _ (pi_tensor_product.tprod R (λ _ : fin 1, x)) :=
+tensor_algebra.lift_ι_apply _ _
+
+lemma of_direct_sum_comp_to_direct_sum :
+  of_direct_sum.comp to_direct_sum = alg_hom.id R (tensor_algebra R M) :=
+begin
+  ext,
+  simp [direct_sum.lof_eq_of, tprod_apply],
+end
+
+@[simp] lemma of_direct_sum_to_direct_sum (x : tensor_algebra R M) :
+  of_direct_sum x.to_direct_sum = x :=
+alg_hom.congr_fun of_direct_sum_comp_to_direct_sum x
+
+@[simp] lemma mk_reindex_cast {n m : ℕ} (h : n = m) (x : ⨂[R]^n M) :
+  graded_monoid.mk m (pi_tensor_product.reindex R M (equiv.cast $ congr_arg fin h) x) =
+    graded_monoid.mk n x :=
+eq.symm (pi_tensor_product.graded_monoid_eq_of_reindex_cast h rfl)
+
+@[simp] lemma mk_reindex_fin_cast {n m : ℕ} (h : n = m) (x : ⨂[R]^n M) :
+  graded_monoid.mk m (pi_tensor_product.reindex R M (fin.cast h).to_equiv x) =
+    graded_monoid.mk n x :=
+by rw [fin.cast_to_equiv, mk_reindex_cast h]
+
+/-- The product of tensor products made of a single vector is the same as a single product of
+all the vectors. -/
+lemma _root_.tensor_power.list_prod_graded_monoid_mk_single (n : ℕ) (x : fin n → M) :
+  ((list.fin_range n).map
+    (λ a, (graded_monoid.mk _ (pi_tensor_product.tprod R (λ i : fin 1, x a))
+      : graded_monoid (λ n, ⨂[R]^n M)))).prod =
+  graded_monoid.mk n (pi_tensor_product.tprod R x) :=
+begin
+  refine fin.cons_induction _ _ x; clear x,
+  { rw [list.fin_range_zero, list.map_nil, list.prod_nil],
+    refl, },
+  { intros n x₀ x ih,
+    rw [list.fin_range_succ_eq_map, list.map_cons, list.prod_cons, list.map_map, function.comp],
+    simp_rw [fin.cons_zero, fin.cons_succ],
+    rw [ih, graded_monoid.mk_mul_mk, tensor_power.tprod_mul_tprod],
+    refine tensor_power.graded_monoid_eq_of_cast (add_comm _ _) _,
+    dsimp only [graded_monoid.mk],
+    rw [tensor_power.cast_tprod],
+    simp_rw [fin.append_left_eq_cons, function.comp],
+    congr' 1 with i,
+    congr' 1,
+    rw [fin.cast_trans, fin.cast_refl, order_iso.refl_apply] },
+end
+
+lemma to_direct_sum_tensor_power_tprod {n} (x : fin n → M) :
+  to_direct_sum (tprod R M n x) = direct_sum.of _ n (pi_tensor_product.tprod R x) :=
+begin
+  rw [tprod_apply, alg_hom.map_list_prod, list.map_of_fn, function.comp],
+  simp_rw to_direct_sum_ι,
+  dsimp only,
+  rw direct_sum.list_prod_of_fn_of_eq_dprod,
+  apply direct_sum.of_eq_of_graded_monoid_eq,
+  rw graded_monoid.mk_list_dprod,
+  rw tensor_power.list_prod_graded_monoid_mk_single,
+end
+
+lemma to_direct_sum_comp_of_direct_sum :
+  to_direct_sum.comp of_direct_sum = alg_hom.id R (⨁ n, ⨂[R]^n M) :=
+begin
+  ext,
+  simp [direct_sum.lof_eq_of, -tprod_apply, to_direct_sum_tensor_power_tprod],
+end
+
+@[simp] lemma to_direct_sum_of_direct_sum (x : ⨁ n, ⨂[R]^n M) :
+  (of_direct_sum x).to_direct_sum = x :=
+alg_hom.congr_fun to_direct_sum_comp_of_direct_sum x
+
+/-- The tensor algebra is isomorphic to a direct sum of tensor powers. -/
+@[simps]
+def equiv_direct_sum : tensor_algebra R M ≃ₐ[R] ⨁ n, ⨂[R]^n M :=
+alg_equiv.of_alg_hom to_direct_sum of_direct_sum
+  to_direct_sum_comp_of_direct_sum
+  of_direct_sum_comp_to_direct_sum
+
+end tensor_algebra
diff --git a/src/linear_algebra/tensor_power.lean b/src/linear_algebra/tensor_power.lean
new file mode 100644
index 0000000000000..94287845afd8e
--- /dev/null
+++ b/src/linear_algebra/tensor_power.lean
@@ -0,0 +1,280 @@
+/-
+Copyright (c) 2021 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import linear_algebra.pi_tensor_product
+import logic.equiv.fin
+import algebra.direct_sum.algebra
+
+/-!
+# Tensor power of a semimodule over a commutative semirings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the `n`th tensor power of `M` as the n-ary tensor product indexed by `fin n` of `M`,
+`⨂[R] (i : fin n), M`. This is a special case of `pi_tensor_product`.
+
+This file introduces the notation `⨂[R]^n M` for `tensor_power R n M`, which in turn is an
+abbreviation for `⨂[R] i : fin n, M`.
+
+## Main definitions:
+
+* `tensor_power.gsemiring`: the tensor powers form a graded semiring.
+* `tensor_power.galgebra`: the tensor powers form a graded algebra.
+
+## Implementation notes
+
+In this file we use `ₜ1` and `ₜ*` as local notation for the graded multiplicative structure on
+tensor powers. Elsewhere, using `1` and `*` on `graded_monoid` should be preferred.
+-/
+
+open_locale tensor_product
+
+/-- Homogenous tensor powers $M^{\otimes n}$. `⨂[R]^n M` is a shorthand for
+`⨂[R] (i : fin n), M`. -/
+@[reducible] protected def tensor_power (R : Type*) (n : ℕ) (M : Type*)
+  [comm_semiring R] [add_comm_monoid M] [module R M] : Type* :=
+⨂[R] i : fin n, M
+
+variables {R : Type*} {M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]
+
+localized "notation (name := tensor_power)
+  `⨂[`:100 R `]^`:80 n:max := tensor_power R n" in tensor_product
+
+namespace pi_tensor_product
+
+/-- Two dependent pairs of tensor products are equal if their index is equal and the contents
+are equal after a canonical reindexing. -/
+@[ext]
+lemma graded_monoid_eq_of_reindex_cast {ιι : Type*} {ι : ιι → Type*} :
+  ∀ {a b : graded_monoid (λ ii, ⨂[R] i : ι ii, M)} (h : a.fst = b.fst),
+    reindex R M (equiv.cast $ congr_arg ι h) a.snd = b.snd → a = b
+| ⟨ai, a⟩ ⟨bi, b⟩ := λ (hi : ai = bi) (h : reindex R M _ a = b),
+begin
+  subst hi,
+  simpa using h,
+end
+
+end pi_tensor_product
+
+namespace tensor_power
+open_locale tensor_product direct_sum
+open pi_tensor_product
+
+/-- As a graded monoid, `⨂[R]^i M` has a `1 : ⨂[R]^0 M`. -/
+instance ghas_one : graded_monoid.ghas_one (λ i, ⨂[R]^i M) :=
+{ one := tprod R $ @fin.elim0' M }
+
+local notation `ₜ1` := @graded_monoid.ghas_one.one ℕ (λ i, ⨂[R]^i M) _ _
+
+lemma ghas_one_def : ₜ1 = tprod R (@fin.elim0' M) := rfl
+
+/-- A variant of `pi_tensor_prod.tmul_equiv` with the result indexed by `fin (n + m)`. -/
+def mul_equiv {n m : ℕ} : (⨂[R]^n M) ⊗[R] (⨂[R]^m M) ≃ₗ[R] ⨂[R]^(n + m) M :=
+(tmul_equiv R M).trans (reindex R M fin_sum_fin_equiv)
+
+/-- As a graded monoid, `⨂[R]^i M` has a `(*) : ⨂[R]^i M → ⨂[R]^j M → ⨂[R]^(i + j) M`. -/
+instance ghas_mul : graded_monoid.ghas_mul (λ i, ⨂[R]^i M) :=
+{ mul := λ i j a b, (tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(i + j) M) a b}
+
+local infix ` ₜ* `:70 := @graded_monoid.ghas_mul.mul ℕ (λ i, ⨂[R]^i M) _ _ _ _
+
+lemma ghas_mul_def {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) : a ₜ* b = mul_equiv (a ⊗ₜ b) := rfl
+
+lemma ghas_mul_eq_coe_linear_map {i j} (a : ⨂[R]^i M) (b : ⨂[R]^j M) :
+  a ₜ* b =
+    ((tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(i + j) M)
+      : ⨂[R]^i M →ₗ[R] ⨂[R]^j M →ₗ[R] ⨂[R]^(i + j) M) a b := rfl
+
+variables (R M)
+
+/-- Cast between "equal" tensor powers. -/
+def cast {i j} (h : i = j) : ⨂[R]^i M ≃ₗ[R] (⨂[R]^j M) :=
+reindex R M (fin.cast h).to_equiv
+
+lemma cast_tprod {i j} (h : i = j) (a : fin i → M) :
+  cast R M h (tprod R a) = tprod R (a ∘ fin.cast h.symm) :=
+reindex_tprod _ _
+
+@[simp] lemma cast_refl {i} (h : i = i) : cast R M h = linear_equiv.refl _ _ :=
+(congr_arg (λ f, reindex R M (rel_iso.to_equiv f)) $ fin.cast_refl h).trans reindex_refl
+
+@[simp] lemma cast_symm {i j} (h : i = j) : (cast R M h).symm = cast R M h.symm := reindex_symm _
+
+@[simp] lemma cast_trans {i j k} (h : i = j) (h' : j = k) :
+  (cast R M h).trans (cast R M h') = cast R M (h.trans h') := reindex_trans _ _
+
+variables {R M}
+
+@[simp] lemma cast_cast {i j k} (h : i = j) (h' : j = k) (a : ⨂[R]^i M) :
+  cast R M h' (cast R M h a) = cast R M (h.trans h') a := reindex_reindex _ _ _
+
+@[ext]
+lemma graded_monoid_eq_of_cast {a b : graded_monoid (λ n, ⨂[R] i : fin n, M)}
+  (h : a.fst = b.fst) (h2 : cast R M h a.snd = b.snd) : a = b :=
+begin
+  refine graded_monoid_eq_of_reindex_cast h _,
+  rw cast at h2,
+  rw [←fin.cast_to_equiv, ← h2],
+end
+
+-- named to match `fin.cast_eq_cast`
+lemma cast_eq_cast {i j} (h : i = j) : ⇑(cast R M h) = _root_.cast (congr_arg _ h) :=
+begin
+  subst h,
+  rw [cast_refl],
+  refl,
+end
+
+variables (R)
+include R
+lemma tprod_mul_tprod {na nb} (a : fin na → M) (b : fin nb → M) :
+  tprod R a ₜ* tprod R b = tprod R (fin.append a b) :=
+begin
+  dsimp [ghas_mul_def, mul_equiv],
+  rw [tmul_equiv_apply R M a b],
+  refine (reindex_tprod _ _).trans _,
+  congr' 1,
+  dsimp only [fin.append, fin_sum_fin_equiv, equiv.coe_fn_symm_mk],
+  apply funext,
+  apply fin.add_cases; simp,
+end
+omit R
+variables {R}
+
+lemma one_mul {n} (a : ⨂[R]^n M) :
+  cast R M (zero_add n) (ₜ1 ₜ* a) = a :=
+begin
+  rw [ghas_mul_def, ghas_one_def],
+  induction a using pi_tensor_product.induction_on with r a x y hx hy,
+  { dsimp only at a,
+    rw [tensor_product.tmul_smul, linear_equiv.map_smul, linear_equiv.map_smul, ←ghas_mul_def,
+      tprod_mul_tprod, cast_tprod],
+    congr' 2 with i,
+    rw fin.elim0'_append,
+    refine congr_arg a (fin.ext _),
+    simp },
+  { rw [tensor_product.tmul_add, map_add, map_add, hx, hy], },
+end
+
+lemma mul_one {n} (a : ⨂[R]^n M) : cast R M (add_zero _) (a ₜ* ₜ1) = a :=
+begin
+  rw [ghas_mul_def, ghas_one_def],
+  induction a using pi_tensor_product.induction_on with r a x y hx hy,
+  { dsimp only at a,
+    rw [←tensor_product.smul_tmul', linear_equiv.map_smul, linear_equiv.map_smul, ←ghas_mul_def,
+      tprod_mul_tprod R a _, cast_tprod],
+    congr' 2 with i,
+    rw fin.append_elim0',
+    refine congr_arg a (fin.ext _),
+    simp },
+  { rw [tensor_product.add_tmul, map_add, map_add, hx, hy], },
+end
+
+lemma mul_assoc {na nb nc} (a : ⨂[R]^na M) (b : ⨂[R]^nb M) (c : ⨂[R]^nc M) :
+  cast R M (add_assoc _ _ _) ((a ₜ* b) ₜ* c) = a ₜ* (b  ₜ* c) :=
+begin
+  let mul : Π (n m : ℕ), (⨂[R]^n M) →ₗ[R] (⨂[R]^m M) →ₗ[R] ⨂[R]^(n + m) M :=
+    (λ n m, (tensor_product.mk R _ _).compr₂ ↑(mul_equiv : _ ≃ₗ[R] ⨂[R]^(n + m) M)),
+  -- replace `a`, `b`, `c` with `tprod R a`, `tprod R b`, `tprod R c`
+  let e : ⨂[R]^(na + nb + nc) M ≃ₗ[R] ⨂[R]^(na + (nb + nc)) M := cast R M (add_assoc _ _ _),
+  let lhs : (⨂[R]^na M) →ₗ[R] (⨂[R]^nb M) →ₗ[R] (⨂[R]^nc M) →ₗ[R] (⨂[R]^(na + (nb + nc)) M) :=
+    (linear_map.llcomp R _ _ _ ((mul _ nc).compr₂ e.to_linear_map)).comp
+      (mul na nb),
+  have lhs_eq : ∀ a b c, lhs a b c = e ((a ₜ* b) ₜ* c) := λ _ _ _, rfl,
+  let rhs : (⨂[R]^na M) →ₗ[R] (⨂[R]^nb M) →ₗ[R] (⨂[R]^nc M) →ₗ[R] (⨂[R]^(na + (nb + nc)) M) :=
+    (linear_map.llcomp R _ _ _ (linear_map.lflip R _ _ _) $
+      (linear_map.llcomp R _ _ _ (mul na _).flip).comp (mul nb nc)).flip,
+  have rhs_eq : ∀ a b c, rhs a b c = (a ₜ* (b ₜ* c)) := λ _ _ _, rfl,
+  suffices : lhs = rhs,
+  from linear_map.congr_fun (linear_map.congr_fun (linear_map.congr_fun this a) b) c,
+  ext a b c,
+  -- clean up
+  simp only [linear_map.comp_multilinear_map_apply, lhs_eq, rhs_eq, tprod_mul_tprod, e,
+    cast_tprod],
+  congr' with j,
+  rw fin.append_assoc,
+  refine congr_arg (fin.append a (fin.append b c)) (fin.ext _),
+  rw [fin.coe_cast, fin.coe_cast],
+end
+
+-- for now we just use the default for the `gnpow` field as it's easier.
+instance gmonoid : graded_monoid.gmonoid (λ i, ⨂[R]^i M) :=
+{ one_mul := λ a, graded_monoid_eq_of_cast (zero_add _) (one_mul _),
+  mul_one := λ a, graded_monoid_eq_of_cast (add_zero _) (mul_one _),
+  mul_assoc := λ a b c, graded_monoid_eq_of_cast (add_assoc _ _ _) (mul_assoc _ _ _),
+  ..tensor_power.ghas_mul,
+  ..tensor_power.ghas_one, }
+
+/-- The canonical map from `R` to `⨂[R]^0 M` corresponding to the algebra_map of the tensor
+algebra. -/
+def algebra_map₀ : R ≃ₗ[R] ⨂[R]^0 M :=
+linear_equiv.symm $ is_empty_equiv (fin 0)
+
+lemma algebra_map₀_eq_smul_one (r : R) :
+  (algebra_map₀ r : ⨂[R]^0 M) = r • ₜ1 :=
+by { simp [algebra_map₀], congr }
+
+lemma algebra_map₀_one : (algebra_map₀ 1 : ⨂[R]^0 M) = ₜ1 :=
+(algebra_map₀_eq_smul_one 1).trans (one_smul _ _)
+
+lemma algebra_map₀_mul {n} (r : R) (a : ⨂[R]^n M) :
+  cast R M (zero_add _) (algebra_map₀ r ₜ* a) = r • a :=
+by rw [ghas_mul_eq_coe_linear_map, algebra_map₀_eq_smul_one, linear_map.map_smul₂,
+  linear_equiv.map_smul,  ←ghas_mul_eq_coe_linear_map, one_mul]
+
+lemma mul_algebra_map₀ {n} (r : R) (a : ⨂[R]^n M) :
+  cast R M (add_zero _) (a ₜ* algebra_map₀ r) = r • a :=
+by rw [ghas_mul_eq_coe_linear_map, algebra_map₀_eq_smul_one, linear_map.map_smul,
+  linear_equiv.map_smul, ←ghas_mul_eq_coe_linear_map, mul_one]
+
+lemma algebra_map₀_mul_algebra_map₀ (r s : R) :
+  cast R M (add_zero _) (algebra_map₀ r ₜ* algebra_map₀ s) = algebra_map₀ (r * s) :=
+begin
+  rw [←smul_eq_mul, linear_equiv.map_smul],
+  exact algebra_map₀_mul r (@algebra_map₀ R M _ _ _ s),
+end
+
+instance gsemiring : direct_sum.gsemiring (λ i, ⨂[R]^i M) :=
+{ mul_zero := λ i j a, linear_map.map_zero _,
+  zero_mul := λ i j b, linear_map.map_zero₂ _ _,
+  mul_add := λ i j a b₁ b₂, linear_map.map_add _ _ _,
+  add_mul := λ i j a₁ a₂ b, linear_map.map_add₂ _ _ _ _,
+  nat_cast := λ n, algebra_map₀ (n : R),
+  nat_cast_zero := by rw [nat.cast_zero, map_zero],
+  nat_cast_succ := λ n, by rw [nat.cast_succ, map_add, algebra_map₀_one],
+  ..tensor_power.gmonoid }
+
+example : semiring (⨁ n : ℕ, ⨂[R]^n M) := by apply_instance
+
+/-- The tensor powers form a graded algebra.
+
+Note that this instance implies `algebra R (⨁ n : ℕ, ⨂[R]^n M)` via `direct_sum.algebra`. -/
+instance galgebra : direct_sum.galgebra R (λ i, ⨂[R]^i M) :=
+{ to_fun := (algebra_map₀ : R ≃ₗ[R] ⨂[R]^0 M).to_linear_map.to_add_monoid_hom,
+  map_one := algebra_map₀_one,
+  map_mul := λ r s, graded_monoid_eq_of_cast rfl begin
+    rw [←linear_equiv.eq_symm_apply],
+    have := algebra_map₀_mul_algebra_map₀ r s,
+    exact this.symm,
+  end,
+  commutes := λ r x, graded_monoid_eq_of_cast (add_comm _ _) begin
+    have := (algebra_map₀_mul r x.snd).trans (mul_algebra_map₀ r x.snd).symm,
+    rw [←linear_equiv.eq_symm_apply, cast_symm],
+    rw [←linear_equiv.eq_symm_apply, cast_symm, cast_cast] at this,
+    exact this,
+  end,
+  smul_def := λ r x, graded_monoid_eq_of_cast (zero_add x.fst).symm begin
+    rw [←linear_equiv.eq_symm_apply, cast_symm],
+    exact (algebra_map₀_mul r x.snd).symm,
+  end }
+
+lemma galgebra_to_fun_def (r : R) :
+  @direct_sum.galgebra.to_fun ℕ R (λ i, ⨂[R]^i M) _ _ _ _ _ _ _ r = algebra_map₀ r := rfl
+
+example : algebra R (⨁ n : ℕ, ⨂[R]^n M) := by apply_instance
+
+end tensor_power
diff --git a/src/linear_algebra/tensor_product.lean b/src/linear_algebra/tensor_product.lean
index c0f36a871fb90..2e031039e0618 100644
--- a/src/linear_algebra/tensor_product.lean
+++ b/src/linear_algebra/tensor_product.lean
@@ -5,12 +5,14 @@ Authors: Kenny Lau, Mario Carneiro
 -/
 
 import group_theory.congruence
-import linear_algebra.bilinear_map
-import linear_algebra.span
+import algebra.module.submodule.bilinear
 
 /-!
 # Tensor product of modules over commutative semirings.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file constructs the tensor product of modules over commutative semirings. Given a semiring
 `R` and modules over it `M` and `N`, the standard construction of the tensor product is
 `tensor_product R M N`. It is also a module over `R`.
@@ -79,8 +81,10 @@ def tensor_product : Type* :=
 
 variables {R}
 
-localized "infix ` ⊗ `:100 := tensor_product _" in tensor_product
-localized "notation M ` ⊗[`:100 R `] `:0 N:100 := tensor_product R M N" in tensor_product
+localized "infix (name := tensor_product.infer)
+  ` ⊗ `:100 := tensor_product hole!" in tensor_product
+localized "notation (name := tensor_product)
+  M ` ⊗[`:100 R `] `:0 N:100 := tensor_product R M N" in tensor_product
 
 namespace tensor_product
 
@@ -136,7 +140,7 @@ section
 variables (R R' M N)
 
 /--
-A typeclass for `has_scalar` structures which can be moved across a tensor product.
+A typeclass for `has_smul` structures which can be moved across a tensor product.
 
 This typeclass is generated automatically from a `is_scalar_tower` instance, but exists so that
 we can also add an instance for `add_comm_group.int_module`, allowing `z •` to be moved even if
@@ -155,7 +159,7 @@ end
 `mul_action.is_scalar_tower.left`. -/
 @[priority 100]
 instance compatible_smul.is_scalar_tower
-  [has_scalar R' R] [is_scalar_tower R' R M] [distrib_mul_action R' N] [is_scalar_tower R' R N] :
+  [has_smul R' R] [is_scalar_tower R' R M] [distrib_mul_action R' N] [is_scalar_tower R' R N] :
   compatible_smul R R' M N :=
 ⟨λ r m n, begin
   conv_lhs {rw ← one_smul R m},
@@ -170,10 +174,10 @@ lemma smul_tmul [distrib_mul_action R' N] [compatible_smul R R' M N] (r : R') (m
 compatible_smul.smul_tmul _ _ _
 
 /-- Auxiliary function to defining scalar multiplication on tensor product. -/
-def smul.aux {R' : Type*} [has_scalar R' M] (r : R') : free_add_monoid (M × N) →+ M ⊗[R] N :=
+def smul.aux {R' : Type*} [has_smul R' M] (r : R') : free_add_monoid (M × N) →+ M ⊗[R] N :=
 free_add_monoid.lift $ λ p : M × N, (r • p.1) ⊗ₜ p.2
 
-theorem smul.aux_of {R' : Type*} [has_scalar R' M] (r : R') (m : M) (n : N) :
+theorem smul.aux_of {R' : Type*} [has_smul R' M] (r : R') (m : M) (n : N) :
   smul.aux r (free_add_monoid.of (m, n)) = (r • m) ⊗ₜ[R] n :=
 rfl
 
@@ -192,7 +196,7 @@ action. Two natural ways in which this situation arises are:
 Note that in the special case that `R = R'`, since `R` is commutative, we just get the usual scalar
 action on a tensor product of two modules. This special case is important enough that, for
 performance reasons, we define it explicitly below. -/
-instance left_has_scalar : has_scalar R' (M ⊗[R] N) :=
+instance left_has_smul : has_smul R' (M ⊗[R] N) :=
 ⟨λ r, (add_con_gen (tensor_product.eqv R M N)).lift (smul.aux r : _ →+ M ⊗[R] N) $
 add_con.add_con_gen_le $ λ x y hxy, match x, y, hxy with
 | _, _, (eqv.of_zero_left n)       := (add_con.ker_rel _).2 $
@@ -209,7 +213,7 @@ add_con.add_con_gen_le $ λ x y hxy, match x, y, hxy with
     by simp_rw [add_monoid_hom.map_add, add_comm]
 end⟩
 
-instance : has_scalar R (M ⊗[R] N) := tensor_product.left_has_scalar
+instance : has_smul R (M ⊗[R] N) := tensor_product.left_has_smul
 
 protected theorem smul_zero (r : R') : (r • 0 : M ⊗[R] N) = 0 :=
 add_monoid_hom.map_zero _
@@ -267,6 +271,9 @@ rfl
   x ⊗ₜ (r • y) = r • (x ⊗ₜ[R] y) :=
 (smul_tmul _ _ _).symm
 
+lemma smul_tmul_smul (r s : R) (m : M) (n : N) : (r • m) ⊗ₜ[R] (s • n) = (r * s) • (m ⊗ₜ[R] n) :=
+by simp only [tmul_smul, smul_tmul, mul_smul]
+
 instance left_module : module R'' (M ⊗[R] N) :=
 { smul := (•),
   add_smul := tensor_product.add_smul,
@@ -286,7 +293,16 @@ section
 
 -- Like `R'`, `R'₂` provides a `distrib_mul_action R'₂ (M ⊗[R] N)`
 variables {R'₂ : Type*} [monoid R'₂] [distrib_mul_action R'₂ M]
-variables [smul_comm_class R R'₂ M] [has_scalar R'₂ R']
+variables [smul_comm_class R R'₂ M]
+
+/-- `smul_comm_class R' R'₂ M` implies `smul_comm_class R' R'₂ (M ⊗[R] N)` -/
+instance smul_comm_class_left [smul_comm_class R' R'₂ M] : smul_comm_class R' R'₂ (M ⊗[R] N) :=
+{ smul_comm := λ r' r'₂ x, tensor_product.induction_on x
+    (by simp_rw tensor_product.smul_zero)
+    (λ m n, by simp_rw [smul_tmul', smul_comm])
+    (λ x y ihx ihy, by { simp_rw tensor_product.smul_add, rw [ihx, ihy] }),}
+
+variables [has_smul R'₂ R']
 
 /-- `is_scalar_tower R'₂ R' M` implies `is_scalar_tower R'₂ R' (M ⊗[R] N)` -/
 instance is_scalar_tower_left [is_scalar_tower R'₂ R' M] :
@@ -311,7 +327,7 @@ end
 
 /-- A short-cut instance for the common case, where the requirements for the `compatible_smul`
 instances are sufficient. -/
-instance is_scalar_tower [has_scalar R' R] [is_scalar_tower R' R M] :
+instance is_scalar_tower [has_smul R' R] [is_scalar_tower R' R M] :
   is_scalar_tower R' R (M ⊗[R] N) :=
 tensor_product.is_scalar_tower_left  -- or right
 
@@ -366,6 +382,12 @@ begin
   { intros t₁ t₂ ht₁ ht₂, exact submodule.add_mem _ ht₁ ht₂, },
 end
 
+@[simp] lemma map₂_mk_top_top_eq_top : submodule.map₂ (mk R M N) ⊤ ⊤ = ⊤ :=
+begin
+  rw [← top_le_iff, ← span_tmul_eq_top, submodule.map₂_eq_span_image2],
+  exact submodule.span_mono (λ _ ⟨m, n, h⟩, ⟨m, n, trivial, trivial, h⟩),
+end
+
 end module
 
 section UMP
@@ -393,8 +415,7 @@ add_con.add_con_gen_le $ λ x y hxy, match x, y, hxy with
     by simp_rw [add_monoid_hom.map_add, add_comm]
 end
 
-lemma lift_aux_tmul (m n) : lift_aux f (m ⊗ₜ n) = f m n :=
-zero_add _
+lemma lift_aux_tmul (m n) : lift_aux f (m ⊗ₜ n) = f m n := rfl
 
 variable {f}
 
@@ -412,11 +433,8 @@ def lift : M ⊗ N →ₗ[R] P :=
   .. lift_aux f }
 variable {f}
 
-@[simp] lemma lift.tmul (x y) : lift f (x ⊗ₜ y) = f x y :=
-zero_add _
-
-@[simp] lemma lift.tmul' (x y) : (lift f).1 (x ⊗ₜ y) = f x y :=
-lift.tmul _ _
+@[simp] lemma lift.tmul (x y) : lift f (x ⊗ₜ y) = f x y := rfl
+@[simp] lemma lift.tmul' (x y) : (lift f).1 (x ⊗ₜ y) = f x y := rfl
 
 theorem ext' {g h : (M ⊗[R] N) →ₗ[R] P}
   (H : ∀ x y, g (x ⊗ₜ y) = h (x ⊗ₜ y)) : g = h :=
@@ -516,6 +534,15 @@ begin
   exact H w x y z,
 end
 
+/-- Two linear maps (M ⊗ N) ⊗ (P ⊗ Q) → S which agree on all elements of the
+form (m ⊗ₜ n) ⊗ₜ (p ⊗ₜ q) are equal. -/
+theorem ext_fourfold' {φ ψ : (M ⊗[R] N) ⊗[R] (P ⊗[R] Q) →ₗ[R] S}
+  (H : ∀ w x y z, φ ((w ⊗ₜ x) ⊗ₜ (y ⊗ₜ z)) = ψ ((w ⊗ₜ x) ⊗ₜ (y ⊗ₜ z))) : φ = ψ :=
+begin
+  ext m n p q,
+  exact H m n p q,
+end
+
 end UMP
 
 variables {M N}
@@ -634,11 +661,11 @@ variables [add_comm_monoid Q'] [module R Q']
 
 lemma map_comp (f₂ : P →ₗ[R] P') (f₁ : M →ₗ[R] P) (g₂ : Q →ₗ[R] Q') (g₁ : N →ₗ[R] Q) :
   map (f₂.comp f₁) (g₂.comp g₁) = (map f₂ g₂).comp (map f₁ g₁) :=
-ext' $ λ _ _, by simp only [linear_map.comp_apply, map_tmul]
+ext' $ λ _ _, rfl
 
 lemma lift_comp_map (i : P →ₗ[R] Q →ₗ[R] Q') (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
   (lift i).comp (map f g) = lift ((i.comp f).compl₂ g) :=
-ext' $ λ _ _, by simp only [lift.tmul, map_tmul, linear_map.compl₂_apply, linear_map.comp_apply]
+ext' $ λ _ _, rfl
 
 local attribute [ext] ext
 
@@ -659,6 +686,55 @@ begin
   { simp only [pow_succ', ih, map_mul], },
 end
 
+lemma map_add_left (f₁ f₂ : M →ₗ[R] P) (g : N →ₗ[R] Q) : map (f₁ + f₂) g = map f₁ g + map f₂ g :=
+by {ext, simp only [add_tmul, compr₂_apply, mk_apply, map_tmul, add_apply]}
+
+lemma map_add_right (f : M →ₗ[R] P) (g₁ g₂ : N →ₗ[R] Q) : map f (g₁ + g₂) = map f g₁ + map f g₂ :=
+by {ext, simp only [tmul_add, compr₂_apply, mk_apply, map_tmul, add_apply]}
+
+lemma map_smul_left (r : R) (f : M →ₗ[R] P) (g : N →ₗ[R] Q) : map (r • f) g = r • map f g :=
+by {ext, simp only [smul_tmul, compr₂_apply, mk_apply, map_tmul, smul_apply, tmul_smul]}
+
+lemma map_smul_right (r : R) (f : M →ₗ[R] P) (g : N →ₗ[R] Q) : map f (r • g) = r • map f g :=
+by {ext, simp only [smul_tmul, compr₂_apply, mk_apply, map_tmul, smul_apply, tmul_smul]}
+
+variables (R M N P Q)
+
+/-- The tensor product of a pair of linear maps between modules, bilinear in both maps. -/
+def map_bilinear : (M →ₗ[R] P) →ₗ[R] (N →ₗ[R] Q) →ₗ[R] (M ⊗[R] N →ₗ[R] P ⊗[R] Q) :=
+linear_map.mk₂ R map map_add_left map_smul_left map_add_right map_smul_right
+
+/-- The canonical linear map from `P ⊗[R] (M →ₗ[R] Q)` to `(M →ₗ[R] P ⊗[R] Q)` -/
+def ltensor_hom_to_hom_ltensor : P ⊗[R] (M →ₗ[R] Q) →ₗ[R] (M →ₗ[R] P ⊗[R] Q) :=
+tensor_product.lift (llcomp R M Q _ ∘ₗ mk R P Q)
+
+/-- The canonical linear map from `(M →ₗ[R] P) ⊗[R] Q` to `(M →ₗ[R] P ⊗[R] Q)` -/
+def rtensor_hom_to_hom_rtensor : (M →ₗ[R] P) ⊗[R] Q →ₗ[R] (M →ₗ[R] P ⊗[R] Q) :=
+tensor_product.lift (llcomp R M P _ ∘ₗ (mk R P Q).flip).flip
+
+/-- The linear map from `(M →ₗ P) ⊗ (N →ₗ Q)` to `(M ⊗ N →ₗ P ⊗ Q)` sending `f ⊗ₜ g` to
+the `tensor_product.map f g`, the tensor product of the two maps. -/
+def hom_tensor_hom_map : (M →ₗ[R] P) ⊗[R] (N →ₗ[R] Q) →ₗ[R] (M ⊗[R] N →ₗ[R] P ⊗[R] Q) :=
+lift (map_bilinear R M N P Q)
+
+variables {R M N P Q}
+
+@[simp]
+lemma map_bilinear_apply (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
+  map_bilinear R M N P Q f g = map f g := rfl
+
+@[simp]
+lemma ltensor_hom_to_hom_ltensor_apply (p : P) (f : M →ₗ[R] Q) (m : M) :
+  ltensor_hom_to_hom_ltensor R M P Q (p ⊗ₜ f) m = p ⊗ₜ f m := rfl
+
+@[simp]
+lemma rtensor_hom_to_hom_rtensor_apply (f : M →ₗ[R] P) (q : Q) (m : M) :
+  rtensor_hom_to_hom_rtensor R M P Q (f ⊗ₜ q) m = f m ⊗ₜ q := rfl
+
+@[simp]
+lemma hom_tensor_hom_map_apply (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
+  hom_tensor_hom_map R M N P Q (f ⊗ₜ g) = map f g := rfl
+
 end
 
 /-- If `M` and `P` are linearly equivalent and `N` and `Q` are linearly equivalent
@@ -719,8 +795,8 @@ variables {M N P Q}
   tensor_tensor_tensor_comm R M N P Q ((m ⊗ₜ n) ⊗ₜ (p ⊗ₜ q)) = (m ⊗ₜ p) ⊗ₜ (n ⊗ₜ q) :=
 rfl
 
-@[simp] lemma tensor_tensor_tensor_comm_symm_tmul (m : M) (n : N) (p : P) (q : Q) :
-  (tensor_tensor_tensor_comm R M N P Q).symm ((m ⊗ₜ p) ⊗ₜ (n ⊗ₜ q)) = (m ⊗ₜ n) ⊗ₜ (p ⊗ₜ q) :=
+@[simp] lemma tensor_tensor_tensor_comm_symm :
+  (tensor_tensor_tensor_comm R M N P Q).symm = tensor_tensor_tensor_comm R M P N Q :=
 rfl
 
 variables (M N P Q)
@@ -814,9 +890,17 @@ def rtensor_hom : (N →ₗ[R] P) →ₗ[R] (N ⊗[R] M →ₗ[R] P ⊗[R] M) :=
 lemma ltensor_comp : (g.comp f).ltensor M = (g.ltensor M).comp (f.ltensor M) :=
 by { ext m n, simp only [compr₂_apply, mk_apply, comp_apply, ltensor_tmul] }
 
+lemma ltensor_comp_apply (x : M ⊗[R] N) :
+  (g.comp f).ltensor M x = (g.ltensor M) ((f.ltensor M) x) :=
+by { rw [ltensor_comp, coe_comp], }
+
 lemma rtensor_comp : (g.comp f).rtensor M = (g.rtensor M).comp (f.rtensor M) :=
 by { ext m n, simp only [compr₂_apply, mk_apply, comp_apply, rtensor_tmul] }
 
+lemma rtensor_comp_apply (x : N ⊗[R] M) :
+  (g.comp f).rtensor M x = (g.rtensor M) ((f.rtensor M) x) :=
+by { rw [rtensor_comp, coe_comp], }
+
 lemma ltensor_mul (f g : module.End R N) : (f * g).ltensor M = (f.ltensor M) * (g.ltensor M) :=
 ltensor_comp M f g
 
@@ -827,8 +911,16 @@ variables (N)
 
 @[simp] lemma ltensor_id : (id : N →ₗ[R] N).ltensor M = id := map_id
 
+-- `simp` can prove this.
+lemma ltensor_id_apply (x : M ⊗[R] N) : (linear_map.id : N →ₗ[R] N).ltensor M x = x :=
+by {rw [ltensor_id, id_coe, id.def], }
+
 @[simp] lemma rtensor_id : (id : N →ₗ[R] N).rtensor M = id := map_id
 
+-- `simp` can prove this.
+lemma rtensor_id_apply (x : N ⊗[R] M) : (linear_map.id : N →ₗ[R] N).rtensor M x = x :=
+by { rw [rtensor_id, id_coe, id.def], }
+
 variables {N}
 
 @[simp] lemma ltensor_comp_rtensor (f : M →ₗ[R] P) (g : N →ₗ[R] Q) :
diff --git a/src/linear_algebra/tensor_product/matrix.lean b/src/linear_algebra/tensor_product/matrix.lean
new file mode 100644
index 0000000000000..9b97cdba60234
--- /dev/null
+++ b/src/linear_algebra/tensor_product/matrix.lean
@@ -0,0 +1,81 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import data.matrix.kronecker
+import linear_algebra.matrix.to_lin
+import linear_algebra.tensor_product_basis
+
+/-!
+# Connections between `tensor_product` and `matrix`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains results about the matrices corresponding to maps between tensor product types,
+where the correspondance is induced by `basis.tensor_product`
+
+Notably, `tensor_product.to_matrix_map` shows that taking  the tensor product of linear maps is
+equivalent to taking the kronecker product of their matrix representations.
+-/
+
+variables {R : Type*} {M N P M' N' : Type*} {ι κ τ ι' κ' : Type*}
+variables [decidable_eq ι] [decidable_eq κ] [decidable_eq τ]
+variables [fintype ι] [fintype κ] [fintype τ] [fintype ι'] [fintype κ']
+variables [comm_ring R]
+variables [add_comm_group M] [add_comm_group N] [add_comm_group P]
+variables [add_comm_group M'] [add_comm_group N']
+variables [module R M] [module R N] [module R P] [module R M'] [module R N']
+variables (bM : basis ι R M) (bN : basis κ R N) (bP : basis τ R P)
+variables (bM' : basis ι' R M') (bN' : basis κ' R N')
+
+open_locale kronecker
+open matrix linear_map
+
+/-- The linear map built from `tensor_product.map` corresponds to the matrix built from
+`matrix.kronecker`. -/
+lemma tensor_product.to_matrix_map (f : M →ₗ[R] M') (g : N →ₗ[R] N') :
+  to_matrix (bM.tensor_product bN) (bM'.tensor_product bN') (tensor_product.map f g)
+    = to_matrix bM bM' f ⊗ₖ to_matrix bN bN' g :=
+begin
+  ext ⟨i, j⟩ ⟨i', j'⟩,
+  simp_rw [matrix.kronecker_map_apply, to_matrix_apply, basis.tensor_product_apply,
+    tensor_product.map_tmul, basis.tensor_product_repr_tmul_apply],
+end
+
+/-- The matrix built from `matrix.kronecker` corresponds to the linear map built from
+`tensor_product.map`. -/
+lemma matrix.to_lin_kronecker (A : matrix ι' ι R) (B : matrix κ' κ R) :
+  to_lin (bM.tensor_product bN) (bM'.tensor_product bN') (A ⊗ₖ B) =
+    tensor_product.map (to_lin bM bM' A) (to_lin bN bN' B) :=
+by rw [←linear_equiv.eq_symm_apply, to_lin_symm, tensor_product.to_matrix_map,
+  to_matrix_to_lin, to_matrix_to_lin]
+
+/-- `tensor_product.comm` corresponds to a permutation of the identity matrix. -/
+lemma tensor_product.to_matrix_comm :
+  to_matrix (bM.tensor_product bN) (bN.tensor_product bM) (tensor_product.comm R M N)
+    = (1 : matrix (ι × κ) (ι × κ) R).submatrix prod.swap id :=
+begin
+  ext ⟨i, j⟩ ⟨i', j'⟩,
+  simp_rw [to_matrix_apply, basis.tensor_product_apply, linear_equiv.coe_coe,
+    tensor_product.comm_tmul, basis.tensor_product_repr_tmul_apply, matrix.submatrix_apply,
+    prod.swap_prod_mk, id.def, basis.repr_self_apply, matrix.one_apply, prod.ext_iff, ite_and,
+    @eq_comm _ i', @eq_comm _ j'],
+  split_ifs; simp,
+end
+
+/-- `tensor_product.assoc` corresponds to a permutation of the identity matrix. -/
+lemma tensor_product.to_matrix_assoc :
+  to_matrix ((bM.tensor_product bN).tensor_product bP) (bM.tensor_product (bN.tensor_product bP))
+    (tensor_product.assoc R M N P)
+    = (1 : matrix (ι × κ × τ) (ι × κ × τ) R).submatrix id (equiv.prod_assoc _ _ _) :=
+begin
+  ext ⟨i, j, k⟩ ⟨⟨i', j'⟩, k'⟩,
+  simp_rw [to_matrix_apply, basis.tensor_product_apply, linear_equiv.coe_coe,
+    tensor_product.assoc_tmul, basis.tensor_product_repr_tmul_apply, matrix.submatrix_apply,
+    equiv.prod_assoc_apply, id.def, basis.repr_self_apply, matrix.one_apply, prod.ext_iff, ite_and,
+    @eq_comm _ i', @eq_comm _ j', @eq_comm _ k'],
+  split_ifs; simp,
+end
diff --git a/src/linear_algebra/tensor_product_basis.lean b/src/linear_algebra/tensor_product_basis.lean
index 673d640c01dff..1fdf3948c96f4 100644
--- a/src/linear_algebra/tensor_product_basis.lean
+++ b/src/linear_algebra/tensor_product_basis.lean
@@ -9,6 +9,9 @@ import linear_algebra.finsupp_vector_space
 /-!
 # Bases and dimensionality of tensor products of modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 These can not go into `linear_algebra.tensor_product` since they depend on
 `linear_algebra.finsupp_vector_space` which in turn imports `linear_algebra.tensor_product`.
 
@@ -37,16 +40,10 @@ lemma basis.tensor_product_apply' (b : basis ι R M) (c : basis κ R N) (i : ι
   basis.tensor_product b c i = b i.1 ⊗ₜ c i.2 :=
 by simp [basis.tensor_product]
 
-end comm_ring
-
-section field
-variables {K : Type*} (V W : Type*)
-variables [field K] [add_comm_group V] [module K V] [add_comm_group W] [module K W]
-
-/-- If `V` and `W` are finite dimensional `K` vector spaces, so is `V ⊗ W`. -/
-instance finite_dimensional_tensor_product [finite_dimensional K V] [finite_dimensional K W] :
-  finite_dimensional K (tensor_product K V W) :=
-finite_dimensional.of_fintype_basis
-  (basis.tensor_product (basis.of_vector_space K V) (basis.of_vector_space K W))
+@[simp]
+lemma basis.tensor_product_repr_tmul_apply (b : basis ι R M) (c : basis κ R N)
+  (m : M) (n : N) (i : ι) (j : κ) :
+  (basis.tensor_product b c).repr (m ⊗ₜ n) (i, j) = b.repr m i * c.repr n j :=
+by simp [basis.tensor_product]
 
-end field
+end comm_ring
diff --git a/src/linear_algebra/trace.lean b/src/linear_algebra/trace.lean
index ddc990b390689..c7e2673e6080a 100644
--- a/src/linear_algebra/trace.lean
+++ b/src/linear_algebra/trace.lean
@@ -8,10 +8,15 @@ import linear_algebra.matrix.trace
 import linear_algebra.contraction
 import linear_algebra.tensor_product_basis
 import linear_algebra.free_module.strong_rank_condition
+import linear_algebra.free_module.finite.rank
+import linear_algebra.projection
 
 /-!
 # Trace of a linear map
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the trace of a linear map.
 
 See also `linear_algebra/matrix/trace.lean` for the trace of a matrix.
@@ -35,7 +40,7 @@ open finite_dimensional
 open_locale tensor_product
 
 section
-variables (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
+variables (R : Type u) [comm_semiring R] {M : Type v} [add_comm_monoid M] [module R M]
 variables {ι : Type w} [decidable_eq ι] [fintype ι]
 variables {κ : Type*} [decidable_eq κ] [fintype κ]
 variables (b : basis ι R M) (c : basis κ R M)
@@ -111,14 +116,15 @@ section
 
 variables {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M]
 variables (N : Type*) [add_comm_group N] [module R N]
-variables {ι : Type*} [fintype ι]
+variables {ι : Type*}
 
 /-- The trace of a linear map correspond to the contraction pairing under the isomorphism
  `End(M) ≃ M* ⊗ M`-/
-lemma trace_eq_contract_of_basis (b : basis ι R M) :
+lemma trace_eq_contract_of_basis [finite ι] (b : basis ι R M) :
   (linear_map.trace R M) ∘ₗ (dual_tensor_hom R M M) = contract_left R M :=
 begin
   classical,
+  casesI nonempty_fintype ι,
   apply basis.ext (basis.tensor_product (basis.dual_basis b) b),
   rintros ⟨i, j⟩,
   simp only [function.comp_app, basis.tensor_product_apply, basis.coe_dual_basis, coe_comp],
@@ -131,12 +137,12 @@ end
 
 /-- The trace of a linear map correspond to the contraction pairing under the isomorphism
  `End(M) ≃ M* ⊗ M`-/
-lemma trace_eq_contract_of_basis' [decidable_eq ι] (b : basis ι R M) :
+lemma trace_eq_contract_of_basis' [fintype ι] [decidable_eq ι] (b : basis ι R M) :
   (linear_map.trace R M) =
   (contract_left R M) ∘ₗ (dual_tensor_hom_equiv_of_basis b).symm.to_linear_map :=
 by simp [linear_equiv.eq_comp_to_linear_map_symm, trace_eq_contract_of_basis b]
 
-variables (R M)
+variables (R M N)
 variables [module.free R M] [module.finite R M] [module.free R N] [module.finite R N] [nontrivial R]
 
 /-- When `M` is finite free, the trace of a linear map correspond to the contraction pairing under
@@ -162,25 +168,98 @@ trace_eq_contract_of_basis' (module.free.choose_basis R M)
 @[simp] theorem trace_one : trace R M 1 = (finrank R M : R) :=
 begin
   have b := module.free.choose_basis R M,
-  rw [trace_eq_matrix_trace R b, to_matrix_one, module.free.finrank_eq_card_choose_basis_index],
+  rw [trace_eq_matrix_trace R b, to_matrix_one, finrank_eq_card_choose_basis_index],
   simp,
 end
 
-variables (M)
+/-- The trace of the identity endomorphism is the dimension of the free module -/
+@[simp] theorem trace_id : trace R M id = (finrank R M : R) :=
+by rw [←one_eq_id, trace_one]
+
+@[simp] theorem trace_transpose : trace R (module.dual R M) ∘ₗ module.dual.transpose = trace R M :=
+begin
+  let e := dual_tensor_hom_equiv R M M,
+  have h : function.surjective e.to_linear_map := e.surjective,
+  refine (cancel_right h).1 _,
+  ext f m, simp [e],
+end
+
+theorem trace_prod_map :
+  trace R (M × N) ∘ₗ prod_map_linear R M N M N R =
+  (coprod id id : R × R →ₗ[R] R) ∘ₗ prod_map (trace R M) (trace R N) :=
+begin
+  let e := ((dual_tensor_hom_equiv R M M).prod (dual_tensor_hom_equiv R N N)),
+  have h : function.surjective e.to_linear_map := e.surjective,
+  refine (cancel_right h).1 _,
+  ext,
+  { simp only [dual_tensor_hom_equiv, tensor_product.algebra_tensor_module.curry_apply,
+  to_fun_eq_coe, tensor_product.curry_apply, coe_restrict_scalars_eq_coe, coe_comp,
+  linear_equiv.coe_to_linear_map, coe_inl, function.comp_app, linear_equiv.prod_apply,
+  dual_tensor_hom_equiv_of_basis_apply, map_zero, prod_map_apply, coprod_apply, id_coe, id.def,
+  add_zero, prod_map_linear_apply, dual_tensor_hom_prod_map_zero, trace_eq_contract_apply,
+  contract_left_apply, fst_apply] },
+  { simp only [dual_tensor_hom_equiv, tensor_product.algebra_tensor_module.curry_apply,
+  to_fun_eq_coe, tensor_product.curry_apply, coe_restrict_scalars_eq_coe, coe_comp,
+  linear_equiv.coe_to_linear_map, coe_inr, function.comp_app, linear_equiv.prod_apply,
+  dual_tensor_hom_equiv_of_basis_apply, map_zero, prod_map_apply, coprod_apply, id_coe, id.def,
+  zero_add, prod_map_linear_apply, zero_prod_map_dual_tensor_hom, trace_eq_contract_apply,
+  contract_left_apply, snd_apply], },
+end
+
+variables {R M N}
+
+theorem trace_prod_map' (f : M →ₗ[R] M) (g : N →ₗ[R] N) :
+  trace R (M × N) (prod_map f g) = trace R M f + trace R N g :=
+begin
+  have h := ext_iff.1 (trace_prod_map R M N) (f, g),
+  simp only [coe_comp, function.comp_app, prod_map_apply, coprod_apply, id_coe, id.def,
+  prod_map_linear_apply] at h, exact h,
+end
+
+variables (R M N)
+
+open tensor_product function
+
+theorem trace_tensor_product :
+  compr₂ (map_bilinear R M N M N) (trace R (M ⊗ N)) =
+  compl₁₂ (lsmul R R : R →ₗ[R] R →ₗ[R] R) (trace R M) (trace R N) :=
+begin
+  apply (compl₁₂_inj
+    (show surjective (dual_tensor_hom R M M), from (dual_tensor_hom_equiv R M M).surjective)
+    (show surjective (dual_tensor_hom R N N), from (dual_tensor_hom_equiv R N N).surjective)).1,
+  ext f m g n,
+  simp only [algebra_tensor_module.curry_apply, to_fun_eq_coe, tensor_product.curry_apply,
+  coe_restrict_scalars_eq_coe, compl₁₂_apply, compr₂_apply, map_bilinear_apply,
+  trace_eq_contract_apply, contract_left_apply, lsmul_apply, algebra.id.smul_eq_mul,
+  map_dual_tensor_hom, dual_distrib_apply],
+end
 
 theorem trace_comp_comm :
   compr₂ (llcomp R M N M) (trace R M) = compr₂ (llcomp R N M N).flip (trace R N) :=
 begin
   apply (compl₁₂_inj
-    (dual_tensor_hom_equiv R N M).surjective (dual_tensor_hom_equiv R M N).surjective).1,
+    (show surjective (dual_tensor_hom R N M), from (dual_tensor_hom_equiv R N M).surjective)
+    (show surjective (dual_tensor_hom R M N), from (dual_tensor_hom_equiv R M N).surjective)).1,
   ext g m f n,
   simp only [tensor_product.algebra_tensor_module.curry_apply, to_fun_eq_coe,
-  tensor_product.curry_apply, coe_restrict_scalars_eq_coe, compl₁₂_apply, compr₂_apply, flip_apply,
-  llcomp_apply', comp_dual_tensor_hom, map_smul, trace_eq_contract_apply, contract_left_apply,
-  smul_eq_mul, mul_comm],
+      linear_equiv.coe_to_linear_map, tensor_product.curry_apply, coe_restrict_scalars_eq_coe,
+      compl₁₂_apply, compr₂_apply, flip_apply, llcomp_apply', comp_dual_tensor_hom, map_smul,
+      trace_eq_contract_apply, contract_left_apply, smul_eq_mul, mul_comm],
 end
 
-variables {R M}
+variables {R M N}
+
+@[simp]
+theorem trace_transpose' (f : M →ₗ[R] M) : trace R _ (module.dual.transpose f) = trace R M f :=
+by { rw [←comp_apply, trace_transpose] }
+
+theorem trace_tensor_product' (f : M →ₗ[R] M) (g : N →ₗ[R] N) :
+  trace R (M ⊗ N) (map f g) = trace R M f * trace R N g :=
+begin
+  have h := ext_iff.1 (ext_iff.1 (trace_tensor_product R M N) f) g,
+  simp only [compr₂_apply, map_bilinear_apply, compl₁₂_apply, lsmul_apply,
+    algebra.id.smul_eq_mul] at h, exact h,
+end
 
 theorem trace_comp_comm' (f : M →ₗ[R] N) (g : N →ₗ[R] M) :
   trace R M (g ∘ₗ f) = trace R N (f ∘ₗ g) :=
@@ -194,6 +273,11 @@ end
 by rw [e.conj_apply, trace_comp_comm', ←comp_assoc, linear_equiv.comp_coe,
   linear_equiv.self_trans_symm, linear_equiv.refl_to_linear_map, id_comp]
 
+theorem is_proj.trace {p : submodule R M} {f : M →ₗ[R] M} (h : is_proj p f)
+  [module.free R p] [module.finite R p] [module.free R f.ker] [module.finite R f.ker] :
+  trace R M f = (finrank R p : R) :=
+by rw [h.eq_conj_prod_map, trace_conj', trace_prod_map', trace_id, map_zero, add_zero]
+
 end
 
 end linear_map
diff --git a/src/linear_algebra/unitary_group.lean b/src/linear_algebra/unitary_group.lean
index 50b9743daa1ed..dac05f32d4cf5 100644
--- a/src/linear_algebra/unitary_group.lean
+++ b/src/linear_algebra/unitary_group.lean
@@ -3,6 +3,7 @@ Copyright (c) 2021 Shing Tak Lam. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Shing Tak Lam
 -/
+import linear_algebra.general_linear_group
 import linear_algebra.matrix.to_lin
 import linear_algebra.matrix.nonsingular_inverse
 import algebra.star.unitary
@@ -10,6 +11,9 @@ import algebra.star.unitary
 /-!
 # The Unitary Group
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines elements of the unitary group `unitary_group n α`, where `α` is a `star_ring`.
 This consists of all `n` by `n` matrices with entries in `α` such that the star-transpose is its
 inverse. In addition, we define the group structure on `unitary_group n α`, and the embedding into
@@ -55,6 +59,28 @@ end
 variables {n : Type u} [decidable_eq n] [fintype n]
 variables {α : Type v} [comm_ring α] [star_ring α]
 
+lemma mem_unitary_group_iff {A : matrix n n α} :
+  A ∈ matrix.unitary_group n α ↔ A * star A = 1 :=
+begin
+  refine ⟨and.right, λ hA, ⟨_, hA⟩⟩,
+  simpa only [mul_eq_mul, mul_eq_one_comm] using hA
+end
+
+lemma mem_unitary_group_iff' {A : matrix n n α} :
+  A ∈ matrix.unitary_group n α ↔ star A * A = 1 :=
+begin
+  refine ⟨and.left, λ hA, ⟨hA, _⟩⟩,
+  rwa [mul_eq_mul, mul_eq_one_comm] at hA,
+end
+
+lemma det_of_mem_unitary {A : matrix n n α} (hA : A ∈ matrix.unitary_group n α) :
+  A.det ∈ unitary α :=
+begin
+  split,
+  { simpa [star, det_transpose] using congr_arg det hA.1 },
+  { simpa [star, det_transpose] using congr_arg det hA.2 },
+end
+
 namespace unitary_group
 
 instance coe_matrix : has_coe (unitary_group n α) (matrix n n α) := ⟨subtype.val⟩
@@ -144,7 +170,7 @@ end unitary_group
 
 section orthogonal_group
 
-variables (β : Type v) [comm_ring β]
+variables (n) (β : Type v) [comm_ring β]
 
 local attribute [instance] star_ring_of_comm
 /--
@@ -152,6 +178,20 @@ local attribute [instance] star_ring_of_comm
 -/
 abbreviation orthogonal_group := unitary_group n β
 
+lemma mem_orthogonal_group_iff {A : matrix n n β} :
+  A ∈ matrix.orthogonal_group n β ↔ A * star A = 1 :=
+begin
+  refine ⟨and.right, λ hA, ⟨_, hA⟩⟩,
+  simpa only [mul_eq_mul, mul_eq_one_comm] using hA
+end
+
+lemma mem_orthogonal_group_iff' {A : matrix n n β} :
+  A ∈ matrix.orthogonal_group n β ↔ star A * A = 1 :=
+begin
+  refine ⟨and.left, λ hA, ⟨hA, _⟩⟩,
+  rwa [mul_eq_mul, mul_eq_one_comm] at hA,
+end
+
 end orthogonal_group
 
 end matrix
diff --git a/src/linear_algebra/vandermonde.lean b/src/linear_algebra/vandermonde.lean
index 4e4575cfe459e..ff3ce3eb48755 100644
--- a/src/linear_algebra/vandermonde.lean
+++ b/src/linear_algebra/vandermonde.lean
@@ -3,16 +3,17 @@ Copyright (c) 2020 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
-
 import algebra.big_operators.fin
 import algebra.geom_sum
-import group_theory.perm.fin
 import linear_algebra.matrix.determinant
-import tactic.ring_exp
+import linear_algebra.matrix.nondegenerate
 
 /-!
 # Vandermonde matrix
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the `vandermonde` matrix and gives its determinant.
 
 ## Main definitions
@@ -27,10 +28,8 @@ This file defines the `vandermonde` matrix and gives its determinant.
 
 variables {R : Type*} [comm_ring R]
 
-open_locale big_operators
-open_locale matrix
-
-open equiv
+open equiv finset
+open_locale big_operators matrix
 
 namespace matrix
 
@@ -71,42 +70,44 @@ lemma vandermonde_transpose_mul_vandermonde {n : ℕ} (v : fin n → R) (i j) :
 by simp only [vandermonde_apply, matrix.mul_apply, matrix.transpose_apply, pow_add]
 
 lemma det_vandermonde {n : ℕ} (v : fin n → R) :
-  det (vandermonde v) = ∏ i : fin n, ∏ j in finset.univ.filter (λ j, i < j), (v j - v i) :=
+  det (vandermonde v) = ∏ i : fin n, ∏ j in Ioi i, (v j - v i) :=
 begin
   unfold vandermonde,
 
   induction n with n ih,
   { exact det_eq_one_of_card_eq_zero (fintype.card_fin 0) },
 
-  calc det (λ (i j : fin n.succ), v i ^ (j : ℕ))
-      = det (λ (i j : fin n.succ), @fin.cons _ (λ _, R)
+  calc det (of $ λ (i j : fin n.succ), v i ^ (j : ℕ))
+      = det (of $ λ (i j : fin n.succ), matrix.vec_cons
                (v 0 ^ (j : ℕ))
                (λ i, v (fin.succ i) ^ (j : ℕ) - v 0 ^ (j : ℕ)) i) :
-    det_eq_of_forall_row_eq_smul_add_const (fin.cons 0 1) 0 (fin.cons_zero _ _) _
-  ... = det (λ (i j : fin n), @fin.cons _ (λ _, R)
-              (v 0 ^ (j.succ : ℕ))
-              (λ (i : fin n), v (fin.succ i) ^ (j.succ : ℕ) - v 0 ^ (j.succ : ℕ))
-              (fin.succ_above 0 i)) :
-    by simp_rw [det_succ_column_zero, fin.sum_univ_succ, fin.cons_zero, minor, fin.cons_succ,
+    det_eq_of_forall_row_eq_smul_add_const (matrix.vec_cons 0 1) 0 (fin.cons_zero _ _) _
+  ... = det (of $ λ (i j : fin n), matrix.vec_cons
+               (v 0 ^ (j.succ : ℕ))
+               (λ (i : fin n), v (fin.succ i) ^ (j.succ : ℕ) - v 0 ^ (j.succ : ℕ))
+               (fin.succ_above 0 i)) :
+    by simp_rw [det_succ_column_zero, fin.sum_univ_succ, of_apply, matrix.cons_val_zero, submatrix,
+                of_apply, matrix.cons_val_succ,
                 fin.coe_zero, pow_zero, one_mul, sub_self, mul_zero, zero_mul,
                 finset.sum_const_zero, add_zero]
-  ... = det (λ (i j : fin n), (v (fin.succ i) - v 0) *
-              (∑ k in finset.range (j + 1 : ℕ), v i.succ ^ k * v 0 ^ (j - k : ℕ))) :
-    by { congr, ext i j, rw [fin.succ_above_zero, fin.cons_succ, fin.coe_succ, mul_comm],
+  ... = det (of $ λ (i j : fin n), (v (fin.succ i) - v 0) *
+              (∑ k in finset.range (j + 1 : ℕ), v i.succ ^ k * v 0 ^ (j - k : ℕ)) :
+                matrix _ _ R) :
+    by { congr, ext i j, rw [fin.succ_above_zero, matrix.cons_val_succ, fin.coe_succ, mul_comm],
          exact (geom_sum₂_mul (v i.succ) (v 0) (j + 1 : ℕ)).symm }
   ... = (∏ (i : fin n), (v (fin.succ i) - v 0)) * det (λ (i j : fin n),
     (∑ k in finset.range (j + 1 : ℕ), v i.succ ^ k * v 0 ^ (j - k : ℕ))) :
     det_mul_column (λ i, v (fin.succ i) - v 0) _
   ... = (∏ (i : fin n), (v (fin.succ i) - v 0)) * det (λ (i j : fin n), v (fin.succ i) ^ (j : ℕ)) :
     congr_arg ((*) _) _
-  ... = ∏ i : fin n.succ, ∏ j in finset.univ.filter (λ j, i < j), (v j - v i) :
-    by { simp_rw [ih (v ∘ fin.succ), fin.prod_univ_succ, fin.prod_filter_zero_lt,
-                  fin.prod_filter_succ_lt] },
+  ... = ∏ i : fin n.succ, ∏ j in Ioi i, (v j - v i) :
+    by simp_rw [ih (v ∘ fin.succ), fin.prod_univ_succ, fin.prod_Ioi_zero, fin.prod_Ioi_succ],
   { intros i j,
-    rw fin.cons_zero,
+    simp_rw [of_apply],
+    rw matrix.cons_val_zero,
     refine fin.cases _ (λ i, _) i,
     { simp },
-    rw [fin.cons_succ, fin.cons_succ, pi.one_apply],
+    rw [matrix.cons_val_succ, matrix.cons_val_succ, pi.one_apply],
     ring },
   { cases n,
     { simp only [det_eq_one_of_card_eq_zero (fintype.card_fin 0)] },
@@ -122,4 +123,34 @@ begin
       exact nat.lt_succ_iff.mp (finset.mem_range.mp hi') } }
 end
 
+lemma det_vandermonde_eq_zero_iff [is_domain R] {n : ℕ} {v : fin n → R} :
+  det (vandermonde v) = 0 ↔ ∃ (i j : fin n), v i = v j ∧ i ≠ j :=
+begin
+  split,
+  { simp only [det_vandermonde v, finset.prod_eq_zero_iff, sub_eq_zero, forall_exists_index],
+    exact λ i _ j h₁ h₂, ⟨j, i, h₂, (mem_Ioi.mp h₁).ne'⟩ },
+  { simp only [ne.def, forall_exists_index, and_imp],
+    refine λ i j h₁ h₂, matrix.det_zero_of_row_eq h₂ (funext $ λ k, _),
+    rw [vandermonde_apply, vandermonde_apply, h₁], }
+end
+
+lemma det_vandermonde_ne_zero_iff [is_domain R] {n : ℕ} {v : fin n → R} :
+  det (vandermonde v) ≠ 0 ↔ function.injective v :=
+by simpa only [det_vandermonde_eq_zero_iff, ne.def, not_exists, not_and, not_not]
+
+theorem eq_zero_of_forall_index_sum_pow_mul_eq_zero {R : Type*} [comm_ring R]
+  [is_domain R] {n : ℕ} {f v : fin n → R} (hf : function.injective f)
+  (hfv : ∀ j, ∑ i : fin n, (f j ^ (i : ℕ)) * v i = 0) : v = 0 :=
+eq_zero_of_mul_vec_eq_zero (det_vandermonde_ne_zero_iff.mpr hf) (funext hfv)
+
+theorem eq_zero_of_forall_index_sum_mul_pow_eq_zero {R : Type*} [comm_ring R]
+  [is_domain R] {n : ℕ} {f v : fin n → R} (hf : function.injective f)
+  (hfv : ∀ j, ∑ i, v i * (f j ^ (i : ℕ)) = 0) : v = 0 :=
+by { apply eq_zero_of_forall_index_sum_pow_mul_eq_zero hf, simp_rw mul_comm, exact hfv }
+
+theorem eq_zero_of_forall_pow_sum_mul_pow_eq_zero {R : Type*} [comm_ring R]
+  [is_domain R] {n : ℕ} {f v : fin n → R} (hf : function.injective f)
+  (hfv : ∀ i : fin n, ∑ j : fin n, v j * (f j ^ (i : ℕ)) = 0) : v = 0 :=
+eq_zero_of_vec_mul_eq_zero (det_vandermonde_ne_zero_iff.mpr hf) (funext hfv)
+
 end matrix
diff --git a/src/logic/basic.lean b/src/logic/basic.lean
index 4eb9f388c4c4c..26ef5b00ad237 100644
--- a/src/logic/basic.lean
+++ b/src/logic/basic.lean
@@ -3,12 +3,15 @@ Copyright (c) 2016 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Leonardo de Moura
 -/
-import tactic.doc_commands
+import tactic.mk_simp_attribute
 import tactic.reserved_notation
 
 /-!
 # Basic logic properties
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file is one of the earliest imports in mathlib.
 
 ## Implementation notes
@@ -50,8 +53,8 @@ instance subsingleton.prod {α β : Type*} [subsingleton α] [subsingleton β] :
 
 instance : decidable_eq empty := λa, a.elim
 
-instance sort.inhabited : inhabited (Sort*) := ⟨punit⟩
-instance sort.inhabited' : inhabited (default) := ⟨punit.star⟩
+instance sort.inhabited : inhabited Sort* := ⟨punit⟩
+instance sort.inhabited' : inhabited default := ⟨punit.star⟩
 
 instance psum.inhabited_left {α β} [inhabited α] : inhabited (psum α β) := ⟨psum.inl default⟩
 instance psum.inhabited_right {α β} [inhabited β] : inhabited (psum α β) := ⟨psum.inr default⟩
@@ -60,7 +63,7 @@ instance psum.inhabited_right {α β} [inhabited β] : inhabited (psum α β) :=
   {α} [subsingleton α] : decidable_eq α
 | a b := is_true (subsingleton.elim a b)
 
-@[simp] lemma eq_iff_true_of_subsingleton {α : Sort*} [subsingleton α] (x y : α) :
+@[simp, nontriviality] lemma eq_iff_true_of_subsingleton {α : Sort*} [subsingleton α] (x y : α) :
   x = y ↔ true :=
 by cc
 
@@ -71,8 +74,8 @@ lemma subsingleton_of_forall_eq {α : Sort*} (x : α) (h : ∀ y, y = x) : subsi
 lemma subsingleton_iff_forall_eq {α : Sort*} (x : α) : subsingleton α ↔ ∀ y, y = x :=
 ⟨λ h y, @subsingleton.elim _ h y x, subsingleton_of_forall_eq x⟩
 
--- TODO[gh-6025]: make this an instance once safe to do so
-lemma subtype.subsingleton (α : Sort*) [subsingleton α] (p : α → Prop) : subsingleton (subtype p) :=
+instance subtype.subsingleton (α : Sort*) [subsingleton α] (p : α → Prop) :
+  subsingleton (subtype p) :=
 ⟨λ ⟨x,_⟩ ⟨y,_⟩, have x = y, from subsingleton.elim _ _, by { cases this, refl }⟩
 
 /-- Add an instance to "undo" coercion transitivity into a chain of coercions, because
@@ -87,7 +90,7 @@ theorem coe_fn_coe_trans
 
 /-- Non-dependent version of `coe_fn_coe_trans`, helps `rw` figure out the argument. -/
 theorem coe_fn_coe_trans'
-  {α β γ} {δ : out_param $ _} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_fun γ (λ _, δ)]
+  {α β γ} {δ : _} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_fun γ (λ _, δ)]
   (x : α) : @coe_fn α _ _ x = @coe_fn β _ _ x := rfl
 
 @[simp] theorem coe_fn_coe_base
@@ -96,9 +99,13 @@ theorem coe_fn_coe_trans'
 
 /-- Non-dependent version of `coe_fn_coe_base`, helps `rw` figure out the argument. -/
 theorem coe_fn_coe_base'
-  {α β} {γ : out_param $ _} [has_coe α β] [has_coe_to_fun β (λ _, γ)]
+  {α β} {γ : _} [has_coe α β] [has_coe_to_fun β (λ _, γ)]
   (x : α) : @coe_fn α _ _ x = @coe_fn β _ _ x := rfl
 
+-- This instance should have low priority, to ensure we follow the chain
+-- `set_like → has_coe_to_sort`
+attribute [instance, priority 10] coe_sort_trans
+
 theorem coe_sort_coe_trans
   {α β γ δ} [has_coe α β] [has_coe_t_aux β γ] [has_coe_to_sort γ δ]
   (x : α) : @coe_sort α _ _ x = @coe_sort β _ _ x := rfl
@@ -146,12 +153,6 @@ instance subsingleton_pempty : subsingleton pempty := ⟨λa, a.elim⟩
 @[simp] lemma not_nonempty_pempty : ¬ nonempty pempty :=
 assume ⟨h⟩, h.elim
 
-@[simp] theorem forall_pempty {P : pempty → Prop} : (∀ x : pempty, P x) ↔ true :=
-⟨λ h, trivial, λ h x, by cases x⟩
-
-@[simp] theorem exists_pempty {P : pempty → Prop} : (∃ x : pempty, P x) ↔ false :=
-⟨λ h, by { cases h with w, cases w }, false.elim⟩
-
 lemma congr_heq {α β γ : Sort*} {f : α → γ} {g : β → γ} {x : α} {y : β} (h₁ : f == g)
   (h₂ : x == y) : f x = g y :=
 by { cases h₂, cases h₁, refl }
@@ -176,11 +177,11 @@ attribute [symm] ne.symm
 
 lemma ne_comm {α} {a b : α} : a ≠ b ↔ b ≠ a := ⟨ne.symm, ne.symm⟩
 
-@[simp] lemma eq_iff_eq_cancel_left {b c : α} :
+@[simp] lemma eq_iff_eq_cancel_left {α : Sort*} {b c : α} :
   (∀ {a}, a = b ↔ a = c) ↔ (b = c) :=
 ⟨λ h, by rw [← h], λ h a, by rw h⟩
 
-@[simp] lemma eq_iff_eq_cancel_right {a b : α} :
+@[simp] lemma eq_iff_eq_cancel_right {α : Sort*} {a b : α} :
   (∀ {c}, a = c ↔ b = c) ↔ (a = b) :=
 ⟨λ h, by rw h, λ h a, by rw h⟩
 
@@ -240,6 +241,10 @@ open function
 theorem false_ne_true : false ≠ true
 | h := h.symm ▸ trivial
 
+theorem eq_true_iff {a : Prop} : (a = true) = a :=
+have (a ↔ true) = a, from propext (iff_true a),
+eq.subst (@iff_eq_eq a true) this
+
 section propositional
 variables {a b c d e f : Prop}
 
@@ -269,7 +274,7 @@ theorem imp_and_distrib {α} : (α → b ∧ c) ↔ (α → b) ∧ (α → c) :=
 ⟨λ h, ⟨λ ha, (h ha).left, λ ha, (h ha).right⟩,
  λ h ha, ⟨h.left ha, h.right ha⟩⟩
 
-@[simp] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
+@[simp, mfld_simps] theorem and_imp : (a ∧ b → c) ↔ (a → b → c) :=
 iff.intro (λ h ha hb, h ⟨ha, hb⟩) (λ h ⟨ha, hb⟩, h ha hb)
 
 theorem iff_def : (a ↔ b) ↔ (a → b) ∧ (b → a) :=
@@ -300,6 +305,9 @@ if ha : a then by simp only [ha, true_and, true_implies_iff]
 @[simp] theorem and_or_imp : (a ∧ b) ∨ (a → c) ↔ a → (b ∨ c) :=
 decidable.and_or_imp
 
+/-- Provide modus tollens (`mt`) as dot notation for implications. -/
+protected lemma function.mt : (a → b) → ¬ b → ¬ a := mt
+
 /-! ### Declarations about `not` -/
 
 /-- Ex falso for negation. From `¬ a` and `a` anything follows. This is the same as `absurd` with
@@ -415,17 +423,30 @@ lemma iff.not (h : a ↔ b) : ¬ a ↔ ¬ b := not_congr h
 lemma iff.not_left (h : a ↔ ¬ b) : ¬ a ↔ b := h.not.trans not_not
 lemma iff.not_right (h : ¬ a ↔ b) : a ↔ ¬ b := not_not.symm.trans h.not
 
+protected lemma iff.ne {α β : Sort*} {a b : α} {c d : β} : (a = b ↔ c = d) → (a ≠ b ↔ c ≠ d) :=
+iff.not
+
+lemma iff.ne_left {α β : Sort*} {a b : α} {c d : β} : (a = b ↔ c ≠ d) → (a ≠ b ↔ c = d) :=
+iff.not_left
+
+lemma iff.ne_right {α β : Sort*} {a b : α} {c d : β} : (a ≠ b ↔ c = d) → (a = b ↔ c ≠ d) :=
+iff.not_right
+
 /-! ### Declarations about `xor` -/
 
 @[simp] theorem xor_true : xor true = not := funext $ λ a, by simp [xor]
 
 @[simp] theorem xor_false : xor false = id := funext $ λ a, by simp [xor]
 
-theorem xor_comm (a b) : xor a b = xor b a := by simp [xor, and_comm, or_comm]
+theorem xor_comm (a b) : xor a b ↔ xor b a := or_comm _ _
 
-instance : is_commutative Prop xor := ⟨xor_comm⟩
+instance : is_commutative Prop xor := ⟨λ a b, propext $ xor_comm a b⟩
 
 @[simp] theorem xor_self (a : Prop) : xor a a = false := by simp [xor]
+@[simp] theorem xor_not_left : xor (¬a) b ↔ (a ↔ b) := by by_cases a; simp *
+@[simp] theorem xor_not_right : xor a (¬b) ↔ (a ↔ b) := by by_cases a; simp *
+theorem xor_not_not : xor (¬a) (¬b) ↔ xor a b := by simp [xor, or_comm, and_comm]
+protected theorem xor.or (h : xor a b) : a ∨ b := h.imp and.left and.left
 
 /-! ### Declarations about `and` -/
 
@@ -477,6 +498,9 @@ iff.intro and.left (λ ha, ⟨ha, h ha⟩)
 theorem and_iff_right_of_imp {a b : Prop} (h : b → a) : (a ∧ b) ↔ b :=
 iff.intro and.right (λ hb, ⟨h hb, hb⟩)
 
+lemma ne_and_eq_iff_right {α : Sort*} {a b c : α} (h : b ≠ c) : a ≠ b ∧ a = c ↔ a = c :=
+and_iff_right_of_imp (λ h2, h2.symm ▸ h.symm)
+
 @[simp] theorem and_iff_left_iff_imp {a b : Prop} : ((a ∧ b) ↔ a) ↔ (a → b) :=
 ⟨λ h ha, (h.2 ha).2, and_iff_left_of_imp⟩
 
@@ -583,6 +607,9 @@ protected theorem decidable.not_imp_not [decidable a] : (¬ a → ¬ b) ↔ (b 
 
 theorem not_imp_not : (¬ a → ¬ b) ↔ (b → a) := decidable.not_imp_not
 
+/-- Provide the reverse of modus tollens (`mt`) as dot notation for implications. -/
+protected theorem function.mtr : (¬ a → ¬ b) → (b → a) := not_imp_not.mp
+
 -- See Note [decidable namespace]
 protected lemma decidable.or_congr_left [decidable c] (h : ¬ c → (a ↔ b)) : a ∨ c ↔ b ∨ c :=
 by { rw [decidable.or_iff_not_imp_right, decidable.or_iff_not_imp_right], exact imp_congr_right h }
@@ -782,9 +809,7 @@ not_and.trans imp_not_comm
 
 /-- One of de Morgan's laws: the negation of a disjunction is logically equivalent to the
 conjunction of the negations. -/
-theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b :=
-⟨λ h, ⟨λ ha, h (or.inl ha), λ hb, h (or.inr hb)⟩,
- λ ⟨h₁, h₂⟩ h, or.elim h h₁ h₂⟩
+theorem not_or_distrib : ¬ (a ∨ b) ↔ ¬ a ∧ ¬ b := or_imp_distrib
 
 -- See Note [decidable namespace]
 protected theorem decidable.or_iff_not_and_not [decidable a] [decidable b] : a ∨ b ↔ ¬ (¬a ∧ ¬b) :=
@@ -802,9 +827,9 @@ theorem and_iff_not_or_not : a ∧ b ↔ ¬ (¬ a ∨ ¬ b) := decidable.and_iff
 @[simp] theorem not_xor (P Q : Prop) : ¬ xor P Q ↔ (P ↔ Q) :=
 by simp only [not_and, xor, not_or_distrib, not_not, ← iff_iff_implies_and_implies]
 
-theorem xor_iff_not_iff (P Q : Prop) : xor P Q ↔ ¬ (P ↔ Q) :=
-by rw [iff_not_comm, not_xor]
-
+theorem xor_iff_not_iff (P Q : Prop) : xor P Q ↔ ¬ (P ↔ Q) := (not_xor P Q).not_right
+theorem xor_iff_iff_not : xor a b ↔ (a ↔ ¬b) := by simp only [← @xor_not_right a, not_not]
+theorem xor_iff_not_iff' : xor a b ↔ (¬a ↔ b) := by simp only [← @xor_not_left _ b, not_not]
 
 end propositional
 
@@ -826,7 +851,7 @@ end mem
 section equality
 variables {α : Sort*} {a b : α}
 
-@[simp] theorem heq_iff_eq : a == b ↔ a = b :=
+@[simp, mfld_simps] theorem heq_iff_eq : a == b ↔ a = b :=
 ⟨eq_of_heq, heq_of_eq⟩
 
 theorem proof_irrel_heq {p q : Prop} (hp : p) (hq : q) : hp == hq :=
@@ -849,12 +874,12 @@ theorem eq_equivalence : equivalence (@eq α) :=
 ⟨eq.refl, @eq.symm _, @eq.trans _⟩
 
 /-- Transport through trivial families is the identity. -/
-@[simp]
+@[simp, transport_simps]
 lemma eq_rec_constant {α : Sort*} {a a' : α} {β : Sort*} (y : β) (h : a = a') :
   (@eq.rec α a (λ a, β) y a' h) = y :=
 by { cases h, refl, }
 
-@[simp]
+@[simp, transport_simps]
 lemma eq_mp_eq_cast {α β : Sort*} (h : α = β) : eq.mp h = cast h := rfl
 
 @[simp]
@@ -892,9 +917,17 @@ lemma heq_of_cast_eq :
 lemma cast_eq_iff_heq {α β : Sort*} {a : α} {a' : β} {e : α = β} : cast e a = a' ↔ a == a' :=
 ⟨heq_of_cast_eq _, λ h, by cases h; refl⟩
 
-lemma rec_heq_of_heq {β} {C : α → Sort*} {x : C a} {y : β} (eq : a = b) (h : x == y) :
-  @eq.rec α a C x b eq == y :=
-by subst eq; exact h
+lemma rec_heq_of_heq {β} {C : α → Sort*} {x : C a} {y : β} (e : a = b) (h : x == y) :
+  @eq.rec α a C x b e == y :=
+by subst e; exact h
+
+lemma rec_heq_iff_heq {β} {C : α → Sort*} {x : C a} {y : β} {e : a = b} :
+  @eq.rec α a C x b e == y ↔ x == y :=
+by subst e
+
+lemma heq_rec_iff_heq {β} {C : α → Sort*} {x : β} {y : C a} {e : a = b} :
+  x == @eq.rec α a C y b e ↔ x == y :=
+by subst e
 
 protected lemma eq.congr {x₁ x₂ y₁ y₂ : α} (h₁ : x₁ = y₁) (h₂ : x₂ = y₂) :
   (x₁ = x₂) ↔ (y₁ = y₂) :=
@@ -916,10 +949,10 @@ lemma congr_fun₃ {f g : Π a b c, δ a b c} (h : f = g) (a : α) (b : β a) (c
   f a b c = g a b c :=
 congr_fun₂ (congr_fun h _) _ _
 
-lemma funext₂ {f g : Π a, β a → Prop} (h : ∀ a b, f a b = g a b) : f = g :=
+lemma funext₂ {f g : Π a b, γ a b} (h : ∀ a b, f a b = g a b) : f = g :=
 funext $ λ _, funext $ h _
 
-lemma funext₃ {f g : Π a b, γ a b → Prop} (h : ∀ a b c, f a b c = g a b c) : f = g :=
+lemma funext₃ {f g : Π a b c, δ a b c} (h : ∀ a b c, f a b c = g a b c) : f = g :=
 funext $ λ _, funext₂ $ h _
 
 end equality
@@ -933,6 +966,9 @@ section dependent
 variables {β : α → Sort*} {γ : Π a, β a → Sort*} {δ : Π a b, γ a b → Sort*}
   {ε : Π a b c, δ a b c → Sort*}
 
+lemma pi_congr {β' : α → Sort*} (h : ∀ a, β a = β' a) : (Π a, β a) = Π a, β' a :=
+(funext h : β = β') ▸ rfl
+
 lemma forall₂_congr {p q : Π a, β a → Prop} (h : ∀ a b, p a b ↔ q a b) :
   (∀ a b, p a b) ↔ ∀ a b, q a b :=
 forall_congr $ λ a, forall_congr $ h a
@@ -1069,6 +1105,7 @@ let ⟨a⟩ := ha in
   (λ hb, hb $ h $ λ x, (not_imp.1 (h' x)).1), λ ⟨x, hx⟩ h, hx (h x)⟩
 
 -- TODO: duplicate of a lemma in core
+@[mfld_simps]
 theorem forall_true_iff : (α → true) ↔ true :=
 implies_true_iff α
 
@@ -1091,9 +1128,14 @@ exists.elim h (λ x hx, ⟨x, and.left hx⟩)
   (∃! x, p x) ↔ ∃ x, p x :=
 ⟨λ h, h.exists, Exists.imp $ λ x hx, ⟨hx, λ y _, subsingleton.elim y x⟩⟩
 
-@[simp] theorem forall_const (α : Sort*) [i : nonempty α] : (α → b) ↔ b :=
+@[simp, mfld_simps] theorem forall_const (α : Sort*) [i : nonempty α] : (α → b) ↔ b :=
 ⟨i.elim, λ hb x, hb⟩
 
+/-- For some reason simp doesn't use `forall_const` to simplify in this case. -/
+@[simp] lemma forall_forall_const {α β : Type*} (p : β → Prop) [nonempty α] :
+  (∀ x, α → p x) ↔ ∀ x, p x :=
+forall_congr $ λ x, forall_const α
+
 @[simp] theorem exists_const (α : Sort*) [i : nonempty α] : (∃ x : α, b) ↔ b :=
 ⟨λ ⟨x, h⟩, h, i.elim exists.intro⟩
 
@@ -1122,14 +1164,20 @@ by simp [and_comm]
 @[simp] theorem forall_eq' {a' : α} : (∀a, a' = a → p a) ↔ p a' :=
 by simp [@eq_comm _ a']
 
-theorem and_forall_ne (a : α) : (p a ∧ ∀ b ≠ a, p b) ↔ ∀ b, p b :=
-by simp only [← @forall_eq _ p a, ← forall_and_distrib, ← or_imp_distrib, classical.em,
+theorem decidable.and_forall_ne [decidable_eq α] (a : α) : (p a ∧ ∀ b ≠ a, p b) ↔ ∀ b, p b :=
+by simp only [← @forall_eq _ p a, ← forall_and_distrib, ← or_imp_distrib, decidable.em,
   forall_const]
 
+theorem and_forall_ne (a : α) : (p a ∧ ∀ b ≠ a, p b) ↔ ∀ b, p b :=
+decidable.and_forall_ne a
+
 -- this lemma is needed to simplify the output of `list.mem_cons_iff`
 @[simp] theorem forall_eq_or_imp {a' : α} : (∀ a, a = a' ∨ q a → p a) ↔ p a' ∧ ∀ a, q a → p a :=
 by simp only [or_imp_distrib, forall_and_distrib, forall_eq]
 
+lemma ne.ne_or_ne {x y : α} (z : α) (h : x ≠ y) : x ≠ z ∨ y ≠ z :=
+not_and_distrib.1 $ mt (and_imp.2 eq.substr) h.symm
+
 theorem exists_eq {a' : α} : ∃ a, a = a' := ⟨_, rfl⟩
 
 @[simp] theorem exists_eq' {a' : α} : ∃ a, a' = a := ⟨_, rfl⟩
@@ -1147,11 +1195,11 @@ by simp only [exists_unique, and_self, forall_eq', exists_eq']
 (exists_congr $ by exact λ a, and.comm).trans exists_eq_left
 
 @[simp] theorem exists_eq_right_right {a' : α} :
-  (∃ (a : α), p a ∧ b ∧ a = a') ↔ p a' ∧ b :=
+  (∃ (a : α), p a ∧ q a ∧ a = a') ↔ p a' ∧ q a' :=
 ⟨λ ⟨_, hp, hq, rfl⟩, ⟨hp, hq⟩, λ ⟨hp, hq⟩, ⟨a', hp, hq, rfl⟩⟩
 
 @[simp] theorem exists_eq_right_right' {a' : α} :
-  (∃ (a : α), p a ∧ b ∧ a' = a) ↔ p a' ∧ b :=
+  (∃ (a : α), p a ∧ q a ∧ a' = a) ↔ p a' ∧ q a' :=
 ⟨λ ⟨_, hp, hq, rfl⟩, ⟨hp, hq⟩, λ ⟨hp, hq⟩, ⟨a', hp, hq, rfl⟩⟩
 
 @[simp] theorem exists_apply_eq_apply (f : α → β) (a' : α) : ∃ a, f a = f a' := ⟨a', rfl⟩
@@ -1207,6 +1255,11 @@ by simp [@eq_comm _ a']
 theorem exists_comm {p : α → β → Prop} : (∃ a b, p a b) ↔ ∃ b a, p a b :=
 ⟨λ ⟨a, b, h⟩, ⟨b, a, h⟩, λ ⟨b, a, h⟩, ⟨a, b, h⟩⟩
 
+lemma exists₂_comm {ι₁ ι₂ : Sort*} {κ₁ : ι₁ → Sort*} {κ₂ : ι₂ → Sort*}
+  {p : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → Prop} :
+  (∃ i₁ j₁ i₂ j₂, p i₁ j₁ i₂ j₂) ↔ ∃ i₂ j₂ i₁ j₁, p i₁ j₁ i₂ j₂ :=
+by simp only [@exists_comm (κ₁ _), @exists_comm ι₁]
+
 theorem and.exists {p q : Prop} {f : p ∧ q → Prop} : (∃ h, f h) ↔ ∃ hp hq, f ⟨hp, hq⟩ :=
 ⟨λ ⟨h, H⟩, ⟨h.1, h.2, H⟩, λ ⟨hp, hq, H⟩, ⟨⟨hp, hq⟩, H⟩⟩
 
@@ -1273,12 +1326,10 @@ mt Exists.fst
   (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : Exists q = ∃ h : p', q' (hp.2 h) :=
 propext (exists_prop_congr hq _)
 
+/-- See `is_empty.exists_iff` for the `false` version. -/
 @[simp] lemma exists_true_left (p : true → Prop) : (∃ x, p x) ↔ p true.intro :=
 exists_prop_of_true _
 
-@[simp] lemma exists_false_left (p : false → Prop) : ¬ ∃ x, p x :=
-exists_prop_of_false not_false
-
 lemma exists_unique.unique {α : Sort*} {p : α → Prop} (h : ∃! x, p x)
   {y₁ y₂ : α} (py₁ : p y₁) (py₂ : p y₂) : y₁ = y₂ :=
 unique_of_exists_unique h py₁ py₂
@@ -1291,12 +1342,10 @@ unique_of_exists_unique h py₁ py₂
   (hq : ∀ h, q h ↔ q' h) (hp : p ↔ p') : (∀ h, q h) = ∀ h : p', q' (hp.2 h) :=
 propext (forall_prop_congr hq _)
 
+/-- See `is_empty.forall_iff` for the `false` version. -/
 @[simp] lemma forall_true_left (p : true → Prop) : (∀ x, p x) ↔ p true.intro :=
 forall_prop_of_true _
 
-@[simp] lemma forall_false_left (p : false → Prop) : (∀ x, p x) ↔ true :=
-forall_prop_of_false not_false
-
 lemma exists_unique.elim2 {α : Sort*} {p : α → Sort*} [∀ x, subsingleton (p x)]
   {q : Π x (h : p x), Prop} {b : Prop} (h₂ : ∃! x (h : p x), q x h)
   (h₁ : ∀ x (h : p x), q x h → (∀ y (hy : p y), q y hy → y = x) → b) : b :=
@@ -1486,12 +1535,24 @@ section ite
 variables {α β γ : Sort*} {σ : α → Sort*} (f : α → β) {P Q : Prop} [decidable P] [decidable Q]
   {a b c : α} {A : P → α} {B : ¬ P → α}
 
-lemma dite_eq_iff : dite P A B = c ↔ (∃ h, A h = c) ∨ ∃ h, B h = c := by by_cases P; simp *
+lemma dite_eq_iff : dite P A B = c ↔ (∃ h, A h = c) ∨ ∃ h, B h = c :=
+by by_cases P; simp [*, exists_prop_of_false not_false]
+
 lemma ite_eq_iff : ite P a b = c ↔ P ∧ a = c ∨ ¬ P ∧ b = c :=
 dite_eq_iff.trans $ by rw [exists_prop, exists_prop]
 
-@[simp] lemma dite_eq_left_iff : dite P (λ _, a) B = a ↔ ∀ h, B h = a := by by_cases P; simp *
-@[simp] lemma dite_eq_right_iff : dite P A (λ _, b) = b ↔ ∀ h, A h = b := by by_cases P; simp *
+lemma dite_eq_iff' : dite P A B = c ↔ (∀ h, A h = c) ∧ (∀ h, B h = c) :=
+⟨λ he, ⟨λ h, (dif_pos h).symm.trans he, λ h, (dif_neg h).symm.trans he⟩,
+  λ he, (em P).elim (λ h, (dif_pos h).trans $ he.1 h) (λ h, (dif_neg h).trans $ he.2 h)⟩
+
+lemma ite_eq_iff' : ite P a b = c ↔ (P → a = c) ∧ (¬ P → b = c) := dite_eq_iff'
+
+@[simp] lemma dite_eq_left_iff : dite P (λ _, a) B = a ↔ ∀ h, B h = a :=
+by by_cases P; simp [*, forall_prop_of_false not_false]
+
+@[simp] lemma dite_eq_right_iff : dite P A (λ _, b) = b ↔ ∀ h, A h = b :=
+by by_cases P; simp [*, forall_prop_of_false not_false]
+
 @[simp] lemma ite_eq_left_iff : ite P a b = a ↔ (¬ P → b = a) := dite_eq_left_iff
 @[simp] lemma ite_eq_right_iff : ite P a b = b ↔ (P → a = b) := dite_eq_right_iff
 
@@ -1577,4 +1638,14 @@ by by_cases h : P; simp [h]
 lemma ite_and : ite (P ∧ Q) a b = ite P (ite Q a b) b :=
 by by_cases hp : P; by_cases hq : Q; simp [hp, hq]
 
+lemma dite_dite_comm {B : Q → α} {C : ¬P → ¬Q → α} (h : P → ¬Q) :
+  (if p : P then A p else if q : Q then B q else C p q) =
+  (if q : Q then B q else if p : P then A p else C p q) :=
+dite_eq_iff'.2 ⟨λ p, by rw [dif_neg (h p), dif_pos p], λ np, by { congr, funext, rw dif_neg np }⟩
+
+lemma ite_ite_comm (h : P → ¬Q) :
+  (if P then a else if Q then b else c) =
+  (if Q then b else if P then a else c) :=
+dite_dite_comm P Q h
+
 end ite
diff --git a/src/logic/denumerable.lean b/src/logic/denumerable.lean
index 0f72967e03d89..30c05405be863 100644
--- a/src/logic/denumerable.lean
+++ b/src/logic/denumerable.lean
@@ -3,13 +3,17 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
-import data.fintype.basic
+import data.fintype.lattice
 import data.list.min_max
+import data.nat.order.lemmas
 import logic.encodable.basic
 
 /-!
 # Denumerable types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines denumerable (countably infinite) types as a typeclass extending `encodable`. This
 is used to provide explicit encode/decode functions from and to `ℕ`, with the information that those
 functions are inverses of each other.
@@ -20,6 +24,8 @@ This property already has a name, namely `α ≃ ℕ`, but here we are intereste
 typeclass.
 -/
 
+variables {α β : Type*}
+
 /-- A denumerable type is (constructively) bijective with `ℕ`. Typeclass equivalent of `α ≃ ℕ`. -/
 class denumerable (α : Type*) extends encodable α :=
 (decode_inv : ∀ n, ∃ a ∈ decode n, encode a = n)
@@ -29,7 +35,7 @@ open nat
 namespace denumerable
 
 section
-variables {α : Type*} {β : Type*} [denumerable α] [denumerable β]
+variables [denumerable α] [denumerable β]
 open encodable
 
 theorem decode_is_some (α) [denumerable α] (n : ℕ) :
@@ -289,3 +295,15 @@ begin
 end
 
 end denumerable
+
+/-- See also `nonempty_encodable`, `nonempty_fintype`. -/
+lemma nonempty_denumerable (α : Type*) [countable α] [infinite α] : nonempty (denumerable α) :=
+(nonempty_encodable α).map $ λ h, by exactI denumerable.of_encodable_of_infinite _
+
+instance nonempty_equiv_of_countable [countable α] [infinite α] [countable β] [infinite β] :
+  nonempty (α ≃ β) :=
+begin
+  casesI nonempty_denumerable α,
+  casesI nonempty_denumerable β,
+  exact ⟨(denumerable.eqv _).trans (denumerable.eqv _).symm⟩,
+end
diff --git a/src/logic/embedding.lean b/src/logic/embedding.lean
deleted file mode 100644
index 73664fb25c63a..0000000000000
--- a/src/logic/embedding.lean
+++ /dev/null
@@ -1,440 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Mario Carneiro
--/
-import data.fun_like.embedding
-import data.pprod
-import data.set.basic
-import data.sigma.basic
-import logic.equiv.basic
-
-/-!
-# Injective functions
--/
-
-universes u v w x
-
-namespace function
-
-/-- `α ↪ β` is a bundled injective function. -/
-@[nolint has_inhabited_instance] -- depending on cardinalities, an injective function may not exist
-structure embedding (α : Sort*) (β : Sort*) :=
-(to_fun : α → β)
-(inj'   : injective to_fun)
-
-infixr ` ↪ `:25 := embedding
-
-instance {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) (λ _, α → β) := ⟨embedding.to_fun⟩
-
-initialize_simps_projections embedding (to_fun → apply)
-
-instance {α : Sort u} {β : Sort v} : embedding_like (α ↪ β) α β :=
-{ coe := embedding.to_fun,
-  injective' := embedding.inj',
-  coe_injective' := λ f g h, by { cases f, cases g, congr' } }
-
-instance {α β : Sort*} : can_lift (α → β) (α ↪ β) :=
-{ coe := coe_fn,
-  cond := injective,
-  prf := λ f hf, ⟨⟨f, hf⟩, rfl⟩ }
-
-end function
-
-section equiv
-
-variables {α : Sort u} {β : Sort v} (f : α ≃ β)
-
-/-- Convert an `α ≃ β` to `α ↪ β`.
-
-This is also available as a coercion `equiv.coe_embedding`.
-The explicit `equiv.to_embedding` version is preferred though, since the coercion can have issues
-inferring the type of the resulting embedding. For example:
-
-```lean
--- Works:
-example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f.to_embedding = s.map f := by simp
--- Error, `f` has type `fin 3 ≃ fin 3` but is expected to have type `fin 3 ↪ ?m_1 : Type ?`
-example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f = s.map f.to_embedding := by simp
-```
--/
-@[simps] protected def equiv.to_embedding : α ↪ β := ⟨f, f.injective⟩
-
-instance equiv.coe_embedding : has_coe (α ≃ β) (α ↪ β) := ⟨equiv.to_embedding⟩
-
-@[reducible]
-instance equiv.perm.coe_embedding : has_coe (equiv.perm α) (α ↪ α) := equiv.coe_embedding
-
-@[simp] lemma equiv.coe_eq_to_embedding  : ↑f = f.to_embedding := rfl
-
-/-- Given an equivalence to a subtype, produce an embedding to the elements of the corresponding
-set. -/
-@[simps]
-def equiv.as_embedding {p : β → Prop} (e : α ≃ subtype p) : α ↪ β :=
-⟨coe ∘ e, subtype.coe_injective.comp e.injective⟩
-
-@[simp]
-lemma equiv.as_embedding_range {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) :
-  set.range e.as_embedding = set_of p :=
-set.ext $ λ x, ⟨λ ⟨y, h⟩, h ▸ subtype.coe_prop (e y), λ hs, ⟨e.symm ⟨x, hs⟩, by simp⟩⟩
-
-end equiv
-
-namespace function
-namespace embedding
-
-lemma coe_injective {α β} : @function.injective (α ↪ β) (α → β) coe_fn := fun_like.coe_injective
-
-@[ext] lemma ext {α β} {f g : embedding α β} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h
-
-lemma ext_iff {α β} {f g : embedding α β} : (∀ x, f x = g x) ↔ f = g := fun_like.ext_iff.symm
-
-@[simp] theorem to_fun_eq_coe {α β} (f : α ↪ β) : to_fun f = f := rfl
-
-@[simp] theorem coe_fn_mk {α β} (f : α → β) (i) :
-  (@mk _ _ f i : α → β) = f := rfl
-
-@[simp] lemma mk_coe {α β : Type*} (f : α ↪ β) (inj) : (⟨f, inj⟩ : α ↪ β) = f :=
-by { ext, simp }
-
-protected theorem injective {α β} (f : α ↪ β) : injective f := embedding_like.injective f
-
-lemma apply_eq_iff_eq {α β} (f : α ↪ β) (x y : α) : f x = f y ↔ x = y :=
-embedding_like.apply_eq_iff_eq f
-
-/-- The identity map as a `function.embedding`. -/
-@[refl, simps {simp_rhs := tt}]
-protected def refl (α : Sort*) : α ↪ α :=
-⟨id, injective_id⟩
-
-/-- Composition of `f : α ↪ β` and `g : β ↪ γ`. -/
-@[trans, simps {simp_rhs := tt}]
-protected def trans {α β γ} (f : α ↪ β) (g : β ↪ γ) : α ↪ γ :=
-⟨g ∘ f, g.injective.comp f.injective⟩
-
-@[simp]
-lemma equiv_to_embedding_trans_symm_to_embedding {α β : Sort*} (e : α ≃ β) :
-  e.to_embedding.trans e.symm.to_embedding = embedding.refl _ :=
-by { ext, simp, }
-
-@[simp]
-lemma equiv_symm_to_embedding_trans_to_embedding {α β : Sort*} (e : α ≃ β) :
-  e.symm.to_embedding.trans e.to_embedding = embedding.refl _ :=
-by { ext, simp, }
-
-/-- Transfer an embedding along a pair of equivalences. -/
-@[simps { fully_applied := ff }]
-protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x}
-  (e₁ : α ≃ β) (e₂ : γ ≃ δ) (f : α ↪ γ) : (β ↪ δ) :=
-(equiv.to_embedding e₁.symm).trans (f.trans e₂.to_embedding)
-
-/-- A right inverse `surj_inv` of a surjective function as an `embedding`. -/
-protected noncomputable def of_surjective {α β} (f : β → α) (hf : surjective f) :
-  α ↪ β :=
-⟨surj_inv hf, injective_surj_inv _⟩
-
-/-- Convert a surjective `embedding` to an `equiv` -/
-protected noncomputable def equiv_of_surjective {α β} (f : α ↪ β) (hf : surjective f) :
-  α ≃ β :=
-equiv.of_bijective f ⟨f.injective, hf⟩
-
-/-- There is always an embedding from an empty type. --/
-protected def of_is_empty {α β} [is_empty α] : α ↪ β :=
-⟨is_empty_elim, is_empty_elim⟩
-
-/-- Change the value of an embedding `f` at one point. If the prescribed image
-is already occupied by some `f a'`, then swap the values at these two points. -/
-def set_value {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
-  [∀ a', decidable (f a' = b)] : α ↪ β :=
-⟨λ a', if a' = a then b else if f a' = b then f a else f a',
-  begin
-    intros x y h,
-    dsimp at h,
-    split_ifs at h; try { substI b }; try { simp only [f.injective.eq_iff] at * }; cc
-  end⟩
-
-theorem set_value_eq {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
-  [∀ a', decidable (f a' = b)] : set_value f a b a = b :=
-by simp [set_value]
-
-/-- Embedding into `option α` using `some`. -/
-@[simps { fully_applied := ff }] protected def some {α} : α ↪ option α :=
-⟨some, option.some_injective α⟩
-
-/-- Embedding into `option α` using `coe`. Usually the correct synctatical form for `simp`. -/
-@[simps { fully_applied := ff }]
-def coe_option {α} : α ↪ option α := ⟨coe, option.some_injective α⟩
-
-/-- Embedding into `with_top α`. -/
-@[simps]
-def coe_with_top {α} : α ↪ with_top α := { to_fun := coe, ..embedding.some}
-
-/-- Given an embedding `f : α ↪ β` and a point outside of `set.range f`, construct an embedding
-`option α ↪ β`. -/
-@[simps] def option_elim {α β} (f : α ↪ β) (x : β) (h : x ∉ set.range f) :
-  option α ↪ β :=
-⟨λ o, o.elim x f, option.injective_iff.2 ⟨f.2, h⟩⟩
-
-/-- Equivalence between embeddings of `option α` and a sigma type over the embeddings of `α`. -/
-@[simps]
-def option_embedding_equiv (α β) : (option α ↪ β) ≃ Σ f : α ↪ β, ↥(set.range f)ᶜ :=
-{ to_fun := λ f, ⟨coe_option.trans f, f none, λ ⟨x, hx⟩, option.some_ne_none x $ f.injective hx⟩,
-  inv_fun := λ f, f.1.option_elim f.2 f.2.2,
-  left_inv := λ f, ext $ by { rintro (_|_); simp [option.coe_def] },
-  right_inv := λ ⟨f, y, hy⟩, by { ext; simp [option.coe_def] } }
-
-/-- Embedding of a `subtype`. -/
-def subtype {α} (p : α → Prop) : subtype p ↪ α :=
-⟨coe, λ _ _, subtype.ext_val⟩
-
-@[simp] lemma coe_subtype {α} (p : α → Prop) : ⇑(subtype p) = coe := rfl
-
-/-- Choosing an element `b : β` gives an embedding of `punit` into `β`. -/
-def punit {β : Sort*} (b : β) : punit ↪ β :=
-⟨λ _, b, by { rintros ⟨⟩ ⟨⟩ _, refl, }⟩
-
-/-- Fixing an element `b : β` gives an embedding `α ↪ α × β`. -/
-def sectl (α : Sort*) {β : Sort*} (b : β) : α ↪ α × β :=
-⟨λ a, (a, b), λ a a' h, congr_arg prod.fst h⟩
-
-/-- Fixing an element `a : α` gives an embedding `β ↪ α × β`. -/
-def sectr {α : Sort*} (a : α) (β : Sort*): β ↪ α × β :=
-⟨λ b, (a, b), λ b b' h, congr_arg prod.snd h⟩
-
-/-- Restrict the codomain of an embedding. -/
-def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
-⟨λ a, ⟨f a, H a⟩, λ a b h, f.injective (@congr_arg _ _ _ _ subtype.val h)⟩
-
-@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
-  cod_restrict p f H a = ⟨f a, H a⟩ := rfl
-
-/-- If `e₁` and `e₂` are embeddings, then so is `prod.map e₁ e₂ : (a, b) ↦ (e₁ a, e₂ b)`. -/
-def prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α × γ ↪ β × δ :=
-⟨prod.map e₁ e₂, e₁.injective.prod_map e₂.injective⟩
-
-@[simp] lemma coe_prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
-  ⇑(e₁.prod_map e₂) = prod.map e₁ e₂ :=
-rfl
-
-/-- If `e₁` and `e₂` are embeddings, then so is `λ ⟨a, b⟩, ⟨e₁ a, e₂ b⟩ : pprod α γ → pprod β δ`. -/
-def pprod_map {α β γ δ : Sort*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : pprod α γ ↪ pprod β δ :=
-⟨λ x, ⟨e₁ x.1, e₂ x.2⟩, e₁.injective.pprod_map e₂.injective⟩
-
-section sum
-open sum
-
-/-- If `e₁` and `e₂` are embeddings, then so is `sum.map e₁ e₂`. -/
-def sum_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α ⊕ γ ↪ β ⊕ δ :=
-⟨sum.map e₁ e₂,
-    assume s₁ s₂ h, match s₁, s₂, h with
-    | inl a₁, inl a₂, h := congr_arg inl $ e₁.injective $ inl.inj h
-    | inr b₁, inr b₂, h := congr_arg inr $ e₂.injective $ inr.inj h
-    end⟩
-
-@[simp] theorem coe_sum_map {α β γ δ} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
-  ⇑(sum_map e₁ e₂) = sum.map e₁ e₂ :=
-rfl
-
-/-- The embedding of `α` into the sum `α ⊕ β`. -/
-@[simps] def inl {α β : Type*} : α ↪ α ⊕ β :=
-⟨sum.inl, λ a b, sum.inl.inj⟩
-
-/-- The embedding of `β` into the sum `α ⊕ β`. -/
-@[simps] def inr {α β : Type*} : β ↪ α ⊕ β :=
-⟨sum.inr, λ a b, sum.inr.inj⟩
-
-end sum
-
-section sigma
-
-variables {α α' : Type*} {β : α → Type*} {β' : α' → Type*}
-
-/-- `sigma.mk` as an `function.embedding`. -/
-@[simps apply] def sigma_mk (a : α) : β a ↪ Σ x, β x :=
-⟨sigma.mk a, sigma_mk_injective⟩
-
-/-- If `f : α ↪ α'` is an embedding and `g : Π a, β α ↪ β' (f α)` is a family
-of embeddings, then `sigma.map f g` is an embedding. -/
-@[simps apply] def sigma_map (f : α ↪ α') (g : Π a, β a ↪ β' (f a)) :
-  (Σ a, β a) ↪ Σ a', β' a' :=
-⟨sigma.map f (λ a, g a), f.injective.sigma_map (λ a, (g a).injective)⟩
-
-end sigma
-
-/-- Define an embedding `(Π a : α, β a) ↪ (Π a : α, γ a)` from a family of embeddings
-`e : Π a, (β a ↪ γ a)`. This embedding sends `f` to `λ a, e a (f a)`. -/
-@[simps] def Pi_congr_right {α : Sort*} {β γ : α → Sort*} (e : ∀ a, β a ↪ γ a) :
-  (Π a, β a) ↪ (Π a, γ a) :=
-⟨λf a, e a (f a), λ f₁ f₂ h, funext $ λ a, (e a).injective (congr_fun h a)⟩
-
-/-- An embedding `e : α ↪ β` defines an embedding `(γ → α) ↪ (γ → β)` that sends each `f`
-to `e ∘ f`. -/
-def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w}
-  (e : α ↪ β) : (γ → α) ↪ (γ → β) :=
-Pi_congr_right (λ _, e)
-
-@[simp] lemma arrow_congr_right_apply {α : Sort u} {β : Sort v} {γ : Sort w}
-  (e : α ↪ β) (f : γ ↪ α) : arrow_congr_right e f = e ∘ f := rfl
-
-/-- An embedding `e : α ↪ β` defines an embedding `(α → γ) ↪ (β → γ)` for any inhabited type `γ`.
-This embedding sends each `f : α → γ` to a function `g : β → γ` such that `g ∘ e = f` and
-`g y = default` whenever `y ∉ range e`. -/
-noncomputable def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w} [inhabited γ]
-  (e : α ↪ β) : (α → γ) ↪ (β → γ) :=
-⟨λ f, extend e f (λ _, default), λ f₁ f₂ h, funext $ λ x,
-  by simpa only [extend_apply e.injective] using congr_fun h (e x)⟩
-
-/-- Restrict both domain and codomain of an embedding. -/
-protected def subtype_map {α β} {p : α → Prop} {q : β → Prop} (f : α ↪ β)
-  (h : ∀{{x}}, p x → q (f x)) : {x : α // p x} ↪ {y : β // q y} :=
-⟨subtype.map f h, subtype.map_injective h f.2⟩
-
-open set
-
-/-- `set.image` as an embedding `set α ↪ set β`. -/
-@[simps apply] protected def image {α β} (f : α ↪ β) : set α ↪ set β :=
-⟨image f, f.2.image_injective⟩
-
-lemma swap_apply {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y z : α) :
-  equiv.swap (f x) (f y) (f z) = f (equiv.swap x y z) :=
-f.injective.swap_apply x y z
-
-lemma swap_comp {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y : α) :
-  equiv.swap (f x) (f y) ∘ f = f ∘ equiv.swap x y :=
-f.injective.swap_comp x y
-
-end embedding
-end function
-
-namespace equiv
-
-open function.embedding
-
-/-- The type of embeddings `α ↪ β` is equivalent to
-    the subtype of all injective functions `α → β`. -/
-def subtype_injective_equiv_embedding (α β : Sort*) :
-  {f : α → β // function.injective f} ≃ (α ↪ β) :=
-{ to_fun := λ f, ⟨f.val, f.property⟩,
-  inv_fun := λ f, ⟨f, f.injective⟩,
-  left_inv := λ f, by simp,
-  right_inv := λ f, by {ext, refl} }
-
-/-- If `α₁ ≃ α₂` and `β₁ ≃ β₂`, then the type of embeddings `α₁ ↪ β₁`
-is equivalent to the type of embeddings `α₂ ↪ β₂`. -/
-@[congr, simps apply] def embedding_congr {α β γ δ : Sort*}
-  (h : α ≃ β) (h' : γ ≃ δ) : (α ↪ γ) ≃ (β ↪ δ) :=
-{ to_fun := λ f, f.congr h h',
-  inv_fun := λ f, f.congr h.symm h'.symm,
-  left_inv := λ x, by {ext, simp},
-  right_inv := λ x, by {ext, simp} }
-
-@[simp] lemma embedding_congr_refl {α β : Sort*} :
-  embedding_congr (equiv.refl α) (equiv.refl β) = equiv.refl (α ↪ β) :=
-by {ext, refl}
-
-@[simp] lemma embedding_congr_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Sort*}
-  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
-  embedding_congr (e₁.trans e₂) (e₁'.trans e₂') =
-  (embedding_congr e₁ e₁').trans (embedding_congr e₂ e₂') :=
-rfl
-
-@[simp] lemma embedding_congr_symm {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
-  (embedding_congr e₁ e₂).symm = embedding_congr e₁.symm e₂.symm :=
-rfl
-
-lemma embedding_congr_apply_trans {α₁ β₁ γ₁ α₂ β₂ γ₂ : Sort*}
-  (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) (ec : γ₁ ≃ γ₂) (f : α₁ ↪ β₁) (g : β₁ ↪ γ₁) :
-  equiv.embedding_congr ea ec (f.trans g) =
-  (equiv.embedding_congr ea eb f).trans (equiv.embedding_congr eb ec g) :=
-by {ext, simp}
-
-@[simp]
-lemma refl_to_embedding {α : Type*} : (equiv.refl α).to_embedding = function.embedding.refl α := rfl
-
-@[simp]
-lemma trans_to_embedding {α β γ : Type*} (e : α ≃ β) (f : β ≃ γ) :
-  (e.trans f).to_embedding = e.to_embedding.trans f.to_embedding := rfl
-
-end equiv
-
-namespace set
-
-/-- The injection map is an embedding between subsets. -/
-@[simps apply] def embedding_of_subset {α} (s t : set α) (h : s ⊆ t) : s ↪ t :=
-⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by { congr, injection h }⟩
-
-end set
-
-section subtype
-
-variable {α : Type*}
-
-/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` can be injectively split
-into a sum of subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right. -/
-def subtype_or_left_embedding (p q : α → Prop) [decidable_pred p] :
-  {x // p x ∨ q x} ↪ {x // p x} ⊕ {x // q x} :=
-⟨λ x, if h : p x then sum.inl ⟨x, h⟩ else sum.inr ⟨x, x.prop.resolve_left h⟩,
-  begin
-    intros x y,
-    dsimp only,
-    split_ifs;
-    simp [subtype.ext_iff]
-  end⟩
-
-lemma subtype_or_left_embedding_apply_left {p q : α → Prop} [decidable_pred p]
-  (x : {x // p x ∨ q x}) (hx : p x) : subtype_or_left_embedding p q x = sum.inl ⟨x, hx⟩ :=
-dif_pos hx
-
-lemma subtype_or_left_embedding_apply_right {p q : α → Prop} [decidable_pred p]
-  (x : {x // p x ∨ q x}) (hx : ¬ p x) :
-  subtype_or_left_embedding p q x = sum.inr ⟨x, x.prop.resolve_left hx⟩ :=
-dif_neg hx
-
-/-- A subtype `{x // p x}` can be injectively sent to into a subtype `{x // q x}`,
-if `p x → q x` for all `x : α`. -/
-@[simps] def subtype.imp_embedding (p q : α → Prop) (h : p ≤ q) :
-  {x // p x} ↪ {x // q x} :=
-⟨λ x, ⟨x, h x x.prop⟩, λ x y, by simp [subtype.ext_iff]⟩
-
-/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` is equivalent to a sum of
-subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right, when
-`disjoint p q`.
-
-See also `equiv.sum_compl`, for when `is_compl p q`.  -/
-@[simps apply] def subtype_or_equiv (p q : α → Prop) [decidable_pred p] (h : disjoint p q) :
-  {x // p x ∨ q x} ≃ {x // p x} ⊕ {x // q x} :=
-{ to_fun := subtype_or_left_embedding p q,
-  inv_fun := sum.elim
-    (subtype.imp_embedding _ _ (λ x hx, (or.inl hx : p x ∨ q x)))
-    (subtype.imp_embedding _ _ (λ x hx, (or.inr hx : p x ∨ q x))),
-  left_inv := λ x, begin
-    by_cases hx : p x,
-    { rw subtype_or_left_embedding_apply_left _ hx,
-      simp [subtype.ext_iff] },
-    { rw subtype_or_left_embedding_apply_right _ hx,
-      simp [subtype.ext_iff] },
-  end,
-  right_inv := λ x, begin
-    cases x,
-    { simp only [sum.elim_inl],
-      rw subtype_or_left_embedding_apply_left,
-      { simp },
-      { simpa using x.prop } },
-    { simp only [sum.elim_inr],
-      rw subtype_or_left_embedding_apply_right,
-      { simp },
-      { suffices : ¬ p x,
-        { simpa },
-        intro hp,
-        simpa using h x ⟨hp, x.prop⟩ } }
-  end }
-
-@[simp] lemma subtype_or_equiv_symm_inl (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
-  (x : {x // p x}) : (subtype_or_equiv p q h).symm (sum.inl x) = ⟨x, or.inl x.prop⟩ :=
-rfl
-
-@[simp] lemma subtype_or_equiv_symm_inr (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
-  (x : {x // q x}) : (subtype_or_equiv p q h).symm (sum.inr x) = ⟨x, or.inr x.prop⟩ :=
-rfl
-
-end subtype
diff --git a/src/logic/embedding/basic.lean b/src/logic/embedding/basic.lean
new file mode 100644
index 0000000000000..06cf19825d790
--- /dev/null
+++ b/src/logic/embedding/basic.lean
@@ -0,0 +1,373 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import data.fun_like.embedding
+import data.prod.pprod
+import data.sigma.basic
+import data.option.basic
+import data.subtype
+import logic.equiv.basic
+
+/-!
+# Injective functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+universes u v w x
+
+namespace function
+
+/-- `α ↪ β` is a bundled injective function. -/
+@[nolint has_nonempty_instance] -- depending on cardinalities, an injective function may not exist
+structure embedding (α : Sort*) (β : Sort*) :=
+(to_fun : α → β)
+(inj'   : injective to_fun)
+
+infixr ` ↪ `:25 := embedding
+
+instance {α : Sort u} {β : Sort v} : has_coe_to_fun (α ↪ β) (λ _, α → β) := ⟨embedding.to_fun⟩
+
+initialize_simps_projections embedding (to_fun → apply)
+
+instance {α : Sort u} {β : Sort v} : embedding_like (α ↪ β) α β :=
+{ coe := embedding.to_fun,
+  injective' := embedding.inj',
+  coe_injective' := λ f g h, by { cases f, cases g, congr' } }
+
+instance {α β : Sort*} : can_lift (α → β) (α ↪ β) coe_fn injective :=
+{ prf := λ f hf, ⟨⟨f, hf⟩, rfl⟩ }
+
+end function
+
+section equiv
+
+variables {α : Sort u} {β : Sort v} (f : α ≃ β)
+
+/-- Convert an `α ≃ β` to `α ↪ β`.
+
+This is also available as a coercion `equiv.coe_embedding`.
+The explicit `equiv.to_embedding` version is preferred though, since the coercion can have issues
+inferring the type of the resulting embedding. For example:
+
+```lean
+-- Works:
+example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f.to_embedding = s.map f := by simp
+-- Error, `f` has type `fin 3 ≃ fin 3` but is expected to have type `fin 3 ↪ ?m_1 : Type ?`
+example (s : finset (fin 3)) (f : equiv.perm (fin 3)) : s.map f = s.map f.to_embedding := by simp
+```
+-/
+protected def equiv.to_embedding : α ↪ β := ⟨f, f.injective⟩
+
+@[simp] lemma equiv.coe_to_embedding : ⇑f.to_embedding = f := rfl
+lemma equiv.to_embedding_apply (a : α) : f.to_embedding a = f a := rfl
+
+instance equiv.coe_embedding : has_coe (α ≃ β) (α ↪ β) := ⟨equiv.to_embedding⟩
+
+@[reducible]
+instance equiv.perm.coe_embedding : has_coe (equiv.perm α) (α ↪ α) := equiv.coe_embedding
+
+@[simp] lemma equiv.coe_eq_to_embedding  : ↑f = f.to_embedding := rfl
+
+/-- Given an equivalence to a subtype, produce an embedding to the elements of the corresponding
+set. -/
+@[simps]
+def equiv.as_embedding {p : β → Prop} (e : α ≃ subtype p) : α ↪ β :=
+⟨coe ∘ e, subtype.coe_injective.comp e.injective⟩
+
+end equiv
+
+namespace function
+namespace embedding
+
+lemma coe_injective {α β} : @function.injective (α ↪ β) (α → β) coe_fn := fun_like.coe_injective
+
+@[ext] lemma ext {α β} {f g : embedding α β} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h
+
+lemma ext_iff {α β} {f g : embedding α β} : (∀ x, f x = g x) ↔ f = g := fun_like.ext_iff.symm
+
+@[simp] theorem to_fun_eq_coe {α β} (f : α ↪ β) : to_fun f = f := rfl
+
+@[simp] theorem coe_fn_mk {α β} (f : α → β) (i) :
+  (@mk _ _ f i : α → β) = f := rfl
+
+@[simp] lemma mk_coe {α β : Type*} (f : α ↪ β) (inj) : (⟨f, inj⟩ : α ↪ β) = f :=
+by { ext, simp }
+
+protected theorem injective {α β} (f : α ↪ β) : injective f := embedding_like.injective f
+
+lemma apply_eq_iff_eq {α β} (f : α ↪ β) (x y : α) : f x = f y ↔ x = y :=
+embedding_like.apply_eq_iff_eq f
+
+/-- The identity map as a `function.embedding`. -/
+@[refl, simps {simp_rhs := tt}]
+protected def refl (α : Sort*) : α ↪ α :=
+⟨id, injective_id⟩
+
+/-- Composition of `f : α ↪ β` and `g : β ↪ γ`. -/
+@[trans, simps {simp_rhs := tt}]
+protected def trans {α β γ} (f : α ↪ β) (g : β ↪ γ) : α ↪ γ :=
+⟨g ∘ f, g.injective.comp f.injective⟩
+
+@[simp]
+lemma equiv_to_embedding_trans_symm_to_embedding {α β : Sort*} (e : α ≃ β) :
+  e.to_embedding.trans e.symm.to_embedding = embedding.refl _ :=
+by { ext, simp, }
+
+@[simp]
+lemma equiv_symm_to_embedding_trans_to_embedding {α β : Sort*} (e : α ≃ β) :
+  e.symm.to_embedding.trans e.to_embedding = embedding.refl _ :=
+by { ext, simp, }
+
+/-- Transfer an embedding along a pair of equivalences. -/
+@[simps { fully_applied := ff }]
+protected def congr {α : Sort u} {β : Sort v} {γ : Sort w} {δ : Sort x}
+  (e₁ : α ≃ β) (e₂ : γ ≃ δ) (f : α ↪ γ) : (β ↪ δ) :=
+(equiv.to_embedding e₁.symm).trans (f.trans e₂.to_embedding)
+
+/-- A right inverse `surj_inv` of a surjective function as an `embedding`. -/
+protected noncomputable def of_surjective {α β} (f : β → α) (hf : surjective f) :
+  α ↪ β :=
+⟨surj_inv hf, injective_surj_inv _⟩
+
+/-- Convert a surjective `embedding` to an `equiv` -/
+protected noncomputable def equiv_of_surjective {α β} (f : α ↪ β) (hf : surjective f) :
+  α ≃ β :=
+equiv.of_bijective f ⟨f.injective, hf⟩
+
+/-- There is always an embedding from an empty type. -/
+protected def of_is_empty {α β} [is_empty α] : α ↪ β :=
+⟨is_empty_elim, is_empty_elim⟩
+
+/-- Change the value of an embedding `f` at one point. If the prescribed image
+is already occupied by some `f a'`, then swap the values at these two points. -/
+def set_value {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
+  [∀ a', decidable (f a' = b)] : α ↪ β :=
+⟨λ a', if a' = a then b else if f a' = b then f a else f a',
+  begin
+    intros x y h,
+    dsimp at h,
+    split_ifs at h; try { substI b }; try { simp only [f.injective.eq_iff] at * }; cc
+  end⟩
+
+theorem set_value_eq {α β} (f : α ↪ β) (a : α) (b : β) [∀ a', decidable (a' = a)]
+  [∀ a', decidable (f a' = b)] : set_value f a b a = b :=
+by simp [set_value]
+
+/-- Embedding into `option α` using `some`. -/
+@[simps { fully_applied := ff }] protected def some {α} : α ↪ option α :=
+⟨some, option.some_injective α⟩
+
+/-- Embedding into `option α` using `coe`. Usually the correct synctatical form for `simp`. -/
+@[simps { fully_applied := ff }]
+def coe_option {α} : α ↪ option α := ⟨coe, option.some_injective α⟩
+
+/-- A version of `option.map` for `function.embedding`s. -/
+@[simps { fully_applied := ff }]
+def option_map {α β} (f : α ↪ β) : option α ↪ option β :=
+⟨option.map f, option.map_injective f.injective⟩
+
+/-- Embedding of a `subtype`. -/
+def subtype {α} (p : α → Prop) : subtype p ↪ α :=
+⟨coe, λ _ _, subtype.ext_val⟩
+
+@[simp] lemma coe_subtype {α} (p : α → Prop) : ⇑(subtype p) = coe := rfl
+
+/-- `quotient.out` as an embedding. -/
+noncomputable def quotient_out (α) [s : setoid α] : quotient s ↪ α :=
+⟨_, quotient.out_injective⟩
+
+@[simp] theorem coe_quotient_out (α) [s : setoid α] : ⇑(quotient_out α) = quotient.out := rfl
+
+/-- Choosing an element `b : β` gives an embedding of `punit` into `β`. -/
+def punit {β : Sort*} (b : β) : punit ↪ β :=
+⟨λ _, b, by { rintros ⟨⟩ ⟨⟩ _, refl, }⟩
+
+/-- Fixing an element `b : β` gives an embedding `α ↪ α × β`. -/
+@[simps] def sectl (α : Sort*) {β : Sort*} (b : β) : α ↪ α × β :=
+⟨λ a, (a, b), λ a a' h, congr_arg prod.fst h⟩
+
+/-- Fixing an element `a : α` gives an embedding `β ↪ α × β`. -/
+@[simps] def sectr {α : Sort*} (a : α) (β : Sort*): β ↪ α × β :=
+⟨λ b, (a, b), λ b b' h, congr_arg prod.snd h⟩
+
+/-- If `e₁` and `e₂` are embeddings, then so is `prod.map e₁ e₂ : (a, b) ↦ (e₁ a, e₂ b)`. -/
+def prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α × γ ↪ β × δ :=
+⟨prod.map e₁ e₂, e₁.injective.prod_map e₂.injective⟩
+
+@[simp] lemma coe_prod_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
+  ⇑(e₁.prod_map e₂) = prod.map e₁ e₂ :=
+rfl
+
+/-- If `e₁` and `e₂` are embeddings, then so is `λ ⟨a, b⟩, ⟨e₁ a, e₂ b⟩ : pprod α γ → pprod β δ`. -/
+def pprod_map {α β γ δ : Sort*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : pprod α γ ↪ pprod β δ :=
+⟨λ x, ⟨e₁ x.1, e₂ x.2⟩, e₁.injective.pprod_map e₂.injective⟩
+
+section sum
+open sum
+
+/-- If `e₁` and `e₂` are embeddings, then so is `sum.map e₁ e₂`. -/
+def sum_map {α β γ δ : Type*} (e₁ : α ↪ β) (e₂ : γ ↪ δ) : α ⊕ γ ↪ β ⊕ δ :=
+⟨sum.map e₁ e₂,
+    assume s₁ s₂ h, match s₁, s₂, h with
+    | inl a₁, inl a₂, h := congr_arg inl $ e₁.injective $ inl.inj h
+    | inr b₁, inr b₂, h := congr_arg inr $ e₂.injective $ inr.inj h
+    end⟩
+
+@[simp] theorem coe_sum_map {α β γ δ} (e₁ : α ↪ β) (e₂ : γ ↪ δ) :
+  ⇑(sum_map e₁ e₂) = sum.map e₁ e₂ :=
+rfl
+
+/-- The embedding of `α` into the sum `α ⊕ β`. -/
+@[simps] def inl {α β : Type*} : α ↪ α ⊕ β :=
+⟨sum.inl, λ a b, sum.inl.inj⟩
+
+/-- The embedding of `β` into the sum `α ⊕ β`. -/
+@[simps] def inr {α β : Type*} : β ↪ α ⊕ β :=
+⟨sum.inr, λ a b, sum.inr.inj⟩
+
+end sum
+
+section sigma
+
+variables {α α' : Type*} {β : α → Type*} {β' : α' → Type*}
+
+/-- `sigma.mk` as an `function.embedding`. -/
+@[simps apply] def sigma_mk (a : α) : β a ↪ Σ x, β x :=
+⟨sigma.mk a, sigma_mk_injective⟩
+
+/-- If `f : α ↪ α'` is an embedding and `g : Π a, β α ↪ β' (f α)` is a family
+of embeddings, then `sigma.map f g` is an embedding. -/
+@[simps apply] def sigma_map (f : α ↪ α') (g : Π a, β a ↪ β' (f a)) :
+  (Σ a, β a) ↪ Σ a', β' a' :=
+⟨sigma.map f (λ a, g a), f.injective.sigma_map (λ a, (g a).injective)⟩
+
+end sigma
+
+/-- Define an embedding `(Π a : α, β a) ↪ (Π a : α, γ a)` from a family of embeddings
+`e : Π a, (β a ↪ γ a)`. This embedding sends `f` to `λ a, e a (f a)`. -/
+@[simps] def Pi_congr_right {α : Sort*} {β γ : α → Sort*} (e : ∀ a, β a ↪ γ a) :
+  (Π a, β a) ↪ (Π a, γ a) :=
+⟨λf a, e a (f a), λ f₁ f₂ h, funext $ λ a, (e a).injective (congr_fun h a)⟩
+
+/-- An embedding `e : α ↪ β` defines an embedding `(γ → α) ↪ (γ → β)` that sends each `f`
+to `e ∘ f`. -/
+def arrow_congr_right {α : Sort u} {β : Sort v} {γ : Sort w}
+  (e : α ↪ β) : (γ → α) ↪ (γ → β) :=
+Pi_congr_right (λ _, e)
+
+@[simp] lemma arrow_congr_right_apply {α : Sort u} {β : Sort v} {γ : Sort w}
+  (e : α ↪ β) (f : γ ↪ α) : arrow_congr_right e f = e ∘ f := rfl
+
+/-- An embedding `e : α ↪ β` defines an embedding `(α → γ) ↪ (β → γ)` for any inhabited type `γ`.
+This embedding sends each `f : α → γ` to a function `g : β → γ` such that `g ∘ e = f` and
+`g y = default` whenever `y ∉ range e`. -/
+noncomputable def arrow_congr_left {α : Sort u} {β : Sort v} {γ : Sort w} [inhabited γ]
+  (e : α ↪ β) : (α → γ) ↪ (β → γ) :=
+⟨λ f, extend e f default, λ f₁ f₂ h, funext $ λ x,
+  by simpa only [e.injective.extend_apply] using congr_fun h (e x)⟩
+
+/-- Restrict both domain and codomain of an embedding. -/
+protected def subtype_map {α β} {p : α → Prop} {q : β → Prop} (f : α ↪ β)
+  (h : ∀{{x}}, p x → q (f x)) : {x : α // p x} ↪ {y : β // q y} :=
+⟨subtype.map f h, subtype.map_injective h f.2⟩
+
+open set
+
+lemma swap_apply {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y z : α) :
+  equiv.swap (f x) (f y) (f z) = f (equiv.swap x y z) :=
+f.injective.swap_apply x y z
+
+lemma swap_comp {α β : Type*} [decidable_eq α] [decidable_eq β] (f : α ↪ β) (x y : α) :
+  equiv.swap (f x) (f y) ∘ f = f ∘ equiv.swap x y :=
+f.injective.swap_comp x y
+
+end embedding
+end function
+
+namespace equiv
+
+open function.embedding
+
+/-- The type of embeddings `α ↪ β` is equivalent to
+    the subtype of all injective functions `α → β`. -/
+def subtype_injective_equiv_embedding (α β : Sort*) :
+  {f : α → β // function.injective f} ≃ (α ↪ β) :=
+{ to_fun := λ f, ⟨f.val, f.property⟩,
+  inv_fun := λ f, ⟨f, f.injective⟩,
+  left_inv := λ f, by simp,
+  right_inv := λ f, by {ext, refl} }
+
+/-- If `α₁ ≃ α₂` and `β₁ ≃ β₂`, then the type of embeddings `α₁ ↪ β₁`
+is equivalent to the type of embeddings `α₂ ↪ β₂`. -/
+@[congr, simps apply] def embedding_congr {α β γ δ : Sort*}
+  (h : α ≃ β) (h' : γ ≃ δ) : (α ↪ γ) ≃ (β ↪ δ) :=
+{ to_fun := λ f, f.congr h h',
+  inv_fun := λ f, f.congr h.symm h'.symm,
+  left_inv := λ x, by {ext, simp},
+  right_inv := λ x, by {ext, simp} }
+
+@[simp] lemma embedding_congr_refl {α β : Sort*} :
+  embedding_congr (equiv.refl α) (equiv.refl β) = equiv.refl (α ↪ β) :=
+by {ext, refl}
+
+@[simp] lemma embedding_congr_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Sort*}
+  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
+  embedding_congr (e₁.trans e₂) (e₁'.trans e₂') =
+  (embedding_congr e₁ e₁').trans (embedding_congr e₂ e₂') :=
+rfl
+
+@[simp] lemma embedding_congr_symm {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
+  (embedding_congr e₁ e₂).symm = embedding_congr e₁.symm e₂.symm :=
+rfl
+
+lemma embedding_congr_apply_trans {α₁ β₁ γ₁ α₂ β₂ γ₂ : Sort*}
+  (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) (ec : γ₁ ≃ γ₂) (f : α₁ ↪ β₁) (g : β₁ ↪ γ₁) :
+  equiv.embedding_congr ea ec (f.trans g) =
+  (equiv.embedding_congr ea eb f).trans (equiv.embedding_congr eb ec g) :=
+by {ext, simp}
+
+@[simp]
+lemma refl_to_embedding {α : Type*} : (equiv.refl α).to_embedding = function.embedding.refl α := rfl
+
+@[simp]
+lemma trans_to_embedding {α β γ : Type*} (e : α ≃ β) (f : β ≃ γ) :
+  (e.trans f).to_embedding = e.to_embedding.trans f.to_embedding := rfl
+
+end equiv
+
+section subtype
+
+variable {α : Type*}
+
+/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` can be injectively split
+into a sum of subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right. -/
+def subtype_or_left_embedding (p q : α → Prop) [decidable_pred p] :
+  {x // p x ∨ q x} ↪ {x // p x} ⊕ {x // q x} :=
+⟨λ x, if h : p x then sum.inl ⟨x, h⟩ else sum.inr ⟨x, x.prop.resolve_left h⟩,
+  begin
+    intros x y,
+    dsimp only,
+    split_ifs;
+    simp [subtype.ext_iff]
+  end⟩
+
+lemma subtype_or_left_embedding_apply_left {p q : α → Prop} [decidable_pred p]
+  (x : {x // p x ∨ q x}) (hx : p x) : subtype_or_left_embedding p q x = sum.inl ⟨x, hx⟩ :=
+dif_pos hx
+
+lemma subtype_or_left_embedding_apply_right {p q : α → Prop} [decidable_pred p]
+  (x : {x // p x ∨ q x}) (hx : ¬ p x) :
+  subtype_or_left_embedding p q x = sum.inr ⟨x, x.prop.resolve_left hx⟩ :=
+dif_neg hx
+
+/-- A subtype `{x // p x}` can be injectively sent to into a subtype `{x // q x}`,
+if `p x → q x` for all `x : α`. -/
+@[simps] def subtype.imp_embedding (p q : α → Prop) (h : ∀ x, p x → q x) :
+  {x // p x} ↪ {x // q x} :=
+⟨λ x, ⟨x, h x x.prop⟩, λ x y, by simp [subtype.ext_iff]⟩
+
+end subtype
diff --git a/src/logic/embedding/set.lean b/src/logic/embedding/set.lean
new file mode 100644
index 0000000000000..60952eac1fe06
--- /dev/null
+++ b/src/logic/embedding/set.lean
@@ -0,0 +1,120 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro
+-/
+import logic.embedding.basic
+import data.set.image
+
+/-!
+# Interactions between embeddings and sets.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+universes u v w x
+
+section equiv
+
+variables {α : Sort u} {β : Sort v} (f : α ≃ β)
+
+@[simp]
+lemma equiv.as_embedding_range {α β : Sort*} {p : β → Prop} (e : α ≃ subtype p) :
+  set.range e.as_embedding = set_of p :=
+set.ext $ λ x, ⟨λ ⟨y, h⟩, h ▸ subtype.coe_prop (e y), λ hs, ⟨e.symm ⟨x, hs⟩, by simp⟩⟩
+
+end equiv
+
+namespace function
+namespace embedding
+
+/-- Embedding into `with_top α`. -/
+@[simps]
+def coe_with_top {α} : α ↪ with_top α := { to_fun := coe, ..embedding.some}
+
+/-- Given an embedding `f : α ↪ β` and a point outside of `set.range f`, construct an embedding
+`option α ↪ β`. -/
+@[simps] def option_elim {α β} (f : α ↪ β) (x : β) (h : x ∉ set.range f) :
+  option α ↪ β :=
+⟨option.elim x f, option.injective_iff.2 ⟨f.2, h⟩⟩
+
+/-- Equivalence between embeddings of `option α` and a sigma type over the embeddings of `α`. -/
+@[simps]
+def option_embedding_equiv (α β) : (option α ↪ β) ≃ Σ f : α ↪ β, ↥(set.range f)ᶜ :=
+{ to_fun := λ f, ⟨coe_option.trans f, f none, λ ⟨x, hx⟩, option.some_ne_none x $ f.injective hx⟩,
+  inv_fun := λ f, f.1.option_elim f.2 f.2.2,
+  left_inv := λ f, ext $ by { rintro (_|_); simp [option.coe_def] },
+  right_inv := λ ⟨f, y, hy⟩, by { ext; simp [option.coe_def] } }
+
+/-- Restrict the codomain of an embedding. -/
+def cod_restrict {α β} (p : set β) (f : α ↪ β) (H : ∀ a, f a ∈ p) : α ↪ p :=
+⟨λ a, ⟨f a, H a⟩, λ a b h, f.injective (@congr_arg _ _ _ _ subtype.val h)⟩
+
+@[simp] theorem cod_restrict_apply {α β} (p) (f : α ↪ β) (H a) :
+  cod_restrict p f H a = ⟨f a, H a⟩ := rfl
+
+open set
+
+/-- `set.image` as an embedding `set α ↪ set β`. -/
+@[simps apply] protected def image {α β} (f : α ↪ β) : set α ↪ set β :=
+⟨image f, f.2.image_injective⟩
+
+end embedding
+end function
+
+namespace set
+
+/-- The injection map is an embedding between subsets. -/
+@[simps apply] def embedding_of_subset {α} (s t : set α) (h : s ⊆ t) : s ↪ t :=
+⟨λ x, ⟨x.1, h x.2⟩, λ ⟨x, hx⟩ ⟨y, hy⟩ h, by { congr, injection h }⟩
+
+end set
+
+section subtype
+
+variable {α : Type*}
+
+/-- A subtype `{x // p x ∨ q x}` over a disjunction of `p q : α → Prop` is equivalent to a sum of
+subtypes `{x // p x} ⊕ {x // q x}` such that `¬ p x` is sent to the right, when
+`disjoint p q`.
+
+See also `equiv.sum_compl`, for when `is_compl p q`.  -/
+@[simps apply] def subtype_or_equiv (p q : α → Prop) [decidable_pred p] (h : disjoint p q) :
+  {x // p x ∨ q x} ≃ {x // p x} ⊕ {x // q x} :=
+{ to_fun := subtype_or_left_embedding p q,
+  inv_fun := sum.elim
+    (subtype.imp_embedding _ _ (λ x hx, (or.inl hx : p x ∨ q x)))
+    (subtype.imp_embedding _ _ (λ x hx, (or.inr hx : p x ∨ q x))),
+  left_inv := λ x, begin
+    by_cases hx : p x,
+    { rw subtype_or_left_embedding_apply_left _ hx,
+      simp [subtype.ext_iff] },
+    { rw subtype_or_left_embedding_apply_right _ hx,
+      simp [subtype.ext_iff] },
+  end,
+  right_inv := λ x, begin
+    cases x,
+    { simp only [sum.elim_inl],
+      rw subtype_or_left_embedding_apply_left,
+      { simp },
+      { simpa using x.prop } },
+    { simp only [sum.elim_inr],
+      rw subtype_or_left_embedding_apply_right,
+      { simp },
+      { suffices : ¬ p x,
+        { simpa },
+        intro hp,
+        simpa using h.le_bot x ⟨hp, x.prop⟩ } }
+  end }
+
+@[simp] lemma subtype_or_equiv_symm_inl (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
+  (x : {x // p x}) : (subtype_or_equiv p q h).symm (sum.inl x) = ⟨x, or.inl x.prop⟩ :=
+rfl
+
+@[simp] lemma subtype_or_equiv_symm_inr (p q : α → Prop) [decidable_pred p] (h : disjoint p q)
+  (x : {x // q x}) : (subtype_or_equiv p q h).symm (sum.inr x) = ⟨x, or.inr x.prop⟩ :=
+rfl
+
+end subtype
diff --git a/src/logic/encodable/basic.lean b/src/logic/encodable/basic.lean
index 993780e8eb558..a5d2623a656c0 100644
--- a/src/logic/encodable/basic.lean
+++ b/src/logic/encodable/basic.lean
@@ -4,12 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Mario Carneiro
 -/
 import logic.equiv.nat
+import data.pnat.basic
 import order.directed
-import order.rel_iso
+import data.countable.defs
+import order.rel_iso.basic
+import data.fin.basic
 
 /-!
 # Encodable types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines encodable (constructively countable) types as a typeclass.
 This is used to provide explicit encode/decode functions from and to `ℕ`, with the information that
 those functions are inverses of each other.
@@ -53,6 +59,10 @@ theorem encode_injective [encodable α] : function.injective (@encode α _)
 @[simp] lemma encode_inj [encodable α] {a b : α} : encode a = encode b ↔ a = b :=
 encode_injective.eq_iff
 
+-- The priority of the instance below is less than the priorities of `subtype.countable`
+-- and `quotient.countable`
+@[priority 400] instance [encodable α] : countable α := encode_injective.countable
+
 lemma surjective_decode_iget (α : Type*) [encodable α] [inhabited α] :
   surjective (λ n, (encodable.decode α n).iget) :=
 λ x, ⟨encodable.encode x, by simp_rw [encodable.encodek]⟩
@@ -299,7 +309,7 @@ by cases a; refl
 end subtype
 
 instance _root_.fin.encodable (n) : encodable (fin n) :=
-of_equiv _ (equiv.fin_equiv_subtype _)
+of_equiv _ fin.equiv_subtype
 
 instance _root_.int.encodable : encodable ℤ :=
 of_equiv _ equiv.int_equiv_nat
@@ -319,8 +329,21 @@ of_equiv _ equiv.plift
 noncomputable def of_inj [encodable β] (f : α → β) (hf : injective f) : encodable α :=
 of_left_injection f (partial_inv f) (λ x, (partial_inv_of_injective hf _ _).2 rfl)
 
+/-- If `α` is countable, then it has a (non-canonical) `encodable` structure. -/
+noncomputable def of_countable (α : Type*) [countable α] : encodable α :=
+nonempty.some $ let ⟨f, hf⟩ := exists_injective_nat α in ⟨of_inj f hf⟩
+
+@[simp] lemma nonempty_encodable : nonempty (encodable α) ↔ countable α :=
+⟨λ ⟨h⟩, @encodable.countable α h, λ h, ⟨@of_countable _ h⟩⟩
+
 end encodable
 
+/-- See also `nonempty_fintype`, `nonempty_denumerable`. -/
+lemma nonempty_encodable (α : Type*) [countable α] : nonempty (encodable α) :=
+⟨encodable.of_countable _⟩
+
+instance : countable ℕ+ := subtype.countable -- short-circuit instance search
+
 section ulower
 local attribute [instance, priority 100] encodable.decidable_range_encode
 
diff --git a/src/logic/encodable/lattice.lean b/src/logic/encodable/lattice.lean
index 64e4e66934549..fe4f3fe986991 100644
--- a/src/logic/encodable/lattice.lean
+++ b/src/logic/encodable/lattice.lean
@@ -3,13 +3,15 @@ Copyright (c) 2020 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
-import data.finset.basic
-import data.set.pairwise
 import logic.encodable.basic
+import logic.pairwise
 
 /-!
 # Lattice operations on encodable types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Lemmas about lattice and set operations on encodable types
 
 ## Implementation Notes
@@ -44,21 +46,11 @@ end
 theorem Union_decode₂_disjoint_on {f : β → set α} (hd : pairwise (disjoint on f)) :
   pairwise (disjoint on λ i, ⋃ b ∈ decode₂ β i, f b) :=
 begin
-  rintro i j ij x,
+  rintro i j ij,
+  refine disjoint_left.mpr (λ x, _),
   suffices : ∀ a, encode a = i → x ∈ f a → ∀ b, encode b = j → x ∉ f b, by simpa [decode₂_eq_some],
   rintro a rfl ha b rfl hb,
-  exact hd a b (mt (congr_arg encode) ij) ⟨ha, hb⟩
+  exact (hd (mt (congr_arg encode) ij)).le_bot ⟨ha, hb⟩
 end
 
 end encodable
-
-namespace finset
-
-lemma nonempty_encodable {α} (t : finset α) : nonempty $ encodable {i // i ∈ t} :=
-begin
-  classical, induction t using finset.induction with x t hx ih,
-  { refine ⟨⟨λ _, 0, λ _, none, λ ⟨x,y⟩, y.rec _⟩⟩ },
-  { cases ih with ih, exactI ⟨encodable.of_equiv _ (finset.subtype_insert_equiv_option hx)⟩ }
-end
-
-end finset
diff --git a/src/logic/encodable/small.lean b/src/logic/encodable/small.lean
deleted file mode 100644
index 109d69d35ef6d..0000000000000
--- a/src/logic/encodable/small.lean
+++ /dev/null
@@ -1,19 +0,0 @@
-/-
-Copyright (c) 2021 Scott Morrison. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Scott Morrison
--/
-import logic.encodable.basic
-import logic.small
-
-/-!
-# All encodable types are small.
-
-That is, any encodable type is equivalent to a type in any universe.
--/
-
-universes w v
-
-@[priority 100]
-instance small_of_encodable (α : Type v) [encodable α] : small.{w} α :=
-small_of_injective encodable.encode_injective
diff --git a/src/logic/equiv/array.lean b/src/logic/equiv/array.lean
new file mode 100644
index 0000000000000..cd709ecf95cbc
--- /dev/null
+++ b/src/logic/equiv/array.lean
@@ -0,0 +1,55 @@
+/-
+Copyright (c) 2018 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+import data.vector.basic
+import logic.equiv.list
+import control.traversable.equiv
+
+/-!
+# Equivalences involving `array`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We keep this separate from the file containing `list`-like equivalences as those have no future
+in mathlib4.
+-/
+
+namespace equiv
+
+/-- The natural equivalence between length-`n` heterogeneous arrays
+and dependent functions from `fin n`. -/
+def d_array_equiv_fin {n : ℕ} (α : fin n → Type*) : d_array n α ≃ (Π i, α i) :=
+⟨d_array.read, d_array.mk, λ ⟨f⟩, rfl, λ f, rfl⟩
+
+/-- The natural equivalence between length-`n` arrays and functions from `fin n`. -/
+def array_equiv_fin (n : ℕ) (α : Type*) : array n α ≃ (fin n → α) :=
+d_array_equiv_fin _
+
+/-- The natural equivalence between length-`n` vectors and length-`n` arrays. -/
+def vector_equiv_array (α : Type*) (n : ℕ) : vector α n ≃ array n α :=
+(vector_equiv_fin _ _).trans (array_equiv_fin _ _).symm
+
+end equiv
+
+namespace array
+open function
+variable {n : ℕ}
+
+instance : traversable (array n) :=
+@equiv.traversable (flip vector n) _ (λ α, equiv.vector_equiv_array α n) _
+
+instance : is_lawful_traversable (array n) :=
+@equiv.is_lawful_traversable (flip vector n) _ (λ α, equiv.vector_equiv_array α n) _ _
+
+end array
+
+/-- If `α` is encodable, then so is `array n α`. -/
+instance _root_.array.encodable {α} [encodable α] {n} : encodable (array n α) :=
+encodable.of_equiv _ (equiv.array_equiv_fin _ _)
+
+/-- If `α` is countable, then so is `array n α`. -/
+instance _root_.array.countable {α} [countable α] {n} : countable (array n α) :=
+countable.of_equiv _ (equiv.vector_equiv_array _ _)
diff --git a/src/logic/equiv/basic.lean b/src/logic/equiv/basic.lean
index a6d9144cb6c83..84745166d6e14 100644
--- a/src/logic/equiv/basic.lean
+++ b/src/logic/equiv/basic.lean
@@ -3,35 +3,24 @@ Copyright (c) 2015 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Mario Carneiro
 -/
-import data.fun_like.equiv
+import logic.equiv.defs
 import data.option.basic
-import data.prod
-import data.quot
+import data.prod.basic
 import data.sigma.basic
-import data.sum.basic
 import data.subtype
+import data.sum.basic
 import logic.function.conjugate
-import logic.unique
-import tactic.norm_cast
-import tactic.simps
 
 /-!
 # Equivalence between types
 
-In this file we define two types:
-
-* `equiv α β` a.k.a. `α ≃ β`: a bijective map `α → β` bundled with its inverse map; we use this (and
-  not equality!) to express that various `Type`s or `Sort`s are equivalent.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-* `equiv.perm α`: the group of permutations `α ≃ α`. More lemmas about `equiv.perm` can be found in
-  `group_theory/perm`.
-
-Then we define
+In this file we continue the work on equivalences begun in `logic/equiv/defs.lean`, defining
 
 * canonical isomorphisms between various types: e.g.,
 
-  - `equiv.refl α` is the identity map interpreted as `α ≃ α`;
-
   - `equiv.sum_equiv_sigma_bool` is the canonical equivalence between the sum of two types `α ⊕ β`
     and the sigma-type `Σ b : bool, cond b α β`;
 
@@ -40,21 +29,9 @@ Then we define
 
 * operations on equivalences: e.g.,
 
-  - `equiv.symm e : β ≃ α` is the inverse of `e : α ≃ β`;
-
-  - `equiv.trans e₁ e₂ : α ≃ γ` is the composition of `e₁ : α ≃ β` and `e₂ : β ≃ γ` (note the order
-    of the arguments!);
-
   - `equiv.prod_congr ea eb : α₁ × β₁ ≃ α₂ × β₂`: combine two equivalences `ea : α₁ ≃ α₂` and
     `eb : β₁ ≃ β₂` using `prod.map`.
 
-* definitions that transfer some instances along an equivalence. By convention, we transfer
-  instances from right to left.
-
-  - `equiv.inhabited` takes `e : α ≃ β` and `[inhabited β]` and returns `inhabited α`;
-  - `equiv.unique` takes `e : α ≃ β` and `[unique β]` and returns `unique α`;
-  - `equiv.decidable_eq` takes `e : α ≃ β` and `[decidable_eq β]` and returns `decidable_eq α`.
-
   More definitions of this kind can be found in other files. E.g., `data/equiv/transfer_instance`
   does it for many algebraic type classes like `group`, `module`, etc.
 
@@ -68,328 +45,8 @@ open function
 universes u v w z
 variables {α : Sort u} {β : Sort v} {γ : Sort w}
 
-/-- `α ≃ β` is the type of functions from `α → β` with a two-sided inverse. -/
-@[nolint has_inhabited_instance]
-structure equiv (α : Sort*) (β : Sort*) :=
-(to_fun    : α → β)
-(inv_fun   : β → α)
-(left_inv  : left_inverse inv_fun to_fun)
-(right_inv : right_inverse inv_fun to_fun)
-
-infix ` ≃ `:25 := equiv
-
-instance {F} [equiv_like F α β] : has_coe_t F (α ≃ β) :=
-⟨λ f, { to_fun := f, inv_fun := equiv_like.inv f, left_inv := equiv_like.left_inv f,
-  right_inv := equiv_like.right_inv f }⟩
-
-/-- `perm α` is the type of bijections from `α` to itself. -/
-@[reducible] def equiv.perm (α : Sort*) := equiv α α
-
 namespace equiv
 
-instance : equiv_like (α ≃ β) α β :=
-{ coe := to_fun, inv := inv_fun, left_inv := left_inv, right_inv := right_inv,
-  coe_injective' := λ e₁ e₂ h₁ h₂, by { cases e₁, cases e₂, congr' } }
-
-instance : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨to_fun⟩
-
-@[simp] theorem coe_fn_mk (f : α → β) (g l r) : (equiv.mk f g l r : α → β) = f :=
-rfl
-
-/-- The map `coe_fn : (r ≃ s) → (r → s)` is injective. -/
-theorem coe_fn_injective : @function.injective (α ≃ β) (α → β) coe_fn := fun_like.coe_injective
-protected lemma coe_inj {e₁ e₂ : α ≃ β} : (e₁ : α → β) = e₂ ↔ e₁ = e₂ := fun_like.coe_fn_eq
-@[ext] lemma ext {f g : equiv α β} (H : ∀ x, f x = g x) : f = g := fun_like.ext f g H
-protected lemma congr_arg {f : equiv α β} {x x' : α} : x = x' → f x = f x' := fun_like.congr_arg f
-protected lemma congr_fun {f g : equiv α β} (h : f = g) (x : α) : f x = g x :=
-fun_like.congr_fun h x
-lemma ext_iff {f g : equiv α β} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
-
-@[ext] lemma perm.ext {σ τ : equiv.perm α} (H : ∀ x, σ x = τ x) : σ = τ :=
-equiv.ext H
-
-protected lemma perm.congr_arg {f : equiv.perm α} {x x' : α} : x = x' → f x = f x' :=
-equiv.congr_arg
-
-protected lemma perm.congr_fun {f g : equiv.perm α} (h : f = g) (x : α) : f x = g x :=
-equiv.congr_fun h x
-
-lemma perm.ext_iff {σ τ : equiv.perm α} : σ = τ ↔ ∀ x, σ x = τ x :=
-ext_iff
-
-/-- Any type is equivalent to itself. -/
-@[refl] protected def refl (α : Sort*) : α ≃ α := ⟨id, id, λ x, rfl, λ x, rfl⟩
-
-instance inhabited' : inhabited (α ≃ α) := ⟨equiv.refl α⟩
-
-/-- Inverse of an equivalence `e : α ≃ β`. -/
-@[symm] protected def symm (e : α ≃ β) : β ≃ α := ⟨e.inv_fun, e.to_fun, e.right_inv, e.left_inv⟩
-
-/-- See Note [custom simps projection] -/
-def simps.symm_apply (e : α ≃ β) : β → α := e.symm
-
-initialize_simps_projections equiv (to_fun → apply, inv_fun → symm_apply)
-
-/-- Composition of equivalences `e₁ : α ≃ β` and `e₂ : β ≃ γ`. -/
-@[trans] protected def trans (e₁ : α ≃ β) (e₂ : β ≃ γ) : α ≃ γ :=
-⟨e₂ ∘ e₁, e₁.symm ∘ e₂.symm, e₂.left_inv.comp e₁.left_inv, e₂.right_inv.comp e₁.right_inv⟩
-
-@[simp]
-lemma to_fun_as_coe (e : α ≃ β) : e.to_fun = e := rfl
-
-@[simp]
-lemma inv_fun_as_coe (e : α ≃ β) : e.inv_fun = e.symm := rfl
-
-protected theorem injective (e : α ≃ β) : injective e := equiv_like.injective e
-protected theorem surjective (e : α ≃ β) : surjective e := equiv_like.surjective e
-protected theorem bijective (e : α ≃ β) : bijective e := equiv_like.bijective e
-
-protected theorem subsingleton (e : α ≃ β) [subsingleton β] : subsingleton α :=
-e.injective.subsingleton
-
-protected theorem subsingleton.symm (e : α ≃ β) [subsingleton α] : subsingleton β :=
-e.symm.injective.subsingleton
-
-lemma subsingleton_congr (e : α ≃ β) : subsingleton α ↔ subsingleton β :=
-⟨λ h, by exactI e.symm.subsingleton, λ h, by exactI e.subsingleton⟩
-
-instance equiv_subsingleton_cod [subsingleton β] :
-  subsingleton (α ≃ β) :=
-⟨λ f g, equiv.ext $ λ x, subsingleton.elim _ _⟩
-
-instance equiv_subsingleton_dom [subsingleton α] :
-  subsingleton (α ≃ β) :=
-⟨λ f g, equiv.ext $ λ x, @subsingleton.elim _ (equiv.subsingleton.symm f) _ _⟩
-
-instance perm_unique [subsingleton α] : unique (perm α) :=
-unique_of_subsingleton (equiv.refl α)
-
-lemma perm.subsingleton_eq_refl [subsingleton α] (e : perm α) :
-  e = equiv.refl α := subsingleton.elim _ _
-
-/-- Transfer `decidable_eq` across an equivalence. -/
-protected def decidable_eq (e : α ≃ β) [decidable_eq β] : decidable_eq α :=
-e.injective.decidable_eq
-
-lemma nonempty_congr (e : α ≃ β) : nonempty α ↔ nonempty β :=
-nonempty.congr e e.symm
-
-protected lemma nonempty (e : α ≃ β) [nonempty β] : nonempty α :=
-e.nonempty_congr.mpr ‹_›
-
-/-- If `α ≃ β` and `β` is inhabited, then so is `α`. -/
-protected def inhabited [inhabited β] (e : α ≃ β) : inhabited α :=
-⟨e.symm default⟩
-
-/-- If `α ≃ β` and `β` is a singleton type, then so is `α`. -/
-protected def unique [unique β] (e : α ≃ β) : unique α :=
-e.symm.surjective.unique
-
-/-- Equivalence between equal types. -/
-protected def cast {α β : Sort*} (h : α = β) : α ≃ β :=
-⟨cast h, cast h.symm, λ x, by { cases h, refl }, λ x, by { cases h, refl }⟩
-
-@[simp] theorem coe_fn_symm_mk (f : α → β) (g l r) : ((equiv.mk f g l r).symm : β → α) = g :=
-rfl
-
-@[simp] theorem coe_refl : ⇑(equiv.refl α) = id := rfl
-
-@[simp] theorem perm.coe_subsingleton {α : Type*} [subsingleton α] (e : perm α) : ⇑(e) = id :=
-by rw [perm.subsingleton_eq_refl e, coe_refl]
-
-theorem refl_apply (x : α) : equiv.refl α x = x := rfl
-
-@[simp] theorem coe_trans (f : α ≃ β) (g : β ≃ γ) : ⇑(f.trans g) = g ∘ f := rfl
-
-theorem trans_apply (f : α ≃ β) (g : β ≃ γ) (a : α) : (f.trans g) a = g (f a) := rfl
-
-@[simp] theorem apply_symm_apply  (e : α ≃ β) (x : β) : e (e.symm x) = x :=
-e.right_inv x
-
-@[simp] theorem symm_apply_apply (e : α ≃ β) (x : α) : e.symm (e x) = x :=
-e.left_inv x
-
-@[simp] theorem symm_comp_self (e : α ≃ β) : e.symm ∘ e = id := funext e.symm_apply_apply
-
-@[simp] theorem self_comp_symm (e : α ≃ β) : e ∘ e.symm = id := funext e.apply_symm_apply
-
-@[simp] lemma symm_trans_apply (f : α ≃ β) (g : β ≃ γ) (a : γ) :
-  (f.trans g).symm a = f.symm (g.symm a) := rfl
-
--- The `simp` attribute is needed to make this a `dsimp` lemma.
--- `simp` will always rewrite with `equiv.symm_symm` before this has a chance to fire.
-@[simp, nolint simp_nf] theorem symm_symm_apply (f : α ≃ β) (b : α) : f.symm.symm b = f b := rfl
-
-theorem apply_eq_iff_eq (f : α ≃ β) {x y : α} : f x = f y ↔ x = y := equiv_like.apply_eq_iff_eq f
-
-theorem apply_eq_iff_eq_symm_apply {α β : Sort*} (f : α ≃ β) {x : α} {y : β} :
-  f x = y ↔ x = f.symm y :=
-begin
-  conv_lhs { rw ←apply_symm_apply f y, },
-  rw apply_eq_iff_eq,
-end
-
-@[simp] theorem cast_apply {α β} (h : α = β) (x : α) : equiv.cast h x = cast h x := rfl
-
-@[simp] theorem cast_symm {α β} (h : α = β) : (equiv.cast h).symm = equiv.cast h.symm := rfl
-
-@[simp] theorem cast_refl {α} (h : α = α := rfl) : equiv.cast h = equiv.refl α := rfl
-
-@[simp] theorem cast_trans {α β γ} (h : α = β) (h2 : β = γ) :
-  (equiv.cast h).trans (equiv.cast h2) = equiv.cast (h.trans h2) :=
-ext $ λ x, by { substs h h2, refl }
-
-lemma cast_eq_iff_heq {α β} (h : α = β) {a : α} {b : β} : equiv.cast h a = b ↔ a == b :=
-by { subst h, simp }
-
-lemma symm_apply_eq {α β} (e : α ≃ β) {x y} : e.symm x = y ↔ x = e y :=
-⟨λ H, by simp [H.symm], λ H, by simp [H]⟩
-
-lemma eq_symm_apply {α β} (e : α ≃ β) {x y} : y = e.symm x ↔ e y = x :=
-(eq_comm.trans e.symm_apply_eq).trans eq_comm
-
-@[simp] theorem symm_symm (e : α ≃ β) : e.symm.symm = e := by { cases e, refl }
-
-@[simp] theorem trans_refl (e : α ≃ β) : e.trans (equiv.refl β) = e := by { cases e, refl }
-
-@[simp] theorem refl_symm : (equiv.refl α).symm = equiv.refl α := rfl
-
-@[simp] theorem refl_trans (e : α ≃ β) : (equiv.refl α).trans e = e := by { cases e, refl }
-
-@[simp] theorem symm_trans_self (e : α ≃ β) : e.symm.trans e = equiv.refl β := ext (by simp)
-
-@[simp] theorem self_trans_symm (e : α ≃ β) : e.trans e.symm = equiv.refl α := ext (by simp)
-
-lemma trans_assoc {δ} (ab : α ≃ β) (bc : β ≃ γ) (cd : γ ≃ δ) :
-  (ab.trans bc).trans cd = ab.trans (bc.trans cd) :=
-equiv.ext $ assume a, rfl
-
-theorem left_inverse_symm (f : equiv α β) : left_inverse f.symm f := f.left_inv
-
-theorem right_inverse_symm (f : equiv α β) : function.right_inverse f.symm f := f.right_inv
-
-lemma injective_comp (e : α ≃ β) (f : β → γ) : injective (f ∘ e) ↔ injective f :=
-equiv_like.injective_comp e f
-
-lemma comp_injective (f : α → β) (e : β ≃ γ) : injective (e ∘ f) ↔ injective f :=
-equiv_like.comp_injective f e
-
-lemma surjective_comp (e : α ≃ β) (f : β → γ) : surjective (f ∘ e) ↔ surjective f :=
-equiv_like.surjective_comp e f
-
-lemma comp_surjective (f : α → β) (e : β ≃ γ) : surjective (e ∘ f) ↔ surjective f :=
-equiv_like.comp_surjective f e
-
-lemma bijective_comp (e : α ≃ β) (f : β → γ) : bijective (f ∘ e) ↔ bijective f :=
-equiv_like.bijective_comp e f
-
-lemma comp_bijective (f : α → β) (e : β ≃ γ) : bijective (e ∘ f) ↔ bijective f :=
-equiv_like.comp_bijective f e
-
-/-- If `α` is equivalent to `β` and `γ` is equivalent to `δ`, then the type of equivalences `α ≃ γ`
-is equivalent to the type of equivalences `β ≃ δ`. -/
-def equiv_congr {δ} (ab : α ≃ β) (cd : γ ≃ δ) : (α ≃ γ) ≃ (β ≃ δ) :=
-⟨ λac, (ab.symm.trans ac).trans cd, λbd, ab.trans $ bd.trans $ cd.symm,
-  assume ac, by { ext x, simp }, assume ac, by { ext x, simp } ⟩
-
-@[simp] lemma equiv_congr_refl {α β} :
-  (equiv.refl α).equiv_congr (equiv.refl β) = equiv.refl (α ≃ β) := by { ext, refl }
-
-@[simp] lemma equiv_congr_symm {δ} (ab : α ≃ β) (cd : γ ≃ δ) :
-  (ab.equiv_congr cd).symm = ab.symm.equiv_congr cd.symm := by { ext, refl }
-
-@[simp] lemma equiv_congr_trans {δ ε ζ} (ab : α ≃ β) (de : δ ≃ ε) (bc : β ≃ γ) (ef : ε ≃ ζ) :
-  (ab.equiv_congr de).trans (bc.equiv_congr ef) = (ab.trans bc).equiv_congr (de.trans ef) :=
-by { ext, refl }
-
-@[simp] lemma equiv_congr_refl_left {α β γ} (bg : β ≃ γ) (e : α ≃ β) :
-  (equiv.refl α).equiv_congr bg e = e.trans bg := rfl
-
-@[simp] lemma equiv_congr_refl_right {α β} (ab e : α ≃ β) :
-  ab.equiv_congr (equiv.refl β) e = ab.symm.trans e := rfl
-
-@[simp] lemma equiv_congr_apply_apply {δ} (ab : α ≃ β) (cd : γ ≃ δ) (e : α ≃ γ) (x) :
-  ab.equiv_congr cd e x = cd (e (ab.symm x)) := rfl
-
-section perm_congr
-
-variables {α' β' : Type*} (e : α' ≃ β')
-
-/-- If `α` is equivalent to `β`, then `perm α` is equivalent to `perm β`. -/
-def perm_congr : perm α' ≃ perm β' :=
-equiv_congr e e
-
-lemma perm_congr_def (p : equiv.perm α') :
-  e.perm_congr p = (e.symm.trans p).trans e := rfl
-
-@[simp] lemma perm_congr_refl :
-  e.perm_congr (equiv.refl _) = equiv.refl _ :=
-by simp [perm_congr_def]
-
-@[simp] lemma perm_congr_symm :
-  e.perm_congr.symm = e.symm.perm_congr := rfl
-
-@[simp] lemma perm_congr_apply (p : equiv.perm α') (x) :
-  e.perm_congr p x = e (p (e.symm x)) := rfl
-
-lemma perm_congr_symm_apply (p : equiv.perm β') (x) :
-  e.perm_congr.symm p x = e.symm (p (e x)) := rfl
-
-lemma perm_congr_trans (p p' : equiv.perm α') :
-  (e.perm_congr p).trans (e.perm_congr p') = e.perm_congr (p.trans p') :=
-by { ext, simp }
-
-end perm_congr
-
-/-- If `α` is an empty type, then it is equivalent to the `empty` type. -/
-def equiv_empty (α : Sort u) [is_empty α] : α ≃ empty :=
-⟨is_empty_elim, λ e, e.rec _, is_empty_elim, λ e, e.rec _⟩
-
-/-- `α` is equivalent to an empty type iff `α` is empty. -/
-def equiv_empty_equiv (α : Sort u) : (α ≃ empty) ≃ is_empty α :=
-⟨λ e, function.is_empty e, @equiv_empty α, λ e, ext $ λ x, (e x).elim, λ p, rfl⟩
-
-/-- `false` is equivalent to `empty`. -/
-def false_equiv_empty : false ≃ empty :=
-equiv_empty _
-
-/-- If `α` is an empty type, then it is equivalent to the `pempty` type in any universe. -/
-def {u' v'} equiv_pempty (α : Sort v') [is_empty α] : α ≃ pempty.{u'} :=
-⟨is_empty_elim, λ e, e.rec _, is_empty_elim, λ e, e.rec _⟩
-
-/-- `false` is equivalent to `pempty`. -/
-def false_equiv_pempty : false ≃ pempty :=
-equiv_pempty _
-
-/-- `empty` is equivalent to `pempty`. -/
-def empty_equiv_pempty : empty ≃ pempty :=
-equiv_pempty _
-
-/-- `pempty` types from any two universes are equivalent. -/
-def pempty_equiv_pempty : pempty.{v} ≃ pempty.{w} :=
-equiv_pempty _
-
-/-- The `Sort` of proofs of a true proposition is equivalent to `punit`. -/
-def prop_equiv_punit {p : Prop} (h : p) : p ≃ punit :=
-⟨λ x, (), λ x, h, λ _, rfl, λ ⟨⟩, rfl⟩
-
-/-- The `Sort` of proofs of a false proposition is equivalent to `pempty`. -/
-def prop_equiv_pempty {p : Prop} (h : ¬p) : p ≃ pempty :=
-⟨λ x, absurd x h, λ x, by cases x, λ x, absurd x h, λ x, by cases x⟩
-
-/-- `true` is equivalent to `punit`. -/
-def true_equiv_punit : true ≃ punit := prop_equiv_punit trivial
-
-/-- `ulift α` is equivalent to `α`. -/
-@[simps apply symm_apply {fully_applied := ff}]
-protected def ulift {α : Type v} : ulift.{u} α ≃ α :=
-⟨ulift.down, ulift.up, ulift.up_down, λ a, rfl⟩
-
-/-- `plift α` is equivalent to `α`. -/
-@[simps apply symm_apply {fully_applied := ff}]
-protected def plift : plift α ≃ α :=
-⟨plift.down, plift.up, plift.up_down, plift.down_up⟩
-
 /-- `pprod α β` is equivalent to `α × β` -/
 @[simps apply symm_apply]
 def pprod_equiv_prod {α β : Type*} : pprod α β ≃ α × β :=
@@ -398,173 +55,35 @@ def pprod_equiv_prod {α β : Type*} : pprod α β ≃ α × β :=
   left_inv := λ ⟨x, y⟩, rfl,
   right_inv := λ ⟨x, y⟩, rfl }
 
-/-- equivalence of propositions is the same as iff -/
-def of_iff {P Q : Prop} (h : P ↔ Q) : P ≃ Q :=
-{ to_fun := h.mp,
-  inv_fun := h.mpr,
-  left_inv := λ x, rfl,
-  right_inv := λ y, rfl }
-
-/-- If `α₁` is equivalent to `α₂` and `β₁` is equivalent to `β₂`, then the type of maps `α₁ → β₁`
-is equivalent to the type of maps `α₂ → β₂`. -/
-@[congr, simps apply] def arrow_congr {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
-  (α₁ → β₁) ≃ (α₂ → β₂) :=
-{ to_fun := λ f, e₂ ∘ f ∘ e₁.symm,
-  inv_fun := λ f, e₂.symm ∘ f ∘ e₁,
-  left_inv := λ f, funext $ λ x, by simp,
-  right_inv := λ f, funext $ λ x, by simp }
-
-lemma arrow_congr_comp {α₁ β₁ γ₁ α₂ β₂ γ₂ : Sort*}
-  (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) (ec : γ₁ ≃ γ₂) (f : α₁ → β₁) (g : β₁ → γ₁) :
-  arrow_congr ea ec (g ∘ f) = (arrow_congr eb ec g) ∘ (arrow_congr ea eb f) :=
-by { ext, simp only [comp, arrow_congr_apply, eb.symm_apply_apply] }
-
-@[simp] lemma arrow_congr_refl {α β : Sort*} :
-  arrow_congr (equiv.refl α) (equiv.refl β) = equiv.refl (α → β) := rfl
-
-@[simp] lemma arrow_congr_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Sort*}
-  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
-  arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') :=
-rfl
-
-@[simp] lemma arrow_congr_symm {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
-  (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm :=
-rfl
-
-/--
-A version of `equiv.arrow_congr` in `Type`, rather than `Sort`.
-
-The `equiv_rw` tactic is not able to use the default `Sort` level `equiv.arrow_congr`,
-because Lean's universe rules will not unify `?l_1` with `imax (1 ?m_1)`.
--/
+/-- Product of two equivalences, in terms of `pprod`. If `α ≃ β` and `γ ≃ δ`, then
+`pprod α γ ≃ pprod β δ`. -/
 @[congr, simps apply]
-def arrow_congr' {α₁ β₁ α₂ β₂ : Type*} (hα : α₁ ≃ α₂) (hβ : β₁ ≃ β₂) : (α₁ → β₁) ≃ (α₂ → β₂) :=
-equiv.arrow_congr hα hβ
-
-@[simp] lemma arrow_congr'_refl {α β : Type*} :
-  arrow_congr' (equiv.refl α) (equiv.refl β) = equiv.refl (α → β) := rfl
-
-@[simp] lemma arrow_congr'_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Type*}
-  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
-  arrow_congr' (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr' e₁ e₁').trans (arrow_congr' e₂ e₂') :=
-rfl
-
-@[simp] lemma arrow_congr'_symm {α₁ β₁ α₂ β₂ : Type*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
-  (arrow_congr' e₁ e₂).symm = arrow_congr' e₁.symm e₂.symm :=
-rfl
-
-/-- Conjugate a map `f : α → α` by an equivalence `α ≃ β`. -/
-@[simps apply]
-def conj (e : α ≃ β) : (α → α) ≃ (β → β) := arrow_congr e e
-
-@[simp] lemma conj_refl : conj (equiv.refl α) = equiv.refl (α → α) := rfl
-
-@[simp] lemma conj_symm (e : α ≃ β) : e.conj.symm = e.symm.conj := rfl
-
-@[simp] lemma conj_trans (e₁ : α ≃ β) (e₂ : β ≃ γ) :
-  (e₁.trans e₂).conj = e₁.conj.trans e₂.conj :=
-rfl
-
--- This should not be a simp lemma as long as `(∘)` is reducible:
--- when `(∘)` is reducible, Lean can unify `f₁ ∘ f₂` with any `g` using
--- `f₁ := g` and `f₂ := λ x, x`.  This causes nontermination.
-lemma conj_comp (e : α ≃ β) (f₁ f₂ : α → α) :
-  e.conj (f₁ ∘ f₂) = (e.conj f₁) ∘ (e.conj f₂) :=
-by apply arrow_congr_comp
-
-lemma eq_comp_symm {α β γ} (e : α ≃ β) (f : β → γ) (g : α → γ) :
-  f = g ∘ e.symm ↔ f ∘ e = g :=
-(e.arrow_congr (equiv.refl γ)).symm_apply_eq.symm
-
-lemma comp_symm_eq {α β γ} (e : α ≃ β) (f : β → γ) (g : α → γ) :
-  g ∘ e.symm = f ↔ g = f ∘ e :=
-(e.arrow_congr (equiv.refl γ)).eq_symm_apply.symm
-
-lemma eq_symm_comp {α β γ} (e : α ≃ β) (f : γ → α) (g : γ → β) :
-  f = e.symm ∘ g ↔ e ∘ f = g :=
-((equiv.refl γ).arrow_congr e).eq_symm_apply
-
-lemma symm_comp_eq {α β γ} (e : α ≃ β) (f : γ → α) (g : γ → β) :
-  e.symm ∘ g = f ↔ g = e ∘ f :=
-((equiv.refl γ).arrow_congr e).symm_apply_eq
-
-section binary_op
+def pprod_congr {δ : Sort z} (e₁ : α ≃ β) (e₂ : γ ≃ δ) : pprod α γ ≃ pprod β δ :=
+{ to_fun := λ x, ⟨e₁ x.1, e₂ x.2⟩,
+  inv_fun := λ x, ⟨e₁.symm x.1, e₂.symm x.2⟩,
+  left_inv := λ ⟨x, y⟩, by simp,
+  right_inv := λ ⟨x, y⟩, by simp }
 
-variables {α₁ β₁ : Type*} (e : α₁ ≃ β₁) (f : α₁ → α₁ → α₁)
-
-lemma semiconj_conj (f : α₁ → α₁) : semiconj e f (e.conj f) := λ x, by simp
-
-lemma semiconj₂_conj : semiconj₂ e f (e.arrow_congr e.conj f) := λ x y, by simp
-
-instance [is_associative α₁ f] :
-  is_associative β₁ (e.arrow_congr (e.arrow_congr e) f) :=
-(e.semiconj₂_conj f).is_associative_right e.surjective
-
-instance [is_idempotent α₁ f] :
-  is_idempotent β₁ (e.arrow_congr (e.arrow_congr e) f) :=
-(e.semiconj₂_conj f).is_idempotent_right e.surjective
-
-instance [is_left_cancel α₁ f] :
-  is_left_cancel β₁ (e.arrow_congr (e.arrow_congr e) f) :=
-⟨e.surjective.forall₃.2 $ λ x y z, by simpa using @is_left_cancel.left_cancel _ f _ x y z⟩
-
-instance [is_right_cancel α₁ f] :
-  is_right_cancel β₁ (e.arrow_congr (e.arrow_congr e) f) :=
-⟨e.surjective.forall₃.2 $ λ x y z, by simpa using @is_right_cancel.right_cancel _ f _ x y z⟩
-
-end binary_op
-
-/-- `punit` sorts in any two universes are equivalent. -/
-def punit_equiv_punit : punit.{v} ≃ punit.{w} :=
-⟨λ _, punit.star, λ _, punit.star, λ u, by { cases u, refl }, λ u, by { cases u, reflexivity }⟩
-
-section
-/-- The sort of maps to `punit.{v}` is equivalent to `punit.{w}`. -/
-def arrow_punit_equiv_punit (α : Sort*) : (α → punit.{v}) ≃ punit.{w} :=
-⟨λ f, punit.star, λ u f, punit.star,
-  λ f, by { funext x, cases f x, refl }, λ u, by { cases u, reflexivity }⟩
-
-/-- If `α` is `subsingleton` and `a : α`, then the type of dependent functions `Π (i : α), β
-i` is equivalent to `β i`. -/
-@[simps]
-def Pi_subsingleton {α} (β : α → Sort*) [subsingleton α] (a : α) : (Π a', β a') ≃ β a :=
-{ to_fun := eval a,
-  inv_fun := λ x b, cast (congr_arg β $ subsingleton.elim a b) x,
-  left_inv := λ f, funext $ λ b, by { rw subsingleton.elim b a, reflexivity },
-  right_inv := λ b, rfl }
-
-/-- If `α` has a unique term, then the type of function `α → β` is equivalent to `β`. -/
-@[simps { fully_applied := ff }] def fun_unique (α β) [unique α] : (α → β) ≃ β :=
-Pi_subsingleton _ default
-
-/-- The sort of maps from `punit` is equivalent to the codomain. -/
-def punit_arrow_equiv (α : Sort*) : (punit.{u} → α) ≃ α :=
-fun_unique _ _
-
-/-- The sort of maps from `true` is equivalent to the codomain. -/
-def true_arrow_equiv (α : Sort*) : (true → α) ≃ α :=
-fun_unique _ _
-
-/-- The sort of maps from a type that `is_empty` is equivalent to `punit`. -/
-def arrow_punit_of_is_empty (α β : Sort*) [is_empty α] : (α → β) ≃ punit.{u} :=
-⟨λ f, punit.star, λ u, is_empty_elim, λ f, funext is_empty_elim, λ u, by { cases u, refl }⟩
-
-/-- The sort of maps from `empty` is equivalent to `punit`. -/
-def empty_arrow_equiv_punit (α : Sort*) : (empty → α) ≃ punit.{u} :=
-arrow_punit_of_is_empty _ _
-
-/-- The sort of maps from `pempty` is equivalent to `punit`. -/
-def pempty_arrow_equiv_punit (α : Sort*) : (pempty → α) ≃ punit.{u} :=
-arrow_punit_of_is_empty _ _
+/-- Combine two equivalences using `pprod` in the domain and `prod` in the codomain. -/
+@[simps apply symm_apply]
+def pprod_prod {α₁ β₁ : Sort*} {α₂ β₂ : Type*} (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) :
+  pprod α₁ β₁ ≃ α₂ × β₂ :=
+(ea.pprod_congr eb).trans pprod_equiv_prod
 
-/-- The sort of maps from `false` is equivalent to `punit`. -/
-def false_arrow_equiv_punit (α : Sort*) : (false → α) ≃ punit.{u} :=
-arrow_punit_of_is_empty _ _
+/-- Combine two equivalences using `pprod` in the codomain and `prod` in the domain. -/
+@[simps apply symm_apply]
+def prod_pprod {α₁ β₁ : Type*} {α₂ β₂ : Sort*} (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) :
+  α₁ × β₁ ≃ pprod α₂ β₂ :=
+(ea.symm.pprod_prod eb.symm).symm
 
-end
+/-- `pprod α β` is equivalent to `plift α × plift β` -/
+@[simps apply symm_apply]
+def pprod_equiv_prod_plift {α β : Sort*} : pprod α β ≃ plift α × plift β :=
+equiv.plift.symm.pprod_prod equiv.plift.symm
 
-/-- Product of two equivalences. If `α₁ ≃ α₂` and `β₁ ≃ β₂`, then `α₁ × β₁ ≃ α₂ × β₂`. -/
-@[congr, simps apply]
+/-- Product of two equivalences. If `α₁ ≃ α₂` and `β₁ ≃ β₂`, then `α₁ × β₁ ≃ α₂ × β₂`. This is
+`prod.map` as an equivalence. -/
+@[congr, simps apply { fully_applied := ff }]
 def prod_congr {α₁ β₁ α₂ β₂ : Type*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) : α₁ × β₁ ≃ α₂ × β₂ :=
 ⟨prod.map e₁ e₂, prod.map e₁.symm e₂.symm, λ ⟨a, b⟩, by simp, λ ⟨a, b⟩, by simp⟩
 
@@ -572,15 +91,30 @@ def prod_congr {α₁ β₁ α₂ β₂ : Type*} (e₁ : α₁ ≃ α₂) (e₂
   (prod_congr e₁ e₂).symm = prod_congr e₁.symm e₂.symm :=
 rfl
 
-/-- Type product is commutative up to an equivalence: `α × β ≃ β × α`. -/
-@[simps apply] def prod_comm (α β : Type*) : α × β ≃ β × α :=
-⟨prod.swap, prod.swap, λ⟨a, b⟩, rfl, λ⟨a, b⟩, rfl⟩
+/-- Type product is commutative up to an equivalence: `α × β ≃ β × α`. This is `prod.swap` as an
+equivalence.-/
+def prod_comm (α β : Type*) : α × β ≃ β × α :=
+⟨prod.swap, prod.swap, prod.swap_swap, prod.swap_swap⟩
+
+@[simp] lemma coe_prod_comm (α β : Type*) : ⇑(prod_comm α β) = prod.swap := rfl
+@[simp] lemma prod_comm_apply {α β : Type*} (x : α × β) : prod_comm α β x = x.swap := rfl
 
 @[simp] lemma prod_comm_symm (α β) : (prod_comm α β).symm = prod_comm β α := rfl
 
 /-- Type product is associative up to an equivalence. -/
 @[simps] def prod_assoc (α β γ : Sort*) : (α × β) × γ ≃ α × (β × γ) :=
-⟨λ p, (p.1.1, p.1.2, p.2), λp, ((p.1, p.2.1), p.2.2), λ ⟨⟨a, b⟩, c⟩, rfl, λ ⟨a, ⟨b, c⟩⟩, rfl⟩
+⟨λ p, (p.1.1, p.1.2, p.2), λ p, ((p.1, p.2.1), p.2.2), λ ⟨⟨a, b⟩, c⟩, rfl, λ ⟨a, ⟨b, c⟩⟩, rfl⟩
+
+/-- Four-way commutativity of `prod`. The name matches `mul_mul_mul_comm`. -/
+@[simps apply]
+def prod_prod_prod_comm (α β γ δ : Type*) : (α × β) × (γ × δ) ≃ (α × γ) × (β × δ) :=
+{ to_fun := λ abcd, ((abcd.1.1, abcd.2.1), (abcd.1.2, abcd.2.2)),
+  inv_fun := λ acbd, ((acbd.1.1, acbd.2.1), (acbd.1.2, acbd.2.2)),
+  left_inv := λ ⟨⟨a, b⟩, ⟨c, d⟩⟩, rfl,
+  right_inv := λ ⟨⟨a, c⟩, ⟨b, d⟩⟩, rfl, }
+
+@[simp] lemma prod_prod_prod_comm_symm (α β γ δ : Type*) :
+  (prod_prod_prod_comm α β γ δ).symm = prod_prod_prod_comm α γ β δ := rfl
 
 /-- Functions on `α × β` are equivalent to functions `α → β → γ`. -/
 @[simps {fully_applied := ff}] def curry (α β γ : Type*) :
@@ -600,6 +134,32 @@ section
 calc punit × α ≃ α × punit : prod_comm _ _
            ... ≃ α         : prod_punit _
 
+/-- Any `unique` type is a right identity for type product up to equivalence. -/
+def prod_unique (α β : Type*) [unique β] : α × β ≃ α :=
+((equiv.refl α).prod_congr $ equiv_punit β).trans $ prod_punit α
+
+@[simp] lemma coe_prod_unique {α β : Type*} [unique β] :
+  ⇑(prod_unique α β) = prod.fst := rfl
+
+lemma prod_unique_apply {α β : Type*} [unique β] (x : α × β) :
+  prod_unique α β x = x.1 := rfl
+
+@[simp] lemma prod_unique_symm_apply {α β : Type*} [unique β] (x : α) :
+  (prod_unique α β).symm x = (x, default) := rfl
+
+/-- Any `unique` type is a left identity for type product up to equivalence. -/
+def unique_prod (α β : Type*) [unique β] : β × α ≃ α :=
+((equiv_punit β).prod_congr $ equiv.refl α).trans $ punit_prod α
+
+@[simp] lemma coe_unique_prod {α β : Type*} [unique β] :
+  ⇑(unique_prod α β) = prod.snd := rfl
+
+lemma unique_prod_apply {α β : Type*} [unique β] (x : β × α) :
+  unique_prod α β x = x.2 := rfl
+
+@[simp] lemma unique_prod_symm_apply {α β : Type*} [unique β] (x : α) :
+  (unique_prod α β).symm x = (default, x) := rfl
+
 /-- `empty` type is a right absorbing element for type product up to an equivalence. -/
 def prod_empty (α : Type*) : α × empty ≃ empty :=
 equiv_empty _
@@ -619,18 +179,34 @@ end
 
 section
 open sum
+
 /-- `psum` is equivalent to `sum`. -/
 def psum_equiv_sum (α β : Type*) : psum α β ≃ α ⊕ β :=
-⟨λ s, psum.cases_on s inl inr,
- λ s, sum.cases_on s psum.inl psum.inr,
- λ s, by cases s; refl,
- λ s, by cases s; refl⟩
+{ to_fun := λ s, psum.cases_on s inl inr,
+  inv_fun := sum.elim psum.inl psum.inr,
+  left_inv := λ s, by cases s; refl,
+  right_inv := λ s, by cases s; refl }
 
-/-- If `α ≃ α'` and `β ≃ β'`, then `α ⊕ β ≃ α' ⊕ β'`. -/
+/-- If `α ≃ α'` and `β ≃ β'`, then `α ⊕ β ≃ α' ⊕ β'`. This is `sum.map` as an equivalence. -/
 @[simps apply]
 def sum_congr {α₁ β₁ α₂ β₂ : Type*} (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) : α₁ ⊕ β₁ ≃ α₂ ⊕ β₂ :=
 ⟨sum.map ea eb, sum.map ea.symm eb.symm, λ x, by simp, λ x, by simp⟩
 
+/-- If `α ≃ α'` and `β ≃ β'`, then `psum α β ≃ psum α' β'`. -/
+def psum_congr {δ : Sort z} (e₁ : α ≃ β) (e₂ : γ ≃ δ) : psum α γ ≃ psum β δ :=
+{ to_fun := λ x, psum.cases_on x (psum.inl ∘ e₁) (psum.inr ∘ e₂),
+  inv_fun := λ x, psum.cases_on x (psum.inl ∘ e₁.symm) (psum.inr ∘ e₂.symm),
+  left_inv := by rintro (x|x); simp,
+  right_inv := by rintro (x|x); simp }
+
+/-- Combine two `equiv`s using `psum` in the domain and `sum` in the codomain. -/
+def psum_sum {α₁ β₁ : Sort*} {α₂ β₂ : Type*} (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) : psum α₁ β₁ ≃ α₂ ⊕ β₂ :=
+(ea.psum_congr eb).trans (psum_equiv_sum _ _)
+
+/-- Combine two `equiv`s using `sum` in the domain and `psum` in the codomain. -/
+def sum_psum {α₁ β₁ : Type*} {α₂ β₂ : Sort*} (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) : α₁ ⊕ β₁ ≃ psum α₂ β₂ :=
+(ea.symm.psum_sum eb.symm).symm
+
 @[simp] lemma sum_congr_trans {α₁ α₂ β₁ β₂ γ₁ γ₂ : Sort*}
   (e : α₁ ≃ β₁) (f : α₂ ≃ β₂) (g : β₁ ≃ γ₁) (h : β₂ ≃ γ₂) :
   (equiv.sum_congr e f).trans (equiv.sum_congr g h) = (equiv.sum_congr (e.trans g) (f.trans h)) :=
@@ -672,17 +248,12 @@ end perm
 /-- `bool` is equivalent the sum of two `punit`s. -/
 def bool_equiv_punit_sum_punit : bool ≃ punit.{u+1} ⊕ punit.{v+1} :=
 ⟨λ b, cond b (inr punit.star) (inl punit.star),
- λ s, sum.rec_on s (λ_, ff) (λ_, tt),
+ sum.elim (λ _, ff) (λ _, tt),
  λ b, by cases b; refl,
  λ s, by rcases s with ⟨⟨⟩⟩ | ⟨⟨⟩⟩; refl⟩
 
-/-- `Prop` is noncomputably equivalent to `bool`. -/
-noncomputable def Prop_equiv_bool : Prop ≃ bool :=
-⟨λ p, @to_bool p (classical.prop_decidable _),
- λ b, b, λ p, by simp, λ b, by simp⟩
-
-/-- Sum of types is commutative up to an equivalence. -/
-@[simps apply]
+/-- Sum of types is commutative up to an equivalence. This is `sum.swap` as an equivalence. -/
+@[simps apply {fully_applied := ff}]
 def sum_comm (α β : Type*) : α ⊕ β ≃ β ⊕ α :=
 ⟨sum.swap, sum.swap, sum.swap_swap, sum.swap_swap⟩
 
@@ -921,6 +492,16 @@ def Pi_congr_right {α} {β₁ β₂ : α → Sort*} (F : Π a, β₁ a ≃ β
 ⟨λ H a, F a (H a), λ H a, (F a).symm (H a),
  λ H, funext $ by simp, λ H, funext $ by simp⟩
 
+/-- Given `φ : α → β → Sort*`, we have an equivalence between `Π a b, φ a b` and `Π b a, φ a b`.
+This is `function.swap` as an `equiv`. -/
+@[simps apply]
+def Pi_comm {α β} (φ : α → β → Sort*) : (Π a b, φ a b) ≃ (Π b a, φ a b) :=
+⟨swap, swap, λ x, rfl, λ y, rfl⟩
+
+@[simp] lemma Pi_comm_symm {α β} {φ : α → β → Sort*} :
+  (Pi_comm φ).symm = (Pi_comm $ swap φ) :=
+rfl
+
 /-- Dependent `curry` equivalence: the type of dependent functions on `Σ i, β i` is equivalent
 to the type of dependent functions of two arguments (i.e., functions to the space of functions).
 
@@ -934,140 +515,6 @@ def Pi_curry {α} {β : α → Sort*} (γ : Π a, β a → Sort*) :
 
 end
 
-section
-/-- A `psigma`-type is equivalent to the corresponding `sigma`-type. -/
-@[simps apply symm_apply] def psigma_equiv_sigma {α} (β : α → Type*) : (Σ' i, β i) ≃ Σ i, β i :=
-⟨λ a, ⟨a.1, a.2⟩, λ a, ⟨a.1, a.2⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩
-
-/-- A family of equivalences `Π a, β₁ a ≃ β₂ a` generates an equivalence between `Σ' a, β₁ a` and
-`Σ' a, β₂ a`. -/
-@[simps apply]
-def psigma_congr_right {α} {β₁ β₂ : α → Sort*} (F : Π a, β₁ a ≃ β₂ a) : (Σ' a, β₁ a) ≃ Σ' a, β₂ a :=
-⟨λ a, ⟨a.1, F a.1 a.2⟩, λ a, ⟨a.1, (F a.1).symm a.2⟩,
- λ ⟨a, b⟩, congr_arg (psigma.mk a) $ symm_apply_apply (F a) b,
- λ ⟨a, b⟩, congr_arg (psigma.mk a) $ apply_symm_apply (F a) b⟩
-
-@[simp] lemma psigma_congr_right_trans {α} {β₁ β₂ β₃ : α → Sort*}
-  (F : Π a, β₁ a ≃ β₂ a) (G : Π a, β₂ a ≃ β₃ a) :
-  (psigma_congr_right F).trans (psigma_congr_right G) =
-    psigma_congr_right (λ a, (F a).trans (G a)) :=
-by { ext1 x, cases x, refl }
-
-@[simp] lemma psigma_congr_right_symm {α} {β₁ β₂ : α → Sort*} (F : Π a, β₁ a ≃ β₂ a) :
-  (psigma_congr_right F).symm = psigma_congr_right (λ a, (F a).symm) :=
-by { ext1 x, cases x, refl }
-
-@[simp] lemma psigma_congr_right_refl {α} {β : α → Sort*} :
-  (psigma_congr_right (λ a, equiv.refl (β a))) = equiv.refl (Σ' a, β a) :=
-by { ext1 x, cases x, refl }
-
-/-- A family of equivalences `Π a, β₁ a ≃ β₂ a` generates an equivalence between `Σ a, β₁ a` and
-`Σ a, β₂ a`. -/
-@[simps apply]
-def sigma_congr_right {α} {β₁ β₂ : α → Type*} (F : Π a, β₁ a ≃ β₂ a) : (Σ a, β₁ a) ≃ Σ a, β₂ a :=
-⟨λ a, ⟨a.1, F a.1 a.2⟩, λ a, ⟨a.1, (F a.1).symm a.2⟩,
- λ ⟨a, b⟩, congr_arg (sigma.mk a) $ symm_apply_apply (F a) b,
- λ ⟨a, b⟩, congr_arg (sigma.mk a) $ apply_symm_apply (F a) b⟩
-
-@[simp] lemma sigma_congr_right_trans {α} {β₁ β₂ β₃ : α → Type*}
-  (F : Π a, β₁ a ≃ β₂ a) (G : Π a, β₂ a ≃ β₃ a) :
-  (sigma_congr_right F).trans (sigma_congr_right G) = sigma_congr_right (λ a, (F a).trans (G a)) :=
-by { ext1 x, cases x, refl }
-
-@[simp] lemma sigma_congr_right_symm {α} {β₁ β₂ : α → Type*} (F : Π a, β₁ a ≃ β₂ a) :
-  (sigma_congr_right F).symm = sigma_congr_right (λ a, (F a).symm) :=
-by { ext1 x, cases x, refl }
-
-@[simp] lemma sigma_congr_right_refl {α} {β : α → Type*} :
-  (sigma_congr_right (λ a, equiv.refl (β a))) = equiv.refl (Σ a, β a) :=
-by { ext1 x, cases x, refl }
-
-/-- A `psigma` with `Prop` fibers is equivalent to the subtype.  -/
-def psigma_equiv_subtype {α : Type v} (P : α → Prop) :
-  (Σ' i, P i) ≃ subtype P :=
-{ to_fun := λ x, ⟨x.1, x.2⟩,
-  inv_fun := λ x, ⟨x.1, x.2⟩,
-  left_inv := λ x, by { cases x, refl, },
-  right_inv := λ x, by { cases x, refl, }, }
-
-/-- A `sigma` with `plift` fibers is equivalent to the subtype. -/
-def sigma_plift_equiv_subtype {α : Type v} (P : α → Prop) :
-  (Σ i, plift (P i)) ≃ subtype P :=
-((psigma_equiv_sigma _).symm.trans (psigma_congr_right (λ a, equiv.plift))).trans
-  (psigma_equiv_subtype P)
-
-/--
-A `sigma` with `λ i, ulift (plift (P i))` fibers is equivalent to `{ x // P x }`.
-Variant of `sigma_plift_equiv_subtype`.
--/
-def sigma_ulift_plift_equiv_subtype {α : Type v} (P : α → Prop) :
-  (Σ i, ulift (plift (P i))) ≃ subtype P :=
-(sigma_congr_right (λ a, equiv.ulift)).trans (sigma_plift_equiv_subtype P)
-
-namespace perm
-
-/-- A family of permutations `Π a, perm (β a)` generates a permuation `perm (Σ a, β₁ a)`. -/
-@[reducible]
-def sigma_congr_right {α} {β : α → Sort*} (F : Π a, perm (β a)) : perm (Σ a, β a) :=
-equiv.sigma_congr_right F
-
-@[simp] lemma sigma_congr_right_trans {α} {β : α → Sort*}
-  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
-  (sigma_congr_right F).trans (sigma_congr_right G) = sigma_congr_right (λ a, (F a).trans (G a)) :=
-equiv.sigma_congr_right_trans F G
-
-@[simp] lemma sigma_congr_right_symm {α} {β : α → Sort*} (F : Π a, perm (β a)) :
-  (sigma_congr_right F).symm = sigma_congr_right (λ a, (F a).symm) :=
-equiv.sigma_congr_right_symm F
-
-@[simp] lemma sigma_congr_right_refl {α} {β : α → Sort*} :
-  (sigma_congr_right (λ a, equiv.refl (β a))) = equiv.refl (Σ a, β a) :=
-equiv.sigma_congr_right_refl
-
-end perm
-
-/-- An equivalence `f : α₁ ≃ α₂` generates an equivalence between `Σ a, β (f a)` and `Σ a, β a`. -/
-@[simps apply]
-def sigma_congr_left {α₁ α₂} {β : α₂ → Sort*} (e : α₁ ≃ α₂) : (Σ a:α₁, β (e a)) ≃ (Σ a:α₂, β a) :=
-⟨λ a, ⟨e a.1, a.2⟩, λ a, ⟨e.symm a.1, @@eq.rec β a.2 (e.right_inv a.1).symm⟩,
- λ ⟨a, b⟩, match e.symm (e a), e.left_inv a : ∀ a' (h : a' = a),
-     @sigma.mk _ (β ∘ e) _ (@@eq.rec β b (congr_arg e h.symm)) = ⟨a, b⟩ with
-   | _, rfl := rfl end,
- λ ⟨a, b⟩, match e (e.symm a), _ : ∀ a' (h : a' = a),
-     sigma.mk a' (@@eq.rec β b h.symm) = ⟨a, b⟩ with
-   | _, rfl := rfl end⟩
-
-/-- Transporting a sigma type through an equivalence of the base -/
-def sigma_congr_left' {α₁ α₂} {β : α₁ → Sort*} (f : α₁ ≃ α₂) :
-  (Σ a:α₁, β a) ≃ (Σ a:α₂, β (f.symm a)) :=
-(sigma_congr_left f.symm).symm
-
-/-- Transporting a sigma type through an equivalence of the base and a family of equivalences
-of matching fibers -/
-def sigma_congr {α₁ α₂} {β₁ : α₁ → Sort*} {β₂ : α₂ → Sort*} (f : α₁ ≃ α₂)
-  (F : ∀ a, β₁ a ≃ β₂ (f a)) :
-  sigma β₁ ≃ sigma β₂ :=
-(sigma_congr_right F).trans (sigma_congr_left f)
-
-/-- `sigma` type with a constant fiber is equivalent to the product. -/
-@[simps apply symm_apply] def sigma_equiv_prod (α β : Type*) : (Σ_:α, β) ≃ α × β :=
-⟨λ a, ⟨a.1, a.2⟩, λ a, ⟨a.1, a.2⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩
-
-/-- If each fiber of a `sigma` type is equivalent to a fixed type, then the sigma type
-is equivalent to the product. -/
-def sigma_equiv_prod_of_equiv {α β} {β₁ : α → Sort*} (F : Π a, β₁ a ≃ β) : sigma β₁ ≃ α × β :=
-(sigma_congr_right F).trans (sigma_equiv_prod α β)
-
-/-- Dependent product of types is associative up to an equivalence. -/
-def sigma_assoc {α : Type*} {β : α → Type*} (γ : Π (a : α), β a → Type*) :
-  (Σ (ab : Σ (a : α), β a), γ ab.1 ab.2) ≃ Σ (a : α), (Σ (b : β a), γ a b) :=
-{ to_fun := λ x, ⟨x.1.1, ⟨x.1.2, x.2⟩⟩,
-  inv_fun := λ x, ⟨⟨x.1, x.2.1⟩, x.2.2⟩,
-  left_inv := λ ⟨⟨a, b⟩, c⟩, rfl,
-  right_inv := λ ⟨a, ⟨b, c⟩⟩, rfl }
-
-end
-
 section prod_congr
 
 variables {α₁ β₁ β₂ : Type*} (e : α₁ → β₁ ≃ β₂)
@@ -1206,15 +653,19 @@ def sum_arrow_equiv_prod_arrow (α β γ : Type*) : ((α ⊕ β) → γ) ≃ (α
 
 /-- Type product is right distributive with respect to type sum up to an equivalence. -/
 def sum_prod_distrib (α β γ : Sort*) : (α ⊕ β) × γ ≃ (α × γ) ⊕ (β × γ) :=
-⟨λ p, match p with (inl a, c) := inl (a, c) | (inr b, c) := inr (b, c) end,
- λ s, match s with inl q := (inl q.1, q.2) | inr q := (inr q.1, q.2) end,
- λ p, by rcases p with ⟨_ | _, _⟩; refl,
- λ s, by rcases s with ⟨_, _⟩ | ⟨_, _⟩; refl⟩
+⟨λ p, p.1.map (λ x, (x, p.2)) (λ x, (x, p.2)),
+ λ s, s.elim (prod.map inl id) (prod.map inr id),
+ by rintro ⟨_ | _, _⟩; refl,
+ by rintro (⟨_, _⟩ | ⟨_, _⟩); refl⟩
 
 @[simp] theorem sum_prod_distrib_apply_left {α β γ} (a : α) (c : γ) :
    sum_prod_distrib α β γ (sum.inl a, c) = sum.inl (a, c) := rfl
 @[simp] theorem sum_prod_distrib_apply_right {α β γ} (b : β) (c : γ) :
    sum_prod_distrib α β γ (sum.inr b, c) = sum.inr (b, c) := rfl
+@[simp] theorem sum_prod_distrib_symm_apply_left {α β γ} (a : α × γ) :
+  (sum_prod_distrib α β γ).symm (inl a) = (inl a.1, a.2) := rfl
+@[simp] theorem sum_prod_distrib_symm_apply_right {α β γ} (b : β × γ) :
+  (sum_prod_distrib α β γ).symm (inr b) = (inr b.1, b.2) := rfl
 
 /-- Type product is left distributive with respect to type sum up to an equivalence. -/
 def prod_sum_distrib (α β γ : Sort*) : α × (β ⊕ γ) ≃ (α × β) ⊕ (α × γ) :=
@@ -1226,11 +677,15 @@ calc α × (β ⊕ γ) ≃ (β ⊕ γ) × α       : prod_comm _ _
    prod_sum_distrib α β γ (a, sum.inl b) = sum.inl (a, b) := rfl
 @[simp] theorem prod_sum_distrib_apply_right {α β γ} (a : α) (c : γ) :
    prod_sum_distrib α β γ (a, sum.inr c) = sum.inr (a, c) := rfl
+@[simp] theorem prod_sum_distrib_symm_apply_left {α β γ} (a : α × β) :
+  (prod_sum_distrib α β γ).symm (inl a) = (a.1, inl a.2) := rfl
+@[simp] theorem prod_sum_distrib_symm_apply_right {α β γ} (a : α × γ) :
+  (prod_sum_distrib α β γ).symm (inr a) = (a.1, inr a.2) := rfl
 
 /-- An indexed sum of disjoint sums of types is equivalent to the sum of the indexed sums. -/
 @[simps] def sigma_sum_distrib {ι : Type*} (α β : ι → Type*) :
   (Σ i, α i ⊕ β i) ≃ (Σ i, α i) ⊕ Σ i, β i :=
-⟨λ p, sum.cases_on p.2 (λ x, sum.inl ⟨_, x⟩) (λ x, sum.inr ⟨_, x⟩),
+⟨λ p, p.2.map (sigma.mk p.1) (sigma.mk p.1),
   sum.elim (sigma.map id (λ _, sum.inl)) (sigma.map id (λ _, sum.inr)),
   λ p, by { rcases p with ⟨i, (a | b)⟩; refl },
   λ p, by { rcases p with (⟨i, a⟩ | ⟨i, b⟩); refl }⟩
@@ -1244,11 +699,20 @@ def sigma_prod_distrib {ι : Type*} (α : ι → Type*) (β : Type*) :
  λ p, by { rcases p with ⟨⟨_, _⟩, _⟩, refl },
  λ p, by { rcases p with ⟨_, ⟨_, _⟩⟩, refl }⟩
 
+/-- An equivalence that separates out the 0th fiber of `(Σ (n : ℕ), f n)`. -/
+def sigma_nat_succ (f : ℕ → Type u) :
+  (Σ n, f n) ≃ f 0 ⊕ Σ n, f (n + 1) :=
+⟨λ x, @sigma.cases_on ℕ f (λ _, f 0 ⊕ Σ n, f (n + 1)) x (λ n, @nat.cases_on (λ i, f i → (f 0 ⊕
+  Σ (n : ℕ), f (n + 1))) n (λ (x : f 0), sum.inl x) (λ (n : ℕ) (x : f n.succ), sum.inr ⟨n, x⟩)),
+  sum.elim (sigma.mk 0) (sigma.map nat.succ (λ _, id)),
+  by { rintro ⟨(n | n), x⟩; refl }, by { rintro (x | ⟨n, x⟩); refl }⟩
+
 /-- The product `bool × α` is equivalent to `α ⊕ α`. -/
-def bool_prod_equiv_sum (α : Type u) : bool × α ≃ α ⊕ α :=
-calc bool × α ≃ (unit ⊕ unit) × α       : prod_congr bool_equiv_punit_sum_punit (equiv.refl _)
-      ...     ≃ (unit × α) ⊕ (unit × α) : sum_prod_distrib _ _ _
-      ...     ≃ α ⊕ α                   : sum_congr (punit_prod _) (punit_prod _)
+@[simps] def bool_prod_equiv_sum (α : Type u) : bool × α ≃ α ⊕ α :=
+{ to_fun := λ p, cond p.1 (inr p.2) (inl p.2),
+  inv_fun := sum.elim (prod.mk ff) (prod.mk tt),
+  left_inv := by rintro ⟨(_|_), _⟩; refl,
+  right_inv := by rintro (_|_); refl }
 
 /-- The function type `bool → α` is equivalent to `α × α`. -/
 @[simps] def bool_arrow_equiv_prod (α : Type u) : (bool → α) ≃ α × α :=
@@ -1263,10 +727,10 @@ section
 open sum nat
 /-- The set of natural numbers is equivalent to `ℕ ⊕ punit`. -/
 def nat_equiv_nat_sum_punit : ℕ ≃ ℕ ⊕ punit.{u+1} :=
-⟨λ n, match n with zero := inr punit.star | succ a := inl a end,
- λ s, match s with inl n := succ n | inr punit.star := zero end,
- λ n, begin cases n, repeat { refl } end,
- λ s, begin cases s with a u, { refl }, {cases u, { refl }} end⟩
+{ to_fun := λ n, nat.cases_on n (inr punit.star) inl,
+  inv_fun := sum.elim nat.succ (λ _, 0),
+  left_inv := λ n, by cases n; refl,
+  right_inv := by rintro (_|_|_); refl }
 
 /-- `ℕ ⊕ punit` is equivalent to `ℕ`. -/
 def nat_sum_punit_equiv_nat : ℕ ⊕ punit.{u+1} ≃ ℕ :=
@@ -1274,7 +738,10 @@ nat_equiv_nat_sum_punit.symm
 
 /-- The type of integer numbers is equivalent to `ℕ ⊕ ℕ`. -/
 def int_equiv_nat_sum_nat : ℤ ≃ ℕ ⊕ ℕ :=
-by refine ⟨_, _, _, _⟩; intro z; {cases z; [left, right]; assumption} <|> {cases z; refl}
+{ to_fun := λ z, int.cases_on z inl inr,
+  inv_fun := sum.elim coe int.neg_succ_of_nat,
+  left_inv := by rintro (m|n); refl,
+  right_inv := by rintro (m|n); refl }
 
 end
 
@@ -1285,10 +752,6 @@ def list_equiv_of_equiv {α β : Type*} (e : α ≃ β) : list α ≃ list β :=
   left_inv := λ l, by rw [list.map_map, e.symm_comp_self, list.map_id],
   right_inv := λ l, by rw [list.map_map, e.self_comp_symm, list.map_id] }
 
-/-- `fin n` is equivalent to `{m // m < n}`. -/
-def fin_equiv_subtype (n : ℕ) : fin n ≃ {m // m < n} :=
-⟨λ x, ⟨x.1, x.2⟩, λ x, ⟨x.1, x.2⟩, λ ⟨a, b⟩, rfl,λ ⟨a, b⟩, rfl⟩
-
 /-- If `α` is equivalent to `β`, then `unique α` is equivalent to `unique β`. -/
 def unique_congr (e : α ≃ β) : unique α ≃ unique β :=
 { to_fun := λ h, @equiv.unique _ _ h e.symm,
@@ -1311,10 +774,10 @@ at corresponding points, then `{a // p a}` is equivalent to `{b // q b}`.
 For the statement where `α = β`, that is, `e : perm α`, see `perm.subtype_perm`. -/
 def subtype_equiv {p : α → Prop} {q : β → Prop}
   (e : α ≃ β) (h : ∀ a, p a ↔ q (e a)) : {a : α // p a} ≃ {b : β // q b} :=
-⟨λ x, ⟨e x, (h _).1 x.2⟩,
- λ y, ⟨e.symm y, (h _).2 (by { simp, exact y.2 })⟩,
- λ ⟨x, h⟩, subtype.ext_val $ by simp,
- λ ⟨y, h⟩, subtype.ext_val $ by simp⟩
+{ to_fun    := λ a, ⟨e a, (h _).mp a.prop⟩,
+  inv_fun   := λ b, ⟨e.symm b, (h _).mpr ((e.apply_symm_apply b).symm ▸ b.prop)⟩,
+  left_inv  := λ a, subtype.ext $ by simp,
+  right_inv := λ b, subtype.ext $ by simp }
 
 @[simp] lemma subtype_equiv_refl {p : α → Prop}
   (h : ∀ a, p a ↔ p (equiv.refl _ a) := λ a, iff.rfl) :
@@ -1359,44 +822,30 @@ def subtype_equiv_of_subtype' {p : α → Prop} (e : α ≃ β) :
 e.symm.subtype_equiv_of_subtype.symm
 
 /-- If two predicates are equal, then the corresponding subtypes are equivalent. -/
-def subtype_equiv_prop {α : Type*} {p q : α → Prop} (h : p = q) : subtype p ≃ subtype q :=
+def subtype_equiv_prop {α : Sort*} {p q : α → Prop} (h : p = q) : subtype p ≃ subtype q :=
 subtype_equiv (equiv.refl α) (assume a, h ▸ iff.rfl)
 
 /-- A subtype of a subtype is equivalent to the subtype of elements satisfying both predicates. This
 version allows the “inner” predicate to depend on `h : p a`. -/
-def subtype_subtype_equiv_subtype_exists {α : Type u} (p : α → Prop) (q : subtype p → Prop) :
+@[simps]
+def subtype_subtype_equiv_subtype_exists {α : Sort u} (p : α → Prop) (q : subtype p → Prop) :
   subtype q ≃ {a : α // ∃h:p a, q ⟨a, h⟩ } :=
-⟨λ⟨⟨a, ha⟩, ha'⟩, ⟨a, ha, ha'⟩,
-  λ⟨a, ha⟩, ⟨⟨a, ha.cases_on $ assume h _, h⟩, by { cases ha, exact ha_h }⟩,
+⟨λ a, ⟨a, a.1.2, by { rcases a with ⟨⟨a, hap⟩, haq⟩, exact haq }⟩,
+  λ a, ⟨⟨a, a.2.fst⟩, a.2.snd⟩,
   assume ⟨⟨a, ha⟩, h⟩, rfl, assume ⟨a, h₁, h₂⟩, rfl⟩
 
-@[simp] lemma subtype_subtype_equiv_subtype_exists_apply {α : Type u} (p : α → Prop)
-  (q : subtype p → Prop) (a) : (subtype_subtype_equiv_subtype_exists p q a : α) = a :=
-by { cases a, cases a_val, refl }
-
 /-- A subtype of a subtype is equivalent to the subtype of elements satisfying both predicates. -/
-def subtype_subtype_equiv_subtype_inter {α : Type u} (p q : α → Prop) :
+@[simps] def subtype_subtype_equiv_subtype_inter {α : Sort u} (p q : α → Prop) :
   {x : subtype p // q x.1} ≃ subtype (λ x, p x ∧ q x) :=
 (subtype_subtype_equiv_subtype_exists p _).trans $
 subtype_equiv_right $ λ x, exists_prop
 
-@[simp] lemma subtype_subtype_equiv_subtype_inter_apply {α : Type u} (p q : α → Prop) (a) :
-  (subtype_subtype_equiv_subtype_inter p q a : α) = a :=
-by { cases a, cases a_val, refl }
-
 /-- If the outer subtype has more restrictive predicate than the inner one,
 then we can drop the latter. -/
-def subtype_subtype_equiv_subtype {α : Type u} {p q : α → Prop} (h : ∀ {x}, q x → p x) :
+@[simps] def subtype_subtype_equiv_subtype {α : Type u} {p q : α → Prop} (h : ∀ {x}, q x → p x) :
   {x : subtype p // q x.1} ≃ subtype q :=
 (subtype_subtype_equiv_subtype_inter p _).trans $
-subtype_equiv_right $
-assume x,
-⟨and.right, λ h₁, ⟨h h₁, h₁⟩⟩
-
-@[simp] lemma subtype_subtype_equiv_subtype_apply {α : Type u} {p q : α → Prop} (h : ∀ x, q x → p x)
-  (a : {x : subtype p // q x.1}) :
-  (subtype_subtype_equiv_subtype h a : α) = a :=
-by { cases a, cases a_val, refl }
+subtype_equiv_right $ λ x, and_iff_right_of_imp h
 
 /-- If a proposition holds for all elements, then the subtype is
 equivalent to the original type. -/
@@ -1515,6 +964,20 @@ depending on whether they satisfy a predicate `p` or not. -/
       refl },
   end }
 
+/-- A product of types can be split as the binary product of one of the types and the product
+  of all the remaining types. -/
+@[simps] def pi_split_at {α : Type*} [decidable_eq α] (i : α) (β : α → Type*) :
+  (Π j, β j) ≃ β i × Π j : {j // j ≠ i}, β j :=
+{ to_fun := λ f, ⟨f i, λ j, f j⟩,
+  inv_fun := λ f j, if h : j = i then h.symm.rec f.1 else f.2 ⟨j, h⟩,
+  right_inv := λ f, by { ext, exacts [dif_pos rfl, (dif_neg x.2).trans (by cases x; refl)] },
+  left_inv := λ f, by { ext, dsimp only, split_ifs, { subst h }, { refl } } }
+
+/-- A product of copies of a type can be split as the binary product of one copy and the product
+  of all the remaining copies. -/
+@[simps] def fun_split_at {α : Type*} [decidable_eq α] (i : α) (β : Type*) :
+  (α → β) ≃ β × ({j // j ≠ i} → β) := pi_split_at i _
+
 end
 
 section subtype_equiv_codomain
@@ -1572,10 +1035,8 @@ lemma of_bijective_apply_symm_apply (f : α → β) (hf : bijective f) (x : β)
   (of_bijective f hf).symm (f x) = x :=
 (of_bijective f hf).symm_apply_apply x
 
-instance : can_lift (α → β) (α ≃ β) :=
-{ coe := coe_fn,
-  cond := bijective,
-  prf := λ f hf, ⟨of_bijective f hf, rfl⟩ }
+instance : can_lift (α → β) (α ≃ β) coe_fn bijective :=
+{ prf := λ f hf, ⟨of_bijective f hf, rfl⟩ }
 
 section
 
@@ -1799,7 +1260,7 @@ end function.involutive
 lemma plift.eq_up_iff_down_eq {x : plift α} {y : α} : x = plift.up y ↔ x.down = y :=
 equiv.plift.eq_symm_apply
 
-lemma function.injective.map_swap {α β : Type*} [decidable_eq α] [decidable_eq β]
+lemma function.injective.map_swap {α β : Sort*} [decidable_eq α] [decidable_eq β]
   {f : α → β} (hf : function.injective f) (x y z : α) :
   f (equiv.swap x y z) = equiv.swap (f x) (f y) (f z) :=
 begin
@@ -1812,89 +1273,6 @@ end
 
 namespace equiv
 
-protected lemma exists_unique_congr {p : α → Prop} {q : β → Prop} (f : α ≃ β)
-  (h : ∀{x}, p x ↔ q (f x)) : (∃! x, p x) ↔ ∃! y, q y :=
-begin
-  split,
-  { rintro ⟨a, ha₁, ha₂⟩,
-    exact ⟨f a, h.1 ha₁, λ b hb, f.symm_apply_eq.1 (ha₂ (f.symm b) (h.2 (by simpa using hb)))⟩ },
-  { rintro ⟨b, hb₁, hb₂⟩,
-    exact ⟨f.symm b, h.2 (by simpa using hb₁), λ y hy, (eq_symm_apply f).2 (hb₂ _ (h.1 hy))⟩ }
-end
-
-protected lemma exists_unique_congr_left' {p : α → Prop} (f : α ≃ β) :
-  (∃! x, p x) ↔ (∃! y, p (f.symm y)) :=
-equiv.exists_unique_congr f (λx, by simp)
-
-protected lemma exists_unique_congr_left {p : β → Prop} (f : α ≃ β) :
-  (∃! x, p (f x)) ↔ (∃! y, p y) :=
-(equiv.exists_unique_congr_left' f.symm).symm
-
-protected lemma forall_congr {p : α → Prop} {q : β → Prop} (f : α ≃ β)
-  (h : ∀{x}, p x ↔ q (f x)) : (∀x, p x) ↔ (∀y, q y) :=
-begin
-  split; intros h₂ x,
-  { rw [←f.right_inv x], apply h.mp, apply h₂ },
-  apply h.mpr, apply h₂
-end
-protected lemma forall_congr' {p : α → Prop} {q : β → Prop} (f : α ≃ β)
-  (h : ∀{x}, p (f.symm x) ↔ q x) : (∀x, p x) ↔ (∀y, q y) :=
-(equiv.forall_congr f.symm (λ x, h.symm)).symm
-
--- We next build some higher arity versions of `equiv.forall_congr`.
--- Although they appear to just be repeated applications of `equiv.forall_congr`,
--- unification of metavariables works better with these versions.
--- In particular, they are necessary in `equiv_rw`.
--- (Stopping at ternary functions seems reasonable: at least in 1-categorical mathematics,
--- it's rare to have axioms involving more than 3 elements at once.)
-universes ua1 ua2 ub1 ub2 ug1 ug2
-variables {α₁ : Sort ua1} {α₂ : Sort ua2}
-          {β₁ : Sort ub1} {β₂ : Sort ub2}
-          {γ₁ : Sort ug1} {γ₂ : Sort ug2}
-
-protected lemma forall₂_congr {p : α₁ → β₁ → Prop} {q : α₂ → β₂ → Prop} (eα : α₁ ≃ α₂)
-  (eβ : β₁ ≃ β₂) (h : ∀{x y}, p x y ↔ q (eα x) (eβ y)) :
-  (∀x y, p x y) ↔ (∀x y, q x y) :=
-begin
-  apply equiv.forall_congr,
-  intros,
-  apply equiv.forall_congr,
-  intros,
-  apply h,
-end
-protected lemma forall₂_congr' {p : α₁ → β₁ → Prop} {q : α₂ → β₂ → Prop} (eα : α₁ ≃ α₂)
-  (eβ : β₁ ≃ β₂) (h : ∀{x y}, p (eα.symm x) (eβ.symm y) ↔ q x y) :
-  (∀x y, p x y) ↔ (∀x y, q x y) :=
-(equiv.forall₂_congr eα.symm eβ.symm (λ x y, h.symm)).symm
-
-protected lemma forall₃_congr {p : α₁ → β₁ → γ₁ → Prop} {q : α₂ → β₂ → γ₂ → Prop}
-  (eα : α₁ ≃ α₂) (eβ : β₁ ≃ β₂) (eγ : γ₁ ≃ γ₂)
-  (h : ∀{x y z}, p x y z ↔ q (eα x) (eβ y) (eγ z)) : (∀x y z, p x y z) ↔ (∀x y z, q x y z) :=
-begin
-  apply equiv.forall₂_congr,
-  intros,
-  apply equiv.forall_congr,
-  intros,
-  apply h,
-end
-protected lemma forall₃_congr' {p : α₁ → β₁ → γ₁ → Prop} {q : α₂ → β₂ → γ₂ → Prop}
-  (eα : α₁ ≃ α₂) (eβ : β₁ ≃ β₂) (eγ : γ₁ ≃ γ₂)
-  (h : ∀{x y z}, p (eα.symm x) (eβ.symm y) (eγ.symm z) ↔ q x y z) :
-    (∀x y z, p x y z) ↔ (∀x y z, q x y z) :=
-(equiv.forall₃_congr eα.symm eβ.symm eγ.symm (λ x y z, h.symm)).symm
-
-protected lemma forall_congr_left' {p : α → Prop} (f : α ≃ β) :
-  (∀x, p x) ↔ (∀y, p (f.symm y)) :=
-equiv.forall_congr f (λx, by simp)
-
-protected lemma forall_congr_left {p : β → Prop} (f : α ≃ β) :
-  (∀x, p (f x)) ↔ (∀y, p y) :=
-(equiv.forall_congr_left' f.symm).symm
-
-protected lemma exists_congr_left {α β} (f : α ≃ β) {p : α → Prop} :
-  (∃ a, p a) ↔ (∃ b, p (f.symm b)) :=
-⟨λ ⟨a, h⟩, ⟨f a, by simpa using h⟩, λ ⟨b, h⟩, ⟨_, h⟩⟩
-
 section
 variables (P : α → Sort w) (e : α ≃ β)
 
@@ -1988,6 +1366,32 @@ end
 
 end
 
+section binary_op
+
+variables {α₁ β₁ : Type*} (e : α₁ ≃ β₁) (f : α₁ → α₁ → α₁)
+
+lemma semiconj_conj (f : α₁ → α₁) : semiconj e f (e.conj f) := λ x, by simp
+
+lemma semiconj₂_conj : semiconj₂ e f (e.arrow_congr e.conj f) := λ x y, by simp
+
+instance [is_associative α₁ f] :
+  is_associative β₁ (e.arrow_congr (e.arrow_congr e) f) :=
+(e.semiconj₂_conj f).is_associative_right e.surjective
+
+instance [is_idempotent α₁ f] :
+  is_idempotent β₁ (e.arrow_congr (e.arrow_congr e) f) :=
+(e.semiconj₂_conj f).is_idempotent_right e.surjective
+
+instance [is_left_cancel α₁ f] :
+  is_left_cancel β₁ (e.arrow_congr (e.arrow_congr e) f) :=
+⟨e.surjective.forall₃.2 $ λ x y z, by simpa using @is_left_cancel.left_cancel _ f _ x y z⟩
+
+instance [is_right_cancel α₁ f] :
+  is_right_cancel β₁ (e.arrow_congr (e.arrow_congr e) f) :=
+⟨e.surjective.forall₃.2 $ λ x y z, by simpa using @is_right_cancel.right_cancel _ f _ x y z⟩
+
+end binary_op
+
 end equiv
 
 lemma function.injective.swap_apply [decidable_eq α] [decidable_eq β] {f : α → β}
@@ -2004,17 +1408,6 @@ lemma function.injective.swap_comp [decidable_eq α] [decidable_eq β] {f : α 
   equiv.swap (f x) (f y) ∘ f = f ∘ equiv.swap x y :=
 funext $ λ z, hf.swap_apply _ _ _
 
-/-- If both `α` and `β` are singletons, then `α ≃ β`. -/
-def equiv_of_unique_of_unique [unique α] [unique β] : α ≃ β :=
-{ to_fun := λ _, default,
-  inv_fun := λ _, default,
-  left_inv := λ _, subsingleton.elim _ _,
-  right_inv := λ _, subsingleton.elim _ _ }
-
-/-- If `α` is a singleton, then it is equivalent to any `punit`. -/
-def equiv_punit_of_unique [unique α] : α ≃ punit.{v} :=
-equiv_of_unique_of_unique
-
 /-- If `α` is a subsingleton, then it is equivalent to `α × α`. -/
 def subsingleton_prod_self_equiv {α : Type*} [subsingleton α] : α × α ≃ α :=
 { to_fun := λ p, p.1,
@@ -2043,61 +1436,6 @@ def unique_unique_equiv : unique (unique α) ≃ unique α :=
 equiv_of_subsingleton_of_subsingleton (λ h, h.default)
   (λ h, { default := h, uniq := λ _, subsingleton.elim _ _ })
 
-namespace quot
-
-/-- An equivalence `e : α ≃ β` generates an equivalence between quotient spaces,
-if `ra a₁ a₂ ↔ rb (e a₁) (e a₂). -/
-protected def congr {ra : α → α → Prop} {rb : β → β → Prop} (e : α ≃ β)
-  (eq : ∀a₁ a₂, ra a₁ a₂ ↔ rb (e a₁) (e a₂)) :
-  quot ra ≃ quot rb :=
-{ to_fun := quot.map e (assume a₁ a₂, (eq a₁ a₂).1),
-  inv_fun := quot.map e.symm
-    (assume b₁ b₂ h,
-     (eq (e.symm b₁) (e.symm b₂)).2
-       ((e.apply_symm_apply b₁).symm ▸ (e.apply_symm_apply b₂).symm ▸ h)),
-  left_inv := by { rintros ⟨a⟩, dunfold quot.map, simp only [equiv.symm_apply_apply] },
-  right_inv := by { rintros ⟨a⟩, dunfold quot.map, simp only [equiv.apply_symm_apply] } }
-
-@[simp]
-lemma congr_mk {ra : α → α → Prop} {rb : β → β → Prop} (e : α ≃ β)
-  (eq : ∀ (a₁ a₂ : α), ra a₁ a₂ ↔ rb (e a₁) (e a₂)) (a : α) :
-  quot.congr e eq (quot.mk ra a) = quot.mk rb (e a) := rfl
-
-/-- Quotients are congruent on equivalences under equality of their relation.
-An alternative is just to use rewriting with `eq`, but then computational proofs get stuck. -/
-protected def congr_right {r r' : α → α → Prop} (eq : ∀a₁ a₂, r a₁ a₂ ↔ r' a₁ a₂) :
-  quot r ≃ quot r' :=
-quot.congr (equiv.refl α) eq
-
-/-- An equivalence `e : α ≃ β` generates an equivalence between the quotient space of `α`
-by a relation `ra` and the quotient space of `β` by the image of this relation under `e`. -/
-protected def congr_left {r : α → α → Prop} (e : α ≃ β) :
-  quot r ≃ quot (λ b b', r (e.symm b) (e.symm b')) :=
-@quot.congr α β r (λ b b', r (e.symm b) (e.symm b')) e (λ a₁ a₂, by simp only [e.symm_apply_apply])
-
-end quot
-
-namespace quotient
-/-- An equivalence `e : α ≃ β` generates an equivalence between quotient spaces,
-if `ra a₁ a₂ ↔ rb (e a₁) (e a₂). -/
-protected def congr {ra : setoid α} {rb : setoid β} (e : α ≃ β)
-  (eq : ∀a₁ a₂, @setoid.r α ra a₁ a₂ ↔ @setoid.r β rb (e a₁) (e a₂)) :
-  quotient ra ≃ quotient rb :=
-quot.congr e eq
-
-@[simp]
-lemma congr_mk {ra : setoid α} {rb : setoid β} (e : α ≃ β)
-  (eq : ∀ (a₁ a₂ : α), setoid.r a₁ a₂ ↔ setoid.r (e a₁) (e a₂)) (a : α):
-  quotient.congr e eq (quotient.mk a) = quotient.mk (e a) :=
-rfl
-
-/-- Quotients are congruent on equivalences under equality of their relation.
-An alternative is just to use rewriting with `eq`, but then computational proofs get stuck. -/
-protected def congr_right {r r' : setoid α}
-  (eq : ∀a₁ a₂, @setoid.r α r a₁ a₂ ↔ @setoid.r α r' a₁ a₂) : quotient r ≃ quotient r' :=
-quot.congr_right eq
-end quotient
-
 namespace function
 
 lemma update_comp_equiv {α β α' : Sort*} [decidable_eq α'] [decidable_eq α] (f : α → β) (g : α' ≃ α)
diff --git a/src/logic/equiv/defs.lean b/src/logic/equiv/defs.lean
new file mode 100644
index 0000000000000..490c633c499db
--- /dev/null
+++ b/src/logic/equiv/defs.lean
@@ -0,0 +1,802 @@
+/-
+Copyright (c) 2015 Microsoft Corporation. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Leonardo de Moura, Mario Carneiro
+-/
+import data.fun_like.equiv
+import logic.unique
+
+/-!
+# Equivalence between types
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define two types:
+
+* `equiv α β` a.k.a. `α ≃ β`: a bijective map `α → β` bundled with its inverse map; we use this (and
+  not equality!) to express that various `Type`s or `Sort`s are equivalent.
+
+* `equiv.perm α`: the group of permutations `α ≃ α`. More lemmas about `equiv.perm` can be found in
+  `group_theory/perm`.
+
+Then we define
+
+* canonical isomorphisms between various types: e.g.,
+
+  - `equiv.refl α` is the identity map interpreted as `α ≃ α`;
+
+* operations on equivalences: e.g.,
+
+  - `equiv.symm e : β ≃ α` is the inverse of `e : α ≃ β`;
+
+  - `equiv.trans e₁ e₂ : α ≃ γ` is the composition of `e₁ : α ≃ β` and `e₂ : β ≃ γ` (note the order
+    of the arguments!);
+
+* definitions that transfer some instances along an equivalence. By convention, we transfer
+  instances from right to left.
+
+  - `equiv.inhabited` takes `e : α ≃ β` and `[inhabited β]` and returns `inhabited α`;
+  - `equiv.unique` takes `e : α ≃ β` and `[unique β]` and returns `unique α`;
+  - `equiv.decidable_eq` takes `e : α ≃ β` and `[decidable_eq β]` and returns `decidable_eq α`.
+
+  More definitions of this kind can be found in other files. E.g., `data/equiv/transfer_instance`
+  does it for many algebraic type classes like `group`, `module`, etc.
+
+Many more such isomorphisms and operations are defined in `logic/equiv/basic`.
+
+## Tags
+
+equivalence, congruence, bijective map
+-/
+
+open function
+
+universes u v w z
+variables {α : Sort u} {β : Sort v} {γ : Sort w}
+
+/-- `α ≃ β` is the type of functions from `α → β` with a two-sided inverse. -/
+structure equiv (α : Sort*) (β : Sort*) :=
+(to_fun    : α → β)
+(inv_fun   : β → α)
+(left_inv  : left_inverse inv_fun to_fun)
+(right_inv : right_inverse inv_fun to_fun)
+
+infix ` ≃ `:25 := equiv
+
+instance {F} [equiv_like F α β] : has_coe_t F (α ≃ β) :=
+⟨λ f, { to_fun := f, inv_fun := equiv_like.inv f, left_inv := equiv_like.left_inv f,
+  right_inv := equiv_like.right_inv f }⟩
+
+/-- `perm α` is the type of bijections from `α` to itself. -/
+@[reducible] def equiv.perm (α : Sort*) := equiv α α
+
+namespace equiv
+
+instance : equiv_like (α ≃ β) α β :=
+{ coe := to_fun, inv := inv_fun, left_inv := left_inv, right_inv := right_inv,
+  coe_injective' := λ e₁ e₂ h₁ h₂, by { cases e₁, cases e₂, congr' } }
+
+instance : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨to_fun⟩
+
+@[simp] theorem coe_fn_mk (f : α → β) (g l r) : (equiv.mk f g l r : α → β) = f :=
+rfl
+
+/-- The map `coe_fn : (r ≃ s) → (r → s)` is injective. -/
+theorem coe_fn_injective : @function.injective (α ≃ β) (α → β) coe_fn := fun_like.coe_injective
+protected lemma coe_inj {e₁ e₂ : α ≃ β} : (e₁ : α → β) = e₂ ↔ e₁ = e₂ := fun_like.coe_fn_eq
+@[ext] lemma ext {f g : equiv α β} (H : ∀ x, f x = g x) : f = g := fun_like.ext f g H
+protected lemma congr_arg {f : equiv α β} {x x' : α} : x = x' → f x = f x' := fun_like.congr_arg f
+protected lemma congr_fun {f g : equiv α β} (h : f = g) (x : α) : f x = g x :=
+fun_like.congr_fun h x
+lemma ext_iff {f g : equiv α β} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
+
+@[ext] lemma perm.ext {σ τ : equiv.perm α} (H : ∀ x, σ x = τ x) : σ = τ :=
+equiv.ext H
+
+protected lemma perm.congr_arg {f : equiv.perm α} {x x' : α} : x = x' → f x = f x' :=
+equiv.congr_arg
+
+protected lemma perm.congr_fun {f g : equiv.perm α} (h : f = g) (x : α) : f x = g x :=
+equiv.congr_fun h x
+
+lemma perm.ext_iff {σ τ : equiv.perm α} : σ = τ ↔ ∀ x, σ x = τ x :=
+ext_iff
+
+/-- Any type is equivalent to itself. -/
+@[refl] protected def refl (α : Sort*) : α ≃ α := ⟨id, id, λ x, rfl, λ x, rfl⟩
+
+instance inhabited' : inhabited (α ≃ α) := ⟨equiv.refl α⟩
+
+/-- Inverse of an equivalence `e : α ≃ β`. -/
+@[symm] protected def symm (e : α ≃ β) : β ≃ α := ⟨e.inv_fun, e.to_fun, e.right_inv, e.left_inv⟩
+
+/-- See Note [custom simps projection] -/
+def simps.symm_apply (e : α ≃ β) : β → α := e.symm
+
+initialize_simps_projections equiv (to_fun → apply, inv_fun → symm_apply)
+
+/-- Composition of equivalences `e₁ : α ≃ β` and `e₂ : β ≃ γ`. -/
+@[trans] protected def trans (e₁ : α ≃ β) (e₂ : β ≃ γ) : α ≃ γ :=
+⟨e₂ ∘ e₁, e₁.symm ∘ e₂.symm, e₂.left_inv.comp e₁.left_inv, e₂.right_inv.comp e₁.right_inv⟩
+
+@[simp, transport_simps, mfld_simps]
+lemma to_fun_as_coe (e : α ≃ β) : e.to_fun = e := rfl
+
+@[simp, mfld_simps]
+lemma inv_fun_as_coe (e : α ≃ β) : e.inv_fun = e.symm := rfl
+
+protected theorem injective (e : α ≃ β) : injective e := equiv_like.injective e
+protected theorem surjective (e : α ≃ β) : surjective e := equiv_like.surjective e
+protected theorem bijective (e : α ≃ β) : bijective e := equiv_like.bijective e
+
+protected theorem subsingleton (e : α ≃ β) [subsingleton β] : subsingleton α :=
+e.injective.subsingleton
+
+protected theorem subsingleton.symm (e : α ≃ β) [subsingleton α] : subsingleton β :=
+e.symm.injective.subsingleton
+
+lemma subsingleton_congr (e : α ≃ β) : subsingleton α ↔ subsingleton β :=
+⟨λ h, by exactI e.symm.subsingleton, λ h, by exactI e.subsingleton⟩
+
+instance equiv_subsingleton_cod [subsingleton β] : subsingleton (α ≃ β) :=
+fun_like.subsingleton_cod
+
+instance equiv_subsingleton_dom [subsingleton α] : subsingleton (α ≃ β) :=
+equiv_like.subsingleton_dom
+
+instance perm_unique [subsingleton α] : unique (perm α) :=
+unique_of_subsingleton (equiv.refl α)
+
+lemma perm.subsingleton_eq_refl [subsingleton α] (e : perm α) :
+  e = equiv.refl α := subsingleton.elim _ _
+
+/-- Transfer `decidable_eq` across an equivalence. -/
+protected def decidable_eq (e : α ≃ β) [decidable_eq β] : decidable_eq α :=
+e.injective.decidable_eq
+
+lemma nonempty_congr (e : α ≃ β) : nonempty α ↔ nonempty β :=
+nonempty.congr e e.symm
+
+protected lemma nonempty (e : α ≃ β) [nonempty β] : nonempty α :=
+e.nonempty_congr.mpr ‹_›
+
+/-- If `α ≃ β` and `β` is inhabited, then so is `α`. -/
+protected def inhabited [inhabited β] (e : α ≃ β) : inhabited α :=
+⟨e.symm default⟩
+
+/-- If `α ≃ β` and `β` is a singleton type, then so is `α`. -/
+protected def unique [unique β] (e : α ≃ β) : unique α :=
+e.symm.surjective.unique
+
+/-- Equivalence between equal types. -/
+protected def cast {α β : Sort*} (h : α = β) : α ≃ β :=
+⟨cast h, cast h.symm, λ x, by { cases h, refl }, λ x, by { cases h, refl }⟩
+
+@[simp] theorem coe_fn_symm_mk (f : α → β) (g l r) : ((equiv.mk f g l r).symm : β → α) = g :=
+rfl
+
+@[simp] theorem coe_refl : ⇑(equiv.refl α) = id := rfl
+
+/-- This cannot be a `simp` lemmas as it incorrectly matches against `e : α ≃ synonym α`, when
+`synonym α` is semireducible. This makes a mess of `multiplicative.of_add` etc. -/
+theorem perm.coe_subsingleton {α : Type*} [subsingleton α] (e : perm α) : ⇑(e) = id :=
+by rw [perm.subsingleton_eq_refl e, coe_refl]
+
+theorem refl_apply (x : α) : equiv.refl α x = x := rfl
+
+@[simp] theorem coe_trans (f : α ≃ β) (g : β ≃ γ) : ⇑(f.trans g) = g ∘ f := rfl
+
+theorem trans_apply (f : α ≃ β) (g : β ≃ γ) (a : α) : (f.trans g) a = g (f a) := rfl
+
+@[simp, equiv_rw_simp] theorem apply_symm_apply  (e : α ≃ β) (x : β) : e (e.symm x) = x :=
+e.right_inv x
+
+@[simp, equiv_rw_simp, transport_simps]
+theorem symm_apply_apply (e : α ≃ β) (x : α) : e.symm (e x) = x :=
+e.left_inv x
+
+@[simp] theorem symm_comp_self (e : α ≃ β) : e.symm ∘ e = id := funext e.symm_apply_apply
+
+@[simp] theorem self_comp_symm (e : α ≃ β) : e ∘ e.symm = id := funext e.apply_symm_apply
+
+@[simp] lemma symm_trans_apply (f : α ≃ β) (g : β ≃ γ) (a : γ) :
+  (f.trans g).symm a = f.symm (g.symm a) := rfl
+
+-- The `simp` attribute is needed to make this a `dsimp` lemma.
+-- `simp` will always rewrite with `equiv.symm_symm` before this has a chance to fire.
+@[simp, nolint simp_nf] theorem symm_symm_apply (f : α ≃ β) (b : α) : f.symm.symm b = f b := rfl
+
+theorem apply_eq_iff_eq (f : α ≃ β) {x y : α} : f x = f y ↔ x = y := equiv_like.apply_eq_iff_eq f
+
+@[transport_simps]
+theorem apply_eq_iff_eq_symm_apply {α β : Sort*} (f : α ≃ β) {x : α} {y : β} :
+  f x = y ↔ x = f.symm y :=
+begin
+  conv_lhs { rw ←apply_symm_apply f y, },
+  rw apply_eq_iff_eq,
+end
+
+@[simp] theorem cast_apply {α β} (h : α = β) (x : α) : equiv.cast h x = cast h x := rfl
+
+@[simp] theorem cast_symm {α β} (h : α = β) : (equiv.cast h).symm = equiv.cast h.symm := rfl
+
+@[simp] theorem cast_refl {α} (h : α = α := rfl) : equiv.cast h = equiv.refl α := rfl
+
+@[simp] theorem cast_trans {α β γ} (h : α = β) (h2 : β = γ) :
+  (equiv.cast h).trans (equiv.cast h2) = equiv.cast (h.trans h2) :=
+ext $ λ x, by { substs h h2, refl }
+
+lemma cast_eq_iff_heq {α β} (h : α = β) {a : α} {b : β} : equiv.cast h a = b ↔ a == b :=
+by { subst h, simp }
+
+lemma symm_apply_eq {α β} (e : α ≃ β) {x y} : e.symm x = y ↔ x = e y :=
+⟨λ H, by simp [H.symm], λ H, by simp [H]⟩
+
+lemma eq_symm_apply {α β} (e : α ≃ β) {x y} : y = e.symm x ↔ e y = x :=
+(eq_comm.trans e.symm_apply_eq).trans eq_comm
+
+@[simp, equiv_rw_simp] theorem symm_symm (e : α ≃ β) : e.symm.symm = e := by { cases e, refl }
+
+@[simp] theorem trans_refl (e : α ≃ β) : e.trans (equiv.refl β) = e := by { cases e, refl }
+
+@[simp] theorem refl_symm : (equiv.refl α).symm = equiv.refl α := rfl
+
+@[simp] theorem refl_trans (e : α ≃ β) : (equiv.refl α).trans e = e := by { cases e, refl }
+
+@[simp] theorem symm_trans_self (e : α ≃ β) : e.symm.trans e = equiv.refl β := ext (by simp)
+
+@[simp] theorem self_trans_symm (e : α ≃ β) : e.trans e.symm = equiv.refl α := ext (by simp)
+
+lemma trans_assoc {δ} (ab : α ≃ β) (bc : β ≃ γ) (cd : γ ≃ δ) :
+  (ab.trans bc).trans cd = ab.trans (bc.trans cd) :=
+equiv.ext $ assume a, rfl
+
+theorem left_inverse_symm (f : equiv α β) : left_inverse f.symm f := f.left_inv
+
+theorem right_inverse_symm (f : equiv α β) : function.right_inverse f.symm f := f.right_inv
+
+lemma injective_comp (e : α ≃ β) (f : β → γ) : injective (f ∘ e) ↔ injective f :=
+equiv_like.injective_comp e f
+
+lemma comp_injective (f : α → β) (e : β ≃ γ) : injective (e ∘ f) ↔ injective f :=
+equiv_like.comp_injective f e
+
+lemma surjective_comp (e : α ≃ β) (f : β → γ) : surjective (f ∘ e) ↔ surjective f :=
+equiv_like.surjective_comp e f
+
+lemma comp_surjective (f : α → β) (e : β ≃ γ) : surjective (e ∘ f) ↔ surjective f :=
+equiv_like.comp_surjective f e
+
+lemma bijective_comp (e : α ≃ β) (f : β → γ) : bijective (f ∘ e) ↔ bijective f :=
+equiv_like.bijective_comp e f
+
+lemma comp_bijective (f : α → β) (e : β ≃ γ) : bijective (e ∘ f) ↔ bijective f :=
+equiv_like.comp_bijective f e
+
+/-- If `α` is equivalent to `β` and `γ` is equivalent to `δ`, then the type of equivalences `α ≃ γ`
+is equivalent to the type of equivalences `β ≃ δ`. -/
+def equiv_congr {δ} (ab : α ≃ β) (cd : γ ≃ δ) : (α ≃ γ) ≃ (β ≃ δ) :=
+⟨ λac, (ab.symm.trans ac).trans cd, λbd, ab.trans $ bd.trans $ cd.symm,
+  assume ac, by { ext x, simp }, assume ac, by { ext x, simp } ⟩
+
+@[simp] lemma equiv_congr_refl {α β} :
+  (equiv.refl α).equiv_congr (equiv.refl β) = equiv.refl (α ≃ β) := by { ext, refl }
+
+@[simp] lemma equiv_congr_symm {δ} (ab : α ≃ β) (cd : γ ≃ δ) :
+  (ab.equiv_congr cd).symm = ab.symm.equiv_congr cd.symm := by { ext, refl }
+
+@[simp] lemma equiv_congr_trans {δ ε ζ} (ab : α ≃ β) (de : δ ≃ ε) (bc : β ≃ γ) (ef : ε ≃ ζ) :
+  (ab.equiv_congr de).trans (bc.equiv_congr ef) = (ab.trans bc).equiv_congr (de.trans ef) :=
+by { ext, refl }
+
+@[simp] lemma equiv_congr_refl_left {α β γ} (bg : β ≃ γ) (e : α ≃ β) :
+  (equiv.refl α).equiv_congr bg e = e.trans bg := rfl
+
+@[simp] lemma equiv_congr_refl_right {α β} (ab e : α ≃ β) :
+  ab.equiv_congr (equiv.refl β) e = ab.symm.trans e := rfl
+
+@[simp] lemma equiv_congr_apply_apply {δ} (ab : α ≃ β) (cd : γ ≃ δ) (e : α ≃ γ) (x) :
+  ab.equiv_congr cd e x = cd (e (ab.symm x)) := rfl
+
+section perm_congr
+
+variables {α' β' : Type*} (e : α' ≃ β')
+
+/-- If `α` is equivalent to `β`, then `perm α` is equivalent to `perm β`. -/
+def perm_congr : perm α' ≃ perm β' :=
+equiv_congr e e
+
+lemma perm_congr_def (p : equiv.perm α') :
+  e.perm_congr p = (e.symm.trans p).trans e := rfl
+
+@[simp] lemma perm_congr_refl :
+  e.perm_congr (equiv.refl _) = equiv.refl _ :=
+by simp [perm_congr_def]
+
+@[simp] lemma perm_congr_symm :
+  e.perm_congr.symm = e.symm.perm_congr := rfl
+
+@[simp] lemma perm_congr_apply (p : equiv.perm α') (x) :
+  e.perm_congr p x = e (p (e.symm x)) := rfl
+
+lemma perm_congr_symm_apply (p : equiv.perm β') (x) :
+  e.perm_congr.symm p x = e.symm (p (e x)) := rfl
+
+lemma perm_congr_trans (p p' : equiv.perm α') :
+  (e.perm_congr p).trans (e.perm_congr p') = e.perm_congr (p.trans p') :=
+by { ext, simp }
+
+end perm_congr
+
+/-- Two empty types are equivalent. -/
+def equiv_of_is_empty  (α β : Sort*) [is_empty α] [is_empty β] : α ≃ β :=
+⟨is_empty_elim, is_empty_elim, is_empty_elim, is_empty_elim⟩
+
+/-- If `α` is an empty type, then it is equivalent to the `empty` type. -/
+def equiv_empty (α : Sort u) [is_empty α] : α ≃ empty :=
+equiv_of_is_empty  α _
+
+/-- If `α` is an empty type, then it is equivalent to the `pempty` type in any universe. -/
+def equiv_pempty (α : Sort v) [is_empty α] : α ≃ pempty.{u} :=
+equiv_of_is_empty  α _
+
+/-- `α` is equivalent to an empty type iff `α` is empty. -/
+def equiv_empty_equiv (α : Sort u) : (α ≃ empty) ≃ is_empty α :=
+⟨λ e, function.is_empty e, @equiv_empty α, λ e, ext $ λ x, (e x).elim, λ p, rfl⟩
+
+/-- The `Sort` of proofs of a false proposition is equivalent to `pempty`. -/
+def prop_equiv_pempty {p : Prop} (h : ¬p) : p ≃ pempty :=
+@equiv_pempty p $ is_empty.prop_iff.2 h
+
+/-- If both `α` and `β` have a unique element, then `α ≃ β`. -/
+def equiv_of_unique (α β : Sort*) [unique α] [unique β] : α ≃ β :=
+{ to_fun := default,
+  inv_fun := default,
+  left_inv := λ _, subsingleton.elim _ _,
+  right_inv := λ _, subsingleton.elim _ _ }
+
+/-- If `α` has a unique element, then it is equivalent to any `punit`. -/
+def equiv_punit (α : Sort*) [unique α] : α ≃ punit.{v} :=
+equiv_of_unique α _
+
+/-- The `Sort` of proofs of a true proposition is equivalent to `punit`. -/
+def prop_equiv_punit {p : Prop} (h : p) : p ≃ punit :=
+@equiv_punit p $ unique_prop h
+
+/-- `ulift α` is equivalent to `α`. -/
+@[simps apply symm_apply {fully_applied := ff}]
+protected def ulift {α : Type v} : ulift.{u} α ≃ α :=
+⟨ulift.down, ulift.up, ulift.up_down, λ a, rfl⟩
+
+/-- `plift α` is equivalent to `α`. -/
+@[simps apply symm_apply {fully_applied := ff}]
+protected def plift : plift α ≃ α :=
+⟨plift.down, plift.up, plift.up_down, plift.down_up⟩
+
+/-- equivalence of propositions is the same as iff -/
+def of_iff {P Q : Prop} (h : P ↔ Q) : P ≃ Q :=
+{ to_fun := h.mp,
+  inv_fun := h.mpr,
+  left_inv := λ x, rfl,
+  right_inv := λ y, rfl }
+
+/-- If `α₁` is equivalent to `α₂` and `β₁` is equivalent to `β₂`, then the type of maps `α₁ → β₁`
+is equivalent to the type of maps `α₂ → β₂`. -/
+@[congr, simps apply] def arrow_congr {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
+  (α₁ → β₁) ≃ (α₂ → β₂) :=
+{ to_fun := λ f, e₂ ∘ f ∘ e₁.symm,
+  inv_fun := λ f, e₂.symm ∘ f ∘ e₁,
+  left_inv := λ f, funext $ λ x, by simp,
+  right_inv := λ f, funext $ λ x, by simp }
+
+lemma arrow_congr_comp {α₁ β₁ γ₁ α₂ β₂ γ₂ : Sort*}
+  (ea : α₁ ≃ α₂) (eb : β₁ ≃ β₂) (ec : γ₁ ≃ γ₂) (f : α₁ → β₁) (g : β₁ → γ₁) :
+  arrow_congr ea ec (g ∘ f) = (arrow_congr eb ec g) ∘ (arrow_congr ea eb f) :=
+by { ext, simp only [comp, arrow_congr_apply, eb.symm_apply_apply] }
+
+@[simp] lemma arrow_congr_refl {α β : Sort*} :
+  arrow_congr (equiv.refl α) (equiv.refl β) = equiv.refl (α → β) := rfl
+
+@[simp] lemma arrow_congr_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Sort*}
+  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
+  arrow_congr (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr e₁ e₁').trans (arrow_congr e₂ e₂') :=
+rfl
+
+@[simp] lemma arrow_congr_symm {α₁ β₁ α₂ β₂ : Sort*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
+  (arrow_congr e₁ e₂).symm = arrow_congr e₁.symm e₂.symm :=
+rfl
+
+/--
+A version of `equiv.arrow_congr` in `Type`, rather than `Sort`.
+
+The `equiv_rw` tactic is not able to use the default `Sort` level `equiv.arrow_congr`,
+because Lean's universe rules will not unify `?l_1` with `imax (1 ?m_1)`.
+-/
+@[congr, simps apply { attrs := [`simp, `transport_simps] }]
+def arrow_congr' {α₁ β₁ α₂ β₂ : Type*} (hα : α₁ ≃ α₂) (hβ : β₁ ≃ β₂) : (α₁ → β₁) ≃ (α₂ → β₂) :=
+equiv.arrow_congr hα hβ
+
+@[simp] lemma arrow_congr'_refl {α β : Type*} :
+  arrow_congr' (equiv.refl α) (equiv.refl β) = equiv.refl (α → β) := rfl
+
+@[simp] lemma arrow_congr'_trans {α₁ β₁ α₂ β₂ α₃ β₃ : Type*}
+  (e₁ : α₁ ≃ α₂) (e₁' : β₁ ≃ β₂) (e₂ : α₂ ≃ α₃) (e₂' : β₂ ≃ β₃) :
+  arrow_congr' (e₁.trans e₂) (e₁'.trans e₂') = (arrow_congr' e₁ e₁').trans (arrow_congr' e₂ e₂') :=
+rfl
+
+@[simp] lemma arrow_congr'_symm {α₁ β₁ α₂ β₂ : Type*} (e₁ : α₁ ≃ α₂) (e₂ : β₁ ≃ β₂) :
+  (arrow_congr' e₁ e₂).symm = arrow_congr' e₁.symm e₂.symm :=
+rfl
+
+/-- Conjugate a map `f : α → α` by an equivalence `α ≃ β`. -/
+@[simps apply]
+def conj (e : α ≃ β) : (α → α) ≃ (β → β) := arrow_congr e e
+
+@[simp] lemma conj_refl : conj (equiv.refl α) = equiv.refl (α → α) := rfl
+
+@[simp] lemma conj_symm (e : α ≃ β) : e.conj.symm = e.symm.conj := rfl
+
+@[simp] lemma conj_trans (e₁ : α ≃ β) (e₂ : β ≃ γ) :
+  (e₁.trans e₂).conj = e₁.conj.trans e₂.conj :=
+rfl
+
+-- This should not be a simp lemma as long as `(∘)` is reducible:
+-- when `(∘)` is reducible, Lean can unify `f₁ ∘ f₂` with any `g` using
+-- `f₁ := g` and `f₂ := λ x, x`.  This causes nontermination.
+lemma conj_comp (e : α ≃ β) (f₁ f₂ : α → α) :
+  e.conj (f₁ ∘ f₂) = (e.conj f₁) ∘ (e.conj f₂) :=
+by apply arrow_congr_comp
+
+lemma eq_comp_symm {α β γ} (e : α ≃ β) (f : β → γ) (g : α → γ) :
+  f = g ∘ e.symm ↔ f ∘ e = g :=
+(e.arrow_congr (equiv.refl γ)).symm_apply_eq.symm
+
+lemma comp_symm_eq {α β γ} (e : α ≃ β) (f : β → γ) (g : α → γ) :
+  g ∘ e.symm = f ↔ g = f ∘ e :=
+(e.arrow_congr (equiv.refl γ)).eq_symm_apply.symm
+
+lemma eq_symm_comp {α β γ} (e : α ≃ β) (f : γ → α) (g : γ → β) :
+  f = e.symm ∘ g ↔ e ∘ f = g :=
+((equiv.refl γ).arrow_congr e).eq_symm_apply
+
+lemma symm_comp_eq {α β γ} (e : α ≃ β) (f : γ → α) (g : γ → β) :
+  e.symm ∘ g = f ↔ g = e ∘ f :=
+((equiv.refl γ).arrow_congr e).symm_apply_eq
+
+/-- `punit` sorts in any two universes are equivalent. -/
+def punit_equiv_punit : punit.{v} ≃ punit.{w} :=
+⟨λ _, punit.star, λ _, punit.star, λ u, by { cases u, refl }, λ u, by { cases u, reflexivity }⟩
+
+/-- `Prop` is noncomputably equivalent to `bool`. -/
+noncomputable def Prop_equiv_bool : Prop ≃ bool :=
+⟨λ p, @to_bool p (classical.prop_decidable _),
+ λ b, b, λ p, by simp, λ b, by simp⟩
+
+section
+/-- The sort of maps to `punit.{v}` is equivalent to `punit.{w}`. -/
+def arrow_punit_equiv_punit (α : Sort*) : (α → punit.{v}) ≃ punit.{w} :=
+⟨λ f, punit.star, λ u f, punit.star,
+  λ f, by { funext x, cases f x, refl }, λ u, by { cases u, reflexivity }⟩
+
+/-- If `α` is `subsingleton` and `a : α`, then the type of dependent functions `Π (i : α), β
+i` is equivalent to `β i`. -/
+@[simps]
+def Pi_subsingleton {α} (β : α → Sort*) [subsingleton α] (a : α) : (Π a', β a') ≃ β a :=
+{ to_fun := eval a,
+  inv_fun := λ x b, cast (congr_arg β $ subsingleton.elim a b) x,
+  left_inv := λ f, funext $ λ b, by { rw subsingleton.elim b a, reflexivity },
+  right_inv := λ b, rfl }
+
+/-- If `α` has a unique term, then the type of function `α → β` is equivalent to `β`. -/
+@[simps { fully_applied := ff }] def fun_unique (α β) [unique α] : (α → β) ≃ β :=
+Pi_subsingleton _ default
+
+/-- The sort of maps from `punit` is equivalent to the codomain. -/
+def punit_arrow_equiv (α : Sort*) : (punit.{u} → α) ≃ α :=
+fun_unique _ _
+
+/-- The sort of maps from `true` is equivalent to the codomain. -/
+def true_arrow_equiv (α : Sort*) : (true → α) ≃ α :=
+fun_unique _ _
+
+/-- The sort of maps from a type that `is_empty` is equivalent to `punit`. -/
+def arrow_punit_of_is_empty (α β : Sort*) [is_empty α] : (α → β) ≃ punit.{u} :=
+⟨λ f, punit.star, λ u, is_empty_elim, λ f, funext is_empty_elim, λ u, by { cases u, refl }⟩
+
+/-- The sort of maps from `empty` is equivalent to `punit`. -/
+def empty_arrow_equiv_punit (α : Sort*) : (empty → α) ≃ punit.{u} :=
+arrow_punit_of_is_empty _ _
+
+/-- The sort of maps from `pempty` is equivalent to `punit`. -/
+def pempty_arrow_equiv_punit (α : Sort*) : (pempty → α) ≃ punit.{u} :=
+arrow_punit_of_is_empty _ _
+
+/-- The sort of maps from `false` is equivalent to `punit`. -/
+def false_arrow_equiv_punit (α : Sort*) : (false → α) ≃ punit.{u} :=
+arrow_punit_of_is_empty _ _
+
+end
+
+section
+
+/-- A `psigma`-type is equivalent to the corresponding `sigma`-type. -/
+@[simps apply symm_apply] def psigma_equiv_sigma {α} (β : α → Type*) : (Σ' i, β i) ≃ Σ i, β i :=
+⟨λ a, ⟨a.1, a.2⟩, λ a, ⟨a.1, a.2⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩
+
+/-- A `psigma`-type is equivalent to the corresponding `sigma`-type. -/
+@[simps apply symm_apply] def psigma_equiv_sigma_plift {α} (β : α → Sort*) :
+  (Σ' i, β i) ≃ Σ i : plift α, plift (β i.down) :=
+⟨λ a, ⟨plift.up a.1, plift.up a.2⟩, λ a, ⟨a.1.down, a.2.down⟩, λ ⟨a, b⟩, rfl, λ ⟨⟨a⟩, ⟨b⟩⟩, rfl⟩
+
+/-- A family of equivalences `Π a, β₁ a ≃ β₂ a` generates an equivalence between `Σ' a, β₁ a` and
+`Σ' a, β₂ a`. -/
+@[simps apply]
+def psigma_congr_right {α} {β₁ β₂ : α → Sort*} (F : Π a, β₁ a ≃ β₂ a) : (Σ' a, β₁ a) ≃ Σ' a, β₂ a :=
+⟨λ a, ⟨a.1, F a.1 a.2⟩, λ a, ⟨a.1, (F a.1).symm a.2⟩,
+ λ ⟨a, b⟩, congr_arg (psigma.mk a) $ symm_apply_apply (F a) b,
+ λ ⟨a, b⟩, congr_arg (psigma.mk a) $ apply_symm_apply (F a) b⟩
+
+@[simp] lemma psigma_congr_right_trans {α} {β₁ β₂ β₃ : α → Sort*}
+  (F : Π a, β₁ a ≃ β₂ a) (G : Π a, β₂ a ≃ β₃ a) :
+  (psigma_congr_right F).trans (psigma_congr_right G) =
+    psigma_congr_right (λ a, (F a).trans (G a)) :=
+by { ext1 x, cases x, refl }
+
+@[simp] lemma psigma_congr_right_symm {α} {β₁ β₂ : α → Sort*} (F : Π a, β₁ a ≃ β₂ a) :
+  (psigma_congr_right F).symm = psigma_congr_right (λ a, (F a).symm) :=
+by { ext1 x, cases x, refl }
+
+@[simp] lemma psigma_congr_right_refl {α} {β : α → Sort*} :
+  (psigma_congr_right (λ a, equiv.refl (β a))) = equiv.refl (Σ' a, β a) :=
+by { ext1 x, cases x, refl }
+
+/-- A family of equivalences `Π a, β₁ a ≃ β₂ a` generates an equivalence between `Σ a, β₁ a` and
+`Σ a, β₂ a`. -/
+@[simps apply]
+def sigma_congr_right {α} {β₁ β₂ : α → Type*} (F : Π a, β₁ a ≃ β₂ a) : (Σ a, β₁ a) ≃ Σ a, β₂ a :=
+⟨λ a, ⟨a.1, F a.1 a.2⟩, λ a, ⟨a.1, (F a.1).symm a.2⟩,
+ λ ⟨a, b⟩, congr_arg (sigma.mk a) $ symm_apply_apply (F a) b,
+ λ ⟨a, b⟩, congr_arg (sigma.mk a) $ apply_symm_apply (F a) b⟩
+
+@[simp] lemma sigma_congr_right_trans {α} {β₁ β₂ β₃ : α → Type*}
+  (F : Π a, β₁ a ≃ β₂ a) (G : Π a, β₂ a ≃ β₃ a) :
+  (sigma_congr_right F).trans (sigma_congr_right G) = sigma_congr_right (λ a, (F a).trans (G a)) :=
+by { ext1 x, cases x, refl }
+
+@[simp] lemma sigma_congr_right_symm {α} {β₁ β₂ : α → Type*} (F : Π a, β₁ a ≃ β₂ a) :
+  (sigma_congr_right F).symm = sigma_congr_right (λ a, (F a).symm) :=
+by { ext1 x, cases x, refl }
+
+@[simp] lemma sigma_congr_right_refl {α} {β : α → Type*} :
+  (sigma_congr_right (λ a, equiv.refl (β a))) = equiv.refl (Σ a, β a) :=
+by { ext1 x, cases x, refl }
+
+/-- A `psigma` with `Prop` fibers is equivalent to the subtype.  -/
+def psigma_equiv_subtype {α : Type v} (P : α → Prop) :
+  (Σ' i, P i) ≃ subtype P :=
+{ to_fun := λ x, ⟨x.1, x.2⟩,
+  inv_fun := λ x, ⟨x.1, x.2⟩,
+  left_inv := λ x, by { cases x, refl, },
+  right_inv := λ x, by { cases x, refl, }, }
+
+/-- A `sigma` with `plift` fibers is equivalent to the subtype. -/
+def sigma_plift_equiv_subtype {α : Type v} (P : α → Prop) :
+  (Σ i, plift (P i)) ≃ subtype P :=
+((psigma_equiv_sigma _).symm.trans (psigma_congr_right (λ a, equiv.plift))).trans
+  (psigma_equiv_subtype P)
+
+/--
+A `sigma` with `λ i, ulift (plift (P i))` fibers is equivalent to `{ x // P x }`.
+Variant of `sigma_plift_equiv_subtype`.
+-/
+def sigma_ulift_plift_equiv_subtype {α : Type v} (P : α → Prop) :
+  (Σ i, ulift (plift (P i))) ≃ subtype P :=
+(sigma_congr_right (λ a, equiv.ulift)).trans (sigma_plift_equiv_subtype P)
+
+namespace perm
+
+/-- A family of permutations `Π a, perm (β a)` generates a permuation `perm (Σ a, β₁ a)`. -/
+@[reducible]
+def sigma_congr_right {α} {β : α → Sort*} (F : Π a, perm (β a)) : perm (Σ a, β a) :=
+equiv.sigma_congr_right F
+
+@[simp] lemma sigma_congr_right_trans {α} {β : α → Sort*}
+  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
+  (sigma_congr_right F).trans (sigma_congr_right G) = sigma_congr_right (λ a, (F a).trans (G a)) :=
+equiv.sigma_congr_right_trans F G
+
+@[simp] lemma sigma_congr_right_symm {α} {β : α → Sort*} (F : Π a, perm (β a)) :
+  (sigma_congr_right F).symm = sigma_congr_right (λ a, (F a).symm) :=
+equiv.sigma_congr_right_symm F
+
+@[simp] lemma sigma_congr_right_refl {α} {β : α → Sort*} :
+  (sigma_congr_right (λ a, equiv.refl (β a))) = equiv.refl (Σ a, β a) :=
+equiv.sigma_congr_right_refl
+
+end perm
+
+/-- An equivalence `f : α₁ ≃ α₂` generates an equivalence between `Σ a, β (f a)` and `Σ a, β a`. -/
+@[simps apply]
+def sigma_congr_left {α₁ α₂} {β : α₂ → Sort*} (e : α₁ ≃ α₂) : (Σ a:α₁, β (e a)) ≃ (Σ a:α₂, β a) :=
+⟨λ a, ⟨e a.1, a.2⟩, λ a, ⟨e.symm a.1, @@eq.rec β a.2 (e.right_inv a.1).symm⟩,
+ λ ⟨a, b⟩, match e.symm (e a), e.left_inv a : ∀ a' (h : a' = a),
+     @sigma.mk _ (β ∘ e) _ (@@eq.rec β b (congr_arg e h.symm)) = ⟨a, b⟩ with
+   | _, rfl := rfl end,
+ λ ⟨a, b⟩, match e (e.symm a), _ : ∀ a' (h : a' = a),
+     sigma.mk a' (@@eq.rec β b h.symm) = ⟨a, b⟩ with
+   | _, rfl := rfl end⟩
+
+/-- Transporting a sigma type through an equivalence of the base -/
+def sigma_congr_left' {α₁ α₂} {β : α₁ → Sort*} (f : α₁ ≃ α₂) :
+  (Σ a:α₁, β a) ≃ (Σ a:α₂, β (f.symm a)) :=
+(sigma_congr_left f.symm).symm
+
+/-- Transporting a sigma type through an equivalence of the base and a family of equivalences
+of matching fibers -/
+def sigma_congr {α₁ α₂} {β₁ : α₁ → Sort*} {β₂ : α₂ → Sort*} (f : α₁ ≃ α₂)
+  (F : ∀ a, β₁ a ≃ β₂ (f a)) :
+  sigma β₁ ≃ sigma β₂ :=
+(sigma_congr_right F).trans (sigma_congr_left f)
+
+/-- `sigma` type with a constant fiber is equivalent to the product. -/
+@[simps apply symm_apply { attrs := [`simp, `mfld_simps] }]
+def sigma_equiv_prod (α β : Type*) : (Σ_:α, β) ≃ α × β :=
+⟨λ a, ⟨a.1, a.2⟩, λ a, ⟨a.1, a.2⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩
+
+/-- If each fiber of a `sigma` type is equivalent to a fixed type, then the sigma type
+is equivalent to the product. -/
+def sigma_equiv_prod_of_equiv {α β} {β₁ : α → Sort*} (F : Π a, β₁ a ≃ β) : sigma β₁ ≃ α × β :=
+(sigma_congr_right F).trans (sigma_equiv_prod α β)
+
+/-- Dependent product of types is associative up to an equivalence. -/
+def sigma_assoc {α : Type*} {β : α → Type*} (γ : Π (a : α), β a → Type*) :
+  (Σ (ab : Σ (a : α), β a), γ ab.1 ab.2) ≃ Σ (a : α), (Σ (b : β a), γ a b) :=
+{ to_fun := λ x, ⟨x.1.1, ⟨x.1.2, x.2⟩⟩,
+  inv_fun := λ x, ⟨⟨x.1, x.2.1⟩, x.2.2⟩,
+  left_inv := λ ⟨⟨a, b⟩, c⟩, rfl,
+  right_inv := λ ⟨a, ⟨b, c⟩⟩, rfl }
+
+end
+
+protected lemma exists_unique_congr {p : α → Prop} {q : β → Prop} (f : α ≃ β)
+  (h : ∀{x}, p x ↔ q (f x)) : (∃! x, p x) ↔ ∃! y, q y :=
+begin
+  split,
+  { rintro ⟨a, ha₁, ha₂⟩,
+    exact ⟨f a, h.1 ha₁, λ b hb, f.symm_apply_eq.1 (ha₂ (f.symm b) (h.2 (by simpa using hb)))⟩ },
+  { rintro ⟨b, hb₁, hb₂⟩,
+    exact ⟨f.symm b, h.2 (by simpa using hb₁), λ y hy, (eq_symm_apply f).2 (hb₂ _ (h.1 hy))⟩ }
+end
+
+protected lemma exists_unique_congr_left' {p : α → Prop} (f : α ≃ β) :
+  (∃! x, p x) ↔ (∃! y, p (f.symm y)) :=
+equiv.exists_unique_congr f (λx, by simp)
+
+protected lemma exists_unique_congr_left {p : β → Prop} (f : α ≃ β) :
+  (∃! x, p (f x)) ↔ (∃! y, p y) :=
+(equiv.exists_unique_congr_left' f.symm).symm
+
+protected lemma forall_congr {p : α → Prop} {q : β → Prop} (f : α ≃ β)
+  (h : ∀{x}, p x ↔ q (f x)) : (∀x, p x) ↔ (∀y, q y) :=
+begin
+  split; intros h₂ x,
+  { rw [←f.right_inv x], apply h.mp, apply h₂ },
+  apply h.mpr, apply h₂
+end
+protected lemma forall_congr' {p : α → Prop} {q : β → Prop} (f : α ≃ β)
+  (h : ∀{x}, p (f.symm x) ↔ q x) : (∀x, p x) ↔ (∀y, q y) :=
+(equiv.forall_congr f.symm (λ x, h.symm)).symm
+
+-- We next build some higher arity versions of `equiv.forall_congr`.
+-- Although they appear to just be repeated applications of `equiv.forall_congr`,
+-- unification of metavariables works better with these versions.
+-- In particular, they are necessary in `equiv_rw`.
+-- (Stopping at ternary functions seems reasonable: at least in 1-categorical mathematics,
+-- it's rare to have axioms involving more than 3 elements at once.)
+universes ua1 ua2 ub1 ub2 ug1 ug2
+variables {α₁ : Sort ua1} {α₂ : Sort ua2}
+          {β₁ : Sort ub1} {β₂ : Sort ub2}
+          {γ₁ : Sort ug1} {γ₂ : Sort ug2}
+
+protected lemma forall₂_congr {p : α₁ → β₁ → Prop} {q : α₂ → β₂ → Prop} (eα : α₁ ≃ α₂)
+  (eβ : β₁ ≃ β₂) (h : ∀{x y}, p x y ↔ q (eα x) (eβ y)) :
+  (∀x y, p x y) ↔ (∀x y, q x y) :=
+begin
+  apply equiv.forall_congr,
+  intros,
+  apply equiv.forall_congr,
+  intros,
+  apply h,
+end
+protected lemma forall₂_congr' {p : α₁ → β₁ → Prop} {q : α₂ → β₂ → Prop} (eα : α₁ ≃ α₂)
+  (eβ : β₁ ≃ β₂) (h : ∀{x y}, p (eα.symm x) (eβ.symm y) ↔ q x y) :
+  (∀x y, p x y) ↔ (∀x y, q x y) :=
+(equiv.forall₂_congr eα.symm eβ.symm (λ x y, h.symm)).symm
+
+protected lemma forall₃_congr {p : α₁ → β₁ → γ₁ → Prop} {q : α₂ → β₂ → γ₂ → Prop}
+  (eα : α₁ ≃ α₂) (eβ : β₁ ≃ β₂) (eγ : γ₁ ≃ γ₂)
+  (h : ∀{x y z}, p x y z ↔ q (eα x) (eβ y) (eγ z)) : (∀x y z, p x y z) ↔ (∀x y z, q x y z) :=
+begin
+  apply equiv.forall₂_congr,
+  intros,
+  apply equiv.forall_congr,
+  intros,
+  apply h,
+end
+protected lemma forall₃_congr' {p : α₁ → β₁ → γ₁ → Prop} {q : α₂ → β₂ → γ₂ → Prop}
+  (eα : α₁ ≃ α₂) (eβ : β₁ ≃ β₂) (eγ : γ₁ ≃ γ₂)
+  (h : ∀{x y z}, p (eα.symm x) (eβ.symm y) (eγ.symm z) ↔ q x y z) :
+    (∀x y z, p x y z) ↔ (∀x y z, q x y z) :=
+(equiv.forall₃_congr eα.symm eβ.symm eγ.symm (λ x y z, h.symm)).symm
+
+protected lemma forall_congr_left' {p : α → Prop} (f : α ≃ β) :
+  (∀x, p x) ↔ (∀y, p (f.symm y)) :=
+equiv.forall_congr f (λx, by simp)
+
+protected lemma forall_congr_left {p : β → Prop} (f : α ≃ β) :
+  (∀x, p (f x)) ↔ (∀y, p y) :=
+(equiv.forall_congr_left' f.symm).symm
+
+protected lemma exists_congr_left {α β} (f : α ≃ β) {p : α → Prop} :
+  (∃ a, p a) ↔ (∃ b, p (f.symm b)) :=
+⟨λ ⟨a, h⟩, ⟨f a, by simpa using h⟩, λ ⟨b, h⟩, ⟨_, h⟩⟩
+
+end equiv
+
+
+namespace quot
+
+/-- An equivalence `e : α ≃ β` generates an equivalence between quotient spaces,
+if `ra a₁ a₂ ↔ rb (e a₁) (e a₂). -/
+protected def congr {ra : α → α → Prop} {rb : β → β → Prop} (e : α ≃ β)
+  (eq : ∀a₁ a₂, ra a₁ a₂ ↔ rb (e a₁) (e a₂)) :
+  quot ra ≃ quot rb :=
+{ to_fun := quot.map e (assume a₁ a₂, (eq a₁ a₂).1),
+  inv_fun := quot.map e.symm
+    (assume b₁ b₂ h,
+     (eq (e.symm b₁) (e.symm b₂)).2
+       ((e.apply_symm_apply b₁).symm ▸ (e.apply_symm_apply b₂).symm ▸ h)),
+  left_inv := by { rintros ⟨a⟩, dunfold quot.map, simp only [equiv.symm_apply_apply] },
+  right_inv := by { rintros ⟨a⟩, dunfold quot.map, simp only [equiv.apply_symm_apply] } }
+
+@[simp]
+lemma congr_mk {ra : α → α → Prop} {rb : β → β → Prop} (e : α ≃ β)
+  (eq : ∀ (a₁ a₂ : α), ra a₁ a₂ ↔ rb (e a₁) (e a₂)) (a : α) :
+  quot.congr e eq (quot.mk ra a) = quot.mk rb (e a) := rfl
+
+/-- Quotients are congruent on equivalences under equality of their relation.
+An alternative is just to use rewriting with `eq`, but then computational proofs get stuck. -/
+protected def congr_right {r r' : α → α → Prop} (eq : ∀a₁ a₂, r a₁ a₂ ↔ r' a₁ a₂) :
+  quot r ≃ quot r' :=
+quot.congr (equiv.refl α) eq
+
+/-- An equivalence `e : α ≃ β` generates an equivalence between the quotient space of `α`
+by a relation `ra` and the quotient space of `β` by the image of this relation under `e`. -/
+protected def congr_left {r : α → α → Prop} (e : α ≃ β) :
+  quot r ≃ quot (λ b b', r (e.symm b) (e.symm b')) :=
+@quot.congr α β r (λ b b', r (e.symm b) (e.symm b')) e (λ a₁ a₂, by simp only [e.symm_apply_apply])
+
+end quot
+
+namespace quotient
+/-- An equivalence `e : α ≃ β` generates an equivalence between quotient spaces,
+if `ra a₁ a₂ ↔ rb (e a₁) (e a₂). -/
+protected def congr {ra : setoid α} {rb : setoid β} (e : α ≃ β)
+  (eq : ∀a₁ a₂, @setoid.r α ra a₁ a₂ ↔ @setoid.r β rb (e a₁) (e a₂)) :
+  quotient ra ≃ quotient rb :=
+quot.congr e eq
+
+@[simp]
+lemma congr_mk {ra : setoid α} {rb : setoid β} (e : α ≃ β)
+  (eq : ∀ (a₁ a₂ : α), setoid.r a₁ a₂ ↔ setoid.r (e a₁) (e a₂)) (a : α):
+  quotient.congr e eq (quotient.mk a) = quotient.mk (e a) :=
+rfl
+
+/-- Quotients are congruent on equivalences under equality of their relation.
+An alternative is just to use rewriting with `eq`, but then computational proofs get stuck. -/
+protected def congr_right {r r' : setoid α}
+  (eq : ∀a₁ a₂, @setoid.r α r a₁ a₂ ↔ @setoid.r α r' a₁ a₂) : quotient r ≃ quotient r' :=
+quot.congr_right eq
+
+end quotient
diff --git a/src/logic/equiv/embedding.lean b/src/logic/equiv/embedding.lean
index e73af659e8869..ef8d3c64aa9cb 100644
--- a/src/logic/equiv/embedding.lean
+++ b/src/logic/equiv/embedding.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Eric Rodriguez. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Rodriguez
 -/
-import logic.embedding
+import logic.embedding.set
 
 /-!
 # Equivalences on embeddings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file shows some advanced equivalences on embeddings, useful for constructing larger
 embeddings from smaller ones.
 -/
@@ -21,7 +24,8 @@ def sum_embedding_equiv_prod_embedding_disjoint {α β γ : Type*} :
   ((α ⊕ β) ↪ γ) ≃ {f : (α ↪ γ) × (β ↪ γ) // disjoint (set.range f.1) (set.range f.2)} :=
 { to_fun := λ f, ⟨(inl.trans f, inr.trans f),
   begin
-    rintros _ ⟨⟨a, h⟩, ⟨b, rfl⟩⟩,
+    rw set.disjoint_left,
+    rintros _ ⟨a, h⟩ ⟨b, rfl⟩,
     simp only [trans_apply, inl_apply, inr_apply] at h,
     have : sum.inl a = sum.inr b := f.injective h,
     simp only at this,
@@ -36,8 +40,8 @@ def sum_embedding_equiv_prod_embedding_disjoint {α β γ : Type*} :
       rintros (a₁|b₁) (a₂|b₂) f_eq;
       simp only [equiv.coe_fn_symm_mk, sum.elim_inl, sum.elim_inr] at f_eq,
       { rw f.injective f_eq },
-      { simp! only at f_eq, exfalso, exact disj ⟨⟨a₁, by simp⟩, ⟨b₂, by simp [f_eq]⟩⟩ },
-      { simp! only at f_eq, exfalso, exact disj ⟨⟨a₂, by simp⟩, ⟨b₁, by simp [f_eq]⟩⟩ },
+      { simp! only at f_eq, exfalso, exact disj.le_bot ⟨⟨a₁, by simp⟩, ⟨b₂, by simp [f_eq]⟩⟩ },
+      { simp! only at f_eq, exfalso, exact disj.le_bot ⟨⟨a₂, by simp⟩, ⟨b₁, by simp [f_eq]⟩⟩ },
       { rw g.injective f_eq }
     end⟩,
   left_inv := λ f, by { dsimp only, ext, cases x; simp! },
@@ -59,12 +63,9 @@ def prod_embedding_disjoint_equiv_sigma_embedding_restricted {α β γ : Type*}
   (Σ f : α ↪ γ, β ↪ ↥((set.range f)ᶜ)) :=
 (subtype_prod_equiv_sigma_subtype $
   λ (a : α ↪ γ) (b : β ↪ _), disjoint (set.range a) (set.range b)).trans $
-  equiv.sigma_congr_right $ λ a,
-    (subtype_equiv_prop begin
-      ext f,
-      rw [←set.range_subset_iff, set.subset_compl_iff_disjoint],
-      exact disjoint.comm.trans disjoint_iff,
-    end).trans (cod_restrict _ _)
+  equiv.sigma_congr_right $ λ a, (subtype_equiv_prop $ by { ext f,
+    rw [←set.range_subset_iff, set.subset_compl_iff_disjoint_right, disjoint.comm] }).trans
+      (cod_restrict _ _)
 
 /-- A combination of the above results, allowing us to turn one embedding over a sum type
 into two dependent embeddings, the second of which avoids any members of the range
diff --git a/src/logic/equiv/fin.lean b/src/logic/equiv/fin.lean
index eae5b663119c0..2033818a7e7ac 100644
--- a/src/logic/equiv/fin.lean
+++ b/src/logic/equiv/fin.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
 import data.fin.vec_notation
-import logic.equiv.basic
-import tactic.norm_num
+import data.int.order.basic
+import logic.equiv.defs
 
 /-!
 # Equivalences for `fin n`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 universes u
@@ -25,22 +28,14 @@ equiv.equiv_pempty _
 
 /-- Equivalence between `fin 1` and `unit`. -/
 def fin_one_equiv : fin 1 ≃ unit :=
-equiv_punit_of_unique
+equiv.equiv_punit _
 
 /-- Equivalence between `fin 2` and `bool`. -/
 def fin_two_equiv : fin 2 ≃ bool :=
-⟨@fin.cases 1 (λ_, bool) ff (λ_, tt),
-  λb, cond b 1 0,
-  begin
-    refine fin.cases _ _, by norm_num,
-    refine fin.cases _ _, by norm_num,
-    exact λi, fin_zero_elim i
-  end,
-  begin
-    rintro ⟨_|_⟩,
-    { refl },
-    { rw ← fin.succ_zero_eq_one, refl }
-  end⟩
+{ to_fun := ![ff, tt],
+  inv_fun := λ b, cond b 1 0,
+  left_inv := fin.forall_fin_two.2 $ by simp,
+  right_inv := bool.forall_bool.2 $ by simp }
 
 /-- `Π i : fin 2, α i` is equivalent to `α 0 × α 1`. See also `fin_two_arrow_equiv` for a
 non-dependent version and `prod_equiv_pi_fin_two` for a version with inputs `α β : Type u`. -/
@@ -185,6 +180,61 @@ fin_succ_equiv_symm_some m
 lemma fin_succ_equiv'_zero {n : ℕ} :
   fin_succ_equiv' (0 : fin (n + 1)) = fin_succ_equiv n := rfl
 
+lemma fin_succ_equiv'_last_apply {n : ℕ} {i : fin (n + 1)} (h : i ≠ fin.last n) :
+  fin_succ_equiv' (fin.last n) i =
+    fin.cast_lt i (lt_of_le_of_ne (fin.le_last _) (fin.coe_injective.ne_iff.2 h) : ↑i < n) :=
+begin
+  have h' : ↑i < n := lt_of_le_of_ne (fin.le_last _) (fin.coe_injective.ne_iff.2 h),
+  conv_lhs { rw ←fin.cast_succ_cast_lt i h' },
+  convert fin_succ_equiv'_below _,
+  rw fin.cast_succ_cast_lt i h',
+  exact h'
+end
+
+lemma fin_succ_equiv'_ne_last_apply {i j : fin (n + 1)} (hi : i ≠ fin.last n)
+  (hj : j ≠ i) :
+  fin_succ_equiv' i j = (i.cast_lt (lt_of_le_of_ne (fin.le_last _)
+                                     (fin.coe_injective.ne_iff.2 hi) : ↑i < n)).pred_above j :=
+begin
+  rw [fin.pred_above],
+  have hi' : ↑i < n := lt_of_le_of_ne (fin.le_last _) (fin.coe_injective.ne_iff.2 hi),
+  rcases hj.lt_or_lt with hij | hij,
+  { simp only [hij.not_lt, fin.cast_succ_cast_lt, not_false_iff, dif_neg],
+    convert fin_succ_equiv'_below _,
+    { simp },
+    { exact hij } },
+  { simp only [hij, fin.cast_succ_cast_lt, dif_pos],
+    convert fin_succ_equiv'_above _,
+    { simp },
+    { simp [fin.le_cast_succ_iff, hij] } }
+end
+
+/-- `succ_above` as an order isomorphism between `fin n` and `{x : fin (n + 1) // x ≠ p}`. -/
+def fin_succ_above_equiv (p : fin (n + 1)) : fin n ≃o {x : fin (n + 1) // x ≠ p} :=
+{ map_rel_iff' := λ _ _, p.succ_above.map_rel_iff',
+  ..equiv.option_subtype p ⟨(fin_succ_equiv' p).symm, rfl⟩ }
+
+lemma fin_succ_above_equiv_apply (p : fin (n + 1)) (i : fin n) :
+  fin_succ_above_equiv p i = ⟨p.succ_above i, p.succ_above_ne i⟩ :=
+rfl
+
+lemma fin_succ_above_equiv_symm_apply_last (x : {x : fin (n + 1) // x ≠ fin.last n}) :
+  (fin_succ_above_equiv (fin.last n)).symm x =
+    fin.cast_lt (x : fin (n + 1))
+                (lt_of_le_of_ne (fin.le_last _) (fin.coe_injective.ne_iff.2 x.property)) :=
+begin
+  rw [←option.some_inj, ←option.coe_def],
+  simpa [fin_succ_above_equiv, order_iso.symm] using fin_succ_equiv'_last_apply x.property,
+end
+
+lemma fin_succ_above_equiv_symm_apply_ne_last {p : fin (n + 1)} (h : p ≠ fin.last n)
+  (x : {x : fin (n + 1) // x ≠ p}) : (fin_succ_above_equiv p).symm x =
+    (p.cast_lt (lt_of_le_of_ne (fin.le_last _) (fin.coe_injective.ne_iff.2 h))).pred_above x :=
+begin
+  rw [←option.some_inj, ←option.coe_def],
+  simpa [fin_succ_above_equiv, order_iso.symm] using fin_succ_equiv'_ne_last_apply h x.property
+end
+
 /-- `equiv` between `fin (n + 1)` and `option (fin n)` sending `fin.last n` to `none` -/
 def fin_succ_equiv_last {n : ℕ} : fin (n + 1) ≃ option (fin n) :=
 fin_succ_equiv' (fin.last n)
@@ -226,6 +276,12 @@ def order_iso.pi_fin_succ_above_iso {n : ℕ} (α : fin (n + 1) → Type u) [Π
 { to_equiv := equiv.pi_fin_succ_above_equiv α i,
   map_rel_iff' := λ f g, i.forall_iff_succ_above.symm }
 
+/-- Equivalence between `fin (n + 1) → β` and `β × (fin n → β)`. -/
+@[simps { fully_applied := ff}]
+def equiv.pi_fin_succ (n : ℕ) (β : Type u) :
+  (fin (n+1) → β) ≃ β × (fin n → β) :=
+equiv.pi_fin_succ_above_equiv (λ _, β) 0
+
 /-- Equivalence between `fin m ⊕ fin n` and `fin (m + n)` -/
 def fin_sum_fin_equiv : fin m ⊕ fin n ≃ fin (m + n) :=
 { to_fun := sum.elim (fin.cast_add n) (fin.nat_add m),
@@ -247,6 +303,10 @@ fin_sum_fin_equiv.symm_apply_apply (sum.inl x)
   fin_sum_fin_equiv.symm (fin.nat_add m x) = sum.inr x :=
 fin_sum_fin_equiv.symm_apply_apply (sum.inr x)
 
+@[simp] lemma fin_sum_fin_equiv_symm_last :
+  fin_sum_fin_equiv.symm (fin.last n) = sum.inr 0 :=
+fin_sum_fin_equiv_symm_apply_nat_add 0
+
 /-- The equivalence between `fin (m + n)` and `fin (n + m)` which rotates by `n`. -/
 def fin_add_flip : fin (m + n) ≃ fin (n + m) :=
 (fin_sum_fin_equiv.symm.trans (equiv.sum_comm _ _)).trans fin_sum_fin_equiv
@@ -365,11 +425,45 @@ def fin_prod_fin_equiv : fin m × fin n ≃ fin (m * n) :=
         ... = y.1 : nat.mod_eq_of_lt y.2),
   right_inv := λ x, fin.eq_of_veq $ nat.mod_add_div _ _ }
 
+/-- The equivalence induced by `a ↦ (a / n, a % n)` for nonzero `n`.
+
+This is like `fin_prod_fin_equiv.symm` but with `m` infinite.
+See `nat.div_mod_unique` for a similar propositional statement. -/
+@[simps]
+def nat.div_mod_equiv (n : ℕ) [ne_zero n] : ℕ ≃ ℕ × fin n :=
+{ to_fun := λ a, (a / n, ↑a),
+  inv_fun := λ p, p.1 * n + ↑p.2,  -- TODO: is there a canonical order of `*` and `+` here?
+  left_inv := λ a, nat.div_add_mod' _ _,
+  right_inv := λ p, begin
+    refine prod.ext _ (fin.ext $ nat.mul_add_mod_of_lt p.2.is_lt),
+    dsimp only,
+    rw [add_comm, nat.add_mul_div_right _ _ (ne_zero.pos n), nat.div_eq_of_lt p.2.is_lt, zero_add],
+  end }
+
+/-- The equivalence induced by `a ↦ (a / n, a % n)` for nonzero `n`.
+
+See `int.div_mod_unique` for a similar propositional statement. -/
+@[simps]
+def int.div_mod_equiv (n : ℕ) [ne_zero n] : ℤ ≃ ℤ × fin n :=
+{ -- TODO: could cast from int directly if we import `data.zmod.defs`, though there are few lemmas
+  -- about that coercion.
+  to_fun := λ a, (a / n, ↑(a.nat_mod n)),
+  inv_fun := λ p, p.1 * n + ↑p.2,
+  left_inv := λ a, by simp_rw [coe_coe, fin.coe_of_nat_eq_mod, int.coe_nat_mod, int.nat_mod,
+    int.to_nat_of_nonneg (int.mod_nonneg _ $ ne_zero.ne n), int.mod_mod, int.div_add_mod'],
+  right_inv := λ ⟨q, r, hrn⟩, begin
+    simp only [fin.coe_mk, prod.mk.inj_iff, fin.ext_iff, coe_coe],
+    obtain ⟨h1, h2⟩ := ⟨int.coe_nat_nonneg r, int.coe_nat_lt.2 hrn⟩,
+    rw [add_comm, int.add_mul_div_right _ _ (ne_zero.ne n), int.div_eq_zero_of_lt h1 h2,
+        int.nat_mod, int.add_mul_mod_self, int.mod_eq_of_lt h1 h2, int.to_nat_coe_nat],
+    exact ⟨zero_add q, fin.coe_coe_of_lt hrn⟩,
+  end }
+
 /-- Promote a `fin n` into a larger `fin m`, as a subtype where the underlying
 values are retained. This is the `order_iso` version of `fin.cast_le`. -/
 @[simps apply symm_apply]
 def fin.cast_le_order_iso {n m : ℕ} (h : n ≤ m) : fin n ≃o {i : fin m // (i : ℕ) < n} :=
-{ to_fun := λ i, ⟨fin.cast_le h i, by simpa using i.is_lt⟩,
+{ to_fun := λ i, ⟨fin.cast_le h i, by simp⟩,
   inv_fun := λ i, ⟨i, i.prop⟩,
   left_inv := λ _, by simp,
   right_inv := λ _, by simp,
diff --git a/src/logic/equiv/fintype.lean b/src/logic/equiv/fintype.lean
index 253760caf4612..989c0e6d07601 100644
--- a/src/logic/equiv/fintype.lean
+++ b/src/logic/equiv/fintype.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yakov Pechersky
 -/
 
-import data.set.finite
+import data.fintype.basic
 import group_theory.perm.sign
-import logic.equiv.basic
+import logic.equiv.defs
 
 /-! # Equivalence between fintypes
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some basic results on equivalences where one or both
 sides of the equivalence are `fintype`s.
 
@@ -87,7 +90,7 @@ is an equivalence between the complement of those subtypes.
 See also `equiv.compl`, for a computable version when a term of type
 `{e' : α ≃ α // ∀ x : {x // p x}, e' x = e x}` is known. -/
 noncomputable def to_compl (e : {x // p x} ≃ {x // q x}) : {x // ¬ p x} ≃ {x // ¬ q x} :=
-classical.choice (fintype.card_eq.mp (fintype.card_compl_eq_card_compl (fintype.card_congr e)))
+classical.choice (fintype.card_eq.mp (fintype.card_compl_eq_card_compl _ _ (fintype.card_congr e)))
 
 /-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.extend_subtype`
 is a permutation of `α` acting like `e` on the subtypes and doing something arbitrary outside.
diff --git a/src/logic/equiv/functor.lean b/src/logic/equiv/functor.lean
index 3ecd01ad4c5de..54d3dfeed9eb3 100644
--- a/src/logic/equiv/functor.lean
+++ b/src/logic/equiv/functor.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Simon Hudon, Scott Morrison
 -/
 import control.bifunctor
-import logic.equiv.basic
+import logic.equiv.defs
 
 /-!
 # Functor and bifunctors can be applied to `equiv`s.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define
 ```lean
 def functor.map_equiv (f : Type u → Type v) [functor f] [is_lawful_functor f] :
diff --git a/src/logic/equiv/list.lean b/src/logic/equiv/list.lean
index 523c5832cb68d..8a960fc413368 100644
--- a/src/logic/equiv/list.lean
+++ b/src/logic/equiv/list.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 import data.finset.sort
+import data.vector.basic
 import logic.denumerable
 
 /-!
 # Equivalences involving `list`-like types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines some additional constructive equivalences using `encodable` and the pairing
 function on `ℕ`.
 -/
@@ -41,6 +45,9 @@ instance _root_.list.encodable : encodable (list α) :=
 ⟨encode_list, decode_list, λ l,
   by induction l with a l IH; simp [encode_list, decode_list, unpair_mkpair, encodek, *]⟩
 
+instance _root_.list.countable {α : Type*} [countable α] : countable (list α) :=
+by { haveI := encodable.of_countable α, apply_instance }
+
 @[simp] theorem encode_list_nil : encode (@nil α) = 0 := rfl
 @[simp] theorem encode_list_cons (a : α) (l : list α) :
   encode (a :: l) = succ (mkpair (encode a) (encode l)) := rfl
@@ -88,6 +95,10 @@ instance _root_.multiset.encodable : encodable (multiset α) :=
 ⟨encode_multiset, decode_multiset,
  λ s, by simp [encode_multiset, decode_multiset, encodek]⟩
 
+/-- If `α` is countable, then so is `multiset α`. -/
+instance _root_.multiset.countable {α : Type*} [countable α] : countable (multiset α) :=
+quotient.countable
+
 end finset
 
 /-- A listable type with decidable equality is encodable. -/
@@ -112,6 +123,9 @@ by { classical, exact (fintype.trunc_encodable α).out }
 /-- If `α` is encodable, then so is `vector α n`. -/
 instance _root_.vector.encodable [encodable α] {n} : encodable (vector α n) := subtype.encodable
 
+/-- If `α` is countable, then so is `vector α n`. -/
+instance _root_.vector.countable [countable α] {n} : countable (vector α n) := subtype.countable
+
 /-- If `α` is encodable, then so is `fin n → α`. -/
 instance fin_arrow [encodable α] {n} : encodable (fin n → α) :=
 of_equiv _ (equiv.vector_equiv_fin _ _).symm
@@ -119,16 +133,16 @@ of_equiv _ (equiv.vector_equiv_fin _ _).symm
 instance fin_pi (n) (π : fin n → Type*) [∀ i, encodable (π i)] : encodable (Π i, π i) :=
 of_equiv _ (equiv.pi_equiv_subtype_sigma (fin n) π)
 
-/-- If `α` is encodable, then so is `array n α`. -/
-instance _root_.array.encodable [encodable α] {n} : encodable (array n α) :=
-of_equiv _ (equiv.array_equiv_fin _ _)
-
 /-- If `α` is encodable, then so is `finset α`. -/
 instance _root_.finset.encodable [encodable α] : encodable (finset α) :=
 by haveI := decidable_eq_of_encodable α; exact
  of_equiv {s : multiset α // s.nodup}
   ⟨λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, ⟨a, b⟩, λ ⟨a, b⟩, rfl, λ ⟨a, b⟩, rfl⟩
 
+/-- If `α` is countable, then so is `finset α`. -/
+instance _root_.finset.countable [countable α] : countable (finset α) :=
+finset.val_injective.countable
+
 -- TODO: Unify with `fintype_pi` and find a better name
 /-- When `α` is finite and `β` is encodable, `α → β` is encodable too. Because the encoding is not
 unique, we wrap it in `trunc` to preserve computability. -/
@@ -251,7 +265,7 @@ lemma raise_chain : ∀ l n, list.chain (≤) n (raise l n)
 /-- `raise l n` is an non-decreasing sequence. -/
 lemma raise_sorted : ∀ l n, list.sorted (≤) (raise l n)
 | []       n := list.sorted_nil
-| (m :: l) n := (list.chain_iff_pairwise (@le_trans _ _)).1 (raise_chain _ _)
+| (m :: l) n := list.chain_iff_pairwise.1 (raise_chain _ _)
 
 /-- If `α` is denumerable, then so is `multiset α`. Warning: this is *not* the same encoding as used
 in `multiset.encodable`. -/
@@ -299,8 +313,7 @@ lemma raise'_chain : ∀ l {m n}, m < n → list.chain (<) m (raise' l n)
 /-- `raise' l n` is a strictly increasing sequence. -/
 lemma raise'_sorted : ∀ l n, list.sorted (<) (raise' l n)
 | []       n := list.sorted_nil
-| (m :: l) n := (list.chain_iff_pairwise (@lt_trans _ _)).1
-  (raise'_chain _ (lt_succ_self _))
+| (m :: l) n := list.chain_iff_pairwise.1 (raise'_chain _ (lt_succ_self _))
 
 /-- Makes `raise' l n` into a finset. Elements are distinct thanks to `raise'_sorted`. -/
 def raise'_finset (l : list ℕ) (n : ℕ) : finset ℕ :=
@@ -326,15 +339,15 @@ namespace equiv
 /-- The type lists on unit is canonically equivalent to the natural numbers. -/
 def list_unit_equiv : list unit ≃ ℕ :=
 { to_fun := list.length,
-  inv_fun := list.repeat (),
+  inv_fun := λ n, list.replicate n (),
   left_inv := λ u, list.length_injective (by simp),
-  right_inv := λ n, list.length_repeat () n }
+  right_inv := λ n, list.length_replicate n () }
 
 /-- `list ℕ` is equivalent to `ℕ`. -/
 def list_nat_equiv_nat : list ℕ ≃ ℕ := denumerable.eqv _
 
 /-- If `α` is equivalent to `ℕ`, then `list α` is equivalent to `α`. -/
-def list_equiv_self_of_equiv_nat {α : Type} (e : α ≃ ℕ) : list α ≃ α :=
+def list_equiv_self_of_equiv_nat {α : Type*} (e : α ≃ ℕ) : list α ≃ α :=
 calc list α ≃ list ℕ : list_equiv_of_equiv e
         ... ≃ ℕ      : list_nat_equiv_nat
         ... ≃ α      : e.symm
diff --git a/src/logic/equiv/local_equiv.lean b/src/logic/equiv/local_equiv.lean
index b6bed0f350ce1..d86e01abfeddc 100644
--- a/src/logic/equiv/local_equiv.lean
+++ b/src/logic/equiv/local_equiv.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import data.set.function
-import logic.equiv.basic
+import logic.equiv.defs
 
 /-!
 # Local equivalences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files defines equivalences between subsets of given types.
 An element `e` of `local_equiv α β` is made of two maps `e.to_fun` and `e.inv_fun` respectively
 from α to β and from  β to α (just like equivs), which are inverse to each other on the subsets
@@ -65,29 +68,6 @@ then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or
 
 -/
 
-mk_simp_attribute mfld_simps "The simpset `mfld_simps` records several simp lemmas that are
-especially useful in manifolds. It is a subset of the whole set of simp lemmas, but it makes it
-possible to have quicker proofs (when used with `squeeze_simp` or `simp only`) while retaining
-readability.
-
-The typical use case is the following, in a file on manifolds:
-If `simp [foo, bar]` is slow, replace it with `squeeze_simp [foo, bar] with mfld_simps` and paste
-its output. The list of lemmas should be reasonable (contrary to the output of
-`squeeze_simp [foo, bar]` which might contain tens of lemmas), and the outcome should be quick
-enough.
-"
-
--- register in the simpset `mfld_simps` several lemmas that are often useful when dealing
--- with manifolds
-attribute [mfld_simps] id.def function.comp.left_id set.mem_set_of_eq set.image_eq_empty
-set.univ_inter set.preimage_univ set.prod_mk_mem_set_prod_eq and_true set.mem_univ
-set.mem_image_of_mem true_and set.mem_inter_eq set.mem_preimage function.comp_app
-set.inter_subset_left set.mem_prod set.range_id set.range_prod_map and_self set.mem_range_self
-eq_self_iff_true forall_const forall_true_iff set.inter_univ set.preimage_id function.comp.right_id
-not_false_iff and_imp set.prod_inter_prod set.univ_prod_univ true_or or_true prod.map_mk
-set.preimage_inter heq_iff_eq equiv.sigma_equiv_prod_apply equiv.sigma_equiv_prod_symm_apply
-subtype.coe_mk equiv.to_fun_as_coe equiv.inv_fun_as_coe
-
 /-- Common `@[simps]` configuration options used for manifold-related declarations. -/
 def mfld_cfg : simps_cfg := {attrs := [`simp, `mfld_simps], fully_applied := ff}
 
@@ -126,21 +106,10 @@ structure local_equiv (α : Type*) (β : Type*) :=
 (inv_fun     : β → α)
 (source      : set α)
 (target      : set β)
-(map_source' : ∀{x}, x ∈ source → to_fun x ∈ target)
-(map_target' : ∀{x}, x ∈ target → inv_fun x ∈ source)
-(left_inv'   : ∀{x}, x ∈ source → inv_fun (to_fun x) = x)
-(right_inv'  : ∀{x}, x ∈ target → to_fun (inv_fun x) = x)
-
-/-- Associating a local_equiv to an equiv-/
-def equiv.to_local_equiv (e : α ≃ β) : local_equiv α β :=
-{ to_fun      := e,
-  inv_fun     := e.symm,
-  source      := univ,
-  target      := univ,
-  map_source' := λx hx, mem_univ _,
-  map_target' := λy hy, mem_univ _,
-  left_inv'   := λx hx, e.left_inv x,
-  right_inv'  := λx hx, e.right_inv x }
+(map_source' : ∀ {{x}}, x ∈ source → to_fun x ∈ target)
+(map_target' : ∀ {{x}}, x ∈ target → inv_fun x ∈ source)
+(left_inv'   : ∀ {{x}}, x ∈ source → inv_fun (to_fun x) = x)
+(right_inv'  : ∀ {{x}}, x ∈ target → to_fun (inv_fun x) = x)
 
 namespace local_equiv
 
@@ -150,9 +119,6 @@ instance [inhabited α] [inhabited β] : inhabited (local_equiv α β) :=
 ⟨⟨const α default, const β default, ∅, ∅, maps_to_empty _ _, maps_to_empty _ _,
   eq_on_empty _ _, eq_on_empty _ _⟩⟩
 
-instance inhabited_of_empty [is_empty α] [is_empty β] : inhabited (local_equiv α β) :=
-⟨((equiv.equiv_empty α).trans (equiv.equiv_empty β).symm).to_local_equiv⟩
-
 /-- The inverse of a local equiv -/
 protected def symm : local_equiv β α :=
 { to_fun     := e.inv_fun,
@@ -193,6 +159,10 @@ e.left_inv' h
 @[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
 e.right_inv' h
 
+lemma eq_symm_apply {x : α} {y : β} (hx : x ∈ e.source) (hy : y ∈ e.target) :
+  x = e.symm y ↔ e x = y :=
+⟨λ h, by rw [← e.right_inv hy, h], λ h, by rw [← e.left_inv hx, h]⟩
+
 protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
 lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
 protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
@@ -202,8 +172,23 @@ protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
 protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
 protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on
 
+/-- Associating a local_equiv to an equiv-/
+@[simps (mfld_cfg)] def _root_.equiv.to_local_equiv (e : α ≃ β) : local_equiv α β :=
+{ to_fun      := e,
+  inv_fun     := e.symm,
+  source      := univ,
+  target      := univ,
+  map_source' := λx hx, mem_univ _,
+  map_target' := λy hy, mem_univ _,
+  left_inv'   := λx hx, e.left_inv x,
+  right_inv'  := λx hx, e.right_inv x }
+
+instance inhabited_of_empty [is_empty α] [is_empty β] : inhabited (local_equiv α β) :=
+⟨((equiv.equiv_empty α).trans (equiv.equiv_empty β).symm).to_local_equiv⟩
+
 /-- Create a copy of a `local_equiv` providing better definitional equalities. -/
-@[simps] def copy (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
+@[simps {fully_applied := ff}]
+def copy (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
   (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
   local_equiv α β :=
 { to_fun := f,
@@ -215,7 +200,7 @@ protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on
   left_inv' := λ x, hs ▸ hf ▸ hg ▸ e.left_inv,
   right_inv' := λ x, ht ▸ hf ▸ hg ▸ e.right_inv }
 
-lemma copy_eq_self (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
+lemma copy_eq (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
   (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
   e.copy f hf g hg s hs t ht = e :=
 by { substs f g s t, cases e, refl }
@@ -268,7 +253,7 @@ lemma symm_maps_to (h : e.is_image s t) : maps_to e.symm (e.target ∩ t) (e.sou
 h.symm.maps_to
 
 /-- Restrict a `local_equiv` to a pair of corresponding sets. -/
-@[simps] def restr (h : e.is_image s t) : local_equiv α β :=
+@[simps {fully_applied := ff}] def restr (h : e.is_image s t) : local_equiv α β :=
 { to_fun := e,
   inv_fun := e.symm,
   source := e.source ∩ s,
@@ -285,15 +270,14 @@ lemma symm_image_eq (h : e.is_image s t) : e.symm '' (e.target ∩ t) = e.source
 h.symm.image_eq
 
 lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
-by simp only [is_image, set.ext_iff, mem_inter_eq, and.congr_right_iff, mem_preimage]
+by simp only [is_image, set.ext_iff, mem_inter_iff, and.congr_right_iff, mem_preimage]
 
-alias iff_preimage_eq ↔ local_equiv.is_image.preimage_eq local_equiv.is_image.of_preimage_eq
+alias iff_preimage_eq ↔ preimage_eq of_preimage_eq
 
 lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
 symm_iff.symm.trans iff_preimage_eq
 
-alias iff_symm_preimage_eq ↔ local_equiv.is_image.symm_preimage_eq
-  local_equiv.is_image.of_symm_preimage_eq
+alias iff_symm_preimage_eq ↔ symm_preimage_eq of_symm_preimage_eq
 
 lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
 of_symm_preimage_eq $ eq.trans (of_symm_preimage_eq rfl).image_eq.symm h
@@ -348,10 +332,7 @@ lemma is_image_source_target : e.is_image e.source e.target := λ x hx, by simp
 lemma is_image_source_target_of_disjoint (e' : local_equiv α β) (hs : disjoint e.source e'.source)
   (ht : disjoint e.target e'.target) :
   e.is_image e'.source e'.target :=
-assume x hx,
-have x ∉ e'.source, from λ hx', hs ⟨hx, hx'⟩,
-have e x ∉ e'.target, from λ hx', ht ⟨e.maps_to hx, hx'⟩,
-by simp only *
+is_image.of_image_eq $ by rw [hs.inter_eq, ht.inter_eq, image_empty]
 
 lemma image_source_inter_eq' (s : set α) :
   e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s :=
@@ -389,6 +370,14 @@ lemma target_inter_inv_preimage_preimage (s : set β) :
   e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
 e.symm.source_inter_preimage_inv_preimage _
 
+lemma symm_image_image_of_subset_source {s : set α} (h : s ⊆ e.source) :
+  e.symm '' (e '' s) = s :=
+(e.left_inv_on.mono h).image_image
+
+lemma image_symm_image_of_subset_target {s : set β} (h : s ⊆ e.target) :
+  e '' (e.symm '' s) = s :=
+e.symm.symm_image_image_of_subset_source h
+
 lemma source_subset_preimage_target : e.source ⊆ e ⁻¹' e.target :=
 e.maps_to
 
@@ -482,6 +471,7 @@ protected def trans : local_equiv α γ :=
 
 @[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
 @[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl
+lemma trans_apply {x : α} : (e.trans e') x = e' (e x) := rfl
 
 lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
 by cases e; cases e'; refl
@@ -530,6 +520,30 @@ lemma restr_trans (s : set α) :
   (e.restr s).trans e' = (e.trans e').restr s :=
 local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source, inter_comm], rwa inter_assoc }
 
+/-- A lemma commonly useful when `e` and `e'` are charts of a manifold. -/
+lemma mem_symm_trans_source {e' : local_equiv α γ} {x : α} (he : x ∈ e.source)
+  (he' : x ∈ e'.source) : e x ∈ (e.symm.trans e').source :=
+⟨e.maps_to he, by rwa [mem_preimage, local_equiv.symm_symm, e.left_inv he]⟩
+
+/-- Postcompose a local equivalence with an equivalence.
+We modify the source and target to have better definitional behavior. -/
+@[simps] def trans_equiv (e' : β ≃ γ) : local_equiv α γ :=
+(e.trans e'.to_local_equiv).copy _ rfl _ rfl e.source (inter_univ _) (e'.symm ⁻¹' e.target)
+  (univ_inter _)
+
+lemma trans_equiv_eq_trans (e' : β ≃ γ) : e.trans_equiv e' = e.trans e'.to_local_equiv :=
+copy_eq _ _ _ _ _ _ _ _ _
+
+/-- Precompose a local equivalence with an equivalence.
+We modify the source and target to have better definitional behavior. -/
+@[simps] def _root_.equiv.trans_local_equiv (e : α ≃ β) : local_equiv α γ :=
+(e.to_local_equiv.trans e').copy _ rfl _ rfl (e ⁻¹' e'.source) (univ_inter _) e'.target
+  (inter_univ _)
+
+lemma _root_.equiv.trans_local_equiv_eq_trans (e : α ≃ β) :
+  e.trans_local_equiv e' = e.to_local_equiv.trans e' :=
+copy_eq _ _ _ _ _ _ _ _ _
+
 /-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. Then `e`
 and `e'` should really be considered the same local equiv. -/
 def eq_on_source (e e' : local_equiv α β) : Prop :=
@@ -589,7 +603,7 @@ begin
   split,
   { simp [he.1] },
   { assume x hx,
-    simp only [mem_inter_eq, restr_source] at hx,
+    simp only [mem_inter_iff, restr_source] at hx,
     exact he.2 hx.1 }
 end
 
@@ -657,6 +671,10 @@ lemma prod_coe_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
   (e.prod e').symm = (e.symm.prod e'.symm) :=
 by ext x; simp [prod_coe_symm]
 
+@[simp, mfld_simps] lemma refl_prod_refl :
+  (local_equiv.refl α).prod (local_equiv.refl β) = local_equiv.refl (α × β) :=
+by { ext1 ⟨x, y⟩, { refl }, { rintro ⟨x, y⟩, refl }, exact univ_prod_univ }
+
 @[simp, mfld_simps] lemma prod_trans {η : Type*} {ε : Type*}
   (e : local_equiv α β) (f : local_equiv β γ) (e' : local_equiv δ η) (f' : local_equiv η ε) :
   (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') :=
@@ -669,7 +687,7 @@ end prod
 sends `e.source ∩ s` to `e.target ∩ t` using `e` and `e'.source \ s` to `e'.target \ t` using `e'`,
 and similarly for the inverse function. The definition assumes `e.is_image s t` and
 `e'.is_image s t`. -/
-@[simps] def piecewise (e e' : local_equiv α β) (s : set α) (t : set β)
+@[simps {fully_applied := ff}] def piecewise (e e' : local_equiv α β) (s : set α) (t : set β)
   [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t) :
   local_equiv α β :=
 { to_fun := s.piecewise e e',
@@ -690,7 +708,8 @@ rfl
 /-- Combine two `local_equiv`s with disjoint sources and disjoint targets. We reuse
 `local_equiv.piecewise`, then override `source` and `target` to ensure better definitional
 equalities. -/
-@[simps] def disjoint_union (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
+@[simps {fully_applied := ff}]
+def disjoint_union (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
   (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
   [∀ y, decidable (y ∈ e.target)] :
   local_equiv α β :=
@@ -703,14 +722,14 @@ lemma disjoint_union_eq_piecewise (e e' : local_equiv α β) (hs : disjoint e.so
   [∀ y, decidable (y ∈ e.target)] :
   e.disjoint_union e' hs ht = e.piecewise e' e.source e.target e.is_image_source_target
     (e'.is_image_source_target_of_disjoint _ hs.symm ht.symm) :=
-copy_eq_self _ _ _ _ _ _ _ _ _
+copy_eq _ _ _ _ _ _ _ _ _
 
 section pi
 
 variables {ι : Type*} {αi βi : ι → Type*} (ei : Π i, local_equiv (αi i) (βi i))
 
 /-- The product of a family of local equivs, as a local equiv on the pi type. -/
-@[simps source target] protected def pi : local_equiv (Π i, αi i) (Π i, βi i) :=
+@[simps (mfld_cfg)] protected def pi : local_equiv (Π i, αi i) (Π i, βi i) :=
 { to_fun := λ f i, ei i (f i),
   inv_fun := λ f i, (ei i).symm (f i),
   source := pi univ (λ i, (ei i).source),
@@ -720,12 +739,6 @@ variables {ι : Type*} {αi βi : ι → Type*} (ei : Π i, local_equiv (αi i)
   left_inv' := λ f hf, funext $ λ i, (ei i).left_inv (hf i trivial),
   right_inv' := λ f hf, funext $ λ i, (ei i).right_inv (hf i trivial) }
 
-attribute [mfld_simps] pi_source pi_target
-
-@[simp, mfld_simps] lemma pi_coe : ⇑(local_equiv.pi ei) = λ (f : Π i, αi i) i, ei i (f i) := rfl
-@[simp, mfld_simps] lemma pi_symm :
-  (local_equiv.pi ei).symm = local_equiv.pi (λ i, (ei i).symm) := rfl
-
 end pi
 
 end local_equiv
@@ -735,8 +748,8 @@ namespace set
 -- All arguments are explicit to avoid missing information in the pretty printer output
 /-- A bijection between two sets `s : set α` and `t : set β` provides a local equivalence
 between `α` and `β`. -/
-@[simps] noncomputable def bij_on.to_local_equiv [nonempty α] (f : α → β) (s : set α) (t : set β)
-  (hf : bij_on f s t) :
+@[simps {fully_applied := ff}] noncomputable def bij_on.to_local_equiv [nonempty α] (f : α → β)
+  (s : set α) (t : set β) (hf : bij_on f s t) :
   local_equiv α β :=
 { to_fun := f,
   inv_fun := inv_fun_on f s,
@@ -758,12 +771,8 @@ end set
 namespace equiv
 /- equivs give rise to local_equiv. We set up simp lemmas to reduce most properties of the local
 equiv to that of the equiv. -/
-variables (e : equiv α β) (e' : equiv β γ)
+variables (e : α ≃ β) (e' : β ≃ γ)
 
-@[simp, mfld_simps] lemma to_local_equiv_coe : (e.to_local_equiv : α → β) = e := rfl
-@[simp, mfld_simps] lemma to_local_equiv_symm_coe : (e.to_local_equiv.symm : β → α) = e.symm := rfl
-@[simp, mfld_simps] lemma to_local_equiv_source : e.to_local_equiv.source = univ := rfl
-@[simp, mfld_simps] lemma to_local_equiv_target : e.to_local_equiv.target = univ := rfl
 @[simp, mfld_simps] lemma refl_to_local_equiv :
   (equiv.refl α).to_local_equiv = local_equiv.refl α := rfl
 @[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
diff --git a/src/logic/equiv/nat.lean b/src/logic/equiv/nat.lean
index 977b44562e24b..ffe91f0fa86ee 100644
--- a/src/logic/equiv/nat.lean
+++ b/src/logic/equiv/nat.lean
@@ -4,47 +4,43 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 import data.nat.pairing
-import data.pnat.basic
 
 /-!
 # Equivalences involving `ℕ`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines some additional constructive equivalences using `encodable` and the pairing
 function on `ℕ`.
 -/
 
-open nat
+open nat function
 
 namespace equiv
 
 variables {α : Type*}
 
-/--
-An equivalence between `ℕ × ℕ` and `ℕ`, using the `mkpair` and `unpair` functions in
-`data.nat.pairing`.
--/
-@[simp] def nat_prod_nat_equiv_nat : ℕ × ℕ ≃ ℕ :=
-⟨λ p, nat.mkpair p.1 p.2,
- nat.unpair,
- λ p, begin cases p, apply nat.unpair_mkpair end,
- nat.mkpair_unpair⟩
-
 /--
 An equivalence between `bool × ℕ` and `ℕ`, by mapping `(tt, x)` to `2 * x + 1` and `(ff, x)` to
 `2 * x`.
 -/
-@[simp] def bool_prod_nat_equiv_nat : bool × ℕ ≃ ℕ :=
-⟨λ ⟨b, n⟩, bit b n, bodd_div2,
- λ ⟨b, n⟩, by simp [bool_prod_nat_equiv_nat._match_1, bodd_bit, div2_bit],
- λ n, by simp [bool_prod_nat_equiv_nat._match_1, bit_decomp]⟩
+@[simps] def bool_prod_nat_equiv_nat : bool × ℕ ≃ ℕ :=
+{ to_fun := uncurry bit,
+  inv_fun := bodd_div2,
+  left_inv := λ ⟨b, n⟩, by simp only [bodd_bit, div2_bit, uncurry_apply_pair, bodd_div2_eq],
+  right_inv := λ n, by simp only [bit_decomp, bodd_div2_eq, uncurry_apply_pair] }
 
 /--
 An equivalence between `ℕ ⊕ ℕ` and `ℕ`, by mapping `(sum.inl x)` to `2 * x` and `(sum.inr x)` to
 `2 * x + 1`.
 -/
-@[simp] def nat_sum_nat_equiv_nat : ℕ ⊕ ℕ ≃ ℕ :=
+@[simps symm_apply] def nat_sum_nat_equiv_nat : ℕ ⊕ ℕ ≃ ℕ :=
 (bool_prod_equiv_sum ℕ).symm.trans bool_prod_nat_equiv_nat
 
+@[simp] lemma nat_sum_nat_equiv_nat_apply : ⇑nat_sum_nat_equiv_nat = sum.elim bit0 bit1 :=
+by ext (x|x); refl
+
 /--
 An equivalence between `ℤ` and `ℕ`, through `ℤ ≃ ℕ ⊕ ℕ` and `ℕ ⊕ ℕ ≃ ℕ`.
 -/
@@ -56,15 +52,7 @@ An equivalence between `α × α` and `α`, given that there is an equivalence b
 -/
 def prod_equiv_of_equiv_nat (e : α ≃ ℕ) : α × α ≃ α :=
 calc α × α ≃ ℕ × ℕ : prod_congr e e
-      ...  ≃ ℕ     : nat_prod_nat_equiv_nat
+      ...  ≃ ℕ     : mkpair_equiv
       ...  ≃ α     : e.symm
 
-/--
-An equivalence between `ℕ+` and `ℕ`, by mapping `x` in `ℕ+` to `x - 1` in `ℕ`.
--/
-def pnat_equiv_nat : ℕ+ ≃ ℕ :=
-⟨λ n, pred n.1, succ_pnat,
-  λ ⟨n, h⟩, by { cases n, cases h, simp [succ_pnat, h] }, λ n, by simp [succ_pnat] ⟩
-
-
 end equiv
diff --git a/src/logic/equiv/option.lean b/src/logic/equiv/option.lean
index 02cf1fffc60cd..9c5fe8dc68bde 100644
--- a/src/logic/equiv/option.lean
+++ b/src/logic/equiv/option.lean
@@ -4,11 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
 import control.equiv_functor
-import logic.equiv.basic
+import data.option.basic
+import data.subtype
+import logic.equiv.defs
 
 /-!
 # Equivalences for `option α`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 
 We define
 * `equiv.option_congr`: the `option α ≃ option β` constructed from `e : α ≃ β` by sending `none` to
@@ -19,6 +24,8 @@ We define
 
 namespace equiv
 
+open option
+
 variables {α β γ : Type*}
 
 section option_congr
@@ -127,4 +134,85 @@ end remove_none
 lemma option_congr_injective : function.injective (option_congr : α ≃ β → option α ≃ option β) :=
 function.left_inverse.injective remove_none_option_congr
 
+/-- Equivalences between `option α` and `β` that send `none` to `x` are equivalent to
+equivalences between `α` and `{y : β // y ≠ x}`. -/
+def option_subtype [decidable_eq β] (x : β) :
+  {e : option α ≃ β // e none = x} ≃ (α ≃ {y : β // y ≠ x}) :=
+{ to_fun := λ e,
+    { to_fun := λ a, ⟨e a, ((equiv_like.injective _).ne_iff' e.property).2 (some_ne_none _)⟩,
+      inv_fun := λ b, get (ne_none_iff_is_some.1 (((equiv_like.injective _).ne_iff'
+        (((apply_eq_iff_eq_symm_apply _).1 e.property).symm)).2 b.property)),
+      left_inv := λ a, begin
+          rw [←some_inj, some_get, ←coe_def],
+          exact symm_apply_apply (e : option α ≃ β) a
+        end,
+      right_inv := λ b, begin
+          ext,
+          simp,
+          exact apply_symm_apply _ _
+        end },
+  inv_fun := λ e,
+    ⟨{ to_fun := λ a, cases_on' a x (coe ∘ e),
+       inv_fun := λ b, if h : b = x then none else e.symm ⟨b, h⟩,
+       left_inv := λ a, begin
+           cases a, { simp },
+           simp only [cases_on'_some, function.comp_app, subtype.coe_eta, symm_apply_apply,
+                      dite_eq_ite],
+           exact if_neg (e a).property
+         end,
+       right_inv := λ b, begin
+           by_cases h : b = x;
+             simp [h]
+         end},
+     rfl⟩,
+  left_inv := λ e, begin
+      ext a,
+      cases a,
+      { simpa using e.property.symm },
+      { simpa }
+    end,
+  right_inv := λ e, begin
+      ext a,
+      refl
+    end }
+
+@[simp] lemma option_subtype_apply_apply [decidable_eq β] (x : β)
+  (e : {e : option α ≃ β // e none = x}) (a : α) (h) :
+  option_subtype x e a = ⟨(e : option α ≃ β) a, h⟩ :=
+rfl
+
+@[simp] lemma coe_option_subtype_apply_apply [decidable_eq β] (x : β)
+  (e : {e : option α ≃ β // e none = x}) (a : α) :
+  ↑(option_subtype x e a) = (e : option α ≃ β) a :=
+rfl
+
+@[simp] lemma option_subtype_apply_symm_apply [decidable_eq β] (x : β)
+  (e : {e : option α ≃ β // e none = x}) (b : {y : β // y ≠ x}) :
+  ↑((option_subtype x e).symm b) = (e : option α ≃ β).symm b :=
+begin
+  dsimp only [option_subtype],
+  simp
+end
+
+@[simp] lemma option_subtype_symm_apply_apply_coe [decidable_eq β] (x : β)
+  (e : α ≃ {y : β // y ≠ x}) (a : α) : (option_subtype x).symm e a = e a :=
+rfl
+
+@[simp] lemma option_subtype_symm_apply_apply_some [decidable_eq β] (x : β)
+  (e : α ≃ {y : β // y ≠ x}) (a : α) : (option_subtype x).symm e (some a) = e a :=
+rfl
+
+@[simp] lemma option_subtype_symm_apply_apply_none [decidable_eq β] (x : β)
+  (e : α ≃ {y : β // y ≠ x}) : (option_subtype x).symm e none = x :=
+rfl
+
+@[simp] lemma option_subtype_symm_apply_symm_apply [decidable_eq β] (x : β)
+  (e : α ≃ {y : β // y ≠ x}) (b : {y : β // y ≠ x}) :
+  ((option_subtype x).symm e : option α ≃ β).symm b = e.symm b :=
+begin
+  simp only [option_subtype, coe_fn_symm_mk, subtype.coe_mk, subtype.coe_eta, dite_eq_ite,
+             ite_eq_right_iff],
+  exact λ h, false.elim (b.property h),
+end
+
 end equiv
diff --git a/src/logic/equiv/set.lean b/src/logic/equiv/set.lean
index 57301d46efd97..ce3c95ec44b43 100644
--- a/src/logic/equiv/set.lean
+++ b/src/logic/equiv/set.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Leonardo de Moura, Mario Carneiro
 -/
 import data.set.function
-import logic.equiv.basic
+import logic.equiv.defs
 
 /-!
 # Equivalences and sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we provide lemmas linking equivalences to sets.
 
 Some notable definitions are:
@@ -21,18 +24,18 @@ This file is separate from `equiv/basic` such that we do not require the full la
 on sets before defining what an equivalence is.
 -/
 
-open function
+open function set
 
 universes u v w z
 variables {α : Sort u} {β : Sort v} {γ : Sort w}
 
 namespace equiv
 
-@[simp] lemma range_eq_univ {α : Type*} {β : Type*} (e : α ≃ β) : set.range e = set.univ :=
-set.eq_univ_of_forall e.surjective
+@[simp] lemma range_eq_univ {α : Type*} {β : Type*} (e : α ≃ β) : range e = univ :=
+eq_univ_of_forall e.surjective
 
 protected lemma image_eq_preimage {α β} (e : α ≃ β) (s : set α) : e '' s = e.symm ⁻¹' s :=
-set.ext $ assume x, set.mem_image_iff_of_inverse e.left_inv e.right_inv
+set.ext $ λ x, mem_image_iff_of_inverse e.left_inv e.right_inv
 
 lemma _root_.set.mem_image_equiv {α β} {S : set α} {f : α ≃ β} {x : β} :
   x ∈ f '' S ↔ f.symm x ∈ S :=
@@ -50,7 +53,7 @@ lemma _root_.set.preimage_equiv_eq_image_symm {α β} (S : set α) (f : β ≃ 
 
 @[simp] protected lemma subset_image {α β} (e : α ≃ β) (s : set α) (t : set β) :
   e.symm '' t ⊆ s ↔ t ⊆ e '' s :=
-by rw [set.image_subset_iff, e.image_eq_preimage]
+by rw [image_subset_iff, e.image_eq_preimage]
 
 @[simp] protected lemma subset_image' {α β} (e : α ≃ β) (s : set α) (t : set β) :
   s ⊆ e.symm '' t ↔ e '' s ⊆ t :=
@@ -75,7 +78,7 @@ e.injective.preimage_image s
 
 protected lemma image_compl {α β} (f : equiv α β) (s : set α) :
   f '' sᶜ = (f '' s)ᶜ :=
-set.image_compl_eq f.bijective
+image_compl_eq f.bijective
 
 @[simp] lemma symm_preimage_preimage {α β} (e : α ≃ β) (s : set β) :
   e.symm ⁻¹' (e ⁻¹' s) = s :=
@@ -89,23 +92,16 @@ e.left_inverse_symm.preimage_preimage s
 e.surjective.preimage_subset_preimage_iff
 
 @[simp] lemma image_subset {α β} (e : α ≃ β) (s t : set α) : e '' s ⊆ e '' t ↔ s ⊆ t :=
-set.image_subset_image_iff e.injective
+image_subset_image_iff e.injective
 
 @[simp] lemma image_eq_iff_eq {α β} (e : α ≃ β) (s t : set α) : e '' s = e '' t ↔ s = t :=
-set.image_eq_image e.injective
+image_eq_image e.injective
 
 lemma preimage_eq_iff_eq_image {α β} (e : α ≃ β) (s t) : e ⁻¹' s = t ↔ s = e '' t :=
-set.preimage_eq_iff_eq_image e.bijective
+preimage_eq_iff_eq_image e.bijective
 
 lemma eq_preimage_iff_image_eq {α β} (e : α ≃ β) (s t) : s = e ⁻¹' t ↔ e '' s = t :=
-set.eq_preimage_iff_image_eq e.bijective
-
-@[simp] lemma prod_comm_preimage {α β} {s : set α} {t : set β} :
-  equiv.prod_comm α β ⁻¹' t ×ˢ s = s ×ˢ t :=
-set.preimage_swap_prod
-
-lemma prod_comm_image {α β} {s : set α} {t : set β} : equiv.prod_comm α β '' s ×ˢ t = t ×ˢ s :=
-set.image_swap_prod
+eq_preimage_iff_image_eq e.bijective
 
 @[simp]
 lemma prod_assoc_preimage {α β γ} {s : set α} {t : set β} {u : set γ} :
@@ -153,8 +149,6 @@ def image {α β : Type*} (e : α ≃ β) (s : set α) : s ≃ e '' s :=
   left_inv := λ x, by simp,
   right_inv := λ y, by simp, }.
 
-open set
-
 namespace set
 
 /-- `univ α` is equivalent to `α`. -/
@@ -217,13 +211,12 @@ protected def singleton {α} (a : α) : ({a} : set α) ≃ punit.{u} :=
  λ ⟨x, h⟩, by { simp at h, subst x },
  λ ⟨⟩, rfl⟩
 
-/-- Equal sets are equivalent. -/
+/-- Equal sets are equivalent.
+
+TODO: this is the same as `equiv.set_congr`! -/
 @[simps apply symm_apply]
 protected def of_eq {α : Type u} {s t : set α} (h : s = t) : s ≃ t :=
-{ to_fun := λ x, ⟨x, h ▸ x.2⟩,
-  inv_fun := λ x, ⟨x, h.symm ▸ x.2⟩,
-  left_inv := λ _, subtype.eq rfl,
-  right_inv := λ _, subtype.eq rfl }
+equiv.set_congr h
 
 /-- If `a ∉ s`, then `insert a s` is equivalent to `s ⊕ punit`. -/
 protected def insert {α} {s : set.{u} α} [decidable_pred (∈ s)] {a : α} (H : a ∉ s) :
@@ -365,6 +358,14 @@ protected def prod {α β} (s : set α) (t : set β) :
   ↥(s ×ˢ t) ≃ s × t :=
 @subtype_prod_equiv_prod α β s t
 
+/-- The set `set.pi set.univ s` is equivalent to `Π a, s a`. -/
+@[simps] protected def univ_pi {α : Type*} {β : α → Type*} (s : Π a, set (β a)) :
+  pi univ s ≃ Π a, s a :=
+{ to_fun := λ f a, ⟨(f : Π a, β a) a, f.2 a (mem_univ a)⟩,
+  inv_fun := λ f, ⟨λ a, f a, λ a ha, (f a).2⟩,
+  left_inv := λ ⟨f, hf⟩, by { ext a, refl },
+  right_inv := λ f, by { ext a, refl } }
+
 /-- If a function `f` is injective on a set `s`, then `s` is equivalent to `f '' s`. -/
 protected noncomputable def image_of_inj_on {α β} (f : α → β) (s : set α) (H : inj_on f s) :
   s ≃ (f '' s) :=
@@ -438,7 +439,7 @@ are already sufficient to ensure non-emptiness. -/
 @[simps]
 def of_left_inverse {α β : Sort*}
   (f : α → β) (f_inv : nonempty α → β → α) (hf : Π h : nonempty α, left_inverse (f_inv h) f) :
-  α ≃ set.range f :=
+  α ≃ range f :=
 { to_fun := λ a, ⟨f a, a, rfl⟩,
   inv_fun := λ b, f_inv (nonempty_of_exists b.2) b,
   left_inv := λ a, hf ⟨a⟩ a,
@@ -451,16 +452,16 @@ Note that if `α` is empty, no such `f_inv` exists and so this definition can't
 the stronger but less convenient `of_left_inverse`. -/
 abbreviation of_left_inverse' {α β : Sort*}
   (f : α → β) (f_inv : β → α) (hf : left_inverse f_inv f) :
-  α ≃ set.range f :=
+  α ≃ range f :=
 of_left_inverse f (λ _, f_inv) (λ _, hf)
 
 /-- If `f : α → β` is an injective function, then domain `α` is equivalent to the range of `f`. -/
 @[simps apply]
-noncomputable def of_injective {α β} (f : α → β) (hf : injective f) : α ≃ set.range f :=
+noncomputable def of_injective {α β} (f : α → β) (hf : injective f) : α ≃ range f :=
 equiv.of_left_inverse f
   (λ h, by exactI function.inv_fun f) (λ h, by exactI function.left_inverse_inv_fun hf)
 
-theorem apply_of_injective_symm {α β} {f : α → β} (hf : injective f) (b : set.range f) :
+theorem apply_of_injective_symm {α β} {f : α → β} (hf : injective f) (b : range f) :
   f ((of_injective f hf).symm b) = b :=
 subtype.ext_iff.1 $ (of_injective f hf).apply_symm_apply b
 
@@ -493,16 +494,12 @@ by { ext, simp }
 
 protected lemma set_forall_iff {α β} (e : α ≃ β) {p : set α → Prop} :
   (∀ a, p a) ↔ (∀ a, p (e ⁻¹' a)) :=
-by simpa [equiv.image_eq_preimage] using (equiv.set.congr e).forall_congr_left'
-
-protected lemma preimage_sUnion {α β} (f : α ≃ β) {s : set (set β)} :
-  f ⁻¹' (⋃₀ s) = ⋃₀ (_root_.set.image f ⁻¹' s) :=
-by { ext x, simp [(equiv.set.congr f).symm.exists_congr_left] }
+e.injective.preimage_surjective.forall
 
 lemma preimage_pi_equiv_pi_subtype_prod_symm_pi {α : Type*} {β : α → Type*}
   (p : α → Prop) [decidable_pred p] (s : Π i, set (β i)) :
-  (pi_equiv_pi_subtype_prod p β).symm ⁻¹' set.pi univ s =
-    (set.pi univ (λ i : {i // p i}, s i)) ×ˢ (set.pi univ (λ i : {i // ¬p i}, s i)) :=
+  (pi_equiv_pi_subtype_prod p β).symm ⁻¹' pi univ s =
+    (pi univ (λ i : {i // p i}, s i)) ×ˢ pi univ (λ i : {i // ¬p i}, s i) :=
 begin
   ext ⟨f, g⟩,
   simp only [mem_preimage, mem_univ_pi, prod_mk_mem_set_prod_eq, subtype.forall,
@@ -534,7 +531,7 @@ end equiv
 /-- If a function is a bijection between two sets `s` and `t`, then it induces an
 equivalence between the types `↥s` and `↥t`. -/
 noncomputable def set.bij_on.equiv {α : Type*} {β : Type*} {s : set α} {t : set β} (f : α → β)
-  (h : set.bij_on f s t) : s ≃ t :=
+  (h : bij_on f s t) : s ≃ t :=
 equiv.of_bijective _ h.bijective
 
 /-- The composition of an updated function with an equiv on a subset can be expressed as an
diff --git a/src/logic/equiv/transfer_instance.lean b/src/logic/equiv/transfer_instance.lean
index e6ec8b2e8628c..d20b4270e3382 100644
--- a/src/logic/equiv/transfer_instance.lean
+++ b/src/logic/equiv/transfer_instance.lean
@@ -3,15 +3,16 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import algebra.algebra.basic
+import algebra.algebra.equiv
 import algebra.field.basic
-import algebra.group.type_tags
-import logic.equiv.basic
-import ring_theory.ideal.local_ring
+import logic.equiv.defs
 
 /-!
 # Transfer algebraic structures across `equiv`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove theorems of the following form: if `β` has a
 group structure and `α ≃ β` then `α` has a group structure, and
 similarly for monoids, semigroups, rings, integral domains, fields and
@@ -19,6 +20,11 @@ so on.
 
 Note that most of these constructions can also be obtained using the `transport` tactic.
 
+### Implementation details
+
+When adding new definitions that transfer type-classes across an equivalence, please mark them
+`@[reducible]`. See note [reducible non-instances].
+
 ## Tags
 
 equiv, group, ring, field, module, algebra
@@ -35,39 +41,39 @@ section instances
 variables (e : α ≃ β)
 
 /-- Transfer `has_one` across an `equiv` -/
-@[to_additive "Transfer `has_zero` across an `equiv`"]
+@[reducible, to_additive "Transfer `has_zero` across an `equiv`"]
 protected def has_one [has_one β] : has_one α := ⟨e.symm 1⟩
 @[to_additive]
 lemma one_def [has_one β] : @has_one.one _ (equiv.has_one e) = e.symm 1 := rfl
 
 /-- Transfer `has_mul` across an `equiv` -/
-@[to_additive "Transfer `has_add` across an `equiv`"]
+@[reducible, to_additive "Transfer `has_add` across an `equiv`"]
 protected def has_mul [has_mul β] : has_mul α := ⟨λ x y, e.symm (e x * e y)⟩
 @[to_additive]
 lemma mul_def [has_mul β] (x y : α) :
   @has_mul.mul _ (equiv.has_mul e) x y = e.symm (e x * e y) := rfl
 
 /-- Transfer `has_div` across an `equiv` -/
-@[to_additive "Transfer `has_sub` across an `equiv`"]
+@[reducible, to_additive "Transfer `has_sub` across an `equiv`"]
 protected def has_div [has_div β] : has_div α := ⟨λ x y, e.symm (e x / e y)⟩
 @[to_additive]
 lemma div_def [has_div β] (x y : α) :
 @has_div.div _ (equiv.has_div e) x y = e.symm (e x / e y) := rfl
 
 /-- Transfer `has_inv` across an `equiv` -/
-@[to_additive "Transfer `has_neg` across an `equiv`"]
+@[reducible, to_additive "Transfer `has_neg` across an `equiv`"]
 protected def has_inv [has_inv β] : has_inv α := ⟨λ x, e.symm (e x)⁻¹⟩
 @[to_additive]
 lemma inv_def [has_inv β] (x : α) : @has_inv.inv _ (equiv.has_inv e) x = e.symm (e x)⁻¹ := rfl
 
-/-- Transfer `has_scalar` across an `equiv` -/
-protected def has_scalar (R : Type*) [has_scalar R β] : has_scalar R α  :=
+/-- Transfer `has_smul` across an `equiv` -/
+@[reducible] protected def has_smul (R : Type*) [has_smul R β] : has_smul R α  :=
 ⟨λ r x, e.symm (r • (e x))⟩
-lemma smul_def {R : Type*} [has_scalar R β] (r : R) (x : α) :
-  @has_scalar.smul _ _ (e.has_scalar R) r x = e.symm (r • (e x)) := rfl
+lemma smul_def {R : Type*} [has_smul R β] (r : R) (x : α) :
+  @has_smul.smul _ _ (e.has_smul R) r x = e.symm (r • (e x)) := rfl
 
 /-- Transfer `has_pow` across an `equiv` -/
-@[to_additive has_scalar]
+@[reducible, to_additive has_smul]
 protected def has_pow (N : Type*) [has_pow β N] : has_pow α N  :=
 ⟨λ x n, e.symm (e x ^ n)⟩
 lemma pow_def {N : Type*} [has_pow β N] (n : N) (x : α) :
@@ -87,7 +93,7 @@ def mul_equiv (e : α ≃ β) [has_mul β] :
 begin
   introsI,
   exact
-  { map_mul' := λ x y, by { apply e.symm.injective, simp, refl, },
+  { map_mul' := λ x y, by { apply e.symm.injective, simp, },
     ..e }
 end
 
@@ -110,8 +116,8 @@ def ring_equiv (e : α ≃ β) [has_add β] [has_mul β] :
 begin
   introsI,
   exact
-  { map_add' := λ x y, by { apply e.symm.injective, simp, refl, },
-    map_mul' := λ x y, by { apply e.symm.injective, simp, refl, },
+  { map_add' := λ x y, by { apply e.symm.injective, simp, },
+    map_mul' := λ x y, by { apply e.symm.injective, simp, },
     ..e }
 end
 
@@ -125,157 +131,171 @@ begin
 end
 
 /-- Transfer `semigroup` across an `equiv` -/
-@[to_additive "Transfer `add_semigroup` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_semigroup` across an `equiv`"]
 protected def semigroup [semigroup β] : semigroup α :=
 let mul := e.has_mul in
 by resetI; apply e.injective.semigroup _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `semigroup_with_zero` across an `equiv` -/
-protected def semigroup_with_zero [semigroup_with_zero β] : semigroup_with_zero α :=
+@[reducible] protected def semigroup_with_zero [semigroup_with_zero β] : semigroup_with_zero α :=
 let mul := e.has_mul, zero := e.has_zero in
 by resetI; apply e.injective.semigroup_with_zero _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `comm_semigroup` across an `equiv` -/
-@[to_additive "Transfer `add_comm_semigroup` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_comm_semigroup` across an `equiv`"]
 protected def comm_semigroup [comm_semigroup β] : comm_semigroup α :=
 let mul := e.has_mul in
 by resetI; apply e.injective.comm_semigroup _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `mul_zero_class` across an `equiv` -/
-protected def mul_zero_class [mul_zero_class β] : mul_zero_class α :=
+@[reducible] protected def mul_zero_class [mul_zero_class β] : mul_zero_class α :=
 let zero := e.has_zero, mul := e.has_mul in
 by resetI; apply e.injective.mul_zero_class _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `mul_one_class` across an `equiv` -/
-@[to_additive "Transfer `add_zero_class` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_zero_class` across an `equiv`"]
 protected def mul_one_class [mul_one_class β] : mul_one_class α :=
 let one := e.has_one, mul := e.has_mul in
 by resetI; apply e.injective.mul_one_class _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `mul_zero_one_class` across an `equiv` -/
-protected def mul_zero_one_class [mul_zero_one_class β] : mul_zero_one_class α :=
+@[reducible] protected def mul_zero_one_class [mul_zero_one_class β] : mul_zero_one_class α :=
 let zero := e.has_zero, one := e.has_one,mul := e.has_mul in
 by resetI; apply e.injective.mul_zero_one_class _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `monoid` across an `equiv` -/
-@[to_additive "Transfer `add_monoid` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_monoid` across an `equiv`"]
 protected def monoid [monoid β] : monoid α :=
 let one := e.has_one, mul := e.has_mul, pow := e.has_pow ℕ in
 by resetI; apply e.injective.monoid _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `comm_monoid` across an `equiv` -/
-@[to_additive "Transfer `add_comm_monoid` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_comm_monoid` across an `equiv`"]
 protected def comm_monoid [comm_monoid β] : comm_monoid α :=
 let one := e.has_one, mul := e.has_mul, pow := e.has_pow ℕ in
 by resetI; apply e.injective.comm_monoid _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `group` across an `equiv` -/
-@[to_additive "Transfer `add_group` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_group` across an `equiv`"]
 protected def group [group β] : group α :=
 let one := e.has_one, mul := e.has_mul, inv := e.has_inv, div := e.has_div,
   npow := e.has_pow ℕ, zpow := e.has_pow ℤ in
 by resetI; apply e.injective.group _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `comm_group` across an `equiv` -/
-@[to_additive "Transfer `add_comm_group` across an `equiv`"]
+@[reducible, to_additive "Transfer `add_comm_group` across an `equiv`"]
 protected def comm_group [comm_group β] : comm_group α :=
 let one := e.has_one, mul := e.has_mul, inv := e.has_inv, div := e.has_div,
   npow := e.has_pow ℕ, zpow := e.has_pow ℤ in
 by resetI; apply e.injective.comm_group _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_unital_non_assoc_semiring` across an `equiv` -/
-protected def non_unital_non_assoc_semiring [non_unital_non_assoc_semiring β] :
+@[reducible] protected def non_unital_non_assoc_semiring [non_unital_non_assoc_semiring β] :
   non_unital_non_assoc_semiring α :=
-let zero := e.has_zero, add := e.has_add, mul := e.has_mul, nsmul := e.has_scalar ℕ in
+let zero := e.has_zero, add := e.has_add, mul := e.has_mul, nsmul := e.has_smul ℕ in
 by resetI; apply e.injective.non_unital_non_assoc_semiring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_unital_semiring` across an `equiv` -/
-protected def non_unital_semiring [non_unital_semiring β] :  non_unital_semiring α :=
-let zero := e.has_zero, add := e.has_add, mul := e.has_mul, nsmul := e.has_scalar ℕ in
+@[reducible] protected def non_unital_semiring [non_unital_semiring β] : non_unital_semiring α :=
+let zero := e.has_zero, add := e.has_add, mul := e.has_mul, nsmul := e.has_smul ℕ in
 by resetI; apply e.injective.non_unital_semiring _; intros; exact e.apply_symm_apply _
 
+/-- Transfer `add_monoid_with_one` across an `equiv` -/
+@[reducible] protected def add_monoid_with_one [add_monoid_with_one β] : add_monoid_with_one α :=
+{ nat_cast := λ n, e.symm n,
+  nat_cast_zero := show e.symm _ = _, by simp [zero_def],
+  nat_cast_succ := λ n, show e.symm _ = e.symm (e (e.symm _) + _), by simp [add_def, one_def],
+  .. e.add_monoid, .. e.has_one }
+
+/-- Transfer `add_group_with_one` across an `equiv` -/
+@[reducible] protected def add_group_with_one [add_group_with_one β] : add_group_with_one α :=
+{ int_cast := λ n, e.symm n,
+  int_cast_of_nat := λ n, by rw [int.cast_coe_nat]; refl,
+  int_cast_neg_succ_of_nat := λ n, congr_arg e.symm $
+    (int.cast_neg_succ_of_nat _).trans $ congr_arg _ (e.apply_symm_apply _).symm,
+  .. e.add_monoid_with_one, .. e.add_group }
+
 /-- Transfer `non_assoc_semiring` across an `equiv` -/
-protected def non_assoc_semiring [non_assoc_semiring β] : non_assoc_semiring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul,
-  nsmul := e.has_scalar ℕ in
+@[reducible] protected def non_assoc_semiring [non_assoc_semiring β] : non_assoc_semiring α :=
+let mul := e.has_mul, add_monoid_with_one := e.add_monoid_with_one in
 by resetI; apply e.injective.non_assoc_semiring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `semiring` across an `equiv` -/
-protected def semiring [semiring β] : semiring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul,
-  nsmul := e.has_scalar ℕ, npow := e.has_pow ℕ in
+@[reducible] protected def semiring [semiring β] : semiring α :=
+let mul := e.has_mul, add_monoid_with_one := e.add_monoid_with_one, npow := e.has_pow ℕ in
 by resetI; apply e.injective.semiring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_unital_comm_semiring` across an `equiv` -/
-protected def non_unital_comm_semiring [non_unital_comm_semiring β] : non_unital_comm_semiring α :=
-let zero := e.has_zero, add := e.has_add, mul := e.has_mul, nsmul := e.has_scalar ℕ in
+@[reducible] protected def non_unital_comm_semiring [non_unital_comm_semiring β] :
+  non_unital_comm_semiring α :=
+let zero := e.has_zero, add := e.has_add, mul := e.has_mul, nsmul := e.has_smul ℕ in
 by resetI; apply e.injective.non_unital_comm_semiring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `comm_semiring` across an `equiv` -/
-protected def comm_semiring [comm_semiring β] : comm_semiring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul,
-  nsmul := e.has_scalar ℕ, npow := e.has_pow ℕ in
+@[reducible] protected def comm_semiring [comm_semiring β] : comm_semiring α :=
+let mul := e.has_mul, add_monoid_with_one := e.add_monoid_with_one, npow := e.has_pow ℕ in
 by resetI; apply e.injective.comm_semiring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_unital_non_assoc_ring` across an `equiv` -/
-protected def non_unital_non_assoc_ring [non_unital_non_assoc_ring β] :
+@[reducible] protected def non_unital_non_assoc_ring [non_unital_non_assoc_ring β] :
   non_unital_non_assoc_ring α :=
 let zero := e.has_zero, add := e.has_add, mul := e.has_mul, neg := e.has_neg, sub := e.has_sub,
-  nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ in
+  nsmul := e.has_smul ℕ, zsmul := e.has_smul ℤ in
 by resetI; apply e.injective.non_unital_non_assoc_ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_unital_ring` across an `equiv` -/
-protected def non_unital_ring [non_unital_ring β] :
+@[reducible] protected def non_unital_ring [non_unital_ring β] :
   non_unital_ring α :=
 let zero := e.has_zero, add := e.has_add, mul := e.has_mul, neg := e.has_neg, sub := e.has_sub,
-  nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ in
+  nsmul := e.has_smul ℕ, zsmul := e.has_smul ℤ in
 by resetI; apply e.injective.non_unital_ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_assoc_ring` across an `equiv` -/
-protected def non_assoc_ring [non_assoc_ring β] :
+@[reducible] protected def non_assoc_ring [non_assoc_ring β] :
   non_assoc_ring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
-  sub := e.has_sub, nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ in
+let add_group_with_one := e.add_group_with_one, mul := e.has_mul in
 by resetI; apply e.injective.non_assoc_ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `ring` across an `equiv` -/
-protected def ring [ring β] : ring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
-  sub := e.has_sub, nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ, npow := e.has_pow ℕ in
+@[reducible] protected def ring [ring β] : ring α :=
+let mul := e.has_mul, add_group_with_one := e.add_group_with_one, npow := e.has_pow ℕ in
 by resetI; apply e.injective.ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `non_unital_comm_ring` across an `equiv` -/
-protected def non_unital_comm_ring [non_unital_comm_ring β] : non_unital_comm_ring α :=
+@[reducible] protected def non_unital_comm_ring [non_unital_comm_ring β] : non_unital_comm_ring α :=
 let zero := e.has_zero, add := e.has_add, mul := e.has_mul, neg := e.has_neg,
-  sub := e.has_sub, nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ in
+  sub := e.has_sub, nsmul := e.has_smul ℕ, zsmul := e.has_smul ℤ in
 by resetI; apply e.injective.non_unital_comm_ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `comm_ring` across an `equiv` -/
-protected def comm_ring [comm_ring β] : comm_ring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
-  sub := e.has_sub, nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ, npow := e.has_pow ℕ in
+@[reducible] protected def comm_ring [comm_ring β] : comm_ring α :=
+let mul := e.has_mul, add_group_with_one := e.add_group_with_one, npow := e.has_pow ℕ in
 by resetI; apply e.injective.comm_ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `nontrivial` across an `equiv` -/
-protected theorem nontrivial [nontrivial β] : nontrivial α :=
+@[reducible] protected theorem nontrivial [nontrivial β] : nontrivial α :=
 e.surjective.nontrivial
 
 /-- Transfer `is_domain` across an `equiv` -/
-protected theorem is_domain [ring α] [ring β] [is_domain β] (e : α ≃+* β) : is_domain α :=
-function.injective.is_domain e.to_ring_hom e.injective
+@[reducible] protected theorem is_domain [ring α] [ring β] [is_domain β] (e : α ≃+* β) :
+  is_domain α := function.injective.is_domain e.to_ring_hom e.injective
+
+/-- Transfer `has_rat_cast` across an `equiv` -/
+@[reducible] protected def has_rat_cast [has_rat_cast β] : has_rat_cast α :=
+{ rat_cast := λ n, e.symm n }
 
 /-- Transfer `division_ring` across an `equiv` -/
-protected def division_ring [division_ring β] : division_ring α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
-  sub := e.has_sub, inv := e.has_inv, div := e.has_div,
-  nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ, npow := e.has_pow ℕ, zpow := e.has_pow ℤ in
+@[reducible] protected def division_ring [division_ring β] : division_ring α :=
+let add_group_with_one := e.add_group_with_one, mul := e.has_mul,
+  inv := e.has_inv, div := e.has_div, mul := e.has_mul, npow := e.has_pow ℕ, zpow := e.has_pow ℤ,
+  rat_cast := e.has_rat_cast, qsmul := e.has_smul ℚ in
 by resetI; apply e.injective.division_ring _; intros; exact e.apply_symm_apply _
 
 /-- Transfer `field` across an `equiv` -/
-protected def field [field β] : field α :=
-let zero := e.has_zero, add := e.has_add, one := e.has_one, mul := e.has_mul, neg := e.has_neg,
-  sub := e.has_sub, inv := e.has_inv, div := e.has_div,
-  nsmul := e.has_scalar ℕ, zsmul := e.has_scalar ℤ, npow := e.has_pow ℕ, zpow := e.has_pow ℤ in
+@[reducible] protected def field [field β] : field α :=
+let add_group_with_one := e.add_group_with_one, mul := e.has_mul, neg := e.has_neg,
+  inv := e.has_inv, div := e.has_div, mul := e.has_mul, npow := e.has_pow ℕ, zpow := e.has_pow ℤ,
+  rat_cast := e.has_rat_cast, qsmul := e.has_smul ℚ in
 by resetI; apply e.injective.field _; intros; exact e.apply_symm_apply _
 
 section R
@@ -286,13 +306,13 @@ section
 variables [monoid R]
 
 /-- Transfer `mul_action` across an `equiv` -/
-protected def mul_action (e : α ≃ β) [mul_action R β] : mul_action R α :=
+@[reducible] protected def mul_action (e : α ≃ β) [mul_action R β] : mul_action R α :=
 { one_smul := by simp [smul_def],
   mul_smul := by simp [smul_def, mul_smul],
-  ..e.has_scalar R }
+  ..e.has_smul R }
 
 /-- Transfer `distrib_mul_action` across an `equiv` -/
-protected def distrib_mul_action (e : α ≃ β) [add_comm_monoid β] :
+@[reducible] protected def distrib_mul_action (e : α ≃ β) [add_comm_monoid β] :
   begin
     letI := equiv.add_comm_monoid e,
     exact Π [distrib_mul_action R β], distrib_mul_action R α
@@ -312,7 +332,7 @@ section
 variables [semiring R]
 
 /-- Transfer `module` across an `equiv` -/
-protected def module (e : α ≃ β) [add_comm_monoid β] :
+@[reducible] protected def module (e : α ≃ β) [add_comm_monoid β] :
   begin
     letI := equiv.add_comm_monoid e,
     exact Π [module R β], module R α
@@ -349,7 +369,7 @@ section
 variables [comm_semiring R]
 
 /-- Transfer `algebra` across an `equiv` -/
-protected def algebra (e : α ≃ β) [semiring β] :
+@[reducible] protected def algebra (e : α ≃ β) [semiring β] :
   begin
     letI := equiv.semiring e,
     exact Π [algebra R β], algebra R α
@@ -391,14 +411,3 @@ end R
 
 end instances
 end equiv
-
-namespace ring_equiv
-
-protected lemma local_ring {A B : Type*} [comm_semiring A] [local_ring A] [comm_semiring B]
-  (e : A ≃+* B) : local_ring B :=
-begin
-  haveI := e.symm.to_equiv.nontrivial,
-  exact local_ring.of_surjective (e : A →+* B) e.surjective
-end
-
-end ring_equiv
diff --git a/src/logic/function/basic.lean b/src/logic/function/basic.lean
index 1e1ff8e494854..beb9d534798ad 100644
--- a/src/logic/function/basic.lean
+++ b/src/logic/function/basic.lean
@@ -9,6 +9,9 @@ import tactic.cache
 
 /-!
 # Miscellaneous function constructions and lemmas
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 universes u v w
@@ -35,8 +38,17 @@ lemma const_def {y : β} : (λ x : α, y) = const α y := rfl
 
 @[simp] lemma comp_const {f : β → γ} {b : β} : f ∘ const α b = const α (f b) := rfl
 
+lemma const_injective [nonempty α] : injective (const α : β → α → β) :=
+λ y₁ y₂ h, let ⟨x⟩ := ‹nonempty α› in congr_fun h x
+
+@[simp] lemma const_inj [nonempty α] {y₁ y₂ : β} : const α y₁ = const α y₂ ↔ y₁ = y₂ :=
+⟨λ h, const_injective h, λ h, h ▸ rfl⟩
+
 lemma id_def : @id α = λ x, x := rfl
 
+@[simp] lemma on_fun_apply (f : β → β → γ) (g : α → β) (a b : α) : on_fun f g a b = f (g a) (g b) :=
+rfl
+
 lemma hfunext {α α': Sort u} {β : α → Sort v} {β' : α' → Sort v} {f : Πa, β a} {f' : Πa, β' a}
   (hα : α = α') (h : ∀a a', a == a' → f a == f' a') : f == f' :=
 begin
@@ -80,7 +92,7 @@ h ▸ hf.ne_iff
 
 /-- If the co-domain `β` of an injective function `f : α → β` has decidable equality, then
 the domain `α` also has decidable equality. -/
-def injective.decidable_eq [decidable_eq β] (I : injective f) : decidable_eq α :=
+protected def injective.decidable_eq [decidable_eq β] (I : injective f) : decidable_eq α :=
 λ a b, decidable_of_iff _ I.eq_iff
 
 lemma injective.of_comp {g : γ → α} (I : injective (f ∘ g)) : injective g :=
@@ -292,6 +304,14 @@ theorem left_inverse.right_inverse_of_surjective {f : α → β} {g : β → α}
   right_inverse f g :=
 λ x, let ⟨y, hy⟩ := hg x in hy ▸ congr_arg g (h y)
 
+lemma right_inverse.left_inverse_of_surjective {f : α → β} {g : β → α} :
+  right_inverse f g → surjective f → left_inverse f g :=
+left_inverse.right_inverse_of_surjective
+
+lemma right_inverse.left_inverse_of_injective {f : α → β} {g : β → α} :
+  right_inverse f g → injective g → left_inverse f g :=
+left_inverse.right_inverse_of_injective
+
 theorem left_inverse.eq_right_inverse {f : α → β} {g₁ g₂ : β → α} (h₁ : left_inverse g₁ f)
   (h₂ : right_inverse g₂ f) :
   g₁ = g₂ :=
@@ -406,6 +426,7 @@ end surj_inv
 
 section update
 variables {α : Sort u} {β : α → Sort v} {α' : Sort w} [decidable_eq α] [decidable_eq α']
+  {f g : Π a, β a} {a : α} {b : β a}
 
 /-- Replacing the value of a function at a given point by a given value. -/
 def update (f : Πa, β a) (a' : α) (v : β a') (a : α) : β a :=
@@ -452,6 +473,12 @@ lemma eq_update_iff {a : α} {b : β a} {f g : Π a, β a} :
   g = update f a b ↔ g a = b ∧ ∀ x ≠ a, g x = f x :=
 funext_iff.trans $ forall_update_iff _ (λ x y, g x = y)
 
+@[simp] lemma update_eq_self_iff : update f a b = f ↔ b = f a := by simp [update_eq_iff]
+@[simp] lemma eq_update_self_iff : f = update f a b ↔ f a = b := by simp [eq_update_iff]
+
+lemma ne_update_self_iff : f ≠ update f a b ↔ f a ≠ b := eq_update_self_iff.not
+lemma update_ne_self_iff : update f a b ≠ f ↔ b ≠ f a := update_eq_self_iff.not
+
 @[simp] lemma update_eq_self (a : α) (f : Πa, β a) : update f a (f a) = f :=
 update_eq_iff.2 ⟨rfl, λ _ _, rfl⟩
 
@@ -526,47 +553,76 @@ along a function `f : α → β` to a function `β → γ`,
 by using the values of `g` on the range of `f`
 and the values of an auxiliary function `e' : β → γ` elsewhere.
 
-Mostly useful when `f` is injective. -/
+Mostly useful when `f` is injective, more generally when `g.factors_through f`. -/
 def extend (f : α → β) (g : α → γ) (e' : β → γ) : β → γ :=
 λ b, if h : ∃ a, f a = b then g (classical.some h) else e' b
 
+/-- g factors through f : `f a = f b → g a = g b` -/
+def factors_through (g : α → γ) (f : α → β) : Prop :=
+∀ ⦃a b⦄, f a = f b → g a = g b
+
+lemma injective.factors_through (hf : injective f) (g : α → γ) : g.factors_through f :=
+λ a b h, congr_arg g (hf h)
+
 lemma extend_def (f : α → β) (g : α → γ) (e' : β → γ) (b : β) [decidable (∃ a, f a = b)] :
   extend f g e' b = if h : ∃ a, f a = b then g (classical.some h) else e' b :=
 by { unfold extend, congr }
 
-@[simp] lemma extend_apply (hf : injective f) (g : α → γ) (e' : β → γ) (a : α) :
+lemma factors_through.extend_apply {g : α → γ} (hf : g.factors_through f) (e' : β → γ) (a : α) :
   extend f g e' (f a) = g a :=
 begin
   simp only [extend_def, dif_pos, exists_apply_eq_apply],
-  exact congr_arg g (hf $ classical.some_spec (exists_apply_eq_apply f a))
+  exact hf (classical.some_spec (exists_apply_eq_apply f a)),
 end
 
+@[simp] lemma injective.extend_apply (hf : f.injective) (g : α → γ) (e' : β → γ) (a : α) :
+  extend f g e' (f a) = g a :=
+(hf.factors_through g).extend_apply e' a
+
 @[simp] lemma extend_apply' (g : α → γ) (e' : β → γ) (b : β) (hb : ¬∃ a, f a = b) :
   extend f g e' b = e' b :=
 by simp [function.extend_def, hb]
 
-lemma apply_extend {δ} (hf : injective f) (F : γ → δ) (g : α → γ) (e' : β → γ) (b : β) :
+lemma factors_through_iff (g : α → γ) [nonempty γ] :
+  g.factors_through f ↔ ∃ (e : β → γ), g = e ∘ f :=
+⟨λ hf, ⟨extend f g (const β (classical.arbitrary γ)),
+      funext (λ x, by simp only [comp_app, hf.extend_apply])⟩,
+  λ h a b hf, by rw [classical.some_spec h, comp_apply, hf]⟩
+
+lemma factors_through.apply_extend {δ} {g : α → γ} (hf : factors_through g f)
+  (F : γ → δ) (e' : β → γ) (b : β) :
   F (extend f g e' b) = extend f (F ∘ g) (F ∘ e') b :=
 begin
   by_cases hb : ∃ a, f a = b,
   { cases hb with a ha, subst b,
-    rw [extend_apply hf, extend_apply hf] },
+    rw [factors_through.extend_apply, factors_through.extend_apply],
+    { intros a b h, simp only [comp_apply], apply congr_arg, exact hf h, },
+    { exact hf, }, },
   { rw [extend_apply' _ _ _ hb, extend_apply' _ _ _ hb] }
 end
 
+lemma injective.apply_extend {δ} (hf : injective f) (F : γ → δ) (g : α → γ) (e' : β → γ) (b : β) :
+  F (extend f g e' b) = extend f (F ∘ g) (F ∘ e') b :=
+(hf.factors_through g).apply_extend F e' b
+
 lemma extend_injective (hf : injective f) (e' : β → γ) :
   injective (λ g, extend f g e') :=
 begin
   intros g₁ g₂ hg,
   refine funext (λ x, _),
   have H := congr_fun hg (f x),
-  simp only [hf, extend_apply] at H,
+  simp only [hf.extend_apply] at H,
   exact H
 end
 
+lemma factors_through.extend_comp {g : α → γ} (e' : β → γ)
+  (hf : factors_through g f) :
+  extend f g e' ∘ f = g :=
+funext $ λ a, by simp only [comp_app, hf.extend_apply e']
+
 @[simp] lemma extend_comp (hf : injective f) (g : α → γ) (e' : β → γ) :
   extend f g e' ∘ f = g :=
-funext $ λ a, extend_apply hf g e' a
+(hf.factors_through g).extend_comp e'
 
 lemma injective.surjective_comp_right' (hf : injective f) (g₀ : β → γ) :
   surjective (λ g : β → γ, g ∘ f) :=
@@ -608,7 +664,7 @@ def bicompr (f : γ → δ) (g : α → β → γ) (a b) :=
 f (g a b)
 
 -- Suggested local notation:
-local notation f `∘₂` g := bicompr f g
+local notation f ` ∘₂ ` g := bicompr f g
 
 lemma uncurry_bicompr (f : α → β → γ) (g : γ → δ) :
   uncurry (g ∘₂ f) = (g ∘ uncurry f) := rfl
@@ -633,7 +689,7 @@ class has_uncurry (α : Type*) (β : out_param Type*) (γ : out_param Type*) :=
 for bundled maps.-/
 add_decl_doc has_uncurry.uncurry
 
-notation `↿`:max x:max := has_uncurry.uncurry x
+notation (name := uncurry) `↿`:max x:max := has_uncurry.uncurry x
 
 instance has_uncurry_base : has_uncurry (α → β) α β := ⟨id⟩
 
@@ -648,6 +704,8 @@ def involutive {α} (f : α → α) : Prop := ∀ x, f (f x) = x
 lemma involutive_iff_iter_2_eq_id {α} {f : α → α} : involutive f ↔ (f^[2] = id) :=
 funext_iff.symm
 
+lemma _root_.bool.involutive_bnot : involutive bnot := bnot_bnot
+
 namespace involutive
 variables {α : Sort u} {f : α → α} (h : involutive f)
 include h
@@ -760,6 +818,21 @@ lemma eq_rec_inj {α : Sort*} {a a' : α} (h : a = a') {C : α → Type*} (x y :
 lemma cast_inj {α β : Type*} (h : α = β) {x y : α} : cast h x = cast h y ↔ x = y :=
 (cast_bijective h).injective.eq_iff
 
+lemma function.left_inverse.eq_rec_eq {α β : Sort*} {γ : β → Sort v} {f : α → β} {g : β → α}
+  (h : function.left_inverse g f) (C : Π a : α, γ (f a)) (a : α) :
+  (congr_arg f (h a)).rec (C (g (f a))) = C a :=
+eq_of_heq $ (eq_rec_heq _ _).trans $ by rw h
+
+lemma function.left_inverse.eq_rec_on_eq {α β : Sort*} {γ : β → Sort v} {f : α → β} {g : β → α}
+  (h : function.left_inverse g f) (C : Π a : α, γ (f a)) (a : α) :
+  (congr_arg f (h a)).rec_on (C (g (f a))) = C a :=
+h.eq_rec_eq _ _
+
+lemma function.left_inverse.cast_eq {α β : Sort*} {γ : β → Sort v} {f : α → β} {g : β → α}
+  (h : function.left_inverse g f) (C : Π a : α, γ (f a)) (a : α) :
+  cast (congr_arg (λ a, γ (f a)) (h a)) (C (g (f a))) = C a :=
+eq_of_heq $ (eq_rec_heq _ _).trans $ by rw h
+
 /-- A set of functions "separates points"
 if for each pair of distinct points there is a function taking different values on them. -/
 def set.separates_points {α β : Type*} (A : set (α → β)) : Prop :=
diff --git a/src/logic/function/conjugate.lean b/src/logic/function/conjugate.lean
index cbe7dd655b4eb..85946719b7a8d 100644
--- a/src/logic/function/conjugate.lean
+++ b/src/logic/function/conjugate.lean
@@ -8,6 +8,9 @@ import logic.function.basic
 /-!
 # Semiconjugate and commuting maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the following predicates:
 
 * `function.semiconj`: `f : α → β` semiconjugates `ga : α → α` to `gb : β → β` if `f ∘ ga = gb ∘ f`;
@@ -51,6 +54,11 @@ lemma inverses_right (h : semiconj f ga gb) (ha : right_inverse ga' ga)
   semiconj f ga' gb' :=
 λ x, by rw [← hb (f (ga' x)), ← h.eq, ha x]
 
+lemma option_map {f : α → β} {ga : α → α} {gb : β → β} (h : semiconj f ga gb) :
+  semiconj (option.map f) (option.map ga) (option.map gb)
+| none := rfl
+| (some a) := congr_arg some $ h _
+
 end semiconj
 
 /-- Two maps `f g : α → α` commute if `f (g x) = g (f x)` for all `x : α`.
@@ -78,6 +86,9 @@ lemma id_right : commute f id := semiconj.id_right
 
 lemma id_left : commute id f := semiconj.id_left
 
+lemma option_map {f g : α → α} : commute f g → commute (option.map f) (option.map g) :=
+semiconj.option_map
+
 end commute
 
 /-- A map `f` semiconjugates a binary operation `ga` to a binary operation `gb` if
diff --git a/src/logic/function/iterate.lean b/src/logic/function/iterate.lean
index d07e04274f4c6..7ee0de3cba916 100644
--- a/src/logic/function/iterate.lean
+++ b/src/logic/function/iterate.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
 import logic.function.conjugate
+import tactic.alias
 
 /-!
 # Iterations of a function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove simple properties of `nat.iterate f n` a.k.a. `f^[n]`:
 
 * `iterate_zero`, `iterate_succ`, `iterate_succ'`, `iterate_add`, `iterate_mul`:
@@ -148,7 +152,7 @@ lemma iterate.rec_zero (p : α → Sort*) {f : α → α} (h : ∀ a, p a → p
   iterate.rec p h ha 0 = ha :=
 rfl
 
-variable {f}
+variables {f} {m n : ℕ} {a : α}
 
 theorem left_inverse.iterate {g : α → α} (hg : left_inverse g f) (n : ℕ) :
   left_inverse (g^[n]) (f^[n]) :=
@@ -164,6 +168,18 @@ lemma iterate_comm (f : α → α) (m n : ℕ) : f^[n]^[m] = (f^[m]^[n]) :=
 lemma iterate_commute (m n : ℕ) : commute (λ f : α → α, f^[m]) (λ f, f^[n]) :=
 λ f, iterate_comm f m n
 
+lemma iterate_add_eq_iterate (hf : injective f) : f^[m + n] a = (f^[n] a) ↔ (f^[m] a) = a :=
+iff.trans (by rw [←iterate_add_apply, nat.add_comm]) (hf.iterate n).eq_iff
+
+alias iterate_add_eq_iterate ↔ iterate_cancel_of_add _
+
+lemma iterate_cancel (hf : injective f) (ha : f^[m] a = (f^[n] a)) : f^[m - n] a = a :=
+begin
+  cases le_total m n,
+  { simp [nat.sub_eq_zero_of_le h] },
+  { exact iterate_cancel_of_add hf (by rwa nat.sub_add_cancel h) }
+end
+
 end function
 
 namespace list
diff --git a/src/logic/hydra.lean b/src/logic/hydra.lean
new file mode 100644
index 0000000000000..97260914248eb
--- /dev/null
+++ b/src/logic/hydra.lean
@@ -0,0 +1,142 @@
+/-
+Copyright (c) 2022 Junyan Xu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Junyan Xu
+-/
+import data.finsupp.lex
+import data.finsupp.multiset
+import order.game_add
+
+/-!
+# Termination of a hydra game
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file deals with the following version of the hydra game: each head of the hydra is
+labelled by an element in a type `α`, and when you cut off one head with label `a`, it
+grows back an arbitrary but finite number of heads, all labelled by elements smaller than
+`a` with respect to a well-founded relation `r` on `α`. We show that no matter how (in
+what order) you choose cut off the heads, the game always terminates, i.e. all heads will
+eventually be cut off (but of course it can last arbitrarily long, i.e. takes an
+arbitrary finite number of steps).
+
+This result is stated as the well-foundedness of the `cut_expand` relation defined in
+this file: we model the heads of the hydra as a multiset of elements of `α`, and the
+valid "moves" of the game are modelled by the relation `cut_expand r` on `multiset α`:
+`cut_expand r s' s` is true iff `s'` is obtained by removing one head `a ∈ s` and
+adding back an arbitrary multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.
+
+We follow the proof by Peter LeFanu Lumsdaine at https://mathoverflow.net/a/229084/3332.
+
+TODO: formalize the relations corresponding to more powerful (e.g. Kirby–Paris and Buchholz)
+hydras, and prove their well-foundedness.
+-/
+
+namespace relation
+
+open multiset prod
+
+variables {α : Type*}
+
+/-- The relation that specifies valid moves in our hydra game. `cut_expand r s' s`
+  means that `s'` is obtained by removing one head `a ∈ s` and adding back an arbitrary
+  multiset `t` of heads such that all `a' ∈ t` satisfy `r a' a`.
+
+  This is most directly translated into `s' = s.erase a + t`, but `multiset.erase` requires
+  `decidable_eq α`, so we use the equivalent condition `s' + {a} = s + t` instead, which
+  is also easier to verify for explicit multisets `s'`, `s` and `t`.
+
+  We also don't include the condition `a ∈ s` because `s' + {a} = s + t` already
+  guarantees `a ∈ s + t`, and if `r` is irreflexive then `a ∉ t`, which is the
+  case when `r` is well-founded, the case we are primarily interested in.
+
+  The lemma `relation.cut_expand_iff` below converts between this convenient definition
+  and the direct translation when `r` is irreflexive. -/
+def cut_expand (r : α → α → Prop) (s' s : multiset α) : Prop :=
+∃ (t : multiset α) (a : α), (∀ a' ∈ t, r a' a) ∧ s' + {a} = s + t
+
+variable {r : α → α → Prop}
+
+lemma cut_expand_le_inv_image_lex [hi : is_irrefl α r] :
+  cut_expand r ≤ inv_image (finsupp.lex (rᶜ ⊓ (≠)) (<)) to_finsupp :=
+λ s t ⟨u, a, hr, he⟩, begin
+  classical, refine ⟨a, λ b h, _, _⟩; simp_rw to_finsupp_apply,
+  { apply_fun count b at he, simp_rw count_add at he,
+    convert he; convert (add_zero _).symm; rw count_eq_zero; intro hb,
+    exacts [h.2 (mem_singleton.1 hb), h.1 (hr b hb)] },
+  { apply_fun count a at he, simp_rw [count_add, count_singleton_self] at he,
+    apply nat.lt_of_succ_le, convert he.le, convert (add_zero _).symm,
+    exact count_eq_zero.2 (λ ha, hi.irrefl a $ hr a ha) },
+end
+
+theorem cut_expand_singleton {s x} (h : ∀ x' ∈ s, r x' x) : cut_expand r s {x} :=
+⟨s, x, h, add_comm s _⟩
+
+theorem cut_expand_singleton_singleton {x' x} (h : r x' x) : cut_expand r {x'} {x} :=
+cut_expand_singleton (λ a h, by rwa mem_singleton.1 h)
+
+theorem cut_expand_add_left {t u} (s) : cut_expand r (s + t) (s + u) ↔ cut_expand r t u :=
+exists₂_congr $ λ _ _, and_congr iff.rfl $ by rw [add_assoc, add_assoc, add_left_cancel_iff]
+
+lemma cut_expand_iff [decidable_eq α] [is_irrefl α r] {s' s : multiset α} :
+  cut_expand r s' s ↔ ∃ (t : multiset α) a, (∀ a' ∈ t, r a' a) ∧ a ∈ s ∧ s' = s.erase a + t :=
+begin
+  simp_rw [cut_expand, add_singleton_eq_iff],
+  refine exists₂_congr (λ t a, ⟨_, _⟩),
+  { rintro ⟨ht, ha, rfl⟩,
+    obtain h|h := mem_add.1 ha,
+    exacts [⟨ht, h, t.erase_add_left_pos h⟩, (@irrefl α r _ a (ht a h)).elim] },
+  { rintro ⟨ht, h, rfl⟩,
+    exact ⟨ht, mem_add.2 (or.inl h), (t.erase_add_left_pos h).symm⟩ },
+end
+
+theorem not_cut_expand_zero [is_irrefl α r] (s) : ¬ cut_expand r s 0 :=
+by { classical, rw cut_expand_iff, rintro ⟨_, _, _, ⟨⟩, _⟩ }
+
+/-- For any relation `r` on `α`, multiset addition `multiset α × multiset α → multiset α` is a
+  fibration between the game sum of `cut_expand r` with itself and `cut_expand r` itself. -/
+lemma cut_expand_fibration (r : α → α → Prop) :
+  fibration (game_add (cut_expand r) (cut_expand r)) (cut_expand r) (λ s, s.1 + s.2) :=
+begin
+  rintro ⟨s₁, s₂⟩ s ⟨t, a, hr, he⟩, dsimp at he ⊢,
+  classical, obtain ⟨ha, rfl⟩ := add_singleton_eq_iff.1 he,
+  rw [add_assoc, mem_add] at ha, obtain (h|h) := ha,
+  { refine ⟨(s₁.erase a + t, s₂), game_add.fst ⟨t, a, hr, _⟩, _⟩,
+    { rw [add_comm, ← add_assoc, singleton_add, cons_erase h] },
+    { rw [add_assoc s₁, erase_add_left_pos _ h, add_right_comm, add_assoc] } },
+  { refine ⟨(s₁, (s₂ + t).erase a), game_add.snd ⟨t, a, hr, _⟩, _⟩,
+    { rw [add_comm, singleton_add, cons_erase h] },
+    { rw [add_assoc, erase_add_right_pos _ h] } },
+end
+
+/-- A multiset is accessible under `cut_expand` if all its singleton subsets are,
+  assuming `r` is irreflexive. -/
+lemma acc_of_singleton [is_irrefl α r] {s : multiset α} :
+  (∀ a ∈ s, acc (cut_expand r) {a}) → acc (cut_expand r) s :=
+begin
+  refine multiset.induction _ _ s,
+  { exact λ _, acc.intro 0 $ λ s h, (not_cut_expand_zero s h).elim },
+  { intros a s ih hacc, rw ← s.singleton_add a,
+    exact ((hacc a $ s.mem_cons_self a).prod_game_add $ ih $ λ a ha,
+      hacc a $ mem_cons_of_mem ha).of_fibration _ (cut_expand_fibration r) },
+end
+
+/-- A singleton `{a}` is accessible under `cut_expand r` if `a` is accessible under `r`,
+  assuming `r` is irreflexive. -/
+lemma _root_.acc.cut_expand [is_irrefl α r] {a : α} (hacc : acc r a) : acc (cut_expand r) {a} :=
+begin
+  induction hacc with a h ih,
+  refine acc.intro _ (λ s, _),
+  classical, rw cut_expand_iff,
+  rintro ⟨t, a, hr, rfl|⟨⟨⟩⟩, rfl⟩,
+  refine acc_of_singleton (λ a', _),
+  rw [erase_singleton, zero_add],
+  exact ih a' ∘ hr a',
+end
+
+/-- `cut_expand r` is well-founded when `r` is. -/
+theorem _root_.well_founded.cut_expand (hr : well_founded r) : well_founded (cut_expand r) :=
+⟨by { letI h := hr.is_irrefl, exact λ s, acc_of_singleton $ λ a _, (hr.apply a).cut_expand }⟩
+
+end relation
diff --git a/src/logic/is_empty.lean b/src/logic/is_empty.lean
index 8c91c08fd2aab..349093c9bcf8b 100644
--- a/src/logic/is_empty.lean
+++ b/src/logic/is_empty.lean
@@ -5,9 +5,13 @@ Authors: Floris van Doorn
 -/
 import logic.function.basic
 import tactic.protected
+
 /-!
 # Types that are empty
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define a typeclass `is_empty`, which expresses that a type has no elements.
 
 ## Main declaration
@@ -54,6 +58,9 @@ lemma subtype.is_empty_of_false {p : α → Prop} (hp : ∀ a, ¬(p a)) : is_emp
 instance subtype.is_empty_false : is_empty {a : α // false} :=
 subtype.is_empty_of_false (λ a, id)
 
+instance sigma.is_empty_left {α} [is_empty α] {E : α → Type*} : is_empty (sigma E) :=
+function.is_empty sigma.fst
+
 /- Test that `pi.is_empty` finds this instance. -/
 example [h : nonempty α] [is_empty β] : is_empty (α → β) := by apply_instance
 
@@ -81,10 +88,10 @@ is_empty_iff
 
 variables [is_empty α]
 
-lemma forall_iff {p : α → Prop} : (∀ a, p a) ↔ true :=
+@[simp] lemma forall_iff {p : α → Prop} : (∀ a, p a) ↔ true :=
 iff_true_intro is_empty_elim
 
-lemma exists_iff {p : α → Prop} : (∃ a, p a) ↔ false :=
+@[simp] lemma exists_iff {p : α → Prop} : (∃ a, p a) ↔ false :=
 iff_false_intro $ λ ⟨x, hx⟩, is_empty.false x
 
 @[priority 100] -- see Note [lower instance priority]
@@ -98,9 +105,23 @@ end is_empty
 @[simp] lemma not_is_empty_iff : ¬ is_empty α ↔ nonempty α :=
 not_iff_comm.mp not_nonempty_iff
 
+@[simp] lemma is_empty_Prop {p : Prop} : is_empty p ↔ ¬p :=
+by simp only [← not_nonempty_iff, nonempty_Prop]
+
 @[simp] lemma is_empty_pi {π : α → Sort*} : is_empty (Π a, π a) ↔ ∃ a, is_empty (π a) :=
 by simp only [← not_nonempty_iff, classical.nonempty_pi, not_forall]
 
+@[simp] lemma is_empty_sigma {α} {E : α → Type*} :
+  is_empty (sigma E) ↔ ∀ a, is_empty (E a) :=
+by simp only [← not_nonempty_iff, nonempty_sigma, not_exists]
+
+@[simp] lemma is_empty_psigma {α} {E : α → Sort*} :
+  is_empty (psigma E) ↔ ∀ a, is_empty (E a) :=
+by simp only [← not_nonempty_iff, nonempty_psigma, not_exists]
+
+@[simp] lemma is_empty_subtype (p : α → Prop) : is_empty (subtype p) ↔ ∀ x, ¬p x :=
+by simp only [← not_nonempty_iff, nonempty_subtype, not_exists]
+
 @[simp] lemma is_empty_prod {α β : Type*} : is_empty (α × β) ↔ is_empty α ∨ is_empty β :=
 by simp only [← not_nonempty_iff, nonempty_prod, not_and_distrib]
 
@@ -113,6 +134,15 @@ by simp only [← not_nonempty_iff, nonempty_sum, not_or_distrib]
 @[simp] lemma is_empty_psum {α β} : is_empty (psum α β) ↔ is_empty α ∧ is_empty β :=
 by simp only [← not_nonempty_iff, nonempty_psum, not_or_distrib]
 
+@[simp] lemma is_empty_ulift {α} : is_empty (ulift α) ↔ is_empty α :=
+by simp only [← not_nonempty_iff, nonempty_ulift]
+
+@[simp] lemma is_empty_plift {α} : is_empty (plift α) ↔ is_empty α :=
+by simp only [← not_nonempty_iff, nonempty_plift]
+
+lemma well_founded_of_empty {α} [is_empty α] (r : α → α → Prop) : well_founded r :=
+⟨is_empty_elim⟩
+
 variables (α)
 
 lemma is_empty_or_nonempty : is_empty α ∨ nonempty α :=
diff --git a/src/logic/lemmas.lean b/src/logic/lemmas.lean
new file mode 100644
index 0000000000000..930d6d764eebc
--- /dev/null
+++ b/src/logic/lemmas.lean
@@ -0,0 +1,72 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import tactic.congr
+import tactic.protected
+import tactic.rcases
+import tactic.split_ifs
+import logic.basic
+
+/-!
+# More basic logic properties
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A few more logic lemmas. These are in their own file, rather than `logic.basic`, because it is
+convenient to be able to use the `split_ifs` tactic.
+
+## Implementation notes
+
+We spell those lemmas out with `dite` and `ite` rather than the `if then else` notation because this
+would result in less delta-reduced statements.
+-/
+
+alias heq_iff_eq ↔ heq.eq eq.heq
+
+attribute [protected] heq.eq eq.heq
+
+alias ne_of_eq_of_ne ← eq.trans_ne
+alias ne_of_ne_of_eq ← ne.trans_eq
+
+variables {α : Sort*} {p q r : Prop} [decidable p] [decidable q] {a b c : α}
+
+lemma dite_dite_distrib_left {a : p → α} {b : ¬ p → q → α} {c : ¬ p → ¬ q → α} :
+  dite p a (λ hp, dite q (b hp) (c hp)) =
+    dite q (λ hq, dite p a $ λ hp, b hp hq) (λ hq, dite p a $ λ hp, c hp hq) :=
+by split_ifs; refl
+
+lemma dite_dite_distrib_right {a : p → q → α} {b : p → ¬ q → α} {c : ¬ p → α} :
+  dite p (λ hp, dite q (a hp) (b hp)) c =
+    dite q (λ hq, dite p (λ hp, a hp hq) c) (λ hq, dite p (λ hp, b hp hq) c) :=
+by split_ifs; refl
+
+lemma ite_dite_distrib_left {a : α} {b : q → α} {c : ¬ q → α} :
+  ite p a (dite q b c) = dite q (λ hq, ite p a $ b hq) (λ hq, ite p a $ c hq) :=
+dite_dite_distrib_left
+
+lemma ite_dite_distrib_right {a : q → α} {b : ¬ q → α} {c : α} :
+  ite p (dite q a b) c = dite q (λ hq, ite p (a hq) c) (λ hq, ite p (b hq) c) :=
+dite_dite_distrib_right
+
+lemma dite_ite_distrib_left {a : p → α} {b : ¬ p → α} {c : ¬ p → α} :
+  dite p a (λ hp, ite q (b hp) (c hp)) = ite q (dite p a b) (dite p a c) :=
+dite_dite_distrib_left
+
+lemma dite_ite_distrib_right {a : p → α} {b : p → α} {c : ¬ p → α} :
+  dite p (λ hp, ite q (a hp) (b hp)) c = ite q (dite p a c) (dite p b c) :=
+dite_dite_distrib_right
+
+lemma ite_ite_distrib_left : ite p a (ite q b c) = ite q (ite p a b) (ite p a c) :=
+dite_dite_distrib_left
+
+lemma ite_ite_distrib_right : ite p (ite q a b) c = ite q (ite p a c) (ite p b c) :=
+dite_dite_distrib_right
+
+lemma Prop.forall {f : Prop → Prop} : (∀ p, f p) ↔ f true ∧ f false :=
+⟨λ h, ⟨h _, h _⟩, by { rintro ⟨h₁, h₀⟩ p, by_cases hp : p; simp only [hp]; assumption }⟩
+
+lemma Prop.exists {f : Prop → Prop} : (∃ p, f p) ↔ f true ∨ f false :=
+⟨λ ⟨p, h⟩, by refine (em p).imp _ _; intro H; convert h; simp [H], by rintro (h | h); exact ⟨_, h⟩⟩
diff --git a/src/logic/nonempty.lean b/src/logic/nonempty.lean
index 178635f3b8080..bf8eb3ed20519 100644
--- a/src/logic/nonempty.lean
+++ b/src/logic/nonempty.lean
@@ -8,6 +8,9 @@ import logic.basic
 /-!
 # Nonempty types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves a few extra facts about `nonempty`, which is defined in core Lean.
 
 ## Main declarations
@@ -38,6 +41,9 @@ lemma not_nonempty_iff_imp_false {α : Sort*} : ¬ nonempty α ↔ α → false
 @[simp] lemma nonempty_sigma : nonempty (Σa:α, γ a) ↔ (∃a:α, nonempty (γ a)) :=
 iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)
 
+@[simp] lemma nonempty_psigma {α} {β : α → Sort*} : nonempty (psigma β) ↔ (∃a:α, nonempty (β a)) :=
+iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)
+
 @[simp] lemma nonempty_subtype {α} {p : α → Prop} : nonempty (subtype p) ↔ (∃a:α, p a) :=
 iff.intro (assume ⟨⟨a, h⟩⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a, h⟩⟩)
 
@@ -57,9 +63,6 @@ iff.intro
   (assume ⟨h⟩, match h with psum.inl a := or.inl ⟨a⟩ | psum.inr b := or.inr ⟨b⟩ end)
   (assume h, match h with or.inl ⟨a⟩ := ⟨psum.inl a⟩ | or.inr ⟨b⟩ := ⟨psum.inr b⟩ end)
 
-@[simp] lemma nonempty_psigma {α} {β : α → Sort*} : nonempty (psigma β) ↔ (∃a:α, nonempty (β a)) :=
-iff.intro (assume ⟨⟨a, c⟩⟩, ⟨a, ⟨c⟩⟩) (assume ⟨a, ⟨c⟩⟩, ⟨⟨a, c⟩⟩)
-
 @[simp] lemma nonempty_empty : ¬ nonempty empty :=
 assume ⟨h⟩, h.elim
 
@@ -75,9 +78,6 @@ iff.intro (assume h a, h _) (assume h ⟨a⟩, h _)
 @[simp] lemma nonempty.exists {α} {p : nonempty α → Prop} : (∃h:nonempty α, p h) ↔ (∃a, p ⟨a⟩) :=
 iff.intro (assume ⟨⟨a⟩, h⟩, ⟨a, h⟩) (assume ⟨a, h⟩, ⟨⟨a⟩, h⟩)
 
-lemma classical.nonempty_pi {α} {β : α → Sort*} : nonempty (Πa:α, β a) ↔ (∀a:α, nonempty (β a)) :=
-iff.intro (assume ⟨f⟩ a, ⟨f a⟩) (assume f, ⟨assume a, classical.choice $ f a⟩)
-
 /-- Using `classical.choice`, lifts a (`Prop`-valued) `nonempty` instance to a (`Type`-valued)
   `inhabited` instance. `classical.inhabited_of_nonempty` already exists, in
   `core/init/classical.lean`, but the assumption is not a type class argument,
@@ -112,9 +112,16 @@ h.elim $ f ∘ inhabited.mk
 instance {α β} [h : nonempty α] [h2 : nonempty β] : nonempty (α × β) :=
 h.elim $ λ g, h2.elim $ λ g2, ⟨⟨g, g2⟩⟩
 
+instance {ι : Sort*} {α : ι → Sort*} [Π i, nonempty (α i)] : nonempty (Π i, α i) :=
+⟨λ _, classical.arbitrary _⟩
+
+lemma classical.nonempty_pi {ι} {α : ι → Sort*} : nonempty (Π i, α i) ↔ ∀ i, nonempty (α i) :=
+⟨λ ⟨f⟩ a, ⟨f a⟩, @pi.nonempty _ _⟩
+
 lemma subsingleton_of_not_nonempty {α : Sort*} (h : ¬ nonempty α) : subsingleton α :=
 ⟨λ x, false.elim $ not_nonempty_iff_imp_false.mp h x⟩
 
-lemma function.surjective.nonempty [h : nonempty β] {f : α → β} (hf : function.surjective f) :
+lemma function.surjective.nonempty {α β : Sort*} [h : nonempty β] {f : α → β}
+  (hf : function.surjective f) :
   nonempty α :=
 let ⟨y⟩ := h, ⟨x, hx⟩ := hf y in ⟨x⟩
diff --git a/src/logic/nontrivial.lean b/src/logic/nontrivial.lean
index cb91c974cceec..14ad9c3c2116d 100644
--- a/src/logic/nontrivial.lean
+++ b/src/logic/nontrivial.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
-import data.prod
+import data.prod.basic
 import data.subtype
 import logic.function.basic
 import logic.unique
@@ -11,6 +11,9 @@ import logic.unique
 /-!
 # Nontrivial types
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A type is *nontrivial* if it contains at least two elements. This is useful in particular for rings
 (where it is equivalent to the fact that zero is different from one) and for vector spaces
 (where it is equivalent to the fact that the dimension is positive).
@@ -103,6 +106,9 @@ lemma subsingleton_iff : subsingleton α ↔ ∀ (x y : α), x = y :=
 lemma not_nontrivial_iff_subsingleton : ¬(nontrivial α) ↔ subsingleton α :=
 by { rw [nontrivial_iff, subsingleton_iff], push_neg, refl }
 
+lemma not_nontrivial (α) [subsingleton α] : ¬nontrivial α :=
+λ ⟨⟨x, y, h⟩⟩, h $ subsingleton.elim x y
+
 lemma not_subsingleton (α) [h : nontrivial α] : ¬subsingleton α :=
 let ⟨⟨x, y, hxy⟩⟩ := h in λ ⟨h'⟩, hxy $ h' x y
 
@@ -172,127 +178,10 @@ end pi
 instance function.nontrivial [h : nonempty α] [nontrivial β] : nontrivial (α → β) :=
 h.elim $ λ a, pi.nontrivial_at a
 
-mk_simp_attribute nontriviality "Simp lemmas for `nontriviality` tactic"
-
+@[nontriviality]
 protected lemma subsingleton.le [preorder α] [subsingleton α] (x y : α) : x ≤ y :=
 le_of_eq (subsingleton.elim x y)
 
-attribute [nontriviality] eq_iff_true_of_subsingleton subsingleton.le
-
-namespace tactic
-
-/--
-Tries to generate a `nontrivial α` instance by performing case analysis on
-`subsingleton_or_nontrivial α`,
-attempting to discharge the subsingleton branch using lemmas with `@[nontriviality]` attribute,
-including `subsingleton.le` and `eq_iff_true_of_subsingleton`.
--/
-meta def nontriviality_by_elim (α : expr) (lems : interactive.parse simp_arg_list) : tactic unit :=
-do
-  alternative ← to_expr ``(subsingleton_or_nontrivial %%α),
-  n ← get_unused_name "_inst",
-  tactic.cases alternative [n, n],
-  (solve1 $ do
-    reset_instance_cache,
-    apply_instance <|>
-      interactive.simp none none ff lems [`nontriviality] (interactive.loc.ns [none])) <|>
-      fail format!"Could not prove goal assuming `subsingleton {α}`",
-  reset_instance_cache
-
-/--
-Tries to generate a `nontrivial α` instance using `nontrivial_of_ne` or `nontrivial_of_lt`
-and local hypotheses.
--/
-meta def nontriviality_by_assumption (α : expr) : tactic unit :=
-do
-  n ← get_unused_name "_inst",
-  to_expr ``(nontrivial %%α) >>= assert n,
-  apply_instance <|> `[solve_by_elim [nontrivial_of_ne, nontrivial_of_lt]],
-  reset_instance_cache
-
-end tactic
-
-namespace tactic.interactive
-
-open tactic
-
-setup_tactic_parser
-
-/--
-Attempts to generate a `nontrivial α` hypothesis.
-
-The tactic first looks for an instance using `apply_instance`.
-
-If the goal is an (in)equality, the type `α` is inferred from the goal.
-Otherwise, the type needs to be specified in the tactic invocation, as `nontriviality α`.
-
-The `nontriviality` tactic will first look for strict inequalities amongst the hypotheses,
-and use these to derive the `nontrivial` instance directly.
-
-Otherwise, it will perform a case split on `subsingleton α ∨ nontrivial α`, and attempt to discharge
-the `subsingleton` goal using `simp [lemmas] with nontriviality`, where `[lemmas]` is a list of
-additional `simp` lemmas that can be passed to `nontriviality` using the syntax
-`nontriviality α using [lemmas]`.
-
-```
-example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
-begin
-  nontriviality, -- There is now a `nontrivial R` hypothesis available.
-  assumption,
-end
-```
-
-```
-example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
-begin
-  nontriviality, -- There is now a `nontrivial R` hypothesis available.
-  apply mul_comm,
-end
-```
-
-```
-example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : (2 : ℕ) ∣ 4 :=
-begin
-  nontriviality R, -- there is now a `nontrivial R` hypothesis available.
-  dec_trivial
-end
-```
-
-```
-def myeq {α : Type} (a b : α) : Prop := a = b
-
-example {α : Type} (a b : α) (h : a = b) : myeq a b :=
-begin
-  success_if_fail { nontriviality α }, -- Fails
-  nontriviality α using [myeq], -- There is now a `nontrivial α` hypothesis available
-  assumption
-end
-```
--/
-meta def nontriviality (t : parse texpr?)
-  (lems : parse (tk "using" *> simp_arg_list <|> pure [])) :
-  tactic unit :=
-do
-  α ← match t with
-  | some α := to_expr α
-  | none :=
-    (do t ← mk_mvar, e ← to_expr ``(@eq %%t _ _), target >>= unify e, return t) <|>
-    (do t ← mk_mvar, e ← to_expr ``(@has_le.le %%t _ _ _), target >>= unify e, return t) <|>
-    (do t ← mk_mvar, e ← to_expr ``(@ne %%t _ _), target >>= unify e, return t) <|>
-    (do t ← mk_mvar, e ← to_expr ``(@has_lt.lt %%t _ _ _), target >>= unify e, return t) <|>
-    fail "The goal is not an (in)equality, so you'll need to specify the desired `nontrivial α`
-      instance by invoking `nontriviality α`."
-  end,
-  nontriviality_by_assumption α <|> nontriviality_by_elim α lems
-
-add_tactic_doc
-{ name                     := "nontriviality",
-  category                 := doc_category.tactic,
-  decl_names               := [`tactic.interactive.nontriviality],
-  tags                     := ["logic", "type class"] }
-
-end tactic.interactive
-
 namespace bool
 
 instance : nontrivial bool := ⟨⟨tt,ff, tt_eq_ff_eq_false⟩⟩
diff --git a/src/logic/pairwise.lean b/src/logic/pairwise.lean
new file mode 100644
index 0000000000000..4835ef323ddfc
--- /dev/null
+++ b/src/logic/pairwise.lean
@@ -0,0 +1,74 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import logic.function.basic
+import tactic.basic
+
+/-!
+# Relations holding pairwise
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines pairwise relations.
+
+## Main declarations
+
+* `pairwise`: `pairwise r` states that `r i j` for all `i ≠ j`.
+* `set.pairwise`: `s.pairwise r` states that `r i j` for all `i ≠ j` with `i, j ∈ s`.
+-/
+
+open set function
+
+variables {α β γ ι ι' : Type*} {r p q : α → α → Prop}
+
+section pairwise
+variables {f g : ι → α} {s t u : set α} {a b : α}
+
+/-- A relation `r` holds pairwise if `r i j` for all `i ≠ j`. -/
+def pairwise (r : α → α → Prop) := ∀ ⦃i j⦄, i ≠ j → r i j
+
+lemma pairwise.mono (hr : pairwise r) (h : ∀ ⦃i j⦄, r i j → p i j) : pairwise p :=
+λ i j hij, h $ hr hij
+
+protected lemma pairwise.eq (h : pairwise r) : ¬ r a b → a = b := not_imp_comm.1 $ @h _ _
+
+lemma function.injective_iff_pairwise_ne : injective f ↔ pairwise ((≠) on f) :=
+forall₂_congr $ λ i j, not_imp_not.symm
+
+alias function.injective_iff_pairwise_ne ↔ function.injective.pairwise_ne _
+
+namespace set
+
+/-- The relation `r` holds pairwise on the set `s` if `r x y` for all *distinct* `x y ∈ s`. -/
+protected def pairwise (s : set α) (r : α → α → Prop) := ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → x ≠ y → r x y
+
+lemma pairwise_of_forall (s : set α) (r : α → α → Prop) (h : ∀ a b, r a b) : s.pairwise r :=
+λ a _ b _ _, h a b
+
+lemma pairwise.imp_on (h : s.pairwise r) (hrp : s.pairwise (λ ⦃a b : α⦄, r a b → p a b)) :
+  s.pairwise p :=
+λ a ha b hb hab, hrp ha hb hab $ h ha hb hab
+
+lemma pairwise.imp (h : s.pairwise r) (hpq : ∀ ⦃a b : α⦄, r a b → p a b) : s.pairwise p :=
+h.imp_on $ pairwise_of_forall s _ hpq
+
+protected lemma pairwise.eq (hs : s.pairwise r) (ha : a ∈ s) (hb : b ∈ s) (h : ¬ r a b) : a = b :=
+of_not_not $ λ hab, h $ hs ha hb hab
+
+lemma _root_.reflexive.set_pairwise_iff (hr : reflexive r) :
+  s.pairwise r ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b :=
+forall₄_congr $ λ a _ b _, or_iff_not_imp_left.symm.trans $ or_iff_right_of_imp $ eq.rec $ hr a
+
+lemma pairwise.on_injective (hs : s.pairwise r) (hf : function.injective f)
+  (hfs : ∀ x, f x ∈ s) :
+  pairwise (r on f) :=
+λ i j hij, hs (hfs i) (hfs j) (hf.ne hij)
+
+end set
+
+lemma pairwise.set_pairwise (h : pairwise r) (s : set α) : s.pairwise r := λ x hx y hy w, h w
+
+end pairwise
diff --git a/src/logic/relation.lean b/src/logic/relation.lean
index 588181c272806..466ad575131e0 100644
--- a/src/logic/relation.lean
+++ b/src/logic/relation.lean
@@ -9,6 +9,9 @@ import logic.relator
 /-!
 # Relation closures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the reflexive, transitive, and reflexive transitive closures of relations.
 It also proves some basic results on definitions in core, such as `eqv_gen`.
 
@@ -39,7 +42,7 @@ the bundled version, see `rel`.
 
 open function
 
-variables {α β γ δ : Type*}
+variables {α β γ δ ε κ : Type*}
 
 section ne_imp
 
@@ -147,6 +150,33 @@ end
 
 end comp
 
+section fibration
+
+variables (rα : α → α → Prop) (rβ : β → β → Prop) (f : α → β)
+
+/-- A function `f : α → β` is a fibration between the relation `rα` and `rβ` if for all
+  `a : α` and `b : β`, whenever `b : β` and `f a` are related by `rβ`, `b` is the image
+  of some `a' : α` under `f`, and `a'` and `a` are related by `rα`. -/
+def fibration := ∀ ⦃a b⦄, rβ b (f a) → ∃ a', rα a' a ∧ f a' = b
+
+variables {rα rβ}
+
+/-- If `f : α → β` is a fibration between relations `rα` and `rβ`, and `a : α` is
+  accessible under `rα`, then `f a` is accessible under `rβ`. -/
+lemma _root_.acc.of_fibration (fib : fibration rα rβ f) {a} (ha : acc rα a) : acc rβ (f a) :=
+begin
+  induction ha with a ha ih,
+  refine acc.intro (f a) (λ b hr, _),
+  obtain ⟨a', hr', rfl⟩ := fib hr,
+  exact ih a' hr',
+end
+
+lemma _root_.acc.of_downward_closed (dc : ∀ {a b}, rβ b (f a) → ∃ c, f c = b)
+  (a : α) (ha : acc (inv_image rβ f) a) : acc rβ (f a) :=
+ha.of_fibration f (λ a b h, let ⟨a', he⟩ := dc h in ⟨a', he.substr h, he⟩)
+
+end fibration
+
 /--
 The map of a relation `r` through a pair of functions pushes the
 relation to the codomains of the functions.  The resulting relation is
@@ -156,6 +186,27 @@ related by `r`.
 protected def map (r : α → β → Prop) (f : α → γ) (g : β → δ) : γ → δ → Prop :=
 λ c d, ∃ a b, r a b ∧ f a = c ∧ g b = d
 
+section map
+variables {r : α → β → Prop} {f : α → γ} {g : β → δ} {c : γ} {d : δ}
+
+lemma map_apply : relation.map r f g c d ↔ ∃ a b, r a b ∧ f a = c ∧ g b = d := iff.rfl
+
+@[simp] lemma map_id_id (r : α → β → Prop) : relation.map r id id = r := by simp [relation.map]
+
+@[simp] lemma map_map (r : α → β → Prop) (f₁ : α → γ) (g₁ : β → δ) (f₂ : γ → ε) (g₂ : δ → κ) :
+  relation.map (relation.map r f₁ g₁) f₂ g₂ = relation.map r (f₂ ∘ f₁) (g₂ ∘ g₁) :=
+begin
+  ext a b,
+  simp only [map_apply, function.comp_app, ←exists_and_distrib_right, @exists₂_comm γ],
+  refine exists₂_congr (λ a b, _),
+  simp [and_assoc],
+end
+
+instance [decidable (∃ a b, r a b ∧ f a = c ∧ g b = d)] : decidable (relation.map r f g c d) :=
+‹decidable _›
+
+end map
+
 variables {r : α → α → Prop} {a b c d : α}
 
 /-- `refl_trans_gen r`: reflexive transitive closure of `r` -/
@@ -373,13 +424,19 @@ end
 
 end trans_gen
 
-lemma _root_.well_founded.trans_gen {α} {r : α → α → Prop} (h : well_founded r) :
-  well_founded (trans_gen r) :=
-⟨λ a, h.induction a (λ x H, acc.intro x (λ y hy, begin
+lemma _root_.acc.trans_gen (h : acc r a) : acc (trans_gen r) a :=
+begin
+  induction h with x _ H,
+  refine acc.intro x (λ y hy, _),
   cases hy with _ hyx z _ hyz hzx,
-  { exact H y hyx },
-  { exact acc.inv (H z hzx) hyz }
-end))⟩
+  exacts [H y hyx, (H z hzx).inv hyz],
+end
+
+lemma _root_.acc_trans_gen_iff : acc (trans_gen r) a ↔ acc r a :=
+⟨subrelation.accessible (λ _ _, trans_gen.single), acc.trans_gen⟩
+
+lemma _root_.well_founded.trans_gen (h : well_founded r) : well_founded (trans_gen r) :=
+⟨λ a, (h.apply a).trans_gen⟩
 
 section trans_gen
 
diff --git a/src/logic/relator.lean b/src/logic/relator.lean
index 30aa8a5230e81..e2d4251b193b5 100644
--- a/src/logic/relator.lean
+++ b/src/logic/relator.lean
@@ -2,12 +2,17 @@
 Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
-
-Relator for functions, pairs, sums, and lists.
 -/
 
 import logic.basic
 
+/-!
+# Relator for functions, pairs, sums, and lists.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
 namespace relator
 universes u₁ u₂ v₁ v₂
 
@@ -26,7 +31,7 @@ variables (R : α → β → Prop) (S : γ → δ → Prop)
 def lift_fun (f : α → γ) (g : β → δ) : Prop :=
 ∀⦃a b⦄, R a b → S (f a) (g b)
 
-infixr ⇒ := lift_fun
+infixr ` ⇒ ` := lift_fun
 
 end
 
diff --git a/src/logic/small.lean b/src/logic/small.lean
deleted file mode 100644
index b54426e440b75..0000000000000
--- a/src/logic/small.lean
+++ /dev/null
@@ -1,143 +0,0 @@
-/-
-Copyright (c) 2021 Scott Morrison. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Scott Morrison
--/
-import data.vector.basic
-
-/-!
-# Small types
-
-A type is `w`-small if there exists an equivalence to some `S : Type w`.
-
-We provide a noncomputable model `shrink α : Type w`, and `equiv_shrink α : α ≃ shrink α`.
-
-A subsingleton type is `w`-small for any `w`.
-
-If `α ≃ β`, then `small.{w} α ↔ small.{w} β`.
--/
-
-universes u w v
-
-/--
-A type is `small.{w}` if there exists an equivalence to some `S : Type w`.
--/
-class small (α : Type v) : Prop :=
-(equiv_small : ∃ (S : Type w), nonempty (α ≃ S))
-
-/--
-Constructor for `small α` from an explicit witness type and equivalence.
--/
-lemma small.mk' {α : Type v} {S : Type w} (e : α ≃ S) : small.{w} α :=
-⟨⟨S, ⟨e⟩⟩⟩
-
-/--
-An arbitrarily chosen model in `Type w` for a `w`-small type.
--/
-@[nolint has_inhabited_instance]
-def shrink (α : Type v) [small.{w} α] : Type w :=
-classical.some (@small.equiv_small α _)
-
-/--
-The noncomputable equivalence between a `w`-small type and a model.
--/
-noncomputable
-def equiv_shrink (α : Type v) [small.{w} α] : α ≃ shrink α :=
-nonempty.some (classical.some_spec (@small.equiv_small α _))
-
-@[priority 100]
-instance small_self (α : Type v) : small.{v} α :=
-small.mk' (equiv.refl _)
-
-@[priority 100]
-instance small_max (α : Type v) : small.{max w v} α :=
-small.mk' equiv.ulift.{w}.symm
-
-instance small_ulift (α : Type v) : small.{v} (ulift.{w} α) :=
-small.mk' equiv.ulift
-
-theorem small_type : small.{max (u+1) v} (Type u) := small_max.{max (u+1) v} _
-
-section
-open_locale classical
-
-theorem small_map {α : Type*} {β : Type*} [hβ : small.{w} β] (e : α ≃ β) : small.{w} α :=
-let ⟨γ, ⟨f⟩⟩ := hβ.equiv_small in small.mk' (e.trans f)
-
-theorem small_congr {α : Type*} {β : Type*} (e : α ≃ β) : small.{w} α ↔ small.{w} β :=
-⟨λ h, @small_map _ _ h e.symm, λ h, @small_map _ _ h e⟩
-
-instance small_subtype (α : Type v) [small.{w} α] (P : α → Prop) : small.{w} { x // P x } :=
-small_map (equiv_shrink α).subtype_equiv_of_subtype'
-
-theorem small_of_injective {α : Type v} {β : Type w} [small.{u} β] {f : α → β}
-  (hf : function.injective f) : small.{u} α :=
-small_map (equiv.of_injective f hf)
-
-theorem small_of_surjective {α : Type v} {β : Type w} [small.{u} α] {f : α → β}
-  (hf : function.surjective f) : small.{u} β :=
-small_of_injective (function.injective_surj_inv hf)
-
-theorem small_subset {α : Type v} {s t : set α} (hts : t ⊆ s) [small.{u} s] : small.{u} t :=
-let f : t → s := λ x, ⟨x, hts x.prop⟩ in
-  @small_of_injective _ _ _ f (λ x y hxy, subtype.ext (subtype.mk.inj hxy))
-
-@[priority 100]
-instance small_subsingleton (α : Type v) [subsingleton α] : small.{w} α :=
-begin
-  rcases is_empty_or_nonempty α; resetI,
-  { apply small_map (equiv.equiv_pempty α) },
-  { apply small_map equiv.punit_of_nonempty_of_subsingleton, assumption' },
-end
-
-/-!
-We don't define `small_of_fintype` or `small_of_encodable` in this file,
-to keep imports to `logic` to a minimum.
--/
-
-instance small_Pi {α} (β : α → Type*) [small.{w} α] [∀ a, small.{w} (β a)] :
-  small.{w} (Π a, β a) :=
-⟨⟨Π a' : shrink α, shrink (β ((equiv_shrink α).symm a')),
-  ⟨equiv.Pi_congr (equiv_shrink α) (λ a, by simpa using equiv_shrink (β a))⟩⟩⟩
-
-instance small_sigma {α} (β : α → Type*) [small.{w} α] [∀ a, small.{w} (β a)] :
-  small.{w} (Σ a, β a) :=
-⟨⟨Σ a' : shrink α, shrink (β ((equiv_shrink α).symm a')),
-  ⟨equiv.sigma_congr (equiv_shrink α) (λ a, by simpa using equiv_shrink (β a))⟩⟩⟩
-
-instance small_prod {α β} [small.{w} α] [small.{w} β] : small.{w} (α × β) :=
-⟨⟨shrink α × shrink β,
-  ⟨equiv.prod_congr (equiv_shrink α) (equiv_shrink β)⟩⟩⟩
-
-instance small_sum {α β} [small.{w} α] [small.{w} β] : small.{w} (α ⊕ β) :=
-⟨⟨shrink α ⊕ shrink β,
-  ⟨equiv.sum_congr (equiv_shrink α) (equiv_shrink β)⟩⟩⟩
-
-instance small_set {α} [small.{w} α] : small.{w} (set α) :=
-⟨⟨set (shrink α), ⟨equiv.set.congr (equiv_shrink α)⟩⟩⟩
-
-instance small_range {α : Type v} {β : Type w} (f : α → β) [small.{u} α] :
-  small.{u} (set.range f) :=
-small_of_surjective set.surjective_onto_range
-
-instance small_image {α : Type v} {β : Type w} (f : α → β) (S : set α) [small.{u} S] :
-  small.{u} (f '' S) :=
-small_of_surjective set.surjective_onto_image
-
-theorem not_small_type : ¬ small.{u} (Type (max u v))
-| ⟨⟨S, ⟨e⟩⟩⟩ := @function.cantor_injective (Σ α, e.symm α)
-  (λ a, ⟨_, cast (e.3 _).symm a⟩)
-  (λ a b e, (cast_inj _).1 $ eq_of_heq (sigma.mk.inj e).2)
-
-instance small_vector {α : Type v} {n : ℕ} [small.{u} α] :
-  small.{u} (vector α n) :=
-small_of_injective (equiv.vector_equiv_fin α n).injective
-
-instance small_list {α : Type v} [small.{u} α] :
-  small.{u} (list α) :=
-begin
-  let e : (Σ n, vector α n) ≃ list α := equiv.sigma_fiber_equiv list.length,
-  exact small_of_surjective e.surjective,
-end
-
-end
diff --git a/src/logic/small/basic.lean b/src/logic/small/basic.lean
new file mode 100644
index 0000000000000..605e4c9b07f6f
--- /dev/null
+++ b/src/logic/small/basic.lean
@@ -0,0 +1,139 @@
+/-
+Copyright (c) 2021 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Scott Morrison
+-/
+import logic.equiv.set
+
+/-!
+# Small types
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A type is `w`-small if there exists an equivalence to some `S : Type w`.
+
+We provide a noncomputable model `shrink α : Type w`, and `equiv_shrink α : α ≃ shrink α`.
+
+A subsingleton type is `w`-small for any `w`.
+
+If `α ≃ β`, then `small.{w} α ↔ small.{w} β`.
+-/
+
+universes u w v
+
+/--
+A type is `small.{w}` if there exists an equivalence to some `S : Type w`.
+-/
+class small (α : Type v) : Prop :=
+(equiv_small : ∃ (S : Type w), nonempty (α ≃ S))
+
+/--
+Constructor for `small α` from an explicit witness type and equivalence.
+-/
+lemma small.mk' {α : Type v} {S : Type w} (e : α ≃ S) : small.{w} α :=
+⟨⟨S, ⟨e⟩⟩⟩
+
+/--
+An arbitrarily chosen model in `Type w` for a `w`-small type.
+-/
+@[nolint has_nonempty_instance]
+def shrink (α : Type v) [small.{w} α] : Type w :=
+classical.some (@small.equiv_small α _)
+
+/--
+The noncomputable equivalence between a `w`-small type and a model.
+-/
+noncomputable
+def equiv_shrink (α : Type v) [small.{w} α] : α ≃ shrink α :=
+nonempty.some (classical.some_spec (@small.equiv_small α _))
+
+@[priority 100]
+instance small_self (α : Type v) : small.{v} α :=
+small.mk' $ equiv.refl α
+
+theorem small_map {α : Type*} {β : Type*} [hβ : small.{w} β] (e : α ≃ β) : small.{w} α :=
+let ⟨γ, ⟨f⟩⟩ := hβ.equiv_small in small.mk' (e.trans f)
+
+theorem small_lift (α : Type u) [hα : small.{v} α] : small.{max v w} α :=
+let ⟨⟨γ, ⟨f⟩⟩⟩ := hα in small.mk' $ f.trans equiv.ulift.symm
+
+@[priority 100]
+instance small_max (α : Type v) : small.{max w v} α :=
+small_lift.{v w} α
+
+instance small_ulift (α : Type u) [small.{v} α] : small.{v} (ulift.{w} α) :=
+small_map equiv.ulift
+
+theorem small_type : small.{max (u+1) v} (Type u) := small_max.{max (u+1) v} _
+
+section
+open_locale classical
+
+theorem small_congr {α : Type*} {β : Type*} (e : α ≃ β) : small.{w} α ↔ small.{w} β :=
+⟨λ h, @small_map _ _ h e.symm, λ h, @small_map _ _ h e⟩
+
+instance small_subtype (α : Type v) [small.{w} α] (P : α → Prop) : small.{w} { x // P x } :=
+small_map (equiv_shrink α).subtype_equiv_of_subtype'
+
+theorem small_of_injective {α : Type v} {β : Type w} [small.{u} β] {f : α → β}
+  (hf : function.injective f) : small.{u} α :=
+small_map (equiv.of_injective f hf)
+
+theorem small_of_surjective {α : Type v} {β : Type w} [small.{u} α] {f : α → β}
+  (hf : function.surjective f) : small.{u} β :=
+small_of_injective (function.injective_surj_inv hf)
+
+theorem small_subset {α : Type v} {s t : set α} (hts : t ⊆ s) [small.{u} s] : small.{u} t :=
+let f : t → s := λ x, ⟨x, hts x.prop⟩ in
+  @small_of_injective _ _ _ f (λ x y hxy, subtype.ext (subtype.mk.inj hxy))
+
+@[priority 100]
+instance small_subsingleton (α : Type v) [subsingleton α] : small.{w} α :=
+begin
+  rcases is_empty_or_nonempty α; resetI,
+  { apply small_map (equiv.equiv_pempty α) },
+  { apply small_map equiv.punit_of_nonempty_of_subsingleton, assumption' },
+end
+
+/-!
+We don't define `small_of_fintype` or `small_of_countable` in this file,
+to keep imports to `logic` to a minimum.
+-/
+
+instance small_Pi {α} (β : α → Type*) [small.{w} α] [∀ a, small.{w} (β a)] :
+  small.{w} (Π a, β a) :=
+⟨⟨Π a' : shrink α, shrink (β ((equiv_shrink α).symm a')),
+  ⟨equiv.Pi_congr (equiv_shrink α) (λ a, by simpa using equiv_shrink (β a))⟩⟩⟩
+
+instance small_sigma {α} (β : α → Type*) [small.{w} α] [∀ a, small.{w} (β a)] :
+  small.{w} (Σ a, β a) :=
+⟨⟨Σ a' : shrink α, shrink (β ((equiv_shrink α).symm a')),
+  ⟨equiv.sigma_congr (equiv_shrink α) (λ a, by simpa using equiv_shrink (β a))⟩⟩⟩
+
+instance small_prod {α β} [small.{w} α] [small.{w} β] : small.{w} (α × β) :=
+⟨⟨shrink α × shrink β,
+  ⟨equiv.prod_congr (equiv_shrink α) (equiv_shrink β)⟩⟩⟩
+
+instance small_sum {α β} [small.{w} α] [small.{w} β] : small.{w} (α ⊕ β) :=
+⟨⟨shrink α ⊕ shrink β,
+  ⟨equiv.sum_congr (equiv_shrink α) (equiv_shrink β)⟩⟩⟩
+
+instance small_set {α} [small.{w} α] : small.{w} (set α) :=
+⟨⟨set (shrink α), ⟨equiv.set.congr (equiv_shrink α)⟩⟩⟩
+
+instance small_range {α : Type v} {β : Type w} (f : α → β) [small.{u} α] :
+  small.{u} (set.range f) :=
+small_of_surjective set.surjective_onto_range
+
+instance small_image {α : Type v} {β : Type w} (f : α → β) (S : set α) [small.{u} S] :
+  small.{u} (f '' S) :=
+small_of_surjective set.surjective_onto_image
+
+theorem not_small_type : ¬ small.{u} (Type (max u v))
+| ⟨⟨S, ⟨e⟩⟩⟩ := @function.cantor_injective (Σ α, e.symm α)
+  (λ a, ⟨_, cast (e.3 _).symm a⟩)
+  (λ a b e, (cast_inj _).1 $ eq_of_heq (sigma.mk.inj e).2)
+
+
+end
diff --git a/src/logic/small/list.lean b/src/logic/small/list.lean
new file mode 100644
index 0000000000000..22c0c647cb521
--- /dev/null
+++ b/src/logic/small/list.lean
@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2021 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Scott Morrison
+-/
+import logic.small.basic
+import data.vector.basic
+
+/-!
+# Instances for `small (list α)` and `small (vector α)`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+These must not be in `logic.small.basic` as this is very low in the import hierarchy,
+and is used by category theory files which do not need everything imported by `data.vector.basic`.
+-/
+
+universes u v
+
+instance small_vector {α : Type v} {n : ℕ} [small.{u} α] :
+  small.{u} (vector α n) :=
+small_of_injective (equiv.vector_equiv_fin α n).injective
+
+instance small_list {α : Type v} [small.{u} α] :
+  small.{u} (list α) :=
+begin
+  let e : (Σ n, vector α n) ≃ list α := equiv.sigma_fiber_equiv list.length,
+  exact small_of_surjective e.surjective,
+end
diff --git a/src/logic/unique.lean b/src/logic/unique.lean
index bafbd62abe354..5384a49f64e38 100644
--- a/src/logic/unique.lean
+++ b/src/logic/unique.lean
@@ -9,6 +9,9 @@ import logic.is_empty
 /-!
 # Types with a unique term
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define a typeclass `unique`,
 which expresses that a type has a unique term.
 In other words, a type that is `inhabited` and a `subsingleton`.
@@ -132,38 +135,55 @@ a loop in the class inheritance graph. -/
 
 end unique
 
-@[simp] lemma pi.default_def {β : Π a : α, Sort v} [Π a, inhabited (β a)] :
+lemma unique_iff_subsingleton_and_nonempty (α : Sort u) :
+  nonempty (unique α) ↔ subsingleton α ∧ nonempty α :=
+⟨λ ⟨u⟩, by split; exactI infer_instance,
+ λ ⟨hs, hn⟩, ⟨by { resetI, inhabit α, exact unique.mk' α }⟩⟩
+
+@[simp] lemma pi.default_def {β : α → Sort v} [Π a, inhabited (β a)] :
   @default (Π a, β a) _ = λ a : α, @default (β a) _ := rfl
 
-lemma pi.default_apply {β : Π a : α, Sort v} [Π a, inhabited (β a)] (a : α) :
+lemma pi.default_apply {β : α → Sort v} [Π a, inhabited (β a)] (a : α) :
   @default (Π a, β a) _ a = default := rfl
 
-instance pi.unique {β : Π a : α, Sort v} [Π a, unique (β a)] : unique (Π a, β a) :=
+instance pi.unique {β : α → Sort v} [Π a, unique (β a)] : unique (Π a, β a) :=
 { uniq := λ f, funext $ λ x, unique.eq_default _,
   .. pi.inhabited α }
 
 /-- There is a unique function on an empty domain. -/
-instance pi.unique_of_is_empty [is_empty α] (β : Π a : α, Sort v) :
+instance pi.unique_of_is_empty [is_empty α] (β : α → Sort v) :
   unique (Π a, β a) :=
 { default := is_empty_elim,
   uniq := λ f, funext is_empty_elim }
 
+lemma eq_const_of_unique [unique α] (f : α → β) : f = function.const α (f default) :=
+by { ext x, rw subsingleton.elim x default }
+
+lemma heq_const_of_unique [unique α] {β : α → Sort v}
+  (f : Π a, β a) : f == function.const α (f default) :=
+function.hfunext rfl $ λ i _ _, by rw subsingleton.elim i default
+
 namespace function
 
 variable {f : α → β}
 
-/-- If the domain of a surjective function is a singleton,
-then the codomain is a singleton as well. -/
-protected def surjective.unique (hf : surjective f) [unique α] : unique β :=
-{ default := f default,
-  uniq := λ b, let ⟨a, ha⟩ := hf b in ha ▸ congr_arg f (unique.eq_default _) }
-
 /-- If the codomain of an injective function is a subsingleton, then the domain
 is a subsingleton as well. -/
 protected lemma injective.subsingleton (hf : injective f) [subsingleton β] :
   subsingleton α :=
 ⟨λ x y, hf $ subsingleton.elim _ _⟩
 
+/-- If the domain of a surjective function is a subsingleton, then the codomain is a subsingleton as
+well. -/
+protected lemma surjective.subsingleton [subsingleton α] (hf : surjective f) :
+  subsingleton β :=
+⟨hf.forall₂.2 $ λ x y, congr_arg f $ subsingleton.elim x y⟩
+
+/-- If the domain of a surjective function is a singleton,
+then the codomain is a singleton as well. -/
+protected def surjective.unique (hf : surjective f) [unique α] : unique β :=
+@unique.mk' _ ⟨f default⟩ hf.subsingleton
+
 /-- If `α` is inhabited and admits an injective map to a subsingleton type, then `α` is `unique`. -/
 protected def injective.unique [inhabited α] [subsingleton β] (hf : injective f) : unique α :=
 @unique.mk' _ _ hf.subsingleton
@@ -178,7 +198,7 @@ end function
 lemma unique.bijective {A B} [unique A] [unique B] {f : A → B} : function.bijective f :=
 begin
   rw function.bijective_iff_has_inverse,
-  refine ⟨λ x, default, _, _⟩; intro x; simp
+  refine ⟨default, _, _⟩; intro x; simp
 end
 
 namespace option
diff --git a/src/measure_theory/card_measurable_space.lean b/src/measure_theory/card_measurable_space.lean
index 2c83c4b6d4f3d..d7dfb8c03f691 100644
--- a/src/measure_theory/card_measurable_space.lean
+++ b/src/measure_theory/card_measurable_space.lean
@@ -10,8 +10,11 @@ import set_theory.cardinal.continuum
 /-!
 # Cardinal of sigma-algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If a sigma-algebra is generated by a set of sets `s`, then the cardinality of the sigma-algebra is
-bounded by `(max (#s) 2) ^ ω`. This is stated in `measurable_space.cardinal_generate_measurable_le`
+bounded by `(max (#s) 2) ^ ℵ₀`. This is stated in `measurable_space.cardinal_generate_measurable_le`
 and `measurable_space.cardinal_measurable_set_le`.
 
 In particular, if `#s ≤ 𝔠`, then the generated sigma-algebra has cardinality at most `𝔠`, see
@@ -41,7 +44,7 @@ this will be enough to generate all sets in the sigma-algebra.
 
 This construction is very similar to that of the Borel hierarchy. -/
 def generate_measurable_rec (s : set (set α)) : ω₁ → set (set α)
-| i := let S := ⋃ j : {j // j < i}, generate_measurable_rec j.1 in
+| i := let S := ⋃ j : Iio i, generate_measurable_rec j.1 in
     s ∪ {∅} ∪ compl '' S ∪ set.range (λ (f : ℕ → S), ⋃ n, (f n).1)
 using_well_founded {dec_tac := `[exact j.2]}
 
@@ -84,32 +87,32 @@ theorem generate_measurable_rec_subset (s : set (set α)) {i j : ω₁} (h : i 
     exact (Union_const x).symm }
 end
 
-/-- At each step of the inductive construction, the cardinality bound `≤ (max (#s) 2) ^ ω` holds. -/
+/-- At each step of the inductive construction, the cardinality bound `≤ (max (#s) 2) ^ ℵ₀` holds.
+-/
 lemma cardinal_generate_measurable_rec_le (s : set (set α)) (i : ω₁) :
-  #(generate_measurable_rec s i) ≤ (max (#s) 2) ^ omega.{u} :=
+  #(generate_measurable_rec s i) ≤ (max (#s) 2) ^ aleph_0.{u} :=
 begin
   apply (aleph 1).ord.out.wo.wf.induction i,
   assume i IH,
-  have A := omega_le_aleph 1,
-  have B : aleph 1 ≤ (max (#s) 2) ^ omega.{u} :=
+  have A := aleph_0_le_aleph 1,
+  have B : aleph 1 ≤ (max (#s) 2) ^ aleph_0.{u} :=
     aleph_one_le_continuum.trans (power_le_power_right (le_max_right _ _)),
-  have C : ω ≤ (max (#s) 2) ^ omega.{u} := A.trans B,
-  have J : #(⋃ (j : {j // j < i}), generate_measurable_rec s j.1) ≤ (max (#s) 2) ^ omega.{u},
+  have C : ℵ₀ ≤ (max (#s) 2) ^ aleph_0.{u} := A.trans B,
+  have J : #(⋃ j : Iio i, generate_measurable_rec s j.1) ≤ (max (#s) 2) ^ aleph_0.{u},
   { apply (mk_Union_le _).trans,
-    have D : cardinal.sup.{u u} (λ (j : {j // j < i}), #(generate_measurable_rec s j.1)) ≤ _ :=
-      cardinal.sup_le (λ ⟨j, hj⟩, IH j hj),
+    have D : (⨆ j : Iio i, #(generate_measurable_rec s j)) ≤ _ := csupr_le' (λ ⟨j, hj⟩, IH j hj),
     apply (mul_le_mul' ((mk_subtype_le _).trans (aleph 1).mk_ord_out.le) D).trans,
     rw mul_eq_max A C,
     exact max_le B le_rfl },
   rw [generate_measurable_rec],
   apply_rules [(mk_union_le _ _).trans, add_le_of_le C, mk_image_le.trans],
-  { exact (le_max_left _ _).trans (self_le_power _ one_lt_omega.le) },
+  { exact (le_max_left _ _).trans (self_le_power _ one_lt_aleph_0.le) },
   { rw [mk_singleton],
-    exact one_lt_omega.le.trans C },
+    exact one_lt_aleph_0.le.trans C },
   { apply mk_range_le.trans,
-    simp only [mk_pi, subtype.val_eq_coe, prod_const, lift_uzero, mk_denumerable, lift_omega],
-    have := @power_le_power_right _ _ ω J,
-    rwa [← power_mul, omega_mul_omega] at this }
+    simp only [mk_pi, subtype.val_eq_coe, prod_const, lift_uzero, mk_denumerable, lift_aleph_0],
+    have := @power_le_power_right _ _ ℵ₀ J,
+    rwa [← power_mul, aleph_0_mul_aleph_0] at this }
 end
 
 /-- `generate_measurable_rec s` generates precisely the smallest sigma-algebra containing `s`. -/
@@ -130,8 +133,8 @@ begin
         Union_mem_generate_measurable_rec (λ n, ⟨I n, _, hI n⟩)⟩,
       { rw ordinal.type_lt,
         refine ordinal.lsub_lt_ord_lift _ (λ i, ordinal.typein_lt_self _),
-        rw [mk_denumerable, lift_omega, is_regular_aleph_one.2],
-        exact omega_lt_aleph_one },
+        rw [mk_denumerable, lift_aleph_0, is_regular_aleph_one.cof_eq],
+        exact aleph_0_lt_aleph_one },
       { rw [←ordinal.typein_lt_typein (<), ordinal.typein_enum],
         apply ordinal.lt_lsub (λ n : ℕ, _) } } },
   { rcases ht with ⟨t, ⟨i, rfl⟩, hx⟩,
@@ -149,24 +152,24 @@ begin
 end
 
 /-- If a sigma-algebra is generated by a set of sets `s`, then the sigma-algebra has cardinality at
-most `(max (#s) 2) ^ ω`. -/
+most `(max (#s) 2) ^ ℵ₀`. -/
 theorem cardinal_generate_measurable_le (s : set (set α)) :
-  #{t | generate_measurable s t} ≤ (max (#s) 2) ^ omega.{u} :=
+  #{t | generate_measurable s t} ≤ (max (#s) 2) ^ aleph_0.{u} :=
 begin
   rw generate_measurable_eq_rec,
   apply (mk_Union_le _).trans,
   rw (aleph 1).mk_ord_out,
   refine le_trans (mul_le_mul' aleph_one_le_continuum
-    (cardinal.sup_le (λ i, cardinal_generate_measurable_rec_le s i))) _,
+    (csupr_le' (λ i, cardinal_generate_measurable_rec_le s i))) _,
   have := power_le_power_right (le_max_right (#s) 2),
-  rw mul_eq_max omega_le_continuum (omega_le_continuum.trans this),
+  rw mul_eq_max aleph_0_le_continuum (aleph_0_le_continuum.trans this),
   exact max_le this le_rfl
 end
 
 /-- If a sigma-algebra is generated by a set of sets `s`, then the sigma
-algebra has cardinality at most `(max (#s) 2) ^ ω`. -/
+algebra has cardinality at most `(max (#s) 2) ^ ℵ₀`. -/
 theorem cardinal_measurable_set_le (s : set (set α)) :
-  #{t | @measurable_set α (generate_from s) t} ≤ (max (#s) 2) ^ omega.{u} :=
+  #{t | @measurable_set α (generate_from s) t} ≤ (max (#s) 2) ^ aleph_0.{u} :=
 cardinal_generate_measurable_le s
 
 /-- If a sigma-algebra is generated by a set of sets `s` with cardinality at most the continuum,
@@ -174,7 +177,7 @@ then the sigma algebra has the same cardinality bound. -/
 theorem cardinal_generate_measurable_le_continuum {s : set (set α)} (hs : #s ≤ 𝔠) :
   #{t | generate_measurable s t} ≤ 𝔠 :=
 (cardinal_generate_measurable_le s).trans begin
-  rw ←continuum_power_omega,
+  rw ←continuum_power_aleph_0,
   exact_mod_cast power_le_power_right (max_le hs (nat_lt_continuum 2).le)
 end
 
diff --git a/src/measure_theory/category/Meas.lean b/src/measure_theory/category/Meas.lean
index 07d607a524b27..bfbecf24eff65 100644
--- a/src/measure_theory/category/Meas.lean
+++ b/src/measure_theory/category/Meas.lean
@@ -11,6 +11,9 @@ import topology.category.Top.basic
 /-!
 # The category of measurable spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Measurable spaces and measurable functions form a (concrete) category `Meas`.
 
 ## Main definitions
diff --git a/src/measure_theory/constructions/borel_space.lean b/src/measure_theory/constructions/borel_space.lean
deleted file mode 100644
index fb54f747b226f..0000000000000
--- a/src/measure_theory/constructions/borel_space.lean
+++ /dev/null
@@ -1,2084 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Yury Kudryashov
--/
-import analysis.complex.basic
-import analysis.normed_space.finite_dimension
-import measure_theory.function.ae_measurable_sequence
-import measure_theory.group.arithmetic
-import measure_theory.lattice
-import measure_theory.measure.open_pos
-import topology.algebra.order.liminf_limsup
-import topology.continuous_function.basic
-import topology.instances.ereal
-import topology.G_delta
-import topology.order.lattice
-import topology.semicontinuous
-import topology.metric_space.metrizable
-
-/-!
-# Borel (measurable) space
-
-## Main definitions
-
-* `borel α` : the least `σ`-algebra that contains all open sets;
-* `class borel_space` : a space with `topological_space` and `measurable_space` structures
-  such that `‹measurable_space α› = borel α`;
-* `class opens_measurable_space` : a space with `topological_space` and `measurable_space`
-  structures such that all open sets are measurable; equivalently, `borel α ≤ ‹measurable_space α›`.
-* `borel_space` instances on `empty`, `unit`, `bool`, `nat`, `int`, `rat`;
-* `measurable` and `borel_space` instances on `ℝ`, `ℝ≥0`, `ℝ≥0∞`.
-
-## Main statements
-
-* `is_open.measurable_set`, `is_closed.measurable_set`: open and closed sets are measurable;
-* `continuous.measurable` : a continuous function is measurable;
-* `continuous.measurable2` : if `f : α → β` and `g : α → γ` are measurable and `op : β × γ → δ`
-  is continuous, then `λ x, op (f x, g y)` is measurable;
-* `measurable.add` etc : dot notation for arithmetic operations on `measurable` predicates,
-  and similarly for `dist` and `edist`;
-* `ae_measurable.add` : similar dot notation for almost everywhere measurable functions;
-* `measurable.ennreal*` : special cases for arithmetic operations on `ℝ≥0∞`.
--/
-
-noncomputable theory
-
-open classical set filter measure_theory
-open_locale classical big_operators topological_space nnreal ennreal measure_theory
-
-universes u v w x y
-variables {α β γ γ₂ δ : Type*} {ι : Sort y} {s t u : set α}
-
-open measurable_space topological_space
-
-/-- `measurable_space` structure generated by `topological_space`. -/
-def borel (α : Type u) [topological_space α] : measurable_space α :=
-generate_from {s : set α | is_open s}
-
-lemma borel_eq_top_of_discrete [topological_space α] [discrete_topology α] :
-  borel α = ⊤ :=
-top_le_iff.1 $ λ s hs, generate_measurable.basic s (is_open_discrete s)
-
-lemma borel_eq_top_of_encodable [topological_space α] [t1_space α] [encodable α] :
-  borel α = ⊤ :=
-begin
-  refine (top_le_iff.1 $ λ s hs, bUnion_of_singleton s ▸ _),
-  apply measurable_set.bUnion s.countable_encodable,
-  intros x hx,
-  apply measurable_set.of_compl,
-  apply generate_measurable.basic,
-  exact is_closed_singleton.is_open_compl
-end
-
-lemma borel_eq_generate_from_of_subbasis {s : set (set α)}
-  [t : topological_space α] [second_countable_topology α] (hs : t = generate_from s) :
-  borel α = generate_from s :=
-le_antisymm
-  (generate_from_le $ assume u (hu : t.is_open u),
-    begin
-      rw [hs] at hu,
-      induction hu,
-      case generate_open.basic : u hu
-      { exact generate_measurable.basic u hu },
-      case generate_open.univ
-      { exact @measurable_set.univ α (generate_from s) },
-      case generate_open.inter : s₁ s₂ _ _ hs₁ hs₂
-      { exact @measurable_set.inter α (generate_from s) _ _ hs₁ hs₂ },
-      case generate_open.sUnion : f hf ih
-      { rcases is_open_sUnion_countable f (by rwa hs) with ⟨v, hv, vf, vu⟩,
-        rw ← vu,
-        exact @measurable_set.sUnion α (generate_from s) _ hv
-          (λ x xv, ih _ (vf xv)) }
-    end)
-  (generate_from_le $ assume u hu, generate_measurable.basic _ $
-    show t.is_open u, by rw [hs]; exact generate_open.basic _ hu)
-
-lemma topological_space.is_topological_basis.borel_eq_generate_from [topological_space α]
-  [second_countable_topology α] {s : set (set α)} (hs : is_topological_basis s) :
-  borel α = generate_from s :=
-borel_eq_generate_from_of_subbasis hs.eq_generate_from
-
-lemma is_pi_system_is_open [topological_space α] : is_pi_system (is_open : set α → Prop) :=
-λ s hs t ht hst, is_open.inter hs ht
-
-lemma borel_eq_generate_from_is_closed [topological_space α] :
-  borel α = generate_from {s | is_closed s} :=
-le_antisymm
-  (generate_from_le $ λ t ht, @measurable_set.of_compl α _ (generate_from {s | is_closed s})
-    (generate_measurable.basic _ $ is_closed_compl_iff.2 ht))
-  (generate_from_le $ λ t ht, @measurable_set.of_compl α _ (borel α)
-    (generate_measurable.basic _ $ is_open_compl_iff.2 ht))
-
-section order_topology
-
-variable (α)
-variables [topological_space α] [second_countable_topology α] [linear_order α] [order_topology α]
-
-lemma borel_eq_generate_from_Iio : borel α = generate_from (range Iio) :=
-begin
-  refine le_antisymm _ (generate_from_le _),
-  { rw borel_eq_generate_from_of_subbasis (@order_topology.topology_eq_generate_intervals α _ _ _),
-    letI : measurable_space α := measurable_space.generate_from (range Iio),
-    have H : ∀ a : α, measurable_set (Iio a) := λ a, generate_measurable.basic _ ⟨_, rfl⟩,
-    refine generate_from_le _, rintro _ ⟨a, rfl | rfl⟩; [skip, apply H],
-    by_cases h : ∃ a', ∀ b, a < b ↔ a' ≤ b,
-    { rcases h with ⟨a', ha'⟩,
-      rw (_ : Ioi a = (Iio a')ᶜ), { exact (H _).compl },
-      simp [set.ext_iff, ha'] },
-    { rcases is_open_Union_countable
-        (λ a' : {a' : α // a < a'}, {b | a'.1 < b})
-        (λ a', is_open_lt' _) with ⟨v, ⟨hv⟩, vu⟩,
-      simp [set.ext_iff] at vu,
-      have : Ioi a = ⋃ x : v, (Iio x.1.1)ᶜ,
-      { simp [set.ext_iff],
-        refine λ x, ⟨λ ax, _, λ ⟨a', ⟨h, av⟩, ax⟩, lt_of_lt_of_le h ax⟩,
-        rcases (vu x).2 _ with ⟨a', h₁, h₂⟩,
-        { exact ⟨a', h₁, le_of_lt h₂⟩ },
-        refine not_imp_comm.1 (λ h, _) h,
-        exact ⟨x, λ b, ⟨λ ab, le_of_not_lt (λ h', h ⟨b, ab, h'⟩),
-          lt_of_lt_of_le ax⟩⟩ },
-      rw this, resetI,
-      apply measurable_set.Union,
-      exact λ _, (H _).compl } },
-  { rw forall_range_iff,
-    intro a,
-    exact generate_measurable.basic _ is_open_Iio }
-end
-
-lemma borel_eq_generate_from_Ioi : borel α = generate_from (range Ioi) :=
-@borel_eq_generate_from_Iio αᵒᵈ _ (by apply_instance : second_countable_topology α) _ _
-
-end order_topology
-
-lemma borel_comap {f : α → β} {t : topological_space β} :
-  @borel α (t.induced f) = (@borel β t).comap f :=
-comap_generate_from.symm
-
-lemma continuous.borel_measurable [topological_space α] [topological_space β]
-  {f : α → β} (hf : continuous f) :
-  @measurable α β (borel α) (borel β) f :=
-measurable.of_le_map $ generate_from_le $
-  λ s hs, generate_measurable.basic (f ⁻¹' s) (hs.preimage hf)
-
-/-- A space with `measurable_space` and `topological_space` structures such that
-all open sets are measurable. -/
-class opens_measurable_space (α : Type*) [topological_space α] [h : measurable_space α] : Prop :=
-(borel_le : borel α ≤ h)
-
-/-- A space with `measurable_space` and `topological_space` structures such that
-the `σ`-algebra of measurable sets is exactly the `σ`-algebra generated by open sets. -/
-class borel_space (α : Type*) [topological_space α] [measurable_space α] : Prop :=
-(measurable_eq : ‹measurable_space α› = borel α)
-
-namespace tactic
-
-/-- Add instances `borel α : measurable_space α` and `⟨rfl⟩ : borel_space α`. -/
-meta def add_borel_instance (α : expr) : tactic unit :=
-do
-  n1 ← get_unused_name "_inst",
-  to_expr ``(borel %%α) >>= pose n1,
-  reset_instance_cache,
-  n2 ← get_unused_name "_inst",
-  v ← to_expr ``(borel_space.mk rfl : borel_space %%α),
-  note n2 none v,
-  reset_instance_cache
-
-/-- Given a type `α`, an assumption `i : measurable_space α`, and an instance `[borel_space α]`,
-replace `i` with `borel α`. -/
-meta def borel_to_refl (α i : expr) : tactic unit :=
-do
-  n ← get_unused_name "h",
-  to_expr ``(%%i = borel %%α) >>= assert n,
-  applyc `borel_space.measurable_eq,
-  unfreezing (tactic.subst i),
-  n1 ← get_unused_name "_inst",
-  to_expr ``(borel %%α) >>= pose n1,
-  reset_instance_cache
-
-/-- Given a type `α`, if there is an assumption `[i : measurable_space α]`, then try to prove
-`[borel_space α]` and replace `i` with `borel α`. Otherwise, add instances
-`borel α : measurable_space α` and `⟨rfl⟩ : borel_space α`. -/
-meta def borelize (α : expr) : tactic unit :=
-do
-  i ← optional (to_expr ``(measurable_space %%α) >>= find_assumption),
-  i.elim (add_borel_instance α) (borel_to_refl α)
-
-namespace interactive
-
-setup_tactic_parser
-
-/-- The behaviour of `borelize α` depends on the existing assumptions on `α`.
-
-- if `α` is a topological space with instances `[measurable_space α] [borel_space α]`, then
-  `borelize α` replaces the former instance by `borel α`;
-- otherwise, `borelize α` adds instances `borel α : measurable_space α` and `⟨rfl⟩ : borel_space α`.
-
-Finally, `borelize [α, β, γ]` runs `borelize α, borelize β, borelize γ`.
--/
-meta def borelize (ts : parse pexpr_list_or_texpr) : tactic unit :=
-mmap' (λ t, to_expr t >>= tactic.borelize) ts
-
-add_tactic_doc
-{ name := "borelize",
-  category := doc_category.tactic,
-  decl_names := [`tactic.interactive.borelize],
-  tags := ["type class"] }
-
-end interactive
-
-end tactic
-
-@[priority 100]
-instance order_dual.opens_measurable_space {α : Type*} [topological_space α] [measurable_space α]
-  [h : opens_measurable_space α] :
-  opens_measurable_space αᵒᵈ :=
-{ borel_le := h.borel_le }
-
-@[priority 100]
-instance order_dual.borel_space {α : Type*} [topological_space α] [measurable_space α]
-  [h : borel_space α] :
-  borel_space αᵒᵈ :=
-{ measurable_eq := h.measurable_eq }
-
-/-- In a `borel_space` all open sets are measurable. -/
-@[priority 100]
-instance borel_space.opens_measurable {α : Type*} [topological_space α] [measurable_space α]
-  [borel_space α] : opens_measurable_space α :=
-⟨ge_of_eq $ borel_space.measurable_eq⟩
-
-instance subtype.borel_space {α : Type*} [topological_space α] [measurable_space α]
-  [hα : borel_space α] (s : set α) :
-  borel_space s :=
-⟨by { rw [hα.1, subtype.measurable_space, ← borel_comap], refl }⟩
-
-instance subtype.opens_measurable_space {α : Type*} [topological_space α] [measurable_space α]
-  [h : opens_measurable_space α] (s : set α) :
-  opens_measurable_space s :=
-⟨by { rw [borel_comap], exact comap_mono h.1 }⟩
-
-theorem _root_.measurable_set.induction_on_open [topological_space α] [measurable_space α]
-  [borel_space α] {C : set α → Prop} (h_open : ∀ U, is_open U → C U)
-  (h_compl : ∀ t, measurable_set t → C t → C tᶜ)
-  (h_union : ∀ f : ℕ → set α, pairwise (disjoint on f) →
-    (∀ i, measurable_set (f i)) → (∀ i, C (f i)) → C (⋃ i, f i)) :
-  ∀ ⦃t⦄, measurable_set t → C t :=
-measurable_space.induction_on_inter borel_space.measurable_eq is_pi_system_is_open
-  (h_open _ is_open_empty) h_open h_compl h_union
-
-section
-variables [topological_space α] [measurable_space α] [opens_measurable_space α]
-   [topological_space β] [measurable_space β] [opens_measurable_space β]
-   [topological_space γ] [measurable_space γ] [borel_space γ]
-   [topological_space γ₂] [measurable_space γ₂] [borel_space γ₂]
-   [measurable_space δ]
-
-lemma is_open.measurable_set (h : is_open s) : measurable_set s :=
-opens_measurable_space.borel_le _ $ generate_measurable.basic _ h
-
-@[measurability]
-lemma measurable_set_interior : measurable_set (interior s) := is_open_interior.measurable_set
-
-lemma is_Gδ.measurable_set (h : is_Gδ s) : measurable_set s :=
-begin
-  rcases h with ⟨S, hSo, hSc, rfl⟩,
-  exact measurable_set.sInter hSc (λ t ht, (hSo t ht).measurable_set)
-end
-
-lemma measurable_set_of_continuous_at {β} [emetric_space β] (f : α → β) :
-  measurable_set {x | continuous_at f x} :=
-(is_Gδ_set_of_continuous_at f).measurable_set
-
-lemma is_closed.measurable_set (h : is_closed s) : measurable_set s :=
-h.is_open_compl.measurable_set.of_compl
-
-lemma is_compact.measurable_set [t2_space α] (h : is_compact s) : measurable_set s :=
-h.is_closed.measurable_set
-
-@[measurability]
-lemma measurable_set_closure : measurable_set (closure s) :=
-is_closed_closure.measurable_set
-
-lemma measurable_of_is_open {f : δ → γ} (hf : ∀ s, is_open s → measurable_set (f ⁻¹' s)) :
-  measurable f :=
-by { rw [‹borel_space γ›.measurable_eq], exact measurable_generate_from hf }
-
-lemma measurable_of_is_closed {f : δ → γ} (hf : ∀ s, is_closed s → measurable_set (f ⁻¹' s)) :
-  measurable f :=
-begin
-  apply measurable_of_is_open, intros s hs,
-  rw [← measurable_set.compl_iff, ← preimage_compl], apply hf, rw [is_closed_compl_iff], exact hs
-end
-
-lemma measurable_of_is_closed' {f : δ → γ}
-  (hf : ∀ s, is_closed s → s.nonempty → s ≠ univ → measurable_set (f ⁻¹' s)) : measurable f :=
-begin
-  apply measurable_of_is_closed, intros s hs,
-  cases eq_empty_or_nonempty s with h1 h1, { simp [h1] },
-  by_cases h2 : s = univ, { simp [h2] },
-  exact hf s hs h1 h2
-end
-
-instance nhds_is_measurably_generated (a : α) : (𝓝 a).is_measurably_generated :=
-begin
-  rw [nhds, infi_subtype'],
-  refine @filter.infi_is_measurably_generated _ _ _ _ (λ i, _),
-  exact i.2.2.measurable_set.principal_is_measurably_generated
-end
-
-/-- If `s` is a measurable set, then `𝓝[s] a` is a measurably generated filter for
-each `a`. This cannot be an `instance` because it depends on a non-instance `hs : measurable_set s`.
--/
-lemma measurable_set.nhds_within_is_measurably_generated {s : set α} (hs : measurable_set s)
-  (a : α) :
-  (𝓝[s] a).is_measurably_generated :=
-by haveI := hs.principal_is_measurably_generated; exact filter.inf_is_measurably_generated _ _
-
-@[priority 100] -- see Note [lower instance priority]
-instance opens_measurable_space.to_measurable_singleton_class [t1_space α] :
-  measurable_singleton_class α :=
-⟨λ x, is_closed_singleton.measurable_set⟩
-
-instance pi.opens_measurable_space_encodable {ι : Type*} {π : ι → Type*} [encodable ι]
-  [t' : Π i, topological_space (π i)]
-  [Π i, measurable_space (π i)] [∀ i, second_countable_topology (π i)]
-  [∀ i, opens_measurable_space (π i)] :
-  opens_measurable_space (Π i, π i) :=
-begin
-  constructor,
-  have : Pi.topological_space =
-    generate_from {t | ∃(s:Πa, set (π a)) (i : finset ι), (∀a∈i, s a ∈ countable_basis (π a)) ∧
-      t = pi ↑i s},
-  { rw [funext (λ a, @eq_generate_from_countable_basis (π a) _ _), pi_generate_from_eq] },
-  rw [borel_eq_generate_from_of_subbasis this],
-  apply generate_from_le,
-  rintros _ ⟨s, i, hi, rfl⟩,
-  refine measurable_set.pi i.countable_to_set (λ a ha, is_open.measurable_set _),
-  rw [eq_generate_from_countable_basis (π a)],
-  exact generate_open.basic _ (hi a ha)
-end
-
-instance pi.opens_measurable_space_fintype {ι : Type*} {π : ι → Type*} [fintype ι]
-  [t' : Π i, topological_space (π i)]
-  [Π i, measurable_space (π i)] [∀ i, second_countable_topology (π i)]
-  [∀ i, opens_measurable_space (π i)] :
-  opens_measurable_space (Π i, π i) :=
-by { letI := fintype.to_encodable ι, apply_instance }
-
-instance prod.opens_measurable_space [second_countable_topology α] [second_countable_topology β] :
-  opens_measurable_space (α × β) :=
-begin
-  constructor,
-  rw [((is_basis_countable_basis α).prod (is_basis_countable_basis β)).borel_eq_generate_from],
-  apply generate_from_le,
-  rintros _ ⟨u, v, hu, hv, rfl⟩,
-  exact (is_open_of_mem_countable_basis hu).measurable_set.prod
-    (is_open_of_mem_countable_basis hv).measurable_set
-end
-
-variables {α' : Type*} [topological_space α'] [measurable_space α']
-
-lemma interior_ae_eq_of_null_frontier {μ : measure α'} {s : set α'}
-  (h : μ (frontier s) = 0) : interior s =ᵐ[μ] s :=
-interior_subset.eventually_le.antisymm $
-  subset_closure.eventually_le.trans (ae_le_set.2 h)
-
-lemma measure_interior_of_null_frontier {μ : measure α'} {s : set α'}
-  (h : μ (frontier s) = 0) : μ (interior s) = μ s :=
-measure_congr (interior_ae_eq_of_null_frontier h)
-
-lemma null_measurable_set_of_null_frontier {s : set α} {μ : measure α}
-  (h : μ (frontier s) = 0) : null_measurable_set s μ :=
-⟨interior s, is_open_interior.measurable_set, (interior_ae_eq_of_null_frontier h).symm⟩
-
-lemma closure_ae_eq_of_null_frontier {μ : measure α'} {s : set α'}
-  (h : μ (frontier s) = 0) : closure s =ᵐ[μ] s :=
-((ae_le_set.2 h).trans interior_subset.eventually_le).antisymm $ subset_closure.eventually_le
-
-lemma measure_closure_of_null_frontier {μ : measure α'} {s : set α'}
-  (h : μ (frontier s) = 0) : μ (closure s) = μ s :=
-measure_congr (closure_ae_eq_of_null_frontier h)
-
-section preorder
-variables [preorder α] [order_closed_topology α] {a b x : α}
-
-@[simp, measurability]
-lemma measurable_set_Ici : measurable_set (Ici a) := is_closed_Ici.measurable_set
-@[simp, measurability]
-lemma measurable_set_Iic : measurable_set (Iic a) := is_closed_Iic.measurable_set
-@[simp, measurability]
-lemma measurable_set_Icc : measurable_set (Icc a b) := is_closed_Icc.measurable_set
-
-instance nhds_within_Ici_is_measurably_generated :
-  (𝓝[Ici b] a).is_measurably_generated :=
-measurable_set_Ici.nhds_within_is_measurably_generated _
-
-instance nhds_within_Iic_is_measurably_generated :
-  (𝓝[Iic b] a).is_measurably_generated :=
-measurable_set_Iic.nhds_within_is_measurably_generated _
-
-instance nhds_within_Icc_is_measurably_generated :
-  is_measurably_generated (𝓝[Icc a b] x) :=
-by { rw [← Ici_inter_Iic, nhds_within_inter], apply_instance }
-
-instance at_top_is_measurably_generated : (filter.at_top : filter α).is_measurably_generated :=
-@filter.infi_is_measurably_generated _ _ _ _ $
-  λ a, (measurable_set_Ici : measurable_set (Ici a)).principal_is_measurably_generated
-
-instance at_bot_is_measurably_generated : (filter.at_bot : filter α).is_measurably_generated :=
-@filter.infi_is_measurably_generated _ _ _ _ $
-  λ a, (measurable_set_Iic : measurable_set (Iic a)).principal_is_measurably_generated
-
-end preorder
-
-section partial_order
-variables [partial_order α] [order_closed_topology α] [second_countable_topology α]
-  {a b : α}
-
-@[measurability]
-lemma measurable_set_le' : measurable_set {p : α × α | p.1 ≤ p.2} :=
-order_closed_topology.is_closed_le'.measurable_set
-
-@[measurability]
-lemma measurable_set_le {f g : δ → α} (hf : measurable f) (hg : measurable g) :
-  measurable_set {a | f a ≤ g a} :=
-hf.prod_mk hg measurable_set_le'
-
-end partial_order
-
-section linear_order
-variables [linear_order α] [order_closed_topology α] {a b x : α}
-
--- we open this locale only here to avoid issues with list being treated as intervals above
-open_locale interval
-
-@[simp, measurability]
-lemma measurable_set_Iio : measurable_set (Iio a) := is_open_Iio.measurable_set
-@[simp, measurability]
-lemma measurable_set_Ioi : measurable_set (Ioi a) := is_open_Ioi.measurable_set
-@[simp, measurability]
-lemma measurable_set_Ioo : measurable_set (Ioo a b) := is_open_Ioo.measurable_set
-
-@[simp, measurability] lemma measurable_set_Ioc : measurable_set (Ioc a b) :=
-measurable_set_Ioi.inter measurable_set_Iic
-
-@[simp, measurability] lemma measurable_set_Ico : measurable_set (Ico a b) :=
-measurable_set_Ici.inter measurable_set_Iio
-
-instance nhds_within_Ioi_is_measurably_generated :
-  (𝓝[Ioi b] a).is_measurably_generated :=
-measurable_set_Ioi.nhds_within_is_measurably_generated _
-
-instance nhds_within_Iio_is_measurably_generated :
-  (𝓝[Iio b] a).is_measurably_generated :=
-measurable_set_Iio.nhds_within_is_measurably_generated _
-
-instance nhds_within_interval_is_measurably_generated :
-  is_measurably_generated (𝓝[[a, b]] x) :=
-nhds_within_Icc_is_measurably_generated
-
-@[measurability]
-lemma measurable_set_lt' [second_countable_topology α] : measurable_set {p : α × α | p.1 < p.2} :=
-(is_open_lt continuous_fst continuous_snd).measurable_set
-
-@[measurability]
-lemma measurable_set_lt [second_countable_topology α] {f g : δ → α} (hf : measurable f)
-  (hg : measurable g) : measurable_set {a | f a < g a} :=
-hf.prod_mk hg measurable_set_lt'
-
-lemma set.ord_connected.measurable_set (h : ord_connected s) : measurable_set s :=
-begin
-  let u := ⋃ (x ∈ s) (y ∈ s), Ioo x y,
-  have huopen : is_open u := is_open_bUnion (λ x hx, is_open_bUnion (λ y hy, is_open_Ioo)),
-  have humeas : measurable_set u := huopen.measurable_set,
-  have hfinite : (s \ u).finite,
-  { refine set.finite_of_forall_between_eq_endpoints (s \ u) (λ x hx y hy z hz hxy hyz, _),
-    by_contra' h,
-    exact hy.2 (mem_Union₂.mpr ⟨x, hx.1,
-      mem_Union₂.mpr ⟨z, hz.1, lt_of_le_of_ne hxy h.1, lt_of_le_of_ne hyz h.2⟩⟩) },
-  have : u ⊆ s :=
-    Union₂_subset (λ x hx, Union₂_subset (λ y hy, Ioo_subset_Icc_self.trans (h.out hx hy))),
-  rw ← union_diff_cancel this,
-  exact humeas.union hfinite.measurable_set
-end
-
-lemma is_preconnected.measurable_set
-  (h : is_preconnected s) : measurable_set s :=
-h.ord_connected.measurable_set
-
-lemma generate_from_Ico_mem_le_borel {α : Type*} [topological_space α] [linear_order α]
-  [order_closed_topology α] (s t : set α) :
-  measurable_space.generate_from {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ico l u = S} ≤ borel α :=
-begin
-  apply generate_from_le,
-  borelize α,
-  rintro _ ⟨a, -, b, -, -, rfl⟩,
-  exact measurable_set_Ico
-end
-
-lemma dense.borel_eq_generate_from_Ico_mem_aux {α : Type*} [topological_space α] [linear_order α]
-  [order_topology α] [second_countable_topology α] {s : set α} (hd : dense s)
-  (hbot : ∀ x, is_bot x → x ∈ s) (hIoo : ∀ x y : α, x < y → Ioo x y = ∅ → y ∈ s) :
-  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ico l u = S} :=
-begin
-  set S : set (set α) := {S | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ico l u = S},
-  refine le_antisymm _ (generate_from_Ico_mem_le_borel _ _),
-  letI : measurable_space α := generate_from S,
-  rw borel_eq_generate_from_Iio,
-  refine generate_from_le (forall_range_iff.2 $ λ a, _),
-  rcases hd.exists_countable_dense_subset_bot_top with ⟨t, hts, hc, htd, htb, htt⟩,
-  by_cases ha : ∀ b < a, (Ioo b a).nonempty,
-  { convert_to measurable_set (⋃ (l ∈ t) (u ∈ t) (hlu : l < u) (hu : u ≤ a), Ico l u),
-    { ext y, simp only [mem_Union, mem_Iio, mem_Ico], split,
-      { intro hy,
-        rcases htd.exists_le' (λ b hb, htb _ hb (hbot b hb)) y with ⟨l, hlt, hly⟩,
-        rcases htd.exists_mem_open is_open_Ioo (ha y hy) with ⟨u, hut, hyu, hua⟩,
-        exact ⟨l, hlt, u, hut, hly.trans_lt hyu, hua.le, hly, hyu⟩ },
-      { rintro ⟨l, -, u, -, -, hua, -, hyu⟩,
-        exact hyu.trans_le hua } },
-    { refine measurable_set.bUnion hc (λ a ha, measurable_set.bUnion hc $ λ b hb, _),
-      refine measurable_set.Union_Prop (λ hab, measurable_set.Union_Prop $ λ hb', _),
-      exact generate_measurable.basic _ ⟨a, hts ha, b, hts hb, hab, mem_singleton _⟩ } },
-  { simp only [not_forall, not_nonempty_iff_eq_empty] at ha,
-    replace ha : a ∈ s := hIoo ha.some a ha.some_spec.fst ha.some_spec.snd,
-    convert_to measurable_set (⋃ (l ∈ t) (hl : l < a), Ico l a),
-    { symmetry,
-      simp only [← Ici_inter_Iio, ← Union_inter, inter_eq_right_iff_subset, subset_def, mem_Union,
-        mem_Ici, mem_Iio],
-      intros x hx, rcases htd.exists_le' (λ b hb, htb _ hb (hbot b hb)) x with ⟨z, hzt, hzx⟩,
-      exact ⟨z, hzt, hzx.trans_lt hx, hzx⟩ },
-    { refine measurable_set.bUnion hc (λ x hx, measurable_set.Union_Prop $ λ hlt, _),
-      exact generate_measurable.basic _ ⟨x, hts hx, a, ha, hlt, mem_singleton _⟩ } }
-end
-
-lemma dense.borel_eq_generate_from_Ico_mem {α : Type*} [topological_space α] [linear_order α]
-  [order_topology α] [second_countable_topology α] [densely_ordered α] [no_min_order α]
-  {s : set α} (hd : dense s) :
-  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ico l u = S} :=
-hd.borel_eq_generate_from_Ico_mem_aux (by simp) $
-  λ x y hxy H, ((nonempty_Ioo.2 hxy).ne_empty H).elim
-
-lemma borel_eq_generate_from_Ico (α : Type*) [topological_space α]
-  [second_countable_topology α] [linear_order α] [order_topology α] :
-  borel α = generate_from {S : set α | ∃ l u (h : l < u), Ico l u = S} :=
-by simpa only [exists_prop, mem_univ, true_and]
-  using (@dense_univ α _).borel_eq_generate_from_Ico_mem_aux (λ _ _, mem_univ _)
-      (λ _ _ _ _, mem_univ _)
-
-lemma dense.borel_eq_generate_from_Ioc_mem_aux {α : Type*} [topological_space α] [linear_order α]
-  [order_topology α] [second_countable_topology α] {s : set α} (hd : dense s)
-  (hbot : ∀ x, is_top x → x ∈ s) (hIoo : ∀ x y : α, x < y → Ioo x y = ∅ → x ∈ s) :
-  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ioc l u = S} :=
-begin
-  convert hd.order_dual.borel_eq_generate_from_Ico_mem_aux hbot (λ x y hlt he, hIoo y x hlt _),
-  { ext s,
-    split; rintro ⟨l, hl, u, hu, hlt, rfl⟩,
-    exacts [⟨u, hu, l, hl, hlt, dual_Ico⟩, ⟨u, hu, l, hl, hlt, dual_Ioc⟩] },
-  { erw dual_Ioo,
-    exact he }
-end
-
-lemma dense.borel_eq_generate_from_Ioc_mem {α : Type*} [topological_space α] [linear_order α]
-  [order_topology α] [second_countable_topology α] [densely_ordered α] [no_max_order α]
-  {s : set α} (hd : dense s) :
-  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ioc l u = S} :=
-hd.borel_eq_generate_from_Ioc_mem_aux (by simp) $
-  λ x y hxy H, ((nonempty_Ioo.2 hxy).ne_empty H).elim
-
-lemma borel_eq_generate_from_Ioc (α : Type*) [topological_space α]
-  [second_countable_topology α] [linear_order α] [order_topology α] :
-  borel α = generate_from {S : set α | ∃ l u (h : l < u), Ioc l u = S} :=
-by simpa only [exists_prop, mem_univ, true_and]
-  using (@dense_univ α _).borel_eq_generate_from_Ioc_mem_aux (λ _ _, mem_univ _)
-      (λ _ _ _ _, mem_univ _)
-
-namespace measure_theory.measure
-
-/-- Two finite measures on a Borel space are equal if they agree on all closed-open intervals.  If
-`α` is a conditionally complete linear order with no top element,
-`measure_theory.measure..ext_of_Ico` is an extensionality lemma with weaker assumptions on `μ` and
-`ν`. -/
-lemma ext_of_Ico_finite {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [linear_order α] [order_topology α]
-  [borel_space α] (μ ν : measure α) [is_finite_measure μ] (hμν : μ univ = ν univ)
-  (h : ∀ ⦃a b⦄, a < b → μ (Ico a b) = ν (Ico a b)) : μ = ν :=
-begin
-  refine ext_of_generate_finite _
-    (borel_space.measurable_eq.trans (borel_eq_generate_from_Ico α))
-    (is_pi_system_Ico (id : α → α) id) _ hμν,
-  { rintro - ⟨a, b, hlt, rfl⟩,
-    exact h hlt }
-end
-
-/-- Two finite measures on a Borel space are equal if they agree on all open-closed intervals.  If
-`α` is a conditionally complete linear order with no top element,
-`measure_theory.measure..ext_of_Ioc` is an extensionality lemma with weaker assumptions on `μ` and
-`ν`. -/
-lemma ext_of_Ioc_finite {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [linear_order α] [order_topology α]
-  [borel_space α] (μ ν : measure α) [is_finite_measure μ] (hμν : μ univ = ν univ)
-  (h : ∀ ⦃a b⦄, a < b → μ (Ioc a b) = ν (Ioc a b)) : μ = ν :=
-begin
-  refine @ext_of_Ico_finite αᵒᵈ _ _ _ _ _ ‹_› μ ν _ hμν (λ a b hab, _),
-  erw dual_Ico,
-  exact h hab
-end
-
-/-- Two measures which are finite on closed-open intervals are equal if the agree on all
-closed-open intervals. -/
-lemma ext_of_Ico' {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
-  [no_max_order α] (μ ν : measure α) (hμ : ∀ ⦃a b⦄, a < b → μ (Ico a b) ≠ ∞)
-  (h : ∀ ⦃a b⦄, a < b → μ (Ico a b) = ν (Ico a b)) : μ = ν :=
-begin
-  rcases exists_countable_dense_bot_top α with ⟨s, hsc, hsd, hsb, hst⟩,
-  have : countable (⋃ (l ∈ s) (u ∈ s) (h : l < u), {Ico l u} : set (set α)),
-    from hsc.bUnion (λ l hl, hsc.bUnion
-      (λ u hu, countable_Union_Prop $ λ _, countable_singleton _)),
-  simp only [← set_of_eq_eq_singleton, ← set_of_exists] at this,
-  refine measure.ext_of_generate_from_of_cover_subset
-    (borel_space.measurable_eq.trans (borel_eq_generate_from_Ico α))
-    (is_pi_system_Ico id id) _ this _ _ _,
-  { rintro _ ⟨l, -, u, -, h, rfl⟩, exact ⟨l, u, h, rfl⟩ },
-  { refine sUnion_eq_univ_iff.2 (λ x, _),
-    rcases hsd.exists_le' hsb x with ⟨l, hls, hlx⟩,
-    rcases hsd.exists_gt x with ⟨u, hus, hxu⟩,
-    exact ⟨_, ⟨l, hls, u, hus, hlx.trans_lt hxu, rfl⟩, hlx, hxu⟩ },
-  { rintro _ ⟨l, -, u, -, hlt, rfl⟩, exact hμ hlt },
-  { rintro _ ⟨l, u, hlt, rfl⟩, exact h hlt }
-end
-
-/-- Two measures which are finite on closed-open intervals are equal if the agree on all
-open-closed intervals. -/
-lemma ext_of_Ioc' {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
-  [no_min_order α] (μ ν : measure α) (hμ : ∀ ⦃a b⦄, a < b → μ (Ioc a b) ≠ ∞)
-  (h : ∀ ⦃a b⦄, a < b → μ (Ioc a b) = ν (Ioc a b)) : μ = ν :=
-begin
-  refine @ext_of_Ico' αᵒᵈ _ _ _ _ _ ‹_› _ μ ν _ _;
-    intros a b hab; erw dual_Ico,
-  exacts [hμ hab, h hab]
-end
-
-/-- Two measures which are finite on closed-open intervals are equal if the agree on all
-closed-open intervals. -/
-lemma ext_of_Ico {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [conditionally_complete_linear_order α] [order_topology α]
-  [borel_space α] [no_max_order α] (μ ν : measure α) [is_locally_finite_measure μ]
-  (h : ∀ ⦃a b⦄, a < b → μ (Ico a b) = ν (Ico a b)) : μ = ν :=
-μ.ext_of_Ico' ν (λ a b hab, measure_Ico_lt_top.ne) h
-
-/-- Two measures which are finite on closed-open intervals are equal if the agree on all
-open-closed intervals. -/
-lemma ext_of_Ioc {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [conditionally_complete_linear_order α] [order_topology α]
-  [borel_space α] [no_min_order α] (μ ν : measure α) [is_locally_finite_measure μ]
-  (h : ∀ ⦃a b⦄, a < b → μ (Ioc a b) = ν (Ioc a b)) : μ = ν :=
-μ.ext_of_Ioc' ν (λ a b hab, measure_Ioc_lt_top.ne) h
-
-/-- Two finite measures on a Borel space are equal if they agree on all left-infinite right-closed
-intervals. -/
-lemma ext_of_Iic {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
-  (μ ν : measure α) [is_finite_measure μ] (h : ∀ a, μ (Iic a) = ν (Iic a)) : μ = ν :=
-begin
-  refine ext_of_Ioc_finite μ ν _ (λ a b hlt, _),
-  { rcases exists_countable_dense_bot_top α with ⟨s, hsc, hsd, -, hst⟩,
-    have : directed_on (≤) s, from directed_on_iff_directed.2 (directed_of_sup $ λ _ _, id),
-    simp only [← bsupr_measure_Iic hsc (hsd.exists_ge' hst) this, h] },
-  rw [← Iic_diff_Iic, measure_diff (Iic_subset_Iic.2 hlt.le) measurable_set_Iic,
-      measure_diff (Iic_subset_Iic.2 hlt.le) measurable_set_Iic, h a, h b],
-  { rw ← h a, exact (measure_lt_top μ _).ne },
-  { exact (measure_lt_top μ _).ne }
-end
-
-/-- Two finite measures on a Borel space are equal if they agree on all left-closed right-infinite
-intervals. -/
-lemma ext_of_Ici {α : Type*} [topological_space α] {m : measurable_space α}
-  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
-  (μ ν : measure α) [is_finite_measure μ] (h : ∀ a, μ (Ici a) = ν (Ici a)) : μ = ν :=
-@ext_of_Iic αᵒᵈ _ _ _ _ _ ‹_› _ _ _ h
-
-end measure_theory.measure
-
-end linear_order
-
-section linear_order
-
-variables [linear_order α] [order_closed_topology α]
-
-@[measurability]
-lemma measurable_set_interval {a b : α} : measurable_set (interval a b) :=
-measurable_set_Icc
-
-@[measurability]
-lemma measurable_set_interval_oc {a b : α} : measurable_set (interval_oc a b) :=
-measurable_set_Ioc
-
-variables [second_countable_topology α]
-
-@[measurability]
-lemma measurable.max {f g : δ → α} (hf : measurable f) (hg : measurable g) :
-  measurable (λ a, max (f a) (g a)) :=
-by simpa only [max_def] using hf.piecewise (measurable_set_le hg hf) hg
-
-@[measurability]
-lemma ae_measurable.max {f g : δ → α} {μ : measure δ}
-  (hf : ae_measurable f μ) (hg : ae_measurable g μ) : ae_measurable (λ a, max (f a) (g a)) μ :=
-⟨λ a, max (hf.mk f a) (hg.mk g a), hf.measurable_mk.max hg.measurable_mk,
-  eventually_eq.comp₂ hf.ae_eq_mk _ hg.ae_eq_mk⟩
-
-@[measurability]
-lemma measurable.min {f g : δ → α} (hf : measurable f) (hg : measurable g) :
-  measurable (λ a, min (f a) (g a)) :=
-by simpa only [min_def] using hf.piecewise (measurable_set_le hf hg) hg
-
-@[measurability]
-lemma ae_measurable.min {f g : δ → α} {μ : measure δ}
-  (hf : ae_measurable f μ) (hg : ae_measurable g μ) : ae_measurable (λ a, min (f a) (g a)) μ :=
-⟨λ a, min (hf.mk f a) (hg.mk g a), hf.measurable_mk.min hg.measurable_mk,
-  eventually_eq.comp₂ hf.ae_eq_mk _ hg.ae_eq_mk⟩
-
-end linear_order
-
-/-- A continuous function from an `opens_measurable_space` to a `borel_space`
-is measurable. -/
-lemma continuous.measurable {f : α → γ} (hf : continuous f) :
-  measurable f :=
-hf.borel_measurable.mono opens_measurable_space.borel_le
-  (le_of_eq $ borel_space.measurable_eq)
-
-/-- A continuous function from an `opens_measurable_space` to a `borel_space`
-is ae-measurable. -/
-lemma continuous.ae_measurable {f : α → γ} (h : continuous f) {μ : measure α} : ae_measurable f μ :=
-h.measurable.ae_measurable
-
-lemma closed_embedding.measurable {f : α → γ} (hf : closed_embedding f) :
-  measurable f :=
-hf.continuous.measurable
-
-lemma continuous.is_open_pos_measure_map {f : β → γ} (hf : continuous f)
-  (hf_surj : function.surjective f) {μ : measure β} [μ.is_open_pos_measure] :
-  (measure.map f μ).is_open_pos_measure :=
-begin
-  refine ⟨λ U hUo hUne, _⟩,
-  rw [measure.map_apply hf.measurable hUo.measurable_set],
-  exact (hUo.preimage hf).measure_ne_zero μ (hf_surj.nonempty_preimage.mpr hUne)
-end
-
-/-- If a function is defined piecewise in terms of functions which are continuous on their
-respective pieces, then it is measurable. -/
-lemma continuous_on.measurable_piecewise
-  {f g : α → γ} {s : set α} [Π (j : α), decidable (j ∈ s)]
-  (hf : continuous_on f s) (hg : continuous_on g sᶜ) (hs : measurable_set s) :
-  measurable (s.piecewise f g) :=
-begin
-  refine measurable_of_is_open (λ t ht, _),
-  rw [piecewise_preimage, set.ite],
-  apply measurable_set.union,
-  { rcases _root_.continuous_on_iff'.1 hf t ht with ⟨u, u_open, hu⟩,
-    rw hu,
-    exact u_open.measurable_set.inter hs },
-  { rcases _root_.continuous_on_iff'.1 hg t ht with ⟨u, u_open, hu⟩,
-    rw [diff_eq_compl_inter, inter_comm, hu],
-    exact u_open.measurable_set.inter hs.compl }
-end
-
-@[priority 100, to_additive]
-instance has_continuous_mul.has_measurable_mul [has_mul γ] [has_continuous_mul γ] :
-  has_measurable_mul γ :=
-{ measurable_const_mul := λ c, (continuous_const.mul continuous_id).measurable,
-  measurable_mul_const := λ c, (continuous_id.mul continuous_const).measurable }
-
-@[priority 100]
-instance has_continuous_sub.has_measurable_sub [has_sub γ] [has_continuous_sub γ] :
-  has_measurable_sub γ :=
-{ measurable_const_sub := λ c, (continuous_const.sub continuous_id).measurable,
-  measurable_sub_const := λ c, (continuous_id.sub continuous_const).measurable }
-
-@[priority 100, to_additive]
-instance topological_group.has_measurable_inv [group γ] [topological_group γ] :
-  has_measurable_inv γ :=
-⟨continuous_inv.measurable⟩
-
-@[priority 100]
-instance has_continuous_smul.has_measurable_smul {M α} [topological_space M]
-  [topological_space α] [measurable_space M] [measurable_space α]
-  [opens_measurable_space M] [borel_space α] [has_scalar M α] [has_continuous_smul M α] :
-  has_measurable_smul M α :=
-⟨λ c, (continuous_const_smul _).measurable,
-  λ y, (continuous_id.smul continuous_const).measurable⟩
-
-section lattice
-
-@[priority 100]
-instance has_continuous_sup.has_measurable_sup [has_sup γ] [has_continuous_sup γ] :
-  has_measurable_sup γ :=
-{ measurable_const_sup := λ c, (continuous_const.sup continuous_id).measurable,
-  measurable_sup_const := λ c, (continuous_id.sup continuous_const).measurable }
-
-@[priority 100]
-instance has_continuous_sup.has_measurable_sup₂ [second_countable_topology γ] [has_sup γ]
-  [has_continuous_sup γ] :
-  has_measurable_sup₂ γ :=
-⟨continuous_sup.measurable⟩
-
-@[priority 100]
-instance has_continuous_inf.has_measurable_inf [has_inf γ] [has_continuous_inf γ] :
-  has_measurable_inf γ :=
-{ measurable_const_inf := λ c, (continuous_const.inf continuous_id).measurable,
-  measurable_inf_const := λ c, (continuous_id.inf continuous_const).measurable }
-
-@[priority 100]
-instance has_continuous_inf.has_measurable_inf₂ [second_countable_topology γ] [has_inf γ]
-  [has_continuous_inf γ] :
-  has_measurable_inf₂ γ :=
-⟨continuous_inf.measurable⟩
-
-end lattice
-
-section homeomorph
-
-@[measurability] protected lemma homeomorph.measurable (h : α ≃ₜ γ) : measurable h :=
-h.continuous.measurable
-
-/-- A homeomorphism between two Borel spaces is a measurable equivalence.-/
-def homeomorph.to_measurable_equiv (h : γ ≃ₜ γ₂) : γ ≃ᵐ γ₂ :=
-{ measurable_to_fun := h.measurable,
-  measurable_inv_fun := h.symm.measurable,
-  to_equiv := h.to_equiv }
-
-@[simp]
-lemma homeomorph.to_measurable_equiv_coe (h : γ ≃ₜ γ₂) : (h.to_measurable_equiv : γ → γ₂) = h :=
-rfl
-
-@[simp] lemma homeomorph.to_measurable_equiv_symm_coe (h : γ ≃ₜ γ₂) :
-  (h.to_measurable_equiv.symm : γ₂ → γ) = h.symm :=
-rfl
-
-end homeomorph
-
-@[measurability] lemma continuous_map.measurable (f : C(α, γ)) : measurable f :=
-f.continuous.measurable
-
-lemma measurable_of_continuous_on_compl_singleton [t1_space α] {f : α → γ} (a : α)
-  (hf : continuous_on f {a}ᶜ) :
-  measurable f :=
-measurable_of_measurable_on_compl_singleton a
-  (continuous_on_iff_continuous_restrict.1 hf).measurable
-
-lemma continuous.measurable2 [second_countable_topology α] [second_countable_topology β]
-  {f : δ → α} {g : δ → β} {c : α → β → γ}
-  (h : continuous (λ p : α × β, c p.1 p.2)) (hf : measurable f) (hg : measurable g) :
-  measurable (λ a, c (f a) (g a)) :=
-h.measurable.comp (hf.prod_mk hg)
-
-lemma continuous.ae_measurable2 [second_countable_topology α] [second_countable_topology β]
-  {f : δ → α} {g : δ → β} {c : α → β → γ} {μ : measure δ}
-  (h : continuous (λ p : α × β, c p.1 p.2)) (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
-  ae_measurable (λ a, c (f a) (g a)) μ :=
-h.measurable.comp_ae_measurable (hf.prod_mk hg)
-
-@[priority 100]
-instance has_continuous_inv₀.has_measurable_inv [group_with_zero γ] [t1_space γ]
-  [has_continuous_inv₀ γ] :
-  has_measurable_inv γ :=
-⟨measurable_of_continuous_on_compl_singleton 0 continuous_on_inv₀⟩
-
-@[priority 100, to_additive]
-instance has_continuous_mul.has_measurable_mul₂ [second_countable_topology γ] [has_mul γ]
-  [has_continuous_mul γ] : has_measurable_mul₂ γ :=
-⟨continuous_mul.measurable⟩
-
-@[priority 100]
-instance has_continuous_sub.has_measurable_sub₂ [second_countable_topology γ] [has_sub γ]
-  [has_continuous_sub γ] : has_measurable_sub₂ γ :=
-⟨continuous_sub.measurable⟩
-
-@[priority 100]
-instance has_continuous_smul.has_measurable_smul₂ {M α} [topological_space M]
-  [second_countable_topology M] [measurable_space M] [opens_measurable_space M]
-  [topological_space α] [second_countable_topology α] [measurable_space α]
-  [borel_space α] [has_scalar M α] [has_continuous_smul M α] :
-  has_measurable_smul₂ M α :=
-⟨continuous_smul.measurable⟩
-
-end
-
-section borel_space
-variables [topological_space α] [measurable_space α] [borel_space α]
-  [topological_space β] [measurable_space β] [borel_space β]
-  [topological_space γ] [measurable_space γ] [borel_space γ]
-  [measurable_space δ]
-
-lemma pi_le_borel_pi {ι : Type*} {π : ι → Type*} [Π i, topological_space (π i)]
-  [Π i, measurable_space (π i)] [∀ i, borel_space (π i)] :
-  measurable_space.pi ≤ borel (Π i, π i) :=
-begin
-  have : ‹Π i, measurable_space (π i)› = λ i, borel (π i) :=
-    funext (λ i, borel_space.measurable_eq),
-  rw [this],
-  exact supr_le (λ i, comap_le_iff_le_map.2 $ (continuous_apply i).borel_measurable)
-end
-
-lemma prod_le_borel_prod : prod.measurable_space ≤ borel (α × β) :=
-begin
-  rw [‹borel_space α›.measurable_eq, ‹borel_space β›.measurable_eq],
-  refine sup_le _ _,
-  { exact comap_le_iff_le_map.mpr continuous_fst.borel_measurable },
-  { exact comap_le_iff_le_map.mpr continuous_snd.borel_measurable }
-end
-
-instance pi.borel_space_fintype_encodable {ι : Type*} {π : ι → Type*} [encodable ι]
-  [t' : Π i, topological_space (π i)]
-  [Π i, measurable_space (π i)] [∀ i, second_countable_topology (π i)]
-  [∀ i, borel_space (π i)] :
-  borel_space (Π i, π i) :=
-⟨le_antisymm pi_le_borel_pi opens_measurable_space.borel_le⟩
-
-instance pi.borel_space_fintype {ι : Type*} {π : ι → Type*} [fintype ι]
-  [t' : Π i, topological_space (π i)]
-  [Π i, measurable_space (π i)] [∀ i, second_countable_topology (π i)]
-  [∀ i, borel_space (π i)] :
-  borel_space (Π i, π i) :=
-⟨le_antisymm pi_le_borel_pi opens_measurable_space.borel_le⟩
-
-instance prod.borel_space [second_countable_topology α] [second_countable_topology β] :
-  borel_space (α × β) :=
-⟨le_antisymm prod_le_borel_prod opens_measurable_space.borel_le⟩
-
-protected lemma embedding.measurable_embedding {f : α → β} (h₁ : embedding f)
-  (h₂ : measurable_set (range f)) : measurable_embedding f :=
-show measurable_embedding (coe ∘ (homeomorph.of_embedding f h₁).to_measurable_equiv),
-from (measurable_embedding.subtype_coe h₂).comp (measurable_equiv.measurable_embedding _)
-
-protected lemma closed_embedding.measurable_embedding {f : α → β} (h : closed_embedding f) :
-  measurable_embedding f :=
-h.to_embedding.measurable_embedding h.closed_range.measurable_set
-
-protected lemma open_embedding.measurable_embedding {f : α → β} (h : open_embedding f) :
-  measurable_embedding f :=
-h.to_embedding.measurable_embedding h.open_range.measurable_set
-
-section linear_order
-
-variables [linear_order α] [order_topology α] [second_countable_topology α]
-
-lemma measurable_of_Iio {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Iio x)) : measurable f :=
-begin
-  convert measurable_generate_from _,
-  exact borel_space.measurable_eq.trans (borel_eq_generate_from_Iio _),
-  rintro _ ⟨x, rfl⟩, exact hf x
-end
-
-lemma upper_semicontinuous.measurable [topological_space δ] [opens_measurable_space δ]
-  {f : δ → α} (hf : upper_semicontinuous f) : measurable f :=
-measurable_of_Iio (λ y, (hf.is_open_preimage y).measurable_set)
-
-lemma measurable_of_Ioi {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Ioi x)) : measurable f :=
-begin
-  convert measurable_generate_from _,
-  exact borel_space.measurable_eq.trans (borel_eq_generate_from_Ioi _),
-  rintro _ ⟨x, rfl⟩, exact hf x
-end
-
-lemma lower_semicontinuous.measurable [topological_space δ] [opens_measurable_space δ]
-  {f : δ → α} (hf : lower_semicontinuous f) : measurable f :=
-measurable_of_Ioi (λ y, (hf.is_open_preimage y).measurable_set)
-
-lemma measurable_of_Iic {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Iic x)) : measurable f :=
-begin
-  apply measurable_of_Ioi,
-  simp_rw [← compl_Iic, preimage_compl, measurable_set.compl_iff],
-  assumption
-end
-
-lemma measurable_of_Ici {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Ici x)) : measurable f :=
-begin
-  apply measurable_of_Iio,
-  simp_rw [← compl_Ici, preimage_compl, measurable_set.compl_iff],
-  assumption
-end
-
-lemma measurable.is_lub {ι} [encodable ι] {f : ι → δ → α} {g : δ → α} (hf : ∀ i, measurable (f i))
-  (hg : ∀ b, is_lub {a | ∃ i, f i b = a} (g b)) :
-  measurable g :=
-begin
-  change ∀ b, is_lub (range $ λ i, f i b) (g b) at hg,
-  rw [‹borel_space α›.measurable_eq, borel_eq_generate_from_Ioi α],
-  apply measurable_generate_from,
-  rintro _ ⟨a, rfl⟩,
-  simp_rw [set.preimage, mem_Ioi, lt_is_lub_iff (hg _), exists_range_iff, set_of_exists],
-  exact measurable_set.Union (λ i, hf i (is_open_lt' _).measurable_set)
-end
-
-private lemma ae_measurable.is_lub_of_nonempty {ι} (hι : nonempty ι)
-  {μ : measure δ} [encodable ι] {f : ι → δ → α} {g : δ → α}
-  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_lub {a | ∃ i, f i b = a} (g b)) :
-  ae_measurable g μ :=
-begin
-  let p : δ → (ι → α) → Prop := λ x f', is_lub {a | ∃ i, f' i = a} (g x),
-  let g_seq := λ x, ite (x ∈ ae_seq_set hf p) (g x) (⟨g x⟩ : nonempty α).some,
-  have hg_seq : ∀ b, is_lub {a | ∃ i, ae_seq hf p i b = a} (g_seq b),
-  { intro b,
-    haveI hα : nonempty α := nonempty.map g ⟨b⟩,
-    simp only [ae_seq, g_seq],
-    split_ifs,
-    { have h_set_eq : {a : α | ∃ (i : ι), (hf i).mk (f i) b = a} = {a : α | ∃ (i : ι), f i b = a},
-      { ext x,
-        simp_rw [set.mem_set_of_eq, ae_seq.mk_eq_fun_of_mem_ae_seq_set hf h], },
-      rw h_set_eq,
-      exact ae_seq.fun_prop_of_mem_ae_seq_set hf h, },
-    { have h_singleton : {a : α | ∃ (i : ι), hα.some = a} = {hα.some},
-      { ext1 x,
-        exact ⟨λ hx, hx.some_spec.symm, λ hx, ⟨hι.some, hx.symm⟩⟩, },
-      rw h_singleton,
-      exact is_lub_singleton, }, },
-  refine ⟨g_seq, measurable.is_lub (ae_seq.measurable hf p) hg_seq, _⟩,
-  exact (ite_ae_eq_of_measure_compl_zero g (λ x, (⟨g x⟩ : nonempty α).some) (ae_seq_set hf p)
-    (ae_seq.measure_compl_ae_seq_set_eq_zero hf hg)).symm,
-end
-
-lemma ae_measurable.is_lub {ι} {μ : measure δ} [encodable ι] {f : ι → δ → α} {g : δ → α}
-  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_lub {a | ∃ i, f i b = a} (g b)) :
-  ae_measurable g μ :=
-begin
-  by_cases hμ : μ = 0, { rw hμ, exact ae_measurable_zero_measure },
-  haveI : μ.ae.ne_bot, { simpa [ne_bot_iff] },
-  by_cases hι : nonempty ι, { exact ae_measurable.is_lub_of_nonempty hι hf hg, },
-  suffices : ∃ x, g =ᵐ[μ] λ y, g x,
-  by { exact ⟨(λ y, g this.some), measurable_const, this.some_spec⟩, },
-  have h_empty : ∀ x, {a : α | ∃ (i : ι), f i x = a} = ∅,
-  { intro x,
-    ext1 y,
-    rw [set.mem_set_of_eq, set.mem_empty_eq, iff_false],
-    exact λ hi, hι (nonempty_of_exists hi), },
-  simp_rw h_empty at hg,
-  exact ⟨hg.exists.some, hg.mono (λ y hy, is_lub.unique hy hg.exists.some_spec)⟩,
-end
-
-lemma measurable.is_glb {ι} [encodable ι] {f : ι → δ → α} {g : δ → α} (hf : ∀ i, measurable (f i))
-  (hg : ∀ b, is_glb {a | ∃ i, f i b = a} (g b)) :
-  measurable g :=
-begin
-  change ∀ b, is_glb (range $ λ i, f i b) (g b) at hg,
-  rw [‹borel_space α›.measurable_eq, borel_eq_generate_from_Iio α],
-  apply measurable_generate_from,
-  rintro _ ⟨a, rfl⟩,
-  simp_rw [set.preimage, mem_Iio, is_glb_lt_iff (hg _), exists_range_iff, set_of_exists],
-  exact measurable_set.Union (λ i, hf i (is_open_gt' _).measurable_set)
-end
-
-private lemma ae_measurable.is_glb_of_nonempty {ι} (hι : nonempty ι)
-  {μ : measure δ} [encodable ι] {f : ι → δ → α} {g : δ → α}
-  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_glb {a | ∃ i, f i b = a} (g b)) :
-  ae_measurable g μ :=
-begin
-  let p : δ → (ι → α) → Prop := λ x f', is_glb {a | ∃ i, f' i = a} (g x),
-  let g_seq := λ x, ite (x ∈ ae_seq_set hf p) (g x) (⟨g x⟩ : nonempty α).some,
-  have hg_seq : ∀ b, is_glb {a | ∃ i, ae_seq hf p i b = a} (g_seq b),
-  { intro b,
-    haveI hα : nonempty α := nonempty.map g ⟨b⟩,
-    simp only [ae_seq, g_seq],
-    split_ifs,
-    { have h_set_eq : {a : α | ∃ (i : ι), (hf i).mk (f i) b = a} = {a : α | ∃ (i : ι), f i b = a},
-      { ext x,
-        simp_rw [set.mem_set_of_eq, ae_seq.mk_eq_fun_of_mem_ae_seq_set hf h], },
-      rw h_set_eq,
-      exact ae_seq.fun_prop_of_mem_ae_seq_set hf h, },
-    { have h_singleton : {a : α | ∃ (i : ι), hα.some = a} = {hα.some},
-      { ext1 x,
-        exact ⟨λ hx, hx.some_spec.symm, λ hx, ⟨hι.some, hx.symm⟩⟩, },
-      rw h_singleton,
-      exact is_glb_singleton, }, },
-  refine ⟨g_seq, measurable.is_glb (ae_seq.measurable hf p) hg_seq, _⟩,
-  exact (ite_ae_eq_of_measure_compl_zero g (λ x, (⟨g x⟩ : nonempty α).some) (ae_seq_set hf p)
-    (ae_seq.measure_compl_ae_seq_set_eq_zero hf hg)).symm,
-end
-
-lemma ae_measurable.is_glb {ι} {μ : measure δ} [encodable ι] {f : ι → δ → α} {g : δ → α}
-  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_glb {a | ∃ i, f i b = a} (g b)) :
-  ae_measurable g μ :=
-begin
-  by_cases hμ : μ = 0, { rw hμ, exact ae_measurable_zero_measure },
-  haveI : μ.ae.ne_bot, { simpa [ne_bot_iff] },
-  by_cases hι : nonempty ι, { exact ae_measurable.is_glb_of_nonempty hι hf hg, },
-  suffices : ∃ x, g =ᵐ[μ] λ y, g x,
-  by { exact ⟨(λ y, g this.some), measurable_const, this.some_spec⟩, },
-  have h_empty : ∀ x, {a : α | ∃ (i : ι), f i x = a} = ∅,
-  { intro x,
-    ext1 y,
-    rw [set.mem_set_of_eq, set.mem_empty_eq, iff_false],
-    exact λ hi, hι (nonempty_of_exists hi), },
-  simp_rw h_empty at hg,
-  exact ⟨hg.exists.some, hg.mono (λ y hy, is_glb.unique hy hg.exists.some_spec)⟩,
-end
-
-protected lemma monotone.measurable [linear_order β] [order_closed_topology β] {f : β → α}
-  (hf : monotone f) : measurable f :=
-suffices h : ∀ x, ord_connected (f ⁻¹' Ioi x),
-  from measurable_of_Ioi (λ x, (h x).measurable_set),
-λ x, ord_connected_def.mpr (λ a ha b hb c hc, lt_of_lt_of_le ha (hf hc.1))
-
-lemma ae_measurable_restrict_of_monotone_on [linear_order β] [order_closed_topology β]
-  {μ : measure β} {s : set β} (hs : measurable_set s) {f : β → α} (hf : monotone_on f s) :
-  ae_measurable f (μ.restrict s) :=
-have this : monotone (f ∘ coe : s → α), from λ ⟨x, hx⟩ ⟨y, hy⟩ (hxy : x ≤ y), hf hx hy hxy,
-ae_measurable_restrict_of_measurable_subtype hs this.measurable
-
-protected lemma antitone.measurable [linear_order β] [order_closed_topology β] {f : β → α}
-  (hf : antitone f) :
-  measurable f :=
-@monotone.measurable αᵒᵈ β _ _ ‹_› _ _ _ _ _ ‹_› _ _ _ hf
-
-lemma ae_measurable_restrict_of_antitone_on [linear_order β] [order_closed_topology β]
-  {μ : measure β} {s : set β} (hs : measurable_set s) {f : β → α} (hf : antitone_on f s) :
-  ae_measurable f (μ.restrict s) :=
-@ae_measurable_restrict_of_monotone_on αᵒᵈ β _ _ ‹_› _ _ _ _ _ ‹_› _ _ _ _ hs _ hf
-
-end linear_order
-
-@[measurability]
-lemma measurable.supr_Prop {α} [measurable_space α] [complete_lattice α]
-  (p : Prop) {f : δ → α} (hf : measurable f) :
-  measurable (λ b, ⨆ h : p, f b) :=
-classical.by_cases
-  (assume h : p, begin convert hf, funext, exact supr_pos h end)
-  (assume h : ¬p, begin convert measurable_const, funext, exact supr_neg h end)
-
-@[measurability]
-lemma measurable.infi_Prop {α} [measurable_space α] [complete_lattice α]
-  (p : Prop) {f : δ → α} (hf : measurable f) :
-  measurable (λ b, ⨅ h : p, f b) :=
-classical.by_cases
-  (assume h : p, begin convert hf, funext, exact infi_pos h end )
-  (assume h : ¬p, begin convert measurable_const, funext, exact infi_neg h end)
-
-section complete_linear_order
-
-variables [complete_linear_order α] [order_topology α] [second_countable_topology α]
-
-@[measurability]
-lemma measurable_supr {ι} [encodable ι] {f : ι → δ → α} (hf : ∀ i, measurable (f i)) :
-  measurable (λ b, ⨆ i, f i b) :=
-measurable.is_lub hf $ λ b, is_lub_supr
-
-@[measurability]
-lemma ae_measurable_supr {ι} {μ : measure δ} [encodable ι] {f : ι → δ → α}
-  (hf : ∀ i, ae_measurable (f i) μ) :
-  ae_measurable (λ b, ⨆ i, f i b) μ :=
-ae_measurable.is_lub hf $ (ae_of_all μ (λ b, is_lub_supr))
-
-@[measurability]
-lemma measurable_infi {ι} [encodable ι] {f : ι → δ → α} (hf : ∀ i, measurable (f i)) :
-  measurable (λ b, ⨅ i, f i b) :=
-measurable.is_glb hf $ λ b, is_glb_infi
-
-@[measurability]
-lemma ae_measurable_infi {ι} {μ : measure δ} [encodable ι] {f : ι → δ → α}
-  (hf : ∀ i, ae_measurable (f i) μ) :
-  ae_measurable (λ b, ⨅ i, f i b) μ :=
-ae_measurable.is_glb hf $ (ae_of_all μ (λ b, is_glb_infi))
-
-lemma measurable_bsupr {ι} (s : set ι) {f : ι → δ → α} (hs : countable s)
-  (hf : ∀ i, measurable (f i)) : measurable (λ b, ⨆ i ∈ s, f i b) :=
-by { haveI : encodable s := hs.to_encodable, simp only [supr_subtype'],
-     exact measurable_supr (λ i, hf i) }
-
-lemma ae_measurable_bsupr {ι} {μ : measure δ} (s : set ι) {f : ι → δ → α} (hs : countable s)
-  (hf : ∀ i, ae_measurable (f i) μ) : ae_measurable (λ b, ⨆ i ∈ s, f i b) μ :=
-begin
-  haveI : encodable s := hs.to_encodable,
-  simp only [supr_subtype'],
-  exact ae_measurable_supr (λ i, hf i),
-end
-
-lemma measurable_binfi {ι} (s : set ι) {f : ι → δ → α} (hs : countable s)
-  (hf : ∀ i, measurable (f i)) : measurable (λ b, ⨅ i ∈ s, f i b) :=
-by { haveI : encodable s := hs.to_encodable, simp only [infi_subtype'],
-     exact measurable_infi (λ i, hf i) }
-
-lemma ae_measurable_binfi {ι} {μ : measure δ} (s : set ι) {f : ι → δ → α} (hs : countable s)
-  (hf : ∀ i, ae_measurable (f i) μ) : ae_measurable (λ b, ⨅ i ∈ s, f i b) μ :=
-begin
-  haveI : encodable s := hs.to_encodable,
-  simp only [infi_subtype'],
-  exact ae_measurable_infi (λ i, hf i),
-end
-
-/-- `liminf` over a general filter is measurable. See `measurable_liminf` for the version over `ℕ`.
--/
-lemma measurable_liminf' {ι ι'} {f : ι → δ → α} {u : filter ι} (hf : ∀ i, measurable (f i))
-  {p : ι' → Prop} {s : ι' → set ι} (hu : u.has_countable_basis p s) (hs : ∀ i, (s i).countable) :
-  measurable (λ x, liminf u (λ i, f i x)) :=
-begin
-  simp_rw [hu.to_has_basis.liminf_eq_supr_infi],
-  refine measurable_bsupr _ hu.countable _,
-  exact λ i, measurable_binfi _ (hs i) hf
-end
-
-/-- `limsup` over a general filter is measurable. See `measurable_limsup` for the version over `ℕ`.
--/
-lemma measurable_limsup' {ι ι'}  {f : ι → δ → α} {u : filter ι} (hf : ∀ i, measurable (f i))
-  {p : ι' → Prop} {s : ι' → set ι} (hu : u.has_countable_basis p s) (hs : ∀ i, (s i).countable) :
-  measurable (λ x, limsup u (λ i, f i x)) :=
-begin
-  simp_rw [hu.to_has_basis.limsup_eq_infi_supr],
-  refine measurable_binfi _ hu.countable _,
-  exact λ i, measurable_bsupr _ (hs i) hf
-end
-
-/-- `liminf` over `ℕ` is measurable. See `measurable_liminf'` for a version with a general filter.
--/
-@[measurability]
-lemma measurable_liminf {f : ℕ → δ → α} (hf : ∀ i, measurable (f i)) :
-  measurable (λ x, liminf at_top (λ i, f i x)) :=
-measurable_liminf' hf at_top_countable_basis (λ i, countable_encodable _)
-
-/-- `limsup` over `ℕ` is measurable. See `measurable_limsup'` for a version with a general filter.
--/
-@[measurability]
-lemma measurable_limsup {f : ℕ → δ → α} (hf : ∀ i, measurable (f i)) :
-  measurable (λ x, limsup at_top (λ i, f i x)) :=
-measurable_limsup' hf at_top_countable_basis (λ i, countable_encodable _)
-
-end complete_linear_order
-
-section conditionally_complete_linear_order
-
-variables [conditionally_complete_linear_order α] [order_topology α] [second_countable_topology α]
-
-lemma measurable_cSup {ι} {f : ι → δ → α} {s : set ι} (hs : s.countable)
-  (hf : ∀ i, measurable (f i)) (bdd : ∀ x, bdd_above ((λ i, f i x) '' s)) :
-  measurable (λ x, Sup ((λ i, f i x) '' s)) :=
-begin
-  cases eq_empty_or_nonempty s with h2s h2s,
-  { simp [h2s, measurable_const] },
-  { apply measurable_of_Iic, intro y,
-    simp_rw [preimage, mem_Iic, cSup_le_iff (bdd _) (h2s.image _), ball_image_iff, set_of_forall],
-    exact measurable_set.bInter hs (λ i hi, measurable_set_le (hf i) measurable_const) }
-end
-
-end conditionally_complete_linear_order
-
-/-- Convert a `homeomorph` to a `measurable_equiv`. -/
-def homemorph.to_measurable_equiv (h : α ≃ₜ β) : α ≃ᵐ β :=
-{ to_equiv := h.to_equiv,
-  measurable_to_fun := h.continuous_to_fun.measurable,
-  measurable_inv_fun := h.continuous_inv_fun.measurable }
-
-protected lemma is_finite_measure_on_compacts.map
-  {α : Type*} {m0 : measurable_space α} [topological_space α] [opens_measurable_space α]
-  {β : Type*} [measurable_space β] [topological_space β] [borel_space β]
-  [t2_space β] (μ : measure α) [is_finite_measure_on_compacts μ] (f : α ≃ₜ β) :
-  is_finite_measure_on_compacts (measure.map f μ) :=
-⟨begin
-  assume K hK,
-  rw [measure.map_apply f.measurable hK.measurable_set],
-  apply is_compact.measure_lt_top,
-  rwa f.compact_preimage
-end⟩
-
-end borel_space
-
-instance empty.borel_space : borel_space empty := ⟨borel_eq_top_of_discrete.symm⟩
-instance unit.borel_space : borel_space unit := ⟨borel_eq_top_of_discrete.symm⟩
-instance bool.borel_space : borel_space bool := ⟨borel_eq_top_of_discrete.symm⟩
-instance nat.borel_space : borel_space ℕ := ⟨borel_eq_top_of_discrete.symm⟩
-instance int.borel_space : borel_space ℤ := ⟨borel_eq_top_of_discrete.symm⟩
-instance rat.borel_space : borel_space ℚ := ⟨borel_eq_top_of_encodable.symm⟩
-
-@[priority 900]
-instance is_R_or_C.measurable_space {𝕜 : Type*} [is_R_or_C 𝕜] : measurable_space 𝕜 := borel 𝕜
-@[priority 900]
-instance is_R_or_C.borel_space {𝕜 : Type*} [is_R_or_C 𝕜] : borel_space 𝕜 := ⟨rfl⟩
-
-/- Instances on `real` and `complex` are special cases of `is_R_or_C` but without these instances,
-Lean fails to prove `borel_space (ι → ℝ)`, so we leave them here. -/
-
-instance real.measurable_space : measurable_space ℝ := borel ℝ
-instance real.borel_space : borel_space ℝ := ⟨rfl⟩
-
-instance nnreal.measurable_space : measurable_space ℝ≥0 := subtype.measurable_space
-instance nnreal.borel_space : borel_space ℝ≥0 := subtype.borel_space _
-
-instance ennreal.measurable_space : measurable_space ℝ≥0∞ := borel ℝ≥0∞
-instance ennreal.borel_space : borel_space ℝ≥0∞ := ⟨rfl⟩
-
-instance ereal.measurable_space : measurable_space ereal := borel ereal
-instance ereal.borel_space : borel_space ereal := ⟨rfl⟩
-
-instance complex.measurable_space : measurable_space ℂ := borel ℂ
-instance complex.borel_space : borel_space ℂ := ⟨rfl⟩
-
-/-- One can cut out `ℝ≥0∞` into the sets `{0}`, `Ico (t^n) (t^(n+1))` for `n : ℤ` and `{∞}`. This
-gives a way to compute the measure of a set in terms of sets on which a given function `f` does not
-fluctuate by more than `t`. -/
-lemma measure_eq_measure_preimage_add_measure_tsum_Ico_zpow [measurable_space α] (μ : measure α)
-  {f : α → ℝ≥0∞} (hf : measurable f) {s : set α} (hs : measurable_set s) {t : ℝ≥0} (ht : 1 < t) :
-  μ s = μ (s ∩ f⁻¹' {0}) + μ (s ∩ f⁻¹' {∞}) + ∑' (n : ℤ), μ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :=
-begin
-  have A : μ s = μ (s ∩ f⁻¹' {0}) + μ (s ∩ f⁻¹' (Ioi 0)),
-  { rw ← measure_union,
-    { congr' 1,
-      ext x,
-      have : 0 = f x ∨ 0 < f x := eq_or_lt_of_le bot_le,
-      rw eq_comm at this,
-      simp only [←and_or_distrib_left, this, mem_singleton_iff, mem_inter_eq, and_true,
-        mem_union_eq, mem_Ioi, mem_preimage], },
-    { apply disjoint_left.2 (λ x hx h'x, _),
-      have : 0 < f x := h'x.2,
-      exact lt_irrefl 0 (this.trans_le hx.2.le) },
-    { exact hs.inter (hf measurable_set_Ioi) } },
-  have B : μ (s ∩ f⁻¹' (Ioi 0)) = μ (s ∩ f⁻¹' {∞}) + μ (s ∩ f⁻¹' (Ioo 0 ∞)),
-  { rw ← measure_union,
-    { rw ← inter_union_distrib_left,
-      congr,
-      ext x,
-      simp only [mem_singleton_iff, mem_union_eq, mem_Ioo, mem_Ioi, mem_preimage],
-      have H : f x = ∞ ∨ f x < ∞ := eq_or_lt_of_le le_top,
-      cases H,
-      { simp only [H, eq_self_iff_true, or_false, with_top.zero_lt_top, not_top_lt, and_false] },
-      { simp only [H, H.ne, and_true, false_or] } },
-    { apply disjoint_left.2 (λ x hx h'x, _),
-      have : f x < ∞ := h'x.2.2,
-      exact lt_irrefl _ (this.trans_le (le_of_eq hx.2.symm)) },
-    { exact hs.inter (hf measurable_set_Ioo) } },
-  have C : μ (s ∩ f⁻¹' (Ioo 0 ∞)) = ∑' (n : ℤ), μ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))),
-  { rw [← measure_Union, ennreal.Ioo_zero_top_eq_Union_Ico_zpow (ennreal.one_lt_coe_iff.2 ht)
-         ennreal.coe_ne_top, preimage_Union, inter_Union],
-    { assume i j,
-      simp only [function.on_fun],
-      wlog h : i ≤ j := le_total i j using [i j, j i] tactic.skip,
-      { assume hij,
-        replace hij : i + 1 ≤ j := lt_of_le_of_ne h hij,
-        apply disjoint_left.2 (λ x hx h'x, lt_irrefl (f x) _),
-        calc f x < t ^ (i + 1) : hx.2.2
-        ... ≤ t ^ j : ennreal.zpow_le_of_le (ennreal.one_le_coe_iff.2 ht.le) hij
-        ... ≤ f x : h'x.2.1 },
-      { assume hij,
-        rw disjoint.comm,
-        exact this hij.symm } },
-    { assume n,
-      exact hs.inter (hf measurable_set_Ico) } },
-  rw [A, B, C, add_assoc],
-end
-
-section metric_space
-
-variables [metric_space α] [measurable_space α] [opens_measurable_space α]
-variables [measurable_space β] {x : α} {ε : ℝ}
-
-open metric
-
-@[measurability]
-lemma measurable_set_ball : measurable_set (metric.ball x ε) :=
-metric.is_open_ball.measurable_set
-
-@[measurability]
-lemma measurable_set_closed_ball : measurable_set (metric.closed_ball x ε) :=
-metric.is_closed_ball.measurable_set
-
-@[measurability]
-lemma measurable_inf_dist {s : set α} : measurable (λ x, inf_dist x s) :=
-(continuous_inf_dist_pt s).measurable
-
-@[measurability]
-lemma measurable.inf_dist {f : β → α} (hf : measurable f) {s : set α} :
-  measurable (λ x, inf_dist (f x) s) :=
-measurable_inf_dist.comp hf
-
-@[measurability]
-lemma measurable_inf_nndist {s : set α} : measurable (λ x, inf_nndist x s) :=
-(continuous_inf_nndist_pt s).measurable
-
-@[measurability]
-lemma measurable.inf_nndist {f : β → α} (hf : measurable f) {s : set α} :
-  measurable (λ x, inf_nndist (f x) s) :=
-measurable_inf_nndist.comp hf
-
-section
-variables [second_countable_topology α]
-
-@[measurability]
-lemma measurable_dist : measurable (λ p : α × α, dist p.1 p.2) :=
-continuous_dist.measurable
-
-@[measurability]
-lemma measurable.dist {f g : β → α} (hf : measurable f) (hg : measurable g) :
-  measurable (λ b, dist (f b) (g b)) :=
-(@continuous_dist α _).measurable2 hf hg
-
-@[measurability]
-lemma measurable_nndist : measurable (λ p : α × α, nndist p.1 p.2) :=
-continuous_nndist.measurable
-
-@[measurability]
-lemma measurable.nndist {f g : β → α} (hf : measurable f) (hg : measurable g) :
-  measurable (λ b, nndist (f b) (g b)) :=
-(@continuous_nndist α _).measurable2 hf hg
-
-end
-
-/-- If a set has a closed thickening with finite measure, then the measure of its `r`-closed
-thickenings converges to the measure of its closure as `r` tends to `0`. -/
-lemma tendsto_measure_cthickening {μ : measure α} {s : set α}
-  (hs : ∃ R > 0, μ (cthickening R s) ≠ ∞) :
-  tendsto (λ r, μ (cthickening r s)) (𝓝 0) (𝓝 (μ (closure s))) :=
-begin
-  have A : tendsto (λ r, μ (cthickening r s)) (𝓝[Ioi 0] 0) (𝓝 (μ (closure s))),
-  { rw closure_eq_Inter_cthickening,
-    exact tendsto_measure_bInter_gt (λ r hr, is_closed_cthickening.measurable_set)
-      (λ i j ipos ij, cthickening_mono ij _) hs },
-  have B : tendsto (λ r, μ (cthickening r s)) (𝓝[Iic 0] 0) (𝓝 (μ (closure s))),
-  { apply tendsto.congr' _ tendsto_const_nhds,
-    filter_upwards [self_mem_nhds_within] with _ hr,
-    rw cthickening_of_nonpos hr, },
-  convert B.sup A,
-  exact (nhds_left_sup_nhds_right' 0).symm,
-end
-
-/-- If a closed set has a closed thickening with finite measure, then the measure of its `r`-closed
-thickenings converges to its measure as `r` tends to `0`. -/
-lemma tendsto_measure_cthickening_of_is_closed {μ : measure α} {s : set α}
-  (hs : ∃ R > 0, μ (cthickening R s) ≠ ∞) (h's : is_closed s) :
-  tendsto (λ r, μ (cthickening r s)) (𝓝 0) (𝓝 (μ s)) :=
-begin
-  convert tendsto_measure_cthickening hs,
-  exact h's.closure_eq.symm
-end
-
-/-- Given a compact set in a proper space, the measure of its `r`-closed thickenings converges to
-its measure as `r` tends to `0`. -/
-lemma tendsto_measure_cthickening_of_is_compact [proper_space α] {μ : measure α}
-  [is_finite_measure_on_compacts μ] {s : set α} (hs : is_compact s) :
-  tendsto (λ r, μ (cthickening r s)) (𝓝 0) (𝓝 (μ s)) :=
-tendsto_measure_cthickening_of_is_closed
-  ⟨1, zero_lt_one, (bounded.measure_lt_top hs.bounded.cthickening).ne⟩ hs.is_closed
-
-end metric_space
-
-section emetric_space
-
-variables [emetric_space α] [measurable_space α] [opens_measurable_space α]
-variables [measurable_space β] {x : α} {ε : ℝ≥0∞}
-
-open emetric
-
-@[measurability]
-lemma measurable_set_eball : measurable_set (emetric.ball x ε) :=
-emetric.is_open_ball.measurable_set
-
-@[measurability]
-lemma measurable_edist_right : measurable (edist x) :=
-(continuous_const.edist continuous_id).measurable
-
-@[measurability]
-lemma measurable_edist_left : measurable (λ y, edist y x) :=
-(continuous_id.edist continuous_const).measurable
-
-@[measurability]
-lemma measurable_inf_edist {s : set α} : measurable (λ x, inf_edist x s) :=
-continuous_inf_edist.measurable
-
-@[measurability]
-lemma measurable.inf_edist {f : β → α} (hf : measurable f) {s : set α} :
-  measurable (λ x, inf_edist (f x) s) :=
-measurable_inf_edist.comp hf
-
-variables [second_countable_topology α]
-
-@[measurability]
-lemma measurable_edist : measurable (λ p : α × α, edist p.1 p.2) :=
-continuous_edist.measurable
-
-@[measurability]
-lemma measurable.edist {f g : β → α} (hf : measurable f) (hg : measurable g) :
-  measurable (λ b, edist (f b) (g b)) :=
-(@continuous_edist α _).measurable2 hf hg
-
-@[measurability]
-lemma ae_measurable.edist {f g : β → α} {μ : measure β}
-  (hf : ae_measurable f μ) (hg : ae_measurable g μ) : ae_measurable (λ a, edist (f a) (g a)) μ :=
-(@continuous_edist α _).ae_measurable2 hf hg
-
-end emetric_space
-
-namespace real
-open measurable_space measure_theory
-
-lemma borel_eq_generate_from_Ioo_rat :
-  borel ℝ = generate_from (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
-is_topological_basis_Ioo_rat.borel_eq_generate_from
-
-lemma is_pi_system_Ioo_rat : @is_pi_system ℝ (⋃ (a b : ℚ) (h : a < b), {Ioo a b})  :=
-begin
-  convert is_pi_system_Ioo (coe : ℚ → ℝ) (coe : ℚ → ℝ),
-  ext x,
-  simp [eq_comm]
-end
-
-/-- The intervals `(-(n + 1), (n + 1))` form a finite spanning sets in the set of open intervals
-with rational endpoints for a locally finite measure `μ` on `ℝ`. -/
-def finite_spanning_sets_in_Ioo_rat (μ : measure ℝ) [is_locally_finite_measure μ] :
-  μ.finite_spanning_sets_in (⋃ (a b : ℚ) (h : a < b), {Ioo a b}) :=
-{ set := λ n, Ioo (-(n + 1)) (n + 1),
-  set_mem := λ n,
-    begin
-      simp only [mem_Union, mem_singleton_iff],
-      refine ⟨-(n + 1), n + 1, _, by norm_cast⟩,
-      exact (neg_nonpos.2 (@nat.cast_nonneg ℚ _ (n + 1))).trans_lt n.cast_add_one_pos
-    end,
-  finite := λ n, measure_Ioo_lt_top,
-  spanning := Union_eq_univ_iff.2 $ λ x,
-    ⟨⌊|x|⌋₊, neg_lt.1 ((neg_le_abs_self x).trans_lt (nat.lt_floor_add_one _)),
-      (le_abs_self x).trans_lt (nat.lt_floor_add_one _)⟩ }
-
-lemma measure_ext_Ioo_rat {μ ν : measure ℝ} [is_locally_finite_measure μ]
-  (h : ∀ a b : ℚ, μ (Ioo a b) = ν (Ioo a b)) : μ = ν :=
-(finite_spanning_sets_in_Ioo_rat μ).ext borel_eq_generate_from_Ioo_rat is_pi_system_Ioo_rat $
-  by { simp only [mem_Union, mem_singleton_iff], rintro _ ⟨a, b, -, rfl⟩, apply h }
-
-lemma borel_eq_generate_from_Iio_rat :
-  borel ℝ = generate_from (⋃ a : ℚ, {Iio a}) :=
-begin
-  let g : measurable_space ℝ := generate_from (⋃ a : ℚ, {Iio a}),
-  refine le_antisymm _ _,
-  { rw borel_eq_generate_from_Ioo_rat,
-    refine generate_from_le (λ t, _),
-    simp only [mem_Union, mem_singleton_iff], rintro ⟨a, b, h, rfl⟩,
-    rw (set.ext (λ x, _) : Ioo (a : ℝ) b = (⋃c>a, (Iio c)ᶜ) ∩ Iio b),
-    { have hg : ∀ q : ℚ, g.measurable_set' (Iio q) :=
-        λ q, generate_measurable.basic (Iio q) (by simp),
-      refine @measurable_set.inter _ g _ _ _ (hg _),
-      refine @measurable_set.bUnion _ _ g _ _ (countable_encodable _) (λ c h, _),
-      exact @measurable_set.compl _ _ g (hg _) },
-    { suffices : x < ↑b → (↑a < x ↔ ∃ (i : ℚ), a < i ∧ ↑i ≤ x), by simpa,
-      refine λ _, ⟨λ h, _, λ ⟨i, hai, hix⟩, (rat.cast_lt.2 hai).trans_le hix⟩,
-      rcases exists_rat_btwn h with ⟨c, ac, cx⟩,
-      exact ⟨c, rat.cast_lt.1 ac, cx.le⟩ } },
-  { refine measurable_space.generate_from_le (λ _, _),
-    simp only [mem_Union, mem_singleton_iff], rintro ⟨r, rfl⟩, exact measurable_set_Iio }
-end
-
-end real
-
-variable [measurable_space α]
-
-@[measurability]
-lemma measurable_real_to_nnreal : measurable (real.to_nnreal) :=
-continuous_real_to_nnreal.measurable
-
-@[measurability]
-lemma measurable.real_to_nnreal {f : α → ℝ} (hf : measurable f) :
-  measurable (λ x, real.to_nnreal (f x)) :=
-measurable_real_to_nnreal.comp hf
-
-@[measurability]
-lemma ae_measurable.real_to_nnreal {f : α → ℝ} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, real.to_nnreal (f x)) μ :=
-measurable_real_to_nnreal.comp_ae_measurable hf
-
-@[measurability]
-lemma measurable_coe_nnreal_real : measurable (coe : ℝ≥0 → ℝ) :=
-nnreal.continuous_coe.measurable
-
-@[measurability]
-lemma measurable.coe_nnreal_real {f : α → ℝ≥0} (hf : measurable f) :
-  measurable (λ x, (f x : ℝ)) :=
-measurable_coe_nnreal_real.comp hf
-
-@[measurability]
-lemma ae_measurable.coe_nnreal_real {f : α → ℝ≥0} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, (f x : ℝ)) μ :=
-measurable_coe_nnreal_real.comp_ae_measurable hf
-
-@[measurability]
-lemma measurable_coe_nnreal_ennreal : measurable (coe : ℝ≥0 → ℝ≥0∞) :=
-ennreal.continuous_coe.measurable
-
-@[measurability]
-lemma measurable.coe_nnreal_ennreal {f : α → ℝ≥0} (hf : measurable f) :
-  measurable (λ x, (f x : ℝ≥0∞)) :=
-ennreal.continuous_coe.measurable.comp hf
-
-@[measurability]
-lemma ae_measurable.coe_nnreal_ennreal {f : α → ℝ≥0} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, (f x : ℝ≥0∞)) μ :=
-ennreal.continuous_coe.measurable.comp_ae_measurable hf
-
-@[measurability]
-lemma measurable.ennreal_of_real {f : α → ℝ} (hf : measurable f) :
-  measurable (λ x, ennreal.of_real (f x)) :=
-ennreal.continuous_of_real.measurable.comp hf
-
-/-- The set of finite `ℝ≥0∞` numbers is `measurable_equiv` to `ℝ≥0`. -/
-def measurable_equiv.ennreal_equiv_nnreal : {r : ℝ≥0∞ | r ≠ ∞} ≃ᵐ ℝ≥0 :=
-ennreal.ne_top_homeomorph_nnreal.to_measurable_equiv
-
-namespace ennreal
-
-lemma measurable_of_measurable_nnreal {f : ℝ≥0∞ → α}
-  (h : measurable (λ p : ℝ≥0, f p)) : measurable f :=
-measurable_of_measurable_on_compl_singleton ∞
-  (measurable_equiv.ennreal_equiv_nnreal.symm.measurable_comp_iff.1 h)
-
-/-- `ℝ≥0∞` is `measurable_equiv` to `ℝ≥0 ⊕ unit`. -/
-def ennreal_equiv_sum : ℝ≥0∞ ≃ᵐ ℝ≥0 ⊕ unit :=
-{ measurable_to_fun  := measurable_of_measurable_nnreal measurable_inl,
-  measurable_inv_fun := measurable_sum measurable_coe_nnreal_ennreal
-    (@measurable_const ℝ≥0∞ unit _ _ ∞),
-  .. equiv.option_equiv_sum_punit ℝ≥0 }
-
-open function (uncurry)
-
-lemma measurable_of_measurable_nnreal_prod [measurable_space β] [measurable_space γ]
-  {f : ℝ≥0∞ × β → γ} (H₁ : measurable (λ p : ℝ≥0 × β, f (p.1, p.2)))
-  (H₂ : measurable (λ x, f (∞, x))) :
-  measurable f :=
-let e : ℝ≥0∞ × β ≃ᵐ ℝ≥0 × β ⊕ unit × β :=
-  (ennreal_equiv_sum.prod_congr (measurable_equiv.refl β)).trans
-    (measurable_equiv.sum_prod_distrib _ _ _) in
-e.symm.measurable_comp_iff.1 $ measurable_sum H₁ (H₂.comp measurable_id.snd)
-
-lemma measurable_of_measurable_nnreal_nnreal [measurable_space β]
-  {f : ℝ≥0∞ × ℝ≥0∞ → β} (h₁ : measurable (λ p : ℝ≥0 × ℝ≥0, f (p.1, p.2)))
-  (h₂ : measurable (λ r : ℝ≥0, f (∞, r))) (h₃ : measurable (λ r : ℝ≥0, f (r, ∞))) :
-  measurable f :=
-measurable_of_measurable_nnreal_prod
-  (measurable_swap_iff.1 $ measurable_of_measurable_nnreal_prod (h₁.comp measurable_swap) h₃)
-  (measurable_of_measurable_nnreal h₂)
-
-@[measurability]
-lemma measurable_of_real : measurable ennreal.of_real :=
-ennreal.continuous_of_real.measurable
-
-@[measurability]
-lemma measurable_to_real : measurable ennreal.to_real :=
-ennreal.measurable_of_measurable_nnreal measurable_coe_nnreal_real
-
-@[measurability]
-lemma measurable_to_nnreal : measurable ennreal.to_nnreal :=
-ennreal.measurable_of_measurable_nnreal measurable_id
-
-instance : has_measurable_mul₂ ℝ≥0∞ :=
-begin
-  refine ⟨measurable_of_measurable_nnreal_nnreal _ _ _⟩,
-  { simp only [← ennreal.coe_mul, measurable_mul.coe_nnreal_ennreal] },
-  { simp only [ennreal.top_mul, ennreal.coe_eq_zero],
-    exact measurable_const.piecewise (measurable_set_singleton _) measurable_const },
-  { simp only [ennreal.mul_top, ennreal.coe_eq_zero],
-    exact measurable_const.piecewise (measurable_set_singleton _) measurable_const }
-end
-
-instance : has_measurable_sub₂ ℝ≥0∞ :=
-⟨by apply measurable_of_measurable_nnreal_nnreal;
-  simp [← with_top.coe_sub, continuous_sub.measurable.coe_nnreal_ennreal]⟩
-
-instance : has_measurable_inv ℝ≥0∞ := ⟨continuous_inv.measurable⟩
-
-end ennreal
-
-@[measurability]
-lemma measurable.ennreal_to_nnreal {f : α → ℝ≥0∞} (hf : measurable f) :
-  measurable (λ x, (f x).to_nnreal) :=
-ennreal.measurable_to_nnreal.comp hf
-
-@[measurability]
-lemma ae_measurable.ennreal_to_nnreal {f : α → ℝ≥0∞} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, (f x).to_nnreal) μ :=
-ennreal.measurable_to_nnreal.comp_ae_measurable hf
-
-lemma measurable_coe_nnreal_ennreal_iff {f : α → ℝ≥0} :
-  measurable (λ x, (f x : ℝ≥0∞)) ↔ measurable f :=
-⟨λ h, h.ennreal_to_nnreal, λ h, h.coe_nnreal_ennreal⟩
-
-@[measurability]
-lemma measurable.ennreal_to_real {f : α → ℝ≥0∞} (hf : measurable f) :
-  measurable (λ x, ennreal.to_real (f x)) :=
-ennreal.measurable_to_real.comp hf
-
-@[measurability]
-lemma ae_measurable.ennreal_to_real {f : α → ℝ≥0∞} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, ennreal.to_real (f x)) μ :=
-ennreal.measurable_to_real.comp_ae_measurable hf
-
-/-- note: `ℝ≥0∞` can probably be generalized in a future version of this lemma. -/
-@[measurability]
-lemma measurable.ennreal_tsum {ι} [encodable ι] {f : ι → α → ℝ≥0∞} (h : ∀ i, measurable (f i)) :
-  measurable (λ x, ∑' i, f i x) :=
-by { simp_rw [ennreal.tsum_eq_supr_sum], apply measurable_supr,
-  exact λ s, s.measurable_sum (λ i _, h i) }
-
-@[measurability]
-lemma measurable.ennreal_tsum' {ι} [encodable ι] {f : ι → α → ℝ≥0∞} (h : ∀ i, measurable (f i)) :
-  measurable (∑' i, f i) :=
-begin
-  convert measurable.ennreal_tsum h,
-  ext1 x,
-  exact tsum_apply (pi.summable.2 (λ _, ennreal.summable)),
-end
-
-@[measurability]
-lemma measurable.nnreal_tsum {ι} [encodable ι] {f : ι → α → ℝ≥0} (h : ∀ i, measurable (f i)) :
-  measurable (λ x, ∑' i, f i x) :=
-begin
-  simp_rw [nnreal.tsum_eq_to_nnreal_tsum],
-  exact (measurable.ennreal_tsum (λ i, (h i).coe_nnreal_ennreal)).ennreal_to_nnreal,
-end
-
-@[measurability]
-lemma ae_measurable.ennreal_tsum {ι} [encodable ι] {f : ι → α → ℝ≥0∞} {μ : measure α}
-  (h : ∀ i, ae_measurable (f i) μ) :
-  ae_measurable (λ x, ∑' i, f i x) μ :=
-by { simp_rw [ennreal.tsum_eq_supr_sum], apply ae_measurable_supr,
-  exact λ s, finset.ae_measurable_sum s (λ i _, h i) }
-
-@[measurability]
-lemma measurable_coe_real_ereal : measurable (coe : ℝ → ereal) :=
-continuous_coe_real_ereal.measurable
-
-@[measurability]
-lemma measurable.coe_real_ereal {f : α → ℝ} (hf : measurable f) :
-  measurable (λ x, (f x : ereal)) :=
-measurable_coe_real_ereal.comp hf
-
-@[measurability]
-lemma ae_measurable.coe_real_ereal {f : α → ℝ} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, (f x : ereal)) μ :=
-measurable_coe_real_ereal.comp_ae_measurable hf
-
-/-- The set of finite `ereal` numbers is `measurable_equiv` to `ℝ`. -/
-def measurable_equiv.ereal_equiv_real : ({⊥, ⊤} : set ereal).compl ≃ᵐ ℝ :=
-ereal.ne_bot_top_homeomorph_real.to_measurable_equiv
-
-lemma ereal.measurable_of_measurable_real {f : ereal → α}
-  (h : measurable (λ p : ℝ, f p)) : measurable f :=
-measurable_of_measurable_on_compl_finite {⊥, ⊤} (by simp)
-  (measurable_equiv.ereal_equiv_real.symm.measurable_comp_iff.1 h)
-
-@[measurability]
-lemma measurable_ereal_to_real : measurable ereal.to_real :=
-ereal.measurable_of_measurable_real (by simpa using measurable_id)
-
-@[measurability]
-lemma measurable.ereal_to_real {f : α → ereal} (hf : measurable f) :
-  measurable (λ x, (f x).to_real) :=
-measurable_ereal_to_real.comp hf
-
-@[measurability]
-lemma ae_measurable.ereal_to_real {f : α → ereal} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, (f x).to_real) μ :=
-measurable_ereal_to_real.comp_ae_measurable hf
-
-@[measurability]
-lemma measurable_coe_ennreal_ereal : measurable (coe : ℝ≥0∞ → ereal) :=
-continuous_coe_ennreal_ereal.measurable
-
-@[measurability]
-lemma measurable.coe_ereal_ennreal {f : α → ℝ≥0∞} (hf : measurable f) :
-  measurable (λ x, (f x : ereal)) :=
-measurable_coe_ennreal_ereal.comp hf
-
-@[measurability]
-lemma ae_measurable.coe_ereal_ennreal {f : α → ℝ≥0∞} {μ : measure α} (hf : ae_measurable f μ) :
-  ae_measurable (λ x, (f x : ereal)) μ :=
-measurable_coe_ennreal_ereal.comp_ae_measurable hf
-
-section normed_group
-
-variables [normed_group α] [opens_measurable_space α] [measurable_space β]
-
-@[measurability]
-lemma measurable_norm : measurable (norm : α → ℝ) :=
-continuous_norm.measurable
-
-@[measurability]
-lemma measurable.norm {f : β → α} (hf : measurable f) : measurable (λ a, norm (f a)) :=
-measurable_norm.comp hf
-
-@[measurability]
-lemma ae_measurable.norm {f : β → α} {μ : measure β} (hf : ae_measurable f μ) :
-  ae_measurable (λ a, norm (f a)) μ :=
-measurable_norm.comp_ae_measurable hf
-
-@[measurability]
-lemma measurable_nnnorm : measurable (nnnorm : α → ℝ≥0) :=
-continuous_nnnorm.measurable
-
-@[measurability]
-lemma measurable.nnnorm {f : β → α} (hf : measurable f) : measurable (λ a, ∥f a∥₊) :=
-measurable_nnnorm.comp hf
-
-@[measurability]
-lemma ae_measurable.nnnorm {f : β → α} {μ : measure β} (hf : ae_measurable f μ) :
-  ae_measurable (λ a, ∥f a∥₊) μ :=
-measurable_nnnorm.comp_ae_measurable hf
-
-@[measurability]
-lemma measurable_ennnorm : measurable (λ x : α, (∥x∥₊ : ℝ≥0∞)) :=
-measurable_nnnorm.coe_nnreal_ennreal
-
-@[measurability]
-lemma measurable.ennnorm {f : β → α} (hf : measurable f) :
-  measurable (λ a, (∥f a∥₊ : ℝ≥0∞)) :=
-hf.nnnorm.coe_nnreal_ennreal
-
-@[measurability]
-lemma ae_measurable.ennnorm {f : β → α} {μ : measure β} (hf : ae_measurable f μ) :
-  ae_measurable (λ a, (∥f a∥₊ : ℝ≥0∞)) μ :=
-measurable_ennnorm.comp_ae_measurable hf
-
-end normed_group
-
-section limits
-
-variables [measurable_space β] [metric_space β] [borel_space β]
-
-open metric
-
-/-- A limit (over a general filter) of measurable `ℝ≥0∞` valued functions is measurable. -/
-lemma measurable_of_tendsto_ennreal' {ι} {f : ι → α → ℝ≥0∞} {g : α → ℝ≥0∞} (u : filter ι)
-  [ne_bot u] [is_countably_generated u] (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
-  measurable g :=
-begin
-  rcases u.exists_seq_tendsto with ⟨x, hx⟩,
-  rw [tendsto_pi_nhds] at lim,
-  have : (λ y, liminf at_top (λ n, (f (x n) y : ℝ≥0∞))) = g :=
-    by { ext1 y, exact ((lim y).comp hx).liminf_eq, },
-  rw ← this,
-  show measurable (λ y, liminf at_top (λ n, (f (x n) y : ℝ≥0∞))),
-  exact measurable_liminf (λ n, hf (x n)),
-end
-
-/-- A sequential limit of measurable `ℝ≥0∞` valued functions is measurable. -/
-lemma measurable_of_tendsto_ennreal {f : ℕ → α → ℝ≥0∞} {g : α → ℝ≥0∞}
-  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) : measurable g :=
-measurable_of_tendsto_ennreal' at_top hf lim
-
-/-- A limit (over a general filter) of measurable `ℝ≥0` valued functions is measurable. -/
-lemma measurable_of_tendsto_nnreal' {ι} {f : ι → α → ℝ≥0} {g : α → ℝ≥0} (u : filter ι)
-  [ne_bot u] [is_countably_generated u] (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
-  measurable g :=
-begin
-  simp_rw [← measurable_coe_nnreal_ennreal_iff] at hf ⊢,
-  refine measurable_of_tendsto_ennreal' u hf _,
-  rw tendsto_pi_nhds at lim ⊢,
-  exact λ x, (ennreal.continuous_coe.tendsto (g x)).comp (lim x),
-end
-
-/-- A sequential limit of measurable `ℝ≥0` valued functions is measurable. -/
-lemma measurable_of_tendsto_nnreal {f : ℕ → α → ℝ≥0} {g : α → ℝ≥0}
-  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) : measurable g :=
-measurable_of_tendsto_nnreal' at_top hf lim
-
-/-- A limit (over a general filter) of measurable functions valued in a metric space is measurable.
--/
-lemma measurable_of_tendsto_metric' {ι} {f : ι → α → β} {g : α → β}
-  (u : filter ι) [ne_bot u] [is_countably_generated u]
-  (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
-  measurable g :=
-begin
-  apply measurable_of_is_closed', intros s h1s h2s h3s,
-  have : measurable (λ x, inf_nndist (g x) s),
-  { suffices : tendsto (λ i x, inf_nndist (f i x) s) u (𝓝 (λ x, inf_nndist (g x) s)),
-      from measurable_of_tendsto_nnreal' u (λ i, (hf i).inf_nndist) this,
-    rw [tendsto_pi_nhds] at lim ⊢, intro x,
-    exact ((continuous_inf_nndist_pt s).tendsto (g x)).comp (lim x) },
-  have h4s : g ⁻¹' s = (λ x, inf_nndist (g x) s) ⁻¹' {0},
-  { ext x, simp [h1s, ← h1s.mem_iff_inf_dist_zero h2s, ← nnreal.coe_eq_zero] },
-  rw [h4s], exact this (measurable_set_singleton 0),
-end
-
-/-- A sequential limit of measurable functions valued in a metric space is measurable. -/
-lemma measurable_of_tendsto_metric {f : ℕ → α → β} {g : α → β}
-  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) :
-  measurable g :=
-measurable_of_tendsto_metric' at_top hf lim
-
-/-- A limit (over a general filter) of measurable functions valued in a metrizable space is
-measurable. -/
-lemma measurable_of_tendsto_metrizable'
-  {β : Type*} [topological_space β] [metrizable_space β]
-  [measurable_space β] [borel_space β] {ι} {f : ι → α → β} {g : α → β}
-  (u : filter ι) [ne_bot u] [is_countably_generated u]
-  (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
-  measurable g :=
-begin
-  letI : metric_space β := metrizable_space_metric β,
-  exact measurable_of_tendsto_metric' u hf lim
-end
-
-/-- A sequential limit of measurable functions valued in a metrizable space is measurable. -/
-lemma measurable_of_tendsto_metrizable {β : Type*} [topological_space β] [metrizable_space β]
-  [measurable_space β] [borel_space β] {f : ℕ → α → β} {g : α → β}
-  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) :
-  measurable g :=
-measurable_of_tendsto_metrizable' at_top hf lim
-
-lemma ae_measurable_of_tendsto_metric_ae {ι : Type*}
-  {μ : measure α} {f : ι → α → β} {g : α → β}
-  (u : filter ι) [hu : ne_bot u] [is_countably_generated u]
-  (hf : ∀ n, ae_measurable (f n) μ) (h_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, f n x) u (𝓝 (g x))) :
-  ae_measurable g μ :=
-begin
-  rcases u.exists_seq_tendsto with ⟨v, hv⟩,
-  have h'f : ∀ n, ae_measurable (f (v n)) μ := λ n, hf (v n),
-  set p : α → (ℕ → β) → Prop := λ x f', tendsto (λ n, f' n) at_top (𝓝 (g x)),
-  have hp : ∀ᵐ x ∂μ, p x (λ n, f (v n) x),
-    by filter_upwards [h_tendsto] with x hx using hx.comp hv,
-  set ae_seq_lim := λ x, ite (x ∈ ae_seq_set h'f p) (g x) (⟨f (v 0) x⟩ : nonempty β).some with hs,
-  refine ⟨ae_seq_lim,
-    measurable_of_tendsto_metric' at_top (@ae_seq.measurable α β _ _ _ (λ n x, f (v n) x) μ h'f p)
-    (tendsto_pi_nhds.mpr (λ x, _)), _⟩,
-  { simp_rw [ae_seq, ae_seq_lim],
-    split_ifs with hx,
-    { simp_rw ae_seq.mk_eq_fun_of_mem_ae_seq_set h'f hx,
-      exact @ae_seq.fun_prop_of_mem_ae_seq_set α β _ _ _ _ _ _ h'f x hx, },
-    { exact tendsto_const_nhds } },
-  { exact (ite_ae_eq_of_measure_compl_zero g (λ x, (⟨f (v 0) x⟩ : nonempty β).some)
-      (ae_seq_set h'f p) (ae_seq.measure_compl_ae_seq_set_eq_zero h'f hp)).symm },
-end
-
-lemma ae_measurable_of_tendsto_metric_ae' {μ : measure α} {f : ℕ → α → β} {g : α → β}
-  (hf : ∀ n, ae_measurable (f n) μ)
-  (h_ae_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
-  ae_measurable g μ :=
-ae_measurable_of_tendsto_metric_ae at_top hf h_ae_tendsto
-
-lemma ae_measurable_of_unif_approx {μ : measure α} {g : α → β}
-  (hf : ∀ ε > (0 : ℝ), ∃ (f : α → β), ae_measurable f μ ∧ ∀ᵐ x ∂μ, dist (f x) (g x) ≤ ε) :
-  ae_measurable g μ :=
-begin
-  obtain ⟨u, u_anti, u_pos, u_lim⟩ :
-    ∃ (u : ℕ → ℝ), strict_anti u ∧ (∀ (n : ℕ), 0 < u n) ∧ tendsto u at_top (𝓝 0) :=
-      exists_seq_strict_anti_tendsto (0 : ℝ),
-  choose f Hf using λ (n : ℕ), hf (u n) (u_pos n),
-  have : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x)),
-  { have : ∀ᵐ x ∂ μ, ∀ n, dist (f n x) (g x) ≤ u n := ae_all_iff.2 (λ n, (Hf n).2),
-    filter_upwards [this],
-    assume x hx,
-    rw tendsto_iff_dist_tendsto_zero,
-    exact squeeze_zero (λ n, dist_nonneg) hx u_lim },
-  exact ae_measurable_of_tendsto_metric_ae' (λ n, (Hf n).1) this,
-end
-
-lemma measurable_of_tendsto_metric_ae {μ : measure α} [μ.is_complete] {f : ℕ → α → β} {g : α → β}
-  (hf : ∀ n, measurable (f n))
-  (h_ae_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
-  measurable g :=
-ae_measurable_iff_measurable.mp
-  (ae_measurable_of_tendsto_metric_ae' (λ i, (hf i).ae_measurable) h_ae_tendsto)
-
-lemma measurable_limit_of_tendsto_metric_ae {ι} [encodable ι] [nonempty ι] {μ : measure α}
-  {f : ι → α → β} {L : filter ι} [L.is_countably_generated] (hf : ∀ n, ae_measurable (f n) μ)
-  (h_ae_tendsto : ∀ᵐ x ∂μ, ∃ l : β, tendsto (λ n, f n x) L (𝓝 l)) :
-  ∃ (f_lim : α → β) (hf_lim_meas : measurable f_lim),
-    ∀ᵐ x ∂μ, tendsto (λ n, f n x) L (𝓝 (f_lim x)) :=
-begin
-  inhabit ι,
-  unfreezingI { rcases eq_or_ne L ⊥ with rfl | hL },
-  { exact ⟨(hf default).mk _, (hf default).measurable_mk,
-      eventually_of_forall $ λ x, tendsto_bot⟩ },
-  haveI : ne_bot L := ⟨hL⟩,
-  let p : α → (ι → β) → Prop := λ x f', ∃ l : β, tendsto (λ n, f' n) L (𝓝 l),
-  have hp_mem : ∀ x ∈ ae_seq_set hf p, p x (λ n, f n x),
-    from λ x hx, ae_seq.fun_prop_of_mem_ae_seq_set hf hx,
-  have h_ae_eq : ∀ᵐ x ∂μ, ∀ n, ae_seq hf p n x = f n x,
-    from ae_seq.ae_seq_eq_fun_ae hf h_ae_tendsto,
-  let f_lim : α → β := λ x, dite (x ∈ ae_seq_set hf p) (λ h, (hp_mem x h).some)
-    (λ h, (⟨f default x⟩ : nonempty β).some),
-  have hf_lim : ∀ x, tendsto (λ n, ae_seq hf p n x) L (𝓝 (f_lim x)),
-  { intros x,
-    simp only [f_lim, ae_seq],
-    split_ifs,
-    { refine (hp_mem x h).some_spec.congr (λ n, _),
-      exact (ae_seq.mk_eq_fun_of_mem_ae_seq_set hf h n).symm },
-    { exact tendsto_const_nhds, }, },
-  have h_ae_tendsto_f_lim : ∀ᵐ x ∂μ, tendsto (λ n, f n x) L (𝓝 (f_lim x)),
-    from h_ae_eq.mono (λ x hx, (hf_lim x).congr hx),
-  have h_f_lim_meas : measurable f_lim,
-    from measurable_of_tendsto_metric' L (ae_seq.measurable hf p)
-      (tendsto_pi_nhds.mpr (λ x, hf_lim x)),
-  exact ⟨f_lim, h_f_lim_meas, h_ae_tendsto_f_lim⟩,
-end
-
-end limits
-
-namespace continuous_linear_map
-
-variables {𝕜 : Type*} [normed_field 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E] [measurable_space E]
-variables [opens_measurable_space E]
-variables {F : Type*} [normed_group F] [normed_space 𝕜 F] [measurable_space F] [borel_space F]
-
-@[measurability]
-protected lemma measurable (L : E →L[𝕜] F) : measurable L :=
-L.continuous.measurable
-
-lemma measurable_comp (L : E →L[𝕜] F) {φ : α → E} (φ_meas : measurable φ) :
-  measurable (λ (a : α), L (φ a)) :=
-L.measurable.comp φ_meas
-
-end continuous_linear_map
-
-namespace continuous_linear_map
-
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
-          {F : Type*} [normed_group F] [normed_space 𝕜 F]
-
-instance : measurable_space (E →L[𝕜] F) := borel _
-
-instance : borel_space (E →L[𝕜] F) := ⟨rfl⟩
-
-@[measurability]
-lemma measurable_apply [measurable_space F] [borel_space F] (x : E) :
-  measurable (λ f : E →L[𝕜] F, f x) :=
-(apply 𝕜 F x).continuous.measurable
-
-@[measurability]
-lemma measurable_apply' [measurable_space E] [opens_measurable_space E]
-  [measurable_space F] [borel_space F] :
-  measurable (λ (x : E) (f : E →L[𝕜] F), f x) :=
-measurable_pi_lambda _ $ λ f, f.measurable
-
-@[measurability]
-lemma measurable_coe [measurable_space F] [borel_space F] :
-  measurable (λ (f : E →L[𝕜] F) (x : E), f x) :=
-measurable_pi_lambda _ measurable_apply
-
-end continuous_linear_map
-
-section continuous_linear_map_nondiscrete_normed_field
-
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E] [measurable_space E] [borel_space E]
-variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
-
-@[measurability]
-lemma measurable.apply_continuous_linear_map  {φ : α → F →L[𝕜] E} (hφ : measurable φ) (v : F) :
-  measurable (λ a, φ a v) :=
-(continuous_linear_map.apply 𝕜 E v).measurable.comp hφ
-
-@[measurability]
-lemma ae_measurable.apply_continuous_linear_map {φ : α → F →L[𝕜] E} {μ : measure α}
-  (hφ : ae_measurable φ μ) (v : F) : ae_measurable (λ a, φ a v) μ :=
-(continuous_linear_map.apply 𝕜 E v).measurable.comp_ae_measurable hφ
-
-end continuous_linear_map_nondiscrete_normed_field
-
-section normed_space
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [complete_space 𝕜] [measurable_space 𝕜]
-variables [borel_space 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E] [measurable_space E] [borel_space E]
-
-lemma measurable_smul_const {f : α → 𝕜} {c : E} (hc : c ≠ 0) :
-  measurable (λ x, f x • c) ↔ measurable f :=
-(closed_embedding_smul_left hc).measurable_embedding.measurable_comp_iff
-
-lemma ae_measurable_smul_const {f : α → 𝕜} {μ : measure α} {c : E} (hc : c ≠ 0) :
-  ae_measurable (λ x, f x • c) μ ↔ ae_measurable f μ :=
-(closed_embedding_smul_left hc).measurable_embedding.ae_measurable_comp_iff
-
-end normed_space
diff --git a/src/measure_theory/constructions/borel_space/basic.lean b/src/measure_theory/constructions/borel_space/basic.lean
new file mode 100644
index 0000000000000..95c59b3ffd372
--- /dev/null
+++ b/src/measure_theory/constructions/borel_space/basic.lean
@@ -0,0 +1,1905 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Yury Kudryashov
+-/
+import analysis.normed.group.basic
+import measure_theory.function.ae_measurable_sequence
+import measure_theory.group.arithmetic
+import measure_theory.lattice
+import measure_theory.measure.open_pos
+import topology.algebra.order.liminf_limsup
+import topology.continuous_function.basic
+import topology.instances.ereal
+import topology.metric_space.hausdorff_distance
+import topology.G_delta
+import topology.order.lattice
+import topology.semicontinuous
+
+/-!
+# Borel (measurable) space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `borel α` : the least `σ`-algebra that contains all open sets;
+* `class borel_space` : a space with `topological_space` and `measurable_space` structures
+  such that `‹measurable_space α› = borel α`;
+* `class opens_measurable_space` : a space with `topological_space` and `measurable_space`
+  structures such that all open sets are measurable; equivalently, `borel α ≤ ‹measurable_space α›`.
+* `borel_space` instances on `empty`, `unit`, `bool`, `nat`, `int`, `rat`;
+* `measurable` and `borel_space` instances on `ℝ`, `ℝ≥0`, `ℝ≥0∞`.
+
+## Main statements
+
+* `is_open.measurable_set`, `is_closed.measurable_set`: open and closed sets are measurable;
+* `continuous.measurable` : a continuous function is measurable;
+* `continuous.measurable2` : if `f : α → β` and `g : α → γ` are measurable and `op : β × γ → δ`
+  is continuous, then `λ x, op (f x, g y)` is measurable;
+* `measurable.add` etc : dot notation for arithmetic operations on `measurable` predicates,
+  and similarly for `dist` and `edist`;
+* `ae_measurable.add` : similar dot notation for almost everywhere measurable functions;
+* `measurable.ennreal*` : special cases for arithmetic operations on `ℝ≥0∞`.
+-/
+
+noncomputable theory
+
+open classical set filter measure_theory
+open_locale classical big_operators topology nnreal ennreal measure_theory
+
+universes u v w x y
+variables {α β γ γ₂ δ : Type*} {ι : Sort y} {s t u : set α}
+
+open measurable_space topological_space
+
+/-- `measurable_space` structure generated by `topological_space`. -/
+def borel (α : Type u) [topological_space α] : measurable_space α :=
+generate_from {s : set α | is_open s}
+
+theorem borel_anti : antitone (@borel α) :=
+λ _ _ h, measurable_space.generate_from_le $ λ s hs, generate_measurable.basic _ (h _ hs)
+
+lemma borel_eq_top_of_discrete [topological_space α] [discrete_topology α] :
+  borel α = ⊤ :=
+top_le_iff.1 $ λ s hs, generate_measurable.basic s (is_open_discrete s)
+
+lemma borel_eq_top_of_countable [topological_space α] [t1_space α] [countable α] :
+  borel α = ⊤ :=
+begin
+  refine (top_le_iff.1 $ λ s hs, bUnion_of_singleton s ▸ _),
+  apply measurable_set.bUnion s.to_countable,
+  intros x hx,
+  apply measurable_set.of_compl,
+  apply generate_measurable.basic,
+  exact is_closed_singleton.is_open_compl
+end
+
+lemma borel_eq_generate_from_of_subbasis {s : set (set α)}
+  [t : topological_space α] [second_countable_topology α] (hs : t = generate_from s) :
+  borel α = generate_from s :=
+le_antisymm
+  (generate_from_le $ assume u (hu : t.is_open u),
+    begin
+      rw [hs] at hu,
+      induction hu,
+      case generate_open.basic : u hu
+      { exact generate_measurable.basic u hu },
+      case generate_open.univ
+      { exact @measurable_set.univ α (generate_from s) },
+      case generate_open.inter : s₁ s₂ _ _ hs₁ hs₂
+      { exact @measurable_set.inter α (generate_from s) _ _ hs₁ hs₂ },
+      case generate_open.sUnion : f hf ih
+      { rcases is_open_sUnion_countable f (by rwa hs) with ⟨v, hv, vf, vu⟩,
+        rw ← vu,
+        exact @measurable_set.sUnion α (generate_from s) _ hv
+          (λ x xv, ih _ (vf xv)) }
+    end)
+  (generate_from_le $ assume u hu, generate_measurable.basic _ $
+    show t.is_open u, by rw [hs]; exact generate_open.basic _ hu)
+
+lemma topological_space.is_topological_basis.borel_eq_generate_from [topological_space α]
+  [second_countable_topology α] {s : set (set α)} (hs : is_topological_basis s) :
+  borel α = generate_from s :=
+borel_eq_generate_from_of_subbasis hs.eq_generate_from
+
+lemma is_pi_system_is_open [topological_space α] : is_pi_system (is_open : set α → Prop) :=
+λ s hs t ht hst, is_open.inter hs ht
+
+lemma borel_eq_generate_from_is_closed [topological_space α] :
+  borel α = generate_from {s | is_closed s} :=
+le_antisymm
+  (generate_from_le $ λ t ht, @measurable_set.of_compl α _ (generate_from {s | is_closed s})
+    (generate_measurable.basic _ $ is_closed_compl_iff.2 ht))
+  (generate_from_le $ λ t ht, @measurable_set.of_compl α _ (borel α)
+    (generate_measurable.basic _ $ is_open_compl_iff.2 ht))
+
+section order_topology
+
+variable (α)
+variables [topological_space α] [second_countable_topology α] [linear_order α] [order_topology α]
+
+lemma borel_eq_generate_from_Iio : borel α = generate_from (range Iio) :=
+begin
+  refine le_antisymm _ (generate_from_le _),
+  { rw borel_eq_generate_from_of_subbasis (@order_topology.topology_eq_generate_intervals α _ _ _),
+    letI : measurable_space α := measurable_space.generate_from (range Iio),
+    have H : ∀ a : α, measurable_set (Iio a) := λ a, generate_measurable.basic _ ⟨_, rfl⟩,
+    refine generate_from_le _, rintro _ ⟨a, rfl | rfl⟩; [skip, apply H],
+    by_cases h : ∃ a', ∀ b, a < b ↔ a' ≤ b,
+    { rcases h with ⟨a', ha'⟩,
+      rw (_ : Ioi a = (Iio a')ᶜ), { exact (H _).compl },
+      simp [set.ext_iff, ha'] },
+    { rcases is_open_Union_countable
+        (λ a' : {a' : α // a < a'}, {b | a'.1 < b})
+        (λ a', is_open_lt' _) with ⟨v, ⟨hv⟩, vu⟩,
+      simp [set.ext_iff] at vu,
+      have : Ioi a = ⋃ x : v, (Iio x.1.1)ᶜ,
+      { simp [set.ext_iff],
+        refine λ x, ⟨λ ax, _, λ ⟨a', ⟨h, av⟩, ax⟩, lt_of_lt_of_le h ax⟩,
+        rcases (vu x).2 _ with ⟨a', h₁, h₂⟩,
+        { exact ⟨a', h₁, le_of_lt h₂⟩ },
+        refine not_imp_comm.1 (λ h, _) h,
+        exact ⟨x, λ b, ⟨λ ab, le_of_not_lt (λ h', h ⟨b, ab, h'⟩),
+          lt_of_lt_of_le ax⟩⟩ },
+      rw this, resetI,
+      apply measurable_set.Union,
+      exact λ _, (H _).compl } },
+  { rw forall_range_iff,
+    intro a,
+    exact generate_measurable.basic _ is_open_Iio }
+end
+
+lemma borel_eq_generate_from_Ioi : borel α = generate_from (range Ioi) :=
+@borel_eq_generate_from_Iio αᵒᵈ _ (by apply_instance : second_countable_topology α) _ _
+
+lemma borel_eq_generate_from_Iic : borel α = measurable_space.generate_from (range Iic) :=
+begin
+  rw borel_eq_generate_from_Ioi,
+  refine le_antisymm _ _,
+  { refine measurable_space.generate_from_le (λ t ht, _),
+    obtain ⟨u, rfl⟩ := ht,
+    rw ← compl_Iic,
+    exact (measurable_space.measurable_set_generate_from (mem_range.mpr ⟨u, rfl⟩)).compl, },
+  { refine measurable_space.generate_from_le (λ t ht, _),
+    obtain ⟨u, rfl⟩ := ht,
+    rw ← compl_Ioi,
+    exact (measurable_space.measurable_set_generate_from (mem_range.mpr ⟨u, rfl⟩)).compl, },
+end
+
+lemma borel_eq_generate_from_Ici : borel α = measurable_space.generate_from (range Ici) :=
+@borel_eq_generate_from_Iic αᵒᵈ _ _ _ _
+
+end order_topology
+
+lemma borel_comap {f : α → β} {t : topological_space β} :
+  @borel α (t.induced f) = (@borel β t).comap f :=
+comap_generate_from.symm
+
+lemma continuous.borel_measurable [topological_space α] [topological_space β]
+  {f : α → β} (hf : continuous f) :
+  @measurable α β (borel α) (borel β) f :=
+measurable.of_le_map $ generate_from_le $
+  λ s hs, generate_measurable.basic (f ⁻¹' s) (hs.preimage hf)
+
+/-- A space with `measurable_space` and `topological_space` structures such that
+all open sets are measurable. -/
+class opens_measurable_space (α : Type*) [topological_space α] [h : measurable_space α] : Prop :=
+(borel_le : borel α ≤ h)
+
+/-- A space with `measurable_space` and `topological_space` structures such that
+the `σ`-algebra of measurable sets is exactly the `σ`-algebra generated by open sets. -/
+class borel_space (α : Type*) [topological_space α] [measurable_space α] : Prop :=
+(measurable_eq : ‹measurable_space α› = borel α)
+
+namespace tactic
+
+/-- Add instances `borel α : measurable_space α` and `⟨rfl⟩ : borel_space α`. -/
+meta def add_borel_instance (α : expr) : tactic unit :=
+do
+  n1 ← get_unused_name "_inst",
+  to_expr ``(borel %%α) >>= pose n1,
+  reset_instance_cache,
+  n2 ← get_unused_name "_inst",
+  v ← to_expr ``(borel_space.mk rfl : borel_space %%α),
+  note n2 none v,
+  reset_instance_cache
+
+/-- Given a type `α`, an assumption `i : measurable_space α`, and an instance `[borel_space α]`,
+replace `i` with `borel α`. -/
+meta def borel_to_refl (α i : expr) : tactic unit :=
+do
+  n ← get_unused_name "h",
+  to_expr ``(%%i = borel %%α) >>= assert n,
+  applyc `borel_space.measurable_eq,
+  unfreezing (tactic.subst i),
+  n1 ← get_unused_name "_inst",
+  to_expr ``(borel %%α) >>= pose n1,
+  reset_instance_cache
+
+/-- Given a type `α`, if there is an assumption `[i : measurable_space α]`, then try to prove
+`[borel_space α]` and replace `i` with `borel α`. Otherwise, add instances
+`borel α : measurable_space α` and `⟨rfl⟩ : borel_space α`. -/
+meta def borelize (α : expr) : tactic unit :=
+do
+  i ← optional (to_expr ``(measurable_space %%α) >>= find_assumption),
+  i.elim (add_borel_instance α) (borel_to_refl α)
+
+namespace interactive
+
+setup_tactic_parser
+
+/-- The behaviour of `borelize α` depends on the existing assumptions on `α`.
+
+- if `α` is a topological space with instances `[measurable_space α] [borel_space α]`, then
+  `borelize α` replaces the former instance by `borel α`;
+- otherwise, `borelize α` adds instances `borel α : measurable_space α` and `⟨rfl⟩ : borel_space α`.
+
+Finally, `borelize [α, β, γ]` runs `borelize α, borelize β, borelize γ`.
+-/
+meta def borelize (ts : parse pexpr_list_or_texpr) : tactic unit :=
+mmap' (λ t, to_expr t >>= tactic.borelize) ts
+
+add_tactic_doc
+{ name := "borelize",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.borelize],
+  tags := ["type class"] }
+
+end interactive
+
+end tactic
+
+@[priority 100]
+instance order_dual.opens_measurable_space {α : Type*} [topological_space α] [measurable_space α]
+  [h : opens_measurable_space α] :
+  opens_measurable_space αᵒᵈ :=
+{ borel_le := h.borel_le }
+
+@[priority 100]
+instance order_dual.borel_space {α : Type*} [topological_space α] [measurable_space α]
+  [h : borel_space α] :
+  borel_space αᵒᵈ :=
+{ measurable_eq := h.measurable_eq }
+
+/-- In a `borel_space` all open sets are measurable. -/
+@[priority 100]
+instance borel_space.opens_measurable {α : Type*} [topological_space α] [measurable_space α]
+  [borel_space α] : opens_measurable_space α :=
+⟨ge_of_eq $ borel_space.measurable_eq⟩
+
+instance subtype.borel_space {α : Type*} [topological_space α] [measurable_space α]
+  [hα : borel_space α] (s : set α) :
+  borel_space s :=
+⟨by { rw [hα.1, subtype.measurable_space, ← borel_comap], refl }⟩
+
+instance subtype.opens_measurable_space {α : Type*} [topological_space α] [measurable_space α]
+  [h : opens_measurable_space α] (s : set α) :
+  opens_measurable_space s :=
+⟨by { rw [borel_comap], exact comap_mono h.1 }⟩
+
+@[priority 100]
+instance borel_space.countably_generated {α : Type*} [topological_space α] [measurable_space α]
+  [borel_space α] [second_countable_topology α] : countably_generated α :=
+begin
+  obtain ⟨b, bct, -, hb⟩ := exists_countable_basis α,
+  refine ⟨⟨b, bct, _⟩⟩,
+  borelize α,
+  exact hb.borel_eq_generate_from,
+end
+
+theorem _root_.measurable_set.induction_on_open [topological_space α] [measurable_space α]
+  [borel_space α] {C : set α → Prop} (h_open : ∀ U, is_open U → C U)
+  (h_compl : ∀ t, measurable_set t → C t → C tᶜ)
+  (h_union : ∀ f : ℕ → set α, pairwise (disjoint on f) →
+    (∀ i, measurable_set (f i)) → (∀ i, C (f i)) → C (⋃ i, f i)) :
+  ∀ ⦃t⦄, measurable_set t → C t :=
+measurable_space.induction_on_inter borel_space.measurable_eq is_pi_system_is_open
+  (h_open _ is_open_empty) h_open h_compl h_union
+
+section
+variables [topological_space α] [measurable_space α] [opens_measurable_space α]
+   [topological_space β] [measurable_space β] [opens_measurable_space β]
+   [topological_space γ] [measurable_space γ] [borel_space γ]
+   [topological_space γ₂] [measurable_space γ₂] [borel_space γ₂]
+   [measurable_space δ]
+
+lemma is_open.measurable_set (h : is_open s) : measurable_set s :=
+opens_measurable_space.borel_le _ $ generate_measurable.basic _ h
+
+@[measurability]
+lemma measurable_set_interior : measurable_set (interior s) := is_open_interior.measurable_set
+
+lemma is_Gδ.measurable_set (h : is_Gδ s) : measurable_set s :=
+begin
+  rcases h with ⟨S, hSo, hSc, rfl⟩,
+  exact measurable_set.sInter hSc (λ t ht, (hSo t ht).measurable_set)
+end
+
+lemma measurable_set_of_continuous_at {β} [emetric_space β] (f : α → β) :
+  measurable_set {x | continuous_at f x} :=
+(is_Gδ_set_of_continuous_at f).measurable_set
+
+lemma is_closed.measurable_set (h : is_closed s) : measurable_set s :=
+h.is_open_compl.measurable_set.of_compl
+
+lemma is_compact.measurable_set [t2_space α] (h : is_compact s) : measurable_set s :=
+h.is_closed.measurable_set
+
+@[measurability]
+lemma measurable_set_closure : measurable_set (closure s) :=
+is_closed_closure.measurable_set
+
+lemma measurable_of_is_open {f : δ → γ} (hf : ∀ s, is_open s → measurable_set (f ⁻¹' s)) :
+  measurable f :=
+by { rw [‹borel_space γ›.measurable_eq], exact measurable_generate_from hf }
+
+lemma measurable_of_is_closed {f : δ → γ} (hf : ∀ s, is_closed s → measurable_set (f ⁻¹' s)) :
+  measurable f :=
+begin
+  apply measurable_of_is_open, intros s hs,
+  rw [← measurable_set.compl_iff, ← preimage_compl], apply hf, rw [is_closed_compl_iff], exact hs
+end
+
+lemma measurable_of_is_closed' {f : δ → γ}
+  (hf : ∀ s, is_closed s → s.nonempty → s ≠ univ → measurable_set (f ⁻¹' s)) : measurable f :=
+begin
+  apply measurable_of_is_closed, intros s hs,
+  cases eq_empty_or_nonempty s with h1 h1, { simp [h1] },
+  by_cases h2 : s = univ, { simp [h2] },
+  exact hf s hs h1 h2
+end
+
+instance nhds_is_measurably_generated (a : α) : (𝓝 a).is_measurably_generated :=
+begin
+  rw [nhds, infi_subtype'],
+  refine @filter.infi_is_measurably_generated _ _ _ _ (λ i, _),
+  exact i.2.2.measurable_set.principal_is_measurably_generated
+end
+
+/-- If `s` is a measurable set, then `𝓝[s] a` is a measurably generated filter for
+each `a`. This cannot be an `instance` because it depends on a non-instance `hs : measurable_set s`.
+-/
+lemma measurable_set.nhds_within_is_measurably_generated {s : set α} (hs : measurable_set s)
+  (a : α) :
+  (𝓝[s] a).is_measurably_generated :=
+by haveI := hs.principal_is_measurably_generated; exact filter.inf_is_measurably_generated _ _
+
+@[priority 100] -- see Note [lower instance priority]
+instance opens_measurable_space.to_measurable_singleton_class [t1_space α] :
+  measurable_singleton_class α :=
+⟨λ x, is_closed_singleton.measurable_set⟩
+
+instance pi.opens_measurable_space {ι : Type*} {π : ι → Type*} [countable ι]
+  [t' : Π i, topological_space (π i)]
+  [Π i, measurable_space (π i)] [∀ i, second_countable_topology (π i)]
+  [∀ i, opens_measurable_space (π i)] :
+  opens_measurable_space (Π i, π i) :=
+begin
+  constructor,
+  have : Pi.topological_space =
+    generate_from {t | ∃(s:Πa, set (π a)) (i : finset ι), (∀a∈i, s a ∈ countable_basis (π a)) ∧
+      t = pi ↑i s},
+  { rw [funext (λ a, @eq_generate_from_countable_basis (π a) _ _), pi_generate_from_eq] },
+  rw [borel_eq_generate_from_of_subbasis this],
+  apply generate_from_le,
+  rintros _ ⟨s, i, hi, rfl⟩,
+  refine measurable_set.pi i.countable_to_set (λ a ha, is_open.measurable_set _),
+  rw [eq_generate_from_countable_basis (π a)],
+  exact generate_open.basic _ (hi a ha)
+end
+
+instance prod.opens_measurable_space [second_countable_topology α] [second_countable_topology β] :
+  opens_measurable_space (α × β) :=
+begin
+  constructor,
+  rw [((is_basis_countable_basis α).prod (is_basis_countable_basis β)).borel_eq_generate_from],
+  apply generate_from_le,
+  rintros _ ⟨u, v, hu, hv, rfl⟩,
+  exact (is_open_of_mem_countable_basis hu).measurable_set.prod
+    (is_open_of_mem_countable_basis hv).measurable_set
+end
+
+variables {α' : Type*} [topological_space α'] [measurable_space α']
+
+lemma interior_ae_eq_of_null_frontier {μ : measure α'} {s : set α'}
+  (h : μ (frontier s) = 0) : interior s =ᵐ[μ] s :=
+interior_subset.eventually_le.antisymm $
+  subset_closure.eventually_le.trans (ae_le_set.2 h)
+
+lemma measure_interior_of_null_frontier {μ : measure α'} {s : set α'}
+  (h : μ (frontier s) = 0) : μ (interior s) = μ s :=
+measure_congr (interior_ae_eq_of_null_frontier h)
+
+lemma null_measurable_set_of_null_frontier {s : set α} {μ : measure α}
+  (h : μ (frontier s) = 0) : null_measurable_set s μ :=
+⟨interior s, is_open_interior.measurable_set, (interior_ae_eq_of_null_frontier h).symm⟩
+
+lemma closure_ae_eq_of_null_frontier {μ : measure α'} {s : set α'}
+  (h : μ (frontier s) = 0) : closure s =ᵐ[μ] s :=
+((ae_le_set.2 h).trans interior_subset.eventually_le).antisymm $ subset_closure.eventually_le
+
+lemma measure_closure_of_null_frontier {μ : measure α'} {s : set α'}
+  (h : μ (frontier s) = 0) : μ (closure s) = μ s :=
+measure_congr (closure_ae_eq_of_null_frontier h)
+
+section preorder
+variables [preorder α] [order_closed_topology α] {a b x : α}
+
+@[simp, measurability]
+lemma measurable_set_Ici : measurable_set (Ici a) := is_closed_Ici.measurable_set
+@[simp, measurability]
+lemma measurable_set_Iic : measurable_set (Iic a) := is_closed_Iic.measurable_set
+@[simp, measurability]
+lemma measurable_set_Icc : measurable_set (Icc a b) := is_closed_Icc.measurable_set
+
+instance nhds_within_Ici_is_measurably_generated :
+  (𝓝[Ici b] a).is_measurably_generated :=
+measurable_set_Ici.nhds_within_is_measurably_generated _
+
+instance nhds_within_Iic_is_measurably_generated :
+  (𝓝[Iic b] a).is_measurably_generated :=
+measurable_set_Iic.nhds_within_is_measurably_generated _
+
+instance nhds_within_Icc_is_measurably_generated :
+  is_measurably_generated (𝓝[Icc a b] x) :=
+by { rw [← Ici_inter_Iic, nhds_within_inter], apply_instance }
+
+instance at_top_is_measurably_generated : (filter.at_top : filter α).is_measurably_generated :=
+@filter.infi_is_measurably_generated _ _ _ _ $
+  λ a, (measurable_set_Ici : measurable_set (Ici a)).principal_is_measurably_generated
+
+instance at_bot_is_measurably_generated : (filter.at_bot : filter α).is_measurably_generated :=
+@filter.infi_is_measurably_generated _ _ _ _ $
+  λ a, (measurable_set_Iic : measurable_set (Iic a)).principal_is_measurably_generated
+
+end preorder
+
+section partial_order
+variables [partial_order α] [order_closed_topology α] [second_countable_topology α]
+  {a b : α}
+
+@[measurability]
+lemma measurable_set_le' : measurable_set {p : α × α | p.1 ≤ p.2} :=
+order_closed_topology.is_closed_le'.measurable_set
+
+@[measurability]
+lemma measurable_set_le {f g : δ → α} (hf : measurable f) (hg : measurable g) :
+  measurable_set {a | f a ≤ g a} :=
+hf.prod_mk hg measurable_set_le'
+
+end partial_order
+
+section linear_order
+variables [linear_order α] [order_closed_topology α] {a b x : α}
+
+-- we open this locale only here to avoid issues with list being treated as intervals above
+open_locale interval
+
+@[simp, measurability]
+lemma measurable_set_Iio : measurable_set (Iio a) := is_open_Iio.measurable_set
+@[simp, measurability]
+lemma measurable_set_Ioi : measurable_set (Ioi a) := is_open_Ioi.measurable_set
+@[simp, measurability]
+lemma measurable_set_Ioo : measurable_set (Ioo a b) := is_open_Ioo.measurable_set
+
+@[simp, measurability] lemma measurable_set_Ioc : measurable_set (Ioc a b) :=
+measurable_set_Ioi.inter measurable_set_Iic
+
+@[simp, measurability] lemma measurable_set_Ico : measurable_set (Ico a b) :=
+measurable_set_Ici.inter measurable_set_Iio
+
+instance nhds_within_Ioi_is_measurably_generated :
+  (𝓝[Ioi b] a).is_measurably_generated :=
+measurable_set_Ioi.nhds_within_is_measurably_generated _
+
+instance nhds_within_Iio_is_measurably_generated :
+  (𝓝[Iio b] a).is_measurably_generated :=
+measurable_set_Iio.nhds_within_is_measurably_generated _
+
+instance nhds_within_uIcc_is_measurably_generated :
+  is_measurably_generated (𝓝[[a, b]] x) :=
+nhds_within_Icc_is_measurably_generated
+
+@[measurability]
+lemma measurable_set_lt' [second_countable_topology α] : measurable_set {p : α × α | p.1 < p.2} :=
+(is_open_lt continuous_fst continuous_snd).measurable_set
+
+@[measurability]
+lemma measurable_set_lt [second_countable_topology α] {f g : δ → α} (hf : measurable f)
+  (hg : measurable g) : measurable_set {a | f a < g a} :=
+hf.prod_mk hg measurable_set_lt'
+
+lemma null_measurable_set_lt [second_countable_topology α] {μ : measure δ} {f g : δ → α}
+  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
+  null_measurable_set {a | f a < g a} μ :=
+(hf.prod_mk hg).null_measurable measurable_set_lt'
+
+lemma set.ord_connected.measurable_set (h : ord_connected s) : measurable_set s :=
+begin
+  let u := ⋃ (x ∈ s) (y ∈ s), Ioo x y,
+  have huopen : is_open u := is_open_bUnion (λ x hx, is_open_bUnion (λ y hy, is_open_Ioo)),
+  have humeas : measurable_set u := huopen.measurable_set,
+  have hfinite : (s \ u).finite := s.finite_diff_Union_Ioo,
+  have : u ⊆ s :=
+    Union₂_subset (λ x hx, Union₂_subset (λ y hy, Ioo_subset_Icc_self.trans (h.out hx hy))),
+  rw ← union_diff_cancel this,
+  exact humeas.union hfinite.measurable_set
+end
+
+lemma is_preconnected.measurable_set
+  (h : is_preconnected s) : measurable_set s :=
+h.ord_connected.measurable_set
+
+lemma generate_from_Ico_mem_le_borel {α : Type*} [topological_space α] [linear_order α]
+  [order_closed_topology α] (s t : set α) :
+  measurable_space.generate_from {S | ∃ (l ∈ s) (u ∈ t) (h : l < u), Ico l u = S} ≤ borel α :=
+begin
+  apply generate_from_le,
+  borelize α,
+  rintro _ ⟨a, -, b, -, -, rfl⟩,
+  exact measurable_set_Ico
+end
+
+lemma dense.borel_eq_generate_from_Ico_mem_aux {α : Type*} [topological_space α] [linear_order α]
+  [order_topology α] [second_countable_topology α] {s : set α} (hd : dense s)
+  (hbot : ∀ x, is_bot x → x ∈ s) (hIoo : ∀ x y : α, x < y → Ioo x y = ∅ → y ∈ s) :
+  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ico l u = S} :=
+begin
+  set S : set (set α) := {S | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ico l u = S},
+  refine le_antisymm _ (generate_from_Ico_mem_le_borel _ _),
+  letI : measurable_space α := generate_from S,
+  rw borel_eq_generate_from_Iio,
+  refine generate_from_le (forall_range_iff.2 $ λ a, _),
+  rcases hd.exists_countable_dense_subset_bot_top with ⟨t, hts, hc, htd, htb, htt⟩,
+  by_cases ha : ∀ b < a, (Ioo b a).nonempty,
+  { convert_to measurable_set (⋃ (l ∈ t) (u ∈ t) (hlu : l < u) (hu : u ≤ a), Ico l u),
+    { ext y, simp only [mem_Union, mem_Iio, mem_Ico], split,
+      { intro hy,
+        rcases htd.exists_le' (λ b hb, htb _ hb (hbot b hb)) y with ⟨l, hlt, hly⟩,
+        rcases htd.exists_mem_open is_open_Ioo (ha y hy) with ⟨u, hut, hyu, hua⟩,
+        exact ⟨l, hlt, u, hut, hly.trans_lt hyu, hua.le, hly, hyu⟩ },
+      { rintro ⟨l, -, u, -, -, hua, -, hyu⟩,
+        exact hyu.trans_le hua } },
+    { refine measurable_set.bUnion hc (λ a ha, measurable_set.bUnion hc $ λ b hb, _),
+      refine measurable_set.Union (λ hab, measurable_set.Union $ λ hb', _),
+      exact generate_measurable.basic _ ⟨a, hts ha, b, hts hb, hab, mem_singleton _⟩ } },
+  { simp only [not_forall, not_nonempty_iff_eq_empty] at ha,
+    replace ha : a ∈ s := hIoo ha.some a ha.some_spec.fst ha.some_spec.snd,
+    convert_to measurable_set (⋃ (l ∈ t) (hl : l < a), Ico l a),
+    { symmetry,
+      simp only [← Ici_inter_Iio, ← Union_inter, inter_eq_right_iff_subset, subset_def, mem_Union,
+        mem_Ici, mem_Iio],
+      intros x hx, rcases htd.exists_le' (λ b hb, htb _ hb (hbot b hb)) x with ⟨z, hzt, hzx⟩,
+      exact ⟨z, hzt, hzx.trans_lt hx, hzx⟩ },
+    { refine measurable_set.bUnion hc (λ x hx, measurable_set.Union $ λ hlt, _),
+      exact generate_measurable.basic _ ⟨x, hts hx, a, ha, hlt, mem_singleton _⟩ } }
+end
+
+lemma dense.borel_eq_generate_from_Ico_mem {α : Type*} [topological_space α] [linear_order α]
+  [order_topology α] [second_countable_topology α] [densely_ordered α] [no_min_order α]
+  {s : set α} (hd : dense s) :
+  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ico l u = S} :=
+hd.borel_eq_generate_from_Ico_mem_aux (by simp) $
+  λ x y hxy H, ((nonempty_Ioo.2 hxy).ne_empty H).elim
+
+lemma borel_eq_generate_from_Ico (α : Type*) [topological_space α]
+  [second_countable_topology α] [linear_order α] [order_topology α] :
+  borel α = generate_from {S : set α | ∃ l u (h : l < u), Ico l u = S} :=
+by simpa only [exists_prop, mem_univ, true_and]
+  using (@dense_univ α _).borel_eq_generate_from_Ico_mem_aux (λ _ _, mem_univ _)
+      (λ _ _ _ _, mem_univ _)
+
+lemma dense.borel_eq_generate_from_Ioc_mem_aux {α : Type*} [topological_space α] [linear_order α]
+  [order_topology α] [second_countable_topology α] {s : set α} (hd : dense s)
+  (hbot : ∀ x, is_top x → x ∈ s) (hIoo : ∀ x y : α, x < y → Ioo x y = ∅ → x ∈ s) :
+  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ioc l u = S} :=
+begin
+  convert hd.order_dual.borel_eq_generate_from_Ico_mem_aux hbot (λ x y hlt he, hIoo y x hlt _),
+  { ext s,
+    split; rintro ⟨l, hl, u, hu, hlt, rfl⟩,
+    exacts [⟨u, hu, l, hl, hlt, dual_Ico⟩, ⟨u, hu, l, hl, hlt, dual_Ioc⟩] },
+  { erw dual_Ioo,
+    exact he }
+end
+
+lemma dense.borel_eq_generate_from_Ioc_mem {α : Type*} [topological_space α] [linear_order α]
+  [order_topology α] [second_countable_topology α] [densely_ordered α] [no_max_order α]
+  {s : set α} (hd : dense s) :
+  borel α = generate_from {S : set α | ∃ (l ∈ s) (u ∈ s) (h : l < u), Ioc l u = S} :=
+hd.borel_eq_generate_from_Ioc_mem_aux (by simp) $
+  λ x y hxy H, ((nonempty_Ioo.2 hxy).ne_empty H).elim
+
+lemma borel_eq_generate_from_Ioc (α : Type*) [topological_space α]
+  [second_countable_topology α] [linear_order α] [order_topology α] :
+  borel α = generate_from {S : set α | ∃ l u (h : l < u), Ioc l u = S} :=
+by simpa only [exists_prop, mem_univ, true_and]
+  using (@dense_univ α _).borel_eq_generate_from_Ioc_mem_aux (λ _ _, mem_univ _)
+      (λ _ _ _ _, mem_univ _)
+
+namespace measure_theory.measure
+
+/-- Two finite measures on a Borel space are equal if they agree on all closed-open intervals.  If
+`α` is a conditionally complete linear order with no top element,
+`measure_theory.measure..ext_of_Ico` is an extensionality lemma with weaker assumptions on `μ` and
+`ν`. -/
+lemma ext_of_Ico_finite {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [linear_order α] [order_topology α]
+  [borel_space α] (μ ν : measure α) [is_finite_measure μ] (hμν : μ univ = ν univ)
+  (h : ∀ ⦃a b⦄, a < b → μ (Ico a b) = ν (Ico a b)) : μ = ν :=
+begin
+  refine ext_of_generate_finite _
+    (borel_space.measurable_eq.trans (borel_eq_generate_from_Ico α))
+    (is_pi_system_Ico (id : α → α) id) _ hμν,
+  { rintro - ⟨a, b, hlt, rfl⟩,
+    exact h hlt }
+end
+
+/-- Two finite measures on a Borel space are equal if they agree on all open-closed intervals.  If
+`α` is a conditionally complete linear order with no top element,
+`measure_theory.measure..ext_of_Ioc` is an extensionality lemma with weaker assumptions on `μ` and
+`ν`. -/
+lemma ext_of_Ioc_finite {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [linear_order α] [order_topology α]
+  [borel_space α] (μ ν : measure α) [is_finite_measure μ] (hμν : μ univ = ν univ)
+  (h : ∀ ⦃a b⦄, a < b → μ (Ioc a b) = ν (Ioc a b)) : μ = ν :=
+begin
+  refine @ext_of_Ico_finite αᵒᵈ _ _ _ _ _ ‹_› μ ν _ hμν (λ a b hab, _),
+  erw dual_Ico,
+  exact h hab
+end
+
+/-- Two measures which are finite on closed-open intervals are equal if the agree on all
+closed-open intervals. -/
+lemma ext_of_Ico' {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
+  [no_max_order α] (μ ν : measure α) (hμ : ∀ ⦃a b⦄, a < b → μ (Ico a b) ≠ ∞)
+  (h : ∀ ⦃a b⦄, a < b → μ (Ico a b) = ν (Ico a b)) : μ = ν :=
+begin
+  rcases exists_countable_dense_bot_top α with ⟨s, hsc, hsd, hsb, hst⟩,
+  have : (⋃ (l ∈ s) (u ∈ s) (h : l < u), {Ico l u} : set (set α)).countable,
+    from hsc.bUnion (λ l hl, hsc.bUnion
+      (λ u hu, countable_Union $ λ _, countable_singleton _)),
+  simp only [← set_of_eq_eq_singleton, ← set_of_exists] at this,
+  refine measure.ext_of_generate_from_of_cover_subset
+    (borel_space.measurable_eq.trans (borel_eq_generate_from_Ico α))
+    (is_pi_system_Ico id id) _ this _ _ _,
+  { rintro _ ⟨l, -, u, -, h, rfl⟩, exact ⟨l, u, h, rfl⟩ },
+  { refine sUnion_eq_univ_iff.2 (λ x, _),
+    rcases hsd.exists_le' hsb x with ⟨l, hls, hlx⟩,
+    rcases hsd.exists_gt x with ⟨u, hus, hxu⟩,
+    exact ⟨_, ⟨l, hls, u, hus, hlx.trans_lt hxu, rfl⟩, hlx, hxu⟩ },
+  { rintro _ ⟨l, -, u, -, hlt, rfl⟩, exact hμ hlt },
+  { rintro _ ⟨l, u, hlt, rfl⟩, exact h hlt }
+end
+
+/-- Two measures which are finite on closed-open intervals are equal if the agree on all
+open-closed intervals. -/
+lemma ext_of_Ioc' {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
+  [no_min_order α] (μ ν : measure α) (hμ : ∀ ⦃a b⦄, a < b → μ (Ioc a b) ≠ ∞)
+  (h : ∀ ⦃a b⦄, a < b → μ (Ioc a b) = ν (Ioc a b)) : μ = ν :=
+begin
+  refine @ext_of_Ico' αᵒᵈ _ _ _ _ _ ‹_› _ μ ν _ _;
+    intros a b hab; erw dual_Ico,
+  exacts [hμ hab, h hab]
+end
+
+/-- Two measures which are finite on closed-open intervals are equal if the agree on all
+closed-open intervals. -/
+lemma ext_of_Ico {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [conditionally_complete_linear_order α] [order_topology α]
+  [borel_space α] [no_max_order α] (μ ν : measure α) [is_locally_finite_measure μ]
+  (h : ∀ ⦃a b⦄, a < b → μ (Ico a b) = ν (Ico a b)) : μ = ν :=
+μ.ext_of_Ico' ν (λ a b hab, measure_Ico_lt_top.ne) h
+
+/-- Two measures which are finite on closed-open intervals are equal if the agree on all
+open-closed intervals. -/
+lemma ext_of_Ioc {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [conditionally_complete_linear_order α] [order_topology α]
+  [borel_space α] [no_min_order α] (μ ν : measure α) [is_locally_finite_measure μ]
+  (h : ∀ ⦃a b⦄, a < b → μ (Ioc a b) = ν (Ioc a b)) : μ = ν :=
+μ.ext_of_Ioc' ν (λ a b hab, measure_Ioc_lt_top.ne) h
+
+/-- Two finite measures on a Borel space are equal if they agree on all left-infinite right-closed
+intervals. -/
+lemma ext_of_Iic {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
+  (μ ν : measure α) [is_finite_measure μ] (h : ∀ a, μ (Iic a) = ν (Iic a)) : μ = ν :=
+begin
+  refine ext_of_Ioc_finite μ ν _ (λ a b hlt, _),
+  { rcases exists_countable_dense_bot_top α with ⟨s, hsc, hsd, -, hst⟩,
+    have : directed_on (≤) s, from directed_on_iff_directed.2 (directed_of_sup $ λ _ _, id),
+    simp only [← bsupr_measure_Iic hsc (hsd.exists_ge' hst) this, h] },
+  rw [← Iic_diff_Iic, measure_diff (Iic_subset_Iic.2 hlt.le) measurable_set_Iic,
+      measure_diff (Iic_subset_Iic.2 hlt.le) measurable_set_Iic, h a, h b],
+  { rw ← h a, exact (measure_lt_top μ _).ne },
+  { exact (measure_lt_top μ _).ne }
+end
+
+/-- Two finite measures on a Borel space are equal if they agree on all left-closed right-infinite
+intervals. -/
+lemma ext_of_Ici {α : Type*} [topological_space α] {m : measurable_space α}
+  [second_countable_topology α] [linear_order α] [order_topology α] [borel_space α]
+  (μ ν : measure α) [is_finite_measure μ] (h : ∀ a, μ (Ici a) = ν (Ici a)) : μ = ν :=
+@ext_of_Iic αᵒᵈ _ _ _ _ _ ‹_› _ _ _ h
+
+end measure_theory.measure
+
+end linear_order
+
+section linear_order
+
+variables [linear_order α] [order_closed_topology α] {a b : α}
+
+@[measurability] lemma measurable_set_uIcc : measurable_set (uIcc a b) := measurable_set_Icc
+@[measurability] lemma measurable_set_uIoc : measurable_set (uIoc a b) := measurable_set_Ioc
+
+variables [second_countable_topology α]
+
+@[measurability]
+lemma measurable.max {f g : δ → α} (hf : measurable f) (hg : measurable g) :
+  measurable (λ a, max (f a) (g a)) :=
+by simpa only [max_def'] using hf.piecewise (measurable_set_le hg hf) hg
+
+@[measurability]
+lemma ae_measurable.max {f g : δ → α} {μ : measure δ}
+  (hf : ae_measurable f μ) (hg : ae_measurable g μ) : ae_measurable (λ a, max (f a) (g a)) μ :=
+⟨λ a, max (hf.mk f a) (hg.mk g a), hf.measurable_mk.max hg.measurable_mk,
+  eventually_eq.comp₂ hf.ae_eq_mk _ hg.ae_eq_mk⟩
+
+@[measurability]
+lemma measurable.min {f g : δ → α} (hf : measurable f) (hg : measurable g) :
+  measurable (λ a, min (f a) (g a)) :=
+by simpa only [min_def] using hf.piecewise (measurable_set_le hf hg) hg
+
+@[measurability]
+lemma ae_measurable.min {f g : δ → α} {μ : measure δ}
+  (hf : ae_measurable f μ) (hg : ae_measurable g μ) : ae_measurable (λ a, min (f a) (g a)) μ :=
+⟨λ a, min (hf.mk f a) (hg.mk g a), hf.measurable_mk.min hg.measurable_mk,
+  eventually_eq.comp₂ hf.ae_eq_mk _ hg.ae_eq_mk⟩
+
+end linear_order
+
+/-- A continuous function from an `opens_measurable_space` to a `borel_space`
+is measurable. -/
+lemma continuous.measurable {f : α → γ} (hf : continuous f) :
+  measurable f :=
+hf.borel_measurable.mono opens_measurable_space.borel_le
+  (le_of_eq $ borel_space.measurable_eq)
+
+/-- A continuous function from an `opens_measurable_space` to a `borel_space`
+is ae-measurable. -/
+lemma continuous.ae_measurable {f : α → γ} (h : continuous f) {μ : measure α} : ae_measurable f μ :=
+h.measurable.ae_measurable
+
+lemma closed_embedding.measurable {f : α → γ} (hf : closed_embedding f) :
+  measurable f :=
+hf.continuous.measurable
+
+lemma continuous.is_open_pos_measure_map {f : β → γ} (hf : continuous f)
+  (hf_surj : function.surjective f) {μ : measure β} [μ.is_open_pos_measure] :
+  (measure.map f μ).is_open_pos_measure :=
+begin
+  refine ⟨λ U hUo hUne, _⟩,
+  rw [measure.map_apply hf.measurable hUo.measurable_set],
+  exact (hUo.preimage hf).measure_ne_zero μ (hf_surj.nonempty_preimage.mpr hUne)
+end
+
+/-- If a function is defined piecewise in terms of functions which are continuous on their
+respective pieces, then it is measurable. -/
+lemma continuous_on.measurable_piecewise
+  {f g : α → γ} {s : set α} [Π (j : α), decidable (j ∈ s)]
+  (hf : continuous_on f s) (hg : continuous_on g sᶜ) (hs : measurable_set s) :
+  measurable (s.piecewise f g) :=
+begin
+  refine measurable_of_is_open (λ t ht, _),
+  rw [piecewise_preimage, set.ite],
+  apply measurable_set.union,
+  { rcases _root_.continuous_on_iff'.1 hf t ht with ⟨u, u_open, hu⟩,
+    rw hu,
+    exact u_open.measurable_set.inter hs },
+  { rcases _root_.continuous_on_iff'.1 hg t ht with ⟨u, u_open, hu⟩,
+    rw [diff_eq_compl_inter, inter_comm, hu],
+    exact u_open.measurable_set.inter hs.compl }
+end
+
+@[priority 100, to_additive]
+instance has_continuous_mul.has_measurable_mul [has_mul γ] [has_continuous_mul γ] :
+  has_measurable_mul γ :=
+{ measurable_const_mul := λ c, (continuous_const.mul continuous_id).measurable,
+  measurable_mul_const := λ c, (continuous_id.mul continuous_const).measurable }
+
+@[priority 100]
+instance has_continuous_sub.has_measurable_sub [has_sub γ] [has_continuous_sub γ] :
+  has_measurable_sub γ :=
+{ measurable_const_sub := λ c, (continuous_const.sub continuous_id).measurable,
+  measurable_sub_const := λ c, (continuous_id.sub continuous_const).measurable }
+
+@[priority 100, to_additive]
+instance topological_group.has_measurable_inv [group γ] [topological_group γ] :
+  has_measurable_inv γ :=
+⟨continuous_inv.measurable⟩
+
+@[priority 100]
+instance has_continuous_smul.has_measurable_smul {M α} [topological_space M]
+  [topological_space α] [measurable_space M] [measurable_space α]
+  [opens_measurable_space M] [borel_space α] [has_smul M α] [has_continuous_smul M α] :
+  has_measurable_smul M α :=
+⟨λ c, (continuous_const_smul _).measurable,
+  λ y, (continuous_id.smul continuous_const).measurable⟩
+
+section lattice
+
+@[priority 100]
+instance has_continuous_sup.has_measurable_sup [has_sup γ] [has_continuous_sup γ] :
+  has_measurable_sup γ :=
+{ measurable_const_sup := λ c, (continuous_const.sup continuous_id).measurable,
+  measurable_sup_const := λ c, (continuous_id.sup continuous_const).measurable }
+
+@[priority 100]
+instance has_continuous_sup.has_measurable_sup₂ [second_countable_topology γ] [has_sup γ]
+  [has_continuous_sup γ] :
+  has_measurable_sup₂ γ :=
+⟨continuous_sup.measurable⟩
+
+@[priority 100]
+instance has_continuous_inf.has_measurable_inf [has_inf γ] [has_continuous_inf γ] :
+  has_measurable_inf γ :=
+{ measurable_const_inf := λ c, (continuous_const.inf continuous_id).measurable,
+  measurable_inf_const := λ c, (continuous_id.inf continuous_const).measurable }
+
+@[priority 100]
+instance has_continuous_inf.has_measurable_inf₂ [second_countable_topology γ] [has_inf γ]
+  [has_continuous_inf γ] :
+  has_measurable_inf₂ γ :=
+⟨continuous_inf.measurable⟩
+
+end lattice
+
+section homeomorph
+
+@[measurability] protected lemma homeomorph.measurable (h : α ≃ₜ γ) : measurable h :=
+h.continuous.measurable
+
+/-- A homeomorphism between two Borel spaces is a measurable equivalence.-/
+def homeomorph.to_measurable_equiv (h : γ ≃ₜ γ₂) : γ ≃ᵐ γ₂ :=
+{ measurable_to_fun := h.measurable,
+  measurable_inv_fun := h.symm.measurable,
+  to_equiv := h.to_equiv }
+
+@[simp]
+lemma homeomorph.to_measurable_equiv_coe (h : γ ≃ₜ γ₂) : (h.to_measurable_equiv : γ → γ₂) = h :=
+rfl
+
+@[simp] lemma homeomorph.to_measurable_equiv_symm_coe (h : γ ≃ₜ γ₂) :
+  (h.to_measurable_equiv.symm : γ₂ → γ) = h.symm :=
+rfl
+
+end homeomorph
+
+@[measurability] lemma continuous_map.measurable (f : C(α, γ)) : measurable f :=
+f.continuous.measurable
+
+lemma measurable_of_continuous_on_compl_singleton [t1_space α] {f : α → γ} (a : α)
+  (hf : continuous_on f {a}ᶜ) :
+  measurable f :=
+measurable_of_measurable_on_compl_singleton a
+  (continuous_on_iff_continuous_restrict.1 hf).measurable
+
+lemma continuous.measurable2 [second_countable_topology α] [second_countable_topology β]
+  {f : δ → α} {g : δ → β} {c : α → β → γ}
+  (h : continuous (λ p : α × β, c p.1 p.2)) (hf : measurable f) (hg : measurable g) :
+  measurable (λ a, c (f a) (g a)) :=
+h.measurable.comp (hf.prod_mk hg)
+
+lemma continuous.ae_measurable2 [second_countable_topology α] [second_countable_topology β]
+  {f : δ → α} {g : δ → β} {c : α → β → γ} {μ : measure δ}
+  (h : continuous (λ p : α × β, c p.1 p.2)) (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
+  ae_measurable (λ a, c (f a) (g a)) μ :=
+h.measurable.comp_ae_measurable (hf.prod_mk hg)
+
+@[priority 100]
+instance has_continuous_inv₀.has_measurable_inv [group_with_zero γ] [t1_space γ]
+  [has_continuous_inv₀ γ] :
+  has_measurable_inv γ :=
+⟨measurable_of_continuous_on_compl_singleton 0 continuous_on_inv₀⟩
+
+@[priority 100, to_additive]
+instance has_continuous_mul.has_measurable_mul₂ [second_countable_topology γ] [has_mul γ]
+  [has_continuous_mul γ] : has_measurable_mul₂ γ :=
+⟨continuous_mul.measurable⟩
+
+@[priority 100]
+instance has_continuous_sub.has_measurable_sub₂ [second_countable_topology γ] [has_sub γ]
+  [has_continuous_sub γ] : has_measurable_sub₂ γ :=
+⟨continuous_sub.measurable⟩
+
+@[priority 100]
+instance has_continuous_smul.has_measurable_smul₂ {M α} [topological_space M]
+  [second_countable_topology M] [measurable_space M] [opens_measurable_space M]
+  [topological_space α] [second_countable_topology α] [measurable_space α]
+  [borel_space α] [has_smul M α] [has_continuous_smul M α] :
+  has_measurable_smul₂ M α :=
+⟨continuous_smul.measurable⟩
+
+end
+
+section borel_space
+variables [topological_space α] [measurable_space α] [borel_space α]
+  [topological_space β] [measurable_space β] [borel_space β]
+  [topological_space γ] [measurable_space γ] [borel_space γ]
+  [measurable_space δ]
+
+lemma pi_le_borel_pi {ι : Type*} {π : ι → Type*} [Π i, topological_space (π i)]
+  [Π i, measurable_space (π i)] [∀ i, borel_space (π i)] :
+  measurable_space.pi ≤ borel (Π i, π i) :=
+begin
+  have : ‹Π i, measurable_space (π i)› = λ i, borel (π i) :=
+    funext (λ i, borel_space.measurable_eq),
+  rw [this],
+  exact supr_le (λ i, comap_le_iff_le_map.2 $ (continuous_apply i).borel_measurable)
+end
+
+lemma prod_le_borel_prod : prod.measurable_space ≤ borel (α × β) :=
+begin
+  rw [‹borel_space α›.measurable_eq, ‹borel_space β›.measurable_eq],
+  refine sup_le _ _,
+  { exact comap_le_iff_le_map.mpr continuous_fst.borel_measurable },
+  { exact comap_le_iff_le_map.mpr continuous_snd.borel_measurable }
+end
+
+instance pi.borel_space {ι : Type*} {π : ι → Type*} [countable ι] [Π i, topological_space (π i)]
+  [Π i, measurable_space (π i)] [∀ i, second_countable_topology (π i)] [∀ i, borel_space (π i)] :
+  borel_space (Π i, π i) :=
+⟨le_antisymm pi_le_borel_pi opens_measurable_space.borel_le⟩
+
+instance prod.borel_space [second_countable_topology α] [second_countable_topology β] :
+  borel_space (α × β) :=
+⟨le_antisymm prod_le_borel_prod opens_measurable_space.borel_le⟩
+
+protected lemma embedding.measurable_embedding {f : α → β} (h₁ : embedding f)
+  (h₂ : measurable_set (range f)) : measurable_embedding f :=
+show measurable_embedding (coe ∘ (homeomorph.of_embedding f h₁).to_measurable_equiv),
+from (measurable_embedding.subtype_coe h₂).comp (measurable_equiv.measurable_embedding _)
+
+protected lemma closed_embedding.measurable_embedding {f : α → β} (h : closed_embedding f) :
+  measurable_embedding f :=
+h.to_embedding.measurable_embedding h.closed_range.measurable_set
+
+protected lemma open_embedding.measurable_embedding {f : α → β} (h : open_embedding f) :
+  measurable_embedding f :=
+h.to_embedding.measurable_embedding h.open_range.measurable_set
+
+section linear_order
+
+variables [linear_order α] [order_topology α] [second_countable_topology α]
+
+lemma measurable_of_Iio {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Iio x)) : measurable f :=
+begin
+  convert measurable_generate_from _,
+  exact borel_space.measurable_eq.trans (borel_eq_generate_from_Iio _),
+  rintro _ ⟨x, rfl⟩, exact hf x
+end
+
+lemma upper_semicontinuous.measurable [topological_space δ] [opens_measurable_space δ]
+  {f : δ → α} (hf : upper_semicontinuous f) : measurable f :=
+measurable_of_Iio (λ y, (hf.is_open_preimage y).measurable_set)
+
+lemma measurable_of_Ioi {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Ioi x)) : measurable f :=
+begin
+  convert measurable_generate_from _,
+  exact borel_space.measurable_eq.trans (borel_eq_generate_from_Ioi _),
+  rintro _ ⟨x, rfl⟩, exact hf x
+end
+
+lemma lower_semicontinuous.measurable [topological_space δ] [opens_measurable_space δ]
+  {f : δ → α} (hf : lower_semicontinuous f) : measurable f :=
+measurable_of_Ioi (λ y, (hf.is_open_preimage y).measurable_set)
+
+lemma measurable_of_Iic {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Iic x)) : measurable f :=
+begin
+  apply measurable_of_Ioi,
+  simp_rw [← compl_Iic, preimage_compl, measurable_set.compl_iff],
+  assumption
+end
+
+lemma measurable_of_Ici {f : δ → α} (hf : ∀ x, measurable_set (f ⁻¹' Ici x)) : measurable f :=
+begin
+  apply measurable_of_Iio,
+  simp_rw [← compl_Ici, preimage_compl, measurable_set.compl_iff],
+  assumption
+end
+
+lemma measurable.is_lub {ι} [countable ι] {f : ι → δ → α} {g : δ → α} (hf : ∀ i, measurable (f i))
+  (hg : ∀ b, is_lub {a | ∃ i, f i b = a} (g b)) :
+  measurable g :=
+begin
+  change ∀ b, is_lub (range $ λ i, f i b) (g b) at hg,
+  rw [‹borel_space α›.measurable_eq, borel_eq_generate_from_Ioi α],
+  apply measurable_generate_from,
+  rintro _ ⟨a, rfl⟩,
+  simp_rw [set.preimage, mem_Ioi, lt_is_lub_iff (hg _), exists_range_iff, set_of_exists],
+  exact measurable_set.Union (λ i, hf i (is_open_lt' _).measurable_set)
+end
+
+private lemma ae_measurable.is_lub_of_nonempty {ι} (hι : nonempty ι)
+  {μ : measure δ} [countable ι] {f : ι → δ → α} {g : δ → α}
+  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_lub {a | ∃ i, f i b = a} (g b)) :
+  ae_measurable g μ :=
+begin
+  let p : δ → (ι → α) → Prop := λ x f', is_lub {a | ∃ i, f' i = a} (g x),
+  let g_seq := λ x, ite (x ∈ ae_seq_set hf p) (g x) (⟨g x⟩ : nonempty α).some,
+  have hg_seq : ∀ b, is_lub {a | ∃ i, ae_seq hf p i b = a} (g_seq b),
+  { intro b,
+    haveI hα : nonempty α := nonempty.map g ⟨b⟩,
+    simp only [ae_seq, g_seq],
+    split_ifs,
+    { have h_set_eq : {a : α | ∃ (i : ι), (hf i).mk (f i) b = a} = {a : α | ∃ (i : ι), f i b = a},
+      { ext x,
+        simp_rw [set.mem_set_of_eq, ae_seq.mk_eq_fun_of_mem_ae_seq_set hf h], },
+      rw h_set_eq,
+      exact ae_seq.fun_prop_of_mem_ae_seq_set hf h, },
+    { have h_singleton : {a : α | ∃ (i : ι), hα.some = a} = {hα.some},
+      { ext1 x,
+        exact ⟨λ hx, hx.some_spec.symm, λ hx, ⟨hι.some, hx.symm⟩⟩, },
+      rw h_singleton,
+      exact is_lub_singleton, }, },
+  refine ⟨g_seq, measurable.is_lub (ae_seq.measurable hf p) hg_seq, _⟩,
+  exact (ite_ae_eq_of_measure_compl_zero g (λ x, (⟨g x⟩ : nonempty α).some) (ae_seq_set hf p)
+    (ae_seq.measure_compl_ae_seq_set_eq_zero hf hg)).symm,
+end
+
+lemma ae_measurable.is_lub {ι} {μ : measure δ} [countable ι] {f : ι → δ → α} {g : δ → α}
+  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_lub {a | ∃ i, f i b = a} (g b)) :
+  ae_measurable g μ :=
+begin
+  by_cases hμ : μ = 0, { rw hμ, exact ae_measurable_zero_measure },
+  haveI : μ.ae.ne_bot, { simpa [ne_bot_iff] },
+  by_cases hι : nonempty ι, { exact ae_measurable.is_lub_of_nonempty hι hf hg, },
+  suffices : ∃ x, g =ᵐ[μ] λ y, g x,
+  by { exact ⟨(λ y, g this.some), measurable_const, this.some_spec⟩, },
+  have h_empty : ∀ x, {a : α | ∃ (i : ι), f i x = a} = ∅,
+  { intro x,
+    ext1 y,
+    rw [set.mem_set_of_eq, set.mem_empty_iff_false, iff_false],
+    exact λ hi, hι (nonempty_of_exists hi), },
+  simp_rw h_empty at hg,
+  exact ⟨hg.exists.some, hg.mono (λ y hy, is_lub.unique hy hg.exists.some_spec)⟩,
+end
+
+lemma measurable.is_glb {ι} [countable ι] {f : ι → δ → α} {g : δ → α} (hf : ∀ i, measurable (f i))
+  (hg : ∀ b, is_glb {a | ∃ i, f i b = a} (g b)) :
+  measurable g :=
+begin
+  change ∀ b, is_glb (range $ λ i, f i b) (g b) at hg,
+  rw [‹borel_space α›.measurable_eq, borel_eq_generate_from_Iio α],
+  apply measurable_generate_from,
+  rintro _ ⟨a, rfl⟩,
+  simp_rw [set.preimage, mem_Iio, is_glb_lt_iff (hg _), exists_range_iff, set_of_exists],
+  exact measurable_set.Union (λ i, hf i (is_open_gt' _).measurable_set)
+end
+
+lemma ae_measurable.is_glb {ι} {μ : measure δ} [countable ι] {f : ι → δ → α} {g : δ → α}
+  (hf : ∀ i, ae_measurable (f i) μ) (hg : ∀ᵐ b ∂μ, is_glb {a | ∃ i, f i b = a} (g b)) :
+  ae_measurable g μ :=
+begin
+  nontriviality α,
+  haveI hα : nonempty α := infer_instance,
+  casesI is_empty_or_nonempty ι with hι hι,
+  { simp only [is_empty.exists_iff, set_of_false, is_glb_empty_iff] at hg,
+    exact ae_measurable_const' (hg.mono $ λ a ha, hg.mono $ λ b hb, (hb _).antisymm (ha _)) },
+  let p : δ → (ι → α) → Prop := λ x f', is_glb {a | ∃ i, f' i = a} (g x),
+  let g_seq := (ae_seq_set hf p).piecewise g (λ _, hα.some),
+  have hg_seq : ∀ b, is_glb {a | ∃ i, ae_seq hf p i b = a} (g_seq b),
+  { intro b,
+    simp only [ae_seq, g_seq, set.piecewise],
+    split_ifs,
+    { have h_set_eq : {a : α | ∃ (i : ι), (hf i).mk (f i) b = a} = {a : α | ∃ (i : ι), f i b = a},
+      { ext x,
+        simp_rw [set.mem_set_of_eq, ae_seq.mk_eq_fun_of_mem_ae_seq_set hf h], },
+      rw h_set_eq,
+      exact ae_seq.fun_prop_of_mem_ae_seq_set hf h, },
+    { exact is_least.is_glb ⟨(@exists_const (hα.some = hα.some) ι _).2 rfl, λ x ⟨i, hi⟩, hi.le⟩ } },
+  refine ⟨g_seq, measurable.is_glb (ae_seq.measurable hf p) hg_seq, _⟩,
+  exact (ite_ae_eq_of_measure_compl_zero g (λ x, hα.some) (ae_seq_set hf p)
+    (ae_seq.measure_compl_ae_seq_set_eq_zero hf hg)).symm,
+end
+
+protected lemma monotone.measurable [linear_order β] [order_closed_topology β] {f : β → α}
+  (hf : monotone f) : measurable f :=
+suffices h : ∀ x, ord_connected (f ⁻¹' Ioi x),
+  from measurable_of_Ioi (λ x, (h x).measurable_set),
+λ x, ord_connected_def.mpr (λ a ha b hb c hc, lt_of_lt_of_le ha (hf hc.1))
+
+lemma ae_measurable_restrict_of_monotone_on [linear_order β] [order_closed_topology β]
+  {μ : measure β} {s : set β} (hs : measurable_set s) {f : β → α} (hf : monotone_on f s) :
+  ae_measurable f (μ.restrict s) :=
+have this : monotone (f ∘ coe : s → α), from λ ⟨x, hx⟩ ⟨y, hy⟩ (hxy : x ≤ y), hf hx hy hxy,
+ae_measurable_restrict_of_measurable_subtype hs this.measurable
+
+protected lemma antitone.measurable [linear_order β] [order_closed_topology β] {f : β → α}
+  (hf : antitone f) :
+  measurable f :=
+@monotone.measurable αᵒᵈ β _ _ ‹_› _ _ _ _ _ ‹_› _ _ _ hf
+
+lemma ae_measurable_restrict_of_antitone_on [linear_order β] [order_closed_topology β]
+  {μ : measure β} {s : set β} (hs : measurable_set s) {f : β → α} (hf : antitone_on f s) :
+  ae_measurable f (μ.restrict s) :=
+@ae_measurable_restrict_of_monotone_on αᵒᵈ β _ _ ‹_› _ _ _ _ _ ‹_› _ _ _ _ hs _ hf
+
+lemma measurable_set_of_mem_nhds_within_Ioi_aux
+  {s : set α} (h : ∀ x ∈ s, s ∈ 𝓝[>] x) (h' : ∀ x ∈ s, ∃ y, x < y) :
+  measurable_set s :=
+begin
+  choose! M hM using h',
+  suffices H : (s \ interior s).countable,
+  { have : s = interior s ∪ (s \ interior s), by rw union_diff_cancel interior_subset,
+    rw this,
+    exact is_open_interior.measurable_set.union H.measurable_set },
+  have A : ∀ x ∈ s, ∃ y ∈ Ioi x, Ioo x y ⊆ s :=
+    λ x hx, (mem_nhds_within_Ioi_iff_exists_Ioo_subset' (hM x hx)).1 (h x hx),
+  choose! y hy h'y using A,
+  have B : set.pairwise_disjoint (s \ interior s) (λ x, Ioo x (y x)),
+  { assume x hx x' hx' hxx',
+    rcases lt_or_gt_of_ne hxx' with h'|h',
+    { apply disjoint_left.2 (λ z hz h'z, _),
+      have : x' ∈ interior s :=
+        mem_interior.2 ⟨Ioo x (y x), h'y _ hx.1, is_open_Ioo, ⟨h', h'z.1.trans hz.2⟩⟩,
+      exact false.elim (hx'.2 this) },
+    { apply disjoint_left.2 (λ z hz h'z, _),
+      have : x ∈ interior s :=
+        mem_interior.2 ⟨Ioo x' (y x'), h'y _ hx'.1, is_open_Ioo, ⟨h', hz.1.trans h'z.2⟩⟩,
+      exact false.elim (hx.2 this) } },
+  exact B.countable_of_Ioo (λ x hx, hy x hx.1),
+end
+
+/-- If a set is a right-neighborhood of all of its points, then it is measurable. -/
+lemma measurable_set_of_mem_nhds_within_Ioi {s : set α}
+  (h : ∀ x ∈ s, s ∈ 𝓝[>] x) : measurable_set s :=
+begin
+  by_cases H : ∃ x ∈ s, is_top x,
+  { rcases H with ⟨x₀, x₀s, h₀⟩,
+    have : s = {x₀} ∪ (s \ {x₀}), by rw union_diff_cancel (singleton_subset_iff.2 x₀s),
+    rw this,
+    refine (measurable_set_singleton _).union _,
+    have A : ∀ x ∈ s \ {x₀}, x < x₀ :=
+      λ x hx, lt_of_le_of_ne (h₀ _) (by simpa using hx.2),
+    refine measurable_set_of_mem_nhds_within_Ioi_aux (λ x hx, _) (λ x hx, ⟨x₀, A x hx⟩),
+    obtain ⟨u, hu, us⟩ : ∃ (u : α) (H : u ∈ Ioi x), Ioo x u ⊆ s :=
+      (mem_nhds_within_Ioi_iff_exists_Ioo_subset' (A x hx)).1 (h x hx.1),
+    refine (mem_nhds_within_Ioi_iff_exists_Ioo_subset' (A x hx)).2 ⟨u, hu, λ y hy, ⟨us hy, _⟩⟩,
+    exact ne_of_lt (hy.2.trans_le (h₀ _)) },
+  { apply measurable_set_of_mem_nhds_within_Ioi_aux h,
+    simp only [is_top] at H,
+    push_neg at H,
+    exact H }
+end
+
+end linear_order
+
+@[measurability]
+lemma measurable.supr_Prop {α} [measurable_space α] [complete_lattice α]
+  (p : Prop) {f : δ → α} (hf : measurable f) :
+  measurable (λ b, ⨆ h : p, f b) :=
+classical.by_cases
+  (assume h : p, begin convert hf, funext, exact supr_pos h end)
+  (assume h : ¬p, begin convert measurable_const, funext, exact supr_neg h end)
+
+@[measurability]
+lemma measurable.infi_Prop {α} [measurable_space α] [complete_lattice α]
+  (p : Prop) {f : δ → α} (hf : measurable f) :
+  measurable (λ b, ⨅ h : p, f b) :=
+classical.by_cases
+  (assume h : p, begin convert hf, funext, exact infi_pos h end )
+  (assume h : ¬p, begin convert measurable_const, funext, exact infi_neg h end)
+
+section complete_linear_order
+
+variables [complete_linear_order α] [order_topology α] [second_countable_topology α]
+
+@[measurability]
+lemma measurable_supr {ι} [countable ι] {f : ι → δ → α} (hf : ∀ i, measurable (f i)) :
+  measurable (λ b, ⨆ i, f i b) :=
+measurable.is_lub hf $ λ b, is_lub_supr
+
+@[measurability]
+lemma ae_measurable_supr {ι} {μ : measure δ} [countable ι] {f : ι → δ → α}
+  (hf : ∀ i, ae_measurable (f i) μ) :
+  ae_measurable (λ b, ⨆ i, f i b) μ :=
+ae_measurable.is_lub hf $ (ae_of_all μ (λ b, is_lub_supr))
+
+@[measurability]
+lemma measurable_infi {ι} [countable ι] {f : ι → δ → α} (hf : ∀ i, measurable (f i)) :
+  measurable (λ b, ⨅ i, f i b) :=
+measurable.is_glb hf $ λ b, is_glb_infi
+
+@[measurability]
+lemma ae_measurable_infi {ι} {μ : measure δ} [countable ι] {f : ι → δ → α}
+  (hf : ∀ i, ae_measurable (f i) μ) :
+  ae_measurable (λ b, ⨅ i, f i b) μ :=
+ae_measurable.is_glb hf $ (ae_of_all μ (λ b, is_glb_infi))
+
+lemma measurable_bsupr {ι} (s : set ι) {f : ι → δ → α} (hs : s.countable)
+  (hf : ∀ i, measurable (f i)) : measurable (λ b, ⨆ i ∈ s, f i b) :=
+by { haveI : encodable s := hs.to_encodable, simp only [supr_subtype'],
+     exact measurable_supr (λ i, hf i) }
+
+lemma ae_measurable_bsupr {ι} {μ : measure δ} (s : set ι) {f : ι → δ → α} (hs : s.countable)
+  (hf : ∀ i, ae_measurable (f i) μ) : ae_measurable (λ b, ⨆ i ∈ s, f i b) μ :=
+begin
+  haveI : encodable s := hs.to_encodable,
+  simp only [supr_subtype'],
+  exact ae_measurable_supr (λ i, hf i),
+end
+
+lemma measurable_binfi {ι} (s : set ι) {f : ι → δ → α} (hs : s.countable)
+  (hf : ∀ i, measurable (f i)) : measurable (λ b, ⨅ i ∈ s, f i b) :=
+by { haveI : encodable s := hs.to_encodable, simp only [infi_subtype'],
+     exact measurable_infi (λ i, hf i) }
+
+lemma ae_measurable_binfi {ι} {μ : measure δ} (s : set ι) {f : ι → δ → α} (hs : s.countable)
+  (hf : ∀ i, ae_measurable (f i) μ) : ae_measurable (λ b, ⨅ i ∈ s, f i b) μ :=
+begin
+  haveI : encodable s := hs.to_encodable,
+  simp only [infi_subtype'],
+  exact ae_measurable_infi (λ i, hf i),
+end
+
+/-- `liminf` over a general filter is measurable. See `measurable_liminf` for the version over `ℕ`.
+-/
+lemma measurable_liminf' {ι ι'} {f : ι → δ → α} {u : filter ι} (hf : ∀ i, measurable (f i))
+  {p : ι' → Prop} {s : ι' → set ι} (hu : u.has_countable_basis p s) (hs : ∀ i, (s i).countable) :
+  measurable (λ x, liminf (λ i, f i x) u) :=
+begin
+  simp_rw [hu.to_has_basis.liminf_eq_supr_infi],
+  refine measurable_bsupr _ hu.countable _,
+  exact λ i, measurable_binfi _ (hs i) hf
+end
+
+/-- `limsup` over a general filter is measurable. See `measurable_limsup` for the version over `ℕ`.
+-/
+lemma measurable_limsup' {ι ι'}  {f : ι → δ → α} {u : filter ι} (hf : ∀ i, measurable (f i))
+  {p : ι' → Prop} {s : ι' → set ι} (hu : u.has_countable_basis p s) (hs : ∀ i, (s i).countable) :
+  measurable (λ x, limsup (λ i, f i x) u) :=
+begin
+  simp_rw [hu.to_has_basis.limsup_eq_infi_supr],
+  refine measurable_binfi _ hu.countable _,
+  exact λ i, measurable_bsupr _ (hs i) hf
+end
+
+/-- `liminf` over `ℕ` is measurable. See `measurable_liminf'` for a version with a general filter.
+-/
+@[measurability]
+lemma measurable_liminf {f : ℕ → δ → α} (hf : ∀ i, measurable (f i)) :
+  measurable (λ x, liminf (λ i, f i x) at_top) :=
+measurable_liminf' hf at_top_countable_basis (λ i, to_countable _)
+
+/-- `limsup` over `ℕ` is measurable. See `measurable_limsup'` for a version with a general filter.
+-/
+@[measurability]
+lemma measurable_limsup {f : ℕ → δ → α} (hf : ∀ i, measurable (f i)) :
+  measurable (λ x, limsup (λ i, f i x) at_top) :=
+measurable_limsup' hf at_top_countable_basis (λ i, to_countable _)
+
+end complete_linear_order
+
+section conditionally_complete_linear_order
+
+variables [conditionally_complete_linear_order α] [order_topology α] [second_countable_topology α]
+
+lemma measurable_cSup {ι} {f : ι → δ → α} {s : set ι} (hs : s.countable)
+  (hf : ∀ i, measurable (f i)) (bdd : ∀ x, bdd_above ((λ i, f i x) '' s)) :
+  measurable (λ x, Sup ((λ i, f i x) '' s)) :=
+begin
+  cases eq_empty_or_nonempty s with h2s h2s,
+  { simp [h2s, measurable_const] },
+  { apply measurable_of_Iic, intro y,
+    simp_rw [preimage, mem_Iic, cSup_le_iff (bdd _) (h2s.image _), ball_image_iff, set_of_forall],
+    exact measurable_set.bInter hs (λ i hi, measurable_set_le (hf i) measurable_const) }
+end
+
+lemma measurable_cInf {ι} {f : ι → δ → α} {s : set ι} (hs : s.countable)
+  (hf : ∀ i, measurable (f i)) (bdd : ∀ x, bdd_below ((λ i, f i x) '' s)) :
+  measurable (λ x, Inf ((λ i, f i x) '' s)) :=
+@measurable_cSup αᵒᵈ _ _ _ _ _ _ _ _ _ _ _ hs hf bdd
+
+lemma measurable_csupr {ι : Type*} [countable ι] {f : ι → δ → α}
+  (hf : ∀ i, measurable (f i)) (bdd : ∀ x, bdd_above (range (λ i, f i x))) :
+  measurable (λ x, ⨆ i, f i x) :=
+begin
+  change measurable (λ x, Sup (range (λ i : ι, f i x))),
+  simp_rw ← image_univ at bdd ⊢,
+  refine measurable_cSup countable_univ hf bdd,
+end
+
+lemma measurable_cinfi {ι : Type*} [countable ι] {f : ι → δ → α}
+  (hf : ∀ i, measurable (f i)) (bdd : ∀ x, bdd_below (range (λ i, f i x))) :
+  measurable (λ x, ⨅ i, f i x) :=
+@measurable_csupr αᵒᵈ _ _ _ _ _ _ _ _ _ _ _ hf bdd
+
+end conditionally_complete_linear_order
+
+/-- Convert a `homeomorph` to a `measurable_equiv`. -/
+def homemorph.to_measurable_equiv (h : α ≃ₜ β) : α ≃ᵐ β :=
+{ to_equiv := h.to_equiv,
+  measurable_to_fun := h.continuous_to_fun.measurable,
+  measurable_inv_fun := h.continuous_inv_fun.measurable }
+
+protected lemma is_finite_measure_on_compacts.map
+  {α : Type*} {m0 : measurable_space α} [topological_space α] [opens_measurable_space α]
+  {β : Type*} [measurable_space β] [topological_space β] [borel_space β]
+  [t2_space β] (μ : measure α) [is_finite_measure_on_compacts μ] (f : α ≃ₜ β) :
+  is_finite_measure_on_compacts (measure.map f μ) :=
+⟨begin
+  assume K hK,
+  rw [measure.map_apply f.measurable hK.measurable_set],
+  apply is_compact.measure_lt_top,
+  rwa f.is_compact_preimage
+end⟩
+
+end borel_space
+
+instance empty.borel_space : borel_space empty := ⟨borel_eq_top_of_discrete.symm⟩
+instance unit.borel_space : borel_space unit := ⟨borel_eq_top_of_discrete.symm⟩
+instance bool.borel_space : borel_space bool := ⟨borel_eq_top_of_discrete.symm⟩
+instance nat.borel_space : borel_space ℕ := ⟨borel_eq_top_of_discrete.symm⟩
+instance int.borel_space : borel_space ℤ := ⟨borel_eq_top_of_discrete.symm⟩
+instance rat.borel_space : borel_space ℚ := ⟨borel_eq_top_of_countable.symm⟩
+
+/- Instances on `real` and `complex` are special cases of `is_R_or_C` but without these instances,
+Lean fails to prove `borel_space (ι → ℝ)`, so we leave them here. -/
+
+instance real.measurable_space : measurable_space ℝ := borel ℝ
+instance real.borel_space : borel_space ℝ := ⟨rfl⟩
+
+instance nnreal.measurable_space : measurable_space ℝ≥0 := subtype.measurable_space
+instance nnreal.borel_space : borel_space ℝ≥0 := subtype.borel_space _
+
+instance ennreal.measurable_space : measurable_space ℝ≥0∞ := borel ℝ≥0∞
+instance ennreal.borel_space : borel_space ℝ≥0∞ := ⟨rfl⟩
+
+instance ereal.measurable_space : measurable_space ereal := borel ereal
+instance ereal.borel_space : borel_space ereal := ⟨rfl⟩
+
+/-- One can cut out `ℝ≥0∞` into the sets `{0}`, `Ico (t^n) (t^(n+1))` for `n : ℤ` and `{∞}`. This
+gives a way to compute the measure of a set in terms of sets on which a given function `f` does not
+fluctuate by more than `t`. -/
+lemma measure_eq_measure_preimage_add_measure_tsum_Ico_zpow [measurable_space α] (μ : measure α)
+  {f : α → ℝ≥0∞} (hf : measurable f) {s : set α} (hs : measurable_set s) {t : ℝ≥0} (ht : 1 < t) :
+  μ s = μ (s ∩ f⁻¹' {0}) + μ (s ∩ f⁻¹' {∞}) + ∑' (n : ℤ), μ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :=
+begin
+  have A : μ s = μ (s ∩ f⁻¹' {0}) + μ (s ∩ f⁻¹' (Ioi 0)),
+  { rw ← measure_union,
+    { congr' 1,
+      ext x,
+      have : 0 = f x ∨ 0 < f x := eq_or_lt_of_le bot_le,
+      rw eq_comm at this,
+      simp only [←and_or_distrib_left, this, mem_singleton_iff, mem_inter_iff, and_true,
+        mem_union, mem_Ioi, mem_preimage], },
+    { apply disjoint_left.2 (λ x hx h'x, _),
+      have : 0 < f x := h'x.2,
+      exact lt_irrefl 0 (this.trans_le hx.2.le) },
+    { exact hs.inter (hf measurable_set_Ioi) } },
+  have B : μ (s ∩ f⁻¹' (Ioi 0)) = μ (s ∩ f⁻¹' {∞}) + μ (s ∩ f⁻¹' (Ioo 0 ∞)),
+  { rw ← measure_union,
+    { rw ← inter_union_distrib_left,
+      congr,
+      ext x,
+      simp only [mem_singleton_iff, mem_union, mem_Ioo, mem_Ioi, mem_preimage],
+      have H : f x = ∞ ∨ f x < ∞ := eq_or_lt_of_le le_top,
+      cases H,
+      { simp only [H, eq_self_iff_true, or_false, with_top.zero_lt_top, not_top_lt, and_false] },
+      { simp only [H, H.ne, and_true, false_or] } },
+    { apply disjoint_left.2 (λ x hx h'x, _),
+      have : f x < ∞ := h'x.2.2,
+      exact lt_irrefl _ (this.trans_le (le_of_eq hx.2.symm)) },
+    { exact hs.inter (hf measurable_set_Ioo) } },
+  have C : μ (s ∩ f⁻¹' (Ioo 0 ∞)) = ∑' (n : ℤ), μ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))),
+  { rw [← measure_Union, ennreal.Ioo_zero_top_eq_Union_Ico_zpow (ennreal.one_lt_coe_iff.2 ht)
+         ennreal.coe_ne_top, preimage_Union, inter_Union],
+    { assume i j,
+      simp only [function.on_fun],
+      assume hij,
+      wlog h : i < j generalizing i j,
+      { exact (this hij.symm (hij.lt_or_lt.resolve_left h)).symm },
+      apply disjoint_left.2 (λ x hx h'x, lt_irrefl (f x) _),
+      calc f x < t ^ (i + 1) : hx.2.2
+      ... ≤ t ^ j : ennreal.zpow_le_of_le (ennreal.one_le_coe_iff.2 ht.le) h
+      ... ≤ f x : h'x.2.1 },
+    { assume n,
+      exact hs.inter (hf measurable_set_Ico) } },
+  rw [A, B, C, add_assoc],
+end
+
+section pseudo_metric_space
+
+variables [pseudo_metric_space α] [measurable_space α] [opens_measurable_space α]
+variables [measurable_space β] {x : α} {ε : ℝ}
+
+open metric
+
+@[measurability]
+lemma measurable_set_ball : measurable_set (metric.ball x ε) :=
+metric.is_open_ball.measurable_set
+
+@[measurability]
+lemma measurable_set_closed_ball : measurable_set (metric.closed_ball x ε) :=
+metric.is_closed_ball.measurable_set
+
+@[measurability]
+lemma measurable_inf_dist {s : set α} : measurable (λ x, inf_dist x s) :=
+(continuous_inf_dist_pt s).measurable
+
+@[measurability]
+lemma measurable.inf_dist {f : β → α} (hf : measurable f) {s : set α} :
+  measurable (λ x, inf_dist (f x) s) :=
+measurable_inf_dist.comp hf
+
+@[measurability]
+lemma measurable_inf_nndist {s : set α} : measurable (λ x, inf_nndist x s) :=
+(continuous_inf_nndist_pt s).measurable
+
+@[measurability]
+lemma measurable.inf_nndist {f : β → α} (hf : measurable f) {s : set α} :
+  measurable (λ x, inf_nndist (f x) s) :=
+measurable_inf_nndist.comp hf
+
+section
+variables [second_countable_topology α]
+
+@[measurability]
+lemma measurable_dist : measurable (λ p : α × α, dist p.1 p.2) :=
+continuous_dist.measurable
+
+@[measurability]
+lemma measurable.dist {f g : β → α} (hf : measurable f) (hg : measurable g) :
+  measurable (λ b, dist (f b) (g b)) :=
+(@continuous_dist α _).measurable2 hf hg
+
+@[measurability]
+lemma measurable_nndist : measurable (λ p : α × α, nndist p.1 p.2) :=
+continuous_nndist.measurable
+
+@[measurability]
+lemma measurable.nndist {f g : β → α} (hf : measurable f) (hg : measurable g) :
+  measurable (λ b, nndist (f b) (g b)) :=
+(@continuous_nndist α _).measurable2 hf hg
+
+end
+
+/-- If a set has a closed thickening with finite measure, then the measure of its `r`-closed
+thickenings converges to the measure of its closure as `r` tends to `0`. -/
+lemma tendsto_measure_cthickening {μ : measure α} {s : set α}
+  (hs : ∃ R > 0, μ (cthickening R s) ≠ ∞) :
+  tendsto (λ r, μ (cthickening r s)) (𝓝 0) (𝓝 (μ (closure s))) :=
+begin
+  have A : tendsto (λ r, μ (cthickening r s)) (𝓝[Ioi 0] 0) (𝓝 (μ (closure s))),
+  { rw closure_eq_Inter_cthickening,
+    exact tendsto_measure_bInter_gt (λ r hr, is_closed_cthickening.measurable_set)
+      (λ i j ipos ij, cthickening_mono ij _) hs },
+  have B : tendsto (λ r, μ (cthickening r s)) (𝓝[Iic 0] 0) (𝓝 (μ (closure s))),
+  { apply tendsto.congr' _ tendsto_const_nhds,
+    filter_upwards [self_mem_nhds_within] with _ hr,
+    rw cthickening_of_nonpos hr, },
+  convert B.sup A,
+  exact (nhds_left_sup_nhds_right' 0).symm,
+end
+
+/-- If a closed set has a closed thickening with finite measure, then the measure of its `r`-closed
+thickenings converges to its measure as `r` tends to `0`. -/
+lemma tendsto_measure_cthickening_of_is_closed {μ : measure α} {s : set α}
+  (hs : ∃ R > 0, μ (cthickening R s) ≠ ∞) (h's : is_closed s) :
+  tendsto (λ r, μ (cthickening r s)) (𝓝 0) (𝓝 (μ s)) :=
+begin
+  convert tendsto_measure_cthickening hs,
+  exact h's.closure_eq.symm
+end
+
+end pseudo_metric_space
+
+/-- Given a compact set in a proper space, the measure of its `r`-closed thickenings converges to
+its measure as `r` tends to `0`. -/
+lemma tendsto_measure_cthickening_of_is_compact [metric_space α] [measurable_space α]
+  [opens_measurable_space α] [proper_space α] {μ : measure α}
+  [is_finite_measure_on_compacts μ] {s : set α} (hs : is_compact s) :
+  tendsto (λ r, μ (metric.cthickening r s)) (𝓝 0) (𝓝 (μ s)) :=
+tendsto_measure_cthickening_of_is_closed
+  ⟨1, zero_lt_one, hs.bounded.cthickening.measure_lt_top.ne⟩ hs.is_closed
+
+section pseudo_emetric_space
+
+variables [pseudo_emetric_space α] [measurable_space α] [opens_measurable_space α]
+variables [measurable_space β] {x : α} {ε : ℝ≥0∞}
+
+open emetric
+
+@[measurability]
+lemma measurable_set_eball : measurable_set (emetric.ball x ε) :=
+emetric.is_open_ball.measurable_set
+
+@[measurability]
+lemma measurable_edist_right : measurable (edist x) :=
+(continuous_const.edist continuous_id).measurable
+
+@[measurability]
+lemma measurable_edist_left : measurable (λ y, edist y x) :=
+(continuous_id.edist continuous_const).measurable
+
+@[measurability]
+lemma measurable_inf_edist {s : set α} : measurable (λ x, inf_edist x s) :=
+continuous_inf_edist.measurable
+
+@[measurability]
+lemma measurable.inf_edist {f : β → α} (hf : measurable f) {s : set α} :
+  measurable (λ x, inf_edist (f x) s) :=
+measurable_inf_edist.comp hf
+
+variables [second_countable_topology α]
+
+@[measurability]
+lemma measurable_edist : measurable (λ p : α × α, edist p.1 p.2) :=
+continuous_edist.measurable
+
+@[measurability]
+lemma measurable.edist {f g : β → α} (hf : measurable f) (hg : measurable g) :
+  measurable (λ b, edist (f b) (g b)) :=
+(@continuous_edist α _).measurable2 hf hg
+
+@[measurability]
+lemma ae_measurable.edist {f g : β → α} {μ : measure β}
+  (hf : ae_measurable f μ) (hg : ae_measurable g μ) : ae_measurable (λ a, edist (f a) (g a)) μ :=
+(@continuous_edist α _).ae_measurable2 hf hg
+
+end pseudo_emetric_space
+
+namespace real
+open measurable_space measure_theory
+
+lemma borel_eq_generate_from_Ioo_rat :
+  borel ℝ = generate_from (⋃(a b : ℚ) (h : a < b), {Ioo a b}) :=
+is_topological_basis_Ioo_rat.borel_eq_generate_from
+
+lemma is_pi_system_Ioo_rat : @is_pi_system ℝ (⋃ (a b : ℚ) (h : a < b), {Ioo a b})  :=
+begin
+  convert is_pi_system_Ioo (coe : ℚ → ℝ) (coe : ℚ → ℝ),
+  ext x,
+  simp [eq_comm]
+end
+
+/-- The intervals `(-(n + 1), (n + 1))` form a finite spanning sets in the set of open intervals
+with rational endpoints for a locally finite measure `μ` on `ℝ`. -/
+def finite_spanning_sets_in_Ioo_rat (μ : measure ℝ) [is_locally_finite_measure μ] :
+  μ.finite_spanning_sets_in (⋃ (a b : ℚ) (h : a < b), {Ioo a b}) :=
+{ set := λ n, Ioo (-(n + 1)) (n + 1),
+  set_mem := λ n,
+    begin
+      simp only [mem_Union, mem_singleton_iff],
+      refine ⟨-(n + 1 : ℕ), n + 1, _, by simp⟩, -- TODO: norm_cast fails here?
+      exact (neg_nonpos.2 (@nat.cast_nonneg ℚ _ (n + 1))).trans_lt n.cast_add_one_pos
+    end,
+  finite := λ n, measure_Ioo_lt_top,
+  spanning := Union_eq_univ_iff.2 $ λ x,
+    ⟨⌊|x|⌋₊, neg_lt.1 ((neg_le_abs_self x).trans_lt (nat.lt_floor_add_one _)),
+      (le_abs_self x).trans_lt (nat.lt_floor_add_one _)⟩ }
+
+lemma measure_ext_Ioo_rat {μ ν : measure ℝ} [is_locally_finite_measure μ]
+  (h : ∀ a b : ℚ, μ (Ioo a b) = ν (Ioo a b)) : μ = ν :=
+(finite_spanning_sets_in_Ioo_rat μ).ext borel_eq_generate_from_Ioo_rat is_pi_system_Ioo_rat $
+  by { simp only [mem_Union, mem_singleton_iff], rintro _ ⟨a, b, -, rfl⟩, apply h }
+
+lemma borel_eq_generate_from_Iio_rat :
+  borel ℝ = generate_from (⋃ a : ℚ, {Iio a}) :=
+begin
+  let g : measurable_space ℝ := generate_from (⋃ a : ℚ, {Iio a}),
+  refine le_antisymm _ _,
+  { rw borel_eq_generate_from_Ioo_rat,
+    refine generate_from_le (λ t, _),
+    simp only [mem_Union, mem_singleton_iff], rintro ⟨a, b, h, rfl⟩,
+    rw (set.ext (λ x, _) : Ioo (a : ℝ) b = (⋃c>a, (Iio c)ᶜ) ∩ Iio b),
+    { have hg : ∀ q : ℚ, measurable_set[g] (Iio q) :=
+        λ q, generate_measurable.basic (Iio q) (by simp),
+      refine @measurable_set.inter _ g _ _ _ (hg _),
+      refine @measurable_set.bUnion _ _ g _ _ (to_countable _) (λ c h, _),
+      exact @measurable_set.compl _ _ g (hg _) },
+    { suffices : x < ↑b → (↑a < x ↔ ∃ (i : ℚ), a < i ∧ ↑i ≤ x), by simpa,
+      refine λ _, ⟨λ h, _, λ ⟨i, hai, hix⟩, (rat.cast_lt.2 hai).trans_le hix⟩,
+      rcases exists_rat_btwn h with ⟨c, ac, cx⟩,
+      exact ⟨c, rat.cast_lt.1 ac, cx.le⟩ } },
+  { refine measurable_space.generate_from_le (λ _, _),
+    simp only [mem_Union, mem_singleton_iff], rintro ⟨r, rfl⟩, exact measurable_set_Iio }
+end
+
+end real
+
+variable [measurable_space α]
+
+@[measurability]
+lemma measurable_real_to_nnreal : measurable (real.to_nnreal) :=
+continuous_real_to_nnreal.measurable
+
+@[measurability]
+lemma measurable.real_to_nnreal {f : α → ℝ} (hf : measurable f) :
+  measurable (λ x, real.to_nnreal (f x)) :=
+measurable_real_to_nnreal.comp hf
+
+@[measurability]
+lemma ae_measurable.real_to_nnreal {f : α → ℝ} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, real.to_nnreal (f x)) μ :=
+measurable_real_to_nnreal.comp_ae_measurable hf
+
+@[measurability]
+lemma measurable_coe_nnreal_real : measurable (coe : ℝ≥0 → ℝ) :=
+nnreal.continuous_coe.measurable
+
+@[measurability]
+lemma measurable.coe_nnreal_real {f : α → ℝ≥0} (hf : measurable f) :
+  measurable (λ x, (f x : ℝ)) :=
+measurable_coe_nnreal_real.comp hf
+
+@[measurability]
+lemma ae_measurable.coe_nnreal_real {f : α → ℝ≥0} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, (f x : ℝ)) μ :=
+measurable_coe_nnreal_real.comp_ae_measurable hf
+
+@[measurability]
+lemma measurable_coe_nnreal_ennreal : measurable (coe : ℝ≥0 → ℝ≥0∞) :=
+ennreal.continuous_coe.measurable
+
+@[measurability]
+lemma measurable.coe_nnreal_ennreal {f : α → ℝ≥0} (hf : measurable f) :
+  measurable (λ x, (f x : ℝ≥0∞)) :=
+ennreal.continuous_coe.measurable.comp hf
+
+@[measurability]
+lemma ae_measurable.coe_nnreal_ennreal {f : α → ℝ≥0} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, (f x : ℝ≥0∞)) μ :=
+ennreal.continuous_coe.measurable.comp_ae_measurable hf
+
+@[measurability]
+lemma measurable.ennreal_of_real {f : α → ℝ} (hf : measurable f) :
+  measurable (λ x, ennreal.of_real (f x)) :=
+ennreal.continuous_of_real.measurable.comp hf
+
+@[simp, norm_cast]
+lemma measurable_coe_nnreal_real_iff {f : α → ℝ≥0} : measurable (λ x, f x : α → ℝ) ↔ measurable f :=
+⟨λ h, by simpa only [real.to_nnreal_coe] using h.real_to_nnreal, measurable.coe_nnreal_real⟩
+
+@[simp, norm_cast]
+lemma ae_measurable_coe_nnreal_real_iff {f : α → ℝ≥0} {μ : measure α} :
+  ae_measurable (λ x, f x : α → ℝ) μ ↔ ae_measurable f μ :=
+⟨λ h, by simpa only [real.to_nnreal_coe] using h.real_to_nnreal, ae_measurable.coe_nnreal_real⟩
+
+/-- The set of finite `ℝ≥0∞` numbers is `measurable_equiv` to `ℝ≥0`. -/
+def measurable_equiv.ennreal_equiv_nnreal : {r : ℝ≥0∞ | r ≠ ∞} ≃ᵐ ℝ≥0 :=
+ennreal.ne_top_homeomorph_nnreal.to_measurable_equiv
+
+namespace ennreal
+
+lemma measurable_of_measurable_nnreal {f : ℝ≥0∞ → α}
+  (h : measurable (λ p : ℝ≥0, f p)) : measurable f :=
+measurable_of_measurable_on_compl_singleton ∞
+  (measurable_equiv.ennreal_equiv_nnreal.symm.measurable_comp_iff.1 h)
+
+/-- `ℝ≥0∞` is `measurable_equiv` to `ℝ≥0 ⊕ unit`. -/
+def ennreal_equiv_sum : ℝ≥0∞ ≃ᵐ ℝ≥0 ⊕ unit :=
+{ measurable_to_fun  := measurable_of_measurable_nnreal measurable_inl,
+  measurable_inv_fun := measurable_sum measurable_coe_nnreal_ennreal
+    (@measurable_const ℝ≥0∞ unit _ _ ∞),
+  .. equiv.option_equiv_sum_punit ℝ≥0 }
+
+open function (uncurry)
+
+lemma measurable_of_measurable_nnreal_prod [measurable_space β] [measurable_space γ]
+  {f : ℝ≥0∞ × β → γ} (H₁ : measurable (λ p : ℝ≥0 × β, f (p.1, p.2)))
+  (H₂ : measurable (λ x, f (∞, x))) :
+  measurable f :=
+let e : ℝ≥0∞ × β ≃ᵐ ℝ≥0 × β ⊕ unit × β :=
+  (ennreal_equiv_sum.prod_congr (measurable_equiv.refl β)).trans
+    (measurable_equiv.sum_prod_distrib _ _ _) in
+e.symm.measurable_comp_iff.1 $ measurable_sum H₁ (H₂.comp measurable_id.snd)
+
+lemma measurable_of_measurable_nnreal_nnreal [measurable_space β]
+  {f : ℝ≥0∞ × ℝ≥0∞ → β} (h₁ : measurable (λ p : ℝ≥0 × ℝ≥0, f (p.1, p.2)))
+  (h₂ : measurable (λ r : ℝ≥0, f (∞, r))) (h₃ : measurable (λ r : ℝ≥0, f (r, ∞))) :
+  measurable f :=
+measurable_of_measurable_nnreal_prod
+  (measurable_swap_iff.1 $ measurable_of_measurable_nnreal_prod (h₁.comp measurable_swap) h₃)
+  (measurable_of_measurable_nnreal h₂)
+
+@[measurability]
+lemma measurable_of_real : measurable ennreal.of_real :=
+ennreal.continuous_of_real.measurable
+
+@[measurability]
+lemma measurable_to_real : measurable ennreal.to_real :=
+ennreal.measurable_of_measurable_nnreal measurable_coe_nnreal_real
+
+@[measurability]
+lemma measurable_to_nnreal : measurable ennreal.to_nnreal :=
+ennreal.measurable_of_measurable_nnreal measurable_id
+
+instance : has_measurable_mul₂ ℝ≥0∞ :=
+begin
+  refine ⟨measurable_of_measurable_nnreal_nnreal _ _ _⟩,
+  { simp only [← ennreal.coe_mul, measurable_mul.coe_nnreal_ennreal] },
+  { simp only [ennreal.top_mul, ennreal.coe_eq_zero],
+    exact measurable_const.piecewise (measurable_set_singleton _) measurable_const },
+  { simp only [ennreal.mul_top, ennreal.coe_eq_zero],
+    exact measurable_const.piecewise (measurable_set_singleton _) measurable_const }
+end
+
+instance : has_measurable_sub₂ ℝ≥0∞ :=
+⟨by apply measurable_of_measurable_nnreal_nnreal;
+  simp [← with_top.coe_sub, continuous_sub.measurable.coe_nnreal_ennreal]⟩
+
+instance : has_measurable_inv ℝ≥0∞ := ⟨continuous_inv.measurable⟩
+
+end ennreal
+
+@[measurability]
+lemma measurable.ennreal_to_nnreal {f : α → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ x, (f x).to_nnreal) :=
+ennreal.measurable_to_nnreal.comp hf
+
+@[measurability]
+lemma ae_measurable.ennreal_to_nnreal {f : α → ℝ≥0∞} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, (f x).to_nnreal) μ :=
+ennreal.measurable_to_nnreal.comp_ae_measurable hf
+
+@[simp, norm_cast] lemma measurable_coe_nnreal_ennreal_iff {f : α → ℝ≥0} :
+  measurable (λ x, (f x : ℝ≥0∞)) ↔ measurable f :=
+⟨λ h, h.ennreal_to_nnreal, λ h, h.coe_nnreal_ennreal⟩
+
+@[simp, norm_cast] lemma ae_measurable_coe_nnreal_ennreal_iff {f : α → ℝ≥0} {μ : measure α} :
+  ae_measurable (λ x, (f x : ℝ≥0∞)) μ ↔ ae_measurable f μ :=
+⟨λ h, h.ennreal_to_nnreal, λ h, h.coe_nnreal_ennreal⟩
+
+@[measurability]
+lemma measurable.ennreal_to_real {f : α → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ x, ennreal.to_real (f x)) :=
+ennreal.measurable_to_real.comp hf
+
+@[measurability]
+lemma ae_measurable.ennreal_to_real {f : α → ℝ≥0∞} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, ennreal.to_real (f x)) μ :=
+ennreal.measurable_to_real.comp_ae_measurable hf
+
+/-- note: `ℝ≥0∞` can probably be generalized in a future version of this lemma. -/
+@[measurability]
+lemma measurable.ennreal_tsum {ι} [countable ι] {f : ι → α → ℝ≥0∞} (h : ∀ i, measurable (f i)) :
+  measurable (λ x, ∑' i, f i x) :=
+by { simp_rw [ennreal.tsum_eq_supr_sum], apply measurable_supr,
+  exact λ s, s.measurable_sum (λ i _, h i) }
+
+@[measurability]
+lemma measurable.ennreal_tsum' {ι} [countable ι] {f : ι → α → ℝ≥0∞} (h : ∀ i, measurable (f i)) :
+  measurable (∑' i, f i) :=
+begin
+  convert measurable.ennreal_tsum h,
+  ext1 x,
+  exact tsum_apply (pi.summable.2 (λ _, ennreal.summable)),
+end
+
+@[measurability]
+lemma measurable.nnreal_tsum {ι} [countable ι] {f : ι → α → ℝ≥0} (h : ∀ i, measurable (f i)) :
+  measurable (λ x, ∑' i, f i x) :=
+begin
+  simp_rw [nnreal.tsum_eq_to_nnreal_tsum],
+  exact (measurable.ennreal_tsum (λ i, (h i).coe_nnreal_ennreal)).ennreal_to_nnreal,
+end
+
+@[measurability]
+lemma ae_measurable.ennreal_tsum {ι} [countable ι] {f : ι → α → ℝ≥0∞} {μ : measure α}
+  (h : ∀ i, ae_measurable (f i) μ) :
+  ae_measurable (λ x, ∑' i, f i x) μ :=
+by { simp_rw [ennreal.tsum_eq_supr_sum], apply ae_measurable_supr,
+  exact λ s, finset.ae_measurable_sum s (λ i _, h i) }
+
+@[measurability]
+lemma ae_measurable.nnreal_tsum {α : Type*} [measurable_space α] {ι : Type*}
+  [countable ι] {f : ι → α → nnreal} {μ : measure_theory.measure α}
+  (h : ∀ (i : ι), ae_measurable (f i) μ) :
+  ae_measurable (λ (x : α), ∑' (i : ι), f i x) μ :=
+begin
+  simp_rw [nnreal.tsum_eq_to_nnreal_tsum],
+  exact (ae_measurable.ennreal_tsum (λ i, (h i).coe_nnreal_ennreal)).ennreal_to_nnreal,
+end
+
+@[measurability]
+lemma measurable_coe_real_ereal : measurable (coe : ℝ → ereal) :=
+continuous_coe_real_ereal.measurable
+
+@[measurability]
+lemma measurable.coe_real_ereal {f : α → ℝ} (hf : measurable f) :
+  measurable (λ x, (f x : ereal)) :=
+measurable_coe_real_ereal.comp hf
+
+@[measurability]
+lemma ae_measurable.coe_real_ereal {f : α → ℝ} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, (f x : ereal)) μ :=
+measurable_coe_real_ereal.comp_ae_measurable hf
+
+/-- The set of finite `ereal` numbers is `measurable_equiv` to `ℝ`. -/
+def measurable_equiv.ereal_equiv_real : ({⊥, ⊤}ᶜ : set ereal) ≃ᵐ ℝ :=
+ereal.ne_bot_top_homeomorph_real.to_measurable_equiv
+
+lemma ereal.measurable_of_measurable_real {f : ereal → α}
+  (h : measurable (λ p : ℝ, f p)) : measurable f :=
+measurable_of_measurable_on_compl_finite {⊥, ⊤} (by simp)
+  (measurable_equiv.ereal_equiv_real.symm.measurable_comp_iff.1 h)
+
+@[measurability]
+lemma measurable_ereal_to_real : measurable ereal.to_real :=
+ereal.measurable_of_measurable_real (by simpa using measurable_id)
+
+@[measurability]
+lemma measurable.ereal_to_real {f : α → ereal} (hf : measurable f) :
+  measurable (λ x, (f x).to_real) :=
+measurable_ereal_to_real.comp hf
+
+@[measurability]
+lemma ae_measurable.ereal_to_real {f : α → ereal} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, (f x).to_real) μ :=
+measurable_ereal_to_real.comp_ae_measurable hf
+
+@[measurability]
+lemma measurable_coe_ennreal_ereal : measurable (coe : ℝ≥0∞ → ereal) :=
+continuous_coe_ennreal_ereal.measurable
+
+@[measurability]
+lemma measurable.coe_ereal_ennreal {f : α → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ x, (f x : ereal)) :=
+measurable_coe_ennreal_ereal.comp hf
+
+@[measurability]
+lemma ae_measurable.coe_ereal_ennreal {f : α → ℝ≥0∞} {μ : measure α} (hf : ae_measurable f μ) :
+  ae_measurable (λ x, (f x : ereal)) μ :=
+measurable_coe_ennreal_ereal.comp_ae_measurable hf
+
+section normed_add_comm_group
+
+variables [normed_add_comm_group α] [opens_measurable_space α] [measurable_space β]
+
+@[measurability]
+lemma measurable_norm : measurable (norm : α → ℝ) :=
+continuous_norm.measurable
+
+@[measurability]
+lemma measurable.norm {f : β → α} (hf : measurable f) : measurable (λ a, norm (f a)) :=
+measurable_norm.comp hf
+
+@[measurability]
+lemma ae_measurable.norm {f : β → α} {μ : measure β} (hf : ae_measurable f μ) :
+  ae_measurable (λ a, norm (f a)) μ :=
+measurable_norm.comp_ae_measurable hf
+
+@[measurability]
+lemma measurable_nnnorm : measurable (nnnorm : α → ℝ≥0) :=
+continuous_nnnorm.measurable
+
+@[measurability]
+lemma measurable.nnnorm {f : β → α} (hf : measurable f) : measurable (λ a, ‖f a‖₊) :=
+measurable_nnnorm.comp hf
+
+@[measurability]
+lemma ae_measurable.nnnorm {f : β → α} {μ : measure β} (hf : ae_measurable f μ) :
+  ae_measurable (λ a, ‖f a‖₊) μ :=
+measurable_nnnorm.comp_ae_measurable hf
+
+@[measurability]
+lemma measurable_ennnorm : measurable (λ x : α, (‖x‖₊ : ℝ≥0∞)) :=
+measurable_nnnorm.coe_nnreal_ennreal
+
+@[measurability]
+lemma measurable.ennnorm {f : β → α} (hf : measurable f) :
+  measurable (λ a, (‖f a‖₊ : ℝ≥0∞)) :=
+hf.nnnorm.coe_nnreal_ennreal
+
+@[measurability]
+lemma ae_measurable.ennnorm {f : β → α} {μ : measure β} (hf : ae_measurable f μ) :
+  ae_measurable (λ a, (‖f a‖₊ : ℝ≥0∞)) μ :=
+measurable_ennnorm.comp_ae_measurable hf
+
+end normed_add_comm_group
diff --git a/src/measure_theory/constructions/borel_space/complex.lean b/src/measure_theory/constructions/borel_space/complex.lean
new file mode 100644
index 0000000000000..de7034d99a042
--- /dev/null
+++ b/src/measure_theory/constructions/borel_space/complex.lean
@@ -0,0 +1,23 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import analysis.complex.basic
+import measure_theory.constructions.borel_space.basic
+
+/-! # Equip `ℂ` with the Borel sigma-algebra 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
+
+noncomputable theory
+
+@[priority 900]
+instance is_R_or_C.measurable_space {𝕜 : Type*} [is_R_or_C 𝕜] : measurable_space 𝕜 := borel 𝕜
+@[priority 900]
+instance is_R_or_C.borel_space {𝕜 : Type*} [is_R_or_C 𝕜] : borel_space 𝕜 := ⟨rfl⟩
+
+
+instance complex.measurable_space : measurable_space ℂ := borel ℂ
+instance complex.borel_space : borel_space ℂ := ⟨rfl⟩
diff --git a/src/measure_theory/constructions/borel_space/continuous_linear_map.lean b/src/measure_theory/constructions/borel_space/continuous_linear_map.lean
new file mode 100644
index 0000000000000..ee21c514a2f3b
--- /dev/null
+++ b/src/measure_theory/constructions/borel_space/continuous_linear_map.lean
@@ -0,0 +1,97 @@
+/-
+Copyright (c) 2020 Patrick Massot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot
+-/
+import analysis.normed_space.finite_dimension
+import measure_theory.constructions.borel_space.basic
+
+/-!
+# Measurable functions in normed spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+open measure_theory
+
+variables {α : Type*} [measurable_space α]
+
+namespace continuous_linear_map
+
+variables {𝕜 : Type*} [normed_field 𝕜]
+variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [measurable_space E]
+  [opens_measurable_space E] {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+  [measurable_space F] [borel_space F]
+
+@[measurability]
+protected lemma measurable (L : E →L[𝕜] F) : measurable L :=
+L.continuous.measurable
+
+lemma measurable_comp (L : E →L[𝕜] F) {φ : α → E} (φ_meas : measurable φ) :
+  measurable (λ (a : α), L (φ a)) :=
+L.measurable.comp φ_meas
+
+end continuous_linear_map
+
+namespace continuous_linear_map
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+          {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+
+instance : measurable_space (E →L[𝕜] F) := borel _
+
+instance : borel_space (E →L[𝕜] F) := ⟨rfl⟩
+
+@[measurability]
+lemma measurable_apply [measurable_space F] [borel_space F] (x : E) :
+  measurable (λ f : E →L[𝕜] F, f x) :=
+(apply 𝕜 F x).continuous.measurable
+
+@[measurability]
+lemma measurable_apply' [measurable_space E] [opens_measurable_space E]
+  [measurable_space F] [borel_space F] :
+  measurable (λ (x : E) (f : E →L[𝕜] F), f x) :=
+measurable_pi_lambda _ $ λ f, f.measurable
+
+@[measurability]
+lemma measurable_coe [measurable_space F] [borel_space F] :
+  measurable (λ (f : E →L[𝕜] F) (x : E), f x) :=
+measurable_pi_lambda _ measurable_apply
+
+end continuous_linear_map
+
+section continuous_linear_map_nontrivially_normed_field
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E] [measurable_space E]
+  [borel_space E] {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+
+@[measurability]
+lemma measurable.apply_continuous_linear_map  {φ : α → F →L[𝕜] E} (hφ : measurable φ) (v : F) :
+  measurable (λ a, φ a v) :=
+(continuous_linear_map.apply 𝕜 E v).measurable.comp hφ
+
+@[measurability]
+lemma ae_measurable.apply_continuous_linear_map {φ : α → F →L[𝕜] E} {μ : measure α}
+  (hφ : ae_measurable φ μ) (v : F) : ae_measurable (λ a, φ a v) μ :=
+(continuous_linear_map.apply 𝕜 E v).measurable.comp_ae_measurable hφ
+
+end continuous_linear_map_nontrivially_normed_field
+
+section normed_space
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [complete_space 𝕜] [measurable_space 𝕜]
+variables [borel_space 𝕜] {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+  [measurable_space E] [borel_space E]
+
+lemma measurable_smul_const {f : α → 𝕜} {c : E} (hc : c ≠ 0) :
+  measurable (λ x, f x • c) ↔ measurable f :=
+(closed_embedding_smul_left hc).measurable_embedding.measurable_comp_iff
+
+lemma ae_measurable_smul_const {f : α → 𝕜} {μ : measure α} {c : E} (hc : c ≠ 0) :
+  ae_measurable (λ x, f x • c) μ ↔ ae_measurable f μ :=
+(closed_embedding_smul_left hc).measurable_embedding.ae_measurable_comp_iff
+
+end normed_space
diff --git a/src/measure_theory/constructions/borel_space/metrizable.lean b/src/measure_theory/constructions/borel_space/metrizable.lean
new file mode 100644
index 0000000000000..36478e37f5677
--- /dev/null
+++ b/src/measure_theory/constructions/borel_space/metrizable.lean
@@ -0,0 +1,175 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import measure_theory.constructions.borel_space.basic
+import topology.metric_space.metrizable
+
+/-!
+# Measurable functions in (pseudo-)metrizable Borel spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open filter measure_theory topological_space
+open_locale classical topology nnreal ennreal measure_theory
+
+variables {α β : Type*} [measurable_space α]
+
+section limits
+
+variables [topological_space β] [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
+
+open metric
+
+/-- A limit (over a general filter) of measurable `ℝ≥0∞` valued functions is measurable. -/
+lemma measurable_of_tendsto_ennreal' {ι} {f : ι → α → ℝ≥0∞} {g : α → ℝ≥0∞} (u : filter ι)
+  [ne_bot u] [is_countably_generated u] (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
+  measurable g :=
+begin
+  rcases u.exists_seq_tendsto with ⟨x, hx⟩,
+  rw [tendsto_pi_nhds] at lim,
+  have : (λ y, liminf (λ n, (f (x n) y : ℝ≥0∞)) at_top) = g :=
+    by { ext1 y, exact ((lim y).comp hx).liminf_eq, },
+  rw ← this,
+  show measurable (λ y, liminf (λ n, (f (x n) y : ℝ≥0∞)) at_top),
+  exact measurable_liminf (λ n, hf (x n)),
+end
+
+/-- A sequential limit of measurable `ℝ≥0∞` valued functions is measurable. -/
+lemma measurable_of_tendsto_ennreal {f : ℕ → α → ℝ≥0∞} {g : α → ℝ≥0∞}
+  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) : measurable g :=
+measurable_of_tendsto_ennreal' at_top hf lim
+
+/-- A limit (over a general filter) of measurable `ℝ≥0` valued functions is measurable. -/
+lemma measurable_of_tendsto_nnreal' {ι} {f : ι → α → ℝ≥0} {g : α → ℝ≥0} (u : filter ι)
+  [ne_bot u] [is_countably_generated u] (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
+  measurable g :=
+begin
+  simp_rw [← measurable_coe_nnreal_ennreal_iff] at hf ⊢,
+  refine measurable_of_tendsto_ennreal' u hf _,
+  rw tendsto_pi_nhds at lim ⊢,
+  exact λ x, (ennreal.continuous_coe.tendsto (g x)).comp (lim x),
+end
+
+/-- A sequential limit of measurable `ℝ≥0` valued functions is measurable. -/
+lemma measurable_of_tendsto_nnreal {f : ℕ → α → ℝ≥0} {g : α → ℝ≥0}
+  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) : measurable g :=
+measurable_of_tendsto_nnreal' at_top hf lim
+
+/-- A limit (over a general filter) of measurable functions valued in a (pseudo) metrizable space is
+measurable. -/
+lemma measurable_of_tendsto_metrizable' {ι} {f : ι → α → β} {g : α → β}
+  (u : filter ι) [ne_bot u] [is_countably_generated u]
+  (hf : ∀ i, measurable (f i)) (lim : tendsto f u (𝓝 g)) :
+  measurable g :=
+begin
+  letI : pseudo_metric_space β := pseudo_metrizable_space_pseudo_metric β,
+  apply measurable_of_is_closed', intros s h1s h2s h3s,
+  have : measurable (λ x, inf_nndist (g x) s),
+  { suffices : tendsto (λ i x, inf_nndist (f i x) s) u (𝓝 (λ x, inf_nndist (g x) s)),
+      from measurable_of_tendsto_nnreal' u (λ i, (hf i).inf_nndist) this,
+    rw [tendsto_pi_nhds] at lim ⊢, intro x,
+    exact ((continuous_inf_nndist_pt s).tendsto (g x)).comp (lim x) },
+  have h4s : g ⁻¹' s = (λ x, inf_nndist (g x) s) ⁻¹' {0},
+  { ext x, simp [h1s, ← h1s.mem_iff_inf_dist_zero h2s, ← nnreal.coe_eq_zero] },
+  rw [h4s], exact this (measurable_set_singleton 0),
+end
+
+/-- A sequential limit of measurable functions valued in a (pseudo) metrizable space is
+measurable. -/
+lemma measurable_of_tendsto_metrizable {f : ℕ → α → β} {g : α → β}
+  (hf : ∀ i, measurable (f i)) (lim : tendsto f at_top (𝓝 g)) :
+  measurable g :=
+measurable_of_tendsto_metrizable' at_top hf lim
+
+lemma ae_measurable_of_tendsto_metrizable_ae {ι}
+  {μ : measure α} {f : ι → α → β} {g : α → β}
+  (u : filter ι) [hu : ne_bot u] [is_countably_generated u]
+  (hf : ∀ n, ae_measurable (f n) μ) (h_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, f n x) u (𝓝 (g x))) :
+  ae_measurable g μ :=
+begin
+  rcases u.exists_seq_tendsto with ⟨v, hv⟩,
+  have h'f : ∀ n, ae_measurable (f (v n)) μ := λ n, hf (v n),
+  set p : α → (ℕ → β) → Prop := λ x f', tendsto (λ n, f' n) at_top (𝓝 (g x)),
+  have hp : ∀ᵐ x ∂μ, p x (λ n, f (v n) x),
+    by filter_upwards [h_tendsto] with x hx using hx.comp hv,
+  set ae_seq_lim := λ x, ite (x ∈ ae_seq_set h'f p) (g x) (⟨f (v 0) x⟩ : nonempty β).some with hs,
+  refine ⟨ae_seq_lim, measurable_of_tendsto_metrizable' at_top (ae_seq.measurable h'f p)
+    (tendsto_pi_nhds.mpr (λ x, _)), _⟩,
+  { simp_rw [ae_seq, ae_seq_lim],
+    split_ifs with hx,
+    { simp_rw ae_seq.mk_eq_fun_of_mem_ae_seq_set h'f hx,
+      exact @ae_seq.fun_prop_of_mem_ae_seq_set _ α β _ _ _ _ _ h'f x hx, },
+    { exact tendsto_const_nhds } },
+  { exact (ite_ae_eq_of_measure_compl_zero g (λ x, (⟨f (v 0) x⟩ : nonempty β).some)
+      (ae_seq_set h'f p) (ae_seq.measure_compl_ae_seq_set_eq_zero h'f hp)).symm },
+end
+
+lemma ae_measurable_of_tendsto_metrizable_ae' {μ : measure α} {f : ℕ → α → β} {g : α → β}
+  (hf : ∀ n, ae_measurable (f n) μ)
+  (h_ae_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
+  ae_measurable g μ :=
+ae_measurable_of_tendsto_metrizable_ae at_top hf h_ae_tendsto
+
+lemma ae_measurable_of_unif_approx {β} [measurable_space β] [pseudo_metric_space β] [borel_space β]
+  {μ : measure α} {g : α → β}
+  (hf : ∀ ε > (0 : ℝ), ∃ (f : α → β), ae_measurable f μ ∧ ∀ᵐ x ∂μ, dist (f x) (g x) ≤ ε) :
+  ae_measurable g μ :=
+begin
+  obtain ⟨u, u_anti, u_pos, u_lim⟩ :
+    ∃ (u : ℕ → ℝ), strict_anti u ∧ (∀ (n : ℕ), 0 < u n) ∧ tendsto u at_top (𝓝 0) :=
+      exists_seq_strict_anti_tendsto (0 : ℝ),
+  choose f Hf using λ (n : ℕ), hf (u n) (u_pos n),
+  have : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x)),
+  { have : ∀ᵐ x ∂ μ, ∀ n, dist (f n x) (g x) ≤ u n := ae_all_iff.2 (λ n, (Hf n).2),
+    filter_upwards [this],
+    assume x hx,
+    rw tendsto_iff_dist_tendsto_zero,
+    exact squeeze_zero (λ n, dist_nonneg) hx u_lim },
+  exact ae_measurable_of_tendsto_metrizable_ae' (λ n, (Hf n).1) this,
+end
+
+lemma measurable_of_tendsto_metrizable_ae {μ : measure α} [μ.is_complete] {f : ℕ → α → β}
+  {g : α → β} (hf : ∀ n, measurable (f n))
+  (h_ae_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x))) :
+  measurable g :=
+ae_measurable_iff_measurable.mp
+  (ae_measurable_of_tendsto_metrizable_ae' (λ i, (hf i).ae_measurable) h_ae_tendsto)
+
+lemma measurable_limit_of_tendsto_metrizable_ae {ι} [countable ι] [nonempty ι] {μ : measure α}
+  {f : ι → α → β} {L : filter ι} [L.is_countably_generated] (hf : ∀ n, ae_measurable (f n) μ)
+  (h_ae_tendsto : ∀ᵐ x ∂μ, ∃ l : β, tendsto (λ n, f n x) L (𝓝 l)) :
+  ∃ (f_lim : α → β) (hf_lim_meas : measurable f_lim),
+    ∀ᵐ x ∂μ, tendsto (λ n, f n x) L (𝓝 (f_lim x)) :=
+begin
+  inhabit ι,
+  unfreezingI { rcases eq_or_ne L ⊥ with rfl | hL },
+  { exact ⟨(hf default).mk _, (hf default).measurable_mk,
+      eventually_of_forall $ λ x, tendsto_bot⟩ },
+  haveI : ne_bot L := ⟨hL⟩,
+  let p : α → (ι → β) → Prop := λ x f', ∃ l : β, tendsto (λ n, f' n) L (𝓝 l),
+  have hp_mem : ∀ x ∈ ae_seq_set hf p, p x (λ n, f n x),
+    from λ x hx, ae_seq.fun_prop_of_mem_ae_seq_set hf hx,
+  have h_ae_eq : ∀ᵐ x ∂μ, ∀ n, ae_seq hf p n x = f n x,
+    from ae_seq.ae_seq_eq_fun_ae hf h_ae_tendsto,
+  let f_lim : α → β := λ x, dite (x ∈ ae_seq_set hf p) (λ h, (hp_mem x h).some)
+    (λ h, (⟨f default x⟩ : nonempty β).some),
+  have hf_lim : ∀ x, tendsto (λ n, ae_seq hf p n x) L (𝓝 (f_lim x)),
+  { intros x,
+    simp only [f_lim, ae_seq],
+    split_ifs,
+    { refine (hp_mem x h).some_spec.congr (λ n, _),
+      exact (ae_seq.mk_eq_fun_of_mem_ae_seq_set hf h n).symm },
+    { exact tendsto_const_nhds, }, },
+  have h_ae_tendsto_f_lim : ∀ᵐ x ∂μ, tendsto (λ n, f n x) L (𝓝 (f_lim x)),
+    from h_ae_eq.mono (λ x hx, (hf_lim x).congr hx),
+  have h_f_lim_meas : measurable f_lim,
+    from measurable_of_tendsto_metrizable' L (ae_seq.measurable hf p)
+      (tendsto_pi_nhds.mpr (λ x, hf_lim x)),
+  exact ⟨f_lim, h_f_lim_meas, h_ae_tendsto_f_lim⟩,
+end
+
+end limits
diff --git a/src/measure_theory/constructions/pi.lean b/src/measure_theory/constructions/pi.lean
index cf65cef2c62d1..a616ee6c52a46 100644
--- a/src/measure_theory/constructions/pi.lean
+++ b/src/measure_theory/constructions/pi.lean
@@ -3,12 +3,16 @@ Copyright (c) 2020 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
-import measure_theory.constructions.prod
+import measure_theory.constructions.prod.basic
 import measure_theory.group.measure
+import topology.constructions
 
 /-!
 # Product measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define and prove properties about finite products of measures
 (and at some point, countable products of measures).
 
@@ -33,12 +37,12 @@ where `pi univ s` is the product of the sets `{s i | i : ι}`.
 We then show that this induces a product of measures, called `measure_theory.measure.pi`.
 For a collection of σ-finite measures `μ` and a collection of measurable sets `s` we show that
 `measure.pi μ (pi univ s) = ∏ i, m i (s i)`. To do this, we follow the following steps:
-* We know that there is some ordering on `ι`, given by an element of `[encodable ι]`.
+* We know that there is some ordering on `ι`, given by an element of `[countable ι]`.
 * Using this, we have an equivalence `measurable_equiv.pi_measurable_equiv_tprod` between
   `Π ι, α i` and an iterated product of `α i`, called `list.tprod α l` for some list `l`.
 * On this iterated product we can easily define a product measure `measure_theory.measure.tprod`
   by iterating `measure_theory.measure.prod`
-* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for encodable
+* Using the previous two steps we construct `measure_theory.measure.pi'` on `Π ι, α i` for countable
   `ι`.
 * We know that `measure_theory.measure.pi'` sends products of sets to products of measures, and
   since `measure_theory.measure.pi` is the maximal such measure (or at least, it comes from an outer
@@ -53,7 +57,7 @@ finitary product measure
 
 noncomputable theory
 open function set measure_theory.outer_measure filter measurable_space encodable
-open_locale classical big_operators topological_space ennreal
+open_locale classical big_operators topology ennreal
 
 universes u v
 
@@ -75,7 +79,8 @@ lemma is_pi_system_pi [Π i, measurable_space (α i)] :
   is_pi_system (pi univ '' pi univ (λ i, {s : set (α i) | measurable_set s})) :=
 is_pi_system.pi (λ i, is_pi_system_measurable_set)
 
-variables [fintype ι] [fintype ι']
+section finite
+variables [finite ι] [finite ι']
 
 /-- Boxes of countably spanning sets are countably spanning. -/
 lemma is_countably_spanning.pi {C : Π i, set (set (α i))}
@@ -83,7 +88,7 @@ lemma is_countably_spanning.pi {C : Π i, set (set (α i))}
   is_countably_spanning (pi univ '' pi univ C) :=
 begin
   choose s h1s h2s using hC,
-  haveI := fintype.to_encodable ι,
+  casesI nonempty_encodable (ι → ℕ),
   let e : ℕ → (ι → ℕ) := λ n, (decode (ι → ℕ) n).iget,
   refine ⟨λ n, pi univ (λ i, s i (e n i)), λ n, mem_image_of_mem _ (λ i _, h1s i _), _⟩,
   simp_rw [(surjective_decode_iget (ι → ℕ)).Union_comp (λ x, pi univ (λ i, s i (x i))),
@@ -96,7 +101,7 @@ lemma generate_from_pi_eq {C : Π i, set (set (α i))}
   (hC : ∀ i, is_countably_spanning (C i)) :
   @measurable_space.pi _ _ (λ i, generate_from (C i)) = generate_from (pi univ '' pi univ C) :=
 begin
-  haveI := fintype.to_encodable ι,
+  casesI nonempty_encodable ι,
   apply le_antisymm,
   { refine supr_le _, intro i, rw [comap_generate_from],
     apply generate_from_le, rintro _ ⟨s, hs, rfl⟩, dsimp,
@@ -132,9 +137,11 @@ lemma generate_from_pi [Π i, measurable_space (α i)] :
   measurable_space.pi :=
 generate_from_eq_pi (λ i, generate_from_measurable_set) (λ i, is_countably_spanning_measurable_set)
 
+end finite
+
 namespace measure_theory
 
-variables {m : Π i, outer_measure (α i)}
+variables [fintype ι] {m : Π i, outer_measure (α i)}
 
 /-- An upper bound for the measure in a finite product space.
   It is defined to by taking the image of the set under all projections, and taking the product
@@ -275,12 +282,12 @@ lemma pi_pi_aux [∀ i, sigma_finite (μ i)] (s : Π i, set (α i)) (hs : ∀ i,
   measure.pi μ (pi univ s) = ∏ i, μ i (s i) :=
 begin
   refine le_antisymm _ _,
-  { rw [measure.pi, to_measure_apply _ _ (measurable_set.pi_fintype (λ i _, hs i))],
+  { rw [measure.pi, to_measure_apply _ _ (measurable_set.pi countable_univ (λ i _, hs i))],
     apply outer_measure.pi_pi_le },
   { haveI : encodable ι := fintype.to_encodable ι,
     rw [← pi'_pi μ s],
-    simp_rw [← pi'_pi μ s, measure.pi,
-      to_measure_apply _ _ (measurable_set.pi_fintype (λ i _, hs i)), ← to_outer_measure_apply],
+    simp_rw [← pi'_pi μ s, measure.pi, to_measure_apply _ _ (measurable_set.pi countable_univ
+      (λ i _, hs i)), ← to_outer_measure_apply],
     suffices : (pi' μ).to_outer_measure ≤ outer_measure.pi (λ i, (μ i).to_outer_measure),
     { exact this _ },
     clear hs s,
@@ -321,7 +328,7 @@ end
 /-- A measure on a finite product space equals the product measure if they are equal on rectangles
   with as sides sets that generate the corresponding σ-algebras. -/
 lemma pi_eq_generate_from {C : Π i, set (set (α i))}
-  (hC : ∀ i, generate_from (C i) = _inst_3 i)
+  (hC : ∀ i, generate_from (C i) = by apply_assumption)
   (h2C : ∀ i, is_pi_system (C i))
   (h3C : ∀ i, (μ i).finite_spanning_sets_in (C i))
   {μν : measure (Π i, α i)}
@@ -428,7 +435,7 @@ lemma ae_le_pi {β : ι → Type*} [Π i, preorder (β i)] {f f' : Π i, α i 
 
 lemma ae_le_set_pi {I : set ι} {s t : Π i, set (α i)} (h : ∀ i ∈ I, s i ≤ᵐ[μ i] t i) :
   (set.pi I s) ≤ᵐ[measure.pi μ] (set.pi I t) :=
-((eventually_all_finite (finite.of_fintype I)).2
+((eventually_all_finite I.to_finite).2
   (λ i hi, tendsto_eval_ae_ae.eventually (h i hi))).mono $
     λ x hst hx i hi, hst i hi $ hx i hi
 
@@ -510,11 +517,19 @@ variable (μ)
 @[to_additive] instance pi.is_mul_left_invariant [∀ i, group (α i)] [∀ i, has_measurable_mul (α i)]
   [∀ i, is_mul_left_invariant (μ i)] : is_mul_left_invariant (measure.pi μ) :=
 begin
-  refine ⟨λ x, (measure.pi_eq (λ s hs, _)).symm⟩,
-  have h : has_mul.mul x ⁻¹' (pi univ s) = set.pi univ (λ i, (λ y, x i * y) ⁻¹' s i),
-  { ext, simp },
-  simp_rw [measure.map_apply (measurable_const_mul x) (measurable_set.univ_pi_fintype hs), h,
-    pi_pi, measure_preimage_mul]
+  refine ⟨λ v, (pi_eq $ λ s hs, _).symm⟩,
+  rw [map_apply (measurable_const_mul _) (measurable_set.univ_pi hs),
+    (show (*) v ⁻¹' univ.pi s = univ.pi (λ i, (*) (v i) ⁻¹' s i), by refl), pi_pi],
+  simp_rw measure_preimage_mul,
+end
+
+@[to_additive] instance pi.is_mul_right_invariant [Π i, group (α i)] [∀ i, has_measurable_mul (α i)]
+  [∀ i, is_mul_right_invariant (μ i)] : is_mul_right_invariant (measure.pi μ) :=
+begin
+  refine ⟨λ v, (pi_eq $ λ s hs, _).symm⟩,
+  rw [map_apply (measurable_mul_const _) (measurable_set.univ_pi hs),
+    (show (* v)  ⁻¹' univ.pi s = univ.pi (λ i, (* v i) ⁻¹' s i), by refl), pi_pi],
+  simp_rw measure_preimage_mul_right,
 end
 
 @[to_additive] instance pi.is_inv_invariant [∀ i, group (α i)] [∀ i, has_measurable_inv (α i)]
@@ -523,10 +538,41 @@ begin
   refine ⟨(measure.pi_eq (λ s hs, _)).symm⟩,
   have A : has_inv.inv ⁻¹' (pi univ s) = set.pi univ (λ i, has_inv.inv ⁻¹' s i),
   { ext, simp },
-  simp_rw [measure.inv, measure.map_apply measurable_inv (measurable_set.univ_pi_fintype hs), A,
+  simp_rw [measure.inv, measure.map_apply measurable_inv (measurable_set.univ_pi hs), A,
     pi_pi, measure_preimage_inv]
 end
 
+instance pi.is_open_pos_measure [Π i, topological_space (α i)] [Π i, is_open_pos_measure (μ i)] :
+  is_open_pos_measure (measure_theory.measure.pi μ) :=
+begin
+  constructor,
+  rintros U U_open ⟨a, ha⟩,
+  obtain ⟨s, ⟨hs, hsU⟩⟩ := is_open_pi_iff'.1 U_open a ha,
+  refine ne_of_gt (lt_of_lt_of_le _ (measure_mono hsU)),
+  simp only [pi_pi],
+  rw canonically_ordered_comm_semiring.prod_pos,
+  intros i _,
+  apply ((hs i).1.measure_pos (μ i) ⟨a i, (hs i).2⟩),
+end
+
+instance pi.is_finite_measure_on_compacts [Π i, topological_space (α i)]
+  [Π i, is_finite_measure_on_compacts (μ i)] :
+  is_finite_measure_on_compacts (measure_theory.measure.pi μ) :=
+begin
+  constructor,
+  intros K hK,
+  suffices : measure.pi μ (set.univ.pi ( λ j, (function.eval j) '' K)) < ⊤,
+  { exact lt_of_le_of_lt (measure_mono (univ.subset_pi_eval_image K)) this, },
+  rw measure.pi_pi,
+  refine with_top.prod_lt_top _,
+  exact λ i _, ne_of_lt (is_compact.measure_lt_top (is_compact.image hK (continuous_apply i))),
+end
+
+@[to_additive]
+instance pi.is_haar_measure [Π i, group (α i)] [Π i, topological_space (α i)]
+  [Π i, is_haar_measure (μ i)] [Π i, has_measurable_mul (α i)] :
+  is_haar_measure (measure.pi μ) := {}
+
 end measure
 instance measure_space.pi [Π i, measure_space (α i)] : measure_space (Π i, α i) :=
 ⟨measure.pi (λ i, volume)⟩
diff --git a/src/measure_theory/constructions/polish.lean b/src/measure_theory/constructions/polish.lean
index 4d548be5a4024..63cf523501aca 100644
--- a/src/measure_theory/constructions/polish.lean
+++ b/src/measure_theory/constructions/polish.lean
@@ -1,14 +1,18 @@
 /-
 Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
+Authors: Sébastien Gouëzel, Felix Weilacher
 -/
-import topology.metric_space.polish
-import measure_theory.constructions.borel_space
+import data.real.cardinality
+import topology.perfect
+import measure_theory.constructions.borel_space.basic
 
 /-!
 # The Borel sigma-algebra on Polish spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We discuss several results pertaining to the relationship between the topology and the Borel
 structure on Polish spaces.
 
@@ -29,7 +33,7 @@ Then, we show Lusin's theorem that two disjoint analytic sets can be separated b
 * `analytic_set.measurably_separable` shows that two disjoint analytic sets are separated by a
   Borel set.
 
-Finally, we prove the Lusin-Souslin theorem that a continuous injective image of a Borel subset of
+We then prove the Lusin-Souslin theorem that a continuous injective image of a Borel subset of
 a Polish space is Borel. The proof of this nontrivial result relies on the above results on
 analytic sets.
 
@@ -43,10 +47,17 @@ analytic sets.
   to a second-countable topological space is a measurable embedding.
 * `is_clopenable_iff_measurable_set`: in a Polish space, a set is clopenable (i.e., it can be made
   open and closed by using a finer Polish topology) if and only if it is Borel-measurable.
+
+We use this to prove several versions of the Borel isomorphism theorem.
+
+* `polish_space.measurable_equiv_of_not_countable` : Any two uncountable Polish spaces
+  are Borel isomorphic.
+* `polish_space.equiv.measurable_equiv` : Any two Polish spaces of the same cardinality
+  are Borel isomorphic.
 -/
 
 open set function polish_space pi_nat topological_space metric filter
-open_locale topological_space measure_theory
+open_locale topology measure_theory filter
 
 variables {α : Type*} [topological_space α] {ι : Type*}
 
@@ -136,7 +147,7 @@ lemma analytic_set.image_of_continuous {β : Type*} [topological_space β]
 hs.image_of_continuous_on hf.continuous_on
 
 /-- A countable intersection of analytic sets is analytic. -/
-theorem analytic_set.Inter [hι : nonempty ι] [encodable ι] [t2_space α]
+theorem analytic_set.Inter [hι : nonempty ι] [countable ι] [t2_space α]
   {s : ι → set α} (hs : ∀ n, analytic_set (s n)) :
   analytic_set (⋂ n, s n) :=
 begin
@@ -181,7 +192,7 @@ begin
 end
 
 /-- A countable union of analytic sets is analytic. -/
-theorem analytic_set.Union [encodable ι] {s : ι → set α} (hs : ∀ n, analytic_set (s n)) :
+theorem analytic_set.Union [countable ι] {s : ι → set α} (hs : ∀ n, analytic_set (s n)) :
   analytic_set (⋃ n, s n) :=
 begin
   /- For the proof, write each `s n` as the continuous image under a map `f n` of a
@@ -231,8 +242,8 @@ begin
   topology `t'`. It is analytic for this topology. As the identity from `t'` to `t` is continuous
   and the image of an analytic set is analytic, it follows that `s` is also analytic for `t`. -/
   obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
-    ∃ (t' : topological_space α), t' ≤ t ∧ @polish_space α t' ∧ @is_closed α t' s ∧
-      @is_open α t' s := hs.is_clopenable,
+    ∃ t' : topological_space α, t' ≤ t ∧ @polish_space α t' ∧ is_closed[t'] s ∧ is_open[t'] s :=
+    hs.is_clopenable,
   have A := @is_closed.analytic_set α t' t'_polish s s_closed,
   convert @analytic_set.image_of_continuous α t' α t s A id (continuous_id_of_le t't),
   simp only [id.def, image_id'],
@@ -242,24 +253,42 @@ end
 a finer Polish topology on the source space for which the function is continuous. -/
 lemma _root_.measurable.exists_continuous {α β : Type*}
   [t : topological_space α] [polish_space α] [measurable_space α] [borel_space α]
-  [tβ : topological_space β] [second_countable_topology β] [measurable_space β] [borel_space β]
-  {f : α → β} (hf : measurable f) :
+  [tβ : topological_space β] [measurable_space β] [opens_measurable_space β]
+  {f : α → β} [second_countable_topology (range f)] (hf : measurable f) :
   ∃ (t' : topological_space α), t' ≤ t ∧ @continuous α β t' tβ f ∧ @polish_space α t' :=
 begin
-  obtain ⟨b, b_count, -, hb⟩ : ∃b : set (set β), countable b ∧ ∅ ∉ b ∧ is_topological_basis b :=
-    exists_countable_basis β,
-  haveI : encodable b := b_count.to_encodable,
-  have : ∀ (s : b), is_clopenable (f ⁻¹' s),
+  obtain ⟨b, b_count, -, hb⟩ :
+    ∃ b : set (set (range f)), b.countable ∧ ∅ ∉ b ∧ is_topological_basis b :=
+    exists_countable_basis (range f),
+  haveI : countable b := b_count.to_subtype,
+  have : ∀ (s : b), is_clopenable (range_factorization f ⁻¹' s),
   { assume s,
     apply measurable_set.is_clopenable,
-    exact hf (hb.is_open s.2).measurable_set },
+    exact hf.subtype_mk (hb.is_open s.2).measurable_set },
   choose T Tt Tpolish Tclosed Topen using this,
   obtain ⟨t', t'T, t't, t'_polish⟩ :
     ∃ (t' : topological_space α), (∀ i, t' ≤ T i) ∧ (t' ≤ t) ∧ @polish_space α t' :=
       exists_polish_space_forall_le T Tt Tpolish,
+  letI := t', -- not needed in Lean 4
   refine ⟨t', t't, _, t'_polish⟩,
-  apply hb.continuous _ (λ s hs, _),
-  exact t'T ⟨s, hs⟩ _ (Topen ⟨s, hs⟩),
+  have : @continuous _ _ t' _ (range_factorization f) :=
+    hb.continuous _ (λ s hs, t'T ⟨s, hs⟩ _ (Topen ⟨s, hs⟩)),
+  exact continuous_subtype_coe.comp this
+end
+
+/-- The image of a measurable set in a Polish space under a measurable map is an analytic set. -/
+theorem _root_.measurable_set.analytic_set_image {X Y : Type*}
+  [topological_space X] [polish_space X] [measurable_space X] [borel_space X]
+  [topological_space Y] [measurable_space Y] [opens_measurable_space Y]
+  {f : X → Y} [second_countable_topology (range f)] {s : set X} (hs : measurable_set s)
+  (hf : measurable f) : analytic_set (f '' s) :=
+begin
+  borelize X,
+  rcases hf.exists_continuous with ⟨τ', hle, hfc, hτ'⟩,
+  letI m' : measurable_space X := @borel _ τ',
+  haveI b' : borel_space X := ⟨rfl⟩,
+  have hle := borel_anti hle,
+  exact (hle _ hs).analytic_set.image_of_continuous hfc
 end
 
 /-! ### Separating sets with measurable sets -/
@@ -270,7 +299,7 @@ This is mostly interesting for Borel-separable sets. -/
 def measurably_separable {α : Type*} [measurable_space α] (s t : set α) : Prop :=
 ∃ u, s ⊆ u ∧ disjoint t u ∧ measurable_set u
 
-lemma measurably_separable.Union [encodable ι]
+lemma measurably_separable.Union [countable ι]
   {α : Type*} [measurable_space α] {s t : ι → set α}
   (h : ∀ m n, measurably_separable (s m) (t n)) :
   measurably_separable (⋃ n, s n) (⋃ m, t m) :=
@@ -291,8 +320,9 @@ end
 contained in disjoint Borel sets (see the full statement in `analytic_set.measurably_separable`).
 Here, we prove this when our analytic sets are the ranges of functions from `ℕ → ℕ`.
 -/
-lemma measurably_separable_range_of_disjoint [t2_space α] [measurable_space α] [borel_space α]
-  {f g : (ℕ → ℕ) → α} (hf : continuous f) (hg : continuous g) (h : disjoint (range f) (range g)) :
+lemma measurably_separable_range_of_disjoint [t2_space α] [measurable_space α]
+  [opens_measurable_space α] {f g : (ℕ → ℕ) → α} (hf : continuous f) (hg : continuous g)
+  (h : disjoint (range f) (range g)) :
   measurably_separable (range f) (range g) :=
 begin
   /- We follow [Kechris, *Classical Descriptive Set Theory* (Theorem 14.7)][kechris1995].
@@ -372,7 +402,7 @@ begin
       exact (Iy i n hi).symm } },
   -- consider two open sets separating `f x` and `g y`.
   obtain ⟨u, v, u_open, v_open, xu, yv, huv⟩ :
-    ∃ u v : set α, is_open u ∧ is_open v ∧ f x ∈ u ∧ g y ∈ v ∧ u ∩ v = ∅,
+    ∃ u v : set α, is_open u ∧ is_open v ∧ f x ∈ u ∧ g y ∈ v ∧ disjoint u v,
   { apply t2_separation,
     exact disjoint_iff_forall_ne.1 h _ (mem_range_self _) _ (mem_range_self _) },
   letI : metric_space (ℕ → ℕ) := metric_space_nat_nat,
@@ -392,8 +422,7 @@ begin
       assume z hz,
       rw mem_cylinder_iff_dist_le at hz,
       exact hz.trans_lt (hn.trans_le (min_le_left _ _)) },
-    { have D : disjoint v u, by rwa [disjoint_iff_inter_eq_empty, inter_comm],
-      apply disjoint.mono_left _ D,
+    { refine disjoint.mono_left _ huv.symm,
       change g '' cylinder y n ⊆ v,
       rw image_subset_iff,
       apply subset.trans _ hεy,
@@ -406,8 +435,9 @@ end
 
 /-- The Lusin separation theorem: if two analytic sets are disjoint, then they are contained in
 disjoint Borel sets. -/
-theorem analytic_set.measurably_separable [t2_space α] [measurable_space α] [borel_space α]
-  {s t : set α} (hs : analytic_set s) (ht : analytic_set t) (h : disjoint s t) :
+theorem analytic_set.measurably_separable [t2_space α] [measurable_space α]
+  [opens_measurable_space α] {s t : set α} (hs : analytic_set s) (ht : analytic_set t)
+  (h : disjoint s t) :
   measurably_separable s t :=
 begin
   rw analytic_set at hs ht,
@@ -418,6 +448,135 @@ begin
   exact measurably_separable_range_of_disjoint f_cont g_cont h,
 end
 
+/-- **Suslin's Theorem**: in a Hausdorff topological space, an analytic set with an analytic
+complement is measurable. -/
+theorem analytic_set.measurable_set_of_compl [t2_space α] [measurable_space α]
+  [opens_measurable_space α] {s : set α} (hs : analytic_set s) (hsc : analytic_set (sᶜ)) :
+  measurable_set s :=
+begin
+  rcases hs.measurably_separable hsc disjoint_compl_right with ⟨u, hsu, hdu, hmu⟩,
+  obtain rfl : s = u := hsu.antisymm (disjoint_compl_left_iff_subset.1 hdu),
+  exact hmu
+end
+
+end measure_theory
+
+/-!
+### Measurability of preimages under measurable maps
+-/
+
+namespace measurable
+
+variables {X Y β : Type*}
+  [topological_space X] [polish_space X] [measurable_space X] [borel_space X]
+  [topological_space Y] [t2_space Y] [measurable_space Y] [opens_measurable_space Y]
+  [measurable_space β]
+
+/-- If `f : X → Y` is a surjective Borel measurable map from a Polish space to a topological space
+with second countable topology, then the preimage of a set `s` is measurable if and only if the set
+is measurable.
+One implication is the definition of measurability, the other one heavily relies on `X` being a
+Polish space. -/
+theorem measurable_set_preimage_iff_of_surjective [second_countable_topology Y] {f : X → Y}
+  (hf : measurable f) (hsurj : surjective f) {s : set Y} :
+  measurable_set (f ⁻¹' s) ↔ measurable_set s :=
+begin
+  refine ⟨λ h, _, λ h, hf h⟩,
+  apply measure_theory.analytic_set.measurable_set_of_compl,
+  { rw [← image_preimage_eq s hsurj],
+    exact h.analytic_set_image hf },
+  { rw [← image_preimage_eq (sᶜ) hsurj],
+    exact h.compl.analytic_set_image hf }
+end
+
+theorem map_measurable_space_eq [second_countable_topology Y] {f : X → Y} (hf : measurable f)
+  (hsurj : surjective f) : measurable_space.map f ‹measurable_space X› = ‹measurable_space Y› :=
+measurable_space.ext $ λ _, hf.measurable_set_preimage_iff_of_surjective hsurj
+
+theorem map_measurable_space_eq_borel [second_countable_topology Y] {f : X → Y} (hf : measurable f)
+  (hsurj : surjective f) : measurable_space.map f ‹measurable_space X› = borel Y :=
+begin
+  have := hf.mono le_rfl opens_measurable_space.borel_le, 
+  letI := borel Y, haveI : borel_space Y := ⟨rfl⟩,
+  exact this.map_measurable_space_eq hsurj
+end
+
+theorem borel_space_codomain [second_countable_topology Y] {f : X → Y} (hf : measurable f)
+  (hsurj : surjective f) : borel_space Y :=
+⟨(hf.map_measurable_space_eq hsurj).symm.trans $ hf.map_measurable_space_eq_borel hsurj⟩
+
+/-- If `f : X → Y` is a Borel measurable map from a Polish space to a topological space with second
+countable topology, then the preimage of a set `s` is measurable if and only if the set is
+measurable in `set.range f`. -/
+theorem measurable_set_preimage_iff_preimage_coe {f : X → Y} [second_countable_topology (range f)]
+  (hf : measurable f) {s : set Y} :
+  measurable_set (f ⁻¹' s) ↔ measurable_set (coe ⁻¹' s : set (range f)) :=
+have hf' : measurable (range_factorization f) := hf.subtype_mk,
+by rw [← hf'.measurable_set_preimage_iff_of_surjective surjective_onto_range]; refl
+
+/-- If `f : X → Y` is a Borel measurable map from a Polish space to a topological space with second
+countable topology and the range of `f` is measurable, then the preimage of a set `s` is measurable
+if and only if the intesection with `set.range f` is measurable. -/
+theorem measurable_set_preimage_iff_inter_range {f : X → Y} [second_countable_topology (range f)]
+  (hf : measurable f) (hr : measurable_set (range f)) {s : set Y} :
+  measurable_set (f ⁻¹' s) ↔ measurable_set (s ∩ range f) :=
+begin
+  rw [hf.measurable_set_preimage_iff_preimage_coe,
+    ← (measurable_embedding.subtype_coe hr).measurable_set_image, subtype.image_preimage_coe]
+end
+
+/-- If `f : X → Y` is a Borel measurable map from a Polish space to a topological space with second
+countable topology, then for any measurable space `β` and `g : Y → β`, the composition `g ∘ f` is
+measurable if and only if the restriction of `g` to the range of `f` is measurable. -/
+theorem measurable_comp_iff_restrict {f : X → Y} [second_countable_topology (range f)]
+  (hf : measurable f) {g : Y → β} :
+  measurable (g ∘ f) ↔ measurable (restrict (range f) g) :=
+forall₂_congr $ λ s _,
+  @measurable.measurable_set_preimage_iff_preimage_coe _ _ _ _ _ _ _ _ _ _ _ _ hf (g ⁻¹' s)
+
+/-- If `f : X → Y` is a surjective Borel measurable map from a Polish space to a topological space
+with second countable topology, then for any measurable space `α` and `g : Y → α`, the composition
+`g ∘ f` is measurable if and only if `g` is measurable. -/
+theorem measurable_comp_iff_of_surjective [second_countable_topology Y] {f : X → Y}
+  (hf : measurable f) (hsurj : surjective f) {g : Y → β} :
+  measurable (g ∘ f) ↔ measurable g :=
+forall₂_congr $ λ s _,
+  @measurable.measurable_set_preimage_iff_of_surjective _ _ _ _ _ _ _ _ _ _ _ _ hf hsurj (g ⁻¹' s)
+
+end measurable
+
+theorem continuous.map_eq_borel {X Y : Type*}
+  [topological_space X] [polish_space X] [measurable_space X] [borel_space X]
+  [topological_space Y] [t2_space Y] [second_countable_topology Y]
+  {f : X → Y} (hf : continuous f) (hsurj : surjective f) :
+  measurable_space.map f ‹measurable_space X› = borel Y :=
+begin
+  borelize Y,
+  exact hf.measurable.map_measurable_space_eq hsurj
+end
+
+theorem continuous.map_borel_eq {X Y : Type*} [topological_space X] [polish_space X]
+  [topological_space Y] [t2_space Y] [second_countable_topology Y]
+  {f : X → Y} (hf : continuous f) (hsurj : surjective f) :
+  measurable_space.map f (borel X) = borel Y :=
+begin
+  borelize X,
+  exact hf.map_eq_borel hsurj
+end
+
+instance quotient.borel_space {X : Type*} [topological_space X] [polish_space X]
+  [measurable_space X] [borel_space X] {s : setoid X} [t2_space (quotient s)]
+  [second_countable_topology (quotient s)] : borel_space (quotient s) :=
+⟨continuous_quotient_mk.map_eq_borel (surjective_quotient_mk _)⟩
+
+@[to_additive]
+instance quotient_group.borel_space {G : Type*} [topological_space G] [polish_space G]
+  [group G] [topological_group G] [measurable_space G] [borel_space G]
+  {N : subgroup G} [N.normal] [is_closed (N : set G)] : borel_space (G ⧸ N) :=
+by haveI := polish_space.second_countable G; exact quotient.borel_space
+
+namespace measure_theory
+
 /-! ### Injective images of Borel sets -/
 
 variables {γ : Type*} [tγ : topological_space γ] [polish_space γ]
@@ -451,7 +610,7 @@ begin
   contradiction since `x` belongs both to this closure and to `w`. -/
   letI := upgrade_polish_space γ,
   obtain ⟨b, b_count, b_nonempty, hb⟩ :
-    ∃ b : set (set γ), countable b ∧ ∅ ∉ b ∧ is_topological_basis b := exists_countable_basis γ,
+    ∃ b : set (set γ), b.countable ∧ ∅ ∉ b ∧ is_topological_basis b := exists_countable_basis γ,
   haveI : encodable b := b_count.to_encodable,
   let A := {p : b × b // disjoint (p.1 : set γ) p.2},
   -- for each pair of disjoint sets in the topological basis `b`, consider Borel sets separating
@@ -476,11 +635,11 @@ begin
     { assume b,
       refine is_closed_closure.measurable_set.inter _,
       refine measurable_set.Inter (λ s, _),
-      exact measurable_set.Inter_Prop (λ hs, (q_meas _).diff (q_meas _)) },
+      exact measurable_set.Inter (λ hs, (q_meas _).diff (q_meas _)) },
     have F_meas : ∀ n, measurable_set (F n),
     { assume n,
       refine measurable_set.Union (λ s, _),
-      exact measurable_set.Union_Prop (λ hs, E_meas _) },
+      exact measurable_set.Union (λ hs, E_meas _) },
     rw this,
     exact measurable_set.Inter (λ n, F_meas n) },
   -- we check both inclusions.
@@ -511,7 +670,7 @@ begin
     choose s hs hxs using C1,
     have C2 : ∀ n, (s n).1.nonempty,
     { assume n,
-      rw ← ne_empty_iff_nonempty,
+      rw nonempty_iff_ne_empty,
       assume hn,
       have := (s n).2,
       rw hn at this,
@@ -545,9 +704,7 @@ begin
     -- assume for a contradiction that `f z ≠ x`.
     by_contra' hne,
     -- introduce disjoint open sets `v` and `w` separating `f z` from `x`.
-    obtain ⟨v, w, v_open, w_open, fzv, xw, hvw⟩ :
-      ∃ v w : set β, is_open v ∧ is_open w ∧ f z ∈ v ∧ x ∈ w ∧ v ∩ w = ∅ :=
-        t2_separation hne,
+    obtain ⟨v, w, v_open, w_open, fzv, xw, hvw⟩ := t2_separation hne,
     obtain ⟨δ, δpos, hδ⟩ : ∃ δ > (0 : ℝ), ball z δ ⊆ f ⁻¹' v,
     { apply metric.mem_nhds_iff.1,
       exact f_cont.continuous_at.preimage_mem_nhds (v_open.mem_nhds fzv) },
@@ -568,7 +725,7 @@ begin
     have : x ∈ closure v := closure_mono fsnv (hxs n).1,
     -- this is a contradiction, as `x` is supposed to belong to `w`, which is disjoint from
     -- the closure of `v`.
-    exact disjoint_left.1 ((disjoint_iff_inter_eq_empty.2 hvw).closure_left w_open) this xw }
+    exact disjoint_left.1 (hvw.closure_left w_open) this xw }
 end
 
 theorem _root_.is_closed.measurable_set_image_of_continuous_on_inj_on
@@ -583,10 +740,11 @@ begin
   { rwa inj_on_iff_injective at f_inj }
 end
 
-variables [measurable_space γ] [borel_space γ]
+
+variables [measurable_space γ] [hγb : borel_space γ]
 {β : Type*} [tβ : topological_space β] [t2_space β] [measurable_space β] [borel_space β]
 {s : set γ} {f : γ → β}
-include tβ
+include tβ hγb
 
 /-- The Lusin-Souslin theorem: if `s` is Borel-measurable in a Polish space, then its image under
 a continuous injective map is also Borel-measurable. -/
@@ -595,8 +753,8 @@ theorem _root_.measurable_set.image_of_continuous_on_inj_on
   measurable_set (f '' s) :=
 begin
   obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
-    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @polish_space γ t' ∧ @is_closed γ t' s ∧
-      @is_open γ t' s := hs.is_clopenable,
+    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @polish_space γ t' ∧ is_closed[t'] s ∧
+      is_open[t'] s := hs.is_clopenable,
   exact @is_closed.measurable_set_image_of_continuous_on_inj_on γ t' t'_polish β _ _ _ _ s
     s_closed f (f_cont.mono_dom t't) f_inj,
 end
@@ -667,8 +825,8 @@ begin
   refine ⟨λ hs, _, λ hs, hs.is_clopenable⟩,
   -- consider a finer topology `t'` in which `s` is open and closed.
   obtain ⟨t', t't, t'_polish, s_closed, s_open⟩ :
-    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @polish_space γ t' ∧ @is_closed γ t' s ∧
-      @is_open γ t' s := hs,
+    ∃ (t' : topological_space γ), t' ≤ tγ ∧ @polish_space γ t' ∧ is_closed[t'] s ∧
+      is_open[t'] s := hs,
   -- the identity is continuous from `t'` to `tγ`.
   have C : @continuous γ γ t' tγ id := continuous_id_of_le t't,
   -- therefore, it is also a measurable embedding, by the Lusin-Souslin theorem
@@ -683,4 +841,159 @@ begin
   simp only [id.def, image_id'],
 end
 
+omit hγb
+
+/-- The set of points for which a measurable sequence of functions converges is measurable. -/
+@[measurability] lemma measurable_set_exists_tendsto
+  [hγ : opens_measurable_space γ] [countable ι] {l : filter ι}
+  [l.is_countably_generated] {f : ι → β → γ} (hf : ∀ i, measurable (f i)) :
+  measurable_set {x | ∃ c, tendsto (λ n, f n x) l (𝓝 c)} :=
+begin
+  by_cases hl : l.ne_bot,
+  swap, { rw not_ne_bot at hl, simp [hl] },
+  letI := upgrade_polish_space γ,
+  rcases l.exists_antitone_basis with ⟨u, hu⟩,
+  simp_rw ← cauchy_map_iff_exists_tendsto,
+  change measurable_set {x | _ ∧ _},
+  have : ∀ x, ((map (λ i, f i x) l) ×ᶠ (map (λ i, f i x) l)).has_antitone_basis
+    (λ n, ((λ i, f i x) '' u n) ×ˢ ((λ i, f i x) '' u n)) := λ x, hu.map.prod hu.map,
+  simp_rw [and_iff_right (hl.map _), filter.has_basis.le_basis_iff (this _).to_has_basis
+    metric.uniformity_basis_dist_inv_nat_succ, set.set_of_forall],
+  refine measurable_set.bInter set.countable_univ (λ K _, _),
+  simp_rw set.set_of_exists,
+  refine measurable_set.bUnion set.countable_univ (λ N hN, _),
+  simp_rw [prod_image_image_eq, image_subset_iff, prod_subset_iff, set.set_of_forall],
+  exact measurable_set.bInter (to_countable (u N)) (λ i _,
+    measurable_set.bInter (to_countable (u N)) (λ j _,
+    measurable_set_lt (measurable.dist (hf i) (hf j)) measurable_const)),
+end
+
+end measure_theory
+
+/-! ### The Borel Isomorphism Theorem -/
+
+/-Note: Move to topology/metric_space/polish when porting. -/
+@[priority 50]
+instance polish_of_countable [h : countable α] [discrete_topology α] : polish_space α :=
+begin
+  obtain ⟨f, hf⟩ := h.exists_injective_nat,
+  have : closed_embedding f,
+  { apply closed_embedding_of_continuous_injective_closed continuous_of_discrete_topology hf,
+    exact λ t _, is_closed_discrete _, },
+  exact this.polish_space,
+end
+
+namespace polish_space
+
+/-Note: This is to avoid a loop in TC inference. When ported to Lean 4, this will not
+be necessary, and `second_countable_of_polish` should probably
+just be added as an instance soon after the definition of `polish_space`.-/
+private lemma second_countable_of_polish [h : polish_space α] : second_countable_topology α :=
+h.second_countable
+
+local attribute [-instance] polish_space_of_complete_second_countable
+local attribute [instance] second_countable_of_polish
+
+variables {β : Type*} [topological_space β] [polish_space α] [polish_space β]
+variables [measurable_space α] [measurable_space β] [borel_space α] [borel_space β]
+
+/-- If two Polish spaces admit Borel measurable injections to one another,
+then they are Borel isomorphic.-/
+noncomputable
+def borel_schroeder_bernstein
+  {f : α → β} {g : β → α}
+  (fmeas : measurable f) (finj : function.injective f)
+  (gmeas : measurable g) (ginj : function.injective g) :
+  α ≃ᵐ β :=
+(fmeas.measurable_embedding finj).schroeder_bernstein (gmeas.measurable_embedding ginj)
+
+/-- Any uncountable Polish space is Borel isomorphic to the Cantor space `ℕ → bool`.-/
+noncomputable
+def measurable_equiv_nat_bool_of_not_countable (h : ¬ countable α) : α ≃ᵐ (ℕ → bool) :=
+begin
+  apply nonempty.some,
+  obtain ⟨f, -, fcts, finj⟩ := is_closed_univ.exists_nat_bool_injection_of_not_countable
+    (by rwa [← countable_coe_iff, (equiv.set.univ _).countable_iff]),
+  obtain ⟨g, gmeas, ginj⟩ :=
+    measurable_space.measurable_injection_nat_bool_of_countably_generated α,
+  exact ⟨borel_schroeder_bernstein gmeas ginj fcts.measurable finj⟩,
+end
+
+/-- The **Borel Isomorphism Theorem**: Any two uncountable Polish spaces are Borel isomorphic.-/
+noncomputable
+def measurable_equiv_of_not_countable (hα : ¬ countable α) (hβ : ¬ countable β ) : α ≃ᵐ β :=
+(measurable_equiv_nat_bool_of_not_countable hα).trans
+  (measurable_equiv_nat_bool_of_not_countable hβ).symm
+
+/-- The **Borel Isomorphism Theorem**: If two Polish spaces have the same cardinality,
+they are Borel isomorphic.-/
+noncomputable
+def equiv.measurable_equiv (e : α ≃ β) : α ≃ᵐ β :=
+begin
+  by_cases h : countable α,
+  { letI := h,
+    letI := countable.of_equiv α e,
+    use e; apply measurable_of_countable, },
+  refine measurable_equiv_of_not_countable h _,
+  rwa e.countable_iff at h,
+end
+
+end polish_space
+
+
+namespace measure_theory
+
+-- todo after the port: move to topology/metric_space/polish
+instance [polish_space α] : polish_space (univ : set α) := is_closed_univ.polish_space
+
+variables (α) [measurable_space α] [polish_space α] [borel_space α]
+
+lemma exists_nat_measurable_equiv_range_coe_fin_of_finite [finite α] :
+  ∃ n : ℕ, nonempty (α ≃ᵐ range (coe : fin n → ℝ)) :=
+begin
+  obtain ⟨n, ⟨n_equiv⟩⟩ := finite.exists_equiv_fin α,
+  refine ⟨n, ⟨polish_space.equiv.measurable_equiv (n_equiv.trans _)⟩⟩,
+  exact equiv.of_injective _ (nat.cast_injective.comp fin.val_injective),
+end
+
+lemma measurable_equiv_range_coe_nat_of_infinite_of_countable [infinite α] [countable α] :
+  nonempty (α ≃ᵐ range (coe : ℕ → ℝ)) :=
+begin
+  haveI : polish_space (range (coe : ℕ → ℝ)),
+  { exact nat.closed_embedding_coe_real.is_closed_map.closed_range.polish_space, },
+  refine ⟨polish_space.equiv.measurable_equiv _⟩,
+  refine (nonempty_equiv_of_countable.some : α ≃ ℕ).trans _,
+  exact equiv.of_injective coe nat.cast_injective,
+end
+
+/-- Any Polish Borel space is measurably equivalent to a subset of the reals. -/
+theorem exists_subset_real_measurable_equiv : ∃ s : set ℝ, measurable_set s ∧ nonempty (α ≃ᵐ s) :=
+begin
+  by_cases hα : countable α,
+  { casesI finite_or_infinite α,
+    { obtain ⟨n, h_nonempty_equiv⟩ := exists_nat_measurable_equiv_range_coe_fin_of_finite α,
+      refine ⟨_, _, h_nonempty_equiv⟩,
+      letI : measurable_space (fin n) := borel (fin n),
+      haveI : borel_space (fin n) := ⟨rfl⟩,
+      refine measurable_embedding.measurable_set_range _,
+      { apply_instance, },
+      { exact continuous_of_discrete_topology.measurable_embedding
+          (nat.cast_injective.comp fin.val_injective), }, },
+    { refine ⟨_, _, measurable_equiv_range_coe_nat_of_infinite_of_countable α⟩,
+      refine measurable_embedding.measurable_set_range _,
+      { apply_instance, },
+      { exact continuous_of_discrete_topology.measurable_embedding nat.cast_injective, }, }, },
+  { refine ⟨univ, measurable_set.univ,
+      ⟨(polish_space.measurable_equiv_of_not_countable hα _ : α ≃ᵐ (univ : set ℝ))⟩⟩,
+    rw countable_coe_iff,
+    exact cardinal.not_countable_real, }
+end
+
+/-- Any Polish Borel space embeds measurably into the reals. -/
+theorem exists_measurable_embedding_real : ∃ (f : α → ℝ), measurable_embedding f :=
+begin
+  obtain ⟨s, hs, ⟨e⟩⟩ := exists_subset_real_measurable_equiv α,
+  exact ⟨coe ∘ e, (measurable_embedding.subtype_coe hs).comp e.measurable_embedding⟩,
+end
+
 end measure_theory
diff --git a/src/measure_theory/constructions/prod.lean b/src/measure_theory/constructions/prod.lean
deleted file mode 100644
index b9092bd1daf90..0000000000000
--- a/src/measure_theory/constructions/prod.lean
+++ /dev/null
@@ -1,1019 +0,0 @@
-/-
-Copyright (c) 2020 Floris van Doorn. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Floris van Doorn
--/
-import measure_theory.measure.giry_monad
-import dynamics.ergodic.measure_preserving
-import measure_theory.integral.set_integral
-
-/-!
-# The product measure
-
-In this file we define and prove properties about the binary product measure. If `α` and `β` have
-σ-finite measures `μ` resp. `ν` then `α × β` can be equipped with a σ-finite measure `μ.prod ν` that
-satisfies `(μ.prod ν) s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`.
-We also have `(μ.prod ν) (s ×ˢ t) = μ s * ν t`, i.e. the measure of a rectangle is the product of
-the measures of the sides.
-
-We also prove Tonelli's theorem and Fubini's theorem.
-
-## Main definition
-
-* `measure_theory.measure.prod`: The product of two measures.
-
-## Main results
-
-* `measure_theory.measure.prod_apply` states `μ.prod ν s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`
-  for measurable `s`. `measure_theory.measure.prod_apply_symm` is the reversed version.
-* `measure_theory.measure.prod_prod` states `μ.prod ν (s ×ˢ t) = μ s * ν t` for measurable sets
-  `s` and `t`.
-* `measure_theory.lintegral_prod`: Tonelli's theorem. It states that for a measurable function
-  `α × β → ℝ≥0∞` we have `∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ`. The version
-  for functions `α → β → ℝ≥0∞` is reversed, and called `lintegral_lintegral`. Both versions have
-  a variant with `_symm` appended, where the order of integration is reversed.
-  The lemma `measurable.lintegral_prod_right'` states that the inner integral of the right-hand side
-  is measurable.
-* `measure_theory.integrable_prod_iff` states that a binary function is integrable iff both
-  * `y ↦ f (x, y)` is integrable for almost every `x`, and
-  * the function `x ↦ ∫ ∥f (x, y)∥ dy` is integrable.
-* `measure_theory.integral_prod`: Fubini's theorem. It states that for a integrable function
-  `α × β → E` (where `E` is a second countable Banach space) we have
-  `∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ`. This theorem has the same variants as
-  Tonelli's theorem. The lemma `measure_theory.integrable.integral_prod_right` states that the
-  inner integral of the right-hand side is integrable.
-
-## Implementation Notes
-
-Many results are proven twice, once for functions in curried form (`α → β → γ`) and one for
-functions in uncurried form (`α × β → γ`). The former often has an assumption
-`measurable (uncurry f)`, which could be inconvenient to discharge, but for the latter it is more
-common that the function has to be given explicitly, since Lean cannot synthesize the function by
-itself. We name the lemmas about the uncurried form with a prime.
-Tonelli's theorem and Fubini's theorem have a different naming scheme, since the version for the
-uncurried version is reversed.
-
-## Tags
-
-product measure, Fubini's theorem, Tonelli's theorem, Fubini-Tonelli theorem
--/
-
-noncomputable theory
-open_locale classical topological_space ennreal measure_theory
-open set function real ennreal
-open measure_theory measurable_space measure_theory.measure
-open topological_space (hiding generate_from)
-open filter (hiding prod_eq map)
-
-variables {α α' β β' γ E : Type*}
-
-/-- Rectangles formed by π-systems form a π-system. -/
-lemma is_pi_system.prod {C : set (set α)} {D : set (set β)} (hC : is_pi_system C)
-  (hD : is_pi_system D) : is_pi_system (image2 (×ˢ) C D) :=
-begin
-  rintro _ ⟨s₁, t₁, hs₁, ht₁, rfl⟩ _ ⟨s₂, t₂, hs₂, ht₂, rfl⟩ hst,
-  rw [prod_inter_prod] at hst ⊢, rw [prod_nonempty_iff] at hst,
-  exact mem_image2_of_mem (hC _ hs₁ _ hs₂ hst.1) (hD _ ht₁ _ ht₂ hst.2)
-end
-
-/-- Rectangles of countably spanning sets are countably spanning. -/
-lemma is_countably_spanning.prod {C : set (set α)} {D : set (set β)}
-  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
-  is_countably_spanning (image2 (×ˢ) C D) :=
-begin
-  rcases ⟨hC, hD⟩ with ⟨⟨s, h1s, h2s⟩, t, h1t, h2t⟩,
-  refine ⟨λ n, (s n.unpair.1) ×ˢ (t n.unpair.2), λ n, mem_image2_of_mem (h1s _) (h1t _), _⟩,
-  rw [Union_unpair_prod, h2s, h2t, univ_prod_univ]
-end
-
-variables [measurable_space α] [measurable_space α'] [measurable_space β] [measurable_space β']
-variables [measurable_space γ]
-variables {μ : measure α} {ν : measure β} {τ : measure γ}
-variables [normed_group E]
-
-/-! ### Measurability
-
-Before we define the product measure, we can talk about the measurability of operations on binary
-functions. We show that if `f` is a binary measurable function, then the function that integrates
-along one of the variables (using either the Lebesgue or Bochner integral) is measurable.
--/
-
-/-- The product of generated σ-algebras is the one generated by rectangles, if both generating sets
-  are countably spanning. -/
-lemma generate_from_prod_eq {α β} {C : set (set α)} {D : set (set β)}
-  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
-  @prod.measurable_space _ _ (generate_from C) (generate_from D) =
-    generate_from (image2 (×ˢ) C D) :=
-begin
-  apply le_antisymm,
-  { refine sup_le _ _; rw [comap_generate_from];
-      apply generate_from_le; rintro _ ⟨s, hs, rfl⟩,
-    { rcases hD with ⟨t, h1t, h2t⟩,
-      rw [← prod_univ, ← h2t, prod_Union],
-      apply measurable_set.Union,
-      intro n, apply measurable_set_generate_from,
-      exact ⟨s, t n, hs, h1t n, rfl⟩ },
-    { rcases hC with ⟨t, h1t, h2t⟩,
-      rw [← univ_prod, ← h2t, Union_prod_const],
-      apply measurable_set.Union,
-      rintro n, apply measurable_set_generate_from,
-      exact mem_image2_of_mem (h1t n) hs } },
-  { apply generate_from_le, rintro _ ⟨s, t, hs, ht, rfl⟩, rw [prod_eq],
-    apply (measurable_fst _).inter (measurable_snd _),
-    { exact measurable_set_generate_from hs },
-    { exact measurable_set_generate_from ht } }
-end
-
-/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
-  generate the σ-algebra on `α × β`. -/
-lemma generate_from_eq_prod {C : set (set α)} {D : set (set β)} (hC : generate_from C = ‹_›)
-  (hD : generate_from D = ‹_›) (h2C : is_countably_spanning C) (h2D : is_countably_spanning D) :
-    generate_from (image2 (×ˢ) C D) = prod.measurable_space :=
-by rw [← hC, ← hD, generate_from_prod_eq h2C h2D]
-
-/-- The product σ-algebra is generated from boxes, i.e. `s ×ˢ t` for sets `s : set α` and
-  `t : set β`. -/
-lemma generate_from_prod :
-  generate_from (image2 (×ˢ) {s : set α | measurable_set s} {t : set β | measurable_set t}) =
-  prod.measurable_space :=
-generate_from_eq_prod generate_from_measurable_set generate_from_measurable_set
-  is_countably_spanning_measurable_set is_countably_spanning_measurable_set
-
-/-- Rectangles form a π-system. -/
-lemma is_pi_system_prod :
-  is_pi_system (image2 (×ˢ) {s : set α | measurable_set s} {t : set β | measurable_set t}) :=
-is_pi_system_measurable_set.prod is_pi_system_measurable_set
-
-/-- If `ν` is a finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
-  a measurable function. `measurable_measure_prod_mk_left` is strictly more general. -/
-lemma measurable_measure_prod_mk_left_finite [is_finite_measure ν] {s : set (α × β)}
-  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
-begin
-  refine induction_on_inter generate_from_prod.symm is_pi_system_prod _ _ _ _ hs,
-  { simp [measurable_zero, const_def] },
-  { rintro _ ⟨s, t, hs, ht, rfl⟩, simp only [mk_preimage_prod_right_eq_if, measure_if],
-    exact measurable_const.indicator hs },
-  { intros t ht h2t,
-    simp_rw [preimage_compl, measure_compl (measurable_prod_mk_left ht) (measure_ne_top ν _)],
-    exact h2t.const_sub _ },
-  { intros f h1f h2f h3f, simp_rw [preimage_Union],
-    have : ∀ b, ν (⋃ i, prod.mk b ⁻¹' f i) = ∑' i, ν (prod.mk b ⁻¹' f i) :=
-      λ b, measure_Union (λ i j hij, disjoint.preimage _ (h1f i j hij))
-        (λ i, measurable_prod_mk_left (h2f i)),
-    simp_rw [this], apply measurable.ennreal_tsum h3f },
-end
-
-/-- If `ν` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
-  a measurable function. -/
-lemma measurable_measure_prod_mk_left [sigma_finite ν] {s : set (α × β)}
-  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
-begin
-  have : ∀ x, measurable_set (prod.mk x ⁻¹' s) := λ x, measurable_prod_mk_left hs,
-  simp only [← @supr_restrict_spanning_sets _ _ ν, this],
-  apply measurable_supr, intro i,
-  haveI := fact.mk (measure_spanning_sets_lt_top ν i),
-  exact measurable_measure_prod_mk_left_finite hs
-end
-
-/-- If `μ` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `y ↦ μ { x | (x, y) ∈ s }` is
-  a measurable function. -/
-lemma measurable_measure_prod_mk_right {μ : measure α} [sigma_finite μ] {s : set (α × β)}
-  (hs : measurable_set s) : measurable (λ y, μ ((λ x, (x, y)) ⁻¹' s)) :=
-measurable_measure_prod_mk_left (measurable_set_swap_iff.mpr hs)
-
-lemma measurable.map_prod_mk_left [sigma_finite ν] : measurable (λ x : α, map (prod.mk x) ν) :=
-begin
-  apply measurable_of_measurable_coe, intros s hs,
-  simp_rw [map_apply measurable_prod_mk_left hs],
-  exact measurable_measure_prod_mk_left hs
-end
-
-lemma measurable.map_prod_mk_right {μ : measure α} [sigma_finite μ] :
-  measurable (λ y : β, map (λ x : α, (x, y)) μ) :=
-begin
-  apply measurable_of_measurable_coe, intros s hs,
-  simp_rw [map_apply measurable_prod_mk_right hs],
-  exact measurable_measure_prod_mk_right hs
-end
-
-/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
-  Tonelli's theorem is measurable. -/
-lemma measurable.lintegral_prod_right' [sigma_finite ν] :
-  ∀ {f : α × β → ℝ≥0∞} (hf : measurable f), measurable (λ x, ∫⁻ y, f (x, y) ∂ν) :=
-begin
-  have m := @measurable_prod_mk_left,
-  refine measurable.ennreal_induction _ _ _,
-  { intros c s hs, simp only [← indicator_comp_right],
-    suffices : measurable (λ x, c * ν (prod.mk x ⁻¹' s)),
-    { simpa [lintegral_indicator _ (m hs)] },
-    exact (measurable_measure_prod_mk_left hs).const_mul _ },
-  { rintro f g - hf hg h2f h2g, simp_rw [pi.add_apply, lintegral_add (hf.comp m) (hg.comp m)],
-    exact h2f.add h2g },
-  { intros f hf h2f h3f,
-    have := measurable_supr h3f,
-    have : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
-    simpa [lintegral_supr (λ n, (hf n).comp m), this] }
-end
-
-/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
-  Tonelli's theorem is measurable.
-  This version has the argument `f` in curried form. -/
-lemma measurable.lintegral_prod_right [sigma_finite ν] {f : α → β → ℝ≥0∞}
-  (hf : measurable (uncurry f)) : measurable (λ x, ∫⁻ y, f x y ∂ν) :=
-hf.lintegral_prod_right'
-
-/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
-  the symmetric version of Tonelli's theorem is measurable. -/
-lemma measurable.lintegral_prod_left' [sigma_finite μ] {f : α × β → ℝ≥0∞}
-  (hf : measurable f) : measurable (λ y, ∫⁻ x, f (x, y) ∂μ) :=
-(measurable_swap_iff.mpr hf).lintegral_prod_right'
-
-/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
-  the symmetric version of Tonelli's theorem is measurable.
-  This version has the argument `f` in curried form. -/
-lemma measurable.lintegral_prod_left [sigma_finite μ] {f : α → β → ℝ≥0∞}
-  (hf : measurable (uncurry f)) : measurable (λ y, ∫⁻ x, f x y ∂μ) :=
-hf.lintegral_prod_left'
-
-lemma measurable_set_integrable [sigma_finite ν] ⦃f : α → β → E⦄
-  (hf : strongly_measurable (uncurry f)) : measurable_set {x | integrable (f x) ν} :=
-begin
-  simp_rw [integrable, hf.of_uncurry_left.ae_strongly_measurable, true_and],
-  exact measurable_set_lt (measurable.lintegral_prod_right hf.ennnorm) measurable_const
-end
-
-section
-variables [normed_space ℝ E] [complete_space E]
-
-/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
-  Fubini's theorem is measurable.
-  This version has `f` in curried form. -/
-lemma measure_theory.strongly_measurable.integral_prod_right [sigma_finite ν] ⦃f : α → β → E⦄
-  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ x, ∫ y, f x y ∂ν) :=
-begin
-  borelize E,
-  haveI : separable_space (range (uncurry f) ∪ {0} : set E) :=
-    hf.separable_space_range_union_singleton,
-  let s : ℕ → simple_func (α × β) E := simple_func.approx_on _ hf.measurable
-    (range (uncurry f) ∪ {0}) 0 (by simp),
-  let s' : ℕ → α → simple_func β E := λ n x, (s n).comp (prod.mk x) measurable_prod_mk_left,
-  let f' : ℕ → α → E := λ n, {x | integrable (f x) ν}.indicator
-    (λ x, (s' n x).integral ν),
-  have hf' : ∀ n, strongly_measurable (f' n),
-  { intro n, refine strongly_measurable.indicator _ (measurable_set_integrable hf),
-    have : ∀ x, (s' n x).range.filter (λ x, x ≠ 0) ⊆ (s n).range,
-    { intros x, refine finset.subset.trans (finset.filter_subset _ _) _, intro y,
-      simp_rw [simple_func.mem_range], rintro ⟨z, rfl⟩, exact ⟨(x, z), rfl⟩ },
-    simp only [simple_func.integral_eq_sum_of_subset (this _)],
-    refine finset.strongly_measurable_sum _ (λ x _, _),
-    refine (measurable.ennreal_to_real _).strongly_measurable.smul_const _,
-    simp only [simple_func.coe_comp, preimage_comp] {single_pass := tt},
-    apply measurable_measure_prod_mk_left,
-    exact (s n).measurable_set_fiber x },
-  have h2f' : tendsto f' at_top (𝓝 (λ (x : α), ∫ (y : β), f x y ∂ν)),
-  { rw [tendsto_pi_nhds], intro x,
-    by_cases hfx : integrable (f x) ν,
-    { have : ∀ n, integrable (s' n x) ν,
-      { intro n, apply (hfx.norm.add hfx.norm).mono' (s' n x).ae_strongly_measurable,
-        apply eventually_of_forall, intro y,
-        simp_rw [s', simple_func.coe_comp], exact simple_func.norm_approx_on_zero_le _ _ (x, y) n },
-      simp only [f', hfx, simple_func.integral_eq_integral _ (this _), indicator_of_mem,
-        mem_set_of_eq],
-      refine tendsto_integral_of_dominated_convergence (λ y, ∥f x y∥ + ∥f x y∥)
-        (λ n, (s' n x).ae_strongly_measurable) (hfx.norm.add hfx.norm) _ _,
-      { exact λ n, eventually_of_forall (λ y, simple_func.norm_approx_on_zero_le _ _ (x, y) n) },
-      { refine eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ _),
-        apply subset_closure,
-        simp [-uncurry_apply_pair], } },
-    { simpa [f', hfx, integral_undef] using @tendsto_const_nhds _ _ _ (0 : E) _, } },
-  exact strongly_measurable_of_tendsto _ hf' h2f'
-end
-
-/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
-  Fubini's theorem is measurable. -/
-lemma measure_theory.strongly_measurable.integral_prod_right' [sigma_finite ν] ⦃f : α × β → E⦄
-  (hf : strongly_measurable f) : strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) :=
-by { rw [← uncurry_curry f] at hf, exact hf.integral_prod_right }
-
-/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
-  the symmetric version of Fubini's theorem is measurable.
-  This version has `f` in curried form. -/
-lemma measure_theory.strongly_measurable.integral_prod_left [sigma_finite μ] ⦃f : α → β → E⦄
-  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ y, ∫ x, f x y ∂μ) :=
-(hf.comp_measurable measurable_swap).integral_prod_right'
-
-/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
-  the symmetric version of Fubini's theorem is measurable. -/
-lemma measure_theory.strongly_measurable.integral_prod_left' [sigma_finite μ] ⦃f : α × β → E⦄
-  (hf : strongly_measurable f) : strongly_measurable (λ y, ∫ x, f (x, y) ∂μ) :=
-(hf.comp_measurable measurable_swap).integral_prod_right'
-
-end
-
-/-! ### The product measure -/
-
-namespace measure_theory
-
-namespace measure
-
-/-- The binary product of measures. They are defined for arbitrary measures, but we basically
-  prove all properties under the assumption that at least one of them is σ-finite. -/
-@[irreducible] protected def prod (μ : measure α) (ν : measure β) : measure (α × β) :=
-bind μ $ λ x : α, map (prod.mk x) ν
-
-instance prod.measure_space {α β} [measure_space α] [measure_space β] : measure_space (α × β) :=
-{ volume := volume.prod volume }
-
-variables {μ ν} [sigma_finite ν]
-
-lemma volume_eq_prod (α β) [measure_space α] [measure_space β] :
-  (volume : measure (α × β)) = (volume : measure α).prod (volume : measure β) :=
-rfl
-
-lemma prod_apply {s : set (α × β)} (hs : measurable_set s) :
-  μ.prod ν s = ∫⁻ x, ν (prod.mk x ⁻¹' s) ∂μ :=
-by simp_rw [measure.prod, bind_apply hs measurable.map_prod_mk_left,
-  map_apply measurable_prod_mk_left hs]
-
-/-- The product measure of the product of two sets is the product of their measures. Note that we
-do not need the sets to be measurable. -/
-@[simp] lemma prod_prod (s : set α) (t : set β) : μ.prod ν (s ×ˢ t) = μ s * ν t :=
-begin
-  apply le_antisymm,
-  { set ST := (to_measurable μ s) ×ˢ (to_measurable ν t),
-    have hSTm : measurable_set ST :=
-      (measurable_set_to_measurable _ _).prod (measurable_set_to_measurable _ _),
-    calc μ.prod ν (s ×ˢ t) ≤ μ.prod ν ST :
-      measure_mono $ set.prod_mono (subset_to_measurable _ _) (subset_to_measurable _ _)
-    ... = μ (to_measurable μ s) * ν (to_measurable ν t) :
-      by simp_rw [prod_apply hSTm, mk_preimage_prod_right_eq_if, measure_if,
-        lintegral_indicator _ (measurable_set_to_measurable _ _), lintegral_const,
-        restrict_apply_univ, mul_comm]
-    ... = μ s * ν t : by rw [measure_to_measurable, measure_to_measurable] },
-  { /- Formalization is based on https://mathoverflow.net/a/254134/136589 -/
-    set ST := to_measurable (μ.prod ν) (s ×ˢ t),
-    have hSTm : measurable_set ST := measurable_set_to_measurable _ _,
-    have hST : s ×ˢ t ⊆ ST := subset_to_measurable _ _,
-    set f : α → ℝ≥0∞ := λ x, ν (prod.mk x ⁻¹' ST),
-    have hfm : measurable f := measurable_measure_prod_mk_left hSTm,
-    set s' : set α := {x | ν t ≤ f x},
-    have hss' : s ⊆ s' := λ x hx, measure_mono (λ y hy, hST $ mk_mem_prod hx hy),
-    calc μ s * ν t ≤ μ s' * ν t : mul_le_mul_right' (measure_mono hss') _
-    ... = ∫⁻ x in s', ν t ∂μ    : by rw [set_lintegral_const, mul_comm]
-    ... ≤ ∫⁻ x in s', f x ∂μ    : set_lintegral_mono measurable_const hfm (λ x, id)
-    ... ≤ ∫⁻ x, f x ∂μ          : lintegral_mono' restrict_le_self le_rfl
-    ... = μ.prod ν ST           : (prod_apply hSTm).symm
-    ... = μ.prod ν (s ×ˢ t)     : measure_to_measurable _ }
-end
-
-lemma ae_measure_lt_top {s : set (α × β)} (hs : measurable_set s)
-  (h2s : (μ.prod ν) s ≠ ∞) : ∀ᵐ x ∂μ, ν (prod.mk x ⁻¹' s) < ∞ :=
-by { simp_rw [prod_apply hs] at h2s, refine ae_lt_top (measurable_measure_prod_mk_left hs) h2s }
-
-lemma integrable_measure_prod_mk_left {s : set (α × β)}
-  (hs : measurable_set s) (h2s : (μ.prod ν) s ≠ ∞) :
-  integrable (λ x, (ν (prod.mk x ⁻¹' s)).to_real) μ :=
-begin
-  refine ⟨(measurable_measure_prod_mk_left hs).ennreal_to_real.ae_measurable.ae_strongly_measurable,
-    _⟩,
-  simp_rw [has_finite_integral, ennnorm_eq_of_real to_real_nonneg],
-  convert h2s.lt_top using 1, simp_rw [prod_apply hs], apply lintegral_congr_ae,
-  refine (ae_measure_lt_top hs h2s).mp _, apply eventually_of_forall, intros x hx,
-  rw [lt_top_iff_ne_top] at hx, simp [of_real_to_real, hx],
-end
-
-/-- Note: the assumption `hs` cannot be dropped. For a counterexample, see
-  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
-lemma measure_prod_null {s : set (α × β)}
-  (hs : measurable_set s) : μ.prod ν s = 0 ↔ (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
-by simp_rw [prod_apply hs, lintegral_eq_zero_iff (measurable_measure_prod_mk_left hs)]
-
-/-- Note: the converse is not true without assuming that `s` is measurable. For a counterexample,
-  see Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
-lemma measure_ae_null_of_prod_null {s : set (α × β)}
-  (h : μ.prod ν s = 0) : (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
-begin
-  obtain ⟨t, hst, mt, ht⟩ := exists_measurable_superset_of_null h,
-  simp_rw [measure_prod_null mt] at ht,
-  rw [eventually_le_antisymm_iff],
-  exact ⟨eventually_le.trans_eq
-    (eventually_of_forall $ λ x, (measure_mono (preimage_mono hst) : _)) ht,
-    eventually_of_forall $ λ x, zero_le _⟩
-end
-
-/-- Note: the converse is not true. For a counterexample, see
-  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
-lemma ae_ae_of_ae_prod {p : α × β → Prop} (h : ∀ᵐ z ∂μ.prod ν, p z) :
-  ∀ᵐ x ∂ μ, ∀ᵐ y ∂ ν, p (x, y) :=
-measure_ae_null_of_prod_null h
-
-/-- `μ.prod ν` has finite spanning sets in rectangles of finite spanning sets. -/
-noncomputable! def finite_spanning_sets_in.prod {ν : measure β} {C : set (set α)} {D : set (set β)}
-  (hμ : μ.finite_spanning_sets_in C) (hν : ν.finite_spanning_sets_in D) :
-  (μ.prod ν).finite_spanning_sets_in (image2 (×ˢ) C D) :=
-begin
-  haveI := hν.sigma_finite,
-  refine ⟨λ n, hμ.set n.unpair.1 ×ˢ hν.set n.unpair.2,
-    λ n, mem_image2_of_mem (hμ.set_mem _) (hν.set_mem _), λ n, _, _⟩,
-  { rw [prod_prod],
-    exact mul_lt_top (hμ.finite _).ne (hν.finite _).ne },
-  { simp_rw [Union_unpair_prod, hμ.spanning, hν.spanning, univ_prod_univ] }
-end
-
-lemma prod_fst_absolutely_continuous : map prod.fst (μ.prod ν) ≪ μ :=
-begin
-  refine absolutely_continuous.mk (λ s hs h2s, _),
-  rw [map_apply measurable_fst hs, ← prod_univ, prod_prod, h2s, zero_mul],
-end
-
-lemma prod_snd_absolutely_continuous : map prod.snd (μ.prod ν) ≪ ν :=
-begin
-  refine absolutely_continuous.mk (λ s hs h2s, _),
-  rw [map_apply measurable_snd hs, ← univ_prod, prod_prod, h2s, mul_zero]
-end
-
-variables [sigma_finite μ]
-
-instance prod.sigma_finite : sigma_finite (μ.prod ν) :=
-(μ.to_finite_spanning_sets_in.prod ν.to_finite_spanning_sets_in).sigma_finite
-
-/-- A measure on a product space equals the product measure if they are equal on rectangles
-  with as sides sets that generate the corresponding σ-algebras. -/
-lemma prod_eq_generate_from {μ : measure α} {ν : measure β} {C : set (set α)}
-  {D : set (set β)} (hC : generate_from C = ‹_›)
-  (hD : generate_from D = ‹_›) (h2C : is_pi_system C) (h2D : is_pi_system D)
-  (h3C : μ.finite_spanning_sets_in C) (h3D : ν.finite_spanning_sets_in D)
-  {μν : measure (α × β)}
-  (h₁ : ∀ (s ∈ C) (t ∈ D), μν (s ×ˢ t) = μ s * ν t) : μ.prod ν = μν :=
-begin
-  refine (h3C.prod h3D).ext
-    (generate_from_eq_prod hC hD h3C.is_countably_spanning h3D.is_countably_spanning).symm
-    (h2C.prod h2D) _,
-  { rintro _ ⟨s, t, hs, ht, rfl⟩, haveI := h3D.sigma_finite,
-    rw [h₁ s hs t ht, prod_prod] }
-end
-
-/-- A measure on a product space equals the product measure if they are equal on rectangles. -/
-lemma prod_eq {μν : measure (α × β)}
-  (h : ∀ s t, measurable_set s → measurable_set t → μν (s ×ˢ t) = μ s * ν t) : μ.prod ν = μν :=
-prod_eq_generate_from generate_from_measurable_set generate_from_measurable_set
-  is_pi_system_measurable_set is_pi_system_measurable_set
-  μ.to_finite_spanning_sets_in ν.to_finite_spanning_sets_in (λ s hs t ht, h s t hs ht)
-
-lemma prod_swap : map prod.swap (μ.prod ν) = ν.prod μ :=
-begin
-  refine (prod_eq _).symm,
-  intros s t hs ht,
-  simp_rw [map_apply measurable_swap (hs.prod ht), preimage_swap_prod, prod_prod, mul_comm]
-end
-
-lemma prod_apply_symm {s : set (α × β)} (hs : measurable_set s) :
-  μ.prod ν s = ∫⁻ y, μ ((λ x, (x, y)) ⁻¹' s) ∂ν :=
-by { rw [← prod_swap, map_apply measurable_swap hs],
-     simp only [prod_apply (measurable_swap hs)], refl }
-
-lemma prod_assoc_prod [sigma_finite τ] :
-  map measurable_equiv.prod_assoc ((μ.prod ν).prod τ) = μ.prod (ν.prod τ) :=
-begin
-  refine (prod_eq_generate_from generate_from_measurable_set generate_from_prod
-    is_pi_system_measurable_set is_pi_system_prod μ.to_finite_spanning_sets_in
-    (ν.to_finite_spanning_sets_in.prod τ.to_finite_spanning_sets_in) _).symm,
-  rintro s hs _ ⟨t, u, ht, hu, rfl⟩, rw [mem_set_of_eq] at hs ht hu,
-  simp_rw [map_apply (measurable_equiv.measurable _) (hs.prod (ht.prod hu)),
-    measurable_equiv.prod_assoc, measurable_equiv.coe_mk, equiv.prod_assoc_preimage,
-    prod_prod, mul_assoc]
-end
-
-/-! ### The product of specific measures -/
-
-lemma prod_restrict (s : set α) (t : set β) :
-  (μ.restrict s).prod (ν.restrict t) = (μ.prod ν).restrict (s ×ˢ t) :=
-begin
-  refine prod_eq (λ s' t' hs' ht', _),
-  rw [restrict_apply (hs'.prod ht'), prod_inter_prod, prod_prod, restrict_apply hs',
-    restrict_apply ht']
-end
-
-lemma restrict_prod_eq_prod_univ (s : set α) :
-  (μ.restrict s).prod ν = (μ.prod ν).restrict (s ×ˢ (univ : set β)) :=
-begin
-  have : ν = ν.restrict set.univ := measure.restrict_univ.symm,
-  rwa [this, measure.prod_restrict, ← this],
-end
-
-lemma prod_dirac (y : β) : μ.prod (dirac y) = map (λ x, (x, y)) μ :=
-begin
-  refine prod_eq (λ s t hs ht, _),
-  simp_rw [map_apply measurable_prod_mk_right (hs.prod ht), mk_preimage_prod_left_eq_if, measure_if,
-    dirac_apply' _ ht, ← indicator_mul_right _ (λ x, μ s), pi.one_apply, mul_one]
-end
-
-lemma dirac_prod (x : α) : (dirac x).prod ν = map (prod.mk x) ν :=
-begin
-  refine prod_eq (λ s t hs ht, _),
-  simp_rw [map_apply measurable_prod_mk_left (hs.prod ht), mk_preimage_prod_right_eq_if, measure_if,
-    dirac_apply' _ hs, ← indicator_mul_left _ _ (λ x, ν t), pi.one_apply, one_mul]
-end
-
-lemma dirac_prod_dirac {x : α} {y : β} : (dirac x).prod (dirac y) = dirac (x, y) :=
-by rw [prod_dirac, map_dirac measurable_prod_mk_right]
-
-lemma prod_sum {ι : Type*} [fintype ι] (ν : ι → measure β) [∀ i, sigma_finite (ν i)] :
-  μ.prod (sum ν) = sum (λ i, μ.prod (ν i)) :=
-begin
-  refine prod_eq (λ s t hs ht, _),
-  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ ht, prod_prod, ennreal.tsum_mul_left]
-end
-
-lemma sum_prod {ι : Type*} [fintype ι] (μ : ι → measure α) [∀ i, sigma_finite (μ i)] :
-  (sum μ).prod ν = sum (λ i, (μ i).prod ν) :=
-begin
-  refine prod_eq (λ s t hs ht, _),
-  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ hs, prod_prod, ennreal.tsum_mul_right]
-end
-
-lemma prod_add (ν' : measure β) [sigma_finite ν'] : μ.prod (ν + ν') = μ.prod ν + μ.prod ν' :=
-by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, left_distrib] }
-
-lemma add_prod (μ' : measure α) [sigma_finite μ'] : (μ + μ').prod ν = μ.prod ν + μ'.prod ν :=
-by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, right_distrib] }
-
-@[simp] lemma zero_prod (ν : measure β) : (0 : measure α).prod ν = 0 :=
-by { rw measure.prod, exact bind_zero_left _ }
-
-@[simp] lemma prod_zero (μ : measure α) : μ.prod (0 : measure β) = 0 :=
-by simp [measure.prod]
-
-lemma map_prod_map {δ} [measurable_space δ] {f : α → β} {g : γ → δ}
-  {μa : measure α} {μc : measure γ} (hfa : sigma_finite (map f μa))
-  (hgc : sigma_finite (map g μc)) (hf : measurable f) (hg : measurable g) :
-  (map f μa).prod (map g μc) = map (prod.map f g) (μa.prod μc) :=
-begin
-  haveI := hgc.of_map μc hg.ae_measurable,
-  refine prod_eq (λ s t hs ht, _),
-  rw [map_apply (hf.prod_map hg) (hs.prod ht), map_apply hf hs, map_apply hg ht],
-  exact prod_prod (f ⁻¹' s) (g ⁻¹' t)
-end
-
-end measure
-
-open measure
-
-namespace measure_preserving
-
-variables {δ : Type*} [measurable_space δ] {μa : measure α} {μb : measure β}
-  {μc : measure γ} {μd : measure δ}
-
-lemma skew_product [sigma_finite μb] [sigma_finite μd]
-  {f : α → β} (hf : measure_preserving f μa μb) {g : α → γ → δ}
-  (hgm : measurable (uncurry g)) (hg : ∀ᵐ x ∂μa, map (g x) μc = μd) :
-  measure_preserving (λ p : α × γ, (f p.1, g p.1 p.2)) (μa.prod μc) (μb.prod μd) :=
-begin
-  classical,
-  have : measurable (λ p : α × γ, (f p.1, g p.1 p.2)) := (hf.1.comp measurable_fst).prod_mk hgm,
-  /- if `μa = 0`, then the lemma is trivial, otherwise we can use `hg`
-  to deduce `sigma_finite μc`. -/
-  rcases eq_or_ne μa 0 with (rfl|ha),
-  { rw [← hf.map_eq, zero_prod, measure.map_zero, zero_prod],
-    exact ⟨this, by simp only [measure.map_zero]⟩ },
-  haveI : sigma_finite μc,
-  { rcases (ae_ne_bot.2 ha).nonempty_of_mem hg with ⟨x, hx : map (g x) μc = μd⟩,
-    exact sigma_finite.of_map _ hgm.of_uncurry_left.ae_measurable (by rwa hx) },
-  -- Thus we can apply `measure.prod_eq` to prove equality of measures.
-  refine ⟨this, (prod_eq $ λ s t hs ht, _).symm⟩,
-  rw [map_apply this (hs.prod ht)],
-  refine (prod_apply (this $ hs.prod ht)).trans _,
-  have : ∀ᵐ x ∂μa, μc ((λ y, (f x, g x y)) ⁻¹' s ×ˢ t) = indicator (f ⁻¹' s) (λ y, μd t) x,
-  { refine hg.mono (λ x hx, _), unfreezingI { subst hx },
-    simp only [mk_preimage_prod_right_fn_eq_if, indicator_apply, mem_preimage],
-    split_ifs,
-    exacts [(map_apply hgm.of_uncurry_left ht).symm, measure_empty] },
-  simp only [preimage_preimage],
-  rw [lintegral_congr_ae this, lintegral_indicator _ (hf.1 hs),
-    set_lintegral_const, hf.measure_preimage hs, mul_comm]
-end
-
-/-- If `f : α → β` sends the measure `μa` to `μb` and `g : γ → δ` sends the measure `μc` to `μd`,
-then `prod.map f g` sends `μa.prod μc` to `μb.prod μd`. -/
-protected lemma prod [sigma_finite μb] [sigma_finite μd] {f : α → β} {g : γ → δ}
-  (hf : measure_preserving f μa μb) (hg : measure_preserving g μc μd) :
-  measure_preserving (prod.map f g) (μa.prod μc) (μb.prod μd) :=
-have measurable (uncurry $ λ _ : α, g), from (hg.1.comp measurable_snd),
-hf.skew_product this $ filter.eventually_of_forall $ λ _, hg.map_eq
-
-end measure_preserving
-
-namespace quasi_measure_preserving
-
-lemma prod_of_right {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
-  (hf : measurable f) [sigma_finite ν]
-  (h2f : ∀ᵐ x ∂μ, quasi_measure_preserving (λ y, f (x, y)) ν τ) :
-  quasi_measure_preserving f (μ.prod ν) τ :=
-begin
-  refine ⟨hf, _⟩,
-  refine absolutely_continuous.mk (λ s hs h2s, _),
-  simp_rw [map_apply hf hs, prod_apply (hf hs), preimage_preimage,
-    lintegral_congr_ae (h2f.mono (λ x hx, hx.preimage_null h2s)), lintegral_zero],
-end
-
-lemma prod_of_left {α β γ} [measurable_space α] [measurable_space β]
-  [measurable_space γ] {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
-  (hf : measurable f) [sigma_finite μ] [sigma_finite ν]
-  (h2f : ∀ᵐ y ∂ν, quasi_measure_preserving (λ x, f (x, y)) μ τ) :
-  quasi_measure_preserving f (μ.prod ν) τ :=
-begin
-  rw [← prod_swap],
-  convert (quasi_measure_preserving.prod_of_right (hf.comp measurable_swap) h2f).comp
-    ((measurable_swap.measure_preserving (ν.prod μ)).symm measurable_equiv.prod_comm)
-    .quasi_measure_preserving,
-  ext ⟨x, y⟩, refl,
-end
-
-end quasi_measure_preserving
-
-end measure_theory
-
-open measure_theory.measure
-
-section
-
-lemma ae_measurable.prod_swap [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
-  (hf : ae_measurable f (ν.prod μ)) : ae_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
-by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }
-
-lemma measure_theory.ae_strongly_measurable.prod_swap
-  {γ : Type*} [topological_space γ] [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
-  (hf : ae_strongly_measurable f (ν.prod μ)) :
-  ae_strongly_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
-by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }
-
-lemma ae_measurable.fst [sigma_finite ν] {f : α → γ}
-  (hf : ae_measurable f μ) : ae_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
-hf.comp_measurable' measurable_fst prod_fst_absolutely_continuous
-
-lemma ae_measurable.snd [sigma_finite ν] {f : β → γ}
-  (hf : ae_measurable f ν) : ae_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
-hf.comp_measurable' measurable_snd prod_snd_absolutely_continuous
-
-lemma measure_theory.ae_strongly_measurable.fst {γ} [topological_space γ] [sigma_finite ν]
-  {f : α → γ} (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
-hf.comp_measurable' measurable_fst prod_fst_absolutely_continuous
-
-lemma measure_theory.ae_strongly_measurable.snd {γ} [topological_space γ] [sigma_finite ν]
-  {f : β → γ} (hf : ae_strongly_measurable f ν) :
-  ae_strongly_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
-hf.comp_measurable' measurable_snd prod_snd_absolutely_continuous
-
-/-- The Bochner integral is a.e.-measurable.
-  This shows that the integrand of (the right-hand-side of) Fubini's theorem is a.e.-measurable. -/
-lemma measure_theory.ae_strongly_measurable.integral_prod_right' [sigma_finite ν]
-  [normed_space ℝ E] [complete_space E]
-  ⦃f : α × β → E⦄ (hf : ae_strongly_measurable f (μ.prod ν)) :
-  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) μ :=
-⟨λ x, ∫ y, hf.mk f (x, y) ∂ν, hf.strongly_measurable_mk.integral_prod_right',
-  by { filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ hx using integral_congr_ae hx }⟩
-
-lemma measure_theory.ae_strongly_measurable.prod_mk_left
-  {γ : Type*} [sigma_finite ν] [topological_space γ] {f : α × β → γ}
-  (hf : ae_strongly_measurable f (μ.prod ν)) : ∀ᵐ x ∂μ, ae_strongly_measurable (λ y, f (x, y)) ν :=
-begin
-  filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with x hx,
-  exact ⟨λ y, hf.mk f (x, y), hf.strongly_measurable_mk.comp_measurable measurable_prod_mk_left, hx⟩
-end
-
-end
-
-namespace measure_theory
-
-/-! ### The Lebesgue integral on a product -/
-
-variables [sigma_finite ν]
-
-lemma lintegral_prod_swap [sigma_finite μ] (f : α × β → ℝ≥0∞)
-  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z.swap ∂(ν.prod μ) = ∫⁻ z, f z ∂(μ.prod ν) :=
-by { rw ← prod_swap at hf, rw [← lintegral_map' hf measurable_swap.ae_measurable, prod_swap] }
-
-/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued measurable functions on `α × β`,
-  the integral of `f` is equal to the iterated integral. -/
-lemma lintegral_prod_of_measurable :
-  ∀ (f : α × β → ℝ≥0∞) (hf : measurable f), ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
-begin
-  have m := @measurable_prod_mk_left,
-  refine measurable.ennreal_induction _ _ _,
-  { intros c s hs, simp only [← indicator_comp_right],
-    simp [lintegral_indicator, m hs, hs, lintegral_const_mul, measurable_measure_prod_mk_left hs,
-      prod_apply] },
-  { rintro f g - hf hg h2f h2g,
-    simp [lintegral_add, measurable.lintegral_prod_right', hf.comp m, hg.comp m,
-      hf, hg, h2f, h2g] },
-  { intros f hf h2f h3f,
-    have kf : ∀ x n, measurable (λ y, f n (x, y)) := λ x n, (hf n).comp m,
-    have k2f : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
-    have lf : ∀ n, measurable (λ x, ∫⁻ y, f n (x, y) ∂ν) := λ n, (hf n).lintegral_prod_right',
-    have l2f : monotone (λ n x, ∫⁻ y, f n (x, y) ∂ν) := λ i j hij x, lintegral_mono (k2f x hij),
-    simp only [lintegral_supr hf h2f, lintegral_supr (kf _), k2f, lintegral_supr lf l2f, h3f] },
-end
-
-/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued almost everywhere measurable functions on `α × β`,
-  the integral of `f` is equal to the iterated integral. -/
-lemma lintegral_prod (f : α × β → ℝ≥0∞) (hf : ae_measurable f (μ.prod ν)) :
-  ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
-begin
-  have A : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ z, hf.mk f z ∂(μ.prod ν) :=
-    lintegral_congr_ae hf.ae_eq_mk,
-  have B : ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ = ∫⁻ x, ∫⁻ y, hf.mk f (x, y) ∂ν ∂μ,
-  { apply lintegral_congr_ae,
-    filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ ha using lintegral_congr_ae ha, },
-  rw [A, B, lintegral_prod_of_measurable _ hf.measurable_mk],
-  apply_instance
-end
-
-/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued almost everywhere measurable
-functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
-lemma lintegral_prod_symm [sigma_finite μ] (f : α × β → ℝ≥0∞)
-  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
-by { simp_rw [← lintegral_prod_swap f hf], exact lintegral_prod _ hf.prod_swap }
-
-/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued measurable
-functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
-lemma lintegral_prod_symm' [sigma_finite μ] (f : α × β → ℝ≥0∞)
-  (hf : measurable f) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
-lintegral_prod_symm f hf.ae_measurable
-
-/-- The reversed version of **Tonelli's Theorem**. In this version `f` is in curried form, which
-makes it easier for the elaborator to figure out `f` automatically. -/
-lemma lintegral_lintegral ⦃f : α → β → ℝ≥0∞⦄
-  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
-  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.1 z.2 ∂(μ.prod ν) :=
-(lintegral_prod _ hf).symm
-
-/-- The reversed version of **Tonelli's Theorem** (symmetric version). In this version `f` is in
-curried form, which makes it easier for the elaborator to figure out `f` automatically. -/
-lemma lintegral_lintegral_symm [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
-  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
-  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.2 z.1 ∂(ν.prod μ) :=
-(lintegral_prod_symm _ hf.prod_swap).symm
-
-/-- Change the order of Lebesgue integration. -/
-lemma lintegral_lintegral_swap [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
-  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
-  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ y, ∫⁻ x, f x y ∂μ ∂ν :=
-(lintegral_lintegral hf).trans (lintegral_prod_symm _ hf)
-
-lemma lintegral_prod_mul {f : α → ℝ≥0∞} {g : β → ℝ≥0∞}
-  (hf : ae_measurable f μ) (hg : ae_measurable g ν) :
-  ∫⁻ z, f z.1 * g z.2 ∂(μ.prod ν) = ∫⁻ x, f x ∂μ * ∫⁻ y, g y ∂ν :=
-by simp [lintegral_prod _ (hf.fst.mul hg.snd), lintegral_lintegral_mul hf hg]
-
-/-! ### Integrability on a product -/
-section
-
-lemma integrable.swap [sigma_finite μ] ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : integrable (f ∘ prod.swap) (ν.prod μ) :=
-⟨hf.ae_strongly_measurable.prod_swap,
-  (lintegral_prod_swap _ hf.ae_strongly_measurable.ennnorm : _).le.trans_lt hf.has_finite_integral⟩
-
-lemma integrable_swap_iff [sigma_finite μ] ⦃f : α × β → E⦄ :
-  integrable (f ∘ prod.swap) (ν.prod μ) ↔ integrable f (μ.prod ν) :=
-⟨λ hf, by { convert hf.swap, ext ⟨x, y⟩, refl }, λ hf, hf.swap⟩
-
-lemma has_finite_integral_prod_iff ⦃f : α × β → E⦄ (h1f : strongly_measurable f) :
-  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
-    has_finite_integral (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
-begin
-  simp only [has_finite_integral, lintegral_prod_of_measurable _ h1f.ennnorm],
-  have : ∀ x, ∀ᵐ y ∂ν, 0 ≤ ∥f (x, y)∥ := λ x, eventually_of_forall (λ y, norm_nonneg _),
-  simp_rw [integral_eq_lintegral_of_nonneg_ae (this _)
-    (h1f.norm.comp_measurable measurable_prod_mk_left).ae_strongly_measurable,
-    ennnorm_eq_of_real to_real_nonneg, of_real_norm_eq_coe_nnnorm],
-  -- this fact is probably too specialized to be its own lemma
-  have : ∀ {p q r : Prop} (h1 : r → p), (r ↔ p ∧ q) ↔ (p → (r ↔ q)) :=
-  λ p q r h1, by rw [← and.congr_right_iff, and_iff_right_of_imp h1],
-  rw [this],
-  { intro h2f, rw lintegral_congr_ae,
-    refine h2f.mp _, apply eventually_of_forall, intros x hx, dsimp only,
-    rw [of_real_to_real], rw [← lt_top_iff_ne_top], exact hx },
-  { intro h2f, refine ae_lt_top _ h2f.ne, exact h1f.ennnorm.lintegral_prod_right' },
-end
-
-lemma has_finite_integral_prod_iff' ⦃f : α × β → E⦄ (h1f : ae_strongly_measurable f (μ.prod ν)) :
-  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
-    has_finite_integral (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
-begin
-  rw [has_finite_integral_congr h1f.ae_eq_mk,
-    has_finite_integral_prod_iff h1f.strongly_measurable_mk],
-  apply and_congr,
-  { apply eventually_congr,
-    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm],
-    assume x hx,
-    exact has_finite_integral_congr hx },
-  { apply has_finite_integral_congr,
-    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm] with _ hx
-      using integral_congr_ae (eventually_eq.fun_comp hx _), },
-  { apply_instance, },
-end
-
-/-- A binary function is integrable if the function `y ↦ f (x, y)` is integrable for almost every
-  `x` and the function `x ↦ ∫ ∥f (x, y)∥ dy` is integrable. -/
-lemma integrable_prod_iff ⦃f : α × β → E⦄ (h1f : ae_strongly_measurable f (μ.prod ν)) :
-  integrable f (μ.prod ν) ↔
-    (∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν) ∧ integrable (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
-by simp [integrable, h1f, has_finite_integral_prod_iff', h1f.norm.integral_prod_right',
-         h1f.prod_mk_left]
-
-/-- A binary function is integrable if the function `x ↦ f (x, y)` is integrable for almost every
-  `y` and the function `y ↦ ∫ ∥f (x, y)∥ dx` is integrable. -/
-lemma integrable_prod_iff' [sigma_finite μ] ⦃f : α × β → E⦄
-  (h1f : ae_strongly_measurable f (μ.prod ν)) :
-  integrable f (μ.prod ν) ↔
-    (∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ) ∧ integrable (λ y, ∫ x, ∥f (x, y)∥ ∂μ) ν :=
-by { convert integrable_prod_iff (h1f.prod_swap) using 1, rw [integrable_swap_iff] }
-
-lemma integrable.prod_left_ae [sigma_finite μ] ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : ∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ :=
-((integrable_prod_iff' hf.ae_strongly_measurable).mp hf).1
-
-lemma integrable.prod_right_ae [sigma_finite μ] ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : ∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν :=
-hf.swap.prod_left_ae
-
-lemma integrable.integral_norm_prod_left ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, ∥f (x, y)∥ ∂ν) μ :=
-((integrable_prod_iff hf.ae_strongly_measurable).mp hf).2
-
-lemma integrable.integral_norm_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, ∥f (x, y)∥ ∂μ) ν :=
-hf.swap.integral_norm_prod_left
-
-end
-
-variables [normed_space ℝ E] [complete_space E]
-
-lemma integrable.integral_prod_left ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, f (x, y) ∂ν) μ :=
-integrable.mono hf.integral_norm_prod_left hf.ae_strongly_measurable.integral_prod_right' $
-  eventually_of_forall $ λ x, (norm_integral_le_integral_norm _).trans_eq $
-  (norm_of_nonneg $ integral_nonneg_of_ae $ eventually_of_forall $
-  λ y, (norm_nonneg (f (x, y)) : _)).symm
-
-lemma integrable.integral_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, f (x, y) ∂μ) ν :=
-hf.swap.integral_prod_left
-
-/-! ### The Bochner integral on a product -/
-
-variables [sigma_finite μ]
-
-lemma integral_prod_swap (f : α × β → E)
-  (hf : ae_strongly_measurable f (μ.prod ν)) : ∫ z, f z.swap ∂(ν.prod μ) = ∫ z, f z ∂(μ.prod ν) :=
-begin
-  rw ← prod_swap at hf,
-  rw [← integral_map measurable_swap.ae_measurable hf, prod_swap]
-end
-
-variables {E' : Type*} [normed_group E'] [complete_space E'] [normed_space ℝ E']
-
-/-! Some rules about the sum/difference of double integrals. They follow from `integral_add`, but
-  we separate them out as separate lemmas, because they involve quite some steps. -/
-
-/-- Integrals commute with addition inside another integral. `F` can be any function. -/
-lemma integral_fn_integral_add ⦃f g : α × β → E⦄ (F : E → E')
-  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫ x, F (∫ y, f (x, y) + g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν + ∫ y, g (x, y) ∂ν) ∂μ :=
-begin
-  refine integral_congr_ae _,
-  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
-  simp [integral_add h2f h2g],
-end
-
-/-- Integrals commute with subtraction inside another integral.
-  `F` can be any measurable function. -/
-lemma integral_fn_integral_sub ⦃f g : α × β → E⦄ (F : E → E')
-  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
-begin
-  refine integral_congr_ae _,
-  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
-  simp [integral_sub h2f h2g],
-end
-
-/-- Integrals commute with subtraction inside a lower Lebesgue integral.
-  `F` can be any function. -/
-lemma lintegral_fn_integral_sub ⦃f g : α × β → E⦄
-  (F : E → ℝ≥0∞) (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫⁻ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫⁻ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
-begin
-  refine lintegral_congr_ae _,
-  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
-  simp [integral_sub h2f h2g],
-end
-
-/-- Double integrals commute with addition. -/
-lemma integral_integral_add ⦃f g : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫ x, ∫ y, f (x, y) + g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
-(integral_fn_integral_add id hf hg).trans $
-  integral_add hf.integral_prod_left hg.integral_prod_left
-
-/-- Double integrals commute with addition. This is the version with `(f + g) (x, y)`
-  (instead of `f (x, y) + g (x, y)`) in the LHS. -/
-lemma integral_integral_add' ⦃f g : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫ x, ∫ y, (f + g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
-integral_integral_add hf hg
-
-/-- Double integrals commute with subtraction. -/
-lemma integral_integral_sub ⦃f g : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫ x, ∫ y, f (x, y) - g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
-(integral_fn_integral_sub id hf hg).trans $
-  integral_sub hf.integral_prod_left hg.integral_prod_left
-
-/-- Double integrals commute with subtraction. This is the version with `(f - g) (x, y)`
-  (instead of `f (x, y) - g (x, y)`) in the LHS. -/
-lemma integral_integral_sub' ⦃f g : α × β → E⦄
-  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
-  ∫ x, ∫ y, (f - g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
-integral_integral_sub hf hg
-
-/-- The map that sends an L¹-function `f : α × β → E` to `∫∫f` is continuous. -/
-lemma continuous_integral_integral :
-  continuous (λ (f : α × β →₁[μ.prod ν] E), ∫ x, ∫ y, f (x, y) ∂ν ∂μ) :=
-begin
-  rw [continuous_iff_continuous_at], intro g,
-  refine tendsto_integral_of_L1 _ (L1.integrable_coe_fn g).integral_prod_left
-    (eventually_of_forall $ λ h, (L1.integrable_coe_fn h).integral_prod_left) _,
-  simp_rw [← lintegral_fn_integral_sub (λ x, (∥x∥₊ : ℝ≥0∞)) (L1.integrable_coe_fn _)
-    (L1.integrable_coe_fn g)],
-  refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds _ (λ i, zero_le _) _,
-  { exact λ i, ∫⁻ x, ∫⁻ y, ∥i (x, y) - g (x, y)∥₊ ∂ν ∂μ },
-  swap, { exact λ i, lintegral_mono (λ x, ennnorm_integral_le_lintegral_ennnorm _) },
-  show tendsto (λ (i : α × β →₁[μ.prod ν] E),
-    ∫⁻ x, ∫⁻ (y : β), ∥i (x, y) - g (x, y)∥₊ ∂ν ∂μ) (𝓝 g) (𝓝 0),
-  have : ∀ (i : α × β →₁[μ.prod ν] E), measurable (λ z, (∥i z - g z∥₊ : ℝ≥0∞)) :=
-  λ i, ((Lp.strongly_measurable i).sub (Lp.strongly_measurable g)).ennnorm,
-  simp_rw [← lintegral_prod_of_measurable _ (this _), ← L1.of_real_norm_sub_eq_lintegral,
-    ← of_real_zero],
-  refine (continuous_of_real.tendsto 0).comp _,
-  rw [← tendsto_iff_norm_tendsto_zero], exact tendsto_id
-end
-
-/-- **Fubini's Theorem**: For integrable functions on `α × β`,
-  the Bochner integral of `f` is equal to the iterated Bochner integral.
-  `integrable_prod_iff` can be useful to show that the function in question in integrable.
-  `measure_theory.integrable.integral_prod_right` is useful to show that the inner integral
-  of the right-hand side is integrable. -/
-lemma integral_prod : ∀ (f : α × β → E) (hf : integrable f (μ.prod ν)),
-  ∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ :=
-begin
-  apply integrable.induction,
-  { intros c s hs h2s,
-    simp_rw [integral_indicator hs, ← indicator_comp_right,
-      function.comp, integral_indicator (measurable_prod_mk_left hs),
-      set_integral_const, integral_smul_const,
-      integral_to_real (measurable_measure_prod_mk_left hs).ae_measurable
-      (ae_measure_lt_top hs h2s.ne), prod_apply hs] },
-  { intros f g hfg i_f i_g hf hg,
-    simp_rw [integral_add' i_f i_g, integral_integral_add' i_f i_g, hf, hg] },
-  { exact is_closed_eq continuous_integral continuous_integral_integral },
-  { intros f g hfg i_f hf, convert hf using 1,
-    { exact integral_congr_ae hfg.symm },
-    { refine integral_congr_ae _,
-      refine (ae_ae_of_ae_prod hfg).mp _,
-      apply eventually_of_forall, intros x hfgx,
-      exact integral_congr_ae (ae_eq_symm hfgx) } }
-end
-
-/-- Symmetric version of **Fubini's Theorem**: For integrable functions on `α × β`,
-  the Bochner integral of `f` is equal to the iterated Bochner integral.
-  This version has the integrals on the right-hand side in the other order. -/
-lemma integral_prod_symm (f : α × β → E) (hf : integrable f (μ.prod ν)) :
-  ∫ z, f z ∂(μ.prod ν) = ∫ y, ∫ x, f (x, y) ∂μ ∂ν :=
-by { simp_rw [← integral_prod_swap f hf.ae_strongly_measurable], exact integral_prod _ hf.swap }
-
-/-- Reversed version of **Fubini's Theorem**. -/
-lemma integral_integral {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
-  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.1 z.2 ∂(μ.prod ν) :=
-(integral_prod _ hf).symm
-
-/-- Reversed version of **Fubini's Theorem** (symmetric version). -/
-lemma integral_integral_symm {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
-  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.2 z.1 ∂(ν.prod μ) :=
-(integral_prod_symm _ hf.swap).symm
-
-/-- Change the order of Bochner integration. -/
-lemma integral_integral_swap ⦃f : α → β → E⦄ (hf : integrable (uncurry f) (μ.prod ν)) :
-  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ y, ∫ x, f x y ∂μ ∂ν :=
-(integral_integral hf).trans (integral_prod_symm _ hf)
-
-/-- **Fubini's Theorem** for set integrals. -/
-lemma set_integral_prod (f : α × β → E) {s : set α} {t : set β}
-  (hf : integrable_on f (s ×ˢ t) (μ.prod ν)) :
-  ∫ z in s ×ˢ t, f z ∂(μ.prod ν) = ∫ x in s, ∫ y in t, f (x, y) ∂ν ∂μ :=
-begin
-  simp only [← measure.prod_restrict s t, integrable_on] at hf ⊢,
-  exact integral_prod f hf
-end
-
-end measure_theory
diff --git a/src/measure_theory/constructions/prod/basic.lean b/src/measure_theory/constructions/prod/basic.lean
new file mode 100644
index 0000000000000..7aa1cd9ca24b2
--- /dev/null
+++ b/src/measure_theory/constructions/prod/basic.lean
@@ -0,0 +1,800 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import measure_theory.measure.giry_monad
+import dynamics.ergodic.measure_preserving
+import measure_theory.integral.lebesgue
+import measure_theory.measure.open_pos
+
+/-!
+# The product measure
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define and prove properties about the binary product measure. If `α` and `β` have
+σ-finite measures `μ` resp. `ν` then `α × β` can be equipped with a σ-finite measure `μ.prod ν` that
+satisfies `(μ.prod ν) s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`.
+We also have `(μ.prod ν) (s ×ˢ t) = μ s * ν t`, i.e. the measure of a rectangle is the product of
+the measures of the sides.
+
+We also prove Tonelli's theorem.
+
+## Main definition
+
+* `measure_theory.measure.prod`: The product of two measures.
+
+## Main results
+
+* `measure_theory.measure.prod_apply` states `μ.prod ν s = ∫⁻ x, ν {y | (x, y) ∈ s} ∂μ`
+  for measurable `s`. `measure_theory.measure.prod_apply_symm` is the reversed version.
+* `measure_theory.measure.prod_prod` states `μ.prod ν (s ×ˢ t) = μ s * ν t` for measurable sets
+  `s` and `t`.
+* `measure_theory.lintegral_prod`: Tonelli's theorem. It states that for a measurable function
+  `α × β → ℝ≥0∞` we have `∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ`. The version
+  for functions `α → β → ℝ≥0∞` is reversed, and called `lintegral_lintegral`. Both versions have
+  a variant with `_symm` appended, where the order of integration is reversed.
+  The lemma `measurable.lintegral_prod_right'` states that the inner integral of the right-hand side
+  is measurable.
+
+## Implementation Notes
+
+Many results are proven twice, once for functions in curried form (`α → β → γ`) and one for
+functions in uncurried form (`α × β → γ`). The former often has an assumption
+`measurable (uncurry f)`, which could be inconvenient to discharge, but for the latter it is more
+common that the function has to be given explicitly, since Lean cannot synthesize the function by
+itself. We name the lemmas about the uncurried form with a prime.
+Tonelli's theorem has a different naming scheme, since the version for the uncurried version is
+reversed.
+
+## Tags
+
+product measure, Tonelli's theorem, Fubini-Tonelli theorem
+-/
+
+noncomputable theory
+open_locale classical topology ennreal measure_theory
+open set function real ennreal
+open measure_theory measurable_space measure_theory.measure
+open topological_space (hiding generate_from)
+open filter (hiding prod_eq map)
+
+variables {α α' β β' γ E : Type*}
+
+/-- Rectangles formed by π-systems form a π-system. -/
+lemma is_pi_system.prod {C : set (set α)} {D : set (set β)} (hC : is_pi_system C)
+  (hD : is_pi_system D) : is_pi_system (image2 (×ˢ) C D) :=
+begin
+  rintro _ ⟨s₁, t₁, hs₁, ht₁, rfl⟩ _ ⟨s₂, t₂, hs₂, ht₂, rfl⟩ hst,
+  rw [prod_inter_prod] at hst ⊢, rw [prod_nonempty_iff] at hst,
+  exact mem_image2_of_mem (hC _ hs₁ _ hs₂ hst.1) (hD _ ht₁ _ ht₂ hst.2)
+end
+
+/-- Rectangles of countably spanning sets are countably spanning. -/
+lemma is_countably_spanning.prod {C : set (set α)} {D : set (set β)}
+  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
+  is_countably_spanning (image2 (×ˢ) C D) :=
+begin
+  rcases ⟨hC, hD⟩ with ⟨⟨s, h1s, h2s⟩, t, h1t, h2t⟩,
+  refine ⟨λ n, (s n.unpair.1) ×ˢ (t n.unpair.2), λ n, mem_image2_of_mem (h1s _) (h1t _), _⟩,
+  rw [Union_unpair_prod, h2s, h2t, univ_prod_univ]
+end
+
+variables [measurable_space α] [measurable_space α'] [measurable_space β] [measurable_space β']
+variables [measurable_space γ]
+variables {μ μ' : measure α} {ν ν' : measure β} {τ : measure γ}
+variables [normed_add_comm_group E]
+
+/-! ### Measurability
+
+Before we define the product measure, we can talk about the measurability of operations on binary
+functions. We show that if `f` is a binary measurable function, then the function that integrates
+along one of the variables (using either the Lebesgue or Bochner integral) is measurable.
+-/
+
+/-- The product of generated σ-algebras is the one generated by rectangles, if both generating sets
+  are countably spanning. -/
+lemma generate_from_prod_eq {α β} {C : set (set α)} {D : set (set β)}
+  (hC : is_countably_spanning C) (hD : is_countably_spanning D) :
+  @prod.measurable_space _ _ (generate_from C) (generate_from D) =
+    generate_from (image2 (×ˢ) C D) :=
+begin
+  apply le_antisymm,
+  { refine sup_le _ _; rw [comap_generate_from];
+      apply generate_from_le; rintro _ ⟨s, hs, rfl⟩,
+    { rcases hD with ⟨t, h1t, h2t⟩,
+      rw [← prod_univ, ← h2t, prod_Union],
+      apply measurable_set.Union,
+      intro n, apply measurable_set_generate_from,
+      exact ⟨s, t n, hs, h1t n, rfl⟩ },
+    { rcases hC with ⟨t, h1t, h2t⟩,
+      rw [← univ_prod, ← h2t, Union_prod_const],
+      apply measurable_set.Union,
+      rintro n, apply measurable_set_generate_from,
+      exact mem_image2_of_mem (h1t n) hs } },
+  { apply generate_from_le, rintro _ ⟨s, t, hs, ht, rfl⟩, rw [prod_eq],
+    apply (measurable_fst _).inter (measurable_snd _),
+    { exact measurable_set_generate_from hs },
+    { exact measurable_set_generate_from ht } }
+end
+
+/-- If `C` and `D` generate the σ-algebras on `α` resp. `β`, then rectangles formed by `C` and `D`
+  generate the σ-algebra on `α × β`. -/
+lemma generate_from_eq_prod {C : set (set α)} {D : set (set β)} (hC : generate_from C = ‹_›)
+  (hD : generate_from D = ‹_›) (h2C : is_countably_spanning C) (h2D : is_countably_spanning D) :
+    generate_from (image2 (×ˢ) C D) = prod.measurable_space :=
+by rw [← hC, ← hD, generate_from_prod_eq h2C h2D]
+
+/-- The product σ-algebra is generated from boxes, i.e. `s ×ˢ t` for sets `s : set α` and
+  `t : set β`. -/
+lemma generate_from_prod :
+  generate_from (image2 (×ˢ) {s : set α | measurable_set s} {t : set β | measurable_set t}) =
+  prod.measurable_space :=
+generate_from_eq_prod generate_from_measurable_set generate_from_measurable_set
+  is_countably_spanning_measurable_set is_countably_spanning_measurable_set
+
+/-- Rectangles form a π-system. -/
+lemma is_pi_system_prod :
+  is_pi_system (image2 (×ˢ) {s : set α | measurable_set s} {t : set β | measurable_set t}) :=
+is_pi_system_measurable_set.prod is_pi_system_measurable_set
+
+/-- If `ν` is a finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
+  a measurable function. `measurable_measure_prod_mk_left` is strictly more general. -/
+lemma measurable_measure_prod_mk_left_finite [is_finite_measure ν] {s : set (α × β)}
+  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
+begin
+  refine induction_on_inter generate_from_prod.symm is_pi_system_prod _ _ _ _ hs,
+  { simp [measurable_zero, const_def] },
+  { rintro _ ⟨s, t, hs, ht, rfl⟩, simp only [mk_preimage_prod_right_eq_if, measure_if],
+    exact measurable_const.indicator hs },
+  { intros t ht h2t,
+    simp_rw [preimage_compl, measure_compl (measurable_prod_mk_left ht) (measure_ne_top ν _)],
+    exact h2t.const_sub _ },
+  { intros f h1f h2f h3f, simp_rw [preimage_Union],
+    have : ∀ b, ν (⋃ i, prod.mk b ⁻¹' f i) = ∑' i, ν (prod.mk b ⁻¹' f i) :=
+      λ b, measure_Union (λ i j hij, disjoint.preimage _ (h1f hij))
+        (λ i, measurable_prod_mk_left (h2f i)),
+    simp_rw [this], apply measurable.ennreal_tsum h3f },
+end
+
+/-- If `ν` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `x ↦ ν { y | (x, y) ∈ s }` is
+  a measurable function. -/
+lemma measurable_measure_prod_mk_left [sigma_finite ν] {s : set (α × β)}
+  (hs : measurable_set s) : measurable (λ x, ν (prod.mk x ⁻¹' s)) :=
+begin
+  have : ∀ x, measurable_set (prod.mk x ⁻¹' s) := λ x, measurable_prod_mk_left hs,
+  simp only [← @supr_restrict_spanning_sets _ _ ν, this],
+  apply measurable_supr, intro i,
+  haveI := fact.mk (measure_spanning_sets_lt_top ν i),
+  exact measurable_measure_prod_mk_left_finite hs
+end
+
+/-- If `μ` is a σ-finite measure, and `s ⊆ α × β` is measurable, then `y ↦ μ { x | (x, y) ∈ s }` is
+  a measurable function. -/
+lemma measurable_measure_prod_mk_right {μ : measure α} [sigma_finite μ] {s : set (α × β)}
+  (hs : measurable_set s) : measurable (λ y, μ ((λ x, (x, y)) ⁻¹' s)) :=
+measurable_measure_prod_mk_left (measurable_set_swap_iff.mpr hs)
+
+lemma measurable.map_prod_mk_left [sigma_finite ν] : measurable (λ x : α, map (prod.mk x) ν) :=
+begin
+  apply measurable_of_measurable_coe, intros s hs,
+  simp_rw [map_apply measurable_prod_mk_left hs],
+  exact measurable_measure_prod_mk_left hs
+end
+
+lemma measurable.map_prod_mk_right {μ : measure α} [sigma_finite μ] :
+  measurable (λ y : β, map (λ x : α, (x, y)) μ) :=
+begin
+  apply measurable_of_measurable_coe, intros s hs,
+  simp_rw [map_apply measurable_prod_mk_right hs],
+  exact measurable_measure_prod_mk_right hs
+end
+
+lemma measurable_embedding.prod_mk {α β γ δ : Type*} {mα : measurable_space α}
+  {mβ : measurable_space β} {mγ : measurable_space γ} {mδ : measurable_space δ}
+  {f : α → β} {g : γ → δ} (hg : measurable_embedding g) (hf : measurable_embedding f) :
+  measurable_embedding (λ x : γ × α, (g x.1, f x.2)) :=
+begin
+  have h_inj : function.injective (λ x : γ × α, (g x.fst, f x.snd)),
+  { intros x y hxy,
+    rw [← @prod.mk.eta _ _ x, ← @prod.mk.eta _ _ y],
+    simp only [prod.mk.inj_iff] at hxy ⊢,
+    exact ⟨hg.injective hxy.1, hf.injective hxy.2⟩, },
+  refine ⟨h_inj, _, _⟩,
+  { exact (hg.measurable.comp measurable_fst).prod_mk (hf.measurable.comp measurable_snd), },
+  { -- Induction using the π-system of rectangles
+    refine λ s hs, @measurable_space.induction_on_inter _
+      (λ s, measurable_set ((λ (x : γ × α), (g x.fst, f x.snd)) '' s)) _ _ generate_from_prod.symm
+      is_pi_system_prod _ _ _ _ _ hs,
+    { simp only [set.image_empty, measurable_set.empty], },
+    { rintros t ⟨t₁, t₂, ht₁, ht₂, rfl⟩,
+      rw ← set.prod_image_image_eq,
+      exact (hg.measurable_set_image.mpr ht₁).prod (hf.measurable_set_image.mpr ht₂), },
+    { intros t ht ht_m,
+      rw [← set.range_diff_image h_inj, ← set.prod_range_range_eq],
+      exact measurable_set.diff
+        (measurable_set.prod hg.measurable_set_range hf.measurable_set_range) ht_m, },
+    { intros g hg_disj hg_meas hg,
+      simp_rw set.image_Union,
+      exact measurable_set.Union hg, }, },
+end
+
+/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
+  Tonelli's theorem is measurable. -/
+lemma measurable.lintegral_prod_right' [sigma_finite ν] :
+  ∀ {f : α × β → ℝ≥0∞} (hf : measurable f), measurable (λ x, ∫⁻ y, f (x, y) ∂ν) :=
+begin
+  have m := @measurable_prod_mk_left,
+  refine measurable.ennreal_induction _ _ _,
+  { intros c s hs, simp only [← indicator_comp_right],
+    suffices : measurable (λ x, c * ν (prod.mk x ⁻¹' s)),
+    { simpa [lintegral_indicator _ (m hs)] },
+    exact (measurable_measure_prod_mk_left hs).const_mul _ },
+  { rintro f g - hf hg h2f h2g, simp_rw [pi.add_apply, lintegral_add_left (hf.comp m)],
+    exact h2f.add h2g },
+  { intros f hf h2f h3f,
+    have := measurable_supr h3f,
+    have : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
+    simpa [lintegral_supr (λ n, (hf n).comp m), this] }
+end
+
+/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
+  Tonelli's theorem is measurable.
+  This version has the argument `f` in curried form. -/
+lemma measurable.lintegral_prod_right [sigma_finite ν] {f : α → β → ℝ≥0∞}
+  (hf : measurable (uncurry f)) : measurable (λ x, ∫⁻ y, f x y ∂ν) :=
+hf.lintegral_prod_right'
+
+/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
+  the symmetric version of Tonelli's theorem is measurable. -/
+lemma measurable.lintegral_prod_left' [sigma_finite μ] {f : α × β → ℝ≥0∞}
+  (hf : measurable f) : measurable (λ y, ∫⁻ x, f (x, y) ∂μ) :=
+(measurable_swap_iff.mpr hf).lintegral_prod_right'
+
+/-- The Lebesgue integral is measurable. This shows that the integrand of (the right-hand-side of)
+  the symmetric version of Tonelli's theorem is measurable.
+  This version has the argument `f` in curried form. -/
+lemma measurable.lintegral_prod_left [sigma_finite μ] {f : α → β → ℝ≥0∞}
+  (hf : measurable (uncurry f)) : measurable (λ y, ∫⁻ x, f x y ∂μ) :=
+hf.lintegral_prod_left'
+
+/-! ### The product measure -/
+
+namespace measure_theory
+
+namespace measure
+
+/-- The binary product of measures. They are defined for arbitrary measures, but we basically
+  prove all properties under the assumption that at least one of them is σ-finite. -/
+@[irreducible] protected def prod (μ : measure α) (ν : measure β) : measure (α × β) :=
+bind μ $ λ x : α, map (prod.mk x) ν
+
+instance prod.measure_space {α β} [measure_space α] [measure_space β] : measure_space (α × β) :=
+{ volume := volume.prod volume }
+
+variables [sigma_finite ν]
+
+lemma volume_eq_prod (α β) [measure_space α] [measure_space β] :
+  (volume : measure (α × β)) = (volume : measure α).prod (volume : measure β) :=
+rfl
+
+lemma prod_apply {s : set (α × β)} (hs : measurable_set s) :
+  μ.prod ν s = ∫⁻ x, ν (prod.mk x ⁻¹' s) ∂μ :=
+by simp_rw [measure.prod, bind_apply hs measurable.map_prod_mk_left,
+  map_apply measurable_prod_mk_left hs]
+
+/-- The product measure of the product of two sets is the product of their measures. Note that we
+do not need the sets to be measurable. -/
+@[simp] lemma prod_prod (s : set α) (t : set β) : μ.prod ν (s ×ˢ t) = μ s * ν t :=
+begin
+  apply le_antisymm,
+  { set ST := (to_measurable μ s) ×ˢ (to_measurable ν t),
+    have hSTm : measurable_set ST :=
+      (measurable_set_to_measurable _ _).prod (measurable_set_to_measurable _ _),
+    calc μ.prod ν (s ×ˢ t) ≤ μ.prod ν ST :
+      measure_mono $ set.prod_mono (subset_to_measurable _ _) (subset_to_measurable _ _)
+    ... = μ (to_measurable μ s) * ν (to_measurable ν t) :
+      by simp_rw [prod_apply hSTm, mk_preimage_prod_right_eq_if, measure_if,
+        lintegral_indicator _ (measurable_set_to_measurable _ _), lintegral_const,
+        restrict_apply_univ, mul_comm]
+    ... = μ s * ν t : by rw [measure_to_measurable, measure_to_measurable] },
+  { /- Formalization is based on https://mathoverflow.net/a/254134/136589 -/
+    set ST := to_measurable (μ.prod ν) (s ×ˢ t),
+    have hSTm : measurable_set ST := measurable_set_to_measurable _ _,
+    have hST : s ×ˢ t ⊆ ST := subset_to_measurable _ _,
+    set f : α → ℝ≥0∞ := λ x, ν (prod.mk x ⁻¹' ST),
+    have hfm : measurable f := measurable_measure_prod_mk_left hSTm,
+    set s' : set α := {x | ν t ≤ f x},
+    have hss' : s ⊆ s' := λ x hx, measure_mono (λ y hy, hST $ mk_mem_prod hx hy),
+    calc μ s * ν t ≤ μ s' * ν t : mul_le_mul_right' (measure_mono hss') _
+    ... = ∫⁻ x in s', ν t ∂μ    : by rw [set_lintegral_const, mul_comm]
+    ... ≤ ∫⁻ x in s', f x ∂μ    : set_lintegral_mono measurable_const hfm (λ x, id)
+    ... ≤ ∫⁻ x, f x ∂μ          : lintegral_mono' restrict_le_self le_rfl
+    ... = μ.prod ν ST           : (prod_apply hSTm).symm
+    ... = μ.prod ν (s ×ˢ t)     : measure_to_measurable _ }
+end
+
+instance {X Y : Type*} [topological_space X] [topological_space Y]
+  {m : measurable_space X} {μ : measure X} [is_open_pos_measure μ]
+  {m' : measurable_space Y} {ν : measure Y} [is_open_pos_measure ν] [sigma_finite ν] :
+  is_open_pos_measure (μ.prod ν) :=
+begin
+  constructor,
+  rintros U U_open ⟨⟨x, y⟩, hxy⟩,
+  rcases is_open_prod_iff.1 U_open x y hxy with ⟨u, v, u_open, v_open, xu, yv, huv⟩,
+  refine ne_of_gt (lt_of_lt_of_le _ (measure_mono huv)),
+  simp only [prod_prod, canonically_ordered_comm_semiring.mul_pos],
+  split,
+  { exact u_open.measure_pos μ ⟨x, xu⟩ },
+  { exact v_open.measure_pos ν ⟨y, yv⟩ }
+end
+
+instance {α β : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+  (μ : measure α) (ν : measure β) [is_finite_measure μ] [is_finite_measure ν] :
+  is_finite_measure (μ.prod ν) :=
+begin
+  constructor,
+  rw [← univ_prod_univ, prod_prod],
+  exact mul_lt_top (measure_lt_top _ _).ne (measure_lt_top _ _).ne,
+end
+
+instance {α β : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+  (μ : measure α) (ν : measure β) [is_probability_measure μ] [is_probability_measure ν] :
+  is_probability_measure (μ.prod ν) :=
+⟨by rw [← univ_prod_univ, prod_prod, measure_univ, measure_univ, mul_one]⟩
+
+instance {α β : Type*} [topological_space α] [topological_space β]
+  {mα : measurable_space α} {mβ : measurable_space β} (μ : measure α) (ν : measure β)
+  [is_finite_measure_on_compacts μ] [is_finite_measure_on_compacts ν] [sigma_finite ν] :
+  is_finite_measure_on_compacts (μ.prod ν) :=
+begin
+  refine ⟨λ K hK, _⟩,
+  set L := (prod.fst '' K) ×ˢ (prod.snd '' K) with hL,
+  have : K ⊆ L,
+  { rintros ⟨x, y⟩ hxy,
+    simp only [prod_mk_mem_set_prod_eq, mem_image, prod.exists, exists_and_distrib_right,
+      exists_eq_right],
+    exact ⟨⟨y, hxy⟩, ⟨x, hxy⟩⟩ },
+  apply lt_of_le_of_lt (measure_mono this),
+  rw [hL, prod_prod],
+  exact mul_lt_top ((is_compact.measure_lt_top ((hK.image continuous_fst))).ne)
+                   ((is_compact.measure_lt_top ((hK.image continuous_snd))).ne)
+end
+
+lemma ae_measure_lt_top {s : set (α × β)} (hs : measurable_set s)
+  (h2s : (μ.prod ν) s ≠ ∞) : ∀ᵐ x ∂μ, ν (prod.mk x ⁻¹' s) < ∞ :=
+by { simp_rw [prod_apply hs] at h2s, refine ae_lt_top (measurable_measure_prod_mk_left hs) h2s }
+
+/-- Note: the assumption `hs` cannot be dropped. For a counterexample, see
+  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
+lemma measure_prod_null {s : set (α × β)}
+  (hs : measurable_set s) : μ.prod ν s = 0 ↔ (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
+by simp_rw [prod_apply hs, lintegral_eq_zero_iff (measurable_measure_prod_mk_left hs)]
+
+/-- Note: the converse is not true without assuming that `s` is measurable. For a counterexample,
+  see Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
+lemma measure_ae_null_of_prod_null {s : set (α × β)}
+  (h : μ.prod ν s = 0) : (λ x, ν (prod.mk x ⁻¹' s)) =ᵐ[μ] 0 :=
+begin
+  obtain ⟨t, hst, mt, ht⟩ := exists_measurable_superset_of_null h,
+  simp_rw [measure_prod_null mt] at ht,
+  rw [eventually_le_antisymm_iff],
+  exact ⟨eventually_le.trans_eq
+    (eventually_of_forall $ λ x, (measure_mono (preimage_mono hst) : _)) ht,
+    eventually_of_forall $ λ x, zero_le _⟩
+end
+
+lemma absolutely_continuous.prod [sigma_finite ν'] (h1 : μ ≪ μ') (h2 : ν ≪ ν') :
+  μ.prod ν ≪ μ'.prod ν' :=
+begin
+  refine absolutely_continuous.mk (λ s hs h2s, _),
+  simp_rw [measure_prod_null hs] at h2s ⊢,
+  exact (h2s.filter_mono h1.ae_le).mono (λ _ h, h2 h)
+end
+
+/-- Note: the converse is not true. For a counterexample, see
+  Walter Rudin *Real and Complex Analysis*, example (c) in section 8.9. -/
+lemma ae_ae_of_ae_prod {p : α × β → Prop} (h : ∀ᵐ z ∂μ.prod ν, p z) :
+  ∀ᵐ x ∂ μ, ∀ᵐ y ∂ ν, p (x, y) :=
+measure_ae_null_of_prod_null h
+
+/-- `μ.prod ν` has finite spanning sets in rectangles of finite spanning sets. -/
+noncomputable! def finite_spanning_sets_in.prod {ν : measure β} {C : set (set α)} {D : set (set β)}
+  (hμ : μ.finite_spanning_sets_in C) (hν : ν.finite_spanning_sets_in D) :
+  (μ.prod ν).finite_spanning_sets_in (image2 (×ˢ) C D) :=
+begin
+  haveI := hν.sigma_finite,
+  refine ⟨λ n, hμ.set n.unpair.1 ×ˢ hν.set n.unpair.2,
+    λ n, mem_image2_of_mem (hμ.set_mem _) (hν.set_mem _), λ n, _, _⟩,
+  { rw [prod_prod],
+    exact mul_lt_top (hμ.finite _).ne (hν.finite _).ne },
+  { simp_rw [Union_unpair_prod, hμ.spanning, hν.spanning, univ_prod_univ] }
+end
+
+lemma quasi_measure_preserving_fst : quasi_measure_preserving prod.fst (μ.prod ν) μ :=
+begin
+  refine ⟨measurable_fst, absolutely_continuous.mk (λ s hs h2s, _)⟩,
+  rw [map_apply measurable_fst hs, ← prod_univ, prod_prod, h2s, zero_mul],
+end
+
+lemma quasi_measure_preserving_snd : quasi_measure_preserving prod.snd (μ.prod ν) ν :=
+begin
+  refine ⟨measurable_snd, absolutely_continuous.mk (λ s hs h2s, _)⟩,
+  rw [map_apply measurable_snd hs, ← univ_prod, prod_prod, h2s, mul_zero]
+end
+
+variables [sigma_finite μ]
+
+instance prod.sigma_finite : sigma_finite (μ.prod ν) :=
+(μ.to_finite_spanning_sets_in.prod ν.to_finite_spanning_sets_in).sigma_finite
+
+/-- A measure on a product space equals the product measure if they are equal on rectangles
+  with as sides sets that generate the corresponding σ-algebras. -/
+lemma prod_eq_generate_from {μ : measure α} {ν : measure β} {C : set (set α)}
+  {D : set (set β)} (hC : generate_from C = ‹_›)
+  (hD : generate_from D = ‹_›) (h2C : is_pi_system C) (h2D : is_pi_system D)
+  (h3C : μ.finite_spanning_sets_in C) (h3D : ν.finite_spanning_sets_in D)
+  {μν : measure (α × β)}
+  (h₁ : ∀ (s ∈ C) (t ∈ D), μν (s ×ˢ t) = μ s * ν t) : μ.prod ν = μν :=
+begin
+  refine (h3C.prod h3D).ext
+    (generate_from_eq_prod hC hD h3C.is_countably_spanning h3D.is_countably_spanning).symm
+    (h2C.prod h2D) _,
+  { rintro _ ⟨s, t, hs, ht, rfl⟩, haveI := h3D.sigma_finite,
+    rw [h₁ s hs t ht, prod_prod] }
+end
+
+/-- A measure on a product space equals the product measure if they are equal on rectangles. -/
+lemma prod_eq {μν : measure (α × β)}
+  (h : ∀ s t, measurable_set s → measurable_set t → μν (s ×ˢ t) = μ s * ν t) : μ.prod ν = μν :=
+prod_eq_generate_from generate_from_measurable_set generate_from_measurable_set
+  is_pi_system_measurable_set is_pi_system_measurable_set
+  μ.to_finite_spanning_sets_in ν.to_finite_spanning_sets_in (λ s hs t ht, h s t hs ht)
+
+lemma prod_swap : map prod.swap (μ.prod ν) = ν.prod μ :=
+begin
+  refine (prod_eq _).symm,
+  intros s t hs ht,
+  simp_rw [map_apply measurable_swap (hs.prod ht), preimage_swap_prod, prod_prod, mul_comm]
+end
+
+lemma measure_preserving_swap : measure_preserving prod.swap (μ.prod ν) (ν.prod μ) :=
+⟨measurable_swap, prod_swap⟩
+
+lemma prod_apply_symm {s : set (α × β)} (hs : measurable_set s) :
+  μ.prod ν s = ∫⁻ y, μ ((λ x, (x, y)) ⁻¹' s) ∂ν :=
+by { rw [← prod_swap, map_apply measurable_swap hs],
+     simp only [prod_apply (measurable_swap hs)], refl }
+
+lemma prod_assoc_prod [sigma_finite τ] :
+  map measurable_equiv.prod_assoc ((μ.prod ν).prod τ) = μ.prod (ν.prod τ) :=
+begin
+  refine (prod_eq_generate_from generate_from_measurable_set generate_from_prod
+    is_pi_system_measurable_set is_pi_system_prod μ.to_finite_spanning_sets_in
+    (ν.to_finite_spanning_sets_in.prod τ.to_finite_spanning_sets_in) _).symm,
+  rintro s hs _ ⟨t, u, ht, hu, rfl⟩, rw [mem_set_of_eq] at hs ht hu,
+  simp_rw [map_apply (measurable_equiv.measurable _) (hs.prod (ht.prod hu)),
+    measurable_equiv.prod_assoc, measurable_equiv.coe_mk, equiv.prod_assoc_preimage,
+    prod_prod, mul_assoc]
+end
+
+/-! ### The product of specific measures -/
+
+lemma prod_restrict (s : set α) (t : set β) :
+  (μ.restrict s).prod (ν.restrict t) = (μ.prod ν).restrict (s ×ˢ t) :=
+begin
+  refine prod_eq (λ s' t' hs' ht', _),
+  rw [restrict_apply (hs'.prod ht'), prod_inter_prod, prod_prod, restrict_apply hs',
+    restrict_apply ht']
+end
+
+lemma restrict_prod_eq_prod_univ (s : set α) :
+  (μ.restrict s).prod ν = (μ.prod ν).restrict (s ×ˢ (univ : set β)) :=
+begin
+  have : ν = ν.restrict set.univ := measure.restrict_univ.symm,
+  rwa [this, measure.prod_restrict, ← this],
+end
+
+lemma prod_dirac (y : β) : μ.prod (dirac y) = map (λ x, (x, y)) μ :=
+begin
+  refine prod_eq (λ s t hs ht, _),
+  simp_rw [map_apply measurable_prod_mk_right (hs.prod ht), mk_preimage_prod_left_eq_if, measure_if,
+    dirac_apply' _ ht, ← indicator_mul_right _ (λ x, μ s), pi.one_apply, mul_one]
+end
+
+lemma dirac_prod (x : α) : (dirac x).prod ν = map (prod.mk x) ν :=
+begin
+  refine prod_eq (λ s t hs ht, _),
+  simp_rw [map_apply measurable_prod_mk_left (hs.prod ht), mk_preimage_prod_right_eq_if, measure_if,
+    dirac_apply' _ hs, ← indicator_mul_left _ _ (λ x, ν t), pi.one_apply, one_mul]
+end
+
+lemma dirac_prod_dirac {x : α} {y : β} : (dirac x).prod (dirac y) = dirac (x, y) :=
+by rw [prod_dirac, map_dirac measurable_prod_mk_right]
+
+lemma prod_sum {ι : Type*} [finite ι] (ν : ι → measure β) [∀ i, sigma_finite (ν i)] :
+  μ.prod (sum ν) = sum (λ i, μ.prod (ν i)) :=
+begin
+  refine prod_eq (λ s t hs ht, _),
+  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ ht, prod_prod, ennreal.tsum_mul_left]
+end
+
+lemma sum_prod {ι : Type*} [finite ι] (μ : ι → measure α) [∀ i, sigma_finite (μ i)] :
+  (sum μ).prod ν = sum (λ i, (μ i).prod ν) :=
+begin
+  refine prod_eq (λ s t hs ht, _),
+  simp_rw [sum_apply _ (hs.prod ht), sum_apply _ hs, prod_prod, ennreal.tsum_mul_right]
+end
+
+lemma prod_add (ν' : measure β) [sigma_finite ν'] : μ.prod (ν + ν') = μ.prod ν + μ.prod ν' :=
+by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, left_distrib] }
+
+lemma add_prod (μ' : measure α) [sigma_finite μ'] : (μ + μ').prod ν = μ.prod ν + μ'.prod ν :=
+by { refine prod_eq (λ s t hs ht, _), simp_rw [add_apply, prod_prod, right_distrib] }
+
+@[simp] lemma zero_prod (ν : measure β) : (0 : measure α).prod ν = 0 :=
+by { rw measure.prod, exact bind_zero_left _ }
+
+@[simp] lemma prod_zero (μ : measure α) : μ.prod (0 : measure β) = 0 :=
+by simp [measure.prod]
+
+lemma map_prod_map {δ} [measurable_space δ] {f : α → β} {g : γ → δ}
+  {μa : measure α} {μc : measure γ} (hfa : sigma_finite (map f μa))
+  (hgc : sigma_finite (map g μc)) (hf : measurable f) (hg : measurable g) :
+  (map f μa).prod (map g μc) = map (prod.map f g) (μa.prod μc) :=
+begin
+  haveI := hgc.of_map μc hg.ae_measurable,
+  refine prod_eq (λ s t hs ht, _),
+  rw [map_apply (hf.prod_map hg) (hs.prod ht), map_apply hf hs, map_apply hg ht],
+  exact prod_prod (f ⁻¹' s) (g ⁻¹' t)
+end
+
+end measure
+
+open measure
+
+namespace measure_preserving
+
+variables {δ : Type*} [measurable_space δ] {μa : measure α} {μb : measure β}
+  {μc : measure γ} {μd : measure δ}
+
+lemma skew_product [sigma_finite μb] [sigma_finite μd]
+  {f : α → β} (hf : measure_preserving f μa μb) {g : α → γ → δ}
+  (hgm : measurable (uncurry g)) (hg : ∀ᵐ x ∂μa, map (g x) μc = μd) :
+  measure_preserving (λ p : α × γ, (f p.1, g p.1 p.2)) (μa.prod μc) (μb.prod μd) :=
+begin
+  classical,
+  have : measurable (λ p : α × γ, (f p.1, g p.1 p.2)) := (hf.1.comp measurable_fst).prod_mk hgm,
+  /- if `μa = 0`, then the lemma is trivial, otherwise we can use `hg`
+  to deduce `sigma_finite μc`. -/
+  rcases eq_or_ne μa 0 with (rfl|ha),
+  { rw [← hf.map_eq, zero_prod, measure.map_zero, zero_prod],
+    exact ⟨this, by simp only [measure.map_zero]⟩ },
+  haveI : sigma_finite μc,
+  { rcases (ae_ne_bot.2 ha).nonempty_of_mem hg with ⟨x, hx : map (g x) μc = μd⟩,
+    exact sigma_finite.of_map _ hgm.of_uncurry_left.ae_measurable (by rwa hx) },
+  -- Thus we can apply `measure.prod_eq` to prove equality of measures.
+  refine ⟨this, (prod_eq $ λ s t hs ht, _).symm⟩,
+  rw [map_apply this (hs.prod ht)],
+  refine (prod_apply (this $ hs.prod ht)).trans _,
+  have : ∀ᵐ x ∂μa, μc ((λ y, (f x, g x y)) ⁻¹' s ×ˢ t) = indicator (f ⁻¹' s) (λ y, μd t) x,
+  { refine hg.mono (λ x hx, _), unfreezingI { subst hx },
+    simp only [mk_preimage_prod_right_fn_eq_if, indicator_apply, mem_preimage],
+    split_ifs,
+    exacts [(map_apply hgm.of_uncurry_left ht).symm, measure_empty] },
+  simp only [preimage_preimage],
+  rw [lintegral_congr_ae this, lintegral_indicator _ (hf.1 hs),
+    set_lintegral_const, hf.measure_preimage hs, mul_comm]
+end
+
+/-- If `f : α → β` sends the measure `μa` to `μb` and `g : γ → δ` sends the measure `μc` to `μd`,
+then `prod.map f g` sends `μa.prod μc` to `μb.prod μd`. -/
+protected lemma prod [sigma_finite μb] [sigma_finite μd] {f : α → β} {g : γ → δ}
+  (hf : measure_preserving f μa μb) (hg : measure_preserving g μc μd) :
+  measure_preserving (prod.map f g) (μa.prod μc) (μb.prod μd) :=
+have measurable (uncurry $ λ _ : α, g), from (hg.1.comp measurable_snd),
+hf.skew_product this $ filter.eventually_of_forall $ λ _, hg.map_eq
+
+end measure_preserving
+
+namespace quasi_measure_preserving
+
+lemma prod_of_right {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
+  (hf : measurable f) [sigma_finite ν]
+  (h2f : ∀ᵐ x ∂μ, quasi_measure_preserving (λ y, f (x, y)) ν τ) :
+  quasi_measure_preserving f (μ.prod ν) τ :=
+begin
+  refine ⟨hf, _⟩,
+  refine absolutely_continuous.mk (λ s hs h2s, _),
+  simp_rw [map_apply hf hs, prod_apply (hf hs), preimage_preimage,
+    lintegral_congr_ae (h2f.mono (λ x hx, hx.preimage_null h2s)), lintegral_zero],
+end
+
+lemma prod_of_left {α β γ} [measurable_space α] [measurable_space β]
+  [measurable_space γ] {f : α × β → γ} {μ : measure α} {ν : measure β} {τ : measure γ}
+  (hf : measurable f) [sigma_finite μ] [sigma_finite ν]
+  (h2f : ∀ᵐ y ∂ν, quasi_measure_preserving (λ x, f (x, y)) μ τ) :
+  quasi_measure_preserving f (μ.prod ν) τ :=
+begin
+  rw [← prod_swap],
+  convert (quasi_measure_preserving.prod_of_right (hf.comp measurable_swap) h2f).comp
+    ((measurable_swap.measure_preserving (ν.prod μ)).symm measurable_equiv.prod_comm)
+    .quasi_measure_preserving,
+  ext ⟨x, y⟩, refl,
+end
+
+end quasi_measure_preserving
+
+end measure_theory
+
+open measure_theory.measure
+
+section
+
+lemma ae_measurable.prod_swap [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
+  (hf : ae_measurable f (ν.prod μ)) : ae_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
+by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }
+
+lemma ae_measurable.fst [sigma_finite ν] {f : α → γ}
+  (hf : ae_measurable f μ) : ae_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
+hf.comp_quasi_measure_preserving quasi_measure_preserving_fst
+
+lemma ae_measurable.snd [sigma_finite ν] {f : β → γ}
+  (hf : ae_measurable f ν) : ae_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
+hf.comp_quasi_measure_preserving quasi_measure_preserving_snd
+
+end
+
+namespace measure_theory
+
+/-! ### The Lebesgue integral on a product -/
+
+variables [sigma_finite ν]
+
+lemma lintegral_prod_swap [sigma_finite μ] (f : α × β → ℝ≥0∞)
+  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z.swap ∂(ν.prod μ) = ∫⁻ z, f z ∂(μ.prod ν) :=
+by { rw ← prod_swap at hf, rw [← lintegral_map' hf measurable_swap.ae_measurable, prod_swap] }
+
+/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued measurable functions on `α × β`,
+  the integral of `f` is equal to the iterated integral. -/
+lemma lintegral_prod_of_measurable :
+  ∀ (f : α × β → ℝ≥0∞) (hf : measurable f), ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
+begin
+  have m := @measurable_prod_mk_left,
+  refine measurable.ennreal_induction _ _ _,
+  { intros c s hs, simp only [← indicator_comp_right],
+    simp [lintegral_indicator, m hs, hs, lintegral_const_mul, measurable_measure_prod_mk_left hs,
+      prod_apply] },
+  { rintro f g - hf hg h2f h2g,
+    simp [lintegral_add_left, measurable.lintegral_prod_right', hf.comp m, hf, h2f, h2g] },
+  { intros f hf h2f h3f,
+    have kf : ∀ x n, measurable (λ y, f n (x, y)) := λ x n, (hf n).comp m,
+    have k2f : ∀ x, monotone (λ n y, f n (x, y)) := λ x i j hij y, h2f hij (x, y),
+    have lf : ∀ n, measurable (λ x, ∫⁻ y, f n (x, y) ∂ν) := λ n, (hf n).lintegral_prod_right',
+    have l2f : monotone (λ n x, ∫⁻ y, f n (x, y) ∂ν) := λ i j hij x, lintegral_mono (k2f x hij),
+    simp only [lintegral_supr hf h2f, lintegral_supr (kf _), k2f, lintegral_supr lf l2f, h3f] },
+end
+
+/-- **Tonelli's Theorem**: For `ℝ≥0∞`-valued almost everywhere measurable functions on `α × β`,
+  the integral of `f` is equal to the iterated integral. -/
+lemma lintegral_prod (f : α × β → ℝ≥0∞) (hf : ae_measurable f (μ.prod ν)) :
+  ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ :=
+begin
+  have A : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ z, hf.mk f z ∂(μ.prod ν) :=
+    lintegral_congr_ae hf.ae_eq_mk,
+  have B : ∫⁻ x, ∫⁻ y, f (x, y) ∂ν ∂μ = ∫⁻ x, ∫⁻ y, hf.mk f (x, y) ∂ν ∂μ,
+  { apply lintegral_congr_ae,
+    filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ ha using lintegral_congr_ae ha, },
+  rw [A, B, lintegral_prod_of_measurable _ hf.measurable_mk],
+  apply_instance
+end
+
+/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued almost everywhere measurable
+functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
+lemma lintegral_prod_symm [sigma_finite μ] (f : α × β → ℝ≥0∞)
+  (hf : ae_measurable f (μ.prod ν)) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
+by { simp_rw [← lintegral_prod_swap f hf], exact lintegral_prod _ hf.prod_swap }
+
+/-- The symmetric verion of Tonelli's Theorem: For `ℝ≥0∞`-valued measurable
+functions on `α × β`,  the integral of `f` is equal to the iterated integral, in reverse order. -/
+lemma lintegral_prod_symm' [sigma_finite μ] (f : α × β → ℝ≥0∞)
+  (hf : measurable f) : ∫⁻ z, f z ∂(μ.prod ν) = ∫⁻ y, ∫⁻ x, f (x, y) ∂μ ∂ν :=
+lintegral_prod_symm f hf.ae_measurable
+
+/-- The reversed version of **Tonelli's Theorem**. In this version `f` is in curried form, which
+makes it easier for the elaborator to figure out `f` automatically. -/
+lemma lintegral_lintegral ⦃f : α → β → ℝ≥0∞⦄
+  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
+  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.1 z.2 ∂(μ.prod ν) :=
+(lintegral_prod _ hf).symm
+
+/-- The reversed version of **Tonelli's Theorem** (symmetric version). In this version `f` is in
+curried form, which makes it easier for the elaborator to figure out `f` automatically. -/
+lemma lintegral_lintegral_symm [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
+  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
+  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ z, f z.2 z.1 ∂(ν.prod μ) :=
+(lintegral_prod_symm _ hf.prod_swap).symm
+
+/-- Change the order of Lebesgue integration. -/
+lemma lintegral_lintegral_swap [sigma_finite μ] ⦃f : α → β → ℝ≥0∞⦄
+  (hf : ae_measurable (uncurry f) (μ.prod ν)) :
+  ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ = ∫⁻ y, ∫⁻ x, f x y ∂μ ∂ν :=
+(lintegral_lintegral hf).trans (lintegral_prod_symm _ hf)
+
+lemma lintegral_prod_mul {f : α → ℝ≥0∞} {g : β → ℝ≥0∞}
+  (hf : ae_measurable f μ) (hg : ae_measurable g ν) :
+  ∫⁻ z, f z.1 * g z.2 ∂(μ.prod ν) = ∫⁻ x, f x ∂μ * ∫⁻ y, g y ∂ν :=
+by simp [lintegral_prod _ (hf.fst.mul hg.snd), lintegral_lintegral_mul hf hg]
+
+/-! ### Marginals of a measure defined on a product -/
+
+namespace measure
+
+variables {ρ : measure (α × β)}
+
+/-- Marginal measure on `α` obtained from a measure `ρ` on `α × β`, defined by `ρ.map prod.fst`. -/
+noncomputable
+def fst (ρ : measure (α × β)) : measure α := ρ.map prod.fst
+
+lemma fst_apply {s : set α} (hs : measurable_set s) : ρ.fst s = ρ (prod.fst ⁻¹' s) :=
+by rw [fst, measure.map_apply measurable_fst hs]
+
+lemma fst_univ : ρ.fst univ = ρ univ :=
+by rw [fst_apply measurable_set.univ, preimage_univ]
+
+instance [is_finite_measure ρ] : is_finite_measure ρ.fst := by { rw fst, apply_instance, }
+
+instance [is_probability_measure ρ] : is_probability_measure ρ.fst :=
+{ measure_univ := by { rw fst_univ, exact measure_univ, } }
+
+lemma fst_map_prod_mk₀ {X : α → β} {Y : α → γ} {μ : measure α}
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ) :
+  (μ.map (λ a, (X a, Y a))).fst = μ.map X :=
+begin
+  ext1 s hs,
+  rw [measure.fst_apply hs, measure.map_apply_of_ae_measurable (hX.prod_mk hY) (measurable_fst hs),
+    measure.map_apply_of_ae_measurable hX hs, ← prod_univ, mk_preimage_prod, preimage_univ,
+    inter_univ],
+end
+
+lemma fst_map_prod_mk {X : α → β} {Y : α → γ} {μ : measure α}
+  (hX : measurable X) (hY : measurable Y) :
+  (μ.map (λ a, (X a, Y a))).fst = μ.map X :=
+fst_map_prod_mk₀ hX.ae_measurable hY.ae_measurable
+
+/-- Marginal measure on `β` obtained from a measure on `ρ` `α × β`, defined by `ρ.map prod.snd`. -/
+noncomputable
+def snd (ρ : measure (α × β)) : measure β := ρ.map prod.snd
+
+lemma snd_apply {s : set β} (hs : measurable_set s) : ρ.snd s = ρ (prod.snd ⁻¹' s) :=
+by rw [snd, measure.map_apply measurable_snd hs]
+
+lemma snd_univ : ρ.snd univ = ρ univ :=
+by rw [snd_apply measurable_set.univ, preimage_univ]
+
+instance [is_finite_measure ρ] : is_finite_measure ρ.snd := by { rw snd, apply_instance, }
+
+instance [is_probability_measure ρ] : is_probability_measure ρ.snd :=
+{ measure_univ := by { rw snd_univ, exact measure_univ, } }
+
+lemma snd_map_prod_mk₀ {X : α → β} {Y : α → γ} {μ : measure α}
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ) :
+  (μ.map (λ a, (X a, Y a))).snd = μ.map Y :=
+begin
+  ext1 s hs,
+  rw [measure.snd_apply hs, measure.map_apply_of_ae_measurable (hX.prod_mk hY) (measurable_snd hs),
+    measure.map_apply_of_ae_measurable hY hs, ← univ_prod, mk_preimage_prod, preimage_univ,
+    univ_inter],
+end
+
+lemma snd_map_prod_mk {X : α → β} {Y : α → γ} {μ : measure α}
+  (hX : measurable X) (hY : measurable Y) :
+  (μ.map (λ a, (X a, Y a))).snd = μ.map Y :=
+snd_map_prod_mk₀ hX.ae_measurable hY.ae_measurable
+
+end measure
+
+
+end measure_theory
diff --git a/src/measure_theory/constructions/prod/integral.lean b/src/measure_theory/constructions/prod/integral.lean
new file mode 100644
index 0000000000000..e92c1173627f9
--- /dev/null
+++ b/src/measure_theory/constructions/prod/integral.lean
@@ -0,0 +1,477 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import measure_theory.constructions.prod.basic
+import measure_theory.integral.set_integral
+
+/-!
+# Integration with respect to the product measure
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove Fubini's theorem.
+
+## Main results
+
+* `measure_theory.integrable_prod_iff` states that a binary function is integrable iff both
+  * `y ↦ f (x, y)` is integrable for almost every `x`, and
+  * the function `x ↦ ∫ ‖f (x, y)‖ dy` is integrable.
+* `measure_theory.integral_prod`: Fubini's theorem. It states that for a integrable function
+  `α × β → E` (where `E` is a second countable Banach space) we have
+  `∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ`. This theorem has the same variants as
+  Tonelli's theorem (see `measure_theory.lintegral_prod`). The lemma
+  `measure_theory.integrable.integral_prod_right` states that the inner integral of the right-hand
+  side is integrable.
+
+## Tags
+
+product measure, Fubini's theorem, Fubini-Tonelli theorem
+-/
+
+noncomputable theory
+open_locale classical topology ennreal measure_theory
+open set function real ennreal
+open measure_theory measurable_space measure_theory.measure
+open topological_space
+open filter (hiding prod_eq map)
+
+variables {α α' β β' γ E : Type*}
+
+variables [measurable_space α] [measurable_space α'] [measurable_space β] [measurable_space β']
+variables [measurable_space γ]
+variables {μ μ' : measure α} {ν ν' : measure β} {τ : measure γ}
+variables [normed_add_comm_group E]
+
+/-! ### Measurability
+
+Before we define the product measure, we can talk about the measurability of operations on binary
+functions. We show that if `f` is a binary measurable function, then the function that integrates
+along one of the variables (using either the Lebesgue or Bochner integral) is measurable.
+-/
+
+lemma measurable_set_integrable [sigma_finite ν] ⦃f : α → β → E⦄
+  (hf : strongly_measurable (uncurry f)) : measurable_set {x | integrable (f x) ν} :=
+begin
+  simp_rw [integrable, hf.of_uncurry_left.ae_strongly_measurable, true_and],
+  exact measurable_set_lt (measurable.lintegral_prod_right hf.ennnorm) measurable_const
+end
+
+section
+variables [normed_space ℝ E] [complete_space E]
+
+/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
+  Fubini's theorem is measurable.
+  This version has `f` in curried form. -/
+lemma measure_theory.strongly_measurable.integral_prod_right [sigma_finite ν] ⦃f : α → β → E⦄
+  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ x, ∫ y, f x y ∂ν) :=
+begin
+  borelize E,
+  haveI : separable_space (range (uncurry f) ∪ {0} : set E) :=
+    hf.separable_space_range_union_singleton,
+  let s : ℕ → simple_func (α × β) E := simple_func.approx_on _ hf.measurable
+    (range (uncurry f) ∪ {0}) 0 (by simp),
+  let s' : ℕ → α → simple_func β E := λ n x, (s n).comp (prod.mk x) measurable_prod_mk_left,
+  let f' : ℕ → α → E := λ n, {x | integrable (f x) ν}.indicator
+    (λ x, (s' n x).integral ν),
+  have hf' : ∀ n, strongly_measurable (f' n),
+  { intro n, refine strongly_measurable.indicator _ (measurable_set_integrable hf),
+    have : ∀ x, (s' n x).range.filter (λ x, x ≠ 0) ⊆ (s n).range,
+    { intros x, refine finset.subset.trans (finset.filter_subset _ _) _, intro y,
+      simp_rw [simple_func.mem_range], rintro ⟨z, rfl⟩, exact ⟨(x, z), rfl⟩ },
+    simp only [simple_func.integral_eq_sum_of_subset (this _)],
+    refine finset.strongly_measurable_sum _ (λ x _, _),
+    refine (measurable.ennreal_to_real _).strongly_measurable.smul_const _,
+    simp only [simple_func.coe_comp, preimage_comp] {single_pass := tt},
+    apply measurable_measure_prod_mk_left,
+    exact (s n).measurable_set_fiber x },
+  have h2f' : tendsto f' at_top (𝓝 (λ (x : α), ∫ (y : β), f x y ∂ν)),
+  { rw [tendsto_pi_nhds], intro x,
+    by_cases hfx : integrable (f x) ν,
+    { have : ∀ n, integrable (s' n x) ν,
+      { intro n, apply (hfx.norm.add hfx.norm).mono' (s' n x).ae_strongly_measurable,
+        apply eventually_of_forall, intro y,
+        simp_rw [s', simple_func.coe_comp], exact simple_func.norm_approx_on_zero_le _ _ (x, y) n },
+      simp only [f', hfx, simple_func.integral_eq_integral _ (this _), indicator_of_mem,
+        mem_set_of_eq],
+      refine tendsto_integral_of_dominated_convergence (λ y, ‖f x y‖ + ‖f x y‖)
+        (λ n, (s' n x).ae_strongly_measurable) (hfx.norm.add hfx.norm) _ _,
+      { exact λ n, eventually_of_forall (λ y, simple_func.norm_approx_on_zero_le _ _ (x, y) n) },
+      { refine eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ _),
+        apply subset_closure,
+        simp [-uncurry_apply_pair], } },
+    { simp [f', hfx, integral_undef], } },
+  exact strongly_measurable_of_tendsto _ hf' h2f'
+end
+
+/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
+  Fubini's theorem is measurable. -/
+lemma measure_theory.strongly_measurable.integral_prod_right' [sigma_finite ν] ⦃f : α × β → E⦄
+  (hf : strongly_measurable f) : strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) :=
+by { rw [← uncurry_curry f] at hf, exact hf.integral_prod_right }
+
+/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
+  the symmetric version of Fubini's theorem is measurable.
+  This version has `f` in curried form. -/
+lemma measure_theory.strongly_measurable.integral_prod_left [sigma_finite μ] ⦃f : α → β → E⦄
+  (hf : strongly_measurable (uncurry f)) : strongly_measurable (λ y, ∫ x, f x y ∂μ) :=
+(hf.comp_measurable measurable_swap).integral_prod_right'
+
+/-- The Bochner integral is measurable. This shows that the integrand of (the right-hand-side of)
+  the symmetric version of Fubini's theorem is measurable. -/
+lemma measure_theory.strongly_measurable.integral_prod_left' [sigma_finite μ] ⦃f : α × β → E⦄
+  (hf : strongly_measurable f) : strongly_measurable (λ y, ∫ x, f (x, y) ∂μ) :=
+(hf.comp_measurable measurable_swap).integral_prod_right'
+
+end
+
+/-! ### The product measure -/
+
+namespace measure_theory
+
+namespace measure
+
+variables [sigma_finite ν]
+
+lemma integrable_measure_prod_mk_left {s : set (α × β)}
+  (hs : measurable_set s) (h2s : (μ.prod ν) s ≠ ∞) :
+  integrable (λ x, (ν (prod.mk x ⁻¹' s)).to_real) μ :=
+begin
+  refine ⟨(measurable_measure_prod_mk_left hs).ennreal_to_real.ae_measurable.ae_strongly_measurable,
+    _⟩,
+  simp_rw [has_finite_integral, ennnorm_eq_of_real to_real_nonneg],
+  convert h2s.lt_top using 1, simp_rw [prod_apply hs], apply lintegral_congr_ae,
+  refine (ae_measure_lt_top hs h2s).mp _, apply eventually_of_forall, intros x hx,
+  rw [lt_top_iff_ne_top] at hx, simp [of_real_to_real, hx],
+end
+
+end measure
+
+open measure
+
+end measure_theory
+
+open measure_theory.measure
+
+section
+
+lemma measure_theory.ae_strongly_measurable.prod_swap
+  {γ : Type*} [topological_space γ] [sigma_finite μ] [sigma_finite ν] {f : β × α → γ}
+  (hf : ae_strongly_measurable f (ν.prod μ)) :
+  ae_strongly_measurable (λ (z : α × β), f z.swap) (μ.prod ν) :=
+by { rw ← prod_swap at hf, exact hf.comp_measurable measurable_swap }
+
+lemma measure_theory.ae_strongly_measurable.fst {γ} [topological_space γ] [sigma_finite ν]
+  {f : α → γ} (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ (z : α × β), f z.1) (μ.prod ν) :=
+hf.comp_quasi_measure_preserving quasi_measure_preserving_fst
+
+lemma measure_theory.ae_strongly_measurable.snd {γ} [topological_space γ] [sigma_finite ν]
+  {f : β → γ} (hf : ae_strongly_measurable f ν) :
+  ae_strongly_measurable (λ (z : α × β), f z.2) (μ.prod ν) :=
+hf.comp_quasi_measure_preserving quasi_measure_preserving_snd
+
+/-- The Bochner integral is a.e.-measurable.
+  This shows that the integrand of (the right-hand-side of) Fubini's theorem is a.e.-measurable. -/
+lemma measure_theory.ae_strongly_measurable.integral_prod_right' [sigma_finite ν]
+  [normed_space ℝ E] [complete_space E]
+  ⦃f : α × β → E⦄ (hf : ae_strongly_measurable f (μ.prod ν)) :
+  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂ν) μ :=
+⟨λ x, ∫ y, hf.mk f (x, y) ∂ν, hf.strongly_measurable_mk.integral_prod_right',
+  by { filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with _ hx using integral_congr_ae hx }⟩
+
+lemma measure_theory.ae_strongly_measurable.prod_mk_left
+  {γ : Type*} [sigma_finite ν] [topological_space γ] {f : α × β → γ}
+  (hf : ae_strongly_measurable f (μ.prod ν)) : ∀ᵐ x ∂μ, ae_strongly_measurable (λ y, f (x, y)) ν :=
+begin
+  filter_upwards [ae_ae_of_ae_prod hf.ae_eq_mk] with x hx,
+  exact ⟨λ y, hf.mk f (x, y), hf.strongly_measurable_mk.comp_measurable measurable_prod_mk_left, hx⟩
+end
+
+end
+
+namespace measure_theory
+
+variables [sigma_finite ν]
+
+/-! ### Integrability on a product -/
+section
+
+lemma integrable.swap [sigma_finite μ] ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : integrable (f ∘ prod.swap) (ν.prod μ) :=
+⟨hf.ae_strongly_measurable.prod_swap,
+  (lintegral_prod_swap _ hf.ae_strongly_measurable.ennnorm : _).le.trans_lt hf.has_finite_integral⟩
+
+lemma integrable_swap_iff [sigma_finite μ] ⦃f : α × β → E⦄ :
+  integrable (f ∘ prod.swap) (ν.prod μ) ↔ integrable f (μ.prod ν) :=
+⟨λ hf, by { convert hf.swap, ext ⟨x, y⟩, refl }, λ hf, hf.swap⟩
+
+lemma has_finite_integral_prod_iff ⦃f : α × β → E⦄ (h1f : strongly_measurable f) :
+  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
+    has_finite_integral (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
+begin
+  simp only [has_finite_integral, lintegral_prod_of_measurable _ h1f.ennnorm],
+  have : ∀ x, ∀ᵐ y ∂ν, 0 ≤ ‖f (x, y)‖ := λ x, eventually_of_forall (λ y, norm_nonneg _),
+  simp_rw [integral_eq_lintegral_of_nonneg_ae (this _)
+    (h1f.norm.comp_measurable measurable_prod_mk_left).ae_strongly_measurable,
+    ennnorm_eq_of_real to_real_nonneg, of_real_norm_eq_coe_nnnorm],
+  -- this fact is probably too specialized to be its own lemma
+  have : ∀ {p q r : Prop} (h1 : r → p), (r ↔ p ∧ q) ↔ (p → (r ↔ q)) :=
+  λ p q r h1, by rw [← and.congr_right_iff, and_iff_right_of_imp h1],
+  rw [this],
+  { intro h2f, rw lintegral_congr_ae,
+    refine h2f.mp _, apply eventually_of_forall, intros x hx, dsimp only,
+    rw [of_real_to_real], rw [← lt_top_iff_ne_top], exact hx },
+  { intro h2f, refine ae_lt_top _ h2f.ne, exact h1f.ennnorm.lintegral_prod_right' },
+end
+
+lemma has_finite_integral_prod_iff' ⦃f : α × β → E⦄ (h1f : ae_strongly_measurable f (μ.prod ν)) :
+  has_finite_integral f (μ.prod ν) ↔ (∀ᵐ x ∂ μ, has_finite_integral (λ y, f (x, y)) ν) ∧
+    has_finite_integral (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
+begin
+  rw [has_finite_integral_congr h1f.ae_eq_mk,
+    has_finite_integral_prod_iff h1f.strongly_measurable_mk],
+  apply and_congr,
+  { apply eventually_congr,
+    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm],
+    assume x hx,
+    exact has_finite_integral_congr hx },
+  { apply has_finite_integral_congr,
+    filter_upwards [ae_ae_of_ae_prod h1f.ae_eq_mk.symm] with _ hx
+      using integral_congr_ae (eventually_eq.fun_comp hx _), },
+  { apply_instance, },
+end
+
+/-- A binary function is integrable if the function `y ↦ f (x, y)` is integrable for almost every
+  `x` and the function `x ↦ ∫ ‖f (x, y)‖ dy` is integrable. -/
+lemma integrable_prod_iff ⦃f : α × β → E⦄ (h1f : ae_strongly_measurable f (μ.prod ν)) :
+  integrable f (μ.prod ν) ↔
+    (∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν) ∧ integrable (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
+by simp [integrable, h1f, has_finite_integral_prod_iff', h1f.norm.integral_prod_right',
+         h1f.prod_mk_left]
+
+/-- A binary function is integrable if the function `x ↦ f (x, y)` is integrable for almost every
+  `y` and the function `y ↦ ∫ ‖f (x, y)‖ dx` is integrable. -/
+lemma integrable_prod_iff' [sigma_finite μ] ⦃f : α × β → E⦄
+  (h1f : ae_strongly_measurable f (μ.prod ν)) :
+  integrable f (μ.prod ν) ↔
+    (∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ) ∧ integrable (λ y, ∫ x, ‖f (x, y)‖ ∂μ) ν :=
+by { convert integrable_prod_iff (h1f.prod_swap) using 1, rw [integrable_swap_iff] }
+
+lemma integrable.prod_left_ae [sigma_finite μ] ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : ∀ᵐ y ∂ ν, integrable (λ x, f (x, y)) μ :=
+((integrable_prod_iff' hf.ae_strongly_measurable).mp hf).1
+
+lemma integrable.prod_right_ae [sigma_finite μ] ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : ∀ᵐ x ∂ μ, integrable (λ y, f (x, y)) ν :=
+hf.swap.prod_left_ae
+
+lemma integrable.integral_norm_prod_left ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, ‖f (x, y)‖ ∂ν) μ :=
+((integrable_prod_iff hf.ae_strongly_measurable).mp hf).2
+
+lemma integrable.integral_norm_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, ‖f (x, y)‖ ∂μ) ν :=
+hf.swap.integral_norm_prod_left
+
+lemma integrable_prod_mul {L : Type*} [is_R_or_C L]
+  {f : α → L} {g : β → L} (hf : integrable f μ) (hg : integrable g ν) :
+  integrable (λ (z : α × β), f z.1 * g z.2) (μ.prod ν) :=
+begin
+  refine (integrable_prod_iff _).2 ⟨_, _⟩,
+  { exact hf.1.fst.mul hg.1.snd },
+  { exact eventually_of_forall (λ x, hg.const_mul (f x)) },
+  { simpa only [norm_mul, integral_mul_left] using hf.norm.mul_const _ }
+end
+
+end
+
+variables [normed_space ℝ E] [complete_space E]
+
+lemma integrable.integral_prod_left ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : integrable (λ x, ∫ y, f (x, y) ∂ν) μ :=
+integrable.mono hf.integral_norm_prod_left hf.ae_strongly_measurable.integral_prod_right' $
+  eventually_of_forall $ λ x, (norm_integral_le_integral_norm _).trans_eq $
+  (norm_of_nonneg $ integral_nonneg_of_ae $ eventually_of_forall $
+  λ y, (norm_nonneg (f (x, y)) : _)).symm
+
+lemma integrable.integral_prod_right [sigma_finite μ] ⦃f : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) : integrable (λ y, ∫ x, f (x, y) ∂μ) ν :=
+hf.swap.integral_prod_left
+
+/-! ### The Bochner integral on a product -/
+
+variables [sigma_finite μ]
+
+lemma integral_prod_swap (f : α × β → E)
+  (hf : ae_strongly_measurable f (μ.prod ν)) : ∫ z, f z.swap ∂(ν.prod μ) = ∫ z, f z ∂(μ.prod ν) :=
+begin
+  rw ← prod_swap at hf,
+  rw [← integral_map measurable_swap.ae_measurable hf, prod_swap]
+end
+
+variables {E' : Type*} [normed_add_comm_group E'] [complete_space E'] [normed_space ℝ E']
+
+/-! Some rules about the sum/difference of double integrals. They follow from `integral_add`, but
+  we separate them out as separate lemmas, because they involve quite some steps. -/
+
+/-- Integrals commute with addition inside another integral. `F` can be any function. -/
+lemma integral_fn_integral_add ⦃f g : α × β → E⦄ (F : E → E')
+  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫ x, F (∫ y, f (x, y) + g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν + ∫ y, g (x, y) ∂ν) ∂μ :=
+begin
+  refine integral_congr_ae _,
+  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
+  simp [integral_add h2f h2g],
+end
+
+/-- Integrals commute with subtraction inside another integral.
+  `F` can be any measurable function. -/
+lemma integral_fn_integral_sub ⦃f g : α × β → E⦄ (F : E → E')
+  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
+begin
+  refine integral_congr_ae _,
+  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
+  simp [integral_sub h2f h2g],
+end
+
+/-- Integrals commute with subtraction inside a lower Lebesgue integral.
+  `F` can be any function. -/
+lemma lintegral_fn_integral_sub ⦃f g : α × β → E⦄
+  (F : E → ℝ≥0∞) (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫⁻ x, F (∫ y, f (x, y) - g (x, y) ∂ν) ∂μ = ∫⁻ x, F (∫ y, f (x, y) ∂ν - ∫ y, g (x, y) ∂ν) ∂μ :=
+begin
+  refine lintegral_congr_ae _,
+  filter_upwards [hf.prod_right_ae, hg.prod_right_ae] with _ h2f h2g,
+  simp [integral_sub h2f h2g],
+end
+
+/-- Double integrals commute with addition. -/
+lemma integral_integral_add ⦃f g : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫ x, ∫ y, f (x, y) + g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
+(integral_fn_integral_add id hf hg).trans $
+  integral_add hf.integral_prod_left hg.integral_prod_left
+
+/-- Double integrals commute with addition. This is the version with `(f + g) (x, y)`
+  (instead of `f (x, y) + g (x, y)`) in the LHS. -/
+lemma integral_integral_add' ⦃f g : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫ x, ∫ y, (f + g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ + ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
+integral_integral_add hf hg
+
+/-- Double integrals commute with subtraction. -/
+lemma integral_integral_sub ⦃f g : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫ x, ∫ y, f (x, y) - g (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
+(integral_fn_integral_sub id hf hg).trans $
+  integral_sub hf.integral_prod_left hg.integral_prod_left
+
+/-- Double integrals commute with subtraction. This is the version with `(f - g) (x, y)`
+  (instead of `f (x, y) - g (x, y)`) in the LHS. -/
+lemma integral_integral_sub' ⦃f g : α × β → E⦄
+  (hf : integrable f (μ.prod ν)) (hg : integrable g (μ.prod ν)) :
+  ∫ x, ∫ y, (f - g) (x, y) ∂ν ∂μ = ∫ x, ∫ y, f (x, y) ∂ν ∂μ - ∫ x, ∫ y, g (x, y) ∂ν ∂μ :=
+integral_integral_sub hf hg
+
+/-- The map that sends an L¹-function `f : α × β → E` to `∫∫f` is continuous. -/
+lemma continuous_integral_integral :
+  continuous (λ (f : α × β →₁[μ.prod ν] E), ∫ x, ∫ y, f (x, y) ∂ν ∂μ) :=
+begin
+  rw [continuous_iff_continuous_at], intro g,
+  refine tendsto_integral_of_L1 _ (L1.integrable_coe_fn g).integral_prod_left
+    (eventually_of_forall $ λ h, (L1.integrable_coe_fn h).integral_prod_left) _,
+  simp_rw [← lintegral_fn_integral_sub (λ x, (‖x‖₊ : ℝ≥0∞)) (L1.integrable_coe_fn _)
+    (L1.integrable_coe_fn g)],
+  refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds _ (λ i, zero_le _) _,
+  { exact λ i, ∫⁻ x, ∫⁻ y, ‖i (x, y) - g (x, y)‖₊ ∂ν ∂μ },
+  swap, { exact λ i, lintegral_mono (λ x, ennnorm_integral_le_lintegral_ennnorm _) },
+  show tendsto (λ (i : α × β →₁[μ.prod ν] E),
+    ∫⁻ x, ∫⁻ (y : β), ‖i (x, y) - g (x, y)‖₊ ∂ν ∂μ) (𝓝 g) (𝓝 0),
+  have : ∀ (i : α × β →₁[μ.prod ν] E), measurable (λ z, (‖i z - g z‖₊ : ℝ≥0∞)) :=
+  λ i, ((Lp.strongly_measurable i).sub (Lp.strongly_measurable g)).ennnorm,
+  simp_rw [← lintegral_prod_of_measurable _ (this _), ← L1.of_real_norm_sub_eq_lintegral,
+    ← of_real_zero],
+  refine (continuous_of_real.tendsto 0).comp _,
+  rw [← tendsto_iff_norm_tendsto_zero], exact tendsto_id
+end
+
+/-- **Fubini's Theorem**: For integrable functions on `α × β`,
+  the Bochner integral of `f` is equal to the iterated Bochner integral.
+  `integrable_prod_iff` can be useful to show that the function in question in integrable.
+  `measure_theory.integrable.integral_prod_right` is useful to show that the inner integral
+  of the right-hand side is integrable. -/
+lemma integral_prod : ∀ (f : α × β → E) (hf : integrable f (μ.prod ν)),
+  ∫ z, f z ∂(μ.prod ν) = ∫ x, ∫ y, f (x, y) ∂ν ∂μ :=
+begin
+  apply integrable.induction,
+  { intros c s hs h2s,
+    simp_rw [integral_indicator hs, ← indicator_comp_right,
+      function.comp, integral_indicator (measurable_prod_mk_left hs),
+      set_integral_const, integral_smul_const,
+      integral_to_real (measurable_measure_prod_mk_left hs).ae_measurable
+      (ae_measure_lt_top hs h2s.ne), prod_apply hs] },
+  { intros f g hfg i_f i_g hf hg,
+    simp_rw [integral_add' i_f i_g, integral_integral_add' i_f i_g, hf, hg] },
+  { exact is_closed_eq continuous_integral continuous_integral_integral },
+  { intros f g hfg i_f hf, convert hf using 1,
+    { exact integral_congr_ae hfg.symm },
+    { refine integral_congr_ae _,
+      refine (ae_ae_of_ae_prod hfg).mp _,
+      apply eventually_of_forall, intros x hfgx,
+      exact integral_congr_ae (ae_eq_symm hfgx) } }
+end
+
+/-- Symmetric version of **Fubini's Theorem**: For integrable functions on `α × β`,
+  the Bochner integral of `f` is equal to the iterated Bochner integral.
+  This version has the integrals on the right-hand side in the other order. -/
+lemma integral_prod_symm (f : α × β → E) (hf : integrable f (μ.prod ν)) :
+  ∫ z, f z ∂(μ.prod ν) = ∫ y, ∫ x, f (x, y) ∂μ ∂ν :=
+by { simp_rw [← integral_prod_swap f hf.ae_strongly_measurable], exact integral_prod _ hf.swap }
+
+/-- Reversed version of **Fubini's Theorem**. -/
+lemma integral_integral {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
+  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.1 z.2 ∂(μ.prod ν) :=
+(integral_prod _ hf).symm
+
+/-- Reversed version of **Fubini's Theorem** (symmetric version). -/
+lemma integral_integral_symm {f : α → β → E} (hf : integrable (uncurry f) (μ.prod ν)) :
+  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ z, f z.2 z.1 ∂(ν.prod μ) :=
+(integral_prod_symm _ hf.swap).symm
+
+/-- Change the order of Bochner integration. -/
+lemma integral_integral_swap ⦃f : α → β → E⦄ (hf : integrable (uncurry f) (μ.prod ν)) :
+  ∫ x, ∫ y, f x y ∂ν ∂μ = ∫ y, ∫ x, f x y ∂μ ∂ν :=
+(integral_integral hf).trans (integral_prod_symm _ hf)
+
+/-- **Fubini's Theorem** for set integrals. -/
+lemma set_integral_prod (f : α × β → E) {s : set α} {t : set β}
+  (hf : integrable_on f (s ×ˢ t) (μ.prod ν)) :
+  ∫ z in s ×ˢ t, f z ∂(μ.prod ν) = ∫ x in s, ∫ y in t, f (x, y) ∂ν ∂μ :=
+begin
+  simp only [← measure.prod_restrict s t, integrable_on] at hf ⊢,
+  exact integral_prod f hf
+end
+
+lemma integral_prod_mul {L : Type*} [is_R_or_C L] (f : α → L) (g : β → L) :
+  ∫ z, f z.1 * g z.2 ∂(μ.prod ν) = (∫ x, f x ∂μ) * (∫ y, g y ∂ν) :=
+begin
+  by_cases h : integrable (λ (z : α × β), f z.1 * g z.2) (μ.prod ν),
+  { rw integral_prod _ h,
+    simp_rw [integral_mul_left, integral_mul_right] },
+  have H : ¬(integrable f μ) ∨ ¬(integrable g ν),
+  { contrapose! h,
+    exact integrable_prod_mul h.1 h.2 },
+  cases H;
+  simp [integral_undef h, integral_undef H],
+end
+
+lemma set_integral_prod_mul {L : Type*} [is_R_or_C L]
+  (f : α → L) (g : β → L) (s : set α) (t : set β) :
+  ∫ z in s ×ˢ t, f z.1 * g z.2 ∂(μ.prod ν) = (∫ x in s, f x ∂μ) * (∫ y in t, g y ∂ν) :=
+by simp only [← measure.prod_restrict s t, integrable_on, integral_prod_mul]
+
+end measure_theory
diff --git a/src/measure_theory/covering/besicovitch.lean b/src/measure_theory/covering/besicovitch.lean
index a88727f55140d..55bc5ce327c6e 100644
--- a/src/measure_theory/covering/besicovitch.lean
+++ b/src/measure_theory/covering/besicovitch.lean
@@ -13,6 +13,9 @@ import topology.metric_space.basic
 /-!
 # Besicovitch covering theorems
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The topological Besicovitch covering theorem ensures that, in a nice metric space, there exists a
 number `N` such that, from any family of balls with bounded radii, one can extract `N` families,
 each made of disjoint balls, covering together all the centers of the initial family.
@@ -99,7 +102,7 @@ noncomputable theory
 universe u
 
 open metric set filter fin measure_theory topological_space
-open_locale topological_space classical big_operators ennreal measure_theory nnreal
+open_locale topology classical big_operators ennreal measure_theory nnreal
 
 
 /-!
@@ -139,7 +142,7 @@ class has_besicovitch_covering (α : Type*) [metric_space α] : Prop :=
 /-- There is always a satellite configuration with a single point. -/
 instance {α : Type*} {τ : ℝ} [inhabited α] [metric_space α] :
   inhabited (besicovitch.satellite_config α 0 τ) :=
-⟨{ c := λ i, default,
+⟨{ c := default,
   r := λ i, 1,
   rpos := λ i, zero_lt_one,
   h := λ i j hij, (hij (subsingleton.elim i j)).elim,
@@ -260,7 +263,8 @@ begin
   by_contra,
   suffices H : function.injective p.index, from not_injective_of_ordinal p.index H,
   assume x y hxy,
-  wlog x_le_y : x ≤ y := le_total x y using [x y, y x],
+  wlog x_le_y : x ≤ y generalizing x y,
+  { exact (this hxy.symm (le_of_not_le x_le_y)).symm },
   rcases eq_or_lt_of_le x_le_y with rfl|H, { refl },
   simp only [nonempty_def, not_exists, exists_prop, not_and, not_lt, not_le, mem_set_of_eq,
     not_forall] at h,
@@ -395,16 +399,14 @@ begin
     rpos := λ k, p.rpos (p.index (G k)),
     h := begin
       assume a b a_ne_b,
-      wlog G_le : G a ≤ G b := le_total (G a) (G b) using [a b, b a] tactic.skip,
-      { have G_lt : G a < G b,
-        { rcases G_le.lt_or_eq with H|H, { exact H },
-          have A : (a : ℕ) ≠ b := fin.coe_injective.ne a_ne_b,
-          rw [← color_G a (nat.lt_succ_iff.1 a.2), ← color_G b (nat.lt_succ_iff.1 b.2), H] at A,
-          exact (A rfl).elim },
-        exact or.inl (Gab a b G_lt) },
-      { assume a_ne_b,
-        rw or_comm,
-        exact this a_ne_b.symm }
+      wlog G_le : G a ≤ G b generalizing a b,
+      { exact (this b a a_ne_b.symm (le_of_not_le G_le)).symm },
+      have G_lt : G a < G b,
+      { rcases G_le.lt_or_eq with H|H, { exact H },
+        have A : (a : ℕ) ≠ b := fin.coe_injective.ne a_ne_b,
+        rw [← color_G a (nat.lt_succ_iff.1 a.2), ← color_G b (nat.lt_succ_iff.1 b.2), H] at A,
+        exact (A rfl).elim },
+      exact or.inl (Gab a b G_lt),
     end,
     hlast := begin
       assume a ha,
@@ -456,11 +458,8 @@ begin
     obtain ⟨jy, jy_lt, jyi, rfl⟩ :
       ∃ (jy : ordinal), jy < p.last_step ∧ p.color jy = i ∧ y = p.index jy,
         by simpa only [exists_prop, mem_Union, mem_singleton_iff] using hy,
-    wlog jxy : jx ≤ jy := le_total jx jy using [jx jy, jy jx] tactic.skip,
-    swap,
-    { assume h1 h2 h3 h4 h5 h6 h7,
-      rw [function.on_fun, disjoint.comm],
-      exact this h4 h5 h6 h1 h2 h3 h7.symm },
+    wlog jxy : jx ≤ jy generalizing jx jy,
+    { exact (this jy jy_lt jyi hy jx jx_lt jxi hx x_ne_y.symm (le_of_not_le jxy)).symm },
     replace jxy : jx < jy,
       by { rcases lt_or_eq_of_le jxy with H|rfl, { exact H }, { exact (x_ne_y rfl).elim } },
     let A : set ℕ := ⋃ (j : {j // j < jy})
@@ -535,7 +534,7 @@ begin
     r_bound := 1,
     r_le := λ x, rle x x.2 },
   rcases exist_disjoint_covering_families hτ hN a with ⟨u, hu, hu'⟩,
-  have u_count : ∀ i, countable (u i),
+  have u_count : ∀ i, (u i).countable,
   { assume i,
     refine (hu i).countable_of_nonempty_interior (λ j hj, _),
     have : (ball (j : α) (r j)).nonempty := nonempty_ball.2 (a.rpos _),
@@ -557,7 +556,7 @@ begin
       simp only [finset.card_fin, finset.sum_const, nsmul_eq_mul],
       rw ennreal.mul_div_cancel',
       { simp only [Npos, ne.def, nat.cast_eq_zero, not_false_iff] },
-      { exact ennreal.coe_nat_ne_top }
+      { exact (ennreal.nat_ne_top _) }
     end
     ... ≤ ∑ i, μ (s ∩ v i) : by { conv_lhs { rw A }, apply measure_Union_fintype_le },
   -- choose an index `i` of a subfamily covering at least a proportion `1/N` of `s`.
@@ -569,7 +568,7 @@ begin
     apply (ennreal.mul_lt_mul_left hμs.ne' (measure_lt_top μ s).ne).2,
     rw ennreal.inv_lt_inv,
     conv_lhs {rw ← add_zero (N : ℝ≥0∞) },
-    exact ennreal.add_lt_add_left (ennreal.nat_ne_top N) ennreal.zero_lt_one },
+    exact ennreal.add_lt_add_left (ennreal.nat_ne_top N) zero_lt_one },
   have B : μ (o ∩ v i) = ∑' (x : u i), μ (o ∩ closed_ball x (r x)),
   { have : o ∩ v i = ⋃ (x : s) (hx : x ∈ u i), o ∩ closed_ball x (r x), by simp only [inter_Union],
     rw [this, measure_bUnion (u_count i)],
@@ -602,7 +601,7 @@ begin
     { apply measurable_set.inter _ omeas,
       haveI : encodable (u i) := (u_count i).to_encodable,
       exact measurable_set.Union
-        (λ b, measurable_set.Union_Prop (λ hb, measurable_set_closed_ball)) },
+        (λ b, measurable_set.Union (λ hb, measurable_set_closed_ball)) },
     calc
     μ o = 1/(N+1) * μ s + N/(N+1) * μ s :
       by { rw [μo, ← add_mul, ennreal.div_add_div_same, add_comm, ennreal.div_self, one_mul]; simp }
@@ -645,7 +644,7 @@ For a version giving the conclusion in a nicer form, see `exists_disjoint_closed
 theorem exists_disjoint_closed_ball_covering_ae_of_finite_measure_aux
   (μ : measure α) [is_finite_measure μ]
   (f : α → set ℝ) (s : set α) (hf : ∀ x ∈ s, ∀ δ > 0, (f x ∩ Ioo 0 δ).nonempty) :
-  ∃ (t : set (α × ℝ)), (countable t)
+  ∃ (t : set (α × ℝ)), t.countable
     ∧ (∀ (p : α × ℝ), p ∈ t → p.1 ∈ s) ∧ (∀ (p : α × ℝ), p ∈ t → p.2 ∈ f p.1)
     ∧ μ (s \ (⋃ (p : α × ℝ) (hp : p ∈ t), closed_ball p.1 p.2)) = 0
     ∧ t.pairwise_disjoint (λ p, closed_ball p.1 p.2) :=
@@ -726,7 +725,7 @@ begin
   { assume n,
     induction n with n IH,
     { simp only [u, P, prod.forall, id.def, function.iterate_zero],
-      simp only [finset.not_mem_empty, forall_false_left, finset.coe_empty, forall_2_true_iff,
+      simp only [finset.not_mem_empty, is_empty.forall_iff, finset.coe_empty, forall_2_true_iff,
         and_self, pairwise_disjoint_empty] },
     { rw u_succ,
       exact (hF (u n) IH).2.1 } },
@@ -754,13 +753,13 @@ begin
             ≤ (N/(N+1)) * μ (s \ ⋃ (p : α × ℝ) (hp : p ∈ u n), closed_ball p.fst p.snd) :
               by { rw u_succ, exact (hF (u n) (Pu n)).2.2 }
         ... ≤ (N/(N+1))^n.succ * μ s :
-          by { rw [pow_succ, mul_assoc], exact ennreal.mul_le_mul le_rfl IH } },
+          by { rw [pow_succ, mul_assoc], exact mul_le_mul_left' IH _ } },
     have C : tendsto (λ (n : ℕ), ((N : ℝ≥0∞)/(N+1))^n * μ s) at_top (𝓝 (0 * μ s)),
     { apply ennreal.tendsto.mul_const _ (or.inr (measure_lt_top μ s).ne),
       apply ennreal.tendsto_pow_at_top_nhds_0_of_lt_1,
       rw [ennreal.div_lt_iff, one_mul],
       { conv_lhs {rw ← add_zero (N : ℝ≥0∞) },
-        exact ennreal.add_lt_add_left (ennreal.nat_ne_top N) ennreal.zero_lt_one },
+        exact ennreal.add_lt_add_left (ennreal.nat_ne_top N) zero_lt_one },
       { simp only [true_or, add_eq_zero_iff, ne.def, not_false_iff, one_ne_zero, and_false] },
       { simp only [ennreal.nat_ne_top, ne.def, not_false_iff, or_true] } },
     rw zero_mul at C,
@@ -784,7 +783,7 @@ For a version giving the conclusion in a nicer form, see `exists_disjoint_closed
 -/
 theorem exists_disjoint_closed_ball_covering_ae_aux (μ : measure α) [sigma_finite μ]
   (f : α → set ℝ) (s : set α) (hf : ∀ x ∈ s, ∀ δ > 0, (f x ∩ Ioo 0 δ).nonempty) :
-  ∃ (t : set (α × ℝ)), (countable t)
+  ∃ (t : set (α × ℝ)), t.countable
     ∧ (∀ (p : α × ℝ), p ∈ t → p.1 ∈ s) ∧ (∀ (p : α × ℝ), p ∈ t → p.2 ∈ f p.1)
     ∧ μ (s \ (⋃ (p : α × ℝ) (hp : p ∈ t), closed_ball p.1 p.2)) = 0
     ∧ t.pairwise_disjoint (λ p, closed_ball p.1 p.2) :=
@@ -808,7 +807,7 @@ Besicovitch covering property (which is satisfied for instance by normed real ve
 theorem exists_disjoint_closed_ball_covering_ae (μ : measure α) [sigma_finite μ]
   (f : α → set ℝ) (s : set α) (hf : ∀ x ∈ s, ∀ δ > 0, (f x ∩ Ioo 0 δ).nonempty)
   (R : α → ℝ) (hR : ∀ x ∈ s, 0 < R x):
-  ∃ (t : set α) (r : α → ℝ), countable t ∧ t ⊆ s ∧ (∀ x ∈ t, r x ∈ f x ∩ Ioo 0 (R x))
+  ∃ (t : set α) (r : α → ℝ), t.countable ∧ t ⊆ s ∧ (∀ x ∈ t, r x ∈ f x ∩ Ioo 0 (R x))
     ∧ μ (s \ (⋃ (x ∈ t), closed_ball x (r x))) = 0
     ∧ t.pairwise_disjoint (λ x, closed_ball x (r x)) :=
 begin
@@ -871,7 +870,7 @@ theorem exists_closed_ball_covering_tsum_measure_le
   (μ : measure α) [sigma_finite μ] [measure.outer_regular μ]
   {ε : ℝ≥0∞} (hε : ε ≠ 0) (f : α → set ℝ) (s : set α)
   (hf : ∀ x ∈ s, ∀ δ > 0, (f x ∩ Ioo 0 δ).nonempty) :
-  ∃ (t : set α) (r : α → ℝ), countable t ∧ t ⊆ s ∧ (∀ x ∈ t, r x ∈ f x)
+  ∃ (t : set α) (r : α → ℝ), t.countable ∧ t ⊆ s ∧ (∀ x ∈ t, r x ∈ f x)
     ∧ s ⊆ (⋃ (x ∈ t), closed_ball x (r x))
     ∧ ∑' (x : t), μ (closed_ball x (r x)) ≤ μ s + ε  :=
 begin
@@ -888,7 +887,7 @@ begin
     λ x hx, metric.mem_nhds_iff.1 (u_open.mem_nhds (su hx)),
   choose! R hR using this,
   obtain ⟨t0, r0, t0_count, t0s, hr0, μt0, t0_disj⟩ :
-    ∃ (t0 : set α) (r0 : α → ℝ), countable t0 ∧ t0 ⊆ s ∧ (∀ x ∈ t0, r0 x ∈ f x ∩ Ioo 0 (R x))
+    ∃ (t0 : set α) (r0 : α → ℝ), t0.countable ∧ t0 ⊆ s ∧ (∀ x ∈ t0, r0 x ∈ f x ∩ Ioo 0 (R x))
       ∧ μ (s \ (⋃ (x ∈ t0), closed_ball x (r0 x))) = 0
       ∧ t0.pairwise_disjoint (λ x, closed_ball x (r0 x)) :=
         exists_disjoint_closed_ball_covering_ae μ f s hf R (λ x hx, (hR x hx).1),
@@ -921,7 +920,7 @@ begin
     (∀ (i : fin N), (S i).pairwise_disjoint (λ j, closed_ball (q.c j) (q.r j))) ∧
       (range q.c ⊆ ⋃ (i : fin N), ⋃ (j ∈ S i), ball (q.c j) (q.r j)) :=
     exist_disjoint_covering_families hτ H q,
-  have S_count : ∀ i, countable (S i),
+  have S_count : ∀ i, (S i).countable,
   { assume i,
     apply (S_disj i).countable_of_nonempty_interior (λ j hj, _),
     have : (ball (j : α) (r1 j)).nonempty := nonempty_ball.2 (q.rpos _),
@@ -1076,12 +1075,18 @@ protected def vitali_family (μ : measure α) [sigma_finite μ] :
           subset.antisymm ht (closed_ball_subset_closed_ball H),
         rw this at tf,
         refine ⟨δ/2, ⟨half_pos δpos, tf⟩, ⟨half_pos δpos, half_lt_self δpos⟩⟩ } },
-    obtain ⟨t, r, t_count, ts, tg, μt, tdisj⟩ : ∃ (t : set α) (r : α → ℝ), countable t
+    obtain ⟨t, r, t_count, ts, tg, μt, tdisj⟩ : ∃ (t : set α) (r : α → ℝ), t.countable
       ∧ t ⊆ s ∧ (∀ x ∈ t, r x ∈ g x ∩ Ioo 0 1)
       ∧ μ (s \ (⋃ (x ∈ t), closed_ball x (r x))) = 0
       ∧ t.pairwise_disjoint (λ x, closed_ball x (r x)) :=
         exists_disjoint_closed_ball_covering_ae μ g s A (λ _, 1) (λ _ _, zero_lt_one),
-    exact ⟨t, λ x, closed_ball x (r x), ts, tdisj, λ x xt, (tg x xt).1.2, μt⟩,
+    let F : α → α × set α := λ x, (x, closed_ball x (r x)),
+    refine ⟨F '' t, _, _, _, _⟩,
+    { rintros - ⟨x, hx, rfl⟩, exact ts hx },
+    { rintros p ⟨x, hx, rfl⟩ q ⟨y, hy, rfl⟩ hxy,
+      exact tdisj hx hy (ne_of_apply_ne F hxy) },
+    { rintros - ⟨x, hx, rfl⟩, exact (tg x hx).1.2 },
+    { rwa bUnion_image }
   end }
 
 /-- The main feature of the Besicovitch Vitali family is that its filter at a point `x` corresponds
@@ -1103,7 +1108,7 @@ begin
   { exact closed_ball_subset_closed_ball hr.2 }
 end
 
-variables [metric_space β] [measurable_space β] [borel_space β] [sigma_compact_space β]
+variables [metric_space β] [measurable_space β] [borel_space β] [second_countable_topology β]
   [has_besicovitch_covering β]
 
 /-- In a space with the Besicovitch covering property, the ratio of the measure of balls converges
@@ -1113,7 +1118,6 @@ lemma ae_tendsto_rn_deriv
   ∀ᵐ x ∂μ, tendsto (λ r, ρ (closed_ball x r) / μ (closed_ball x r))
     (𝓝[>] 0) (𝓝 (ρ.rn_deriv μ x)) :=
 begin
-  haveI : second_countable_topology β := emetric.second_countable_of_sigma_compact β,
   filter_upwards [vitali_family.ae_tendsto_rn_deriv (besicovitch.vitali_family μ) ρ] with x hx,
   exact hx.comp (tendsto_filter_at μ x)
 end
@@ -1128,7 +1132,6 @@ lemma ae_tendsto_measure_inter_div_of_measurable_set
   ∀ᵐ x ∂μ, tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r))
     (𝓝[>] 0) (𝓝 (s.indicator 1 x)) :=
 begin
-  haveI : second_countable_topology β := emetric.second_countable_of_sigma_compact β,
   filter_upwards [vitali_family.ae_tendsto_measure_inter_div_of_measurable_set
     (besicovitch.vitali_family μ) hs],
   assume x hx,
@@ -1139,14 +1142,12 @@ end
 to `1` when `r` tends to `0`, for almost every `x` in `s`.
 This shows that almost every point of `s` is a Lebesgue density point for `s`.
 A stronger version holds for measurable sets, see `ae_tendsto_measure_inter_div_of_measurable_set`.
--/
+
+See also `is_unif_loc_doubling_measure.ae_tendsto_measure_inter_div`. -/
 lemma ae_tendsto_measure_inter_div (μ : measure β) [is_locally_finite_measure μ] (s : set β) :
   ∀ᵐ x ∂(μ.restrict s), tendsto (λ r, μ (s ∩ (closed_ball x r)) / μ (closed_ball x r))
     (𝓝[>] 0) (𝓝 1) :=
-begin
-  haveI : second_countable_topology β := emetric.second_countable_of_sigma_compact β,
-  filter_upwards [vitali_family.ae_tendsto_measure_inter_div (besicovitch.vitali_family μ)]
-    with x hx using hx.comp (tendsto_filter_at μ x),
-end
+by filter_upwards [vitali_family.ae_tendsto_measure_inter_div (besicovitch.vitali_family μ)]
+    with x hx using hx.comp (tendsto_filter_at μ x)
 
 end besicovitch
diff --git a/src/measure_theory/covering/besicovitch_vector_space.lean b/src/measure_theory/covering/besicovitch_vector_space.lean
index 51ec7115bc341..130fe156abfde 100644
--- a/src/measure_theory/covering/besicovitch_vector_space.lean
+++ b/src/measure_theory/covering/besicovitch_vector_space.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 
-import measure_theory.measure.haar_lebesgue
+import measure_theory.measure.lebesgue.eq_haar
 import measure_theory.covering.besicovitch
 
 /-!
 # Satellite configurations for Besicovitch covering lemma in vector spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Besicovitch covering theorem ensures that, in a nice metric space, there exists a number `N`
 such that, from any family of balls with bounded radii, one can extract `N` families, each made of
 disjoint balls, covering together all the centers of the initial family.
@@ -43,13 +46,13 @@ In particular, this number is bounded by `5 ^ dim` by a straightforward measure
 universe u
 open metric set finite_dimensional measure_theory filter fin
 
-open_locale ennreal topological_space
+open_locale ennreal topology
 
 noncomputable theory
 
 namespace besicovitch
 
-variables {E : Type*} [normed_group E]
+variables {E : Type*} [normed_add_comm_group E]
 
 namespace satellite_config
 variables [normed_space ℝ E] {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
@@ -123,8 +126,8 @@ end satellite_config
 
 /-- The maximum cardinality of a `1`-separated set in the ball of radius `2`. This is also the
 optimal number of families in the Besicovitch covering theorem. -/
-def multiplicity (E : Type*) [normed_group E] :=
-Sup {N | ∃ s : finset E, s.card = N ∧ (∀ c ∈ s, ∥c∥ ≤ 2) ∧ (∀ c ∈ s, ∀ d ∈ s, c ≠ d → 1 ≤ ∥c - d∥)}
+def multiplicity (E : Type*) [normed_add_comm_group E] :=
+Sup {N | ∃ s : finset E, s.card = N ∧ (∀ c ∈ s, ‖c‖ ≤ 2) ∧ (∀ c ∈ s, ∀ d ∈ s, c ≠ d → 1 ≤ ‖c - d‖)}
 
 section
 variables [normed_space ℝ E]  [finite_dimensional ℝ E]
@@ -133,7 +136,7 @@ variables [normed_space ℝ E]  [finite_dimensional ℝ E]
 useful to show that the supremum in the definition of `besicovitch.multiplicity E` is
 well behaved. -/
 lemma card_le_of_separated
-  (s : finset E) (hs : ∀ c ∈ s, ∥c∥ ≤ 2) (h : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ∥c - d∥) :
+  (s : finset E) (hs : ∀ c ∈ s, ‖c‖ ≤ 2) (h : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ‖c - d‖) :
   s.card ≤ 5 ^ (finrank ℝ E) :=
 begin
   /- We consider balls of radius `1/2` around the points in `s`. They are disjoint, and all
@@ -187,7 +190,7 @@ begin
 end
 
 lemma card_le_multiplicity
-  {s : finset E} (hs : ∀ c ∈ s, ∥c∥ ≤ 2) (h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ∥c - d∥) :
+  {s : finset E} (hs : ∀ c ∈ s, ‖c‖ ≤ 2) (h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ‖c - d‖) :
   s.card ≤ multiplicity E :=
 begin
   apply le_cSup,
@@ -202,8 +205,8 @@ variable (E)
 
 /-- If `δ` is small enough, a `(1-δ)`-separated set in the ball of radius `2` also has cardinality
 at most `multiplicity E`. -/
-lemma exists_good_δ : ∃ (δ : ℝ), 0 < δ ∧ δ < 1 ∧ ∀ (s : finset E), (∀ c ∈ s, ∥c∥ ≤ 2) →
-  (∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - δ ≤ ∥c - d∥) → s.card ≤ multiplicity E :=
+lemma exists_good_δ : ∃ (δ : ℝ), 0 < δ ∧ δ < 1 ∧ ∀ (s : finset E), (∀ c ∈ s, ‖c‖ ≤ 2) →
+  (∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - δ ≤ ‖c - d‖) → s.card ≤ multiplicity E :=
 begin
   /- This follows from a compactness argument: otherwise, one could extract a converging
   subsequence, to obtain a `1`-separated set in the ball of radius `2` with cardinality
@@ -212,8 +215,8 @@ begin
   classical,
   by_contra' h,
   set N := multiplicity E + 1 with hN,
-  have : ∀ (δ : ℝ), 0 < δ → ∃ f : fin N → E, (∀ (i : fin N), ∥f i∥ ≤ 2)
-    ∧ (∀ i j, i ≠ j → 1 - δ ≤ ∥f i - f j∥),
+  have : ∀ (δ : ℝ), 0 < δ → ∃ f : fin N → E, (∀ (i : fin N), ‖f i‖ ≤ 2)
+    ∧ (∀ i j, i ≠ j → 1 - δ ≤ ‖f i - f j‖),
   { assume δ hδ,
     rcases lt_or_le δ 1 with hδ'|hδ',
     { rcases h δ hδ hδ' with ⟨s, hs, h's, s_card⟩,
@@ -228,21 +231,21 @@ begin
   -- in the image are separated by `1 - δ`.
   choose! F hF using this,
   -- Choose a converging subsequence when `δ → 0`.
-  have : ∃ f : fin N → E, (∀ (i : fin N), ∥f i∥ ≤ 2) ∧ (∀ i j, i ≠ j → 1 ≤ ∥f i - f j∥),
+  have : ∃ f : fin N → E, (∀ (i : fin N), ‖f i‖ ≤ 2) ∧ (∀ i j, i ≠ j → 1 ≤ ‖f i - f j‖),
   { obtain ⟨u, u_mono, zero_lt_u, hu⟩ : ∃ (u : ℕ → ℝ), (∀ (m n : ℕ), m < n → u n < u m)
       ∧ (∀ (n : ℕ), 0 < u n) ∧ filter.tendsto u filter.at_top (𝓝 0) :=
         exists_seq_strict_anti_tendsto (0 : ℝ),
     have A : ∀ n, F (u n) ∈ closed_ball (0 : fin N → E) 2,
     { assume n,
-      simp only [pi_norm_le_iff zero_le_two, mem_closed_ball, dist_zero_right,
+      simp only [pi_norm_le_iff_of_nonneg zero_le_two, mem_closed_ball, dist_zero_right,
                  (hF (u n) (zero_lt_u n)).left, forall_const], },
     obtain ⟨f, fmem, φ, φ_mono, hf⟩ : ∃ (f ∈ closed_ball (0 : fin N → E) 2) (φ : ℕ → ℕ),
       strict_mono φ ∧ tendsto ((F ∘ u) ∘ φ) at_top (𝓝 f) :=
         is_compact.tendsto_subseq (is_compact_closed_ball _ _) A,
     refine ⟨f, λ i, _, λ i j hij, _⟩,
-    { simp only [pi_norm_le_iff zero_le_two, mem_closed_ball, dist_zero_right] at fmem,
+    { simp only [pi_norm_le_iff_of_nonneg zero_le_two, mem_closed_ball, dist_zero_right] at fmem,
       exact fmem i },
-    { have A : tendsto (λ n, ∥F (u (φ n)) i - F (u (φ n)) j∥) at_top (𝓝 (∥f i - f j∥)) :=
+    { have A : tendsto (λ n, ‖F (u (φ n)) i - F (u (φ n)) j‖) at_top (𝓝 (‖f i - f j‖)) :=
         ((hf.apply i).sub (hf.apply j)).norm,
       have B : tendsto (λ n, 1 - u (φ n)) at_top (𝓝 (1 - 0)) :=
         tendsto_const_nhds.sub (hu.comp φ_mono.tendsto_at_top),
@@ -253,16 +256,16 @@ begin
   have finj : function.injective f,
   { assume i j hij,
     by_contra,
-    have : 1 ≤ ∥f i - f j∥ := h'f i j h,
+    have : 1 ≤ ‖f i - f j‖ := h'f i j h,
     simp only [hij, norm_zero, sub_self] at this,
     exact lt_irrefl _ (this.trans_lt zero_lt_one) },
   let s := finset.image f finset.univ,
   have s_card : s.card = N,
     by { rw finset.card_image_of_injective _ finj, exact finset.card_fin N },
-  have hs : ∀ c ∈ s, ∥c∥ ≤ 2,
+  have hs : ∀ c ∈ s, ‖c‖ ≤ 2,
     by simp only [hf, forall_apply_eq_imp_iff', forall_const, forall_exists_index, finset.mem_univ,
                   finset.mem_image],
-  have h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ∥c - d∥,
+  have h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 ≤ ‖c - d‖,
   { simp only [s, forall_apply_eq_imp_iff', forall_exists_index, finset.mem_univ, finset.mem_image,
       ne.def, exists_true_left, forall_apply_eq_imp_iff', forall_true_left],
     assume i j hij,
@@ -289,29 +292,29 @@ by { dsimp [good_τ, good_δ], linarith [(exists_good_δ E).some_spec.1] }
 
 variable {E}
 
-lemma card_le_multiplicity_of_δ {s : finset E} (hs : ∀ c ∈ s, ∥c∥ ≤ 2)
-  (h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - good_δ E ≤ ∥c - d∥) :
+lemma card_le_multiplicity_of_δ {s : finset E} (hs : ∀ c ∈ s, ‖c‖ ≤ 2)
+  (h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - good_δ E ≤ ‖c - d‖) :
   s.card ≤ multiplicity E :=
 (classical.some_spec (exists_good_δ E)).2.2 s hs h's
 
-lemma le_multiplicity_of_δ_of_fin {n : ℕ} (f : fin n → E) (h : ∀ i, ∥f i∥ ≤ 2)
-  (h' : ∀ i j, i ≠ j → 1 - good_δ E ≤ ∥f i - f j∥) :
+lemma le_multiplicity_of_δ_of_fin {n : ℕ} (f : fin n → E) (h : ∀ i, ‖f i‖ ≤ 2)
+  (h' : ∀ i j, i ≠ j → 1 - good_δ E ≤ ‖f i - f j‖) :
   n ≤ multiplicity E :=
 begin
   classical,
   have finj : function.injective f,
   { assume i j hij,
     by_contra,
-    have : 1 - good_δ E ≤ ∥f i - f j∥ := h' i j h,
+    have : 1 - good_δ E ≤ ‖f i - f j‖ := h' i j h,
     simp only [hij, norm_zero, sub_self] at this,
     linarith [good_δ_lt_one E] },
   let s := finset.image f finset.univ,
   have s_card : s.card = n,
     by { rw finset.card_image_of_injective _ finj, exact finset.card_fin n },
-  have hs : ∀ c ∈ s, ∥c∥ ≤ 2,
+  have hs : ∀ c ∈ s, ‖c‖ ≤ 2,
     by simp only [h, forall_apply_eq_imp_iff', forall_const, forall_exists_index, finset.mem_univ,
                   finset.mem_image, implies_true_iff],
-  have h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - good_δ E ≤ ∥c - d∥,
+  have h's : ∀ (c ∈ s) (d ∈ s), c ≠ d → 1 - good_δ E ≤ ‖c - d‖,
   { simp only [s, forall_apply_eq_imp_iff', forall_exists_index, finset.mem_univ, finset.mem_image,
       ne.def, exists_true_left, forall_apply_eq_imp_iff', forall_true_left],
     assume i j hij,
@@ -331,23 +334,23 @@ namespace satellite_config
 We prove that the number of points in a satellite configuration is bounded by the maximal number
 of `1`-separated points in the ball of radius `2`. For this, start from a satellite congifuration
 `c`. Without loss of generality, one can assume that the last ball is centered at `0` and of
-radius `1`. Define `c' i = c i` if `∥c i∥ ≤ 2`, and `c' i = (2/∥c i∥) • c i` if `∥c i∥ > 2`.
+radius `1`. Define `c' i = c i` if `‖c i‖ ≤ 2`, and `c' i = (2/‖c i‖) • c i` if `‖c i‖ > 2`.
 It turns out that these points are `1 - δ`-separated, where `δ` is arbitrarily small if `τ` is
 close enough to `1`. The number of such configurations is bounded by `multiplicity E` if `δ` is
 suitably small.
 
 To check that the points `c' i` are `1 - δ`-separated, one treats separately the cases where
-both `∥c i∥` and `∥c j∥` are `≤ 2`, where one of them is `≤ 2` and the other one is `> 2`, and
+both `‖c i‖` and `‖c j‖` are `≤ 2`, where one of them is `≤ 2` and the other one is `> 2`, and
 where both of them are `> 2`.
 -/
 
 lemma exists_normalized_aux1 {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
   (lastr : a.r (last N) = 1) (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4) (hδ2 : δ ≤ 1)
   (i j : fin N.succ) (inej : i ≠ j) :
-  1 - δ ≤ ∥a.c i - a.c j∥ :=
+  1 - δ ≤ ‖a.c i - a.c j‖ :=
 begin
-  have ah : ∀ i j, i ≠ j → (a.r i ≤ ∥a.c i - a.c j∥ ∧ a.r j ≤ τ * a.r i) ∨
-                          (a.r j ≤ ∥a.c j - a.c i∥ ∧ a.r i ≤ τ * a.r j),
+  have ah : ∀ i j, i ≠ j → (a.r i ≤ ‖a.c i - a.c j‖ ∧ a.r j ≤ τ * a.r i) ∨
+                          (a.r j ≤ ‖a.c j - a.c i‖ ∧ a.r i ≤ τ * a.r j),
     by simpa only [dist_eq_norm] using a.h,
   have δnonneg : 0 ≤ δ := by linarith only [hτ, hδ1],
   have D : 0 ≤ 1 - δ / 4, by linarith only [hδ2],
@@ -358,7 +361,7 @@ begin
     ... ≤ 1 : (by linarith only [sq_nonneg δ]),
   have J : 1 - δ ≤ 1 - δ / 4, by linarith only [δnonneg],
   have K : 1 - δ / 4 ≤ τ⁻¹, by { rw [inv_eq_one_div, le_div_iff τpos], exact I },
-  suffices L : τ⁻¹ ≤ ∥a.c i - a.c j∥, by linarith only [J, K, L],
+  suffices L : τ⁻¹ ≤ ‖a.c i - a.c j‖, by linarith only [J, K, L],
   have hτ' : ∀ k, τ⁻¹ ≤ a.r k,
   { assume k,
     rw [inv_eq_one_div, div_le_iff τpos, ← lastr, mul_comm],
@@ -376,16 +379,16 @@ variable [normed_space ℝ E]
 lemma exists_normalized_aux2 {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
   (lastc : a.c (last N) = 0) (lastr : a.r (last N) = 1)
   (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4) (hδ2 : δ ≤ 1)
-  (i j : fin N.succ) (inej : i ≠ j) (hi : ∥a.c i∥ ≤ 2) (hj : 2 < ∥a.c j∥) :
-  1 - δ ≤ ∥a.c i - (2 / ∥a.c j∥) • a.c j∥ :=
+  (i j : fin N.succ) (inej : i ≠ j) (hi : ‖a.c i‖ ≤ 2) (hj : 2 < ‖a.c j‖) :
+  1 - δ ≤ ‖a.c i - (2 / ‖a.c j‖) • a.c j‖ :=
 begin
-  have ah : ∀ i j, i ≠ j → (a.r i ≤ ∥a.c i - a.c j∥ ∧ a.r j ≤ τ * a.r i) ∨
-                          (a.r j ≤ ∥a.c j - a.c i∥ ∧ a.r i ≤ τ * a.r j),
+  have ah : ∀ i j, i ≠ j → (a.r i ≤ ‖a.c i - a.c j‖ ∧ a.r j ≤ τ * a.r i) ∨
+                          (a.r j ≤ ‖a.c j - a.c i‖ ∧ a.r i ≤ τ * a.r j),
     by simpa only [dist_eq_norm] using a.h,
   have δnonneg : 0 ≤ δ := by linarith only [hτ, hδ1],
   have D : 0 ≤ 1 - δ / 4, by linarith only [hδ2],
   have τpos : 0 < τ := _root_.zero_lt_one.trans_le hτ,
-  have hcrj : ∥a.c j∥ ≤ a.r j + 1,
+  have hcrj : ‖a.c j‖ ≤ a.r j + 1,
     by simpa only [lastc, lastr, dist_zero_right] using a.inter' j,
   have I : a.r i ≤ 2,
   { rcases lt_or_le i (last N) with H|H,
@@ -398,7 +401,7 @@ begin
     (1 - δ / 4) * τ ≤ (1 - δ / 4) * (1 + δ / 4) : mul_le_mul_of_nonneg_left hδ1 D
     ... = 1 - δ^2 / 16 : by ring
     ... ≤ 1 : (by linarith only [sq_nonneg δ]),
-  have A : a.r j - δ ≤ ∥a.c i - a.c j∥,
+  have A : a.r j - δ ≤ ‖a.c i - a.c j‖,
   { rcases ah j i inej.symm with H|H, { rw norm_sub_rev, linarith [H.1] },
     have C : a.r j ≤ 4 := calc
       a.r j ≤ τ * a.r i : H.2
@@ -414,14 +417,14 @@ begin
     ... ≤ (1 - δ / 4) * (τ * a.r i) :
       mul_le_mul_of_nonneg_left (H.2) D
     ... ≤ 1 * a.r i : by { rw [← mul_assoc], apply mul_le_mul_of_nonneg_right J (a.rpos _).le }
-    ... ≤ ∥a.c i - a.c j∥ : by { rw [one_mul], exact H.1 } },
-  set d := (2 / ∥a.c j∥) • a.c j with hd,
-  have : a.r j - δ ≤ ∥a.c i - d∥ + (a.r j - 1) := calc
-    a.r j - δ ≤ ∥a.c i - a.c j∥ : A
-    ... ≤ ∥a.c i - d∥ + ∥d - a.c j∥ : by simp only [← dist_eq_norm, dist_triangle]
-    ... ≤ ∥a.c i - d∥ + (a.r j - 1) : begin
+    ... ≤ ‖a.c i - a.c j‖ : by { rw [one_mul], exact H.1 } },
+  set d := (2 / ‖a.c j‖) • a.c j with hd,
+  have : a.r j - δ ≤ ‖a.c i - d‖ + (a.r j - 1) := calc
+    a.r j - δ ≤ ‖a.c i - a.c j‖ : A
+    ... ≤ ‖a.c i - d‖ + ‖d - a.c j‖ : by simp only [← dist_eq_norm, dist_triangle]
+    ... ≤ ‖a.c i - d‖ + (a.r j - 1) : begin
       apply add_le_add_left,
-      have A : 0 ≤ 1 - 2 / ∥a.c j∥, by simpa [div_le_iff (zero_le_two.trans_lt hj)] using hj.le,
+      have A : 0 ≤ 1 - 2 / ‖a.c j‖, by simpa [div_le_iff (zero_le_two.trans_lt hj)] using hj.le,
       rw [← one_smul ℝ (a.c j), hd, ← sub_smul, norm_smul, norm_sub_rev, real.norm_eq_abs,
           abs_of_nonneg A, sub_mul],
       field_simp [(zero_le_two.trans_lt hj).ne'],
@@ -433,17 +436,17 @@ end
 lemma exists_normalized_aux3 {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
   (lastc : a.c (last N) = 0) (lastr : a.r (last N) = 1)
   (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4)
-  (i j : fin N.succ) (inej : i ≠ j) (hi : 2 < ∥a.c i∥) (hij : ∥a.c i∥ ≤ ∥a.c j∥) :
-  1 - δ ≤ ∥(2 / ∥a.c i∥) • a.c i - (2 / ∥a.c j∥) • a.c j∥ :=
+  (i j : fin N.succ) (inej : i ≠ j) (hi : 2 < ‖a.c i‖) (hij : ‖a.c i‖ ≤ ‖a.c j‖) :
+  1 - δ ≤ ‖(2 / ‖a.c i‖) • a.c i - (2 / ‖a.c j‖) • a.c j‖ :=
 begin
-  have ah : ∀ i j, i ≠ j → (a.r i ≤ ∥a.c i - a.c j∥ ∧ a.r j ≤ τ * a.r i) ∨
-                          (a.r j ≤ ∥a.c j - a.c i∥ ∧ a.r i ≤ τ * a.r j),
+  have ah : ∀ i j, i ≠ j → (a.r i ≤ ‖a.c i - a.c j‖ ∧ a.r j ≤ τ * a.r i) ∨
+                          (a.r j ≤ ‖a.c j - a.c i‖ ∧ a.r i ≤ τ * a.r j),
     by simpa only [dist_eq_norm] using a.h,
   have δnonneg : 0 ≤ δ := by linarith only [hτ, hδ1],
   have τpos : 0 < τ := _root_.zero_lt_one.trans_le hτ,
-  have hcrj : ∥a.c j∥ ≤ a.r j + 1,
+  have hcrj : ‖a.c j‖ ≤ a.r j + 1,
     by simpa only [lastc, lastr, dist_zero_right] using a.inter' j,
-  have A : a.r i ≤ ∥a.c i∥,
+  have A : a.r i ≤ ‖a.c i‖,
   { have : i < last N,
     { apply lt_top_iff_ne_top.2,
       assume iN,
@@ -452,25 +455,25 @@ begin
       exact lt_irrefl _ (zero_le_two.trans_lt hi) },
     convert (a.hlast i this).1,
     rw [dist_eq_norm, lastc, sub_zero] },
-  have hj : 2 < ∥a.c j∥ := hi.trans_le hij,
-  set s := ∥a.c i∥ with hs,
+  have hj : 2 < ‖a.c j‖ := hi.trans_le hij,
+  set s := ‖a.c i‖ with hs,
   have spos : 0 < s := zero_lt_two.trans hi,
-  set d := (s/∥a.c j∥) • a.c j with hd,
-  have I : ∥a.c j - a.c i∥ ≤ ∥a.c j∥ - s + ∥d - a.c i∥ := calc
-    ∥a.c j - a.c i∥ ≤ ∥a.c j - d∥ + ∥d - a.c i∥ : by simp [← dist_eq_norm, dist_triangle]
-    ... = ∥a.c j∥ - ∥a.c i∥ + ∥d - a.c i∥ : begin
+  set d := (s/‖a.c j‖) • a.c j with hd,
+  have I : ‖a.c j - a.c i‖ ≤ ‖a.c j‖ - s + ‖d - a.c i‖ := calc
+    ‖a.c j - a.c i‖ ≤ ‖a.c j - d‖ + ‖d - a.c i‖ : by simp [← dist_eq_norm, dist_triangle]
+    ... = ‖a.c j‖ - ‖a.c i‖ + ‖d - a.c i‖ : begin
       nth_rewrite 0 ← one_smul ℝ (a.c j),
       rw [add_left_inj, hd, ← sub_smul, norm_smul, real.norm_eq_abs, abs_of_nonneg, sub_mul,
           one_mul, div_mul_cancel _ (zero_le_two.trans_lt hj).ne'],
       rwa [sub_nonneg, div_le_iff (zero_lt_two.trans hj), one_mul],
     end,
-  have J : a.r j - ∥a.c j - a.c i∥ ≤ s / 2 * δ := calc
-    a.r j - ∥a.c j - a.c i∥ ≤ s * (τ - 1) : begin
+  have J : a.r j - ‖a.c j - a.c i‖ ≤ s / 2 * δ := calc
+    a.r j - ‖a.c j - a.c i‖ ≤ s * (τ - 1) : begin
       rcases ah j i inej.symm with H|H,
-      { calc a.r j - ∥a.c j - a.c i∥ ≤ 0 : sub_nonpos.2 H.1
+      { calc a.r j - ‖a.c j - a.c i‖ ≤ 0 : sub_nonpos.2 H.1
         ... ≤ s * (τ - 1) : mul_nonneg spos.le (sub_nonneg.2 hτ) },
       { rw norm_sub_rev at H,
-        calc a.r j - ∥a.c j - a.c i∥ ≤ τ * a.r i - a.r i : sub_le_sub H.2 H.1
+        calc a.r j - ‖a.c j - a.c i‖ ≤ τ * a.r i - a.r i : sub_le_sub H.2 H.1
         ... = a.r i * (τ - 1) : by ring
         ... ≤ s * (τ - 1) : mul_le_mul_of_nonneg_right A (sub_nonneg.2 hτ) }
     end
@@ -478,9 +481,9 @@ begin
     ... = s / 2 * δ : by ring,
   have invs_nonneg : 0 ≤ 2 / s := (div_nonneg zero_le_two (zero_le_two.trans hi.le)),
   calc 1 - δ = (2 / s) * (s / 2 - (s / 2) * δ) : by { field_simp [spos.ne'], ring }
-  ... ≤ (2 / s) * ∥d - a.c i∥ :
+  ... ≤ (2 / s) * ‖d - a.c i‖ :
     mul_le_mul_of_nonneg_left (by linarith only [hcrj, I, J, hi]) invs_nonneg
-  ... = ∥(2 / s) • a.c i - (2 / ∥a.c j∥) • a.c j∥ : begin
+  ... = ‖(2 / s) • a.c i - (2 / ‖a.c j‖) • a.c j‖ : begin
     conv_lhs { rw [norm_sub_rev, ← abs_of_nonneg invs_nonneg] },
     rw [← real.norm_eq_abs, ← norm_smul, smul_sub, hd, smul_smul],
     congr' 3,
@@ -491,33 +494,31 @@ end
 lemma exists_normalized {N : ℕ} {τ : ℝ} (a : satellite_config E N τ)
   (lastc : a.c (last N) = 0) (lastr : a.r (last N) = 1)
   (hτ : 1 ≤ τ) (δ : ℝ) (hδ1 : τ ≤ 1 + δ / 4) (hδ2 : δ ≤ 1) :
-  ∃ (c' : fin N.succ → E), (∀ n, ∥c' n∥ ≤ 2) ∧ (∀ i j, i ≠ j → 1 - δ ≤ ∥c' i - c' j∥) :=
+  ∃ (c' : fin N.succ → E), (∀ n, ‖c' n‖ ≤ 2) ∧ (∀ i j, i ≠ j → 1 - δ ≤ ‖c' i - c' j‖) :=
 begin
-  let c' : fin N.succ → E := λ i, if ∥a.c i∥ ≤ 2 then a.c i else (2 / ∥a.c i∥) • a.c i,
-  have norm_c'_le : ∀ i, ∥c' i∥ ≤ 2,
+  let c' : fin N.succ → E := λ i, if ‖a.c i‖ ≤ 2 then a.c i else (2 / ‖a.c i‖) • a.c i,
+  have norm_c'_le : ∀ i, ‖c' i‖ ≤ 2,
   { assume i,
     simp only [c'],
     split_ifs, { exact h },
-    by_cases hi : ∥a.c i∥ = 0;
+    by_cases hi : ‖a.c i‖ = 0;
     field_simp [norm_smul, hi] },
   refine ⟨c', λ n, norm_c'_le n, λ i j inej, _⟩,
   -- up to exchanging `i` and `j`, one can assume `∥c i∥ ≤ ∥c j∥`.
-  wlog hij : ∥a.c i∥ ≤ ∥a.c j∥ := le_total (∥a.c i∥) (∥a.c j∥) using [i j, j i] tactic.skip, swap,
-  { assume i_ne_j,
-    rw norm_sub_rev,
-    exact this i_ne_j.symm },
-  rcases le_or_lt (∥a.c j∥) 2 with Hj|Hj,
+  wlog hij : ‖a.c i‖ ≤ ‖a.c j‖ generalizing i j,
+  { rw norm_sub_rev, exact this j i inej.symm (le_of_not_le hij) },
+  rcases le_or_lt (‖a.c j‖) 2 with Hj|Hj,
   -- case `∥c j∥ ≤ 2` (and therefore also `∥c i∥ ≤ 2`)
   { simp_rw [c', Hj, hij.trans Hj, if_true],
     exact exists_normalized_aux1 a lastr hτ δ hδ1 hδ2 i j inej },
-  -- case `2 < ∥c j∥`
-  { have H'j : (∥a.c j∥ ≤ 2) ↔ false, by simpa only [not_le, iff_false] using Hj,
-    rcases le_or_lt (∥a.c i∥) 2 with Hi|Hi,
-    { -- case `∥c i∥ ≤ 2`
+  -- case `2 < ‖c j‖`
+  { have H'j : (‖a.c j‖ ≤ 2) ↔ false, by simpa only [not_le, iff_false] using Hj,
+    rcases le_or_lt (‖a.c i‖) 2 with Hi|Hi,
+    { -- case `‖c i‖ ≤ 2`
       simp_rw [c', Hi, if_true, H'j, if_false],
       exact exists_normalized_aux2 a lastc lastr hτ δ hδ1 hδ2 i j inej Hi Hj },
-    { -- case `2 < ∥c i∥`
-      have H'i : (∥a.c i∥ ≤ 2) ↔ false, by simpa only [not_le, iff_false] using Hi,
+    { -- case `2 < ‖c i‖`
+      have H'i : (‖a.c i‖ ≤ 2) ↔ false, by simpa only [not_le, iff_false] using Hi,
       simp_rw [c', H'i, if_false, H'j, if_false],
       exact exists_normalized_aux3 a lastc lastr hτ δ hδ1 i j inej Hi hij } }
 end
diff --git a/src/measure_theory/covering/density_theorem.lean b/src/measure_theory/covering/density_theorem.lean
new file mode 100644
index 0000000000000..143854e2f2ca9
--- /dev/null
+++ b/src/measure_theory/covering/density_theorem.lean
@@ -0,0 +1,180 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import measure_theory.measure.doubling
+import measure_theory.covering.vitali
+import measure_theory.covering.differentiation
+
+/-!
+# Uniformly locally doubling measures and Lebesgue's density theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Lebesgue's density theorem states that given a set `S` in a sigma compact metric space with
+locally-finite uniformly locally doubling measure `μ` then for almost all points `x` in `S`, for any
+sequence of closed balls `B₀, B₁, B₂, ...` containing `x`, the limit `μ (S ∩ Bⱼ) / μ (Bⱼ) → 1` as
+`j → ∞`.
+
+In this file we combine general results about existence of Vitali families for uniformly locally
+doubling measures with results about differentiation along a Vitali family to obtain an explicit
+form of Lebesgue's density theorem.
+
+## Main results
+  * `is_unif_loc_doubling_measure.ae_tendsto_measure_inter_div`: a version of Lebesgue's density
+  theorem for sequences of balls converging on a point but whose centres are not required to be
+  fixed.
+
+-/
+
+noncomputable theory
+
+open set filter metric measure_theory topological_space
+open_locale nnreal topology
+
+namespace is_unif_loc_doubling_measure
+
+variables {α : Type*} [metric_space α] [measurable_space α]
+          (μ : measure α) [is_unif_loc_doubling_measure μ]
+
+section
+variables [second_countable_topology α] [borel_space α] [is_locally_finite_measure μ]
+
+open_locale topology
+
+/-- A Vitali family in a space with a uniformly locally doubling measure, designed so that the sets
+at `x` contain all `closed_ball y r` when `dist x y ≤ K * r`. -/
+@[irreducible] def vitali_family (K : ℝ) : vitali_family μ :=
+begin
+  /- the Vitali covering theorem gives a family that works well at small scales, thanks to the
+  doubling property. We enlarge this family to add large sets, to make sure that all balls and not
+  only small ones belong to the family, for convenience. -/
+  let R := scaling_scale_of μ (max (4 * K + 3) 3),
+  have Rpos : 0 < R := scaling_scale_of_pos _ _,
+  have A : ∀ (x : α), ∃ᶠ r in 𝓝[>] (0 : ℝ),
+    μ (closed_ball x (3 * r)) ≤ scaling_constant_of μ (max (4 * K + 3) 3) * μ (closed_ball x r),
+  { assume x,
+    apply frequently_iff.2 (λ U hU, _),
+    obtain ⟨ε, εpos, hε⟩ := mem_nhds_within_Ioi_iff_exists_Ioc_subset.1 hU,
+    refine ⟨min ε R, hε ⟨lt_min εpos Rpos, min_le_left _ _⟩, _⟩,
+    exact measure_mul_le_scaling_constant_of_mul μ
+      ⟨zero_lt_three, le_max_right _ _⟩ (min_le_right _ _) },
+  exact (vitali.vitali_family μ (scaling_constant_of μ (max (4 * K + 3) 3)) A).enlarge
+    (R / 4) (by linarith),
+end
+
+/-- In the Vitali family `is_unif_loc_doubling_measure.vitali_family K`, the sets based at `x`
+contain all balls `closed_ball y r` when `dist x y ≤ K * r`. -/
+lemma closed_ball_mem_vitali_family_of_dist_le_mul
+  {K : ℝ} {x y : α} {r : ℝ} (h : dist x y ≤ K * r) (rpos : 0 < r) :
+  closed_ball y r ∈ (vitali_family μ K).sets_at x :=
+begin
+  let R := scaling_scale_of μ (max (4 * K + 3) 3),
+  simp only [vitali_family, vitali_family.enlarge, vitali.vitali_family, mem_union, mem_set_of_eq,
+    is_closed_ball, true_and, (nonempty_ball.2 rpos).mono ball_subset_interior_closed_ball,
+    measurable_set_closed_ball],
+  /- The measure is doubling on scales smaller than `R`. Therefore, we treat differently small
+  and large balls. For large balls, this follows directly from the enlargement we used in the
+  definition. -/
+  by_cases H : closed_ball y r ⊆ closed_ball x (R / 4),
+  swap, { exact or.inr H },
+  left,
+  /- For small balls, there is the difficulty that `r` could be large but still the ball could be
+  small, if the annulus `{y | ε ≤ dist y x ≤ R/4}` is empty. We split between the cases `r ≤ R`
+  and `r < R`, and use the doubling for the former and rough estimates for the latter. -/
+  rcases le_or_lt r R with hr|hr,
+  { refine ⟨(K + 1) * r, _⟩,
+    split,
+    { apply closed_ball_subset_closed_ball',
+      rw dist_comm,
+      linarith },
+    { have I1 : closed_ball x (3 * ((K + 1) * r)) ⊆ closed_ball y ((4 * K + 3) * r),
+      { apply closed_ball_subset_closed_ball',
+        linarith },
+      have I2 : closed_ball y ((4 * K + 3) * r) ⊆ closed_ball y ((max (4 * K + 3) 3) * r),
+      { apply closed_ball_subset_closed_ball,
+        exact mul_le_mul_of_nonneg_right (le_max_left _ _) rpos.le },
+      apply (measure_mono (I1.trans I2)).trans,
+      exact measure_mul_le_scaling_constant_of_mul _
+        ⟨zero_lt_three.trans_le (le_max_right _ _), le_rfl⟩ hr } },
+  { refine ⟨R / 4, H, _⟩,
+    have : closed_ball x (3 * (R / 4)) ⊆ closed_ball y r,
+    { apply closed_ball_subset_closed_ball',
+      have A : y ∈ closed_ball y r, from mem_closed_ball_self rpos.le,
+      have B := mem_closed_ball'.1 (H A),
+      linarith },
+    apply (measure_mono this).trans _,
+    refine le_mul_of_one_le_left (zero_le _) _,
+    exact ennreal.one_le_coe_iff.2 (le_max_right _ _) }
+end
+
+lemma tendsto_closed_ball_filter_at {K : ℝ} {x : α} {ι : Type*} {l : filter ι}
+  (w : ι → α) (δ : ι → ℝ) (δlim : tendsto δ l (𝓝[>] 0))
+  (xmem : ∀ᶠ j in l, x ∈ closed_ball (w j) (K * δ j)) :
+  tendsto (λ j, closed_ball (w j) (δ j)) l ((vitali_family μ K).filter_at x) :=
+begin
+  refine (vitali_family μ K).tendsto_filter_at_iff.mpr ⟨_, λ ε hε, _⟩,
+  { filter_upwards [xmem, δlim self_mem_nhds_within] with j hj h'j,
+    exact closed_ball_mem_vitali_family_of_dist_le_mul μ hj h'j },
+  { by_cases l.ne_bot,
+    swap, { simp [not_ne_bot.1 h] },
+    have hK : 0 ≤ K,
+    { resetI,
+      rcases (xmem.and (δlim self_mem_nhds_within)).exists with ⟨j, hj, h'j⟩,
+      have : 0 ≤ K * δ j := nonempty_closed_ball.1 ⟨x, hj⟩,
+      exact (mul_nonneg_iff_left_nonneg_of_pos (mem_Ioi.1 h'j)).1 this },
+    have δpos := eventually_mem_of_tendsto_nhds_within δlim,
+    replace δlim := tendsto_nhds_of_tendsto_nhds_within δlim,
+    replace hK : 0 < K + 1, by linarith,
+    apply (((metric.tendsto_nhds.mp δlim _ (div_pos hε hK)).and δpos).and xmem).mono,
+    rintros j ⟨⟨hjε, hj₀ : 0 < δ j⟩, hx⟩ y hy,
+    replace hjε : (K + 1) * δ j < ε :=
+      by simpa [abs_eq_self.mpr hj₀.le] using (lt_div_iff' hK).mp hjε,
+    simp only [mem_closed_ball] at hx hy ⊢,
+    linarith [dist_triangle_right y x (w j)] }
+end
+
+end
+
+section applications
+variables [second_countable_topology α] [borel_space α] [is_locally_finite_measure μ]
+  {E : Type*} [normed_add_comm_group E]
+
+/-- A version of *Lebesgue's density theorem* for a sequence of closed balls whose centers are
+not required to be fixed.
+
+See also `besicovitch.ae_tendsto_measure_inter_div`. -/
+lemma ae_tendsto_measure_inter_div (S : set α) (K : ℝ) :
+  ∀ᵐ x ∂μ.restrict S, ∀ {ι : Type*} {l : filter ι} (w : ι → α) (δ : ι → ℝ)
+    (δlim : tendsto δ l (𝓝[>] 0))
+    (xmem : ∀ᶠ j in l, x ∈ closed_ball (w j) (K * δ j)),
+    tendsto (λ j, μ (S ∩ closed_ball (w j) (δ j)) / μ (closed_ball (w j) (δ j))) l (𝓝 1) :=
+by filter_upwards [(vitali_family μ K).ae_tendsto_measure_inter_div S] with x hx ι l w δ δlim xmem
+using hx.comp (tendsto_closed_ball_filter_at μ _ _ δlim xmem)
+
+/-- A version of *Lebesgue differentiation theorem* for a sequence of closed balls whose
+centers are not required to be fixed. -/
+lemma ae_tendsto_average_norm_sub {f : α → E} (hf : integrable f μ) (K : ℝ) :
+  ∀ᵐ x ∂μ, ∀ {ι : Type*} {l : filter ι} (w : ι → α) (δ : ι → ℝ)
+    (δlim : tendsto δ l (𝓝[>] 0))
+    (xmem : ∀ᶠ j in l, x ∈ closed_ball (w j) (K * δ j)),
+    tendsto (λ j, ⨍ y in closed_ball (w j) (δ j), ‖f y - f x‖ ∂μ) l (𝓝 0) :=
+by filter_upwards [(vitali_family μ K).ae_tendsto_average_norm_sub hf] with x hx ι l w δ δlim xmem
+using hx.comp (tendsto_closed_ball_filter_at μ _ _ δlim xmem)
+
+/-- A version of *Lebesgue differentiation theorem* for a sequence of closed balls whose
+centers are not required to be fixed. -/
+lemma ae_tendsto_average [normed_space ℝ E] [complete_space E]
+  {f : α → E} (hf : integrable f μ) (K : ℝ) :
+  ∀ᵐ x ∂μ, ∀ {ι : Type*} {l : filter ι} (w : ι → α) (δ : ι → ℝ)
+    (δlim : tendsto δ l (𝓝[>] 0))
+    (xmem : ∀ᶠ j in l, x ∈ closed_ball (w j) (K * δ j)),
+    tendsto (λ j, ⨍ y in closed_ball (w j) (δ j), f y ∂μ) l (𝓝 (f x)) :=
+by filter_upwards [(vitali_family μ K).ae_tendsto_average hf] with x hx ι l w δ δlim xmem
+using hx.comp (tendsto_closed_ball_filter_at μ _ _ δlim xmem)
+
+end applications
+
+end is_unif_loc_doubling_measure
diff --git a/src/measure_theory/covering/differentiation.lean b/src/measure_theory/covering/differentiation.lean
index 85b3575e833fc..7cf9a8478abf0 100644
--- a/src/measure_theory/covering/differentiation.lean
+++ b/src/measure_theory/covering/differentiation.lean
@@ -7,13 +7,17 @@ import measure_theory.covering.vitali_family
 import measure_theory.measure.regular
 import measure_theory.function.ae_measurable_order
 import measure_theory.integral.lebesgue
-import measure_theory.decomposition.radon_nikodym
+import measure_theory.integral.average
+import measure_theory.decomposition.lebesgue
 
 /-!
 # Differentiation of measures
 
-On a metric space with a measure `μ`, consider a Vitali family (i.e., for each `x` one has a family
-of sets shrinking to `x`, with a good behavior with respect to covering theorems).
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+On a second countable metric space with a measure `μ`, consider a Vitali family (i.e., for each `x`
+one has a family of sets shrinking to `x`, with a good behavior with respect to covering theorems).
 Consider also another measure `ρ`. Then, for almost every `x`, the ratio `ρ a / μ a` converges when
 `a` shrinks to `x` along the Vitali family, towards the Radon-Nikodym derivative of `ρ` with
 respect to `μ`. This is the main theorem on differentiation of measures.
@@ -26,6 +30,13 @@ ratio really makes sense.
 For concrete applications, one needs concrete instances of Vitali families, as provided for instance
 by `besicovitch.vitali_family` (for balls) or by `vitali.vitali_family` (for doubling measures).
 
+Specific applications to Lebesgue density points and the Lebesgue differentiation theorem are also
+derived:
+* `vitali_family.ae_tendsto_measure_inter_div` states that, for almost every point `x ∈ s`,
+  then `μ (s ∩ a) / μ a` tends to `1` as `a` shrinks to `x` along a Vitali family.
+* `vitali_family.ae_tendsto_average_norm_sub` states that, for almost every point `x`, then the
+  average of `y ↦ ‖f y - f x‖` on `a` tends to `0` as `a` shrinks to `x` along a Vitali family.
+
 ## Sketch of proof
 
 Let `v` be a Vitali family for `μ`. Assume for simplicity that `ρ` is absolutely continuous with
@@ -48,18 +59,31 @@ almost everywhere measurable, again based on the disjoint subcovering argument
 (see `vitali_family.exists_measurable_supersets_lim_ratio`), and then proceed as sketched above
 but replacing `v.lim_ratio ρ` by a measurable version called `v.lim_ratio_meas ρ`.
 
+## Counterexample
+
+The standing assumption in this file is that spaces are second countable. Without this assumption,
+measures may be zero locally but nonzero globally, which is not compatible with differentiation
+theory (which deduces global information from local one). Here is an example displaying this
+behavior.
+
+Define a measure `μ` by `μ s = 0` if `s` is covered by countably many balls of radius `1`,
+and `μ s = ∞` otherwise. This is indeed a countably additive measure, which is moreover
+locally finite and doubling at small scales. It vanishes on every ball of radius `1`, so all the
+quantities in differentiation theory (defined as ratios of measures as the radius tends to zero)
+make no sense. However, the measure is not globally zero if the space is big enough.
+
 ## References
 
 * [Herbert Federer, Geometric Measure Theory, Chapter 2.9][Federer1996]
 -/
 
 open measure_theory metric set filter topological_space measure_theory.measure
-open_locale filter ennreal measure_theory nnreal topological_space
-
-local attribute [instance] emetric.second_countable_of_sigma_compact
+open_locale filter ennreal measure_theory nnreal topology
 
 variables {α : Type*} [metric_space α] {m0 : measurable_space α}
 {μ : measure α} (v : vitali_family μ)
+{E : Type*} [normed_add_comm_group E]
+
 include v
 
 namespace vitali_family
@@ -103,7 +127,7 @@ end
 
 /-- If two measures `ρ` and `ν` have, at every point of a set `s`, arbitrarily small sets in a
 Vitali family satisfying `ρ a ≤ ν a`, then `ρ s ≤ ν s` if `ρ ≪ μ`.-/
-theorem measure_le_of_frequently_le [sigma_compact_space α] [borel_space α]
+theorem measure_le_of_frequently_le [second_countable_topology α] [borel_space α]
   {ρ : measure α} (ν : measure α) [is_locally_finite_measure ν]
   (hρ : ρ ≪ μ) (s : set α) (hs : ∀ x ∈ s, ∃ᶠ a in v.filter_at x, ρ a ≤ ν a) :
   ρ s ≤ ν s :=
@@ -131,13 +155,13 @@ end
 
 section
 
-variables [sigma_compact_space α] [borel_space α] [is_locally_finite_measure μ]
+variables [second_countable_topology α] [borel_space α] [is_locally_finite_measure μ]
   {ρ : measure α} [is_locally_finite_measure ρ]
 
 /-- If a measure `ρ` is singular with respect to `μ`, then for `μ` almost every `x`, the ratio
 `ρ a / μ a` tends to zero when `a` shrinks to `x` along the Vitali family. This makes sense
 as `μ a` is eventually positive by `ae_eventually_measure_pos`. -/
-lemma ae_eventually_measure_zero_of_singular (hρ : ρ ⊥ₘ μ) :
+lemma ae_eventually_measure_zero_of_singular (hρ : ρ ⟂ₘ μ) :
   ∀ᵐ x ∂μ, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 0) :=
 begin
   have A : ∀ ε > (0 : ℝ≥0), ∀ᵐ x ∂μ, ∀ᶠ a in v.filter_at x, ρ a < ε * μ a,
@@ -157,14 +181,14 @@ begin
       rw [ennreal.mul_inv_cancel (ennreal.coe_pos.2 εpos).ne' ennreal.coe_ne_top, one_mul],
     end
     ... ≤ ε⁻¹ * ρ (s ∩ o) : begin
-      apply ennreal.mul_le_mul le_rfl,
+      refine mul_le_mul_left' _ _,
       refine v.measure_le_of_frequently_le ρ ((measure.absolutely_continuous.refl μ).smul ε) _ _,
       assume x hx,
       rw hs at hx,
-      simp only [mem_inter_eq, not_lt, not_eventually, mem_set_of_eq] at hx,
+      simp only [mem_inter_iff, not_lt, not_eventually, mem_set_of_eq] at hx,
       exact hx.1
     end
-    ... ≤ ε⁻¹ * ρ o : ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_right _ _))
+    ... ≤ ε⁻¹ * ρ o : mul_le_mul_left' (measure_mono (inter_subset_right _ _)) _
     ... = 0 : by rw [ρo, mul_zero] },
   obtain ⟨u, u_anti, u_pos, u_lim⟩ :
     ∃ (u : ℕ → ℝ≥0), strict_anti u ∧ (∀ (n : ℕ), 0 < u n) ∧ tendsto u at_top (𝓝 0) :=
@@ -181,7 +205,7 @@ begin
   filter_upwards [hx n, h'x, v.eventually_measure_lt_top x],
   assume a ha μa_pos μa_lt_top,
   rw ennreal.div_lt_iff (or.inl μa_pos.ne') (or.inl μa_lt_top.ne),
-  exact ha.trans_le (ennreal.mul_le_mul ((ennreal.coe_le_coe.2 hn.le).trans w_lt.le) le_rfl)
+  exact ha.trans_le (mul_le_mul_right' ((ennreal.coe_le_coe.2 hn.le).trans w_lt.le) _)
 end
 
 section absolutely_continuous
@@ -218,7 +242,7 @@ the ratio `ρ a / μ a` converges as `a` shrinks to `x` along a Vitali family fo
 theorem ae_tendsto_div :
   ∀ᵐ x ∂μ, ∃ c, tendsto (λ a, ρ a / μ a) (v.filter_at x) (𝓝 c) :=
 begin
-  obtain ⟨w, w_count, w_dense, w_zero, w_top⟩ : ∃ w : set ℝ≥0∞, countable w ∧ dense w ∧
+  obtain ⟨w, w_count, w_dense, w_zero, w_top⟩ : ∃ w : set ℝ≥0∞, w.countable ∧ dense w ∧
     0 ∉ w ∧ ∞ ∉ w := ennreal.exists_countable_dense_no_zero_top,
   have I : ∀ x ∈ w, x ≠ ∞ := λ x xs hx, w_top (hx ▸ xs),
   have A : ∀ (c ∈ w) (d ∈ w), (c < d) → ∀ᵐ x ∂μ,
@@ -228,19 +252,19 @@ begin
     lift d to ℝ≥0 using I d hd,
     apply v.null_of_frequently_le_of_frequently_ge hρ (ennreal.coe_lt_coe.1 hcd),
     { simp only [and_imp, exists_prop, not_frequently, not_and, not_lt, not_le, not_eventually,
-        mem_set_of_eq, mem_compl_eq, not_forall],
+        mem_set_of_eq, mem_compl_iff, not_forall],
       assume x h1x h2x,
       apply h1x.mono (λ a ha, _),
       refine (ennreal.div_le_iff_le_mul _ (or.inr (bot_le.trans_lt ha).ne')).1 ha.le,
       simp only [ennreal.coe_ne_top, ne.def, or_true, not_false_iff] },
     { simp only [and_imp, exists_prop, not_frequently, not_and, not_lt, not_le, not_eventually,
-        mem_set_of_eq, mem_compl_eq, not_forall],
+        mem_set_of_eq, mem_compl_iff, not_forall],
       assume x h1x h2x,
       apply h2x.mono (λ a ha, _),
       exact ennreal.mul_le_of_le_div ha.le } },
   have B : ∀ᵐ x ∂μ, ∀ (c ∈ w) (d ∈ w), (c < d) →
     ¬((∃ᶠ a in v.filter_at x, ρ a / μ a < c) ∧ (∃ᶠ a in v.filter_at x, d < ρ a / μ a)),
-    by simpa only [ae_ball_iff w_count, ae_imp_iff],
+    by simpa only [ae_ball_iff w_count, ae_all_iff],
   filter_upwards [B],
   assume x hx,
   exact tendsto_of_no_upcrossings w_dense hx,
@@ -432,7 +456,7 @@ begin
     ... ≤ p * μ (s ∩ t) + 0 :
       add_le_add H ((measure_mono (inter_subset_right _ _)).trans (hρ A).le)
     ... ≤ p * μ s :
-      by { rw add_zero, exact ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_left _ _)) },
+      by { rw add_zero, exact mul_le_mul_left' (measure_mono (inter_subset_left _ _)) _ },
   refine v.measure_le_of_frequently_le _ hρ _ (λ x hx, _),
   have I : ∀ᶠ (b : set α) in v.filter_at x, ρ b / μ b < p := (tendsto_order.1 hx.2).2 _ (h hx.1),
   apply I.frequently.mono (λ a ha, _),
@@ -456,7 +480,7 @@ begin
     ... ≤ ρ (s ∩ t) + q * μ tᶜ : begin
         apply add_le_add H,
         rw [coe_nnreal_smul_apply],
-        exact ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_right _ _)),
+        exact mul_le_mul_left' (measure_mono (inter_subset_right _ _)) _,
       end
     ... ≤ ρ s :
       by { rw [A, mul_zero, add_zero], exact measure_mono (inter_subset_left _ _) },
@@ -563,7 +587,7 @@ begin
         abel,
       end
     ... ≤ t^2 * ρ (s ∩ f ⁻¹' I) : begin
-        apply ennreal.mul_le_mul le_rfl _,
+        refine mul_le_mul_left' _ _,
         rw ← ennreal.coe_zpow (zero_lt_one.trans ht).ne',
         apply v.mul_measure_le_of_subset_lt_lim_ratio_meas hρ,
         assume x hx,
@@ -573,7 +597,7 @@ begin
         conv_rhs { rw ← mul_one (t^ n) },
         refine mul_lt_mul' le_rfl _ (zero_le _) (nnreal.zpow_pos t_ne_zero' _),
         rw zpow_neg_one,
-        exact nnreal.inv_lt_one ht,
+        exact inv_lt_one ht,
       end },
   calc ν s = ν (s ∩ f⁻¹' {0}) + ν (s ∩ f⁻¹' {∞}) + ∑' (n : ℤ), ν (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :
     measure_eq_measure_preimage_add_measure_tsum_Ico_zpow ν f_meas hs ht
@@ -625,7 +649,7 @@ begin
     ... ≤ ∫⁻ x in s ∩ f⁻¹' I, t * f x ∂μ : begin
         apply lintegral_mono_ae ((ae_restrict_iff' M).2 (eventually_of_forall (λ x hx, _))),
         rw [add_comm, ennreal.zpow_add t_ne_zero ennreal.coe_ne_top, zpow_one],
-        exact ennreal.mul_le_mul le_rfl hx.2.1,
+        exact mul_le_mul_left' hx.2.1 _,
       end
     ... = t * ∫⁻ x in s ∩ f⁻¹' I, f x ∂μ : lintegral_const_mul _ f_meas },
   calc ρ s = ρ (s ∩ f⁻¹' {0}) + ρ (s ∩ f⁻¹' {∞}) + ∑' (n : ℤ), ρ (s ∩ f⁻¹' (Ico (t^n) (t^(n+1)))) :
@@ -706,6 +730,8 @@ begin
   { simp only [Bx, zero_add] }
 end
 
+/-! ### Lebesgue density points -/
+
 /-- Given a measurable set `s`, then `μ (s ∩ a) / μ a` converges when `a` shrinks to a typical
 point `x` along a Vitali family. The limit is `1` for `x ∈ s` and `0` for `x ∉ s`. This shows that
 almost every point of `s` is a Lebesgue density point for `s`. A version for non-measurable sets
@@ -745,6 +771,173 @@ begin
   exact measure_to_measurable_inter_of_sigma_finite ha _,
 end
 
+/-! ### Lebesgue differentiation theorem -/
+
+lemma ae_tendsto_lintegral_div' {f : α → ℝ≥0∞} (hf : measurable f) (h'f : ∫⁻ y, f y ∂μ ≠ ∞) :
+  ∀ᵐ x ∂μ, tendsto (λ a, (∫⁻ y in a, f y ∂μ) / μ a) (v.filter_at x) (𝓝 (f x)) :=
+begin
+  let ρ := μ.with_density f,
+  haveI : is_finite_measure ρ, from is_finite_measure_with_density h'f,
+  filter_upwards [ae_tendsto_rn_deriv v ρ, rn_deriv_with_density μ hf] with x hx h'x,
+  rw ← h'x,
+  apply hx.congr' _,
+  filter_upwards [v.eventually_filter_at_measurable_set] with a ha,
+  rw ← with_density_apply f ha,
+end
+
+lemma ae_tendsto_lintegral_div {f : α → ℝ≥0∞} (hf : ae_measurable f μ) (h'f : ∫⁻ y, f y ∂μ ≠ ∞) :
+  ∀ᵐ x ∂μ, tendsto (λ a, (∫⁻ y in a, f y ∂μ) / μ a) (v.filter_at x) (𝓝 (f x)) :=
+begin
+  have A : ∫⁻ y, hf.mk f y ∂μ ≠ ∞,
+  { convert h'f using 1,
+    apply lintegral_congr_ae,
+    exact hf.ae_eq_mk.symm },
+  filter_upwards [v.ae_tendsto_lintegral_div' hf.measurable_mk A, hf.ae_eq_mk] with x hx h'x,
+  rw h'x,
+  convert hx,
+  ext1 a,
+  congr' 1,
+  apply lintegral_congr_ae,
+  exact ae_restrict_of_ae (hf.ae_eq_mk)
+end
+
+lemma ae_tendsto_lintegral_nnnorm_sub_div'
+  {f : α → E} (hf : integrable f μ) (h'f : strongly_measurable f) :
+  ∀ᵐ x ∂μ, tendsto (λ a, (∫⁻ y in a, ‖f y - f x‖₊ ∂μ) / μ a) (v.filter_at x) (𝓝 0) :=
+begin
+  /- For every `c`, then `(∫⁻ y in a, ‖f y - c‖₊ ∂μ) / μ a` tends almost everywhere to `‖f x - c‖`.
+  We apply this to a countable set of `c` which is dense in the range of `f`, to deduce the desired
+  convergence.
+  A minor technical inconvenience is that constants are not integrable, so to apply previous lemmas
+  we need to replace `c` with the restriction of `c` to a finite measure set `A n` in the
+  above sketch. -/
+  let A := measure_theory.measure.finite_spanning_sets_in_open' μ,
+  rcases h'f.is_separable_range with ⟨t, t_count, ht⟩,
+  have main : ∀ᵐ x ∂μ, ∀ (n : ℕ) (c : E) (hc : c ∈ t),
+    tendsto (λ a, (∫⁻ y in a, ‖f y - (A.set n).indicator (λ y, c) y‖₊ ∂μ) / μ a)
+    (v.filter_at x) (𝓝 (‖f x - (A.set n).indicator (λ y, c) x‖₊)),
+  { simp_rw [ae_all_iff, ae_ball_iff t_count],
+    assume n c hc,
+    apply ae_tendsto_lintegral_div',
+    { refine (h'f.sub _).ennnorm,
+      exact strongly_measurable_const.indicator (is_open.measurable_set (A.set_mem n)) },
+    { apply ne_of_lt,
+      calc ∫⁻ y, ↑‖f y - (A.set n).indicator (λ (y : α), c) y‖₊ ∂μ
+          ≤ ∫⁻ y, (‖f y‖₊ + ‖(A.set n).indicator (λ (y : α), c) y‖₊) ∂μ :
+        begin
+          apply lintegral_mono,
+          assume x,
+          dsimp,
+          rw ← ennreal.coe_add,
+          exact ennreal.coe_le_coe.2 (nnnorm_sub_le _ _),
+        end
+      ... = ∫⁻ y, ‖f y‖₊ ∂μ + ∫⁻ y, ‖(A.set n).indicator (λ (y : α), c) y‖₊ ∂μ :
+        lintegral_add_left h'f.ennnorm _
+      ... < ∞ + ∞ :
+        begin
+          have I : integrable ((A.set n).indicator (λ (y : α), c)) μ,
+            by simp only [integrable_indicator_iff (is_open.measurable_set (A.set_mem n)),
+              integrable_on_const, A.finite n, or_true],
+          exact ennreal.add_lt_add hf.2 I.2,
+        end } },
+  filter_upwards [main, v.ae_eventually_measure_pos] with x hx h'x,
+  have M : ∀ c ∈ t, tendsto (λ a, (∫⁻ y in a, ‖f y - c‖₊ ∂μ) / μ a)
+    (v.filter_at x) (𝓝 (‖f x - c‖₊)),
+  { assume c hc,
+    obtain ⟨n, xn⟩ : ∃ n, x ∈ A.set n, by simpa [← A.spanning] using mem_univ x,
+    specialize hx n c hc,
+    simp only [xn, indicator_of_mem] at hx,
+    apply hx.congr' _,
+    filter_upwards [v.eventually_filter_at_subset_of_nhds (is_open.mem_nhds (A.set_mem n) xn),
+      v.eventually_filter_at_measurable_set]
+      with a ha h'a,
+    congr' 1,
+    apply set_lintegral_congr_fun h'a,
+    apply eventually_of_forall (λ y, _),
+    assume hy,
+    simp only [ha hy, indicator_of_mem] },
+  apply ennreal.tendsto_nhds_zero.2 (λ ε εpos, _),
+  obtain ⟨c, ct, xc⟩ : ∃ c ∈ t, (‖f x - c‖₊ : ℝ≥0∞) < ε / 2,
+  { simp_rw ← edist_eq_coe_nnnorm_sub,
+    have : f x ∈ closure t, from ht (mem_range_self _),
+    exact emetric.mem_closure_iff.1 this (ε / 2) (ennreal.half_pos (ne_of_gt εpos)) },
+  filter_upwards [(tendsto_order.1 (M c ct)).2 (ε / 2) xc, h'x, v.eventually_measure_lt_top x]
+    with a ha h'a h''a,
+  apply ennreal.div_le_of_le_mul,
+  calc ∫⁻ y in a, ‖f y - f x‖₊ ∂μ
+      ≤ ∫⁻ y in a, ‖f y - c‖₊ + ‖f x - c‖₊ ∂μ :
+    begin
+      apply lintegral_mono (λ x, _),
+      simpa only [← edist_eq_coe_nnnorm_sub] using edist_triangle_right _ _ _,
+    end
+  ... = ∫⁻ y in a, ‖f y - c‖₊ ∂μ + ∫⁻ y in a, ‖f x - c‖₊ ∂μ :
+    lintegral_add_right _ measurable_const
+  ... ≤ ε / 2 * μ a + ε / 2 * μ a :
+    begin
+      refine add_le_add _ _,
+      { rw ennreal.div_lt_iff (or.inl (h'a.ne')) (or.inl (h''a.ne)) at ha,
+        exact ha.le },
+      { simp only [lintegral_const, measure.restrict_apply, measurable_set.univ, univ_inter],
+        exact mul_le_mul_right' xc.le _ }
+    end
+  ... = ε * μ a : by rw [← add_mul, ennreal.add_halves]
+end
+
+lemma ae_tendsto_lintegral_nnnorm_sub_div {f : α → E} (hf : integrable f μ) :
+  ∀ᵐ x ∂μ, tendsto (λ a, (∫⁻ y in a, ‖f y - f x‖₊ ∂μ) / μ a) (v.filter_at x) (𝓝 0) :=
+begin
+  have I : integrable (hf.1.mk f) μ, from hf.congr hf.1.ae_eq_mk,
+  filter_upwards [v.ae_tendsto_lintegral_nnnorm_sub_div' I hf.1.strongly_measurable_mk,
+    hf.1.ae_eq_mk] with x hx h'x,
+  apply hx.congr _,
+  assume a,
+  congr' 1,
+  apply lintegral_congr_ae,
+  apply ae_restrict_of_ae,
+  filter_upwards [hf.1.ae_eq_mk] with y hy,
+  rw [hy, h'x]
+end
+
+/-- *Lebesgue differentiation theorem*: for almost every point `x`, the
+average of `‖f y - f x‖` on `a` tends to `0` as `a` shrinks to `x` along a Vitali family.-/
+lemma ae_tendsto_average_norm_sub {f : α → E} (hf : integrable f μ) :
+  ∀ᵐ x ∂μ, tendsto (λ a, ⨍ y in a, ‖f y - f x‖ ∂μ) (v.filter_at x) (𝓝 0) :=
+begin
+  filter_upwards [v.ae_tendsto_lintegral_nnnorm_sub_div hf, v.ae_eventually_measure_pos]
+    with x hx h'x,
+  have := (ennreal.tendsto_to_real ennreal.zero_ne_top).comp hx,
+  simp only [ennreal.zero_to_real] at this,
+  apply tendsto.congr' _ this,
+  filter_upwards [h'x, v.eventually_measure_lt_top x] with a ha h'a,
+  simp only [function.comp_app, ennreal.to_real_div, set_average_eq, div_eq_inv_mul],
+  have A : integrable_on (λ y, (‖f y - f x‖₊ : ℝ)) a μ,
+  { simp_rw [coe_nnnorm],
+    exact (hf.integrable_on.sub (integrable_on_const.2 (or.inr h'a))).norm },
+  rw [lintegral_coe_eq_integral _ A, ennreal.to_real_of_real],
+  { simp_rw [coe_nnnorm],
+    refl },
+  { apply integral_nonneg,
+    assume x,
+    exact nnreal.coe_nonneg _ }
+end
+
+/-- *Lebesgue differentiation theorem*: for almost every point `x`, the
+average of `f` on `a` tends to `f x` as `a` shrinks to `x` along a Vitali family.-/
+lemma ae_tendsto_average [normed_space ℝ E] [complete_space E] {f : α → E} (hf : integrable f μ) :
+  ∀ᵐ x ∂μ, tendsto (λ a, ⨍ y in a, f y ∂μ) (v.filter_at x) (𝓝 (f x)) :=
+begin
+  filter_upwards [v.ae_tendsto_average_norm_sub hf, v.ae_eventually_measure_pos] with x hx h'x,
+  rw tendsto_iff_norm_tendsto_zero,
+  refine squeeze_zero' (eventually_of_forall (λ a, norm_nonneg _)) _ hx,
+  filter_upwards [h'x, v.eventually_measure_lt_top x] with a ha h'a,
+  nth_rewrite 0 [← set_average_const ha.ne' h'a.ne (f x)],
+  simp_rw [set_average_eq'],
+  rw ← integral_sub,
+  { exact norm_integral_le_integral_norm _ },
+  { exact (integrable_inv_smul_measure ha.ne' h'a.ne).2 hf.integrable_on },
+  { exact (integrable_inv_smul_measure ha.ne' h'a.ne).2 (integrable_on_const.2 (or.inr h'a)) }
+end
+
 end
 
 end vitali_family
diff --git a/src/measure_theory/covering/liminf_limsup.lean b/src/measure_theory/covering/liminf_limsup.lean
new file mode 100644
index 0000000000000..bd254f5dcaff9
--- /dev/null
+++ b/src/measure_theory/covering/liminf_limsup.lean
@@ -0,0 +1,290 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import measure_theory.covering.density_theorem
+
+/-!
+# Liminf, limsup, and uniformly locally doubling measures.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is a place to collect lemmas about liminf and limsup for subsets of a metric space
+carrying a uniformly locally doubling measure.
+
+## Main results:
+
+ * `blimsup_cthickening_mul_ae_eq`: the limsup of the closed thickening of a sequence of subsets
+   of a metric space is unchanged almost everywhere for a uniformly locally doubling measure if the
+   sequence of distances is multiplied by a positive scale factor. This is a generalisation of a
+   result of Cassels, appearing as Lemma 9 on page 217 of
+   [J.W.S. Cassels, *Some metrical theorems in Diophantine approximation. I*](cassels1950).
+ * `blimsup_thickening_mul_ae_eq`: a variant of `blimsup_cthickening_mul_ae_eq` for thickenings
+   rather than closed thickenings.
+
+-/
+
+open set filter metric measure_theory topological_space
+open_locale nnreal ennreal topology
+
+variables {α : Type*} [metric_space α] [second_countable_topology α] [measurable_space α]
+  [borel_space α]
+variables (μ : measure α) [is_locally_finite_measure μ] [is_unif_loc_doubling_measure μ]
+
+/-- This is really an auxiliary result en route to `blimsup_cthickening_ae_le_of_eventually_mul_le`
+(which is itself an auxiliary result en route to `blimsup_cthickening_mul_ae_eq`).
+
+NB: The `set : α` type ascription is present because of issue #16932 on GitHub. -/
+lemma blimsup_cthickening_ae_le_of_eventually_mul_le_aux
+  (p : ℕ → Prop) {s : ℕ → set α} (hs : ∀ i, is_closed (s i))
+  {r₁ r₂ : ℕ → ℝ} (hr : tendsto r₁ at_top (𝓝[>] 0)) (hrp : 0 ≤ r₁)
+  {M : ℝ} (hM : 0 < M) (hM' : M < 1) (hMr : ∀ᶠ i in at_top, M * r₁ i ≤ r₂ i) :
+  (blimsup (λ i, cthickening (r₁ i) (s i)) at_top p : set α) ≤ᵐ[μ]
+  (blimsup (λ i, cthickening (r₂ i) (s i)) at_top p : set α) :=
+begin
+  /- Sketch of proof:
+
+  Assume that `p` is identically true for simplicity. Let `Y₁ i = cthickening (r₁ i) (s i)`, define
+  `Y₂` similarly except using `r₂`, and let `(Z i) = ⋃_{j ≥ i} (Y₂ j)`. Our goal is equivalent to
+  showing that `μ ((limsup Y₁) \ (Z i)) = 0` for all `i`.
+
+  Assume for contradiction that `μ ((limsup Y₁) \ (Z i)) ≠ 0` for some `i` and let
+  `W = (limsup Y₁) \ (Z i)`. Apply Lebesgue's density theorem to obtain a point `d` in `W` of
+  density `1`. Since `d ∈ limsup Y₁`, there is a subsequence of `j ↦ Y₁ j`, indexed by
+  `f 0 < f 1 < ...`, such that `d ∈ Y₁ (f j)` for all `j`. For each `j`, we may thus choose
+  `w j ∈ s (f j)` such that `d ∈ B j`, where `B j = closed_ball (w j) (r₁ (f j))`. Note that
+  since `d` has density one, `μ (W ∩ (B j)) / μ (B j) → 1`.
+
+  We obtain our contradiction by showing that there exists `η < 1` such that
+  `μ (W ∩ (B j)) / μ (B j) ≤ η` for sufficiently large `j`. In fact we claim that `η = 1 - C⁻¹`
+  is such a value where `C` is the scaling constant of `M⁻¹` for the uniformly locally doubling
+  measure `μ`.
+
+  To prove the claim, let `b j = closed_ball (w j) (M * r₁ (f j))` and for given `j` consider the
+  sets `b j` and `W ∩ (B j)`. These are both subsets of `B j` and are disjoint for large enough `j`
+  since `M * r₁ j ≤ r₂ j` and thus `b j ⊆ Z i ⊆ Wᶜ`. We thus have:
+  `μ (b j) + μ (W ∩ (B j)) ≤ μ (B j)`. Combining this with `μ (B j) ≤ C * μ (b j)` we obtain
+  the required inequality. -/
+  set Y₁ : ℕ → set α := λ i, cthickening (r₁ i) (s i),
+  set Y₂ : ℕ → set α := λ i, cthickening (r₂ i) (s i),
+  let Z : ℕ → set α := λ i, ⋃ j (h : p j ∧ i ≤ j), Y₂ j,
+  suffices : ∀ i, μ (at_top.blimsup Y₁ p \ Z i) = 0,
+  { rwa [ae_le_set, @blimsup_eq_infi_bsupr_of_nat _ _ _ Y₂, infi_eq_Inter, diff_Inter,
+      measure_Union_null_iff], },
+  intros,
+  set W := at_top.blimsup Y₁ p \ Z i,
+  by_contra contra,
+  obtain ⟨d, hd, hd'⟩ : ∃ d, d ∈ W ∧ ∀ {ι : Type*} {l : filter ι} (w : ι → α) (δ : ι → ℝ),
+    tendsto δ l (𝓝[>] 0) → (∀ᶠ j in l, d ∈ closed_ball (w j) (2 * δ j)) →
+    tendsto (λ j, μ (W ∩ closed_ball (w j) (δ j)) / μ (closed_ball (w j) (δ j))) l (𝓝 1) :=
+    measure.exists_mem_of_measure_ne_zero_of_ae contra
+      (is_unif_loc_doubling_measure.ae_tendsto_measure_inter_div μ W 2),
+  replace hd : d ∈ blimsup Y₁ at_top p := ((mem_diff _).mp hd).1,
+  obtain ⟨f : ℕ → ℕ, hf⟩ := exists_forall_mem_of_has_basis_mem_blimsup' at_top_basis hd,
+  simp only [forall_and_distrib] at hf,
+  obtain ⟨hf₀ : ∀ j, d ∈ cthickening (r₁ (f j)) (s (f j)), hf₁, hf₂ : ∀ j, j ≤ f j⟩ := hf,
+  have hf₃ : tendsto f at_top at_top :=
+    tendsto_at_top_at_top.mpr (λ j, ⟨f j, λ i hi, (hf₂ j).trans (hi.trans $ hf₂ i)⟩),
+  replace hr : tendsto (r₁ ∘ f) at_top (𝓝[>] 0) := hr.comp hf₃,
+  replace hMr : ∀ᶠ j in at_top, M * r₁ (f j) ≤ r₂ (f j) := hf₃.eventually hMr,
+  replace hf₀ : ∀ j, ∃ (w ∈ s (f j)), d ∈ closed_ball w (2 * r₁ (f j)),
+  { intros j,
+    specialize hrp (f j),
+    rw pi.zero_apply at hrp,
+    rcases eq_or_lt_of_le hrp with hr0 | hrp',
+    { specialize hf₀ j,
+      rw [← hr0, cthickening_zero, (hs (f j)).closure_eq] at hf₀,
+      exact ⟨d, hf₀, by simp [← hr0]⟩, },
+    { exact mem_Union₂.mp (cthickening_subset_Union_closed_ball_of_lt (s (f j)) (by positivity)
+        (lt_two_mul_self hrp') (hf₀ j)), }, },
+  choose w hw hw' using hf₀,
+  let C := is_unif_loc_doubling_measure.scaling_constant_of μ M⁻¹,
+  have hC : 0 < C :=
+    lt_of_lt_of_le zero_lt_one (is_unif_loc_doubling_measure.one_le_scaling_constant_of μ M⁻¹),
+  suffices : ∃ (η < (1 : ℝ≥0)), ∀ᶠ j in at_top,
+    μ (W ∩ closed_ball (w j) (r₁ (f j))) / μ (closed_ball (w j) (r₁ (f j))) ≤ η,
+  { obtain ⟨η, hη, hη'⟩ := this,
+    replace hη' : 1 ≤ η := by simpa only [ennreal.one_le_coe_iff] using
+      le_of_tendsto (hd' w (λ j, r₁ (f j)) hr $ eventually_of_forall hw') hη',
+    exact (lt_self_iff_false _).mp (lt_of_lt_of_le hη hη'), },
+  refine ⟨1 - C⁻¹, tsub_lt_self zero_lt_one (inv_pos.mpr hC), _⟩,
+  replace hC : C ≠ 0 := ne_of_gt hC,
+  let b : ℕ → set α := λ j, closed_ball (w j) (M * r₁ (f j)),
+  let B : ℕ → set α := λ j, closed_ball (w j) (r₁ (f j)),
+  have h₁ : ∀ j, b j ⊆ B j :=
+    λ j, closed_ball_subset_closed_ball (mul_le_of_le_one_left (hrp (f j)) hM'.le),
+  have h₂ : ∀ j, W ∩ B j ⊆ B j := λ j, inter_subset_right W (B j),
+  have h₃ : ∀ᶠ j in at_top, disjoint (b j) (W ∩ B j),
+  { apply hMr.mp,
+    rw eventually_at_top,
+    refine ⟨i, λ j hj hj', disjoint.inf_right (B j) $ disjoint.inf_right' (blimsup Y₁ at_top p) _⟩,
+    change disjoint (b j) (Z i)ᶜ,
+    rw disjoint_compl_right_iff_subset,
+    refine (closed_ball_subset_cthickening (hw j) (M * r₁ (f j))).trans
+      ((cthickening_mono hj' _).trans (λ a ha, _)),
+    simp only [mem_Union, exists_prop],
+    exact ⟨f j, ⟨hf₁ j, hj.le.trans (hf₂ j)⟩, ha⟩, },
+  have h₄ : ∀ᶠ j in at_top, μ (B j) ≤ C * μ (b j) :=
+    (hr.eventually (is_unif_loc_doubling_measure.eventually_measure_le_scaling_constant_mul'
+      μ M hM)).mono (λ j hj, hj (w j)),
+  refine (h₃.and h₄).mono (λ j hj₀, _),
+  change μ (W ∩ B j) / μ (B j) ≤ ↑(1 - C⁻¹),
+  rcases eq_or_ne (μ (B j)) ∞ with hB | hB, { simp [hB], },
+  apply ennreal.div_le_of_le_mul,
+  rw [with_top.coe_sub, ennreal.coe_one, ennreal.sub_mul (λ _ _, hB), one_mul],
+  replace hB : ↑C⁻¹ * μ (B j) ≠ ∞,
+  { refine ennreal.mul_ne_top _ hB,
+    rwa [ennreal.coe_inv hC, ne.def, ennreal.inv_eq_top, ennreal.coe_eq_zero], },
+  obtain ⟨hj₁ : disjoint (b j) (W ∩ B j), hj₂ : μ (B j) ≤ C * μ (b j)⟩ := hj₀,
+  replace hj₂ : ↑C⁻¹ * μ (B j) ≤ μ (b j),
+  { rw [ennreal.coe_inv hC, ← ennreal.div_eq_inv_mul],
+    exact ennreal.div_le_of_le_mul' hj₂, },
+  have hj₃ : ↑C⁻¹ * μ (B j) + μ (W ∩ B j) ≤ μ (B j),
+  { refine le_trans (add_le_add_right hj₂ _) _,
+    rw ← measure_union' hj₁ measurable_set_closed_ball,
+    exact measure_mono (union_subset (h₁ j) (h₂ j)), },
+  replace hj₃ := tsub_le_tsub_right hj₃ (↑C⁻¹ * μ (B j)),
+  rwa ennreal.add_sub_cancel_left hB at hj₃,
+end
+
+/-- This is really an auxiliary result en route to `blimsup_cthickening_mul_ae_eq`.
+
+NB: The `set : α` type ascription is present because of issue #16932 on GitHub. -/
+lemma blimsup_cthickening_ae_le_of_eventually_mul_le
+  (p : ℕ → Prop) {s : ℕ → set α} {M : ℝ} (hM : 0 < M)
+  {r₁ r₂ : ℕ → ℝ} (hr : tendsto r₁ at_top (𝓝[>] 0)) (hMr : ∀ᶠ i in at_top, M * r₁ i ≤ r₂ i) :
+  (blimsup (λ i, cthickening (r₁ i) (s i)) at_top p : set α) ≤ᵐ[μ]
+  (blimsup (λ i, cthickening (r₂ i) (s i)) at_top p : set α) :=
+begin
+  let R₁ := λ i, max 0 (r₁ i),
+  let R₂ := λ i, max 0 (r₂ i),
+  have hRp : 0 ≤ R₁ := λ i, le_max_left 0 (r₁ i),
+  replace hMr : ∀ᶠ i in at_top, M * R₁ i ≤ R₂ i,
+  { refine hMr.mono (λ i hi, _),
+    rw [mul_max_of_nonneg _ _ hM.le, mul_zero],
+    exact max_le_max (le_refl 0) hi, },
+  simp_rw [← cthickening_max_zero (r₁ _), ← cthickening_max_zero (r₂ _)],
+  cases le_or_lt 1 M with hM' hM',
+  { apply has_subset.subset.eventually_le,
+    change _ ≤ _,
+    refine mono_blimsup' (hMr.mono $ λ i hi hp, cthickening_mono _ (s i)),
+    exact (le_mul_of_one_le_left (hRp i) hM').trans hi, },
+  { simp only [← @cthickening_closure _ _ _ (s _)],
+    have hs : ∀ i, is_closed (closure (s i)) := λ i, is_closed_closure,
+    exact blimsup_cthickening_ae_le_of_eventually_mul_le_aux
+      μ p hs (tendsto_nhds_max_right hr) hRp hM hM' hMr, },
+end
+
+/-- Given a sequence of subsets `sᵢ` of a metric space, together with a sequence of radii `rᵢ`
+such that `rᵢ → 0`, the set of points which belong to infinitely many of the closed
+`rᵢ`-thickenings of `sᵢ` is unchanged almost everywhere for a uniformly locally doubling measure if
+the `rᵢ` are all scaled by a positive constant.
+
+This lemma is a generalisation of Lemma 9 appearing on page 217 of
+[J.W.S. Cassels, *Some metrical theorems in Diophantine approximation. I*](cassels1950).
+
+See also `blimsup_thickening_mul_ae_eq`.
+
+NB: The `set : α` type ascription is present because of issue #16932 on GitHub. -/
+theorem blimsup_cthickening_mul_ae_eq
+  (p : ℕ → Prop) (s : ℕ → set α) {M : ℝ} (hM : 0 < M) (r : ℕ → ℝ) (hr : tendsto r at_top (𝓝 0)) :
+  (blimsup (λ i, cthickening (M * r i) (s i)) at_top p : set α) =ᵐ[μ]
+  (blimsup (λ i, cthickening (r i) (s i)) at_top p : set α) :=
+begin
+  have : ∀ (p : ℕ → Prop) {r : ℕ → ℝ} (hr : tendsto r at_top (𝓝[>] 0)),
+    (blimsup (λ i, cthickening (M * r i) (s i)) at_top p : set α) =ᵐ[μ]
+    (blimsup (λ i, cthickening (r i) (s i)) at_top p : set α),
+  { clear p hr r, intros p r hr,
+    have hr' : tendsto (λ i, M * r i) at_top (𝓝[>] 0),
+    { convert tendsto_nhds_within_Ioi.const_mul hM hr; simp only [mul_zero], },
+    refine eventually_le_antisymm_iff.mpr ⟨_, _⟩,
+    { exact blimsup_cthickening_ae_le_of_eventually_mul_le μ p (inv_pos.mpr hM) hr'
+        (eventually_of_forall $ λ i, by rw inv_mul_cancel_left₀ hM.ne' (r i)), },
+    { exact blimsup_cthickening_ae_le_of_eventually_mul_le μ p hM hr
+        (eventually_of_forall $ λ i, le_refl _), }, },
+  let r' : ℕ → ℝ := λ i, if 0 < r i then r i else 1/((i : ℝ) + 1),
+  have hr' : tendsto r' at_top (𝓝[>] 0),
+  { refine tendsto_nhds_within_iff.mpr ⟨tendsto.if' hr tendsto_one_div_add_at_top_nhds_0_nat,
+      eventually_of_forall $ λ i, _⟩,
+    by_cases hi : 0 < r i,
+    { simp [hi, r'], },
+    { simp only [hi, r', one_div, mem_Ioi, if_false, inv_pos], positivity, }, },
+  have h₀ : ∀ i, (p i ∧ 0 < r i) → cthickening (r i) (s i) = cthickening (r' i) (s i),
+  { rintros i ⟨-, hi⟩, congr, change r i = ite (0 < r i) (r i) _, simp [hi], },
+  have h₁ : ∀ i, (p i ∧ 0 < r i) → cthickening (M * r i) (s i) = cthickening (M * r' i) (s i),
+  { rintros i ⟨-, hi⟩, simp only [hi, mul_ite, if_true], },
+  have h₂ : ∀ i, (p i ∧ r i ≤ 0) → cthickening (M * r i) (s i) = cthickening (r i) (s i),
+  { rintros i ⟨-, hi⟩,
+    have hi' : M * r i ≤ 0 := mul_nonpos_of_nonneg_of_nonpos hM.le hi,
+    rw [cthickening_of_nonpos hi, cthickening_of_nonpos hi'], },
+  have hp : p = λ i, (p i ∧ 0 < r i) ∨ (p i ∧ r i ≤ 0),
+  { ext i, simp [← and_or_distrib_left, lt_or_le 0 (r i)], },
+  rw [hp, blimsup_or_eq_sup, blimsup_or_eq_sup, sup_eq_union,
+    blimsup_congr (eventually_of_forall h₀), blimsup_congr (eventually_of_forall h₁),
+    blimsup_congr (eventually_of_forall h₂)],
+  exact ae_eq_set_union (this (λ i, p i ∧ 0 < r i) hr') (ae_eq_refl _),
+end
+
+lemma blimsup_cthickening_ae_eq_blimsup_thickening
+  {p : ℕ → Prop} {s : ℕ → set α} {r : ℕ → ℝ}
+  (hr : tendsto r at_top (𝓝 0)) (hr' : ∀ᶠ i in at_top , p i → 0 < r i) :
+  (blimsup (λ i, cthickening (r i) (s i)) at_top p : set α) =ᵐ[μ]
+  (blimsup (λ i, thickening (r i) (s i)) at_top p : set α) :=
+begin
+  refine eventually_le_antisymm_iff.mpr ⟨_, has_subset.subset.eventually_le (_ : _ ≤ _)⟩,
+  { rw eventually_le_congr (blimsup_cthickening_mul_ae_eq μ p s (@one_half_pos ℝ _) r hr).symm
+      eventually_eq.rfl,
+    apply has_subset.subset.eventually_le,
+    change _ ≤ _,
+    refine mono_blimsup' (hr'.mono $ λ i hi pi, cthickening_subset_thickening' (hi pi) _ (s i)),
+    nlinarith [hi pi], },
+  { exact mono_blimsup (λ i pi, thickening_subset_cthickening _ _), },
+end
+
+/-- An auxiliary result en route to `blimsup_thickening_mul_ae_eq`. -/
+lemma blimsup_thickening_mul_ae_eq_aux
+  (p : ℕ → Prop) (s : ℕ → set α) {M : ℝ} (hM : 0 < M)
+  (r : ℕ → ℝ) (hr : tendsto r at_top (𝓝 0)) (hr' : ∀ᶠ i in at_top , p i → 0 < r i) :
+  (blimsup (λ i, thickening (M * r i) (s i)) at_top p : set α) =ᵐ[μ]
+  (blimsup (λ i, thickening (r i) (s i)) at_top p : set α) :=
+begin
+  have h₁ := blimsup_cthickening_ae_eq_blimsup_thickening μ hr hr',
+  have h₂ := blimsup_cthickening_mul_ae_eq μ p s hM r hr,
+  replace hr : tendsto (λ i, M * r i) at_top (𝓝 0), { convert hr.const_mul M, simp, },
+  replace hr' : ∀ᶠ i in at_top , p i → 0 < M * r i := hr'.mono (λ i hi hip, mul_pos hM (hi hip)),
+  have h₃ := blimsup_cthickening_ae_eq_blimsup_thickening μ hr hr',
+  exact h₃.symm.trans (h₂.trans h₁),
+end
+
+/-- Given a sequence of subsets `sᵢ` of a metric space, together with a sequence of radii `rᵢ`
+such that `rᵢ → 0`, the set of points which belong to infinitely many of the
+`rᵢ`-thickenings of `sᵢ` is unchanged almost everywhere for a uniformly locally doubling measure if
+the `rᵢ` are all scaled by a positive constant.
+
+This lemma is a generalisation of Lemma 9 appearing on page 217 of
+[J.W.S. Cassels, *Some metrical theorems in Diophantine approximation. I*](cassels1950).
+
+See also `blimsup_cthickening_mul_ae_eq`.
+
+NB: The `set : α` type ascription is present because of issue #16932 on GitHub. -/
+theorem blimsup_thickening_mul_ae_eq
+  (p : ℕ → Prop) (s : ℕ → set α) {M : ℝ} (hM : 0 < M) (r : ℕ → ℝ) (hr : tendsto r at_top (𝓝 0)) :
+  (blimsup (λ i, thickening (M * r i) (s i)) at_top p : set α) =ᵐ[μ]
+  (blimsup (λ i, thickening (r i) (s i)) at_top p : set α) :=
+begin
+  let q : ℕ → Prop := λ i, p i ∧ 0 < r i,
+  have h₁ : blimsup (λ i, thickening (r i) (s i)) at_top p =
+            blimsup (λ i, thickening (r i) (s i)) at_top q,
+  { refine blimsup_congr' (eventually_of_forall $ λ i h, _),
+    replace hi : 0 < r i, { contrapose! h, apply thickening_of_nonpos h, },
+    simp only [hi, iff_self_and, implies_true_iff], },
+  have h₂ : blimsup (λ i, thickening (M * r i) (s i)) at_top p =
+            blimsup (λ i, thickening (M * r i) (s i)) at_top q,
+  { refine blimsup_congr' (eventually_of_forall $ λ i h, _),
+    replace h : 0 < r i, { rw ← zero_lt_mul_left hM, contrapose! h, apply thickening_of_nonpos h, },
+    simp only [h, iff_self_and, implies_true_iff], },
+  rw [h₁, h₂],
+  exact blimsup_thickening_mul_ae_eq_aux μ q s hM r hr (eventually_of_forall (λ i hi, hi.2)),
+end
diff --git a/src/measure_theory/covering/one_dim.lean b/src/measure_theory/covering/one_dim.lean
new file mode 100644
index 0000000000000..851314e77b0ca
--- /dev/null
+++ b/src/measure_theory/covering/one_dim.lean
@@ -0,0 +1,67 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import measure_theory.covering.density_theorem
+import measure_theory.measure.lebesgue.eq_haar
+
+/-!
+# Covering theorems for Lebesgue measure in one dimension
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We have a general theory of covering theorems for doubling measures, developed notably
+in `density_theorems.lean`. In this file, we expand the API for this theory in one dimension,
+by showing that intervals belong to the relevant Vitali family.
+-/
+
+open set measure_theory is_unif_loc_doubling_measure filter
+open_locale topology
+
+namespace real
+
+lemma Icc_mem_vitali_family_at_right {x y : ℝ} (hxy : x < y) :
+  Icc x y ∈ (vitali_family (volume : measure ℝ) 1).sets_at x :=
+begin
+  rw Icc_eq_closed_ball,
+  refine closed_ball_mem_vitali_family_of_dist_le_mul _ _ (by linarith),
+  rw [dist_comm, real.dist_eq, abs_of_nonneg];
+  linarith,
+end
+
+lemma tendsto_Icc_vitali_family_right (x : ℝ) :
+  tendsto (λ y, Icc x y) (𝓝[>] x) ((vitali_family (volume : measure ℝ) 1).filter_at x) :=
+begin
+  refine (vitali_family.tendsto_filter_at_iff _).2 ⟨_, _⟩,
+  { filter_upwards [self_mem_nhds_within] with y hy using Icc_mem_vitali_family_at_right hy },
+  { assume ε εpos,
+    have : x ∈ Ico x (x + ε) := ⟨le_refl _, by linarith⟩,
+    filter_upwards [Icc_mem_nhds_within_Ioi this] with y hy,
+    rw closed_ball_eq_Icc,
+    exact Icc_subset_Icc (by linarith) hy.2 }
+end
+
+lemma Icc_mem_vitali_family_at_left {x y : ℝ} (hxy : x < y) :
+  Icc x y ∈ (vitali_family (volume : measure ℝ) 1).sets_at y :=
+begin
+  rw Icc_eq_closed_ball,
+  refine closed_ball_mem_vitali_family_of_dist_le_mul _ _ (by linarith),
+  rw [real.dist_eq, abs_of_nonneg];
+  linarith,
+end
+
+lemma tendsto_Icc_vitali_family_left (x : ℝ) :
+  tendsto (λ y, Icc y x) (𝓝[<] x) ((vitali_family (volume : measure ℝ) 1).filter_at x) :=
+begin
+  refine (vitali_family.tendsto_filter_at_iff _).2 ⟨_, _⟩,
+  { filter_upwards [self_mem_nhds_within] with y hy using Icc_mem_vitali_family_at_left hy },
+  { assume ε εpos,
+    have : x ∈ Ioc (x - ε) x := ⟨by linarith, le_refl _⟩,
+    filter_upwards [Icc_mem_nhds_within_Iio this] with y hy,
+    rw closed_ball_eq_Icc,
+    exact Icc_subset_Icc hy.1 (by linarith) }
+end
+
+end real
diff --git a/src/measure_theory/covering/vitali.lean b/src/measure_theory/covering/vitali.lean
index c3ab69ef80710..00af34b0a68e1 100644
--- a/src/measure_theory/covering/vitali.lean
+++ b/src/measure_theory/covering/vitali.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import topology.metric_space.basic
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
 import measure_theory.covering.vitali_family
 
 /-!
 # Vitali covering theorems
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The topological Vitali covering theorem, in its most classical version, states the following.
 Consider a family of balls `(B (x_i, r_i))_{i ∈ I}` in a metric space, with uniformly bounded
 radii. Then one can extract a disjoint subfamily indexed by `J ⊆ I`, such that any `B (x_i, r_i)`
@@ -33,10 +36,10 @@ covering a fixed proportion `1/C` of the ball `closed_ball x (3 * diam a)` forms
 This version is given in `vitali.vitali_family`.
 -/
 
-variables {α : Type*}
+variables {α ι : Type*}
 
 open set metric measure_theory topological_space filter
-open_locale nnreal classical ennreal topological_space
+open_locale nnreal classical ennreal topology
 
 namespace vitali
 
@@ -48,12 +51,15 @@ When `t` is a family of balls, the `τ`-enlargment of `ball x r` is `ball x ((1+
 it is expressed in terms of a function `δ` (think "radius" or "diameter"), positive and bounded on
 all elements of `t`. The condition is that every element `a` of `t` should intersect an
 element `b` of `u` of size larger than that of `a` up to `τ`, i.e., `δ b ≥ δ a / τ`.
+
+We state the lemma slightly more generally, with an indexed family of sets `B a` for `a ∈ t`, for
+wider applicability.
 -/
 theorem exists_disjoint_subfamily_covering_enlargment
-  (t : set (set α)) (δ : set α → ℝ) (τ : ℝ) (hτ : 1 < τ) (δnonneg : ∀ a ∈ t, 0 ≤ δ a)
-  (R : ℝ) (δle : ∀ a ∈ t, δ a ≤ R) (hne : ∀ a ∈ t, set.nonempty a) :
-  ∃ u ⊆ t, u.pairwise_disjoint id ∧
-    ∀ a ∈ t, ∃ b ∈ u, set.nonempty (a ∩ b) ∧ δ a ≤ τ * δ b :=
+  (B : ι → set α) (t : set ι) (δ : ι → ℝ) (τ : ℝ) (hτ : 1 < τ) (δnonneg : ∀ a ∈ t, 0 ≤ δ a)
+  (R : ℝ) (δle : ∀ a ∈ t, δ a ≤ R) (hne : ∀ a ∈ t, (B a).nonempty) :
+  ∃ u ⊆ t, u.pairwise_disjoint B ∧
+    ∀ a ∈ t, ∃ b ∈ u, (B a ∩ B b).nonempty ∧ δ a ≤ τ * δ b :=
 begin
   /- The proof could be formulated as a transfinite induction. First pick an element of `t` with `δ`
   as large as possible (up to a factor of `τ`). Then among the remaining elements not intersecting
@@ -68,33 +74,33 @@ begin
   that `u ∪ {a'}` still has this property, contradicting the maximality. Therefore, `u`
   intersects all elements of `t`, and by definition it satisfies all the desired properties.
   -/
-  let T : set (set (set α)) := {u | u ⊆ t ∧ u.pairwise_disjoint id
-    ∧ ∀ a ∈ t, ∀ b ∈ u, set.nonempty (a ∩ b) → ∃ c ∈ u, (a ∩ c).nonempty ∧ δ a ≤ τ * δ c},
+  let T : set (set ι) := {u | u ⊆ t ∧ u.pairwise_disjoint B
+    ∧ ∀ a ∈ t, ∀ b ∈ u, (B a ∩ B b).nonempty → ∃ c ∈ u, (B a ∩ B c).nonempty ∧ δ a ≤ τ * δ c},
   -- By Zorn, choose a maximal family in the good set `T` of disjoint families.
   obtain ⟨u, uT, hu⟩ : ∃ u ∈ T, ∀ v ∈ T, u ⊆ v → v = u,
   { refine zorn_subset _ (λ U UT hU, _),
     refine ⟨⋃₀ U, _, λ s hs, subset_sUnion_of_mem hs⟩,
-    simp only [set.sUnion_subset_iff, and_imp, exists_prop, forall_exists_index,
+    simp only [set.sUnion_subset_iff, and_imp, exists_prop, forall_exists_index, mem_sUnion,
                 set.mem_set_of_eq],
     refine ⟨λ u hu, (UT hu).1, (pairwise_disjoint_sUnion hU.directed_on).2 (λ u hu, (UT hu).2.1),
       λ a hat b u uU hbu hab, _⟩,
-    obtain ⟨c, cu, ac, hc⟩ : ∃ (c : set α) (H : c ∈ u), (a ∩ c).nonempty ∧ δ a ≤ τ * δ c :=
+    obtain ⟨c, cu, ac, hc⟩ : ∃ (c : ι) (H : c ∈ u), (B a ∩ B c).nonempty ∧ δ a ≤ τ * δ c :=
       (UT uU).2.2 a hat b hbu hab,
     exact ⟨c, ⟨u, uU, cu⟩, ac, hc⟩ },
   -- the only nontrivial bit is to check that every `a ∈ t` intersects an element `b ∈ u` with
   -- comparatively large `δ b`. Assume this is not the case, then we will contradict the maximality.
   refine ⟨u, uT.1, uT.2.1, λ a hat, _⟩,
   contrapose! hu,
-  have a_disj : ∀ c ∈ u, disjoint a c,
+  have a_disj : ∀ c ∈ u, disjoint (B a) (B c),
   { assume c hc,
     by_contra,
     rw not_disjoint_iff_nonempty_inter at h,
-    obtain ⟨d, du, ad, hd⟩ : ∃ (d : set α) (H : d ∈ u), (a ∩ d).nonempty ∧ δ a ≤ τ * δ d :=
+    obtain ⟨d, du, ad, hd⟩ : ∃ (d : ι) (H : d ∈ u), (B a ∩ B d).nonempty ∧ δ a ≤ τ * δ d :=
       uT.2.2 a hat c hc h,
     exact lt_irrefl _ ((hu d du ad).trans_le hd) },
   -- Let `A` be all the elements of `t` which do not intersect the family `u`. It is nonempty as it
   -- contains `a`. We will pick an element `a'` of `A` with `δ a'` almost as large as possible.
-  let A := {a' | a' ∈ t ∧ ∀ c ∈ u, disjoint a' c},
+  let A := {a' | a' ∈ t ∧ ∀ c ∈ u, disjoint (B a') (B c)},
   have Anonempty : A.nonempty := ⟨a, hat, a_disj⟩,
   let m := Sup (δ '' A),
   have bddA : bdd_above (δ '' A),
@@ -128,7 +134,7 @@ begin
   { assume c ct b ba'u hcb,
     -- if `c` already intersects an element of `u`, then it intersects an element of `u` with
     -- large `δ` by the assumption on `u`, and there is nothing left to do.
-    by_cases H : ∃ d ∈ u, set.nonempty (c ∩ d),
+    by_cases H : ∃ d ∈ u, (B c ∩ B d).nonempty,
     { rcases H with ⟨d, du, hd⟩,
       rcases uT.2.2 c ct d du hd with ⟨d', d'u, hd'⟩,
       exact ⟨d', mem_insert_of_mem _ d'u, hd'⟩ },
@@ -150,101 +156,65 @@ end
 extract a disjoint subfamily `u ⊆ t` so that all balls in `t` are covered by the 5-times
 dilations of balls in `u`. -/
 theorem exists_disjoint_subfamily_covering_enlargment_closed_ball [metric_space α]
-  (t : set (set α)) (R : ℝ) (ht : ∀ s ∈ t, ∃ x r, s = closed_ball x r ∧ r ≤ R) :
-  ∃ u ⊆ t, u.pairwise_disjoint id ∧
-    ∀ a ∈ t, ∃ x r, closed_ball x r ∈ u ∧ a ⊆ closed_ball x (5 * r) :=
+  (t : set ι) (x : ι → α) (r : ι → ℝ) (R : ℝ) (hr : ∀ a ∈ t, r a ≤ R) :
+  ∃ u ⊆ t, u.pairwise_disjoint (λ a, closed_ball (x a) (r a)) ∧
+    ∀ a ∈ t, ∃ b ∈ u, closed_ball (x a) (r a) ⊆ closed_ball (x b) (5 * r b) :=
 begin
   rcases eq_empty_or_nonempty t with rfl|tnonempty,
   { exact ⟨∅, subset.refl _, pairwise_disjoint_empty, by simp⟩ },
-  haveI : inhabited α,
-  { choose s hst using tnonempty,
-    choose x r hxr using ht s hst,
-    exact ⟨x⟩ },
-  -- Exclude the trivial case where `t` is reduced to the empty set.
-  rcases eq_or_ne t {∅} with rfl|t_ne_empty,
-  { refine ⟨{∅}, subset.refl _, _⟩,
-    simp only [true_and, closed_ball_eq_empty, mem_singleton_iff, and_true, empty_subset, forall_eq,
-      pairwise_disjoint_singleton, exists_const],
-    exact ⟨-1, by simp only [right.neg_neg_iff, zero_lt_one]⟩ },
-  -- The real proof starts now. Since the center or the radius of a ball is not uniquely defined
-  -- in a general metric space, we just choose one for definiteness.
-  choose! x r hxr using ht,
-  have r_nonneg : ∀ (a : set α), a ∈ t → a.nonempty → 0 ≤ r a,
-  { assume a hat a_nonempty,
-    rw (hxr a hat).1 at a_nonempty,
-    simpa only [nonempty_closed_ball] using a_nonempty },
-  -- The difference with the generic version is that we are not excluding empty sets in our family
-  -- (which would correspond to `r a < 0`). To compensate for this, we apply the generic version
-  -- to the subfamily `t'` made of nonempty sets, and we use `δ = r` there. This gives a disjointed
-  -- subfamily `u'`.
+  by_cases ht : ∀ a ∈ t, r a < 0,
+  { exact ⟨t, subset.rfl, λ a ha b hb hab,
+      by simp only [function.on_fun, closed_ball_eq_empty.2 (ht a ha), empty_disjoint],
+      λ a ha, ⟨a, ha, by simp only [closed_ball_eq_empty.2 (ht a ha), empty_subset]⟩⟩ },
+  push_neg at ht,
   let t' := {a ∈ t | 0 ≤ r a},
-  obtain ⟨u', u't', u'_disj, hu'⟩ : ∃ u' ⊆ t', u'.pairwise_disjoint id ∧
-    ∀ a ∈ t', ∃ b ∈ u', set.nonempty (a ∩ b) ∧ r a ≤ 2 * r b,
-  { refine exists_disjoint_subfamily_covering_enlargment t' r 2 one_lt_two
-      (λ a ha, ha.2) R (λ a ha, (hxr a ha.1).2) (λ a ha, _),
-    rw [(hxr a ha.1).1],
-    simp only [ha.2, nonempty_closed_ball] },
-  -- this subfamily is nonempty, as we have excluded the situation `t = {∅}`.
-  have u'_nonempty : u'.nonempty,
-  { have : ∃ a ∈ t, a ≠ ∅,
-    { contrapose! t_ne_empty,
-      apply subset.antisymm,
-      { simpa only using t_ne_empty },
-      { rcases tnonempty with ⟨a, hat⟩,
-        have := t_ne_empty a hat,
-        simpa only [this, singleton_subset_iff] using hat } },
-    rcases this with ⟨a, hat, a_nonempty⟩,
-    have ranonneg : 0 ≤ r a := r_nonneg a hat (ne_empty_iff_nonempty.1 a_nonempty),
-    rcases hu' a ⟨hat, ranonneg⟩ with ⟨b, bu', hb⟩,
-    exact ⟨b, bu'⟩ },
-  -- check that the family `u'` gives the desired disjoint covering.
-  refine ⟨u', λ a ha, (u't' ha).1, u'_disj, λ a hat, _⟩,
-  -- it remains to check that any ball in `t` is contained in the 5-dilation of a ball
-  -- in `u'`. This depends on whether the ball is empty of not.
-  rcases eq_empty_or_nonempty a with rfl|a_nonempty,
-  -- if the ball is empty, use any element of `u'` (since we know that `u'` is nonempty).
-  { rcases u'_nonempty with ⟨b, hb⟩,
-    refine ⟨x b, r b, _, empty_subset _⟩,
-    rwa ← (hxr b (u't' hb).1).1 },
-  -- if the ball is not empty, it belongs to `t'`. Then it intersects a ball `a'` in `u'` with
-  -- controlled radius, by definition of `u'`. It is straightforward to check that this ball
-  -- satisfies all the desired properties.
-  { have hat' : a ∈ t' := ⟨hat, r_nonneg a hat a_nonempty⟩,
-    obtain ⟨a', a'u', aa', raa'⟩ :
-      (∃ (a' : set α) (H : a' ∈ u'), (a ∩ a').nonempty ∧ r a ≤ 2 * r a') := hu' a hat',
-    refine ⟨x a', r a', _, _⟩,
-    { convert a'u',
-      exact (hxr a' (u't' a'u').1).1.symm },
-    { rw (hxr a hat'.1).1 at aa' ⊢,
-      rw (hxr a' (u't' a'u').1).1 at aa',
-      have : dist (x a) (x a') ≤ r a + r a' :=
-        dist_le_add_of_nonempty_closed_ball_inter_closed_ball aa',
-      apply closed_ball_subset_closed_ball',
-      linarith } }
+  rcases exists_disjoint_subfamily_covering_enlargment (λ a, closed_ball (x a) (r a)) t' r
+    2 one_lt_two (λ a ha, ha.2) R (λ a ha, hr a ha.1) (λ a ha, ⟨x a, mem_closed_ball_self ha.2⟩)
+    with ⟨u, ut', u_disj, hu⟩,
+  have A : ∀ a ∈ t', ∃ b ∈ u, closed_ball (x a) (r a) ⊆ closed_ball (x b) (5 * r b),
+  { assume a ha,
+    rcases hu a ha with ⟨b, bu, hb, rb⟩,
+    refine ⟨b, bu, _⟩,
+    have : dist (x a) (x b) ≤ r a + r b :=
+      dist_le_add_of_nonempty_closed_ball_inter_closed_ball hb,
+    apply closed_ball_subset_closed_ball',
+    linarith },
+  refine ⟨u, ut'.trans (λ a ha, ha.1), u_disj, λ a ha, _⟩,
+  rcases le_or_lt 0 (r a) with h'a|h'a,
+  { exact A a ⟨ha, h'a⟩ },
+  { rcases ht with ⟨b, rb⟩,
+    rcases A b ⟨rb.1, rb.2⟩ with ⟨c, cu, hc⟩,
+    refine ⟨c, cu, by simp only [closed_ball_eq_empty.2 h'a, empty_subset]⟩ },
 end
 
+
 /-- The measurable Vitali covering theorem. Assume one is given a family `t` of closed sets with
 nonempty interior, such that each `a ∈ t` is included in a ball `B (x, r)` and covers a definite
-proportion of the ball `B (x, 6 r)` for a given measure `μ` (think of the situation where `μ` is
-a doubling measure and `t` is a family of balls). Consider a (possible non-measurable) set `s`
+proportion of the ball `B (x, 3 r)` for a given measure `μ` (think of the situation where `μ` is
+a doubling measure and `t` is a family of balls). Consider a (possibly non-measurable) set `s`
 at which the family is fine, i.e., every point of `s` belongs to arbitrarily small elements of `t`.
-Then one can extract from `t` a disjoint subfamily that covers almost all `s`. -/
+Then one can extract from `t` a disjoint subfamily that covers almost all `s`.
+
+For more flexibility, we give a statement with a parameterized family of sets.
+-/
 theorem exists_disjoint_covering_ae [metric_space α] [measurable_space α] [opens_measurable_space α]
   [second_countable_topology α]
   (μ : measure α) [is_locally_finite_measure μ] (s : set α)
-  (t : set (set α)) (hf : ∀ x ∈ s, ∀ (ε > (0 : ℝ)), ∃ a ∈ t, x ∈ a ∧ a ⊆ closed_ball x ε)
-  (ht : ∀ a ∈ t, (interior a).nonempty) (h't : ∀ a ∈ t, is_closed a)
-  (C : ℝ≥0) (h : ∀ a ∈ t, ∃ x ∈ a, μ (closed_ball x (3 * diam a)) ≤ C * μ a) :
-  ∃ u ⊆ t, countable u ∧ u.pairwise_disjoint id ∧ μ (s \ ⋃ (a ∈ u), a) = 0 :=
+  (t : set ι) (C : ℝ≥0) (r : ι → ℝ) (c : ι → α) (B : ι → set α)
+  (hB : ∀ a ∈ t, B a ⊆ closed_ball (c a) (r a))
+  (μB : ∀ a ∈ t, μ (closed_ball (c a) (3 * r a)) ≤ C * μ (B a))
+  (ht : ∀ a ∈ t, (interior (B a)).nonempty) (h't : ∀ a ∈ t, is_closed (B a))
+  (hf : ∀ x ∈ s, ∀ (ε > (0 : ℝ)), ∃ a ∈ t, r a ≤ ε ∧ c a = x) :
+  ∃ u ⊆ t, u.countable ∧ u.pairwise_disjoint B ∧ μ (s \ ⋃ a ∈ u, B a) = 0 :=
 begin
   /- The idea of the proof is the following. Assume for simplicity that `μ` is finite. Applying the
-  abstract Vitali covering theorem with `δ = diam`, one obtains a disjoint subfamily `u`, such
-  that any element of `t` intersects an element of `u` with comparable diameter. Fix `ε > 0`.
+  abstract Vitali covering theorem with `δ = r` given by `hf`, one obtains a disjoint subfamily `u`,
+  such that any element of `t` intersects an element of `u` with comparable radius. Fix `ε > 0`.
   Since the elements of `u` have summable measure, one can remove finitely elements `w_1, ..., w_n`.
   so that the measure of the remaining elements is `< ε`. Consider now a point `z` not
   in the `w_i`. There is a small ball around `z` not intersecting the `w_i` (as they are closed),
   an element `a ∈ t` contained in this small ball (as the family `t` is fine at `z`) and an element
-  `b ∈ u` intersecting `a`, with comparable diameter (by definition of `u`). Then `z` belongs to the
+  `b ∈ u` intersecting `a`, with comparable radius (by definition of `u`). Then `z` belongs to the
   enlargement of `b`. This shows that `s \ (w_1 ∪ ... ∪ w_n)` is contained in
   `⋃ (b ∈ u \ {w_1, ... w_n}) (enlargement of b)`. The measure of the latter set is bounded by
   `∑ (b ∈ u \ {w_1, ... w_n}) C * μ b` (by the doubling property of the measure), which is at most
@@ -255,14 +225,8 @@ begin
   use the whole family `t`, but a subfamily `t'` supported on small balls (which is possible since
   the family is assumed to be fine at every point of `s`).
   -/
-  rcases eq_empty_or_nonempty s with rfl|nonempty,
-  { refine ⟨∅, empty_subset _, countable_empty, pairwise_disjoint_empty,
-      by simp only [measure_empty, Union_false, Union_empty, diff_self]⟩ },
-  haveI : inhabited α,
-  { choose x hx using nonempty,
-    exact ⟨x⟩ },
   -- choose around each `x` a small ball on which the measure is finite
-  have : ∀ x, ∃ r, 0 < r ∧ r ≤ 1 ∧ μ (closed_ball x (20 * r)) < ∞,
+  have : ∀ x, ∃ R, 0 < R ∧ R ≤ 1 ∧ μ (closed_ball x (20 * R)) < ∞,
   { assume x,
     obtain ⟨R, Rpos, μR⟩ : ∃ (R : ℝ) (hR : 0 < R), μ (closed_ball x R) < ∞ :=
       (μ.finite_at_nhds x).exists_mem_basis nhds_basis_closed_ball,
@@ -274,124 +238,123 @@ begin
       calc 20 * min 1 (R / 20) ≤ 20 * (R/20) :
         mul_le_mul_of_nonneg_left (min_le_right _ _) (by norm_num)
       ... = R : by ring } },
-  choose r hr0 hr1 hrμ,
+  choose R hR0 hR1 hRμ,
   -- we restrict to a subfamily `t'` of `t`, made of elements small enough to ensure that
-  -- they only see a finite part of the measure.
-  let t' := {a ∈ t | ∃ x, a ⊆ closed_ball x (r x)},
+  -- they only see a finite part of the measure, and with a doubling property
+  let t' := {a ∈ t | r a ≤ R (c a)},
   -- extract a disjoint subfamily `u` of `t'` thanks to the abstract Vitali covering theorem.
-  obtain ⟨u, ut', u_disj, hu⟩ : ∃ u ⊆ t', u.pairwise_disjoint id ∧
-    ∀ a ∈ t', ∃ b ∈ u, set.nonempty (a ∩ b) ∧ diam a ≤ 2 * diam b,
-  { have A : ∀ (a : set α), a ∈ t' → diam a ≤ 2,
-    { rintros a ⟨hat, ⟨x, hax⟩⟩,
-      calc diam a ≤ 2 * 1 : diam_le_of_subset_closed_ball zero_le_one
-        (hax.trans $ closed_ball_subset_closed_ball $ hr1 x)
-      ... = 2 : mul_one _ },
-    have B : ∀ (a : set α), a ∈ t' → a.nonempty :=
+  obtain ⟨u, ut', u_disj, hu⟩ : ∃ u ⊆ t', u.pairwise_disjoint B ∧
+    ∀ a ∈ t', ∃ b ∈ u, (B a ∩ B b).nonempty ∧ r a ≤ 2 * r b,
+  { have A : ∀ a ∈ t', r a ≤ 1,
+    { assume a ha,
+      apply ha.2.trans (hR1 (c a)), },
+    have A' : ∀ a ∈ t', (B a).nonempty :=
       λ a hat', set.nonempty.mono interior_subset (ht a hat'.1),
-    exact exists_disjoint_subfamily_covering_enlargment t' diam 2 one_lt_two
-      (λ a ha, diam_nonneg) 2 A B },
+    refine exists_disjoint_subfamily_covering_enlargment B t' r 2 one_lt_two
+      (λ a ha, _) 1 A A',
+    exact nonempty_closed_ball.1 ((A' a ha).mono (hB a ha.1)) },
   have ut : u ⊆ t := λ a hau, (ut' hau).1,
   -- As the space is second countable, the family is countable since all its sets have nonempty
   -- interior.
-  have u_count : countable u :=
-    u_disj.countable_of_nonempty_interior (λ a ha, ht a (ut ha)),
+  have u_count : u.countable := u_disj.countable_of_nonempty_interior (λ a ha, ht a (ut ha)),
   -- the family `u` will be the desired family
   refine ⟨u, λ a hat', (ut' hat').1, u_count, u_disj, _⟩,
   -- it suffices to show that it covers almost all `s` locally around each point `x`.
   refine null_of_locally_null _ (λ x hx, _),
   -- let `v` be the subfamily of `u` made of those sets intersecting the small ball `ball x (r x)`
-  let v := {a ∈ u | (a ∩ ball x (r x)).nonempty },
+  let v := {a ∈ u | (B a ∩ ball x (R x)).nonempty },
   have vu : v ⊆ u := λ a ha, ha.1,
   -- they are all contained in a fixed ball of finite measure, thanks to our choice of `t'`
-  obtain ⟨R, μR, hR⟩ : ∃ R, μ (closed_ball x R) < ∞ ∧
-                          ∀ a ∈ u, (a ∩ ball x (r x)).nonempty → a ⊆ closed_ball x R,
-  { have : ∀ a ∈ u, ∃ y, a ⊆ closed_ball y (r y) := λ a hau, (ut' hau).2,
-    choose! y hy using this,
-    have Idist_v : ∀ a ∈ v, dist (y a) x ≤ r (y a) + r x,
+  obtain ⟨K, μK, hK⟩ : ∃ K, μ (closed_ball x K) < ∞ ∧
+                          ∀ a ∈ u, (B a ∩ ball x (R x)).nonempty → B a ⊆ closed_ball x K,
+  { have Idist_v : ∀ a ∈ v, dist (c a) x ≤ r a + R x,
     { assume a hav,
       apply dist_le_add_of_nonempty_closed_ball_inter_closed_ball,
-      exact hav.2.mono (inter_subset_inter (hy a hav.1) ball_subset_closed_ball) },
-    set R0 := Sup ((λ a, r (y a)) '' v) with hR0,
-    have R0_bdd : bdd_above ((λ a, r (y a)) '' v),
+      refine hav.2.mono _,
+      apply inter_subset_inter _ ball_subset_closed_ball,
+      exact hB a (ut (vu hav)) },
+    set R0 := Sup (r '' v) with R0_def,
+    have R0_bdd : bdd_above (r '' v),
     { refine ⟨1, λ r' hr', _⟩,
       rcases (mem_image _ _ _).1 hr' with ⟨b, hb, rfl⟩,
-      exact hr1 _ },
-    rcases le_total R0 (r x) with H|H,
-    { refine ⟨20 * r x, hrμ x, λ a au hax, _⟩,
-      refine (hy a au).trans _,
+      exact le_trans (ut' (vu hb)).2 (hR1 (c b)) },
+    rcases le_total R0 (R x) with H|H,
+    { refine ⟨20 * R x, hRμ x, λ a au hax, _⟩,
+      refine (hB a (ut au)).trans _,
       apply closed_ball_subset_closed_ball',
-      have : r (y a) ≤ R0 := le_cSup R0_bdd (mem_image_of_mem _ ⟨au, hax⟩),
-      linarith [(hr0 (y a)).le, (hr0 x).le, Idist_v a ⟨au, hax⟩] },
-    { have R0pos : 0 < R0 := (hr0 x).trans_le H,
+      have : r a ≤ R0 := le_cSup R0_bdd (mem_image_of_mem _ ⟨au, hax⟩),
+      linarith [Idist_v a ⟨au, hax⟩, hR0 x] },
+    { have R0pos : 0 < R0 := (hR0 x).trans_le H,
       have vnonempty : v.nonempty,
       { by_contra,
-        rw [← ne_empty_iff_nonempty, not_not] at h,
-        simp only [h, real.Sup_empty, image_empty] at hR0,
-        exact lt_irrefl _ (R0pos.trans_le (le_of_eq hR0)) },
-      obtain ⟨a, hav, R0a⟩ : ∃ a ∈ v, R0/2 < r (y a),
-      { obtain ⟨r', r'mem, hr'⟩ : ∃ r' ∈ ((λ a, r (y a)) '' v), R0 / 2 < r' :=
+        rw [nonempty_iff_ne_empty, not_not] at h,
+        simp only [h, real.Sup_empty, image_empty] at R0_def,
+        exact lt_irrefl _ (R0pos.trans_le (le_of_eq R0_def)) },
+      obtain ⟨a, hav, R0a⟩ : ∃ a ∈ v, R0/2 < r a,
+      { obtain ⟨r', r'mem, hr'⟩ : ∃ r' ∈ r '' v, R0 / 2 < r' :=
           exists_lt_of_lt_cSup (nonempty_image_iff.2 vnonempty) (half_lt_self R0pos),
         rcases (mem_image _ _ _).1 r'mem with ⟨a, hav, rfl⟩,
         exact ⟨a, hav, hr'⟩ },
       refine ⟨8 * R0, _, _⟩,
-      { apply lt_of_le_of_lt (measure_mono _) (hrμ (y a)),
+      { apply lt_of_le_of_lt (measure_mono _) (hRμ (c a)),
         apply closed_ball_subset_closed_ball',
         rw dist_comm,
-        linarith [Idist_v a hav] },
+        linarith [Idist_v a hav, (ut' (vu hav)).2] },
       { assume b bu hbx,
-        refine (hy b bu).trans _,
+        refine (hB b (ut bu)).trans _,
         apply closed_ball_subset_closed_ball',
-        have : r (y b) ≤ R0 := le_cSup R0_bdd (mem_image_of_mem _ ⟨bu, hbx⟩),
+        have : r b ≤ R0 := le_cSup R0_bdd (mem_image_of_mem _ ⟨bu, hbx⟩),
         linarith [Idist_v b ⟨bu, hbx⟩] } } },
-  -- we will show that, in `ball x (r x)`, almost all `s` is covered by the family `u`.
-  refine ⟨_ ∩ ball x (r x), inter_mem_nhds_within _ (ball_mem_nhds _ (hr0 _)),
+  -- we will show that, in `ball x (R x)`, almost all `s` is covered by the family `u`.
+  refine ⟨_ ∩ ball x (R x), inter_mem_nhds_within _ (ball_mem_nhds _ (hR0 _)),
     nonpos_iff_eq_zero.mp (le_of_forall_le_of_dense (λ ε εpos, _))⟩,
   -- the elements of `v` are disjoint and all contained in a finite volume ball, hence the sum
   -- of their measures is finite.
-  have I : ∑' (a : v), μ a < ∞,
-  { calc ∑' (a : v), μ a = μ (⋃ (a ∈ v), a) : begin
+  have I : ∑' (a : v), μ (B a) < ∞,
+  { calc ∑' (a : v), μ (B a) = μ (⋃ (a ∈ v), B a) : begin
       rw measure_bUnion (u_count.mono vu) _ (λ a ha, (h't _ (vu.trans ut ha)).measurable_set),
       exact u_disj.subset vu
     end
-    ... ≤ μ (closed_ball x R) : measure_mono (Union₂_subset (λ a ha, hR a (vu ha) ha.2))
-    ... < ∞ : μR },
+    ... ≤ μ (closed_ball x K) : measure_mono (Union₂_subset (λ a ha, hK a (vu ha) ha.2))
+    ... < ∞ : μK },
   -- we can obtain a finite subfamily of `v`, such that the measures of the remaining elements
   -- add up to an arbitrarily small number, say `ε / C`.
-  obtain ⟨w, hw⟩ : ∃ (w : finset ↥v), ∑' (a : {a // a ∉ w}), μ a < ε / C,
-  { haveI : ne_bot (at_top : filter (finset v)) := at_top_ne_bot,
-    have : 0 < ε / C, by simp only [ennreal.div_pos_iff, εpos.ne', ennreal.coe_ne_top, ne.def,
+  obtain ⟨w, hw⟩ : ∃ (w : finset ↥v), ∑' (a : {a // a ∉ w}), μ (B a) < ε / C,
+  { have : 0 < ε / C, by simp only [ennreal.div_pos_iff, εpos.ne', ennreal.coe_ne_top, ne.def,
                                     not_false_iff, and_self],
     exact ((tendsto_order.1 (ennreal.tendsto_tsum_compl_at_top_zero I.ne)).2 _ this).exists },
-  choose! y hy using h,
   -- main property: the points `z` of `s` which are not covered by `u` are contained in the
   -- enlargements of the elements not in `w`.
-  have M : (s \ ⋃ (a : set α) (H : a ∈ u), a) ∩ ball x (r x)
-    ⊆ ⋃ (a : {a // a ∉ w}), closed_ball (y a) (3 * diam (a : set α)),
+  have M : (s \ ⋃ a ∈ u, B a) ∩ ball x (R x)
+    ⊆ ⋃ (a : {a // a ∉ w}), closed_ball (c a) (3 * r a),
   { assume z hz,
-    set k := ⋃ (a : v) (ha : a ∈ w), (a : set α) with hk,
+    set k := ⋃ (a : v) (ha : a ∈ w), B a with hk,
     have k_closed : is_closed k :=
       is_closed_bUnion w.finite_to_set (λ i hi, h't _ (ut (vu i.2))),
     have z_notmem_k : z ∉ k,
-    { simp only [not_exists, exists_prop, mem_Union, mem_sep_eq, forall_exists_index,
+    { simp only [not_exists, exists_prop, mem_Union, mem_sep_iff, forall_exists_index,
         set_coe.exists, not_and, exists_and_distrib_right, subtype.coe_mk],
       assume b hbv h'b h'z,
-      have : z ∈ (s \ ⋃ (a : set α) (H : a ∈ u), a) ∩ (⋃ (a : set α) (H : a ∈ u), a) :=
+      have : z ∈ (s \ ⋃ a ∈ u, B a) ∩ (⋃ a ∈ u, B a) :=
         mem_inter (mem_of_mem_inter_left hz) (mem_bUnion (vu hbv) h'z),
       simpa only [diff_inter_self] },
     -- since the elements of `w` are closed and finitely many, one can find a small ball around `z`
     -- not intersecting them
-    have : ball x (r x) \ k ∈ 𝓝 z,
+    have : ball x (R x) \ k ∈ 𝓝 z,
     { apply is_open.mem_nhds (is_open_ball.sdiff k_closed) _,
       exact (mem_diff _).2 ⟨mem_of_mem_inter_right hz, z_notmem_k⟩ },
-    obtain ⟨d, dpos, hd⟩ : ∃ (d : ℝ) (dpos : 0 < d), closed_ball z d ⊆ ball x (r x) \ k :=
+    obtain ⟨d, dpos, hd⟩ : ∃ (d : ℝ) (dpos : 0 < d), closed_ball z d ⊆ ball x (R x) \ k :=
       nhds_basis_closed_ball.mem_iff.1 this,
     -- choose an element `a` of the family `t` contained in this small ball
-    obtain ⟨a, hat, za, ad⟩ : ∃ a ∈ t, z ∈ a ∧ a ⊆ closed_ball z d :=
-      hf z ((mem_diff _).1 (mem_of_mem_inter_left hz)).1 d dpos,
-    have ax : a ⊆ ball x (r x) := ad.trans (hd.trans (diff_subset (ball x (r x)) k)),
+    obtain ⟨a, hat, ad, rfl⟩ : ∃ a ∈ t, r a ≤ min d (R z) ∧ c a = z,
+      from hf z ((mem_diff _).1 (mem_of_mem_inter_left hz)).1 (min d (R z)) (lt_min dpos (hR0 z)),
+    have ax : B a ⊆ ball x (R x),
+    { refine (hB a hat).trans _,
+      refine subset.trans _ (hd.trans (diff_subset (ball x (R x)) k)),
+      exact closed_ball_subset_closed_ball (ad.trans (min_le_left _ _)), },
     -- it intersects an element `b` of `u` with comparable diameter, by definition of `u`
-    obtain ⟨b, bu, ab, bdiam⟩ : ∃ (b : set α) (H : b ∈ u), (a ∩ b).nonempty ∧ diam a ≤ 2 * diam b :=
-      hu a ⟨hat, ⟨x, ax.trans ball_subset_closed_ball⟩⟩,
+    obtain ⟨b, bu, ab, bdiam⟩ : ∃ b ∈ u, (B a ∩ B b).nonempty ∧ r a ≤ 2 * r b,
+      from hu a ⟨hat, ad.trans (min_le_right _ _)⟩,
     have bv : b ∈ v,
     { refine ⟨bu, ab.mono _⟩,
       rw inter_comm,
@@ -401,109 +364,82 @@ begin
     -- contrary to `b`
     have b'_notmem_w : b' ∉ w,
     { assume b'w,
-      have b'k : (b' : set α) ⊆ k := finset.subset_set_bUnion_of_mem b'w,
-      have : ((ball x (r x) \ k) ∩ k).nonempty := ab.mono (inter_subset_inter (ad.trans hd) b'k),
+      have b'k : B b' ⊆ k, from @finset.subset_set_bUnion_of_mem _ _ _ (λ (y : v), B y) _ b'w,
+      have : ((ball x (R x) \ k) ∩ k).nonempty,
+      { apply ab.mono (inter_subset_inter _ b'k),
+        refine ((hB _ hat).trans _).trans hd,
+        exact (closed_ball_subset_closed_ball (ad.trans (min_le_left _ _))) },
       simpa only [diff_inter_self, not_nonempty_empty] },
     let b'' : {a // a ∉ w} := ⟨b', b'_notmem_w⟩,
     -- since `a` and `b` have comparable diameters, it follows that `z` belongs to the
     -- enlargement of `b`
-    have zb : z ∈ closed_ball (y b) (3 * diam b),
+    have zb : c a ∈ closed_ball (c b) (3 * r b),
     { rcases ab with ⟨e, ⟨ea, eb⟩⟩,
-      have A : dist z e ≤ diam a := dist_le_diam_of_mem (bounded_closed_ball.mono ad) za ea,
-      have B : dist e (y b) ≤ diam b,
-      { rcases (ut' bu).2 with ⟨c, hc⟩,
-        apply dist_le_diam_of_mem (bounded_closed_ball.mono hc) eb (hy b (ut bu)).1 },
+      have A : dist (c a) e ≤ r a, from mem_closed_ball'.1 (hB a hat ea),
+      have B : dist e (c b) ≤ r b, from mem_closed_ball.1 (hB b (ut bu) eb),
       simp only [mem_closed_ball],
-      linarith [dist_triangle z e (y b)] },
-    suffices H : closed_ball (y (b'' : set α)) (3 * diam (b'' : set α))
-      ⊆ ⋃ (a : {a // a ∉ w}), closed_ball (y (a : set α)) (3 * diam (a : set α)), from H zb,
-    exact subset_Union (λ (a : {a // a ∉ w}), closed_ball (y a) (3 * diam (a : set α))) b'' },
+      linarith [dist_triangle (c a) e (c b)] },
+    suffices H : closed_ball (c b'') (3 * r b'')
+      ⊆ ⋃ (a : {a // a ∉ w}), closed_ball (c a) (3 * r a), from H zb,
+    exact subset_Union (λ (a : {a // a ∉ w}), closed_ball (c a) (3 * r a)) b'' },
   -- now that we have proved our main inclusion, we can use it to estimate the measure of the points
   -- in `ball x (r x)` not covered by `u`.
   haveI : encodable v := (u_count.mono vu).to_encodable,
-  calc μ ((s \ ⋃ (a : set α) (H : a ∈ u), a) ∩ ball x (r x))
-      ≤ μ (⋃ (a : {a // a ∉ w}), closed_ball (y a) (3 * diam (a : set α))) : measure_mono M
-  ... ≤ ∑' (a : {a // a ∉ w}), μ (closed_ball (y a) (3 * diam (a : set α))) : measure_Union_le _
-  ... ≤ ∑' (a : {a // a ∉ w}), C * μ a : ennreal.tsum_le_tsum (λ a, (hy a (ut (vu a.1.2))).2)
-  ... = C * ∑' (a : {a // a ∉ w}), μ a : ennreal.tsum_mul_left
-  ... ≤ C * (ε / C) : ennreal.mul_le_mul le_rfl hw.le
-  ... ≤ ε : ennreal.mul_div_le,
+  calc μ ((s \ ⋃ a ∈ u, B a) ∩ ball x (R x))
+      ≤ μ (⋃ (a : {a // a ∉ w}), closed_ball (c a) (3 * r a)) : measure_mono M
+  ... ≤ ∑' (a : {a // a ∉ w}), μ (closed_ball (c a) (3 * r a)) :
+    measure_Union_le _
+  ... ≤ ∑' (a : {a // a ∉ w}), C * μ (B a) : ennreal.tsum_le_tsum (λ a, μB a (ut (vu a.1.2)))
+  ... = C * ∑' (a : {a // a ∉ w}), μ (B a) : ennreal.tsum_mul_left
+  ... ≤ C * (ε / C) : mul_le_mul_left' hw.le _
+  ... ≤ ε : ennreal.mul_div_le
 end
 
 /-- Assume that around every point there are arbitrarily small scales at which the measure is
-doubling. Then the set of closed sets `a` with nonempty interior covering a fixed proportion `1/C`
-of the ball `closed_ball x (3 * diam a)` forms a Vitali family. This is essentially a restatement
-of the measurable Vitali theorem. -/
+doubling. Then the set of closed sets `a` with nonempty interior contained in `closed_ball x r` and
+covering a fixed proportion `1/C` of the ball `closed_ball x (3 * r)` forms a Vitali family.
+This is essentially a restatement of the measurable Vitali theorem. -/
 protected def vitali_family [metric_space α] [measurable_space α] [opens_measurable_space α]
   [second_countable_topology α] (μ : measure α) [is_locally_finite_measure μ] (C : ℝ≥0)
-  (h : ∀ x (ε > 0), ∃ r ∈ Ioc (0 : ℝ) ε, μ (closed_ball x (6 * r)) ≤ C * μ (closed_ball x r)) :
+  (h : ∀ x, ∃ᶠ r in 𝓝[>] 0, μ (closed_ball x (3 * r)) ≤ C * μ (closed_ball x r)) :
   vitali_family μ :=
-{ sets_at := λ x, {a | x ∈ a ∧ is_closed a ∧ (interior a).nonempty ∧
-                      μ (closed_ball x (3 * diam a)) ≤ C * μ a},
-  measurable_set' := λ x a ha, ha.2.1.measurable_set,
-  nonempty_interior := λ x a ha, ha.2.2.1,
+{ sets_at := λ x, {a | is_closed a ∧ (interior a).nonempty ∧ ∃ r, (a ⊆ closed_ball x r ∧
+                      μ (closed_ball x (3 * r)) ≤ C * μ a)},
+  measurable_set' := λ x a ha, ha.1.measurable_set,
+  nonempty_interior := λ x a ha, ha.2.1,
   nontrivial := λ x ε εpos, begin
-    obtain ⟨r, ⟨rpos, rε⟩, μr⟩ : ∃ r ∈ Ioc (0 : ℝ) ε,
-      μ (closed_ball x (6 * r)) ≤ C * μ (closed_ball x r) := h x ε εpos,
-    refine ⟨closed_ball x r, ⟨_, is_closed_ball, _, _⟩, closed_ball_subset_closed_ball rε⟩,
-    { simp only [rpos.le, mem_closed_ball, dist_self] },
-    { exact (nonempty_ball.2 rpos).mono (ball_subset_interior_closed_ball) },
-    { apply le_trans (measure_mono (closed_ball_subset_closed_ball _)) μr,
-      have : diam (closed_ball x r) ≤ 2 * r := diam_closed_ball rpos.le,
-      linarith }
+    obtain ⟨r, μr, rpos, rε⟩ : ∃ r,
+      μ (closed_ball x (3 * r)) ≤ C * μ (closed_ball x r) ∧ r ∈ Ioc (0 : ℝ) ε :=
+      ((h x).and_eventually (Ioc_mem_nhds_within_Ioi ⟨le_rfl, εpos⟩)).exists,
+    refine ⟨closed_ball x r, ⟨is_closed_ball, _, ⟨r, subset.rfl, μr⟩⟩,
+      closed_ball_subset_closed_ball rε⟩,
+    exact (nonempty_ball.2 rpos).mono (ball_subset_interior_closed_ball)
   end,
   covering := begin
     assume s f fsubset ffine,
-    rcases eq_empty_or_nonempty s with rfl|H,
-    { exact ⟨∅, λ _, ∅, by simp, by simp⟩ },
-    haveI : inhabited α, { choose x hx using H, exact ⟨x⟩ },
-    let t := ⋃ (x ∈ s), f x,
-    have A₁ : ∀ x ∈ s, ∀ (ε : ℝ), 0 < ε → (∃ a ∈ t, x ∈ a ∧ a ⊆ closed_ball x ε),
+    let t : set (ℝ × α × set α) :=
+      {p | p.2.2 ⊆ closed_ball p.2.1 p.1 ∧ μ (closed_ball p.2.1 (3 * p.1)) ≤ C * μ p.2.2
+      ∧ (interior p.2.2).nonempty ∧ is_closed p.2.2 ∧ p.2.2 ∈ f p.2.1 ∧ p.2.1 ∈ s},
+    have A : ∀ x ∈ s, ∀ (ε : ℝ), ε > 0 → (∃ (p : ℝ × α × set α) (Hp : p ∈ t), p.1 ≤ ε ∧ p.2.1 = x),
     { assume x xs ε εpos,
-      rcases ffine x xs ε εpos with ⟨a, xa, hax⟩,
-      exact ⟨a, mem_bUnion xs xa, (fsubset x xs xa).1, hax⟩ },
-    have A₂ : ∀ a ∈ t, (interior a).nonempty,
-    { rintros a ha,
-      rcases mem_Union₂.1 ha with ⟨x, xs, xa⟩,
-      exact (fsubset x xs xa).2.2.1 },
-    have A₃ : ∀ a ∈ t, is_closed a,
-    { rintros a ha,
-      rcases mem_Union₂.1 ha with ⟨x, xs, xa⟩,
-      exact (fsubset x xs xa).2.1 },
-    have A₄ : ∀ a ∈ t, ∃ x ∈ a, μ (closed_ball x (3 * diam a)) ≤ C * μ a,
-    { rintros a ha,
-      rcases mem_Union₂.1 ha with ⟨x, xs, xa⟩,
-      exact ⟨x, (fsubset x xs xa).1, (fsubset x xs xa).2.2.2⟩ },
-    obtain ⟨u, ut, u_count, u_disj, μu⟩ :
-      ∃ u ⊆ t, u.countable ∧ u.pairwise disjoint ∧ μ (s \ ⋃ a ∈ u, a) = 0 :=
-        exists_disjoint_covering_ae μ s t A₁ A₂ A₃ C A₄,
-    have : ∀ a ∈ u, ∃ x ∈ s, a ∈ f x := λ a ha, mem_Union₂.1 (ut ha),
-    choose! x hx using this,
-    have inj_on_x : inj_on x u,
-    { assume a ha b hb hab,
-      have A : (a ∩ b).nonempty,
-      { refine ⟨x a, mem_inter ((fsubset _ (hx a ha).1 (hx a ha).2).1) _⟩,
-        rw hab,
-        exact (fsubset _ (hx b hb).1 (hx b hb).2).1 },
-      contrapose A,
-      have : disjoint a b := u_disj ha hb A,
-      simpa only [← not_disjoint_iff_nonempty_inter] },
-    refine ⟨x '' u, function.inv_fun_on x u, _, _, _, _⟩,
-    { assume y hy,
-      rcases (mem_image _ _ _).1 hy with ⟨a, au, rfl⟩,
-      exact (hx a au).1 },
-    { rw [inj_on_x.pairwise_disjoint_image],
-      assume a ha b hb hab,
-      simp only [function.on_fun, inj_on_x.left_inv_on_inv_fun_on ha,
-                 inj_on_x.left_inv_on_inv_fun_on hb, (∘)],
-      exact u_disj ha hb hab },
-    { assume y hy,
-      rcases (mem_image _ _ _).1 hy with ⟨a, ha, rfl⟩,
-      rw inj_on_x.left_inv_on_inv_fun_on ha,
-      exact (hx a ha).2 },
-    { rw [bUnion_image],
-      convert μu using 3,
-      exact Union₂_congr (λ a ha, inj_on_x.left_inv_on_inv_fun_on ha) }
+      rcases ffine x xs ε εpos with ⟨a, ha, h'a⟩,
+      rcases fsubset x xs ha with ⟨a_closed, a_int, ⟨r, ar, μr⟩⟩,
+      refine ⟨⟨min r ε, x, a⟩, ⟨_, _, a_int, a_closed, ha, xs⟩, min_le_right _ _, rfl⟩,
+      { rcases min_cases r ε with h'|h'; rwa h'.1 },
+      { apply le_trans (measure_mono (closed_ball_subset_closed_ball _)) μr,
+        exact mul_le_mul_of_nonneg_left (min_le_left _ _) zero_le_three } },
+    rcases exists_disjoint_covering_ae μ s t C (λ p, p.1) (λ p, p.2.1) (λ p, p.2.2) (λ p hp, hp.1)
+      (λ p hp, hp.2.1) (λ p hp, hp.2.2.1) (λ p hp, hp.2.2.2.1) A
+      with ⟨t', t't, t'_count, t'_disj, μt'⟩,
+    refine ⟨(λ (p : ℝ × α × set α), p.2) '' t', _, _, _, _⟩,
+    { rintros - ⟨q, hq, rfl⟩,
+      exact (t't hq).2.2.2.2.2 },
+    { rintros p ⟨q, hq, rfl⟩ p' ⟨q', hq', rfl⟩ hqq',
+      exact t'_disj hq hq' (ne_of_apply_ne _ hqq') },
+    { rintros - ⟨q, hq, rfl⟩,
+      exact (t't hq).2.2.2.2.1 },
+    { convert μt' using 3,
+      rw bUnion_image }
   end }
 
 end vitali
diff --git a/src/measure_theory/covering/vitali_family.lean b/src/measure_theory/covering/vitali_family.lean
index 4e63e1925e3ed..2104ee59faf9f 100644
--- a/src/measure_theory/covering/vitali_family.lean
+++ b/src/measure_theory/covering/vitali_family.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.measure_space
 /-!
 # Vitali families
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 On a metric space `X` with a measure `μ`, consider for each `x : X` a family of measurable sets with
 nonempty interiors, called `sets_at x`. This family is a Vitali family if it satisfies the following
 property: consider a (possibly non-measurable) set `s`, and for any `x` in `s` a
@@ -46,7 +49,7 @@ Vitali relations there)
 -/
 
 open measure_theory metric set filter topological_space measure_theory.measure
-open_locale filter measure_theory topological_space
+open_locale filter measure_theory topology
 
 variables {α : Type*} [metric_space α]
 
@@ -60,16 +63,16 @@ Vitali families are provided by covering theorems such as the Besicovitch coveri
 Vitali covering theorem. They make it possible to formulate general versions of theorems on
 differentiations of measure that apply in both contexts.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure vitali_family {m : measurable_space α} (μ : measure α) :=
 (sets_at : Π (x : α), set (set α))
 (measurable_set' : ∀ (x : α), ∀ (a : set α), a ∈ sets_at x → measurable_set a)
 (nonempty_interior : ∀ (x : α), ∀ (y : set α), y ∈ sets_at x → (interior y).nonempty)
 (nontrivial : ∀ (x : α) (ε > (0 : ℝ)), ∃ y ∈ sets_at x, y ⊆ closed_ball x ε)
 (covering : ∀ (s : set α) (f : Π (x : α), set (set α)), (∀ x ∈ s, f x ⊆ sets_at x) →
-  (∀ (x ∈ s) (ε > (0 : ℝ)), ∃ a ∈ f x, a ⊆ closed_ball x ε) →
-  ∃ (t : set α) (u : α → set α), t ⊆ s ∧ t.pairwise_disjoint u ∧ (∀ x ∈ t, u x ∈ f x)
-  ∧ μ (s \ ⋃ x ∈ t, u x) = 0)
+  (∀ (x ∈ s) (ε > (0 : ℝ)), ∃ a ∈ f x, a ⊆ closed_ball x ε) → ∃ (t : set (α × set α)),
+    (∀ (p : α × set α), p ∈ t → p.1 ∈ s) ∧ t.pairwise_disjoint (λ p, p.2) ∧
+    (∀ (p : α × set α), p ∈ t → p.2 ∈ f p.1) ∧ μ (s \ ⋃ (p : α × set α) (hp : p ∈ t), p.2) = 0)
 
 namespace vitali_family
 
@@ -85,8 +88,8 @@ def mono (v : vitali_family μ) (ν : measure α) (hν : ν ≪ μ) :
   nonempty_interior := v.nonempty_interior,
   nontrivial := v.nontrivial,
   covering := λ s f h h', begin
-    rcases v.covering s f h h' with ⟨t, u, ts, u_disj, uf, μu⟩,
-    exact ⟨t, u, ts, u_disj, uf, hν μu⟩
+    rcases v.covering s f h h' with ⟨t, ts, disj, mem_f, hμ⟩,
+    exact ⟨t, ts, disj, mem_f, hν hμ⟩
   end }
 
 /-- Given a Vitali family `v` for a measure `μ`, a family `f` is a fine subfamily on a set `s` if
@@ -102,53 +105,56 @@ variables {v : vitali_family μ} {f : α → set (set α)} {s : set α} (h : v.f
 include h
 
 theorem exists_disjoint_covering_ae :
-  ∃ (t : set α) (u : α → set α), t ⊆ s ∧ t.pairwise_disjoint u ∧
-    (∀ x ∈ t, u x ∈ v.sets_at x ∩ f x) ∧ μ (s \ ⋃ x ∈ t, u x) = 0 :=
+  ∃ (t : set (α × set α)), (∀ (p : α × set α), p ∈ t → p.1 ∈ s) ∧
+  t.pairwise_disjoint (λ p, p.2) ∧
+  (∀ (p : α × set α), p ∈ t → p.2 ∈ v.sets_at p.1 ∩ f p.1)
+  ∧ μ (s \ ⋃ (p : α × set α) (hp : p ∈ t), p.2) = 0 :=
 v.covering s (λ x, v.sets_at x ∩ f x) (λ x hx, inter_subset_left _ _) h
 
-/-- Given `h : v.fine_subfamily_on f s`, then `h.index` is a subset of `s` parametrizing a disjoint
+/-- Given `h : v.fine_subfamily_on f s`, then `h.index` is a set parametrizing a disjoint
 covering of almost every `s`. -/
-protected def index : set α :=
+protected def index : set (α × set α) :=
 h.exists_disjoint_covering_ae.some
 
-/-- Given `h : v.fine_subfamily_on f s`, then `h.covering x` is a set in the family,
-for `x ∈ h.index`, such that these sets form a disjoint covering of almost every `s`. -/
-protected def covering : α → set α :=
-h.exists_disjoint_covering_ae.some_spec.some
+/-- Given `h : v.fine_subfamily_on f s`, then `h.covering p` is a set in the family,
+for `p ∈ h.index`, such that these sets form a disjoint covering of almost every `s`. -/
+@[nolint unused_arguments] protected def covering : α × set α → set α :=
+λ p, p.2
 
-lemma index_subset : h.index ⊆ s :=
-h.exists_disjoint_covering_ae.some_spec.some_spec.1
+lemma index_subset : ∀ (p : α × set α), p ∈ h.index → p.1 ∈ s :=
+h.exists_disjoint_covering_ae.some_spec.1
 
 lemma covering_disjoint : h.index.pairwise_disjoint h.covering :=
-h.exists_disjoint_covering_ae.some_spec.some_spec.2.1
+h.exists_disjoint_covering_ae.some_spec.2.1
 
 lemma covering_disjoint_subtype : pairwise (disjoint on (λ x : h.index, h.covering x)) :=
 (pairwise_subtype_iff_pairwise_set _ _).2 h.covering_disjoint
 
-lemma covering_mem {x : α} (hx : x ∈ h.index) : h.covering x ∈ f x :=
-(h.exists_disjoint_covering_ae.some_spec.some_spec.2.2.1 x hx).2
+lemma covering_mem {p : α × set α} (hp : p ∈ h.index) : h.covering p ∈ f p.1 :=
+(h.exists_disjoint_covering_ae.some_spec.2.2.1 p hp).2
 
-lemma covering_mem_family {x : α} (hx : x ∈ h.index) : h.covering x ∈ v.sets_at x :=
-(h.exists_disjoint_covering_ae.some_spec.some_spec.2.2.1 x hx).1
+lemma covering_mem_family {p : α × set α} (hp : p ∈ h.index) : h.covering p ∈ v.sets_at p.1 :=
+(h.exists_disjoint_covering_ae.some_spec.2.2.1 p hp).1
 
-lemma measure_diff_bUnion : μ (s \ ⋃ x ∈ h.index, h.covering x) = 0 :=
-h.exists_disjoint_covering_ae.some_spec.some_spec.2.2.2
+lemma measure_diff_bUnion : μ (s \ ⋃ p ∈ h.index, h.covering p) = 0 :=
+h.exists_disjoint_covering_ae.some_spec.2.2.2
 
-lemma index_countable [second_countable_topology α] : countable h.index :=
+lemma index_countable [second_countable_topology α] : h.index.countable :=
 h.covering_disjoint.countable_of_nonempty_interior
   (λ x hx, v.nonempty_interior _ _ (h.covering_mem_family hx))
 
-protected lemma measurable_set_u {x : α} (hx : x ∈ h.index) : measurable_set (h.covering x) :=
-v.measurable_set' x _ (h.covering_mem_family hx)
+protected lemma measurable_set_u {p : α × set α} (hp : p ∈ h.index) :
+  measurable_set (h.covering p) :=
+v.measurable_set' p.1 _ (h.covering_mem_family hp)
 
 lemma measure_le_tsum_of_absolutely_continuous [second_countable_topology α]
   {ρ : measure α} (hρ : ρ ≪ μ) :
-  ρ s ≤ ∑' (x : h.index), ρ (h.covering x) :=
-calc ρ s ≤ ρ ((s \ ⋃ (x ∈ h.index), h.covering x) ∪ (⋃ (x ∈ h.index), h.covering x)) :
+  ρ s ≤ ∑' (p : h.index), ρ (h.covering p) :=
+calc ρ s ≤ ρ ((s \ ⋃ (p ∈ h.index), h.covering p) ∪ (⋃ (p ∈ h.index), h.covering p)) :
     measure_mono (by simp only [subset_union_left, diff_union_self])
-  ... ≤ ρ (s \ ⋃ (x ∈ h.index), h.covering x) + ρ (⋃ (x ∈ h.index), h.covering x) :
+  ... ≤ ρ (s \ ⋃ (p ∈ h.index), h.covering p) + ρ (⋃ (p ∈ h.index), h.covering p) :
     measure_union_le _ _
-  ... = ∑' (x : h.index), ρ (h.covering x) : by rw [hρ h.measure_diff_bUnion,
+  ... = ∑' (p : h.index), ρ (h.covering p) : by rw [hρ h.measure_diff_bUnion,
     measure_bUnion h.index_countable h.covering_disjoint (λ x hx, h.measurable_set_u hx),
     zero_add]
 
@@ -158,6 +164,34 @@ h.measure_le_tsum_of_absolutely_continuous measure.absolutely_continuous.rfl
 
 end fine_subfamily_on
 
+/-- One can enlarge a Vitali family by adding to the sets `f x` at `x` all sets which are not
+contained in a `δ`-neighborhood on `x`. This does not change the local filter at a point, but it
+can be convenient to get a nicer global behavior. -/
+def enlarge (v : vitali_family μ) (δ : ℝ) (δpos : 0 < δ) : vitali_family μ :=
+{ sets_at := λ x, v.sets_at x ∪
+                {a | measurable_set a ∧ (interior a).nonempty ∧ ¬(a ⊆ closed_ball x δ)},
+  measurable_set' := λ x a ha, by { cases ha, exacts [v.measurable_set' _ _ ha, ha.1] },
+  nonempty_interior := λ x a ha, by { cases ha, exacts [v.nonempty_interior _ _ ha, ha.2.1] },
+  nontrivial := begin
+    assume x ε εpos,
+    rcases v.nontrivial x ε εpos with ⟨a, ha, h'a⟩,
+    exact ⟨a, mem_union_left _ ha, h'a⟩,
+  end,
+  covering := begin
+    assume s f fset ffine,
+    let g : α → set (set α) := λ x, f x ∩ v.sets_at x,
+    have : ∀ x ∈ s, ∀ (ε : ℝ), ε > 0 → (∃ (a : set α) (H : a ∈ g x), a ⊆ closed_ball x ε),
+    { assume x hx ε εpos,
+      obtain ⟨a, af, ha⟩ : ∃ a ∈ f x, a ⊆ closed_ball x (min ε δ),
+        from ffine x hx (min ε δ) (lt_min εpos δpos),
+      rcases fset x hx af with h'a|h'a,
+      { exact ⟨a, ⟨af, h'a⟩, ha.trans (closed_ball_subset_closed_ball (min_le_left _ _))⟩ },
+      { refine false.elim (h'a.2.2 _),
+        exact ha.trans (closed_ball_subset_closed_ball (min_le_right _ _)) } },
+    rcases v.covering s g (λ x hx, inter_subset_right _ _) this with ⟨t, ts, tdisj, tg, μt⟩,
+    exact ⟨t, ts, tdisj, λ p hp, (tg p hp).1, μt⟩,
+  end }
+
 variable (v : vitali_family μ)
 include v
 
@@ -172,7 +206,7 @@ lemma mem_filter_at_iff {x : α} {s : set (set α)} :
 begin
   simp only [filter_at, exists_prop, gt_iff_lt],
   rw mem_binfi_of_directed,
-  { simp only [subset_def, and_imp, exists_prop, mem_sep_eq, mem_Ioi, mem_principal] },
+  { simp only [subset_def, and_imp, exists_prop, mem_sep_iff, mem_Ioi, mem_principal] },
   { simp only [directed_on, exists_prop, ge_iff_le, le_principal_iff, mem_Ioi, order.preimage,
       mem_principal],
     assume x hx y hy,
@@ -185,7 +219,7 @@ end
 instance filter_at_ne_bot (x : α) : (v.filter_at x).ne_bot :=
 begin
   simp only [ne_bot_iff, ←empty_mem_iff_bot, mem_filter_at_iff, not_exists, exists_prop,
-    mem_empty_eq, and_true, gt_iff_lt, not_and, ne.def, not_false_iff, not_forall],
+    mem_empty_iff_false, and_true, gt_iff_lt, not_and, ne.def, not_false_iff, not_forall],
   assume ε εpos,
   obtain ⟨w, w_sets, hw⟩ : ∃ (w ∈ v.sets_at x), w ⊆ closed_ball x ε := v.nontrivial x ε εpos,
   exact ⟨w, w_sets, hw⟩
@@ -203,6 +237,25 @@ begin
   exact ⟨1, zero_lt_one⟩
 end
 
+lemma eventually_filter_at_subset_closed_ball (x : α) {ε : ℝ} (hε : 0 < ε) :
+  ∀ᶠ (a : set α) in v.filter_at x, a ⊆ closed_ball x ε :=
+begin
+  simp only [v.eventually_filter_at_iff],
+  exact ⟨ε, hε, λ a ha ha', ha'⟩,
+end
+
+lemma tendsto_filter_at_iff {ι : Type*} {l : filter ι} {f : ι → set α} {x : α} :
+  tendsto f l (v.filter_at x) ↔
+  (∀ᶠ i in l, f i ∈ v.sets_at x) ∧ (∀ (ε > (0 : ℝ)), ∀ᶠ i in l, f i ⊆ closed_ball x ε) :=
+begin
+  refine ⟨λ H,
+    ⟨H.eventually $ v.eventually_filter_at_mem_sets x,
+     λ ε hε, H.eventually $ v.eventually_filter_at_subset_closed_ball x hε⟩,
+    λ H s hs, (_ : ∀ᶠ i in l, f i ∈ s)⟩,
+  obtain ⟨ε, εpos, hε⟩ := v.mem_filter_at_iff.mp hs,
+  filter_upwards [H.1, H.2 ε εpos] with i hi hiε using hε _ hi hiε,
+end
+
 lemma eventually_filter_at_measurable_set (x : α) :
   ∀ᶠ a in v.filter_at x, measurable_set a :=
 by { filter_upwards [v.eventually_filter_at_mem_sets x] with _ ha using v.measurable_set' _ _ ha }
diff --git a/src/measure_theory/decomposition/jordan.lean b/src/measure_theory/decomposition/jordan.lean
index 6ac5fb5ee48ac..85d3be72c1027 100644
--- a/src/measure_theory/decomposition/jordan.lean
+++ b/src/measure_theory/decomposition/jordan.lean
@@ -9,6 +9,9 @@ import measure_theory.measure.mutually_singular
 /-!
 # Jordan decomposition
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the existence and uniqueness of the Jordan decomposition for signed measures.
 The Jordan decomposition theorem states that, given a signed measure `s`, there exists a
 unique pair of mutually singular measures `μ` and `ν`, such that `s = μ - ν`.
@@ -52,7 +55,7 @@ finite measures. -/
 (pos_part neg_part : measure α)
 [pos_part_finite : is_finite_measure pos_part]
 [neg_part_finite : is_finite_measure neg_part]
-(mutually_singular : pos_part ⊥ₘ neg_part)
+(mutually_singular : pos_part ⟂ₘ neg_part)
 
 attribute [instance] jordan_decomposition.pos_part_finite
 attribute [instance] jordan_decomposition.neg_part_finite
@@ -73,11 +76,11 @@ instance : has_involutive_neg (jordan_decomposition α) :=
 { neg := λ j, ⟨j.neg_part, j.pos_part, j.mutually_singular.symm⟩,
   neg_neg := λ j, jordan_decomposition.ext _ _ rfl rfl }
 
-instance : has_scalar ℝ≥0 (jordan_decomposition α) :=
+instance : has_smul ℝ≥0 (jordan_decomposition α) :=
 { smul := λ r j, ⟨r • j.pos_part, r • j.neg_part,
     mutually_singular.smul _ (mutually_singular.smul _ j.mutually_singular.symm).symm⟩ }
 
-instance has_scalar_real : has_scalar ℝ (jordan_decomposition α) :=
+instance has_smul_real : has_smul ℝ (jordan_decomposition α) :=
 { smul := λ r j, if hr : 0 ≤ r then r.to_nnreal • j else - ((-r).to_nnreal • j) }
 
 @[simp] lemma zero_pos_part : (0 : jordan_decomposition α).pos_part = 0 := rfl
@@ -169,7 +172,7 @@ end jordan_decomposition
 
 namespace signed_measure
 
-open measure vector_measure jordan_decomposition classical
+open classical jordan_decomposition measure set vector_measure
 
 variables {s : signed_measure α} {μ ν : measure α} [is_finite_measure μ] [is_finite_measure ν]
 
@@ -221,8 +224,7 @@ begin
   rw [← of_union _ (measurable_set.inter hi₁ hk) (measurable_set.inter hi₁.compl hk),
       set.inter_comm i, set.inter_comm iᶜ, set.inter_union_compl _ _],
   { apply_instance },
-  { rintro x ⟨⟨hx₁, _⟩, hx₂, _⟩,
-    exact false.elim (hx₂ hx₁) }
+  { exact (disjoint_compl_right.inf_left _).inf_right _ }
 end
 
 section
@@ -235,7 +237,7 @@ lemma subset_positive_null_set
   (hsu : 0 ≤[u] s) (hw₁ : s w = 0) (hw₂ : w ⊆ u) (hwt : v ⊆ w) : s v = 0 :=
 begin
   have : s v + s (w \ v) = 0,
-  { rw [← hw₁, ← of_union set.disjoint_diff hv (hw.diff hv),
+  { rw [← hw₁, ← of_union set.disjoint_sdiff_right hv (hw.diff hv),
         set.union_diff_self, set.union_eq_self_of_subset_left hwt],
     apply_instance },
   have h₁ := nonneg_of_zero_le_restrict _ (restrict_le_restrict_subset _ _ hu hsu (hwt.trans hw₂)),
@@ -265,7 +267,7 @@ begin
   rw restrict_le_restrict_iff at hsu hsv,
   have a := hsu (hu.diff hv) (u.diff_subset v),
   have b := hsv (hv.diff hu) (v.diff_subset u),
-  erw [of_union (set.disjoint_of_subset_left (u.diff_subset v) set.disjoint_diff)
+  erw [of_union (set.disjoint_of_subset_left (u.diff_subset v) disjoint_sdiff_self_right)
         (hu.diff hv) (hv.diff hu)] at hs,
   rw zero_apply at a b,
   split,
@@ -293,12 +295,9 @@ lemma of_inter_eq_of_symm_diff_eq_zero_positive
 begin
   have hwuv : s ((w ∩ u) ∆ (w ∩ v)) = 0,
   { refine subset_positive_null_set (hu.union hv) ((hw.inter hu).symm_diff (hw.inter hv))
-      (hu.symm_diff hv) (restrict_le_restrict_union _ _ hu hsu hv hsv) hs _ _,
-    { exact symm_diff_le_sup u v },
-    { rintro x (⟨⟨hxw, hxu⟩, hx⟩ | ⟨⟨hxw, hxv⟩, hx⟩);
-      rw [set.mem_inter_eq, not_and] at hx,
-      { exact or.inl ⟨hxu, hx hxw⟩ },
-      { exact or.inr ⟨hxv, hx hxw⟩ } } },
+      (hu.symm_diff hv) (restrict_le_restrict_union _ _ hu hsu hv hsv) hs symm_diff_subset_union _,
+    rw ←inter_symm_diff_distrib_left,
+    exact inter_subset_right _ _ },
   obtain ⟨huv, hvu⟩ := of_diff_eq_zero_of_symm_diff_eq_zero_positive
     (hw.inter hu) (hw.inter hv)
     (restrict_le_restrict_subset _ _ hu hsu (w.inter_subset_right u))
@@ -514,7 +513,7 @@ end
 
 -- TODO: Generalize to vector measures once total variation on vector measures is defined
 lemma mutually_singular_iff (s t : signed_measure α) :
-  s ⊥ᵥ t ↔ s.total_variation ⊥ₘ t.total_variation :=
+  s ⟂ᵥ t ↔ s.total_variation ⟂ₘ t.total_variation :=
 begin
   split,
   { rintro ⟨u, hmeas, hu₁, hu₂⟩,
@@ -535,7 +534,7 @@ begin
 end
 
 lemma mutually_singular_ennreal_iff (s : signed_measure α) (μ : vector_measure α ℝ≥0∞) :
-  s ⊥ᵥ μ ↔ s.total_variation ⊥ₘ μ.ennreal_to_measure :=
+  s ⟂ᵥ μ ↔ s.total_variation ⟂ₘ μ.ennreal_to_measure :=
 begin
   split,
   { rintro ⟨u, hmeas, hu₁, hu₂⟩,
@@ -554,8 +553,8 @@ begin
 end
 
 lemma total_variation_mutually_singular_iff (s : signed_measure α) (μ : measure α) :
-  s.total_variation ⊥ₘ μ ↔
-  s.to_jordan_decomposition.pos_part ⊥ₘ μ ∧ s.to_jordan_decomposition.neg_part ⊥ₘ μ :=
+  s.total_variation ⟂ₘ μ ↔
+  s.to_jordan_decomposition.pos_part ⟂ₘ μ ∧ s.to_jordan_decomposition.neg_part ⟂ₘ μ :=
 measure.mutually_singular.add_left_iff
 
 end signed_measure
diff --git a/src/measure_theory/decomposition/lebesgue.lean b/src/measure_theory/decomposition/lebesgue.lean
index 2a56abe838e3c..b6c8c243b82d2 100644
--- a/src/measure_theory/decomposition/lebesgue.lean
+++ b/src/measure_theory/decomposition/lebesgue.lean
@@ -12,6 +12,9 @@ import measure_theory.function.ae_eq_of_integral
 /-!
 # Lebesgue decomposition
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the Lebesgue decomposition theorem. The Lebesgue decomposition theorem states that,
 given two σ-finite measures `μ` and `ν`, there exists a σ-finite measure `ξ` and a measurable
 function `f` such that `μ = ξ + fν` and `ξ` is mutually singular with respect to `ν`.
@@ -74,7 +77,7 @@ measure `ξ` and a measurable function `f`, such that `ξ` is mutually singular
 `ν` and `μ = ξ + ν.with_density f`. -/
 class have_lebesgue_decomposition (μ ν : measure α) : Prop :=
 (lebesgue_decomposition :
-  ∃ (p : measure α × (α → ℝ≥0∞)), measurable p.2 ∧ p.1 ⊥ₘ ν ∧ μ = p.1 + ν.with_density p.2)
+  ∃ (p : measure α × (α → ℝ≥0∞)), measurable p.2 ∧ p.1 ⟂ₘ ν ∧ μ = p.1 + ν.with_density p.2)
 
 /-- If a pair of measures `have_lebesgue_decomposition`, then `singular_part` chooses the
 measure from `have_lebesgue_decomposition`, otherwise it returns the zero measure. For sigma-finite
@@ -92,7 +95,7 @@ if h : have_lebesgue_decomposition μ ν then (classical.some h.lebesgue_decompo
 
 lemma have_lebesgue_decomposition_spec (μ ν : measure α)
   [h : have_lebesgue_decomposition μ ν] :
-  measurable (μ.rn_deriv ν) ∧ (μ.singular_part ν) ⊥ₘ ν ∧
+  measurable (μ.rn_deriv ν) ∧ (μ.singular_part ν) ⟂ₘ ν ∧
   μ = (μ.singular_part ν) + ν.with_density (μ.rn_deriv ν) :=
 begin
   rw [singular_part, rn_deriv, dif_pos h, dif_pos h],
@@ -129,7 +132,7 @@ begin
 end
 
 lemma mutually_singular_singular_part (μ ν : measure α) :
-  μ.singular_part ν ⊥ₘ ν :=
+  μ.singular_part ν ⟂ₘ ν :=
 begin
   by_cases h : have_lebesgue_decomposition μ ν,
   { exactI (have_lebesgue_decomposition_spec μ ν).2.1 },
@@ -226,7 +229,7 @@ This theorem provides the uniqueness of the `singular_part` in the Lebesgue deco
 while `measure_theory.measure.eq_rn_deriv` provides the uniqueness of the
 `rn_deriv`. -/
 theorem eq_singular_part {s : measure α} {f : α → ℝ≥0∞} (hf : measurable f)
-  (hs : s ⊥ₘ ν) (hadd : μ = s + ν.with_density f) :
+  (hs : s ⟂ₘ ν) (hadd : μ = s + ν.with_density f) :
   s = μ.singular_part ν :=
 begin
   haveI : have_lebesgue_decomposition μ ν := ⟨⟨⟨s, f⟩, hf, hs, hadd⟩⟩,
@@ -294,7 +297,7 @@ begin
     ((measurable_rn_deriv μ₁ ν).add (measurable_rn_deriv μ₂ ν))
     ((have_lebesgue_decomposition_spec _ _).2.1.add_left (have_lebesgue_decomposition_spec _ _).2.1)
     _).symm,
-  erw with_density_add (measurable_rn_deriv μ₁ ν) (measurable_rn_deriv μ₂ ν),
+  erw with_density_add_left (measurable_rn_deriv μ₁ ν),
   conv_rhs { rw [add_assoc, add_comm (μ₂.singular_part ν), ← add_assoc, ← add_assoc] },
   rw [← have_lebesgue_decomposition_add μ₁ ν, add_assoc,
       add_comm (ν.with_density (μ₂.rn_deriv ν)),
@@ -316,7 +319,7 @@ theorem, while `measure_theory.measure.eq_singular_part` provides the uniqueness
 `singular_part`. Here, the uniqueness is given in terms of the measures, while the uniqueness in
 terms of the functions is given in `eq_rn_deriv`. -/
 theorem eq_with_density_rn_deriv {s : measure α} {f : α → ℝ≥0∞} (hf : measurable f)
-  (hs : s ⊥ₘ ν) (hadd : μ = s + ν.with_density f) :
+  (hs : s ⟂ₘ ν) (hadd : μ = s + ν.with_density f) :
   ν.with_density f = ν.with_density (μ.rn_deriv ν) :=
 begin
   haveI : have_lebesgue_decomposition μ ν := ⟨⟨⟨s, f⟩, hf, hs, hadd⟩⟩,
@@ -366,7 +369,7 @@ theorem, while `measure_theory.measure.eq_singular_part` provides the uniqueness
 `singular_part`. Here, the uniqueness is given in terms of the functions, while the uniqueness in
 terms of the functions is given in `eq_with_density_rn_deriv`. -/
 theorem eq_rn_deriv [sigma_finite ν] {s : measure α} {f : α → ℝ≥0∞} (hf : measurable f)
-  (hs : s ⊥ₘ ν) (hadd : μ = s + ν.with_density f) :
+  (hs : s ⟂ₘ ν) (hadd : μ = s + ν.with_density f) :
   f =ᵐ[ν] μ.rn_deriv ν :=
 begin
   refine ae_eq_of_forall_set_lintegral_eq_of_sigma_finite hf (measurable_rn_deriv μ ν) _,
@@ -400,7 +403,7 @@ a measurable set `E`, such that `ν(E) > 0` and `E` is positive with respect to
 
 This lemma is useful for the Lebesgue decomposition theorem. -/
 lemma exists_positive_of_not_mutually_singular
-  (μ ν : measure α) [is_finite_measure μ] [is_finite_measure ν] (h : ¬ μ ⊥ₘ ν) :
+  (μ ν : measure α) [is_finite_measure μ] [is_finite_measure ν] (h : ¬ μ ⟂ₘ ν) :
   ∃ ε : ℝ≥0, 0 < ε ∧ ∃ E : set α, measurable_set E ∧ 0 < ν E ∧
   0 ≤[E] μ.to_signed_measure - (ε • ν).to_signed_measure :=
 begin
@@ -429,7 +432,7 @@ begin
     by_cases hb : 0 < νA,
     { suffices : ∀ b, 0 < b → μA ≤ b,
       { by_contra,
-        have h' := this (μA / 2) (nnreal.half_pos (zero_lt_iff.2 h)),
+        have h' := this (μA / 2) (half_pos (zero_lt_iff.2 h)),
         rw ← @not_not (μA ≤ μA / 2) at h',
         exact h' (not_le.2 (nnreal.half_lt_self h)) },
       intros c hc,
@@ -442,7 +445,7 @@ begin
       { rw [← nnreal.coe_lt_coe, ← mul_lt_mul_right hb₁, nnreal.coe_mul, mul_assoc,
             ← nnreal.coe_inv, ← nnreal.coe_mul, _root_.mul_inv_cancel, ← nnreal.coe_mul,
             mul_one, nnreal.coe_inv],
-        { convert hn, simp },
+        { exact hn },
         { exact ne.symm (ne_of_lt hb) } },
       refine le_trans _ (le_of_lt h'),
       rw [← ennreal.coe_le_coe, ennreal.coe_mul],
@@ -473,34 +476,6 @@ def measurable_le (μ ν : measure α) : set (α → ℝ≥0∞) :=
 lemma zero_mem_measurable_le : (0 : α → ℝ≥0∞) ∈ measurable_le μ ν :=
 ⟨measurable_zero, λ A hA, by simp⟩
 
-lemma max_measurable_le (f g : α → ℝ≥0∞)
-  (hf : f ∈ measurable_le μ ν) (hg : g ∈ measurable_le μ ν) (A : set α) (hA : measurable_set A) :
-  ∫⁻ a in A, max (f a) (g a) ∂μ ≤
-  ∫⁻ a in A ∩ { a | f a ≤ g a }, g a ∂μ + ∫⁻ a in A ∩ { a | g a < f a }, f a ∂μ :=
-begin
-  rw [← lintegral_indicator _ hA, ← lintegral_indicator f,
-      ← lintegral_indicator g, ← lintegral_add],
-  { refine lintegral_mono (λ a, _),
-    by_cases haA : a ∈ A,
-    { by_cases f a ≤ g a,
-      { simp only,
-        rw [indicator_of_mem haA, indicator_of_mem, indicator_of_not_mem, add_zero],
-        simp only [le_refl, max_le_iff, and_true, h],
-        { rintro ⟨_, hc⟩, exact false.elim ((not_lt.2 h) hc) },
-        { exact ⟨haA, h⟩ } },
-      { simp only,
-        rw [indicator_of_mem haA, indicator_of_mem _ f,
-            indicator_of_not_mem, zero_add],
-        simp only [true_and, le_refl, max_le_iff, le_of_lt (not_le.1 h)],
-        { rintro ⟨_, hc⟩, exact false.elim (h hc) },
-        { exact ⟨haA, not_le.1 h⟩ } } },
-    { simp [indicator_of_not_mem haA] } },
-  { exact measurable.indicator hg.1 (hA.inter (measurable_set_le hf.1 hg.1)) },
-  { exact measurable.indicator hf.1 (hA.inter (measurable_set_lt hg.1 hf.1)) },
-  { exact hA.inter (measurable_set_le hf.1 hg.1) },
-  { exact hA.inter (measurable_set_lt hg.1 hf.1) },
-end
-
 lemma sup_mem_measurable_le {f g : α → ℝ≥0∞}
   (hf : f ∈ measurable_le μ ν) (hg : g ∈ measurable_le μ ν) :
   (λ a, f a ⊔ g a) ∈ measurable_le μ ν :=
@@ -509,7 +484,7 @@ begin
   refine ⟨measurable.max hf.1 hg.1, λ A hA, _⟩,
   have h₁ := hA.inter (measurable_set_le hf.1 hg.1),
   have h₂ := hA.inter (measurable_set_lt hg.1 hf.1),
-  refine le_trans (max_measurable_le f g hf hg A hA) _,
+  rw [set_lintegral_max hf.1 hg.1],
   refine (add_le_add (hg.2 _ h₁) (hf.2 _ h₂)).trans_eq _,
   { simp only [← not_le, ← compl_set_of, ← diff_eq],
     exact measure_inter_add_diff _ (measurable_set_le hf.1 hg.1) }
@@ -655,7 +630,7 @@ theorem have_lebesgue_decomposition_of_finite_measure [is_finite_measure μ] [is
             le_sub_iff_add_le, ← ennreal.to_real_add, ennreal.to_real_le_to_real,
             measure.coe_smul, pi.smul_apply, with_density_apply _ (hA.inter hE₁),
             show ε • ν (A ∩ E) = (ε : ℝ≥0∞) * ν (A ∩ E), by refl,
-            ← set_lintegral_const, ← lintegral_add measurable_const hξm] at this,
+            ← set_lintegral_const, ← lintegral_add_left measurable_const] at this,
       { rw [ne.def, ennreal.add_eq_top, not_or_distrib],
         exact ⟨ne_of_lt (measure_lt_top _ _), ne_of_lt (measure_lt_top _ _)⟩ },
       { exact ne_of_lt (measure_lt_top _ _) },
@@ -669,24 +644,18 @@ theorem have_lebesgue_decomposition_of_finite_measure [is_finite_measure μ] [is
     have hξε : ξ + E.indicator (λ _, ε) ∈ measurable_le ν μ,
     { refine ⟨measurable.add hξm (measurable.indicator measurable_const hE₁), λ A hA, _⟩,
       have : ∫⁻ a in A, (ξ + E.indicator (λ _, ε)) a ∂ν =
-            ∫⁻ a in A ∩ E, ε + ξ a ∂ν + ∫⁻ a in A ∩ Eᶜ, ξ a ∂ν,
-      { rw [lintegral_add measurable_const hξm, add_assoc,
-            ← lintegral_union (hA.inter hE₁) (hA.inter hE₁.compl)
-              (disjoint.mono (inter_subset_right _ _) (inter_subset_right _ _)
-              disjoint_compl_right), inter_union_compl],
-        simp_rw [pi.add_apply],
-        rw [lintegral_add hξm (measurable.indicator measurable_const hE₁), add_comm],
-        refine congr_fun (congr_arg has_add.add _) _,
-        rw [set_lintegral_const, lintegral_indicator _ hE₁, set_lintegral_const,
-            measure.restrict_apply hE₁, inter_comm] },
+            ∫⁻ a in A ∩ E, ε + ξ a ∂ν + ∫⁻ a in A \ E, ξ a ∂ν,
+      { simp only [lintegral_add_left measurable_const, lintegral_add_left hξm,
+          set_lintegral_const, add_assoc, lintegral_inter_add_diff _ _ hE₁, pi.add_apply,
+          lintegral_indicator _ hE₁, restrict_apply hE₁],
+        rw [inter_comm, add_comm] },
       rw [this, ← measure_inter_add_diff A hE₁],
       exact add_le_add (hε₂ A hA) (hξle (A \ E) (hA.diff hE₁)) },
       have : ∫⁻ a, ξ a + E.indicator (λ _, ε) a ∂ν ≤ Sup (measurable_le_eval ν μ) :=
         le_Sup ⟨ξ + E.indicator (λ _, ε), hξε, rfl⟩,
   -- but this contradicts the maximality of `∫⁻ x, ξ x ∂ν`
       refine not_lt.2 this _,
-      rw [hξ₁, lintegral_add hξm (measurable.indicator (measurable_const) hE₁),
-          lintegral_indicator _ hE₁, set_lintegral_const],
+      rw [hξ₁, lintegral_add_left hξm, lintegral_indicator _ hE₁, set_lintegral_const],
       refine ennreal.lt_add_right _ (ennreal.mul_pos_iff.2 ⟨ennreal.coe_pos.2 hε₁, hE₂⟩).ne',
       have := measure_ne_top (ν.with_density ξ) univ,
       rwa [with_density_apply _ measurable_set.univ, measure.restrict_univ] at this },
@@ -738,7 +707,7 @@ instance have_lebesgue_decomposition_of_sigma_finite
   { choose A hA₁ hA₂ hA₃ using λ n, mutually_singular_singular_part (μn n) (νn n),
     simp only [hξ],
   -- We use the set `B := ⋃ j, (S.set j) ∩ A j` where `A n` is the set provided as
-  -- `singular_part (μn n) (νn n) ⊥ₘ νn n`
+  -- `singular_part (μn n) (νn n) ⟂ₘ νn n`
     refine ⟨⋃ j, (S.set j) ∩ A j,
       measurable_set.Union (λ n, (S.set_mem n).inter (hA₁ n)), _, _⟩,
   -- `ξ B = 0` since `ξ B = ∑ i j, singular_part (μn j) (νn j) (S.set i ∩ A i)`
@@ -754,7 +723,7 @@ instance have_lebesgue_decomposition_of_sigma_finite
             rw [hμn, ← nonpos_iff_eq_zero],
             refine le_trans ((singular_part_le _ _) _ ((S.set_mem i).inter (hA₁ i))) (le_of_eq _),
             rw [restrict_apply ((S.set_mem i).inter (hA₁ i)), inter_comm, ← inter_assoc],
-            have : disjoint (S.set j) (S.set i) := h₂ j i hij,
+            have : disjoint (S.set j) (S.set i) := h₂ hij,
             rw disjoint_iff_inter_eq_empty at this,
             rw [this, empty_inter, measure_empty] },
           { apply_instance } },
@@ -766,14 +735,16 @@ instance have_lebesgue_decomposition_of_sigma_finite
   -- `ν Bᶜ = ∑ i, ν (S.set i ∩ (A i)ᶜ) = ∑ i, (νn i) (A i)ᶜ = 0`
     { have hcompl : is_compl (⋃ n, (S.set n ∩ A n)) (⋃ n, S.set n ∩ (A n)ᶜ),
       { split,
-        { rintro x ⟨hx₁, hx₂⟩, rw mem_Union at hx₁ hx₂,
+        { rw disjoint_iff_inf_le,
+          rintro x ⟨hx₁, hx₂⟩, rw mem_Union at hx₁ hx₂,
           obtain ⟨⟨i, hi₁, hi₂⟩, ⟨j, hj₁, hj₂⟩⟩ := ⟨hx₁, hx₂⟩,
           have : i = j,
-          { by_contra hij, exact h₂ i j hij ⟨hi₁, hj₁⟩ },
+          { by_contra hij, exact (h₂ hij).le_bot ⟨hi₁, hj₁⟩ },
           exact hj₂ (this ▸ hi₂) },
-        { intros x hx,
-          simp only [mem_Union, sup_eq_union, mem_inter_eq,
-                    mem_union_eq, mem_compl_eq, or_iff_not_imp_left],
+        { rw codisjoint_iff_le_sup,
+          intros x hx,
+          simp only [mem_Union, sup_eq_union, mem_inter_iff,
+                    mem_union, mem_compl_iff, or_iff_not_imp_left],
           intro h, push_neg at h,
           rw [top_eq_univ, ← S.spanning, mem_Union] at hx,
           obtain ⟨i, hi⟩ := hx,
@@ -801,8 +772,7 @@ instance have_lebesgue_decomposition_of_sigma_finite
       rw [sum_apply _ hs, tsum_eq_single n, hνn, h₁,
           restrict_restrict (T.set_mem n), inter_self],
       { intros m hm,
-        rw [hνn, h₁, restrict_restrict (T.set_mem n),
-            disjoint_iff_inter_eq_empty.1 (h₃ n m hm.symm), restrict_empty,
+        rw [hνn, h₁, restrict_restrict (T.set_mem n), (h₃ hm.symm).inter_eq, restrict_empty,
             coe_zero, pi.zero_apply] },
       { apply_instance } },
     { exact λ n, measurable.indicator (measurable_rn_deriv _ _) (S.set_mem n) } },
@@ -888,7 +858,7 @@ def singular_part (s : signed_measure α) (μ : measure α) : signed_measure α
 section
 
 lemma singular_part_mutually_singular (s : signed_measure α) (μ : measure α) :
-  s.to_jordan_decomposition.pos_part.singular_part μ ⊥ₘ
+  s.to_jordan_decomposition.pos_part.singular_part μ ⟂ₘ
   s.to_jordan_decomposition.neg_part.singular_part μ :=
 begin
   by_cases hl : s.have_lebesgue_decomposition μ,
@@ -921,10 +891,10 @@ begin
 end
 
 lemma mutually_singular_singular_part (s : signed_measure α) (μ : measure α) :
-  singular_part s μ ⊥ᵥ μ.to_ennreal_vector_measure :=
+  singular_part s μ ⟂ᵥ μ.to_ennreal_vector_measure :=
 begin
   rw [mutually_singular_ennreal_iff, singular_part_total_variation],
-  change _ ⊥ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ),
+  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ),
   rw vector_measure.equiv_measure.right_inv μ,
   exact (mutually_singular_singular_part _ _).add_left (mutually_singular_singular_part _ _)
 end
@@ -991,13 +961,13 @@ end
 variables {s μ}
 
 lemma jordan_decomposition_add_with_density_mutually_singular
-  {f : α → ℝ} (hf : measurable f) (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) :
-  t.to_jordan_decomposition.pos_part + μ.with_density (λ (x : α), ennreal.of_real (f x)) ⊥ₘ
+  {f : α → ℝ} (hf : measurable f) (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) :
+  t.to_jordan_decomposition.pos_part + μ.with_density (λ (x : α), ennreal.of_real (f x)) ⟂ₘ
   t.to_jordan_decomposition.neg_part + μ.with_density (λ (x : α), ennreal.of_real (-f x)) :=
 begin
   rw [mutually_singular_ennreal_iff, total_variation_mutually_singular_iff] at htμ,
-  change _ ⊥ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) ∧
-         _ ⊥ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
+  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) ∧
+         _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
   rw [vector_measure.equiv_measure.right_inv] at htμ,
   exact ((jordan_decomposition.mutually_singular _).add_right
     (htμ.1.mono_ac (refl _) (with_density_absolutely_continuous _ _))).add_left
@@ -1007,7 +977,7 @@ end
 
 lemma to_jordan_decomposition_eq_of_eq_add_with_density
   {f : α → ℝ} (hf : measurable f) (hfi : integrable f μ)
-  (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
+  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
   s.to_jordan_decomposition = @jordan_decomposition.mk α _
     (t.to_jordan_decomposition.pos_part + μ.with_density (λ x, ennreal.of_real (f x)))
     (t.to_jordan_decomposition.neg_part + μ.with_density (λ x, ennreal.of_real (- f x)))
@@ -1022,7 +992,7 @@ begin
   ext i hi,
   rw [vector_measure.sub_apply, to_signed_measure_apply_measurable hi,
       to_signed_measure_apply_measurable hi, add_apply, add_apply,
-      ennreal.to_real_add, ennreal.to_real_add, add_sub_comm,
+      ennreal.to_real_add, ennreal.to_real_add, add_sub_add_comm,
       ← to_signed_measure_apply_measurable hi, ← to_signed_measure_apply_measurable hi,
       ← vector_measure.sub_apply, ← jordan_decomposition.to_signed_measure,
       to_signed_measure_to_jordan_decomposition, vector_measure.add_apply,
@@ -1034,12 +1004,12 @@ end
 
 private lemma have_lebesgue_decomposition_mk' (μ : measure α)
   {f : α → ℝ} (hf : measurable f) (hfi : integrable f μ)
-  (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
+  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
   s.have_lebesgue_decomposition μ :=
 begin
   have htμ' := htμ,
   rw mutually_singular_ennreal_iff at htμ,
-  change _ ⊥ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
+  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
   rw [vector_measure.equiv_measure.right_inv, total_variation_mutually_singular_iff] at htμ,
   refine
     { pos_part :=
@@ -1053,7 +1023,7 @@ begin
 end
 
 lemma have_lebesgue_decomposition_mk (μ : measure α) {f : α → ℝ} (hf : measurable f)
-  (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
+  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
   s.have_lebesgue_decomposition μ :=
 begin
   by_cases hfi : integrable f μ,
@@ -1065,13 +1035,13 @@ end
 
 private theorem eq_singular_part'
   (t : signed_measure α) {f : α → ℝ} (hf : measurable f) (hfi : integrable f μ)
-  (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
+  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
   t = s.singular_part μ :=
 begin
   have htμ' := htμ,
   rw [mutually_singular_ennreal_iff, total_variation_mutually_singular_iff] at htμ,
-  change _ ⊥ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) ∧
-         _ ⊥ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
+  change _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) ∧
+         _ ⟂ₘ vector_measure.equiv_measure.to_fun (vector_measure.equiv_measure.inv_fun μ) at htμ,
   rw [vector_measure.equiv_measure.right_inv] at htμ,
   { rw [singular_part, ← t.to_signed_measure_to_jordan_decomposition,
         jordan_decomposition.to_signed_measure],
@@ -1089,7 +1059,7 @@ mutually singular with respect to `μ` and `s = t + μ.with_densityᵥ f`, we ha
 `t = singular_part s μ`, i.e. `t` is the singular part of the Lebesgue decomposition between
 `s` and `μ`. -/
 theorem eq_singular_part (t : signed_measure α) (f : α → ℝ)
-  (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
+  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
   t = s.singular_part μ :=
 begin
   by_cases hfi : integrable f μ,
@@ -1172,7 +1142,7 @@ by { rw [sub_eq_add_neg, sub_eq_add_neg, singular_part_add, singular_part_neg] }
 mutually singular with respect to `μ` and `s = t + μ.with_densityᵥ f`, we have
 `f = rn_deriv s μ`, i.e. `f` is the Radon-Nikodym derivative of `s` and `μ`. -/
 theorem eq_rn_deriv (t : signed_measure α) (f : α → ℝ) (hfi : integrable f μ)
-  (htμ : t ⊥ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
+  (htμ : t ⟂ᵥ μ.to_ennreal_vector_measure) (hadd : s = t + μ.with_densityᵥ f) :
   f =ᵐ[μ] s.rn_deriv μ :=
 begin
   set f' := hfi.1.mk f,
diff --git a/src/measure_theory/decomposition/radon_nikodym.lean b/src/measure_theory/decomposition/radon_nikodym.lean
index ce7f41201fe0e..a6cfab57e8e65 100644
--- a/src/measure_theory/decomposition/radon_nikodym.lean
+++ b/src/measure_theory/decomposition/radon_nikodym.lean
@@ -8,6 +8,9 @@ import measure_theory.decomposition.lebesgue
 /-!
 # Radon-Nikodym theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the Radon-Nikodym theorem. The Radon-Nikodym theorem states that, given measures
 `μ, ν`, if `have_lebesgue_decomposition μ ν`, then `μ` is absolutely continuous with respect to
 `ν` if and only if there exists a measurable function `f : α → ℝ≥0∞` such that `μ = fν`.
diff --git a/src/measure_theory/decomposition/signed_hahn.lean b/src/measure_theory/decomposition/signed_hahn.lean
index c54a22e05ebb4..bda6013a8533d 100644
--- a/src/measure_theory/decomposition/signed_hahn.lean
+++ b/src/measure_theory/decomposition/signed_hahn.lean
@@ -9,6 +9,9 @@ import order.symm_diff
 /-!
 # Hahn decomposition
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the Hahn decomposition theorem (signed version). The Hahn decomposition theorem
 states that, given a signed measure `s`, there exist complementary, measurable sets `i` and `j`,
 such that `i` is positive and `j` is negative with respect to `s`; that is, `s` restricted on `i`
@@ -224,13 +227,10 @@ end
 private lemma restrict_nonpos_seq_disjoint : pairwise (disjoint on (restrict_nonpos_seq s i)) :=
 begin
   intros n m h,
+  rw [function.on_fun, set.disjoint_iff_inter_eq_empty],
   rcases lt_or_gt_of_ne h with (h | h),
-  { intro x,
-    rw [set.inf_eq_inter, restrict_nonpos_seq_disjoint' h],
-    exact id },
-  { intro x,
-    rw [set.inf_eq_inter, set.inter_comm, restrict_nonpos_seq_disjoint' h],
-    exact id }
+  { rw [restrict_nonpos_seq_disjoint' h] },
+  { rw [set.inter_comm, restrict_nonpos_seq_disjoint' h] }
 end
 
 private lemma exists_subset_restrict_nonpos' (hi₁ : measurable_set i) (hi₂ : s i < 0)
@@ -242,7 +242,7 @@ begin
   set k := nat.find hn with hk₁,
   have hk₂ : s ≤[i \ ⋃ l < k, restrict_nonpos_seq s i l] 0 := nat.find_spec hn,
   have hmeas : measurable_set (⋃ (l : ℕ) (H : l < k), restrict_nonpos_seq s i l) :=
-    (measurable_set.Union $ λ _, measurable_set.Union_Prop
+    (measurable_set.Union $ λ _, measurable_set.Union
       (λ _, restrict_nonpos_seq_measurable_set _)),
   refine ⟨i \ ⋃ l < k, restrict_nonpos_seq s i l, hi₁.diff hmeas, set.diff_subset _ _, hk₂, _⟩,
   rw [of_diff hmeas hi₁, s.of_disjoint_Union_nat],
@@ -250,7 +250,7 @@ begin
     { intros l hl,
       refine le_of_lt (measure_of_restrict_nonpos_seq h _ _),
       refine mt (restrict_le_zero_subset _ (hi₁.diff _) (set.subset.refl _)) (nat.find_min hn hl),
-      exact (measurable_set.Union $ λ _, measurable_set.Union_Prop
+      exact (measurable_set.Union $ λ _, measurable_set.Union
         (λ _, restrict_nonpos_seq_measurable_set _)) },
     suffices : 0 ≤ ∑' (l : ℕ), s (⋃ (H : l < k), restrict_nonpos_seq s i l),
     { rw sub_neg,
@@ -262,12 +262,13 @@ begin
       rw [set.mem_Union, exists_prop, and_iff_right_iff_imp],
       exact λ _, h },
     { convert le_of_eq s.empty.symm,
-      ext, simp only [exists_prop, set.mem_empty_eq, set.mem_Union, not_and, iff_false],
+      ext, simp only [exists_prop, set.mem_empty_iff_false, set.mem_Union, not_and, iff_false],
       exact λ h', false.elim (h h') } },
-  { intro, exact measurable_set.Union_Prop (λ _, restrict_nonpos_seq_measurable_set _) },
-  { intros a b hab x hx,
-    simp only [exists_prop, set.mem_Union, set.mem_inter_eq, set.inf_eq_inter] at hx,
-    exact let ⟨⟨_, hx₁⟩, _, hx₂⟩ := hx in restrict_nonpos_seq_disjoint a b hab ⟨hx₁, hx₂⟩ },
+  { intro, exact measurable_set.Union (λ _, restrict_nonpos_seq_measurable_set _) },
+  { intros a b hab,
+    refine set.disjoint_Union_left.mpr (λ ha, _),
+    refine set.disjoint_Union_right.mpr (λ hb, _),
+    exact restrict_nonpos_seq_disjoint hab },
   { apply set.Union_subset,
     intros a x,
     simp only [and_imp, exists_prop, set.mem_Union],
@@ -371,7 +372,7 @@ begin
   { intro n,
     refine le_trans _ (le_of_lt (h_lt _)),
     rw [hA, ← set.diff_union_of_subset (set.subset_Union _ n),
-        of_union (disjoint.comm.1 set.disjoint_diff) _ (hmeas n)],
+        of_union set.disjoint_sdiff_left _ (hmeas n)],
     { refine add_le_of_nonpos_left _,
       have : s ≤[A] 0 := restrict_le_restrict_Union _ _ hmeas hr,
       refine nonpos_of_restrict_le_zero _ (restrict_le_zero_subset _ _ (set.diff_subset _ _) this),
@@ -399,7 +400,7 @@ begin
   { apply le_antisymm,
     { refine le_of_tendsto_of_tendsto tendsto_const_nhds hf₂ (eventually_of_forall (λ n, _)),
       rw [← (hB n).2, hA, ← set.diff_union_of_subset (set.subset_Union _ n),
-          of_union (disjoint.comm.1 set.disjoint_diff) _ (hB₁ n)],
+          of_union set.disjoint_sdiff_left _ (hB₁ n)],
       { refine add_le_of_nonpos_left _,
         have : s ≤[A] 0 :=
           restrict_le_restrict_Union _ _ hB₁ (λ m, let ⟨_, h⟩ := (hB m).1 in h),
diff --git a/src/measure_theory/decomposition/unsigned_hahn.lean b/src/measure_theory/decomposition/unsigned_hahn.lean
index 7c41df895fa79..1f6150bc2c764 100644
--- a/src/measure_theory/decomposition/unsigned_hahn.lean
+++ b/src/measure_theory/decomposition/unsigned_hahn.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.measure_space
 /-!
 # Unsigned Hahn decomposition theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the unsigned version of the Hahn decomposition theorem.
 
 ## Main statements
@@ -22,17 +25,12 @@ Hahn decomposition
 -/
 
 open set filter
-open_locale classical topological_space ennreal
+open_locale classical topology ennreal
 
 namespace measure_theory
 
 variables {α : Type*} [measurable_space α] {μ ν : measure α}
 
--- suddenly this is necessary?!
-private lemma aux {m : ℕ} {γ d : ℝ} (h : γ - (1 / 2) ^ m < d) :
-  γ - 2 * (1 / 2) ^ m + (1 / 2) ^ m ≤ d :=
-by linarith
-
 /-- **Hahn decomposition theorem** -/
 lemma hahn_decomposition [is_finite_measure μ] [is_finite_measure ν] :
   ∃s, measurable_set s ∧
@@ -61,7 +59,7 @@ begin
       ennreal.to_nnreal_add (hμ _) (hμ _), ennreal.to_nnreal_add (hν _) (hν _),
       nnreal.coe_add, nnreal.coe_add],
     simp only [sub_eq_add_neg, neg_add],
-    ac_refl },
+    abel },
 
   have d_Union : ∀(s : ℕ → set α), monotone s →
     tendsto (λn, d (s n)) at_top (𝓝 (d (⋃n, s n))),
@@ -106,7 +104,7 @@ begin
   have hf : ∀n m, measurable_set (f n m),
   { assume n m,
     simp only [f, finset.inf_eq_infi],
-    exact measurable_set.bInter (countable_encodable _) (assume i _, he₁ _) },
+    exact measurable_set.bInter (to_countable _) (assume i _, he₁ _) },
 
   have f_subset_f : ∀{a b c d}, a ≤ b → c ≤ d → f a d ⊆ f b c,
   { assume a b c d hab hcd,
@@ -127,7 +125,7 @@ begin
     { have := he₂ m,
       simp only [f],
       rw [nat.Ico_succ_singleton, finset.inf_singleton],
-      exact aux this },
+      linarith },
     { assume n (hmn : m ≤ n) ih,
       have : γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n + 1)) ≤ γ + d (f m (n + 1)),
       { calc γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n+1)) ≤
@@ -138,7 +136,7 @@ begin
             linarith
           end
           ... = (γ - (1 / 2)^(n+1)) + (γ - 2 * (1 / 2)^m + (1 / 2)^n) :
-            by simp only [sub_eq_add_neg]; ac_refl
+            by simp only [sub_eq_add_neg]; abel
           ... ≤ d (e (n + 1)) + d (f m n) : add_le_add (le_of_lt $ he₂ _) ih
           ... ≤ d (e (n + 1)) + d (f m n \ e (n + 1)) + d (f m (n + 1)) :
             by rw [f_succ _ _ hmn, d_split (f m n) (e (n + 1)) (hf _ _) (he₁ _), add_assoc]
@@ -146,7 +144,7 @@ begin
             begin
               rw [d_split (e (n + 1) ∪ f m n) (e (n + 1)),
                 union_diff_left, union_inter_cancel_left],
-              ac_refl,
+              abel,
               exact (he₁ _).union (hf _ _),
               exact (he₁ _)
             end
@@ -157,7 +155,8 @@ begin
   let s := ⋃ m, ⋂n, f m n,
   have γ_le_d_s : γ ≤ d s,
   { have hγ : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 γ),
-    { suffices : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 (γ - 2 * 0)), { simpa },
+    { suffices : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 (γ - 2 * 0)),
+      { simpa only [mul_zero, tsub_zero] },
       exact (tendsto_const_nhds.sub $ tendsto_const_nhds.mul $
         tendsto_pow_at_top_nhds_0_of_lt_1
           (le_of_lt $ half_pos $ zero_lt_one) (half_lt_self zero_lt_one)) },
@@ -190,11 +189,8 @@ begin
     exact ((add_le_add_iff_left γ).1 $
       calc γ + d t ≤ d s + d t : add_le_add γ_le_d_s le_rfl
         ... = d (s ∪ t) :
-        begin
-          rw [d_split _ _ (hs.union ht) ht, union_diff_right, union_inter_cancel_right,
-            diff_eq_self.2],
-          exact assume a ⟨hat, has⟩, hts hat has
-        end
+          by rw [d_split _ _ (hs.union ht) ht, union_diff_right, union_inter_cancel_right,
+            (subset_compl_iff_disjoint_left.1 hts).sdiff_eq_left]
         ... ≤ γ + 0 : by rw [add_zero]; exact d_le_γ _ (hs.union ht)),
     rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, ← nnreal.coe_le_coe],
     simpa only [d, sub_le_iff_le_add, zero_add] using this }
diff --git a/src/measure_theory/function/ae_eq_fun.lean b/src/measure_theory/function/ae_eq_fun.lean
index 1227e854a4621..85f19720ac1b6 100644
--- a/src/measure_theory/function/ae_eq_fun.lean
+++ b/src/measure_theory/function/ae_eq_fun.lean
@@ -6,12 +6,15 @@ Authors: Johannes Hölzl, Zhouhang Zhou
 import measure_theory.integral.lebesgue
 import order.filter.germ
 import topology.continuous_function.algebra
-import measure_theory.function.strongly_measurable
+import measure_theory.function.strongly_measurable.basic
 
 /-!
 
 # Almost everywhere equal functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We build a space of equivalence classes of functions, where two functions are treated as identical
 if they are almost everywhere equal. We form the set of equivalence classes under the relation of
 being almost everywhere equal, which is sometimes known as the `L⁰` space.
@@ -68,7 +71,7 @@ function space, almost everywhere equal, `L⁰`, ae_eq_fun
 -/
 
 noncomputable theory
-open_locale classical ennreal topological_space
+open_locale classical ennreal topology
 
 open set filter topological_space ennreal emetric measure_theory function
 variables {α β γ δ : Type*} [measurable_space α] {μ ν : measure α}
@@ -116,11 +119,11 @@ ae_strongly_measurable.strongly_measurable_mk _
 protected lemma ae_strongly_measurable (f : α →ₘ[μ] β) : ae_strongly_measurable f μ :=
 f.strongly_measurable.ae_strongly_measurable
 
-protected lemma measurable [metrizable_space β] [measurable_space β] [borel_space β]
+protected lemma measurable [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
   (f : α →ₘ[μ] β) : measurable f :=
 ae_strongly_measurable.measurable_mk _
 
-protected lemma ae_measurable [metrizable_space β] [measurable_space β] [borel_space β]
+protected lemma ae_measurable [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
   (f : α →ₘ[μ] β) :
   ae_measurable f μ :=
 f.measurable.ae_measurable
@@ -199,8 +202,9 @@ by { rw [comp_eq_mk], apply coe_fn_mk }
 
 section comp_measurable
 
-variables [measurable_space β] [metrizable_space β] [borel_space β]
-  [measurable_space γ] [metrizable_space γ] [opens_measurable_space γ] [second_countable_topology γ]
+variables [measurable_space β] [pseudo_metrizable_space β] [borel_space β]
+  [measurable_space γ] [pseudo_metrizable_space γ] [opens_measurable_space γ]
+  [second_countable_topology γ]
 
 /-- Given a measurable function `g : β → γ`, and an almost everywhere equal function `[f] : α →ₘ β`,
     return the equivalence class of `g ∘ f`, i.e., the almost everywhere equal function
@@ -277,9 +281,11 @@ by { rw comp₂_eq_mk, apply coe_fn_mk }
 
 section
 
-variables [measurable_space β] [metrizable_space β] [borel_space β] [second_countable_topology β]
-  [measurable_space γ] [metrizable_space γ] [borel_space γ] [second_countable_topology γ]
-  [measurable_space δ] [metrizable_space δ] [opens_measurable_space δ] [second_countable_topology δ]
+variables
+  [measurable_space β] [pseudo_metrizable_space β] [borel_space β] [second_countable_topology β]
+  [measurable_space γ] [pseudo_metrizable_space γ] [borel_space γ] [second_countable_topology γ]
+  [measurable_space δ] [pseudo_metrizable_space δ] [opens_measurable_space δ]
+  [second_countable_topology δ]
 
 /-- Given a measurable function `g : β → γ → δ`, and almost everywhere equal functions
     `[f₁] : α →ₘ β` and `[f₂] : α →ₘ γ`, return the equivalence class of the function
@@ -331,9 +337,9 @@ lemma comp_to_germ (g : β → γ) (hg : continuous g) (f : α →ₘ[μ] β) :
   (comp g hg f).to_germ = f.to_germ.map g :=
 induction_on f $ λ f hf, by simp
 
-lemma comp_measurable_to_germ [measurable_space β] [borel_space β] [metrizable_space β]
-  [metrizable_space γ] [second_countable_topology γ] [measurable_space γ] [opens_measurable_space γ]
-  (g : β → γ) (hg : measurable g) (f : α →ₘ[μ] β) :
+lemma comp_measurable_to_germ [measurable_space β] [borel_space β] [pseudo_metrizable_space β]
+  [pseudo_metrizable_space γ] [second_countable_topology γ] [measurable_space γ]
+  [opens_measurable_space γ] (g : β → γ) (hg : measurable g) (f : α →ₘ[μ] β) :
   (comp_measurable g hg f).to_germ = f.to_germ.map g :=
 induction_on f $ λ f hf, by simp
 
@@ -343,10 +349,10 @@ lemma comp₂_to_germ (g : β → γ → δ) (hg : continuous (uncurry g))
 induction_on₂ f₁ f₂ $ λ f₁ hf₁ f₂ hf₂, by simp
 
 lemma comp₂_measurable_to_germ
-  [metrizable_space β] [second_countable_topology β] [measurable_space β] [borel_space β]
-  [metrizable_space γ] [second_countable_topology γ] [measurable_space γ] [borel_space γ]
-  [metrizable_space δ] [second_countable_topology δ] [measurable_space δ] [opens_measurable_space δ]
-  (g : β → γ → δ) (hg : measurable (uncurry g))
+  [pseudo_metrizable_space β] [second_countable_topology β] [measurable_space β] [borel_space β]
+  [pseudo_metrizable_space γ] [second_countable_topology γ] [measurable_space γ] [borel_space γ]
+  [pseudo_metrizable_space δ] [second_countable_topology δ] [measurable_space δ]
+  [opens_measurable_space δ] (g : β → γ → δ) (hg : measurable (uncurry g))
   (f₁ : α →ₘ[μ] β) (f₂ : α →ₘ[μ] γ) :
   (comp₂_measurable g hg f₁ f₂).to_germ = f₁.to_germ.map₂ g f₂.to_germ :=
 induction_on₂ f₁ f₂ $ λ f₁ hf₁ f₂ hf₂, by simp
@@ -386,14 +392,13 @@ partial_order.lift to_germ to_germ_injective
 section lattice
 
 section sup
-variables [semilattice_sup β] [measurable_space β] [second_countable_topology β]
-  [metrizable_space β] [borel_space β] [has_measurable_sup₂ β]
+variables [semilattice_sup β] [has_continuous_sup β]
 
 instance : has_sup (α →ₘ[μ] β) :=
-{ sup := λ f g, ae_eq_fun.comp₂_measurable (⊔) measurable_sup f g }
+{ sup := λ f g, ae_eq_fun.comp₂ (⊔) continuous_sup f g }
 
 lemma coe_fn_sup (f g : α →ₘ[μ] β) : ⇑(f ⊔ g) =ᵐ[μ] λ x, f x ⊔ g x :=
-coe_fn_comp₂_measurable _ _ _ _
+coe_fn_comp₂ _ _ _ _
 
 protected lemma le_sup_left (f g : α →ₘ[μ] β) : f ≤ f ⊔ g :=
 by { rw ← coe_fn_le, filter_upwards [coe_fn_sup f g] with _ ha, rw ha, exact le_sup_left, }
@@ -412,14 +417,13 @@ end
 end sup
 
 section inf
-variables [semilattice_inf β] [measurable_space β] [second_countable_topology β]
-  [metrizable_space β] [borel_space β] [has_measurable_inf₂ β]
+variables [semilattice_inf β] [has_continuous_inf β]
 
 instance : has_inf (α →ₘ[μ] β) :=
-{ inf := λ f g, ae_eq_fun.comp₂_measurable (⊓) measurable_inf f g }
+{ inf := λ f g, ae_eq_fun.comp₂ (⊓) continuous_inf f g }
 
 lemma coe_fn_inf (f g : α →ₘ[μ] β) : ⇑(f ⊓ g) =ᵐ[μ] λ x, f x ⊓ g x :=
-coe_fn_comp₂_measurable _ _ _ _
+coe_fn_comp₂ _ _ _ _
 
 protected lemma inf_le_left (f g : α →ₘ[μ] β) : f ⊓ g ≤ f :=
 by { rw ← coe_fn_le, filter_upwards [coe_fn_inf f g] with _ ha, rw ha, exact inf_le_left, }
@@ -437,9 +441,7 @@ end
 
 end inf
 
-instance [lattice β] [measurable_space β] [second_countable_topology β]
-  [metrizable_space β] [borel_space β]
-  [has_measurable_sup₂ β] [has_measurable_inf₂ β] : lattice (α →ₘ[μ] β) :=
+instance [lattice β] [topological_lattice β] : lattice (α →ₘ[μ] β) :=
 { sup           := has_sup.sup,
   le_sup_left   := ae_eq_fun.le_sup_left,
   le_sup_right  := ae_eq_fun.le_sup_right,
@@ -474,13 +476,13 @@ instance [inhabited β] : inhabited (α →ₘ[μ] β) := ⟨const α default⟩
 
 -- Note we set up the scalar actions before the `monoid` structures in case we want to
 -- try to override the `nsmul` or `zsmul` fields in future.
-section has_scalar
+section has_smul
 
 variables {𝕜 𝕜' : Type*}
-variables [has_scalar 𝕜 γ] [has_continuous_const_smul 𝕜 γ]
-variables [has_scalar 𝕜' γ] [has_continuous_const_smul 𝕜' γ]
+variables [has_smul 𝕜 γ] [has_continuous_const_smul 𝕜 γ]
+variables [has_smul 𝕜' γ] [has_continuous_const_smul 𝕜' γ]
 
-instance : has_scalar 𝕜 (α →ₘ[μ] γ) :=
+instance : has_smul 𝕜 (α →ₘ[μ] γ) :=
 ⟨λ c f, comp ((•) c) (continuous_id.const_smul c) f⟩
 
 @[simp] lemma smul_mk (c : 𝕜) (f : α → γ) (hf : ae_strongly_measurable f μ) :
@@ -495,13 +497,13 @@ comp_to_germ _ _ _
 instance [smul_comm_class 𝕜 𝕜' γ] : smul_comm_class 𝕜 𝕜' (α →ₘ[μ] γ) :=
 ⟨λ a b f, induction_on f $ λ f hf, by simp_rw [smul_mk, smul_comm]⟩
 
-instance [has_scalar 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' γ] : is_scalar_tower 𝕜 𝕜' (α →ₘ[μ] γ) :=
+instance [has_smul 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' γ] : is_scalar_tower 𝕜 𝕜' (α →ₘ[μ] γ) :=
 ⟨λ a b f, induction_on f $ λ f hf, by simp_rw [smul_mk, smul_assoc]⟩
 
-instance [has_scalar 𝕜ᵐᵒᵖ γ] [is_central_scalar 𝕜 γ] : is_central_scalar 𝕜 (α →ₘ[μ] γ) :=
+instance [has_smul 𝕜ᵐᵒᵖ γ] [is_central_scalar 𝕜 γ] : is_central_scalar 𝕜 (α →ₘ[μ] γ) :=
 ⟨λ a f, induction_on f $ λ f hf, by simp_rw [smul_mk, op_smul_eq_smul]⟩
 
-end has_scalar
+end has_smul
 
 section has_mul
 variables [has_mul γ] [has_continuous_mul γ]
@@ -671,11 +673,25 @@ by rw [← lintegral_mk, mk_coe_fn]
 induction_on f $ λ f hf, (lintegral_eq_zero_iff' hf.ae_measurable).trans mk_eq_mk.symm
 
 lemma lintegral_add (f g : α →ₘ[μ] ℝ≥0∞) : lintegral (f + g) = lintegral f + lintegral g :=
-induction_on₂ f g $ λ f hf g hg, by simp [lintegral_add' hf.ae_measurable hg.ae_measurable]
+induction_on₂ f g $ λ f hf g hg, by simp [lintegral_add_left' hf.ae_measurable]
 
 lemma lintegral_mono {f g : α →ₘ[μ] ℝ≥0∞} : f ≤ g → lintegral f ≤ lintegral g :=
 induction_on₂ f g $ λ f hf g hg hfg, lintegral_mono_ae hfg
 
+section abs
+
+lemma coe_fn_abs {β} [topological_space β] [lattice β] [topological_lattice β]
+  [add_group β] [topological_add_group β]
+  (f : α →ₘ[μ] β) :
+  ⇑|f| =ᵐ[μ] λ x, |f x| :=
+begin
+  simp_rw abs_eq_sup_neg,
+  filter_upwards [ae_eq_fun.coe_fn_sup f (-f), ae_eq_fun.coe_fn_neg f] with x hx_sup hx_neg,
+  rw [hx_sup, hx_neg, pi.neg_apply],
+end
+
+end abs
+
 section pos_part
 
 variables [linear_order γ] [order_closed_topology γ] [has_zero γ]
@@ -703,7 +719,7 @@ namespace continuous_map
 open measure_theory
 
 variables [topological_space α] [borel_space α] (μ)
-variables [topological_space β] [second_countable_topology_either α β] [metrizable_space β]
+variables [topological_space β] [second_countable_topology_either α β] [pseudo_metrizable_space β]
 
 /-- The equivalence class of `μ`-almost-everywhere measurable functions associated to a continuous
 map. -/
@@ -726,7 +742,7 @@ def to_ae_eq_fun_mul_hom : C(α, β) →* α →ₘ[μ] β :=
     f.continuous.ae_strongly_measurable g.continuous.ae_strongly_measurable }
 
 variables {𝕜 : Type*} [semiring 𝕜]
-variables [topological_space γ] [metrizable_space γ] [add_comm_group γ]
+variables [topological_space γ] [pseudo_metrizable_space γ] [add_comm_group γ]
   [module 𝕜 γ] [topological_add_group γ] [has_continuous_const_smul 𝕜 γ]
   [second_countable_topology_either α γ]
 
@@ -737,3 +753,6 @@ def to_ae_eq_fun_linear_map : C(α, γ) →ₗ[𝕜] α →ₘ[μ] γ :=
   .. to_ae_eq_fun_add_hom μ }
 
 end continuous_map
+
+-- Guard against import creep
+assert_not_exists inner_product_space
diff --git a/src/measure_theory/function/ae_eq_of_integral.lean b/src/measure_theory/function/ae_eq_of_integral.lean
index 1ebaa6d706f9d..27c711e645a7e 100644
--- a/src/measure_theory/function/ae_eq_of_integral.lean
+++ b/src/measure_theory/function/ae_eq_of_integral.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
 
+import analysis.inner_product_space.basic
 import analysis.normed_space.dual
-import measure_theory.function.strongly_measurable_lp
+import measure_theory.function.strongly_measurable.lp
 import measure_theory.integral.set_integral
 
 /-! # From equality of integrals to equality of functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides various statements of the general form "if two functions have the same integral
 on all sets, then they are equal almost everywhere".
 The different lemmas use various hypotheses on the class of functions, on the target space or on the
@@ -52,7 +56,8 @@ section ae_eq_of_forall
 
 variables {α E 𝕜 : Type*} {m : measurable_space α} {μ : measure α} [is_R_or_C 𝕜]
 
-lemma ae_eq_zero_of_forall_inner [inner_product_space 𝕜 E] [second_countable_topology E]
+lemma ae_eq_zero_of_forall_inner
+  [normed_add_comm_group E] [inner_product_space 𝕜 E] [second_countable_topology E]
   {f : α → E} (hf : ∀ c : E, (λ x, (inner c (f x) : 𝕜)) =ᵐ[μ] 0) :
   f =ᵐ[μ] 0 :=
 begin
@@ -60,7 +65,7 @@ begin
   have hs : dense_range s := dense_range_dense_seq E,
   have hf' : ∀ᵐ x ∂μ, ∀ n : ℕ, inner (s n) (f x) = (0 : 𝕜), from ae_all_iff.mpr (λ n, hf (s n)),
   refine hf'.mono (λ x hx, _),
-  rw [pi.zero_apply, ← inner_self_eq_zero],
+  rw [pi.zero_apply, ← @inner_self_eq_zero 𝕜],
   have h_closed : is_closed {c : E | inner c (f x) = (0 : 𝕜)},
     from is_closed_eq (continuous_id.inner continuous_const) continuous_const,
   exact @is_closed_property ℕ E _ s (λ c, inner c (f x) = (0 : 𝕜)) hs h_closed (λ n, hx n) _,
@@ -70,43 +75,43 @@ local notation `⟪`x`, `y`⟫` := y x
 
 variables (𝕜)
 
-lemma ae_eq_zero_of_forall_dual_of_is_separable [normed_group E] [normed_space 𝕜 E]
+lemma ae_eq_zero_of_forall_dual_of_is_separable [normed_add_comm_group E] [normed_space 𝕜 E]
   {t : set E} (ht : topological_space.is_separable t)
   {f : α → E} (hf : ∀ c : dual 𝕜 E, (λ x, ⟪f x, c⟫) =ᵐ[μ] 0) (h't : ∀ᵐ x ∂μ, f x ∈ t) :
   f =ᵐ[μ] 0 :=
 begin
   rcases ht with ⟨d, d_count, hd⟩,
   haveI : encodable d := d_count.to_encodable,
-  have : ∀ (x : d), ∃ g : E →L[𝕜] 𝕜, ∥g∥ ≤ 1 ∧ g x = ∥(x : E)∥ := λ x, exists_dual_vector'' 𝕜 x,
+  have : ∀ (x : d), ∃ g : E →L[𝕜] 𝕜, ‖g‖ ≤ 1 ∧ g x = ‖(x : E)‖ := λ x, exists_dual_vector'' 𝕜 x,
   choose s hs using this,
   have A : ∀ (a : E), a ∈ t → (∀ x, ⟪a, s x⟫ = (0 : 𝕜)) → a = 0,
   { assume a hat ha,
     contrapose! ha,
-    have a_pos : 0 < ∥a∥, by simp only [ha, norm_pos_iff, ne.def, not_false_iff],
+    have a_pos : 0 < ‖a‖, by simp only [ha, norm_pos_iff, ne.def, not_false_iff],
     have a_mem : a ∈ closure d := hd hat,
-    obtain ⟨x, hx⟩ : ∃ (x : d), dist a x < ∥a∥ / 2,
-    { rcases metric.mem_closure_iff.1 a_mem (∥a∥/2) (half_pos a_pos) with ⟨x, h'x, hx⟩,
+    obtain ⟨x, hx⟩ : ∃ (x : d), dist a x < ‖a‖ / 2,
+    { rcases metric.mem_closure_iff.1 a_mem (‖a‖/2) (half_pos a_pos) with ⟨x, h'x, hx⟩,
       exact ⟨⟨x, h'x⟩, hx⟩ },
     use x,
-    have I : ∥a∥/2 < ∥(x : E)∥,
-    { have : ∥a∥ ≤ ∥(x : E)∥ + ∥a - x∥ := norm_le_insert' _ _,
-      have : ∥a - x∥ < ∥a∥/2, by rwa dist_eq_norm at hx,
+    have I : ‖a‖/2 < ‖(x : E)‖,
+    { have : ‖a‖ ≤ ‖(x : E)‖ + ‖a - x‖ := norm_le_insert' _ _,
+      have : ‖a - x‖ < ‖a‖/2, by rwa dist_eq_norm at hx,
       linarith },
     assume h,
-    apply lt_irrefl (∥s x x∥),
-    calc ∥s x x∥ = ∥s x (x - a)∥ : by simp only [h, sub_zero, continuous_linear_map.map_sub]
-    ... ≤ 1 * ∥(x : E) - a∥ : continuous_linear_map.le_of_op_norm_le _ (hs x).1 _
-    ... < ∥a∥ / 2 : by { rw [one_mul], rwa dist_eq_norm' at hx }
-    ... < ∥(x : E)∥ : I
-    ... = ∥s x x∥ : by rw [(hs x).2, is_R_or_C.norm_coe_norm] },
+    apply lt_irrefl (‖s x x‖),
+    calc ‖s x x‖ = ‖s x (x - a)‖ : by simp only [h, sub_zero, continuous_linear_map.map_sub]
+    ... ≤ 1 * ‖(x : E) - a‖ : continuous_linear_map.le_of_op_norm_le _ (hs x).1 _
+    ... < ‖a‖ / 2 : by { rw [one_mul], rwa dist_eq_norm' at hx }
+    ... < ‖(x : E)‖ : I
+    ... = ‖s x x‖ : by rw [(hs x).2, is_R_or_C.norm_coe_norm] },
   have hfs : ∀ (y : d), ∀ᵐ x ∂μ, ⟪f x, s y⟫ = (0 : 𝕜), from λ y, hf (s y),
   have hf' : ∀ᵐ x ∂μ, ∀ (y : d), ⟪f x, s y⟫ = (0 : 𝕜), by rwa ae_all_iff,
   filter_upwards [hf', h't] with x hx h'x,
   exact A (f x) h'x hx,
 end
 
-lemma ae_eq_zero_of_forall_dual [normed_group E] [normed_space 𝕜 E] [second_countable_topology E]
-  {f : α → E} (hf : ∀ c : dual 𝕜 E, (λ x, ⟪f x, c⟫) =ᵐ[μ] 0) :
+lemma ae_eq_zero_of_forall_dual [normed_add_comm_group E] [normed_space 𝕜 E]
+  [second_countable_topology E] {f : α → E} (hf : ∀ c : dual 𝕜 E, (λ x, ⟪f x, c⟫) =ᵐ[μ] 0) :
   f =ᵐ[μ] 0 :=
 ae_eq_zero_of_forall_dual_of_is_separable 𝕜 (is_separable_of_separable_space (set.univ : set E)) hf
 (eventually_of_forall (λ x, set.mem_univ _))
@@ -118,7 +123,7 @@ end ae_eq_of_forall
 
 variables {α E : Type*}
   {m m0 : measurable_space α} {μ : measure α} {s t : set α}
-  [normed_group E] [normed_space ℝ E]
+  [normed_add_comm_group E] [normed_space ℝ E]
 
   [complete_space E]
   {p : ℝ≥0∞}
@@ -162,7 +167,7 @@ end
 
 section ennreal
 
-open_locale topological_space
+open_locale topology
 
 lemma ae_le_of_forall_set_lintegral_le_of_sigma_finite [sigma_finite μ]
   {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g)
@@ -182,7 +187,7 @@ begin
     have A : ∫⁻ x in s, g x ∂μ + ε * μ s ≤ ∫⁻ x in s, g x ∂μ + 0 := calc
       ∫⁻ x in s, g x ∂μ + ε * μ s = ∫⁻ x in s, g x ∂μ + ∫⁻ x in s, ε ∂μ :
         by simp only [lintegral_const, set.univ_inter, measurable_set.univ, measure.restrict_apply]
-      ... = ∫⁻ x in s, (g x + ε) ∂μ : (lintegral_add hg measurable_const).symm
+      ... = ∫⁻ x in s, (g x + ε) ∂μ : (lintegral_add_right _ measurable_const).symm
       ... ≤ ∫⁻ x in s, f x ∂μ : set_lintegral_mono (hg.add measurable_const) hf (λ x hx, hx.1.1)
       ... ≤ ∫⁻ x in s, g x ∂μ + 0 : by { rw [add_zero], exact h s s_meas s_lt_top },
     have B : ∫⁻ x in s, g x ∂μ ≠ ∞,
@@ -236,14 +241,12 @@ end ennreal
 
 section real
 
-section real_finite_measure
-
-variables [is_finite_measure μ] {f : α → ℝ}
+variables {f : α → ℝ}
 
-/-- Don't use this lemma. Use `ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure`. -/
-lemma ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure_of_strongly_measurable
+/-- Don't use this lemma. Use `ae_nonneg_of_forall_set_integral_nonneg`. -/
+lemma ae_nonneg_of_forall_set_integral_nonneg_of_strongly_measurable
   (hfm : strongly_measurable f)
-  (hf : integrable f μ) (hf_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in s, f x ∂μ) :
+  (hf : integrable f μ) (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ) :
   0 ≤ᵐ[μ] f :=
 begin
   simp_rw [eventually_le, pi.zero_apply],
@@ -251,47 +254,70 @@ begin
   intros b hb_neg,
   let s := {x | f x ≤ b},
   have hs : measurable_set s, from hfm.measurable_set_le strongly_measurable_const,
+  have mus : μ s < ∞,
+  { let c : ℝ≥0 := ⟨|b|, abs_nonneg _⟩,
+    have c_pos : (c : ℝ≥0∞) ≠ 0, by simpa using hb_neg.ne,
+    calc μ s ≤ μ {x | (c : ℝ≥0∞) ≤ ‖f x‖₊} :
+    begin
+      apply measure_mono,
+      assume x hx,
+      simp only [set.mem_set_of_eq] at hx,
+      simpa only [nnnorm, abs_of_neg hb_neg, abs_of_neg (hx.trans_lt hb_neg), real.norm_eq_abs,
+        subtype.mk_le_mk, neg_le_neg_iff, set.mem_set_of_eq, ennreal.coe_le_coe] using hx,
+    end
+    ... ≤ (∫⁻ x, ‖f x‖₊ ∂μ) / c :
+      meas_ge_le_lintegral_div hfm.ae_measurable.ennnorm c_pos ennreal.coe_ne_top
+    ... < ∞ : ennreal.div_lt_top (ne_of_lt hf.2) c_pos },
   have h_int_gt : ∫ x in s, f x ∂μ ≤ b * (μ s).to_real,
   { have h_const_le : ∫ x in s, f x ∂μ ≤ ∫ x in s, b ∂μ,
     { refine set_integral_mono_ae_restrict hf.integrable_on
-        (integrable_on_const.mpr (or.inr (measure_lt_top μ s))) _,
+        (integrable_on_const.mpr (or.inr mus)) _,
       rw [eventually_le, ae_restrict_iff hs],
       exact eventually_of_forall (λ x hxs, hxs), },
     rwa [set_integral_const, smul_eq_mul, mul_comm] at h_const_le, },
   by_contra,
   refine (lt_self_iff_false (∫ x in s, f x ∂μ)).mp (h_int_gt.trans_lt _),
   refine (mul_neg_iff.mpr (or.inr ⟨hb_neg, _⟩)).trans_le _,
-  swap, { simp_rw measure.restrict_restrict hs, exact hf_zero s hs, },
+  swap, { simp_rw measure.restrict_restrict hs, exact hf_zero s hs mus, },
   refine (ennreal.to_real_nonneg).lt_of_ne (λ h_eq, h _),
   cases (ennreal.to_real_eq_zero_iff _).mp h_eq.symm with hμs_eq_zero hμs_eq_top,
   { exact hμs_eq_zero, },
-  { exact absurd hμs_eq_top (measure_lt_top μ s).ne, },
+  { exact absurd hμs_eq_top mus.ne, },
 end
 
-lemma ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure (hf : integrable f μ)
-  (hf_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in s, f x ∂μ) :
+lemma ae_nonneg_of_forall_set_integral_nonneg (hf : integrable f μ)
+  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ) :
   0 ≤ᵐ[μ] f :=
 begin
   rcases hf.1 with ⟨f', hf'_meas, hf_ae⟩,
   have hf'_integrable : integrable f' μ, from integrable.congr hf hf_ae,
-  have hf'_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in s, f' x ∂μ,
-  { intros s hs,
+  have hf'_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f' x ∂μ,
+  { intros s hs h's,
     rw set_integral_congr_ae hs (hf_ae.mono (λ x hx hxs, hx.symm)),
-    exact hf_zero s hs, },
-  exact (ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure_of_strongly_measurable hf'_meas
+    exact hf_zero s hs h's, },
+  exact (ae_nonneg_of_forall_set_integral_nonneg_of_strongly_measurable hf'_meas
     hf'_integrable hf'_zero).trans hf_ae.symm.le,
 end
 
-end real_finite_measure
+lemma ae_le_of_forall_set_integral_le {f g : α → ℝ} (hf : integrable f μ) (hg : integrable g μ)
+  (hf_le : ∀ s, measurable_set s → μ s < ∞ → ∫ x in s, f x ∂μ ≤ ∫ x in s, g x ∂μ) :
+  f ≤ᵐ[μ] g :=
+begin
+  rw ← eventually_sub_nonneg,
+  refine ae_nonneg_of_forall_set_integral_nonneg (hg.sub hf) (λ s hs, _),
+  rw [integral_sub' hg.integrable_on hf.integrable_on, sub_nonneg],
+  exact hf_le s hs
+end
 
-lemma ae_nonneg_restrict_of_forall_set_integral_nonneg_inter {f : α → ℝ} {t : set α} (hμt : μ t ≠ ∞)
-  (hf : integrable_on f t μ) (hf_zero : ∀ s, measurable_set s → 0 ≤ ∫ x in (s ∩ t), f x ∂μ) :
+lemma ae_nonneg_restrict_of_forall_set_integral_nonneg_inter {f : α → ℝ} {t : set α}
+  (hf : integrable_on f t μ)
+  (hf_zero : ∀ s, measurable_set s → μ (s ∩ t) < ∞ → 0 ≤ ∫ x in (s ∩ t), f x ∂μ) :
   0 ≤ᵐ[μ.restrict t] f :=
 begin
-  haveI : fact (μ t < ∞) := ⟨lt_top_iff_ne_top.mpr hμt⟩,
-  refine ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure hf (λ s hs, _),
+  refine ae_nonneg_of_forall_set_integral_nonneg hf (λ s hs h's, _),
   simp_rw measure.restrict_restrict hs,
-  exact hf_zero s hs,
+  apply hf_zero s hs,
+  rwa measure.restrict_apply hs at h's,
 end
 
 lemma ae_nonneg_of_forall_set_integral_nonneg_of_sigma_finite [sigma_finite μ] {f : α → ℝ}
@@ -301,9 +327,9 @@ lemma ae_nonneg_of_forall_set_integral_nonneg_of_sigma_finite [sigma_finite μ]
 begin
   apply ae_of_forall_measure_lt_top_ae_restrict,
   assume t t_meas t_lt_top,
-  apply ae_nonneg_restrict_of_forall_set_integral_nonneg_inter t_lt_top.ne
+  apply ae_nonneg_restrict_of_forall_set_integral_nonneg_inter
     (hf_int_finite t t_meas t_lt_top),
-  assume s s_meas,
+  assume s s_meas hs,
   exact hf_zero _ (s_meas.inter t_meas)
     (lt_of_le_of_lt (measure_mono (set.inter_subset_right _ _)) t_lt_top)
 end
@@ -328,20 +354,14 @@ begin
     exact hf_zero (s ∩ t) (hs.inter hf.measurable_set) hμts, },
 end
 
-lemma integrable.ae_nonneg_of_forall_set_integral_nonneg {f : α → ℝ} (hf : integrable f μ)
-  (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ) :
-  0 ≤ᵐ[μ] f :=
-ae_fin_strongly_measurable.ae_nonneg_of_forall_set_integral_nonneg hf.ae_fin_strongly_measurable
-  (λ s hs hμs, hf.integrable_on) hf_zero
-
 lemma ae_nonneg_restrict_of_forall_set_integral_nonneg {f : α → ℝ}
   (hf_int_finite : ∀ s, measurable_set s → μ s < ∞ → integrable_on f s μ)
   (hf_zero : ∀ s, measurable_set s → μ s < ∞ → 0 ≤ ∫ x in s, f x ∂μ)
   {t : set α} (ht : measurable_set t) (hμt : μ t ≠ ∞) :
   0 ≤ᵐ[μ.restrict t] f :=
 begin
-  refine ae_nonneg_restrict_of_forall_set_integral_nonneg_inter hμt
-    (hf_int_finite t ht (lt_top_iff_ne_top.mpr hμt)) (λ s hs, _),
+  refine ae_nonneg_restrict_of_forall_set_integral_nonneg_inter
+    (hf_int_finite t ht (lt_top_iff_ne_top.mpr hμt)) (λ s hs h's, _),
   refine (hf_zero (s ∩ t) (hs.inter ht) _),
   exact (measure_mono (set.inter_subset_right s t)).trans_lt (lt_top_iff_ne_top.mpr hμt),
 end
diff --git a/src/measure_theory/function/ae_measurable_order.lean b/src/measure_theory/function/ae_measurable_order.lean
index 6bf64579b8274..fd40f966cee90 100644
--- a/src/measure_theory/function/ae_measurable_order.lean
+++ b/src/measure_theory/function/ae_measurable_order.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
 
 /-!
 # Measurability criterion for ennreal-valued functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Consider a function `f : α → ℝ≥0∞`. If the level sets `{f < p}` and `{q < f}` have measurable
 supersets which are disjoint up to measure zero when `p` and `q` are finite numbers satisfying
 `p < q`, then `f` is almost-everywhere measurable. This is proved in
@@ -30,7 +33,7 @@ theorem measure_theory.ae_measurable_of_exist_almost_disjoint_supersets
   {α : Type*} {m : measurable_space α} (μ : measure α)
   {β : Type*} [complete_linear_order β] [densely_ordered β] [topological_space β]
   [order_topology β] [second_countable_topology β] [measurable_space β] [borel_space β]
-  (s : set β) (s_count : countable s) (s_dense : dense s) (f : α → β)
+  (s : set β) (s_count : s.countable) (s_dense : dense s) (f : α → β)
   (h : ∀ (p ∈ s) (q ∈ s), p < q → ∃ u v, measurable_set u ∧ measurable_set v ∧
     {x | f x < p} ⊆ u ∧ {x | q < f x} ⊆ v ∧ μ (u ∩ v) = 0) :
   ae_measurable f μ :=
@@ -61,7 +64,7 @@ begin
       refine (measure_Union_le _).trans _,
       apply ennreal.tsum_le_tsum (λ p, _),
       apply measure_Union_le _,
-      exact (s_count.mono (inter_subset_left _ _)).to_encodable,
+      exact (s_count.mono (inter_subset_left _ _)).to_subtype,
     end
     ... ≤ ∑' (p : s) (q : s ∩ Ioi p), μ (u p q ∩ v p q) : begin
       apply ennreal.tsum_le_tsum (λ p, _),
@@ -77,7 +80,7 @@ begin
       change μ _ = 0,
       convert this,
       ext y,
-      simp only [not_exists, exists_prop, mem_set_of_eq, mem_compl_eq, not_not_mem] },
+      simp only [not_exists, exists_prop, mem_set_of_eq, mem_compl_iff, not_not_mem] },
     filter_upwards [this] with x hx,
     apply (infi_eq_of_forall_ge_of_forall_gt_exists_lt _ _).symm,
     { assume i,
@@ -109,7 +112,7 @@ theorem ennreal.ae_measurable_of_exist_almost_disjoint_supersets
     {x | f x < p} ⊆ u ∧ {x | (q : ℝ≥0∞) < f x} ⊆ v ∧ μ (u ∩ v) = 0) :
   ae_measurable f μ :=
 begin
-  obtain ⟨s, s_count, s_dense, s_zero, s_top⟩ : ∃ s : set ℝ≥0∞, countable s ∧ dense s ∧
+  obtain ⟨s, s_count, s_dense, s_zero, s_top⟩ : ∃ s : set ℝ≥0∞, s.countable ∧ dense s ∧
     0 ∉ s ∧ ∞ ∉ s := ennreal.exists_countable_dense_no_zero_top,
   have I : ∀ x ∈ s, x ≠ ∞ := λ x xs hx, s_top (hx ▸ xs),
   apply measure_theory.ae_measurable_of_exist_almost_disjoint_supersets μ s s_count s_dense _,
diff --git a/src/measure_theory/function/ae_measurable_sequence.lean b/src/measure_theory/function/ae_measurable_sequence.lean
index 659ab55518ae6..90a71460a9acd 100644
--- a/src/measure_theory/function/ae_measurable_sequence.lean
+++ b/src/measure_theory/function/ae_measurable_sequence.lean
@@ -9,6 +9,9 @@ import measure_theory.measurable_space
 /-!
 # Sequence of measurable functions associated to a sequence of a.e.-measurable functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define here tools to prove statements about limits (infi, supr...) of sequences of
 `ae_measurable` functions.
 Given a sequence of a.e.-measurable functions `f : ι → α → β` with hypothesis
@@ -23,7 +26,7 @@ and a measurable set `ae_seq_set hf p`, such that
 open measure_theory
 open_locale classical
 
-variables {α β γ ι : Type*} [measurable_space α] [measurable_space β]
+variables {ι : Sort*} {α β γ : Type*} [measurable_space α] [measurable_space β]
   {f : ι → α → β} {μ : measure α} {p : α → (ι → β) → Prop}
 
 /-- If we have the additional hypothesis `∀ᵐ x ∂μ, p x (λ n, f n x)`, this is a measurable set
@@ -99,7 +102,7 @@ lemma measurable (hf : ∀ i, ae_measurable (f i) μ) (p : α → (ι → β) 
 measurable.ite ae_seq_set_measurable_set (hf i).measurable_mk $ measurable_const' $
   λ x y, rfl
 
-lemma measure_compl_ae_seq_set_eq_zero [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
+lemma measure_compl_ae_seq_set_eq_zero [countable ι] (hf : ∀ i, ae_measurable (f i) μ)
   (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
   μ (ae_seq_set hf p)ᶜ = 0 :=
 begin
@@ -109,7 +112,7 @@ begin
   exact filter.eventually.and hf_eq hp,
 end
 
-lemma ae_seq_eq_mk_ae [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
+lemma ae_seq_eq_mk_ae [countable ι] (hf : ∀ i, ae_measurable (f i) μ)
   (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
   ∀ᵐ (a : α) ∂μ, ∀ (i : ι), ae_seq hf p i a = (hf i).mk (f i) a :=
 begin
@@ -119,7 +122,7 @@ begin
     (le_of_eq (measure_compl_ae_seq_set_eq_zero hf hp))) (zero_le _),
 end
 
-lemma ae_seq_eq_fun_ae [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
+lemma ae_seq_eq_fun_ae [countable ι] (hf : ∀ i, ae_measurable (f i) μ)
   (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
   ∀ᵐ (a : α) ∂μ, ∀ (i : ι), ae_seq hf p i a = f i a :=
 begin
@@ -128,12 +131,12 @@ begin
   exact measure_mono_null h_ss (measure_compl_ae_seq_set_eq_zero hf hp),
 end
 
-lemma ae_seq_n_eq_fun_n_ae [encodable ι] (hf : ∀ i, ae_measurable (f i) μ)
+lemma ae_seq_n_eq_fun_n_ae [countable ι] (hf : ∀ i, ae_measurable (f i) μ)
   (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) (n : ι) :
   ae_seq hf p n =ᵐ[μ] f n:=
 ae_all_iff.mp (ae_seq_eq_fun_ae hf hp) n
 
-lemma supr [complete_lattice β] [encodable ι]
+lemma supr [complete_lattice β] [countable ι]
   (hf : ∀ i, ae_measurable (f i) μ) (hp : ∀ᵐ x ∂μ, p x (λ n, f n x)) :
   (⨆ n, ae_seq hf p n) =ᵐ[μ] ⨆ n, f n :=
 begin
diff --git a/src/measure_theory/function/conditional_expectation.lean b/src/measure_theory/function/conditional_expectation.lean
deleted file mode 100644
index a61faa4a52063..0000000000000
--- a/src/measure_theory/function/conditional_expectation.lean
+++ /dev/null
@@ -1,1997 +0,0 @@
-/-
-Copyright (c) 2021 Rémy Degenne. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Rémy Degenne
--/
-
-import analysis.inner_product_space.projection
-import measure_theory.function.l2_space
-import measure_theory.decomposition.radon_nikodym
-
-/-! # Conditional expectation
-
-We build the conditional expectation of an integrable function `f` with value in a Banach space
-with respect to a measure `μ` (defined on a measurable space structure `m0`) and a measurable space
-structure `m` with `hm : m ≤ m0` (a sub-sigma-algebra). This is an `m`-strongly measurable
-function `μ[f|hm]` which is integrable and verifies `∫ x in s, μ[f|hm] x ∂μ = ∫ x in s, f x ∂μ`
-for all `m`-measurable sets `s`. It is unique as an element of `L¹`.
-
-The construction is done in four steps:
-* Define the conditional expectation of an `L²` function, as an element of `L²`. This is the
-  orthogonal projection on the subspace of almost everywhere `m`-measurable functions.
-* Show that the conditional expectation of the indicator of a measurable set with finite measure
-  is integrable and define a map `set α → (E →L[ℝ] (α →₁[μ] E))` which to a set associates a linear
-  map. That linear map sends `x ∈ E` to the conditional expectation of the indicator of the set
-  with value `x`.
-* Extend that map to `condexp_L1_clm : (α →₁[μ] E) →L[ℝ] (α →₁[μ] E)`. This is done using the same
-  construction as the Bochner integral (see the file `measure_theory/integral/set_to_L1`).
-* Define the conditional expectation of a function `f : α → E`, which is an integrable function
-  `α → E` equal to 0 if `f` is not integrable, and equal to an `m`-measurable representative of
-  `condexp_L1_clm` applied to `[f]`, the equivalence class of `f` in `L¹`.
-
-## Main results
-
-The conditional expectation and its properties
-
-* `condexp (hm : m ≤ m0) (μ : measure α) (f : α → E)`: conditional expectation of `f` with respect
-  to `m`.
-* `integrable_condexp` : `condexp` is integrable.
-* `measurable_condexp` : `condexp` is `m`-measurable.
-* `set_integral_condexp (hf : integrable f μ) (hs : measurable_set[m] s)` : the conditional
-  expectation verifies `∫ x in s, condexp hm μ f x ∂μ = ∫ x in s, f x ∂μ` for any `m`-measurable
-  set `s`.
-
-While `condexp` is function-valued, we also define `condexp_L1` with value in `L1` and a continuous
-linear map `condexp_L1_clm` from `L1` to `L1`. `condexp` should be used in most cases.
-
-Uniqueness of the conditional expectation
-
-* `Lp.ae_eq_of_forall_set_integral_eq'`: two `Lp` functions verifying the equality of integrals
-  defining the conditional expectation are equal.
-* `ae_eq_of_forall_set_integral_eq_of_sigma_finite'`: two functions verifying the equality of
-  integrals defining the conditional expectation are equal almost everywhere.
-  Requires `[sigma_finite (μ.trim hm)]`.
-* `ae_eq_condexp_of_forall_set_integral_eq`: an a.e. `m`-measurable function which verifies the
-  equality of integrals is a.e. equal to `condexp`.
-
-## Notations
-
-For a measure `μ` defined on a measurable space structure `m0`, another measurable space structure
-`m` with `hm : m ≤ m0` (a sub-sigma-algebra) and a function `f`, we define the notation
-* `μ[f|hm] = condexp hm μ f`.
-
-## Implementation notes
-
-Most of the results in this file are valid for a complete real normed space `F`.
-However, some lemmas also use `𝕜 : is_R_or_C`:
-* `condexp_L2` is defined only for an `inner_product_space` for now, and we use `𝕜` for its field.
-* results about scalar multiplication are stated not only for `ℝ` but also for `𝕜` if we happen to
-  have `normed_space 𝕜 F`.
-
-## Tags
-
-conditional expectation, conditional expected value
-
--/
-
-noncomputable theory
-open topological_space measure_theory.Lp filter continuous_linear_map
-open_locale nnreal ennreal topological_space big_operators measure_theory
-
-namespace measure_theory
-
-/-- A function `f` verifies `ae_strongly_measurable' m f μ` if it is `μ`-a.e. equal to
-an `m`-strongly measurable function. This is similar to `ae_strongly_measurable`, but the
-`measurable_space` structures used for the measurability statement and for the measure are
-different. -/
-def ae_strongly_measurable' {α β} [topological_space β]
-  (m : measurable_space α) {m0 : measurable_space α}
-  (f : α → β) (μ : measure α) : Prop :=
-∃ g : α → β, strongly_measurable[m] g ∧ f =ᵐ[μ] g
-
-namespace ae_strongly_measurable'
-
-variables {α β 𝕜 : Type*} {m m0 : measurable_space α} {μ : measure α}
-  [topological_space β] {f g : α → β}
-
-lemma congr (hf : ae_strongly_measurable' m f μ) (hfg : f =ᵐ[μ] g) :
-  ae_strongly_measurable' m g μ :=
-by { obtain ⟨f', hf'_meas, hff'⟩ := hf, exact ⟨f', hf'_meas, hfg.symm.trans hff'⟩, }
-
-lemma add [has_add β] [has_continuous_add β] (hf : ae_strongly_measurable' m f μ)
-  (hg : ae_strongly_measurable' m g μ) :
-  ae_strongly_measurable' m (f+g) μ :=
-begin
-  rcases hf with ⟨f', h_f'_meas, hff'⟩,
-  rcases hg with ⟨g', h_g'_meas, hgg'⟩,
-  exact ⟨f' + g', h_f'_meas.add h_g'_meas, hff'.add hgg'⟩,
-end
-
-lemma neg [add_group β] [topological_add_group β]
-  {f : α → β} (hfm : ae_strongly_measurable' m f μ) :
-  ae_strongly_measurable' m (-f) μ :=
-begin
-  rcases hfm with ⟨f', hf'_meas, hf_ae⟩,
-  refine ⟨-f', hf'_meas.neg, hf_ae.mono (λ x hx, _)⟩,
-  simp_rw pi.neg_apply,
-  rw hx,
-end
-
-lemma sub [add_group β] [topological_add_group β] {f g : α → β}
-  (hfm : ae_strongly_measurable' m f μ) (hgm : ae_strongly_measurable' m g μ) :
-  ae_strongly_measurable' m (f - g) μ :=
-begin
-  rcases hfm with ⟨f', hf'_meas, hf_ae⟩,
-  rcases hgm with ⟨g', hg'_meas, hg_ae⟩,
-  refine ⟨f'-g', hf'_meas.sub hg'_meas, hf_ae.mp (hg_ae.mono (λ x hx1 hx2, _))⟩,
-  simp_rw pi.sub_apply,
-  rw [hx1, hx2],
-end
-
-lemma const_smul [has_scalar 𝕜 β] [has_continuous_const_smul 𝕜 β]
-  (c : 𝕜) (hf : ae_strongly_measurable' m f μ) :
-  ae_strongly_measurable' m (c • f) μ :=
-begin
-  rcases hf with ⟨f', h_f'_meas, hff'⟩,
-  refine ⟨c • f', h_f'_meas.const_smul c, _⟩,
-  exact eventually_eq.fun_comp hff' (λ x, c • x),
-end
-
-lemma const_inner {𝕜 β} [is_R_or_C 𝕜] [inner_product_space 𝕜 β]
-  {f : α → β} (hfm : ae_strongly_measurable' m f μ) (c : β) :
-  ae_strongly_measurable' m (λ x, (inner c (f x) : 𝕜)) μ :=
-begin
-  rcases hfm with ⟨f', hf'_meas, hf_ae⟩,
-  refine ⟨λ x, (inner c (f' x) : 𝕜), (@strongly_measurable_const _ _ m _ _).inner hf'_meas,
-    hf_ae.mono (λ x hx, _)⟩,
-  dsimp only,
-  rw hx,
-end
-
-/-- An `m`-strongly measurable function almost everywhere equal to `f`. -/
-def mk (f : α → β) (hfm : ae_strongly_measurable' m f μ) : α → β := hfm.some
-
-lemma strongly_measurable_mk {f : α → β} (hfm : ae_strongly_measurable' m f μ) :
-  strongly_measurable[m] (hfm.mk f) :=
-hfm.some_spec.1
-
-lemma ae_eq_mk {f : α → β} (hfm : ae_strongly_measurable' m f μ) : f =ᵐ[μ] hfm.mk f :=
-hfm.some_spec.2
-
-lemma continuous_comp {γ} [topological_space γ] {f : α → β} {g : β → γ}
-  (hg : continuous g) (hf : ae_strongly_measurable' m f μ) :
-  ae_strongly_measurable' m (g ∘ f) μ :=
-⟨λ x, g (hf.mk _ x),
-  @continuous.comp_strongly_measurable _ _ _ m _ _ _ _ hg hf.strongly_measurable_mk,
-  hf.ae_eq_mk.mono (λ x hx, by rw [function.comp_apply, hx])⟩
-
-end ae_strongly_measurable'
-
-lemma ae_strongly_measurable'_of_ae_strongly_measurable'_trim {α β} {m m0 m0' : measurable_space α}
-  [topological_space β] (hm0 : m0 ≤ m0') {μ : measure α} {f : α → β}
-  (hf : ae_strongly_measurable' m f (μ.trim hm0)) :
-  ae_strongly_measurable' m f μ :=
-by { obtain ⟨g, hg_meas, hfg⟩ := hf, exact ⟨g, hg_meas, ae_eq_of_ae_eq_trim hfg⟩, }
-
-lemma strongly_measurable.ae_strongly_measurable'
-  {α β} {m m0 : measurable_space α} [topological_space β]
-  {μ : measure α} {f : α → β} (hf : strongly_measurable[m] f) :
-  ae_strongly_measurable' m f μ :=
-⟨f, hf, ae_eq_refl _⟩
-
-lemma ae_eq_trim_iff_of_ae_strongly_measurable' {α β} [topological_space β] [metrizable_space β]
-  {m m0 : measurable_space α} {μ : measure α} {f g : α → β}
-  (hm : m ≤ m0) (hfm : ae_strongly_measurable' m f μ) (hgm : ae_strongly_measurable' m g μ) :
-  hfm.mk f =ᵐ[μ.trim hm] hgm.mk g ↔ f =ᵐ[μ] g :=
-(ae_eq_trim_iff hm hfm.strongly_measurable_mk hgm.strongly_measurable_mk).trans
-⟨λ h, hfm.ae_eq_mk.trans (h.trans hgm.ae_eq_mk.symm),
-  λ h, hfm.ae_eq_mk.symm.trans (h.trans hgm.ae_eq_mk)⟩
-
-
-variables {α β γ E E' F F' G G' H 𝕜 : Type*} {p : ℝ≥0∞}
-  [is_R_or_C 𝕜] -- 𝕜 for ℝ or ℂ
-  [topological_space β] -- β for a generic topological space
-  -- E for an inner product space
-  [inner_product_space 𝕜 E]
-  -- E' for an inner product space on which we compute integrals
-  [inner_product_space 𝕜 E']
-  [complete_space E'] [normed_space ℝ E']
-  -- F for a Lp submodule
-  [normed_group F] [normed_space 𝕜 F]
-  -- F' for integrals on a Lp submodule
-  [normed_group F'] [normed_space 𝕜 F'] [normed_space ℝ F'] [complete_space F']
-  -- G for a Lp add_subgroup
-  [normed_group G]
-  -- G' for integrals on a Lp add_subgroup
-  [normed_group G'] [normed_space ℝ G'] [complete_space G']
-  -- H for a normed group (hypotheses of mem_ℒp)
-  [normed_group H]
-
-section Lp_meas
-
-/-! ## The subset `Lp_meas` of `Lp` functions a.e. measurable with respect to a sub-sigma-algebra -/
-
-variables (F)
-
-/-- `Lp_meas_subgroup F m p μ` is the subspace of `Lp F p μ` containing functions `f` verifying
-`ae_strongly_measurable' m f μ`, i.e. functions which are `μ`-a.e. equal to
-an `m`-strongly measurable function. -/
-def Lp_meas_subgroup (m : measurable_space α) [measurable_space α] (p : ℝ≥0∞) (μ : measure α) :
-  add_subgroup (Lp F p μ) :=
-{ carrier   := {f : (Lp F p μ) | ae_strongly_measurable' m f μ} ,
-  zero_mem' := ⟨(0 : α → F), @strongly_measurable_zero _ _ m _ _, Lp.coe_fn_zero _ _ _⟩,
-  add_mem'  := λ f g hf hg, (hf.add hg).congr (Lp.coe_fn_add f g).symm,
-  neg_mem' := λ f hf, ae_strongly_measurable'.congr hf.neg (Lp.coe_fn_neg f).symm, }
-
-variables (𝕜)
-/-- `Lp_meas F 𝕜 m p μ` is the subspace of `Lp F p μ` containing functions `f` verifying
-`ae_strongly_measurable' m f μ`, i.e. functions which are `μ`-a.e. equal to
-an `m`-strongly measurable function. -/
-def Lp_meas (m : measurable_space α) [measurable_space α] (p : ℝ≥0∞)
-  (μ : measure α) :
-  submodule 𝕜 (Lp F p μ) :=
-{ carrier   := {f : (Lp F p μ) | ae_strongly_measurable' m f μ} ,
-  zero_mem' := ⟨(0 : α → F), @strongly_measurable_zero _ _ m _ _, Lp.coe_fn_zero _ _ _⟩,
-  add_mem'  := λ f g hf hg, (hf.add hg).congr (Lp.coe_fn_add f g).symm,
-  smul_mem' := λ c f hf, (hf.const_smul c).congr (Lp.coe_fn_smul c f).symm, }
-variables {F 𝕜}
-
-variables
-
-lemma mem_Lp_meas_subgroup_iff_ae_strongly_measurable' {m m0 : measurable_space α} {μ : measure α}
-  {f : Lp F p μ} :
-  f ∈ Lp_meas_subgroup F m p μ ↔ ae_strongly_measurable' m f μ :=
-by rw [← add_subgroup.mem_carrier, Lp_meas_subgroup, set.mem_set_of_eq]
-
-lemma mem_Lp_meas_iff_ae_strongly_measurable'
-  {m m0 : measurable_space α} {μ : measure α} {f : Lp F p μ} :
-  f ∈ Lp_meas F 𝕜 m p μ ↔ ae_strongly_measurable' m f μ :=
-by rw [← set_like.mem_coe, ← submodule.mem_carrier, Lp_meas, set.mem_set_of_eq]
-
-lemma Lp_meas.ae_strongly_measurable'
-  {m m0 : measurable_space α} {μ : measure α} (f : Lp_meas F 𝕜 m p μ) :
-  ae_strongly_measurable' m f μ :=
-mem_Lp_meas_iff_ae_strongly_measurable'.mp f.mem
-
-lemma mem_Lp_meas_self
-  {m0 : measurable_space α} (μ : measure α) (f : Lp F p μ) :
-  f ∈ Lp_meas F 𝕜 m0 p μ :=
-mem_Lp_meas_iff_ae_strongly_measurable'.mpr (Lp.ae_strongly_measurable f)
-
-lemma Lp_meas_subgroup_coe {m m0 : measurable_space α} {μ : measure α}
-  {f : Lp_meas_subgroup F m p μ} :
-  ⇑f = (f : Lp F p μ) :=
-coe_fn_coe_base f
-
-lemma Lp_meas_coe {m m0 : measurable_space α} {μ : measure α} {f : Lp_meas F 𝕜 m p μ} :
-  ⇑f = (f : Lp F p μ) :=
-coe_fn_coe_base f
-
-lemma mem_Lp_meas_indicator_const_Lp {m m0 : measurable_space α} (hm : m ≤ m0)
-  {μ : measure α} {s : set α} (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) {c : F} :
-  indicator_const_Lp p (hm s hs) hμs c ∈ Lp_meas F 𝕜 m p μ :=
-⟨s.indicator (λ x : α, c), (@strongly_measurable_const _ _ m _ _).indicator hs,
-  indicator_const_Lp_coe_fn⟩
-
-section complete_subspace
-
-/-! ## The subspace `Lp_meas` is complete.
-
-We define an `isometric` between `Lp_meas_subgroup` and the `Lp` space corresponding to the
-measure `μ.trim hm`. As a consequence, the completeness of `Lp` implies completeness of
-`Lp_meas_subgroup` (and `Lp_meas`). -/
-
-variables {ι : Type*} {m m0 : measurable_space α} {μ : measure α}
-
-/-- If `f` belongs to `Lp_meas_subgroup F m p μ`, then the measurable function it is almost
-everywhere equal to (given by `ae_measurable.mk`) belongs to `ℒp` for the measure `μ.trim hm`. -/
-lemma mem_ℒp_trim_of_mem_Lp_meas_subgroup (hm : m ≤ m0) (f : Lp F p μ)
-  (hf_meas : f ∈ Lp_meas_subgroup F m p μ) :
-  mem_ℒp (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp hf_meas).some p (μ.trim hm) :=
-begin
-  have hf : ae_strongly_measurable' m f μ,
-    from (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp hf_meas),
-  let g := hf.some,
-  obtain ⟨hg, hfg⟩ := hf.some_spec,
-  change mem_ℒp g p (μ.trim hm),
-  refine ⟨hg.ae_strongly_measurable, _⟩,
-  have h_snorm_fg : snorm g p (μ.trim hm) = snorm f p μ,
-    by { rw snorm_trim hm hg, exact snorm_congr_ae hfg.symm, },
-  rw h_snorm_fg,
-  exact Lp.snorm_lt_top f,
-end
-
-/-- If `f` belongs to `Lp` for the measure `μ.trim hm`, then it belongs to the subgroup
-`Lp_meas_subgroup F m p μ`. -/
-lemma mem_Lp_meas_subgroup_to_Lp_of_trim (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) :
-  (mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f)).to_Lp f ∈ Lp_meas_subgroup F m p μ :=
-begin
-  let hf_mem_ℒp := mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f),
-  rw mem_Lp_meas_subgroup_iff_ae_strongly_measurable',
-  refine ae_strongly_measurable'.congr _ (mem_ℒp.coe_fn_to_Lp hf_mem_ℒp).symm,
-  refine ae_strongly_measurable'_of_ae_strongly_measurable'_trim hm _,
-  exact Lp.ae_strongly_measurable f,
-end
-
-variables (F p μ)
-/-- Map from `Lp_meas_subgroup` to `Lp F p (μ.trim hm)`. -/
-def Lp_meas_subgroup_to_Lp_trim (hm : m ≤ m0) (f : Lp_meas_subgroup F m p μ) : Lp F p (μ.trim hm) :=
-mem_ℒp.to_Lp (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp f.mem).some
-  (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm f f.mem)
-
-variables (𝕜)
-/-- Map from `Lp_meas` to `Lp F p (μ.trim hm)`. -/
-def Lp_meas_to_Lp_trim (hm : m ≤ m0) (f : Lp_meas F 𝕜 m p μ) : Lp F p (μ.trim hm) :=
-mem_ℒp.to_Lp (mem_Lp_meas_iff_ae_strongly_measurable'.mp f.mem).some
-  (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm f f.mem)
-variables {𝕜}
-
-/-- Map from `Lp F p (μ.trim hm)` to `Lp_meas_subgroup`, inverse of
-`Lp_meas_subgroup_to_Lp_trim`. -/
-def Lp_trim_to_Lp_meas_subgroup (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) : Lp_meas_subgroup F m p μ :=
-⟨(mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f)).to_Lp f, mem_Lp_meas_subgroup_to_Lp_of_trim hm f⟩
-
-variables (𝕜)
-/-- Map from `Lp F p (μ.trim hm)` to `Lp_meas`, inverse of `Lp_meas_to_Lp_trim`. -/
-def Lp_trim_to_Lp_meas (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) : Lp_meas F 𝕜 m p μ :=
-⟨(mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f)).to_Lp f, mem_Lp_meas_subgroup_to_Lp_of_trim hm f⟩
-
-variables {F 𝕜 p μ}
-
-lemma Lp_meas_subgroup_to_Lp_trim_ae_eq (hm : m ≤ m0) (f : Lp_meas_subgroup F m p μ) :
-  Lp_meas_subgroup_to_Lp_trim F p μ hm f =ᵐ[μ] f :=
-(ae_eq_of_ae_eq_trim (mem_ℒp.coe_fn_to_Lp (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm ↑f f.mem))).trans
-  (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp f.mem).some_spec.2.symm
-
-lemma Lp_trim_to_Lp_meas_subgroup_ae_eq (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) :
-  Lp_trim_to_Lp_meas_subgroup F p μ hm f =ᵐ[μ] f :=
-mem_ℒp.coe_fn_to_Lp _
-
-lemma Lp_meas_to_Lp_trim_ae_eq (hm : m ≤ m0) (f : Lp_meas F 𝕜 m p μ) :
-  Lp_meas_to_Lp_trim F 𝕜 p μ hm f =ᵐ[μ] f :=
-(ae_eq_of_ae_eq_trim (mem_ℒp.coe_fn_to_Lp (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm ↑f f.mem))).trans
-  (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp f.mem).some_spec.2.symm
-
-lemma Lp_trim_to_Lp_meas_ae_eq (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) :
-  Lp_trim_to_Lp_meas F 𝕜 p μ hm f =ᵐ[μ] f :=
-mem_ℒp.coe_fn_to_Lp _
-
-/-- `Lp_trim_to_Lp_meas_subgroup` is a right inverse of `Lp_meas_subgroup_to_Lp_trim`. -/
-lemma Lp_meas_subgroup_to_Lp_trim_right_inv (hm : m ≤ m0) :
-  function.right_inverse (Lp_trim_to_Lp_meas_subgroup F p μ hm)
-    (Lp_meas_subgroup_to_Lp_trim F p μ hm) :=
-begin
-  intro f,
-  ext1,
-  refine ae_eq_trim_of_strongly_measurable hm
-    (Lp.strongly_measurable _) (Lp.strongly_measurable _) _,
-  exact (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _).trans (Lp_trim_to_Lp_meas_subgroup_ae_eq hm _),
-end
-
-/-- `Lp_trim_to_Lp_meas_subgroup` is a left inverse of `Lp_meas_subgroup_to_Lp_trim`. -/
-lemma Lp_meas_subgroup_to_Lp_trim_left_inv (hm : m ≤ m0) :
-  function.left_inverse (Lp_trim_to_Lp_meas_subgroup F p μ hm)
-    (Lp_meas_subgroup_to_Lp_trim F p μ hm) :=
-begin
-  intro f,
-  ext1,
-  ext1,
-  rw ← Lp_meas_subgroup_coe,
-  exact (Lp_trim_to_Lp_meas_subgroup_ae_eq hm _).trans (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _),
-end
-
-lemma Lp_meas_subgroup_to_Lp_trim_add (hm : m ≤ m0) (f g : Lp_meas_subgroup F m p μ) :
-  Lp_meas_subgroup_to_Lp_trim F p μ hm (f + g)
-    = Lp_meas_subgroup_to_Lp_trim F p μ hm f + Lp_meas_subgroup_to_Lp_trim F p μ hm g :=
-begin
-  ext1,
-  refine eventually_eq.trans _ (Lp.coe_fn_add _ _).symm,
-  refine ae_eq_trim_of_strongly_measurable hm (Lp.strongly_measurable _) _ _,
-  { exact (Lp.strongly_measurable _).add (Lp.strongly_measurable _), },
-  refine (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _).trans _,
-  refine eventually_eq.trans _
-    (eventually_eq.add (Lp_meas_subgroup_to_Lp_trim_ae_eq hm f).symm
-      (Lp_meas_subgroup_to_Lp_trim_ae_eq hm g).symm),
-  refine (Lp.coe_fn_add _ _).trans _,
-  simp_rw Lp_meas_subgroup_coe,
-  exact eventually_of_forall (λ x, by refl),
-end
-
-lemma Lp_meas_subgroup_to_Lp_trim_neg (hm : m ≤ m0) (f : Lp_meas_subgroup F m p μ) :
-  Lp_meas_subgroup_to_Lp_trim F p μ hm (-f)
-    = -Lp_meas_subgroup_to_Lp_trim F p μ hm f :=
-begin
-  ext1,
-  refine eventually_eq.trans _ (Lp.coe_fn_neg _).symm,
-  refine ae_eq_trim_of_strongly_measurable hm (Lp.strongly_measurable _) _ _,
-  { exact @strongly_measurable.neg _ _ _ m _ _ _ (Lp.strongly_measurable _), },
-  refine (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _).trans _,
-  refine eventually_eq.trans _
-    (eventually_eq.neg (Lp_meas_subgroup_to_Lp_trim_ae_eq hm f).symm),
-  refine (Lp.coe_fn_neg _).trans _,
-  simp_rw Lp_meas_subgroup_coe,
-  exact eventually_of_forall (λ x, by refl),
-end
-
-lemma Lp_meas_subgroup_to_Lp_trim_sub (hm : m ≤ m0) (f g : Lp_meas_subgroup F m p μ) :
-  Lp_meas_subgroup_to_Lp_trim F p μ hm (f - g)
-    = Lp_meas_subgroup_to_Lp_trim F p μ hm f - Lp_meas_subgroup_to_Lp_trim F p μ hm g :=
-by rw [sub_eq_add_neg, sub_eq_add_neg, Lp_meas_subgroup_to_Lp_trim_add,
-  Lp_meas_subgroup_to_Lp_trim_neg]
-
-lemma Lp_meas_to_Lp_trim_smul (hm : m ≤ m0) (c : 𝕜) (f : Lp_meas F 𝕜 m p μ) :
-  Lp_meas_to_Lp_trim F 𝕜 p μ hm (c • f) = c • Lp_meas_to_Lp_trim F 𝕜 p μ hm f :=
-begin
-  ext1,
-  refine eventually_eq.trans _ (Lp.coe_fn_smul _ _).symm,
-  refine ae_eq_trim_of_strongly_measurable hm (Lp.strongly_measurable _) _ _,
-  { exact (Lp.strongly_measurable _).const_smul c, },
-  refine (Lp_meas_to_Lp_trim_ae_eq hm _).trans _,
-  refine (Lp.coe_fn_smul _ _).trans _,
-  refine (Lp_meas_to_Lp_trim_ae_eq hm f).mono (λ x hx, _),
-  rw [pi.smul_apply, pi.smul_apply, hx],
-  refl,
-end
-
-/-- `Lp_meas_subgroup_to_Lp_trim` preserves the norm. -/
-lemma Lp_meas_subgroup_to_Lp_trim_norm_map [hp : fact (1 ≤ p)] (hm : m ≤ m0)
-  (f : Lp_meas_subgroup F m p μ) :
-  ∥Lp_meas_subgroup_to_Lp_trim F p μ hm f∥ = ∥f∥ :=
-begin
-  rw [Lp.norm_def, snorm_trim hm (Lp.strongly_measurable _),
-    snorm_congr_ae (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _), Lp_meas_subgroup_coe, ← Lp.norm_def],
-  congr,
-end
-
-lemma isometry_Lp_meas_subgroup_to_Lp_trim [hp : fact (1 ≤ p)] (hm : m ≤ m0) :
-  isometry (Lp_meas_subgroup_to_Lp_trim F p μ hm) :=
-begin
-  rw isometry_emetric_iff_metric,
-  intros f g,
-  rw [dist_eq_norm, ← Lp_meas_subgroup_to_Lp_trim_sub, Lp_meas_subgroup_to_Lp_trim_norm_map,
-    dist_eq_norm],
-end
-
-variables (F p μ)
-/-- `Lp_meas_subgroup` and `Lp F p (μ.trim hm)` are isometric. -/
-def Lp_meas_subgroup_to_Lp_trim_iso [hp : fact (1 ≤ p)] (hm : m ≤ m0) :
-  Lp_meas_subgroup F m p μ ≃ᵢ Lp F p (μ.trim hm) :=
-{ to_fun    := Lp_meas_subgroup_to_Lp_trim F p μ hm,
-  inv_fun   := Lp_trim_to_Lp_meas_subgroup F p μ hm,
-  left_inv  := Lp_meas_subgroup_to_Lp_trim_left_inv hm,
-  right_inv := Lp_meas_subgroup_to_Lp_trim_right_inv hm,
-  isometry_to_fun := isometry_Lp_meas_subgroup_to_Lp_trim hm, }
-
-variables (𝕜)
-/-- `Lp_meas_subgroup` and `Lp_meas` are isometric. -/
-def Lp_meas_subgroup_to_Lp_meas_iso [hp : fact (1 ≤ p)] :
-  Lp_meas_subgroup F m p μ ≃ᵢ Lp_meas F 𝕜 m p μ :=
-isometric.refl (Lp_meas_subgroup F m p μ)
-
-/-- `Lp_meas` and `Lp F p (μ.trim hm)` are isometric, with a linear equivalence. -/
-def Lp_meas_to_Lp_trim_lie [hp : fact (1 ≤ p)] (hm : m ≤ m0) :
-  Lp_meas F 𝕜 m p μ ≃ₗᵢ[𝕜] Lp F p (μ.trim hm) :=
-{ to_fun    := Lp_meas_to_Lp_trim F 𝕜 p μ hm,
-  inv_fun   := Lp_trim_to_Lp_meas F 𝕜 p μ hm,
-  left_inv  := Lp_meas_subgroup_to_Lp_trim_left_inv hm,
-  right_inv := Lp_meas_subgroup_to_Lp_trim_right_inv hm,
-  map_add'  := Lp_meas_subgroup_to_Lp_trim_add hm,
-  map_smul' := Lp_meas_to_Lp_trim_smul hm,
-  norm_map' := Lp_meas_subgroup_to_Lp_trim_norm_map hm, }
-variables {F 𝕜 p μ}
-
-instance [hm : fact (m ≤ m0)] [complete_space F] [hp : fact (1 ≤ p)] :
-  complete_space (Lp_meas_subgroup F m p μ) :=
-by { rw (Lp_meas_subgroup_to_Lp_trim_iso F p μ hm.elim).complete_space_iff, apply_instance, }
-
-instance [hm : fact (m ≤ m0)] [complete_space F] [hp : fact (1 ≤ p)] :
-  complete_space (Lp_meas F 𝕜 m p μ) :=
-by { rw (Lp_meas_subgroup_to_Lp_meas_iso F 𝕜 p μ).symm.complete_space_iff, apply_instance, }
-
-lemma is_complete_ae_strongly_measurable' [hp : fact (1 ≤ p)] [complete_space F] (hm : m ≤ m0) :
-  is_complete {f : Lp F p μ | ae_strongly_measurable' m f μ} :=
-begin
-  rw ← complete_space_coe_iff_is_complete,
-  haveI : fact (m ≤ m0) := ⟨hm⟩,
-  change complete_space (Lp_meas_subgroup F m p μ),
-  apply_instance,
-end
-
-lemma is_closed_ae_strongly_measurable' [hp : fact (1 ≤ p)] [complete_space F] (hm : m ≤ m0) :
-  is_closed {f : Lp F p μ | ae_strongly_measurable' m f μ} :=
-is_complete.is_closed (is_complete_ae_strongly_measurable' hm)
-
-end complete_subspace
-
-section strongly_measurable
-
-variables {m m0 : measurable_space α} {μ : measure α}
-
-/-- We do not get `ae_fin_strongly_measurable f (μ.trim hm)`, since we don't have
-`f =ᵐ[μ.trim hm] Lp_meas_to_Lp_trim F 𝕜 p μ hm f` but only the weaker
-`f =ᵐ[μ] Lp_meas_to_Lp_trim F 𝕜 p μ hm f`. -/
-lemma Lp_meas.ae_fin_strongly_measurable' (hm : m ≤ m0) (f : Lp_meas F 𝕜 m p μ) (hp_ne_zero : p ≠ 0)
-  (hp_ne_top : p ≠ ∞) :
-  ∃ g, fin_strongly_measurable g (μ.trim hm) ∧ f =ᵐ[μ] g :=
-⟨Lp_meas_subgroup_to_Lp_trim F p μ hm f, Lp.fin_strongly_measurable _ hp_ne_zero hp_ne_top,
-  (Lp_meas_subgroup_to_Lp_trim_ae_eq hm f).symm⟩
-
-/-- When applying the inverse of `Lp_meas_to_Lp_trim_lie` (which takes a function in the Lp space of
-the sub-sigma algebra and returns its version in the larger Lp space) to an indicator of the
-sub-sigma-algebra, we obtain an indicator in the Lp space of the larger sigma-algebra. -/
-lemma Lp_meas_to_Lp_trim_lie_symm_indicator [one_le_p : fact (1 ≤ p)] [normed_space ℝ F]
-  {hm : m ≤ m0} {s : set α} {μ : measure α}
-  (hs : measurable_set[m] s) (hμs : μ.trim hm s ≠ ∞) (c : F) :
-  ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm
-      (indicator_const_Lp p hs hμs c) : Lp F p μ)
-    = indicator_const_Lp p (hm s hs) ((le_trim hm).trans_lt hμs.lt_top).ne c :=
-begin
-  ext1,
-  rw ← Lp_meas_coe,
-  change Lp_trim_to_Lp_meas F ℝ p μ hm (indicator_const_Lp p hs hμs c)
-    =ᵐ[μ] (indicator_const_Lp p _ _ c : α → F),
-  refine (Lp_trim_to_Lp_meas_ae_eq hm _).trans _,
-  exact (ae_eq_of_ae_eq_trim indicator_const_Lp_coe_fn).trans indicator_const_Lp_coe_fn.symm,
-end
-
-lemma Lp_meas_to_Lp_trim_lie_symm_to_Lp [one_le_p : fact (1 ≤ p)] [normed_space ℝ F]
-  (hm : m ≤ m0) (f : α → F) (hf : mem_ℒp f p (μ.trim hm)) :
-  ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm (hf.to_Lp f) : Lp F p μ)
-    = (mem_ℒp_of_mem_ℒp_trim hm hf).to_Lp f :=
-begin
-  ext1,
-  rw ← Lp_meas_coe,
-  refine (Lp_trim_to_Lp_meas_ae_eq hm _).trans _,
-  exact (ae_eq_of_ae_eq_trim (mem_ℒp.coe_fn_to_Lp hf)).trans (mem_ℒp.coe_fn_to_Lp _).symm,
-end
-
-end strongly_measurable
-
-end Lp_meas
-
-
-section induction
-
-variables {m m0 : measurable_space α} {μ : measure α} [fact (1 ≤ p)] [normed_space ℝ F]
-
-/-- Auxiliary lemma for `Lp.induction_strongly_measurable`. -/
-@[elab_as_eliminator]
-lemma Lp.induction_strongly_measurable_aux (hm : m ≤ m0) (hp_ne_top : p ≠ ∞) (P : Lp F p μ → Prop)
-  (h_ind : ∀ (c : F) {s : set α} (hs : measurable_set[m] s) (hμs : μ s < ∞),
-      P (Lp.simple_func.indicator_const p (hm s hs) hμs.ne c))
-  (h_add : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
-    ∀ hfm : ae_strongly_measurable' m f μ, ∀ hgm : ae_strongly_measurable' m g μ,
-    disjoint (function.support f) (function.support g) →
-    P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)))
-  (h_closed : is_closed {f : Lp_meas F ℝ m p μ | P f}) :
-  ∀ f : Lp F p μ, ae_strongly_measurable' m f μ → P f :=
-begin
-  intros f hf,
-  let f' := (⟨f, hf⟩ : Lp_meas F ℝ m p μ),
-  let g := Lp_meas_to_Lp_trim_lie F ℝ p μ hm f',
-  have hfg : f' = (Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm g,
-    by simp only [linear_isometry_equiv.symm_apply_apply],
-  change P ↑f',
-  rw hfg,
-  refine @Lp.induction α F m _ p (μ.trim hm) _ hp_ne_top
-    (λ g, P ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm g)) _ _ _ g,
-  { intros b t ht hμt,
-    rw [Lp.simple_func.coe_indicator_const,
-      Lp_meas_to_Lp_trim_lie_symm_indicator ht hμt.ne b],
-      have hμt' : μ t < ∞, from (le_trim hm).trans_lt hμt,
-    specialize h_ind b ht hμt',
-    rwa Lp.simple_func.coe_indicator_const at h_ind, },
-  { intros f g hf hg h_disj hfP hgP,
-    rw linear_isometry_equiv.map_add,
-    push_cast,
-    have h_eq : ∀ (f : α → F) (hf : mem_ℒp f p (μ.trim hm)),
-      ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm (mem_ℒp.to_Lp f hf) : Lp F p μ)
-        = (mem_ℒp_of_mem_ℒp_trim hm hf).to_Lp f,
-      from Lp_meas_to_Lp_trim_lie_symm_to_Lp hm,
-    rw h_eq f hf at hfP ⊢,
-    rw h_eq g hg at hgP ⊢,
-    exact h_add (mem_ℒp_of_mem_ℒp_trim hm hf) (mem_ℒp_of_mem_ℒp_trim hm hg)
-      (ae_strongly_measurable'_of_ae_strongly_measurable'_trim hm hf.ae_strongly_measurable)
-      (ae_strongly_measurable'_of_ae_strongly_measurable'_trim hm hg.ae_strongly_measurable)
-      h_disj hfP hgP, },
-  { change is_closed ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm ⁻¹' {g : Lp_meas F ℝ m p μ | P ↑g}),
-    exact is_closed.preimage (linear_isometry_equiv.continuous _) h_closed, },
-end
-
-/-- To prove something for an `Lp` function a.e. strongly measurable with respect to a
-sub-σ-algebra `m` in a normed space, it suffices to show that
-* the property holds for (multiples of) characteristic functions which are measurable w.r.t. `m`;
-* is closed under addition;
-* the set of functions in `Lp` strongly measurable w.r.t. `m` for which the property holds is
-  closed.
--/
-@[elab_as_eliminator]
-lemma Lp.induction_strongly_measurable (hm : m ≤ m0) (hp_ne_top : p ≠ ∞) (P : Lp F p μ → Prop)
-  (h_ind : ∀ (c : F) {s : set α} (hs : measurable_set[m] s) (hμs : μ s < ∞),
-      P (Lp.simple_func.indicator_const p (hm s hs) hμs.ne c))
-  (h_add : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
-    ∀ hfm : strongly_measurable[m] f, ∀ hgm : strongly_measurable[m] g,
-    disjoint (function.support f) (function.support g) →
-    P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)))
-  (h_closed : is_closed {f : Lp_meas F ℝ m p μ | P f}) :
-  ∀ f : Lp F p μ, ae_strongly_measurable' m f μ → P f :=
-begin
-  intros f hf,
-  suffices h_add_ae : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
-      ∀ hfm : ae_strongly_measurable' m f μ, ∀ hgm : ae_strongly_measurable' m g μ,
-      disjoint (function.support f) (function.support g) →
-      P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)),
-    from Lp.induction_strongly_measurable_aux hm hp_ne_top P h_ind h_add_ae h_closed f hf,
-  intros f g hf hg hfm hgm h_disj hPf hPg,
-  let s_f : set α := function.support (hfm.mk f),
-  have hs_f : measurable_set[m] s_f := hfm.strongly_measurable_mk.measurable_set_support,
-  have hs_f_eq : s_f =ᵐ[μ] function.support f := hfm.ae_eq_mk.symm.support,
-  let s_g : set α := function.support (hgm.mk g),
-  have hs_g : measurable_set[m] s_g := hgm.strongly_measurable_mk.measurable_set_support,
-  have hs_g_eq : s_g =ᵐ[μ] function.support g := hgm.ae_eq_mk.symm.support,
-  have h_inter_empty : (s_f.inter s_g) =ᵐ[μ] (∅ : set α),
-  { refine (hs_f_eq.inter hs_g_eq).trans _,
-    suffices : function.support f ∩ function.support g = ∅, by rw this,
-    exact set.disjoint_iff_inter_eq_empty.mp h_disj, },
-  let f' := (s_f \ s_g).indicator (hfm.mk f),
-  have hff' : f =ᵐ[μ] f',
-  { have : s_f \ s_g =ᵐ[μ] s_f,
-    { rw [← set.diff_inter_self_eq_diff, set.inter_comm],
-      refine ((ae_eq_refl s_f).diff h_inter_empty).trans _,
-      rw set.diff_empty, },
-    refine ((indicator_ae_eq_of_ae_eq_set this).trans _).symm,
-    rw set.indicator_support,
-    exact hfm.ae_eq_mk.symm, },
-  have hf'_meas : strongly_measurable[m] f',
-    from hfm.strongly_measurable_mk.indicator (hs_f.diff hs_g),
-  have hf'_Lp : mem_ℒp f' p μ := hf.ae_eq hff',
-  let g' := (s_g \ s_f).indicator (hgm.mk g),
-  have hgg' : g =ᵐ[μ] g',
-  { have : s_g \ s_f =ᵐ[μ] s_g,
-    { rw [← set.diff_inter_self_eq_diff],
-      refine ((ae_eq_refl s_g).diff h_inter_empty).trans _,
-      rw set.diff_empty, },
-    refine ((indicator_ae_eq_of_ae_eq_set this).trans _).symm,
-    rw set.indicator_support,
-    exact hgm.ae_eq_mk.symm, },
-  have hg'_meas : strongly_measurable[m] g',
-    from hgm.strongly_measurable_mk.indicator (hs_g.diff hs_f),
-  have hg'_Lp : mem_ℒp g' p μ := hg.ae_eq hgg',
-  have h_disj : disjoint (function.support f') (function.support g'),
-  { have : disjoint (s_f \ s_g) (s_g \ s_f) := disjoint_sdiff_sdiff,
-    exact this.mono set.support_indicator_subset set.support_indicator_subset, },
-  rw ← mem_ℒp.to_Lp_congr hf'_Lp hf hff'.symm at ⊢ hPf,
-  rw ← mem_ℒp.to_Lp_congr hg'_Lp hg hgg'.symm at ⊢ hPg,
-  exact h_add hf'_Lp hg'_Lp hf'_meas hg'_meas h_disj hPf hPg,
-end
-
-/-- To prove something for an arbitrary `mem_ℒp` function a.e. strongly measurable with respect
-to a sub-σ-algebra `m` in a normed space, it suffices to show that
-* the property holds for (multiples of) characteristic functions which are measurable w.r.t. `m`;
-* is closed under addition;
-* the set of functions in the `Lᵖ` space strongly measurable w.r.t. `m` for which the property
-  holds is closed.
-* the property is closed under the almost-everywhere equal relation.
--/
-@[elab_as_eliminator]
-lemma mem_ℒp.induction_strongly_measurable (hm : m ≤ m0) (hp_ne_top : p ≠ ∞)
-  (P : (α → F) → Prop)
-  (h_ind : ∀ (c : F) ⦃s⦄, measurable_set[m] s → μ s < ∞ → P (s.indicator (λ _, c)))
-  (h_add : ∀ ⦃f g : α → F⦄, disjoint (function.support f) (function.support g)
-    → mem_ℒp f p μ → mem_ℒp g p μ → strongly_measurable[m] f → strongly_measurable[m] g →
-    P f → P g → P (f + g))
-  (h_closed : is_closed {f : Lp_meas F ℝ m p μ | P f} )
-  (h_ae : ∀ ⦃f g⦄, f =ᵐ[μ] g → mem_ℒp f p μ → P f → P g) :
-  ∀ ⦃f : α → F⦄ (hf : mem_ℒp f p μ) (hfm : ae_strongly_measurable' m f μ), P f :=
-begin
-  intros f hf hfm,
-  let f_Lp := hf.to_Lp f,
-  have hfm_Lp : ae_strongly_measurable' m f_Lp μ, from hfm.congr hf.coe_fn_to_Lp.symm,
-  refine h_ae (hf.coe_fn_to_Lp) (Lp.mem_ℒp _) _,
-  change P f_Lp,
-  refine Lp.induction_strongly_measurable hm hp_ne_top (λ f, P ⇑f) _ _ h_closed f_Lp hfm_Lp,
-  { intros c s hs hμs,
-    rw Lp.simple_func.coe_indicator_const,
-    refine h_ae (indicator_const_Lp_coe_fn).symm _ (h_ind c hs hμs),
-    exact mem_ℒp_indicator_const p (hm s hs) c (or.inr hμs.ne), },
-  { intros f g hf_mem hg_mem hfm hgm h_disj hfP hgP,
-    have hfP' : P f := h_ae (hf_mem.coe_fn_to_Lp) (Lp.mem_ℒp _) hfP,
-    have hgP' : P g := h_ae (hg_mem.coe_fn_to_Lp) (Lp.mem_ℒp _) hgP,
-    specialize h_add h_disj hf_mem hg_mem hfm hgm hfP' hgP',
-    refine h_ae _ (hf_mem.add hg_mem) h_add,
-    exact ((hf_mem.coe_fn_to_Lp).symm.add (hg_mem.coe_fn_to_Lp).symm).trans
-      (Lp.coe_fn_add _ _).symm, },
-end
-
-end induction
-
-
-section uniqueness_of_conditional_expectation
-
-/-! ## Uniqueness of the conditional expectation -/
-
-variables {m m0 : measurable_space α} {μ : measure α}
-
-lemma Lp_meas.ae_eq_zero_of_forall_set_integral_eq_zero
-  (hm : m ≤ m0) (f : Lp_meas E' 𝕜 m p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
-  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
-  (hf_zero : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = 0) :
-  f =ᵐ[μ] 0 :=
-begin
-  obtain ⟨g, hg_sm, hfg⟩ := Lp_meas.ae_fin_strongly_measurable' hm f hp_ne_zero hp_ne_top,
-  refine hfg.trans _,
-  refine ae_eq_zero_of_forall_set_integral_eq_of_fin_strongly_measurable_trim hm _ _ hg_sm,
-  { intros s hs hμs,
-    have hfg_restrict : f =ᵐ[μ.restrict s] g, from ae_restrict_of_ae hfg,
-    rw [integrable_on, integrable_congr hfg_restrict.symm],
-    exact hf_int_finite s hs hμs, },
-  { intros s hs hμs,
-    have hfg_restrict : f =ᵐ[μ.restrict s] g, from ae_restrict_of_ae hfg,
-    rw integral_congr_ae hfg_restrict.symm,
-    exact hf_zero s hs hμs, },
-end
-
-include 𝕜
-
-lemma Lp.ae_eq_zero_of_forall_set_integral_eq_zero'
-  (hm : m ≤ m0) (f : Lp E' p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
-  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
-  (hf_zero : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = 0)
-  (hf_meas : ae_strongly_measurable' m f μ) :
-  f =ᵐ[μ] 0 :=
-begin
-  let f_meas : Lp_meas E' 𝕜 m p μ := ⟨f, hf_meas⟩,
-  have hf_f_meas : f =ᵐ[μ] f_meas, by simp only [coe_fn_coe_base', subtype.coe_mk],
-  refine hf_f_meas.trans _,
-  refine Lp_meas.ae_eq_zero_of_forall_set_integral_eq_zero hm f_meas hp_ne_zero hp_ne_top _ _,
-  { intros s hs hμs,
-    have hfg_restrict : f =ᵐ[μ.restrict s] f_meas, from ae_restrict_of_ae hf_f_meas,
-    rw [integrable_on, integrable_congr hfg_restrict.symm],
-    exact hf_int_finite s hs hμs, },
-  { intros s hs hμs,
-    have hfg_restrict : f =ᵐ[μ.restrict s] f_meas, from ae_restrict_of_ae hf_f_meas,
-    rw integral_congr_ae hfg_restrict.symm,
-    exact hf_zero s hs hμs, },
-end
-
-/-- **Uniqueness of the conditional expectation** -/
-lemma Lp.ae_eq_of_forall_set_integral_eq'
-  (hm : m ≤ m0) (f g : Lp E' p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
-  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
-  (hg_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on g s μ)
-  (hfg : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ)
-  (hf_meas : ae_strongly_measurable' m f μ) (hg_meas : ae_strongly_measurable' m g μ) :
-  f =ᵐ[μ] g :=
-begin
-  suffices h_sub : ⇑(f-g) =ᵐ[μ] 0,
-    by { rw ← sub_ae_eq_zero, exact (Lp.coe_fn_sub f g).symm.trans h_sub, },
-  have hfg' : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, (f - g) x ∂μ = 0,
-  { intros s hs hμs,
-    rw integral_congr_ae (ae_restrict_of_ae (Lp.coe_fn_sub f g)),
-    rw integral_sub' (hf_int_finite s hs hμs) (hg_int_finite s hs hμs),
-    exact sub_eq_zero.mpr (hfg s hs hμs), },
-  have hfg_int : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on ⇑(f-g) s μ,
-  { intros s hs hμs,
-    rw [integrable_on, integrable_congr (ae_restrict_of_ae (Lp.coe_fn_sub f g))],
-    exact (hf_int_finite s hs hμs).sub (hg_int_finite s hs hμs), },
-  have hfg_meas : ae_strongly_measurable' m ⇑(f - g) μ,
-    from ae_strongly_measurable'.congr (hf_meas.sub hg_meas) (Lp.coe_fn_sub f g).symm,
-  exact Lp.ae_eq_zero_of_forall_set_integral_eq_zero' hm (f-g) hp_ne_zero hp_ne_top hfg_int hfg'
-    hfg_meas,
-end
-
-omit 𝕜
-
-lemma ae_eq_of_forall_set_integral_eq_of_sigma_finite' (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
-  {f g : α → F'}
-  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
-  (hg_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on g s μ)
-  (hfg_eq : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ)
-  (hfm : ae_strongly_measurable' m f μ) (hgm : ae_strongly_measurable' m g μ) :
-  f =ᵐ[μ] g :=
-begin
-  rw ← ae_eq_trim_iff_of_ae_strongly_measurable' hm hfm hgm,
-  have hf_mk_int_finite : ∀ s, measurable_set[m] s → μ.trim hm s < ∞ →
-    @integrable_on _ _ m _ (hfm.mk f) s (μ.trim hm),
-  { intros s hs hμs,
-    rw trim_measurable_set_eq hm hs at hμs,
-    rw [integrable_on, restrict_trim hm _ hs],
-    refine integrable.trim hm _ hfm.strongly_measurable_mk,
-    exact integrable.congr (hf_int_finite s hs hμs) (ae_restrict_of_ae hfm.ae_eq_mk), },
-  have hg_mk_int_finite : ∀ s, measurable_set[m] s → μ.trim hm s < ∞ →
-    @integrable_on _ _ m _ (hgm.mk g) s (μ.trim hm),
-  { intros s hs hμs,
-    rw trim_measurable_set_eq hm hs at hμs,
-    rw [integrable_on, restrict_trim hm _ hs],
-    refine integrable.trim hm _ hgm.strongly_measurable_mk,
-    exact integrable.congr (hg_int_finite s hs hμs) (ae_restrict_of_ae hgm.ae_eq_mk), },
-  have hfg_mk_eq : ∀ s : set α, measurable_set[m] s → μ.trim hm s < ∞ →
-    ∫ x in s, (hfm.mk f x) ∂(μ.trim hm) = ∫ x in s, (hgm.mk g x) ∂(μ.trim hm),
-  { intros s hs hμs,
-    rw trim_measurable_set_eq hm hs at hμs,
-    rw [restrict_trim hm _ hs, ← integral_trim hm hfm.strongly_measurable_mk,
-      ← integral_trim hm hgm.strongly_measurable_mk,
-      integral_congr_ae (ae_restrict_of_ae hfm.ae_eq_mk.symm),
-      integral_congr_ae (ae_restrict_of_ae hgm.ae_eq_mk.symm)],
-    exact hfg_eq s hs hμs, },
-  exact ae_eq_of_forall_set_integral_eq_of_sigma_finite hf_mk_int_finite hg_mk_int_finite hfg_mk_eq,
-end
-
-end uniqueness_of_conditional_expectation
-
-
-section integral_norm_le
-
-variables {m m0 : measurable_space α} {μ : measure α} {s : set α}
-
-/-- Let `m` be a sub-σ-algebra of `m0`, `f` a `m0`-measurable function and `g` a `m`-measurable
-function, such that their integrals coincide on `m`-measurable sets with finite measure.
-Then `∫ x in s, ∥g x∥ ∂μ ≤ ∫ x in s, ∥f x∥ ∂μ` on all `m`-measurable sets with finite measure. -/
-lemma integral_norm_le_of_forall_fin_meas_integral_eq (hm : m ≤ m0) {f g : α → ℝ}
-  (hf : strongly_measurable f) (hfi : integrable_on f s μ)
-  (hg : strongly_measurable[m] g) (hgi : integrable_on g s μ)
-  (hgf : ∀ t, measurable_set[m] t → μ t < ∞ → ∫ x in t, g x ∂μ = ∫ x in t, f x ∂μ)
-  (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) :
-  ∫ x in s, ∥g x∥ ∂μ ≤ ∫ x in s, ∥f x∥ ∂μ :=
-begin
-  rw [integral_norm_eq_pos_sub_neg (hg.mono hm) hgi, integral_norm_eq_pos_sub_neg hf hfi],
-  have h_meas_nonneg_g : measurable_set[m] {x | 0 ≤ g x},
-    from (@strongly_measurable_const _ _ m _ _).measurable_set_le hg,
-  have h_meas_nonneg_f : measurable_set {x | 0 ≤ f x},
-    from strongly_measurable_const.measurable_set_le hf,
-  have h_meas_nonpos_g : measurable_set[m] {x | g x ≤ 0},
-    from hg.measurable_set_le (@strongly_measurable_const _ _ m _ _),
-  have h_meas_nonpos_f : measurable_set {x | f x ≤ 0},
-    from hf.measurable_set_le strongly_measurable_const,
-  refine sub_le_sub _ _,
-  { rw [measure.restrict_restrict (hm _ h_meas_nonneg_g),
-      measure.restrict_restrict h_meas_nonneg_f,
-      hgf _ (@measurable_set.inter α m _ _ h_meas_nonneg_g hs)
-        ((measure_mono (set.inter_subset_right _ _)).trans_lt (lt_top_iff_ne_top.mpr hμs)),
-      ← measure.restrict_restrict (hm _ h_meas_nonneg_g),
-      ← measure.restrict_restrict h_meas_nonneg_f],
-    exact set_integral_le_nonneg (hm _ h_meas_nonneg_g) hf hfi, },
-  { rw [measure.restrict_restrict (hm _ h_meas_nonpos_g),
-      measure.restrict_restrict h_meas_nonpos_f,
-      hgf _ (@measurable_set.inter α m _ _ h_meas_nonpos_g hs)
-        ((measure_mono (set.inter_subset_right _ _)).trans_lt (lt_top_iff_ne_top.mpr hμs)),
-      ← measure.restrict_restrict (hm _ h_meas_nonpos_g),
-      ← measure.restrict_restrict h_meas_nonpos_f],
-    exact set_integral_nonpos_le (hm _ h_meas_nonpos_g) hf hfi, },
-end
-
-/-- Let `m` be a sub-σ-algebra of `m0`, `f` a `m0`-measurable function and `g` a `m`-measurable
-function, such that their integrals coincide on `m`-measurable sets with finite measure.
-Then `∫⁻ x in s, ∥g x∥₊ ∂μ ≤ ∫⁻ x in s, ∥f x∥₊ ∂μ` on all `m`-measurable sets with finite
-measure. -/
-lemma lintegral_nnnorm_le_of_forall_fin_meas_integral_eq (hm : m ≤ m0) {f g : α → ℝ}
-  (hf : strongly_measurable f) (hfi : integrable_on f s μ)
-  (hg : strongly_measurable[m] g) (hgi : integrable_on g s μ)
-  (hgf : ∀ t, measurable_set[m] t → μ t < ∞ → ∫ x in t, g x ∂μ = ∫ x in t, f x ∂μ)
-  (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) :
-  ∫⁻ x in s, ∥g x∥₊ ∂μ ≤ ∫⁻ x in s, ∥f x∥₊ ∂μ :=
-begin
-  rw [← of_real_integral_norm_eq_lintegral_nnnorm hfi,
-    ← of_real_integral_norm_eq_lintegral_nnnorm hgi, ennreal.of_real_le_of_real_iff],
-  { exact integral_norm_le_of_forall_fin_meas_integral_eq hm hf hfi hg hgi hgf hs hμs, },
-  { exact integral_nonneg (λ x, norm_nonneg _), },
-end
-
-end integral_norm_le
-
-/-! ## Conditional expectation in L2
-
-We define a conditional expectation in `L2`: it is the orthogonal projection on the subspace
-`Lp_meas`. -/
-
-section condexp_L2
-
-variables [complete_space E] {m m0 : measurable_space α} {μ : measure α}
-  {s t : set α}
-
-local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
-local notation `⟪`x`, `y`⟫₂` := @inner 𝕜 (α →₂[μ] E) _ x y
-
-variables (𝕜)
-/-- Conditional expectation of a function in L2 with respect to a sigma-algebra -/
-def condexp_L2 (hm : m ≤ m0) : (α →₂[μ] E) →L[𝕜] (Lp_meas E 𝕜 m 2 μ) :=
-@orthogonal_projection 𝕜 (α →₂[μ] E) _ _ (Lp_meas E 𝕜 m 2 μ)
-  (by { haveI : fact (m ≤ m0) := ⟨hm⟩, exact infer_instance, })
-variables {𝕜}
-
-lemma ae_strongly_measurable'_condexp_L2 (hm : m ≤ m0) (f : α →₂[μ] E) :
-  ae_strongly_measurable' m (condexp_L2 𝕜 hm f) μ :=
-Lp_meas.ae_strongly_measurable' _
-
-lemma integrable_on_condexp_L2_of_measure_ne_top (hm : m ≤ m0) (hμs : μ s ≠ ∞) (f : α →₂[μ] E) :
-  integrable_on (condexp_L2 𝕜 hm f) s μ :=
-integrable_on_Lp_of_measure_ne_top ((condexp_L2 𝕜 hm f) : α →₂[μ] E)
-  fact_one_le_two_ennreal.elim hμs
-
-lemma integrable_condexp_L2_of_is_finite_measure (hm : m ≤ m0) [is_finite_measure μ]
-  {f : α →₂[μ] E} :
-  integrable (condexp_L2 𝕜 hm f) μ :=
-integrable_on_univ.mp $ integrable_on_condexp_L2_of_measure_ne_top hm (measure_ne_top _ _) f
-
-lemma norm_condexp_L2_le_one (hm : m ≤ m0) : ∥@condexp_L2 α E 𝕜 _ _ _ _ _ μ hm∥ ≤ 1 :=
-by { haveI : fact (m ≤ m0) := ⟨hm⟩, exact orthogonal_projection_norm_le _, }
-
-lemma norm_condexp_L2_le (hm : m ≤ m0) (f : α →₂[μ] E) : ∥condexp_L2 𝕜 hm f∥ ≤ ∥f∥ :=
-((@condexp_L2 _ E 𝕜 _ _ _ _ _ μ hm).le_op_norm f).trans
-  (mul_le_of_le_one_left (norm_nonneg _) (norm_condexp_L2_le_one hm))
-
-lemma snorm_condexp_L2_le (hm : m ≤ m0) (f : α →₂[μ] E) :
-  snorm (condexp_L2 𝕜 hm f) 2 μ ≤ snorm f 2 μ :=
-begin
-  rw [Lp_meas_coe, ← ennreal.to_real_le_to_real (Lp.snorm_ne_top _) (Lp.snorm_ne_top _),
-    ← Lp.norm_def, ← Lp.norm_def, submodule.norm_coe],
-  exact norm_condexp_L2_le hm f,
-end
-
-lemma norm_condexp_L2_coe_le (hm : m ≤ m0) (f : α →₂[μ] E) :
-  ∥(condexp_L2 𝕜 hm f : α →₂[μ] E)∥ ≤ ∥f∥ :=
-begin
-  rw [Lp.norm_def, Lp.norm_def, ← Lp_meas_coe],
-  refine (ennreal.to_real_le_to_real _ (Lp.snorm_ne_top _)).mpr (snorm_condexp_L2_le hm f),
-  exact Lp.snorm_ne_top _,
-end
-
-lemma inner_condexp_L2_left_eq_right (hm : m ≤ m0) {f g : α →₂[μ] E} :
-  ⟪(condexp_L2 𝕜 hm f : α →₂[μ] E), g⟫₂ = ⟪f, (condexp_L2 𝕜 hm g : α →₂[μ] E)⟫₂ :=
-by { haveI : fact (m ≤ m0) := ⟨hm⟩, exact inner_orthogonal_projection_left_eq_right _ f g, }
-
-lemma condexp_L2_indicator_of_measurable (hm : m ≤ m0)
-  (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) (c : E) :
-  (condexp_L2 𝕜 hm (indicator_const_Lp 2 (hm s hs) hμs c) : α →₂[μ] E)
-    = indicator_const_Lp 2 (hm s hs) hμs c :=
-begin
-  rw condexp_L2,
-  haveI : fact (m ≤ m0) := ⟨hm⟩,
-  have h_mem : indicator_const_Lp 2 (hm s hs) hμs c ∈ Lp_meas E 𝕜 m 2 μ,
-    from mem_Lp_meas_indicator_const_Lp hm hs hμs,
-  let ind := (⟨indicator_const_Lp 2 (hm s hs) hμs c, h_mem⟩ : Lp_meas E 𝕜 m 2 μ),
-  have h_coe_ind : (ind : α →₂[μ] E) = indicator_const_Lp 2 (hm s hs) hμs c, by refl,
-  have h_orth_mem := orthogonal_projection_mem_subspace_eq_self ind,
-  rw [← h_coe_ind, h_orth_mem],
-end
-
-lemma inner_condexp_L2_eq_inner_fun (hm : m ≤ m0) (f g : α →₂[μ] E)
-  (hg : ae_strongly_measurable' m g μ) :
-  ⟪(condexp_L2 𝕜 hm f : α →₂[μ] E), g⟫₂ = ⟪f, g⟫₂ :=
-begin
-  symmetry,
-  rw [← sub_eq_zero, ← inner_sub_left, condexp_L2],
-  simp only [mem_Lp_meas_iff_ae_strongly_measurable'.mpr hg, orthogonal_projection_inner_eq_zero],
-end
-
-section real
-
-variables {hm : m ≤ m0}
-
-lemma integral_condexp_L2_eq_of_fin_meas_real (f : Lp 𝕜 2 μ) (hs : measurable_set[m] s)
-  (hμs : μ s ≠ ∞) :
-  ∫ x in s, condexp_L2 𝕜 hm f x ∂μ = ∫ x in s, f x ∂μ :=
-begin
-  rw ← L2.inner_indicator_const_Lp_one (hm s hs) hμs,
-  have h_eq_inner : ∫ x in s, condexp_L2 𝕜 hm f x ∂μ
-    = inner (indicator_const_Lp 2 (hm s hs) hμs (1 : 𝕜)) (condexp_L2 𝕜 hm f),
-  { rw L2.inner_indicator_const_Lp_one (hm s hs) hμs,
-    congr, },
-  rw [h_eq_inner, ← inner_condexp_L2_left_eq_right, condexp_L2_indicator_of_measurable hm hs hμs],
-end
-
-lemma lintegral_nnnorm_condexp_L2_le (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) (f : Lp ℝ 2 μ) :
-  ∫⁻ x in s, ∥condexp_L2 ℝ hm f x∥₊ ∂μ ≤ ∫⁻ x in s, ∥f x∥₊ ∂μ :=
-begin
-  let h_meas := Lp_meas.ae_strongly_measurable' (condexp_L2 ℝ hm f),
-  let g := h_meas.some,
-  have hg_meas : strongly_measurable[m] g, from h_meas.some_spec.1,
-  have hg_eq : g =ᵐ[μ] condexp_L2 ℝ hm f, from h_meas.some_spec.2.symm,
-  have hg_eq_restrict : g =ᵐ[μ.restrict s] condexp_L2 ℝ hm f, from ae_restrict_of_ae hg_eq,
-  have hg_nnnorm_eq : (λ x, (∥g x∥₊ : ℝ≥0∞))
-    =ᵐ[μ.restrict s] (λ x, (∥condexp_L2 ℝ hm f x∥₊ : ℝ≥0∞)),
-  { refine hg_eq_restrict.mono (λ x hx, _),
-    dsimp only,
-    rw hx, },
-  rw lintegral_congr_ae hg_nnnorm_eq.symm,
-  refine lintegral_nnnorm_le_of_forall_fin_meas_integral_eq hm
-    (Lp.strongly_measurable f) _ _ _ _ hs hμs,
-  { exact integrable_on_Lp_of_measure_ne_top f fact_one_le_two_ennreal.elim hμs, },
-  { exact hg_meas, },
-  { rw [integrable_on, integrable_congr hg_eq_restrict],
-    exact integrable_on_condexp_L2_of_measure_ne_top hm hμs f, },
-  { intros t ht hμt,
-    rw ← integral_condexp_L2_eq_of_fin_meas_real f ht hμt.ne,
-    exact set_integral_congr_ae (hm t ht) (hg_eq.mono (λ x hx _, hx)), },
-end
-
-lemma condexp_L2_ae_eq_zero_of_ae_eq_zero (hs : measurable_set[m] s) (hμs : μ s ≠ ∞)
-  {f : Lp ℝ 2 μ} (hf : f =ᵐ[μ.restrict s] 0) :
-  condexp_L2 ℝ hm f =ᵐ[μ.restrict s] 0 :=
-begin
-  suffices h_nnnorm_eq_zero : ∫⁻ x in s, ∥condexp_L2 ℝ hm f x∥₊ ∂μ = 0,
-  { rw lintegral_eq_zero_iff at h_nnnorm_eq_zero,
-    refine h_nnnorm_eq_zero.mono (λ x hx, _),
-    dsimp only at hx,
-    rw pi.zero_apply at hx ⊢,
-    { rwa [ennreal.coe_eq_zero, nnnorm_eq_zero] at hx, },
-    { refine measurable.coe_nnreal_ennreal (measurable.nnnorm _),
-      rw Lp_meas_coe,
-      exact (Lp.strongly_measurable _).measurable }, },
-  refine le_antisymm _ (zero_le _),
-  refine (lintegral_nnnorm_condexp_L2_le hs hμs f).trans (le_of_eq _),
-  rw lintegral_eq_zero_iff,
-  { refine hf.mono (λ x hx, _),
-    dsimp only,
-    rw hx,
-    simp, },
-  { exact (Lp.strongly_measurable _).ennnorm, },
-end
-
-lemma lintegral_nnnorm_condexp_L2_indicator_le_real
-  (hs : measurable_set s) (hμs : μ s ≠ ∞) (ht : measurable_set[m] t) (hμt : μ t ≠ ∞) :
-  ∫⁻ a in t, ∥condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a∥₊ ∂μ ≤ μ (s ∩ t) :=
-begin
-  refine (lintegral_nnnorm_condexp_L2_le ht hμt _).trans (le_of_eq _),
-  have h_eq : ∫⁻ x in t, ∥(indicator_const_Lp 2 hs hμs (1 : ℝ)) x∥₊ ∂μ
-    = ∫⁻ x in t, s.indicator (λ x, (1 : ℝ≥0∞)) x ∂μ,
-  { refine lintegral_congr_ae (ae_restrict_of_ae _),
-    refine (@indicator_const_Lp_coe_fn _ _ _ 2 _ _ _ hs hμs (1 : ℝ)).mono (λ x hx, _),
-    rw hx,
-    classical,
-    simp_rw set.indicator_apply,
-    split_ifs; simp, },
-  rw [h_eq, lintegral_indicator _ hs, lintegral_const, measure.restrict_restrict hs],
-  simp only [one_mul, set.univ_inter, measurable_set.univ, measure.restrict_apply],
-end
-
-end real
-
-/-- `condexp_L2` commutes with taking inner products with constants. See the lemma
-`condexp_L2_comp_continuous_linear_map` for a more general result about commuting with continuous
-linear maps. -/
-lemma condexp_L2_const_inner (hm : m ≤ m0) (f : Lp E 2 μ) (c : E) :
-  condexp_L2 𝕜 hm (((Lp.mem_ℒp f).const_inner c).to_Lp (λ a, ⟪c, f a⟫))
-    =ᵐ[μ] λ a, ⟪c, condexp_L2 𝕜 hm f a⟫ :=
-begin
-  rw Lp_meas_coe,
-  have h_mem_Lp : mem_ℒp (λ a, ⟪c, condexp_L2 𝕜 hm f a⟫) 2 μ,
-  { refine mem_ℒp.const_inner _ _, rw Lp_meas_coe, exact Lp.mem_ℒp _, },
-  have h_eq : h_mem_Lp.to_Lp _ =ᵐ[μ] λ a, ⟪c, condexp_L2 𝕜 hm f a⟫, from h_mem_Lp.coe_fn_to_Lp,
-  refine eventually_eq.trans _ h_eq,
-  refine Lp.ae_eq_of_forall_set_integral_eq' hm _ _ ennreal.zero_lt_two.ne.symm ennreal.coe_ne_top
-    (λ s hs hμs, integrable_on_condexp_L2_of_measure_ne_top hm hμs.ne _) _ _ _ _,
-  { intros s hs hμs,
-    rw [integrable_on, integrable_congr (ae_restrict_of_ae h_eq)],
-    exact (integrable_on_condexp_L2_of_measure_ne_top hm hμs.ne _).const_inner _, },
-  { intros s hs hμs,
-    rw [← Lp_meas_coe, integral_condexp_L2_eq_of_fin_meas_real _ hs hμs.ne,
-      integral_congr_ae (ae_restrict_of_ae h_eq), Lp_meas_coe,
-      ← L2.inner_indicator_const_Lp_eq_set_integral_inner 𝕜 ↑(condexp_L2 𝕜 hm f) (hm s hs) c hμs.ne,
-      ← inner_condexp_L2_left_eq_right, condexp_L2_indicator_of_measurable,
-      L2.inner_indicator_const_Lp_eq_set_integral_inner 𝕜 f (hm s hs) c hμs.ne,
-      set_integral_congr_ae (hm s hs)
-        ((mem_ℒp.coe_fn_to_Lp ((Lp.mem_ℒp f).const_inner c)).mono (λ x hx hxs, hx))], },
-  { rw ← Lp_meas_coe, exact Lp_meas.ae_strongly_measurable' _, },
-  { refine ae_strongly_measurable'.congr _ h_eq.symm,
-    exact (Lp_meas.ae_strongly_measurable' _).const_inner _, },
-end
-
-/-- `condexp_L2` verifies the equality of integrals defining the conditional expectation. -/
-lemma integral_condexp_L2_eq (hm : m ≤ m0)
-  (f : Lp E' 2 μ) (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) :
-  ∫ x in s, condexp_L2 𝕜 hm f x ∂μ = ∫ x in s, f x ∂μ :=
-begin
-  rw [← sub_eq_zero, Lp_meas_coe, ← integral_sub'
-      (integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs)
-      (integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs)],
-  refine integral_eq_zero_of_forall_integral_inner_eq_zero _ _ _,
-  { rw integrable_congr (ae_restrict_of_ae (Lp.coe_fn_sub ↑(condexp_L2 𝕜 hm f) f).symm),
-    exact integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs, },
-  intro c,
-  simp_rw [pi.sub_apply, inner_sub_right],
-  rw integral_sub
-    ((integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs).const_inner c)
-    ((integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs).const_inner c),
-  have h_ae_eq_f := mem_ℒp.coe_fn_to_Lp ((Lp.mem_ℒp f).const_inner c),
-  rw [← Lp_meas_coe, sub_eq_zero,
-    ← set_integral_congr_ae (hm s hs) ((condexp_L2_const_inner hm f c).mono (λ x hx _, hx)),
-    ← set_integral_congr_ae (hm s hs) (h_ae_eq_f.mono (λ x hx _, hx))],
-  exact integral_condexp_L2_eq_of_fin_meas_real _ hs hμs,
-end
-
-variables {E'' 𝕜' : Type*} [is_R_or_C 𝕜']
-  [inner_product_space 𝕜' E''] [complete_space E''] [normed_space ℝ E'']
-
-variables (𝕜 𝕜')
-lemma condexp_L2_comp_continuous_linear_map (hm : m ≤ m0) (T : E' →L[ℝ] E'') (f : α →₂[μ] E') :
-  (condexp_L2 𝕜' hm (T.comp_Lp f) : α →₂[μ] E'') =ᵐ[μ] T.comp_Lp (condexp_L2 𝕜 hm f : α →₂[μ] E') :=
-begin
-  refine Lp.ae_eq_of_forall_set_integral_eq' hm _ _ ennreal.zero_lt_two.ne.symm ennreal.coe_ne_top
-    (λ s hs hμs, integrable_on_condexp_L2_of_measure_ne_top hm hμs.ne _)
-    (λ s hs hμs, integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs.ne)
-    _ _ _,
-  { intros s hs hμs,
-    rw [T.set_integral_comp_Lp _ (hm s hs),
-      T.integral_comp_comm
-        (integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs.ne),
-      ← Lp_meas_coe, ← Lp_meas_coe, integral_condexp_L2_eq hm f hs hμs.ne,
-      integral_condexp_L2_eq hm (T.comp_Lp f) hs hμs.ne, T.set_integral_comp_Lp _ (hm s hs),
-      T.integral_comp_comm
-        (integrable_on_Lp_of_measure_ne_top f fact_one_le_two_ennreal.elim hμs.ne)], },
-  { rw ← Lp_meas_coe, exact Lp_meas.ae_strongly_measurable' _, },
-  { have h_coe := T.coe_fn_comp_Lp (condexp_L2 𝕜 hm f : α →₂[μ] E'),
-    rw ← eventually_eq at h_coe,
-    refine ae_strongly_measurable'.congr _ h_coe.symm,
-    exact (Lp_meas.ae_strongly_measurable' (condexp_L2 𝕜 hm f)).continuous_comp T.continuous, },
-end
-variables {𝕜 𝕜'}
-
-section condexp_L2_indicator
-
-variables (𝕜)
-lemma condexp_L2_indicator_ae_eq_smul (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞)
-  (x : E') :
-  condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x)
-    =ᵐ[μ] λ a, (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a) • x :=
-begin
-  rw indicator_const_Lp_eq_to_span_singleton_comp_Lp hs hμs x,
-  have h_comp := condexp_L2_comp_continuous_linear_map ℝ 𝕜 hm (to_span_singleton ℝ x)
-    (indicator_const_Lp 2 hs hμs (1 : ℝ)),
-  rw ← Lp_meas_coe at h_comp,
-  refine h_comp.trans _,
-  exact (to_span_singleton ℝ x).coe_fn_comp_Lp _,
-end
-
-lemma condexp_L2_indicator_eq_to_span_singleton_comp (hm : m ≤ m0) (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (x : E') :
-  (condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) : α →₂[μ] E')
-    = (to_span_singleton ℝ x).comp_Lp (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ))) :=
-begin
-  ext1,
-  rw ← Lp_meas_coe,
-  refine (condexp_L2_indicator_ae_eq_smul 𝕜 hm hs hμs x).trans _,
-  have h_comp := (to_span_singleton ℝ x).coe_fn_comp_Lp
-    (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) : α →₂[μ] ℝ),
-  rw ← eventually_eq at h_comp,
-  refine eventually_eq.trans _ h_comp.symm,
-  refine eventually_of_forall (λ y, _),
-  refl,
-end
-
-variables {𝕜}
-
-lemma set_lintegral_nnnorm_condexp_L2_indicator_le (hm : m ≤ m0) (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (x : E') {t : set α} (ht : measurable_set[m] t) (hμt : μ t ≠ ∞) :
-  ∫⁻ a in t, ∥condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) a∥₊ ∂μ ≤ μ (s ∩ t) * ∥x∥₊ :=
-calc ∫⁻ a in t, ∥condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) a∥₊ ∂μ
-    = ∫⁻ a in t, ∥(condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a) • x∥₊ ∂μ :
-set_lintegral_congr_fun (hm t ht)
-  ((condexp_L2_indicator_ae_eq_smul 𝕜 hm hs hμs x).mono (λ a ha hat, by rw ha))
-... = ∫⁻ a in t, ∥condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a∥₊ ∂μ * ∥x∥₊ :
-begin
-  simp_rw [nnnorm_smul, ennreal.coe_mul],
-  rw [lintegral_mul_const, Lp_meas_coe],
-  exact (Lp.strongly_measurable _).ennnorm
-end
-... ≤ μ (s ∩ t) * ∥x∥₊ :
-  ennreal.mul_le_mul (lintegral_nnnorm_condexp_L2_indicator_le_real hs hμs ht hμt) le_rfl
-
-lemma lintegral_nnnorm_condexp_L2_indicator_le (hm : m ≤ m0) (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (x : E') [sigma_finite (μ.trim hm)] :
-  ∫⁻ a, ∥condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) a∥₊ ∂μ ≤ μ s * ∥x∥₊ :=
-begin
-  refine lintegral_le_of_forall_fin_meas_le' hm (μ s * ∥x∥₊) _ (λ t ht hμt, _),
-  { rw Lp_meas_coe,
-    exact (Lp.ae_strongly_measurable _).ennnorm },
-  refine (set_lintegral_nnnorm_condexp_L2_indicator_le hm hs hμs x ht hμt).trans _,
-  refine ennreal.mul_le_mul _ le_rfl,
-  exact measure_mono (set.inter_subset_left _ _),
-end
-
-/-- If the measure `μ.trim hm` is sigma-finite, then the conditional expectation of a measurable set
-with finite measure is integrable. -/
-lemma integrable_condexp_L2_indicator (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
-  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : E') :
-  integrable (condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x)) μ :=
-begin
-  refine integrable_of_forall_fin_meas_le' hm (μ s * ∥x∥₊)
-    (ennreal.mul_lt_top hμs ennreal.coe_ne_top) _ _,
-  { rw Lp_meas_coe, exact Lp.ae_strongly_measurable _, },
-  { refine λ t ht hμt, (set_lintegral_nnnorm_condexp_L2_indicator_le hm hs hμs x ht hμt).trans _,
-    exact ennreal.mul_le_mul (measure_mono (set.inter_subset_left _ _)) le_rfl, },
-end
-
-end condexp_L2_indicator
-
-section condexp_ind_smul
-
-variables [normed_space ℝ G] {hm : m ≤ m0}
-
-/-- Conditional expectation of the indicator of a measurable set with finite measure, in L2. -/
-def condexp_ind_smul (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) : Lp G 2 μ :=
-(to_span_singleton ℝ x).comp_LpL 2 μ (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)))
-
-lemma ae_strongly_measurable'_condexp_ind_smul
-  (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  ae_strongly_measurable' m (condexp_ind_smul hm hs hμs x) μ :=
-begin
-  have h : ae_strongly_measurable' m (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ))) μ,
-    from ae_strongly_measurable'_condexp_L2 _ _,
-  rw condexp_ind_smul,
-  suffices : ae_strongly_measurable' m
-    ((to_span_singleton ℝ x) ∘ (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)))) μ,
-  { refine ae_strongly_measurable'.congr this _,
-    refine eventually_eq.trans _ (coe_fn_comp_LpL _ _).symm,
-    rw Lp_meas_coe, },
-  exact ae_strongly_measurable'.continuous_comp (to_span_singleton ℝ x).continuous h,
-end
-
-lemma condexp_ind_smul_add (hs : measurable_set s) (hμs : μ s ≠ ∞) (x y : G) :
-  condexp_ind_smul hm hs hμs (x + y)
-    = condexp_ind_smul hm hs hμs x + condexp_ind_smul hm hs hμs y :=
-by { simp_rw [condexp_ind_smul], rw [to_span_singleton_add, add_comp_LpL, add_apply], }
-
-lemma condexp_ind_smul_smul (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : ℝ) (x : G) :
-  condexp_ind_smul hm hs hμs (c • x) = c • condexp_ind_smul hm hs hμs x :=
-by { simp_rw [condexp_ind_smul], rw [to_span_singleton_smul, smul_comp_LpL, smul_apply], }
-
-lemma condexp_ind_smul_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F] (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (c : 𝕜) (x : F) :
-  condexp_ind_smul hm hs hμs (c • x) = c • condexp_ind_smul hm hs hμs x :=
-by rw [condexp_ind_smul, condexp_ind_smul, to_span_singleton_smul',
-  (to_span_singleton ℝ x).smul_comp_LpL_apply c
-  ↑(condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)))]
-
-lemma condexp_ind_smul_ae_eq_smul (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  condexp_ind_smul hm hs hμs x
-    =ᵐ[μ] λ a, (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a) • x :=
-(to_span_singleton ℝ x).coe_fn_comp_LpL _
-
-lemma set_lintegral_nnnorm_condexp_ind_smul_le (hm : m ≤ m0) (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (x : G) {t : set α} (ht : measurable_set[m] t) (hμt : μ t ≠ ∞) :
-  ∫⁻ a in t, ∥condexp_ind_smul hm hs hμs x a∥₊ ∂μ ≤ μ (s ∩ t) * ∥x∥₊ :=
-calc ∫⁻ a in t, ∥condexp_ind_smul hm hs hμs x a∥₊ ∂μ
-    = ∫⁻ a in t, ∥condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a • x∥₊ ∂μ :
-set_lintegral_congr_fun (hm t ht)
-  ((condexp_ind_smul_ae_eq_smul hm hs hμs x).mono (λ a ha hat, by rw ha ))
-... = ∫⁻ a in t, ∥condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a∥₊ ∂μ * ∥x∥₊ :
-begin
-  simp_rw [nnnorm_smul, ennreal.coe_mul],
-  rw [lintegral_mul_const, Lp_meas_coe],
-  exact (Lp.strongly_measurable _).ennnorm
-end
-... ≤ μ (s ∩ t) * ∥x∥₊ :
-  ennreal.mul_le_mul (lintegral_nnnorm_condexp_L2_indicator_le_real hs hμs ht hμt) le_rfl
-
-lemma lintegral_nnnorm_condexp_ind_smul_le (hm : m ≤ m0) (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (x : G) [sigma_finite (μ.trim hm)] :
-  ∫⁻ a, ∥condexp_ind_smul hm hs hμs x a∥₊ ∂μ ≤ μ s * ∥x∥₊ :=
-begin
-  refine lintegral_le_of_forall_fin_meas_le' hm (μ s * ∥x∥₊) _ (λ t ht hμt, _),
-  { exact (Lp.ae_strongly_measurable _).ennnorm },
-  refine (set_lintegral_nnnorm_condexp_ind_smul_le hm hs hμs x ht hμt).trans _,
-  refine ennreal.mul_le_mul _ le_rfl,
-  exact measure_mono (set.inter_subset_left _ _),
-end
-
-/-- If the measure `μ.trim hm` is sigma-finite, then the conditional expectation of a measurable set
-with finite measure is integrable. -/
-lemma integrable_condexp_ind_smul (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
-  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  integrable (condexp_ind_smul hm hs hμs x) μ :=
-begin
-  refine integrable_of_forall_fin_meas_le' hm (μ s * ∥x∥₊)
-    (ennreal.mul_lt_top hμs ennreal.coe_ne_top) _ _,
-  { exact Lp.ae_strongly_measurable _, },
-  { refine λ t ht hμt, (set_lintegral_nnnorm_condexp_ind_smul_le hm hs hμs x ht hμt).trans _,
-    exact ennreal.mul_le_mul (measure_mono (set.inter_subset_left _ _)) le_rfl, },
-end
-
-lemma condexp_ind_smul_empty {x : G} :
-  condexp_ind_smul hm measurable_set.empty
-    ((@measure_empty _ _ μ).le.trans_lt ennreal.coe_lt_top).ne x = 0 :=
-begin
-  rw [condexp_ind_smul, indicator_const_empty],
-  simp only [coe_fn_coe_base, submodule.coe_zero, continuous_linear_map.map_zero],
-end
-
-lemma set_integral_condexp_ind_smul (hs : measurable_set[m] s) (ht : measurable_set t)
-  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (x : G') :
-  ∫ a in s, (condexp_ind_smul hm ht hμt x) a ∂μ = (μ (t ∩ s)).to_real • x :=
-calc ∫ a in s, (condexp_ind_smul hm ht hμt x) a ∂μ
-    = (∫ a in s, (condexp_L2 ℝ hm (indicator_const_Lp 2 ht hμt (1 : ℝ)) a • x) ∂μ) :
-  set_integral_congr_ae (hm s hs) ((condexp_ind_smul_ae_eq_smul hm ht hμt x).mono (λ x hx hxs, hx))
-... = (∫ a in s, condexp_L2 ℝ hm (indicator_const_Lp 2 ht hμt (1 : ℝ)) a ∂μ) • x :
-  integral_smul_const _ x
-... = (∫ a in s, indicator_const_Lp 2 ht hμt (1 : ℝ) a ∂μ) • x :
-  by rw @integral_condexp_L2_eq α _ ℝ _ _ _ _ _ _ _ _ hm
-    (indicator_const_Lp 2 ht hμt (1 : ℝ)) hs hμs
-... = (μ (t ∩ s)).to_real • x :
-  by rw [set_integral_indicator_const_Lp (hm s hs), smul_assoc, one_smul]
-
-end condexp_ind_smul
-
-end condexp_L2
-
-section condexp_ind
-
-/-! ## Conditional expectation of an indicator as a continuous linear map.
-
-The goal of this section is to build
-`condexp_ind (hm : m ≤ m0) (μ : measure α) (s : set s) : G →L[ℝ] α →₁[μ] G`, which
-takes `x : G` to the conditional expectation of the indicator of the set `s` with value `x`,
-seen as an element of `α →₁[μ] G`.
--/
-
-variables {m m0 : measurable_space α} {μ : measure α} {s t : set α} [normed_space ℝ G]
-
-section condexp_ind_L1_fin
-
-/-- Conditional expectation of the indicator of a measurable set with finite measure,
-as a function in L1. -/
-def condexp_ind_L1_fin (hm : m ≤ m0) [sigma_finite (μ.trim hm)] (hs : measurable_set s)
-  (hμs : μ s ≠ ∞) (x : G) : α →₁[μ] G :=
-(integrable_condexp_ind_smul hm hs hμs x).to_L1 _
-
-lemma condexp_ind_L1_fin_ae_eq_condexp_ind_smul (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
-  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  condexp_ind_L1_fin hm hs hμs x =ᵐ[μ] condexp_ind_smul hm hs hμs x :=
-(integrable_condexp_ind_smul hm hs hμs x).coe_fn_to_L1
-
-variables {hm : m ≤ m0} [sigma_finite (μ.trim hm)]
-
-lemma condexp_ind_L1_fin_add (hs : measurable_set s) (hμs : μ s ≠ ∞) (x y : G) :
-  condexp_ind_L1_fin hm hs hμs (x + y)
-    = condexp_ind_L1_fin hm hs hμs x + condexp_ind_L1_fin hm hs hμs y :=
-begin
-  ext1,
-  refine (mem_ℒp.coe_fn_to_Lp _).trans _,
-  refine eventually_eq.trans _ (Lp.coe_fn_add _ _).symm,
-  refine eventually_eq.trans _
-    (eventually_eq.add (mem_ℒp.coe_fn_to_Lp _).symm (mem_ℒp.coe_fn_to_Lp _).symm),
-  rw condexp_ind_smul_add,
-  refine (Lp.coe_fn_add _ _).trans (eventually_of_forall (λ a, _)),
-  refl,
-end
-
-lemma condexp_ind_L1_fin_smul (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : ℝ) (x : G) :
-  condexp_ind_L1_fin hm hs hμs (c • x) = c • condexp_ind_L1_fin hm hs hμs x :=
-begin
-  ext1,
-  refine (mem_ℒp.coe_fn_to_Lp _).trans _,
-  refine eventually_eq.trans _ (Lp.coe_fn_smul _ _).symm,
-  rw condexp_ind_smul_smul hs hμs c x,
-  refine (Lp.coe_fn_smul _ _).trans _,
-  refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x).mono (λ y hy, _),
-  rw [pi.smul_apply, pi.smul_apply, hy],
-end
-
-lemma condexp_ind_L1_fin_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F]
-  (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : 𝕜) (x : F) :
-  condexp_ind_L1_fin hm hs hμs (c • x) = c • condexp_ind_L1_fin hm hs hμs x :=
-begin
-  ext1,
-  refine (mem_ℒp.coe_fn_to_Lp _).trans _,
-  refine eventually_eq.trans _ (Lp.coe_fn_smul _ _).symm,
-  rw condexp_ind_smul_smul' hs hμs c x,
-  refine (Lp.coe_fn_smul _ _).trans _,
-  refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x).mono (λ y hy, _),
-  rw [pi.smul_apply, pi.smul_apply, hy],
-end
-
-lemma norm_condexp_ind_L1_fin_le (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  ∥condexp_ind_L1_fin hm hs hμs x∥ ≤ (μ s).to_real * ∥x∥ :=
-begin
-  have : 0 ≤ ∫ (a : α), ∥condexp_ind_L1_fin hm hs hμs x a∥ ∂μ,
-    from integral_nonneg (λ a, norm_nonneg _),
-  rw [L1.norm_eq_integral_norm, ← ennreal.to_real_of_real (norm_nonneg x), ← ennreal.to_real_mul,
-    ← ennreal.to_real_of_real this, ennreal.to_real_le_to_real ennreal.of_real_ne_top
-      (ennreal.mul_ne_top hμs ennreal.of_real_ne_top),
-    of_real_integral_norm_eq_lintegral_nnnorm],
-  swap, { rw [← mem_ℒp_one_iff_integrable], exact Lp.mem_ℒp _, },
-  have h_eq : ∫⁻ a, ∥condexp_ind_L1_fin hm hs hμs x a∥₊ ∂μ
-    = ∫⁻ a, ∥condexp_ind_smul hm hs hμs x a∥₊ ∂μ,
-  { refine lintegral_congr_ae _,
-    refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x).mono (λ z hz, _),
-    dsimp only,
-    rw hz, },
-  rw [h_eq, of_real_norm_eq_coe_nnnorm],
-  exact lintegral_nnnorm_condexp_ind_smul_le hm hs hμs x,
-end
-
-lemma condexp_ind_L1_fin_disjoint_union (hs : measurable_set s) (ht : measurable_set t)
-  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) (x : G) :
-  condexp_ind_L1_fin hm (hs.union ht) ((measure_union_le s t).trans_lt
-    (lt_top_iff_ne_top.mpr (ennreal.add_ne_top.mpr ⟨hμs, hμt⟩))).ne x
-  = condexp_ind_L1_fin hm hs hμs x + condexp_ind_L1_fin hm ht hμt x :=
-begin
-  ext1,
-  have hμst := ((measure_union_le s t).trans_lt
-    (lt_top_iff_ne_top.mpr (ennreal.add_ne_top.mpr ⟨hμs, hμt⟩))).ne,
-  refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm (hs.union ht) hμst x).trans _,
-  refine eventually_eq.trans _ (Lp.coe_fn_add _ _).symm,
-  have hs_eq := condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x,
-  have ht_eq := condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm ht hμt x,
-  refine eventually_eq.trans _ (eventually_eq.add hs_eq.symm ht_eq.symm),
-  rw condexp_ind_smul,
-  rw indicator_const_Lp_disjoint_union hs ht hμs hμt hst (1 : ℝ),
-  rw (condexp_L2 ℝ hm).map_add,
-  push_cast,
-  rw ((to_span_singleton ℝ x).comp_LpL 2 μ).map_add,
-  refine (Lp.coe_fn_add _ _).trans _,
-  refine eventually_of_forall (λ y, _),
-  refl,
-end
-
-end condexp_ind_L1_fin
-
-open_locale classical
-
-section condexp_ind_L1
-
-/-- Conditional expectation of the indicator of a set, as a function in L1. Its value for sets
-which are not both measurable and of finite measure is not used: we set it to 0. -/
-def condexp_ind_L1 {m m0 : measurable_space α} (hm : m ≤ m0) (μ : measure α) (s : set α)
-  [sigma_finite (μ.trim hm)] (x : G) :
-  α →₁[μ] G :=
-if hs : measurable_set s ∧ μ s ≠ ∞ then condexp_ind_L1_fin hm hs.1 hs.2 x else 0
-
-variables {hm : m ≤ m0} [sigma_finite (μ.trim hm)]
-
-lemma condexp_ind_L1_of_measurable_set_of_measure_ne_top (hs : measurable_set s) (hμs : μ s ≠ ∞)
-  (x : G) :
-  condexp_ind_L1 hm μ s x = condexp_ind_L1_fin hm hs hμs x :=
-by simp only [condexp_ind_L1, and.intro hs hμs, dif_pos, ne.def, not_false_iff, and_self]
-
-lemma condexp_ind_L1_of_measure_eq_top (hμs : μ s = ∞) (x : G) :
-  condexp_ind_L1 hm μ s x = 0 :=
-by simp only [condexp_ind_L1, hμs, eq_self_iff_true, not_true, ne.def, dif_neg, not_false_iff,
-  and_false]
-
-lemma condexp_ind_L1_of_not_measurable_set (hs : ¬ measurable_set s) (x : G) :
-  condexp_ind_L1 hm μ s x = 0 :=
-by simp only [condexp_ind_L1, hs, dif_neg, not_false_iff, false_and]
-
-lemma condexp_ind_L1_add (x y : G) :
-  condexp_ind_L1 hm μ s (x + y) = condexp_ind_L1 hm μ s x + condexp_ind_L1 hm μ s y :=
-begin
-  by_cases hs : measurable_set s,
-  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw zero_add, },
-  by_cases hμs : μ s = ∞,
-  { simp_rw condexp_ind_L1_of_measure_eq_top hμs, rw zero_add, },
-  { simp_rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs,
-    exact condexp_ind_L1_fin_add hs hμs x y, },
-end
-
-lemma condexp_ind_L1_smul (c : ℝ) (x : G) :
-  condexp_ind_L1 hm μ s (c • x) = c • condexp_ind_L1 hm μ s x :=
-begin
-  by_cases hs : measurable_set s,
-  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw smul_zero, },
-  by_cases hμs : μ s = ∞,
-  { simp_rw condexp_ind_L1_of_measure_eq_top hμs, rw smul_zero, },
-  { simp_rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs,
-    exact condexp_ind_L1_fin_smul hs hμs c x, },
-end
-
-lemma condexp_ind_L1_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F] (c : 𝕜) (x : F) :
-  condexp_ind_L1 hm μ s (c • x) = c • condexp_ind_L1 hm μ s x :=
-begin
-  by_cases hs : measurable_set s,
-  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw smul_zero, },
-  by_cases hμs : μ s = ∞,
-  { simp_rw condexp_ind_L1_of_measure_eq_top hμs, rw smul_zero, },
-  { simp_rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs,
-    exact condexp_ind_L1_fin_smul' hs hμs c x, },
-end
-
-lemma norm_condexp_ind_L1_le (x : G) :
-  ∥condexp_ind_L1 hm μ s x∥ ≤ (μ s).to_real * ∥x∥ :=
-begin
-  by_cases hs : measurable_set s,
-  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw Lp.norm_zero,
-    exact mul_nonneg ennreal.to_real_nonneg (norm_nonneg _), },
-  by_cases hμs : μ s = ∞,
-  { rw [condexp_ind_L1_of_measure_eq_top hμs x, Lp.norm_zero],
-    exact mul_nonneg ennreal.to_real_nonneg (norm_nonneg _), },
-  { rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs x,
-    exact norm_condexp_ind_L1_fin_le hs hμs x, },
-end
-
-lemma continuous_condexp_ind_L1 : continuous (λ x : G, condexp_ind_L1 hm μ s x) :=
-continuous_of_linear_of_bound condexp_ind_L1_add condexp_ind_L1_smul norm_condexp_ind_L1_le
-
-lemma condexp_ind_L1_disjoint_union (hs : measurable_set s) (ht : measurable_set t)
-  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) (x : G) :
-  condexp_ind_L1 hm μ (s ∪ t) x = condexp_ind_L1 hm μ s x + condexp_ind_L1 hm μ t x :=
-begin
-  have hμst : μ (s ∪ t) ≠ ∞, from ((measure_union_le s t).trans_lt
-    (lt_top_iff_ne_top.mpr (ennreal.add_ne_top.mpr ⟨hμs, hμt⟩))).ne,
-  rw [condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs x,
-    condexp_ind_L1_of_measurable_set_of_measure_ne_top ht hμt x,
-    condexp_ind_L1_of_measurable_set_of_measure_ne_top (hs.union ht) hμst x],
-  exact condexp_ind_L1_fin_disjoint_union hs ht hμs hμt hst x,
-end
-
-end condexp_ind_L1
-
-/-- Conditional expectation of the indicator of a set, as a linear map from `G` to L1. -/
-def condexp_ind {m m0 : measurable_space α} (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)]
-  (s : set α) : G →L[ℝ] α →₁[μ] G :=
-{ to_fun    := condexp_ind_L1 hm μ s,
-  map_add'  := condexp_ind_L1_add,
-  map_smul' := condexp_ind_L1_smul,
-  cont      := continuous_condexp_ind_L1, }
-
-lemma condexp_ind_ae_eq_condexp_ind_smul (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
-  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  condexp_ind hm μ s x =ᵐ[μ] condexp_ind_smul hm hs hμs x :=
-begin
-  refine eventually_eq.trans _ (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x),
-  simp [condexp_ind, condexp_ind_L1, hs, hμs],
-end
-
-variables {hm : m ≤ m0} [sigma_finite (μ.trim hm)]
-
-lemma ae_strongly_measurable'_condexp_ind (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
-  ae_strongly_measurable' m (condexp_ind hm μ s x) μ :=
-ae_strongly_measurable'.congr (ae_strongly_measurable'_condexp_ind_smul hm hs hμs x)
-  (condexp_ind_ae_eq_condexp_ind_smul hm hs hμs x).symm
-
-@[simp] lemma condexp_ind_empty : condexp_ind hm μ ∅ = (0 : G →L[ℝ] α →₁[μ] G) :=
-begin
-  ext1,
-  ext1,
-  refine (condexp_ind_ae_eq_condexp_ind_smul hm measurable_set.empty (by simp) x).trans _,
-  rw condexp_ind_smul_empty,
-  refine (Lp.coe_fn_zero G 2 μ).trans _,
-  refine eventually_eq.trans _ (Lp.coe_fn_zero G 1 μ).symm,
-  refl,
-end
-
-lemma condexp_ind_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F] (c : 𝕜) (x : F) :
-  condexp_ind hm μ s (c • x) = c • condexp_ind hm μ s x :=
-condexp_ind_L1_smul' c x
-
-lemma norm_condexp_ind_apply_le (x : G) : ∥condexp_ind hm μ s x∥ ≤ (μ s).to_real * ∥x∥ :=
-norm_condexp_ind_L1_le x
-
-lemma norm_condexp_ind_le : ∥(condexp_ind hm μ s : G →L[ℝ] α →₁[μ] G)∥ ≤ (μ s).to_real :=
-continuous_linear_map.op_norm_le_bound _ ennreal.to_real_nonneg norm_condexp_ind_apply_le
-
-lemma condexp_ind_disjoint_union_apply (hs : measurable_set s) (ht : measurable_set t)
-  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) (x : G) :
-  condexp_ind hm μ (s ∪ t) x = condexp_ind hm μ s x + condexp_ind hm μ t x :=
-condexp_ind_L1_disjoint_union hs ht hμs hμt hst x
-
-lemma condexp_ind_disjoint_union (hs : measurable_set s) (ht : measurable_set t) (hμs : μ s ≠ ∞)
-  (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) :
-  (condexp_ind hm μ (s ∪ t) : G →L[ℝ] α →₁[μ] G) = condexp_ind hm μ s + condexp_ind hm μ t :=
-by { ext1, push_cast, exact condexp_ind_disjoint_union_apply hs ht hμs hμt hst x, }
-
-variables (G)
-
-lemma dominated_fin_meas_additive_condexp_ind (hm : m ≤ m0) (μ : measure α)
-  [sigma_finite (μ.trim hm)] :
-  dominated_fin_meas_additive μ (condexp_ind hm μ : set α → G →L[ℝ] α →₁[μ] G) 1 :=
-⟨λ s t, condexp_ind_disjoint_union, λ s _ _, norm_condexp_ind_le.trans (one_mul _).symm.le⟩
-
-variables {G}
-
-lemma set_integral_condexp_ind (hs : measurable_set[m] s) (ht : measurable_set t) (hμs : μ s ≠ ∞)
-  (hμt : μ t ≠ ∞) (x : G') :
-  ∫ a in s, condexp_ind hm μ t x a ∂μ = (μ (t ∩ s)).to_real • x :=
-calc
-∫ a in s, condexp_ind hm μ t x a ∂μ = ∫ a in s, condexp_ind_smul hm ht hμt x a ∂μ :
-  set_integral_congr_ae (hm s hs)
-    ((condexp_ind_ae_eq_condexp_ind_smul hm ht hμt x).mono (λ x hx hxs, hx))
-... = (μ (t ∩ s)).to_real • x : set_integral_condexp_ind_smul hs ht hμs hμt x
-
-lemma condexp_ind_of_measurable (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) (c : G) :
-  condexp_ind hm μ s c = indicator_const_Lp 1 (hm s hs) hμs c :=
-begin
-  ext1,
-  refine eventually_eq.trans _ indicator_const_Lp_coe_fn.symm,
-  refine (condexp_ind_ae_eq_condexp_ind_smul hm (hm s hs) hμs c).trans _,
-  refine (condexp_ind_smul_ae_eq_smul hm (hm s hs) hμs c).trans _,
-  rw [Lp_meas_coe, condexp_L2_indicator_of_measurable hm hs hμs (1 : ℝ)],
-  refine (@indicator_const_Lp_coe_fn α _ _ 2 μ _ s (hm s hs) hμs (1 : ℝ)).mono (λ x hx, _),
-  dsimp only,
-  rw hx,
-  by_cases hx_mem : x ∈ s; simp [hx_mem],
-end
-
-end condexp_ind
-
-section condexp_L1
-
-variables {m m0 : measurable_space α} {μ : measure α}
-  {hm : m ≤ m0} [sigma_finite (μ.trim hm)] {f g : α → F'} {s : set α}
-
-/-- Conditional expectation of a function as a linear map from `α →₁[μ] F'` to itself. -/
-def condexp_L1_clm (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)] :
-  (α →₁[μ] F') →L[ℝ] α →₁[μ] F' :=
-L1.set_to_L1 (dominated_fin_meas_additive_condexp_ind F' hm μ)
-
-lemma condexp_L1_clm_smul (c : 𝕜) (f : α →₁[μ] F') :
-  condexp_L1_clm hm μ (c • f) = c • condexp_L1_clm hm μ f :=
-L1.set_to_L1_smul (dominated_fin_meas_additive_condexp_ind F' hm μ)
-  (λ c s x, condexp_ind_smul' c x) c f
-
-lemma condexp_L1_clm_indicator_const_Lp (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : F') :
-  (condexp_L1_clm hm μ) (indicator_const_Lp 1 hs hμs x) = condexp_ind hm μ s x :=
-L1.set_to_L1_indicator_const_Lp (dominated_fin_meas_additive_condexp_ind F' hm μ) hs hμs x
-
-lemma condexp_L1_clm_indicator_const (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : F') :
-  (condexp_L1_clm hm μ) ↑(simple_func.indicator_const 1 hs hμs x) = condexp_ind hm μ s x :=
-by { rw Lp.simple_func.coe_indicator_const, exact condexp_L1_clm_indicator_const_Lp hs hμs x, }
-
-/-- Auxiliary lemma used in the proof of `set_integral_condexp_L1_clm`. -/
-lemma set_integral_condexp_L1_clm_of_measure_ne_top (f : α →₁[μ] F') (hs : measurable_set[m] s)
-  (hμs : μ s ≠ ∞) :
-  ∫ x in s, condexp_L1_clm hm μ f x ∂μ = ∫ x in s, f x ∂μ :=
-begin
-  refine Lp.induction ennreal.one_ne_top
-    (λ f : α →₁[μ] F', ∫ x in s, condexp_L1_clm hm μ f x ∂μ = ∫ x in s, f x ∂μ)
-  _ _ (is_closed_eq _ _) f,
-  { intros x t ht hμt,
-    simp_rw condexp_L1_clm_indicator_const ht hμt.ne x,
-    rw [Lp.simple_func.coe_indicator_const, set_integral_indicator_const_Lp (hm _ hs)],
-    exact set_integral_condexp_ind hs ht hμs hμt.ne x, },
-  { intros f g hf_Lp hg_Lp hfg_disj hf hg,
-    simp_rw (condexp_L1_clm hm μ).map_add,
-    rw set_integral_congr_ae (hm s hs) ((Lp.coe_fn_add (condexp_L1_clm hm μ (hf_Lp.to_Lp f))
-      (condexp_L1_clm hm μ (hg_Lp.to_Lp g))).mono (λ x hx hxs, hx)),
-    rw set_integral_congr_ae (hm s hs) ((Lp.coe_fn_add (hf_Lp.to_Lp f) (hg_Lp.to_Lp g)).mono
-      (λ x hx hxs, hx)),
-    simp_rw pi.add_apply,
-    rw [integral_add (L1.integrable_coe_fn _).integrable_on (L1.integrable_coe_fn _).integrable_on,
-      integral_add (L1.integrable_coe_fn _).integrable_on (L1.integrable_coe_fn _).integrable_on,
-      hf, hg], },
-  { exact (continuous_set_integral s).comp (condexp_L1_clm hm μ).continuous, },
-  { exact continuous_set_integral s, },
-end
-
-/-- The integral of the conditional expectation `condexp_L1_clm` over an `m`-measurable set is equal
-to the integral of `f` on that set. See also `set_integral_condexp`, the similar statement for
-`condexp`. -/
-lemma set_integral_condexp_L1_clm (f : α →₁[μ] F') (hs : measurable_set[m] s) :
-  ∫ x in s, condexp_L1_clm hm μ f x ∂μ = ∫ x in s, f x ∂μ :=
-begin
-  let S := spanning_sets (μ.trim hm),
-  have hS_meas : ∀ i, measurable_set[m] (S i) := measurable_spanning_sets (μ.trim hm),
-  have hS_meas0 : ∀ i, measurable_set (S i) := λ i, hm _ (hS_meas i),
-  have hs_eq : s = ⋃ i, S i ∩ s,
-  { simp_rw set.inter_comm,
-    rw [← set.inter_Union, (Union_spanning_sets (μ.trim hm)), set.inter_univ], },
-  have hS_finite : ∀ i, μ (S i ∩ s) < ∞,
-  { refine λ i, (measure_mono (set.inter_subset_left _ _)).trans_lt _,
-    have hS_finite_trim := measure_spanning_sets_lt_top (μ.trim hm) i,
-    rwa trim_measurable_set_eq hm (hS_meas i) at hS_finite_trim, },
-  have h_mono : monotone (λ i, (S i) ∩ s),
-  { intros i j hij x,
-    simp_rw set.mem_inter_iff,
-    exact λ h, ⟨monotone_spanning_sets (μ.trim hm) hij h.1, h.2⟩, },
-  have h_eq_forall : (λ i, ∫ x in (S i) ∩ s, condexp_L1_clm hm μ f x ∂μ)
-      = λ i, ∫ x in (S i) ∩ s, f x ∂μ,
-    from funext (λ i, set_integral_condexp_L1_clm_of_measure_ne_top f
-      (@measurable_set.inter α m _ _ (hS_meas i) hs) (hS_finite i).ne),
-  have h_right : tendsto (λ i, ∫ x in (S i) ∩ s, f x ∂μ) at_top (𝓝 (∫ x in s, f x ∂μ)),
-  { have h := tendsto_set_integral_of_monotone (λ i, (hS_meas0 i).inter (hm s hs)) h_mono
-      (L1.integrable_coe_fn f).integrable_on,
-    rwa ← hs_eq at h, },
-  have h_left : tendsto (λ i, ∫ x in (S i) ∩ s, condexp_L1_clm hm μ f x ∂μ) at_top
-    (𝓝 (∫ x in s, condexp_L1_clm hm μ f x ∂μ)),
-  { have h := tendsto_set_integral_of_monotone (λ i, (hS_meas0 i).inter (hm s hs))
-      h_mono (L1.integrable_coe_fn (condexp_L1_clm hm μ f)).integrable_on,
-    rwa ← hs_eq at h, },
-  rw h_eq_forall at h_left,
-  exact tendsto_nhds_unique h_left h_right,
-end
-
-lemma ae_strongly_measurable'_condexp_L1_clm (f : α →₁[μ] F') :
-  ae_strongly_measurable' m (condexp_L1_clm hm μ f) μ :=
-begin
-  refine Lp.induction ennreal.one_ne_top
-    (λ f : α →₁[μ] F', ae_strongly_measurable' m (condexp_L1_clm hm μ f) μ)
-    _ _ _ f,
-  { intros c s hs hμs,
-    rw condexp_L1_clm_indicator_const hs hμs.ne c,
-    exact ae_strongly_measurable'_condexp_ind hs hμs.ne c, },
-  { intros f g hf hg h_disj hfm hgm,
-    rw (condexp_L1_clm hm μ).map_add,
-    refine ae_strongly_measurable'.congr _ (coe_fn_add _ _).symm,
-    exact ae_strongly_measurable'.add hfm hgm, },
-  { have : {f : Lp F' 1 μ | ae_strongly_measurable' m (condexp_L1_clm hm μ f) μ}
-        = (condexp_L1_clm hm μ) ⁻¹' {f | ae_strongly_measurable' m f μ},
-      by refl,
-    rw this,
-    refine is_closed.preimage (condexp_L1_clm hm μ).continuous _,
-    exact is_closed_ae_strongly_measurable' hm, },
-end
-
-lemma condexp_L1_clm_Lp_meas (f : Lp_meas F' ℝ m 1 μ) :
-  condexp_L1_clm hm μ (f : α →₁[μ] F') = ↑f :=
-begin
-  let g := Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm f,
-  have hfg : f = (Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm).symm g,
-    by simp only [linear_isometry_equiv.symm_apply_apply],
-  rw hfg,
-  refine @Lp.induction α F' m _ 1 (μ.trim hm) _ ennreal.coe_ne_top
-    (λ g : α →₁[μ.trim hm] F',
-      condexp_L1_clm hm μ ((Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm).symm g : α →₁[μ] F')
-        = ↑((Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm).symm g)) _ _ _ g,
-  { intros c s hs hμs,
-    rw [Lp.simple_func.coe_indicator_const, Lp_meas_to_Lp_trim_lie_symm_indicator hs hμs.ne c,
-      condexp_L1_clm_indicator_const_Lp],
-    exact condexp_ind_of_measurable hs ((le_trim hm).trans_lt hμs).ne c, },
-  { intros f g hf hg hfg_disj hf_eq hg_eq,
-    rw linear_isometry_equiv.map_add,
-    push_cast,
-    rw [map_add, hf_eq, hg_eq], },
-  { refine is_closed_eq _ _,
-    { refine (condexp_L1_clm hm μ).continuous.comp (continuous_induced_dom.comp _),
-      exact linear_isometry_equiv.continuous _, },
-    { refine continuous_induced_dom.comp _,
-      exact linear_isometry_equiv.continuous _, }, },
-end
-
-lemma condexp_L1_clm_of_ae_strongly_measurable'
-  (f : α →₁[μ] F') (hfm : ae_strongly_measurable' m f μ) :
-  condexp_L1_clm hm μ f = f :=
-condexp_L1_clm_Lp_meas (⟨f, hfm⟩ : Lp_meas F' ℝ m 1 μ)
-
-/-- Conditional expectation of a function, in L1. Its value is 0 if the function is not
-integrable. The function-valued `condexp` should be used instead in most cases. -/
-def condexp_L1 (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)] (f : α → F') : α →₁[μ] F' :=
-set_to_fun μ (condexp_ind hm μ) (dominated_fin_meas_additive_condexp_ind F' hm μ) f
-
-lemma condexp_L1_undef (hf : ¬ integrable f μ) : condexp_L1 hm μ f = 0 :=
-set_to_fun_undef (dominated_fin_meas_additive_condexp_ind F' hm μ) hf
-
-lemma condexp_L1_eq (hf : integrable f μ) :
-  condexp_L1 hm μ f = condexp_L1_clm hm μ (hf.to_L1 f) :=
-set_to_fun_eq (dominated_fin_meas_additive_condexp_ind F' hm μ) hf
-
-lemma condexp_L1_zero : condexp_L1 hm μ (0 : α → F') = 0 :=
-set_to_fun_zero _
-
-lemma ae_strongly_measurable'_condexp_L1 {f : α → F'} :
-  ae_strongly_measurable' m (condexp_L1 hm μ f) μ :=
-begin
-  by_cases hf : integrable f μ,
-  { rw condexp_L1_eq hf,
-    exact ae_strongly_measurable'_condexp_L1_clm _, },
-  { rw condexp_L1_undef hf,
-    refine ae_strongly_measurable'.congr _ (coe_fn_zero _ _ _).symm,
-    exact strongly_measurable.ae_strongly_measurable' (@strongly_measurable_zero _ _ m _ _), },
-end
-
-lemma integrable_condexp_L1 (f : α → F') : integrable (condexp_L1 hm μ f) μ :=
-L1.integrable_coe_fn _
-
-/-- The integral of the conditional expectation `condexp_L1` over an `m`-measurable set is equal to
-the integral of `f` on that set. See also `set_integral_condexp`, the similar statement for
-`condexp`. -/
-lemma set_integral_condexp_L1 (hf : integrable f μ) (hs : measurable_set[m] s) :
-  ∫ x in s, condexp_L1 hm μ f x ∂μ = ∫ x in s, f x ∂μ :=
-begin
-  simp_rw condexp_L1_eq hf,
-  rw set_integral_condexp_L1_clm (hf.to_L1 f) hs,
-  exact set_integral_congr_ae (hm s hs) ((hf.coe_fn_to_L1).mono (λ x hx hxs, hx)),
-end
-
-lemma condexp_L1_add (hf : integrable f μ) (hg : integrable g μ) :
-  condexp_L1 hm μ (f + g) = condexp_L1 hm μ f + condexp_L1 hm μ g :=
-set_to_fun_add _ hf hg
-
-lemma condexp_L1_neg (f : α → F') : condexp_L1 hm μ (-f) = - condexp_L1 hm μ f :=
-set_to_fun_neg _ f
-
-lemma condexp_L1_smul (c : 𝕜) (f : α → F') : condexp_L1 hm μ (c • f) = c • condexp_L1 hm μ f :=
-set_to_fun_smul _ (λ c _ x, condexp_ind_smul' c x) c f
-
-lemma condexp_L1_sub (hf : integrable f μ) (hg : integrable g μ) :
-  condexp_L1 hm μ (f - g) = condexp_L1 hm μ f - condexp_L1 hm μ g :=
-set_to_fun_sub _ hf hg
-
-lemma condexp_L1_of_ae_strongly_measurable'
-  (hfm : ae_strongly_measurable' m f μ) (hfi : integrable f μ) :
-  condexp_L1 hm μ f =ᵐ[μ] f :=
-begin
-  rw condexp_L1_eq hfi,
-  refine eventually_eq.trans _ (integrable.coe_fn_to_L1 hfi),
-  rw condexp_L1_clm_of_ae_strongly_measurable',
-  exact ae_strongly_measurable'.congr hfm (integrable.coe_fn_to_L1 hfi).symm,
-end
-
-end condexp_L1
-
-section condexp
-
-/-! ### Conditional expectation of a function -/
-
-open_locale classical
-
-variables {𝕜} {m m0 : measurable_space α} {μ : measure α}
-  {hm : m ≤ m0} [sigma_finite (μ.trim hm)] {f g : α → F'} {s : set α}
-
-variables (m)
-/-- Conditional expectation of a function. Its value is 0 if the function is not integrable. -/
-@[irreducible] def condexp (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)] (f : α → F') :
-  α → F' :=
-if (strongly_measurable[m] f ∧ integrable f μ) then f
-else ae_strongly_measurable'_condexp_L1.mk (condexp_L1 hm μ f)
-
-variables {m}
-
--- We define notations `μ[f|hm]` and `μ[f|m,hm]` for the conditional expectation of `f` with
--- respect to `m`. Both can be used in code but only the second one will be used by the goal view.
--- The first notation avoids the repetition of `m`, which is already present in `hm`. The second
--- one ensures that `m` stays visible in the goal view: when `hm` is complicated, it gets rendered
--- as `_` and the measurable space would not be visible in `μ[f|_]`, but is clear in `μ[f|m,_]`.
-localized "notation  μ `[` f `|` hm `]` := measure_theory.condexp _ hm μ f" in measure_theory
-localized "notation  μ `[` f `|` m `,` hm `]` := measure_theory.condexp m hm μ f" in measure_theory
-
-lemma condexp_of_strongly_measurable
-  {f : α → F'} (hf : strongly_measurable[m] f) (hfi : integrable f μ) :
-  μ[f|m,hm] = f :=
-by rw [condexp, if_pos (⟨hf, hfi⟩ : strongly_measurable[m] f ∧ integrable f μ)]
-
-lemma condexp_const (c : F') [is_finite_measure μ] : μ[(λ x : α, c)|m,hm] = λ _, c :=
-condexp_of_strongly_measurable (@strongly_measurable_const _ _ m _ _) (integrable_const c)
-
-lemma condexp_ae_eq_condexp_L1 (f : α → F') : μ[f|m,hm] =ᵐ[μ] condexp_L1 hm μ f :=
-begin
-  unfold condexp,
-  by_cases hfm : strongly_measurable[m] f,
-  { by_cases hfi : integrable f μ,
-    { rw if_pos (⟨hfm, hfi⟩ : strongly_measurable[m] f ∧ integrable f μ),
-      exact (condexp_L1_of_ae_strongly_measurable'
-        (strongly_measurable.ae_strongly_measurable' hfm) hfi).symm, },
-    { simp only [hfi, if_false, and_false],
-      exact (ae_strongly_measurable'.ae_eq_mk ae_strongly_measurable'_condexp_L1).symm, }, },
-  simp only [hfm, if_false, false_and],
-  exact (ae_strongly_measurable'.ae_eq_mk ae_strongly_measurable'_condexp_L1).symm,
-end
-
-lemma condexp_ae_eq_condexp_L1_clm (hf : integrable f μ) :
-  μ[f|m,hm] =ᵐ[μ] condexp_L1_clm hm μ (hf.to_L1 f) :=
-begin
-  refine (condexp_ae_eq_condexp_L1 f).trans (eventually_of_forall (λ x, _)),
-  rw condexp_L1_eq hf,
-end
-
-lemma condexp_undef (hf : ¬ integrable f μ) : μ[f|m,hm] =ᵐ[μ] 0 :=
-begin
-  refine (condexp_ae_eq_condexp_L1 f).trans (eventually_eq.trans _ (coe_fn_zero _ 1 _)),
-  rw condexp_L1_undef hf,
-end
-
-@[simp] lemma condexp_zero : μ[(0 : α → F')|m,hm] = 0 :=
-condexp_of_strongly_measurable (@strongly_measurable_zero _ _ m _ _) (integrable_zero _ _ _)
-
-lemma strongly_measurable_condexp : strongly_measurable[m] (μ[f|m,hm]) :=
-begin
-  unfold condexp,
-  by_cases hfm : strongly_measurable[m] f,
-  { by_cases hfi : integrable f μ,
-    { rwa if_pos (⟨hfm, hfi⟩ : strongly_measurable[m] f ∧ integrable f μ), },
-    { simp only [hfi, if_false, and_false],
-      exact ae_strongly_measurable'.strongly_measurable_mk _, }, },
-  simp only [hfm, if_false, false_and],
-  exact ae_strongly_measurable'.strongly_measurable_mk _,
-end
-
-lemma integrable_condexp : integrable (μ[f|m,hm]) μ :=
-(integrable_condexp_L1 f).congr (condexp_ae_eq_condexp_L1 f).symm
-
-variable (hm)
-
-/-- The integral of the conditional expectation `μ[f|hm]` over an `m`-measurable set is equal to
-the integral of `f` on that set. -/
-lemma set_integral_condexp (hf : integrable f μ) (hs : measurable_set[m] s) :
-  ∫ x in s, μ[f|m,hm] x ∂μ = ∫ x in s, f x ∂μ :=
-begin
-  rw set_integral_congr_ae (hm s hs) ((condexp_ae_eq_condexp_L1 f).mono (λ x hx _, hx)),
-  exact set_integral_condexp_L1 hf hs,
-end
-
-variable {hm}
-
-lemma integral_condexp (hf : integrable f μ) : ∫ x, μ[f|m,hm] x ∂μ = ∫ x, f x ∂μ :=
-begin
-  suffices : ∫ x in set.univ, μ[f|m,hm] x ∂μ = ∫ x in set.univ, f x ∂μ,
-    by { simp_rw integral_univ at this, exact this, },
-  exact set_integral_condexp hm hf (@measurable_set.univ _ m),
-end
-
-/-- **Uniqueness of the conditional expectation**
-If a function is a.e. `m`-measurable, verifies an integrability condition and has same integral
-as `f` on all `m`-measurable sets, then it is a.e. equal to `μ[f|hm]`. -/
-lemma ae_eq_condexp_of_forall_set_integral_eq (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
-  {f g : α → F'} (hf : integrable f μ)
-  (hg_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on g s μ)
-  (hg_eq : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, g x ∂μ = ∫ x in s, f x ∂μ)
-  (hgm : ae_strongly_measurable' m g μ) :
-  g =ᵐ[μ] μ[f|m,hm] :=
-begin
-  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' hm hg_int_finite
-    (λ s hs hμs, integrable_condexp.integrable_on) (λ s hs hμs, _) hgm
-    (strongly_measurable.ae_strongly_measurable' strongly_measurable_condexp),
-  rw [hg_eq s hs hμs, set_integral_condexp hm hf hs],
-end
-
-lemma condexp_add (hf : integrable f μ) (hg : integrable g μ) :
-  μ[f + g | m,hm] =ᵐ[μ] μ[f|m,hm] + μ[g|m,hm] :=
-begin
-  refine (condexp_ae_eq_condexp_L1 _).trans _,
-  rw condexp_L1_add hf hg,
-  exact (coe_fn_add _ _).trans
-    ((condexp_ae_eq_condexp_L1 _).symm.add (condexp_ae_eq_condexp_L1 _).symm),
-end
-
-lemma condexp_smul (c : 𝕜) (f : α → F') : μ[c • f | m,hm] =ᵐ[μ] c • μ[f|m,hm] :=
-begin
-  refine (condexp_ae_eq_condexp_L1 _).trans _,
-  rw condexp_L1_smul c f,
-  refine (@condexp_ae_eq_condexp_L1 _ _ _ _ _ m _ _ hm _ f).mp _,
-  refine (coe_fn_smul c (condexp_L1 hm μ f)).mono (λ x hx1 hx2, _),
-  rw [hx1, pi.smul_apply, pi.smul_apply, hx2],
-end
-
-lemma condexp_neg (f : α → F') : μ[-f|m,hm] =ᵐ[μ] - μ[f|m,hm] :=
-by letI : module ℝ (α → F') := @pi.module α (λ _, F') ℝ _ _ (λ _, infer_instance);
-calc μ[-f|m,hm] = μ[(-1 : ℝ) • f|m,hm] : by rw neg_one_smul ℝ f
-... =ᵐ[μ] (-1 : ℝ) • μ[f|m,hm] : condexp_smul (-1) f
-... = -μ[f|m,hm] : neg_one_smul ℝ (μ[f|m,hm])
-
-lemma condexp_sub (hf : integrable f μ) (hg : integrable g μ) :
-  μ[f - g | m,hm] =ᵐ[μ] μ[f|m,hm] - μ[g|m,hm] :=
-begin
-  simp_rw sub_eq_add_neg,
-  exact (condexp_add hf hg.neg).trans (eventually_eq.rfl.add (condexp_neg g)),
-end
-
-lemma condexp_condexp_of_le {m₁ m₂ m0 : measurable_space α} {μ : measure α}
-  (hm₁₂ : m₁ ≤ m₂) (hm₂ : m₂ ≤ m0) [sigma_finite (μ.trim (hm₁₂.trans hm₂))]
-  [sigma_finite (μ.trim hm₂)] :
-  μ[ μ[f|m₂, hm₂] | m₁, hm₁₂.trans hm₂] =ᵐ[μ] μ[f | m₁, hm₁₂.trans hm₂] :=
-begin
-  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' (hm₁₂.trans hm₂)
-    (λ s hs hμs, integrable_condexp.integrable_on) (λ s hs hμs, integrable_condexp.integrable_on)
-    _ (strongly_measurable.ae_strongly_measurable' strongly_measurable_condexp)
-      (strongly_measurable.ae_strongly_measurable' strongly_measurable_condexp),
-  intros s hs hμs,
-  rw set_integral_condexp _ integrable_condexp hs,
-  by_cases hf : integrable f μ,
-  { rw [set_integral_condexp _ hf hs, set_integral_condexp _ hf (hm₁₂ s hs)], },
-  { simp_rw integral_congr_ae (ae_restrict_of_ae (condexp_undef hf)), },
-end
-
-section real
-
-lemma rn_deriv_ae_eq_condexp {f : α → ℝ} (hf : integrable f μ) :
-  signed_measure.rn_deriv ((μ.with_densityᵥ f).trim hm) (μ.trim hm) =ᵐ[μ] μ[f | m,hm] :=
-begin
-  refine ae_eq_condexp_of_forall_set_integral_eq hm hf _ _ _,
-  { exact λ _ _ _, (integrable_of_integrable_trim hm (signed_measure.integrable_rn_deriv
-      ((μ.with_densityᵥ f).trim hm) (μ.trim hm))).integrable_on },
-  { intros s hs hlt,
-    conv_rhs { rw [← hf.with_densityᵥ_trim_eq_integral hm hs,
-      ← signed_measure.with_densityᵥ_rn_deriv_eq ((μ.with_densityᵥ f).trim hm) (μ.trim hm)
-        (hf.with_densityᵥ_trim_absolutely_continuous hm)], },
-    rw [with_densityᵥ_apply
-        (signed_measure.integrable_rn_deriv ((μ.with_densityᵥ f).trim hm) (μ.trim hm)) hs,
-      ← set_integral_trim hm _ hs],
-    exact (signed_measure.measurable_rn_deriv _ _).strongly_measurable },
-  { exact strongly_measurable.ae_strongly_measurable'
-      (signed_measure.measurable_rn_deriv _ _).strongly_measurable },
-end
-
-end real
-
-end condexp
-
-end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/ae_measurable.lean b/src/measure_theory/function/conditional_expectation/ae_measurable.lean
new file mode 100644
index 0000000000000..2cc7b7b1d1eb7
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/ae_measurable.lean
@@ -0,0 +1,701 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.function.l2_space
+import measure_theory.function.strongly_measurable.lp
+
+/-! # Functions a.e. measurable with respect to a sub-σ-algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A function `f` verifies `ae_strongly_measurable' m f μ` if it is `μ`-a.e. equal to
+an `m`-strongly measurable function. This is similar to `ae_strongly_measurable`, but the
+`measurable_space` structures used for the measurability statement and for the measure are
+different.
+
+We define `Lp_meas F 𝕜 m p μ`, the subspace of `Lp F p μ` containing functions `f` verifying
+`ae_strongly_measurable' m f μ`, i.e. functions which are `μ`-a.e. equal to an `m`-strongly
+measurable function.
+
+## Main statements
+
+We define an `isometry_equiv` between `Lp_meas_subgroup` and the `Lp` space corresponding to the
+measure `μ.trim hm`. As a consequence, the completeness of `Lp` implies completeness of `Lp_meas`.
+
+`Lp.induction_strongly_measurable` (see also `mem_ℒp.induction_strongly_measurable`):
+To prove something for an `Lp` function a.e. strongly measurable with respect to a
+sub-σ-algebra `m` in a normed space, it suffices to show that
+* the property holds for (multiples of) characteristic functions which are measurable w.r.t. `m`;
+* is closed under addition;
+* the set of functions in `Lp` strongly measurable w.r.t. `m` for which the property holds is
+  closed.
+
+-/
+
+open topological_space filter
+open_locale ennreal measure_theory
+
+namespace measure_theory
+
+/-- A function `f` verifies `ae_strongly_measurable' m f μ` if it is `μ`-a.e. equal to
+an `m`-strongly measurable function. This is similar to `ae_strongly_measurable`, but the
+`measurable_space` structures used for the measurability statement and for the measure are
+different. -/
+def ae_strongly_measurable' {α β} [topological_space β]
+  (m : measurable_space α) {m0 : measurable_space α}
+  (f : α → β) (μ : measure α) : Prop :=
+∃ g : α → β, strongly_measurable[m] g ∧ f =ᵐ[μ] g
+
+namespace ae_strongly_measurable'
+
+variables {α β 𝕜 : Type*} {m m0 : measurable_space α} {μ : measure α}
+  [topological_space β] {f g : α → β}
+
+lemma congr (hf : ae_strongly_measurable' m f μ) (hfg : f =ᵐ[μ] g) :
+  ae_strongly_measurable' m g μ :=
+by { obtain ⟨f', hf'_meas, hff'⟩ := hf, exact ⟨f', hf'_meas, hfg.symm.trans hff'⟩, }
+
+lemma add [has_add β] [has_continuous_add β] (hf : ae_strongly_measurable' m f μ)
+  (hg : ae_strongly_measurable' m g μ) :
+  ae_strongly_measurable' m (f+g) μ :=
+begin
+  rcases hf with ⟨f', h_f'_meas, hff'⟩,
+  rcases hg with ⟨g', h_g'_meas, hgg'⟩,
+  exact ⟨f' + g', h_f'_meas.add h_g'_meas, hff'.add hgg'⟩,
+end
+
+lemma neg [add_group β] [topological_add_group β]
+  {f : α → β} (hfm : ae_strongly_measurable' m f μ) :
+  ae_strongly_measurable' m (-f) μ :=
+begin
+  rcases hfm with ⟨f', hf'_meas, hf_ae⟩,
+  refine ⟨-f', hf'_meas.neg, hf_ae.mono (λ x hx, _)⟩,
+  simp_rw pi.neg_apply,
+  rw hx,
+end
+
+lemma sub [add_group β] [topological_add_group β] {f g : α → β}
+  (hfm : ae_strongly_measurable' m f μ) (hgm : ae_strongly_measurable' m g μ) :
+  ae_strongly_measurable' m (f - g) μ :=
+begin
+  rcases hfm with ⟨f', hf'_meas, hf_ae⟩,
+  rcases hgm with ⟨g', hg'_meas, hg_ae⟩,
+  refine ⟨f'-g', hf'_meas.sub hg'_meas, hf_ae.mp (hg_ae.mono (λ x hx1 hx2, _))⟩,
+  simp_rw pi.sub_apply,
+  rw [hx1, hx2],
+end
+
+lemma const_smul [has_smul 𝕜 β] [has_continuous_const_smul 𝕜 β]
+  (c : 𝕜) (hf : ae_strongly_measurable' m f μ) :
+  ae_strongly_measurable' m (c • f) μ :=
+begin
+  rcases hf with ⟨f', h_f'_meas, hff'⟩,
+  refine ⟨c • f', h_f'_meas.const_smul c, _⟩,
+  exact eventually_eq.fun_comp hff' (λ x, c • x),
+end
+
+lemma const_inner {𝕜 β} [is_R_or_C 𝕜] [normed_add_comm_group β] [inner_product_space 𝕜 β]
+  {f : α → β} (hfm : ae_strongly_measurable' m f μ) (c : β) :
+  ae_strongly_measurable' m (λ x, (inner c (f x) : 𝕜)) μ :=
+begin
+  rcases hfm with ⟨f', hf'_meas, hf_ae⟩,
+  refine ⟨λ x, (inner c (f' x) : 𝕜), (@strongly_measurable_const _ _ m _ _).inner hf'_meas,
+    hf_ae.mono (λ x hx, _)⟩,
+  dsimp only,
+  rw hx,
+end
+
+/-- An `m`-strongly measurable function almost everywhere equal to `f`. -/
+noncomputable
+def mk (f : α → β) (hfm : ae_strongly_measurable' m f μ) : α → β := hfm.some
+
+lemma strongly_measurable_mk {f : α → β} (hfm : ae_strongly_measurable' m f μ) :
+  strongly_measurable[m] (hfm.mk f) :=
+hfm.some_spec.1
+
+lemma ae_eq_mk {f : α → β} (hfm : ae_strongly_measurable' m f μ) : f =ᵐ[μ] hfm.mk f :=
+hfm.some_spec.2
+
+lemma continuous_comp {γ} [topological_space γ] {f : α → β} {g : β → γ}
+  (hg : continuous g) (hf : ae_strongly_measurable' m f μ) :
+  ae_strongly_measurable' m (g ∘ f) μ :=
+⟨λ x, g (hf.mk _ x),
+  @continuous.comp_strongly_measurable _ _ _ m _ _ _ _ hg hf.strongly_measurable_mk,
+  hf.ae_eq_mk.mono (λ x hx, by rw [function.comp_apply, hx])⟩
+
+end ae_strongly_measurable'
+
+lemma ae_strongly_measurable'_of_ae_strongly_measurable'_trim {α β} {m m0 m0' : measurable_space α}
+  [topological_space β] (hm0 : m0 ≤ m0') {μ : measure α} {f : α → β}
+  (hf : ae_strongly_measurable' m f (μ.trim hm0)) :
+  ae_strongly_measurable' m f μ :=
+by { obtain ⟨g, hg_meas, hfg⟩ := hf, exact ⟨g, hg_meas, ae_eq_of_ae_eq_trim hfg⟩, }
+
+lemma strongly_measurable.ae_strongly_measurable'
+  {α β} {m m0 : measurable_space α} [topological_space β]
+  {μ : measure α} {f : α → β} (hf : strongly_measurable[m] f) :
+  ae_strongly_measurable' m f μ :=
+⟨f, hf, ae_eq_refl _⟩
+
+lemma ae_eq_trim_iff_of_ae_strongly_measurable' {α β} [topological_space β] [metrizable_space β]
+  {m m0 : measurable_space α} {μ : measure α} {f g : α → β}
+  (hm : m ≤ m0) (hfm : ae_strongly_measurable' m f μ) (hgm : ae_strongly_measurable' m g μ) :
+  hfm.mk f =ᵐ[μ.trim hm] hgm.mk g ↔ f =ᵐ[μ] g :=
+(ae_eq_trim_iff hm hfm.strongly_measurable_mk hgm.strongly_measurable_mk).trans
+⟨λ h, hfm.ae_eq_mk.trans (h.trans hgm.ae_eq_mk.symm),
+  λ h, hfm.ae_eq_mk.symm.trans (h.trans hgm.ae_eq_mk)⟩
+
+lemma ae_strongly_measurable.comp_ae_measurable'
+  {α β γ : Type*} [topological_space β] {mα : measurable_space α} {mγ : measurable_space γ}
+  {f : α → β} {μ : measure γ} {g : γ → α}
+  (hf : ae_strongly_measurable f (μ.map g)) (hg : ae_measurable g μ) :
+  ae_strongly_measurable' (mα.comap g) (f ∘ g) μ :=
+⟨(hf.mk f) ∘ g, hf.strongly_measurable_mk.comp_measurable (measurable_iff_comap_le.mpr le_rfl),
+  ae_eq_comp hg hf.ae_eq_mk⟩
+
+/-- If the restriction to a set `s` of a σ-algebra `m` is included in the restriction to `s` of
+another σ-algebra `m₂` (hypothesis `hs`), the set `s` is `m` measurable and a function `f` almost
+everywhere supported on `s` is `m`-ae-strongly-measurable, then `f` is also
+`m₂`-ae-strongly-measurable. -/
+lemma ae_strongly_measurable'.ae_strongly_measurable'_of_measurable_space_le_on
+  {α E} {m m₂ m0 : measurable_space α} {μ : measure α}
+  [topological_space E] [has_zero E] (hm : m ≤ m0) {s : set α} {f : α → E}
+  (hs_m : measurable_set[m] s) (hs : ∀ t, measurable_set[m] (s ∩ t) → measurable_set[m₂] (s ∩ t))
+  (hf : ae_strongly_measurable' m f μ) (hf_zero : f =ᵐ[μ.restrict sᶜ] 0) :
+  ae_strongly_measurable' m₂ f μ :=
+begin
+  let f' := hf.mk f,
+  have h_ind_eq : s.indicator (hf.mk f) =ᵐ[μ] f,
+  { refine filter.eventually_eq.trans _
+      (indicator_ae_eq_of_restrict_compl_ae_eq_zero (hm _ hs_m) hf_zero),
+    filter_upwards [hf.ae_eq_mk] with x hx,
+    by_cases hxs : x ∈ s,
+    { simp [hxs, hx], },
+    { simp [hxs], }, },
+  suffices : strongly_measurable[m₂] (s.indicator (hf.mk f)),
+    from ae_strongly_measurable'.congr this.ae_strongly_measurable' h_ind_eq,
+  have hf_ind : strongly_measurable[m] (s.indicator (hf.mk f)),
+    from hf.strongly_measurable_mk.indicator hs_m,
+  exact hf_ind.strongly_measurable_of_measurable_space_le_on hs_m hs
+    (λ x hxs, set.indicator_of_not_mem hxs _),
+end
+
+variables {α E' F F' 𝕜 : Type*} {p : ℝ≥0∞}
+  [is_R_or_C 𝕜] -- 𝕜 for ℝ or ℂ
+  -- E' for an inner product space on which we compute integrals
+  [normed_add_comm_group E'] [inner_product_space 𝕜 E']
+  [complete_space E'] [normed_space ℝ E']
+  -- F for a Lp submodule
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  -- F' for integrals on a Lp submodule
+  [normed_add_comm_group F'] [normed_space 𝕜 F'] [normed_space ℝ F'] [complete_space F']
+
+section Lp_meas
+
+/-! ## The subset `Lp_meas` of `Lp` functions a.e. measurable with respect to a sub-sigma-algebra -/
+
+variables (F)
+
+/-- `Lp_meas_subgroup F m p μ` is the subspace of `Lp F p μ` containing functions `f` verifying
+`ae_strongly_measurable' m f μ`, i.e. functions which are `μ`-a.e. equal to
+an `m`-strongly measurable function. -/
+def Lp_meas_subgroup (m : measurable_space α) [measurable_space α] (p : ℝ≥0∞) (μ : measure α) :
+  add_subgroup (Lp F p μ) :=
+{ carrier   := {f : (Lp F p μ) | ae_strongly_measurable' m f μ} ,
+  zero_mem' := ⟨(0 : α → F), @strongly_measurable_zero _ _ m _ _, Lp.coe_fn_zero _ _ _⟩,
+  add_mem'  := λ f g hf hg, (hf.add hg).congr (Lp.coe_fn_add f g).symm,
+  neg_mem' := λ f hf, ae_strongly_measurable'.congr hf.neg (Lp.coe_fn_neg f).symm, }
+
+variables (𝕜)
+/-- `Lp_meas F 𝕜 m p μ` is the subspace of `Lp F p μ` containing functions `f` verifying
+`ae_strongly_measurable' m f μ`, i.e. functions which are `μ`-a.e. equal to
+an `m`-strongly measurable function. -/
+def Lp_meas (m : measurable_space α) [measurable_space α] (p : ℝ≥0∞)
+  (μ : measure α) :
+  submodule 𝕜 (Lp F p μ) :=
+{ carrier   := {f : (Lp F p μ) | ae_strongly_measurable' m f μ} ,
+  zero_mem' := ⟨(0 : α → F), @strongly_measurable_zero _ _ m _ _, Lp.coe_fn_zero _ _ _⟩,
+  add_mem'  := λ f g hf hg, (hf.add hg).congr (Lp.coe_fn_add f g).symm,
+  smul_mem' := λ c f hf, (hf.const_smul c).congr (Lp.coe_fn_smul c f).symm, }
+variables {F 𝕜}
+
+variables
+
+lemma mem_Lp_meas_subgroup_iff_ae_strongly_measurable' {m m0 : measurable_space α} {μ : measure α}
+  {f : Lp F p μ} :
+  f ∈ Lp_meas_subgroup F m p μ ↔ ae_strongly_measurable' m f μ :=
+by rw [← add_subgroup.mem_carrier, Lp_meas_subgroup, set.mem_set_of_eq]
+
+lemma mem_Lp_meas_iff_ae_strongly_measurable'
+  {m m0 : measurable_space α} {μ : measure α} {f : Lp F p μ} :
+  f ∈ Lp_meas F 𝕜 m p μ ↔ ae_strongly_measurable' m f μ :=
+by rw [← set_like.mem_coe, ← submodule.mem_carrier, Lp_meas, set.mem_set_of_eq]
+
+lemma Lp_meas.ae_strongly_measurable'
+  {m m0 : measurable_space α} {μ : measure α} (f : Lp_meas F 𝕜 m p μ) :
+  ae_strongly_measurable' m f μ :=
+mem_Lp_meas_iff_ae_strongly_measurable'.mp f.mem
+
+lemma mem_Lp_meas_self
+  {m0 : measurable_space α} (μ : measure α) (f : Lp F p μ) :
+  f ∈ Lp_meas F 𝕜 m0 p μ :=
+mem_Lp_meas_iff_ae_strongly_measurable'.mpr (Lp.ae_strongly_measurable f)
+
+lemma Lp_meas_subgroup_coe {m m0 : measurable_space α} {μ : measure α}
+  {f : Lp_meas_subgroup F m p μ} :
+  ⇑f = (f : Lp F p μ) :=
+coe_fn_coe_base f
+
+lemma Lp_meas_coe {m m0 : measurable_space α} {μ : measure α} {f : Lp_meas F 𝕜 m p μ} :
+  ⇑f = (f : Lp F p μ) :=
+coe_fn_coe_base f
+
+lemma mem_Lp_meas_indicator_const_Lp {m m0 : measurable_space α} (hm : m ≤ m0)
+  {μ : measure α} {s : set α} (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) {c : F} :
+  indicator_const_Lp p (hm s hs) hμs c ∈ Lp_meas F 𝕜 m p μ :=
+⟨s.indicator (λ x : α, c), (@strongly_measurable_const _ _ m _ _).indicator hs,
+  indicator_const_Lp_coe_fn⟩
+
+section complete_subspace
+
+/-! ## The subspace `Lp_meas` is complete.
+
+We define an `isometry_equiv` between `Lp_meas_subgroup` and the `Lp` space corresponding to the
+measure `μ.trim hm`. As a consequence, the completeness of `Lp` implies completeness of
+`Lp_meas_subgroup` (and `Lp_meas`). -/
+
+variables {ι : Type*} {m m0 : measurable_space α} {μ : measure α}
+
+/-- If `f` belongs to `Lp_meas_subgroup F m p μ`, then the measurable function it is almost
+everywhere equal to (given by `ae_measurable.mk`) belongs to `ℒp` for the measure `μ.trim hm`. -/
+lemma mem_ℒp_trim_of_mem_Lp_meas_subgroup (hm : m ≤ m0) (f : Lp F p μ)
+  (hf_meas : f ∈ Lp_meas_subgroup F m p μ) :
+  mem_ℒp (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp hf_meas).some p (μ.trim hm) :=
+begin
+  have hf : ae_strongly_measurable' m f μ,
+    from (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp hf_meas),
+  let g := hf.some,
+  obtain ⟨hg, hfg⟩ := hf.some_spec,
+  change mem_ℒp g p (μ.trim hm),
+  refine ⟨hg.ae_strongly_measurable, _⟩,
+  have h_snorm_fg : snorm g p (μ.trim hm) = snorm f p μ,
+    by { rw snorm_trim hm hg, exact snorm_congr_ae hfg.symm, },
+  rw h_snorm_fg,
+  exact Lp.snorm_lt_top f,
+end
+
+/-- If `f` belongs to `Lp` for the measure `μ.trim hm`, then it belongs to the subgroup
+`Lp_meas_subgroup F m p μ`. -/
+lemma mem_Lp_meas_subgroup_to_Lp_of_trim (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) :
+  (mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f)).to_Lp f ∈ Lp_meas_subgroup F m p μ :=
+begin
+  let hf_mem_ℒp := mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f),
+  rw mem_Lp_meas_subgroup_iff_ae_strongly_measurable',
+  refine ae_strongly_measurable'.congr _ (mem_ℒp.coe_fn_to_Lp hf_mem_ℒp).symm,
+  refine ae_strongly_measurable'_of_ae_strongly_measurable'_trim hm _,
+  exact Lp.ae_strongly_measurable f,
+end
+
+variables (F p μ)
+/-- Map from `Lp_meas_subgroup` to `Lp F p (μ.trim hm)`. -/
+noncomputable
+def Lp_meas_subgroup_to_Lp_trim (hm : m ≤ m0) (f : Lp_meas_subgroup F m p μ) : Lp F p (μ.trim hm) :=
+mem_ℒp.to_Lp (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp f.mem).some
+  (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm f f.mem)
+
+variables (𝕜)
+/-- Map from `Lp_meas` to `Lp F p (μ.trim hm)`. -/
+noncomputable
+def Lp_meas_to_Lp_trim (hm : m ≤ m0) (f : Lp_meas F 𝕜 m p μ) : Lp F p (μ.trim hm) :=
+mem_ℒp.to_Lp (mem_Lp_meas_iff_ae_strongly_measurable'.mp f.mem).some
+  (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm f f.mem)
+variables {𝕜}
+
+/-- Map from `Lp F p (μ.trim hm)` to `Lp_meas_subgroup`, inverse of
+`Lp_meas_subgroup_to_Lp_trim`. -/
+noncomputable
+def Lp_trim_to_Lp_meas_subgroup (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) : Lp_meas_subgroup F m p μ :=
+⟨(mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f)).to_Lp f, mem_Lp_meas_subgroup_to_Lp_of_trim hm f⟩
+
+variables (𝕜)
+/-- Map from `Lp F p (μ.trim hm)` to `Lp_meas`, inverse of `Lp_meas_to_Lp_trim`. -/
+noncomputable
+def Lp_trim_to_Lp_meas (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) : Lp_meas F 𝕜 m p μ :=
+⟨(mem_ℒp_of_mem_ℒp_trim hm (Lp.mem_ℒp f)).to_Lp f, mem_Lp_meas_subgroup_to_Lp_of_trim hm f⟩
+
+variables {F 𝕜 p μ}
+
+lemma Lp_meas_subgroup_to_Lp_trim_ae_eq (hm : m ≤ m0) (f : Lp_meas_subgroup F m p μ) :
+  Lp_meas_subgroup_to_Lp_trim F p μ hm f =ᵐ[μ] f :=
+(ae_eq_of_ae_eq_trim (mem_ℒp.coe_fn_to_Lp (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm ↑f f.mem))).trans
+  (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp f.mem).some_spec.2.symm
+
+lemma Lp_trim_to_Lp_meas_subgroup_ae_eq (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) :
+  Lp_trim_to_Lp_meas_subgroup F p μ hm f =ᵐ[μ] f :=
+mem_ℒp.coe_fn_to_Lp _
+
+lemma Lp_meas_to_Lp_trim_ae_eq (hm : m ≤ m0) (f : Lp_meas F 𝕜 m p μ) :
+  Lp_meas_to_Lp_trim F 𝕜 p μ hm f =ᵐ[μ] f :=
+(ae_eq_of_ae_eq_trim (mem_ℒp.coe_fn_to_Lp (mem_ℒp_trim_of_mem_Lp_meas_subgroup hm ↑f f.mem))).trans
+  (mem_Lp_meas_subgroup_iff_ae_strongly_measurable'.mp f.mem).some_spec.2.symm
+
+lemma Lp_trim_to_Lp_meas_ae_eq (hm : m ≤ m0) (f : Lp F p (μ.trim hm)) :
+  Lp_trim_to_Lp_meas F 𝕜 p μ hm f =ᵐ[μ] f :=
+mem_ℒp.coe_fn_to_Lp _
+
+/-- `Lp_trim_to_Lp_meas_subgroup` is a right inverse of `Lp_meas_subgroup_to_Lp_trim`. -/
+lemma Lp_meas_subgroup_to_Lp_trim_right_inv (hm : m ≤ m0) :
+  function.right_inverse (Lp_trim_to_Lp_meas_subgroup F p μ hm)
+    (Lp_meas_subgroup_to_Lp_trim F p μ hm) :=
+begin
+  intro f,
+  ext1,
+  refine ae_eq_trim_of_strongly_measurable hm
+    (Lp.strongly_measurable _) (Lp.strongly_measurable _) _,
+  exact (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _).trans (Lp_trim_to_Lp_meas_subgroup_ae_eq hm _),
+end
+
+/-- `Lp_trim_to_Lp_meas_subgroup` is a left inverse of `Lp_meas_subgroup_to_Lp_trim`. -/
+lemma Lp_meas_subgroup_to_Lp_trim_left_inv (hm : m ≤ m0) :
+  function.left_inverse (Lp_trim_to_Lp_meas_subgroup F p μ hm)
+    (Lp_meas_subgroup_to_Lp_trim F p μ hm) :=
+begin
+  intro f,
+  ext1,
+  ext1,
+  rw ← Lp_meas_subgroup_coe,
+  exact (Lp_trim_to_Lp_meas_subgroup_ae_eq hm _).trans (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _),
+end
+
+lemma Lp_meas_subgroup_to_Lp_trim_add (hm : m ≤ m0) (f g : Lp_meas_subgroup F m p μ) :
+  Lp_meas_subgroup_to_Lp_trim F p μ hm (f + g)
+    = Lp_meas_subgroup_to_Lp_trim F p μ hm f + Lp_meas_subgroup_to_Lp_trim F p μ hm g :=
+begin
+  ext1,
+  refine eventually_eq.trans _ (Lp.coe_fn_add _ _).symm,
+  refine ae_eq_trim_of_strongly_measurable hm (Lp.strongly_measurable _) _ _,
+  { exact (Lp.strongly_measurable _).add (Lp.strongly_measurable _), },
+  refine (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _).trans _,
+  refine eventually_eq.trans _
+    (eventually_eq.add (Lp_meas_subgroup_to_Lp_trim_ae_eq hm f).symm
+      (Lp_meas_subgroup_to_Lp_trim_ae_eq hm g).symm),
+  refine (Lp.coe_fn_add _ _).trans _,
+  simp_rw Lp_meas_subgroup_coe,
+  exact eventually_of_forall (λ x, by refl),
+end
+
+lemma Lp_meas_subgroup_to_Lp_trim_neg (hm : m ≤ m0) (f : Lp_meas_subgroup F m p μ) :
+  Lp_meas_subgroup_to_Lp_trim F p μ hm (-f)
+    = -Lp_meas_subgroup_to_Lp_trim F p μ hm f :=
+begin
+  ext1,
+  refine eventually_eq.trans _ (Lp.coe_fn_neg _).symm,
+  refine ae_eq_trim_of_strongly_measurable hm (Lp.strongly_measurable _) _ _,
+  { exact @strongly_measurable.neg _ _ _ m _ _ _ (Lp.strongly_measurable _), },
+  refine (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _).trans _,
+  refine eventually_eq.trans _
+    (eventually_eq.neg (Lp_meas_subgroup_to_Lp_trim_ae_eq hm f).symm),
+  refine (Lp.coe_fn_neg _).trans _,
+  simp_rw Lp_meas_subgroup_coe,
+  exact eventually_of_forall (λ x, by refl),
+end
+
+lemma Lp_meas_subgroup_to_Lp_trim_sub (hm : m ≤ m0) (f g : Lp_meas_subgroup F m p μ) :
+  Lp_meas_subgroup_to_Lp_trim F p μ hm (f - g)
+    = Lp_meas_subgroup_to_Lp_trim F p μ hm f - Lp_meas_subgroup_to_Lp_trim F p μ hm g :=
+by rw [sub_eq_add_neg, sub_eq_add_neg, Lp_meas_subgroup_to_Lp_trim_add,
+  Lp_meas_subgroup_to_Lp_trim_neg]
+
+lemma Lp_meas_to_Lp_trim_smul (hm : m ≤ m0) (c : 𝕜) (f : Lp_meas F 𝕜 m p μ) :
+  Lp_meas_to_Lp_trim F 𝕜 p μ hm (c • f) = c • Lp_meas_to_Lp_trim F 𝕜 p μ hm f :=
+begin
+  ext1,
+  refine eventually_eq.trans _ (Lp.coe_fn_smul _ _).symm,
+  refine ae_eq_trim_of_strongly_measurable hm (Lp.strongly_measurable _) _ _,
+  { exact (Lp.strongly_measurable _).const_smul c, },
+  refine (Lp_meas_to_Lp_trim_ae_eq hm _).trans _,
+  refine (Lp.coe_fn_smul _ _).trans _,
+  refine (Lp_meas_to_Lp_trim_ae_eq hm f).mono (λ x hx, _),
+  rw [pi.smul_apply, pi.smul_apply, hx],
+  refl,
+end
+
+/-- `Lp_meas_subgroup_to_Lp_trim` preserves the norm. -/
+lemma Lp_meas_subgroup_to_Lp_trim_norm_map [hp : fact (1 ≤ p)] (hm : m ≤ m0)
+  (f : Lp_meas_subgroup F m p μ) :
+  ‖Lp_meas_subgroup_to_Lp_trim F p μ hm f‖ = ‖f‖ :=
+begin
+  rw [Lp.norm_def, snorm_trim hm (Lp.strongly_measurable _),
+    snorm_congr_ae (Lp_meas_subgroup_to_Lp_trim_ae_eq hm _), Lp_meas_subgroup_coe, ← Lp.norm_def],
+  congr,
+end
+
+lemma isometry_Lp_meas_subgroup_to_Lp_trim [hp : fact (1 ≤ p)] (hm : m ≤ m0) :
+  isometry (Lp_meas_subgroup_to_Lp_trim F p μ hm) :=
+isometry.of_dist_eq $ λ f g, by rw [dist_eq_norm, ← Lp_meas_subgroup_to_Lp_trim_sub,
+  Lp_meas_subgroup_to_Lp_trim_norm_map, dist_eq_norm]
+
+variables (F p μ)
+/-- `Lp_meas_subgroup` and `Lp F p (μ.trim hm)` are isometric. -/
+noncomputable
+def Lp_meas_subgroup_to_Lp_trim_iso [hp : fact (1 ≤ p)] (hm : m ≤ m0) :
+  Lp_meas_subgroup F m p μ ≃ᵢ Lp F p (μ.trim hm) :=
+{ to_fun    := Lp_meas_subgroup_to_Lp_trim F p μ hm,
+  inv_fun   := Lp_trim_to_Lp_meas_subgroup F p μ hm,
+  left_inv  := Lp_meas_subgroup_to_Lp_trim_left_inv hm,
+  right_inv := Lp_meas_subgroup_to_Lp_trim_right_inv hm,
+  isometry_to_fun := isometry_Lp_meas_subgroup_to_Lp_trim hm, }
+
+variables (𝕜)
+/-- `Lp_meas_subgroup` and `Lp_meas` are isometric. -/
+noncomputable
+def Lp_meas_subgroup_to_Lp_meas_iso [hp : fact (1 ≤ p)] :
+  Lp_meas_subgroup F m p μ ≃ᵢ Lp_meas F 𝕜 m p μ :=
+isometry_equiv.refl (Lp_meas_subgroup F m p μ)
+
+/-- `Lp_meas` and `Lp F p (μ.trim hm)` are isometric, with a linear equivalence. -/
+noncomputable
+def Lp_meas_to_Lp_trim_lie [hp : fact (1 ≤ p)] (hm : m ≤ m0) :
+  Lp_meas F 𝕜 m p μ ≃ₗᵢ[𝕜] Lp F p (μ.trim hm) :=
+{ to_fun    := Lp_meas_to_Lp_trim F 𝕜 p μ hm,
+  inv_fun   := Lp_trim_to_Lp_meas F 𝕜 p μ hm,
+  left_inv  := Lp_meas_subgroup_to_Lp_trim_left_inv hm,
+  right_inv := Lp_meas_subgroup_to_Lp_trim_right_inv hm,
+  map_add'  := Lp_meas_subgroup_to_Lp_trim_add hm,
+  map_smul' := Lp_meas_to_Lp_trim_smul hm,
+  norm_map' := Lp_meas_subgroup_to_Lp_trim_norm_map hm, }
+variables {F 𝕜 p μ}
+
+instance [hm : fact (m ≤ m0)] [complete_space F] [hp : fact (1 ≤ p)] :
+  complete_space (Lp_meas_subgroup F m p μ) :=
+by { rw (Lp_meas_subgroup_to_Lp_trim_iso F p μ hm.elim).complete_space_iff, apply_instance, }
+
+-- For now just no-lint this; lean4's tree-based logging will make this easier to debug.
+-- One possible change might be to generalize `𝕜` from `is_R_or_C` to `normed_field`, as this
+-- result may well hold there.
+@[nolint fails_quickly]
+instance [hm : fact (m ≤ m0)] [complete_space F] [hp : fact (1 ≤ p)] :
+  complete_space (Lp_meas F 𝕜 m p μ) :=
+by { rw (Lp_meas_subgroup_to_Lp_meas_iso F 𝕜 p μ).symm.complete_space_iff, apply_instance, }
+
+lemma is_complete_ae_strongly_measurable' [hp : fact (1 ≤ p)] [complete_space F] (hm : m ≤ m0) :
+  is_complete {f : Lp F p μ | ae_strongly_measurable' m f μ} :=
+begin
+  rw ← complete_space_coe_iff_is_complete,
+  haveI : fact (m ≤ m0) := ⟨hm⟩,
+  change complete_space (Lp_meas_subgroup F m p μ),
+  apply_instance,
+end
+
+lemma is_closed_ae_strongly_measurable' [hp : fact (1 ≤ p)] [complete_space F] (hm : m ≤ m0) :
+  is_closed {f : Lp F p μ | ae_strongly_measurable' m f μ} :=
+is_complete.is_closed (is_complete_ae_strongly_measurable' hm)
+
+end complete_subspace
+
+section strongly_measurable
+
+variables {m m0 : measurable_space α} {μ : measure α}
+
+/-- We do not get `ae_fin_strongly_measurable f (μ.trim hm)`, since we don't have
+`f =ᵐ[μ.trim hm] Lp_meas_to_Lp_trim F 𝕜 p μ hm f` but only the weaker
+`f =ᵐ[μ] Lp_meas_to_Lp_trim F 𝕜 p μ hm f`. -/
+lemma Lp_meas.ae_fin_strongly_measurable' (hm : m ≤ m0) (f : Lp_meas F 𝕜 m p μ) (hp_ne_zero : p ≠ 0)
+  (hp_ne_top : p ≠ ∞) :
+  ∃ g, fin_strongly_measurable g (μ.trim hm) ∧ f =ᵐ[μ] g :=
+⟨Lp_meas_subgroup_to_Lp_trim F p μ hm f, Lp.fin_strongly_measurable _ hp_ne_zero hp_ne_top,
+  (Lp_meas_subgroup_to_Lp_trim_ae_eq hm f).symm⟩
+
+/-- When applying the inverse of `Lp_meas_to_Lp_trim_lie` (which takes a function in the Lp space of
+the sub-sigma algebra and returns its version in the larger Lp space) to an indicator of the
+sub-sigma-algebra, we obtain an indicator in the Lp space of the larger sigma-algebra. -/
+lemma Lp_meas_to_Lp_trim_lie_symm_indicator [one_le_p : fact (1 ≤ p)] [normed_space ℝ F]
+  {hm : m ≤ m0} {s : set α} {μ : measure α}
+  (hs : measurable_set[m] s) (hμs : μ.trim hm s ≠ ∞) (c : F) :
+  ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm
+      (indicator_const_Lp p hs hμs c) : Lp F p μ)
+    = indicator_const_Lp p (hm s hs) ((le_trim hm).trans_lt hμs.lt_top).ne c :=
+begin
+  ext1,
+  rw ← Lp_meas_coe,
+  change Lp_trim_to_Lp_meas F ℝ p μ hm (indicator_const_Lp p hs hμs c)
+    =ᵐ[μ] (indicator_const_Lp p _ _ c : α → F),
+  refine (Lp_trim_to_Lp_meas_ae_eq hm _).trans _,
+  exact (ae_eq_of_ae_eq_trim indicator_const_Lp_coe_fn).trans indicator_const_Lp_coe_fn.symm,
+end
+
+lemma Lp_meas_to_Lp_trim_lie_symm_to_Lp [one_le_p : fact (1 ≤ p)] [normed_space ℝ F]
+  (hm : m ≤ m0) (f : α → F) (hf : mem_ℒp f p (μ.trim hm)) :
+  ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm (hf.to_Lp f) : Lp F p μ)
+    = (mem_ℒp_of_mem_ℒp_trim hm hf).to_Lp f :=
+begin
+  ext1,
+  rw ← Lp_meas_coe,
+  refine (Lp_trim_to_Lp_meas_ae_eq hm _).trans _,
+  exact (ae_eq_of_ae_eq_trim (mem_ℒp.coe_fn_to_Lp hf)).trans (mem_ℒp.coe_fn_to_Lp _).symm,
+end
+
+end strongly_measurable
+
+end Lp_meas
+
+
+section induction
+
+variables {m m0 : measurable_space α} {μ : measure α} [fact (1 ≤ p)] [normed_space ℝ F]
+
+/-- Auxiliary lemma for `Lp.induction_strongly_measurable`. -/
+@[elab_as_eliminator]
+lemma Lp.induction_strongly_measurable_aux (hm : m ≤ m0) (hp_ne_top : p ≠ ∞) (P : Lp F p μ → Prop)
+  (h_ind : ∀ (c : F) {s : set α} (hs : measurable_set[m] s) (hμs : μ s < ∞),
+      P (Lp.simple_func.indicator_const p (hm s hs) hμs.ne c))
+  (h_add : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
+    ∀ hfm : ae_strongly_measurable' m f μ, ∀ hgm : ae_strongly_measurable' m g μ,
+    disjoint (function.support f) (function.support g) →
+    P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)))
+  (h_closed : is_closed {f : Lp_meas F ℝ m p μ | P f}) :
+  ∀ f : Lp F p μ, ae_strongly_measurable' m f μ → P f :=
+begin
+  intros f hf,
+  let f' := (⟨f, hf⟩ : Lp_meas F ℝ m p μ),
+  let g := Lp_meas_to_Lp_trim_lie F ℝ p μ hm f',
+  have hfg : f' = (Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm g,
+    by simp only [linear_isometry_equiv.symm_apply_apply],
+  change P ↑f',
+  rw hfg,
+  refine @Lp.induction α F m _ p (μ.trim hm) _ hp_ne_top
+    (λ g, P ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm g)) _ _ _ g,
+  { intros b t ht hμt,
+    rw [Lp.simple_func.coe_indicator_const,
+      Lp_meas_to_Lp_trim_lie_symm_indicator ht hμt.ne b],
+      have hμt' : μ t < ∞, from (le_trim hm).trans_lt hμt,
+    specialize h_ind b ht hμt',
+    rwa Lp.simple_func.coe_indicator_const at h_ind, },
+  { intros f g hf hg h_disj hfP hgP,
+    rw linear_isometry_equiv.map_add,
+    push_cast,
+    have h_eq : ∀ (f : α → F) (hf : mem_ℒp f p (μ.trim hm)),
+      ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm (mem_ℒp.to_Lp f hf) : Lp F p μ)
+        = (mem_ℒp_of_mem_ℒp_trim hm hf).to_Lp f,
+      from Lp_meas_to_Lp_trim_lie_symm_to_Lp hm,
+    rw h_eq f hf at hfP ⊢,
+    rw h_eq g hg at hgP ⊢,
+    exact h_add (mem_ℒp_of_mem_ℒp_trim hm hf) (mem_ℒp_of_mem_ℒp_trim hm hg)
+      (ae_strongly_measurable'_of_ae_strongly_measurable'_trim hm hf.ae_strongly_measurable)
+      (ae_strongly_measurable'_of_ae_strongly_measurable'_trim hm hg.ae_strongly_measurable)
+      h_disj hfP hgP, },
+  { change is_closed ((Lp_meas_to_Lp_trim_lie F ℝ p μ hm).symm ⁻¹' {g : Lp_meas F ℝ m p μ | P ↑g}),
+    exact is_closed.preimage (linear_isometry_equiv.continuous _) h_closed, },
+end
+
+/-- To prove something for an `Lp` function a.e. strongly measurable with respect to a
+sub-σ-algebra `m` in a normed space, it suffices to show that
+* the property holds for (multiples of) characteristic functions which are measurable w.r.t. `m`;
+* is closed under addition;
+* the set of functions in `Lp` strongly measurable w.r.t. `m` for which the property holds is
+  closed.
+-/
+@[elab_as_eliminator]
+lemma Lp.induction_strongly_measurable (hm : m ≤ m0) (hp_ne_top : p ≠ ∞) (P : Lp F p μ → Prop)
+  (h_ind : ∀ (c : F) {s : set α} (hs : measurable_set[m] s) (hμs : μ s < ∞),
+      P (Lp.simple_func.indicator_const p (hm s hs) hμs.ne c))
+  (h_add : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
+    ∀ hfm : strongly_measurable[m] f, ∀ hgm : strongly_measurable[m] g,
+    disjoint (function.support f) (function.support g) →
+    P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)))
+  (h_closed : is_closed {f : Lp_meas F ℝ m p μ | P f}) :
+  ∀ f : Lp F p μ, ae_strongly_measurable' m f μ → P f :=
+begin
+  intros f hf,
+  suffices h_add_ae : ∀ ⦃f g⦄, ∀ hf : mem_ℒp f p μ, ∀ hg : mem_ℒp g p μ,
+      ∀ hfm : ae_strongly_measurable' m f μ, ∀ hgm : ae_strongly_measurable' m g μ,
+      disjoint (function.support f) (function.support g) →
+      P (hf.to_Lp f) → P (hg.to_Lp g) → P ((hf.to_Lp f) + (hg.to_Lp g)),
+    from Lp.induction_strongly_measurable_aux hm hp_ne_top P h_ind h_add_ae h_closed f hf,
+  intros f g hf hg hfm hgm h_disj hPf hPg,
+  let s_f : set α := function.support (hfm.mk f),
+  have hs_f : measurable_set[m] s_f := hfm.strongly_measurable_mk.measurable_set_support,
+  have hs_f_eq : s_f =ᵐ[μ] function.support f := hfm.ae_eq_mk.symm.support,
+  let s_g : set α := function.support (hgm.mk g),
+  have hs_g : measurable_set[m] s_g := hgm.strongly_measurable_mk.measurable_set_support,
+  have hs_g_eq : s_g =ᵐ[μ] function.support g := hgm.ae_eq_mk.symm.support,
+  have h_inter_empty : ((s_f ∩ s_g) : set α) =ᵐ[μ] (∅ : set α),
+  { refine (hs_f_eq.inter hs_g_eq).trans _,
+    suffices : function.support f ∩ function.support g = ∅, by rw this,
+    exact set.disjoint_iff_inter_eq_empty.mp h_disj, },
+  let f' := (s_f \ s_g).indicator (hfm.mk f),
+  have hff' : f =ᵐ[μ] f',
+  { have : s_f \ s_g =ᵐ[μ] s_f,
+    { rw [← set.diff_inter_self_eq_diff, set.inter_comm],
+      refine ((ae_eq_refl s_f).diff h_inter_empty).trans _,
+      rw set.diff_empty, },
+    refine ((indicator_ae_eq_of_ae_eq_set this).trans _).symm,
+    rw set.indicator_support,
+    exact hfm.ae_eq_mk.symm, },
+  have hf'_meas : strongly_measurable[m] f',
+    from hfm.strongly_measurable_mk.indicator (hs_f.diff hs_g),
+  have hf'_Lp : mem_ℒp f' p μ := hf.ae_eq hff',
+  let g' := (s_g \ s_f).indicator (hgm.mk g),
+  have hgg' : g =ᵐ[μ] g',
+  { have : s_g \ s_f =ᵐ[μ] s_g,
+    { rw [← set.diff_inter_self_eq_diff],
+      refine ((ae_eq_refl s_g).diff h_inter_empty).trans _,
+      rw set.diff_empty, },
+    refine ((indicator_ae_eq_of_ae_eq_set this).trans _).symm,
+    rw set.indicator_support,
+    exact hgm.ae_eq_mk.symm, },
+  have hg'_meas : strongly_measurable[m] g',
+    from hgm.strongly_measurable_mk.indicator (hs_g.diff hs_f),
+  have hg'_Lp : mem_ℒp g' p μ := hg.ae_eq hgg',
+  have h_disj : disjoint (function.support f') (function.support g'),
+  { have : disjoint (s_f \ s_g) (s_g \ s_f) := disjoint_sdiff_sdiff,
+    exact this.mono set.support_indicator_subset set.support_indicator_subset, },
+  rw ← mem_ℒp.to_Lp_congr hf'_Lp hf hff'.symm at ⊢ hPf,
+  rw ← mem_ℒp.to_Lp_congr hg'_Lp hg hgg'.symm at ⊢ hPg,
+  exact h_add hf'_Lp hg'_Lp hf'_meas hg'_meas h_disj hPf hPg,
+end
+
+/-- To prove something for an arbitrary `mem_ℒp` function a.e. strongly measurable with respect
+to a sub-σ-algebra `m` in a normed space, it suffices to show that
+* the property holds for (multiples of) characteristic functions which are measurable w.r.t. `m`;
+* is closed under addition;
+* the set of functions in the `Lᵖ` space strongly measurable w.r.t. `m` for which the property
+  holds is closed.
+* the property is closed under the almost-everywhere equal relation.
+-/
+@[elab_as_eliminator]
+lemma mem_ℒp.induction_strongly_measurable (hm : m ≤ m0) (hp_ne_top : p ≠ ∞)
+  (P : (α → F) → Prop)
+  (h_ind : ∀ (c : F) ⦃s⦄, measurable_set[m] s → μ s < ∞ → P (s.indicator (λ _, c)))
+  (h_add : ∀ ⦃f g : α → F⦄, disjoint (function.support f) (function.support g)
+    → mem_ℒp f p μ → mem_ℒp g p μ → strongly_measurable[m] f → strongly_measurable[m] g →
+    P f → P g → P (f + g))
+  (h_closed : is_closed {f : Lp_meas F ℝ m p μ | P f} )
+  (h_ae : ∀ ⦃f g⦄, f =ᵐ[μ] g → mem_ℒp f p μ → P f → P g) :
+  ∀ ⦃f : α → F⦄ (hf : mem_ℒp f p μ) (hfm : ae_strongly_measurable' m f μ), P f :=
+begin
+  intros f hf hfm,
+  let f_Lp := hf.to_Lp f,
+  have hfm_Lp : ae_strongly_measurable' m f_Lp μ, from hfm.congr hf.coe_fn_to_Lp.symm,
+  refine h_ae (hf.coe_fn_to_Lp) (Lp.mem_ℒp _) _,
+  change P f_Lp,
+  refine Lp.induction_strongly_measurable hm hp_ne_top (λ f, P ⇑f) _ _ h_closed f_Lp hfm_Lp,
+  { intros c s hs hμs,
+    rw Lp.simple_func.coe_indicator_const,
+    refine h_ae (indicator_const_Lp_coe_fn).symm _ (h_ind c hs hμs),
+    exact mem_ℒp_indicator_const p (hm s hs) c (or.inr hμs.ne), },
+  { intros f g hf_mem hg_mem hfm hgm h_disj hfP hgP,
+    have hfP' : P f := h_ae (hf_mem.coe_fn_to_Lp) (Lp.mem_ℒp _) hfP,
+    have hgP' : P g := h_ae (hg_mem.coe_fn_to_Lp) (Lp.mem_ℒp _) hgP,
+    specialize h_add h_disj hf_mem hg_mem hfm hgm hfP' hgP',
+    refine h_ae _ (hf_mem.add hg_mem) h_add,
+    exact ((hf_mem.coe_fn_to_Lp).symm.add (hg_mem.coe_fn_to_Lp).symm).trans
+      (Lp.coe_fn_add _ _).symm, },
+end
+
+end induction
+
+end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/basic.lean b/src/measure_theory/function/conditional_expectation/basic.lean
new file mode 100644
index 0000000000000..dab82b38e673d
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/basic.lean
@@ -0,0 +1,447 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.function.conditional_expectation.condexp_L1
+
+/-! # Conditional expectation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We build the conditional expectation of an integrable function `f` with value in a Banach space
+with respect to a measure `μ` (defined on a measurable space structure `m0`) and a measurable space
+structure `m` with `hm : m ≤ m0` (a sub-sigma-algebra). This is an `m`-strongly measurable
+function `μ[f|hm]` which is integrable and verifies `∫ x in s, μ[f|hm] x ∂μ = ∫ x in s, f x ∂μ`
+for all `m`-measurable sets `s`. It is unique as an element of `L¹`.
+
+The construction is done in four steps:
+* Define the conditional expectation of an `L²` function, as an element of `L²`. This is the
+  orthogonal projection on the subspace of almost everywhere `m`-measurable functions.
+* Show that the conditional expectation of the indicator of a measurable set with finite measure
+  is integrable and define a map `set α → (E →L[ℝ] (α →₁[μ] E))` which to a set associates a linear
+  map. That linear map sends `x ∈ E` to the conditional expectation of the indicator of the set
+  with value `x`.
+* Extend that map to `condexp_L1_clm : (α →₁[μ] E) →L[ℝ] (α →₁[μ] E)`. This is done using the same
+  construction as the Bochner integral (see the file `measure_theory/integral/set_to_L1`).
+* Define the conditional expectation of a function `f : α → E`, which is an integrable function
+  `α → E` equal to 0 if `f` is not integrable, and equal to an `m`-measurable representative of
+  `condexp_L1_clm` applied to `[f]`, the equivalence class of `f` in `L¹`.
+
+The first step is done in `measure_theory.function.conditional_expectation.condexp_L2`, the two
+next steps in `measure_theory.function.conditional_expectation.condexp_L1` and the final step is
+performed in this file.
+
+## Main results
+
+The conditional expectation and its properties
+
+* `condexp (m : measurable_space α) (μ : measure α) (f : α → E)`: conditional expectation of `f`
+  with respect to `m`.
+* `integrable_condexp` : `condexp` is integrable.
+* `strongly_measurable_condexp` : `condexp` is `m`-strongly-measurable.
+* `set_integral_condexp (hf : integrable f μ) (hs : measurable_set[m] s)` : if `m ≤ m0` (the
+  σ-algebra over which the measure is defined), then the conditional expectation verifies
+  `∫ x in s, condexp m μ f x ∂μ = ∫ x in s, f x ∂μ` for any `m`-measurable set `s`.
+
+While `condexp` is function-valued, we also define `condexp_L1` with value in `L1` and a continuous
+linear map `condexp_L1_clm` from `L1` to `L1`. `condexp` should be used in most cases.
+
+Uniqueness of the conditional expectation
+
+* `ae_eq_condexp_of_forall_set_integral_eq`: an a.e. `m`-measurable function which verifies the
+  equality of integrals is a.e. equal to `condexp`.
+
+## Notations
+
+For a measure `μ` defined on a measurable space structure `m0`, another measurable space structure
+`m` with `hm : m ≤ m0` (a sub-σ-algebra) and a function `f`, we define the notation
+* `μ[f|m] = condexp m μ f`.
+
+## Tags
+
+conditional expectation, conditional expected value
+
+-/
+
+open topological_space measure_theory.Lp filter
+open_locale ennreal topology big_operators measure_theory
+
+namespace measure_theory
+
+variables {α F F' 𝕜 : Type*} {p : ℝ≥0∞}
+  [is_R_or_C 𝕜] -- 𝕜 for ℝ or ℂ
+  -- F for a Lp submodule
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  -- F' for integrals on a Lp submodule
+  [normed_add_comm_group F'] [normed_space 𝕜 F'] [normed_space ℝ F'] [complete_space F']
+
+open_locale classical
+
+variables {𝕜} {m m0 : measurable_space α} {μ : measure α} {f g : α → F'} {s : set α}
+
+/-- Conditional expectation of a function. It is defined as 0 if any one of the following conditions
+is true:
+- `m` is not a sub-σ-algebra of `m0`,
+- `μ` is not σ-finite with respect to `m`,
+- `f` is not integrable. -/
+@[irreducible]
+noncomputable
+def condexp (m : measurable_space α) {m0 : measurable_space α} (μ : measure α) (f : α → F') :
+  α → F' :=
+if hm : m ≤ m0
+  then if h : sigma_finite (μ.trim hm) ∧ integrable f μ
+    then if strongly_measurable[m] f
+      then f
+      else (@ae_strongly_measurable'_condexp_L1 _ _ _ _ _ m m0 μ hm h.1 _).mk
+        (@condexp_L1 _ _ _ _ _ _ _ hm μ h.1 f)
+    else 0
+  else 0
+
+-- We define notation `μ[f|m]` for the conditional expectation of `f` with respect to `m`.
+localized "notation (name := measure_theory.condexp)
+  μ `[` f `|` m `]` := measure_theory.condexp m μ f" in measure_theory
+
+lemma condexp_of_not_le (hm_not : ¬ m ≤ m0) : μ[f|m] = 0 := by rw [condexp, dif_neg hm_not]
+
+lemma condexp_of_not_sigma_finite (hm : m ≤ m0) (hμm_not : ¬ sigma_finite (μ.trim hm)) :
+  μ[f|m] = 0 :=
+by { rw [condexp, dif_pos hm, dif_neg], push_neg, exact λ h, absurd h hμm_not, }
+
+lemma condexp_of_sigma_finite (hm : m ≤ m0) [hμm : sigma_finite (μ.trim hm)] :
+  μ[f|m] =
+  if integrable f μ
+    then if strongly_measurable[m] f
+      then f else ae_strongly_measurable'_condexp_L1.mk (condexp_L1 hm μ f)
+    else 0 :=
+begin
+  rw [condexp, dif_pos hm],
+  simp only [hμm, ne.def, true_and],
+  by_cases hf : integrable f μ,
+  { rw [dif_pos hf, if_pos hf], },
+  { rw [dif_neg hf, if_neg hf], },
+end
+
+lemma condexp_of_strongly_measurable (hm : m ≤ m0) [hμm : sigma_finite (μ.trim hm)]
+  {f : α → F'} (hf : strongly_measurable[m] f) (hfi : integrable f μ) :
+  μ[f|m] = f :=
+by { rw [condexp_of_sigma_finite hm, if_pos hfi, if_pos hf], apply_instance, }
+
+lemma condexp_const (hm : m ≤ m0) (c : F') [is_finite_measure μ] : μ[(λ x : α, c)|m] = λ _, c :=
+condexp_of_strongly_measurable hm (@strongly_measurable_const _ _ m _ _) (integrable_const c)
+
+lemma condexp_ae_eq_condexp_L1 (hm : m ≤ m0) [hμm : sigma_finite (μ.trim hm)]
+  (f : α → F') : μ[f|m] =ᵐ[μ] condexp_L1 hm μ f :=
+begin
+  rw condexp_of_sigma_finite hm,
+  by_cases hfi : integrable f μ,
+  { rw if_pos hfi,
+    by_cases hfm : strongly_measurable[m] f,
+    { rw if_pos hfm,
+      exact (condexp_L1_of_ae_strongly_measurable'
+        (strongly_measurable.ae_strongly_measurable' hfm) hfi).symm, },
+    { rw if_neg hfm,
+      exact (ae_strongly_measurable'.ae_eq_mk ae_strongly_measurable'_condexp_L1).symm, }, },
+  rw [if_neg hfi, condexp_L1_undef hfi],
+  exact (coe_fn_zero _ _ _).symm,
+end
+
+lemma condexp_ae_eq_condexp_L1_clm (hm : m ≤ m0) [sigma_finite (μ.trim hm)] (hf : integrable f μ) :
+  μ[f|m] =ᵐ[μ] condexp_L1_clm hm μ (hf.to_L1 f) :=
+begin
+  refine (condexp_ae_eq_condexp_L1 hm f).trans (eventually_of_forall (λ x, _)),
+  rw condexp_L1_eq hf,
+end
+
+lemma condexp_undef (hf : ¬ integrable f μ) : μ[f|m] = 0 :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { rw condexp_of_not_le hm, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { rw condexp_of_not_sigma_finite hm hμm, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  rw [condexp_of_sigma_finite, if_neg hf],
+end
+
+@[simp] lemma condexp_zero : μ[(0 : α → F')|m] = 0 :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { rw condexp_of_not_le hm, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { rw condexp_of_not_sigma_finite hm hμm, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  exact condexp_of_strongly_measurable hm (@strongly_measurable_zero _ _ m _ _)
+    (integrable_zero _ _ _),
+end
+
+lemma strongly_measurable_condexp : strongly_measurable[m] (μ[f|m]) :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { rw condexp_of_not_le hm, exact strongly_measurable_zero, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { rw condexp_of_not_sigma_finite hm hμm, exact strongly_measurable_zero, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  rw condexp_of_sigma_finite hm,
+  swap, { apply_instance, },
+  split_ifs with hfi hfm,
+  { exact hfm, },
+  { exact ae_strongly_measurable'.strongly_measurable_mk _, },
+  { exact strongly_measurable_zero, },
+end
+
+lemma condexp_congr_ae (h : f =ᵐ[μ] g) : μ[f | m] =ᵐ[μ] μ[g | m] :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw condexp_of_not_le hm, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  exact (condexp_ae_eq_condexp_L1 hm f).trans
+    (filter.eventually_eq.trans (by rw condexp_L1_congr_ae hm h)
+    (condexp_ae_eq_condexp_L1 hm g).symm),
+end
+
+lemma condexp_of_ae_strongly_measurable' (hm : m ≤ m0) [hμm : sigma_finite (μ.trim hm)]
+  {f : α → F'} (hf : ae_strongly_measurable' m f μ) (hfi : integrable f μ) :
+  μ[f|m] =ᵐ[μ] f :=
+begin
+  refine ((condexp_congr_ae hf.ae_eq_mk).trans _).trans hf.ae_eq_mk.symm,
+  rw condexp_of_strongly_measurable hm hf.strongly_measurable_mk
+    ((integrable_congr hf.ae_eq_mk).mp hfi),
+end
+
+lemma integrable_condexp : integrable (μ[f|m]) μ :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { rw condexp_of_not_le hm, exact integrable_zero _ _ _, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { rw condexp_of_not_sigma_finite hm hμm, exact integrable_zero _ _ _, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  exact (integrable_condexp_L1 f).congr (condexp_ae_eq_condexp_L1 hm f).symm,
+end
+
+/-- The integral of the conditional expectation `μ[f|hm]` over an `m`-measurable set is equal to
+the integral of `f` on that set. -/
+lemma set_integral_condexp (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  (hf : integrable f μ) (hs : measurable_set[m] s) :
+  ∫ x in s, μ[f|m] x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  rw set_integral_congr_ae (hm s hs) ((condexp_ae_eq_condexp_L1 hm f).mono (λ x hx _, hx)),
+  exact set_integral_condexp_L1 hf hs,
+end
+
+lemma integral_condexp (hm : m ≤ m0) [hμm : sigma_finite (μ.trim hm)]
+  (hf : integrable f μ) : ∫ x, μ[f|m] x ∂μ = ∫ x, f x ∂μ :=
+begin
+  suffices : ∫ x in set.univ, μ[f|m] x ∂μ = ∫ x in set.univ, f x ∂μ,
+    by { simp_rw integral_univ at this, exact this, },
+  exact set_integral_condexp hm hf (@measurable_set.univ _ m),
+end
+
+/-- **Uniqueness of the conditional expectation**
+If a function is a.e. `m`-measurable, verifies an integrability condition and has same integral
+as `f` on all `m`-measurable sets, then it is a.e. equal to `μ[f|hm]`. -/
+lemma ae_eq_condexp_of_forall_set_integral_eq (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  {f g : α → F'} (hf : integrable f μ)
+  (hg_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on g s μ)
+  (hg_eq : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, g x ∂μ = ∫ x in s, f x ∂μ)
+  (hgm : ae_strongly_measurable' m g μ) :
+  g =ᵐ[μ] μ[f|m] :=
+begin
+  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' hm hg_int_finite
+    (λ s hs hμs, integrable_condexp.integrable_on) (λ s hs hμs, _) hgm
+    (strongly_measurable.ae_strongly_measurable' strongly_measurable_condexp),
+  rw [hg_eq s hs hμs, set_integral_condexp hm hf hs],
+end
+
+lemma condexp_bot' [hμ : μ.ae.ne_bot] (f : α → F') :
+  μ[f|⊥] = λ _, (μ set.univ).to_real⁻¹ • ∫ x, f x ∂μ :=
+begin
+  by_cases hμ_finite : is_finite_measure μ,
+  swap,
+  { have h : ¬ sigma_finite (μ.trim bot_le),
+    { rwa sigma_finite_trim_bot_iff, },
+    rw not_is_finite_measure_iff at hμ_finite,
+    rw [condexp_of_not_sigma_finite bot_le h],
+    simp only [hμ_finite, ennreal.top_to_real, inv_zero, zero_smul],
+    refl, },
+  haveI : is_finite_measure μ := hμ_finite,
+  by_cases hf : integrable f μ,
+  swap, { rw [integral_undef hf, smul_zero, condexp_undef hf], refl, },
+  have h_meas : strongly_measurable[⊥] (μ[f|⊥]) := strongly_measurable_condexp,
+  obtain ⟨c, h_eq⟩ := strongly_measurable_bot_iff.mp h_meas,
+  rw h_eq,
+  have h_integral : ∫ x, μ[f|⊥] x ∂μ = ∫ x, f x ∂μ := integral_condexp bot_le hf,
+  simp_rw [h_eq, integral_const] at h_integral,
+  rw [← h_integral, ← smul_assoc, smul_eq_mul, inv_mul_cancel, one_smul],
+  rw [ne.def, ennreal.to_real_eq_zero_iff, auto.not_or_eq, measure.measure_univ_eq_zero,
+    ← ae_eq_bot, ← ne.def, ← ne_bot_iff],
+  exact ⟨hμ, measure_ne_top μ set.univ⟩,
+end
+
+lemma condexp_bot_ae_eq (f : α → F') :
+  μ[f|⊥] =ᵐ[μ] λ _, (μ set.univ).to_real⁻¹ • ∫ x, f x ∂μ :=
+begin
+  by_cases μ.ae.ne_bot,
+  { refine eventually_of_forall (λ x, _),
+    rw condexp_bot' f,
+    exact h, },
+  { rw [ne_bot_iff, not_not, ae_eq_bot] at h,
+    simp only [h, ae_zero], },
+end
+
+lemma condexp_bot [is_probability_measure μ] (f : α → F') :
+  μ[f|⊥] = λ _, ∫ x, f x ∂μ :=
+by { refine (condexp_bot' f).trans _, rw [measure_univ, ennreal.one_to_real, inv_one, one_smul], }
+
+lemma condexp_add (hf : integrable f μ) (hg : integrable g μ) :
+  μ[f + g | m] =ᵐ[μ] μ[f|m] + μ[g|m] :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw condexp_of_not_le hm, simp, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, simp, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  refine (condexp_ae_eq_condexp_L1 hm _).trans _,
+  rw condexp_L1_add hf hg,
+  exact (coe_fn_add _ _).trans
+    ((condexp_ae_eq_condexp_L1 hm _).symm.add (condexp_ae_eq_condexp_L1 hm _).symm),
+end
+
+lemma condexp_finset_sum {ι : Type*} {s : finset ι} {f : ι → α → F'}
+  (hf : ∀ i ∈ s, integrable (f i) μ) :
+  μ[∑ i in s, f i | m] =ᵐ[μ] ∑ i in s, μ[f i | m] :=
+begin
+  induction s using finset.induction_on with i s his heq hf,
+  { rw [finset.sum_empty, finset.sum_empty, condexp_zero] },
+  { rw [finset.sum_insert his, finset.sum_insert his],
+    exact (condexp_add (hf i $ finset.mem_insert_self i s) $ integrable_finset_sum' _
+      (λ j hmem, hf j $ finset.mem_insert_of_mem hmem)).trans
+      ((eventually_eq.refl _ _).add (heq $ λ j hmem, hf j $ finset.mem_insert_of_mem hmem)) }
+end
+
+lemma condexp_smul (c : 𝕜) (f : α → F') : μ[c • f | m] =ᵐ[μ] c • μ[f|m] :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw condexp_of_not_le hm, simp, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, simp, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  refine (condexp_ae_eq_condexp_L1 hm _).trans _,
+  rw condexp_L1_smul c f,
+  refine (@condexp_ae_eq_condexp_L1 _ _ _ _ _ m _ _ hm _ f).mp _,
+  refine (coe_fn_smul c (condexp_L1 hm μ f)).mono (λ x hx1 hx2, _),
+  rw [hx1, pi.smul_apply, pi.smul_apply, hx2],
+end
+
+lemma condexp_neg (f : α → F') : μ[-f|m] =ᵐ[μ] - μ[f|m] :=
+by letI : module ℝ (α → F') := @pi.module α (λ _, F') ℝ _ _ (λ _, infer_instance);
+calc μ[-f|m] = μ[(-1 : ℝ) • f|m] : by rw neg_one_smul ℝ f
+... =ᵐ[μ] (-1 : ℝ) • μ[f|m] : condexp_smul (-1) f
+... = -μ[f|m] : neg_one_smul ℝ (μ[f|m])
+
+lemma condexp_sub (hf : integrable f μ) (hg : integrable g μ) :
+  μ[f - g | m] =ᵐ[μ] μ[f|m] - μ[g|m] :=
+begin
+  simp_rw sub_eq_add_neg,
+  exact (condexp_add hf hg.neg).trans (eventually_eq.rfl.add (condexp_neg g)),
+end
+
+lemma condexp_condexp_of_le {m₁ m₂ m0 : measurable_space α} {μ : measure α} (hm₁₂ : m₁ ≤ m₂)
+  (hm₂ : m₂ ≤ m0) [sigma_finite (μ.trim hm₂)] :
+  μ[ μ[f|m₂] | m₁] =ᵐ[μ] μ[f | m₁] :=
+begin
+  by_cases hμm₁ : sigma_finite (μ.trim (hm₁₂.trans hm₂)),
+  swap, { simp_rw condexp_of_not_sigma_finite (hm₁₂.trans hm₂) hμm₁, },
+  haveI : sigma_finite (μ.trim (hm₁₂.trans hm₂)) := hμm₁,
+  by_cases hf : integrable f μ,
+  swap, { simp_rw [condexp_undef hf, condexp_zero], },
+  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' (hm₁₂.trans hm₂)
+    (λ s hs hμs, integrable_condexp.integrable_on) (λ s hs hμs, integrable_condexp.integrable_on)
+    _ (strongly_measurable.ae_strongly_measurable' strongly_measurable_condexp)
+      (strongly_measurable.ae_strongly_measurable' strongly_measurable_condexp),
+  intros s hs hμs,
+  rw set_integral_condexp (hm₁₂.trans hm₂) integrable_condexp hs,
+  swap, { apply_instance, },
+  rw [set_integral_condexp (hm₁₂.trans hm₂) hf hs, set_integral_condexp hm₂ hf (hm₁₂ s hs)],
+end
+
+lemma condexp_mono {E} [normed_lattice_add_comm_group E] [complete_space E] [normed_space ℝ E]
+  [ordered_smul ℝ E] {f g : α → E} (hf : integrable f μ) (hg : integrable g μ) (hfg : f ≤ᵐ[μ] g) :
+  μ[f | m] ≤ᵐ[μ] μ[g | m] :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw condexp_of_not_le hm, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  exact (condexp_ae_eq_condexp_L1 hm _).trans_le
+    ((condexp_L1_mono hf hg hfg).trans_eq (condexp_ae_eq_condexp_L1 hm _).symm),
+end
+
+lemma condexp_nonneg {E} [normed_lattice_add_comm_group E] [complete_space E] [normed_space ℝ E]
+  [ordered_smul ℝ E] {f : α → E} (hf : 0 ≤ᵐ[μ] f) :
+  0 ≤ᵐ[μ] μ[f | m] :=
+begin
+  by_cases hfint : integrable f μ,
+  { rw (condexp_zero.symm : (0 : α → E) = μ[0 | m]),
+    exact condexp_mono (integrable_zero _ _ _) hfint hf },
+  { rw condexp_undef hfint, }
+end
+
+lemma condexp_nonpos {E} [normed_lattice_add_comm_group E] [complete_space E] [normed_space ℝ E]
+  [ordered_smul ℝ E] {f : α → E} (hf : f ≤ᵐ[μ] 0) :
+  μ[f | m] ≤ᵐ[μ] 0 :=
+begin
+  by_cases hfint : integrable f μ,
+  { rw (condexp_zero.symm : (0 : α → E) = μ[0 | m]),
+    exact condexp_mono hfint (integrable_zero _ _ _) hf },
+  { rw condexp_undef hfint, }
+end
+
+/-- **Lebesgue dominated convergence theorem**: sufficient conditions under which almost
+  everywhere convergence of a sequence of functions implies the convergence of their image by
+  `condexp_L1`. -/
+lemma tendsto_condexp_L1_of_dominated_convergence (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  {fs : ℕ → α → F'} {f : α → F'} (bound_fs : α → ℝ)
+  (hfs_meas : ∀ n, ae_strongly_measurable (fs n) μ) (h_int_bound_fs : integrable bound_fs μ)
+  (hfs_bound : ∀ n, ∀ᵐ x ∂μ, ‖fs n x‖ ≤ bound_fs x)
+  (hfs : ∀ᵐ x ∂μ, tendsto (λ n, fs n x) at_top (𝓝 (f x))) :
+  tendsto (λ n, condexp_L1 hm μ (fs n)) at_top (𝓝 (condexp_L1 hm μ f)) :=
+tendsto_set_to_fun_of_dominated_convergence _ bound_fs hfs_meas h_int_bound_fs hfs_bound hfs
+
+/-- If two sequences of functions have a.e. equal conditional expectations at each step, converge
+and verify dominated convergence hypotheses, then the conditional expectations of their limits are
+a.e. equal. -/
+lemma tendsto_condexp_unique (fs gs : ℕ → α → F') (f g : α → F')
+  (hfs_int : ∀ n, integrable (fs n) μ) (hgs_int : ∀ n, integrable (gs n) μ)
+  (hfs : ∀ᵐ x ∂μ, tendsto (λ n, fs n x) at_top (𝓝 (f x)))
+  (hgs : ∀ᵐ x ∂μ, tendsto (λ n, gs n x) at_top (𝓝 (g x)))
+  (bound_fs : α → ℝ) (h_int_bound_fs : integrable bound_fs μ)
+  (bound_gs : α → ℝ) (h_int_bound_gs : integrable bound_gs μ)
+  (hfs_bound : ∀ n, ∀ᵐ x ∂μ, ‖fs n x‖ ≤ bound_fs x)
+  (hgs_bound : ∀ n, ∀ᵐ x ∂μ, ‖gs n x‖ ≤ bound_gs x)
+  (hfg : ∀ n, μ[fs n | m] =ᵐ[μ] μ[gs n | m]) :
+  μ[f | m] =ᵐ[μ] μ[g | m] :=
+begin
+  by_cases hm : m ≤ m0, swap, { simp_rw condexp_of_not_le hm, },
+  by_cases hμm : sigma_finite (μ.trim hm), swap, { simp_rw condexp_of_not_sigma_finite hm hμm, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  refine (condexp_ae_eq_condexp_L1 hm f).trans ((condexp_ae_eq_condexp_L1 hm g).trans _).symm,
+  rw ← Lp.ext_iff,
+  have hn_eq : ∀ n, condexp_L1 hm μ (gs n) = condexp_L1 hm μ (fs n),
+  { intros n,
+    ext1,
+    refine (condexp_ae_eq_condexp_L1 hm (gs n)).symm.trans ((hfg n).symm.trans _),
+    exact (condexp_ae_eq_condexp_L1 hm (fs n)), },
+  have hcond_fs : tendsto (λ n, condexp_L1 hm μ (fs n)) at_top (𝓝 (condexp_L1 hm μ f)),
+    from tendsto_condexp_L1_of_dominated_convergence hm _ (λ n, (hfs_int n).1) h_int_bound_fs
+       hfs_bound hfs,
+  have hcond_gs : tendsto (λ n, condexp_L1 hm μ (gs n)) at_top (𝓝 (condexp_L1 hm μ g)),
+    from tendsto_condexp_L1_of_dominated_convergence hm _ (λ n, (hgs_int n).1) h_int_bound_gs
+       hgs_bound hgs,
+  exact tendsto_nhds_unique_of_eventually_eq hcond_gs hcond_fs (eventually_of_forall hn_eq),
+end
+
+end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/condexp_L1.lean b/src/measure_theory/function/conditional_expectation/condexp_L1.lean
new file mode 100644
index 0000000000000..1f5729691234e
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/condexp_L1.lean
@@ -0,0 +1,570 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.function.conditional_expectation.condexp_L2
+
+/-! # Conditional expectation in L1
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains two more steps of the construction of the conditional expectation, which is
+completed in `measure_theory.function.conditional_expectation.basic`. See that file for a
+description of the full process.
+
+The contitional expectation of an `L²` function is defined in
+`measure_theory.function.conditional_expectation.condexp_L2`. In this file, we perform two steps.
+* Show that the conditional expectation of the indicator of a measurable set with finite measure
+  is integrable and define a map `set α → (E →L[ℝ] (α →₁[μ] E))` which to a set associates a linear
+  map. That linear map sends `x ∈ E` to the conditional expectation of the indicator of the set
+  with value `x`.
+* Extend that map to `condexp_L1_clm : (α →₁[μ] E) →L[ℝ] (α →₁[μ] E)`. This is done using the same
+  construction as the Bochner integral (see the file `measure_theory/integral/set_to_L1`).
+
+## Main definitions
+
+* `condexp_L1`: Conditional expectation of a function as a linear map from `L1` to itself.
+
+-/
+
+noncomputable theory
+open topological_space measure_theory.Lp filter continuous_linear_map
+open_locale nnreal ennreal topology big_operators measure_theory
+
+namespace measure_theory
+
+variables {α β F F' G G' 𝕜 : Type*} {p : ℝ≥0∞}
+  [is_R_or_C 𝕜] -- 𝕜 for ℝ or ℂ
+  -- F for a Lp submodule
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  -- F' for integrals on a Lp submodule
+  [normed_add_comm_group F'] [normed_space 𝕜 F'] [normed_space ℝ F'] [complete_space F']
+  -- G for a Lp add_subgroup
+  [normed_add_comm_group G]
+  -- G' for integrals on a Lp add_subgroup
+  [normed_add_comm_group G'] [normed_space ℝ G'] [complete_space G']
+
+section condexp_ind
+
+/-! ## Conditional expectation of an indicator as a continuous linear map.
+
+The goal of this section is to build
+`condexp_ind (hm : m ≤ m0) (μ : measure α) (s : set s) : G →L[ℝ] α →₁[μ] G`, which
+takes `x : G` to the conditional expectation of the indicator of the set `s` with value `x`,
+seen as an element of `α →₁[μ] G`.
+-/
+
+variables {m m0 : measurable_space α} {μ : measure α} {s t : set α} [normed_space ℝ G]
+
+section condexp_ind_L1_fin
+
+/-- Conditional expectation of the indicator of a measurable set with finite measure,
+as a function in L1. -/
+def condexp_ind_L1_fin (hm : m ≤ m0) [sigma_finite (μ.trim hm)] (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (x : G) : α →₁[μ] G :=
+(integrable_condexp_ind_smul hm hs hμs x).to_L1 _
+
+lemma condexp_ind_L1_fin_ae_eq_condexp_ind_smul (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  condexp_ind_L1_fin hm hs hμs x =ᵐ[μ] condexp_ind_smul hm hs hμs x :=
+(integrable_condexp_ind_smul hm hs hμs x).coe_fn_to_L1
+
+variables {hm : m ≤ m0} [sigma_finite (μ.trim hm)]
+
+lemma condexp_ind_L1_fin_add (hs : measurable_set s) (hμs : μ s ≠ ∞) (x y : G) :
+  condexp_ind_L1_fin hm hs hμs (x + y)
+    = condexp_ind_L1_fin hm hs hμs x + condexp_ind_L1_fin hm hs hμs y :=
+begin
+  ext1,
+  refine (mem_ℒp.coe_fn_to_Lp _).trans _,
+  refine eventually_eq.trans _ (Lp.coe_fn_add _ _).symm,
+  refine eventually_eq.trans _
+    (eventually_eq.add (mem_ℒp.coe_fn_to_Lp _).symm (mem_ℒp.coe_fn_to_Lp _).symm),
+  rw condexp_ind_smul_add,
+  refine (Lp.coe_fn_add _ _).trans (eventually_of_forall (λ a, _)),
+  refl,
+end
+
+lemma condexp_ind_L1_fin_smul (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : ℝ) (x : G) :
+  condexp_ind_L1_fin hm hs hμs (c • x) = c • condexp_ind_L1_fin hm hs hμs x :=
+begin
+  ext1,
+  refine (mem_ℒp.coe_fn_to_Lp _).trans _,
+  refine eventually_eq.trans _ (Lp.coe_fn_smul _ _).symm,
+  rw condexp_ind_smul_smul hs hμs c x,
+  refine (Lp.coe_fn_smul _ _).trans _,
+  refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x).mono (λ y hy, _),
+  rw [pi.smul_apply, pi.smul_apply, hy],
+end
+
+lemma condexp_ind_L1_fin_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : 𝕜) (x : F) :
+  condexp_ind_L1_fin hm hs hμs (c • x) = c • condexp_ind_L1_fin hm hs hμs x :=
+begin
+  ext1,
+  refine (mem_ℒp.coe_fn_to_Lp _).trans _,
+  refine eventually_eq.trans _ (Lp.coe_fn_smul _ _).symm,
+  rw condexp_ind_smul_smul' hs hμs c x,
+  refine (Lp.coe_fn_smul _ _).trans _,
+  refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x).mono (λ y hy, _),
+  rw [pi.smul_apply, pi.smul_apply, hy],
+end
+
+lemma norm_condexp_ind_L1_fin_le (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  ‖condexp_ind_L1_fin hm hs hμs x‖ ≤ (μ s).to_real * ‖x‖ :=
+begin
+  have : 0 ≤ ∫ (a : α), ‖condexp_ind_L1_fin hm hs hμs x a‖ ∂μ,
+    from integral_nonneg (λ a, norm_nonneg _),
+  rw [L1.norm_eq_integral_norm, ← ennreal.to_real_of_real (norm_nonneg x), ← ennreal.to_real_mul,
+    ← ennreal.to_real_of_real this, ennreal.to_real_le_to_real ennreal.of_real_ne_top
+      (ennreal.mul_ne_top hμs ennreal.of_real_ne_top),
+    of_real_integral_norm_eq_lintegral_nnnorm],
+  swap, { rw [← mem_ℒp_one_iff_integrable], exact Lp.mem_ℒp _, },
+  have h_eq : ∫⁻ a, ‖condexp_ind_L1_fin hm hs hμs x a‖₊ ∂μ
+    = ∫⁻ a, ‖condexp_ind_smul hm hs hμs x a‖₊ ∂μ,
+  { refine lintegral_congr_ae _,
+    refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x).mono (λ z hz, _),
+    dsimp only,
+    rw hz, },
+  rw [h_eq, of_real_norm_eq_coe_nnnorm],
+  exact lintegral_nnnorm_condexp_ind_smul_le hm hs hμs x,
+end
+
+lemma condexp_ind_L1_fin_disjoint_union (hs : measurable_set s) (ht : measurable_set t)
+  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) (x : G) :
+  condexp_ind_L1_fin hm (hs.union ht) ((measure_union_le s t).trans_lt
+    (lt_top_iff_ne_top.mpr (ennreal.add_ne_top.mpr ⟨hμs, hμt⟩))).ne x
+  = condexp_ind_L1_fin hm hs hμs x + condexp_ind_L1_fin hm ht hμt x :=
+begin
+  ext1,
+  have hμst := ((measure_union_le s t).trans_lt
+    (lt_top_iff_ne_top.mpr (ennreal.add_ne_top.mpr ⟨hμs, hμt⟩))).ne,
+  refine (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm (hs.union ht) hμst x).trans _,
+  refine eventually_eq.trans _ (Lp.coe_fn_add _ _).symm,
+  have hs_eq := condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x,
+  have ht_eq := condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm ht hμt x,
+  refine eventually_eq.trans _ (eventually_eq.add hs_eq.symm ht_eq.symm),
+  rw condexp_ind_smul,
+  rw indicator_const_Lp_disjoint_union hs ht hμs hμt hst (1 : ℝ),
+  rw (condexp_L2 ℝ hm).map_add,
+  push_cast,
+  rw ((to_span_singleton ℝ x).comp_LpL 2 μ).map_add,
+  refine (Lp.coe_fn_add _ _).trans _,
+  refine eventually_of_forall (λ y, _),
+  refl,
+end
+
+end condexp_ind_L1_fin
+
+open_locale classical
+
+section condexp_ind_L1
+
+/-- Conditional expectation of the indicator of a set, as a function in L1. Its value for sets
+which are not both measurable and of finite measure is not used: we set it to 0. -/
+def condexp_ind_L1 {m m0 : measurable_space α} (hm : m ≤ m0) (μ : measure α) (s : set α)
+  [sigma_finite (μ.trim hm)] (x : G) :
+  α →₁[μ] G :=
+if hs : measurable_set s ∧ μ s ≠ ∞ then condexp_ind_L1_fin hm hs.1 hs.2 x else 0
+
+variables {hm : m ≤ m0} [sigma_finite (μ.trim hm)]
+
+lemma condexp_ind_L1_of_measurable_set_of_measure_ne_top (hs : measurable_set s) (hμs : μ s ≠ ∞)
+  (x : G) :
+  condexp_ind_L1 hm μ s x = condexp_ind_L1_fin hm hs hμs x :=
+by simp only [condexp_ind_L1, and.intro hs hμs, dif_pos, ne.def, not_false_iff, and_self]
+
+lemma condexp_ind_L1_of_measure_eq_top (hμs : μ s = ∞) (x : G) :
+  condexp_ind_L1 hm μ s x = 0 :=
+by simp only [condexp_ind_L1, hμs, eq_self_iff_true, not_true, ne.def, dif_neg, not_false_iff,
+  and_false]
+
+lemma condexp_ind_L1_of_not_measurable_set (hs : ¬ measurable_set s) (x : G) :
+  condexp_ind_L1 hm μ s x = 0 :=
+by simp only [condexp_ind_L1, hs, dif_neg, not_false_iff, false_and]
+
+lemma condexp_ind_L1_add (x y : G) :
+  condexp_ind_L1 hm μ s (x + y) = condexp_ind_L1 hm μ s x + condexp_ind_L1 hm μ s y :=
+begin
+  by_cases hs : measurable_set s,
+  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw zero_add, },
+  by_cases hμs : μ s = ∞,
+  { simp_rw condexp_ind_L1_of_measure_eq_top hμs, rw zero_add, },
+  { simp_rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs,
+    exact condexp_ind_L1_fin_add hs hμs x y, },
+end
+
+lemma condexp_ind_L1_smul (c : ℝ) (x : G) :
+  condexp_ind_L1 hm μ s (c • x) = c • condexp_ind_L1 hm μ s x :=
+begin
+  by_cases hs : measurable_set s,
+  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw smul_zero, },
+  by_cases hμs : μ s = ∞,
+  { simp_rw condexp_ind_L1_of_measure_eq_top hμs, rw smul_zero, },
+  { simp_rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs,
+    exact condexp_ind_L1_fin_smul hs hμs c x, },
+end
+
+lemma condexp_ind_L1_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F] (c : 𝕜) (x : F) :
+  condexp_ind_L1 hm μ s (c • x) = c • condexp_ind_L1 hm μ s x :=
+begin
+  by_cases hs : measurable_set s,
+  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw smul_zero, },
+  by_cases hμs : μ s = ∞,
+  { simp_rw condexp_ind_L1_of_measure_eq_top hμs, rw smul_zero, },
+  { simp_rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs,
+    exact condexp_ind_L1_fin_smul' hs hμs c x, },
+end
+
+lemma norm_condexp_ind_L1_le (x : G) :
+  ‖condexp_ind_L1 hm μ s x‖ ≤ (μ s).to_real * ‖x‖ :=
+begin
+  by_cases hs : measurable_set s,
+  swap, {simp_rw condexp_ind_L1_of_not_measurable_set hs, rw Lp.norm_zero,
+    exact mul_nonneg ennreal.to_real_nonneg (norm_nonneg _), },
+  by_cases hμs : μ s = ∞,
+  { rw [condexp_ind_L1_of_measure_eq_top hμs x, Lp.norm_zero],
+    exact mul_nonneg ennreal.to_real_nonneg (norm_nonneg _), },
+  { rw condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs x,
+    exact norm_condexp_ind_L1_fin_le hs hμs x, },
+end
+
+lemma continuous_condexp_ind_L1 : continuous (λ x : G, condexp_ind_L1 hm μ s x) :=
+continuous_of_linear_of_bound condexp_ind_L1_add condexp_ind_L1_smul norm_condexp_ind_L1_le
+
+lemma condexp_ind_L1_disjoint_union (hs : measurable_set s) (ht : measurable_set t)
+  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) (x : G) :
+  condexp_ind_L1 hm μ (s ∪ t) x = condexp_ind_L1 hm μ s x + condexp_ind_L1 hm μ t x :=
+begin
+  have hμst : μ (s ∪ t) ≠ ∞, from ((measure_union_le s t).trans_lt
+    (lt_top_iff_ne_top.mpr (ennreal.add_ne_top.mpr ⟨hμs, hμt⟩))).ne,
+  rw [condexp_ind_L1_of_measurable_set_of_measure_ne_top hs hμs x,
+    condexp_ind_L1_of_measurable_set_of_measure_ne_top ht hμt x,
+    condexp_ind_L1_of_measurable_set_of_measure_ne_top (hs.union ht) hμst x],
+  exact condexp_ind_L1_fin_disjoint_union hs ht hμs hμt hst x,
+end
+
+end condexp_ind_L1
+
+/-- Conditional expectation of the indicator of a set, as a linear map from `G` to L1. -/
+def condexp_ind {m m0 : measurable_space α} (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)]
+  (s : set α) : G →L[ℝ] α →₁[μ] G :=
+{ to_fun    := condexp_ind_L1 hm μ s,
+  map_add'  := condexp_ind_L1_add,
+  map_smul' := condexp_ind_L1_smul,
+  cont      := continuous_condexp_ind_L1, }
+
+lemma condexp_ind_ae_eq_condexp_ind_smul (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  condexp_ind hm μ s x =ᵐ[μ] condexp_ind_smul hm hs hμs x :=
+begin
+  refine eventually_eq.trans _ (condexp_ind_L1_fin_ae_eq_condexp_ind_smul hm hs hμs x),
+  simp [condexp_ind, condexp_ind_L1, hs, hμs],
+end
+
+variables {hm : m ≤ m0} [sigma_finite (μ.trim hm)]
+
+lemma ae_strongly_measurable'_condexp_ind (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  ae_strongly_measurable' m (condexp_ind hm μ s x) μ :=
+ae_strongly_measurable'.congr (ae_strongly_measurable'_condexp_ind_smul hm hs hμs x)
+  (condexp_ind_ae_eq_condexp_ind_smul hm hs hμs x).symm
+
+@[simp] lemma condexp_ind_empty : condexp_ind hm μ ∅ = (0 : G →L[ℝ] α →₁[μ] G) :=
+begin
+  ext1,
+  ext1,
+  refine (condexp_ind_ae_eq_condexp_ind_smul hm measurable_set.empty (by simp) x).trans _,
+  rw condexp_ind_smul_empty,
+  refine (Lp.coe_fn_zero G 2 μ).trans _,
+  refine eventually_eq.trans _ (Lp.coe_fn_zero G 1 μ).symm,
+  refl,
+end
+
+lemma condexp_ind_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F] (c : 𝕜) (x : F) :
+  condexp_ind hm μ s (c • x) = c • condexp_ind hm μ s x :=
+condexp_ind_L1_smul' c x
+
+lemma norm_condexp_ind_apply_le (x : G) : ‖condexp_ind hm μ s x‖ ≤ (μ s).to_real * ‖x‖ :=
+norm_condexp_ind_L1_le x
+
+lemma norm_condexp_ind_le : ‖(condexp_ind hm μ s : G →L[ℝ] α →₁[μ] G)‖ ≤ (μ s).to_real :=
+continuous_linear_map.op_norm_le_bound _ ennreal.to_real_nonneg norm_condexp_ind_apply_le
+
+lemma condexp_ind_disjoint_union_apply (hs : measurable_set s) (ht : measurable_set t)
+  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) (x : G) :
+  condexp_ind hm μ (s ∪ t) x = condexp_ind hm μ s x + condexp_ind hm μ t x :=
+condexp_ind_L1_disjoint_union hs ht hμs hμt hst x
+
+lemma condexp_ind_disjoint_union (hs : measurable_set s) (ht : measurable_set t) (hμs : μ s ≠ ∞)
+  (hμt : μ t ≠ ∞) (hst : s ∩ t = ∅) :
+  (condexp_ind hm μ (s ∪ t) : G →L[ℝ] α →₁[μ] G) = condexp_ind hm μ s + condexp_ind hm μ t :=
+by { ext1, push_cast, exact condexp_ind_disjoint_union_apply hs ht hμs hμt hst x, }
+
+variables (G)
+
+lemma dominated_fin_meas_additive_condexp_ind (hm : m ≤ m0) (μ : measure α)
+  [sigma_finite (μ.trim hm)] :
+  dominated_fin_meas_additive μ (condexp_ind hm μ : set α → G →L[ℝ] α →₁[μ] G) 1 :=
+⟨λ s t, condexp_ind_disjoint_union, λ s _ _, norm_condexp_ind_le.trans (one_mul _).symm.le⟩
+
+variables {G}
+
+lemma set_integral_condexp_ind (hs : measurable_set[m] s) (ht : measurable_set t) (hμs : μ s ≠ ∞)
+  (hμt : μ t ≠ ∞) (x : G') :
+  ∫ a in s, condexp_ind hm μ t x a ∂μ = (μ (t ∩ s)).to_real • x :=
+calc
+∫ a in s, condexp_ind hm μ t x a ∂μ = ∫ a in s, condexp_ind_smul hm ht hμt x a ∂μ :
+  set_integral_congr_ae (hm s hs)
+    ((condexp_ind_ae_eq_condexp_ind_smul hm ht hμt x).mono (λ x hx hxs, hx))
+... = (μ (t ∩ s)).to_real • x : set_integral_condexp_ind_smul hs ht hμs hμt x
+
+lemma condexp_ind_of_measurable (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) (c : G) :
+  condexp_ind hm μ s c = indicator_const_Lp 1 (hm s hs) hμs c :=
+begin
+  ext1,
+  refine eventually_eq.trans _ indicator_const_Lp_coe_fn.symm,
+  refine (condexp_ind_ae_eq_condexp_ind_smul hm (hm s hs) hμs c).trans _,
+  refine (condexp_ind_smul_ae_eq_smul hm (hm s hs) hμs c).trans _,
+  rw [Lp_meas_coe, condexp_L2_indicator_of_measurable hm hs hμs (1 : ℝ)],
+  refine (@indicator_const_Lp_coe_fn α _ _ 2 μ _ s (hm s hs) hμs (1 : ℝ)).mono (λ x hx, _),
+  dsimp only,
+  rw hx,
+  by_cases hx_mem : x ∈ s; simp [hx_mem],
+end
+
+lemma condexp_ind_nonneg {E} [normed_lattice_add_comm_group E] [normed_space ℝ E] [ordered_smul ℝ E]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : E) (hx : 0 ≤ x) :
+  0 ≤ condexp_ind hm μ s x :=
+begin
+  rw ← coe_fn_le,
+  refine eventually_le.trans_eq _ (condexp_ind_ae_eq_condexp_ind_smul hm hs hμs x).symm,
+  exact (coe_fn_zero E 1 μ).trans_le (condexp_ind_smul_nonneg hs hμs x hx),
+end
+
+end condexp_ind
+
+section condexp_L1
+
+variables {m m0 : measurable_space α} {μ : measure α}
+  {hm : m ≤ m0} [sigma_finite (μ.trim hm)] {f g : α → F'} {s : set α}
+
+/-- Conditional expectation of a function as a linear map from `α →₁[μ] F'` to itself. -/
+def condexp_L1_clm (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)] :
+  (α →₁[μ] F') →L[ℝ] α →₁[μ] F' :=
+L1.set_to_L1 (dominated_fin_meas_additive_condexp_ind F' hm μ)
+
+lemma condexp_L1_clm_smul (c : 𝕜) (f : α →₁[μ] F') :
+  condexp_L1_clm hm μ (c • f) = c • condexp_L1_clm hm μ f :=
+L1.set_to_L1_smul (dominated_fin_meas_additive_condexp_ind F' hm μ)
+  (λ c s x, condexp_ind_smul' c x) c f
+
+lemma condexp_L1_clm_indicator_const_Lp (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : F') :
+  (condexp_L1_clm hm μ) (indicator_const_Lp 1 hs hμs x) = condexp_ind hm μ s x :=
+L1.set_to_L1_indicator_const_Lp (dominated_fin_meas_additive_condexp_ind F' hm μ) hs hμs x
+
+lemma condexp_L1_clm_indicator_const (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : F') :
+  (condexp_L1_clm hm μ) ↑(simple_func.indicator_const 1 hs hμs x) = condexp_ind hm μ s x :=
+by { rw Lp.simple_func.coe_indicator_const, exact condexp_L1_clm_indicator_const_Lp hs hμs x, }
+
+/-- Auxiliary lemma used in the proof of `set_integral_condexp_L1_clm`. -/
+lemma set_integral_condexp_L1_clm_of_measure_ne_top (f : α →₁[μ] F') (hs : measurable_set[m] s)
+  (hμs : μ s ≠ ∞) :
+  ∫ x in s, condexp_L1_clm hm μ f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  refine Lp.induction ennreal.one_ne_top
+    (λ f : α →₁[μ] F', ∫ x in s, condexp_L1_clm hm μ f x ∂μ = ∫ x in s, f x ∂μ)
+  _ _ (is_closed_eq _ _) f,
+  { intros x t ht hμt,
+    simp_rw condexp_L1_clm_indicator_const ht hμt.ne x,
+    rw [Lp.simple_func.coe_indicator_const, set_integral_indicator_const_Lp (hm _ hs)],
+    exact set_integral_condexp_ind hs ht hμs hμt.ne x, },
+  { intros f g hf_Lp hg_Lp hfg_disj hf hg,
+    simp_rw (condexp_L1_clm hm μ).map_add,
+    rw set_integral_congr_ae (hm s hs) ((Lp.coe_fn_add (condexp_L1_clm hm μ (hf_Lp.to_Lp f))
+      (condexp_L1_clm hm μ (hg_Lp.to_Lp g))).mono (λ x hx hxs, hx)),
+    rw set_integral_congr_ae (hm s hs) ((Lp.coe_fn_add (hf_Lp.to_Lp f) (hg_Lp.to_Lp g)).mono
+      (λ x hx hxs, hx)),
+    simp_rw pi.add_apply,
+    rw [integral_add (L1.integrable_coe_fn _).integrable_on (L1.integrable_coe_fn _).integrable_on,
+      integral_add (L1.integrable_coe_fn _).integrable_on (L1.integrable_coe_fn _).integrable_on,
+      hf, hg], },
+  { exact (continuous_set_integral s).comp (condexp_L1_clm hm μ).continuous, },
+  { exact continuous_set_integral s, },
+end
+
+/-- The integral of the conditional expectation `condexp_L1_clm` over an `m`-measurable set is equal
+to the integral of `f` on that set. See also `set_integral_condexp`, the similar statement for
+`condexp`. -/
+lemma set_integral_condexp_L1_clm (f : α →₁[μ] F') (hs : measurable_set[m] s) :
+  ∫ x in s, condexp_L1_clm hm μ f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  let S := spanning_sets (μ.trim hm),
+  have hS_meas : ∀ i, measurable_set[m] (S i) := measurable_spanning_sets (μ.trim hm),
+  have hS_meas0 : ∀ i, measurable_set (S i) := λ i, hm _ (hS_meas i),
+  have hs_eq : s = ⋃ i, S i ∩ s,
+  { simp_rw set.inter_comm,
+    rw [← set.inter_Union, (Union_spanning_sets (μ.trim hm)), set.inter_univ], },
+  have hS_finite : ∀ i, μ (S i ∩ s) < ∞,
+  { refine λ i, (measure_mono (set.inter_subset_left _ _)).trans_lt _,
+    have hS_finite_trim := measure_spanning_sets_lt_top (μ.trim hm) i,
+    rwa trim_measurable_set_eq hm (hS_meas i) at hS_finite_trim, },
+  have h_mono : monotone (λ i, (S i) ∩ s),
+  { intros i j hij x,
+    simp_rw set.mem_inter_iff,
+    exact λ h, ⟨monotone_spanning_sets (μ.trim hm) hij h.1, h.2⟩, },
+  have h_eq_forall : (λ i, ∫ x in (S i) ∩ s, condexp_L1_clm hm μ f x ∂μ)
+      = λ i, ∫ x in (S i) ∩ s, f x ∂μ,
+    from funext (λ i, set_integral_condexp_L1_clm_of_measure_ne_top f
+      (@measurable_set.inter α m _ _ (hS_meas i) hs) (hS_finite i).ne),
+  have h_right : tendsto (λ i, ∫ x in (S i) ∩ s, f x ∂μ) at_top (𝓝 (∫ x in s, f x ∂μ)),
+  { have h := tendsto_set_integral_of_monotone (λ i, (hS_meas0 i).inter (hm s hs)) h_mono
+      (L1.integrable_coe_fn f).integrable_on,
+    rwa ← hs_eq at h, },
+  have h_left : tendsto (λ i, ∫ x in (S i) ∩ s, condexp_L1_clm hm μ f x ∂μ) at_top
+    (𝓝 (∫ x in s, condexp_L1_clm hm μ f x ∂μ)),
+  { have h := tendsto_set_integral_of_monotone (λ i, (hS_meas0 i).inter (hm s hs))
+      h_mono (L1.integrable_coe_fn (condexp_L1_clm hm μ f)).integrable_on,
+    rwa ← hs_eq at h, },
+  rw h_eq_forall at h_left,
+  exact tendsto_nhds_unique h_left h_right,
+end
+
+lemma ae_strongly_measurable'_condexp_L1_clm (f : α →₁[μ] F') :
+  ae_strongly_measurable' m (condexp_L1_clm hm μ f) μ :=
+begin
+  refine Lp.induction ennreal.one_ne_top
+    (λ f : α →₁[μ] F', ae_strongly_measurable' m (condexp_L1_clm hm μ f) μ)
+    _ _ _ f,
+  { intros c s hs hμs,
+    rw condexp_L1_clm_indicator_const hs hμs.ne c,
+    exact ae_strongly_measurable'_condexp_ind hs hμs.ne c, },
+  { intros f g hf hg h_disj hfm hgm,
+    rw (condexp_L1_clm hm μ).map_add,
+    refine ae_strongly_measurable'.congr _ (coe_fn_add _ _).symm,
+    exact ae_strongly_measurable'.add hfm hgm, },
+  { have : {f : Lp F' 1 μ | ae_strongly_measurable' m (condexp_L1_clm hm μ f) μ}
+        = (condexp_L1_clm hm μ) ⁻¹' {f | ae_strongly_measurable' m f μ},
+      by refl,
+    rw this,
+    refine is_closed.preimage (condexp_L1_clm hm μ).continuous _,
+    exact is_closed_ae_strongly_measurable' hm, },
+end
+
+lemma condexp_L1_clm_Lp_meas (f : Lp_meas F' ℝ m 1 μ) :
+  condexp_L1_clm hm μ (f : α →₁[μ] F') = ↑f :=
+begin
+  let g := Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm f,
+  have hfg : f = (Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm).symm g,
+    by simp only [linear_isometry_equiv.symm_apply_apply],
+  rw hfg,
+  refine @Lp.induction α F' m _ 1 (μ.trim hm) _ ennreal.coe_ne_top
+    (λ g : α →₁[μ.trim hm] F',
+      condexp_L1_clm hm μ ((Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm).symm g : α →₁[μ] F')
+        = ↑((Lp_meas_to_Lp_trim_lie F' ℝ 1 μ hm).symm g)) _ _ _ g,
+  { intros c s hs hμs,
+    rw [Lp.simple_func.coe_indicator_const, Lp_meas_to_Lp_trim_lie_symm_indicator hs hμs.ne c,
+      condexp_L1_clm_indicator_const_Lp],
+    exact condexp_ind_of_measurable hs ((le_trim hm).trans_lt hμs).ne c, },
+  { intros f g hf hg hfg_disj hf_eq hg_eq,
+    rw linear_isometry_equiv.map_add,
+    push_cast,
+    rw [map_add, hf_eq, hg_eq], },
+  { refine is_closed_eq _ _,
+    { refine (condexp_L1_clm hm μ).continuous.comp (continuous_induced_dom.comp _),
+      exact linear_isometry_equiv.continuous _, },
+    { refine continuous_induced_dom.comp _,
+      exact linear_isometry_equiv.continuous _, }, },
+end
+
+lemma condexp_L1_clm_of_ae_strongly_measurable'
+  (f : α →₁[μ] F') (hfm : ae_strongly_measurable' m f μ) :
+  condexp_L1_clm hm μ f = f :=
+condexp_L1_clm_Lp_meas (⟨f, hfm⟩ : Lp_meas F' ℝ m 1 μ)
+
+/-- Conditional expectation of a function, in L1. Its value is 0 if the function is not
+integrable. The function-valued `condexp` should be used instead in most cases. -/
+def condexp_L1 (hm : m ≤ m0) (μ : measure α) [sigma_finite (μ.trim hm)] (f : α → F') : α →₁[μ] F' :=
+set_to_fun μ (condexp_ind hm μ) (dominated_fin_meas_additive_condexp_ind F' hm μ) f
+
+lemma condexp_L1_undef (hf : ¬ integrable f μ) : condexp_L1 hm μ f = 0 :=
+set_to_fun_undef (dominated_fin_meas_additive_condexp_ind F' hm μ) hf
+
+lemma condexp_L1_eq (hf : integrable f μ) :
+  condexp_L1 hm μ f = condexp_L1_clm hm μ (hf.to_L1 f) :=
+set_to_fun_eq (dominated_fin_meas_additive_condexp_ind F' hm μ) hf
+
+@[simp] lemma condexp_L1_zero : condexp_L1 hm μ (0 : α → F') = 0 :=
+set_to_fun_zero _
+
+@[simp] lemma condexp_L1_measure_zero (hm : m ≤ m0) : condexp_L1 hm (0 : measure α) f = 0 :=
+set_to_fun_measure_zero _ rfl
+
+lemma ae_strongly_measurable'_condexp_L1 {f : α → F'} :
+  ae_strongly_measurable' m (condexp_L1 hm μ f) μ :=
+begin
+  by_cases hf : integrable f μ,
+  { rw condexp_L1_eq hf,
+    exact ae_strongly_measurable'_condexp_L1_clm _, },
+  { rw condexp_L1_undef hf,
+    refine ae_strongly_measurable'.congr _ (coe_fn_zero _ _ _).symm,
+    exact strongly_measurable.ae_strongly_measurable' (@strongly_measurable_zero _ _ m _ _), },
+end
+
+lemma condexp_L1_congr_ae (hm : m ≤ m0) [sigma_finite (μ.trim hm)] (h : f =ᵐ[μ] g) :
+  condexp_L1 hm μ f = condexp_L1 hm μ g :=
+set_to_fun_congr_ae _ h
+
+lemma integrable_condexp_L1 (f : α → F') : integrable (condexp_L1 hm μ f) μ :=
+L1.integrable_coe_fn _
+
+/-- The integral of the conditional expectation `condexp_L1` over an `m`-measurable set is equal to
+the integral of `f` on that set. See also `set_integral_condexp`, the similar statement for
+`condexp`. -/
+lemma set_integral_condexp_L1 (hf : integrable f μ) (hs : measurable_set[m] s) :
+  ∫ x in s, condexp_L1 hm μ f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  simp_rw condexp_L1_eq hf,
+  rw set_integral_condexp_L1_clm (hf.to_L1 f) hs,
+  exact set_integral_congr_ae (hm s hs) ((hf.coe_fn_to_L1).mono (λ x hx hxs, hx)),
+end
+
+lemma condexp_L1_add (hf : integrable f μ) (hg : integrable g μ) :
+  condexp_L1 hm μ (f + g) = condexp_L1 hm μ f + condexp_L1 hm μ g :=
+set_to_fun_add _ hf hg
+
+lemma condexp_L1_neg (f : α → F') : condexp_L1 hm μ (-f) = - condexp_L1 hm μ f :=
+set_to_fun_neg _ f
+
+lemma condexp_L1_smul (c : 𝕜) (f : α → F') : condexp_L1 hm μ (c • f) = c • condexp_L1 hm μ f :=
+set_to_fun_smul _ (λ c _ x, condexp_ind_smul' c x) c f
+
+lemma condexp_L1_sub (hf : integrable f μ) (hg : integrable g μ) :
+  condexp_L1 hm μ (f - g) = condexp_L1 hm μ f - condexp_L1 hm μ g :=
+set_to_fun_sub _ hf hg
+
+lemma condexp_L1_of_ae_strongly_measurable'
+  (hfm : ae_strongly_measurable' m f μ) (hfi : integrable f μ) :
+  condexp_L1 hm μ f =ᵐ[μ] f :=
+begin
+  rw condexp_L1_eq hfi,
+  refine eventually_eq.trans _ (integrable.coe_fn_to_L1 hfi),
+  rw condexp_L1_clm_of_ae_strongly_measurable',
+  exact ae_strongly_measurable'.congr hfm (integrable.coe_fn_to_L1 hfi).symm,
+end
+
+lemma condexp_L1_mono {E} [normed_lattice_add_comm_group E] [complete_space E] [normed_space ℝ E]
+  [ordered_smul ℝ E] {f g : α → E}
+  (hf : integrable f μ) (hg : integrable g μ) (hfg : f ≤ᵐ[μ] g) :
+  condexp_L1 hm μ f ≤ᵐ[μ] condexp_L1 hm μ g :=
+begin
+  rw coe_fn_le,
+  have h_nonneg : ∀ s, measurable_set s → μ s < ∞ → ∀ x : E, 0 ≤ x → 0 ≤ condexp_ind hm μ s x,
+    from λ s hs hμs x hx, condexp_ind_nonneg hs hμs.ne x hx,
+  exact set_to_fun_mono (dominated_fin_meas_additive_condexp_ind E hm μ) h_nonneg hf hg hfg,
+end
+
+end condexp_L1
+
+end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/condexp_L2.lean b/src/measure_theory/function/conditional_expectation/condexp_L2.lean
new file mode 100644
index 0000000000000..b099139680fd1
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/condexp_L2.lean
@@ -0,0 +1,521 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import analysis.inner_product_space.projection
+import measure_theory.function.conditional_expectation.unique
+
+/-! # Conditional expectation in L2
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains one step of the construction of the conditional expectation, which is completed
+in `measure_theory.function.conditional_expectation.basic`. See that file for a description of the
+full process.
+
+We build the conditional expectation of an `L²` function, as an element of `L²`. This is the
+orthogonal projection on the subspace of almost everywhere `m`-measurable functions.
+
+## Main definitions
+
+* `condexp_L2`: Conditional expectation of a function in L2 with respect to a sigma-algebra: it is
+the orthogonal projection on the subspace `Lp_meas`.
+
+## Implementation notes
+
+Most of the results in this file are valid for a complete real normed space `F`.
+However, some lemmas also use `𝕜 : is_R_or_C`:
+* `condexp_L2` is defined only for an `inner_product_space` for now, and we use `𝕜` for its field.
+* results about scalar multiplication are stated not only for `ℝ` but also for `𝕜` if we happen to
+  have `normed_space 𝕜 F`.
+
+-/
+
+open topological_space filter continuous_linear_map
+open_locale ennreal topology measure_theory
+
+namespace measure_theory
+
+variables {α E E' F G G' 𝕜 : Type*} {p : ℝ≥0∞}
+  [is_R_or_C 𝕜] -- 𝕜 for ℝ or ℂ
+  -- E for an inner product space
+  [normed_add_comm_group E] [inner_product_space 𝕜 E] [complete_space E]
+  -- E' for an inner product space on which we compute integrals
+  [normed_add_comm_group E'] [inner_product_space 𝕜 E']
+  [complete_space E'] [normed_space ℝ E']
+  -- F for a Lp submodule
+  [normed_add_comm_group F] [normed_space 𝕜 F]
+  -- G for a Lp add_subgroup
+  [normed_add_comm_group G]
+  -- G' for integrals on a Lp add_subgroup
+  [normed_add_comm_group G'] [normed_space ℝ G'] [complete_space G']
+
+variables {m m0 : measurable_space α} {μ : measure α} {s t : set α}
+
+local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
+local notation `⟪`x`, `y`⟫₂` := @inner 𝕜 (α →₂[μ] E) _ x y
+
+variables (𝕜)
+/-- Conditional expectation of a function in L2 with respect to a sigma-algebra -/
+noncomputable
+def condexp_L2 (hm : m ≤ m0) : (α →₂[μ] E) →L[𝕜] (Lp_meas E 𝕜 m 2 μ) :=
+@orthogonal_projection 𝕜 (α →₂[μ] E) _ _ _ (Lp_meas E 𝕜 m 2 μ)
+  (by { haveI : fact (m ≤ m0) := ⟨hm⟩, exact infer_instance, })
+variables {𝕜}
+
+lemma ae_strongly_measurable'_condexp_L2 (hm : m ≤ m0) (f : α →₂[μ] E) :
+  ae_strongly_measurable' m (condexp_L2 𝕜 hm f) μ :=
+Lp_meas.ae_strongly_measurable' _
+
+lemma integrable_on_condexp_L2_of_measure_ne_top (hm : m ≤ m0) (hμs : μ s ≠ ∞) (f : α →₂[μ] E) :
+  integrable_on (condexp_L2 𝕜 hm f) s μ :=
+integrable_on_Lp_of_measure_ne_top ((condexp_L2 𝕜 hm f) : α →₂[μ] E)
+  fact_one_le_two_ennreal.elim hμs
+
+lemma integrable_condexp_L2_of_is_finite_measure (hm : m ≤ m0) [is_finite_measure μ]
+  {f : α →₂[μ] E} :
+  integrable (condexp_L2 𝕜 hm f) μ :=
+integrable_on_univ.mp $ integrable_on_condexp_L2_of_measure_ne_top hm (measure_ne_top _ _) f
+
+lemma norm_condexp_L2_le_one (hm : m ≤ m0) : ‖@condexp_L2 α E 𝕜 _ _ _ _ _ _ μ hm‖ ≤ 1 :=
+by { haveI : fact (m ≤ m0) := ⟨hm⟩, exact orthogonal_projection_norm_le _, }
+
+lemma norm_condexp_L2_le (hm : m ≤ m0) (f : α →₂[μ] E) : ‖condexp_L2 𝕜 hm f‖ ≤ ‖f‖ :=
+((@condexp_L2 _ E 𝕜 _ _ _ _ _ _ μ hm).le_op_norm f).trans
+  (mul_le_of_le_one_left (norm_nonneg _) (norm_condexp_L2_le_one hm))
+
+lemma snorm_condexp_L2_le (hm : m ≤ m0) (f : α →₂[μ] E) :
+  snorm (condexp_L2 𝕜 hm f) 2 μ ≤ snorm f 2 μ :=
+begin
+  rw [Lp_meas_coe, ← ennreal.to_real_le_to_real (Lp.snorm_ne_top _) (Lp.snorm_ne_top _),
+    ← Lp.norm_def, ← Lp.norm_def, submodule.norm_coe],
+  exact norm_condexp_L2_le hm f,
+end
+
+lemma norm_condexp_L2_coe_le (hm : m ≤ m0) (f : α →₂[μ] E) :
+  ‖(condexp_L2 𝕜 hm f : α →₂[μ] E)‖ ≤ ‖f‖ :=
+begin
+  rw [Lp.norm_def, Lp.norm_def, ← Lp_meas_coe],
+  refine (ennreal.to_real_le_to_real _ (Lp.snorm_ne_top _)).mpr (snorm_condexp_L2_le hm f),
+  exact Lp.snorm_ne_top _,
+end
+
+lemma inner_condexp_L2_left_eq_right (hm : m ≤ m0) {f g : α →₂[μ] E} :
+  ⟪(condexp_L2 𝕜 hm f : α →₂[μ] E), g⟫₂ = ⟪f, (condexp_L2 𝕜 hm g : α →₂[μ] E)⟫₂ :=
+by { haveI : fact (m ≤ m0) := ⟨hm⟩, exact inner_orthogonal_projection_left_eq_right _ f g, }
+
+lemma condexp_L2_indicator_of_measurable (hm : m ≤ m0)
+  (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) (c : E) :
+  (condexp_L2 𝕜 hm (indicator_const_Lp 2 (hm s hs) hμs c) : α →₂[μ] E)
+    = indicator_const_Lp 2 (hm s hs) hμs c :=
+begin
+  rw condexp_L2,
+  haveI : fact (m ≤ m0) := ⟨hm⟩,
+  have h_mem : indicator_const_Lp 2 (hm s hs) hμs c ∈ Lp_meas E 𝕜 m 2 μ,
+    from mem_Lp_meas_indicator_const_Lp hm hs hμs,
+  let ind := (⟨indicator_const_Lp 2 (hm s hs) hμs c, h_mem⟩ : Lp_meas E 𝕜 m 2 μ),
+  have h_coe_ind : (ind : α →₂[μ] E) = indicator_const_Lp 2 (hm s hs) hμs c, by refl,
+  have h_orth_mem := orthogonal_projection_mem_subspace_eq_self ind,
+  rw [← h_coe_ind, h_orth_mem],
+end
+
+lemma inner_condexp_L2_eq_inner_fun (hm : m ≤ m0) (f g : α →₂[μ] E)
+  (hg : ae_strongly_measurable' m g μ) :
+  ⟪(condexp_L2 𝕜 hm f : α →₂[μ] E), g⟫₂ = ⟪f, g⟫₂ :=
+begin
+  symmetry,
+  rw [← sub_eq_zero, ← inner_sub_left, condexp_L2],
+  simp only [mem_Lp_meas_iff_ae_strongly_measurable'.mpr hg, orthogonal_projection_inner_eq_zero],
+end
+
+section real
+
+variables {hm : m ≤ m0}
+
+lemma integral_condexp_L2_eq_of_fin_meas_real (f : Lp 𝕜 2 μ) (hs : measurable_set[m] s)
+  (hμs : μ s ≠ ∞) :
+  ∫ x in s, condexp_L2 𝕜 hm f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  rw ← L2.inner_indicator_const_Lp_one (hm s hs) hμs,
+  have h_eq_inner : ∫ x in s, condexp_L2 𝕜 hm f x ∂μ
+    = inner (indicator_const_Lp 2 (hm s hs) hμs (1 : 𝕜)) (condexp_L2 𝕜 hm f),
+  { rw L2.inner_indicator_const_Lp_one (hm s hs) hμs,
+    congr, },
+  rw [h_eq_inner, ← inner_condexp_L2_left_eq_right, condexp_L2_indicator_of_measurable hm hs hμs],
+end
+
+lemma lintegral_nnnorm_condexp_L2_le (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) (f : Lp ℝ 2 μ) :
+  ∫⁻ x in s, ‖condexp_L2 ℝ hm f x‖₊ ∂μ ≤ ∫⁻ x in s, ‖f x‖₊ ∂μ :=
+begin
+  let h_meas := Lp_meas.ae_strongly_measurable' (condexp_L2 ℝ hm f),
+  let g := h_meas.some,
+  have hg_meas : strongly_measurable[m] g, from h_meas.some_spec.1,
+  have hg_eq : g =ᵐ[μ] condexp_L2 ℝ hm f, from h_meas.some_spec.2.symm,
+  have hg_eq_restrict : g =ᵐ[μ.restrict s] condexp_L2 ℝ hm f, from ae_restrict_of_ae hg_eq,
+  have hg_nnnorm_eq : (λ x, (‖g x‖₊ : ℝ≥0∞))
+    =ᵐ[μ.restrict s] (λ x, (‖condexp_L2 ℝ hm f x‖₊ : ℝ≥0∞)),
+  { refine hg_eq_restrict.mono (λ x hx, _),
+    dsimp only,
+    rw hx, },
+  rw lintegral_congr_ae hg_nnnorm_eq.symm,
+  refine lintegral_nnnorm_le_of_forall_fin_meas_integral_eq hm
+    (Lp.strongly_measurable f) _ _ _ _ hs hμs,
+  { exact integrable_on_Lp_of_measure_ne_top f fact_one_le_two_ennreal.elim hμs, },
+  { exact hg_meas, },
+  { rw [integrable_on, integrable_congr hg_eq_restrict],
+    exact integrable_on_condexp_L2_of_measure_ne_top hm hμs f, },
+  { intros t ht hμt,
+    rw ← integral_condexp_L2_eq_of_fin_meas_real f ht hμt.ne,
+    exact set_integral_congr_ae (hm t ht) (hg_eq.mono (λ x hx _, hx)), },
+end
+
+lemma condexp_L2_ae_eq_zero_of_ae_eq_zero (hs : measurable_set[m] s) (hμs : μ s ≠ ∞)
+  {f : Lp ℝ 2 μ} (hf : f =ᵐ[μ.restrict s] 0) :
+  condexp_L2 ℝ hm f =ᵐ[μ.restrict s] 0 :=
+begin
+  suffices h_nnnorm_eq_zero : ∫⁻ x in s, ‖condexp_L2 ℝ hm f x‖₊ ∂μ = 0,
+  { rw lintegral_eq_zero_iff at h_nnnorm_eq_zero,
+    refine h_nnnorm_eq_zero.mono (λ x hx, _),
+    dsimp only at hx,
+    rw pi.zero_apply at hx ⊢,
+    { rwa [ennreal.coe_eq_zero, nnnorm_eq_zero] at hx, },
+    { refine measurable.coe_nnreal_ennreal (measurable.nnnorm _),
+      rw Lp_meas_coe,
+      exact (Lp.strongly_measurable _).measurable }, },
+  refine le_antisymm _ (zero_le _),
+  refine (lintegral_nnnorm_condexp_L2_le hs hμs f).trans (le_of_eq _),
+  rw lintegral_eq_zero_iff,
+  { refine hf.mono (λ x hx, _),
+    dsimp only,
+    rw hx,
+    simp, },
+  { exact (Lp.strongly_measurable _).ennnorm, },
+end
+
+lemma lintegral_nnnorm_condexp_L2_indicator_le_real
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (ht : measurable_set[m] t) (hμt : μ t ≠ ∞) :
+  ∫⁻ a in t, ‖condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a‖₊ ∂μ ≤ μ (s ∩ t) :=
+begin
+  refine (lintegral_nnnorm_condexp_L2_le ht hμt _).trans (le_of_eq _),
+  have h_eq : ∫⁻ x in t, ‖(indicator_const_Lp 2 hs hμs (1 : ℝ)) x‖₊ ∂μ
+    = ∫⁻ x in t, s.indicator (λ x, (1 : ℝ≥0∞)) x ∂μ,
+  { refine lintegral_congr_ae (ae_restrict_of_ae _),
+    refine (@indicator_const_Lp_coe_fn _ _ _ 2 _ _ _ hs hμs (1 : ℝ)).mono (λ x hx, _),
+    rw hx,
+    classical,
+    simp_rw set.indicator_apply,
+    split_ifs; simp, },
+  rw [h_eq, lintegral_indicator _ hs, lintegral_const, measure.restrict_restrict hs],
+  simp only [one_mul, set.univ_inter, measurable_set.univ, measure.restrict_apply],
+end
+
+end real
+
+/-- `condexp_L2` commutes with taking inner products with constants. See the lemma
+`condexp_L2_comp_continuous_linear_map` for a more general result about commuting with continuous
+linear maps. -/
+lemma condexp_L2_const_inner (hm : m ≤ m0) (f : Lp E 2 μ) (c : E) :
+  condexp_L2 𝕜 hm (((Lp.mem_ℒp f).const_inner c).to_Lp (λ a, ⟪c, f a⟫))
+    =ᵐ[μ] λ a, ⟪c, condexp_L2 𝕜 hm f a⟫ :=
+begin
+  rw Lp_meas_coe,
+  have h_mem_Lp : mem_ℒp (λ a, ⟪c, condexp_L2 𝕜 hm f a⟫) 2 μ,
+  { refine mem_ℒp.const_inner _ _, rw Lp_meas_coe, exact Lp.mem_ℒp _, },
+  have h_eq : h_mem_Lp.to_Lp _ =ᵐ[μ] λ a, ⟪c, condexp_L2 𝕜 hm f a⟫, from h_mem_Lp.coe_fn_to_Lp,
+  refine eventually_eq.trans _ h_eq,
+  refine Lp.ae_eq_of_forall_set_integral_eq' 𝕜 hm _ _ two_ne_zero ennreal.coe_ne_top
+    (λ s hs hμs, integrable_on_condexp_L2_of_measure_ne_top hm hμs.ne _) _ _ _ _,
+  { intros s hs hμs,
+    rw [integrable_on, integrable_congr (ae_restrict_of_ae h_eq)],
+    exact (integrable_on_condexp_L2_of_measure_ne_top hm hμs.ne _).const_inner _, },
+  { intros s hs hμs,
+    rw [← Lp_meas_coe, integral_condexp_L2_eq_of_fin_meas_real _ hs hμs.ne,
+      integral_congr_ae (ae_restrict_of_ae h_eq), Lp_meas_coe,
+      ← L2.inner_indicator_const_Lp_eq_set_integral_inner 𝕜 ↑(condexp_L2 𝕜 hm f) (hm s hs) c hμs.ne,
+      ← inner_condexp_L2_left_eq_right, condexp_L2_indicator_of_measurable,
+      L2.inner_indicator_const_Lp_eq_set_integral_inner 𝕜 f (hm s hs) c hμs.ne,
+      set_integral_congr_ae (hm s hs)
+        ((mem_ℒp.coe_fn_to_Lp ((Lp.mem_ℒp f).const_inner c)).mono (λ x hx hxs, hx))], },
+  { rw ← Lp_meas_coe, exact Lp_meas.ae_strongly_measurable' _, },
+  { refine ae_strongly_measurable'.congr _ h_eq.symm,
+    exact (Lp_meas.ae_strongly_measurable' _).const_inner _, },
+end
+
+/-- `condexp_L2` verifies the equality of integrals defining the conditional expectation. -/
+lemma integral_condexp_L2_eq (hm : m ≤ m0)
+  (f : Lp E' 2 μ) (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) :
+  ∫ x in s, condexp_L2 𝕜 hm f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  rw [← sub_eq_zero, Lp_meas_coe, ← integral_sub'
+      (integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs)
+      (integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs)],
+  refine integral_eq_zero_of_forall_integral_inner_eq_zero 𝕜 _ _ _,
+  { rw integrable_congr (ae_restrict_of_ae (Lp.coe_fn_sub ↑(condexp_L2 𝕜 hm f) f).symm),
+    exact integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs, },
+  intro c,
+  simp_rw [pi.sub_apply, inner_sub_right],
+  rw integral_sub
+    ((integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs).const_inner c)
+    ((integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs).const_inner c),
+  have h_ae_eq_f := mem_ℒp.coe_fn_to_Lp ((Lp.mem_ℒp f).const_inner c),
+  rw [← Lp_meas_coe, sub_eq_zero,
+    ← set_integral_congr_ae (hm s hs) ((condexp_L2_const_inner hm f c).mono (λ x hx _, hx)),
+    ← set_integral_congr_ae (hm s hs) (h_ae_eq_f.mono (λ x hx _, hx))],
+  exact integral_condexp_L2_eq_of_fin_meas_real _ hs hμs,
+end
+
+variables {E'' 𝕜' : Type*} [is_R_or_C 𝕜'] [normed_add_comm_group E'']
+  [inner_product_space 𝕜' E''] [complete_space E''] [normed_space ℝ E'']
+
+variables (𝕜 𝕜')
+lemma condexp_L2_comp_continuous_linear_map (hm : m ≤ m0) (T : E' →L[ℝ] E'') (f : α →₂[μ] E') :
+  (condexp_L2 𝕜' hm (T.comp_Lp f) : α →₂[μ] E'') =ᵐ[μ] T.comp_Lp (condexp_L2 𝕜 hm f : α →₂[μ] E') :=
+begin
+  refine Lp.ae_eq_of_forall_set_integral_eq' 𝕜' hm _ _ two_ne_zero ennreal.coe_ne_top
+    (λ s hs hμs, integrable_on_condexp_L2_of_measure_ne_top hm hμs.ne _)
+    (λ s hs hμs, integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs.ne)
+    _ _ _,
+  { intros s hs hμs,
+    rw [T.set_integral_comp_Lp _ (hm s hs),
+      T.integral_comp_comm
+        (integrable_on_Lp_of_measure_ne_top _ fact_one_le_two_ennreal.elim hμs.ne),
+      ← Lp_meas_coe, ← Lp_meas_coe, integral_condexp_L2_eq hm f hs hμs.ne,
+      integral_condexp_L2_eq hm (T.comp_Lp f) hs hμs.ne, T.set_integral_comp_Lp _ (hm s hs),
+      T.integral_comp_comm
+        (integrable_on_Lp_of_measure_ne_top f fact_one_le_two_ennreal.elim hμs.ne)], },
+  { rw ← Lp_meas_coe, exact Lp_meas.ae_strongly_measurable' _, },
+  { have h_coe := T.coe_fn_comp_Lp (condexp_L2 𝕜 hm f : α →₂[μ] E'),
+    rw ← eventually_eq at h_coe,
+    refine ae_strongly_measurable'.congr _ h_coe.symm,
+    exact (Lp_meas.ae_strongly_measurable' (condexp_L2 𝕜 hm f)).continuous_comp T.continuous, },
+end
+variables {𝕜 𝕜'}
+
+section condexp_L2_indicator
+
+variables (𝕜)
+lemma condexp_L2_indicator_ae_eq_smul (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞)
+  (x : E') :
+  condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x)
+    =ᵐ[μ] λ a, (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a) • x :=
+begin
+  rw indicator_const_Lp_eq_to_span_singleton_comp_Lp hs hμs x,
+  have h_comp := condexp_L2_comp_continuous_linear_map ℝ 𝕜 hm (to_span_singleton ℝ x)
+    (indicator_const_Lp 2 hs hμs (1 : ℝ)),
+  rw ← Lp_meas_coe at h_comp,
+  refine h_comp.trans _,
+  exact (to_span_singleton ℝ x).coe_fn_comp_Lp _,
+end
+
+lemma condexp_L2_indicator_eq_to_span_singleton_comp (hm : m ≤ m0) (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (x : E') :
+  (condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) : α →₂[μ] E')
+    = (to_span_singleton ℝ x).comp_Lp (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ))) :=
+begin
+  ext1,
+  rw ← Lp_meas_coe,
+  refine (condexp_L2_indicator_ae_eq_smul 𝕜 hm hs hμs x).trans _,
+  have h_comp := (to_span_singleton ℝ x).coe_fn_comp_Lp
+    (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) : α →₂[μ] ℝ),
+  rw ← eventually_eq at h_comp,
+  refine eventually_eq.trans _ h_comp.symm,
+  refine eventually_of_forall (λ y, _),
+  refl,
+end
+
+variables {𝕜}
+
+lemma set_lintegral_nnnorm_condexp_L2_indicator_le (hm : m ≤ m0) (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (x : E') {t : set α} (ht : measurable_set[m] t) (hμt : μ t ≠ ∞) :
+  ∫⁻ a in t, ‖condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) a‖₊ ∂μ ≤ μ (s ∩ t) * ‖x‖₊ :=
+calc ∫⁻ a in t, ‖condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) a‖₊ ∂μ
+    = ∫⁻ a in t, ‖(condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a) • x‖₊ ∂μ :
+set_lintegral_congr_fun (hm t ht)
+  ((condexp_L2_indicator_ae_eq_smul 𝕜 hm hs hμs x).mono (λ a ha hat, by rw ha))
+... = ∫⁻ a in t, ‖condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a‖₊ ∂μ * ‖x‖₊ :
+begin
+  simp_rw [nnnorm_smul, ennreal.coe_mul],
+  rw [lintegral_mul_const, Lp_meas_coe],
+  exact (Lp.strongly_measurable _).ennnorm
+end
+... ≤ μ (s ∩ t) * ‖x‖₊ :
+  mul_le_mul_right' (lintegral_nnnorm_condexp_L2_indicator_le_real hs hμs ht hμt) _
+
+lemma lintegral_nnnorm_condexp_L2_indicator_le (hm : m ≤ m0) (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (x : E') [sigma_finite (μ.trim hm)] :
+  ∫⁻ a, ‖condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x) a‖₊ ∂μ ≤ μ s * ‖x‖₊ :=
+begin
+  refine lintegral_le_of_forall_fin_meas_le' hm (μ s * ‖x‖₊) _ (λ t ht hμt, _),
+  { rw Lp_meas_coe,
+    exact (Lp.ae_strongly_measurable _).ennnorm },
+  refine (set_lintegral_nnnorm_condexp_L2_indicator_le hm hs hμs x ht hμt).trans _,
+  exact mul_le_mul_right' (measure_mono (set.inter_subset_left _ _)) _
+end
+
+/-- If the measure `μ.trim hm` is sigma-finite, then the conditional expectation of a measurable set
+with finite measure is integrable. -/
+lemma integrable_condexp_L2_indicator (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : E') :
+  integrable (condexp_L2 𝕜 hm (indicator_const_Lp 2 hs hμs x)) μ :=
+begin
+  refine integrable_of_forall_fin_meas_le' hm (μ s * ‖x‖₊)
+    (ennreal.mul_lt_top hμs ennreal.coe_ne_top) _ _,
+  { rw Lp_meas_coe, exact Lp.ae_strongly_measurable _, },
+  { refine λ t ht hμt, (set_lintegral_nnnorm_condexp_L2_indicator_le hm hs hμs x ht hμt).trans _,
+    exact mul_le_mul_right' (measure_mono (set.inter_subset_left _ _)) _, },
+end
+
+end condexp_L2_indicator
+
+section condexp_ind_smul
+
+variables [normed_space ℝ G] {hm : m ≤ m0}
+
+/-- Conditional expectation of the indicator of a measurable set with finite measure, in L2. -/
+noncomputable
+def condexp_ind_smul (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) : Lp G 2 μ :=
+(to_span_singleton ℝ x).comp_LpL 2 μ (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)))
+
+lemma ae_strongly_measurable'_condexp_ind_smul
+  (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  ae_strongly_measurable' m (condexp_ind_smul hm hs hμs x) μ :=
+begin
+  have h : ae_strongly_measurable' m (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ))) μ,
+    from ae_strongly_measurable'_condexp_L2 _ _,
+  rw condexp_ind_smul,
+  suffices : ae_strongly_measurable' m
+    ((to_span_singleton ℝ x) ∘ (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)))) μ,
+  { refine ae_strongly_measurable'.congr this _,
+    refine eventually_eq.trans _ (coe_fn_comp_LpL _ _).symm,
+    rw Lp_meas_coe, },
+  exact ae_strongly_measurable'.continuous_comp (to_span_singleton ℝ x).continuous h,
+end
+
+lemma condexp_ind_smul_add (hs : measurable_set s) (hμs : μ s ≠ ∞) (x y : G) :
+  condexp_ind_smul hm hs hμs (x + y)
+    = condexp_ind_smul hm hs hμs x + condexp_ind_smul hm hs hμs y :=
+by { simp_rw [condexp_ind_smul], rw [to_span_singleton_add, add_comp_LpL, add_apply], }
+
+lemma condexp_ind_smul_smul (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : ℝ) (x : G) :
+  condexp_ind_smul hm hs hμs (c • x) = c • condexp_ind_smul hm hs hμs x :=
+by { simp_rw [condexp_ind_smul], rw [to_span_singleton_smul, smul_comp_LpL, smul_apply], }
+
+lemma condexp_ind_smul_smul' [normed_space ℝ F] [smul_comm_class ℝ 𝕜 F] (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (c : 𝕜) (x : F) :
+  condexp_ind_smul hm hs hμs (c • x) = c • condexp_ind_smul hm hs hμs x :=
+by rw [condexp_ind_smul, condexp_ind_smul, to_span_singleton_smul',
+  (to_span_singleton ℝ x).smul_comp_LpL c, smul_apply]
+
+lemma condexp_ind_smul_ae_eq_smul (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  condexp_ind_smul hm hs hμs x
+    =ᵐ[μ] λ a, (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a) • x :=
+(to_span_singleton ℝ x).coe_fn_comp_LpL _
+
+lemma set_lintegral_nnnorm_condexp_ind_smul_le (hm : m ≤ m0) (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (x : G) {t : set α} (ht : measurable_set[m] t) (hμt : μ t ≠ ∞) :
+  ∫⁻ a in t, ‖condexp_ind_smul hm hs hμs x a‖₊ ∂μ ≤ μ (s ∩ t) * ‖x‖₊ :=
+calc ∫⁻ a in t, ‖condexp_ind_smul hm hs hμs x a‖₊ ∂μ
+    = ∫⁻ a in t, ‖condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a • x‖₊ ∂μ :
+set_lintegral_congr_fun (hm t ht)
+  ((condexp_ind_smul_ae_eq_smul hm hs hμs x).mono (λ a ha hat, by rw ha ))
+... = ∫⁻ a in t, ‖condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) a‖₊ ∂μ * ‖x‖₊ :
+begin
+  simp_rw [nnnorm_smul, ennreal.coe_mul],
+  rw [lintegral_mul_const, Lp_meas_coe],
+  exact (Lp.strongly_measurable _).ennnorm
+end
+... ≤ μ (s ∩ t) * ‖x‖₊ :
+  mul_le_mul_right' (lintegral_nnnorm_condexp_L2_indicator_le_real hs hμs ht hμt) _
+
+lemma lintegral_nnnorm_condexp_ind_smul_le (hm : m ≤ m0) (hs : measurable_set s)
+  (hμs : μ s ≠ ∞) (x : G) [sigma_finite (μ.trim hm)] :
+  ∫⁻ a, ‖condexp_ind_smul hm hs hμs x a‖₊ ∂μ ≤ μ s * ‖x‖₊ :=
+begin
+  refine lintegral_le_of_forall_fin_meas_le' hm (μ s * ‖x‖₊) _ (λ t ht hμt, _),
+  { exact (Lp.ae_strongly_measurable _).ennnorm },
+  refine (set_lintegral_nnnorm_condexp_ind_smul_le hm hs hμs x ht hμt).trans _,
+  exact mul_le_mul_right' (measure_mono (set.inter_subset_left _ _)) _
+end
+
+/-- If the measure `μ.trim hm` is sigma-finite, then the conditional expectation of a measurable set
+with finite measure is integrable. -/
+lemma integrable_condexp_ind_smul (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : G) :
+  integrable (condexp_ind_smul hm hs hμs x) μ :=
+begin
+  refine integrable_of_forall_fin_meas_le' hm (μ s * ‖x‖₊)
+    (ennreal.mul_lt_top hμs ennreal.coe_ne_top) _ _,
+  { exact Lp.ae_strongly_measurable _, },
+  { refine λ t ht hμt, (set_lintegral_nnnorm_condexp_ind_smul_le hm hs hμs x ht hμt).trans _,
+    exact mul_le_mul_right' (measure_mono (set.inter_subset_left _ _)) _, },
+end
+
+lemma condexp_ind_smul_empty {x : G} :
+  condexp_ind_smul hm measurable_set.empty
+    ((@measure_empty _ _ μ).le.trans_lt ennreal.coe_lt_top).ne x = 0 :=
+begin
+  rw [condexp_ind_smul, indicator_const_empty],
+  simp only [coe_fn_coe_base, submodule.coe_zero, continuous_linear_map.map_zero],
+end
+
+lemma set_integral_condexp_L2_indicator (hs : measurable_set[m] s) (ht : measurable_set t)
+  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) :
+  ∫ x in s, (condexp_L2 ℝ hm (indicator_const_Lp 2 ht hμt (1 : ℝ))) x ∂μ = (μ (t ∩ s)).to_real :=
+calc ∫ x in s, (condexp_L2 ℝ hm (indicator_const_Lp 2 ht hμt (1 : ℝ))) x ∂μ
+    = ∫ x in s, indicator_const_Lp 2 ht hμt (1 : ℝ) x ∂μ :
+      @integral_condexp_L2_eq
+        α _ ℝ _ _ _ _ _ _ _ _ _ hm (indicator_const_Lp 2 ht hμt (1 : ℝ)) hs hμs
+... = (μ (t ∩ s)).to_real • 1 : set_integral_indicator_const_Lp (hm s hs) ht hμt (1 : ℝ)
+... = (μ (t ∩ s)).to_real : by rw [smul_eq_mul, mul_one]
+
+lemma set_integral_condexp_ind_smul (hs : measurable_set[m] s) (ht : measurable_set t)
+  (hμs : μ s ≠ ∞) (hμt : μ t ≠ ∞) (x : G') :
+  ∫ a in s, (condexp_ind_smul hm ht hμt x) a ∂μ = (μ (t ∩ s)).to_real • x :=
+calc ∫ a in s, (condexp_ind_smul hm ht hμt x) a ∂μ
+    = (∫ a in s, (condexp_L2 ℝ hm (indicator_const_Lp 2 ht hμt (1 : ℝ)) a • x) ∂μ) :
+  set_integral_congr_ae (hm s hs) ((condexp_ind_smul_ae_eq_smul hm ht hμt x).mono (λ x hx hxs, hx))
+... = (∫ a in s, condexp_L2 ℝ hm (indicator_const_Lp 2 ht hμt (1 : ℝ)) a ∂μ) • x :
+  integral_smul_const _ x
+... = (μ (t ∩ s)).to_real • x :
+  by rw set_integral_condexp_L2_indicator hs ht hμs hμt
+
+lemma condexp_L2_indicator_nonneg (hm : m ≤ m0) (hs : measurable_set s) (hμs : μ s ≠ ∞)
+  [sigma_finite (μ.trim hm)] :
+  0 ≤ᵐ[μ] condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) :=
+begin
+  have h : ae_strongly_measurable' m (condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ))) μ,
+    from ae_strongly_measurable'_condexp_L2 _ _,
+  refine eventually_le.trans_eq _ h.ae_eq_mk.symm,
+  refine @ae_le_of_ae_le_trim _ _ _ _ _ _ hm _ _ _,
+  refine ae_nonneg_of_forall_set_integral_nonneg_of_sigma_finite _ _,
+  { intros t ht hμt,
+    refine @integrable.integrable_on _ _ m _ _ _ _ _,
+    refine integrable.trim hm _ _,
+    { rw integrable_congr h.ae_eq_mk.symm,
+      exact integrable_condexp_L2_indicator hm hs hμs _, },
+    { exact h.strongly_measurable_mk, }, },
+  { intros t ht hμt,
+    rw ← set_integral_trim hm h.strongly_measurable_mk ht,
+    have h_ae : ∀ᵐ x ∂μ, x ∈ t → h.mk _ x = condexp_L2 ℝ hm (indicator_const_Lp 2 hs hμs (1 : ℝ)) x,
+    { filter_upwards [h.ae_eq_mk] with x hx,
+      exact λ _, hx.symm, },
+    rw [set_integral_congr_ae (hm t ht) h_ae,
+      set_integral_condexp_L2_indicator ht hs ((le_trim hm).trans_lt hμt).ne hμs],
+    exact ennreal.to_real_nonneg, },
+end
+
+lemma condexp_ind_smul_nonneg {E} [normed_lattice_add_comm_group E] [normed_space ℝ E]
+  [ordered_smul ℝ E] [sigma_finite (μ.trim hm)]
+  (hs : measurable_set s) (hμs : μ s ≠ ∞) (x : E) (hx : 0 ≤ x) :
+  0 ≤ᵐ[μ] condexp_ind_smul hm hs hμs x :=
+begin
+  refine eventually_le.trans_eq _ (condexp_ind_smul_ae_eq_smul hm hs hμs x).symm,
+  filter_upwards [condexp_L2_indicator_nonneg hm hs hμs] with a ha,
+  exact smul_nonneg ha hx,
+end
+
+end condexp_ind_smul
+
+end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/indicator.lean b/src/measure_theory/function/conditional_expectation/indicator.lean
new file mode 100644
index 0000000000000..75267db6ea2d7
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/indicator.lean
@@ -0,0 +1,199 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import measure_theory.function.conditional_expectation.basic
+
+/-!
+
+# Conditional expectation of indicator functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves some results about the conditional expectation of an indicator function and
+as a corollary, also proves several results about the behaviour of the conditional expectation on
+a restricted measure.
+
+## Main result
+
+* `measure_theory.condexp_indicator`: If `s` is a `m`-measurable set, then the conditional
+  expectation of the indicator function of `s` is almost everywhere equal to the indicator
+  of `s` of the conditional expectation. Namely, `𝔼[s.indicator f | m] = s.indicator 𝔼[f | m]` a.e.
+
+-/
+
+noncomputable theory
+open topological_space measure_theory.Lp filter continuous_linear_map
+open_locale nnreal ennreal topology big_operators measure_theory
+
+namespace measure_theory
+
+variables {α 𝕜 E : Type*} {m m0 : measurable_space α}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  {μ : measure α} {f : α → E} {s : set α}
+
+lemma condexp_ae_eq_restrict_zero (hs : measurable_set[m] s) (hf : f =ᵐ[μ.restrict s] 0) :
+  μ[f | m] =ᵐ[μ.restrict s] 0 :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw condexp_of_not_le hm, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  haveI : sigma_finite ((μ.restrict s).trim hm),
+  { rw ← restrict_trim hm _ hs,
+    exact restrict.sigma_finite _ s, },
+  by_cases hf_int : integrable f μ,
+  swap, { rw condexp_undef hf_int, },
+  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' hm _ _ _ _ _,
+  { exact λ t ht hμt, integrable_condexp.integrable_on.integrable_on, },
+  { exact λ t ht hμt, (integrable_zero _ _ _).integrable_on, },
+  { intros t ht hμt,
+    rw [measure.restrict_restrict (hm _ ht), set_integral_condexp hm hf_int (ht.inter hs),
+      ← measure.restrict_restrict (hm _ ht)],
+    refine set_integral_congr_ae (hm _ ht) _,
+    filter_upwards [hf] with x hx h using hx, },
+  { exact strongly_measurable_condexp.ae_strongly_measurable', },
+  { exact strongly_measurable_zero.ae_strongly_measurable', },
+end
+
+/-- Auxiliary lemma for `condexp_indicator`. -/
+lemma condexp_indicator_aux (hs : measurable_set[m] s) (hf : f =ᵐ[μ.restrict sᶜ] 0) :
+  μ[s.indicator f | m] =ᵐ[μ] s.indicator (μ[f | m]) :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw [condexp_of_not_le hm, set.indicator_zero'], },
+  have hsf_zero : ∀ g : α → E, g =ᵐ[μ.restrict sᶜ] 0 → s.indicator g =ᵐ[μ] g,
+    from λ g, indicator_ae_eq_of_restrict_compl_ae_eq_zero (hm _ hs),
+  refine ((hsf_zero (μ[f | m]) (condexp_ae_eq_restrict_zero hs.compl hf)).trans _).symm,
+  exact condexp_congr_ae (hsf_zero f hf).symm,
+end
+
+/-- The conditional expectation of the indicator of a function over an `m`-measurable set with
+respect to the σ-algebra `m` is a.e. equal to the indicator of the conditional expectation. -/
+lemma condexp_indicator (hf_int : integrable f μ) (hs : measurable_set[m] s) :
+  μ[s.indicator f | m] =ᵐ[μ] s.indicator (μ[f | m]) :=
+begin
+  by_cases hm : m ≤ m0,
+  swap, { simp_rw [condexp_of_not_le hm, set.indicator_zero'], },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw [condexp_of_not_sigma_finite hm hμm, set.indicator_zero'], },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  -- use `have` to perform what should be the first calc step because of an error I don't
+  -- understand
+  have : s.indicator (μ[f|m]) =ᵐ[μ] s.indicator (μ[s.indicator f + sᶜ.indicator f|m]),
+    by rw set.indicator_self_add_compl s f,
+  refine (this.trans _).symm,
+  calc s.indicator (μ[s.indicator f + sᶜ.indicator f|m])
+      =ᵐ[μ] s.indicator (μ[s.indicator f|m] + μ[sᶜ.indicator f|m]) :
+    begin
+      have : μ[s.indicator f + sᶜ.indicator f|m] =ᵐ[μ] μ[s.indicator f|m] + μ[sᶜ.indicator f|m],
+        from condexp_add (hf_int.indicator (hm _ hs)) (hf_int.indicator (hm _ hs.compl)),
+      filter_upwards [this] with x hx,
+      classical,
+      rw [set.indicator_apply, set.indicator_apply, hx],
+    end
+  ... = s.indicator (μ[s.indicator f|m]) + s.indicator (μ[sᶜ.indicator f|m]) :
+    s.indicator_add' _ _
+  ... =ᵐ[μ] s.indicator (μ[s.indicator f|m]) + s.indicator (sᶜ.indicator (μ[sᶜ.indicator f|m])) :
+    begin
+      refine filter.eventually_eq.rfl.add _,
+      have : sᶜ.indicator (μ[sᶜ.indicator f|m]) =ᵐ[μ] μ[sᶜ.indicator f|m],
+      { refine (condexp_indicator_aux hs.compl _).symm.trans _,
+        { exact indicator_ae_eq_restrict_compl (hm _ hs.compl), },
+        { rw [set.indicator_indicator, set.inter_self], }, },
+      filter_upwards [this] with x hx,
+      by_cases hxs : x ∈ s,
+      { simp only [hx, hxs, set.indicator_of_mem], },
+      { simp only [hxs, set.indicator_of_not_mem, not_false_iff], },
+    end
+  ... =ᵐ[μ] s.indicator (μ[s.indicator f|m]) :
+    by rw [set.indicator_indicator, set.inter_compl_self, set.indicator_empty', add_zero]
+  ... =ᵐ[μ] μ[s.indicator f|m] :
+    begin
+      refine (condexp_indicator_aux hs _).symm.trans _,
+      { exact indicator_ae_eq_restrict_compl (hm _ hs), },
+      { rw [set.indicator_indicator, set.inter_self], },
+    end
+end
+
+lemma condexp_restrict_ae_eq_restrict (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  (hs_m : measurable_set[m] s) (hf_int : integrable f μ) :
+  (μ.restrict s)[f | m] =ᵐ[μ.restrict s] μ[f | m] :=
+begin
+  haveI : sigma_finite ((μ.restrict s).trim hm),
+  { rw ← restrict_trim hm _ hs_m, apply_instance, },
+  rw ae_eq_restrict_iff_indicator_ae_eq (hm _ hs_m),
+  swap, { apply_instance, },
+  refine eventually_eq.trans _ (condexp_indicator hf_int hs_m),
+  refine ae_eq_condexp_of_forall_set_integral_eq hm (hf_int.indicator (hm _ hs_m)) _ _ _,
+  { intros t ht hμt,
+    rw [← integrable_indicator_iff (hm _ ht), set.indicator_indicator, set.inter_comm,
+      ← set.indicator_indicator],
+    suffices h_int_restrict : integrable (t.indicator ((μ.restrict s)[f|m])) (μ.restrict s),
+    { rw [integrable_indicator_iff (hm _ hs_m), integrable_on],
+      rw [integrable_indicator_iff (hm _ ht), integrable_on] at h_int_restrict ⊢,
+      exact h_int_restrict, },
+    exact integrable_condexp.indicator (hm _ ht), },
+  { intros t ht hμt,
+    calc ∫ x in t, s.indicator ((μ.restrict s)[f|m]) x ∂μ
+        = ∫ x in t, ((μ.restrict s)[f|m]) x ∂(μ.restrict s) :
+      by rw [integral_indicator (hm _ hs_m), measure.restrict_restrict (hm _ hs_m),
+        measure.restrict_restrict (hm _ ht), set.inter_comm]
+    ... = ∫ x in t, f x ∂(μ.restrict s) : set_integral_condexp hm hf_int.integrable_on ht
+    ... = ∫ x in t, s.indicator f x ∂μ :
+      by rw [integral_indicator (hm _ hs_m), measure.restrict_restrict (hm _ hs_m),
+        measure.restrict_restrict (hm _ ht), set.inter_comm], },
+  { exact (strongly_measurable_condexp.indicator hs_m).ae_strongly_measurable', },
+end
+
+/-- If the restriction to a `m`-measurable set `s` of a σ-algebra `m` is equal to the restriction
+to `s` of another σ-algebra `m₂` (hypothesis `hs`), then `μ[f | m] =ᵐ[μ.restrict s] μ[f | m₂]`. -/
+lemma condexp_ae_eq_restrict_of_measurable_space_eq_on {m m₂ m0 : measurable_space α}
+  {μ : measure α} (hm : m ≤ m0) (hm₂ : m₂ ≤ m0)
+  [sigma_finite (μ.trim hm)] [sigma_finite (μ.trim hm₂)]
+  (hs_m : measurable_set[m] s) (hs : ∀ t, measurable_set[m] (s ∩ t) ↔ measurable_set[m₂] (s ∩ t)) :
+  μ[f | m] =ᵐ[μ.restrict s] μ[f | m₂] :=
+begin
+  rw ae_eq_restrict_iff_indicator_ae_eq (hm _ hs_m),
+  have hs_m₂ : measurable_set[m₂] s,
+  { rwa [← set.inter_univ s, ← hs set.univ, set.inter_univ], },
+  by_cases hf_int : integrable f μ,
+  swap, { simp_rw condexp_undef hf_int, },
+  refine ((condexp_indicator hf_int hs_m).symm.trans _).trans (condexp_indicator hf_int hs_m₂),
+  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' hm₂
+    (λ s hs hμs, integrable_condexp.integrable_on)
+    (λ s hs hμs, integrable_condexp.integrable_on) _ _
+    strongly_measurable_condexp.ae_strongly_measurable',
+  swap,
+  { have : strongly_measurable[m] (μ[s.indicator f | m]) := strongly_measurable_condexp,
+    refine this.ae_strongly_measurable'.ae_strongly_measurable'_of_measurable_space_le_on
+      hm hs_m (λ t, (hs t).mp) _,
+    exact condexp_ae_eq_restrict_zero hs_m.compl (indicator_ae_eq_restrict_compl (hm _ hs_m)), },
+  intros t ht hμt,
+  have : ∫ x in t, μ[s.indicator f|m] x ∂μ = ∫ x in s ∩ t, μ[s.indicator f|m] x ∂μ,
+  { rw ← integral_add_compl (hm _ hs_m) integrable_condexp.integrable_on,
+    suffices : ∫ x in sᶜ, μ[s.indicator f|m] x ∂μ.restrict t = 0,
+      by rw [this, add_zero, measure.restrict_restrict (hm _ hs_m)],
+    rw measure.restrict_restrict (measurable_set.compl (hm _ hs_m)),
+    suffices : μ[s.indicator f|m] =ᵐ[μ.restrict sᶜ] 0,
+    { rw [set.inter_comm, ← measure.restrict_restrict (hm₂ _ ht)],
+      calc ∫ (x : α) in t, μ[s.indicator f|m] x ∂μ.restrict sᶜ
+          = ∫ (x : α) in t, 0 ∂μ.restrict sᶜ : begin
+            refine set_integral_congr_ae (hm₂ _ ht) _,
+            filter_upwards [this] with x hx h using hx,
+          end
+      ... = 0 : integral_zero _ _, },
+    refine condexp_ae_eq_restrict_zero hs_m.compl _,
+    exact indicator_ae_eq_restrict_compl (hm _ hs_m), },
+  have hst_m : measurable_set[m] (s ∩ t) := (hs _).mpr (hs_m₂.inter ht),
+  simp_rw [this, set_integral_condexp hm₂ (hf_int.indicator (hm _ hs_m)) ht,
+    set_integral_condexp hm (hf_int.indicator (hm _ hs_m)) hst_m,
+    integral_indicator (hm _ hs_m), measure.restrict_restrict (hm _ hs_m),
+    ← set.inter_assoc, set.inter_self],
+end
+
+end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/real.lean b/src/measure_theory/function/conditional_expectation/real.lean
new file mode 100644
index 0000000000000..ffdda9fc88a67
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/real.lean
@@ -0,0 +1,405 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne, Kexing Ying
+-/
+
+import measure_theory.function.conditional_expectation.indicator
+import measure_theory.function.uniform_integrable
+import measure_theory.decomposition.radon_nikodym
+
+/-!
+
+# Conditional expectation of real-valued functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves some results regarding the conditional expectation of real-valued functions.
+
+## Main results
+
+* `measure_theory.rn_deriv_ae_eq_condexp`: the conditional expectation `μ[f | m]` is equal to the
+  Radon-Nikodym derivative of `fμ` restricted on `m` with respect to `μ` restricted on `m`.
+* `measure_theory.integrable.uniform_integrable_condexp`: the conditional expectation of a function
+  form a uniformly integrable class.
+* `measure_theory.condexp_strongly_measurable_mul`: the pull-out property of the conditional
+  expectation.
+
+-/
+
+noncomputable theory
+open topological_space measure_theory.Lp filter continuous_linear_map
+open_locale nnreal ennreal topology big_operators measure_theory
+
+namespace measure_theory
+
+variables {α : Type*} {m m0 : measurable_space α} {μ : measure α}
+
+lemma rn_deriv_ae_eq_condexp {hm : m ≤ m0} [hμm : sigma_finite (μ.trim hm)] {f : α → ℝ}
+  (hf : integrable f μ) :
+  signed_measure.rn_deriv ((μ.with_densityᵥ f).trim hm) (μ.trim hm) =ᵐ[μ] μ[f | m] :=
+begin
+  refine ae_eq_condexp_of_forall_set_integral_eq hm hf _ _ _,
+  { exact λ _ _ _, (integrable_of_integrable_trim hm (signed_measure.integrable_rn_deriv
+      ((μ.with_densityᵥ f).trim hm) (μ.trim hm))).integrable_on },
+  { intros s hs hlt,
+    conv_rhs { rw [← hf.with_densityᵥ_trim_eq_integral hm hs,
+      ← signed_measure.with_densityᵥ_rn_deriv_eq ((μ.with_densityᵥ f).trim hm) (μ.trim hm)
+        (hf.with_densityᵥ_trim_absolutely_continuous hm)], },
+    rw [with_densityᵥ_apply
+        (signed_measure.integrable_rn_deriv ((μ.with_densityᵥ f).trim hm) (μ.trim hm)) hs,
+      ← set_integral_trim hm _ hs],
+    exact (signed_measure.measurable_rn_deriv _ _).strongly_measurable },
+  { exact strongly_measurable.ae_strongly_measurable'
+      (signed_measure.measurable_rn_deriv _ _).strongly_measurable },
+end
+
+-- TODO: the following couple of lemmas should be generalized and proved using Jensen's inequality
+-- for the conditional expectation (not in mathlib yet) .
+lemma snorm_one_condexp_le_snorm (f : α → ℝ) :
+  snorm (μ[f | m]) 1 μ ≤ snorm f 1 μ :=
+begin
+  by_cases hf : integrable f μ,
+  swap, { rw [condexp_undef hf, snorm_zero], exact zero_le _ },
+  by_cases hm : m ≤ m0,
+  swap, { rw [condexp_of_not_le hm, snorm_zero], exact zero_le _ },
+  by_cases hsig : sigma_finite (μ.trim hm),
+  swap, { rw [condexp_of_not_sigma_finite hm hsig, snorm_zero], exact zero_le _ },
+  calc snorm (μ[f | m]) 1 μ ≤ snorm (μ[|f| | m]) 1 μ :
+  begin
+    refine snorm_mono_ae _,
+    filter_upwards [@condexp_mono _ m m0 _ _ _ _ _ _ _ _ hf hf.abs
+        (@ae_of_all _ m0 _ μ (λ x, le_abs_self (f x) : ∀ x, f x ≤ |f x|)),
+      eventually_le.trans (condexp_neg f).symm.le
+        (@condexp_mono _ m m0 _ _ _ _ _ _ _  _ hf.neg hf.abs
+        (@ae_of_all _ m0 _ μ (λ x, neg_le_abs_self (f x) : ∀ x, -f x ≤ |f x|)))] with x hx₁ hx₂,
+    exact abs_le_abs hx₁ hx₂,
+  end
+    ... = snorm f 1 μ :
+  begin
+    rw [snorm_one_eq_lintegral_nnnorm, snorm_one_eq_lintegral_nnnorm,
+      ← ennreal.to_real_eq_to_real (ne_of_lt integrable_condexp.2) (ne_of_lt hf.2),
+      ← integral_norm_eq_lintegral_nnnorm
+        (strongly_measurable_condexp.mono hm).ae_strongly_measurable,
+      ← integral_norm_eq_lintegral_nnnorm hf.1],
+    simp_rw [real.norm_eq_abs],
+    rw ← @integral_condexp _ _ _ _ _ m m0 μ _ hm hsig hf.abs,
+    refine integral_congr_ae _,
+    have : 0 ≤ᵐ[μ] μ[|f| | m],
+    { rw ← @condexp_zero α ℝ _ _ _ m m0 μ,
+      exact condexp_mono (integrable_zero _ _ _) hf.abs
+        (@ae_of_all _ m0 _ μ (λ x, abs_nonneg (f x) : ∀ x, 0 ≤ |f x|)) },
+    filter_upwards [this] with x hx,
+    exact abs_eq_self.2 hx
+  end
+end
+
+lemma integral_abs_condexp_le (f : α → ℝ) :
+  ∫ x, |μ[f | m] x| ∂μ ≤ ∫ x, |f x| ∂μ :=
+begin
+  by_cases hm : m ≤ m0,
+  swap,
+  { simp_rw [condexp_of_not_le hm, pi.zero_apply, abs_zero, integral_zero],
+    exact integral_nonneg (λ x, abs_nonneg _) },
+  by_cases hfint : integrable f μ,
+  swap,
+  { simp only [condexp_undef hfint, pi.zero_apply, abs_zero, integral_const,
+      algebra.id.smul_eq_mul, mul_zero],
+    exact integral_nonneg (λ x, abs_nonneg _) },
+  rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae],
+  { rw ennreal.to_real_le_to_real;
+    simp_rw [← real.norm_eq_abs, of_real_norm_eq_coe_nnnorm],
+    { rw [← snorm_one_eq_lintegral_nnnorm, ← snorm_one_eq_lintegral_nnnorm],
+      exact snorm_one_condexp_le_snorm _ },
+    { exact ne_of_lt integrable_condexp.2 },
+    { exact ne_of_lt hfint.2 } },
+  { exact eventually_of_forall (λ x, abs_nonneg _) },
+  { simp_rw ← real.norm_eq_abs,
+    exact hfint.1.norm },
+  { exact eventually_of_forall (λ x, abs_nonneg _) },
+  { simp_rw ← real.norm_eq_abs,
+    exact (strongly_measurable_condexp.mono hm).ae_strongly_measurable.norm }
+end
+
+lemma set_integral_abs_condexp_le {s : set α} (hs : measurable_set[m] s) (f : α → ℝ) :
+  ∫ x in s, |μ[f | m] x| ∂μ ≤ ∫ x in s, |f x| ∂μ :=
+begin
+  by_cases hnm : m ≤ m0,
+  swap,
+  { simp_rw [condexp_of_not_le hnm, pi.zero_apply, abs_zero, integral_zero],
+    exact integral_nonneg (λ x, abs_nonneg _) },
+  by_cases hfint : integrable f μ,
+  swap,
+  { simp only [condexp_undef hfint, pi.zero_apply, abs_zero, integral_const,
+      algebra.id.smul_eq_mul, mul_zero],
+    exact integral_nonneg (λ x, abs_nonneg _) },
+  have : ∫ x in s, |μ[f | m] x| ∂μ = ∫ x, |μ[s.indicator f | m] x| ∂μ,
+  { rw ← integral_indicator,
+    swap, { exact hnm _ hs },
+    refine integral_congr_ae _,
+    have : (λ x, |μ[s.indicator f | m] x|) =ᵐ[μ] λ x, |s.indicator (μ[f | m]) x| :=
+      eventually_eq.fun_comp (condexp_indicator hfint hs) _,
+    refine eventually_eq.trans (eventually_of_forall $ λ x, _) this.symm,
+    rw [← real.norm_eq_abs, norm_indicator_eq_indicator_norm],
+    refl },
+  rw [this, ← integral_indicator],
+  swap, { exact hnm _ hs },
+  refine (integral_abs_condexp_le _).trans (le_of_eq $ integral_congr_ae $
+    eventually_of_forall $ λ x, _),
+  rw [← real.norm_eq_abs, norm_indicator_eq_indicator_norm],
+  refl,
+end
+
+/-- If the real valued function `f` is bounded almost everywhere by `R`, then so is its conditional
+expectation. -/
+lemma ae_bdd_condexp_of_ae_bdd {R : ℝ≥0} {f : α → ℝ}
+  (hbdd : ∀ᵐ x ∂μ, |f x| ≤ R) :
+  ∀ᵐ x ∂μ, |μ[f | m] x| ≤ R :=
+begin
+  by_cases hnm : m ≤ m0,
+  swap,
+  { simp_rw [condexp_of_not_le hnm, pi.zero_apply, abs_zero],
+    refine eventually_of_forall (λ x, R.coe_nonneg) },
+  by_cases hfint : integrable f μ,
+  swap,
+  { simp_rw [condexp_undef hfint],
+    filter_upwards [hbdd] with x hx,
+    rw [pi.zero_apply, abs_zero],
+    exact (abs_nonneg _).trans hx },
+  by_contra h,
+  change μ _ ≠ 0 at h,
+  simp only [← zero_lt_iff, set.compl_def, set.mem_set_of_eq, not_le] at h,
+  suffices : (μ {x | ↑R < |μ[f | m] x|}).to_real * ↑R < (μ {x | ↑R < |μ[f | m] x|}).to_real * ↑R,
+  { exact this.ne rfl },
+  refine lt_of_lt_of_le (set_integral_gt_gt R.coe_nonneg _ _ h.ne.symm) _,
+  { simp_rw [← real.norm_eq_abs],
+    exact (strongly_measurable_condexp.mono hnm).measurable.norm },
+  { exact integrable_condexp.abs.integrable_on },
+  refine (set_integral_abs_condexp_le _ _).trans _,
+  { simp_rw [← real.norm_eq_abs],
+    exact @measurable_set_lt _ _ _ _ _ m _ _ _ _ _ measurable_const
+      strongly_measurable_condexp.norm.measurable },
+  simp only [← smul_eq_mul, ← set_integral_const, nnreal.val_eq_coe,
+    is_R_or_C.coe_real_eq_id, id.def],
+  refine set_integral_mono_ae hfint.abs.integrable_on _ _,
+  { refine ⟨ae_strongly_measurable_const, lt_of_le_of_lt _
+      (integrable_condexp.integrable_on : integrable_on (μ[f | m]) {x | ↑R < |μ[f | m] x|} μ).2⟩,
+    refine set_lintegral_mono (measurable.nnnorm _).coe_nnreal_ennreal
+      (strongly_measurable_condexp.mono hnm).measurable.nnnorm.coe_nnreal_ennreal (λ x hx, _),
+    { exact measurable_const },
+    { rw [ennreal.coe_le_coe, real.nnnorm_of_nonneg R.coe_nonneg],
+      exact subtype.mk_le_mk.2 (le_of_lt hx) } },
+  { exact hbdd },
+end
+
+/-- Given a integrable function `g`, the conditional expectations of `g` with respect to
+a sequence of sub-σ-algebras is uniformly integrable. -/
+lemma integrable.uniform_integrable_condexp {ι : Type*} [is_finite_measure μ]
+  {g : α → ℝ} (hint : integrable g μ) {ℱ : ι → measurable_space α} (hℱ : ∀ i, ℱ i ≤ m0) :
+  uniform_integrable (λ i, μ[g | ℱ i]) 1 μ :=
+begin
+  have hmeas : ∀ n, ∀ C, measurable_set {x | C ≤ ‖μ[g | ℱ n] x‖₊} :=
+    λ n C, measurable_set_le measurable_const
+      (strongly_measurable_condexp.mono (hℱ n)).measurable.nnnorm,
+  have hg : mem_ℒp g 1 μ := mem_ℒp_one_iff_integrable.2 hint,
+  refine uniform_integrable_of le_rfl ennreal.one_ne_top
+    (λ n, (strongly_measurable_condexp.mono (hℱ n)).ae_strongly_measurable) (λ ε hε, _),
+  by_cases hne : snorm g 1 μ = 0,
+  { rw snorm_eq_zero_iff hg.1 one_ne_zero at hne,
+    refine ⟨0, λ n, (le_of_eq $ (snorm_eq_zero_iff
+      ((strongly_measurable_condexp.mono (hℱ n)).ae_strongly_measurable.indicator (hmeas n 0))
+      one_ne_zero).2 _).trans (zero_le _)⟩,
+    filter_upwards [@condexp_congr_ae _ _ _ _ _ (ℱ n) m0 μ _ _ hne] with x hx,
+    simp only [zero_le', set.set_of_true, set.indicator_univ, pi.zero_apply, hx, condexp_zero] },
+  obtain ⟨δ, hδ, h⟩ := hg.snorm_indicator_le μ le_rfl ennreal.one_ne_top hε,
+  set C : ℝ≥0 := ⟨δ, hδ.le⟩⁻¹ * (snorm g 1 μ).to_nnreal with hC,
+  have hCpos : 0 < C :=
+    mul_pos (inv_pos.2 hδ) (ennreal.to_nnreal_pos hne hg.snorm_lt_top.ne),
+  have : ∀ n, μ {x : α | C ≤ ‖μ[g | ℱ n] x‖₊} ≤ ennreal.of_real δ,
+  { intro n,
+    have := mul_meas_ge_le_pow_snorm' μ one_ne_zero ennreal.one_ne_top
+      ((@strongly_measurable_condexp _ _ _ _ _ (ℱ n) _ μ g).mono
+        (hℱ n)).ae_strongly_measurable C,
+    rw [ennreal.one_to_real, ennreal.rpow_one, ennreal.rpow_one, mul_comm,
+      ← ennreal.le_div_iff_mul_le (or.inl (ennreal.coe_ne_zero.2 hCpos.ne.symm))
+        (or.inl ennreal.coe_lt_top.ne)] at this,
+    simp_rw [ennreal.coe_le_coe] at this,
+    refine this.trans _,
+    rw [ennreal.div_le_iff_le_mul (or.inl (ennreal.coe_ne_zero.2 hCpos.ne.symm))
+        (or.inl ennreal.coe_lt_top.ne), hC, nonneg.inv_mk, ennreal.coe_mul,
+      ennreal.coe_to_nnreal hg.snorm_lt_top.ne, ← mul_assoc, ← ennreal.of_real_eq_coe_nnreal,
+      ← ennreal.of_real_mul hδ.le, mul_inv_cancel hδ.ne.symm, ennreal.of_real_one, one_mul],
+    exact snorm_one_condexp_le_snorm _ },
+  refine ⟨C, λ n, le_trans _ (h {x : α | C ≤ ‖μ[g | ℱ n] x‖₊} (hmeas n C) (this n))⟩,
+  have hmeasℱ : measurable_set[ℱ n] {x : α | C ≤ ‖μ[g | ℱ n] x‖₊} :=
+    @measurable_set_le _ _ _ _ _ (ℱ n) _ _ _ _ _ measurable_const
+      (@measurable.nnnorm _ _ _ _ _ (ℱ n) _ strongly_measurable_condexp.measurable),
+  rw ← snorm_congr_ae (condexp_indicator hint hmeasℱ),
+  exact snorm_one_condexp_le_snorm _,
+end
+
+section pull_out
+-- TODO: this section could be generalized beyond multiplication, to any bounded bilinear map.
+
+/-- Auxiliary lemma for `condexp_measurable_mul`. -/
+lemma condexp_strongly_measurable_simple_func_mul (hm : m ≤ m0)
+  (f : @simple_func α m ℝ) {g : α → ℝ} (hg : integrable g μ) :
+  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
+begin
+  have : ∀ s c (f : α → ℝ), set.indicator s (function.const α c) * f = s.indicator (c • f),
+  { intros s c f,
+    ext1 x,
+    by_cases hx : x ∈ s,
+    { simp only [hx, pi.mul_apply, set.indicator_of_mem, pi.smul_apply, algebra.id.smul_eq_mul] },
+    { simp only [hx, pi.mul_apply, set.indicator_of_not_mem, not_false_iff, zero_mul], }, },
+  refine @simple_func.induction _ _ m _ _ (λ c s hs, _) (λ g₁ g₂ h_disj h_eq₁ h_eq₂, _) f,
+  { simp only [simple_func.const_zero, simple_func.coe_piecewise, simple_func.coe_const,
+      simple_func.coe_zero, set.piecewise_eq_indicator],
+    rw [this, this],
+    refine (condexp_indicator (hg.smul c) hs).trans _,
+    filter_upwards [@condexp_smul α ℝ ℝ _ _ _ _ _ m m0 μ c g] with x hx,
+    classical,
+    simp_rw [set.indicator_apply, hx], },
+  { have h_add := @simple_func.coe_add _ _ m _ g₁ g₂,
+    calc μ[⇑(g₁ + g₂) * g|m] =ᵐ[μ] μ[(⇑g₁ + ⇑g₂) * g|m] :
+      by { refine condexp_congr_ae (eventually_eq.mul _ eventually_eq.rfl), rw h_add, }
+    ... =ᵐ[μ] μ[⇑g₁ * g|m] + μ[⇑g₂ * g|m] :
+      by { rw add_mul, exact condexp_add (hg.simple_func_mul' hm _) (hg.simple_func_mul' hm _), }
+    ... =ᵐ[μ] ⇑g₁ * μ[g|m] + ⇑g₂ * μ[g|m] : eventually_eq.add h_eq₁ h_eq₂
+    ... =ᵐ[μ] ⇑(g₁ + g₂) * μ[g|m] : by rw [h_add, add_mul], },
+end
+
+lemma condexp_strongly_measurable_mul_of_bound (hm : m ≤ m0) [is_finite_measure μ]
+  {f g : α → ℝ} (hf : strongly_measurable[m] f) (hg : integrable g μ) (c : ℝ)
+  (hf_bound : ∀ᵐ x ∂μ, ‖f x‖ ≤ c) :
+  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
+begin
+  let fs := hf.approx_bounded c,
+  have hfs_tendsto : ∀ᵐ x ∂μ, tendsto (λ n, fs n x) at_top (𝓝 (f x)),
+    from hf.tendsto_approx_bounded_ae hf_bound,
+  by_cases hμ : μ = 0,
+  { simp only [hμ, ae_zero], },
+  haveI : μ.ae.ne_bot, by simp only [hμ, ae_ne_bot, ne.def, not_false_iff],
+  have hc : 0 ≤ c,
+  { have h_exists : ∃ x, ‖f x‖ ≤ c := eventually.exists hf_bound,
+    exact (norm_nonneg _).trans h_exists.some_spec, },
+  have hfs_bound : ∀ n x, ‖fs n x‖ ≤ c := hf.norm_approx_bounded_le hc,
+  have hn_eq : ∀ n, μ[fs n * g | m] =ᵐ[μ] fs n * μ[g | m],
+    from λ n, condexp_strongly_measurable_simple_func_mul hm _ hg,
+  have : μ[f * μ[g|m]|m] = f * μ[g|m],
+  { refine condexp_of_strongly_measurable hm (hf.mul strongly_measurable_condexp) _,
+    exact integrable_condexp.bdd_mul' ((hf.mono hm).ae_strongly_measurable) hf_bound, },
+  rw ← this,
+  refine tendsto_condexp_unique (λ n x, fs n x * g x) (λ n x, fs n x * μ[g|m] x) (f * g)
+    (f * μ[g|m]) _ _ _ _ (λ x, c * ‖g x‖) _ (λ x, c * ‖μ[g|m] x‖) _ _ _ _,
+  { exact λ n, hg.bdd_mul'
+      ((simple_func.strongly_measurable (fs n)).mono hm).ae_strongly_measurable
+      (eventually_of_forall (hfs_bound n)), },
+  { exact λ n, integrable_condexp.bdd_mul'
+      ((simple_func.strongly_measurable (fs n)).mono hm).ae_strongly_measurable
+      (eventually_of_forall (hfs_bound n)), },
+  { filter_upwards [hfs_tendsto] with x hx,
+    rw pi.mul_apply,
+    exact tendsto.mul hx tendsto_const_nhds, },
+  { filter_upwards [hfs_tendsto] with x hx,
+    rw pi.mul_apply,
+    exact tendsto.mul hx tendsto_const_nhds, },
+  { exact hg.norm.const_mul c, },
+  { exact integrable_condexp.norm.const_mul c, },
+  { refine λ n, eventually_of_forall (λ x, _),
+    exact (norm_mul_le _ _).trans (mul_le_mul_of_nonneg_right (hfs_bound n x) (norm_nonneg _)), },
+  { refine λ n, eventually_of_forall (λ x, _),
+    exact (norm_mul_le _ _).trans (mul_le_mul_of_nonneg_right (hfs_bound n x) (norm_nonneg _)), },
+  { intros n,
+    simp_rw ← pi.mul_apply,
+    refine (condexp_strongly_measurable_simple_func_mul hm _ hg).trans _,
+    rw condexp_of_strongly_measurable hm
+      ((simple_func.strongly_measurable _).mul strongly_measurable_condexp) _,
+    { apply_instance, },
+    { apply_instance, },
+    exact integrable_condexp.bdd_mul'
+      ((simple_func.strongly_measurable (fs n)).mono hm).ae_strongly_measurable
+      (eventually_of_forall (hfs_bound n)), },
+end
+
+lemma condexp_strongly_measurable_mul_of_bound₀ (hm : m ≤ m0) [is_finite_measure μ]
+  {f g : α → ℝ} (hf : ae_strongly_measurable' m f μ) (hg : integrable g μ) (c : ℝ)
+  (hf_bound : ∀ᵐ x ∂μ, ‖f x‖ ≤ c) :
+  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
+begin
+  have : μ[f * g | m] =ᵐ[μ] μ[hf.mk f * g | m],
+    from condexp_congr_ae (eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl),
+  refine this.trans _,
+  have : f * μ[g | m] =ᵐ[μ] hf.mk f * μ[g | m] := eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl,
+  refine eventually_eq.trans _ this.symm,
+  refine condexp_strongly_measurable_mul_of_bound hm hf.strongly_measurable_mk hg c _,
+  filter_upwards [hf_bound, hf.ae_eq_mk] with x hxc hx_eq,
+  rw ← hx_eq,
+  exact hxc,
+end
+
+/-- Pull-out property of the conditional expectation. -/
+lemma condexp_strongly_measurable_mul {f g : α → ℝ} (hf : strongly_measurable[m] f)
+  (hfg : integrable (f * g) μ) (hg : integrable g μ) :
+  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
+begin
+  by_cases hm : m ≤ m0, swap, { simp_rw condexp_of_not_le hm, rw mul_zero, },
+  by_cases hμm : sigma_finite (μ.trim hm),
+  swap, { simp_rw condexp_of_not_sigma_finite hm hμm, rw mul_zero, },
+  haveI : sigma_finite (μ.trim hm) := hμm,
+  obtain ⟨sets, sets_prop, h_univ⟩ := hf.exists_spanning_measurable_set_norm_le hm μ,
+  simp_rw forall_and_distrib at sets_prop,
+  obtain ⟨h_meas, h_finite, h_norm⟩ := sets_prop,
+
+  suffices : ∀ n, ∀ᵐ x ∂μ, x ∈ sets n → μ[f * g|m] x = f x * μ[g|m] x,
+  { rw ← ae_all_iff at this,
+    filter_upwards [this] with x hx,
+    rw pi.mul_apply,
+    obtain ⟨i, hi⟩ : ∃ i, x ∈ sets i,
+    { have h_mem : x ∈ ⋃ i, sets i,
+      { rw h_univ, exact set.mem_univ _, },
+      simpa using h_mem, },
+    exact hx i hi, },
+  refine λ n, ae_imp_of_ae_restrict _,
+  suffices : (μ.restrict (sets n))[f * g | m]
+    =ᵐ[μ.restrict (sets n)] f * (μ.restrict (sets n))[g | m],
+  { simp_rw ← pi.mul_apply,
+    refine (condexp_restrict_ae_eq_restrict hm (h_meas n) hfg).symm.trans _,
+    exact this.trans (eventually_eq.rfl.mul (condexp_restrict_ae_eq_restrict hm (h_meas n) hg)), },
+  suffices : (μ.restrict (sets n))[((sets n).indicator f) * g | m]
+    =ᵐ[μ.restrict (sets n)] ((sets n).indicator f) * (μ.restrict (sets n))[g | m],
+  { refine eventually_eq.trans _ (this.trans _),
+    { exact condexp_congr_ae
+        ((indicator_ae_eq_restrict (hm _ (h_meas n))).symm.mul eventually_eq.rfl), },
+    { exact (indicator_ae_eq_restrict (hm _ (h_meas n))).mul eventually_eq.rfl, }, },
+  haveI : is_finite_measure (μ.restrict (sets n)),
+  { constructor,
+    rw measure.restrict_apply_univ,
+    exact h_finite n, },
+  refine condexp_strongly_measurable_mul_of_bound hm (hf.indicator (h_meas n)) hg.integrable_on n _,
+  refine eventually_of_forall (λ x, _),
+  by_cases hxs : x ∈ sets n,
+  { simp only [hxs, set.indicator_of_mem],
+    exact h_norm n x hxs, },
+  { simp only [hxs, set.indicator_of_not_mem, not_false_iff, _root_.norm_zero, nat.cast_nonneg], },
+end
+
+/-- Pull-out property of the conditional expectation. -/
+lemma condexp_strongly_measurable_mul₀ {f g : α → ℝ} (hf : ae_strongly_measurable' m f μ)
+  (hfg : integrable (f * g) μ) (hg : integrable g μ) :
+  μ[f * g | m] =ᵐ[μ] f * μ[g | m] :=
+begin
+  have : μ[f * g | m] =ᵐ[μ] μ[hf.mk f * g | m],
+    from condexp_congr_ae (eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl),
+  refine this.trans _,
+  have : f * μ[g | m] =ᵐ[μ] hf.mk f * μ[g | m] := eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl,
+  refine eventually_eq.trans _ this.symm,
+  refine condexp_strongly_measurable_mul hf.strongly_measurable_mk _ hg,
+  refine (integrable_congr _).mp hfg,
+  exact eventually_eq.mul hf.ae_eq_mk eventually_eq.rfl,
+end
+
+end pull_out
+
+end measure_theory
diff --git a/src/measure_theory/function/conditional_expectation/unique.lean b/src/measure_theory/function/conditional_expectation/unique.lean
new file mode 100644
index 0000000000000..70986754eff09
--- /dev/null
+++ b/src/measure_theory/function/conditional_expectation/unique.lean
@@ -0,0 +1,216 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.function.ae_eq_of_integral
+import measure_theory.function.conditional_expectation.ae_measurable
+
+/-!
+# Uniqueness of the conditional expectation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Two Lp functions `f, g` which are almost everywhere strongly measurable with respect to a σ-algebra
+`m` and verify `∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ` for all `m`-measurable sets `s` are equal
+almost everywhere. This proves the uniqueness of the conditional expectation, which is not yet
+defined in this file but is introduced in `measure_theory.function.conditional_expectation.basic`.
+
+## Main statements
+
+* `Lp.ae_eq_of_forall_set_integral_eq'`: two `Lp` functions verifying the equality of integrals
+  defining the conditional expectation are equal.
+* `ae_eq_of_forall_set_integral_eq_of_sigma_finite'`: two functions verifying the equality of
+  integrals defining the conditional expectation are equal almost everywhere.
+  Requires `[sigma_finite (μ.trim hm)]`.
+
+-/
+
+open_locale ennreal measure_theory
+
+namespace measure_theory
+
+variables {α E' F' 𝕜 : Type*} {p : ℝ≥0∞}
+  {m m0 : measurable_space α} {μ : measure α}
+  [is_R_or_C 𝕜] -- 𝕜 for ℝ or ℂ
+  -- E' for an inner product space on which we compute integrals
+  [normed_add_comm_group E'] [inner_product_space 𝕜 E']
+  [complete_space E'] [normed_space ℝ E']
+  -- F' for integrals on a Lp submodule
+  [normed_add_comm_group F'] [normed_space 𝕜 F'] [normed_space ℝ F'] [complete_space F']
+
+section uniqueness_of_conditional_expectation
+
+/-! ## Uniqueness of the conditional expectation -/
+
+lemma Lp_meas.ae_eq_zero_of_forall_set_integral_eq_zero
+  (hm : m ≤ m0) (f : Lp_meas E' 𝕜 m p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
+  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
+  (hf_zero : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = 0) :
+  f =ᵐ[μ] 0 :=
+begin
+  obtain ⟨g, hg_sm, hfg⟩ := Lp_meas.ae_fin_strongly_measurable' hm f hp_ne_zero hp_ne_top,
+  refine hfg.trans _,
+  refine ae_eq_zero_of_forall_set_integral_eq_of_fin_strongly_measurable_trim hm _ _ hg_sm,
+  { intros s hs hμs,
+    have hfg_restrict : f =ᵐ[μ.restrict s] g, from ae_restrict_of_ae hfg,
+    rw [integrable_on, integrable_congr hfg_restrict.symm],
+    exact hf_int_finite s hs hμs, },
+  { intros s hs hμs,
+    have hfg_restrict : f =ᵐ[μ.restrict s] g, from ae_restrict_of_ae hfg,
+    rw integral_congr_ae hfg_restrict.symm,
+    exact hf_zero s hs hμs, },
+end
+
+include 𝕜
+variables (𝕜)
+
+lemma Lp.ae_eq_zero_of_forall_set_integral_eq_zero'
+  (hm : m ≤ m0) (f : Lp E' p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
+  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
+  (hf_zero : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = 0)
+  (hf_meas : ae_strongly_measurable' m f μ) :
+  f =ᵐ[μ] 0 :=
+begin
+  let f_meas : Lp_meas E' 𝕜 m p μ := ⟨f, hf_meas⟩,
+  have hf_f_meas : f =ᵐ[μ] f_meas, by simp only [coe_fn_coe_base', subtype.coe_mk],
+  refine hf_f_meas.trans _,
+  refine Lp_meas.ae_eq_zero_of_forall_set_integral_eq_zero hm f_meas hp_ne_zero hp_ne_top _ _,
+  { intros s hs hμs,
+    have hfg_restrict : f =ᵐ[μ.restrict s] f_meas, from ae_restrict_of_ae hf_f_meas,
+    rw [integrable_on, integrable_congr hfg_restrict.symm],
+    exact hf_int_finite s hs hμs, },
+  { intros s hs hμs,
+    have hfg_restrict : f =ᵐ[μ.restrict s] f_meas, from ae_restrict_of_ae hf_f_meas,
+    rw integral_congr_ae hfg_restrict.symm,
+    exact hf_zero s hs hμs, },
+end
+
+/-- **Uniqueness of the conditional expectation** -/
+lemma Lp.ae_eq_of_forall_set_integral_eq'
+  (hm : m ≤ m0) (f g : Lp E' p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
+  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
+  (hg_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on g s μ)
+  (hfg : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ)
+  (hf_meas : ae_strongly_measurable' m f μ) (hg_meas : ae_strongly_measurable' m g μ) :
+  f =ᵐ[μ] g :=
+begin
+  suffices h_sub : ⇑(f-g) =ᵐ[μ] 0,
+    by { rw ← sub_ae_eq_zero, exact (Lp.coe_fn_sub f g).symm.trans h_sub, },
+  have hfg' : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, (f - g) x ∂μ = 0,
+  { intros s hs hμs,
+    rw integral_congr_ae (ae_restrict_of_ae (Lp.coe_fn_sub f g)),
+    rw integral_sub' (hf_int_finite s hs hμs) (hg_int_finite s hs hμs),
+    exact sub_eq_zero.mpr (hfg s hs hμs), },
+  have hfg_int : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on ⇑(f-g) s μ,
+  { intros s hs hμs,
+    rw [integrable_on, integrable_congr (ae_restrict_of_ae (Lp.coe_fn_sub f g))],
+    exact (hf_int_finite s hs hμs).sub (hg_int_finite s hs hμs), },
+  have hfg_meas : ae_strongly_measurable' m ⇑(f - g) μ,
+    from ae_strongly_measurable'.congr (hf_meas.sub hg_meas) (Lp.coe_fn_sub f g).symm,
+  exact Lp.ae_eq_zero_of_forall_set_integral_eq_zero' 𝕜 hm (f-g) hp_ne_zero hp_ne_top hfg_int hfg'
+    hfg_meas,
+end
+
+variables {𝕜}
+omit 𝕜
+
+lemma ae_eq_of_forall_set_integral_eq_of_sigma_finite' (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
+  {f g : α → F'}
+  (hf_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on f s μ)
+  (hg_int_finite : ∀ s, measurable_set[m] s → μ s < ∞ → integrable_on g s μ)
+  (hfg_eq : ∀ s : set α, measurable_set[m] s → μ s < ∞ → ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ)
+  (hfm : ae_strongly_measurable' m f μ) (hgm : ae_strongly_measurable' m g μ) :
+  f =ᵐ[μ] g :=
+begin
+  rw ← ae_eq_trim_iff_of_ae_strongly_measurable' hm hfm hgm,
+  have hf_mk_int_finite : ∀ s, measurable_set[m] s → μ.trim hm s < ∞ →
+    @integrable_on _ _ m _ (hfm.mk f) s (μ.trim hm),
+  { intros s hs hμs,
+    rw trim_measurable_set_eq hm hs at hμs,
+    rw [integrable_on, restrict_trim hm _ hs],
+    refine integrable.trim hm _ hfm.strongly_measurable_mk,
+    exact integrable.congr (hf_int_finite s hs hμs) (ae_restrict_of_ae hfm.ae_eq_mk), },
+  have hg_mk_int_finite : ∀ s, measurable_set[m] s → μ.trim hm s < ∞ →
+    @integrable_on _ _ m _ (hgm.mk g) s (μ.trim hm),
+  { intros s hs hμs,
+    rw trim_measurable_set_eq hm hs at hμs,
+    rw [integrable_on, restrict_trim hm _ hs],
+    refine integrable.trim hm _ hgm.strongly_measurable_mk,
+    exact integrable.congr (hg_int_finite s hs hμs) (ae_restrict_of_ae hgm.ae_eq_mk), },
+  have hfg_mk_eq : ∀ s : set α, measurable_set[m] s → μ.trim hm s < ∞ →
+    ∫ x in s, (hfm.mk f x) ∂(μ.trim hm) = ∫ x in s, (hgm.mk g x) ∂(μ.trim hm),
+  { intros s hs hμs,
+    rw trim_measurable_set_eq hm hs at hμs,
+    rw [restrict_trim hm _ hs, ← integral_trim hm hfm.strongly_measurable_mk,
+      ← integral_trim hm hgm.strongly_measurable_mk,
+      integral_congr_ae (ae_restrict_of_ae hfm.ae_eq_mk.symm),
+      integral_congr_ae (ae_restrict_of_ae hgm.ae_eq_mk.symm)],
+    exact hfg_eq s hs hμs, },
+  exact ae_eq_of_forall_set_integral_eq_of_sigma_finite hf_mk_int_finite hg_mk_int_finite hfg_mk_eq,
+end
+
+end uniqueness_of_conditional_expectation
+
+
+section integral_norm_le
+
+variables {s : set α}
+
+/-- Let `m` be a sub-σ-algebra of `m0`, `f` a `m0`-measurable function and `g` a `m`-measurable
+function, such that their integrals coincide on `m`-measurable sets with finite measure.
+Then `∫ x in s, ‖g x‖ ∂μ ≤ ∫ x in s, ‖f x‖ ∂μ` on all `m`-measurable sets with finite measure. -/
+lemma integral_norm_le_of_forall_fin_meas_integral_eq (hm : m ≤ m0) {f g : α → ℝ}
+  (hf : strongly_measurable f) (hfi : integrable_on f s μ)
+  (hg : strongly_measurable[m] g) (hgi : integrable_on g s μ)
+  (hgf : ∀ t, measurable_set[m] t → μ t < ∞ → ∫ x in t, g x ∂μ = ∫ x in t, f x ∂μ)
+  (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) :
+  ∫ x in s, ‖g x‖ ∂μ ≤ ∫ x in s, ‖f x‖ ∂μ :=
+begin
+  rw [integral_norm_eq_pos_sub_neg hgi, integral_norm_eq_pos_sub_neg hfi],
+  have h_meas_nonneg_g : measurable_set[m] {x | 0 ≤ g x},
+    from (@strongly_measurable_const _ _ m _ _).measurable_set_le hg,
+  have h_meas_nonneg_f : measurable_set {x | 0 ≤ f x},
+    from strongly_measurable_const.measurable_set_le hf,
+  have h_meas_nonpos_g : measurable_set[m] {x | g x ≤ 0},
+    from hg.measurable_set_le (@strongly_measurable_const _ _ m _ _),
+  have h_meas_nonpos_f : measurable_set {x | f x ≤ 0},
+    from hf.measurable_set_le strongly_measurable_const,
+  refine sub_le_sub _ _,
+  { rw [measure.restrict_restrict (hm _ h_meas_nonneg_g),
+      measure.restrict_restrict h_meas_nonneg_f,
+      hgf _ (@measurable_set.inter α m _ _ h_meas_nonneg_g hs)
+        ((measure_mono (set.inter_subset_right _ _)).trans_lt (lt_top_iff_ne_top.mpr hμs)),
+      ← measure.restrict_restrict (hm _ h_meas_nonneg_g),
+      ← measure.restrict_restrict h_meas_nonneg_f],
+    exact set_integral_le_nonneg (hm _ h_meas_nonneg_g) hf hfi, },
+  { rw [measure.restrict_restrict (hm _ h_meas_nonpos_g),
+      measure.restrict_restrict h_meas_nonpos_f,
+      hgf _ (@measurable_set.inter α m _ _ h_meas_nonpos_g hs)
+        ((measure_mono (set.inter_subset_right _ _)).trans_lt (lt_top_iff_ne_top.mpr hμs)),
+      ← measure.restrict_restrict (hm _ h_meas_nonpos_g),
+      ← measure.restrict_restrict h_meas_nonpos_f],
+    exact set_integral_nonpos_le (hm _ h_meas_nonpos_g) hf hfi, },
+end
+
+/-- Let `m` be a sub-σ-algebra of `m0`, `f` a `m0`-measurable function and `g` a `m`-measurable
+function, such that their integrals coincide on `m`-measurable sets with finite measure.
+Then `∫⁻ x in s, ‖g x‖₊ ∂μ ≤ ∫⁻ x in s, ‖f x‖₊ ∂μ` on all `m`-measurable sets with finite
+measure. -/
+lemma lintegral_nnnorm_le_of_forall_fin_meas_integral_eq (hm : m ≤ m0) {f g : α → ℝ}
+  (hf : strongly_measurable f) (hfi : integrable_on f s μ)
+  (hg : strongly_measurable[m] g) (hgi : integrable_on g s μ)
+  (hgf : ∀ t, measurable_set[m] t → μ t < ∞ → ∫ x in t, g x ∂μ = ∫ x in t, f x ∂μ)
+  (hs : measurable_set[m] s) (hμs : μ s ≠ ∞) :
+  ∫⁻ x in s, ‖g x‖₊ ∂μ ≤ ∫⁻ x in s, ‖f x‖₊ ∂μ :=
+begin
+  rw [← of_real_integral_norm_eq_lintegral_nnnorm hfi,
+    ← of_real_integral_norm_eq_lintegral_nnnorm hgi, ennreal.of_real_le_of_real_iff],
+  { exact integral_norm_le_of_forall_fin_meas_integral_eq hm hf hfi hg hgi hgf hs hμs, },
+  { exact integral_nonneg (λ x, norm_nonneg _), },
+end
+
+end integral_norm_le
+
+end measure_theory
diff --git a/src/measure_theory/function/continuous_map_dense.lean b/src/measure_theory/function/continuous_map_dense.lean
index 949035b8da651..c7c511cfef3a1 100644
--- a/src/measure_theory/function/continuous_map_dense.lean
+++ b/src/measure_theory/function/continuous_map_dense.lean
@@ -7,15 +7,33 @@ Authors: Heather Macbeth
 import measure_theory.measure.regular
 import measure_theory.function.simple_func_dense_lp
 import topology.urysohns_lemma
-import measure_theory.function.l1_space
+import measure_theory.integral.bochner
 
 /-!
 # Approximation in Lᵖ by continuous functions
 
-This file proves that bounded continuous functions are dense in `Lp E p μ`, for `1 ≤ p < ∞`, if the
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves that bounded continuous functions are dense in `Lp E p μ`, for `p < ∞`, if the
 domain `α` of the functions is a normal topological space and the measure `μ` is weakly regular.
+It also proves the same results for approximation by continuous functions with compact support
+when the space is locally compact and `μ` is regular.
+
+The result is presented in several versions. First concrete versions giving an approximation
+up to `ε` in these various contexts, and then abstract versions stating that the topological
+closure of the relevant subgroups of `Lp` are the whole space.
+
+* `mem_ℒp.exists_has_compact_support_snorm_sub_le` states that, in a locally compact space,
+  an `ℒp` function can be approximated by continuous functions with compact support,
+  in the sense that `snorm (f - g) p μ` is small.
+* `mem_ℒp.exists_has_compact_support_integral_rpow_sub_le`: same result, but expressed in
+  terms of `∫ ‖f - g‖^p`.
+
+Versions with `integrable` instead of `mem_ℒp` are specialized to the case `p = 1`.
+Versions with `bounded_continuous` instead of `has_compact_support` drop the locally
+compact assumption and give only approximation by a bounded continuous function.
 
-The result is presented in several versions:
 * `measure_theory.Lp.bounded_continuous_function_dense`: The subgroup
   `measure_theory.Lp.bounded_continuous_function` of `Lp E p μ`, the additive subgroup of
   `Lp E p μ` consisting of equivalence classes containing a continuous representative, is dense in
@@ -42,130 +60,292 @@ Vitali-Carathéodory theorem, in the file `measure_theory.vitali_caratheodory`.
 
 -/
 
-open_locale ennreal nnreal topological_space bounded_continuous_function
-open measure_theory topological_space continuous_map
+open_locale ennreal nnreal topology bounded_continuous_function
+open measure_theory topological_space continuous_map set
 
 variables {α : Type*} [measurable_space α] [topological_space α] [normal_space α] [borel_space α]
-variables (E : Type*) [normed_group E]
-  [second_countable_topology_either α E]
-variables {p : ℝ≥0∞} [_i : fact (1 ≤ p)] (hp : p ≠ ∞) (μ : measure α)
-
-include _i hp
+variables {E : Type*} [normed_add_comm_group E] {μ : measure α} {p : ℝ≥0∞}
 
-namespace measure_theory.Lp
+namespace measure_theory
 
 variables [normed_space ℝ E]
 
+/-- A variant of Urysohn's lemma, `ℒ^p` version, for an outer regular measure `μ`:
+consider two sets `s ⊆ u` which are respectively closed and open with `μ s < ∞`, and a vector `c`.
+Then one may find a continuous function `f` equal to `c` on `s` and to `0` outside of `u`,
+bounded by `‖c‖` everywhere, and such that the `ℒ^p` norm of `f - s.indicator (λ y, c)` is
+arbitrarily small. Additionally, this function `f` belongs to `ℒ^p`. -/
+lemma exists_continuous_snorm_sub_le_of_closed [μ.outer_regular]
+  (hp : p ≠ ∞) {s u : set α} (s_closed : is_closed s) (u_open : is_open u) (hsu : s ⊆ u)
+  (hs : μ s ≠ ∞) (c : E) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (f : α → E), continuous f ∧ snorm (λ x, f x - s.indicator (λ y, c) x) p μ ≤ ε ∧
+    (∀ x, ‖f x‖ ≤ ‖c‖) ∧ function.support f ⊆ u ∧ mem_ℒp f p μ :=
+begin
+  obtain ⟨η, η_pos, hη⟩ : ∃ (η : ℝ≥0), 0 < η ∧ ∀ (s : set α), μ s ≤ η →
+    snorm (s.indicator (λ x, c)) p μ ≤ ε, from exists_snorm_indicator_le hp c hε,
+  have ηpos : (0 : ℝ≥0∞) < η := ennreal.coe_lt_coe.2 η_pos,
+  obtain ⟨V, sV, V_open, h'V, hV⟩ : ∃ (V : set α) (H : V ⊇ s), is_open V ∧ μ V < ∞ ∧ μ (V \ s) < η,
+    from s_closed.measurable_set.exists_is_open_diff_lt hs ηpos.ne',
+  let v := u ∩ V,
+  have hsv : s ⊆ v := subset_inter hsu sV,
+  have hμv : μ v < ∞ := (measure_mono (inter_subset_right _ _)).trans_lt h'V,
+  obtain ⟨g, hgv, hgs, hg_range⟩ := exists_continuous_zero_one_of_closed
+    (u_open.inter V_open).is_closed_compl s_closed (disjoint_compl_left_iff.2 hsv),
+  -- Multiply this by `c` to get a continuous approximation to the function `f`; the key point is
+  -- that this is pointwise bounded by the indicator of the set `v \ s`, which has small measure.
+  have g_norm : ∀ x, ‖g x‖ = g x := λ x, by rw [real.norm_eq_abs, abs_of_nonneg (hg_range x).1],
+  have gc_bd0 : ∀ x, ‖g x • c‖ ≤ ‖c‖,
+  { assume x,
+    simp only [norm_smul, g_norm x],
+    apply mul_le_of_le_one_left (norm_nonneg _),
+    exact (hg_range x).2 },
+  have gc_bd : ∀ x, ‖g x • c - s.indicator (λ x, c) x‖ ≤ ‖(v \ s).indicator (λ x, c) x‖,
+  { intros x,
+    by_cases hv : x ∈ v,
+    { rw ← set.diff_union_of_subset hsv at hv,
+      cases hv with hsv hs,
+      { simpa only [hsv.2, set.indicator_of_not_mem, not_false_iff, sub_zero, hsv,
+          set.indicator_of_mem] using gc_bd0 x},
+      { simp [hgs hs, hs] } },
+    { simp [hgv hv, (λ h, hv (hsv h) : x ∉ s)], } },
+  have gc_support : function.support (λ (x : α), g x • c) ⊆ v,
+  { refine function.support_subset_iff'.2 (λ x hx, _),
+    simp only [hgv hx, pi.zero_apply, zero_smul] },
+  have gc_mem : mem_ℒp (λ x, g x • c) p μ,
+  { refine mem_ℒp.smul_of_top_left (mem_ℒp_top_const _) _,
+    refine ⟨g.continuous.ae_strongly_measurable, _⟩,
+    have : snorm (v.indicator (λ x, (1 : ℝ))) p μ < ⊤,
+    { refine (snorm_indicator_const_le _ _).trans_lt _,
+      simp only [lt_top_iff_ne_top, hμv.ne, nnnorm_one, ennreal.coe_one, one_div, one_mul, ne.def,
+        ennreal.rpow_eq_top_iff, inv_lt_zero, false_and, or_false, not_and, not_lt,
+        ennreal.to_real_nonneg, implies_true_iff] },
+    refine (snorm_mono (λ x, _)).trans_lt this,
+    by_cases hx : x ∈ v,
+    { simp only [hx, abs_of_nonneg (hg_range x).1, (hg_range x).2, real.norm_eq_abs,
+        indicator_of_mem, cstar_ring.norm_one] },
+    { simp only [hgv hx, pi.zero_apply, real.norm_eq_abs, abs_zero, abs_nonneg] } },
+  refine ⟨λ x, g x • c, g.continuous.smul continuous_const, (snorm_mono gc_bd).trans _, gc_bd0,
+    gc_support.trans (inter_subset_left _ _), gc_mem⟩,
+  exact hη _ ((measure_mono (diff_subset_diff (inter_subset_right _ _) subset.rfl)).trans hV.le),
+end
+
+/-- In a locally compact space, any function in `ℒp` can be approximated by compactly supported
+continuous functions when `p < ∞`, version in terms of `snorm`. -/
+lemma mem_ℒp.exists_has_compact_support_snorm_sub_le
+  [locally_compact_space α] [μ.regular] (hp : p ≠ ∞)
+  {f : α → E} (hf : mem_ℒp f p μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (g : α → E), has_compact_support g ∧ snorm (f - g) p μ ≤ ε ∧ continuous g ∧ mem_ℒp g p μ :=
+begin
+  suffices H : ∃ (g : α → E), snorm (f - g) p μ ≤ ε ∧ continuous g ∧ mem_ℒp g p μ ∧
+    has_compact_support g,
+  { rcases H with ⟨g, hg, g_cont, g_mem, g_support⟩,
+    exact ⟨g, g_support, hg, g_cont, g_mem⟩ },
+  -- It suffices to check that the set of functions we consider approximates characteristic
+  -- functions, is stable under addition and consists of ae strongly measurable functions.
+  -- First check the latter easy facts.
+  apply hf.induction_dense hp _ _ _ _ hε, rotate,
+  -- stability under addition
+  { rintros f g ⟨f_cont, f_mem, hf⟩ ⟨g_cont, g_mem, hg⟩,
+    exact ⟨f_cont.add g_cont, f_mem.add g_mem, hf.add hg⟩ },
+  -- ae strong measurability
+  { rintros f ⟨f_cont, f_mem, hf⟩,
+    exact f_mem.ae_strongly_measurable },
+  -- We are left with approximating characteristic functions.
+  -- This follows from `exists_continuous_snorm_sub_le_of_closed`.
+  assume c t ht htμ ε hε,
+  rcases exists_Lp_half E μ p hε with ⟨δ, δpos, hδ⟩,
+  obtain ⟨η, ηpos, hη⟩ : ∃ (η : ℝ≥0), 0 < η ∧ ∀ (s : set α), μ s ≤ η →
+    snorm (s.indicator (λ x, c)) p μ ≤ δ, from exists_snorm_indicator_le hp c δpos.ne',
+  have hη_pos' : (0 : ℝ≥0∞) < η, from ennreal.coe_pos.2 ηpos,
+  obtain ⟨s, st, s_compact, μs⟩ : ∃ s ⊆ t, is_compact s ∧ μ (t \ s) < η,
+    from ht.exists_is_compact_diff_lt htμ.ne hη_pos'.ne',
+  have hsμ : μ s < ∞, from (measure_mono st).trans_lt htμ,
+  have I1 : snorm (s.indicator (λ y, c) - t.indicator (λ y, c)) p μ ≤ δ,
+  { rw [← snorm_neg, neg_sub, ← indicator_diff st],
+    exact (hη _ μs.le) },
+  obtain ⟨k, k_compact, sk, -⟩ : ∃ (k : set α), is_compact k ∧ s ⊆ interior k ∧ k ⊆ univ,
+    from exists_compact_between s_compact is_open_univ (subset_univ _),
+  rcases exists_continuous_snorm_sub_le_of_closed hp s_compact.is_closed is_open_interior sk
+    hsμ.ne c δpos.ne' with ⟨f, f_cont, I2, f_bound, f_support, f_mem⟩,
+  have I3 : snorm (f - t.indicator (λ y, c)) p μ ≤ ε,
+  { convert (hδ _ _ (f_mem.ae_strongly_measurable.sub
+        (ae_strongly_measurable_const.indicator s_compact.measurable_set))
+      ((ae_strongly_measurable_const.indicator s_compact.measurable_set).sub
+        (ae_strongly_measurable_const.indicator ht)) I2 I1).le,
+    simp only [sub_add_sub_cancel] },
+  refine ⟨f, I3, f_cont, f_mem, has_compact_support.intro k_compact (λ x hx, _)⟩,
+  rw ← function.nmem_support,
+  contrapose! hx,
+  exact interior_subset (f_support hx)
+end
+
+/-- In a locally compact space, any function in `ℒp` can be approximated by compactly supported
+continuous functions when `0 < p < ∞`, version in terms of `∫`. -/
+lemma mem_ℒp.exists_has_compact_support_integral_rpow_sub_le
+  [locally_compact_space α] [μ.regular] {p : ℝ} (hp : 0 < p)
+  {f : α → E} (hf : mem_ℒp f (ennreal.of_real p) μ) {ε : ℝ} (hε : 0 < ε) :
+  ∃ (g : α → E), has_compact_support g ∧ ∫ x, ‖f x - g x‖^p ∂μ ≤ ε ∧ continuous g
+    ∧ mem_ℒp g (ennreal.of_real p) μ :=
+begin
+  have I : 0 < ε ^ (1/p) := real.rpow_pos_of_pos hε _,
+  have A : ennreal.of_real (ε ^ (1/p)) ≠ 0,
+    by simp only [ne.def, ennreal.of_real_eq_zero, not_le, I],
+  have B : ennreal.of_real p ≠ 0, by simpa only [ne.def, ennreal.of_real_eq_zero, not_le] using hp,
+  rcases hf.exists_has_compact_support_snorm_sub_le ennreal.coe_ne_top A
+    with ⟨g, g_support, hg, g_cont, g_mem⟩,
+  change snorm _ (ennreal.of_real p) _ ≤ _ at hg,
+  refine ⟨g, g_support, _, g_cont, g_mem⟩,
+  rwa [(hf.sub g_mem).snorm_eq_integral_rpow_norm B ennreal.coe_ne_top,
+    ennreal.of_real_le_of_real_iff I.le, one_div,
+    ennreal.to_real_of_real hp.le, real.rpow_le_rpow_iff _ hε.le (inv_pos.2 hp)] at hg,
+  exact integral_nonneg (λ x, real.rpow_nonneg_of_nonneg (norm_nonneg _) _),
+end
+
+/-- In a locally compact space, any integrable function can be approximated by compactly supported
+continuous functions, version in terms of `∫⁻`. -/
+lemma integrable.exists_has_compact_support_lintegral_sub_le [locally_compact_space α] [μ.regular]
+  {f : α → E} (hf : integrable f μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (g : α → E), has_compact_support g ∧ ∫⁻ x, ‖f x - g x‖₊ ∂μ ≤ ε ∧ continuous g
+    ∧ integrable g μ :=
+begin
+  simp only [← mem_ℒp_one_iff_integrable, ← snorm_one_eq_lintegral_nnnorm] at hf ⊢,
+  exact hf.exists_has_compact_support_snorm_sub_le ennreal.one_ne_top hε,
+end
+
+/-- In a locally compact space, any integrable function can be approximated by compactly supported
+continuous functions, version in terms of `∫`. -/
+lemma integrable.exists_has_compact_support_integral_sub_le [locally_compact_space α] [μ.regular]
+  {f : α → E} (hf : integrable f μ) {ε : ℝ} (hε : 0 < ε) :
+  ∃ (g : α → E), has_compact_support g ∧ ∫ x, ‖f x - g x‖ ∂μ ≤ ε ∧ continuous g
+    ∧ integrable g μ :=
+begin
+  simp only [← mem_ℒp_one_iff_integrable, ← snorm_one_eq_lintegral_nnnorm,
+    ← ennreal.of_real_one] at hf ⊢,
+  simpa using hf.exists_has_compact_support_integral_rpow_sub_le zero_lt_one hε,
+end
+
+/-- Any function in `ℒp` can be approximated by bounded continuous functions when `p < ∞`,
+version in terms of `snorm`. -/
+lemma mem_ℒp.exists_bounded_continuous_snorm_sub_le [μ.weakly_regular] (hp : p ≠ ∞)
+  {f : α → E} (hf : mem_ℒp f p μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (g : α →ᵇ E), snorm (f - g) p μ ≤ ε ∧ mem_ℒp g p μ :=
+begin
+  suffices H : ∃ (g : α → E), snorm (f - g) p μ ≤ ε ∧ continuous g ∧ mem_ℒp g p μ ∧
+    metric.bounded (range g),
+  { rcases H with ⟨g, hg, g_cont, g_mem, g_bd⟩,
+    exact ⟨⟨⟨g, g_cont⟩, metric.bounded_range_iff.1 g_bd⟩, hg, g_mem⟩ },
+  -- It suffices to check that the set of functions we consider approximates characteristic
+  -- functions, is stable under addition and made of ae strongly measurable functions.
+  -- First check the latter easy facts.
+  apply hf.induction_dense hp _ _ _ _ hε, rotate,
+  -- stability under addition
+  { rintros f g ⟨f_cont, f_mem, f_bd⟩ ⟨g_cont, g_mem, g_bd⟩,
+    refine ⟨f_cont.add g_cont, f_mem.add g_mem, _⟩,
+    let f' : α →ᵇ E := ⟨⟨f, f_cont⟩, metric.bounded_range_iff.1 f_bd⟩,
+    let g' : α →ᵇ E := ⟨⟨g, g_cont⟩, metric.bounded_range_iff.1 g_bd⟩,
+    exact (f' + g').bounded_range },
+  -- ae strong measurability
+  { exact λ f ⟨_, h, _⟩, h.ae_strongly_measurable },
+  -- We are left with approximating characteristic functions.
+  -- This follows from `exists_continuous_snorm_sub_le_of_closed`.
+  assume c t ht htμ ε hε,
+  rcases exists_Lp_half E μ p hε with ⟨δ, δpos, hδ⟩,
+  obtain ⟨η, ηpos, hη⟩ : ∃ (η : ℝ≥0), 0 < η ∧ ∀ (s : set α), μ s ≤ η →
+    snorm (s.indicator (λ x, c)) p μ ≤ δ, from exists_snorm_indicator_le hp c δpos.ne',
+  have hη_pos' : (0 : ℝ≥0∞) < η, from ennreal.coe_pos.2 ηpos,
+  obtain ⟨s, st, s_closed, μs⟩ : ∃ s ⊆ t, is_closed s ∧ μ (t \ s) < η,
+    from ht.exists_is_closed_diff_lt htμ.ne hη_pos'.ne',
+  have hsμ : μ s < ∞, from (measure_mono st).trans_lt htμ,
+  have I1 : snorm (s.indicator (λ y, c) - t.indicator (λ y, c)) p μ ≤ δ,
+  { rw [← snorm_neg, neg_sub, ← indicator_diff st],
+    exact (hη _ μs.le) },
+  rcases exists_continuous_snorm_sub_le_of_closed hp s_closed is_open_univ (subset_univ _)
+    hsμ.ne c δpos.ne' with ⟨f, f_cont, I2, f_bound, -, f_mem⟩,
+  have I3 : snorm (f - t.indicator (λ y, c)) p μ ≤ ε,
+  { convert (hδ _ _ (f_mem.ae_strongly_measurable.sub
+        (ae_strongly_measurable_const.indicator s_closed.measurable_set))
+      ((ae_strongly_measurable_const.indicator s_closed.measurable_set).sub
+        (ae_strongly_measurable_const.indicator ht)) I2 I1).le,
+    simp only [sub_add_sub_cancel] },
+  refine ⟨f, I3, f_cont, f_mem, _⟩,
+  exact (bounded_continuous_function.of_normed_add_comm_group f f_cont _ f_bound).bounded_range,
+end
+
+/-- Any function in `ℒp` can be approximated by bounded continuous functions when `0 < p < ∞`,
+version in terms of `∫`. -/
+lemma mem_ℒp.exists_bounded_continuous_integral_rpow_sub_le
+  [μ.weakly_regular] {p : ℝ} (hp : 0 < p)
+  {f : α → E} (hf : mem_ℒp f (ennreal.of_real p) μ) {ε : ℝ} (hε : 0 < ε) :
+  ∃ (g : α →ᵇ E), ∫ x, ‖f x - g x‖^p ∂μ ≤ ε ∧ mem_ℒp g (ennreal.of_real p) μ :=
+begin
+  have I : 0 < ε ^ (1/p) := real.rpow_pos_of_pos hε _,
+  have A : ennreal.of_real (ε ^ (1/p)) ≠ 0,
+    by simp only [ne.def, ennreal.of_real_eq_zero, not_le, I],
+  have B : ennreal.of_real p ≠ 0, by simpa only [ne.def, ennreal.of_real_eq_zero, not_le] using hp,
+  rcases hf.exists_bounded_continuous_snorm_sub_le ennreal.coe_ne_top A with ⟨g, hg, g_mem⟩,
+  change snorm _ (ennreal.of_real p) _ ≤ _ at hg,
+  refine ⟨g, _, g_mem⟩,
+  rwa [(hf.sub g_mem).snorm_eq_integral_rpow_norm B ennreal.coe_ne_top,
+    ennreal.of_real_le_of_real_iff I.le, one_div,
+    ennreal.to_real_of_real hp.le, real.rpow_le_rpow_iff _ hε.le (inv_pos.2 hp)] at hg,
+  exact integral_nonneg (λ x, real.rpow_nonneg_of_nonneg (norm_nonneg _) _),
+end
+
+/-- Any integrable function can be approximated by bounded continuous functions,
+version in terms of `∫⁻`. -/
+lemma integrable.exists_bounded_continuous_lintegral_sub_le [μ.weakly_regular]
+  {f : α → E} (hf : integrable f μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (g : α →ᵇ E), ∫⁻ x, ‖f x - g x‖₊ ∂μ ≤ ε ∧ integrable g μ :=
+begin
+  simp only [← mem_ℒp_one_iff_integrable, ← snorm_one_eq_lintegral_nnnorm] at hf ⊢,
+  exact hf.exists_bounded_continuous_snorm_sub_le ennreal.one_ne_top hε,
+end
+
+/-- Any integrable function can be approximated by bounded continuous functions,
+version in terms of `∫`. -/
+lemma integrable.exists_bounded_continuous_integral_sub_le [μ.weakly_regular]
+  {f : α → E} (hf : integrable f μ) {ε : ℝ} (hε : 0 < ε) :
+  ∃ (g : α →ᵇ E), ∫ x, ‖f x - g x‖ ∂μ ≤ ε ∧ integrable g μ :=
+begin
+  simp only [← mem_ℒp_one_iff_integrable, ← snorm_one_eq_lintegral_nnnorm,
+    ← ennreal.of_real_one] at hf ⊢,
+  simpa using hf.exists_bounded_continuous_integral_rpow_sub_le zero_lt_one hε,
+end
+
+namespace Lp
+
+variables (E)
+
 /-- A function in `Lp` can be approximated in `Lp` by continuous functions. -/
-lemma bounded_continuous_function_dense [μ.weakly_regular] :
+lemma bounded_continuous_function_dense
+  [second_countable_topology_either α E] [_i : fact (1 ≤ p)] (hp : p ≠ ∞) [μ.weakly_regular] :
   (bounded_continuous_function E p μ).topological_closure = ⊤ :=
 begin
-  have hp₀ : 0 < p := lt_of_lt_of_le ennreal.zero_lt_one _i.elim,
-  have hp₀' : 0 ≤ 1 / p.to_real := div_nonneg zero_le_one ennreal.to_real_nonneg,
-  have hp₀'' : 0 < p.to_real,
-  { simpa [← ennreal.to_real_lt_to_real ennreal.zero_ne_top hp] using hp₀ },
-  -- It suffices to prove that scalar multiples of the indicator function of a finite-measure
-  -- measurable set can be approximated by continuous functions
-  suffices :  ∀ (c : E) {s : set α} (hs : measurable_set s) (hμs : μ s < ⊤),
-    (Lp.simple_func.indicator_const p hs hμs.ne c : Lp E p μ)
-      ∈ (bounded_continuous_function E p μ).topological_closure,
-  { rw add_subgroup.eq_top_iff',
-    refine Lp.induction hp _ _ _ _,
-    { exact this },
-    { exact λ f g hf hg hfg', add_subgroup.add_mem _ },
-    { exact add_subgroup.is_closed_topological_closure _ } },
-  -- Let `s` be a finite-measure measurable set, let's approximate `c` times its indicator function
-  intros c s hs hsμ,
+  rw add_subgroup.eq_top_iff',
+  assume f,
   refine mem_closure_iff_frequently.mpr _,
   rw metric.nhds_basis_closed_ball.frequently_iff,
   intros ε hε,
-  -- A little bit of pre-emptive work, to find `η : ℝ≥0` which will be a margin small enough for
-  -- our purposes
-  obtain ⟨η, hη_pos, hη_le⟩ : ∃ η, 0 < η ∧ (↑(∥bit0 (∥c∥)∥₊ * (2 * η) ^ (1 / p.to_real)) : ℝ) ≤ ε,
-  { have : filter.tendsto (λ x : ℝ≥0, ∥bit0 (∥c∥)∥₊ * (2 * x) ^ (1 / p.to_real)) (𝓝 0) (𝓝 0),
-    { have : filter.tendsto (λ x : ℝ≥0, 2 * x) (𝓝 0) (𝓝 (2 * 0)) := filter.tendsto_id.const_mul 2,
-      convert ((nnreal.continuous_at_rpow_const (or.inr hp₀')).tendsto.comp this).const_mul _,
-      simp [hp₀''.ne'] },
-    let ε' : ℝ≥0 := ⟨ε, hε.le⟩,
-    have hε' : 0 < ε' := by exact_mod_cast hε,
-    obtain ⟨δ, hδ, hδε'⟩ :=
-      nnreal.nhds_zero_basis.eventually_iff.mp (eventually_le_of_tendsto_lt hε' this),
-    obtain ⟨η, hη, hηδ⟩ := exists_between hδ,
-    refine ⟨η, hη, _⟩,
-    exact_mod_cast hδε' hηδ },
-  have hη_pos' : (0 : ℝ≥0∞) < η := ennreal.coe_pos.2 hη_pos,
-  -- Use the regularity of the measure to `η`-approximate `s` by an open superset and a closed
-  -- subset
-  obtain ⟨u, su, u_open, μu⟩ : ∃ u ⊇ s, is_open u ∧ μ u < μ s + ↑η,
-  { refine s.exists_is_open_lt_of_lt _ _,
-    simpa using ennreal.add_lt_add_left hsμ.ne hη_pos' },
-  obtain ⟨F, Fs, F_closed, μF⟩ : ∃ F ⊆ s, is_closed F ∧ μ s < μ F + ↑η :=
-    hs.exists_is_closed_lt_add hsμ.ne hη_pos'.ne',
-  have : disjoint uᶜ F,
-  { rw [set.disjoint_iff_inter_eq_empty, set.inter_comm, ← set.subset_compl_iff_disjoint],
-    simpa using Fs.trans su },
-  have h_μ_sdiff : μ (u \ F) ≤ 2 * η,
-  { have hFμ : μ F < ⊤ := (measure_mono Fs).trans_lt hsμ,
-    refine ennreal.le_of_add_le_add_left hFμ.ne _,
-    have : μ u < μ F + ↑η + ↑η,
-      from μu.trans (ennreal.add_lt_add_right ennreal.coe_ne_top μF),
-    convert this.le using 1,
-    { rw [add_comm, ← measure_union, set.diff_union_of_subset (Fs.trans su)],
-      exacts [disjoint_sdiff_self_left, F_closed.measurable_set] },
-    have : (2:ℝ≥0∞) * η = η + η := by simpa using add_mul (1:ℝ≥0∞) 1 η,
-    rw this,
-    abel },
-  -- Apply Urysohn's lemma to get a continuous approximation to the characteristic function of
-  -- the set `s`
-  obtain ⟨g, hgu, hgF, hg_range⟩ :=
-    exists_continuous_zero_one_of_closed u_open.is_closed_compl F_closed this,
-  -- Multiply this by `c` to get a continuous approximation to the function `f`; the key point is
-  -- that this is pointwise bounded by the indicator of the set `u \ F`
-  have g_norm : ∀ x, ∥g x∥ = g x := λ x, by rw [real.norm_eq_abs, abs_of_nonneg (hg_range x).1],
-  have gc_bd : ∀ x, ∥g x • c - s.indicator (λ x, c) x∥ ≤ ∥(u \ F).indicator (λ x, bit0 ∥c∥) x∥,
-  { intros x,
-    by_cases hu : x ∈ u,
-    { rw ← set.diff_union_of_subset (Fs.trans su) at hu,
-      cases hu with hFu hF,
-      { refine (norm_sub_le _ _).trans _,
-        refine (add_le_add_left (norm_indicator_le_norm_self (λ x, c) x) _).trans _,
-        have h₀ : g x * ∥c∥ + ∥c∥ ≤ 2 * ∥c∥,
-        { nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c] },
-        have h₁ : (2:ℝ) * ∥c∥ = bit0 (∥c∥) := by simpa using add_mul (1:ℝ) 1 (∥c∥),
-        simp [hFu, norm_smul, h₀, ← h₁, g_norm x] },
-      { simp [hgF hF, Fs hF] } },
-    { have : x ∉ s := λ h, hu (su h),
-      simp [hgu hu, this] } },
-  -- The rest is basically just `ennreal`-arithmetic
-  have gc_snorm : snorm ((λ x, g x • c) - s.indicator (λ x, c)) p μ
-    ≤ (↑(∥bit0 (∥c∥)∥₊ * (2 * η) ^ (1 / p.to_real)) : ℝ≥0∞),
-  { refine (snorm_mono_ae (filter.eventually_of_forall gc_bd)).trans _,
-    rw snorm_indicator_const (u_open.sdiff F_closed).measurable_set hp₀.ne' hp,
-    push_cast [← ennreal.coe_rpow_of_nonneg _ hp₀'],
-    exact ennreal.mul_left_mono (ennreal.monotone_rpow_of_nonneg hp₀' h_μ_sdiff) },
-  have gc_cont : continuous (λ x, g x • c) := g.continuous.smul continuous_const,
-  have gc_mem_ℒp : mem_ℒp (λ x, g x • c) p μ,
-  { have : mem_ℒp ((λ x, g x • c) - s.indicator (λ x, c)) p μ :=
-    ⟨gc_cont.ae_strongly_measurable.sub (strongly_measurable_const.indicator hs)
-        .ae_strongly_measurable,
-      gc_snorm.trans_lt ennreal.coe_lt_top⟩,
-    simpa using this.add (mem_ℒp_indicator_const p hs c (or.inr hsμ.ne)) },
-  refine ⟨gc_mem_ℒp.to_Lp _, _, _⟩,
-  { rw mem_closed_ball_iff_norm,
-    refine le_trans _ hη_le,
-    rw [simple_func.coe_indicator_const, indicator_const_Lp, ← mem_ℒp.to_Lp_sub, Lp.norm_to_Lp],
-    exact ennreal.to_real_le_coe_of_le_coe gc_snorm },
-  { rw [set_like.mem_coe, mem_bounded_continuous_function_iff],
-    refine ⟨bounded_continuous_function.of_normed_group _ gc_cont (∥c∥) _, rfl⟩,
-    intros x,
-    have h₀ : g x * ∥c∥ ≤ ∥c∥,
-    { nlinarith [(hg_range x).1, (hg_range x).2, norm_nonneg c] },
-    simp [norm_smul, g_norm x, h₀] },
+  have A : ennreal.of_real ε ≠ 0, by simp only [ne.def, ennreal.of_real_eq_zero, not_le, hε],
+  obtain ⟨g, hg, g_mem⟩ : ∃ (g : α →ᵇ E), snorm (f - g) p μ ≤ ennreal.of_real ε ∧ mem_ℒp g p μ,
+    from (Lp.mem_ℒp f).exists_bounded_continuous_snorm_sub_le hp A,
+  refine ⟨g_mem.to_Lp _, _, ⟨g, rfl⟩⟩,
+  simp only [dist_eq_norm, metric.mem_closed_ball'],
+  rw Lp.norm_def,
+  convert ennreal.to_real_le_of_le_of_real hε.le hg using 2,
+  apply snorm_congr_ae,
+  filter_upwards [coe_fn_sub f (g_mem.to_Lp g), g_mem.coe_fn_to_Lp] with x hx h'x,
+  simp only [hx, pi.sub_apply, sub_right_inj, h'x],
 end
 
-end measure_theory.Lp
+end Lp
 
+end measure_theory
+
+variables [second_countable_topology_either α E] [_i : fact (1 ≤ p)] (hp : p ≠ ∞)
 variables (𝕜 : Type*) [normed_field 𝕜] [normed_algebra ℝ 𝕜] [normed_space 𝕜 E]
+include _i hp
+variables (E) (μ)
 
 namespace bounded_continuous_function
 
@@ -174,7 +354,8 @@ lemma to_Lp_dense_range [μ.weakly_regular] [is_finite_measure μ] :
 begin
   haveI : normed_space ℝ E := restrict_scalars.normed_space ℝ 𝕜 E,
   rw dense_range_iff_closure_range,
-  suffices : (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ).range.to_add_subgroup.topological_closure = ⊤,
+  suffices : (linear_map.range (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ))
+    .to_add_subgroup.topological_closure = ⊤,
   { exact congr_arg coe this },
   simp [range_to_Lp p μ, measure_theory.Lp.bounded_continuous_function_dense E hp],
 end
@@ -188,7 +369,8 @@ lemma to_Lp_dense_range [compact_space α] [μ.weakly_regular] [is_finite_measur
 begin
   haveI : normed_space ℝ E := restrict_scalars.normed_space ℝ 𝕜 E,
   rw dense_range_iff_closure_range,
-  suffices : (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ).range.to_add_subgroup.topological_closure = ⊤,
+  suffices : (linear_map.range (to_Lp p μ 𝕜 : _ →L[𝕜] Lp E p μ))
+    .to_add_subgroup.topological_closure = ⊤,
   { exact congr_arg coe this },
   simp [range_to_Lp p μ, measure_theory.Lp.bounded_continuous_function_dense E hp]
 end
diff --git a/src/measure_theory/function/convergence_in_measure.lean b/src/measure_theory/function/convergence_in_measure.lean
index a641cdf84b018..823d8e060d4c4 100644
--- a/src/measure_theory/function/convergence_in_measure.lean
+++ b/src/measure_theory/function/convergence_in_measure.lean
@@ -3,12 +3,16 @@ Copyright (c) 2022 Rémy Degenne, Kexing Ying. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne, Kexing Ying
 -/
-
+import analysis.special_functions.pow.real
 import measure_theory.function.egorov
+import measure_theory.function.lp_space
 
 /-!
 # Convergence in measure
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define convergence in measure which is one of the many notions of convergence in probability.
 A sequence of functions `f` is said to converge in measure to some function `g`
 if for all `ε > 0`, the measure of the set `{x | ε ≤ dist (f i x) (g x)}` tends to 0 as `i`
@@ -36,7 +40,7 @@ convergence in measure and other notions of convergence.
 -/
 
 open topological_space filter
-open_locale nnreal ennreal measure_theory topological_space
+open_locale nnreal ennreal measure_theory topology
 
 namespace measure_theory
 
@@ -49,10 +53,10 @@ def tendsto_in_measure [has_dist E] {m : measurable_space α}
   (μ : measure α) (f : ι → α → E) (l : filter ι) (g : α → E) : Prop :=
 ∀ ε (hε : 0 < ε), tendsto (λ i, μ {x | ε ≤ dist (f i x) (g x)}) l (𝓝 0)
 
-lemma tendsto_in_measure_iff_norm [semi_normed_group E] {l : filter ι}
+lemma tendsto_in_measure_iff_norm [seminormed_add_comm_group E] {l : filter ι}
   {f : ι → α → E} {g : α → E} :
   tendsto_in_measure μ f l g
-  ↔ ∀ ε (hε : 0 < ε), tendsto (λ i, μ {x | ε ≤ ∥f i x - g x∥}) l (𝓝 0) :=
+  ↔ ∀ ε (hε : 0 < ε), tendsto (λ i, μ {x | ε ≤ ‖f i x - g x‖}) l (𝓝 0) :=
 by simp_rw [tendsto_in_measure, dist_eq_norm]
 
 namespace tendsto_in_measure
@@ -115,7 +119,7 @@ begin
   suffices : {x : α | ε ≤ dist (f n x) (g x)} ⊆ t, from (measure_mono this).trans ht,
   rw ← set.compl_subset_compl,
   intros x hx,
-  rw [set.mem_compl_eq, set.nmem_set_of_eq, dist_comm, not_le],
+  rw [set.mem_compl_iff, set.nmem_set_of_iff, dist_comm, not_le],
   exact hN n hn x hx,
 end
 
@@ -217,13 +221,13 @@ begin
   { refine λ x hx, metric.tendsto_at_top.mpr (λ ε hε, _),
     rw [hs, limsup_eq_infi_supr_of_nat] at hx,
     simp only [set.supr_eq_Union, set.infi_eq_Inter, set.compl_Inter, set.compl_Union,
-      set.mem_Union, set.mem_Inter, set.mem_compl_eq, set.mem_set_of_eq, not_le] at hx,
+      set.mem_Union, set.mem_Inter, set.mem_compl_iff, set.mem_set_of_eq, not_le] at hx,
     obtain ⟨N, hNx⟩ := hx,
     obtain ⟨k, hk_lt_ε⟩ := h_lt_ε_real ε hε,
     refine ⟨max N (k - 1), λ n hn_ge, lt_of_le_of_lt _ hk_lt_ε⟩,
     specialize hNx n ((le_max_left _ _).trans hn_ge),
     have h_inv_n_le_k : (2 : ℝ)⁻¹ ^ n ≤ 2 * 2⁻¹ ^ k,
-    { rw [mul_comm, ← inv_mul_le_iff' (@two_pos ℝ _ _)],
+    { rw [mul_comm, ← inv_mul_le_iff' (zero_lt_two' ℝ)],
       conv_lhs { congr, rw ← pow_one (2 : ℝ)⁻¹ },
       rw [← pow_add, add_comm],
       exact pow_le_pow_of_le_one ((one_div (2 : ℝ)) ▸ one_half_pos.le) (inv_le_one one_le_two)
@@ -259,7 +263,7 @@ end exists_seq_tendsto_ae
 
 section ae_measurable_of
 
-variables [measurable_space E] [normed_group E] [borel_space E]
+variables [measurable_space E] [normed_add_comm_group E] [borel_space E]
 
 lemma tendsto_in_measure.ae_measurable
   {u : filter ι} [ne_bot u] [is_countably_generated u]
@@ -268,14 +272,14 @@ lemma tendsto_in_measure.ae_measurable
   ae_measurable g μ :=
 begin
   obtain ⟨ns, hns⟩ := h_tendsto.exists_seq_tendsto_ae',
-  exact ae_measurable_of_tendsto_metric_ae at_top (λ n, hf (ns n)) hns,
+  exact ae_measurable_of_tendsto_metrizable_ae at_top (λ n, hf (ns n)) hns,
 end
 
 end ae_measurable_of
 
 section tendsto_in_measure_of
 
-variables [normed_group E] {p : ℝ≥0∞}
+variables [normed_add_comm_group E] {p : ℝ≥0∞}
 variables {f : ι → α → E} {g : α → E}
 
 /-- This lemma is superceded by `measure_theory.tendsto_in_measure_of_tendsto_snorm` where we
@@ -326,8 +330,8 @@ end
 
 /-- See also `measure_theory.tendsto_in_measure_of_tendsto_snorm` which work for general
 Lp-convergence for all `p ≠ 0`. -/
-lemma tendsto_in_measure_of_tendsto_snorm_top {E} [normed_group E] {f : ι → α → E} {g : α → E}
-  {l : filter ι} (hfg : tendsto (λ n, snorm (f n - g) ∞ μ) l (𝓝 0)) :
+lemma tendsto_in_measure_of_tendsto_snorm_top {E} [normed_add_comm_group E] {f : ι → α → E}
+  {g : α → E} {l : filter ι} (hfg : tendsto (λ n, snorm (f n - g) ∞ μ) l (𝓝 0)) :
   tendsto_in_measure μ f l g :=
 begin
   intros δ hδ,
@@ -339,13 +343,13 @@ begin
   refine hfg.mono (λ n hn, _),
   simp only [true_and, gt_iff_lt, ge_iff_le, zero_tsub, zero_le, zero_add, set.mem_Icc,
     pi.sub_apply] at *,
-  have : ess_sup (λ (x : α), (∥f n x - g x∥₊ : ℝ≥0∞)) μ < ennreal.of_real δ :=
+  have : ess_sup (λ (x : α), (‖f n x - g x‖₊ : ℝ≥0∞)) μ < ennreal.of_real δ :=
     lt_of_le_of_lt hn (ennreal.half_lt_self (ennreal.of_real_pos.2 hδ).ne.symm
       ennreal.of_real_lt_top.ne),
   refine ((le_of_eq _).trans (ae_lt_of_ess_sup_lt this).le).trans hε.le,
   congr' with x,
   simp only [ennreal.of_real_le_iff_le_to_real ennreal.coe_lt_top.ne, ennreal.coe_to_real,
-    not_lt, coe_nnnorm, set.mem_set_of_eq, set.mem_compl_eq],
+    not_lt, coe_nnnorm, set.mem_set_of_eq, set.mem_compl_iff],
   rw ← dist_eq_norm (f n x) (g x),
   refl
 end
@@ -366,7 +370,7 @@ end
 lemma tendsto_in_measure_of_tendsto_Lp [hp : fact (1 ≤ p)]
   {f : ι → Lp E p μ} {g : Lp E p μ} {l : filter ι} (hfg : tendsto f l (𝓝 g)) :
   tendsto_in_measure μ (λ n, f n) l g :=
-tendsto_in_measure_of_tendsto_snorm (ennreal.zero_lt_one.trans_le hp.elim).ne.symm
+tendsto_in_measure_of_tendsto_snorm (zero_lt_one.trans_le hp.elim).ne.symm
   (λ n, Lp.ae_strongly_measurable _) (Lp.ae_strongly_measurable _)
   ((Lp.tendsto_Lp_iff_tendsto_ℒp' _ _).mp hfg)
 
diff --git a/src/measure_theory/function/egorov.lean b/src/measure_theory/function/egorov.lean
index a982920ffed55..d6d2f6c83c226 100644
--- a/src/measure_theory/function/egorov.lean
+++ b/src/measure_theory/function/egorov.lean
@@ -3,11 +3,14 @@ Copyright (c) 2022 Kexing Ying. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kexing Ying
 -/
-import measure_theory.integral.set_integral
+import measure_theory.function.strongly_measurable.basic
 
 /-!
 # Egorov theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the Egorov theorem which states that an almost everywhere convergent
 sequence on a finite measure space converges uniformly except on an arbitrarily small set.
 This theorem is useful for the Vitali convergence theorem as well as theorems regarding
@@ -21,7 +24,7 @@ convergence in measure.
 -/
 
 noncomputable theory
-open_locale classical measure_theory nnreal ennreal topological_space
+open_locale classical measure_theory nnreal ennreal topology
 
 namespace measure_theory
 
@@ -56,7 +59,7 @@ begin
   simp_rw [metric.tendsto_at_top, ae_iff] at hfg,
   rw [← nonpos_iff_eq_zero, ← hfg],
   refine measure_mono (λ x, _),
-  simp only [mem_inter_eq, mem_Inter, ge_iff_le, mem_not_convergent_seq_iff],
+  simp only [mem_inter_iff, mem_Inter, ge_iff_le, mem_not_convergent_seq_iff],
   push_neg,
   rintro ⟨hmem, hx⟩,
   refine ⟨hmem, 1 / (n + 1 : ℝ), nat.one_div_pos_of_nat, λ N, _⟩,
@@ -64,13 +67,13 @@ begin
   exact ⟨n, hn₁, hn₂.le⟩
 end
 
-lemma not_convergent_seq_measurable_set [preorder ι] [encodable ι]
+lemma not_convergent_seq_measurable_set [preorder ι] [countable ι]
   (hf : ∀ n, strongly_measurable[m] (f n)) (hg : strongly_measurable g) :
   measurable_set (not_convergent_seq f g n j) :=
-measurable_set.Union (λ k, measurable_set.Union_Prop $ λ hk,
+measurable_set.Union (λ k, measurable_set.Union $ λ hk,
   strongly_measurable.measurable_set_lt strongly_measurable_const $ (hf k).dist hg)
 
-lemma measure_not_convergent_seq_tendsto_zero [semilattice_sup ι] [encodable ι]
+lemma measure_not_convergent_seq_tendsto_zero [semilattice_sup ι] [countable ι]
   (hf : ∀ n, strongly_measurable (f n)) (hg : strongly_measurable g)
   (hsm : measurable_set s) (hs : μ s ≠ ∞)
   (hfg : ∀ᵐ x ∂μ, x ∈ s → tendsto (λ n, f n x) at_top (𝓝 (g x))) (n : ℕ) :
@@ -87,7 +90,7 @@ begin
     ⟨h.some, (lt_of_le_of_lt (measure_mono $ inter_subset_left _ _) (lt_top_iff_ne_top.2 hs)).ne⟩,
 end
 
-variables [semilattice_sup ι] [nonempty ι] [encodable ι]
+variables [semilattice_sup ι] [nonempty ι] [countable ι]
 
 lemma exists_not_convergent_seq_lt (hε : 0 < ε)
   (hf : ∀ n, strongly_measurable (f n)) (hg : strongly_measurable g)
@@ -179,7 +182,7 @@ begin
   obtain ⟨N, hN⟩ := exists_nat_one_div_lt hδ,
   rw eventually_at_top,
   refine ⟨egorov.not_convergent_seq_lt_index (half_pos hε) hf hg hsm hs hfg N, λ n hn x hx, _⟩,
-  simp only [mem_diff, egorov.Union_not_convergent_seq, not_exists, mem_Union, mem_inter_eq,
+  simp only [mem_diff, egorov.Union_not_convergent_seq, not_exists, mem_Union, mem_inter_iff,
     not_and, exists_and_distrib_left] at hx,
   obtain ⟨hxs, hx⟩ := hx,
   specialize hx hxs N,
@@ -191,14 +194,14 @@ end
 
 end egorov
 
-variables [semilattice_sup ι] [nonempty ι] [encodable ι]
+variables [semilattice_sup ι] [nonempty ι] [countable ι]
   {γ : Type*} [topological_space γ]
   {f : ι → α → β} {g : α → β} {s : set α}
 
 /-- **Egorov's theorem**: If `f : ι → α → β` is a sequence of strongly measurable functions that
 converges to `g : α → β` almost everywhere on a measurable set `s` of finite measure,
 then for all `ε > 0`, there exists a subset `t ⊆ s` such that `μ t ≤ ε` and `f` converges to `g`
-uniformly on `s \ t`. We require the index type `ι` to be encodable, and usually `ι = ℕ`.
+uniformly on `s \ t`. We require the index type `ι` to be countable, and usually `ι = ℕ`.
 
 In other words, a sequence of almost everywhere convergent functions converges uniformly except on
 an arbitrarily small set. -/
diff --git a/src/measure_theory/function/ess_sup.lean b/src/measure_theory/function/ess_sup.lean
index 469004444c966..101cfc2794317 100644
--- a/src/measure_theory/function/ess_sup.lean
+++ b/src/measure_theory/function/ess_sup.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Rémy Degenne. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
 import order.filter.ennreal
 
 /-!
 # Essential supremum and infimum
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 We define the essential supremum and infimum of a function `f : α → β` with respect to a measure
 `μ` on `α`. The essential supremum is the infimum of the constants `c : β` such that `f x ≤ c`
 almost everywhere.
@@ -26,8 +29,8 @@ sense). We do not define that quantity here, which is simply the supremum of a m
 * `ess_inf f μ := μ.ae.liminf f`
 -/
 
-open measure_theory filter topological_space
-open_locale ennreal measure_theory
+open measure_theory filter set topological_space
+open_locale ennreal measure_theory nnreal
 
 variables {α β : Type*} {m : measurable_space α} {μ ν : measure α}
 
@@ -48,19 +51,53 @@ limsup_congr hfg
 lemma ess_inf_congr_ae {f g : α → β} (hfg : f =ᵐ[μ] g) :  ess_inf f μ = ess_inf g μ :=
 @ess_sup_congr_ae α βᵒᵈ _ _ _ _ _ hfg
 
+@[simp] lemma ess_sup_const' [μ.ae.ne_bot] (c : β) : ess_sup (λ x : α, c) μ = c := limsup_const _
+@[simp] lemma ess_inf_const' [μ.ae.ne_bot] (c : β) : ess_inf (λ x : α, c) μ = c := liminf_const _
+
+lemma ess_sup_const (c : β) (hμ : μ ≠ 0) : ess_sup (λ x : α, c) μ = c :=
+by { rw ←ae_ne_bot at hμ, exactI ess_sup_const' _ }
+
+lemma ess_inf_const (c : β) (hμ : μ ≠ 0) : ess_inf (λ x : α, c) μ = c :=
+by { rw ←ae_ne_bot at hμ, exactI ess_inf_const' _ }
+
 end conditionally_complete_lattice
 
 section conditionally_complete_linear_order
-variable [conditionally_complete_linear_order β]
+variables [conditionally_complete_linear_order β] {x : β} {f : α → β}
 
 lemma ess_sup_eq_Inf {m : measurable_space α} (μ : measure α) (f : α → β) :
   ess_sup f μ = Inf {a | μ {x | a < f x} = 0} :=
-begin
-  dsimp [ess_sup, limsup, Limsup],
-  congr,
-  ext a,
-  simp [eventually_map, ae_iff],
-end
+by { dsimp [ess_sup, limsup, Limsup], simp only [ae_iff, not_le] }
+
+lemma ess_inf_eq_Sup {m : measurable_space α} (μ : measure α) (f : α → β) :
+  ess_inf f μ = Sup {a | μ {x | f x < a} = 0} :=
+by { dsimp [ess_inf, liminf, Liminf], simp only [ae_iff, not_le] }
+
+lemma ae_lt_of_ess_sup_lt (hx : ess_sup f μ < x)
+  (hf : is_bounded_under (≤) μ.ae f . is_bounded_default) : ∀ᵐ y ∂μ, f y < x :=
+eventually_lt_of_limsup_lt hx hf
+
+lemma ae_lt_of_lt_ess_inf (hx : x < ess_inf f μ)
+  (hf : is_bounded_under (≥) μ.ae f . is_bounded_default) : ∀ᵐ y ∂μ, x < f y :=
+eventually_lt_of_lt_liminf hx hf
+
+variables [topological_space β] [first_countable_topology β] [order_topology β]
+
+lemma ae_le_ess_sup (hf : is_bounded_under (≤) μ.ae f . is_bounded_default) :
+  ∀ᵐ y ∂μ, f y ≤ ess_sup f μ :=
+eventually_le_limsup hf
+
+lemma ae_ess_inf_le (hf : is_bounded_under (≥) μ.ae f . is_bounded_default) :
+  ∀ᵐ y ∂μ, ess_inf f μ ≤ f y :=
+eventually_liminf_le hf
+
+lemma meas_ess_sup_lt (hf : is_bounded_under (≤) μ.ae f . is_bounded_default) :
+  μ {y | ess_sup f μ < f y} = 0 :=
+by { simp_rw ←not_le, exact ae_le_ess_sup hf }
+
+lemma meas_lt_ess_inf (hf : is_bounded_under (≥) μ.ae f . is_bounded_default) :
+  μ {y | f y < ess_inf f μ} = 0 :=
+by { simp_rw ←not_le, exact ae_ess_inf_le hf }
 
 end conditionally_complete_linear_order
 
@@ -81,12 +118,6 @@ limsup_le_limsup hfg
 lemma ess_inf_mono_ae {f g : α → β} (hfg : f ≤ᵐ[μ] g) : ess_inf f μ ≤ ess_inf g μ :=
 liminf_le_liminf hfg
 
-lemma ess_sup_const (c : β) (hμ : μ ≠ 0) : ess_sup (λ x : α, c) μ = c :=
-begin
-  haveI hμ_ne_bot : μ.ae.ne_bot, { rwa [ne_bot_iff, ne.def, ae_eq_bot] },
-  exact limsup_const c,
-end
-
 lemma ess_sup_le_of_ae_le {f : α → β} (c : β) (hf : f ≤ᵐ[μ] (λ _, c)) : ess_sup f μ ≤ c :=
 begin
   refine (ess_sup_mono_ae hf).trans _,
@@ -95,9 +126,6 @@ begin
   { rwa ess_sup_const, },
 end
 
-lemma ess_inf_const (c : β) (hμ : μ ≠ 0) : ess_inf (λ x : α, c) μ = c :=
-@ess_sup_const α βᵒᵈ _ _ _ _ hμ
-
 lemma le_ess_inf_of_ae_le {f : α → β} (c : β) (hf : (λ _, c) ≤ᵐ[μ] f) : c ≤ ess_inf f μ :=
 @ess_sup_le_of_ae_le α βᵒᵈ _ _ _ _ c hf
 
@@ -203,12 +231,6 @@ end complete_lattice
 section complete_linear_order
 variable [complete_linear_order β]
 
-lemma ae_lt_of_ess_sup_lt {f : α → β} {x : β} (hf : ess_sup f μ < x) : ∀ᵐ y ∂μ, f y < x :=
-filter.eventually_lt_of_limsup_lt hf
-
-lemma ae_lt_of_lt_ess_inf {f : α → β} {x : β} (hf : x < ess_inf f μ) : ∀ᵐ y ∂μ, x < f y :=
-@ae_lt_of_ess_sup_lt α βᵒᵈ _ _ _ _ _ hf
-
 lemma ess_sup_indicator_eq_ess_sup_restrict [has_zero β] {s : set α}
   {f : α → β} (hf : 0 ≤ᵐ[μ.restrict s] f) (hs : measurable_set s) (hs_not_null : μ s ≠ 0) :
   ess_sup (s.indicator f) μ = ess_sup f (μ.restrict s) :=
@@ -219,7 +241,7 @@ begin
   rw eventually_map at h_restrict_le ⊢,
   rw ae_restrict_iff' hs at h_restrict_le,
   have hc : 0 ≤ c,
-  { suffices : ∃ x, 0 ≤ f x ∧ f x ≤ c, by { obtain ⟨x, hx⟩ := this, exact hx.1.trans hx.2, },
+  { rsuffices ⟨x, hx⟩ : ∃ x, 0 ≤ f x ∧ f x ≤ c, from hx.1.trans hx.2,
     refine frequently.exists _,
     { exact μ.ae, },
     rw [eventually_le, ae_restrict_iff' hs] at hf,
@@ -252,11 +274,19 @@ limsup_eq_zero_iff
 lemma ess_sup_const_mul {a : ℝ≥0∞} : ess_sup (λ (x : α), a * (f x)) μ = a * ess_sup f μ :=
 limsup_const_mul
 
+lemma ess_sup_mul_le (f g : α → ℝ≥0∞) : ess_sup (f * g) μ ≤ ess_sup f μ * ess_sup g μ :=
+limsup_mul_le f g
+
 lemma ess_sup_add_le (f g : α → ℝ≥0∞) : ess_sup (f + g) μ ≤ ess_sup f μ + ess_sup g μ :=
 limsup_add_le f g
 
-lemma ess_sup_liminf_le {ι} [encodable ι] [linear_order ι] (f : ι → α → ℝ≥0∞) :
+lemma ess_sup_liminf_le {ι} [countable ι] [linear_order ι] (f : ι → α → ℝ≥0∞) :
   ess_sup (λ x, at_top.liminf (λ n, f n x)) μ ≤ at_top.liminf (λ n, ess_sup (λ x, f n x) μ) :=
 by { simp_rw ess_sup, exact ennreal.limsup_liminf_le_liminf_limsup (λ a b, f b a), }
 
+lemma coe_ess_sup {f : α → ℝ≥0} (hf : is_bounded_under (≤) μ.ae f) :
+  (↑(ess_sup f μ) : ℝ≥0∞) = ess_sup (λ x, f x) μ :=
+(ennreal.coe_Inf $ by exact hf).trans $ eq_of_forall_le_iff $ λ r,
+  by simp [ess_sup, limsup, Limsup, eventually_map, ennreal.forall_ennreal]
+
 end ennreal
diff --git a/src/measure_theory/function/floor.lean b/src/measure_theory/function/floor.lean
index a14bb132cedf7..1f7c974ad0c6e 100644
--- a/src/measure_theory/function/floor.lean
+++ b/src/measure_theory/function/floor.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
 
 /-!
 # Measurability of `⌊x⌋` etc
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that `int.floor`, `int.ceil`, `int.fract`, `nat.floor`, and `nat.ceil` are
 measurable under some assumptions on the (semi)ring.
 -/
@@ -21,7 +24,7 @@ variables {α R : Type*} [measurable_space α] [linear_ordered_ring R] [floor_ri
 
 lemma int.measurable_floor [opens_measurable_space R] :
   measurable (int.floor : R → ℤ) :=
-measurable_to_encodable $ λ x, by simpa only [int.preimage_floor_singleton]
+measurable_to_countable $ λ x, by simpa only [int.preimage_floor_singleton]
   using measurable_set_Ico
 
 @[measurability] lemma measurable.floor [opens_measurable_space R]
@@ -30,7 +33,7 @@ int.measurable_floor.comp hf
 
 lemma int.measurable_ceil [opens_measurable_space R] :
   measurable (int.ceil : R → ℤ) :=
-measurable_to_encodable $ λ x,
+measurable_to_countable $ λ x,
   by simpa only [int.preimage_ceil_singleton] using measurable_set_Ioc
 
 @[measurability] lemma measurable.ceil [opens_measurable_space R]
@@ -64,13 +67,13 @@ variables {α R : Type*} [measurable_space α] [linear_ordered_semiring R] [floo
   {f : α → R}
 
 lemma nat.measurable_floor : measurable (nat.floor : R → ℕ) :=
-measurable_to_encodable $ λ n, by cases eq_or_ne ⌊n⌋₊ 0; simp [*, nat.preimage_floor_of_ne_zero]
+measurable_to_countable $ λ n, by cases eq_or_ne ⌊n⌋₊ 0; simp [*, nat.preimage_floor_of_ne_zero]
 
 @[measurability] lemma measurable.nat_floor (hf : measurable f) : measurable (λ x, ⌊f x⌋₊) :=
 nat.measurable_floor.comp hf
 
 lemma nat.measurable_ceil : measurable (nat.ceil : R → ℕ) :=
-measurable_to_encodable $ λ n, by cases eq_or_ne ⌈n⌉₊ 0; simp [*, nat.preimage_ceil_of_ne_zero]
+measurable_to_countable $ λ n, by cases eq_or_ne ⌈n⌉₊ 0; simp [*, nat.preimage_ceil_of_ne_zero]
 
 @[measurability] lemma measurable.nat_ceil (hf : measurable f) : measurable (λ x, ⌈f x⌉₊) :=
 nat.measurable_ceil.comp hf
diff --git a/src/measure_theory/function/jacobian.lean b/src/measure_theory/function/jacobian.lean
index 9a85c2426f01f..c7469efe8f991 100644
--- a/src/measure_theory/function/jacobian.lean
+++ b/src/measure_theory/function/jacobian.lean
@@ -3,15 +3,19 @@ Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
+import analysis.calculus.inverse
+import measure_theory.constructions.borel_space.continuous_linear_map
 import measure_theory.covering.besicovitch_vector_space
-import measure_theory.measure.haar_lebesgue
+import measure_theory.measure.lebesgue.eq_haar
 import analysis.normed_space.pointwise
-import measure_theory.covering.differentiation
 import measure_theory.constructions.polish
 
 /-!
 # Change of variables in higher-dimensional integrals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `μ` be a Lebesgue measure on a finite-dimensional real vector space `E`.
 Let `f : E → E` be a function which is injective and differentiable on a measurable set `s`,
 with derivative `f'`. Then we prove that `f '' s` is measurable, and
@@ -87,10 +91,10 @@ Change of variables in integrals
 
 open measure_theory measure_theory.measure metric filter set finite_dimensional asymptotics
 topological_space
-open_locale nnreal ennreal topological_space pointwise
+open_locale nnreal ennreal topology pointwise
 
-variables {E F : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
-[normed_group F] [normed_space ℝ F] {s : set E} {f : E → E} {f' : E → E →L[ℝ] E}
+variables {E F : Type*} [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+[normed_add_comm_group F] [normed_space ℝ F] {s : set E} {f : E → E} {f' : E → E →L[ℝ] E}
 
 /-!
 ### Decomposition lemmas
@@ -124,7 +128,7 @@ begin
     simp },
   -- we will use countably many linear maps. Select these from all the derivatives since the
   -- space of linear maps is second-countable
-  obtain ⟨T, T_count, hT⟩ : ∃ T : set s, countable T ∧
+  obtain ⟨T, T_count, hT⟩ : ∃ T : set s, T.countable ∧
     (⋃ x ∈ T, ball (f' (x : E)) (r (f' x))) = ⋃ (x : s), ball (f' x) (r (f' x)) :=
     topological_space.is_open_Union_countable _ (λ x, is_open_ball),
   -- fix a sequence `u` of positive reals tending to zero.
@@ -134,7 +138,7 @@ begin
   -- `M n z` is the set of points `x` such that `f y - f x` is close to `f' z (y - x)` for `y`
   -- in the ball of radius `u n` around `x`.
   let M : ℕ → T → set E := λ n z, {x | x ∈ s ∧
-    ∀ y ∈ s ∩ ball x (u n), ∥f y - f x - f' z (y - x)∥ ≤ r (f' z) * ∥y - x∥},
+    ∀ y ∈ s ∩ ball x (u n), ‖f y - f x - f' z (y - x)‖ ≤ r (f' z) * ‖y - x‖},
   -- As `f` is differentiable everywhere on `s`, the sets `M n z` cover `s` by design.
   have s_subset : ∀ x ∈ s, ∃ (n : ℕ) (z : T), x ∈ M n z,
   { assume x xs,
@@ -144,30 +148,30 @@ begin
         refine mem_Union.2 ⟨⟨x, xs⟩, _⟩,
         simpa only [mem_ball, subtype.coe_mk, dist_self] using (rpos (f' x)).bot_lt },
       rwa mem_Union₂ at this },
-    obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ), 0 < ε ∧ ∥f' x - f' z∥ + ε ≤ r (f' z),
-    { refine ⟨r (f' z) - ∥f' x - f' z∥, _, le_of_eq (by abel)⟩,
+    obtain ⟨ε, εpos, hε⟩ : ∃ (ε : ℝ), 0 < ε ∧ ‖f' x - f' z‖ + ε ≤ r (f' z),
+    { refine ⟨r (f' z) - ‖f' x - f' z‖, _, le_of_eq (by abel)⟩,
       simpa only [sub_pos] using mem_ball_iff_norm.mp hz },
     obtain ⟨δ, δpos, hδ⟩ : ∃ (δ : ℝ) (H : 0 < δ),
-      ball x δ ∩ s ⊆ {y | ∥f y - f x - (f' x) (y - x)∥ ≤ ε * ∥y - x∥} :=
+      ball x δ ∩ s ⊆ {y | ‖f y - f x - (f' x) (y - x)‖ ≤ ε * ‖y - x‖} :=
         metric.mem_nhds_within_iff.1 (is_o.def (hf' x xs) εpos),
     obtain ⟨n, hn⟩ : ∃ n, u n < δ := ((tendsto_order.1 u_lim).2 _ δpos).exists,
     refine ⟨n, ⟨z, zT⟩, ⟨xs, _⟩⟩,
     assume y hy,
-    calc ∥f y - f x - (f' z) (y - x)∥
-        = ∥(f y - f x - (f' x) (y - x)) + (f' x - f' z) (y - x)∥ :
+    calc ‖f y - f x - (f' z) (y - x)‖
+        = ‖(f y - f x - (f' x) (y - x)) + (f' x - f' z) (y - x)‖ :
       begin
         congr' 1,
         simp only [continuous_linear_map.coe_sub', map_sub, pi.sub_apply],
         abel,
       end
-    ... ≤ ∥f y - f x - (f' x) (y - x)∥ + ∥(f' x - f' z) (y - x)∥ : norm_add_le _ _
-    ... ≤ ε * ∥y - x∥ + ∥f' x - f' z∥ * ∥y - x∥ :
+    ... ≤ ‖f y - f x - (f' x) (y - x)‖ + ‖(f' x - f' z) (y - x)‖ : norm_add_le _ _
+    ... ≤ ε * ‖y - x‖ + ‖f' x - f' z‖ * ‖y - x‖ :
       begin
         refine add_le_add (hδ _) (continuous_linear_map.le_op_norm _ _),
         rw inter_comm,
         exact inter_subset_inter_right _ (ball_subset_ball hn.le) hy,
       end
-    ... ≤ r (f' z) * ∥y - x∥ :
+    ... ≤ r (f' z) * ‖y - x‖ :
       begin
         rw [← add_mul, add_comm],
         exact mul_le_mul_of_nonneg_right hε (norm_nonneg _),
@@ -179,8 +183,8 @@ begin
     refine ⟨xs, λ y hy, _⟩,
     obtain ⟨a, aM, a_lim⟩ : ∃ (a : ℕ → E), (∀ k, a k ∈ M n z) ∧ tendsto a at_top (𝓝 x) :=
       mem_closure_iff_seq_limit.1 hx,
-    have L1 : tendsto (λ (k : ℕ), ∥f y - f (a k) - (f' z) (y - a k)∥) at_top
-      (𝓝 ∥f y - f x - (f' z) (y - x)∥),
+    have L1 : tendsto (λ (k : ℕ), ‖f y - f (a k) - (f' z) (y - a k)‖) at_top
+      (𝓝 ‖f y - f x - (f' z) (y - x)‖),
     { apply tendsto.norm,
       have L : tendsto (λ k, f (a k)) at_top (𝓝 (f x)),
       { apply (hf' x xs).continuous_within_at.tendsto.comp,
@@ -188,9 +192,9 @@ begin
         exact eventually_of_forall (λ k, (aM k).1) },
       apply tendsto.sub (tendsto_const_nhds.sub L),
       exact ((f' z).continuous.tendsto _).comp (tendsto_const_nhds.sub a_lim) },
-    have L2 : tendsto (λ (k : ℕ), (r (f' z) : ℝ) * ∥y - a k∥) at_top (𝓝 (r (f' z) * ∥y - x∥)) :=
+    have L2 : tendsto (λ (k : ℕ), (r (f' z) : ℝ) * ‖y - a k‖) at_top (𝓝 (r (f' z) * ‖y - x‖)) :=
       (tendsto_const_nhds.sub a_lim).norm.const_mul _,
-    have I : ∀ᶠ k in at_top, ∥f y - f (a k) - (f' z) (y - a k)∥ ≤ r (f' z) * ∥y - a k∥,
+    have I : ∀ᶠ k in at_top, ‖f y - f (a k) - (f' z) (y - a k)‖ ≤ r (f' z) * ‖y - a k‖,
     { have L : tendsto (λ k, dist y (a k)) at_top (𝓝 (dist y x)) := tendsto_const_nhds.dist a_lim,
       filter_upwards [(tendsto_order.1 L).2 _ hy.2],
       assume k hk,
@@ -220,7 +224,7 @@ begin
       { rcases hs with ⟨x, xs⟩,
         rcases s_subset x xs with ⟨n, z, hnz⟩,
         exact false.elim z.2 },
-      { exact (nonempty_coe_sort _).2 hT } },
+      { exact hT.coe_sort } },
     inhabit (ℕ × T × ℕ),
     exact ⟨_, encodable.surjective_decode_iget _⟩ },
   -- these sets `t q = K n z p` will do
@@ -239,7 +243,7 @@ begin
   obtain ⟨q, hq⟩ : ∃ q, F q = (n, z, p) := hF _,
   -- then `x` belongs to `t q`.
   apply mem_Union.2 ⟨q, _⟩,
-  simp only [hq, subset_closure hnz, hp, mem_inter_eq, and_self],
+  simp only [hq, subset_closure hnz, hp, mem_inter_iff, and_self],
 end
 
 variables [measurable_space E] [borel_space E] (μ : measure E) [is_add_haar_measure μ]
@@ -322,16 +326,16 @@ begin
       { apply mem_image_of_mem,
         simpa only [dist_eq_norm, mem_closed_ball, mem_closed_ball_zero_iff] using zr },
       { rw [mem_closed_ball_iff_norm, add_sub_cancel],
-        calc ∥f z - f x - A (z - x)∥
-            ≤ δ * ∥z - x∥ : hf _ zs _ xs
+        calc ‖f z - f x - A (z - x)‖
+            ≤ δ * ‖z - x‖ : hf _ zs _ xs
         ... ≤ ε * r :
           mul_le_mul (le_of_lt hδ) (mem_closed_ball_iff_norm.1 zr) (norm_nonneg _) εpos.le },
       { simp only [map_sub, pi.sub_apply],
         abel } },
     have : A '' (closed_ball 0 r) + closed_ball (f x) (ε * r)
       = {f x} + r • (A '' (closed_ball 0 1) + closed_ball 0 ε),
-      by rw [smul_add_set, ← add_assoc, add_comm ({f x}), add_assoc, smul_closed_ball _ _ εpos.le,
-        smul_zero, singleton_add_closed_ball_zero, ← A.image_smul_set,
+      by rw [smul_add, ← add_assoc, add_comm ({f x}), add_assoc, smul_closed_ball _ _ εpos.le,
+        smul_zero, singleton_add_closed_ball_zero, ← image_smul_set ℝ E E A,
         smul_closed_ball _ _ zero_le_one, smul_zero, real.norm_eq_abs, abs_of_nonneg r0, mul_one,
         mul_comm],
     rw this at K,
@@ -341,7 +345,7 @@ begin
       by simp only [abs_of_nonneg r0, add_haar_smul, image_add_left, abs_pow, singleton_add,
                     measure_preimage_add]
     ... ≤ ennreal.of_real (r ^ finrank ℝ E) * (m * μ (closed_ball 0 1)) :
-      by { rw add_comm, exact ennreal.mul_le_mul le_rfl hε.le }
+      by { rw add_comm, exact mul_le_mul_left' hε.le _ }
     ... = m * μ (closed_ball x r) :
       by { simp only [add_haar_closed_ball' _ _ r0], ring } },
   -- covering `s` by closed balls with total measure very close to `μ s`, one deduces that the
@@ -367,7 +371,7 @@ begin
     ... ≤ ∑' (x : t), m * μ (closed_ball x (r x)) :
       ennreal.tsum_le_tsum (λ x, I x (r x) (ts x.2) (rpos x x.2).le)
     ... ≤ m * (μ s + a) :
-      by { rw ennreal.tsum_mul_left, exact ennreal.mul_le_mul le_rfl μt } },
+      by { rw ennreal.tsum_mul_left, exact mul_le_mul_left' μt _ } },
   -- taking the limit in `a`, one obtains the conclusion
   have L : tendsto (λ a, (m : ℝ≥0∞) * (μ s + a)) (𝓝[>] 0) (𝓝 (m * (μ s + 0))),
   { apply tendsto.mono_left _ nhds_within_le_nhds,
@@ -411,17 +415,17 @@ begin
     rcases (this.and self_mem_nhds_within).exists with ⟨δ₀, h, h'⟩,
     exact ⟨δ₀, h', h⟩, },
   -- record smallness conditions for `δ` that will be needed to apply `hδ₀` below.
-  have L1 : ∀ᶠ δ in 𝓝 (0 : ℝ≥0), subsingleton E ∨ δ < ∥(B.symm : E →L[ℝ] E)∥₊⁻¹,
+  have L1 : ∀ᶠ δ in 𝓝 (0 : ℝ≥0), subsingleton E ∨ δ < ‖(B.symm : E →L[ℝ] E)‖₊⁻¹,
   { by_cases (subsingleton E),
     { simp only [h, true_or, eventually_const] },
     simp only [h, false_or],
     apply Iio_mem_nhds,
-    simpa only [h, false_or, nnreal.inv_pos] using B.subsingleton_or_nnnorm_symm_pos },
+    simpa only [h, false_or, inv_pos] using B.subsingleton_or_nnnorm_symm_pos },
   have L2 : ∀ᶠ δ in 𝓝 (0 : ℝ≥0),
-    ∥(B.symm : E →L[ℝ] E)∥₊ * (∥(B.symm : E →L[ℝ] E)∥₊⁻¹ - δ)⁻¹ * δ < δ₀,
-  { have : tendsto (λ δ, ∥(B.symm : E →L[ℝ] E)∥₊ * (∥(B.symm : E →L[ℝ] E)∥₊⁻¹ - δ)⁻¹ * δ)
-      (𝓝 0) (𝓝 (∥(B.symm : E →L[ℝ] E)∥₊ * (∥(B.symm : E →L[ℝ] E)∥₊⁻¹ - 0)⁻¹ * 0)),
-    { rcases eq_or_ne (∥(B.symm : E →L[ℝ] E)∥₊) 0 with H|H,
+    ‖(B.symm : E →L[ℝ] E)‖₊ * (‖(B.symm : E →L[ℝ] E)‖₊⁻¹ - δ)⁻¹ * δ < δ₀,
+  { have : tendsto (λ δ, ‖(B.symm : E →L[ℝ] E)‖₊ * (‖(B.symm : E →L[ℝ] E)‖₊⁻¹ - δ)⁻¹ * δ)
+      (𝓝 0) (𝓝 (‖(B.symm : E →L[ℝ] E)‖₊ * (‖(B.symm : E →L[ℝ] E)‖₊⁻¹ - 0)⁻¹ * 0)),
+    { rcases eq_or_ne (‖(B.symm : E →L[ℝ] E)‖₊) 0 with H|H,
       { simpa only [H, zero_mul] using tendsto_const_nhds },
       refine tendsto.mul (tendsto_const_nhds.mul _) tendsto_id,
       refine (tendsto.sub tendsto_const_nhds tendsto_id).inv₀ _,
@@ -448,12 +452,12 @@ begin
 end
 
 /-- If a differentiable function `f` is approximated by a linear map `A` on a set `s`, up to `δ`,
-then at almost every `x` in `s` one has `∥f' x - A∥ ≤ δ`. -/
+then at almost every `x` in `s` one has `‖f' x - A‖ ≤ δ`. -/
 lemma _root_.approximates_linear_on.norm_fderiv_sub_le
   {A : E →L[ℝ] E} {δ : ℝ≥0}
   (hf : approximates_linear_on f A s δ) (hs : measurable_set s)
   (f' : E → E →L[ℝ] E) (hf' : ∀ x ∈ s, has_fderiv_within_at f (f' x) s x) :
-  ∀ᵐ x ∂(μ.restrict s), ∥f' x - A∥₊ ≤ δ :=
+  ∀ᵐ x ∂(μ.restrict s), ‖f' x - A‖₊ ≤ δ :=
 begin
   /- The conclusion will hold at the Lebesgue density points of `s` (which have full measure).
   At such a point `x`, for any `z` and any `ε > 0` one has for small `r`
@@ -465,11 +469,11 @@ begin
   assume x hx xs,
   -- consider an arbitrary vector `z`.
   apply continuous_linear_map.op_norm_le_bound _ δ.2 (λ z, _),
-  -- to show that `∥(f' x - A) z∥ ≤ δ ∥z∥`, it suffices to do it up to some error that vanishes
+  -- to show that `‖(f' x - A) z‖ ≤ δ ‖z‖`, it suffices to do it up to some error that vanishes
   -- asymptotically in terms of `ε > 0`.
-  suffices H : ∀ ε, 0 < ε → ∥(f' x - A) z∥ ≤ (δ + ε) * (∥z∥ + ε) + ∥(f' x - A)∥ * ε,
-  { have : tendsto (λ (ε : ℝ), ((δ : ℝ) + ε) * (∥z∥ + ε) + ∥(f' x - A)∥ * ε) (𝓝[>] 0)
-      (𝓝 ((δ + 0) * (∥z∥ + 0) + ∥(f' x - A)∥ * 0)) :=
+  suffices H : ∀ ε, 0 < ε → ‖(f' x - A) z‖ ≤ (δ + ε) * (‖z‖ + ε) + ‖(f' x - A)‖ * ε,
+  { have : tendsto (λ (ε : ℝ), ((δ : ℝ) + ε) * (‖z‖ + ε) + ‖(f' x - A)‖ * ε) (𝓝[>] 0)
+      (𝓝 ((δ + 0) * (‖z‖ + 0) + ‖(f' x - A)‖ * 0)) :=
         tendsto.mono_left (continuous.tendsto (by continuity) 0) nhds_within_le_nhds,
     simp only [add_zero, mul_zero] at this,
     apply le_of_tendsto_of_tendsto tendsto_const_nhds this,
@@ -483,7 +487,7 @@ begin
     eventually_nonempty_inter_smul_of_density_one μ s x hx
       _ measurable_set_closed_ball (measure_closed_ball_pos μ z εpos).ne',
   obtain ⟨ρ, ρpos, hρ⟩ :
-    ∃ ρ > 0, ball x ρ ∩ s ⊆ {y : E | ∥f y - f x - (f' x) (y - x)∥ ≤ ε * ∥y - x∥} :=
+    ∃ ρ > 0, ball x ρ ∩ s ⊆ {y : E | ‖f y - f x - (f' x) (y - x)‖ ≤ ε * ‖y - x‖} :=
       mem_nhds_within_iff.1 (is_o.def (hf' x xs) εpos),
   -- for small enough `r`, the rescaled ball `r • closed_ball z ε` is included in the set where
   -- `f y - f x` is well approximated by `f' x (y - x)`.
@@ -497,47 +501,47 @@ begin
   { simp only [mem_smul_set, image_add_left, mem_preimage, singleton_add] at hy,
     rcases hy with ⟨a, az, ha⟩,
     exact ⟨a, az, by simp only [ha, add_neg_cancel_left]⟩ },
-  have norm_a : ∥a∥ ≤ ∥z∥ + ε := calc
-    ∥a∥ = ∥z + (a - z)∥ : by simp only [add_sub_cancel'_right]
-    ... ≤ ∥z∥ + ∥a - z∥ : norm_add_le _ _
-    ... ≤ ∥z∥ + ε : add_le_add_left (mem_closed_ball_iff_norm.1 az) _,
+  have norm_a : ‖a‖ ≤ ‖z‖ + ε := calc
+    ‖a‖ = ‖z + (a - z)‖ : by simp only [add_sub_cancel'_right]
+    ... ≤ ‖z‖ + ‖a - z‖ : norm_add_le _ _
+    ... ≤ ‖z‖ + ε : add_le_add_left (mem_closed_ball_iff_norm.1 az) _,
   -- use the approximation properties to control `(f' x - A) a`, and then `(f' x - A) z` as `z` is
   -- close to `a`.
-  have I : r * ∥(f' x - A) a∥ ≤ r * (δ + ε) * (∥z∥ + ε) := calc
-    r * ∥(f' x - A) a∥ = ∥(f' x - A) (r • a)∥ :
+  have I : r * ‖(f' x - A) a‖ ≤ r * (δ + ε) * (‖z‖ + ε) := calc
+    r * ‖(f' x - A) a‖ = ‖(f' x - A) (r • a)‖ :
       by simp only [continuous_linear_map.map_smul, norm_smul, real.norm_eq_abs,
                     abs_of_nonneg rpos.le]
-    ... = ∥(f y - f x - A (y - x)) -
-            (f y - f x - (f' x) (y - x))∥ :
+    ... = ‖(f y - f x - A (y - x)) -
+            (f y - f x - (f' x) (y - x))‖ :
       begin
         congr' 1,
         simp only [ya, add_sub_cancel', sub_sub_sub_cancel_left, continuous_linear_map.coe_sub',
           eq_self_iff_true, sub_left_inj, pi.sub_apply, continuous_linear_map.map_smul, smul_sub],
       end
-    ... ≤ ∥f y - f x - A (y - x)∥ +
-             ∥f y - f x - (f' x) (y - x)∥ : norm_sub_le _ _
-    ... ≤ δ * ∥y - x∥ + ε * ∥y - x∥ :
+    ... ≤ ‖f y - f x - A (y - x)‖ +
+             ‖f y - f x - (f' x) (y - x)‖ : norm_sub_le _ _
+    ... ≤ δ * ‖y - x‖ + ε * ‖y - x‖ :
       add_le_add (hf _ ys _ xs) (hρ ⟨rρ hy, ys⟩)
-    ... = r * (δ + ε) * ∥a∥ :
+    ... = r * (δ + ε) * ‖a‖ :
       by { simp only [ya, add_sub_cancel', norm_smul, real.norm_eq_abs, abs_of_nonneg rpos.le],
            ring }
-    ... ≤ r * (δ + ε) * (∥z∥ + ε) :
+    ... ≤ r * (δ + ε) * (‖z‖ + ε) :
       mul_le_mul_of_nonneg_left norm_a (mul_nonneg rpos.le (add_nonneg δ.2 εpos.le)),
-  show ∥(f' x - A) z∥ ≤ (δ + ε) * (∥z∥ + ε) + ∥(f' x - A)∥ * ε, from calc
-    ∥(f' x - A) z∥ = ∥(f' x - A) a + (f' x - A) (z - a)∥ :
+  show ‖(f' x - A) z‖ ≤ (δ + ε) * (‖z‖ + ε) + ‖(f' x - A)‖ * ε, from calc
+    ‖(f' x - A) z‖ = ‖(f' x - A) a + (f' x - A) (z - a)‖ :
       begin
         congr' 1,
         simp only [continuous_linear_map.coe_sub', map_sub, pi.sub_apply],
         abel
       end
-    ... ≤ ∥(f' x - A) a∥ + ∥(f' x - A) (z - a)∥ : norm_add_le _ _
-    ... ≤ (δ + ε) * (∥z∥ + ε) + ∥f' x - A∥ * ∥z - a∥ :
+    ... ≤ ‖(f' x - A) a‖ + ‖(f' x - A) (z - a)‖ : norm_add_le _ _
+    ... ≤ (δ + ε) * (‖z‖ + ε) + ‖f' x - A‖ * ‖z - a‖ :
       begin
         apply add_le_add,
         { rw mul_assoc at I, exact (mul_le_mul_left rpos).1 I },
         { apply continuous_linear_map.le_op_norm }
       end
-    ... ≤ (δ + ε) * (∥z∥ + ε) + ∥f' x - A∥ * ε : add_le_add le_rfl
+    ... ≤ (δ + ε) * (‖z‖ + ε) + ‖f' x - A‖ * ε : add_le_add le_rfl
       (mul_le_mul_of_nonneg_left (mem_closed_ball_iff_norm'.1 az) (norm_nonneg _)),
 end
 
@@ -588,7 +592,7 @@ begin
     end
   ... ≤ ∑' n, (real.to_nnreal (|(A n).det|) + 1 : ℝ≥0) * 0 :
     begin
-      refine ennreal.tsum_le_tsum (λ n, ennreal.mul_le_mul le_rfl _),
+      refine ennreal.tsum_le_tsum (λ n, mul_le_mul_left' _ _),
       exact le_trans (measure_mono (inter_subset_left _ _)) (le_of_eq hs),
     end
   ... = 0 : by simp only [tsum_zero, mul_zero]
@@ -643,7 +647,7 @@ begin
   ... ≤ ε * ∑' n, μ (closed_ball 0 R ∩ t n) :
     begin
       rw ennreal.tsum_mul_left,
-      refine ennreal.mul_le_mul le_rfl (ennreal.tsum_le_tsum (λ n, measure_mono _)),
+      refine mul_le_mul_left' (ennreal.tsum_le_tsum (λ n, measure_mono _)) _,
       exact inter_subset_inter_left _ hs,
     end
   ... = ε * μ (⋃ n, closed_ball 0 R ∩ t n) :
@@ -656,7 +660,7 @@ begin
   ... ≤ ε * μ (closed_ball 0 R) :
     begin
       rw ← inter_Union,
-      exact ennreal.mul_le_mul le_rfl (measure_mono (inter_subset_left _ _)),
+      exact mul_le_mul_left' (measure_mono (inter_subset_left _ _)) _,
     end
 end
 
@@ -741,7 +745,7 @@ begin
   refine ae_sum_iff.2 (λ n, _),
   -- on almost all `s ∩ t n`, `f' x` is close to `A n` thanks to
   -- `approximates_linear_on.norm_fderiv_sub_le`.
-  have E₁ : ∀ᵐ (x : E) ∂μ.restrict (s ∩ t n), ∥f' x - A n∥₊ ≤ δ :=
+  have E₁ : ∀ᵐ (x : E) ∂μ.restrict (s ∩ t n), ‖f' x - A n‖₊ ≤ δ :=
     (ht n).norm_fderiv_sub_le μ (hs.inter (t_meas n)) f'
       (λ x hx, (hf' x hx.1).mono (inter_subset_left _ _)),
   -- moreover, `g x` is equal to `A n` there.
@@ -813,7 +817,7 @@ begin
   `A n` (and where `f'` is almost everywhere close to `A n`), and then use that `f` expands the
   measure of such a set by at most `(A n).det + ε`. -/
   have : ∀ (A : E →L[ℝ] E), ∃ (δ : ℝ≥0), 0 < δ ∧
-    (∀ (B : E →L[ℝ] E), ∥B - A∥ ≤ δ → |B.det - A.det| ≤ ε) ∧
+    (∀ (B : E →L[ℝ] E), ‖B - A‖ ≤ δ → |B.det - A.det| ≤ ε) ∧
     ∀ (t : set E) (g : E → E) (hf : approximates_linear_on g A t δ),
      μ (g '' t) ≤ (ennreal.of_real (|A.det|) + ε) * μ t,
   { assume A,
@@ -831,7 +835,7 @@ begin
       rw ← real.dist_eq,
       apply (hδ' B _).le,
       rw dist_eq_norm,
-      calc ∥B - A∥ ≤ (min δ δ'' : ℝ≥0) : hB
+      calc ‖B - A‖ ≤ (min δ δ'' : ℝ≥0) : hB
       ... ≤ δ'' : by simp only [le_refl, nnreal.coe_min, min_le_iff, or_true]
       ... < δ' : half_lt_self δ'pos },
     { assume t g htg,
@@ -891,10 +895,7 @@ begin
       rw ← this,
     end
   ... = ∫⁻ x in s, ennreal.of_real (|(f' x).det|) ∂μ + 2 * ε * μ s :
-    begin
-      rw lintegral_add' (ae_measurable_of_real_abs_det_fderiv_within μ hs hf') ae_measurable_const,
-      simp only [lintegral_const, measurable_set.univ, measure.restrict_apply, univ_inter],
-    end
+    by simp only [lintegral_add_right' _ ae_measurable_const, set_lintegral_const]
 end
 
 lemma add_haar_image_le_lintegral_abs_det_fderiv_aux2 (hs : measurable_set s) (h's : μ s ≠ ∞)
@@ -961,7 +962,7 @@ begin
   well-approximated by linear maps `A n` (and where `f'` is almost everywhere close to `A n`),
   and then use that `f` expands the measure of such a set by at least `(A n).det - ε`. -/
   have : ∀ (A : E →L[ℝ] E), ∃ (δ : ℝ≥0), 0 < δ ∧
-    (∀ (B : E →L[ℝ] E), ∥B - A∥ ≤ δ → |B.det - A.det| ≤ ε) ∧
+    (∀ (B : E →L[ℝ] E), ‖B - A‖ ≤ δ → |B.det - A.det| ≤ ε) ∧
     ∀ (t : set E) (g : E → E) (hf : approximates_linear_on g A t δ),
      ennreal.of_real (|A.det|) * μ t ≤ μ (g '' t) + ε * μ t,
   { assume A,
@@ -969,7 +970,7 @@ begin
       ∃ (δ' : ℝ) (H : 0 < δ'), ∀ B, dist B A < δ' → dist B.det A.det < ↑ε :=
         continuous_at_iff.1 continuous_linear_map.continuous_det.continuous_at ε εpos,
     let δ'' : ℝ≥0 := ⟨δ' / 2, (half_pos δ'pos).le⟩,
-    have I'' : ∀ (B : E →L[ℝ] E), ∥B - A∥ ≤ ↑δ'' → |B.det - A.det| ≤ ↑ε,
+    have I'' : ∀ (B : E →L[ℝ] E), ‖B - A‖ ≤ ↑δ'' → |B.det - A.det| ≤ ↑ε,
     { assume B hB,
       rw ← real.dist_eq,
       apply (hδ' B _).le,
@@ -994,7 +995,7 @@ begin
     { assume t g htg,
       rcases eq_or_ne (μ t) ∞ with ht|ht,
       { simp only [ht, εpos.ne', with_top.mul_top, ennreal.coe_eq_zero, le_top, ne.def,
-                   not_false_iff, ennreal.add_top] },
+                   not_false_iff, _root_.add_top] },
       have := h t g (htg.mono_num (min_le_left _ _)),
       rwa [with_top.coe_sub, ennreal.sub_mul, tsub_le_iff_right] at this,
       simp only [ht, implies_true_iff, ne.def, not_false_iff] } },
@@ -1034,11 +1035,10 @@ begin
                       ennreal.of_real_coe_nnreal]
     end
   ... = ∑' n, (ennreal.of_real (|(A n).det|) * μ (s ∩ t n) + ε * μ (s ∩ t n)) :
-    by simp only [measurable_const, lintegral_const, lintegral_add, measurable_set.univ,
-                  eq_self_iff_true, measure.restrict_apply, univ_inter]
+    by simp only [set_lintegral_const, lintegral_add_right _ measurable_const]
   ... ≤ ∑' n, ((μ (f '' (s ∩ t n)) + ε * μ (s ∩ t n)) + ε * μ (s ∩ t n)) :
     begin
-      refine ennreal.tsum_le_tsum (λ n, add_le_add _ le_rfl),
+      refine ennreal.tsum_le_tsum (λ n, add_le_add_right _ _),
       exact (hδ (A n)).2.2 _ _ (ht n),
     end
   ... = μ (f '' s) + 2 * ε * μ s :
@@ -1047,7 +1047,7 @@ begin
       rw [image_Union, measure_Union], rotate,
       { assume i j hij,
         apply (disjoint.image _ hf (inter_subset_left _ _) (inter_subset_left _ _)),
-        exact disjoint.mono (inter_subset_right _ _) (inter_subset_right _ _) (t_disj i j hij) },
+        exact disjoint.mono (inter_subset_right _ _) (inter_subset_right _ _) (t_disj hij) },
       { assume i,
         exact measurable_image_of_fderiv_within (hs.inter (t_meas i)) (λ x hx,
           (hf' x hx.1).mono (inter_subset_left _ _)) (hf.mono (inter_subset_left _ _)) },
@@ -1117,7 +1117,7 @@ begin
       { assume i j hij,
         apply disjoint.image _ hf (inter_subset_left _ _) (inter_subset_left _ _),
         exact disjoint.mono (inter_subset_right _ _) (inter_subset_right _ _)
-          (disjoint_disjointed _ i j hij) },
+          (disjoint_disjointed _ hij) },
       { assume i,
         exact measurable_image_of_fderiv_within (hs.inter (u_meas i)) (λ x hx,
           (hf' x hx.1).mono (inter_subset_left _ _)) (hf.mono (inter_subset_left _ _)) },
@@ -1248,4 +1248,50 @@ begin
   refl
 end
 
+/- Porting note: move this to `topology.algebra.module.basic` when port is over -/
+lemma det_one_smul_right {𝕜 : Type*} [normed_field 𝕜] (v : 𝕜) :
+  ((1 : 𝕜 →L[𝕜] 𝕜).smul_right v).det = v :=
+begin
+  have : (1 : 𝕜 →L[𝕜] 𝕜).smul_right v = v • (1 : 𝕜 →L[𝕜] 𝕜),
+  { ext1 w,
+    simp only [continuous_linear_map.smul_right_apply, continuous_linear_map.one_apply,
+    algebra.id.smul_eq_mul, one_mul, continuous_linear_map.coe_smul', pi.smul_apply, mul_one] },
+  rw [this, continuous_linear_map.det, continuous_linear_map.coe_smul],
+  change ((1 : 𝕜 →L[𝕜] 𝕜) : 𝕜 →ₗ[𝕜] 𝕜) with linear_map.id,
+  rw [linear_map.det_smul, finite_dimensional.finrank_self, linear_map.det_id, pow_one, mul_one],
+end
+
+/-- Integrability in the change of variable formula for differentiable functions (one-variable
+version): if a function `f` is injective and differentiable on a measurable set ``s ⊆ ℝ`, then a
+function `g : ℝ → F` is integrable on `f '' s` if and only if `|(f' x)| • g ∘ f` is integrable on
+`s`. -/
+theorem integrable_on_image_iff_integrable_on_abs_deriv_smul
+  {s : set ℝ} {f : ℝ → ℝ} {f' : ℝ → ℝ} (hs : measurable_set s)
+  (hf' : ∀ x ∈ s, has_deriv_within_at f (f' x) s x) (hf : inj_on f s) (g : ℝ → F) :
+  integrable_on g (f '' s) ↔ integrable_on (λ x, |(f' x)| • g (f x)) s :=
+by simpa only [det_one_smul_right] using integrable_on_image_iff_integrable_on_abs_det_fderiv_smul
+  volume hs (λ x hx, (hf' x hx).has_fderiv_within_at) hf g
+
+/-- Change of variable formula for differentiable functions (one-variable version): if a function
+`f` is injective and differentiable on a measurable set `s ⊆ ℝ`, then the Bochner integral of a
+function `g : ℝ → F` on `f '' s` coincides with the integral of `|(f' x)| • g ∘ f` on `s`. -/
+theorem integral_image_eq_integral_abs_deriv_smul {s : set ℝ} {f : ℝ → ℝ} {f' : ℝ → ℝ}
+  [complete_space F] (hs : measurable_set s) (hf' : ∀ x ∈ s, has_deriv_within_at f (f' x) s x)
+  (hf : inj_on f s) (g : ℝ → F) :
+  ∫ x in f '' s, g x = ∫ x in s, |(f' x)| • g (f x) :=
+by simpa only [det_one_smul_right] using integral_image_eq_integral_abs_det_fderiv_smul
+  volume hs (λ x hx, (hf' x hx).has_fderiv_within_at) hf g
+
+theorem integral_target_eq_integral_abs_det_fderiv_smul [complete_space F]
+  {f : local_homeomorph E E} (hf' : ∀ x ∈ f.source, has_fderiv_at f (f' x) x) (g : E → F) :
+  ∫ x in f.target, g x ∂μ = ∫ x in f.source, |(f' x).det| • g (f x) ∂μ :=
+begin
+  have : f '' f.source = f.target := local_equiv.image_source_eq_target f.to_local_equiv,
+  rw ← this,
+  apply integral_image_eq_integral_abs_det_fderiv_smul μ f.open_source.measurable_set _ f.inj_on,
+  assume x hx,
+  exact (hf' x hx).has_fderiv_within_at
+end
+
+
 end measure_theory
diff --git a/src/measure_theory/function/l1_space.lean b/src/measure_theory/function/l1_space.lean
index eb5066f28b773..0ca5e2f3fd606 100644
--- a/src/measure_theory/function/l1_space.lean
+++ b/src/measure_theory/function/l1_space.lean
@@ -3,12 +3,15 @@ Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou
 -/
-import measure_theory.function.lp_space
+import measure_theory.function.lp_order
 
 
 /-!
 # Integrable functions and `L¹` space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In the first part of this file, the predicate `integrable` is defined and basic properties of
 integrable functions are proved.
 
@@ -20,16 +23,16 @@ classes of integrable functions, already defined as a special case of `L^p` spac
 
 ## Notation
 
-* `α →₁[μ] β` is the type of `L¹` space, where `α` is a `measure_space` and `β` is a `normed_group`
-  with a `second_countable_topology`. `f : α →ₘ β` is a "function" in `L¹`. In comments, `[f]` is
-  also used to denote an `L¹` function.
+* `α →₁[μ] β` is the type of `L¹` space, where `α` is a `measure_space` and `β` is a
+  `normed_add_comm_group` with a `second_countable_topology`. `f : α →ₘ β` is a "function" in `L¹`.
+  In comments, `[f]` is also used to denote an `L¹` function.
 
   `₁` can be typed as `\1`.
 
 ## Main definitions
 
-* Let `f : α → β` be a function, where `α` is a `measure_space` and `β` a `normed_group`.
-  Then `has_finite_integral f` means `(∫⁻ a, ∥f a∥₊) < ∞`.
+* Let `f : α → β` be a function, where `α` is a `measure_space` and `β` a `normed_add_comm_group`.
+  Then `has_finite_integral f` means `(∫⁻ a, ‖f a‖₊) < ∞`.
 
 * If `β` is moreover a `measurable_space` then `f` is called `integrable` if
   `f` is `measurable` and `has_finite_integral f` holds.
@@ -47,56 +50,60 @@ integrable, function space, l1
 
 noncomputable theory
 
-open_locale classical topological_space big_operators ennreal measure_theory nnreal
+open_locale classical topology big_operators ennreal measure_theory nnreal
 
 open set filter topological_space ennreal emetric measure_theory
 
 variables {α β γ δ : Type*} {m : measurable_space α} {μ ν : measure α} [measurable_space δ]
-variables [normed_group β]
-variables [normed_group γ]
+variables [normed_add_comm_group β]
+variables [normed_add_comm_group γ]
 
 namespace measure_theory
 
 /-! ### Some results about the Lebesgue integral involving a normed group -/
 
 lemma lintegral_nnnorm_eq_lintegral_edist (f : α → β) :
-  ∫⁻ a, ∥f a∥₊ ∂μ = ∫⁻ a, edist (f a) 0 ∂μ :=
+  ∫⁻ a, ‖f a‖₊ ∂μ = ∫⁻ a, edist (f a) 0 ∂μ :=
 by simp only [edist_eq_coe_nnnorm]
 
 lemma lintegral_norm_eq_lintegral_edist (f : α → β) :
-  ∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ = ∫⁻ a, edist (f a) 0 ∂μ :=
+  ∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ = ∫⁻ a, edist (f a) 0 ∂μ :=
 by simp only [of_real_norm_eq_coe_nnnorm, edist_eq_coe_nnnorm]
 
 lemma lintegral_edist_triangle {f g h : α → β}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ)
-  (hh : ae_strongly_measurable h μ) :
+  (hf : ae_strongly_measurable f μ) (hh : ae_strongly_measurable h μ) :
   ∫⁻ a, edist (f a) (g a) ∂μ ≤ ∫⁻ a, edist (f a) (h a) ∂μ + ∫⁻ a, edist (g a) (h a) ∂μ :=
 begin
-  rw ← lintegral_add' (hf.edist hh) (hg.edist hh),
+  rw ← lintegral_add_left' (hf.edist hh),
   refine lintegral_mono (λ a, _),
   apply edist_triangle_right
 end
 
-lemma lintegral_nnnorm_zero : ∫⁻ a : α, ∥(0 : β)∥₊ ∂μ = 0 := by simp
+lemma lintegral_nnnorm_zero : ∫⁻ a : α, ‖(0 : β)‖₊ ∂μ = 0 := by simp
+
+lemma lintegral_nnnorm_add_left
+  {f : α → β} (hf : ae_strongly_measurable f μ) (g : α → γ) :
+  ∫⁻ a, ‖f a‖₊ + ‖g a‖₊ ∂μ = ∫⁻ a, ‖f a‖₊ ∂μ + ∫⁻ a, ‖g a‖₊ ∂μ :=
+lintegral_add_left' hf.ennnorm _
 
-lemma lintegral_nnnorm_add
-  {f : α → β} {g : α → γ} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ∫⁻ a, ∥f a∥₊ + ∥g a∥₊ ∂μ = ∫⁻ a, ∥f a∥₊ ∂μ + ∫⁻ a, ∥g a∥₊ ∂μ :=
-lintegral_add' hf.ennnorm hg.ennnorm
+lemma lintegral_nnnorm_add_right
+  (f : α → β) {g : α → γ} (hg : ae_strongly_measurable g μ) :
+  ∫⁻ a, ‖f a‖₊ + ‖g a‖₊ ∂μ = ∫⁻ a, ‖f a‖₊ ∂μ + ∫⁻ a, ‖g a‖₊ ∂μ :=
+lintegral_add_right' _ hg.ennnorm
 
 lemma lintegral_nnnorm_neg {f : α → β} :
-  ∫⁻ a, ∥(-f) a∥₊ ∂μ = ∫⁻ a, ∥f a∥₊ ∂μ :=
+  ∫⁻ a, ‖(-f) a‖₊ ∂μ = ∫⁻ a, ‖f a‖₊ ∂μ :=
 by simp only [pi.neg_apply, nnnorm_neg]
 
 /-! ### The predicate `has_finite_integral` -/
 
-/-- `has_finite_integral f μ` means that the integral `∫⁻ a, ∥f a∥ ∂μ` is finite.
+/-- `has_finite_integral f μ` means that the integral `∫⁻ a, ‖f a‖ ∂μ` is finite.
   `has_finite_integral f` means `has_finite_integral f volume`. -/
 def has_finite_integral {m : measurable_space α} (f : α → β) (μ : measure α . volume_tac) : Prop :=
-∫⁻ a, ∥f a∥₊ ∂μ < ∞
+∫⁻ a, ‖f a‖₊ ∂μ < ∞
 
 lemma has_finite_integral_iff_norm (f : α → β) :
-  has_finite_integral f μ ↔ ∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ < ∞ :=
+  has_finite_integral f μ ↔ ∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ < ∞ :=
 by simp only [has_finite_integral, of_real_norm_eq_coe_nnnorm]
 
 lemma has_finite_integral_iff_edist (f : α → β) :
@@ -105,36 +112,31 @@ by simp only [has_finite_integral_iff_norm, edist_dist, dist_zero_right]
 
 lemma has_finite_integral_iff_of_real {f : α → ℝ} (h : 0 ≤ᵐ[μ] f) :
   has_finite_integral f μ ↔ ∫⁻ a, ennreal.of_real (f a) ∂μ < ∞ :=
-have lintegral_eq : ∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ = ∫⁻ a, ennreal.of_real (f a) ∂μ :=
-begin
-  refine lintegral_congr_ae (h.mono $ λ a h, _),
-  rwa [real.norm_eq_abs, abs_of_nonneg]
-end,
-by rw [has_finite_integral_iff_norm, lintegral_eq]
+by rw [has_finite_integral, lintegral_nnnorm_eq_of_ae_nonneg h]
 
 lemma has_finite_integral_iff_of_nnreal {f : α → ℝ≥0} :
   has_finite_integral (λ x, (f x : ℝ)) μ ↔ ∫⁻ a, f a ∂μ < ∞ :=
 by simp [has_finite_integral_iff_norm]
 
 lemma has_finite_integral.mono {f : α → β} {g : α → γ} (hg : has_finite_integral g μ)
-  (h : ∀ᵐ a ∂μ, ∥f a∥ ≤ ∥g a∥) : has_finite_integral f μ :=
+  (h : ∀ᵐ a ∂μ, ‖f a‖ ≤ ‖g a‖) : has_finite_integral f μ :=
 begin
   simp only [has_finite_integral_iff_norm] at *,
-  calc ∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ ≤ ∫⁻ (a : α), (ennreal.of_real ∥g a∥) ∂μ :
+  calc ∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ ≤ ∫⁻ (a : α), (ennreal.of_real ‖g a‖) ∂μ :
     lintegral_mono_ae (h.mono $ assume a h, of_real_le_of_real h)
     ... < ∞ : hg
 end
 
 lemma has_finite_integral.mono' {f : α → β} {g : α → ℝ} (hg : has_finite_integral g μ)
-  (h : ∀ᵐ a ∂μ, ∥f a∥ ≤ g a) : has_finite_integral f μ :=
+  (h : ∀ᵐ a ∂μ, ‖f a‖ ≤ g a) : has_finite_integral f μ :=
 hg.mono $ h.mono $ λ x hx, le_trans hx (le_abs_self _)
 
 lemma has_finite_integral.congr' {f : α → β} {g : α → γ} (hf : has_finite_integral f μ)
-  (h : ∀ᵐ a ∂μ, ∥f a∥ = ∥g a∥) :
+  (h : ∀ᵐ a ∂μ, ‖f a‖ = ‖g a‖) :
   has_finite_integral g μ :=
 hf.mono $ eventually_eq.le $ eventually_eq.symm h
 
-lemma has_finite_integral_congr' {f : α → β} {g : α → γ} (h : ∀ᵐ a ∂μ, ∥f a∥ = ∥g a∥) :
+lemma has_finite_integral_congr' {f : α → β} {g : α → γ} (h : ∀ᵐ a ∂μ, ‖f a‖ = ‖g a‖) :
   has_finite_integral f μ ↔ has_finite_integral g μ :=
 ⟨λ hf, hf.congr' h, λ hg, hg.congr' $ eventually_eq.symm h⟩
 
@@ -148,14 +150,15 @@ has_finite_integral_congr' $ h.fun_comp norm
 
 lemma has_finite_integral_const_iff {c : β} :
   has_finite_integral (λ x : α, c) μ ↔ c = 0 ∨ μ univ < ∞ :=
-by simp [has_finite_integral, lintegral_const, lt_top_iff_ne_top, or_iff_not_imp_left]
+by simp [has_finite_integral, lintegral_const, lt_top_iff_ne_top, ennreal.mul_eq_top,
+  or_iff_not_imp_left]
 
 lemma has_finite_integral_const [is_finite_measure μ] (c : β) :
   has_finite_integral (λ x : α, c) μ :=
 has_finite_integral_const_iff.2 (or.inr $ measure_lt_top _ _)
 
 lemma has_finite_integral_of_bounded [is_finite_measure μ] {f : α → β} {C : ℝ}
-  (hC : ∀ᵐ a ∂μ, ∥f a∥ ≤ C) : has_finite_integral f μ :=
+  (hC : ∀ᵐ a ∂μ, ‖f a‖ ≤ C) : has_finite_integral f μ :=
 (has_finite_integral_const C).mono' hC
 
 lemma has_finite_integral.mono_measure {f : α → β} (h : has_finite_integral f ν) (hμ : μ ≤ ν) :
@@ -206,20 +209,20 @@ by simpa [has_finite_integral] using hfi
 ⟨λ h, neg_neg f ▸ h.neg, has_finite_integral.neg⟩
 
 lemma has_finite_integral.norm {f : α → β} (hfi : has_finite_integral f μ) :
-  has_finite_integral (λa, ∥f a∥) μ :=
-have eq : (λa, (nnnorm ∥f a∥ : ℝ≥0∞)) = λa, (∥f a∥₊ : ℝ≥0∞),
+  has_finite_integral (λa, ‖f a‖) μ :=
+have eq : (λa, (nnnorm ‖f a‖ : ℝ≥0∞)) = λa, (‖f a‖₊ : ℝ≥0∞),
   by { funext, rw nnnorm_norm },
 by { rwa [has_finite_integral, eq] }
 
 lemma has_finite_integral_norm_iff (f : α → β) :
-  has_finite_integral (λa, ∥f a∥) μ ↔ has_finite_integral f μ :=
+  has_finite_integral (λa, ‖f a‖) μ ↔ has_finite_integral f μ :=
 has_finite_integral_congr' $ eventually_of_forall $ λ x, norm_norm (f x)
 
 lemma has_finite_integral_to_real_of_lintegral_ne_top
   {f : α → ℝ≥0∞} (hf : ∫⁻ x, f x ∂μ ≠ ∞) :
   has_finite_integral (λ x, (f x).to_real) μ :=
 begin
-  have : ∀ x, (∥(f x).to_real∥₊ : ℝ≥0∞) =
+  have : ∀ x, (‖(f x).to_real‖₊ : ℝ≥0∞) =
     @coe ℝ≥0 ℝ≥0∞ _ (⟨(f x).to_real, ennreal.to_real_nonneg⟩ : ℝ≥0),
   { intro x, rw real.nnnorm_of_nonneg },
   simp_rw [has_finite_integral, this],
@@ -241,18 +244,18 @@ section dominated_convergence
 
 variables {F : ℕ → α → β} {f : α → β} {bound : α → ℝ}
 
-lemma all_ae_of_real_F_le_bound (h : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a) :
-  ∀ n, ∀ᵐ a ∂μ, ennreal.of_real ∥F n a∥ ≤ ennreal.of_real (bound a) :=
+lemma all_ae_of_real_F_le_bound (h : ∀ n, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound a) :
+  ∀ n, ∀ᵐ a ∂μ, ennreal.of_real ‖F n a‖ ≤ ennreal.of_real (bound a) :=
 λn, (h n).mono $ λ a h, ennreal.of_real_le_of_real h
 
 lemma all_ae_tendsto_of_real_norm (h : ∀ᵐ a ∂μ, tendsto (λ n, F n a) at_top $ 𝓝 $ f a) :
-  ∀ᵐ a ∂μ, tendsto (λn, ennreal.of_real ∥F n a∥) at_top $ 𝓝 $ ennreal.of_real ∥f a∥ :=
+  ∀ᵐ a ∂μ, tendsto (λn, ennreal.of_real ‖F n a‖) at_top $ 𝓝 $ ennreal.of_real ‖f a‖ :=
 h.mono $
   λ a h, tendsto_of_real $ tendsto.comp (continuous.tendsto continuous_norm _) h
 
-lemma all_ae_of_real_f_le_bound (h_bound : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a)
+lemma all_ae_of_real_f_le_bound (h_bound : ∀ n, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound a)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, F n a) at_top (𝓝 (f a))) :
-  ∀ᵐ a ∂μ, ennreal.of_real ∥f a∥ ≤ ennreal.of_real (bound a) :=
+  ∀ᵐ a ∂μ, ennreal.of_real ‖f a‖ ≤ ennreal.of_real (bound a) :=
 begin
   have F_le_bound := all_ae_of_real_F_le_bound h_bound,
   rw ← ae_all_iff at F_le_bound,
@@ -263,14 +266,14 @@ end
 
 lemma has_finite_integral_of_dominated_convergence {F : ℕ → α → β} {f : α → β} {bound : α → ℝ}
   (bound_has_finite_integral : has_finite_integral bound μ)
-  (h_bound : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a)
+  (h_bound : ∀ n, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound a)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, F n a) at_top (𝓝 (f a))) :
   has_finite_integral f μ :=
-/- `∥F n a∥ ≤ bound a` and `∥F n a∥ --> ∥f a∥` implies `∥f a∥ ≤ bound a`,
-  and so `∫ ∥f∥ ≤ ∫ bound < ∞` since `bound` is has_finite_integral -/
+/- `‖F n a‖ ≤ bound a` and `‖F n a‖ --> ‖f a‖` implies `‖f a‖ ≤ bound a`,
+  and so `∫ ‖f‖ ≤ ∫ bound < ∞` since `bound` is has_finite_integral -/
 begin
   rw has_finite_integral_iff_norm,
-  calc ∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ ≤ ∫⁻ a, ennreal.of_real (bound a) ∂μ :
+  calc ∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ ≤ ∫⁻ a, ennreal.of_real (bound a) ∂μ :
     lintegral_mono_ae $ all_ae_of_real_f_le_bound h_bound h_lim
     ... < ∞ :
     begin
@@ -284,20 +287,20 @@ lemma tendsto_lintegral_norm_of_dominated_convergence
   {F : ℕ → α → β} {f : α → β} {bound : α → ℝ}
   (F_measurable : ∀ n, ae_strongly_measurable (F n) μ)
   (bound_has_finite_integral : has_finite_integral bound μ)
-  (h_bound : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a)
+  (h_bound : ∀ n, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound a)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, F n a) at_top (𝓝 (f a))) :
-  tendsto (λn, ∫⁻ a, (ennreal.of_real ∥F n a - f a∥) ∂μ) at_top (𝓝 0) :=
+  tendsto (λn, ∫⁻ a, (ennreal.of_real ‖F n a - f a‖) ∂μ) at_top (𝓝 0) :=
 have f_measurable : ae_strongly_measurable f μ :=
   ae_strongly_measurable_of_tendsto_ae _ F_measurable h_lim,
 let b := λ a, 2 * ennreal.of_real (bound a) in
-/- `∥F n a∥ ≤ bound a` and `F n a --> f a` implies `∥f a∥ ≤ bound a`, and thus by the
-  triangle inequality, have `∥F n a - f a∥ ≤ 2 * (bound a). -/
-have hb : ∀ n, ∀ᵐ a ∂μ, ennreal.of_real ∥F n a - f a∥ ≤ b a,
+/- `‖F n a‖ ≤ bound a` and `F n a --> f a` implies `‖f a‖ ≤ bound a`, and thus by the
+  triangle inequality, have `‖F n a - f a‖ ≤ 2 * (bound a). -/
+have hb : ∀ n, ∀ᵐ a ∂μ, ennreal.of_real ‖F n a - f a‖ ≤ b a,
 begin
   assume n,
   filter_upwards [all_ae_of_real_F_le_bound h_bound n, all_ae_of_real_f_le_bound h_bound h_lim]
     with a h₁ h₂,
-  calc ennreal.of_real ∥F n a - f a∥ ≤ (ennreal.of_real ∥F n a∥) + (ennreal.of_real ∥f a∥) :
+  calc ennreal.of_real ‖F n a - f a‖ ≤ (ennreal.of_real ‖F n a‖) + (ennreal.of_real ‖f a‖) :
   begin
     rw [← ennreal.of_real_add],
     apply of_real_le_of_real,
@@ -306,21 +309,21 @@ begin
     ... ≤ (ennreal.of_real (bound a)) + (ennreal.of_real (bound a)) : add_le_add h₁ h₂
     ... = b a : by rw ← two_mul
 end,
-/- On the other hand, `F n a --> f a` implies that `∥F n a - f a∥ --> 0`  -/
-have h : ∀ᵐ a ∂μ, tendsto (λ n, ennreal.of_real ∥F n a - f a∥) at_top (𝓝 0),
+/- On the other hand, `F n a --> f a` implies that `‖F n a - f a‖ --> 0`  -/
+have h : ∀ᵐ a ∂μ, tendsto (λ n, ennreal.of_real ‖F n a - f a‖) at_top (𝓝 0),
 begin
   rw ← ennreal.of_real_zero,
   refine h_lim.mono (λ a h, (continuous_of_real.tendsto _).comp _),
   rwa ← tendsto_iff_norm_tendsto_zero
 end,
 /- Therefore, by the dominated convergence theorem for nonnegative integration, have
-  ` ∫ ∥f a - F n a∥ --> 0 ` -/
+  ` ∫ ‖f a - F n a‖ --> 0 ` -/
 begin
-  suffices h : tendsto (λn, ∫⁻ a, (ennreal.of_real ∥F n a - f a∥) ∂μ) at_top (𝓝 (∫⁻ (a:α), 0 ∂μ)),
+  suffices h : tendsto (λn, ∫⁻ a, (ennreal.of_real ‖F n a - f a‖) ∂μ) at_top (𝓝 (∫⁻ (a:α), 0 ∂μ)),
   { rwa lintegral_zero at h },
   -- Using the dominated convergence theorem.
   refine tendsto_lintegral_of_dominated_convergence' _ _ hb _ _,
-  -- Show `λa, ∥f a - F n a∥` is almost everywhere measurable for all `n`
+  -- Show `λa, ‖f a - F n a‖` is almost everywhere measurable for all `n`
   { exact λ n,  measurable_of_real.comp_ae_measurable
       ((F_measurable n).sub f_measurable).norm.ae_measurable },
   -- Show `2 * bound` is has_finite_integral
@@ -329,7 +332,7 @@ begin
         by { rw lintegral_const_mul', exact coe_ne_top }
         ... ≠ ∞ : mul_ne_top coe_ne_top bound_has_finite_integral.ne },
     filter_upwards [h_bound 0] with _ h using le_trans (norm_nonneg _) h },
-  -- Show `∥f a - F n a∥ --> 0`
+  -- Show `‖f a - F n a‖ --> 0`
   { exact h }
 end
 
@@ -340,25 +343,29 @@ section pos_part
 
 lemma has_finite_integral.max_zero {f : α → ℝ} (hf : has_finite_integral f μ) :
   has_finite_integral (λa, max (f a) 0) μ :=
-hf.mono $ eventually_of_forall $ λ x, by simp [real.norm_eq_abs, abs_le, abs_nonneg, le_abs_self]
+hf.mono $ eventually_of_forall $ λ x, by simp [abs_le, le_abs_self]
 
 lemma has_finite_integral.min_zero {f : α → ℝ} (hf : has_finite_integral f μ) :
   has_finite_integral (λa, min (f a) 0) μ :=
 hf.mono $ eventually_of_forall $ λ x,
-  by simp [real.norm_eq_abs, abs_le, abs_nonneg, neg_le, neg_le_abs_self, abs_eq_max_neg, le_total]
+  by simp [abs_le, neg_le, neg_le_abs_self, abs_eq_max_neg, le_total]
 
 end pos_part
 
 section normed_space
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]
+variables {𝕜 : Type*}
 
-lemma has_finite_integral.smul (c : 𝕜) {f : α → β} : has_finite_integral f μ →
-  has_finite_integral (c • f) μ :=
+lemma has_finite_integral.smul
+  [normed_add_comm_group 𝕜] [smul_zero_class 𝕜 β] [has_bounded_smul 𝕜 β] (c : 𝕜) {f : α → β} :
+  has_finite_integral f μ → has_finite_integral (c • f) μ :=
 begin
   simp only [has_finite_integral], assume hfi,
   calc
-    ∫⁻ (a : α), ∥c • f a∥₊ ∂μ = ∫⁻ (a : α), (∥c∥₊) * ∥f a∥₊ ∂μ :
-      by simp only [nnnorm_smul, ennreal.coe_mul]
+    ∫⁻ (a : α), ‖c • f a‖₊ ∂μ ≤ ∫⁻ (a : α), (‖c‖₊) * ‖f a‖₊ ∂μ : begin
+      refine lintegral_mono _,
+      intro i,
+      exact_mod_cast (nnnorm_smul_le c (f i) : _),
+    end
     ... < ∞ :
     begin
       rw lintegral_const_mul',
@@ -366,22 +373,28 @@ begin
     end
 end
 
-lemma has_finite_integral_smul_iff {c : 𝕜} (hc : c ≠ 0) (f : α → β) :
+lemma has_finite_integral_smul_iff
+  [normed_ring 𝕜] [mul_action_with_zero 𝕜 β] [has_bounded_smul 𝕜 β]
+  {c : 𝕜} (hc : is_unit c)
+  (f : α → β) :
   has_finite_integral (c • f) μ ↔ has_finite_integral f μ :=
 begin
+  obtain ⟨c, rfl⟩ := hc,
   split,
   { assume h,
-    simpa only [smul_smul, inv_mul_cancel hc, one_smul] using h.smul c⁻¹ },
+    simpa only [smul_smul, units.inv_mul, one_smul] using h.smul (↑c⁻¹ : 𝕜) },
   exact has_finite_integral.smul _
 end
 
-lemma has_finite_integral.const_mul {f : α → ℝ} (h : has_finite_integral f μ) (c : ℝ) :
+lemma has_finite_integral.const_mul [normed_ring 𝕜] {f : α → 𝕜} (h : has_finite_integral f μ)
+  (c : 𝕜) :
   has_finite_integral (λ x, c * f x) μ :=
-(has_finite_integral.smul c h : _)
+h.smul c
 
-lemma has_finite_integral.mul_const {f : α → ℝ} (h : has_finite_integral f μ) (c : ℝ) :
+lemma has_finite_integral.mul_const [normed_ring 𝕜] {f : α → 𝕜} (h : has_finite_integral f μ)
+  (c : 𝕜) :
   has_finite_integral (λ x, f x * c) μ :=
-by simp_rw [mul_comm, h.const_mul _]
+h.smul (mul_opposite.op c)
 
 end normed_space
 
@@ -389,7 +402,7 @@ end normed_space
 
 -- variables [measurable_space β] [measurable_space γ] [measurable_space δ]
 
-/-- `integrable f μ` means that `f` is measurable and that the integral `∫⁻ a, ∥f a∥ ∂μ` is finite.
+/-- `integrable f μ` means that `f` is measurable and that the integral `∫⁻ a, ‖f a‖ ∂μ` is finite.
   `integrable f` means `integrable f volume`. -/
 def integrable {α} {m : measurable_space α} (f : α → β) (μ : measure α . volume_tac) : Prop :=
 ae_strongly_measurable f μ ∧ has_finite_integral f μ
@@ -410,22 +423,22 @@ lemma integrable.has_finite_integral {f : α → β} (hf : integrable f μ) : ha
 hf.2
 
 lemma integrable.mono {f : α → β} {g : α → γ}
-  (hg : integrable g μ) (hf : ae_strongly_measurable f μ) (h : ∀ᵐ a ∂μ, ∥f a∥ ≤ ∥g a∥) :
+  (hg : integrable g μ) (hf : ae_strongly_measurable f μ) (h : ∀ᵐ a ∂μ, ‖f a‖ ≤ ‖g a‖) :
   integrable f μ :=
 ⟨hf, hg.has_finite_integral.mono h⟩
 
 lemma integrable.mono' {f : α → β} {g : α → ℝ}
-  (hg : integrable g μ) (hf : ae_strongly_measurable f μ) (h : ∀ᵐ a ∂μ, ∥f a∥ ≤ g a) :
+  (hg : integrable g μ) (hf : ae_strongly_measurable f μ) (h : ∀ᵐ a ∂μ, ‖f a‖ ≤ g a) :
   integrable f μ :=
 ⟨hf, hg.has_finite_integral.mono' h⟩
 
 lemma integrable.congr' {f : α → β} {g : α → γ}
-  (hf : integrable f μ) (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ∥f a∥ = ∥g a∥) :
+  (hf : integrable f μ) (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ‖f a‖ = ‖g a‖) :
   integrable g μ :=
 ⟨hg, hf.has_finite_integral.congr' h⟩
 
 lemma integrable_congr' {f : α → β} {g : α → γ}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ∥f a∥ = ∥g a∥) :
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ‖f a‖ = ‖g a‖) :
   integrable f μ ↔ integrable g μ :=
 ⟨λ h2f, h2f.congr' hg h, λ h2g, h2g.congr' hf $ eventually_eq.symm h⟩
 
@@ -443,12 +456,12 @@ begin
   rw [integrable, and_iff_right this, has_finite_integral_const_iff]
 end
 
-lemma integrable_const [is_finite_measure μ] (c : β) : integrable (λ x : α, c) μ :=
+@[simp] lemma integrable_const [is_finite_measure μ] (c : β) : integrable (λ x : α, c) μ :=
 integrable_const_iff.2 $ or.inr $ measure_lt_top _ _
 
 lemma mem_ℒp.integrable_norm_rpow {f : α → β} {p : ℝ≥0∞}
   (hf : mem_ℒp f p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  integrable (λ (x : α), ∥f x∥ ^ p.to_real) μ :=
+  integrable (λ (x : α), ‖f x‖ ^ p.to_real) μ :=
 begin
   rw ← mem_ℒp_one_iff_integrable,
   exact hf.norm_rpow hp_ne_zero hp_ne_top,
@@ -456,7 +469,7 @@ end
 
 lemma mem_ℒp.integrable_norm_rpow' [is_finite_measure μ] {f : α → β} {p : ℝ≥0∞}
   (hf : mem_ℒp f p μ) :
-  integrable (λ (x : α), ∥f x∥ ^ p.to_real) μ :=
+  integrable (λ (x : α), ‖f x‖ ^ p.to_real) μ :=
 begin
   by_cases h_zero : p = 0,
   { simp [h_zero, integrable_const] },
@@ -494,7 +507,7 @@ by { rw ← mem_ℒp_one_iff_integrable at h ⊢, exact h.right_of_add_measure,
 
 @[simp] lemma integrable_zero_measure {m : measurable_space α} {f : α → β} :
   integrable f (0 : measure α) :=
-⟨ae_measurable_zero_measure f, has_finite_integral_zero_measure f⟩
+⟨ae_strongly_measurable_zero_measure f, has_finite_integral_zero_measure f⟩
 
 theorem integrable_finset_sum_measure {ι} {m : measurable_space α} {f : α → β}
   {μ : ι → measure α} {s : finset ι} :
@@ -510,6 +523,10 @@ lemma integrable_smul_measure {f : α → β} {c : ℝ≥0∞} (h₁ : c ≠ 0)
 ⟨λ h, by simpa only [smul_smul, ennreal.inv_mul_cancel h₁ h₂, one_smul]
   using h.smul_measure (ennreal.inv_ne_top.2 h₁), λ h, h.smul_measure h₂⟩
 
+lemma integrable_inv_smul_measure {f : α → β} {c : ℝ≥0∞} (h₁ : c ≠ 0) (h₂ : c ≠ ∞) :
+  integrable f (c⁻¹ • μ) ↔ integrable f μ :=
+integrable_smul_measure (by simpa using h₂) (by simpa using h₁)
+
 lemma integrable.to_average {f : α → β} (h : integrable f μ) :
   integrable f ((μ univ)⁻¹ • μ) :=
 begin
@@ -560,9 +577,8 @@ lemma lintegral_edist_lt_top {f g : α → β}
   (hf : integrable f μ) (hg : integrable g μ) :
   ∫⁻ a, edist (f a) (g a) ∂μ < ∞ :=
 lt_of_le_of_lt
-  (lintegral_edist_triangle hf.ae_strongly_measurable hg.ae_strongly_measurable
-    (ae_strongly_measurable_const : ae_strongly_measurable (λa, (0 : β)) μ))
-  (ennreal.add_lt_top.2 $ by { simp_rw ← has_finite_integral_iff_edist,
+  (lintegral_edist_triangle hf.ae_strongly_measurable ae_strongly_measurable_zero)
+  (ennreal.add_lt_top.2 $ by { simp_rw [pi.zero_apply, ← has_finite_integral_iff_edist],
                                exact ⟨hf.has_finite_integral, hg.has_finite_integral⟩ })
 
 variables (α β μ)
@@ -570,12 +586,11 @@ variables (α β μ)
 by simp [integrable, ae_strongly_measurable_const]
 variables {α β μ}
 
-lemma integrable.add' {f g : α → β} (hf : integrable f μ)
-  (hg : integrable g μ) :
+lemma integrable.add' {f g : α → β} (hf : integrable f μ) (hg : integrable g μ) :
   has_finite_integral (f + g) μ :=
-calc ∫⁻ a, ∥f a + g a∥₊ ∂μ ≤ ∫⁻ a, ∥f a∥₊ + ∥g a∥₊ ∂μ :
+calc ∫⁻ a, ‖f a + g a‖₊ ∂μ ≤ ∫⁻ a, ‖f a‖₊ + ‖g a‖₊ ∂μ :
   lintegral_mono (λ a, by exact_mod_cast nnnorm_add_le _ _)
-... = _ : lintegral_nnnorm_add hf.ae_strongly_measurable hg.ae_strongly_measurable
+... = _ : lintegral_nnnorm_add_left hf.ae_strongly_measurable _
 ... < ∞ : add_lt_top.2 ⟨hf.has_finite_integral, hg.has_finite_integral⟩
 
 lemma integrable.add
@@ -598,43 +613,98 @@ lemma integrable.neg {f : α → β} (hf : integrable f μ) : integrable (-f) μ
   integrable (-f) μ ↔ integrable f μ :=
 ⟨λ h, neg_neg f ▸ h.neg, integrable.neg⟩
 
-lemma integrable.sub' {f g : α → β}
-  (hf : integrable f μ) (hg : integrable g μ) : has_finite_integral (f - g) μ :=
-calc ∫⁻ a, ∥f a - g a∥₊ ∂μ ≤ ∫⁻ a, ∥f a∥₊ + ∥-g a∥₊ ∂μ :
-  lintegral_mono (assume a, by { simp only [sub_eq_add_neg], exact_mod_cast nnnorm_add_le _ _ } )
-... = _ :
-  by { simp only [nnnorm_neg],
-       exact lintegral_nnnorm_add hf.ae_strongly_measurable hg.ae_strongly_measurable }
-... < ∞ : add_lt_top.2 ⟨hf.has_finite_integral, hg.has_finite_integral⟩
-
 lemma integrable.sub {f g : α → β}
   (hf : integrable f μ) (hg : integrable g μ) : integrable (f - g) μ :=
 by simpa only [sub_eq_add_neg] using hf.add hg.neg
 
 lemma integrable.norm {f : α → β} (hf : integrable f μ) :
-  integrable (λa, ∥f a∥) μ :=
+  integrable (λ a, ‖f a‖) μ :=
 ⟨hf.ae_strongly_measurable.norm, hf.has_finite_integral.norm⟩
 
-lemma integrable.abs {f : α → ℝ} (hf : integrable f μ) :
-  integrable (λa, |f a|) μ :=
-by simpa [← real.norm_eq_abs] using hf.norm
+lemma integrable.inf {β} [normed_lattice_add_comm_group β] {f g : α → β}
+  (hf : integrable f μ) (hg : integrable g μ) :
+  integrable (f ⊓ g) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hf hg ⊢, exact hf.inf hg, }
+
+lemma integrable.sup {β} [normed_lattice_add_comm_group β] {f g : α → β}
+  (hf : integrable f μ) (hg : integrable g μ) :
+  integrable (f ⊔ g) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hf hg ⊢, exact hf.sup hg, }
+
+lemma integrable.abs {β} [normed_lattice_add_comm_group β] {f : α → β} (hf : integrable f μ) :
+  integrable (λ a, |f a|) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact hf.abs, }
+
+lemma integrable.bdd_mul {F : Type*} [normed_division_ring F]
+  {f g : α → F} (hint : integrable g μ) (hm : ae_strongly_measurable f μ)
+  (hfbdd : ∃ C, ∀ x, ‖f x‖ ≤ C) :
+  integrable (λ x, f x * g x) μ :=
+begin
+  casesI is_empty_or_nonempty α with hα hα,
+  { rw μ.eq_zero_of_is_empty,
+    exact integrable_zero_measure },
+  { refine ⟨hm.mul hint.1, _⟩,
+    obtain ⟨C, hC⟩ := hfbdd,
+    have hCnonneg : 0 ≤ C := le_trans (norm_nonneg _) (hC hα.some),
+    have : (λ x, ‖f x * g x‖₊) ≤ λ x, ⟨C, hCnonneg⟩ * ‖g x‖₊,
+    { intro x,
+      simp only [nnnorm_mul],
+      exact mul_le_mul_of_nonneg_right (hC x) (zero_le _) },
+    refine lt_of_le_of_lt (lintegral_mono_nnreal this) _,
+    simp only [ennreal.coe_mul],
+    rw lintegral_const_mul' _ _ ennreal.coe_ne_top,
+    exact ennreal.mul_lt_top ennreal.coe_ne_top (ne_of_lt hint.2) },
+end
+
+/-- Hölder's inequality for integrable functions: the scalar multiplication of an integrable
+vector-valued function by a scalar function with finite essential supremum is integrable. -/
+lemma integrable.ess_sup_smul {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β] {f : α → β}
+  (hf : integrable f μ) {g : α → 𝕜} (g_ae_strongly_measurable : ae_strongly_measurable g μ)
+  (ess_sup_g : ess_sup (λ x, (‖g x‖₊ : ℝ≥0∞)) μ ≠ ∞) :
+  integrable (λ (x : α), g x • f x) μ :=
+begin
+  rw ← mem_ℒp_one_iff_integrable at *,
+  refine ⟨g_ae_strongly_measurable.smul hf.1, _⟩,
+  have h : (1:ℝ≥0∞) / 1 = 1 / ∞ + 1 / 1 := by norm_num,
+  have hg' : snorm g ∞ μ ≠ ∞ := by rwa snorm_exponent_top,
+  calc snorm (λ (x : α), g x • f x) 1 μ
+      ≤ _ : measure_theory.snorm_smul_le_mul_snorm hf.1 g_ae_strongly_measurable h
+  ... < ∞ : ennreal.mul_lt_top hg' hf.2.ne,
+end
+
+/-- Hölder's inequality for integrable functions: the scalar multiplication of an integrable
+scalar-valued function by a vector-value function with finite essential supremum is integrable. -/
+lemma integrable.smul_ess_sup {𝕜 : Type*} [normed_ring 𝕜] [module 𝕜 β] [has_bounded_smul 𝕜 β]
+  {f : α → 𝕜}
+  (hf : integrable f μ) {g : α → β} (g_ae_strongly_measurable : ae_strongly_measurable g μ)
+  (ess_sup_g : ess_sup (λ x, (‖g x‖₊ : ℝ≥0∞)) μ ≠ ∞) :
+  integrable (λ (x : α), f x • g x) μ :=
+begin
+  rw ← mem_ℒp_one_iff_integrable at *,
+  refine ⟨hf.1.smul g_ae_strongly_measurable, _⟩,
+  have h : (1:ℝ≥0∞) / 1 = 1 / 1 + 1 / ∞ := by norm_num,
+  have hg' : snorm g ∞ μ ≠ ∞ := by rwa snorm_exponent_top,
+  calc snorm (λ (x : α), f x • g x) 1 μ
+      ≤ _ : measure_theory.snorm_smul_le_mul_snorm g_ae_strongly_measurable hf.1 h
+  ... < ∞ : ennreal.mul_lt_top hf.2.ne hg',
+end
 
 lemma integrable_norm_iff {f : α → β} (hf : ae_strongly_measurable f μ) :
-  integrable (λa, ∥f a∥) μ ↔ integrable f μ :=
+  integrable (λa, ‖f a‖) μ ↔ integrable f μ :=
 by simp_rw [integrable, and_iff_right hf, and_iff_right hf.norm, has_finite_integral_norm_iff]
 
 lemma integrable_of_norm_sub_le {f₀ f₁ : α → β} {g : α → ℝ}
   (hf₁_m : ae_strongly_measurable f₁ μ)
   (hf₀_i : integrable f₀ μ)
   (hg_i : integrable g μ)
-  (h : ∀ᵐ a ∂μ, ∥f₀ a - f₁ a∥ ≤ g a) :
+  (h : ∀ᵐ a ∂μ, ‖f₀ a - f₁ a‖ ≤ g a) :
   integrable f₁ μ :=
 begin
-  have : ∀ᵐ a ∂μ, ∥f₁ a∥ ≤ ∥f₀ a∥ + g a,
+  have : ∀ᵐ a ∂μ, ‖f₁ a‖ ≤ ‖f₀ a‖ + g a,
   { apply h.mono,
     intros a ha,
-    calc ∥f₁ a∥ ≤ ∥f₀ a∥ + ∥f₀ a - f₁ a∥ : norm_le_insert _ _
-    ... ≤ ∥f₀ a∥ + g a : add_le_add_left ha _ },
+    calc ‖f₁ a‖ ≤ ‖f₀ a‖ + ‖f₀ a - f₁ a‖ : norm_le_insert _ _
+    ... ≤ ‖f₀ a‖ + g a : add_le_add_left ha _ },
   exact integrable.mono' (hf₀_i.norm.add hg_i) hf₁_m this
 end
 
@@ -642,13 +712,29 @@ lemma integrable.prod_mk {f : α → β} {g : α → γ} (hf : integrable f μ)
   integrable (λ x, (f x, g x)) μ :=
 ⟨hf.ae_strongly_measurable.prod_mk hg.ae_strongly_measurable,
   (hf.norm.add' hg.norm).mono $ eventually_of_forall $ λ x,
-  calc max ∥f x∥ ∥g x∥ ≤ ∥f x∥ + ∥g x∥   : max_le_add_of_nonneg (norm_nonneg _) (norm_nonneg _)
-                 ... ≤ ∥(∥f x∥ + ∥g x∥)∥ : le_abs_self _⟩
+  calc max ‖f x‖ ‖g x‖ ≤ ‖f x‖ + ‖g x‖   : max_le_add_of_nonneg (norm_nonneg _) (norm_nonneg _)
+                 ... ≤ ‖(‖f x‖ + ‖g x‖)‖ : le_abs_self _⟩
 
 lemma mem_ℒp.integrable {q : ℝ≥0∞} (hq1 : 1 ≤ q) {f : α → β} [is_finite_measure μ]
   (hfq : mem_ℒp f q μ) : integrable f μ :=
 mem_ℒp_one_iff_integrable.mp (hfq.mem_ℒp_of_exponent_le hq1)
 
+/-- A non-quantitative version of Markov inequality for integrable functions: the measure of points
+where `‖f x‖ ≥ ε` is finite for all positive `ε`. -/
+lemma integrable.measure_ge_lt_top {f : α → β} (hf : integrable f μ) {ε : ℝ} (hε : 0 < ε) :
+  μ {x | ε ≤ ‖f x‖} < ∞ :=
+begin
+  rw show {x | ε ≤ ‖f x‖} = {x | ennreal.of_real ε ≤ ‖f x‖₊},
+    by simp only [ennreal.of_real, real.to_nnreal_le_iff_le_coe, ennreal.coe_le_coe, coe_nnnorm],
+  refine (meas_ge_le_mul_pow_snorm μ one_ne_zero ennreal.one_ne_top hf.1 _).trans_lt _,
+  { simpa only [ne.def, ennreal.of_real_eq_zero, not_le] using hε },
+  apply ennreal.mul_lt_top,
+  { simpa only [ennreal.one_to_real, ennreal.rpow_one, ne.def, ennreal.inv_eq_top,
+      ennreal.of_real_eq_zero, not_le] using hε },
+  simpa only [ennreal.one_to_real, ennreal.rpow_one]
+    using (mem_ℒp_one_iff_integrable.2 hf).snorm_ne_top,
+end
+
 lemma lipschitz_with.integrable_comp_iff_of_antilipschitz {K K'} {f : α → β} {g : β → γ}
   (hg : lipschitz_with K g) (hg' : antilipschitz_with K' g) (g0 : g 0 = 0) :
   integrable (g ∘ f) μ ↔ integrable f μ :=
@@ -663,7 +749,7 @@ begin
   refine lt_of_le_of_lt _ ((has_finite_integral_iff_norm _).1 hf.has_finite_integral),
   apply lintegral_mono,
   assume x,
-  simp [real.norm_eq_abs, ennreal.of_real_le_of_real, abs_le, abs_nonneg, le_abs_self],
+  simp [ennreal.of_real_le_of_real, abs_le, le_abs_self],
 end
 
 lemma of_real_to_real_ae_eq {f : α → ℝ≥0∞} (hf : ∀ᵐ x ∂μ, f x < ∞) :
@@ -683,7 +769,7 @@ begin
 end
 
 section
-variables  {E : Type*} [normed_group E] [normed_space ℝ E]
+variables  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
 
 lemma integrable_with_density_iff_integrable_coe_smul
   {f : α → ℝ≥0} (hf : measurable f) {g : α → E} :
@@ -754,7 +840,7 @@ begin
 end
 
 section
-variables {E : Type*} [normed_group E] [normed_space ℝ E]
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
 
 lemma mem_ℒ1_smul_of_L1_with_density {f : α → ℝ≥0} (f_meas : measurable f)
   (u : Lp E 1 (μ.with_density (λ x, f x))) :
@@ -810,7 +896,7 @@ noncomputable def with_density_smul_li {f : α → ℝ≥0} (f_meas : measurable
     apply lintegral_congr_ae,
     filter_upwards [(mem_ℒ1_smul_of_L1_with_density f_meas u).coe_fn_to_Lp] with x hx,
     rw [hx, pi.mul_apply],
-    change ↑∥(f x : ℝ) • u x∥₊ = ↑(f x) * ↑∥u x∥₊,
+    change ↑‖(f x : ℝ) • u x‖₊ = ↑(f x) * ↑‖u x‖₊,
     simp only [nnnorm_smul, nnreal.nnnorm_eq, ennreal.coe_mul],
   end }
 
@@ -848,42 +934,45 @@ hf.neg.pos_part
 
 end pos_part
 
-section normed_space
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]
+section has_bounded_smul
+variables {𝕜 : Type*}
 
-lemma integrable.smul (c : 𝕜) {f : α → β}
+lemma integrable.smul [normed_add_comm_group 𝕜] [smul_zero_class 𝕜 β] [has_bounded_smul 𝕜 β]
+  (c : 𝕜) {f : α → β}
   (hf : integrable f μ) : integrable (c • f) μ :=
 ⟨hf.ae_strongly_measurable.const_smul c, hf.has_finite_integral.smul c⟩
 
-lemma integrable_smul_iff {c : 𝕜} (hc : c ≠ 0) (f : α → β) :
+lemma is_unit.integrable_smul_iff [normed_ring 𝕜] [module 𝕜 β] [has_bounded_smul 𝕜 β]
+  {c : 𝕜} (hc : is_unit c) (f : α → β) :
   integrable (c • f) μ ↔ integrable f μ :=
-and_congr (ae_strongly_measurable_const_smul_iff₀ hc) (has_finite_integral_smul_iff hc f)
+and_congr (hc.ae_strongly_measurable_const_smul_iff) (has_finite_integral_smul_iff hc f)
 
-lemma integrable.const_mul {f : α → ℝ} (h : integrable f μ) (c : ℝ) :
-  integrable (λ x, c * f x) μ :=
-integrable.smul c h
+lemma integrable_smul_iff [normed_division_ring 𝕜] [module 𝕜 β] [has_bounded_smul 𝕜 β]
+  {c : 𝕜} (hc : c ≠ 0) (f : α → β) :
+  integrable (c • f) μ ↔ integrable f μ :=
+(is_unit.mk0 _ hc).integrable_smul_iff f
 
-lemma integrable.const_mul' {f : α → ℝ} (h : integrable f μ) (c : ℝ) :
-  integrable ((λ (x : α), c) * f) μ :=
-integrable.smul c h
+variables [normed_ring 𝕜] [module 𝕜 β] [has_bounded_smul 𝕜 β]
 
-lemma integrable.mul_const {f : α → ℝ} (h : integrable f μ) (c : ℝ) :
-  integrable (λ x, f x * c) μ :=
-by simp_rw [mul_comm, h.const_mul _]
+lemma integrable.smul_of_top_right {f : α → β} {φ : α → 𝕜}
+  (hf : integrable f μ) (hφ : mem_ℒp φ ∞ μ) :
+  integrable (φ • f) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact mem_ℒp.smul_of_top_right hf hφ }
 
-lemma integrable.mul_const' {f : α → ℝ} (h : integrable f μ) (c : ℝ) :
-  integrable (f * (λ (x : α), c)) μ :=
-integrable.mul_const h c
+lemma integrable.smul_of_top_left {f : α → β} {φ : α → 𝕜}
+  (hφ : integrable φ μ) (hf : mem_ℒp f ∞ μ) :
+  integrable (φ • f) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hφ ⊢, exact mem_ℒp.smul_of_top_left hf hφ }
 
-lemma integrable.div_const {f : α → ℝ} (h : integrable f μ) (c : ℝ) :
-  integrable (λ x, f x / c) μ :=
-by simp_rw [div_eq_mul_inv, h.mul_const]
+lemma integrable.smul_const {f : α → 𝕜} (hf : integrable f μ) (c : β) :
+  integrable (λ x, f x • c) μ :=
+hf.smul_of_top_left (mem_ℒp_top_const c)
 
-end normed_space
+end has_bounded_smul
 
 section normed_space_over_complete_field
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [complete_space 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [complete_space 𝕜]
+variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
 
 lemma integrable_smul_const {f : α → 𝕜} {c : E} (hc : c ≠ 0) :
   integrable (λ x, f x • c) μ ↔ integrable f μ :=
@@ -894,8 +983,57 @@ begin
   have : ∀ x : ℝ≥0∞, x = 0 → x < ∞ := by simp,
   simp [hc, or_iff_left_of_imp (this _)]
 end
+
 end normed_space_over_complete_field
 
+section normed_ring
+variables {𝕜 : Type*} [normed_ring 𝕜] {f : α → 𝕜}
+
+lemma integrable.const_mul {f : α → 𝕜} (h : integrable f μ) (c : 𝕜) :
+  integrable (λ x, c * f x) μ :=
+h.smul c
+
+lemma integrable.const_mul' {f : α → 𝕜} (h : integrable f μ) (c : 𝕜) :
+  integrable ((λ (x : α), c) * f) μ :=
+integrable.const_mul h c
+
+lemma integrable.mul_const {f : α → 𝕜} (h : integrable f μ) (c : 𝕜) :
+  integrable (λ x, f x * c) μ :=
+h.smul (mul_opposite.op c)
+
+lemma integrable.mul_const' {f : α → 𝕜} (h : integrable f μ) (c : 𝕜) :
+  integrable (f * (λ (x : α), c)) μ :=
+integrable.mul_const h c
+
+lemma integrable_const_mul_iff {c : 𝕜} (hc : is_unit c) (f : α → 𝕜) :
+  integrable (λ x, c * f x) μ ↔ integrable f μ :=
+hc.integrable_smul_iff f
+
+lemma integrable_mul_const_iff {c : 𝕜} (hc : is_unit c) (f : α → 𝕜) :
+  integrable (λ x, f x * c) μ ↔ integrable f μ :=
+hc.op.integrable_smul_iff f
+
+lemma integrable.bdd_mul' {f g : α → 𝕜} {c : ℝ} (hg : integrable g μ)
+  (hf : ae_strongly_measurable f μ) (hf_bound : ∀ᵐ x ∂μ, ‖f x‖ ≤ c) :
+  integrable (λ x, f x * g x) μ :=
+begin
+  refine integrable.mono' (hg.norm.smul c) (hf.mul hg.1) _,
+  filter_upwards [hf_bound] with x hx,
+  rw [pi.smul_apply, smul_eq_mul],
+  exact (norm_mul_le _ _).trans (mul_le_mul_of_nonneg_right hx (norm_nonneg _)),
+end
+
+end normed_ring
+
+section normed_division_ring
+variables {𝕜 : Type*} [normed_division_ring 𝕜] {f : α → 𝕜}
+
+lemma integrable.div_const {f : α → 𝕜} (h : integrable f μ) (c : 𝕜) :
+  integrable (λ x, f x / c) μ :=
+by simp_rw [div_eq_mul_inv, h.mul_const]
+
+end normed_division_ring
+
 section is_R_or_C
 variables {𝕜 : Type*} [is_R_or_C 𝕜] {f : α → 𝕜}
 
@@ -916,22 +1054,10 @@ by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact hf.im, }
 
 end is_R_or_C
 
-section inner_product
-variables {𝕜 E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E] {f : α → E}
-
-local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
-
-lemma integrable.const_inner (c : E) (hf : integrable f μ) : integrable (λ x, ⟪c, f x⟫) μ :=
-by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact hf.const_inner c, }
-
-lemma integrable.inner_const (hf : integrable f μ) (c : E) : integrable (λ x, ⟪f x, c⟫) μ :=
-by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact hf.inner_const c, }
-
-end inner_product
-
 section trim
 
-variables {H : Type*} [normed_group H] {m0 : measurable_space α} {μ' : measure α} {f : α → H}
+variables {H : Type*} [normed_add_comm_group H] {m0 : measurable_space α} {μ' : measure α}
+  {f : α → H}
 
 lemma integrable.trim (hm : m ≤ m0) (hf_int : integrable f μ') (hf : strongly_measurable[m] f) :
   integrable f (μ'.trim hm) :=
@@ -956,17 +1082,17 @@ end trim
 
 section sigma_finite
 
-variables {E : Type*} {m0 : measurable_space α} [normed_group E]
+variables {E : Type*} {m0 : measurable_space α} [normed_add_comm_group E]
 
 lemma integrable_of_forall_fin_meas_le' {μ : measure α} (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
   (C : ℝ≥0∞) (hC : C < ∞) {f : α → E} (hf_meas : ae_strongly_measurable f μ)
-  (hf : ∀ s, measurable_set[m] s → μ s ≠ ∞ → ∫⁻ x in s, ∥f x∥₊ ∂μ ≤ C) :
+  (hf : ∀ s, measurable_set[m] s → μ s ≠ ∞ → ∫⁻ x in s, ‖f x‖₊ ∂μ ≤ C) :
   integrable f μ :=
 ⟨hf_meas, (lintegral_le_of_forall_fin_meas_le' hm C hf_meas.ennnorm hf).trans_lt hC⟩
 
 lemma integrable_of_forall_fin_meas_le [sigma_finite μ]
   (C : ℝ≥0∞) (hC : C < ∞) {f : α → E} (hf_meas : ae_strongly_measurable f μ)
-  (hf : ∀ s : set α, measurable_set s → μ s ≠ ∞ → ∫⁻ x in s, ∥f x∥₊ ∂μ ≤ C) :
+  (hf : ∀ s : set α, measurable_set s → μ s ≠ ∞ → ∫⁻ x in s, ‖f x‖₊ ∂μ ≤ C) :
   integrable f μ :=
 @integrable_of_forall_fin_meas_le' _ _ _ _ _ _ _ (by rwa trim_eq_self) C hC _ hf_meas hf
 
@@ -1021,13 +1147,13 @@ lemma integrable.sub {f g : α →ₘ[μ] β} (hf : integrable f) (hg : integrab
 
 end
 
-section normed_space
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]
+section has_bounded_smul
+variables {𝕜 : Type*} [normed_ring 𝕜] [module 𝕜 β] [has_bounded_smul 𝕜 β]
 
 lemma integrable.smul {c : 𝕜} {f : α →ₘ[μ] β} : integrable f → integrable (c • f) :=
 induction_on f $ λ f hfm hfi, (integrable_mk _).2 $ ((integrable_mk hfm).1 hfi).smul _
 
-end normed_space
+end has_bounded_smul
 
 end
 
@@ -1066,14 +1192,14 @@ lemma dist_def (f g : α →₁[μ] β) :
 by { simp [Lp.dist_def, snorm, snorm'], simp [edist_eq_coe_nnnorm_sub] }
 
 lemma norm_def (f : α →₁[μ] β) :
-  ∥f∥ = (∫⁻ a, ∥f a∥₊ ∂μ).to_real :=
+  ‖f‖ = (∫⁻ a, ‖f a‖₊ ∂μ).to_real :=
 by { simp [Lp.norm_def, snorm, snorm'] }
 
 /-- Computing the norm of a difference between two L¹-functions. Note that this is not a
   special case of `norm_def` since `(f - g) x` and `f x - g x` are not equal
   (but only a.e.-equal). -/
 lemma norm_sub_eq_lintegral (f g : α →₁[μ] β) :
-  ∥f - g∥ = (∫⁻ x, (∥f x - g x∥₊ : ℝ≥0∞) ∂μ).to_real :=
+  ‖f - g‖ = (∫⁻ x, (‖f x - g x‖₊ : ℝ≥0∞) ∂μ).to_real :=
 begin
   rw [norm_def],
   congr' 1,
@@ -1083,14 +1209,14 @@ begin
 end
 
 lemma of_real_norm_eq_lintegral (f : α →₁[μ] β) :
-  ennreal.of_real ∥f∥ = ∫⁻ x, (∥f x∥₊ : ℝ≥0∞) ∂μ :=
+  ennreal.of_real ‖f‖ = ∫⁻ x, (‖f x‖₊ : ℝ≥0∞) ∂μ :=
 by { rw [norm_def, ennreal.of_real_to_real], exact ne_of_lt (has_finite_integral_coe_fn f) }
 
 /-- Computing the norm of a difference between two L¹-functions. Note that this is not a
   special case of `of_real_norm_eq_lintegral` since `(f - g) x` and `f x - g x` are not equal
   (but only a.e.-equal). -/
 lemma of_real_norm_sub_eq_lintegral (f g : α →₁[μ] β) :
-  ennreal.of_real ∥f - g∥ = ∫⁻ x, (∥f x - g x∥₊ : ℝ≥0∞) ∂μ :=
+  ennreal.of_real ‖f - g‖ = ∫⁻ x, (‖f x - g x‖₊ : ℝ≥0∞) ∂μ :=
 begin
   simp_rw [of_real_norm_eq_lintegral, ← edist_eq_coe_nnnorm],
   apply lintegral_congr_ae,
@@ -1133,11 +1259,11 @@ lemma to_L1_sub (f g : α → β) (hf : integrable f μ) (hg : integrable g μ)
   to_L1 (f - g) (hf.sub hg) = to_L1 f hf - to_L1 g hg := rfl
 
 lemma norm_to_L1 (f : α → β) (hf : integrable f μ) :
-  ∥hf.to_L1 f∥ = ennreal.to_real (∫⁻ a, edist (f a) 0 ∂μ) :=
+  ‖hf.to_L1 f‖ = ennreal.to_real (∫⁻ a, edist (f a) 0 ∂μ) :=
 by { simp [to_L1, snorm, snorm'], simp [edist_eq_coe_nnnorm] }
 
 lemma norm_to_L1_eq_lintegral_norm (f : α → β) (hf : integrable f μ) :
-  ∥hf.to_L1 f∥ = ennreal.to_real (∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ) :=
+  ‖hf.to_L1 f‖ = ennreal.to_real (∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ) :=
 by { rw [norm_to_L1, lintegral_norm_eq_lintegral_edist] }
 
 @[simp] lemma edist_to_L1_to_L1 (f g : α → β) (hf : integrable f μ) (hg : integrable g μ) :
@@ -1148,7 +1274,7 @@ by { simp [integrable.to_L1, snorm, snorm'], simp [edist_eq_coe_nnnorm_sub] }
   edist (hf.to_L1 f) 0 = ∫⁻ a, edist (f a) 0 ∂μ :=
 by { simp [integrable.to_L1, snorm, snorm'], simp [edist_eq_coe_nnnorm] }
 
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]
+variables {𝕜 : Type*} [normed_ring 𝕜] [module 𝕜 β] [has_bounded_smul 𝕜 β]
 
 lemma to_L1_smul (f : α → β) (hf : integrable f μ) (k : 𝕜) :
   to_L1 (λ a, k • f a) (hf.smul k) = k • to_L1 f hf := rfl
@@ -1162,17 +1288,17 @@ end measure_theory
 
 open measure_theory
 
-variables {E : Type*} [normed_group E]
-          {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
-          {H : Type*} [normed_group H] [normed_space 𝕜 H]
+variables {E : Type*} [normed_add_comm_group E]
+          {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
+          {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H]
 
 lemma measure_theory.integrable.apply_continuous_linear_map {φ : α → H →L[𝕜] E}
   (φ_int : integrable φ μ) (v : H) : integrable (λ a, φ a v) μ :=
-(φ_int.norm.mul_const ∥v∥).mono' (φ_int.ae_strongly_measurable.apply_continuous_linear_map v)
+(φ_int.norm.mul_const ‖v‖).mono' (φ_int.ae_strongly_measurable.apply_continuous_linear_map v)
   (eventually_of_forall $ λ a, (φ a).le_op_norm v)
 
 lemma continuous_linear_map.integrable_comp {φ : α → H} (L : H →L[𝕜] E)
   (φ_int : integrable φ μ) : integrable (λ (a : α), L (φ a)) μ :=
-((integrable.norm φ_int).const_mul ∥L∥).mono'
+((integrable.norm φ_int).const_mul ‖L‖).mono'
   (L.continuous.comp_ae_strongly_measurable φ_int.ae_strongly_measurable)
   (eventually_of_forall $ λ a, L.le_op_norm (φ a))
diff --git a/src/measure_theory/function/l2_space.lean b/src/measure_theory/function/l2_space.lean
index b5fa74214189a..73e7a16a5e4d8 100644
--- a/src/measure_theory/function/l2_space.lean
+++ b/src/measure_theory/function/l2_space.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Rémy Degenne. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
-import analysis.inner_product_space.basic
+import data.is_R_or_C.lemmas
+import measure_theory.function.strongly_measurable.inner
 import measure_theory.integral.set_integral
 
 /-! # `L^2` space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `E` is an inner product space over `𝕜` (`ℝ` or `ℂ`), then `Lp E 2 μ` (defined in `lp_space.lean`)
 is also an inner product space, with inner product defined as `inner f g = ∫ a, ⟪f a, g a⟫ ∂μ`.
 
@@ -22,27 +26,27 @@ is also an inner product space, with inner product defined as `inner f g = ∫ a
 -/
 
 noncomputable theory
-open topological_space measure_theory measure_theory.Lp
+open topological_space measure_theory measure_theory.Lp filter
 open_locale nnreal ennreal measure_theory
 
 namespace measure_theory
 
 section
 
-variables {α F : Type*} {m : measurable_space α} {μ : measure α} [normed_group F]
+variables {α F : Type*} {m : measurable_space α} {μ : measure α} [normed_add_comm_group F]
 
 lemma mem_ℒp.integrable_sq {f : α → ℝ} (h : mem_ℒp f 2 μ) :
   integrable (λ x, (f x)^2) μ :=
-by simpa [real.norm_eq_abs, ← mem_ℒp_one_iff_integrable]
-  using h.norm_rpow ennreal.two_ne_zero ennreal.two_ne_top
+by simpa [← mem_ℒp_one_iff_integrable]
+  using h.norm_rpow two_ne_zero ennreal.two_ne_top
 
 lemma mem_ℒp_two_iff_integrable_sq_norm {f : α → F} (hf : ae_strongly_measurable f μ) :
-  mem_ℒp f 2 μ ↔ integrable (λ x, ∥f x∥^2) μ :=
+  mem_ℒp f 2 μ ↔ integrable (λ x, ‖f x‖^2) μ :=
 begin
   rw ← mem_ℒp_one_iff_integrable,
-  convert (mem_ℒp_norm_rpow_iff hf ennreal.two_ne_zero ennreal.two_ne_top).symm,
+  convert (mem_ℒp_norm_rpow_iff hf two_ne_zero ennreal.two_ne_top).symm,
   { simp },
-  { rw [div_eq_mul_inv, ennreal.mul_inv_cancel ennreal.two_ne_zero ennreal.two_ne_top] }
+  { rw [div_eq_mul_inv, ennreal.mul_inv_cancel two_ne_zero ennreal.two_ne_top] }
 end
 
 lemma mem_ℒp_two_iff_integrable_sq {f : α → ℝ} (hf : ae_strongly_measurable f μ) :
@@ -50,20 +54,62 @@ lemma mem_ℒp_two_iff_integrable_sq {f : α → ℝ} (hf : ae_strongly_measurab
 begin
   convert mem_ℒp_two_iff_integrable_sq_norm hf,
   ext x,
-  simp [real.norm_eq_abs],
+  simp,
 end
 
 end
 
+section inner_product_space
+
+variables {α : Type*} {m : measurable_space α} {p : ℝ≥0∞} {μ : measure α}
+variables {E 𝕜 : Type*} [is_R_or_C 𝕜] [normed_add_comm_group E] [inner_product_space 𝕜 E]
+
+local notation `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
+
+lemma mem_ℒp.const_inner (c : E) {f : α → E} (hf : mem_ℒp f p μ) :
+  mem_ℒp (λ a, ⟪c, f a⟫) p μ :=
+hf.of_le_mul (ae_strongly_measurable.inner ae_strongly_measurable_const hf.1)
+  (eventually_of_forall (λ x, norm_inner_le_norm _ _))
+
+lemma mem_ℒp.inner_const {f : α → E} (hf : mem_ℒp f p μ) (c : E) :
+  mem_ℒp (λ a, ⟪f a, c⟫) p μ :=
+hf.of_le_mul (ae_strongly_measurable.inner hf.1 ae_strongly_measurable_const)
+  (eventually_of_forall (λ x, by { rw mul_comm, exact norm_inner_le_norm _ _, }))
+
+variables {f : α → E}
+
+lemma integrable.const_inner (c : E) (hf : integrable f μ) : integrable (λ x, ⟪c, f x⟫) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact hf.const_inner c, }
+
+lemma integrable.inner_const (hf : integrable f μ) (c : E) : integrable (λ x, ⟪f x, c⟫) μ :=
+by { rw ← mem_ℒp_one_iff_integrable at hf ⊢, exact hf.inner_const c, }
+
+variables [complete_space E] [normed_space ℝ E]
+
+lemma _root_.integral_inner {f : α → E} (hf : integrable f μ) (c : E) :
+  ∫ x, ⟪c, f x⟫ ∂μ = ⟪c, ∫ x, f x ∂μ⟫ :=
+((innerSL 𝕜 c).restrict_scalars ℝ).integral_comp_comm hf
+
+variables (𝕜)
+-- variable binder update doesn't work for lemmas which refer to `𝕜` only via the notation
+local notation (name := inner_with_explicit) `⟪`x`, `y`⟫` := @inner 𝕜 E _ x y
+
+lemma _root_.integral_eq_zero_of_forall_integral_inner_eq_zero (f : α → E) (hf : integrable f μ)
+  (hf_int : ∀ (c : E), ∫ x, ⟪c, f x⟫ ∂μ = 0) :
+  ∫ x, f x ∂μ = 0 :=
+by { specialize hf_int (∫ x, f x ∂μ), rwa [integral_inner hf, inner_self_eq_zero] at hf_int }
+
+end inner_product_space
+
 namespace L2
 
 variables {α E F 𝕜 : Type*} [is_R_or_C 𝕜] [measurable_space α] {μ : measure α}
-  [inner_product_space 𝕜 E] [normed_group F]
+  [normed_add_comm_group E] [inner_product_space 𝕜 E] [normed_add_comm_group F]
 
 
 local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y
 
-lemma snorm_rpow_two_norm_lt_top (f : Lp F 2 μ) : snorm (λ x, ∥f x∥ ^ (2 : ℝ)) 1 μ < ∞ :=
+lemma snorm_rpow_two_norm_lt_top (f : Lp F 2 μ) : snorm (λ x, ‖f x‖ ^ (2 : ℝ)) 1 μ < ∞ :=
 begin
   have h_two : ennreal.of_real (2 : ℝ) = 2, by simp [zero_le_one],
   rw [snorm_norm_rpow f zero_lt_two, one_mul, h_two],
@@ -72,19 +118,17 @@ end
 
 lemma snorm_inner_lt_top (f g : α →₂[μ] E) : snorm (λ (x : α), ⟪f x, g x⟫) 1 μ < ∞ :=
 begin
-  have h : ∀ x, is_R_or_C.abs ⟪f x, g x⟫ ≤ ∥f x∥ * ∥g x∥, from λ x, abs_inner_le_norm _ _,
-  have h' : ∀ x, is_R_or_C.abs ⟪f x, g x⟫ ≤ is_R_or_C.abs (∥f x∥^2 + ∥g x∥^2),
-  { refine λ x, le_trans (h x) _,
-    rw [is_R_or_C.abs_to_real, abs_eq_self.mpr],
-    swap, { exact add_nonneg (by simp) (by simp), },
-    refine le_trans _ (half_le_self (add_nonneg (sq_nonneg _) (sq_nonneg _))),
-    refine (le_div_iff (@zero_lt_two ℝ _ _)).mpr ((le_of_eq _).trans (two_mul_le_add_sq _ _)),
-    ring, },
-  simp_rw [← is_R_or_C.norm_eq_abs, ← real.rpow_nat_cast] at h',
-  refine (snorm_mono_ae (ae_of_all _ h')).trans_lt ((snorm_add_le _ _ le_rfl).trans_lt _),
+  have h : ∀ x, ‖⟪f x, g x⟫‖ ≤ ‖‖f x‖ ^ (2 : ℝ) + ‖g x‖ ^ (2 : ℝ)‖,
+  { intro x,
+    rw [← @nat.cast_two ℝ, real.rpow_nat_cast, real.rpow_nat_cast],
+    calc ‖⟪f x, g x⟫‖ ≤ ‖f x‖ * ‖g x‖ : norm_inner_le_norm _ _
+    ... ≤ 2 * ‖f x‖ * ‖g x‖ :
+      mul_le_mul_of_nonneg_right (le_mul_of_one_le_left (norm_nonneg _) one_le_two) (norm_nonneg _)
+    ... ≤ ‖‖f x‖^2 + ‖g x‖^2‖ : (two_mul_le_add_sq _ _).trans (le_abs_self _) },
+  refine (snorm_mono_ae (ae_of_all _ h)).trans_lt ((snorm_add_le _ _ le_rfl).trans_lt _),
   { exact ((Lp.ae_strongly_measurable f).norm.ae_measurable.pow_const _).ae_strongly_measurable },
   { exact ((Lp.ae_strongly_measurable g).norm.ae_measurable.pow_const _).ae_strongly_measurable },
-  simp only [nat.cast_bit0, ennreal.add_lt_top, nat.cast_one],
+  rw [ennreal.add_lt_top],
   exact ⟨snorm_rpow_two_norm_lt_top f, snorm_rpow_two_norm_lt_top g⟩,
 end
 
@@ -98,7 +142,7 @@ instance : has_inner 𝕜 (α →₂[μ] E) := ⟨λ f g, ∫ a, ⟪f a, g a⟫
 lemma inner_def (f g : α →₂[μ] E) : ⟪f, g⟫ = ∫ a : α, ⟪f a, g a⟫ ∂μ := rfl
 
 lemma integral_inner_eq_sq_snorm (f : α →₂[μ] E) :
-  ∫ a, ⟪f a, f a⟫ ∂μ = ennreal.to_real ∫⁻ a, (∥f a∥₊ : ℝ≥0∞) ^ (2:ℝ) ∂μ :=
+  ∫ a, ⟪f a, f a⟫ ∂μ = ennreal.to_real ∫⁻ a, (‖f a‖₊ : ℝ≥0∞) ^ (2:ℝ) ∂μ :=
 begin
   simp_rw inner_self_eq_norm_sq_to_K,
   norm_cast,
@@ -114,16 +158,16 @@ begin
   norm_cast,
 end
 
-private lemma norm_sq_eq_inner' (f : α →₂[μ] E) : ∥f∥ ^ 2 = is_R_or_C.re ⟪f, f⟫ :=
+private lemma norm_sq_eq_inner' (f : α →₂[μ] E) : ‖f‖ ^ 2 = is_R_or_C.re ⟪f, f⟫ :=
 begin
   have h_two : (2 : ℝ≥0∞).to_real = 2 := by simp,
   rw [inner_def, integral_inner_eq_sq_snorm, norm_def, ← ennreal.to_real_pow, is_R_or_C.of_real_re,
     ennreal.to_real_eq_to_real (ennreal.pow_ne_top (Lp.snorm_ne_top f)) _],
-  { rw [←ennreal.rpow_nat_cast, snorm_eq_snorm' ennreal.two_ne_zero ennreal.two_ne_top, snorm',
+  { rw [←ennreal.rpow_nat_cast, snorm_eq_snorm' two_ne_zero ennreal.two_ne_top, snorm',
       ← ennreal.rpow_mul, one_div, h_two],
     simp, },
   { refine (lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top zero_lt_two _).ne,
-    rw [← h_two, ← snorm_eq_snorm' ennreal.two_ne_zero ennreal.two_ne_top],
+    rw [← h_two, ← snorm_eq_snorm' two_ne_zero ennreal.two_ne_top],
     exact Lp.snorm_lt_top f, },
 end
 
@@ -158,7 +202,7 @@ end
 
 instance inner_product_space : inner_product_space 𝕜 (α →₂[μ] E) :=
 { norm_sq_eq_inner := norm_sq_eq_inner',
-  conj_sym := λ _ _, by simp_rw [inner_def, ← integral_conj, inner_conj_sym],
+  conj_symm := λ _ _, by simp_rw [inner_def, ← integral_conj, inner_conj_symm],
   add_left := add_left',
   smul_left := smul_left', }
 
@@ -195,7 +239,7 @@ begin
       from indicator_const_Lp_coe_fn_nmem,
     refine h_indicator.mono (λ x hx hxs, _),
     rw hx hxs,
-    exact inner_zero_left, },
+    exact inner_zero_left _, },
   rw [h_left, h_right, add_zero],
 end
 
@@ -236,8 +280,8 @@ lemma bounded_continuous_function.inner_to_Lp (f g : α →ᵇ 𝕜) :
   = ∫ x, conj (f x) * g x ∂μ :=
 begin
   apply integral_congr_ae,
-  have hf_ae := f.coe_fn_to_Lp μ,
-  have hg_ae := g.coe_fn_to_Lp μ,
+  have hf_ae := f.coe_fn_to_Lp 2 μ 𝕜,
+  have hg_ae := g.coe_fn_to_Lp 2 μ 𝕜,
   filter_upwards [hf_ae, hg_ae] with _ hf hg,
   rw [hf, hg],
   simp
diff --git a/src/measure_theory/function/locally_integrable.lean b/src/measure_theory/function/locally_integrable.lean
index e8d07e8aeebf3..a60ff6ae5fe66 100644
--- a/src/measure_theory/function/locally_integrable.lean
+++ b/src/measure_theory/function/locally_integrable.lean
@@ -8,184 +8,479 @@ import measure_theory.integral.integrable_on
 /-!
 # Locally integrable functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A function is called *locally integrable* (`measure_theory.locally_integrable`) if it is integrable
-on every compact subset of its domain.
+on a neighborhood of every point. More generally, it is *locally integrable on `s`* if it is
+locally integrable on a neighbourhood within `s` of any point of `s`.
 
-This file contains properties of locally integrable functions and of integrability results
+This file contains properties of locally integrable functions, and integrability results
 on compact sets.
 
 ## Main statements
 
 * `continuous.locally_integrable`: A continuous function is locally integrable.
-
+* `continuous_on.locally_integrable_on`: A function which is continuous on `s` is locally
+  integrable on `s`.
 -/
 
 open measure_theory measure_theory.measure set function topological_space
-open_locale topological_space interval
+open_locale topology interval
 
-variables {X Y E : Type*} [measurable_space X] [topological_space X]
+variables {X Y E R : Type*} [measurable_space X] [topological_space X]
 variables [measurable_space Y] [topological_space Y]
-variables [normed_group E] {f : X → E} {μ : measure X}
+variables [normed_add_comm_group E] {f : X → E} {μ : measure X} {s : set X}
 
 namespace measure_theory
 
-/-- A function `f : X → E` is locally integrable if it is integrable on all compact sets.
-  See `measure_theory.locally_integrable_iff` for the justification of this name. -/
+section locally_integrable_on
+
+/-- A function `f : X → E` is *locally integrable on s*, for `s ⊆ X`, if for every `x ∈ s` there is
+a neighbourhood of `x` within `s` on which `f` is integrable. (Note this is, in general, strictly
+weaker than local integrability with respect to `μ.restrict s`.) -/
+def locally_integrable_on (f : X → E) (s : set X) (μ : measure X . volume_tac) : Prop :=
+∀ (x : X), x ∈ s → integrable_at_filter f (𝓝[s] x) μ
+
+lemma locally_integrable_on.mono
+  (hf : measure_theory.locally_integrable_on f s μ) {t : set X} (hst : t ⊆ s) :
+  locally_integrable_on f t μ :=
+λ x hx, (hf x $ hst hx).filter_mono (nhds_within_mono x hst)
+
+lemma locally_integrable_on.norm (hf : locally_integrable_on f s μ) :
+  locally_integrable_on (λ x, ‖f x‖) s μ :=
+λ t ht, let ⟨U, hU_nhd, hU_int⟩ := hf t ht in ⟨U, hU_nhd, hU_int.norm⟩
+
+lemma integrable_on.locally_integrable_on (hf : integrable_on f s μ) :
+  locally_integrable_on f s μ :=
+λ x hx, ⟨s, self_mem_nhds_within, hf⟩
+
+/-- If a function is locally integrable on a compact set, then it is integrable on that set. -/
+lemma locally_integrable_on.integrable_on_is_compact
+  (hf : locally_integrable_on f s μ) (hs : is_compact s) :
+  integrable_on f s μ :=
+is_compact.induction_on hs integrable_on_empty (λ u v huv hv, hv.mono_set huv)
+  (λ u v hu hv, integrable_on_union.mpr ⟨hu, hv⟩) hf
+
+lemma locally_integrable_on.integrable_on_compact_subset
+  (hf : locally_integrable_on f s μ) {t : set X} (hst : t ⊆ s) (ht : is_compact t) :
+  integrable_on f t μ :=
+(hf.mono hst).integrable_on_is_compact ht
+
+lemma locally_integrable_on.ae_strongly_measurable [second_countable_topology X]
+  (hf : locally_integrable_on f s μ) :
+  ae_strongly_measurable f (μ.restrict s) :=
+begin
+  have : ∀ (x : s), ∃ u, is_open u ∧ x.1 ∈ u ∧ integrable_on f (u ∩ s) μ,
+  { rintro ⟨x, hx⟩,
+    rcases hf x hx with ⟨t, ht, h't⟩,
+    rcases mem_nhds_within.1 ht with ⟨u, u_open, x_mem, u_sub⟩,
+    refine ⟨u, u_open, x_mem, h't.mono_set u_sub⟩ },
+  choose u u_open xu hu using this,
+  obtain ⟨T, T_count, hT⟩ : ∃ (T : set s), T.countable ∧ s = (⋃ (i : T), u i ∩ s),
+  { have : s ⊆ (⋃ (x : s), u x), from λ y hy, mem_Union_of_mem ⟨y, hy⟩ (xu ⟨y, hy⟩),
+    obtain ⟨T, hT_count, hT_un⟩ := is_open_Union_countable u u_open,
+    refine ⟨T, hT_count, _⟩,
+    rw [←hT_un, bUnion_eq_Union] at this,
+    rw [←Union_inter, eq_comm, inter_eq_right_iff_subset],
+    exact this },
+  haveI : countable T, from countable_coe_iff.mpr T_count,
+  rw [hT, ae_strongly_measurable_Union_iff],
+  exact λ (i : T), (hu i).ae_strongly_measurable,
+end
+
+/-- If `s` is either open, or closed, then `f` is locally integrable on `s` iff it is integrable on
+every compact subset contained in `s`. -/
+lemma locally_integrable_on_iff [locally_compact_space X] [t2_space X]
+  (hs : is_closed s ∨ is_open s) :
+  locally_integrable_on f s μ ↔ ∀ (k : set X) (hk : k ⊆ s), is_compact k → integrable_on f k μ :=
+begin
+  -- The correct condition is that `s` be *locally closed*, i.e. for every `x ∈ s` there is some
+  -- `U ∈ 𝓝 x` such that `U ∩ s` is closed. But mathlib doesn't have locally closed sets yet.
+  refine ⟨λ hf k hk, hf.integrable_on_compact_subset hk, λ hf x hx, _⟩,
+  cases hs,
+  { exact let ⟨K, hK, h2K⟩ := exists_compact_mem_nhds x in ⟨_, inter_mem_nhds_within s h2K,
+    hf _ (inter_subset_left _ _) (is_compact_of_is_closed_subset hK (hs.inter hK.is_closed)
+    (inter_subset_right _ _))⟩ },
+  { obtain ⟨K, hK, h2K, h3K⟩ := exists_compact_subset hs hx,
+    refine ⟨K, _, hf K h3K hK⟩,
+    simpa only [is_open.nhds_within_eq hs hx, interior_eq_nhds'] using h2K }
+end
+
+end locally_integrable_on
+
+/-- A function `f : X → E` is *locally integrable* if it is integrable on a neighborhood of every
+point. In particular, it is integrable on all compact sets,
+see `locally_integrable.integrable_on_is_compact`. -/
 def locally_integrable (f : X → E) (μ : measure X . volume_tac) : Prop :=
-∀ ⦃K⦄, is_compact K → integrable_on f K μ
+∀ (x : X), integrable_at_filter f (𝓝 x) μ
 
-lemma integrable.locally_integrable (hf : integrable f μ) : locally_integrable f μ :=
-λ K hK, hf.integrable_on
+lemma locally_integrable_on_univ : locally_integrable_on f univ μ ↔ locally_integrable f μ :=
+by simpa only [locally_integrable_on, nhds_within_univ, mem_univ, true_implies_iff]
 
-lemma locally_integrable.ae_strongly_measurable [sigma_compact_space X]
-  (hf : locally_integrable f μ) :
-  ae_strongly_measurable f μ :=
+lemma locally_integrable.locally_integrable_on (hf : locally_integrable f μ) (s : set X) :
+  locally_integrable_on f s μ :=
+λ x hx, (hf x).filter_mono nhds_within_le_nhds
+
+lemma integrable.locally_integrable (hf : integrable f μ) : locally_integrable f μ :=
+λ x, hf.integrable_at_filter _
+
+/-- If `f` is locally integrable with respect to `μ.restrict s`, it is locally integrable on `s`.
+(See `locally_integrable_on_iff_locally_integrable_restrict` for an iff statement when `s` is
+closed.) -/
+lemma locally_integrable_on_of_locally_integrable_restrict [opens_measurable_space X]
+  (hf : locally_integrable f (μ.restrict s)) :
+  locally_integrable_on f s μ :=
 begin
-  rw [← @restrict_univ _ _ μ, ← Union_compact_covering, ae_strongly_measurable_Union_iff],
-  exact λ i, (hf $ is_compact_compact_covering X i).ae_strongly_measurable
+  intros x hx,
+  obtain ⟨t, ht_mem, ht_int⟩ := hf x,
+  obtain ⟨u, hu_sub, hu_o, hu_mem⟩ := mem_nhds_iff.mp ht_mem,
+  refine ⟨_, inter_mem_nhds_within s (hu_o.mem_nhds hu_mem), _⟩,
+  simpa only [integrable_on, measure.restrict_restrict hu_o.measurable_set, inter_comm]
+    using ht_int.mono_set hu_sub,
 end
 
-lemma locally_integrable_iff [locally_compact_space X] :
-  locally_integrable f μ ↔ ∀ x : X, ∃ U ∈ 𝓝 x, integrable_on f U μ :=
+/-- If `s` is closed, being locally integrable on `s` wrt `μ` is equivalent to being locally
+integrable with respect to `μ.restrict s`. For the one-way implication without assuming `s` closed,
+see `locally_integrable_on_of_locally_integrable_restrict`. -/
+lemma locally_integrable_on_iff_locally_integrable_restrict [opens_measurable_space X]
+  (hs : is_closed s) :
+  locally_integrable_on f s μ ↔ locally_integrable f (μ.restrict s) :=
 begin
-  refine ⟨λ hf x, _, λ hf K hK, _⟩,
-  { obtain ⟨K, hK, h2K⟩ := exists_compact_mem_nhds x, exact ⟨K, h2K, hf hK⟩ },
-  { refine is_compact.induction_on hK integrable_on_empty (λ s t hst h, h.mono_set hst)
-      (λ s t hs ht, integrable_on_union.mpr ⟨hs, ht⟩) (λ x hx, _),
-    obtain ⟨K, hK, h2K⟩ := hf x,
-    exact ⟨K, nhds_within_le_nhds hK, h2K⟩ }
+  refine ⟨λ hf x, _, locally_integrable_on_of_locally_integrable_restrict⟩,
+  by_cases h : x ∈ s,
+  { obtain ⟨t, ht_nhds, ht_int⟩ := hf x h,
+    obtain ⟨u, hu_o, hu_x, hu_sub⟩ := mem_nhds_within.mp ht_nhds,
+    refine ⟨u, hu_o.mem_nhds hu_x, _⟩,
+    rw [integrable_on, restrict_restrict hu_o.measurable_set],
+    exact ht_int.mono_set hu_sub },
+  { rw ←is_open_compl_iff at hs,
+    refine ⟨sᶜ, hs.mem_nhds h, _⟩,
+    rw [integrable_on, restrict_restrict, inter_comm, inter_compl_self, ←integrable_on],
+    exacts [integrable_on_empty, hs.measurable_set] },
 end
 
-section real
-variables [opens_measurable_space X] {A K : set X} {g g' : X → ℝ}
+/-- If a function is locally integrable, then it is integrable on any compact set. -/
+lemma locally_integrable.integrable_on_is_compact {k : set X} (hf : locally_integrable f μ)
+  (hk : is_compact k) : integrable_on f k μ :=
+(hf.locally_integrable_on k).integrable_on_is_compact hk
 
-lemma integrable_on.mul_continuous_on_of_subset
-  (hg : integrable_on g A μ) (hg' : continuous_on g' K)
-  (hA : measurable_set A) (hK : is_compact K) (hAK : A ⊆ K) :
-  integrable_on (λ x, g x * g' x) A μ :=
+/-- If a function is locally integrable, then it is integrable on an open neighborhood of any
+compact set. -/
+lemma locally_integrable.integrable_on_nhds_is_compact (hf : locally_integrable f μ) {k : set X}
+  (hk : is_compact k) : ∃ u, is_open u ∧ k ⊆ u ∧ integrable_on f u μ :=
 begin
-  rcases is_compact.exists_bound_of_continuous_on hK hg' with ⟨C, hC⟩,
-  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg ⊢,
-  have : ∀ᵐ x ∂(μ.restrict A), ∥g x * g' x∥ ≤ C * ∥g x∥,
-  { filter_upwards [ae_restrict_mem hA] with x hx,
-    rw [real.norm_eq_abs, abs_mul, mul_comm, real.norm_eq_abs],
-    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (abs_nonneg _), },
-  exact mem_ℒp.of_le_mul hg (hg.ae_strongly_measurable.ae_measurable.mul
-    ((hg'.mono hAK).ae_measurable hA)).ae_strongly_measurable this,
+  refine is_compact.induction_on hk _ _ _ _,
+  { refine ⟨∅, is_open_empty, subset.rfl, integrable_on_empty⟩ },
+  { rintros s t hst ⟨u, u_open, tu, hu⟩,
+    exact ⟨u, u_open, hst.trans tu, hu⟩ },
+  { rintros s t ⟨u, u_open, su, hu⟩ ⟨v, v_open, tv, hv⟩,
+    exact ⟨u ∪ v, u_open.union v_open, union_subset_union su tv, hu.union hv⟩ },
+  { assume x hx,
+    rcases hf x with ⟨u, ux, hu⟩,
+    rcases mem_nhds_iff.1 ux with ⟨v, vu, v_open, xv⟩,
+    exact ⟨v, nhds_within_le_nhds (v_open.mem_nhds xv), v, v_open, subset.rfl, hu.mono_set vu⟩ }
 end
 
-lemma integrable_on.mul_continuous_on [t2_space X]
-  (hg : integrable_on g K μ) (hg' : continuous_on g' K) (hK : is_compact K) :
-  integrable_on (λ x, g x * g' x) K μ :=
-hg.mul_continuous_on_of_subset hg' hK.measurable_set hK (subset.refl _)
+lemma locally_integrable_iff [locally_compact_space X] :
+  locally_integrable f μ ↔ ∀ (k : set X), is_compact k → integrable_on f k μ :=
+⟨λ hf k hk, hf.integrable_on_is_compact hk,
+  λ hf x, let ⟨K, hK, h2K⟩ := exists_compact_mem_nhds x in ⟨K, h2K, hf K hK⟩⟩
 
-lemma integrable_on.continuous_on_mul_of_subset
-  (hg : continuous_on g K) (hg' : integrable_on g' A μ)
-  (hK : is_compact K) (hA : measurable_set A) (hAK : A ⊆ K) :
-  integrable_on (λ x, g x * g' x) A μ :=
-by simpa [mul_comm] using hg'.mul_continuous_on_of_subset hg hA hK hAK
+lemma locally_integrable.ae_strongly_measurable [second_countable_topology X]
+  (hf : locally_integrable f μ) : ae_strongly_measurable f μ :=
+by simpa only [restrict_univ] using (locally_integrable_on_univ.mpr hf).ae_strongly_measurable
 
-lemma integrable_on.continuous_on_mul [t2_space X]
-  (hg : continuous_on g K) (hg' : integrable_on g' K μ) (hK : is_compact K) :
-  integrable_on (λ x, g x * g' x) K μ :=
-integrable_on.continuous_on_mul_of_subset hg hg' hK hK.measurable_set subset.rfl
+lemma locally_integrable_const [is_locally_finite_measure μ] (c : E) :
+  locally_integrable (λ x, c) μ :=
+begin
+  assume x,
+  rcases μ.finite_at_nhds x with ⟨U, hU, h'U⟩,
+  refine ⟨U, hU, _⟩,
+  simp only [h'U, integrable_on_const, or_true],
+end
+
+lemma locally_integrable_on_const [is_locally_finite_measure μ] (c : E) :
+  locally_integrable_on (λ x, c) s μ :=
+(locally_integrable_const c).locally_integrable_on s
+
+lemma locally_integrable.indicator (hf : locally_integrable f μ)
+  {s : set X} (hs : measurable_set s) : locally_integrable (s.indicator f) μ :=
+begin
+  assume x,
+  rcases hf x with ⟨U, hU, h'U⟩,
+  exact ⟨U, hU, h'U.indicator hs⟩,
+end
 
-end real
+theorem locally_integrable_map_homeomorph [borel_space X] [borel_space Y]
+  (e : X ≃ₜ Y) {f : Y → E} {μ : measure X} :
+  locally_integrable f (measure.map e μ) ↔ locally_integrable (f ∘ e) μ :=
+begin
+  refine ⟨λ h x, _, λ h x, _⟩,
+  { rcases h (e x) with ⟨U, hU, h'U⟩,
+    refine ⟨e ⁻¹' U, e.continuous.continuous_at.preimage_mem_nhds hU, _⟩,
+    exact (integrable_on_map_equiv e.to_measurable_equiv).1 h'U },
+  { rcases h (e.symm x) with ⟨U, hU, h'U⟩,
+    refine ⟨e.symm ⁻¹' U, e.symm.continuous.continuous_at.preimage_mem_nhds hU, _⟩,
+    apply (integrable_on_map_equiv e.to_measurable_equiv).2,
+    simp only [homeomorph.to_measurable_equiv_coe],
+    convert h'U,
+    ext x,
+    simp only [mem_preimage, homeomorph.symm_apply_apply] }
+end
 
 end measure_theory
-open measure_theory
 
-/-- If a function is integrable at `𝓝[s] x` for each point `x` of a compact set `s`, then it is
-integrable on `s`. -/
-lemma is_compact.integrable_on_of_nhds_within {K : set X} (hK : is_compact K)
-  (hf : ∀ x ∈ K, integrable_at_filter f (𝓝[K] x) μ) : integrable_on f K μ :=
-is_compact.induction_on hK integrable_on_empty (λ s t hst ht, ht.mono_set hst)
-  (λ s t hs ht, hs.union ht) hf
+open measure_theory
 
 section borel
 
-variables [opens_measurable_space X] [metrizable_space X] [is_locally_finite_measure μ]
+variables [opens_measurable_space X] [is_locally_finite_measure μ]
 variables {K : set X} {a b : X}
 
+/-- A continuous function `f` is locally integrable with respect to any locally finite measure. -/
+lemma continuous.locally_integrable [second_countable_topology_either X E]
+  (hf : continuous f) : locally_integrable f μ :=
+hf.integrable_at_nhds
+
+/-- A function `f` continuous on a set `K` is locally integrable on this set with respect
+to any locally finite measure. -/
+lemma continuous_on.locally_integrable_on [second_countable_topology_either X E]
+  (hf : continuous_on f K) (hK : measurable_set K) :
+  locally_integrable_on f K μ :=
+λ x hx, hf.integrable_at_nhds_within hK hx
+
+variables [metrizable_space X]
+
 /-- A function `f` continuous on a compact set `K` is integrable on this set with respect to any
 locally finite measure. -/
 lemma continuous_on.integrable_on_compact (hK : is_compact K) (hf : continuous_on f K) :
   integrable_on f K μ :=
 begin
   letI := metrizable_space_metric X,
-  apply hK.integrable_on_of_nhds_within (λ x hx, _),
+  refine locally_integrable_on.integrable_on_is_compact (λ x hx, _) hK,
   exact hf.integrable_at_nhds_within_of_is_separable hK.measurable_set hK.is_separable hx,
 end
 
-/-- A continuous function `f` is locally integrable with respect to any locally finite measure. -/
-lemma continuous.locally_integrable (hf : continuous f) : locally_integrable f μ :=
-λ s hs, hf.continuous_on.integrable_on_compact hs
-
 lemma continuous_on.integrable_on_Icc [preorder X] [compact_Icc_space X]
   (hf : continuous_on f (Icc a b)) : integrable_on f (Icc a b) μ :=
 hf.integrable_on_compact is_compact_Icc
 
 lemma continuous.integrable_on_Icc [preorder X] [compact_Icc_space X] (hf : continuous f) :
   integrable_on f (Icc a b) μ :=
-hf.locally_integrable is_compact_Icc
+hf.continuous_on.integrable_on_Icc
 
 lemma continuous.integrable_on_Ioc [preorder X] [compact_Icc_space X] (hf : continuous f) :
   integrable_on f (Ioc a b) μ :=
 hf.integrable_on_Icc.mono_set Ioc_subset_Icc_self
 
-lemma continuous_on.integrable_on_interval [linear_order X] [compact_Icc_space X]
+lemma continuous_on.integrable_on_uIcc [linear_order X] [compact_Icc_space X]
   (hf : continuous_on f [a, b]) : integrable_on f [a, b] μ :=
 hf.integrable_on_Icc
 
-lemma continuous.integrable_on_interval [linear_order X] [compact_Icc_space X] (hf : continuous f) :
+lemma continuous.integrable_on_uIcc [linear_order X] [compact_Icc_space X] (hf : continuous f) :
   integrable_on f [a, b] μ :=
 hf.integrable_on_Icc
 
-lemma continuous.integrable_on_interval_oc [linear_order X] [compact_Icc_space X]
+lemma continuous.integrable_on_uIoc [linear_order X] [compact_Icc_space X]
   (hf : continuous f) : integrable_on f (Ι a b) μ :=
 hf.integrable_on_Ioc
 
 /-- A continuous function with compact support is integrable on the whole space. -/
 lemma continuous.integrable_of_has_compact_support
   (hf : continuous f) (hcf : has_compact_support f) : integrable f μ :=
-(integrable_on_iff_integable_of_support_subset (subset_tsupport f) measurable_set_closure).mp $
-  hf.locally_integrable hcf
+(integrable_on_iff_integrable_of_support_subset (subset_tsupport f)).mp $
+  hf.continuous_on.integrable_on_compact hcf
 
 end borel
 
+open_locale ennreal
+
 section monotone
 
-variables [borel_space X] [metrizable_space X]
+variables [borel_space X]
   [conditionally_complete_linear_order X] [conditionally_complete_linear_order E]
   [order_topology X] [order_topology E] [second_countable_topology E]
-  [is_locally_finite_measure μ] {s : set X}
 
-lemma monotone_on.integrable_on_compact (hs : is_compact s) (hmono : monotone_on f s) :
+lemma monotone_on.integrable_on_of_measure_ne_top
+  (hmono : monotone_on f s) {a b : X} (ha : is_least s a) (hb : is_greatest s b) (hs : μ s ≠ ∞)
+  (h's : measurable_set s) :
   integrable_on f s μ :=
 begin
   borelize E,
   obtain rfl | h := s.eq_empty_or_nonempty,
   { exact integrable_on_empty },
-  have hbelow : bdd_below (f '' s) :=
-    ⟨f (Inf s), λ x ⟨y, hy, hyx⟩, hyx ▸ hmono (hs.Inf_mem h) hy (cInf_le hs.bdd_below hy)⟩,
-  have habove : bdd_above (f '' s) :=
-    ⟨f (Sup s), λ x ⟨y, hy, hyx⟩, hyx ▸ hmono hy (hs.Sup_mem h) (le_cSup hs.bdd_above hy)⟩,
+  have hbelow : bdd_below (f '' s) := ⟨f a, λ x ⟨y, hy, hyx⟩, hyx ▸ hmono ha.1 hy (ha.2 hy)⟩,
+  have habove : bdd_above (f '' s) := ⟨f b, λ x ⟨y, hy, hyx⟩, hyx ▸ hmono hy hb.1 (hb.2 hy)⟩,
   have : metric.bounded (f '' s) := metric.bounded_of_bdd_above_of_bdd_below habove hbelow,
   rcases bounded_iff_forall_norm_le.mp this with ⟨C, hC⟩,
-  refine integrable.mono' (continuous_const.locally_integrable hs)
-    (ae_measurable_restrict_of_monotone_on hs.measurable_set hmono).ae_strongly_measurable
-    ((ae_restrict_iff' hs.measurable_set).mpr $ ae_of_all _ $
+  have A : integrable_on (λ x, C) s μ, by simp only [hs.lt_top, integrable_on_const, or_true],
+  refine integrable.mono' A
+    (ae_measurable_restrict_of_monotone_on h's hmono).ae_strongly_measurable
+    ((ae_restrict_iff' h's).mpr $ ae_of_all _ $
       λ y hy, hC (f y) (mem_image_of_mem f hy)),
 end
 
-lemma antitone_on.integrable_on_compact (hs : is_compact s) (hanti : antitone_on f s) :
+lemma monotone_on.integrable_on_is_compact [is_finite_measure_on_compacts μ]
+  (hs : is_compact s) (hmono : monotone_on f s) :
   integrable_on f s μ :=
-hanti.dual_right.integrable_on_compact hs
+begin
+  obtain rfl | h := s.eq_empty_or_nonempty,
+  { exact integrable_on_empty },
+  { exact hmono.integrable_on_of_measure_ne_top (hs.is_least_Inf h) (hs.is_greatest_Sup h)
+    hs.measure_lt_top.ne hs.measurable_set }
+end
 
-lemma monotone.locally_integrable (hmono : monotone f) : locally_integrable f μ :=
-λ s hs, (hmono.monotone_on _).integrable_on_compact hs
+lemma antitone_on.integrable_on_of_measure_ne_top
+  (hanti : antitone_on f s) {a b : X} (ha : is_least s a) (hb : is_greatest s b) (hs : μ s ≠ ∞)
+  (h's : measurable_set s) :
+  integrable_on f s μ :=
+hanti.dual_right.integrable_on_of_measure_ne_top ha hb  hs h's
 
-lemma antitone.locally_integrable (hanti : antitone f) : locally_integrable f μ :=
+lemma antione_on.integrable_on_is_compact [is_finite_measure_on_compacts μ]
+  (hs : is_compact s) (hanti : antitone_on f s) :
+  integrable_on f s μ :=
+hanti.dual_right.integrable_on_is_compact hs
+
+lemma monotone.locally_integrable [is_locally_finite_measure μ] (hmono : monotone f) :
+  locally_integrable f μ :=
+begin
+  assume x,
+  rcases μ.finite_at_nhds x with ⟨U, hU, h'U⟩,
+  obtain ⟨a, b, xab, hab, abU⟩ : ∃ (a b : X), x ∈ Icc a b ∧ Icc a b ∈ 𝓝 x ∧ Icc a b ⊆ U,
+    from exists_Icc_mem_subset_of_mem_nhds hU,
+  have ab : a ≤ b := xab.1.trans xab.2,
+  refine ⟨Icc a b, hab, _⟩,
+  exact (hmono.monotone_on _).integrable_on_of_measure_ne_top (is_least_Icc ab)
+    (is_greatest_Icc ab) ((measure_mono abU).trans_lt h'U).ne measurable_set_Icc,
+end
+
+lemma antitone.locally_integrable [is_locally_finite_measure μ] (hanti : antitone f) :
+  locally_integrable f μ :=
 hanti.dual_right.locally_integrable
 
 end monotone
+
+namespace measure_theory
+
+variables [opens_measurable_space X] {A K : set X}
+
+section mul
+
+variables [normed_ring R] [second_countable_topology_either X R] {g g' : X → R}
+
+lemma integrable_on.mul_continuous_on_of_subset
+  (hg : integrable_on g A μ) (hg' : continuous_on g' K)
+  (hA : measurable_set A) (hK : is_compact K) (hAK : A ⊆ K) :
+  integrable_on (λ x, g x * g' x) A μ :=
+begin
+  rcases is_compact.exists_bound_of_continuous_on hK hg' with ⟨C, hC⟩,
+  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg ⊢,
+  have : ∀ᵐ x ∂(μ.restrict A), ‖g x * g' x‖ ≤ C * ‖g x‖,
+  { filter_upwards [ae_restrict_mem hA] with x hx,
+    refine (norm_mul_le _ _).trans _,
+    rw mul_comm,
+    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (norm_nonneg _), },
+  exact mem_ℒp.of_le_mul hg (hg.ae_strongly_measurable.mul $
+    (hg'.mono hAK).ae_strongly_measurable hA) this,
+end
+
+lemma integrable_on.mul_continuous_on [t2_space X]
+  (hg : integrable_on g K μ) (hg' : continuous_on g' K) (hK : is_compact K) :
+  integrable_on (λ x, g x * g' x) K μ :=
+hg.mul_continuous_on_of_subset hg' hK.measurable_set hK (subset.refl _)
+
+lemma integrable_on.continuous_on_mul_of_subset
+  (hg : continuous_on g K) (hg' : integrable_on g' A μ)
+  (hK : is_compact K) (hA : measurable_set A) (hAK : A ⊆ K) :
+  integrable_on (λ x, g x * g' x) A μ :=
+begin
+  rcases is_compact.exists_bound_of_continuous_on hK hg with ⟨C, hC⟩,
+  rw [integrable_on, ← mem_ℒp_one_iff_integrable] at hg' ⊢,
+  have : ∀ᵐ x ∂(μ.restrict A), ‖g x * g' x‖ ≤ C * ‖g' x‖,
+  { filter_upwards [ae_restrict_mem hA] with x hx,
+    refine (norm_mul_le _ _).trans _,
+    apply mul_le_mul_of_nonneg_right (hC x (hAK hx)) (norm_nonneg _), },
+  exact mem_ℒp.of_le_mul hg' (((hg.mono hAK).ae_strongly_measurable hA).mul
+    hg'.ae_strongly_measurable) this,
+end
+
+lemma integrable_on.continuous_on_mul [t2_space X]
+  (hg : continuous_on g K) (hg' : integrable_on g' K μ) (hK : is_compact K) :
+  integrable_on (λ x, g x * g' x) K μ :=
+hg'.continuous_on_mul_of_subset hg hK hK.measurable_set subset.rfl
+
+end mul
+
+section smul
+
+variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]
+
+lemma integrable_on.continuous_on_smul [t2_space X] [second_countable_topology_either X 𝕜]
+  {g : X → E} (hg : integrable_on g K μ) {f : X → 𝕜} (hf : continuous_on f K) (hK : is_compact K) :
+  integrable_on (λ x, f x • g x) K μ :=
+begin
+  rw [integrable_on, ←integrable_norm_iff],
+  { simp_rw norm_smul,
+    refine integrable_on.continuous_on_mul _ hg.norm hK,
+    exact continuous_norm.comp_continuous_on hf },
+  { exact (hf.ae_strongly_measurable hK.measurable_set).smul hg.1 }
+end
+
+lemma integrable_on.smul_continuous_on [t2_space X] [second_countable_topology_either X E]
+  {f : X → 𝕜} (hf : integrable_on f K μ) {g : X → E} (hg : continuous_on g K) (hK : is_compact K) :
+  integrable_on (λ x, f x • g x) K μ :=
+begin
+  rw [integrable_on, ←integrable_norm_iff],
+  { simp_rw norm_smul,
+    refine integrable_on.mul_continuous_on hf.norm _ hK,
+    exact continuous_norm.comp_continuous_on hg },
+  { exact hf.1.smul (hg.ae_strongly_measurable hK.measurable_set) }
+end
+
+end smul
+
+namespace locally_integrable_on
+
+lemma continuous_on_mul [locally_compact_space X] [t2_space X] [normed_ring R]
+  [second_countable_topology_either X R]
+  {f g : X → R} {s : set X}
+  (hf : locally_integrable_on f s μ) (hg : continuous_on g s) (hs : is_open s) :
+  locally_integrable_on (λ x, g x * f x) s μ :=
+begin
+  rw measure_theory.locally_integrable_on_iff (or.inr hs) at hf ⊢,
+  exact λ k hk_sub hk_c, (hf k hk_sub hk_c).continuous_on_mul (hg.mono hk_sub) hk_c
+end
+
+lemma mul_continuous_on [locally_compact_space X] [t2_space X] [normed_ring R]
+  [second_countable_topology_either X R] {f g : X → R} {s : set X}
+  (hf : locally_integrable_on f s μ) (hg : continuous_on g s) (hs : is_open s) :
+  locally_integrable_on (λ x, f x * g x) s μ :=
+begin
+  rw measure_theory.locally_integrable_on_iff (or.inr hs) at hf ⊢,
+  exact λ k hk_sub hk_c, (hf k hk_sub hk_c).mul_continuous_on (hg.mono hk_sub) hk_c
+end
+
+lemma continuous_on_smul [locally_compact_space X] [t2_space X]
+  {𝕜 : Type*} [normed_field 𝕜] [second_countable_topology_either X 𝕜] [normed_space 𝕜 E]
+  {f : X → E} {g : X → 𝕜} {s : set X} (hs : is_open s)
+  (hf : locally_integrable_on f s μ) (hg : continuous_on g s) :
+  locally_integrable_on (λ x, g x • f x) s μ :=
+begin
+  rw measure_theory.locally_integrable_on_iff (or.inr hs) at hf ⊢,
+  exact λ k hk_sub hk_c, (hf k hk_sub hk_c).continuous_on_smul (hg.mono hk_sub) hk_c
+end
+
+lemma smul_continuous_on [locally_compact_space X] [t2_space X]
+  {𝕜 : Type*} [normed_field 𝕜] [second_countable_topology_either X E] [normed_space 𝕜 E]
+  {f : X → 𝕜} {g : X → E} {s : set X} (hs : is_open s)
+  (hf : locally_integrable_on f s μ) (hg : continuous_on g s)  :
+  locally_integrable_on (λ x, f x • g x) s μ :=
+begin
+  rw measure_theory.locally_integrable_on_iff (or.inr hs) at hf ⊢,
+  exact λ k hk_sub hk_c, (hf k hk_sub hk_c).smul_continuous_on (hg.mono hk_sub) hk_c
+end
+
+end locally_integrable_on
+
+end measure_theory
diff --git a/src/measure_theory/function/lp_order.lean b/src/measure_theory/function/lp_order.lean
index 1d1980e013646..f0e0059b88fbe 100644
--- a/src/measure_theory/function/lp_order.lean
+++ b/src/measure_theory/function/lp_order.lean
@@ -3,12 +3,15 @@ Copyright (c) 2021 Rémy Degenne. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
+import analysis.normed.order.lattice
 import measure_theory.function.lp_space
-import analysis.normed_space.lattice_ordered_group
 
 /-!
 # Order related properties of Lp spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ### Results
 
 - `Lp E p μ` is an `ordered_add_comm_group` when `E` is a `normed_lattice_add_comm_group`.
@@ -17,8 +20,6 @@ import analysis.normed_space.lattice_ordered_group
 
 - move definitions of `Lp.pos_part` and `Lp.neg_part` to this file, and define them as
   `has_pos_part.pos` and `has_pos_part.neg` given by the lattice structure.
-- show that if `E` is a `normed_lattice_add_comm_group` then so is `Lp E p μ` for `1 ≤ p`. In
-  particular, this shows `order_closed_topology` for `Lp`.
 
 -/
 
@@ -55,9 +56,51 @@ begin
 end
 
 instance : ordered_add_comm_group (Lp E p μ) :=
-{ add_le_add_left := λ f g hfg f', add_le_add_left hfg f',
+{ add_le_add_left := λ f g, add_le_add_left,
   ..subtype.partial_order _, ..add_subgroup.to_add_comm_group _}
 
+lemma _root_.measure_theory.mem_ℒp.sup {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
+  mem_ℒp (f ⊔ g) p μ :=
+mem_ℒp.mono' (hf.norm.add hg.norm) (hf.1.sup hg.1)
+  (filter.eventually_of_forall (λ x, norm_sup_le_add (f x) (g x)))
+
+lemma _root_.measure_theory.mem_ℒp.inf {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
+  mem_ℒp (f ⊓ g) p μ :=
+mem_ℒp.mono' (hf.norm.add hg.norm) (hf.1.inf hg.1)
+  (filter.eventually_of_forall (λ x, norm_inf_le_add (f x) (g x)))
+
+lemma _root_.measure_theory.mem_ℒp.abs {f : α → E} (hf : mem_ℒp f p μ)  :
+  mem_ℒp (|f|) p μ :=
+hf.sup hf.neg
+
+instance : lattice (Lp E p μ) :=
+subtype.lattice (λ f g hf hg, by { rw mem_Lp_iff_mem_ℒp at *,
+    exact (mem_ℒp_congr_ae (ae_eq_fun.coe_fn_sup _ _)).mpr (hf.sup hg), })
+  (λ f g hf hg, by { rw mem_Lp_iff_mem_ℒp at *,
+    exact (mem_ℒp_congr_ae (ae_eq_fun.coe_fn_inf _ _)).mpr (hf.inf hg),})
+
+lemma coe_fn_sup (f g : Lp E p μ) : ⇑(f ⊔ g) =ᵐ[μ] ⇑f ⊔ ⇑g :=
+ae_eq_fun.coe_fn_sup _ _
+
+lemma coe_fn_inf (f g : Lp E p μ) : ⇑(f ⊓ g) =ᵐ[μ] ⇑f ⊓ ⇑g :=
+ae_eq_fun.coe_fn_inf _ _
+
+lemma coe_fn_abs (f : Lp E p μ) : ⇑|f| =ᵐ[μ] λ x, |f x| :=
+ae_eq_fun.coe_fn_abs _
+
+noncomputable
+instance [fact (1 ≤ p)] : normed_lattice_add_comm_group (Lp E p μ) :=
+{ add_le_add_left := λ f g, add_le_add_left,
+  solid := λ f g hfg, begin
+    rw ← coe_fn_le at hfg,
+    simp_rw [Lp.norm_def, ennreal.to_real_le_to_real (Lp.snorm_ne_top f) (Lp.snorm_ne_top g)],
+    refine snorm_mono_ae _,
+    filter_upwards [hfg, Lp.coe_fn_abs f, Lp.coe_fn_abs g] with x hx hxf hxg,
+    rw [hxf, hxg] at hx,
+    exact has_solid_norm.solid hx,
+  end,
+  ..Lp.lattice, ..Lp.normed_add_comm_group, }
+
 end order
 
 end Lp
diff --git a/src/measure_theory/function/lp_seminorm.lean b/src/measure_theory/function/lp_seminorm.lean
new file mode 100644
index 0000000000000..7482c420fc669
--- /dev/null
+++ b/src/measure_theory/function/lp_seminorm.lean
@@ -0,0 +1,1633 @@
+/-
+Copyright (c) 2020 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne, Sébastien Gouëzel
+-/
+import analysis.normed_space.indicator_function
+import analysis.special_functions.pow.continuity
+import measure_theory.function.ess_sup
+import measure_theory.function.ae_eq_fun
+import measure_theory.integral.mean_inequalities
+
+/-!
+# ℒp space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file describes properties of almost everywhere strongly measurable functions with finite
+`p`-seminorm, denoted by `snorm f p μ` and defined for `p:ℝ≥0∞` as `0` if `p=0`,
+`(∫ ‖f a‖^p ∂μ) ^ (1/p)` for `0 < p < ∞` and `ess_sup ‖f‖ μ` for `p=∞`.
+
+The Prop-valued `mem_ℒp f p μ` states that a function `f : α → E` has finite `p`-seminorm
+and is almost everywhere strongly measurable.
+
+## Main definitions
+
+* `snorm' f p μ` : `(∫ ‖f a‖^p ∂μ) ^ (1/p)` for `f : α → F` and `p : ℝ`, where `α` is a  measurable
+  space and `F` is a normed group.
+* `snorm_ess_sup f μ` : seminorm in `ℒ∞`, equal to the essential supremum `ess_sup ‖f‖ μ`.
+* `snorm f p μ` : for `p : ℝ≥0∞`, seminorm in `ℒp`, equal to `0` for `p=0`, to `snorm' f p μ`
+  for `0 < p < ∞` and to `snorm_ess_sup f μ` for `p = ∞`.
+
+* `mem_ℒp f p μ` : property that the function `f` is almost everywhere strongly measurable and has
+  finite `p`-seminorm for the measure `μ` (`snorm f p μ < ∞`)
+
+-/
+
+noncomputable theory
+open topological_space measure_theory filter
+open_locale nnreal ennreal big_operators topology measure_theory
+
+variables {α E F G : Type*} {m m0 : measurable_space α} {p : ℝ≥0∞} {q : ℝ} {μ ν : measure α}
+  [normed_add_comm_group E] [normed_add_comm_group F] [normed_add_comm_group G]
+
+namespace measure_theory
+
+section ℒp
+
+/-!
+### ℒp seminorm
+
+We define the ℒp seminorm, denoted by `snorm f p μ`. For real `p`, it is given by an integral
+formula (for which we use the notation `snorm' f p μ`), and for `p = ∞` it is the essential
+supremum (for which we use the notation `snorm_ess_sup f μ`).
+
+We also define a predicate `mem_ℒp f p μ`, requesting that a function is almost everywhere
+strongly measurable and has finite `snorm f p μ`.
+
+This paragraph is devoted to the basic properties of these definitions. It is constructed as
+follows: for a given property, we prove it for `snorm'` and `snorm_ess_sup` when it makes sense,
+deduce it for `snorm`, and translate it in terms of `mem_ℒp`.
+-/
+
+section ℒp_space_definition
+
+/-- `(∫ ‖f a‖^q ∂μ) ^ (1/q)`, which is a seminorm on the space of measurable functions for which
+this quantity is finite -/
+def snorm' {m : measurable_space α} (f : α → F) (q : ℝ) (μ : measure α) : ℝ≥0∞ :=
+(∫⁻ a, ‖f a‖₊^q ∂μ) ^ (1/q)
+
+/-- seminorm for `ℒ∞`, equal to the essential supremum of `‖f‖`. -/
+def snorm_ess_sup {m : measurable_space α} (f : α → F) (μ : measure α) :=
+ess_sup (λ x, (‖f x‖₊ : ℝ≥0∞)) μ
+
+/-- `ℒp` seminorm, equal to `0` for `p=0`, to `(∫ ‖f a‖^p ∂μ) ^ (1/p)` for `0 < p < ∞` and to
+`ess_sup ‖f‖ μ` for `p = ∞`. -/
+def snorm {m : measurable_space α} (f : α → F) (p : ℝ≥0∞) (μ : measure α) : ℝ≥0∞ :=
+if p = 0 then 0 else (if p = ∞ then snorm_ess_sup f μ else snorm' f (ennreal.to_real p) μ)
+
+lemma snorm_eq_snorm' (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) {f : α → F} :
+  snorm f p μ = snorm' f (ennreal.to_real p) μ :=
+by simp [snorm, hp_ne_zero, hp_ne_top]
+
+lemma snorm_eq_lintegral_rpow_nnnorm (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) {f : α → F} :
+  snorm f p μ = (∫⁻ x, ‖f x‖₊ ^ p.to_real ∂μ) ^ (1 / p.to_real) :=
+by rw [snorm_eq_snorm' hp_ne_zero hp_ne_top, snorm']
+
+lemma snorm_one_eq_lintegral_nnnorm {f : α → F} : snorm f 1 μ = ∫⁻ x, ‖f x‖₊ ∂μ :=
+by simp_rw [snorm_eq_lintegral_rpow_nnnorm one_ne_zero ennreal.coe_ne_top, ennreal.one_to_real,
+  one_div_one, ennreal.rpow_one]
+
+@[simp] lemma snorm_exponent_top {f : α → F} : snorm f ∞ μ = snorm_ess_sup f μ := by simp [snorm]
+
+/-- The property that `f:α→E` is ae strongly measurable and `(∫ ‖f a‖^p ∂μ)^(1/p)` is finite
+if `p < ∞`, or `ess_sup f < ∞` if `p = ∞`. -/
+def mem_ℒp {α} {m : measurable_space α}
+  (f : α → E) (p : ℝ≥0∞) (μ : measure α . volume_tac) : Prop :=
+ae_strongly_measurable f μ ∧ snorm f p μ < ∞
+
+lemma mem_ℒp.ae_strongly_measurable {f : α → E} {p : ℝ≥0∞} (h : mem_ℒp f p μ) :
+  ae_strongly_measurable f μ := h.1
+
+lemma lintegral_rpow_nnnorm_eq_rpow_snorm' {f : α → F} (hq0_lt : 0 < q) :
+  ∫⁻ a, ‖f a‖₊ ^ q ∂μ = (snorm' f q μ) ^ q :=
+begin
+  rw [snorm', ←ennreal.rpow_mul, one_div, inv_mul_cancel, ennreal.rpow_one],
+  exact (ne_of_lt hq0_lt).symm,
+end
+
+end ℒp_space_definition
+
+section top
+
+lemma mem_ℒp.snorm_lt_top {f : α → E} (hfp : mem_ℒp f p μ) : snorm f p μ < ∞ := hfp.2
+
+lemma mem_ℒp.snorm_ne_top {f : α → E} (hfp : mem_ℒp f p μ) : snorm f p μ ≠ ∞ := ne_of_lt (hfp.2)
+
+lemma lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top {f : α → F} (hq0_lt : 0 < q)
+  (hfq : snorm' f q μ < ∞) :
+  ∫⁻ a, ‖f a‖₊ ^ q ∂μ < ∞ :=
+begin
+  rw lintegral_rpow_nnnorm_eq_rpow_snorm' hq0_lt,
+  exact ennreal.rpow_lt_top_of_nonneg (le_of_lt hq0_lt) (ne_of_lt hfq),
+end
+
+lemma lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top {f : α → F} (hp_ne_zero : p ≠ 0)
+  (hp_ne_top : p ≠ ∞) (hfp : snorm f p μ < ∞) :
+  ∫⁻ a, ‖f a‖₊ ^ p.to_real ∂μ < ∞ :=
+begin
+  apply lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top,
+  { exact ennreal.to_real_pos hp_ne_zero hp_ne_top },
+  { simpa [snorm_eq_snorm' hp_ne_zero hp_ne_top] using hfp }
+end
+
+lemma snorm_lt_top_iff_lintegral_rpow_nnnorm_lt_top {f : α → F} (hp_ne_zero : p ≠ 0)
+  (hp_ne_top : p ≠ ∞) :
+  snorm f p μ < ∞ ↔ ∫⁻ a, ‖f a‖₊ ^ p.to_real ∂μ < ∞ :=
+⟨lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top hp_ne_zero hp_ne_top,
+  begin
+    intros h,
+    have hp' := ennreal.to_real_pos hp_ne_zero hp_ne_top,
+    have : 0 < 1 / p.to_real := div_pos zero_lt_one hp',
+    simpa [snorm_eq_lintegral_rpow_nnnorm hp_ne_zero hp_ne_top] using
+      ennreal.rpow_lt_top_of_nonneg (le_of_lt this) (ne_of_lt h)
+  end⟩
+
+end top
+
+section zero
+
+@[simp] lemma snorm'_exponent_zero {f : α → F} : snorm' f 0 μ = 1 :=
+by rw [snorm', div_zero, ennreal.rpow_zero]
+
+@[simp] lemma snorm_exponent_zero {f : α → F} : snorm f 0 μ = 0 :=
+by simp [snorm]
+
+lemma mem_ℒp_zero_iff_ae_strongly_measurable {f : α → E} :
+  mem_ℒp f 0 μ ↔ ae_strongly_measurable f μ :=
+by simp [mem_ℒp, snorm_exponent_zero]
+
+@[simp] lemma snorm'_zero (hp0_lt : 0 < q) : snorm' (0 : α → F) q μ = 0 :=
+by simp [snorm', hp0_lt]
+
+@[simp] lemma snorm'_zero' (hq0_ne : q ≠ 0) (hμ : μ ≠ 0) : snorm' (0 : α → F) q μ = 0 :=
+begin
+  cases le_or_lt 0 q with hq0 hq_neg,
+  { exact snorm'_zero (lt_of_le_of_ne hq0 hq0_ne.symm), },
+  { simp [snorm', ennreal.rpow_eq_zero_iff, hμ, hq_neg], },
+end
+
+@[simp] lemma snorm_ess_sup_zero : snorm_ess_sup (0 : α → F) μ = 0 :=
+begin
+  simp_rw [snorm_ess_sup, pi.zero_apply, nnnorm_zero, ennreal.coe_zero, ←ennreal.bot_eq_zero],
+  exact ess_sup_const_bot,
+end
+
+@[simp] lemma snorm_zero : snorm (0 : α → F) p μ = 0 :=
+begin
+  by_cases h0 : p = 0,
+  { simp [h0], },
+  by_cases h_top : p = ∞,
+  { simp only [h_top, snorm_exponent_top, snorm_ess_sup_zero], },
+  rw ←ne.def at h0,
+  simp [snorm_eq_snorm' h0 h_top, ennreal.to_real_pos h0 h_top],
+end
+
+@[simp] lemma snorm_zero' : snorm (λ x : α, (0 : F)) p μ = 0 :=
+by convert snorm_zero
+
+lemma zero_mem_ℒp : mem_ℒp (0 : α → E) p μ :=
+⟨ae_strongly_measurable_zero, by { rw snorm_zero, exact ennreal.coe_lt_top, } ⟩
+
+lemma zero_mem_ℒp' : mem_ℒp (λ x : α, (0 : E)) p μ :=
+by convert zero_mem_ℒp
+
+variables [measurable_space α]
+
+lemma snorm'_measure_zero_of_pos {f : α → F} (hq_pos : 0 < q) :
+  snorm' f q (0 : measure α) = 0 :=
+by simp [snorm', hq_pos]
+
+lemma snorm'_measure_zero_of_exponent_zero {f : α → F} : snorm' f 0 (0 : measure α) = 1 :=
+by simp [snorm']
+
+lemma snorm'_measure_zero_of_neg {f : α → F} (hq_neg : q < 0) : snorm' f q (0 : measure α) = ∞ :=
+by simp [snorm', hq_neg]
+
+@[simp] lemma snorm_ess_sup_measure_zero {f : α → F} : snorm_ess_sup f (0 : measure α) = 0 :=
+by simp [snorm_ess_sup]
+
+@[simp] lemma snorm_measure_zero {f : α → F} : snorm f p (0 : measure α) = 0 :=
+begin
+  by_cases h0 : p = 0,
+  { simp [h0], },
+  by_cases h_top : p = ∞,
+  { simp [h_top], },
+  rw ←ne.def at h0,
+  simp [snorm_eq_snorm' h0 h_top, snorm', ennreal.to_real_pos h0 h_top],
+end
+
+end zero
+
+section const
+
+lemma snorm'_const (c : F) (hq_pos : 0 < q) :
+  snorm' (λ x : α , c) q μ = (‖c‖₊ : ℝ≥0∞) * (μ set.univ) ^ (1/q) :=
+begin
+  rw [snorm', lintegral_const, ennreal.mul_rpow_of_nonneg _ _ (by simp [hq_pos.le] : 0 ≤ 1 / q)],
+  congr,
+  rw ←ennreal.rpow_mul,
+  suffices hq_cancel : q * (1/q) = 1, by rw [hq_cancel, ennreal.rpow_one],
+  rw [one_div, mul_inv_cancel (ne_of_lt hq_pos).symm],
+end
+
+lemma snorm'_const' [is_finite_measure μ] (c : F) (hc_ne_zero : c ≠ 0) (hq_ne_zero : q ≠ 0) :
+  snorm' (λ x : α , c) q μ = (‖c‖₊ : ℝ≥0∞) * (μ set.univ) ^ (1/q) :=
+begin
+  rw [snorm', lintegral_const, ennreal.mul_rpow_of_ne_top _ (measure_ne_top μ set.univ)],
+  { congr,
+    rw ←ennreal.rpow_mul,
+    suffices hp_cancel : q * (1/q) = 1, by rw [hp_cancel, ennreal.rpow_one],
+    rw [one_div, mul_inv_cancel hq_ne_zero], },
+  { rw [ne.def, ennreal.rpow_eq_top_iff, not_or_distrib, not_and_distrib, not_and_distrib],
+    split,
+    { left,
+      rwa [ennreal.coe_eq_zero, nnnorm_eq_zero], },
+    { exact or.inl ennreal.coe_ne_top, }, },
+end
+
+lemma snorm_ess_sup_const (c : F) (hμ : μ ≠ 0) :
+  snorm_ess_sup (λ x : α, c) μ = (‖c‖₊ : ℝ≥0∞) :=
+by rw [snorm_ess_sup, ess_sup_const _ hμ]
+
+lemma snorm'_const_of_is_probability_measure (c : F) (hq_pos : 0 < q) [is_probability_measure μ] :
+  snorm' (λ x : α , c) q μ = (‖c‖₊ : ℝ≥0∞) :=
+by simp [snorm'_const c hq_pos, measure_univ]
+
+lemma snorm_const (c : F) (h0 : p ≠ 0) (hμ : μ ≠ 0) :
+  snorm (λ x : α , c) p μ = (‖c‖₊ : ℝ≥0∞) * (μ set.univ) ^ (1/(ennreal.to_real p)) :=
+begin
+  by_cases h_top : p = ∞,
+  { simp [h_top, snorm_ess_sup_const c hμ], },
+  simp [snorm_eq_snorm' h0 h_top, snorm'_const, ennreal.to_real_pos h0 h_top],
+end
+
+lemma snorm_const' (c : F) (h0 : p ≠ 0) (h_top: p ≠ ∞) :
+  snorm (λ x : α , c) p μ = (‖c‖₊ : ℝ≥0∞) * (μ set.univ) ^ (1/(ennreal.to_real p)) :=
+begin
+  simp [snorm_eq_snorm' h0 h_top, snorm'_const, ennreal.to_real_pos h0 h_top],
+end
+
+lemma snorm_const_lt_top_iff {p : ℝ≥0∞} {c : F} (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
+  snorm (λ x : α, c) p μ < ∞ ↔ c = 0 ∨ μ set.univ < ∞ :=
+begin
+  have hp : 0 < p.to_real, from ennreal.to_real_pos hp_ne_zero hp_ne_top,
+  by_cases hμ : μ = 0,
+  { simp only [hμ, measure.coe_zero, pi.zero_apply, or_true, with_top.zero_lt_top,
+      snorm_measure_zero], },
+  by_cases hc : c = 0,
+  { simp only [hc, true_or, eq_self_iff_true, with_top.zero_lt_top, snorm_zero'], },
+  rw snorm_const' c hp_ne_zero hp_ne_top,
+  by_cases hμ_top : μ set.univ = ∞,
+  { simp [hc, hμ_top, hp], },
+  rw ennreal.mul_lt_top_iff,
+  simp only [true_and, one_div, ennreal.rpow_eq_zero_iff, hμ, false_or, or_false,
+    ennreal.coe_lt_top, nnnorm_eq_zero, ennreal.coe_eq_zero,
+    measure_theory.measure.measure_univ_eq_zero, hp, inv_lt_zero, hc, and_false, false_and,
+    _root_.inv_pos, or_self, hμ_top, ne.lt_top hμ_top, iff_true],
+  exact ennreal.rpow_lt_top_of_nonneg (inv_nonneg.mpr hp.le) hμ_top,
+end
+
+lemma mem_ℒp_const (c : E) [is_finite_measure μ] : mem_ℒp (λ a:α, c) p μ :=
+begin
+  refine ⟨ae_strongly_measurable_const, _⟩,
+  by_cases h0 : p = 0,
+  { simp [h0], },
+  by_cases hμ : μ = 0,
+  { simp [hμ], },
+  rw snorm_const c h0 hμ,
+  refine ennreal.mul_lt_top ennreal.coe_ne_top _,
+  refine (ennreal.rpow_lt_top_of_nonneg _ (measure_ne_top μ set.univ)).ne,
+  simp,
+end
+
+lemma mem_ℒp_top_const (c : E) : mem_ℒp (λ a:α, c) ∞ μ :=
+begin
+  refine ⟨ae_strongly_measurable_const, _⟩,
+  by_cases h : μ = 0,
+  { simp only [h, snorm_measure_zero, with_top.zero_lt_top] },
+  { rw snorm_const _ ennreal.top_ne_zero h,
+    simp only [ennreal.top_to_real, div_zero, ennreal.rpow_zero, mul_one, ennreal.coe_lt_top] }
+end
+
+lemma mem_ℒp_const_iff {p : ℝ≥0∞} {c : E} (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
+  mem_ℒp (λ x : α, c) p μ ↔ c = 0 ∨ μ set.univ < ∞ :=
+begin
+  rw ← snorm_const_lt_top_iff hp_ne_zero hp_ne_top,
+  exact ⟨λ h, h.2, λ h, ⟨ae_strongly_measurable_const, h⟩⟩,
+end
+
+end const
+
+lemma snorm'_mono_nnnorm_ae {f : α → F} {g : α → G} (hq : 0 ≤ q) (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ ‖g x‖₊) :
+  snorm' f q μ ≤ snorm' g q μ :=
+begin
+  rw [snorm'],
+  refine ennreal.rpow_le_rpow _ (one_div_nonneg.2 hq),
+  refine lintegral_mono_ae (h.mono $ λ x hx, _),
+  exact ennreal.rpow_le_rpow (ennreal.coe_le_coe.2 hx) hq
+end
+
+lemma snorm'_mono_ae {f : α → F} {g : α → G} (hq : 0 ≤ q) (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ ‖g x‖) :
+  snorm' f q μ ≤ snorm' g q μ :=
+snorm'_mono_nnnorm_ae hq h
+
+lemma snorm'_congr_nnnorm_ae {f g : α → F} (hfg : ∀ᵐ x ∂μ, ‖f x‖₊ = ‖g x‖₊) :
+  snorm' f q μ = snorm' g q μ :=
+begin
+  have : (λ x, (‖f x‖₊ ^ q : ℝ≥0∞)) =ᵐ[μ] (λ x, ‖g x‖₊ ^ q),
+    from hfg.mono (λ x hx, by simp_rw hx),
+  simp only [snorm', lintegral_congr_ae this]
+end
+
+lemma snorm'_congr_norm_ae {f g : α → F} (hfg : ∀ᵐ x ∂μ, ‖f x‖ = ‖g x‖) :
+  snorm' f q μ = snorm' g q μ :=
+snorm'_congr_nnnorm_ae $ hfg.mono $ λ x hx, nnreal.eq hx
+
+lemma snorm'_congr_ae {f g : α → F} (hfg : f =ᵐ[μ] g) : snorm' f q μ = snorm' g q μ :=
+snorm'_congr_nnnorm_ae (hfg.fun_comp _)
+
+lemma snorm_ess_sup_congr_ae {f g : α → F} (hfg : f =ᵐ[μ] g) :
+  snorm_ess_sup f μ = snorm_ess_sup g μ :=
+ess_sup_congr_ae (hfg.fun_comp (coe ∘ nnnorm))
+
+lemma snorm_ess_sup_mono_nnnorm_ae {f g : α → F} (hfg : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ ‖g x‖₊) :
+  snorm_ess_sup f μ ≤ snorm_ess_sup g μ :=
+ess_sup_mono_ae $ hfg.mono $ λ x hx, ennreal.coe_le_coe.mpr hx
+
+lemma snorm_mono_nnnorm_ae {f : α → F} {g : α → G} (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ ‖g x‖₊) :
+  snorm f p μ ≤ snorm g p μ :=
+begin
+  simp only [snorm],
+  split_ifs,
+  { exact le_rfl },
+  { exact ess_sup_mono_ae (h.mono $ λ x hx, ennreal.coe_le_coe.mpr hx) },
+  { exact snorm'_mono_nnnorm_ae ennreal.to_real_nonneg h }
+end
+
+lemma snorm_mono_ae {f : α → F} {g : α → G} (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ ‖g x‖) :
+  snorm f p μ ≤ snorm g p μ :=
+snorm_mono_nnnorm_ae h
+
+lemma snorm_mono_ae_real {f : α → F} {g : α → ℝ} (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ g x) :
+  snorm f p μ ≤ snorm g p μ :=
+snorm_mono_ae $ h.mono (λ x hx, hx.trans ((le_abs_self _).trans (real.norm_eq_abs _).symm.le))
+
+lemma snorm_mono_nnnorm {f : α → F} {g : α → G} (h : ∀ x, ‖f x‖₊ ≤ ‖g x‖₊) :
+  snorm f p μ ≤ snorm g p μ :=
+snorm_mono_nnnorm_ae (eventually_of_forall (λ x, h x))
+
+lemma snorm_mono {f : α → F} {g : α → G} (h : ∀ x, ‖f x‖ ≤ ‖g x‖) :
+  snorm f p μ ≤ snorm g p μ :=
+snorm_mono_nnnorm h
+
+lemma snorm_mono_real {f : α → F} {g : α → ℝ} (h : ∀ x, ‖f x‖ ≤ g x) :
+  snorm f p μ ≤ snorm g p μ :=
+snorm_mono_ae_real (eventually_of_forall (λ x, h x))
+
+lemma snorm_ess_sup_le_of_ae_nnnorm_bound {f : α → F} {C : ℝ≥0} (hfC : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ C) :
+  snorm_ess_sup f μ ≤ C :=
+ess_sup_le_of_ae_le C $ hfC.mono $ λ x hx, ennreal.coe_le_coe.mpr hx
+
+lemma snorm_ess_sup_le_of_ae_bound {f : α → F} {C : ℝ} (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  snorm_ess_sup f μ ≤ ennreal.of_real C :=
+snorm_ess_sup_le_of_ae_nnnorm_bound $ hfC.mono $ λ x hx, hx.trans C.le_coe_to_nnreal
+
+lemma snorm_ess_sup_lt_top_of_ae_nnnorm_bound {f : α → F} {C : ℝ≥0} (hfC : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ C) :
+  snorm_ess_sup f μ < ∞ :=
+(snorm_ess_sup_le_of_ae_nnnorm_bound hfC).trans_lt ennreal.coe_lt_top
+
+lemma snorm_ess_sup_lt_top_of_ae_bound {f : α → F} {C : ℝ} (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  snorm_ess_sup f μ < ∞ :=
+(snorm_ess_sup_le_of_ae_bound hfC).trans_lt ennreal.of_real_lt_top
+
+lemma snorm_le_of_ae_nnnorm_bound {f : α → F} {C : ℝ≥0} (hfC : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ C) :
+  snorm f p μ ≤ C • (μ set.univ ^ p.to_real⁻¹) :=
+begin
+  by_cases hμ : μ = 0,
+  { simp [hμ] },
+  haveI : μ.ae.ne_bot := ae_ne_bot.mpr hμ,
+  by_cases hp : p = 0,
+  { simp [hp] },
+  have : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ ‖(C : ℝ)‖₊ := hfC.mono (λ x hx, hx.trans_eq C.nnnorm_eq.symm),
+  refine (snorm_mono_ae this).trans_eq _,
+  rw [snorm_const _ hp hμ, C.nnnorm_eq, one_div, ennreal.smul_def, smul_eq_mul],
+end
+
+lemma snorm_le_of_ae_bound {f : α → F} {C : ℝ} (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  snorm f p μ ≤ ((μ set.univ) ^ p.to_real⁻¹) * (ennreal.of_real C) :=
+begin
+  rw [←mul_comm],
+  exact snorm_le_of_ae_nnnorm_bound (hfC.mono $ λ x hx, hx.trans C.le_coe_to_nnreal),
+end
+
+lemma snorm_congr_nnnorm_ae {f : α → F} {g : α → G} (hfg : ∀ᵐ x ∂μ, ‖f x‖₊ = ‖g x‖₊) :
+  snorm f p μ = snorm g p μ :=
+le_antisymm (snorm_mono_nnnorm_ae $ eventually_eq.le hfg)
+  (snorm_mono_nnnorm_ae $ (eventually_eq.symm hfg).le)
+
+lemma snorm_congr_norm_ae {f : α → F} {g : α → G} (hfg : ∀ᵐ x ∂μ, ‖f x‖ = ‖g x‖) :
+  snorm f p μ = snorm g p μ :=
+snorm_congr_nnnorm_ae $ hfg.mono $ λ x hx, nnreal.eq hx
+
+@[simp] lemma snorm'_norm {f : α → F} : snorm' (λ a, ‖f a‖) q μ = snorm' f q μ :=
+by simp [snorm']
+
+@[simp] lemma snorm_norm (f : α → F) : snorm (λ x, ‖f x‖) p μ = snorm f p μ :=
+snorm_congr_norm_ae $ eventually_of_forall $ λ x, norm_norm _
+
+lemma snorm'_norm_rpow (f : α → F) (p q : ℝ) (hq_pos : 0 < q) :
+  snorm' (λ x, ‖f x‖ ^ q) p μ = (snorm' f (p * q) μ) ^ q :=
+begin
+  simp_rw snorm',
+  rw [← ennreal.rpow_mul, ←one_div_mul_one_div],
+  simp_rw one_div,
+  rw [mul_assoc, inv_mul_cancel hq_pos.ne.symm, mul_one],
+  congr,
+  ext1 x,
+  simp_rw ← of_real_norm_eq_coe_nnnorm,
+  rw [real.norm_eq_abs, abs_eq_self.mpr (real.rpow_nonneg_of_nonneg (norm_nonneg _) _),
+    mul_comm, ← ennreal.of_real_rpow_of_nonneg (norm_nonneg _) hq_pos.le, ennreal.rpow_mul],
+end
+
+lemma snorm_norm_rpow (f : α → F) (hq_pos : 0 < q) :
+  snorm (λ x, ‖f x‖ ^ q) p μ = (snorm f (p * ennreal.of_real q) μ) ^ q :=
+begin
+  by_cases h0 : p = 0,
+  { simp [h0, ennreal.zero_rpow_of_pos hq_pos], },
+  by_cases hp_top : p = ∞,
+  { simp only [hp_top, snorm_exponent_top, ennreal.top_mul, hq_pos.not_le, ennreal.of_real_eq_zero,
+      if_false, snorm_exponent_top, snorm_ess_sup],
+    have h_rpow : ess_sup (λ (x : α), (‖(‖f x‖ ^ q)‖₊ : ℝ≥0∞)) μ
+      = ess_sup (λ (x : α), (↑‖f x‖₊) ^ q) μ,
+    { congr,
+      ext1 x,
+      nth_rewrite 1 ← nnnorm_norm,
+      rw [ennreal.coe_rpow_of_nonneg _ hq_pos.le, ennreal.coe_eq_coe],
+      ext,
+      push_cast,
+      rw real.norm_rpow_of_nonneg (norm_nonneg _), },
+    rw h_rpow,
+    have h_rpow_mono := ennreal.strict_mono_rpow_of_pos hq_pos,
+    have h_rpow_surj := (ennreal.rpow_left_bijective hq_pos.ne.symm).2,
+    let iso := h_rpow_mono.order_iso_of_surjective _ h_rpow_surj,
+    exact (iso.ess_sup_apply (λ x, (‖f x‖₊ : ℝ≥0∞)) μ).symm, },
+  rw [snorm_eq_snorm' h0 hp_top, snorm_eq_snorm' _ _],
+  swap, { refine mul_ne_zero h0 _, rwa [ne.def, ennreal.of_real_eq_zero, not_le], },
+  swap, { exact ennreal.mul_ne_top hp_top ennreal.of_real_ne_top, },
+  rw [ennreal.to_real_mul, ennreal.to_real_of_real hq_pos.le],
+  exact snorm'_norm_rpow f p.to_real q hq_pos,
+end
+
+lemma snorm_congr_ae {f g : α → F} (hfg : f =ᵐ[μ] g) : snorm f p μ = snorm g p μ :=
+snorm_congr_norm_ae $ hfg.mono (λ x hx, hx ▸ rfl)
+
+lemma mem_ℒp_congr_ae {f g : α → E} (hfg : f =ᵐ[μ] g) : mem_ℒp f p μ ↔ mem_ℒp g p μ :=
+by simp only [mem_ℒp, snorm_congr_ae hfg, ae_strongly_measurable_congr hfg]
+
+lemma mem_ℒp.ae_eq {f g : α → E} (hfg : f =ᵐ[μ] g) (hf_Lp : mem_ℒp f p μ) : mem_ℒp g p μ :=
+(mem_ℒp_congr_ae hfg).1 hf_Lp
+
+lemma mem_ℒp.of_le {f : α → E} {g : α → F}
+  (hg : mem_ℒp g p μ) (hf : ae_strongly_measurable f μ) (hfg : ∀ᵐ x ∂μ, ‖f x‖ ≤ ‖g x‖) :
+  mem_ℒp f p μ :=
+⟨hf, (snorm_mono_ae hfg).trans_lt hg.snorm_lt_top⟩
+
+alias mem_ℒp.of_le ← mem_ℒp.mono
+
+lemma mem_ℒp.mono' {f : α → E} {g : α → ℝ} (hg : mem_ℒp g p μ)
+  (hf : ae_strongly_measurable f μ) (h : ∀ᵐ a ∂μ, ‖f a‖ ≤ g a) : mem_ℒp f p μ :=
+hg.mono hf $ h.mono $ λ x hx, le_trans hx (le_abs_self _)
+
+lemma mem_ℒp.congr_norm {f : α → E} {g : α → F} (hf : mem_ℒp f p μ)
+  (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ‖f a‖ = ‖g a‖) :
+  mem_ℒp g p μ :=
+hf.mono hg $ eventually_eq.le $ eventually_eq.symm h
+
+lemma mem_ℒp_congr_norm {f : α → E} {g : α → F}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ‖f a‖ = ‖g a‖) :
+  mem_ℒp f p μ ↔ mem_ℒp g p μ :=
+⟨λ h2f, h2f.congr_norm hg h, λ h2g, h2g.congr_norm hf $ eventually_eq.symm h⟩
+
+lemma mem_ℒp_top_of_bound {f : α → E} (hf : ae_strongly_measurable f μ) (C : ℝ)
+  (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  mem_ℒp f ∞ μ :=
+⟨hf, by { rw snorm_exponent_top, exact snorm_ess_sup_lt_top_of_ae_bound hfC, }⟩
+
+lemma mem_ℒp.of_bound [is_finite_measure μ] {f : α → E} (hf : ae_strongly_measurable f μ)
+  (C : ℝ) (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  mem_ℒp f p μ :=
+(mem_ℒp_const C).of_le hf (hfC.mono (λ x hx, le_trans hx (le_abs_self _)))
+
+@[mono] lemma snorm'_mono_measure (f : α → F) (hμν : ν ≤ μ) (hq : 0 ≤ q) :
+  snorm' f q ν ≤ snorm' f q μ :=
+begin
+  simp_rw snorm',
+  suffices h_integral_mono : (∫⁻ a, (‖f a‖₊ : ℝ≥0∞) ^ q ∂ν) ≤ ∫⁻ a, ‖f a‖₊ ^ q ∂μ,
+    from ennreal.rpow_le_rpow h_integral_mono (by simp [hq]),
+  exact lintegral_mono' hμν le_rfl,
+end
+
+@[mono] lemma snorm_ess_sup_mono_measure (f : α → F) (hμν : ν ≪ μ) :
+  snorm_ess_sup f ν ≤ snorm_ess_sup f μ :=
+by { simp_rw snorm_ess_sup, exact ess_sup_mono_measure hμν, }
+
+@[mono] lemma snorm_mono_measure (f : α → F) (hμν : ν ≤ μ) :
+  snorm f p ν ≤ snorm f p μ :=
+begin
+  by_cases hp0 : p = 0,
+  { simp [hp0], },
+  by_cases hp_top : p = ∞,
+  { simp [hp_top, snorm_ess_sup_mono_measure f (measure.absolutely_continuous_of_le hμν)], },
+  simp_rw snorm_eq_snorm' hp0 hp_top,
+  exact snorm'_mono_measure f hμν ennreal.to_real_nonneg,
+end
+
+lemma mem_ℒp.mono_measure {f : α → E} (hμν : ν ≤ μ) (hf : mem_ℒp f p μ) :
+  mem_ℒp f p ν :=
+⟨hf.1.mono_measure hμν, (snorm_mono_measure f hμν).trans_lt hf.2⟩
+
+lemma mem_ℒp.restrict (s : set α) {f : α → E} (hf : mem_ℒp f p μ) :
+  mem_ℒp f p (μ.restrict s) :=
+hf.mono_measure measure.restrict_le_self
+
+lemma snorm'_smul_measure {p : ℝ} (hp : 0 ≤ p) {f : α → F} (c : ℝ≥0∞) :
+  snorm' f p (c • μ) = c ^ (1 / p) * snorm' f p μ :=
+by { rw [snorm', lintegral_smul_measure, ennreal.mul_rpow_of_nonneg, snorm'], simp [hp], }
+
+lemma snorm_ess_sup_smul_measure {f : α → F} {c : ℝ≥0∞} (hc : c ≠ 0) :
+  snorm_ess_sup f (c • μ) = snorm_ess_sup f μ :=
+by { simp_rw [snorm_ess_sup], exact ess_sup_smul_measure hc, }
+
+/-- Use `snorm_smul_measure_of_ne_top` instead. -/
+private lemma snorm_smul_measure_of_ne_zero_of_ne_top {p : ℝ≥0∞} (hp_ne_zero : p ≠ 0)
+  (hp_ne_top : p ≠ ∞) {f : α → F} (c : ℝ≥0∞) :
+  snorm f p (c • μ) = c ^ (1 / p).to_real • snorm f p μ :=
+begin
+  simp_rw snorm_eq_snorm' hp_ne_zero hp_ne_top,
+  rw snorm'_smul_measure ennreal.to_real_nonneg,
+  congr,
+  simp_rw one_div,
+  rw ennreal.to_real_inv,
+end
+
+lemma snorm_smul_measure_of_ne_zero {p : ℝ≥0∞} {f : α → F} {c : ℝ≥0∞} (hc : c ≠ 0) :
+  snorm f p (c • μ) = c ^ (1 / p).to_real • snorm f p μ :=
+begin
+  by_cases hp0 : p = 0,
+  { simp [hp0], },
+  by_cases hp_top : p = ∞,
+  { simp [hp_top, snorm_ess_sup_smul_measure hc], },
+  exact snorm_smul_measure_of_ne_zero_of_ne_top hp0 hp_top c,
+end
+
+lemma snorm_smul_measure_of_ne_top {p : ℝ≥0∞} (hp_ne_top : p ≠ ∞) {f : α → F} (c : ℝ≥0∞) :
+  snorm f p (c • μ) = c ^ (1 / p).to_real • snorm f p μ :=
+begin
+  by_cases hp0 : p = 0,
+  { simp [hp0], },
+  { exact snorm_smul_measure_of_ne_zero_of_ne_top hp0 hp_ne_top c, },
+end
+
+lemma snorm_one_smul_measure {f : α → F} (c : ℝ≥0∞) :
+  snorm f 1 (c • μ) = c * snorm f 1 μ :=
+by { rw @snorm_smul_measure_of_ne_top _ _ _ μ _ 1 (@ennreal.coe_ne_top 1) f c, simp, }
+
+lemma mem_ℒp.of_measure_le_smul {μ' : measure α} (c : ℝ≥0∞) (hc : c ≠ ∞)
+  (hμ'_le : μ' ≤ c • μ) {f : α → E} (hf : mem_ℒp f p μ) :
+  mem_ℒp f p μ' :=
+begin
+  refine ⟨hf.1.mono' (measure.absolutely_continuous_of_le_smul hμ'_le), _⟩,
+  refine (snorm_mono_measure f hμ'_le).trans_lt _,
+  by_cases hc0 : c = 0,
+  { simp [hc0], },
+  rw [snorm_smul_measure_of_ne_zero hc0, smul_eq_mul],
+  refine ennreal.mul_lt_top _ hf.2.ne,
+  simp [hc, hc0],
+end
+
+lemma mem_ℒp.smul_measure {f : α → E} {c : ℝ≥0∞} (hf : mem_ℒp f p μ) (hc : c ≠ ∞) :
+  mem_ℒp f p (c • μ) :=
+hf.of_measure_le_smul c hc le_rfl
+
+include m
+
+lemma snorm_one_add_measure (f : α → F) (μ ν : measure α) :
+  snorm f 1 (μ + ν) = snorm f 1 μ + snorm f 1 ν :=
+by { simp_rw snorm_one_eq_lintegral_nnnorm, rw lintegral_add_measure _ μ ν, }
+
+lemma snorm_le_add_measure_right (f : α → F) (μ ν : measure α) {p : ℝ≥0∞} :
+  snorm f p μ ≤ snorm f p (μ + ν) :=
+snorm_mono_measure f $ measure.le_add_right $ le_refl _
+
+lemma snorm_le_add_measure_left (f : α → F) (μ ν : measure α) {p : ℝ≥0∞} :
+  snorm f p ν ≤ snorm f p (μ + ν) :=
+snorm_mono_measure f $ measure.le_add_left $ le_refl _
+
+omit m
+
+lemma mem_ℒp.left_of_add_measure {f : α → E} (h : mem_ℒp f p (μ + ν)) : mem_ℒp f p μ :=
+h.mono_measure $ measure.le_add_right $ le_refl _
+
+lemma mem_ℒp.right_of_add_measure {f : α → E} (h : mem_ℒp f p (μ + ν)) : mem_ℒp f p ν :=
+h.mono_measure $ measure.le_add_left $ le_refl _
+
+lemma mem_ℒp.norm {f : α → E} (h : mem_ℒp f p μ) : mem_ℒp (λ x, ‖f x‖) p μ :=
+h.of_le h.ae_strongly_measurable.norm (eventually_of_forall (λ x, by simp))
+
+lemma mem_ℒp_norm_iff {f : α → E} (hf : ae_strongly_measurable f μ) :
+  mem_ℒp (λ x, ‖f x‖) p μ ↔ mem_ℒp f p μ :=
+⟨λ h, ⟨hf, by { rw ← snorm_norm, exact h.2, }⟩, λ h, h.norm⟩
+
+lemma snorm'_eq_zero_of_ae_zero {f : α → F} (hq0_lt : 0 < q) (hf_zero : f =ᵐ[μ] 0) :
+  snorm' f q μ = 0 :=
+by rw [snorm'_congr_ae hf_zero, snorm'_zero hq0_lt]
+
+lemma snorm'_eq_zero_of_ae_zero' (hq0_ne : q ≠ 0) (hμ : μ ≠ 0) {f : α → F} (hf_zero : f =ᵐ[μ] 0) :
+  snorm' f q μ = 0 :=
+by rw [snorm'_congr_ae hf_zero, snorm'_zero' hq0_ne hμ]
+
+lemma ae_eq_zero_of_snorm'_eq_zero {f : α → E} (hq0 : 0 ≤ q) (hf : ae_strongly_measurable f μ)
+  (h : snorm' f q μ = 0) : f =ᵐ[μ] 0 :=
+begin
+  rw [snorm', ennreal.rpow_eq_zero_iff] at h,
+  cases h,
+  { rw lintegral_eq_zero_iff' (hf.ennnorm.pow_const q) at h,
+    refine h.left.mono (λ x hx, _),
+    rw [pi.zero_apply, ennreal.rpow_eq_zero_iff] at hx,
+    cases hx,
+    { cases hx with hx _,
+      rwa [←ennreal.coe_zero, ennreal.coe_eq_coe, nnnorm_eq_zero] at hx, },
+    { exact absurd hx.left ennreal.coe_ne_top, }, },
+  { exfalso,
+    rw [one_div, inv_lt_zero] at h,
+    exact hq0.not_lt h.right },
+end
+
+lemma snorm'_eq_zero_iff (hq0_lt : 0 < q) {f : α → E} (hf : ae_strongly_measurable f μ) :
+  snorm' f q μ = 0 ↔ f =ᵐ[μ] 0 :=
+⟨ae_eq_zero_of_snorm'_eq_zero (le_of_lt hq0_lt) hf, snorm'_eq_zero_of_ae_zero hq0_lt⟩
+
+lemma coe_nnnorm_ae_le_snorm_ess_sup {m : measurable_space α} (f : α → F) (μ : measure α) :
+  ∀ᵐ x ∂μ, (‖f x‖₊ : ℝ≥0∞) ≤ snorm_ess_sup f μ :=
+ennreal.ae_le_ess_sup (λ x, (‖f x‖₊ : ℝ≥0∞))
+
+@[simp] lemma snorm_ess_sup_eq_zero_iff {f : α → F} : snorm_ess_sup f μ = 0 ↔ f =ᵐ[μ] 0 :=
+by simp [eventually_eq, snorm_ess_sup]
+
+lemma snorm_eq_zero_iff {f : α → E} (hf : ae_strongly_measurable f μ) (h0 : p ≠ 0) :
+  snorm f p μ = 0 ↔ f =ᵐ[μ] 0 :=
+begin
+  by_cases h_top : p = ∞,
+  { rw [h_top, snorm_exponent_top, snorm_ess_sup_eq_zero_iff], },
+  rw snorm_eq_snorm' h0 h_top,
+  exact snorm'_eq_zero_iff (ennreal.to_real_pos h0 h_top) hf,
+end
+
+lemma snorm'_add_le {f g : α → E}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (hq1 : 1 ≤ q) :
+  snorm' (f + g) q μ ≤ snorm' f q μ + snorm' g q μ :=
+calc (∫⁻ a, ↑‖(f + g) a‖₊ ^ q ∂μ) ^ (1 / q)
+    ≤ (∫⁻ a, (((λ a, (‖f a‖₊ : ℝ≥0∞))
+        + (λ a, (‖g a‖₊ : ℝ≥0∞))) a) ^ q ∂μ) ^ (1 / q) :
+begin
+  refine ennreal.rpow_le_rpow _ (by simp [le_trans zero_le_one hq1] : 0 ≤ 1 / q),
+  refine lintegral_mono (λ a, ennreal.rpow_le_rpow _ (le_trans zero_le_one hq1)),
+  simp [←ennreal.coe_add, nnnorm_add_le],
+end
+... ≤ snorm' f q μ + snorm' g q μ :
+  ennreal.lintegral_Lp_add_le hf.ennnorm hg.ennnorm hq1
+
+lemma snorm'_add_le_of_le_one {f g : α → E}
+  (hf : ae_strongly_measurable f μ) (hq0 : 0 ≤ q) (hq1 : q ≤ 1) :
+  snorm' (f + g) q μ ≤ 2^(1/q-1) * (snorm' f q μ + snorm' g q μ) :=
+calc (∫⁻ a, ↑‖(f + g) a‖₊ ^ q ∂μ) ^ (1 / q)
+    ≤ (∫⁻ a, (((λ a, (‖f a‖₊ : ℝ≥0∞))
+        + (λ a, (‖g a‖₊ : ℝ≥0∞))) a) ^ q ∂μ) ^ (1 / q) :
+begin
+  refine ennreal.rpow_le_rpow _ (by simp [hq0] : 0 ≤ 1 / q),
+  refine lintegral_mono (λ a, ennreal.rpow_le_rpow _ hq0),
+  simp [←ennreal.coe_add, nnnorm_add_le],
+end
+... ≤ 2^(1/q-1) * (snorm' f q μ + snorm' g q μ) :
+  ennreal.lintegral_Lp_add_le_of_le_one hf.ennnorm hq0 hq1
+
+lemma snorm_ess_sup_add_le {f g : α → F} :
+  snorm_ess_sup (f + g) μ ≤ snorm_ess_sup f μ + snorm_ess_sup g μ :=
+begin
+  refine le_trans (ess_sup_mono_ae (eventually_of_forall (λ x, _)))
+    (ennreal.ess_sup_add_le _ _),
+  simp_rw [pi.add_apply, ←ennreal.coe_add, ennreal.coe_le_coe],
+  exact nnnorm_add_le _ _,
+end
+
+lemma snorm_add_le
+  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (hp1 : 1 ≤ p) :
+  snorm (f + g) p μ ≤ snorm f p μ + snorm g p μ :=
+begin
+  by_cases hp0 : p = 0,
+  { simp [hp0], },
+  by_cases hp_top : p = ∞,
+  { simp [hp_top, snorm_ess_sup_add_le], },
+  have hp1_real : 1 ≤ p.to_real,
+  by rwa [← ennreal.one_to_real, ennreal.to_real_le_to_real ennreal.one_ne_top hp_top],
+  repeat { rw snorm_eq_snorm' hp0 hp_top, },
+  exact snorm'_add_le hf hg hp1_real,
+end
+
+/-- A constant for the inequality `‖f + g‖_{L^p} ≤ C * (‖f‖_{L^p} + ‖g‖_{L^p})`. It is equal to `1`
+for `p ≥ 1` or `p = 0`, and `2^(1/p-1)` in the more tricky interval `(0, 1)`. -/
+def Lp_add_const (p : ℝ≥0∞) : ℝ≥0∞ :=
+if p ∈ set.Ioo (0 : ℝ≥0∞) 1 then 2^(1/p.to_real-1) else 1
+
+lemma Lp_add_const_of_one_le {p : ℝ≥0∞} (hp : 1 ≤ p) : Lp_add_const p = 1 :=
+begin
+  rw [Lp_add_const, if_neg],
+  assume h,
+  exact lt_irrefl _ (h.2.trans_le hp),
+end
+
+lemma Lp_add_const_zero : Lp_add_const 0 = 1 :=
+begin
+  rw [Lp_add_const, if_neg],
+  assume h,
+  exact lt_irrefl _ (h.1),
+end
+
+lemma Lp_add_const_lt_top (p : ℝ≥0∞) : Lp_add_const p < ∞ :=
+begin
+  rw [Lp_add_const],
+  split_ifs,
+  { apply ennreal.rpow_lt_top_of_nonneg _ ennreal.two_ne_top,
+    simp only [one_div, sub_nonneg],
+    apply one_le_inv (ennreal.to_real_pos h.1.ne' (h.2.trans ennreal.one_lt_top).ne),
+    simpa using ennreal.to_real_mono ennreal.one_ne_top h.2.le },
+  { exact ennreal.one_lt_top }
+end
+
+lemma snorm_add_le'
+  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (p : ℝ≥0∞) :
+  snorm (f + g) p μ ≤ Lp_add_const p * (snorm f p μ + snorm g p μ) :=
+begin
+  rcases eq_or_ne p 0 with rfl|hp,
+  { simp only [snorm_exponent_zero, add_zero, mul_zero, le_zero_iff] },
+  rcases lt_or_le p 1 with h'p|h'p,
+  { simp only [snorm_eq_snorm' hp (h'p.trans ennreal.one_lt_top).ne],
+    convert snorm'_add_le_of_le_one hf ennreal.to_real_nonneg _,
+    { have : p ∈ set.Ioo (0 : ℝ≥0∞) 1 := ⟨hp.bot_lt, h'p⟩,
+      simp only [Lp_add_const, if_pos this] },
+    { simpa using ennreal.to_real_mono ennreal.one_ne_top h'p.le } },
+  { simp [Lp_add_const_of_one_le h'p],
+    exact snorm_add_le hf hg h'p }
+end
+
+variables (μ E)
+/-- Technical lemma to control the addition of functions in `L^p` even for `p < 1`: Given `δ > 0`,
+there exists `η` such that two functions bounded by `η` in `L^p` have a sum bounded by `δ`. One
+could take `η = δ / 2` for `p ≥ 1`, but the point of the lemma is that it works also for `p < 1`.
+-/
+lemma exists_Lp_half (p : ℝ≥0∞) {δ : ℝ≥0∞} (hδ : δ ≠ 0) :
+  ∃ (η : ℝ≥0∞), 0 < η ∧ ∀ (f g : α → E) (hf : ae_strongly_measurable f μ)
+    (hg : ae_strongly_measurable g μ) (Hf : snorm f p μ ≤ η) (Hg : snorm g p μ ≤ η),
+      snorm (f + g) p μ < δ :=
+begin
+  have : tendsto (λ (η : ℝ≥0∞), Lp_add_const p * (η + η)) (𝓝[>] 0) (𝓝 (Lp_add_const p * (0 + 0))),
+    from (ennreal.tendsto.const_mul (tendsto_id.add tendsto_id)
+      (or.inr (Lp_add_const_lt_top p).ne)).mono_left nhds_within_le_nhds,
+  simp only [add_zero, mul_zero] at this,
+  rcases (((tendsto_order.1 this).2 δ hδ.bot_lt).and self_mem_nhds_within).exists
+    with ⟨η, hη, ηpos⟩,
+  refine ⟨η, ηpos, λ f g hf hg Hf Hg, _⟩,
+  calc snorm (f + g) p μ ≤ Lp_add_const p * (snorm f p μ + snorm g p μ) : snorm_add_le' hf hg p
+  ... ≤ Lp_add_const p * (η + η) : mul_le_mul_of_nonneg_left (add_le_add Hf Hg) bot_le
+  ... < δ : hη
+end
+variables {μ E}
+
+lemma snorm_sub_le'
+  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (p : ℝ≥0∞) :
+  snorm (f - g) p μ ≤ Lp_add_const p * (snorm f p μ + snorm g p μ) :=
+calc snorm (f - g) p μ = snorm (f + - g) p μ : by rw sub_eq_add_neg
+  -- We cannot use snorm_add_le on f and (-g) because we don't have `ae_measurable (-g) μ`, since
+  -- we don't suppose `[borel_space E]`.
+... = snorm (λ x, ‖f x + - g x‖) p μ : (snorm_norm (f + - g)).symm
+... ≤ snorm (λ x, ‖f x‖ + ‖- g x‖) p μ : by
+{ refine snorm_mono_real (λ x, _), rw norm_norm, exact norm_add_le _ _, }
+... = snorm (λ x, ‖f x‖ + ‖g x‖) p μ : by simp_rw norm_neg
+... ≤ Lp_add_const p * (snorm (λ x, ‖f x‖) p μ + snorm (λ x, ‖g x‖) p μ) :
+  snorm_add_le' hf.norm hg.norm p
+... = Lp_add_const p * (snorm f p μ + snorm g p μ) : by rw [← snorm_norm f, ← snorm_norm g]
+
+lemma snorm_sub_le
+  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (hp : 1 ≤ p) :
+  snorm (f - g) p μ ≤ snorm f p μ + snorm g p μ :=
+by simpa [Lp_add_const_of_one_le hp] using snorm_sub_le' hf hg p
+
+lemma snorm_add_lt_top {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
+  snorm (f + g) p μ < ∞ := calc
+snorm (f + g) p μ ≤ Lp_add_const p * (snorm f p μ + snorm g p μ) :
+  snorm_add_le' hf.ae_strongly_measurable hg.ae_strongly_measurable p
+... < ∞ :
+begin
+  apply ennreal.mul_lt_top (Lp_add_const_lt_top p).ne,
+  exact ((ennreal.add_lt_top).2 ⟨hf.2, hg.2⟩).ne,
+end
+
+lemma ae_le_snorm_ess_sup {f : α → F} : ∀ᵐ y ∂μ, ↑‖f y‖₊ ≤ snorm_ess_sup f μ := ae_le_ess_sup
+
+lemma meas_snorm_ess_sup_lt {f : α → F} : μ {y | snorm_ess_sup f μ < ‖f y‖₊} = 0 :=
+meas_ess_sup_lt
+
+section map_measure
+
+variables {β : Type*} {mβ : measurable_space β} {f : α → β} {g : β → E}
+
+include mβ
+
+lemma snorm_ess_sup_map_measure
+  (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
+  snorm_ess_sup g (measure.map f μ) = snorm_ess_sup (g ∘ f) μ :=
+ess_sup_map_measure hg.ennnorm hf
+
+lemma snorm_map_measure (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
+  snorm g p (measure.map f μ) = snorm (g ∘ f) p μ :=
+begin
+  by_cases hp_zero : p = 0,
+  { simp only [hp_zero, snorm_exponent_zero], },
+  by_cases hp_top : p = ∞,
+  { simp_rw [hp_top, snorm_exponent_top],
+    exact snorm_ess_sup_map_measure hg hf, },
+  simp_rw snorm_eq_lintegral_rpow_nnnorm hp_zero hp_top,
+  rw lintegral_map' (hg.ennnorm.pow_const p.to_real) hf,
+end
+
+lemma mem_ℒp_map_measure_iff
+  (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
+  mem_ℒp g p (measure.map f μ) ↔ mem_ℒp (g ∘ f) p μ :=
+by simp [mem_ℒp, snorm_map_measure hg hf, hg.comp_ae_measurable hf, hg]
+
+lemma _root_.measurable_embedding.snorm_ess_sup_map_measure {g : β → F}
+  (hf : measurable_embedding f) :
+  snorm_ess_sup g (measure.map f μ) = snorm_ess_sup (g ∘ f) μ :=
+hf.ess_sup_map_measure
+
+lemma _root_.measurable_embedding.snorm_map_measure {g : β → F} (hf : measurable_embedding f) :
+  snorm g p (measure.map f μ) = snorm (g ∘ f) p μ :=
+begin
+  by_cases hp_zero : p = 0,
+  { simp only [hp_zero, snorm_exponent_zero], },
+  by_cases hp : p = ∞,
+  { simp_rw [hp, snorm_exponent_top],
+    exact hf.ess_sup_map_measure, },
+  { simp_rw snorm_eq_lintegral_rpow_nnnorm hp_zero hp,
+    rw hf.lintegral_map, },
+end
+
+lemma _root_.measurable_embedding.mem_ℒp_map_measure_iff {g : β → F}
+  (hf : measurable_embedding f) :
+  mem_ℒp g p (measure.map f μ) ↔ mem_ℒp (g ∘ f) p μ :=
+by simp_rw [mem_ℒp, hf.ae_strongly_measurable_map_iff, hf.snorm_map_measure]
+
+lemma _root_.measurable_equiv.mem_ℒp_map_measure_iff (f : α ≃ᵐ β) {g : β → F} :
+  mem_ℒp g p (measure.map f μ) ↔ mem_ℒp (g ∘ f) p μ :=
+f.measurable_embedding.mem_ℒp_map_measure_iff
+
+omit mβ
+
+end map_measure
+
+section trim
+
+lemma snorm'_trim (hm : m ≤ m0) {f : α → E} (hf : strongly_measurable[m] f) :
+  snorm' f q (ν.trim hm) = snorm' f q ν :=
+begin
+  simp_rw snorm',
+  congr' 1,
+  refine lintegral_trim hm _,
+  refine @measurable.pow_const _ _ _ _ _ _ _ m _ (@measurable.coe_nnreal_ennreal _ m _ _) _,
+  apply @strongly_measurable.measurable,
+  exact (@strongly_measurable.nnnorm α m _ _ _ hf),
+end
+
+lemma limsup_trim (hm : m ≤ m0) {f : α → ℝ≥0∞} (hf : measurable[m] f) :
+  (ν.trim hm).ae.limsup f = ν.ae.limsup f :=
+begin
+  simp_rw limsup_eq,
+  suffices h_set_eq : {a : ℝ≥0∞ | ∀ᵐ n ∂(ν.trim hm), f n ≤ a} = {a : ℝ≥0∞ | ∀ᵐ n ∂ν, f n ≤ a},
+    by rw h_set_eq,
+  ext1 a,
+  suffices h_meas_eq : ν {x | ¬ f x ≤ a} = ν.trim hm {x | ¬ f x ≤ a},
+    by simp_rw [set.mem_set_of_eq, ae_iff, h_meas_eq],
+  refine (trim_measurable_set_eq hm _).symm,
+  refine @measurable_set.compl _ _ m (@measurable_set_le ℝ≥0∞ _ _ _ _ m _ _ _ _ _ hf _),
+  exact @measurable_const _ _ _ m _,
+end
+
+lemma ess_sup_trim (hm : m ≤ m0) {f : α → ℝ≥0∞} (hf : measurable[m] f) :
+  ess_sup f (ν.trim hm) = ess_sup f ν :=
+by { simp_rw ess_sup, exact limsup_trim hm hf, }
+
+lemma snorm_ess_sup_trim (hm : m ≤ m0) {f : α → E} (hf : strongly_measurable[m] f) :
+  snorm_ess_sup f (ν.trim hm) = snorm_ess_sup f ν :=
+ess_sup_trim _ (@strongly_measurable.ennnorm _ m _ _ _ hf)
+
+lemma snorm_trim (hm : m ≤ m0) {f : α → E} (hf : strongly_measurable[m] f) :
+  snorm f p (ν.trim hm) = snorm f p ν :=
+begin
+  by_cases h0 : p = 0,
+  { simp [h0], },
+  by_cases h_top : p = ∞,
+  { simpa only [h_top, snorm_exponent_top] using snorm_ess_sup_trim hm hf, },
+  simpa only [snorm_eq_snorm' h0 h_top] using snorm'_trim hm hf,
+end
+
+lemma snorm_trim_ae (hm : m ≤ m0) {f : α → E} (hf : ae_strongly_measurable f (ν.trim hm)) :
+  snorm f p (ν.trim hm) = snorm f p ν :=
+begin
+  rw [snorm_congr_ae hf.ae_eq_mk, snorm_congr_ae (ae_eq_of_ae_eq_trim hf.ae_eq_mk)],
+  exact snorm_trim hm hf.strongly_measurable_mk,
+end
+
+lemma mem_ℒp_of_mem_ℒp_trim (hm : m ≤ m0) {f : α → E} (hf : mem_ℒp f p (ν.trim hm)) :
+  mem_ℒp f p ν :=
+⟨ae_strongly_measurable_of_ae_strongly_measurable_trim hm hf.1,
+(le_of_eq (snorm_trim_ae hm hf.1).symm).trans_lt hf.2⟩
+
+end trim
+
+@[simp] lemma snorm'_neg {f : α → F} : snorm' (-f) q μ = snorm' f q μ := by simp [snorm']
+
+@[simp] lemma snorm_neg {f : α → F} : snorm (-f) p μ = snorm f p μ :=
+begin
+  by_cases h0 : p = 0,
+  { simp [h0], },
+  by_cases h_top : p = ∞,
+  { simp [h_top, snorm_ess_sup], },
+  simp [snorm_eq_snorm' h0 h_top],
+end
+
+lemma mem_ℒp.neg {f : α → E} (hf : mem_ℒp f p μ) : mem_ℒp (-f) p μ :=
+⟨ae_strongly_measurable.neg hf.1, by simp [hf.right]⟩
+
+lemma mem_ℒp_neg_iff {f : α → E} : mem_ℒp (-f) p μ ↔ mem_ℒp f p μ :=
+⟨λ h, neg_neg f ▸ h.neg, mem_ℒp.neg⟩
+
+lemma snorm'_le_snorm'_mul_rpow_measure_univ {p q : ℝ} (hp0_lt : 0 < p) (hpq : p ≤ q)
+  {f : α → E} (hf : ae_strongly_measurable f μ) :
+  snorm' f p μ ≤ snorm' f q μ * (μ set.univ) ^ (1/p - 1/q) :=
+begin
+  have hq0_lt : 0 < q, from lt_of_lt_of_le hp0_lt hpq,
+  by_cases hpq_eq : p = q,
+  { rw [hpq_eq, sub_self, ennreal.rpow_zero, mul_one],
+    exact le_rfl, },
+  have hpq : p < q, from lt_of_le_of_ne hpq hpq_eq,
+  let g := λ a : α, (1 : ℝ≥0∞),
+  have h_rw : ∫⁻ a, ↑‖f a‖₊^p ∂ μ = ∫⁻ a, (‖f a‖₊ * (g a))^p ∂ μ,
+  from lintegral_congr (λ a, by simp),
+  repeat {rw snorm'},
+  rw h_rw,
+  let r := p * q / (q - p),
+  have hpqr : 1/p = 1/q + 1/r,
+  { field_simp [(ne_of_lt hp0_lt).symm,
+      (ne_of_lt hq0_lt).symm],
+    ring, },
+  calc (∫⁻ (a : α), (↑‖f a‖₊ * g a) ^ p ∂μ) ^ (1/p)
+      ≤ (∫⁻ (a : α), ↑‖f a‖₊ ^ q ∂μ) ^ (1/q) * (∫⁻ (a : α), (g a) ^ r ∂μ) ^ (1/r) :
+    ennreal.lintegral_Lp_mul_le_Lq_mul_Lr hp0_lt hpq hpqr μ hf.ennnorm ae_measurable_const
+  ... = (∫⁻ (a : α), ↑‖f a‖₊ ^ q ∂μ) ^ (1/q) * μ set.univ ^ (1/p - 1/q) :
+    by simp [hpqr],
+end
+
+lemma snorm'_le_snorm_ess_sup_mul_rpow_measure_univ (hq_pos : 0 < q) {f : α → F} :
+  snorm' f q μ ≤ snorm_ess_sup f μ * (μ set.univ) ^ (1/q) :=
+begin
+  have h_le : ∫⁻ (a : α), ↑‖f a‖₊ ^ q ∂μ ≤ ∫⁻ (a : α), (snorm_ess_sup f μ) ^ q ∂μ,
+  { refine lintegral_mono_ae _,
+    have h_nnnorm_le_snorm_ess_sup := coe_nnnorm_ae_le_snorm_ess_sup f μ,
+    refine h_nnnorm_le_snorm_ess_sup.mono (λ x hx, ennreal.rpow_le_rpow hx (le_of_lt hq_pos)), },
+  rw [snorm', ←ennreal.rpow_one (snorm_ess_sup f μ)],
+  nth_rewrite 1 ←mul_inv_cancel (ne_of_lt hq_pos).symm,
+  rw [ennreal.rpow_mul, one_div,
+    ←ennreal.mul_rpow_of_nonneg _ _ (by simp [hq_pos.le] : 0 ≤ q⁻¹)],
+  refine ennreal.rpow_le_rpow _ (by simp [hq_pos.le]),
+  rwa lintegral_const at h_le,
+end
+
+lemma snorm_le_snorm_mul_rpow_measure_univ {p q : ℝ≥0∞} (hpq : p ≤ q) {f : α → E}
+  (hf : ae_strongly_measurable f μ) :
+  snorm f p μ ≤ snorm f q μ * (μ set.univ) ^ (1/p.to_real - 1/q.to_real) :=
+begin
+  by_cases hp0 : p = 0,
+  { simp [hp0, zero_le], },
+  rw ← ne.def at hp0,
+  have hp0_lt : 0 < p, from lt_of_le_of_ne (zero_le _) hp0.symm,
+  have hq0_lt : 0 < q, from lt_of_lt_of_le hp0_lt hpq,
+  by_cases hq_top : q = ∞,
+  { simp only [hq_top, div_zero, one_div, ennreal.top_to_real, sub_zero, snorm_exponent_top,
+      inv_zero],
+    by_cases hp_top : p = ∞,
+    { simp only [hp_top, ennreal.rpow_zero, mul_one, ennreal.top_to_real, sub_zero, inv_zero,
+        snorm_exponent_top],
+      exact le_rfl, },
+    rw snorm_eq_snorm' hp0 hp_top,
+    have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp0_lt.ne' hp_top,
+    refine (snorm'_le_snorm_ess_sup_mul_rpow_measure_univ hp_pos).trans (le_of_eq _),
+    congr,
+    exact one_div _, },
+  have hp_lt_top : p < ∞, from hpq.trans_lt (lt_top_iff_ne_top.mpr hq_top),
+  have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp0_lt.ne' hp_lt_top.ne,
+  rw [snorm_eq_snorm' hp0_lt.ne.symm hp_lt_top.ne, snorm_eq_snorm' hq0_lt.ne.symm hq_top],
+  have hpq_real : p.to_real ≤ q.to_real, by rwa ennreal.to_real_le_to_real hp_lt_top.ne hq_top,
+  exact snorm'_le_snorm'_mul_rpow_measure_univ hp_pos hpq_real hf,
+end
+
+lemma snorm'_le_snorm'_of_exponent_le {m : measurable_space α} {p q : ℝ} (hp0_lt : 0 < p)
+  (hpq : p ≤ q) (μ : measure α) [is_probability_measure μ] {f : α → E}
+  (hf : ae_strongly_measurable f μ) :
+  snorm' f p μ ≤ snorm' f q μ :=
+begin
+  have h_le_μ := snorm'_le_snorm'_mul_rpow_measure_univ hp0_lt hpq hf,
+  rwa [measure_univ, ennreal.one_rpow, mul_one] at h_le_μ,
+end
+
+lemma snorm'_le_snorm_ess_sup (hq_pos : 0 < q) {f : α → F} [is_probability_measure μ] :
+  snorm' f q μ ≤ snorm_ess_sup f μ :=
+le_trans (snorm'_le_snorm_ess_sup_mul_rpow_measure_univ hq_pos) (le_of_eq (by simp [measure_univ]))
+
+lemma snorm_le_snorm_of_exponent_le {p q : ℝ≥0∞} (hpq : p ≤ q) [is_probability_measure μ]
+  {f : α → E} (hf : ae_strongly_measurable f μ) :
+  snorm f p μ ≤ snorm f q μ :=
+(snorm_le_snorm_mul_rpow_measure_univ hpq hf).trans (le_of_eq (by simp [measure_univ]))
+
+lemma snorm'_lt_top_of_snorm'_lt_top_of_exponent_le {p q : ℝ} [is_finite_measure μ] {f : α → E}
+  (hf : ae_strongly_measurable f μ) (hfq_lt_top : snorm' f q μ < ∞)
+  (hp_nonneg : 0 ≤ p) (hpq : p ≤ q) :
+  snorm' f p μ < ∞ :=
+begin
+  cases le_or_lt p 0 with hp_nonpos hp_pos,
+  { rw le_antisymm hp_nonpos hp_nonneg,
+    simp, },
+  have hq_pos : 0 < q, from lt_of_lt_of_le hp_pos hpq,
+  calc snorm' f p μ
+      ≤ snorm' f q μ * (μ set.univ) ^ (1/p - 1/q) :
+    snorm'_le_snorm'_mul_rpow_measure_univ hp_pos hpq hf
+  ... < ∞ :
+  begin
+    rw ennreal.mul_lt_top_iff,
+    refine or.inl ⟨hfq_lt_top, ennreal.rpow_lt_top_of_nonneg _ (measure_ne_top μ set.univ)⟩,
+    rwa [le_sub_comm, sub_zero, one_div, one_div, inv_le_inv hq_pos hp_pos],
+  end
+end
+
+variables (μ)
+
+lemma pow_mul_meas_ge_le_snorm {f : α → E}
+  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (hf : ae_strongly_measurable f μ) (ε : ℝ≥0∞) :
+  (ε * μ {x | ε ≤ ‖f x‖₊ ^ p.to_real}) ^ (1 / p.to_real) ≤ snorm f p μ :=
+begin
+  rw snorm_eq_lintegral_rpow_nnnorm hp_ne_zero hp_ne_top,
+  exact ennreal.rpow_le_rpow (mul_meas_ge_le_lintegral₀ (hf.ennnorm.pow_const _) ε)
+    (one_div_nonneg.2 ennreal.to_real_nonneg),
+end
+
+lemma mul_meas_ge_le_pow_snorm {f : α → E}
+  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (hf : ae_strongly_measurable f μ) (ε : ℝ≥0∞) :
+  ε * μ {x | ε ≤ ‖f x‖₊ ^ p.to_real} ≤ snorm f p μ ^ p.to_real :=
+begin
+  have : 1 / p.to_real * p.to_real = 1,
+  { refine one_div_mul_cancel _,
+    rw [ne, ennreal.to_real_eq_zero_iff],
+    exact not_or hp_ne_zero hp_ne_top },
+  rw [← ennreal.rpow_one (ε * μ {x | ε ≤ ‖f x‖₊ ^ p.to_real}), ← this, ennreal.rpow_mul],
+  exact ennreal.rpow_le_rpow (pow_mul_meas_ge_le_snorm μ hp_ne_zero hp_ne_top hf ε)
+    ennreal.to_real_nonneg,
+end
+
+/-- A version of Markov's inequality using Lp-norms. -/
+lemma mul_meas_ge_le_pow_snorm' {f : α → E}
+  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (hf : ae_strongly_measurable f μ) (ε : ℝ≥0∞) :
+  ε ^ p.to_real * μ {x | ε ≤ ‖f x‖₊} ≤ snorm f p μ ^ p.to_real :=
+begin
+  convert mul_meas_ge_le_pow_snorm μ hp_ne_zero hp_ne_top hf (ε ^ p.to_real),
+  ext x,
+  rw ennreal.rpow_le_rpow_iff (ennreal.to_real_pos hp_ne_zero hp_ne_top),
+end
+
+lemma meas_ge_le_mul_pow_snorm {f : α → E} (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
+  (hf : ae_strongly_measurable f μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  μ {x | ε ≤ ‖f x‖₊} ≤ ε⁻¹ ^ p.to_real * snorm f p μ ^ p.to_real :=
+begin
+  by_cases ε = ∞,
+  { simp [h] },
+  have hεpow : ε ^ p.to_real ≠ 0 := (ennreal.rpow_pos (pos_iff_ne_zero.2 hε) h).ne.symm,
+  have hεpow' : ε ^ p.to_real ≠ ∞ := (ennreal.rpow_ne_top_of_nonneg ennreal.to_real_nonneg h),
+  rw [ennreal.inv_rpow, ← ennreal.mul_le_mul_left hεpow hεpow', ← mul_assoc,
+      ennreal.mul_inv_cancel hεpow hεpow', one_mul],
+  exact mul_meas_ge_le_pow_snorm' μ hp_ne_zero hp_ne_top hf ε,
+end
+
+variables {μ}
+
+lemma mem_ℒp.mem_ℒp_of_exponent_le {p q : ℝ≥0∞} [is_finite_measure μ] {f : α → E}
+  (hfq : mem_ℒp f q μ) (hpq : p ≤ q) :
+  mem_ℒp f p μ :=
+begin
+  cases hfq with hfq_m hfq_lt_top,
+  by_cases hp0 : p = 0,
+  { rwa [hp0, mem_ℒp_zero_iff_ae_strongly_measurable], },
+  rw ←ne.def at hp0,
+  refine ⟨hfq_m, _⟩,
+  by_cases hp_top : p = ∞,
+  { have hq_top : q = ∞,
+      by rwa [hp_top, top_le_iff] at hpq,
+    rw [hp_top],
+    rwa hq_top at hfq_lt_top, },
+  have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp0 hp_top,
+  by_cases hq_top : q = ∞,
+  { rw snorm_eq_snorm' hp0 hp_top,
+    rw [hq_top, snorm_exponent_top] at hfq_lt_top,
+    refine lt_of_le_of_lt (snorm'_le_snorm_ess_sup_mul_rpow_measure_univ hp_pos) _,
+    refine ennreal.mul_lt_top hfq_lt_top.ne _,
+    exact (ennreal.rpow_lt_top_of_nonneg (by simp [hp_pos.le]) (measure_ne_top μ set.univ)).ne },
+  have hq0 : q ≠ 0,
+  { by_contra hq_eq_zero,
+    have hp_eq_zero : p = 0, from le_antisymm (by rwa hq_eq_zero at hpq) (zero_le _),
+    rw [hp_eq_zero, ennreal.zero_to_real] at hp_pos,
+    exact (lt_irrefl _) hp_pos, },
+  have hpq_real : p.to_real ≤ q.to_real, by rwa ennreal.to_real_le_to_real hp_top hq_top,
+  rw snorm_eq_snorm' hp0 hp_top,
+  rw snorm_eq_snorm' hq0 hq_top at hfq_lt_top,
+  exact snorm'_lt_top_of_snorm'_lt_top_of_exponent_le hfq_m hfq_lt_top (le_of_lt hp_pos) hpq_real,
+end
+
+section has_measurable_add
+-- variable [has_measurable_add₂ E]
+
+lemma snorm'_sum_le {ι} {f : ι → α → E} {s : finset ι}
+  (hfs : ∀ i, i ∈ s → ae_strongly_measurable (f i) μ) (hq1 : 1 ≤ q) :
+  snorm' (∑ i in s, f i) q μ ≤ ∑ i in s, snorm' (f i) q μ :=
+finset.le_sum_of_subadditive_on_pred (λ (f : α → E), snorm' f q μ)
+  (λ f, ae_strongly_measurable f μ) (snorm'_zero (zero_lt_one.trans_le hq1))
+  (λ f g hf hg, snorm'_add_le hf hg hq1) (λ f g hf hg, hf.add hg) _ hfs
+
+lemma snorm_sum_le {ι} {f : ι → α → E} {s : finset ι}
+  (hfs : ∀ i, i ∈ s → ae_strongly_measurable (f i) μ) (hp1 : 1 ≤ p) :
+  snorm (∑ i in s, f i) p μ ≤ ∑ i in s, snorm (f i) p μ :=
+finset.le_sum_of_subadditive_on_pred (λ (f : α → E), snorm f p μ)
+  (λ f, ae_strongly_measurable f μ) snorm_zero (λ f g hf hg, snorm_add_le hf hg hp1)
+  (λ f g hf hg, hf.add hg) _ hfs
+
+lemma mem_ℒp.add {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) : mem_ℒp (f + g) p μ :=
+⟨ae_strongly_measurable.add hf.1 hg.1, snorm_add_lt_top hf hg⟩
+
+lemma mem_ℒp.sub {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) : mem_ℒp (f - g) p μ :=
+by { rw sub_eq_add_neg, exact hf.add hg.neg }
+
+lemma mem_ℒp_finset_sum {ι} (s : finset ι) {f : ι → α → E} (hf : ∀ i ∈ s, mem_ℒp (f i) p μ) :
+  mem_ℒp (λ a, ∑ i in s, f i a) p μ :=
+begin
+  haveI : decidable_eq ι := classical.dec_eq _,
+  revert hf,
+  refine finset.induction_on s _ _,
+  { simp only [zero_mem_ℒp', finset.sum_empty, implies_true_iff], },
+  { intros i s his ih hf,
+    simp only [his, finset.sum_insert, not_false_iff],
+    exact (hf i (s.mem_insert_self i)).add (ih (λ j hj, hf j (finset.mem_insert_of_mem hj))), },
+end
+
+lemma mem_ℒp_finset_sum' {ι} (s : finset ι) {f : ι → α → E} (hf : ∀ i ∈ s, mem_ℒp (f i) p μ) :
+  mem_ℒp (∑ i in s, f i) p μ :=
+begin
+  convert mem_ℒp_finset_sum s hf,
+  ext x,
+  simp,
+end
+
+end has_measurable_add
+
+section monotonicity
+
+lemma snorm'_le_nnreal_smul_snorm'_of_ae_le_mul {f : α → F} {g : α → G} {c : ℝ≥0}
+  (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ c * ‖g x‖₊) {p : ℝ} (hp : 0 < p) :
+  snorm' f p μ ≤ c • snorm' g p μ :=
+begin
+  simp_rw [snorm'],
+  rw [←ennreal.rpow_le_rpow_iff hp, ennreal.smul_def, smul_eq_mul,
+    ennreal.mul_rpow_of_nonneg _ _ hp.le],
+  simp_rw [←ennreal.rpow_mul, one_div, inv_mul_cancel hp.ne.symm, ennreal.rpow_one,
+    ennreal.coe_rpow_of_nonneg _ hp.le, ←lintegral_const_mul' _ _ ennreal.coe_ne_top,
+    ←ennreal.coe_mul],
+  apply lintegral_mono_ae,
+  simp_rw [ennreal.coe_le_coe, ←nnreal.mul_rpow, nnreal.rpow_le_rpow_iff hp],
+  exact h,
+end
+
+lemma snorm_ess_sup_le_nnreal_smul_snorm_ess_sup_of_ae_le_mul {f : α → F} {g : α → G} {c : ℝ≥0}
+  (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ c * ‖g x‖₊) :
+  snorm_ess_sup f μ ≤ c • snorm_ess_sup g μ :=
+calc  ess_sup (λ x, (‖f x‖₊: ℝ≥0∞)) μ
+    ≤ ess_sup (λ x, (↑(c * ‖g x‖₊) : ℝ≥0∞)) μ
+          : ess_sup_mono_ae $ h.mono $ λ x hx, ennreal.coe_le_coe.mpr hx
+... = ess_sup (λ x, (c * ‖g x‖₊ : ℝ≥0∞)) μ : by simp_rw ennreal.coe_mul
+... = c • ess_sup (λ x, (‖g x‖₊ : ℝ≥0∞)) μ : ennreal.ess_sup_const_mul
+
+lemma snorm_le_nnreal_smul_snorm_of_ae_le_mul {f : α → F} {g : α → G} {c : ℝ≥0}
+  (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ c * ‖g x‖₊) (p : ℝ≥0∞) :
+  snorm f p μ ≤ c • snorm g p μ :=
+begin
+  by_cases h0 : p = 0,
+  { simp [h0], },
+  by_cases h_top : p = ∞,
+  { rw h_top,
+    exact snorm_ess_sup_le_nnreal_smul_snorm_ess_sup_of_ae_le_mul h, },
+  simp_rw snorm_eq_snorm' h0 h_top,
+  exact snorm'_le_nnreal_smul_snorm'_of_ae_le_mul h (ennreal.to_real_pos h0 h_top),
+end
+
+-- TODO: add the whole family of lemmas?
+private lemma le_mul_iff_eq_zero_of_nonneg_of_neg_of_nonneg {α} [linear_ordered_semiring α]
+  {a b c : α} (ha : 0 ≤ a) (hb : b < 0) (hc : 0 ≤ c) : a ≤ b * c ↔ a = 0 ∧ c = 0 :=
+begin
+  split,
+  { intro h,
+    exact ⟨(h.trans (mul_nonpos_of_nonpos_of_nonneg hb.le hc)).antisymm ha,
+      (nonpos_of_mul_nonneg_right (ha.trans h) hb).antisymm hc⟩ },
+  { rintro ⟨rfl, rfl⟩,
+    rw mul_zero, }
+end
+
+/-- When `c` is negative, `‖f x‖ ≤ c * ‖g x‖` is nonsense and forces both `f` and `g` to have an
+`snorm` of `0`. -/
+lemma snorm_eq_zero_and_zero_of_ae_le_mul_neg {f : α → F} {g : α → G} {c : ℝ}
+  (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ c * ‖g x‖) (hc : c < 0) (p : ℝ≥0∞) :
+  snorm f p μ = 0 ∧ snorm g p μ = 0 :=
+begin
+  simp_rw [le_mul_iff_eq_zero_of_nonneg_of_neg_of_nonneg (norm_nonneg _) hc (norm_nonneg _),
+    norm_eq_zero, eventually_and] at h,
+  change f =ᵐ[μ] 0 ∧ g =ᵐ[μ] 0 at h,
+  simp [snorm_congr_ae h.1, snorm_congr_ae h.2],
+end
+
+lemma snorm_le_mul_snorm_of_ae_le_mul {f : α → F} {g : α → G} {c : ℝ}
+  (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ c * ‖g x‖) (p : ℝ≥0∞) :
+  snorm f p μ ≤ (ennreal.of_real c) * snorm g p μ :=
+snorm_le_nnreal_smul_snorm_of_ae_le_mul
+  (h.mono $ λ x hx, hx.trans $ mul_le_mul_of_nonneg_right c.le_coe_to_nnreal (norm_nonneg _)) _
+
+lemma mem_ℒp.of_nnnorm_le_mul {f : α → E} {g : α → F} {c : ℝ≥0}
+  (hg : mem_ℒp g p μ) (hf : ae_strongly_measurable f μ) (hfg : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ c * ‖g x‖₊) :
+  mem_ℒp f p μ :=
+⟨hf, (snorm_le_nnreal_smul_snorm_of_ae_le_mul hfg p).trans_lt $
+  ennreal.mul_lt_top ennreal.coe_ne_top hg.snorm_ne_top⟩
+
+lemma mem_ℒp.of_le_mul {f : α → E} {g : α → F} {c : ℝ}
+  (hg : mem_ℒp g p μ) (hf : ae_strongly_measurable f μ) (hfg : ∀ᵐ x ∂μ, ‖f x‖ ≤ c * ‖g x‖) :
+  mem_ℒp f p μ :=
+⟨hf, (snorm_le_mul_snorm_of_ae_le_mul hfg p).trans_lt $
+  ennreal.mul_lt_top ennreal.of_real_ne_top hg.snorm_ne_top⟩
+
+lemma snorm'_le_snorm'_mul_snorm' {p q r : ℝ}
+  {f : α → E} (hf : ae_strongly_measurable f μ) {g : α → F} (hg : ae_strongly_measurable g μ)
+  (b : E → F → G) (h : ∀ᵐ x ∂μ, ‖b (f x) (g x)‖₊ ≤ ‖f x‖₊ * ‖g x‖₊)
+  (hp0_lt : 0 < p) (hpq : p < q) (hpqr : 1/p = 1/q + 1/r) :
+  snorm' (λ x, b (f x) (g x)) p μ ≤ snorm' f q μ * snorm' g r μ :=
+begin
+  rw snorm',
+  calc (∫⁻ (a : α), ↑‖b (f a) (g a)‖₊ ^ p ∂μ) ^ (1 / p)
+        ≤ (∫⁻ (a : α), ↑(‖f a‖₊ * ‖g a‖₊) ^ p ∂μ) ^ (1 / p) :
+          (ennreal.rpow_le_rpow_iff $ one_div_pos.mpr (hp0_lt)).mpr $
+            lintegral_mono_ae $ h.mono $ λ a ha, (ennreal.rpow_le_rpow_iff (hp0_lt)).mpr $
+              ennreal.coe_le_coe.mpr $ ha
+    ... ≤ _ : _,
+  simp_rw [snorm', ennreal.coe_mul],
+  exact ennreal.lintegral_Lp_mul_le_Lq_mul_Lr hp0_lt hpq hpqr μ hf.ennnorm
+    hg.ennnorm,
+end
+
+lemma snorm_le_snorm_top_mul_snorm (p : ℝ≥0∞)
+  (f : α → E) {g : α → F} (hg : ae_strongly_measurable g μ) (b : E → F → G)
+  (h : ∀ᵐ x ∂μ, ‖b (f x) (g x)‖₊ ≤ ‖f x‖₊ * ‖g x‖₊) :
+  snorm (λ x, b (f x) (g x)) p μ ≤ snorm f ∞ μ * snorm g p μ :=
+begin
+  by_cases hp_top : p = ∞,
+  { simp_rw [hp_top, snorm_exponent_top],
+    refine le_trans (ess_sup_mono_ae $ h.mono $ λ a ha, _) (ennreal.ess_sup_mul_le _ _),
+    simp_rw [pi.mul_apply, ←ennreal.coe_mul, ennreal.coe_le_coe],
+    exact ha },
+  by_cases hp_zero : p = 0,
+  { simp only [hp_zero, snorm_exponent_zero, mul_zero, le_zero_iff], },
+  simp_rw [snorm_eq_lintegral_rpow_nnnorm hp_zero hp_top, snorm_exponent_top, snorm_ess_sup],
+  calc (∫⁻ x, ↑‖b (f x) (g x)‖₊ ^ p.to_real ∂μ) ^ (1 / p.to_real)
+      ≤ (∫⁻ x, ↑‖f x‖₊ ^ p.to_real * ↑‖g x‖₊ ^ p.to_real ∂μ) ^ (1 / p.to_real) :
+    begin
+      refine ennreal.rpow_le_rpow _ (one_div_nonneg.mpr ennreal.to_real_nonneg),
+      refine lintegral_mono_ae (h.mono $ λ a ha, _),
+      rw ←ennreal.mul_rpow_of_nonneg _ _ ennreal.to_real_nonneg,
+      refine ennreal.rpow_le_rpow _ ennreal.to_real_nonneg,
+      rw [←ennreal.coe_mul, ennreal.coe_le_coe],
+      exact ha,
+    end
+  ... ≤ (∫⁻ x, (ess_sup (λ x, ↑‖f x‖₊) μ) ^ p.to_real * ↑‖g x‖₊ ^ p.to_real ∂μ) ^ (1 / p.to_real) :
+    begin
+      refine ennreal.rpow_le_rpow _ _,
+      swap, { rw one_div_nonneg, exact ennreal.to_real_nonneg, },
+      refine lintegral_mono_ae _,
+      filter_upwards [@ennreal.ae_le_ess_sup _ _ μ (λ x, ↑‖f x‖₊)] with x hx,
+      exact mul_le_mul_right' (ennreal.rpow_le_rpow hx ennreal.to_real_nonneg) _
+    end
+  ... = ess_sup (λ x, ↑‖f x‖₊) μ * (∫⁻ x, ↑‖g x‖₊ ^ p.to_real ∂μ) ^ (1 / p.to_real) :
+    begin
+      rw lintegral_const_mul'',
+      swap, { exact hg.nnnorm.ae_measurable.coe_nnreal_ennreal.pow ae_measurable_const, },
+      rw ennreal.mul_rpow_of_nonneg,
+      swap, { rw one_div_nonneg, exact ennreal.to_real_nonneg, },
+      rw [← ennreal.rpow_mul, one_div, mul_inv_cancel, ennreal.rpow_one],
+      rw [ne.def, ennreal.to_real_eq_zero_iff, auto.not_or_eq],
+      exact ⟨hp_zero, hp_top⟩,
+    end
+end
+
+lemma snorm_le_snorm_mul_snorm_top (p : ℝ≥0∞)
+  {f : α → E} (hf : ae_strongly_measurable f μ) (g : α → F) (b : E → F → G)
+  (h : ∀ᵐ x ∂μ, ‖b (f x) (g x)‖₊ ≤ ‖f x‖₊ * ‖g x‖₊) :
+  snorm (λ x, b (f x) (g x)) p μ ≤ snorm f p μ * snorm g ∞ μ :=
+begin
+  rw [← snorm_norm f, ← snorm_norm g],
+  refine (snorm_mono_ae_real h).trans _,
+  simp_rw [mul_comm ‖f _‖₊, nnreal.coe_mul, coe_nnnorm],
+  rw mul_comm,
+  refine snorm_le_snorm_top_mul_snorm p (λ x, ‖g x‖) hf.norm _ (h.mono $ λ x hx, _),
+  simp_rw [nnnorm_mul],
+end
+
+/-- Hölder's inequality, as an inequality on the `ℒp` seminorm of an elementwise operation
+`λ x, b (f x) (g x)`. -/
+lemma snorm_le_snorm_mul_snorm_of_nnnorm {p q r : ℝ≥0∞}
+  {f : α → E} (hf : ae_strongly_measurable f μ) {g : α → F} (hg : ae_strongly_measurable g μ)
+  (b : E → F → G) (h : ∀ᵐ x ∂μ, ‖b (f x) (g x)‖₊ ≤ ‖f x‖₊ * ‖g x‖₊)
+  (hpqr : 1/p = 1/q + 1/r) :
+  snorm (λ x, b (f x) (g x)) p μ ≤ snorm f q μ * snorm g r μ :=
+begin
+  by_cases hp_zero : p = 0,
+  { simp [hp_zero], },
+  have hq_ne_zero : q ≠ 0,
+  { intro hq_zero,
+    simp only [hq_zero, hp_zero, one_div, ennreal.inv_zero, top_add,
+      ennreal.inv_eq_top] at hpqr,
+    exact hpqr, },
+  have hr_ne_zero : r ≠ 0,
+  { intro hr_zero,
+    simp only [hr_zero, hp_zero, one_div, ennreal.inv_zero, add_top,
+      ennreal.inv_eq_top] at hpqr,
+    exact hpqr, },
+  by_cases hq_top : q = ∞,
+  { have hpr : p = r,
+    { simpa only [hq_top, one_div, ennreal.div_top, zero_add, inv_inj] using hpqr, },
+    rw [← hpr, hq_top],
+    exact snorm_le_snorm_top_mul_snorm p f hg b h, },
+  by_cases hr_top : r = ∞,
+  { have hpq : p = q,
+    { simpa only [hr_top, one_div, ennreal.div_top, add_zero, inv_inj] using hpqr, },
+    rw [← hpq, hr_top],
+    exact snorm_le_snorm_mul_snorm_top p hf g b h, },
+  have hpq : p < q,
+  { suffices : 1 / q < 1 / p,
+    { rwa [one_div, one_div, ennreal.inv_lt_inv] at this, },
+    rw hpqr,
+    refine ennreal.lt_add_right _ _,
+    { simp only [hq_ne_zero, one_div, ne.def, ennreal.inv_eq_top, not_false_iff], },
+    { simp only [hr_top, one_div, ne.def, ennreal.inv_eq_zero, not_false_iff], }, },
+  rw [snorm_eq_snorm' hp_zero (hpq.trans_le le_top).ne, snorm_eq_snorm' hq_ne_zero hq_top,
+    snorm_eq_snorm' hr_ne_zero hr_top],
+  refine snorm'_le_snorm'_mul_snorm' hf hg _ h _ _ _,
+  { exact ennreal.to_real_pos hp_zero (hpq.trans_le le_top).ne, },
+  { exact ennreal.to_real_strict_mono hq_top hpq, },
+  rw [← ennreal.one_to_real, ← ennreal.to_real_div, ← ennreal.to_real_div, ← ennreal.to_real_div,
+    hpqr, ennreal.to_real_add],
+  { simp only [hq_ne_zero, one_div, ne.def, ennreal.inv_eq_top, not_false_iff], },
+  { simp only [hr_ne_zero, one_div, ne.def, ennreal.inv_eq_top, not_false_iff], },
+end
+
+/-- Hölder's inequality, as an inequality on the `ℒp` seminorm of an elementwise operation
+`λ x, b (f x) (g x)`. -/
+lemma snorm_le_snorm_mul_snorm'_of_norm {p q r : ℝ≥0∞}
+  {f : α → E} (hf : ae_strongly_measurable f μ) {g : α → F} (hg : ae_strongly_measurable g μ)
+  (b : E → F → G) (h : ∀ᵐ x ∂μ, ‖b (f x) (g x)‖ ≤ ‖f x‖ * ‖g x‖)
+  (hpqr : 1/p = 1/q + 1/r) :
+  snorm (λ x, b (f x) (g x)) p μ ≤ snorm f q μ * snorm g r μ :=
+snorm_le_snorm_mul_snorm_of_nnnorm hf hg b h hpqr
+
+end monotonicity
+
+/-!
+### Bounded actions by normed rings
+
+In this section we show inequalities on the norm.
+-/
+section has_bounded_smul
+
+variables {𝕜 : Type*} [normed_ring 𝕜] [mul_action_with_zero 𝕜 E] [mul_action_with_zero 𝕜 F]
+variables [has_bounded_smul 𝕜 E] [has_bounded_smul 𝕜 F]
+
+lemma snorm'_const_smul_le (c : 𝕜) (f : α → F) (hq_pos : 0 < q) :
+  snorm' (c • f) q μ ≤ ‖c‖₊ • snorm' f q μ :=
+snorm'_le_nnreal_smul_snorm'_of_ae_le_mul (eventually_of_forall $ λ a, nnnorm_smul_le _ _) hq_pos
+
+lemma snorm_ess_sup_const_smul_le (c : 𝕜) (f : α → F) :
+  snorm_ess_sup (c • f) μ ≤ ‖c‖₊ • snorm_ess_sup f μ :=
+snorm_ess_sup_le_nnreal_smul_snorm_ess_sup_of_ae_le_mul
+  (eventually_of_forall $ λ a, nnnorm_smul_le _ _)
+
+lemma snorm_const_smul_le (c : 𝕜) (f : α → F) :
+  snorm (c • f) p μ ≤ ‖c‖₊ • snorm f p μ :=
+snorm_le_nnreal_smul_snorm_of_ae_le_mul (eventually_of_forall $ λ a, nnnorm_smul_le _ _) _
+
+lemma mem_ℒp.const_smul {f : α → E} (hf : mem_ℒp f p μ) (c : 𝕜) :
+  mem_ℒp (c • f) p μ :=
+⟨ae_strongly_measurable.const_smul hf.1 c,
+  (snorm_const_smul_le c f).trans_lt (ennreal.mul_lt_top ennreal.coe_ne_top hf.2.ne)⟩
+
+lemma mem_ℒp.const_mul {R} [normed_ring R] {f : α → R} (hf : mem_ℒp f p μ) (c : R) :
+  mem_ℒp (λ x, c * f x) p μ :=
+hf.const_smul c
+
+lemma snorm'_smul_le_mul_snorm' {p q r : ℝ}
+  {f : α → E} (hf : ae_strongly_measurable f μ) {φ : α → 𝕜} (hφ : ae_strongly_measurable φ μ)
+  (hp0_lt : 0 < p) (hpq : p < q) (hpqr : 1/p = 1/q + 1/r) :
+  snorm' (φ • f) p μ ≤ snorm' φ q μ * snorm' f r μ :=
+snorm'_le_snorm'_mul_snorm' hφ hf (•)
+  (eventually_of_forall $ λ a, nnnorm_smul_le _ _) hp0_lt hpq hpqr
+
+lemma snorm_smul_le_snorm_top_mul_snorm (p : ℝ≥0∞)
+  {f : α → E} (hf : ae_strongly_measurable f μ) (φ : α → 𝕜) :
+  snorm (φ • f) p μ ≤ snorm φ ∞ μ * snorm f p μ :=
+(snorm_le_snorm_top_mul_snorm p φ hf (•) (eventually_of_forall $ λ a, nnnorm_smul_le _ _) : _)
+
+lemma snorm_smul_le_snorm_mul_snorm_top (p : ℝ≥0∞)
+  (f : α → E) {φ : α → 𝕜} (hφ : ae_strongly_measurable φ μ) :
+  snorm (φ • f) p μ ≤ snorm φ p μ * snorm f ∞ μ :=
+(snorm_le_snorm_mul_snorm_top p hφ f (•) (eventually_of_forall $ λ a, nnnorm_smul_le _ _) : _)
+
+/-- Hölder's inequality, as an inequality on the `ℒp` seminorm of a scalar product `φ • f`. -/
+lemma snorm_smul_le_mul_snorm {p q r : ℝ≥0∞}
+  {f : α → E} (hf : ae_strongly_measurable f μ) {φ : α → 𝕜} (hφ : ae_strongly_measurable φ μ)
+  (hpqr : 1/p = 1/q + 1/r) :
+  snorm (φ • f) p μ ≤ snorm φ q μ * snorm f r μ :=
+(snorm_le_snorm_mul_snorm_of_nnnorm hφ hf (•)
+  (eventually_of_forall $ λ a, nnnorm_smul_le _ _) hpqr : _)
+
+lemma mem_ℒp.smul {p q r : ℝ≥0∞} {f : α → E} {φ : α → 𝕜}
+  (hf : mem_ℒp f r μ) (hφ : mem_ℒp φ q μ) (hpqr : 1/p = 1/q + 1/r) :
+  mem_ℒp (φ • f) p μ :=
+⟨hφ.1.smul hf.1, (snorm_smul_le_mul_snorm hf.1 hφ.1 hpqr).trans_lt
+  (ennreal.mul_lt_top hφ.snorm_ne_top hf.snorm_ne_top)⟩
+
+lemma mem_ℒp.smul_of_top_right {p : ℝ≥0∞} {f : α → E} {φ : α → 𝕜}
+  (hf : mem_ℒp f p μ) (hφ : mem_ℒp φ ∞ μ) :
+  mem_ℒp (φ • f) p μ :=
+by { apply hf.smul hφ, simp only [ennreal.div_top, zero_add] }
+
+lemma mem_ℒp.smul_of_top_left {p : ℝ≥0∞} {f : α → E} {φ : α → 𝕜}
+  (hf : mem_ℒp f ∞ μ) (hφ : mem_ℒp φ p μ) :
+  mem_ℒp (φ • f) p μ :=
+by { apply hf.smul hφ, simp only [ennreal.div_top, add_zero] }
+
+end has_bounded_smul
+
+/-!
+### Bounded actions by normed division rings
+
+The inequalities in the previous section are now tight.
+-/
+section normed_space
+
+variables {𝕜 : Type*} [normed_division_ring 𝕜] [mul_action_with_zero 𝕜 E] [module 𝕜 F]
+variables [has_bounded_smul 𝕜 E] [has_bounded_smul 𝕜 F]
+
+lemma snorm'_const_smul {f : α → F} (c : 𝕜) (hq_pos : 0 < q) :
+  snorm' (c • f) q μ = ‖c‖₊ • snorm' f q μ :=
+begin
+  obtain rfl | hc := eq_or_ne c 0,
+  { simp [snorm', hq_pos], },
+  refine le_antisymm (snorm'_const_smul_le _ _ hq_pos) _,
+  have : snorm' _ q μ ≤ _:= snorm'_const_smul_le (c⁻¹) (c • f) hq_pos,
+  rwa [inv_smul_smul₀ hc, nnnorm_inv, ennreal.le_inv_smul_iff (nnnorm_ne_zero_iff.mpr hc)] at this,
+end
+
+lemma snorm_ess_sup_const_smul (c : 𝕜) (f : α → F) :
+  snorm_ess_sup (c • f) μ = (‖c‖₊ : ℝ≥0∞) * snorm_ess_sup f μ :=
+by simp_rw [snorm_ess_sup,  pi.smul_apply, nnnorm_smul, ennreal.coe_mul, ennreal.ess_sup_const_mul]
+
+lemma snorm_const_smul (c : 𝕜) (f : α → F) :
+  snorm (c • f) p μ = (‖c‖₊ : ℝ≥0∞) * snorm f p μ :=
+begin
+  obtain rfl | hc := eq_or_ne c 0,
+  { simp, },
+  refine le_antisymm (snorm_const_smul_le _ _) _,
+  have : snorm _ p μ ≤ _:= snorm_const_smul_le (c⁻¹) (c • f),
+  rwa [inv_smul_smul₀ hc, nnnorm_inv, ennreal.le_inv_smul_iff (nnnorm_ne_zero_iff.mpr hc)] at this,
+end
+
+end normed_space
+
+lemma snorm_indicator_ge_of_bdd_below (hp : p ≠ 0) (hp' : p ≠ ∞)
+  {f : α → F} (C : ℝ≥0) {s : set α} (hs : measurable_set s)
+  (hf : ∀ᵐ x ∂μ, x ∈ s → C ≤ ‖s.indicator f x‖₊) :
+  C • μ s ^ (1 / p.to_real) ≤ snorm (s.indicator f) p μ :=
+begin
+  rw [ennreal.smul_def, smul_eq_mul, snorm_eq_lintegral_rpow_nnnorm hp hp',
+    ennreal.le_rpow_one_div_iff (ennreal.to_real_pos hp hp'),
+    ennreal.mul_rpow_of_nonneg _ _ ennreal.to_real_nonneg,
+    ← ennreal.rpow_mul, one_div_mul_cancel (ennreal.to_real_pos hp hp').ne.symm, ennreal.rpow_one,
+    ← set_lintegral_const, ← lintegral_indicator _ hs],
+  refine lintegral_mono_ae _,
+  filter_upwards [hf] with x hx,
+  rw nnnorm_indicator_eq_indicator_nnnorm,
+  by_cases hxs : x ∈ s,
+  { simp only [set.indicator_of_mem hxs] at ⊢ hx,
+    exact ennreal.rpow_le_rpow (ennreal.coe_le_coe.2 (hx hxs)) ennreal.to_real_nonneg },
+  { simp [set.indicator_of_not_mem hxs] },
+end
+
+section is_R_or_C
+variables {𝕜 : Type*} [is_R_or_C 𝕜] {f : α → 𝕜}
+
+lemma mem_ℒp.re (hf : mem_ℒp f p μ) : mem_ℒp (λ x, is_R_or_C.re (f x)) p μ :=
+begin
+  have : ∀ x, ‖is_R_or_C.re (f x)‖ ≤ 1 * ‖f x‖,
+    by { intro x, rw one_mul, exact is_R_or_C.norm_re_le_norm (f x), },
+  refine hf.of_le_mul _ (eventually_of_forall this),
+  exact is_R_or_C.continuous_re.comp_ae_strongly_measurable hf.1,
+end
+
+lemma mem_ℒp.im (hf : mem_ℒp f p μ) : mem_ℒp (λ x, is_R_or_C.im (f x)) p μ :=
+begin
+  have : ∀ x, ‖is_R_or_C.im (f x)‖ ≤ 1 * ‖f x‖,
+    by { intro x, rw one_mul, exact is_R_or_C.norm_im_le_norm (f x), },
+  refine hf.of_le_mul _ (eventually_of_forall this),
+  exact is_R_or_C.continuous_im.comp_ae_strongly_measurable hf.1,
+end
+
+end is_R_or_C
+
+section liminf
+
+variables [measurable_space E] [opens_measurable_space E] {R : ℝ≥0}
+
+lemma ae_bdd_liminf_at_top_rpow_of_snorm_bdd {p : ℝ≥0∞}
+  {f : ℕ → α → E} (hfmeas : ∀ n, measurable (f n)) (hbdd : ∀ n, snorm (f n) p μ ≤ R) :
+  ∀ᵐ x ∂μ, liminf (λ n, (‖f n x‖₊ ^ p.to_real : ℝ≥0∞)) at_top < ∞ :=
+begin
+  by_cases hp0 : p.to_real = 0,
+  { simp only [hp0, ennreal.rpow_zero],
+    refine eventually_of_forall (λ x, _),
+    rw liminf_const (1 : ℝ≥0∞),
+    exacts [ennreal.one_lt_top, at_top_ne_bot] },
+  have hp : p ≠ 0 := λ h, by simpa [h] using hp0,
+  have hp' : p ≠ ∞ := λ h, by simpa [h] using hp0,
+  refine ae_lt_top
+    (measurable_liminf (λ n, (hfmeas n).nnnorm.coe_nnreal_ennreal.pow_const p.to_real))
+    (lt_of_le_of_lt (lintegral_liminf_le
+      (λ n, (hfmeas n).nnnorm.coe_nnreal_ennreal.pow_const p.to_real))
+      (lt_of_le_of_lt _ (ennreal.rpow_lt_top_of_nonneg
+        ennreal.to_real_nonneg ennreal.coe_ne_top : ↑R ^ p.to_real < ∞))).ne,
+  simp_rw snorm_eq_lintegral_rpow_nnnorm hp hp' at hbdd,
+  simp_rw [liminf_eq, eventually_at_top],
+  exact Sup_le (λ b ⟨a, ha⟩, (ha a le_rfl).trans
+    ((ennreal.rpow_one_div_le_iff (ennreal.to_real_pos hp hp')).1 (hbdd _))),
+end
+
+lemma ae_bdd_liminf_at_top_of_snorm_bdd {p : ℝ≥0∞} (hp : p ≠ 0)
+  {f : ℕ → α → E} (hfmeas : ∀ n, measurable (f n)) (hbdd : ∀ n, snorm (f n) p μ ≤ R) :
+  ∀ᵐ x ∂μ, liminf (λ n, (‖f n x‖₊ : ℝ≥0∞)) at_top < ∞ :=
+begin
+  by_cases hp' : p = ∞,
+  { subst hp',
+    simp_rw snorm_exponent_top at hbdd,
+    have : ∀ n, ∀ᵐ x ∂μ, (‖f n x‖₊ : ℝ≥0∞) < R + 1 :=
+      λ n, ae_lt_of_ess_sup_lt (lt_of_le_of_lt (hbdd n) $
+        ennreal.lt_add_right ennreal.coe_ne_top one_ne_zero),
+    rw ← ae_all_iff at this,
+    filter_upwards [this] with x hx using lt_of_le_of_lt
+      (liminf_le_of_frequently_le' $ frequently_of_forall $ λ n, (hx n).le)
+      (ennreal.add_lt_top.2 ⟨ennreal.coe_lt_top, ennreal.one_lt_top⟩) },
+  filter_upwards [ae_bdd_liminf_at_top_rpow_of_snorm_bdd hfmeas hbdd] with x hx,
+  have hppos : 0 < p.to_real := ennreal.to_real_pos hp hp',
+  have : liminf (λ n, (‖f n x‖₊ ^ p.to_real : ℝ≥0∞)) at_top =
+    (liminf (λ n, (‖f n x‖₊ : ℝ≥0∞)) at_top)^ p.to_real,
+  { change liminf (λ n, ennreal.order_iso_rpow p.to_real hppos (‖f n x‖₊ : ℝ≥0∞)) at_top =
+      ennreal.order_iso_rpow p.to_real hppos (liminf (λ n, (‖f n x‖₊ : ℝ≥0∞)) at_top),
+    refine (order_iso.liminf_apply (ennreal.order_iso_rpow p.to_real _) _ _ _ _).symm;
+    is_bounded_default },
+  rw this at hx,
+  rw [← ennreal.rpow_one (liminf (λ n, ‖f n x‖₊) at_top), ← mul_inv_cancel hppos.ne.symm,
+    ennreal.rpow_mul],
+  exact ennreal.rpow_lt_top_of_nonneg (inv_nonneg.2 hppos.le) hx.ne,
+end
+
+end liminf
+
+end ℒp
+
+end measure_theory
diff --git a/src/measure_theory/function/lp_space.lean b/src/measure_theory/function/lp_space.lean
index 353a865f65161..8192c83bd4425 100644
--- a/src/measure_theory/function/lp_space.lean
+++ b/src/measure_theory/function/lp_space.lean
@@ -3,34 +3,22 @@ Copyright (c) 2020 Rémy Degenne. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne, Sébastien Gouëzel
 -/
-import analysis.normed_space.indicator_function
 import analysis.normed.group.hom
-import measure_theory.function.ess_sup
-import measure_theory.function.ae_eq_fun
-import measure_theory.integral.mean_inequalities
+import measure_theory.function.lp_seminorm
 import topology.continuous_function.compact
 
 /-!
-# ℒp space and Lp space
+# Lp space
 
-This file describes properties of almost everywhere strongly measurable functions with finite
-seminorm, denoted by `snorm f p μ` and defined for `p:ℝ≥0∞` as `0` if `p=0`,
-`(∫ ∥f a∥^p ∂μ) ^ (1/p)` for `0 < p < ∞` and `ess_sup ∥f∥ μ` for `p=∞`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-The Prop-valued `mem_ℒp f p μ` states that a function `f : α → E` has finite seminorm.
-The space `Lp E p μ` is the subtype of elements of `α →ₘ[μ] E` (see ae_eq_fun) such that
-`snorm f p μ` is finite. For `1 ≤ p`, `snorm` defines a norm and `Lp` is a complete metric space.
+This file provides the space `Lp E p μ` as the subtype of elements of `α →ₘ[μ] E` (see ae_eq_fun)
+such that `snorm f p μ` is finite. For `1 ≤ p`, `snorm` defines a norm and `Lp` is a complete metric
+space.
 
 ## Main definitions
 
-* `snorm' f p μ` : `(∫ ∥f a∥^p ∂μ) ^ (1/p)` for `f : α → F` and `p : ℝ`, where `α` is a  measurable
-  space and `F` is a normed group.
-* `snorm_ess_sup f μ` : seminorm in `ℒ∞`, equal to the essential supremum `ess_sup ∥f∥ μ`.
-* `snorm f p μ` : for `p : ℝ≥0∞`, seminorm in `ℒp`, equal to `0` for `p=0`, to `snorm' f p μ`
-  for `0 < p < ∞` and to `snorm_ess_sup f μ` for `p = ∞`.
-
-* `mem_ℒp f p μ` : property that the function `f` is almost everywhere strongly measurable and has
-  finite `p`-seminorm for the measure `μ` (`snorm f p μ < ∞`)
 * `Lp E p μ` : elements of `α →ₘ[μ] E` (see ae_eq_fun) such that `snorm f p μ` is finite. Defined
   as an `add_subgroup` of `α →ₘ[μ] E`.
 
@@ -75,1255 +63,13 @@ function coercion from the coercion to almost everywhere defined functions.
 
 noncomputable theory
 open topological_space measure_theory filter
-open_locale nnreal ennreal big_operators topological_space measure_theory
+open_locale nnreal ennreal big_operators topology measure_theory
 
 variables {α E F G : Type*} {m m0 : measurable_space α} {p : ℝ≥0∞} {q : ℝ} {μ ν : measure α}
-  [normed_group E] [normed_group F] [normed_group G]
+  [normed_add_comm_group E] [normed_add_comm_group F] [normed_add_comm_group G]
 
 namespace measure_theory
 
-section ℒp
-
-/-!
-### ℒp seminorm
-
-We define the ℒp seminorm, denoted by `snorm f p μ`. For real `p`, it is given by an integral
-formula (for which we use the notation `snorm' f p μ`), and for `p = ∞` it is the essential
-supremum (for which we use the notation `snorm_ess_sup f μ`).
-
-We also define a predicate `mem_ℒp f p μ`, requesting that a function is almost everywhere
-measurable and has finite `snorm f p μ`.
-
-This paragraph is devoted to the basic properties of these definitions. It is constructed as
-follows: for a given property, we prove it for `snorm'` and `snorm_ess_sup` when it makes sense,
-deduce it for `snorm`, and translate it in terms of `mem_ℒp`.
--/
-
-section ℒp_space_definition
-
-/-- `(∫ ∥f a∥^q ∂μ) ^ (1/q)`, which is a seminorm on the space of measurable functions for which
-this quantity is finite -/
-def snorm' {m : measurable_space α} (f : α → F) (q : ℝ) (μ : measure α) : ℝ≥0∞ :=
-(∫⁻ a, ∥f a∥₊^q ∂μ) ^ (1/q)
-
-/-- seminorm for `ℒ∞`, equal to the essential supremum of `∥f∥`. -/
-def snorm_ess_sup {m : measurable_space α} (f : α → F) (μ : measure α) :=
-ess_sup (λ x, (∥f x∥₊ : ℝ≥0∞)) μ
-
-/-- `ℒp` seminorm, equal to `0` for `p=0`, to `(∫ ∥f a∥^p ∂μ) ^ (1/p)` for `0 < p < ∞` and to
-`ess_sup ∥f∥ μ` for `p = ∞`. -/
-def snorm {m : measurable_space α} (f : α → F) (p : ℝ≥0∞) (μ : measure α) : ℝ≥0∞ :=
-if p = 0 then 0 else (if p = ∞ then snorm_ess_sup f μ else snorm' f (ennreal.to_real p) μ)
-
-lemma snorm_eq_snorm' (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) {f : α → F} :
-  snorm f p μ = snorm' f (ennreal.to_real p) μ :=
-by simp [snorm, hp_ne_zero, hp_ne_top]
-
-lemma snorm_eq_lintegral_rpow_nnnorm (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) {f : α → F} :
-  snorm f p μ = (∫⁻ x, ∥f x∥₊ ^ p.to_real ∂μ) ^ (1 / p.to_real) :=
-by rw [snorm_eq_snorm' hp_ne_zero hp_ne_top, snorm']
-
-lemma snorm_one_eq_lintegral_nnnorm {f : α → F} : snorm f 1 μ = ∫⁻ x, ∥f x∥₊ ∂μ :=
-by simp_rw [snorm_eq_lintegral_rpow_nnnorm one_ne_zero ennreal.coe_ne_top, ennreal.one_to_real,
-  one_div_one, ennreal.rpow_one]
-
-@[simp] lemma snorm_exponent_top {f : α → F} : snorm f ∞ μ = snorm_ess_sup f μ := by simp [snorm]
-
-/-- The property that `f:α→E` is ae strongly measurable and `(∫ ∥f a∥^p ∂μ)^(1/p)` is finite
-if `p < ∞`, or `ess_sup f < ∞` if `p = ∞`. -/
-def mem_ℒp {α} {m : measurable_space α}
-  (f : α → E) (p : ℝ≥0∞) (μ : measure α . volume_tac) : Prop :=
-ae_strongly_measurable f μ ∧ snorm f p μ < ∞
-
-lemma mem_ℒp.ae_strongly_measurable {f : α → E} {p : ℝ≥0∞} (h : mem_ℒp f p μ) :
-  ae_strongly_measurable f μ := h.1
-
-lemma lintegral_rpow_nnnorm_eq_rpow_snorm' {f : α → F} (hq0_lt : 0 < q) :
-  ∫⁻ a, ∥f a∥₊ ^ q ∂μ = (snorm' f q μ) ^ q :=
-begin
-  rw [snorm', ←ennreal.rpow_mul, one_div, inv_mul_cancel, ennreal.rpow_one],
-  exact (ne_of_lt hq0_lt).symm,
-end
-
-end ℒp_space_definition
-
-section top
-
-lemma mem_ℒp.snorm_lt_top {f : α → E} (hfp : mem_ℒp f p μ) : snorm f p μ < ∞ := hfp.2
-
-lemma mem_ℒp.snorm_ne_top {f : α → E} (hfp : mem_ℒp f p μ) : snorm f p μ ≠ ∞ := ne_of_lt (hfp.2)
-
-lemma lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top {f : α → F} (hq0_lt : 0 < q)
-  (hfq : snorm' f q μ < ∞) :
-  ∫⁻ a, ∥f a∥₊ ^ q ∂μ < ∞ :=
-begin
-  rw lintegral_rpow_nnnorm_eq_rpow_snorm' hq0_lt,
-  exact ennreal.rpow_lt_top_of_nonneg (le_of_lt hq0_lt) (ne_of_lt hfq),
-end
-
-lemma lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top {f : α → F} (hp_ne_zero : p ≠ 0)
-  (hp_ne_top : p ≠ ∞) (hfp : snorm f p μ < ∞) :
-  ∫⁻ a, ∥f a∥₊ ^ p.to_real ∂μ < ∞ :=
-begin
-  apply lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top,
-  { exact ennreal.to_real_pos hp_ne_zero hp_ne_top },
-  { simpa [snorm_eq_snorm' hp_ne_zero hp_ne_top] using hfp }
-end
-
-lemma snorm_lt_top_iff_lintegral_rpow_nnnorm_lt_top {f : α → F} (hp_ne_zero : p ≠ 0)
-  (hp_ne_top : p ≠ ∞) :
-  snorm f p μ < ∞ ↔ ∫⁻ a, ∥f a∥₊ ^ p.to_real ∂μ < ∞ :=
-⟨lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top hp_ne_zero hp_ne_top,
-  begin
-    intros h,
-    have hp' := ennreal.to_real_pos hp_ne_zero hp_ne_top,
-    have : 0 < 1 / p.to_real := div_pos zero_lt_one hp',
-    simpa [snorm_eq_lintegral_rpow_nnnorm hp_ne_zero hp_ne_top] using
-      ennreal.rpow_lt_top_of_nonneg (le_of_lt this) (ne_of_lt h)
-  end⟩
-
-end top
-
-section zero
-
-@[simp] lemma snorm'_exponent_zero {f : α → F} : snorm' f 0 μ = 1 :=
-by rw [snorm', div_zero, ennreal.rpow_zero]
-
-@[simp] lemma snorm_exponent_zero {f : α → F} : snorm f 0 μ = 0 :=
-by simp [snorm]
-
-lemma mem_ℒp_zero_iff_ae_strongly_measurable {f : α → E} :
-  mem_ℒp f 0 μ ↔ ae_strongly_measurable f μ :=
-by simp [mem_ℒp, snorm_exponent_zero]
-
-@[simp] lemma snorm'_zero (hp0_lt : 0 < q) : snorm' (0 : α → F) q μ = 0 :=
-by simp [snorm', hp0_lt]
-
-@[simp] lemma snorm'_zero' (hq0_ne : q ≠ 0) (hμ : μ ≠ 0) : snorm' (0 : α → F) q μ = 0 :=
-begin
-  cases le_or_lt 0 q with hq0 hq_neg,
-  { exact snorm'_zero (lt_of_le_of_ne hq0 hq0_ne.symm), },
-  { simp [snorm', ennreal.rpow_eq_zero_iff, hμ, hq_neg], },
-end
-
-@[simp] lemma snorm_ess_sup_zero : snorm_ess_sup (0 : α → F) μ = 0 :=
-begin
-  simp_rw [snorm_ess_sup, pi.zero_apply, nnnorm_zero, ennreal.coe_zero, ←ennreal.bot_eq_zero],
-  exact ess_sup_const_bot,
-end
-
-@[simp] lemma snorm_zero : snorm (0 : α → F) p μ = 0 :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  by_cases h_top : p = ∞,
-  { simp only [h_top, snorm_exponent_top, snorm_ess_sup_zero], },
-  rw ←ne.def at h0,
-  simp [snorm_eq_snorm' h0 h_top, ennreal.to_real_pos h0 h_top],
-end
-
-@[simp] lemma snorm_zero' : snorm (λ x : α, (0 : F)) p μ = 0 :=
-by convert snorm_zero
-
-lemma zero_mem_ℒp : mem_ℒp (0 : α → E) p μ :=
-⟨ae_strongly_measurable_zero, by { rw snorm_zero, exact ennreal.coe_lt_top, } ⟩
-
-lemma zero_mem_ℒp' : mem_ℒp (λ x : α, (0 : E)) p μ :=
-by convert zero_mem_ℒp
-
-variables [measurable_space α]
-
-lemma snorm'_measure_zero_of_pos {f : α → F} (hq_pos : 0 < q) :
-  snorm' f q (0 : measure α) = 0 :=
-by simp [snorm', hq_pos]
-
-lemma snorm'_measure_zero_of_exponent_zero {f : α → F} : snorm' f 0 (0 : measure α) = 1 :=
-by simp [snorm']
-
-lemma snorm'_measure_zero_of_neg {f : α → F} (hq_neg : q < 0) : snorm' f q (0 : measure α) = ∞ :=
-by simp [snorm', hq_neg]
-
-@[simp] lemma snorm_ess_sup_measure_zero {f : α → F} : snorm_ess_sup f (0 : measure α) = 0 :=
-by simp [snorm_ess_sup]
-
-@[simp] lemma snorm_measure_zero {f : α → F} : snorm f p (0 : measure α) = 0 :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  by_cases h_top : p = ∞,
-  { simp [h_top], },
-  rw ←ne.def at h0,
-  simp [snorm_eq_snorm' h0 h_top, snorm', ennreal.to_real_pos h0 h_top],
-end
-
-end zero
-
-section const
-
-lemma snorm'_const (c : F) (hq_pos : 0 < q) :
-  snorm' (λ x : α , c) q μ = (∥c∥₊ : ℝ≥0∞) * (μ set.univ) ^ (1/q) :=
-begin
-  rw [snorm', lintegral_const, ennreal.mul_rpow_of_nonneg _ _ (by simp [hq_pos.le] : 0 ≤ 1 / q)],
-  congr,
-  rw ←ennreal.rpow_mul,
-  suffices hq_cancel : q * (1/q) = 1, by rw [hq_cancel, ennreal.rpow_one],
-  rw [one_div, mul_inv_cancel (ne_of_lt hq_pos).symm],
-end
-
-lemma snorm'_const' [is_finite_measure μ] (c : F) (hc_ne_zero : c ≠ 0) (hq_ne_zero : q ≠ 0) :
-  snorm' (λ x : α , c) q μ = (∥c∥₊ : ℝ≥0∞) * (μ set.univ) ^ (1/q) :=
-begin
-  rw [snorm', lintegral_const, ennreal.mul_rpow_of_ne_top _ (measure_ne_top μ set.univ)],
-  { congr,
-    rw ←ennreal.rpow_mul,
-    suffices hp_cancel : q * (1/q) = 1, by rw [hp_cancel, ennreal.rpow_one],
-    rw [one_div, mul_inv_cancel hq_ne_zero], },
-  { rw [ne.def, ennreal.rpow_eq_top_iff, not_or_distrib, not_and_distrib, not_and_distrib],
-    split,
-    { left,
-      rwa [ennreal.coe_eq_zero, nnnorm_eq_zero], },
-    { exact or.inl ennreal.coe_ne_top, }, },
-end
-
-lemma snorm_ess_sup_const (c : F) (hμ : μ ≠ 0) :
-  snorm_ess_sup (λ x : α, c) μ = (∥c∥₊ : ℝ≥0∞) :=
-by rw [snorm_ess_sup, ess_sup_const _ hμ]
-
-lemma snorm'_const_of_is_probability_measure (c : F) (hq_pos : 0 < q) [is_probability_measure μ] :
-  snorm' (λ x : α , c) q μ = (∥c∥₊ : ℝ≥0∞) :=
-by simp [snorm'_const c hq_pos, measure_univ]
-
-lemma snorm_const (c : F) (h0 : p ≠ 0) (hμ : μ ≠ 0) :
-  snorm (λ x : α , c) p μ = (∥c∥₊ : ℝ≥0∞) * (μ set.univ) ^ (1/(ennreal.to_real p)) :=
-begin
-  by_cases h_top : p = ∞,
-  { simp [h_top, snorm_ess_sup_const c hμ], },
-  simp [snorm_eq_snorm' h0 h_top, snorm'_const, ennreal.to_real_pos h0 h_top],
-end
-
-lemma snorm_const' (c : F) (h0 : p ≠ 0) (h_top: p ≠ ∞) :
-  snorm (λ x : α , c) p μ = (∥c∥₊ : ℝ≥0∞) * (μ set.univ) ^ (1/(ennreal.to_real p)) :=
-begin
-  simp [snorm_eq_snorm' h0 h_top, snorm'_const, ennreal.to_real_pos h0 h_top],
-end
-
-lemma snorm_const_lt_top_iff {p : ℝ≥0∞} {c : F} (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  snorm (λ x : α, c) p μ < ∞ ↔ c = 0 ∨ μ set.univ < ∞ :=
-begin
-  have hp : 0 < p.to_real, from ennreal.to_real_pos hp_ne_zero hp_ne_top,
-  by_cases hμ : μ = 0,
-  { simp only [hμ, measure.coe_zero, pi.zero_apply, or_true, with_top.zero_lt_top,
-      snorm_measure_zero], },
-  by_cases hc : c = 0,
-  { simp only [hc, true_or, eq_self_iff_true, with_top.zero_lt_top, snorm_zero'], },
-  rw snorm_const' c hp_ne_zero hp_ne_top,
-  by_cases hμ_top : μ set.univ = ∞,
-  { simp [hc, hμ_top, hp], },
-  rw ennreal.mul_lt_top_iff,
-  simp only [true_and, one_div, ennreal.rpow_eq_zero_iff, hμ, false_or, or_false,
-    ennreal.coe_lt_top, nnnorm_eq_zero, ennreal.coe_eq_zero,
-    measure_theory.measure.measure_univ_eq_zero, hp, inv_lt_zero, hc, and_false, false_and,
-    _root_.inv_pos, or_self, hμ_top, ne.lt_top hμ_top, iff_true],
-  exact ennreal.rpow_lt_top_of_nonneg (inv_nonneg.mpr hp.le) hμ_top,
-end
-
-lemma mem_ℒp_const (c : E) [is_finite_measure μ] : mem_ℒp (λ a:α, c) p μ :=
-begin
-  refine ⟨ae_strongly_measurable_const, _⟩,
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  by_cases hμ : μ = 0,
-  { simp [hμ], },
-  rw snorm_const c h0 hμ,
-  refine ennreal.mul_lt_top ennreal.coe_ne_top _,
-  refine (ennreal.rpow_lt_top_of_nonneg _ (measure_ne_top μ set.univ)).ne,
-  simp,
-end
-
-lemma mem_ℒp_top_const (c : E) : mem_ℒp (λ a:α, c) ∞ μ :=
-begin
-  refine ⟨ae_strongly_measurable_const, _⟩,
-  by_cases h : μ = 0,
-  { simp only [h, snorm_measure_zero, with_top.zero_lt_top] },
-  { rw snorm_const _ ennreal.top_ne_zero h,
-    simp only [ennreal.top_to_real, div_zero, ennreal.rpow_zero, mul_one, ennreal.coe_lt_top] }
-end
-
-lemma mem_ℒp_const_iff {p : ℝ≥0∞} {c : E} (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  mem_ℒp (λ x : α, c) p μ ↔ c = 0 ∨ μ set.univ < ∞ :=
-begin
-  rw ← snorm_const_lt_top_iff hp_ne_zero hp_ne_top,
-  exact ⟨λ h, h.2, λ h, ⟨ae_strongly_measurable_const, h⟩⟩,
-end
-
-end const
-
-lemma snorm'_mono_ae {f : α → F} {g : α → G} (hq : 0 ≤ q) (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ ∥g x∥) :
-  snorm' f q μ ≤ snorm' g q μ :=
-begin
-  rw [snorm'],
-  refine ennreal.rpow_le_rpow _ (one_div_nonneg.2 hq),
-  refine lintegral_mono_ae (h.mono $ λ x hx, _),
-  exact ennreal.rpow_le_rpow (ennreal.coe_le_coe.2 hx) hq
-end
-
-lemma snorm'_congr_norm_ae {f g : α → F} (hfg : ∀ᵐ x ∂μ, ∥f x∥ = ∥g x∥) :
-  snorm' f q μ = snorm' g q μ :=
-begin
-  have : (λ x, (∥f x∥₊ ^ q : ℝ≥0∞)) =ᵐ[μ] (λ x, ∥g x∥₊ ^ q),
-    from hfg.mono (λ x hx, by { simp only [← coe_nnnorm, nnreal.coe_eq] at hx, simp [hx] }),
-  simp only [snorm', lintegral_congr_ae this]
-end
-
-lemma snorm'_congr_ae {f g : α → F} (hfg : f =ᵐ[μ] g) : snorm' f q μ = snorm' g q μ :=
-snorm'_congr_norm_ae (hfg.fun_comp _)
-
-lemma snorm_ess_sup_congr_ae {f g : α → F} (hfg : f =ᵐ[μ] g) :
-  snorm_ess_sup f μ = snorm_ess_sup g μ :=
-ess_sup_congr_ae (hfg.fun_comp (coe ∘ nnnorm))
-
-lemma snorm_mono_ae {f : α → F} {g : α → G} (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ ∥g x∥) :
-  snorm f p μ ≤ snorm g p μ :=
-begin
-  simp only [snorm],
-  split_ifs,
-  { exact le_rfl },
-  { refine ess_sup_mono_ae (h.mono $ λ x hx, _),
-    exact_mod_cast hx },
-  { exact snorm'_mono_ae ennreal.to_real_nonneg h }
-end
-
-lemma snorm_mono_ae_real {f : α → F} {g : α → ℝ} (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ g x) :
-  snorm f p μ ≤ snorm g p μ :=
-snorm_mono_ae $ h.mono (λ x hx, hx.trans ((le_abs_self _).trans (real.norm_eq_abs _).symm.le))
-
-lemma snorm_mono {f : α → F} {g : α → G} (h : ∀ x, ∥f x∥ ≤ ∥g x∥) :
-  snorm f p μ ≤ snorm g p μ :=
-snorm_mono_ae (eventually_of_forall (λ x, h x))
-
-lemma snorm_mono_real {f : α → F} {g : α → ℝ} (h : ∀ x, ∥f x∥ ≤ g x) :
-  snorm f p μ ≤ snorm g p μ :=
-snorm_mono_ae_real (eventually_of_forall (λ x, h x))
-
-lemma snorm_ess_sup_le_of_ae_bound {f : α → F} {C : ℝ} (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  snorm_ess_sup f μ ≤ ennreal.of_real C:=
-begin
-  simp_rw [snorm_ess_sup, ← of_real_norm_eq_coe_nnnorm],
-  refine ess_sup_le_of_ae_le (ennreal.of_real C) (hfC.mono (λ x hx, _)),
-  exact ennreal.of_real_le_of_real hx,
-end
-
-lemma snorm_ess_sup_lt_top_of_ae_bound {f : α → F} {C : ℝ} (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  snorm_ess_sup f μ < ∞ :=
-(snorm_ess_sup_le_of_ae_bound hfC).trans_lt ennreal.of_real_lt_top
-
-lemma snorm_le_of_ae_bound {f : α → F} {C : ℝ} (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  snorm f p μ ≤ ((μ set.univ) ^ p.to_real⁻¹) * (ennreal.of_real C) :=
-begin
-  by_cases hμ : μ = 0,
-  { simp [hμ] },
-  haveI : μ.ae.ne_bot := ae_ne_bot.mpr hμ,
-  by_cases hp : p = 0,
-  { simp [hp] },
-  have hC : 0 ≤ C, from le_trans (norm_nonneg _) hfC.exists.some_spec,
-  have hC' : ∥C∥ = C := by rw [real.norm_eq_abs, abs_eq_self.mpr hC],
-  have : ∀ᵐ x ∂μ, ∥f x∥ ≤ ∥(λ _, C) x∥, from hfC.mono (λ x hx, hx.trans (le_of_eq hC'.symm)),
-  convert snorm_mono_ae this,
-  rw [snorm_const _ hp hμ, mul_comm, ← of_real_norm_eq_coe_nnnorm, hC', one_div]
-end
-
-lemma snorm_congr_norm_ae {f : α → F} {g : α → G} (hfg : ∀ᵐ x ∂μ, ∥f x∥ = ∥g x∥) :
-  snorm f p μ = snorm g p μ :=
-le_antisymm (snorm_mono_ae $ eventually_eq.le hfg)
-  (snorm_mono_ae $ (eventually_eq.symm hfg).le)
-
-@[simp] lemma snorm'_norm {f : α → F} : snorm' (λ a, ∥f a∥) q μ = snorm' f q μ :=
-by simp [snorm']
-
-@[simp] lemma snorm_norm (f : α → F) : snorm (λ x, ∥f x∥) p μ = snorm f p μ :=
-snorm_congr_norm_ae $ eventually_of_forall $ λ x, norm_norm _
-
-lemma snorm'_norm_rpow (f : α → F) (p q : ℝ) (hq_pos : 0 < q) :
-  snorm' (λ x, ∥f x∥ ^ q) p μ = (snorm' f (p * q) μ) ^ q :=
-begin
-  simp_rw snorm',
-  rw [← ennreal.rpow_mul, ←one_div_mul_one_div],
-  simp_rw one_div,
-  rw [mul_assoc, inv_mul_cancel hq_pos.ne.symm, mul_one],
-  congr,
-  ext1 x,
-  simp_rw ← of_real_norm_eq_coe_nnnorm,
-  rw [real.norm_eq_abs, abs_eq_self.mpr (real.rpow_nonneg_of_nonneg (norm_nonneg _) _),
-    mul_comm, ← ennreal.of_real_rpow_of_nonneg (norm_nonneg _) hq_pos.le, ennreal.rpow_mul],
-end
-
-lemma snorm_norm_rpow (f : α → F) (hq_pos : 0 < q) :
-  snorm (λ x, ∥f x∥ ^ q) p μ = (snorm f (p * ennreal.of_real q) μ) ^ q :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0, ennreal.zero_rpow_of_pos hq_pos], },
-  by_cases hp_top : p = ∞,
-  { simp only [hp_top, snorm_exponent_top, ennreal.top_mul, hq_pos.not_le, ennreal.of_real_eq_zero,
-      if_false, snorm_exponent_top, snorm_ess_sup],
-    have h_rpow : ess_sup (λ (x : α), (∥(∥f x∥ ^ q)∥₊ : ℝ≥0∞)) μ
-      = ess_sup (λ (x : α), (↑∥f x∥₊) ^ q) μ,
-    { congr,
-      ext1 x,
-      nth_rewrite 1 ← nnnorm_norm,
-      rw [ennreal.coe_rpow_of_nonneg _ hq_pos.le, ennreal.coe_eq_coe],
-      ext,
-      push_cast,
-      rw real.norm_rpow_of_nonneg (norm_nonneg _), },
-    rw h_rpow,
-    have h_rpow_mono := ennreal.strict_mono_rpow_of_pos hq_pos,
-    have h_rpow_surj := (ennreal.rpow_left_bijective hq_pos.ne.symm).2,
-    let iso := h_rpow_mono.order_iso_of_surjective _ h_rpow_surj,
-    exact (iso.ess_sup_apply (λ x, (∥f x∥₊ : ℝ≥0∞)) μ).symm, },
-  rw [snorm_eq_snorm' h0 hp_top, snorm_eq_snorm' _ _],
-  swap, { refine mul_ne_zero h0 _, rwa [ne.def, ennreal.of_real_eq_zero, not_le], },
-  swap, { exact ennreal.mul_ne_top hp_top ennreal.of_real_ne_top, },
-  rw [ennreal.to_real_mul, ennreal.to_real_of_real hq_pos.le],
-  exact snorm'_norm_rpow f p.to_real q hq_pos,
-end
-
-lemma snorm_congr_ae {f g : α → F} (hfg : f =ᵐ[μ] g) : snorm f p μ = snorm g p μ :=
-snorm_congr_norm_ae $ hfg.mono (λ x hx, hx ▸ rfl)
-
-lemma mem_ℒp_congr_ae {f g : α → E} (hfg : f =ᵐ[μ] g) : mem_ℒp f p μ ↔ mem_ℒp g p μ :=
-by simp only [mem_ℒp, snorm_congr_ae hfg, ae_strongly_measurable_congr hfg]
-
-lemma mem_ℒp.ae_eq {f g : α → E} (hfg : f =ᵐ[μ] g) (hf_Lp : mem_ℒp f p μ) : mem_ℒp g p μ :=
-(mem_ℒp_congr_ae hfg).1 hf_Lp
-
-lemma mem_ℒp.of_le {f : α → E} {g : α → F}
-  (hg : mem_ℒp g p μ) (hf : ae_strongly_measurable f μ) (hfg : ∀ᵐ x ∂μ, ∥f x∥ ≤ ∥g x∥) :
-  mem_ℒp f p μ :=
-⟨hf, (snorm_mono_ae hfg).trans_lt hg.snorm_lt_top⟩
-
-alias mem_ℒp.of_le ← measure_theory.mem_ℒp.mono
-
-lemma mem_ℒp.mono' {f : α → E} {g : α → ℝ} (hg : mem_ℒp g p μ)
-  (hf : ae_strongly_measurable f μ) (h : ∀ᵐ a ∂μ, ∥f a∥ ≤ g a) : mem_ℒp f p μ :=
-hg.mono hf $ h.mono $ λ x hx, le_trans hx (le_abs_self _)
-
-lemma mem_ℒp.congr_norm {f : α → E} {g : α → F} (hf : mem_ℒp f p μ)
-  (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ∥f a∥ = ∥g a∥) :
-  mem_ℒp g p μ :=
-hf.mono hg $ eventually_eq.le $ eventually_eq.symm h
-
-lemma mem_ℒp_congr_norm {f : α → E} {g : α → F}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (h : ∀ᵐ a ∂μ, ∥f a∥ = ∥g a∥) :
-  mem_ℒp f p μ ↔ mem_ℒp g p μ :=
-⟨λ h2f, h2f.congr_norm hg h, λ h2g, h2g.congr_norm hf $ eventually_eq.symm h⟩
-
-lemma mem_ℒp_top_of_bound {f : α → E} (hf : ae_strongly_measurable f μ) (C : ℝ)
-  (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  mem_ℒp f ∞ μ :=
-⟨hf, by { rw snorm_exponent_top, exact snorm_ess_sup_lt_top_of_ae_bound hfC, }⟩
-
-lemma mem_ℒp.of_bound [is_finite_measure μ] {f : α → E} (hf : ae_strongly_measurable f μ)
-  (C : ℝ) (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  mem_ℒp f p μ :=
-(mem_ℒp_const C).of_le hf (hfC.mono (λ x hx, le_trans hx (le_abs_self _)))
-
-@[mono] lemma snorm'_mono_measure (f : α → F) (hμν : ν ≤ μ) (hq : 0 ≤ q) :
-  snorm' f q ν ≤ snorm' f q μ :=
-begin
-  simp_rw snorm',
-  suffices h_integral_mono : (∫⁻ a, (∥f a∥₊ : ℝ≥0∞) ^ q ∂ν) ≤ ∫⁻ a, ∥f a∥₊ ^ q ∂μ,
-    from ennreal.rpow_le_rpow h_integral_mono (by simp [hq]),
-  exact lintegral_mono' hμν le_rfl,
-end
-
-@[mono] lemma snorm_ess_sup_mono_measure (f : α → F) (hμν : ν ≪ μ) :
-  snorm_ess_sup f ν ≤ snorm_ess_sup f μ :=
-by { simp_rw snorm_ess_sup, exact ess_sup_mono_measure hμν, }
-
-@[mono] lemma snorm_mono_measure (f : α → F) (hμν : ν ≤ μ) :
-  snorm f p ν ≤ snorm f p μ :=
-begin
-  by_cases hp0 : p = 0,
-  { simp [hp0], },
-  by_cases hp_top : p = ∞,
-  { simp [hp_top, snorm_ess_sup_mono_measure f (measure.absolutely_continuous_of_le hμν)], },
-  simp_rw snorm_eq_snorm' hp0 hp_top,
-  exact snorm'_mono_measure f hμν ennreal.to_real_nonneg,
-end
-
-lemma mem_ℒp.mono_measure {f : α → E} (hμν : ν ≤ μ) (hf : mem_ℒp f p μ) :
-  mem_ℒp f p ν :=
-⟨hf.1.mono_measure hμν, (snorm_mono_measure f hμν).trans_lt hf.2⟩
-
-lemma mem_ℒp.restrict (s : set α) {f : α → E} (hf : mem_ℒp f p μ) :
-  mem_ℒp f p (μ.restrict s) :=
-hf.mono_measure measure.restrict_le_self
-
-lemma snorm'_smul_measure {p : ℝ} (hp : 0 ≤ p) {f : α → F} (c : ℝ≥0∞) :
-  snorm' f p (c • μ) = c ^ (1 / p) * snorm' f p μ :=
-by { rw [snorm', lintegral_smul_measure, ennreal.mul_rpow_of_nonneg, snorm'], simp [hp], }
-
-lemma snorm_ess_sup_smul_measure {f : α → F} {c : ℝ≥0∞} (hc : c ≠ 0) :
-  snorm_ess_sup f (c • μ) = snorm_ess_sup f μ :=
-by { simp_rw [snorm_ess_sup], exact ess_sup_smul_measure hc, }
-
-/-- Use `snorm_smul_measure_of_ne_top` instead. -/
-private lemma snorm_smul_measure_of_ne_zero_of_ne_top {p : ℝ≥0∞} (hp_ne_zero : p ≠ 0)
-  (hp_ne_top : p ≠ ∞) {f : α → F} (c : ℝ≥0∞) :
-  snorm f p (c • μ) = c ^ (1 / p).to_real • snorm f p μ :=
-begin
-  simp_rw snorm_eq_snorm' hp_ne_zero hp_ne_top,
-  rw snorm'_smul_measure ennreal.to_real_nonneg,
-  congr,
-  simp_rw one_div,
-  rw ennreal.to_real_inv,
-end
-
-lemma snorm_smul_measure_of_ne_zero {p : ℝ≥0∞} {f : α → F} {c : ℝ≥0∞} (hc : c ≠ 0) :
-  snorm f p (c • μ) = c ^ (1 / p).to_real • snorm f p μ :=
-begin
-  by_cases hp0 : p = 0,
-  { simp [hp0], },
-  by_cases hp_top : p = ∞,
-  { simp [hp_top, snorm_ess_sup_smul_measure hc], },
-  exact snorm_smul_measure_of_ne_zero_of_ne_top hp0 hp_top c,
-end
-
-lemma snorm_smul_measure_of_ne_top {p : ℝ≥0∞} (hp_ne_top : p ≠ ∞) {f : α → F} (c : ℝ≥0∞) :
-  snorm f p (c • μ) = c ^ (1 / p).to_real • snorm f p μ :=
-begin
-  by_cases hp0 : p = 0,
-  { simp [hp0], },
-  { exact snorm_smul_measure_of_ne_zero_of_ne_top hp0 hp_ne_top c, },
-end
-
-lemma snorm_one_smul_measure {f : α → F} (c : ℝ≥0∞) :
-  snorm f 1 (c • μ) = c * snorm f 1 μ :=
-by { rw @snorm_smul_measure_of_ne_top _ _ _ μ _ 1 (@ennreal.coe_ne_top 1) f c, simp, }
-
-lemma mem_ℒp.of_measure_le_smul {μ' : measure α} (c : ℝ≥0∞) (hc : c ≠ ∞)
-  (hμ'_le : μ' ≤ c • μ) {f : α → E} (hf : mem_ℒp f p μ) :
-  mem_ℒp f p μ' :=
-begin
-  refine ⟨hf.1.mono' (measure.absolutely_continuous_of_le_smul hμ'_le), _⟩,
-  refine (snorm_mono_measure f hμ'_le).trans_lt _,
-  by_cases hc0 : c = 0,
-  { simp [hc0], },
-  rw [snorm_smul_measure_of_ne_zero hc0, smul_eq_mul],
-  refine ennreal.mul_lt_top _ hf.2.ne,
-  simp [hc, hc0],
-end
-
-lemma mem_ℒp.smul_measure {f : α → E} {c : ℝ≥0∞} (hf : mem_ℒp f p μ) (hc : c ≠ ∞) :
-  mem_ℒp f p (c • μ) :=
-hf.of_measure_le_smul c hc le_rfl
-
-include m
-
-lemma snorm_one_add_measure (f : α → F) (μ ν : measure α) :
-  snorm f 1 (μ + ν) = snorm f 1 μ + snorm f 1 ν :=
-by { simp_rw snorm_one_eq_lintegral_nnnorm, rw lintegral_add_measure _ μ ν, }
-
-lemma snorm_le_add_measure_right (f : α → F) (μ ν : measure α) {p : ℝ≥0∞} :
-  snorm f p μ ≤ snorm f p (μ + ν) :=
-snorm_mono_measure f $ measure.le_add_right $ le_refl _
-
-lemma snorm_le_add_measure_left (f : α → F) (μ ν : measure α) {p : ℝ≥0∞} :
-  snorm f p ν ≤ snorm f p (μ + ν) :=
-snorm_mono_measure f $ measure.le_add_left $ le_refl _
-
-omit m
-
-lemma mem_ℒp.left_of_add_measure {f : α → E} (h : mem_ℒp f p (μ + ν)) : mem_ℒp f p μ :=
-h.mono_measure $ measure.le_add_right $ le_refl _
-
-lemma mem_ℒp.right_of_add_measure {f : α → E} (h : mem_ℒp f p (μ + ν)) : mem_ℒp f p ν :=
-h.mono_measure $ measure.le_add_left $ le_refl _
-
-lemma mem_ℒp.norm {f : α → E} (h : mem_ℒp f p μ) : mem_ℒp (λ x, ∥f x∥) p μ :=
-h.of_le h.ae_strongly_measurable.norm (eventually_of_forall (λ x, by simp))
-
-lemma mem_ℒp_norm_iff {f : α → E} (hf : ae_strongly_measurable f μ) :
-  mem_ℒp (λ x, ∥f x∥) p μ ↔ mem_ℒp f p μ :=
-⟨λ h, ⟨hf, by { rw ← snorm_norm, exact h.2, }⟩, λ h, h.norm⟩
-
-lemma snorm'_eq_zero_of_ae_zero {f : α → F} (hq0_lt : 0 < q) (hf_zero : f =ᵐ[μ] 0) :
-  snorm' f q μ = 0 :=
-by rw [snorm'_congr_ae hf_zero, snorm'_zero hq0_lt]
-
-lemma snorm'_eq_zero_of_ae_zero' (hq0_ne : q ≠ 0) (hμ : μ ≠ 0) {f : α → F} (hf_zero : f =ᵐ[μ] 0) :
-  snorm' f q μ = 0 :=
-by rw [snorm'_congr_ae hf_zero, snorm'_zero' hq0_ne hμ]
-
-lemma ae_eq_zero_of_snorm'_eq_zero {f : α → E} (hq0 : 0 ≤ q) (hf : ae_strongly_measurable f μ)
-  (h : snorm' f q μ = 0) : f =ᵐ[μ] 0 :=
-begin
-  rw [snorm', ennreal.rpow_eq_zero_iff] at h,
-  cases h,
-  { rw lintegral_eq_zero_iff' (hf.ennnorm.pow_const q) at h,
-    refine h.left.mono (λ x hx, _),
-    rw [pi.zero_apply, ennreal.rpow_eq_zero_iff] at hx,
-    cases hx,
-    { cases hx with hx _,
-      rwa [←ennreal.coe_zero, ennreal.coe_eq_coe, nnnorm_eq_zero] at hx, },
-    { exact absurd hx.left ennreal.coe_ne_top, }, },
-  { exfalso,
-    rw [one_div, inv_lt_zero] at h,
-    exact hq0.not_lt h.right },
-end
-
-lemma snorm'_eq_zero_iff (hq0_lt : 0 < q) {f : α → E} (hf : ae_strongly_measurable f μ) :
-  snorm' f q μ = 0 ↔ f =ᵐ[μ] 0 :=
-⟨ae_eq_zero_of_snorm'_eq_zero (le_of_lt hq0_lt) hf, snorm'_eq_zero_of_ae_zero hq0_lt⟩
-
-lemma coe_nnnorm_ae_le_snorm_ess_sup {m : measurable_space α} (f : α → F) (μ : measure α) :
-  ∀ᵐ x ∂μ, (∥f x∥₊ : ℝ≥0∞) ≤ snorm_ess_sup f μ :=
-ennreal.ae_le_ess_sup (λ x, (∥f x∥₊ : ℝ≥0∞))
-
-@[simp] lemma snorm_ess_sup_eq_zero_iff {f : α → F} : snorm_ess_sup f μ = 0 ↔ f =ᵐ[μ] 0 :=
-by simp [eventually_eq, snorm_ess_sup]
-
-lemma snorm_eq_zero_iff {f : α → E} (hf : ae_strongly_measurable f μ) (h0 : p ≠ 0) :
-  snorm f p μ = 0 ↔ f =ᵐ[μ] 0 :=
-begin
-  by_cases h_top : p = ∞,
-  { rw [h_top, snorm_exponent_top, snorm_ess_sup_eq_zero_iff], },
-  rw snorm_eq_snorm' h0 h_top,
-  exact snorm'_eq_zero_iff (ennreal.to_real_pos h0 h_top) hf,
-end
-
-lemma snorm'_add_le {f g : α → E}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (hq1 : 1 ≤ q) :
-  snorm' (f + g) q μ ≤ snorm' f q μ + snorm' g q μ :=
-calc (∫⁻ a, ↑∥(f + g) a∥₊ ^ q ∂μ) ^ (1 / q)
-    ≤ (∫⁻ a, (((λ a, (∥f a∥₊ : ℝ≥0∞))
-        + (λ a, (∥g a∥₊ : ℝ≥0∞))) a) ^ q ∂μ) ^ (1 / q) :
-begin
-  refine ennreal.rpow_le_rpow _ (by simp [le_trans zero_le_one hq1] : 0 ≤ 1 / q),
-  refine lintegral_mono (λ a, ennreal.rpow_le_rpow _ (le_trans zero_le_one hq1)),
-  simp [←ennreal.coe_add, nnnorm_add_le],
-end
-... ≤ snorm' f q μ + snorm' g q μ :
-  ennreal.lintegral_Lp_add_le hf.ennnorm hg.ennnorm hq1
-
-lemma snorm_ess_sup_add_le {f g : α → F} :
-  snorm_ess_sup (f + g) μ ≤ snorm_ess_sup f μ + snorm_ess_sup g μ :=
-begin
-  refine le_trans (ess_sup_mono_ae (eventually_of_forall (λ x, _)))
-    (ennreal.ess_sup_add_le _ _),
-  simp_rw [pi.add_apply, ←ennreal.coe_add, ennreal.coe_le_coe],
-  exact nnnorm_add_le _ _,
-end
-
-lemma snorm_add_le
-  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (hp1 : 1 ≤ p) :
-  snorm (f + g) p μ ≤ snorm f p μ + snorm g p μ :=
-begin
-  by_cases hp0 : p = 0,
-  { simp [hp0], },
-  by_cases hp_top : p = ∞,
-  { simp [hp_top, snorm_ess_sup_add_le], },
-  have hp1_real : 1 ≤ p.to_real,
-  by rwa [← ennreal.one_to_real, ennreal.to_real_le_to_real ennreal.one_ne_top hp_top],
-  repeat { rw snorm_eq_snorm' hp0 hp_top, },
-  exact snorm'_add_le hf hg hp1_real,
-end
-
-lemma snorm_sub_le
-  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) (hp1 : 1 ≤ p) :
-  snorm (f - g) p μ ≤ snorm f p μ + snorm g p μ :=
-calc snorm (f - g) p μ = snorm (f + - g) p μ : by rw sub_eq_add_neg
-  -- We cannot use snorm_add_le on f and (-g) because we don't have `ae_measurable (-g) μ`, since
-  -- we don't suppose `[borel_space E]`.
-... = snorm (λ x, ∥f x + - g x∥) p μ : (snorm_norm (f + - g)).symm
-... ≤ snorm (λ x, ∥f x∥ + ∥- g x∥) p μ : by
-{ refine snorm_mono_real (λ x, _), rw norm_norm, exact norm_add_le _ _, }
-... = snorm (λ x, ∥f x∥ + ∥g x∥) p μ : by simp_rw norm_neg
-... ≤ snorm (λ x, ∥f x∥) p μ + snorm (λ x, ∥g x∥) p μ : snorm_add_le hf.norm hg.norm hp1
-... = snorm f p μ + snorm g p μ : by rw [← snorm_norm f, ← snorm_norm g]
-
-lemma snorm_add_lt_top_of_one_le {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ)
-  (hq1 : 1 ≤ p) : snorm (f + g) p μ < ∞ :=
-lt_of_le_of_lt (snorm_add_le hf.1 hg.1 hq1) (ennreal.add_lt_top.mpr ⟨hf.2, hg.2⟩)
-
-lemma snorm'_add_lt_top_of_le_one
-  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ)
-  (hf_snorm : snorm' f q μ < ∞) (hg_snorm : snorm' g q μ < ∞) (hq_pos : 0 < q) (hq1 : q ≤ 1) :
-  snorm' (f + g) q μ < ∞ :=
-calc (∫⁻ a, ↑∥(f + g) a∥₊ ^ q ∂μ) ^ (1 / q)
-    ≤ (∫⁻ a, (((λ a, (∥f a∥₊ : ℝ≥0∞))
-        + (λ a, (∥g a∥₊ : ℝ≥0∞))) a) ^ q ∂μ) ^ (1 / q) :
-begin
-  refine ennreal.rpow_le_rpow _ (by simp [hq_pos.le] : 0 ≤ 1 / q),
-  refine lintegral_mono (λ a, ennreal.rpow_le_rpow _ hq_pos.le),
-  simp [←ennreal.coe_add, nnnorm_add_le],
-end
-... ≤ (∫⁻ a, (∥f a∥₊ : ℝ≥0∞) ^ q + (∥g a∥₊ : ℝ≥0∞) ^ q ∂μ) ^ (1 / q) :
-begin
-  refine ennreal.rpow_le_rpow (lintegral_mono (λ a, _)) (by simp [hq_pos.le] : 0 ≤ 1 / q),
-  exact ennreal.rpow_add_le_add_rpow _ _ hq_pos hq1,
-end
-... < ∞ :
-begin
-  refine ennreal.rpow_lt_top_of_nonneg (by simp [hq_pos.le] : 0 ≤ 1 / q) _,
-  rw [lintegral_add' (hf.ennnorm.pow_const q)
-    (hg.ennnorm.pow_const q), ennreal.add_ne_top, ←lt_top_iff_ne_top,
-    ←lt_top_iff_ne_top],
-  exact ⟨lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top hq_pos hf_snorm,
-    lintegral_rpow_nnnorm_lt_top_of_snorm'_lt_top hq_pos hg_snorm⟩,
-end
-
-lemma snorm_add_lt_top {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) :
-  snorm (f + g) p μ < ∞ :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  rw ←ne.def at h0,
-  cases le_total 1 p with hp1 hp1,
-  { exact snorm_add_lt_top_of_one_le hf hg hp1, },
-  have hp_top : p ≠ ∞, from (lt_of_le_of_lt hp1 ennreal.coe_lt_top).ne,
-  have hp_pos : 0 < p.to_real,
-  { rw [← ennreal.zero_to_real, @ennreal.to_real_lt_to_real 0 p ennreal.coe_ne_top hp_top],
-    exact ((zero_le p).lt_of_ne h0.symm), },
-  have hp1_real : p.to_real ≤ 1,
-  { rwa [← ennreal.one_to_real, @ennreal.to_real_le_to_real p 1 hp_top ennreal.coe_ne_top], },
-  rw snorm_eq_snorm' h0 hp_top,
-  rw [mem_ℒp, snorm_eq_snorm' h0 hp_top] at hf hg,
-  exact snorm'_add_lt_top_of_le_one hf.1 hg.1 hf.2 hg.2 hp_pos hp1_real,
-end
-
-section map_measure
-
-variables {β : Type*} {mβ : measurable_space β} {f : α → β} {g : β → E}
-
-include mβ
-
-lemma snorm_ess_sup_map_measure
-  (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
-  snorm_ess_sup g (measure.map f μ) = snorm_ess_sup (g ∘ f) μ :=
-ess_sup_map_measure hg.ennnorm hf
-
-lemma snorm_map_measure (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
-  snorm g p (measure.map f μ) = snorm (g ∘ f) p μ :=
-begin
-  by_cases hp_zero : p = 0,
-  { simp only [hp_zero, snorm_exponent_zero], },
-  by_cases hp_top : p = ∞,
-  { simp_rw [hp_top, snorm_exponent_top],
-    exact snorm_ess_sup_map_measure hg hf, },
-  simp_rw snorm_eq_lintegral_rpow_nnnorm hp_zero hp_top,
-  rw lintegral_map' (hg.ennnorm.pow_const p.to_real) hf,
-end
-
-lemma mem_ℒp_map_measure_iff
-  (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
-  mem_ℒp g p (measure.map f μ) ↔ mem_ℒp (g ∘ f) p μ :=
-by simp [mem_ℒp, snorm_map_measure hg hf, hg.comp_ae_measurable hf, hg]
-
-lemma _root_.measurable_embedding.snorm_ess_sup_map_measure {g : β → F}
-  (hf : measurable_embedding f) :
-  snorm_ess_sup g (measure.map f μ) = snorm_ess_sup (g ∘ f) μ :=
-hf.ess_sup_map_measure
-
-lemma _root_.measurable_embedding.snorm_map_measure {g : β → F} (hf : measurable_embedding f) :
-  snorm g p (measure.map f μ) = snorm (g ∘ f) p μ :=
-begin
-  by_cases hp_zero : p = 0,
-  { simp only [hp_zero, snorm_exponent_zero], },
-  by_cases hp : p = ∞,
-  { simp_rw [hp, snorm_exponent_top],
-    exact hf.ess_sup_map_measure, },
-  { simp_rw snorm_eq_lintegral_rpow_nnnorm hp_zero hp,
-    rw hf.lintegral_map, },
-end
-
-lemma _root_.measurable_embedding.mem_ℒp_map_measure_iff {g : β → F}
-  (hf : measurable_embedding f) :
-  mem_ℒp g p (measure.map f μ) ↔ mem_ℒp (g ∘ f) p μ :=
-by simp_rw [mem_ℒp, hf.ae_strongly_measurable_map_iff, hf.snorm_map_measure]
-
-lemma _root_.measurable_equiv.mem_ℒp_map_measure_iff (f : α ≃ᵐ β) {g : β → F} :
-  mem_ℒp g p (measure.map f μ) ↔ mem_ℒp (g ∘ f) p μ :=
-f.measurable_embedding.mem_ℒp_map_measure_iff
-
-omit mβ
-
-end map_measure
-
-section trim
-
-lemma snorm'_trim (hm : m ≤ m0) {f : α → E} (hf : strongly_measurable[m] f) :
-  snorm' f q (ν.trim hm) = snorm' f q ν :=
-begin
-  simp_rw snorm',
-  congr' 1,
-  refine lintegral_trim hm _,
-  refine @measurable.pow_const _ _ _ _ _ _ _ m _ (@measurable.coe_nnreal_ennreal _ m _ _) _,
-  apply @strongly_measurable.measurable,
-  exact (@strongly_measurable.nnnorm α m _ _ _ hf),
-end
-
-lemma limsup_trim (hm : m ≤ m0) {f : α → ℝ≥0∞} (hf : measurable[m] f) :
-  (ν.trim hm).ae.limsup f = ν.ae.limsup f :=
-begin
-  simp_rw limsup_eq,
-  suffices h_set_eq : {a : ℝ≥0∞ | ∀ᵐ n ∂(ν.trim hm), f n ≤ a} = {a : ℝ≥0∞ | ∀ᵐ n ∂ν, f n ≤ a},
-    by rw h_set_eq,
-  ext1 a,
-  suffices h_meas_eq : ν {x | ¬ f x ≤ a} = ν.trim hm {x | ¬ f x ≤ a},
-    by simp_rw [set.mem_set_of_eq, ae_iff, h_meas_eq],
-  refine (trim_measurable_set_eq hm _).symm,
-  refine @measurable_set.compl _ _ m (@measurable_set_le ℝ≥0∞ _ _ _ _ m _ _ _ _ _ hf _),
-  exact @measurable_const _ _ _ m _,
-end
-
-lemma ess_sup_trim (hm : m ≤ m0) {f : α → ℝ≥0∞} (hf : measurable[m] f) :
-  ess_sup f (ν.trim hm) = ess_sup f ν :=
-by { simp_rw ess_sup, exact limsup_trim hm hf, }
-
-lemma snorm_ess_sup_trim (hm : m ≤ m0) {f : α → E} (hf : strongly_measurable[m] f) :
-  snorm_ess_sup f (ν.trim hm) = snorm_ess_sup f ν :=
-ess_sup_trim _ (@strongly_measurable.ennnorm _ m _ _ _ hf)
-
-lemma snorm_trim (hm : m ≤ m0) {f : α → E} (hf : strongly_measurable[m] f) :
-  snorm f p (ν.trim hm) = snorm f p ν :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  by_cases h_top : p = ∞,
-  { simpa only [h_top, snorm_exponent_top] using snorm_ess_sup_trim hm hf, },
-  simpa only [snorm_eq_snorm' h0 h_top] using snorm'_trim hm hf,
-end
-
-lemma snorm_trim_ae (hm : m ≤ m0) {f : α → E} (hf : ae_strongly_measurable f (ν.trim hm)) :
-  snorm f p (ν.trim hm) = snorm f p ν :=
-begin
-  rw [snorm_congr_ae hf.ae_eq_mk, snorm_congr_ae (ae_eq_of_ae_eq_trim hf.ae_eq_mk)],
-  exact snorm_trim hm hf.strongly_measurable_mk,
-end
-
-lemma mem_ℒp_of_mem_ℒp_trim (hm : m ≤ m0) {f : α → E} (hf : mem_ℒp f p (ν.trim hm)) :
-  mem_ℒp f p ν :=
-⟨ae_strongly_measurable_of_ae_strongly_measurable_trim hm hf.1,
-(le_of_eq (snorm_trim_ae hm hf.1).symm).trans_lt hf.2⟩
-
-end trim
-
-@[simp] lemma snorm'_neg {f : α → F} : snorm' (-f) q μ = snorm' f q μ := by simp [snorm']
-
-@[simp] lemma snorm_neg {f : α → F} : snorm (-f) p μ = snorm f p μ :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  by_cases h_top : p = ∞,
-  { simp [h_top, snorm_ess_sup], },
-  simp [snorm_eq_snorm' h0 h_top],
-end
-
-section borel_space
--- variable [borel_space E]
-
-lemma mem_ℒp.neg {f : α → E} (hf : mem_ℒp f p μ) : mem_ℒp (-f) p μ :=
-⟨ae_strongly_measurable.neg hf.1, by simp [hf.right]⟩
-
-lemma mem_ℒp_neg_iff {f : α → E} : mem_ℒp (-f) p μ ↔ mem_ℒp f p μ :=
-⟨λ h, neg_neg f ▸ h.neg, mem_ℒp.neg⟩
-
-lemma snorm'_le_snorm'_mul_rpow_measure_univ {p q : ℝ} (hp0_lt : 0 < p) (hpq : p ≤ q)
-  {f : α → E} (hf : ae_strongly_measurable f μ) :
-  snorm' f p μ ≤ snorm' f q μ * (μ set.univ) ^ (1/p - 1/q) :=
-begin
-  have hq0_lt : 0 < q, from lt_of_lt_of_le hp0_lt hpq,
-  by_cases hpq_eq : p = q,
-  { rw [hpq_eq, sub_self, ennreal.rpow_zero, mul_one],
-    exact le_rfl, },
-  have hpq : p < q, from lt_of_le_of_ne hpq hpq_eq,
-  let g := λ a : α, (1 : ℝ≥0∞),
-  have h_rw : ∫⁻ a, ↑∥f a∥₊^p ∂ μ = ∫⁻ a, (∥f a∥₊ * (g a))^p ∂ μ,
-  from lintegral_congr (λ a, by simp),
-  repeat {rw snorm'},
-  rw h_rw,
-  let r := p * q / (q - p),
-  have hpqr : 1/p = 1/q + 1/r,
-  { field_simp [(ne_of_lt hp0_lt).symm,
-      (ne_of_lt hq0_lt).symm],
-    ring, },
-  calc (∫⁻ (a : α), (↑∥f a∥₊ * g a) ^ p ∂μ) ^ (1/p)
-      ≤ (∫⁻ (a : α), ↑∥f a∥₊ ^ q ∂μ) ^ (1/q) * (∫⁻ (a : α), (g a) ^ r ∂μ) ^ (1/r) :
-    ennreal.lintegral_Lp_mul_le_Lq_mul_Lr hp0_lt hpq hpqr μ hf.ennnorm ae_measurable_const
-  ... = (∫⁻ (a : α), ↑∥f a∥₊ ^ q ∂μ) ^ (1/q) * μ set.univ ^ (1/p - 1/q) :
-    by simp [hpqr],
-end
-
-lemma snorm'_le_snorm_ess_sup_mul_rpow_measure_univ (hq_pos : 0 < q) {f : α → F} :
-  snorm' f q μ ≤ snorm_ess_sup f μ * (μ set.univ) ^ (1/q) :=
-begin
-  have h_le : ∫⁻ (a : α), ↑∥f a∥₊ ^ q ∂μ ≤ ∫⁻ (a : α), (snorm_ess_sup f μ) ^ q ∂μ,
-  { refine lintegral_mono_ae _,
-    have h_nnnorm_le_snorm_ess_sup := coe_nnnorm_ae_le_snorm_ess_sup f μ,
-    refine h_nnnorm_le_snorm_ess_sup.mono (λ x hx, ennreal.rpow_le_rpow hx (le_of_lt hq_pos)), },
-  rw [snorm', ←ennreal.rpow_one (snorm_ess_sup f μ)],
-  nth_rewrite 1 ←mul_inv_cancel (ne_of_lt hq_pos).symm,
-  rw [ennreal.rpow_mul, one_div,
-    ←ennreal.mul_rpow_of_nonneg _ _ (by simp [hq_pos.le] : 0 ≤ q⁻¹)],
-  refine ennreal.rpow_le_rpow _ (by simp [hq_pos.le]),
-  rwa lintegral_const at h_le,
-end
-
-lemma snorm_le_snorm_mul_rpow_measure_univ {p q : ℝ≥0∞} (hpq : p ≤ q) {f : α → E}
-  (hf : ae_strongly_measurable f μ) :
-  snorm f p μ ≤ snorm f q μ * (μ set.univ) ^ (1/p.to_real - 1/q.to_real) :=
-begin
-  by_cases hp0 : p = 0,
-  { simp [hp0, zero_le], },
-  rw ← ne.def at hp0,
-  have hp0_lt : 0 < p, from lt_of_le_of_ne (zero_le _) hp0.symm,
-  have hq0_lt : 0 < q, from lt_of_lt_of_le hp0_lt hpq,
-  by_cases hq_top : q = ∞,
-  { simp only [hq_top, div_zero, one_div, ennreal.top_to_real, sub_zero, snorm_exponent_top,
-      inv_zero],
-    by_cases hp_top : p = ∞,
-    { simp only [hp_top, ennreal.rpow_zero, mul_one, ennreal.top_to_real, sub_zero, inv_zero,
-        snorm_exponent_top],
-      exact le_rfl, },
-    rw snorm_eq_snorm' hp0 hp_top,
-    have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp0_lt.ne' hp_top,
-    refine (snorm'_le_snorm_ess_sup_mul_rpow_measure_univ hp_pos).trans (le_of_eq _),
-    congr,
-    exact one_div _, },
-  have hp_lt_top : p < ∞, from hpq.trans_lt (lt_top_iff_ne_top.mpr hq_top),
-  have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp0_lt.ne' hp_lt_top.ne,
-  rw [snorm_eq_snorm' hp0_lt.ne.symm hp_lt_top.ne, snorm_eq_snorm' hq0_lt.ne.symm hq_top],
-  have hpq_real : p.to_real ≤ q.to_real, by rwa ennreal.to_real_le_to_real hp_lt_top.ne hq_top,
-  exact snorm'_le_snorm'_mul_rpow_measure_univ hp_pos hpq_real hf,
-end
-
-lemma snorm'_le_snorm'_of_exponent_le {m : measurable_space α} {p q : ℝ} (hp0_lt : 0 < p)
-  (hpq : p ≤ q) (μ : measure α) [is_probability_measure μ] {f : α → E}
-  (hf : ae_strongly_measurable f μ) :
-  snorm' f p μ ≤ snorm' f q μ :=
-begin
-  have h_le_μ := snorm'_le_snorm'_mul_rpow_measure_univ hp0_lt hpq hf,
-  rwa [measure_univ, ennreal.one_rpow, mul_one] at h_le_μ,
-end
-
-lemma snorm'_le_snorm_ess_sup (hq_pos : 0 < q) {f : α → F} [is_probability_measure μ] :
-  snorm' f q μ ≤ snorm_ess_sup f μ :=
-le_trans (snorm'_le_snorm_ess_sup_mul_rpow_measure_univ hq_pos) (le_of_eq (by simp [measure_univ]))
-
-lemma snorm_le_snorm_of_exponent_le {p q : ℝ≥0∞} (hpq : p ≤ q) [is_probability_measure μ]
-  {f : α → E} (hf : ae_strongly_measurable f μ) :
-  snorm f p μ ≤ snorm f q μ :=
-(snorm_le_snorm_mul_rpow_measure_univ hpq hf).trans (le_of_eq (by simp [measure_univ]))
-
-lemma snorm'_lt_top_of_snorm'_lt_top_of_exponent_le {p q : ℝ} [is_finite_measure μ] {f : α → E}
-  (hf : ae_strongly_measurable f μ) (hfq_lt_top : snorm' f q μ < ∞)
-  (hp_nonneg : 0 ≤ p) (hpq : p ≤ q) :
-  snorm' f p μ < ∞ :=
-begin
-  cases le_or_lt p 0 with hp_nonpos hp_pos,
-  { rw le_antisymm hp_nonpos hp_nonneg,
-    simp, },
-  have hq_pos : 0 < q, from lt_of_lt_of_le hp_pos hpq,
-  calc snorm' f p μ
-      ≤ snorm' f q μ * (μ set.univ) ^ (1/p - 1/q) :
-    snorm'_le_snorm'_mul_rpow_measure_univ hp_pos hpq hf
-  ... < ∞ :
-  begin
-    rw ennreal.mul_lt_top_iff,
-    refine or.inl ⟨hfq_lt_top, ennreal.rpow_lt_top_of_nonneg _ (measure_ne_top μ set.univ)⟩,
-    rwa [le_sub, sub_zero, one_div, one_div, inv_le_inv hq_pos hp_pos],
-  end
-end
-
-variables (μ)
-
-lemma pow_mul_meas_ge_le_snorm {f : α → E}
-  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (hf : ae_strongly_measurable f μ) (ε : ℝ≥0∞) :
-  (ε * μ {x | ε ≤ ∥f x∥₊ ^ p.to_real}) ^ (1 / p.to_real) ≤ snorm f p μ :=
-begin
-  rw snorm_eq_lintegral_rpow_nnnorm hp_ne_zero hp_ne_top,
-  exact ennreal.rpow_le_rpow (mul_meas_ge_le_lintegral₀ (hf.ennnorm.pow_const _) ε)
-    (one_div_nonneg.2 ennreal.to_real_nonneg),
-end
-
-lemma mul_meas_ge_le_pow_snorm {f : α → E}
-  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (hf : ae_strongly_measurable f μ) (ε : ℝ≥0∞) :
-  ε * μ {x | ε ≤ ∥f x∥₊ ^ p.to_real} ≤ snorm f p μ ^ p.to_real :=
-begin
-  have : 1 / p.to_real * p.to_real = 1,
-  { refine one_div_mul_cancel _,
-    rw [ne, ennreal.to_real_eq_zero_iff],
-    exact not_or hp_ne_zero hp_ne_top },
-  rw [← ennreal.rpow_one (ε * μ {x | ε ≤ ∥f x∥₊ ^ p.to_real}), ← this, ennreal.rpow_mul],
-  exact ennreal.rpow_le_rpow (pow_mul_meas_ge_le_snorm μ hp_ne_zero hp_ne_top hf ε)
-    ennreal.to_real_nonneg,
-end
-
-/-- A version of Markov's inequality using Lp-norms. -/
-lemma mul_meas_ge_le_pow_snorm' {f : α → E}
-  (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (hf : ae_strongly_measurable f μ) (ε : ℝ≥0∞) :
-  ε ^ p.to_real * μ {x | ε ≤ ∥f x∥₊} ≤ snorm f p μ ^ p.to_real :=
-begin
-  convert mul_meas_ge_le_pow_snorm μ hp_ne_zero hp_ne_top hf (ε ^ p.to_real),
-  ext x,
-  rw ennreal.rpow_le_rpow_iff (ennreal.to_real_pos hp_ne_zero hp_ne_top),
-end
-
-lemma meas_ge_le_mul_pow_snorm {f : α → E} (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞)
-  (hf : ae_strongly_measurable f μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
-  μ {x | ε ≤ ∥f x∥₊} ≤ ε⁻¹ ^ p.to_real * snorm f p μ ^ p.to_real :=
-begin
-  by_cases ε = ∞,
-  { simp [h] },
-  have hεpow : ε ^ p.to_real ≠ 0 := (ennreal.rpow_pos (pos_iff_ne_zero.2 hε) h).ne.symm,
-  have hεpow' : ε ^ p.to_real ≠ ∞ := (ennreal.rpow_ne_top_of_nonneg ennreal.to_real_nonneg h),
-  rw [ennreal.inv_rpow, ← ennreal.mul_le_mul_left hεpow hεpow', ← mul_assoc,
-      ennreal.mul_inv_cancel hεpow hεpow', one_mul],
-  exact mul_meas_ge_le_pow_snorm' μ hp_ne_zero hp_ne_top hf ε,
-end
-
-variables {μ}
-
-lemma mem_ℒp.mem_ℒp_of_exponent_le {p q : ℝ≥0∞} [is_finite_measure μ] {f : α → E}
-  (hfq : mem_ℒp f q μ) (hpq : p ≤ q) :
-  mem_ℒp f p μ :=
-begin
-  cases hfq with hfq_m hfq_lt_top,
-  by_cases hp0 : p = 0,
-  { rwa [hp0, mem_ℒp_zero_iff_ae_strongly_measurable], },
-  rw ←ne.def at hp0,
-  refine ⟨hfq_m, _⟩,
-  by_cases hp_top : p = ∞,
-  { have hq_top : q = ∞,
-      by rwa [hp_top, top_le_iff] at hpq,
-    rw [hp_top],
-    rwa hq_top at hfq_lt_top, },
-  have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp0 hp_top,
-  by_cases hq_top : q = ∞,
-  { rw snorm_eq_snorm' hp0 hp_top,
-    rw [hq_top, snorm_exponent_top] at hfq_lt_top,
-    refine lt_of_le_of_lt (snorm'_le_snorm_ess_sup_mul_rpow_measure_univ hp_pos) _,
-    refine ennreal.mul_lt_top hfq_lt_top.ne _,
-    exact (ennreal.rpow_lt_top_of_nonneg (by simp [hp_pos.le]) (measure_ne_top μ set.univ)).ne },
-  have hq0 : q ≠ 0,
-  { by_contra hq_eq_zero,
-    have hp_eq_zero : p = 0, from le_antisymm (by rwa hq_eq_zero at hpq) (zero_le _),
-    rw [hp_eq_zero, ennreal.zero_to_real] at hp_pos,
-    exact (lt_irrefl _) hp_pos, },
-  have hpq_real : p.to_real ≤ q.to_real, by rwa ennreal.to_real_le_to_real hp_top hq_top,
-  rw snorm_eq_snorm' hp0 hp_top,
-  rw snorm_eq_snorm' hq0 hq_top at hfq_lt_top,
-  exact snorm'_lt_top_of_snorm'_lt_top_of_exponent_le hfq_m hfq_lt_top (le_of_lt hp_pos) hpq_real,
-end
-
-section has_measurable_add
--- variable [has_measurable_add₂ E]
-
-lemma snorm'_sum_le {ι} {f : ι → α → E} {s : finset ι}
-  (hfs : ∀ i, i ∈ s → ae_strongly_measurable (f i) μ) (hq1 : 1 ≤ q) :
-  snorm' (∑ i in s, f i) q μ ≤ ∑ i in s, snorm' (f i) q μ :=
-finset.le_sum_of_subadditive_on_pred (λ (f : α → E), snorm' f q μ)
-  (λ f, ae_strongly_measurable f μ) (snorm'_zero (zero_lt_one.trans_le hq1))
-  (λ f g hf hg, snorm'_add_le hf hg hq1) (λ f g hf hg, hf.add hg) _ hfs
-
-lemma snorm_sum_le {ι} {f : ι → α → E} {s : finset ι}
-  (hfs : ∀ i, i ∈ s → ae_strongly_measurable (f i) μ) (hp1 : 1 ≤ p) :
-  snorm (∑ i in s, f i) p μ ≤ ∑ i in s, snorm (f i) p μ :=
-finset.le_sum_of_subadditive_on_pred (λ (f : α → E), snorm f p μ)
-  (λ f, ae_strongly_measurable f μ) snorm_zero (λ f g hf hg, snorm_add_le hf hg hp1)
-  (λ f g hf hg, hf.add hg) _ hfs
-
-lemma mem_ℒp.add {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) : mem_ℒp (f + g) p μ :=
-⟨ae_strongly_measurable.add hf.1 hg.1, snorm_add_lt_top hf hg⟩
-
-lemma mem_ℒp.sub {f g : α → E} (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ) : mem_ℒp (f - g) p μ :=
-by { rw sub_eq_add_neg, exact hf.add hg.neg }
-
-lemma mem_ℒp_finset_sum {ι} (s : finset ι) {f : ι → α → E} (hf : ∀ i ∈ s, mem_ℒp (f i) p μ) :
-  mem_ℒp (λ a, ∑ i in s, f i a) p μ :=
-begin
-  haveI : decidable_eq ι := classical.dec_eq _,
-  revert hf,
-  refine finset.induction_on s _ _,
-  { simp only [zero_mem_ℒp', finset.sum_empty, implies_true_iff], },
-  { intros i s his ih hf,
-    simp only [his, finset.sum_insert, not_false_iff],
-    exact (hf i (s.mem_insert_self i)).add (ih (λ j hj, hf j (finset.mem_insert_of_mem hj))), },
-end
-
-lemma mem_ℒp_finset_sum' {ι} (s : finset ι) {f : ι → α → E} (hf : ∀ i ∈ s, mem_ℒp (f i) p μ) :
-  mem_ℒp (∑ i in s, f i) p μ :=
-begin
-  convert mem_ℒp_finset_sum s hf,
-  ext x,
-  simp,
-end
-
-end has_measurable_add
-
-end borel_space
-
-section normed_space
-
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E] [normed_space 𝕜 F]
-
-lemma snorm'_const_smul {f : α → F} (c : 𝕜) (hq_pos : 0 < q) :
-  snorm' (c • f) q μ = (∥c∥₊ : ℝ≥0∞) * snorm' f q μ :=
-begin
-  rw snorm',
-  simp_rw [pi.smul_apply, nnnorm_smul, ennreal.coe_mul,
-    ennreal.mul_rpow_of_nonneg _ _ hq_pos.le],
-  suffices h_integral : ∫⁻ a, ↑(∥c∥₊) ^ q * ↑∥f a∥₊ ^ q ∂μ
-    = (∥c∥₊ : ℝ≥0∞)^q * ∫⁻ a, ∥f a∥₊ ^ q ∂μ,
-  { apply_fun (λ x, x ^ (1/q)) at h_integral,
-    rw [h_integral, ennreal.mul_rpow_of_nonneg _ _ (by simp [hq_pos.le] : 0 ≤ 1 / q)],
-    congr,
-    simp_rw [←ennreal.rpow_mul, one_div, mul_inv_cancel hq_pos.ne.symm, ennreal.rpow_one], },
-  rw lintegral_const_mul',
-  rw ennreal.coe_rpow_of_nonneg _ hq_pos.le,
-  exact ennreal.coe_ne_top,
-end
-
-lemma snorm_ess_sup_const_smul {f : α → F} (c : 𝕜) :
-  snorm_ess_sup (c • f) μ = (∥c∥₊ : ℝ≥0∞) * snorm_ess_sup f μ :=
-by simp_rw [snorm_ess_sup,  pi.smul_apply, nnnorm_smul, ennreal.coe_mul, ennreal.ess_sup_const_mul]
-
-lemma snorm_const_smul {f : α → F} (c : 𝕜) :
-  snorm (c • f) p μ = (∥c∥₊ : ℝ≥0∞) * snorm f p μ :=
-begin
-  by_cases h0 : p = 0,
-  { simp [h0], },
-  by_cases h_top : p = ∞,
-  { simp [h_top, snorm_ess_sup_const_smul], },
-  repeat { rw snorm_eq_snorm' h0 h_top, },
-  rw ←ne.def at h0,
-  exact snorm'_const_smul c (ennreal.to_real_pos h0 h_top),
-end
-
-lemma mem_ℒp.const_smul {f : α → E} (hf : mem_ℒp f p μ) (c : 𝕜) :
-  mem_ℒp (c • f) p μ :=
-⟨ae_strongly_measurable.const_smul hf.1 c,
-  (snorm_const_smul c).le.trans_lt (ennreal.mul_lt_top ennreal.coe_ne_top hf.2.ne)⟩
-
-lemma mem_ℒp.const_mul {f : α → 𝕜} (hf : mem_ℒp f p μ) (c : 𝕜) :
-  mem_ℒp (λ x, c * f x) p μ :=
-hf.const_smul c
-
-lemma snorm'_smul_le_mul_snorm' {p q r : ℝ}
-  {f : α → E} (hf : ae_strongly_measurable f μ) {φ : α → 𝕜} (hφ : ae_strongly_measurable φ μ)
-  (hp0_lt : 0 < p) (hpq : p < q) (hpqr : 1/p = 1/q + 1/r) :
-  snorm' (φ • f) p μ ≤ snorm' φ q μ * snorm' f r μ :=
-begin
-  simp_rw [snorm', pi.smul_apply', nnnorm_smul, ennreal.coe_mul],
-  exact ennreal.lintegral_Lp_mul_le_Lq_mul_Lr hp0_lt hpq hpqr μ hφ.ennnorm
-    hf.ennnorm,
-end
-
-end normed_space
-
-section monotonicity
-
-lemma snorm_le_mul_snorm_aux_of_nonneg {f : α → F} {g : α → G} {c : ℝ}
-  (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ c * ∥g x∥) (hc : 0 ≤ c) (p : ℝ≥0∞) :
-  snorm f p μ ≤ (ennreal.of_real c) * snorm g p μ :=
-begin
-  lift c to ℝ≥0 using hc,
-  rw [ennreal.of_real_coe_nnreal, ← c.nnnorm_eq, ← snorm_norm g, ← snorm_const_smul (c : ℝ)],
-  swap, apply_instance,
-  refine snorm_mono_ae _,
-  simpa
-end
-
-lemma snorm_le_mul_snorm_aux_of_neg {f : α → F} {g : α → G} {c : ℝ}
-  (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ c * ∥g x∥) (hc : c < 0) (p : ℝ≥0∞) :
-  snorm f p μ = 0 ∧ snorm g p μ = 0 :=
-begin
-  suffices : f =ᵐ[μ] 0 ∧ g =ᵐ[μ] 0,
-    by simp [snorm_congr_ae this.1, snorm_congr_ae this.2],
-  refine ⟨h.mono $ λ x hx, _, h.mono $ λ x hx, _⟩,
-  { refine norm_le_zero_iff.1 (hx.trans _),
-    exact mul_nonpos_of_nonpos_of_nonneg hc.le (norm_nonneg _) },
-  { refine norm_le_zero_iff.1 (nonpos_of_mul_nonneg_right _ hc),
-    exact (norm_nonneg _).trans hx }
-end
-
-lemma snorm_le_mul_snorm_of_ae_le_mul {f : α → F} {g : α → G} {c : ℝ}
-  (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ c * ∥g x∥) (p : ℝ≥0∞) :
-  snorm f p μ ≤ (ennreal.of_real c) * snorm g p μ :=
-begin
-  cases le_or_lt 0 c with hc hc,
-  { exact snorm_le_mul_snorm_aux_of_nonneg h hc p },
-  { simp [snorm_le_mul_snorm_aux_of_neg h hc p] }
-end
-
-lemma mem_ℒp.of_le_mul {f : α → E} {g : α → F} {c : ℝ}
-  (hg : mem_ℒp g p μ) (hf : ae_strongly_measurable f μ) (hfg : ∀ᵐ x ∂μ, ∥f x∥ ≤ c * ∥g x∥) :
-  mem_ℒp f p μ :=
-begin
-  simp only [mem_ℒp, hf, true_and],
-  apply lt_of_le_of_lt (snorm_le_mul_snorm_of_ae_le_mul hfg p),
-  simp [lt_top_iff_ne_top, hg.snorm_ne_top],
-end
-
-end monotonicity
-
-lemma snorm_indicator_ge_of_bdd_below (hp : p ≠ 0) (hp' : p ≠ ∞)
-  {f : α → F} (C : ℝ≥0) {s : set α} (hs : measurable_set s)
-  (hf : ∀ᵐ x ∂μ, x ∈ s → C ≤ ∥s.indicator f x∥₊) :
-  C • μ s ^ (1 / p.to_real) ≤ snorm (s.indicator f) p μ :=
-begin
-  rw [ennreal.smul_def, smul_eq_mul, snorm_eq_lintegral_rpow_nnnorm hp hp',
-    ennreal.le_rpow_one_div_iff (ennreal.to_real_pos hp hp'),
-    ennreal.mul_rpow_of_nonneg _ _ ennreal.to_real_nonneg,
-    ← ennreal.rpow_mul, one_div_mul_cancel (ennreal.to_real_pos hp hp').ne.symm, ennreal.rpow_one,
-    ← set_lintegral_const, ← lintegral_indicator _ hs],
-  refine lintegral_mono_ae _,
-  filter_upwards [hf] with x hx,
-  rw nnnorm_indicator_eq_indicator_nnnorm,
-  by_cases hxs : x ∈ s,
-  { simp only [set.indicator_of_mem hxs] at ⊢ hx,
-    exact ennreal.rpow_le_rpow (ennreal.coe_le_coe.2 (hx hxs)) ennreal.to_real_nonneg },
-  { simp [set.indicator_of_not_mem hxs] },
-end
-
-section is_R_or_C
-variables {𝕜 : Type*} [is_R_or_C 𝕜] {f : α → 𝕜}
-
-lemma mem_ℒp.re (hf : mem_ℒp f p μ) : mem_ℒp (λ x, is_R_or_C.re (f x)) p μ :=
-begin
-  have : ∀ x, ∥is_R_or_C.re (f x)∥ ≤ 1 * ∥f x∥,
-    by { intro x, rw one_mul, exact is_R_or_C.norm_re_le_norm (f x), },
-  exact hf.of_le_mul hf.1.re (eventually_of_forall this),
-end
-
-lemma mem_ℒp.im (hf : mem_ℒp f p μ) : mem_ℒp (λ x, is_R_or_C.im (f x)) p μ :=
-begin
-  have : ∀ x, ∥is_R_or_C.im (f x)∥ ≤ 1 * ∥f x∥,
-    by { intro x, rw one_mul, exact is_R_or_C.norm_im_le_norm (f x), },
-  exact hf.of_le_mul hf.1.im (eventually_of_forall this),
-end
-
-end is_R_or_C
-
-section inner_product
-variables {E' 𝕜 : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E']
-
-local notation `⟪`x`, `y`⟫` := @inner 𝕜 E' _ x y
-
-lemma mem_ℒp.const_inner (c : E') {f : α → E'} (hf : mem_ℒp f p μ) :
-  mem_ℒp (λ a, ⟪c, f a⟫) p μ :=
-hf.of_le_mul (ae_strongly_measurable.inner ae_strongly_measurable_const hf.1)
-  (eventually_of_forall (λ x, norm_inner_le_norm _ _))
-
-lemma mem_ℒp.inner_const {f : α → E'} (hf : mem_ℒp f p μ) (c : E') :
-  mem_ℒp (λ a, ⟪f a, c⟫) p μ :=
-hf.of_le_mul (ae_strongly_measurable.inner hf.1 ae_strongly_measurable_const)
-  (eventually_of_forall (λ x, by { rw mul_comm, exact norm_inner_le_norm _ _, }))
-
-end inner_product
-
-end ℒp
-
 /-!
 ### Lp space
 
@@ -1331,17 +77,17 @@ The space of equivalence classes of measurable functions for which `snorm f p μ
 -/
 
 @[simp] lemma snorm_ae_eq_fun {α E : Type*} [measurable_space α] {μ : measure α}
-  [normed_group E] {p : ℝ≥0∞} {f : α → E} (hf : ae_strongly_measurable f μ) :
+  [normed_add_comm_group E] {p : ℝ≥0∞} {f : α → E} (hf : ae_strongly_measurable f μ) :
   snorm (ae_eq_fun.mk f hf) p μ = snorm f p μ :=
 snorm_congr_ae (ae_eq_fun.coe_fn_mk _ _)
 
 lemma mem_ℒp.snorm_mk_lt_top {α E : Type*} [measurable_space α] {μ : measure α}
-  [normed_group E] {p : ℝ≥0∞} {f : α → E} (hfp : mem_ℒp f p μ) :
+  [normed_add_comm_group E] {p : ℝ≥0∞} {f : α → E} (hfp : mem_ℒp f p μ) :
   snorm (ae_eq_fun.mk f hfp.1) p μ < ∞ :=
 by simp [hfp.2]
 
 /-- Lp space -/
-def Lp {α} (E : Type*) {m : measurable_space α} [normed_group E]
+def Lp {α} (E : Type*) {m : measurable_space α} [normed_add_comm_group E]
   (p : ℝ≥0∞) (μ : measure α . volume_tac) : add_subgroup (α →ₘ[μ] E) :=
 { carrier := {f | snorm f p μ < ∞},
   zero_mem' := by simp [snorm_congr_ae ae_eq_fun.coe_fn_zero, snorm_zero],
@@ -1350,8 +96,10 @@ def Lp {α} (E : Type*) {m : measurable_space α} [normed_group E]
   neg_mem' := λ f hf,
     by rwa [set.mem_set_of_eq, snorm_congr_ae (ae_eq_fun.coe_fn_neg _), snorm_neg] }
 
-localized "notation α ` →₁[`:25 μ `] ` E := measure_theory.Lp E 1 μ" in measure_theory
-localized "notation α ` →₂[`:25 μ `] ` E := measure_theory.Lp E 2 μ" in measure_theory
+localized "notation (name := measure_theory.L1)
+  α ` →₁[`:25 μ `] ` E := measure_theory.Lp E 1 μ" in measure_theory
+localized "notation (name := measure_theory.L2)
+  α ` →₂[`:25 μ `] ` E := measure_theory.Lp E 2 μ" in measure_theory
 
 namespace mem_ℒp
 
@@ -1444,16 +192,28 @@ lemma mem_Lp_const (α) {m : measurable_space α} (μ : measure α) (c : E) [is_
 
 instance : has_norm (Lp E p μ) := { norm := λ f, ennreal.to_real (snorm f p μ) }
 
-instance : has_dist (Lp E p μ) := { dist := λ f g, ∥f - g∥}
+-- note: we need this to be defeq to the instance from `seminormed_add_group.to_has_nnnorm`, so
+-- can't use `ennreal.to_nnreal (snorm f p μ)`
+instance : has_nnnorm (Lp E p μ) := { nnnorm := λ f, ⟨‖f‖, ennreal.to_real_nonneg⟩ }
+
+instance : has_dist (Lp E p μ) := { dist := λ f g, ‖f - g‖}
 
 instance : has_edist (Lp E p μ) := { edist := λ f g, snorm (f - g) p μ }
 
-lemma norm_def (f : Lp E p μ) : ∥f∥ = ennreal.to_real (snorm f p μ) := rfl
+lemma norm_def (f : Lp E p μ) : ‖f‖ = ennreal.to_real (snorm f p μ) := rfl
+
+lemma nnnorm_def (f : Lp E p μ) : ‖f‖₊ = ennreal.to_nnreal (snorm f p μ) := subtype.eta _ _
+
+@[simp, norm_cast] protected lemma coe_nnnorm (f : Lp E p μ) : (‖f‖₊ : ℝ) = ‖f‖ := rfl
 
 @[simp] lemma norm_to_Lp (f : α → E) (hf : mem_ℒp f p μ) :
-  ∥hf.to_Lp f∥ = ennreal.to_real (snorm f p μ) :=
+  ‖hf.to_Lp f‖ = ennreal.to_real (snorm f p μ) :=
 by rw [norm_def, snorm_congr_ae (mem_ℒp.coe_fn_to_Lp hf)]
 
+@[simp] lemma nnnorm_to_Lp (f : α → E) (hf : mem_ℒp f p μ) :
+  ‖hf.to_Lp f‖₊ = ennreal.to_nnreal (snorm f p μ) :=
+nnreal.eq $ norm_to_Lp f hf
+
 lemma dist_def (f g : Lp E p μ) : dist f g = (snorm (f - g) p μ).to_real :=
 begin
   simp_rw [dist, norm_def],
@@ -1472,22 +232,29 @@ by { rw edist_def, exact snorm_congr_ae (hf.coe_fn_to_Lp.sub hg.coe_fn_to_Lp) }
   edist (hf.to_Lp f) 0 = snorm f p μ :=
 by { convert edist_to_Lp_to_Lp f 0 hf zero_mem_ℒp, simp }
 
-@[simp] lemma norm_zero : ∥(0 : Lp E p μ)∥ = 0 :=
+@[simp] lemma nnnorm_zero : ‖(0 : Lp E p μ)‖₊ = 0 :=
 begin
-  change (snorm ⇑(0 : α →ₘ[μ] E) p μ).to_real = 0,
+  rw [nnnorm_def],
+  change (snorm ⇑(0 : α →ₘ[μ] E) p μ).to_nnreal = 0,
   simp [snorm_congr_ae ae_eq_fun.coe_fn_zero, snorm_zero]
 end
 
-lemma norm_eq_zero_iff {f : Lp E p μ} (hp : 0 < p) : ∥f∥ = 0 ↔ f = 0 :=
+@[simp] lemma norm_zero : ‖(0 : Lp E p μ)‖ = 0 :=
+congr_arg coe nnnorm_zero
+
+lemma nnnorm_eq_zero_iff {f : Lp E p μ} (hp : 0 < p) : ‖f‖₊ = 0 ↔ f = 0 :=
 begin
   refine ⟨λ hf, _, λ hf, by simp [hf]⟩,
-  rw [norm_def, ennreal.to_real_eq_zero_iff] at hf,
+  rw [nnnorm_def, ennreal.to_nnreal_eq_zero_iff] at hf,
   cases hf,
   { rw snorm_eq_zero_iff (Lp.ae_strongly_measurable f) hp.ne.symm at hf,
     exact subtype.eq (ae_eq_fun.ext (hf.trans ae_eq_fun.coe_fn_zero.symm)), },
   { exact absurd hf (snorm_ne_top f), },
 end
 
+lemma norm_eq_zero_iff {f : Lp E p μ} (hp : 0 < p) : ‖f‖ = 0 ↔ f = 0 :=
+iff.symm $ (nnnorm_eq_zero_iff hp).symm.trans $ (nnreal.coe_eq_zero _).symm
+
 lemma eq_zero_iff_ae_eq_zero {f : Lp E p μ} : f = 0 ↔ f =ᵐ[μ] 0 :=
 begin
   split,
@@ -1501,72 +268,100 @@ begin
     exact h'a.symm, },
 end
 
-@[simp] lemma norm_neg {f : Lp E p μ} : ∥-f∥ = ∥f∥ :=
-by rw [norm_def, norm_def, snorm_congr_ae (coe_fn_neg _), snorm_neg]
+@[simp] lemma nnnorm_neg (f : Lp E p μ) : ‖-f‖₊ = ‖f‖₊ :=
+by rw [nnnorm_def, nnnorm_def, snorm_congr_ae (coe_fn_neg _), snorm_neg]
+
+@[simp] lemma norm_neg (f : Lp E p μ) : ‖-f‖ = ‖f‖ :=
+(congr_arg (coe : ℝ≥0 → ℝ) (nnnorm_neg f) : _)
+
+lemma nnnorm_le_mul_nnnorm_of_ae_le_mul {c : ℝ≥0} {f : Lp E p μ} {g : Lp F p μ}
+  (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ c * ‖g x‖₊ ) : ‖f‖₊ ≤ c * ‖g‖₊  :=
+begin
+  simp only [nnnorm_def],
+  have := snorm_le_nnreal_smul_snorm_of_ae_le_mul h p,
+  rwa [← ennreal.to_nnreal_le_to_nnreal, ennreal.smul_def, smul_eq_mul, ennreal.to_nnreal_mul,
+    ennreal.to_nnreal_coe] at this,
+  { exact (Lp.mem_ℒp _).snorm_ne_top },
+  { exact ennreal.mul_ne_top ennreal.coe_ne_top (Lp.mem_ℒp _).snorm_ne_top },
+end
 
 lemma norm_le_mul_norm_of_ae_le_mul {c : ℝ} {f : Lp E p μ} {g : Lp F p μ}
-  (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ c * ∥g x∥) : ∥f∥ ≤ c * ∥g∥ :=
+  (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ c * ‖g x‖) : ‖f‖ ≤ c * ‖g‖ :=
 begin
-  by_cases pzero : p = 0,
-  { simp [pzero, norm_def] },
   cases le_or_lt 0 c with hc hc,
-  { have := snorm_le_mul_snorm_aux_of_nonneg h hc p,
-    rw [← ennreal.to_real_le_to_real, ennreal.to_real_mul, ennreal.to_real_of_real hc] at this,
-    { exact this },
-    { exact (Lp.mem_ℒp _).snorm_ne_top },
-    { simp [(Lp.mem_ℒp _).snorm_ne_top] } },
-  { have := snorm_le_mul_snorm_aux_of_neg h hc p,
-    simp only [snorm_eq_zero_iff (Lp.ae_strongly_measurable _) pzero, ← eq_zero_iff_ae_eq_zero]
-      at this,
+  { lift c to ℝ≥0 using hc,
+    exact nnreal.coe_le_coe.mpr (nnnorm_le_mul_nnnorm_of_ae_le_mul h) },
+  { simp only [norm_def],
+    have := snorm_eq_zero_and_zero_of_ae_le_mul_neg h hc p,
     simp [this] }
 end
 
-lemma norm_le_norm_of_ae_le {f : Lp E p μ} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ ∥g x∥) :
-  ∥f∥ ≤ ∥g∥ :=
+lemma norm_le_norm_of_ae_le {f : Lp E p μ} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ ‖g x‖) :
+  ‖f‖ ≤ ‖g‖ :=
 begin
   rw [norm_def, norm_def, ennreal.to_real_le_to_real (snorm_ne_top _) (snorm_ne_top _)],
   exact snorm_mono_ae h
 end
 
-lemma mem_Lp_of_ae_le_mul {c : ℝ} {f : α →ₘ[μ] E} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ c * ∥g x∥) :
+lemma mem_Lp_of_nnnorm_ae_le_mul {c : ℝ≥0} {f : α →ₘ[μ] E} {g : Lp F p μ}
+  (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ c * ‖g x‖₊) :
+  f ∈ Lp E p μ :=
+mem_Lp_iff_mem_ℒp.2 $ mem_ℒp.of_nnnorm_le_mul (Lp.mem_ℒp g) f.ae_strongly_measurable h
+
+lemma mem_Lp_of_ae_le_mul {c : ℝ} {f : α →ₘ[μ] E} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ c * ‖g x‖) :
   f ∈ Lp E p μ :=
 mem_Lp_iff_mem_ℒp.2 $ mem_ℒp.of_le_mul (Lp.mem_ℒp g) f.ae_strongly_measurable h
 
-lemma mem_Lp_of_ae_le {f : α →ₘ[μ] E} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ ∥g x∥) :
+lemma mem_Lp_of_nnnorm_ae_le {f : α →ₘ[μ] E} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ ‖g x‖₊) :
   f ∈ Lp E p μ :=
 mem_Lp_iff_mem_ℒp.2 $ mem_ℒp.of_le (Lp.mem_ℒp g) f.ae_strongly_measurable h
 
-lemma mem_Lp_of_ae_bound [is_finite_measure μ] {f : α →ₘ[μ] E} (C : ℝ) (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
+lemma mem_Lp_of_ae_le {f : α →ₘ[μ] E} {g : Lp F p μ} (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ ‖g x‖) :
+  f ∈ Lp E p μ :=
+mem_Lp_of_nnnorm_ae_le h
+
+lemma mem_Lp_of_ae_nnnorm_bound [is_finite_measure μ] {f : α →ₘ[μ] E} (C : ℝ≥0)
+  (hfC : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ C) :
   f ∈ Lp E p μ :=
 mem_Lp_iff_mem_ℒp.2 $ mem_ℒp.of_bound f.ae_strongly_measurable _ hfC
 
-lemma norm_le_of_ae_bound [is_finite_measure μ] {f : Lp E p μ} {C : ℝ} (hC : 0 ≤ C)
-  (hfC : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  ∥f∥ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * C :=
+lemma mem_Lp_of_ae_bound [is_finite_measure μ] {f : α →ₘ[μ] E} (C : ℝ) (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  f ∈ Lp E p μ :=
+mem_Lp_iff_mem_ℒp.2 $ mem_ℒp.of_bound f.ae_strongly_measurable _ hfC
+
+lemma nnnorm_le_of_ae_bound [is_finite_measure μ] {f : Lp E p μ} {C : ℝ≥0}
+  (hfC : ∀ᵐ x ∂μ, ‖f x‖₊ ≤ C) :
+  ‖f‖₊ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * C :=
 begin
   by_cases hμ : μ = 0,
   { by_cases hp : p.to_real⁻¹ = 0,
-    { simpa [hp, hμ, norm_def] using hC },
-    { simp [hμ, norm_def, real.zero_rpow hp] } },
-  let A : ℝ≥0 := (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * ⟨C, hC⟩,
-  suffices : snorm f p μ ≤ A,
-  { exact ennreal.to_real_le_coe_of_le_coe this },
-  convert snorm_le_of_ae_bound hfC,
+    { simp [hp, hμ, nnnorm_def] },
+    { simp [hμ, nnnorm_def, real.zero_rpow hp] } },
+  rw [←ennreal.coe_le_coe, nnnorm_def, ennreal.coe_to_nnreal (snorm_ne_top _)],
+  refine (snorm_le_of_ae_nnnorm_bound hfC).trans_eq _,
   rw [← coe_measure_univ_nnreal μ, ennreal.coe_rpow_of_ne_zero (measure_univ_nnreal_pos hμ).ne',
-    ennreal.coe_mul],
-  congr,
-  rw max_eq_left hC
+    ennreal.coe_mul, mul_comm, ennreal.smul_def, smul_eq_mul],
 end
 
-instance [hp : fact (1 ≤ p)] : normed_group (Lp E p μ) :=
+lemma norm_le_of_ae_bound [is_finite_measure μ] {f : Lp E p μ} {C : ℝ} (hC : 0 ≤ C)
+  (hfC : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  ‖f‖ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * C :=
+begin
+  lift C to ℝ≥0 using hC,
+  have := nnnorm_le_of_ae_bound hfC,
+  rwa [←nnreal.coe_le_coe, nnreal.coe_mul, nnreal.coe_rpow] at this,
+end
+
+instance [hp : fact (1 ≤ p)] : normed_add_comm_group (Lp E p μ) :=
 { edist := edist,
   edist_dist := λ f g, by
     rw [edist_def, dist_def, ←snorm_congr_ae (coe_fn_sub _ _),
       ennreal.of_real_to_real (snorm_ne_top (f - g))],
-  .. normed_group.of_core (Lp E p μ)
-    { norm_eq_zero_iff := λ f, norm_eq_zero_iff (ennreal.zero_lt_one.trans_le hp.1),
-      triangle := begin
-        assume f g,
+  ..add_group_norm.to_normed_add_comm_group
+    { to_fun := (norm : Lp E p μ → ℝ),
+      map_zero' := norm_zero,
+      neg' := by simp,
+      add_le' := λ f g, begin
         simp only [norm_def],
         rw ← ennreal.to_real_add (snorm_ne_top f) (snorm_ne_top g),
         suffices h_snorm : snorm ⇑(f + g) p μ ≤ snorm ⇑f p μ + snorm ⇑g p μ,
@@ -1575,21 +370,28 @@ instance [hp : fact (1 ≤ p)] : normed_group (Lp E p μ) :=
         rw [snorm_congr_ae (coe_fn_add _ _)],
         exact snorm_add_le (Lp.ae_strongly_measurable f) (Lp.ae_strongly_measurable g) hp.1,
       end,
-      norm_neg := by simp } }
+      eq_zero_of_map_eq_zero' := λ f, (norm_eq_zero_iff $ zero_lt_one.trans_le hp.1).1 } }
 
 -- check no diamond is created
 example [fact (1 ≤ p)] :
   pseudo_emetric_space.to_has_edist = (Lp.has_edist : has_edist (Lp E p μ)) :=
 rfl
 
-section normed_space
+example [fact (1 ≤ p)] :
+  seminormed_add_group.to_has_nnnorm = (Lp.has_nnnorm : has_nnnorm (Lp E p μ)) :=
+rfl
 
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]
+section has_bounded_smul
+
+variables {𝕜 𝕜' : Type*}
+variables [normed_ring 𝕜] [normed_ring 𝕜'] [module 𝕜 E] [module 𝕜' E]
+variables [has_bounded_smul 𝕜 E] [has_bounded_smul 𝕜' E]
 
 lemma mem_Lp_const_smul (c : 𝕜) (f : Lp E p μ) : c • ↑f ∈ Lp E p μ :=
 begin
-  rw [mem_Lp_iff_snorm_lt_top, snorm_congr_ae (ae_eq_fun.coe_fn_smul _ _), snorm_const_smul,
-    ennreal.mul_lt_top_iff],
+  rw [mem_Lp_iff_snorm_lt_top, snorm_congr_ae (ae_eq_fun.coe_fn_smul _ _)],
+  refine (snorm_const_smul_le _ _).trans_lt _,
+  rw [ennreal.smul_def, smul_eq_mul, ennreal.mul_lt_top_iff],
   exact or.inl ⟨ennreal.coe_lt_top, f.prop⟩,
 end
 
@@ -1610,20 +412,40 @@ instance : module 𝕜 (Lp E p μ) :=
 
 lemma coe_fn_smul (c : 𝕜) (f : Lp E p μ) : ⇑(c • f) =ᵐ[μ] c • f := ae_eq_fun.coe_fn_smul _ _
 
-lemma norm_const_smul (c : 𝕜) (f : Lp E p μ) : ∥c • f∥ = ∥c∥ * ∥f∥ :=
-by rw [norm_def, snorm_congr_ae (coe_fn_smul _ _), snorm_const_smul c,
-  ennreal.to_real_mul, ennreal.coe_to_real, coe_nnnorm, norm_def]
+instance [module 𝕜ᵐᵒᵖ E] [has_bounded_smul 𝕜ᵐᵒᵖ E] [is_central_scalar 𝕜 E] :
+  is_central_scalar 𝕜 (Lp E p μ) :=
+{ op_smul_eq_smul := λ k f, subtype.ext $ op_smul_eq_smul k (f : α →ₘ[μ] E) }
+
+instance [smul_comm_class 𝕜 𝕜' E] : smul_comm_class 𝕜 𝕜' (Lp E p μ) :=
+{ smul_comm := λ k k' f, subtype.ext $ smul_comm k k' (f : α →ₘ[μ] E) }
+
+instance [has_smul 𝕜 𝕜'] [is_scalar_tower 𝕜 𝕜' E] : is_scalar_tower 𝕜 𝕜' (Lp E p μ) :=
+{ smul_assoc := λ k k' f, subtype.ext $ smul_assoc k k' (f : α →ₘ[μ] E) }
+
+instance [fact (1 ≤ p)] : has_bounded_smul 𝕜 (Lp E p μ) :=
+-- TODO: add `has_bounded_smul.of_nnnorm_smul_le
+has_bounded_smul.of_norm_smul_le $ λ r f, begin
+  suffices : (‖r • f‖₊ : ℝ≥0∞) ≤ ‖r‖₊ * ‖f‖₊,
+  { exact_mod_cast this },
+  rw [nnnorm_def, nnnorm_def, ennreal.coe_to_nnreal (Lp.snorm_ne_top _),
+    snorm_congr_ae (coe_fn_smul _ _), ennreal.coe_to_nnreal (Lp.snorm_ne_top _)],
+  exact snorm_const_smul_le r f,
+end
+
+end has_bounded_smul
+
+section normed_space
+variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]
 
 instance [fact (1 ≤ p)] : normed_space 𝕜 (Lp E p μ) :=
-{ norm_smul_le := λ _ _, by simp [norm_const_smul] }
+{ norm_smul_le := λ _ _, norm_smul_le _ _ }
 
 end normed_space
 
 end Lp
 
 namespace mem_ℒp
-
-variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]
+variables {𝕜 : Type*} [normed_ring 𝕜] [module 𝕜 E] [has_bounded_smul 𝕜 E]
 
 lemma to_Lp_const_smul {f : α → E} (c : 𝕜) (hf : mem_ℒp f p μ) :
   (hf.const_smul c).to_Lp (c • f) = c • hf.to_Lp f := rfl
@@ -1649,16 +471,16 @@ begin
 end
 
 lemma snorm_ess_sup_indicator_const_le (s : set α) (c : G) :
-  snorm_ess_sup (s.indicator (λ x : α , c)) μ ≤ ∥c∥₊ :=
+  snorm_ess_sup (s.indicator (λ x : α , c)) μ ≤ ‖c‖₊ :=
 begin
   by_cases hμ0 : μ = 0,
-  { rw [hμ0, snorm_ess_sup_measure_zero, ennreal.coe_nonneg],
-    exact zero_le', },
+  { rw [hμ0, snorm_ess_sup_measure_zero],
+    exact zero_le _ },
   { exact (snorm_ess_sup_indicator_le s (λ x, c)).trans (snorm_ess_sup_const c hμ0).le, },
 end
 
 lemma snorm_ess_sup_indicator_const_eq (s : set α) (c : G) (hμs : μ s ≠ 0) :
-  snorm_ess_sup (s.indicator (λ x : α , c)) μ = ∥c∥₊ :=
+  snorm_ess_sup (s.indicator (λ x : α , c)) μ = ‖c‖₊ :=
 begin
   refine le_antisymm (snorm_ess_sup_indicator_const_le s c) _,
   by_contra' h,
@@ -1671,11 +493,11 @@ end
 
 variables (hs)
 
-lemma snorm_indicator_le {E : Type*} [normed_group E] (f : α → E) :
+lemma snorm_indicator_le {E : Type*} [normed_add_comm_group E] (f : α → E) :
   snorm (s.indicator f) p μ ≤ snorm f p μ :=
 begin
   refine snorm_mono_ae (eventually_of_forall (λ x, _)),
-  suffices : ∥s.indicator f x∥₊ ≤ ∥f x∥₊,
+  suffices : ‖s.indicator f x‖₊ ≤ ‖f x‖₊,
   { exact nnreal.coe_mono this },
   rw nnnorm_indicator_eq_indicator_nnnorm,
   exact s.indicator_le_self _ x,
@@ -1684,14 +506,14 @@ end
 variables {hs}
 
 lemma snorm_indicator_const {c : G} (hs : measurable_set s) (hp : p ≠ 0) (hp_top : p ≠ ∞) :
-  snorm (s.indicator (λ x, c)) p μ = ∥c∥₊ * (μ s) ^ (1 / p.to_real) :=
+  snorm (s.indicator (λ x, c)) p μ = ‖c‖₊ * (μ s) ^ (1 / p.to_real) :=
 begin
   have hp_pos : 0 < p.to_real, from ennreal.to_real_pos hp hp_top,
   rw snorm_eq_lintegral_rpow_nnnorm hp hp_top,
   simp_rw [nnnorm_indicator_eq_indicator_nnnorm, ennreal.coe_indicator],
-  have h_indicator_pow : (λ a : α, s.indicator (λ (x : α), (∥c∥₊ : ℝ≥0∞)) a ^ p.to_real)
-    = s.indicator (λ (x : α), ↑∥c∥₊ ^ p.to_real),
-  { rw set.comp_indicator_const (∥c∥₊ : ℝ≥0∞) (λ x, x ^ p.to_real) _,
+  have h_indicator_pow : (λ a : α, s.indicator (λ (x : α), (‖c‖₊ : ℝ≥0∞)) a ^ p.to_real)
+    = s.indicator (λ (x : α), ↑‖c‖₊ ^ p.to_real),
+  { rw set.comp_indicator_const (‖c‖₊ : ℝ≥0∞) (λ x, x ^ p.to_real) _,
     simp [hp_pos], },
   rw [h_indicator_pow, lintegral_indicator _ hs, set_lintegral_const, ennreal.mul_rpow_of_nonneg],
   { rw [← ennreal.rpow_mul, mul_one_div_cancel hp_pos.ne.symm, ennreal.rpow_one], },
@@ -1699,13 +521,30 @@ begin
 end
 
 lemma snorm_indicator_const' {c : G} (hs : measurable_set s) (hμs : μ s ≠ 0) (hp : p ≠ 0) :
-  snorm (s.indicator (λ _, c)) p μ = ∥c∥₊ * (μ s) ^ (1 / p.to_real) :=
+  snorm (s.indicator (λ _, c)) p μ = ‖c‖₊ * (μ s) ^ (1 / p.to_real) :=
 begin
   by_cases hp_top : p = ∞,
   { simp [hp_top, snorm_ess_sup_indicator_const_eq s c hμs], },
   { exact snorm_indicator_const hs hp hp_top, },
 end
 
+lemma snorm_indicator_const_le (c : G) (p : ℝ≥0∞) :
+  snorm (s.indicator (λ x, c)) p μ ≤ ‖c‖₊ * (μ s) ^ (1 / p.to_real) :=
+begin
+  rcases eq_or_ne p 0 with rfl|hp,
+  { simp only [snorm_exponent_zero, zero_le'] },
+  rcases eq_or_ne p ∞ with rfl|h'p,
+  { simp only [snorm_exponent_top, ennreal.top_to_real, div_zero, ennreal.rpow_zero, mul_one],
+    exact snorm_ess_sup_indicator_const_le _ _ },
+  let t := to_measurable μ s,
+  calc snorm (s.indicator (λ x, c)) p μ
+      ≤ snorm (t.indicator (λ x, c)) p μ :
+    snorm_mono (norm_indicator_le_of_subset (subset_to_measurable _ _) _)
+  ... = ‖c‖₊ * (μ t) ^ (1 / p.to_real) :
+    snorm_indicator_const (measurable_set_to_measurable _ _) hp h'p
+  ... = ‖c‖₊ * (μ s) ^ (1 / p.to_real) : by rw measure_to_measurable
+end
+
 lemma mem_ℒp.indicator (hs : measurable_set s) (hf : mem_ℒp f p μ) :
   mem_ℒp (s.indicator f) p μ :=
 ⟨hf.ae_strongly_measurable.indicator hs, lt_of_le_of_lt (snorm_indicator_le f) hf.snorm_lt_top⟩
@@ -1735,7 +574,7 @@ begin
   { simp_rw [hp_top, snorm_exponent_top],
     exact snorm_ess_sup_indicator_eq_snorm_ess_sup_restrict hs, },
   simp_rw snorm_eq_lintegral_rpow_nnnorm hp_zero hp_top,
-  suffices : ∫⁻ x, ∥s.indicator f x∥₊ ^ p.to_real ∂μ = ∫⁻ x in s, ∥f x∥₊ ^ p.to_real ∂μ,
+  suffices : ∫⁻ x, ‖s.indicator f x‖₊ ^ p.to_real ∂μ = ∫⁻ x in s, ‖f x‖₊ ^ p.to_real ∂μ,
     by rw this,
   rw ← lintegral_indicator _ hs,
   congr,
@@ -1757,7 +596,7 @@ begin
   { rw hp_zero, exact mem_ℒp_zero_iff_ae_strongly_measurable.mpr ae_strongly_measurable_const, },
   by_cases hp_top : p = ∞,
   { rw hp_top,
-    exact mem_ℒp_top_of_bound ae_strongly_measurable_const (∥c∥)
+    exact mem_ℒp_top_of_bound ae_strongly_measurable_const (‖c‖)
       (eventually_of_forall (λ x, le_rfl)), },
   rw [mem_ℒp_const_iff hp_zero hp_top, measure.restrict_apply_univ],
   cases hμsc,
@@ -1765,6 +604,36 @@ begin
   { exact or.inr hμsc.lt_top, },
 end
 
+/-- The `ℒ^p` norm of the indicator of a set is uniformly small if the set itself has small measure,
+for any `p < ∞`. Given here as an existential `∀ ε > 0, ∃ η > 0, ...` to avoid later
+management of `ℝ≥0∞`-arithmetic. -/
+lemma exists_snorm_indicator_le (hp : p ≠ ∞) (c : E) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (η : ℝ≥0), 0 < η ∧ ∀ (s : set α), μ s ≤ η → snorm (s.indicator (λ x, c)) p μ ≤ ε :=
+begin
+  rcases eq_or_ne p 0 with rfl|h'p,
+  { exact ⟨1, zero_lt_one, λ s hs, by simp⟩ },
+  have hp₀ : 0 < p := bot_lt_iff_ne_bot.2 h'p,
+  have hp₀' : 0 ≤ 1 / p.to_real := div_nonneg zero_le_one ennreal.to_real_nonneg,
+  have hp₀'' : 0 < p.to_real,
+  { simpa [← ennreal.to_real_lt_to_real ennreal.zero_ne_top hp] using hp₀ },
+  obtain ⟨η, hη_pos, hη_le⟩ : ∃ (η : ℝ≥0), 0 < η ∧ (‖c‖₊ * η ^ (1 / p.to_real) : ℝ≥0∞) ≤ ε,
+  { have : filter.tendsto (λ x : ℝ≥0, ((‖c‖₊ * x ^ (1 / p.to_real) : ℝ≥0) : ℝ≥0∞))
+      (𝓝 0) (𝓝 (0 : ℝ≥0)),
+    { rw ennreal.tendsto_coe,
+      convert ((nnreal.continuous_at_rpow_const (or.inr hp₀')).tendsto).const_mul _,
+      simp [hp₀''.ne'] },
+    have hε' : 0 < ε := hε.bot_lt,
+    obtain ⟨δ, hδ, hδε'⟩ :=
+      nnreal.nhds_zero_basis.eventually_iff.mp (eventually_le_of_tendsto_lt hε' this),
+    obtain ⟨η, hη, hηδ⟩ := exists_between hδ,
+    refine ⟨η, hη, _⟩,
+    rw [ennreal.coe_rpow_of_nonneg _ hp₀', ← ennreal.coe_mul],
+    exact hδε' hηδ },
+  refine ⟨η, hη_pos, λ s hs, _⟩,
+  refine (snorm_indicator_const_le _ _).trans (le_trans _ hη_le),
+  exact mul_le_mul_left' (ennreal.rpow_le_rpow hs hp₀') _,
+end
+
 end indicator
 
 section indicator_const_Lp
@@ -1789,18 +658,18 @@ lemma indicator_const_Lp_coe_fn_nmem :
 indicator_const_Lp_coe_fn.mono (λ x hx hxs, hx.trans (set.indicator_of_not_mem hxs _))
 
 lemma norm_indicator_const_Lp (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  ∥indicator_const_Lp p hs hμs c∥ = ∥c∥ * (μ s).to_real ^ (1 / p.to_real) :=
+  ‖indicator_const_Lp p hs hμs c‖ = ‖c‖ * (μ s).to_real ^ (1 / p.to_real) :=
 by rw [Lp.norm_def, snorm_congr_ae indicator_const_Lp_coe_fn,
     snorm_indicator_const hs hp_ne_zero hp_ne_top, ennreal.to_real_mul, ennreal.to_real_rpow,
     ennreal.coe_to_real, coe_nnnorm]
 
-lemma norm_indicator_const_Lp_top (hμs_ne_zero : μ s ≠ 0) : ∥indicator_const_Lp ∞ hs hμs c∥ = ∥c∥ :=
+lemma norm_indicator_const_Lp_top (hμs_ne_zero : μ s ≠ 0) : ‖indicator_const_Lp ∞ hs hμs c‖ = ‖c‖ :=
 by rw [Lp.norm_def, snorm_congr_ae indicator_const_Lp_coe_fn,
     snorm_indicator_const' hs hμs_ne_zero ennreal.top_ne_zero, ennreal.top_to_real, div_zero,
     ennreal.rpow_zero, mul_one, ennreal.coe_to_real, coe_nnnorm]
 
 lemma norm_indicator_const_Lp' (hp_pos : p ≠ 0) (hμs_pos : μ s ≠ 0) :
-  ∥indicator_const_Lp p hs hμs c∥ = ∥c∥ * (μ s).to_real ^ (1 / p.to_real) :=
+  ‖indicator_const_Lp p hs hμs c‖ = ‖c‖ * (μ s).to_real ^ (1 / p.to_real) :=
 begin
   by_cases hp_top : p = ∞,
   { rw [hp_top, ennreal.top_to_real, div_zero, real.rpow_zero, mul_one],
@@ -1844,7 +713,7 @@ end indicator_const_Lp
 
 lemma mem_ℒp.norm_rpow_div {f : α → E}
   (hf : mem_ℒp f p μ) (q : ℝ≥0∞) :
-  mem_ℒp (λ (x : α), ∥f x∥ ^ q.to_real) (p/q) μ :=
+  mem_ℒp (λ (x : α), ‖f x‖ ^ q.to_real) (p/q) μ :=
 begin
   refine ⟨(hf.1.norm.ae_measurable.pow_const q.to_real).ae_strongly_measurable, _⟩,
   by_cases q_top : q = ∞, { simp [q_top] },
@@ -1862,7 +731,7 @@ end
 
 lemma mem_ℒp_norm_rpow_iff {q : ℝ≥0∞} {f : α → E} (hf : ae_strongly_measurable f μ)
   (q_zero : q ≠ 0) (q_top : q ≠ ∞) :
-  mem_ℒp (λ (x : α), ∥f x∥ ^ q.to_real) (p/q) μ ↔ mem_ℒp f p μ :=
+  mem_ℒp (λ (x : α), ‖f x‖ ^ q.to_real) (p/q) μ ↔ mem_ℒp f p μ :=
 begin
   refine ⟨λ h, _, λ h, h.norm_rpow_div q⟩,
   apply (mem_ℒp_norm_iff hf).1,
@@ -1877,7 +746,7 @@ end
 
 lemma mem_ℒp.norm_rpow {f : α → E}
   (hf : mem_ℒp f p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  mem_ℒp (λ (x : α), ∥f x∥ ^ p.to_real) 1 μ :=
+  mem_ℒp (λ (x : α), ‖f x‖ ^ p.to_real) 1 μ :=
 begin
   convert hf.norm_rpow_div p,
   rw [div_eq_mul_inv, ennreal.mul_inv_cancel hp_ne_zero hp_ne_top],
@@ -1900,34 +769,35 @@ section composition
 variables {g : E → F} {c : ℝ≥0}
 
 lemma lipschitz_with.comp_mem_ℒp {α E F} {K} [measurable_space α] {μ : measure α}
-  [normed_group E] [normed_group F] {f : α → E} {g : E → F} (hg : lipschitz_with K g)
-  (g0 : g 0 = 0) (hL : mem_ℒp f p μ) : mem_ℒp (g ∘ f) p μ  :=
+  [normed_add_comm_group E] [normed_add_comm_group F] {f : α → E} {g : E → F}
+  (hg : lipschitz_with K g) (g0 : g 0 = 0) (hL : mem_ℒp f p μ) : mem_ℒp (g ∘ f) p μ  :=
 begin
-  have : ∀ᵐ x ∂μ, ∥g (f x)∥ ≤ K * ∥f x∥,
-  { apply filter.eventually_of_forall (λ x, _),
-    rw [← dist_zero_right, ← dist_zero_right, ← g0],
-    apply hg.dist_le_mul },
-  exact hL.of_le_mul (hg.continuous.comp_ae_strongly_measurable hL.1) this,
+  have : ∀ x, ‖g (f x)‖ ≤ K * ‖f x‖,
+  { intro a,
+    -- TODO: add `lipschitz_with.nnnorm_sub_le` and `lipschitz_with.nnnorm_le`
+    simpa [g0] using hg.norm_sub_le (f a) 0, },
+  exact hL.of_le_mul (hg.continuous.comp_ae_strongly_measurable hL.1) (eventually_of_forall this),
 end
 
 lemma measure_theory.mem_ℒp.of_comp_antilipschitz_with {α E F} {K'}
-  [measurable_space α] {μ : measure α} [normed_group E] [normed_group F]
+  [measurable_space α] {μ : measure α} [normed_add_comm_group E] [normed_add_comm_group F]
   {f : α → E} {g : E → F} (hL : mem_ℒp (g ∘ f) p μ)
   (hg : uniform_continuous g) (hg' : antilipschitz_with K' g) (g0 : g 0 = 0) : mem_ℒp f p μ :=
 begin
-  have A : ∀ᵐ x ∂μ, ∥f x∥ ≤ K' * ∥g (f x)∥,
-  { apply filter.eventually_of_forall (λ x, _),
+  have A : ∀ x, ‖f x‖ ≤ K' * ‖g (f x)‖,
+  { intro x,
+    -- TODO: add `antilipschitz_with.le_mul_nnnorm_sub` and `antilipschitz_with.le_mul_norm`
     rw [← dist_zero_right, ← dist_zero_right, ← g0],
     apply hg'.le_mul_dist },
   have B : ae_strongly_measurable f μ :=
     ((hg'.uniform_embedding hg).embedding.ae_strongly_measurable_comp_iff.1 hL.1),
-  exact hL.of_le_mul B A,
+  exact hL.of_le_mul B (filter.eventually_of_forall A),
 end
 
 namespace lipschitz_with
 
 lemma mem_ℒp_comp_iff_of_antilipschitz {α E F} {K K'} [measurable_space α] {μ : measure α}
-  [normed_group E] [normed_group F]
+  [normed_add_comm_group E] [normed_add_comm_group F]
   {f : α → E} {g : E → F} (hg : lipschitz_with K g) (hg' : antilipschitz_with K' g) (g0 : g 0 = 0) :
   mem_ℒp (g ∘ f) p μ ↔ mem_ℒp f p μ :=
 ⟨λ h, h.of_comp_antilipschitz_with hg.uniform_continuous hg' g0, λ h, hg.comp_mem_ℒp g0 h⟩
@@ -1937,7 +807,7 @@ defined as an element of `Lp`. -/
 def comp_Lp (hg : lipschitz_with c g) (g0 : g 0 = 0) (f : Lp E p μ) : Lp F p μ :=
 ⟨ae_eq_fun.comp g hg.continuous (f : α →ₘ[μ] E),
 begin
-  suffices : ∀ᵐ x ∂μ, ∥ae_eq_fun.comp g hg.continuous (f : α →ₘ[μ] E) x∥ ≤ c * ∥f x∥,
+  suffices : ∀ᵐ x ∂μ, ‖ae_eq_fun.comp g hg.continuous (f : α →ₘ[μ] E) x‖ ≤ c * ‖f x‖,
   { exact Lp.mem_Lp_of_ae_le_mul this },
   filter_upwards [ae_eq_fun.coe_fn_comp g hg.continuous (f : α →ₘ[μ] E)] with a ha,
   simp only [ha],
@@ -1959,7 +829,7 @@ begin
 end
 
 lemma norm_comp_Lp_sub_le (hg : lipschitz_with c g) (g0 : g 0 = 0) (f f' : Lp E p μ) :
-  ∥hg.comp_Lp g0 f - hg.comp_Lp g0 f'∥ ≤ c * ∥f - f'∥ :=
+  ‖hg.comp_Lp g0 f - hg.comp_Lp g0 f'‖ ≤ c * ‖f - f'‖ :=
 begin
   apply Lp.norm_le_mul_norm_of_ae_le_mul,
   filter_upwards [hg.coe_fn_comp_Lp g0 f, hg.coe_fn_comp_Lp g0 f',
@@ -1969,7 +839,7 @@ begin
 end
 
 lemma norm_comp_Lp_le (hg : lipschitz_with c g) (g0 : g 0 = 0) (f : Lp E p μ) :
-  ∥hg.comp_Lp g0 f∥ ≤ c * ∥f∥ :=
+  ‖hg.comp_Lp g0 f‖ ≤ c * ‖f‖ :=
 by simpa using hg.norm_comp_Lp_sub_le g0 f 0
 
 lemma lipschitz_with_comp_Lp [fact (1 ≤ p)] (hg : lipschitz_with c g) (g0 : g 0 = 0) :
@@ -1983,7 +853,7 @@ lemma continuous_comp_Lp [fact (1 ≤ p)] (hg : lipschitz_with c g) (g0 : g 0 =
 end lipschitz_with
 
 namespace continuous_linear_map
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E] [normed_space 𝕜 F]
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E] [normed_space 𝕜 F]
 
 /-- Composing `f : Lp ` with `L : E →L[𝕜] F`. -/
 def comp_Lp (L : E →L[𝕜] F) (f : Lp E p μ) : Lp F p μ :=
@@ -2037,7 +907,8 @@ begin
   refl,
 end
 
-lemma smul_comp_Lp {𝕜'} [normed_field 𝕜'] [normed_space 𝕜' F] [smul_comm_class 𝕜 𝕜' F]
+lemma smul_comp_Lp {𝕜'} [normed_ring 𝕜'] [module 𝕜' F] [has_bounded_smul 𝕜' F]
+  [smul_comm_class 𝕜 𝕜' F]
   (c : 𝕜') (L : E →L[𝕜] F) (f : Lp E p μ) :
   (c • L).comp_Lp f = c • L.comp_Lp f :=
 begin
@@ -2049,7 +920,7 @@ begin
   refl,
 end
 
-lemma norm_comp_Lp_le (L : E →L[𝕜] F) (f : Lp E p μ)  : ∥L.comp_Lp f∥ ≤ ∥L∥ * ∥f∥ :=
+lemma norm_comp_Lp_le (L : E →L[𝕜] F) (f : Lp E p μ)  : ‖L.comp_Lp f‖ ≤ ‖L‖ * ‖f‖ :=
 lipschitz_with.norm_comp_Lp_le _ _ _
 
 variables (μ p)
@@ -2071,7 +942,7 @@ def comp_Lpₗ (L : E →L[𝕜] F) : (Lp E p μ) →ₗ[𝕜] (Lp F p μ) :=
     ext1,
     filter_upwards [Lp.coe_fn_smul c f, coe_fn_comp_Lp L (c • f), Lp.coe_fn_smul c (L.comp_Lp f),
       coe_fn_comp_Lp L f] with _ ha1 ha2 ha3 ha4,
-    simp only [ha1, ha2, ha3, ha4, map_smul, pi.smul_apply],
+    simp only [ha1, ha2, ha3, ha4, smul_hom_class.map_smul, pi.smul_apply],
   end }
 
 /-- Composing `f : Lp E p μ` with `L : E →L[𝕜] F`, seen as a continuous `𝕜`-linear map on
@@ -2082,7 +953,7 @@ def comp_Lpₗ (L : E →L[𝕜] F) : (Lp E p μ) →ₗ[𝕜] (Lp F p μ) :=
 * `continuous_linear_map.comp_left_continuous_compact` for continuous functions on compact spaces.
 -/
 def comp_LpL [fact (1 ≤ p)] (L : E →L[𝕜] F) : (Lp E p μ) →L[𝕜] (Lp F p μ) :=
-linear_map.mk_continuous (L.comp_Lpₗ p μ) ∥L∥ L.norm_comp_Lp_le
+linear_map.mk_continuous (L.comp_Lpₗ p μ) ‖L‖ L.norm_comp_Lp_le
 
 variables {μ p}
 
@@ -2094,18 +965,13 @@ lemma add_comp_LpL [fact (1 ≤ p)] (L L' : E →L[𝕜] F) :
   (L + L').comp_LpL p μ = L.comp_LpL p μ + L'.comp_LpL p μ :=
 by { ext1 f, exact add_comp_Lp L L' f }
 
-lemma smul_comp_LpL [fact (1 ≤ p)] (c : 𝕜) (L : E →L[𝕜] F) :
-  (c • L).comp_LpL p μ  = c • (L.comp_LpL p μ) :=
+lemma smul_comp_LpL [fact (1 ≤ p)] {𝕜'} [normed_ring 𝕜'] [module 𝕜' F]
+  [has_bounded_smul 𝕜' F] [smul_comm_class 𝕜 𝕜' F] (c : 𝕜') (L : E →L[𝕜] F) :
+  (c • L).comp_LpL p μ = c • L.comp_LpL p μ :=
 by { ext1 f, exact smul_comp_Lp c L f }
 
-/-- TODO: written in an "apply" way because of a missing `has_scalar` instance. -/
-lemma smul_comp_LpL_apply [fact (1 ≤ p)] {𝕜'} [normed_field 𝕜'] [normed_space 𝕜' F]
-  [smul_comm_class 𝕜 𝕜' F] (c : 𝕜') (L : E →L[𝕜] F) (f : Lp E p μ) :
-  (c • L).comp_LpL p μ f = c • (L.comp_LpL p μ f) :=
-smul_comp_Lp c L f
-
 lemma norm_compLpL_le [fact (1 ≤ p)] (L : E →L[𝕜] F) :
-  ∥L.comp_LpL p μ∥ ≤ ∥L∥ :=
+  ‖L.comp_LpL p μ‖ ≤ ‖L‖ :=
 linear_map.mk_continuous_norm_le _ (norm_nonneg _) _
 
 end continuous_linear_map
@@ -2134,7 +1000,7 @@ namespace Lp
 section pos_part
 
 lemma lipschitz_with_pos_part : lipschitz_with 1 (λ (x : ℝ), max x 0) :=
-lipschitz_with.of_dist_le_mul $ λ x y, by simp [dist, abs_max_sub_max_le_abs]
+lipschitz_with.of_dist_le_mul $ λ x y, by simp [real.dist_eq, abs_max_sub_max_le_abs]
 
 lemma _root_.measure_theory.mem_ℒp.pos_part {f : α → ℝ} (hf : mem_ℒp f p μ) :
   mem_ℒp (λ x, max (f x) 0) p μ :=
@@ -2197,20 +1063,20 @@ namespace Lp
 lemma snorm'_lim_eq_lintegral_liminf {ι} [nonempty ι] [linear_order ι] {f : ι → α → G} {p : ℝ}
   (hp_nonneg : 0 ≤ p) {f_lim : α → G}
   (h_lim : ∀ᵐ (x : α) ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x))) :
-  snorm' f_lim p μ = (∫⁻ a, at_top.liminf (λ m, (∥f m a∥₊ : ℝ≥0∞)^p) ∂μ) ^ (1/p) :=
+  snorm' f_lim p μ = (∫⁻ a, at_top.liminf (λ m, (‖f m a‖₊ : ℝ≥0∞)^p) ∂μ) ^ (1/p) :=
 begin
-  suffices h_no_pow : (∫⁻ a, ∥f_lim a∥₊ ^ p ∂μ)
-    = (∫⁻ a, at_top.liminf (λ m, (∥f m a∥₊ : ℝ≥0∞)^p) ∂μ),
+  suffices h_no_pow : (∫⁻ a, ‖f_lim a‖₊ ^ p ∂μ)
+    = (∫⁻ a, at_top.liminf (λ m, (‖f m a‖₊ : ℝ≥0∞)^p) ∂μ),
   { rw [snorm', h_no_pow], },
   refine lintegral_congr_ae (h_lim.mono (λ a ha, _)),
   rw tendsto.liminf_eq,
   simp_rw [ennreal.coe_rpow_of_nonneg _ hp_nonneg, ennreal.tendsto_coe],
-  refine ((nnreal.continuous_rpow_const hp_nonneg).tendsto (∥f_lim a∥₊)).comp _,
+  refine ((nnreal.continuous_rpow_const hp_nonneg).tendsto (‖f_lim a‖₊)).comp _,
   exact (continuous_nnnorm.tendsto (f_lim a)).comp ha,
 end
 
-lemma snorm'_lim_le_liminf_snorm' {E} [normed_group E] {f : ℕ → α → E} {p : ℝ} (hp_pos : 0 < p)
-  (hf : ∀ n, ae_strongly_measurable (f n) μ) {f_lim : α → E}
+lemma snorm'_lim_le_liminf_snorm' {E} [normed_add_comm_group E] {f : ℕ → α → E} {p : ℝ}
+  (hp_pos : 0 < p) (hf : ∀ n, ae_strongly_measurable (f n) μ) {f_lim : α → E}
   (h_lim : ∀ᵐ (x : α) ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x)))  :
   snorm' f_lim p μ ≤ at_top.liminf (λ n, snorm' (f n) p μ) :=
 begin
@@ -2230,7 +1096,7 @@ end
 lemma snorm_exponent_top_lim_eq_ess_sup_liminf {ι} [nonempty ι] [linear_order ι] {f : ι → α → G}
   {f_lim : α → G}
   (h_lim : ∀ᵐ (x : α) ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x))) :
-  snorm f_lim ∞ μ = ess_sup (λ x, at_top.liminf (λ m, (∥f m x∥₊ : ℝ≥0∞))) μ :=
+  snorm f_lim ∞ μ = ess_sup (λ x, at_top.liminf (λ m, (‖f m x‖₊ : ℝ≥0∞))) μ :=
 begin
   rw [snorm_exponent_top, snorm_ess_sup],
   refine ess_sup_congr_ae (h_lim.mono (λ x hx, _)),
@@ -2239,17 +1105,17 @@ begin
   exact (continuous_nnnorm.tendsto (f_lim x)).comp hx,
 end
 
-lemma snorm_exponent_top_lim_le_liminf_snorm_exponent_top {ι} [nonempty ι] [encodable ι]
+lemma snorm_exponent_top_lim_le_liminf_snorm_exponent_top {ι} [nonempty ι] [countable ι]
   [linear_order ι] {f : ι → α → F} {f_lim : α → F}
   (h_lim : ∀ᵐ (x : α) ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x))) :
   snorm f_lim ∞ μ ≤ at_top.liminf (λ n, snorm (f n) ∞ μ) :=
 begin
   rw snorm_exponent_top_lim_eq_ess_sup_liminf h_lim,
   simp_rw [snorm_exponent_top, snorm_ess_sup],
-  exact ennreal.ess_sup_liminf_le (λ n, (λ x, (∥f n x∥₊ : ℝ≥0∞))),
+  exact ennreal.ess_sup_liminf_le (λ n, (λ x, (‖f n x‖₊ : ℝ≥0∞))),
 end
 
-lemma snorm_lim_le_liminf_snorm {E} [normed_group E]
+lemma snorm_lim_le_liminf_snorm {E} [normed_add_comm_group E]
   {f : ℕ → α → E} (hf : ∀ n, ae_strongly_measurable (f n) μ) (f_lim : α → E)
   (h_lim : ∀ᵐ (x : α) ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x))) :
   snorm f_lim p μ ≤ at_top.liminf (λ n, snorm (f n) p μ) :=
@@ -2329,10 +1195,9 @@ begin
   let B := λ n : ℕ, ((1:ℝ) / 2) ^ n,
   have hB_pos : ∀ n, 0 < B n, from λ n, pow_pos (div_pos zero_lt_one zero_lt_two) n,
   refine metric.complete_of_convergent_controlled_sequences B hB_pos (λ f hf, _),
-  suffices h_limit : ∃ (f_lim : α → E) (hf_lim_meas : mem_ℒp f_lim p μ),
+  rsuffices ⟨f_lim, hf_lim_meas, h_tendsto⟩ : ∃ (f_lim : α → E) (hf_lim_meas : mem_ℒp f_lim p μ),
     at_top.tendsto (λ n, snorm (f n - f_lim) p μ) (𝓝 0),
-  { rcases h_limit with ⟨f_lim, hf_lim_meas, h_tendsto⟩,
-    exact ⟨hf_lim_meas.to_Lp f_lim, tendsto_Lp_of_tendsto_ℒp f_lim hf_lim_meas h_tendsto⟩, },
+  { exact ⟨hf_lim_meas.to_Lp f_lim, tendsto_Lp_of_tendsto_ℒp f_lim hf_lim_meas h_tendsto⟩, },
   have hB : summable B, from summable_geometric_two,
   cases hB with M hB,
   let B1 := λ n, ennreal.of_real (B n),
@@ -2359,10 +1224,10 @@ end
 private lemma snorm'_sum_norm_sub_le_tsum_of_cauchy_snorm' {f : ℕ → α → E}
   (hf : ∀ n, ae_strongly_measurable (f n) μ) {p : ℝ} (hp1 : 1 ≤ p)
   {B : ℕ → ℝ≥0∞} (h_cau : ∀ (N n m : ℕ), N ≤ n → N ≤ m → snorm' (f n - f m) p μ < B N) (n : ℕ) :
-  snorm' (λ x, ∑ i in finset.range (n + 1), ∥f (i + 1) x - f i x∥) p μ ≤ ∑' i, B i :=
+  snorm' (λ x, ∑ i in finset.range (n + 1), ‖f (i + 1) x - f i x‖) p μ ≤ ∑' i, B i :=
 begin
-  let f_norm_diff := λ i x, ∥f (i + 1) x - f i x∥,
-  have hgf_norm_diff : ∀ n, (λ x, ∑ i in finset.range (n + 1), ∥f (i + 1) x - f i x∥)
+  let f_norm_diff := λ i x, ‖f (i + 1) x - f i x‖,
+  have hgf_norm_diff : ∀ n, (λ x, ∑ i in finset.range (n + 1), ‖f (i + 1) x - f i x‖)
       = ∑ i in finset.range (n + 1), f_norm_diff i,
     from λ n, funext (λ x, by simp [f_norm_diff]),
   rw hgf_norm_diff,
@@ -2374,8 +1239,8 @@ end
 
 private lemma lintegral_rpow_sum_coe_nnnorm_sub_le_rpow_tsum {f : ℕ → α → E}
   (hf : ∀ n, ae_strongly_measurable (f n) μ) {p : ℝ} (hp1 : 1 ≤ p) {B : ℕ → ℝ≥0∞} (n : ℕ)
-  (hn : snorm' (λ x, ∑ i in finset.range (n + 1), ∥f (i + 1) x - f i x∥) p μ ≤ ∑' i, B i) :
-  ∫⁻ a, (∑ i in finset.range (n + 1), ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ
+  (hn : snorm' (λ x, ∑ i in finset.range (n + 1), ‖f (i + 1) x - f i x‖) p μ ≤ ∑' i, B i) :
+  ∫⁻ a, (∑ i in finset.range (n + 1), ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ
     ≤ (∑' i, B i) ^ p :=
 begin
   have hp_pos : 0 < p := zero_lt_one.trans_le hp1,
@@ -2383,8 +1248,8 @@ begin
     one_div_one_div p],
   simp_rw snorm' at hn,
   have h_nnnorm_nonneg :
-    (λ a, (∥∑ i in finset.range (n + 1), ∥f (i + 1) a - f i a∥∥₊ : ℝ≥0∞) ^ p)
-    = λ a, (∑ i in finset.range (n + 1), (∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)) ^ p,
+    (λ a, (‖∑ i in finset.range (n + 1), ‖f (i + 1) a - f i a‖‖₊ : ℝ≥0∞) ^ p)
+    = λ a, (∑ i in finset.range (n + 1), (‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)) ^ p,
   { ext1 a,
     congr,
     simp_rw ←of_real_norm_eq_coe_nnnorm,
@@ -2392,19 +1257,19 @@ begin
     { rw real.norm_of_nonneg _,
       exact finset.sum_nonneg (λ x hx, norm_nonneg _), },
     { exact λ x hx, norm_nonneg _, }, },
-  change (∫⁻ a, (λ x, ↑∥∑ i in finset.range (n + 1), ∥f (i+1) x - f i x∥∥₊^p) a ∂μ)^(1/p)
+  change (∫⁻ a, (λ x, ↑‖∑ i in finset.range (n + 1), ‖f (i+1) x - f i x‖‖₊^p) a ∂μ)^(1/p)
     ≤ ∑' i, B i at hn,
   rwa h_nnnorm_nonneg at hn,
 end
 
 private lemma lintegral_rpow_tsum_coe_nnnorm_sub_le_tsum {f : ℕ → α → E}
   (hf : ∀ n, ae_strongly_measurable (f n) μ) {p : ℝ} (hp1 : 1 ≤ p) {B : ℕ → ℝ≥0∞}
-  (h : ∀ n, ∫⁻ a, (∑ i in finset.range (n + 1), ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ
+  (h : ∀ n, ∫⁻ a, (∑ i in finset.range (n + 1), ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ
     ≤ (∑' i, B i) ^ p) :
-  (∫⁻ a, (∑' i, ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ) ^ (1/p) ≤ ∑' i, B i :=
+  (∫⁻ a, (∑' i, ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ) ^ (1/p) ≤ ∑' i, B i :=
 begin
   have hp_pos : 0 < p := zero_lt_one.trans_le hp1,
-  suffices h_pow : ∫⁻ a, (∑' i, ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ ≤ (∑' i, B i) ^ p,
+  suffices h_pow : ∫⁻ a, (∑' i, ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ ≤ (∑' i, B i) ^ p,
     by rwa [←ennreal.le_rpow_one_div_iff (by simp [hp_pos] : 0 < 1 / p), one_div_one_div],
   have h_tsum_1 : ∀ g : ℕ → ℝ≥0∞,
       ∑' i, g i = at_top.liminf (λ n, ∑ i in finset.range (n + 1), g i),
@@ -2412,8 +1277,8 @@ begin
   simp_rw h_tsum_1 _,
   rw ← h_tsum_1,
   have h_liminf_pow : ∫⁻ a, at_top.liminf (λ n, ∑ i in finset.range (n + 1),
-      (∥f (i + 1) a - f i a∥₊))^p ∂μ
-    = ∫⁻ a, at_top.liminf (λ n, (∑ i in finset.range (n + 1), (∥f (i + 1) a - f i a∥₊))^p) ∂μ,
+      (‖f (i + 1) a - f i a‖₊))^p ∂μ
+    = ∫⁻ a, at_top.liminf (λ n, (∑ i in finset.range (n + 1), (‖f (i + 1) a - f i a‖₊))^p) ∂μ,
   { refine lintegral_congr (λ x, _),
     have h_rpow_mono := ennreal.strict_mono_rpow_of_pos (zero_lt_one.trans_le hp1),
     have h_rpow_surj := (ennreal.rpow_left_bijective hp_pos.ne.symm).2,
@@ -2429,16 +1294,16 @@ end
 private lemma tsum_nnnorm_sub_ae_lt_top
   {f : ℕ → α → E} (hf : ∀ n, ae_strongly_measurable (f n) μ) {p : ℝ} (hp1 : 1 ≤ p) {B : ℕ → ℝ≥0∞}
   (hB : ∑' i, B i ≠ ∞)
-  (h : (∫⁻ a, (∑' i, ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ) ^ (1/p) ≤ ∑' i, B i) :
-  ∀ᵐ x ∂μ, (∑' i, ∥f (i + 1) x - f i x∥₊ : ℝ≥0∞) < ∞ :=
+  (h : (∫⁻ a, (∑' i, ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ) ^ (1/p) ≤ ∑' i, B i) :
+  ∀ᵐ x ∂μ, (∑' i, ‖f (i + 1) x - f i x‖₊ : ℝ≥0∞) < ∞ :=
 begin
   have hp_pos : 0 < p := zero_lt_one.trans_le hp1,
-  have h_integral : ∫⁻ a, (∑' i, ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ < ∞,
+  have h_integral : ∫⁻ a, (∑' i, ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ < ∞,
   { have h_tsum_lt_top : (∑' i, B i) ^ p < ∞,
       from ennreal.rpow_lt_top_of_nonneg hp_pos.le hB,
     refine lt_of_le_of_lt _ h_tsum_lt_top,
     rwa [←ennreal.le_rpow_one_div_iff (by simp [hp_pos] : 0 < 1 / p), one_div_one_div] at h, },
-  have rpow_ae_lt_top : ∀ᵐ x ∂μ, (∑' i, ∥f (i + 1) x - f i x∥₊ : ℝ≥0∞)^p < ∞,
+  have rpow_ae_lt_top : ∀ᵐ x ∂μ, (∑' i, ‖f (i + 1) x - f i x‖₊ : ℝ≥0∞)^p < ∞,
   { refine ae_lt_top' (ae_measurable.pow_const _ _) h_integral.ne,
     exact ae_measurable.ennreal_tsum (λ n, ((hf (n+1)).sub (hf n)).ennnorm), },
   refine rpow_ae_lt_top.mono (λ x hx, _),
@@ -2452,15 +1317,15 @@ lemma ae_tendsto_of_cauchy_snorm' [complete_space E] {f : ℕ → α → E} {p :
   ∀ᵐ x ∂μ, ∃ l : E, at_top.tendsto (λ n, f n x) (𝓝 l) :=
 begin
   have h_summable : ∀ᵐ x ∂μ, summable (λ (i : ℕ), f (i + 1) x - f i x),
-  { have h1 : ∀ n, snorm' (λ x, ∑ i in finset.range (n + 1), ∥f (i + 1) x - f i x∥) p μ
+  { have h1 : ∀ n, snorm' (λ x, ∑ i in finset.range (n + 1), ‖f (i + 1) x - f i x‖) p μ
         ≤ ∑' i, B i,
       from snorm'_sum_norm_sub_le_tsum_of_cauchy_snorm' hf hp1 h_cau,
-    have h2 : ∀ n, ∫⁻ a, (∑ i in finset.range (n + 1), ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ
+    have h2 : ∀ n, ∫⁻ a, (∑ i in finset.range (n + 1), ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ
         ≤ (∑' i, B i) ^ p,
       from λ n, lintegral_rpow_sum_coe_nnnorm_sub_le_rpow_tsum hf hp1 n (h1 n),
-    have h3 : (∫⁻ a, (∑' i, ∥f (i + 1) a - f i a∥₊ : ℝ≥0∞)^p ∂μ) ^ (1/p) ≤ ∑' i, B i,
+    have h3 : (∫⁻ a, (∑' i, ‖f (i + 1) a - f i a‖₊ : ℝ≥0∞)^p ∂μ) ^ (1/p) ≤ ∑' i, B i,
       from lintegral_rpow_tsum_coe_nnnorm_sub_le_tsum hf hp1 h2,
-    have h4 : ∀ᵐ x ∂μ, (∑' i, ∥f (i + 1) x - f i x∥₊ : ℝ≥0∞) < ∞,
+    have h4 : ∀ᵐ x ∂μ, (∑' i, ‖f (i + 1) x - f i x‖₊ : ℝ≥0∞) < ∞,
       from tsum_nnnorm_sub_ae_lt_top hf hp1 hB h3,
     exact h4.mono (λ x hx, summable_of_summable_nnnorm
       (ennreal.tsum_coe_ne_top_iff_summable.mp (lt_top_iff_ne_top.mp hx))), },
@@ -2488,8 +1353,8 @@ lemma ae_tendsto_of_cauchy_snorm [complete_space E] {f : ℕ → α → E}
 begin
   by_cases hp_top : p = ∞,
   { simp_rw [hp_top] at *,
-    have h_cau_ae : ∀ᵐ x ∂μ, ∀ N n m, N ≤ n → N ≤ m → (∥(f n - f m) x∥₊ : ℝ≥0∞) < B N,
-    { simp_rw [ae_all_iff, ae_imp_iff],
+    have h_cau_ae : ∀ᵐ x ∂μ, ∀ N n m, N ≤ n → N ≤ m → (‖(f n - f m) x‖₊ : ℝ≥0∞) < B N,
+    { simp_rw ae_all_iff,
       exact λ N n m hnN hmN, ae_lt_of_ess_sup_lt (h_cau N n m hnN hmN), },
     simp_rw [snorm_exponent_top, snorm_ess_sup] at h_cau,
     refine h_cau_ae.mono (λ x hx, cauchy_seq_tendsto_of_complete _),
@@ -2510,7 +1375,7 @@ begin
   have h_cau' : ∀ (N n m : ℕ), N ≤ n → N ≤ m → snorm' (f n - f m) (p.to_real) μ < B N,
   { intros N n m hn hm,
     specialize h_cau N n m hn hm,
-    rwa snorm_eq_snorm' (ennreal.zero_lt_one.trans_le hp).ne.symm hp_top at h_cau, },
+    rwa snorm_eq_snorm' (zero_lt_one.trans_le hp).ne.symm hp_top at h_cau, },
   exact ae_tendsto_of_cauchy_snorm' hf hp1 hB h_cau',
 end
 
@@ -2547,7 +1412,7 @@ lemma mem_ℒp_of_cauchy_tendsto (hp : 1 ≤ p) {f : ℕ → α → E} (hf : ∀
 begin
   refine ⟨h_lim_meas, _⟩,
   rw ennreal.tendsto_at_top_zero at h_tendsto,
-  cases (h_tendsto 1 ennreal.zero_lt_one) with N h_tendsto_1,
+  cases (h_tendsto 1 zero_lt_one) with N h_tendsto_1,
   specialize h_tendsto_1 N (le_refl N),
   have h_add : f_lim = f_lim - f N + f N, by abel,
   rw h_add,
@@ -2622,29 +1487,36 @@ variables [is_finite_measure μ]
 lemma mem_Lp (f : α →ᵇ E) :
   f.to_continuous_map.to_ae_eq_fun μ ∈ Lp E p μ :=
 begin
-  refine Lp.mem_Lp_of_ae_bound (∥f∥) _,
+  refine Lp.mem_Lp_of_ae_bound (‖f‖) _,
   filter_upwards [f.to_continuous_map.coe_fn_to_ae_eq_fun μ] with x _,
   convert f.norm_coe_le_norm x
 end
 
 /-- The `Lp`-norm of a bounded continuous function is at most a constant (depending on the measure
 of the whole space) times its sup-norm. -/
-lemma Lp_norm_le (f : α →ᵇ E) :
-  ∥(⟨f.to_continuous_map.to_ae_eq_fun μ, mem_Lp f⟩ : Lp E p μ)∥
-  ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * ∥f∥ :=
+lemma Lp_nnnorm_le (f : α →ᵇ E) :
+  ‖(⟨f.to_continuous_map.to_ae_eq_fun μ, mem_Lp f⟩ : Lp E p μ)‖₊
+  ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * ‖f‖₊ :=
 begin
-  apply Lp.norm_le_of_ae_bound (norm_nonneg f),
-  { refine (f.to_continuous_map.coe_fn_to_ae_eq_fun μ).mono _,
-    intros x hx,
-    convert f.norm_coe_le_norm x },
-  { apply_instance }
+  apply Lp.nnnorm_le_of_ae_bound,
+  refine (f.to_continuous_map.coe_fn_to_ae_eq_fun μ).mono _,
+  intros x hx,
+  rw [←nnreal.coe_le_coe, coe_nnnorm, coe_nnnorm],
+  convert f.norm_coe_le_norm x,
 end
 
+/-- The `Lp`-norm of a bounded continuous function is at most a constant (depending on the measure
+of the whole space) times its sup-norm. -/
+lemma Lp_norm_le (f : α →ᵇ E) :
+  ‖(⟨f.to_continuous_map.to_ae_eq_fun μ, mem_Lp f⟩ : Lp E p μ)‖
+  ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ * ‖f‖ :=
+Lp_nnnorm_le f
+
 variables (p μ)
 
 /-- The normed group homomorphism of considering a bounded continuous function on a finite-measure
 space as an element of `Lp`. -/
-def to_Lp_hom [fact (1 ≤ p)] : normed_group_hom (α →ᵇ E) (Lp E p μ) :=
+def to_Lp_hom [fact (1 ≤ p)] : normed_add_group_hom (α →ᵇ E) (Lp E p μ) :=
 { bound' := ⟨_, Lp_norm_le⟩,
   .. add_monoid_hom.cod_restrict
       ((continuous_map.to_ae_eq_fun_add_hom μ).comp (to_continuous_map_add_hom α E))
@@ -2661,11 +1533,11 @@ begin
     (by { rintros - ⟨f, rfl⟩, exact mem_Lp f } : _ ≤ Lp E p μ),
 end
 
-variables (𝕜 : Type*)
+variables (𝕜 : Type*) [fact (1 ≤ p)]
 
 /-- The bounded linear map of considering a bounded continuous function on a finite-measure space
 as an element of `Lp`. -/
-def to_Lp [normed_field 𝕜] [normed_space 𝕜 E] [fact (1 ≤ p)] :
+def to_Lp [normed_field 𝕜] [normed_space 𝕜 E] :
   (α →ᵇ E) →L[𝕜] (Lp E p μ) :=
 linear_map.mk_continuous
   (linear_map.cod_restrict
@@ -2675,23 +1547,34 @@ linear_map.mk_continuous
   _
   Lp_norm_le
 
+lemma coe_fn_to_Lp [normed_field 𝕜] [normed_space 𝕜 E] (f : α →ᵇ E) :
+  to_Lp p μ 𝕜 f =ᵐ[μ] f := ae_eq_fun.coe_fn_mk f _
+
 variables {𝕜}
 
-lemma range_to_Lp [normed_field 𝕜] [normed_space 𝕜 E] [fact (1 ≤ p)] :
-  (((to_Lp p μ 𝕜).range : submodule 𝕜 (Lp E p μ)).to_add_subgroup)
+lemma range_to_Lp [normed_field 𝕜] [normed_space 𝕜 E] :
+  ((linear_map.range (to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] Lp E p μ)).to_add_subgroup)
     = measure_theory.Lp.bounded_continuous_function E p μ :=
 range_to_Lp_hom p μ
 
 variables {p}
 
-lemma coe_fn_to_Lp [normed_field 𝕜] [normed_space 𝕜 E] [fact (1 ≤ p)] (f : α →ᵇ E) :
-  to_Lp p μ 𝕜 f =ᵐ[μ] f :=
-ae_eq_fun.coe_fn_mk f _
-
-lemma to_Lp_norm_le [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E] [fact (1 ≤ p)] :
-  ∥(to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] (Lp E p μ))∥ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ :=
+lemma to_Lp_norm_le [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]:
+  ‖(to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] (Lp E p μ))‖ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ :=
 linear_map.mk_continuous_norm_le _ ((measure_univ_nnreal μ) ^ (p.to_real)⁻¹).coe_nonneg _
 
+lemma to_Lp_inj {f g : α →ᵇ E} [μ.is_open_pos_measure] [normed_field 𝕜] [normed_space 𝕜 E] :
+  to_Lp p μ 𝕜 f = to_Lp p μ 𝕜 g ↔ f = g :=
+begin
+  refine ⟨λ h, _, by tauto⟩,
+  rw [←fun_like.coe_fn_eq, ←(map_continuous f).ae_eq_iff_eq μ (map_continuous g)],
+  refine (coe_fn_to_Lp p μ 𝕜 f).symm.trans (eventually_eq.trans _ $ coe_fn_to_Lp p μ 𝕜 g),
+  rw h,
+end
+
+lemma to_Lp_injective [μ.is_open_pos_measure] [normed_field 𝕜] [normed_space 𝕜 E] :
+  function.injective ⇑(to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] (Lp E p μ)) := λ f g hfg, (to_Lp_inj μ).mp hfg
+
 end bounded_continuous_function
 
 namespace continuous_map
@@ -2711,13 +1594,13 @@ def to_Lp [normed_field 𝕜] [normed_space 𝕜 E] :
 variables {𝕜}
 
 lemma range_to_Lp [normed_field 𝕜] [normed_space 𝕜 E] :
-  ((to_Lp p μ 𝕜).range : submodule 𝕜 (Lp E p μ)).to_add_subgroup
+  (linear_map.range (to_Lp p μ 𝕜 : C(α, E) →L[𝕜] Lp E p μ)).to_add_subgroup
     = measure_theory.Lp.bounded_continuous_function E p μ :=
 begin
   refine set_like.ext' _,
   have := (linear_isometry_bounded_of_compact α E 𝕜).surjective,
   convert function.surjective.range_comp this (bounded_continuous_function.to_Lp p μ 𝕜),
-  rw ← bounded_continuous_function.range_to_Lp p μ,
+  rw ←bounded_continuous_function.range_to_Lp p μ,
   refl,
 end
 
@@ -2741,16 +1624,37 @@ rfl
   (to_Lp p μ 𝕜 f : α →ₘ[μ] E) = f.to_ae_eq_fun μ :=
 rfl
 
-variables [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
+lemma to_Lp_injective [μ.is_open_pos_measure] [normed_field 𝕜] [normed_space 𝕜 E] :
+  function.injective ⇑(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] (Lp E p μ)) :=
+(bounded_continuous_function.to_Lp_injective _).comp
+  (linear_isometry_bounded_of_compact α E 𝕜).injective
+
+lemma to_Lp_inj {f g : C(α, E)} [μ.is_open_pos_measure] [normed_field 𝕜] [normed_space 𝕜 E] :
+  to_Lp p μ 𝕜 f = to_Lp p μ 𝕜 g ↔ f = g :=
+(to_Lp_injective μ).eq_iff
+
+variables {μ}
+
+/-- If a sum of continuous functions `g n` is convergent, and the same sum converges in `Lᵖ` to `h`,
+then in fact `g n` converges uniformly to `h`.  -/
+lemma has_sum_of_has_sum_Lp {β : Type*} [μ.is_open_pos_measure] [normed_field 𝕜] [normed_space 𝕜 E]
+  {g : β → C(α, E)} {f : C(α, E)} (hg : summable g)
+  (hg2 : has_sum (to_Lp p μ 𝕜 ∘ g) (to_Lp p μ 𝕜 f)) : has_sum g f :=
+begin
+  convert summable.has_sum hg,
+  exact to_Lp_injective μ (hg2.unique ((to_Lp p μ 𝕜).has_sum $ summable.has_sum hg)),
+end
+
+variables (μ) [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
 
 lemma to_Lp_norm_eq_to_Lp_norm_coe :
-  ∥(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] (Lp E p μ))∥
-  = ∥(bounded_continuous_function.to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] (Lp E p μ))∥ :=
+  ‖(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] (Lp E p μ))‖
+  = ‖(bounded_continuous_function.to_Lp p μ 𝕜 : (α →ᵇ E) →L[𝕜] (Lp E p μ))‖ :=
 continuous_linear_map.op_norm_comp_linear_isometry_equiv _ _
 
 /-- Bound for the operator norm of `continuous_map.to_Lp`. -/
 lemma to_Lp_norm_le :
-  ∥(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] (Lp E p μ))∥ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ :=
+  ‖(to_Lp p μ 𝕜 : C(α, E) →L[𝕜] (Lp E p μ))‖ ≤ (measure_univ_nnreal μ) ^ (p.to_real)⁻¹ :=
 by { rw to_Lp_norm_eq_to_Lp_norm_coe, exact bounded_continuous_function.to_Lp_norm_le μ }
 
 end continuous_map
@@ -2763,26 +1667,26 @@ namespace Lp
 
 lemma pow_mul_meas_ge_le_norm (f : Lp E p μ)
   (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (ε : ℝ≥0∞) :
-  (ε * μ {x | ε ≤ ∥f x∥₊ ^ p.to_real}) ^ (1 / p.to_real) ≤ (ennreal.of_real ∥f∥) :=
+  (ε * μ {x | ε ≤ ‖f x‖₊ ^ p.to_real}) ^ (1 / p.to_real) ≤ (ennreal.of_real ‖f‖) :=
 (ennreal.of_real_to_real (snorm_ne_top f)).symm ▸
   pow_mul_meas_ge_le_snorm μ hp_ne_zero hp_ne_top (Lp.ae_strongly_measurable f) ε
 
 lemma mul_meas_ge_le_pow_norm (f : Lp E p μ)
   (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (ε : ℝ≥0∞) :
-  ε * μ {x | ε ≤ ∥f x∥₊ ^ p.to_real} ≤ (ennreal.of_real ∥f∥) ^ p.to_real :=
+  ε * μ {x | ε ≤ ‖f x‖₊ ^ p.to_real} ≤ (ennreal.of_real ‖f‖) ^ p.to_real :=
 (ennreal.of_real_to_real (snorm_ne_top f)).symm ▸
   mul_meas_ge_le_pow_snorm μ hp_ne_zero hp_ne_top (Lp.ae_strongly_measurable f) ε
 
 /-- A version of Markov's inequality with elements of Lp. -/
 lemma mul_meas_ge_le_pow_norm' (f : Lp E p μ)
   (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) (ε : ℝ≥0∞) :
-  ε ^ p.to_real * μ {x | ε ≤ ∥f x∥₊} ≤ (ennreal.of_real ∥f∥) ^ p.to_real :=
+  ε ^ p.to_real * μ {x | ε ≤ ‖f x‖₊} ≤ (ennreal.of_real ‖f‖) ^ p.to_real :=
 (ennreal.of_real_to_real (snorm_ne_top f)).symm ▸
   mul_meas_ge_le_pow_snorm' μ hp_ne_zero hp_ne_top (Lp.ae_strongly_measurable f) ε
 
 lemma meas_ge_le_mul_pow_norm (f : Lp E p μ)
   (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
-  μ {x | ε ≤ ∥f x∥₊} ≤ ε⁻¹ ^ p.to_real * (ennreal.of_real ∥f∥) ^ p.to_real :=
+  μ {x | ε ≤ ‖f x‖₊} ≤ ε⁻¹ ^ p.to_real * (ennreal.of_real ‖f‖) ^ p.to_real :=
 (ennreal.of_real_to_real (snorm_ne_top f)).symm ▸
   meas_ge_le_mul_pow_snorm μ hp_ne_zero hp_ne_top (Lp.ae_strongly_measurable f) hε
 
diff --git a/src/measure_theory/function/simple_func.lean b/src/measure_theory/function/simple_func.lean
new file mode 100644
index 0000000000000..7e69629179f8c
--- /dev/null
+++ b/src/measure_theory/function/simple_func.lean
@@ -0,0 +1,1015 @@
+/-
+Copyright (c) 2018 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro, Johannes Hölzl
+-/
+import measure_theory.constructions.borel_space.basic
+import algebra.indicator_function
+import algebra.support
+
+/-!
+# Simple functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A function `f` from a measurable space to any type is called *simple*, if every preimage `f ⁻¹' {x}`
+is measurable, and the range is finite. In this file, we define simple functions and establish their
+basic properties; and we construct a sequence of simple functions approximating an arbitrary Borel
+measurable function `f : α → ℝ≥0∞`.
+
+The theorem `measurable.ennreal_induction` shows that in order to prove something for an arbitrary
+measurable function into `ℝ≥0∞`, it is sufficient to show that the property holds for (multiples of)
+characteristic functions and is closed under addition and supremum of increasing sequences of
+functions.
+-/
+noncomputable theory
+open set (hiding restrict restrict_apply) filter ennreal function (support)
+open_locale classical topology big_operators nnreal ennreal measure_theory
+
+namespace measure_theory
+
+variables {α β γ δ : Type*}
+
+/-- A function `f` from a measurable space to any type is called *simple*,
+if every preimage `f ⁻¹' {x}` is measurable, and the range is finite. This structure bundles
+a function with these properties. -/
+structure {u v} simple_func (α : Type u) [measurable_space α] (β : Type v) :=
+(to_fun : α → β)
+(measurable_set_fiber' : ∀ x, measurable_set (to_fun ⁻¹' {x}))
+(finite_range' : (set.range to_fun).finite)
+
+local infixr ` →ₛ `:25 := simple_func
+
+namespace simple_func
+
+section measurable
+variables [measurable_space α]
+instance has_coe_to_fun : has_coe_to_fun (α →ₛ β) (λ _, α → β) := ⟨to_fun⟩
+
+lemma coe_injective ⦃f g : α →ₛ β⦄ (H : (f : α → β) = g) : f = g :=
+by cases f; cases g; congr; exact H
+
+@[ext] theorem ext {f g : α →ₛ β} (H : ∀ a, f a = g a) : f = g :=
+coe_injective $ funext H
+
+lemma finite_range (f : α →ₛ β) : (set.range f).finite := f.finite_range'
+
+lemma measurable_set_fiber (f : α →ₛ β) (x : β) : measurable_set (f ⁻¹' {x}) :=
+f.measurable_set_fiber' x
+
+@[simp] lemma apply_mk (f : α → β) (h h') (x : α) : simple_func.mk f h h' x = f x := rfl
+
+/-- Simple function defined on the empty type. -/
+def of_is_empty [is_empty α] : α →ₛ β :=
+{ to_fun := is_empty_elim,
+  measurable_set_fiber' := λ x, subsingleton.measurable_set,
+  finite_range' := by simp [range_eq_empty] }
+
+/-- Range of a simple function `α →ₛ β` as a `finset β`. -/
+protected def range (f : α →ₛ β) : finset β := f.finite_range.to_finset
+
+@[simp] theorem mem_range {f : α →ₛ β} {b} : b ∈ f.range ↔ b ∈ range f :=
+finite.mem_to_finset _
+
+theorem mem_range_self (f : α →ₛ β) (x : α) : f x ∈ f.range := mem_range.2 ⟨x, rfl⟩
+
+@[simp] lemma coe_range (f : α →ₛ β) : (↑f.range : set β) = set.range f :=
+f.finite_range.coe_to_finset
+
+theorem mem_range_of_measure_ne_zero {f : α →ₛ β} {x : β} {μ : measure α} (H : μ (f ⁻¹' {x}) ≠ 0) :
+  x ∈ f.range :=
+let ⟨a, ha⟩ := nonempty_of_measure_ne_zero H in
+mem_range.2 ⟨a, ha⟩
+
+lemma forall_range_iff {f : α →ₛ β} {p : β → Prop} :
+  (∀ y ∈ f.range, p y) ↔ ∀ x, p (f x) :=
+by simp only [mem_range, set.forall_range_iff]
+
+lemma exists_range_iff {f : α →ₛ β} {p : β → Prop} :
+  (∃ y ∈ f.range, p y) ↔ ∃ x, p (f x) :=
+by simpa only [mem_range, exists_prop] using set.exists_range_iff
+
+lemma preimage_eq_empty_iff (f : α →ₛ β) (b : β) : f ⁻¹' {b} = ∅ ↔ b ∉ f.range :=
+preimage_singleton_eq_empty.trans $ not_congr mem_range.symm
+
+lemma exists_forall_le [nonempty β] [preorder β] [is_directed β (≤)] (f : α →ₛ β) :
+  ∃ C, ∀ x, f x ≤ C :=
+f.range.exists_le.imp $ λ C, forall_range_iff.1
+
+/-- Constant function as a `simple_func`. -/
+def const (α) {β} [measurable_space α] (b : β) : α →ₛ β :=
+⟨λ a, b, λ x, measurable_set.const _, finite_range_const⟩
+
+instance [inhabited β] : inhabited (α →ₛ β) := ⟨const _ default⟩
+
+theorem const_apply (a : α) (b : β) : (const α b) a = b := rfl
+
+@[simp] theorem coe_const (b : β) : ⇑(const α b) = function.const α b := rfl
+
+@[simp] lemma range_const (α) [measurable_space α] [nonempty α] (b : β) :
+  (const α b).range = {b} :=
+finset.coe_injective $ by simp
+
+lemma range_const_subset (α) [measurable_space α] (b : β) :
+  (const α b).range ⊆ {b} :=
+finset.coe_subset.1 $ by simp
+
+lemma simple_func_bot {α} (f : @simple_func α ⊥ β) [nonempty β] : ∃ c, ∀ x, f x = c :=
+begin
+  have hf_meas := @simple_func.measurable_set_fiber α _ ⊥ f,
+  simp_rw measurable_space.measurable_set_bot_iff at hf_meas,
+  casesI is_empty_or_nonempty α,
+  { simp only [is_empty.forall_iff, exists_const], },
+  { specialize hf_meas (f h.some),
+    cases hf_meas,
+    { exfalso,
+      refine set.not_mem_empty h.some _,
+      rw [← hf_meas, set.mem_preimage],
+      exact set.mem_singleton _, },
+    { refine ⟨f h.some, λ x, _⟩,
+      have : x ∈ f ⁻¹' {f h.some},
+      { rw hf_meas, exact set.mem_univ x, },
+      rwa [set.mem_preimage, set.mem_singleton_iff] at this, }, },
+end
+
+lemma simple_func_bot' {α} [nonempty β] (f : @simple_func α ⊥ β) :
+  ∃ c, f = @simple_func.const α _ ⊥ c :=
+begin
+  obtain ⟨c, h_eq⟩ := simple_func_bot f,
+  refine ⟨c, _⟩,
+  ext1 x,
+  rw [h_eq x, simple_func.coe_const],
+end
+
+lemma measurable_set_cut (r : α → β → Prop) (f : α →ₛ β)
+  (h : ∀b, measurable_set {a | r a b}) : measurable_set {a | r a (f a)} :=
+begin
+  have : {a | r a (f a)} = ⋃ b ∈ range f, {a | r a b} ∩ f ⁻¹' {b},
+  { ext a,
+    suffices : r a (f a) ↔ ∃ i, r a (f i) ∧ f a = f i, by simpa,
+    exact ⟨λ h, ⟨a, ⟨h, rfl⟩⟩, λ ⟨a', ⟨h', e⟩⟩, e.symm ▸ h'⟩ },
+  rw this,
+  exact measurable_set.bUnion f.finite_range.countable
+    (λ b _, measurable_set.inter (h b) (f.measurable_set_fiber _))
+end
+
+@[measurability]
+theorem measurable_set_preimage (f : α →ₛ β) (s) : measurable_set (f ⁻¹' s) :=
+measurable_set_cut (λ _ b, b ∈ s) f (λ b, measurable_set.const (b ∈ s))
+
+/-- A simple function is measurable -/
+@[measurability]
+protected theorem measurable [measurable_space β] (f : α →ₛ β) : measurable f :=
+λ s _, measurable_set_preimage f s
+
+@[measurability]
+protected theorem ae_measurable [measurable_space β] {μ : measure α} (f : α →ₛ β) :
+  ae_measurable f μ :=
+f.measurable.ae_measurable
+
+protected lemma sum_measure_preimage_singleton (f : α →ₛ β) {μ : measure α} (s : finset β) :
+  ∑ y in s, μ (f ⁻¹' {y}) = μ (f ⁻¹' ↑s) :=
+sum_measure_preimage_singleton _ (λ _ _, f.measurable_set_fiber _)
+
+lemma sum_range_measure_preimage_singleton (f : α →ₛ β) (μ : measure α) :
+  ∑ y in f.range, μ (f ⁻¹' {y}) = μ univ :=
+by rw [f.sum_measure_preimage_singleton, coe_range, preimage_range]
+
+/-- If-then-else as a `simple_func`. -/
+def piecewise (s : set α) (hs : measurable_set s) (f g : α →ₛ β) : α →ₛ β :=
+⟨s.piecewise f g,
+ λ x, by letI : measurable_space β := ⊤; exact
+   f.measurable.piecewise hs g.measurable trivial,
+ (f.finite_range.union g.finite_range).subset range_ite_subset⟩
+
+@[simp] theorem coe_piecewise {s : set α} (hs : measurable_set s) (f g : α →ₛ β) :
+  ⇑(piecewise s hs f g) = s.piecewise f g :=
+rfl
+
+theorem piecewise_apply {s : set α} (hs : measurable_set s) (f g : α →ₛ β) (a) :
+  piecewise s hs f g a = if a ∈ s then f a else g a :=
+rfl
+
+@[simp] lemma piecewise_compl {s : set α} (hs : measurable_set sᶜ) (f g : α →ₛ β) :
+  piecewise sᶜ hs f g = piecewise s hs.of_compl g f :=
+coe_injective $ by simp [hs]
+
+@[simp] lemma piecewise_univ (f g : α →ₛ β) : piecewise univ measurable_set.univ f g = f :=
+coe_injective $ by simp
+
+@[simp] lemma piecewise_empty (f g : α →ₛ β) : piecewise ∅ measurable_set.empty f g = g :=
+coe_injective $ by simp
+
+lemma support_indicator [has_zero β] {s : set α} (hs : measurable_set s) (f : α →ₛ β) :
+  function.support (f.piecewise s hs (simple_func.const α 0)) = s ∩ function.support f :=
+set.support_indicator
+
+lemma range_indicator {s : set α} (hs : measurable_set s)
+  (hs_nonempty : s.nonempty) (hs_ne_univ : s ≠ univ) (x y : β) :
+  (piecewise s hs (const α x) (const α y)).range = {x, y} :=
+by simp only [← finset.coe_inj, coe_range, coe_piecewise, range_piecewise, coe_const,
+  finset.coe_insert, finset.coe_singleton, hs_nonempty.image_const,
+  (nonempty_compl.2 hs_ne_univ).image_const, singleton_union]
+
+lemma measurable_bind [measurable_space γ] (f : α →ₛ β) (g : β → α → γ)
+  (hg : ∀ b, measurable (g b)) : measurable (λ a, g (f a) a) :=
+λ s hs, f.measurable_set_cut (λ a b, g b a ∈ s) $ λ b, hg b hs
+
+/-- If `f : α →ₛ β` is a simple function and `g : β → α →ₛ γ` is a family of simple functions,
+then `f.bind g` binds the first argument of `g` to `f`. In other words, `f.bind g a = g (f a) a`. -/
+def bind (f : α →ₛ β) (g : β → α →ₛ γ) : α →ₛ γ :=
+⟨λa, g (f a) a,
+ λ c, f.measurable_set_cut (λ a b, g b a = c) $ λ b, (g b).measurable_set_preimage {c},
+ (f.finite_range.bUnion (λ b _, (g b).finite_range)).subset $
+ by rintro _ ⟨a, rfl⟩; simp; exact ⟨a, a, rfl⟩⟩
+
+@[simp] theorem bind_apply (f : α →ₛ β) (g : β → α →ₛ γ) (a) :
+  f.bind g a = g (f a) a := rfl
+
+/-- Given a function `g : β → γ` and a simple function `f : α →ₛ β`, `f.map g` return the simple
+    function `g ∘ f : α →ₛ γ` -/
+def map (g : β → γ) (f : α →ₛ β) : α →ₛ γ := bind f (const α ∘ g)
+
+theorem map_apply (g : β → γ) (f : α →ₛ β) (a) : f.map g a = g (f a) := rfl
+
+theorem map_map (g : β → γ) (h: γ → δ) (f : α →ₛ β) : (f.map g).map h = f.map (h ∘ g) := rfl
+
+@[simp] theorem coe_map (g : β → γ) (f : α →ₛ β) : (f.map g : α → γ) = g ∘ f := rfl
+
+@[simp] theorem range_map [decidable_eq γ] (g : β → γ) (f : α →ₛ β) :
+  (f.map g).range = f.range.image g :=
+finset.coe_injective $ by simp only [coe_range, coe_map, finset.coe_image, range_comp]
+
+@[simp] theorem map_const (g : β → γ) (b : β) : (const α b).map g = const α (g b) := rfl
+
+lemma map_preimage (f : α →ₛ β) (g : β → γ) (s : set γ) :
+  (f.map g) ⁻¹' s = f ⁻¹' ↑(f.range.filter (λb, g b ∈ s)) :=
+by { simp only [coe_range, sep_mem_eq, set.mem_range, function.comp_app, coe_map, finset.coe_filter,
+  ← mem_preimage, inter_comm, preimage_inter_range], apply preimage_comp }
+
+lemma map_preimage_singleton (f : α →ₛ β) (g : β → γ) (c : γ) :
+  (f.map g) ⁻¹' {c} = f ⁻¹' ↑(f.range.filter (λ b, g b = c)) :=
+map_preimage _ _ _
+
+/-- Composition of a `simple_fun` and a measurable function is a `simple_func`. -/
+def comp [measurable_space β] (f : β →ₛ γ) (g : α → β) (hgm : measurable g) : α →ₛ γ :=
+{ to_fun := f ∘ g,
+  finite_range' := f.finite_range.subset $ set.range_comp_subset_range _ _,
+  measurable_set_fiber' := λ z, hgm (f.measurable_set_fiber z) }
+
+@[simp] lemma coe_comp [measurable_space β] (f : β →ₛ γ) {g : α → β} (hgm : measurable g) :
+  ⇑(f.comp g hgm) = f ∘ g :=
+rfl
+
+lemma range_comp_subset_range [measurable_space β] (f : β →ₛ γ) {g : α → β} (hgm : measurable g) :
+  (f.comp g hgm).range ⊆ f.range :=
+finset.coe_subset.1 $ by simp only [coe_range, coe_comp, set.range_comp_subset_range]
+
+/-- Extend a `simple_func` along a measurable embedding: `f₁.extend g hg f₂` is the function
+`F : β →ₛ γ` such that `F ∘ g = f₁` and `F y = f₂ y` whenever `y ∉ range g`. -/
+def extend [measurable_space β] (f₁ : α →ₛ γ) (g : α → β)
+  (hg : measurable_embedding g) (f₂ : β →ₛ γ) : β →ₛ γ :=
+{ to_fun := function.extend g f₁ f₂,
+  finite_range' := (f₁.finite_range.union $ f₂.finite_range.subset
+    (image_subset_range _ _)).subset (range_extend_subset _ _ _),
+  measurable_set_fiber' :=
+    begin
+      letI : measurable_space γ := ⊤, haveI : measurable_singleton_class γ := ⟨λ _, trivial⟩,
+      exact λ x, hg.measurable_extend f₁.measurable f₂.measurable (measurable_set_singleton _)
+    end }
+
+@[simp] lemma extend_apply [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
+  (hg : measurable_embedding g) (f₂ : β →ₛ γ) (x : α) : (f₁.extend g hg f₂) (g x) = f₁ x :=
+hg.injective.extend_apply _ _ _
+
+@[simp] lemma extend_apply' [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
+  (hg : measurable_embedding g) (f₂ : β →ₛ γ) {y : β} (h : ¬∃ x, g x = y) :
+  (f₁.extend g hg f₂) y = f₂ y :=
+function.extend_apply' _ _ _ h
+
+@[simp] lemma extend_comp_eq' [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
+  (hg : measurable_embedding g) (f₂ : β →ₛ γ) : (f₁.extend g hg f₂) ∘ g = f₁ :=
+funext $ λ x, extend_apply _ _ _ _
+
+@[simp] lemma extend_comp_eq [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
+  (hg : measurable_embedding g) (f₂ : β →ₛ γ) : (f₁.extend g hg f₂).comp g hg.measurable = f₁ :=
+coe_injective $ extend_comp_eq' _ _ _
+
+/-- If `f` is a simple function taking values in `β → γ` and `g` is another simple function
+with the same domain and codomain `β`, then `f.seq g = f a (g a)`. -/
+def seq (f : α →ₛ (β → γ)) (g : α →ₛ β) : α →ₛ γ := f.bind (λf, g.map f)
+
+@[simp] lemma seq_apply (f : α →ₛ (β → γ)) (g : α →ₛ β) (a : α) : f.seq g a = f a (g a) := rfl
+
+/-- Combine two simple functions `f : α →ₛ β` and `g : α →ₛ β`
+into `λ a, (f a, g a)`. -/
+def pair (f : α →ₛ β) (g : α →ₛ γ) : α →ₛ (β × γ) := (f.map prod.mk).seq g
+
+@[simp] lemma pair_apply (f : α →ₛ β) (g : α →ₛ γ) (a) : pair f g a = (f a, g a) := rfl
+
+lemma pair_preimage (f : α →ₛ β) (g : α →ₛ γ) (s : set β) (t : set γ) :
+  pair f g ⁻¹' s ×ˢ t = (f ⁻¹' s) ∩ (g ⁻¹' t) := rfl
+
+/- A special form of `pair_preimage` -/
+lemma pair_preimage_singleton (f : α →ₛ β) (g : α →ₛ γ) (b : β) (c : γ) :
+  (pair f g) ⁻¹' {(b, c)} = (f ⁻¹' {b}) ∩ (g ⁻¹' {c}) :=
+by { rw ← singleton_prod_singleton, exact pair_preimage _ _ _ _ }
+
+theorem bind_const (f : α →ₛ β) : f.bind (const α) = f := by ext; simp
+
+@[to_additive] instance [has_one β] : has_one (α →ₛ β) := ⟨const α 1⟩
+@[to_additive] instance [has_mul β] : has_mul (α →ₛ β) := ⟨λf g, (f.map (*)).seq g⟩
+@[to_additive] instance [has_div β] : has_div (α →ₛ β) := ⟨λf g, (f.map (/)).seq g⟩
+@[to_additive] instance [has_inv β] : has_inv (α →ₛ β) := ⟨λf, f.map (has_inv.inv)⟩
+instance [has_sup β] : has_sup (α →ₛ β) := ⟨λf g, (f.map (⊔)).seq g⟩
+instance [has_inf β] : has_inf (α →ₛ β) := ⟨λf g, (f.map (⊓)).seq g⟩
+instance [has_le β] : has_le (α →ₛ β) := ⟨λf g, ∀a, f a ≤ g a⟩
+
+@[simp, to_additive] lemma const_one [has_one β] : const α (1 : β) = 1 := rfl
+
+@[simp, norm_cast, to_additive] lemma coe_one [has_one β] : ⇑(1 : α →ₛ β) = 1 := rfl
+@[simp, norm_cast, to_additive] lemma coe_mul [has_mul β] (f g : α →ₛ β) : ⇑(f * g) = f * g := rfl
+@[simp, norm_cast, to_additive] lemma coe_inv [has_inv β] (f : α →ₛ β) : ⇑(f⁻¹) = f⁻¹ := rfl
+@[simp, norm_cast, to_additive] lemma coe_div [has_div β] (f g : α →ₛ β) : ⇑(f / g) = f / g := rfl
+@[simp, norm_cast] lemma coe_le [preorder β] {f g : α →ₛ β} : (f : α → β) ≤ g ↔ f ≤ g := iff.rfl
+@[simp, norm_cast] lemma coe_sup [has_sup β] (f g : α →ₛ β) : ⇑(f ⊔ g) = f ⊔ g := rfl
+@[simp, norm_cast] lemma coe_inf [has_inf β] (f g : α →ₛ β) : ⇑(f ⊓ g) = f ⊓ g := rfl
+
+@[to_additive] lemma mul_apply [has_mul β] (f g : α →ₛ β) (a : α) : (f * g) a = f a * g a := rfl
+@[to_additive] lemma div_apply [has_div β] (f g : α →ₛ β) (x : α) : (f / g) x = f x / g x := rfl
+@[to_additive] lemma inv_apply [has_inv β] (f : α →ₛ β) (x : α) : f⁻¹ x = (f x)⁻¹ := rfl
+lemma sup_apply [has_sup β] (f g : α →ₛ β) (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl
+lemma inf_apply [has_inf β] (f g : α →ₛ β) (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl
+
+@[simp, to_additive] lemma range_one [nonempty α] [has_one β] : (1 : α →ₛ β).range = {1} :=
+finset.ext $ λ x, by simp [eq_comm]
+
+@[simp] lemma range_eq_empty_of_is_empty {β} [hα : is_empty α] (f : α →ₛ β) :
+  f.range = ∅ :=
+begin
+  rw ← finset.not_nonempty_iff_eq_empty,
+  by_contra,
+  obtain ⟨y, hy_mem⟩ := h,
+  rw [simple_func.mem_range, set.mem_range] at hy_mem,
+  obtain ⟨x, hxy⟩ := hy_mem,
+  rw is_empty_iff at hα,
+  exact hα x,
+end
+
+lemma eq_zero_of_mem_range_zero [has_zero β] : ∀ {y : β}, y ∈ (0 : α →ₛ β).range → y = 0 :=
+forall_range_iff.2 $ λ x, rfl
+
+@[to_additive]
+lemma mul_eq_map₂ [has_mul β] (f g : α →ₛ β) : f * g = (pair f g).map (λp:β×β, p.1 * p.2) := rfl
+
+lemma sup_eq_map₂ [has_sup β] (f g : α →ₛ β) : f ⊔ g = (pair f g).map (λp:β×β, p.1 ⊔ p.2) := rfl
+
+@[to_additive]
+lemma const_mul_eq_map [has_mul β] (f : α →ₛ β) (b : β) : const α b * f = f.map (λa, b * a) := rfl
+
+@[to_additive]
+theorem map_mul [has_mul β] [has_mul γ] {g : β → γ}
+  (hg : ∀ x y, g (x * y) = g x * g y) (f₁ f₂ : α →ₛ β) : (f₁ * f₂).map g = f₁.map g * f₂.map g :=
+ext $ λ x, hg _ _
+
+variables {K : Type*}
+
+instance [has_smul K β] : has_smul K (α →ₛ β) := ⟨λ k f, f.map ((•) k)⟩
+@[simp] lemma coe_smul [has_smul K β] (c : K) (f : α →ₛ β) : ⇑(c • f) = c • f := rfl
+lemma smul_apply [has_smul K β] (k : K) (f : α →ₛ β) (a : α) : (k • f) a = k • f a := rfl
+
+instance has_nat_pow [monoid β] : has_pow (α →ₛ β) ℕ := ⟨λ f n, f.map (^ n)⟩
+@[simp] lemma coe_pow [monoid β] (f : α →ₛ β) (n : ℕ) : ⇑(f ^ n) = f ^ n := rfl
+lemma pow_apply [monoid β] (n : ℕ) (f : α →ₛ β) (a : α) : (f ^ n) a = f a ^ n := rfl
+
+instance has_int_pow [div_inv_monoid β] : has_pow (α →ₛ β) ℤ := ⟨λ f n, f.map (^ n)⟩
+@[simp] lemma coe_zpow [div_inv_monoid β] (f : α →ₛ β) (z : ℤ) : ⇑(f ^ z) = f ^ z := rfl
+lemma zpow_apply [div_inv_monoid β] (z : ℤ) (f : α →ₛ β) (a : α) : (f ^ z) a = f a ^ z := rfl
+
+-- TODO: work out how to generate these instances with `to_additive`, which gets confused by the
+-- argument order swap between `coe_smul` and `coe_pow`.
+section additive
+
+instance [add_monoid β] : add_monoid (α →ₛ β) :=
+function.injective.add_monoid (λ f, show α → β, from f) coe_injective coe_zero coe_add
+  (λ _ _, coe_smul _ _)
+
+instance [add_comm_monoid β] : add_comm_monoid (α →ₛ β) :=
+function.injective.add_comm_monoid (λ f, show α → β, from f) coe_injective coe_zero coe_add
+  (λ _ _, coe_smul _ _)
+
+instance [add_group β] : add_group (α →ₛ β) :=
+function.injective.add_group (λ f, show α → β, from f) coe_injective
+  coe_zero coe_add coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _)
+
+instance [add_comm_group β] : add_comm_group (α →ₛ β) :=
+function.injective.add_comm_group (λ f, show α → β, from f) coe_injective
+  coe_zero coe_add coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _)
+
+end additive
+
+@[to_additive] instance [monoid β] : monoid (α →ₛ β) :=
+function.injective.monoid (λ f, show α → β, from f) coe_injective coe_one coe_mul coe_pow
+
+@[to_additive] instance [comm_monoid β] : comm_monoid (α →ₛ β) :=
+function.injective.comm_monoid (λ f, show α → β, from f) coe_injective coe_one coe_mul coe_pow
+
+@[to_additive] instance [group β] : group (α →ₛ β) :=
+function.injective.group (λ f, show α → β, from f) coe_injective
+  coe_one coe_mul coe_inv coe_div coe_pow coe_zpow
+
+@[to_additive] instance [comm_group β] : comm_group (α →ₛ β) :=
+function.injective.comm_group (λ f, show α → β, from f) coe_injective
+  coe_one coe_mul coe_inv coe_div coe_pow coe_zpow
+
+instance [semiring K] [add_comm_monoid β] [module K β] : module K (α →ₛ β) :=
+function.injective.module K ⟨λ f, show α → β, from f, coe_zero, coe_add⟩
+  coe_injective coe_smul
+
+lemma smul_eq_map [has_smul K β] (k : K) (f : α →ₛ β) : k • f = f.map ((•) k) := rfl
+
+instance [preorder β] : preorder (α →ₛ β) :=
+{ le_refl := λf a, le_rfl,
+  le_trans := λf g h hfg hgh a, le_trans (hfg _) (hgh a),
+  .. simple_func.has_le }
+
+instance [partial_order β] : partial_order (α →ₛ β) :=
+{ le_antisymm := assume f g hfg hgf, ext $ assume a, le_antisymm (hfg a) (hgf a),
+  .. simple_func.preorder }
+
+instance [has_le β] [order_bot β] : order_bot (α →ₛ β) :=
+{ bot := const α ⊥, bot_le := λf a, bot_le }
+
+instance [has_le β] [order_top β] : order_top (α →ₛ β) :=
+{ top := const α ⊤, le_top := λf a, le_top }
+
+instance [semilattice_inf β] : semilattice_inf (α →ₛ β) :=
+{ inf := (⊓),
+  inf_le_left := assume f g a, inf_le_left,
+  inf_le_right := assume f g a, inf_le_right,
+  le_inf := assume f g h hfh hgh a, le_inf (hfh a) (hgh a),
+  .. simple_func.partial_order }
+
+instance [semilattice_sup β] : semilattice_sup (α →ₛ β) :=
+{ sup := (⊔),
+  le_sup_left := assume f g a, le_sup_left,
+  le_sup_right := assume f g a, le_sup_right,
+  sup_le := assume f g h hfh hgh a, sup_le (hfh a) (hgh a),
+  .. simple_func.partial_order }
+
+instance [lattice β] : lattice (α →ₛ β) :=
+{ .. simple_func.semilattice_sup,.. simple_func.semilattice_inf }
+
+instance [has_le β] [bounded_order β] : bounded_order (α →ₛ β) :=
+{ .. simple_func.order_bot, .. simple_func.order_top }
+
+lemma finset_sup_apply [semilattice_sup β] [order_bot β] {f : γ → α →ₛ β} (s : finset γ) (a : α) :
+  s.sup f a = s.sup (λc, f c a) :=
+begin
+  refine finset.induction_on s rfl _,
+  assume a s hs ih,
+  rw [finset.sup_insert, finset.sup_insert, sup_apply, ih]
+end
+
+section restrict
+
+variables [has_zero β]
+
+/-- Restrict a simple function `f : α →ₛ β` to a set `s`. If `s` is measurable,
+then `f.restrict s a = if a ∈ s then f a else 0`, otherwise `f.restrict s = const α 0`. -/
+def restrict (f : α →ₛ β) (s : set α) : α →ₛ β :=
+if hs : measurable_set s then piecewise s hs f 0 else 0
+
+theorem restrict_of_not_measurable {f : α →ₛ β} {s : set α}
+  (hs : ¬measurable_set s) :
+  restrict f s = 0 :=
+dif_neg hs
+
+@[simp] theorem coe_restrict (f : α →ₛ β) {s : set α} (hs : measurable_set s) :
+  ⇑(restrict f s) = indicator s f :=
+by { rw [restrict, dif_pos hs], refl }
+
+@[simp] theorem restrict_univ (f : α →ₛ β) : restrict f univ = f :=
+by simp [restrict]
+
+@[simp] theorem restrict_empty (f : α →ₛ β) : restrict f ∅ = 0 :=
+by simp [restrict]
+
+theorem map_restrict_of_zero [has_zero γ] {g : β → γ} (hg : g 0 = 0) (f : α →ₛ β) (s : set α) :
+  (f.restrict s).map g = (f.map g).restrict s :=
+ext $ λ x,
+if hs : measurable_set s then by simp [hs, set.indicator_comp_of_zero hg]
+else by simp [restrict_of_not_measurable hs, hg]
+
+theorem map_coe_ennreal_restrict (f : α →ₛ ℝ≥0) (s : set α) :
+  (f.restrict s).map (coe : ℝ≥0 → ℝ≥0∞) = (f.map coe).restrict s :=
+map_restrict_of_zero ennreal.coe_zero _ _
+
+theorem map_coe_nnreal_restrict (f : α →ₛ ℝ≥0) (s : set α) :
+  (f.restrict s).map (coe : ℝ≥0 → ℝ) = (f.map coe).restrict s :=
+map_restrict_of_zero nnreal.coe_zero _ _
+
+theorem restrict_apply (f : α →ₛ β) {s : set α} (hs : measurable_set s) (a) :
+  restrict f s a = indicator s f a :=
+by simp only [f.coe_restrict hs]
+
+theorem restrict_preimage (f : α →ₛ β) {s : set α} (hs : measurable_set s)
+  {t : set β} (ht : (0:β) ∉ t) : restrict f s ⁻¹' t = s ∩ f ⁻¹' t :=
+by simp [hs, indicator_preimage_of_not_mem _ _ ht, inter_comm]
+
+theorem restrict_preimage_singleton (f : α →ₛ β) {s : set α} (hs : measurable_set s)
+  {r : β} (hr : r ≠ 0) : restrict f s ⁻¹' {r} = s ∩ f ⁻¹' {r} :=
+f.restrict_preimage hs hr.symm
+
+lemma mem_restrict_range {r : β} {s : set α} {f : α →ₛ β} (hs : measurable_set s) :
+  r ∈ (restrict f s).range ↔ (r = 0 ∧ s ≠ univ) ∨ (r ∈ f '' s) :=
+by rw [← finset.mem_coe, coe_range, coe_restrict _ hs, mem_range_indicator]
+
+lemma mem_image_of_mem_range_restrict {r : β} {s : set α} {f : α →ₛ β}
+  (hr : r ∈ (restrict f s).range) (h0 : r ≠ 0) :
+  r ∈ f '' s :=
+if hs : measurable_set s then by simpa [mem_restrict_range hs, h0] using hr
+else by { rw [restrict_of_not_measurable hs] at hr,
+  exact (h0 $ eq_zero_of_mem_range_zero hr).elim }
+
+@[mono] lemma restrict_mono [preorder β] (s : set α) {f g : α →ₛ β} (H : f ≤ g) :
+  f.restrict s ≤ g.restrict s :=
+if hs : measurable_set s then λ x, by simp only [coe_restrict _ hs, indicator_le_indicator (H x)]
+else by simp only [restrict_of_not_measurable hs, le_refl]
+
+end restrict
+
+section approx
+
+section
+variables [semilattice_sup β] [order_bot β] [has_zero β]
+
+/-- Fix a sequence `i : ℕ → β`. Given a function `α → β`, its `n`-th approximation
+by simple functions is defined so that in case `β = ℝ≥0∞` it sends each `a` to the supremum
+of the set `{i k | k ≤ n ∧ i k ≤ f a}`, see `approx_apply` and `supr_approx_apply` for details. -/
+def approx (i : ℕ → β) (f : α → β) (n : ℕ) : α →ₛ β :=
+(finset.range n).sup (λk, restrict (const α (i k)) {a:α | i k ≤ f a})
+
+lemma approx_apply [topological_space β] [order_closed_topology β] [measurable_space β]
+  [opens_measurable_space β] {i : ℕ → β} {f : α → β} {n : ℕ} (a : α) (hf : measurable f) :
+  (approx i f n : α →ₛ β) a = (finset.range n).sup (λk, if i k ≤ f a then i k else 0) :=
+begin
+  dsimp only [approx],
+  rw [finset_sup_apply],
+  congr,
+  funext k,
+  rw [restrict_apply],
+  refl,
+  exact (hf measurable_set_Ici)
+end
+
+lemma monotone_approx (i : ℕ → β) (f : α → β) : monotone (approx i f) :=
+assume n m h, finset.sup_mono $ finset.range_subset.2 h
+
+lemma approx_comp [topological_space β] [order_closed_topology β] [measurable_space β]
+  [opens_measurable_space β] [measurable_space γ]
+  {i : ℕ → β} {f : γ → β} {g : α → γ} {n : ℕ} (a : α)
+  (hf : measurable f) (hg : measurable g) :
+  (approx i (f ∘ g) n : α →ₛ β) a = (approx i f n : γ →ₛ β) (g a) :=
+by rw [approx_apply _ hf, approx_apply _ (hf.comp hg)]
+
+end
+
+lemma supr_approx_apply [topological_space β] [complete_lattice β] [order_closed_topology β]
+  [has_zero β] [measurable_space β] [opens_measurable_space β]
+  (i : ℕ → β) (f : α → β) (a : α) (hf : measurable f) (h_zero : (0 : β) = ⊥) :
+  (⨆n, (approx i f n : α →ₛ β) a) = (⨆k (h : i k ≤ f a), i k) :=
+begin
+  refine le_antisymm (supr_le $ assume n, _) (supr_le $ assume k, supr_le $ assume hk, _),
+  { rw [approx_apply a hf, h_zero],
+    refine finset.sup_le (assume k hk, _),
+    split_ifs,
+    exact le_supr_of_le k (le_supr _ h),
+    exact bot_le },
+  { refine le_supr_of_le (k+1) _,
+    rw [approx_apply a hf],
+    have : k ∈ finset.range (k+1) := finset.mem_range.2 (nat.lt_succ_self _),
+    refine le_trans (le_of_eq _) (finset.le_sup this),
+    rw [if_pos hk] }
+end
+
+end approx
+
+section eapprox
+
+/-- A sequence of `ℝ≥0∞`s such that its range is the set of non-negative rational numbers. -/
+def ennreal_rat_embed (n : ℕ) : ℝ≥0∞ :=
+ennreal.of_real ((encodable.decode ℚ n).get_or_else (0 : ℚ))
+
+lemma ennreal_rat_embed_encode (q : ℚ) :
+  ennreal_rat_embed (encodable.encode q) = real.to_nnreal q :=
+by rw [ennreal_rat_embed, encodable.encodek]; refl
+
+/-- Approximate a function `α → ℝ≥0∞` by a sequence of simple functions. -/
+def eapprox : (α → ℝ≥0∞) → ℕ → α →ₛ ℝ≥0∞ :=
+approx ennreal_rat_embed
+
+lemma eapprox_lt_top (f : α → ℝ≥0∞) (n : ℕ) (a : α) : eapprox f n a < ∞ :=
+begin
+  simp only [eapprox, approx, finset_sup_apply, finset.sup_lt_iff, with_top.zero_lt_top,
+    finset.mem_range, ennreal.bot_eq_zero, restrict],
+  assume b hb,
+  split_ifs,
+  { simp only [coe_zero, coe_piecewise, piecewise_eq_indicator, coe_const],
+    calc {a : α | ennreal_rat_embed b ≤ f a}.indicator (λ x, ennreal_rat_embed b) a
+        ≤ ennreal_rat_embed b : indicator_le_self _ _ a
+    ... < ⊤ : ennreal.coe_lt_top },
+  { exact with_top.zero_lt_top },
+end
+
+@[mono] lemma monotone_eapprox (f : α → ℝ≥0∞) : monotone (eapprox f) :=
+monotone_approx _ f
+
+lemma supr_eapprox_apply (f : α → ℝ≥0∞) (hf : measurable f) (a : α) :
+  (⨆n, (eapprox f n : α →ₛ ℝ≥0∞) a) = f a :=
+begin
+  rw [eapprox, supr_approx_apply ennreal_rat_embed f a hf rfl],
+  refine le_antisymm (supr_le $ assume i, supr_le $ assume hi, hi) (le_of_not_gt _),
+  assume h,
+  rcases ennreal.lt_iff_exists_rat_btwn.1 h with ⟨q, hq, lt_q, q_lt⟩,
+  have : (real.to_nnreal q : ℝ≥0∞) ≤
+      (⨆ (k : ℕ) (h : ennreal_rat_embed k ≤ f a), ennreal_rat_embed k),
+  { refine le_supr_of_le (encodable.encode q) _,
+    rw [ennreal_rat_embed_encode q],
+    refine le_supr_of_le (le_of_lt q_lt) _,
+    exact le_rfl },
+  exact lt_irrefl _ (lt_of_le_of_lt this lt_q)
+end
+
+lemma eapprox_comp [measurable_space γ] {f : γ → ℝ≥0∞} {g : α → γ} {n : ℕ}
+  (hf : measurable f) (hg : measurable g) :
+  (eapprox (f ∘ g) n : α → ℝ≥0∞) = (eapprox f n : γ →ₛ ℝ≥0∞) ∘ g :=
+funext $ assume a, approx_comp a hf hg
+
+/-- Approximate a function `α → ℝ≥0∞` by a series of simple functions taking their values
+in `ℝ≥0`. -/
+def eapprox_diff (f : α → ℝ≥0∞) : ∀ (n : ℕ), α →ₛ ℝ≥0
+| 0 := (eapprox f 0).map ennreal.to_nnreal
+| (n+1) := (eapprox f (n+1) - eapprox f n).map ennreal.to_nnreal
+
+lemma sum_eapprox_diff (f : α → ℝ≥0∞) (n : ℕ) (a : α) :
+  (∑ k in finset.range (n+1), (eapprox_diff f k a : ℝ≥0∞)) = eapprox f n a :=
+begin
+  induction n with n IH,
+  { simp only [nat.nat_zero_eq_zero, finset.sum_singleton, finset.range_one], refl },
+  { rw [finset.sum_range_succ, nat.succ_eq_add_one, IH, eapprox_diff, coe_map, function.comp_app,
+        coe_sub, pi.sub_apply, ennreal.coe_to_nnreal,
+        add_tsub_cancel_of_le (monotone_eapprox f (nat.le_succ _) _)],
+    apply (lt_of_le_of_lt _ (eapprox_lt_top f (n+1) a)).ne,
+    rw tsub_le_iff_right,
+    exact le_self_add },
+end
+
+lemma tsum_eapprox_diff (f : α → ℝ≥0∞) (hf : measurable f) (a : α) :
+  (∑' n, (eapprox_diff f n a : ℝ≥0∞)) = f a :=
+by simp_rw [ennreal.tsum_eq_supr_nat' (tendsto_add_at_top_nat 1), sum_eapprox_diff,
+  supr_eapprox_apply f hf a]
+
+end eapprox
+
+end measurable
+
+section measure
+variables {m : measurable_space α} {μ ν : measure α}
+
+/-- Integral of a simple function whose codomain is `ℝ≥0∞`. -/
+def lintegral {m : measurable_space α} (f : α →ₛ ℝ≥0∞) (μ : measure α) : ℝ≥0∞ :=
+∑ x in f.range, x * μ (f ⁻¹' {x})
+
+lemma lintegral_eq_of_subset (f : α →ₛ ℝ≥0∞) {s : finset ℝ≥0∞}
+  (hs : ∀ x, f x ≠ 0 → μ (f ⁻¹' {f x}) ≠ 0 → f x ∈ s) :
+  f.lintegral μ = ∑ x in s, x * μ (f ⁻¹' {x}) :=
+begin
+  refine finset.sum_bij_ne_zero (λr _ _, r) _ _ _ _,
+  { simpa only [forall_range_iff, mul_ne_zero_iff, and_imp] },
+  { intros, assumption },
+  { intros b _ hb,
+    refine ⟨b, _, hb, rfl⟩,
+    rw [mem_range, ← preimage_singleton_nonempty],
+    exact nonempty_of_measure_ne_zero (mul_ne_zero_iff.1 hb).2 },
+  { intros, refl }
+end
+
+lemma lintegral_eq_of_subset' (f : α →ₛ ℝ≥0∞) {s : finset ℝ≥0∞}
+  (hs : f.range \ {0} ⊆ s) :
+  f.lintegral μ = ∑ x in s, x * μ (f ⁻¹' {x}) :=
+f.lintegral_eq_of_subset $ λ x hfx _, hs $
+  finset.mem_sdiff.2 ⟨f.mem_range_self x, mt finset.mem_singleton.1 hfx⟩
+
+/-- Calculate the integral of `(g ∘ f)`, where `g : β → ℝ≥0∞` and `f : α →ₛ β`.  -/
+lemma map_lintegral (g : β → ℝ≥0∞) (f : α →ₛ β) :
+  (f.map g).lintegral μ = ∑ x in f.range, g x * μ (f ⁻¹' {x}) :=
+begin
+  simp only [lintegral, range_map],
+  refine finset.sum_image' _ (assume b hb, _),
+  rcases mem_range.1 hb with ⟨a, rfl⟩,
+  rw [map_preimage_singleton, ← f.sum_measure_preimage_singleton, finset.mul_sum],
+  refine finset.sum_congr _ _,
+  { congr },
+  { assume x, simp only [finset.mem_filter], rintro ⟨_, h⟩, rw h },
+end
+
+lemma add_lintegral (f g : α →ₛ ℝ≥0∞) : (f + g).lintegral μ = f.lintegral μ + g.lintegral μ :=
+calc (f + g).lintegral μ =
+      ∑ x in (pair f g).range, (x.1 * μ (pair f g ⁻¹' {x}) + x.2 * μ (pair f g ⁻¹' {x})) :
+    by rw [add_eq_map₂, map_lintegral]; exact finset.sum_congr rfl (assume a ha, add_mul _ _ _)
+  ... = ∑ x in (pair f g).range, x.1 * μ (pair f g ⁻¹' {x}) +
+      ∑ x in (pair f g).range, x.2 * μ (pair f g ⁻¹' {x}) : by rw [finset.sum_add_distrib]
+  ... = ((pair f g).map prod.fst).lintegral μ + ((pair f g).map prod.snd).lintegral μ :
+    by rw [map_lintegral, map_lintegral]
+  ... = lintegral f μ + lintegral g μ : rfl
+
+lemma const_mul_lintegral (f : α →ₛ ℝ≥0∞) (x : ℝ≥0∞) :
+  (const α x * f).lintegral μ = x * f.lintegral μ :=
+calc (f.map (λa, x * a)).lintegral μ = ∑ r in f.range, x * r * μ (f ⁻¹' {r}) :
+    map_lintegral _ _
+  ... = ∑ r in f.range, x * (r * μ (f ⁻¹' {r})) :
+    finset.sum_congr rfl (assume a ha, mul_assoc _ _ _)
+  ... = x * f.lintegral μ :
+    finset.mul_sum.symm
+
+/-- Integral of a simple function `α →ₛ ℝ≥0∞` as a bilinear map. -/
+def lintegralₗ {m : measurable_space α} : (α →ₛ ℝ≥0∞) →ₗ[ℝ≥0∞] measure α →ₗ[ℝ≥0∞] ℝ≥0∞ :=
+{ to_fun := λ f,
+  { to_fun := lintegral f,
+    map_add' := by simp [lintegral, mul_add, finset.sum_add_distrib],
+    map_smul' := λ c μ, by simp [lintegral, mul_left_comm _ c, finset.mul_sum] },
+  map_add' := λ f g, linear_map.ext (λ μ, add_lintegral f g),
+  map_smul' := λ c f, linear_map.ext (λ μ, const_mul_lintegral f c) }
+
+@[simp] lemma zero_lintegral : (0 : α →ₛ ℝ≥0∞).lintegral μ = 0 :=
+linear_map.ext_iff.1 lintegralₗ.map_zero μ
+
+lemma lintegral_add {ν} (f : α →ₛ ℝ≥0∞) : f.lintegral (μ + ν) = f.lintegral μ + f.lintegral ν :=
+(lintegralₗ f).map_add μ ν
+
+lemma lintegral_smul (f : α →ₛ ℝ≥0∞) (c : ℝ≥0∞) :
+  f.lintegral (c • μ) = c • f.lintegral μ :=
+(lintegralₗ f).map_smul c μ
+
+@[simp] lemma lintegral_zero [measurable_space α] (f : α →ₛ ℝ≥0∞) :
+  f.lintegral 0 = 0 :=
+(lintegralₗ f).map_zero
+
+lemma lintegral_sum {m : measurable_space α} {ι} (f : α →ₛ ℝ≥0∞) (μ : ι → measure α) :
+  f.lintegral (measure.sum μ) = ∑' i, f.lintegral (μ i) :=
+begin
+  simp only [lintegral, measure.sum_apply, f.measurable_set_preimage, ← finset.tsum_subtype,
+    ← ennreal.tsum_mul_left],
+  apply ennreal.tsum_comm
+end
+
+lemma restrict_lintegral (f : α →ₛ ℝ≥0∞) {s : set α} (hs : measurable_set s) :
+  (restrict f s).lintegral μ = ∑ r in f.range, r * μ (f ⁻¹' {r} ∩ s) :=
+calc (restrict f s).lintegral μ = ∑ r in f.range, r * μ (restrict f s ⁻¹' {r}) :
+  lintegral_eq_of_subset _ $ λ x hx, if hxs : x ∈ s
+    then λ _, by simp only [f.restrict_apply hs, indicator_of_mem hxs, mem_range_self]
+    else false.elim $ hx $ by simp [*]
+... = ∑ r in f.range, r * μ (f ⁻¹' {r} ∩ s) :
+  finset.sum_congr rfl $ forall_range_iff.2 $ λ b, if hb : f b = 0 then by simp only [hb, zero_mul]
+    else by rw [restrict_preimage_singleton _ hs hb, inter_comm]
+
+lemma lintegral_restrict {m : measurable_space α} (f : α →ₛ ℝ≥0∞) (s : set α) (μ : measure α) :
+  f.lintegral (μ.restrict s) = ∑ y in f.range, y * μ (f ⁻¹' {y} ∩ s) :=
+by simp only [lintegral, measure.restrict_apply, f.measurable_set_preimage]
+
+lemma restrict_lintegral_eq_lintegral_restrict (f : α →ₛ ℝ≥0∞) {s : set α}
+  (hs : measurable_set s) :
+  (restrict f s).lintegral μ = f.lintegral (μ.restrict s) :=
+by rw [f.restrict_lintegral hs, lintegral_restrict]
+
+lemma const_lintegral (c : ℝ≥0∞) : (const α c).lintegral μ = c * μ univ :=
+begin
+  rw [lintegral],
+  casesI is_empty_or_nonempty α,
+  { simp [μ.eq_zero_of_is_empty] },
+  { simp [preimage_const_of_mem] },
+end
+
+lemma const_lintegral_restrict (c : ℝ≥0∞) (s : set α) :
+  (const α c).lintegral (μ.restrict s) = c * μ s :=
+by rw [const_lintegral, measure.restrict_apply measurable_set.univ, univ_inter]
+
+lemma restrict_const_lintegral (c : ℝ≥0∞) {s : set α} (hs : measurable_set s) :
+  ((const α c).restrict s).lintegral μ = c * μ s :=
+by rw [restrict_lintegral_eq_lintegral_restrict _ hs, const_lintegral_restrict]
+
+lemma le_sup_lintegral (f g : α →ₛ ℝ≥0∞) : f.lintegral μ ⊔ g.lintegral μ ≤ (f ⊔ g).lintegral μ :=
+calc f.lintegral μ ⊔ g.lintegral μ =
+      ((pair f g).map prod.fst).lintegral μ ⊔ ((pair f g).map prod.snd).lintegral μ : rfl
+  ... ≤ ∑ x in (pair f g).range, (x.1 ⊔ x.2) * μ (pair f g ⁻¹' {x}) :
+  begin
+    rw [map_lintegral, map_lintegral],
+    refine sup_le _ _;
+      refine finset.sum_le_sum (λ a _, mul_le_mul_right' _ _),
+    exact le_sup_left,
+    exact le_sup_right
+  end
+  ... = (f ⊔ g).lintegral μ : by rw [sup_eq_map₂, map_lintegral]
+
+/-- `simple_func.lintegral` is monotone both in function and in measure. -/
+@[mono] lemma lintegral_mono {f g : α →ₛ ℝ≥0∞} (hfg : f ≤ g) (hμν : μ ≤ ν) :
+  f.lintegral μ ≤ g.lintegral ν :=
+calc f.lintegral μ ≤ f.lintegral μ ⊔ g.lintegral μ : le_sup_left
+  ... ≤ (f ⊔ g).lintegral μ : le_sup_lintegral _ _
+  ... = g.lintegral μ : by rw [sup_of_le_right hfg]
+  ... ≤ g.lintegral ν : finset.sum_le_sum $ λ y hy, ennreal.mul_left_mono $
+                          hμν _ (g.measurable_set_preimage _)
+
+/-- `simple_func.lintegral` depends only on the measures of `f ⁻¹' {y}`. -/
+lemma lintegral_eq_of_measure_preimage [measurable_space β] {f : α →ₛ ℝ≥0∞} {g : β →ₛ ℝ≥0∞}
+  {ν : measure β} (H : ∀ y, μ (f ⁻¹' {y}) = ν (g ⁻¹' {y})) :
+  f.lintegral μ = g.lintegral ν :=
+begin
+  simp only [lintegral, ← H],
+  apply lintegral_eq_of_subset,
+  simp only [H],
+  intros,
+  exact mem_range_of_measure_ne_zero ‹_›
+end
+
+/-- If two simple functions are equal a.e., then their `lintegral`s are equal. -/
+lemma lintegral_congr {f g : α →ₛ ℝ≥0∞} (h : f =ᵐ[μ] g) :
+  f.lintegral μ = g.lintegral μ :=
+lintegral_eq_of_measure_preimage $ λ y, measure_congr $
+  eventually.set_eq $ h.mono $ λ x hx, by simp [hx]
+
+lemma lintegral_map' {β} [measurable_space β] {μ' : measure β} (f : α →ₛ ℝ≥0∞) (g : β →ₛ ℝ≥0∞)
+  (m' : α → β) (eq : ∀ a, f a = g (m' a)) (h : ∀s, measurable_set s → μ' s = μ (m' ⁻¹' s)) :
+  f.lintegral μ = g.lintegral μ' :=
+lintegral_eq_of_measure_preimage $ λ y,
+by { simp only [preimage, eq], exact (h (g ⁻¹' {y}) (g.measurable_set_preimage _)).symm }
+
+lemma lintegral_map {β} [measurable_space β] (g : β →ₛ ℝ≥0∞) {f : α → β} (hf : measurable f) :
+  g.lintegral (measure.map f μ) = (g.comp f hf).lintegral μ :=
+eq.symm $ lintegral_map' _ _ f (λ a, rfl) (λ s hs, measure.map_apply hf hs)
+
+end measure
+
+section fin_meas_supp
+
+open finset function
+
+lemma support_eq [measurable_space α] [has_zero β] (f : α →ₛ β) :
+  support f = ⋃ y ∈ f.range.filter (λ y, y ≠ 0), f ⁻¹' {y} :=
+set.ext $ λ x, by simp only [mem_support, set.mem_preimage, mem_filter, mem_range_self, true_and,
+  exists_prop, mem_Union, set.mem_range, mem_singleton_iff, exists_eq_right']
+
+variables {m : measurable_space α} [has_zero β] [has_zero γ] {μ : measure α} {f : α →ₛ β}
+
+lemma measurable_set_support [measurable_space α] (f : α →ₛ β) : measurable_set (support f) :=
+by { rw f.support_eq, exact finset.measurable_set_bUnion _ (λ y hy, measurable_set_fiber _ _), }
+
+/-- A `simple_func` has finite measure support if it is equal to `0` outside of a set of finite
+measure. -/
+protected def fin_meas_supp {m : measurable_space α} (f : α →ₛ β) (μ : measure α) : Prop :=
+f =ᶠ[μ.cofinite] 0
+
+lemma fin_meas_supp_iff_support : f.fin_meas_supp μ ↔ μ (support f) < ∞ := iff.rfl
+
+lemma fin_meas_supp_iff : f.fin_meas_supp μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞ :=
+begin
+  split,
+  { refine λ h y hy, lt_of_le_of_lt (measure_mono _) h,
+    exact λ x hx (H : f x = 0), hy $ H ▸ eq.symm hx },
+  { intro H,
+    rw [fin_meas_supp_iff_support, support_eq],
+    refine lt_of_le_of_lt (measure_bUnion_finset_le _ _) (sum_lt_top _),
+    exact λ y hy, (H y (finset.mem_filter.1 hy).2).ne }
+end
+
+namespace fin_meas_supp
+
+lemma meas_preimage_singleton_ne_zero (h : f.fin_meas_supp μ) {y : β} (hy : y ≠ 0) :
+  μ (f ⁻¹' {y}) < ∞ :=
+fin_meas_supp_iff.1 h y hy
+
+protected lemma map {g : β → γ} (hf : f.fin_meas_supp μ) (hg : g 0 = 0) :
+  (f.map g).fin_meas_supp μ :=
+flip lt_of_le_of_lt hf (measure_mono $ support_comp_subset hg f)
+
+lemma of_map {g : β → γ} (h : (f.map g).fin_meas_supp μ) (hg : ∀b, g b = 0 → b = 0) :
+  f.fin_meas_supp μ :=
+flip lt_of_le_of_lt h $ measure_mono $ support_subset_comp hg _
+
+lemma map_iff {g : β → γ} (hg : ∀ {b}, g b = 0 ↔ b = 0) :
+  (f.map g).fin_meas_supp μ ↔ f.fin_meas_supp μ :=
+⟨λ h, h.of_map $ λ b, hg.1, λ h, h.map $ hg.2 rfl⟩
+
+protected lemma pair {g : α →ₛ γ} (hf : f.fin_meas_supp μ) (hg : g.fin_meas_supp μ) :
+  (pair f g).fin_meas_supp μ :=
+calc μ (support $ pair f g) = μ (support f ∪ support g) : congr_arg μ $ support_prod_mk f g
+... ≤ μ (support f) + μ (support g) : measure_union_le _ _
+... < _ : add_lt_top.2 ⟨hf, hg⟩
+
+protected lemma map₂ [has_zero δ] (hf : f.fin_meas_supp μ)
+  {g : α →ₛ γ} (hg : g.fin_meas_supp μ) {op : β → γ → δ} (H : op 0 0 = 0) :
+  ((pair f g).map (function.uncurry op)).fin_meas_supp μ :=
+(hf.pair hg).map H
+
+protected lemma add {β} [add_monoid β] {f g : α →ₛ β} (hf : f.fin_meas_supp μ)
+  (hg : g.fin_meas_supp μ) :
+  (f + g).fin_meas_supp μ :=
+by { rw [add_eq_map₂], exact hf.map₂ hg (zero_add 0) }
+
+protected lemma mul {β} [monoid_with_zero β] {f g : α →ₛ β} (hf : f.fin_meas_supp μ)
+  (hg : g.fin_meas_supp μ) :
+  (f * g).fin_meas_supp μ :=
+by { rw [mul_eq_map₂], exact hf.map₂ hg (zero_mul 0) }
+
+lemma lintegral_lt_top {f : α →ₛ ℝ≥0∞} (hm : f.fin_meas_supp μ) (hf : ∀ᵐ a ∂μ, f a ≠ ∞) :
+  f.lintegral μ < ∞ :=
+begin
+  refine sum_lt_top (λ a ha, _),
+  rcases eq_or_ne a ∞ with rfl|ha,
+  { simp only [ae_iff, ne.def, not_not] at hf,
+    simp [set.preimage, hf] },
+  { by_cases ha0 : a = 0,
+    { subst a, rwa [zero_mul] },
+    { exact mul_ne_top ha (fin_meas_supp_iff.1 hm _ ha0).ne } }
+end
+
+lemma of_lintegral_ne_top {f : α →ₛ ℝ≥0∞} (h : f.lintegral μ ≠ ∞) : f.fin_meas_supp μ :=
+begin
+  refine fin_meas_supp_iff.2 (λ b hb, _),
+  rw [f.lintegral_eq_of_subset' (finset.subset_insert b _)] at h,
+  refine ennreal.lt_top_of_mul_ne_top_right _ hb,
+  exact (lt_top_of_sum_ne_top h (finset.mem_insert_self _ _)).ne
+end
+
+lemma iff_lintegral_lt_top {f : α →ₛ ℝ≥0∞} (hf : ∀ᵐ a ∂μ, f a ≠ ∞) :
+  f.fin_meas_supp μ ↔ f.lintegral μ < ∞ :=
+⟨λ h, h.lintegral_lt_top hf, λ h, of_lintegral_ne_top h.ne⟩
+
+end fin_meas_supp
+
+end fin_meas_supp
+
+/-- To prove something for an arbitrary simple function, it suffices to show
+that the property holds for (multiples of) characteristic functions and is closed under
+addition (of functions with disjoint support).
+
+It is possible to make the hypotheses in `h_add` a bit stronger, and such conditions can be added
+once we need them (for example it is only necessary to consider the case where `g` is a multiple
+of a characteristic function, and that this multiple doesn't appear in the image of `f`) -/
+@[elab_as_eliminator]
+protected lemma induction {α γ} [measurable_space α] [add_monoid γ] {P : simple_func α γ → Prop}
+  (h_ind : ∀ c {s} (hs : measurable_set s),
+    P (simple_func.piecewise s hs (simple_func.const _ c) (simple_func.const _ 0)))
+  (h_add : ∀ ⦃f g : simple_func α γ⦄, disjoint (support f) (support g) → P f → P g → P (f + g))
+  (f : simple_func α γ) : P f :=
+begin
+  generalize' h : f.range \ {0} = s,
+  rw [← finset.coe_inj, finset.coe_sdiff, finset.coe_singleton, simple_func.coe_range] at h,
+  revert s f h, refine finset.induction _ _,
+  { intros f hf, rw [finset.coe_empty, diff_eq_empty, range_subset_singleton] at hf,
+    convert h_ind 0 measurable_set.univ, ext x, simp [hf] },
+  { intros x s hxs ih f hf,
+    have mx := f.measurable_set_preimage {x},
+    let g := simple_func.piecewise (f ⁻¹' {x}) mx 0 f,
+    have Pg : P g,
+    { apply ih, simp only [g, simple_func.coe_piecewise, range_piecewise],
+      rw [image_compl_preimage, union_diff_distrib, diff_diff_comm, hf, finset.coe_insert,
+        insert_diff_self_of_not_mem, diff_eq_empty.mpr, set.empty_union],
+      { rw [set.image_subset_iff], convert set.subset_univ _,
+        exact preimage_const_of_mem (mem_singleton _) },
+      { rwa [finset.mem_coe] }},
+    convert h_add _ Pg (h_ind x mx),
+    { ext1 y, by_cases hy : y ∈ f ⁻¹' {x}; [simpa [hy], simp [hy]] },
+    rw disjoint_iff_inf_le,
+    rintro y, by_cases hy : y ∈ f ⁻¹' {x}; simp [hy] }
+end
+
+end simple_func
+
+end measure_theory
+
+open measure_theory measure_theory.simple_func
+/-- To prove something for an arbitrary measurable function into `ℝ≥0∞`, it suffices to show
+that the property holds for (multiples of) characteristic functions and is closed under addition
+and supremum of increasing sequences of functions.
+
+It is possible to make the hypotheses in the induction steps a bit stronger, and such conditions
+can be added once we need them (for example in `h_add` it is only necessary to consider the sum of
+a simple function with a multiple of a characteristic function and that the intersection
+of their images is a subset of `{0}`. -/
+@[elab_as_eliminator]
+theorem measurable.ennreal_induction {α} [measurable_space α] {P : (α → ℝ≥0∞) → Prop}
+  (h_ind : ∀ (c : ℝ≥0∞) ⦃s⦄, measurable_set s → P (indicator s (λ _, c)))
+  (h_add : ∀ ⦃f g : α → ℝ≥0∞⦄, disjoint (support f) (support g) → measurable f → measurable g →
+    P f → P g → P (f + g))
+  (h_supr : ∀ ⦃f : ℕ → α → ℝ≥0∞⦄ (hf : ∀n, measurable (f n)) (h_mono : monotone f)
+    (hP : ∀ n, P (f n)), P (λ x, ⨆ n, f n x))
+  ⦃f : α → ℝ≥0∞⦄ (hf : measurable f) : P f :=
+begin
+  convert h_supr (λ n, (eapprox f n).measurable) (monotone_eapprox f) _,
+  { ext1 x, rw [supr_eapprox_apply f hf] },
+  { exact λ n, simple_func.induction (λ c s hs, h_ind c hs)
+      (λ f g hfg hf hg, h_add hfg f.measurable g.measurable hf hg) (eapprox f n) }
+end
diff --git a/src/measure_theory/function/simple_func_dense.lean b/src/measure_theory/function/simple_func_dense.lean
index 8918b5a124759..25fcda5f6fa32 100644
--- a/src/measure_theory/function/simple_func_dense.lean
+++ b/src/measure_theory/function/simple_func_dense.lean
@@ -3,13 +3,14 @@ Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou, Yury Kudryashov, Heather Macbeth
 -/
-import measure_theory.integral.mean_inequalities
-import topology.continuous_function.compact
-import topology.metric_space.metrizable
+import measure_theory.function.simple_func
 
 /-!
 # Density of simple functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Show that each Borel measurable function can be approximated pointwise
 by a sequence of simple functions.
 
@@ -33,7 +34,7 @@ by a sequence of simple functions.
 -/
 
 open set function filter topological_space ennreal emetric finset
-open_locale classical topological_space ennreal measure_theory big_operators
+open_locale classical topology ennreal measure_theory big_operators
 variables {α β ι E F 𝕜 : Type*}
 
 noncomputable theory
@@ -46,7 +47,7 @@ namespace simple_func
 
 /-! ### Pointwise approximation by simple functions -/
 
-variables [measurable_space α] [emetric_space α] [opens_measurable_space α]
+variables [measurable_space α] [pseudo_emetric_space α] [opens_measurable_space α]
 
 /-- `nearest_pt_ind e N x` is the index `k` such that `e k` is the nearest point to `x` among the
 points `e 0`, ..., `e N`. If more than one point are at the same distance from `x`, then
@@ -54,7 +55,7 @@ points `e 0`, ..., `e N`. If more than one point are at the same distance from `
 noncomputable def nearest_pt_ind (e : ℕ → α) : ℕ → α →ₛ ℕ
 | 0 := const α 0
 | (N + 1) := piecewise (⋂ k ≤ N, {x | edist (e (N + 1)) x < edist (e k) x})
-    (measurable_set.Inter $ λ k, measurable_set.Inter_Prop $ λ hk,
+    (measurable_set.Inter $ λ k, measurable_set.Inter $ λ hk,
       measurable_set_lt measurable_edist_right measurable_edist_right)
     (const α $ N + 1) (nearest_pt_ind N)
 
diff --git a/src/measure_theory/function/simple_func_dense_lp.lean b/src/measure_theory/function/simple_func_dense_lp.lean
index f30c330a0f56e..e67f84473c68a 100644
--- a/src/measure_theory/function/simple_func_dense_lp.lean
+++ b/src/measure_theory/function/simple_func_dense_lp.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou, Yury Kudryashov, Heather Macbeth
 -/
 import measure_theory.function.l1_space
-import measure_theory.function.lp_order
 import measure_theory.function.simple_func_dense
 
 /-!
 # Density of simple functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Show that each `Lᵖ` Borel measurable function can be approximated in `Lᵖ` norm
 by a sequence of simple functions.
 
@@ -20,9 +22,10 @@ by a sequence of simple functions.
 
 ## Main results
 
-* `tendsto_approx_on_univ_Lp` (Lᵖ convergence): If `E` is a `normed_group` and `f` is measurable
-  and `mem_ℒp` (for `p < ∞`), then the simple functions `simple_func.approx_on f hf s 0 h₀ n` may
-  be considered as elements of `Lp E p μ`, and they tend in Lᵖ to `f`.
+* `tendsto_approx_on_univ_Lp` (Lᵖ convergence): If `E` is a `normed_add_comm_group` and `f` is
+  measurable and `mem_ℒp` (for `p < ∞`), then the simple functions
+  `simple_func.approx_on f hf s 0 h₀ n` may be considered as elements of `Lp E p μ`, and they tend
+  in Lᵖ to `f`.
 * `Lp.simple_func.dense_embedding`: the embedding `coe_to_Lp` of the `Lp` simple functions into
   `Lp` is dense.
 * `Lp.simple_func.induction`, `Lp.induction`, `mem_ℒp.induction`, `integrable.induction`: to prove
@@ -41,7 +44,7 @@ For `E` finite-dimensional, simple functions `α →ₛ E` are dense in L^∞ --
 
 noncomputable theory
 open set function filter topological_space ennreal emetric finset
-open_locale classical topological_space ennreal measure_theory big_operators
+open_locale classical topology ennreal measure_theory big_operators
 variables {α β ι E F 𝕜 : Type*}
 
 namespace measure_theory
@@ -53,12 +56,12 @@ namespace simple_func
 /-! ### Lp approximation by simple functions -/
 
 section Lp
-variables [measurable_space β]
-variables [measurable_space E] [normed_group E] [normed_group F] {q : ℝ} {p : ℝ≥0∞}
+variables [measurable_space β] [measurable_space E] [normed_add_comm_group E]
+  [normed_add_comm_group F] {q : ℝ} {p : ℝ≥0∞}
 
 lemma nnnorm_approx_on_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
   {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s] (x : β) (n : ℕ) :
-  ∥approx_on f hf s y₀ h₀ n x - f x∥₊ ≤ ∥f x - y₀∥₊ :=
+  ‖approx_on f hf s y₀ h₀ n x - f x‖₊ ≤ ‖f x - y₀‖₊ :=
 begin
   have := edist_approx_on_le hf h₀ x n,
   rw edist_comm y₀ at this,
@@ -68,7 +71,7 @@ end
 
 lemma norm_approx_on_y₀_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
   {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s] (x : β) (n : ℕ) :
-  ∥approx_on f hf s y₀ h₀ n x - y₀∥ ≤ ∥f x - y₀∥ + ∥f x - y₀∥ :=
+  ‖approx_on f hf s y₀ h₀ n x - y₀‖ ≤ ‖f x - y₀‖ + ‖f x - y₀‖ :=
 begin
   have := edist_approx_on_y0_le hf h₀ x n,
   repeat { rw [edist_comm y₀, edist_eq_coe_nnnorm_sub] at this },
@@ -77,7 +80,7 @@ end
 
 lemma norm_approx_on_zero_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
   {s : set E} (h₀ : (0 : E) ∈ s) [separable_space s] (x : β) (n : ℕ) :
-  ∥approx_on f hf s 0 h₀ n x∥ ≤ ∥f x∥ + ∥f x∥ :=
+  ‖approx_on f hf s 0 h₀ n x‖ ≤ ‖f x‖ + ‖f x‖ :=
 begin
   have := edist_approx_on_y0_le hf h₀ x n,
   simp [edist_comm (0 : E), edist_eq_coe_nnnorm] at this,
@@ -93,29 +96,29 @@ begin
   by_cases hp_zero : p = 0,
   { simpa only [hp_zero, snorm_exponent_zero] using tendsto_const_nhds },
   have hp : 0 < p.to_real := to_real_pos hp_zero hp_ne_top,
-  suffices : tendsto (λ n, ∫⁻ x, ∥approx_on f hf s y₀ h₀ n x - f x∥₊ ^ p.to_real ∂μ) at_top (𝓝 0),
+  suffices : tendsto (λ n, ∫⁻ x, ‖approx_on f hf s y₀ h₀ n x - f x‖₊ ^ p.to_real ∂μ) at_top (𝓝 0),
   { simp only [snorm_eq_lintegral_rpow_nnnorm hp_zero hp_ne_top],
     convert continuous_rpow_const.continuous_at.tendsto.comp this;
     simp [_root_.inv_pos.mpr hp] },
   -- We simply check the conditions of the Dominated Convergence Theorem:
   -- (1) The function "`p`-th power of distance between `f` and the approximation" is measurable
-  have hF_meas : ∀ n, measurable (λ x, (∥approx_on f hf s y₀ h₀ n x - f x∥₊ : ℝ≥0∞) ^ p.to_real),
+  have hF_meas : ∀ n, measurable (λ x, (‖approx_on f hf s y₀ h₀ n x - f x‖₊ : ℝ≥0∞) ^ p.to_real),
   { simpa only [← edist_eq_coe_nnnorm_sub] using
       λ n, (approx_on f hf s y₀ h₀ n).measurable_bind (λ y x, (edist y (f x)) ^ p.to_real)
       (λ y, (measurable_edist_right.comp hf).pow_const p.to_real) },
   -- (2) The functions "`p`-th power of distance between `f` and the approximation" are uniformly
-  -- bounded, at any given point, by `λ x, ∥f x - y₀∥ ^ p.to_real`
-  have h_bound : ∀ n, (λ x, (∥approx_on f hf s y₀ h₀ n x - f x∥₊ : ℝ≥0∞) ^ p.to_real)
-      ≤ᵐ[μ] (λ x, ∥f x - y₀∥₊ ^ p.to_real),
+  -- bounded, at any given point, by `λ x, ‖f x - y₀‖ ^ p.to_real`
+  have h_bound : ∀ n, (λ x, (‖approx_on f hf s y₀ h₀ n x - f x‖₊ : ℝ≥0∞) ^ p.to_real)
+      ≤ᵐ[μ] (λ x, ‖f x - y₀‖₊ ^ p.to_real),
   { exact λ n, eventually_of_forall
       (λ x, rpow_le_rpow (coe_mono (nnnorm_approx_on_le hf h₀ x n)) to_real_nonneg) },
-  -- (3) The bounding function `λ x, ∥f x - y₀∥ ^ p.to_real` has finite integral
-  have h_fin :  ∫⁻ (a : β), ∥f a - y₀∥₊ ^ p.to_real ∂μ ≠ ⊤,
+  -- (3) The bounding function `λ x, ‖f x - y₀‖ ^ p.to_real` has finite integral
+  have h_fin :  ∫⁻ (a : β), ‖f a - y₀‖₊ ^ p.to_real ∂μ ≠ ⊤,
     from (lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top hp_zero hp_ne_top hi).ne,
   -- (4) The functions "`p`-th power of distance between `f` and the approximation" tend pointwise
   -- to zero
   have h_lim : ∀ᵐ (a : β) ∂μ,
-    tendsto (λ n, (∥approx_on f hf s y₀ h₀ n a - f a∥₊ : ℝ≥0∞) ^ p.to_real) at_top (𝓝 0),
+    tendsto (λ n, (‖approx_on f hf s y₀ h₀ n a - f a‖₊ : ℝ≥0∞) ^ p.to_real) at_top (𝓝 0),
   { filter_upwards [hμ] with a ha,
     have : tendsto (λ n, (approx_on f hf s y₀ h₀ n) a - f a) at_top (𝓝 (f a - f a)),
     { exact (tendsto_approx_on hf h₀ ha).sub tendsto_const_nhds },
@@ -137,8 +140,8 @@ begin
     convert snorm_add_lt_top this hi₀,
     ext x,
     simp },
-  have hf' : mem_ℒp (λ x, ∥f x - y₀∥) p μ,
-  { have h_meas : measurable (λ x, ∥f x - y₀∥),
+  have hf' : mem_ℒp (λ x, ‖f x - y₀‖) p μ,
+  { have h_meas : measurable (λ x, ‖f x - y₀‖),
     { simp only [← dist_eq_norm],
       exact (continuous_id.dist continuous_const).measurable.comp fmeas },
     refine ⟨h_meas.ae_measurable.ae_strongly_measurable, _⟩,
@@ -146,14 +149,14 @@ begin
     convert snorm_add_lt_top hf hi₀.neg,
     ext x,
     simp [sub_eq_add_neg] },
-  have : ∀ᵐ x ∂μ, ∥approx_on f fmeas s y₀ h₀ n x - y₀∥ ≤ ∥(∥f x - y₀∥ + ∥f x - y₀∥)∥,
+  have : ∀ᵐ x ∂μ, ‖approx_on f fmeas s y₀ h₀ n x - y₀‖ ≤ ‖(‖f x - y₀‖ + ‖f x - y₀‖)‖,
   { refine eventually_of_forall _,
     intros x,
     convert norm_approx_on_y₀_le fmeas h₀ x n,
     rw [real.norm_eq_abs, abs_of_nonneg],
     exact add_nonneg (norm_nonneg _) (norm_nonneg _) },
   calc snorm (λ x, approx_on f fmeas s y₀ h₀ n x - y₀) p μ
-      ≤ snorm (λ x, ∥f x - y₀∥ + ∥f x - y₀∥) p μ : snorm_mono_ae this
+      ≤ snorm (λ x, ‖f x - y₀‖ + ‖f x - y₀‖) p μ : snorm_mono_ae this
   ... < ⊤ : snorm_add_lt_top hf' hf',
 end
 
@@ -186,18 +189,43 @@ lemma tendsto_approx_on_range_Lp [borel_space E]
 by simpa only [Lp.tendsto_Lp_iff_tendsto_ℒp'']
   using tendsto_approx_on_range_Lp_snorm hp_ne_top fmeas hf.2
 
+/-- Any function in `ℒp` can be approximated by a simple function if `p < ∞`. -/
+lemma _root_.measure_theory.mem_ℒp.exists_simple_func_snorm_sub_lt
+  {E : Type*} [normed_add_comm_group E]
+  {f : β → E} {μ : measure β} (hf : mem_ℒp f p μ) (hp_ne_top : p ≠ ∞) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (g : β →ₛ E), snorm (f - g) p μ < ε ∧ mem_ℒp g p μ :=
+begin
+  borelize E,
+  let f' := hf.1.mk f,
+  suffices H : ∃ (g : β →ₛ E), snorm (f' - g) p μ < ε ∧ mem_ℒp g p μ,
+  { rcases H with ⟨g, hg, g_mem⟩,
+    refine ⟨g, _, g_mem⟩,
+    convert hg using 1,
+    apply snorm_congr_ae,
+    filter_upwards [hf.1.ae_eq_mk] with x hx,
+    simpa only [pi.sub_apply, sub_left_inj] using hx },
+  have hf' : mem_ℒp f' p μ, from hf.ae_eq hf.1.ae_eq_mk,
+  have f'meas : measurable f' := hf.1.measurable_mk,
+  haveI : separable_space (range f' ∪ {0} : set E),
+    from strongly_measurable.separable_space_range_union_singleton hf.1.strongly_measurable_mk,
+  rcases ((tendsto_order.1 (tendsto_approx_on_range_Lp_snorm hp_ne_top f'meas hf'.2)).2
+    ε hε.bot_lt).exists with ⟨n, hn⟩,
+  rw [← snorm_neg, neg_sub] at hn,
+  exact ⟨_, hn, mem_ℒp_approx_on_range f'meas hf' _⟩,
+end
+
 end Lp
 
 /-! ### L1 approximation by simple functions -/
 
 section integrable
 variables [measurable_space β]
-variables [measurable_space E] [normed_group E]
+variables [measurable_space E] [normed_add_comm_group E]
 
 lemma tendsto_approx_on_L1_nnnorm [opens_measurable_space E]
   {f : β → E} (hf : measurable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s]
   {μ : measure β} (hμ : ∀ᵐ x ∂μ, f x ∈ closure s) (hi : has_finite_integral (λ x, f x - y₀) μ) :
-  tendsto (λ n, ∫⁻ x, ∥approx_on f hf s y₀ h₀ n x - f x∥₊ ∂μ) at_top (𝓝 0) :=
+  tendsto (λ n, ∫⁻ x, ‖approx_on f hf s y₀ h₀ n x - f x‖₊ ∂μ) at_top (𝓝 0) :=
 by simpa [snorm_one_eq_lintegral_nnnorm] using tendsto_approx_on_Lp_snorm hf h₀ one_ne_top hμ
   (by simpa [snorm_one_eq_lintegral_nnnorm] using hi)
 
@@ -214,7 +242,7 @@ end
 lemma tendsto_approx_on_range_L1_nnnorm [opens_measurable_space E]
   {f : β → E} {μ : measure β} [separable_space (range f ∪ {0} : set E)]
   (fmeas : measurable f) (hf : integrable f μ) :
-  tendsto (λ n, ∫⁻ x, ∥approx_on f fmeas (range f ∪ {0}) 0 (by simp) n x - f x∥₊ ∂μ)
+  tendsto (λ n, ∫⁻ x, ‖approx_on f fmeas (range f ∪ {0}) 0 (by simp) n x - f x‖₊ ∂μ)
     at_top (𝓝 0) :=
 begin
   apply tendsto_approx_on_L1_nnnorm fmeas,
@@ -236,7 +264,7 @@ end integrable
 section simple_func_properties
 
 variables [measurable_space α]
-variables [normed_group E] [normed_group F]
+variables [normed_add_comm_group E] [normed_add_comm_group F]
 variables {μ : measure α} {p : ℝ≥0∞}
 
 /-!
@@ -248,8 +276,8 @@ A simple function `f : α →ₛ E` into a normed group `E` verifies, for a meas
   `mem_ℒp f p μ ↔ integrable f μ ↔ f.fin_meas_supp μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞`.
 -/
 
-lemma exists_forall_norm_le (f : α →ₛ F) : ∃ C, ∀ x, ∥f x∥ ≤ C :=
-exists_forall_le (f.map (λ x, ∥x∥))
+lemma exists_forall_norm_le (f : α →ₛ F) : ∃ C, ∀ x, ‖f x‖ ≤ C :=
+exists_forall_le (f.map (λ x, ‖x‖))
 
 lemma mem_ℒp_zero (f : α →ₛ E) (μ : measure α) : mem_ℒp f 0 μ :=
 mem_ℒp_zero_iff_ae_strongly_measurable.mpr f.ae_strongly_measurable
@@ -259,8 +287,8 @@ let ⟨C, hfC⟩ := f.exists_forall_norm_le in
 mem_ℒp_top_of_bound f.ae_strongly_measurable C $ eventually_of_forall hfC
 
 protected lemma snorm'_eq {p : ℝ} (f : α →ₛ F) (μ : measure α) :
-  snorm' f p μ = (∑ y in f.range, (∥y∥₊ : ℝ≥0∞) ^ p * μ (f ⁻¹' {y})) ^ (1/p) :=
-have h_map : (λ a, (∥f a∥₊ : ℝ≥0∞) ^ p) = f.map (λ a : F, (∥a∥₊ : ℝ≥0∞) ^ p), by simp,
+  snorm' f p μ = (∑ y in f.range, (‖y‖₊ : ℝ≥0∞) ^ p * μ (f ⁻¹' {y})) ^ (1/p) :=
+have h_map : (λ a, (‖f a‖₊ : ℝ≥0∞) ^ p) = f.map (λ a : F, (‖a‖₊ : ℝ≥0∞) ^ p), by simp,
 by rw [snorm', h_map, lintegral_eq_lintegral, map_lintegral]
 
 lemma measure_preimage_lt_top_of_mem_ℒp (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) (f : α →ₛ E)
@@ -278,7 +306,7 @@ begin
   { suffices h_empty : f ⁻¹' {y} = ∅,
       by { rw [h_empty, measure_empty], exact ennreal.coe_lt_top, },
     ext1 x,
-    rw [set.mem_preimage, set.mem_singleton_iff, mem_empty_eq, iff_false],
+    rw [set.mem_preimage, set.mem_singleton_iff, mem_empty_iff_false, iff_false],
     refine λ hxy, hyf _,
     rw [mem_range, set.mem_range],
     exact ⟨x, hxy⟩, },
@@ -314,7 +342,7 @@ lemma mem_ℒp_iff {f : α →ₛ E} (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞)
   λ h, mem_ℒp_of_finite_measure_preimage p h⟩
 
 lemma integrable_iff {f : α →ₛ E} : integrable f μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞ :=
-mem_ℒp_one_iff_integrable.symm.trans $ mem_ℒp_iff ennreal.zero_lt_one.ne' ennreal.coe_ne_top
+mem_ℒp_one_iff_integrable.symm.trans $ mem_ℒp_iff one_ne_zero ennreal.coe_ne_top
 
 lemma mem_ℒp_iff_integrable {f : α →ₛ E} (hp_pos : p ≠ 0) (hp_ne_top : p ≠ ∞) :
   mem_ℒp f p μ ↔ integrable f μ :=
@@ -384,7 +412,8 @@ namespace Lp
 
 open ae_eq_fun
 
-variables [measurable_space α] [normed_group E] [normed_group F] (p : ℝ≥0∞) (μ : measure α)
+variables [measurable_space α] [normed_add_comm_group E] [normed_add_comm_group F] (p : ℝ≥0∞)
+  (μ : measure α)
 
 variables (E)
 
@@ -395,9 +424,11 @@ def simple_func : add_subgroup (Lp E p μ) :=
                 ∃ (s : α →ₛ E), (ae_eq_fun.mk s s.ae_strongly_measurable : α →ₘ[μ] E) = f},
   zero_mem' := ⟨0, rfl⟩,
   add_mem' := λ f g ⟨s, hs⟩ ⟨t, ht⟩, ⟨s + t,
-      by simp only [←hs, ←ht, mk_add_mk, add_subgroup.coe_add, mk_eq_mk, simple_func.coe_add]⟩,
+      by simp only [←hs, ←ht, ae_eq_fun.mk_add_mk, add_subgroup.coe_add, ae_eq_fun.mk_eq_mk,
+        simple_func.coe_add]⟩,
   neg_mem' := λ f ⟨s, hs⟩, ⟨-s,
-      by simp only [←hs, neg_mk, simple_func.coe_neg, mk_eq_mk, add_subgroup.coe_neg]⟩ }
+      by simp only [←hs, ae_eq_fun.neg_mk, simple_func.coe_neg, ae_eq_fun.mk_eq_mk,
+        add_subgroup.coe_neg]⟩ }
 
 variables {E p μ}
 
@@ -417,20 +448,20 @@ unnecessary.  But instead, `Lp.simple_func E p μ` is defined as an `add_subgrou
 which does not permit this (but has the advantage of working when `E` itself is a normed group,
 i.e. has no scalar action). -/
 
-variables [normed_field 𝕜] [normed_space 𝕜 E]
+variables [normed_ring 𝕜] [module 𝕜 E] [has_bounded_smul 𝕜 E]
 
-/-- If `E` is a normed space, `Lp.simple_func E p μ` is a `has_scalar`. Not declared as an
+/-- If `E` is a normed space, `Lp.simple_func E p μ` is a `has_smul`. Not declared as an
 instance as it is (as of writing) used only in the construction of the Bochner integral. -/
-protected def has_scalar : has_scalar 𝕜 (Lp.simple_func E p μ) := ⟨λ k f, ⟨k • f,
+protected def has_smul : has_smul 𝕜 (Lp.simple_func E p μ) := ⟨λ k f, ⟨k • f,
 begin
   rcases f with ⟨f, ⟨s, hs⟩⟩,
   use k • s,
-  apply eq.trans (smul_mk k s s.ae_strongly_measurable).symm _,
+  apply eq.trans (ae_eq_fun.smul_mk k s s.ae_strongly_measurable).symm _,
   rw hs,
   refl,
 end ⟩⟩
 
-local attribute [instance] simple_func.has_scalar
+local attribute [instance] simple_func.has_smul
 
 @[simp, norm_cast] lemma coe_smul (c : 𝕜) (f : Lp.simple_func E p μ) :
   ((c • f : Lp.simple_func E p μ) : Lp E p μ) = c • (f : Lp E p μ) := rfl
@@ -449,12 +480,20 @@ local attribute [instance] simple_func.module
 
 /-- If `E` is a normed space, `Lp.simple_func E p μ` is a normed space. Not declared as an
 instance as it is (as of writing) used only in the construction of the Bochner integral. -/
-protected def normed_space [fact (1 ≤ p)] : normed_space 𝕜 (Lp.simple_func E p μ) :=
-⟨ λc f, by { rw [add_subgroup.coe_norm, add_subgroup.coe_norm, coe_smul, norm_smul] } ⟩
+protected lemma has_bounded_smul [fact (1 ≤ p)] : has_bounded_smul 𝕜 (Lp.simple_func E p μ) :=
+has_bounded_smul.of_norm_smul_le $ λ r f, (norm_smul_le r (f : Lp E p μ) : _)
+
+local attribute [instance] simple_func.has_bounded_smul
+
+/-- If `E` is a normed space, `Lp.simple_func E p μ` is a normed space. Not declared as an
+instance as it is (as of writing) used only in the construction of the Bochner integral. -/
+protected def normed_space {𝕜} [normed_field 𝕜] [normed_space 𝕜 E] [fact (1 ≤ p)] :
+  normed_space 𝕜 (Lp.simple_func E p μ) :=
+⟨norm_smul_le⟩
 
 end instances
 
-local attribute [instance] simple_func.module simple_func.normed_space
+local attribute [instance] simple_func.module simple_func.normed_space simple_func.has_bounded_smul
 
 section to_Lp
 
@@ -480,13 +519,13 @@ lemma to_Lp_sub (f g : α →ₛ E) (hf : mem_ℒp f p μ) (hg : mem_ℒp g p μ
   to_Lp (f - g) (hf.sub hg) = to_Lp f hf - to_Lp g hg :=
 by { simp only [sub_eq_add_neg, ← to_Lp_neg, ← to_Lp_add], refl }
 
-variables [normed_field 𝕜] [normed_space 𝕜 E]
+variables [normed_ring 𝕜] [module 𝕜 E] [has_bounded_smul 𝕜 E]
 
 lemma to_Lp_smul (f : α →ₛ E) (hf : mem_ℒp f p μ) (c : 𝕜) :
   to_Lp (c • f) (hf.const_smul c) = c • to_Lp f hf := rfl
 
 lemma norm_to_Lp [fact (1 ≤ p)] (f : α →ₛ E) (hf : mem_ℒp f p μ) :
-  ∥to_Lp f hf∥ = ennreal.to_real (snorm f p μ) :=
+  ‖to_Lp f hf‖ = ennreal.to_real (snorm f p μ) :=
 norm_to_Lp f hf
 
 end to_Lp
@@ -533,7 +572,7 @@ simple_func.eq' (classical.some_spec f.2)
 
 lemma to_simple_func_to_Lp (f : α →ₛ E) (hfi : mem_ℒp f p μ) :
   to_simple_func (to_Lp f hfi) =ᵐ[μ] f :=
-by { rw ← mk_eq_mk, exact classical.some_spec (to_Lp f hfi).2 }
+by { rw ← ae_eq_fun.mk_eq_mk, exact classical.some_spec (to_Lp f hfi).2 }
 
 variables (E μ)
 
@@ -573,7 +612,7 @@ begin
   repeat { assume h, rw h, },
 end
 
-variables [normed_field 𝕜] [normed_space 𝕜 E]
+variables [normed_ring 𝕜] [module 𝕜 E] [has_bounded_smul 𝕜 E]
 
 lemma smul_to_simple_func (k : 𝕜) (f : Lp.simple_func E p μ) :
   to_simple_func (k • f) =ᵐ[μ] k • to_simple_func f :=
@@ -585,7 +624,7 @@ begin
 end
 
 lemma norm_to_simple_func [fact (1 ≤ p)] (f : Lp.simple_func E p μ) :
-  ∥f∥ = ennreal.to_real (snorm (to_simple_func f) p μ) :=
+  ‖f‖ = ennreal.to_real (snorm (to_simple_func f) p μ) :=
 by simpa [to_Lp_to_simple_func] using norm_to_Lp (to_simple_func f) (simple_func.mem_ℒp f)
 
 end to_simple_func
@@ -684,7 +723,7 @@ protected lemma dense_range (hp_ne_top : p ≠ ∞) :
   dense_range (coe : (Lp.simple_func E p μ) → (Lp E p μ)) :=
 (simple_func.dense_inducing hp_ne_top).dense
 
-variables [normed_field 𝕜] [normed_space 𝕜 E]
+variables [normed_ring 𝕜] [module 𝕜 E] [has_bounded_smul 𝕜 E]
 variables (α E 𝕜)
 
 /-- The embedding of Lp simple functions into Lp functions, as a continuous linear map. -/
@@ -742,7 +781,7 @@ begin
     rw mem_compl_iff at hxs,
     have hx' : x ∉ {a : α | ¬0 ≤ simple_func.to_simple_func f a},
       from λ h, hxs (subset_to_measurable μ _ h),
-    rwa [set.nmem_set_of_eq, not_not] at hx', },
+    rwa [set.nmem_set_of_iff, not_not] at hx', },
   let f' := simple_func.piecewise s (measurable_set_to_measurable μ _).compl
     (simple_func.to_simple_func f) (simple_func.const α (0 : G)),
   refine ⟨f', λ x, _, _⟩,
@@ -775,7 +814,7 @@ begin
   rw mem_closure_iff_seq_limit,
   have hg_mem_ℒp : mem_ℒp g p μ := Lp.mem_ℒp g,
   have zero_mem : (0 : G) ∈ (range g ∪ {0} : set G) ∩ {y | 0 ≤ y}, by simp only [union_singleton,
-    mem_inter_eq, mem_insert_iff, eq_self_iff_true, true_or, mem_set_of_eq, le_refl, and_self],
+    mem_inter_iff, mem_insert_iff, eq_self_iff_true, true_or, mem_set_of_eq, le_refl, and_self],
   haveI : separable_space (((range g ∪ {0}) ∩ {y | 0 ≤ y}) : set G),
   { apply is_separable.separable_space,
     apply is_separable.mono _ (set.inter_subset_left _ _),
@@ -828,7 +867,7 @@ end simple_func
 
 end Lp
 
-variables [measurable_space α] [normed_group E] {f : α → E} {p : ℝ≥0∞} {μ : measure α}
+variables [measurable_space α] [normed_add_comm_group E] {f : α → E} {p : ℝ≥0∞} {μ : measure α}
 
 /-- To prove something for an arbitrary `Lp` function in a second countable Borel normed group, it
 suffices to show that
@@ -846,7 +885,7 @@ lemma Lp.induction [_i : fact (1 ≤ p)] (hp_ne_top : p ≠ ∞) (P : Lp E p μ
   ∀ f : Lp E p μ, P f :=
 begin
   refine λ f, (Lp.simple_func.dense_range hp_ne_top).induction_on f h_closed _,
-  refine Lp.simple_func.induction (lt_of_lt_of_le ennreal.zero_lt_one _i.elim).ne' hp_ne_top _ _,
+  refine Lp.simple_func.induction (lt_of_lt_of_le zero_lt_one _i.elim).ne' hp_ne_top _ _,
   { exact λ c s, h_ind c },
   { exact λ f g hf hg, h_add hf hg },
 end
@@ -877,7 +916,7 @@ begin
     { intros c s hs h,
       by_cases hc : c = 0,
       { subst hc, convert h_ind 0 measurable_set.empty (by simp) using 1, ext, simp [const] },
-      have hp_pos : p ≠ 0 := (lt_of_lt_of_le ennreal.zero_lt_one _i.elim).ne',
+      have hp_pos : p ≠ 0 := (lt_of_lt_of_le zero_lt_one _i.elim).ne',
       exact h_ind c hs (simple_func.measure_lt_top_of_mem_ℒp_indicator hp_pos hp_ne_top hc hs h) },
     { intros f g hfg hf hg int_fg,
       rw [simple_func.coe_add,
@@ -892,6 +931,57 @@ begin
   exact λ f hf, h_ae hf.coe_fn_to_Lp (Lp.mem_ℒp _) (this (hf.to_Lp f)),
 end
 
+/-- If a set of ae strongly measurable functions is stable under addition and approximates
+characteristic functions in `ℒp`, then it is dense in `ℒp`. -/
+lemma mem_ℒp.induction_dense (hp_ne_top : p ≠ ∞) (P : (α → E) → Prop)
+  (h0P : ∀ (c : E) ⦃s : set α⦄, measurable_set s → μ s < ∞ → ∀ {ε : ℝ≥0∞}, ε ≠ 0 →
+    (∃ (g : α → E), snorm (g - s.indicator (λ x, c)) p μ ≤ ε ∧ P g))
+  (h1P : ∀ f g, P f → P g → P (f + g))
+  (h2P : ∀ f, P f → ae_strongly_measurable f μ)
+  {f : α → E} (hf : mem_ℒp f p μ) {ε : ℝ≥0∞} (hε : ε ≠ 0) :
+  ∃ (g : α → E), snorm (f - g) p μ ≤ ε ∧ P g :=
+begin
+  rcases eq_or_ne p 0 with rfl|hp_pos,
+  { rcases h0P (0 : E) measurable_set.empty
+      (by simp only [measure_empty, with_top.zero_lt_top]) hε with ⟨g, hg, Pg⟩,
+    exact ⟨g, by simp only [snorm_exponent_zero, zero_le'], Pg⟩ },
+  suffices H : ∀ (f' : α →ₛ E) (δ : ℝ≥0∞) (hδ : δ ≠ 0), mem_ℒp f' p μ →
+    ∃ g, snorm (f' - g) p μ ≤ δ ∧ P g,
+  { obtain ⟨η, ηpos, hη⟩ := exists_Lp_half E μ p hε,
+    rcases hf.exists_simple_func_snorm_sub_lt hp_ne_top ηpos.ne' with ⟨f', hf', f'_mem⟩,
+    rcases H f' η ηpos.ne' f'_mem with ⟨g, hg, Pg⟩,
+    refine ⟨g, _, Pg⟩,
+    convert (hη _ _ (hf.ae_strongly_measurable.sub f'.ae_strongly_measurable)
+      (f'.ae_strongly_measurable.sub (h2P g Pg)) hf'.le hg).le,
+    simp only [sub_add_sub_cancel] },
+  refine simple_func.induction _ _,
+  { intros c s hs ε εpos Hs,
+    rcases eq_or_ne c 0 with rfl|hc,
+    { rcases h0P (0 : E) measurable_set.empty
+        (by simp only [measure_empty, with_top.zero_lt_top]) εpos with ⟨g, hg, Pg⟩,
+      rw [← snorm_neg, neg_sub] at hg,
+      refine ⟨g, _, Pg⟩,
+      convert hg,
+      ext x,
+      simp only [simple_func.const_zero, simple_func.coe_piecewise, simple_func.coe_zero,
+        piecewise_eq_indicator, indicator_zero', pi.zero_apply, indicator_zero] },
+    { have : μ s < ∞,
+        from (simple_func.measure_lt_top_of_mem_ℒp_indicator hp_pos hp_ne_top hc hs Hs),
+      rcases h0P c hs this εpos with ⟨g, hg, Pg⟩,
+      rw [← snorm_neg, neg_sub] at hg,
+      exact ⟨g, hg, Pg⟩ } },
+  { intros f f' hff' hf hf' δ δpos int_ff',
+    obtain ⟨η, ηpos, hη⟩ := exists_Lp_half E μ p δpos,
+    rw [simple_func.coe_add,
+      mem_ℒp_add_of_disjoint hff' f.strongly_measurable f'.strongly_measurable] at int_ff',
+    rcases hf η ηpos.ne' int_ff'.1 with ⟨g, hg, Pg⟩,
+    rcases hf' η ηpos.ne' int_ff'.2 with ⟨g', hg', Pg'⟩,
+    refine ⟨g + g', _, h1P g g' Pg Pg'⟩,
+    convert (hη _ _ (f.ae_strongly_measurable.sub (h2P g Pg))
+          (f'.ae_strongly_measurable.sub (h2P g' Pg')) hg hg').le,
+    abel }
+end
+
 section integrable
 
 notation α ` →₁ₛ[`:25 μ `] ` E := @measure_theory.Lp.simple_func α E _ _ 1 μ
diff --git a/src/measure_theory/function/special_functions.lean b/src/measure_theory/function/special_functions.lean
deleted file mode 100644
index 8aa2b24be303d..0000000000000
--- a/src/measure_theory/function/special_functions.lean
+++ /dev/null
@@ -1,257 +0,0 @@
-/-
-Copyright (c) 2020 Yury Kudryashov. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yury Kudryashov
--/
-
-import analysis.special_functions.pow
-import analysis.special_functions.trigonometric.arctan
-import analysis.inner_product_space.basic
-import measure_theory.constructions.borel_space
-
-/-!
-# Measurability of real and complex functions
-
-We show that most standard real and complex functions are measurable, notably `exp`, `cos`, `sin`,
-`cosh`, `sinh`, `log`, `pow`, `arcsin`, `arccos`, `arctan`, and scalar products.
--/
-
-noncomputable theory
-open_locale nnreal ennreal
-
-namespace real
-
-@[measurability] lemma measurable_exp : measurable exp := continuous_exp.measurable
-
-@[measurability] lemma measurable_log : measurable log :=
-measurable_of_measurable_on_compl_singleton 0 $ continuous.measurable $
-  continuous_on_iff_continuous_restrict.1 continuous_on_log
-
-@[measurability] lemma measurable_sin : measurable sin := continuous_sin.measurable
-
-@[measurability] lemma measurable_cos : measurable cos := continuous_cos.measurable
-
-@[measurability] lemma measurable_sinh : measurable sinh := continuous_sinh.measurable
-
-@[measurability] lemma measurable_cosh : measurable cosh := continuous_cosh.measurable
-
-@[measurability] lemma measurable_arcsin : measurable arcsin := continuous_arcsin.measurable
-
-@[measurability] lemma measurable_arccos : measurable arccos := continuous_arccos.measurable
-
-@[measurability] lemma measurable_arctan : measurable arctan := continuous_arctan.measurable
-
-end real
-
-namespace complex
-
-@[measurability] lemma measurable_re : measurable re := continuous_re.measurable
-
-@[measurability] lemma measurable_im : measurable im := continuous_im.measurable
-
-@[measurability] lemma measurable_of_real : measurable (coe : ℝ → ℂ) :=
-continuous_of_real.measurable
-
-@[measurability] lemma measurable_exp : measurable exp := continuous_exp.measurable
-
-@[measurability] lemma measurable_sin : measurable sin := continuous_sin.measurable
-
-@[measurability] lemma measurable_cos : measurable cos := continuous_cos.measurable
-
-@[measurability] lemma measurable_sinh : measurable sinh := continuous_sinh.measurable
-
-@[measurability] lemma measurable_cosh : measurable cosh := continuous_cosh.measurable
-
-@[measurability] lemma measurable_arg : measurable arg :=
-have A : measurable (λ x : ℂ, real.arcsin (x.im / x.abs)),
-  from real.measurable_arcsin.comp (measurable_im.div measurable_norm),
-have B : measurable (λ x : ℂ, real.arcsin ((-x).im / x.abs)),
-  from real.measurable_arcsin.comp ((measurable_im.comp measurable_neg).div measurable_norm),
-measurable.ite (is_closed_le continuous_const continuous_re).measurable_set A $
-  measurable.ite (is_closed_le continuous_const continuous_im).measurable_set
-    (B.add_const _) (B.sub_const _)
-
-@[measurability] lemma measurable_log : measurable log :=
-(measurable_of_real.comp $ real.measurable_log.comp measurable_norm).add $
-  (measurable_of_real.comp measurable_arg).mul_const I
-
-end complex
-
-namespace is_R_or_C
-
-variables {𝕜 : Type*} [is_R_or_C 𝕜]
-
-@[measurability] lemma measurable_re : measurable (re : 𝕜 → ℝ) := continuous_re.measurable
-
-@[measurability] lemma measurable_im : measurable (im : 𝕜 → ℝ) := continuous_im.measurable
-
-end is_R_or_C
-
-section real_composition
-open real
-variables {α : Type*} {m : measurable_space α} {f : α → ℝ} (hf : measurable f)
-
-@[measurability] lemma measurable.exp : measurable (λ x, real.exp (f x)) :=
-real.measurable_exp.comp hf
-
-@[measurability] lemma measurable.log : measurable (λ x, log (f x)) :=
-measurable_log.comp hf
-
-@[measurability] lemma measurable.cos : measurable (λ x, real.cos (f x)) :=
-real.measurable_cos.comp hf
-
-@[measurability] lemma measurable.sin : measurable (λ x, real.sin (f x)) :=
-real.measurable_sin.comp hf
-
-@[measurability] lemma measurable.cosh : measurable (λ x, real.cosh (f x)) :=
-real.measurable_cosh.comp hf
-
-@[measurability] lemma measurable.sinh : measurable (λ x, real.sinh (f x)) :=
-real.measurable_sinh.comp hf
-
-@[measurability] lemma measurable.arctan : measurable (λ x, arctan (f x)) :=
-measurable_arctan.comp hf
-
-@[measurability] lemma measurable.sqrt : measurable (λ x, sqrt (f x)) :=
-continuous_sqrt.measurable.comp hf
-
-end real_composition
-
-section complex_composition
-open complex
-variables {α : Type*} {m : measurable_space α} {f : α → ℂ} (hf : measurable f)
-
-@[measurability] lemma measurable.cexp : measurable (λ x, complex.exp (f x)) :=
-complex.measurable_exp.comp hf
-
-@[measurability] lemma measurable.ccos : measurable (λ x, complex.cos (f x)) :=
-complex.measurable_cos.comp hf
-
-@[measurability] lemma measurable.csin : measurable (λ x, complex.sin (f x)) :=
-complex.measurable_sin.comp hf
-
-@[measurability] lemma measurable.ccosh : measurable (λ x, complex.cosh (f x)) :=
-complex.measurable_cosh.comp hf
-
-@[measurability] lemma measurable.csinh : measurable (λ x, complex.sinh (f x)) :=
-complex.measurable_sinh.comp hf
-
-@[measurability] lemma measurable.carg : measurable (λ x, arg (f x)) :=
-measurable_arg.comp hf
-
-@[measurability] lemma measurable.clog : measurable (λ x, log (f x)) :=
-measurable_log.comp hf
-
-end complex_composition
-
-section is_R_or_C_composition
-
-variables {α 𝕜 : Type*} [is_R_or_C 𝕜] {m : measurable_space α}
-  {f : α → 𝕜} {μ : measure_theory.measure α}
-
-include m
-
-@[measurability] lemma measurable.re (hf : measurable f) : measurable (λ x, is_R_or_C.re (f x)) :=
-is_R_or_C.measurable_re.comp hf
-
-@[measurability] lemma ae_measurable.re (hf : ae_measurable f μ) :
-  ae_measurable (λ x, is_R_or_C.re (f x)) μ :=
-is_R_or_C.measurable_re.comp_ae_measurable hf
-
-@[measurability] lemma measurable.im (hf : measurable f) : measurable (λ x, is_R_or_C.im (f x)) :=
-is_R_or_C.measurable_im.comp hf
-
-@[measurability] lemma ae_measurable.im (hf : ae_measurable f μ) :
-  ae_measurable (λ x, is_R_or_C.im (f x)) μ :=
-is_R_or_C.measurable_im.comp_ae_measurable hf
-
-omit m
-
-end is_R_or_C_composition
-
-section
-
-variables {α 𝕜 : Type*} [is_R_or_C 𝕜] [measurable_space α]
-  {f : α → 𝕜} {μ : measure_theory.measure α}
-
-@[measurability] lemma is_R_or_C.measurable_of_real : measurable (coe : ℝ → 𝕜) :=
-is_R_or_C.continuous_of_real.measurable
-
-lemma measurable_of_re_im
-  (hre : measurable (λ x, is_R_or_C.re (f x)))
-  (him : measurable (λ x, is_R_or_C.im (f x))) : measurable f :=
-begin
-  convert (is_R_or_C.measurable_of_real.comp hre).add
-    ((is_R_or_C.measurable_of_real.comp him).mul_const is_R_or_C.I),
-  { ext1 x,
-    exact (is_R_or_C.re_add_im _).symm },
-  all_goals { apply_instance },
-end
-
-lemma ae_measurable_of_re_im
-  (hre : ae_measurable (λ x, is_R_or_C.re (f x)) μ)
-  (him : ae_measurable (λ x, is_R_or_C.im (f x)) μ) : ae_measurable f μ :=
-begin
-  convert (is_R_or_C.measurable_of_real.comp_ae_measurable hre).add
-    ((is_R_or_C.measurable_of_real.comp_ae_measurable him).mul_const is_R_or_C.I),
-  { ext1 x,
-    exact (is_R_or_C.re_add_im _).symm },
-  all_goals { apply_instance },
-end
-
-end
-
-section pow_instances
-
-instance complex.has_measurable_pow : has_measurable_pow ℂ ℂ :=
-⟨measurable.ite (measurable_fst (measurable_set_singleton 0))
-  (measurable.ite (measurable_snd (measurable_set_singleton 0)) measurable_one measurable_zero)
-  (measurable_fst.clog.mul measurable_snd).cexp⟩
-
-instance real.has_measurable_pow : has_measurable_pow ℝ ℝ :=
-⟨complex.measurable_re.comp $ ((complex.measurable_of_real.comp measurable_fst).pow
-  (complex.measurable_of_real.comp measurable_snd))⟩
-
-instance nnreal.has_measurable_pow : has_measurable_pow ℝ≥0 ℝ :=
-⟨(measurable_fst.coe_nnreal_real.pow measurable_snd).subtype_mk⟩
-
-instance ennreal.has_measurable_pow : has_measurable_pow ℝ≥0∞ ℝ :=
-begin
-  refine ⟨ennreal.measurable_of_measurable_nnreal_prod _ _⟩,
-  { simp_rw ennreal.coe_rpow_def,
-    refine measurable.ite _ measurable_const
-      (measurable_fst.pow measurable_snd).coe_nnreal_ennreal,
-    exact measurable_set.inter (measurable_fst (measurable_set_singleton 0))
-      (measurable_snd measurable_set_Iio), },
-  { simp_rw ennreal.top_rpow_def,
-    refine measurable.ite measurable_set_Ioi measurable_const _,
-    exact measurable.ite (measurable_set_singleton 0) measurable_const measurable_const, },
-end
-
-end pow_instances
-
-section
-variables {α : Type*} {𝕜 : Type*} {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
-local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y
-
-@[measurability]
-lemma measurable.inner {m : measurable_space α} [measurable_space E] [opens_measurable_space E]
-  [topological_space.second_countable_topology E]
-  {f g : α → E} (hf : measurable f) (hg : measurable g) :
-  measurable (λ t, ⟪f t, g t⟫) :=
-continuous.measurable2 continuous_inner hf hg
-
-@[measurability]
-lemma ae_measurable.inner {m : measurable_space α} [measurable_space E] [opens_measurable_space E]
-  [topological_space.second_countable_topology E]
-  {μ : measure_theory.measure α} {f g : α → E} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
-  ae_measurable (λ x, ⟪f x, g x⟫) μ :=
-begin
-  refine ⟨λ x, ⟪hf.mk f x, hg.mk g x⟫, hf.measurable_mk.inner hg.measurable_mk, _⟩,
-  refine hf.ae_eq_mk.mp (hg.ae_eq_mk.mono (λ x hxg hxf, _)),
-  dsimp only,
-  congr,
-  exacts [hxf, hxg],
-end
-
-end
diff --git a/src/measure_theory/function/special_functions/arctan.lean b/src/measure_theory/function/special_functions/arctan.lean
new file mode 100644
index 0000000000000..2d10fb0a4c189
--- /dev/null
+++ b/src/measure_theory/function/special_functions/arctan.lean
@@ -0,0 +1,31 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+
+import analysis.special_functions.trigonometric.arctan
+import measure_theory.constructions.borel_space.basic
+
+/-!
+# Measurability of arctan
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+namespace real
+
+@[measurability] lemma measurable_arctan : measurable arctan := continuous_arctan.measurable
+
+end real
+
+section real_composition
+open real
+variables {α : Type*} {m : measurable_space α} {f : α → ℝ} (hf : measurable f)
+
+@[measurability] lemma measurable.arctan : measurable (λ x, arctan (f x)) :=
+measurable_arctan.comp hf
+
+end real_composition
diff --git a/src/measure_theory/function/special_functions/basic.lean b/src/measure_theory/function/special_functions/basic.lean
new file mode 100644
index 0000000000000..17665d0e7e0cc
--- /dev/null
+++ b/src/measure_theory/function/special_functions/basic.lean
@@ -0,0 +1,168 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+
+import analysis.special_functions.pow.nnreal
+import measure_theory.constructions.borel_space.complex
+
+/-!
+# Measurability of real and complex functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We show that most standard real and complex functions are measurable, notably `exp`, `cos`, `sin`,
+`cosh`, `sinh`, `log`, `pow`, `arcsin`, `arccos`.
+
+See also `measure_theory.function.special_functions.arctan` and
+`measure_theory.function.special_functions.inner`, which have been split off to minimize imports.
+-/
+
+noncomputable theory
+open_locale nnreal ennreal
+
+namespace real
+
+@[measurability] lemma measurable_exp : measurable exp := continuous_exp.measurable
+
+@[measurability] lemma measurable_log : measurable log :=
+measurable_of_measurable_on_compl_singleton 0 $ continuous.measurable $
+  continuous_on_iff_continuous_restrict.1 continuous_on_log
+
+@[measurability] lemma measurable_sin : measurable sin := continuous_sin.measurable
+
+@[measurability] lemma measurable_cos : measurable cos := continuous_cos.measurable
+
+@[measurability] lemma measurable_sinh : measurable sinh := continuous_sinh.measurable
+
+@[measurability] lemma measurable_cosh : measurable cosh := continuous_cosh.measurable
+
+@[measurability] lemma measurable_arcsin : measurable arcsin := continuous_arcsin.measurable
+
+@[measurability] lemma measurable_arccos : measurable arccos := continuous_arccos.measurable
+
+end real
+
+namespace complex
+
+@[measurability] lemma measurable_re : measurable re := continuous_re.measurable
+
+@[measurability] lemma measurable_im : measurable im := continuous_im.measurable
+
+@[measurability] lemma measurable_of_real : measurable (coe : ℝ → ℂ) :=
+continuous_of_real.measurable
+
+@[measurability] lemma measurable_exp : measurable exp := continuous_exp.measurable
+
+@[measurability] lemma measurable_sin : measurable sin := continuous_sin.measurable
+
+@[measurability] lemma measurable_cos : measurable cos := continuous_cos.measurable
+
+@[measurability] lemma measurable_sinh : measurable sinh := continuous_sinh.measurable
+
+@[measurability] lemma measurable_cosh : measurable cosh := continuous_cosh.measurable
+
+@[measurability] lemma measurable_arg : measurable arg :=
+have A : measurable (λ x : ℂ, real.arcsin (x.im / x.abs)),
+  from real.measurable_arcsin.comp (measurable_im.div measurable_norm),
+have B : measurable (λ x : ℂ, real.arcsin ((-x).im / x.abs)),
+  from real.measurable_arcsin.comp ((measurable_im.comp measurable_neg).div measurable_norm),
+measurable.ite (is_closed_le continuous_const continuous_re).measurable_set A $
+  measurable.ite (is_closed_le continuous_const continuous_im).measurable_set
+    (B.add_const _) (B.sub_const _)
+
+@[measurability] lemma measurable_log : measurable log :=
+(measurable_of_real.comp $ real.measurable_log.comp measurable_norm).add $
+  (measurable_of_real.comp measurable_arg).mul_const I
+
+end complex
+
+section real_composition
+open real
+variables {α : Type*} {m : measurable_space α} {f : α → ℝ} (hf : measurable f)
+
+@[measurability] lemma measurable.exp : measurable (λ x, real.exp (f x)) :=
+real.measurable_exp.comp hf
+
+@[measurability] lemma measurable.log : measurable (λ x, log (f x)) :=
+measurable_log.comp hf
+
+@[measurability] lemma measurable.cos : measurable (λ x, real.cos (f x)) :=
+real.measurable_cos.comp hf
+
+@[measurability] lemma measurable.sin : measurable (λ x, real.sin (f x)) :=
+real.measurable_sin.comp hf
+
+@[measurability] lemma measurable.cosh : measurable (λ x, real.cosh (f x)) :=
+real.measurable_cosh.comp hf
+
+@[measurability] lemma measurable.sinh : measurable (λ x, real.sinh (f x)) :=
+real.measurable_sinh.comp hf
+
+@[measurability] lemma measurable.sqrt : measurable (λ x, sqrt (f x)) :=
+continuous_sqrt.measurable.comp hf
+
+end real_composition
+
+section complex_composition
+open complex
+variables {α : Type*} {m : measurable_space α} {f : α → ℂ} (hf : measurable f)
+
+@[measurability] lemma measurable.cexp : measurable (λ x, complex.exp (f x)) :=
+complex.measurable_exp.comp hf
+
+@[measurability] lemma measurable.ccos : measurable (λ x, complex.cos (f x)) :=
+complex.measurable_cos.comp hf
+
+@[measurability] lemma measurable.csin : measurable (λ x, complex.sin (f x)) :=
+complex.measurable_sin.comp hf
+
+@[measurability] lemma measurable.ccosh : measurable (λ x, complex.cosh (f x)) :=
+complex.measurable_cosh.comp hf
+
+@[measurability] lemma measurable.csinh : measurable (λ x, complex.sinh (f x)) :=
+complex.measurable_sinh.comp hf
+
+@[measurability] lemma measurable.carg : measurable (λ x, arg (f x)) :=
+measurable_arg.comp hf
+
+@[measurability] lemma measurable.clog : measurable (λ x, log (f x)) :=
+measurable_log.comp hf
+
+end complex_composition
+
+section pow_instances
+
+instance complex.has_measurable_pow : has_measurable_pow ℂ ℂ :=
+⟨measurable.ite (measurable_fst (measurable_set_singleton 0))
+  (measurable.ite (measurable_snd (measurable_set_singleton 0)) measurable_one measurable_zero)
+  (measurable_fst.clog.mul measurable_snd).cexp⟩
+
+instance real.has_measurable_pow : has_measurable_pow ℝ ℝ :=
+⟨complex.measurable_re.comp $ ((complex.measurable_of_real.comp measurable_fst).pow
+  (complex.measurable_of_real.comp measurable_snd))⟩
+
+instance nnreal.has_measurable_pow : has_measurable_pow ℝ≥0 ℝ :=
+⟨(measurable_fst.coe_nnreal_real.pow measurable_snd).subtype_mk⟩
+
+instance ennreal.has_measurable_pow : has_measurable_pow ℝ≥0∞ ℝ :=
+begin
+  refine ⟨ennreal.measurable_of_measurable_nnreal_prod _ _⟩,
+  { simp_rw ennreal.coe_rpow_def,
+    refine measurable.ite _ measurable_const
+      (measurable_fst.pow measurable_snd).coe_nnreal_ennreal,
+    exact measurable_set.inter (measurable_fst (measurable_set_singleton 0))
+      (measurable_snd measurable_set_Iio), },
+  { simp_rw ennreal.top_rpow_def,
+    refine measurable.ite measurable_set_Ioi measurable_const _,
+    exact measurable.ite (measurable_set_singleton 0) measurable_const measurable_const, },
+end
+
+end pow_instances
+
+-- Guard against import creep:
+assert_not_exists inner_product_space
+assert_not_exists real.arctan
+assert_not_exists finite_dimensional.proper
diff --git a/src/measure_theory/function/special_functions/inner.lean b/src/measure_theory/function/special_functions/inner.lean
new file mode 100644
index 0000000000000..7ef44069c3dce
--- /dev/null
+++ b/src/measure_theory/function/special_functions/inner.lean
@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+
+import analysis.inner_product_space.basic
+import measure_theory.constructions.borel_space.complex
+
+/-!
+# Measurability of scalar products
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α : Type*} {𝕜 : Type*} {E : Type*}
+variables [is_R_or_C 𝕜] [normed_add_comm_group E] [inner_product_space 𝕜 E]
+local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y
+
+@[measurability]
+lemma measurable.inner {m : measurable_space α} [measurable_space E] [opens_measurable_space E]
+  [topological_space.second_countable_topology E]
+  {f g : α → E} (hf : measurable f) (hg : measurable g) :
+  measurable (λ t, ⟪f t, g t⟫) :=
+continuous.measurable2 continuous_inner hf hg
+
+@[measurability]
+lemma ae_measurable.inner {m : measurable_space α} [measurable_space E] [opens_measurable_space E]
+  [topological_space.second_countable_topology E]
+  {μ : measure_theory.measure α} {f g : α → E} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
+  ae_measurable (λ x, ⟪f x, g x⟫) μ :=
+begin
+  refine ⟨λ x, ⟪hf.mk f x, hg.mk g x⟫, hf.measurable_mk.inner hg.measurable_mk, _⟩,
+  refine hf.ae_eq_mk.mp (hg.ae_eq_mk.mono (λ x hxg hxf, _)),
+  dsimp only,
+  congr,
+  exacts [hxf, hxg],
+end
diff --git a/src/measure_theory/function/special_functions/is_R_or_C.lean b/src/measure_theory/function/special_functions/is_R_or_C.lean
new file mode 100644
index 0000000000000..105fbac18bb90
--- /dev/null
+++ b/src/measure_theory/function/special_functions/is_R_or_C.lean
@@ -0,0 +1,87 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+
+import measure_theory.function.special_functions.basic
+import data.is_R_or_C.lemmas
+
+/-!
+# Measurability of the basic `is_R_or_C` functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+noncomputable theory
+open_locale nnreal ennreal
+
+
+namespace is_R_or_C
+
+variables {𝕜 : Type*} [is_R_or_C 𝕜]
+
+@[measurability] lemma measurable_re : measurable (re : 𝕜 → ℝ) := continuous_re.measurable
+
+@[measurability] lemma measurable_im : measurable (im : 𝕜 → ℝ) := continuous_im.measurable
+
+end is_R_or_C
+
+section is_R_or_C_composition
+
+variables {α 𝕜 : Type*} [is_R_or_C 𝕜] {m : measurable_space α}
+  {f : α → 𝕜} {μ : measure_theory.measure α}
+
+include m
+
+@[measurability] lemma measurable.re (hf : measurable f) : measurable (λ x, is_R_or_C.re (f x)) :=
+is_R_or_C.measurable_re.comp hf
+
+@[measurability] lemma ae_measurable.re (hf : ae_measurable f μ) :
+  ae_measurable (λ x, is_R_or_C.re (f x)) μ :=
+is_R_or_C.measurable_re.comp_ae_measurable hf
+
+@[measurability] lemma measurable.im (hf : measurable f) : measurable (λ x, is_R_or_C.im (f x)) :=
+is_R_or_C.measurable_im.comp hf
+
+@[measurability] lemma ae_measurable.im (hf : ae_measurable f μ) :
+  ae_measurable (λ x, is_R_or_C.im (f x)) μ :=
+is_R_or_C.measurable_im.comp_ae_measurable hf
+
+omit m
+
+end is_R_or_C_composition
+
+section
+
+variables {α 𝕜 : Type*} [is_R_or_C 𝕜] [measurable_space α]
+  {f : α → 𝕜} {μ : measure_theory.measure α}
+
+@[measurability] lemma is_R_or_C.measurable_of_real : measurable (coe : ℝ → 𝕜) :=
+is_R_or_C.continuous_of_real.measurable
+
+lemma measurable_of_re_im
+  (hre : measurable (λ x, is_R_or_C.re (f x)))
+  (him : measurable (λ x, is_R_or_C.im (f x))) : measurable f :=
+begin
+  convert (is_R_or_C.measurable_of_real.comp hre).add
+    ((is_R_or_C.measurable_of_real.comp him).mul_const is_R_or_C.I),
+  { ext1 x,
+    exact (is_R_or_C.re_add_im _).symm },
+  all_goals { apply_instance },
+end
+
+lemma ae_measurable_of_re_im
+  (hre : ae_measurable (λ x, is_R_or_C.re (f x)) μ)
+  (him : ae_measurable (λ x, is_R_or_C.im (f x)) μ) : ae_measurable f μ :=
+begin
+  convert (is_R_or_C.measurable_of_real.comp_ae_measurable hre).add
+    ((is_R_or_C.measurable_of_real.comp_ae_measurable him).mul_const is_R_or_C.I),
+  { ext1 x,
+    exact (is_R_or_C.re_add_im _).symm },
+  all_goals { apply_instance },
+end
+
+end
diff --git a/src/measure_theory/function/strongly_measurable.lean b/src/measure_theory/function/strongly_measurable.lean
deleted file mode 100644
index aa58802f339e8..0000000000000
--- a/src/measure_theory/function/strongly_measurable.lean
+++ /dev/null
@@ -1,1761 +0,0 @@
-/-
-Copyright (c) 2021 Rémy Degenne. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Rémy Degenne, Sébastien Gouëzel
--/
-import measure_theory.function.ess_sup
-import measure_theory.integral.mean_inequalities
-import topology.continuous_function.compact
-import topology.metric_space.metrizable
-import measure_theory.function.simple_func_dense
-
-/-!
-# Strongly measurable and finitely strongly measurable functions
-
-A function `f` is said to be strongly measurable if `f` is the sequential limit of simple functions.
-It is said to be finitely strongly measurable with respect to a measure `μ` if the supports
-of those simple functions have finite measure. We also provide almost everywhere versions of
-these notions.
-
-Almost everywhere strongly measurable functions form the largest class of functions that can be
-integrated using the Bochner integral.
-
-If the target space has a second countable topology, strongly measurable and measurable are
-equivalent.
-
-If the measure is sigma-finite, strongly measurable and finitely strongly measurable are equivalent.
-
-The main property of finitely strongly measurable functions is
-`fin_strongly_measurable.exists_set_sigma_finite`: there exists a measurable set `t` such that the
-function is supported on `t` and `μ.restrict t` is sigma-finite. As a consequence, we can prove some
-results for those functions as if the measure was sigma-finite.
-
-## Main definitions
-
-* `strongly_measurable f`: `f : α → β` is the limit of a sequence `fs : ℕ → simple_func α β`.
-* `fin_strongly_measurable f μ`: `f : α → β` is the limit of a sequence `fs : ℕ → simple_func α β`
-  such that for all `n ∈ ℕ`, the measure of the support of `fs n` is finite.
-* `ae_strongly_measurable f μ`: `f` is almost everywhere equal to a `strongly_measurable` function.
-* `ae_fin_strongly_measurable f μ`: `f` is almost everywhere equal to a `fin_strongly_measurable`
-  function.
-
-* `ae_fin_strongly_measurable.sigma_finite_set`: a measurable set `t` such that
-  `f =ᵐ[μ.restrict tᶜ] 0` and `μ.restrict t` is sigma-finite.
-
-## Main statements
-
-* `ae_fin_strongly_measurable.exists_set_sigma_finite`: there exists a measurable set `t` such that
-  `f =ᵐ[μ.restrict tᶜ] 0` and `μ.restrict t` is sigma-finite.
-
-We provide a solid API for strongly measurable functions, and for almost everywhere strongly
-measurable functions, as a basis for the Bochner integral.
-
-## References
-
-* Hytönen, Tuomas, Jan Van Neerven, Mark Veraar, and Lutz Weis. Analysis in Banach spaces.
-  Springer, 2016.
-
--/
-
-open measure_theory filter topological_space function set measure_theory.measure
-open_locale ennreal topological_space measure_theory nnreal big_operators
-
-/-- The typeclass `second_countable_topology_either α β` registers the fact that at least one of
-the two spaces has second countable topology. This is the right assumption to ensure that continuous
-maps from `α` to `β` are strongly measurable. -/
-class second_countable_topology_either
-  (α β : Type*) [topological_space α] [topological_space β] : Prop :=
-(out : second_countable_topology α ∨ second_countable_topology β)
-
-@[priority 100] instance second_countable_topology_either_of_left
-  (α β : Type*) [topological_space α] [topological_space β] [second_countable_topology α] :
-  second_countable_topology_either α β :=
-{ out := or.inl (by apply_instance) }
-
-@[priority 100] instance second_countable_topology_either_of_right
-  (α β : Type*) [topological_space α] [topological_space β] [second_countable_topology β] :
-  second_countable_topology_either α β :=
-{ out := or.inr (by apply_instance) }
-
-variables {α β γ ι : Type*} [encodable ι]
-namespace measure_theory
-
-local infixr ` →ₛ `:25 := simple_func
-
-section definitions
-variable [topological_space β]
-
-/-- A function is `strongly_measurable` if it is the limit of simple functions. -/
-def strongly_measurable [measurable_space α] (f : α → β) : Prop :=
-∃ fs : ℕ → α →ₛ β, ∀ x, tendsto (λ n, fs n x) at_top (𝓝 (f x))
-
-localized "notation `strongly_measurable[` m `]` := @measure_theory.strongly_measurable _ _ _ m"
-in measure_theory
-
-/-- A function is `fin_strongly_measurable` with respect to a measure if it is the limit of simple
-  functions with support with finite measure. -/
-def fin_strongly_measurable [has_zero β] {m0 : measurable_space α} (f : α → β) (μ : measure α) :
-  Prop :=
-∃ fs : ℕ → α →ₛ β, (∀ n, μ (support (fs n)) < ∞) ∧ (∀ x, tendsto (λ n, fs n x) at_top (𝓝 (f x)))
-
-/-- A function is `ae_strongly_measurable` with respect to a measure `μ` if it is almost everywhere
-equal to the limit of a sequence of simple functions. -/
-def ae_strongly_measurable {m0 : measurable_space α} (f : α → β) (μ : measure α) : Prop :=
-∃ g, strongly_measurable g ∧ f =ᵐ[μ] g
-
-/-- A function is `ae_fin_strongly_measurable` with respect to a measure if it is almost everywhere
-equal to the limit of a sequence of simple functions with support with finite measure. -/
-def ae_fin_strongly_measurable [has_zero β] {m0 : measurable_space α} (f : α → β) (μ : measure α) :
-  Prop :=
-∃ g, fin_strongly_measurable g μ ∧ f =ᵐ[μ] g
-
-end definitions
-
-open_locale measure_theory
-
-/-! ## Strongly measurable functions -/
-
-lemma strongly_measurable.ae_strongly_measurable {α β} {m0 : measurable_space α}
-  [topological_space β] {f : α → β} {μ : measure α} (hf : strongly_measurable f) :
-  ae_strongly_measurable f μ :=
-⟨f, hf, eventually_eq.refl _ _⟩
-
-@[simp] lemma subsingleton.strongly_measurable {α β} [measurable_space α] [topological_space β]
-  [subsingleton β] (f : α → β) :
-  strongly_measurable f :=
-begin
-  let f_sf : α →ₛ β := ⟨f, λ x, _, set.subsingleton.finite set.subsingleton_of_subsingleton⟩,
-  { exact ⟨λ n, f_sf, λ x, tendsto_const_nhds⟩, },
-  { have h_univ : f ⁻¹' {x} = set.univ, by { ext1 y, simp, },
-    rw h_univ,
-    exact measurable_set.univ, },
-end
-
-lemma simple_func.strongly_measurable {α β} {m : measurable_space α} [topological_space β]
-  (f : α →ₛ β) :
-  strongly_measurable f :=
-⟨λ _, f, λ x, tendsto_const_nhds⟩
-
-lemma strongly_measurable_of_is_empty [is_empty α] {m : measurable_space α} [topological_space β]
-  (f : α → β) : strongly_measurable f :=
-⟨λ n, simple_func.of_is_empty, is_empty_elim⟩
-
-lemma strongly_measurable_const {α β} {m : measurable_space α} [topological_space β] {b : β} :
-  strongly_measurable (λ a : α, b) :=
-⟨λ n, simple_func.const α b, λ a, tendsto_const_nhds⟩
-
-@[to_additive]
-lemma strongly_measurable_one {α β} {m : measurable_space α} [topological_space β] [has_one β] :
-  strongly_measurable (1 : α → β) :=
-@strongly_measurable_const _ _ _ _ 1
-
-/-- A version of `strongly_measurable_const` that assumes `f x = f y` for all `x, y`.
-This version works for functions between empty types. -/
-lemma strongly_measurable_const' {α β} {m : measurable_space α} [topological_space β] {f : α → β}
-  (hf : ∀ x y, f x = f y) : strongly_measurable f :=
-begin
-  casesI is_empty_or_nonempty α,
-  { exact strongly_measurable_of_is_empty f },
-  { convert strongly_measurable_const, exact funext (λ x, hf x h.some) }
-end
-
-@[simp] lemma subsingleton.strongly_measurable' {α β} [measurable_space α] [topological_space β]
-  [subsingleton α] (f : α → β) :
-  strongly_measurable f :=
-strongly_measurable_const' (λ x y, by rw subsingleton.elim x y)
-
-namespace strongly_measurable
-
-variables {f g : α → β}
-
-section basic_properties_in_any_topological_space
-variables [topological_space β]
-
-/-- A sequence of simple functions such that `∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x))`.
-That property is given by `strongly_measurable.tendsto_approx`. -/
-protected noncomputable
-def approx {m : measurable_space α} (hf : strongly_measurable f) : ℕ → α →ₛ β :=
-hf.some
-
-protected lemma tendsto_approx {m : measurable_space α} (hf : strongly_measurable f) :
-  ∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x)) :=
-hf.some_spec
-
-end basic_properties_in_any_topological_space
-
-lemma fin_strongly_measurable_of_set_sigma_finite [topological_space β] [has_zero β]
-  {m : measurable_space α} {μ : measure α} (hf_meas : strongly_measurable f) {t : set α}
-  (ht : measurable_set t) (hft_zero : ∀ x ∈ tᶜ, f x = 0) (htμ : sigma_finite (μ.restrict t)) :
-  fin_strongly_measurable f μ :=
-begin
-  haveI : sigma_finite (μ.restrict t) := htμ,
-  let S := spanning_sets (μ.restrict t),
-  have hS_meas : ∀ n, measurable_set (S n), from measurable_spanning_sets (μ.restrict t),
-  let f_approx := hf_meas.approx,
-  let fs := λ n, simple_func.restrict (f_approx n) (S n ∩ t),
-  have h_fs_t_compl : ∀ n, ∀ x ∉ t, fs n x = 0,
-  { intros n x hxt,
-    rw simple_func.restrict_apply _ ((hS_meas n).inter ht),
-    refine set.indicator_of_not_mem _ _,
-    simp [hxt], },
-  refine ⟨fs, _, λ x, _⟩,
-  { simp_rw simple_func.support_eq,
-    refine λ n, (measure_bUnion_finset_le _ _).trans_lt _,
-    refine ennreal.sum_lt_top_iff.mpr (λ y hy, _),
-    rw simple_func.restrict_preimage_singleton _ ((hS_meas n).inter ht),
-    swap, { rw finset.mem_filter at hy, exact hy.2, },
-    refine (measure_mono (set.inter_subset_left _ _)).trans_lt _,
-    have h_lt_top := measure_spanning_sets_lt_top (μ.restrict t) n,
-    rwa measure.restrict_apply' ht at h_lt_top, },
-  { by_cases hxt : x ∈ t,
-    swap, { rw [funext (λ n, h_fs_t_compl n x hxt), hft_zero x hxt], exact tendsto_const_nhds, },
-    have h : tendsto (λ n, (f_approx n) x) at_top (𝓝 (f x)), from hf_meas.tendsto_approx x,
-    obtain ⟨n₁, hn₁⟩ : ∃ n, ∀ m, n ≤ m → fs m x = f_approx m x,
-    { obtain ⟨n, hn⟩ : ∃ n, ∀ m, n ≤ m → x ∈ S m ∩ t,
-      { suffices : ∃ n, ∀ m, n ≤ m → x ∈ S m,
-        { obtain ⟨n, hn⟩ := this,
-          exact ⟨n, λ m hnm, set.mem_inter (hn m hnm) hxt⟩, },
-        suffices : ∃ n, x ∈ S n,
-        { rcases this with ⟨n, hn⟩,
-          exact ⟨n, λ m hnm, monotone_spanning_sets (μ.restrict t) hnm hn⟩, },
-        rw [← set.mem_Union, Union_spanning_sets (μ.restrict t)],
-        trivial, },
-      refine ⟨n, λ m hnm, _⟩,
-      simp_rw [fs, simple_func.restrict_apply _ ((hS_meas m).inter ht),
-        set.indicator_of_mem (hn m hnm)], },
-    rw tendsto_at_top' at h ⊢,
-    intros s hs,
-    obtain ⟨n₂, hn₂⟩ := h s hs,
-    refine ⟨max n₁ n₂, λ m hm, _⟩,
-    rw hn₁ m ((le_max_left _ _).trans hm.le),
-    exact hn₂ m ((le_max_right _ _).trans hm.le), },
-end
-
-/-- If the measure is sigma-finite, all strongly measurable functions are
-  `fin_strongly_measurable`. -/
-protected lemma fin_strongly_measurable [topological_space β] [has_zero β] {m0 : measurable_space α}
-  (hf : strongly_measurable f) (μ : measure α) [sigma_finite μ] :
-  fin_strongly_measurable f μ :=
-hf.fin_strongly_measurable_of_set_sigma_finite measurable_set.univ (by simp)
-  (by rwa measure.restrict_univ)
-
-/-- A strongly measurable function is measurable. -/
-protected lemma measurable {m : measurable_space α} [topological_space β] [metrizable_space β]
-  [measurable_space β] [borel_space β] (hf : strongly_measurable f) :
-  measurable f :=
-measurable_of_tendsto_metrizable (λ n, (hf.approx n).measurable)
-  (tendsto_pi_nhds.mpr hf.tendsto_approx)
-
-/-- A strongly measurable function is almost everywhere measurable. -/
-protected lemma ae_measurable {m : measurable_space α} [topological_space β] [metrizable_space β]
-  [measurable_space β] [borel_space β] {μ : measure α} (hf : strongly_measurable f) :
-  ae_measurable f μ :=
-hf.measurable.ae_measurable
-
-lemma _root_.continuous.comp_strongly_measurable
-  {m : measurable_space α} [topological_space β] [topological_space γ] {g : β → γ} {f : α → β}
-  (hg : continuous g) (hf : strongly_measurable f) : strongly_measurable (λ x, g (f x)) :=
-⟨λ n, simple_func.map g (hf.approx n), λ x, (hg.tendsto _).comp (hf.tendsto_approx x)⟩
-
-@[to_additive]
-lemma measurable_set_mul_support {m : measurable_space α}
-  [has_one β] [topological_space β] [metrizable_space β] (hf : strongly_measurable f) :
-  measurable_set (mul_support f) :=
-by { borelize β, exact measurable_set_mul_support hf.measurable }
-
-protected lemma mono {m m' : measurable_space α} [topological_space β]
-  (hf : strongly_measurable[m'] f) (h_mono : m' ≤ m) :
-  strongly_measurable[m] f :=
-begin
-  let f_approx : ℕ → @simple_func α m β := λ n,
-  { to_fun := hf.approx n,
-    measurable_set_fiber' := λ x, h_mono _ (simple_func.measurable_set_fiber' _ x),
-    finite_range' := simple_func.finite_range (hf.approx n) },
-  exact ⟨f_approx, hf.tendsto_approx⟩,
-end
-
-protected lemma prod_mk {m : measurable_space α} [topological_space β] [topological_space γ]
-  {f : α → β} {g : α → γ} (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (λ x, (f x, g x)) :=
-begin
-  refine ⟨λ n, simple_func.pair (hf.approx n) (hg.approx n), λ x, _⟩,
-  rw nhds_prod_eq,
-  exact tendsto.prod_mk (hf.tendsto_approx x) (hg.tendsto_approx x),
-end
-
-lemma comp_measurable [topological_space β] {m : measurable_space α} {m' : measurable_space γ}
-  {f : α → β} {g : γ → α} (hf : strongly_measurable f) (hg : measurable g) :
-  strongly_measurable (f ∘ g) :=
-⟨λ n, simple_func.comp (hf.approx n) g hg, λ x, hf.tendsto_approx (g x)⟩
-
-lemma of_uncurry_left [topological_space β] {mα : measurable_space α} {mγ : measurable_space γ}
-  {f : α → γ → β} (hf : strongly_measurable (uncurry f)) {x : α} :
-  strongly_measurable (f x) :=
-hf.comp_measurable measurable_prod_mk_left
-
-lemma of_uncurry_right [topological_space β] {mα : measurable_space α} {mγ : measurable_space γ}
-  {f : α → γ → β} (hf : strongly_measurable (uncurry f)) {y : γ} :
-  strongly_measurable (λ x, f x y) :=
-hf.comp_measurable measurable_prod_mk_right
-
-section arithmetic
-variables {mα : measurable_space α} [topological_space β]
-include mα
-
-@[to_additive]
-protected lemma mul [has_mul β] [has_continuous_mul β]
-  (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (f * g) :=
-⟨λ n, hf.approx n * hg.approx n, λ x, (hf.tendsto_approx x).mul (hg.tendsto_approx x)⟩
-
-@[to_additive]
-lemma mul_const [has_mul β] [has_continuous_mul β] (hf : strongly_measurable f) (c : β) :
-  strongly_measurable (λ x, f x * c) :=
-hf.mul strongly_measurable_const
-
-@[to_additive]
-lemma const_mul [has_mul β] [has_continuous_mul β] (hf : strongly_measurable f) (c : β) :
-  strongly_measurable (λ x, c * f x) :=
-strongly_measurable_const.mul hf
-
-@[to_additive]
-protected lemma inv [group β] [topological_group β] (hf : strongly_measurable f) :
-  strongly_measurable f⁻¹ :=
-⟨λ n, (hf.approx n)⁻¹, λ x, (hf.tendsto_approx x).inv⟩
-
-@[to_additive]
-protected lemma div [has_div β] [has_continuous_div β]
-  (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (f / g) :=
-⟨λ n, hf.approx n / hg.approx n, λ x, (hf.tendsto_approx x).div' (hg.tendsto_approx x)⟩
-
-@[to_additive]
-protected lemma smul {𝕜} [topological_space 𝕜] [has_scalar 𝕜 β] [has_continuous_smul 𝕜 β]
-  {f : α → 𝕜} {g : α → β} (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (λ x, f x • g x) :=
-continuous_smul.comp_strongly_measurable (hf.prod_mk hg)
-
-protected lemma const_smul {𝕜} [has_scalar 𝕜 β] [has_continuous_const_smul 𝕜 β]
-  (hf : strongly_measurable f) (c : 𝕜) :
-  strongly_measurable (c • f) :=
-⟨λ n, c • (hf.approx n), λ x, (hf.tendsto_approx x).const_smul c⟩
-
-protected lemma const_smul' {𝕜} [has_scalar 𝕜 β] [has_continuous_const_smul 𝕜 β]
-  (hf : strongly_measurable f) (c : 𝕜) :
-  strongly_measurable (λ x, c • (f x)) :=
-hf.const_smul c
-
-@[to_additive]
-protected lemma smul_const {𝕜} [topological_space 𝕜] [has_scalar 𝕜 β] [has_continuous_smul 𝕜 β]
-  {f : α → 𝕜} (hf : strongly_measurable f) (c : β) :
-  strongly_measurable (λ x, f x • c) :=
-continuous_smul.comp_strongly_measurable (hf.prod_mk strongly_measurable_const)
-
-end arithmetic
-
-section mul_action
-
-variables [topological_space β] {G : Type*} [group G] [mul_action G β]
-  [has_continuous_const_smul G β]
-
-lemma _root_.strongly_measurable_const_smul_iff {m : measurable_space α} (c : G) :
-  strongly_measurable (λ x, c • f x) ↔ strongly_measurable f :=
-⟨λ h, by simpa only [inv_smul_smul] using h.const_smul' c⁻¹, λ h, h.const_smul c⟩
-
-variables {G₀ : Type*} [group_with_zero G₀] [mul_action G₀ β]
-  [has_continuous_const_smul G₀ β]
-
-lemma _root_.strongly_measurable_const_smul_iff₀ {m : measurable_space α} {c : G₀} (hc : c ≠ 0) :
-  strongly_measurable (λ x, c • f x) ↔ strongly_measurable f :=
-begin
-  refine ⟨λ h, _, λ h, h.const_smul c⟩,
-  convert h.const_smul' c⁻¹,
-  simp [smul_smul, inv_mul_cancel hc]
-end
-
-end mul_action
-
-section order
-variables [measurable_space α] [topological_space β]
-
-open filter
-open_locale filter
-
-protected lemma sup [has_sup β] [has_continuous_sup β] (hf : strongly_measurable f)
-  (hg : strongly_measurable g) :
-  strongly_measurable (f ⊔ g) :=
-⟨λ n, hf.approx n ⊔ hg.approx n, λ x, (hf.tendsto_approx x).sup_right_nhds (hg.tendsto_approx x)⟩
-
-protected lemma inf [has_inf β] [has_continuous_inf β] (hf : strongly_measurable f)
-  (hg : strongly_measurable g) :
-  strongly_measurable (f ⊓ g) :=
-⟨λ n, hf.approx n ⊓ hg.approx n, λ x, (hf.tendsto_approx x).inf_right_nhds (hg.tendsto_approx x)⟩
-
-end order
-
-/-!
-### Big operators: `∏` and `∑`
--/
-
-section monoid
-variables {M : Type*} [monoid M] [topological_space M] [has_continuous_mul M]
-  {m : measurable_space α}
-
-include m
-
-@[to_additive]
-lemma _root_.list.strongly_measurable_prod'
-  (l : list (α → M)) (hl : ∀ f ∈ l, strongly_measurable f) :
-  strongly_measurable l.prod :=
-begin
-  induction l with f l ihl, { exact strongly_measurable_one },
-  rw [list.forall_mem_cons] at hl,
-  rw [list.prod_cons],
-  exact hl.1.mul (ihl hl.2)
-end
-
-@[to_additive]
-lemma _root_.list.strongly_measurable_prod
-  (l : list (α → M)) (hl : ∀ f ∈ l, strongly_measurable f) :
-  strongly_measurable (λ x, (l.map (λ f : α → M, f x)).prod) :=
-by simpa only [← pi.list_prod_apply] using l.strongly_measurable_prod' hl
-
-end monoid
-
-section comm_monoid
-variables {M : Type*} [comm_monoid M] [topological_space M] [has_continuous_mul M]
-  {m : measurable_space α}
-
-include m
-
-@[to_additive]
-lemma _root_.multiset.strongly_measurable_prod'
-  (l : multiset (α → M)) (hl : ∀ f ∈ l, strongly_measurable f) :
-  strongly_measurable l.prod :=
-by { rcases l with ⟨l⟩, simpa using l.strongly_measurable_prod' (by simpa using hl) }
-
-@[to_additive]
-lemma _root_.multiset.strongly_measurable_prod
-  (s : multiset (α → M)) (hs : ∀ f ∈ s, strongly_measurable f) :
-  strongly_measurable (λ x, (s.map (λ f : α → M, f x)).prod) :=
-by simpa only [← pi.multiset_prod_apply] using s.strongly_measurable_prod' hs
-
-@[to_additive]
-lemma _root_.finset.strongly_measurable_prod'
-  {ι : Type*} {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, strongly_measurable (f i)) :
-  strongly_measurable (∏ i in s, f i) :=
-finset.prod_induction _ _ (λ a b ha hb, ha.mul hb) (@strongly_measurable_one α M _ _ _) hf
-
-@[to_additive]
-lemma _root_.finset.strongly_measurable_prod
-  {ι : Type*} {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, strongly_measurable (f i)) :
-  strongly_measurable (λ a, ∏ i in s, f i a) :=
-by simpa only [← finset.prod_apply] using s.strongly_measurable_prod' hf
-
-end comm_monoid
-
-/-- The range of a strongly measurable function is separable. -/
-lemma is_separable_range {m : measurable_space α} [topological_space β]
-  (hf : strongly_measurable f) :
-  topological_space.is_separable (range f) :=
-begin
-  have : is_separable (closure (⋃ n, range (hf.approx n))) :=
-    (is_separable_Union (λ n, (simple_func.finite_range (hf.approx n)).is_separable)).closure,
-  apply this.mono,
-  rintros - ⟨x, rfl⟩,
-  apply mem_closure_of_tendsto (hf.tendsto_approx x),
-  apply eventually_of_forall (λ n, _),
-  apply mem_Union_of_mem n,
-  exact mem_range_self _
-end
-
-lemma separable_space_range_union_singleton {m : measurable_space α} [topological_space β]
-  [metrizable_space β] (hf : strongly_measurable f) {b : β} :
-  separable_space (range f ∪ {b} : set β) :=
-begin
-  letI := metrizable_space_metric β,
-  exact (is_separable.union hf.is_separable_range (finite_singleton _).is_separable).separable_space
-end
-
-section second_countable_strongly_measurable
-
-variables {mα : measurable_space α} [measurable_space β]
-include mα
-
-/-- In a space with second countable topology, measurable implies strongly measurable. -/
-lemma _root_.measurable.strongly_measurable [topological_space β] [metrizable_space β]
-  [second_countable_topology β] [opens_measurable_space β] (hf : measurable f) :
-  strongly_measurable f :=
-begin
-  letI := metrizable_space_metric β,
-  rcases is_empty_or_nonempty β; resetI,
-  { exact subsingleton.strongly_measurable f, },
-  { inhabit β,
-    exact ⟨simple_func.approx_on f hf set.univ default (set.mem_univ _),
-      λ x, simple_func.tendsto_approx_on hf (set.mem_univ _) (by simp)⟩, },
-end
-
-/-- In a space with second countable topology, strongly measurable and measurable are equivalent. -/
-lemma _root_.strongly_measurable_iff_measurable
-  [topological_space β] [metrizable_space β] [borel_space β] [second_countable_topology β] :
-  strongly_measurable f ↔ measurable f :=
-⟨λ h, h.measurable, λ h, measurable.strongly_measurable h⟩
-
-lemma _root_.strongly_measurable_id [topological_space α] [metrizable_space α]
-  [opens_measurable_space α] [second_countable_topology α] :
-  strongly_measurable (id : α → α) :=
-measurable_id.strongly_measurable
-
-end second_countable_strongly_measurable
-
-/-- A function is strongly measurable if and only if it is measurable and has separable
-range. -/
-theorem _root_.strongly_measurable_iff_measurable_separable {m : measurable_space α}
-  [topological_space β] [metrizable_space β] [measurable_space β] [borel_space β] :
-  strongly_measurable f ↔ (measurable f ∧ is_separable (range f)) :=
-begin
-  refine ⟨λ H, ⟨H.measurable, H.is_separable_range⟩, _⟩,
-  rintros ⟨H, H'⟩,
-  letI := metrizable_space_metric β,
-  let g := cod_restrict f (closure (range f)) (λ x, subset_closure (mem_range_self x)),
-  have fg : f = (coe : closure (range f) → β) ∘ g, by { ext x, refl },
-  have T : measurable_embedding (coe : closure (range f) → β),
-  { apply closed_embedding.measurable_embedding,
-    exact closed_embedding_subtype_coe is_closed_closure },
-  have g_meas : measurable g,
-  { rw fg at H, exact T.measurable_comp_iff.1 H },
-  haveI : second_countable_topology (closure (range f)),
-  { suffices : separable_space (closure (range f)),
-      by exactI uniform_space.second_countable_of_separable _,
-    exact (is_separable.closure H').separable_space },
-  have g_smeas : strongly_measurable g := measurable.strongly_measurable g_meas,
-  rw fg,
-  exact continuous_subtype_coe.comp_strongly_measurable g_smeas,
-end
-
-/-- A continuous function is strongly measurable when either the source space or the target space
-is second-countable. -/
-lemma _root_.continuous.strongly_measurable [measurable_space α]
-  [topological_space α] [opens_measurable_space α]
-  {β : Type*} [topological_space β] [metrizable_space β] [h : second_countable_topology_either α β]
-  {f : α → β} (hf : continuous f) :
-  strongly_measurable f :=
-begin
-  borelize β,
-  casesI h.out,
-  { rw strongly_measurable_iff_measurable_separable,
-    refine ⟨hf.measurable, _⟩,
-    rw ← image_univ,
-    exact (is_separable_of_separable_space univ).image hf },
-  { exact hf.measurable.strongly_measurable }
-end
-
-/-- If `g` is a topological embedding, then `f` is strongly measurable iff `g ∘ f` is. -/
-lemma _root_.embedding.comp_strongly_measurable_iff {m : measurable_space α}
-  [topological_space β] [metrizable_space β] [topological_space γ] [metrizable_space γ]
-  {g : β → γ} {f : α → β} (hg : embedding g) :
-  strongly_measurable (λ x, g (f x)) ↔ strongly_measurable f :=
-begin
-  letI := metrizable_space_metric γ,
-  borelize [β, γ],
-  refine ⟨λ H, strongly_measurable_iff_measurable_separable.2 ⟨_, _⟩,
-    λ H, hg.continuous.comp_strongly_measurable H⟩,
-  { let G : β → range g := cod_restrict g (range g) mem_range_self,
-    have hG : closed_embedding G :=
-    { closed_range :=
-      begin
-        convert is_closed_univ,
-        apply eq_univ_of_forall,
-        rintros ⟨-, ⟨x, rfl⟩⟩,
-        exact mem_range_self x
-      end,
-      .. hg.cod_restrict _ _ },
-    have : measurable (G ∘ f) := measurable.subtype_mk H.measurable,
-    exact hG.measurable_embedding.measurable_comp_iff.1 this },
-  { have : is_separable (g ⁻¹' (range (g ∘ f))) := hg.is_separable_preimage H.is_separable_range,
-    convert this,
-    ext x,
-    simp [hg.inj.eq_iff] }
-end
-
-/-- A sequential limit of strongly measurable functions is strongly measurable. -/
-lemma _root_.strongly_measurable_of_tendsto {ι : Type*} {m : measurable_space α}
-  [topological_space β] [metrizable_space β] (u : filter ι) [ne_bot u] [is_countably_generated u]
-  {f : ι → α → β} {g : α → β} (hf : ∀ i, strongly_measurable (f i)) (lim : tendsto f u (𝓝 g)) :
-  strongly_measurable g :=
-begin
-  letI := metrizable_space_metric β,
-  borelize β,
-  refine strongly_measurable_iff_measurable_separable.2 ⟨_, _⟩,
-  { apply measurable_of_tendsto_metrizable' u (λ i, _) lim,
-    exact (hf i).measurable },
-  { rcases u.exists_seq_tendsto with ⟨v, hv⟩,
-    have : is_separable (closure (⋃ i, range (f (v i)))) :=
-      (is_separable_Union (λ i, (hf (v i)).is_separable_range)).closure,
-    apply this.mono,
-    rintros - ⟨x, rfl⟩,
-    rw [tendsto_pi_nhds] at lim,
-    apply mem_closure_of_tendsto ((lim x).comp hv),
-    apply eventually_of_forall (λ n, _),
-    apply mem_Union_of_mem n,
-    exact mem_range_self _ }
-end
-
-protected lemma piecewise {m : measurable_space α} [topological_space β]
-  {s : set α} {_ : decidable_pred (∈ s)} (hs : measurable_set s)
-  (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (set.piecewise s f g) :=
-begin
-  refine ⟨λ n, simple_func.piecewise s hs (hf.approx n) (hg.approx n), λ x, _⟩,
-  by_cases hx : x ∈ s,
-  { simpa [hx] using hf.tendsto_approx x },
-  { simpa [hx] using hg.tendsto_approx x },
-end
-
-/-- this is slightly different from `strongly_measurable.piecewise`. It can be used to show
-`strongly_measurable (ite (x=0) 0 1)` by
-`exact strongly_measurable.ite (measurable_set_singleton 0) strongly_measurable_const
-strongly_measurable_const`, but replacing `strongly_measurable.ite` by
-`strongly_measurable.piecewise` in that example proof does not work. -/
-protected lemma ite {m : measurable_space α} [topological_space β]
-  {p : α → Prop} {_ : decidable_pred p}
-  (hp : measurable_set {a : α | p a}) (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (λ x, ite (p x) (f x) (g x)) :=
-strongly_measurable.piecewise hp hf hg
-
-lemma _root_.strongly_measurable_of_strongly_measurable_union_cover
-  {m : measurable_space α} [topological_space β]
-  {f : α → β} (s t : set α) (hs : measurable_set s) (ht : measurable_set t) (h : univ ⊆ s ∪ t)
-  (hc : strongly_measurable (λ a : s, f a)) (hd : strongly_measurable (λ a : t, f a)) :
-  strongly_measurable f :=
-begin
-  classical,
-  let f : ℕ → α →ₛ β := λ n,
-  { to_fun := λ x, if hx : x ∈ s then hc.approx n ⟨x, hx⟩
-                   else hd.approx n ⟨x, by simpa [hx] using h (mem_univ x)⟩,
-    measurable_set_fiber' :=
-    begin
-      assume x,
-      convert (hs.subtype_image
-        ((hc.approx n).measurable_set_fiber x)).union
-        ((ht.subtype_image
-        ((hd.approx n).measurable_set_fiber x)).diff hs),
-      ext1 y,
-      simp only [mem_union_eq, mem_preimage, mem_singleton_iff, mem_image, set_coe.exists,
-        subtype.coe_mk, exists_and_distrib_right, exists_eq_right, mem_diff],
-      by_cases hy : y ∈ s,
-      { rw dif_pos hy,
-        simp only [hy, exists_true_left, not_true, and_false, or_false]},
-      { rw dif_neg hy,
-        have A : y ∈ t, by simpa [hy] using h (mem_univ y),
-        simp only [A, hy, false_or, exists_false_left, not_false_iff, and_true, exists_true_left] }
-    end,
-    finite_range' :=
-    begin
-      apply ((hc.approx n).finite_range.union (hd.approx n).finite_range).subset,
-      rintros - ⟨y, rfl⟩,
-      dsimp,
-      by_cases hy : y ∈ s,
-      { left,
-        rw dif_pos hy,
-        exact mem_range_self _ },
-      { right,
-        rw dif_neg hy,
-        exact mem_range_self _ }
-    end },
-  refine ⟨f, λ y, _⟩,
-  by_cases hy : y ∈ s,
-  { convert hc.tendsto_approx ⟨y, hy⟩ using 1,
-    ext1 n,
-    simp only [dif_pos hy, simple_func.apply_mk] },
-  { have A : y ∈ t, by simpa [hy] using h (mem_univ y),
-    convert hd.tendsto_approx ⟨y, A⟩ using 1,
-    ext1 n,
-    simp only [dif_neg hy, simple_func.apply_mk] }
-end
-
-lemma _root_.strongly_measurable_of_restrict_of_restrict_compl
-  {m : measurable_space α} [topological_space β] {f : α → β} {s : set α} (hs : measurable_set s)
-  (h₁ : strongly_measurable (s.restrict f)) (h₂ : strongly_measurable (sᶜ.restrict f)) :
-  strongly_measurable f :=
-strongly_measurable_of_strongly_measurable_union_cover s sᶜ hs hs.compl
-  (union_compl_self s).ge h₁ h₂
-
-protected lemma indicator {m : measurable_space α} [topological_space β] [has_zero β]
-  (hf : strongly_measurable f) {s : set α} (hs : measurable_set s) :
-  strongly_measurable (s.indicator f) :=
-hf.piecewise hs strongly_measurable_const
-
-protected lemma dist {m : measurable_space α} {β : Type*} [pseudo_metric_space β] {f g : α → β}
-  (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (λ x, dist (f x) (g x)) :=
-continuous_dist.comp_strongly_measurable (hf.prod_mk hg)
-
-protected lemma norm {m : measurable_space α} {β : Type*} [normed_group β] {f : α → β}
-  (hf : strongly_measurable f) :
-  strongly_measurable (λ x, ∥f x∥) :=
-continuous_norm.comp_strongly_measurable hf
-
-protected lemma nnnorm {m : measurable_space α} {β : Type*} [normed_group β] {f : α → β}
-  (hf : strongly_measurable f) :
-  strongly_measurable (λ x, ∥f x∥₊) :=
-continuous_nnnorm.comp_strongly_measurable hf
-
-protected lemma ennnorm {m : measurable_space α} {β : Type*} [normed_group β] {f : α → β}
-  (hf : strongly_measurable f) :
-  measurable (λ a, (∥f a∥₊ : ℝ≥0∞)) :=
-(ennreal.continuous_coe.comp_strongly_measurable hf.nnnorm).measurable
-
-protected lemma real_to_nnreal {m : measurable_space α} {f : α → ℝ}
-  (hf : strongly_measurable f) :
-  strongly_measurable (λ x, (f x).to_nnreal) :=
-continuous_real_to_nnreal.comp_strongly_measurable hf
-
-lemma _root_.measurable_embedding.strongly_measurable_extend {f : α → β} {g : α → γ} {g' : γ → β}
-  {mα : measurable_space α} {mγ : measurable_space γ} [topological_space β]
-  (hg : measurable_embedding g)
-  (hf : strongly_measurable f) (hg' : strongly_measurable g') :
-  strongly_measurable (function.extend g f g') :=
-begin
-  refine ⟨λ n, simple_func.extend (hf.approx n) g hg (hg'.approx n), _⟩,
-  assume x,
-  by_cases hx : ∃ y, g y = x,
-  { rcases hx with ⟨y, rfl⟩,
-    simpa only [simple_func.extend_apply, hg.injective, extend_apply] using hf.tendsto_approx y },
-  { simpa only [hx, simple_func.extend_apply', not_false_iff, extend_apply']
-      using hg'.tendsto_approx x }
-end
-
-lemma _root_.measurable_embedding.exists_strongly_measurable_extend
-  {f : α → β} {g : α → γ}
-  {mα : measurable_space α} {mγ : measurable_space γ} [topological_space β]
-  (hg : measurable_embedding g) (hf : strongly_measurable f) (hne : γ → nonempty β) :
-  ∃ f' : γ → β, strongly_measurable f' ∧ f' ∘ g = f :=
-⟨function.extend g f (λ x, classical.choice (hne x)),
-  hg.strongly_measurable_extend hf (strongly_measurable_const' $ λ _ _, rfl),
-  funext $ λ x, extend_apply hg.injective _ _ _⟩
-
-protected lemma inner {𝕜 : Type*} {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
-  {m : measurable_space α} {f g : α → E} (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  strongly_measurable (λ t, @inner 𝕜 _ _(f t) (g t)) :=
-continuous.comp_strongly_measurable continuous_inner (hf.prod_mk hg)
-
-lemma measurable_set_eq_fun {m : measurable_space α} {E} [topological_space E] [metrizable_space E]
-  {f g : α → E} (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  measurable_set {x | f x = g x} :=
-begin
-  letI := metrizable_space_metric E,
-  have : {x | f x = g x} = {x | dist (f x) (g x) = 0}, by { ext x, simp },
-  rw this,
-  exact (hf.dist hg).measurable (measurable_set_singleton (0 : ℝ)),
-end
-
-lemma measurable_set_lt {m : measurable_space α} [topological_space β]
-  [linear_order β] [order_closed_topology β] [metrizable_space β]
-  {f g : α → β} (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  measurable_set {a | f a < g a} :=
-begin
-  letI := metrizable_space_metric β,
-  let β' : Type* := (range f ∪ range g : set β),
-  haveI : second_countable_topology β',
-  { suffices : separable_space (range f ∪ range g : set β),
-      by exactI uniform_space.second_countable_of_separable _,
-    apply (hf.is_separable_range.union hg.is_separable_range).separable_space },
-  let f' : α → β' := cod_restrict f _ (by simp),
-  let g' : α → β' := cod_restrict g _ (by simp),
-  change measurable_set {a | f' a < g' a},
-  borelize β,
-  exact measurable_set_lt hf.measurable.subtype_mk hg.measurable.subtype_mk,
-end
-
-lemma measurable_set_le {m : measurable_space α} [topological_space β]
-  [linear_order β] [order_closed_topology β] [metrizable_space β]
-  {f g : α → β} (hf : strongly_measurable f) (hg : strongly_measurable g) :
-  measurable_set {a | f a ≤ g a} :=
-begin
-  letI := metrizable_space_metric β,
-  let β' : Type* := (range f ∪ range g : set β),
-  haveI : second_countable_topology β',
-  { suffices : separable_space (range f ∪ range g : set β),
-      by exactI uniform_space.second_countable_of_separable _,
-    apply (hf.is_separable_range.union hg.is_separable_range).separable_space },
-  let f' : α → β' := cod_restrict f _ (by simp),
-  let g' : α → β' := cod_restrict g _ (by simp),
-  change measurable_set {a | f' a ≤ g' a},
-  borelize β,
-  exact measurable_set_le hf.measurable.subtype_mk hg.measurable.subtype_mk,
-end
-
-end strongly_measurable
-
-/-! ## Finitely strongly measurable functions -/
-
-lemma fin_strongly_measurable_zero {α β} {m : measurable_space α} {μ : measure α} [has_zero β]
-  [topological_space β] :
-  fin_strongly_measurable (0 : α → β) μ :=
-⟨0, by simp only [pi.zero_apply, simple_func.coe_zero, support_zero', measure_empty,
-    with_top.zero_lt_top, forall_const],
-  λ n, tendsto_const_nhds⟩
-
-namespace fin_strongly_measurable
-
-variables {m0 : measurable_space α} {μ : measure α} {f g : α → β}
-
-lemma ae_fin_strongly_measurable [has_zero β] [topological_space β]
-  (hf : fin_strongly_measurable f μ) :
-  ae_fin_strongly_measurable f μ :=
-⟨f, hf, ae_eq_refl f⟩
-
-section sequence
-variables [has_zero β] [topological_space β] (hf : fin_strongly_measurable f μ)
-
-/-- A sequence of simple functions such that `∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x))`
-and `∀ n, μ (support (hf.approx n)) < ∞`. These properties are given by
-`fin_strongly_measurable.tendsto_approx` and `fin_strongly_measurable.fin_support_approx`. -/
-protected noncomputable def approx : ℕ → α →ₛ β := hf.some
-
-protected lemma fin_support_approx : ∀ n, μ (support (hf.approx n)) < ∞ := hf.some_spec.1
-
-protected lemma tendsto_approx : ∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x)) :=
-hf.some_spec.2
-
-end sequence
-
-protected lemma strongly_measurable [has_zero β] [topological_space β]
-  (hf : fin_strongly_measurable f μ) :
-  strongly_measurable f :=
-⟨hf.approx, hf.tendsto_approx⟩
-
-lemma exists_set_sigma_finite [has_zero β] [topological_space β] [t2_space β]
-  (hf : fin_strongly_measurable f μ) :
-  ∃ t, measurable_set t ∧ (∀ x ∈ tᶜ, f x = 0) ∧ sigma_finite (μ.restrict t) :=
-begin
-  rcases hf with ⟨fs, hT_lt_top, h_approx⟩,
-  let T := λ n, support (fs n),
-  have hT_meas : ∀ n, measurable_set (T n), from λ n, simple_func.measurable_set_support (fs n),
-  let t := ⋃ n, T n,
-  refine ⟨t, measurable_set.Union hT_meas, _, _⟩,
-  { have h_fs_zero : ∀ n, ∀ x ∈ tᶜ, fs n x = 0,
-    { intros n x hxt,
-      rw [set.mem_compl_iff, set.mem_Union, not_exists] at hxt,
-      simpa using (hxt n), },
-    refine λ x hxt, tendsto_nhds_unique (h_approx x) _,
-    rw funext (λ n, h_fs_zero n x hxt),
-    exact tendsto_const_nhds, },
-  { refine ⟨⟨⟨λ n, tᶜ ∪ T n, λ n, trivial, λ n, _, _⟩⟩⟩,
-    { rw [measure.restrict_apply' (measurable_set.Union hT_meas), set.union_inter_distrib_right,
-        set.compl_inter_self t, set.empty_union],
-      exact (measure_mono (set.inter_subset_left _ _)).trans_lt (hT_lt_top n), },
-    { rw ← set.union_Union tᶜ T,
-      exact set.compl_union_self _ } }
-end
-
-/-- A finitely strongly measurable function is measurable. -/
-protected lemma measurable [has_zero β] [topological_space β] [metrizable_space β]
-  [measurable_space β] [borel_space β] (hf : fin_strongly_measurable f μ) :
-  measurable f :=
-hf.strongly_measurable.measurable
-
-section arithmetic
-variables [topological_space β]
-
-protected lemma mul [monoid_with_zero β] [has_continuous_mul β]
-  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
-  fin_strongly_measurable (f * g) μ :=
-begin
-  refine ⟨λ n, hf.approx n * hg.approx n, _, λ x, (hf.tendsto_approx x).mul (hg.tendsto_approx x)⟩,
-  intro n,
-  exact (measure_mono (support_mul_subset_left _ _)).trans_lt (hf.fin_support_approx n),
-end
-
-protected lemma add [add_monoid β] [has_continuous_add β]
-  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
-  fin_strongly_measurable (f + g) μ :=
-⟨λ n, hf.approx n + hg.approx n,
-  λ n, (measure_mono (function.support_add _ _)).trans_lt ((measure_union_le _ _).trans_lt
-    (ennreal.add_lt_top.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩)),
-  λ x, (hf.tendsto_approx x).add (hg.tendsto_approx x)⟩
-
-protected lemma neg [add_group β] [topological_add_group β] (hf : fin_strongly_measurable f μ) :
-  fin_strongly_measurable (-f) μ :=
-begin
-  refine ⟨λ n, -hf.approx n, λ n, _, λ x, (hf.tendsto_approx x).neg⟩,
-  suffices : μ (function.support (λ x, - (hf.approx n) x)) < ∞, by convert this,
-  rw function.support_neg (hf.approx n),
-  exact hf.fin_support_approx n,
-end
-
-protected lemma sub [add_group β] [has_continuous_sub β]
-  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
-  fin_strongly_measurable (f - g) μ :=
-⟨λ n, hf.approx n - hg.approx n,
-  λ n, (measure_mono (function.support_sub _ _)).trans_lt ((measure_union_le _ _).trans_lt
-    (ennreal.add_lt_top.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩)),
-  λ x, (hf.tendsto_approx x).sub (hg.tendsto_approx x)⟩
-
-protected lemma const_smul {𝕜} [topological_space 𝕜] [add_monoid β] [monoid 𝕜]
-  [distrib_mul_action 𝕜 β] [has_continuous_smul 𝕜 β]
-  (hf : fin_strongly_measurable f μ) (c : 𝕜) :
-  fin_strongly_measurable (c • f) μ :=
-begin
-  refine ⟨λ n, c • (hf.approx n), λ n, _, λ x, (hf.tendsto_approx x).const_smul c⟩,
-  rw simple_func.coe_smul,
-  refine (measure_mono (support_smul_subset_right c _)).trans_lt (hf.fin_support_approx n),
-end
-
-end arithmetic
-
-section order
-variables [topological_space β] [has_zero β]
-
-protected lemma sup [semilattice_sup β] [has_continuous_sup β]
-  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
-  fin_strongly_measurable (f ⊔ g) μ :=
-begin
-  refine ⟨λ n, hf.approx n ⊔ hg.approx n, λ n, _,
-    λ x, (hf.tendsto_approx x).sup_right_nhds (hg.tendsto_approx x)⟩,
-  refine (measure_mono (support_sup _ _)).trans_lt _,
-  exact measure_union_lt_top_iff.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩,
-end
-
-protected lemma inf [semilattice_inf β] [has_continuous_inf β]
-  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
-  fin_strongly_measurable (f ⊓ g) μ :=
-begin
-  refine ⟨λ n, hf.approx n ⊓ hg.approx n, λ n, _,
-    λ x, (hf.tendsto_approx x).inf_right_nhds (hg.tendsto_approx x)⟩,
-  refine (measure_mono (support_inf _ _)).trans_lt _,
-  exact measure_union_lt_top_iff.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩,
-end
-
-end order
-
-end fin_strongly_measurable
-
-lemma fin_strongly_measurable_iff_strongly_measurable_and_exists_set_sigma_finite {α β} {f : α → β}
-  [topological_space β] [t2_space β] [has_zero β] {m : measurable_space α} {μ : measure α} :
-  fin_strongly_measurable f μ ↔ (strongly_measurable f
-    ∧ (∃ t, measurable_set t ∧ (∀ x ∈ tᶜ, f x = 0) ∧ sigma_finite (μ.restrict t))) :=
-⟨λ hf, ⟨hf.strongly_measurable, hf.exists_set_sigma_finite⟩,
-  λ hf, hf.1.fin_strongly_measurable_of_set_sigma_finite hf.2.some_spec.1 hf.2.some_spec.2.1
-    hf.2.some_spec.2.2⟩
-
-lemma ae_fin_strongly_measurable_zero {α β} {m : measurable_space α} (μ : measure α) [has_zero β]
-  [topological_space β] :
-  ae_fin_strongly_measurable (0 : α → β) μ :=
-⟨0, fin_strongly_measurable_zero, eventually_eq.rfl⟩
-
-
-/-! ## Almost everywhere strongly measurable functions -/
-
-lemma ae_strongly_measurable_const {α β} {m : measurable_space α} {μ : measure α}
-  [topological_space β] {b : β} :
-  ae_strongly_measurable (λ a : α, b) μ :=
-strongly_measurable_const.ae_strongly_measurable
-
-@[to_additive] lemma ae_strongly_measurable_one {α β} {m : measurable_space α} {μ : measure α}
-  [topological_space β] [has_one β] :
-  ae_strongly_measurable (1 : α → β) μ :=
-strongly_measurable_one.ae_strongly_measurable
-
-@[simp] lemma subsingleton.ae_strongly_measurable {m : measurable_space α} [topological_space β]
-  [subsingleton β] {μ : measure α} (f : α → β) :
-  ae_strongly_measurable f μ :=
-(subsingleton.strongly_measurable f).ae_strongly_measurable
-
-@[simp] lemma subsingleton.ae_strongly_measurable' {m : measurable_space α} [topological_space β]
-  [subsingleton α] {μ : measure α} (f : α → β) :
-  ae_strongly_measurable f μ :=
-(subsingleton.strongly_measurable' f).ae_strongly_measurable
-
-@[simp] lemma ae_measurable_zero_measure [measurable_space α] [topological_space β]
-  (f : α → β) :
-  ae_strongly_measurable f (0 : measure α) :=
-begin
-  nontriviality α,
-  inhabit α,
-  exact ⟨λ x, f default, strongly_measurable_const, rfl⟩
-end
-
-lemma simple_func.ae_strongly_measurable {m : measurable_space α} {μ : measure α}
-  [topological_space β] (f : α →ₛ β) :
-  ae_strongly_measurable f μ :=
-f.strongly_measurable.ae_strongly_measurable
-
-namespace ae_strongly_measurable
-
-variables {m : measurable_space α} {μ : measure α} [topological_space β] [topological_space γ]
-  {f g : α → β}
-
-section mk
-
-/-- A `strongly_measurable` function such that `f =ᵐ[μ] hf.mk f`. See lemmas
-`strongly_measurable_mk` and `ae_eq_mk`. -/
-protected noncomputable def mk (f : α → β) (hf : ae_strongly_measurable f μ) : α → β := hf.some
-
-lemma strongly_measurable_mk (hf : ae_strongly_measurable f μ) :
-  strongly_measurable (hf.mk f) :=
-hf.some_spec.1
-
-lemma measurable_mk [metrizable_space β] [measurable_space β] [borel_space β]
-  (hf : ae_strongly_measurable f μ) :
-  measurable (hf.mk f) :=
-hf.strongly_measurable_mk.measurable
-
-lemma ae_eq_mk (hf : ae_strongly_measurable f μ) : f =ᵐ[μ] hf.mk f :=
-hf.some_spec.2
-
-protected lemma ae_measurable {β} [measurable_space β] [topological_space β] [metrizable_space β]
-  [borel_space β] {f : α → β} (hf : ae_strongly_measurable f μ) :
-  ae_measurable f μ :=
-⟨hf.mk f, hf.strongly_measurable_mk.measurable, hf.ae_eq_mk⟩
-
-end mk
-
-lemma congr (hf : ae_strongly_measurable f μ) (h : f =ᵐ[μ] g) : ae_strongly_measurable g μ :=
-⟨hf.mk f, hf.strongly_measurable_mk, h.symm.trans hf.ae_eq_mk⟩
-
-lemma _root_.ae_strongly_measurable_congr (h : f =ᵐ[μ] g) :
-  ae_strongly_measurable f μ ↔ ae_strongly_measurable g μ :=
-⟨λ hf, hf.congr h, λ hg, hg.congr h.symm⟩
-
-lemma mono_measure {ν : measure α} (hf : ae_strongly_measurable f μ) (h : ν ≤ μ) :
-  ae_strongly_measurable f ν :=
-⟨hf.mk f, hf.strongly_measurable_mk, eventually.filter_mono (ae_mono h) hf.ae_eq_mk⟩
-
-protected lemma mono' {ν : measure α} (h : ae_strongly_measurable f μ) (h' : ν ≪ μ) :
-  ae_strongly_measurable f ν :=
-⟨h.mk f, h.strongly_measurable_mk, h' h.ae_eq_mk⟩
-
-lemma mono_set {s t} (h : s ⊆ t) (ht : ae_strongly_measurable f (μ.restrict t)) :
-  ae_strongly_measurable f (μ.restrict s) :=
-ht.mono_measure (restrict_mono h le_rfl)
-
-protected lemma restrict (hfm : ae_strongly_measurable f μ) {s} :
-  ae_strongly_measurable f (μ.restrict s) :=
-hfm.mono_measure measure.restrict_le_self
-
-lemma ae_mem_imp_eq_mk {s} (h : ae_strongly_measurable f (μ.restrict s)) :
-  ∀ᵐ x ∂μ, x ∈ s → f x = h.mk f x :=
-ae_imp_of_ae_restrict h.ae_eq_mk
-
-/-- The composition of a continuous function and an ae strongly measurable function is ae strongly
-measurable. -/
-lemma _root_.continuous.comp_ae_strongly_measurable {g : β → γ} {f : α → β}
-  (hg : continuous g) (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, g (f x)) μ :=
-⟨_, hg.comp_strongly_measurable hf.strongly_measurable_mk, eventually_eq.fun_comp hf.ae_eq_mk g⟩
-
-/-- A continuous function from `α` to `β` is ae strongly measurable when one of the two spaces is
-second countable. -/
-lemma _root_.continuous.ae_strongly_measurable [topological_space α] [opens_measurable_space α]
-  [metrizable_space β] [second_countable_topology_either α β] (hf : continuous f) :
-  ae_strongly_measurable f μ :=
-hf.strongly_measurable.ae_strongly_measurable
-
-protected lemma prod_mk {f : α → β} {g : α → γ}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (λ x, (f x, g x)) μ :=
-⟨λ x, (hf.mk f x, hg.mk g x), hf.strongly_measurable_mk.prod_mk hg.strongly_measurable_mk,
-  hf.ae_eq_mk.prod_mk hg.ae_eq_mk⟩
-
-/-- In a space with second countable topology, measurable implies ae strongly measurable. -/
-lemma _root_.measurable.ae_strongly_measurable {m : measurable_space α}
-  {μ : measure α} [measurable_space β] [metrizable_space β]
-  [second_countable_topology β] [opens_measurable_space β] (hf : measurable f) :
-  ae_strongly_measurable f μ :=
-hf.strongly_measurable.ae_strongly_measurable
-
-section arithmetic
-
-@[to_additive]
-protected lemma mul [has_mul β] [has_continuous_mul β]
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (f * g) μ :=
-⟨hf.mk f * hg.mk g, hf.strongly_measurable_mk.mul hg.strongly_measurable_mk,
-  hf.ae_eq_mk.mul hg.ae_eq_mk⟩
-
-@[to_additive]
-protected lemma mul_const [has_mul β] [has_continuous_mul β]
-  (hf : ae_strongly_measurable f μ) (c : β) :
-  ae_strongly_measurable (λ x, f x * c) μ :=
-hf.mul ae_strongly_measurable_const
-
-@[to_additive]
-protected lemma const_mul [has_mul β] [has_continuous_mul β]
-  (hf : ae_strongly_measurable f μ) (c : β) :
-  ae_strongly_measurable (λ x, c * f x) μ :=
-ae_strongly_measurable_const.mul hf
-
-@[to_additive]
-protected lemma inv [group β] [topological_group β] (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (f⁻¹) μ :=
-⟨(hf.mk f)⁻¹, hf.strongly_measurable_mk.inv, hf.ae_eq_mk.inv⟩
-
-@[to_additive]
-protected lemma div [group β] [topological_group β]
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (f / g) μ :=
-⟨hf.mk f / hg.mk g, hf.strongly_measurable_mk.div hg.strongly_measurable_mk,
-  hf.ae_eq_mk.div hg.ae_eq_mk⟩
-
-@[to_additive]
-protected lemma smul {𝕜} [topological_space 𝕜] [has_scalar 𝕜 β] [has_continuous_smul 𝕜 β]
-  {f : α → 𝕜} {g : α → β} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (λ x, f x • g x) μ :=
-continuous_smul.comp_ae_strongly_measurable (hf.prod_mk hg)
-
-protected lemma const_smul {𝕜} [has_scalar 𝕜 β] [has_continuous_const_smul 𝕜 β]
-  (hf : ae_strongly_measurable f μ) (c : 𝕜) :
-  ae_strongly_measurable (c • f) μ :=
-⟨c • hf.mk f, hf.strongly_measurable_mk.const_smul c, hf.ae_eq_mk.const_smul c⟩
-
-protected lemma const_smul' {𝕜} [has_scalar 𝕜 β] [has_continuous_const_smul 𝕜 β]
-  (hf : ae_strongly_measurable f μ) (c : 𝕜) :
-  ae_strongly_measurable (λ x, c • (f x)) μ :=
-hf.const_smul c
-
-@[to_additive]
-protected lemma smul_const {𝕜} [topological_space 𝕜] [has_scalar 𝕜 β] [has_continuous_smul 𝕜 β]
-  {f : α → 𝕜} (hf : ae_strongly_measurable f μ) (c : β) :
-  ae_strongly_measurable (λ x, f x • c) μ :=
-continuous_smul.comp_ae_strongly_measurable (hf.prod_mk ae_strongly_measurable_const)
-
-end arithmetic
-
-section order
-
-protected lemma sup [semilattice_sup β] [has_continuous_sup β]
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (f ⊔ g) μ :=
-⟨hf.mk f ⊔ hg.mk g, hf.strongly_measurable_mk.sup hg.strongly_measurable_mk,
-  hf.ae_eq_mk.sup hg.ae_eq_mk⟩
-
-protected lemma inf [semilattice_inf β] [has_continuous_inf β]
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (f ⊓ g) μ :=
-⟨hf.mk f ⊓ hg.mk g, hf.strongly_measurable_mk.inf hg.strongly_measurable_mk,
-  hf.ae_eq_mk.inf hg.ae_eq_mk⟩
-
-end order
-
-/-!
-### Big operators: `∏` and `∑`
--/
-
-section monoid
-variables {M : Type*} [monoid M] [topological_space M] [has_continuous_mul M]
-
-@[to_additive]
-lemma _root_.list.ae_strongly_measurable_prod' (l : list (α → M))
-  (hl : ∀ f ∈ l, ae_strongly_measurable f μ) : ae_strongly_measurable l.prod μ :=
-begin
-  induction l with f l ihl, { exact ae_strongly_measurable_one },
-  rw [list.forall_mem_cons] at hl,
-  rw [list.prod_cons],
-  exact hl.1.mul (ihl hl.2)
-end
-
-@[to_additive]
-lemma _root_.list.ae_strongly_measurable_prod
-  (l : list (α → M)) (hl : ∀ f ∈ l, ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, (l.map (λ f : α → M, f x)).prod) μ :=
-by simpa only [← pi.list_prod_apply] using l.ae_strongly_measurable_prod' hl
-
-end monoid
-
-section comm_monoid
-variables {M : Type*} [comm_monoid M] [topological_space M] [has_continuous_mul M]
-
-@[to_additive]
-lemma _root_.multiset.ae_strongly_measurable_prod' (l : multiset (α → M))
-  (hl : ∀ f ∈ l, ae_strongly_measurable f μ) : ae_strongly_measurable l.prod μ :=
-by { rcases l with ⟨l⟩, simpa using l.ae_strongly_measurable_prod' (by simpa using hl) }
-
-@[to_additive]
-lemma _root_.multiset.ae_strongly_measurable_prod (s : multiset (α → M))
-  (hs : ∀ f ∈ s, ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, (s.map (λ f : α → M, f x)).prod) μ :=
-by simpa only [← pi.multiset_prod_apply] using s.ae_strongly_measurable_prod' hs
-
-@[to_additive]
-lemma _root_.finset.ae_strongly_measurable_prod' {ι : Type*}  {f : ι → α → M}
-  (s : finset ι) (hf : ∀i ∈ s, ae_strongly_measurable (f i) μ) :
-  ae_strongly_measurable (∏ i in s, f i) μ :=
-multiset.ae_strongly_measurable_prod' _ $
-  λ g hg, let ⟨i, hi, hg⟩ := multiset.mem_map.1 hg in (hg ▸ hf _ hi)
-
-@[to_additive]
-lemma _root_.finset.ae_strongly_measurable_prod {ι : Type*}  {f : ι → α → M}
-  (s : finset ι) (hf : ∀i ∈ s, ae_strongly_measurable (f i) μ) :
-  ae_strongly_measurable (λ a, ∏ i in s, f i a) μ :=
-by simpa only [← finset.prod_apply] using s.ae_strongly_measurable_prod' hf
-
-end comm_monoid
-
-section second_countable_ae_strongly_measurable
-
-variables [measurable_space β]
-
-/-- In a space with second countable topology, measurable implies strongly measurable. -/
-lemma _root_.ae_measurable.ae_strongly_measurable [metrizable_space β]
-  [opens_measurable_space β] [second_countable_topology β] (hf : ae_measurable f μ) :
-  ae_strongly_measurable f μ :=
-⟨hf.mk f, hf.measurable_mk.strongly_measurable, hf.ae_eq_mk⟩
-
-lemma _root_.ae_strongly_measurable_id {α : Type*} [topological_space α] [metrizable_space α]
-  {m : measurable_space α} [opens_measurable_space α] [second_countable_topology α]
-  {μ : measure α} :
-  ae_strongly_measurable (id : α → α) μ :=
-ae_measurable_id.ae_strongly_measurable
-
-/-- In a space with second countable topology, strongly measurable and measurable are equivalent. -/
-lemma _root_.ae_strongly_measurable_iff_ae_measurable [metrizable_space β] [borel_space β]
-  [second_countable_topology β] :
-  ae_strongly_measurable f μ ↔ ae_measurable f μ :=
-⟨λ h, h.ae_measurable, λ h, h.ae_strongly_measurable⟩
-
-end second_countable_ae_strongly_measurable
-
-protected lemma dist {β : Type*} [pseudo_metric_space β] {f g : α → β}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (λ x, dist (f x) (g x)) μ :=
-continuous_dist.comp_ae_strongly_measurable (hf.prod_mk hg)
-
-protected lemma norm {β : Type*} [normed_group β] {f : α → β} (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, ∥f x∥) μ :=
-continuous_norm.comp_ae_strongly_measurable hf
-
-protected lemma nnnorm {β : Type*} [normed_group β] {f : α → β} (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, ∥f x∥₊) μ :=
-continuous_nnnorm.comp_ae_strongly_measurable hf
-
-protected lemma ennnorm {β : Type*} [normed_group β] {f : α → β} (hf : ae_strongly_measurable f μ) :
-  ae_measurable (λ a, (∥f a∥₊ : ℝ≥0∞)) μ :=
-(ennreal.continuous_coe.comp_ae_strongly_measurable hf.nnnorm).ae_measurable
-
-protected lemma edist {β : Type*} [normed_group β] {f g : α → β}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_measurable (λ a, edist (f a) (g a)) μ :=
-(continuous_edist.comp_ae_strongly_measurable (hf.prod_mk hg)).ae_measurable
-
-protected lemma real_to_nnreal {f : α → ℝ}
-  (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, (f x).to_nnreal) μ :=
-continuous_real_to_nnreal.comp_ae_strongly_measurable hf
-
-section
-variables {𝕜 : Type*} {E : Type*} [is_R_or_C 𝕜] [inner_product_space 𝕜 E]
-local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y
-
-protected lemma re {f : α → 𝕜} (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, is_R_or_C.re (f x)) μ :=
-is_R_or_C.continuous_re.comp_ae_strongly_measurable hf
-
-protected lemma im {f : α → 𝕜} (hf : ae_strongly_measurable f μ) :
-  ae_strongly_measurable (λ x, is_R_or_C.im (f x)) μ :=
-is_R_or_C.continuous_im.comp_ae_strongly_measurable hf
-
-protected lemma inner {m : measurable_space α} {μ : measure α} {f g : α → E}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (λ x, ⟪f x, g x⟫) μ :=
-continuous_inner.comp_ae_strongly_measurable (hf.prod_mk hg)
-
-end
-
-lemma _root_.ae_strongly_measurable_indicator_iff [has_zero β] {s : set α} (hs : measurable_set s) :
-  ae_strongly_measurable (indicator s f) μ ↔ ae_strongly_measurable f (μ.restrict s)  :=
-begin
-  split,
-  { intro h,
-    exact (h.mono_measure measure.restrict_le_self).congr (indicator_ae_eq_restrict hs) },
-  { intro h,
-    refine ⟨indicator s (h.mk f), h.strongly_measurable_mk.indicator hs, _⟩,
-    have A : s.indicator f =ᵐ[μ.restrict s] s.indicator (h.mk f) :=
-      (indicator_ae_eq_restrict hs).trans (h.ae_eq_mk.trans $ (indicator_ae_eq_restrict hs).symm),
-    have B : s.indicator f =ᵐ[μ.restrict sᶜ] s.indicator (h.mk f) :=
-      (indicator_ae_eq_restrict_compl hs).trans (indicator_ae_eq_restrict_compl hs).symm,
-    exact ae_of_ae_restrict_of_ae_restrict_compl _ A B },
-end
-
-protected lemma indicator [has_zero β]
-  (hfm : ae_strongly_measurable f μ) {s : set α} (hs : measurable_set s) :
-  ae_strongly_measurable (s.indicator f) μ :=
-(ae_strongly_measurable_indicator_iff hs).mpr hfm.restrict
-
-lemma _root_.ae_strongly_measurable_of_ae_strongly_measurable_trim {α} {m m0 : measurable_space α}
-  {μ : measure α} (hm : m ≤ m0) {f : α → β} (hf : ae_strongly_measurable f (μ.trim hm)) :
-  ae_strongly_measurable f μ :=
-⟨hf.mk f, strongly_measurable.mono hf.strongly_measurable_mk hm, ae_eq_of_ae_eq_trim hf.ae_eq_mk⟩
-
-lemma comp_ae_measurable {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α} {f : γ → α}
-  {μ : measure γ} (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
-  ae_strongly_measurable (g ∘ f) μ :=
-⟨(hg.mk g) ∘ hf.mk f, hg.strongly_measurable_mk.comp_measurable hf.measurable_mk,
-  (ae_eq_comp hf hg.ae_eq_mk).trans ((hf.ae_eq_mk).fun_comp (hg.mk g))⟩
-
-lemma comp_measurable {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α} {f : γ → α}
-  {μ : measure γ} (hg : ae_strongly_measurable g (measure.map f μ)) (hf : measurable f) :
-  ae_strongly_measurable (g ∘ f) μ :=
-hg.comp_ae_measurable hf.ae_measurable
-
-lemma comp_measurable' {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α} {f : γ → α}
-  {μ : measure γ} {ν : measure α} (hg : ae_strongly_measurable g ν) (hf : measurable f)
-  (h : μ.map f ≪ ν) : ae_strongly_measurable (g ∘ f) μ :=
-(hg.mono' h).comp_measurable hf
-
-lemma is_separable_ae_range (hf : ae_strongly_measurable f μ) :
-  ∃ (t : set β), is_separable t ∧ ∀ᵐ x ∂μ, f x ∈ t :=
-begin
-  refine ⟨range (hf.mk f), hf.strongly_measurable_mk.is_separable_range, _⟩,
-  filter_upwards [hf.ae_eq_mk] with x hx,
-  simp [hx]
-end
-
-/-- A function is almost everywhere strongly measurable if and only if it is almost everywhere
-measurable, and up to a zero measure set its range is contained in a separable set. -/
-theorem _root_.ae_strongly_measurable_iff_ae_measurable_separable
-  [metrizable_space β] [measurable_space β] [borel_space β] :
-  ae_strongly_measurable f μ ↔
-    (ae_measurable f μ ∧ ∃ (t : set β), is_separable t ∧ ∀ᵐ x ∂μ, f x ∈ t) :=
-begin
-  letI : metric_space β := metrizable_space_metric β,
-  classical,
-  refine ⟨λ H, ⟨H.ae_measurable, H.is_separable_ae_range⟩, _⟩,
-  rintros ⟨H, ⟨t, t_sep, ht⟩⟩,
-  rcases eq_empty_or_nonempty t with rfl|h₀,
-  { simp only [mem_empty_eq, eventually_false_iff_eq_bot, ae_eq_bot] at ht,
-    rw ht,
-    exact ae_measurable_zero_measure f },
-  { obtain ⟨g, g_meas, gt, fg⟩ : ∃ (g : α → β), measurable g ∧ range g ⊆ t ∧ f =ᵐ[μ] g :=
-      H.exists_ae_eq_range_subset ht h₀,
-    refine ⟨g, _, fg⟩,
-    exact strongly_measurable_iff_measurable_separable.2 ⟨g_meas, t_sep.mono gt⟩ }
-end
-
-lemma _root_.measurable_embedding.ae_strongly_measurable_map_iff
-  {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α}
-  {f : γ → α} {μ : measure γ} (hf : measurable_embedding f) {g : α → β} :
-  ae_strongly_measurable g (measure.map f μ) ↔ ae_strongly_measurable (g ∘ f) μ :=
-begin
-  refine ⟨λ H, H.comp_measurable hf.measurable, _⟩,
-  rintro ⟨g₁, hgm₁, heq⟩,
-  rcases hf.exists_strongly_measurable_extend hgm₁ (λ x, ⟨g x⟩) with ⟨g₂, hgm₂, rfl⟩,
-  exact ⟨g₂, hgm₂, hf.ae_map_iff.2 heq⟩
-end
-
-lemma _root_.embedding.ae_strongly_measurable_comp_iff
-  [metrizable_space β] [metrizable_space γ]
-  {g : β → γ} {f : α → β} (hg : embedding g) :
-  ae_strongly_measurable (λ x, g (f x)) μ ↔ ae_strongly_measurable f μ :=
-begin
-  letI := metrizable_space_metric γ,
-  borelize [β, γ],
-  refine ⟨λ H, ae_strongly_measurable_iff_ae_measurable_separable.2 ⟨_, _⟩,
-    λ H, hg.continuous.comp_ae_strongly_measurable H⟩,
-  { let G : β → range g := cod_restrict g (range g) mem_range_self,
-    have hG : closed_embedding G :=
-    { closed_range :=
-      begin
-        convert is_closed_univ,
-        apply eq_univ_of_forall,
-        rintros ⟨-, ⟨x, rfl⟩⟩,
-        exact mem_range_self x
-      end,
-      .. hg.cod_restrict _ _ },
-    have : ae_measurable (G ∘ f) μ := ae_measurable.subtype_mk H.ae_measurable,
-    exact hG.measurable_embedding.ae_measurable_comp_iff.1 this },
-  { rcases (ae_strongly_measurable_iff_ae_measurable_separable.1 H).2 with ⟨t, ht, h't⟩,
-    exact ⟨g⁻¹' t, hg.is_separable_preimage ht, h't⟩ }
-end
-
-lemma _root_.measure_theory.measure_preserving.ae_strongly_measurable_comp_iff {β : Type*}
-  {f : α → β} {mα : measurable_space α} {μa : measure α}  {mβ : measurable_space β} {μb : measure β}
-  (hf : measure_preserving f μa μb) (h₂ : measurable_embedding f) {g : β → γ} :
-  ae_strongly_measurable (g ∘ f) μa ↔ ae_strongly_measurable g μb :=
-by rw [← hf.map_eq, h₂.ae_strongly_measurable_map_iff]
-
-/-- An almost everywhere sequential limit of almost everywhere strongly measurable functions is
-almost everywhere strongly measurable. -/
-lemma _root_.ae_strongly_measurable_of_tendsto_ae {ι : Type*}
-  [metrizable_space β] (u : filter ι) [ne_bot u] [is_countably_generated u]
-  {f : ι → α → β} {g : α → β} (hf : ∀ i, ae_strongly_measurable (f i) μ)
-  (lim : ∀ᵐ x ∂μ, tendsto (λ n, f n x) u (𝓝 (g x))) :
-  ae_strongly_measurable g μ :=
-begin
-  letI := metrizable_space_metric β,
-  borelize β,
-  refine ae_strongly_measurable_iff_ae_measurable_separable.2 ⟨_, _⟩,
-  { exact ae_measurable_of_tendsto_metric_ae _ (λ n, (hf n).ae_measurable) lim },
-  { rcases u.exists_seq_tendsto with ⟨v, hv⟩,
-    have : ∀ (n : ℕ), ∃ (t : set β), is_separable t ∧ f (v n) ⁻¹' t ∈ μ.ae :=
-      λ n, (ae_strongly_measurable_iff_ae_measurable_separable.1 (hf (v n))).2,
-    choose t t_sep ht using this,
-    refine ⟨closure (⋃ i, (t i)), (is_separable_Union (λ i, (t_sep i))).closure, _⟩,
-    filter_upwards [ae_all_iff.2 ht, lim] with x hx h'x,
-    apply mem_closure_of_tendsto ((h'x).comp hv),
-    apply eventually_of_forall (λ n, _),
-    apply mem_Union_of_mem n,
-    exact hx n }
-end
-
-/-- If a sequence of almost everywhere strongly measurable functions converges almost everywhere,
-one can select a strongly measurable function as the almost everywhere limit. -/
-lemma _root_.exists_strongly_measurable_limit_of_tendsto_ae [metrizable_space β] {f : ℕ → α → β}
-  (hf : ∀ n, ae_strongly_measurable (f n) μ)
-  (h_ae_tendsto : ∀ᵐ x ∂μ, ∃ l : β, tendsto (λ n, f n x) at_top (𝓝 l)) :
-  ∃ (f_lim : α → β) (hf_lim_meas : strongly_measurable f_lim),
-    ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x)) :=
-begin
-  borelize β,
-  letI := metrizable_space_metric β,
-  obtain ⟨g, g_meas, hg⟩ : ∃ (g : α → β) (g_meas : measurable g),
-      ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x)) :=
-    measurable_limit_of_tendsto_metric_ae (λ n, (hf n).ae_measurable) h_ae_tendsto,
-  have Hg : ae_strongly_measurable g μ := ae_strongly_measurable_of_tendsto_ae _ hf hg,
-  refine ⟨Hg.mk g, Hg.strongly_measurable_mk, _⟩,
-  filter_upwards [hg, Hg.ae_eq_mk] with x hx h'x,
-  rwa h'x at hx,
-end
-
-lemma sum_measure [metrizable_space β]
-  {m : measurable_space α} {μ : ι → measure α} (h : ∀ i, ae_strongly_measurable f (μ i)) :
-  ae_strongly_measurable f (measure.sum μ) :=
-begin
-  borelize β,
-  refine ae_strongly_measurable_iff_ae_measurable_separable.2
-    ⟨ae_measurable.sum_measure (λ i, (h i).ae_measurable), _⟩,
-  have A : ∀ (i : ι), ∃ (t : set β), is_separable t ∧ f ⁻¹' t ∈ (μ i).ae :=
-    λ i, (ae_strongly_measurable_iff_ae_measurable_separable.1 (h i)).2,
-  choose t t_sep ht using A,
-  refine ⟨(⋃ i, t i), is_separable_Union t_sep, _⟩,
-  simp only [measure.ae_sum_eq, mem_Union, eventually_supr],
-  assume i,
-  filter_upwards [ht i] with x hx,
-  exact ⟨i, hx⟩
-end
-
-@[simp] lemma _root_.ae_strongly_measurable_sum_measure_iff
-  [metrizable_space β] {m : measurable_space α} {μ : ι → measure α} :
-  ae_strongly_measurable f (sum μ) ↔ ∀ i, ae_strongly_measurable f (μ i) :=
-⟨λ h i, h.mono_measure (measure.le_sum _ _), sum_measure⟩
-
-@[simp] lemma _root_.ae_strongly_measurable_add_measure_iff [metrizable_space β] {ν : measure α} :
-  ae_strongly_measurable f (μ + ν) ↔ ae_strongly_measurable f μ ∧ ae_strongly_measurable f ν :=
-by { rw [← sum_cond, ae_strongly_measurable_sum_measure_iff, bool.forall_bool, and.comm], refl }
-
-lemma add_measure [metrizable_space β] {ν : measure α} {f : α → β}
-  (hμ : ae_strongly_measurable f μ) (hν : ae_strongly_measurable f ν) :
-  ae_strongly_measurable f (μ + ν) :=
-ae_strongly_measurable_add_measure_iff.2 ⟨hμ, hν⟩
-
-protected lemma Union [metrizable_space β] {s : ι → set α}
-  (h : ∀ i, ae_strongly_measurable f (μ.restrict (s i))) :
-  ae_strongly_measurable f (μ.restrict (⋃ i, s i)) :=
-(sum_measure h).mono_measure $ restrict_Union_le
-
-@[simp] lemma _root_.ae_strongly_measurable_Union_iff [metrizable_space β] {s : ι → set α} :
-  ae_strongly_measurable f (μ.restrict (⋃ i, s i)) ↔
-    ∀ i, ae_strongly_measurable f (μ.restrict (s i)) :=
-⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_strongly_measurable.Union⟩
-
-@[simp] lemma _root_.ae_strongly_measurable_union_iff [metrizable_space β] {s t : set α} :
-  ae_strongly_measurable f (μ.restrict (s ∪ t)) ↔
-    ae_strongly_measurable f (μ.restrict s) ∧ ae_strongly_measurable f (μ.restrict t) :=
-by simp only [union_eq_Union, ae_strongly_measurable_Union_iff, bool.forall_bool, cond, and.comm]
-
-lemma smul_measure {R : Type*} [monoid R] [distrib_mul_action R ℝ≥0∞]
-  [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] (h : ae_strongly_measurable f μ) (c : R) :
-  ae_strongly_measurable f (c • μ) :=
-⟨h.mk f, h.strongly_measurable_mk, ae_smul_measure h.ae_eq_mk c⟩
-
-section normed_space
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [complete_space 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
-
-lemma _root_.ae_strongly_measurable_smul_const_iff {f : α → 𝕜} {c : E} (hc : c ≠ 0) :
-  ae_strongly_measurable (λ x, f x • c) μ ↔ ae_strongly_measurable f μ :=
-(closed_embedding_smul_left hc).to_embedding.ae_strongly_measurable_comp_iff
-
-end normed_space
-
-section mul_action
-
-variables {G : Type*} [group G] [mul_action G β]
-  [has_continuous_const_smul G β]
-
-lemma _root_.ae_strongly_measurable_const_smul_iff (c : G) :
-  ae_strongly_measurable (λ x, c • f x) μ ↔ ae_strongly_measurable f μ :=
-⟨λ h, by simpa only [inv_smul_smul] using h.const_smul' c⁻¹, λ h, h.const_smul c⟩
-
-variables {G₀ : Type*} [group_with_zero G₀] [mul_action G₀ β]
-  [has_continuous_const_smul G₀ β]
-
-lemma _root_.ae_strongly_measurable_const_smul_iff₀ {c : G₀} (hc : c ≠ 0) :
-  ae_strongly_measurable (λ x, c • f x) μ ↔ ae_strongly_measurable f μ :=
-begin
-  refine ⟨λ h, _, λ h, h.const_smul c⟩,
-  convert h.const_smul' c⁻¹,
-  simp [smul_smul, inv_mul_cancel hc]
-end
-
-end mul_action
-
-section continuous_linear_map_nondiscrete_normed_field
-
-variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
-variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
-variables {G : Type*} [normed_group G] [normed_space 𝕜 G]
-
-lemma _root_.strongly_measurable.apply_continuous_linear_map
-  {m : measurable_space α} {φ : α → F →L[𝕜] E} (hφ : strongly_measurable φ) (v : F) :
-  strongly_measurable (λ a, φ a v) :=
-(continuous_linear_map.apply 𝕜 E v).continuous.comp_strongly_measurable hφ
-
-lemma apply_continuous_linear_map {φ : α → F →L[𝕜] E}
-  (hφ : ae_strongly_measurable φ μ) (v : F) :
-  ae_strongly_measurable (λ a, φ a v) μ :=
-(continuous_linear_map.apply 𝕜 E v).continuous.comp_ae_strongly_measurable hφ
-
-lemma _root_.continuous_linear_map.ae_strongly_measurable_comp₂ (L : E →L[𝕜] F →L[𝕜] G)
-  {f : α → E} {g : α → F}
-  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
-  ae_strongly_measurable (λ x, L (f x) (g x)) μ :=
-L.continuous₂.comp_ae_strongly_measurable $ hf.prod_mk hg
-
-end continuous_linear_map_nondiscrete_normed_field
-
-lemma _root_.ae_strongly_measurable_with_density_iff {E : Type*} [normed_group E] [normed_space ℝ E]
-  {f : α → ℝ≥0} (hf : measurable f) {g : α → E} :
-  ae_strongly_measurable g (μ.with_density (λ x, (f x : ℝ≥0∞))) ↔
-    ae_strongly_measurable (λ x, (f x : ℝ) • g x) μ :=
-begin
-  split,
-  { rintros ⟨g', g'meas, hg'⟩,
-    have A : measurable_set {x : α | f x ≠ 0} := (hf (measurable_set_singleton 0)).compl,
-    refine ⟨λ x, (f x : ℝ) • g' x, hf.coe_nnreal_real.strongly_measurable.smul g'meas, _⟩,
-    apply @ae_of_ae_restrict_of_ae_restrict_compl _ _ _ {x | f x ≠ 0},
-    { rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal] at hg',
-      rw ae_restrict_iff' A,
-      filter_upwards [hg'] with a ha h'a,
-      have : (f a : ℝ≥0∞) ≠ 0, by simpa only [ne.def, ennreal.coe_eq_zero] using h'a,
-      rw ha this },
-    { filter_upwards [ae_restrict_mem A.compl] with x hx,
-      simp only [not_not, mem_set_of_eq, mem_compl_eq] at hx,
-      simp [hx] } },
-  { rintros ⟨g', g'meas, hg'⟩,
-    refine ⟨λ x, (f x : ℝ)⁻¹ • g' x, hf.coe_nnreal_real.inv.strongly_measurable.smul g'meas, _⟩,
-    rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal],
-    filter_upwards [hg'] with x hx h'x,
-    rw [← hx, smul_smul, _root_.inv_mul_cancel, one_smul],
-    simp only [ne.def, ennreal.coe_eq_zero] at h'x,
-    simpa only [nnreal.coe_eq_zero, ne.def] using h'x }
-end
-
-end ae_strongly_measurable
-
-
-/-! ## Almost everywhere finitely strongly measurable functions -/
-
-namespace ae_fin_strongly_measurable
-
-variables {m : measurable_space α} {μ : measure α} [topological_space β]
-  {f g : α → β}
-
-section mk
-variables [has_zero β]
-
-/-- A `fin_strongly_measurable` function such that `f =ᵐ[μ] hf.mk f`. See lemmas
-`fin_strongly_measurable_mk` and `ae_eq_mk`. -/
-protected noncomputable def mk (f : α → β) (hf : ae_fin_strongly_measurable f μ) : α → β := hf.some
-
-lemma fin_strongly_measurable_mk (hf : ae_fin_strongly_measurable f μ) :
-  fin_strongly_measurable (hf.mk f) μ :=
-hf.some_spec.1
-
-lemma ae_eq_mk (hf : ae_fin_strongly_measurable f μ) : f =ᵐ[μ] hf.mk f :=
-hf.some_spec.2
-
-protected lemma ae_measurable {β} [has_zero β] [measurable_space β] [topological_space β]
-  [metrizable_space β] [borel_space β]
-  {f : α → β} (hf : ae_fin_strongly_measurable f μ) :
-  ae_measurable f μ :=
-⟨hf.mk f, hf.fin_strongly_measurable_mk.measurable, hf.ae_eq_mk⟩
-
-end mk
-
-section arithmetic
-
-protected lemma mul [monoid_with_zero β] [has_continuous_mul β]
-  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
-  ae_fin_strongly_measurable (f * g) μ :=
-⟨hf.mk f * hg.mk g, hf.fin_strongly_measurable_mk.mul hg.fin_strongly_measurable_mk,
-  hf.ae_eq_mk.mul hg.ae_eq_mk⟩
-
-protected lemma add [add_monoid β] [has_continuous_add β]
-  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
-  ae_fin_strongly_measurable (f + g) μ :=
-⟨hf.mk f + hg.mk g, hf.fin_strongly_measurable_mk.add hg.fin_strongly_measurable_mk,
-  hf.ae_eq_mk.add hg.ae_eq_mk⟩
-
-protected lemma neg [add_group β] [topological_add_group β] (hf : ae_fin_strongly_measurable f μ) :
-  ae_fin_strongly_measurable (-f) μ :=
-⟨-hf.mk f, hf.fin_strongly_measurable_mk.neg, hf.ae_eq_mk.neg⟩
-
-protected lemma sub [add_group β] [has_continuous_sub β]
-  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
-  ae_fin_strongly_measurable (f - g) μ :=
-⟨hf.mk f - hg.mk g, hf.fin_strongly_measurable_mk.sub hg.fin_strongly_measurable_mk,
-  hf.ae_eq_mk.sub hg.ae_eq_mk⟩
-
-protected lemma const_smul {𝕜} [topological_space 𝕜] [add_monoid β] [monoid 𝕜]
-  [distrib_mul_action 𝕜 β] [has_continuous_smul 𝕜 β]
-  (hf : ae_fin_strongly_measurable f μ) (c : 𝕜) :
-  ae_fin_strongly_measurable (c • f) μ :=
-⟨c • hf.mk f, hf.fin_strongly_measurable_mk.const_smul c, hf.ae_eq_mk.const_smul c⟩
-
-end arithmetic
-
-section order
-variables [has_zero β]
-
-protected lemma sup [semilattice_sup β] [has_continuous_sup β]
-  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
-  ae_fin_strongly_measurable (f ⊔ g) μ :=
-⟨hf.mk f ⊔ hg.mk g, hf.fin_strongly_measurable_mk.sup hg.fin_strongly_measurable_mk,
-  hf.ae_eq_mk.sup hg.ae_eq_mk⟩
-
-protected lemma inf [semilattice_inf β] [has_continuous_inf β]
-  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
-  ae_fin_strongly_measurable (f ⊓ g) μ :=
-⟨hf.mk f ⊓ hg.mk g, hf.fin_strongly_measurable_mk.inf hg.fin_strongly_measurable_mk,
-  hf.ae_eq_mk.inf hg.ae_eq_mk⟩
-
-end order
-
-variables [has_zero β] [t2_space β]
-
-lemma exists_set_sigma_finite (hf : ae_fin_strongly_measurable f μ) :
-  ∃ t, measurable_set t ∧ f =ᵐ[μ.restrict tᶜ] 0 ∧ sigma_finite (μ.restrict t) :=
-begin
-  rcases hf with ⟨g, hg, hfg⟩,
-  obtain ⟨t, ht, hgt_zero, htμ⟩ := hg.exists_set_sigma_finite,
-  refine ⟨t, ht, _, htμ⟩,
-  refine eventually_eq.trans (ae_restrict_of_ae hfg) _,
-  rw [eventually_eq, ae_restrict_iff' ht.compl],
-  exact eventually_of_forall hgt_zero,
-end
-
-/-- A measurable set `t` such that `f =ᵐ[μ.restrict tᶜ] 0` and `sigma_finite (μ.restrict t)`. -/
-def sigma_finite_set (hf : ae_fin_strongly_measurable f μ) : set α :=
-hf.exists_set_sigma_finite.some
-
-protected lemma measurable_set (hf : ae_fin_strongly_measurable f μ) :
-  measurable_set hf.sigma_finite_set :=
-hf.exists_set_sigma_finite.some_spec.1
-
-lemma ae_eq_zero_compl (hf : ae_fin_strongly_measurable f μ) :
-  f =ᵐ[μ.restrict hf.sigma_finite_setᶜ] 0 :=
-hf.exists_set_sigma_finite.some_spec.2.1
-
-instance sigma_finite_restrict (hf : ae_fin_strongly_measurable f μ) :
-  sigma_finite (μ.restrict hf.sigma_finite_set) :=
-hf.exists_set_sigma_finite.some_spec.2.2
-
-end ae_fin_strongly_measurable
-
-section second_countable_topology
-
-variables {G : Type*} {p : ℝ≥0∞} {m m0 : measurable_space α} {μ : measure α}
-  [normed_group G] [measurable_space G] [borel_space G] [second_countable_topology G]
-  {f : α → G}
-
-/-- In a space with second countable topology and a sigma-finite measure, `fin_strongly_measurable`
-  and `measurable` are equivalent. -/
-lemma fin_strongly_measurable_iff_measurable {m0 : measurable_space α} (μ : measure α)
-  [sigma_finite μ] :
-  fin_strongly_measurable f μ ↔ measurable f :=
-⟨λ h, h.measurable, λ h, (measurable.strongly_measurable h).fin_strongly_measurable μ⟩
-
-/-- In a space with second countable topology and a sigma-finite measure,
-  `ae_fin_strongly_measurable` and `ae_measurable` are equivalent. -/
-lemma ae_fin_strongly_measurable_iff_ae_measurable {m0 : measurable_space α} (μ : measure α)
-  [sigma_finite μ] :
-  ae_fin_strongly_measurable f μ ↔ ae_measurable f μ :=
-by simp_rw [ae_fin_strongly_measurable, ae_measurable, fin_strongly_measurable_iff_measurable]
-
-end second_countable_topology
-
-lemma measurable_uncurry_of_continuous_of_measurable {α β ι : Type*} [topological_space ι]
-  [metrizable_space ι] [measurable_space ι] [second_countable_topology ι] [opens_measurable_space ι]
-  {mβ : measurable_space β} [topological_space β] [metrizable_space β] [borel_space β]
-  {m : measurable_space α} {u : ι → α → β}
-  (hu_cont : ∀ x, continuous (λ i, u i x)) (h : ∀ i, measurable (u i)) :
-  measurable (function.uncurry u) :=
-begin
-  letI := metrizable_space_metric β,
-  obtain ⟨t_sf, ht_sf⟩ : ∃ t : ℕ → simple_func ι ι, ∀ j x,
-    tendsto (λ n, u (t n j) x) at_top (𝓝 $ u j x),
-  { have h_str_meas : strongly_measurable (id : ι → ι), from strongly_measurable_id,
-    refine ⟨h_str_meas.approx, λ j x, _⟩,
-    exact ((hu_cont x).tendsto j).comp (h_str_meas.tendsto_approx j), },
-  let U := λ (n : ℕ) (p : ι × α), u (t_sf n p.fst) p.snd,
-  have h_tendsto : tendsto U at_top (𝓝 (λ p, u p.fst p.snd)),
-  { rw tendsto_pi_nhds,
-    exact λ p, ht_sf p.fst p.snd, },
-  refine measurable_of_tendsto_metric (λ n, _) h_tendsto,
-  haveI : encodable (t_sf n).range, from fintype.to_encodable ↥(t_sf n).range,
-  have h_meas : measurable (λ (p : (t_sf n).range × α), u ↑p.fst p.snd),
-  { have : (λ (p : ↥((t_sf n).range) × α), u ↑(p.fst) p.snd)
-        = (λ (p : α × ((t_sf n).range)), u ↑(p.snd) p.fst) ∘ prod.swap := rfl,
-    rw [this, @measurable_swap_iff α ↥((t_sf n).range) β m],
-    exact measurable_from_prod_encodable (λ j, h j), },
-  have : (λ p : ι × α, u (t_sf n p.fst) p.snd)
-    = (λ p : ↥(t_sf n).range × α, u p.fst p.snd)
-      ∘ (λ p : ι × α, (⟨t_sf n p.fst, simple_func.mem_range_self _ _⟩, p.snd)) := rfl,
-  simp_rw [U, this],
-  refine h_meas.comp (measurable.prod_mk _ measurable_snd),
-  exact ((t_sf n).measurable.comp measurable_fst).subtype_mk,
-end
-
-lemma strongly_measurable_uncurry_of_continuous_of_strongly_measurable {α β ι : Type*}
-  [topological_space ι] [metrizable_space ι] [measurable_space ι] [second_countable_topology ι]
-  [opens_measurable_space ι] [topological_space β] [metrizable_space β]
-  [measurable_space α] {u : ι → α → β}
-  (hu_cont : ∀ x, continuous (λ i, u i x)) (h : ∀ i, strongly_measurable (u i)) :
-  strongly_measurable (function.uncurry u) :=
-begin
-  borelize β,
-  obtain ⟨t_sf, ht_sf⟩ : ∃ t : ℕ → simple_func ι ι, ∀ j x,
-    tendsto (λ n, u (t n j) x) at_top (𝓝 $ u j x),
-  { have h_str_meas : strongly_measurable (id : ι → ι), from strongly_measurable_id,
-    refine ⟨h_str_meas.approx, λ j x, _⟩,
-    exact ((hu_cont x).tendsto j).comp (h_str_meas.tendsto_approx j), },
-  let U := λ (n : ℕ) (p : ι × α), u (t_sf n p.fst) p.snd,
-  have h_tendsto : tendsto U at_top (𝓝 (λ p, u p.fst p.snd)),
-  { rw tendsto_pi_nhds,
-    exact λ p, ht_sf p.fst p.snd, },
-  refine strongly_measurable_of_tendsto _ (λ n, _) h_tendsto,
-  haveI : encodable (t_sf n).range, from fintype.to_encodable ↥(t_sf n).range,
-  have h_str_meas : strongly_measurable (λ (p : (t_sf n).range × α), u ↑p.fst p.snd),
-  { refine strongly_measurable_iff_measurable_separable.2 ⟨_, _⟩,
-    { have : (λ (p : ↥((t_sf n).range) × α), u ↑(p.fst) p.snd)
-          = (λ (p : α × ((t_sf n).range)), u ↑(p.snd) p.fst) ∘ prod.swap := rfl,
-      rw [this, measurable_swap_iff],
-      exact measurable_from_prod_encodable (λ j, (h j).measurable), },
-    { have : is_separable (⋃ (i : (t_sf n).range), range (u i)) :=
-        is_separable_Union (λ i, (h i).is_separable_range),
-      apply this.mono,
-      rintros - ⟨⟨i, x⟩, rfl⟩,
-      simp only [mem_Union, mem_range],
-      exact ⟨i, x, rfl⟩ } },
-  have : (λ p : ι × α, u (t_sf n p.fst) p.snd)
-    = (λ p : ↥(t_sf n).range × α, u p.fst p.snd)
-      ∘ (λ p : ι × α, (⟨t_sf n p.fst, simple_func.mem_range_self _ _⟩, p.snd)) := rfl,
-  simp_rw [U, this],
-  refine h_str_meas.comp_measurable (measurable.prod_mk _ measurable_snd),
-  exact ((t_sf n).measurable.comp measurable_fst).subtype_mk,
-end
-
-end measure_theory
diff --git a/src/measure_theory/function/strongly_measurable/basic.lean b/src/measure_theory/function/strongly_measurable/basic.lean
new file mode 100644
index 0000000000000..a2efb0496676c
--- /dev/null
+++ b/src/measure_theory/function/strongly_measurable/basic.lean
@@ -0,0 +1,1953 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne, Sébastien Gouëzel
+-/
+import analysis.normed_space.finite_dimension
+import analysis.normed_space.bounded_linear_maps
+import measure_theory.constructions.borel_space.metrizable
+import measure_theory.integral.lebesgue
+import measure_theory.function.simple_func_dense
+
+/-!
+# Strongly measurable and finitely strongly measurable functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A function `f` is said to be strongly measurable if `f` is the sequential limit of simple functions.
+It is said to be finitely strongly measurable with respect to a measure `μ` if the supports
+of those simple functions have finite measure. We also provide almost everywhere versions of
+these notions.
+
+Almost everywhere strongly measurable functions form the largest class of functions that can be
+integrated using the Bochner integral.
+
+If the target space has a second countable topology, strongly measurable and measurable are
+equivalent.
+
+If the measure is sigma-finite, strongly measurable and finitely strongly measurable are equivalent.
+
+The main property of finitely strongly measurable functions is
+`fin_strongly_measurable.exists_set_sigma_finite`: there exists a measurable set `t` such that the
+function is supported on `t` and `μ.restrict t` is sigma-finite. As a consequence, we can prove some
+results for those functions as if the measure was sigma-finite.
+
+## Main definitions
+
+* `strongly_measurable f`: `f : α → β` is the limit of a sequence `fs : ℕ → simple_func α β`.
+* `fin_strongly_measurable f μ`: `f : α → β` is the limit of a sequence `fs : ℕ → simple_func α β`
+  such that for all `n ∈ ℕ`, the measure of the support of `fs n` is finite.
+* `ae_strongly_measurable f μ`: `f` is almost everywhere equal to a `strongly_measurable` function.
+* `ae_fin_strongly_measurable f μ`: `f` is almost everywhere equal to a `fin_strongly_measurable`
+  function.
+
+* `ae_fin_strongly_measurable.sigma_finite_set`: a measurable set `t` such that
+  `f =ᵐ[μ.restrict tᶜ] 0` and `μ.restrict t` is sigma-finite.
+
+## Main statements
+
+* `ae_fin_strongly_measurable.exists_set_sigma_finite`: there exists a measurable set `t` such that
+  `f =ᵐ[μ.restrict tᶜ] 0` and `μ.restrict t` is sigma-finite.
+
+We provide a solid API for strongly measurable functions, and for almost everywhere strongly
+measurable functions, as a basis for the Bochner integral.
+
+## References
+
+* Hytönen, Tuomas, Jan Van Neerven, Mark Veraar, and Lutz Weis. Analysis in Banach spaces.
+  Springer, 2016.
+
+-/
+
+open measure_theory filter topological_space function set measure_theory.measure
+open_locale ennreal topology measure_theory nnreal big_operators
+
+/-- The typeclass `second_countable_topology_either α β` registers the fact that at least one of
+the two spaces has second countable topology. This is the right assumption to ensure that continuous
+maps from `α` to `β` are strongly measurable. -/
+class second_countable_topology_either
+  (α β : Type*) [topological_space α] [topological_space β] : Prop :=
+(out : second_countable_topology α ∨ second_countable_topology β)
+
+@[priority 100] instance second_countable_topology_either_of_left
+  (α β : Type*) [topological_space α] [topological_space β] [second_countable_topology α] :
+  second_countable_topology_either α β :=
+{ out := or.inl (by apply_instance) }
+
+@[priority 100] instance second_countable_topology_either_of_right
+  (α β : Type*) [topological_space α] [topological_space β] [second_countable_topology β] :
+  second_countable_topology_either α β :=
+{ out := or.inr (by apply_instance) }
+
+variables {α β γ ι : Type*} [countable ι]
+namespace measure_theory
+
+local infixr ` →ₛ `:25 := simple_func
+
+section definitions
+variable [topological_space β]
+
+/-- A function is `strongly_measurable` if it is the limit of simple functions. -/
+def strongly_measurable [measurable_space α] (f : α → β) : Prop :=
+∃ fs : ℕ → α →ₛ β, ∀ x, tendsto (λ n, fs n x) at_top (𝓝 (f x))
+
+localized "notation (name := strongly_measurable_of)
+  `strongly_measurable[` m `]` := @measure_theory.strongly_measurable _ _ _ m" in measure_theory
+
+/-- A function is `fin_strongly_measurable` with respect to a measure if it is the limit of simple
+  functions with support with finite measure. -/
+def fin_strongly_measurable [has_zero β] {m0 : measurable_space α} (f : α → β) (μ : measure α) :
+  Prop :=
+∃ fs : ℕ → α →ₛ β, (∀ n, μ (support (fs n)) < ∞) ∧ (∀ x, tendsto (λ n, fs n x) at_top (𝓝 (f x)))
+
+/-- A function is `ae_strongly_measurable` with respect to a measure `μ` if it is almost everywhere
+equal to the limit of a sequence of simple functions. -/
+def ae_strongly_measurable {m0 : measurable_space α} (f : α → β) (μ : measure α) : Prop :=
+∃ g, strongly_measurable g ∧ f =ᵐ[μ] g
+
+/-- A function is `ae_fin_strongly_measurable` with respect to a measure if it is almost everywhere
+equal to the limit of a sequence of simple functions with support with finite measure. -/
+def ae_fin_strongly_measurable [has_zero β] {m0 : measurable_space α} (f : α → β) (μ : measure α) :
+  Prop :=
+∃ g, fin_strongly_measurable g μ ∧ f =ᵐ[μ] g
+
+end definitions
+
+open_locale measure_theory
+
+/-! ## Strongly measurable functions -/
+
+protected lemma strongly_measurable.ae_strongly_measurable {α β} {m0 : measurable_space α}
+  [topological_space β] {f : α → β} {μ : measure α} (hf : strongly_measurable f) :
+  ae_strongly_measurable f μ :=
+⟨f, hf, eventually_eq.refl _ _⟩
+
+@[simp] lemma subsingleton.strongly_measurable {α β} [measurable_space α] [topological_space β]
+  [subsingleton β] (f : α → β) :
+  strongly_measurable f :=
+begin
+  let f_sf : α →ₛ β := ⟨f, λ x, _, set.subsingleton.finite set.subsingleton_of_subsingleton⟩,
+  { exact ⟨λ n, f_sf, λ x, tendsto_const_nhds⟩, },
+  { have h_univ : f ⁻¹' {x} = set.univ, by { ext1 y, simp, },
+    rw h_univ,
+    exact measurable_set.univ, },
+end
+
+lemma simple_func.strongly_measurable {α β} {m : measurable_space α} [topological_space β]
+  (f : α →ₛ β) :
+  strongly_measurable f :=
+⟨λ _, f, λ x, tendsto_const_nhds⟩
+
+lemma strongly_measurable_of_is_empty [is_empty α] {m : measurable_space α} [topological_space β]
+  (f : α → β) : strongly_measurable f :=
+⟨λ n, simple_func.of_is_empty, is_empty_elim⟩
+
+lemma strongly_measurable_const {α β} {m : measurable_space α} [topological_space β] {b : β} :
+  strongly_measurable (λ a : α, b) :=
+⟨λ n, simple_func.const α b, λ a, tendsto_const_nhds⟩
+
+@[to_additive]
+lemma strongly_measurable_one {α β} {m : measurable_space α} [topological_space β] [has_one β] :
+  strongly_measurable (1 : α → β) :=
+@strongly_measurable_const _ _ _ _ 1
+
+/-- A version of `strongly_measurable_const` that assumes `f x = f y` for all `x, y`.
+This version works for functions between empty types. -/
+lemma strongly_measurable_const' {α β} {m : measurable_space α} [topological_space β] {f : α → β}
+  (hf : ∀ x y, f x = f y) : strongly_measurable f :=
+begin
+  casesI is_empty_or_nonempty α,
+  { exact strongly_measurable_of_is_empty f },
+  { convert strongly_measurable_const, exact funext (λ x, hf x h.some) }
+end
+
+@[simp] lemma subsingleton.strongly_measurable' {α β} [measurable_space α] [topological_space β]
+  [subsingleton α] (f : α → β) :
+  strongly_measurable f :=
+strongly_measurable_const' (λ x y, by rw subsingleton.elim x y)
+
+namespace strongly_measurable
+
+variables {f g : α → β}
+
+section basic_properties_in_any_topological_space
+variables [topological_space β]
+
+/-- A sequence of simple functions such that `∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x))`.
+That property is given by `strongly_measurable.tendsto_approx`. -/
+protected noncomputable
+def approx {m : measurable_space α} (hf : strongly_measurable f) : ℕ → α →ₛ β :=
+hf.some
+
+protected lemma tendsto_approx {m : measurable_space α} (hf : strongly_measurable f) :
+  ∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x)) :=
+hf.some_spec
+
+/-- Similar to `strongly_measurable.approx`, but enforces that the norm of every function in the
+sequence is less than `c` everywhere. If `‖f x‖ ≤ c` this sequence of simple functions verifies
+`tendsto (λ n, hf.approx_bounded n x) at_top (𝓝 (f x))`. -/
+noncomputable
+def approx_bounded {m : measurable_space α}
+  [has_norm β] [has_smul ℝ β] (hf : strongly_measurable f) (c : ℝ) :
+  ℕ → simple_func α β :=
+λ n, (hf.approx n).map (λ x, (min 1 (c / ‖x‖)) • x)
+
+lemma tendsto_approx_bounded_of_norm_le {β} {f : α → β} [normed_add_comm_group β] [normed_space ℝ β]
+  {m : measurable_space α} (hf : strongly_measurable[m] f) {c : ℝ} {x : α} (hfx : ‖f x‖ ≤ c) :
+  tendsto (λ n, hf.approx_bounded c n x) at_top (𝓝 (f x)) :=
+begin
+  have h_tendsto := hf.tendsto_approx x,
+  simp only [strongly_measurable.approx_bounded, simple_func.coe_map, function.comp_app],
+  by_cases hfx0 : ‖f x‖ = 0,
+  { rw norm_eq_zero at hfx0,
+    rw hfx0 at h_tendsto ⊢,
+    have h_tendsto_norm : tendsto (λ n, ‖hf.approx n x‖) at_top (𝓝 0),
+    { convert h_tendsto.norm,
+      rw norm_zero, },
+    refine squeeze_zero_norm (λ n, _) h_tendsto_norm,
+    calc ‖min 1 (c / ‖hf.approx n x‖) • hf.approx n x‖
+        = ‖min 1 (c / ‖hf.approx n x‖)‖ * ‖hf.approx n x‖ : norm_smul _ _
+    ... ≤ ‖(1 : ℝ)‖ * ‖hf.approx n x‖ :
+      begin
+        refine mul_le_mul_of_nonneg_right _ (norm_nonneg _),
+        rw [norm_one, real.norm_of_nonneg],
+        { exact min_le_left _ _, },
+        { exact le_min zero_le_one
+            (div_nonneg ((norm_nonneg _).trans hfx) (norm_nonneg _)), },
+      end
+    ... = ‖hf.approx n x‖ : by rw [norm_one, one_mul], },
+  rw ← one_smul ℝ (f x),
+  refine tendsto.smul _ h_tendsto,
+  have : min 1 (c / ‖f x‖) = 1,
+  { rw [min_eq_left_iff, one_le_div (lt_of_le_of_ne (norm_nonneg _) (ne.symm hfx0))],
+    exact hfx, },
+  nth_rewrite 0 this.symm,
+  refine tendsto.min tendsto_const_nhds _,
+  refine tendsto.div tendsto_const_nhds h_tendsto.norm hfx0,
+end
+
+lemma tendsto_approx_bounded_ae {β} {f : α → β} [normed_add_comm_group β] [normed_space ℝ β]
+  {m m0 : measurable_space α} {μ : measure α}
+  (hf : strongly_measurable[m] f) {c : ℝ}
+  (hf_bound : ∀ᵐ x ∂μ, ‖f x‖ ≤ c) :
+  ∀ᵐ x ∂μ, tendsto (λ n, hf.approx_bounded c n x) at_top (𝓝 (f x)) :=
+by filter_upwards [hf_bound] with x hfx using tendsto_approx_bounded_of_norm_le hf hfx
+
+lemma norm_approx_bounded_le {β} {f : α → β} [seminormed_add_comm_group β] [normed_space ℝ β]
+  {m : measurable_space α} {c : ℝ} (hf : strongly_measurable[m] f) (hc : 0 ≤ c) (n : ℕ) (x : α) :
+  ‖hf.approx_bounded c n x‖ ≤ c :=
+begin
+  simp only [strongly_measurable.approx_bounded, simple_func.coe_map, function.comp_app],
+  refine (norm_smul_le _ _).trans _,
+  by_cases h0 : ‖hf.approx n x‖ = 0,
+  { simp only [h0, div_zero, min_eq_right, zero_le_one, norm_zero, mul_zero],
+    exact hc, },
+  cases le_total (‖hf.approx n x‖) c,
+  { rw min_eq_left _,
+    { simpa only [norm_one, one_mul] using h, },
+    { rwa one_le_div (lt_of_le_of_ne (norm_nonneg _) (ne.symm h0)), }, },
+  { rw min_eq_right _,
+    { rw [norm_div, norm_norm, mul_comm, mul_div, div_eq_mul_inv, mul_comm, ← mul_assoc,
+        inv_mul_cancel h0, one_mul, real.norm_of_nonneg hc], },
+    { rwa div_le_one (lt_of_le_of_ne (norm_nonneg _) (ne.symm h0)), }, },
+end
+
+lemma _root_.strongly_measurable_bot_iff [nonempty β] [t2_space β] :
+  strongly_measurable[⊥] f ↔ ∃ c, f = λ _, c :=
+begin
+  casesI is_empty_or_nonempty α with hα hα,
+  { simp only [subsingleton.strongly_measurable', eq_iff_true_of_subsingleton, exists_const], },
+  refine ⟨λ hf, _, λ hf_eq, _⟩,
+  { refine ⟨f hα.some, _⟩,
+    let fs := hf.approx,
+    have h_fs_tendsto : ∀ x, tendsto (λ n, fs n x) at_top (𝓝 (f x)) := hf.tendsto_approx,
+    have : ∀ n, ∃ c, ∀ x, fs n x = c := λ n, simple_func.simple_func_bot (fs n),
+    let cs := λ n, (this n).some,
+    have h_cs_eq : ∀ n, ⇑(fs n) = (λ x, cs n) := λ n, funext (this n).some_spec,
+    simp_rw h_cs_eq at h_fs_tendsto,
+    have h_tendsto : tendsto cs at_top (𝓝 (f hα.some)) := h_fs_tendsto hα.some,
+    ext1 x,
+    exact tendsto_nhds_unique (h_fs_tendsto x) h_tendsto, },
+  { obtain ⟨c, rfl⟩ := hf_eq,
+    exact strongly_measurable_const, },
+end
+
+end basic_properties_in_any_topological_space
+
+lemma fin_strongly_measurable_of_set_sigma_finite [topological_space β] [has_zero β]
+  {m : measurable_space α} {μ : measure α} (hf_meas : strongly_measurable f) {t : set α}
+  (ht : measurable_set t) (hft_zero : ∀ x ∈ tᶜ, f x = 0) (htμ : sigma_finite (μ.restrict t)) :
+  fin_strongly_measurable f μ :=
+begin
+  haveI : sigma_finite (μ.restrict t) := htμ,
+  let S := spanning_sets (μ.restrict t),
+  have hS_meas : ∀ n, measurable_set (S n), from measurable_spanning_sets (μ.restrict t),
+  let f_approx := hf_meas.approx,
+  let fs := λ n, simple_func.restrict (f_approx n) (S n ∩ t),
+  have h_fs_t_compl : ∀ n, ∀ x ∉ t, fs n x = 0,
+  { intros n x hxt,
+    rw simple_func.restrict_apply _ ((hS_meas n).inter ht),
+    refine set.indicator_of_not_mem _ _,
+    simp [hxt], },
+  refine ⟨fs, _, λ x, _⟩,
+  { simp_rw simple_func.support_eq,
+    refine λ n, (measure_bUnion_finset_le _ _).trans_lt _,
+    refine ennreal.sum_lt_top_iff.mpr (λ y hy, _),
+    rw simple_func.restrict_preimage_singleton _ ((hS_meas n).inter ht),
+    swap, { rw finset.mem_filter at hy, exact hy.2, },
+    refine (measure_mono (set.inter_subset_left _ _)).trans_lt _,
+    have h_lt_top := measure_spanning_sets_lt_top (μ.restrict t) n,
+    rwa measure.restrict_apply' ht at h_lt_top, },
+  { by_cases hxt : x ∈ t,
+    swap, { rw [funext (λ n, h_fs_t_compl n x hxt), hft_zero x hxt], exact tendsto_const_nhds, },
+    have h : tendsto (λ n, (f_approx n) x) at_top (𝓝 (f x)), from hf_meas.tendsto_approx x,
+    obtain ⟨n₁, hn₁⟩ : ∃ n, ∀ m, n ≤ m → fs m x = f_approx m x,
+    { obtain ⟨n, hn⟩ : ∃ n, ∀ m, n ≤ m → x ∈ S m ∩ t,
+      { rsuffices ⟨n, hn⟩ : ∃ n, ∀ m, n ≤ m → x ∈ S m,
+        { exact ⟨n, λ m hnm, set.mem_inter (hn m hnm) hxt⟩, },
+        rsuffices ⟨n, hn⟩ : ∃ n, x ∈ S n,
+        { exact ⟨n, λ m hnm, monotone_spanning_sets (μ.restrict t) hnm hn⟩, },
+        rw [← set.mem_Union, Union_spanning_sets (μ.restrict t)],
+        trivial, },
+      refine ⟨n, λ m hnm, _⟩,
+      simp_rw [fs, simple_func.restrict_apply _ ((hS_meas m).inter ht),
+        set.indicator_of_mem (hn m hnm)], },
+    rw tendsto_at_top' at h ⊢,
+    intros s hs,
+    obtain ⟨n₂, hn₂⟩ := h s hs,
+    refine ⟨max n₁ n₂, λ m hm, _⟩,
+    rw hn₁ m ((le_max_left _ _).trans hm.le),
+    exact hn₂ m ((le_max_right _ _).trans hm.le), },
+end
+
+/-- If the measure is sigma-finite, all strongly measurable functions are
+  `fin_strongly_measurable`. -/
+protected lemma fin_strongly_measurable [topological_space β] [has_zero β] {m0 : measurable_space α}
+  (hf : strongly_measurable f) (μ : measure α) [sigma_finite μ] :
+  fin_strongly_measurable f μ :=
+hf.fin_strongly_measurable_of_set_sigma_finite measurable_set.univ (by simp)
+  (by rwa measure.restrict_univ)
+
+/-- A strongly measurable function is measurable. -/
+protected lemma measurable {m : measurable_space α} [topological_space β]
+  [pseudo_metrizable_space β] [measurable_space β] [borel_space β] (hf : strongly_measurable f) :
+  measurable f :=
+measurable_of_tendsto_metrizable (λ n, (hf.approx n).measurable)
+  (tendsto_pi_nhds.mpr hf.tendsto_approx)
+
+/-- A strongly measurable function is almost everywhere measurable. -/
+protected lemma ae_measurable {m : measurable_space α} [topological_space β]
+  [pseudo_metrizable_space β] [measurable_space β] [borel_space β] {μ : measure α}
+  (hf : strongly_measurable f) :
+  ae_measurable f μ :=
+hf.measurable.ae_measurable
+
+lemma _root_.continuous.comp_strongly_measurable
+  {m : measurable_space α} [topological_space β] [topological_space γ] {g : β → γ} {f : α → β}
+  (hg : continuous g) (hf : strongly_measurable f) : strongly_measurable (λ x, g (f x)) :=
+⟨λ n, simple_func.map g (hf.approx n), λ x, (hg.tendsto _).comp (hf.tendsto_approx x)⟩
+
+@[to_additive]
+lemma measurable_set_mul_support {m : measurable_space α}
+  [has_one β] [topological_space β] [metrizable_space β] (hf : strongly_measurable f) :
+  measurable_set (mul_support f) :=
+by { borelize β, exact measurable_set_mul_support hf.measurable }
+
+protected lemma mono {m m' : measurable_space α} [topological_space β]
+  (hf : strongly_measurable[m'] f) (h_mono : m' ≤ m) :
+  strongly_measurable[m] f :=
+begin
+  let f_approx : ℕ → @simple_func α m β := λ n,
+  { to_fun := hf.approx n,
+    measurable_set_fiber' := λ x, h_mono _ (simple_func.measurable_set_fiber' _ x),
+    finite_range' := simple_func.finite_range (hf.approx n) },
+  exact ⟨f_approx, hf.tendsto_approx⟩,
+end
+
+protected lemma prod_mk {m : measurable_space α} [topological_space β] [topological_space γ]
+  {f : α → β} {g : α → γ} (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (λ x, (f x, g x)) :=
+begin
+  refine ⟨λ n, simple_func.pair (hf.approx n) (hg.approx n), λ x, _⟩,
+  rw nhds_prod_eq,
+  exact tendsto.prod_mk (hf.tendsto_approx x) (hg.tendsto_approx x),
+end
+
+lemma comp_measurable [topological_space β] {m : measurable_space α} {m' : measurable_space γ}
+  {f : α → β} {g : γ → α} (hf : strongly_measurable f) (hg : measurable g) :
+  strongly_measurable (f ∘ g) :=
+⟨λ n, simple_func.comp (hf.approx n) g hg, λ x, hf.tendsto_approx (g x)⟩
+
+lemma of_uncurry_left [topological_space β] {mα : measurable_space α} {mγ : measurable_space γ}
+  {f : α → γ → β} (hf : strongly_measurable (uncurry f)) {x : α} :
+  strongly_measurable (f x) :=
+hf.comp_measurable measurable_prod_mk_left
+
+lemma of_uncurry_right [topological_space β] {mα : measurable_space α} {mγ : measurable_space γ}
+  {f : α → γ → β} (hf : strongly_measurable (uncurry f)) {y : γ} :
+  strongly_measurable (λ x, f x y) :=
+hf.comp_measurable measurable_prod_mk_right
+
+section arithmetic
+variables {mα : measurable_space α} [topological_space β]
+include mα
+
+@[to_additive]
+protected lemma mul [has_mul β] [has_continuous_mul β]
+  (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (f * g) :=
+⟨λ n, hf.approx n * hg.approx n, λ x, (hf.tendsto_approx x).mul (hg.tendsto_approx x)⟩
+
+@[to_additive]
+lemma mul_const [has_mul β] [has_continuous_mul β] (hf : strongly_measurable f) (c : β) :
+  strongly_measurable (λ x, f x * c) :=
+hf.mul strongly_measurable_const
+
+@[to_additive]
+lemma const_mul [has_mul β] [has_continuous_mul β] (hf : strongly_measurable f) (c : β) :
+  strongly_measurable (λ x, c * f x) :=
+strongly_measurable_const.mul hf
+
+@[to_additive]
+protected lemma inv [group β] [topological_group β] (hf : strongly_measurable f) :
+  strongly_measurable f⁻¹ :=
+⟨λ n, (hf.approx n)⁻¹, λ x, (hf.tendsto_approx x).inv⟩
+
+@[to_additive]
+protected lemma div [has_div β] [has_continuous_div β]
+  (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (f / g) :=
+⟨λ n, hf.approx n / hg.approx n, λ x, (hf.tendsto_approx x).div' (hg.tendsto_approx x)⟩
+
+@[to_additive]
+protected lemma smul {𝕜} [topological_space 𝕜] [has_smul 𝕜 β] [has_continuous_smul 𝕜 β]
+  {f : α → 𝕜} {g : α → β} (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (λ x, f x • g x) :=
+continuous_smul.comp_strongly_measurable (hf.prod_mk hg)
+
+protected lemma const_smul {𝕜} [has_smul 𝕜 β] [has_continuous_const_smul 𝕜 β]
+  (hf : strongly_measurable f) (c : 𝕜) :
+  strongly_measurable (c • f) :=
+⟨λ n, c • (hf.approx n), λ x, (hf.tendsto_approx x).const_smul c⟩
+
+protected lemma const_smul' {𝕜} [has_smul 𝕜 β] [has_continuous_const_smul 𝕜 β]
+  (hf : strongly_measurable f) (c : 𝕜) :
+  strongly_measurable (λ x, c • (f x)) :=
+hf.const_smul c
+
+@[to_additive]
+protected lemma smul_const {𝕜} [topological_space 𝕜] [has_smul 𝕜 β] [has_continuous_smul 𝕜 β]
+  {f : α → 𝕜} (hf : strongly_measurable f) (c : β) :
+  strongly_measurable (λ x, f x • c) :=
+continuous_smul.comp_strongly_measurable (hf.prod_mk strongly_measurable_const)
+
+end arithmetic
+
+section mul_action
+variables {M G G₀ : Type*}
+variables [topological_space β]
+variables [monoid M] [mul_action M β] [has_continuous_const_smul M β]
+variables [group G] [mul_action G β] [has_continuous_const_smul G β]
+variables [group_with_zero G₀] [mul_action G₀ β] [has_continuous_const_smul G₀ β]
+
+lemma _root_.strongly_measurable_const_smul_iff {m : measurable_space α} (c : G) :
+  strongly_measurable (λ x, c • f x) ↔ strongly_measurable f :=
+⟨λ h, by simpa only [inv_smul_smul] using h.const_smul' c⁻¹, λ h, h.const_smul c⟩
+
+lemma _root_.is_unit.strongly_measurable_const_smul_iff {m : measurable_space α} {c : M}
+  (hc : is_unit c) :
+  strongly_measurable (λ x, c • f x) ↔ strongly_measurable f :=
+let ⟨u, hu⟩ := hc in hu ▸ strongly_measurable_const_smul_iff u
+
+lemma _root_.strongly_measurable_const_smul_iff₀ {m : measurable_space α} {c : G₀} (hc : c ≠ 0) :
+  strongly_measurable (λ x, c • f x) ↔ strongly_measurable f :=
+(is_unit.mk0 _ hc).strongly_measurable_const_smul_iff
+
+end mul_action
+
+section order
+variables [measurable_space α] [topological_space β]
+
+open filter
+open_locale filter
+
+protected lemma sup [has_sup β] [has_continuous_sup β] (hf : strongly_measurable f)
+  (hg : strongly_measurable g) :
+  strongly_measurable (f ⊔ g) :=
+⟨λ n, hf.approx n ⊔ hg.approx n, λ x, (hf.tendsto_approx x).sup_right_nhds (hg.tendsto_approx x)⟩
+
+protected lemma inf [has_inf β] [has_continuous_inf β] (hf : strongly_measurable f)
+  (hg : strongly_measurable g) :
+  strongly_measurable (f ⊓ g) :=
+⟨λ n, hf.approx n ⊓ hg.approx n, λ x, (hf.tendsto_approx x).inf_right_nhds (hg.tendsto_approx x)⟩
+
+end order
+
+/-!
+### Big operators: `∏` and `∑`
+-/
+
+section monoid
+variables {M : Type*} [monoid M] [topological_space M] [has_continuous_mul M]
+  {m : measurable_space α}
+
+include m
+
+@[to_additive]
+lemma _root_.list.strongly_measurable_prod'
+  (l : list (α → M)) (hl : ∀ f ∈ l, strongly_measurable f) :
+  strongly_measurable l.prod :=
+begin
+  induction l with f l ihl, { exact strongly_measurable_one },
+  rw [list.forall_mem_cons] at hl,
+  rw [list.prod_cons],
+  exact hl.1.mul (ihl hl.2)
+end
+
+@[to_additive]
+lemma _root_.list.strongly_measurable_prod
+  (l : list (α → M)) (hl : ∀ f ∈ l, strongly_measurable f) :
+  strongly_measurable (λ x, (l.map (λ f : α → M, f x)).prod) :=
+by simpa only [← pi.list_prod_apply] using l.strongly_measurable_prod' hl
+
+end monoid
+
+section comm_monoid
+variables {M : Type*} [comm_monoid M] [topological_space M] [has_continuous_mul M]
+  {m : measurable_space α}
+
+include m
+
+@[to_additive]
+lemma _root_.multiset.strongly_measurable_prod'
+  (l : multiset (α → M)) (hl : ∀ f ∈ l, strongly_measurable f) :
+  strongly_measurable l.prod :=
+by { rcases l with ⟨l⟩, simpa using l.strongly_measurable_prod' (by simpa using hl) }
+
+@[to_additive]
+lemma _root_.multiset.strongly_measurable_prod
+  (s : multiset (α → M)) (hs : ∀ f ∈ s, strongly_measurable f) :
+  strongly_measurable (λ x, (s.map (λ f : α → M, f x)).prod) :=
+by simpa only [← pi.multiset_prod_apply] using s.strongly_measurable_prod' hs
+
+@[to_additive]
+lemma _root_.finset.strongly_measurable_prod'
+  {ι : Type*} {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, strongly_measurable (f i)) :
+  strongly_measurable (∏ i in s, f i) :=
+finset.prod_induction _ _ (λ a b ha hb, ha.mul hb) (@strongly_measurable_one α M _ _ _) hf
+
+@[to_additive]
+lemma _root_.finset.strongly_measurable_prod
+  {ι : Type*} {f : ι → α → M} (s : finset ι) (hf : ∀i ∈ s, strongly_measurable (f i)) :
+  strongly_measurable (λ a, ∏ i in s, f i a) :=
+by simpa only [← finset.prod_apply] using s.strongly_measurable_prod' hf
+
+end comm_monoid
+
+/-- The range of a strongly measurable function is separable. -/
+lemma is_separable_range {m : measurable_space α} [topological_space β]
+  (hf : strongly_measurable f) :
+  topological_space.is_separable (range f) :=
+begin
+  have : is_separable (closure (⋃ n, range (hf.approx n))) :=
+    (is_separable_Union (λ n, (simple_func.finite_range (hf.approx n)).is_separable)).closure,
+  apply this.mono,
+  rintros _ ⟨x, rfl⟩,
+  apply mem_closure_of_tendsto (hf.tendsto_approx x),
+  apply eventually_of_forall (λ n, _),
+  apply mem_Union_of_mem n,
+  exact mem_range_self _
+end
+
+lemma separable_space_range_union_singleton {m : measurable_space α} [topological_space β]
+  [pseudo_metrizable_space β] (hf : strongly_measurable f) {b : β} :
+  separable_space (range f ∪ {b} : set β) :=
+begin
+  letI := pseudo_metrizable_space_pseudo_metric β,
+  exact (hf.is_separable_range.union (finite_singleton _).is_separable).separable_space
+end
+
+section second_countable_strongly_measurable
+
+variables {mα : measurable_space α} [measurable_space β]
+include mα
+
+/-- In a space with second countable topology, measurable implies strongly measurable. -/
+lemma _root_.measurable.strongly_measurable [topological_space β] [pseudo_metrizable_space β]
+  [second_countable_topology β] [opens_measurable_space β] (hf : measurable f) :
+  strongly_measurable f :=
+begin
+  letI := pseudo_metrizable_space_pseudo_metric β,
+  rcases is_empty_or_nonempty β; resetI,
+  { exact subsingleton.strongly_measurable f, },
+  { inhabit β,
+    exact ⟨simple_func.approx_on f hf set.univ default (set.mem_univ _),
+      λ x, simple_func.tendsto_approx_on hf (set.mem_univ _) (by simp)⟩, },
+end
+
+/-- In a space with second countable topology, strongly measurable and measurable are equivalent. -/
+lemma _root_.strongly_measurable_iff_measurable
+  [topological_space β] [metrizable_space β] [borel_space β] [second_countable_topology β] :
+  strongly_measurable f ↔ measurable f :=
+⟨λ h, h.measurable, λ h, measurable.strongly_measurable h⟩
+
+lemma _root_.strongly_measurable_id [topological_space α] [pseudo_metrizable_space α]
+  [opens_measurable_space α] [second_countable_topology α] :
+  strongly_measurable (id : α → α) :=
+measurable_id.strongly_measurable
+
+end second_countable_strongly_measurable
+
+/-- A function is strongly measurable if and only if it is measurable and has separable
+range. -/
+theorem _root_.strongly_measurable_iff_measurable_separable {m : measurable_space α}
+  [topological_space β] [pseudo_metrizable_space β] [measurable_space β] [borel_space β] :
+  strongly_measurable f ↔ (measurable f ∧ is_separable (range f)) :=
+begin
+  refine ⟨λ H, ⟨H.measurable, H.is_separable_range⟩, _⟩,
+  rintros ⟨H, H'⟩,
+  letI := pseudo_metrizable_space_pseudo_metric β,
+  let g := cod_restrict f (closure (range f)) (λ x, subset_closure (mem_range_self x)),
+  have fg : f = (coe : closure (range f) → β) ∘ g, by { ext x, refl },
+  have T : measurable_embedding (coe : closure (range f) → β),
+  { apply closed_embedding.measurable_embedding,
+    exact closed_embedding_subtype_coe is_closed_closure },
+  have g_meas : measurable g,
+  { rw fg at H, exact T.measurable_comp_iff.1 H },
+  haveI : second_countable_topology (closure (range f)),
+  { suffices : separable_space (closure (range f)),
+      by exactI uniform_space.second_countable_of_separable _,
+    exact (is_separable.closure H').separable_space },
+  have g_smeas : strongly_measurable g := measurable.strongly_measurable g_meas,
+  rw fg,
+  exact continuous_subtype_coe.comp_strongly_measurable g_smeas,
+end
+
+/-- A continuous function is strongly measurable when either the source space or the target space
+is second-countable. -/
+lemma _root_.continuous.strongly_measurable [measurable_space α]
+  [topological_space α] [opens_measurable_space α]
+  {β : Type*} [topological_space β] [pseudo_metrizable_space β]
+  [h : second_countable_topology_either α β]
+  {f : α → β} (hf : continuous f) :
+  strongly_measurable f :=
+begin
+  borelize β,
+  casesI h.out,
+  { rw strongly_measurable_iff_measurable_separable,
+    refine ⟨hf.measurable, _⟩,
+    rw ← image_univ,
+    exact (is_separable_of_separable_space univ).image hf },
+  { exact hf.measurable.strongly_measurable }
+end
+
+/-- If `g` is a topological embedding, then `f` is strongly measurable iff `g ∘ f` is. -/
+lemma _root_.embedding.comp_strongly_measurable_iff {m : measurable_space α}
+  [topological_space β] [pseudo_metrizable_space β] [topological_space γ]
+  [pseudo_metrizable_space γ]
+  {g : β → γ} {f : α → β} (hg : embedding g) :
+  strongly_measurable (λ x, g (f x)) ↔ strongly_measurable f :=
+begin
+  letI := pseudo_metrizable_space_pseudo_metric γ,
+  borelize [β, γ],
+  refine ⟨λ H, strongly_measurable_iff_measurable_separable.2 ⟨_, _⟩,
+    λ H, hg.continuous.comp_strongly_measurable H⟩,
+  { let G : β → range g := cod_restrict g (range g) mem_range_self,
+    have hG : closed_embedding G :=
+    { closed_range :=
+      begin
+        convert is_closed_univ,
+        apply eq_univ_of_forall,
+        rintros ⟨-, ⟨x, rfl⟩⟩,
+        exact mem_range_self x
+      end,
+      .. hg.cod_restrict _ _ },
+    have : measurable (G ∘ f) := measurable.subtype_mk H.measurable,
+    exact hG.measurable_embedding.measurable_comp_iff.1 this },
+  { have : is_separable (g ⁻¹' (range (g ∘ f))) := hg.is_separable_preimage H.is_separable_range,
+    convert this,
+    ext x,
+    simp [hg.inj.eq_iff] }
+end
+
+/-- A sequential limit of strongly measurable functions is strongly measurable. -/
+lemma _root_.strongly_measurable_of_tendsto {ι : Type*} {m : measurable_space α}
+  [topological_space β] [pseudo_metrizable_space β] (u : filter ι) [ne_bot u]
+  [is_countably_generated u] {f : ι → α → β} {g : α → β} (hf : ∀ i, strongly_measurable (f i))
+  (lim : tendsto f u (𝓝 g)) :
+  strongly_measurable g :=
+begin
+  borelize β,
+  refine strongly_measurable_iff_measurable_separable.2 ⟨_, _⟩,
+  { exact measurable_of_tendsto_metrizable' u (λ i, (hf i).measurable) lim },
+  { rcases u.exists_seq_tendsto with ⟨v, hv⟩,
+    have : is_separable (closure (⋃ i, range (f (v i)))) :=
+      (is_separable_Union (λ i, (hf (v i)).is_separable_range)).closure,
+    apply this.mono,
+    rintros _ ⟨x, rfl⟩,
+    rw [tendsto_pi_nhds] at lim,
+    apply mem_closure_of_tendsto ((lim x).comp hv),
+    apply eventually_of_forall (λ n, _),
+    apply mem_Union_of_mem n,
+    exact mem_range_self _ }
+end
+
+protected lemma piecewise {m : measurable_space α} [topological_space β]
+  {s : set α} {_ : decidable_pred (∈ s)} (hs : measurable_set s)
+  (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (set.piecewise s f g) :=
+begin
+  refine ⟨λ n, simple_func.piecewise s hs (hf.approx n) (hg.approx n), λ x, _⟩,
+  by_cases hx : x ∈ s,
+  { simpa [hx] using hf.tendsto_approx x },
+  { simpa [hx] using hg.tendsto_approx x },
+end
+
+/-- this is slightly different from `strongly_measurable.piecewise`. It can be used to show
+`strongly_measurable (ite (x=0) 0 1)` by
+`exact strongly_measurable.ite (measurable_set_singleton 0) strongly_measurable_const
+strongly_measurable_const`, but replacing `strongly_measurable.ite` by
+`strongly_measurable.piecewise` in that example proof does not work. -/
+protected lemma ite {m : measurable_space α} [topological_space β]
+  {p : α → Prop} {_ : decidable_pred p}
+  (hp : measurable_set {a : α | p a}) (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (λ x, ite (p x) (f x) (g x)) :=
+strongly_measurable.piecewise hp hf hg
+
+lemma _root_.strongly_measurable_of_strongly_measurable_union_cover
+  {m : measurable_space α} [topological_space β]
+  {f : α → β} (s t : set α) (hs : measurable_set s) (ht : measurable_set t) (h : univ ⊆ s ∪ t)
+  (hc : strongly_measurable (λ a : s, f a)) (hd : strongly_measurable (λ a : t, f a)) :
+  strongly_measurable f :=
+begin
+  classical,
+  let f : ℕ → α →ₛ β := λ n,
+  { to_fun := λ x, if hx : x ∈ s then hc.approx n ⟨x, hx⟩
+                   else hd.approx n ⟨x, by simpa [hx] using h (mem_univ x)⟩,
+    measurable_set_fiber' :=
+    begin
+      assume x,
+      convert (hs.subtype_image
+        ((hc.approx n).measurable_set_fiber x)).union
+        ((ht.subtype_image
+        ((hd.approx n).measurable_set_fiber x)).diff hs),
+      ext1 y,
+      simp only [mem_union, mem_preimage, mem_singleton_iff, mem_image, set_coe.exists,
+        subtype.coe_mk, exists_and_distrib_right, exists_eq_right, mem_diff],
+      by_cases hy : y ∈ s,
+      { rw dif_pos hy,
+        simp only [hy, exists_true_left, not_true, and_false, or_false]},
+      { rw dif_neg hy,
+        have A : y ∈ t, by simpa [hy] using h (mem_univ y),
+        simp only [A, hy, false_or, is_empty.exists_iff, not_false_iff, and_true,
+          exists_true_left] }
+    end,
+    finite_range' :=
+    begin
+      apply ((hc.approx n).finite_range.union (hd.approx n).finite_range).subset,
+      rintros - ⟨y, rfl⟩,
+      dsimp,
+      by_cases hy : y ∈ s,
+      { left,
+        rw dif_pos hy,
+        exact mem_range_self _ },
+      { right,
+        rw dif_neg hy,
+        exact mem_range_self _ }
+    end },
+  refine ⟨f, λ y, _⟩,
+  by_cases hy : y ∈ s,
+  { convert hc.tendsto_approx ⟨y, hy⟩ using 1,
+    ext1 n,
+    simp only [dif_pos hy, simple_func.apply_mk] },
+  { have A : y ∈ t, by simpa [hy] using h (mem_univ y),
+    convert hd.tendsto_approx ⟨y, A⟩ using 1,
+    ext1 n,
+    simp only [dif_neg hy, simple_func.apply_mk] }
+end
+
+lemma _root_.strongly_measurable_of_restrict_of_restrict_compl
+  {m : measurable_space α} [topological_space β] {f : α → β} {s : set α} (hs : measurable_set s)
+  (h₁ : strongly_measurable (s.restrict f)) (h₂ : strongly_measurable (sᶜ.restrict f)) :
+  strongly_measurable f :=
+strongly_measurable_of_strongly_measurable_union_cover s sᶜ hs hs.compl
+  (union_compl_self s).ge h₁ h₂
+
+protected lemma indicator {m : measurable_space α} [topological_space β] [has_zero β]
+  (hf : strongly_measurable f) {s : set α} (hs : measurable_set s) :
+  strongly_measurable (s.indicator f) :=
+hf.piecewise hs strongly_measurable_const
+
+protected lemma dist {m : measurable_space α} {β : Type*} [pseudo_metric_space β] {f g : α → β}
+  (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (λ x, dist (f x) (g x)) :=
+continuous_dist.comp_strongly_measurable (hf.prod_mk hg)
+
+protected lemma norm {m : measurable_space α} {β : Type*} [seminormed_add_comm_group β]
+  {f : α → β} (hf : strongly_measurable f) :
+  strongly_measurable (λ x, ‖f x‖) :=
+continuous_norm.comp_strongly_measurable hf
+
+protected lemma nnnorm {m : measurable_space α} {β : Type*} [seminormed_add_comm_group β]
+  {f : α → β} (hf : strongly_measurable f) :
+  strongly_measurable (λ x, ‖f x‖₊) :=
+continuous_nnnorm.comp_strongly_measurable hf
+
+protected lemma ennnorm {m : measurable_space α} {β : Type*} [seminormed_add_comm_group β]
+  {f : α → β} (hf : strongly_measurable f) :
+  measurable (λ a, (‖f a‖₊ : ℝ≥0∞)) :=
+(ennreal.continuous_coe.comp_strongly_measurable hf.nnnorm).measurable
+
+protected lemma real_to_nnreal {m : measurable_space α} {f : α → ℝ}
+  (hf : strongly_measurable f) :
+  strongly_measurable (λ x, (f x).to_nnreal) :=
+continuous_real_to_nnreal.comp_strongly_measurable hf
+
+lemma _root_.measurable_embedding.strongly_measurable_extend {f : α → β} {g : α → γ} {g' : γ → β}
+  {mα : measurable_space α} {mγ : measurable_space γ} [topological_space β]
+  (hg : measurable_embedding g)
+  (hf : strongly_measurable f) (hg' : strongly_measurable g') :
+  strongly_measurable (function.extend g f g') :=
+begin
+  refine ⟨λ n, simple_func.extend (hf.approx n) g hg (hg'.approx n), _⟩,
+  assume x,
+  by_cases hx : ∃ y, g y = x,
+  { rcases hx with ⟨y, rfl⟩,
+    simpa only [simple_func.extend_apply, hg.injective,
+      injective.extend_apply] using hf.tendsto_approx y },
+  { simpa only [hx, simple_func.extend_apply', not_false_iff, extend_apply']
+      using hg'.tendsto_approx x }
+end
+
+lemma _root_.measurable_embedding.exists_strongly_measurable_extend
+  {f : α → β} {g : α → γ}
+  {mα : measurable_space α} {mγ : measurable_space γ} [topological_space β]
+  (hg : measurable_embedding g) (hf : strongly_measurable f) (hne : γ → nonempty β) :
+  ∃ f' : γ → β, strongly_measurable f' ∧ f' ∘ g = f :=
+⟨function.extend g f (λ x, classical.choice (hne x)),
+  hg.strongly_measurable_extend hf (strongly_measurable_const' $ λ _ _, rfl),
+  funext $ λ x, hg.injective.extend_apply _ _ _⟩
+
+lemma measurable_set_eq_fun {m : measurable_space α} {E} [topological_space E] [metrizable_space E]
+  {f g : α → E} (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  measurable_set {x | f x = g x} :=
+begin
+  borelize E × E,
+  exact (hf.prod_mk hg).measurable is_closed_diagonal.measurable_set
+end
+
+lemma measurable_set_lt {m : measurable_space α} [topological_space β]
+  [linear_order β] [order_closed_topology β] [pseudo_metrizable_space β]
+  {f g : α → β} (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  measurable_set {a | f a < g a} :=
+begin
+  borelize β × β,
+  exact (hf.prod_mk hg).measurable is_open_lt_prod.measurable_set
+end
+
+lemma measurable_set_le {m : measurable_space α} [topological_space β]
+  [preorder β] [order_closed_topology β] [pseudo_metrizable_space β]
+  {f g : α → β} (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  measurable_set {a | f a ≤ g a} :=
+begin
+  borelize β × β,
+  exact (hf.prod_mk hg).measurable is_closed_le_prod.measurable_set
+end
+
+lemma strongly_measurable_in_set {m : measurable_space α} [topological_space β] [has_zero β]
+  {s : set α} {f : α → β}
+  (hs : measurable_set s) (hf : strongly_measurable f) (hf_zero : ∀ x ∉ s, f x = 0) :
+  ∃ fs : ℕ → α →ₛ β, (∀ x, tendsto (λ n, fs n x) at_top (𝓝 (f x))) ∧ (∀ (x ∉ s) n, fs n x = 0) :=
+begin
+  let g_seq_s : ℕ → @simple_func α m β := λ n, (hf.approx n).restrict s,
+  have hg_eq : ∀ x ∈ s, ∀ n, g_seq_s n x = hf.approx n x,
+  { intros x hx n,
+    rw [simple_func.coe_restrict _ hs, set.indicator_of_mem hx], },
+  have hg_zero : ∀ x ∉ s, ∀ n, g_seq_s n x = 0,
+  { intros x hx n,
+    rw [simple_func.coe_restrict _ hs, set.indicator_of_not_mem hx], },
+  refine ⟨g_seq_s, λ x, _, hg_zero⟩,
+  by_cases hx : x ∈ s,
+  { simp_rw hg_eq x hx,
+    exact hf.tendsto_approx x, },
+  { simp_rw [hg_zero x hx, hf_zero x hx],
+    exact tendsto_const_nhds, },
+end
+
+/-- If the restriction to a set `s` of a σ-algebra `m` is included in the restriction to `s` of
+another σ-algebra `m₂` (hypothesis `hs`), the set `s` is `m` measurable and a function `f` supported
+on `s` is `m`-strongly-measurable, then `f` is also `m₂`-strongly-measurable. -/
+lemma strongly_measurable_of_measurable_space_le_on {α E} {m m₂ : measurable_space α}
+  [topological_space E] [has_zero E] {s : set α} {f : α → E}
+  (hs_m : measurable_set[m] s) (hs : ∀ t, measurable_set[m] (s ∩ t) → measurable_set[m₂] (s ∩ t))
+  (hf : strongly_measurable[m] f) (hf_zero : ∀ x ∉ s, f x = 0) :
+  strongly_measurable[m₂] f :=
+begin
+  have hs_m₂ : measurable_set[m₂] s,
+  { rw ← set.inter_univ s,
+    refine hs set.univ _,
+    rwa [set.inter_univ], },
+  obtain ⟨g_seq_s, hg_seq_tendsto, hg_seq_zero⟩ := strongly_measurable_in_set hs_m hf hf_zero,
+  let g_seq_s₂ : ℕ → @simple_func α m₂ E := λ n,
+  { to_fun := g_seq_s n,
+    measurable_set_fiber' := λ x, begin
+      rw [← set.inter_univ ((g_seq_s n) ⁻¹' {x}), ← set.union_compl_self s,
+        set.inter_union_distrib_left, set.inter_comm ((g_seq_s n) ⁻¹' {x})],
+      refine measurable_set.union (hs _ (hs_m.inter _)) _,
+      { exact @simple_func.measurable_set_fiber _ _ m _ _, },
+      by_cases hx : x = 0,
+      { suffices : (g_seq_s n) ⁻¹' {x} ∩ sᶜ = sᶜ, by { rw this, exact hs_m₂.compl, },
+        ext1 y,
+        rw [hx, set.mem_inter_iff, set.mem_preimage, set.mem_singleton_iff],
+        exact ⟨λ h, h.2, λ h, ⟨hg_seq_zero y h n, h⟩⟩, },
+      { suffices : (g_seq_s n) ⁻¹' {x} ∩ sᶜ = ∅, by { rw this, exact measurable_set.empty, },
+        ext1 y,
+        simp only [mem_inter_iff, mem_preimage, mem_singleton_iff, mem_compl_iff,
+          mem_empty_iff_false, iff_false, not_and, not_not_mem],
+        refine imp_of_not_imp_not _ _ (λ hys, _),
+        rw hg_seq_zero y hys n,
+        exact ne.symm hx, },
+    end,
+    finite_range' := @simple_func.finite_range _ _ m (g_seq_s n), },
+  have hg_eq : ∀ x n, g_seq_s₂ n x = g_seq_s n x := λ x n, rfl,
+  refine ⟨g_seq_s₂, λ x, _⟩,
+  simp_rw hg_eq,
+  exact hg_seq_tendsto x,
+end
+
+/-- If a function `f` is strongly measurable w.r.t. a sub-σ-algebra `m` and the measure is σ-finite
+on `m`, then there exists spanning measurable sets with finite measure on which `f` has bounded
+norm. In particular, `f` is integrable on each of those sets. -/
+lemma exists_spanning_measurable_set_norm_le [seminormed_add_comm_group β]
+  {m m0 : measurable_space α} (hm : m ≤ m0) (hf : strongly_measurable[m] f) (μ : measure α)
+  [sigma_finite (μ.trim hm)] :
+  ∃ s : ℕ → set α, (∀ n, measurable_set[m] (s n) ∧ μ (s n) < ∞ ∧ ∀ x ∈ s n, ‖f x‖ ≤ n)
+    ∧ (⋃ i, s i) = set.univ :=
+begin
+  let sigma_finite_sets := spanning_sets (μ.trim hm),
+  let norm_sets := λ (n : ℕ), {x | ‖f x‖ ≤ n},
+  have norm_sets_spanning : (⋃ n, norm_sets n) = set.univ,
+  { ext1 x, simp only [set.mem_Union, set.mem_set_of_eq, set.mem_univ, iff_true],
+    exact ⟨⌈‖f x‖⌉₊, nat.le_ceil (‖f x‖)⟩, },
+  let sets := λ n, sigma_finite_sets n ∩ norm_sets n,
+  have h_meas : ∀ n, measurable_set[m] (sets n),
+  { refine λ n, measurable_set.inter _ _,
+    { exact measurable_spanning_sets (μ.trim hm) n, },
+    { exact hf.norm.measurable_set_le strongly_measurable_const, }, },
+  have h_finite : ∀ n, μ (sets n) < ∞,
+  { refine λ n, (measure_mono (set.inter_subset_left _ _)).trans_lt _,
+    exact (le_trim hm).trans_lt (measure_spanning_sets_lt_top (μ.trim hm) n), },
+  refine ⟨sets, λ n, ⟨h_meas n, h_finite n, _⟩, _⟩,
+  { exact λ x hx, hx.2, },
+  { have : (⋃ i, sigma_finite_sets i ∩ norm_sets i)
+      = (⋃ i, sigma_finite_sets i) ∩ (⋃ i, norm_sets i),
+    { refine set.Union_inter_of_monotone (monotone_spanning_sets (μ.trim hm)) (λ i j hij x, _),
+      simp only [norm_sets, set.mem_set_of_eq],
+      refine λ hif, hif.trans _,
+      exact_mod_cast hij, },
+    rw [this, norm_sets_spanning, Union_spanning_sets (μ.trim hm), set.inter_univ], },
+end
+
+end strongly_measurable
+
+/-! ## Finitely strongly measurable functions -/
+
+lemma fin_strongly_measurable_zero {α β} {m : measurable_space α} {μ : measure α} [has_zero β]
+  [topological_space β] :
+  fin_strongly_measurable (0 : α → β) μ :=
+⟨0, by simp only [pi.zero_apply, simple_func.coe_zero, support_zero', measure_empty,
+    with_top.zero_lt_top, forall_const],
+  λ n, tendsto_const_nhds⟩
+
+namespace fin_strongly_measurable
+
+variables {m0 : measurable_space α} {μ : measure α} {f g : α → β}
+
+lemma ae_fin_strongly_measurable [has_zero β] [topological_space β]
+  (hf : fin_strongly_measurable f μ) :
+  ae_fin_strongly_measurable f μ :=
+⟨f, hf, ae_eq_refl f⟩
+
+section sequence
+variables [has_zero β] [topological_space β] (hf : fin_strongly_measurable f μ)
+
+/-- A sequence of simple functions such that `∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x))`
+and `∀ n, μ (support (hf.approx n)) < ∞`. These properties are given by
+`fin_strongly_measurable.tendsto_approx` and `fin_strongly_measurable.fin_support_approx`. -/
+protected noncomputable def approx : ℕ → α →ₛ β := hf.some
+
+protected lemma fin_support_approx : ∀ n, μ (support (hf.approx n)) < ∞ := hf.some_spec.1
+
+protected lemma tendsto_approx : ∀ x, tendsto (λ n, hf.approx n x) at_top (𝓝 (f x)) :=
+hf.some_spec.2
+
+end sequence
+
+protected lemma strongly_measurable [has_zero β] [topological_space β]
+  (hf : fin_strongly_measurable f μ) :
+  strongly_measurable f :=
+⟨hf.approx, hf.tendsto_approx⟩
+
+lemma exists_set_sigma_finite [has_zero β] [topological_space β] [t2_space β]
+  (hf : fin_strongly_measurable f μ) :
+  ∃ t, measurable_set t ∧ (∀ x ∈ tᶜ, f x = 0) ∧ sigma_finite (μ.restrict t) :=
+begin
+  rcases hf with ⟨fs, hT_lt_top, h_approx⟩,
+  let T := λ n, support (fs n),
+  have hT_meas : ∀ n, measurable_set (T n), from λ n, simple_func.measurable_set_support (fs n),
+  let t := ⋃ n, T n,
+  refine ⟨t, measurable_set.Union hT_meas, _, _⟩,
+  { have h_fs_zero : ∀ n, ∀ x ∈ tᶜ, fs n x = 0,
+    { intros n x hxt,
+      rw [set.mem_compl_iff, set.mem_Union, not_exists] at hxt,
+      simpa using (hxt n), },
+    refine λ x hxt, tendsto_nhds_unique (h_approx x) _,
+    rw funext (λ n, h_fs_zero n x hxt),
+    exact tendsto_const_nhds, },
+  { refine ⟨⟨⟨λ n, tᶜ ∪ T n, λ n, trivial, λ n, _, _⟩⟩⟩,
+    { rw [measure.restrict_apply' (measurable_set.Union hT_meas), set.union_inter_distrib_right,
+        set.compl_inter_self t, set.empty_union],
+      exact (measure_mono (set.inter_subset_left _ _)).trans_lt (hT_lt_top n), },
+    { rw ← set.union_Union tᶜ T,
+      exact set.compl_union_self _ } }
+end
+
+/-- A finitely strongly measurable function is measurable. -/
+protected lemma measurable [has_zero β] [topological_space β] [pseudo_metrizable_space β]
+  [measurable_space β] [borel_space β] (hf : fin_strongly_measurable f μ) :
+  measurable f :=
+hf.strongly_measurable.measurable
+
+section arithmetic
+variables [topological_space β]
+
+protected lemma mul [monoid_with_zero β] [has_continuous_mul β]
+  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
+  fin_strongly_measurable (f * g) μ :=
+begin
+  refine ⟨λ n, hf.approx n * hg.approx n, _, λ x, (hf.tendsto_approx x).mul (hg.tendsto_approx x)⟩,
+  intro n,
+  exact (measure_mono (support_mul_subset_left _ _)).trans_lt (hf.fin_support_approx n),
+end
+
+protected lemma add [add_monoid β] [has_continuous_add β]
+  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
+  fin_strongly_measurable (f + g) μ :=
+⟨λ n, hf.approx n + hg.approx n,
+  λ n, (measure_mono (function.support_add _ _)).trans_lt ((measure_union_le _ _).trans_lt
+    (ennreal.add_lt_top.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩)),
+  λ x, (hf.tendsto_approx x).add (hg.tendsto_approx x)⟩
+
+protected lemma neg [add_group β] [topological_add_group β] (hf : fin_strongly_measurable f μ) :
+  fin_strongly_measurable (-f) μ :=
+begin
+  refine ⟨λ n, -hf.approx n, λ n, _, λ x, (hf.tendsto_approx x).neg⟩,
+  suffices : μ (function.support (λ x, - (hf.approx n) x)) < ∞, by convert this,
+  rw function.support_neg (hf.approx n),
+  exact hf.fin_support_approx n,
+end
+
+protected lemma sub [add_group β] [has_continuous_sub β]
+  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
+  fin_strongly_measurable (f - g) μ :=
+⟨λ n, hf.approx n - hg.approx n,
+  λ n, (measure_mono (function.support_sub _ _)).trans_lt ((measure_union_le _ _).trans_lt
+    (ennreal.add_lt_top.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩)),
+  λ x, (hf.tendsto_approx x).sub (hg.tendsto_approx x)⟩
+
+protected lemma const_smul {𝕜} [topological_space 𝕜] [add_monoid β] [monoid 𝕜]
+  [distrib_mul_action 𝕜 β] [has_continuous_smul 𝕜 β]
+  (hf : fin_strongly_measurable f μ) (c : 𝕜) :
+  fin_strongly_measurable (c • f) μ :=
+begin
+  refine ⟨λ n, c • (hf.approx n), λ n, _, λ x, (hf.tendsto_approx x).const_smul c⟩,
+  rw simple_func.coe_smul,
+  refine (measure_mono (support_smul_subset_right c _)).trans_lt (hf.fin_support_approx n),
+end
+
+end arithmetic
+
+section order
+variables [topological_space β] [has_zero β]
+
+protected lemma sup [semilattice_sup β] [has_continuous_sup β]
+  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
+  fin_strongly_measurable (f ⊔ g) μ :=
+begin
+  refine ⟨λ n, hf.approx n ⊔ hg.approx n, λ n, _,
+    λ x, (hf.tendsto_approx x).sup_right_nhds (hg.tendsto_approx x)⟩,
+  refine (measure_mono (support_sup _ _)).trans_lt _,
+  exact measure_union_lt_top_iff.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩,
+end
+
+protected lemma inf [semilattice_inf β] [has_continuous_inf β]
+  (hf : fin_strongly_measurable f μ) (hg : fin_strongly_measurable g μ) :
+  fin_strongly_measurable (f ⊓ g) μ :=
+begin
+  refine ⟨λ n, hf.approx n ⊓ hg.approx n, λ n, _,
+    λ x, (hf.tendsto_approx x).inf_right_nhds (hg.tendsto_approx x)⟩,
+  refine (measure_mono (support_inf _ _)).trans_lt _,
+  exact measure_union_lt_top_iff.mpr ⟨hf.fin_support_approx n, hg.fin_support_approx n⟩,
+end
+
+end order
+
+end fin_strongly_measurable
+
+lemma fin_strongly_measurable_iff_strongly_measurable_and_exists_set_sigma_finite {α β} {f : α → β}
+  [topological_space β] [t2_space β] [has_zero β] {m : measurable_space α} {μ : measure α} :
+  fin_strongly_measurable f μ ↔ (strongly_measurable f
+    ∧ (∃ t, measurable_set t ∧ (∀ x ∈ tᶜ, f x = 0) ∧ sigma_finite (μ.restrict t))) :=
+⟨λ hf, ⟨hf.strongly_measurable, hf.exists_set_sigma_finite⟩,
+  λ hf, hf.1.fin_strongly_measurable_of_set_sigma_finite hf.2.some_spec.1 hf.2.some_spec.2.1
+    hf.2.some_spec.2.2⟩
+
+lemma ae_fin_strongly_measurable_zero {α β} {m : measurable_space α} (μ : measure α) [has_zero β]
+  [topological_space β] :
+  ae_fin_strongly_measurable (0 : α → β) μ :=
+⟨0, fin_strongly_measurable_zero, eventually_eq.rfl⟩
+
+
+/-! ## Almost everywhere strongly measurable functions -/
+
+lemma ae_strongly_measurable_const {α β} {m : measurable_space α} {μ : measure α}
+  [topological_space β] {b : β} :
+  ae_strongly_measurable (λ a : α, b) μ :=
+strongly_measurable_const.ae_strongly_measurable
+
+@[to_additive] lemma ae_strongly_measurable_one {α β} {m : measurable_space α} {μ : measure α}
+  [topological_space β] [has_one β] :
+  ae_strongly_measurable (1 : α → β) μ :=
+strongly_measurable_one.ae_strongly_measurable
+
+@[simp] lemma subsingleton.ae_strongly_measurable {m : measurable_space α} [topological_space β]
+  [subsingleton β] {μ : measure α} (f : α → β) :
+  ae_strongly_measurable f μ :=
+(subsingleton.strongly_measurable f).ae_strongly_measurable
+
+@[simp] lemma subsingleton.ae_strongly_measurable' {m : measurable_space α} [topological_space β]
+  [subsingleton α] {μ : measure α} (f : α → β) :
+  ae_strongly_measurable f μ :=
+(subsingleton.strongly_measurable' f).ae_strongly_measurable
+
+@[simp] lemma ae_strongly_measurable_zero_measure [measurable_space α] [topological_space β]
+  (f : α → β) :
+  ae_strongly_measurable f (0 : measure α) :=
+begin
+  nontriviality α,
+  inhabit α,
+  exact ⟨λ x, f default, strongly_measurable_const, rfl⟩
+end
+
+lemma simple_func.ae_strongly_measurable {m : measurable_space α} {μ : measure α}
+  [topological_space β] (f : α →ₛ β) :
+  ae_strongly_measurable f μ :=
+f.strongly_measurable.ae_strongly_measurable
+
+namespace ae_strongly_measurable
+
+variables {m : measurable_space α} {μ : measure α} [topological_space β] [topological_space γ]
+  {f g : α → β}
+
+section mk
+
+/-- A `strongly_measurable` function such that `f =ᵐ[μ] hf.mk f`. See lemmas
+`strongly_measurable_mk` and `ae_eq_mk`. -/
+protected noncomputable def mk (f : α → β) (hf : ae_strongly_measurable f μ) : α → β := hf.some
+
+lemma strongly_measurable_mk (hf : ae_strongly_measurable f μ) :
+  strongly_measurable (hf.mk f) :=
+hf.some_spec.1
+
+lemma measurable_mk [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
+  (hf : ae_strongly_measurable f μ) :
+  measurable (hf.mk f) :=
+hf.strongly_measurable_mk.measurable
+
+lemma ae_eq_mk (hf : ae_strongly_measurable f μ) : f =ᵐ[μ] hf.mk f :=
+hf.some_spec.2
+
+protected lemma ae_measurable {β} [measurable_space β] [topological_space β]
+  [pseudo_metrizable_space β] [borel_space β] {f : α → β} (hf : ae_strongly_measurable f μ) :
+  ae_measurable f μ :=
+⟨hf.mk f, hf.strongly_measurable_mk.measurable, hf.ae_eq_mk⟩
+
+end mk
+
+lemma congr (hf : ae_strongly_measurable f μ) (h : f =ᵐ[μ] g) : ae_strongly_measurable g μ :=
+⟨hf.mk f, hf.strongly_measurable_mk, h.symm.trans hf.ae_eq_mk⟩
+
+lemma _root_.ae_strongly_measurable_congr (h : f =ᵐ[μ] g) :
+  ae_strongly_measurable f μ ↔ ae_strongly_measurable g μ :=
+⟨λ hf, hf.congr h, λ hg, hg.congr h.symm⟩
+
+lemma mono_measure {ν : measure α} (hf : ae_strongly_measurable f μ) (h : ν ≤ μ) :
+  ae_strongly_measurable f ν :=
+⟨hf.mk f, hf.strongly_measurable_mk, eventually.filter_mono (ae_mono h) hf.ae_eq_mk⟩
+
+protected lemma mono' {ν : measure α} (h : ae_strongly_measurable f μ) (h' : ν ≪ μ) :
+  ae_strongly_measurable f ν :=
+⟨h.mk f, h.strongly_measurable_mk, h' h.ae_eq_mk⟩
+
+lemma mono_set {s t} (h : s ⊆ t) (ht : ae_strongly_measurable f (μ.restrict t)) :
+  ae_strongly_measurable f (μ.restrict s) :=
+ht.mono_measure (restrict_mono h le_rfl)
+
+protected lemma restrict (hfm : ae_strongly_measurable f μ) {s} :
+  ae_strongly_measurable f (μ.restrict s) :=
+hfm.mono_measure measure.restrict_le_self
+
+lemma ae_mem_imp_eq_mk {s} (h : ae_strongly_measurable f (μ.restrict s)) :
+  ∀ᵐ x ∂μ, x ∈ s → f x = h.mk f x :=
+ae_imp_of_ae_restrict h.ae_eq_mk
+
+/-- The composition of a continuous function and an ae strongly measurable function is ae strongly
+measurable. -/
+lemma _root_.continuous.comp_ae_strongly_measurable {g : β → γ} {f : α → β}
+  (hg : continuous g) (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, g (f x)) μ :=
+⟨_, hg.comp_strongly_measurable hf.strongly_measurable_mk, eventually_eq.fun_comp hf.ae_eq_mk g⟩
+
+/-- A continuous function from `α` to `β` is ae strongly measurable when one of the two spaces is
+second countable. -/
+lemma _root_.continuous.ae_strongly_measurable [topological_space α] [opens_measurable_space α]
+  [pseudo_metrizable_space β] [second_countable_topology_either α β] (hf : continuous f) :
+  ae_strongly_measurable f μ :=
+hf.strongly_measurable.ae_strongly_measurable
+
+protected lemma prod_mk {f : α → β} {g : α → γ}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (λ x, (f x, g x)) μ :=
+⟨λ x, (hf.mk f x, hg.mk g x), hf.strongly_measurable_mk.prod_mk hg.strongly_measurable_mk,
+  hf.ae_eq_mk.prod_mk hg.ae_eq_mk⟩
+
+/-- In a space with second countable topology, measurable implies ae strongly measurable. -/
+lemma _root_.measurable.ae_strongly_measurable {m : measurable_space α}
+  {μ : measure α} [measurable_space β] [pseudo_metrizable_space β]
+  [second_countable_topology β] [opens_measurable_space β] (hf : measurable f) :
+  ae_strongly_measurable f μ :=
+hf.strongly_measurable.ae_strongly_measurable
+
+section arithmetic
+
+@[to_additive]
+protected lemma mul [has_mul β] [has_continuous_mul β]
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (f * g) μ :=
+⟨hf.mk f * hg.mk g, hf.strongly_measurable_mk.mul hg.strongly_measurable_mk,
+  hf.ae_eq_mk.mul hg.ae_eq_mk⟩
+
+@[to_additive]
+protected lemma mul_const [has_mul β] [has_continuous_mul β]
+  (hf : ae_strongly_measurable f μ) (c : β) :
+  ae_strongly_measurable (λ x, f x * c) μ :=
+hf.mul ae_strongly_measurable_const
+
+@[to_additive]
+protected lemma const_mul [has_mul β] [has_continuous_mul β]
+  (hf : ae_strongly_measurable f μ) (c : β) :
+  ae_strongly_measurable (λ x, c * f x) μ :=
+ae_strongly_measurable_const.mul hf
+
+@[to_additive]
+protected lemma inv [group β] [topological_group β] (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (f⁻¹) μ :=
+⟨(hf.mk f)⁻¹, hf.strongly_measurable_mk.inv, hf.ae_eq_mk.inv⟩
+
+@[to_additive]
+protected lemma div [group β] [topological_group β]
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (f / g) μ :=
+⟨hf.mk f / hg.mk g, hf.strongly_measurable_mk.div hg.strongly_measurable_mk,
+  hf.ae_eq_mk.div hg.ae_eq_mk⟩
+
+@[to_additive]
+protected lemma smul {𝕜} [topological_space 𝕜] [has_smul 𝕜 β] [has_continuous_smul 𝕜 β]
+  {f : α → 𝕜} {g : α → β} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (λ x, f x • g x) μ :=
+continuous_smul.comp_ae_strongly_measurable (hf.prod_mk hg)
+
+protected lemma const_smul {𝕜} [has_smul 𝕜 β] [has_continuous_const_smul 𝕜 β]
+  (hf : ae_strongly_measurable f μ) (c : 𝕜) :
+  ae_strongly_measurable (c • f) μ :=
+⟨c • hf.mk f, hf.strongly_measurable_mk.const_smul c, hf.ae_eq_mk.const_smul c⟩
+
+protected lemma const_smul' {𝕜} [has_smul 𝕜 β] [has_continuous_const_smul 𝕜 β]
+  (hf : ae_strongly_measurable f μ) (c : 𝕜) :
+  ae_strongly_measurable (λ x, c • (f x)) μ :=
+hf.const_smul c
+
+@[to_additive]
+protected lemma smul_const {𝕜} [topological_space 𝕜] [has_smul 𝕜 β] [has_continuous_smul 𝕜 β]
+  {f : α → 𝕜} (hf : ae_strongly_measurable f μ) (c : β) :
+  ae_strongly_measurable (λ x, f x • c) μ :=
+continuous_smul.comp_ae_strongly_measurable (hf.prod_mk ae_strongly_measurable_const)
+
+end arithmetic
+
+section order
+
+protected lemma sup [semilattice_sup β] [has_continuous_sup β]
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (f ⊔ g) μ :=
+⟨hf.mk f ⊔ hg.mk g, hf.strongly_measurable_mk.sup hg.strongly_measurable_mk,
+  hf.ae_eq_mk.sup hg.ae_eq_mk⟩
+
+protected lemma inf [semilattice_inf β] [has_continuous_inf β]
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (f ⊓ g) μ :=
+⟨hf.mk f ⊓ hg.mk g, hf.strongly_measurable_mk.inf hg.strongly_measurable_mk,
+  hf.ae_eq_mk.inf hg.ae_eq_mk⟩
+
+end order
+
+/-!
+### Big operators: `∏` and `∑`
+-/
+
+section monoid
+variables {M : Type*} [monoid M] [topological_space M] [has_continuous_mul M]
+
+@[to_additive]
+lemma _root_.list.ae_strongly_measurable_prod' (l : list (α → M))
+  (hl : ∀ f ∈ l, ae_strongly_measurable f μ) : ae_strongly_measurable l.prod μ :=
+begin
+  induction l with f l ihl, { exact ae_strongly_measurable_one },
+  rw [list.forall_mem_cons] at hl,
+  rw [list.prod_cons],
+  exact hl.1.mul (ihl hl.2)
+end
+
+@[to_additive]
+lemma _root_.list.ae_strongly_measurable_prod
+  (l : list (α → M)) (hl : ∀ f ∈ l, ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, (l.map (λ f : α → M, f x)).prod) μ :=
+by simpa only [← pi.list_prod_apply] using l.ae_strongly_measurable_prod' hl
+
+end monoid
+
+section comm_monoid
+variables {M : Type*} [comm_monoid M] [topological_space M] [has_continuous_mul M]
+
+@[to_additive]
+lemma _root_.multiset.ae_strongly_measurable_prod' (l : multiset (α → M))
+  (hl : ∀ f ∈ l, ae_strongly_measurable f μ) : ae_strongly_measurable l.prod μ :=
+by { rcases l with ⟨l⟩, simpa using l.ae_strongly_measurable_prod' (by simpa using hl) }
+
+@[to_additive]
+lemma _root_.multiset.ae_strongly_measurable_prod (s : multiset (α → M))
+  (hs : ∀ f ∈ s, ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, (s.map (λ f : α → M, f x)).prod) μ :=
+by simpa only [← pi.multiset_prod_apply] using s.ae_strongly_measurable_prod' hs
+
+@[to_additive]
+lemma _root_.finset.ae_strongly_measurable_prod' {ι : Type*}  {f : ι → α → M}
+  (s : finset ι) (hf : ∀i ∈ s, ae_strongly_measurable (f i) μ) :
+  ae_strongly_measurable (∏ i in s, f i) μ :=
+multiset.ae_strongly_measurable_prod' _ $
+  λ g hg, let ⟨i, hi, hg⟩ := multiset.mem_map.1 hg in (hg ▸ hf _ hi)
+
+@[to_additive]
+lemma _root_.finset.ae_strongly_measurable_prod {ι : Type*}  {f : ι → α → M}
+  (s : finset ι) (hf : ∀i ∈ s, ae_strongly_measurable (f i) μ) :
+  ae_strongly_measurable (λ a, ∏ i in s, f i a) μ :=
+by simpa only [← finset.prod_apply] using s.ae_strongly_measurable_prod' hf
+
+end comm_monoid
+
+section second_countable_ae_strongly_measurable
+
+variables [measurable_space β]
+
+/-- In a space with second countable topology, measurable implies strongly measurable. -/
+lemma _root_.ae_measurable.ae_strongly_measurable [pseudo_metrizable_space β]
+  [opens_measurable_space β] [second_countable_topology β] (hf : ae_measurable f μ) :
+  ae_strongly_measurable f μ :=
+⟨hf.mk f, hf.measurable_mk.strongly_measurable, hf.ae_eq_mk⟩
+
+lemma _root_.ae_strongly_measurable_id {α : Type*} [topological_space α] [pseudo_metrizable_space α]
+  {m : measurable_space α} [opens_measurable_space α] [second_countable_topology α]
+  {μ : measure α} :
+  ae_strongly_measurable (id : α → α) μ :=
+ae_measurable_id.ae_strongly_measurable
+
+/-- In a space with second countable topology, strongly measurable and measurable are equivalent. -/
+lemma _root_.ae_strongly_measurable_iff_ae_measurable [pseudo_metrizable_space β] [borel_space β]
+  [second_countable_topology β] :
+  ae_strongly_measurable f μ ↔ ae_measurable f μ :=
+⟨λ h, h.ae_measurable, λ h, h.ae_strongly_measurable⟩
+
+end second_countable_ae_strongly_measurable
+
+protected lemma dist {β : Type*} [pseudo_metric_space β] {f g : α → β}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (λ x, dist (f x) (g x)) μ :=
+continuous_dist.comp_ae_strongly_measurable (hf.prod_mk hg)
+
+protected lemma norm {β : Type*} [seminormed_add_comm_group β] {f : α → β}
+  (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, ‖f x‖) μ :=
+continuous_norm.comp_ae_strongly_measurable hf
+
+protected lemma nnnorm {β : Type*} [seminormed_add_comm_group β] {f : α → β}
+  (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, ‖f x‖₊) μ :=
+continuous_nnnorm.comp_ae_strongly_measurable hf
+
+protected lemma ennnorm {β : Type*} [seminormed_add_comm_group β] {f : α → β}
+  (hf : ae_strongly_measurable f μ) :
+  ae_measurable (λ a, (‖f a‖₊ : ℝ≥0∞)) μ :=
+(ennreal.continuous_coe.comp_ae_strongly_measurable hf.nnnorm).ae_measurable
+
+protected lemma edist {β : Type*} [seminormed_add_comm_group β] {f g : α → β}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_measurable (λ a, edist (f a) (g a)) μ :=
+(continuous_edist.comp_ae_strongly_measurable (hf.prod_mk hg)).ae_measurable
+
+protected lemma real_to_nnreal {f : α → ℝ}
+  (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, (f x).to_nnreal) μ :=
+continuous_real_to_nnreal.comp_ae_strongly_measurable hf
+
+lemma _root_.ae_strongly_measurable_indicator_iff [has_zero β] {s : set α} (hs : measurable_set s) :
+  ae_strongly_measurable (indicator s f) μ ↔ ae_strongly_measurable f (μ.restrict s)  :=
+begin
+  split,
+  { intro h,
+    exact (h.mono_measure measure.restrict_le_self).congr (indicator_ae_eq_restrict hs) },
+  { intro h,
+    refine ⟨indicator s (h.mk f), h.strongly_measurable_mk.indicator hs, _⟩,
+    have A : s.indicator f =ᵐ[μ.restrict s] s.indicator (h.mk f) :=
+      (indicator_ae_eq_restrict hs).trans (h.ae_eq_mk.trans $ (indicator_ae_eq_restrict hs).symm),
+    have B : s.indicator f =ᵐ[μ.restrict sᶜ] s.indicator (h.mk f) :=
+      (indicator_ae_eq_restrict_compl hs).trans (indicator_ae_eq_restrict_compl hs).symm,
+    exact ae_of_ae_restrict_of_ae_restrict_compl _ A B },
+end
+
+protected lemma indicator [has_zero β]
+  (hfm : ae_strongly_measurable f μ) {s : set α} (hs : measurable_set s) :
+  ae_strongly_measurable (s.indicator f) μ :=
+(ae_strongly_measurable_indicator_iff hs).mpr hfm.restrict
+
+lemma null_measurable_set_eq_fun {E} [topological_space E] [metrizable_space E]
+  {f g : α → E} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  null_measurable_set {x | f x = g x} μ :=
+begin
+  apply (hf.strongly_measurable_mk.measurable_set_eq_fun hg.strongly_measurable_mk)
+    .null_measurable_set.congr,
+  filter_upwards [hf.ae_eq_mk, hg.ae_eq_mk] with x hfx hgx,
+  change (hf.mk f x = hg.mk g x) = (f x = g x),
+  simp only [hfx, hgx]
+end
+
+lemma null_measurable_set_lt
+  [linear_order β] [order_closed_topology β] [pseudo_metrizable_space β]
+  {f g : α → β} (hf : ae_strongly_measurable f μ)
+  (hg : ae_strongly_measurable g μ) :
+  null_measurable_set {a | f a < g a} μ :=
+begin
+  apply (hf.strongly_measurable_mk.measurable_set_lt hg.strongly_measurable_mk)
+    .null_measurable_set.congr,
+  filter_upwards [hf.ae_eq_mk, hg.ae_eq_mk] with x hfx hgx,
+  change (hf.mk f x < hg.mk g x) = (f x < g x),
+  simp only [hfx, hgx]
+end
+
+lemma null_measurable_set_le [preorder β] [order_closed_topology β] [pseudo_metrizable_space β]
+  {f g : α → β} (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  null_measurable_set {a | f a ≤ g a} μ :=
+begin
+  apply (hf.strongly_measurable_mk.measurable_set_le hg.strongly_measurable_mk)
+    .null_measurable_set.congr,
+  filter_upwards [hf.ae_eq_mk, hg.ae_eq_mk] with x hfx hgx,
+  change (hf.mk f x ≤ hg.mk g x) = (f x ≤ g x),
+  simp only [hfx, hgx]
+end
+
+lemma _root_.ae_strongly_measurable_of_ae_strongly_measurable_trim {α} {m m0 : measurable_space α}
+  {μ : measure α} (hm : m ≤ m0) {f : α → β} (hf : ae_strongly_measurable f (μ.trim hm)) :
+  ae_strongly_measurable f μ :=
+⟨hf.mk f, strongly_measurable.mono hf.strongly_measurable_mk hm, ae_eq_of_ae_eq_trim hf.ae_eq_mk⟩
+
+lemma comp_ae_measurable {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α} {f : γ → α}
+  {μ : measure γ} (hg : ae_strongly_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
+  ae_strongly_measurable (g ∘ f) μ :=
+⟨(hg.mk g) ∘ hf.mk f, hg.strongly_measurable_mk.comp_measurable hf.measurable_mk,
+  (ae_eq_comp hf hg.ae_eq_mk).trans ((hf.ae_eq_mk).fun_comp (hg.mk g))⟩
+
+lemma comp_measurable {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α} {f : γ → α}
+  {μ : measure γ} (hg : ae_strongly_measurable g (measure.map f μ)) (hf : measurable f) :
+  ae_strongly_measurable (g ∘ f) μ :=
+hg.comp_ae_measurable hf.ae_measurable
+
+lemma comp_quasi_measure_preserving {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α}
+  {f : γ → α} {μ : measure γ} {ν : measure α} (hg : ae_strongly_measurable g ν)
+  (hf : quasi_measure_preserving f μ ν) : ae_strongly_measurable (g ∘ f) μ :=
+(hg.mono' hf.absolutely_continuous).comp_measurable hf.measurable
+
+lemma is_separable_ae_range (hf : ae_strongly_measurable f μ) :
+  ∃ (t : set β), is_separable t ∧ ∀ᵐ x ∂μ, f x ∈ t :=
+begin
+  refine ⟨range (hf.mk f), hf.strongly_measurable_mk.is_separable_range, _⟩,
+  filter_upwards [hf.ae_eq_mk] with x hx,
+  simp [hx]
+end
+
+/-- A function is almost everywhere strongly measurable if and only if it is almost everywhere
+measurable, and up to a zero measure set its range is contained in a separable set. -/
+theorem _root_.ae_strongly_measurable_iff_ae_measurable_separable
+  [pseudo_metrizable_space β] [measurable_space β] [borel_space β] :
+  ae_strongly_measurable f μ ↔
+    (ae_measurable f μ ∧ ∃ (t : set β), is_separable t ∧ ∀ᵐ x ∂μ, f x ∈ t) :=
+begin
+  refine ⟨λ H, ⟨H.ae_measurable, H.is_separable_ae_range⟩, _⟩,
+  rintros ⟨H, ⟨t, t_sep, ht⟩⟩,
+  rcases eq_empty_or_nonempty t with rfl|h₀,
+  { simp only [mem_empty_iff_false, eventually_false_iff_eq_bot, ae_eq_bot] at ht,
+    rw ht,
+    exact ae_strongly_measurable_zero_measure f },
+  { obtain ⟨g, g_meas, gt, fg⟩ : ∃ (g : α → β), measurable g ∧ range g ⊆ t ∧ f =ᵐ[μ] g :=
+      H.exists_ae_eq_range_subset ht h₀,
+    refine ⟨g, _, fg⟩,
+    exact strongly_measurable_iff_measurable_separable.2 ⟨g_meas, t_sep.mono gt⟩ }
+end
+
+lemma _root_.measurable_embedding.ae_strongly_measurable_map_iff
+  {γ : Type*} {mγ : measurable_space γ} {mα : measurable_space α}
+  {f : γ → α} {μ : measure γ} (hf : measurable_embedding f) {g : α → β} :
+  ae_strongly_measurable g (measure.map f μ) ↔ ae_strongly_measurable (g ∘ f) μ :=
+begin
+  refine ⟨λ H, H.comp_measurable hf.measurable, _⟩,
+  rintro ⟨g₁, hgm₁, heq⟩,
+  rcases hf.exists_strongly_measurable_extend hgm₁ (λ x, ⟨g x⟩) with ⟨g₂, hgm₂, rfl⟩,
+  exact ⟨g₂, hgm₂, hf.ae_map_iff.2 heq⟩
+end
+
+lemma _root_.embedding.ae_strongly_measurable_comp_iff
+  [pseudo_metrizable_space β] [pseudo_metrizable_space γ]
+  {g : β → γ} {f : α → β} (hg : embedding g) :
+  ae_strongly_measurable (λ x, g (f x)) μ ↔ ae_strongly_measurable f μ :=
+begin
+  letI := pseudo_metrizable_space_pseudo_metric γ,
+  borelize [β, γ],
+  refine ⟨λ H, ae_strongly_measurable_iff_ae_measurable_separable.2 ⟨_, _⟩,
+    λ H, hg.continuous.comp_ae_strongly_measurable H⟩,
+  { let G : β → range g := cod_restrict g (range g) mem_range_self,
+    have hG : closed_embedding G :=
+    { closed_range :=
+      begin
+        convert is_closed_univ,
+        apply eq_univ_of_forall,
+        rintros ⟨-, ⟨x, rfl⟩⟩,
+        exact mem_range_self x
+      end,
+      .. hg.cod_restrict _ _ },
+    have : ae_measurable (G ∘ f) μ := ae_measurable.subtype_mk H.ae_measurable,
+    exact hG.measurable_embedding.ae_measurable_comp_iff.1 this },
+  { rcases (ae_strongly_measurable_iff_ae_measurable_separable.1 H).2 with ⟨t, ht, h't⟩,
+    exact ⟨g⁻¹' t, hg.is_separable_preimage ht, h't⟩ }
+end
+
+lemma _root_.measure_theory.measure_preserving.ae_strongly_measurable_comp_iff {β : Type*}
+  {f : α → β} {mα : measurable_space α} {μa : measure α}  {mβ : measurable_space β} {μb : measure β}
+  (hf : measure_preserving f μa μb) (h₂ : measurable_embedding f) {g : β → γ} :
+  ae_strongly_measurable (g ∘ f) μa ↔ ae_strongly_measurable g μb :=
+by rw [← hf.map_eq, h₂.ae_strongly_measurable_map_iff]
+
+/-- An almost everywhere sequential limit of almost everywhere strongly measurable functions is
+almost everywhere strongly measurable. -/
+lemma _root_.ae_strongly_measurable_of_tendsto_ae {ι : Type*}
+  [pseudo_metrizable_space β] (u : filter ι) [ne_bot u] [is_countably_generated u]
+  {f : ι → α → β} {g : α → β} (hf : ∀ i, ae_strongly_measurable (f i) μ)
+  (lim : ∀ᵐ x ∂μ, tendsto (λ n, f n x) u (𝓝 (g x))) :
+  ae_strongly_measurable g μ :=
+begin
+  borelize β,
+  refine ae_strongly_measurable_iff_ae_measurable_separable.2 ⟨_, _⟩,
+  { exact ae_measurable_of_tendsto_metrizable_ae _ (λ n, (hf n).ae_measurable) lim },
+  { rcases u.exists_seq_tendsto with ⟨v, hv⟩,
+    have : ∀ (n : ℕ), ∃ (t : set β), is_separable t ∧ f (v n) ⁻¹' t ∈ μ.ae :=
+      λ n, (ae_strongly_measurable_iff_ae_measurable_separable.1 (hf (v n))).2,
+    choose t t_sep ht using this,
+    refine ⟨closure (⋃ i, (t i)), (is_separable_Union (λ i, (t_sep i))).closure, _⟩,
+    filter_upwards [ae_all_iff.2 ht, lim] with x hx h'x,
+    apply mem_closure_of_tendsto ((h'x).comp hv),
+    apply eventually_of_forall (λ n, _),
+    apply mem_Union_of_mem n,
+    exact hx n }
+end
+
+/-- If a sequence of almost everywhere strongly measurable functions converges almost everywhere,
+one can select a strongly measurable function as the almost everywhere limit. -/
+lemma _root_.exists_strongly_measurable_limit_of_tendsto_ae [pseudo_metrizable_space β]
+  {f : ℕ → α → β} (hf : ∀ n, ae_strongly_measurable (f n) μ)
+  (h_ae_tendsto : ∀ᵐ x ∂μ, ∃ l : β, tendsto (λ n, f n x) at_top (𝓝 l)) :
+  ∃ (f_lim : α → β) (hf_lim_meas : strongly_measurable f_lim),
+    ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (f_lim x)) :=
+begin
+  borelize β,
+  obtain ⟨g, g_meas, hg⟩ : ∃ (g : α → β) (g_meas : measurable g),
+      ∀ᵐ x ∂μ, tendsto (λ n, f n x) at_top (𝓝 (g x)) :=
+    measurable_limit_of_tendsto_metrizable_ae (λ n, (hf n).ae_measurable) h_ae_tendsto,
+  have Hg : ae_strongly_measurable g μ := ae_strongly_measurable_of_tendsto_ae _ hf hg,
+  refine ⟨Hg.mk g, Hg.strongly_measurable_mk, _⟩,
+  filter_upwards [hg, Hg.ae_eq_mk] with x hx h'x,
+  rwa h'x at hx,
+end
+
+lemma sum_measure [pseudo_metrizable_space β]
+  {m : measurable_space α} {μ : ι → measure α} (h : ∀ i, ae_strongly_measurable f (μ i)) :
+  ae_strongly_measurable f (measure.sum μ) :=
+begin
+  borelize β,
+  refine ae_strongly_measurable_iff_ae_measurable_separable.2
+    ⟨ae_measurable.sum_measure (λ i, (h i).ae_measurable), _⟩,
+  have A : ∀ (i : ι), ∃ (t : set β), is_separable t ∧ f ⁻¹' t ∈ (μ i).ae :=
+    λ i, (ae_strongly_measurable_iff_ae_measurable_separable.1 (h i)).2,
+  choose t t_sep ht using A,
+  refine ⟨(⋃ i, t i), is_separable_Union t_sep, _⟩,
+  simp only [measure.ae_sum_eq, mem_Union, eventually_supr],
+  assume i,
+  filter_upwards [ht i] with x hx,
+  exact ⟨i, hx⟩
+end
+
+@[simp] lemma _root_.ae_strongly_measurable_sum_measure_iff
+  [pseudo_metrizable_space β] {m : measurable_space α} {μ : ι → measure α} :
+  ae_strongly_measurable f (sum μ) ↔ ∀ i, ae_strongly_measurable f (μ i) :=
+⟨λ h i, h.mono_measure (measure.le_sum _ _), sum_measure⟩
+
+@[simp] lemma _root_.ae_strongly_measurable_add_measure_iff [pseudo_metrizable_space β]
+  {ν : measure α} :
+  ae_strongly_measurable f (μ + ν) ↔ ae_strongly_measurable f μ ∧ ae_strongly_measurable f ν :=
+by { rw [← sum_cond, ae_strongly_measurable_sum_measure_iff, bool.forall_bool, and.comm], refl }
+
+lemma add_measure [pseudo_metrizable_space β] {ν : measure α} {f : α → β}
+  (hμ : ae_strongly_measurable f μ) (hν : ae_strongly_measurable f ν) :
+  ae_strongly_measurable f (μ + ν) :=
+ae_strongly_measurable_add_measure_iff.2 ⟨hμ, hν⟩
+
+protected lemma Union [pseudo_metrizable_space β] {s : ι → set α}
+  (h : ∀ i, ae_strongly_measurable f (μ.restrict (s i))) :
+  ae_strongly_measurable f (μ.restrict (⋃ i, s i)) :=
+(sum_measure h).mono_measure $ restrict_Union_le
+
+@[simp] lemma _root_.ae_strongly_measurable_Union_iff [pseudo_metrizable_space β] {s : ι → set α} :
+  ae_strongly_measurable f (μ.restrict (⋃ i, s i)) ↔
+    ∀ i, ae_strongly_measurable f (μ.restrict (s i)) :=
+⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_strongly_measurable.Union⟩
+
+@[simp] lemma _root_.ae_strongly_measurable_union_iff [pseudo_metrizable_space β] {s t : set α} :
+  ae_strongly_measurable f (μ.restrict (s ∪ t)) ↔
+    ae_strongly_measurable f (μ.restrict s) ∧ ae_strongly_measurable f (μ.restrict t) :=
+by simp only [union_eq_Union, ae_strongly_measurable_Union_iff, bool.forall_bool, cond, and.comm]
+
+lemma ae_strongly_measurable_uIoc_iff [linear_order α] [pseudo_metrizable_space β]
+  {f : α → β} {a b : α} :
+  ae_strongly_measurable f (μ.restrict $ uIoc a b) ↔
+  ae_strongly_measurable f (μ.restrict $ Ioc a b) ∧
+  ae_strongly_measurable f (μ.restrict $ Ioc b a) :=
+by rw [uIoc_eq_union, ae_strongly_measurable_union_iff]
+
+lemma smul_measure {R : Type*} [monoid R] [distrib_mul_action R ℝ≥0∞]
+  [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] (h : ae_strongly_measurable f μ) (c : R) :
+  ae_strongly_measurable f (c • μ) :=
+⟨h.mk f, h.strongly_measurable_mk, ae_smul_measure h.ae_eq_mk c⟩
+
+section normed_space
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜] [complete_space 𝕜]
+variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+
+lemma _root_.ae_strongly_measurable_smul_const_iff {f : α → 𝕜} {c : E} (hc : c ≠ 0) :
+  ae_strongly_measurable (λ x, f x • c) μ ↔ ae_strongly_measurable f μ :=
+(closed_embedding_smul_left hc).to_embedding.ae_strongly_measurable_comp_iff
+
+end normed_space
+
+section mul_action
+
+variables {M G G₀ : Type*}
+variables [monoid M] [mul_action M β] [has_continuous_const_smul M β]
+variables [group G] [mul_action G β] [has_continuous_const_smul G β]
+variables [group_with_zero G₀] [mul_action G₀ β] [has_continuous_const_smul G₀ β]
+
+lemma _root_.ae_strongly_measurable_const_smul_iff (c : G) :
+  ae_strongly_measurable (λ x, c • f x) μ ↔ ae_strongly_measurable f μ :=
+⟨λ h, by simpa only [inv_smul_smul] using h.const_smul' c⁻¹, λ h, h.const_smul c⟩
+
+lemma _root_.is_unit.ae_strongly_measurable_const_smul_iff {c : M} (hc : is_unit c) :
+  ae_strongly_measurable (λ x, c • f x) μ ↔ ae_strongly_measurable f μ :=
+let ⟨u, hu⟩ := hc in hu ▸ ae_strongly_measurable_const_smul_iff u
+
+lemma _root_.ae_strongly_measurable_const_smul_iff₀ {c : G₀} (hc : c ≠ 0) :
+  ae_strongly_measurable (λ x, c • f x) μ ↔ ae_strongly_measurable f μ :=
+(is_unit.mk0 _ hc).ae_strongly_measurable_const_smul_iff
+
+end mul_action
+
+section continuous_linear_map_nontrivially_normed_field
+
+variables {𝕜 : Type*} [nontrivially_normed_field 𝕜]
+variables {E : Type*} [normed_add_comm_group E] [normed_space 𝕜 E]
+variables {F : Type*} [normed_add_comm_group F] [normed_space 𝕜 F]
+variables {G : Type*} [normed_add_comm_group G] [normed_space 𝕜 G]
+
+lemma _root_.strongly_measurable.apply_continuous_linear_map
+  {m : measurable_space α} {φ : α → F →L[𝕜] E} (hφ : strongly_measurable φ) (v : F) :
+  strongly_measurable (λ a, φ a v) :=
+(continuous_linear_map.apply 𝕜 E v).continuous.comp_strongly_measurable hφ
+
+lemma apply_continuous_linear_map {φ : α → F →L[𝕜] E}
+  (hφ : ae_strongly_measurable φ μ) (v : F) :
+  ae_strongly_measurable (λ a, φ a v) μ :=
+(continuous_linear_map.apply 𝕜 E v).continuous.comp_ae_strongly_measurable hφ
+
+lemma _root_.continuous_linear_map.ae_strongly_measurable_comp₂ (L : E →L[𝕜] F →L[𝕜] G)
+  {f : α → E} {g : α → F}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (λ x, L (f x) (g x)) μ :=
+L.continuous₂.comp_ae_strongly_measurable $ hf.prod_mk hg
+
+end continuous_linear_map_nontrivially_normed_field
+
+lemma _root_.ae_strongly_measurable_with_density_iff {E : Type*} [normed_add_comm_group E]
+  [normed_space ℝ E] {f : α → ℝ≥0} (hf : measurable f) {g : α → E} :
+  ae_strongly_measurable g (μ.with_density (λ x, (f x : ℝ≥0∞))) ↔
+    ae_strongly_measurable (λ x, (f x : ℝ) • g x) μ :=
+begin
+  split,
+  { rintros ⟨g', g'meas, hg'⟩,
+    have A : measurable_set {x : α | f x ≠ 0} := (hf (measurable_set_singleton 0)).compl,
+    refine ⟨λ x, (f x : ℝ) • g' x, hf.coe_nnreal_real.strongly_measurable.smul g'meas, _⟩,
+    apply @ae_of_ae_restrict_of_ae_restrict_compl _ _ _ {x | f x ≠ 0},
+    { rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal] at hg',
+      rw ae_restrict_iff' A,
+      filter_upwards [hg'] with a ha h'a,
+      have : (f a : ℝ≥0∞) ≠ 0, by simpa only [ne.def, ennreal.coe_eq_zero] using h'a,
+      rw ha this },
+    { filter_upwards [ae_restrict_mem A.compl] with x hx,
+      simp only [not_not, mem_set_of_eq, mem_compl_iff] at hx,
+      simp [hx] } },
+  { rintros ⟨g', g'meas, hg'⟩,
+    refine ⟨λ x, (f x : ℝ)⁻¹ • g' x, hf.coe_nnreal_real.inv.strongly_measurable.smul g'meas, _⟩,
+    rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal],
+    filter_upwards [hg'] with x hx h'x,
+    rw [← hx, smul_smul, _root_.inv_mul_cancel, one_smul],
+    simp only [ne.def, ennreal.coe_eq_zero] at h'x,
+    simpa only [nnreal.coe_eq_zero, ne.def] using h'x }
+end
+
+end ae_strongly_measurable
+
+lemma ae_strongly_measurable_of_absolutely_continuous {α β : Type*} [measurable_space α]
+  [topological_space β] {μ ν : measure α} (h : ν ≪ μ) (g : α → β)
+  (hμ : ae_strongly_measurable g μ) : ae_strongly_measurable g ν :=
+begin
+  obtain ⟨g₁, hg₁, hg₁'⟩ := hμ,
+  refine ⟨g₁, hg₁, h.ae_eq hg₁'⟩,
+end
+
+/-! ## Almost everywhere finitely strongly measurable functions -/
+
+namespace ae_fin_strongly_measurable
+
+variables {m : measurable_space α} {μ : measure α} [topological_space β]
+  {f g : α → β}
+
+section mk
+variables [has_zero β]
+
+/-- A `fin_strongly_measurable` function such that `f =ᵐ[μ] hf.mk f`. See lemmas
+`fin_strongly_measurable_mk` and `ae_eq_mk`. -/
+protected noncomputable def mk (f : α → β) (hf : ae_fin_strongly_measurable f μ) : α → β := hf.some
+
+lemma fin_strongly_measurable_mk (hf : ae_fin_strongly_measurable f μ) :
+  fin_strongly_measurable (hf.mk f) μ :=
+hf.some_spec.1
+
+lemma ae_eq_mk (hf : ae_fin_strongly_measurable f μ) : f =ᵐ[μ] hf.mk f :=
+hf.some_spec.2
+
+protected lemma ae_measurable {β} [has_zero β] [measurable_space β] [topological_space β]
+  [pseudo_metrizable_space β] [borel_space β]
+  {f : α → β} (hf : ae_fin_strongly_measurable f μ) :
+  ae_measurable f μ :=
+⟨hf.mk f, hf.fin_strongly_measurable_mk.measurable, hf.ae_eq_mk⟩
+
+end mk
+
+section arithmetic
+
+protected lemma mul [monoid_with_zero β] [has_continuous_mul β]
+  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
+  ae_fin_strongly_measurable (f * g) μ :=
+⟨hf.mk f * hg.mk g, hf.fin_strongly_measurable_mk.mul hg.fin_strongly_measurable_mk,
+  hf.ae_eq_mk.mul hg.ae_eq_mk⟩
+
+protected lemma add [add_monoid β] [has_continuous_add β]
+  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
+  ae_fin_strongly_measurable (f + g) μ :=
+⟨hf.mk f + hg.mk g, hf.fin_strongly_measurable_mk.add hg.fin_strongly_measurable_mk,
+  hf.ae_eq_mk.add hg.ae_eq_mk⟩
+
+protected lemma neg [add_group β] [topological_add_group β] (hf : ae_fin_strongly_measurable f μ) :
+  ae_fin_strongly_measurable (-f) μ :=
+⟨-hf.mk f, hf.fin_strongly_measurable_mk.neg, hf.ae_eq_mk.neg⟩
+
+protected lemma sub [add_group β] [has_continuous_sub β]
+  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
+  ae_fin_strongly_measurable (f - g) μ :=
+⟨hf.mk f - hg.mk g, hf.fin_strongly_measurable_mk.sub hg.fin_strongly_measurable_mk,
+  hf.ae_eq_mk.sub hg.ae_eq_mk⟩
+
+protected lemma const_smul {𝕜} [topological_space 𝕜] [add_monoid β] [monoid 𝕜]
+  [distrib_mul_action 𝕜 β] [has_continuous_smul 𝕜 β]
+  (hf : ae_fin_strongly_measurable f μ) (c : 𝕜) :
+  ae_fin_strongly_measurable (c • f) μ :=
+⟨c • hf.mk f, hf.fin_strongly_measurable_mk.const_smul c, hf.ae_eq_mk.const_smul c⟩
+
+end arithmetic
+
+section order
+variables [has_zero β]
+
+protected lemma sup [semilattice_sup β] [has_continuous_sup β]
+  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
+  ae_fin_strongly_measurable (f ⊔ g) μ :=
+⟨hf.mk f ⊔ hg.mk g, hf.fin_strongly_measurable_mk.sup hg.fin_strongly_measurable_mk,
+  hf.ae_eq_mk.sup hg.ae_eq_mk⟩
+
+protected lemma inf [semilattice_inf β] [has_continuous_inf β]
+  (hf : ae_fin_strongly_measurable f μ) (hg : ae_fin_strongly_measurable g μ) :
+  ae_fin_strongly_measurable (f ⊓ g) μ :=
+⟨hf.mk f ⊓ hg.mk g, hf.fin_strongly_measurable_mk.inf hg.fin_strongly_measurable_mk,
+  hf.ae_eq_mk.inf hg.ae_eq_mk⟩
+
+end order
+
+variables [has_zero β] [t2_space β]
+
+lemma exists_set_sigma_finite (hf : ae_fin_strongly_measurable f μ) :
+  ∃ t, measurable_set t ∧ f =ᵐ[μ.restrict tᶜ] 0 ∧ sigma_finite (μ.restrict t) :=
+begin
+  rcases hf with ⟨g, hg, hfg⟩,
+  obtain ⟨t, ht, hgt_zero, htμ⟩ := hg.exists_set_sigma_finite,
+  refine ⟨t, ht, _, htμ⟩,
+  refine eventually_eq.trans (ae_restrict_of_ae hfg) _,
+  rw [eventually_eq, ae_restrict_iff' ht.compl],
+  exact eventually_of_forall hgt_zero,
+end
+
+/-- A measurable set `t` such that `f =ᵐ[μ.restrict tᶜ] 0` and `sigma_finite (μ.restrict t)`. -/
+def sigma_finite_set (hf : ae_fin_strongly_measurable f μ) : set α :=
+hf.exists_set_sigma_finite.some
+
+protected lemma measurable_set (hf : ae_fin_strongly_measurable f μ) :
+  measurable_set hf.sigma_finite_set :=
+hf.exists_set_sigma_finite.some_spec.1
+
+lemma ae_eq_zero_compl (hf : ae_fin_strongly_measurable f μ) :
+  f =ᵐ[μ.restrict hf.sigma_finite_setᶜ] 0 :=
+hf.exists_set_sigma_finite.some_spec.2.1
+
+instance sigma_finite_restrict (hf : ae_fin_strongly_measurable f μ) :
+  sigma_finite (μ.restrict hf.sigma_finite_set) :=
+hf.exists_set_sigma_finite.some_spec.2.2
+
+end ae_fin_strongly_measurable
+
+section second_countable_topology
+
+variables {G : Type*} {p : ℝ≥0∞} {m m0 : measurable_space α} {μ : measure α}
+  [seminormed_add_comm_group G] [measurable_space G] [borel_space G] [second_countable_topology G]
+  {f : α → G}
+
+/-- In a space with second countable topology and a sigma-finite measure, `fin_strongly_measurable`
+  and `measurable` are equivalent. -/
+lemma fin_strongly_measurable_iff_measurable {m0 : measurable_space α} (μ : measure α)
+  [sigma_finite μ] :
+  fin_strongly_measurable f μ ↔ measurable f :=
+⟨λ h, h.measurable, λ h, (measurable.strongly_measurable h).fin_strongly_measurable μ⟩
+
+/-- In a space with second countable topology and a sigma-finite measure,
+  `ae_fin_strongly_measurable` and `ae_measurable` are equivalent. -/
+lemma ae_fin_strongly_measurable_iff_ae_measurable {m0 : measurable_space α} (μ : measure α)
+  [sigma_finite μ] :
+  ae_fin_strongly_measurable f μ ↔ ae_measurable f μ :=
+by simp_rw [ae_fin_strongly_measurable, ae_measurable, fin_strongly_measurable_iff_measurable]
+
+end second_countable_topology
+
+lemma measurable_uncurry_of_continuous_of_measurable {α β ι : Type*} [topological_space ι]
+  [metrizable_space ι] [measurable_space ι] [second_countable_topology ι] [opens_measurable_space ι]
+  {mβ : measurable_space β} [topological_space β] [pseudo_metrizable_space β] [borel_space β]
+  {m : measurable_space α} {u : ι → α → β}
+  (hu_cont : ∀ x, continuous (λ i, u i x)) (h : ∀ i, measurable (u i)) :
+  measurable (function.uncurry u) :=
+begin
+  obtain ⟨t_sf, ht_sf⟩ : ∃ t : ℕ → simple_func ι ι, ∀ j x,
+    tendsto (λ n, u (t n j) x) at_top (𝓝 $ u j x),
+  { have h_str_meas : strongly_measurable (id : ι → ι), from strongly_measurable_id,
+    refine ⟨h_str_meas.approx, λ j x, _⟩,
+    exact ((hu_cont x).tendsto j).comp (h_str_meas.tendsto_approx j), },
+  let U := λ (n : ℕ) (p : ι × α), u (t_sf n p.fst) p.snd,
+  have h_tendsto : tendsto U at_top (𝓝 (λ p, u p.fst p.snd)),
+  { rw tendsto_pi_nhds,
+    exact λ p, ht_sf p.fst p.snd, },
+  refine measurable_of_tendsto_metrizable (λ n, _) h_tendsto,
+  have h_meas : measurable (λ (p : (t_sf n).range × α), u ↑p.fst p.snd),
+  { have : (λ (p : ↥((t_sf n).range) × α), u ↑(p.fst) p.snd)
+        = (λ (p : α × ((t_sf n).range)), u ↑(p.snd) p.fst) ∘ prod.swap := rfl,
+    rw [this, @measurable_swap_iff α ↥((t_sf n).range) β m],
+    exact measurable_from_prod_countable (λ j, h j), },
+  have : (λ p : ι × α, u (t_sf n p.fst) p.snd)
+    = (λ p : ↥(t_sf n).range × α, u p.fst p.snd)
+      ∘ (λ p : ι × α, (⟨t_sf n p.fst, simple_func.mem_range_self _ _⟩, p.snd)) := rfl,
+  simp_rw [U, this],
+  refine h_meas.comp (measurable.prod_mk _ measurable_snd),
+  exact ((t_sf n).measurable.comp measurable_fst).subtype_mk,
+end
+
+lemma strongly_measurable_uncurry_of_continuous_of_strongly_measurable {α β ι : Type*}
+  [topological_space ι] [metrizable_space ι] [measurable_space ι] [second_countable_topology ι]
+  [opens_measurable_space ι] [topological_space β] [pseudo_metrizable_space β]
+  [measurable_space α] {u : ι → α → β}
+  (hu_cont : ∀ x, continuous (λ i, u i x)) (h : ∀ i, strongly_measurable (u i)) :
+  strongly_measurable (function.uncurry u) :=
+begin
+  borelize β,
+  obtain ⟨t_sf, ht_sf⟩ : ∃ t : ℕ → simple_func ι ι, ∀ j x,
+    tendsto (λ n, u (t n j) x) at_top (𝓝 $ u j x),
+  { have h_str_meas : strongly_measurable (id : ι → ι), from strongly_measurable_id,
+    refine ⟨h_str_meas.approx, λ j x, _⟩,
+    exact ((hu_cont x).tendsto j).comp (h_str_meas.tendsto_approx j), },
+  let U := λ (n : ℕ) (p : ι × α), u (t_sf n p.fst) p.snd,
+  have h_tendsto : tendsto U at_top (𝓝 (λ p, u p.fst p.snd)),
+  { rw tendsto_pi_nhds,
+    exact λ p, ht_sf p.fst p.snd, },
+  refine strongly_measurable_of_tendsto _ (λ n, _) h_tendsto,
+  have h_str_meas : strongly_measurable (λ (p : (t_sf n).range × α), u ↑p.fst p.snd),
+  { refine strongly_measurable_iff_measurable_separable.2 ⟨_, _⟩,
+    { have : (λ (p : ↥((t_sf n).range) × α), u ↑(p.fst) p.snd)
+          = (λ (p : α × ((t_sf n).range)), u ↑(p.snd) p.fst) ∘ prod.swap := rfl,
+      rw [this, measurable_swap_iff],
+      exact measurable_from_prod_countable (λ j, (h j).measurable), },
+    { have : is_separable (⋃ (i : (t_sf n).range), range (u i)) :=
+        is_separable_Union (λ i, (h i).is_separable_range),
+      apply this.mono,
+      rintros _ ⟨⟨i, x⟩, rfl⟩,
+      simp only [mem_Union, mem_range],
+      exact ⟨i, x, rfl⟩ } },
+  have : (λ p : ι × α, u (t_sf n p.fst) p.snd)
+    = (λ p : ↥(t_sf n).range × α, u p.fst p.snd)
+      ∘ (λ p : ι × α, (⟨t_sf n p.fst, simple_func.mem_range_self _ _⟩, p.snd)) := rfl,
+  simp_rw [U, this],
+  refine h_str_meas.comp_measurable (measurable.prod_mk _ measurable_snd),
+  exact ((t_sf n).measurable.comp measurable_fst).subtype_mk,
+end
+
+end measure_theory
+
+-- Guard against import creep
+assert_not_exists inner_product_space
diff --git a/src/measure_theory/function/strongly_measurable/inner.lean b/src/measure_theory/function/strongly_measurable/inner.lean
new file mode 100644
index 0000000000000..2d147cf26fd68
--- /dev/null
+++ b/src/measure_theory/function/strongly_measurable/inner.lean
@@ -0,0 +1,53 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne, Sébastien Gouëzel
+-/
+import measure_theory.function.strongly_measurable.basic
+import analysis.inner_product_space.basic
+
+/-!
+# Inner products of strongly measurable functions are strongly measurable.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+variables {α : Type*}
+namespace measure_theory
+
+/-! ## Strongly measurable functions -/
+
+namespace strongly_measurable
+
+protected lemma inner {𝕜 : Type*} {E : Type*}
+  [is_R_or_C 𝕜] [normed_add_comm_group E] [inner_product_space 𝕜 E]
+  {m : measurable_space α} {f g : α → E} (hf : strongly_measurable f) (hg : strongly_measurable g) :
+  strongly_measurable (λ t, @inner 𝕜 _ _(f t) (g t)) :=
+continuous.comp_strongly_measurable continuous_inner (hf.prod_mk hg)
+
+end strongly_measurable
+
+namespace ae_strongly_measurable
+
+variables {m : measurable_space α} {μ : measure α} {𝕜 : Type*} {E : Type*} [is_R_or_C 𝕜]
+  [normed_add_comm_group E] [inner_product_space 𝕜 E]
+local notation `⟪`x`, `y`⟫` := @inner 𝕜 _ _ x y
+
+protected lemma re {f : α → 𝕜} (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, is_R_or_C.re (f x)) μ :=
+is_R_or_C.continuous_re.comp_ae_strongly_measurable hf
+
+protected lemma im {f : α → 𝕜} (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x, is_R_or_C.im (f x)) μ :=
+is_R_or_C.continuous_im.comp_ae_strongly_measurable hf
+
+protected lemma inner {m : measurable_space α} {μ : measure α} {f g : α → E}
+  (hf : ae_strongly_measurable f μ) (hg : ae_strongly_measurable g μ) :
+  ae_strongly_measurable (λ x, ⟪f x, g x⟫) μ :=
+continuous_inner.comp_ae_strongly_measurable (hf.prod_mk hg)
+
+end ae_strongly_measurable
+
+end measure_theory
diff --git a/src/measure_theory/function/strongly_measurable/lp.lean b/src/measure_theory/function/strongly_measurable/lp.lean
new file mode 100644
index 0000000000000..fbcd743140127
--- /dev/null
+++ b/src/measure_theory/function/strongly_measurable/lp.lean
@@ -0,0 +1,76 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import measure_theory.function.simple_func_dense_lp
+import measure_theory.function.strongly_measurable.basic
+
+/-!
+# Finitely strongly measurable functions in `Lp`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Functions in `Lp` for `0 < p < ∞` are finitely strongly measurable.
+
+## Main statements
+
+* `mem_ℒp.ae_fin_strongly_measurable`: if `mem_ℒp f p μ` with `0 < p < ∞`, then
+  `ae_fin_strongly_measurable f μ`.
+* `Lp.fin_strongly_measurable`: for `0 < p < ∞`, `Lp` functions are finitely strongly measurable.
+
+## References
+
+* Hytönen, Tuomas, Jan Van Neerven, Mark Veraar, and Lutz Weis. Analysis in Banach spaces.
+Springer, 2016.
+-/
+
+open measure_theory filter topological_space function
+open_locale ennreal topology measure_theory
+
+namespace measure_theory
+
+local infixr ` →ₛ `:25 := simple_func
+
+variables {α G : Type*} {p : ℝ≥0∞} {m m0 : measurable_space α} {μ : measure α}
+  [normed_add_comm_group G]
+  {f : α → G}
+
+lemma mem_ℒp.fin_strongly_measurable_of_strongly_measurable
+  (hf : mem_ℒp f p μ) (hf_meas : strongly_measurable f) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
+  fin_strongly_measurable f μ :=
+begin
+  borelize G,
+  haveI : separable_space (set.range f ∪ {0} : set G) :=
+    hf_meas.separable_space_range_union_singleton,
+  let fs := simple_func.approx_on f hf_meas.measurable (set.range f ∪ {0}) 0 (by simp),
+  refine ⟨fs, _, _⟩,
+  { have h_fs_Lp : ∀ n, mem_ℒp (fs n) p μ,
+      from simple_func.mem_ℒp_approx_on_range hf_meas.measurable hf,
+    exact λ n, (fs n).measure_support_lt_top_of_mem_ℒp (h_fs_Lp n) hp_ne_zero hp_ne_top },
+  { assume x,
+    apply simple_func.tendsto_approx_on,
+    apply subset_closure,
+    simp },
+end
+
+lemma mem_ℒp.ae_fin_strongly_measurable (hf : mem_ℒp f p μ) (hp_ne_zero : p ≠ 0)
+  (hp_ne_top : p ≠ ∞) :
+  ae_fin_strongly_measurable f μ :=
+⟨hf.ae_strongly_measurable.mk f, ((mem_ℒp_congr_ae hf.ae_strongly_measurable.ae_eq_mk).mp hf)
+  .fin_strongly_measurable_of_strongly_measurable
+    hf.ae_strongly_measurable.strongly_measurable_mk hp_ne_zero hp_ne_top,
+  hf.ae_strongly_measurable.ae_eq_mk⟩
+
+lemma integrable.ae_fin_strongly_measurable (hf : integrable f μ) :
+  ae_fin_strongly_measurable f μ :=
+(mem_ℒp_one_iff_integrable.mpr hf).ae_fin_strongly_measurable one_ne_zero ennreal.coe_ne_top
+
+lemma Lp.fin_strongly_measurable (f : Lp G p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
+  fin_strongly_measurable f μ :=
+(Lp.mem_ℒp f).fin_strongly_measurable_of_strongly_measurable
+  (Lp.strongly_measurable f) hp_ne_zero hp_ne_top
+
+end measure_theory
diff --git a/src/measure_theory/function/strongly_measurable_lp.lean b/src/measure_theory/function/strongly_measurable_lp.lean
deleted file mode 100644
index 571c39a8569c0..0000000000000
--- a/src/measure_theory/function/strongly_measurable_lp.lean
+++ /dev/null
@@ -1,73 +0,0 @@
-/-
-Copyright (c) 2022 Rémy Degenne. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Rémy Degenne
--/
-
-import measure_theory.function.simple_func_dense_lp
-import measure_theory.function.strongly_measurable
-
-/-!
-# Finitely strongly measurable functions in `Lp`
-
-Functions in `Lp` for `0 < p < ∞` are finitely strongly measurable.
-
-## Main statements
-
-* `mem_ℒp.ae_fin_strongly_measurable`: if `mem_ℒp f p μ` with `0 < p < ∞`, then
-  `ae_fin_strongly_measurable f μ`.
-* `Lp.fin_strongly_measurable`: for `0 < p < ∞`, `Lp` functions are finitely strongly measurable.
-
-## References
-
-* Hytönen, Tuomas, Jan Van Neerven, Mark Veraar, and Lutz Weis. Analysis in Banach spaces.
-Springer, 2016.
--/
-
-open measure_theory filter topological_space function
-open_locale ennreal topological_space measure_theory
-
-namespace measure_theory
-
-local infixr ` →ₛ `:25 := simple_func
-
-variables {α G : Type*} {p : ℝ≥0∞} {m m0 : measurable_space α} {μ : measure α}
-  [normed_group G]
-  {f : α → G}
-
-lemma mem_ℒp.fin_strongly_measurable_of_strongly_measurable
-  (hf : mem_ℒp f p μ) (hf_meas : strongly_measurable f) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  fin_strongly_measurable f μ :=
-begin
-  borelize G,
-  haveI : separable_space (set.range f ∪ {0} : set G) :=
-    hf_meas.separable_space_range_union_singleton,
-  let fs := simple_func.approx_on f hf_meas.measurable (set.range f ∪ {0}) 0 (by simp),
-  refine ⟨fs, _, _⟩,
-  { have h_fs_Lp : ∀ n, mem_ℒp (fs n) p μ,
-      from simple_func.mem_ℒp_approx_on_range hf_meas.measurable hf,
-    exact λ n, (fs n).measure_support_lt_top_of_mem_ℒp (h_fs_Lp n) hp_ne_zero hp_ne_top },
-  { assume x,
-    apply simple_func.tendsto_approx_on,
-    apply subset_closure,
-    simp },
-end
-
-lemma mem_ℒp.ae_fin_strongly_measurable (hf : mem_ℒp f p μ) (hp_ne_zero : p ≠ 0)
-  (hp_ne_top : p ≠ ∞) :
-  ae_fin_strongly_measurable f μ :=
-⟨hf.ae_strongly_measurable.mk f, ((mem_ℒp_congr_ae hf.ae_strongly_measurable.ae_eq_mk).mp hf)
-  .fin_strongly_measurable_of_strongly_measurable
-    hf.ae_strongly_measurable.strongly_measurable_mk hp_ne_zero hp_ne_top,
-  hf.ae_strongly_measurable.ae_eq_mk⟩
-
-lemma integrable.ae_fin_strongly_measurable (hf : integrable f μ) :
-  ae_fin_strongly_measurable f μ :=
-(mem_ℒp_one_iff_integrable.mpr hf).ae_fin_strongly_measurable one_ne_zero ennreal.coe_ne_top
-
-lemma Lp.fin_strongly_measurable (f : Lp G p μ) (hp_ne_zero : p ≠ 0) (hp_ne_top : p ≠ ∞) :
-  fin_strongly_measurable f μ :=
-(Lp.mem_ℒp f).fin_strongly_measurable_of_strongly_measurable
-  (Lp.strongly_measurable f) hp_ne_zero hp_ne_top
-
-end measure_theory
diff --git a/src/measure_theory/function/uniform_integrable.lean b/src/measure_theory/function/uniform_integrable.lean
index 0821464f1df43..27cf1d4f84a64 100644
--- a/src/measure_theory/function/uniform_integrable.lean
+++ b/src/measure_theory/function/uniform_integrable.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kexing Ying
 -/
 import measure_theory.function.convergence_in_measure
+import measure_theory.function.l1_space
 
 /-!
 # Uniform integrability
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the definitions for uniform integrability (both in the measure theory sense
 as well as the probability theory sense). This file also contains the Vitali convergence theorem
 which estabishes a relation between uniform integrability, convergence in measure and
@@ -42,13 +46,13 @@ uniform integrable, uniformly absolutely continuous integral, Vitali convergence
 -/
 
 noncomputable theory
-open_locale classical measure_theory nnreal ennreal topological_space
+open_locale classical measure_theory nnreal ennreal topology big_operators
 
 namespace measure_theory
 
 open set filter topological_space
 
-variables {α β ι : Type*} {m : measurable_space α} {μ : measure α} [normed_group β]
+variables {α β ι : Type*} {m : measurable_space α} {μ : measure α} [normed_add_comm_group β]
 
 /-- Uniform integrability in the measure theory sense.
 
@@ -65,21 +69,24 @@ snorm (s.indicator (f i)) p μ ≤ ennreal.of_real ε
 uniformly integrable in the measure theory sense and is uniformly bounded. -/
 def uniform_integrable {m : measurable_space α}
   (f : ι → α → β) (p : ℝ≥0∞) (μ : measure α) : Prop :=
-(∀ i, strongly_measurable (f i)) ∧ unif_integrable f p μ ∧ ∃ C : ℝ≥0, ∀ i, snorm (f i) p μ ≤ C
+(∀ i, ae_strongly_measurable (f i) μ) ∧ unif_integrable f p μ ∧ ∃ C : ℝ≥0, ∀ i, snorm (f i) p μ ≤ C
+
+namespace uniform_integrable
 
-lemma uniform_integrable.strongly_measurable {f : ι → α → β} {p : ℝ≥0∞}
-  (hf : uniform_integrable f p μ) (i : ι) : strongly_measurable (f i) :=
+protected lemma ae_strongly_measurable {f : ι → α → β} {p : ℝ≥0∞}
+  (hf : uniform_integrable f p μ) (i : ι) : ae_strongly_measurable (f i) μ :=
 hf.1 i
 
-lemma uniform_integrable.unif_integrable {f : ι → α → β} {p : ℝ≥0∞}
+protected lemma unif_integrable {f : ι → α → β} {p : ℝ≥0∞}
   (hf : uniform_integrable f p μ) : unif_integrable f p μ :=
 hf.2.1
 
-lemma uniform_integrable.mem_ℒp {f : ι → α → β} {p : ℝ≥0∞}
+protected lemma mem_ℒp {f : ι → α → β} {p : ℝ≥0∞}
   (hf : uniform_integrable f p μ) (i : ι) :
   mem_ℒp (f i) p μ :=
-⟨(hf.1 i).ae_strongly_measurable,
-let ⟨_, _, hC⟩ := hf.2 in lt_of_le_of_lt (hC i) ennreal.coe_lt_top⟩
+⟨hf.1 i, let ⟨_, _, hC⟩ := hf.2 in lt_of_le_of_lt (hC i) ennreal.coe_lt_top⟩
+
+end uniform_integrable
 
 section unif_integrable
 
@@ -140,9 +147,9 @@ lemma unif_integrable_congr_ae {p : ℝ≥0∞} {f g : ι → α → β} (hfg :
 ⟨λ hf, hf.ae_eq hfg, λ hg, hg.ae_eq (λ n, (hfg n).symm)⟩
 
 lemma tendsto_indicator_ge (f : α → β) (x : α):
-  tendsto (λ M : ℕ, {x | (M : ℝ) ≤ ∥f x∥₊}.indicator f x) at_top (𝓝 0) :=
+  tendsto (λ M : ℕ, {x | (M : ℝ) ≤ ‖f x‖₊}.indicator f x) at_top (𝓝 0) :=
 begin
-  refine @tendsto_at_top_of_eventually_const _ _ _ _ _ _ _ (nat.ceil (∥f x∥₊ : ℝ) + 1) (λ n hn, _),
+  refine @tendsto_at_top_of_eventually_const _ _ _ _ _ _ _ (nat.ceil (‖f x‖₊ : ℝ) + 1) (λ n hn, _),
   rw indicator_of_not_mem,
   simp only [not_le, mem_set_of_eq],
   refine lt_of_le_of_lt (nat.le_ceil _) _,
@@ -161,16 +168,16 @@ variables {f : α → β}
 as the latter provides `0 ≤ M` and does not require the measurability of `f`. -/
 lemma mem_ℒp.integral_indicator_norm_ge_le
   (hf : mem_ℒp f 1 μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
-  ∃ M : ℝ, ∫⁻ x, ∥{x | M ≤ ∥f x∥₊}.indicator f x∥₊ ∂μ ≤ ennreal.of_real ε :=
+  ∃ M : ℝ, ∫⁻ x, ‖{x | M ≤ ‖f x‖₊}.indicator f x‖₊ ∂μ ≤ ennreal.of_real ε :=
 begin
-  have htendsto : ∀ᵐ x ∂μ, tendsto (λ M : ℕ, {x | (M : ℝ) ≤ ∥f x∥₊}.indicator f x) at_top (𝓝 0) :=
+  have htendsto : ∀ᵐ x ∂μ, tendsto (λ M : ℕ, {x | (M : ℝ) ≤ ‖f x‖₊}.indicator f x) at_top (𝓝 0) :=
     univ_mem' (id $ λ x, tendsto_indicator_ge f x),
-  have hmeas : ∀ M : ℕ, ae_strongly_measurable ({x | (M : ℝ) ≤ ∥f x∥₊}.indicator f) μ,
+  have hmeas : ∀ M : ℕ, ae_strongly_measurable ({x | (M : ℝ) ≤ ‖f x‖₊}.indicator f) μ,
   { assume M,
     apply hf.1.indicator,
     apply strongly_measurable.measurable_set_le strongly_measurable_const
       hmeas.nnnorm.measurable.coe_nnreal_real.strongly_measurable },
-  have hbound : has_finite_integral (λ x, ∥f x∥) μ,
+  have hbound : has_finite_integral (λ x, ‖f x‖) μ,
   { rw mem_ℒp_one_iff_integrable at hf,
     exact hf.norm.2 },
   have := tendsto_lintegral_norm_of_dominated_convergence hmeas hbound _ htendsto,
@@ -184,7 +191,7 @@ begin
     simp only [coe_nnnorm, ennreal.of_real_eq_coe_nnreal (norm_nonneg _)],
     refl },
   { refine λ n, univ_mem' (id $ λ x, _),
-    by_cases hx : (n : ℝ) ≤ ∥f x∥,
+    by_cases hx : (n : ℝ) ≤ ‖f x‖,
     { dsimp,
       rwa indicator_of_mem },
     { dsimp,
@@ -197,12 +204,12 @@ end
 which does not require measurability. -/
 lemma mem_ℒp.integral_indicator_norm_ge_nonneg_le_of_meas
   (hf : mem_ℒp f 1 μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
-  ∃ M : ℝ, 0 ≤ M ∧ ∫⁻ x, ∥{x | M ≤ ∥f x∥₊}.indicator f x∥₊ ∂μ ≤ ennreal.of_real ε :=
+  ∃ M : ℝ, 0 ≤ M ∧ ∫⁻ x, ‖{x | M ≤ ‖f x‖₊}.indicator f x‖₊ ∂μ ≤ ennreal.of_real ε :=
 let ⟨M, hM⟩ := hf.integral_indicator_norm_ge_le μ hmeas hε in ⟨max M 0, le_max_right _ _, by simpa⟩
 
 lemma mem_ℒp.integral_indicator_norm_ge_nonneg_le
   (hf : mem_ℒp f 1 μ) {ε : ℝ} (hε : 0 < ε) :
-  ∃ M : ℝ, 0 ≤ M ∧ ∫⁻ x, ∥{x | M ≤ ∥f x∥₊}.indicator f x∥₊ ∂μ ≤ ennreal.of_real ε :=
+  ∃ M : ℝ, 0 ≤ M ∧ ∫⁻ x, ‖{x | M ≤ ‖f x‖₊}.indicator f x‖₊ ∂μ ≤ ennreal.of_real ε :=
 begin
   have hf_mk : mem_ℒp (hf.1.mk f) 1 μ := (mem_ℒp_congr_ae hf.1.ae_eq_mk).mp hf,
   obtain ⟨M, hM_pos, hfM⟩ := hf_mk.integral_indicator_norm_ge_nonneg_le_of_meas μ
@@ -215,15 +222,15 @@ end
 
 lemma mem_ℒp.snorm_ess_sup_indicator_norm_ge_eq_zero
   (hf : mem_ℒp f ∞ μ) (hmeas : strongly_measurable f) :
-  ∃ M : ℝ, snorm_ess_sup ({x | M ≤ ∥f x∥₊}.indicator f) μ = 0 :=
+  ∃ M : ℝ, snorm_ess_sup ({x | M ≤ ‖f x‖₊}.indicator f) μ = 0 :=
 begin
   have hbdd : snorm_ess_sup f μ < ∞ := hf.snorm_lt_top,
   refine ⟨(snorm f ∞ μ + 1).to_real, _⟩,
   rw snorm_ess_sup_indicator_eq_snorm_ess_sup_restrict,
-  have : μ.restrict {x : α | (snorm f ⊤ μ + 1).to_real ≤ ∥f x∥₊} = 0,
+  have : μ.restrict {x : α | (snorm f ⊤ μ + 1).to_real ≤ ‖f x‖₊} = 0,
   { simp only [coe_nnnorm, snorm_exponent_top, measure.restrict_eq_zero],
-    have : {x : α | (snorm_ess_sup f μ + 1).to_real ≤ ∥f x∥} ⊆
-      {x : α | snorm_ess_sup f μ < ∥f x∥₊},
+    have : {x : α | (snorm_ess_sup f μ + 1).to_real ≤ ‖f x‖} ⊆
+      {x : α | snorm_ess_sup f μ < ‖f x‖₊},
     { intros x hx,
       rw [mem_set_of_eq, ← ennreal.to_real_lt_to_real hbdd.ne ennreal.coe_lt_top.ne,
           ennreal.coe_to_real, coe_nnnorm],
@@ -244,7 +251,7 @@ end
 latter provides `0 < M`. -/
 lemma mem_ℒp.snorm_indicator_norm_ge_le
   (hf : mem_ℒp f p μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
-  ∃ M : ℝ, snorm ({x | M ≤ ∥f x∥₊}.indicator f) p μ ≤ ennreal.of_real ε :=
+  ∃ M : ℝ, snorm ({x | M ≤ ‖f x‖₊}.indicator f) p μ ≤ ennreal.of_real ε :=
 begin
   by_cases hp_ne_zero : p = 0,
   { refine ⟨1, hp_ne_zero.symm ▸ _⟩,
@@ -255,7 +262,7 @@ begin
     refine ⟨M, _⟩,
     simp only [snorm_exponent_top, hM, zero_le] },
   obtain ⟨M, hM', hM⟩ := @mem_ℒp.integral_indicator_norm_ge_nonneg_le _ _ _ μ _
-    (λ x, ∥f x∥^p.to_real) (hf.norm_rpow hp_ne_zero hp_ne_top) _
+    (λ x, ‖f x‖^p.to_real) (hf.norm_rpow hp_ne_zero hp_ne_top) _
     (real.rpow_pos_of_pos hε p.to_real),
   refine ⟨M ^(1 / p.to_real), _⟩,
   rw [snorm_eq_lintegral_rpow_nnnorm hp_ne_zero hp_ne_top,
@@ -268,13 +275,13 @@ begin
   ext1 x,
   rw [ennreal.coe_rpow_of_nonneg _ ennreal.to_real_nonneg,
       nnnorm_indicator_eq_indicator_nnnorm, nnnorm_indicator_eq_indicator_nnnorm],
-  have hiff : M ^ (1 / p.to_real) ≤ ∥f x∥₊ ↔ M ≤ ∥∥f x∥ ^ p.to_real∥₊,
+  have hiff : M ^ (1 / p.to_real) ≤ ‖f x‖₊ ↔ M ≤ ‖‖f x‖ ^ p.to_real‖₊,
   { rw [coe_nnnorm, coe_nnnorm, real.norm_rpow_of_nonneg (norm_nonneg _), norm_norm,
         ← real.rpow_le_rpow_iff hM' (real.rpow_nonneg_of_nonneg (norm_nonneg _) _)
         (one_div_pos.2 $ ennreal.to_real_pos hp_ne_zero hp_ne_top),
         ← real.rpow_mul (norm_nonneg _),
         mul_one_div_cancel (ennreal.to_real_pos hp_ne_zero hp_ne_top).ne.symm, real.rpow_one] },
-  by_cases hx : x ∈ {x : α | M ^ (1 / p.to_real) ≤ ∥f x∥₊},
+  by_cases hx : x ∈ {x : α | M ^ (1 / p.to_real) ≤ ‖f x‖₊},
   { rw [set.indicator_of_mem hx,set.indicator_of_mem, real.nnnorm_of_nonneg], refl,
     change _ ≤ _,
     rwa ← hiff },
@@ -287,7 +294,7 @@ end
 /-- This lemma implies that a single function is uniformly integrable (in the probability sense). -/
 lemma mem_ℒp.snorm_indicator_norm_ge_pos_le
   (hf : mem_ℒp f p μ) (hmeas : strongly_measurable f) {ε : ℝ} (hε : 0 < ε) :
-  ∃ M : ℝ, 0 < M ∧ snorm ({x | M ≤ ∥f x∥₊}.indicator f) p μ ≤ ennreal.of_real ε :=
+  ∃ M : ℝ, 0 < M ∧ snorm ({x | M ≤ ‖f x‖₊}.indicator f) p μ ≤ ennreal.of_real ε :=
 begin
   obtain ⟨M, hM⟩ := hf.snorm_indicator_norm_ge_le μ hmeas hε,
   refine ⟨max M 1, lt_of_lt_of_le zero_lt_one (le_max_right _ _),
@@ -301,7 +308,7 @@ end
 end
 
 lemma snorm_indicator_le_of_bound {f : α → β} (hp_top : p ≠ ∞)
-  {ε : ℝ} (hε : 0 < ε) {M : ℝ} (hf : ∀ x, ∥f x∥ < M) :
+  {ε : ℝ} (hε : 0 < ε) {M : ℝ} (hf : ∀ x, ‖f x‖ < M) :
   ∃ (δ : ℝ) (hδ : 0 < δ), ∀ s, measurable_set s → μ s ≤ ennreal.of_real δ →
   snorm (s.indicator f) p μ ≤ ennreal.of_real ε :=
 begin
@@ -317,7 +324,7 @@ begin
   by_cases hp : p = 0,
   { simp [hp] },
   rw snorm_indicator_eq_snorm_restrict hs,
-  have haebdd : ∀ᵐ x ∂μ.restrict s, ∥f x∥ ≤ M,
+  have haebdd : ∀ᵐ x ∂μ.restrict s, ‖f x‖ ≤ M,
   { filter_upwards,
     exact (λ x, (hf x).le) },
   refine le_trans (snorm_le_of_ae_bound haebdd) _,
@@ -343,9 +350,9 @@ lemma mem_ℒp.snorm_indicator_le' (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
 begin
   obtain ⟨M, hMpos, hM⟩ := hf.snorm_indicator_norm_ge_pos_le μ hmeas hε,
   obtain ⟨δ, hδpos, hδ⟩ := @snorm_indicator_le_of_bound _ _ _ μ _ _
-    ({x | ∥f x∥ < M}.indicator f) hp_top _ hε M _,
+    ({x | ‖f x‖ < M}.indicator f) hp_top _ hε M _,
   { refine ⟨δ, hδpos, λ s hs hμs, _⟩,
-    rw (_ : f = {x : α | M ≤ ∥f x∥₊}.indicator f + {x : α | ∥f x∥ < M}.indicator f),
+    rw (_ : f = {x : α | M ≤ ‖f x‖₊}.indicator f + {x : α | ‖f x‖ < M}.indicator f),
     { rw snorm_indicator_eq_snorm_restrict hs,
       refine le_trans (snorm_add_le _ _ hp_one) _,
       { exact strongly_measurable.ae_strongly_measurable (hmeas.indicator
@@ -357,7 +364,7 @@ begin
         rw ← snorm_indicator_eq_snorm_restrict hs,
         exact hδ s hs hμs } },
     { ext x,
-      by_cases hx : M ≤ ∥f x∥,
+      by_cases hx : M ≤ ‖f x‖,
       { rw [pi.add_apply, indicator_of_mem, indicator_of_not_mem, add_zero];
         simpa },
       { rw [pi.add_apply, indicator_of_not_mem, indicator_of_mem, zero_add];
@@ -420,7 +427,7 @@ begin
 end
 
 /-- This lemma is less general than `measure_theory.unif_integrable_fintype` which applies to
-all sequences indexed by a fintype. -/
+all sequences indexed by a finite type. -/
 lemma unif_integrable_fin (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
   {n : ℕ} {f : fin n → α → β} (hf : ∀ i, mem_ℒp (f i) p μ) :
   unif_integrable f p μ :=
@@ -447,16 +454,19 @@ begin
 end
 
 /-- A finite sequence of Lp functions is uniformly integrable. -/
-lemma unif_integrable_fintype [fintype ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
+lemma unif_integrable_finite [finite ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
   {f : ι → α → β} (hf : ∀ i, mem_ℒp (f i) p μ) :
   unif_integrable f p μ :=
 begin
+  obtain ⟨n, hn⟩ := finite.exists_equiv_fin ι,
   intros ε hε,
-  set g : fin (fintype.card ι) → α → β := f ∘ (fintype.equiv_fin ι).symm,
+  set g : fin n → α → β := f ∘ hn.some.symm with hgeq,
   have hg : ∀ i, mem_ℒp (g i) p μ := λ _, hf _,
   obtain ⟨δ, hδpos, hδ⟩ := unif_integrable_fin μ hp_one hp_top hg hε,
-  exact ⟨δ, hδpos, λ i s hs hμs,
-    equiv.symm_apply_apply (fintype.equiv_fin ι) i ▸ hδ (fintype.equiv_fin ι i) s hs hμs⟩,
+  refine ⟨δ, hδpos, λ i s hs hμs, _⟩,
+  specialize hδ (hn.some i) s hs hμs,
+  simp_rw [hgeq, function.comp_app, equiv.symm_apply_apply] at hδ,
+  assumption,
 end
 
 end
@@ -468,7 +478,7 @@ lemma snorm_sub_le_of_dist_bdd
 begin
   by_cases hp : p = 0,
   { simp [hp], },
-  have : ∀ x, ∥s.indicator (f - g) x∥ ≤ ∥s.indicator (λ x, c) x∥,
+  have : ∀ x, ‖s.indicator (f - g) x‖ ≤ ‖s.indicator (λ x, c) x‖,
   { intro x,
     by_cases hx : x ∈ s,
     { rw [indicator_of_mem hx, indicator_of_mem hx, pi.sub_apply, ← dist_eq_norm,
@@ -477,7 +487,7 @@ begin
     { simp [indicator_of_not_mem hx] } },
   refine le_trans (snorm_mono this) _,
   rw snorm_indicator_const hs hp hp',
-  refine ennreal.mul_le_mul (le_of_eq _) le_rfl,
+  refine mul_le_mul_right' (le_of_eq _) _,
   rw [← of_real_norm_eq_coe_nnnorm, real.norm_eq_abs, abs_of_nonneg hc],
 end
 
@@ -501,7 +511,7 @@ begin
   have hdivp : 0 ≤ 1 / p.to_real,
   { refine one_div_nonneg.2 _,
     rw [← ennreal.zero_to_real, ennreal.to_real_le_to_real ennreal.zero_ne_top hp'],
-    exact le_trans ennreal.zero_lt_one.le hp },
+    exact le_trans (zero_le _) hp },
   have hpow : 0 < (measure_univ_nnreal μ) ^ (1 / p.to_real) :=
     real.rpow_pos_of_pos (measure_univ_nnreal_pos hμ) _,
   obtain ⟨δ₁, hδ₁, hsnorm₁⟩ := hui hε',
@@ -631,7 +641,7 @@ lemma tendsto_in_measure_iff_tendsto_Lp [is_finite_measure μ]
   tendsto (λ n, snorm (f n - g) p μ) at_top (𝓝 0) :=
 ⟨λ h, tendsto_Lp_of_tendsto_in_measure μ hp hp' (λ n, (hf n).1) hg h.2 h.1,
   λ h, ⟨tendsto_in_measure_of_tendsto_snorm
-    (lt_of_lt_of_le ennreal.zero_lt_one hp).ne.symm
+    (lt_of_lt_of_le zero_lt_one hp).ne.symm
     (λ n, (hf n).ae_strongly_measurable)
     hg.ae_strongly_measurable h, unif_integrable_of_tendsto_Lp μ hp hp' hf hg h⟩⟩
 
@@ -639,10 +649,10 @@ lemma tendsto_in_measure_iff_tendsto_Lp [is_finite_measure μ]
 lemma unif_integrable_of' (hp : 1 ≤ p) (hp' : p ≠ ∞) {f : ι → α → β}
   (hf : ∀ i, strongly_measurable (f i))
   (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0, 0 < C ∧
-    ∀ i, snorm ({x | C ≤ ∥f i x∥₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
+    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
   unif_integrable f p μ :=
 begin
-  have hpzero := (lt_of_lt_of_le ennreal.zero_lt_one hp).ne.symm,
+  have hpzero := (lt_of_lt_of_le zero_lt_one hp).ne.symm,
   by_cases hμ : μ set.univ = 0,
   { rw measure.measure_univ_eq_zero at hμ,
     exact hμ.symm ▸ unif_integrable_zero_meas },
@@ -654,31 +664,32 @@ begin
   { rw (snorm_eq_zero_iff ((hf i).indicator hs).ae_strongly_measurable hpzero).2
       (indicator_meas_zero hμs'),
     norm_num },
-  calc snorm (indicator s (f i)) p μ ≤ snorm (indicator (s ∩ {x | C ≤ ∥f i x∥₊}) (f i)) p μ +
-    snorm (indicator (s ∩ {x | ∥f i x∥₊ < C}) (f i)) p μ :
+  calc snorm (indicator s (f i)) p μ ≤ snorm (indicator (s ∩ {x | C ≤ ‖f i x‖₊}) (f i)) p μ +
+    snorm (indicator (s ∩ {x | ‖f i x‖₊ < C}) (f i)) p μ :
     begin
       refine le_trans (eq.le _) (snorm_add_le (strongly_measurable.ae_strongly_measurable
         ((hf i).indicator (hs.inter (strongly_measurable_const.measurable_set_le (hf i).nnnorm))))
         (strongly_measurable.ae_strongly_measurable ((hf i).indicator (hs.inter
         ((hf i).nnnorm.measurable_set_lt strongly_measurable_const)))) hp),
       congr,
-      change _ = λ x, (s ∩ {x : α | C ≤ ∥f i x∥₊}).indicator (f i) x +
-        (s ∩ {x : α | ∥f i x∥₊ < C}).indicator (f i) x,
+      change _ = λ x, (s ∩ {x : α | C ≤ ‖f i x‖₊}).indicator (f i) x +
+        (s ∩ {x : α | ‖f i x‖₊ < C}).indicator (f i) x,
       rw ← set.indicator_union_of_disjoint,
       { congr,
         rw [← inter_union_distrib_left, (by { ext, simp [le_or_lt] } :
-          {x : α | C ≤ ∥f i x∥₊} ∪ {x : α | ∥f i x∥₊ < C} = set.univ), inter_univ] },
+          {x : α | C ≤ ‖f i x‖₊} ∪ {x : α | ‖f i x‖₊ < C} = set.univ), inter_univ] },
       { refine (disjoint.inf_right' _ _).inf_left' _,
+        rw disjoint_iff_inf_le,
         rintro x ⟨hx₁ : _ ≤ _, hx₂ : _ < _⟩,
         exact false.elim (hx₂.ne (eq_of_le_of_not_lt hx₁ (not_lt.2 hx₂.le)).symm) }
     end
-    ... ≤ snorm (indicator ({x | C ≤ ∥f i x∥₊}) (f i)) p μ + C * μ s ^ (1 / ennreal.to_real p) :
+    ... ≤ snorm (indicator ({x | C ≤ ‖f i x‖₊}) (f i)) p μ + C * μ s ^ (1 / ennreal.to_real p) :
     begin
       refine add_le_add (snorm_mono $ λ x, norm_indicator_le_of_subset
         (inter_subset_right _ _) _ _) _,
       rw ← indicator_indicator,
       rw snorm_indicator_eq_snorm_restrict,
-      have : ∀ᵐ x ∂(μ.restrict s), ∥({x : α | ∥f i x∥₊ < C}).indicator (f i) x∥ ≤ C,
+      have : ∀ᵐ x ∂(μ.restrict s), ‖({x : α | ‖f i x‖₊ < C}).indicator (f i) x‖ ≤ C,
       { refine ae_of_all _ _,
         simp_rw norm_indicator_eq_indicator_norm,
         exact indicator_le' (λ x (hx : _ < _), hx.le) (λ _ _, nnreal.coe_nonneg _) },
@@ -697,7 +708,7 @@ begin
     begin
       refine add_le_add_left _ _,
       rw [← ennreal.of_real_coe_nnreal, ← ennreal.of_real_mul (nnreal.coe_nonneg _),
-        ← div_div_eq_div_mul, mul_div_cancel' _ (nnreal.coe_pos.2 hCpos).ne.symm],
+        ← div_div, mul_div_cancel' _ (nnreal.coe_pos.2 hCpos).ne.symm],
       exact le_rfl,
     end
     ... ≤ ennreal.of_real ε :
@@ -708,14 +719,25 @@ begin
 end
 
 lemma unif_integrable_of (hp : 1 ≤ p) (hp' : p ≠ ∞) {f : ι → α → β}
-  (hf : ∀ i, strongly_measurable (f i))
+  (hf : ∀ i, ae_strongly_measurable (f i) μ)
   (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
-    ∀ i, snorm ({x | C ≤ ∥f i x∥₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
+    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
   unif_integrable f p μ :=
 begin
-  refine unif_integrable_of' μ hp hp' hf (λ ε hε, _),
+  set g : ι → α → β := λ i, (hf i).some,
+  refine (unif_integrable_of' μ hp hp' (λ i, (Exists.some_spec $hf i).1) (λ ε hε, _)).ae_eq
+    (λ i, (Exists.some_spec $ hf i).2.symm),
   obtain ⟨C, hC⟩ := h ε hε,
-  refine ⟨max C 1, lt_max_of_lt_right one_pos, λ i, le_trans (snorm_mono (λ x, _)) (hC i)⟩,
+  have hCg : ∀ i, snorm ({x | C ≤ ‖g i x‖₊}.indicator (g i)) p μ ≤ ennreal.of_real ε,
+  { intro i,
+    refine le_trans (le_of_eq $ snorm_congr_ae _) (hC i),
+    filter_upwards [(Exists.some_spec $ hf i).2] with x hx,
+    by_cases hfx : x ∈ {x | C ≤ ‖f i x‖₊},
+    { rw [indicator_of_mem hfx, indicator_of_mem, hx],
+      rwa [mem_set_of, hx] at hfx },
+    { rw [indicator_of_not_mem hfx, indicator_of_not_mem],
+      rwa [mem_set_of, hx] at hfx } },
+  refine ⟨max C 1, lt_max_of_lt_right one_pos, λ i, le_trans (snorm_mono (λ x, _)) (hCg i)⟩,
   rw [norm_indicator_eq_indicator_norm, norm_indicator_eq_indicator_norm],
   exact indicator_le_indicator_of_subset
     (λ x hx, le_trans (le_max_left _ _) hx) (λ _, norm_nonneg _) _,
@@ -737,34 +759,35 @@ In this section, we will develope some API for `uniform_integrable` and prove th
 
 variables {p : ℝ≥0∞} {f : ι → α → β}
 
-lemma uniform_integrable_zero_meas [measurable_space α] (hf : ∀ i, strongly_measurable (f i)) :
+lemma uniform_integrable_zero_meas [measurable_space α] :
   uniform_integrable f p (0 : measure α) :=
-⟨hf, unif_integrable_zero_meas, 0, λ i, snorm_measure_zero.le⟩
+⟨λ n, ae_strongly_measurable_zero_measure _,
+  unif_integrable_zero_meas, 0, λ i, snorm_measure_zero.le⟩
 
 lemma uniform_integrable.ae_eq {g : ι → α → β}
-  (hf : uniform_integrable f p μ) (hg : ∀ i, strongly_measurable (g i)) (hfg : ∀ n, f n =ᵐ[μ] g n) :
+  (hf : uniform_integrable f p μ) (hfg : ∀ n, f n =ᵐ[μ] g n) :
   uniform_integrable g p μ :=
 begin
-  obtain ⟨-, hunif, C, hC⟩ := hf,
-  refine ⟨hg, (unif_integrable_congr_ae hfg).1 hunif, C, λ i, _⟩,
+  obtain ⟨hfm, hunif, C, hC⟩ := hf,
+  refine ⟨λ i, (hfm i).congr (hfg i), (unif_integrable_congr_ae hfg).1 hunif, C, λ i, _⟩,
   rw ← snorm_congr_ae (hfg i),
   exact hC i
 end
 
 lemma uniform_integrable_congr_ae {g : ι → α → β}
-  (hf : ∀ i, strongly_measurable (f i)) (hg : ∀ i, strongly_measurable (g i))
   (hfg : ∀ n, f n =ᵐ[μ] g n) :
   uniform_integrable f p μ ↔ uniform_integrable g p μ :=
-⟨λ h, h.ae_eq hg hfg, λ h, h.ae_eq hf (λ i, (hfg i).symm)⟩
+⟨λ h, h.ae_eq hfg, λ h, h.ae_eq (λ i, (hfg i).symm)⟩
 
 /-- A finite sequence of Lp functions is uniformly integrable in the probability sense. -/
-lemma uniform_integrable_fintype [fintype ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
-  (hf : ∀ i, strongly_measurable (f i)) (hf' : ∀ i, mem_ℒp (f i) p μ) :
+lemma uniform_integrable_finite [finite ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
+  (hf : ∀ i, mem_ℒp (f i) p μ) :
   uniform_integrable f p μ :=
 begin
-  refine ⟨hf, unif_integrable_fintype μ hp_one hp_top hf', _⟩,
+  casesI nonempty_fintype ι,
+  refine ⟨λ n, (hf n).1, unif_integrable_finite μ hp_one hp_top hf, _⟩,
   by_cases hι : nonempty ι,
-  { choose ae_meas hf using hf',
+  { choose ae_meas hf using hf,
     set C := (finset.univ.image (λ i : ι, snorm (f i) p μ)).max'
       ⟨snorm (f hι.some) p μ, finset.mem_image.2 ⟨hι.some, finset.mem_univ _, rfl⟩⟩,
     refine ⟨C.to_nnreal, λ i, _⟩,
@@ -779,30 +802,31 @@ end
 
 /-- A single function is uniformly integrable in the probability sense. -/
 lemma uniform_integrable_subsingleton [subsingleton ι] (hp_one : 1 ≤ p) (hp_top : p ≠ ∞)
-  (hf : ∀ i, strongly_measurable (f i)) (hf' : ∀ i, mem_ℒp (f i) p μ) :
+  (hf : ∀ i, mem_ℒp (f i) p μ) :
   uniform_integrable f p μ :=
-uniform_integrable_fintype hp_one hp_top hf hf'
+uniform_integrable_finite hp_one hp_top hf
 
 /-- A constant sequence of functions is uniformly integrable in the probability sense. -/
 lemma uniform_integrable_const {g : α → β} (hp : 1 ≤ p) (hp_ne_top : p ≠ ∞)
-  (hgm : strongly_measurable g) (hg : mem_ℒp g p μ) :
+  (hg : mem_ℒp g p μ) :
   uniform_integrable (λ n : ι, g) p μ :=
-⟨λ i, hgm, unif_integrable_const μ hp hp_ne_top hg,
+⟨λ i, hg.1, unif_integrable_const μ hp hp_ne_top hg,
   ⟨(snorm g p μ).to_nnreal, λ i, le_of_eq (ennreal.coe_to_nnreal hg.2.ne).symm⟩⟩
 
-/-- A sequene of functions `(fₙ)` is uniformly integrable in the probability sense if for all
-`ε > 0`, there exists some `C` such that `∫ x in {|fₙ| ≥ C}, fₙ x ∂μ ≤ ε` for all `n`. -/
-lemma uniform_integrable_of [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞)
+/-- This lemma is superceded by `uniform_integrable_of` which only requires
+`ae_strongly_measurable`. -/
+lemma uniform_integrable_of' [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞)
   (hf : ∀ i, strongly_measurable (f i))
   (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
-    ∀ i, snorm ({x | C ≤ ∥f i x∥₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
+    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
   uniform_integrable f p μ :=
 begin
-  refine ⟨hf, unif_integrable_of μ hp hp' hf h, _⟩,
+  refine ⟨λ i, (hf i).ae_strongly_measurable,
+    unif_integrable_of μ hp hp' (λ i, (hf i).ae_strongly_measurable) h, _⟩,
   obtain ⟨C, hC⟩ := h 1 one_pos,
   refine ⟨(C * (μ univ ^ (p.to_real⁻¹)) + 1 : ℝ≥0∞).to_nnreal, λ i, _⟩,
-  calc snorm (f i) p μ ≤ snorm ({x : α | ∥f i x∥₊ < C}.indicator (f i)) p μ +
-    snorm ({x : α | C ≤ ∥f i x∥₊}.indicator (f i)) p μ :
+  calc snorm (f i) p μ ≤ snorm ({x : α | ‖f i x‖₊ < C}.indicator (f i)) p μ +
+    snorm ({x : α | C ≤ ‖f i x‖₊}.indicator (f i)) p μ :
   begin
     refine le_trans (snorm_mono (λ x, _)) (snorm_add_le
       (strongly_measurable.ae_strongly_measurable ((hf i).indicator
@@ -818,7 +842,7 @@ begin
   end
   ... ≤ C * μ univ ^ (p.to_real⁻¹) + 1 :
   begin
-    have : ∀ᵐ x ∂μ, ∥{x : α | ∥f i x∥₊ < C}.indicator (f i) x∥₊ ≤ C,
+    have : ∀ᵐ x ∂μ, ‖{x : α | ‖f i x‖₊ < C}.indicator (f i) x‖₊ ≤ C,
     { refine eventually_of_forall _,
       simp_rw nnnorm_indicator_eq_indicator_nnnorm,
       exact indicator_le (λ x (hx : _ < _), hx.le) },
@@ -835,29 +859,53 @@ begin
   end
 end
 
-lemma uniform_integrable.spec (hp : p ≠ 0) (hp' : p ≠ ∞)
+/-- A sequene of functions `(fₙ)` is uniformly integrable in the probability sense if for all
+`ε > 0`, there exists some `C` such that `∫ x in {|fₙ| ≥ C}, fₙ x ∂μ ≤ ε` for all `n`. -/
+lemma uniform_integrable_of [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞)
+  (hf : ∀ i, ae_strongly_measurable (f i) μ)
+  (h : ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
+    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε) :
+  uniform_integrable f p μ :=
+begin
+  set g : ι → α → β := λ i, (hf i).some,
+  have hgmeas : ∀ i, strongly_measurable (g i) := λ i, (Exists.some_spec $ hf i).1,
+  have hgeq : ∀ i, g i =ᵐ[μ] f i := λ i, (Exists.some_spec $ hf i).2.symm,
+  refine (uniform_integrable_of' hp hp' hgmeas $ λ ε hε, _).ae_eq hgeq,
+  obtain ⟨C, hC⟩ := h ε hε,
+  refine ⟨C, λ i, le_trans (le_of_eq $ snorm_congr_ae _) (hC i)⟩,
+  filter_upwards [(Exists.some_spec $ hf i).2] with x hx,
+  by_cases hfx : x ∈ {x | C ≤ ‖f i x‖₊},
+  { rw [indicator_of_mem hfx, indicator_of_mem, hx],
+    rwa [mem_set_of, hx] at hfx },
+  { rw [indicator_of_not_mem hfx, indicator_of_not_mem],
+    rwa [mem_set_of, hx] at hfx }
+end
+
+/-- This lemma is superceded by `uniform_integrable.spec` which does not require measurability. -/
+lemma uniform_integrable.spec' (hp : p ≠ 0) (hp' : p ≠ ∞)
+  (hf : ∀ i, strongly_measurable (f i))
   (hfu : uniform_integrable f p μ) {ε : ℝ} (hε : 0 < ε) :
-  ∃ C : ℝ≥0, ∀ i, snorm ({x | C ≤ ∥f i x∥₊}.indicator (f i)) p μ ≤ ennreal.of_real ε :=
+  ∃ C : ℝ≥0, ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε :=
 begin
-  obtain ⟨hf₀, hfu, M, hM⟩ := hfu,
+  obtain ⟨-, hfu, M, hM⟩ := hfu,
   obtain ⟨δ, hδpos, hδ⟩ := hfu hε,
-  obtain ⟨C, hC⟩ : ∃ C : ℝ≥0, ∀ i, μ {x | C ≤ ∥f i x∥₊} ≤ ennreal.of_real δ,
+  obtain ⟨C, hC⟩ : ∃ C : ℝ≥0, ∀ i, μ {x | C ≤ ‖f i x‖₊} ≤ ennreal.of_real δ,
   { by_contra hcon, push_neg at hcon,
     choose ℐ hℐ using hcon,
     lift δ to ℝ≥0 using hδpos.le,
     have : ∀ C : ℝ≥0, C • (δ : ℝ≥0∞) ^ (1 / p.to_real) ≤ snorm (f (ℐ C)) p μ,
     { intros C,
-      calc C • (δ : ℝ≥0∞) ^ (1 / p.to_real) ≤ C • μ {x | C ≤ ∥f (ℐ C) x∥₊} ^ (1 / p.to_real):
+      calc C • (δ : ℝ≥0∞) ^ (1 / p.to_real) ≤ C • μ {x | C ≤ ‖f (ℐ C) x‖₊} ^ (1 / p.to_real):
       begin
         rw [ennreal.smul_def, ennreal.smul_def, smul_eq_mul, smul_eq_mul],
         simp_rw ennreal.of_real_coe_nnreal at hℐ,
-        refine ennreal.mul_le_mul le_rfl (ennreal.rpow_le_rpow (hℐ C).le
+        refine mul_le_mul' le_rfl (ennreal.rpow_le_rpow (hℐ C).le
           (one_div_nonneg.2 ennreal.to_real_nonneg)),
       end
-      ... ≤ snorm ({x | C ≤ ∥f (ℐ C) x∥₊}.indicator (f (ℐ C))) p μ :
+      ... ≤ snorm ({x | C ≤ ‖f (ℐ C) x‖₊}.indicator (f (ℐ C))) p μ :
       begin
         refine snorm_indicator_ge_of_bdd_below hp hp' _
-          (measurable_set_le measurable_const (hf₀ _).nnnorm.measurable)
+          (measurable_set_le measurable_const (hf _).nnnorm.measurable)
           (eventually_of_forall $ λ x hx, _),
         rwa [nnnorm_indicator_eq_indicator_nnnorm, indicator_of_mem hx],
       end
@@ -871,18 +919,89 @@ begin
       (le_max_left M 1)) (lt_of_lt_of_le _ this)).ne rfl,
     rw [← ennreal.coe_one, ← with_top.coe_max, ← ennreal.coe_mul, ennreal.coe_lt_coe],
     exact lt_two_mul_self (lt_max_of_lt_right one_pos) },
-  exact ⟨C, λ i, hδ i _ (measurable_set_le measurable_const (hf₀ i).nnnorm.measurable) (hC i)⟩,
+  exact ⟨C, λ i, hδ i _ (measurable_set_le measurable_const (hf i).nnnorm.measurable) (hC i)⟩,
+end
+
+lemma uniform_integrable.spec (hp : p ≠ 0) (hp' : p ≠ ∞)
+  (hfu : uniform_integrable f p μ) {ε : ℝ} (hε : 0 < ε) :
+  ∃ C : ℝ≥0, ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε :=
+begin
+  set g : ι → α → β := λ i, (hfu.1 i).some,
+  have hgmeas : ∀ i, strongly_measurable (g i) := λ i, (Exists.some_spec $ hfu.1 i).1,
+  have hgunif : uniform_integrable g p μ := hfu.ae_eq (λ i, (Exists.some_spec $ hfu.1 i).2),
+  obtain ⟨C, hC⟩ := hgunif.spec' hp hp' hgmeas hε,
+  refine ⟨C, λ i, le_trans (le_of_eq $ snorm_congr_ae _) (hC i)⟩,
+  filter_upwards [(Exists.some_spec $ hfu.1 i).2] with x hx,
+  by_cases hfx : x ∈ {x | C ≤ ‖f i x‖₊},
+  { rw [indicator_of_mem hfx, indicator_of_mem, hx],
+    rwa [mem_set_of, hx] at hfx },
+  { rw [indicator_of_not_mem hfx, indicator_of_not_mem],
+    rwa [mem_set_of, hx] at hfx }
 end
 
 /-- The definition of uniform integrable in mathlib is equivalent to the definition commonly
 found in literature. -/
 lemma uniform_integrable_iff [is_finite_measure μ] (hp : 1 ≤ p) (hp' : p ≠ ∞) :
-  uniform_integrable f p μ ↔ (∀ i, strongly_measurable (f i)) ∧
+  uniform_integrable f p μ ↔ (∀ i, ae_strongly_measurable (f i) μ) ∧
   ∀ ε : ℝ, 0 < ε → ∃ C : ℝ≥0,
-    ∀ i, snorm ({x | C ≤ ∥f i x∥₊}.indicator (f i)) p μ ≤ ennreal.of_real ε  :=
-⟨λ h, ⟨h.1, λ ε, h.spec (lt_of_lt_of_le ennreal.zero_lt_one hp).ne.symm hp'⟩,
+    ∀ i, snorm ({x | C ≤ ‖f i x‖₊}.indicator (f i)) p μ ≤ ennreal.of_real ε  :=
+⟨λ h, ⟨h.1, λ ε, h.spec (lt_of_lt_of_le zero_lt_one hp).ne.symm hp'⟩,
  λ h, uniform_integrable_of hp hp' h.1 h.2⟩
 
+
+/-- The averaging of a uniformly integrable sequence is also uniformly integrable. -/
+lemma uniform_integrable_average (hp : 1 ≤ p)
+  {f : ℕ → α → ℝ} (hf : uniform_integrable f p μ) :
+  uniform_integrable (λ n, (∑ i in finset.range n, f i) / n) p μ :=
+begin
+  obtain ⟨hf₁, hf₂, hf₃⟩ := hf,
+  refine ⟨λ n, _, λ ε hε, _, _⟩,
+  { simp_rw div_eq_mul_inv,
+    exact (finset.ae_strongly_measurable_sum' _ (λ i _, hf₁ i)).mul
+      (ae_strongly_measurable_const : ae_strongly_measurable (λ x, (↑n : ℝ)⁻¹) μ) },
+  { obtain ⟨δ, hδ₁, hδ₂⟩ := hf₂ hε,
+    refine ⟨δ, hδ₁, λ n s hs hle, _⟩,
+    simp_rw [div_eq_mul_inv, finset.sum_mul, set.indicator_finset_sum],
+    refine le_trans (snorm_sum_le (λ i hi, ((hf₁ i).mul_const (↑n)⁻¹).indicator hs) hp) _,
+    have : ∀ i, s.indicator (f i * (↑n)⁻¹) = (↑n : ℝ)⁻¹ • s.indicator (f i),
+    { intro i,
+      rw [mul_comm, (_ : (↑n)⁻¹ * f i = λ ω, (↑n : ℝ)⁻¹ • f i ω)],
+      { rw set.indicator_const_smul s (↑n)⁻¹ (f i),
+        refl },
+      { refl } },
+    simp_rw [this, snorm_const_smul, ← finset.mul_sum, nnnorm_inv, real.nnnorm_coe_nat],
+    by_cases hn : (↑(↑n : ℝ≥0)⁻¹ : ℝ≥0∞) = 0,
+    { simp only [hn, zero_mul, zero_le] },
+    refine le_trans _ (_ : ↑(↑n : ℝ≥0)⁻¹ * (n • ennreal.of_real ε) ≤ ennreal.of_real ε),
+    { refine (ennreal.mul_le_mul_left hn ennreal.coe_ne_top).2 _,
+      conv_rhs { rw ← finset.card_range n },
+      exact finset.sum_le_card_nsmul _ _ _ (λ i hi, hδ₂ _ _ hs hle) },
+    { simp only [ennreal.coe_eq_zero, inv_eq_zero, nat.cast_eq_zero] at hn,
+      rw [nsmul_eq_mul, ← mul_assoc, ennreal.coe_inv, ennreal.coe_nat,
+        ennreal.inv_mul_cancel _ (ennreal.nat_ne_top _), one_mul],
+      { exact le_rfl },
+      all_goals { simpa only [ne.def, nat.cast_eq_zero] } } },
+  { obtain ⟨C, hC⟩ := hf₃,
+    simp_rw [div_eq_mul_inv, finset.sum_mul],
+    refine ⟨C, λ n, (snorm_sum_le (λ i hi, (hf₁ i).mul_const (↑n)⁻¹) hp).trans _⟩,
+    have : ∀ i, (λ ω, f i ω * (↑n)⁻¹) = (↑n : ℝ)⁻¹ • λ ω, f i ω,
+    { intro i,
+      ext ω,
+      simp only [mul_comm, pi.smul_apply, algebra.id.smul_eq_mul] },
+    simp_rw [this, snorm_const_smul, ← finset.mul_sum, nnnorm_inv, real.nnnorm_coe_nat],
+    by_cases hn : (↑(↑n : ℝ≥0)⁻¹ : ℝ≥0∞) = 0,
+    { simp only [hn, zero_mul, zero_le] },
+    refine le_trans _ (_ : ↑(↑n : ℝ≥0)⁻¹ * (n • C : ℝ≥0∞) ≤ C),
+    { refine (ennreal.mul_le_mul_left hn ennreal.coe_ne_top).2 _,
+      conv_rhs { rw ← finset.card_range n },
+      exact finset.sum_le_card_nsmul _ _ _ (λ i hi, hC i) },
+    { simp only [ennreal.coe_eq_zero, inv_eq_zero, nat.cast_eq_zero] at hn,
+      rw [nsmul_eq_mul, ← mul_assoc, ennreal.coe_inv, ennreal.coe_nat,
+        ennreal.inv_mul_cancel _ (ennreal.nat_ne_top _), one_mul],
+      { exact le_rfl },
+      all_goals { simpa only [ne.def, nat.cast_eq_zero] } } }
+end
+
 end uniform_integrable
 
 end measure_theory
diff --git a/src/measure_theory/group/action.lean b/src/measure_theory/group/action.lean
index 40174526c0d77..82da7ac4e5014 100644
--- a/src/measure_theory/group/action.lean
+++ b/src/measure_theory/group/action.lean
@@ -11,18 +11,21 @@ import dynamics.minimal
 /-!
 # Measures invariant under group actions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A measure `μ : measure α` is said to be *invariant* under an action of a group `G` if scalar
 multiplication by `c : G` is a measure preserving map for all `c`. In this file we define a
 typeclass for measures invariant under action of an (additive or multiplicative) group and prove
 some basic properties of such measures.
 -/
 
-open_locale ennreal nnreal pointwise topological_space
+open_locale ennreal nnreal pointwise topology
 open measure_theory measure_theory.measure set function
 
 namespace measure_theory
 
-variables {G M α : Type*}
+variables {G M α : Type*} {s : set α}
 
 /-- A measure `μ : measure α` is invariant under an additive action of `M` on `α` if for any
 measurable set `s : set α` and `c : M`, the measure of its preimage under `λ x, c +ᵥ x` is equal to
@@ -34,16 +37,16 @@ class vadd_invariant_measure (M α : Type*) [has_vadd M α] {_ : measurable_spac
 /-- A measure `μ : measure α` is invariant under a multiplicative action of `M` on `α` if for any
 measurable set `s : set α` and `c : M`, the measure of its preimage under `λ x, c • x` is equal to
 the measure of `s`. -/
-@[to_additive] class smul_invariant_measure (M α : Type*) [has_scalar M α] {_ : measurable_space α}
+@[to_additive] class smul_invariant_measure (M α : Type*) [has_smul M α] {_ : measurable_space α}
   (μ : measure α) : Prop :=
 (measure_preimage_smul [] : ∀ (c : M) ⦃s : set α⦄, measurable_set s → μ ((λ x, c • x) ⁻¹' s) = μ s)
 
 namespace smul_invariant_measure
 
-@[to_additive] instance zero [measurable_space α] [has_scalar M α] : smul_invariant_measure M α 0 :=
+@[to_additive] instance zero [measurable_space α] [has_smul M α] : smul_invariant_measure M α 0 :=
 ⟨λ _ _ _, rfl⟩
 
-variables [has_scalar M α] {m : measurable_space α} {μ ν : measure α}
+variables [has_smul M α] {m : measurable_space α} {μ ν : measure α}
 
 @[to_additive] instance add [smul_invariant_measure M α μ] [smul_invariant_measure M α ν] :
   smul_invariant_measure M α (μ + ν) :=
@@ -60,6 +63,25 @@ smul_invariant_measure.smul c
 
 end smul_invariant_measure
 
+section has_measurable_smul
+
+variables {m : measurable_space α} [measurable_space M] [has_smul M α] [has_measurable_smul M α]
+  (c : M) (μ : measure α) [smul_invariant_measure M α μ]
+
+@[simp, to_additive] lemma measure_preserving_smul : measure_preserving ((•) c) μ μ :=
+{ measurable := measurable_const_smul c,
+  map_eq :=
+  begin
+    ext1 s hs,
+    rw map_apply (measurable_const_smul c) hs,
+    exact smul_invariant_measure.measure_preimage_smul μ c hs,
+  end }
+
+@[simp, to_additive] lemma map_smul : map ((•) c) μ = μ :=
+(measure_preserving_smul c μ).map_eq
+
+end has_measurable_smul
+
 variables (G) {m : measurable_space α} [group G] [mul_action G α] [measurable_space G]
   [has_measurable_smul G α] (c : G) (μ : measure α)
 
@@ -88,8 +110,7 @@ variables (G) {m : measurable_space α} [group G] [mul_action G α] [measurable_
     ∀ c : G, measure_preserving ((•) c) μ μ] :=
 begin
   tfae_have : 1 ↔ 2, from ⟨λ h, h.1, λ h, ⟨h⟩⟩,
-  tfae_have : 2 → 6,
-    from λ H c, ext (λ s hs, by rw [map_apply (measurable_const_smul c) hs, H _ _ hs]),
+  tfae_have : 1 → 6, { introsI h c, exact (measure_preserving_smul c μ).map_eq, },
   tfae_have : 6 → 7, from λ H c, ⟨measurable_const_smul c, H c⟩,
   tfae_have : 7 → 4, from λ H c, (H c).measure_preimage_emb (measurable_embedding_const_smul c),
   tfae_have : 4 → 5, from λ H c s, by { rw [← preimage_smul_inv], apply H },
@@ -117,16 +138,10 @@ add_decl_doc vadd_invariant_measure_tfae
 
 variables {G} [smul_invariant_measure G α μ]
 
-@[to_additive] lemma measure_preserving_smul : measure_preserving ((•) c) μ μ :=
-((smul_invariant_measure_tfae G μ).out 0 6).mp ‹_› c
-
-@[simp, to_additive] lemma map_smul : map ((•) c) μ = μ :=
-(measure_preserving_smul c μ).map_eq
-
 @[simp, to_additive] lemma measure_preimage_smul (s : set α) : μ ((•) c ⁻¹' s) = μ s :=
 ((smul_invariant_measure_tfae G μ).out 0 3).mp ‹_› c s
 
-@[simp, to_additive] lemma measure_smul_set (s : set α) : μ (c • s) = μ s :=
+@[simp, to_additive] lemma measure_smul (s : set α) : μ (c • s) = μ s :=
 ((smul_invariant_measure_tfae G μ).out 0 4).mp ‹_› c s
 
 variable {μ}
@@ -136,6 +151,8 @@ variable {μ}
 by simpa only [← preimage_smul_inv]
   using hs.preimage (measure_preserving_smul _ _).quasi_measure_preserving
 
+lemma measure_smul_null {s} (h : μ s = 0) (c : G) : μ (c • s) = 0 := by rwa measure_smul
+
 section is_minimal
 
 variables (G) [topological_space α] [has_continuous_const_smul G α] [mul_action.is_minimal G α]
@@ -148,7 +165,7 @@ positive on any nonempty open set. In case of a regular measure, one can assume
   (hμK : μ K ≠ 0) (hU : is_open U) (hne : U.nonempty) : 0 < μ U :=
 let ⟨t, ht⟩ := hK.exists_finite_cover_smul G hU hne
 in pos_iff_ne_zero.2 $ λ hμU, hμK $ measure_mono_null ht $
-  (measure_bUnion_null_iff t.countable_to_set).2 $ λ _ _, by rwa measure_smul_set
+  (measure_bUnion_null_iff t.countable_to_set).2 $ λ _ _, by rwa measure_smul
 
 /-- If measure `μ` is invariant under an additive group action and is nonzero on a compact set `K`,
 then it is positive on any nonempty open set. In case of a regular measure, one can assume `μ ≠ 0`
@@ -177,8 +194,39 @@ include G
 @[to_additive] lemma measure_eq_zero_iff_eq_empty_of_smul_invariant (hμ : μ ≠ 0) (hU : is_open U) :
   μ U = 0 ↔ U = ∅ :=
 by rw [← not_iff_not, ← ne.def, ← pos_iff_ne_zero,
-  measure_pos_iff_nonempty_of_smul_invariant G hμ hU, ← ne_empty_iff_nonempty]
+  measure_pos_iff_nonempty_of_smul_invariant G hμ hU, nonempty_iff_ne_empty]
 
 end is_minimal
 
+lemma smul_ae_eq_self_of_mem_zpowers
+  {x y : G} (hs : (x • s : set α) =ᵐ[μ] s) (hy : y ∈ subgroup.zpowers x) :
+  (y • s : set α) =ᵐ[μ] s :=
+begin
+  obtain ⟨k, rfl⟩ := subgroup.mem_zpowers_iff.mp hy,
+  let e : α ≃ α := mul_action.to_perm_hom G α x,
+  have he : quasi_measure_preserving e μ μ :=
+    (measure_preserving_smul x μ).quasi_measure_preserving,
+  have he' : quasi_measure_preserving e.symm μ μ :=
+    (measure_preserving_smul x⁻¹ μ).quasi_measure_preserving,
+  simpa only [mul_action.to_perm_hom_apply, mul_action.to_perm_apply, image_smul,
+    ← monoid_hom.map_zpow] using he.image_zpow_ae_eq he' k hs,
+end
+
+lemma vadd_ae_eq_self_of_mem_zmultiples {G : Type*} [measurable_space G]
+  [add_group G] [add_action G α] [vadd_invariant_measure G α μ] [has_measurable_vadd G α]
+  {x y : G} (hs : (x +ᵥ s : set α) =ᵐ[μ] s) (hy : y ∈ add_subgroup.zmultiples x) :
+  (y +ᵥ s : set α) =ᵐ[μ] s :=
+begin
+  letI : measurable_space (multiplicative G) := (by apply_instance : measurable_space G),
+  letI : smul_invariant_measure (multiplicative G) α μ :=
+    ⟨λ g, vadd_invariant_measure.measure_preimage_vadd μ (multiplicative.to_add g)⟩,
+  letI : has_measurable_smul (multiplicative G) α :=
+  { measurable_const_smul := λ g, measurable_const_vadd (multiplicative.to_add g),
+    measurable_smul_const := λ a, @measurable_vadd_const (multiplicative G) α
+      (by apply_instance : has_vadd G α) _ _ (by apply_instance : has_measurable_vadd G α) a },
+  exact @smul_ae_eq_self_of_mem_zpowers (multiplicative G) α _ _ _ _ _ _ _ _ _ _ hs hy,
+end
+
+attribute [to_additive vadd_ae_eq_self_of_mem_zmultiples] smul_ae_eq_self_of_mem_zpowers
+
 end measure_theory
diff --git a/src/measure_theory/group/add_circle.lean b/src/measure_theory/group/add_circle.lean
new file mode 100644
index 0000000000000..67d2fc9588ddf
--- /dev/null
+++ b/src/measure_theory/group/add_circle.lean
@@ -0,0 +1,112 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import measure_theory.integral.periodic
+import data.zmod.quotient
+
+/-!
+# Measure-theoretic results about the additive circle
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The file is a place to collect measure-theoretic results about the additive circle.
+
+## Main definitions:
+
+ * `add_circle.closed_ball_ae_eq_ball`: open and closed balls in the additive circle are almost
+   equal
+ * `add_circle.is_add_fundamental_domain_of_ae_ball`: a ball is a fundamental domain for rational
+   angle rotation in the additive circle
+
+-/
+
+open set function filter measure_theory measure_theory.measure metric
+open_locale measure_theory pointwise big_operators topology ennreal
+
+namespace add_circle
+
+variables {T : ℝ} [hT : fact (0 < T)]
+include hT
+
+lemma closed_ball_ae_eq_ball {x : add_circle T} {ε : ℝ} :
+  closed_ball x ε =ᵐ[volume] ball x ε :=
+begin
+  cases le_or_lt ε 0 with hε hε,
+  { rw [ball_eq_empty.mpr hε, ae_eq_empty, volume_closed_ball,
+      min_eq_right (by linarith [hT.out] : 2 * ε ≤ T), ennreal.of_real_eq_zero],
+    exact mul_nonpos_of_nonneg_of_nonpos zero_le_two hε, },
+  { suffices : volume (closed_ball x ε) ≤ volume (ball x ε),
+    { exact (ae_eq_of_subset_of_measure_ge ball_subset_closed_ball this measurable_set_ball
+        (measure_ne_top _ _)).symm, },
+    have : tendsto (λ δ, volume (closed_ball x δ)) (𝓝[<] ε) (𝓝 $ volume (closed_ball x ε)),
+    { simp_rw volume_closed_ball,
+      refine ennreal.tendsto_of_real (tendsto.min tendsto_const_nhds $ tendsto.const_mul _ _),
+      convert (@monotone_id ℝ _).tendsto_nhds_within_Iio ε,
+      simp, },
+    refine le_of_tendsto this (mem_nhds_within_Iio_iff_exists_Ioo_subset.mpr ⟨0, hε, λ r hr, _⟩),
+    exact measure_mono (closed_ball_subset_ball hr.2), },
+end
+
+/-- Let `G` be the subgroup of `add_circle T` generated by a point `u` of finite order `n : ℕ`. Then
+any set `I` that is almost equal to a ball of radius `T / 2n` is a fundamental domain for the action
+of `G` on `add_circle T` by left addition. -/
+lemma is_add_fundamental_domain_of_ae_ball (I : set $ add_circle T)
+  (u x : add_circle T) (hu : is_of_fin_add_order u)
+  (hI : I =ᵐ[volume] ball x (T / (2 * add_order_of u))) :
+  is_add_fundamental_domain (add_subgroup.zmultiples u) I :=
+begin
+  set G := add_subgroup.zmultiples u,
+  set n := add_order_of u,
+  set B := ball x (T / (2 * n)),
+  have hn : 1 ≤ (n : ℝ), { norm_cast, linarith [add_order_of_pos' hu], },
+  refine is_add_fundamental_domain.mk_of_measure_univ_le _ _ _ _,
+  { -- `null_measurable_set I volume`
+    exact (measurable_set_ball.null_measurable_set.congr hI.symm), },
+  { -- `∀ (g : G), g ≠ 0 → ae_disjoint volume (g +ᵥ I) I`
+    rintros ⟨g, hg⟩ hg',
+    replace hg' : g ≠ 0, by simpa only [ne.def, add_subgroup.mk_eq_zero_iff] using hg',
+    change ae_disjoint volume (g +ᵥ I) I,
+    refine ae_disjoint.congr (disjoint.ae_disjoint _)
+      ((quasi_measure_preserving_add_left volume (-g)).vadd_ae_eq_of_ae_eq g hI) hI,
+    have hBg : g +ᵥ B = ball (g + x) (T / (2 * n)),
+    { rw [add_comm g x, ← singleton_add_ball _ x g, add_ball, thickening_singleton], },
+    rw hBg,
+    apply ball_disjoint_ball,
+    rw [dist_eq_norm, add_sub_cancel, div_mul_eq_div_div, ← add_div, ← add_div, add_self_div_two,
+      div_le_iff' (by positivity : 0 < (n : ℝ)), ← nsmul_eq_mul],
+    refine (le_add_order_smul_norm_of_is_of_fin_add_order (hu.of_mem_zmultiples hg) hg').trans
+      (nsmul_le_nsmul (norm_nonneg g) _),
+    exact nat.le_of_dvd (add_order_of_pos_iff.mpr hu) (add_order_of_dvd_of_mem_zmultiples hg), },
+  { -- `∀ (g : G), quasi_measure_preserving (has_vadd.vadd g) volume volume`
+    exact (λ g, quasi_measure_preserving_add_left volume g), },
+  { -- `volume univ ≤ ∑' (g : G), volume (g +ᵥ I)`
+    replace hI : I =ᵐ[volume] closed_ball x (T / (2 * ↑n)) :=
+      hI.trans closed_ball_ae_eq_ball.symm,
+    haveI : fintype G := @fintype.of_finite _ hu.finite_zmultiples,
+    have hG_card : (finset.univ : finset G).card = n,
+    { show _ = add_order_of u, rw [add_order_eq_card_zmultiples', nat.card_eq_fintype_card], refl },
+    simp_rw [measure_vadd],
+    rw [add_circle.measure_univ, tsum_fintype, finset.sum_const, measure_congr hI,
+      volume_closed_ball, ← ennreal.of_real_nsmul, mul_div, mul_div_mul_comm,
+      div_self (@two_ne_zero ℝ _ _ _ _), one_mul, min_eq_right (div_le_self hT.out.le hn), hG_card,
+      nsmul_eq_mul, mul_div_cancel' T (lt_of_lt_of_le zero_lt_one hn).ne.symm],
+    exact le_refl _, },
+end
+
+lemma volume_of_add_preimage_eq (s I : set $ add_circle T) (u x : add_circle T)
+  (hu : is_of_fin_add_order u) (hs : (u +ᵥ s : set $ add_circle T) =ᵐ[volume] s)
+  (hI : I =ᵐ[volume] ball x (T / (2 * add_order_of u))) :
+  volume s = add_order_of u • volume (s ∩ I) :=
+begin
+  let G := add_subgroup.zmultiples u,
+  haveI : fintype G := @fintype.of_finite _ hu.finite_zmultiples,
+  have hsG : ∀ (g : G), (g +ᵥ s : set $ add_circle T) =ᵐ[volume] s,
+  { rintros ⟨y, hy⟩, exact (vadd_ae_eq_self_of_mem_zmultiples hs hy : _), },
+  rw [(is_add_fundamental_domain_of_ae_ball I u x hu hI).measure_eq_card_smul_of_vadd_ae_eq_self
+    s hsG, add_order_eq_card_zmultiples' u, nat.card_eq_fintype_card],
+end
+
+end add_circle
diff --git a/src/measure_theory/group/arithmetic.lean b/src/measure_theory/group/arithmetic.lean
index 8425505e590cf..64c9f1e7bd8e6 100644
--- a/src/measure_theory/group/arithmetic.lean
+++ b/src/measure_theory/group/arithmetic.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.ae_measurable
 /-!
 # Typeclasses for measurability of operations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define classes `has_measurable_mul` etc and prove dot-style lemmas
 (`measurable.mul`, `ae_measurable.mul` etc). For binary operations we define two typeclasses:
 
@@ -174,7 +177,7 @@ export has_measurable_pow (measurable_pow)
 /-- `monoid.has_pow` is measurable. -/
 instance monoid.has_measurable_pow (M : Type*) [monoid M] [measurable_space M]
   [has_measurable_mul₂ M] : has_measurable_pow M ℕ :=
-⟨measurable_from_prod_encodable $ λ n, begin
+⟨measurable_from_prod_countable $ λ n, begin
   induction n with n ih,
   { simp only [pow_zero, ←pi.one_def, measurable_one] },
   { simp only [pow_succ], exact measurable_id.mul ih }
@@ -336,6 +339,30 @@ begin
   simp_rw [set.mem_set_of_eq, pi.sub_apply, sub_eq_zero],
 end
 
+lemma null_measurable_set_eq_fun {E} [measurable_space E] [add_group E]
+  [measurable_singleton_class E] [has_measurable_sub₂ E] {f g : α → E}
+  (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
+  null_measurable_set {x | f x = g x} μ :=
+begin
+  apply (measurable_set_eq_fun hf.measurable_mk hg.measurable_mk).null_measurable_set.congr,
+  filter_upwards [hf.ae_eq_mk, hg.ae_eq_mk] with x hfx hgx,
+  change (hf.mk f x = hg.mk g x) = (f x = g x),
+  simp only [hfx, hgx],
+end
+
+lemma measurable_set_eq_fun_of_countable {m : measurable_space α} {E} [measurable_space E]
+  [measurable_singleton_class E] [countable E] {f g : α → E}
+  (hf : measurable f) (hg : measurable g) :
+  measurable_set {x | f x = g x} :=
+begin
+  have : {x | f x = g x} = ⋃ j, {x | f x = j} ∩ {x | g x = j},
+  { ext1 x, simp only [set.mem_set_of_eq, set.mem_Union, set.mem_inter_iff, exists_eq_right'], },
+  rw this,
+  refine measurable_set.Union (λ j, measurable_set.inter _ _),
+  { exact hf (measurable_set_singleton j), },
+  { exact hg (measurable_set_singleton j), },
+end
+
 lemma ae_eq_trim_of_measurable {α E} {m m0 : measurable_space α} {μ : measure α}
   [measurable_space E] [add_group E] [measurable_singleton_class E] [has_measurable_sub₂ E]
   (hm : m ≤ m0) {f g : α → E} (hf : measurable[m] f) (hg : measurable[m] g)
@@ -420,7 +447,7 @@ end inv
 instance div_inv_monoid.has_measurable_zpow (G : Type u) [div_inv_monoid G] [measurable_space G]
   [has_measurable_mul₂ G] [has_measurable_inv G] :
   has_measurable_pow G ℤ :=
-⟨measurable_from_prod_encodable $ λ n, begin
+⟨measurable_from_prod_countable $ λ n, begin
   cases n with n n,
   { simp_rw zpow_of_nat, exact measurable_id.pow_const _ },
   { simp_rw zpow_neg_succ_of_nat, exact (measurable_id.pow_const (n + 1)).inv }
@@ -442,7 +469,7 @@ class has_measurable_vadd (M α : Type*) [has_vadd M α] [measurable_space M] [m
 /-- We say that the action of `M` on `α` `has_measurable_smul` if for each `c` the map `x ↦ c • x`
 is a measurable function and for each `x` the map `c ↦ c • x` is a measurable function. -/
 @[to_additive]
-class has_measurable_smul (M α : Type*) [has_scalar M α] [measurable_space M] [measurable_space α] :
+class has_measurable_smul (M α : Type*) [has_smul M α] [measurable_space M] [measurable_space α] :
   Prop :=
 (measurable_const_smul : ∀ c : M, measurable ((•) c : α → α))
 (measurable_smul_const : ∀ x : α, measurable (λ c : M, c • x))
@@ -456,7 +483,7 @@ class has_measurable_vadd₂ (M α : Type*) [has_vadd M α] [measurable_space M]
 /-- We say that the action of `M` on `α` `has_measurable_smul₂` if the map
 `(c, x) ↦ c • x` is a measurable function. -/
 @[to_additive has_measurable_vadd₂]
-class has_measurable_smul₂ (M α : Type*) [has_scalar M α] [measurable_space M]
+class has_measurable_smul₂ (M α : Type*) [has_smul M α] [measurable_space M]
   [measurable_space α] : Prop :=
 (measurable_smul : measurable (function.uncurry (•) : M × α → α))
 
@@ -490,7 +517,7 @@ s.to_submonoid.has_measurable_smul
 
 section smul
 
-variables {M β α : Type*} [measurable_space M] [measurable_space β] [has_scalar M β]
+variables {M β α : Type*} [measurable_space M] [measurable_space β] [has_smul M β]
   {m : measurable_space α} {f : α → M} {g : α → β}
 
 include m
@@ -550,31 +577,31 @@ hf.const_smul' c
 omit m
 
 @[to_additive]
-instance pi.has_measurable_smul {ι : Type*} {α : ι → Type*} [∀ i, has_scalar M (α i)]
+instance pi.has_measurable_smul {ι : Type*} {α : ι → Type*} [∀ i, has_smul M (α i)]
   [∀ i, measurable_space (α i)] [∀ i, has_measurable_smul M (α i)] :
   has_measurable_smul M (Π i, α i) :=
 ⟨λ g, measurable_pi_iff.mpr $ λ i, (measurable_pi_apply i).const_smul _,
  λ g, measurable_pi_iff.mpr $ λ i, measurable_smul_const _⟩
 
-/-- `add_monoid.has_scalar_nat` is measurable. -/
+/-- `add_monoid.has_smul_nat` is measurable. -/
 instance add_monoid.has_measurable_smul_nat₂ (M : Type*) [add_monoid M] [measurable_space M]
   [has_measurable_add₂ M] : has_measurable_smul₂ ℕ M :=
 ⟨begin
   suffices : measurable (λ p : M × ℕ, p.2 • p.1),
   { apply this.comp measurable_swap, },
-  refine measurable_from_prod_encodable (λ n, _),
+  refine measurable_from_prod_countable (λ n, _),
   induction n with n ih,
   { simp only [zero_smul, ←pi.zero_def, measurable_zero] },
   { simp only [succ_nsmul], exact measurable_id.add ih }
 end⟩
 
-/-- `sub_neg_monoid.has_scalar_int` is measurable. -/
+/-- `sub_neg_monoid.has_smul_int` is measurable. -/
 instance sub_neg_monoid.has_measurable_smul_int₂ (M : Type*) [sub_neg_monoid M] [measurable_space M]
   [has_measurable_add₂ M] [has_measurable_neg M] : has_measurable_smul₂ ℤ M :=
 ⟨begin
   suffices : measurable (λ p : M × ℤ, p.2 • p.1),
   { apply this.comp measurable_swap, },
-  refine measurable_from_prod_encodable (λ n, _),
+  refine measurable_from_prod_countable (λ n, _),
   induction n with n n ih,
   { simp only [of_nat_zsmul], exact measurable_const_smul _, },
   { simp only [zsmul_neg_succ_of_nat], exact (measurable_const_smul _).neg }
@@ -662,7 +689,7 @@ instance {M : Type*} [has_mul M] [measurable_space M] [has_measurable_mul₂ M]
 
 /-- If a scalar is central, then its right action is measurable when its left action is. -/
 instance has_measurable_smul.op {M α} [measurable_space M]
-  [measurable_space α] [has_scalar M α] [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α]
+  [measurable_space α] [has_smul M α] [has_smul Mᵐᵒᵖ α] [is_central_scalar M α]
   [has_measurable_smul M α] : has_measurable_smul Mᵐᵒᵖ α :=
 ⟨ mul_opposite.rec $ λ c, show measurable (λ x, op c • x),
                           by simpa only [op_smul_eq_smul] using measurable_const_smul c,
@@ -671,7 +698,7 @@ instance has_measurable_smul.op {M α} [measurable_space M]
 
 /-- If a scalar is central, then its right action is measurable when its left action is. -/
 instance has_measurable_smul₂.op {M α} [measurable_space M]
-  [measurable_space α] [has_scalar M α] [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α]
+  [measurable_space α] [has_smul M α] [has_smul Mᵐᵒᵖ α] [is_central_scalar M α]
   [has_measurable_smul₂ M α] : has_measurable_smul₂ Mᵐᵒᵖ α :=
 ⟨show measurable (λ x : Mᵐᵒᵖ × α, op (unop x.1) • x.2), begin
   simp_rw op_smul_eq_smul,
diff --git a/src/measure_theory/group/fundamental_domain.lean b/src/measure_theory/group/fundamental_domain.lean
index 1f5b9a0fbb8cf..c97dba8abe1bc 100644
--- a/src/measure_theory/group/fundamental_domain.lean
+++ b/src/measure_theory/group/fundamental_domain.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import measure_theory.group.action
-import measure_theory.group.pointwise
 import measure_theory.integral.set_integral
 
 /-!
 # Fundamental domain of a group action
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A set `s` is said to be a *fundamental domain* of an action of a group `G` on a measurable space `α`
 with respect to a measure `μ` if
 
@@ -25,9 +27,18 @@ fundamental domains have the same measure, and for a `G`-invariant function, its
 two fundamental domains are equal to each other.
 
 We also generate additive versions of all theorems in this file using the `to_additive` attribute.
+
+## Main declarations
+
+* `measure_theory.is_fundamental_domain`: Predicate for a set to be a fundamental domain of the
+  action of a group
+* `measure_theory.fundamental_frontier`: Fundamental frontier of a set under the action of a group.
+  Elements of `s` that belong to some other translate of `s`.
+* `measure_theory.fundamental_interior`: Fundamental interior of a set under the action of a group.
+  Elements of `s` that do not belong to any other translate of `s`.
 -/
 
-open_locale ennreal pointwise topological_space nnreal ennreal measure_theory
+open_locale ennreal pointwise topology nnreal ennreal measure_theory
 open measure_theory measure_theory.measure set function topological_space filter
 
 namespace measure_theory
@@ -39,22 +50,23 @@ a.e. disjoint and cover the whole space. -/
   [has_vadd G α] [measurable_space α] (s : set α) (μ : measure α . volume_tac) : Prop :=
 (null_measurable_set : null_measurable_set s μ)
 (ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g +ᵥ x ∈ s)
-(ae_disjoint : ∀ g ≠ (0 : G), ae_disjoint μ (g +ᵥ s) s)
+(ae_disjoint : pairwise $ ae_disjoint μ on λ g : G, g +ᵥ s)
 
 /-- A measurable set `s` is a *fundamental domain* for an action of a group `G` on a measurable
 space `α` with respect to a measure `α` if the sets `g • s`, `g : G`, are pairwise a.e. disjoint and
 cover the whole space. -/
 @[protect_proj, to_additive is_add_fundamental_domain]
-structure is_fundamental_domain (G : Type*) {α : Type*} [has_one G] [has_scalar G α]
+structure is_fundamental_domain (G : Type*) {α : Type*} [has_one G] [has_smul G α]
   [measurable_space α] (s : set α) (μ : measure α . volume_tac) : Prop :=
 (null_measurable_set : null_measurable_set s μ)
 (ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g • x ∈ s)
-(ae_disjoint : ∀ g ≠ (1 : G), ae_disjoint μ (g • s) s)
+(ae_disjoint : pairwise $ ae_disjoint μ on λ g : G, g • s)
 
-namespace is_fundamental_domain
+variables {G H α β E : Type*}
 
-variables {G α E : Type*} [group G] [mul_action G α] [measurable_space α]
-  [normed_group E] {s t : set α} {μ : measure α}
+namespace is_fundamental_domain
+variables [group G] [group H] [mul_action G α] [measurable_space α] [mul_action H β]
+  [measurable_space β] [normed_add_comm_group E] {s t : set α} {μ : measure α}
 
 /-- If for each `x : α`, exactly one of `g • x`, `g : G`, belongs to a measurable set `s`, then `s`
 is a fundamental domain for the action of `G` on `α`. -/
@@ -64,89 +76,119 @@ lemma mk' (h_meas : null_measurable_set s μ) (h_exists : ∀ x : α, ∃! g : G
   is_fundamental_domain G s μ :=
 { null_measurable_set := h_meas,
   ae_covers := eventually_of_forall $ λ x, (h_exists x).exists,
-  ae_disjoint := λ g hne, disjoint.ae_disjoint $ disjoint_left.2
+  ae_disjoint := λ a b hab, disjoint.ae_disjoint $ disjoint_left.2 $ λ x hxa hxb,
     begin
-      rintro _ ⟨x, hx, rfl⟩ hgx,
-      rw ← one_smul G x at hx,
-      exact hne ((h_exists x).unique hgx hx)
+      rw mem_smul_set_iff_inv_smul_mem at hxa hxb,
+      exact hab (inv_injective $ (h_exists x).unique hxa hxb),
     end }
 
+/-- For `s` to be a fundamental domain, it's enough to check `ae_disjoint (g • s) s` for `g ≠ 1`. -/
+@[to_additive "For `s` to be a fundamental domain, it's enough to check `ae_disjoint (g +ᵥ s) s` for
+`g ≠ 0`."]
+lemma mk'' (h_meas : null_measurable_set s μ) (h_ae_covers : ∀ᵐ x ∂μ, ∃ g : G, g • x ∈ s)
+  (h_ae_disjoint : ∀ g ≠ (1 : G), ae_disjoint μ (g • s) s)
+  (h_qmp : ∀ (g : G), quasi_measure_preserving ((•) g : α → α) μ μ) :
+  is_fundamental_domain G s μ :=
+{ null_measurable_set := h_meas,
+  ae_covers := h_ae_covers,
+  ae_disjoint := pairwise_ae_disjoint_of_ae_disjoint_forall_ne_one h_ae_disjoint h_qmp }
+
+/-- If a measurable space has a finite measure `μ` and a countable group `G` acts
+quasi-measure-preservingly, then to show that a set `s` is a fundamental domain, it is sufficient
+to check that its translates `g • s` are (almost) disjoint and that the sum `∑' g, μ (g • s)` is
+sufficiently large. -/
+@[to_additive measure_theory.is_add_fundamental_domain.mk_of_measure_univ_le "
+If a measurable space has a finite measure `μ` and a countable additive group `G` acts
+quasi-measure-preservingly, then to show that a set `s` is a fundamental domain, it is sufficient
+to check that its translates `g +ᵥ s` are (almost) disjoint and that the sum `∑' g, μ (g +ᵥ s)` is
+sufficiently large."]
+lemma mk_of_measure_univ_le [is_finite_measure μ] [countable G]
+  (h_meas : null_measurable_set s μ)
+  (h_ae_disjoint : ∀ g ≠ (1 : G), ae_disjoint μ (g • s) s)
+  (h_qmp : ∀ (g : G), quasi_measure_preserving ((•) g : α → α) μ μ)
+  (h_measure_univ_le : μ (univ : set α) ≤ ∑' (g : G), μ (g • s)) :
+  is_fundamental_domain G s μ :=
+have ae_disjoint : pairwise (ae_disjoint μ on (λ (g : G), g • s)) :=
+  pairwise_ae_disjoint_of_ae_disjoint_forall_ne_one h_ae_disjoint h_qmp,
+{ null_measurable_set := h_meas,
+  ae_disjoint := ae_disjoint,
+  ae_covers :=
+  begin
+    replace h_meas : ∀ (g : G), null_measurable_set (g • s) μ :=
+      λ g, by { rw [← inv_inv g, ← preimage_smul], exact h_meas.preimage (h_qmp g⁻¹), },
+    have h_meas' : null_measurable_set {a | ∃ (g : G), g • a ∈ s} μ,
+    { rw ← Union_smul_eq_set_of_exists, exact null_measurable_set.Union h_meas, },
+    rw [ae_iff_measure_eq h_meas', ← Union_smul_eq_set_of_exists],
+    refine le_antisymm (measure_mono $ subset_univ _) _,
+    rw measure_Union₀ ae_disjoint h_meas,
+    exact h_measure_univ_le,
+  end }
+
 @[to_additive] lemma Union_smul_ae_eq (h : is_fundamental_domain G s μ) :
   (⋃ g : G, g • s) =ᵐ[μ] univ :=
 eventually_eq_univ.2 $ h.ae_covers.mono $ λ x ⟨g, hg⟩, mem_Union.2 ⟨g⁻¹, _, hg, inv_smul_smul _ _⟩
 
 @[to_additive] lemma mono (h : is_fundamental_domain G s μ) {ν : measure α} (hle : ν ≪ μ) :
   is_fundamental_domain G s ν :=
-⟨h.1.mono_ac hle, hle h.2, λ g hg, hle (h.3 g hg)⟩
-
-variables [measurable_space G] [has_measurable_smul G α] [smul_invariant_measure G α μ]
-
-@[to_additive] lemma null_measurable_set_smul (h : is_fundamental_domain G s μ) (g : G) :
-  null_measurable_set (g • s) μ :=
-h.null_measurable_set.smul g
-
-@[to_additive] lemma restrict_restrict (h : is_fundamental_domain G s μ) (g : G) (t : set α) :
-  (μ.restrict t).restrict (g • s) = μ.restrict (g • s ∩ t) :=
-restrict_restrict₀ ((h.null_measurable_set_smul g).mono restrict_le_self)
+⟨h.1.mono_ac hle, hle h.2, h.ae_disjoint.mono $ λ a b hab, hle hab⟩
 
-@[to_additive] lemma pairwise_ae_disjoint (h : is_fundamental_domain G s μ) :
-  pairwise (λ g₁ g₂ : G, ae_disjoint μ (g₁ • s) (g₂ • s)) :=
-λ g₁ g₂ hne,
-calc μ (g₁ • s ∩ g₂ • s) = μ (g₂ • ((g₂⁻¹ * g₁) • s ∩ s)) :
-  by rw [smul_set_inter, smul_smul, mul_inv_cancel_left]
-... = μ ((g₂⁻¹ * g₁) • s ∩ s) : measure_smul_set _ _ _
-... = 0 : h.ae_disjoint _ $ mt inv_mul_eq_one.1 hne.symm
-
-@[to_additive] lemma pairwise_ae_disjoint_of_ac {ν} (h : is_fundamental_domain G s μ) (hν : ν ≪ μ) :
-  pairwise (λ g₁ g₂ : G, ae_disjoint ν (g₁ • s) (g₂ • s)) :=
-h.pairwise_ae_disjoint.mono $ λ g₁ g₂ H, hν H
-
-@[to_additive] lemma preimage_of_equiv (h : is_fundamental_domain G s μ) {f : α → α}
-  (hf : quasi_measure_preserving f μ μ) {e : G → G} (he : bijective e)
+@[to_additive] lemma preimage_of_equiv {ν : measure β} (h : is_fundamental_domain G s μ) {f : β → α}
+  (hf : quasi_measure_preserving f ν μ) {e : G → H} (he : bijective e)
   (hef : ∀ g, semiconj f ((•) (e g)) ((•) g)) :
-  is_fundamental_domain G (f ⁻¹' s) μ :=
+  is_fundamental_domain H (f ⁻¹' s) ν :=
 { null_measurable_set := h.null_measurable_set.preimage hf,
   ae_covers := (hf.ae h.ae_covers).mono $ λ x ⟨g, hg⟩, ⟨e g, by rwa [mem_preimage, hef g x]⟩,
-  ae_disjoint := λ g hg,
+  ae_disjoint := λ a b hab,
     begin
-      lift e to G ≃ G using he,
-      have : (e.symm g⁻¹)⁻¹ ≠ (e.symm 1)⁻¹, by simp [hg],
-      convert (h.pairwise_ae_disjoint _ _ this).preimage hf using 1,
-      { simp only [← preimage_smul_inv, preimage_preimage, ← hef _ _, e.apply_symm_apply,
-          inv_inv] },
-      { ext1 x,
-        simp only [mem_preimage, ← preimage_smul, ← hef _ _, e.apply_symm_apply, one_smul] }
+      lift e to G ≃ H using he,
+      have : (e.symm a⁻¹)⁻¹ ≠ (e.symm b⁻¹)⁻¹, by simp [hab],
+      convert (h.ae_disjoint this).preimage hf using 1,
+      simp only [←preimage_smul_inv, preimage_preimage, ←hef _ _, e.apply_symm_apply, inv_inv],
     end }
 
-@[to_additive] lemma image_of_equiv (h : is_fundamental_domain G s μ)
-  (f : α ≃ᵐ α) (hfμ : measure_preserving f μ μ)
-  (e : equiv.perm G) (hef : ∀ g, semiconj f ((•) (e g)) ((•) g)) :
-  is_fundamental_domain G (f '' s) μ :=
+@[to_additive] lemma image_of_equiv {ν : measure β} (h : is_fundamental_domain G s μ)
+  (f : α ≃ β) (hf : quasi_measure_preserving f.symm ν μ)
+  (e : H ≃ G) (hef : ∀ g, semiconj f ((•) (e g)) ((•) g)) :
+  is_fundamental_domain H (f '' s) ν :=
 begin
   rw f.image_eq_preimage,
-  refine h.preimage_of_equiv (hfμ.symm f).quasi_measure_preserving e.symm.bijective (λ g x, _),
+  refine h.preimage_of_equiv hf e.symm.bijective (λ g x, _),
   rcases f.surjective x with ⟨x, rfl⟩,
   rw [← hef _ _, f.symm_apply_apply, f.symm_apply_apply, e.apply_symm_apply]
 end
 
-@[to_additive] lemma smul (h : is_fundamental_domain G s μ) (g : G) :
-  is_fundamental_domain G (g • s) μ :=
-h.image_of_equiv (measurable_equiv.smul g) (measure_preserving_smul _ _)
-  ⟨λ g', g⁻¹ * g' * g, λ g', g * g' * g⁻¹, λ g', by simp [mul_assoc], λ g', by simp [mul_assoc]⟩ $
-  λ g' x, by simp [smul_smul, mul_assoc]
+@[to_additive] lemma pairwise_ae_disjoint_of_ac {ν} (h : is_fundamental_domain G s μ) (hν : ν ≪ μ) :
+  pairwise (λ g₁ g₂ : G, ae_disjoint ν (g₁ • s) (g₂ • s)) :=
+h.ae_disjoint.mono $ λ g₁ g₂ H, hν H
 
 @[to_additive] lemma smul_of_comm {G' : Type*} [group G'] [mul_action G' α] [measurable_space G']
   [has_measurable_smul G' α] [smul_invariant_measure G' α μ] [smul_comm_class G' G α]
   (h : is_fundamental_domain G s μ) (g : G') :
   is_fundamental_domain G (g • s) μ :=
-h.image_of_equiv (measurable_equiv.smul g) (measure_preserving_smul _ _) (equiv.refl _) $
-  smul_comm g
+h.image_of_equiv (mul_action.to_perm g) (measure_preserving_smul _ _).quasi_measure_preserving
+  (equiv.refl _) $ smul_comm g
+
+variables [measurable_space G] [has_measurable_smul G α] [smul_invariant_measure G α μ]
 
-variables [encodable G] {ν : measure α}
+@[to_additive] lemma null_measurable_set_smul (h : is_fundamental_domain G s μ) (g : G) :
+  null_measurable_set (g • s) μ :=
+h.null_measurable_set.smul g
+
+@[to_additive] lemma restrict_restrict (h : is_fundamental_domain G s μ) (g : G) (t : set α) :
+  (μ.restrict t).restrict (g • s) = μ.restrict (g • s ∩ t) :=
+restrict_restrict₀ ((h.null_measurable_set_smul g).mono restrict_le_self)
+
+@[to_additive] lemma smul (h : is_fundamental_domain G s μ) (g : G) :
+  is_fundamental_domain G (g • s) μ :=
+h.image_of_equiv (mul_action.to_perm g) (measure_preserving_smul _ _).quasi_measure_preserving
+  ⟨λ g', g⁻¹ * g' * g, λ g', g * g' * g⁻¹, λ g', by simp [mul_assoc], λ g', by simp [mul_assoc]⟩ $
+  λ g' x, by simp [smul_smul, mul_assoc]
+
+variables [countable G] {ν : measure α}
 
 @[to_additive] lemma sum_restrict_of_ac (h : is_fundamental_domain G s μ) (hν : ν ≪ μ) :
   sum (λ g : G, ν.restrict (g • s)) = ν :=
-by rw [← restrict_Union_ae (h.pairwise_ae_disjoint.mono $ λ i j h, hν h)
+by rw [← restrict_Union_ae (h.ae_disjoint.mono $ λ i j h, hν h)
     (λ g, (h.null_measurable_set_smul g).mono_ac hν),
   restrict_congr_set (hν h.Union_smul_ae_eq), restrict_univ]
 
@@ -162,18 +204,31 @@ h.sum_restrict_of_ac (refl _)
   ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in g • s, f x ∂μ :=
 h.lintegral_eq_tsum_of_ac (refl _) f
 
-@[to_additive] lemma set_lintegral_eq_tsum' (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞)
+@[to_additive] lemma lintegral_eq_tsum' (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞) :
+  ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in s, f (g⁻¹ • x) ∂μ :=
+calc ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in g • s, f x ∂μ : h.lintegral_eq_tsum f
+... = ∑' g : G, ∫⁻ x in g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
+... = ∑' g : G, ∫⁻ x in s, f (g⁻¹ • x) ∂μ :
+  tsum_congr $ λ g, ((measure_preserving_smul g⁻¹ μ).set_lintegral_comp_emb
+    (measurable_embedding_const_smul _) _ _).symm
+
+
+@[to_additive] lemma lintegral_eq_tsum'' (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞) :
+  ∫⁻ x, f x ∂μ = ∑' g : G, ∫⁻ x in s, f (g • x) ∂μ :=
+(lintegral_eq_tsum' h f).trans ((equiv.inv G).tsum_eq (λ g, ∫⁻ (x : α) in s, f (g • x) ∂μ))
+
+@[to_additive] lemma set_lintegral_eq_tsum (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞)
   (t : set α) : ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :=
 calc ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in g • s, f x ∂(μ.restrict t) :
   h.lintegral_eq_tsum_of_ac restrict_le_self.absolutely_continuous _
 ... = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :
   by simp only [h.restrict_restrict, inter_comm]
 
-@[to_additive] lemma set_lintegral_eq_tsum (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞)
+@[to_additive] lemma set_lintegral_eq_tsum' (h : is_fundamental_domain G s μ) (f : α → ℝ≥0∞)
   (t : set α) :
   ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
 calc ∫⁻ x in t, f x ∂μ = ∑' g : G, ∫⁻ x in t ∩ g • s, f x ∂μ :
-  h.set_lintegral_eq_tsum' f t
+  h.set_lintegral_eq_tsum f t
 ... = ∑' g : G, ∫⁻ x in t ∩ g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
 ... = ∑' g : G, ∫⁻ x in g⁻¹ • (g • t ∩ s), f (x) ∂μ :
   by simp only [smul_set_inter, inv_smul_smul]
@@ -195,19 +250,36 @@ h.measure_eq_tsum_of_ac absolutely_continuous.rfl t
 
 @[to_additive] lemma measure_eq_tsum (h : is_fundamental_domain G s μ) (t : set α) :
   μ t = ∑' g : G, μ (g • t ∩ s) :=
-by simpa only [set_lintegral_one] using h.set_lintegral_eq_tsum (λ _, 1) t
+by simpa only [set_lintegral_one] using h.set_lintegral_eq_tsum' (λ _, 1) t
 
 @[to_additive] lemma measure_zero_of_invariant (h : is_fundamental_domain G s μ) (t : set α)
   (ht : ∀ g : G, g • t = t) (hts : μ (t ∩ s) = 0) :
   μ t = 0 :=
 by simp [measure_eq_tsum h, ht, hts]
 
+/-- Given a measure space with an action of a finite group `G`, the measure of any `G`-invariant set
+is determined by the measure of its intersection with a fundamental domain for the action of `G`. -/
+@[to_additive measure_eq_card_smul_of_vadd_ae_eq_self "Given a measure space with an action of a
+finite additive group `G`, the measure of any `G`-invariant set is determined by the measure of its
+intersection with a fundamental domain for the action of `G`."]
+lemma measure_eq_card_smul_of_smul_ae_eq_self [finite G]
+  (h : is_fundamental_domain G s μ) (t : set α) (ht : ∀ g : G, (g • t : set α) =ᵐ[μ] t) :
+  μ t = nat.card G • μ (t ∩ s) :=
+begin
+  haveI : fintype G := fintype.of_finite G,
+  rw h.measure_eq_tsum,
+  replace ht : ∀ g : G, ((g • t) ∩ s : set α) =ᵐ[μ] (t ∩ s : set α) :=
+    λ g, ae_eq_set_inter (ht g) (ae_eq_refl s),
+  simp_rw [measure_congr (ht _), tsum_fintype, finset.sum_const, nat.card_eq_fintype_card,
+    finset.card_univ],
+end
+
 @[to_additive] protected lemma set_lintegral_eq (hs : is_fundamental_domain G s μ)
   (ht : is_fundamental_domain G t μ) (f : α → ℝ≥0∞) (hf : ∀ (g : G) x, f (g • x) = f x) :
   ∫⁻ x in s, f x ∂μ = ∫⁻ x in t, f x ∂μ :=
-calc ∫⁻ x in s, f x ∂μ = ∑' g : G, ∫⁻ x in s ∩ g • t, f x ∂μ : ht.set_lintegral_eq_tsum' _ _
+calc ∫⁻ x in s, f x ∂μ = ∑' g : G, ∫⁻ x in s ∩ g • t, f x ∂μ : ht.set_lintegral_eq_tsum _ _
 ... = ∑' g : G, ∫⁻ x in g • t ∩ s, f (g⁻¹ • x) ∂μ            : by simp only [hf, inter_comm]
-... = ∫⁻ x in t, f x ∂μ                                      : (hs.set_lintegral_eq_tsum _ _).symm
+... = ∫⁻ x in t, f x ∂μ                                      : (hs.set_lintegral_eq_tsum' _ _).symm
 
 @[to_additive] lemma measure_set_eq (hs : is_fundamental_domain G s μ)
   (ht : is_fundamental_domain G t μ) {A : set α} (hA₀ : measurable_set A)
@@ -230,7 +302,7 @@ protected lemma measure_eq (hs : is_fundamental_domain G s μ)
 by simpa only [set_lintegral_one] using hs.set_lintegral_eq ht (λ _, 1) (λ _ _, rfl)
 
 @[to_additive] protected lemma ae_strongly_measurable_on_iff
-  {β : Type*} [topological_space β] [metrizable_space β]
+  {β : Type*} [topological_space β] [pseudo_metrizable_space β]
   (hs : is_fundamental_domain G s μ) (ht : is_fundamental_domain G t μ) {f : α → β}
   (hf : ∀ (g : G) x, f (g • x) = f x) :
   ae_strongly_measurable f (μ.restrict s) ↔ ae_strongly_measurable f (μ.restrict t) :=
@@ -270,37 +342,96 @@ and_congr (hs.ae_strongly_measurable_on_iff ht hf) (hs.has_finite_integral_on_if
 
 variables [normed_space ℝ E] [complete_space E]
 
+@[to_additive] lemma integral_eq_tsum_of_ac (h : is_fundamental_domain G s μ) (hν : ν ≪ μ)
+  (f : α → E) (hf : integrable f ν) : ∫ x, f x ∂ν = ∑' g : G, ∫ x in g • s, f x ∂ν :=
+begin
+  rw [← measure_theory.integral_sum_measure, h.sum_restrict_of_ac hν],
+  rw h.sum_restrict_of_ac hν, -- Weirdly, these rewrites seem not to be combinable
+  exact hf,
+end
+
+@[to_additive] lemma integral_eq_tsum (h : is_fundamental_domain G s μ)
+  (f : α → E) (hf : integrable f μ) : ∫ x, f x ∂μ = ∑' g : G, ∫ x in g • s, f x ∂μ :=
+integral_eq_tsum_of_ac h (by refl) f hf
+
+@[to_additive] lemma integral_eq_tsum' (h : is_fundamental_domain G s μ)
+  (f : α → E) (hf : integrable f μ) : ∫ x, f x ∂μ = ∑' g : G, ∫ x in s, f (g⁻¹ • x) ∂μ :=
+calc ∫ x, f x ∂μ = ∑' g : G, ∫ x in g • s, f x ∂μ : h.integral_eq_tsum f hf
+... = ∑' g : G, ∫ x in g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
+... = ∑' g : G, ∫ x in s, f (g⁻¹ • x) ∂μ :
+  tsum_congr $ λ g, (measure_preserving_smul g⁻¹ μ).set_integral_image_emb
+    (measurable_embedding_const_smul _) _ _
+
+@[to_additive] lemma integral_eq_tsum'' (h : is_fundamental_domain G s μ)
+  (f : α → E) (hf : integrable f μ) : ∫ x, f x ∂μ = ∑' g : G, ∫ x in s, f (g • x) ∂μ :=
+(integral_eq_tsum' h f hf).trans ((equiv.inv G).tsum_eq (λ g, ∫ (x : α) in s, f (g • x) ∂μ))
+
+@[to_additive] lemma set_integral_eq_tsum (h : is_fundamental_domain G s μ) {f : α → E}
+  {t : set α} (hf : integrable_on f t μ) :
+  ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :=
+calc ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in g • s, f x ∂(μ.restrict t) :
+  h.integral_eq_tsum_of_ac restrict_le_self.absolutely_continuous f hf
+... = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :
+  by simp only [h.restrict_restrict, measure_smul, inter_comm]
+
+@[to_additive] lemma set_integral_eq_tsum' (h : is_fundamental_domain G s μ) {f : α → E}
+  {t : set α} (hf : integrable_on f t μ) :
+  ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :=
+calc ∫ x in t, f x ∂μ = ∑' g : G, ∫ x in t ∩ g • s, f x ∂μ :
+  h.set_integral_eq_tsum hf
+... = ∑' g : G, ∫ x in t ∩ g⁻¹ • s, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
+... = ∑' g : G, ∫ x in g⁻¹ • (g • t ∩ s), f (x) ∂μ :
+  by simp only [smul_set_inter, inv_smul_smul]
+... = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ :
+  tsum_congr $ λ g, (measure_preserving_smul g⁻¹ μ).set_integral_image_emb
+    (measurable_embedding_const_smul _) _ _
+
 @[to_additive] protected lemma set_integral_eq (hs : is_fundamental_domain G s μ)
   (ht : is_fundamental_domain G t μ) {f : α → E} (hf : ∀ (g : G) x, f (g • x) = f x) :
   ∫ x in s, f x ∂μ = ∫ x in t, f x ∂μ :=
 begin
   by_cases hfs : integrable_on f s μ,
   { have hft : integrable_on f t μ, by rwa ht.integrable_on_iff hs hf,
-    have hac : ∀ {u}, μ.restrict u ≪ μ := λ u, restrict_le_self.absolutely_continuous,
-    calc ∫ x in s, f x ∂μ = ∫ x in ⋃ g : G, g • t, f x ∂(μ.restrict s) :
-      by rw [restrict_congr_set (hac ht.Union_smul_ae_eq), restrict_univ]
-    ... = ∑' g : G, ∫ x in g • t, f x ∂(μ.restrict s) :
-      integral_Union_ae (λ g, (ht.null_measurable_set_smul g).mono_ac hac)
-        (ht.pairwise_ae_disjoint_of_ac hac) hfs.integrable.integrable_on
-    ... = ∑' g : G, ∫ x in s ∩ g • t, f x ∂μ :
-      by simp only [ht.restrict_restrict, inter_comm]
-    ... = ∑' g : G, ∫ x in s ∩ g⁻¹ • t, f x ∂μ : ((equiv.inv G).tsum_eq _).symm
-    ... = ∑' g : G, ∫ x in g⁻¹ • (g • s ∩ t), f x ∂μ :
-      by simp only [smul_set_inter, inv_smul_smul]
-    ... = ∑' g : G, ∫ x in g • s ∩ t, f (g⁻¹ • x) ∂μ :
-      tsum_congr $ λ g, (measure_preserving_smul g⁻¹ μ).set_integral_image_emb
-        (measurable_embedding_const_smul _) _ _
-    ... = ∑' g : G, ∫ x in g • s, f x ∂(μ.restrict t) :
-      by simp only [hf, hs.restrict_restrict]
-    ... = ∫ x in ⋃ g : G, g • s, f x ∂(μ.restrict t) :
-      (integral_Union_ae (λ g, (hs.null_measurable_set_smul g).mono_ac hac)
-        (hs.pairwise_ae_disjoint.mono $ λ i j h, hac h) hft.integrable.integrable_on).symm
-    ... = ∫ x in t, f x ∂μ :
-      by rw [restrict_congr_set (hac hs.Union_smul_ae_eq), restrict_univ] },
+    calc ∫ x in s, f x ∂μ = ∑' g : G, ∫ x in s ∩ g • t, f x ∂μ : ht.set_integral_eq_tsum hfs
+    ... = ∑' g : G, ∫ x in g • t ∩ s, f (g⁻¹ • x) ∂μ : by simp only [hf, inter_comm]
+    ... = ∫ x in t, f x ∂μ : (hs.set_integral_eq_tsum' hft).symm, },
   { rw [integral_undef hfs, integral_undef],
     rwa [hs.integrable_on_iff ht hf] at hfs }
 end
 
+/-- If the action of a countable group `G` admits an invariant measure `μ` with a fundamental domain
+`s`, then every null-measurable set `t` such that the sets `g • t ∩ s` are pairwise a.e.-disjoint
+has measure at most `μ s`. -/
+@[to_additive "If the additive action of a countable group `G` admits an invariant measure `μ` with
+a fundamental domain `s`, then every null-measurable set `t` such that the sets `g +ᵥ t ∩ s` are
+pairwise a.e.-disjoint has measure at most `μ s`."]
+ lemma measure_le_of_pairwise_disjoint (hs : is_fundamental_domain G s μ)
+  (ht : null_measurable_set t μ) (hd : pairwise (ae_disjoint μ on (λ g : G, g • t ∩ s))) :
+  μ t ≤ μ s :=
+calc μ t = ∑' g : G, μ (g • t ∩ s) : hs.measure_eq_tsum t
+... = μ (⋃ g : G, g • t ∩ s) : eq.symm $ measure_Union₀ hd $
+  λ g, (ht.smul _).inter hs.null_measurable_set
+... ≤ μ s : measure_mono (Union_subset $ λ g, inter_subset_right _ _)
+
+/-- If the action of a countable group `G` admits an invariant measure `μ` with a fundamental domain
+`s`, then every null-measurable set `t` of measure strictly greater than `μ s` contains two
+points `x y` such that `g • x = y` for some `g ≠ 1`. -/
+@[to_additive "If the additive action of a countable group `G` admits an invariant measure `μ` with
+a fundamental domain `s`, then every null-measurable set `t` of measure strictly greater than `μ s`
+contains two points `x y` such that `g +ᵥ x = y` for some `g ≠ 0`."]
+lemma exists_ne_one_smul_eq (hs : is_fundamental_domain G s μ) (htm : null_measurable_set t μ)
+  (ht : μ s < μ t) : ∃ (x y ∈ t) (g ≠ (1 : G)), g • x = y :=
+begin
+  contrapose! ht,
+  refine hs.measure_le_of_pairwise_disjoint htm (pairwise.ae_disjoint $ λ g₁ g₂ hne, _),
+  dsimp [function.on_fun],
+  refine (disjoint.inf_left _ _).inf_right _,
+  rw set.disjoint_left,
+  rintro _ ⟨x, hx, rfl⟩ ⟨y, hy, hxy⟩,
+  refine ht x hx y hy (g₂⁻¹ * g₁) (mt inv_mul_eq_one.1 hne.symm) _,
+  rw [mul_smul, ← hxy, inv_smul_smul]
+end
+
 /-- If `f` is invariant under the action of a countable group `G`, and `μ` is a `G`-invariant
   measure with a fundamental domain `s`, then the `ess_sup` of `f` restricted to `s` is the same as
   that of `f` on all of its domain. -/
@@ -325,4 +456,140 @@ end
 
 end is_fundamental_domain
 
+/-! ### Interior/frontier of a fundamental domain -/
+
+section measurable_space
+variables (G) [group G] [mul_action G α] (s : set α) {x : α}
+
+/-- The boundary of a fundamental domain, those points of the domain that also lie in a nontrivial
+translate. -/
+@[to_additive measure_theory.add_fundamental_frontier "The boundary of a fundamental domain, those
+points of the domain that also lie in a nontrivial translate."]
+def fundamental_frontier : set α := s ∩ ⋃ (g : G) (hg : g ≠ 1), g • s
+
+/-- The interior of a fundamental domain, those points of the domain not lying in any translate. -/
+@[to_additive measure_theory.add_fundamental_interior "The interior of a fundamental domain, those
+points of the domain not lying in any translate."]
+def fundamental_interior : set α := s \ ⋃ (g : G) (hg : g ≠ 1), g • s
+
+variables {G s}
+
+@[simp, to_additive measure_theory.mem_add_fundamental_frontier]
+lemma mem_fundamental_frontier :
+  x ∈ fundamental_frontier G s ↔ x ∈ s ∧ ∃ (g : G) (hg : g ≠ 1), x ∈ g • s :=
+by simp [fundamental_frontier]
+
+@[simp, to_additive measure_theory.mem_add_fundamental_interior]
+lemma mem_fundamental_interior :
+  x ∈ fundamental_interior G s ↔ x ∈ s ∧ ∀ (g : G) (hg : g ≠ 1), x ∉ g • s :=
+by simp [fundamental_interior]
+
+@[to_additive measure_theory.add_fundamental_frontier_subset]
+lemma fundamental_frontier_subset : fundamental_frontier G s ⊆ s := inter_subset_left _ _
+
+@[to_additive measure_theory.add_fundamental_interior_subset]
+lemma fundamental_interior_subset : fundamental_interior G s ⊆ s := diff_subset _ _
+
+variables (G s)
+
+@[to_additive measure_theory.disjoint_add_fundamental_interior_add_fundamental_frontier]
+lemma disjoint_fundamental_interior_fundamental_frontier :
+  disjoint (fundamental_interior G s) (fundamental_frontier G s) :=
+disjoint_sdiff_self_left.mono_right inf_le_right
+
+@[simp, to_additive measure_theory.add_fundamental_interior_union_add_fundamental_frontier]
+lemma fundamental_interior_union_fundamental_frontier :
+  fundamental_interior G s ∪ fundamental_frontier G s = s :=
+diff_union_inter _ _
+
+@[simp, to_additive measure_theory.add_fundamental_interior_union_add_fundamental_frontier]
+lemma fundamental_frontier_union_fundamental_interior :
+  fundamental_frontier G s ∪ fundamental_interior G s = s :=
+inter_union_diff _ _
+
+@[simp, to_additive measure_theory.sdiff_add_fundamental_interior]
+lemma sdiff_fundamental_interior : s \ fundamental_interior G s = fundamental_frontier G s :=
+sdiff_sdiff_right_self
+
+@[simp, to_additive measure_theory.sdiff_add_fundamental_frontier]
+lemma sdiff_fundamental_frontier : s \ fundamental_frontier G s = fundamental_interior G s :=
+diff_self_inter
+
+@[simp, to_additive measure_theory.add_fundamental_frontier_vadd]
+lemma fundamental_frontier_smul [group H] [mul_action H α] [smul_comm_class H G α] (g : H) :
+  fundamental_frontier G (g • s) = g • fundamental_frontier G s :=
+by simp_rw [fundamental_frontier, smul_set_inter, smul_set_Union, smul_comm g]
+
+@[simp, to_additive measure_theory.add_fundamental_interior_vadd]
+lemma fundamental_interior_smul [group H] [mul_action H α] [smul_comm_class H G α] (g : H) :
+  fundamental_interior G (g • s) = g • fundamental_interior G s :=
+by simp_rw [fundamental_interior, smul_set_sdiff, smul_set_Union, smul_comm g]
+
+@[to_additive measure_theory.pairwise_disjoint_add_fundamental_interior]
+lemma pairwise_disjoint_fundamental_interior :
+  pairwise (disjoint on λ g : G, g • fundamental_interior G s) :=
+begin
+  refine λ a b hab, disjoint_left.2 _,
+  rintro _ ⟨x, hx, rfl⟩ ⟨y, hy, hxy⟩,
+  rw mem_fundamental_interior at hx hy,
+  refine hx.2 (a⁻¹ * b) _ _,
+  rwa [ne.def, inv_mul_eq_iff_eq_mul, mul_one, eq_comm],
+  simpa [mul_smul, ←hxy, mem_inv_smul_set_iff] using hy.1,
+end
+
+variables [countable G] [measurable_space G] [measurable_space α] [has_measurable_smul G α]
+  {μ : measure α} [smul_invariant_measure G α μ]
+
+@[to_additive measure_theory.null_measurable_set.add_fundamental_frontier]
+protected lemma null_measurable_set.fundamental_frontier (hs : null_measurable_set s μ) :
+  null_measurable_set (fundamental_frontier G s) μ :=
+hs.inter $ null_measurable_set.Union $ λ g, null_measurable_set.Union $ λ hg, hs.smul _
+
+@[to_additive measure_theory.null_measurable_set.add_fundamental_interior]
+protected lemma null_measurable_set.fundamental_interior (hs : null_measurable_set s μ) :
+  null_measurable_set (fundamental_interior G s) μ :=
+hs.diff $ null_measurable_set.Union $ λ g, null_measurable_set.Union $ λ hg, hs.smul _
+
+end measurable_space
+
+namespace is_fundamental_domain
+section group
+variables [countable G] [group G] [mul_action G α] [measurable_space α] {μ : measure α} {s : set α}
+  (hs : is_fundamental_domain G s μ)
+include hs
+
+@[to_additive measure_theory.is_add_fundamental_domain.measure_add_fundamental_frontier]
+lemma measure_fundamental_frontier : μ (fundamental_frontier G s) = 0 :=
+by simpa only [fundamental_frontier, Union₂_inter, measure_Union_null_iff', one_smul,
+  measure_Union_null_iff, inter_comm s, function.on_fun] using λ g (hg : g ≠ 1), hs.ae_disjoint hg
+
+@[to_additive measure_theory.is_add_fundamental_domain.measure_add_fundamental_interior]
+lemma measure_fundamental_interior : μ (fundamental_interior G s) = μ s :=
+measure_diff_null' hs.measure_fundamental_frontier
+
+end group
+
+variables [countable G] [group G] [mul_action G α] [measurable_space α] {μ : measure α} {s : set α}
+  (hs : is_fundamental_domain G s μ) [measurable_space G] [has_measurable_smul G α]
+  [smul_invariant_measure G α μ]
+include hs
+
+protected lemma fundamental_interior : is_fundamental_domain G (fundamental_interior G s) μ :=
+{ null_measurable_set := hs.null_measurable_set.fundamental_interior _ _,
+  ae_covers := begin
+    simp_rw [ae_iff, not_exists, ←mem_inv_smul_set_iff, set_of_forall, ←compl_set_of, set_of_mem_eq,
+      ←compl_Union],
+    have : (⋃ g : G, g⁻¹ • s) \ (⋃ g : G, g⁻¹ • fundamental_frontier G s) ⊆
+      ⋃ g : G, g⁻¹ • fundamental_interior G s,
+    { simp_rw [diff_subset_iff, ←Union_union_distrib, ←smul_set_union,
+        fundamental_frontier_union_fundamental_interior] },
+    refine eq_bot_mono (μ.mono $ compl_subset_compl.2 this) _,
+    simp only [Union_inv_smul, outer_measure.measure_of_eq_coe, coe_to_outer_measure, compl_sdiff,
+      ennreal.bot_eq_zero, himp_eq, sup_eq_union, @Union_smul_eq_set_of_exists _ _ _ _ s],
+    exact measure_union_null
+      (measure_Union_null $ λ _, measure_smul_null hs.measure_fundamental_frontier _) hs.ae_covers,
+  end,
+  ae_disjoint := (pairwise_disjoint_fundamental_interior _ _).mono $ λ _ _, disjoint.ae_disjoint }
+
+end is_fundamental_domain
 end measure_theory
diff --git a/src/measure_theory/group/geometry_of_numbers.lean b/src/measure_theory/group/geometry_of_numbers.lean
new file mode 100644
index 0000000000000..63dea545779a2
--- /dev/null
+++ b/src/measure_theory/group/geometry_of_numbers.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2021 Alex J. Best. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alex J. Best
+-/
+import analysis.convex.measure
+import measure_theory.group.fundamental_domain
+import measure_theory.measure.lebesgue.eq_haar
+
+/-!
+# Geometry of numbers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove some of the fundamental theorems in the geometry of numbers, as studied by
+Hermann Minkowski.
+
+## Main results
+
+* `exists_pair_mem_lattice_not_disjoint_vadd`: Blichfeldt's principle, existence of two distinct
+  points in a subgroup such that the translates of a set by these two points are not disjoint when
+  the covolume of the subgroup is larger than the volume of the
+* `exists_ne_zero_mem_lattice_of_measure_mul_two_pow_lt_measure`: Minkowski's theorem, existence of
+  a non-zero lattice point inside a convex symmetric domain of large enough volume.
+
+## TODO
+
+* Calculate the volume of the fundamental domain of a finite index subgroup
+* Voronoi diagrams
+* See [Pete L. Clark, *Abstract Geometry of Numbers: Linear Forms* (arXiv)](https://arxiv.org/abs/1405.2119)
+  for some more ideas.
+
+## References
+
+* [Pete L. Clark, *Geometry of Numbers with Applications to Number Theory*][clark_gon] p.28
+-/
+
+namespace measure_theory
+
+open ennreal finite_dimensional measure_theory measure_theory.measure set
+open_locale pointwise
+
+variables {E L : Type*} [measurable_space E] {μ : measure E} {F s : set E}
+
+/-- **Blichfeldt's Theorem**. If the volume of the set `s` is larger than the covolume of the
+countable subgroup `L` of `E`, then there exists two distincts points `x, y ∈ L` such that `(x + s)`
+and `(y + s)` are not disjoint. -/
+lemma exists_pair_mem_lattice_not_disjoint_vadd [add_comm_group L] [countable L]
+  [add_action L E] [measurable_space L] [has_measurable_vadd L E] [vadd_invariant_measure L E μ]
+  (fund : is_add_fundamental_domain L F μ) (hS : null_measurable_set s μ) (h : μ F < μ s) :
+  ∃ x y : L, x ≠ y ∧ ¬ disjoint (x +ᵥ s) (y +ᵥ s) :=
+begin
+  contrapose! h,
+  exact ((fund.measure_eq_tsum _).trans (measure_Union₀ (pairwise.mono h $ λ i j hij,
+    (hij.mono inf_le_left inf_le_left).ae_disjoint) $ λ _,
+    (hS.vadd _).inter fund.null_measurable_set).symm).trans_le
+    (measure_mono $ Union_subset $ λ _, inter_subset_right _ _),
+end
+
+/-- The **Minkowksi Convex Body Theorem**. If `s` is a convex symmetric domain of `E` whose volume
+is large enough compared to the covolume of a lattice `L` of `E`, then it contains a non-zero
+lattice point of `L`.  -/
+lemma exists_ne_zero_mem_lattice_of_measure_mul_two_pow_lt_measure [normed_add_comm_group E]
+  [normed_space ℝ E] [borel_space E] [finite_dimensional ℝ E] [is_add_haar_measure μ]
+  {L : add_subgroup E} [countable L] (fund : is_add_fundamental_domain L F μ)
+  (h : μ F * 2 ^ finrank ℝ E < μ s) (h_symm : ∀ x ∈ s, -x ∈ s) (h_conv : convex ℝ s) :
+  ∃ x ≠ 0, ((x : L) : E) ∈ s :=
+begin
+  have h_vol : μ F < μ ((2⁻¹ : ℝ) • s),
+  { rwa [add_haar_smul_of_nonneg μ (by norm_num : 0 ≤ (2 : ℝ)⁻¹) s, ←mul_lt_mul_right
+      (pow_ne_zero (finrank ℝ E) (two_ne_zero' _)) (pow_ne_top two_ne_top), mul_right_comm,
+      of_real_pow (by norm_num : 0 ≤ (2 : ℝ)⁻¹), ←of_real_inv_of_pos zero_lt_two, of_real_bit0,
+      of_real_one, ←mul_pow, ennreal.inv_mul_cancel two_ne_zero two_ne_top, one_pow, one_mul] },
+  obtain ⟨x, y, hxy, h⟩ := exists_pair_mem_lattice_not_disjoint_vadd fund
+    ((h_conv.smul _).null_measurable_set _) h_vol,
+  obtain ⟨_, ⟨v, hv, rfl⟩, w, hw, hvw⟩ := not_disjoint_iff.mp h,
+  refine ⟨x - y, sub_ne_zero.2 hxy, _⟩,
+  rw mem_inv_smul_set_iff₀ (two_ne_zero' ℝ) at hv hw,
+  simp_rw [add_subgroup.vadd_def, vadd_eq_add, add_comm _ w, ←sub_eq_sub_iff_add_eq_add,
+    ←add_subgroup.coe_sub] at hvw,
+  rw [←hvw, ←inv_smul_smul₀ (two_ne_zero' ℝ) (_ - _), smul_sub, sub_eq_add_neg, smul_add],
+  refine h_conv hw (h_symm _ hv) _ _ _; norm_num,
+end
+
+end measure_theory
diff --git a/src/measure_theory/group/integration.lean b/src/measure_theory/group/integration.lean
index 1143a97806c65..258cf46be347d 100644
--- a/src/measure_theory/group/integration.lean
+++ b/src/measure_theory/group/integration.lean
@@ -10,6 +10,9 @@ import measure_theory.group.action
 /-!
 # Integration on Groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We develop properties of integrals with a group as domain.
 This file contains properties about integrability, Lebesgue integration and Bochner integration.
 -/
@@ -20,7 +23,7 @@ open measure topological_space
 open_locale ennreal
 
 variables {𝕜 M α G E F : Type*} [measurable_space G]
-variables [normed_group E] [normed_space ℝ E] [complete_space E] [normed_group F]
+variables [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] [normed_add_comm_group F]
 variables {μ : measure G} {f : G → E} {g : G}
 
 section measurable_inv
@@ -140,15 +143,7 @@ variables [has_measurable_inv G]
 lemma integrable.comp_div_left {f : G → F}
   [is_inv_invariant μ] [is_mul_left_invariant μ] (hf : integrable f μ) (g : G) :
   integrable (λ t, f (g / t)) μ :=
-begin
-  rw [← map_mul_right_inv_eq_self μ g⁻¹, integrable_map_measure, function.comp],
-  { simp_rw [div_inv_eq_mul, mul_inv_cancel_left], exact hf },
-  { refine ae_strongly_measurable.comp_measurable _ (measurable_id.const_div g),
-    simp_rw [map_map (measurable_id'.const_div g) (measurable_id'.const_mul g⁻¹).inv,
-      function.comp, div_inv_eq_mul, mul_inv_cancel_left, map_id'],
-    exact hf.ae_strongly_measurable },
-  { exact (measurable_id'.const_mul g⁻¹).inv.ae_measurable }
-end
+((measure_preserving_div_left μ g).integrable_comp hf.ae_strongly_measurable).mpr hf
 
 @[simp, to_additive]
 lemma integrable_comp_div_left (f : G → F)
@@ -183,7 +178,6 @@ end
 
 end smul
 
-
 section topological_group
 
 variables [topological_space G] [group G] [topological_group G] [borel_space G]
diff --git a/src/measure_theory/group/measurable_equiv.lean b/src/measure_theory/group/measurable_equiv.lean
index 4fda5629527a0..baa7f9a11cbb4 100644
--- a/src/measure_theory/group/measurable_equiv.lean
+++ b/src/measure_theory/group/measurable_equiv.lean
@@ -8,6 +8,9 @@ import measure_theory.group.arithmetic
 /-!
 # (Scalar) multiplication and (vector) addition as measurable equivalences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the following measurable equivalences:
 
 * `measurable_equiv.smul`: if a group `G` acts on `α` by measurable maps, then each element `c : G`
diff --git a/src/measure_theory/group/measure.lean b/src/measure_theory/group/measure.lean
index 16c0670da6b6d..5207c9ebdc00f 100644
--- a/src/measure_theory/group/measure.lean
+++ b/src/measure_theory/group/measure.lean
@@ -7,10 +7,16 @@ import dynamics.ergodic.measure_preserving
 import measure_theory.measure.regular
 import measure_theory.group.measurable_equiv
 import measure_theory.measure.open_pos
+import measure_theory.group.action
+import measure_theory.constructions.prod.basic
+import topology.continuous_function.cocompact_map
 
 /-!
 # Measures on Groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We develop some properties of measures on (topological) groups
 
 * We define properties on measures: measures that are left or right invariant w.r.t. multiplication.
@@ -24,10 +30,10 @@ We also give analogues of all these notions in the additive world.
 
 noncomputable theory
 
-open_locale ennreal pointwise big_operators
-open has_inv set function measure_theory.measure
+open_locale nnreal ennreal pointwise big_operators topology
+open has_inv set function measure_theory.measure filter
 
-variables {G : Type*} [measurable_space G]
+variables {𝕜 G H : Type*} [measurable_space G] [measurable_space H]
 
 namespace measure_theory
 namespace measure
@@ -67,13 +73,25 @@ is_mul_left_invariant.map_mul_left_eq_self g
 lemma map_mul_right_eq_self (μ : measure G) [is_mul_right_invariant μ] (g : G) : map (* g) μ = μ :=
 is_mul_right_invariant.map_mul_right_eq_self g
 
-@[to_additive]
-instance [is_mul_left_invariant μ] (c : ℝ≥0∞) : is_mul_left_invariant (c • μ) :=
-⟨λ g, by rw [map_smul, map_mul_left_eq_self]⟩
+@[to_additive measure_theory.is_add_left_invariant_smul]
+instance is_mul_left_invariant_smul [is_mul_left_invariant μ] (c : ℝ≥0∞) :
+  is_mul_left_invariant (c • μ) :=
+⟨λ g, by rw [measure.map_smul, map_mul_left_eq_self]⟩
 
-@[to_additive]
-instance [is_mul_right_invariant μ] (c : ℝ≥0∞) : is_mul_right_invariant (c • μ) :=
-⟨λ g, by rw [map_smul, map_mul_right_eq_self]⟩
+@[to_additive measure_theory.is_add_right_invariant_smul]
+instance is_mul_right_invariant_smul [is_mul_right_invariant μ] (c : ℝ≥0∞) :
+  is_mul_right_invariant (c • μ) :=
+⟨λ g, by rw [measure.map_smul, map_mul_right_eq_self]⟩
+
+@[to_additive measure_theory.is_add_left_invariant_smul_nnreal]
+instance is_mul_left_invariant_smul_nnreal [is_mul_left_invariant μ] (c : ℝ≥0) :
+  is_mul_left_invariant (c • μ) :=
+measure_theory.is_mul_left_invariant_smul (c : ℝ≥0∞)
+
+@[to_additive measure_theory.is_add_right_invariant_smul_nnreal]
+instance is_mul_right_invariant_smul_nnreal [is_mul_right_invariant μ] (c : ℝ≥0) :
+  is_mul_right_invariant (c • μ) :=
+measure_theory.is_mul_right_invariant_smul (c : ℝ≥0∞)
 
 section has_measurable_mul
 
@@ -84,11 +102,40 @@ lemma measure_preserving_mul_left (μ : measure G) [is_mul_left_invariant μ] (g
   measure_preserving ((*) g) μ μ :=
 ⟨measurable_const_mul g, map_mul_left_eq_self μ g⟩
 
+@[to_additive]
+lemma measure_preserving.mul_left (μ : measure G) [is_mul_left_invariant μ] (g : G)
+  {X : Type*} [measurable_space X] {μ' : measure X} {f : X → G} (hf : measure_preserving f μ' μ) :
+  measure_preserving (λ x, g * f x) μ' μ :=
+(measure_preserving_mul_left μ g).comp hf
+
 @[to_additive]
 lemma measure_preserving_mul_right (μ : measure G) [is_mul_right_invariant μ] (g : G) :
   measure_preserving (* g) μ μ :=
 ⟨measurable_mul_const g, map_mul_right_eq_self μ g⟩
 
+@[to_additive]
+lemma measure_preserving.mul_right (μ : measure G) [is_mul_right_invariant μ] (g : G)
+  {X : Type*} [measurable_space X] {μ' : measure X} {f : X → G} (hf : measure_preserving f μ' μ) :
+  measure_preserving (λ x, f x * g) μ' μ :=
+(measure_preserving_mul_right μ g).comp hf
+
+@[to_additive]
+instance is_mul_left_invariant.smul_invariant_measure [is_mul_left_invariant μ] :
+  smul_invariant_measure G G μ :=
+⟨λ x s hs, (measure_preserving_mul_left μ x).measure_preimage hs⟩
+
+@[to_additive]
+instance is_mul_right_invariant.to_smul_invariant_measure_op [μ.is_mul_right_invariant] :
+  smul_invariant_measure Gᵐᵒᵖ G μ :=
+⟨λ x s hs, (measure_preserving_mul_right μ (mul_opposite.unop x)).measure_preimage hs⟩
+
+@[to_additive]
+instance subgroup.smul_invariant_measure
+  {G α : Type*} [group G] [mul_action G α] [measurable_space α]
+  {μ : measure α} [smul_invariant_measure G α μ] (H : subgroup G) :
+  smul_invariant_measure H α μ :=
+⟨λ y s hs, by convert smul_invariant_measure.measure_preimage_smul μ (y : G) hs⟩
+
 /-- An alternative way to prove that `μ` is left invariant under multiplication. -/
 @[to_additive /-" An alternative way to prove that `μ` is left invariant under addition. "-/]
 lemma forall_measure_preimage_mul_iff (μ : measure G) :
@@ -115,21 +162,74 @@ begin
   exact ⟨λ h, ⟨h⟩, λ h, h.1⟩
 end
 
+@[to_additive]
+instance [is_mul_left_invariant μ] [sigma_finite μ] {H : Type*} [has_mul H]
+  {mH : measurable_space H} {ν : measure H} [has_measurable_mul H]
+  [is_mul_left_invariant ν] [sigma_finite ν] :
+  is_mul_left_invariant (μ.prod ν) :=
+begin
+  constructor,
+  rintros ⟨g, h⟩,
+  change map (prod.map ((*) g) ((*) h)) (μ.prod ν) = μ.prod ν,
+  rw [← map_prod_map _ _ (measurable_const_mul g) (measurable_const_mul h),
+    map_mul_left_eq_self μ g, map_mul_left_eq_self ν h],
+  { rw map_mul_left_eq_self μ g, apply_instance },
+  { rw map_mul_left_eq_self ν h, apply_instance },
+end
+
+@[to_additive]
+instance [is_mul_right_invariant μ] [sigma_finite μ] {H : Type*} [has_mul H]
+  {mH : measurable_space H} {ν : measure H} [has_measurable_mul H]
+  [is_mul_right_invariant ν] [sigma_finite ν] :
+  is_mul_right_invariant (μ.prod ν) :=
+begin
+  constructor,
+  rintros ⟨g, h⟩,
+  change map (prod.map (* g) (* h)) (μ.prod ν) = μ.prod ν,
+  rw [← map_prod_map _ _ (measurable_mul_const g) (measurable_mul_const h),
+    map_mul_right_eq_self μ g, map_mul_right_eq_self ν h],
+  { rw map_mul_right_eq_self μ g, apply_instance },
+  { rw map_mul_right_eq_self ν h, apply_instance },
+end
+
+@[to_additive]
+lemma is_mul_left_invariant_map {H : Type*}
+  [measurable_space H] [has_mul H] [has_measurable_mul H]
+  [is_mul_left_invariant μ]
+  (f : G →ₙ* H) (hf : measurable f) (h_surj : surjective f) :
+  is_mul_left_invariant (measure.map f μ) :=
+begin
+  refine ⟨λ h, _⟩,
+  rw map_map (measurable_const_mul _) hf,
+  obtain ⟨g, rfl⟩ := h_surj h,
+  conv_rhs { rw ← map_mul_left_eq_self μ g },
+  rw map_map hf (measurable_const_mul _),
+  congr' 2,
+  ext y,
+  simp only [comp_app, map_mul],
+end
+
 end has_measurable_mul
 
 end mul
 
-section group
-
-variables [group G]
+section div_inv_monoid
+variables [div_inv_monoid G]
 
 @[to_additive]
 lemma map_div_right_eq_self (μ : measure G) [is_mul_right_invariant μ] (g : G) :
   map (/ g) μ = μ :=
 by simp_rw [div_eq_mul_inv, map_mul_right_eq_self μ g⁻¹]
 
+end div_inv_monoid
 
-variables [has_measurable_mul G]
+section group
+variables [group G] [has_measurable_mul G]
+
+@[to_additive]
+lemma measure_preserving_div_right (μ : measure G) [is_mul_right_invariant μ]
+  (g : G) : measure_preserving (/ g) μ μ :=
+by simp_rw [div_eq_mul_inv, measure_preserving_mul_right μ g⁻¹]
 
 /-- We shorten this from `measure_preimage_mul_left`, since left invariant is the preferred option
   for measures in this formalization. -/
@@ -163,6 +263,21 @@ lemma map_div_right_ae (μ : measure G) [is_mul_right_invariant μ] (x : G) :
   filter.map (λ t, t / x) μ.ae = μ.ae :=
 ((measurable_equiv.div_right x).map_ae μ).trans $ congr_arg ae $ map_div_right_eq_self μ x
 
+@[to_additive]
+lemma eventually_mul_left_iff (μ : measure G) [is_mul_left_invariant μ] (t : G) {p : G → Prop} :
+  (∀ᵐ x ∂μ, p (t * x)) ↔ ∀ᵐ x ∂μ, p x :=
+by { conv_rhs { rw [filter.eventually, ← map_mul_left_ae μ t] }, refl }
+
+@[to_additive]
+lemma eventually_mul_right_iff (μ : measure G) [is_mul_right_invariant μ] (t : G) {p : G → Prop} :
+  (∀ᵐ x ∂μ, p (x * t)) ↔ ∀ᵐ x ∂μ, p x :=
+by { conv_rhs { rw [filter.eventually, ← map_mul_right_ae μ t] }, refl }
+
+@[to_additive]
+lemma eventually_div_right_iff (μ : measure G) [is_mul_right_invariant μ] (t : G) {p : G → Prop} :
+  (∀ᵐ x ∂μ, p (x / t)) ↔ ∀ᵐ x ∂μ, p x :=
+by { conv_rhs { rw [filter.eventually, ← map_div_right_ae μ t] }, refl }
+
 end group
 
 namespace measure
@@ -194,6 +309,13 @@ is_inv_invariant.inv_eq_self
 lemma map_inv_eq_self (μ : measure G) [is_inv_invariant μ] : map has_inv.inv μ = μ :=
 is_inv_invariant.inv_eq_self
 
+variables [has_measurable_inv G]
+
+@[to_additive]
+lemma measure_preserving_inv (μ : measure G) [is_inv_invariant μ] :
+  measure_preserving has_inv.inv μ μ :=
+⟨measurable_inv, map_inv_eq_self μ⟩
+
 end inv
 
 section has_involutive_inv
@@ -223,8 +345,8 @@ instance (μ : measure G) [sigma_finite μ] : sigma_finite μ.inv :=
 
 end has_involutive_inv
 
-section mul_inv
-variables [group G] [has_measurable_mul G] [has_measurable_inv G] {μ : measure G}
+section division_monoid
+variables [division_monoid G] [has_measurable_mul G] [has_measurable_inv G] {μ : measure G}
 
 @[to_additive]
 instance [is_mul_left_invariant μ] : is_mul_right_invariant μ.inv :=
@@ -247,40 +369,53 @@ begin
 end
 
 @[to_additive]
-lemma map_div_left_eq_self (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ] (g : G) :
-  map (λ t, g / t) μ = μ :=
+lemma measure_preserving_div_left (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ]
+  (g : G) : measure_preserving (λ t, g / t) μ μ :=
 begin
   simp_rw [div_eq_mul_inv],
-  conv_rhs { rw [← map_mul_left_eq_self μ g, ← map_inv_eq_self μ] },
-  exact (map_map (measurable_const_mul g) measurable_inv).symm
+  exact (measure_preserving_mul_left μ g).comp (measure_preserving_inv μ)
 end
 
+@[to_additive]
+lemma map_div_left_eq_self (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ] (g : G) :
+  map (λ t, g / t) μ = μ :=
+(measure_preserving_div_left μ g).map_eq
+
+@[to_additive]
+lemma measure_preserving_mul_right_inv (μ : measure G)
+  [is_inv_invariant μ] [is_mul_left_invariant μ] (g : G) :
+  measure_preserving (λ t, (g * t)⁻¹) μ μ :=
+(measure_preserving_inv μ).comp $ measure_preserving_mul_left μ g
+
 @[to_additive]
 lemma map_mul_right_inv_eq_self (μ : measure G) [is_inv_invariant μ] [is_mul_left_invariant μ]
   (g : G) : map (λ t, (g * t)⁻¹) μ = μ :=
-begin
-  conv_rhs { rw [← map_inv_eq_self μ, ← map_mul_left_eq_self μ g] },
-  exact (map_map measurable_inv (measurable_const_mul g)).symm
-end
+(measure_preserving_mul_right_inv μ g).map_eq
+
+end division_monoid
+
+section group
+variables [group G] [has_measurable_mul G] [has_measurable_inv G] {μ : measure G}
 
 @[to_additive]
 lemma map_div_left_ae (μ : measure G) [is_mul_left_invariant μ] [is_inv_invariant μ] (x : G) :
   filter.map (λ t, x / t) μ.ae = μ.ae :=
 ((measurable_equiv.div_left x).map_ae μ).trans $ congr_arg ae $ map_div_left_eq_self μ x
 
-end mul_inv
+end group
 
 end measure
 
 section topological_group
 
-variables [topological_space G] [borel_space G] {μ : measure G}
-variables [group G] [topological_group G]
+variables [topological_space G] [borel_space G] {μ : measure G} [group G]
 
 @[to_additive]
-instance measure.regular.inv [t2_space G] [regular μ] : regular μ.inv :=
+instance measure.regular.inv [has_continuous_inv G] [t2_space G] [regular μ] : regular μ.inv :=
 regular.map (homeomorph.inv G)
 
+variables [topological_group G]
+
 @[to_additive]
 lemma regular_inv_iff [t2_space G] : μ.inv.regular ↔ μ.regular :=
 begin
@@ -331,7 +466,7 @@ end
 lemma measure_ne_zero_iff_nonempty_of_is_mul_left_invariant [regular μ]
   (hμ : μ ≠ 0) {s : set G} (hs : is_open s) :
   μ s ≠ 0 ↔ s.nonempty :=
-by simpa [null_iff_of_is_mul_left_invariant hs, hμ] using ne_empty_iff_nonempty
+by simpa [null_iff_of_is_mul_left_invariant hs, hμ] using nonempty_iff_ne_empty.symm
 
 @[to_additive]
 lemma measure_pos_iff_nonempty_of_is_mul_left_invariant [regular μ]
@@ -353,7 +488,7 @@ begin
   calc μ K ≤ μ (⋃ (g : G) (H : g ∈ t), (λ (h : G), g * h) ⁻¹' U) : measure_mono hKt
   ... ≤ ∑ g in t, μ ((λ (h : G), g * h) ⁻¹' U) : measure_bUnion_finset_le _ _
   ... = finset.card t * μ U : by simp only [measure_preimage_mul, finset.sum_const, nsmul_eq_mul]
-  ... < ∞ : ennreal.mul_lt_top ennreal.coe_nat_ne_top h
+  ... < ∞ : ennreal.mul_lt_top (ennreal.nat_ne_top _) h
 end
 
 /-- If a left-invariant measure gives finite mass to a set with nonempty interior, then
@@ -366,24 +501,78 @@ lemma measure_lt_top_of_is_compact_of_is_mul_left_invariant'
 measure_lt_top_of_is_compact_of_is_mul_left_invariant (interior U) is_open_interior hU
   ((measure_mono (interior_subset)).trans_lt (lt_top_iff_ne_top.2 h)).ne hK
 
+/-- In a noncompact locally compact group, a left-invariant measure which is positive
+on open sets has infinite mass. -/
+@[simp, to_additive "In a noncompact locally compact additive group, a left-invariant measure which
+is positive on open sets has infinite mass."]
+lemma measure_univ_of_is_mul_left_invariant [locally_compact_space G] [noncompact_space G]
+  (μ : measure G) [is_open_pos_measure μ] [μ.is_mul_left_invariant] :
+  μ univ = ∞ :=
+begin
+  /- Consider a closed compact set `K` with nonempty interior. For any compact set `L`, one may
+  find `g = g (L)` such that `L` is disjoint from `g • K`. Iterating this, one finds
+  infinitely many translates of `K` which are disjoint from each other. As they all have the
+  same positive mass, it follows that the space has infinite measure. -/
+  obtain ⟨K, hK, Kclosed, Kint⟩ : ∃ (K : set G), is_compact K ∧ is_closed K ∧ (1 : G) ∈ interior K,
+  { rcases local_is_compact_is_closed_nhds_of_group (is_open_univ.mem_nhds (mem_univ (1 : G)))
+      with ⟨K, hK⟩,
+    exact ⟨K, hK.1, hK.2.1, hK.2.2.2⟩, },
+  have K_pos : 0 < μ K, from measure_pos_of_nonempty_interior _ ⟨_, Kint⟩,
+  have A : ∀ (L : set G), is_compact L → ∃ (g : G), disjoint L (g • K),
+    from λ L hL, exists_disjoint_smul_of_is_compact hL hK,
+  choose! g hg using A,
+  set L : ℕ → set G := λ n, (λ T, T ∪ (g T • K))^[n] K with hL,
+  have Lcompact : ∀ n, is_compact (L n),
+  { assume n,
+    induction n with n IH,
+    { exact hK },
+    { simp_rw [hL, iterate_succ'],
+      apply is_compact.union IH (hK.smul (g (L n))) } },
+  have Lclosed : ∀ n, is_closed (L n),
+  { assume n,
+    induction n with n IH,
+    { exact Kclosed },
+    { simp_rw [hL, iterate_succ'],
+      apply is_closed.union IH (Kclosed.smul (g (L n))) } },
+  have M : ∀ n, μ (L n) = (n + 1 : ℕ) * μ K,
+  { assume n,
+    induction n with n IH,
+    { simp only [L, one_mul, algebra_map.coe_one, iterate_zero, id.def] },
+    { calc μ (L (n + 1)) = μ (L n) + μ (g (L n) • K) :
+        begin
+          simp_rw [hL, iterate_succ'],
+          exact measure_union' (hg _ (Lcompact _)) (Lclosed _).measurable_set
+        end
+      ... = ((n + 1) + 1 : ℕ) * μ K :
+        by simp only [IH, measure_smul, add_mul, nat.cast_add, algebra_map.coe_one, one_mul] } },
+  have N : tendsto (λ n, μ (L n)) at_top (𝓝 (∞ * μ K)),
+  { simp_rw [M],
+    apply ennreal.tendsto.mul_const _ (or.inl ennreal.top_ne_zero),
+    exact ennreal.tendsto_nat_nhds_top.comp (tendsto_add_at_top_nat _) },
+  simp only [ennreal.top_mul, K_pos.ne', if_false] at N,
+  apply top_le_iff.1,
+  exact le_of_tendsto' N (λ n, measure_mono (subset_univ _)),
+end
+
 end topological_group
 
-section comm_group
+section comm_semigroup
 
-variables [comm_group G]
+variables [comm_semigroup G]
 
 /-- In an abelian group every left invariant measure is also right-invariant.
   We don't declare the converse as an instance, since that would loop type-class inference, and
-  we use `is_mul_left_invariant` as default hypotheses in abelian groups. -/
-@[priority 100, to_additive "In an abelian additive group every left invariant measure is also
-right-invariant. We don't declare the converse as an instance, since that would loop type-class
-inference, and we use `is_add_left_invariant` as default hypotheses in abelian groups."]
+  we use `is_mul_left_invariant` as the default hypothesis in abelian groups. -/
+@[priority 100, to_additive is_add_left_invariant.is_add_right_invariant "In an abelian additive
+group every left invariant measure is also right-invariant. We don't declare the converse as an
+instance, since that would loop type-class inference, and we use `is_add_left_invariant` as the
+default hypothesis in abelian groups."]
 instance is_mul_left_invariant.is_mul_right_invariant {μ : measure G} [is_mul_left_invariant μ] :
   is_mul_right_invariant μ :=
 ⟨λ g, by simp_rw [mul_comm, map_mul_left_eq_self]⟩
 
 
-end comm_group
+end comm_semigroup
 
 section haar
 
@@ -449,32 +638,34 @@ lemma is_haar_measure_of_is_compact_nonempty_interior [topological_group G] [bor
     λ L hL, measure_lt_top_of_is_compact_of_is_mul_left_invariant' h'K h' hL,
   to_is_open_pos_measure := is_open_pos_measure_of_mul_left_invariant_of_compact K hK h }
 
-/-- The image of a Haar measure under a group homomorphism which is also a homeomorphism is again
-a Haar measure. -/
-@[to_additive "The image of an additive Haar measure under an additive group homomorphism which is
-also a homeomorphism is again an additive Haar measure."]
+/-- The image of a Haar measure under a continuous surjective proper group homomorphism is again
+a Haar measure. See also `mul_equiv.is_haar_measure_map`. -/
+@[to_additive "The image of an additive Haar measure under a continuous surjective proper additive
+group homomorphism is again an additive Haar measure. See also
+`add_equiv.is_add_haar_measure_map`."]
 lemma is_haar_measure_map [borel_space G] [topological_group G] {H : Type*} [group H]
   [topological_space H] [measurable_space H] [borel_space H] [t2_space H] [topological_group H]
-  (f : G ≃* H) (hf : continuous f) (hfsymm : continuous f.symm) :
+  (f : G →* H) (hf : continuous f) (h_surj : surjective f)
+  (h_prop : tendsto f (cocompact G) (cocompact H)) :
   is_haar_measure (measure.map f μ) :=
-{ to_is_mul_left_invariant := begin
-    constructor,
-    assume h,
-    rw map_map (continuous_mul_left h).measurable hf.measurable,
-    conv_rhs { rw ← map_mul_left_eq_self μ (f.symm h) },
-    rw map_map hf.measurable (continuous_mul_left _).measurable,
-    congr' 2,
-    ext y,
-    simp only [mul_equiv.apply_symm_apply, comp_app, mul_equiv.map_mul],
-  end,
+{ to_is_mul_left_invariant := is_mul_left_invariant_map f.to_mul_hom hf.measurable h_surj,
   lt_top_of_is_compact := begin
     assume K hK,
     rw map_apply hf.measurable hK.measurable_set,
-    have : f.symm '' K = f ⁻¹' K := equiv.image_eq_preimage _ _,
-    rw ← this,
-    exact is_compact.measure_lt_top (hK.image hfsymm)
+    exact is_compact.measure_lt_top
+      ((⟨⟨f, hf⟩, h_prop⟩ : cocompact_map G H).is_compact_preimage hK),
   end,
-  to_is_open_pos_measure := hf.is_open_pos_measure_map f.surjective }
+  to_is_open_pos_measure := hf.is_open_pos_measure_map h_surj }
+
+/-- A convenience wrapper for `measure_theory.measure.is_haar_measure_map`. -/
+@[to_additive "A convenience wrapper for `measure_theory.measure.is_add_haar_measure_map`."]
+lemma _root_.mul_equiv.is_haar_measure_map
+  [borel_space G] [topological_group G] {H : Type*} [group H]
+  [topological_space H] [measurable_space H] [borel_space H] [t2_space H] [topological_group H]
+  (e : G ≃* H) (he : continuous e) (hesymm : continuous e.symm) :
+  is_haar_measure (measure.map e μ) :=
+is_haar_measure_map μ (e : G →* H) he e.surjective
+  ({ .. e } : G ≃ₜ H).to_cocompact_map.cocompact_tendsto'
 
 /-- A Haar measure on a σ-compact space is σ-finite.
 
@@ -488,8 +679,13 @@ instance is_haar_measure.sigma_finite [sigma_compact_space G] : sigma_finite μ
   finite := λ n, is_compact.measure_lt_top $ is_compact_compact_covering G n,
   spanning := Union_compact_covering G }⟩⟩
 
-open_locale topological_space
-open filter
+@[to_additive]
+instance {G : Type*} [group G] [topological_space G] {mG : measurable_space G}
+  {H : Type*} [group H] [topological_space H] {mH : measurable_space H}
+  (μ : measure G) (ν : measure H) [is_haar_measure μ] [is_haar_measure ν]
+  [sigma_finite μ] [sigma_finite ν]
+  [has_measurable_mul G] [has_measurable_mul H] :
+  is_haar_measure (μ.prod ν) := {}
 
 /-- If the neutral element of a group is not isolated, then a Haar measure on this group has
 no atoms.
@@ -534,12 +730,6 @@ begin
   exact ge_of_tendsto' J I,
 end
 
-/- The above instance applies in particular to show that an additive Haar measure on a nontrivial
-finite-dimensional real vector space has no atom. -/
-example {E : Type*} [normed_group E] [normed_space ℝ E] [nontrivial E] [finite_dimensional ℝ E]
-  [measurable_space E] [borel_space E] (μ : measure E) [is_add_haar_measure μ] :
-  has_no_atoms μ := by apply_instance
-
 end
 
 end measure
diff --git a/src/measure_theory/group/pointwise.lean b/src/measure_theory/group/pointwise.lean
index 86bbc5f745e23..82e55d4269208 100644
--- a/src/measure_theory/group/pointwise.lean
+++ b/src/measure_theory/group/pointwise.lean
@@ -8,6 +8,9 @@ import measure_theory.group.arithmetic
 /-!
 # Pointwise set operations on `measurable_set`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove several versions of the following fact: if `s` is a measurable set, then so is
 `a • s`. Note that the pointwise product of two measurable sets need not be measurable, so there is
 no `measurable_set.mul` etc.
diff --git a/src/measure_theory/group/prod.lean b/src/measure_theory/group/prod.lean
index 9e84e468f01ff..6e6bd774ca8db 100644
--- a/src/measure_theory/group/prod.lean
+++ b/src/measure_theory/group/prod.lean
@@ -3,28 +3,31 @@ Copyright (c) 2021 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
-import measure_theory.constructions.prod
+import measure_theory.constructions.prod.basic
 import measure_theory.group.measure
 
 /-!
 # Measure theory in the product of groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 In this file we show properties about measure theory in products of measurable groups
 and properties of iterated integrals in measurable groups.
 
 These lemmas show the uniqueness of left invariant measures on measurable groups, up to
 scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.
 
-The idea of the proof is to use the translation invariance of measures to prove `μ(F) = c * μ(E)`
-for two sets `E` and `F`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
-the characteristic functions of `E` and `F`.
+The idea of the proof is to use the translation invariance of measures to prove `μ(t) = c * μ(s)`
+for two sets `s` and `t`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
+the characteristic functions of `s` and `t`.
 Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
-preserves the measure `μ.prod ν`, which means that
+preserves the measure `μ × ν`, which means that
 ```
   ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
 ```
-If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E)`, we can rewrite the RHS to
-`μ(F)`, and the LHS to `c * μ(E)`, where `c = c(ν)` does not depend on `μ`.
-Applying this to `μ` and to `ν` gives `μ (F) / μ (E) = ν (F) / ν (E)`, which is the uniqueness up to
+If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' s)`, we can rewrite the RHS to
+`μ(t)`, and the LHS to `c * μ(s)`, where `c = c(ν)` does not depend on `μ`.
+Applying this to `μ` and to `ν` gives `μ (t) / μ (s) = ν (t) / ν (s)`, which is the uniqueness up to
 scalar multiplication.
 
 The proof in [Halmos] seems to contain an omission in §60 Th. A, see
@@ -38,97 +41,95 @@ open_locale classical ennreal pointwise measure_theory
 
 variables (G : Type*) [measurable_space G]
 variables [group G] [has_measurable_mul₂ G]
-variables (μ ν : measure G) [sigma_finite ν] [sigma_finite μ] {E : set G}
+variables (μ ν : measure G) [sigma_finite ν] [sigma_finite μ] {s : set G}
 
-/-- The map `(x, y) ↦ (x, xy)` as a `measurable_equiv`. This is a shear mapping. -/
-@[to_additive "The map `(x, y) ↦ (x, x + y)` as a `measurable_equiv`.
-This is a shear mapping."]
+/-- The map `(x, y) ↦ (x, xy)` as a `measurable_equiv`. -/
+@[to_additive "The map `(x, y) ↦ (x, x + y)` as a `measurable_equiv`."]
 protected def measurable_equiv.shear_mul_right [has_measurable_inv G] : G × G ≃ᵐ G × G :=
 { measurable_to_fun  := measurable_fst.prod_mk measurable_mul,
   measurable_inv_fun := measurable_fst.prod_mk $ measurable_fst.inv.mul measurable_snd,
   .. equiv.prod_shear (equiv.refl _) equiv.mul_left }
 
+/-- The map `(x, y) ↦ (x, y / x)` as a `measurable_equiv` with as inverse `(x, y) ↦ (x, yx)` -/
+@[to_additive
+  "The map `(x, y) ↦ (x, y - x)` as a `measurable_equiv` with as inverse `(x, y) ↦ (x, y + x)`."]
+protected def measurable_equiv.shear_div_right [has_measurable_inv G] : G × G ≃ᵐ G × G :=
+{ measurable_to_fun  := measurable_fst.prod_mk $ measurable_snd.div measurable_fst,
+  measurable_inv_fun := measurable_fst.prod_mk $ measurable_snd.mul measurable_fst,
+  .. equiv.prod_shear (equiv.refl _) (equiv.div_right) }
+
 variables {G}
 
 namespace measure_theory
 
 open measure
 
-/-- A shear mapping preserves the measure `μ.prod ν`.
+section left_invariant
+
+/-- The multiplicative shear mapping `(x, y) ↦ (x, xy)` preserves the measure `μ × ν`.
 This condition is part of the definition of a measurable group in [Halmos, §59].
 There, the map in this lemma is called `S`. -/
-@[to_additive map_prod_sum_eq /-" An additive shear mapping preserves the measure `μ.prod ν`. "-/]
-lemma map_prod_mul_eq [is_mul_left_invariant ν] :
-  map (λ z : G × G, (z.1, z.1 * z.2)) (μ.prod ν) = μ.prod ν :=
-((measure_preserving.id μ).skew_product measurable_mul
-  (filter.eventually_of_forall $ map_mul_left_eq_self ν)).map_eq
-
-/-- The function we are mapping along is `SR` in [Halmos, §59],
-  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
-@[to_additive map_prod_add_eq_swap /-"  "-/]
-lemma map_prod_mul_eq_swap [is_mul_left_invariant μ] :
-  map (λ z : G × G, (z.2, z.2 * z.1)) (μ.prod ν) = ν.prod μ :=
-begin
-  rw [← prod_swap],
-  simp_rw [map_map (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)) measurable_swap],
-  exact map_prod_mul_eq ν μ
-end
+@[to_additive measure_preserving_prod_add
+  /-" The shear mapping `(x, y) ↦ (x, x + y)` preserves the measure `μ × ν`. "-/]
+lemma measure_preserving_prod_mul [is_mul_left_invariant ν] :
+  measure_preserving (λ z : G × G, (z.1, z.1 * z.2)) (μ.prod ν) (μ.prod ν) :=
+(measure_preserving.id μ).skew_product measurable_mul $
+  filter.eventually_of_forall $ map_mul_left_eq_self ν
+
+/-- The map `(x, y) ↦ (y, yx)` sends the measure `μ × ν` to `ν × μ`.
+This is the map `SR` in [Halmos, §59].
+`S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
+@[to_additive measure_preserving_prod_add_swap
+  /-" The map `(x, y) ↦ (y, y + x)` sends the measure `μ × ν` to `ν × μ`. "-/]
+lemma measure_preserving_prod_mul_swap [is_mul_left_invariant μ] :
+  measure_preserving (λ z : G × G, (z.2, z.2 * z.1)) (μ.prod ν) (ν.prod μ) :=
+(measure_preserving_prod_mul ν μ).comp measure_preserving_swap
 
 @[to_additive]
-lemma measurable_measure_mul_right (hE : measurable_set E) :
-  measurable (λ x, μ ((λ y, y * x) ⁻¹' E)) :=
+lemma measurable_measure_mul_right (hs : measurable_set s) :
+  measurable (λ x, μ ((λ y, y * x) ⁻¹' s)) :=
 begin
   suffices : measurable (λ y,
-    μ ((λ x, (x, y)) ⁻¹' ((λ z : G × G, ((1 : G), z.1 * z.2)) ⁻¹' ((univ : set G) ×ˢ E)))),
+    μ ((λ x, (x, y)) ⁻¹' ((λ z : G × G, ((1 : G), z.1 * z.2)) ⁻¹' (univ ×ˢ s)))),
   { convert this, ext1 x, congr' 1 with y : 1, simp },
   apply measurable_measure_prod_mk_right,
-  exact measurable_const.prod_mk (measurable_fst.mul measurable_snd) (measurable_set.univ.prod hE)
+  exact measurable_const.prod_mk measurable_mul (measurable_set.univ.prod hs)
 end
 
 variables [has_measurable_inv G]
 
-/-- The function we are mapping along is `S⁻¹` in [Halmos, §59],
-  where `S` is the map in `map_prod_mul_eq`. -/
-@[to_additive map_prod_neg_add_eq]
-lemma map_prod_inv_mul_eq [is_mul_left_invariant ν] :
-  map (λ z : G × G, (z.1, z.1⁻¹ * z.2)) (μ.prod ν) = μ.prod ν :=
-(measurable_equiv.shear_mul_right G).map_apply_eq_iff_map_symm_apply_eq.mp $ map_prod_mul_eq μ ν
-
-@[to_additive]
-lemma quasi_measure_preserving_div [is_mul_right_invariant μ] :
-  quasi_measure_preserving (λ (p : G × G), p.1 / p.2) (μ.prod μ) μ :=
-begin
-  refine quasi_measure_preserving.prod_of_left measurable_div _,
-  simp_rw [div_eq_mul_inv],
-  apply eventually_of_forall,
-  refine λ y, ⟨measurable_mul_const y⁻¹, (map_mul_right_eq_self μ y⁻¹).absolutely_continuous⟩
-end
+/-- The map `(x, y) ↦ (x, x⁻¹y)` is measure-preserving.
+This is the function `S⁻¹` in [Halmos, §59],
+where `S` is the map `(x, y) ↦ (x, xy)`. -/
+@[to_additive measure_preserving_prod_neg_add
+  "The map `(x, y) ↦ (x, - x + y)` is measure-preserving."]
+lemma measure_preserving_prod_inv_mul [is_mul_left_invariant ν] :
+  measure_preserving (λ z : G × G, (z.1, z.1⁻¹ * z.2)) (μ.prod ν) (μ.prod ν) :=
+(measure_preserving_prod_mul μ ν).symm $ measurable_equiv.shear_mul_right G
 
 variables [is_mul_left_invariant μ]
 
-/-- The function we are mapping along is `S⁻¹R` in [Halmos, §59],
-  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
-@[to_additive map_prod_neg_add_eq_swap]
-lemma map_prod_inv_mul_eq_swap : map (λ z : G × G, (z.2, z.2⁻¹ * z.1)) (μ.prod ν) = ν.prod μ :=
+/-- The map `(x, y) ↦ (y, y⁻¹x)` sends `μ × ν` to `ν × μ`.
+This is the function `S⁻¹R` in [Halmos, §59],
+where `S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
+@[to_additive measure_preserving_prod_neg_add_swap
+  "The map `(x, y) ↦ (y, - y + x)` sends `μ × ν` to `ν × μ`."]
+lemma measure_preserving_prod_inv_mul_swap :
+  measure_preserving (λ z : G × G, (z.2, z.2⁻¹ * z.1)) (μ.prod ν) (ν.prod μ) :=
+(measure_preserving_prod_inv_mul ν μ).comp measure_preserving_swap
+
+/-- The map `(x, y) ↦ (yx, x⁻¹)` is measure-preserving.
+This is the function `S⁻¹RSR` in [Halmos, §59],
+where `S` is the map `(x, y) ↦ (x, xy)` and `R` is `prod.swap`. -/
+@[to_additive measure_preserving_add_prod_neg
+  "The map `(x, y) ↦ (y + x, - x)` is measure-preserving."]
+lemma measure_preserving_mul_prod_inv [is_mul_left_invariant ν] :
+  measure_preserving (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod ν) (μ.prod ν) :=
 begin
-  rw [← prod_swap],
-  simp_rw
-    [map_map (measurable_snd.prod_mk $ measurable_snd.inv.mul measurable_fst) measurable_swap],
-  exact map_prod_inv_mul_eq ν μ
-end
-
-/-- The function we are mapping along is `S⁻¹RSR` in [Halmos, §59],
-  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
-@[to_additive map_prod_add_neg_eq]
-lemma map_prod_mul_inv_eq [is_mul_left_invariant ν] :
-  map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod ν) = μ.prod ν :=
-begin
-  suffices : map ((λ z : G × G, (z.2, z.2⁻¹ * z.1)) ∘ (λ z : G × G, (z.2, z.2 * z.1))) (μ.prod ν) =
-    μ.prod ν,
-  { convert this, ext1 ⟨x, y⟩, simp },
-  simp_rw [← map_map (measurable_snd.prod_mk (measurable_snd.inv.mul measurable_fst))
-    (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)), map_prod_mul_eq_swap μ ν,
-    map_prod_inv_mul_eq_swap ν μ]
+  convert (measure_preserving_prod_inv_mul_swap ν μ).comp
+    (measure_preserving_prod_mul_swap μ ν),
+  ext1 ⟨x, y⟩,
+  simp_rw [function.comp_apply, mul_inv_rev, inv_mul_cancel_right]
 end
 
 @[to_additive] lemma quasi_measure_preserving_inv :
@@ -139,29 +140,30 @@ begin
   have hf : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
     (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
   suffices : map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod μ) (s⁻¹ ×ˢ s⁻¹) = 0,
-  { simpa only [map_prod_mul_inv_eq μ μ, prod_prod, mul_eq_zero, or_self] using this },
+  { simpa only [(measure_preserving_mul_prod_inv μ μ).map_eq,
+      prod_prod, mul_eq_zero, or_self] using this },
   have hsm' : measurable_set (s⁻¹ ×ˢ s⁻¹) := hsm.inv.prod hsm.inv,
   simp_rw [map_apply hf hsm', prod_apply_symm (hf hsm'), preimage_preimage, mk_preimage_prod,
     inv_preimage, inv_inv, measure_mono_null (inter_subset_right _ _) hμs, lintegral_zero]
 end
 
 @[to_additive]
-lemma map_inv_absolutely_continuous : map has_inv.inv μ ≪ μ :=
-(quasi_measure_preserving_inv μ).absolutely_continuous
-
-@[to_additive]
-lemma measure_inv_null : μ E⁻¹ = 0 ↔ μ E = 0 :=
+lemma measure_inv_null : μ s⁻¹ = 0 ↔ μ s = 0 :=
 begin
-  refine ⟨λ hE, _, (quasi_measure_preserving_inv μ).preimage_null⟩,
-  convert (quasi_measure_preserving_inv μ).preimage_null hE,
-  exact (inv_inv _).symm
+  refine ⟨λ hs, _, (quasi_measure_preserving_inv μ).preimage_null⟩,
+  rw [← inv_inv s],
+  exact (quasi_measure_preserving_inv μ).preimage_null hs
 end
 
 @[to_additive]
-lemma absolutely_continuous_map_inv : μ ≪ map has_inv.inv μ :=
+lemma inv_absolutely_continuous : μ.inv ≪ μ :=
+(quasi_measure_preserving_inv μ).absolutely_continuous
+
+@[to_additive]
+lemma absolutely_continuous_inv : μ ≪ μ.inv :=
 begin
   refine absolutely_continuous.mk (λ s hs, _),
-  simp_rw [map_apply measurable_inv hs, inv_preimage, measure_inv_null, imp_self]
+  simp_rw [inv_apply μ s, measure_inv_null, imp_self]
 end
 
 @[to_additive]
@@ -171,36 +173,26 @@ lemma lintegral_lintegral_mul_inv [is_mul_left_invariant ν]
 begin
   have h : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
   (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
-  have h2f : ae_measurable (uncurry $ λ x y, f (y * x) x⁻¹) (μ.prod ν),
-  { apply hf.comp_measurable' h (map_prod_mul_inv_eq μ ν).absolutely_continuous },
+  have h2f : ae_measurable (uncurry $ λ x y, f (y * x) x⁻¹) (μ.prod ν) :=
+    hf.comp_quasi_measure_preserving (measure_preserving_mul_prod_inv μ ν).quasi_measure_preserving,
   simp_rw [lintegral_lintegral h2f, lintegral_lintegral hf],
-  conv_rhs { rw [← map_prod_mul_inv_eq μ ν] },
+  conv_rhs { rw [← (measure_preserving_mul_prod_inv μ ν).map_eq] },
   symmetry,
-  exact lintegral_map' (hf.mono' (map_prod_mul_inv_eq μ ν).absolutely_continuous) h.ae_measurable,
+  exact lintegral_map' (hf.mono' (measure_preserving_mul_prod_inv μ ν).map_eq.absolutely_continuous)
+    h.ae_measurable,
 end
 
 @[to_additive]
 lemma measure_mul_right_null (y : G) :
-  μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ E = 0 :=
-calc μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ ((λ x, y⁻¹ * x) ⁻¹' E⁻¹)⁻¹ = 0 :
+  μ ((λ x, x * y) ⁻¹' s) = 0 ↔ μ s = 0 :=
+calc μ ((λ x, x * y) ⁻¹' s) = 0 ↔ μ ((λ x, y⁻¹ * x) ⁻¹' s⁻¹)⁻¹ = 0 :
   by simp_rw [← inv_preimage, preimage_preimage, mul_inv_rev, inv_inv]
-... ↔ μ E = 0 : by simp only [measure_inv_null μ, measure_preimage_mul]
+... ↔ μ s = 0 : by simp only [measure_inv_null μ, measure_preimage_mul]
 
 @[to_additive]
 lemma measure_mul_right_ne_zero
-  (h2E : μ E ≠ 0) (y : G) : μ ((λ x, x * y) ⁻¹' E) ≠ 0 :=
-(not_iff_not_of_iff (measure_mul_right_null μ y)).mpr h2E
-
-@[to_additive] lemma quasi_measure_preserving_mul_right (g : G) :
-  quasi_measure_preserving (λ h : G, h * g) μ μ :=
-begin
-  refine ⟨measurable_mul_const g, absolutely_continuous.mk $ λ s hs, _⟩,
-  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null], exact id,
-end
-
-@[to_additive]
-lemma map_mul_right_absolutely_continuous (g : G) : map (* g) μ ≪ μ :=
-(quasi_measure_preserving_mul_right μ g).absolutely_continuous
+  (h2s : μ s ≠ 0) (y : G) : μ ((λ x, x * y) ⁻¹' s) ≠ 0 :=
+(not_iff_not_of_iff (measure_mul_right_null μ y)).mpr h2s
 
 @[to_additive]
 lemma absolutely_continuous_map_mul_right (g : G) : μ ≪ map (* g) μ :=
@@ -209,46 +201,32 @@ begin
   rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null], exact id
 end
 
-@[to_additive] lemma quasi_measure_preserving_div_left (g : G) :
-  quasi_measure_preserving (λ h : G, g / h) μ μ :=
-begin
-  refine ⟨measurable_const.div measurable_id, _⟩,
-  simp_rw [div_eq_mul_inv],
-  rw [← map_map (measurable_const_mul g) measurable_inv],
-  refine ((map_inv_absolutely_continuous μ).map $ measurable_const_mul g).trans _,
-  rw [map_mul_left_eq_self],
-end
-
-@[to_additive]
-lemma map_div_left_absolutely_continuous (g : G) : map (λ h, g / h) μ ≪ μ :=
-(quasi_measure_preserving_div_left μ g).absolutely_continuous
-
 @[to_additive]
 lemma absolutely_continuous_map_div_left (g : G) : μ ≪ map (λ h, g / h) μ :=
 begin
   simp_rw [div_eq_mul_inv],
   rw [← map_map (measurable_const_mul g) measurable_inv],
   conv_lhs { rw [← map_mul_left_eq_self μ g] },
-  exact (absolutely_continuous_map_inv μ).map (measurable_const_mul g)
+  exact (absolutely_continuous_inv μ).map (measurable_const_mul g)
 end
 
 /-- This is the computation performed in the proof of [Halmos, §60 Th. A]. -/
-@[to_additive]
+@[to_additive "This is the computation performed in the proof of [Halmos, §60 Th. A]."]
 lemma measure_mul_lintegral_eq
-  [is_mul_left_invariant ν] (Em : measurable_set E) (f : G → ℝ≥0∞) (hf : measurable f) :
-  μ E * ∫⁻ y, f y ∂ν = ∫⁻ x, ν ((λ z, z * x) ⁻¹' E) * f (x⁻¹) ∂μ :=
+  [is_mul_left_invariant ν] (sm : measurable_set s) (f : G → ℝ≥0∞) (hf : measurable f) :
+  μ s * ∫⁻ y, f y ∂ν = ∫⁻ x, ν ((λ z, z * x) ⁻¹' s) * f (x⁻¹) ∂μ :=
 begin
-  rw [← set_lintegral_one, ← lintegral_indicator _ Em,
-    ← lintegral_lintegral_mul (measurable_const.indicator Em).ae_measurable hf.ae_measurable,
+  rw [← set_lintegral_one, ← lintegral_indicator _ sm,
+    ← lintegral_lintegral_mul (measurable_const.indicator sm).ae_measurable hf.ae_measurable,
     ← lintegral_lintegral_mul_inv μ ν],
-  swap, { exact (((measurable_const.indicator Em).comp measurable_fst).mul
+  swap, { exact (((measurable_const.indicator sm).comp measurable_fst).mul
       (hf.comp measurable_snd)).ae_measurable },
-  have mE : ∀ x : G, measurable (λ y, ((λ z, z * x) ⁻¹' E).indicator (λ z, (1 : ℝ≥0∞)) y) :=
-  λ x, measurable_const.indicator (measurable_mul_const _ Em),
-  have : ∀ x y, E.indicator (λ (z : G), (1 : ℝ≥0∞)) (y * x) =
-    ((λ z, z * x) ⁻¹' E).indicator (λ (b : G), 1) y,
+  have ms : ∀ x : G, measurable (λ y, ((λ z, z * x) ⁻¹' s).indicator (λ z, (1 : ℝ≥0∞)) y) :=
+  λ x, measurable_const.indicator (measurable_mul_const _ sm),
+  have : ∀ x y, s.indicator (λ (z : G), (1 : ℝ≥0∞)) (y * x) =
+    ((λ z, z * x) ⁻¹' s).indicator (λ (b : G), 1) y,
   { intros x y, symmetry, convert indicator_comp_right (λ y, y * x), ext1 z, refl },
-  simp_rw [this, lintegral_mul_const _ (mE _), lintegral_indicator _ (measurable_mul_const _ Em),
+  simp_rw [this, lintegral_mul_const _ (ms _), lintegral_indicator _ (measurable_mul_const _ sm),
     set_lintegral_one],
 end
 
@@ -258,77 +236,84 @@ other. "-/]
 lemma absolutely_continuous_of_is_mul_left_invariant [is_mul_left_invariant ν] (hν : ν ≠ 0) :
   μ ≪ ν :=
 begin
-  refine absolutely_continuous.mk (λ E Em hνE, _),
-  have h1 := measure_mul_lintegral_eq μ ν Em 1 measurable_one,
-  simp_rw [pi.one_apply, lintegral_one, mul_one, (measure_mul_right_null ν _).mpr hνE,
+  refine absolutely_continuous.mk (λ s sm hνs, _),
+  have h1 := measure_mul_lintegral_eq μ ν sm 1 measurable_one,
+  simp_rw [pi.one_apply, lintegral_one, mul_one, (measure_mul_right_null ν _).mpr hνs,
     lintegral_zero, mul_eq_zero, measure_univ_eq_zero.not.mpr hν, or_false] at h1,
   exact h1
 end
 
 @[to_additive]
 lemma ae_measure_preimage_mul_right_lt_top [is_mul_left_invariant ν]
-  (Em : measurable_set E) (hμE : μ E ≠ ∞) :
-  ∀ᵐ x ∂μ, ν ((λ y, y * x) ⁻¹' E) < ∞ :=
+  (sm : measurable_set s) (hμs : μ s ≠ ∞) :
+  ∀ᵐ x ∂μ, ν ((λ y, y * x) ⁻¹' s) < ∞ :=
 begin
   refine ae_of_forall_measure_lt_top_ae_restrict' ν.inv _ _,
   intros A hA h2A h3A,
   simp only [ν.inv_apply] at h3A,
-  apply ae_lt_top (measurable_measure_mul_right ν Em),
-  have h1 := measure_mul_lintegral_eq μ ν Em (A⁻¹.indicator 1) (measurable_one.indicator hA.inv),
+  apply ae_lt_top (measurable_measure_mul_right ν sm),
+  have h1 := measure_mul_lintegral_eq μ ν sm (A⁻¹.indicator 1) (measurable_one.indicator hA.inv),
   rw [lintegral_indicator _ hA.inv] at h1,
   simp_rw [pi.one_apply, set_lintegral_one, ← image_inv, indicator_image inv_injective, image_inv,
-    ← indicator_mul_right _ (λ x, ν ((λ y, y * x) ⁻¹' E)), function.comp, pi.one_apply,
+    ← indicator_mul_right _ (λ x, ν ((λ y, y * x) ⁻¹' s)), function.comp, pi.one_apply,
     mul_one] at h1,
   rw [← lintegral_indicator _ hA, ← h1],
-  exact ennreal.mul_ne_top hμE h3A.ne,
+  exact ennreal.mul_ne_top hμs h3A.ne,
 end
 
 @[to_additive]
 lemma ae_measure_preimage_mul_right_lt_top_of_ne_zero [is_mul_left_invariant ν]
-  (Em : measurable_set E) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞) :
-  ∀ᵐ x ∂μ, ν ((λ y, y * x) ⁻¹' E) < ∞ :=
+  (sm : measurable_set s) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) :
+  ∀ᵐ x ∂μ, ν ((λ y, y * x) ⁻¹' s) < ∞ :=
 begin
-  refine (ae_measure_preimage_mul_right_lt_top ν ν Em h3E).filter_mono _,
+  refine (ae_measure_preimage_mul_right_lt_top ν ν sm h3s).filter_mono _,
   refine (absolutely_continuous_of_is_mul_left_invariant μ ν _).ae_le,
-  refine mt _ h2E,
+  refine mt _ h2s,
   intro hν,
   rw [hν, measure.coe_zero, pi.zero_apply]
 end
 
 /-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
-  Note that if `f` is the characteristic function of a measurable set `F` this states that
-  `μ F = c * μ E` for a constant `c` that does not depend on `μ`.
+  Note that if `f` is the characteristic function of a measurable set `t` this states that
+  `μ t = c * μ s` for a constant `c` that does not depend on `μ`.
 
   Note: There is a gap in the last step of the proof in [Halmos].
-  In the last line, the equality `g(x⁻¹)ν(Ex⁻¹) = f(x)` holds if we can prove that
-  `0 < ν(Ex⁻¹) < ∞`. The first inequality follows from §59, Th. D, but the second inequality is
+  In the last line, the equality `g(x⁻¹)ν(sx⁻¹) = f(x)` holds if we can prove that
+  `0 < ν(sx⁻¹) < ∞`. The first inequality follows from §59, Th. D, but the second inequality is
   not justified. We prove this inequality for almost all `x` in
   `measure_theory.ae_measure_preimage_mul_right_lt_top_of_ne_zero`. -/
-@[to_additive]
+@[to_additive "A technical lemma relating two different measures. This is basically
+[Halmos, §60 Th. A]. Note that if `f` is the characteristic function of a measurable set `t` this
+states that `μ t = c * μ s` for a constant `c` that does not depend on `μ`.
+
+Note: There is a gap in the last step of the proof in [Halmos]. In the last line, the equality
+`g(-x) + ν(s - x) = f(x)` holds if we can prove that `0 < ν(s - x) < ∞`. The first inequality
+follows from §59, Th. D, but the second inequality is not justified. We prove this inequality for
+almost all `x` in `measure_theory.ae_measure_preimage_add_right_lt_top_of_ne_zero`."]
 lemma measure_lintegral_div_measure [is_mul_left_invariant ν]
-  (Em : measurable_set E) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞)
+  (sm : measurable_set s) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞)
   (f : G → ℝ≥0∞) (hf : measurable f) :
-  μ E * ∫⁻ y, f y⁻¹ / ν ((λ x, x * y⁻¹) ⁻¹' E) ∂ν = ∫⁻ x, f x ∂μ :=
+  μ s * ∫⁻ y, f y⁻¹ / ν ((λ x, x * y⁻¹) ⁻¹' s) ∂ν = ∫⁻ x, f x ∂μ :=
 begin
-  set g := λ y, f y⁻¹ / ν ((λ x, x * y⁻¹) ⁻¹' E),
+  set g := λ y, f y⁻¹ / ν ((λ x, x * y⁻¹) ⁻¹' s),
   have hg : measurable g := (hf.comp measurable_inv).div
-    ((measurable_measure_mul_right ν Em).comp measurable_inv),
-  simp_rw [measure_mul_lintegral_eq μ ν Em g hg, g, inv_inv],
+    ((measurable_measure_mul_right ν sm).comp measurable_inv),
+  simp_rw [measure_mul_lintegral_eq μ ν sm g hg, g, inv_inv],
   refine lintegral_congr_ae _,
-  refine (ae_measure_preimage_mul_right_lt_top_of_ne_zero μ ν Em h2E h3E).mono (λ x hx , _),
-  simp_rw [ennreal.mul_div_cancel' (measure_mul_right_ne_zero ν h2E _) hx.ne]
+  refine (ae_measure_preimage_mul_right_lt_top_of_ne_zero μ ν sm h2s h3s).mono (λ x hx , _),
+  simp_rw [ennreal.mul_div_cancel' (measure_mul_right_ne_zero ν h2s _) hx.ne]
 end
 
 @[to_additive]
-lemma measure_mul_measure_eq [is_mul_left_invariant ν] {E F : set G}
-  (hE : measurable_set E) (hF : measurable_set F) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞) :
-    μ E * ν F = ν E * μ F :=
+lemma measure_mul_measure_eq [is_mul_left_invariant ν] {s t : set G}
+  (hs : measurable_set s) (ht : measurable_set t) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) :
+    μ s * ν t = ν s * μ t :=
 begin
-  have h1 := measure_lintegral_div_measure ν ν hE h2E h3E (F.indicator (λ x, 1))
-    (measurable_const.indicator hF),
-  have h2 := measure_lintegral_div_measure μ ν hE h2E h3E (F.indicator (λ x, 1))
-    (measurable_const.indicator hF),
-  rw [lintegral_indicator _ hF, set_lintegral_one] at h1 h2,
+  have h1 := measure_lintegral_div_measure ν ν hs h2s h3s (t.indicator (λ x, 1))
+    (measurable_const.indicator ht),
+  have h2 := measure_lintegral_div_measure μ ν hs h2s h3s (t.indicator (λ x, 1))
+    (measurable_const.indicator ht),
+  rw [lintegral_indicator _ ht, set_lintegral_one] at h1 h2,
   rw [← h1, mul_left_comm, h2],
 end
 
@@ -336,11 +321,147 @@ end
 @[to_additive /-" Left invariant Borel measures on an additive measurable group are unique
   (up to a scalar). "-/]
 lemma measure_eq_div_smul [is_mul_left_invariant ν]
-  (hE : measurable_set E) (h2E : ν E ≠ 0) (h3E : ν E ≠ ∞) : μ = (μ E / ν E) • ν :=
+  (hs : measurable_set s) (h2s : ν s ≠ 0) (h3s : ν s ≠ ∞) : μ = (μ s / ν s) • ν :=
 begin
-  ext1 F hF,
+  ext1 t ht,
   rw [smul_apply, smul_eq_mul, mul_comm, ← mul_div_assoc, mul_comm,
-    measure_mul_measure_eq μ ν hE hF h2E h3E, mul_div_assoc, ennreal.mul_div_cancel' h2E h3E]
+    measure_mul_measure_eq μ ν hs ht h2s h3s, mul_div_assoc, ennreal.mul_div_cancel' h2s h3s]
+end
+
+end left_invariant
+
+section right_invariant
+
+@[to_additive measure_preserving_prod_add_right]
+lemma measure_preserving_prod_mul_right [is_mul_right_invariant ν] :
+  measure_preserving (λ z : G × G, (z.1, z.2 * z.1)) (μ.prod ν) (μ.prod ν) :=
+(measure_preserving.id μ).skew_product (by exact measurable_snd.mul measurable_fst) $
+  filter.eventually_of_forall $ map_mul_right_eq_self ν
+
+/-- The map `(x, y) ↦ (y, xy)` sends the measure `μ × ν` to `ν × μ`. -/
+@[to_additive measure_preserving_prod_add_swap_right
+  /-" The map `(x, y) ↦ (y, x + y)` sends the measure `μ × ν` to `ν × μ`. "-/]
+lemma measure_preserving_prod_mul_swap_right [is_mul_right_invariant μ] :
+  measure_preserving (λ z : G × G, (z.2, z.1 * z.2)) (μ.prod ν) (ν.prod μ) :=
+(measure_preserving_prod_mul_right ν μ).comp measure_preserving_swap
+
+/-- The map `(x, y) ↦ (xy, y)` preserves the measure `μ × ν`. -/
+@[to_additive measure_preserving_add_prod
+  /-" The map `(x, y) ↦ (x + y, y)` preserves the measure `μ × ν`. "-/]
+lemma measure_preserving_mul_prod [is_mul_right_invariant μ] :
+  measure_preserving (λ z : G × G, (z.1 * z.2, z.2)) (μ.prod ν) (μ.prod ν) :=
+measure_preserving_swap.comp $ by apply measure_preserving_prod_mul_swap_right μ ν
+
+variables [has_measurable_inv G]
+
+/-- The map `(x, y) ↦ (x, y / x)` is measure-preserving. -/
+@[to_additive measure_preserving_prod_sub
+  "The map `(x, y) ↦ (x, y - x)` is measure-preserving."]
+lemma measure_preserving_prod_div [is_mul_right_invariant ν] :
+  measure_preserving (λ z : G × G, (z.1, z.2 / z.1)) (μ.prod ν) (μ.prod ν) :=
+(measure_preserving_prod_mul_right μ ν).symm (measurable_equiv.shear_div_right G).symm
+
+/-- The map `(x, y) ↦ (y, x / y)` sends `μ × ν` to `ν × μ`. -/
+@[to_additive measure_preserving_prod_sub_swap
+  "The map `(x, y) ↦ (y, x - y)` sends `μ × ν` to `ν × μ`."]
+lemma measure_preserving_prod_div_swap [is_mul_right_invariant μ] :
+  measure_preserving (λ z : G × G, (z.2, z.1 / z.2)) (μ.prod ν) (ν.prod μ) :=
+(measure_preserving_prod_div ν μ).comp measure_preserving_swap
+
+/-- The map `(x, y) ↦ (x / y, y)` preserves the measure `μ × ν`. -/
+@[to_additive measure_preserving_sub_prod
+  /-" The map `(x, y) ↦ (x - y, y)` preserves the measure `μ × ν`. "-/]
+lemma measure_preserving_div_prod [is_mul_right_invariant μ] :
+  measure_preserving (λ z : G × G, (z.1 / z.2, z.2)) (μ.prod ν) (μ.prod ν) :=
+measure_preserving_swap.comp $ by apply measure_preserving_prod_div_swap μ ν
+
+/-- The map `(x, y) ↦ (xy, x⁻¹)` is measure-preserving. -/
+@[to_additive measure_preserving_add_prod_neg_right
+  "The map `(x, y) ↦ (x + y, - x)` is measure-preserving."]
+lemma measure_preserving_mul_prod_inv_right [is_mul_right_invariant μ] [is_mul_right_invariant ν] :
+  measure_preserving (λ z : G × G, (z.1 * z.2, z.1⁻¹)) (μ.prod ν) (μ.prod ν) :=
+begin
+  convert (measure_preserving_prod_div_swap ν μ).comp
+    (measure_preserving_prod_mul_swap_right μ ν),
+  ext1 ⟨x, y⟩,
+  simp_rw [function.comp_apply, div_mul_eq_div_div_swap, div_self', one_div]
+end
+
+end right_invariant
+
+section quasi_measure_preserving
+
+variables [has_measurable_inv G]
+
+@[to_additive]
+lemma quasi_measure_preserving_inv_of_right_invariant [is_mul_right_invariant μ] :
+  quasi_measure_preserving (has_inv.inv : G → G) μ μ :=
+begin
+  rw [← μ.inv_inv],
+  exact (quasi_measure_preserving_inv μ.inv).mono
+    (inv_absolutely_continuous μ.inv) (absolutely_continuous_inv μ.inv)
+end
+
+@[to_additive]
+lemma quasi_measure_preserving_div_left [is_mul_left_invariant μ] (g : G) :
+  quasi_measure_preserving (λ h : G, g / h) μ μ :=
+begin
+  simp_rw [div_eq_mul_inv],
+  exact (measure_preserving_mul_left μ g).quasi_measure_preserving.comp
+    (quasi_measure_preserving_inv μ)
 end
 
+@[to_additive]
+lemma quasi_measure_preserving_div_left_of_right_invariant [is_mul_right_invariant μ] (g : G) :
+  quasi_measure_preserving (λ h : G, g / h) μ μ :=
+begin
+  rw [← μ.inv_inv],
+  exact (quasi_measure_preserving_div_left μ.inv g).mono
+    (inv_absolutely_continuous μ.inv) (absolutely_continuous_inv μ.inv)
+end
+
+@[to_additive]
+lemma quasi_measure_preserving_div_of_right_invariant [is_mul_right_invariant μ] :
+  quasi_measure_preserving (λ (p : G × G), p.1 / p.2) (μ.prod ν) μ :=
+begin
+  refine quasi_measure_preserving.prod_of_left measurable_div (eventually_of_forall $ λ y, _),
+  exact (measure_preserving_div_right μ y).quasi_measure_preserving
+end
+
+@[to_additive]
+lemma quasi_measure_preserving_div [is_mul_left_invariant μ] :
+  quasi_measure_preserving (λ (p : G × G), p.1 / p.2) (μ.prod ν) μ :=
+(quasi_measure_preserving_div_of_right_invariant μ.inv ν).mono
+  ((absolutely_continuous_inv μ).prod absolutely_continuous.rfl)
+  (inv_absolutely_continuous μ)
+
+/-- A *left*-invariant measure is quasi-preserved by *right*-multiplication.
+This should not be confused with `(measure_preserving_mul_right μ g).quasi_measure_preserving`. -/
+@[to_additive /-"A *left*-invariant measure is quasi-preserved by *right*-addition.
+This should not be confused with `(measure_preserving_add_right μ g).quasi_measure_preserving`. "-/]
+lemma quasi_measure_preserving_mul_right [is_mul_left_invariant μ] (g : G) :
+  quasi_measure_preserving (λ h : G, h * g) μ μ :=
+begin
+  refine ⟨measurable_mul_const g, absolutely_continuous.mk $ λ s hs, _⟩,
+  rw [map_apply (measurable_mul_const g) hs, measure_mul_right_null], exact id,
+end
+
+/-- A *right*-invariant measure is quasi-preserved by *left*-multiplication.
+This should not be confused with `(measure_preserving_mul_left μ g).quasi_measure_preserving`. -/
+@[to_additive /-"A *right*-invariant measure is quasi-preserved by *left*-addition.
+This should not be confused with `(measure_preserving_add_left μ g).quasi_measure_preserving`. "-/]
+lemma quasi_measure_preserving_mul_left [is_mul_right_invariant μ] (g : G) :
+  quasi_measure_preserving (λ h : G, g * h) μ μ :=
+begin
+  have := (quasi_measure_preserving_mul_right μ.inv g⁻¹).mono
+    (inv_absolutely_continuous μ.inv) (absolutely_continuous_inv μ.inv),
+  rw [μ.inv_inv] at this,
+  have := (quasi_measure_preserving_inv_of_right_invariant μ).comp
+    (this.comp (quasi_measure_preserving_inv_of_right_invariant μ)),
+  simp_rw [function.comp, mul_inv_rev, inv_inv] at this,
+  exact this
+end
+
+end quasi_measure_preserving
+
 end measure_theory
diff --git a/src/measure_theory/integral/average.lean b/src/measure_theory/integral/average.lean
index 7bb6581827581..05d85570cef2b 100644
--- a/src/measure_theory/integral/average.lean
+++ b/src/measure_theory/integral/average.lean
@@ -1,13 +1,16 @@
 /-
 Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yury G. Kudryashov
+Authors: Yury G. Kudryashov, Yaël Dillies
 -/
 import measure_theory.integral.set_integral
 
 /-!
 # Integral average of a function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `measure_theory.average μ f` (notation: `⨍ x, f x ∂μ`) to be the average
 value of `f` with respect to measure `μ`. It is defined as `∫ x, f x ∂((μ univ)⁻¹ • μ)`, so it
 is equal to zero if `f` is not integrable or if `μ` is an infinite measure. If `μ` is a probability
@@ -16,6 +19,11 @@ measure, then the average of any function is equal to its integral.
 For the average on a set, we use `⨍ x in s, f x ∂μ` (notation for `⨍ x, f x ∂(μ.restrict s)`). For
 average w.r.t. the volume, one can omit `∂volume`.
 
+Both have a version for the Lebesgue integral rather than Bochner.
+
+We prove several version of the first moment method: An integrable function is below/above its
+average on a set of positive measure.
+
 ## Implementation notes
 
 The average is defined as an integral over `(μ univ)⁻¹ • μ` so that all theorems about Bochner
@@ -27,27 +35,182 @@ function, we provide a convenience lemma `measure_theory.integrable.to_average`.
 integral, center mass, average value
 -/
 
-open measure_theory measure_theory.measure metric set filter topological_space function
-open_locale topological_space big_operators ennreal convex
+open ennreal measure_theory measure_theory.measure metric set filter topological_space function
+open_locale topology big_operators ennreal convex
 
 variables {α E F : Type*} {m0 : measurable_space α}
-  [normed_group E] [normed_space ℝ E] [complete_space E]
-  [normed_group F] [normed_space ℝ F] [complete_space F]
-  {μ : measure α} {s : set E}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
+  {μ ν : measure α} {s t : set α}
 
 /-!
 ### Average value of a function w.r.t. a measure
 
-The average value of a function `f` w.r.t. a measure `μ` (notation: `⨍ x, f x ∂μ`) is defined as
-`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ`, so it is equal to zero if `f` is not integrable or if `μ` is an
-infinite measure. If `μ` is a probability measure, then the average of any function is equal to its
-integral.
-
+The (Bochner, Lebesgue) average value of a function `f` w.r.t. a measure `μ` (notation:
+`⨍ x, f x ∂μ`, `⨍⁻ x, f x ∂μ`) is defined as the (Bochner, Lebesgue) integral divided by the total
+measure, so it is equal to zero if `μ` is an infinite measure, and (typically) equal to infinity if
+`f` is not integrable. If `μ` is a probability measure, then the average of any function is equal to
+its integral.
 -/
 
 namespace measure_theory
+section ennreal
+variables (μ) {f g : α → ℝ≥0∞}
+include m0
+
+/-- Average value of an `ℝ≥0∞`-valued function `f` w.r.t. a measure `μ`, notation: `⨍⁻ x, f x ∂μ`.
+It is defined as `μ univ⁻¹ * ∫⁻ x, f x ∂μ`, so it is equal to zero if `μ` is an infinite measure. If
+`μ` is a probability measure, then the average of any function is equal to its integral.
+
+For the average on a set, use `⨍⁻ x in s, f x ∂μ` (defined as `⨍⁻ x, f x ∂(μ.restrict s)`). For
+average w.r.t. the volume, one can omit `∂volume`. -/
+noncomputable def laverage (f : α → ℝ≥0∞) := ∫⁻ x, f x ∂((μ univ)⁻¹ • μ)
+
+notation `⨍⁻` binders `, ` r:(scoped:60 f, f) ` ∂` μ:70 := laverage μ r
+notation `⨍⁻` binders `, ` r:(scoped:60 f, laverage volume f) := r
+notation `⨍⁻` binders ` in ` s `, ` r:(scoped:60 f, f) ` ∂` μ:70 :=
+  laverage (measure.restrict μ s) r
+notation `⨍⁻` binders ` in ` s `, ` r:(scoped:60 f, laverage (measure.restrict volume s) f) := r
+
+@[simp] lemma laverage_zero : ⨍⁻ x, (0 : ℝ≥0∞) ∂μ = 0 := by rw [laverage, lintegral_zero]
+
+@[simp] lemma laverage_zero_measure (f : α → ℝ≥0∞) : ⨍⁻ x, f x ∂(0 : measure α) = 0 :=
+by simp [laverage]
+
+lemma laverage_eq' (f : α → ℝ≥0∞) : ⨍⁻ x, f x ∂μ = ∫⁻ x, f x ∂((μ univ)⁻¹ • μ) := rfl
+
+lemma laverage_eq (f : α → ℝ≥0∞) : ⨍⁻ x, f x ∂μ = ∫⁻ x, f x ∂μ / μ univ :=
+by rw [laverage_eq', lintegral_smul_measure, ennreal.div_eq_inv_mul]
+
+lemma laverage_eq_lintegral [is_probability_measure μ] (f : α → ℝ≥0∞) :
+  ⨍⁻ x, f x ∂μ = ∫⁻ x, f x ∂μ :=
+by rw [laverage, measure_univ, inv_one, one_smul]
+
+@[simp] lemma measure_mul_laverage [is_finite_measure μ] (f : α → ℝ≥0∞) :
+  μ univ * ⨍⁻ x, f x ∂μ = ∫⁻ x, f x ∂μ :=
+begin
+  cases eq_or_ne μ 0 with hμ hμ,
+  { rw [hμ, lintegral_zero_measure, laverage_zero_measure, mul_zero] },
+  { rw [laverage_eq, ennreal.mul_div_cancel' (measure_univ_ne_zero.2 hμ) (measure_ne_top _ _)] }
+end
+
+lemma set_laverage_eq (f : α → ℝ≥0∞) (s : set α) : ⨍⁻ x in s, f x ∂μ = ∫⁻ x in s, f x ∂μ / μ s :=
+by rw [laverage_eq, restrict_apply_univ]
+
+lemma set_laverage_eq' (f : α → ℝ≥0∞) (s : set α) :
+  ⨍⁻ x in s, f x ∂μ = ∫⁻ x, f x ∂((μ s)⁻¹ • μ.restrict s) :=
+by simp only [laverage_eq', restrict_apply_univ]
+
+variable {μ}
+
+lemma laverage_congr {f g : α → ℝ≥0∞} (h : f =ᵐ[μ] g) : ⨍⁻ x, f x ∂μ = ⨍⁻ x, g x ∂μ :=
+by simp only [laverage_eq, lintegral_congr_ae h]
+
+lemma set_laverage_congr (h : s =ᵐ[μ] t) : ⨍⁻ x in s, f x ∂μ = ⨍⁻ x in t, f x ∂μ :=
+by simp only [set_laverage_eq, set_lintegral_congr h, measure_congr h]
+
+lemma set_laverage_congr_fun (hs : measurable_set s) (h : ∀ᵐ x ∂μ, x ∈ s → f x = g x) :
+  ⨍⁻ x in s, f x ∂μ = ⨍⁻ x in s, g x ∂μ :=
+by simp only [laverage_eq, set_lintegral_congr_fun hs h]
+
+lemma laverage_lt_top (hf : ∫⁻ x, f x ∂μ ≠ ∞) : ⨍⁻ x, f x ∂μ < ∞ :=
+begin
+  obtain rfl | hμ := eq_or_ne μ 0,
+  { simp },
+  { rw laverage_eq,
+    exact div_lt_top hf (measure_univ_ne_zero.2 hμ) }
+end
+
+lemma set_laverage_lt_top : ∫⁻ x in s, f x ∂μ ≠ ∞ → ⨍⁻ x in s, f x ∂μ < ∞ := laverage_lt_top
+
+lemma laverage_add_measure :
+  ⨍⁻ x, f x ∂(μ + ν) =
+    μ univ / (μ univ + ν univ) * ⨍⁻ x, f x ∂μ + ν univ / (μ univ + ν univ) * ⨍⁻ x, f x ∂ν :=
+begin
+  by_cases hμ : is_finite_measure μ, swap,
+  { rw not_is_finite_measure_iff at hμ,
+    simp [laverage_eq, hμ] },
+  by_cases hν : is_finite_measure ν, swap,
+  { rw not_is_finite_measure_iff at hν,
+    simp [laverage_eq, hν] },
+  haveI := hμ, haveI := hν,
+  simp only [←ennreal.mul_div_right_comm, measure_mul_laverage, ←ennreal.add_div,
+    ←lintegral_add_measure, ←measure.add_apply, ←laverage_eq],
+end
+
+lemma measure_mul_set_laverage (f : α → ℝ≥0∞) (h : μ s ≠ ∞) :
+  μ s * ⨍⁻ x in s, f x ∂μ = ∫⁻ x in s, f x ∂μ :=
+by { haveI := fact.mk h.lt_top, rw [← measure_mul_laverage, restrict_apply_univ] }
+
+lemma laverage_union (hd : ae_disjoint μ s t) (ht : null_measurable_set t μ) :
+  ⨍⁻ x in s ∪ t, f x ∂μ =
+    μ s / (μ s + μ t) * ⨍⁻ x in s, f x ∂μ + μ t / (μ s + μ t) * ⨍⁻ x in t, f x ∂μ :=
+by rw [restrict_union₀ hd ht, laverage_add_measure, restrict_apply_univ, restrict_apply_univ]
+
+lemma laverage_union_mem_open_segment (hd : ae_disjoint μ s t) (ht : null_measurable_set t μ)
+  (hs₀ : μ s ≠ 0) (ht₀ : μ t ≠ 0) (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞) :
+  ⨍⁻ x in s ∪ t, f x ∂μ ∈ open_segment ℝ≥0∞ (⨍⁻ x in s, f x ∂μ) (⨍⁻ x in t, f x ∂μ) :=
+begin
+  refine ⟨μ s / (μ s + μ t), μ t / (μ s + μ t), ennreal.div_pos hs₀ $ add_ne_top.2 ⟨hsμ, htμ⟩,
+    ennreal.div_pos ht₀ $ add_ne_top.2 ⟨hsμ, htμ⟩, _, (laverage_union hd ht).symm⟩,
+  rw [←ennreal.add_div, ennreal.div_self (add_eq_zero.not.2 $ λ h, hs₀ h.1)
+    (add_ne_top.2 ⟨hsμ, htμ⟩)],
+end
+
+lemma laverage_union_mem_segment (hd : ae_disjoint μ s t) (ht : null_measurable_set t μ)
+  (hsμ : μ s ≠ ∞) (htμ : μ t ≠ ∞) :
+  ⨍⁻ x in s ∪ t, f x ∂μ ∈ [⨍⁻ x in s, f x ∂μ -[ℝ≥0∞] ⨍⁻ x in t, f x ∂μ] :=
+begin
+  by_cases hs₀ : μ s = 0,
+  { rw ← ae_eq_empty at hs₀,
+    rw [restrict_congr_set (hs₀.union eventually_eq.rfl), empty_union],
+    exact right_mem_segment _ _ _ },
+  { refine ⟨μ s / (μ s + μ t), μ t / (μ s + μ t), zero_le _, zero_le _, _,
+      (laverage_union hd ht).symm⟩,
+    rw [←ennreal.add_div, ennreal.div_self (add_eq_zero.not.2 $ λ h, hs₀ h.1)
+      (add_ne_top.2 ⟨hsμ, htμ⟩)] }
+end
+
+lemma laverage_mem_open_segment_compl_self [is_finite_measure μ] (hs : null_measurable_set s μ)
+  (hs₀ : μ s ≠ 0) (hsc₀ : μ sᶜ ≠ 0) :
+  ⨍⁻ x, f x ∂μ ∈ open_segment ℝ≥0∞ (⨍⁻ x in s, f x ∂μ) (⨍⁻ x in sᶜ, f x ∂μ) :=
+by simpa only [union_compl_self, restrict_univ]
+  using laverage_union_mem_open_segment ae_disjoint_compl_right hs.compl hs₀ hsc₀
+    (measure_ne_top _ _) (measure_ne_top _ _)
+
+@[simp] lemma laverage_const (μ : measure α) [is_finite_measure μ] [h : μ.ae.ne_bot] (c : ℝ≥0∞) :
+  ⨍⁻ x, c ∂μ = c :=
+by simp only [laverage_eq, lintegral_const, measure.restrict_apply, measurable_set.univ, univ_inter,
+  div_eq_mul_inv, mul_assoc, ennreal.mul_inv_cancel, mul_one, measure_ne_top μ univ, ne.def,
+  measure_univ_ne_zero, ae_ne_bot.1 h, not_false_iff]
+
+lemma set_laverage_const (hs₀ : μ s ≠ 0) (hs : μ s ≠ ∞) (c : ℝ≥0∞) : ⨍⁻ x in s, c ∂μ = c :=
+by simp only [set_laverage_eq, lintegral_const, measure.restrict_apply, measurable_set.univ,
+  univ_inter, div_eq_mul_inv, mul_assoc, ennreal.mul_inv_cancel hs₀ hs, mul_one]
+
+@[simp] lemma laverage_one [is_finite_measure μ] [h : μ.ae.ne_bot] : ⨍⁻ x, (1 : ℝ≥0∞) ∂μ = 1 :=
+laverage_const _ _
+
+lemma set_laverage_one (hs₀ : μ s ≠ 0) (hs : μ s ≠ ∞) : ⨍⁻ x in s, (1 : ℝ≥0∞) ∂μ = 1 :=
+set_laverage_const hs₀ hs _
 
-variable (μ)
+@[simp] lemma lintegral_laverage (μ : measure α) [is_finite_measure μ] (f : α → ℝ≥0∞) :
+  ∫⁻ x, ⨍⁻ a, f a ∂μ ∂μ = ∫⁻ x, f x ∂μ :=
+begin
+  unfreezingI { obtain rfl | hμ := eq_or_ne μ 0 },
+  { simp },
+  { rw [lintegral_const, laverage_eq,
+      ennreal.div_mul_cancel (measure_univ_ne_zero.2 hμ) (measure_ne_top _ _)] }
+end
+
+lemma set_lintegral_set_laverage (μ : measure α) [is_finite_measure μ] (f : α → ℝ≥0∞) (s : set α) :
+  ∫⁻ x in s, ⨍⁻ a in s, f a ∂μ ∂μ = ∫⁻ x in s, f x ∂μ :=
+lintegral_laverage _ _
+
+end ennreal
+
+section normed_add_comm_group
+variables (μ) {f g : α → E}
 include m0
 
 /-- Average value of a function `f` w.r.t. a measure `μ`, notation: `⨍ x, f x ∂μ`. It is defined as
@@ -71,33 +234,44 @@ by rw [average, smul_zero, integral_zero_measure]
 
 @[simp] lemma average_neg (f : α → E) : ⨍ x, -f x ∂μ = -⨍ x, f x ∂μ := integral_neg f
 
-lemma average_def (f : α → E) : ⨍ x, f x ∂μ = ∫ x, f x ∂((μ univ)⁻¹ • μ) := rfl
+lemma average_eq' (f : α → E) : ⨍ x, f x ∂μ = ∫ x, f x ∂((μ univ)⁻¹ • μ) := rfl
 
-lemma average_def' (f : α → E) : ⨍ x, f x ∂μ = (μ univ).to_real⁻¹ • ∫ x, f x ∂μ :=
-by rw [average_def, integral_smul_measure, ennreal.to_real_inv]
+lemma average_eq (f : α → E) : ⨍ x, f x ∂μ = (μ univ).to_real⁻¹ • ∫ x, f x ∂μ :=
+by rw [average_eq', integral_smul_measure, ennreal.to_real_inv]
 
 lemma average_eq_integral [is_probability_measure μ] (f : α → E) :
   ⨍ x, f x ∂μ = ∫ x, f x ∂μ :=
-by rw [average, measure_univ, ennreal.inv_one, one_smul]
+by rw [average, measure_univ, inv_one, one_smul]
 
 @[simp] lemma measure_smul_average [is_finite_measure μ] (f : α → E) :
   (μ univ).to_real • ⨍ x, f x ∂μ = ∫ x, f x ∂μ :=
 begin
   cases eq_or_ne μ 0 with hμ hμ,
   { rw [hμ, integral_zero_measure, average_zero_measure, smul_zero] },
-  { rw [average_def', smul_inv_smul₀],
+  { rw [average_eq, smul_inv_smul₀],
     refine (ennreal.to_real_pos _ $ measure_ne_top _ _).ne',
     rwa [ne.def, measure_univ_eq_zero] }
 end
 
 lemma set_average_eq (f : α → E) (s : set α) :
   ⨍ x in s, f x ∂μ = (μ s).to_real⁻¹ • ∫ x in s, f x ∂μ :=
-by rw [average_def', restrict_apply_univ]
+by rw [average_eq, restrict_apply_univ]
+
+lemma set_average_eq' (f : α → E) (s : set α) :
+  ⨍ x in s, f x ∂μ = ∫ x, f x ∂((μ s)⁻¹ • μ.restrict s) :=
+by simp only [average_eq', restrict_apply_univ]
 
 variable {μ}
 
 lemma average_congr {f g : α → E} (h : f =ᵐ[μ] g) : ⨍ x, f x ∂μ = ⨍ x, g x ∂μ :=
-by simp only [average_def', integral_congr_ae h]
+by simp only [average_eq, integral_congr_ae h]
+
+lemma set_average_congr (h : s =ᵐ[μ] t) : ⨍ x in s, f x ∂μ = ⨍ x in t, f x ∂μ :=
+by simp only [set_average_eq, set_integral_congr_set_ae h, measure_congr h]
+
+lemma set_average_congr_fun (hs : measurable_set s) (h : ∀ᵐ x ∂μ, x ∈ s → f x = g x) :
+  ⨍ x in s, f x ∂μ = ⨍ x in s, g x ∂μ :=
+by simp only [average_eq, set_integral_congr_ae hs h]
 
 lemma average_add_measure [is_finite_measure μ] {ν : measure α} [is_finite_measure ν] {f : α → E}
   (hμ : integrable f μ) (hν : integrable f ν) :
@@ -107,7 +281,7 @@ lemma average_add_measure [is_finite_measure μ] {ν : measure α} [is_finite_me
 begin
   simp only [div_eq_inv_mul, mul_smul, measure_smul_average, ← smul_add,
     ← integral_add_measure hμ hν, ← ennreal.to_real_add (measure_ne_top μ _) (measure_ne_top ν _)],
-  rw [average_def', measure.add_apply]
+  rw [average_eq, measure.add_apply]
 end
 
 lemma average_pair {f : α → E} {g : α → F} (hfi : integrable f μ) (hgi : integrable g μ) :
@@ -162,4 +336,362 @@ by simpa only [union_compl_self, restrict_univ]
   using average_union_mem_open_segment ae_disjoint_compl_right hs.compl hs₀ hsc₀
     (measure_ne_top _ _) (measure_ne_top _ _) hfi.integrable_on hfi.integrable_on
 
+@[simp] lemma average_const (μ : measure α) [is_finite_measure μ] [h : μ.ae.ne_bot] (c : E) :
+  ⨍ x, c ∂μ = c :=
+by simp only [average_eq, integral_const, measure.restrict_apply, measurable_set.univ, one_smul,
+  univ_inter, smul_smul, ← ennreal.to_real_inv, ← ennreal.to_real_mul, ennreal.inv_mul_cancel,
+  measure_ne_top μ univ, ne.def, measure_univ_eq_zero, ae_ne_bot.1 h, not_false_iff,
+  ennreal.one_to_real]
+
+lemma set_average_const {s : set α} (hs₀ : μ s ≠ 0) (hs : μ s ≠ ∞) (c : E) :
+  ⨍ x in s, c ∂μ = c :=
+by simp only [set_average_eq, integral_const, measure.restrict_apply, measurable_set.univ,
+  univ_inter, smul_smul, ← ennreal.to_real_inv, ← ennreal.to_real_mul,
+  ennreal.inv_mul_cancel hs₀ hs, ennreal.one_to_real, one_smul]
+
+@[simp] lemma integral_average (μ : measure α) [is_finite_measure μ] (f : α → E) :
+  ∫ x, ⨍ a, f a ∂μ ∂μ = ∫ x, f x ∂μ :=
+begin
+  unfreezingI { obtain rfl | hμ := eq_or_ne μ 0 },
+  { simp only [integral_zero_measure] },
+  { rw [integral_const, average_eq,
+      smul_inv_smul₀ (to_real_ne_zero.2 ⟨measure_univ_ne_zero.2 hμ, measure_ne_top _ _⟩)] }
+end
+
+lemma set_integral_set_average (μ : measure α) [is_finite_measure μ] (f : α → E) (s : set α) :
+  ∫ x in s, ⨍ a in s, f a ∂μ ∂μ = ∫ x in s, f x ∂μ :=
+integral_average _ _
+
+lemma integral_sub_average (μ : measure α) [is_finite_measure μ] (f : α → E) :
+  ∫ x, f x - ⨍ a, f a ∂μ ∂μ = 0 :=
+begin
+  by_cases hf : integrable f μ,
+  { rw [integral_sub hf (integrable_const _), integral_average, sub_self] },
+  refine integral_undef (λ h, hf _),
+  convert h.add (integrable_const _),
+  exact (sub_add_cancel _ _).symm,
+end
+
+lemma set_integral_sub_set_average (hs : μ s ≠ ∞) (f : α → E) :
+  ∫ x in s, f x - ⨍ a in s, f a ∂μ ∂μ = 0 :=
+by haveI haveI : fact (μ s < ∞) := ⟨lt_top_iff_ne_top.2 hs⟩; exact integral_sub_average _ _
+
+lemma integral_average_sub [is_finite_measure μ] (hf : integrable f μ) :
+  ∫ x, ⨍ a, f a ∂μ - f x ∂μ = 0 :=
+by rw [integral_sub (integrable_const _) hf, integral_average, sub_self]
+
+lemma set_integral_set_average_sub (hs : μ s ≠ ∞) (hf : integrable_on f s μ) :
+  ∫ x in s, ⨍ a in s, f a ∂μ - f x ∂μ = 0 :=
+by haveI haveI : fact (μ s < ∞) := ⟨lt_top_iff_ne_top.2 hs⟩; exact integral_average_sub hf
+
+end normed_add_comm_group
+
+lemma of_real_average {f : α → ℝ} (hf : integrable f μ) (hf₀ : 0 ≤ᵐ[μ] f) :
+  ennreal.of_real (⨍ x, f x ∂μ) = (∫⁻ x, ennreal.of_real (f x) ∂μ) / μ univ :=
+begin
+  obtain rfl | hμ := eq_or_ne μ 0,
+  { simp },
+  { rw [average_eq, smul_eq_mul, ←to_real_inv, of_real_mul (to_real_nonneg),
+      of_real_to_real (inv_ne_top.2 $ measure_univ_ne_zero.2 hμ),
+      of_real_integral_eq_lintegral_of_real hf hf₀, ennreal.div_eq_inv_mul] }
+end
+
+lemma of_real_set_average {f : α → ℝ} (hf : integrable_on f s μ)
+  (hf₀ : 0 ≤ᵐ[μ.restrict s] f) :
+  ennreal.of_real (⨍ x in s, f x ∂μ) = (∫⁻ x in s, ennreal.of_real (f x) ∂μ) / μ s :=
+by simpa using of_real_average hf hf₀
+
+lemma to_real_laverage {f : α → ℝ≥0∞} (hf : ae_measurable f μ) (hf' : ∀ᵐ x ∂μ, f x ≠ ∞) :
+  (⨍⁻ x, f x ∂μ).to_real = ⨍ x, (f x).to_real ∂μ :=
+begin
+  obtain rfl | hμ := eq_or_ne μ 0,
+  { simp },
+  { rw [average_eq, laverage_eq, smul_eq_mul, to_real_div, div_eq_inv_mul,
+      ←integral_to_real hf (hf'.mono $ λ _, lt_top_iff_ne_top.2)] }
+end
+
+lemma to_real_set_laverage {f : α → ℝ≥0∞} (hf : ae_measurable f (μ.restrict s))
+  (hf' : ∀ᵐ x ∂(μ.restrict s), f x ≠ ∞) :
+  (∫⁻ x in s, f x ∂μ / μ s).to_real = ⨍ x in s, (f x).to_real ∂μ :=
+by simpa [laverage_eq] using to_real_laverage hf hf'
+
+/-! ### First moment method -/
+
+section first_moment_real
+variables {N : set α} {f : α → ℝ}
+
+/-- **First moment method**. An integrable function is smaller than its mean on a set of positive
+measure. -/
+lemma measure_le_set_average_pos (hμ : μ s ≠ 0) (hμ₁ : μ s ≠ ∞) (hf : integrable_on f s μ) :
+  0 < μ {x ∈ s | f x ≤ ⨍ a in s, f a ∂μ} :=
+begin
+  refine pos_iff_ne_zero.2 (λ H, _),
+  replace H : (μ.restrict s) {x | f x ≤ ⨍ a in s, f a ∂μ} = 0,
+  { rwa [restrict_apply₀, inter_comm],
+    exact ae_strongly_measurable.null_measurable_set_le hf.1 ae_strongly_measurable_const },
+  haveI : is_finite_measure (μ.restrict s) :=
+    ⟨by simpa only [measure.restrict_apply, measurable_set.univ, univ_inter] using hμ₁.lt_top⟩,
+  refine (integral_sub_average (μ.restrict s) f).not_gt _,
+  refine (set_integral_pos_iff_support_of_nonneg_ae _ _).2 _,
+  { refine eq_bot_mono (measure_mono (λ x hx, _)) H,
+    simp only [pi.zero_apply, sub_nonneg, mem_compl_iff, mem_set_of_eq, not_le] at hx,
+    exact hx.le },
+  { exact hf.sub (integrable_on_const.2 $ or.inr $ lt_top_iff_ne_top.2 hμ₁) },
+  { rwa [pos_iff_ne_zero, inter_comm, ←diff_compl, ←diff_inter_self_eq_diff, measure_diff_null],
+    refine eq_bot_mono (measure_mono _) (measure_inter_eq_zero_of_restrict H),
+    exact inter_subset_inter_left _ (λ a ha, (sub_eq_zero.1 $ of_not_not ha).le) }
+end
+
+/-- **First moment method**. An integrable function is greater than its mean on a set of positive
+measure. -/
+lemma measure_set_average_le_pos (hμ : μ s ≠ 0) (hμ₁ : μ s ≠ ∞) (hf : integrable_on f s μ) :
+  0 < μ {x ∈ s | ⨍ a in s, f a ∂μ ≤ f x} :=
+by simpa [integral_neg, neg_div] using measure_le_set_average_pos hμ hμ₁ hf.neg
+
+/-- **First moment method**. The minimum of an integrable function is smaller than its mean. -/
+lemma exists_le_set_average (hμ : μ s ≠ 0) (hμ₁ : μ s ≠ ∞) (hf : integrable_on f s μ) :
+  ∃ x ∈ s, f x ≤ ⨍ a in s, f a ∂μ :=
+let ⟨x, hx, h⟩ := nonempty_of_measure_ne_zero (measure_le_set_average_pos hμ hμ₁ hf).ne'
+  in ⟨x, hx, h⟩
+
+/-- **First moment method**. The maximum of an integrable function is greater than its mean. -/
+lemma exists_set_average_le (hμ : μ s ≠ 0) (hμ₁ : μ s ≠ ∞) (hf : integrable_on f s μ) :
+  ∃ x ∈ s, ⨍ a in s, f a ∂μ ≤ f x :=
+let ⟨x, hx, h⟩ := nonempty_of_measure_ne_zero (measure_set_average_le_pos hμ hμ₁ hf).ne'
+  in ⟨x, hx, h⟩
+
+section finite_measure
+variables [is_finite_measure μ]
+
+/-- **First moment method**. An integrable function is smaller than its mean on a set of positive
+measure. -/
+lemma measure_le_average_pos (hμ : μ ≠ 0) (hf : integrable f μ) : 0 < μ {x | f x ≤ ⨍ a, f a ∂μ} :=
+by simpa using measure_le_set_average_pos (measure.measure_univ_ne_zero.2 hμ) (measure_ne_top _ _)
+  hf.integrable_on
+
+/-- **First moment method**. An integrable function is greater than its mean on a set of positive
+measure. -/
+lemma measure_average_le_pos (hμ : μ ≠ 0) (hf : integrable f μ) : 0 < μ {x | ⨍ a, f a ∂μ ≤ f x} :=
+by simpa using measure_set_average_le_pos (measure.measure_univ_ne_zero.2 hμ) (measure_ne_top _ _)
+  hf.integrable_on
+
+/-- **First moment method**. The minimum of an integrable function is smaller than its mean. -/
+lemma exists_le_average (hμ : μ ≠ 0) (hf : integrable f μ) : ∃ x, f x ≤ ⨍ a, f a ∂μ :=
+let ⟨x, hx⟩ := nonempty_of_measure_ne_zero (measure_le_average_pos hμ hf).ne' in ⟨x, hx⟩
+
+/-- **First moment method**. The maximum of an integrable function is greater than its mean. -/
+lemma exists_average_le (hμ : μ ≠ 0) (hf : integrable f μ) : ∃ x, ⨍ a, f a ∂μ ≤ f x :=
+let ⟨x, hx⟩ := nonempty_of_measure_ne_zero (measure_average_le_pos hμ hf).ne' in ⟨x, hx⟩
+
+/-- **First moment method**. The minimum of an integrable function is smaller than its mean, while
+avoiding a null set. -/
+lemma exists_not_mem_null_le_average (hμ : μ ≠ 0) (hf : integrable f μ) (hN : μ N = 0) :
+  ∃ x ∉ N, f x ≤ ⨍ a, f a ∂μ :=
+begin
+  have := measure_le_average_pos hμ hf,
+  rw ←measure_diff_null hN at this,
+  obtain ⟨x, hx, hxN⟩ := nonempty_of_measure_ne_zero this.ne',
+  exact ⟨x, hxN, hx⟩,
+end
+
+/-- **First moment method**. The maximum of an integrable function is greater than its mean, while
+avoiding a null set. -/
+lemma exists_not_mem_null_average_le (hμ : μ ≠ 0) (hf : integrable f μ) (hN : μ N = 0) :
+  ∃ x ∉ N, ⨍ a, f a ∂μ ≤ f x :=
+by simpa [integral_neg, neg_div] using exists_not_mem_null_le_average hμ hf.neg hN
+
+end finite_measure
+
+section probability_measure
+variables [is_probability_measure μ]
+
+/-- **First moment method**. An integrable function is smaller than its integral on a set of
+positive measure. -/
+lemma measure_le_integral_pos (hf : integrable f μ) : 0 < μ {x | f x ≤ ∫ a, f a ∂μ} :=
+by simpa only [average_eq_integral]
+  using measure_le_average_pos (is_probability_measure.ne_zero μ) hf
+
+/-- **First moment method**. An integrable function is greater than its integral on a set of
+positive measure. -/
+lemma measure_integral_le_pos (hf : integrable f μ) : 0 < μ {x | ∫ a, f a ∂μ ≤ f x} :=
+by simpa only [average_eq_integral]
+  using measure_average_le_pos (is_probability_measure.ne_zero μ) hf
+
+/-- **First moment method**. The minimum of an integrable function is smaller than its integral. -/
+lemma exists_le_integral (hf : integrable f μ) : ∃ x, f x ≤ ∫ a, f a ∂μ :=
+by simpa only [average_eq_integral] using exists_le_average (is_probability_measure.ne_zero μ) hf
+
+/-- **First moment method**. The maximum of an integrable function is greater than its integral. -/
+lemma exists_integral_le (hf : integrable f μ) : ∃ x, ∫ a, f a ∂μ ≤ f x :=
+by simpa only [average_eq_integral] using exists_average_le (is_probability_measure.ne_zero μ) hf
+
+/-- **First moment method**. The minimum of an integrable function is smaller than its integral,
+while avoiding a null set. -/
+lemma exists_not_mem_null_le_integral (hf : integrable f μ) (hN : μ N = 0) :
+  ∃ x ∉ N, f x ≤ ∫ a, f a ∂μ :=
+by simpa only [average_eq_integral]
+  using exists_not_mem_null_le_average (is_probability_measure.ne_zero μ) hf hN
+
+/-- **First moment method**. The maximum of an integrable function is greater than its integral,
+while avoiding a null set. -/
+lemma exists_not_mem_null_integral_le (hf : integrable f μ) (hN : μ N = 0) :
+  ∃ x ∉ N, ∫ a, f a ∂μ ≤ f x :=
+by simpa only [average_eq_integral]
+  using exists_not_mem_null_average_le (is_probability_measure.ne_zero μ) hf hN
+
+end probability_measure
+end first_moment_real
+
+section first_moment_ennreal
+variables {N : set α} {f : α → ℝ≥0∞}
+
+/-- **First moment method**. A measurable function is smaller than its mean on a set of positive
+measure. -/
+lemma measure_le_set_laverage_pos (hμ : μ s ≠ 0) (hμ₁ : μ s ≠ ∞)
+  (hf : ae_measurable f (μ.restrict s)) : 0 < μ {x ∈ s | f x ≤ ⨍⁻ a in s, f a ∂μ} :=
+begin
+  obtain h | h := eq_or_ne (∫⁻ a in s, f a ∂μ) ∞,
+  { simpa [mul_top, hμ₁, laverage, h, top_div_of_ne_top hμ₁, pos_iff_ne_zero] using hμ },
+  have := measure_le_set_average_pos hμ hμ₁ (integrable_to_real_of_lintegral_ne_top hf h),
+  rw [←set_of_inter_eq_sep, ←measure.restrict_apply₀
+    (hf.ae_strongly_measurable.null_measurable_set_le ae_strongly_measurable_const)],
+  rw [←set_of_inter_eq_sep, ←measure.restrict_apply₀
+    (hf.ennreal_to_real.ae_strongly_measurable.null_measurable_set_le ae_strongly_measurable_const),
+    ←measure_diff_null (measure_eq_top_of_lintegral_ne_top hf h)] at this,
+  refine this.trans_le (measure_mono _),
+  rintro x ⟨hfx, hx⟩,
+  dsimp at hfx,
+  rwa [←to_real_laverage hf, to_real_le_to_real hx (set_laverage_lt_top h).ne] at hfx,
+  { simp_rw [ae_iff, not_ne_iff],
+    exact measure_eq_top_of_lintegral_ne_top hf h }
+end
+
+/-- **First moment method**. A measurable function is greater than its mean on a set of positive
+measure. -/
+lemma measure_set_laverage_le_pos (hμ : μ s ≠ 0) (hs : null_measurable_set s μ)
+  (hint : ∫⁻ a in s, f a ∂μ ≠ ∞) : 0 < μ {x ∈ s | ⨍⁻ a in s, f a ∂μ ≤ f x} :=
+begin
+  obtain hμ₁ | hμ₁ := eq_or_ne (μ s) ∞,
+  { simp [set_laverage_eq, hμ₁] },
+  obtain ⟨g, hg, hgf, hfg⟩ := exists_measurable_le_lintegral_eq (μ.restrict s) f,
+  have hfg' : ⨍⁻ a in s, f a ∂μ = ⨍⁻ a in s, g a ∂μ,
+  { simp_rw [laverage_eq, hfg] },
+  rw hfg at hint,
+  have := measure_set_average_le_pos hμ hμ₁
+    (integrable_to_real_of_lintegral_ne_top hg.ae_measurable hint),
+  simp_rw [←set_of_inter_eq_sep, ←measure.restrict_apply₀' hs, hfg'],
+  rw [←set_of_inter_eq_sep, ←measure.restrict_apply₀' hs,
+    ←measure_diff_null (measure_eq_top_of_lintegral_ne_top hg.ae_measurable hint)] at this,
+  refine this.trans_le (measure_mono _),
+  rintro x ⟨hfx, hx⟩,
+  dsimp at hfx,
+  rw [←to_real_laverage hg.ae_measurable, to_real_le_to_real (set_laverage_lt_top hint).ne hx]
+    at hfx,
+  exact hfx.trans (hgf _),
+  { simp_rw [ae_iff, not_ne_iff],
+    exact measure_eq_top_of_lintegral_ne_top hg.ae_measurable hint }
+end
+
+/-- **First moment method**. The minimum of a measurable function is smaller than its mean. -/
+lemma exists_le_set_laverage (hμ : μ s ≠ 0) (hμ₁ : μ s ≠ ∞) (hf : ae_measurable f (μ.restrict s)) :
+  ∃ x ∈ s, f x ≤ ⨍⁻ a in s, f a ∂μ :=
+let ⟨x, hx, h⟩ := nonempty_of_measure_ne_zero (measure_le_set_laverage_pos hμ hμ₁ hf).ne'
+  in ⟨x, hx, h⟩
+
+/-- **First moment method**. The maximum of a measurable function is greater than its mean. -/
+lemma exists_set_laverage_le (hμ : μ s ≠ 0) (hs : null_measurable_set s μ)
+  (hint : ∫⁻ a in s, f a ∂μ ≠ ∞) : ∃ x ∈ s, ⨍⁻ a in s, f a ∂μ ≤ f x :=
+let ⟨x, hx, h⟩ := nonempty_of_measure_ne_zero (measure_set_laverage_le_pos hμ hs hint).ne'
+  in ⟨x, hx, h⟩
+
+/-- **First moment method**. A measurable function is greater than its mean on a set of positive
+measure. -/
+lemma measure_laverage_le_pos (hμ : μ ≠ 0) (hint : ∫⁻ a, f a ∂μ ≠ ∞) :
+  0 < μ {x | ⨍⁻ a, f a ∂μ ≤ f x} :=
+by simpa [hint] using @measure_set_laverage_le_pos _ _ _ _ f (measure_univ_ne_zero.2 hμ)
+  null_measurable_set_univ
+
+/-- **First moment method**. The maximum of a measurable function is greater than its mean. -/
+lemma exists_laverage_le (hμ : μ ≠ 0) (hint : ∫⁻ a, f a ∂μ ≠ ∞) : ∃ x, ⨍⁻ a, f a ∂μ ≤ f x :=
+let ⟨x, hx⟩ := nonempty_of_measure_ne_zero (measure_laverage_le_pos hμ hint).ne' in ⟨x, hx⟩
+
+/-- **First moment method**. The maximum of a measurable function is greater than its mean, while
+avoiding a null set. -/
+lemma exists_not_mem_null_laverage_le (hμ : μ ≠ 0) (hint : ∫⁻ (a : α), f a ∂μ ≠ ∞) (hN : μ N = 0) :
+  ∃ x ∉ N, ⨍⁻ a, f a ∂μ ≤ f x :=
+begin
+  have := measure_laverage_le_pos hμ hint,
+  rw ←measure_diff_null hN at this,
+  obtain ⟨x, hx, hxN⟩ := nonempty_of_measure_ne_zero this.ne',
+  exact ⟨x, hxN, hx⟩,
+end
+
+section finite_measure
+variables [is_finite_measure μ]
+
+/-- **First moment method**. A measurable function is smaller than its mean on a set of positive
+measure. -/
+lemma measure_le_laverage_pos (hμ : μ ≠ 0) (hf : ae_measurable f μ) :
+  0 < μ {x | f x ≤ ⨍⁻ a, f a ∂μ} :=
+by simpa
+  using measure_le_set_laverage_pos (measure_univ_ne_zero.2 hμ) (measure_ne_top _ _) hf.restrict
+
+/-- **First moment method**. The minimum of a measurable function is smaller than its mean. -/
+lemma exists_le_laverage (hμ : μ ≠ 0) (hf : ae_measurable f μ) : ∃ x, f x ≤ ⨍⁻ a, f a ∂μ :=
+let ⟨x, hx⟩ := nonempty_of_measure_ne_zero (measure_le_laverage_pos hμ hf).ne' in ⟨x, hx⟩
+
+/-- **First moment method**. The minimum of a measurable function is smaller than its mean, while
+avoiding a null set. -/
+lemma exists_not_mem_null_le_laverage (hμ : μ ≠ 0) (hf : ae_measurable f μ) (hN : μ N = 0) :
+  ∃ x ∉ N, f x ≤ ⨍⁻ a, f a ∂μ :=
+begin
+  have := measure_le_laverage_pos hμ hf,
+  rw ←measure_diff_null hN at this,
+  obtain ⟨x, hx, hxN⟩ := nonempty_of_measure_ne_zero this.ne',
+  exact ⟨x, hxN, hx⟩,
+end
+
+end finite_measure
+
+section probability_measure
+variables [is_probability_measure μ]
+
+/-- **First moment method**. A measurable function is smaller than its integral on a set of
+positive measure. -/
+lemma measure_le_lintegral_pos (hf : ae_measurable f μ) : 0 < μ {x | f x ≤ ∫⁻ a, f a ∂μ} :=
+by simpa only [laverage_eq_lintegral]
+  using measure_le_laverage_pos (is_probability_measure.ne_zero μ) hf
+
+/-- **First moment method**. A measurable function is greater than its integral on a set of
+positive measure. -/
+lemma measure_lintegral_le_pos (hint : ∫⁻ a, f a ∂μ ≠ ∞) : 0 < μ {x | ∫⁻ a, f a ∂μ ≤ f x} :=
+by simpa only [laverage_eq_lintegral]
+  using measure_laverage_le_pos (is_probability_measure.ne_zero μ) hint
+
+/-- **First moment method**. The minimum of a measurable function is smaller than its integral. -/
+lemma exists_le_lintegral (hf : ae_measurable f μ) : ∃ x, f x ≤ ∫⁻ a, f a ∂μ :=
+by simpa only [laverage_eq_lintegral]
+  using exists_le_laverage (is_probability_measure.ne_zero μ) hf
+
+/-- **First moment method**. The maximum of a measurable function is greater than its integral. -/
+lemma exists_lintegral_le (hint : ∫⁻ a, f a ∂μ ≠ ∞) : ∃ x, ∫⁻ a, f a ∂μ ≤ f x :=
+by simpa only [laverage_eq_lintegral]
+  using exists_laverage_le (is_probability_measure.ne_zero μ) hint
+
+/-- **First moment method**. The minimum of a measurable function is smaller than its integral,
+while avoiding a null set. -/
+lemma exists_not_mem_null_le_lintegral (hf : ae_measurable f μ) (hN : μ N = 0) :
+  ∃ x ∉ N, f x ≤ ∫⁻ a, f a ∂μ :=
+by simpa only [laverage_eq_lintegral]
+  using exists_not_mem_null_le_laverage (is_probability_measure.ne_zero μ) hf hN
+
+/-- **First moment method**. The maximum of a measurable function is greater than its integral,
+while avoiding a null set. -/
+lemma exists_not_mem_null_lintegral_le (hint : ∫⁻ a, f a ∂μ ≠ ∞)
+  (hN : μ N = 0) : ∃ x ∉ N, ∫⁻ a, f a ∂μ ≤ f x :=
+by simpa only [laverage_eq_lintegral]
+  using exists_not_mem_null_laverage_le (is_probability_measure.ne_zero μ) hint hN
+
+end probability_measure
+end first_moment_ennreal
 end measure_theory
diff --git a/src/measure_theory/integral/bochner.lean b/src/measure_theory/integral/bochner.lean
index 6c728afa447d5..84076d698e9b8 100644
--- a/src/measure_theory/integral/bochner.lean
+++ b/src/measure_theory/integral/bochner.lean
@@ -4,12 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou, Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne
 -/
 import measure_theory.integral.set_to_l1
-import analysis.normed_space.bounded_linear_maps
-import topology.sequences
 
 /-!
 # Bochner integral
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Bochner integral extends the definition of the Lebesgue integral to functions that map from a
 measure space into a Banach space (complete normed vector space). It is constructed here by
 extending the integral on simple functions.
@@ -53,7 +54,7 @@ file `set_to_L1`).
   * `integral_sub`                   : `∫ x, f x - g x ∂μ = ∫ x, f x ∂μ - ∫ x, g x ∂μ`
   * `integral_smul`                  : `∫ x, r • f x ∂μ = r • ∫ x, f x ∂μ`
   * `integral_congr_ae`              : `f =ᵐ[μ] g → ∫ x, f x ∂μ = ∫ x, g x ∂μ`
-  * `norm_integral_le_integral_norm` : `∥∫ x, f x ∂μ∥ ≤ ∫ x, ∥f x∥ ∂μ`
+  * `norm_integral_le_integral_norm` : `‖∫ x, f x ∂μ‖ ≤ ∫ x, ‖f x‖ ∂μ`
 
 2. Basic properties of the Bochner integral on functions of type `α → ℝ`, where `α` is a measure
   space.
@@ -101,7 +102,7 @@ functions :
 
 1. First go to the `L¹` space.
 
-   For example, if you see `ennreal.to_real (∫⁻ a, ennreal.of_real $ ∥f a∥)`, that is the norm of
+   For example, if you see `ennreal.to_real (∫⁻ a, ennreal.of_real $ ‖f a‖)`, that is the norm of
    `f` in `L¹` space. Rewrite using `L1.norm_of_fun_eq_lintegral_norm`.
 
 2. Show that the set `{f ∈ L¹ | ∫ f = ∫⁻ f⁺ - ∫⁻ f⁻}` is closed in `L¹` using `is_closed_eq`.
@@ -141,8 +142,10 @@ Bochner integral, simple function, function space, Lebesgue dominated convergenc
 
 -/
 
+assert_not_exists differentiable
+
 noncomputable theory
-open_locale topological_space big_operators nnreal ennreal measure_theory
+open_locale topology big_operators nnreal ennreal measure_theory
 open set filter topological_space ennreal emetric
 
 namespace measure_theory
@@ -153,7 +156,7 @@ section weighted_smul
 
 open continuous_linear_map
 
-variables [normed_group F] [normed_space ℝ F] {m : measurable_space α} {μ : measure α}
+variables [normed_add_comm_group F] [normed_space ℝ F] {m : measurable_space α} {μ : measure α}
 
 /-- Given a set `s`, return the continuous linear map `λ x, (μ s).to_real • x`. The extension of
 that set function through `set_to_L1` gives the Bochner integral of L1 functions. -/
@@ -221,10 +224,10 @@ lemma weighted_smul_smul [normed_field 𝕜] [normed_space 𝕜 F] [smul_comm_cl
   weighted_smul μ s (c • x) = c • weighted_smul μ s x :=
 by { simp_rw [weighted_smul_apply, smul_comm], }
 
-lemma norm_weighted_smul_le (s : set α) : ∥(weighted_smul μ s : F →L[ℝ] F)∥ ≤ (μ s).to_real :=
-calc ∥(weighted_smul μ s : F →L[ℝ] F)∥ = ∥(μ s).to_real∥ * ∥continuous_linear_map.id ℝ F∥ :
+lemma norm_weighted_smul_le (s : set α) : ‖(weighted_smul μ s : F →L[ℝ] F)‖ ≤ (μ s).to_real :=
+calc ‖(weighted_smul μ s : F →L[ℝ] F)‖ = ‖(μ s).to_real‖ * ‖continuous_linear_map.id ℝ F‖ :
   norm_smul _ _
-... ≤ ∥(μ s).to_real∥ : (mul_le_mul_of_nonneg_left norm_id_le (norm_nonneg _)).trans (mul_one _).le
+... ≤ ‖(μ s).to_real‖ : (mul_le_mul_of_nonneg_left norm_id_le (norm_nonneg _)).trans (mul_one _).le
 ... = abs (μ s).to_real : real.norm_eq_abs _
 ... = (μ s).to_real : abs_eq_self.mpr ennreal.to_real_nonneg
 
@@ -278,8 +281,8 @@ and prove basic property of this integral.
 -/
 open finset
 
-variables [normed_group E] [normed_group F] [normed_space ℝ F] {p : ℝ≥0∞}
-  {G F' : Type*} [normed_group G] [normed_group F'] [normed_space ℝ F']
+variables [normed_add_comm_group E] [normed_add_comm_group F] [normed_space ℝ F] {p : ℝ≥0∞}
+  {G F' : Type*} [normed_add_comm_group G] [normed_add_comm_group F'] [normed_space ℝ F']
   {m : measurable_space α} {μ : measure α}
 
 /-- Bochner integral of simple functions whose codomain is a real `normed_space`.
@@ -391,16 +394,16 @@ lemma integral_smul (c : 𝕜) {f : α →ₛ E} (hf : integrable f μ) :
 set_to_simple_func_smul _ weighted_smul_union weighted_smul_smul c hf
 
 lemma norm_set_to_simple_func_le_integral_norm (T : set α → E →L[ℝ] F) {C : ℝ}
-  (hT_norm : ∀ s, measurable_set s → μ s < ∞ → ∥T s∥ ≤ C * (μ s).to_real) {f : α →ₛ E}
+  (hT_norm : ∀ s, measurable_set s → μ s < ∞ → ‖T s‖ ≤ C * (μ s).to_real) {f : α →ₛ E}
   (hf : integrable f μ) :
-  ∥f.set_to_simple_func T∥ ≤ C * (f.map norm).integral μ :=
-calc ∥f.set_to_simple_func T∥
-    ≤ C * ∑ x in f.range, ennreal.to_real (μ (f ⁻¹' {x})) * ∥x∥ :
+  ‖f.set_to_simple_func T‖ ≤ C * (f.map norm).integral μ :=
+calc ‖f.set_to_simple_func T‖
+    ≤ C * ∑ x in f.range, ennreal.to_real (μ (f ⁻¹' {x})) * ‖x‖ :
   norm_set_to_simple_func_le_sum_mul_norm_of_integrable T hT_norm f hf
 ... = C * (f.map norm).integral μ : by { rw map_integral f norm hf norm_zero, simp_rw smul_eq_mul, }
 
 lemma norm_integral_le_integral_norm (f : α →ₛ E) (hf : integrable f μ) :
-  ∥f.integral μ∥ ≤ (f.map norm).integral μ :=
+  ‖f.integral μ‖ ≤ (f.map norm).integral μ :=
 begin
   refine (norm_set_to_simple_func_le_integral_norm _ (λ s _ _, _) hf).trans (one_mul _).le,
   exact (norm_weighted_smul_le s).trans (one_mul _).symm.le,
@@ -424,13 +427,14 @@ namespace L1
 
 open ae_eq_fun Lp.simple_func Lp
 
-variables [normed_group E] [normed_group F] {m : measurable_space α} {μ : measure α}
+variables [normed_add_comm_group E] [normed_add_comm_group F] {m : measurable_space α}
+  {μ : measure α}
 
 variables {α E μ}
 
 namespace simple_func
 
-lemma norm_eq_integral (f : α →₁ₛ[μ] E) : ∥f∥ = ((to_simple_func f).map norm).integral μ :=
+lemma norm_eq_integral (f : α →₁ₛ[μ] E) : ‖f‖ = ((to_simple_func f).map norm).integral μ :=
 begin
   rw [norm_eq_sum_mul f, (to_simple_func f).map_integral norm (simple_func.integrable f) norm_zero],
   simp_rw smul_eq_mul,
@@ -466,7 +470,7 @@ Define the Bochner integral on `α →₁ₛ[μ] E` by extension from the simple
 and prove basic properties of this integral. -/
 
 variables [normed_field 𝕜] [normed_space 𝕜 E] [normed_space ℝ E] [smul_comm_class ℝ 𝕜 E]
-  {F' : Type*} [normed_group F'] [normed_space ℝ F']
+  {F' : Type*} [normed_add_comm_group F'] [normed_space ℝ F']
 
 local attribute [instance] simple_func.normed_space
 
@@ -492,13 +496,13 @@ lemma integral_smul (c : 𝕜) (f : α →₁ₛ[μ] E) :
   integral (c • f) = c • integral f :=
 set_to_L1s_smul _ (λ _ _, weighted_smul_null) weighted_smul_union weighted_smul_smul c f
 
-lemma norm_integral_le_norm (f : α →₁ₛ[μ] E) : ∥integral f∥ ≤ ∥f∥ :=
+lemma norm_integral_le_norm (f : α →₁ₛ[μ] E) : ‖integral f‖ ≤ ‖f‖ :=
 begin
   rw [integral, norm_eq_integral],
   exact (to_simple_func f).norm_integral_le_integral_norm (simple_func.integrable f)
 end
 
-variables {E' : Type*} [normed_group E'] [normed_space ℝ E'] [normed_space 𝕜 E']
+variables {E' : Type*} [normed_add_comm_group E'] [normed_space ℝ E'] [normed_space 𝕜 E']
 
 
 variables (α E μ 𝕜)
@@ -512,11 +516,11 @@ def integral_clm : (α →₁ₛ[μ] E) →L[ℝ] E := integral_clm' α E ℝ μ
 
 variables {α E μ 𝕜}
 
-local notation `Integral` := integral_clm α E μ
+local notation (name := simple_func.integral_clm) `Integral` := integral_clm α E μ
 
 open continuous_linear_map
 
-lemma norm_Integral_le_one : ∥Integral∥ ≤ 1 :=
+lemma norm_Integral_le_one : ‖Integral‖ ≤ 1 :=
 linear_map.mk_continuous_norm_le _ (zero_le_one) _
 
 section pos_part
@@ -546,7 +550,7 @@ begin
 end
 
 lemma integral_eq_norm_pos_part_sub (f : α →₁ₛ[μ] ℝ) :
-  integral f = ∥pos_part f∥ - ∥neg_part f∥ :=
+  integral f = ‖pos_part f‖ - ‖neg_part f‖ :=
 begin
   -- Convert things in `L¹` to their `simple_func` counterpart
   have ae_eq₁ : (to_simple_func f).pos_part =ᵐ[μ] (to_simple_func (pos_part f)).map norm,
@@ -584,10 +588,10 @@ end simple_func_integral
 end simple_func
 
 open simple_func
-local notation `Integral` := @integral_clm α E _ _ _ _ _ μ _
+local notation (name := simple_func.integral_clm) `Integral` := @integral_clm α E _ _ _ _ _ μ _
 
 
-variables [normed_space ℝ E] [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
+variables [normed_space ℝ E] [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
   [smul_comm_class ℝ 𝕜 E] [normed_space ℝ F] [complete_space E]
 
 section integration_in_L1
@@ -609,61 +613,90 @@ variables {𝕜}
 def integral_clm : (α →₁[μ] E) →L[ℝ] E := integral_clm' ℝ
 
 /-- The Bochner integral in L1 space -/
-def integral (f : α →₁[μ] E) : E := integral_clm f
+@[irreducible] def integral (f : α →₁[μ] E) : E := integral_clm f
 
-lemma integral_eq (f : α →₁[μ] E) : integral f = integral_clm f := rfl
+lemma integral_eq (f : α →₁[μ] E) : integral f = integral_clm f :=
+by simp only [integral]
 
 lemma integral_eq_set_to_L1 (f : α →₁[μ] E) :
   integral f = set_to_L1 (dominated_fin_meas_additive_weighted_smul μ) f :=
-rfl
+by { simp only [integral], refl }
 
 @[norm_cast] lemma simple_func.integral_L1_eq_integral (f : α →₁ₛ[μ] E) :
   integral (f : α →₁[μ] E) = (simple_func.integral f) :=
-set_to_L1_eq_set_to_L1s_clm (dominated_fin_meas_additive_weighted_smul μ) f
+begin
+  simp only [integral],
+  exact set_to_L1_eq_set_to_L1s_clm (dominated_fin_meas_additive_weighted_smul μ) f
+end
 
 variables (α E)
 @[simp] lemma integral_zero : integral (0 : α →₁[μ] E) = 0 :=
-map_zero integral_clm
+begin
+  simp only [integral],
+  exact map_zero integral_clm
+end
+
 variables {α E}
 
+@[integral_simps]
 lemma integral_add (f g : α →₁[μ] E) : integral (f + g) = integral f + integral g :=
-map_add integral_clm f g
+begin
+  simp only [integral],
+  exact map_add integral_clm f g
+end
 
+@[integral_simps]
 lemma integral_neg (f : α →₁[μ] E) : integral (-f) = - integral f :=
-map_neg integral_clm f
+begin
+  simp only [integral],
+  exact map_neg integral_clm f
+end
 
+@[integral_simps]
 lemma integral_sub (f g : α →₁[μ] E) : integral (f - g) = integral f - integral g :=
-map_sub integral_clm f g
+begin
+  simp only [integral],
+  exact map_sub integral_clm f g
+end
 
+@[integral_simps]
 lemma integral_smul (c : 𝕜) (f : α →₁[μ] E) : integral (c • f) = c • integral f :=
-map_smul (integral_clm' 𝕜) c f
+begin
+  simp only [integral],
+  show (integral_clm' 𝕜) (c • f) = c • (integral_clm' 𝕜) f, from map_smul (integral_clm' 𝕜) c f
+end
 
-local notation `Integral` := @integral_clm α E _ _ μ _ _
-local notation `sIntegral` := @simple_func.integral_clm α E _ _ μ _
+local notation (name := integral_clm) `Integral` := @integral_clm α E _ _ μ _ _
+local notation (name := simple_func.integral_clm') `sIntegral` :=
+  @simple_func.integral_clm α E _ _ μ _
 
-lemma norm_Integral_le_one : ∥Integral∥ ≤ 1 :=
+lemma norm_Integral_le_one : ‖Integral‖ ≤ 1 :=
 norm_set_to_L1_le (dominated_fin_meas_additive_weighted_smul μ) zero_le_one
 
-lemma norm_integral_le (f : α →₁[μ] E) : ∥integral f∥ ≤ ∥f∥ :=
-calc ∥integral f∥ = ∥Integral f∥ : rfl
-  ... ≤ ∥Integral∥ * ∥f∥ : le_op_norm _ _
-  ... ≤ 1 * ∥f∥ : mul_le_mul_of_nonneg_right norm_Integral_le_one $ norm_nonneg _
-  ... = ∥f∥ : one_mul _
+lemma norm_integral_le (f : α →₁[μ] E) : ‖integral f‖ ≤ ‖f‖ :=
+calc ‖integral f‖ = ‖Integral f‖ : by simp only [integral]
+  ... ≤ ‖Integral‖ * ‖f‖ : le_op_norm _ _
+  ... ≤ 1 * ‖f‖ : mul_le_mul_of_nonneg_right norm_Integral_le_one $ norm_nonneg _
+  ... = ‖f‖ : one_mul _
 
 @[continuity]
 lemma continuous_integral : continuous (λ (f : α →₁[μ] E), integral f) :=
-L1.integral_clm.continuous
+begin
+  simp only [integral],
+  exact L1.integral_clm.continuous
+end
 
 section pos_part
 
 lemma integral_eq_norm_pos_part_sub (f : α →₁[μ] ℝ) :
-  integral f = ∥Lp.pos_part f∥ - ∥Lp.neg_part f∥ :=
+  integral f = ‖Lp.pos_part f‖ - ‖Lp.neg_part f‖ :=
 begin
   -- Use `is_closed_property` and `is_closed_eq`
   refine @is_closed_property _ _ _ (coe : (α →₁ₛ[μ] ℝ) → (α →₁[μ] ℝ))
-    (λ f : α →₁[μ] ℝ, integral f = ∥Lp.pos_part f∥ - ∥Lp.neg_part f∥)
+    (λ f : α →₁[μ] ℝ, integral f = ‖Lp.pos_part f‖ - ‖Lp.neg_part f‖)
     (simple_func.dense_range one_ne_top) (is_closed_eq _ _) _ f,
-  { exact cont _ },
+  { simp only [integral],
+    exact cont _ },
   { refine continuous.sub (continuous_norm.comp Lp.continuous_pos_part)
       (continuous_norm.comp Lp.continuous_neg_part) },
   -- Show that the property holds for all simple functions in the `L¹` space.
@@ -686,20 +719,20 @@ functions, and 0 otherwise; prove its basic properties.
 
 -/
 
-variables [normed_group E] [normed_space ℝ E] [complete_space E]
-          [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E] [smul_comm_class ℝ 𝕜 E]
-          [normed_group F] [normed_space ℝ F] [complete_space F]
+variables [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+          [nontrivially_normed_field 𝕜] [normed_space 𝕜 E] [smul_comm_class ℝ 𝕜 E]
+          [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
 
 section
 open_locale classical
 
 /-- The Bochner integral -/
-def integral {m : measurable_space α} (μ : measure α) (f : α → E) : E :=
+@[irreducible] def integral {m : measurable_space α} (μ : measure α) (f : α → E) : E :=
 if hf : integrable f μ then L1.integral (hf.to_L1 f) else 0
 
 end
 
-/-! In the notation for integrals, an expression like `∫ x, g ∥x∥ ∂μ` will not be parsed correctly,
+/-! In the notation for integrals, an expression like `∫ x, g ‖x‖ ∂μ` will not be parsed correctly,
   and needs parentheses. We do not set the binding power of `r` to `0`, because then
   `∫ x, f x = 0` will be parsed incorrectly. -/
 notation `∫` binders `, ` r:(scoped:60 f, f) ` ∂` μ:70 := integral μ r
@@ -715,17 +748,20 @@ variables {f g : α → E} {m : measurable_space α} {μ : measure α}
 
 lemma integral_eq (f : α → E) (hf : integrable f μ) :
   ∫ a, f a ∂μ = L1.integral (hf.to_L1 f) :=
-@dif_pos _ (id _) hf _ _ _
+by { rw [integral], exact @dif_pos _ (id _) hf _ _ _ }
 
 lemma integral_eq_set_to_fun (f : α → E) :
   ∫ a, f a ∂μ = set_to_fun μ (weighted_smul μ) (dominated_fin_meas_additive_weighted_smul μ) f :=
-rfl
+by { simp only [integral, L1.integral], refl }
 
 lemma L1.integral_eq_integral (f : α →₁[μ] E) : L1.integral f = ∫ a, f a ∂μ :=
-(L1.set_to_fun_eq_set_to_L1 (dominated_fin_meas_additive_weighted_smul μ) f).symm
+begin
+  simp only [integral, L1.integral],
+  exact (L1.set_to_fun_eq_set_to_L1 (dominated_fin_meas_additive_weighted_smul μ) f).symm
+end
 
 lemma integral_undef (h : ¬ integrable f μ) : ∫ a, f a ∂μ = 0 :=
-@dif_neg _ (id _) h _ _ _
+by { rw [integral], exact @dif_neg _ (id _) h _ _ _ }
 
 lemma integral_non_ae_strongly_measurable (h : ¬ ae_strongly_measurable f μ) : ∫ a, f a ∂μ = 0 :=
 integral_undef $ not_and_of_not_left _ h
@@ -733,16 +769,26 @@ integral_undef $ not_and_of_not_left _ h
 variables (α E)
 
 lemma integral_zero : ∫ a : α, (0:E) ∂μ = 0 :=
-set_to_fun_zero (dominated_fin_meas_additive_weighted_smul μ)
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_zero (dominated_fin_meas_additive_weighted_smul μ)
+end
 
 @[simp] lemma integral_zero' : integral μ (0 : α → E) = 0 :=
 integral_zero α E
 
 variables {α E}
 
+lemma integrable_of_integral_eq_one {f : α → ℝ} (h : ∫ x, f x ∂μ = 1) :
+  integrable f μ :=
+by { contrapose h, rw integral_undef h, exact zero_ne_one }
+
 lemma integral_add (hf : integrable f μ) (hg : integrable g μ) :
   ∫ a, f a + g a ∂μ = ∫ a, f a ∂μ + ∫ a, g a ∂μ :=
-set_to_fun_add (dominated_fin_meas_additive_weighted_smul μ) hf hg
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_add (dominated_fin_meas_additive_weighted_smul μ) hf hg
+end
 
 lemma integral_add' (hf : integrable f μ) (hg : integrable g μ) :
   ∫ a, (f + g) a ∂μ = ∫ a, f a ∂μ + ∫ a, g a ∂μ :=
@@ -750,48 +796,74 @@ integral_add hf hg
 
 lemma integral_finset_sum {ι} (s : finset ι) {f : ι → α → E} (hf : ∀ i ∈ s, integrable (f i) μ) :
   ∫ a, ∑ i in s, f i a ∂μ = ∑ i in s, ∫ a, f i a ∂μ :=
-set_to_fun_finset_sum (dominated_fin_meas_additive_weighted_smul _) s hf
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_finset_sum (dominated_fin_meas_additive_weighted_smul _) s hf
+end
 
+@[integral_simps]
 lemma integral_neg (f : α → E) : ∫ a, -f a ∂μ = - ∫ a, f a ∂μ :=
-set_to_fun_neg (dominated_fin_meas_additive_weighted_smul μ) f
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_neg (dominated_fin_meas_additive_weighted_smul μ) f
+end
 
 lemma integral_neg' (f : α → E) : ∫ a, (-f) a ∂μ = - ∫ a, f a ∂μ :=
 integral_neg f
 
 lemma integral_sub (hf : integrable f μ) (hg : integrable g μ) :
   ∫ a, f a - g a ∂μ = ∫ a, f a ∂μ - ∫ a, g a ∂μ :=
-set_to_fun_sub (dominated_fin_meas_additive_weighted_smul μ) hf hg
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_sub (dominated_fin_meas_additive_weighted_smul μ) hf hg
+end
 
 lemma integral_sub' (hf : integrable f μ) (hg : integrable g μ) :
   ∫ a, (f - g) a ∂μ = ∫ a, f a ∂μ - ∫ a, g a ∂μ :=
 integral_sub hf hg
 
+@[integral_simps]
 lemma integral_smul (c : 𝕜) (f : α → E) :
   ∫ a, c • (f a) ∂μ = c • ∫ a, f a ∂μ :=
-set_to_fun_smul (dominated_fin_meas_additive_weighted_smul μ) weighted_smul_smul c f
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_smul (dominated_fin_meas_additive_weighted_smul μ) weighted_smul_smul c f
+end
 
-lemma integral_mul_left (r : ℝ) (f : α → ℝ) : ∫ a, r * (f a) ∂μ = r * ∫ a, f a ∂μ :=
+lemma integral_mul_left {L : Type*} [is_R_or_C L] (r : L) (f : α → L) :
+  ∫ a, r * (f a) ∂μ = r * ∫ a, f a ∂μ :=
 integral_smul r f
 
-lemma integral_mul_right (r : ℝ) (f : α → ℝ) : ∫ a, (f a) * r ∂μ = ∫ a, f a ∂μ * r :=
+lemma integral_mul_right {L : Type*} [is_R_or_C L] (r : L) (f : α → L) :
+  ∫ a, (f a) * r ∂μ = ∫ a, f a ∂μ * r :=
 by { simp only [mul_comm], exact integral_mul_left r f }
 
-lemma integral_div (r : ℝ) (f : α → ℝ) : ∫ a, (f a) / r ∂μ = ∫ a, f a ∂μ / r :=
-integral_mul_right r⁻¹ f
+lemma integral_div {L : Type*} [is_R_or_C L] (r : L) (f : α → L) :
+  ∫ a, (f a) / r ∂μ = ∫ a, f a ∂μ / r :=
+by simpa only [←div_eq_mul_inv] using integral_mul_right r⁻¹ f
 
 lemma integral_congr_ae (h : f =ᵐ[μ] g) : ∫ a, f a ∂μ = ∫ a, g a ∂μ :=
-set_to_fun_congr_ae (dominated_fin_meas_additive_weighted_smul μ) h
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_congr_ae (dominated_fin_meas_additive_weighted_smul μ) h
+end
 
 @[simp] lemma L1.integral_of_fun_eq_integral {f : α → E} (hf : integrable f μ) :
   ∫ a, (hf.to_L1 f) a ∂μ = ∫ a, f a ∂μ :=
-set_to_fun_to_L1 (dominated_fin_meas_additive_weighted_smul μ) hf
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_to_L1 (dominated_fin_meas_additive_weighted_smul μ) hf
+end
 
 @[continuity]
 lemma continuous_integral : continuous (λ (f : α →₁[μ] E), ∫ a, f a ∂μ) :=
-continuous_set_to_fun (dominated_fin_meas_additive_weighted_smul μ)
+begin
+  simp only [integral, L1.integral],
+  exact continuous_set_to_fun (dominated_fin_meas_additive_weighted_smul μ)
+end
 
 lemma norm_integral_le_lintegral_norm (f : α → E) :
-  ∥∫ a, f a ∂μ∥ ≤ ennreal.to_real (∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ) :=
+  ‖∫ a, f a ∂μ‖ ≤ ennreal.to_real (∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ) :=
 begin
   by_cases hf : integrable f μ,
   { rw [integral_eq f hf, ← integrable.norm_to_L1_eq_lintegral_norm f hf],
@@ -800,7 +872,7 @@ begin
 end
 
 lemma ennnorm_integral_le_lintegral_ennnorm (f : α → E) :
-  (∥∫ a, f a ∂μ∥₊ : ℝ≥0∞) ≤ ∫⁻ a, ∥f a∥₊ ∂μ :=
+  (‖∫ a, f a ∂μ‖₊ : ℝ≥0∞) ≤ ∫⁻ a, ‖f a‖₊ ∂μ :=
 by { simp_rw [← of_real_norm_eq_coe_nnnorm], apply ennreal.of_real_le_of_le_to_real,
   exact norm_integral_le_lintegral_norm f }
 
@@ -831,17 +903,11 @@ hf.2.tendsto_set_integral_nhds_zero hs
 /-- If `F i → f` in `L1`, then `∫ x, F i x ∂μ → ∫ x, f x ∂μ`. -/
 lemma tendsto_integral_of_L1 {ι} (f : α → E) (hfi : integrable f μ)
   {F : ι → α → E} {l : filter ι} (hFi : ∀ᶠ i in l, integrable (F i) μ)
-  (hF : tendsto (λ i, ∫⁻ x, ∥F i x - f x∥₊ ∂μ) l (𝓝 0)) :
+  (hF : tendsto (λ i, ∫⁻ x, ‖F i x - f x‖₊ ∂μ) l (𝓝 0)) :
   tendsto (λ i, ∫ x, F i x ∂μ) l (𝓝 $ ∫ x, f x ∂μ) :=
 begin
-  rw [tendsto_iff_norm_tendsto_zero],
-  replace hF : tendsto (λ i, ennreal.to_real $ ∫⁻ x, ∥F i x - f x∥₊ ∂μ) l (𝓝 0) :=
-    (ennreal.tendsto_to_real zero_ne_top).comp hF,
-  refine squeeze_zero_norm' (hFi.mp $ hFi.mono $ λ i hFi hFm, _) hF,
-  simp only [norm_norm, ← integral_sub hFi hfi],
-  convert norm_integral_le_lintegral_norm (λ x, F i x - f x),
-  ext1 x,
-  exact coe_nnreal_eq _
+  simp only [integral, L1.integral],
+  exact tendsto_set_to_fun_of_L1 (dominated_fin_meas_additive_weighted_smul μ) f hfi hFi hF
 end
 
 /-- Lebesgue dominated convergence theorem provides sufficient conditions under which almost
@@ -852,29 +918,35 @@ end
 theorem tendsto_integral_of_dominated_convergence {F : ℕ → α → E} {f : α → E} (bound : α → ℝ)
   (F_measurable : ∀ n, ae_strongly_measurable (F n) μ)
   (bound_integrable : integrable bound μ)
-  (h_bound : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a)
+  (h_bound : ∀ n, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound a)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, F n a) at_top (𝓝 (f a))) :
   tendsto (λn, ∫ a, F n a ∂μ) at_top (𝓝 $ ∫ a, f a ∂μ) :=
-tendsto_set_to_fun_of_dominated_convergence (dominated_fin_meas_additive_weighted_smul μ) bound
-  F_measurable bound_integrable h_bound h_lim
+begin
+  simp only [integral, L1.integral],
+  exact tendsto_set_to_fun_of_dominated_convergence (dominated_fin_meas_additive_weighted_smul μ)
+    bound F_measurable bound_integrable h_bound h_lim
+end
 
 /-- Lebesgue dominated convergence theorem for filters with a countable basis -/
 lemma tendsto_integral_filter_of_dominated_convergence {ι} {l : filter ι}
   [l.is_countably_generated]
   {F : ι → α → E} {f : α → E} (bound : α → ℝ)
   (hF_meas : ∀ᶠ n in l, ae_strongly_measurable (F n) μ)
-  (h_bound : ∀ᶠ n in l, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound a)
+  (h_bound : ∀ᶠ n in l, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound a)
   (bound_integrable : integrable bound μ)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, F n a) l (𝓝 (f a))) :
   tendsto (λn, ∫ a, F n a ∂μ) l (𝓝 $ ∫ a, f a ∂μ) :=
-tendsto_set_to_fun_filter_of_dominated_convergence (dominated_fin_meas_additive_weighted_smul μ)
-  bound hF_meas h_bound bound_integrable h_lim
+begin
+  simp only [integral, L1.integral],
+  exact tendsto_set_to_fun_filter_of_dominated_convergence
+    (dominated_fin_meas_additive_weighted_smul μ) bound hF_meas h_bound bound_integrable h_lim
+end
 
 /-- Lebesgue dominated convergence theorem for series. -/
-lemma has_sum_integral_of_dominated_convergence {ι} [encodable ι]
+lemma has_sum_integral_of_dominated_convergence {ι} [countable ι]
   {F : ι → α → E} {f : α → E} (bound : ι → α → ℝ)
   (hF_meas : ∀ n, ae_strongly_measurable (F n) μ)
-  (h_bound : ∀ n, ∀ᵐ a ∂μ, ∥F n a∥ ≤ bound n a)
+  (h_bound : ∀ n, ∀ᵐ a ∂μ, ‖F n a‖ ≤ bound n a)
   (bound_summable : ∀ᵐ a ∂μ, summable (λ n, bound n a))
   (bound_integrable : integrable (λ a, ∑' n, bound n a) μ)
   (h_lim : ∀ᵐ a ∂μ, has_sum (λ n, F n a) (f a)) :
@@ -896,26 +968,56 @@ begin
   { refine eventually_of_forall (λ s, _),
     filter_upwards [eventually_countable_forall.2 h_bound, hb_nonneg, bound_summable]
       with a hFa ha0 has,
-    calc ∥∑ n in s, F n a∥ ≤ ∑ n in s, bound n a : norm_sum_le_of_le _ (λ n hn, hFa n)
+    calc ‖∑ n in s, F n a‖ ≤ ∑ n in s, bound n a : norm_sum_le_of_le _ (λ n hn, hFa n)
                        ... ≤ ∑' n, bound n a     : sum_le_tsum _ (λ n hn, ha0 n) has },
 end
 
 variables {X : Type*} [topological_space X] [first_countable_topology X]
 
+lemma continuous_within_at_of_dominated {F : X → α → E} {x₀ : X} {bound : α → ℝ} {s : set X}
+  (hF_meas : ∀ᶠ x in 𝓝[s] x₀, ae_strongly_measurable (F x) μ)
+  (h_bound : ∀ᶠ x in 𝓝[s] x₀, ∀ᵐ a ∂μ, ‖F x a‖ ≤ bound a)
+  (bound_integrable : integrable bound μ)
+  (h_cont : ∀ᵐ a ∂μ, continuous_within_at (λ x, F x a) s x₀) :
+  continuous_within_at (λ x, ∫ a, F x a ∂μ) s x₀ :=
+begin
+  simp only [integral, L1.integral],
+  exact continuous_within_at_set_to_fun_of_dominated (dominated_fin_meas_additive_weighted_smul μ)
+    hF_meas h_bound bound_integrable h_cont
+end
+
 lemma continuous_at_of_dominated {F : X → α → E} {x₀ : X} {bound : α → ℝ}
   (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) μ)
-  (h_bound : ∀ᶠ x in 𝓝 x₀, ∀ᵐ a ∂μ, ∥F x a∥ ≤ bound a)
+  (h_bound : ∀ᶠ x in 𝓝 x₀, ∀ᵐ a ∂μ, ‖F x a‖ ≤ bound a)
   (bound_integrable : integrable bound μ) (h_cont : ∀ᵐ a ∂μ, continuous_at (λ x, F x a) x₀) :
   continuous_at (λ x, ∫ a, F x a ∂μ) x₀ :=
-continuous_at_set_to_fun_of_dominated (dominated_fin_meas_additive_weighted_smul μ) hF_meas h_bound
-  bound_integrable h_cont
+begin
+  simp only [integral, L1.integral],
+  exact continuous_at_set_to_fun_of_dominated (dominated_fin_meas_additive_weighted_smul μ) hF_meas
+    h_bound bound_integrable h_cont
+end
+
+lemma continuous_on_of_dominated {F : X → α → E} {bound : α → ℝ} {s : set X}
+  (hF_meas : ∀ x ∈ s, ae_strongly_measurable (F x) μ)
+  (h_bound : ∀ x ∈ s, ∀ᵐ a ∂μ, ‖F x a‖ ≤ bound a)
+  (bound_integrable : integrable bound μ)
+  (h_cont : ∀ᵐ a ∂μ, continuous_on (λ x, F x a) s) :
+  continuous_on (λ x, ∫ a, F x a ∂μ) s :=
+begin
+  simp only [integral, L1.integral],
+  exact continuous_on_set_to_fun_of_dominated (dominated_fin_meas_additive_weighted_smul μ) hF_meas
+    h_bound bound_integrable h_cont
+end
 
 lemma continuous_of_dominated {F : X → α → E} {bound : α → ℝ}
-  (hF_meas : ∀ x, ae_strongly_measurable (F x) μ) (h_bound : ∀ x, ∀ᵐ a ∂μ, ∥F x a∥ ≤ bound a)
+  (hF_meas : ∀ x, ae_strongly_measurable (F x) μ) (h_bound : ∀ x, ∀ᵐ a ∂μ, ‖F x a‖ ≤ bound a)
   (bound_integrable : integrable bound μ) (h_cont : ∀ᵐ a ∂μ, continuous (λ x, F x a)) :
   continuous (λ x, ∫ a, F x a ∂μ) :=
-continuous_set_to_fun_of_dominated (dominated_fin_meas_additive_weighted_smul μ) hF_meas h_bound
-  bound_integrable h_cont
+begin
+  simp only [integral, L1.integral],
+  exact continuous_set_to_fun_of_dominated (dominated_fin_meas_additive_weighted_smul μ) hF_meas
+    h_bound bound_integrable h_cont
+end
 
 /-- The Bochner integral of a real-valued function `f : α → ℝ` is the difference between the
   integral of the positive part of `f` and the integral of the negative part of `f`.  -/
@@ -925,7 +1027,7 @@ lemma integral_eq_lintegral_pos_part_sub_lintegral_neg_part {f : α → ℝ} (hf
   ennreal.to_real (∫⁻ a, (ennreal.of_real $ - f a) ∂μ) :=
 let f₁ := hf.to_L1 f in
 -- Go to the `L¹` space
-have eq₁ : ennreal.to_real (∫⁻ a, (ennreal.of_real $ f a) ∂μ) = ∥Lp.pos_part f₁∥ :=
+have eq₁ : ennreal.to_real (∫⁻ a, (ennreal.of_real $ f a) ∂μ) = ‖Lp.pos_part f₁‖ :=
 begin
   rw L1.norm_def,
   congr' 1,
@@ -938,7 +1040,7 @@ begin
   simp only [real.coe_to_nnreal', subtype.coe_mk],
 end,
 -- Go to the `L¹` space
-have eq₂ : ennreal.to_real (∫⁻ a, (ennreal.of_real $ - f a) ∂μ)  = ∥Lp.neg_part f₁∥ :=
+have eq₂ : ennreal.to_real (∫⁻ a, (ennreal.of_real $ - f a) ∂μ)  = ‖Lp.neg_part f₁‖ :=
 begin
   rw L1.norm_def,
   congr' 1,
@@ -972,24 +1074,24 @@ begin
   { rw integral_undef hfi,
     simp_rw [integrable, hfm, has_finite_integral_iff_norm, lt_top_iff_ne_top, ne.def, true_and,
       not_not] at hfi,
-    have : ∫⁻ (a : α), ennreal.of_real (f a) ∂μ = ∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ,
+    have : ∫⁻ (a : α), ennreal.of_real (f a) ∂μ = ∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ,
     { refine lintegral_congr_ae (hf.mono $ assume a h, _),
       rw [real.norm_eq_abs, abs_of_nonneg h] },
     rw [this, hfi], refl }
 end
 
-lemma integral_norm_eq_lintegral_nnnorm {G} [normed_group G]
+lemma integral_norm_eq_lintegral_nnnorm {G} [normed_add_comm_group G]
   {f : α → G} (hf : ae_strongly_measurable f μ) :
-  ∫ x, ∥f x∥ ∂μ = ennreal.to_real ∫⁻ x, ∥f x∥₊ ∂μ :=
+  ∫ x, ‖f x‖ ∂μ = ennreal.to_real ∫⁻ x, ‖f x‖₊ ∂μ :=
 begin
   rw integral_eq_lintegral_of_nonneg_ae _ hf.norm,
   { simp_rw [of_real_norm_eq_coe_nnnorm], },
   { refine ae_of_all _ _, simp_rw [pi.zero_apply, norm_nonneg, imp_true_iff] },
 end
 
-lemma of_real_integral_norm_eq_lintegral_nnnorm {G} [normed_group G] {f : α → G}
+lemma of_real_integral_norm_eq_lintegral_nnnorm {G} [normed_add_comm_group G] {f : α → G}
   (hf : integrable f μ) :
-  ennreal.of_real ∫ x, ∥f x∥ ∂μ = ∫⁻ x, ∥f x∥₊ ∂μ :=
+  ennreal.of_real ∫ x, ‖f x‖ ∂μ = ∫⁻ x, ‖f x‖₊ ∂μ :=
 by rw [integral_norm_eq_lintegral_nnnorm hf.ae_strongly_measurable,
     ennreal.of_real_to_real (lt_top_iff_ne_top.mp hf.2)]
 
@@ -1002,8 +1104,11 @@ begin
 end
 
 lemma integral_nonneg_of_ae {f : α → ℝ} (hf : 0 ≤ᵐ[μ] f) : 0 ≤ ∫ a, f a ∂μ :=
-set_to_fun_nonneg (dominated_fin_meas_additive_weighted_smul μ)
-  (λ s _ _, weighted_smul_nonneg s) hf
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_nonneg (dominated_fin_meas_additive_weighted_smul μ)
+    (λ s _ _, weighted_smul_nonneg s) hf
+end
 
 lemma lintegral_coe_eq_integral (f : α → ℝ≥0) (hfi : integrable (λ x, (f x : ℝ)) μ) :
   ∫⁻ a, f a ∂μ = ennreal.of_real ∫ a, f a ∂μ :=
@@ -1016,7 +1121,7 @@ end
 lemma of_real_integral_eq_lintegral_of_real {f : α → ℝ} (hfi : integrable f μ) (f_nn : 0 ≤ᵐ[μ] f) :
   ennreal.of_real (∫ x, f x ∂μ) = ∫⁻ x, ennreal.of_real (f x) ∂μ :=
 begin
-  simp_rw [integral_congr_ae (show f =ᵐ[μ] λ x, ∥f x∥,
+  simp_rw [integral_congr_ae (show f =ᵐ[μ] λ x, ‖f x‖,
              by { filter_upwards [f_nn] with x hx,
                   rw [real.norm_eq_abs, abs_eq_self.mpr hx], }),
            of_real_integral_norm_eq_lintegral_nnnorm hfi, ←of_real_norm_eq_coe_nnnorm],
@@ -1083,10 +1188,10 @@ lemma integral_pos_iff_support_of_nonneg {f : α → ℝ} (hf : 0 ≤ f) (hfi :
   (0 < ∫ x, f x ∂μ) ↔ 0 < μ (function.support f) :=
 integral_pos_iff_support_of_nonneg_ae (eventually_of_forall hf) hfi
 
-section normed_group
-variables {H : Type*} [normed_group H]
+section normed_add_comm_group
+variables {H : Type*} [normed_add_comm_group H]
 
-lemma L1.norm_eq_integral_norm (f : α →₁[μ] H) : ∥f∥ = ∫ a, ∥f a∥ ∂μ :=
+lemma L1.norm_eq_integral_norm (f : α →₁[μ] H) : ‖f‖ = ∫ a, ‖f a‖ ∂μ :=
 begin
   simp only [snorm, snorm', ennreal.one_to_real, ennreal.rpow_one, Lp.norm_def,
     if_false, ennreal.one_ne_top, one_ne_zero, _root_.div_one],
@@ -1096,7 +1201,7 @@ begin
 end
 
 lemma L1.norm_of_fun_eq_integral_norm {f : α → H} (hf : integrable f μ) :
-  ∥hf.to_L1 f∥ = ∫ a, ∥f a∥ ∂μ :=
+  ‖hf.to_L1 f‖ = ∫ a, ‖f a‖ ∂μ :=
 begin
   rw L1.norm_eq_integral_norm,
   refine integral_congr_ae _,
@@ -1107,9 +1212,9 @@ end
 
 lemma mem_ℒp.snorm_eq_integral_rpow_norm {f : α → H} {p : ℝ≥0∞} (hp1 : p ≠ 0) (hp2 : p ≠ ∞)
   (hf : mem_ℒp f p μ) :
-  snorm f p μ = ennreal.of_real ((∫ a, ∥f a∥ ^ p.to_real ∂μ) ^ (p.to_real ⁻¹)) :=
+  snorm f p μ = ennreal.of_real ((∫ a, ‖f a‖ ^ p.to_real ∂μ) ^ (p.to_real ⁻¹)) :=
 begin
-  have A : ∫⁻ (a : α), ennreal.of_real (∥f a∥ ^ p.to_real) ∂μ = ∫⁻ (a : α), ∥f a∥₊ ^ p.to_real ∂μ,
+  have A : ∫⁻ (a : α), ennreal.of_real (‖f a‖ ^ p.to_real) ∂μ = ∫⁻ (a : α), ‖f a‖₊ ^ p.to_real ∂μ,
   { apply lintegral_congr (λ x, _),
     rw [← of_real_rpow_of_nonneg (norm_nonneg _) to_real_nonneg, of_real_norm_eq_coe_nnnorm] },
   simp only [snorm_eq_lintegral_rpow_nnnorm hp1 hp2, one_div],
@@ -1120,12 +1225,15 @@ begin
   exact (lintegral_rpow_nnnorm_lt_top_of_snorm_lt_top hp1 hp2 hf.2).ne
 end
 
-end normed_group
+end normed_add_comm_group
 
 lemma integral_mono_ae {f g : α → ℝ} (hf : integrable f μ) (hg : integrable g μ) (h : f ≤ᵐ[μ] g) :
   ∫ a, f a ∂μ ≤ ∫ a, g a ∂μ :=
-set_to_fun_mono (dominated_fin_meas_additive_weighted_smul μ) (λ s _ _, weighted_smul_nonneg s)
-  hf hg h
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_mono (dominated_fin_meas_additive_weighted_smul μ)
+    (λ s _ _, weighted_smul_nonneg s) hf hg h
+end
 
 @[mono] lemma integral_mono {f g : α → ℝ} (hf : integrable f μ) (hg : integrable g μ) (h : f ≤ g) :
   ∫ a, f a ∂μ ≤ ∫ a, g a ∂μ :=
@@ -1137,7 +1245,7 @@ begin
   by_cases hfm : ae_strongly_measurable f μ,
   { refine integral_mono_ae ⟨hfm, _⟩ hgi h,
     refine (hgi.has_finite_integral.mono $ h.mp $ hf.mono $ λ x hf hfg, _),
-    simpa [real.norm_eq_abs, abs_of_nonneg hf, abs_of_nonneg (le_trans hf hfg)] },
+    simpa [abs_of_nonneg hf, abs_of_nonneg (le_trans hf hfg)] },
   { rw [integral_non_ae_strongly_measurable hfm],
     exact integral_nonneg_of_ae (hf.trans h) }
 end
@@ -1153,13 +1261,13 @@ begin
     ((has_finite_integral_iff_of_real hf).1 hfi.2).ne]
 end
 
-lemma norm_integral_le_integral_norm (f : α → E) : ∥(∫ a, f a ∂μ)∥ ≤ ∫ a, ∥f a∥ ∂μ :=
-have le_ae : ∀ᵐ a ∂μ, 0 ≤ ∥f a∥ := eventually_of_forall (λa, norm_nonneg _),
+lemma norm_integral_le_integral_norm (f : α → E) : ‖(∫ a, f a ∂μ)‖ ≤ ∫ a, ‖f a‖ ∂μ :=
+have le_ae : ∀ᵐ a ∂μ, 0 ≤ ‖f a‖ := eventually_of_forall (λa, norm_nonneg _),
 classical.by_cases
 ( λh : ae_strongly_measurable f μ,
-  calc ∥∫ a, f a ∂μ∥ ≤ ennreal.to_real (∫⁻ a, (ennreal.of_real ∥f a∥) ∂μ) :
+  calc ‖∫ a, f a ∂μ‖ ≤ ennreal.to_real (∫⁻ a, (ennreal.of_real ‖f a‖) ∂μ) :
       norm_integral_le_lintegral_norm _
-    ... = ∫ a, ∥f a∥ ∂μ : (integral_eq_lintegral_of_nonneg_ae le_ae $ h.norm).symm )
+    ... = ∫ a, ‖f a‖ ∂μ : (integral_eq_lintegral_of_nonneg_ae le_ae $ h.norm).symm )
 ( λh : ¬ae_strongly_measurable f μ,
   begin
     rw [integral_non_ae_strongly_measurable h, norm_zero],
@@ -1167,8 +1275,8 @@ classical.by_cases
   end )
 
 lemma norm_integral_le_of_norm_le {f : α → E} {g : α → ℝ} (hg : integrable g μ)
-  (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ g x) : ∥∫ x, f x ∂μ∥ ≤ ∫ x, g x ∂μ :=
-calc ∥∫ x, f x ∂μ∥ ≤ ∫ x, ∥f x∥ ∂μ : norm_integral_le_integral_norm f
+  (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ g x) : ‖∫ x, f x ∂μ‖ ≤ ∫ x, g x ∂μ :=
+calc ‖∫ x, f x ∂μ‖ ≤ ∫ x, ‖f x‖ ∂μ : norm_integral_le_integral_norm f
                ... ≤ ∫ x, g x ∂μ   :
   integral_mono_of_nonneg (eventually_of_forall $ λ x, norm_nonneg _) hg h
 
@@ -1188,6 +1296,7 @@ by { rw [← f.integral_eq_integral hfi, simple_func.integral, ← simple_func.i
 begin
   cases (@le_top _ _ _ (μ univ)).lt_or_eq with hμ hμ,
   { haveI : is_finite_measure μ := ⟨hμ⟩,
+    simp only [integral, L1.integral],
     exact set_to_fun_const (dominated_fin_meas_additive_weighted_smul _) _, },
   { by_cases hc : c = 0,
     { simp [hc, integral_zero] },
@@ -1198,9 +1307,9 @@ begin
 end
 
 lemma norm_integral_le_of_norm_le_const [is_finite_measure μ] {f : α → E} {C : ℝ}
-  (h : ∀ᵐ x ∂μ, ∥f x∥ ≤ C) :
-  ∥∫ x, f x ∂μ∥ ≤ C * (μ univ).to_real :=
-calc ∥∫ x, f x ∂μ∥ ≤ ∫ x, C ∂μ : norm_integral_le_of_norm_le (integrable_const C) h
+  (h : ∀ᵐ x ∂μ, ‖f x‖ ≤ C) :
+  ‖∫ x, f x ∂μ‖ ≤ C * (μ univ).to_real :=
+calc ‖∫ x, f x ∂μ‖ ≤ ∫ x, C ∂μ : norm_integral_le_of_norm_le (integrable_const C) h
                ... = C * (μ univ).to_real : by rw [integral_const, smul_eq_mul, mul_comm]
 
 lemma tendsto_integral_approx_on_of_measurable
@@ -1211,9 +1320,9 @@ lemma tendsto_integral_approx_on_of_measurable
   tendsto (λ n, (simple_func.approx_on f hfm s y₀ h₀ n).integral μ) at_top (𝓝 $ ∫ x, f x ∂μ) :=
 begin
   have hfi' := simple_func.integrable_approx_on hfm hfi h₀ h₀i,
-  simp only [simple_func.integral_eq_integral _ (hfi' _)],
-  exact tendsto_integral_of_L1 _ hfi (eventually_of_forall hfi')
-    (simple_func.tendsto_approx_on_L1_nnnorm hfm _ hs (hfi.sub h₀i).2)
+  simp only [simple_func.integral_eq_integral _ (hfi' _), integral, L1.integral],
+  exact tendsto_set_to_fun_approx_on_of_measurable (dominated_fin_meas_additive_weighted_smul μ)
+    hfi hfm hs h₀ h₀i,
 end
 
 lemma tendsto_integral_approx_on_of_measurable_of_range_subset
@@ -1224,10 +1333,7 @@ lemma tendsto_integral_approx_on_of_measurable_of_range_subset
     (𝓝 $ ∫ x, f x ∂μ) :=
 begin
   apply tendsto_integral_approx_on_of_measurable hf fmeas _ _ (integrable_zero _ _ _),
-  apply eventually_of_forall (λ x, _),
-  apply subset_closure,
-  apply hs,
-  simp,
+  exact eventually_of_forall (λ x, subset_closure (hs (set.mem_union_left _ (mem_range_self _)))),
 end
 
 variable {ν : measure α}
@@ -1255,7 +1361,10 @@ end
 
 @[simp] lemma integral_zero_measure {m : measurable_space α} (f : α → E) :
   ∫ x, f x ∂(0 : measure α) = 0 :=
-set_to_fun_measure_zero (dominated_fin_meas_additive_weighted_smul _) rfl
+begin
+  simp only [integral, L1.integral],
+  exact set_to_fun_measure_zero (dominated_fin_meas_additive_weighted_smul _) rfl
+end
 
 theorem integral_finset_sum_measure {ι} {m : measurable_space α} {f : α → E}
   {μ : ι → measure α} {s : finset ι} (hf : ∀ i ∈ s, integrable f (μ i)) :
@@ -1270,7 +1379,7 @@ begin
 end
 
 lemma nndist_integral_add_measure_le_lintegral (h₁ : integrable f μ) (h₂ : integrable f ν) :
-  (nndist (∫ x, f x ∂μ) (∫ x, f x ∂(μ + ν)) : ℝ≥0∞) ≤ ∫⁻ x, ∥f x∥₊ ∂ν :=
+  (nndist (∫ x, f x ∂μ) (∫ x, f x ∂(μ + ν)) : ℝ≥0∞) ≤ ∫⁻ x, ‖f x‖₊ ∂ν :=
 begin
   rw [integral_add_measure h₁ h₂, nndist_comm, nndist_eq_nnnorm, add_sub_cancel'],
   exact ennnorm_integral_le_lintegral_ennnorm _
@@ -1284,11 +1393,11 @@ begin
   simp only [has_sum, ← integral_finset_sum_measure (λ i _, hfi i)],
   refine metric.nhds_basis_ball.tendsto_right_iff.mpr (λ ε ε0, _),
   lift ε to ℝ≥0 using ε0.le,
-  have hf_lt : ∫⁻ x, ∥f x∥₊ ∂(measure.sum μ) < ∞ := hf.2,
-  have hmem : ∀ᶠ y in 𝓝 ∫⁻ x, ∥f x∥₊ ∂(measure.sum μ), ∫⁻ x, ∥f x∥₊ ∂(measure.sum μ) < y + ε,
+  have hf_lt : ∫⁻ x, ‖f x‖₊ ∂(measure.sum μ) < ∞ := hf.2,
+  have hmem : ∀ᶠ y in 𝓝 ∫⁻ x, ‖f x‖₊ ∂(measure.sum μ), ∫⁻ x, ‖f x‖₊ ∂(measure.sum μ) < y + ε,
   { refine tendsto_id.add tendsto_const_nhds (lt_mem_nhds $ ennreal.lt_add_right _ _),
     exacts [hf_lt.ne, ennreal.coe_ne_zero.2 (nnreal.coe_ne_zero.1 ε0.ne')] },
-  refine ((has_sum_lintegral_measure (λ x, ∥f x∥₊) μ).eventually hmem).mono (λ s hs, _),
+  refine ((has_sum_lintegral_measure (λ x, ‖f x‖₊) μ).eventually hmem).mono (λ s hs, _),
   obtain ⟨ν, hν⟩ : ∃ ν, (∑ i in s, μ i) + ν = measure.sum μ,
   { refine ⟨measure.sum (λ i : ↥(sᶜ : set ι), μ i), _⟩,
     simpa only [← measure.sum_coe_finset] using measure.sum_add_sum_compl (s : set ι) μ },
@@ -1304,6 +1413,38 @@ theorem integral_sum_measure {ι} {m : measurable_space α} {f : α → E} {μ :
   ∫ a, f a ∂measure.sum μ = ∑' i, ∫ a, f a ∂μ i :=
 (has_sum_integral_measure hf).tsum_eq.symm
 
+lemma integral_tsum {ι} [countable ι] {f : ι → α → E} (hf : ∀ i, ae_strongly_measurable (f i) μ)
+  (hf' : ∑' i, ∫⁻ (a : α), ‖f i a‖₊ ∂μ ≠ ∞) :
+  ∫ (a : α), (∑' i, f i a) ∂μ = ∑' i, ∫ (a : α), f i a ∂μ :=
+begin
+  have hf'' : ∀ i, ae_measurable (λ x, (‖f i x‖₊ : ℝ≥0∞)) μ, from λ i, (hf i).ennnorm,
+  have hhh : ∀ᵐ (a : α) ∂μ, summable (λ n, (‖f n a‖₊ : ℝ)),
+  { rw ← lintegral_tsum hf'' at hf',
+    refine (ae_lt_top' (ae_measurable.ennreal_tsum hf'') hf').mono _,
+    intros x hx,
+    rw ← ennreal.tsum_coe_ne_top_iff_summable_coe,
+    exact hx.ne, },
+  convert (measure_theory.has_sum_integral_of_dominated_convergence (λ i a, ‖f i a‖₊) hf _
+    hhh ⟨_, _⟩ _).tsum_eq.symm,
+  { intros n,
+    filter_upwards with x,
+    refl, },
+  { simp_rw [← coe_nnnorm, ← nnreal.coe_tsum],
+    rw ae_strongly_measurable_iff_ae_measurable,
+    apply ae_measurable.coe_nnreal_real,
+    apply ae_measurable.nnreal_tsum,
+    exact λ i, (hf i).nnnorm.ae_measurable, },
+  { dsimp [has_finite_integral],
+    have : ∫⁻ a, ∑' n, ‖f n a‖₊ ∂μ < ⊤ := by rwa [lintegral_tsum hf'', lt_top_iff_ne_top],
+    convert this using 1,
+    apply lintegral_congr_ae,
+    simp_rw [← coe_nnnorm, ← nnreal.coe_tsum, nnreal.nnnorm_eq],
+    filter_upwards [hhh] with a ha,
+    exact ennreal.coe_tsum (nnreal.summable_coe.mp ha), },
+  { filter_upwards [hhh] with x hx,
+    exact (summable_of_summable_norm hx).has_sum, },
+end
+
 @[simp] lemma integral_smul_measure (f : α → E) (c : ℝ≥0∞) :
   ∫ x, f x ∂(c • μ) = c.to_real • ∫ x, f x ∂μ :=
 begin
@@ -1402,18 +1543,136 @@ calc ∫ x, f x ∂(measure.dirac a) = ∫ x, f a ∂(measure.dirac a) :
   integral_congr_ae $ ae_eq_dirac f
 ... = f a : by simp [measure.dirac_apply_of_mem]
 
-end properties
+lemma set_integral_dirac' {mα : measurable_space α} {f : α → E} (hf : strongly_measurable f)
+  (a : α) {s : set α} (hs : measurable_set s) [decidable (a ∈ s)] :
+  ∫ x in s, f x ∂(measure.dirac a) = if a ∈ s then f a else 0 :=
+begin
+  rw [restrict_dirac' hs],
+  swap, { apply_instance, },
+  split_ifs,
+  { exact integral_dirac' _ _ hf, },
+  { exact integral_zero_measure _, },
+end
+
+lemma set_integral_dirac [measurable_space α] [measurable_singleton_class α] (f : α → E)
+  (a : α) (s : set α) [decidable (a ∈ s)] :
+  ∫ x in s, f x ∂(measure.dirac a) = if a ∈ s then f a else 0 :=
+begin
+  rw [restrict_dirac],
+  split_ifs,
+  { exact integral_dirac _ _, },
+  { exact integral_zero_measure _, },
+end
 
-mk_simp_attribute integral_simps "Simp set for integral rules."
+lemma mul_meas_ge_le_integral_of_nonneg [is_finite_measure μ] {f : α → ℝ} (hf_nonneg : 0 ≤ f)
+  (hf_int : integrable f μ) (ε : ℝ) :
+  ε * (μ {x | ε ≤ f x}).to_real ≤ ∫ x, f x ∂μ :=
+begin
+  cases lt_or_le ε 0 with hε hε,
+  { exact (mul_nonpos_of_nonpos_of_nonneg hε.le ennreal.to_real_nonneg).trans
+      (integral_nonneg hf_nonneg), },
+  rw [integral_eq_lintegral_of_nonneg_ae (eventually_of_forall (λ x, hf_nonneg x))
+    hf_int.ae_strongly_measurable, ← ennreal.to_real_of_real hε, ← ennreal.to_real_mul],
+  have : {x : α | (ennreal.of_real ε).to_real ≤ f x}
+    = {x : α | ennreal.of_real ε ≤ (λ x, ennreal.of_real (f x)) x},
+  { ext1 x,
+    rw [set.mem_set_of_eq, set.mem_set_of_eq, ← ennreal.to_real_of_real (hf_nonneg x)],
+    exact ennreal.to_real_le_to_real ennreal.of_real_ne_top ennreal.of_real_ne_top, },
+  rw this,
+  have h_meas : ae_measurable (λ x, ennreal.of_real (f x)) μ,
+    from measurable_id'.ennreal_of_real.comp_ae_measurable hf_int.ae_measurable,
+  have h_mul_meas_le := @mul_meas_ge_le_lintegral₀ _ _ μ _ h_meas (ennreal.of_real ε),
+  rw ennreal.to_real_le_to_real _ _,
+  { exact h_mul_meas_le, },
+  { simp only [ne.def, with_top.mul_eq_top_iff, ennreal.of_real_eq_zero, not_le,
+      ennreal.of_real_ne_top, false_and, or_false, not_and],
+    exact λ _, measure_ne_top _ _, },
+  { have h_lt_top : ∫⁻ a, ‖f a‖₊ ∂μ < ∞ := hf_int.has_finite_integral,
+    simp_rw [← of_real_norm_eq_coe_nnnorm, real.norm_eq_abs] at h_lt_top,
+    convert h_lt_top.ne,
+    ext1 x,
+    rw abs_of_nonneg (hf_nonneg x), },
+end
 
-attribute [integral_simps] integral_neg integral_smul L1.integral_add L1.integral_sub
-  L1.integral_smul L1.integral_neg
+/-- Hölder's inequality for the integral of a product of norms. The integral of the product of two
+norms of functions is bounded by the product of their `ℒp` and `ℒq` seminorms when `p` and `q` are
+conjugate exponents. -/
+theorem integral_mul_norm_le_Lp_mul_Lq {E} [normed_add_comm_group E] {f g : α → E}
+  {p q : ℝ} (hpq : p.is_conjugate_exponent q)
+  (hf : mem_ℒp f (ennreal.of_real p) μ) (hg : mem_ℒp g (ennreal.of_real q) μ) :
+  ∫ a, ‖f a‖ * ‖g a‖ ∂μ ≤ (∫ a, ‖f a‖ ^ p ∂μ) ^ (1/p) * (∫ a, ‖g a‖ ^ q ∂μ) ^ (1/q) :=
+begin
+  -- translate the Bochner integrals into Lebesgue integrals.
+  rw [integral_eq_lintegral_of_nonneg_ae, integral_eq_lintegral_of_nonneg_ae,
+    integral_eq_lintegral_of_nonneg_ae],
+  rotate 1,
+  { exact eventually_of_forall (λ x, real.rpow_nonneg_of_nonneg (norm_nonneg _) _), },
+  { exact (hg.1.norm.ae_measurable.pow ae_measurable_const).ae_strongly_measurable, },
+  { exact eventually_of_forall (λ x, real.rpow_nonneg_of_nonneg (norm_nonneg _) _),},
+  { exact (hf.1.norm.ae_measurable.pow ae_measurable_const).ae_strongly_measurable, },
+  { exact eventually_of_forall (λ x, mul_nonneg (norm_nonneg _) (norm_nonneg _)), },
+  { exact hf.1.norm.mul hg.1.norm, },
+  rw [ennreal.to_real_rpow, ennreal.to_real_rpow, ← ennreal.to_real_mul],
+  -- replace norms by nnnorm
+  have h_left : ∫⁻ a, ennreal.of_real (‖f a‖ * ‖g a‖) ∂μ
+    = ∫⁻ a, ((λ x, (‖f x‖₊ : ℝ≥0∞)) * (λ x, ‖g x‖₊)) a ∂μ,
+  { simp_rw [pi.mul_apply, ← of_real_norm_eq_coe_nnnorm, ennreal.of_real_mul (norm_nonneg _)], },
+  have h_right_f : ∫⁻ a, ennreal.of_real (‖f a‖ ^ p) ∂μ = ∫⁻ a, ‖f a‖₊ ^ p ∂μ,
+  { refine lintegral_congr (λ x, _),
+    rw [← of_real_norm_eq_coe_nnnorm, ennreal.of_real_rpow_of_nonneg (norm_nonneg _) hpq.nonneg], },
+  have h_right_g : ∫⁻ a, ennreal.of_real (‖g a‖ ^ q) ∂μ = ∫⁻ a, ‖g a‖₊ ^ q ∂μ,
+  { refine lintegral_congr (λ x, _),
+    rw [← of_real_norm_eq_coe_nnnorm,
+      ennreal.of_real_rpow_of_nonneg (norm_nonneg _) hpq.symm.nonneg], },
+  rw [h_left, h_right_f, h_right_g],
+  -- we can now apply `ennreal.lintegral_mul_le_Lp_mul_Lq` (up to the `to_real` application)
+  refine ennreal.to_real_mono _ _,
+  { refine ennreal.mul_ne_top _ _,
+    { convert hf.snorm_ne_top,
+      rw snorm_eq_lintegral_rpow_nnnorm,
+      { rw ennreal.to_real_of_real hpq.nonneg, },
+      { rw [ne.def, ennreal.of_real_eq_zero, not_le],
+        exact hpq.pos, },
+      { exact ennreal.coe_ne_top, }, },
+    { convert hg.snorm_ne_top,
+      rw snorm_eq_lintegral_rpow_nnnorm,
+      { rw ennreal.to_real_of_real hpq.symm.nonneg, },
+      { rw [ne.def, ennreal.of_real_eq_zero, not_le],
+        exact hpq.symm.pos, },
+      { exact ennreal.coe_ne_top, }, }, },
+  { exact ennreal.lintegral_mul_le_Lp_mul_Lq μ hpq hf.1.nnnorm.ae_measurable.coe_nnreal_ennreal
+      hg.1.nnnorm.ae_measurable.coe_nnreal_ennreal, },
+end
 
-attribute [irreducible] integral L1.integral
+/-- Hölder's inequality for functions `α → ℝ`. The integral of the product of two nonnegative
+functions is bounded by the product of their `ℒp` and `ℒq` seminorms when `p` and `q` are conjugate
+exponents. -/
+theorem integral_mul_le_Lp_mul_Lq_of_nonneg {p q : ℝ}
+  (hpq : p.is_conjugate_exponent q) {f g : α → ℝ} (hf_nonneg : 0 ≤ᵐ[μ] f) (hg_nonneg : 0 ≤ᵐ[μ] g)
+  (hf : mem_ℒp f (ennreal.of_real p) μ) (hg : mem_ℒp g (ennreal.of_real q) μ) :
+  ∫ a, f a * g a ∂μ ≤ (∫ a, (f a) ^ p ∂μ) ^ (1/p) * (∫ a, (g a) ^ q ∂μ) ^ (1/q) :=
+begin
+  have h_left : ∫ a, f a * g a ∂μ = ∫ a, ‖f a‖ * ‖g a‖ ∂μ,
+  { refine integral_congr_ae _,
+    filter_upwards [hf_nonneg, hg_nonneg] with x hxf hxg,
+    rw [real.norm_of_nonneg hxf, real.norm_of_nonneg hxg], },
+  have h_right_f : ∫ a, (f a) ^ p ∂μ = ∫ a, ‖f a‖ ^ p ∂μ,
+  { refine integral_congr_ae _,
+    filter_upwards [hf_nonneg] with x hxf,
+    rw real.norm_of_nonneg hxf, },
+  have h_right_g : ∫ a, (g a) ^ q ∂μ = ∫ a, ‖g a‖ ^ q ∂μ,
+  { refine integral_congr_ae _,
+    filter_upwards [hg_nonneg] with x hxg,
+    rw real.norm_of_nonneg hxg, },
+  rw [h_left, h_right_f, h_right_g],
+  exact integral_mul_norm_le_Lp_mul_Lq hpq hf hg,
+end
+
+end properties
 
 section integral_trim
 
-variables {H β γ : Type*} [normed_group H]
+variables {H β γ : Type*} [normed_add_comm_group H]
   {m m0 : measurable_space β} {μ : measure β}
 
 /-- Simple function seen as simple function of a larger `measurable_space`. -/
@@ -1500,7 +1759,7 @@ lemma ae_eq_trim_iff [topological_space γ] [metrizable_space γ]
 ⟨ae_eq_of_ae_eq_trim, ae_eq_trim_of_strongly_measurable hm hf hg⟩
 
 lemma ae_le_trim_of_strongly_measurable
-  [linear_order γ] [topological_space γ] [order_closed_topology γ] [metrizable_space γ]
+  [linear_order γ] [topological_space γ] [order_closed_topology γ] [pseudo_metrizable_space γ]
   (hm : m ≤ m0) {f g : β → γ} (hf : strongly_measurable[m] f) (hg : strongly_measurable[m] g)
   (hfg : f ≤ᵐ[μ] g) :
   f ≤ᵐ[μ.trim hm] g :=
@@ -1510,11 +1769,72 @@ begin
 end
 
 lemma ae_le_trim_iff
-  [linear_order γ] [topological_space γ] [order_closed_topology γ] [metrizable_space γ]
+  [linear_order γ] [topological_space γ] [order_closed_topology γ] [pseudo_metrizable_space γ]
   (hm : m ≤ m0) {f g : β → γ} (hf : strongly_measurable[m] f) (hg : strongly_measurable[m] g) :
   f ≤ᵐ[μ.trim hm] g ↔ f ≤ᵐ[μ] g :=
 ⟨ae_le_of_ae_le_trim, ae_le_trim_of_strongly_measurable hm hf hg⟩
 
 end integral_trim
 
+section snorm_bound
+
+variables {m0 : measurable_space α} {μ : measure α}
+
+lemma snorm_one_le_of_le {r : ℝ≥0} {f : α → ℝ}
+  (hfint : integrable f μ) (hfint' : 0 ≤ ∫ x, f x ∂μ) (hf : ∀ᵐ ω ∂μ, f ω ≤ r) :
+  snorm f 1 μ ≤ 2 * μ set.univ * r :=
+begin
+  by_cases hr : r = 0,
+  { suffices : f =ᵐ[μ] 0,
+    { rw [snorm_congr_ae this, snorm_zero, hr, ennreal.coe_zero, mul_zero],
+      exact le_rfl },
+    rw [hr, nonneg.coe_zero] at hf,
+    have hnegf : ∫ x, -f x ∂μ = 0,
+    { rw [integral_neg, neg_eq_zero],
+      exact le_antisymm (integral_nonpos_of_ae hf) hfint' },
+    have := (integral_eq_zero_iff_of_nonneg_ae _ hfint.neg).1 hnegf,
+    { filter_upwards [this] with ω hω,
+      rwa [pi.neg_apply, pi.zero_apply, neg_eq_zero] at hω },
+    { filter_upwards [hf] with ω hω,
+      rwa [pi.zero_apply, pi.neg_apply, right.nonneg_neg_iff] } },
+  by_cases hμ : is_finite_measure μ,
+  swap,
+  { have : μ set.univ = ∞,
+    { by_contra hμ',
+      exact hμ (is_finite_measure.mk $ lt_top_iff_ne_top.2 hμ') },
+    rw [this, ennreal.mul_top, if_neg, ennreal.top_mul, if_neg],
+    { exact le_top },
+    { simp [hr] },
+    { norm_num } },
+  haveI := hμ,
+  rw [integral_eq_integral_pos_part_sub_integral_neg_part hfint, sub_nonneg] at hfint',
+  have hposbdd : ∫ ω, max (f ω) 0 ∂μ ≤ (μ set.univ).to_real • r,
+  { rw ← integral_const,
+    refine integral_mono_ae hfint.real_to_nnreal (integrable_const r) _,
+    filter_upwards [hf] with ω hω using real.to_nnreal_le_iff_le_coe.2 hω },
+  rw [mem_ℒp.snorm_eq_integral_rpow_norm one_ne_zero ennreal.one_ne_top
+      (mem_ℒp_one_iff_integrable.2 hfint),
+    ennreal.of_real_le_iff_le_to_real (ennreal.mul_ne_top
+      (ennreal.mul_ne_top ennreal.two_ne_top $ @measure_ne_top _ _ _ hμ _) ennreal.coe_ne_top)],
+  simp_rw [ennreal.one_to_real, _root_.inv_one, real.rpow_one, real.norm_eq_abs,
+    ← max_zero_add_max_neg_zero_eq_abs_self, ← real.coe_to_nnreal'],
+  rw integral_add hfint.real_to_nnreal,
+  { simp only [real.coe_to_nnreal', ennreal.to_real_mul, ennreal.to_real_bit0,
+    ennreal.one_to_real, ennreal.coe_to_real] at hfint' ⊢,
+    refine (add_le_add_left hfint' _).trans _,
+    rwa [← two_mul, mul_assoc, mul_le_mul_left (two_pos : (0 : ℝ) < 2)] },
+  { exact hfint.neg.sup (integrable_zero _ _ μ) }
+end
+
+lemma snorm_one_le_of_le' {r : ℝ} {f : α → ℝ}
+  (hfint : integrable f μ) (hfint' : 0 ≤ ∫ x, f x ∂μ) (hf : ∀ᵐ ω ∂μ, f ω ≤ r) :
+  snorm f 1 μ ≤ 2 * μ set.univ * ennreal.of_real r :=
+begin
+  refine snorm_one_le_of_le hfint hfint' _,
+  simp only [real.coe_to_nnreal', le_max_iff],
+  filter_upwards [hf] with ω hω using or.inl hω,
+end
+
+end snorm_bound
+
 end measure_theory
diff --git a/src/measure_theory/integral/circle_integral.lean b/src/measure_theory/integral/circle_integral.lean
index 2b621adf67b2b..3f553cf5c911d 100644
--- a/src/measure_theory/integral/circle_integral.lean
+++ b/src/measure_theory/integral/circle_integral.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
 import measure_theory.integral.interval_integral
+import analysis.calculus.deriv.zpow
 import analysis.normed_space.pointwise
 import analysis.special_functions.non_integrable
 import analysis.analytic.basic
@@ -11,6 +12,9 @@ import analysis.analytic.basic
 /-!
 # Integral over a circle in `ℂ`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `∮ z in C(c, R), f z` to be the integral $\oint_{|z-c|=|R|} f(z)\,dz$ and
 prove some properties of this integral. We give definition and prove most lemmas for a function
 `f : ℂ → E`, where `E` is a complex Banach space. For this reason,
@@ -65,11 +69,11 @@ some lemmas use, e.g., `(z - c)⁻¹ • f z` instead of `f z / (z - c)`.
 integral, circle, Cauchy integral
 -/
 
-variables {E : Type*} [normed_group E]
+variables {E : Type*} [normed_add_comm_group E]
 
 noncomputable theory
 
-open_locale real nnreal interval pointwise topological_space
+open_locale real nnreal interval pointwise topology
 open complex measure_theory topological_space metric function set filter asymptotics
 
 /-!
@@ -109,11 +113,18 @@ lemma circle_map_mem_closed_ball (c : ℂ) {R : ℝ} (hR : 0 ≤ R) (θ : ℝ) :
   circle_map c R θ ∈ closed_ball c R :=
 sphere_subset_closed_ball (circle_map_mem_sphere c hR θ)
 
+lemma circle_map_not_mem_ball (c : ℂ) (R : ℝ) (θ : ℝ) : circle_map c R θ ∉ ball c R :=
+by simp [dist_eq, le_abs_self]
+
+lemma circle_map_ne_mem_ball {c : ℂ} {R : ℝ} {w : ℂ} (hw : w ∈ ball c R) (θ : ℝ) :
+  circle_map c R θ ≠ w :=
+(ne_of_mem_of_not_mem hw (circle_map_not_mem_ball _ _ _)).symm
+
 /-- The range of `circle_map c R` is the circle with center `c` and radius `|R|`. -/
 @[simp] lemma range_circle_map (c : ℂ) (R : ℝ) : range (circle_map c R) = sphere c (|R|) :=
 calc range (circle_map c R) = c +ᵥ R • range (λ θ : ℝ, exp (θ * I)) :
   by simp only [← image_vadd, ← image_smul, ← range_comp, vadd_eq_add, circle_map, (∘), real_smul]
-... = sphere c (|R|) : by simp [smul_sphere R (0 : ℂ) zero_le_one, real.norm_eq_abs]
+... = sphere c (|R|) : by simp [smul_sphere R (0 : ℂ) zero_le_one]
 
 /-- The image of `(0, 2π]` under `circle_map c R` is the circle with center `c` and radius `|R|`. -/
 @[simp] lemma image_circle_map_Ioc (c : ℂ) (R : ℝ) :
@@ -132,7 +143,7 @@ mt circle_map_eq_center_iff.1 hR
 lemma has_deriv_at_circle_map (c : ℂ) (R : ℝ) (θ : ℝ) :
   has_deriv_at (circle_map c R) (circle_map 0 R θ * I) θ :=
 by simpa only [mul_assoc, one_mul, of_real_clm_apply, circle_map, of_real_one, zero_add]
- using ((of_real_clm.has_deriv_at.mul_const I).cexp_real.const_mul (R : ℂ)).const_add c
+ using ((of_real_clm.has_deriv_at.mul_const I).cexp.const_mul (R : ℂ)).const_add c
 
 /- TODO: prove `cont_diff ℝ (circle_map c R)`. This needs a version of `cont_diff.mul`
 for multiplication in a normed algebra over the base field. -/
@@ -164,6 +175,14 @@ lemma lipschitz_with_circle_map (c : ℂ) (R : ℝ) :
 lipschitz_with_of_nnnorm_deriv_le (differentiable_circle_map _ _) $ λ θ,
   nnreal.coe_le_coe.1 $ by simp
 
+lemma continuous_circle_map_inv {R : ℝ} {z w : ℂ} (hw : w ∈ ball z R) :
+ continuous (λ θ, (circle_map z R θ - w)⁻¹) :=
+begin
+  have : ∀ θ, circle_map z R θ - w ≠ 0,
+  { simp_rw sub_ne_zero, exact λ θ, circle_map_ne_mem_ball hw θ, },
+  continuity,
+end
+
 /-!
 ### Integrability of a function on a circle
 -/
@@ -244,7 +263,7 @@ begin
   { intro h, contrapose! h, rcases h with ⟨hR, hn, hw⟩,
     simp only [circle_integrable_iff R, deriv_circle_map],
     rw ← image_circle_map_Ioc at hw, rcases hw with ⟨θ, hθ, rfl⟩,
-    replace hθ : θ ∈ [0, 2 * π], from Icc_subset_interval (Ioc_subset_Icc_self hθ),
+    replace hθ : θ ∈ [0, 2 * π], from Icc_subset_uIcc (Ioc_subset_Icc_self hθ),
     refine not_interval_integrable_of_sub_inv_is_O_punctured _ real.two_pi_pos.ne hθ,
     set f : ℝ → ℂ := λ θ', circle_map c R θ' - circle_map c R θ,
     have : ∀ᶠ θ' in 𝓝[≠] θ, f θ' ∈ ball (0 : ℂ) 1 \ {0},
@@ -253,12 +272,17 @@ begin
           (deriv_circle_map_ne_zero hR)).eventually this,
       filter_upwards [self_mem_nhds_within,
         mem_nhds_within_of_mem_nhds (ball_mem_nhds _ zero_lt_one)],
-      simp [dist_eq, sub_eq_zero] { contextual := tt } },
+      simp only [dist_eq, sub_eq_zero, mem_compl_iff, mem_singleton_iff, mem_ball, mem_diff,
+                 mem_ball_zero_iff, norm_eq_abs, not_false_iff, and_self, implies_true_iff]
+                {contextual := tt} },
     refine ((((has_deriv_at_circle_map c R θ).is_O_sub).mono inf_le_left).inv_rev
-      (this.mono (λ θ', and.right))).trans _,
+      (this.mono (λ θ' h₁ h₂, absurd h₂ h₁.2))).trans _,
     refine is_O.of_bound (|R|)⁻¹ (this.mono $ λ θ' hθ', _),
     set x := abs (f θ'),
-    suffices : x⁻¹ ≤ x ^ n, by simpa [inv_mul_cancel_left₀, mt _root_.abs_eq_zero.1 hR],
+    suffices : x⁻¹ ≤ x ^ n,
+    by simpa only [inv_mul_cancel_left₀, abs_eq_zero.not.2 hR, norm_eq_abs, map_inv₀,
+                   algebra.id.smul_eq_mul, map_mul, abs_circle_map_zero, abs_I, mul_one,
+                   abs_zpow, ne.def, not_false_iff] using this,
     have : x ∈ Ioo (0 : ℝ) 1, by simpa [and.comm, x] using hθ',
     rw ← zpow_neg_one,
     refine (zpow_strict_anti this.1 this.2).le_iff_le.2 (int.lt_add_one_iff.1 _), exact hn },
@@ -298,7 +322,7 @@ lemma integral_sub_inv_smul_sub_smul (f : ℂ → E) (c w : ℂ) (R : ℝ) :
   ∮ z in C(c, R), (z - w)⁻¹ • (z - w) • f z = ∮ z in C(c, R), f z :=
 begin
   rcases eq_or_ne R 0 with rfl|hR, { simp only [integral_radius_zero] },
-  have : countable (circle_map c R ⁻¹' {w}), from (countable_singleton _).preimage_circle_map c hR,
+  have : (circle_map c R ⁻¹' {w}).countable, from (countable_singleton _).preimage_circle_map c hR,
   refine interval_integral.integral_congr_ae ((this.ae_not_mem _).mono $ λ θ hθ hθ', _),
   change circle_map c R θ ≠ w at hθ,
   simp only [inv_smul_smul₀ (sub_ne_zero.2 $ hθ)]
@@ -314,11 +338,11 @@ lemma integral_sub {f g : ℂ → E} {c : ℂ} {R : ℝ} (hf : circle_integrable
 by simp only [circle_integral, smul_sub, interval_integral.integral_sub hf.out hg.out]
 
 lemma norm_integral_le_of_norm_le_const' {f : ℂ → E} {c : ℂ} {R C : ℝ}
-  (hf : ∀ z ∈ sphere c (|R|), ∥f z∥ ≤ C) :
-  ∥∮ z in C(c, R), f z∥ ≤ 2 * π * |R| * C :=
-calc ∥∮ z in C(c, R), f z∥ ≤ |R| * C * |2 * π - 0| :
+  (hf : ∀ z ∈ sphere c (|R|), ‖f z‖ ≤ C) :
+  ‖∮ z in C(c, R), f z‖ ≤ 2 * π * |R| * C :=
+calc ‖∮ z in C(c, R), f z‖ ≤ |R| * C * |2 * π - 0| :
   interval_integral.norm_integral_le_of_norm_le_const $ λ θ _,
-    (calc ∥deriv (circle_map c R) θ • f (circle_map c R θ)∥ = |R| * ∥f (circle_map c R θ)∥ :
+    (calc ‖deriv (circle_map c R) θ • f (circle_map c R θ)‖ = |R| * ‖f (circle_map c R θ)‖ :
       by simp [norm_smul]
     ... ≤ |R| * C : mul_le_mul_of_nonneg_left (hf _ $ circle_map_mem_sphere' _ _ _)
       (_root_.abs_nonneg _))
@@ -326,37 +350,37 @@ calc ∥∮ z in C(c, R), f z∥ ≤ |R| * C * |2 * π - 0| :
   by { rw [sub_zero, _root_.abs_of_pos real.two_pi_pos], ac_refl }
 
 lemma norm_integral_le_of_norm_le_const {f : ℂ → E} {c : ℂ} {R C : ℝ} (hR : 0 ≤ R)
-  (hf : ∀ z ∈ sphere c R, ∥f z∥ ≤ C) :
-  ∥∮ z in C(c, R), f z∥ ≤ 2 * π * R * C :=
+  (hf : ∀ z ∈ sphere c R, ‖f z‖ ≤ C) :
+  ‖∮ z in C(c, R), f z‖ ≤ 2 * π * R * C :=
 have |R| = R, from _root_.abs_of_nonneg hR,
-calc ∥∮ z in C(c, R), f z∥ ≤ 2 * π * |R| * C :
+calc ‖∮ z in C(c, R), f z‖ ≤ 2 * π * |R| * C :
   norm_integral_le_of_norm_le_const' $ by rwa this
 ... = 2 * π * R * C : by rw this
 
 lemma norm_two_pi_I_inv_smul_integral_le_of_norm_le_const {f : ℂ → E} {c : ℂ} {R C : ℝ} (hR : 0 ≤ R)
-  (hf : ∀ z ∈ sphere c R, ∥f z∥ ≤ C) :
-  ∥(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), f z∥ ≤ R * C :=
+  (hf : ∀ z ∈ sphere c R, ‖f z‖ ≤ C) :
+  ‖(2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), f z‖ ≤ R * C :=
 begin
-  have : ∥(2 * π * I : ℂ)⁻¹∥ = (2 * π)⁻¹, by simp [real.pi_pos.le],
+  have : ‖(2 * π * I : ℂ)⁻¹‖ = (2 * π)⁻¹, by simp [real.pi_pos.le],
   rw [norm_smul, this, ← div_eq_inv_mul, div_le_iff real.two_pi_pos, mul_comm (R * C), ← mul_assoc],
   exact norm_integral_le_of_norm_le_const hR hf
 end
 
-/-- If `f` is continuous on the circle `|z - c| = R`, `R > 0`, the `∥f z∥` is less than or equal to
+/-- If `f` is continuous on the circle `|z - c| = R`, `R > 0`, the `‖f z‖` is less than or equal to
 `C : ℝ` on this circle, and this norm is strictly less than `C` at some point `z` of the circle,
-then `∥∮ z in C(c, R), f z∥ < 2 * π * R * C`. -/
+then `‖∮ z in C(c, R), f z‖ < 2 * π * R * C`. -/
 lemma norm_integral_lt_of_norm_le_const_of_lt {f : ℂ → E} {c : ℂ} {R C : ℝ} (hR : 0 < R)
-  (hc : continuous_on f (sphere c R)) (hf : ∀ z ∈ sphere c R, ∥f z∥ ≤ C)
-  (hlt : ∃ z ∈ sphere c R, ∥f z∥ < C) :
-  ∥∮ z in C(c, R), f z∥ < 2 * π * R * C :=
+  (hc : continuous_on f (sphere c R)) (hf : ∀ z ∈ sphere c R, ‖f z‖ ≤ C)
+  (hlt : ∃ z ∈ sphere c R, ‖f z‖ < C) :
+  ‖∮ z in C(c, R), f z‖ < 2 * π * R * C :=
 begin
   rw [← _root_.abs_of_pos hR, ← image_circle_map_Ioc] at hlt,
   rcases hlt with ⟨_, ⟨θ₀, hmem, rfl⟩, hlt⟩,
-  calc ∥∮ z in C(c, R), f z∥ ≤ ∫ θ in 0..2 * π, ∥deriv (circle_map c R) θ • f (circle_map c R θ)∥ :
+  calc ‖∮ z in C(c, R), f z‖ ≤ ∫ θ in 0..2 * π, ‖deriv (circle_map c R) θ • f (circle_map c R θ)‖ :
     interval_integral.norm_integral_le_integral_norm real.two_pi_pos.le
   ... < ∫ θ in 0..2 * π, R * C :
     begin
-      simp only [norm_smul, deriv_circle_map, norm_eq_abs, complex.abs_mul, abs_I, mul_one,
+      simp only [norm_smul, deriv_circle_map, norm_eq_abs, map_mul, abs_I, mul_one,
         abs_circle_map_zero, abs_of_pos hR],
       refine interval_integral.integral_lt_integral_of_continuous_on_of_le_of_exists_lt
         real.two_pi_pos _ continuous_on_const (λ θ hθ, _) ⟨θ₀, Ioc_subset_Icc_self hmem, _⟩,
@@ -456,18 +480,18 @@ by simp only [cauchy_power_series, continuous_multilinear_map.mk_pi_field_apply,
   div_eq_mul_inv, mul_pow, mul_smul, circle_integral.integral_smul, ← smul_comm (w ^ n)]
 
 lemma norm_cauchy_power_series_le (f : ℂ → E) (c : ℂ) (R : ℝ) (n : ℕ) :
-  ∥cauchy_power_series f c R n∥ ≤
-    (2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ∥f (circle_map c R θ)∥) * (|R|⁻¹) ^ n :=
-calc ∥cauchy_power_series f c R n∥
-    = (2 * π)⁻¹ * ∥∮ z in C(c, R), (z - c)⁻¹ ^ n • (z - c)⁻¹ • f z∥ :
+  ‖cauchy_power_series f c R n‖ ≤
+    (2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ‖f (circle_map c R θ)‖) * (|R|⁻¹) ^ n :=
+calc ‖cauchy_power_series f c R n‖
+    = (2 * π)⁻¹ * ‖∮ z in C(c, R), (z - c)⁻¹ ^ n • (z - c)⁻¹ • f z‖ :
   by simp [cauchy_power_series, norm_smul, real.pi_pos.le]
-... ≤ (2 * π)⁻¹ * ∫ θ in 0..2*π, ∥deriv (circle_map c R) θ • (circle_map c R θ - c)⁻¹ ^ n •
-  (circle_map c R θ - c)⁻¹ • f (circle_map c R θ)∥ :
+... ≤ (2 * π)⁻¹ * ∫ θ in 0..2*π, ‖deriv (circle_map c R) θ • (circle_map c R θ - c)⁻¹ ^ n •
+  (circle_map c R θ - c)⁻¹ • f (circle_map c R θ)‖ :
   mul_le_mul_of_nonneg_left (interval_integral.norm_integral_le_integral_norm real.two_pi_pos.le)
     (by simp [real.pi_pos.le])
-... = (2 * π)⁻¹ * (|R|⁻¹ ^ n * (|R| * (|R|⁻¹ * ∫ (x : ℝ) in 0..2 * π, ∥f (circle_map c R x)∥))) :
+... = (2 * π)⁻¹ * (|R|⁻¹ ^ n * (|R| * (|R|⁻¹ * ∫ (x : ℝ) in 0..2 * π, ‖f (circle_map c R x)‖))) :
   by simp [norm_smul, mul_left_comm (|R|)]
-... ≤ (2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ∥f (circle_map c R θ)∥) * |R|⁻¹ ^ n :
+... ≤ (2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ‖f (circle_map c R θ)‖) * |R|⁻¹ ^ n :
   begin
     rcases eq_or_ne R 0 with rfl|hR,
     { cases n; simp [-mul_inv_rev, real.two_pi_pos] },
@@ -479,7 +503,7 @@ lemma le_radius_cauchy_power_series (f : ℂ → E) (c : ℂ) (R : ℝ≥0) :
   ↑R ≤ (cauchy_power_series f c R).radius :=
 begin
   refine (cauchy_power_series f c R).le_radius_of_bound
-    ((2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ∥f (circle_map c R θ)∥)) (λ n, _),
+    ((2 * π)⁻¹ * (∫ θ : ℝ in 0..2*π, ‖f (circle_map c R θ)‖)) (λ n, _),
   refine (mul_le_mul_of_nonneg_right (norm_cauchy_power_series_le _ _ _ _)
     (pow_nonneg R.coe_nonneg _)).trans _,
   rw [_root_.abs_of_nonneg R.coe_nonneg],
@@ -487,7 +511,7 @@ begin
   { rw [hR, mul_zero],
     exact mul_nonneg (inv_nonneg.2 real.two_pi_pos.le)
       (interval_integral.integral_nonneg real.two_pi_pos.le (λ _ _, norm_nonneg _)) },
-  { rw [inv_pow₀, inv_mul_cancel_right₀ hR] }
+  { rw [inv_pow, inv_mul_cancel_right₀ hR] }
 end
 
 /-- For any circle integrable function `f`, the power series `cauchy_power_series f c R` multiplied
@@ -498,24 +522,24 @@ lemma has_sum_two_pi_I_cauchy_power_series_integral {f : ℂ → E} {c : ℂ} {R
   has_sum (λ n : ℕ, ∮ z in C(c, R), (w / (z - c)) ^ n • (z - c)⁻¹ • f z)
     (∮ z in C(c, R), (z - (c + w))⁻¹ • f z) :=
 begin
-  have hR : 0 < R := (abs_nonneg w).trans_lt hw,
+  have hR : 0 < R := (complex.abs.nonneg w).trans_lt hw,
   have hwR : abs w / R ∈ Ico (0 : ℝ) 1,
-    from ⟨div_nonneg (abs_nonneg w) hR.le, (div_lt_one hR).2 hw⟩,
+    from ⟨div_nonneg (complex.abs.nonneg w) hR.le, (div_lt_one hR).2 hw⟩,
   refine interval_integral.has_sum_integral_of_dominated_convergence
-    (λ n θ, ∥f (circle_map c R θ)∥ * (abs w / R) ^ n) (λ n, _) (λ n, _) _ _ _,
+    (λ n θ, ‖f (circle_map c R θ)‖ * (abs w / R) ^ n) (λ n, _) (λ n, _) _ _ _,
   { simp only [deriv_circle_map],
     apply_rules [ae_strongly_measurable.smul, hf.def.1];
     { apply measurable.ae_strongly_measurable, measurability } },
-  { simp [norm_smul, abs_of_pos hR, mul_left_comm R, mul_inv_cancel_left₀ hR.ne', mul_comm (∥_∥)] },
+  { simp [norm_smul, abs_of_pos hR, mul_left_comm R, mul_inv_cancel_left₀ hR.ne', mul_comm (‖_‖)] },
   { exact eventually_of_forall (λ _ _, (summable_geometric_of_lt_1 hwR.1 hwR.2).mul_left _) },
   { simpa only [tsum_mul_left, tsum_geometric_of_lt_1 hwR.1 hwR.2]
       using hf.norm.mul_continuous_on continuous_on_const },
-  { refine eventually_of_forall (λ θ hθ, has_sum.const_smul _),
+  { refine eventually_of_forall (λ θ hθ, has_sum.const_smul _ _),
     simp only [smul_smul],
-    refine has_sum.smul_const _,
-    have : ∥w / (circle_map c R θ - c)∥ < 1, by simpa [abs_of_pos hR] using hwR.2,
+    refine has_sum.smul_const _ _,
+    have : ‖w / (circle_map c R θ - c)‖ < 1, by simpa [abs_of_pos hR] using hwR.2,
     convert (has_sum_geometric_of_norm_lt_1 this).mul_right _,
-    simp [← sub_sub, ← mul_inv₀, sub_mul, div_mul_cancel _ (circle_map_ne_center hR.ne')] }
+    simp [← sub_sub, ← mul_inv, sub_mul, div_mul_cancel _ (circle_map_ne_center hR.ne')] }
 end
 
 /-- For any circle integrable function `f`, the power series `cauchy_power_series f c R`, `R > 0`,
@@ -527,7 +551,7 @@ lemma has_sum_cauchy_power_series_integral {f : ℂ → E} {c : ℂ} {R : ℝ} {
     ((2 * π * I : ℂ)⁻¹ • ∮ z in C(c, R), (z - (c + w))⁻¹ • f z) :=
 begin
   simp only [cauchy_power_series_apply],
-  exact (has_sum_two_pi_I_cauchy_power_series_integral hf hw).const_smul
+  exact (has_sum_two_pi_I_cauchy_power_series_integral hf hw).const_smul _
 end
 
 /-- For any circle integrable function `f`, the power series `cauchy_power_series f c R`, `R > 0`,
@@ -574,7 +598,7 @@ begin
   refine this ▸ has_sum_single _ (λ n hn, _),
   simp only [div_eq_mul_inv, mul_pow, integral_const_mul, mul_assoc],
   rw [(integral_congr hR.le (λ z hz, _)).trans (H n hn), mul_zero],
-  rw [← pow_succ', ← zpow_coe_nat, inv_zpow₀, ← zpow_neg₀, int.coe_nat_succ, neg_add,
+  rw [← pow_succ', ← zpow_coe_nat, inv_zpow, ← zpow_neg, int.coe_nat_succ, neg_add,
     sub_eq_add_neg _ (1 : ℤ)]
 end
 
diff --git a/src/measure_theory/integral/circle_transform.lean b/src/measure_theory/integral/circle_transform.lean
new file mode 100644
index 0000000000000..4ba4ce3582103
--- /dev/null
+++ b/src/measure_theory/integral/circle_transform.lean
@@ -0,0 +1,177 @@
+/-
+Copyright (c) 2022 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck
+-/
+import data.complex.basic
+import measure_theory.integral.circle_integral
+/-!
+# Circle integral transform
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define the circle integral transform of a function `f` with complex domain. This is
+defined as $(2πi)^{-1}\frac{f(x)}{x-w}$ where `x` moves along a circle. We then prove some basic
+facts about these functions.
+
+These results are useful for proving that the uniform limit of a sequence of holomorphic functions
+is holomorphic.
+
+-/
+
+open set measure_theory metric filter function
+open_locale interval real
+
+noncomputable theory
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℂ E] (R : ℝ) (z w : ℂ)
+
+namespace complex
+
+/-- Given a function `f : ℂ → E`, `circle_transform R z w f` is the functions mapping `θ` to
+`(2 * ↑π * I)⁻¹ • deriv (circle_map z R) θ • ((circle_map z R θ) - w)⁻¹ • f (circle_map z R θ)`.
+
+If `f` is differentiable and `w` is in the interior of the ball, then the integral from `0` to
+`2 * π` of this gives the value `f(w)`. -/
+def circle_transform (f : ℂ → E) (θ : ℝ) : E :=
+(2 * ↑π * I)⁻¹ • deriv (circle_map z R) θ • ((circle_map z R θ) - w)⁻¹ • f (circle_map z R θ)
+
+/-- The derivative of `circle_transform` w.r.t `w`.-/
+def circle_transform_deriv (f : ℂ → E) (θ : ℝ) : E :=
+(2 * ↑π * I)⁻¹ • deriv (circle_map z R) θ • ((circle_map z R θ - w) ^ 2)⁻¹ • f (circle_map z R θ)
+
+lemma circle_transform_deriv_periodic (f : ℂ → E) :
+  periodic (circle_transform_deriv R z w f) (2 * π) :=
+begin
+  have := periodic_circle_map,
+  simp_rw periodic at *,
+  intro x,
+  simp_rw [circle_transform_deriv, this],
+  congr' 2,
+  simp [this],
+end
+
+lemma circle_transform_deriv_eq (f : ℂ → E) :
+  circle_transform_deriv R z w f =
+  (λ θ, (circle_map z R θ - w)⁻¹ • (circle_transform R z w f θ)) :=
+begin
+  ext,
+  simp_rw [circle_transform_deriv, circle_transform, ←mul_smul, ←mul_assoc],
+  ring_nf,
+  rw inv_pow,
+  congr,
+  ring,
+end
+
+lemma integral_circle_transform [complete_space E] (f : ℂ → E) :
+  ∫ (θ : ℝ) in 0..2 * π, circle_transform R z w f θ =
+  (2 * ↑π * I)⁻¹ • ∮ z in C(z, R), (z - w)⁻¹ • f z :=
+begin
+  simp_rw [circle_transform, circle_integral, deriv_circle_map, circle_map],
+  simp,
+end
+
+lemma continuous_circle_transform {R : ℝ} (hR : 0 < R) {f : ℂ → E} {z w : ℂ}
+  (hf : continuous_on f $ sphere z R) (hw : w ∈ ball z R) :
+  continuous (circle_transform R z w f) :=
+begin
+  apply_rules [continuous.smul, continuous_const],
+  simp_rw deriv_circle_map,
+  apply_rules [continuous.mul, (continuous_circle_map 0 R), continuous_const],
+  { apply continuous_circle_map_inv hw },
+  { apply continuous_on.comp_continuous hf (continuous_circle_map z R),
+    exact (λ _, (circle_map_mem_sphere _ hR.le) _) },
+end
+
+lemma continuous_circle_transform_deriv {R : ℝ} (hR : 0 < R) {f : ℂ → E} {z w : ℂ}
+  (hf : continuous_on f (sphere z R)) (hw : w ∈ ball z R) :
+  continuous (circle_transform_deriv R z w f) :=
+begin
+  rw circle_transform_deriv_eq,
+  exact (continuous_circle_map_inv hw).smul (continuous_circle_transform hR hf hw),
+end
+
+/--A useful bound for circle integrals (with complex codomain)-/
+def circle_transform_bounding_function (R : ℝ) (z : ℂ) (w : ℂ × ℝ) : ℂ :=
+circle_transform_deriv R z w.1 (λ x, 1) w.2
+
+lemma continuous_on_prod_circle_transform_function {R r : ℝ} (hr : r < R) {z : ℂ} :
+  continuous_on (λ w : ℂ × ℝ, ((circle_map z R w.snd - w.fst)⁻¹) ^ 2) (closed_ball z r ×ˢ univ) :=
+begin
+  simp_rw ←one_div,
+  apply_rules [continuous_on.pow, continuous_on.div, continuous_on_const],
+  refine ((continuous_circle_map z R).continuous_on.comp continuous_on_snd (λ _, and.right)).sub
+    (continuous_on_id.comp continuous_on_fst (λ _, and.left)),
+  simp only [mem_prod, ne.def, and_imp, prod.forall],
+  intros a b ha hb,
+  have ha2 : a ∈ ball z R, by {simp at *, linarith,},
+  exact (sub_ne_zero.2 (circle_map_ne_mem_ball ha2 b)),
+end
+
+lemma continuous_on_abs_circle_transform_bounding_function {R r : ℝ} (hr : r < R) (z : ℂ) :
+  continuous_on (abs ∘ (λ t, circle_transform_bounding_function R z t)) (closed_ball z r ×ˢ univ) :=
+begin
+  have : continuous_on (circle_transform_bounding_function R z) (closed_ball z r ×ˢ (⊤ : set ℝ)),
+  { apply_rules [continuous_on.smul, continuous_on_const],
+    simp only [deriv_circle_map],
+    have c := (continuous_circle_map 0 R).continuous_on,
+    apply_rules [continuous_on.mul, c.comp continuous_on_snd (λ _, and.right), continuous_on_const],
+    simp_rw ←inv_pow,
+    apply continuous_on_prod_circle_transform_function hr, },
+  refine continuous_abs.continuous_on.comp this _,
+  show maps_to _ _ (⊤ : set ℂ),
+  simp [maps_to],
+end
+
+lemma abs_circle_transform_bounding_function_le {R r : ℝ} (hr : r < R) (hr' : 0 ≤ r) (z : ℂ) :
+  ∃ x : closed_ball z r ×ˢ [0, 2 * π],
+  ∀ y : closed_ball z r ×ˢ [0, 2 * π],
+  abs (circle_transform_bounding_function R z y) ≤ abs (circle_transform_bounding_function R z x) :=
+begin
+  have cts := continuous_on_abs_circle_transform_bounding_function hr z,
+  have comp : is_compact (closed_ball z r ×ˢ [0, 2 * π]),
+  { apply_rules [is_compact.prod, proper_space.is_compact_closed_ball z r, is_compact_uIcc], },
+  have none : (closed_ball z r ×ˢ [0, 2 * π]).nonempty :=
+    (nonempty_closed_ball.2 hr').prod nonempty_uIcc,
+  have := is_compact.exists_forall_ge comp none (cts.mono
+    (by { intro z, simp only [mem_prod, mem_closed_ball, mem_univ, and_true, and_imp], tauto })),
+  simpa only [set_coe.forall, subtype.coe_mk, set_coe.exists],
+end
+
+/-- The derivative of a `circle_transform` is locally bounded. -/
+lemma circle_transform_deriv_bound {R : ℝ} (hR : 0 < R) {z x : ℂ} {f : ℂ → ℂ}
+  (hx : x ∈ ball z R) (hf : continuous_on f (sphere z R)) :
+  ∃ (B ε : ℝ), 0 < ε ∧ ball x ε ⊆ ball z R ∧
+  (∀ (t : ℝ) (y ∈ ball x ε), ‖circle_transform_deriv R z y f t‖ ≤ B) :=
+begin
+  obtain ⟨r, hr, hrx⟩ := exists_lt_mem_ball_of_mem_ball hx,
+  obtain ⟨ε', hε', H⟩ := exists_ball_subset_ball hrx,
+  obtain ⟨⟨⟨a, b⟩, ⟨ha, hb⟩⟩, hab⟩ := abs_circle_transform_bounding_function_le hr
+    (pos_of_mem_ball hrx).le z,
+  let V : ℝ → (ℂ → ℂ) := λ θ w, circle_transform_deriv R z w (λ x, 1) θ,
+  have funccomp : continuous_on (λ r , abs (f r)) (sphere z R),
+  by { have cabs : continuous_on abs ⊤ := by apply continuous_abs.continuous_on,
+    apply cabs.comp (hf), rw maps_to, tauto,},
+  have sbou := is_compact.exists_forall_ge (is_compact_sphere z R)
+    (normed_space.sphere_nonempty.2 hR.le) funccomp,
+  obtain ⟨X, HX, HX2⟩ := sbou,
+  refine ⟨abs (V b a) * abs (f X), ε' , hε', subset.trans H (ball_subset_ball hr.le), _ ⟩,
+  intros y v hv,
+  obtain ⟨y1, hy1, hfun⟩ := periodic.exists_mem_Ico₀
+    (circle_transform_deriv_periodic R z v f) real.two_pi_pos y,
+  have hy2: y1 ∈ [0, 2*π], by {convert (Ico_subset_Icc_self hy1),
+    simp [uIcc_of_le real.two_pi_pos.le]},
+  have := mul_le_mul (hab ⟨⟨v, y1⟩, ⟨ball_subset_closed_ball (H hv), hy2⟩⟩)
+   (HX2 (circle_map z R y1) (circle_map_mem_sphere z hR.le y1))
+   (complex.abs.nonneg _) (complex.abs.nonneg _),
+  simp_rw hfun,
+  simp only [circle_transform_bounding_function, circle_transform_deriv, V, norm_eq_abs,
+    algebra.id.smul_eq_mul, deriv_circle_map, map_mul, abs_circle_map_zero, abs_I, mul_one,
+    ←mul_assoc, mul_inv_rev, inv_I, abs_neg, abs_inv, abs_of_real, one_mul, abs_two, abs_pow,
+    mem_ball, gt_iff_lt, subtype.coe_mk, set_coe.forall, mem_prod, mem_closed_ball, and_imp,
+    prod.forall, normed_space.sphere_nonempty, mem_sphere_iff_norm] at *,
+  exact this,
+end
+
+end complex
diff --git a/src/measure_theory/integral/divergence_theorem.lean b/src/measure_theory/integral/divergence_theorem.lean
index 03385590b4f6f..5b52d7cf9ad36 100644
--- a/src/measure_theory/integral/divergence_theorem.lean
+++ b/src/measure_theory/integral/divergence_theorem.lean
@@ -5,12 +5,16 @@ Authors: Yury Kudryashov
 -/
 import analysis.box_integral.divergence_theorem
 import analysis.box_integral.integrability
+import analysis.calculus.deriv.basic
+import measure_theory.constructions.prod.integral
 import measure_theory.integral.interval_integral
-import data.set.intervals.monotone
 
 /-!
 # Divergence theorem for Bochner integral
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the Divergence theorem for Bochner integral on a box in
 `ℝⁿ⁺¹ = fin (n + 1) → ℝ`. More precisely, we prove the following theorem.
 
@@ -47,13 +51,13 @@ divergence theorem, Bochner integral
 -/
 
 open set finset topological_space function box_integral measure_theory filter
-open_locale big_operators classical topological_space interval
+open_locale big_operators classical topology interval
 
 universes u
 
 namespace measure_theory
 
-variables {E : Type u} [normed_group E] [normed_space ℝ E] [complete_space E]
+variables {E : Type u} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
 
 section
 variables {n : ℕ}
@@ -61,7 +65,7 @@ variables {n : ℕ}
 local notation `ℝⁿ` := fin n → ℝ
 local notation `ℝⁿ⁺¹` := fin (n + 1) → ℝ
 local notation `Eⁿ⁺¹` := fin (n + 1) → E
-local notation `e` i := pi.single i 1
+local notation `e ` i := pi.single i 1
 
 section
 
@@ -69,13 +73,13 @@ section
 ### Divergence theorem for functions on `ℝⁿ⁺¹ = fin (n + 1) → ℝ`.
 
 In this section we use the divergence theorem for a Henstock-Kurzweil-like integral
-`box_integral.has_integral_bot_divergence_of_forall_has_deriv_within_at` to prove the divergence
+`box_integral.has_integral_GP_divergence_of_forall_has_deriv_within_at` to prove the divergence
 theorem for Bochner integral. The divergence theorem for Bochner integral
 `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable` assumes that the function
 itself is continuous on a closed box, differentiable at all but countably many points of its
 interior, and the divergence is integrable on the box.
 
-This statement differs from `box_integral.has_integral_bot_divergence_of_forall_has_deriv_within_at`
+This statement differs from `box_integral.has_integral_GP_divergence_of_forall_has_deriv_within_at`
 in several aspects.
 
 * We use Bochner integral instead of a Henstock-Kurzweil integral. This modification is done in
@@ -93,10 +97,10 @@ in several aspects.
 
 /-- An auxiliary lemma for
 `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable`. This is exactly
-`box_integral.has_integral_bot_divergence_of_forall_has_deriv_within_at` reformulated for the
+`box_integral.has_integral_GP_divergence_of_forall_has_deriv_within_at` reformulated for the
 Bochner integral. -/
 lemma integral_divergence_of_has_fderiv_within_at_off_countable_aux₁ (I : box (fin (n + 1)))
-  (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : countable s)
+  (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : s.countable)
   (Hc : continuous_on f I.Icc) (Hd : ∀ x ∈ I.Icc \ s, has_fderiv_within_at f (f' x) I.Icc x)
   (Hi : integrable_on (λ x, ∑ i, f' x (e i) i) I.Icc) :
   ∫ x in I.Icc, ∑ i, f' x (e i) i =
@@ -106,7 +110,7 @@ lemma integral_divergence_of_has_fderiv_within_at_off_countable_aux₁ (I : box
 begin
   simp only [← set_integral_congr_set_ae (box.coe_ae_eq_Icc _)],
   have A := ((Hi.mono_set box.coe_subset_Icc).has_box_integral ⊥ rfl),
-  have B := has_integral_bot_divergence_of_forall_has_deriv_within_at I f f' (s ∩ I.Icc)
+  have B := has_integral_GP_divergence_of_forall_has_deriv_within_at I f f' (s ∩ I.Icc)
     (hs.mono (inter_subset_left _ _)) (λ x hx, Hc _ hx.2)
     (λ x hx, Hd _ ⟨hx.1, λ h, hx.2 ⟨h, hx.1⟩⟩),
   rw continuous_on_pi at Hc,
@@ -124,7 +128,7 @@ end
 `measure_theory.integral_divergence_of_has_fderiv_within_at_off_countable`. Compared to the previous
 lemma, here we drop the assumption of differentiability on the boundary of the box. -/
 lemma integral_divergence_of_has_fderiv_within_at_off_countable_aux₂ (I : box (fin (n + 1)))
-  (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : countable s)
+  (f : ℝⁿ⁺¹ → Eⁿ⁺¹) (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : s.countable)
   (Hc : continuous_on f I.Icc) (Hd : ∀ x ∈ I.Ioo \ s, has_fderiv_at f (f' x) x)
   (Hi : integrable_on (λ x, ∑ i, f' x (e i) i) I.Icc) :
   ∫ x in I.Icc, ∑ i, f' x (e i) i =
@@ -203,7 +207,7 @@ begin
     from box.le_iff_Icc.1 (box.face_mono (hJ_le _) i),
   rw [mem_closed_ball_zero_iff, real.norm_eq_abs, abs_of_nonneg dist_nonneg,
     dist_eq_norm, ← integral_sub (Hid.mono_set Hsub) ((Hic _).mono_set Hsub)],
-  calc ∥(∫ x in ((J k).face i).Icc, f (i.insert_nth d x) i - f (i.insert_nth (c k) x) i)∥
+  calc ‖(∫ x in ((J k).face i).Icc, f (i.insert_nth d x) i - f (i.insert_nth (c k) x) i)‖
       ≤ (ε / ∏ j, ((I.face i).upper j - (I.face i).lower j)) * (volume ((J k).face i).Icc).to_real :
     begin
       refine norm_set_integral_le_of_norm_le_const' (((J k).face i).measure_Icc_lt_top _)
@@ -230,9 +234,9 @@ end
 
 variables (a b : ℝⁿ⁺¹)
 
-local notation `face` i := set.Icc (a ∘ fin.succ_above i) (b ∘ fin.succ_above i)
-local notation `front_face` i:2000 := fin.insert_nth i (b i)
-local notation `back_face` i:2000 := fin.insert_nth i (a i)
+local notation `face ` i := set.Icc (a ∘ fin.succ_above i) (b ∘ fin.succ_above i)
+local notation `front_face ` i:2000 := fin.insert_nth i (b i)
+local notation `back_face ` i:2000 := fin.insert_nth i (a i)
 
 /-- **Divergence theorem** for Bochner integral. If `f : ℝⁿ⁺¹ → Eⁿ⁺¹` is continuous on a rectangular
 box `[a, b] : set ℝⁿ⁺¹`, `a ≤ b`, is differentiable on its interior with derivative
@@ -250,7 +254,7 @@ of `f : ℝⁿ⁺¹ → Eⁿ⁺¹` to these faces are given by `f ∘ back_face
 `back_face i = fin.insert_nth i (a i)` and `front_face i = fin.insert_nth i (b i)` are embeddings
 `ℝⁿ → ℝⁿ⁺¹` that take `y : ℝⁿ` and insert `a i` (resp., `b i`) as `i`-th coordinate. -/
 lemma integral_divergence_of_has_fderiv_within_at_off_countable (hle : a ≤ b) (f : ℝⁿ⁺¹ → Eⁿ⁺¹)
-  (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : countable s) (Hc : continuous_on f (Icc a b))
+  (f' : ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] Eⁿ⁺¹) (s : set ℝⁿ⁺¹) (hs : s.countable) (Hc : continuous_on f (Icc a b))
   (Hd : ∀ x ∈ set.pi univ (λ i, Ioo (a i) (b i)) \ s, has_fderiv_at f (f' x) x)
   (Hi : integrable_on (λ x, ∑ i, f' x (e i) i) (Icc a b)) :
   ∫ x in Icc a b, ∑ i, f' x (e i) i =
@@ -281,7 +285,7 @@ end
 in terms of a vector-valued function `f : ℝⁿ⁺¹ → Eⁿ⁺¹`. -/
 lemma integral_divergence_of_has_fderiv_within_at_off_countable' (hle : a ≤ b)
   (f : fin (n + 1) → ℝⁿ⁺¹ → E) (f' : fin (n + 1) → ℝⁿ⁺¹ → ℝⁿ⁺¹ →L[ℝ] E)
-  (s : set ℝⁿ⁺¹) (hs : countable s) (Hc : ∀ i, continuous_on (f i) (Icc a b))
+  (s : set ℝⁿ⁺¹) (hs : s.countable) (Hc : ∀ i, continuous_on (f i) (Icc a b))
   (Hd : ∀ (x ∈ pi set.univ (λ i, Ioo (a i) (b i)) \ s) i, has_fderiv_at (f i) (f' i x) x)
   (Hi : integrable_on (λ x, ∑ i, f' i x (e i)) (Icc a b)) :
   ∫ x in Icc a b, ∑ i, f' i x (e i) =
@@ -296,10 +300,10 @@ end
 /-- An auxiliary lemma that is used to specialize the general divergence theorem to spaces that do
 not have the form `fin n → ℝ`. -/
 lemma integral_divergence_of_has_fderiv_within_at_off_countable_of_equiv
-  {F : Type*} [normed_group F] [normed_space ℝ F] [partial_order F] [measure_space F]
+  {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] [partial_order F] [measure_space F]
   [borel_space F] (eL : F ≃L[ℝ] ℝⁿ⁺¹) (he_ord : ∀ x y, eL x ≤ eL y ↔ x ≤ y)
   (he_vol : measure_preserving eL volume volume) (f : fin (n + 1) → F → E)
-  (f' : fin (n + 1) → F → F →L[ℝ] E) (s : set F) (hs : countable s)
+  (f' : fin (n + 1) → F → F →L[ℝ] E) (s : set F) (hs : s.countable)
   (a b : F) (hle : a ≤ b) (Hc : ∀ i, continuous_on (f i) (Icc a b))
   (Hd : ∀ (x ∈ interior (Icc a b) \ s) i, has_fderiv_at (f i) (f' i x) x)
   (DF : F → E) (hDF : ∀ x, DF x = ∑ i, f' i x (eL.symm $ e i)) (Hi : integrable_on DF (Icc a b)) :
@@ -332,9 +336,8 @@ calc ∫ x in Icc a b, DF x = ∫ x in Icc a b, ∑ i, f' i x (eL.symm $ e i) :
     { refine λ x hx i, (Hd (eL.symm x) ⟨_, hx.2⟩ i).comp x eL.symm.has_fderiv_at,
       rw ← hIcc,
       refine preimage_interior_subset_interior_preimage eL.continuous _,
-      simp only [set.mem_preimage, eL.apply_symm_apply, ← pi_univ_Icc,
-        interior_pi_set (finite.of_fintype _), interior_Icc],
-      exact hx.1 },
+      simpa only [set.mem_preimage, eL.apply_symm_apply, ← pi_univ_Icc, interior_pi_set finite_univ,
+        interior_Icc] using hx.1 },
     { rw [← he_vol.integrable_on_comp_preimage he_emb, hIcc],
       simp [← hDF, (∘), Hi] }
   end
@@ -360,7 +363,7 @@ differentiability of `f`;
 * `measure_theory.integral_eq_of_has_deriv_within_at_off_countable` for a version that works both
   for `a ≤ b` and `b ≤ a` at the expense of using unordered intervals instead of `set.Icc`. -/
 theorem integral_eq_of_has_deriv_within_at_off_countable_of_le (f f' : ℝ → E)
-  {a b : ℝ} (hle : a ≤ b) {s : set ℝ} (hs : countable s)
+  {a b : ℝ} (hle : a ≤ b) {s : set ℝ} (hs : s.countable)
   (Hc : continuous_on f (Icc a b)) (Hd : ∀ x ∈ Ioo a b \ s, has_deriv_at f (f' x) x)
   (Hi : interval_integrable f' volume a b) :
   ∫ x in a..b, f' x = f b - f a :=
@@ -400,16 +403,16 @@ See also `measure_theory.interval_integral.integral_eq_sub_of_has_deriv_right` f
 only assumes right differentiability of `f`.
 -/
 theorem integral_eq_of_has_deriv_within_at_off_countable (f f' : ℝ → E) {a b : ℝ} {s : set ℝ}
-  (hs : countable s) (Hc : continuous_on f [a, b])
+  (hs : s.countable) (Hc : continuous_on f [a, b])
   (Hd : ∀ x ∈ Ioo (min a b) (max a b) \ s, has_deriv_at f (f' x) x)
   (Hi : interval_integrable f' volume a b) :
   ∫ x in a..b, f' x = f b - f a :=
 begin
   cases le_total a b with hab hab,
-  { simp only [interval_of_le hab, min_eq_left hab, max_eq_right hab] at *,
+  { simp only [uIcc_of_le hab, min_eq_left hab, max_eq_right hab] at *,
     exact integral_eq_of_has_deriv_within_at_off_countable_of_le f f' hab hs Hc Hd Hi },
-  { simp only [interval_of_ge hab, min_eq_right hab, max_eq_left hab] at *,
-    rw [interval_integral.integral_symm, neg_eq_iff_neg_eq, neg_sub, eq_comm],
+  { simp only [uIcc_of_ge hab, min_eq_right hab, max_eq_left hab] at *,
+    rw [interval_integral.integral_symm, neg_eq_iff_eq_neg, neg_sub],
     exact integral_eq_of_has_deriv_within_at_off_countable_of_le f f' hab hs Hc Hd Hi.symm }
 end
 
@@ -424,7 +427,7 @@ See also `measure_theory.integral2_divergence_prod_of_has_fderiv_within_at_off_c
 version that does not assume `a ≤ b` and uses iterated interval integral instead of the integral
 over `Icc a b`. -/
 lemma integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le (f g : ℝ × ℝ → E)
-  (f' g' : ℝ × ℝ → ℝ × ℝ →L[ℝ] E) (a b : ℝ × ℝ) (hle : a ≤ b) (s : set (ℝ × ℝ)) (hs : countable s)
+  (f' g' : ℝ × ℝ → ℝ × ℝ →L[ℝ] E) (a b : ℝ × ℝ) (hle : a ≤ b) (s : set (ℝ × ℝ)) (hs : s.countable)
   (Hcf : continuous_on f (Icc a b)) (Hcg : continuous_on g (Icc a b))
   (Hdf : ∀ x ∈ Ioo a.1 b.1 ×ˢ Ioo a.2 b.2 \ s, has_fderiv_at f (f' x) x)
   (Hdg : ∀ x ∈ Ioo a.1 b.1 ×ˢ Ioo a.2 b.2 \ s, has_fderiv_at g (g' x) x)
@@ -477,7 +480,7 @@ the normal derivative of `F` along the boundary.
 See also `measure_theory.integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le`
 for a version that uses an integral over `Icc a b`, where `a b : ℝ × ℝ`, `a ≤ b`. -/
 lemma integral2_divergence_prod_of_has_fderiv_within_at_off_countable (f g : ℝ × ℝ → E)
-  (f' g' : ℝ × ℝ → ℝ × ℝ →L[ℝ] E) (a₁ a₂ b₁ b₂ : ℝ) (s : set (ℝ × ℝ)) (hs : countable s)
+  (f' g' : ℝ × ℝ → ℝ × ℝ →L[ℝ] E) (a₁ a₂ b₁ b₂ : ℝ) (s : set (ℝ × ℝ)) (hs : s.countable)
   (Hcf : continuous_on f ([a₁, b₁] ×ˢ [a₂, b₂])) (Hcg : continuous_on g ([a₁, b₁] ×ˢ [a₂, b₂]))
   (Hdf : ∀ x ∈ Ioo (min a₁ b₁) (max a₁ b₁) ×ˢ Ioo (min a₂ b₂) (max a₂ b₂) \ s,
     has_fderiv_at f (f' x) x)
@@ -488,31 +491,31 @@ lemma integral2_divergence_prod_of_has_fderiv_within_at_off_countable (f g : ℝ
     (∫ x in a₁..b₁, g (x, b₂)) - (∫ x in a₁..b₁, g (x, a₂)) +
       (∫ y in a₂..b₂, f (b₁, y)) - ∫ y in a₂..b₂, f (a₁, y) :=
 begin
-  wlog h₁ : a₁ ≤ b₁ := le_total a₁ b₁ using [a₁ b₁, b₁ a₁] tactic.skip,
-  wlog h₂ : a₂ ≤ b₂ := le_total a₂ b₂ using [a₂ b₂, b₂ a₂] tactic.skip,
-  { simp only [interval_of_le h₁, interval_of_le h₂, min_eq_left, max_eq_right, h₁, h₂]
-      at Hcf Hcg Hdf Hdg Hi,
-    calc ∫ x in a₁..b₁, ∫ y in a₂..b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1)
-        = ∫ x in Icc a₁ b₁, ∫ y in Icc a₂ b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1) :
-      by simp only [interval_integral.integral_of_le, h₁, h₂,
-        set_integral_congr_set_ae Ioc_ae_eq_Icc]
-    ... = ∫ x in Icc a₁ b₁ ×ˢ Icc a₂ b₂, f' x (1, 0) + g' x (0, 1) :
-      (set_integral_prod _ Hi).symm
-    ... = (∫ x in a₁..b₁, g (x, b₂)) - (∫ x in a₁..b₁, g (x, a₂)) +
-            (∫ y in a₂..b₂, f (b₁, y)) - ∫ y in a₂..b₂, f (a₁, y) :
-      begin
-        rw Icc_prod_Icc at *,
-        apply integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le f g f' g'
-          (a₁, a₂) (b₁, b₂) ⟨h₁, h₂⟩ s; assumption
-      end },
-  { rw [interval_swap b₂ a₂, min_comm b₂ a₂, max_comm b₂ a₂] at this,
-    intros Hcf Hcg Hdf Hdg Hi,
-    simp only [interval_integral.integral_symm b₂ a₂, interval_integral.integral_neg],
-    refine (congr_arg has_neg.neg (this Hcf Hcg Hdf Hdg Hi)).trans _, abel },
-  { rw [interval_swap b₁ a₁, min_comm b₁ a₁, max_comm b₁ a₁] at this,
-    intros Hcf Hcg Hdf Hdg Hi,
+  wlog h₁ : a₁ ≤ b₁ generalizing a₁ b₁,
+  { specialize this b₁ a₁,
+    rw [uIcc_comm b₁ a₁, min_comm b₁ a₁, max_comm b₁ a₁] at this,
     simp only [interval_integral.integral_symm b₁ a₁],
-    refine (congr_arg has_neg.neg (this Hcf Hcg Hdf Hdg Hi)).trans _, abel }
+    refine (congr_arg has_neg.neg (this Hcf Hcg Hdf Hdg Hi (le_of_not_le h₁))).trans _, abel },
+  wlog h₂ : a₂ ≤ b₂ generalizing a₂ b₂,
+  { specialize this b₂ a₂,
+    rw [uIcc_comm b₂ a₂, min_comm b₂ a₂, max_comm b₂ a₂] at this,
+    simp only [interval_integral.integral_symm b₂ a₂, interval_integral.integral_neg],
+    refine (congr_arg has_neg.neg (this Hcf Hcg Hdf Hdg Hi (le_of_not_le h₂))).trans _, abel },
+  simp only [uIcc_of_le h₁, uIcc_of_le h₂, min_eq_left, max_eq_right, h₁, h₂]
+    at Hcf Hcg Hdf Hdg Hi,
+  calc ∫ x in a₁..b₁, ∫ y in a₂..b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1)
+      = ∫ x in Icc a₁ b₁, ∫ y in Icc a₂ b₂, f' (x, y) (1, 0) + g' (x, y) (0, 1) :
+    by simp only [interval_integral.integral_of_le, h₁, h₂,
+      set_integral_congr_set_ae Ioc_ae_eq_Icc]
+  ... = ∫ x in Icc a₁ b₁ ×ˢ Icc a₂ b₂, f' x (1, 0) + g' x (0, 1) :
+    (set_integral_prod _ Hi).symm
+  ... = (∫ x in a₁..b₁, g (x, b₂)) - (∫ x in a₁..b₁, g (x, a₂)) +
+          (∫ y in a₂..b₂, f (b₁, y)) - ∫ y in a₂..b₂, f (a₁, y) :
+    begin
+      rw Icc_prod_Icc at *,
+      apply integral_divergence_prod_Icc_of_has_fderiv_within_at_off_countable_of_le f g f' g'
+        (a₁, a₂) (b₁, b₂) ⟨h₁, h₂⟩ s; assumption
+    end
 end
 
 end measure_theory
diff --git a/src/measure_theory/integral/exp_decay.lean b/src/measure_theory/integral/exp_decay.lean
index 87843c8693b17..aaf1b899783dd 100644
--- a/src/measure_theory/integral/exp_decay.lean
+++ b/src/measure_theory/integral/exp_decay.lean
@@ -4,13 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: David Loeffler
 -/
 import measure_theory.integral.interval_integral
-import analysis.special_functions.exponential
-import analysis.special_functions.integrals
 import measure_theory.integral.integral_eq_improper
 
 /-!
 # Integrals with exponential decay at ∞
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 As easy special cases of general theorems in the library, we prove the following test
 for integrability:
 
@@ -20,39 +21,23 @@ for integrability:
 
 noncomputable theory
 open real interval_integral measure_theory set filter
-
-/-- Integral of `exp (-b * x)` over `(a, X)` is bounded as `X → ∞`. -/
-lemma integral_exp_neg_le {b : ℝ} (a X : ℝ) (h2 : 0 < b) :
-  (∫ x in a .. X, exp (-b * x)) ≤ exp (-b * a) / b :=
-begin
-  rw integral_deriv_eq_sub' (λ x, -exp (-b * x) / b),
-  -- goal 1/4: F(X) - F(a) is bounded
-  { simp only [tsub_le_iff_right],
-    rw [neg_div b (exp (-b * a)), neg_div b (exp (-b * X)), add_neg_self, neg_le, neg_zero],
-    exact (div_pos (exp_pos _) h2).le, },
-  -- goal 2/4: the derivative of F is exp(-b x)
-  { ext1, simp [h2.ne'] },
-  -- goal 3/4: F is differentiable
-  { intros x hx, simp [h2.ne'], },
-  -- goal 4/4: exp(-b x) is continuous
-  { apply continuous.continuous_on, continuity }
-end
+open_locale topology
 
 /-- `exp (-b * x)` is integrable on `(a, ∞)`. -/
 lemma exp_neg_integrable_on_Ioi (a : ℝ) {b : ℝ} (h : 0 < b) :
   integrable_on (λ x : ℝ, exp (-b * x)) (Ioi a) :=
 begin
-  have : ∀ (X : ℝ), integrable_on (λ x : ℝ, exp (-b * x) ) (Ioc a X),
-  { intro X, exact (continuous_const.mul continuous_id).exp.integrable_on_Ioc },
-  apply (integrable_on_Ioi_of_interval_integral_norm_bounded (exp (-b * a) / b) a this tendsto_id),
-  simp only [eventually_at_top, norm_of_nonneg (exp_pos _).le],
-  exact ⟨a, λ b2 hb2, integral_exp_neg_le a b2 h⟩,
+  have : tendsto (λ x, -exp (-b * x) / b) at_top (𝓝 (-0/b)),
+  { refine tendsto.div_const (tendsto.neg _) _,
+    exact tendsto_exp_at_bot.comp (tendsto_id.neg_const_mul_at_top (right.neg_neg_iff.2 h)) },
+  refine integrable_on_Ioi_deriv_of_nonneg' (λ x hx, _) (λ x hx, (exp_pos _).le) this,
+  simpa [h.ne'] using ((has_deriv_at_id x).const_mul b).neg.exp.neg.div_const b,
 end
 
 /-- If `f` is continuous on `[a, ∞)`, and is `O (exp (-b * x))` at `∞` for some `b > 0`, then
 `f` is integrable on `(a, ∞)`. -/
 lemma integrable_of_is_O_exp_neg {f : ℝ → ℝ} {a b : ℝ} (h0 : 0 < b)
-  (h1 : continuous_on f (Ici a)) (h2 : asymptotics.is_O f (λ x, exp (-b * x)) at_top) :
+  (h1 : continuous_on f (Ici a)) (h2 : f =O[at_top] (λ x, exp (-b * x))) :
   integrable_on f (Ioi a) :=
 begin
   cases h2.is_O_with with c h3,
diff --git a/src/measure_theory/integral/fund_thm_calculus.lean b/src/measure_theory/integral/fund_thm_calculus.lean
new file mode 100644
index 0000000000000..5395634b24f97
--- /dev/null
+++ b/src/measure_theory/integral/fund_thm_calculus.lean
@@ -0,0 +1,1492 @@
+/-
+Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury G. Kudryashov, Patrick Massot, Sébastien Gouëzel
+-/
+import analysis.calculus.fderiv_measurable
+import analysis.calculus.deriv.comp
+import analysis.calculus.deriv.add
+import analysis.calculus.deriv.slope
+import analysis.calculus.deriv.mul
+import analysis.normed_space.dual
+import measure_theory.integral.interval_integral
+import measure_theory.integral.vitali_caratheodory
+
+/-!
+# Fundamental Theorem of Calculus
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We prove various versions of the
+[fundamental theorem of calculus](https://en.wikipedia.org/wiki/Fundamental_theorem_of_calculus)
+for interval integrals in `ℝ`.
+
+Recall that its first version states that the function `(u, v) ↦ ∫ x in u..v, f x` has derivative
+`(δu, δv) ↦ δv • f b - δu • f a` at `(a, b)` provided that `f` is continuous at `a` and `b`,
+and its second version states that, if `f` has an integrable derivative on `[a, b]`, then
+`∫ x in a..b, f' x = f b - f a`.
+
+## Main statements
+
+### FTC-1 for Lebesgue measure
+
+We prove several versions of FTC-1, all in the `interval_integral` namespace. Many of them follow
+the naming scheme `integral_has(_strict?)_(f?)deriv(_within?)_at(_of_tendsto_ae?)(_right|_left?)`.
+They formulate FTC in terms of `has(_strict?)_(f?)deriv(_within?)_at`.
+Let us explain the meaning of each part of the name:
+
+* `_strict` means that the theorem is about strict differentiability;
+* `f` means that the theorem is about differentiability in both endpoints; incompatible with
+  `_right|_left`;
+* `_within` means that the theorem is about one-sided derivatives, see below for details;
+* `_of_tendsto_ae` means that instead of continuity the theorem assumes that `f` has a finite limit
+  almost surely as `x` tends to `a` and/or `b`;
+* `_right` or `_left` mean that the theorem is about differentiability in the right (resp., left)
+  endpoint.
+
+We also reformulate these theorems in terms of `(f?)deriv(_within?)`. These theorems are named
+`(f?)deriv(_within?)_integral(_of_tendsto_ae?)(_right|_left?)` with the same meaning of parts of the
+name.
+
+### One-sided derivatives
+
+Theorem `integral_has_fderiv_within_at_of_tendsto_ae` states that `(u, v) ↦ ∫ x in u..v, f x` has a
+derivative `(δu, δv) ↦ δv • cb - δu • ca` within the set `s × t` at `(a, b)` provided that `f` tends
+to `ca` (resp., `cb`) almost surely at `la` (resp., `lb`), where possible values of `s`, `t`, and
+corresponding filters `la`, `lb` are given in the following table.
+
+| `s`     | `la`     | `t`     | `lb`     |
+| ------- | ----     | ---     | ----     |
+| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
+| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
+| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
+| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
+
+We use a typeclass `FTC_filter` to make Lean automatically find `la`/`lb` based on `s`/`t`. This way
+we can formulate one theorem instead of `16` (or `8` if we leave only non-trivial ones not covered
+by `integral_has_deriv_within_at_of_tendsto_ae_(left|right)` and
+`integral_has_fderiv_at_of_tendsto_ae`). Similarly,
+`integral_has_deriv_within_at_of_tendsto_ae_right` works for both one-sided derivatives using the
+same typeclass to find an appropriate filter.
+
+### FTC for a locally finite measure
+
+Before proving FTC for the Lebesgue measure, we prove a few statements that can be seen as FTC for
+any measure. The most general of them,
+`measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae`, states the following. Let `(la, la')`
+be an `FTC_filter` pair of filters around `a` (i.e., `FTC_filter a la la'`) and let `(lb, lb')` be
+an `FTC_filter` pair of filters around `b`. If `f` has finite limits `ca` and `cb` almost surely at
+`la'` and `lb'`, respectively, then
+`∫ x in va..vb, f x ∂μ - ∫ x in ua..ub, f x ∂μ = ∫ x in ub..vb, cb ∂μ - ∫ x in ua..va, ca ∂μ +
+  o(‖∫ x in ua..va, (1:ℝ) ∂μ‖ + ‖∫ x in ub..vb, (1:ℝ) ∂μ‖)` as `ua` and `va` tend to `la` while
+`ub` and `vb` tend to `lb`.
+
+### FTC-2 and corollaries
+
+We use FTC-1 to prove several versions of FTC-2 for the Lebesgue measure, using a similar naming
+scheme as for the versions of FTC-1. They include:
+* `interval_integral.integral_eq_sub_of_has_deriv_right_of_le` - most general version, for functions
+  with a right derivative
+* `interval_integral.integral_eq_sub_of_has_deriv_at'` - version for functions with a derivative on
+  an open set
+* `interval_integral.integral_deriv_eq_sub'` - version that is easiest to use when computing the
+  integral of a specific function
+
+We then derive additional integration techniques from FTC-2:
+* `interval_integral.integral_mul_deriv_eq_deriv_mul` - integration by parts
+* `interval_integral.integral_comp_mul_deriv''` - integration by substitution
+
+Many applications of these theorems can be found in the file `analysis.special_functions.integrals`.
+
+Note that the assumptions of FTC-2 are formulated in the form that `f'` is integrable. To use it in
+a context with the stronger assumption that `f'` is continuous, one can use
+`continuous_on.interval_integrable` or `continuous_on.integrable_on_Icc` or
+`continuous_on.integrable_on_interval`.
+
+### `FTC_filter` class
+
+As explained above, many theorems in this file rely on the typeclass
+`FTC_filter (a : ℝ) (l l' : filter ℝ)` to avoid code duplication. This typeclass combines four
+assumptions:
+
+- `pure a ≤ l`;
+- `l' ≤ 𝓝 a`;
+- `l'` has a basis of measurable sets;
+- if `u n` and `v n` tend to `l`, then for any `s ∈ l'`, `Ioc (u n) (v n)` is eventually included
+  in `s`.
+
+This typeclass has the following “real” instances: `(a, pure a, ⊥)`, `(a, 𝓝[≥] a, 𝓝[>] a)`,
+`(a, 𝓝[≤] a, 𝓝[≤] a)`, `(a, 𝓝 a, 𝓝 a)`.
+Furthermore, we have the following instances that are equal to the previously mentioned instances:
+`(a, 𝓝[{a}] a, ⊥)` and `(a, 𝓝[univ] a, 𝓝[univ] a)`.
+While the difference between `Ici a` and `Ioi a` doesn't matter for theorems about Lebesgue measure,
+it becomes important in the versions of FTC about any locally finite measure if this measure has an
+atom at one of the endpoints.
+
+### Combining one-sided and two-sided derivatives
+
+There are some `FTC_filter` instances where the fact that it is one-sided or
+two-sided depends on the point, namely `(x, 𝓝[Icc a b] x, 𝓝[Icc a b] x)`
+(resp. `(x, 𝓝[[a, b]] x, 𝓝[[a, b]] x)`, where `[a, b] = set.uIcc a b`),
+with `x ∈ Icc a b` (resp. `x ∈ [a, b]`).
+This results in a two-sided derivatives for `x ∈ Ioo a b` and one-sided derivatives for
+`x ∈ {a, b}`. Other instances could be added when needed (in that case, one also needs to add
+instances for `filter.is_measurably_generated` and `filter.tendsto_Ixx_class`).
+
+## Tags
+
+integral, fundamental theorem of calculus, FTC-1, FTC-2, change of variables in integrals
+-/
+
+noncomputable theory
+open topological_space (second_countable_topology)
+open measure_theory set classical filter function
+
+open_locale classical topology filter ennreal big_operators interval nnreal
+
+variables {ι 𝕜 E F A : Type*} [normed_add_comm_group E]
+  [complete_space E] [normed_space ℝ E]
+
+namespace interval_integral
+
+/-!
+### Fundamental theorem of calculus, part 1, for any measure
+
+In this section we prove a few lemmas that can be seen as versions of FTC-1 for interval integrals
+w.r.t. any measure. Many theorems are formulated for one or two pairs of filters related by
+`FTC_filter a l l'`. This typeclass has exactly four “real” instances: `(a, pure a, ⊥)`,
+`(a, 𝓝[≥] a, 𝓝[>] a)`, `(a, 𝓝[≤] a, 𝓝[≤] a)`, `(a, 𝓝 a, 𝓝 a)`, and two instances
+that are equal to the first and last “real” instances: `(a, 𝓝[{a}] a, ⊥)` and
+`(a, 𝓝[univ] a, 𝓝[univ] a)`.  We use this approach to avoid repeating arguments in many very similar
+cases.  Lean can automatically find both `a` and `l'` based on `l`.
+
+The most general theorem `measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae` can be seen
+as a generalization of lemma `integral_has_strict_fderiv_at` below which states strict
+differentiability of `∫ x in u..v, f x` in `(u, v)` at `(a, b)` for a measurable function `f` that
+is integrable on `a..b` and is continuous at `a` and `b`. The lemma is generalized in three
+directions: first, `measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae` deals with any
+locally finite measure `μ`; second, it works for one-sided limits/derivatives; third, it assumes
+only that `f` has finite limits almost surely at `a` and `b`.
+
+Namely, let `f` be a measurable function integrable on `a..b`. Let `(la, la')` be a pair of
+`FTC_filter`s around `a`; let `(lb, lb')` be a pair of `FTC_filter`s around `b`. Suppose that `f`
+has finite limits `ca` and `cb` at `la' ⊓ μ.ae` and `lb' ⊓ μ.ae`, respectively.  Then
+`∫ x in va..vb, f x ∂μ - ∫ x in ua..ub, f x ∂μ = ∫ x in ub..vb, cb ∂μ - ∫ x in ua..va, ca ∂μ +
+  o(‖∫ x in ua..va, (1:ℝ) ∂μ‖ + ‖∫ x in ub..vb, (1:ℝ) ∂μ‖)`
+as `ua` and `va` tend to `la` while `ub` and `vb` tend to `lb`.
+
+This theorem is formulated with integral of constants instead of measures in the right hand sides
+for two reasons: first, this way we avoid `min`/`max` in the statements; second, often it is
+possible to write better `simp` lemmas for these integrals, see `integral_const` and
+`integral_const_of_cdf`.
+
+In the next subsection we apply this theorem to prove various theorems about differentiability
+of the integral w.r.t. Lebesgue measure. -/
+
+/-- An auxiliary typeclass for the Fundamental theorem of calculus, part 1. It is used to formulate
+theorems that work simultaneously for left and right one-sided derivatives of `∫ x in u..v, f x`. -/
+class FTC_filter (a : out_param ℝ) (outer : filter ℝ) (inner : out_param $ filter ℝ)
+  extends tendsto_Ixx_class Ioc outer inner : Prop :=
+(pure_le : pure a ≤ outer)
+(le_nhds : inner ≤ 𝓝 a)
+[meas_gen : is_measurably_generated inner]
+
+/- The `dangerous_instance` linter doesn't take `out_param`s into account, so it thinks that
+`FTC_filter.to_tendsto_Ixx_class` is dangerous. Disable this linter using `nolint`.
+-/
+attribute [nolint dangerous_instance] FTC_filter.to_tendsto_Ixx_class
+
+namespace FTC_filter
+
+instance pure (a : ℝ) : FTC_filter a (pure a) ⊥ :=
+{ pure_le := le_rfl,
+  le_nhds := bot_le }
+
+instance nhds_within_singleton (a : ℝ) : FTC_filter a (𝓝[{a}] a) ⊥ :=
+by { rw [nhds_within, principal_singleton, inf_eq_right.2 (pure_le_nhds a)], apply_instance }
+
+lemma finite_at_inner {a : ℝ} (l : filter ℝ) {l'} [h : FTC_filter a l l']
+  {μ : measure ℝ} [is_locally_finite_measure μ] :
+  μ.finite_at_filter l' :=
+(μ.finite_at_nhds a).filter_mono h.le_nhds
+
+instance nhds (a : ℝ) : FTC_filter a (𝓝 a) (𝓝 a) :=
+{ pure_le := pure_le_nhds a,
+  le_nhds := le_rfl }
+
+instance nhds_univ (a : ℝ) : FTC_filter a (𝓝[univ] a) (𝓝 a) :=
+by { rw nhds_within_univ, apply_instance }
+
+instance nhds_left (a : ℝ) : FTC_filter a (𝓝[≤] a) (𝓝[≤] a) :=
+{ pure_le := pure_le_nhds_within right_mem_Iic,
+  le_nhds := inf_le_left }
+
+instance nhds_right (a : ℝ) : FTC_filter a (𝓝[≥] a) (𝓝[>] a) :=
+{ pure_le := pure_le_nhds_within left_mem_Ici,
+  le_nhds := inf_le_left }
+
+instance nhds_Icc {x a b : ℝ} [h : fact (x ∈ Icc a b)] :
+  FTC_filter x (𝓝[Icc a b] x) (𝓝[Icc a b] x) :=
+{ pure_le := pure_le_nhds_within h.out,
+  le_nhds := inf_le_left }
+
+instance nhds_uIcc {x a b : ℝ} [h : fact (x ∈ [a, b])] :
+  FTC_filter x (𝓝[[a, b]] x) (𝓝[[a, b]] x) :=
+by { haveI : fact (x ∈ set.Icc (min a b) (max a b)) := h, exact FTC_filter.nhds_Icc }
+
+end FTC_filter
+
+open asymptotics
+
+section
+
+variables {f : ℝ → E} {a b : ℝ} {c ca cb : E} {l l' la la' lb lb' : filter ℝ} {lt : filter ι}
+  {μ : measure ℝ} {u v ua va ub vb : ι → ℝ}
+
+/-- Fundamental theorem of calculus-1, local version for any measure.
+Let filters `l` and `l'` be related by `tendsto_Ixx_class Ioc`.
+If `f` has a finite limit `c` at `l' ⊓ μ.ae`, where `μ` is a measure
+finite at `l'`, then `∫ x in u..v, f x ∂μ = ∫ x in u..v, c ∂μ + o(∫ x in u..v, 1 ∂μ)` as both
+`u` and `v` tend to `l`.
+
+See also `measure_integral_sub_linear_is_o_of_tendsto_ae` for a version assuming
+`[FTC_filter a l l']` and `[is_locally_finite_measure μ]`. If `l` is one of `𝓝[≥] a`,
+`𝓝[≤] a`, `𝓝 a`, then it's easier to apply the non-primed version.
+The primed version also works, e.g., for `l = l' = at_top`.
+
+We use integrals of constants instead of measures because this way it is easier to formulate
+a statement that works in both cases `u ≤ v` and `v ≤ u`. -/
+lemma measure_integral_sub_linear_is_o_of_tendsto_ae'
+  [is_measurably_generated l'] [tendsto_Ixx_class Ioc l l']
+  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
+  (hl : μ.finite_at_filter l')
+  (hu : tendsto u lt l) (hv : tendsto v lt l) :
+  (λ t, ∫ x in u t..v t, f x ∂μ - ∫ x in u t..v t, c ∂μ) =o[lt] (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) :=
+begin
+  have A := hf.integral_sub_linear_is_o_ae hfm hl (hu.Ioc hv),
+  have B := hf.integral_sub_linear_is_o_ae hfm hl (hv.Ioc hu),
+  simp only [integral_const'],
+  convert (A.trans_le _).sub (B.trans_le _),
+  { ext t,
+    simp_rw [interval_integral, sub_smul],
+    abel },
+  all_goals { intro t, cases le_total (u t) (v t) with huv huv; simp [huv] }
+end
+
+/-- Fundamental theorem of calculus-1, local version for any measure.
+Let filters `l` and `l'` be related by `tendsto_Ixx_class Ioc`.
+If `f` has a finite limit `c` at `l ⊓ μ.ae`, where `μ` is a measure
+finite at `l`, then `∫ x in u..v, f x ∂μ = μ (Ioc u v) • c + o(μ(Ioc u v))` as both
+`u` and `v` tend to `l` so that `u ≤ v`.
+
+See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_le` for a version assuming
+`[FTC_filter a l l']` and `[is_locally_finite_measure μ]`. If `l` is one of `𝓝[≥] a`,
+`𝓝[≤] a`, `𝓝 a`, then it's easier to apply the non-primed version.
+The primed version also works, e.g., for `l = l' = at_top`. -/
+lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_le'
+  [is_measurably_generated l'] [tendsto_Ixx_class Ioc l l']
+  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
+  (hl : μ.finite_at_filter l') (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : u ≤ᶠ[lt] v) :
+  (λ t, ∫ x in u t..v t, f x ∂μ - (μ (Ioc (u t) (v t))).to_real • c) =o[lt]
+    (λ t, (μ $ Ioc (u t) (v t)).to_real) :=
+(measure_integral_sub_linear_is_o_of_tendsto_ae' hfm hf hl hu hv).congr'
+  (huv.mono $ λ x hx, by simp [integral_const', hx])
+  (huv.mono $ λ x hx, by simp [integral_const', hx])
+
+/-- Fundamental theorem of calculus-1, local version for any measure.
+Let filters `l` and `l'` be related by `tendsto_Ixx_class Ioc`.
+If `f` has a finite limit `c` at `l ⊓ μ.ae`, where `μ` is a measure
+finite at `l`, then `∫ x in u..v, f x ∂μ = -μ (Ioc v u) • c + o(μ(Ioc v u))` as both
+`u` and `v` tend to `l` so that `v ≤ u`.
+
+See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge` for a version assuming
+`[FTC_filter a l l']` and `[is_locally_finite_measure μ]`. If `l` is one of `𝓝[≥] a`,
+`𝓝[≤] a`, `𝓝 a`, then it's easier to apply the non-primed version.
+The primed version also works, e.g., for `l = l' = at_top`. -/
+lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge'
+  [is_measurably_generated l'] [tendsto_Ixx_class Ioc l l']
+  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
+  (hl : μ.finite_at_filter l') (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : v ≤ᶠ[lt] u) :
+  (λ t, ∫ x in u t..v t, f x ∂μ + (μ (Ioc (v t) (u t))).to_real • c) =o[lt]
+    (λ t, (μ $ Ioc (v t) (u t)).to_real) :=
+(measure_integral_sub_linear_is_o_of_tendsto_ae_of_le' hfm hf hl hv hu huv).neg_left.congr_left $
+  λ t, by simp [integral_symm (u t), add_comm]
+
+section
+
+variables [is_locally_finite_measure μ] [FTC_filter a l l']
+
+include a
+
+local attribute [instance] FTC_filter.meas_gen
+
+/-- Fundamental theorem of calculus-1, local version for any measure.
+Let filters `l` and `l'` be related by `[FTC_filter a l l']`; let `μ` be a locally finite measure.
+If `f` has a finite limit `c` at `l' ⊓ μ.ae`, then
+`∫ x in u..v, f x ∂μ = ∫ x in u..v, c ∂μ + o(∫ x in u..v, 1 ∂μ)` as both `u` and `v` tend to `l`.
+
+See also `measure_integral_sub_linear_is_o_of_tendsto_ae'` for a version that also works, e.g., for
+`l = l' = at_top`.
+
+We use integrals of constants instead of measures because this way it is easier to formulate
+a statement that works in both cases `u ≤ v` and `v ≤ u`. -/
+lemma measure_integral_sub_linear_is_o_of_tendsto_ae (hfm : strongly_measurable_at_filter f l' μ)
+  (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c)) (hu : tendsto u lt l) (hv : tendsto v lt l) :
+  (λ t, ∫ x in u t..v t, f x ∂μ - ∫ x in u t..v t, c ∂μ) =o[lt] (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) :=
+measure_integral_sub_linear_is_o_of_tendsto_ae' hfm hf (FTC_filter.finite_at_inner l) hu hv
+
+/-- Fundamental theorem of calculus-1, local version for any measure.
+Let filters `l` and `l'` be related by `[FTC_filter a l l']`; let `μ` be a locally finite measure.
+If `f` has a finite limit `c` at `l' ⊓ μ.ae`, then
+`∫ x in u..v, f x ∂μ = μ (Ioc u v) • c + o(μ(Ioc u v))` as both `u` and `v` tend to `l`.
+
+See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_le'` for a version that also works,
+e.g., for `l = l' = at_top`. -/
+lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_le
+  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
+  (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : u ≤ᶠ[lt] v) :
+  (λ t, ∫ x in u t..v t, f x ∂μ - (μ (Ioc (u t) (v t))).to_real • c) =o[lt]
+    (λ t, (μ $ Ioc (u t) (v t)).to_real) :=
+measure_integral_sub_linear_is_o_of_tendsto_ae_of_le' hfm hf (FTC_filter.finite_at_inner l)
+  hu hv huv
+
+/-- Fundamental theorem of calculus-1, local version for any measure.
+Let filters `l` and `l'` be related by `[FTC_filter a l l']`; let `μ` be a locally finite measure.
+If `f` has a finite limit `c` at `l' ⊓ μ.ae`, then
+`∫ x in u..v, f x ∂μ = -μ (Ioc v u) • c + o(μ(Ioc v u))` as both `u` and `v` tend to `l`.
+
+See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge'` for a version that also works,
+e.g., for `l = l' = at_top`. -/
+lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge
+  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
+  (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : v ≤ᶠ[lt] u) :
+  (λ t, ∫ x in u t..v t, f x ∂μ + (μ (Ioc (v t) (u t))).to_real • c) =o[lt]
+    (λ t, (μ $ Ioc (v t) (u t)).to_real) :=
+measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge' hfm hf (FTC_filter.finite_at_inner l)
+  hu hv huv
+
+end
+
+local attribute [instance] FTC_filter.meas_gen
+
+variables [FTC_filter a la la'] [FTC_filter b lb lb'] [is_locally_finite_measure μ]
+
+/-- Fundamental theorem of calculus-1, strict derivative in both limits for a locally finite
+measure.
+
+Let `f` be a measurable function integrable on `a..b`. Let `(la, la')` be a pair of `FTC_filter`s
+around `a`; let `(lb, lb')` be a pair of `FTC_filter`s around `b`. Suppose that `f` has finite
+limits `ca` and `cb` at `la' ⊓ μ.ae` and `lb' ⊓ μ.ae`, respectively.
+Then `∫ x in va..vb, f x ∂μ - ∫ x in ua..ub, f x ∂μ =
+  ∫ x in ub..vb, cb ∂μ - ∫ x in ua..va, ca ∂μ +
+    o(‖∫ x in ua..va, (1:ℝ) ∂μ‖ + ‖∫ x in ub..vb, (1:ℝ) ∂μ‖)`
+as `ua` and `va` tend to `la` while `ub` and `vb` tend to `lb`.
+-/
+lemma measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae
+  (hab : interval_integrable f μ a b)
+  (hmeas_a : strongly_measurable_at_filter f la' μ)
+  (hmeas_b : strongly_measurable_at_filter f lb' μ)
+  (ha_lim : tendsto f (la' ⊓ μ.ae) (𝓝 ca)) (hb_lim : tendsto f (lb' ⊓ μ.ae) (𝓝 cb))
+  (hua : tendsto ua lt la) (hva : tendsto va lt la)
+  (hub : tendsto ub lt lb) (hvb : tendsto vb lt lb) :
+  (λ t, (∫ x in va t..vb t, f x ∂μ) - (∫ x in ua t..ub t, f x ∂μ) -
+    (∫ x in ub t..vb t, cb ∂μ - ∫ x in ua t..va t, ca ∂μ)) =o[lt]
+    (λ t, ‖∫ x in ua t..va t, (1:ℝ) ∂μ‖ + ‖∫ x in ub t..vb t, (1:ℝ) ∂μ‖) :=
+begin
+  refine
+    ((measure_integral_sub_linear_is_o_of_tendsto_ae hmeas_a ha_lim hua hva).neg_left.add_add
+    (measure_integral_sub_linear_is_o_of_tendsto_ae hmeas_b hb_lim hub hvb)).congr'
+      _ eventually_eq.rfl,
+  have A : ∀ᶠ t in lt, interval_integrable f μ (ua t) (va t) :=
+    ha_lim.eventually_interval_integrable_ae hmeas_a (FTC_filter.finite_at_inner la) hua hva,
+  have A' : ∀ᶠ t in lt, interval_integrable f μ a (ua t) :=
+    ha_lim.eventually_interval_integrable_ae hmeas_a (FTC_filter.finite_at_inner la)
+      (tendsto_const_pure.mono_right FTC_filter.pure_le) hua,
+  have B : ∀ᶠ t in lt, interval_integrable f μ (ub t) (vb t) :=
+    hb_lim.eventually_interval_integrable_ae hmeas_b (FTC_filter.finite_at_inner lb) hub hvb,
+  have B' : ∀ᶠ t in lt, interval_integrable f μ b (ub t) :=
+    hb_lim.eventually_interval_integrable_ae hmeas_b (FTC_filter.finite_at_inner lb)
+      (tendsto_const_pure.mono_right FTC_filter.pure_le) hub,
+  filter_upwards [A, A', B, B'] with _ ua_va a_ua ub_vb b_ub,
+  rw [← integral_interval_sub_interval_comm'],
+  { dsimp only [], abel, },
+  exacts [ub_vb, ua_va, b_ub.symm.trans $ hab.symm.trans a_ua]
+end
+
+/-- Fundamental theorem of calculus-1, strict derivative in right endpoint for a locally finite
+measure.
+
+Let `f` be a measurable function integrable on `a..b`. Let `(lb, lb')` be a pair of `FTC_filter`s
+around `b`. Suppose that `f` has a finite limit `c` at `lb' ⊓ μ.ae`.
+
+Then `∫ x in a..v, f x ∂μ - ∫ x in a..u, f x ∂μ = ∫ x in u..v, c ∂μ + o(∫ x in u..v, (1:ℝ) ∂μ)`
+as `u` and `v` tend to `lb`.
+-/
+lemma measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right
+  (hab : interval_integrable f μ a b) (hmeas : strongly_measurable_at_filter f lb' μ)
+  (hf : tendsto f (lb' ⊓ μ.ae) (𝓝 c)) (hu : tendsto u lt lb) (hv : tendsto v lt lb) :
+  (λ t, ∫ x in a..v t, f x ∂μ - ∫ x in a..u t, f x ∂μ - ∫ x in u t..v t, c ∂μ) =o[lt]
+    (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) :=
+by simpa using measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae
+  hab strongly_measurable_at_bot hmeas ((tendsto_bot : tendsto _ ⊥ (𝓝 0)).mono_left inf_le_left)
+  hf (tendsto_const_pure : tendsto _ _ (pure a)) tendsto_const_pure hu hv
+
+/-- Fundamental theorem of calculus-1, strict derivative in left endpoint for a locally finite
+measure.
+
+Let `f` be a measurable function integrable on `a..b`. Let `(la, la')` be a pair of `FTC_filter`s
+around `a`. Suppose that `f` has a finite limit `c` at `la' ⊓ μ.ae`.
+
+Then `∫ x in v..b, f x ∂μ - ∫ x in u..b, f x ∂μ = -∫ x in u..v, c ∂μ + o(∫ x in u..v, (1:ℝ) ∂μ)`
+as `u` and `v` tend to `la`.
+-/
+lemma measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_left
+  (hab : interval_integrable f μ a b) (hmeas : strongly_measurable_at_filter f la' μ)
+  (hf : tendsto f (la' ⊓ μ.ae) (𝓝 c)) (hu : tendsto u lt la) (hv : tendsto v lt la) :
+  (λ t, ∫ x in v t..b, f x ∂μ - ∫ x in u t..b, f x ∂μ + ∫ x in u t..v t, c ∂μ) =o[lt]
+    (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) :=
+by simpa using measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae
+  hab hmeas strongly_measurable_at_bot hf ((tendsto_bot : tendsto _ ⊥ (𝓝 0)).mono_left inf_le_left)
+  hu hv (tendsto_const_pure : tendsto _ _ (pure b)) tendsto_const_pure
+
+end
+
+/-!
+### Fundamental theorem of calculus-1 for Lebesgue measure
+
+In this section we restate theorems from the previous section for Lebesgue measure.
+In particular, we prove that `∫ x in u..v, f x` is strictly differentiable in `(u, v)`
+at `(a, b)` provided that `f` is integrable on `a..b` and is continuous at `a` and `b`.
+-/
+
+variables {f : ℝ → E} {c ca cb : E} {l l' la la' lb lb' : filter ℝ} {lt : filter ι}
+  {a b z : ℝ} {u v ua ub va vb : ι → ℝ} [FTC_filter a la la'] [FTC_filter b lb lb']
+
+/-!
+#### Auxiliary `is_o` statements
+
+In this section we prove several lemmas that can be interpreted as strict differentiability of
+`(u, v) ↦ ∫ x in u..v, f x ∂μ` in `u` and/or `v` at a filter. The statements use `is_o` because
+we have no definition of `has_strict_(f)deriv_at_filter` in the library.
+-/
+
+/-- Fundamental theorem of calculus-1, local version. If `f` has a finite limit `c` almost surely at
+`l'`, where `(l, l')` is an `FTC_filter` pair around `a`, then
+`∫ x in u..v, f x ∂μ = (v - u) • c + o (v - u)` as both `u` and `v` tend to `l`. -/
+lemma integral_sub_linear_is_o_of_tendsto_ae [FTC_filter a l l']
+  (hfm : strongly_measurable_at_filter f l') (hf : tendsto f (l' ⊓ volume.ae) (𝓝 c))
+  {u v : ι → ℝ} (hu : tendsto u lt l) (hv : tendsto v lt l) :
+  (λ t, (∫ x in u t..v t, f x) - (v t - u t) • c) =o[lt] (v - u) :=
+by simpa [integral_const] using measure_integral_sub_linear_is_o_of_tendsto_ae hfm hf hu hv
+
+/-- Fundamental theorem of calculus-1, strict differentiability at filter in both endpoints.
+If `f` is a measurable function integrable on `a..b`, `(la, la')` is an `FTC_filter` pair around
+`a`, and `(lb, lb')` is an `FTC_filter` pair around `b`, and `f` has finite limits `ca` and `cb`
+almost surely at `la'` and `lb'`, respectively, then
+`(∫ x in va..vb, f x) - ∫ x in ua..ub, f x = (vb - ub) • cb - (va - ua) • ca +
+  o(‖va - ua‖ + ‖vb - ub‖)` as `ua` and `va` tend to `la` while `ub` and `vb` tend to `lb`.
+
+This lemma could've been formulated using `has_strict_fderiv_at_filter` if we had this
+definition. -/
+lemma integral_sub_integral_sub_linear_is_o_of_tendsto_ae
+  (hab : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f la') (hmeas_b : strongly_measurable_at_filter f lb')
+  (ha_lim : tendsto f (la' ⊓ volume.ae) (𝓝 ca)) (hb_lim : tendsto f (lb' ⊓ volume.ae) (𝓝 cb))
+  (hua : tendsto ua lt la) (hva : tendsto va lt la)
+  (hub : tendsto ub lt lb) (hvb : tendsto vb lt lb) :
+  (λ t, (∫ x in va t..vb t, f x) - (∫ x in ua t..ub t, f x) -
+    ((vb t - ub t) • cb - (va t - ua t) • ca)) =o[lt] (λ t, ‖va t - ua t‖ + ‖vb t - ub t‖) :=
+by simpa [integral_const]
+  using measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae hab hmeas_a hmeas_b
+    ha_lim hb_lim hua hva hub hvb
+
+/-- Fundamental theorem of calculus-1, strict differentiability at filter in both endpoints.
+If `f` is a measurable function integrable on `a..b`, `(lb, lb')` is an `FTC_filter` pair
+around `b`, and `f` has a finite limit `c` almost surely at `lb'`, then
+`(∫ x in a..v, f x) - ∫ x in a..u, f x = (v - u) • c + o(‖v - u‖)` as `u` and `v` tend to `lb`.
+
+This lemma could've been formulated using `has_strict_deriv_at_filter` if we had this definition. -/
+lemma integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right
+  (hab : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f lb')
+  (hf : tendsto f (lb' ⊓ volume.ae) (𝓝 c)) (hu : tendsto u lt lb) (hv : tendsto v lt lb) :
+  (λ t, (∫ x in a..v t, f x) - (∫ x in a..u t, f x) - (v t - u t) • c) =o[lt] (v - u) :=
+by simpa only [integral_const, smul_eq_mul, mul_one] using
+  measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right hab hmeas hf hu hv
+
+/-- Fundamental theorem of calculus-1, strict differentiability at filter in both endpoints.
+If `f` is a measurable function integrable on `a..b`, `(la, la')` is an `FTC_filter` pair
+around `a`, and `f` has a finite limit `c` almost surely at `la'`, then
+`(∫ x in v..b, f x) - ∫ x in u..b, f x = -(v - u) • c + o(‖v - u‖)` as `u` and `v` tend to `la`.
+
+This lemma could've been formulated using `has_strict_deriv_at_filter` if we had this definition. -/
+lemma integral_sub_integral_sub_linear_is_o_of_tendsto_ae_left
+  (hab : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f la')
+  (hf : tendsto f (la' ⊓ volume.ae) (𝓝 c)) (hu : tendsto u lt la) (hv : tendsto v lt la) :
+  (λ t, (∫ x in v t..b, f x) - (∫ x in u t..b, f x) + (v t - u t) • c) =o[lt] (v - u) :=
+by simpa only [integral_const, smul_eq_mul, mul_one] using
+  measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_left hab hmeas hf hu hv
+
+open continuous_linear_map (fst snd smul_right sub_apply smul_right_apply coe_fst' coe_snd' map_sub)
+
+/-!
+#### Strict differentiability
+
+In this section we prove that for a measurable function `f` integrable on `a..b`,
+
+* `integral_has_strict_fderiv_at_of_tendsto_ae`: the function `(u, v) ↦ ∫ x in u..v, f x` has
+  derivative `(u, v) ↦ v • cb - u • ca` at `(a, b)` in the sense of strict differentiability
+  provided that `f` tends to `ca` and `cb` almost surely as `x` tendsto to `a` and `b`,
+  respectively;
+
+* `integral_has_strict_fderiv_at`: the function `(u, v) ↦ ∫ x in u..v, f x` has
+  derivative `(u, v) ↦ v • f b - u • f a` at `(a, b)` in the sense of strict differentiability
+  provided that `f` is continuous at `a` and `b`;
+
+* `integral_has_strict_deriv_at_of_tendsto_ae_right`: the function `u ↦ ∫ x in a..u, f x` has
+  derivative `c` at `b` in the sense of strict differentiability provided that `f` tends to `c`
+  almost surely as `x` tends to `b`;
+
+* `integral_has_strict_deriv_at_right`: the function `u ↦ ∫ x in a..u, f x` has derivative `f b` at
+  `b` in the sense of strict differentiability provided that `f` is continuous at `b`;
+
+* `integral_has_strict_deriv_at_of_tendsto_ae_left`: the function `u ↦ ∫ x in u..b, f x` has
+  derivative `-c` at `a` in the sense of strict differentiability provided that `f` tends to `c`
+  almost surely as `x` tends to `a`;
+
+* `integral_has_strict_deriv_at_left`: the function `u ↦ ∫ x in u..b, f x` has derivative `-f a` at
+  `a` in the sense of strict differentiability provided that `f` is continuous at `a`.
+-/
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has finite
+limits `ca` and `cb` almost surely as `x` tends to `a` and `b`, respectively, then
+`(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca` at `(a, b)`
+in the sense of strict differentiability. -/
+lemma integral_has_strict_fderiv_at_of_tendsto_ae
+  (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
+  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
+  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 cb)) :
+  has_strict_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
+    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) (a, b) :=
+begin
+  have := integral_sub_integral_sub_linear_is_o_of_tendsto_ae hf hmeas_a hmeas_b ha hb
+    ((continuous_fst.comp continuous_snd).tendsto ((a, b), (a, b)))
+    ((continuous_fst.comp continuous_fst).tendsto ((a, b), (a, b)))
+    ((continuous_snd.comp continuous_snd).tendsto ((a, b), (a, b)))
+    ((continuous_snd.comp continuous_fst).tendsto ((a, b), (a, b))),
+  refine (this.congr_left _).trans_is_O _,
+  { intro x, simp [sub_smul] },
+  { exact is_O_fst_prod.norm_left.add is_O_snd_prod.norm_left }
+end
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `a` and `b`, then `(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca`
+at `(a, b)` in the sense of strict differentiability. -/
+lemma integral_has_strict_fderiv_at
+  (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
+  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
+  (ha : continuous_at f a) (hb : continuous_at f b) :
+  has_strict_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
+    ((snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a)) (a, b) :=
+integral_has_strict_fderiv_at_of_tendsto_ae hf hmeas_a hmeas_b
+  (ha.mono_left inf_le_left) (hb.mono_left inf_le_left)
+
+/-- **First Fundamental Theorem of Calculus**: if `f : ℝ → E` is integrable on `a..b` and `f x` has
+a finite limit `c` almost surely at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `c` at `b` in
+the sense of strict differentiability. -/
+lemma integral_has_strict_deriv_at_of_tendsto_ae_right
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
+  (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 c)) : has_strict_deriv_at (λ u, ∫ x in a..u, f x) c b :=
+integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right hf hmeas hb continuous_at_snd
+  continuous_at_fst
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `f b` at `b` in the sense of strict
+differentiability. -/
+lemma integral_has_strict_deriv_at_right
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
+  (hb : continuous_at f b) : has_strict_deriv_at (λ u, ∫ x in a..u, f x) (f b) b :=
+integral_has_strict_deriv_at_of_tendsto_ae_right hf hmeas (hb.mono_left inf_le_left)
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-c` at `a` in the sense
+of strict differentiability. -/
+lemma integral_has_strict_deriv_at_of_tendsto_ae_left
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
+  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 c)) : has_strict_deriv_at (λ u, ∫ x in u..b, f x) (-c) a :=
+by simpa only [← integral_symm]
+  using (integral_has_strict_deriv_at_of_tendsto_ae_right hf.symm hmeas ha).neg
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-f a` at `a` in the sense of strict
+differentiability. -/
+lemma integral_has_strict_deriv_at_left
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
+  (ha : continuous_at f a) : has_strict_deriv_at (λ u, ∫ x in u..b, f x) (-f a) a :=
+by simpa only [← integral_symm] using (integral_has_strict_deriv_at_right hf.symm hmeas ha).neg
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is continuous, then `u ↦ ∫ x in a..u, f x`
+has derivative `f b` at `b` in the sense of strict differentiability. -/
+lemma _root_.continuous.integral_has_strict_deriv_at {f : ℝ → E} (hf : continuous f) (a b : ℝ) :
+  has_strict_deriv_at (λ u, ∫ (x : ℝ) in a..u, f x) (f b) b :=
+integral_has_strict_deriv_at_right (hf.interval_integrable _ _)
+ (hf.strongly_measurable_at_filter _ _) hf.continuous_at
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is continuous, then the derivative
+of `u ↦ ∫ x in a..u, f x` at `b` is `f b`. -/
+lemma _root_.continuous.deriv_integral (f : ℝ → E) (hf : continuous f) (a b : ℝ) :
+  deriv (λ u, ∫ (x : ℝ) in a..u, f x) b = f b :=
+(hf.integral_has_strict_deriv_at a b).has_deriv_at.deriv
+
+/-!
+#### Fréchet differentiability
+
+In this subsection we restate results from the previous subsection in terms of `has_fderiv_at`,
+`has_deriv_at`, `fderiv`, and `deriv`.
+-/
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has finite
+limits `ca` and `cb` almost surely as `x` tends to `a` and `b`, respectively, then
+`(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca` at `(a, b)`. -/
+lemma integral_has_fderiv_at_of_tendsto_ae (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
+  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
+  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 cb)) :
+  has_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
+    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) (a, b) :=
+(integral_has_strict_fderiv_at_of_tendsto_ae hf hmeas_a hmeas_b ha hb).has_fderiv_at
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `a` and `b`, then `(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca`
+at `(a, b)`. -/
+lemma integral_has_fderiv_at (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
+  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
+  (ha : continuous_at f a) (hb : continuous_at f b) :
+  has_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
+    ((snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a)) (a, b) :=
+(integral_has_strict_fderiv_at hf hmeas_a hmeas_b ha hb).has_fderiv_at
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has finite
+limits `ca` and `cb` almost surely as `x` tends to `a` and `b`, respectively, then `fderiv`
+derivative of `(u, v) ↦ ∫ x in u..v, f x` at `(a, b)` equals `(u, v) ↦ v • cb - u • ca`. -/
+lemma fderiv_integral_of_tendsto_ae (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
+  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
+  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 cb)) :
+  fderiv ℝ (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x) (a, b) =
+    (snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca :=
+(integral_has_fderiv_at_of_tendsto_ae hf hmeas_a hmeas_b ha hb).fderiv
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `a` and `b`, then `fderiv` derivative of `(u, v) ↦ ∫ x in u..v, f x` at `(a, b)` equals `(u, v) ↦
+v • cb - u • ca`. -/
+lemma fderiv_integral (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
+  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
+  (ha : continuous_at f a) (hb : continuous_at f b) :
+  fderiv ℝ (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x) (a, b) =
+    (snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a) :=
+(integral_has_fderiv_at hf hmeas_a hmeas_b ha hb).fderiv
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `c` at `b`. -/
+lemma integral_has_deriv_at_of_tendsto_ae_right
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
+  (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 c)) : has_deriv_at (λ u, ∫ x in a..u, f x) c b :=
+(integral_has_strict_deriv_at_of_tendsto_ae_right hf hmeas hb).has_deriv_at
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `f b` at `b`. -/
+lemma integral_has_deriv_at_right
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
+  (hb : continuous_at f b) : has_deriv_at (λ u, ∫ x in a..u, f x) (f b) b :=
+(integral_has_strict_deriv_at_right hf hmeas hb).has_deriv_at
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` has a finite
+limit `c` almost surely at `b`, then the derivative of `u ↦ ∫ x in a..u, f x` at `b` equals `c`. -/
+lemma deriv_integral_of_tendsto_ae_right
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
+  (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 c)) : deriv (λ u, ∫ x in a..u, f x) b = c :=
+(integral_has_deriv_at_of_tendsto_ae_right hf hmeas hb).deriv
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `b`, then the derivative of `u ↦ ∫ x in a..u, f x` at `b` equals `f b`. -/
+lemma deriv_integral_right
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
+  (hb : continuous_at f b) :
+  deriv (λ u, ∫ x in a..u, f x) b = f b :=
+(integral_has_deriv_at_right hf hmeas hb).deriv
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-c` at `a`. -/
+lemma integral_has_deriv_at_of_tendsto_ae_left
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
+  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 c)) : has_deriv_at (λ u, ∫ x in u..b, f x) (-c) a :=
+(integral_has_strict_deriv_at_of_tendsto_ae_left hf hmeas ha).has_deriv_at
+
+/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-f a` at `a`. -/
+lemma integral_has_deriv_at_left
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
+  (ha : continuous_at f a) :
+  has_deriv_at (λ u, ∫ x in u..b, f x) (-f a) a :=
+(integral_has_strict_deriv_at_left hf hmeas ha).has_deriv_at
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` has a finite
+limit `c` almost surely at `a`, then the derivative of `u ↦ ∫ x in u..b, f x` at `a` equals `-c`. -/
+lemma deriv_integral_of_tendsto_ae_left
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
+  (hb : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 c)) : deriv (λ u, ∫ x in u..b, f x) a = -c :=
+(integral_has_deriv_at_of_tendsto_ae_left hf hmeas hb).deriv
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
+at `a`, then the derivative of `u ↦ ∫ x in u..b, f x` at `a` equals `-f a`. -/
+lemma deriv_integral_left
+  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
+  (hb : continuous_at f a) :
+  deriv (λ u, ∫ x in u..b, f x) a = -f a :=
+(integral_has_deriv_at_left hf hmeas hb).deriv
+
+/-!
+#### One-sided derivatives
+-/
+
+/-- Let `f` be a measurable function integrable on `a..b`. The function `(u, v) ↦ ∫ x in u..v, f x`
+has derivative `(u, v) ↦ v • cb - u • ca` within `s × t` at `(a, b)`, where
+`s ∈ {Iic a, {a}, Ici a, univ}` and `t ∈ {Iic b, {b}, Ici b, univ}` provided that `f` tends to `ca`
+and `cb` almost surely at the filters `la` and `lb` from the following table.
+
+| `s`     | `la`     | `t`     | `lb`     |
+| ------- | ----     | ---     | ----     |
+| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
+| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
+| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
+| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
+-/
+lemma integral_has_fderiv_within_at_of_tendsto_ae
+  (hf : interval_integrable f volume a b)
+  {s t : set ℝ} [FTC_filter a (𝓝[s] a) la] [FTC_filter b (𝓝[t] b) lb]
+  (hmeas_a : strongly_measurable_at_filter f la) (hmeas_b : strongly_measurable_at_filter f lb)
+  (ha : tendsto f (la ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (lb ⊓ volume.ae) (𝓝 cb)) :
+  has_fderiv_within_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
+    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) (s ×ˢ t) (a, b) :=
+begin
+  rw [has_fderiv_within_at, nhds_within_prod_eq],
+  have := integral_sub_integral_sub_linear_is_o_of_tendsto_ae hf hmeas_a hmeas_b ha hb
+    (tendsto_const_pure.mono_right FTC_filter.pure_le : tendsto _ _ (𝓝[s] a)) tendsto_fst
+    (tendsto_const_pure.mono_right FTC_filter.pure_le : tendsto _ _ (𝓝[t] b)) tendsto_snd,
+  refine (this.congr_left _).trans_is_O _,
+  { intro x, simp [sub_smul] },
+  { exact is_O_fst_prod.norm_left.add is_O_snd_prod.norm_left }
+end
+
+/-- Let `f` be a measurable function integrable on `a..b`. The function `(u, v) ↦ ∫ x in u..v, f x`
+has derivative `(u, v) ↦ v • f b - u • f a` within `s × t` at `(a, b)`, where
+`s ∈ {Iic a, {a}, Ici a, univ}` and `t ∈ {Iic b, {b}, Ici b, univ}` provided that `f` tends to
+`f a` and `f b` at the filters `la` and `lb` from the following table. In most cases this assumption
+is definitionally equal `continuous_at f _` or `continuous_within_at f _ _`.
+
+| `s`     | `la`     | `t`     | `lb`     |
+| ------- | ----     | ---     | ----     |
+| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
+| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
+| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
+| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
+-/
+lemma integral_has_fderiv_within_at
+  (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f la) (hmeas_b : strongly_measurable_at_filter f lb)
+  {s t : set ℝ} [FTC_filter a (𝓝[s] a) la] [FTC_filter b (𝓝[t] b) lb]
+  (ha : tendsto f la (𝓝 $ f a)) (hb : tendsto f lb (𝓝 $ f b)) :
+  has_fderiv_within_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
+    ((snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a)) (s ×ˢ t) (a, b) :=
+integral_has_fderiv_within_at_of_tendsto_ae hf hmeas_a hmeas_b (ha.mono_left inf_le_left)
+  (hb.mono_left inf_le_left)
+
+/-- An auxiliary tactic closing goals `unique_diff_within_at ℝ s a` where
+`s ∈ {Iic a, Ici a, univ}`. -/
+meta def unique_diff_within_at_Ici_Iic_univ : tactic unit :=
+`[apply_rules [unique_diff_on.unique_diff_within_at, unique_diff_on_Ici, unique_diff_on_Iic,
+  left_mem_Ici, right_mem_Iic, unique_diff_within_at_univ]]
+
+/-- Let `f` be a measurable function integrable on `a..b`. Choose `s ∈ {Iic a, Ici a, univ}`
+and `t ∈ {Iic b, Ici b, univ}`. Suppose that `f` tends to `ca` and `cb` almost surely at the filters
+`la` and `lb` from the table below. Then `fderiv_within ℝ (λ p, ∫ x in p.1..p.2, f x) (s ×ˢ t)`
+is equal to `(u, v) ↦ u • cb - v • ca`.
+
+| `s`     | `la`     | `t`     | `lb`     |
+| ------- | ----     | ---     | ----     |
+| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
+| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
+| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
+| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
+-/
+lemma fderiv_within_integral_of_tendsto_ae
+  (hf : interval_integrable f volume a b)
+  (hmeas_a : strongly_measurable_at_filter f la) (hmeas_b : strongly_measurable_at_filter f lb)
+  {s t : set ℝ} [FTC_filter a (𝓝[s] a) la] [FTC_filter b (𝓝[t] b) lb]
+  (ha : tendsto f (la ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (lb ⊓ volume.ae) (𝓝 cb))
+  (hs : unique_diff_within_at ℝ s a . unique_diff_within_at_Ici_Iic_univ)
+  (ht : unique_diff_within_at ℝ t b . unique_diff_within_at_Ici_Iic_univ) :
+  fderiv_within ℝ (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x) (s ×ˢ t) (a, b) =
+    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) :=
+(integral_has_fderiv_within_at_of_tendsto_ae hf hmeas_a hmeas_b ha hb).fderiv_within $ hs.prod ht
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely as `x` tends to `b` from the right or from the left,
+then `u ↦ ∫ x in a..u, f x` has right (resp., left) derivative `c` at `b`. -/
+lemma integral_has_deriv_within_at_of_tendsto_ae_right
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] b)) (hb : tendsto f (𝓝[t] b ⊓ volume.ae) (𝓝 c)) :
+  has_deriv_within_at (λ u, ∫ x in a..u, f x) c s b :=
+integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right hf hmeas hb
+  (tendsto_const_pure.mono_right FTC_filter.pure_le) tendsto_id
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
+from the left or from the right at `b`, then `u ↦ ∫ x in a..u, f x` has left (resp., right)
+derivative `f b` at `b`. -/
+lemma integral_has_deriv_within_at_right
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] b)) (hb : continuous_within_at f t b) :
+  has_deriv_within_at (λ u, ∫ x in a..u, f x) (f b) s b :=
+integral_has_deriv_within_at_of_tendsto_ae_right hf hmeas (hb.mono_left inf_le_left)
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely as `x` tends to `b` from the right or from the left, then the right
+(resp., left) derivative of `u ↦ ∫ x in a..u, f x` at `b` equals `c`. -/
+lemma deriv_within_integral_of_tendsto_ae_right
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
+  (hmeas: strongly_measurable_at_filter f (𝓝[t] b)) (hb : tendsto f (𝓝[t] b ⊓ volume.ae) (𝓝 c))
+  (hs : unique_diff_within_at ℝ s b . unique_diff_within_at_Ici_Iic_univ) :
+  deriv_within (λ u, ∫ x in a..u, f x) s b = c :=
+(integral_has_deriv_within_at_of_tendsto_ae_right hf hmeas hb).deriv_within hs
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
+on the right or on the left at `b`, then the right (resp., left) derivative of
+`u ↦ ∫ x in a..u, f x` at `b` equals `f b`. -/
+lemma deriv_within_integral_right
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] b)) (hb : continuous_within_at f t b)
+  (hs : unique_diff_within_at ℝ s b . unique_diff_within_at_Ici_Iic_univ) :
+  deriv_within (λ u, ∫ x in a..u, f x) s b = f b :=
+(integral_has_deriv_within_at_right hf hmeas hb).deriv_within hs
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely as `x` tends to `a` from the right or from the left,
+then `u ↦ ∫ x in u..b, f x` has right (resp., left) derivative `-c` at `a`. -/
+lemma integral_has_deriv_within_at_of_tendsto_ae_left
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] a))
+  (ha : tendsto f (𝓝[t] a ⊓ volume.ae) (𝓝 c)) :
+  has_deriv_within_at (λ u, ∫ x in u..b, f x) (-c) s a :=
+by { simp only [integral_symm b],
+  exact (integral_has_deriv_within_at_of_tendsto_ae_right hf.symm hmeas ha).neg }
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
+from the left or from the right at `a`, then `u ↦ ∫ x in u..b, f x` has left (resp., right)
+derivative `-f a` at `a`. -/
+lemma integral_has_deriv_within_at_left
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] a)) (ha : continuous_within_at f t a) :
+  has_deriv_within_at (λ u, ∫ x in u..b, f x) (-f a) s a :=
+integral_has_deriv_within_at_of_tendsto_ae_left hf hmeas (ha.mono_left inf_le_left)
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
+limit `c` almost surely as `x` tends to `a` from the right or from the left, then the right
+(resp., left) derivative of `u ↦ ∫ x in u..b, f x` at `a` equals `-c`. -/
+lemma deriv_within_integral_of_tendsto_ae_left
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] a)) (ha : tendsto f (𝓝[t] a ⊓ volume.ae) (𝓝 c))
+  (hs : unique_diff_within_at ℝ s a . unique_diff_within_at_Ici_Iic_univ) :
+  deriv_within (λ u, ∫ x in u..b, f x) s a = -c :=
+(integral_has_deriv_within_at_of_tendsto_ae_left hf hmeas ha).deriv_within hs
+
+/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
+on the right or on the left at `a`, then the right (resp., left) derivative of
+`u ↦ ∫ x in u..b, f x` at `a` equals `-f a`. -/
+lemma deriv_within_integral_left
+  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
+  (hmeas : strongly_measurable_at_filter f (𝓝[t] a)) (ha : continuous_within_at f t a)
+  (hs : unique_diff_within_at ℝ s a . unique_diff_within_at_Ici_Iic_univ) :
+  deriv_within (λ u, ∫ x in u..b, f x) s a = -f a :=
+(integral_has_deriv_within_at_left hf hmeas ha).deriv_within hs
+
+/-- The integral of a continuous function is differentiable on a real set `s`. -/
+theorem differentiable_on_integral_of_continuous {s : set ℝ}
+  (hintg : ∀ x ∈ s, interval_integrable f volume a x) (hcont : continuous f) :
+  differentiable_on ℝ (λ u, ∫ x in a..u, f x) s :=
+λ y hy, (integral_has_deriv_at_right (hintg y hy)
+  hcont.ae_strongly_measurable.strongly_measurable_at_filter
+    hcont.continuous_at) .differentiable_at.differentiable_within_at
+
+/-!
+### Fundamental theorem of calculus, part 2
+
+This section contains theorems pertaining to FTC-2 for interval integrals, i.e., the assertion
+that `∫ x in a..b, f' x = f b - f a` under suitable assumptions.
+
+The most classical version of this theorem assumes that `f'` is continuous. However, this is
+unnecessarily strong: the result holds if `f'` is just integrable. We prove the strong version,
+following [Rudin, *Real and Complex Analysis* (Theorem 7.21)][rudin2006real]. The proof is first
+given for real-valued functions, and then deduced for functions with a general target space. For
+a real-valued function `g`, it suffices to show that `g b - g a ≤ (∫ x in a..b, g' x) + ε` for all
+positive `ε`. To prove this, choose a lower-semicontinuous function `G'` with `g' < G'` and with
+integral close to that of `g'` (its existence is guaranteed by the Vitali-Carathéodory theorem).
+It satisfies `g t - g a ≤ ∫ x in a..t, G' x` for all `t ∈ [a, b]`: this inequality holds at `a`,
+and if it holds at `t` then it holds for `u` close to `t` on its right, as the left hand side
+increases by `g u - g t ∼ (u -t) g' t`, while the right hand side increases by
+`∫ x in t..u, G' x` which is roughly at least `∫ x in t..u, G' t = (u - t) G' t`, by lower
+semicontinuity. As  `g' t < G' t`, this gives the conclusion. One can therefore push progressively
+this inequality to the right until the point `b`, where it gives the desired conclusion.
+-/
+
+variables {g' g φ : ℝ → ℝ}
+
+/-- Hard part of FTC-2 for integrable derivatives, real-valued functions: one has
+`g b - g a ≤ ∫ y in a..b, g' y` when `g'` is integrable.
+Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`.
+We give the slightly more general version that `g b - g a ≤ ∫ y in a..b, φ y` when `g' ≤ φ` and
+`φ` is integrable (even if `g'` is not known to be integrable).
+Version assuming that `g` is differentiable on `[a, b)`. -/
+lemma sub_le_integral_of_has_deriv_right_of_le_Ico (hab : a ≤ b) (hcont : continuous_on g (Icc a b))
+  (hderiv : ∀ x ∈ Ico a b, has_deriv_within_at g (g' x) (Ioi x) x)
+  (φint : integrable_on φ (Icc a b)) (hφg : ∀ x ∈ Ico a b, g' x ≤ φ x) :
+  g b - g a ≤ ∫ y in a..b, φ y :=
+begin
+  refine le_of_forall_pos_le_add (λ ε εpos, _),
+  -- Bound from above `g'` by a lower-semicontinuous function `G'`.
+  rcases exists_lt_lower_semicontinuous_integral_lt φ φint εpos with
+    ⟨G', f_lt_G', G'cont, G'int, G'lt_top, hG'⟩,
+  -- we will show by "induction" that `g t - g a ≤ ∫ u in a..t, G' u` for all `t ∈ [a, b]`.
+  set s := {t | g t - g a ≤ ∫ u in a..t, (G' u).to_real} ∩ Icc a b,
+  -- the set `s` of points where this property holds is closed.
+  have s_closed : is_closed s,
+  { have : continuous_on (λ t, (g t - g a, ∫ u in a..t, (G' u).to_real)) (Icc a b),
+    { rw ← uIcc_of_le hab at G'int ⊢ hcont,
+      exact (hcont.sub continuous_on_const).prod (continuous_on_primitive_interval G'int) },
+    simp only [s, inter_comm],
+    exact this.preimage_closed_of_closed is_closed_Icc order_closed_topology.is_closed_le' },
+  have main : Icc a b ⊆ {t | g t - g a ≤ ∫ u in a..t, (G' u).to_real },
+  { -- to show that the set `s` is all `[a, b]`, it suffices to show that any point `t` in `s`
+    -- with `t < b` admits another point in `s` slightly to its right
+    -- (this is a sort of real induction).
+    apply s_closed.Icc_subset_of_forall_exists_gt
+      (by simp only [integral_same, mem_set_of_eq, sub_self]) (λ t ht v t_lt_v, _),
+    obtain ⟨y, g'_lt_y', y_lt_G'⟩ : ∃ (y : ℝ), (g' t : ereal) < y ∧ (y : ereal) < G' t :=
+      ereal.lt_iff_exists_real_btwn.1 ((ereal.coe_le_coe_iff.2 (hφg t ht.2)).trans_lt (f_lt_G' t)),
+    -- bound from below the increase of `∫ x in a..u, G' x` on the right of `t`, using the lower
+    -- semicontinuity of `G'`.
+    have I1 : ∀ᶠ u in 𝓝[>] t, (u - t) * y ≤ ∫ w in t..u, (G' w).to_real,
+    { have B : ∀ᶠ u in 𝓝 t, (y : ereal) < G' u :=
+        G'cont.lower_semicontinuous_at _ _ y_lt_G',
+      rcases mem_nhds_iff_exists_Ioo_subset.1 B with ⟨m, M, ⟨hm, hM⟩, H⟩,
+      have : Ioo t (min M b) ∈ 𝓝[>] t := mem_nhds_within_Ioi_iff_exists_Ioo_subset.2
+        ⟨min M b, by simp only [hM, ht.right.right, lt_min_iff, mem_Ioi, and_self], subset.refl _⟩,
+      filter_upwards [this] with u hu,
+      have I : Icc t u ⊆ Icc a b := Icc_subset_Icc ht.2.1 (hu.2.le.trans (min_le_right _ _)),
+      calc (u - t) * y = ∫ v in Icc t u, y :
+        by simp only [hu.left.le, measure_theory.integral_const, algebra.id.smul_eq_mul, sub_nonneg,
+                      measurable_set.univ, real.volume_Icc, measure.restrict_apply, univ_inter,
+                      ennreal.to_real_of_real]
+      ... ≤ ∫ w in t..u, (G' w).to_real :
+      begin
+        rw [interval_integral.integral_of_le hu.1.le, ← integral_Icc_eq_integral_Ioc],
+        apply set_integral_mono_ae_restrict,
+        { simp only [integrable_on_const, real.volume_Icc, ennreal.of_real_lt_top, or_true] },
+        { exact integrable_on.mono_set G'int I },
+        { have C1 : ∀ᵐ (x : ℝ) ∂volume.restrict (Icc t u), G' x < ∞ :=
+            ae_mono (measure.restrict_mono I le_rfl) G'lt_top,
+          have C2 : ∀ᵐ (x : ℝ) ∂volume.restrict (Icc t u), x ∈ Icc t u :=
+            ae_restrict_mem measurable_set_Icc,
+          filter_upwards [C1, C2] with x G'x hx,
+          apply ereal.coe_le_coe_iff.1,
+          have : x ∈ Ioo m M, by simp only [hm.trans_le hx.left,
+            (hx.right.trans_lt hu.right).trans_le (min_le_left M b), mem_Ioo, and_self],
+          convert le_of_lt (H this),
+          exact ereal.coe_to_real G'x.ne (ne_bot_of_gt (f_lt_G' x)) }
+      end },
+    -- bound from above the increase of `g u - g a` on the right of `t`, using the derivative at `t`
+    have I2 : ∀ᶠ u in 𝓝[>] t, g u - g t ≤ (u - t) * y,
+    { have g'_lt_y : g' t < y := ereal.coe_lt_coe_iff.1 g'_lt_y',
+      filter_upwards [(hderiv t ⟨ht.2.1, ht.2.2⟩).limsup_slope_le'
+        (not_mem_Ioi.2 le_rfl) g'_lt_y, self_mem_nhds_within] with u hu t_lt_u,
+      have := mul_le_mul_of_nonneg_left hu.le (sub_pos.2 t_lt_u).le,
+      rwa [← smul_eq_mul, sub_smul_slope] at this },
+    -- combine the previous two bounds to show that `g u - g a` increases less quickly than
+    -- `∫ x in a..u, G' x`.
+    have I3 : ∀ᶠ u in 𝓝[>] t, g u - g t ≤ ∫ w in t..u, (G' w).to_real,
+    { filter_upwards [I1, I2] with u hu1 hu2 using hu2.trans hu1, },
+    have I4 : ∀ᶠ u in 𝓝[>] t, u ∈ Ioc t (min v b),
+    { refine mem_nhds_within_Ioi_iff_exists_Ioc_subset.2 ⟨min v b, _, subset.refl _⟩,
+      simp only [lt_min_iff, mem_Ioi],
+      exact ⟨t_lt_v, ht.2.2⟩ },
+    -- choose a point `x` slightly to the right of `t` which satisfies the above bound
+    rcases (I3.and I4).exists with ⟨x, hx, h'x⟩,
+    -- we check that it belongs to `s`, essentially by construction
+    refine ⟨x, _, Ioc_subset_Ioc le_rfl (min_le_left _ _) h'x⟩,
+    calc g x - g a = (g t - g a) + (g x - g t) : by abel
+    ... ≤ (∫ w in a..t, (G' w).to_real) + ∫ w in t..x, (G' w).to_real : add_le_add ht.1 hx
+    ... = ∫ w in a..x, (G' w).to_real :
+    begin
+      apply integral_add_adjacent_intervals,
+      { rw interval_integrable_iff_integrable_Ioc_of_le ht.2.1,
+        exact integrable_on.mono_set G'int
+          (Ioc_subset_Icc_self.trans (Icc_subset_Icc le_rfl ht.2.2.le)) },
+      { rw interval_integrable_iff_integrable_Ioc_of_le h'x.1.le,
+        apply integrable_on.mono_set G'int,
+        refine Ioc_subset_Icc_self.trans (Icc_subset_Icc ht.2.1 (h'x.2.trans (min_le_right _ _))) }
+    end },
+  -- now that we know that `s` contains `[a, b]`, we get the desired result by applying this to `b`.
+  calc g b - g a ≤ ∫ y in a..b, (G' y).to_real : main (right_mem_Icc.2 hab)
+  ... ≤ (∫ y in a..b, φ y) + ε :
+    begin
+      convert hG'.le;
+      { rw interval_integral.integral_of_le hab,
+        simp only [integral_Icc_eq_integral_Ioc', real.volume_singleton] },
+    end
+end
+
+/-- Hard part of FTC-2 for integrable derivatives, real-valued functions: one has
+`g b - g a ≤ ∫ y in a..b, g' y` when `g'` is integrable.
+Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`.
+We give the slightly more general version that `g b - g a ≤ ∫ y in a..b, φ y` when `g' ≤ φ` and
+`φ` is integrable (even if `g'` is not known to be integrable).
+Version assuming that `g` is differentiable on `(a, b)`. -/
+lemma sub_le_integral_of_has_deriv_right_of_le (hab : a ≤ b)
+  (hcont : continuous_on g (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at g (g' x) (Ioi x) x)
+  (φint : integrable_on φ (Icc a b)) (hφg : ∀ x ∈ Ioo a b, g' x ≤ φ x) :
+  g b - g a ≤ ∫ y in a..b, φ y :=
+begin
+  -- This follows from the version on a closed-open interval (applied to `[t, b)` for `t` close to
+  -- `a`) and a continuity argument.
+  obtain rfl|a_lt_b := hab.eq_or_lt, { simp },
+  set s := {t | g b - g t ≤ ∫ u in t..b, φ u} ∩ Icc a b,
+  have s_closed : is_closed s,
+  { have : continuous_on (λ t, (g b - g t, ∫ u in t..b, φ u)) (Icc a b),
+    { rw ← uIcc_of_le hab at ⊢ hcont φint,
+      exact (continuous_on_const.sub hcont).prod (continuous_on_primitive_interval_left φint) },
+    simp only [s, inter_comm],
+    exact this.preimage_closed_of_closed is_closed_Icc is_closed_le_prod, },
+  have A : closure (Ioc a b) ⊆ s,
+  { apply s_closed.closure_subset_iff.2,
+    assume t ht,
+    refine ⟨_, ⟨ht.1.le, ht.2⟩⟩,
+    exact sub_le_integral_of_has_deriv_right_of_le_Ico ht.2
+      (hcont.mono (Icc_subset_Icc ht.1.le le_rfl))
+      (λ x hx, hderiv x ⟨ht.1.trans_le hx.1, hx.2⟩)
+      (φint.mono_set (Icc_subset_Icc ht.1.le le_rfl))
+      (λ x hx, hφg x ⟨ht.1.trans_le hx.1, hx.2⟩) },
+  rw closure_Ioc a_lt_b.ne at A,
+  exact (A (left_mem_Icc.2 hab)).1,
+end
+
+/-- Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`. -/
+lemma integral_le_sub_of_has_deriv_right_of_le (hab : a ≤ b)
+  (hcont : continuous_on g (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at g (g' x) (Ioi x) x)
+  (φint : integrable_on φ (Icc a b)) (hφg : ∀ x ∈ Ioo a b, φ x ≤ g' x) :
+  ∫ y in a..b, φ y ≤ g b - g a :=
+begin
+  rw ← neg_le_neg_iff,
+  convert sub_le_integral_of_has_deriv_right_of_le hab hcont.neg (λ x hx, (hderiv x hx).neg)
+    φint.neg (λ x hx, neg_le_neg (hφg x hx)),
+  { abel },
+  { simp only [← integral_neg], refl },
+end
+
+/-- Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`: real version -/
+lemma integral_eq_sub_of_has_deriv_right_of_le_real (hab : a ≤ b)
+  (hcont : continuous_on g (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at g (g' x) (Ioi x) x)
+  (g'int : integrable_on g' (Icc a b)) :
+  ∫ y in a..b, g' y = g b - g a :=
+le_antisymm
+  (integral_le_sub_of_has_deriv_right_of_le hab hcont hderiv g'int (λ x hx, le_rfl))
+  (sub_le_integral_of_has_deriv_right_of_le hab hcont hderiv g'int (λ x hx, le_rfl))
+
+variable {f' : ℝ → E}
+
+/-- **Fundamental theorem of calculus-2**: If `f : ℝ → E` is continuous on `[a, b]` (where `a ≤ b`)
+  and has a right derivative at `f' x` for all `x` in `(a, b)`, and `f'` is integrable on `[a, b]`,
+  then `∫ y in a..b, f' y` equals `f b - f a`. -/
+theorem integral_eq_sub_of_has_deriv_right_of_le (hab : a ≤ b) (hcont : continuous_on f (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at f (f' x) (Ioi x) x)
+  (f'int : interval_integrable f' volume a b) :
+  ∫ y in a..b, f' y = f b - f a :=
+begin
+  refine (normed_space.eq_iff_forall_dual_eq ℝ).2 (λ g, _),
+  rw [← g.interval_integral_comp_comm f'int, g.map_sub],
+  exact integral_eq_sub_of_has_deriv_right_of_le_real hab (g.continuous.comp_continuous_on hcont)
+    (λ x hx, g.has_fderiv_at.comp_has_deriv_within_at x (hderiv x hx))
+    (g.integrable_comp ((interval_integrable_iff_integrable_Icc_of_le hab).1 f'int))
+end
+
+/-- Fundamental theorem of calculus-2: If `f : ℝ → E` is continuous on `[a, b]` and
+  has a right derivative at `f' x` for all `x` in `[a, b)`, and `f'` is integrable on `[a, b]` then
+  `∫ y in a..b, f' y` equals `f b - f a`. -/
+theorem integral_eq_sub_of_has_deriv_right (hcont : continuous_on f (uIcc a b))
+  (hderiv : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hint : interval_integrable f' volume a b) :
+  ∫ y in a..b, f' y = f b - f a :=
+begin
+  cases le_total a b with hab hab,
+  { simp only [uIcc_of_le, min_eq_left, max_eq_right, hab] at hcont hderiv hint,
+    apply integral_eq_sub_of_has_deriv_right_of_le hab hcont hderiv hint },
+  { simp only [uIcc_of_ge, min_eq_right, max_eq_left, hab] at hcont hderiv,
+    rw [integral_symm, integral_eq_sub_of_has_deriv_right_of_le hab hcont hderiv hint.symm,
+        neg_sub] }
+end
+
+/-- Fundamental theorem of calculus-2: If `f : ℝ → E` is continuous on `[a, b]` (where `a ≤ b`) and
+  has a derivative at `f' x` for all `x` in `(a, b)`, and `f'` is integrable on `[a, b]`, then
+  `∫ y in a..b, f' y` equals `f b - f a`. -/
+theorem integral_eq_sub_of_has_deriv_at_of_le (hab : a ≤ b)
+  (hcont : continuous_on f (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hint : interval_integrable f' volume a b) :
+  ∫ y in a..b, f' y = f b - f a :=
+integral_eq_sub_of_has_deriv_right_of_le hab hcont (λ x hx, (hderiv x hx).has_deriv_within_at) hint
+
+/-- Fundamental theorem of calculus-2: If `f : ℝ → E` has a derivative at `f' x` for all `x` in
+  `[a, b]` and `f'` is integrable on `[a, b]`, then `∫ y in a..b, f' y` equals `f b - f a`. -/
+theorem integral_eq_sub_of_has_deriv_at
+  (hderiv : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (hint : interval_integrable f' volume a b) :
+  ∫ y in a..b, f' y = f b - f a :=
+integral_eq_sub_of_has_deriv_right (has_deriv_at.continuous_on hderiv)
+  (λ x hx, (hderiv _ (mem_Icc_of_Ioo hx)).has_deriv_within_at) hint
+
+theorem integral_eq_sub_of_has_deriv_at_of_tendsto (hab : a < b) {fa fb}
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hint : interval_integrable f' volume a b)
+  (ha : tendsto f (𝓝[>] a) (𝓝 fa)) (hb : tendsto f (𝓝[<] b) (𝓝 fb)) :
+  ∫ y in a..b, f' y = fb - fa :=
+begin
+  set F : ℝ → E := update (update f a fa) b fb,
+  have Fderiv : ∀ x ∈ Ioo a b, has_deriv_at F (f' x) x,
+  { refine λ x hx, (hderiv x hx).congr_of_eventually_eq _,
+    filter_upwards [Ioo_mem_nhds hx.1 hx.2] with _ hy, simp only [F],
+    rw [update_noteq hy.2.ne, update_noteq hy.1.ne'], },
+  have hcont : continuous_on F (Icc a b),
+  { rw [continuous_on_update_iff, continuous_on_update_iff, Icc_diff_right, Ico_diff_left],
+    refine ⟨⟨λ z hz, (hderiv z hz).continuous_at.continuous_within_at, _⟩, _⟩,
+    { exact λ _, ha.mono_left (nhds_within_mono _ Ioo_subset_Ioi_self) },
+    { rintro -,
+      refine (hb.congr' _).mono_left (nhds_within_mono _ Ico_subset_Iio_self),
+      filter_upwards [Ioo_mem_nhds_within_Iio (right_mem_Ioc.2 hab)]
+        with _ hz using (update_noteq hz.1.ne' _ _).symm } },
+  simpa [F, hab.ne, hab.ne'] using integral_eq_sub_of_has_deriv_at_of_le hab.le hcont Fderiv hint
+end
+
+/-- Fundamental theorem of calculus-2: If `f : ℝ → E` is differentiable at every `x` in `[a, b]` and
+  its derivative is integrable on `[a, b]`, then `∫ y in a..b, deriv f y` equals `f b - f a`. -/
+theorem integral_deriv_eq_sub (hderiv : ∀ x ∈ uIcc a b, differentiable_at ℝ f x)
+  (hint : interval_integrable (deriv f) volume a b) :
+  ∫ y in a..b, deriv f y = f b - f a :=
+integral_eq_sub_of_has_deriv_at (λ x hx, (hderiv x hx).has_deriv_at) hint
+
+theorem integral_deriv_eq_sub' (f) (hderiv : deriv f = f')
+  (hdiff : ∀ x ∈ uIcc a b, differentiable_at ℝ f x)
+  (hcont : continuous_on f' (uIcc a b)) :
+  ∫ y in a..b, f' y = f b - f a :=
+begin
+  rw [← hderiv, integral_deriv_eq_sub hdiff],
+  rw hderiv,
+  exact hcont.interval_integrable
+end
+
+/-!
+### Automatic integrability for nonnegative derivatives
+-/
+
+/-- When the right derivative of a function is nonnegative, then it is automatically integrable. -/
+lemma integrable_on_deriv_right_of_nonneg  (hcont : continuous_on g (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at g (g' x) (Ioi x) x)
+  (g'pos : ∀ x ∈ Ioo a b, 0 ≤ g' x) :
+  integrable_on g' (Ioc a b) :=
+begin
+  by_cases hab : a < b, swap,
+  { simp [Ioc_eq_empty hab] },
+  rw integrable_on_Ioc_iff_integrable_on_Ioo,
+  have meas_g' : ae_measurable g' (volume.restrict (Ioo a b)),
+  { apply (ae_measurable_deriv_within_Ioi g _).congr,
+    refine (ae_restrict_mem measurable_set_Ioo).mono (λ x hx, _),
+    exact (hderiv x hx).deriv_within (unique_diff_within_at_Ioi _) },
+  suffices H : ∫⁻ x in Ioo a b, ‖g' x‖₊ ≤ ennreal.of_real (g b - g a),
+    from ⟨meas_g'.ae_strongly_measurable, H.trans_lt ennreal.of_real_lt_top⟩,
+  by_contra' H,
+  obtain ⟨f, fle, fint, hf⟩ :
+    ∃ (f : simple_func ℝ ℝ≥0), (∀ x, f x ≤ ‖g' x‖₊) ∧ ∫⁻ (x : ℝ) in Ioo a b, f x < ∞
+      ∧ ennreal.of_real (g b - g a) < ∫⁻ (x : ℝ) in Ioo a b, f x :=
+    exists_lt_lintegral_simple_func_of_lt_lintegral H,
+  let F : ℝ → ℝ := coe ∘ f,
+  have intF : integrable_on F (Ioo a b),
+  { refine ⟨f.measurable.coe_nnreal_real.ae_strongly_measurable, _⟩,
+    simpa only [has_finite_integral, nnreal.nnnorm_eq] using fint },
+  have A : ∫⁻ (x : ℝ) in Ioo a b, f x = ennreal.of_real (∫ x in Ioo a b, F x) :=
+    lintegral_coe_eq_integral _ intF,
+  rw A at hf,
+  have B : ∫ (x : ℝ) in Ioo a b, F x ≤ g b - g a,
+  { rw [← integral_Ioc_eq_integral_Ioo, ← interval_integral.integral_of_le hab.le],
+    apply integral_le_sub_of_has_deriv_right_of_le hab.le hcont hderiv _ (λ x hx, _),
+    { rwa integrable_on_Icc_iff_integrable_on_Ioo },
+    { convert nnreal.coe_le_coe.2 (fle x),
+      simp only [real.norm_of_nonneg (g'pos x hx), coe_nnnorm] } },
+  exact lt_irrefl _ (hf.trans_le (ennreal.of_real_le_of_real B)),
+end
+
+/-- When the derivative of a function is nonnegative, then it is automatically integrable,
+Ioc version. -/
+lemma integrable_on_deriv_of_nonneg (hcont : continuous_on g (Icc a b))
+  (hderiv : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
+  (g'pos : ∀ x ∈ Ioo a b, 0 ≤ g' x) :
+  integrable_on g' (Ioc a b) :=
+integrable_on_deriv_right_of_nonneg hcont (λ x hx, (hderiv x hx).has_deriv_within_at) g'pos
+
+/-- When the derivative of a function is nonnegative, then it is automatically integrable,
+interval version. -/
+theorem interval_integrable_deriv_of_nonneg (hcont : continuous_on g (uIcc a b))
+  (hderiv : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_at g (g' x) x)
+  (hpos : ∀ x ∈ Ioo (min a b) (max a b), 0 ≤ g' x) :
+  interval_integrable g' volume a b :=
+begin
+  cases le_total a b with hab hab,
+  { simp only [uIcc_of_le, min_eq_left, max_eq_right, hab, interval_integrable,
+      hab, Ioc_eq_empty_of_le, integrable_on_empty, and_true] at hcont hderiv hpos ⊢,
+    exact integrable_on_deriv_of_nonneg hcont hderiv hpos, },
+  { simp only [uIcc_of_ge, min_eq_right, max_eq_left, hab, interval_integrable,
+      Ioc_eq_empty_of_le, integrable_on_empty, true_and] at hcont hderiv hpos ⊢,
+    exact integrable_on_deriv_of_nonneg hcont hderiv hpos }
+end
+
+/-!
+### Integration by parts
+-/
+
+section parts
+
+variables [normed_ring A] [normed_algebra ℝ A] [complete_space A]
+
+theorem integral_deriv_mul_eq_sub {u v u' v' : ℝ → A}
+  (hu : ∀ x ∈ uIcc a b, has_deriv_at u (u' x) x)
+  (hv : ∀ x ∈ uIcc a b, has_deriv_at v (v' x) x)
+  (hu' : interval_integrable u' volume a b) (hv' : interval_integrable v' volume a b) :
+  ∫ x in a..b, u' x * v x + u x * v' x = u b * v b - u a * v a :=
+integral_eq_sub_of_has_deriv_at (λ x hx, (hu x hx).mul (hv x hx)) $
+  (hu'.mul_continuous_on (has_deriv_at.continuous_on hv)).add
+    (hv'.continuous_on_mul ((has_deriv_at.continuous_on hu)))
+
+theorem integral_mul_deriv_eq_deriv_mul {u v u' v' : ℝ → A}
+  (hu : ∀ x ∈ uIcc a b, has_deriv_at u (u' x) x)
+  (hv : ∀ x ∈ uIcc a b, has_deriv_at v (v' x) x)
+  (hu' : interval_integrable u' volume a b) (hv' : interval_integrable v' volume a b) :
+  ∫ x in a..b, u x * v' x = u b * v b - u a * v a - ∫ x in a..b, u' x * v x :=
+begin
+  rw [← integral_deriv_mul_eq_sub hu hv hu' hv', ← integral_sub],
+  { exact integral_congr (λ x hx, by simp only [add_sub_cancel']) },
+  { exact ((hu'.mul_continuous_on (has_deriv_at.continuous_on hv)).add
+      (hv'.continuous_on_mul (has_deriv_at.continuous_on hu))) },
+  { exact hu'.mul_continuous_on (has_deriv_at.continuous_on hv) },
+end
+
+end parts
+
+/-!
+### Integration by substitution / Change of variables
+-/
+
+section smul
+
+/--
+Change of variables, general form. If `f` is continuous on `[a, b]` and has
+right-derivative `f'` in `(a, b)`, `g` is continuous on `f '' (a, b)` and integrable on
+`f '' [a, b]`, and `f' x • (g ∘ f) x` is integrable on `[a, b]`,
+then we can substitute `u = f x` to get `∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
+-/
+theorem integral_comp_smul_deriv''' {f f' : ℝ → ℝ} {g : ℝ → E}
+  (hf : continuous_on f [a, b])
+  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hg_cont : continuous_on g (f '' Ioo (min a b) (max a b)))
+  (hg1 : integrable_on g (f '' [a, b]) )
+  (hg2 : integrable_on (λ x, f'(x) • (g ∘ f) x) [a, b]) :
+  ∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u :=
+begin
+  rw [hf.image_uIcc, ←interval_integrable_iff'] at hg1,
+  have h_cont : continuous_on (λ u, ∫ t in f a..f u, g t) [a, b],
+  { refine (continuous_on_primitive_interval' hg1 _).comp hf _,
+    { rw ← hf.image_uIcc, exact mem_image_of_mem f left_mem_uIcc },
+    { rw ← hf.image_uIcc, exact maps_to_image _ _ } },
+  have h_der : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at
+    (λ u, ∫ t in f a..f u, g t) (f' x • ((g ∘ f) x)) (Ioi x) x,
+  { intros x hx,
+    obtain ⟨c, hc⟩ := nonempty_Ioo.mpr hx.1,
+    obtain ⟨d, hd⟩ := nonempty_Ioo.mpr hx.2,
+    have cdsub : [c, d] ⊆ Ioo (min a b) (max a b),
+    { rw uIcc_of_le (hc.2.trans hd.1).le, exact Icc_subset_Ioo hc.1 hd.2 },
+    replace hg_cont := hg_cont.mono (image_subset f cdsub),
+    let J := [Inf (f '' [c, d]), Sup (f '' [c, d])],
+    have hJ : f '' [c, d] = J := (hf.mono (cdsub.trans Ioo_subset_Icc_self)).image_uIcc,
+    rw hJ at hg_cont,
+    have h2x : f x ∈ J, { rw ←hJ, exact mem_image_of_mem _ (mem_uIcc_of_le hc.2.le hd.1.le), },
+    have h2g : interval_integrable g volume (f a) (f x),
+    { refine hg1.mono_set _,
+      rw ←hf.image_uIcc,
+      exact hf.surj_on_uIcc left_mem_uIcc (Ioo_subset_Icc_self hx) },
+    have h3g := hg_cont.strongly_measurable_at_filter_nhds_within measurable_set_Icc (f x),
+    haveI : fact (f x ∈ J) := ⟨h2x⟩,
+    have : has_deriv_within_at (λ u, ∫ x in f a..u, g x) (g (f x)) J (f x) :=
+      interval_integral.integral_has_deriv_within_at_right h2g h3g (hg_cont (f x) h2x),
+    refine (this.scomp x ((hff' x hx).Ioo_of_Ioi hd.1) _).Ioi_of_Ioo hd.1,
+    rw ←hJ,
+    refine (maps_to_image _ _).mono _ subset.rfl,
+    exact Ioo_subset_Icc_self.trans ((Icc_subset_Icc_left hc.2.le).trans Icc_subset_uIcc) },
+  rw ←interval_integrable_iff' at hg2,
+  simp_rw [integral_eq_sub_of_has_deriv_right h_cont h_der hg2, integral_same, sub_zero],
+end
+
+/--
+Change of variables for continuous integrands. If `f` is continuous on `[a, b]` and has
+continuous right-derivative `f'` in `(a, b)`, and `g` is continuous on `f '' [a, b]` then we can
+substitute `u = f x` to get `∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
+-/
+theorem integral_comp_smul_deriv'' {f f' : ℝ → ℝ} {g : ℝ → E}
+  (hf : continuous_on f [a, b])
+  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hf' : continuous_on f' [a, b])
+  (hg : continuous_on g (f '' [a, b])) :
+  ∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u :=
+begin
+  refine integral_comp_smul_deriv''' hf hff'
+    (hg.mono $ image_subset _ Ioo_subset_Icc_self) _
+    (hf'.smul (hg.comp hf $ subset_preimage_image f _)).integrable_on_Icc,
+  rw hf.image_uIcc at hg ⊢,
+  exact hg.integrable_on_Icc,
+end
+
+/--
+Change of variables. If `f` is has continuous derivative `f'` on `[a, b]`,
+and `g` is continuous on `f '' [a, b]`, then we can substitute `u = f x` to get
+`∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
+Compared to `interval_integral.integral_comp_smul_deriv` we only require that `g` is continuous on
+`f '' [a, b]`.
+-/
+theorem integral_comp_smul_deriv' {f f' : ℝ → ℝ} {g : ℝ → E}
+  (h : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (h' : continuous_on f' (uIcc a b)) (hg : continuous_on g (f '' [a, b])) :
+  ∫ x in a..b, f' x • (g ∘ f) x = ∫ x in f a..f b, g x :=
+integral_comp_smul_deriv'' (λ x hx, (h x hx).continuous_at.continuous_within_at)
+  (λ x hx, (h x $ Ioo_subset_Icc_self hx).has_deriv_within_at) h' hg
+
+/--
+Change of variables, most common version. If `f` is has continuous derivative `f'` on `[a, b]`,
+and `g` is continuous, then we can substitute `u = f x` to get
+`∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
+-/
+theorem integral_comp_smul_deriv {f f' : ℝ → ℝ} {g : ℝ → E}
+  (h : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (h' : continuous_on f' (uIcc a b)) (hg : continuous g) :
+  ∫ x in a..b, f' x • (g ∘ f) x = ∫ x in f a..f b, g x :=
+integral_comp_smul_deriv' h h' hg.continuous_on
+
+theorem integral_deriv_comp_smul_deriv' {f f' : ℝ → ℝ} {g g' : ℝ → E}
+  (hf : continuous_on f [a, b])
+  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hf' : continuous_on f' [a, b])
+  (hg : continuous_on g [f a, f b])
+  (hgg' : ∀ x ∈ Ioo (min (f a) (f b)) (max (f a) (f b)), has_deriv_within_at g (g' x) (Ioi x) x)
+  (hg' : continuous_on g' (f '' [a, b])) :
+  ∫ x in a..b, f' x • (g' ∘ f) x = (g ∘ f) b - (g ∘ f) a :=
+begin
+  rw [integral_comp_smul_deriv'' hf hff' hf' hg',
+  integral_eq_sub_of_has_deriv_right hg hgg' (hg'.mono _).interval_integrable],
+  exact intermediate_value_uIcc hf
+end
+
+theorem integral_deriv_comp_smul_deriv {f f' : ℝ → ℝ} {g g' : ℝ → E}
+  (hf : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (hg : ∀ x ∈ uIcc a b, has_deriv_at g (g' (f x)) (f x))
+  (hf' : continuous_on f' (uIcc a b)) (hg' : continuous g') :
+  ∫ x in a..b, f' x • (g' ∘ f) x = (g ∘ f) b - (g ∘ f) a :=
+integral_eq_sub_of_has_deriv_at (λ x hx, (hg x hx).scomp x $ hf x hx)
+  (hf'.smul (hg'.comp_continuous_on $ has_deriv_at.continuous_on hf)).interval_integrable
+
+end smul
+section mul
+
+/--
+Change of variables, general form for scalar functions. If `f` is continuous on `[a, b]` and has
+continuous right-derivative `f'` in `(a, b)`, `g` is continuous on `f '' (a, b)` and integrable on
+`f '' [a, b]`, and `(g ∘ f) x * f' x` is integrable on `[a, b]`, then we can substitute `u = f x`
+to get `∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
+-/
+theorem integral_comp_mul_deriv''' {a b : ℝ} {f f' : ℝ → ℝ} {g : ℝ → ℝ}
+  (hf : continuous_on f [a, b])
+  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hg_cont : continuous_on g (f '' Ioo (min a b) (max a b)))
+  (hg1 : integrable_on g (f '' [a, b]) )
+  (hg2 : integrable_on (λ x, (g ∘ f) x * f' x) [a, b]) :
+  ∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u :=
+begin
+  have hg2' : integrable_on (λ x, f' x • (g ∘ f) x) [a, b] := by simpa [mul_comm] using hg2,
+  simpa [mul_comm] using integral_comp_smul_deriv''' hf hff' hg_cont hg1 hg2',
+end
+
+/--
+Change of variables for continuous integrands. If `f` is continuous on `[a, b]` and has
+continuous right-derivative `f'` in `(a, b)`, and `g` is continuous on `f '' [a, b]` then we can
+substitute `u = f x` to get `∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
+-/
+theorem integral_comp_mul_deriv'' {f f' g : ℝ → ℝ}
+  (hf : continuous_on f [a, b])
+  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hf' : continuous_on f' [a, b])
+  (hg : continuous_on g (f '' [a, b])) :
+  ∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u :=
+by simpa [mul_comm] using integral_comp_smul_deriv'' hf hff' hf' hg
+
+/--
+Change of variables. If `f` is has continuous derivative `f'` on `[a, b]`,
+and `g` is continuous on `f '' [a, b]`, then we can substitute `u = f x` to get
+`∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
+Compared to `interval_integral.integral_comp_mul_deriv` we only require that `g` is continuous on
+`f '' [a, b]`.
+-/
+theorem integral_comp_mul_deriv' {f f' g : ℝ → ℝ}
+  (h : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (h' : continuous_on f' (uIcc a b)) (hg : continuous_on g (f '' [a, b])) :
+  ∫ x in a..b, (g ∘ f) x * f' x = ∫ x in f a..f b, g x :=
+by simpa [mul_comm] using integral_comp_smul_deriv' h h' hg
+
+/--
+Change of variables, most common version. If `f` is has continuous derivative `f'` on `[a, b]`,
+and `g` is continuous, then we can substitute `u = f x` to get
+`∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
+-/
+theorem integral_comp_mul_deriv {f f' g : ℝ → ℝ}
+  (h : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (h' : continuous_on f' (uIcc a b)) (hg : continuous g) :
+  ∫ x in a..b, (g ∘ f) x * f' x = ∫ x in f a..f b, g x :=
+integral_comp_mul_deriv' h h' hg.continuous_on
+
+theorem integral_deriv_comp_mul_deriv' {f f' g g' : ℝ → ℝ}
+  (hf : continuous_on f [a, b])
+  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
+  (hf' : continuous_on f' [a, b])
+  (hg : continuous_on g [f a, f b])
+  (hgg' : ∀ x ∈ Ioo (min (f a) (f b)) (max (f a) (f b)), has_deriv_within_at g (g' x) (Ioi x) x)
+  (hg' : continuous_on g' (f '' [a, b])) :
+  ∫ x in a..b, (g' ∘ f) x * f' x = (g ∘ f) b - (g ∘ f) a :=
+by simpa [mul_comm] using integral_deriv_comp_smul_deriv' hf hff' hf' hg hgg' hg'
+
+theorem integral_deriv_comp_mul_deriv {f f' g g' : ℝ → ℝ}
+  (hf : ∀ x ∈ uIcc a b, has_deriv_at f (f' x) x)
+  (hg : ∀ x ∈ uIcc a b, has_deriv_at g (g' (f x)) (f x))
+  (hf' : continuous_on f' (uIcc a b)) (hg' : continuous g') :
+  ∫ x in a..b, (g' ∘ f) x * f' x = (g ∘ f) b - (g ∘ f) a :=
+by simpa [mul_comm] using integral_deriv_comp_smul_deriv hf hg hf' hg'
+
+end mul
+
+end interval_integral
diff --git a/src/measure_theory/integral/integrable_on.lean b/src/measure_theory/integral/integrable_on.lean
index a5248839a5e5c..63a9af38d5522 100644
--- a/src/measure_theory/integral/integrable_on.lean
+++ b/src/measure_theory/integral/integrable_on.lean
@@ -9,6 +9,9 @@ import analysis.normed_space.indicator_function
 
 /-! # Functions integrable on a set and at a filter
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `integrable_on f s μ := integrable f (μ.restrict s)` and prove theorems like
 `integrable_on_union : integrable_on f (s ∪ t) μ ↔ integrable_on f s μ ∧ integrable_on f t μ`.
 
@@ -21,7 +24,7 @@ at `l`.
 
 noncomputable theory
 open set filter topological_space measure_theory function
-open_locale classical topological_space interval big_operators filter ennreal measure_theory
+open_locale classical topology interval big_operators filter ennreal measure_theory
 
 variables {α β E F : Type*} [measurable_space α]
 
@@ -65,15 +68,15 @@ end
 
 namespace measure_theory
 
-section normed_group
+section normed_add_comm_group
 
-lemma has_finite_integral_restrict_of_bounded [normed_group E] {f : α → E} {s : set α}
-  {μ : measure α} {C}  (hs : μ s < ∞) (hf : ∀ᵐ x ∂(μ.restrict s), ∥f x∥ ≤ C) :
+lemma has_finite_integral_restrict_of_bounded [normed_add_comm_group E] {f : α → E} {s : set α}
+  {μ : measure α} {C}  (hs : μ s < ∞) (hf : ∀ᵐ x ∂(μ.restrict s), ‖f x‖ ≤ C) :
   has_finite_integral f (μ.restrict s) :=
 by haveI : is_finite_measure (μ.restrict s) := ⟨by rwa [measure.restrict_apply_univ]⟩;
   exact has_finite_integral_of_bounded hf
 
-variables [normed_group E] {f g : α → E} {s t : set α} {μ ν : measure α}
+variables [normed_add_comm_group E] {f g : α → E} {s t : set α} {μ ν : measure α}
 
 /-- A function is `integrable_on` a set `s` if it is almost everywhere strongly measurable on `s`
 and if the integral of its pointwise norm over `s` is less than infinity. -/
@@ -114,21 +117,26 @@ lemma integrable_on.congr_set_ae (h : integrable_on f t μ) (hst : s =ᵐ[μ] t)
   integrable_on f s μ :=
 h.mono_set_ae hst.le
 
-lemma integrable_on.congr_fun' (h : integrable_on f s μ) (hst : f =ᵐ[μ.restrict s] g) :
+lemma integrable_on.congr_fun_ae (h : integrable_on f s μ) (hst : f =ᵐ[μ.restrict s] g) :
   integrable_on g s μ :=
 integrable.congr h hst
 
+lemma integrable_on_congr_fun_ae (hst : f =ᵐ[μ.restrict s] g) :
+  integrable_on f s μ ↔ integrable_on g s μ :=
+⟨λ h, h.congr_fun_ae hst, λ h, h.congr_fun_ae hst.symm⟩
+
 lemma integrable_on.congr_fun (h : integrable_on f s μ) (hst : eq_on f g s)
   (hs : measurable_set s) :
   integrable_on g s μ :=
-h.congr_fun' ((ae_restrict_iff' hs).2 (eventually_of_forall hst))
+h.congr_fun_ae ((ae_restrict_iff' hs).2 (eventually_of_forall hst))
+
+lemma integrable_on_congr_fun (hst : eq_on f g s) (hs : measurable_set s) :
+  integrable_on f s μ ↔ integrable_on g s μ :=
+⟨λ h, h.congr_fun hst hs, λ h, h.congr_fun hst.symm hs⟩
 
 lemma integrable.integrable_on (h : integrable f μ) : integrable_on f s μ :=
 h.mono_measure $ measure.restrict_le_self
 
-lemma integrable.integrable_on' (h : integrable f (μ.restrict s)) : integrable_on f s μ :=
-h
-
 lemma integrable_on.restrict (h : integrable_on f s μ) (hs : measurable_set s) :
   integrable_on f s (μ.restrict t) :=
 by { rw [integrable_on, measure.restrict_restrict hs], exact h.mono_set (inter_subset_left _ _) }
@@ -157,7 +165,7 @@ begin
   simp,
 end
 
-@[simp] lemma integrable_on_finite_Union {s : set β} (hs : finite s)
+@[simp] lemma integrable_on_finite_bUnion {s : set β} (hs : s.finite)
   {t : β → set α} : integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
 begin
   apply hs.induction_on,
@@ -167,11 +175,12 @@ end
 
 @[simp] lemma integrable_on_finset_Union {s : finset β} {t : β → set α} :
   integrable_on f (⋃ i ∈ s, t i) μ ↔ ∀ i ∈ s, integrable_on f (t i) μ :=
-integrable_on_finite_Union s.finite_to_set
+integrable_on_finite_bUnion s.finite_to_set
 
-@[simp] lemma integrable_on_fintype_Union [fintype β] {t : β → set α} :
+@[simp] lemma integrable_on_finite_Union [finite β] {t : β → set α} :
   integrable_on f (⋃ i, t i) μ ↔ ∀ i, integrable_on f (t i) μ :=
-by simpa using @integrable_on_finset_Union _ _ _ _ _ f μ finset.univ t
+by { casesI nonempty_fintype β,
+  simpa using @integrable_on_finset_Union _ _ _ _ _ f μ finset.univ t }
 
 lemma integrable_on.add_measure (hμ : integrable_on f s μ) (hν : integrable_on f s ν) :
   integrable_on f s (μ + ν) :=
@@ -208,15 +217,19 @@ lemma integrable_indicator_iff (hs : measurable_set s) :
 by simp [integrable_on, integrable, has_finite_integral, nnnorm_indicator_eq_indicator_nnnorm,
   ennreal.coe_indicator, lintegral_indicator _ hs, ae_strongly_measurable_indicator_iff hs]
 
-lemma integrable_on.indicator (h : integrable_on f s μ) (hs : measurable_set s) :
+lemma integrable_on.integrable_indicator (h : integrable_on f s μ) (hs : measurable_set s) :
   integrable (indicator s f) μ :=
 (integrable_indicator_iff hs).2 h
 
 lemma integrable.indicator (h : integrable f μ) (hs : measurable_set s) :
   integrable (indicator s f) μ :=
-h.integrable_on.indicator hs
+h.integrable_on.integrable_indicator hs
 
-lemma integrable_indicator_const_Lp {E} [normed_group E]
+lemma integrable_on.indicator (h : integrable_on f s μ) (ht : measurable_set t) :
+  integrable_on (indicator t f) s μ :=
+integrable.indicator h ht
+
+lemma integrable_indicator_const_Lp {E} [normed_add_comm_group E]
   {p : ℝ≥0∞} {s : set α} (hs : measurable_set s) (hμs : μ s ≠ ∞) (c : E) :
   integrable (indicator_const_Lp p hs hμs c) μ :=
 begin
@@ -226,15 +239,86 @@ begin
   simpa only [set.univ_inter, measurable_set.univ, measure.restrict_apply] using hμs,
 end
 
-lemma integrable_on_iff_integable_of_support_subset {f : α → E} {s : set α}
-  (h1s : support f ⊆ s) (h2s : measurable_set s) :
+/-- If a function is integrable on a set `s` and nonzero there, then the measurable hull of `s` is
+well behaved: the restriction of the measure to `to_measurable μ s` coincides with its restriction
+to `s`. -/
+lemma integrable_on.restrict_to_measurable (hf : integrable_on f s μ) (h's : ∀ x ∈ s, f x ≠ 0) :
+  μ.restrict (to_measurable μ s) = μ.restrict s :=
+begin
+  rcases exists_seq_strict_anti_tendsto (0 : ℝ) with ⟨u, u_anti, u_pos, u_lim⟩,
+  let v := λ n, to_measurable (μ.restrict s) {x | u n ≤ ‖f x‖},
+  have A : ∀ n, μ (s ∩ v n) ≠ ∞,
+  { assume n,
+    rw [inter_comm, ← measure.restrict_apply (measurable_set_to_measurable _ _),
+      measure_to_measurable],
+    exact (hf.measure_ge_lt_top (u_pos n)).ne },
+  apply measure.restrict_to_measurable_of_cover _ A,
+  assume x hx,
+  have : 0 < ‖f x‖, by simp only [h's x hx, norm_pos_iff, ne.def, not_false_iff],
+  obtain ⟨n, hn⟩ : ∃ n, u n < ‖f x‖, from ((tendsto_order.1 u_lim).2 _ this).exists,
+  refine mem_Union.2 ⟨n, _⟩,
+  exact subset_to_measurable _ _ hn.le
+end
+
+/-- If a function is integrable on a set `s`, and vanishes on `t \ s`, then it is integrable on `t`
+if `t` is null-measurable. -/
+lemma integrable_on.of_ae_diff_eq_zero (hf : integrable_on f s μ)
+  (ht : null_measurable_set t μ) (h't : ∀ᵐ x ∂μ, x ∈ t \ s → f x = 0) :
+  integrable_on f t μ :=
+begin
+  let u := {x ∈ s | f x ≠ 0},
+  have hu : integrable_on f u μ := hf.mono_set (λ x hx, hx.1),
+  let v := to_measurable μ u,
+  have A : integrable_on f v μ,
+  { rw [integrable_on, hu.restrict_to_measurable],
+    { exact hu },
+    { assume x hx, exact hx.2 } },
+  have B : integrable_on f (t \ v) μ,
+  { apply integrable_on_zero.congr,
+    filter_upwards [ae_restrict_of_ae h't, ae_restrict_mem₀
+      (ht.diff (measurable_set_to_measurable μ u).null_measurable_set)] with x hxt hx,
+    by_cases h'x : x ∈ s,
+    { by_contra H,
+      exact hx.2 (subset_to_measurable μ u ⟨h'x, ne.symm H⟩) },
+    { exact (hxt ⟨hx.1, h'x⟩).symm, } },
+  apply (A.union B).mono_set _,
+  rw union_diff_self,
+  exact subset_union_right _ _
+end
+
+/-- If a function is integrable on a set `s`, and vanishes on `t \ s`, then it is integrable on `t`
+if `t` is measurable. -/
+lemma integrable_on.of_forall_diff_eq_zero (hf : integrable_on f s μ)
+  (ht : measurable_set t) (h't : ∀ x ∈ t \ s, f x = 0) :
+  integrable_on f t μ :=
+hf.of_ae_diff_eq_zero ht.null_measurable_set (eventually_of_forall h't)
+
+/-- If a function is integrable on a set `s` and vanishes almost everywhere on its complement,
+then it is integrable. -/
+lemma integrable_on.integrable_of_ae_not_mem_eq_zero (hf : integrable_on f s μ)
+  (h't : ∀ᵐ x ∂μ, x ∉ s → f x = 0) : integrable f μ :=
+begin
+  rw ← integrable_on_univ,
+  apply hf.of_ae_diff_eq_zero null_measurable_set_univ,
+  filter_upwards [h't] with x hx h'x using hx h'x.2,
+end
+
+/-- If a function is integrable on a set `s` and vanishes everywhere on its complement,
+then it is integrable. -/
+lemma integrable_on.integrable_of_forall_not_mem_eq_zero (hf : integrable_on f s μ)
+  (h't : ∀ x ∉ s, f x = 0) : integrable f μ :=
+hf.integrable_of_ae_not_mem_eq_zero (eventually_of_forall (λ x hx, h't x hx))
+
+lemma integrable_on_iff_integrable_of_support_subset (h1s : support f ⊆ s) :
   integrable_on f s μ ↔ integrable f μ :=
 begin
   refine ⟨λ h, _, λ h, h.integrable_on⟩,
-  rwa [← indicator_eq_self.2 h1s, integrable_indicator_iff h2s]
+  apply h.integrable_of_forall_not_mem_eq_zero (λ x hx, _),
+  contrapose! hx,
+  exact h1s (mem_support.2 hx),
 end
 
-lemma integrable_on_Lp_of_measure_ne_top {E} [normed_group E]
+lemma integrable_on_Lp_of_measure_ne_top {E} [normed_add_comm_group E]
   {p : ℝ≥0∞} {s : set α} (f : Lp E p μ) (hp : 1 ≤ p) (hμs : μ s ≠ ∞) :
   integrable_on f s μ :=
 begin
@@ -245,6 +329,16 @@ begin
   exact ((Lp.mem_ℒp _).restrict s).mem_ℒp_of_exponent_le hp,
 end
 
+lemma integrable.lintegral_lt_top {f : α → ℝ} (hf : integrable f μ) :
+  ∫⁻ x, ennreal.of_real (f x) ∂μ < ∞ :=
+calc ∫⁻ x, ennreal.of_real (f x) ∂μ
+    ≤ ∫⁻ x, ↑‖f x‖₊ ∂μ : lintegral_of_real_le_lintegral_nnnorm f
+... < ∞ : hf.2
+
+lemma integrable_on.set_lintegral_lt_top {f : α → ℝ} {s : set α} (hf : integrable_on f s μ) :
+  ∫⁻ x in s, ennreal.of_real (f x) ∂μ < ∞ :=
+integrable.lintegral_lt_top hf
+
 /-- We say that a function `f` is *integrable at filter* `l` if it is integrable on some
 set `s ∈ l`. Equivalently, it is eventually integrable on `s` in `l.small_sets`. -/
 def integrable_at_filter (f : α → E) (l : filter α) (μ : measure α . volume_tac) :=
@@ -252,6 +346,10 @@ def integrable_at_filter (f : α → E) (l : filter α) (μ : measure α . volum
 
 variables {l l' : filter α}
 
+lemma integrable.integrable_at_filter (h : integrable f μ) (l : filter α) :
+  integrable_at_filter f l μ :=
+⟨univ, filter.univ_mem, integrable_on_univ.2 h⟩
+
 protected lemma integrable_at_filter.eventually (h : integrable_at_filter f l μ) :
   ∀ᶠ s in l.small_sets, integrable_on f s μ :=
 iff.mpr (eventually_small_sets' $ λ s t hst ht, ht.mono_set hst) h
@@ -280,7 +378,7 @@ begin
   exact λ ⟨hv, ht⟩, ⟨hv, ⟨ht, hx⟩⟩
 end
 
-alias integrable_at_filter.inf_ae_iff ↔ measure_theory.integrable_at_filter.of_inf_ae _
+alias integrable_at_filter.inf_ae_iff ↔ integrable_at_filter.of_inf_ae _
 
 /-- If `μ` is a measure finite at filter `l` and `f` is a function such that its norm is bounded
 above at `l`, then `f` is integrable at `l`. -/
@@ -289,7 +387,7 @@ lemma measure.finite_at_filter.integrable_at_filter {l : filter α} [is_measurab
   (hf : l.is_bounded_under (≤) (norm ∘ f)) :
   integrable_at_filter f l μ :=
 begin
-  obtain ⟨C, hC⟩ : ∃ C, ∀ᶠ s in l.small_sets, ∀ x ∈ s, ∥f x∥ ≤ C,
+  obtain ⟨C, hC⟩ : ∃ C, ∀ᶠ s in l.small_sets, ∀ x ∈ s, ‖f x‖ ≤ C,
     from hf.imp (λ C hC, eventually_small_sets.2 ⟨_, hC, λ t, id⟩),
   rcases (hfm.eventually.and (hμ.eventually.and hC)).exists_measurable_mem_of_small_sets
     with ⟨s, hsl, hsm, hfm, hμ, hC⟩,
@@ -307,7 +405,7 @@ lemma measure.finite_at_filter.integrable_at_filter_of_tendsto_ae
   hf.norm.is_bounded_under_le).of_inf_ae
 
 alias measure.finite_at_filter.integrable_at_filter_of_tendsto_ae ←
-  filter.tendsto.integrable_at_filter_ae
+  _root_.filter.tendsto.integrable_at_filter_ae
 
 lemma measure.finite_at_filter.integrable_at_filter_of_tendsto {l : filter α}
   [is_measurably_generated l] (hfm : strongly_measurable_at_filter f l μ)
@@ -315,7 +413,8 @@ lemma measure.finite_at_filter.integrable_at_filter_of_tendsto {l : filter α}
   integrable_at_filter f l μ :=
 hμ.integrable_at_filter hfm hf.norm.is_bounded_under_le
 
-alias measure.finite_at_filter.integrable_at_filter_of_tendsto ← filter.tendsto.integrable_at_filter
+alias measure.finite_at_filter.integrable_at_filter_of_tendsto ←
+  _root_.filter.tendsto.integrable_at_filter
 
 lemma integrable_add_of_disjoint {f g : α → E}
   (h : disjoint (support f) (support g)) (hf : strongly_measurable f) (hg : strongly_measurable g) :
@@ -326,13 +425,13 @@ begin
   { rw ← indicator_add_eq_right h, exact hfg.indicator hg.measurable_set_support }
 end
 
-end normed_group
+end normed_add_comm_group
 
 end measure_theory
 
 open measure_theory
 
-variables [normed_group E]
+variables [normed_add_comm_group E]
 
 /-- A function which is continuous on a set `s` is almost everywhere measurable with respect to
 `μ.restrict s`. -/
@@ -355,13 +454,13 @@ end
 /-- A function which is continuous on a separable set `s` is almost everywhere strongly measurable
 with respect to `μ.restrict s`. -/
 lemma continuous_on.ae_strongly_measurable_of_is_separable
-  [topological_space α] [metrizable_space α] [opens_measurable_space α]
-  [topological_space β] [metrizable_space β]
+  [topological_space α] [pseudo_metrizable_space α] [opens_measurable_space α]
+  [topological_space β] [pseudo_metrizable_space β]
   {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s)
   (h's : topological_space.is_separable s) :
   ae_strongly_measurable f (μ.restrict s) :=
 begin
-  letI := metrizable_space_metric α,
+  letI := pseudo_metrizable_space_pseudo_metric α,
   borelize β,
   rw ae_strongly_measurable_iff_ae_measurable_separable,
   refine ⟨hf.ae_measurable hs, f '' s, hf.is_separable_image h's, _⟩,
@@ -372,7 +471,7 @@ end
 respect to `μ.restrict s` when either the source space or the target space is second-countable. -/
 lemma continuous_on.ae_strongly_measurable
   [topological_space α] [topological_space β] [h : second_countable_topology_either α β]
-  [opens_measurable_space α] [metrizable_space β]
+  [opens_measurable_space α] [pseudo_metrizable_space β]
   {f : α → β} {s : set α} {μ : measure α} (hf : continuous_on f s) (hs : measurable_set s) :
   ae_strongly_measurable f (μ.restrict s) :=
 begin
@@ -389,8 +488,24 @@ begin
   { exact is_separable_of_separable_space _ }
 end
 
+/-- A function which is continuous on a compact set `s` is almost everywhere strongly measurable
+with respect to `μ.restrict s`. -/
+lemma continuous_on.ae_strongly_measurable_of_is_compact
+  [topological_space α] [opens_measurable_space α] [topological_space β] [pseudo_metrizable_space β]
+  {f : α → β} {s : set α} {μ : measure α}
+  (hf : continuous_on f s) (hs : is_compact s) (h's : measurable_set s) :
+  ae_strongly_measurable f (μ.restrict s) :=
+begin
+  letI := pseudo_metrizable_space_pseudo_metric β,
+  borelize β,
+  rw ae_strongly_measurable_iff_ae_measurable_separable,
+  refine ⟨hf.ae_measurable h's, f '' s, _, _⟩,
+  { exact (hs.image_of_continuous_on hf).is_separable },
+  { exact mem_of_superset (self_mem_ae_restrict h's) (subset_preimage_image _ _) }
+end
+
 lemma continuous_on.integrable_at_nhds_within_of_is_separable
-  [topological_space α] [metrizable_space α]
+  [topological_space α] [pseudo_metrizable_space α]
   [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
   {a : α} {t : set α} {f : α → E} (hft : continuous_on f t) (ht : measurable_set t)
   (h't : topological_space.is_separable t) (ha : a ∈ t) :
@@ -412,10 +527,20 @@ begin
     (μ.finite_at_nhds_within _ _),
 end
 
+lemma continuous.integrable_at_nhds
+  [topological_space α] [second_countable_topology_either α E]
+  [opens_measurable_space α] {μ : measure α} [is_locally_finite_measure μ]
+  {f : α → E} (hf : continuous f) (a : α) :
+  integrable_at_filter f (𝓝 a) μ :=
+begin
+  rw ← nhds_within_univ,
+  exact hf.continuous_on.integrable_at_nhds_within measurable_set.univ (mem_univ a),
+end
+
 /-- If a function is continuous on an open set `s`, then it is strongly measurable at the filter
 `𝓝 x` for all `x ∈ s` if either the source space or the target space is second-countable. -/
 lemma continuous_on.strongly_measurable_at_filter [topological_space α]
-  [opens_measurable_space α] [topological_space β] [metrizable_space β]
+  [opens_measurable_space α] [topological_space β] [pseudo_metrizable_space β]
   [second_countable_topology_either α β] {f : α → β} {s : set α} {μ : measure α}
   (hs : is_open s) (hf : continuous_on f s) :
   ∀ x ∈ s, strongly_measurable_at_filter f (𝓝 x) μ :=
@@ -428,7 +553,7 @@ lemma continuous_at.strongly_measurable_at_filter
 continuous_on.strongly_measurable_at_filter hs $ continuous_at.continuous_on hf
 
 lemma continuous.strongly_measurable_at_filter [topological_space α] [opens_measurable_space α]
-  [topological_space β] [metrizable_space β] [second_countable_topology_either α β]
+  [topological_space β] [pseudo_metrizable_space β] [second_countable_topology_either α β]
   {f : α → β} (hf : continuous f) (μ : measure α) (l : filter α) :
   strongly_measurable_at_filter f l μ :=
 hf.strongly_measurable.strongly_measurable_at_filter
@@ -436,8 +561,105 @@ hf.strongly_measurable.strongly_measurable_at_filter
 /-- If a function is continuous on a measurable set `s`, then it is measurable at the filter
   `𝓝[s] x` for all `x`. -/
 lemma continuous_on.strongly_measurable_at_filter_nhds_within {α β : Type*} [measurable_space α]
-  [topological_space α] [opens_measurable_space α] [topological_space β] [metrizable_space β]
+  [topological_space α] [opens_measurable_space α] [topological_space β] [pseudo_metrizable_space β]
   [second_countable_topology_either α β] {f : α → β} {s : set α} {μ : measure α}
   (hf : continuous_on f s) (hs : measurable_set s) (x : α) :
   strongly_measurable_at_filter f (𝓝[s] x) μ :=
 ⟨s, self_mem_nhds_within, hf.ae_strongly_measurable hs⟩
+
+/-! ### Lemmas about adding and removing interval boundaries
+
+The primed lemmas take explicit arguments about the measure being finite at the endpoint, while
+the unprimed ones use `[has_no_atoms μ]`.
+-/
+
+section partial_order
+
+variables [partial_order α] [measurable_singleton_class α]
+  {f : α → E} {μ : measure α} {a b : α}
+
+lemma integrable_on_Icc_iff_integrable_on_Ioc' (ha : μ {a} ≠ ∞) :
+  integrable_on f (Icc a b) μ ↔ integrable_on f (Ioc a b) μ :=
+begin
+  by_cases hab : a ≤ b,
+  { rw [←Ioc_union_left hab, integrable_on_union, eq_true_intro
+      (integrable_on_singleton_iff.mpr $ or.inr ha.lt_top), and_true] },
+  { rw [Icc_eq_empty hab, Ioc_eq_empty],
+    contrapose! hab,
+    exact hab.le }
+end
+
+lemma integrable_on_Icc_iff_integrable_on_Ico' (hb : μ {b} ≠ ∞) :
+  integrable_on f (Icc a b) μ ↔ integrable_on f (Ico a b) μ :=
+begin
+  by_cases hab : a ≤ b,
+  { rw [←Ico_union_right hab, integrable_on_union, eq_true_intro
+      (integrable_on_singleton_iff.mpr $ or.inr hb.lt_top), and_true] },
+  { rw [Icc_eq_empty hab, Ico_eq_empty],
+    contrapose! hab,
+    exact hab.le }
+end
+
+lemma integrable_on_Ico_iff_integrable_on_Ioo' (ha : μ {a} ≠ ∞) :
+  integrable_on f (Ico a b) μ ↔ integrable_on f (Ioo a b) μ :=
+begin
+  by_cases hab : a < b,
+  { rw [←Ioo_union_left hab, integrable_on_union, eq_true_intro
+      (integrable_on_singleton_iff.mpr $ or.inr ha.lt_top), and_true] },
+  { rw [Ioo_eq_empty hab, Ico_eq_empty hab] }
+end
+
+lemma integrable_on_Ioc_iff_integrable_on_Ioo' (hb : μ {b} ≠ ∞) :
+  integrable_on f (Ioc a b) μ ↔ integrable_on f (Ioo a b) μ :=
+begin
+  by_cases hab : a < b,
+  { rw [←Ioo_union_right hab, integrable_on_union, eq_true_intro
+      (integrable_on_singleton_iff.mpr $ or.inr hb.lt_top), and_true] },
+  { rw [Ioo_eq_empty hab, Ioc_eq_empty hab] }
+end
+
+lemma integrable_on_Icc_iff_integrable_on_Ioo' (ha : μ {a} ≠ ∞) (hb : μ {b} ≠ ∞) :
+  integrable_on f (Icc a b) μ ↔ integrable_on f (Ioo a b) μ :=
+by rw [integrable_on_Icc_iff_integrable_on_Ioc' ha, integrable_on_Ioc_iff_integrable_on_Ioo' hb]
+
+lemma integrable_on_Ici_iff_integrable_on_Ioi' (hb : μ {b} ≠ ∞) :
+  integrable_on f (Ici b) μ ↔ integrable_on f (Ioi b) μ :=
+by rw [←Ioi_union_left, integrable_on_union,
+  eq_true_intro (integrable_on_singleton_iff.mpr $ or.inr hb.lt_top), and_true]
+
+lemma integrable_on_Iic_iff_integrable_on_Iio' (hb : μ {b} ≠ ∞) :
+  integrable_on f (Iic b) μ ↔ integrable_on f (Iio b) μ :=
+by rw [←Iio_union_right, integrable_on_union,
+  eq_true_intro (integrable_on_singleton_iff.mpr $ or.inr hb.lt_top), and_true]
+
+variables [has_no_atoms μ]
+
+lemma integrable_on_Icc_iff_integrable_on_Ioc :
+  integrable_on f (Icc a b) μ ↔ integrable_on f (Ioc a b) μ :=
+integrable_on_Icc_iff_integrable_on_Ioc' (by { rw measure_singleton, exact ennreal.zero_ne_top })
+
+lemma integrable_on_Icc_iff_integrable_on_Ico :
+  integrable_on f (Icc a b) μ ↔ integrable_on f (Ico a b) μ :=
+integrable_on_Icc_iff_integrable_on_Ico' (by { rw measure_singleton, exact ennreal.zero_ne_top })
+
+lemma integrable_on_Ico_iff_integrable_on_Ioo :
+  integrable_on f (Ico a b) μ ↔ integrable_on f (Ioo a b) μ :=
+integrable_on_Ico_iff_integrable_on_Ioo' (by { rw measure_singleton, exact ennreal.zero_ne_top })
+
+lemma integrable_on_Ioc_iff_integrable_on_Ioo :
+  integrable_on f (Ioc a b) μ ↔ integrable_on f (Ioo a b) μ :=
+integrable_on_Ioc_iff_integrable_on_Ioo' (by { rw measure_singleton, exact ennreal.zero_ne_top })
+
+lemma integrable_on_Icc_iff_integrable_on_Ioo :
+  integrable_on f (Icc a b) μ ↔ integrable_on f (Ioo a b) μ :=
+by rw [integrable_on_Icc_iff_integrable_on_Ioc, integrable_on_Ioc_iff_integrable_on_Ioo]
+
+lemma integrable_on_Ici_iff_integrable_on_Ioi :
+  integrable_on f (Ici b) μ ↔ integrable_on f (Ioi b) μ :=
+integrable_on_Ici_iff_integrable_on_Ioi' (by { rw measure_singleton, exact ennreal.zero_ne_top })
+
+lemma integrable_on_Iic_iff_integrable_on_Iio :
+  integrable_on f (Iic b) μ ↔ integrable_on f (Iio b) μ :=
+integrable_on_Iic_iff_integrable_on_Iio' (by { rw measure_singleton, exact ennreal.zero_ne_top })
+
+end partial_order
diff --git a/src/measure_theory/integral/integral_eq_improper.lean b/src/measure_theory/integral/integral_eq_improper.lean
index 26970b5f6bb36..1cd7f2b271541 100644
--- a/src/measure_theory/integral/integral_eq_improper.lean
+++ b/src/measure_theory/integral/integral_eq_improper.lean
@@ -3,12 +3,18 @@ Copyright (c) 2021 Anatole Dedecker. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anatole Dedecker, Bhavik Mehta
 -/
-import measure_theory.integral.interval_integral
+import analysis.special_functions.pow.deriv
+import measure_theory.integral.fund_thm_calculus
 import order.filter.at_top_bot
+import measure_theory.function.jacobian
+import measure_theory.measure.haar.normed_space
 
 /-!
 # Links between an integral and its "improper" version
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In its current state, mathlib only knows how to talk about definite ("proper") integrals,
 in the sense that it treats integrals over `[x, +∞)` the same as it treats integrals over
 `[y, z]`. For example, the integral over `[1, +∞)` is **not** defined to be the limit of
@@ -43,17 +49,25 @@ as an `ae_cover` w.r.t. `μ.restrict (Iic b)`, instead of using `(λ x, Ioc x b)
   then `∫⁻ x in φ n, f x ∂μ` tends to `∫⁻ x, f x ∂μ` as `n` tends to `l`
 - `measure_theory.ae_cover.integrable_of_integral_norm_tendsto` : if `φ` is a `ae_cover μ l`,
   where `l` is a countably generated filter, if `f` is measurable and integrable on each `φ n`,
-  and if `∫ x in φ n, ∥f x∥ ∂μ` tends to some `I : ℝ` as n tends to `l`, then `f` is integrable
+  and if `∫ x in φ n, ‖f x‖ ∂μ` tends to some `I : ℝ` as n tends to `l`, then `f` is integrable
 - `measure_theory.ae_cover.integral_tendsto_of_countably_generated` : if `φ` is a `ae_cover μ l`,
   where `l` is a countably generated filter, and if `f` is measurable and integrable (globally),
   then `∫ x in φ n, f x ∂μ` tends to `∫ x, f x ∂μ` as `n` tends to `+∞`.
 
 We then specialize these lemmas to various use cases involving intervals, which are frequent
-in analysis.
+in analysis. In particular,
+- `measure_theory.integral_Ioi_of_has_deriv_at_of_tendsto` is a version of FTC-2 on the interval
+  `(a, +∞)`, giving the formula `∫ x in (a, +∞), g' x = l - g a` if `g'` is integrable and
+  `g` tends to `l` at `+∞`.
+- `measure_theory.integral_Ioi_of_has_deriv_at_of_nonneg` gives the same result assuming that
+  `g'` is nonnegative instead of integrable. Its automatic integrability in this context is proved
+  in `measure_theory.integrable_on_Ioi_deriv_of_nonneg`.
+- `measure_theory.integral_comp_smul_deriv_Ioi` is a version of the change of variables formula
+  on semi-infinite intervals.
 -/
 
 open measure_theory filter set topological_space
-open_locale ennreal nnreal topological_space
+open_locale ennreal nnreal topology
 
 namespace measure_theory
 
@@ -151,6 +165,100 @@ lemma ae_cover_Iio [no_max_order α] :
 
 end linear_order_α
 
+section finite_intervals
+
+variables [linear_order α] [topological_space α] [order_closed_topology α]
+  [opens_measurable_space α] {a b : ι → α} {A B : α}
+  (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B))
+
+lemma ae_cover_Ioo_of_Icc :
+  ae_cover (μ.restrict $ Ioo A B) l (λ i, Icc (a i) (b i)) :=
+{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
+    ae_of_all μ (λ x hx,
+    (ha.eventually $ eventually_le_nhds hx.left).mp $
+    (hb.eventually $ eventually_ge_nhds hx.right).mono $
+    λ i hbi hai, ⟨hai, hbi⟩)),
+  measurable := λ i, measurable_set_Icc, }
+
+lemma ae_cover_Ioo_of_Ico :
+  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ico (a i) (b i)) :=
+{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
+    ae_of_all μ (λ x hx,
+    (ha.eventually $ eventually_le_nhds hx.left).mp $
+    (hb.eventually $ eventually_gt_nhds hx.right).mono $
+    λ i hbi hai, ⟨hai, hbi⟩)),
+  measurable := λ i, measurable_set_Ico, }
+
+lemma ae_cover_Ioo_of_Ioc :
+  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ioc (a i) (b i)) :=
+{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
+    ae_of_all μ (λ x hx,
+    (ha.eventually $ eventually_lt_nhds hx.left).mp $
+    (hb.eventually $ eventually_ge_nhds hx.right).mono $
+    λ i hbi hai, ⟨hai, hbi⟩)),
+  measurable := λ i, measurable_set_Ioc, }
+
+lemma ae_cover_Ioo_of_Ioo :
+  ae_cover (μ.restrict $ Ioo A B) l (λ i, Ioo (a i) (b i)) :=
+{ ae_eventually_mem := (ae_restrict_iff' measurable_set_Ioo).mpr (
+    ae_of_all μ (λ x hx,
+    (ha.eventually $ eventually_lt_nhds hx.left).mp $
+    (hb.eventually $ eventually_gt_nhds hx.right).mono $
+    λ i hbi hai, ⟨hai, hbi⟩)),
+  measurable := λ i, measurable_set_Ioo, }
+
+variables [has_no_atoms μ]
+
+lemma ae_cover_Ioc_of_Icc (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ioc A B) l (λ i, Icc (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Icc ha hb]
+
+lemma ae_cover_Ioc_of_Ico (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ico (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Ico ha hb]
+
+lemma ae_cover_Ioc_of_Ioc (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ioc (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Ioc ha hb]
+
+lemma ae_cover_Ioc_of_Ioo (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ioc A B) l (λ i, Ioo (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ioc.symm, ae_cover_Ioo_of_Ioo ha hb]
+
+lemma ae_cover_Ico_of_Icc (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ico A B) l (λ i, Icc (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Icc ha hb]
+
+lemma ae_cover_Ico_of_Ico (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ico A B) l (λ i, Ico (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Ico ha hb]
+
+lemma ae_cover_Ico_of_Ioc (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ico A B) l (λ i, Ioc (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Ioc ha hb]
+
+lemma ae_cover_Ico_of_Ioo (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Ico A B) l (λ i, Ioo (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Ico.symm, ae_cover_Ioo_of_Ioo ha hb]
+
+lemma ae_cover_Icc_of_Icc (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Icc A B) l (λ i, Icc (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Icc ha hb]
+
+lemma ae_cover_Icc_of_Ico (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Icc A B) l (λ i, Ico (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Ico ha hb]
+
+lemma ae_cover_Icc_of_Ioc (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Icc A B) l (λ i, Ioc (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Ioc ha hb]
+
+lemma ae_cover_Icc_of_Ioo (ha : tendsto a l (𝓝 A)) (hb : tendsto b l (𝓝 B)) :
+  ae_cover (μ.restrict $ Icc A B) l (λ i, Ioo (a i) (b i)) :=
+by simp [measure.restrict_congr_set Ioo_ae_eq_Icc.symm, ae_cover_Ioo_of_Ioo ha hb]
+
+end finite_intervals
+
 lemma ae_cover.restrict {φ : ι → set α} (hφ : ae_cover μ l φ) {s : set α} :
   ae_cover (μ.restrict s) l φ :=
 { ae_eventually_mem := ae_restrict_of_ae hφ.ae_eventually_mem,
@@ -187,7 +295,7 @@ begin
     let ⟨i, hi⟩ := (hu.eventually hx).exists in mem_Union.mpr ⟨i, hi⟩
 end
 
-lemma ae_cover.ae_strongly_measurable {β : Type*} [topological_space β] [metrizable_space β]
+lemma ae_cover.ae_strongly_measurable {β : Type*} [topological_space β] [pseudo_metrizable_space β]
   [l.is_countably_generated] [l.ne_bot]
   {f : α → β} {φ : ι → set α} (hφ : ae_cover μ l φ)
   (hfm : ∀ i, ae_strongly_measurable f (μ.restrict $ φ i)) : ae_strongly_measurable f μ :=
@@ -209,16 +317,16 @@ lemma ae_cover.comp_tendsto {α ι ι' : Type*} [measurable_space α] {μ : meas
 { ae_eventually_mem := hφ.ae_eventually_mem.mono (λ x hx, hu.eventually hx),
   measurable := λ i, hφ.measurable (u i) }
 
-section ae_cover_Union_Inter_encodable
+section ae_cover_Union_Inter_countable
 
-variables {α ι : Type*} [encodable ι]
+variables {α ι : Type*} [countable ι]
   [measurable_space α] {μ : measure α}
 
 lemma ae_cover.bUnion_Iic_ae_cover [preorder ι] {φ : ι → set α} (hφ : ae_cover μ at_top φ) :
   ae_cover μ at_top (λ (n : ι), ⋃ k (h : k ∈ Iic n), φ k) :=
 { ae_eventually_mem := hφ.ae_eventually_mem.mono
     (λ x h, h.mono (λ i hi, mem_bUnion right_mem_Iic hi)),
-  measurable := λ i, measurable_set.bUnion (countable_encodable _) (λ n _, hφ.measurable n) }
+  measurable := λ i, measurable_set.bUnion (to_countable _) (λ n _, hφ.measurable n) }
 
 lemma ae_cover.bInter_Ici_ae_cover [semilattice_sup ι] [nonempty ι] {φ : ι → set α}
   (hφ : ae_cover μ at_top φ) : ae_cover μ at_top (λ (n : ι), ⋂ k (h : k ∈ Ici n), φ k) :=
@@ -231,9 +339,9 @@ lemma ae_cover.bInter_Ici_ae_cover [semilattice_sup ι] [nonempty ι] {φ : ι 
       intros j hj,
       exact mem_bInter (λ k hk, hi k (le_trans hj hk)),
     end,
-  measurable := λ i, measurable_set.bInter (countable_encodable _) (λ n _, hφ.measurable n) }
+  measurable := λ i, measurable_set.bInter (to_countable _) (λ n _, hφ.measurable n) }
 
-end ae_cover_Union_Inter_encodable
+end ae_cover_Union_Inter_countable
 
 section lintegral
 
@@ -291,11 +399,11 @@ end lintegral
 section integrable
 
 variables {α ι E : Type*} [measurable_space α] {μ : measure α} {l : filter ι}
-  [normed_group E]
+  [normed_add_comm_group E]
 
 lemma ae_cover.integrable_of_lintegral_nnnorm_bounded [l.ne_bot] [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (I : ℝ) (hfm : ae_strongly_measurable f μ)
-  (hbounded : ∀ᶠ i in l, ∫⁻ x in φ i, ∥f x∥₊ ∂μ ≤ ennreal.of_real I) :
+  (hbounded : ∀ᶠ i in l, ∫⁻ x in φ i, ‖f x‖₊ ∂μ ≤ ennreal.of_real I) :
   integrable f μ :=
 begin
   refine ⟨hfm, (le_of_tendsto _ hbounded).trans_lt ennreal.of_real_lt_top⟩,
@@ -305,7 +413,7 @@ end
 lemma ae_cover.integrable_of_lintegral_nnnorm_tendsto [l.ne_bot] [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (I : ℝ)
   (hfm : ae_strongly_measurable f μ)
-  (htendsto : tendsto (λ i, ∫⁻ x in φ i, ∥f x∥₊ ∂μ) l (𝓝 $ ennreal.of_real I)) :
+  (htendsto : tendsto (λ i, ∫⁻ x in φ i, ‖f x‖₊ ∂μ) l (𝓝 $ ennreal.of_real I)) :
   integrable f μ :=
 begin
   refine hφ.integrable_of_lintegral_nnnorm_bounded (max 1 (I + 1)) hfm _,
@@ -316,7 +424,7 @@ end
 
 lemma ae_cover.integrable_of_lintegral_nnnorm_bounded' [l.ne_bot] [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (I : ℝ≥0) (hfm : ae_strongly_measurable f μ)
-  (hbounded : ∀ᶠ i in l, ∫⁻ x in φ i, ∥f x∥₊ ∂μ ≤ I) :
+  (hbounded : ∀ᶠ i in l, ∫⁻ x in φ i, ‖f x‖₊ ∂μ ≤ I) :
   integrable f μ :=
 hφ.integrable_of_lintegral_nnnorm_bounded I hfm
   (by simpa only [ennreal.of_real_coe_nnreal] using hbounded)
@@ -324,7 +432,7 @@ hφ.integrable_of_lintegral_nnnorm_bounded I hfm
 lemma ae_cover.integrable_of_lintegral_nnnorm_tendsto' [l.ne_bot] [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (I : ℝ≥0)
   (hfm : ae_strongly_measurable f μ)
-  (htendsto : tendsto (λ i, ∫⁻ x in φ i, ∥f x∥₊ ∂μ) l (𝓝 I)) :
+  (htendsto : tendsto (λ i, ∫⁻ x in φ i, ‖f x‖₊ ∂μ) l (𝓝 I)) :
   integrable f μ :=
 hφ.integrable_of_lintegral_nnnorm_tendsto I hfm
   (by simpa only [ennreal.of_real_coe_nnreal] using htendsto)
@@ -332,7 +440,7 @@ hφ.integrable_of_lintegral_nnnorm_tendsto I hfm
 lemma ae_cover.integrable_of_integral_norm_bounded [l.ne_bot] [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E}
   (I : ℝ) (hfi : ∀ i, integrable_on f (φ i) μ)
-  (hbounded : ∀ᶠ i in l, ∫ x in φ i, ∥f x∥ ∂μ ≤ I) :
+  (hbounded : ∀ᶠ i in l, ∫ x in φ i, ‖f x‖ ∂μ ≤ I) :
   integrable f μ :=
 begin
   have hfm : ae_strongly_measurable f μ :=
@@ -350,7 +458,7 @@ end
 lemma ae_cover.integrable_of_integral_norm_tendsto [l.ne_bot] [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E}
   (I : ℝ) (hfi : ∀ i, integrable_on f (φ i) μ)
-  (htendsto : tendsto (λ i, ∫ x in φ i, ∥f x∥ ∂μ) l (𝓝 I)) :
+  (htendsto : tendsto (λ i, ∫ x in φ i, ‖f x‖ ∂μ) l (𝓝 I)) :
   integrable f μ :=
 let ⟨I', hI'⟩ := htendsto.is_bounded_under_le in hφ.integrable_of_integral_norm_bounded I' hfi hI'
 
@@ -375,14 +483,14 @@ end integrable
 section integral
 
 variables {α ι E : Type*} [measurable_space α] {μ : measure α} {l : filter ι}
-  [normed_group E] [normed_space ℝ E] [complete_space E]
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
 
 lemma ae_cover.integral_tendsto_of_countably_generated [l.is_countably_generated]
   {φ : ι → set α} (hφ : ae_cover μ l φ) {f : α → E} (hfi : integrable f μ) :
   tendsto (λ i, ∫ x in φ i, f x ∂μ) l (𝓝 $ ∫ x, f x ∂μ) :=
 suffices h : tendsto (λ i, ∫ (x : α), (φ i).indicator f x ∂μ) l (𝓝 (∫ (x : α), f x ∂μ)),
 by { convert h, ext n, rw integral_indicator (hφ.measurable n) },
-tendsto_integral_filter_of_dominated_convergence (λ x, ∥f x∥)
+tendsto_integral_filter_of_dominated_convergence (λ x, ‖f x‖)
   (eventually_of_forall $ λ i, hfi.ae_strongly_measurable.indicator $ hφ.measurable i)
   (eventually_of_forall $ λ i, ae_of_all _ $ λ x, norm_indicator_le_norm_self _ _)
   hfi.norm (hφ.ae_tendsto_indicator f)
@@ -411,13 +519,13 @@ section integrable_of_interval_integral
 
 variables {ι E : Type*} {μ : measure ℝ}
           {l : filter ι} [filter.ne_bot l] [is_countably_generated l]
-          [normed_group E]
+          [normed_add_comm_group E]
           {a b : ι → ℝ} {f : ℝ → E}
 
 lemma integrable_of_interval_integral_norm_bounded
   (I : ℝ) (hfi : ∀ i, integrable_on f (Ioc (a i) (b i)) μ)
   (ha : tendsto a l at_bot) (hb : tendsto b l at_top)
-  (h : ∀ᶠ i in l, ∫ x in a i .. b i, ∥f x∥ ∂μ ≤ I) :
+  (h : ∀ᶠ i in l, ∫ x in a i .. b i, ‖f x‖ ∂μ ≤ I) :
   integrable f μ :=
 begin
   have hφ : ae_cover μ l _ := ae_cover_Ioc ha hb,
@@ -427,17 +535,21 @@ begin
   rwa ←interval_integral.integral_of_le (hai.trans hbi)
 end
 
+/-- If `f` is integrable on intervals `Ioc (a i) (b i)`,
+where `a i` tends to -∞ and `b i` tends to ∞, and
+`∫ x in a i .. b i, ‖f x‖ ∂μ` converges to `I : ℝ` along a filter `l`,
+then `f` is integrable on the interval (-∞, ∞) -/
 lemma integrable_of_interval_integral_norm_tendsto
   (I : ℝ) (hfi : ∀ i, integrable_on f (Ioc (a i) (b i)) μ)
   (ha : tendsto a l at_bot) (hb : tendsto b l at_top)
-  (h : tendsto (λ i, ∫ x in a i .. b i, ∥f x∥ ∂μ) l (𝓝 I)) :
+  (h : tendsto (λ i, ∫ x in a i .. b i, ‖f x‖ ∂μ) l (𝓝 I)) :
   integrable f μ :=
 let ⟨I', hI'⟩ := h.is_bounded_under_le in
   integrable_of_interval_integral_norm_bounded I' hfi ha hb hI'
 
 lemma integrable_on_Iic_of_interval_integral_norm_bounded (I b : ℝ)
   (hfi : ∀ i, integrable_on f (Ioc (a i) b) μ) (ha : tendsto a l at_bot)
-  (h : ∀ᶠ i in l, (∫ x in a i .. b, ∥f x∥ ∂μ) ≤ I) :
+  (h : ∀ᶠ i in l, (∫ x in a i .. b, ‖f x‖ ∂μ) ≤ I) :
   integrable_on f (Iic b) μ :=
 begin
   have hφ : ae_cover (μ.restrict $ Iic b) l _ := ae_cover_Ioi ha,
@@ -451,16 +563,20 @@ begin
   exact id
 end
 
+/-- If `f` is integrable on intervals `Ioc (a i) b`,
+where `a i` tends to -∞, and
+`∫ x in a i .. b, ‖f x‖ ∂μ` converges to `I : ℝ` along a filter `l`,
+then `f` is integrable on the interval (-∞, b) -/
 lemma integrable_on_Iic_of_interval_integral_norm_tendsto (I b : ℝ)
   (hfi : ∀ i, integrable_on f (Ioc (a i) b) μ) (ha : tendsto a l at_bot)
-  (h : tendsto (λ i, ∫ x in a i .. b, ∥f x∥ ∂μ) l (𝓝 I)) :
+  (h : tendsto (λ i, ∫ x in a i .. b, ‖f x‖ ∂μ) l (𝓝 I)) :
   integrable_on f (Iic b) μ :=
 let ⟨I', hI'⟩ := h.is_bounded_under_le in
   integrable_on_Iic_of_interval_integral_norm_bounded I' b hfi ha hI'
 
 lemma integrable_on_Ioi_of_interval_integral_norm_bounded (I a : ℝ)
   (hfi : ∀ i, integrable_on f (Ioc a (b i)) μ) (hb : tendsto b l at_top)
-  (h : ∀ᶠ i in l, (∫ x in a .. b i, ∥f x∥ ∂μ) ≤ I) :
+  (h : ∀ᶠ i in l, (∫ x in a .. b i, ‖f x‖ ∂μ) ≤ I) :
   integrable_on f (Ioi a) μ :=
 begin
   have hφ : ae_cover (μ.restrict $ Ioi a) l _ := ae_cover_Iic hb,
@@ -475,20 +591,47 @@ begin
   exact id
 end
 
+/-- If `f` is integrable on intervals `Ioc a (b i)`,
+where `b i` tends to ∞, and
+`∫ x in a .. b i, ‖f x‖ ∂μ` converges to `I : ℝ` along a filter `l`,
+then `f` is integrable on the interval (a, ∞) -/
 lemma integrable_on_Ioi_of_interval_integral_norm_tendsto (I a : ℝ)
   (hfi : ∀ i, integrable_on f (Ioc a (b i)) μ) (hb : tendsto b l at_top)
-  (h : tendsto (λ i, ∫ x in a .. b i, ∥f x∥ ∂μ) l (𝓝 $ I)) :
+  (h : tendsto (λ i, ∫ x in a .. b i, ‖f x‖ ∂μ) l (𝓝 $ I)) :
   integrable_on f (Ioi a) μ :=
 let ⟨I', hI'⟩ := h.is_bounded_under_le in
   integrable_on_Ioi_of_interval_integral_norm_bounded I' a hfi hb hI'
 
+lemma integrable_on_Ioc_of_interval_integral_norm_bounded {I a₀ b₀ : ℝ}
+  (hfi : ∀ i, integrable_on f $ Ioc (a i) (b i))
+  (ha : tendsto a l $ 𝓝 a₀) (hb : tendsto b l $ 𝓝 b₀)
+  (h : ∀ᶠ i in l, (∫ x in Ioc (a i) (b i), ‖f x‖) ≤ I) : integrable_on f (Ioc a₀ b₀) :=
+begin
+  refine (ae_cover_Ioc_of_Ioc ha hb).integrable_of_integral_norm_bounded I
+    (λ i, (hfi i).restrict measurable_set_Ioc) (eventually.mono h _),
+  intros i hi, simp only [measure.restrict_restrict measurable_set_Ioc],
+  refine le_trans (set_integral_mono_set (hfi i).norm _ _) hi,
+  { apply ae_of_all, simp only [pi.zero_apply, norm_nonneg, forall_const] },
+  { apply ae_of_all, intros c hc, exact hc.1 },
+end
+
+lemma integrable_on_Ioc_of_interval_integral_norm_bounded_left {I a₀ b : ℝ}
+  (hfi : ∀ i, integrable_on f $ Ioc (a i) b) (ha : tendsto a l $ 𝓝 a₀)
+  (h : ∀ᶠ i in l, (∫ x in Ioc (a i) b, ‖f x‖) ≤ I) : integrable_on f (Ioc a₀ b) :=
+integrable_on_Ioc_of_interval_integral_norm_bounded hfi ha tendsto_const_nhds h
+
+lemma integrable_on_Ioc_of_interval_integral_norm_bounded_right {I a b₀ : ℝ}
+  (hfi : ∀ i, integrable_on f $ Ioc a (b i)) (hb : tendsto b l $ 𝓝 b₀)
+  (h : ∀ᶠ i in l, (∫ x in Ioc a (b i), ‖f x‖ ) ≤ I) : integrable_on f (Ioc a b₀) :=
+integrable_on_Ioc_of_interval_integral_norm_bounded hfi tendsto_const_nhds hb h
+
 end integrable_of_interval_integral
 
 section integral_of_interval_integral
 
 variables {ι E : Type*} {μ : measure ℝ}
           {l : filter ι} [is_countably_generated l]
-          [normed_group E] [normed_space ℝ E] [complete_space E]
+          [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
           {a b : ι → ℝ} {f : ℝ → E}
 
 lemma interval_integral_tendsto_integral
@@ -530,4 +673,322 @@ end
 
 end integral_of_interval_integral
 
+open real
+open_locale interval
+
+section Ioi_FTC
+
+variables {E : Type*} {f f' : ℝ → E} {g g' : ℝ → ℝ} {a b l : ℝ} {m : E}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+/-- **Fundamental theorem of calculus-2**, on semi-infinite intervals `(a, +∞)`.
+When a function has a limit at infinity `m`, and its derivative is integrable, then the
+integral of the derivative on `(a, +∞)` is `m - f a`. Version assuming differentiability
+on `(a, +∞)` and continuity on `[a, +∞)`.-/
+lemma integral_Ioi_of_has_deriv_at_of_tendsto (hcont : continuous_on f (Ici a))
+  (hderiv : ∀ x ∈ Ioi a, has_deriv_at f (f' x) x)
+  (f'int : integrable_on f' (Ioi a)) (hf : tendsto f at_top (𝓝 m)) :
+  ∫ x in Ioi a, f' x = m - f a :=
+begin
+  refine tendsto_nhds_unique (interval_integral_tendsto_integral_Ioi a f'int tendsto_id) _,
+  apply tendsto.congr' _ (hf.sub_const _),
+  filter_upwards [Ioi_mem_at_top a] with x hx,
+  have h'x : a ≤ id x := le_of_lt hx,
+  symmetry,
+  apply interval_integral.integral_eq_sub_of_has_deriv_at_of_le h'x
+    (hcont.mono Icc_subset_Ici_self) (λ y hy, hderiv y hy.1),
+  rw interval_integrable_iff_integrable_Ioc_of_le h'x,
+  exact f'int.mono (λ y hy, hy.1) le_rfl,
+end
+
+/-- **Fundamental theorem of calculus-2**, on semi-infinite intervals `(a, +∞)`.
+When a function has a limit at infinity `m`, and its derivative is integrable, then the
+integral of the derivative on `(a, +∞)` is `m - f a`. Version assuming differentiability
+on `[a, +∞)`. -/
+lemma integral_Ioi_of_has_deriv_at_of_tendsto'
+  (hderiv : ∀ x ∈ Ici a, has_deriv_at f (f' x) x)
+  (f'int : integrable_on f' (Ioi a)) (hf : tendsto f at_top (𝓝 m)) :
+  ∫ x in Ioi a, f' x = m - f a :=
+begin
+  apply integral_Ioi_of_has_deriv_at_of_tendsto _ (λ x hx, hderiv x (le_of_lt hx)) f'int hf,
+  assume x hx,
+  exact (hderiv x hx).continuous_at.continuous_within_at,
+end
+
+/-- When a function has a limit at infinity, and its derivative is nonnegative, then the derivative
+is automatically integrable on `(a, +∞)`. Version assuming differentiability
+on `(a, +∞)` and continuity on `[a, +∞)`. -/
+lemma integrable_on_Ioi_deriv_of_nonneg (hcont : continuous_on g (Ici a))
+  (hderiv : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
+  (g'pos : ∀ x ∈ Ioi a, 0 ≤ g' x) (hg : tendsto g at_top (𝓝 l)) :
+  integrable_on g' (Ioi a) :=
+begin
+  apply integrable_on_Ioi_of_interval_integral_norm_tendsto (l - g a) a (λ x, _) tendsto_id, swap,
+  { exact interval_integral.integrable_on_deriv_of_nonneg (hcont.mono Icc_subset_Ici_self)
+      (λ y hy, hderiv y hy.1) (λ y hy, g'pos y hy.1) },
+  apply tendsto.congr' _ (hg.sub_const _),
+  filter_upwards [Ioi_mem_at_top a] with x hx,
+  have h'x : a ≤ id x := le_of_lt hx,
+  calc g x - g a = ∫ y in a..id x, g' y :
+    begin
+      symmetry,
+      apply interval_integral.integral_eq_sub_of_has_deriv_at_of_le h'x
+        (hcont.mono Icc_subset_Ici_self) (λ y hy, hderiv y hy.1),
+      rw interval_integrable_iff_integrable_Ioc_of_le h'x,
+      exact interval_integral.integrable_on_deriv_of_nonneg (hcont.mono Icc_subset_Ici_self)
+        (λ y hy, hderiv y hy.1) (λ y hy, g'pos y hy.1)
+    end
+  ... = ∫ y in a..id x, ‖g' y‖ :
+    begin
+      simp_rw interval_integral.integral_of_le h'x,
+      refine set_integral_congr (measurable_set_Ioc) (λ y hy, _),
+      dsimp,
+      rw abs_of_nonneg,
+      exact g'pos _ hy.1,
+    end
+end
+
+/-- When a function has a limit at infinity, and its derivative is nonnegative, then the derivative
+is automatically integrable on `(a, +∞)`. Version assuming differentiability
+on `[a, +∞)`. -/
+lemma integrable_on_Ioi_deriv_of_nonneg'
+  (hderiv : ∀ x ∈ Ici a, has_deriv_at g (g' x) x)
+  (g'pos : ∀ x ∈ Ioi a, 0 ≤ g' x) (hg : tendsto g at_top (𝓝 l)) :
+  integrable_on g' (Ioi a) :=
+begin
+  apply integrable_on_Ioi_deriv_of_nonneg _ (λ x hx, hderiv x (le_of_lt hx)) g'pos hg,
+  assume x hx,
+  exact (hderiv x hx).continuous_at.continuous_within_at,
+end
+
+/-- When a function has a limit at infinity `l`, and its derivative is nonnegative, then the
+integral of the derivative on `(a, +∞)` is `l - g a` (and the derivative is integrable, see
+`integrable_on_Ioi_deriv_of_nonneg`). Version assuming differentiability on `(a, +∞)` and
+continuity on `[a, +∞)`. -/
+lemma integral_Ioi_of_has_deriv_at_of_nonneg (hcont : continuous_on g (Ici a))
+  (hderiv : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
+  (g'pos : ∀ x ∈ Ioi a, 0 ≤ g' x) (hg : tendsto g at_top (𝓝 l)) :
+  ∫ x in Ioi a, g' x = l - g a :=
+integral_Ioi_of_has_deriv_at_of_tendsto hcont hderiv
+  (integrable_on_Ioi_deriv_of_nonneg hcont hderiv g'pos hg) hg
+
+/-- When a function has a limit at infinity `l`, and its derivative is nonnegative, then the
+integral of the derivative on `(a, +∞)` is `l - g a` (and the derivative is integrable, see
+`integrable_on_Ioi_deriv_of_nonneg'`). Version assuming differentiability on `[a, +∞)`. -/
+lemma integral_Ioi_of_has_deriv_at_of_nonneg'
+  (hderiv : ∀ x ∈ Ici a, has_deriv_at g (g' x) x)
+  (g'pos : ∀ x ∈ Ioi a, 0 ≤ g' x) (hg : tendsto g at_top (𝓝 l)) :
+  ∫ x in Ioi a, g' x = l - g a :=
+integral_Ioi_of_has_deriv_at_of_tendsto' hderiv
+  (integrable_on_Ioi_deriv_of_nonneg' hderiv g'pos hg) hg
+
+/-- When a function has a limit at infinity, and its derivative is nonpositive, then the derivative
+is automatically integrable on `(a, +∞)`. Version assuming differentiability
+on `(a, +∞)` and continuity on `[a, +∞)`. -/
+lemma integrable_on_Ioi_deriv_of_nonpos (hcont : continuous_on g (Ici a))
+  (hderiv : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
+  (g'neg : ∀ x ∈ Ioi a, g' x ≤ 0) (hg : tendsto g at_top (𝓝 l)) :
+  integrable_on g' (Ioi a) :=
+begin
+  apply integrable_neg_iff.1,
+  exact integrable_on_Ioi_deriv_of_nonneg hcont.neg (λ x hx, (hderiv x hx).neg)
+    (λ x hx, neg_nonneg_of_nonpos (g'neg x hx)) hg.neg,
+end
+
+/-- When a function has a limit at infinity, and its derivative is nonpositive, then the derivative
+is automatically integrable on `(a, +∞)`. Version assuming differentiability
+on `[a, +∞)`. -/
+lemma integrable_on_Ioi_deriv_of_nonpos'
+  (hderiv : ∀ x ∈ Ici a, has_deriv_at g (g' x) x)
+  (g'neg : ∀ x ∈ Ioi a, g' x ≤ 0) (hg : tendsto g at_top (𝓝 l)) :
+  integrable_on g' (Ioi a) :=
+begin
+  apply integrable_on_Ioi_deriv_of_nonpos _ (λ x hx, hderiv x (le_of_lt hx)) g'neg hg,
+  assume x hx,
+  exact (hderiv x hx).continuous_at.continuous_within_at,
+end
+
+/-- When a function has a limit at infinity `l`, and its derivative is nonpositive, then the
+integral of the derivative on `(a, +∞)` is `l - g a` (and the derivative is integrable, see
+`integrable_on_Ioi_deriv_of_nonneg`). Version assuming differentiability on `(a, +∞)` and
+continuity on `[a, +∞)`. -/
+lemma integral_Ioi_of_has_deriv_at_of_nonpos (hcont : continuous_on g (Ici a))
+  (hderiv : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
+  (g'neg : ∀ x ∈ Ioi a, g' x ≤ 0) (hg : tendsto g at_top (𝓝 l)) :
+  ∫ x in Ioi a, g' x = l - g a :=
+integral_Ioi_of_has_deriv_at_of_tendsto hcont hderiv
+  (integrable_on_Ioi_deriv_of_nonpos hcont hderiv g'neg hg) hg
+
+/-- When a function has a limit at infinity `l`, and its derivative is nonpositive, then the
+integral of the derivative on `(a, +∞)` is `l - g a` (and the derivative is integrable, see
+`integrable_on_Ioi_deriv_of_nonneg'`). Version assuming differentiability on `[a, +∞)`. -/
+lemma integral_Ioi_of_has_deriv_at_of_nonpos'
+  (hderiv : ∀ x ∈ Ici a, has_deriv_at g (g' x) x)
+  (g'neg : ∀ x ∈ Ioi a, g' x ≤ 0) (hg : tendsto g at_top (𝓝 l)) :
+  ∫ x in Ioi a, g' x = l - g a :=
+integral_Ioi_of_has_deriv_at_of_tendsto' hderiv
+  (integrable_on_Ioi_deriv_of_nonpos' hderiv g'neg hg) hg
+
+end Ioi_FTC
+
+section Ioi_change_variables
+
+open real
+open_locale interval
+
+variables {E : Type*} {f : ℝ → E}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+/-- Change-of-variables formula for `Ioi` integrals of vector-valued functions, proved by taking
+limits from the result for finite intervals. -/
+lemma integral_comp_smul_deriv_Ioi {f f' : ℝ → ℝ} {g : ℝ → E} {a : ℝ}
+  (hf : continuous_on f $ Ici a)
+  (hft : tendsto f at_top at_top)
+  (hff' : ∀ x ∈ Ioi a, has_deriv_within_at f (f' x) (Ioi x) x)
+  (hg_cont : continuous_on g $ f '' Ioi a)
+  (hg1 : integrable_on g $ f '' Ici a)
+  (hg2 : integrable_on (λ x, f' x • (g ∘ f) x) (Ici a)) :
+  ∫ x in Ioi a, f' x • (g ∘ f) x = ∫ u in Ioi (f a), g u :=
+begin
+  have eq : ∀ b : ℝ, a < b → ∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a .. f b, g u,
+  { intros b hb,
+    have i1 : Ioo (min a b) (max a b) ⊆ Ioi a,
+    { rw min_eq_left hb.le, exact Ioo_subset_Ioi_self },
+    have i2 : [a, b] ⊆ Ici a,
+    { rw uIcc_of_le hb.le, exact Icc_subset_Ici_self },
+    refine interval_integral.integral_comp_smul_deriv''' (hf.mono i2)
+      (λ x hx, hff' x $ mem_of_mem_of_subset hx i1) (hg_cont.mono $ image_subset _ _)
+      (hg1.mono_set $ image_subset _ _) (hg2.mono_set i2),
+    { rw min_eq_left hb.le, exact Ioo_subset_Ioi_self },
+    { rw uIcc_of_le hb.le, exact Icc_subset_Ici_self } },
+  rw integrable_on_Ici_iff_integrable_on_Ioi at hg2,
+  have t2 := interval_integral_tendsto_integral_Ioi _ hg2 tendsto_id,
+  have : Ioi (f a) ⊆ f '' Ici a := (Ioi_subset_Ici_self.trans $
+    is_preconnected.intermediate_value_Ici is_preconnected_Ici left_mem_Ici
+    (le_principal_iff.mpr $ Ici_mem_at_top _) hf hft),
+  have t1 := (interval_integral_tendsto_integral_Ioi _ (hg1.mono_set this) tendsto_id).comp hft,
+  exact tendsto_nhds_unique (tendsto.congr' (eventually_eq_of_mem (Ioi_mem_at_top a) eq) t2) t1,
+end
+
+/-- Change-of-variables formula for `Ioi` integrals of scalar-valued functions -/
+lemma integral_comp_mul_deriv_Ioi {f f' : ℝ → ℝ} {g : ℝ → ℝ} {a : ℝ}
+  (hf : continuous_on f $ Ici a)
+  (hft : tendsto f at_top at_top)
+  (hff' : ∀ x ∈ Ioi a, has_deriv_within_at f (f' x) (Ioi x) x)
+  (hg_cont : continuous_on g $ f '' Ioi a)
+  (hg1 : integrable_on g $ f '' Ici a)
+  (hg2 : integrable_on (λ x, (g ∘ f) x * f' x) (Ici a)) :
+  ∫ x in Ioi a, (g ∘ f) x * f' x = ∫ u in Ioi (f a), g u :=
+begin
+  have hg2' : integrable_on (λ x, f' x • (g ∘ f) x) (Ici a) := by simpa [mul_comm] using hg2,
+  simpa [mul_comm] using integral_comp_smul_deriv_Ioi hf hft hff' hg_cont hg1 hg2',
+end
+
+/-- Substitution `y = x ^ p` in integrals over `Ioi 0` -/
+lemma integral_comp_rpow_Ioi (g : ℝ → E) {p : ℝ} (hp : p ≠ 0) :
+  ∫ x in Ioi 0, (|p| * x ^ (p - 1)) • g (x ^ p) = ∫ y in Ioi 0, g y :=
+begin
+  let S := Ioi (0 : ℝ),
+  have a1 : ∀ x:ℝ, x ∈ S → has_deriv_within_at (λ (t:ℝ), t ^ p) (p * x ^ (p - 1)) S x :=
+    λ x hx, (has_deriv_at_rpow_const (or.inl (mem_Ioi.mp hx).ne')).has_deriv_within_at,
+  have a2 : inj_on (λ x:ℝ, x ^ p) S,
+  { rcases lt_or_gt_of_ne hp,
+    { apply strict_anti_on.inj_on,
+      intros x hx y hy hxy,
+      rw [←inv_lt_inv (rpow_pos_of_pos hx p) (rpow_pos_of_pos hy p),
+      ←rpow_neg (le_of_lt hx), ←rpow_neg (le_of_lt hy)],
+      exact rpow_lt_rpow (le_of_lt hx) hxy (neg_pos.mpr h), },
+    exact strict_mono_on.inj_on (λ x hx y hy hxy, rpow_lt_rpow (mem_Ioi.mp hx).le hxy h),},
+  have a3 : (λ (t : ℝ), t ^ p) '' S = S,
+  { ext1, rw mem_image, split,
+    { rintro ⟨y, hy, rfl⟩, exact rpow_pos_of_pos hy p },
+    { intro hx, refine ⟨x ^ (1 / p), rpow_pos_of_pos hx _, _⟩,
+      rw [←rpow_mul (le_of_lt hx), one_div_mul_cancel hp, rpow_one], } },
+  have := integral_image_eq_integral_abs_deriv_smul measurable_set_Ioi a1 a2 g,
+  rw a3 at this, rw this,
+  refine set_integral_congr measurable_set_Ioi _,
+  intros x hx, dsimp only,
+  rw [abs_mul, abs_of_nonneg (rpow_nonneg_of_nonneg (le_of_lt hx) _)],
+end
+
+lemma integral_comp_rpow_Ioi_of_pos {g : ℝ → E} {p : ℝ} (hp : 0 < p) :
+  ∫ x in Ioi 0, (p * x ^ (p - 1)) • g (x ^ p) = ∫ y in Ioi 0, g y :=
+begin
+  convert integral_comp_rpow_Ioi g hp.ne',
+  funext, congr, rw abs_of_nonneg hp.le,
+end
+
+lemma integral_comp_mul_left_Ioi (g : ℝ → E) (a : ℝ) {b : ℝ} (hb : 0 < b) :
+  ∫ x in Ioi a, g (b * x) = |b⁻¹| • ∫ x in Ioi (b * a), g x :=
+begin
+  have : ∀ c : ℝ, measurable_set (Ioi c) := λ c, measurable_set_Ioi,
+  rw [←integral_indicator (this a), ←integral_indicator (this $ b * a)],
+  convert measure.integral_comp_mul_left _ b,
+  ext1 x,
+  rw [←indicator_comp_right, preimage_const_mul_Ioi _ hb, mul_div_cancel_left _ hb.ne'],
+end
+
+lemma integral_comp_mul_right_Ioi (g : ℝ → E) (a : ℝ) {b : ℝ} (hb : 0 < b) :
+  ∫ x in Ioi a, g (x * b) = |b⁻¹| • ∫ x in Ioi (a * b), g x :=
+by simpa only [mul_comm] using integral_comp_mul_left_Ioi g a hb
+
+end Ioi_change_variables
+
+section Ioi_integrability
+
+open real
+open_locale interval
+
+variables {E : Type*} [normed_add_comm_group E]
+
+/-- The substitution `y = x ^ p` in integrals over `Ioi 0` preserves integrability. -/
+lemma integrable_on_Ioi_comp_rpow_iff [normed_space ℝ E] (f : ℝ → E) {p : ℝ} (hp : p ≠ 0) :
+  integrable_on (λ x, (|p| * x ^ (p - 1)) • f (x ^ p)) (Ioi 0) ↔ integrable_on f (Ioi 0) :=
+begin
+  let S := Ioi (0 : ℝ),
+  have a1 : ∀ x:ℝ, x ∈ S → has_deriv_within_at (λ (t:ℝ), t ^ p) (p * x ^ (p - 1)) S x :=
+    λ x hx, (has_deriv_at_rpow_const (or.inl (mem_Ioi.mp hx).ne')).has_deriv_within_at,
+  have a2 : inj_on (λ x:ℝ, x ^ p) S,
+  { rcases lt_or_gt_of_ne hp,
+    { apply strict_anti_on.inj_on,
+      intros x hx y hy hxy,
+      rw [←inv_lt_inv (rpow_pos_of_pos hx p) (rpow_pos_of_pos hy p),
+      ←rpow_neg (le_of_lt hx), ←rpow_neg (le_of_lt hy)],
+      exact rpow_lt_rpow (le_of_lt hx) hxy (neg_pos.mpr h), },
+    exact strict_mono_on.inj_on (λ x hx y hy hxy, rpow_lt_rpow (mem_Ioi.mp hx).le hxy h) },
+  have a3 : (λ (t : ℝ), t ^ p) '' S = S,
+  { ext1, rw mem_image, split,
+    { rintro ⟨y, hy, rfl⟩, exact rpow_pos_of_pos hy p },
+    { intro hx, refine ⟨x ^ (1 / p), rpow_pos_of_pos hx _, _⟩,
+      rw [←rpow_mul (le_of_lt hx), one_div_mul_cancel hp, rpow_one], } },
+  have := integrable_on_image_iff_integrable_on_abs_deriv_smul measurable_set_Ioi a1 a2 f,
+  rw a3 at this,
+  rw this,
+  refine integrable_on_congr_fun (λ x hx, _) measurable_set_Ioi,
+  simp_rw [abs_mul, abs_of_nonneg (rpow_nonneg_of_nonneg (le_of_lt hx) _)],
+end
+
+/-- The substitution `y = x ^ p` in integrals over `Ioi 0` preserves integrability (version
+without `|p|` factor) -/
+lemma integrable_on_Ioi_comp_rpow_iff' [normed_space ℝ E] (f : ℝ → E) {p : ℝ} (hp : p ≠ 0) :
+  integrable_on (λ x, x ^ (p - 1) • f (x ^ p)) (Ioi 0) ↔ integrable_on f (Ioi 0) :=
+by simpa only [←integrable_on_Ioi_comp_rpow_iff f hp, mul_smul]
+  using (integrable_smul_iff (abs_pos.mpr hp).ne' _).symm
+
+lemma integrable_on_Ioi_comp_mul_left_iff (f : ℝ → E) (c : ℝ) {a : ℝ} (ha : 0 < a) :
+  integrable_on (λ x, f (a * x)) (Ioi c) ↔ integrable_on f (Ioi $ a * c) :=
+begin
+  rw [←integrable_indicator_iff (measurable_set_Ioi : measurable_set $ Ioi c)],
+  rw [←integrable_indicator_iff (measurable_set_Ioi : measurable_set $ Ioi $ a * c)],
+  convert integrable_comp_mul_left_iff ((Ioi (a * c)).indicator f) ha.ne' using 2,
+  ext1 x,
+  rw [←indicator_comp_right, preimage_const_mul_Ioi _ ha, mul_comm a c, mul_div_cancel _ ha.ne'],
+end
+
+lemma integrable_on_Ioi_comp_mul_right_iff (f : ℝ → E) (c : ℝ) {a : ℝ} (ha : 0 < a) :
+  integrable_on (λ x, f (x * a)) (Ioi c) ↔ integrable_on f (Ioi $ c * a) :=
+by simpa only [mul_comm, mul_zero] using integrable_on_Ioi_comp_mul_left_iff f c ha
+
+end Ioi_integrability
+
 end measure_theory
diff --git a/src/measure_theory/integral/interval_average.lean b/src/measure_theory/integral/interval_average.lean
new file mode 100644
index 0000000000000..14e8f186367c2
--- /dev/null
+++ b/src/measure_theory/integral/interval_average.lean
@@ -0,0 +1,52 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import measure_theory.integral.interval_integral
+import measure_theory.integral.average
+
+/-!
+# Integral average over an interval
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we introduce notation `⨍ x in a..b, f x` for the average `⨍ x in Ι a b, f x` of `f`
+over the interval `Ι a b = set.Ioc (min a b) (max a b)` w.r.t. the Lebesgue measure, then prove
+formulas for this average:
+
+* `interval_average_eq`: `⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x`;
+* `interval_average_eq_div`: `⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a)`.
+
+We also prove that `⨍ x in a..b, f x = ⨍ x in b..a, f x`, see `interval_average_symm`.
+
+## Notation
+
+`⨍ x in a..b, f x`: average of `f` over the interval `Ι a b` w.r.t. the Lebesgue measure.
+
+-/
+
+open measure_theory set topological_space
+open_locale interval
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+notation `⨍` binders ` in ` a `..` b `, `
+  r:(scoped:60 f, average (measure.restrict volume (Ι a b)) f) := r
+
+lemma interval_average_symm (f : ℝ → E) (a b : ℝ) : ⨍ x in a..b, f x = ⨍ x in b..a, f x :=
+by rw [set_average_eq, set_average_eq, uIoc_swap]
+
+lemma interval_average_eq (f : ℝ → E) (a b : ℝ) : ⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x :=
+begin
+  cases le_or_lt a b with h h,
+  { rw [set_average_eq, uIoc_of_le h, real.volume_Ioc, interval_integral.integral_of_le h,
+      ennreal.to_real_of_real (sub_nonneg.2 h)] },
+  { rw [set_average_eq, uIoc_of_lt h, real.volume_Ioc, interval_integral.integral_of_ge h.le,
+     ennreal.to_real_of_real (sub_nonneg.2 h.le), smul_neg, ← neg_smul, ← inv_neg, neg_sub] }
+end
+
+lemma interval_average_eq_div (f : ℝ → ℝ) (a b : ℝ) :
+  ⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a) :=
+by rw [interval_average_eq, smul_eq_mul, div_eq_inv_mul]
diff --git a/src/measure_theory/integral/interval_integral.lean b/src/measure_theory/integral/interval_integral.lean
index 9b527eac71164..e33e59b0144fc 100644
--- a/src/measure_theory/integral/interval_integral.lean
+++ b/src/measure_theory/integral/interval_integral.lean
@@ -3,102 +3,18 @@ Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Patrick Massot, Sébastien Gouëzel
 -/
-import analysis.normed_space.dual
 import data.set.intervals.disjoint
-import measure_theory.measure.haar_lebesgue
-import analysis.calculus.extend_deriv
-import measure_theory.function.locally_integrable
 import measure_theory.integral.set_integral
-import measure_theory.integral.vitali_caratheodory
+import measure_theory.measure.lebesgue.basic
 
 /-!
 # Integral over an interval
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `∫ x in a..b, f x ∂μ` to be `∫ x in Ioc a b, f x ∂μ` if `a ≤ b` and
-`-∫ x in Ioc b a, f x ∂μ` if `b ≤ a`. We prove a few simple properties and several versions of the
-[fundamental theorem of calculus](https://en.wikipedia.org/wiki/Fundamental_theorem_of_calculus).
-
-Recall that its first version states that the function `(u, v) ↦ ∫ x in u..v, f x` has derivative
-`(δu, δv) ↦ δv • f b - δu • f a` at `(a, b)` provided that `f` is continuous at `a` and `b`,
-and its second version states that, if `f` has an integrable derivative on `[a, b]`, then
-`∫ x in a..b, f' x = f b - f a`.
-
-## Main statements
-
-### FTC-1 for Lebesgue measure
-
-We prove several versions of FTC-1, all in the `interval_integral` namespace. Many of them follow
-the naming scheme `integral_has(_strict?)_(f?)deriv(_within?)_at(_of_tendsto_ae?)(_right|_left?)`.
-They formulate FTC in terms of `has(_strict?)_(f?)deriv(_within?)_at`.
-Let us explain the meaning of each part of the name:
-
-* `_strict` means that the theorem is about strict differentiability;
-* `f` means that the theorem is about differentiability in both endpoints; incompatible with
-  `_right|_left`;
-* `_within` means that the theorem is about one-sided derivatives, see below for details;
-* `_of_tendsto_ae` means that instead of continuity the theorem assumes that `f` has a finite limit
-  almost surely as `x` tends to `a` and/or `b`;
-* `_right` or `_left` mean that the theorem is about differentiability in the right (resp., left)
-  endpoint.
-
-We also reformulate these theorems in terms of `(f?)deriv(_within?)`. These theorems are named
-`(f?)deriv(_within?)_integral(_of_tendsto_ae?)(_right|_left?)` with the same meaning of parts of the
-name.
-
-### One-sided derivatives
-
-Theorem `integral_has_fderiv_within_at_of_tendsto_ae` states that `(u, v) ↦ ∫ x in u..v, f x` has a
-derivative `(δu, δv) ↦ δv • cb - δu • ca` within the set `s × t` at `(a, b)` provided that `f` tends
-to `ca` (resp., `cb`) almost surely at `la` (resp., `lb`), where possible values of `s`, `t`, and
-corresponding filters `la`, `lb` are given in the following table.
-
-| `s`     | `la`     | `t`     | `lb`     |
-| ------- | ----     | ---     | ----     |
-| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
-| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
-| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
-| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
-
-We use a typeclass `FTC_filter` to make Lean automatically find `la`/`lb` based on `s`/`t`. This way
-we can formulate one theorem instead of `16` (or `8` if we leave only non-trivial ones not covered
-by `integral_has_deriv_within_at_of_tendsto_ae_(left|right)` and
-`integral_has_fderiv_at_of_tendsto_ae`). Similarly,
-`integral_has_deriv_within_at_of_tendsto_ae_right` works for both one-sided derivatives using the
-same typeclass to find an appropriate filter.
-
-### FTC for a locally finite measure
-
-Before proving FTC for the Lebesgue measure, we prove a few statements that can be seen as FTC for
-any measure. The most general of them,
-`measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae`, states the following. Let `(la, la')`
-be an `FTC_filter` pair of filters around `a` (i.e., `FTC_filter a la la'`) and let `(lb, lb')` be
-an `FTC_filter` pair of filters around `b`. If `f` has finite limits `ca` and `cb` almost surely at
-`la'` and `lb'`, respectively, then
-`∫ x in va..vb, f x ∂μ - ∫ x in ua..ub, f x ∂μ = ∫ x in ub..vb, cb ∂μ - ∫ x in ua..va, ca ∂μ +
-  o(∥∫ x in ua..va, (1:ℝ) ∂μ∥ + ∥∫ x in ub..vb, (1:ℝ) ∂μ∥)` as `ua` and `va` tend to `la` while
-`ub` and `vb` tend to `lb`.
-
-### FTC-2 and corollaries
-
-We use FTC-1 to prove several versions of FTC-2 for the Lebesgue measure, using a similar naming
-scheme as for the versions of FTC-1. They include:
-* `interval_integral.integral_eq_sub_of_has_deriv_right_of_le` - most general version, for functions
-  with a right derivative
-* `interval_integral.integral_eq_sub_of_has_deriv_at'` - version for functions with a derivative on
-  an open set
-* `interval_integral.integral_deriv_eq_sub'` - version that is easiest to use when computing the
-  integral of a specific function
-
-We then derive additional integration techniques from FTC-2:
-* `interval_integral.integral_mul_deriv_eq_deriv_mul` - integration by parts
-* `interval_integral.integral_comp_mul_deriv''` - integration by substitution
-
-Many applications of these theorems can be found in the file `analysis.special_functions.integrals`.
-
-Note that the assumptions of FTC-2 are formulated in the form that `f'` is integrable. To use it in
-a context with the stronger assumption that `f'` is continuous, one can use
-`continuous_on.interval_integrable` or `continuous_on.integrable_on_Icc` or
-`continuous_on.integrable_on_interval`.
+`-∫ x in Ioc b a, f x ∂μ` if `b ≤ a`.
 
 ## Implementation notes
 
@@ -106,7 +22,7 @@ a context with the stronger assumption that `f'` is continuous, one can use
 
 In order to avoid `if`s in the definition, we define `interval_integrable f μ a b` as
 `integrable_on f (Ioc a b) μ ∧ integrable_on f (Ioc b a) μ`. For any `a`, `b` one of these
-intervals is empty and the other coincides with `set.interval_oc a b = set.Ioc (min a b) (max a b)`.
+intervals is empty and the other coincides with `set.uIoc a b = set.Ioc (min a b) (max a b)`.
 
 Similarly, we define `∫ x in a..b, f x ∂μ` to be `∫ x in Ioc a b, f x ∂μ - ∫ x in Ioc b a, f x ∂μ`.
 Again, for any `a`, `b` one of these integrals is zero, and the other gives the expected result.
@@ -116,7 +32,7 @@ the cases `a ≤ b` and `b ≤ a` separately.
 
 ### Choice of the interval
 
-We use integral over `set.interval_oc a b = set.Ioc (min a b) (max a b)` instead of one of the other
+We use integral over `set.uIoc a b = set.Ioc (min a b) (max a b)` instead of one of the other
 three possible intervals with the same endpoints for two reasons:
 
 * this way `∫ x in a..b, f x ∂μ + ∫ x in b..c, f x ∂μ = ∫ x in a..c, f x ∂μ` holds whenever
@@ -127,58 +43,28 @@ three possible intervals with the same endpoints for two reasons:
   [cumulative distribution function](https://en.wikipedia.org/wiki/Cumulative_distribution_function)
   of `μ`.
 
-### `FTC_filter` class
-
-As explained above, many theorems in this file rely on the typeclass
-`FTC_filter (a : ℝ) (l l' : filter ℝ)` to avoid code duplication. This typeclass combines four
-assumptions:
-
-- `pure a ≤ l`;
-- `l' ≤ 𝓝 a`;
-- `l'` has a basis of measurable sets;
-- if `u n` and `v n` tend to `l`, then for any `s ∈ l'`, `Ioc (u n) (v n)` is eventually included
-  in `s`.
-
-This typeclass has the following “real” instances: `(a, pure a, ⊥)`, `(a, 𝓝[≥] a, 𝓝[>] a)`,
-`(a, 𝓝[≤] a, 𝓝[≤] a)`, `(a, 𝓝 a, 𝓝 a)`.
-Furthermore, we have the following instances that are equal to the previously mentioned instances:
-`(a, 𝓝[{a}] a, ⊥)` and `(a, 𝓝[univ] a, 𝓝[univ] a)`.
-While the difference between `Ici a` and `Ioi a` doesn't matter for theorems about Lebesgue measure,
-it becomes important in the versions of FTC about any locally finite measure if this measure has an
-atom at one of the endpoints.
-
-### Combining one-sided and two-sided derivatives
-
-There are some `FTC_filter` instances where the fact that it is one-sided or
-two-sided depends on the point, namely `(x, 𝓝[Icc a b] x, 𝓝[Icc a b] x)`
-(resp. `(x, 𝓝[[a, b]] x, 𝓝[[a, b]] x)`, where `[a, b] = set.interval a b`),
-with `x ∈ Icc a b` (resp. `x ∈ [a, b]`).
-This results in a two-sided derivatives for `x ∈ Ioo a b` and one-sided derivatives for
-`x ∈ {a, b}`. Other instances could be added when needed (in that case, one also needs to add
-instances for `filter.is_measurably_generated` and `filter.tendsto_Ixx_class`).
-
 ## Tags
 
-integral, fundamental theorem of calculus, FTC-1, FTC-2, change of variables in integrals
+integral
 -/
 
 noncomputable theory
 open topological_space (second_countable_topology)
 open measure_theory set classical filter function
 
-open_locale classical topological_space filter ennreal big_operators interval
+open_locale classical topology filter ennreal big_operators interval nnreal
 
-variables {ι 𝕜 E F : Type*} [normed_group E]
+variables {ι 𝕜 E F A : Type*} [normed_add_comm_group E]
 
 /-!
-### Integrability at an interval
+### Integrability on an interval
 -/
 
 /-- A function `f` is called *interval integrable* with respect to a measure `μ` on an unordered
 interval `a..b` if it is integrable on both intervals `(a, b]` and `(b, a]`. One of these
 intervals is always empty, so this property is equivalent to `f` being integrable on
 `(min a b, max a b]`. -/
-def interval_integrable (f : ℝ → E) (μ : measure ℝ) (a b : ℝ) :=
+def interval_integrable (f : ℝ → E) (μ : measure ℝ) (a b : ℝ) : Prop :=
 integrable_on f (Ioc a b) μ ∧ integrable_on f (Ioc b a) μ
 
 section
@@ -186,30 +72,39 @@ section
 variables {f : ℝ → E} {a b : ℝ} {μ : measure ℝ}
 
 /-- A function is interval integrable with respect to a given measure `μ` on `a..b` if and
-  only if it is integrable on `interval_oc a b` with respect to `μ`. This is an equivalent
-  defintion of `interval_integrable`. -/
+  only if it is integrable on `uIoc a b` with respect to `μ`. This is an equivalent
+  definition of `interval_integrable`. -/
 lemma interval_integrable_iff : interval_integrable f μ a b ↔ integrable_on f (Ι a b) μ :=
-by rw [interval_oc_eq_union, integrable_on_union, interval_integrable]
+by rw [uIoc_eq_union, integrable_on_union, interval_integrable]
 
 /-- If a function is interval integrable with respect to a given measure `μ` on `a..b` then
-  it is integrable on `interval_oc a b` with respect to `μ`. -/
+  it is integrable on `uIoc a b` with respect to `μ`. -/
 lemma interval_integrable.def (h : interval_integrable f μ a b) : integrable_on f (Ι a b) μ :=
 interval_integrable_iff.mp h
 
 lemma interval_integrable_iff_integrable_Ioc_of_le (hab : a ≤ b) :
   interval_integrable f μ a b ↔ integrable_on f (Ioc a b) μ :=
-by rw [interval_integrable_iff, interval_oc_of_le hab]
+by rw [interval_integrable_iff, uIoc_of_le hab]
+
+lemma interval_integrable_iff' [has_no_atoms μ] :
+  interval_integrable f μ a b ↔ integrable_on f (uIcc a b) μ :=
+by rw [interval_integrable_iff, ←Icc_min_max, uIoc, integrable_on_Icc_iff_integrable_on_Ioc]
+
+lemma interval_integrable_iff_integrable_Icc_of_le
+  {f : ℝ → E} {a b : ℝ} (hab : a ≤ b) {μ : measure ℝ} [has_no_atoms μ] :
+  interval_integrable f μ a b ↔ integrable_on f (Icc a b) μ :=
+by rw [interval_integrable_iff_integrable_Ioc_of_le hab, integrable_on_Icc_iff_integrable_on_Ioc]
 
 /-- If a function is integrable with respect to a given measure `μ` then it is interval integrable
-  with respect to `μ` on `interval a b`. -/
+  with respect to `μ` on `uIcc a b`. -/
 lemma measure_theory.integrable.interval_integrable (hf : integrable f μ) :
   interval_integrable f μ a b :=
 ⟨hf.integrable_on, hf.integrable_on⟩
 
 lemma measure_theory.integrable_on.interval_integrable (hf : integrable_on f [a, b] μ) :
   interval_integrable f μ a b :=
-⟨measure_theory.integrable_on.mono_set hf (Ioc_subset_Icc_self.trans Icc_subset_interval),
- measure_theory.integrable_on.mono_set hf (Ioc_subset_Icc_self.trans Icc_subset_interval')⟩
+⟨measure_theory.integrable_on.mono_set hf (Ioc_subset_Icc_self.trans Icc_subset_uIcc),
+ measure_theory.integrable_on.mono_set hf (Ioc_subset_Icc_self.trans Icc_subset_uIcc')⟩
 
 lemma interval_integrable_const_iff {c : E} :
   interval_integrable (λ _, c) μ a b ↔ c = 0 ∨ μ (Ι a b) < ∞ :=
@@ -257,9 +152,14 @@ lemma neg (h : interval_integrable f μ a b) : interval_integrable (-f) μ a b :
 ⟨h.1.neg, h.2.neg⟩
 
 lemma norm (h : interval_integrable f μ a b) :
-  interval_integrable (λ x, ∥f x∥) μ a b  :=
+  interval_integrable (λ x, ‖f x‖) μ a b  :=
 ⟨h.1.norm, h.2.norm⟩
 
+lemma interval_integrable_norm_iff {f : ℝ → E} {μ : measure ℝ} {a b : ℝ}
+  (hf : ae_strongly_measurable f (μ.restrict (Ι a b))) :
+  interval_integrable (λ t, ‖f t‖) μ a b ↔ interval_integrable f μ a b :=
+by { simp_rw [interval_integrable_iff, integrable_on], exact integrable_norm_iff hf }
+
 lemma abs {f : ℝ → ℝ} (h : interval_integrable f μ a b) :
   interval_integrable (λ x, |f x|) μ a b  :=
 h.norm
@@ -267,28 +167,32 @@ h.norm
 lemma mono (hf : interval_integrable f ν a b) (h1 : [c, d] ⊆ [a, b]) (h2 : μ ≤ ν) :
   interval_integrable f μ c d :=
 interval_integrable_iff.mpr $ hf.def.mono
-  (interval_oc_subset_interval_oc_of_interval_subset_interval h1) h2
-
-lemma mono_set (hf : interval_integrable f μ a b) (h : [c, d] ⊆ [a, b]) :
-  interval_integrable f μ c d :=
-hf.mono h rfl.le
+  (uIoc_subset_uIoc_of_uIcc_subset_uIcc h1) h2
 
 lemma mono_measure (hf : interval_integrable f ν a b) (h : μ ≤ ν) :
   interval_integrable f μ a b :=
 hf.mono rfl.subset h
 
+lemma mono_set (hf : interval_integrable f μ a b) (h : [c, d] ⊆ [a, b]) :
+  interval_integrable f μ c d :=
+hf.mono h rfl.le
+
 lemma mono_set_ae (hf : interval_integrable f μ a b) (h : Ι c d ≤ᵐ[μ] Ι a b) :
   interval_integrable f μ c d :=
 interval_integrable_iff.mpr $ hf.def.mono_set_ae h
 
-lemma mono_fun [normed_group F] {g : ℝ → F}
+lemma mono_set' (hf : interval_integrable f μ a b) (hsub : Ι c d ⊆ Ι a b) :
+  interval_integrable f μ c d :=
+hf.mono_set_ae $ eventually_of_forall hsub
+
+lemma mono_fun [normed_add_comm_group F] {g : ℝ → F}
   (hf : interval_integrable f μ a b) (hgm : ae_strongly_measurable g (μ.restrict (Ι a b)))
-  (hle : (λ x, ∥g x∥) ≤ᵐ[μ.restrict (Ι a b)] (λ x, ∥f x∥)) : interval_integrable g μ a b :=
+  (hle : (λ x, ‖g x‖) ≤ᵐ[μ.restrict (Ι a b)] (λ x, ‖f x‖)) : interval_integrable g μ a b :=
 interval_integrable_iff.2 $ hf.def.integrable.mono hgm hle
 
 lemma mono_fun' {g : ℝ → ℝ} (hg : interval_integrable g μ a b)
   (hfm : ae_strongly_measurable f (μ.restrict (Ι a b)))
-  (hle : (λ x, ∥f x∥) ≤ᵐ[μ.restrict (Ι a b)] g) : interval_integrable f μ a b :=
+  (hle : (λ x, ‖f x‖) ≤ᵐ[μ.restrict (Ι a b)] g) : interval_integrable f μ a b :=
 interval_integrable_iff.2 $ hg.def.integrable.mono' hfm hle
 
 protected lemma ae_strongly_measurable (h : interval_integrable f μ a b) :
@@ -301,7 +205,7 @@ h.2.ae_strongly_measurable
 
 end
 
-variables {f g : ℝ → E} {a b : ℝ} {μ : measure ℝ}
+variables [normed_ring A] {f g : ℝ → E} {a b : ℝ} {μ : measure ℝ}
 
 lemma smul [normed_field 𝕜] [normed_space 𝕜 E]
   {f : ℝ → E} {a b : ℝ} {μ : measure ℝ} (h : interval_integrable f μ a b) (r : 𝕜) :
@@ -316,18 +220,93 @@ lemma smul [normed_field 𝕜] [normed_space 𝕜 E]
   interval_integrable (λ x, f x - g x) μ a b :=
 ⟨hf.1.sub hg.1, hf.2.sub hg.2⟩
 
-lemma mul_continuous_on {f g : ℝ → ℝ}
+lemma sum (s : finset ι) {f : ι → ℝ → E} (h : ∀ i ∈ s, interval_integrable (f i) μ a b) :
+  interval_integrable (∑ i in s, f i) μ a b :=
+⟨integrable_finset_sum' s (λ i hi, (h i hi).1), integrable_finset_sum' s (λ i hi, (h i hi).2)⟩
+
+lemma mul_continuous_on {f g : ℝ → A}
   (hf : interval_integrable f μ a b) (hg : continuous_on g [a, b]) :
   interval_integrable (λ x, f x * g x) μ a b :=
 begin
   rw interval_integrable_iff at hf ⊢,
-  exact hf.mul_continuous_on_of_subset hg measurable_set_Ioc is_compact_interval Ioc_subset_Icc_self
+  exact hf.mul_continuous_on_of_subset hg measurable_set_Ioc is_compact_uIcc Ioc_subset_Icc_self
 end
 
-lemma continuous_on_mul {f g : ℝ → ℝ} (hf : interval_integrable f μ a b)
-  (hg : continuous_on g [a, b]) :
+lemma continuous_on_mul {f g : ℝ → A}
+  (hf : interval_integrable f μ a b) (hg : continuous_on g [a, b]) :
   interval_integrable (λ x, g x * f x) μ a b :=
-by simpa [mul_comm] using hf.mul_continuous_on hg
+begin
+  rw interval_integrable_iff at hf ⊢,
+  exact hf.continuous_on_mul_of_subset hg is_compact_uIcc measurable_set_Ioc Ioc_subset_Icc_self
+end
+
+@[simp]
+lemma const_mul {f : ℝ → A}
+  (hf : interval_integrable f μ a b) (c : A) : interval_integrable (λ x, c * f x) μ a b :=
+hf.continuous_on_mul continuous_on_const
+
+@[simp]
+lemma mul_const {f : ℝ → A}
+  (hf : interval_integrable f μ a b) (c : A) : interval_integrable (λ x, f x * c) μ a b :=
+hf.mul_continuous_on continuous_on_const
+
+@[simp]
+lemma div_const {𝕜 : Type*} {f : ℝ → 𝕜} [normed_field 𝕜]
+  (h : interval_integrable f μ a b) (c : 𝕜) :
+  interval_integrable (λ x, f x / c) μ a b :=
+by simpa only [div_eq_mul_inv] using mul_const h c⁻¹
+
+lemma comp_mul_left (hf : interval_integrable f volume a b) (c : ℝ) :
+  interval_integrable (λ x, f (c * x)) volume (a / c) (b / c) :=
+begin
+  rcases eq_or_ne c 0 with hc|hc, { rw hc, simp },
+  rw interval_integrable_iff' at hf ⊢,
+  have A : measurable_embedding (λ x, x * c⁻¹) :=
+    (homeomorph.mul_right₀ _ (inv_ne_zero hc)).closed_embedding.measurable_embedding,
+  rw [←real.smul_map_volume_mul_right (inv_ne_zero hc), integrable_on, measure.restrict_smul,
+    integrable_smul_measure (by simpa : ennreal.of_real (|c⁻¹|) ≠ 0) ennreal.of_real_ne_top,
+    ←integrable_on, measurable_embedding.integrable_on_map_iff A],
+  convert hf using 1,
+  { ext, simp only [comp_app], congr' 1, field_simp, ring },
+  { rw preimage_mul_const_uIcc (inv_ne_zero hc), field_simp [hc] },
+end
+
+lemma comp_mul_right (hf : interval_integrable f volume a b) (c : ℝ) :
+  interval_integrable (λ x, f (x * c)) volume (a / c) (b / c) :=
+by simpa only [mul_comm] using comp_mul_left hf c
+
+lemma comp_add_right (hf : interval_integrable f volume a b) (c : ℝ) :
+  interval_integrable (λ x, f (x + c)) volume (a - c) (b - c) :=
+begin
+  wlog h : a ≤ b,
+  { exact interval_integrable.symm (this hf.symm _ (le_of_not_le h)) },
+  rw interval_integrable_iff' at hf ⊢,
+  have A : measurable_embedding (λ x, x + c) :=
+    (homeomorph.add_right c).closed_embedding.measurable_embedding,
+  have Am : measure.map (λ x, x + c) volume = volume,
+  { exact is_add_left_invariant.is_add_right_invariant.map_add_right_eq_self _ },
+  rw ←Am at hf,
+  convert (measurable_embedding.integrable_on_map_iff A).mp hf,
+  rw preimage_add_const_uIcc,
+end
+
+lemma comp_add_left (hf : interval_integrable f volume a b) (c : ℝ) :
+  interval_integrable (λ x, f (c + x)) volume (a - c) (b - c) :=
+by simpa only [add_comm] using interval_integrable.comp_add_right hf c
+
+lemma comp_sub_right (hf : interval_integrable f volume a b) (c : ℝ) :
+  interval_integrable (λ x, f (x - c)) volume (a + c) (b + c) :=
+by simpa only [sub_neg_eq_add] using interval_integrable.comp_add_right hf (-c)
+
+lemma iff_comp_neg  :
+  interval_integrable f volume a b ↔ interval_integrable (λ x, f (-x)) volume (-a) (-b) :=
+begin
+  split, all_goals { intro hf, convert comp_mul_left hf (-1), simp, field_simp, field_simp },
+end
+
+lemma comp_sub_left (hf : interval_integrable f volume a b) (c : ℝ) :
+  interval_integrable (λ x, f (c - x)) volume (c - a) (c - b) :=
+by simpa only [neg_sub, ←sub_eq_add_neg] using iff_comp_neg.mp (hf.comp_add_left c)
 
 end interval_integrable
 
@@ -336,12 +315,12 @@ section
 variables {μ : measure ℝ} [is_locally_finite_measure μ]
 
 lemma continuous_on.interval_integrable {u : ℝ → E} {a b : ℝ}
-  (hu : continuous_on u (interval a b)) : interval_integrable u μ a b :=
+  (hu : continuous_on u (uIcc a b)) : interval_integrable u μ a b :=
 (continuous_on.integrable_on_Icc hu).interval_integrable
 
 lemma continuous_on.interval_integrable_of_Icc {u : ℝ → E} {a b : ℝ} (h : a ≤ b)
   (hu : continuous_on u (Icc a b)) : interval_integrable u μ a b :=
-continuous_on.interval_integrable ((interval_of_le h).symm ▸ hu)
+continuous_on.interval_integrable ((uIcc_of_le h).symm ▸ hu)
 
 /-- A continuous function on `ℝ` is `interval_integrable` with respect to any locally finite measure
 `ν` on ℝ. -/
@@ -356,14 +335,14 @@ section
 variables {μ : measure ℝ} [is_locally_finite_measure μ] [conditionally_complete_linear_order E]
   [order_topology E] [second_countable_topology E]
 
-lemma monotone_on.interval_integrable {u : ℝ → E} {a b : ℝ} (hu : monotone_on u (interval a b)) :
+lemma monotone_on.interval_integrable {u : ℝ → E} {a b : ℝ} (hu : monotone_on u (uIcc a b)) :
   interval_integrable u μ a b :=
 begin
   rw interval_integrable_iff,
-  exact (hu.integrable_on_compact is_compact_interval).mono_set Ioc_subset_Icc_self,
+  exact (hu.integrable_on_is_compact is_compact_uIcc).mono_set Ioc_subset_Icc_self,
 end
 
-lemma antitone_on.interval_integrable {u : ℝ → E} {a b : ℝ} (hu : antitone_on u (interval a b)) :
+lemma antitone_on.interval_integrable {u : ℝ → E} {a b : ℝ} (hu : antitone_on u (uIcc a b)) :
   interval_integrable u μ a b :=
 hu.dual_right.interval_integrable
 
@@ -424,7 +403,7 @@ variables [complete_space E] [normed_space ℝ E]
 /-- The interval integral `∫ x in a..b, f x ∂μ` is defined
 as `∫ x in Ioc a b, f x ∂μ - ∫ x in Ioc b a, f x ∂μ`. If `a ≤ b`, then it equals
 `∫ x in Ioc a b, f x ∂μ`, otherwise it equals `-∫ x in Ioc b a, f x ∂μ`. -/
-def interval_integral (f : ℝ → E) (a b : ℝ) (μ : measure ℝ) :=
+def interval_integral (f : ℝ → E) (a b : ℝ) (μ : measure ℝ) : E :=
 ∫ x in Ioc a b, f x ∂μ - ∫ x in Ioc b a, f x ∂μ
 
 notation `∫` binders ` in ` a `..` b `, ` r:(scoped:60 f, f) ` ∂` μ:70 := interval_integral r a b μ
@@ -451,67 +430,92 @@ by simp only [interval_integral, neg_sub]
 lemma integral_of_ge (h : b ≤ a) : ∫ x in a..b, f x ∂μ = -∫ x in Ioc b a, f x ∂μ :=
 by simp only [integral_symm b, integral_of_le h]
 
-lemma interval_integral_eq_integral_interval_oc (f : ℝ → E) (a b : ℝ) (μ : measure ℝ) :
+lemma interval_integral_eq_integral_uIoc (f : ℝ → E) (a b : ℝ) (μ : measure ℝ) :
   ∫ x in a..b, f x ∂μ = (if a ≤ b then 1 else -1 : ℝ) • ∫ x in Ι a b, f x ∂μ :=
 begin
   split_ifs with h,
-  { simp only [integral_of_le h, interval_oc_of_le h, one_smul] },
-  { simp only [integral_of_ge (not_le.1 h).le, interval_oc_of_lt (not_le.1 h), neg_one_smul] }
+  { simp only [integral_of_le h, uIoc_of_le h, one_smul] },
+  { simp only [integral_of_ge (not_le.1 h).le, uIoc_of_lt (not_le.1 h), neg_one_smul] }
+end
+
+lemma norm_interval_integral_eq (f : ℝ → E) (a b : ℝ) (μ : measure ℝ) :
+  ‖∫ x in a..b, f x ∂μ‖ = ‖∫ x in Ι a b, f x ∂μ‖ :=
+begin
+  simp_rw [interval_integral_eq_integral_uIoc, norm_smul],
+  split_ifs; simp only [norm_neg, norm_one, one_mul],
 end
 
+lemma abs_interval_integral_eq (f : ℝ → ℝ) (a b : ℝ) (μ : measure ℝ) :
+  |∫ x in a..b, f x ∂μ| = |∫ x in Ι a b, f x ∂μ| :=
+norm_interval_integral_eq f a b μ
+
 lemma integral_cases (f : ℝ → E) (a b) :
   ∫ x in a..b, f x ∂μ ∈ ({∫ x in Ι a b, f x ∂μ, -∫ x in Ι a b, f x ∂μ} : set E) :=
-by { rw interval_integral_eq_integral_interval_oc, split_ifs; simp }
+by { rw interval_integral_eq_integral_uIoc, split_ifs; simp }
 
 lemma integral_undef (h : ¬ interval_integrable f μ a b) :
   ∫ x in a..b, f x ∂μ = 0 :=
 by cases le_total a b with hab hab;
   simp only [integral_of_le, integral_of_ge, hab, neg_eq_zero];
-    refine integral_undef (not_imp_not.mpr integrable.integrable_on' _);
-      simpa [hab] using not_and_distrib.mp h
+    refine integral_undef (not_imp_not.mpr _ h);
+      simpa only [hab, Ioc_eq_empty_of_le, integrable_on_empty, not_true, false_or, or_false]
+        using not_and_distrib.mp h
+
+lemma interval_integrable_of_integral_ne_zero {a b : ℝ}
+  {f : ℝ → E} {μ : measure ℝ} (h : ∫ x in a..b, f x ∂μ ≠ 0) :
+  interval_integrable f μ a b :=
+by { contrapose! h, exact interval_integral.integral_undef h }
 
 lemma integral_non_ae_strongly_measurable
   (hf : ¬ ae_strongly_measurable f (μ.restrict (Ι a b))) :
   ∫ x in a..b, f x ∂μ = 0 :=
-by rw [interval_integral_eq_integral_interval_oc, integral_non_ae_strongly_measurable hf, smul_zero]
+by rw [interval_integral_eq_integral_uIoc, integral_non_ae_strongly_measurable hf, smul_zero]
 
 lemma integral_non_ae_strongly_measurable_of_le (h : a ≤ b)
   (hf : ¬ ae_strongly_measurable f (μ.restrict (Ioc a b))) :
   ∫ x in a..b, f x ∂μ = 0 :=
-integral_non_ae_strongly_measurable $ by rwa [interval_oc_of_le h]
+integral_non_ae_strongly_measurable $ by rwa [uIoc_of_le h]
 
 lemma norm_integral_min_max (f : ℝ → E) :
-  ∥∫ x in min a b..max a b, f x ∂μ∥ = ∥∫ x in a..b, f x ∂μ∥ :=
+  ‖∫ x in min a b..max a b, f x ∂μ‖ = ‖∫ x in a..b, f x ∂μ‖ :=
 by cases le_total a b; simp [*, integral_symm a b]
 
 lemma norm_integral_eq_norm_integral_Ioc (f : ℝ → E) :
-  ∥∫ x in a..b, f x ∂μ∥ = ∥∫ x in Ι a b, f x ∂μ∥ :=
-by rw [← norm_integral_min_max, integral_of_le min_le_max, interval_oc]
+  ‖∫ x in a..b, f x ∂μ‖ = ‖∫ x in Ι a b, f x ∂μ‖ :=
+by rw [← norm_integral_min_max, integral_of_le min_le_max, uIoc]
 
-lemma abs_integral_eq_abs_integral_interval_oc (f : ℝ → ℝ) :
+lemma abs_integral_eq_abs_integral_uIoc (f : ℝ → ℝ) :
   |∫ x in a..b, f x ∂μ| = |∫ x in Ι a b, f x ∂μ| :=
 norm_integral_eq_norm_integral_Ioc f
 
 lemma norm_integral_le_integral_norm_Ioc :
-  ∥∫ x in a..b, f x ∂μ∥ ≤ ∫ x in Ι a b, ∥f x∥ ∂μ :=
-calc ∥∫ x in a..b, f x ∂μ∥ = ∥∫ x in Ι a b, f x ∂μ∥ :
+  ‖∫ x in a..b, f x ∂μ‖ ≤ ∫ x in Ι a b, ‖f x‖ ∂μ :=
+calc ‖∫ x in a..b, f x ∂μ‖ = ‖∫ x in Ι a b, f x ∂μ‖ :
   norm_integral_eq_norm_integral_Ioc f
-... ≤ ∫ x in Ι a b, ∥f x∥ ∂μ :
+... ≤ ∫ x in Ι a b, ‖f x‖ ∂μ :
   norm_integral_le_integral_norm f
 
-lemma norm_integral_le_abs_integral_norm : ∥∫ x in a..b, f x ∂μ∥ ≤ |∫ x in a..b, ∥f x∥ ∂μ| :=
+lemma norm_integral_le_abs_integral_norm : ‖∫ x in a..b, f x ∂μ‖ ≤ |∫ x in a..b, ‖f x‖ ∂μ| :=
 begin
   simp only [← real.norm_eq_abs, norm_integral_eq_norm_integral_Ioc],
   exact le_trans (norm_integral_le_integral_norm _) (le_abs_self _)
 end
 
 lemma norm_integral_le_integral_norm (h : a ≤ b) :
-  ∥∫ x in a..b, f x ∂μ∥ ≤ ∫ x in a..b, ∥f x∥ ∂μ :=
-norm_integral_le_integral_norm_Ioc.trans_eq $ by rw [interval_oc_of_le h, integral_of_le h]
+  ‖∫ x in a..b, f x ∂μ‖ ≤ ∫ x in a..b, ‖f x‖ ∂μ :=
+norm_integral_le_integral_norm_Ioc.trans_eq $ by rw [uIoc_of_le h, integral_of_le h]
+
+lemma norm_integral_le_of_norm_le {g : ℝ → ℝ}
+  (h : ∀ᵐ t ∂(μ.restrict $ Ι a b), ‖f t‖ ≤ g t)
+  (hbound : interval_integrable g μ a b) :
+  ‖∫ t in a..b, f t ∂μ‖ ≤ |∫ t in a..b, g t ∂μ| :=
+by simp_rw [norm_interval_integral_eq, abs_interval_integral_eq,
+  abs_eq_self.mpr (integral_nonneg_of_ae $ h.mono $ λ t ht, (norm_nonneg _).trans ht),
+  norm_integral_le_of_norm_le hbound.def h]
 
 lemma norm_integral_le_of_norm_le_const_ae {a b C : ℝ} {f : ℝ → E}
-  (h : ∀ᵐ x, x ∈ Ι a b → ∥f x∥ ≤ C) :
-  ∥∫ x in a..b, f x∥ ≤ C * |b - a| :=
+  (h : ∀ᵐ x, x ∈ Ι a b → ‖f x‖ ≤ C) :
+  ‖∫ x in a..b, f x‖ ≤ C * |b - a| :=
 begin
   rw [norm_integral_eq_norm_integral_Ioc],
   convert norm_set_integral_le_of_norm_le_const_ae'' _ measurable_set_Ioc h,
@@ -520,18 +524,18 @@ begin
 end
 
 lemma norm_integral_le_of_norm_le_const {a b C : ℝ} {f : ℝ → E}
-  (h : ∀ x ∈ Ι a b, ∥f x∥ ≤ C) :
-  ∥∫ x in a..b, f x∥ ≤ C * |b - a| :=
+  (h : ∀ x ∈ Ι a b, ‖f x‖ ≤ C) :
+  ‖∫ x in a..b, f x‖ ≤ C * |b - a| :=
 norm_integral_le_of_norm_le_const_ae $ eventually_of_forall h
 
 @[simp] lemma integral_add (hf : interval_integrable f μ a b) (hg : interval_integrable g μ a b) :
   ∫ x in a..b, f x + g x ∂μ = ∫ x in a..b, f x ∂μ + ∫ x in a..b, g x ∂μ :=
-by simp only [interval_integral_eq_integral_interval_oc, integral_add hf.def hg.def, smul_add]
+by simp only [interval_integral_eq_integral_uIoc, integral_add hf.def hg.def, smul_add]
 
 lemma integral_finset_sum {ι} {s : finset ι} {f : ι → ℝ → E}
   (h : ∀ i ∈ s, interval_integrable (f i) μ a b) :
   ∫ x in a..b, ∑ i in s, f i x ∂μ = ∑ i in s, ∫ x in a..b, f i x ∂μ :=
-by simp only [interval_integral_eq_integral_interval_oc,
+by simp only [interval_integral_eq_integral_uIoc,
   integral_finset_sum s (λ i hi, (h i hi).def), finset.smul_sum]
 
 @[simp] lemma integral_neg : ∫ x in a..b, -f x ∂μ = -∫ x in a..b, f x ∂μ :=
@@ -541,14 +545,14 @@ by { simp only [interval_integral, integral_neg], abel }
   ∫ x in a..b, f x - g x ∂μ = ∫ x in a..b, f x ∂μ - ∫ x in a..b, g x ∂μ :=
 by simpa only [sub_eq_add_neg] using (integral_add hf hg.neg).trans (congr_arg _ integral_neg)
 
-@[simp] lemma integral_smul {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
+@[simp] lemma integral_smul {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
   [smul_comm_class ℝ 𝕜 E]
   (r : 𝕜) (f : ℝ → E) : ∫ x in a..b, r • f x ∂μ = r • ∫ x in a..b, f x ∂μ :=
 by simp only [interval_integral, integral_smul, smul_sub]
 
 @[simp] lemma integral_smul_const {𝕜 : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E] (f : ℝ → 𝕜) (c : E) :
   ∫ x in a..b, f x • c ∂μ = (∫ x in a..b, f x ∂μ) • c :=
-by simp only [interval_integral_eq_integral_interval_oc, integral_smul_const, smul_assoc]
+by simp only [interval_integral_eq_integral_uIoc, integral_smul_const, smul_assoc]
 
 @[simp] lemma integral_const_mul {𝕜 : Type*} [is_R_or_C 𝕜] (r : 𝕜) (f : ℝ → 𝕜) :
   ∫ x in a..b, r * f x ∂μ = r * ∫ x in a..b, f x ∂μ :=
@@ -574,18 +578,33 @@ lemma integral_smul_measure (c : ℝ≥0∞) :
   ∫ x in a..b, f x ∂(c • μ) = c.to_real • ∫ x in a..b, f x ∂μ :=
 by simp only [interval_integral, measure.restrict_smul, integral_smul_measure, smul_sub]
 
-variables [normed_group F] [complete_space F] [normed_space ℝ F]
+end basic
+
+lemma integral_of_real {a b : ℝ} {μ : measure ℝ} {f : ℝ → ℝ} :
+  ∫ x in a..b, (f x : ℂ) ∂μ = ↑(∫ x in a..b, f x ∂μ) :=
+by simp only [interval_integral, integral_of_real, complex.of_real_sub]
+
+section continuous_linear_map
+
+variables {a b : ℝ} {μ : measure ℝ} {f : ℝ → E}
+variables [is_R_or_C 𝕜] [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F]
+
+open continuous_linear_map
+
+lemma _root_.continuous_linear_map.interval_integral_apply {a b : ℝ} {φ : ℝ → F →L[𝕜] E}
+  (hφ : interval_integrable φ μ a b) (v : F) :
+  (∫ x in a..b, φ x ∂μ) v = ∫ x in a..b, φ x v ∂μ :=
+by simp_rw [interval_integral_eq_integral_uIoc, ← integral_apply hφ.def v, coe_smul',
+  pi.smul_apply]
+
+variables [normed_space ℝ F] [complete_space F]
 
 lemma _root_.continuous_linear_map.interval_integral_comp_comm
-  (L : E →L[ℝ] F) (hf : interval_integrable f μ a b) :
+  (L : E →L[𝕜] F) (hf : interval_integrable f μ a b) :
   ∫ x in a..b, L (f x) ∂μ = L (∫ x in a..b, f x ∂μ) :=
-begin
-  rw [interval_integral, interval_integral, L.integral_comp_comm, L.integral_comp_comm, L.map_sub],
-  exacts [hf.2, hf.1]
-end
-
-end basic
+by simp_rw [interval_integral, L.integral_comp_comm hf.1, L.integral_comp_comm hf.2, L.map_sub]
 
+end continuous_linear_map
 section comp
 
 variables {a b c d : ℝ} (f : ℝ → E)
@@ -729,28 +748,6 @@ section order_closed_topology
 
 variables {a b c d : ℝ} {f g : ℝ → E} {μ : measure ℝ}
 
-lemma integrable_on_Icc_iff_integrable_on_Ioc'
-  {E : Type*} [normed_group E]
-  {f : ℝ → E} {a b : ℝ} (ha : μ {a} ≠ ∞) :
-  integrable_on f (Icc a b) μ ↔ integrable_on f (Ioc a b) μ :=
-begin
-  cases le_or_lt a b with hab hab,
-  { have : Icc a b = Icc a a ∪ Ioc a b := (Icc_union_Ioc_eq_Icc le_rfl hab).symm,
-    rw [this, integrable_on_union],
-    simp [ha.lt_top] },
-  { simp [hab, hab.le] },
-end
-
-lemma integrable_on_Icc_iff_integrable_on_Ioc
-  {E : Type*}[normed_group E] [has_no_atoms μ] {f : ℝ → E} {a b : ℝ} :
-  integrable_on f (Icc a b) μ ↔ integrable_on f (Ioc a b) μ :=
-integrable_on_Icc_iff_integrable_on_Ioc' (by simp)
-
-lemma interval_integrable_iff_integrable_Icc_of_le {E : Type*} [normed_group E]
-  {f : ℝ → E} {a b : ℝ} (hab : a ≤ b) {μ : measure ℝ} [has_no_atoms μ] :
-  interval_integrable f μ a b ↔ integrable_on f (Icc a b) μ :=
-by rw [interval_integrable_iff_integrable_Ioc_of_le hab, integrable_on_Icc_iff_integrable_on_Ioc]
-
 /-- If two functions are equal in the relevant interval, their interval integrals are also equal. -/
 lemma integral_congr {a b : ℝ} (h : eq_on f g [a, b]) :
   ∫ x in a..b, f x ∂μ = ∫ x in a..b, g x ∂μ :=
@@ -762,7 +759,7 @@ lemma integral_add_adjacent_intervals_cancel (hab : interval_integrable f μ a b
   ∫ x in a..b, f x ∂μ + ∫ x in b..c, f x ∂μ + ∫ x in c..a, f x ∂μ = 0 :=
 begin
   have hac := hab.trans hbc,
-  simp only [interval_integral, ← add_sub_comm, sub_eq_zero],
+  simp only [interval_integral, sub_add_sub_comm, sub_eq_zero],
   iterate 4 { rw ← integral_union },
   { suffices : Ioc a b ∪ Ioc b c ∪ Ioc c a = Ioc b a ∪ Ioc c b ∪ Ioc a c, by rw this,
     rw [Ioc_union_Ioc_union_Ioc_cycle, union_right_comm, Ioc_union_Ioc_union_Ioc_cycle,
@@ -827,12 +824,11 @@ by { rw [integral_interval_sub_interval_comm hab hcd hac, integral_symm b d, int
 lemma integral_Iic_sub_Iic (ha : integrable_on f (Iic a) μ) (hb : integrable_on f (Iic b) μ) :
   ∫ x in Iic b, f x ∂μ - ∫ x in Iic a, f x ∂μ = ∫ x in a..b, f x ∂μ :=
 begin
-  wlog hab : a ≤ b using [a b] tactic.skip,
-  { rw [sub_eq_iff_eq_add', integral_of_le hab, ← integral_union (Iic_disjoint_Ioc le_rfl),
-      Iic_union_Ioc_eq_Iic hab],
-    exacts [measurable_set_Ioc, ha, hb.mono_set (λ _, and.right)] },
-  { intros ha hb,
-    rw [integral_symm, ← this hb ha, neg_sub] }
+  wlog hab : a ≤ b generalizing a b,
+  { rw [integral_symm, ← this hb ha (le_of_not_le hab), neg_sub] },
+  rw [sub_eq_iff_eq_add', integral_of_le hab, ← integral_union (Iic_disjoint_Ioc le_rfl),
+    Iic_union_Ioc_eq_Iic hab],
+  exacts [measurable_set_Ioc, ha, hb.mono_set (λ _, and.right)]
 end
 
 /-- If `μ` is a finite measure then `∫ x in a..b, c ∂μ = (μ (Iic b) - μ (Iic a)) • c`. -/
@@ -862,7 +858,7 @@ by simp only [interval_integral, set_integral_congr_ae (measurable_set_Ioc) h,
 
 lemma integral_congr_ae (h : ∀ᵐ x ∂μ, x ∈ Ι a b → f x = g x) :
   ∫ x in a..b, f x ∂μ = ∫ x in a..b, g x ∂μ :=
-integral_congr_ae' (ae_interval_oc_iff.mp h).1 (ae_interval_oc_iff.mp h).2
+integral_congr_ae' (ae_uIoc_iff.mp h).1 (ae_uIoc_iff.mp h).2
 
 lemma integral_zero_ae (h : ∀ᵐ x ∂μ, x ∈ Ι a b → f x = 0) :
   ∫ x in a..b, f x ∂μ = 0 :=
@@ -883,34 +879,58 @@ end
 lemma tendsto_integral_filter_of_dominated_convergence {ι} {l : filter ι}
   [l.is_countably_generated] {F : ι → ℝ → E} (bound : ℝ → ℝ)
   (hF_meas : ∀ᶠ n in l, ae_strongly_measurable (F n) (μ.restrict (Ι a b)))
-  (h_bound : ∀ᶠ n in l, ∀ᵐ x ∂μ, x ∈ Ι a b → ∥F n x∥ ≤ bound x)
+  (h_bound : ∀ᶠ n in l, ∀ᵐ x ∂μ, x ∈ Ι a b → ‖F n x‖ ≤ bound x)
   (bound_integrable : interval_integrable bound μ a b)
   (h_lim : ∀ᵐ x ∂μ, x ∈ Ι a b → tendsto (λ n, F n x) l (𝓝 (f x))) :
   tendsto (λn, ∫ x in a..b, F n x ∂μ) l (𝓝 $ ∫ x in a..b, f x ∂μ) :=
 begin
-  simp only [interval_integrable_iff, interval_integral_eq_integral_interval_oc,
-    ← ae_restrict_iff' measurable_set_interval_oc] at *,
+  simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc,
+    ← ae_restrict_iff' measurable_set_uIoc] at *,
   exact tendsto_const_nhds.smul
     (tendsto_integral_filter_of_dominated_convergence bound hF_meas h_bound bound_integrable h_lim)
 end
 
 /-- Lebesgue dominated convergence theorem for series. -/
-lemma has_sum_integral_of_dominated_convergence {ι} [encodable ι]
+lemma has_sum_integral_of_dominated_convergence {ι} [countable ι]
   {F : ι → ℝ → E} (bound : ι → ℝ → ℝ)
   (hF_meas : ∀ n, ae_strongly_measurable (F n) (μ.restrict (Ι a b)))
-  (h_bound : ∀ n, ∀ᵐ t ∂μ, t ∈ Ι a b → ∥F n t∥ ≤ bound n t)
+  (h_bound : ∀ n, ∀ᵐ t ∂μ, t ∈ Ι a b → ‖F n t‖ ≤ bound n t)
   (bound_summable : ∀ᵐ t ∂μ, t ∈ Ι a b → summable (λ n, bound n t))
   (bound_integrable : interval_integrable (λ t, ∑' n, bound n t) μ a b)
   (h_lim : ∀ᵐ t ∂μ, t ∈ Ι a b → has_sum (λ n, F n t) (f t)) :
   has_sum (λn, ∫ t in a..b, F n t ∂μ) (∫ t in a..b, f t ∂μ) :=
 begin
-  simp only [interval_integrable_iff, interval_integral_eq_integral_interval_oc,
-    ← ae_restrict_iff' measurable_set_interval_oc] at *,
+  simp only [interval_integrable_iff, interval_integral_eq_integral_uIoc,
+    ← ae_restrict_iff' measurable_set_uIoc] at *,
   exact (has_sum_integral_of_dominated_convergence bound hF_meas h_bound bound_summable
-    bound_integrable h_lim).const_smul
+    bound_integrable h_lim).const_smul _,
 end
 
 open topological_space
+
+/-- Interval integrals commute with countable sums, when the supremum norms are summable (a
+special case of the dominated convergence theorem). -/
+lemma has_sum_interval_integral_of_summable_norm [countable ι] {f : ι → C(ℝ, E)}
+  (hf_sum : summable (λ i : ι, ‖(f i).restrict (⟨uIcc a b, is_compact_uIcc⟩ : compacts ℝ)‖)) :
+  has_sum (λ i : ι, ∫ x in a..b, f i x) (∫ x in a..b, (∑' i : ι, f i x)) :=
+begin
+  refine has_sum_integral_of_dominated_convergence
+    (λ i (x : ℝ), ‖(f i).restrict ↑(⟨uIcc a b, is_compact_uIcc⟩ : compacts ℝ)‖)
+    (λ i, (map_continuous $ f i).ae_strongly_measurable)
+    (λ i, ae_of_all _ (λ x hx, ((f i).restrict ↑(⟨uIcc a b, is_compact_uIcc⟩ :
+      compacts ℝ)).norm_coe_le_norm ⟨x, ⟨hx.1.le, hx.2⟩⟩))
+    (ae_of_all _ (λ x hx, hf_sum))
+    interval_integrable_const
+    (ae_of_all _ (λ x hx, summable.has_sum _)),
+  -- next line is slow, & doesn't work with "exact" in place of "apply" -- ?
+  apply continuous_map.summable_apply (summable_of_summable_norm hf_sum) ⟨x, ⟨hx.1.le, hx.2⟩⟩,
+end
+
+lemma tsum_interval_integral_eq_of_summable_norm [countable ι] {f : ι → C(ℝ, E)}
+  (hf_sum : summable (λ i : ι, ‖(f i).restrict (⟨uIcc a b, is_compact_uIcc⟩ : compacts ℝ)‖)) :
+  ∑' (i : ι), ∫ x in a..b, f i x = ∫ x in a..b, (∑' i : ι, f i x) :=
+(has_sum_interval_integral_of_summable_norm hf_sum).tsum_eq
+
 variables {X : Type*} [topological_space X] [first_countable_topology X]
 
 /-- Continuity of interval integral with respect to a parameter, at a point within a set.
@@ -922,7 +942,7 @@ variables {X : Type*} [topological_space X] [first_countable_topology X]
 lemma continuous_within_at_of_dominated_interval
   {F : X → ℝ → E} {x₀ : X} {bound : ℝ → ℝ} {a b : ℝ} {s : set X}
   (hF_meas : ∀ᶠ x in 𝓝[s] x₀, ae_strongly_measurable (F x) (μ.restrict $ Ι a b))
-  (h_bound : ∀ᶠ x in 𝓝[s] x₀, ∀ᵐ t ∂μ, t ∈ Ι a b → ∥F x t∥ ≤ bound t)
+  (h_bound : ∀ᶠ x in 𝓝[s] x₀, ∀ᵐ t ∂μ, t ∈ Ι a b → ‖F x t‖ ≤ bound t)
   (bound_integrable : interval_integrable bound μ a b)
   (h_cont : ∀ᵐ t ∂μ, t ∈ Ι a b → continuous_within_at (λ x, F x t) s x₀) :
   continuous_within_at (λ x, ∫ t in a..b, F x t ∂μ) s x₀ :=
@@ -937,7 +957,7 @@ tendsto_integral_filter_of_dominated_convergence bound hF_meas h_bound bound_int
 lemma continuous_at_of_dominated_interval
   {F : X → ℝ → E} {x₀ : X} {bound : ℝ → ℝ} {a b : ℝ}
   (hF_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (F x) (μ.restrict $ Ι a b))
-  (h_bound : ∀ᶠ x in 𝓝 x₀, ∀ᵐ t ∂μ, t ∈ Ι a b → ∥F x t∥ ≤ bound t)
+  (h_bound : ∀ᶠ x in 𝓝 x₀, ∀ᵐ t ∂μ, t ∈ Ι a b → ‖F x t‖ ≤ bound t)
   (bound_integrable : interval_integrable bound μ a b)
   (h_cont : ∀ᵐ t ∂μ, t ∈ Ι a b → continuous_at (λ x, F x t) x₀) :
   continuous_at (λ x, ∫ t in a..b, F x t ∂μ) x₀ :=
@@ -950,7 +970,7 @@ tendsto_integral_filter_of_dominated_convergence bound hF_meas h_bound bound_int
   then the same holds for `(λ x, ∫ t in a..b, F x t ∂μ) s x₀`. -/
 lemma continuous_of_dominated_interval {F : X → ℝ → E} {bound : ℝ → ℝ} {a b : ℝ}
   (hF_meas : ∀ x, ae_strongly_measurable (F x) $ μ.restrict $ Ι a b)
-  (h_bound : ∀ x, ∀ᵐ t ∂μ, t ∈ Ι a b → ∥F x t∥ ≤ bound t)
+  (h_bound : ∀ x, ∀ᵐ t ∂μ, t ∈ Ι a b → ‖F x t‖ ≤ bound t)
   (bound_integrable : interval_integrable bound μ a b)
   (h_cont : ∀ᵐ t ∂μ, t ∈ Ι a b → continuous (λ x, F x t)) :
   continuous (λ x, ∫ t in a..b, F x t ∂μ) :=
@@ -975,7 +995,7 @@ begin
     have h_int' : ∀ {x}, x ∈ Icc b₁ b₂ → interval_integrable f μ b₁ x,
     { rintros x ⟨h₁, h₂⟩,
       apply h_int.mono_set,
-      apply interval_subset_interval,
+      apply uIcc_subset_uIcc,
       { exact ⟨min_le_of_left_le (min_le_right a b₁),
                 h₁.trans (h₂.trans $ le_max_of_le_right $ le_max_right _ _)⟩ },
       { exact ⟨min_le_of_left_le $ (min_le_right _ _).trans h₁,
@@ -984,7 +1004,7 @@ begin
     { rintros b ⟨h₁, h₂⟩,
       rw ← integral_add_adjacent_intervals _ (h_int' ⟨h₁, h₂⟩),
       apply h_int.mono_set,
-      apply interval_subset_interval,
+      apply uIcc_subset_uIcc,
       { exact ⟨min_le_of_left_le (min_le_left a b₁), le_max_of_le_right (le_max_left _ _)⟩ },
       { exact ⟨min_le_of_left_le (min_le_right _ _),
                 le_max_of_le_right (h₁.trans $ h₂.trans (le_max_right a b₂))⟩ } },
@@ -996,7 +1016,7 @@ begin
       exact λ b b_in, (integral_indicator b_in).symm },
 
     apply continuous_within_at.congr_of_eventually_eq _ this (integral_indicator h₀).symm,
-    have : interval_integrable (λ x, ∥f x∥) μ b₁ b₂,
+    have : interval_integrable (λ x, ‖f x‖) μ b₁ b₂,
       from interval_integrable.norm (h_int' $ right_mem_Icc.mpr h₁₂),
     refine continuous_within_at_of_dominated_interval _ _ this _ ; clear this,
     { apply eventually.mono (self_mem_nhds_within),
@@ -1039,7 +1059,7 @@ begin
   by_cases h : a ≤ b,
   { have : ∀ x ∈ Icc a b, ∫ t in Ioc a x, f t ∂μ = ∫ t in a..x, f t ∂μ,
     { intros x x_in,
-      simp_rw [← interval_oc_of_le h, integral_of_le x_in.1] },
+      simp_rw [← uIoc_of_le h, integral_of_le x_in.1] },
     rw continuous_on_congr this,
     intros x₀ hx₀,
     refine continuous_within_at_primitive (measure_singleton x₀) _,
@@ -1065,19 +1085,19 @@ begin
   intros b₀ hb₀,
   refine continuous_within_at_primitive (measure_singleton _) _,
   rw [min_eq_right ha.1, max_eq_right ha.2],
-  simpa [interval_integrable_iff, interval_oc] using h_int,
+  simpa [interval_integrable_iff, uIoc] using h_int,
 end
 
 lemma continuous_on_primitive_interval [has_no_atoms μ]
-  (h_int : integrable_on f (interval a b) μ) :
-  continuous_on (λ x, ∫ t in a..x, f t ∂ μ) (interval a b) :=
-continuous_on_primitive_interval' h_int.interval_integrable left_mem_interval
+  (h_int : integrable_on f (uIcc a b) μ) :
+  continuous_on (λ x, ∫ t in a..x, f t ∂ μ) (uIcc a b) :=
+continuous_on_primitive_interval' h_int.interval_integrable left_mem_uIcc
 
 lemma continuous_on_primitive_interval_left [has_no_atoms μ]
-  (h_int : integrable_on f (interval a b) μ) :
-  continuous_on (λ x, ∫ t in x..b, f t ∂ μ) (interval a b) :=
+  (h_int : integrable_on f (uIcc a b) μ) :
+  continuous_on (λ x, ∫ t in x..b, f t ∂ μ) (uIcc a b) :=
 begin
-  rw interval_swap a b at h_int ⊢,
+  rw uIcc_comm a b at h_int ⊢,
   simp only [integral_symm b],
   exact (continuous_on_primitive_interval h_int).neg,
 end
@@ -1120,7 +1140,7 @@ begin
   { rw [integral_symm, neg_eq_zero, integral_eq_zero_iff_of_le_of_nonneg_ae hab hf hfi.symm] }
 end
 
-/-- If `f` is nonnegative and integrable on the unordered interval `set.interval_oc a b`, then its
+/-- If `f` is nonnegative and integrable on the unordered interval `set.uIoc a b`, then its
 integral over `a..b` is positive if and only if `a < b` and the measure of
 `function.support f ∩ set.Ioc a b` is positive. -/
 lemma integral_pos_iff_support_of_nonneg_ae'
@@ -1128,34 +1148,46 @@ lemma integral_pos_iff_support_of_nonneg_ae'
   0 < ∫ x in a..b, f x ∂μ ↔ a < b ∧ 0 < μ (support f ∩ Ioc a b) :=
 begin
   cases lt_or_le a b with hab hba,
-  { rw interval_oc_of_le hab.le at hf,
+  { rw uIoc_of_le hab.le at hf,
     simp only [hab, true_and, integral_of_le hab.le,
       set_integral_pos_iff_support_of_nonneg_ae hf hfi.1] },
   { suffices : ∫ x in a..b, f x ∂μ ≤ 0, by simp only [this.not_lt, hba.not_lt, false_and],
     rw [integral_of_ge hba, neg_nonpos],
-    rw [interval_oc_swap, interval_oc_of_le hba] at hf,
+    rw [uIoc_swap, uIoc_of_le hba] at hf,
     exact integral_nonneg_of_ae hf }
 end
 
 /-- If `f` is nonnegative a.e.-everywhere and it is integrable on the unordered interval
-`set.interval_oc a b`, then its integral over `a..b` is positive if and only if `a < b` and the
+`set.uIoc a b`, then its integral over `a..b` is positive if and only if `a < b` and the
 measure of `function.support f ∩ set.Ioc a b` is positive. -/
 lemma integral_pos_iff_support_of_nonneg_ae (hf : 0 ≤ᵐ[μ] f) (hfi : interval_integrable f μ a b) :
   0 < ∫ x in a..b, f x ∂μ ↔ a < b ∧ 0 < μ (support f ∩ Ioc a b) :=
 integral_pos_iff_support_of_nonneg_ae' (ae_mono measure.restrict_le_self hf) hfi
 
-/-- If `f : ℝ → ℝ` is strictly positive and integrable on `(a, b]` for real numbers `a < b`, then
-its integral over `a..b` is strictly positive. -/
-lemma interval_integral_pos_of_pos {f : ℝ → ℝ} {a b : ℝ}
-  (hfi : interval_integrable f measure_space.volume a b) (h : ∀ x, 0 < f x) (hab : a < b) :
-  0 < ∫ x in a..b, f x :=
+/-- If `f : ℝ → ℝ` is integrable on `(a, b]` for real numbers `a < b`, and positive on the interior
+of the interval, then its integral over `a..b` is strictly positive. -/
+lemma interval_integral_pos_of_pos_on {f : ℝ → ℝ} {a b : ℝ}
+  (hfi : interval_integrable f volume a b) (hpos : ∀ (x : ℝ), x ∈ Ioo a b → 0 < f x) (hab : a < b) :
+  0 < ∫ (x : ℝ) in a..b, f x :=
 begin
-  have hsupp : support f = univ := eq_univ_iff_forall.mpr (λ t, (h t).ne.symm),
-  replace h₀ : 0 ≤ᵐ[volume] f := eventually_of_forall (λ x, (h x).le),
-  rw integral_pos_iff_support_of_nonneg_ae h₀ hfi,
-  exact ⟨hab, by simp [hsupp, hab]⟩,
+  have hsupp : Ioo a b ⊆ support f ∩ Ioc a b :=
+    λ x hx, ⟨mem_support.mpr (hpos x hx).ne', Ioo_subset_Ioc_self hx⟩,
+  have h₀ : 0 ≤ᵐ[volume.restrict (uIoc a b)] f,
+  { rw [eventually_le, uIoc_of_le hab.le],
+    refine ae_restrict_of_ae_eq_of_ae_restrict Ioo_ae_eq_Ioc _,
+    exact (ae_restrict_iff' measurable_set_Ioo).mpr (ae_of_all _ (λ x hx, (hpos x hx).le)) },
+  rw integral_pos_iff_support_of_nonneg_ae' h₀ hfi,
+  exact ⟨hab, ((measure.measure_Ioo_pos _).mpr hab).trans_le (measure_mono hsupp)⟩,
 end
 
+/-- If `f : ℝ → ℝ` is strictly positive everywhere, and integrable on `(a, b]` for real numbers
+`a < b`, then its integral over `a..b` is strictly positive. (See `interval_integral_pos_of_pos_on`
+for a version only assuming positivity of `f` on `(a, b)` rather than everywhere.) -/
+lemma interval_integral_pos_of_pos {f : ℝ → ℝ} {a b : ℝ}
+  (hfi : interval_integrable f measure_space.volume a b) (hpos : ∀ x, 0 < f x) (hab : a < b) :
+  0 < ∫ x in a..b, f x :=
+interval_integral_pos_of_pos_on hfi (λ x hx, hpos x) hab
+
 /-- If `f` and `g` are two functions that are interval integrable on `a..b`, `a ≤ b`,
 `f x ≤ g x` for a.e. `x ∈ set.Ioc a b`, and `f x < g x` on a subset of `set.Ioc a b`
 of nonzero measure, then `∫ x in a..b, f x ∂μ < ∫ x in a..b, g x ∂μ`. -/
@@ -1249,1224 +1281,37 @@ lemma abs_integral_mono_interval {c d } (h : Ι a b ⊆ Ι c d)
   (hf : 0 ≤ᵐ[μ.restrict (Ι c d)] f) (hfi : interval_integrable f μ c d) :
   |∫ x in a..b, f x ∂μ| ≤ |∫ x in c..d, f x ∂μ| :=
 have hf' : 0 ≤ᵐ[μ.restrict (Ι a b)] f, from ae_mono (measure.restrict_mono h le_rfl) hf,
-calc |∫ x in a..b, f x ∂μ| = |∫ x in Ι a b, f x ∂μ| : abs_integral_eq_abs_integral_interval_oc f
+calc |∫ x in a..b, f x ∂μ| = |∫ x in Ι a b, f x ∂μ| : abs_integral_eq_abs_integral_uIoc f
 ... = ∫ x in Ι a b, f x ∂μ : abs_of_nonneg (measure_theory.integral_nonneg_of_ae hf')
 ... ≤ ∫ x in Ι c d, f x ∂μ : set_integral_mono_set hfi.def hf h.eventually_le
 ... ≤ |∫ x in Ι c d, f x ∂μ| : le_abs_self _
-... = |∫ x in c..d, f x ∂μ| : (abs_integral_eq_abs_integral_interval_oc f).symm
+... = |∫ x in c..d, f x ∂μ| : (abs_integral_eq_abs_integral_uIoc f).symm
 
 end mono
 
 end
 
-/-!
-### Fundamental theorem of calculus, part 1, for any measure
-
-In this section we prove a few lemmas that can be seen as versions of FTC-1 for interval integrals
-w.r.t. any measure. Many theorems are formulated for one or two pairs of filters related by
-`FTC_filter a l l'`. This typeclass has exactly four “real” instances: `(a, pure a, ⊥)`,
-`(a, 𝓝[≥] a, 𝓝[>] a)`, `(a, 𝓝[≤] a, 𝓝[≤] a)`, `(a, 𝓝 a, 𝓝 a)`, and two instances
-that are equal to the first and last “real” instances: `(a, 𝓝[{a}] a, ⊥)` and
-`(a, 𝓝[univ] a, 𝓝[univ] a)`.  We use this approach to avoid repeating arguments in many very similar
-cases.  Lean can automatically find both `a` and `l'` based on `l`.
-
-The most general theorem `measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae` can be seen
-as a generalization of lemma `integral_has_strict_fderiv_at` below which states strict
-differentiability of `∫ x in u..v, f x` in `(u, v)` at `(a, b)` for a measurable function `f` that
-is integrable on `a..b` and is continuous at `a` and `b`. The lemma is generalized in three
-directions: first, `measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae` deals with any
-locally finite measure `μ`; second, it works for one-sided limits/derivatives; third, it assumes
-only that `f` has finite limits almost surely at `a` and `b`.
-
-Namely, let `f` be a measurable function integrable on `a..b`. Let `(la, la')` be a pair of
-`FTC_filter`s around `a`; let `(lb, lb')` be a pair of `FTC_filter`s around `b`. Suppose that `f`
-has finite limits `ca` and `cb` at `la' ⊓ μ.ae` and `lb' ⊓ μ.ae`, respectively.  Then
-`∫ x in va..vb, f x ∂μ - ∫ x in ua..ub, f x ∂μ = ∫ x in ub..vb, cb ∂μ - ∫ x in ua..va, ca ∂μ +
-  o(∥∫ x in ua..va, (1:ℝ) ∂μ∥ + ∥∫ x in ub..vb, (1:ℝ) ∂μ∥)`
-as `ua` and `va` tend to `la` while `ub` and `vb` tend to `lb`.
-
-This theorem is formulated with integral of constants instead of measures in the right hand sides
-for two reasons: first, this way we avoid `min`/`max` in the statements; second, often it is
-possible to write better `simp` lemmas for these integrals, see `integral_const` and
-`integral_const_of_cdf`.
-
-In the next subsection we apply this theorem to prove various theorems about differentiability
-of the integral w.r.t. Lebesgue measure. -/
-
-/-- An auxiliary typeclass for the Fundamental theorem of calculus, part 1. It is used to formulate
-theorems that work simultaneously for left and right one-sided derivatives of `∫ x in u..v, f x`. -/
-class FTC_filter (a : out_param ℝ) (outer : filter ℝ) (inner : out_param $ filter ℝ)
-  extends tendsto_Ixx_class Ioc outer inner : Prop :=
-(pure_le : pure a ≤ outer)
-(le_nhds : inner ≤ 𝓝 a)
-[meas_gen : is_measurably_generated inner]
-
-/- The `dangerous_instance` linter doesn't take `out_param`s into account, so it thinks that
-`FTC_filter.to_tendsto_Ixx_class` is dangerous. Disable this linter using `nolint`.
--/
-attribute [nolint dangerous_instance] FTC_filter.to_tendsto_Ixx_class
-
-namespace FTC_filter
-
-instance pure (a : ℝ) : FTC_filter a (pure a) ⊥ :=
-{ pure_le := le_rfl,
-  le_nhds := bot_le }
-
-instance nhds_within_singleton (a : ℝ) : FTC_filter a (𝓝[{a}] a) ⊥ :=
-by { rw [nhds_within, principal_singleton, inf_eq_right.2 (pure_le_nhds a)], apply_instance }
-
-lemma finite_at_inner {a : ℝ} (l : filter ℝ) {l'} [h : FTC_filter a l l']
-  {μ : measure ℝ} [is_locally_finite_measure μ] :
-  μ.finite_at_filter l' :=
-(μ.finite_at_nhds a).filter_mono h.le_nhds
-
-instance nhds (a : ℝ) : FTC_filter a (𝓝 a) (𝓝 a) :=
-{ pure_le := pure_le_nhds a,
-  le_nhds := le_rfl }
-
-instance nhds_univ (a : ℝ) : FTC_filter a (𝓝[univ] a) (𝓝 a) :=
-by { rw nhds_within_univ, apply_instance }
-
-instance nhds_left (a : ℝ) : FTC_filter a (𝓝[≤] a) (𝓝[≤] a) :=
-{ pure_le := pure_le_nhds_within right_mem_Iic,
-  le_nhds := inf_le_left }
+section has_sum
+variables {μ : measure ℝ} {f : ℝ → E}
 
-instance nhds_right (a : ℝ) : FTC_filter a (𝓝[≥] a) (𝓝[>] a) :=
-{ pure_le := pure_le_nhds_within left_mem_Ici,
-  le_nhds := inf_le_left }
-
-instance nhds_Icc {x a b : ℝ} [h : fact (x ∈ Icc a b)] :
-  FTC_filter x (𝓝[Icc a b] x) (𝓝[Icc a b] x) :=
-{ pure_le := pure_le_nhds_within h.out,
-  le_nhds := inf_le_left }
-
-instance nhds_interval {x a b : ℝ} [h : fact (x ∈ [a, b])] :
-  FTC_filter x (𝓝[[a, b]] x) (𝓝[[a, b]] x) :=
-by { haveI : fact (x ∈ set.Icc (min a b) (max a b)) := h, exact FTC_filter.nhds_Icc }
-
-end FTC_filter
-
-open asymptotics
-
-section
-
-variables {f : ℝ → E} {a b : ℝ} {c ca cb : E} {l l' la la' lb lb' : filter ℝ} {lt : filter ι}
-  {μ : measure ℝ} {u v ua va ub vb : ι → ℝ}
-
-/-- Fundamental theorem of calculus-1, local version for any measure.
-Let filters `l` and `l'` be related by `tendsto_Ixx_class Ioc`.
-If `f` has a finite limit `c` at `l' ⊓ μ.ae`, where `μ` is a measure
-finite at `l'`, then `∫ x in u..v, f x ∂μ = ∫ x in u..v, c ∂μ + o(∫ x in u..v, 1 ∂μ)` as both
-`u` and `v` tend to `l`.
-
-See also `measure_integral_sub_linear_is_o_of_tendsto_ae` for a version assuming
-`[FTC_filter a l l']` and `[is_locally_finite_measure μ]`. If `l` is one of `𝓝[≥] a`,
-`𝓝[≤] a`, `𝓝 a`, then it's easier to apply the non-primed version.
-The primed version also works, e.g., for `l = l' = at_top`.
-
-We use integrals of constants instead of measures because this way it is easier to formulate
-a statement that works in both cases `u ≤ v` and `v ≤ u`. -/
-lemma measure_integral_sub_linear_is_o_of_tendsto_ae'
-  [is_measurably_generated l'] [tendsto_Ixx_class Ioc l l']
-  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
-  (hl : μ.finite_at_filter l')
-  (hu : tendsto u lt l) (hv : tendsto v lt l) :
-  is_o (λ t, ∫ x in u t..v t, f x ∂μ - ∫ x in u t..v t, c ∂μ)
-    (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) lt :=
+lemma _root_.measure_theory.integrable.has_sum_interval_integral (hfi : integrable f μ) (y : ℝ) :
+  has_sum (λ (n : ℤ), ∫ x in (y + n)..(y + n + 1), f x ∂μ) (∫ x, f x ∂μ) :=
 begin
-  have A := hf.integral_sub_linear_is_o_ae hfm hl (hu.Ioc hv),
-  have B := hf.integral_sub_linear_is_o_ae hfm hl (hv.Ioc hu),
-  simp only [integral_const'],
-  convert (A.trans_le _).sub (B.trans_le _),
-  { ext t,
-    simp_rw [interval_integral, sub_smul],
-    abel },
-  all_goals { intro t, cases le_total (u t) (v t) with huv huv; simp [huv] }
+  simp_rw integral_of_le (le_add_of_nonneg_right zero_le_one),
+  rw [←integral_univ, ←Union_Ioc_add_int_cast y],
+  exact has_sum_integral_Union (λ i, measurable_set_Ioc) (pairwise_disjoint_Ioc_add_int_cast y)
+    hfi.integrable_on,
 end
 
-/-- Fundamental theorem of calculus-1, local version for any measure.
-Let filters `l` and `l'` be related by `tendsto_Ixx_class Ioc`.
-If `f` has a finite limit `c` at `l ⊓ μ.ae`, where `μ` is a measure
-finite at `l`, then `∫ x in u..v, f x ∂μ = μ (Ioc u v) • c + o(μ(Ioc u v))` as both
-`u` and `v` tend to `l` so that `u ≤ v`.
-
-See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_le` for a version assuming
-`[FTC_filter a l l']` and `[is_locally_finite_measure μ]`. If `l` is one of `𝓝[≥] a`,
-`𝓝[≤] a`, `𝓝 a`, then it's easier to apply the non-primed version.
-The primed version also works, e.g., for `l = l' = at_top`. -/
-lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_le'
-  [is_measurably_generated l'] [tendsto_Ixx_class Ioc l l']
-  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
-  (hl : μ.finite_at_filter l') (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : u ≤ᶠ[lt] v) :
-  is_o (λ t, ∫ x in u t..v t, f x ∂μ - (μ (Ioc (u t) (v t))).to_real • c)
-    (λ t, (μ $ Ioc (u t) (v t)).to_real) lt :=
-(measure_integral_sub_linear_is_o_of_tendsto_ae' hfm hf hl hu hv).congr'
-  (huv.mono $ λ x hx, by simp [integral_const', hx])
-  (huv.mono $ λ x hx, by simp [integral_const', hx])
-
-/-- Fundamental theorem of calculus-1, local version for any measure.
-Let filters `l` and `l'` be related by `tendsto_Ixx_class Ioc`.
-If `f` has a finite limit `c` at `l ⊓ μ.ae`, where `μ` is a measure
-finite at `l`, then `∫ x in u..v, f x ∂μ = -μ (Ioc v u) • c + o(μ(Ioc v u))` as both
-`u` and `v` tend to `l` so that `v ≤ u`.
-
-See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge` for a version assuming
-`[FTC_filter a l l']` and `[is_locally_finite_measure μ]`. If `l` is one of `𝓝[≥] a`,
-`𝓝[≤] a`, `𝓝 a`, then it's easier to apply the non-primed version.
-The primed version also works, e.g., for `l = l' = at_top`. -/
-lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge'
-  [is_measurably_generated l'] [tendsto_Ixx_class Ioc l l']
-  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
-  (hl : μ.finite_at_filter l') (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : v ≤ᶠ[lt] u) :
-  is_o (λ t, ∫ x in u t..v t, f x ∂μ + (μ (Ioc (v t) (u t))).to_real • c)
-    (λ t, (μ $ Ioc (v t) (u t)).to_real) lt :=
-(measure_integral_sub_linear_is_o_of_tendsto_ae_of_le' hfm hf hl hv hu huv).neg_left.congr_left $
-  λ t, by simp [integral_symm (u t), add_comm]
-
-section
-
-variables [is_locally_finite_measure μ] [FTC_filter a l l']
-
-include a
-
-local attribute [instance] FTC_filter.meas_gen
-
-/-- Fundamental theorem of calculus-1, local version for any measure.
-Let filters `l` and `l'` be related by `[FTC_filter a l l']`; let `μ` be a locally finite measure.
-If `f` has a finite limit `c` at `l' ⊓ μ.ae`, then
-`∫ x in u..v, f x ∂μ = ∫ x in u..v, c ∂μ + o(∫ x in u..v, 1 ∂μ)` as both `u` and `v` tend to `l`.
-
-See also `measure_integral_sub_linear_is_o_of_tendsto_ae'` for a version that also works, e.g., for
-`l = l' = at_top`.
-
-We use integrals of constants instead of measures because this way it is easier to formulate
-a statement that works in both cases `u ≤ v` and `v ≤ u`. -/
-lemma measure_integral_sub_linear_is_o_of_tendsto_ae (hfm : strongly_measurable_at_filter f l' μ)
-  (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c)) (hu : tendsto u lt l) (hv : tendsto v lt l) :
-  is_o (λ t, ∫ x in u t..v t, f x ∂μ - ∫ x in u t..v t, c ∂μ)
-    (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) lt :=
-measure_integral_sub_linear_is_o_of_tendsto_ae' hfm hf (FTC_filter.finite_at_inner l) hu hv
-
-/-- Fundamental theorem of calculus-1, local version for any measure.
-Let filters `l` and `l'` be related by `[FTC_filter a l l']`; let `μ` be a locally finite measure.
-If `f` has a finite limit `c` at `l' ⊓ μ.ae`, then
-`∫ x in u..v, f x ∂μ = μ (Ioc u v) • c + o(μ(Ioc u v))` as both `u` and `v` tend to `l`.
-
-See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_le'` for a version that also works,
-e.g., for `l = l' = at_top`. -/
-lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_le
-  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
-  (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : u ≤ᶠ[lt] v) :
-  is_o (λ t, ∫ x in u t..v t, f x ∂μ - (μ (Ioc (u t) (v t))).to_real • c)
-    (λ t, (μ $ Ioc (u t) (v t)).to_real) lt :=
-measure_integral_sub_linear_is_o_of_tendsto_ae_of_le' hfm hf (FTC_filter.finite_at_inner l)
-  hu hv huv
-
-/-- Fundamental theorem of calculus-1, local version for any measure.
-Let filters `l` and `l'` be related by `[FTC_filter a l l']`; let `μ` be a locally finite measure.
-If `f` has a finite limit `c` at `l' ⊓ μ.ae`, then
-`∫ x in u..v, f x ∂μ = -μ (Ioc v u) • c + o(μ(Ioc v u))` as both `u` and `v` tend to `l`.
-
-See also `measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge'` for a version that also works,
-e.g., for `l = l' = at_top`. -/
-lemma measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge
-  (hfm : strongly_measurable_at_filter f l' μ) (hf : tendsto f (l' ⊓ μ.ae) (𝓝 c))
-  (hu : tendsto u lt l) (hv : tendsto v lt l) (huv : v ≤ᶠ[lt] u) :
-  is_o (λ t, ∫ x in u t..v t, f x ∂μ + (μ (Ioc (v t) (u t))).to_real • c)
-    (λ t, (μ $ Ioc (v t) (u t)).to_real) lt :=
-measure_integral_sub_linear_is_o_of_tendsto_ae_of_ge' hfm hf (FTC_filter.finite_at_inner l)
-  hu hv huv
-
-end
-
-local attribute [instance] FTC_filter.meas_gen
-
-variables [FTC_filter a la la'] [FTC_filter b lb lb'] [is_locally_finite_measure μ]
-
-/-- Fundamental theorem of calculus-1, strict derivative in both limits for a locally finite
-measure.
-
-Let `f` be a measurable function integrable on `a..b`. Let `(la, la')` be a pair of `FTC_filter`s
-around `a`; let `(lb, lb')` be a pair of `FTC_filter`s around `b`. Suppose that `f` has finite
-limits `ca` and `cb` at `la' ⊓ μ.ae` and `lb' ⊓ μ.ae`, respectively.
-Then `∫ x in va..vb, f x ∂μ - ∫ x in ua..ub, f x ∂μ =
-  ∫ x in ub..vb, cb ∂μ - ∫ x in ua..va, ca ∂μ +
-    o(∥∫ x in ua..va, (1:ℝ) ∂μ∥ + ∥∫ x in ub..vb, (1:ℝ) ∂μ∥)`
-as `ua` and `va` tend to `la` while `ub` and `vb` tend to `lb`.
--/
-lemma measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae
-  (hab : interval_integrable f μ a b)
-  (hmeas_a : strongly_measurable_at_filter f la' μ)
-  (hmeas_b : strongly_measurable_at_filter f lb' μ)
-  (ha_lim : tendsto f (la' ⊓ μ.ae) (𝓝 ca)) (hb_lim : tendsto f (lb' ⊓ μ.ae) (𝓝 cb))
-  (hua : tendsto ua lt la) (hva : tendsto va lt la)
-  (hub : tendsto ub lt lb) (hvb : tendsto vb lt lb) :
-  is_o (λ t, (∫ x in va t..vb t, f x ∂μ) - (∫ x in ua t..ub t, f x ∂μ) -
-    (∫ x in ub t..vb t, cb ∂μ - ∫ x in ua t..va t, ca ∂μ))
-    (λ t, ∥∫ x in ua t..va t, (1:ℝ) ∂μ∥ + ∥∫ x in ub t..vb t, (1:ℝ) ∂μ∥) lt :=
+lemma _root_.measure_theory.integrable.has_sum_interval_integral_comp_add_int
+  (hfi : integrable f) :
+  has_sum (λ (n : ℤ), ∫ x in 0..1, f (x + n)) (∫ x, f x) :=
 begin
-  refine
-    ((measure_integral_sub_linear_is_o_of_tendsto_ae hmeas_a ha_lim hua hva).neg_left.add_add
-    (measure_integral_sub_linear_is_o_of_tendsto_ae hmeas_b hb_lim hub hvb)).congr'
-      _ eventually_eq.rfl,
-  have A : ∀ᶠ t in lt, interval_integrable f μ (ua t) (va t) :=
-    ha_lim.eventually_interval_integrable_ae hmeas_a (FTC_filter.finite_at_inner la) hua hva,
-  have A' : ∀ᶠ t in lt, interval_integrable f μ a (ua t) :=
-    ha_lim.eventually_interval_integrable_ae hmeas_a (FTC_filter.finite_at_inner la)
-      (tendsto_const_pure.mono_right FTC_filter.pure_le) hua,
-  have B : ∀ᶠ t in lt, interval_integrable f μ (ub t) (vb t) :=
-    hb_lim.eventually_interval_integrable_ae hmeas_b (FTC_filter.finite_at_inner lb) hub hvb,
-  have B' : ∀ᶠ t in lt, interval_integrable f μ b (ub t) :=
-    hb_lim.eventually_interval_integrable_ae hmeas_b (FTC_filter.finite_at_inner lb)
-      (tendsto_const_pure.mono_right FTC_filter.pure_le) hub,
-  filter_upwards [A, A', B, B'] with _ ua_va a_ua ub_vb b_ub,
-  rw [← integral_interval_sub_interval_comm'],
-  { dsimp only [], abel, },
-  exacts [ub_vb, ua_va, b_ub.symm.trans $ hab.symm.trans a_ua]
+  convert hfi.has_sum_interval_integral 0 using 2,
+  ext1 n,
+  rw [integral_comp_add_right, zero_add, add_comm],
 end
 
-/-- Fundamental theorem of calculus-1, strict derivative in right endpoint for a locally finite
-measure.
-
-Let `f` be a measurable function integrable on `a..b`. Let `(lb, lb')` be a pair of `FTC_filter`s
-around `b`. Suppose that `f` has a finite limit `c` at `lb' ⊓ μ.ae`.
-
-Then `∫ x in a..v, f x ∂μ - ∫ x in a..u, f x ∂μ = ∫ x in u..v, c ∂μ + o(∫ x in u..v, (1:ℝ) ∂μ)`
-as `u` and `v` tend to `lb`.
--/
-lemma measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right
-  (hab : interval_integrable f μ a b) (hmeas : strongly_measurable_at_filter f lb' μ)
-  (hf : tendsto f (lb' ⊓ μ.ae) (𝓝 c)) (hu : tendsto u lt lb) (hv : tendsto v lt lb) :
-  is_o (λ t, ∫ x in a..v t, f x ∂μ - ∫ x in a..u t, f x ∂μ - ∫ x in u t..v t, c ∂μ)
-    (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) lt :=
-by simpa using measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae
-  hab strongly_measurable_at_bot hmeas ((tendsto_bot : tendsto _ ⊥ (𝓝 0)).mono_left inf_le_left)
-  hf (tendsto_const_pure : tendsto _ _ (pure a)) tendsto_const_pure hu hv
-
-/-- Fundamental theorem of calculus-1, strict derivative in left endpoint for a locally finite
-measure.
-
-Let `f` be a measurable function integrable on `a..b`. Let `(la, la')` be a pair of `FTC_filter`s
-around `a`. Suppose that `f` has a finite limit `c` at `la' ⊓ μ.ae`.
-
-Then `∫ x in v..b, f x ∂μ - ∫ x in u..b, f x ∂μ = -∫ x in u..v, c ∂μ + o(∫ x in u..v, (1:ℝ) ∂μ)`
-as `u` and `v` tend to `la`.
--/
-lemma measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_left
-  (hab : interval_integrable f μ a b) (hmeas : strongly_measurable_at_filter f la' μ)
-  (hf : tendsto f (la' ⊓ μ.ae) (𝓝 c)) (hu : tendsto u lt la) (hv : tendsto v lt la) :
-  is_o (λ t, ∫ x in v t..b, f x ∂μ - ∫ x in u t..b, f x ∂μ + ∫ x in u t..v t, c ∂μ)
-    (λ t, ∫ x in u t..v t, (1:ℝ) ∂μ) lt :=
-by simpa using measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae
-  hab hmeas strongly_measurable_at_bot hf ((tendsto_bot : tendsto _ ⊥ (𝓝 0)).mono_left inf_le_left)
-  hu hv (tendsto_const_pure : tendsto _ _ (pure b)) tendsto_const_pure
-
-end
-
-/-!
-### Fundamental theorem of calculus-1 for Lebesgue measure
-
-In this section we restate theorems from the previous section for Lebesgue measure.
-In particular, we prove that `∫ x in u..v, f x` is strictly differentiable in `(u, v)`
-at `(a, b)` provided that `f` is integrable on `a..b` and is continuous at `a` and `b`.
--/
-
-variables {f : ℝ → E} {c ca cb : E} {l l' la la' lb lb' : filter ℝ} {lt : filter ι}
-  {a b z : ℝ} {u v ua ub va vb : ι → ℝ} [FTC_filter a la la'] [FTC_filter b lb lb']
-
-/-!
-#### Auxiliary `is_o` statements
-
-In this section we prove several lemmas that can be interpreted as strict differentiability of
-`(u, v) ↦ ∫ x in u..v, f x ∂μ` in `u` and/or `v` at a filter. The statements use `is_o` because
-we have no definition of `has_strict_(f)deriv_at_filter` in the library.
--/
-
-/-- Fundamental theorem of calculus-1, local version. If `f` has a finite limit `c` almost surely at
-`l'`, where `(l, l')` is an `FTC_filter` pair around `a`, then
-`∫ x in u..v, f x ∂μ = (v - u) • c + o (v - u)` as both `u` and `v` tend to `l`. -/
-lemma integral_sub_linear_is_o_of_tendsto_ae [FTC_filter a l l']
-  (hfm : strongly_measurable_at_filter f l') (hf : tendsto f (l' ⊓ volume.ae) (𝓝 c))
-  {u v : ι → ℝ} (hu : tendsto u lt l) (hv : tendsto v lt l) :
-  is_o (λ t, (∫ x in u t..v t, f x) - (v t - u t) • c) (v - u) lt :=
-by simpa [integral_const] using measure_integral_sub_linear_is_o_of_tendsto_ae hfm hf hu hv
-
-/-- Fundamental theorem of calculus-1, strict differentiability at filter in both endpoints.
-If `f` is a measurable function integrable on `a..b`, `(la, la')` is an `FTC_filter` pair around
-`a`, and `(lb, lb')` is an `FTC_filter` pair around `b`, and `f` has finite limits `ca` and `cb`
-almost surely at `la'` and `lb'`, respectively, then
-`(∫ x in va..vb, f x) - ∫ x in ua..ub, f x = (vb - ub) • cb - (va - ua) • ca +
-  o(∥va - ua∥ + ∥vb - ub∥)` as `ua` and `va` tend to `la` while `ub` and `vb` tend to `lb`.
-
-This lemma could've been formulated using `has_strict_fderiv_at_filter` if we had this
-definition. -/
-lemma integral_sub_integral_sub_linear_is_o_of_tendsto_ae
-  (hab : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f la') (hmeas_b : strongly_measurable_at_filter f lb')
-  (ha_lim : tendsto f (la' ⊓ volume.ae) (𝓝 ca)) (hb_lim : tendsto f (lb' ⊓ volume.ae) (𝓝 cb))
-  (hua : tendsto ua lt la) (hva : tendsto va lt la)
-  (hub : tendsto ub lt lb) (hvb : tendsto vb lt lb) :
-  is_o (λ t, (∫ x in va t..vb t, f x) - (∫ x in ua t..ub t, f x) -
-    ((vb t - ub t) • cb - (va t - ua t) • ca)) (λ t, ∥va t - ua t∥ + ∥vb t - ub t∥) lt :=
-by simpa [integral_const]
-  using measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae hab hmeas_a hmeas_b
-    ha_lim hb_lim hua hva hub hvb
-
-/-- Fundamental theorem of calculus-1, strict differentiability at filter in both endpoints.
-If `f` is a measurable function integrable on `a..b`, `(lb, lb')` is an `FTC_filter` pair
-around `b`, and `f` has a finite limit `c` almost surely at `lb'`, then
-`(∫ x in a..v, f x) - ∫ x in a..u, f x = (v - u) • c + o(∥v - u∥)` as `u` and `v` tend to `lb`.
-
-This lemma could've been formulated using `has_strict_deriv_at_filter` if we had this definition. -/
-lemma integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right
-  (hab : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f lb')
-  (hf : tendsto f (lb' ⊓ volume.ae) (𝓝 c)) (hu : tendsto u lt lb) (hv : tendsto v lt lb) :
-  is_o (λ t, (∫ x in a..v t, f x) - (∫ x in a..u t, f x) - (v t - u t) • c) (v - u) lt :=
-by simpa only [integral_const, smul_eq_mul, mul_one] using
-  measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right hab hmeas hf hu hv
-
-/-- Fundamental theorem of calculus-1, strict differentiability at filter in both endpoints.
-If `f` is a measurable function integrable on `a..b`, `(la, la')` is an `FTC_filter` pair
-around `a`, and `f` has a finite limit `c` almost surely at `la'`, then
-`(∫ x in v..b, f x) - ∫ x in u..b, f x = -(v - u) • c + o(∥v - u∥)` as `u` and `v` tend to `la`.
-
-This lemma could've been formulated using `has_strict_deriv_at_filter` if we had this definition. -/
-lemma integral_sub_integral_sub_linear_is_o_of_tendsto_ae_left
-  (hab : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f la')
-  (hf : tendsto f (la' ⊓ volume.ae) (𝓝 c)) (hu : tendsto u lt la) (hv : tendsto v lt la) :
-  is_o (λ t, (∫ x in v t..b, f x) - (∫ x in u t..b, f x) + (v t - u t) • c) (v - u) lt :=
-by simpa only [integral_const, smul_eq_mul, mul_one] using
-  measure_integral_sub_integral_sub_linear_is_o_of_tendsto_ae_left hab hmeas hf hu hv
-
-open continuous_linear_map (fst snd smul_right sub_apply smul_right_apply coe_fst' coe_snd' map_sub)
-
-/-!
-#### Strict differentiability
-
-In this section we prove that for a measurable function `f` integrable on `a..b`,
-
-* `integral_has_strict_fderiv_at_of_tendsto_ae`: the function `(u, v) ↦ ∫ x in u..v, f x` has
-  derivative `(u, v) ↦ v • cb - u • ca` at `(a, b)` in the sense of strict differentiability
-  provided that `f` tends to `ca` and `cb` almost surely as `x` tendsto to `a` and `b`,
-  respectively;
-
-* `integral_has_strict_fderiv_at`: the function `(u, v) ↦ ∫ x in u..v, f x` has
-  derivative `(u, v) ↦ v • f b - u • f a` at `(a, b)` in the sense of strict differentiability
-  provided that `f` is continuous at `a` and `b`;
-
-* `integral_has_strict_deriv_at_of_tendsto_ae_right`: the function `u ↦ ∫ x in a..u, f x` has
-  derivative `c` at `b` in the sense of strict differentiability provided that `f` tends to `c`
-  almost surely as `x` tends to `b`;
-
-* `integral_has_strict_deriv_at_right`: the function `u ↦ ∫ x in a..u, f x` has derivative `f b` at
-  `b` in the sense of strict differentiability provided that `f` is continuous at `b`;
-
-* `integral_has_strict_deriv_at_of_tendsto_ae_left`: the function `u ↦ ∫ x in u..b, f x` has
-  derivative `-c` at `a` in the sense of strict differentiability provided that `f` tends to `c`
-  almost surely as `x` tends to `a`;
-
-* `integral_has_strict_deriv_at_left`: the function `u ↦ ∫ x in u..b, f x` has derivative `-f a` at
-  `a` in the sense of strict differentiability provided that `f` is continuous at `a`.
--/
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has finite
-limits `ca` and `cb` almost surely as `x` tends to `a` and `b`, respectively, then
-`(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca` at `(a, b)`
-in the sense of strict differentiability. -/
-lemma integral_has_strict_fderiv_at_of_tendsto_ae
-  (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
-  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
-  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 cb)) :
-  has_strict_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
-    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) (a, b) :=
-begin
-  have := integral_sub_integral_sub_linear_is_o_of_tendsto_ae hf hmeas_a hmeas_b ha hb
-    ((continuous_fst.comp continuous_snd).tendsto ((a, b), (a, b)))
-    ((continuous_fst.comp continuous_fst).tendsto ((a, b), (a, b)))
-    ((continuous_snd.comp continuous_snd).tendsto ((a, b), (a, b)))
-    ((continuous_snd.comp continuous_fst).tendsto ((a, b), (a, b))),
-  refine (this.congr_left _).trans_is_O _,
-  { intro x, simp [sub_smul] },
-  { exact is_O_fst_prod.norm_left.add is_O_snd_prod.norm_left }
-end
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `a` and `b`, then `(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca`
-at `(a, b)` in the sense of strict differentiability. -/
-lemma integral_has_strict_fderiv_at
-  (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
-  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
-  (ha : continuous_at f a) (hb : continuous_at f b) :
-  has_strict_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
-    ((snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a)) (a, b) :=
-integral_has_strict_fderiv_at_of_tendsto_ae hf hmeas_a hmeas_b
-  (ha.mono_left inf_le_left) (hb.mono_left inf_le_left)
-
-/-- **First Fundamental Theorem of Calculus**: if `f : ℝ → E` is integrable on `a..b` and `f x` has
-a finite limit `c` almost surely at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `c` at `b` in
-the sense of strict differentiability. -/
-lemma integral_has_strict_deriv_at_of_tendsto_ae_right
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
-  (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 c)) : has_strict_deriv_at (λ u, ∫ x in a..u, f x) c b :=
-integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right hf hmeas hb continuous_at_snd
-  continuous_at_fst
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `f b` at `b` in the sense of strict
-differentiability. -/
-lemma integral_has_strict_deriv_at_right
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
-  (hb : continuous_at f b) : has_strict_deriv_at (λ u, ∫ x in a..u, f x) (f b) b :=
-integral_has_strict_deriv_at_of_tendsto_ae_right hf hmeas (hb.mono_left inf_le_left)
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-c` at `a` in the sense
-of strict differentiability. -/
-lemma integral_has_strict_deriv_at_of_tendsto_ae_left
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
-  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 c)) : has_strict_deriv_at (λ u, ∫ x in u..b, f x) (-c) a :=
-by simpa only [← integral_symm]
-  using (integral_has_strict_deriv_at_of_tendsto_ae_right hf.symm hmeas ha).neg
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-f a` at `a` in the sense of strict
-differentiability. -/
-lemma integral_has_strict_deriv_at_left
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
-  (ha : continuous_at f a) : has_strict_deriv_at (λ u, ∫ x in u..b, f x) (-f a) a :=
-by simpa only [← integral_symm] using (integral_has_strict_deriv_at_right hf.symm hmeas ha).neg
-
-/-!
-#### Fréchet differentiability
-
-In this subsection we restate results from the previous subsection in terms of `has_fderiv_at`,
-`has_deriv_at`, `fderiv`, and `deriv`.
--/
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has finite
-limits `ca` and `cb` almost surely as `x` tends to `a` and `b`, respectively, then
-`(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca` at `(a, b)`. -/
-lemma integral_has_fderiv_at_of_tendsto_ae (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
-  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
-  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 cb)) :
-  has_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
-    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) (a, b) :=
-(integral_has_strict_fderiv_at_of_tendsto_ae hf hmeas_a hmeas_b ha hb).has_fderiv_at
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `a` and `b`, then `(u, v) ↦ ∫ x in u..v, f x` has derivative `(u, v) ↦ v • cb - u • ca`
-at `(a, b)`. -/
-lemma integral_has_fderiv_at (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
-  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
-  (ha : continuous_at f a) (hb : continuous_at f b) :
-  has_fderiv_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
-    ((snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a)) (a, b) :=
-(integral_has_strict_fderiv_at hf hmeas_a hmeas_b ha hb).has_fderiv_at
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has finite
-limits `ca` and `cb` almost surely as `x` tends to `a` and `b`, respectively, then `fderiv`
-derivative of `(u, v) ↦ ∫ x in u..v, f x` at `(a, b)` equals `(u, v) ↦ v • cb - u • ca`. -/
-lemma fderiv_integral_of_tendsto_ae (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
-  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
-  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 cb)) :
-  fderiv ℝ (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x) (a, b) =
-    (snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca :=
-(integral_has_fderiv_at_of_tendsto_ae hf hmeas_a hmeas_b ha hb).fderiv
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `a` and `b`, then `fderiv` derivative of `(u, v) ↦ ∫ x in u..v, f x` at `(a, b)` equals `(u, v) ↦
-v • cb - u • ca`. -/
-lemma fderiv_integral (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f (𝓝 a))
-  (hmeas_b : strongly_measurable_at_filter f (𝓝 b))
-  (ha : continuous_at f a) (hb : continuous_at f b) :
-  fderiv ℝ (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x) (a, b) =
-    (snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a) :=
-(integral_has_fderiv_at hf hmeas_a hmeas_b ha hb).fderiv
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `c` at `b`. -/
-lemma integral_has_deriv_at_of_tendsto_ae_right
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
-  (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 c)) : has_deriv_at (λ u, ∫ x in a..u, f x) c b :=
-(integral_has_strict_deriv_at_of_tendsto_ae_right hf hmeas hb).has_deriv_at
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `b`, then `u ↦ ∫ x in a..u, f x` has derivative `f b` at `b`. -/
-lemma integral_has_deriv_at_right
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
-  (hb : continuous_at f b) : has_deriv_at (λ u, ∫ x in a..u, f x) (f b) b :=
-(integral_has_strict_deriv_at_right hf hmeas hb).has_deriv_at
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` has a finite
-limit `c` almost surely at `b`, then the derivative of `u ↦ ∫ x in a..u, f x` at `b` equals `c`. -/
-lemma deriv_integral_of_tendsto_ae_right
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
-  (hb : tendsto f (𝓝 b ⊓ volume.ae) (𝓝 c)) : deriv (λ u, ∫ x in a..u, f x) b = c :=
-(integral_has_deriv_at_of_tendsto_ae_right hf hmeas hb).deriv
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `b`, then the derivative of `u ↦ ∫ x in a..u, f x` at `b` equals `f b`. -/
-lemma deriv_integral_right
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 b))
-  (hb : continuous_at f b) :
-  deriv (λ u, ∫ x in a..u, f x) b = f b :=
-(integral_has_deriv_at_right hf hmeas hb).deriv
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-c` at `a`. -/
-lemma integral_has_deriv_at_of_tendsto_ae_left
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
-  (ha : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 c)) : has_deriv_at (λ u, ∫ x in u..b, f x) (-c) a :=
-(integral_has_strict_deriv_at_of_tendsto_ae_left hf hmeas ha).has_deriv_at
-
-/-- Fundamental theorem of calculus-1: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `a`, then `u ↦ ∫ x in u..b, f x` has derivative `-f a` at `a`. -/
-lemma integral_has_deriv_at_left
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
-  (ha : continuous_at f a) :
-  has_deriv_at (λ u, ∫ x in u..b, f x) (-f a) a :=
-(integral_has_strict_deriv_at_left hf hmeas ha).has_deriv_at
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` has a finite
-limit `c` almost surely at `a`, then the derivative of `u ↦ ∫ x in u..b, f x` at `a` equals `-c`. -/
-lemma deriv_integral_of_tendsto_ae_left
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
-  (hb : tendsto f (𝓝 a ⊓ volume.ae) (𝓝 c)) : deriv (λ u, ∫ x in u..b, f x) a = -c :=
-(integral_has_deriv_at_of_tendsto_ae_left hf hmeas hb).deriv
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f` is continuous
-at `a`, then the derivative of `u ↦ ∫ x in u..b, f x` at `a` equals `-f a`. -/
-lemma deriv_integral_left
-  (hf : interval_integrable f volume a b) (hmeas : strongly_measurable_at_filter f (𝓝 a))
-  (hb : continuous_at f a) :
-  deriv (λ u, ∫ x in u..b, f x) a = -f a :=
-(integral_has_deriv_at_left hf hmeas hb).deriv
-
-/-!
-#### One-sided derivatives
--/
-
-/-- Let `f` be a measurable function integrable on `a..b`. The function `(u, v) ↦ ∫ x in u..v, f x`
-has derivative `(u, v) ↦ v • cb - u • ca` within `s × t` at `(a, b)`, where
-`s ∈ {Iic a, {a}, Ici a, univ}` and `t ∈ {Iic b, {b}, Ici b, univ}` provided that `f` tends to `ca`
-and `cb` almost surely at the filters `la` and `lb` from the following table.
-
-| `s`     | `la`     | `t`     | `lb`     |
-| ------- | ----     | ---     | ----     |
-| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
-| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
-| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
-| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
--/
-lemma integral_has_fderiv_within_at_of_tendsto_ae
-  (hf : interval_integrable f volume a b)
-  {s t : set ℝ} [FTC_filter a (𝓝[s] a) la] [FTC_filter b (𝓝[t] b) lb]
-  (hmeas_a : strongly_measurable_at_filter f la) (hmeas_b : strongly_measurable_at_filter f lb)
-  (ha : tendsto f (la ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (lb ⊓ volume.ae) (𝓝 cb)) :
-  has_fderiv_within_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
-    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) (s ×ˢ t) (a, b) :=
-begin
-  rw [has_fderiv_within_at, nhds_within_prod_eq],
-  have := integral_sub_integral_sub_linear_is_o_of_tendsto_ae hf hmeas_a hmeas_b ha hb
-    (tendsto_const_pure.mono_right FTC_filter.pure_le : tendsto _ _ (𝓝[s] a)) tendsto_fst
-    (tendsto_const_pure.mono_right FTC_filter.pure_le : tendsto _ _ (𝓝[t] b)) tendsto_snd,
-  refine (this.congr_left _).trans_is_O _,
-  { intro x, simp [sub_smul] },
-  { exact is_O_fst_prod.norm_left.add is_O_snd_prod.norm_left }
-end
-
-/-- Let `f` be a measurable function integrable on `a..b`. The function `(u, v) ↦ ∫ x in u..v, f x`
-has derivative `(u, v) ↦ v • f b - u • f a` within `s × t` at `(a, b)`, where
-`s ∈ {Iic a, {a}, Ici a, univ}` and `t ∈ {Iic b, {b}, Ici b, univ}` provided that `f` tends to
-`f a` and `f b` at the filters `la` and `lb` from the following table. In most cases this assumption
-is definitionally equal `continuous_at f _` or `continuous_within_at f _ _`.
-
-| `s`     | `la`     | `t`     | `lb`     |
-| ------- | ----     | ---     | ----     |
-| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
-| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
-| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
-| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
--/
-lemma integral_has_fderiv_within_at
-  (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f la) (hmeas_b : strongly_measurable_at_filter f lb)
-  {s t : set ℝ} [FTC_filter a (𝓝[s] a) la] [FTC_filter b (𝓝[t] b) lb]
-  (ha : tendsto f la (𝓝 $ f a)) (hb : tendsto f lb (𝓝 $ f b)) :
-  has_fderiv_within_at (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x)
-    ((snd ℝ ℝ ℝ).smul_right (f b) - (fst ℝ ℝ ℝ).smul_right (f a)) (s ×ˢ t) (a, b) :=
-integral_has_fderiv_within_at_of_tendsto_ae hf hmeas_a hmeas_b (ha.mono_left inf_le_left)
-  (hb.mono_left inf_le_left)
-
-/-- An auxiliary tactic closing goals `unique_diff_within_at ℝ s a` where
-`s ∈ {Iic a, Ici a, univ}`. -/
-meta def unique_diff_within_at_Ici_Iic_univ : tactic unit :=
-`[apply_rules [unique_diff_on.unique_diff_within_at, unique_diff_on_Ici, unique_diff_on_Iic,
-  left_mem_Ici, right_mem_Iic, unique_diff_within_at_univ]]
-
-/-- Let `f` be a measurable function integrable on `a..b`. Choose `s ∈ {Iic a, Ici a, univ}`
-and `t ∈ {Iic b, Ici b, univ}`. Suppose that `f` tends to `ca` and `cb` almost surely at the filters
-`la` and `lb` from the table below. Then `fderiv_within ℝ (λ p, ∫ x in p.1..p.2, f x) (s ×ˢ t)`
-is equal to `(u, v) ↦ u • cb - v • ca`.
-
-| `s`     | `la`     | `t`     | `lb`     |
-| ------- | ----     | ---     | ----     |
-| `Iic a` | `𝓝[≤] a` | `Iic b` | `𝓝[≤] b` |
-| `Ici a` | `𝓝[>] a` | `Ici b` | `𝓝[>] b` |
-| `{a}`   | `⊥`      | `{b}`   | `⊥`      |
-| `univ`  | `𝓝 a`    | `univ`  | `𝓝 b`    |
--/
-lemma fderiv_within_integral_of_tendsto_ae
-  (hf : interval_integrable f volume a b)
-  (hmeas_a : strongly_measurable_at_filter f la) (hmeas_b : strongly_measurable_at_filter f lb)
-  {s t : set ℝ} [FTC_filter a (𝓝[s] a) la] [FTC_filter b (𝓝[t] b) lb]
-  (ha : tendsto f (la ⊓ volume.ae) (𝓝 ca)) (hb : tendsto f (lb ⊓ volume.ae) (𝓝 cb))
-  (hs : unique_diff_within_at ℝ s a . unique_diff_within_at_Ici_Iic_univ)
-  (ht : unique_diff_within_at ℝ t b . unique_diff_within_at_Ici_Iic_univ) :
-  fderiv_within ℝ (λ p : ℝ × ℝ, ∫ x in p.1..p.2, f x) (s ×ˢ t) (a, b) =
-    ((snd ℝ ℝ ℝ).smul_right cb - (fst ℝ ℝ ℝ).smul_right ca) :=
-(integral_has_fderiv_within_at_of_tendsto_ae hf hmeas_a hmeas_b ha hb).fderiv_within $ hs.prod ht
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely as `x` tends to `b` from the right or from the left,
-then `u ↦ ∫ x in a..u, f x` has right (resp., left) derivative `c` at `b`. -/
-lemma integral_has_deriv_within_at_of_tendsto_ae_right
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] b)) (hb : tendsto f (𝓝[t] b ⊓ volume.ae) (𝓝 c)) :
-  has_deriv_within_at (λ u, ∫ x in a..u, f x) c s b :=
-integral_sub_integral_sub_linear_is_o_of_tendsto_ae_right hf hmeas hb
-  (tendsto_const_pure.mono_right FTC_filter.pure_le) tendsto_id
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
-from the left or from the right at `b`, then `u ↦ ∫ x in a..u, f x` has left (resp., right)
-derivative `f b` at `b`. -/
-lemma integral_has_deriv_within_at_right
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] b)) (hb : continuous_within_at f t b) :
-  has_deriv_within_at (λ u, ∫ x in a..u, f x) (f b) s b :=
-integral_has_deriv_within_at_of_tendsto_ae_right hf hmeas (hb.mono_left inf_le_left)
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely as `x` tends to `b` from the right or from the left, then the right
-(resp., left) derivative of `u ↦ ∫ x in a..u, f x` at `b` equals `c`. -/
-lemma deriv_within_integral_of_tendsto_ae_right
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
-  (hmeas: strongly_measurable_at_filter f (𝓝[t] b)) (hb : tendsto f (𝓝[t] b ⊓ volume.ae) (𝓝 c))
-  (hs : unique_diff_within_at ℝ s b . unique_diff_within_at_Ici_Iic_univ) :
-  deriv_within (λ u, ∫ x in a..u, f x) s b = c :=
-(integral_has_deriv_within_at_of_tendsto_ae_right hf hmeas hb).deriv_within hs
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
-on the right or on the left at `b`, then the right (resp., left) derivative of
-`u ↦ ∫ x in a..u, f x` at `b` equals `f b`. -/
-lemma deriv_within_integral_right
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter b (𝓝[s] b) (𝓝[t] b)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] b)) (hb : continuous_within_at f t b)
-  (hs : unique_diff_within_at ℝ s b . unique_diff_within_at_Ici_Iic_univ) :
-  deriv_within (λ u, ∫ x in a..u, f x) s b = f b :=
-(integral_has_deriv_within_at_right hf hmeas hb).deriv_within hs
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely as `x` tends to `a` from the right or from the left,
-then `u ↦ ∫ x in u..b, f x` has right (resp., left) derivative `-c` at `a`. -/
-lemma integral_has_deriv_within_at_of_tendsto_ae_left
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] a))
-  (ha : tendsto f (𝓝[t] a ⊓ volume.ae) (𝓝 c)) :
-  has_deriv_within_at (λ u, ∫ x in u..b, f x) (-c) s a :=
-by { simp only [integral_symm b],
-  exact (integral_has_deriv_within_at_of_tendsto_ae_right hf.symm hmeas ha).neg }
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
-from the left or from the right at `a`, then `u ↦ ∫ x in u..b, f x` has left (resp., right)
-derivative `-f a` at `a`. -/
-lemma integral_has_deriv_within_at_left
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] a)) (ha : continuous_within_at f t a) :
-  has_deriv_within_at (λ u, ∫ x in u..b, f x) (-f a) s a :=
-integral_has_deriv_within_at_of_tendsto_ae_left hf hmeas (ha.mono_left inf_le_left)
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` has a finite
-limit `c` almost surely as `x` tends to `a` from the right or from the left, then the right
-(resp., left) derivative of `u ↦ ∫ x in u..b, f x` at `a` equals `-c`. -/
-lemma deriv_within_integral_of_tendsto_ae_left
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] a)) (ha : tendsto f (𝓝[t] a ⊓ volume.ae) (𝓝 c))
-  (hs : unique_diff_within_at ℝ s a . unique_diff_within_at_Ici_Iic_univ) :
-  deriv_within (λ u, ∫ x in u..b, f x) s a = -c :=
-(integral_has_deriv_within_at_of_tendsto_ae_left hf hmeas ha).deriv_within hs
-
-/-- Fundamental theorem of calculus: if `f : ℝ → E` is integrable on `a..b` and `f x` is continuous
-on the right or on the left at `a`, then the right (resp., left) derivative of
-`u ↦ ∫ x in u..b, f x` at `a` equals `-f a`. -/
-lemma deriv_within_integral_left
-  (hf : interval_integrable f volume a b) {s t : set ℝ} [FTC_filter a (𝓝[s] a) (𝓝[t] a)]
-  (hmeas : strongly_measurable_at_filter f (𝓝[t] a)) (ha : continuous_within_at f t a)
-  (hs : unique_diff_within_at ℝ s a . unique_diff_within_at_Ici_Iic_univ) :
-  deriv_within (λ u, ∫ x in u..b, f x) s a = -f a :=
-(integral_has_deriv_within_at_left hf hmeas ha).deriv_within hs
-
-/-- The integral of a continuous function is differentiable on a real set `s`. -/
-theorem differentiable_on_integral_of_continuous {s : set ℝ}
-  (hintg : ∀ x ∈ s, interval_integrable f volume a x) (hcont : continuous f) :
-  differentiable_on ℝ (λ u, ∫ x in a..u, f x) s :=
-λ y hy, (integral_has_deriv_at_right (hintg y hy)
-  hcont.ae_strongly_measurable.strongly_measurable_at_filter
-    hcont.continuous_at) .differentiable_at.differentiable_within_at
-
-/-!
-### Fundamental theorem of calculus, part 2
-
-This section contains theorems pertaining to FTC-2 for interval integrals, i.e., the assertion
-that `∫ x in a..b, f' x = f b - f a` under suitable assumptions.
-
-The most classical version of this theorem assumes that `f'` is continuous. However, this is
-unnecessarily strong: the result holds if `f'` is just integrable. We prove the strong version,
-following [Rudin, *Real and Complex Analysis* (Theorem 7.21)][rudin2006real]. The proof is first
-given for real-valued functions, and then deduced for functions with a general target space. For
-a real-valued function `g`, it suffices to show that `g b - g a ≤ (∫ x in a..b, g' x) + ε` for all
-positive `ε`. To prove this, choose a lower-semicontinuous function `G'` with `g' < G'` and with
-integral close to that of `g'` (its existence is guaranteed by the Vitali-Carathéodory theorem).
-It satisfies `g t - g a ≤ ∫ x in a..t, G' x` for all `t ∈ [a, b]`: this inequality holds at `a`,
-and if it holds at `t` then it holds for `u` close to `t` on its right, as the left hand side
-increases by `g u - g t ∼ (u -t) g' t`, while the right hand side increases by
-`∫ x in t..u, G' x` which is roughly at least `∫ x in t..u, G' t = (u - t) G' t`, by lower
-semicontinuity. As  `g' t < G' t`, this gives the conclusion. One can therefore push progressively
-this inequality to the right until the point `b`, where it gives the desired conclusion.
--/
-
-variables {g' g : ℝ → ℝ}
-
-/-- Hard part of FTC-2 for integrable derivatives, real-valued functions: one has
-`g b - g a ≤ ∫ y in a..b, g' y`.
-Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`. -/
-lemma sub_le_integral_of_has_deriv_right_of_le (hab : a ≤ b) (hcont : continuous_on g (Icc a b))
-  (hderiv : ∀ x ∈ Ico a b, has_deriv_within_at g (g' x) (Ioi x) x)
-  (g'int : integrable_on g' (Icc a b)) :
-  g b - g a ≤ ∫ y in a..b, g' y :=
-begin
-  refine le_of_forall_pos_le_add (λ ε εpos, _),
-  -- Bound from above `g'` by a lower-semicontinuous function `G'`.
-  rcases exists_lt_lower_semicontinuous_integral_lt g' g'int εpos with
-    ⟨G', g'_lt_G', G'cont, G'int, G'lt_top, hG'⟩,
-  -- we will show by "induction" that `g t - g a ≤ ∫ u in a..t, G' u` for all `t ∈ [a, b]`.
-  set s := {t | g t - g a ≤ ∫ u in a..t, (G' u).to_real} ∩ Icc a b,
-  -- the set `s` of points where this property holds is closed.
-  have s_closed : is_closed s,
-  { have : continuous_on (λ t, (g t - g a, ∫ u in a..t, (G' u).to_real)) (Icc a b),
-    { rw ← interval_of_le hab at G'int ⊢ hcont,
-      exact (hcont.sub continuous_on_const).prod (continuous_on_primitive_interval G'int) },
-    simp only [s, inter_comm],
-    exact this.preimage_closed_of_closed is_closed_Icc order_closed_topology.is_closed_le' },
-  have main : Icc a b ⊆ {t | g t - g a ≤ ∫ u in a..t, (G' u).to_real },
-  { -- to show that the set `s` is all `[a, b]`, it suffices to show that any point `t` in `s`
-    -- with `t < b` admits another point in `s` slightly to its right
-    -- (this is a sort of real induction).
-    apply s_closed.Icc_subset_of_forall_exists_gt
-      (by simp only [integral_same, mem_set_of_eq, sub_self]) (λ t ht v t_lt_v, _),
-    obtain ⟨y, g'_lt_y', y_lt_G'⟩ : ∃ (y : ℝ), (g' t : ereal) < y ∧ (y : ereal) < G' t :=
-      ereal.lt_iff_exists_real_btwn.1 (g'_lt_G' t),
-    -- bound from below the increase of `∫ x in a..u, G' x` on the right of `t`, using the lower
-    -- semicontinuity of `G'`.
-    have I1 : ∀ᶠ u in 𝓝[>] t, (u - t) * y ≤ ∫ w in t..u, (G' w).to_real,
-    { have B : ∀ᶠ u in 𝓝 t, (y : ereal) < G' u :=
-        G'cont.lower_semicontinuous_at _ _ y_lt_G',
-      rcases mem_nhds_iff_exists_Ioo_subset.1 B with ⟨m, M, ⟨hm, hM⟩, H⟩,
-      have : Ioo t (min M b) ∈ 𝓝[>] t := mem_nhds_within_Ioi_iff_exists_Ioo_subset.2
-        ⟨min M b, by simp only [hM, ht.right.right, lt_min_iff, mem_Ioi, and_self], subset.refl _⟩,
-      filter_upwards [this] with u hu,
-      have I : Icc t u ⊆ Icc a b := Icc_subset_Icc ht.2.1 (hu.2.le.trans (min_le_right _ _)),
-      calc (u - t) * y = ∫ v in Icc t u, y :
-        by simp only [hu.left.le, measure_theory.integral_const, algebra.id.smul_eq_mul, sub_nonneg,
-                      measurable_set.univ, real.volume_Icc, measure.restrict_apply, univ_inter,
-                      ennreal.to_real_of_real]
-      ... ≤ ∫ w in t..u, (G' w).to_real :
-      begin
-        rw [interval_integral.integral_of_le hu.1.le, ← integral_Icc_eq_integral_Ioc],
-        apply set_integral_mono_ae_restrict,
-        { simp only [integrable_on_const, real.volume_Icc, ennreal.of_real_lt_top, or_true] },
-        { exact integrable_on.mono_set G'int I },
-        { have C1 : ∀ᵐ (x : ℝ) ∂volume.restrict (Icc t u), G' x < ∞ :=
-            ae_mono (measure.restrict_mono I le_rfl) G'lt_top,
-          have C2 : ∀ᵐ (x : ℝ) ∂volume.restrict (Icc t u), x ∈ Icc t u :=
-            ae_restrict_mem measurable_set_Icc,
-          filter_upwards [C1, C2] with x G'x hx,
-          apply ereal.coe_le_coe_iff.1,
-          have : x ∈ Ioo m M, by simp only [hm.trans_le hx.left,
-            (hx.right.trans_lt hu.right).trans_le (min_le_left M b), mem_Ioo, and_self],
-          convert le_of_lt (H this),
-          exact ereal.coe_to_real G'x.ne (ne_bot_of_gt (g'_lt_G' x)) }
-      end },
-    -- bound from above the increase of `g u - g a` on the right of `t`, using the derivative at `t`
-    have I2 : ∀ᶠ u in 𝓝[>] t, g u - g t ≤ (u - t) * y,
-    { have g'_lt_y : g' t < y := ereal.coe_lt_coe_iff.1 g'_lt_y',
-      filter_upwards [(hderiv t ⟨ht.2.1, ht.2.2⟩).limsup_slope_le'
-        (not_mem_Ioi.2 le_rfl) g'_lt_y, self_mem_nhds_within] with u hu t_lt_u,
-      have := mul_le_mul_of_nonneg_left hu.le (sub_pos.2 t_lt_u).le,
-      rwa [← smul_eq_mul, sub_smul_slope] at this },
-    -- combine the previous two bounds to show that `g u - g a` increases less quickly than
-    -- `∫ x in a..u, G' x`.
-    have I3 : ∀ᶠ u in 𝓝[>] t, g u - g t ≤ ∫ w in t..u, (G' w).to_real,
-    { filter_upwards [I1, I2] with u hu1 hu2 using hu2.trans hu1, },
-    have I4 : ∀ᶠ u in 𝓝[>] t, u ∈ Ioc t (min v b),
-    { refine mem_nhds_within_Ioi_iff_exists_Ioc_subset.2 ⟨min v b, _, subset.refl _⟩,
-      simp only [lt_min_iff, mem_Ioi],
-      exact ⟨t_lt_v, ht.2.2⟩ },
-    -- choose a point `x` slightly to the right of `t` which satisfies the above bound
-    rcases (I3.and I4).exists with ⟨x, hx, h'x⟩,
-    -- we check that it belongs to `s`, essentially by construction
-    refine ⟨x, _, Ioc_subset_Ioc le_rfl (min_le_left _ _) h'x⟩,
-    calc g x - g a = (g t - g a) + (g x - g t) : by abel
-    ... ≤ (∫ w in a..t, (G' w).to_real) + ∫ w in t..x, (G' w).to_real : add_le_add ht.1 hx
-    ... = ∫ w in a..x, (G' w).to_real :
-    begin
-      apply integral_add_adjacent_intervals,
-      { rw interval_integrable_iff_integrable_Ioc_of_le ht.2.1,
-        exact integrable_on.mono_set G'int
-          (Ioc_subset_Icc_self.trans (Icc_subset_Icc le_rfl ht.2.2.le)) },
-      { rw interval_integrable_iff_integrable_Ioc_of_le h'x.1.le,
-        apply integrable_on.mono_set G'int,
-        refine Ioc_subset_Icc_self.trans (Icc_subset_Icc ht.2.1 (h'x.2.trans (min_le_right _ _))) }
-    end },
-  -- now that we know that `s` contains `[a, b]`, we get the desired result by applying this to `b`.
-  calc g b - g a ≤ ∫ y in a..b, (G' y).to_real : main (right_mem_Icc.2 hab)
-  ... ≤ (∫ y in a..b, g' y) + ε :
-    begin
-      convert hG'.le;
-      { rw interval_integral.integral_of_le hab,
-        simp only [integral_Icc_eq_integral_Ioc', real.volume_singleton] },
-    end
-end
-
-/-- Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`. -/
-lemma integral_le_sub_of_has_deriv_right_of_le (hab : a ≤ b)
-  (hcont : continuous_on g (Icc a b))
-  (hderiv : ∀ x ∈ Ico a b, has_deriv_within_at g (g' x) (Ioi x) x)
-  (g'int : integrable_on g' (Icc a b)) :
-  ∫ y in a..b, g' y ≤ g b - g a :=
-begin
-  rw ← neg_le_neg_iff,
-  convert sub_le_integral_of_has_deriv_right_of_le hab hcont.neg (λ x hx, (hderiv x hx).neg)
-    g'int.neg,
-  { abel },
-  { simp only [integral_neg] }
-end
-
-/-- Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`: real version -/
-lemma integral_eq_sub_of_has_deriv_right_of_le_real (hab : a ≤ b)
-  (hcont : continuous_on g (Icc a b))
-  (hderiv : ∀ x ∈ Ico a b, has_deriv_within_at g (g' x) (Ioi x) x)
-  (g'int : integrable_on g' (Icc a b)) :
-  ∫ y in a..b, g' y = g b - g a :=
-le_antisymm
-  (integral_le_sub_of_has_deriv_right_of_le hab hcont hderiv g'int)
-  (sub_le_integral_of_has_deriv_right_of_le hab hcont hderiv g'int)
-
-/-- Auxiliary lemma in the proof of `integral_eq_sub_of_has_deriv_right_of_le`: real version, not
-requiring differentiability as the left endpoint of the interval. Follows from
-`integral_eq_sub_of_has_deriv_right_of_le_real` together with a continuity argument. -/
-lemma integral_eq_sub_of_has_deriv_right_of_le_real' (hab : a ≤ b)
-  (hcont : continuous_on g (Icc a b))
-  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at g (g' x) (Ioi x) x)
-  (g'int : integrable_on g' (Icc a b)) :
-  ∫ y in a..b, g' y = g b - g a :=
-begin
-  obtain rfl|a_lt_b := hab.eq_or_lt, { simp },
-  set s := {t | ∫ u in t..b, g' u = g b - g t} ∩ Icc a b,
-  have s_closed : is_closed s,
-  { have : continuous_on (λ t, (∫ u in t..b, g' u, g b - g t)) (Icc a b),
-    { rw ← interval_of_le hab at ⊢ hcont g'int,
-      exact (continuous_on_primitive_interval_left g'int).prod (continuous_on_const.sub hcont) },
-    simp only [s, inter_comm],
-    exact this.preimage_closed_of_closed is_closed_Icc is_closed_diagonal, },
-  have A : closure (Ioc a b) ⊆ s,
-  { apply s_closed.closure_subset_iff.2,
-    assume t ht,
-    refine ⟨_, ⟨ht.1.le, ht.2⟩⟩,
-    exact integral_eq_sub_of_has_deriv_right_of_le_real ht.2
-      (hcont.mono (Icc_subset_Icc ht.1.le le_rfl))
-      (λ x hx, hderiv x ⟨ht.1.trans_le hx.1, hx.2⟩)
-      (g'int.mono_set (Icc_subset_Icc ht.1.le le_rfl)) },
-  rw closure_Ioc a_lt_b.ne at A,
-  exact (A (left_mem_Icc.2 hab)).1,
-end
-
-variable {f' : ℝ → E}
-
-/-- **Fundamental theorem of calculus-2**: If `f : ℝ → E` is continuous on `[a, b]` (where `a ≤ b`)
-  and has a right derivative at `f' x` for all `x` in `(a, b)`, and `f'` is integrable on `[a, b]`,
-  then `∫ y in a..b, f' y` equals `f b - f a`. -/
-theorem integral_eq_sub_of_has_deriv_right_of_le (hab : a ≤ b) (hcont : continuous_on f (Icc a b))
-  (hderiv : ∀ x ∈ Ioo a b, has_deriv_within_at f (f' x) (Ioi x) x)
-  (f'int : interval_integrable f' volume a b) :
-  ∫ y in a..b, f' y = f b - f a :=
-begin
-  refine (normed_space.eq_iff_forall_dual_eq ℝ).2 (λ g, _),
-  rw [← g.interval_integral_comp_comm f'int, g.map_sub],
-  exact integral_eq_sub_of_has_deriv_right_of_le_real' hab (g.continuous.comp_continuous_on hcont)
-    (λ x hx, g.has_fderiv_at.comp_has_deriv_within_at x (hderiv x hx))
-    (g.integrable_comp ((interval_integrable_iff_integrable_Icc_of_le hab).1 f'int))
-end
-
-/-- Fundamental theorem of calculus-2: If `f : ℝ → E` is continuous on `[a, b]` and
-  has a right derivative at `f' x` for all `x` in `[a, b)`, and `f'` is integrable on `[a, b]` then
-  `∫ y in a..b, f' y` equals `f b - f a`. -/
-theorem integral_eq_sub_of_has_deriv_right (hcont : continuous_on f (interval a b))
-  (hderiv : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
-  (hint : interval_integrable f' volume a b) :
-  ∫ y in a..b, f' y = f b - f a :=
-begin
-  cases le_total a b with hab hab,
-  { simp only [interval_of_le, min_eq_left, max_eq_right, hab] at hcont hderiv hint,
-    apply integral_eq_sub_of_has_deriv_right_of_le hab hcont hderiv hint },
-  { simp only [interval_of_ge, min_eq_right, max_eq_left, hab] at hcont hderiv,
-    rw [integral_symm, integral_eq_sub_of_has_deriv_right_of_le hab hcont hderiv hint.symm,
-        neg_sub] }
-end
-
-/-- Fundamental theorem of calculus-2: If `f : ℝ → E` is continuous on `[a, b]` (where `a ≤ b`) and
-  has a derivative at `f' x` for all `x` in `(a, b)`, and `f'` is integrable on `[a, b]`, then
-  `∫ y in a..b, f' y` equals `f b - f a`. -/
-theorem integral_eq_sub_of_has_deriv_at_of_le (hab : a ≤ b)
-  (hcont : continuous_on f (Icc a b))
-  (hderiv : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hint : interval_integrable f' volume a b) :
-  ∫ y in a..b, f' y = f b - f a :=
-integral_eq_sub_of_has_deriv_right_of_le hab hcont (λ x hx, (hderiv x hx).has_deriv_within_at) hint
-
-/-- Fundamental theorem of calculus-2: If `f : ℝ → E` has a derivative at `f' x` for all `x` in
-  `[a, b]` and `f'` is integrable on `[a, b]`, then `∫ y in a..b, f' y` equals `f b - f a`. -/
-theorem integral_eq_sub_of_has_deriv_at
-  (hderiv : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (hint : interval_integrable f' volume a b) :
-  ∫ y in a..b, f' y = f b - f a :=
-integral_eq_sub_of_has_deriv_right (has_deriv_at.continuous_on hderiv)
-  (λ x hx, (hderiv _ (mem_Icc_of_Ioo hx)).has_deriv_within_at) hint
-
-theorem integral_eq_sub_of_has_deriv_at_of_tendsto (hab : a < b) {fa fb}
-  (hderiv : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hint : interval_integrable f' volume a b)
-  (ha : tendsto f (𝓝[>] a) (𝓝 fa)) (hb : tendsto f (𝓝[<] b) (𝓝 fb)) :
-  ∫ y in a..b, f' y = fb - fa :=
-begin
-  set F : ℝ → E := update (update f a fa) b fb,
-  have Fderiv : ∀ x ∈ Ioo a b, has_deriv_at F (f' x) x,
-  { refine λ x hx, (hderiv x hx).congr_of_eventually_eq _,
-    filter_upwards [Ioo_mem_nhds hx.1 hx.2] with _ hy, simp only [F],
-    rw [update_noteq hy.2.ne, update_noteq hy.1.ne'], },
-  have hcont : continuous_on F (Icc a b),
-  { rw [continuous_on_update_iff, continuous_on_update_iff, Icc_diff_right, Ico_diff_left],
-    refine ⟨⟨λ z hz, (hderiv z hz).continuous_at.continuous_within_at, _⟩, _⟩,
-    { exact λ _, ha.mono_left (nhds_within_mono _ Ioo_subset_Ioi_self) },
-    { rintro -,
-      refine (hb.congr' _).mono_left (nhds_within_mono _ Ico_subset_Iio_self),
-      filter_upwards [Ioo_mem_nhds_within_Iio (right_mem_Ioc.2 hab)]
-        with _ hz using (update_noteq hz.1.ne' _ _).symm } },
-  simpa [F, hab.ne, hab.ne'] using integral_eq_sub_of_has_deriv_at_of_le hab.le hcont Fderiv hint
-end
-
-/-- Fundamental theorem of calculus-2: If `f : ℝ → E` is differentiable at every `x` in `[a, b]` and
-  its derivative is integrable on `[a, b]`, then `∫ y in a..b, deriv f y` equals `f b - f a`. -/
-theorem integral_deriv_eq_sub (hderiv : ∀ x ∈ interval a b, differentiable_at ℝ f x)
-  (hint : interval_integrable (deriv f) volume a b) :
-  ∫ y in a..b, deriv f y = f b - f a :=
-integral_eq_sub_of_has_deriv_at (λ x hx, (hderiv x hx).has_deriv_at) hint
-
-theorem integral_deriv_eq_sub' (f) (hderiv : deriv f = f')
-  (hdiff : ∀ x ∈ interval a b, differentiable_at ℝ f x)
-  (hcont : continuous_on f' (interval a b)) :
-  ∫ y in a..b, f' y = f b - f a :=
-begin
-  rw [← hderiv, integral_deriv_eq_sub hdiff],
-  rw hderiv,
-  exact hcont.interval_integrable
-end
-
-/-!
-### Integration by parts
--/
-
-theorem integral_deriv_mul_eq_sub {u v u' v' : ℝ → ℝ}
-  (hu : ∀ x ∈ interval a b, has_deriv_at u (u' x) x)
-  (hv : ∀ x ∈ interval a b, has_deriv_at v (v' x) x)
-  (hu' : interval_integrable u' volume a b) (hv' : interval_integrable v' volume a b) :
-  ∫ x in a..b, u' x * v x + u x * v' x = u b * v b - u a * v a :=
-integral_eq_sub_of_has_deriv_at (λ x hx, (hu x hx).mul (hv x hx)) $
-  (hu'.mul_continuous_on (has_deriv_at.continuous_on hv)).add
-    (hv'.continuous_on_mul ((has_deriv_at.continuous_on hu)))
-
-theorem integral_mul_deriv_eq_deriv_mul {u v u' v' : ℝ → ℝ}
-  (hu : ∀ x ∈ interval a b, has_deriv_at u (u' x) x)
-  (hv : ∀ x ∈ interval a b, has_deriv_at v (v' x) x)
-  (hu' : interval_integrable u' volume a b) (hv' : interval_integrable v' volume a b) :
-  ∫ x in a..b, u x * v' x = u b * v b - u a * v a - ∫ x in a..b, v x * u' x :=
-begin
-  rw [← integral_deriv_mul_eq_sub hu hv hu' hv', ← integral_sub],
-  { exact integral_congr (λ x hx, by simp only [mul_comm, add_sub_cancel']) },
-  { exact ((hu'.mul_continuous_on (has_deriv_at.continuous_on hv)).add
-      (hv'.continuous_on_mul (has_deriv_at.continuous_on hu))) },
-  { exact hu'.continuous_on_mul (has_deriv_at.continuous_on hv) },
-end
-
-/-!
-### Integration by substitution / Change of variables
--/
-
-section smul
-
-/--
-Change of variables, general form. If `f` is continuous on `[a, b]` and has
-continuous right-derivative `f'` in `(a, b)`, and `g` is continuous on `f '' [a, b]` then we can
-substitute `u = f x` to get `∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
-
-We could potentially slightly weaken the conditions, by not requiring that `f'` and `g` are
-continuous on the endpoints of these intervals, but in that case we need to additionally assume that
-the functions are integrable on that interval.
--/
-theorem integral_comp_smul_deriv'' {f f' : ℝ → ℝ} {g : ℝ → E}
-  (hf : continuous_on f [a, b])
-  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
-  (hf' : continuous_on f' [a, b])
-  (hg : continuous_on g (f '' [a, b])) :
-  ∫ x in a..b, f' x • (g ∘ f) x= ∫ u in f a..f b, g u :=
-begin
-  have h_cont : continuous_on (λ u, ∫ t in f a..f u, g t) [a, b],
-  { rw [hf.image_interval] at hg,
-    refine (continuous_on_primitive_interval' hg.interval_integrable _).comp hf _,
-    { rw ← hf.image_interval, exact mem_image_of_mem f left_mem_interval },
-    { rw ← hf.image_interval, exact maps_to_image _ _ } },
-  have h_der : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at
-    (λ u, ∫ t in f a..f u, g t) (f' x • ((g ∘ f) x)) (Ioi x) x,
-  { intros x hx,
-    let I := [Inf (f '' [a, b]), Sup (f '' [a, b])],
-    have hI : f '' [a, b] = I := hf.image_interval,
-    have h2x : f x ∈ I, { rw [← hI], exact mem_image_of_mem f (Ioo_subset_Icc_self hx) },
-    have h2g : interval_integrable g volume (f a) (f x),
-    { refine (hg.mono $ _).interval_integrable,
-      exact hf.surj_on_interval left_mem_interval (Ioo_subset_Icc_self hx) },
-    rw [hI] at hg,
-    have h3g : strongly_measurable_at_filter g (𝓝[I] f x) volume :=
-    hg.strongly_measurable_at_filter_nhds_within measurable_set_Icc (f x),
-    haveI : fact (f x ∈ I) := ⟨h2x⟩,
-    have : has_deriv_within_at (λ u, ∫ x in f a..u, g x) (g (f x)) I (f x) :=
-    integral_has_deriv_within_at_right h2g h3g (hg (f x) h2x),
-    refine (this.scomp x ((hff' x hx).Ioo_of_Ioi hx.2) _).Ioi_of_Ioo hx.2,
-    rw ← hI,
-    exact (maps_to_image _ _).mono (Ioo_subset_Icc_self.trans $ Icc_subset_Icc_left hx.1.le)
-      subset.rfl },
-  have h_int : interval_integrable (λ (x : ℝ), f' x • (g ∘ f) x) volume a b :=
-  (hf'.smul (hg.comp hf $ subset_preimage_image f _)).interval_integrable,
-  simp_rw [integral_eq_sub_of_has_deriv_right h_cont h_der h_int, integral_same, sub_zero],
-end
-
-/--
-Change of variables. If `f` is has continuous derivative `f'` on `[a, b]`,
-and `g` is continuous on `f '' [a, b]`, then we can substitute `u = f x` to get
-`∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
-Compared to `interval_integral.integral_comp_smul_deriv` we only require that `g` is continuous on
-`f '' [a, b]`.
--/
-theorem integral_comp_smul_deriv' {f f' : ℝ → ℝ} {g : ℝ → E}
-  (h : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (h' : continuous_on f' (interval a b)) (hg : continuous_on g (f '' [a, b])) :
-  ∫ x in a..b, f' x • (g ∘ f) x = ∫ x in f a..f b, g x :=
-integral_comp_smul_deriv'' (λ x hx, (h x hx).continuous_at.continuous_within_at)
-  (λ x hx, (h x $ Ioo_subset_Icc_self hx).has_deriv_within_at) h' hg
-
-/--
-Change of variables, most common version. If `f` is has continuous derivative `f'` on `[a, b]`,
-and `g` is continuous, then we can substitute `u = f x` to get
-`∫ x in a..b, f' x • (g ∘ f) x = ∫ u in f a..f b, g u`.
--/
-theorem integral_comp_smul_deriv {f f' : ℝ → ℝ} {g : ℝ → E}
-  (h : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (h' : continuous_on f' (interval a b)) (hg : continuous g) :
-  ∫ x in a..b, f' x • (g ∘ f) x = ∫ x in f a..f b, g x :=
-integral_comp_smul_deriv' h h' hg.continuous_on
-
-theorem integral_deriv_comp_smul_deriv' {f f' : ℝ → ℝ} {g g' : ℝ → E}
-  (hf : continuous_on f [a, b])
-  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
-  (hf' : continuous_on f' [a, b])
-  (hg : continuous_on g [f a, f b])
-  (hgg' : ∀ x ∈ Ioo (min (f a) (f b)) (max (f a) (f b)), has_deriv_within_at g (g' x) (Ioi x) x)
-  (hg' : continuous_on g' (f '' [a, b])) :
-  ∫ x in a..b, f' x • (g' ∘ f) x = (g ∘ f) b - (g ∘ f) a :=
-begin
-  rw [integral_comp_smul_deriv'' hf hff' hf' hg',
-  integral_eq_sub_of_has_deriv_right hg hgg' (hg'.mono _).interval_integrable],
-  exact intermediate_value_interval hf
-end
-
-theorem integral_deriv_comp_smul_deriv {f f' : ℝ → ℝ} {g g' : ℝ → E}
-  (hf : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (hg : ∀ x ∈ interval a b, has_deriv_at g (g' (f x)) (f x))
-  (hf' : continuous_on f' (interval a b)) (hg' : continuous g') :
-  ∫ x in a..b, f' x • (g' ∘ f) x = (g ∘ f) b - (g ∘ f) a :=
-integral_eq_sub_of_has_deriv_at (λ x hx, (hg x hx).scomp x $ hf x hx)
-  (hf'.smul (hg'.comp_continuous_on $ has_deriv_at.continuous_on hf)).interval_integrable
-
-end smul
-section mul
-
-/--
-Change of variables, general form for scalar functions. If `f` is continuous on `[a, b]` and has
-continuous right-derivative `f'` in `(a, b)`, and `g` is continuous on `f '' [a, b]` then we can
-substitute `u = f x` to get `∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
--/
-theorem integral_comp_mul_deriv'' {f f' g : ℝ → ℝ}
-  (hf : continuous_on f [a, b])
-  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
-  (hf' : continuous_on f' [a, b])
-  (hg : continuous_on g (f '' [a, b])) :
-  ∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u :=
-by simpa [mul_comm] using integral_comp_smul_deriv'' hf hff' hf' hg
-
-/--
-Change of variables. If `f` is has continuous derivative `f'` on `[a, b]`,
-and `g` is continuous on `f '' [a, b]`, then we can substitute `u = f x` to get
-`∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
-Compared to `interval_integral.integral_comp_mul_deriv` we only require that `g` is continuous on
-`f '' [a, b]`.
--/
-theorem integral_comp_mul_deriv' {f f' g : ℝ → ℝ}
-  (h : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (h' : continuous_on f' (interval a b)) (hg : continuous_on g (f '' [a, b])) :
-  ∫ x in a..b, (g ∘ f) x * f' x = ∫ x in f a..f b, g x :=
-by simpa [mul_comm] using integral_comp_smul_deriv' h h' hg
-
-/--
-Change of variables, most common version. If `f` is has continuous derivative `f'` on `[a, b]`,
-and `g` is continuous, then we can substitute `u = f x` to get
-`∫ x in a..b, (g ∘ f) x * f' x = ∫ u in f a..f b, g u`.
--/
-theorem integral_comp_mul_deriv {f f' g : ℝ → ℝ}
-  (h : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (h' : continuous_on f' (interval a b)) (hg : continuous g) :
-  ∫ x in a..b, (g ∘ f) x * f' x = ∫ x in f a..f b, g x :=
-integral_comp_mul_deriv' h h' hg.continuous_on
-
-theorem integral_deriv_comp_mul_deriv' {f f' g g' : ℝ → ℝ}
-  (hf : continuous_on f [a, b])
-  (hff' : ∀ x ∈ Ioo (min a b) (max a b), has_deriv_within_at f (f' x) (Ioi x) x)
-  (hf' : continuous_on f' [a, b])
-  (hg : continuous_on g [f a, f b])
-  (hgg' : ∀ x ∈ Ioo (min (f a) (f b)) (max (f a) (f b)), has_deriv_within_at g (g' x) (Ioi x) x)
-  (hg' : continuous_on g' (f '' [a, b])) :
-  ∫ x in a..b, (g' ∘ f) x * f' x = (g ∘ f) b - (g ∘ f) a :=
-by simpa [mul_comm] using integral_deriv_comp_smul_deriv' hf hff' hf' hg hgg' hg'
-
-theorem integral_deriv_comp_mul_deriv {f f' g g' : ℝ → ℝ}
-  (hf : ∀ x ∈ interval a b, has_deriv_at f (f' x) x)
-  (hg : ∀ x ∈ interval a b, has_deriv_at g (g' (f x)) (f x))
-  (hf' : continuous_on f' (interval a b)) (hg' : continuous g') :
-  ∫ x in a..b, (g' ∘ f) x * f' x = (g ∘ f) b - (g ∘ f) a :=
-by simpa [mul_comm] using integral_deriv_comp_smul_deriv hf hg hf' hg'
-
-end mul
+end has_sum
 
 end interval_integral
diff --git a/src/measure_theory/integral/layercake.lean b/src/measure_theory/integral/layercake.lean
new file mode 100644
index 0000000000000..058d48d0699f9
--- /dev/null
+++ b/src/measure_theory/integral/layercake.lean
@@ -0,0 +1,363 @@
+/-
+Copyright (c) 2022 Kalle Kytölä. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kalle Kytölä
+-/
+import measure_theory.integral.interval_integral
+import analysis.special_functions.integrals
+
+/-!
+# The layer cake formula / Cavalieri's principle / tail probability formula
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove the following layer cake formula.
+
+Consider a non-negative measurable function `f` on a sigma-finite measure space. Apply pointwise
+to it an increasing absolutely continuous function `G : ℝ≥0 → ℝ≥0` vanishing at the origin, with
+derivative `G' = g` on the positive real line (in other words, `G` a primitive of a non-negative
+locally integrable function `g` on the positive real line). Then the integral of the result,
+`∫ G ∘ f`, can be written as the integral over the positive real line of the "tail measures" of `f`
+(i.e., a function giving the measures of the sets on which `f` exceeds different positive real
+values) weighted by `g`. In probability theory contexts, the "tail measures" could be referred to
+as "tail probabilities" of the random variable `f`, or as values of the "complementary cumulative
+distribution function" of the random variable `f`. The terminology "tail probability formula" is
+therefore occasionally used for the layer cake formula (or a standard application of it).
+
+The essence of the (mathematical) proof is Fubini's theorem.
+
+We also give the two most common applications of the layer cake formula
+ * a representation of the integral of a nonnegative function f:
+   ∫ f(ω) ∂μ(ω) = ∫ μ {ω | f(ω) ≥ t} dt
+ * a representation of the integral of the p:th power of a nonnegative function f:
+   ∫ f(ω)^p ∂μ(ω) = p * ∫ t^(p-1) * μ {ω | f(ω) ≥ t} dt .
+
+Variants of the formulas with measures of sets of the form {ω | f(ω) > t} instead of {ω | f(ω) ≥ t}
+are also included.
+
+## Main results
+
+ * `lintegral_comp_eq_lintegral_meas_le_mul` and `lintegral_comp_eq_lintegral_meas_lt_mul`:
+   The general layer cake formulas with Lebesgue integrals, written in terms of measures of
+   sets of the forms {ω | t ≤ f(ω)} and {ω | t < f(ω)}, respectively.
+ * `lintegral_eq_lintegral_meas_le` and `lintegral_eq_lintegral_meas_lt`:
+   The most common special cases of the layer cake formulas, stating that for a nonnegative
+   function f we have ∫ f(ω) ∂μ(ω) = ∫ μ {ω | f(ω) ≥ t} dt and
+   ∫ f(ω) ∂μ(ω) = ∫ μ {ω | f(ω) > t} dt, respectively.
+ * `lintegral_rpow_eq_lintegral_meas_le_mul` and `lintegral_rpow_eq_lintegral_meas_lt_mul`:
+   Other common special cases of the layer cake formulas, stating that for a nonnegative function f
+   and p > 0, we have ∫ f(ω)^p ∂μ(ω) = p * ∫ μ {ω | f(ω) ≥ t} * t^(p-1) dt and
+   ∫ f(ω)^p ∂μ(ω) = p * ∫ μ {ω | f(ω) > t} * t^(p-1) dt, respectively.
+
+## Tags
+
+layer cake representation, Cavalieri's principle, tail probability formula
+-/
+
+noncomputable theory
+open_locale ennreal measure_theory
+open set measure_theory filter
+
+/-! ### Layercake formula -/
+section layercake
+
+namespace measure_theory
+
+variables {α : Type*} [measurable_space α] {f : α → ℝ} {g : ℝ → ℝ} {s : set α}
+
+/-- An auxiliary version of the layer cake formula (Cavalieri's principle, tail probability
+formula), with a measurability assumption that would also essentially follow from the
+integrability assumptions.
+
+See `measure_theory.lintegral_comp_eq_lintegral_meas_le_mul` and
+`measure_theory.lintegral_comp_eq_lintegral_meas_lt_mul` for the main formulations of the layer
+cake formula. -/
+lemma lintegral_comp_eq_lintegral_meas_le_mul_of_measurable (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f)
+  (g_intble : ∀ t > 0, interval_integrable g volume 0 t)
+  (g_mble : measurable g) (g_nn : ∀ t > 0, 0 ≤ g t) :
+  ∫⁻ ω, ennreal.of_real (∫ t in 0 .. (f ω), g t) ∂μ
+    = ∫⁻ t in Ioi 0, (μ {a : α | t ≤ f a}) * ennreal.of_real (g t) :=
+begin
+  have g_intble' : ∀ (t : ℝ), 0 ≤ t → interval_integrable g volume 0 t,
+  { intros t ht,
+    cases eq_or_lt_of_le ht,
+    { simp [← h], },
+    { exact g_intble t h, }, },
+  have integrand_eq : ∀ ω, ennreal.of_real (∫ t in 0 .. (f ω), g t)
+                           = ∫⁻ t in Ioc 0 (f ω), ennreal.of_real (g t),
+  { intro ω,
+    have g_ae_nn : 0 ≤ᵐ[volume.restrict (Ioc 0 (f ω))] g,
+    { filter_upwards [self_mem_ae_restrict (measurable_set_Ioc : measurable_set (Ioc 0 (f ω)))]
+        with x hx using g_nn x hx.1, },
+    rw ← of_real_integral_eq_lintegral_of_real (g_intble' (f ω) (f_nn ω)).1 g_ae_nn,
+    congr,
+    exact interval_integral.integral_of_le (f_nn ω), },
+  simp_rw [integrand_eq, ← lintegral_indicator (λ t, ennreal.of_real (g t)) measurable_set_Ioc,
+           ← lintegral_indicator _ measurable_set_Ioi],
+  rw lintegral_lintegral_swap,
+  { apply congr_arg,
+    funext s,
+    have aux₁ : (λ x, (Ioc 0 (f x)).indicator (λ (t : ℝ), ennreal.of_real (g t)) s)
+                = (λ x, (ennreal.of_real (g s) * (Ioi (0 : ℝ)).indicator (λ _, 1) s)
+                             * (Ici s).indicator (λ (t : ℝ), (1 : ℝ≥0∞)) (f x)),
+    { funext a,
+      by_cases s ∈ Ioc (0 : ℝ) (f a),
+      { simp only [h, (show s ∈ Ioi (0 : ℝ), from h.1),
+                   (show f a ∈ Ici s, from h.2), indicator_of_mem, mul_one], },
+      { have h_copy := h,
+        simp only [mem_Ioc, not_and, not_le] at h,
+        by_cases h' : 0 < s,
+        { simp only [h_copy, h h', indicator_of_not_mem, not_false_iff, mem_Ici, not_le,
+                     mul_zero], },
+        { have : s ∉ Ioi (0 : ℝ) := h',
+          simp only [this, h', indicator_of_not_mem, not_false_iff, mul_zero, zero_mul, mem_Ioc,
+                     false_and], }, }, },
+    simp_rw aux₁,
+    rw lintegral_const_mul',
+    swap, { apply ennreal.mul_ne_top ennreal.of_real_ne_top,
+            by_cases s ∈ Ioi (0 : ℝ); { simp [h], }, },
+    simp_rw [(show (λ a, (Ici s).indicator (λ (t : ℝ), (1 : ℝ≥0∞)) (f a))
+                   = (λ a, {a : α | s ≤ f a}.indicator (λ _, 1) a),
+              by { funext a, by_cases s ≤ f a; simp [h], })],
+    rw lintegral_indicator,
+    swap, { exact f_mble measurable_set_Ici, },
+    rw [lintegral_one, measure.restrict_apply measurable_set.univ, univ_inter, indicator_mul_left,
+        mul_assoc,
+        (show (Ioi 0).indicator (λ (_x : ℝ), (1 : ℝ≥0∞)) s * μ {a : α | s ≤ f a}
+              = (Ioi 0).indicator (λ (_x : ℝ), 1 * μ {a : α | s ≤ f a}) s,
+        by { by_cases 0 < s; simp [h], })],
+    simp_rw [mul_comm _ (ennreal.of_real _), one_mul],
+    refl, },
+  have aux₂ : function.uncurry
+              (λ (x : α) (y : ℝ), (Ioc 0 (f x)).indicator (λ (t : ℝ), ennreal.of_real (g t)) y)
+              = {p : α × ℝ | p.2 ∈ Ioc 0 (f p.1)}.indicator (λ p, ennreal.of_real (g p.2)),
+  { funext p,
+    cases p,
+    rw function.uncurry_apply_pair,
+    by_cases p_snd ∈ Ioc 0 (f p_fst),
+    { have h' : (p_fst, p_snd) ∈ {p : α × ℝ | p.snd ∈ Ioc 0 (f p.fst)} := h,
+      rw [set.indicator_of_mem h', set.indicator_of_mem h], },
+    { have h' : (p_fst, p_snd) ∉ {p : α × ℝ | p.snd ∈ Ioc 0 (f p.fst)} := h,
+      rw [set.indicator_of_not_mem h', set.indicator_of_not_mem h], }, },
+  rw aux₂,
+  have mble := measurable_set_region_between_oc measurable_zero f_mble measurable_set.univ,
+  simp_rw [mem_univ, pi.zero_apply, true_and] at mble,
+  exact (ennreal.measurable_of_real.comp (g_mble.comp measurable_snd)).ae_measurable.indicator mble,
+end
+
+/-- The layer cake formula / Cavalieri's principle / tail probability formula:
+
+Let `f` be a non-negative measurable function on a sigma-finite measure space. Let `G` be an
+increasing absolutely continuous function on the positive real line, vanishing at the origin,
+with derivative `G' = g`. Then the integral of the composition `G ∘ f` can be written as
+the integral over the positive real line of the "tail measures" `μ {ω | f(ω) ≥ t}` of `f`
+weighted by `g`.
+
+Roughly speaking, the statement is: `∫⁻ (G ∘ f) ∂μ = ∫⁻ t in 0 .. ∞, g(t) * μ {ω | f(ω) ≥ t}`.
+
+See `lintegral_comp_eq_lintegral_meas_lt_mul` for a version with sets of the form `{ω | f(ω) > t}`
+instead. -/
+theorem lintegral_comp_eq_lintegral_meas_le_mul (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f)
+  (g_intble : ∀ t > 0, interval_integrable g volume 0 t)
+  (g_nn : ∀ᵐ t ∂(volume.restrict (Ioi 0)), 0 ≤ g t) :
+  ∫⁻ ω, ennreal.of_real (∫ t in 0 .. f ω, g t) ∂μ
+    = ∫⁻ t in Ioi 0, μ {a : α | t ≤ f a} * ennreal.of_real (g t) :=
+begin
+  have ex_G : ∃ (G : ℝ → ℝ), measurable G ∧ 0 ≤ G ∧ g =ᵐ[volume.restrict (Ioi 0)] G,
+  { refine ae_measurable.exists_measurable_nonneg _ g_nn,
+    exact ae_measurable_Ioi_of_forall_Ioc (λ t ht, (g_intble t ht).1.1.ae_measurable), },
+  rcases ex_G with ⟨G, G_mble, G_nn, g_eq_G⟩,
+  have g_eq_G_on : ∀ t, g =ᵐ[volume.restrict (Ioc 0 t)] G,
+    from λ t, ae_mono (measure.restrict_mono Ioc_subset_Ioi_self le_rfl) g_eq_G,
+  have G_intble : ∀ t > 0, interval_integrable G volume 0 t,
+  { refine λ t t_pos, ⟨(g_intble t t_pos).1.congr_fun_ae (g_eq_G_on t), _⟩,
+    rw Ioc_eq_empty_of_le t_pos.lt.le,
+    exact integrable_on_empty, },
+  have eq₁ : ∫⁻ t in Ioi 0, μ {a : α | t ≤ f a} * ennreal.of_real (g t)
+             = ∫⁻ t in Ioi 0, μ {a : α | t ≤ f a} * ennreal.of_real (G t),
+  { apply lintegral_congr_ae,
+    filter_upwards [g_eq_G] with a ha,
+    rw [ha], },
+  have eq₂ : ∀ ω, ∫ t in 0..f ω, g t = ∫ t in 0..f ω, G t,
+  { refine λ ω, interval_integral.integral_congr_ae _,
+    have fω_nn : 0 ≤ f ω := f_nn ω,
+    rw [uIoc_of_le fω_nn,
+        ← ae_restrict_iff' (measurable_set_Ioc : measurable_set (Ioc (0 : ℝ) (f ω)))],
+    exact g_eq_G_on (f ω), },
+  simp_rw [eq₁, eq₂],
+  exact lintegral_comp_eq_lintegral_meas_le_mul_of_measurable μ f_nn f_mble
+    G_intble G_mble (λ t t_pos, G_nn t),
+end
+
+/-- The standard case of the layer cake formula / Cavalieri's principle / tail probability formula:
+
+For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
+be written (roughly speaking) as: `∫⁻ f ∂μ = ∫⁻ t in 0 .. ∞, μ {ω | f(ω) ≥ t}`.
+
+See `lintegral_eq_lintegral_meas_lt` for a version with sets of the form `{ω | f(ω) > t}`
+instead. -/
+theorem lintegral_eq_lintegral_meas_le (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f) :
+  ∫⁻ ω, ennreal.of_real (f ω) ∂μ = ∫⁻ t in Ioi 0, (μ {a : α | t ≤ f a}) :=
+begin
+  set cst := λ (t : ℝ), (1 : ℝ) with def_cst,
+  have cst_intble : ∀ t > 0, interval_integrable cst volume 0 t,
+    from λ _ _, interval_integrable_const,
+  have key := lintegral_comp_eq_lintegral_meas_le_mul μ f_nn f_mble cst_intble
+              (eventually_of_forall (λ t, zero_le_one)),
+  simp_rw [def_cst, ennreal.of_real_one, mul_one] at key,
+  rw ← key,
+  congr' with ω,
+  simp only [interval_integral.integral_const, sub_zero, algebra.id.smul_eq_mul, mul_one],
+end
+
+/-- An application of the layer cake formula / Cavalieri's principle / tail probability formula:
+
+For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
+be written (roughly speaking) as: `∫⁻ f^p ∂μ = p * ∫⁻ t in 0 .. ∞, t^(p-1) * μ {ω | f(ω) ≥ t}`.
+
+See `lintegral_rpow_eq_lintegral_meas_lt_mul` for a version with sets of the form `{ω | f(ω) > t}`
+instead. -/
+theorem lintegral_rpow_eq_lintegral_meas_le_mul (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f) {p : ℝ} (p_pos: 0 < p) :
+  ∫⁻ ω, ennreal.of_real ((f ω)^p) ∂μ
+    = (ennreal.of_real p) * ∫⁻ t in Ioi 0, (μ {a : α | t ≤ f a}) * ennreal.of_real (t^(p-1)) :=
+begin
+  have one_lt_p : -1 < p - 1 := by linarith,
+  have obs : ∀ (x : ℝ), (∫ (t : ℝ) in 0..x, t^(p-1)) = x^p / p,
+  { intros x,
+    rw integral_rpow (or.inl one_lt_p),
+    simp [real.zero_rpow p_pos.ne.symm], },
+  set g := λ (t : ℝ), t^(p-1) with g_def,
+  have g_nn : ∀ᵐ t ∂(volume.restrict (Ioi (0 : ℝ))), 0 ≤ g t,
+  { filter_upwards [self_mem_ae_restrict (measurable_set_Ioi : measurable_set (Ioi (0 : ℝ)))],
+    intros t t_pos,
+    rw g_def,
+    exact real.rpow_nonneg_of_nonneg (mem_Ioi.mp t_pos).le (p - 1), },
+  have g_intble : ∀ t > 0, interval_integrable g volume 0 t,
+    from λ _ _, interval_integral.interval_integrable_rpow' one_lt_p,
+  have key := lintegral_comp_eq_lintegral_meas_le_mul μ f_nn f_mble g_intble g_nn,
+  simp_rw [g_def] at key,
+  rw [← key, ← lintegral_const_mul (ennreal.of_real p)]; simp_rw obs,
+  { congr' with ω,
+    rw [← ennreal.of_real_mul p_pos.le, mul_div_cancel' ((f ω)^p) p_pos.ne.symm], },
+  { exact ((f_mble.pow measurable_const).div_const p).ennreal_of_real, },
+end
+
+end measure_theory
+
+end layercake
+
+section layercake_lt
+
+open measure_theory
+
+variables {α : Type*} [measurable_space α] (μ : measure α)
+variables {β : Type*} [measurable_space β] [measurable_singleton_class β]
+
+namespace measure
+
+lemma meas_le_ne_meas_lt_subset_meas_pos {R : Type*} [linear_order R]
+  [measurable_space R] [measurable_singleton_class R] {g : α → R} (g_mble : measurable g) {t : R}
+  (ht : μ {a : α | t ≤ g a} ≠ μ {a : α | t < g a}) :
+  0 < μ {a : α | g a = t} :=
+begin
+  have uni : {a : α | t ≤ g a } = {a : α | t < g a} ∪ {a : α | t = g a},
+  { ext a,
+    simp only [mem_set_of_eq, mem_union],
+    apply le_iff_lt_or_eq, },
+  rw (show {a : α | t = g a} = {a : α | g a = t}, by simp_rw [eq_comm]) at uni,
+  have disj : {a : α | t < g a} ∩ {a : α | g a = t} = ∅,
+  { ext a,
+    simp only [mem_inter_iff, mem_set_of_eq, mem_empty_iff_false, iff_false, not_and],
+    exact ne_of_gt, },
+  have μ_add : μ {a : α | t ≤ g a} = μ {a : α | t < g a} + μ {a : α | g a = t},
+    by rw [uni, measure_union (disjoint_iff_inter_eq_empty.mpr disj)
+                              (g_mble (finite.measurable_set (finite_singleton t)))],
+  by_contra con,
+  rw [not_lt, nonpos_iff_eq_zero] at con,
+  rw [con, add_zero] at μ_add,
+  exact ht μ_add,
+end
+
+lemma countable_meas_le_ne_meas_lt [sigma_finite μ] {R : Type*} [linear_order R]
+  [measurable_space R] [measurable_singleton_class R] {g : α → R} (g_mble : measurable g) :
+  {t : R | μ {a : α | t ≤ g a } ≠ μ {a : α | t < g a}}.countable :=
+countable.mono (show _, from λ t ht, meas_le_ne_meas_lt_subset_meas_pos μ g_mble ht)
+               (measure.countable_meas_level_set_pos g_mble)
+
+lemma meas_le_ae_eq_meas_lt [sigma_finite μ] {R : Type*} [linear_order R] [measurable_space R]
+  [measurable_singleton_class R] (ν : measure R) [has_no_atoms ν]
+  {g : α → R} (g_mble : measurable g) :
+  (λ t, μ {a : α | t ≤ g a}) =ᵐ[ν] (λ t, μ {a : α | t < g a}) :=
+set.countable.measure_zero (measure.countable_meas_le_ne_meas_lt μ g_mble) _
+
+end measure
+
+variables {f : α → ℝ} {g : ℝ → ℝ} {s : set α}
+
+/-- The layer cake formula / Cavalieri's principle / tail probability formula:
+
+Let `f` be a non-negative measurable function on a sigma-finite measure space. Let `G` be an
+increasing absolutely continuous function on the positive real line, vanishing at the origin,
+with derivative `G' = g`. Then the integral of the composition `G ∘ f` can be written as
+the integral over the positive real line of the "tail measures" `μ {ω | f(ω) > t}` of `f`
+weighted by `g`.
+
+Roughly speaking, the statement is: `∫⁻ (G ∘ f) ∂μ = ∫⁻ t in 0 .. ∞, g(t) * μ {ω | f(ω) > t}`.
+
+See `lintegral_comp_eq_lintegral_meas_le_mul` for a version with sets of the form `{ω | f(ω) ≥ t}`
+instead. -/
+theorem lintegral_comp_eq_lintegral_meas_lt_mul (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f)
+  (g_intble : ∀ t > 0, interval_integrable g volume 0 t)
+  (g_nn : ∀ᵐ t ∂(volume.restrict (Ioi 0)), 0 ≤ g t) :
+  ∫⁻ ω, ennreal.of_real (∫ t in 0 .. f ω, g t) ∂μ
+    = ∫⁻ t in Ioi 0, μ {a : α | t < f a} * ennreal.of_real (g t) :=
+begin
+  rw lintegral_comp_eq_lintegral_meas_le_mul μ f_nn f_mble g_intble g_nn,
+  apply lintegral_congr_ae,
+  filter_upwards [measure.meas_le_ae_eq_meas_lt μ (volume.restrict (Ioi 0)) f_mble] with t ht,
+  rw ht,
+end
+
+/-- The standard case of the layer cake formula / Cavalieri's principle / tail probability formula:
+
+For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
+be written (roughly speaking) as: `∫⁻ f ∂μ = ∫⁻ t in 0 .. ∞, μ {ω | f(ω) > t}`.
+
+See `lintegral_eq_lintegral_meas_le` for a version with sets of the form `{ω | f(ω) ≥ t}`
+instead. -/
+theorem lintegral_eq_lintegral_meas_lt (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f) :
+  ∫⁻ ω, ennreal.of_real (f ω) ∂μ = ∫⁻ t in Ioi 0, (μ {a : α | t < f a}) :=
+begin
+  rw lintegral_eq_lintegral_meas_le μ f_nn f_mble,
+  apply lintegral_congr_ae,
+  filter_upwards [measure.meas_le_ae_eq_meas_lt μ (volume.restrict (Ioi 0)) f_mble] with t ht,
+  rw ht,
+end
+
+/-- An application of the layer cake formula / Cavalieri's principle / tail probability formula:
+
+For a nonnegative function `f` on a sigma-finite measure space, the Lebesgue integral of `f` can
+be written (roughly speaking) as: `∫⁻ f^p ∂μ = p * ∫⁻ t in 0 .. ∞, t^(p-1) * μ {ω | f(ω) > t}`.
+
+See `lintegral_rpow_eq_lintegral_meas_le_mul` for a version with sets of the form `{ω | f(ω) ≥ t}`
+instead. -/
+theorem lintegral_rpow_eq_lintegral_meas_lt_mul (μ : measure α) [sigma_finite μ]
+  (f_nn : 0 ≤ f) (f_mble : measurable f) {p : ℝ} (p_pos: 0 < p) :
+  ∫⁻ ω, ennreal.of_real ((f ω)^p) ∂μ
+    = (ennreal.of_real p) * ∫⁻ t in Ioi 0, (μ {a : α | t < f a}) * ennreal.of_real (t^(p-1)) :=
+begin
+  rw lintegral_rpow_eq_lintegral_meas_le_mul μ f_nn f_mble p_pos,
+  apply congr_arg (λ z, (ennreal.of_real p * z)),
+  apply lintegral_congr_ae,
+  filter_upwards [measure.meas_le_ae_eq_meas_lt μ (volume.restrict (Ioi 0)) f_mble] with t ht,
+  rw ht,
+end
+
+end layercake_lt
diff --git a/src/measure_theory/integral/lebesgue.lean b/src/measure_theory/integral/lebesgue.lean
index 8f13b3c789654..6041f5c3b1747 100644
--- a/src/measure_theory/integral/lebesgue.lean
+++ b/src/measure_theory/integral/lebesgue.lean
@@ -3,22 +3,17 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Johannes Hölzl
 -/
-import measure_theory.measure.mutually_singular
-import measure_theory.constructions.borel_space
-import algebra.indicator_function
-import algebra.support
 import dynamics.ergodic.measure_preserving
+import measure_theory.function.simple_func
+import measure_theory.measure.mutually_singular
 
 /-!
-# Lebesgue integral for `ℝ≥0∞`-valued functions
+# Lower Lebesgue integral for `ℝ≥0∞`-valued functions
 
-We define simple functions and show that each Borel measurable function on `ℝ≥0∞` can be
-approximated by a sequence of simple functions.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-To prove something for an arbitrary measurable function into `ℝ≥0∞`, the theorem
-`measurable.ennreal_induction` shows that is it sufficient to show that the property holds for
-(multiples of) characteristic functions and is closed under addition and supremum of increasing
-sequences of functions.
+We define the lower Lebesgue integral of an `ℝ≥0∞`-valued function.
 
 ## Notation
 
@@ -36,970 +31,65 @@ We introduce the following notation for the lower Lebesgue integral of a functio
 
 noncomputable theory
 open set (hiding restrict restrict_apply) filter ennreal function (support)
-open_locale classical topological_space big_operators nnreal ennreal measure_theory
+open_locale classical topology big_operators nnreal ennreal measure_theory
 
 namespace measure_theory
 
-variables {α β γ δ : Type*}
-
-/-- A function `f` from a measurable space to any type is called *simple*,
-if every preimage `f ⁻¹' {x}` is measurable, and the range is finite. This structure bundles
-a function with these properties. -/
-structure {u v} simple_func (α : Type u) [measurable_space α] (β : Type v) :=
-(to_fun : α → β)
-(measurable_set_fiber' : ∀ x, measurable_set (to_fun ⁻¹' {x}))
-(finite_range' : (set.range to_fun).finite)
-
-local infixr ` →ₛ `:25 := simple_func
-
-namespace simple_func
-
-section measurable
-variables [measurable_space α]
-instance has_coe_to_fun : has_coe_to_fun (α →ₛ β) (λ _, α → β) := ⟨to_fun⟩
-
-lemma coe_injective ⦃f g : α →ₛ β⦄ (H : (f : α → β) = g) : f = g :=
-by cases f; cases g; congr; exact H
-
-@[ext] theorem ext {f g : α →ₛ β} (H : ∀ a, f a = g a) : f = g :=
-coe_injective $ funext H
-
-lemma finite_range (f : α →ₛ β) : (set.range f).finite := f.finite_range'
-
-lemma measurable_set_fiber (f : α →ₛ β) (x : β) : measurable_set (f ⁻¹' {x}) :=
-f.measurable_set_fiber' x
-
-@[simp] lemma apply_mk (f : α → β) (h h') (x : α) : simple_func.mk f h h' x = f x := rfl
-
-/-- Simple function defined on the empty type. -/
-def of_is_empty [is_empty α] : α →ₛ β :=
-{ to_fun := is_empty_elim,
-  measurable_set_fiber' := λ x, subsingleton.measurable_set,
-  finite_range' := by simp [range_eq_empty] }
-
-/-- Range of a simple function `α →ₛ β` as a `finset β`. -/
-protected def range (f : α →ₛ β) : finset β := f.finite_range.to_finset
-
-@[simp] theorem mem_range {f : α →ₛ β} {b} : b ∈ f.range ↔ b ∈ range f :=
-finite.mem_to_finset _
-
-theorem mem_range_self (f : α →ₛ β) (x : α) : f x ∈ f.range := mem_range.2 ⟨x, rfl⟩
-
-@[simp] lemma coe_range (f : α →ₛ β) : (↑f.range : set β) = set.range f :=
-f.finite_range.coe_to_finset
-
-theorem mem_range_of_measure_ne_zero {f : α →ₛ β} {x : β} {μ : measure α} (H : μ (f ⁻¹' {x}) ≠ 0) :
-  x ∈ f.range :=
-let ⟨a, ha⟩ := nonempty_of_measure_ne_zero H in
-mem_range.2 ⟨a, ha⟩
-
-lemma forall_range_iff {f : α →ₛ β} {p : β → Prop} :
-  (∀ y ∈ f.range, p y) ↔ ∀ x, p (f x) :=
-by simp only [mem_range, set.forall_range_iff]
-
-lemma exists_range_iff {f : α →ₛ β} {p : β → Prop} :
-  (∃ y ∈ f.range, p y) ↔ ∃ x, p (f x) :=
-by simpa only [mem_range, exists_prop] using set.exists_range_iff
-
-lemma preimage_eq_empty_iff (f : α →ₛ β) (b : β) : f ⁻¹' {b} = ∅ ↔ b ∉ f.range :=
-preimage_singleton_eq_empty.trans $ not_congr mem_range.symm
-
-lemma exists_forall_le [nonempty β] [preorder β] [is_directed β (≤)] (f : α →ₛ β) :
-  ∃ C, ∀ x, f x ≤ C :=
-f.range.exists_le.imp $ λ C, forall_range_iff.1
-
-/-- Constant function as a `simple_func`. -/
-def const (α) {β} [measurable_space α] (b : β) : α →ₛ β :=
-⟨λ a, b, λ x, measurable_set.const _, finite_range_const⟩
-
-instance [inhabited β] : inhabited (α →ₛ β) := ⟨const _ default⟩
-
-theorem const_apply (a : α) (b : β) : (const α b) a = b := rfl
-
-@[simp] theorem coe_const (b : β) : ⇑(const α b) = function.const α b := rfl
-
-@[simp] lemma range_const (α) [measurable_space α] [nonempty α] (b : β) :
-  (const α b).range = {b} :=
-finset.coe_injective $ by simp
-
-lemma range_const_subset (α) [measurable_space α] (b : β) :
-  (const α b).range ⊆ {b} :=
-finset.coe_subset.1 $ by simp
-
-lemma measurable_set_cut (r : α → β → Prop) (f : α →ₛ β)
-  (h : ∀b, measurable_set {a | r a b}) : measurable_set {a | r a (f a)} :=
-begin
-  have : {a | r a (f a)} = ⋃ b ∈ range f, {a | r a b} ∩ f ⁻¹' {b},
-  { ext a,
-    suffices : r a (f a) ↔ ∃ i, r a (f i) ∧ f a = f i, by simpa,
-    exact ⟨λ h, ⟨a, ⟨h, rfl⟩⟩, λ ⟨a', ⟨h', e⟩⟩, e.symm ▸ h'⟩ },
-  rw this,
-  exact measurable_set.bUnion f.finite_range.countable
-    (λ b _, measurable_set.inter (h b) (f.measurable_set_fiber _))
-end
-
-@[measurability]
-theorem measurable_set_preimage (f : α →ₛ β) (s) : measurable_set (f ⁻¹' s) :=
-measurable_set_cut (λ _ b, b ∈ s) f (λ b, measurable_set.const (b ∈ s))
-
-/-- A simple function is measurable -/
-@[measurability]
-protected theorem measurable [measurable_space β] (f : α →ₛ β) : measurable f :=
-λ s _, measurable_set_preimage f s
-
-@[measurability]
-protected theorem ae_measurable [measurable_space β] {μ : measure α} (f : α →ₛ β) :
-  ae_measurable f μ :=
-f.measurable.ae_measurable
-
-protected lemma sum_measure_preimage_singleton (f : α →ₛ β) {μ : measure α} (s : finset β) :
-  ∑ y in s, μ (f ⁻¹' {y}) = μ (f ⁻¹' ↑s) :=
-sum_measure_preimage_singleton _ (λ _ _, f.measurable_set_fiber _)
-
-lemma sum_range_measure_preimage_singleton (f : α →ₛ β) (μ : measure α) :
-  ∑ y in f.range, μ (f ⁻¹' {y}) = μ univ :=
-by rw [f.sum_measure_preimage_singleton, coe_range, preimage_range]
-
-/-- If-then-else as a `simple_func`. -/
-def piecewise (s : set α) (hs : measurable_set s) (f g : α →ₛ β) : α →ₛ β :=
-⟨s.piecewise f g,
- λ x, by letI : measurable_space β := ⊤; exact
-   f.measurable.piecewise hs g.measurable trivial,
- (f.finite_range.union g.finite_range).subset range_ite_subset⟩
-
-@[simp] theorem coe_piecewise {s : set α} (hs : measurable_set s) (f g : α →ₛ β) :
-  ⇑(piecewise s hs f g) = s.piecewise f g :=
-rfl
-
-theorem piecewise_apply {s : set α} (hs : measurable_set s) (f g : α →ₛ β) (a) :
-  piecewise s hs f g a = if a ∈ s then f a else g a :=
-rfl
-
-@[simp] lemma piecewise_compl {s : set α} (hs : measurable_set sᶜ) (f g : α →ₛ β) :
-  piecewise sᶜ hs f g = piecewise s hs.of_compl g f :=
-coe_injective $ by simp [hs]
-
-@[simp] lemma piecewise_univ (f g : α →ₛ β) : piecewise univ measurable_set.univ f g = f :=
-coe_injective $ by simp
-
-@[simp] lemma piecewise_empty (f g : α →ₛ β) : piecewise ∅ measurable_set.empty f g = g :=
-coe_injective $ by simp
-
-lemma support_indicator [has_zero β] {s : set α} (hs : measurable_set s) (f : α →ₛ β) :
-  function.support (f.piecewise s hs (simple_func.const α 0)) = s ∩ function.support f :=
-set.support_indicator
-
-lemma range_indicator {s : set α} (hs : measurable_set s)
-  (hs_nonempty : s.nonempty) (hs_ne_univ : s ≠ univ) (x y : β) :
-  (piecewise s hs (const α x) (const α y)).range = {x, y} :=
-begin
-  ext1 z,
-  rw [mem_range, set.mem_range, finset.mem_insert, finset.mem_singleton],
-  simp_rw piecewise_apply,
-  split; intro h,
-  { obtain ⟨a, haz⟩ := h,
-    by_cases has : a ∈ s,
-    { left,
-      simp only [has, function.const_apply, if_true, coe_const] at haz,
-      exact haz.symm, },
-    { right,
-      simp only [has, function.const_apply, if_false, coe_const] at haz,
-      exact haz.symm, }, },
-  { cases h,
-    { obtain ⟨a, has⟩ : ∃ a, a ∈ s, from hs_nonempty,
-      exact ⟨a, by simpa [has] using h.symm⟩, },
-    { obtain ⟨a, has⟩ : ∃ a, a ∉ s,
-      { by_contra' h,
-        refine hs_ne_univ _,
-        ext1 a,
-        simp [h a], },
-      exact ⟨a, by simpa [has] using h.symm⟩, }, },
-end
-
-lemma measurable_bind [measurable_space γ] (f : α →ₛ β) (g : β → α → γ)
-  (hg : ∀ b, measurable (g b)) : measurable (λ a, g (f a) a) :=
-λ s hs, f.measurable_set_cut (λ a b, g b a ∈ s) $ λ b, hg b hs
-
-/-- If `f : α →ₛ β` is a simple function and `g : β → α →ₛ γ` is a family of simple functions,
-then `f.bind g` binds the first argument of `g` to `f`. In other words, `f.bind g a = g (f a) a`. -/
-def bind (f : α →ₛ β) (g : β → α →ₛ γ) : α →ₛ γ :=
-⟨λa, g (f a) a,
- λ c, f.measurable_set_cut (λ a b, g b a = c) $ λ b, (g b).measurable_set_preimage {c},
- (f.finite_range.bUnion (λ b _, (g b).finite_range)).subset $
- by rintro _ ⟨a, rfl⟩; simp; exact ⟨a, a, rfl⟩⟩
-
-@[simp] theorem bind_apply (f : α →ₛ β) (g : β → α →ₛ γ) (a) :
-  f.bind g a = g (f a) a := rfl
-
-/-- Given a function `g : β → γ` and a simple function `f : α →ₛ β`, `f.map g` return the simple
-    function `g ∘ f : α →ₛ γ` -/
-def map (g : β → γ) (f : α →ₛ β) : α →ₛ γ := bind f (const α ∘ g)
-
-theorem map_apply (g : β → γ) (f : α →ₛ β) (a) : f.map g a = g (f a) := rfl
-
-theorem map_map (g : β → γ) (h: γ → δ) (f : α →ₛ β) : (f.map g).map h = f.map (h ∘ g) := rfl
-
-@[simp] theorem coe_map (g : β → γ) (f : α →ₛ β) : (f.map g : α → γ) = g ∘ f := rfl
-
-@[simp] theorem range_map [decidable_eq γ] (g : β → γ) (f : α →ₛ β) :
-  (f.map g).range = f.range.image g :=
-finset.coe_injective $ by simp only [coe_range, coe_map, finset.coe_image, range_comp]
-
-@[simp] theorem map_const (g : β → γ) (b : β) : (const α b).map g = const α (g b) := rfl
-
-lemma map_preimage (f : α →ₛ β) (g : β → γ) (s : set γ) :
-  (f.map g) ⁻¹' s = f ⁻¹' ↑(f.range.filter (λb, g b ∈ s)) :=
-by { simp only [coe_range, sep_mem_eq, set.mem_range, function.comp_app, coe_map, finset.coe_filter,
-  ← mem_preimage, inter_comm, preimage_inter_range], apply preimage_comp }
-
-lemma map_preimage_singleton (f : α →ₛ β) (g : β → γ) (c : γ) :
-  (f.map g) ⁻¹' {c} = f ⁻¹' ↑(f.range.filter (λ b, g b = c)) :=
-map_preimage _ _ _
-
-/-- Composition of a `simple_fun` and a measurable function is a `simple_func`. -/
-def comp [measurable_space β] (f : β →ₛ γ) (g : α → β) (hgm : measurable g) : α →ₛ γ :=
-{ to_fun := f ∘ g,
-  finite_range' := f.finite_range.subset $ set.range_comp_subset_range _ _,
-  measurable_set_fiber' := λ z, hgm (f.measurable_set_fiber z) }
-
-@[simp] lemma coe_comp [measurable_space β] (f : β →ₛ γ) {g : α → β} (hgm : measurable g) :
-  ⇑(f.comp g hgm) = f ∘ g :=
-rfl
-
-lemma range_comp_subset_range [measurable_space β] (f : β →ₛ γ) {g : α → β} (hgm : measurable g) :
-  (f.comp g hgm).range ⊆ f.range :=
-finset.coe_subset.1 $ by simp only [coe_range, coe_comp, set.range_comp_subset_range]
-
-/-- Extend a `simple_func` along a measurable embedding: `f₁.extend g hg f₂` is the function
-`F : β →ₛ γ` such that `F ∘ g = f₁` and `F y = f₂ y` whenever `y ∉ range g`. -/
-def extend [measurable_space β] (f₁ : α →ₛ γ) (g : α → β)
-  (hg : measurable_embedding g) (f₂ : β →ₛ γ) : β →ₛ γ :=
-{ to_fun := function.extend g f₁ f₂,
-  finite_range' := (f₁.finite_range.union $ f₂.finite_range.subset
-    (image_subset_range _ _)).subset (range_extend_subset _ _ _),
-  measurable_set_fiber' :=
-    begin
-      letI : measurable_space γ := ⊤, haveI : measurable_singleton_class γ := ⟨λ _, trivial⟩,
-      exact λ x, hg.measurable_extend f₁.measurable f₂.measurable (measurable_set_singleton _)
-    end }
-
-@[simp] lemma extend_apply [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
-  (hg : measurable_embedding g) (f₂ : β →ₛ γ) (x : α) : (f₁.extend g hg f₂) (g x) = f₁ x :=
-function.extend_apply hg.injective _ _ _
-
-@[simp] lemma extend_apply' [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
-  (hg : measurable_embedding g) (f₂ : β →ₛ γ) {y : β} (h : ¬∃ x, g x = y) :
-  (f₁.extend g hg f₂) y = f₂ y :=
-function.extend_apply' _ _ _ h
-
-@[simp] lemma extend_comp_eq' [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
-  (hg : measurable_embedding g) (f₂ : β →ₛ γ) : (f₁.extend g hg f₂) ∘ g = f₁ :=
-funext $ λ x, extend_apply _ _ _ _
-
-@[simp] lemma extend_comp_eq [measurable_space β] (f₁ : α →ₛ γ) {g : α → β}
-  (hg : measurable_embedding g) (f₂ : β →ₛ γ) : (f₁.extend g hg f₂).comp g hg.measurable = f₁ :=
-coe_injective $ extend_comp_eq' _ _ _
-
-/-- If `f` is a simple function taking values in `β → γ` and `g` is another simple function
-with the same domain and codomain `β`, then `f.seq g = f a (g a)`. -/
-def seq (f : α →ₛ (β → γ)) (g : α →ₛ β) : α →ₛ γ := f.bind (λf, g.map f)
-
-@[simp] lemma seq_apply (f : α →ₛ (β → γ)) (g : α →ₛ β) (a : α) : f.seq g a = f a (g a) := rfl
-
-/-- Combine two simple functions `f : α →ₛ β` and `g : α →ₛ β`
-into `λ a, (f a, g a)`. -/
-def pair (f : α →ₛ β) (g : α →ₛ γ) : α →ₛ (β × γ) := (f.map prod.mk).seq g
-
-@[simp] lemma pair_apply (f : α →ₛ β) (g : α →ₛ γ) (a) : pair f g a = (f a, g a) := rfl
-
-lemma pair_preimage (f : α →ₛ β) (g : α →ₛ γ) (s : set β) (t : set γ) :
-  pair f g ⁻¹' s ×ˢ t = (f ⁻¹' s) ∩ (g ⁻¹' t) := rfl
-
-/- A special form of `pair_preimage` -/
-lemma pair_preimage_singleton (f : α →ₛ β) (g : α →ₛ γ) (b : β) (c : γ) :
-  (pair f g) ⁻¹' {(b, c)} = (f ⁻¹' {b}) ∩ (g ⁻¹' {c}) :=
-by { rw ← singleton_prod_singleton, exact pair_preimage _ _ _ _ }
-
-theorem bind_const (f : α →ₛ β) : f.bind (const α) = f := by ext; simp
-
-@[to_additive] instance [has_one β] : has_one (α →ₛ β) := ⟨const α 1⟩
-@[to_additive] instance [has_mul β] : has_mul (α →ₛ β) := ⟨λf g, (f.map (*)).seq g⟩
-@[to_additive] instance [has_div β] : has_div (α →ₛ β) := ⟨λf g, (f.map (/)).seq g⟩
-@[to_additive] instance [has_inv β] : has_inv (α →ₛ β) := ⟨λf, f.map (has_inv.inv)⟩
-instance [has_sup β] : has_sup (α →ₛ β) := ⟨λf g, (f.map (⊔)).seq g⟩
-instance [has_inf β] : has_inf (α →ₛ β) := ⟨λf g, (f.map (⊓)).seq g⟩
-instance [has_le β] : has_le (α →ₛ β) := ⟨λf g, ∀a, f a ≤ g a⟩
-
-@[simp, to_additive] lemma const_one [has_one β] : const α (1 : β) = 1 := rfl
-
-@[simp, norm_cast, to_additive] lemma coe_one [has_one β] : ⇑(1 : α →ₛ β) = 1 := rfl
-@[simp, norm_cast, to_additive] lemma coe_mul [has_mul β] (f g : α →ₛ β) : ⇑(f * g) = f * g := rfl
-@[simp, norm_cast, to_additive] lemma coe_inv [has_inv β] (f : α →ₛ β) : ⇑(f⁻¹) = f⁻¹ := rfl
-@[simp, norm_cast, to_additive] lemma coe_div [has_div β] (f g : α →ₛ β) : ⇑(f / g) = f / g := rfl
-@[simp, norm_cast] lemma coe_le [preorder β] {f g : α →ₛ β} : (f : α → β) ≤ g ↔ f ≤ g := iff.rfl
-@[simp, norm_cast] lemma coe_sup [has_sup β] (f g : α →ₛ β) : ⇑(f ⊔ g) = f ⊔ g := rfl
-@[simp, norm_cast] lemma coe_inf [has_inf β] (f g : α →ₛ β) : ⇑(f ⊓ g) = f ⊓ g := rfl
-
-@[to_additive] lemma mul_apply [has_mul β] (f g : α →ₛ β) (a : α) : (f * g) a = f a * g a := rfl
-@[to_additive] lemma div_apply [has_div β] (f g : α →ₛ β) (x : α) : (f / g) x = f x / g x := rfl
-@[to_additive] lemma inv_apply [has_inv β] (f : α →ₛ β) (x : α) : f⁻¹ x = (f x)⁻¹ := rfl
-lemma sup_apply [has_sup β] (f g : α →ₛ β) (a : α) : (f ⊔ g) a = f a ⊔ g a := rfl
-lemma inf_apply [has_inf β] (f g : α →ₛ β) (a : α) : (f ⊓ g) a = f a ⊓ g a := rfl
-
-@[simp, to_additive] lemma range_one [nonempty α] [has_one β] : (1 : α →ₛ β).range = {1} :=
-finset.ext $ λ x, by simp [eq_comm]
-
-@[simp] lemma range_eq_empty_of_is_empty {β} [hα : is_empty α] (f : α →ₛ β) :
-  f.range = ∅ :=
-begin
-  rw ← finset.not_nonempty_iff_eq_empty,
-  by_contra,
-  obtain ⟨y, hy_mem⟩ := h,
-  rw [simple_func.mem_range, set.mem_range] at hy_mem,
-  obtain ⟨x, hxy⟩ := hy_mem,
-  rw is_empty_iff at hα,
-  exact hα x,
-end
-
-lemma eq_zero_of_mem_range_zero [has_zero β] : ∀ {y : β}, y ∈ (0 : α →ₛ β).range → y = 0 :=
-forall_range_iff.2 $ λ x, rfl
-
-@[to_additive]
-lemma mul_eq_map₂ [has_mul β] (f g : α →ₛ β) : f * g = (pair f g).map (λp:β×β, p.1 * p.2) := rfl
-
-lemma sup_eq_map₂ [has_sup β] (f g : α →ₛ β) : f ⊔ g = (pair f g).map (λp:β×β, p.1 ⊔ p.2) := rfl
-
-@[to_additive]
-lemma const_mul_eq_map [has_mul β] (f : α →ₛ β) (b : β) : const α b * f = f.map (λa, b * a) := rfl
-
-@[to_additive]
-theorem map_mul [has_mul β] [has_mul γ] {g : β → γ}
-  (hg : ∀ x y, g (x * y) = g x * g y) (f₁ f₂ : α →ₛ β) : (f₁ * f₂).map g = f₁.map g * f₂.map g :=
-ext $ λ x, hg _ _
-
-variables {K : Type*}
-
-instance [has_scalar K β] : has_scalar K (α →ₛ β) := ⟨λ k f, f.map ((•) k)⟩
-@[simp] lemma coe_smul [has_scalar K β] (c : K) (f : α →ₛ β) : ⇑(c • f) = c • f := rfl
-lemma smul_apply [has_scalar K β] (k : K) (f : α →ₛ β) (a : α) : (k • f) a = k • f a := rfl
-
-instance has_nat_pow [monoid β] : has_pow (α →ₛ β) ℕ := ⟨λ f n, f.map (^ n)⟩
-@[simp] lemma coe_pow [monoid β] (f : α →ₛ β) (n : ℕ) : ⇑(f ^ n) = f ^ n := rfl
-lemma pow_apply [monoid β] (n : ℕ) (f : α →ₛ β) (a : α) : (f ^ n) a = f a ^ n := rfl
-
-instance has_int_pow [div_inv_monoid β] : has_pow (α →ₛ β) ℤ := ⟨λ f n, f.map (^ n)⟩
-@[simp] lemma coe_zpow [div_inv_monoid β] (f : α →ₛ β) (z : ℤ) : ⇑(f ^ z) = f ^ z := rfl
-lemma zpow_apply [div_inv_monoid β] (z : ℤ) (f : α →ₛ β) (a : α) : (f ^ z) a = f a ^ z := rfl
-
--- TODO: work out how to generate these instances with `to_additive`, which gets confused by the
--- argument order swap between `coe_smul` and `coe_pow`.
-section additive
-
-instance [add_monoid β] : add_monoid (α →ₛ β) :=
-function.injective.add_monoid (λ f, show α → β, from f) coe_injective coe_zero coe_add
-  (λ _ _, coe_smul _ _)
-
-instance [add_comm_monoid β] : add_comm_monoid (α →ₛ β) :=
-function.injective.add_comm_monoid (λ f, show α → β, from f) coe_injective coe_zero coe_add
-  (λ _ _, coe_smul _ _)
-
-instance [add_group β] : add_group (α →ₛ β) :=
-function.injective.add_group (λ f, show α → β, from f) coe_injective
-  coe_zero coe_add coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _)
-
-instance [add_comm_group β] : add_comm_group (α →ₛ β) :=
-function.injective.add_comm_group (λ f, show α → β, from f) coe_injective
-  coe_zero coe_add coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _)
-
-end additive
-
-@[to_additive] instance [monoid β] : monoid (α →ₛ β) :=
-function.injective.monoid (λ f, show α → β, from f) coe_injective coe_one coe_mul coe_pow
-
-@[to_additive] instance [comm_monoid β] : comm_monoid (α →ₛ β) :=
-function.injective.comm_monoid (λ f, show α → β, from f) coe_injective coe_one coe_mul coe_pow
-
-@[to_additive] instance [group β] : group (α →ₛ β) :=
-function.injective.group (λ f, show α → β, from f) coe_injective
-  coe_one coe_mul coe_inv coe_div coe_pow coe_zpow
-
-@[to_additive] instance [comm_group β] : comm_group (α →ₛ β) :=
-function.injective.comm_group (λ f, show α → β, from f) coe_injective
-  coe_one coe_mul coe_inv coe_div coe_pow coe_zpow
-
-instance [semiring K] [add_comm_monoid β] [module K β] : module K (α →ₛ β) :=
-function.injective.module K ⟨λ f, show α → β, from f, coe_zero, coe_add⟩
-  coe_injective coe_smul
-
-lemma smul_eq_map [has_scalar K β] (k : K) (f : α →ₛ β) : k • f = f.map ((•) k) := rfl
 
-instance [preorder β] : preorder (α →ₛ β) :=
-{ le_refl := λf a, le_rfl,
-  le_trans := λf g h hfg hgh a, le_trans (hfg _) (hgh a),
-  .. simple_func.has_le }
+section move_this
 
-instance [partial_order β] : partial_order (α →ₛ β) :=
-{ le_antisymm := assume f g hfg hgf, ext $ assume a, le_antisymm (hfg a) (hgf a),
-  .. simple_func.preorder }
+variables {α : Type*} {mα : measurable_space α} {a : α} {s : set α}
+include mα
 
-instance [has_le β] [order_bot β] : order_bot (α →ₛ β) :=
-{ bot := const α ⊥, bot_le := λf a, bot_le }
-
-instance [has_le β] [order_top β] : order_top (α →ₛ β) :=
-{ top := const α ⊤, le_top := λf a, le_top }
-
-instance [semilattice_inf β] : semilattice_inf (α →ₛ β) :=
-{ inf := (⊓),
-  inf_le_left := assume f g a, inf_le_left,
-  inf_le_right := assume f g a, inf_le_right,
-  le_inf := assume f g h hfh hgh a, le_inf (hfh a) (hgh a),
-  .. simple_func.partial_order }
-
-instance [semilattice_sup β] : semilattice_sup (α →ₛ β) :=
-{ sup := (⊔),
-  le_sup_left := assume f g a, le_sup_left,
-  le_sup_right := assume f g a, le_sup_right,
-  sup_le := assume f g h hfh hgh a, sup_le (hfh a) (hgh a),
-  .. simple_func.partial_order }
-
-instance [lattice β] : lattice (α →ₛ β) :=
-{ .. simple_func.semilattice_sup,.. simple_func.semilattice_inf }
-
-instance [has_le β] [bounded_order β] : bounded_order (α →ₛ β) :=
-{ .. simple_func.order_bot, .. simple_func.order_top }
-
-lemma finset_sup_apply [semilattice_sup β] [order_bot β] {f : γ → α →ₛ β} (s : finset γ) (a : α) :
-  s.sup f a = s.sup (λc, f c a) :=
-begin
-  refine finset.induction_on s rfl _,
-  assume a s hs ih,
-  rw [finset.sup_insert, finset.sup_insert, sup_apply, ih]
-end
-
-section restrict
-
-variables [has_zero β]
-
-/-- Restrict a simple function `f : α →ₛ β` to a set `s`. If `s` is measurable,
-then `f.restrict s a = if a ∈ s then f a else 0`, otherwise `f.restrict s = const α 0`. -/
-def restrict (f : α →ₛ β) (s : set α) : α →ₛ β :=
-if hs : measurable_set s then piecewise s hs f 0 else 0
-
-theorem restrict_of_not_measurable {f : α →ₛ β} {s : set α}
-  (hs : ¬measurable_set s) :
-  restrict f s = 0 :=
-dif_neg hs
-
-@[simp] theorem coe_restrict (f : α →ₛ β) {s : set α} (hs : measurable_set s) :
-  ⇑(restrict f s) = indicator s f :=
-by { rw [restrict, dif_pos hs], refl }
-
-@[simp] theorem restrict_univ (f : α →ₛ β) : restrict f univ = f :=
-by simp [restrict]
-
-@[simp] theorem restrict_empty (f : α →ₛ β) : restrict f ∅ = 0 :=
-by simp [restrict]
-
-theorem map_restrict_of_zero [has_zero γ] {g : β → γ} (hg : g 0 = 0) (f : α →ₛ β) (s : set α) :
-  (f.restrict s).map g = (f.map g).restrict s :=
-ext $ λ x,
-if hs : measurable_set s then by simp [hs, set.indicator_comp_of_zero hg]
-else by simp [restrict_of_not_measurable hs, hg]
-
-theorem map_coe_ennreal_restrict (f : α →ₛ ℝ≥0) (s : set α) :
-  (f.restrict s).map (coe : ℝ≥0 → ℝ≥0∞) = (f.map coe).restrict s :=
-map_restrict_of_zero ennreal.coe_zero _ _
-
-theorem map_coe_nnreal_restrict (f : α →ₛ ℝ≥0) (s : set α) :
-  (f.restrict s).map (coe : ℝ≥0 → ℝ) = (f.map coe).restrict s :=
-map_restrict_of_zero nnreal.coe_zero _ _
-
-theorem restrict_apply (f : α →ₛ β) {s : set α} (hs : measurable_set s) (a) :
-  restrict f s a = indicator s f a :=
-by simp only [f.coe_restrict hs]
-
-theorem restrict_preimage (f : α →ₛ β) {s : set α} (hs : measurable_set s)
-  {t : set β} (ht : (0:β) ∉ t) : restrict f s ⁻¹' t = s ∩ f ⁻¹' t :=
-by simp [hs, indicator_preimage_of_not_mem _ _ ht, inter_comm]
-
-theorem restrict_preimage_singleton (f : α →ₛ β) {s : set α} (hs : measurable_set s)
-  {r : β} (hr : r ≠ 0) : restrict f s ⁻¹' {r} = s ∩ f ⁻¹' {r} :=
-f.restrict_preimage hs hr.symm
-
-lemma mem_restrict_range {r : β} {s : set α} {f : α →ₛ β} (hs : measurable_set s) :
-  r ∈ (restrict f s).range ↔ (r = 0 ∧ s ≠ univ) ∨ (r ∈ f '' s) :=
-by rw [← finset.mem_coe, coe_range, coe_restrict _ hs, mem_range_indicator]
-
-lemma mem_image_of_mem_range_restrict {r : β} {s : set α} {f : α →ₛ β}
-  (hr : r ∈ (restrict f s).range) (h0 : r ≠ 0) :
-  r ∈ f '' s :=
-if hs : measurable_set s then by simpa [mem_restrict_range hs, h0] using hr
-else by { rw [restrict_of_not_measurable hs] at hr,
-  exact (h0 $ eq_zero_of_mem_range_zero hr).elim }
-
-@[mono] lemma restrict_mono [preorder β] (s : set α) {f g : α →ₛ β} (H : f ≤ g) :
-  f.restrict s ≤ g.restrict s :=
-if hs : measurable_set s then λ x, by simp only [coe_restrict _ hs, indicator_le_indicator (H x)]
-else by simp only [restrict_of_not_measurable hs, le_refl]
-
-end restrict
-
-section approx
-
-section
-variables [semilattice_sup β] [order_bot β] [has_zero β]
-
-/-- Fix a sequence `i : ℕ → β`. Given a function `α → β`, its `n`-th approximation
-by simple functions is defined so that in case `β = ℝ≥0∞` it sends each `a` to the supremum
-of the set `{i k | k ≤ n ∧ i k ≤ f a}`, see `approx_apply` and `supr_approx_apply` for details. -/
-def approx (i : ℕ → β) (f : α → β) (n : ℕ) : α →ₛ β :=
-(finset.range n).sup (λk, restrict (const α (i k)) {a:α | i k ≤ f a})
-
-lemma approx_apply [topological_space β] [order_closed_topology β] [measurable_space β]
-  [opens_measurable_space β] {i : ℕ → β} {f : α → β} {n : ℕ} (a : α) (hf : measurable f) :
-  (approx i f n : α →ₛ β) a = (finset.range n).sup (λk, if i k ≤ f a then i k else 0) :=
+-- todo after the port: move to measure_theory/measure/measure_space
+lemma restrict_dirac' (hs : measurable_set s) [decidable (a ∈ s)] :
+  (measure.dirac a).restrict s = if a ∈ s then measure.dirac a else 0 :=
 begin
-  dsimp only [approx],
-  rw [finset_sup_apply],
-  congr,
-  funext k,
-  rw [restrict_apply],
-  refl,
-  exact (hf measurable_set_Ici)
-end
-
-lemma monotone_approx (i : ℕ → β) (f : α → β) : monotone (approx i f) :=
-assume n m h, finset.sup_mono $ finset.range_subset.2 h
-
-lemma approx_comp [topological_space β] [order_closed_topology β] [measurable_space β]
-  [opens_measurable_space β] [measurable_space γ]
-  {i : ℕ → β} {f : γ → β} {g : α → γ} {n : ℕ} (a : α)
-  (hf : measurable f) (hg : measurable g) :
-  (approx i (f ∘ g) n : α →ₛ β) a = (approx i f n : γ →ₛ β) (g a) :=
-by rw [approx_apply _ hf, approx_apply _ (hf.comp hg)]
-
-end
-
-lemma supr_approx_apply [topological_space β] [complete_lattice β] [order_closed_topology β]
-  [has_zero β] [measurable_space β] [opens_measurable_space β]
-  (i : ℕ → β) (f : α → β) (a : α) (hf : measurable f) (h_zero : (0 : β) = ⊥) :
-  (⨆n, (approx i f n : α →ₛ β) a) = (⨆k (h : i k ≤ f a), i k) :=
-begin
-  refine le_antisymm (supr_le $ assume n, _) (supr_le $ assume k, supr_le $ assume hk, _),
-  { rw [approx_apply a hf, h_zero],
-    refine finset.sup_le (assume k hk, _),
-    split_ifs,
-    exact le_supr_of_le k (le_supr _ h),
-    exact bot_le },
-  { refine le_supr_of_le (k+1) _,
-    rw [approx_apply a hf],
-    have : k ∈ finset.range (k+1) := finset.mem_range.2 (nat.lt_succ_self _),
-    refine le_trans (le_of_eq _) (finset.le_sup this),
-    rw [if_pos hk] }
+  ext1 t ht,
+  classical,
+  simp only [measure.restrict_apply ht, measure.dirac_apply' _ (ht.inter hs), set.indicator_apply,
+    set.mem_inter_iff, pi.one_apply],
+  by_cases has : a ∈ s,
+  { simp only [has, and_true, if_true],
+    split_ifs with hat,
+    { rw measure.dirac_apply_of_mem hat, },
+    { simp only [measure.dirac_apply' _ ht, set.indicator_apply, hat, if_false], }, },
+  { simp only [has, and_false, if_false, measure.coe_zero, pi.zero_apply], },
 end
 
-end approx
-
-section eapprox
-
-/-- A sequence of `ℝ≥0∞`s such that its range is the set of non-negative rational numbers. -/
-def ennreal_rat_embed (n : ℕ) : ℝ≥0∞ :=
-ennreal.of_real ((encodable.decode ℚ n).get_or_else (0 : ℚ))
-
-lemma ennreal_rat_embed_encode (q : ℚ) :
-  ennreal_rat_embed (encodable.encode q) = real.to_nnreal q :=
-by rw [ennreal_rat_embed, encodable.encodek]; refl
-
-/-- Approximate a function `α → ℝ≥0∞` by a sequence of simple functions. -/
-def eapprox : (α → ℝ≥0∞) → ℕ → α →ₛ ℝ≥0∞ :=
-approx ennreal_rat_embed
-
-lemma eapprox_lt_top (f : α → ℝ≥0∞) (n : ℕ) (a : α) : eapprox f n a < ∞ :=
-begin
-  simp only [eapprox, approx, finset_sup_apply, finset.sup_lt_iff, with_top.zero_lt_top,
-    finset.mem_range, ennreal.bot_eq_zero, restrict],
-  assume b hb,
-  split_ifs,
-  { simp only [coe_zero, coe_piecewise, piecewise_eq_indicator, coe_const],
-    calc {a : α | ennreal_rat_embed b ≤ f a}.indicator (λ x, ennreal_rat_embed b) a
-        ≤ ennreal_rat_embed b : indicator_le_self _ _ a
-    ... < ⊤ : ennreal.coe_lt_top },
-  { exact with_top.zero_lt_top },
-end
-
-@[mono] lemma monotone_eapprox (f : α → ℝ≥0∞) : monotone (eapprox f) :=
-monotone_approx _ f
-
-lemma supr_eapprox_apply (f : α → ℝ≥0∞) (hf : measurable f) (a : α) :
-  (⨆n, (eapprox f n : α →ₛ ℝ≥0∞) a) = f a :=
-begin
-  rw [eapprox, supr_approx_apply ennreal_rat_embed f a hf rfl],
-  refine le_antisymm (supr_le $ assume i, supr_le $ assume hi, hi) (le_of_not_gt _),
-  assume h,
-  rcases ennreal.lt_iff_exists_rat_btwn.1 h with ⟨q, hq, lt_q, q_lt⟩,
-  have : (real.to_nnreal q : ℝ≥0∞) ≤
-      (⨆ (k : ℕ) (h : ennreal_rat_embed k ≤ f a), ennreal_rat_embed k),
-  { refine le_supr_of_le (encodable.encode q) _,
-    rw [ennreal_rat_embed_encode q],
-    refine le_supr_of_le (le_of_lt q_lt) _,
-    exact le_rfl },
-  exact lt_irrefl _ (lt_of_le_of_lt this lt_q)
-end
-
-lemma eapprox_comp [measurable_space γ] {f : γ → ℝ≥0∞} {g : α → γ} {n : ℕ}
-  (hf : measurable f) (hg : measurable g) :
-  (eapprox (f ∘ g) n : α → ℝ≥0∞) = (eapprox f n : γ →ₛ ℝ≥0∞) ∘ g :=
-funext $ assume a, approx_comp a hf hg
-
-/-- Approximate a function `α → ℝ≥0∞` by a series of simple functions taking their values
-in `ℝ≥0`. -/
-def eapprox_diff (f : α → ℝ≥0∞) : ∀ (n : ℕ), α →ₛ ℝ≥0
-| 0 := (eapprox f 0).map ennreal.to_nnreal
-| (n+1) := (eapprox f (n+1) - eapprox f n).map ennreal.to_nnreal
-
-lemma sum_eapprox_diff (f : α → ℝ≥0∞) (n : ℕ) (a : α) :
-  (∑ k in finset.range (n+1), (eapprox_diff f k a : ℝ≥0∞)) = eapprox f n a :=
-begin
-  induction n with n IH,
-  { simp only [nat.nat_zero_eq_zero, finset.sum_singleton, finset.range_one], refl },
-  { rw [finset.sum_range_succ, nat.succ_eq_add_one, IH, eapprox_diff, coe_map, function.comp_app,
-        coe_sub, pi.sub_apply, ennreal.coe_to_nnreal,
-        add_tsub_cancel_of_le (monotone_eapprox f (nat.le_succ _) _)],
-    apply (lt_of_le_of_lt _ (eapprox_lt_top f (n+1) a)).ne,
-    rw tsub_le_iff_right,
-    exact le_self_add },
-end
-
-lemma tsum_eapprox_diff (f : α → ℝ≥0∞) (hf : measurable f) (a : α) :
-  (∑' n, (eapprox_diff f n a : ℝ≥0∞)) = f a :=
-by simp_rw [ennreal.tsum_eq_supr_nat' (tendsto_add_at_top_nat 1), sum_eapprox_diff,
-  supr_eapprox_apply f hf a]
-
-end eapprox
-
-end measurable
-
-section measure
-variables {m : measurable_space α} {μ ν : measure α}
-
-/-- Integral of a simple function whose codomain is `ℝ≥0∞`. -/
-def lintegral {m : measurable_space α} (f : α →ₛ ℝ≥0∞) (μ : measure α) : ℝ≥0∞ :=
-∑ x in f.range, x * μ (f ⁻¹' {x})
-
-lemma lintegral_eq_of_subset (f : α →ₛ ℝ≥0∞) {s : finset ℝ≥0∞}
-  (hs : ∀ x, f x ≠ 0 → μ (f ⁻¹' {f x}) ≠ 0 → f x ∈ s) :
-  f.lintegral μ = ∑ x in s, x * μ (f ⁻¹' {x}) :=
-begin
-  refine finset.sum_bij_ne_zero (λr _ _, r) _ _ _ _,
-  { simpa only [forall_range_iff, mul_ne_zero_iff, and_imp] },
-  { intros, assumption },
-  { intros b _ hb,
-    refine ⟨b, _, hb, rfl⟩,
-    rw [mem_range, ← preimage_singleton_nonempty],
-    exact nonempty_of_measure_ne_zero (mul_ne_zero_iff.1 hb).2 },
-  { intros, refl }
-end
-
-lemma lintegral_eq_of_subset' (f : α →ₛ ℝ≥0∞) {s : finset ℝ≥0∞}
-  (hs : f.range \ {0} ⊆ s) :
-  f.lintegral μ = ∑ x in s, x * μ (f ⁻¹' {x}) :=
-f.lintegral_eq_of_subset $ λ x hfx _, hs $
-  finset.mem_sdiff.2 ⟨f.mem_range_self x, mt finset.mem_singleton.1 hfx⟩
-
-/-- Calculate the integral of `(g ∘ f)`, where `g : β → ℝ≥0∞` and `f : α →ₛ β`.  -/
-lemma map_lintegral (g : β → ℝ≥0∞) (f : α →ₛ β) :
-  (f.map g).lintegral μ = ∑ x in f.range, g x * μ (f ⁻¹' {x}) :=
-begin
-  simp only [lintegral, range_map],
-  refine finset.sum_image' _ (assume b hb, _),
-  rcases mem_range.1 hb with ⟨a, rfl⟩,
-  rw [map_preimage_singleton, ← f.sum_measure_preimage_singleton, finset.mul_sum],
-  refine finset.sum_congr _ _,
-  { congr },
-  { assume x, simp only [finset.mem_filter], rintro ⟨_, h⟩, rw h },
-end
-
-lemma add_lintegral (f g : α →ₛ ℝ≥0∞) : (f + g).lintegral μ = f.lintegral μ + g.lintegral μ :=
-calc (f + g).lintegral μ =
-      ∑ x in (pair f g).range, (x.1 * μ (pair f g ⁻¹' {x}) + x.2 * μ (pair f g ⁻¹' {x})) :
-    by rw [add_eq_map₂, map_lintegral]; exact finset.sum_congr rfl (assume a ha, add_mul _ _ _)
-  ... = ∑ x in (pair f g).range, x.1 * μ (pair f g ⁻¹' {x}) +
-      ∑ x in (pair f g).range, x.2 * μ (pair f g ⁻¹' {x}) : by rw [finset.sum_add_distrib]
-  ... = ((pair f g).map prod.fst).lintegral μ + ((pair f g).map prod.snd).lintegral μ :
-    by rw [map_lintegral, map_lintegral]
-  ... = lintegral f μ + lintegral g μ : rfl
-
-lemma const_mul_lintegral (f : α →ₛ ℝ≥0∞) (x : ℝ≥0∞) :
-  (const α x * f).lintegral μ = x * f.lintegral μ :=
-calc (f.map (λa, x * a)).lintegral μ = ∑ r in f.range, x * r * μ (f ⁻¹' {r}) :
-    map_lintegral _ _
-  ... = ∑ r in f.range, x * (r * μ (f ⁻¹' {r})) :
-    finset.sum_congr rfl (assume a ha, mul_assoc _ _ _)
-  ... = x * f.lintegral μ :
-    finset.mul_sum.symm
-
-/-- Integral of a simple function `α →ₛ ℝ≥0∞` as a bilinear map. -/
-def lintegralₗ {m : measurable_space α} : (α →ₛ ℝ≥0∞) →ₗ[ℝ≥0∞] measure α →ₗ[ℝ≥0∞] ℝ≥0∞ :=
-{ to_fun := λ f,
-  { to_fun := lintegral f,
-    map_add' := by simp [lintegral, mul_add, finset.sum_add_distrib],
-    map_smul' := λ c μ, by simp [lintegral, mul_left_comm _ c, finset.mul_sum] },
-  map_add' := λ f g, linear_map.ext (λ μ, add_lintegral f g),
-  map_smul' := λ c f, linear_map.ext (λ μ, const_mul_lintegral f c) }
-
-@[simp] lemma zero_lintegral : (0 : α →ₛ ℝ≥0∞).lintegral μ = 0 :=
-linear_map.ext_iff.1 lintegralₗ.map_zero μ
-
-lemma lintegral_add {ν} (f : α →ₛ ℝ≥0∞) : f.lintegral (μ + ν) = f.lintegral μ + f.lintegral ν :=
-(lintegralₗ f).map_add μ ν
-
-lemma lintegral_smul (f : α →ₛ ℝ≥0∞) (c : ℝ≥0∞) :
-  f.lintegral (c • μ) = c • f.lintegral μ :=
-(lintegralₗ f).map_smul c μ
-
-@[simp] lemma lintegral_zero [measurable_space α] (f : α →ₛ ℝ≥0∞) :
-  f.lintegral 0 = 0 :=
-(lintegralₗ f).map_zero
-
-lemma lintegral_sum {m : measurable_space α} {ι} (f : α →ₛ ℝ≥0∞) (μ : ι → measure α) :
-  f.lintegral (measure.sum μ) = ∑' i, f.lintegral (μ i) :=
-begin
-  simp only [lintegral, measure.sum_apply, f.measurable_set_preimage, ← finset.tsum_subtype,
-    ← ennreal.tsum_mul_left],
-  apply ennreal.tsum_comm
-end
-
-lemma restrict_lintegral (f : α →ₛ ℝ≥0∞) {s : set α} (hs : measurable_set s) :
-  (restrict f s).lintegral μ = ∑ r in f.range, r * μ (f ⁻¹' {r} ∩ s) :=
-calc (restrict f s).lintegral μ = ∑ r in f.range, r * μ (restrict f s ⁻¹' {r}) :
-  lintegral_eq_of_subset _ $ λ x hx, if hxs : x ∈ s
-    then λ _, by simp only [f.restrict_apply hs, indicator_of_mem hxs, mem_range_self]
-    else false.elim $ hx $ by simp [*]
-... = ∑ r in f.range, r * μ (f ⁻¹' {r} ∩ s) :
-  finset.sum_congr rfl $ forall_range_iff.2 $ λ b, if hb : f b = 0 then by simp only [hb, zero_mul]
-    else by rw [restrict_preimage_singleton _ hs hb, inter_comm]
-
-lemma lintegral_restrict {m : measurable_space α} (f : α →ₛ ℝ≥0∞) (s : set α) (μ : measure α) :
-  f.lintegral (μ.restrict s) = ∑ y in f.range, y * μ (f ⁻¹' {y} ∩ s) :=
-by simp only [lintegral, measure.restrict_apply, f.measurable_set_preimage]
-
-lemma restrict_lintegral_eq_lintegral_restrict (f : α →ₛ ℝ≥0∞) {s : set α}
-  (hs : measurable_set s) :
-  (restrict f s).lintegral μ = f.lintegral (μ.restrict s) :=
-by rw [f.restrict_lintegral hs, lintegral_restrict]
-
-lemma const_lintegral (c : ℝ≥0∞) : (const α c).lintegral μ = c * μ univ :=
-begin
-  rw [lintegral],
-  casesI is_empty_or_nonempty α,
-  { simp [μ.eq_zero_of_is_empty] },
-  { simp [preimage_const_of_mem] },
-end
-
-lemma const_lintegral_restrict (c : ℝ≥0∞) (s : set α) :
-  (const α c).lintegral (μ.restrict s) = c * μ s :=
-by rw [const_lintegral, measure.restrict_apply measurable_set.univ, univ_inter]
-
-lemma restrict_const_lintegral (c : ℝ≥0∞) {s : set α} (hs : measurable_set s) :
-  ((const α c).restrict s).lintegral μ = c * μ s :=
-by rw [restrict_lintegral_eq_lintegral_restrict _ hs, const_lintegral_restrict]
-
-lemma le_sup_lintegral (f g : α →ₛ ℝ≥0∞) : f.lintegral μ ⊔ g.lintegral μ ≤ (f ⊔ g).lintegral μ :=
-calc f.lintegral μ ⊔ g.lintegral μ =
-      ((pair f g).map prod.fst).lintegral μ ⊔ ((pair f g).map prod.snd).lintegral μ : rfl
-  ... ≤ ∑ x in (pair f g).range, (x.1 ⊔ x.2) * μ (pair f g ⁻¹' {x}) :
-  begin
-    rw [map_lintegral, map_lintegral],
-    refine sup_le _ _;
-      refine finset.sum_le_sum (λ a _, mul_le_mul_right' _ _),
-    exact le_sup_left,
-    exact le_sup_right
-  end
-  ... = (f ⊔ g).lintegral μ : by rw [sup_eq_map₂, map_lintegral]
-
-/-- `simple_func.lintegral` is monotone both in function and in measure. -/
-@[mono] lemma lintegral_mono {f g : α →ₛ ℝ≥0∞} (hfg : f ≤ g) (hμν : μ ≤ ν) :
-  f.lintegral μ ≤ g.lintegral ν :=
-calc f.lintegral μ ≤ f.lintegral μ ⊔ g.lintegral μ : le_sup_left
-  ... ≤ (f ⊔ g).lintegral μ : le_sup_lintegral _ _
-  ... = g.lintegral μ : by rw [sup_of_le_right hfg]
-  ... ≤ g.lintegral ν : finset.sum_le_sum $ λ y hy, ennreal.mul_left_mono $
-                          hμν _ (g.measurable_set_preimage _)
-
-/-- `simple_func.lintegral` depends only on the measures of `f ⁻¹' {y}`. -/
-lemma lintegral_eq_of_measure_preimage [measurable_space β] {f : α →ₛ ℝ≥0∞} {g : β →ₛ ℝ≥0∞}
-  {ν : measure β} (H : ∀ y, μ (f ⁻¹' {y}) = ν (g ⁻¹' {y})) :
-  f.lintegral μ = g.lintegral ν :=
+-- todo after the port: move to measure_theory/measure/measure_space
+lemma restrict_dirac [measurable_singleton_class α] [decidable (a ∈ s)] :
+  (measure.dirac a).restrict s = if a ∈ s then measure.dirac a else 0 :=
 begin
-  simp only [lintegral, ← H],
-  apply lintegral_eq_of_subset,
-  simp only [H],
-  intros,
-  exact mem_range_of_measure_ne_zero ‹_›
+  ext1 t ht,
+  classical,
+  simp only [measure.restrict_apply ht, measure.dirac_apply _, set.indicator_apply,
+    set.mem_inter_iff, pi.one_apply],
+  by_cases has : a ∈ s,
+  { simp only [has, and_true, if_true],
+    split_ifs with hat,
+    { rw measure.dirac_apply_of_mem hat, },
+    { simp only [measure.dirac_apply' _ ht, set.indicator_apply, hat, if_false], }, },
+  { simp only [has, and_false, if_false, measure.coe_zero, pi.zero_apply], },
 end
 
-/-- If two simple functions are equal a.e., then their `lintegral`s are equal. -/
-lemma lintegral_congr {f g : α →ₛ ℝ≥0∞} (h : f =ᵐ[μ] g) :
-  f.lintegral μ = g.lintegral μ :=
-lintegral_eq_of_measure_preimage $ λ y, measure_congr $
-  eventually.set_eq $ h.mono $ λ x hx, by simp [hx]
-
-lemma lintegral_map' {β} [measurable_space β] {μ' : measure β} (f : α →ₛ ℝ≥0∞) (g : β →ₛ ℝ≥0∞)
-  (m' : α → β) (eq : ∀ a, f a = g (m' a)) (h : ∀s, measurable_set s → μ' s = μ (m' ⁻¹' s)) :
-  f.lintegral μ = g.lintegral μ' :=
-lintegral_eq_of_measure_preimage $ λ y,
-by { simp only [preimage, eq], exact (h (g ⁻¹' {y}) (g.measurable_set_preimage _)).symm }
-
-lemma lintegral_map {β} [measurable_space β] (g : β →ₛ ℝ≥0∞) {f : α → β} (hf : measurable f) :
-  g.lintegral (measure.map f μ) = (g.comp f hf).lintegral μ :=
-eq.symm $ lintegral_map' _ _ f (λ a, rfl) (λ s hs, measure.map_apply hf hs)
-
-end measure
-
-section fin_meas_supp
-
-open finset function
-
-lemma support_eq [measurable_space α] [has_zero β] (f : α →ₛ β) :
-  support f = ⋃ y ∈ f.range.filter (λ y, y ≠ 0), f ⁻¹' {y} :=
-set.ext $ λ x, by simp only [mem_support, set.mem_preimage, mem_filter, mem_range_self, true_and,
-  exists_prop, mem_Union, set.mem_range, mem_singleton_iff, exists_eq_right']
-
-variables {m : measurable_space α} [has_zero β] [has_zero γ] {μ : measure α} {f : α →ₛ β}
+end move_this
 
-lemma measurable_set_support [measurable_space α] (f : α →ₛ β) : measurable_set (support f) :=
-by { rw f.support_eq, exact finset.measurable_set_bUnion _ (λ y hy, measurable_set_fiber _ _), }
-
-/-- A `simple_func` has finite measure support if it is equal to `0` outside of a set of finite
-measure. -/
-protected def fin_meas_supp {m : measurable_space α} (f : α →ₛ β) (μ : measure α) : Prop :=
-f =ᶠ[μ.cofinite] 0
-
-lemma fin_meas_supp_iff_support : f.fin_meas_supp μ ↔ μ (support f) < ∞ := iff.rfl
+local infixr ` →ₛ `:25 := simple_func
 
-lemma fin_meas_supp_iff : f.fin_meas_supp μ ↔ ∀ y ≠ 0, μ (f ⁻¹' {y}) < ∞ :=
-begin
-  split,
-  { refine λ h y hy, lt_of_le_of_lt (measure_mono _) h,
-    exact λ x hx (H : f x = 0), hy $ H ▸ eq.symm hx },
-  { intro H,
-    rw [fin_meas_supp_iff_support, support_eq],
-    refine lt_of_le_of_lt (measure_bUnion_finset_le _ _) (sum_lt_top _),
-    exact λ y hy, (H y (finset.mem_filter.1 hy).2).ne }
-end
-
-namespace fin_meas_supp
-
-lemma meas_preimage_singleton_ne_zero (h : f.fin_meas_supp μ) {y : β} (hy : y ≠ 0) :
-  μ (f ⁻¹' {y}) < ∞ :=
-fin_meas_supp_iff.1 h y hy
-
-protected lemma map {g : β → γ} (hf : f.fin_meas_supp μ) (hg : g 0 = 0) :
-  (f.map g).fin_meas_supp μ :=
-flip lt_of_le_of_lt hf (measure_mono $ support_comp_subset hg f)
-
-lemma of_map {g : β → γ} (h : (f.map g).fin_meas_supp μ) (hg : ∀b, g b = 0 → b = 0) :
-  f.fin_meas_supp μ :=
-flip lt_of_le_of_lt h $ measure_mono $ support_subset_comp hg _
-
-lemma map_iff {g : β → γ} (hg : ∀ {b}, g b = 0 ↔ b = 0) :
-  (f.map g).fin_meas_supp μ ↔ f.fin_meas_supp μ :=
-⟨λ h, h.of_map $ λ b, hg.1, λ h, h.map $ hg.2 rfl⟩
-
-protected lemma pair {g : α →ₛ γ} (hf : f.fin_meas_supp μ) (hg : g.fin_meas_supp μ) :
-  (pair f g).fin_meas_supp μ :=
-calc μ (support $ pair f g) = μ (support f ∪ support g) : congr_arg μ $ support_prod_mk f g
-... ≤ μ (support f) + μ (support g) : measure_union_le _ _
-... < _ : add_lt_top.2 ⟨hf, hg⟩
-
-protected lemma map₂ [has_zero δ] (hf : f.fin_meas_supp μ)
-  {g : α →ₛ γ} (hg : g.fin_meas_supp μ) {op : β → γ → δ} (H : op 0 0 = 0) :
-  ((pair f g).map (function.uncurry op)).fin_meas_supp μ :=
-(hf.pair hg).map H
-
-protected lemma add {β} [add_monoid β] {f g : α →ₛ β} (hf : f.fin_meas_supp μ)
-  (hg : g.fin_meas_supp μ) :
-  (f + g).fin_meas_supp μ :=
-by { rw [add_eq_map₂], exact hf.map₂ hg (zero_add 0) }
-
-protected lemma mul {β} [monoid_with_zero β] {f g : α →ₛ β} (hf : f.fin_meas_supp μ)
-  (hg : g.fin_meas_supp μ) :
-  (f * g).fin_meas_supp μ :=
-by { rw [mul_eq_map₂], exact hf.map₂ hg (zero_mul 0) }
-
-lemma lintegral_lt_top {f : α →ₛ ℝ≥0∞} (hm : f.fin_meas_supp μ) (hf : ∀ᵐ a ∂μ, f a ≠ ∞) :
-  f.lintegral μ < ∞ :=
-begin
-  refine sum_lt_top (λ a ha, _),
-  rcases eq_or_ne a ∞ with rfl|ha,
-  { simp only [ae_iff, ne.def, not_not] at hf,
-    simp [set.preimage, hf] },
-  { by_cases ha0 : a = 0,
-    { subst a, rwa [zero_mul] },
-    { exact mul_ne_top ha (fin_meas_supp_iff.1 hm _ ha0).ne } }
-end
-
-lemma of_lintegral_ne_top {f : α →ₛ ℝ≥0∞} (h : f.lintegral μ ≠ ∞) : f.fin_meas_supp μ :=
-begin
-  refine fin_meas_supp_iff.2 (λ b hb, _),
-  rw [f.lintegral_eq_of_subset' (finset.subset_insert b _)] at h,
-  refine ennreal.lt_top_of_mul_ne_top_right _ hb,
-  exact (lt_top_of_sum_ne_top h (finset.mem_insert_self _ _)).ne
-end
-
-lemma iff_lintegral_lt_top {f : α →ₛ ℝ≥0∞} (hf : ∀ᵐ a ∂μ, f a ≠ ∞) :
-  f.fin_meas_supp μ ↔ f.lintegral μ < ∞ :=
-⟨λ h, h.lintegral_lt_top hf, λ h, of_lintegral_ne_top h.ne⟩
-
-end fin_meas_supp
-
-end fin_meas_supp
-
-/-- To prove something for an arbitrary simple function, it suffices to show
-that the property holds for (multiples of) characteristic functions and is closed under
-addition (of functions with disjoint support).
-
-It is possible to make the hypotheses in `h_add` a bit stronger, and such conditions can be added
-once we need them (for example it is only necessary to consider the case where `g` is a multiple
-of a characteristic function, and that this multiple doesn't appear in the image of `f`) -/
-@[elab_as_eliminator]
-protected lemma induction {α γ} [measurable_space α] [add_monoid γ] {P : simple_func α γ → Prop}
-  (h_ind : ∀ c {s} (hs : measurable_set s),
-    P (simple_func.piecewise s hs (simple_func.const _ c) (simple_func.const _ 0)))
-  (h_add : ∀ ⦃f g : simple_func α γ⦄, disjoint (support f) (support g) → P f → P g → P (f + g))
-  (f : simple_func α γ) : P f :=
-begin
-  generalize' h : f.range \ {0} = s,
-  rw [← finset.coe_inj, finset.coe_sdiff, finset.coe_singleton, simple_func.coe_range] at h,
-  revert s f h, refine finset.induction _ _,
-  { intros f hf, rw [finset.coe_empty, diff_eq_empty, range_subset_singleton] at hf,
-    convert h_ind 0 measurable_set.univ, ext x, simp [hf] },
-  { intros x s hxs ih f hf,
-    have mx := f.measurable_set_preimage {x},
-    let g := simple_func.piecewise (f ⁻¹' {x}) mx 0 f,
-    have Pg : P g,
-    { apply ih, simp only [g, simple_func.coe_piecewise, range_piecewise],
-      rw [image_compl_preimage, union_diff_distrib, diff_diff_comm, hf, finset.coe_insert,
-        insert_diff_self_of_not_mem, diff_eq_empty.mpr, set.empty_union],
-      { rw [set.image_subset_iff], convert set.subset_univ _,
-        exact preimage_const_of_mem (mem_singleton _) },
-      { rwa [finset.mem_coe] }},
-    convert h_add _ Pg (h_ind x mx),
-    { ext1 y, by_cases hy : y ∈ f ⁻¹' {x}; [simpa [hy], simp [hy]] },
-    rintro y, by_cases hy : y ∈ f ⁻¹' {x}; simp [hy] }
-end
-
-end simple_func
+variables {α β γ δ : Type*}
 
 section lintegral
+
 open simple_func
-variables {m : measurable_space α} {μ ν : measure α}
+
+variables {m : measurable_space α} {μ ν : measure α} {f : α → ℝ≥0∞} {s : set α}
 
 /-- The **lower Lebesgue integral** of a function `f` with respect to a measure `μ`. -/
 @[irreducible] def lintegral {m : measurable_space α} (μ : measure α) (f : α → ℝ≥0∞) : ℝ≥0∞ :=
 ⨆ (g : α →ₛ ℝ≥0∞) (hf : ⇑g ≤ f), g.lintegral μ
 
-/-! In the notation for integrals, an expression like `∫⁻ x, g ∥x∥ ∂μ` will not be parsed correctly,
+/-! In the notation for integrals, an expression like `∫⁻ x, g ‖x‖ ∂μ` will not be parsed correctly,
   and needs parentheses. We do not set the binding power of `r` to `0`, because then
   `∫⁻ x, f x = 0` will be parsed incorrectly. -/
 notation `∫⁻` binders `, ` r:(scoped:60 f, f) ` ∂` μ:70 := lintegral μ r
@@ -1032,12 +122,7 @@ lintegral_mono' (le_refl μ) hfg
 
 lemma lintegral_mono_nnreal {f g : α → ℝ≥0} (h : f ≤ g) :
   ∫⁻ a, f a ∂μ ≤ ∫⁻ a, g a ∂μ :=
-begin
-  refine lintegral_mono _,
-  intro a,
-  rw ennreal.coe_le_coe,
-  exact h a,
-end
+lintegral_mono $ λ a, ennreal.coe_le_coe.2 (h a)
 
 lemma supr_lintegral_measurable_le_eq_lintegral (f : α → ℝ≥0∞) :
   (⨆ (g : α → ℝ≥0∞) (g_meas : measurable g) (hg : g ≤ f), ∫⁻ a, g a ∂μ) = ∫⁻ a, f a ∂μ :=
@@ -1065,6 +150,10 @@ lintegral_mono
 @[simp] lemma lintegral_const (c : ℝ≥0∞) : ∫⁻ a, c ∂μ = c * μ univ :=
 by rw [← simple_func.const_lintegral, ← simple_func.lintegral_eq_lintegral, simple_func.coe_const]
 
+lemma lintegral_zero : ∫⁻ a:α, 0 ∂μ = 0 := by simp
+
+lemma lintegral_zero_fun : lintegral μ (0 : α → ℝ≥0∞) = 0 := lintegral_zero
+
 @[simp] lemma lintegral_one : ∫⁻ a, (1 : ℝ≥0∞) ∂μ = μ univ :=
 by rw [lintegral_const, one_mul]
 
@@ -1074,6 +163,42 @@ by rw [lintegral_const, measure.restrict_apply_univ]
 lemma set_lintegral_one (s) : ∫⁻ a in s, 1 ∂μ = μ s :=
 by rw [set_lintegral_const, one_mul]
 
+lemma set_lintegral_const_lt_top [is_finite_measure μ] (s : set α) {c : ℝ≥0∞} (hc : c ≠ ∞) :
+  ∫⁻ a in s, c ∂μ < ∞ :=
+begin
+  rw lintegral_const,
+  exact ennreal.mul_lt_top hc (measure_ne_top (μ.restrict s) univ),
+end
+
+lemma lintegral_const_lt_top [is_finite_measure μ] {c : ℝ≥0∞} (hc : c ≠ ∞) :
+  ∫⁻ a, c ∂μ < ∞ :=
+by simpa only [measure.restrict_univ] using set_lintegral_const_lt_top univ hc
+
+section
+
+variable (μ)
+
+/-- For any function `f : α → ℝ≥0∞`, there exists a measurable function `g ≤ f` with the same
+integral. -/
+lemma exists_measurable_le_lintegral_eq (f : α → ℝ≥0∞) :
+  ∃ g : α → ℝ≥0∞, measurable g ∧ g ≤ f ∧ ∫⁻ a, f a ∂μ = ∫⁻ a, g a ∂μ :=
+begin
+  cases eq_or_ne (∫⁻ a, f a ∂μ) 0 with h₀ h₀,
+  { exact ⟨0, measurable_zero, zero_le f, h₀.trans lintegral_zero.symm⟩ },
+  rcases exists_seq_strict_mono_tendsto' h₀.bot_lt with ⟨L, hL_mono, hLf, hL_tendsto⟩,
+  have : ∀ n, ∃ g : α → ℝ≥0∞, measurable g ∧ g ≤ f ∧ L n < ∫⁻ a, g a ∂μ,
+  { intro n,
+    simpa only [← supr_lintegral_measurable_le_eq_lintegral f, lt_supr_iff, exists_prop]
+      using (hLf n).2 },
+  choose g hgm hgf hLg,
+  refine ⟨λ x, ⨆ n, g n x, measurable_supr hgm, λ x, supr_le (λ n, hgf n x), le_antisymm _ _⟩,
+  { refine le_of_tendsto' hL_tendsto (λ n, (hLg n).le.trans $ lintegral_mono $ λ x, _),
+    exact le_supr (λ n, g n x) n },
+  { exact lintegral_mono (λ x, supr_le $ λ n, hgf n x) }
+end
+
+end
+
 /-- `∫⁻ a in s, f a ∂μ` is defined as the supremum of integrals of simple functions
 `φ : α →ₛ ℝ≥0∞` such that `φ ≤ f`. This lemma says that it suffices to take
 functions `φ : α →ₛ ℝ≥0`. -/
@@ -1111,7 +236,7 @@ lemma exists_simple_func_forall_lintegral_sub_lt_of_pos {f : α → ℝ≥0∞}
 begin
   rw lintegral_eq_nnreal at h,
   have := ennreal.lt_add_right h hε,
-  erw ennreal.bsupr_add at this; [skip, exact ⟨0, λ x, by simp⟩],
+  erw ennreal.bsupr_add at this; [skip, exact ⟨0, λ x, zero_le _⟩],
   simp_rw [lt_supr_iff, supr_lt_iff, supr_le_iff] at this,
   rcases this with ⟨φ, hle : ∀ x, ↑(φ x) ≤ f x, b, hbφ, hb⟩,
   refine ⟨φ, hle, λ ψ hψ, _⟩,
@@ -1185,6 +310,27 @@ lemma set_lintegral_congr_fun {f g : α → ℝ≥0∞} {s : set α} (hs : measu
   ∫⁻ x in s, f x ∂μ = ∫⁻ x in s, g x ∂μ :=
 by { rw lintegral_congr_ae, rw eventually_eq, rwa ae_restrict_iff' hs, }
 
+lemma lintegral_of_real_le_lintegral_nnnorm (f : α → ℝ) :
+  ∫⁻ x, ennreal.of_real (f x) ∂μ ≤ ∫⁻ x, ‖f x‖₊ ∂μ :=
+begin
+  simp_rw ← of_real_norm_eq_coe_nnnorm,
+  refine lintegral_mono (λ x, ennreal.of_real_le_of_real _),
+  rw real.norm_eq_abs,
+  exact le_abs_self (f x),
+end
+
+lemma lintegral_nnnorm_eq_of_ae_nonneg {f : α → ℝ} (h_nonneg : 0 ≤ᵐ[μ] f) :
+  ∫⁻ x, ‖f x‖₊ ∂μ = ∫⁻ x, ennreal.of_real (f x) ∂μ :=
+begin
+  apply lintegral_congr_ae,
+  filter_upwards [h_nonneg] with x hx,
+  rw [real.nnnorm_of_nonneg hx, ennreal.of_real_eq_coe_nnreal hx],
+end
+
+lemma lintegral_nnnorm_eq_of_nonneg {f : α → ℝ} (h_nonneg : 0 ≤ f) :
+  ∫⁻ x, ‖f x‖₊ ∂μ = ∫⁻ x, ennreal.of_real (f x) ∂μ :=
+lintegral_nnnorm_eq_of_ae_nonneg (filter.eventually_of_forall h_nonneg)
+
 /-- Monotone convergence theorem -- sometimes called Beppo-Levi convergence.
 
 See `lintegral_supr_directed` for a more general form. -/
@@ -1342,7 +488,7 @@ begin
   ... = C * μ s + ε₁ : by simp only [←simple_func.lintegral_eq_lintegral, coe_const,
     lintegral_const, measure.restrict_apply, measurable_set.univ, univ_inter]
   ... ≤ C * ((ε₂ - ε₁) / C) + ε₁ :
-    add_le_add_right (ennreal.mul_le_mul le_rfl hs.le) _
+    add_le_add_right (mul_le_mul_left' hs.le _) _
   ... ≤ (ε₂ - ε₁) + ε₁ : add_le_add mul_div_le le_rfl
   ... = ε₂ : tsub_add_cancel_of_le hε₁₂.le,
 end
@@ -1360,8 +506,18 @@ begin
   exact (hl δ δ0).mono (λ i, hδ _)
 end
 
-@[simp] lemma lintegral_add {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g) :
-  (∫⁻ a, f a + g a ∂μ) = (∫⁻ a, f a ∂μ) + (∫⁻ a, g a ∂μ) :=
+/-- The sum of the lower Lebesgue integrals of two functions is less than or equal to the integral
+of their sum. The other inequality needs one of these functions to be (a.e.-)measurable. -/
+lemma le_lintegral_add (f g : α → ℝ≥0∞) : ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ ≤ ∫⁻ a, f a + g a ∂μ :=
+begin
+  dunfold lintegral,
+  refine ennreal.bsupr_add_bsupr_le' ⟨0, zero_le f⟩  ⟨0, zero_le g⟩ (λ f' hf' g' hg', _),
+  exact le_supr₂_of_le (f' + g') (add_le_add hf' hg') (add_lintegral _ _).ge
+end
+
+-- Use stronger lemmas `lintegral_add_left`/`lintegral_add_right` instead
+lemma lintegral_add_aux {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g) :
+  ∫⁻ a, f a + g a ∂μ = ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ :=
 calc (∫⁻ a, f a + g a ∂μ) =
     (∫⁻ a, (⨆n, (eapprox f n : α → ℝ≥0∞) a) + (⨆n, (eapprox g n : α → ℝ≥0∞) a) ∂μ) :
     by simp only [supr_eapprox_apply, hf, hg]
@@ -1387,20 +543,36 @@ calc (∫⁻ a, f a + g a ∂μ) =
   ... = (∫⁻ a, f a ∂μ) + (∫⁻ a, g a ∂μ) :
     by rw [lintegral_eq_supr_eapprox_lintegral hf, lintegral_eq_supr_eapprox_lintegral hg]
 
-lemma lintegral_add' {f g : α → ℝ≥0∞} (hf : ae_measurable f μ) (hg : ae_measurable g μ) :
-  (∫⁻ a, f a + g a ∂μ) = (∫⁻ a, f a ∂μ) + (∫⁻ a, g a ∂μ) :=
-calc (∫⁻ a, f a + g a ∂μ) = (∫⁻ a, hf.mk f a + hg.mk g a ∂μ) :
-  lintegral_congr_ae (eventually_eq.add hf.ae_eq_mk hg.ae_eq_mk)
-... = (∫⁻ a, hf.mk f a ∂μ) + (∫⁻ a, hg.mk g a ∂μ) : lintegral_add hf.measurable_mk hg.measurable_mk
-... = (∫⁻ a, f a ∂μ) + (∫⁻ a, g a ∂μ) : begin
-  congr' 1,
-  { exact lintegral_congr_ae hf.ae_eq_mk.symm },
-  { exact lintegral_congr_ae hg.ae_eq_mk.symm },
-end
-
-lemma lintegral_zero : (∫⁻ a:α, 0 ∂μ) = 0 := by simp
-
-lemma lintegral_zero_fun : (∫⁻ a:α, (0 : α → ℝ≥0∞) a ∂μ) = 0 := by simp
+/-- If `f g : α → ℝ≥0∞` are two functions and one of them is (a.e.) measurable, then the Lebesgue
+integral of `f + g` equals the sum of integrals. This lemma assumes that `f` is integrable, see also
+`measure_theory.lintegral_add_right` and primed versions of these lemmas. -/
+@[simp] lemma lintegral_add_left {f : α → ℝ≥0∞} (hf : measurable f) (g : α → ℝ≥0∞) :
+  ∫⁻ a, f a + g a ∂μ = ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ :=
+begin
+  refine le_antisymm _ (le_lintegral_add _ _),
+  rcases exists_measurable_le_lintegral_eq μ (λ a, f a + g a) with ⟨φ, hφm, hφ_le, hφ_eq⟩,
+  calc ∫⁻ a, f a + g a ∂μ = ∫⁻ a, φ a ∂μ : hφ_eq
+  ... ≤ ∫⁻ a, f a + (φ a - f a) ∂μ        : lintegral_mono (λ a, le_add_tsub)
+  ... = ∫⁻ a, f a ∂μ + ∫⁻ a, φ a - f a ∂μ : lintegral_add_aux hf (hφm.sub hf)
+  ... ≤ ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ       :
+    add_le_add_left (lintegral_mono $ λ a, tsub_le_iff_left.2 $ hφ_le a) _
+end
+
+lemma lintegral_add_left' {f : α → ℝ≥0∞} (hf : ae_measurable f μ) (g : α → ℝ≥0∞) :
+  ∫⁻ a, f a + g a ∂μ = ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ :=
+by rw [lintegral_congr_ae hf.ae_eq_mk, ← lintegral_add_left hf.measurable_mk,
+  lintegral_congr_ae (hf.ae_eq_mk.add (ae_eq_refl g))]
+
+lemma lintegral_add_right' (f : α → ℝ≥0∞) {g : α → ℝ≥0∞} (hg : ae_measurable g μ) :
+  ∫⁻ a, f a + g a ∂μ = ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ :=
+by simpa only [add_comm] using lintegral_add_left' hg f
+
+/-- If `f g : α → ℝ≥0∞` are two functions and one of them is (a.e.) measurable, then the Lebesgue
+integral of `f + g` equals the sum of integrals. This lemma assumes that `g` is integrable, see also
+`measure_theory.lintegral_add_left` and primed versions of these lemmas. -/
+@[simp] lemma lintegral_add_right (f : α → ℝ≥0∞) {g : α → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ a, f a + g a ∂μ = ∫⁻ a, f a ∂μ + ∫⁻ a, g a ∂μ :=
+lintegral_add_right' f hg.ae_measurable
 
 @[simp] lemma lintegral_smul_measure (c : ℝ≥0∞) (f : α → ℝ≥0∞) :
   ∫⁻ a, f a ∂ (c • μ) = c * ∫⁻ a, f a ∂μ :=
@@ -1452,16 +624,21 @@ begin
   exact measure.restrict_eq_zero.2 hs',
 end
 
-lemma lintegral_finset_sum (s : finset β) {f : β → α → ℝ≥0∞} (hf : ∀ b ∈ s, measurable (f b)) :
+lemma lintegral_finset_sum' (s : finset β) {f : β → α → ℝ≥0∞}
+  (hf : ∀ b ∈ s, ae_measurable (f b) μ) :
   (∫⁻ a, ∑ b in s, f b a ∂μ) = ∑ b in s, ∫⁻ a, f b a ∂μ :=
 begin
   induction s using finset.induction_on with a s has ih,
   { simp },
   { simp only [finset.sum_insert has],
     rw [finset.forall_mem_insert] at hf,
-    rw [lintegral_add hf.1 (s.measurable_sum hf.2), ih hf.2] }
+    rw [lintegral_add_left' hf.1, ih hf.2] }
 end
 
+lemma lintegral_finset_sum (s : finset β) {f : β → α → ℝ≥0∞} (hf : ∀ b ∈ s, measurable (f b)) :
+  (∫⁻ a, ∑ b in s, f b a ∂μ) = ∑ b in s, ∫⁻ a, f b a ∂μ :=
+lintegral_finset_sum' s (λ b hb, (hf b hb).ae_measurable)
+
 @[simp] lemma lintegral_const_mul (r : ℝ≥0∞) {f : α → ℝ≥0∞} (hf : measurable f) :
   (∫⁻ a, r * f a ∂μ) = r * (∫⁻ a, f a ∂μ) :=
 calc (∫⁻ a, r * f a ∂μ) = (∫⁻ a, (⨆n, (const α r * eapprox f n) a) ∂μ) :
@@ -1491,7 +668,7 @@ begin
   rw [lintegral, ennreal.mul_supr],
   refine supr_le (λs, _),
   rw [ennreal.mul_supr],
-  simp only [supr_le_iff, ge_iff_le],
+  simp only [supr_le_iff],
   assume hs,
   rw [← simple_func.const_mul_lintegral, lintegral],
   refine le_supr_of_le (const α r * s) (le_supr_of_le (λx, _) le_rfl),
@@ -1561,6 +738,16 @@ begin
     simp [hφ x, hs, indicator_le_indicator] }
 end
 
+lemma lintegral_indicator₀ (f : α → ℝ≥0∞) {s : set α} (hs : null_measurable_set s μ) :
+  ∫⁻ a, s.indicator f a ∂μ = ∫⁻ a in s, f a ∂μ :=
+by rw [← lintegral_congr_ae (indicator_ae_eq_of_ae_eq_set hs.to_measurable_ae_eq),
+  lintegral_indicator _ (measurable_set_to_measurable _ _),
+  measure.restrict_congr_set hs.to_measurable_ae_eq]
+
+lemma lintegral_indicator_const {s : set α} (hs : measurable_set s) (c : ℝ≥0∞) :
+  ∫⁻ a, s.indicator (λ _, c) a ∂μ = c * μ s :=
+by rw [lintegral_indicator _ hs, set_lintegral_const]
+
 lemma set_lintegral_eq_const {f : α → ℝ≥0∞} (hf : measurable f) (r : ℝ≥0∞) :
   ∫⁻ x in {x | f x = r}, f x ∂μ = r * μ {x | f x = r} :=
 begin
@@ -1571,38 +758,62 @@ begin
   exact hf (measurable_set_singleton r)
 end
 
-/-- **Markov's inequality** also known as **Chebyshev's first inequality**. For a version assuming
-`ae_measurable`, see `mul_meas_ge_le_lintegral₀`. -/
-lemma mul_meas_ge_le_lintegral {f : α → ℝ≥0∞} (hf : measurable f) (ε : ℝ≥0∞) :
-  ε * μ {x | ε ≤ f x} ≤ ∫⁻ a, f a ∂μ :=
+@[simp] lemma lintegral_indicator_one (hs : measurable_set s) : ∫⁻ a, s.indicator 1 a ∂μ = μ s :=
+(lintegral_indicator_const hs _).trans $ one_mul _
+
+/-- A version of **Markov's inequality** for two functions. It doesn't follow from the standard
+Markov's inequality because we only assume measurability of `g`, not `f`. -/
+lemma lintegral_add_mul_meas_add_le_le_lintegral {f g : α → ℝ≥0∞} (hle : f ≤ᵐ[μ] g)
+  (hg : ae_measurable g μ) (ε : ℝ≥0∞) :
+  ∫⁻ a, f a ∂μ + ε * μ {x | f x + ε ≤ g x} ≤ ∫⁻ a, g a ∂μ :=
 begin
-  have : measurable_set {a : α | ε ≤ f a }, from hf measurable_set_Ici,
-  rw [← simple_func.restrict_const_lintegral _ this, ← simple_func.lintegral_eq_lintegral],
-  refine lintegral_mono (λ a, _),
-  simp only [restrict_apply _ this],
-  exact indicator_apply_le id
+  rcases exists_measurable_le_lintegral_eq μ f with ⟨φ, hφm, hφ_le, hφ_eq⟩,
+  calc ∫⁻ x, f x ∂μ + ε * μ {x | f x + ε ≤ g x} = ∫⁻ x, φ x ∂μ + ε * μ {x | f x + ε ≤ g x} :
+    by rw [hφ_eq]
+  ... ≤ ∫⁻ x, φ x ∂μ + ε * μ {x | φ x + ε ≤ g x} :
+    add_le_add_left (mul_le_mul_left'
+      (measure_mono $ λ x, (add_le_add_right (hφ_le _) _).trans) _) _
+  ... = ∫⁻ x, φ x + indicator {x | φ x + ε ≤ g x} (λ _, ε) x ∂μ :
+    begin
+      rw [lintegral_add_left hφm, lintegral_indicator₀, set_lintegral_const],
+      exact measurable_set_le (hφm.null_measurable.measurable'.add_const _) hg.null_measurable
+    end
+  ... ≤ ∫⁻ x, g x ∂μ : lintegral_mono_ae (hle.mono $ λ x hx₁, _),
+  simp only [indicator_apply], split_ifs with hx₂,
+  exacts [hx₂, (add_zero _).trans_le $ (hφ_le x).trans hx₁]
 end
 
 /-- **Markov's inequality** also known as **Chebyshev's first inequality**. -/
 lemma mul_meas_ge_le_lintegral₀ {f : α → ℝ≥0∞} (hf : ae_measurable f μ) (ε : ℝ≥0∞) :
   ε * μ {x | ε ≤ f x} ≤ ∫⁻ a, f a ∂μ :=
-begin
-  have A : μ {x | ε ≤ f x} = μ {x | ε ≤ hf.mk f x},
-  { apply eventually_eq.measure_eq,
-    filter_upwards [hf.ae_eq_mk] with x hx,
-    change (ε ≤ f x) = (ε ≤ hf.mk f x),
-    simp [hx] },
-  have B : ∫⁻ a, f a ∂μ = ∫⁻ a, hf.mk f a ∂μ := lintegral_congr_ae hf.ae_eq_mk,
-  rw [A, B],
-  exact mul_meas_ge_le_lintegral hf.measurable_mk ε,
-end
+by simpa only [lintegral_zero, zero_add]
+  using lintegral_add_mul_meas_add_le_le_lintegral (ae_of_all _ $ λ x, zero_le (f x)) hf ε
+
+/-- **Markov's inequality** also known as **Chebyshev's first inequality**. For a version assuming
+`ae_measurable`, see `mul_meas_ge_le_lintegral₀`. -/
+lemma mul_meas_ge_le_lintegral {f : α → ℝ≥0∞} (hf : measurable f) (ε : ℝ≥0∞) :
+  ε * μ {x | ε ≤ f x} ≤ ∫⁻ a, f a ∂μ :=
+mul_meas_ge_le_lintegral₀ hf.ae_measurable ε
 
-lemma lintegral_eq_top_of_measure_eq_top_pos {f : α → ℝ≥0∞} (hf : ae_measurable f μ)
-  (hμf : 0 < μ {x | f x = ∞}) : ∫⁻ x, f x ∂μ = ∞ :=
+lemma lintegral_eq_top_of_measure_eq_top_ne_zero {f : α → ℝ≥0∞} (hf : ae_measurable f μ)
+  (hμf : μ {x | f x = ∞} ≠ 0) : ∫⁻ x, f x ∂μ = ∞ :=
 eq_top_iff.mpr $
-calc ∞ = ∞ * μ {x | ∞ ≤ f x} : by simp [mul_eq_top, hμf.ne.symm]
+calc ∞ = ∞ * μ {x | ∞ ≤ f x} : by simp [mul_eq_top, hμf]
    ... ≤ ∫⁻ x, f x ∂μ : mul_meas_ge_le_lintegral₀ hf ∞
 
+lemma set_lintegral_eq_top_of_measure_eq_top_ne_zero (hf : ae_measurable f (μ.restrict s))
+  (hμf : μ {x ∈ s | f x = ∞} ≠ 0) : ∫⁻ x in s, f x ∂μ = ∞ :=
+lintegral_eq_top_of_measure_eq_top_ne_zero hf $
+  mt (eq_bot_mono $ by { rw ←set_of_inter_eq_sep, exact measure.le_restrict_apply _ _ }) hμf
+
+lemma measure_eq_top_of_lintegral_ne_top (hf : ae_measurable f μ) (hμf : ∫⁻ x, f x ∂μ ≠ ∞) :
+  μ {x | f x = ∞} = 0 :=
+of_not_not $ λ h, hμf $ lintegral_eq_top_of_measure_eq_top_ne_zero hf h
+
+lemma measure_eq_top_of_set_lintegral_ne_top (hf : ae_measurable f (μ.restrict s))
+  (hμf : ∫⁻ x in s, f x ∂μ ≠ ∞) : μ {x ∈ s | f x = ∞} = 0 :=
+of_not_not $ λ h, hμf $ set_lintegral_eq_top_of_measure_eq_top_ne_zero hf h
+
 /-- **Markov's inequality** also known as **Chebyshev's first inequality**. -/
 lemma meas_ge_le_lintegral_div {f : α → ℝ≥0∞} (hf : ae_measurable f μ) {ε : ℝ≥0∞}
   (hε : ε ≠ 0) (hε' : ε ≠ ∞) :
@@ -1610,34 +821,33 @@ lemma meas_ge_le_lintegral_div {f : α → ℝ≥0∞} (hf : ae_measurable f μ)
 (ennreal.le_div_iff_mul_le (or.inl hε) (or.inl hε')).2 $
 by { rw [mul_comm], exact mul_meas_ge_le_lintegral₀ hf ε }
 
-@[simp] lemma lintegral_eq_zero_iff {f : α → ℝ≥0∞} (hf : measurable f) :
-  ∫⁻ a, f a ∂μ = 0 ↔ (f =ᵐ[μ] 0) :=
-begin
-  refine iff.intro (assume h, _) (assume h, _),
-  { have : ∀n:ℕ, ∀ᵐ a ∂μ, f a < n⁻¹,
-    { assume n,
-      rw [ae_iff, ← nonpos_iff_eq_zero, ← @ennreal.zero_div n⁻¹,
-        ennreal.le_div_iff_mul_le, mul_comm],
-      simp only [not_lt],
-      -- TODO: why `rw ← h` fails with "not an equality or an iff"?
-      exacts [h ▸ mul_meas_ge_le_lintegral hf n⁻¹,
-        or.inl (ennreal.inv_ne_zero.2 ennreal.coe_nat_ne_top),
-        or.inr ennreal.zero_ne_top] },
-    refine (ae_all_iff.2 this).mono (λ a ha, _),
-    by_contradiction h,
-    rcases ennreal.exists_inv_nat_lt h with ⟨n, hn⟩,
-    exact (lt_irrefl _ $ lt_trans hn $ ha n).elim },
-  { calc ∫⁻ a, f a ∂μ = ∫⁻ a, 0 ∂μ : lintegral_congr_ae h
-      ... = 0 : lintegral_zero }
+lemma ae_eq_of_ae_le_of_lintegral_le {f g : α → ℝ≥0∞} (hfg : f ≤ᵐ[μ] g)
+  (hf : ∫⁻ x, f x ∂μ ≠ ∞) (hg : ae_measurable g μ) (hgf : ∫⁻ x, g x ∂μ ≤ ∫⁻ x, f x ∂μ) :
+  f =ᵐ[μ] g :=
+begin
+  have : ∀ n : ℕ, ∀ᵐ x ∂μ, g x < f x + n⁻¹,
+  { intro n,
+    simp only [ae_iff, not_lt],
+    have : ∫⁻ x, f x ∂μ + (↑n)⁻¹ * μ {x : α | f x + n⁻¹ ≤ g x} ≤ ∫⁻ x, f x ∂μ,
+      from (lintegral_add_mul_meas_add_le_le_lintegral hfg hg n⁻¹).trans hgf,
+    rw [(ennreal.cancel_of_ne hf).add_le_iff_nonpos_right, nonpos_iff_eq_zero, mul_eq_zero] at this,
+    exact this.resolve_left (ennreal.inv_ne_zero.2 (ennreal.nat_ne_top _)) },
+  refine hfg.mp ((ae_all_iff.2 this).mono (λ x hlt hle, hle.antisymm _)),
+  suffices : tendsto (λ n : ℕ, f x + n⁻¹) at_top (𝓝 (f x)),
+    from ge_of_tendsto' this (λ i, (hlt i).le),
+  simpa only [inv_top, add_zero]
+    using tendsto_const_nhds.add (ennreal.tendsto_inv_iff.2 ennreal.tendsto_nat_nhds_top)
 end
 
 @[simp] lemma lintegral_eq_zero_iff' {f : α → ℝ≥0∞} (hf : ae_measurable f μ) :
-  ∫⁻ a, f a ∂μ = 0 ↔ (f =ᵐ[μ] 0) :=
-begin
-  have : ∫⁻ a, f a ∂μ = ∫⁻ a, hf.mk f a ∂μ := lintegral_congr_ae hf.ae_eq_mk,
-  rw [this, lintegral_eq_zero_iff hf.measurable_mk],
-  exact ⟨λ H, hf.ae_eq_mk.trans H, λ H, hf.ae_eq_mk.symm.trans H⟩
-end
+  ∫⁻ a, f a ∂μ = 0 ↔ f =ᵐ[μ] 0 :=
+have ∫⁻ a : α, 0 ∂μ ≠ ∞, by simpa only [lintegral_zero] using zero_ne_top,
+⟨λ h, (ae_eq_of_ae_le_of_lintegral_le (ae_of_all _ $ zero_le f) this hf
+  (h.trans lintegral_zero.symm).le).symm, λ h, (lintegral_congr_ae h).trans lintegral_zero⟩
+
+@[simp] lemma lintegral_eq_zero_iff {f : α → ℝ≥0∞} (hf : measurable f) :
+  ∫⁻ a, f a ∂μ = 0 ↔ f =ᵐ[μ] 0 :=
+lintegral_eq_zero_iff' hf.ae_measurable
 
 lemma lintegral_pos_iff_support {f : α → ℝ≥0∞} (hf : measurable f) :
   0 < ∫⁻ a, f a ∂μ ↔ 0 < μ (function.support f) :=
@@ -1668,62 +878,65 @@ calc
   ... = ⨆n, (∫⁻ a, f n a ∂μ) :
     by simp only [lintegral_congr_ae (g_eq_f.mono $ λ a ha, ha _)]
 
-lemma lintegral_sub {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g)
+lemma lintegral_sub' {f g : α → ℝ≥0∞} (hg : ae_measurable g μ)
   (hg_fin : ∫⁻ a, g a ∂μ ≠ ∞) (h_le : g ≤ᵐ[μ] f) :
   ∫⁻ a, f a - g a ∂μ = ∫⁻ a, f a ∂μ - ∫⁻ a, g a ∂μ :=
 begin
-  rw [← ennreal.add_left_inj hg_fin,
-        tsub_add_cancel_of_le (lintegral_mono_ae h_le),
-      ← lintegral_add (hf.sub hg) hg],
-  refine lintegral_congr_ae (h_le.mono $ λ x hx, _),
-  exact tsub_add_cancel_of_le hx
+  refine ennreal.eq_sub_of_add_eq hg_fin _,
+  rw [← lintegral_add_right' _ hg],
+  exact lintegral_congr_ae (h_le.mono $ λ x hx, tsub_add_cancel_of_le hx)
 end
 
-lemma lintegral_sub_le (f g : α → ℝ≥0∞)
-  (hf : measurable f) (hg : measurable g) (h : f ≤ᵐ[μ] g) :
+lemma lintegral_sub {f g : α → ℝ≥0∞} (hg : measurable g)
+  (hg_fin : ∫⁻ a, g a ∂μ ≠ ∞) (h_le : g ≤ᵐ[μ] f) :
+  ∫⁻ a, f a - g a ∂μ = ∫⁻ a, f a ∂μ - ∫⁻ a, g a ∂μ :=
+lintegral_sub' hg.ae_measurable hg_fin h_le
+
+lemma lintegral_sub_le' (f g : α → ℝ≥0∞) (hf : ae_measurable f μ) :
   ∫⁻ x, g x ∂μ - ∫⁻ x, f x ∂μ ≤ ∫⁻ x, g x - f x ∂μ :=
 begin
+  rw tsub_le_iff_right,
   by_cases hfi : ∫⁻ x, f x ∂μ = ∞,
-  { rw [hfi, ennreal.sub_top],
-    exact bot_le },
-  { rw lintegral_sub hg hf hfi h,
-    refl' }
+  { rw [hfi, add_top],
+    exact le_top },
+  { rw [← lintegral_add_right' _ hf],
+    exact lintegral_mono (λ x, le_tsub_add) }
 end
 
-lemma lintegral_strict_mono_of_ae_le_of_ae_lt_on {f g : α → ℝ≥0∞}
-  (hf : measurable f) (hg : measurable g) (hfi : ∫⁻ x, f x ∂μ ≠ ∞) (h_le : f ≤ᵐ[μ] g)
-  {s : set α} (hμs : μ s ≠ 0) (h : ∀ᵐ x ∂μ, x ∈ s → f x < g x) :
+lemma lintegral_sub_le (f g : α → ℝ≥0∞) (hf : measurable f) :
+  ∫⁻ x, g x ∂μ - ∫⁻ x, f x ∂μ ≤ ∫⁻ x, g x - f x ∂μ :=
+lintegral_sub_le' f g hf.ae_measurable
+
+lemma lintegral_strict_mono_of_ae_le_of_frequently_ae_lt {f g : α → ℝ≥0∞} (hg : ae_measurable g μ)
+  (hfi : ∫⁻ x, f x ∂μ ≠ ∞) (h_le : f ≤ᵐ[μ] g) (h : ∃ᵐ x ∂μ, f x ≠ g x) :
   ∫⁻ x, f x ∂μ < ∫⁻ x, g x ∂μ :=
 begin
-  rw [← tsub_pos_iff_lt, ← lintegral_sub hg hf hfi h_le],
-  by_contra hnlt,
-  rw [not_lt, nonpos_iff_eq_zero, lintegral_eq_zero_iff (hg.sub hf), filter.eventually_eq] at hnlt,
-  simp only [ae_iff, tsub_eq_zero_iff_le, pi.zero_apply, not_lt, not_le] at hnlt h,
-  refine hμs _,
-  push_neg at h,
-  have hs_eq : s = {a : α | a ∈ s ∧ g a ≤ f a} ∪ {a : α | a ∈ s ∧ f a < g a},
-  { ext1 x,
-    simp_rw [set.mem_union, set.mem_set_of_eq, ← not_le],
-    tauto, },
-  rw hs_eq,
-  refine measure_union_null h (measure_mono_null _ hnlt),
-  simp,
+  contrapose! h,
+  simp only [not_frequently, ne.def, not_not],
+  exact ae_eq_of_ae_le_of_lintegral_le h_le hfi hg h
 end
 
+lemma lintegral_strict_mono_of_ae_le_of_ae_lt_on {f g : α → ℝ≥0∞}
+  (hg : ae_measurable g μ) (hfi : ∫⁻ x, f x ∂μ ≠ ∞) (h_le : f ≤ᵐ[μ] g)
+  {s : set α} (hμs : μ s ≠ 0) (h : ∀ᵐ x ∂μ, x ∈ s → f x < g x) :
+  ∫⁻ x, f x ∂μ < ∫⁻ x, g x ∂μ :=
+lintegral_strict_mono_of_ae_le_of_frequently_ae_lt hg hfi h_le $
+  ((frequently_ae_mem_iff.2 hμs).and_eventually h).mono $ λ x hx, (hx.2 hx.1).ne
+
 lemma lintegral_strict_mono {f g : α → ℝ≥0∞} (hμ : μ ≠ 0)
-  (hf : measurable f) (hg : measurable g) (hfi : ∫⁻ x, f x ∂μ ≠ ∞) (h : ∀ᵐ x ∂μ, f x < g x) :
+  (hg : ae_measurable g μ) (hfi : ∫⁻ x, f x ∂μ ≠ ∞) (h : ∀ᵐ x ∂μ, f x < g x) :
   ∫⁻ x, f x ∂μ < ∫⁻ x, g x ∂μ :=
 begin
   rw [ne.def, ← measure.measure_univ_eq_zero] at hμ,
-  refine lintegral_strict_mono_of_ae_le_of_ae_lt_on hf hg hfi (ae_le_of_ae_lt h) hμ _,
+  refine lintegral_strict_mono_of_ae_le_of_ae_lt_on hg hfi (ae_le_of_ae_lt h) hμ _,
   simpa using h,
 end
 
 lemma set_lintegral_strict_mono {f g : α → ℝ≥0∞} {s : set α}
-  (hsm : measurable_set s) (hs : μ s ≠ 0) (hf : measurable f) (hg : measurable g)
+  (hsm : measurable_set s) (hs : μ s ≠ 0) (hg : measurable g)
   (hfi : ∫⁻ x in s, f x ∂μ ≠ ∞) (h : ∀ᵐ x ∂μ, x ∈ s → f x < g x) :
   ∫⁻ x in s, f x ∂μ < ∫⁻ x in s, g x ∂μ :=
-lintegral_strict_mono (by simp [hs]) hf hg hfi ((ae_restrict_iff' hsm).mpr h)
+lintegral_strict_mono (by simp [hs]) hg.ae_measurable hfi ((ae_restrict_iff' hsm).mpr h)
 
 /-- Monotone convergence theorem for nonincreasing sequences of functions -/
 lemma lintegral_infi_ae
@@ -1737,7 +950,7 @@ have fn_le_f0' : (⨅n, ∫⁻ a, f n a ∂μ) ≤ ∫⁻ a, f 0 a ∂μ, from i
 show ∫⁻ a, f 0 a ∂μ - ∫⁻ a, ⨅n, f n a ∂μ = ∫⁻ a, f 0 a ∂μ - (⨅n, ∫⁻ a, f n a ∂μ), from
 calc
   ∫⁻ a, f 0 a ∂μ - (∫⁻ a, ⨅n, f n a ∂μ) = ∫⁻ a, f 0 a - ⨅n, f n a ∂μ:
-    (lintegral_sub (h_meas 0) (measurable_infi h_meas)
+    (lintegral_sub (measurable_infi h_meas)
     (ne_top_of_le_ne_top h_fin $ lintegral_mono (assume a, infi_le _ _))
     (ae_of_all _ $ assume a, infi_le _ _)).symm
   ... = ∫⁻ a, ⨆n, f 0 a - f n a ∂μ : congr rfl (funext (assume a, ennreal.sub_infi))
@@ -1752,7 +965,7 @@ calc
       induction n with n ih,
       {exact le_rfl}, {exact le_trans (h n) ih}
     end,
-    congr_arg supr $ funext $ assume n, lintegral_sub (h_meas _) (h_meas _)
+    congr_arg supr $ funext $ assume n, lintegral_sub (h_meas _)
       (ne_top_of_le_ne_top h_fin $ lintegral_mono_ae $ h_mono n) (h_mono n)
   ... = ∫⁻ a, f 0 a ∂μ - ⨅n, ∫⁻ a, f n a ∂μ : ennreal.sub_infi.symm
 
@@ -1765,13 +978,13 @@ lintegral_infi_ae h_meas (λ n, ae_of_all _ $ h_anti n.le_succ) h_fin
 
 /-- Known as Fatou's lemma, version with `ae_measurable` functions -/
 lemma lintegral_liminf_le' {f : ℕ → α → ℝ≥0∞} (h_meas : ∀n, ae_measurable (f n) μ) :
-  ∫⁻ a, liminf at_top (λ n, f n a) ∂μ ≤ liminf at_top (λ n, ∫⁻ a, f n a ∂μ) :=
+  ∫⁻ a, liminf (λ n, f n a) at_top ∂μ ≤ liminf (λ n, ∫⁻ a, f n a ∂μ) at_top :=
 calc
-  ∫⁻ a, liminf at_top (λ n, f n a) ∂μ = ∫⁻ a, ⨆n:ℕ, ⨅i≥n, f i a ∂μ :
+  ∫⁻ a, liminf (λ n, f n a) at_top ∂μ = ∫⁻ a, ⨆n:ℕ, ⨅i≥n, f i a ∂μ :
      by simp only [liminf_eq_supr_infi_of_nat]
   ... = ⨆n:ℕ, ∫⁻ a, ⨅i≥n, f i a ∂μ :
     lintegral_supr'
-      (assume n, ae_measurable_binfi _ (countable_encodable _) h_meas)
+      (assume n, ae_measurable_binfi _ (to_countable _) h_meas)
       (ae_of_all μ (assume a n m hnm, infi_le_infi_of_subset $ λ i hi, le_trans hnm hi))
   ... ≤ ⨆n:ℕ, ⨅i≥n, ∫⁻ a, f i a ∂μ :
     supr_mono $ λ n, le_infi₂_lintegral _
@@ -1779,27 +992,27 @@ calc
 
 /-- Known as Fatou's lemma -/
 lemma lintegral_liminf_le {f : ℕ → α → ℝ≥0∞} (h_meas : ∀n, measurable (f n)) :
-  ∫⁻ a, liminf at_top (λ n, f n a) ∂μ ≤ liminf at_top (λ n, ∫⁻ a, f n a ∂μ) :=
+  ∫⁻ a, liminf (λ n, f n a) at_top ∂μ ≤ liminf (λ n, ∫⁻ a, f n a ∂μ) at_top :=
 lintegral_liminf_le' (λ n, (h_meas n).ae_measurable)
 
 lemma limsup_lintegral_le {f : ℕ → α → ℝ≥0∞} {g : α → ℝ≥0∞}
   (hf_meas : ∀ n, measurable (f n)) (h_bound : ∀n, f n ≤ᵐ[μ] g) (h_fin : ∫⁻ a, g a ∂μ ≠ ∞) :
-  limsup at_top (λn, ∫⁻ a, f n a ∂μ) ≤ ∫⁻ a, limsup at_top (λn, f n a) ∂μ :=
+  limsup (λn, ∫⁻ a, f n a ∂μ) at_top ≤ ∫⁻ a, limsup (λn, f n a) at_top ∂μ :=
 calc
-  limsup at_top (λn, ∫⁻ a, f n a ∂μ) = ⨅n:ℕ, ⨆i≥n, ∫⁻ a, f i a ∂μ :
+  limsup (λn, ∫⁻ a, f n a ∂μ) at_top = ⨅n:ℕ, ⨆i≥n, ∫⁻ a, f i a ∂μ :
     limsup_eq_infi_supr_of_nat
   ... ≤ ⨅n:ℕ, ∫⁻ a, ⨆i≥n, f i a ∂μ :
     infi_mono $ assume n, supr₂_lintegral_le _
   ... = ∫⁻ a, ⨅n:ℕ, ⨆i≥n, f i a ∂μ :
     begin
       refine (lintegral_infi _ _ _).symm,
-      { assume n, exact measurable_bsupr _ (countable_encodable _) hf_meas },
+      { assume n, exact measurable_bsupr _ (to_countable _) hf_meas },
       { assume n m hnm a, exact (supr_le_supr_of_subset $ λ i hi, le_trans hnm hi) },
       { refine ne_top_of_le_ne_top h_fin (lintegral_mono_ae _),
         refine (ae_all_iff.2 h_bound).mono (λ n hn, _),
         exact supr_le (λ i, supr_le $ λ hi, hn i) }
     end
-  ... = ∫⁻ a, limsup at_top (λn, f n a) ∂μ :
+  ... = ∫⁻ a, limsup (λn, f n a) at_top ∂μ :
     by simp only [limsup_eq_infi_supr_of_nat]
 
 /-- Dominated convergence theorem for nonnegative functions -/
@@ -1810,10 +1023,10 @@ lemma tendsto_lintegral_of_dominated_convergence
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, F n a) at_top (𝓝 (f a))) :
   tendsto (λn, ∫⁻ a, F n a ∂μ) at_top (𝓝 (∫⁻ a, f a ∂μ)) :=
 tendsto_of_le_liminf_of_limsup_le
-(calc ∫⁻ a, f a ∂μ = ∫⁻ a, liminf at_top (λ (n : ℕ), F n a) ∂μ :
+(calc ∫⁻ a, f a ∂μ = ∫⁻ a, liminf (λ (n : ℕ), F n a) at_top ∂μ :
       lintegral_congr_ae $ h_lim.mono $ assume a h, h.liminf_eq.symm
- ... ≤ liminf at_top (λ n, ∫⁻ a, F n a ∂μ) : lintegral_liminf_le hF_meas)
-(calc limsup at_top (λ (n : ℕ), ∫⁻ a, F n a ∂μ) ≤ ∫⁻ a, limsup at_top (λn, F n a) ∂μ :
+ ... ≤ liminf (λ n, ∫⁻ a, F n a ∂μ) at_top : lintegral_liminf_le hF_meas)
+(calc limsup (λ (n : ℕ), ∫⁻ a, F n a ∂μ) at_top ≤ ∫⁻ a, limsup (λn, F n a) at_top ∂μ :
       limsup_lintegral_le hF_meas h_bound h_fin
  ... = ∫⁻ a, f a ∂μ : lintegral_congr_ae $ h_lim.mono $ λ a h, h.limsup_eq)
 
@@ -1873,11 +1086,12 @@ end
 section
 open encodable
 
-/-- Monotone convergence for a suprema over a directed family and indexed by an encodable type -/
-theorem lintegral_supr_directed [encodable β] {f : β → α → ℝ≥0∞}
-  (hf : ∀b, measurable (f b)) (h_directed : directed (≤) f) :
-  ∫⁻ a, ⨆b, f b a ∂μ = ⨆b, ∫⁻ a, f b a ∂μ :=
+/-- Monotone convergence for a supremum over a directed family and indexed by a countable type -/
+theorem lintegral_supr_directed_of_measurable [countable β] {f : β → α → ℝ≥0∞}
+  (hf : ∀ b, measurable (f b)) (h_directed : directed (≤) f) :
+  ∫⁻ a, ⨆ b, f b a ∂μ = ⨆ b, ∫⁻ a, f b a ∂μ :=
 begin
+  casesI nonempty_encodable β,
   casesI is_empty_or_nonempty β, { simp [supr_of_empty] },
   inhabit β,
   have : ∀a, (⨆ b, f b a) = (⨆ n, f (h_directed.sequence f n) a),
@@ -1897,50 +1111,128 @@ begin
     end
 end
 
-end
-
-lemma lintegral_tsum [encodable β] {f : β → α → ℝ≥0∞} (hf : ∀i, measurable (f i)) :
+/-- Monotone convergence for a supremum over a directed family and indexed by a countable type. -/
+theorem lintegral_supr_directed [countable β] {f : β → α → ℝ≥0∞}
+  (hf : ∀ b, ae_measurable (f b) μ) (h_directed : directed (≤) f) :
+  ∫⁻ a, ⨆ b, f b a ∂μ = ⨆ b, ∫⁻ a, f b a ∂μ :=
+begin
+  simp_rw ←supr_apply,
+  let p : α → (β → ennreal) → Prop := λ x f', directed has_le.le f',
+  have hp : ∀ᵐ x ∂μ, p x (λ i, f i x),
+  { filter_upwards with x i j,
+    obtain ⟨z, hz₁, hz₂⟩ := h_directed i j,
+    exact ⟨z, hz₁ x, hz₂ x⟩, },
+  have h_ae_seq_directed : directed has_le.le (ae_seq hf p),
+  { intros b₁ b₂,
+    obtain ⟨z, hz₁, hz₂⟩ := h_directed b₁ b₂,
+    refine ⟨z, _, _⟩;
+    { intros x,
+      by_cases hx : x ∈ ae_seq_set hf p,
+      { repeat { rw ae_seq.ae_seq_eq_fun_of_mem_ae_seq_set hf hx },
+        apply_rules [hz₁, hz₂], },
+      { simp only [ae_seq, hx, if_false],
+        exact le_rfl, }, }, },
+  convert (lintegral_supr_directed_of_measurable (ae_seq.measurable hf p)
+    h_ae_seq_directed) using 1,
+  { simp_rw ←supr_apply,
+    rw lintegral_congr_ae (ae_seq.supr hf hp).symm, },
+  { congr' 1,
+    ext1 b,
+    rw lintegral_congr_ae,
+    symmetry,
+    refine ae_seq.ae_seq_n_eq_fun_n_ae hf hp _, },
+end
+
+end
+
+lemma lintegral_tsum [countable β] {f : β → α → ℝ≥0∞} (hf : ∀i, ae_measurable (f i) μ) :
   ∫⁻ a, ∑' i, f i a ∂μ = ∑' i, ∫⁻ a, f i a ∂μ :=
 begin
   simp only [ennreal.tsum_eq_supr_sum],
   rw [lintegral_supr_directed],
-  { simp [lintegral_finset_sum _ (λ i _, hf i)] },
-  { assume b, exact finset.measurable_sum _ (λ i _, hf i) },
+  { simp [lintegral_finset_sum' _ (λ i _, hf i)] },
+  { assume b, exact finset.ae_measurable_sum _ (λ i _, hf i) },
   { assume s t,
     use [s ∪ t],
     split,
-    exact assume a, finset.sum_le_sum_of_subset (finset.subset_union_left _ _),
-    exact assume a, finset.sum_le_sum_of_subset (finset.subset_union_right _ _) }
+    { exact assume a, finset.sum_le_sum_of_subset (finset.subset_union_left _ _), },
+    { exact assume a, finset.sum_le_sum_of_subset (finset.subset_union_right _ _) } }
 end
 
 open measure
 
-lemma lintegral_Union [encodable β] {s : β → set α} (hm : ∀ i, measurable_set (s i))
+lemma lintegral_Union₀ [countable β] {s : β → set α} (hm : ∀ i, null_measurable_set (s i) μ)
+  (hd : pairwise (ae_disjoint μ on s)) (f : α → ℝ≥0∞) :
+  ∫⁻ a in ⋃ i, s i, f a ∂μ = ∑' i, ∫⁻ a in s i, f a ∂μ :=
+by simp only [measure.restrict_Union_ae hd hm, lintegral_sum_measure]
+
+lemma lintegral_Union [countable β] {s : β → set α} (hm : ∀ i, measurable_set (s i))
   (hd : pairwise (disjoint on s)) (f : α → ℝ≥0∞) :
   ∫⁻ a in ⋃ i, s i, f a ∂μ = ∑' i, ∫⁻ a in s i, f a ∂μ :=
-by simp only [measure.restrict_Union hd hm, lintegral_sum_measure]
+lintegral_Union₀ (λ i, (hm i).null_measurable_set) hd.ae_disjoint f
+
+lemma lintegral_bUnion₀ {t : set β} {s : β → set α} (ht : t.countable)
+  (hm : ∀ i ∈ t, null_measurable_set (s i) μ)
+  (hd : t.pairwise (ae_disjoint μ on s)) (f : α → ℝ≥0∞) :
+  ∫⁻ a in ⋃ i ∈ t, s i, f a ∂μ = ∑' i : t, ∫⁻ a in s i, f a ∂μ :=
+begin
+  haveI := ht.to_encodable,
+  rw [bUnion_eq_Union, lintegral_Union₀ (set_coe.forall'.1 hm) (hd.subtype _ _)]
+end
+
+lemma lintegral_bUnion {t : set β} {s : β → set α} (ht : t.countable)
+  (hm : ∀ i ∈ t, measurable_set (s i)) (hd : t.pairwise_disjoint s) (f : α → ℝ≥0∞) :
+  ∫⁻ a in ⋃ i ∈ t, s i, f a ∂μ = ∑' i : t, ∫⁻ a in s i, f a ∂μ :=
+lintegral_bUnion₀ ht (λ i hi, (hm i hi).null_measurable_set) hd.ae_disjoint f
 
-lemma lintegral_Union_le [encodable β] (s : β → set α) (f : α → ℝ≥0∞) :
+lemma lintegral_bUnion_finset₀ {s : finset β} {t : β → set α}
+  (hd : set.pairwise ↑s (ae_disjoint μ on t)) (hm : ∀ b ∈ s, null_measurable_set (t b) μ)
+  (f : α → ℝ≥0∞) :
+  ∫⁻ a in ⋃ b ∈ s, t b, f a ∂μ = ∑ b in s, ∫⁻ a in t b, f a ∂μ :=
+by simp only [← finset.mem_coe, lintegral_bUnion₀ s.countable_to_set hm hd, ← s.tsum_subtype']
+
+lemma lintegral_bUnion_finset {s : finset β} {t : β → set α}
+  (hd : set.pairwise_disjoint ↑s t) (hm : ∀ b ∈ s, measurable_set (t b)) (f : α → ℝ≥0∞) :
+  ∫⁻ a in ⋃ b ∈ s, t b, f a ∂μ = ∑ b in s, ∫⁻ a in t b, f a ∂μ :=
+lintegral_bUnion_finset₀ hd.ae_disjoint (λ b hb, (hm b hb).null_measurable_set) f
+
+lemma lintegral_Union_le [countable β] (s : β → set α) (f : α → ℝ≥0∞) :
   ∫⁻ a in ⋃ i, s i, f a ∂μ ≤ ∑' i, ∫⁻ a in s i, f a ∂μ :=
 begin
   rw [← lintegral_sum_measure],
   exact lintegral_mono' restrict_Union_le le_rfl
 end
 
-lemma lintegral_union {f : α → ℝ≥0∞} {A B : set α}
-  (hA : measurable_set A) (hB : measurable_set B) (hAB : disjoint A B) :
+lemma lintegral_union {f : α → ℝ≥0∞} {A B : set α} (hB : measurable_set B) (hAB : disjoint A B) :
   ∫⁻ a in A ∪ B, f a ∂μ = ∫⁻ a in A, f a ∂μ + ∫⁻ a in B, f a ∂μ :=
-begin
-  rw [set.union_eq_Union, lintegral_Union, tsum_bool, add_comm],
-  { simp only [to_bool_false_eq_ff, to_bool_true_eq_tt, cond] },
-  { intros i, exact measurable_set.cond hA hB },
-  { rwa pairwise_disjoint_on_bool }
-end
+by rw [restrict_union hAB hB, lintegral_add_measure]
+
+lemma lintegral_inter_add_diff {B : set α} (f : α → ℝ≥0∞) (A : set α) (hB : measurable_set B) :
+  ∫⁻ x in A ∩ B, f x ∂μ + ∫⁻ x in A \ B, f x ∂μ = ∫⁻ x in A, f x ∂μ :=
+by rw [← lintegral_add_measure, restrict_inter_add_diff _ hB]
 
 lemma lintegral_add_compl (f : α → ℝ≥0∞) {A : set α} (hA : measurable_set A) :
   ∫⁻ x in A, f x ∂μ + ∫⁻ x in Aᶜ, f x ∂μ = ∫⁻ x, f x ∂μ :=
 by rw [← lintegral_add_measure, measure.restrict_add_restrict_compl hA]
 
+lemma lintegral_max {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g) :
+  ∫⁻ x, max (f x) (g x) ∂μ = ∫⁻ x in {x | f x ≤ g x}, g x ∂μ + ∫⁻ x in {x | g x < f x}, f x ∂μ :=
+begin
+  have hm : measurable_set {x | f x ≤ g x}, from measurable_set_le hf hg,
+  rw [← lintegral_add_compl (λ x, max (f x) (g x)) hm],
+  simp only [← compl_set_of, ← not_le],
+  refine congr_arg2 (+) (set_lintegral_congr_fun hm _) (set_lintegral_congr_fun hm.compl _),
+  exacts [ae_of_all _ (λ x, max_eq_right), ae_of_all _ (λ x hx, max_eq_left (not_le.1 hx).le)]
+end
+
+lemma set_lintegral_max {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g) (s : set α) :
+  ∫⁻ x in s, max (f x) (g x) ∂μ =
+    ∫⁻ x in s ∩ {x | f x ≤ g x}, g x ∂μ + ∫⁻ x in s ∩ {x | g x < f x}, f x ∂μ :=
+begin
+  rw [lintegral_max hf hg, restrict_restrict, restrict_restrict, inter_comm s, inter_comm s],
+  exacts [measurable_set_lt hg hf, measurable_set_le hf hg]
+end
+
 lemma lintegral_map {mβ : measurable_space β} {f : β → ℝ≥0∞} {g : α → β}
   (hf : measurable f) (hg : measurable g) : ∫⁻ a, f a ∂(map g μ) = ∫⁻ a, f (g a) ∂μ :=
 begin
@@ -1979,6 +1271,12 @@ lemma set_lintegral_map [measurable_space β] {f : β → ℝ≥0∞} {g : α 
   ∫⁻ y in s, f y ∂(map g μ) = ∫⁻ x in g ⁻¹' s, f (g x) ∂μ :=
 by rw [restrict_map hg hs, lintegral_map hf hg]
 
+lemma lintegral_indicator_const_comp {mβ : measurable_space β}
+  {f : α → β} {s : set β} (hf : measurable f) (hs : measurable_set s) (c : ℝ≥0∞) :
+  ∫⁻ a, s.indicator (λ _, c) (f a) ∂μ = c * μ (f ⁻¹' s) :=
+by rw [lintegral_comp (measurable_const.indicator hs) hf, lintegral_indicator_const hs,
+  measure.map_apply hf hs]
+
 /-- If `g : α → β` is a measurable embedding and `f : β → ℝ≥0∞` is any function (not necessarily
 measurable), then `∫⁻ a, f a ∂(map g μ) = ∫⁻ a, f (g a) ∂μ`. Compare with `lintegral_map` wich
 applies to any measurable `g : α → β` but requires that `f` is measurable as well. -/
@@ -2033,6 +1331,12 @@ lemma measure_preserving.set_lintegral_comp_emb {mb : measurable_space β} {ν :
 by rw [← hg.set_lintegral_comp_preimage_emb hge, preimage_image_eq _ hge.injective]
 
 section dirac_and_count
+
+@[priority 10]
+instance _root_.measurable_space.top.measurable_singleton_class {α : Type*} :
+  @measurable_singleton_class α (⊤ : measurable_space α) :=
+{ measurable_set_singleton := λ i, measurable_space.measurable_set_top, }
+
 variable [measurable_space α]
 
 lemma lintegral_dirac' (a : α) {f : α → ℝ≥0∞} (hf : measurable f) :
@@ -2043,13 +1347,25 @@ lemma lintegral_dirac [measurable_singleton_class α] (a : α) (f : α → ℝ
   ∫⁻ a, f a ∂(dirac a) = f a :=
 by simp [lintegral_congr_ae (ae_eq_dirac f)]
 
-lemma lintegral_encodable {α : Type*} {m : measurable_space α} [encodable α]
-  [measurable_singleton_class α] (f : α → ℝ≥0∞) (μ : measure α) :
-  ∫⁻ a, f a ∂μ = ∑' a, f a * μ {a} :=
+lemma set_lintegral_dirac' {a : α} {f : α → ℝ≥0∞} (hf : measurable f)
+  {s : set α} (hs : measurable_set s) [decidable (a ∈ s)] :
+  ∫⁻ x in s, f x ∂(measure.dirac a) = if a ∈ s then f a else 0 :=
 begin
-  conv_lhs { rw [← sum_smul_dirac μ, lintegral_sum_measure] },
-  congr' 1 with a : 1,
-  rw [lintegral_smul_measure, lintegral_dirac, mul_comm],
+  rw [restrict_dirac' hs],
+  swap, { apply_instance, },
+  split_ifs,
+  { exact lintegral_dirac' _ hf, },
+  { exact lintegral_zero_measure _, },
+end
+
+lemma set_lintegral_dirac {a : α} (f : α → ℝ≥0∞)
+  (s : set α) [measurable_singleton_class α] [decidable (a ∈ s)] :
+  ∫⁻ x in s, f x ∂(measure.dirac a) = if a ∈ s then f a else 0 :=
+begin
+  rw [restrict_dirac],
+  split_ifs,
+  { exact lintegral_dirac _ _, },
+  { exact lintegral_zero_measure _, },
 end
 
 lemma lintegral_count' {f : α → ℝ≥0∞} (hf : measurable f) :
@@ -2068,8 +1384,89 @@ begin
   exact funext (λ a, lintegral_dirac a f),
 end
 
+lemma _root_.ennreal.tsum_const_eq [measurable_singleton_class α] (c : ℝ≥0∞) :
+  (∑' (i : α), c) = c * (measure.count (univ : set α)) :=
+by rw [← lintegral_count, lintegral_const]
+
+/-- Markov's inequality for the counting measure with hypothesis using `tsum` in `ℝ≥0∞`. -/
+lemma _root_.ennreal.count_const_le_le_of_tsum_le [measurable_singleton_class α]
+  {a : α → ℝ≥0∞} (a_mble : measurable a) {c : ℝ≥0∞} (tsum_le_c : ∑' i, a i ≤ c)
+  {ε : ℝ≥0∞} (ε_ne_zero : ε ≠ 0) (ε_ne_top : ε ≠ ∞) :
+  measure.count {i : α | ε ≤ a i} ≤ c / ε :=
+begin
+  rw ← lintegral_count at tsum_le_c,
+  apply (measure_theory.meas_ge_le_lintegral_div a_mble.ae_measurable ε_ne_zero ε_ne_top).trans,
+  exact ennreal.div_le_div tsum_le_c rfl.le,
+end
+
+/-- Markov's inequality for counting measure with hypothesis using `tsum` in `ℝ≥0`. -/
+lemma _root_.nnreal.count_const_le_le_of_tsum_le [measurable_singleton_class α]
+  {a : α → ℝ≥0} (a_mble : measurable a) (a_summable : summable a)
+  {c : ℝ≥0} (tsum_le_c : ∑' i, a i ≤ c) {ε : ℝ≥0} (ε_ne_zero : ε ≠ 0) :
+  measure.count {i : α | ε ≤ a i} ≤ c / ε :=
+begin
+  rw [show (λ i, ε ≤ a i) = (λ i, (ε : ℝ≥0∞) ≤ (coe ∘ a) i),
+        by { funext i, simp only [ennreal.coe_le_coe], }],
+  apply ennreal.count_const_le_le_of_tsum_le (measurable_coe_nnreal_ennreal.comp a_mble)
+          _ (by exact_mod_cast ε_ne_zero) (@ennreal.coe_ne_top ε),
+  convert ennreal.coe_le_coe.mpr tsum_le_c,
+  rw ennreal.tsum_coe_eq a_summable.has_sum,
+end
+
 end dirac_and_count
 
+section countable
+/-!
+### Lebesgue integral over finite and countable types and sets
+-/
+
+lemma lintegral_countable' [countable α] [measurable_singleton_class α] (f : α → ℝ≥0∞) :
+  ∫⁻ a, f a ∂μ = ∑' a, f a * μ {a} :=
+begin
+  conv_lhs { rw [← sum_smul_dirac μ, lintegral_sum_measure] },
+  congr' 1 with a : 1,
+  rw [lintegral_smul_measure, lintegral_dirac, mul_comm],
+end
+
+lemma lintegral_singleton' {f : α → ℝ≥0∞} (hf : measurable f) (a : α) :
+  ∫⁻ x in {a}, f x ∂μ = f a * μ {a} :=
+by simp only [restrict_singleton, lintegral_smul_measure, lintegral_dirac' _ hf, mul_comm]
+
+lemma lintegral_singleton [measurable_singleton_class α] (f : α → ℝ≥0∞) (a : α) :
+  ∫⁻ x in {a}, f x ∂μ = f a * μ {a} :=
+by simp only [restrict_singleton, lintegral_smul_measure, lintegral_dirac, mul_comm]
+
+lemma lintegral_countable [measurable_singleton_class α] (f : α → ℝ≥0∞) {s : set α}
+  (hs : s.countable) :
+  ∫⁻ a in s, f a ∂μ = ∑' a : s, f a * μ {(a : α)} :=
+calc ∫⁻ a in s, f a ∂μ = ∫⁻ a in ⋃ x ∈ s, {x}, f a ∂μ : by rw [bUnion_of_singleton]
+... = ∑' a : s, ∫⁻ x in {a}, f x ∂μ :
+  lintegral_bUnion hs (λ _ _, measurable_set_singleton _) (pairwise_disjoint_fiber id s) _
+... = ∑' a : s, f a * μ {(a : α)} : by simp only [lintegral_singleton]
+
+lemma lintegral_insert [measurable_singleton_class α]
+  {a : α} {s : set α} (h : a ∉ s) (f : α → ℝ≥0∞) :
+  ∫⁻ x in insert a s, f x ∂μ = f a * μ {a} + ∫⁻ x in s, f x ∂μ :=
+begin
+  rw [← union_singleton, lintegral_union (measurable_set_singleton a), lintegral_singleton,
+    add_comm],
+  rwa disjoint_singleton_right
+end
+
+lemma lintegral_finset [measurable_singleton_class α] (s : finset α) (f : α → ℝ≥0∞) :
+  ∫⁻ x in s, f x ∂μ = ∑ x in s, f x * μ {x} :=
+by simp only [lintegral_countable _ s.countable_to_set, ← s.tsum_subtype']
+
+lemma lintegral_fintype [measurable_singleton_class α] [fintype α] (f : α → ℝ≥0∞) :
+  ∫⁻ x, f x ∂μ = ∑ x, f x * μ {x} :=
+by rw [← lintegral_finset, finset.coe_univ, measure.restrict_univ]
+
+lemma lintegral_unique [unique α] (f : α → ℝ≥0∞) : ∫⁻ x, f x ∂μ = f default * μ univ :=
+calc ∫⁻ x, f x ∂μ = ∫⁻ x, f default ∂μ : lintegral_congr $ unique.forall_iff.2 rfl
+... = f default * μ univ : lintegral_const _
+
+end countable
+
 lemma ae_lt_top {f : α → ℝ≥0∞} (hf : measurable f) (h2f : ∫⁻ x, f x ∂μ ≠ ∞) :
   ∀ᵐ x ∂μ, f x < ∞ :=
 begin
@@ -2133,15 +1530,33 @@ begin
   exact lintegral_congr_ae (ae_restrict_of_ae h)
 end
 
-lemma with_density_add {f g : α → ℝ≥0∞} (hf : measurable f) (hg : measurable g) :
+lemma with_density_add_left {f : α → ℝ≥0∞} (hf : measurable f) (g : α → ℝ≥0∞) :
   μ.with_density (f + g) = μ.with_density f + μ.with_density g :=
 begin
   refine measure.ext (λ s hs, _),
   rw [with_density_apply _ hs, measure.add_apply,
-      with_density_apply _ hs, with_density_apply _ hs, ← lintegral_add hf hg],
+      with_density_apply _ hs, with_density_apply _ hs, ← lintegral_add_left hf],
   refl,
 end
 
+lemma with_density_add_right (f : α → ℝ≥0∞) {g : α → ℝ≥0∞} (hg : measurable g) :
+  μ.with_density (f + g) = μ.with_density f + μ.with_density g :=
+by simpa only [add_comm] using with_density_add_left hg f
+
+lemma with_density_add_measure {m : measurable_space α} (μ ν : measure α) (f : α → ℝ≥0∞) :
+  (μ + ν).with_density f = μ.with_density f + ν.with_density f :=
+begin
+  ext1 s hs,
+  simp only [with_density_apply f hs, restrict_add, lintegral_add_measure, measure.add_apply],
+end
+
+lemma with_density_sum {ι : Type*} {m : measurable_space α} (μ : ι → measure α) (f : α → ℝ≥0∞) :
+  (sum μ).with_density f = sum (λ n, (μ n).with_density f) :=
+begin
+  ext1 s hs,
+  simp_rw [sum_apply _ hs, with_density_apply f hs, restrict_sum μ hs, lintegral_sum_measure],
+end
+
 lemma with_density_smul (r : ℝ≥0∞) {f : α → ℝ≥0∞} (hf : measurable f) :
   μ.with_density (r • f) = r • μ.with_density f :=
 begin
@@ -2193,7 +1608,7 @@ begin
   ext1 s hs,
   simp_rw [sum_apply _ hs, with_density_apply _ hs],
   change ∫⁻ x in s, (∑' n, f n) x ∂μ = ∑' (i : ℕ), ∫⁻ x, f i x ∂(μ.restrict s),
-  rw ← lintegral_tsum h,
+  rw ← lintegral_tsum (λ i, (h i).ae_measurable),
   refine lintegral_congr (λ x, tsum_apply (pi.summable.2 (λ _, ennreal.summable))),
 end
 
@@ -2210,7 +1625,7 @@ lemma with_density_indicator_one {s : set α} (hs : measurable_set s) :
 by rw [with_density_indicator hs, with_density_one]
 
 lemma with_density_of_real_mutually_singular {f : α → ℝ} (hf : measurable f) :
-  μ.with_density (λ x, ennreal.of_real $ f x) ⊥ₘ μ.with_density (λ x, ennreal.of_real $ -f x) :=
+  μ.with_density (λ x, ennreal.of_real $ f x) ⟂ₘ μ.with_density (λ x, ennreal.of_real $ -f x) :=
 begin
   set S : set α := { x | f x < 0 } with hSdef,
   have hS : measurable_set S := measurable_set_lt hf measurable_const,
@@ -2251,14 +1666,14 @@ begin
     simp only [pi.zero_apply, mem_set_of_eq, filter.mem_mk] at A,
     convert A,
     ext x,
-    simp only [and_comm, exists_prop, mem_inter_eq, iff_self, mem_set_of_eq, mem_compl_eq,
+    simp only [and_comm, exists_prop, mem_inter_iff, iff_self, mem_set_of_eq, mem_compl_iff,
                not_forall] },
   { assume hs,
     let t := to_measurable μ ({x | f x ≠ 0} ∩ s),
     have A : s ⊆ t ∪ {x | f x = 0},
     { assume x hx,
       rcases eq_or_ne (f x) 0 with fx|fx,
-      { simp only [fx, mem_union_eq, mem_set_of_eq, eq_self_iff_true, or_true] },
+      { simp only [fx, mem_union, mem_set_of_eq, eq_self_iff_true, or_true] },
       { left,
         apply subset_to_measurable _ _,
         exact ⟨fx, hx⟩ } },
@@ -2277,7 +1692,7 @@ begin
   rw [ae_iff, ae_iff, with_density_apply_eq_zero hf],
   congr',
   ext x,
-  simp only [exists_prop, mem_inter_eq, iff_self, mem_set_of_eq, not_forall],
+  simp only [exists_prop, mem_inter_iff, iff_self, mem_set_of_eq, not_forall],
 end
 
 lemma ae_with_density_iff_ae_restrict {p : α → Prop} {f : α → ℝ≥0∞} (hf : measurable f) :
@@ -2288,36 +1703,6 @@ begin
   { exact hf (measurable_set_singleton 0).compl },
 end
 
-lemma ae_measurable_with_density_iff {E : Type*} [normed_group E] [normed_space ℝ E]
-  [topological_space.second_countable_topology E] [measurable_space E] [borel_space E]
-  {f : α → ℝ≥0} (hf : measurable f) {g : α → E} :
-  ae_measurable g (μ.with_density (λ x, (f x : ℝ≥0∞))) ↔ ae_measurable (λ x, (f x : ℝ) • g x) μ :=
-begin
-  split,
-  { rintros ⟨g', g'meas, hg'⟩,
-    have A : measurable_set {x : α | f x ≠ 0} := (hf (measurable_set_singleton 0)).compl,
-    refine ⟨λ x, (f x : ℝ) • g' x, hf.coe_nnreal_real.smul g'meas, _⟩,
-    apply @ae_of_ae_restrict_of_ae_restrict_compl _ _ _ {x | f x ≠ 0},
-    { rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal] at hg',
-      rw ae_restrict_iff' A,
-      filter_upwards [hg'],
-      assume a ha h'a,
-      have : (f a : ℝ≥0∞) ≠ 0, by simpa only [ne.def, coe_eq_zero] using h'a,
-      rw ha this },
-    { filter_upwards [ae_restrict_mem A.compl],
-      assume x hx,
-      simp only [not_not, mem_set_of_eq, mem_compl_eq] at hx,
-      simp [hx] } },
-  { rintros ⟨g', g'meas, hg'⟩,
-    refine ⟨λ x, (f x : ℝ)⁻¹ • g' x, hf.coe_nnreal_real.inv.smul g'meas, _⟩,
-    rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal],
-    filter_upwards [hg'],
-    assume x hx h'x,
-    rw [← hx, smul_smul, _root_.inv_mul_cancel, one_smul],
-    simp only [ne.def, coe_eq_zero] at h'x,
-    simpa only [nnreal.coe_eq_zero, ne.def] using h'x }
-end
-
 lemma ae_measurable_with_density_ennreal_iff {f : α → ℝ≥0} (hf : measurable f) {g : α → ℝ≥0∞} :
   ae_measurable g (μ.with_density (λ x, (f x : ℝ≥0∞))) ↔
     ae_measurable (λ x, (f x : ℝ≥0∞) * g x) μ :=
@@ -2335,7 +1720,7 @@ begin
       rw ha this },
     { filter_upwards [ae_restrict_mem A.compl],
       assume x hx,
-      simp only [not_not, mem_set_of_eq, mem_compl_eq] at hx,
+      simp only [not_not, mem_set_of_eq, mem_compl_iff] at hx,
       simp [hx] } },
   { rintros ⟨g', g'meas, hg'⟩,
     refine ⟨λ x, (f x)⁻¹ * g' x, hf.coe_nnreal_ennreal.inv.smul g'meas, _⟩,
@@ -2347,35 +1732,9 @@ end
 
 end lintegral
 
-end measure_theory
-
-open measure_theory measure_theory.simple_func
-/-- To prove something for an arbitrary measurable function into `ℝ≥0∞`, it suffices to show
-that the property holds for (multiples of) characteristic functions and is closed under addition
-and supremum of increasing sequences of functions.
-
-It is possible to make the hypotheses in the induction steps a bit stronger, and such conditions
-can be added once we need them (for example in `h_add` it is only necessary to consider the sum of
-a simple function with a multiple of a characteristic function and that the intersection
-of their images is a subset of `{0}`. -/
-@[elab_as_eliminator]
-theorem measurable.ennreal_induction {α} [measurable_space α] {P : (α → ℝ≥0∞) → Prop}
-  (h_ind : ∀ (c : ℝ≥0∞) ⦃s⦄, measurable_set s → P (indicator s (λ _, c)))
-  (h_add : ∀ ⦃f g : α → ℝ≥0∞⦄, disjoint (support f) (support g) → measurable f → measurable g →
-    P f → P g → P (f + g))
-  (h_supr : ∀ ⦃f : ℕ → α → ℝ≥0∞⦄ (hf : ∀n, measurable (f n)) (h_mono : monotone f)
-    (hP : ∀ n, P (f n)), P (λ x, ⨆ n, f n x))
-  ⦃f : α → ℝ≥0∞⦄ (hf : measurable f) : P f :=
-begin
-  convert h_supr (λ n, (eapprox f n).measurable) (monotone_eapprox f) _,
-  { ext1 x, rw [supr_eapprox_apply f hf] },
-  { exact λ n, simple_func.induction (λ c s hs, h_ind c hs)
-      (λ f g hfg hf hg, h_add hfg f.measurable g.measurable hf hg) (eapprox f n) }
-end
-
-namespace measure_theory
+open measure_theory.simple_func
 
-variables {α : Type*} {m m0 : measurable_space α}
+variables {m m0 : measurable_space α}
 
 include m
 
@@ -2398,7 +1757,7 @@ begin
   { intros g h h_univ h_mea_g h_mea_h h_ind_g h_ind_h,
     simp [mul_add, *, measurable.mul] },
   { intros g h_mea_g h_mono_g h_ind,
-    have : monotone (λ n a, f a * g n a) := λ m n hmn x, ennreal.mul_le_mul le_rfl (h_mono_g hmn x),
+    have : monotone (λ n a, f a * g n a) := λ m n hmn x, mul_le_mul_left' (h_mono_g hmn x) _,
     simp [lintegral_supr, ennreal.mul_supr, h_mf.mul (h_mea_g _), *] }
 end
 
@@ -2436,7 +1795,7 @@ begin
           (hf.measurable_mk (measurable_set_singleton 0).compl).compl,
         filter_upwards [ae_restrict_mem M],
         assume x hx,
-        simp only [not_not, mem_set_of_eq, mem_compl_eq] at hx,
+        simp only [not_not, mem_set_of_eq, mem_compl_iff] at hx,
         simp only [hx, zero_mul, pi.mul_apply] }
     end
   ... = ∫⁻ (a : α), (f * g) a ∂μ :
@@ -2459,7 +1818,7 @@ lemma lintegral_with_density_le_lintegral_mul (μ : measure α)
 begin
   rw [← supr_lintegral_measurable_le_eq_lintegral, ← supr_lintegral_measurable_le_eq_lintegral],
   refine supr₂_le (λ i i_meas, supr_le (λ hi, _)),
-  have A : f * i ≤ f * g := λ x, ennreal.mul_le_mul le_rfl (hi x),
+  have A : f * i ≤ f * g := λ x, mul_le_mul_left' (hi x) _,
   refine le_supr₂_of_le (f * i) (f_meas.mul i_meas) _,
   exact le_supr_of_le A (le_of_eq (lintegral_with_density_eq_lintegral_mul _ f_meas i_meas))
 end
@@ -2548,13 +1907,13 @@ begin
   have : ∀ n, μ (s n) < ∞,
     from λ n, (measure_mono $ disjointed_subset _ _).trans_lt (measure_spanning_sets_lt_top μ n),
   obtain ⟨δ, δpos, δsum⟩ : ∃ δ : ℕ → ℝ≥0, (∀ i, 0 < δ i) ∧ ∑' i, μ (s i) * δ i < ε,
-    from ennreal.exists_pos_tsum_mul_lt_of_encodable ε0 _ (λ n, (this n).ne),
+    from ennreal.exists_pos_tsum_mul_lt_of_countable ε0 _ (λ n, (this n).ne),
   set N : α → ℕ := spanning_sets_index μ,
   have hN_meas : measurable N := measurable_spanning_sets_index μ,
   have hNs : ∀ n, N ⁻¹' {n} = s n := preimage_spanning_sets_index_singleton μ,
   refine ⟨δ ∘ N, λ x, δpos _, measurable_from_nat.comp hN_meas, _⟩,
   simpa [lintegral_comp measurable_from_nat.coe_nnreal_ennreal hN_meas, hNs,
-    lintegral_encodable, measurable_spanning_sets_index, mul_comm] using δsum,
+    lintegral_countable', measurable_spanning_sets_index, mul_comm] using δsum,
 end
 
 lemma lintegral_trim {μ : measure α} (hm : m ≤ m0) {f : α → ℝ≥0∞} (hf : measurable[m] f) :
@@ -2567,8 +1926,8 @@ begin
     suffices h_trim_s : μ.trim hm s = μ s, by rw h_trim_s,
     exact trim_measurable_set_eq hm hs, },
   { intros f g hfg hf hg hf_prop hg_prop,
-    have h_m := lintegral_add hf hg,
-    have h_m0 := lintegral_add (measurable.mono hf hm le_rfl) (measurable.mono hg hm le_rfl),
+    have h_m := lintegral_add_left hf g,
+    have h_m0 := lintegral_add_left (measurable.mono hf hm le_rfl) g,
     rwa [hf_prop, hg_prop, ← h_m0] at h_m, },
   { intros f hf hf_mono hf_prop,
     rw lintegral_supr hf hf_mono,
@@ -2585,7 +1944,7 @@ by rw [lintegral_congr_ae (ae_eq_of_ae_eq_trim hf.ae_eq_mk),
 
 section sigma_finite
 
-variables {E : Type*} [normed_group E] [measurable_space E]
+variables {E : Type*} [normed_add_comm_group E] [measurable_space E]
   [opens_measurable_space E]
 
 lemma univ_le_of_forall_fin_meas_le {μ : measure α} (hm : m ≤ m0) [sigma_finite (μ.trim hm)]
@@ -2673,6 +2032,78 @@ lemma lintegral_le_of_forall_fin_meas_le [measurable_space α] {μ : measure α}
   ∫⁻ x, f x ∂μ ≤ C :=
 @lintegral_le_of_forall_fin_meas_le' _ _ _ _ _ (by rwa trim_eq_self) C _ hf_meas hf
 
+local infixr ` →ₛ `:25 := simple_func
+
+lemma simple_func.exists_lt_lintegral_simple_func_of_lt_lintegral
+  {m : measurable_space α} {μ : measure α} [sigma_finite μ] {f : α →ₛ ℝ≥0}
+  {L : ℝ≥0∞} (hL : L < ∫⁻ x, f x ∂μ) :
+  ∃ g : α →ₛ ℝ≥0, (∀ x, g x ≤ f x) ∧ (∫⁻ x, g x ∂μ < ∞) ∧ (L < ∫⁻ x, g x ∂μ) :=
+begin
+  induction f using measure_theory.simple_func.induction with c s hs f₁ f₂ H h₁ h₂ generalizing L,
+  { simp only [hs, const_zero, coe_piecewise, coe_const, simple_func.coe_zero, univ_inter,
+      piecewise_eq_indicator, lintegral_indicator, lintegral_const, measure.restrict_apply',
+      coe_indicator, function.const_apply] at hL,
+    have c_ne_zero : c ≠ 0,
+    { assume hc, simpa only [hc, ennreal.coe_zero, zero_mul, not_lt_zero] using hL },
+    have : L / c < μ s,
+    { rwa [ennreal.div_lt_iff, mul_comm],
+      { simp only [c_ne_zero, ne.def, coe_eq_zero, not_false_iff, true_or] },
+      { simp only [ne.def, coe_ne_top, not_false_iff, true_or] } },
+    obtain ⟨t, ht, ts, mut, t_top⟩ :
+      ∃ (t : set α), measurable_set t ∧ t ⊆ s ∧ L / ↑c < μ t ∧ μ t < ∞ :=
+        measure.exists_subset_measure_lt_top hs this,
+    refine ⟨piecewise t ht (const α c) (const α 0), λ x, _, _, _⟩,
+    { apply indicator_le_indicator_of_subset ts (λ x, _), exact zero_le _ },
+    { simp only [ht, const_zero, coe_piecewise, coe_const, simple_func.coe_zero, univ_inter,
+        piecewise_eq_indicator, coe_indicator, function.const_apply, lintegral_indicator,
+        lintegral_const, measure.restrict_apply', ennreal.mul_lt_top ennreal.coe_ne_top t_top.ne] },
+    { simp only [ht, const_zero, coe_piecewise, coe_const, simple_func.coe_zero,
+        piecewise_eq_indicator, coe_indicator, function.const_apply, lintegral_indicator,
+        lintegral_const, measure.restrict_apply', univ_inter],
+      rwa [mul_comm, ← ennreal.div_lt_iff],
+      { simp only [c_ne_zero, ne.def, coe_eq_zero, not_false_iff, true_or] },
+      { simp only [ne.def, coe_ne_top, not_false_iff, true_or] } } },
+  { replace hL : L < ∫⁻ x, f₁ x ∂μ + ∫⁻ x, f₂ x ∂μ,
+    { rwa ← lintegral_add_left f₁.measurable.coe_nnreal_ennreal },
+    by_cases hf₁ : ∫⁻ x, f₁ x ∂μ = 0,
+    { simp only [hf₁, zero_add] at hL,
+      rcases h₂ hL with ⟨g, g_le, g_top, gL⟩,
+      refine ⟨g, λ x, (g_le x).trans _, g_top, gL⟩,
+      simp only [simple_func.coe_add, pi.add_apply, le_add_iff_nonneg_left, zero_le'] },
+    by_cases hf₂ : ∫⁻ x, f₂ x ∂μ = 0,
+    { simp only [hf₂, add_zero] at hL,
+      rcases h₁ hL with ⟨g, g_le, g_top, gL⟩,
+      refine ⟨g, λ x, (g_le x).trans _, g_top, gL⟩,
+      simp only [simple_func.coe_add, pi.add_apply, le_add_iff_nonneg_right, zero_le'] },
+    obtain ⟨L₁, L₂, hL₁, hL₂, hL⟩ :
+      ∃ (L₁ L₂ : ℝ≥0∞), L₁ < ∫⁻ x, f₁ x ∂μ ∧ L₂ < ∫⁻ x, f₂ x ∂μ ∧ L < L₁ + L₂ :=
+      ennreal.exists_lt_add_of_lt_add hL hf₁ hf₂,
+    rcases h₁ hL₁ with ⟨g₁, g₁_le, g₁_top, hg₁⟩,
+    rcases h₂ hL₂ with ⟨g₂, g₂_le, g₂_top, hg₂⟩,
+    refine ⟨g₁ + g₂, λ x, add_le_add (g₁_le x) (g₂_le x), _, _⟩,
+    { apply lt_of_le_of_lt _ (add_lt_top.2 ⟨g₁_top, g₂_top⟩),
+      rw ← lintegral_add_left g₁.measurable.coe_nnreal_ennreal,
+      exact le_rfl },
+    { apply hL.trans ((ennreal.add_lt_add hg₁ hg₂).trans_le _),
+      rw ← lintegral_add_left g₁.measurable.coe_nnreal_ennreal,
+      exact le_rfl } }
+end
+
+lemma exists_lt_lintegral_simple_func_of_lt_lintegral
+  {m : measurable_space α} {μ : measure α} [sigma_finite μ] {f : α → ℝ≥0}
+  {L : ℝ≥0∞} (hL : L < ∫⁻ x, f x ∂μ) :
+  ∃ g : α →ₛ ℝ≥0, (∀ x, g x ≤ f x) ∧ (∫⁻ x, g x ∂μ < ∞) ∧ (L < ∫⁻ x, g x ∂μ) :=
+begin
+  simp_rw [lintegral_eq_nnreal, lt_supr_iff] at hL,
+  rcases hL with ⟨g₀, hg₀, g₀L⟩,
+  have h'L : L < ∫⁻ x, g₀ x ∂μ,
+  { convert g₀L,
+    rw ← simple_func.lintegral_eq_lintegral,
+    refl },
+  rcases simple_func.exists_lt_lintegral_simple_func_of_lt_lintegral h'L with ⟨g, hg, gL, gtop⟩,
+  exact ⟨g, λ x, (hg x).trans (coe_le_coe.1 (hg₀ x)), gL, gtop⟩,
+end
+
 /-- A sigma-finite measure is absolutely continuous with respect to some finite measure. -/
 lemma exists_absolutely_continuous_is_finite_measure
   {m : measurable_space α} (μ : measure α) [sigma_finite μ] :
@@ -2680,7 +2111,7 @@ lemma exists_absolutely_continuous_is_finite_measure
 begin
   obtain ⟨g, gpos, gmeas, hg⟩ : ∃ (g : α → ℝ≥0), (∀ (x : α), 0 < g x) ∧
     measurable g ∧ ∫⁻ (x : α), ↑(g x) ∂μ < 1 :=
-      exists_pos_lintegral_lt_of_sigma_finite μ (ennreal.zero_lt_one).ne',
+      exists_pos_lintegral_lt_of_sigma_finite μ one_ne_zero,
   refine ⟨μ.with_density (λ x, g x), is_finite_measure_with_density hg.ne_top, _⟩,
   have : μ = (μ.with_density (λ x, g x)).with_density (λ x, (g x)⁻¹),
   { have A : (λ (x : α), (g x : ℝ≥0∞)) * (λ (x : α), (↑(g x))⁻¹) = 1,
diff --git a/src/measure_theory/integral/lebesgue_normed_space.lean b/src/measure_theory/integral/lebesgue_normed_space.lean
new file mode 100644
index 0000000000000..04fc83750aa4b
--- /dev/null
+++ b/src/measure_theory/integral/lebesgue_normed_space.lean
@@ -0,0 +1,46 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import measure_theory.integral.lebesgue
+import analysis.normed_space.basic
+
+/-! # A lemma about measurability with density under scalar multiplication in normed spaces 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
+
+open measure_theory filter ennreal set
+open_locale nnreal ennreal
+variables {α β γ δ : Type*} {m : measurable_space α} {μ : measure_theory.measure α}
+
+lemma ae_measurable_with_density_iff {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [topological_space.second_countable_topology E] [measurable_space E] [borel_space E]
+  {f : α → ℝ≥0} (hf : measurable f) {g : α → E} :
+  ae_measurable g (μ.with_density (λ x, (f x : ℝ≥0∞))) ↔ ae_measurable (λ x, (f x : ℝ) • g x) μ :=
+begin
+  split,
+  { rintros ⟨g', g'meas, hg'⟩,
+    have A : measurable_set {x : α | f x ≠ 0} := (hf (measurable_set_singleton 0)).compl,
+    refine ⟨λ x, (f x : ℝ) • g' x, hf.coe_nnreal_real.smul g'meas, _⟩,
+    apply @ae_of_ae_restrict_of_ae_restrict_compl _ _ _ {x | f x ≠ 0},
+    { rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal] at hg',
+      rw ae_restrict_iff' A,
+      filter_upwards [hg'],
+      assume a ha h'a,
+      have : (f a : ℝ≥0∞) ≠ 0, by simpa only [ne.def, coe_eq_zero] using h'a,
+      rw ha this },
+    { filter_upwards [ae_restrict_mem A.compl],
+      assume x hx,
+      simp only [not_not, mem_set_of_eq, mem_compl_iff] at hx,
+      simp [hx] } },
+  { rintros ⟨g', g'meas, hg'⟩,
+    refine ⟨λ x, (f x : ℝ)⁻¹ • g' x, hf.coe_nnreal_real.inv.smul g'meas, _⟩,
+    rw [eventually_eq, ae_with_density_iff hf.coe_nnreal_ennreal],
+    filter_upwards [hg'],
+    assume x hx h'x,
+    rw [← hx, smul_smul, _root_.inv_mul_cancel, one_smul],
+    simp only [ne.def, coe_eq_zero] at h'x,
+    simpa only [nnreal.coe_eq_zero, ne.def] using h'x }
+end
diff --git a/src/measure_theory/integral/mean_inequalities.lean b/src/measure_theory/integral/mean_inequalities.lean
index c85c3758b7f58..970d8d1085a23 100644
--- a/src/measure_theory/integral/mean_inequalities.lean
+++ b/src/measure_theory/integral/mean_inequalities.lean
@@ -6,11 +6,14 @@ Authors: Rémy Degenne
 import measure_theory.integral.lebesgue
 import analysis.mean_inequalities
 import analysis.mean_inequalities_pow
-import measure_theory.function.special_functions
+import measure_theory.function.special_functions.basic
 
 /-!
 # Mean value inequalities for integrals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove several inequalities on integrals, notably the Hölder inequality and
 the Minkowski inequality. The versions for finite sums are in `analysis.mean_inequalities`.
 
@@ -49,8 +52,8 @@ variables {α : Type*} [measurable_space α] {μ : measure α}
 namespace ennreal
 
 lemma lintegral_mul_le_one_of_lintegral_rpow_eq_one {p q : ℝ} (hpq : p.is_conjugate_exponent q)
-  {f g : α → ℝ≥0∞} (hf : ae_measurable f μ) (hg : ae_measurable g μ)
-  (hf_norm : ∫⁻ a, (f a)^p ∂μ = 1) (hg_norm : ∫⁻ a, (g a)^q ∂μ = 1) :
+  {f g : α → ℝ≥0∞} (hf : ae_measurable f μ) (hf_norm : ∫⁻ a, (f a)^p ∂μ = 1)
+  (hg_norm : ∫⁻ a, (g a)^q ∂μ = 1) :
   ∫⁻ a, (f * g) a ∂μ ≤ 1 :=
 begin
   calc ∫⁻ (a : α), ((f * g) a) ∂μ
@@ -59,11 +62,11 @@ begin
   ... = 1 :
   begin
     simp only [div_eq_mul_inv],
-    rw lintegral_add',
-    { rw [lintegral_mul_const'' _ (hf.pow_const p), lintegral_mul_const'' _ (hg.pow_const q),
-        hf_norm, hg_norm, ← div_eq_mul_inv, ← div_eq_mul_inv, hpq.inv_add_inv_conj_ennreal], },
+    rw lintegral_add_left',
+    { rw [lintegral_mul_const'' _ (hf.pow_const p), lintegral_mul_const', hf_norm, hg_norm,
+        ← div_eq_mul_inv, ← div_eq_mul_inv, hpq.inv_add_inv_conj_ennreal],
+      simp [hpq.symm.pos], },
     { exact (hf.pow_const _).mul_const _, },
-    { exact (hg.pow_const _).mul_const _, },
   end
 end
 
@@ -74,7 +77,7 @@ def fun_mul_inv_snorm (f : α → ℝ≥0∞) (p : ℝ) (μ : measure α) : α 
 lemma fun_eq_fun_mul_inv_snorm_mul_snorm {p : ℝ} (f : α → ℝ≥0∞)
   (hf_nonzero : ∫⁻ a, (f a) ^ p ∂μ ≠ 0) (hf_top : ∫⁻ a, (f a) ^ p ∂μ ≠ ⊤) {a : α} :
   f a = (fun_mul_inv_snorm f p μ a) * (∫⁻ c, (f c)^p ∂μ)^(1/p) :=
-by simp [fun_mul_inv_snorm, mul_assoc, inv_mul_cancel, hf_nonzero, hf_top]
+by simp [fun_mul_inv_snorm, mul_assoc, ennreal.inv_mul_cancel, hf_nonzero, hf_top]
 
 lemma fun_mul_inv_snorm_rpow {p : ℝ} (hp0 : 0 < p) {f : α → ℝ≥0∞} {a : α} :
   (fun_mul_inv_snorm f p μ a) ^ p = (f a)^p * (∫⁻ c, (f c) ^ p ∂μ)⁻¹ :=
@@ -86,16 +89,17 @@ begin
 end
 
 lemma lintegral_rpow_fun_mul_inv_snorm_eq_one {p : ℝ} (hp0_lt : 0 < p) {f : α → ℝ≥0∞}
-  (hf : ae_measurable f μ) (hf_nonzero : ∫⁻ a, (f a)^p ∂μ ≠ 0) (hf_top : ∫⁻ a, (f a)^p ∂μ ≠ ⊤) :
+  (hf_nonzero : ∫⁻ a, (f a)^p ∂μ ≠ 0) (hf_top : ∫⁻ a, (f a)^p ∂μ ≠ ⊤) :
   ∫⁻ c, (fun_mul_inv_snorm f p μ c)^p ∂μ = 1 :=
 begin
   simp_rw fun_mul_inv_snorm_rpow hp0_lt,
-  rw [lintegral_mul_const'' _ (hf.pow_const p), mul_inv_cancel hf_nonzero hf_top],
+  rw [lintegral_mul_const', ennreal.mul_inv_cancel hf_nonzero hf_top],
+  rwa inv_ne_top
 end
 
 /-- Hölder's inequality in case of finite non-zero integrals -/
 lemma lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_ne_top {p q : ℝ} (hpq : p.is_conjugate_exponent q)
-  {f g : α → ℝ≥0∞} (hf : ae_measurable f μ) (hg : ae_measurable g μ)
+  {f g : α → ℝ≥0∞} (hf : ae_measurable f μ)
   (hf_nontop : ∫⁻ a, (f a)^p ∂μ ≠ ⊤) (hg_nontop : ∫⁻ a, (g a)^q ∂μ ≠ ⊤)
   (hf_nonzero : ∫⁻ a, (f a)^p ∂μ ≠ 0) (hg_nonzero : ∫⁻ a, (g a)^q ∂μ ≠ 0) :
   ∫⁻ a, (f * g) a ∂μ ≤ (∫⁻ a, (f a)^p ∂μ)^(1/p) * (∫⁻ a, (g a)^q ∂μ)^(1/q) :=
@@ -113,40 +117,35 @@ begin
   end
   ... ≤ npf * nqg :
   begin
-    rw lintegral_mul_const' (npf * nqg) _ (by simp [hf_nontop, hg_nontop, hf_nonzero, hg_nonzero]),
-    nth_rewrite 1 ←one_mul (npf * nqg),
-    refine mul_le_mul _ (le_refl (npf * nqg)),
-    have hf1 := lintegral_rpow_fun_mul_inv_snorm_eq_one hpq.pos hf hf_nonzero hf_nontop,
-    have hg1 := lintegral_rpow_fun_mul_inv_snorm_eq_one hpq.symm.pos hg hg_nonzero hg_nontop,
-    exact lintegral_mul_le_one_of_lintegral_rpow_eq_one hpq (hf.mul_const _)
-      (hg.mul_const _) hf1 hg1,
+    rw lintegral_mul_const' (npf * nqg) _
+      (by simp [hf_nontop, hg_nontop, hf_nonzero, hg_nonzero, ennreal.mul_eq_top]),
+    refine mul_le_of_le_one_left' _,
+    have hf1 := lintegral_rpow_fun_mul_inv_snorm_eq_one hpq.pos hf_nonzero hf_nontop,
+    have hg1 := lintegral_rpow_fun_mul_inv_snorm_eq_one hpq.symm.pos hg_nonzero hg_nontop,
+    exact lintegral_mul_le_one_of_lintegral_rpow_eq_one hpq (hf.mul_const _) hf1 hg1,
   end
 end
 
-lemma ae_eq_zero_of_lintegral_rpow_eq_zero {p : ℝ} (hp0_lt : 0 < p) {f : α → ℝ≥0∞}
+lemma ae_eq_zero_of_lintegral_rpow_eq_zero {p : ℝ} (hp0 : 0 ≤ p) {f : α → ℝ≥0∞}
   (hf : ae_measurable f μ) (hf_zero : ∫⁻ a, (f a)^p ∂μ = 0) :
   f =ᵐ[μ] 0 :=
 begin
   rw lintegral_eq_zero_iff' (hf.pow_const p) at hf_zero,
   refine filter.eventually.mp hf_zero (filter.eventually_of_forall (λ x, _)),
   dsimp only,
-  rw [pi.zero_apply, rpow_eq_zero_iff],
-  intro hx,
-  cases hx,
-  { exact hx.left, },
-  { exfalso,
-    linarith, },
+  rw [pi.zero_apply, ← not_imp_not],
+  exact λ hx, (rpow_pos_of_nonneg (pos_iff_ne_zero.2 hx) hp0).ne'
 end
 
-lemma lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero {p : ℝ} (hp0_lt : 0 < p)
+lemma lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero {p : ℝ} (hp0 : 0 ≤ p)
   {f g : α → ℝ≥0∞} (hf : ae_measurable f μ) (hf_zero : ∫⁻ a, (f a)^p ∂μ = 0) :
   ∫⁻ a, (f * g) a ∂μ = 0 :=
 begin
   rw ←@lintegral_zero_fun α _ μ,
   refine lintegral_congr_ae _,
   suffices h_mul_zero : f * g =ᵐ[μ] 0 * g , by rwa zero_mul at h_mul_zero,
-  have hf_eq_zero : f =ᵐ[μ] 0, from ae_eq_zero_of_lintegral_rpow_eq_zero hp0_lt hf hf_zero,
-  exact filter.eventually_eq.mul hf_eq_zero (ae_eq_refl g),
+  have hf_eq_zero : f =ᵐ[μ] 0, from ae_eq_zero_of_lintegral_rpow_eq_zero hp0 hf hf_zero,
+  exact hf_eq_zero.mul (ae_eq_refl g),
 end
 
 lemma lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_eq_top {p q : ℝ} (hp0_lt : 0 < p) (hq0 : 0 ≤ q)
@@ -167,25 +166,24 @@ theorem lintegral_mul_le_Lp_mul_Lq (μ : measure α) {p q : ℝ} (hpq : p.is_con
   ∫⁻ a, (f * g) a ∂μ ≤ (∫⁻ a, (f a)^p ∂μ) ^ (1/p) * (∫⁻ a, (g a)^q ∂μ) ^ (1/q) :=
 begin
   by_cases hf_zero : ∫⁻ a, (f a) ^ p ∂μ = 0,
-  { refine le_trans (le_of_eq _) (zero_le _),
-    exact lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero hpq.pos hf hf_zero, },
+  { refine eq.trans_le _ (zero_le _),
+    exact lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero hpq.nonneg hf hf_zero, },
   by_cases hg_zero : ∫⁻ a, (g a) ^ q ∂μ = 0,
-  { refine le_trans (le_of_eq _) (zero_le _),
+  { refine eq.trans_le _ (zero_le _),
     rw mul_comm,
-    exact lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero hpq.symm.pos hg hg_zero, },
+    exact lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero hpq.symm.nonneg hg hg_zero, },
   by_cases hf_top : ∫⁻ a, (f a) ^ p ∂μ = ⊤,
   { exact lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_eq_top hpq.pos hpq.symm.nonneg hf_top hg_zero, },
   by_cases hg_top : ∫⁻ a, (g a) ^ q ∂μ = ⊤,
   { rw [mul_comm, mul_comm ((∫⁻ (a : α), (f a) ^ p ∂μ) ^ (1 / p))],
     exact lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_eq_top hpq.symm.pos hpq.nonneg hg_top hf_zero, },
   -- non-⊤ non-zero case
-  exact ennreal.lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_ne_top hpq hf hg hf_top hg_top hf_zero
-    hg_zero,
+  exact ennreal.lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_ne_top hpq hf hf_top hg_top hf_zero hg_zero
 end
 
 lemma lintegral_rpow_add_lt_top_of_lintegral_rpow_lt_top {p : ℝ}
   {f g : α → ℝ≥0∞} (hf : ae_measurable f μ) (hf_top : ∫⁻ a, (f a) ^ p ∂μ < ⊤)
-  (hg : ae_measurable g μ) (hg_top : ∫⁻ a, (g a) ^ p ∂μ < ⊤) (hp1 : 1 ≤ p) :
+  (hg_top : ∫⁻ a, (g a) ^ p ∂μ < ⊤) (hp1 : 1 ≤ p) :
   ∫⁻ a, ((f + g) a) ^ p ∂μ < ⊤ :=
 begin
   have hp0_lt : 0 < p, from lt_of_lt_of_le zero_lt_one hp1,
@@ -199,31 +197,29 @@ begin
     { rw [←ennreal.zero_rpow_of_pos hp0_lt],
       exact ennreal.rpow_lt_rpow (by simp [zero_lt_one]) hp0_lt, },
     have h_rw : (1 / 2) ^ p * (2:ℝ≥0∞) ^ (p - 1) = 1 / 2,
-    { rw [sub_eq_add_neg, ennreal.rpow_add _ _ ennreal.two_ne_zero ennreal.coe_ne_top,
+    { rw [sub_eq_add_neg, ennreal.rpow_add _ _ two_ne_zero ennreal.coe_ne_top,
         ←mul_assoc, ←ennreal.mul_rpow_of_nonneg _ _ hp0, one_div,
-        ennreal.inv_mul_cancel ennreal.two_ne_zero ennreal.coe_ne_top, ennreal.one_rpow,
+        ennreal.inv_mul_cancel two_ne_zero ennreal.coe_ne_top, ennreal.one_rpow,
         one_mul, ennreal.rpow_neg_one], },
     rw ←ennreal.mul_le_mul_left (ne_of_lt h_zero_lt_half_rpow).symm _,
     { rw [mul_add, ← mul_assoc, ← mul_assoc, h_rw, ←ennreal.mul_rpow_of_nonneg _ _ hp0, mul_add],
       refine ennreal.rpow_arith_mean_le_arith_mean2_rpow (1/2 : ℝ≥0∞) (1/2 : ℝ≥0∞)
         (f a) (g a) _ hp1,
       rw [ennreal.div_add_div_same, one_add_one_eq_two,
-        ennreal.div_self ennreal.two_ne_zero ennreal.coe_ne_top], },
+        ennreal.div_self two_ne_zero ennreal.coe_ne_top], },
     { rw ← lt_top_iff_ne_top,
       refine ennreal.rpow_lt_top_of_nonneg hp0 _,
       rw [one_div, ennreal.inv_ne_top],
-      exact ennreal.two_ne_zero, },
+      exact two_ne_zero, },
   end
   ... < ⊤ :
   begin
-    rw [lintegral_add', lintegral_const_mul'' _ (hf.pow_const p),
-      lintegral_const_mul'' _ (hg.pow_const p), ennreal.add_lt_top],
-    { have h_two : (2 : ℝ≥0∞) ^ (p - 1) < ⊤,
-      from ennreal.rpow_lt_top_of_nonneg (by simp [hp1]) ennreal.coe_ne_top,
-      repeat {rw ennreal.mul_lt_top_iff},
-      simp [hf_top, hg_top, h_two], },
-    { exact (hf.pow_const _).const_mul _ },
-    { exact (hg.pow_const _).const_mul _ },
+    have h_two : (2 : ℝ≥0∞) ^ (p - 1) ≠ ⊤,
+      from ennreal.rpow_ne_top_of_nonneg (by simp [hp1]) ennreal.coe_ne_top,
+    rw [lintegral_add_left', lintegral_const_mul'' _ (hf.pow_const p),
+      lintegral_const_mul' _ _ h_two, ennreal.add_lt_top],
+    { exact ⟨ennreal.mul_lt_top h_two hf_top.ne, ennreal.mul_lt_top h_two hg_top.ne⟩ },
+    { exact (hf.pow_const p).const_mul _ }
   end
 end
 
@@ -264,7 +260,7 @@ begin
     have hpq2 : p * q2 = r,
     { rw [← inv_inv r, ← one_div, ← one_div, h_one_div_r],
       field_simp [q2, real.conjugate_exponent, p2, hp0_ne, hq0_ne] },
-    simp_rw [div_mul_div_comm₀, mul_one, mul_comm p2, mul_comm q2, hpp2, hpq2],
+    simp_rw [div_mul_div_comm, mul_one, mul_comm p2, mul_comm q2, hpp2, hpq2],
   end
 end
 
@@ -317,7 +313,7 @@ begin
       = ∫⁻ (a : α), (f a + g a) * (f + g) a ^ (p - 1) ∂μ,
     from rfl,
     simp_rw [h_add_apply, add_mul],
-    rw lintegral_add' (hf.mul h_add_m) (hg.mul h_add_m),
+    rw lintegral_add_left' (hf.mul h_add_m),
   end
     ... ≤ ((∫⁻ a, (f a)^p ∂μ) ^ (1/p) + (∫⁻ a, (g a)^p ∂μ) ^ (1/p))
       * (∫⁻ a, (f a + g a)^p ∂μ) ^ (1/q) :
@@ -371,7 +367,7 @@ begin
   by_cases h1 : p = 1,
   { refine le_of_eq _,
     simp_rw [h1, one_div_one, ennreal.rpow_one],
-    exact lintegral_add' hf hg, },
+    exact lintegral_add_left' hf _, },
   have hp1_lt : 1 < p, by { refine lt_of_le_of_ne hp1 _, symmetry, exact h1, },
   have hpq := real.is_conjugate_exponent_conjugate_exponent hp1_lt,
   by_cases h0 : ∫⁻ a, ((f+g) a) ^ p ∂ μ = 0,
@@ -380,10 +376,33 @@ begin
   have htop : ∫⁻ a, ((f+g) a) ^ p ∂ μ ≠ ⊤,
   { rw ← ne.def at hf_top hg_top,
     rw ← lt_top_iff_ne_top at hf_top hg_top ⊢,
-    exact lintegral_rpow_add_lt_top_of_lintegral_rpow_lt_top hf hf_top hg hg_top hp1, },
+    exact lintegral_rpow_add_lt_top_of_lintegral_rpow_lt_top hf hf_top hg_top hp1, },
   exact lintegral_Lp_add_le_aux hpq hf hf_top hg hg_top h0 htop,
 end
 
+/-- Variant of Minkowski's inequality for functions `α → ℝ≥0∞` in `ℒp` with `p ≤ 1`: the `ℒp`
+seminorm of the sum of two functions is bounded by a constant multiple of the sum
+of their `ℒp` seminorms. -/
+theorem lintegral_Lp_add_le_of_le_one {p : ℝ} {f g : α → ℝ≥0∞}
+  (hf : ae_measurable f μ) (hp0 : 0 ≤ p) (hp1 : p ≤ 1) :
+  (∫⁻ a, ((f + g) a)^p ∂ μ) ^ (1/p) ≤
+    2^(1/p-1) * ((∫⁻ a, (f a)^p ∂μ) ^ (1/p) + (∫⁻ a, (g a)^p ∂μ) ^ (1/p)) :=
+begin
+  rcases eq_or_lt_of_le hp0 with rfl|hp,
+  { simp only [pi.add_apply, rpow_zero, lintegral_one, _root_.div_zero, zero_sub],
+    norm_num,
+    rw [rpow_neg, rpow_one, ennreal.inv_mul_cancel two_ne_zero two_ne_top],
+    exact le_rfl },
+  calc (∫⁻ a, (f + g) a ^ p ∂μ) ^ (1 / p) ≤ (∫⁻ a, (f a)^p ∂ μ + ∫⁻ a, (g a)^p ∂ μ) ^ (1/p) :
+    begin
+      apply rpow_le_rpow _ (div_nonneg zero_le_one hp0),
+      rw ← lintegral_add_left' (hf.pow_const p),
+      exact lintegral_mono (λ a, rpow_add_le_add_rpow _ _ hp0 hp1)
+    end
+  ... ≤ 2 ^ (1/p-1) * ((∫⁻ a, f a ^ p ∂μ) ^ (1/p) + (∫⁻ a, g a ^ p ∂μ) ^ (1/p)) :
+    rpow_add_le_mul_rpow_add_rpow _ _ ((one_le_div hp).2 hp1)
+end
+
 end ennreal
 
 /-- Hölder's inequality for functions `α → ℝ≥0`. The integral of the product of two functions
diff --git a/src/measure_theory/integral/peak_function.lean b/src/measure_theory/integral/peak_function.lean
new file mode 100644
index 0000000000000..0436fb4cce815
--- /dev/null
+++ b/src/measure_theory/integral/peak_function.lean
@@ -0,0 +1,346 @@
+/-
+Copyright (c) 2023 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import measure_theory.integral.set_integral
+import measure_theory.function.locally_integrable
+
+/-!
+# Integrals against peak functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A sequence of peak functions is a sequence of functions with average one concentrating around
+a point `x₀`. Given such a sequence `φₙ`, then `∫ φₙ g` tends to `g x₀` in many situations, with
+a whole zoo of possible assumptions on `φₙ` and `g`. This file is devoted to such results.
+
+## Main results
+
+* `tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at`: If a sequence of peak
+  functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
+  `g` is integrable and continuous at `x₀`, then `∫ φᵢ • g` converges to `g x₀`.
+* `tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`:
+  If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
+  then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
+  concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀`
+  if `g` is continuous on `s`.
+
+Note that there are related results about convolution with respect to peak functions in the file
+`analysis.convolution`, such as `convolution_tendsto_right` there.
+-/
+
+open set filter measure_theory measure_theory.measure topological_space metric
+open_locale topology ennreal
+
+/-- This lemma exists for finsets, but not for sets currently. porting note: move to
+data.set.basic after the port. -/
+lemma set.disjoint_sdiff_inter {α : Type*} (s t : set α) : disjoint (s \ t) (s ∩ t) :=
+disjoint_of_subset_right (inter_subset_right _ _) disjoint_sdiff_left
+
+open set
+
+variables {α E ι : Type*} {hm : measurable_space α} {μ : measure α}
+  [topological_space α] [borel_space α]
+  [normed_add_comm_group E] [normed_space ℝ E]
+  {g : α → E} {l : filter ι} {x₀ : α} {s : set α} {φ : ι → α → ℝ}
+
+/-- If a sequence of peak functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
+`g` is integrable and continuous at `x₀`, then `φᵢ • g` is eventually integrable. -/
+lemma integrable_on_peak_smul_of_integrable_on_of_continuous_within_at
+  (hs : measurable_set s)
+  (hlφ : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 l (s \ u))
+  (hiφ : ∀ᶠ i in l, ∫ x in s, φ i x ∂μ = 1)
+  (hmg : integrable_on g s μ)
+  (hcg : continuous_within_at g s x₀) :
+  ∀ᶠ i in l, integrable_on (λ x, φ i x • g x) s μ :=
+begin
+  obtain ⟨u, u_open, x₀u, hu⟩ : ∃ u, is_open u ∧ x₀ ∈ u ∧ ∀ x ∈ u ∩ s, g x ∈ ball (g x₀) 1,
+    from mem_nhds_within.1 (hcg (ball_mem_nhds _ zero_lt_one)),
+  filter_upwards [tendsto_uniformly_on_iff.1 (hlφ u u_open x₀u) 1 zero_lt_one, hiφ]
+    with i hi h'i,
+  have A : integrable_on (λ x, φ i x • g x) (s \ u) μ,
+  { refine integrable.smul_of_top_right (hmg.mono (diff_subset _ _) le_rfl) _,
+    apply mem_ℒp_top_of_bound
+      ((integrable_of_integral_eq_one h'i).ae_strongly_measurable.mono_set ((diff_subset _ _))) 1,
+    filter_upwards [self_mem_ae_restrict (hs.diff u_open.measurable_set)] with x hx,
+    simpa only [pi.zero_apply, dist_zero_left] using (hi x hx).le },
+  have B : integrable_on (λ x, φ i x • g x) (s ∩ u) μ,
+  { apply integrable.smul_of_top_left,
+    { exact integrable_on.mono_set (integrable_of_integral_eq_one h'i) (inter_subset_left _ _) },
+    { apply mem_ℒp_top_of_bound (hmg.mono_set (inter_subset_left _ _)).ae_strongly_measurable
+        (‖g x₀‖ + 1),
+      filter_upwards [self_mem_ae_restrict (hs.inter u_open.measurable_set)] with x hx,
+      rw inter_comm at hx,
+      exact (norm_lt_of_mem_ball (hu x hx)).le } },
+  convert A.union B,
+  simp only [diff_union_inter],
+end
+
+variables [complete_space E]
+
+/-- If a sequence of peak functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
+`g` is integrable and continuous at `x₀`, then `∫ φᵢ • g` converges to `x₀`. Auxiliary lemma
+where one assumes additionally `g x₀ = 0`. -/
+lemma tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at_aux
+  (hs : measurable_set s)
+  (hnφ : ∀ᶠ i in l, ∀ x ∈ s, 0 ≤ φ i x)
+  (hlφ : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 l (s \ u))
+  (hiφ : ∀ᶠ i in l, ∫ x in s, φ i x ∂μ = 1)
+  (hmg : integrable_on g s μ) (h'g : g x₀ = 0)
+  (hcg : continuous_within_at g s x₀) :
+  tendsto (λ i : ι, ∫ x in s, φ i x • g x ∂μ) l (𝓝 0) :=
+begin
+  refine metric.tendsto_nhds.2 (λ ε εpos, _),
+  obtain ⟨δ, hδ, δpos⟩ : ∃ δ, δ * ∫ x in s, ‖g x‖ ∂μ + δ < ε ∧ 0 < δ,
+  { have A : tendsto (λ δ, δ * ∫ x in s, ‖g x‖ ∂μ + δ) (𝓝[>] 0) (𝓝 (0 * ∫ x in s, ‖g x‖ ∂μ + 0)),
+    { apply tendsto.mono_left _ nhds_within_le_nhds,
+      exact (tendsto_id.mul tendsto_const_nhds).add tendsto_id },
+    rw [zero_mul, zero_add] at A,
+    exact (((tendsto_order.1 A).2 ε εpos).and self_mem_nhds_within).exists },
+  suffices : ∀ᶠ i in l, ‖∫ x in s, φ i x • g x ∂μ‖ ≤ δ * ∫ x in s, ‖g x‖ ∂μ + δ,
+  { filter_upwards [this] with i hi,
+    simp only [dist_zero_right],
+    exact hi.trans_lt hδ },
+  obtain ⟨u, u_open, x₀u, hu⟩ : ∃ u, is_open u ∧ x₀ ∈ u ∧ ∀ x ∈ u ∩ s, g x ∈ ball (g x₀) δ,
+    from mem_nhds_within.1 (hcg (ball_mem_nhds _ δpos)),
+  filter_upwards [tendsto_uniformly_on_iff.1 (hlφ u u_open x₀u) δ δpos, hiφ, hnφ,
+    integrable_on_peak_smul_of_integrable_on_of_continuous_within_at hs hlφ hiφ hmg hcg]
+      with i hi h'i hφpos h''i,
+  have B : ‖∫ x in s ∩ u, φ i x • g x ∂μ‖ ≤ δ, from calc
+    ‖∫ x in s ∩ u, φ i x • g x ∂μ‖ ≤ ∫ x in s ∩ u, ‖φ i x • g x‖ ∂μ :
+      norm_integral_le_integral_norm _
+    ... ≤ ∫ x in s ∩ u, ‖φ i x‖ * δ ∂μ :
+      begin
+        refine set_integral_mono_on _ _ (hs.inter u_open.measurable_set) (λ x hx, _),
+        { exact integrable_on.mono_set h''i.norm (inter_subset_left _ _) },
+        { exact integrable_on.mono_set ((integrable_of_integral_eq_one h'i).norm.mul_const _)
+            (inter_subset_left _ _) },
+        rw norm_smul,
+        apply mul_le_mul_of_nonneg_left _ (norm_nonneg _),
+        rw [inter_comm, h'g] at hu,
+        exact (mem_ball_zero_iff.1 (hu x hx)).le,
+      end
+    ... ≤ ∫ x in s, ‖φ i x‖ * δ ∂μ :
+      begin
+        apply set_integral_mono_set,
+        { exact ((integrable_of_integral_eq_one h'i).norm.mul_const _) },
+        { exact eventually_of_forall (λ x, mul_nonneg (norm_nonneg _) δpos.le) },
+        { apply eventually_of_forall, exact inter_subset_left s u }
+      end
+    ... = ∫ x in s, φ i x * δ ∂μ :
+      begin
+        apply set_integral_congr hs (λ x hx, _),
+        rw real.norm_of_nonneg (hφpos _ hx),
+      end
+    ... = δ : by rw [integral_mul_right, h'i, one_mul],
+  have C : ‖∫ x in s \ u, φ i x • g x ∂μ‖ ≤ δ * ∫ x in s, ‖g x‖ ∂μ, from calc
+    ‖∫ x in s \ u, φ i x • g x ∂μ‖ ≤ ∫ x in s \ u, ‖φ i x • g x‖ ∂μ :
+      norm_integral_le_integral_norm _
+    ... ≤ ∫ x in s \ u, δ * ‖g x‖ ∂μ :
+      begin
+        refine set_integral_mono_on _ _ (hs.diff u_open.measurable_set) (λ x hx, _),
+        { exact integrable_on.mono_set h''i.norm (diff_subset _ _) },
+        { exact integrable_on.mono_set (hmg.norm.const_mul _) (diff_subset _ _) },
+        rw norm_smul,
+        apply mul_le_mul_of_nonneg_right _ (norm_nonneg _),
+        simpa only [pi.zero_apply, dist_zero_left] using (hi x hx).le,
+      end
+    ... ≤ δ * ∫ x in s, ‖g x‖ ∂μ :
+      begin
+        rw integral_mul_left,
+        apply mul_le_mul_of_nonneg_left (set_integral_mono_set hmg.norm _ _) δpos.le,
+        { exact eventually_of_forall (λ x, norm_nonneg _) },
+        { apply eventually_of_forall, exact diff_subset s u }
+      end,
+  calc
+  ‖∫ x in s, φ i x • g x ∂μ‖ = ‖∫ x in s \ u, φ i x • g x ∂μ + ∫ x in s ∩ u, φ i x • g x ∂μ‖ :
+    begin
+      conv_lhs { rw ← diff_union_inter s u },
+      rw integral_union (disjoint_sdiff_inter _ _) (hs.inter u_open.measurable_set)
+        (h''i.mono_set (diff_subset _ _)) (h''i.mono_set (inter_subset_left _ _))
+    end
+  ... ≤ ‖∫ x in s \ u, φ i x • g x ∂μ‖ + ‖∫ x in s ∩ u, φ i x • g x ∂μ‖ : norm_add_le _ _
+  ... ≤ δ * ∫ x in s, ‖g x‖ ∂μ + δ : add_le_add C B
+end
+
+/- If a sequence of peak functions `φᵢ` converges uniformly to zero away from a point `x₀`, and
+`g` is integrable and continuous at `x₀`, then `∫ φᵢ • g` converges to `x₀`. -/
+lemma tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at
+  (hs : measurable_set s) (h's : μ s ≠ ∞)
+  (hnφ : ∀ᶠ i in l, ∀ x ∈ s, 0 ≤ φ i x)
+  (hlφ : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 l (s \ u))
+  (hiφ : (λ i, ∫ x in s, φ i x ∂μ) =ᶠ[l] 1)
+  (hmg : integrable_on g s μ)
+  (hcg : continuous_within_at g s x₀) :
+  tendsto (λ i : ι, ∫ x in s, φ i x • g x ∂μ) l (𝓝 (g x₀)) :=
+begin
+  let h := g - (λ y, g x₀),
+  have A : tendsto (λ i : ι, ∫ x in s, φ i x • h x ∂μ + (∫ x in s, φ i x ∂μ) • g x₀) l
+    (𝓝 (0 + (1 : ℝ) • g x₀)),
+  { refine tendsto.add _ (tendsto.smul (tendsto_const_nhds.congr' hiφ.symm) tendsto_const_nhds),
+    apply tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at_aux
+      hs hnφ hlφ hiφ,
+    { apply integrable.sub hmg,
+      apply integrable_on_const.2,
+      simp only [h's.lt_top, or_true] },
+    { simp only [h, pi.sub_apply, sub_self] },
+    { exact hcg.sub continuous_within_at_const } },
+  simp only [one_smul, zero_add] at A,
+  refine tendsto.congr' _ A,
+  filter_upwards [integrable_on_peak_smul_of_integrable_on_of_continuous_within_at
+    hs hlφ hiφ hmg hcg, hiφ] with i hi h'i,
+  simp only [h, pi.sub_apply, smul_sub],
+  rw [integral_sub hi, integral_smul_const, sub_add_cancel],
+  exact integrable.smul_const (integrable_of_integral_eq_one h'i) _,
+end
+
+/-- If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
+then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
+concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀` if `g` is
+integrable on `s` and continuous at `x₀`.
+
+Version assuming that `μ` gives positive mass to all neighborhoods of `x₀` within `s`.
+For a less precise but more usable version, see
+`tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`.
+ -/
+lemma tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_measure_nhds_within_pos
+  [metrizable_space α] [is_locally_finite_measure μ] (hs : is_compact s)
+  (hμ : ∀ u, is_open u → x₀ ∈ u → 0 < μ (u ∩ s))
+  {c : α → ℝ} (hc : continuous_on c s) (h'c : ∀ y ∈ s, y ≠ x₀ → c y < c x₀)
+  (hnc : ∀ x ∈ s, 0 ≤ c x) (hnc₀ : 0 < c x₀) (h₀ : x₀ ∈ s)
+  (hmg : integrable_on g s μ)
+  (hcg : continuous_within_at g s x₀) :
+  tendsto (λ (n : ℕ), (∫ x in s, (c x) ^ n ∂μ)⁻¹ • (∫ x in s, (c x) ^ n • g x ∂μ)) at_top
+    (𝓝 (g x₀)) :=
+begin
+  /- We apply the general result
+  `tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at` to the sequence of
+  peak functions `φₙ = (c x) ^ n / ∫ (c x) ^ n`. The only nontrivial bit is to check that this
+  sequence converges uniformly to zero on any set `s \ u` away from `x₀`. By compactness, the
+  function `c` is bounded by `t < c x₀` there. Consider `t' ∈ (t, c x₀)`, and a neighborhood `v`
+  of `x₀` where `c x ≥ t'`, by continuity. Then `∫ (c x) ^ n` is bounded below by `t' ^ n μ v`.
+  It follows that, on `s \ u`, then `φₙ x ≤ t ^ n / (t' ^ n μ v)`, which tends (exponentially fast)
+  to zero with `n`. -/
+  let φ : ℕ → α → ℝ := λ n x, (∫ x in s, (c x) ^ n ∂μ)⁻¹ * (c x) ^ n,
+  have hnφ : ∀ n, ∀ x ∈ s, 0 ≤ φ n x,
+  { assume n x hx,
+    apply mul_nonneg (inv_nonneg.2 _) (pow_nonneg (hnc x hx) _),
+    exact set_integral_nonneg hs.measurable_set (λ x hx, pow_nonneg (hnc x hx) _) },
+  have I : ∀ n, integrable_on (λ x, (c x)^n) s μ :=
+    λ n, continuous_on.integrable_on_compact hs (hc.pow n),
+  have J : ∀ n, 0 ≤ᵐ[μ.restrict s] λ (x : α), c x ^ n,
+  { assume n,
+    filter_upwards [ae_restrict_mem hs.measurable_set] with x hx,
+    exact pow_nonneg (hnc x hx) n },
+  have P : ∀ n, 0 < ∫ x in s, (c x) ^ n ∂μ,
+  { assume n,
+    refine (set_integral_pos_iff_support_of_nonneg_ae (J n) (I n)).2 _,
+    obtain ⟨u, u_open, x₀_u, hu⟩ : ∃ (u : set α), is_open u ∧ x₀ ∈ u ∧ u ∩ s ⊆ c ⁻¹' Ioi 0 :=
+      _root_.continuous_on_iff.1 hc x₀ h₀ (Ioi (0 : ℝ)) is_open_Ioi hnc₀,
+    apply (hμ u u_open x₀_u).trans_le,
+    exact measure_mono (λ x hx, ⟨ne_of_gt (pow_pos (hu hx) _), hx.2⟩) },
+  have hiφ : ∀ n, ∫ x in s, φ n x ∂μ = 1 :=
+    λ n, by rw [integral_mul_left, inv_mul_cancel (P n).ne'],
+  have A : ∀ (u : set α), is_open u → x₀ ∈ u → tendsto_uniformly_on φ 0 at_top (s \ u),
+  { assume u u_open x₀u,
+    obtain ⟨t, t_pos, tx₀, ht⟩ : ∃ t, 0 ≤ t ∧ t < c x₀ ∧ (∀ x ∈ s \ u, c x ≤ t),
+    { rcases eq_empty_or_nonempty (s \ u) with h|h,
+      { exact ⟨0, le_rfl, hnc₀,
+          by simp only [h, mem_empty_iff_false, is_empty.forall_iff, implies_true_iff]⟩ },
+      obtain ⟨x, hx, h'x⟩ : ∃ x ∈ s \ u, ∀ y ∈ s \ u, c y ≤ c x :=
+        is_compact.exists_forall_ge (hs.diff u_open) h (hc.mono (diff_subset _ _)),
+      refine ⟨c x, hnc x hx.1, h'c x hx.1 _, h'x⟩,
+      rintros rfl,
+      exact hx.2 x₀u },
+    obtain ⟨t', tt', t'x₀⟩ : ∃ t', t < t' ∧ t' < c x₀ := exists_between tx₀,
+    have t'_pos : 0 < t' := t_pos.trans_lt tt',
+    obtain ⟨v, v_open, x₀_v, hv⟩ : ∃ (v : set α), is_open v ∧ x₀ ∈ v ∧ v ∩ s ⊆ c ⁻¹' Ioi t' :=
+      _root_.continuous_on_iff.1 hc x₀ h₀ (Ioi t') is_open_Ioi t'x₀,
+    have M : ∀ n, ∀ x ∈ s \ u, φ n x ≤ (μ (v ∩ s)).to_real ⁻¹ * (t / t') ^ n,
+    { assume n x hx,
+      have B : t' ^ n * (μ (v ∩ s)).to_real ≤ ∫ y in s, (c y) ^ n ∂μ, from calc
+        t' ^ n * (μ (v ∩ s)).to_real = ∫ y in v ∩ s, t' ^ n ∂μ :
+          by simp only [integral_const, measure.restrict_apply, measurable_set.univ, univ_inter,
+              algebra.id.smul_eq_mul, mul_comm]
+        ... ≤ ∫ y in v ∩ s, (c y) ^ n ∂μ :
+          begin
+            apply set_integral_mono_on _ _ (v_open.measurable_set.inter hs.measurable_set) _,
+            { apply integrable_on_const.2 (or.inr _),
+              exact lt_of_le_of_lt (measure_mono (inter_subset_right _ _)) hs.measure_lt_top },
+            { exact (I n).mono (inter_subset_right _ _) le_rfl },
+            { assume x hx,
+              exact pow_le_pow_of_le_left t'_pos.le (le_of_lt (hv hx)) _ }
+          end
+        ... ≤ ∫ y in s, (c y) ^ n ∂μ :
+          set_integral_mono_set (I n) (J n) (eventually_of_forall (inter_subset_right _ _)),
+      simp_rw [φ, ← div_eq_inv_mul, div_pow, div_div],
+      apply div_le_div (pow_nonneg t_pos n) _ _ B,
+      { exact pow_le_pow_of_le_left (hnc _ hx.1) (ht x hx) _ },
+      { apply mul_pos (pow_pos (t_pos.trans_lt tt') _)
+          (ennreal.to_real_pos (hμ v v_open x₀_v).ne' _),
+        have : μ (v ∩ s) ≤ μ s := measure_mono (inter_subset_right _ _),
+        exact ne_of_lt (lt_of_le_of_lt this hs.measure_lt_top) } },
+    have N : tendsto (λ n, (μ (v ∩ s)).to_real ⁻¹ * (t / t') ^ n) at_top
+      (𝓝 ((μ (v ∩ s)).to_real ⁻¹ * 0)),
+    { apply tendsto.mul tendsto_const_nhds _, { apply_instance },
+      apply tendsto_pow_at_top_nhds_0_of_lt_1 (div_nonneg t_pos t'_pos.le),
+      exact (div_lt_one t'_pos).2 tt' },
+    rw mul_zero at N,
+    refine tendsto_uniformly_on_iff.2 (λ ε εpos, _),
+    filter_upwards [(tendsto_order.1 N).2 ε εpos] with n hn x hx,
+    simp only [pi.zero_apply, dist_zero_left, real.norm_of_nonneg (hnφ n x hx.1)],
+    exact (M n x hx).trans_lt hn },
+  have : tendsto (λ (i : ℕ), ∫ (x : α) in s, φ i x • g x ∂μ) at_top (𝓝 (g x₀)) :=
+    tendsto_set_integral_peak_smul_of_integrable_on_of_continuous_within_at hs.measurable_set
+      hs.measure_lt_top.ne (eventually_of_forall hnφ) A (eventually_of_forall hiφ) hmg hcg,
+  convert this,
+  simp_rw [← smul_smul, integral_smul],
+end
+
+/-- If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
+then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
+concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀` if `g` is
+integrable on `s` and continuous at `x₀`.
+
+Version assuming that `μ` gives positive mass to all open sets.
+For a less precise but more usable version, see
+`tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on`.
+-/
+lemma tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_integrable_on
+  [metrizable_space α] [is_locally_finite_measure μ] [is_open_pos_measure μ] (hs : is_compact s)
+  {c : α → ℝ} (hc : continuous_on c s) (h'c : ∀ y ∈ s, y ≠ x₀ → c y < c x₀)
+  (hnc : ∀ x ∈ s, 0 ≤ c x) (hnc₀ : 0 < c x₀) (h₀ : x₀ ∈ closure (interior s))
+  (hmg : integrable_on g s μ)
+  (hcg : continuous_within_at g s x₀) :
+  tendsto (λ (n : ℕ), (∫ x in s, (c x) ^ n ∂μ)⁻¹ • (∫ x in s, (c x) ^ n • g x ∂μ)) at_top
+    (𝓝 (g x₀)) :=
+begin
+  have : x₀ ∈ s,
+  { rw ← hs.is_closed.closure_eq, exact closure_mono interior_subset h₀ },
+  apply tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_measure_nhds_within_pos
+    hs _ hc h'c hnc hnc₀ this hmg hcg,
+  assume u u_open x₀_u,
+  calc 0 < μ (u ∩ interior s) :
+    (u_open.inter is_open_interior).measure_pos μ (_root_.mem_closure_iff.1 h₀ u u_open x₀_u)
+  ... ≤ μ (u ∩ s) : measure_mono (inter_subset_inter_right _ interior_subset)
+end
+
+/-- If a continuous function `c` realizes its maximum at a unique point `x₀` in a compact set `s`,
+then the sequence of functions `(c x) ^ n / ∫ (c x) ^ n` is a sequence of peak functions
+concentrating around `x₀`. Therefore, `∫ (c x) ^ n * g / ∫ (c x) ^ n` converges to `g x₀` if `g` is
+continuous on `s`. -/
+lemma tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_continuous_on
+  [metrizable_space α] [is_locally_finite_measure μ] [is_open_pos_measure μ] (hs : is_compact s)
+  {c : α → ℝ} (hc : continuous_on c s) (h'c : ∀ y ∈ s, y ≠ x₀ → c y < c x₀)
+  (hnc : ∀ x ∈ s, 0 ≤ c x) (hnc₀ : 0 < c x₀) (h₀ : x₀ ∈ closure (interior s))
+  (hmg : continuous_on g s) :
+  tendsto (λ (n : ℕ), (∫ x in s, (c x) ^ n ∂μ)⁻¹ • (∫ x in s, (c x) ^ n • g x ∂μ)) at_top
+    (𝓝 (g x₀)) :=
+begin
+  have : x₀ ∈ s,
+  { rw ← hs.is_closed.closure_eq, exact closure_mono interior_subset h₀ },
+  exact tendsto_set_integral_pow_smul_of_unique_maximum_of_is_compact_of_integrable_on
+    hs hc h'c hnc hnc₀ h₀ (hmg.integrable_on_compact hs) (hmg x₀ this)
+end
diff --git a/src/measure_theory/integral/periodic.lean b/src/measure_theory/integral/periodic.lean
index 48f6c027dede1..490cba056c617 100644
--- a/src/measure_theory/integral/periodic.lean
+++ b/src/measure_theory/integral/periodic.lean
@@ -1,21 +1,46 @@
 /-
 Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yury Kudryashov
+Authors: Yury Kudryashov, Alex Kontorovich, Heather Macbeth
 -/
-import measure_theory.group.fundamental_domain
+import measure_theory.measure.lebesgue.eq_haar
+import measure_theory.measure.haar.quotient
+import measure_theory.constructions.polish
 import measure_theory.integral.interval_integral
 import topology.algebra.order.floor
 
 /-!
 # Integrals of periodic functions
 
-In this file we prove that `∫ x in t..t + T, f x = ∫ x in s..s + T, f x` for any (not necessarily
-measurable) function periodic function with period `T`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that the half-open interval `Ioc t (t + T)` in `ℝ` is a fundamental domain of
+the action of the subgroup `ℤ ∙ T` on `ℝ`.
+
+A consequence is `add_circle.measure_preserving_mk`: the covering map from `ℝ` to the "additive
+circle" `ℝ ⧸ (ℤ ∙ T)` is measure-preserving, with respect to the restriction of Lebesgue measure to
+`Ioc t (t + T)` (upstairs) and with respect to Haar measure (downstairs).
+
+Another consequence (`function.periodic.interval_integral_add_eq` and related declarations) is that
+`∫ x in t..t + T, f x = ∫ x in s..s + T, f x` for any (not necessarily measurable) function with
+period `T`.
 -/
 
-open set function measure_theory measure_theory.measure topological_space
-open_locale measure_theory
+open set function measure_theory measure_theory.measure topological_space add_subgroup
+  interval_integral
+
+open_locale measure_theory nnreal ennreal
+
+noncomputable instance add_circle.measurable_space {a : ℝ} : measurable_space (add_circle a) :=
+quotient_add_group.measurable_space _
+
+instance add_circle.borel_space {a : ℝ} : borel_space (add_circle a) :=
+quotient_add_group.borel_space
+
+@[measurability] protected lemma add_circle.measurable_mk' {a : ℝ} :
+  measurable (coe : ℝ → add_circle a) :=
+continuous.measurable $ add_circle.continuous_mk' a
 
 lemma is_add_fundamental_domain_Ioc {T : ℝ} (hT : 0 < T) (t : ℝ) (μ : measure ℝ . volume_tac) :
   is_add_fundamental_domain (add_subgroup.zmultiples T) (Ioc t (t + T)) μ :=
@@ -27,21 +52,206 @@ begin
   simpa only [add_comm x] using exists_unique_add_zsmul_mem_Ioc hT x t
 end
 
-variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]
+lemma is_add_fundamental_domain_Ioc' {T : ℝ} (hT : 0 < T) (t : ℝ) (μ : measure ℝ . volume_tac) :
+  is_add_fundamental_domain (add_subgroup.zmultiples T).opposite (Ioc t (t + T)) μ :=
+begin
+  refine is_add_fundamental_domain.mk' measurable_set_Ioc.null_measurable_set (λ x, _),
+  have : bijective (cod_restrict (λ n : ℤ, n • T) (add_subgroup.zmultiples T) _),
+    from (equiv.of_injective (λ n : ℤ, n • T) (zsmul_strict_mono_left hT).injective).bijective,
+  refine this.exists_unique_iff.2 _,
+  simpa using exists_unique_add_zsmul_mem_Ioc hT x t,
+end
+
+namespace add_circle
+variables (T : ℝ) [hT : fact (0 < T)]
+include hT
+
+/-- Equip the "additive circle" `ℝ ⧸ (ℤ ∙ T)` with, as a standard measure, the Haar measure of total
+mass `T` -/
+noncomputable instance measure_space : measure_space (add_circle T) :=
+{ volume := (ennreal.of_real T) • add_haar_measure ⊤,
+  .. add_circle.measurable_space }
+
+@[simp] protected lemma measure_univ : volume (set.univ : set (add_circle T)) = ennreal.of_real T :=
+begin
+  dsimp [(volume)],
+  rw ← positive_compacts.coe_top,
+  simp [add_haar_measure_self, -positive_compacts.coe_top],
+end
+
+instance : is_add_haar_measure (volume : measure (add_circle T)) :=
+is_add_haar_measure.smul _ (by simp [hT.out]) ennreal.of_real_ne_top
+
+instance is_finite_measure : is_finite_measure (volume : measure (add_circle T)) :=
+{ measure_univ_lt_top := by simp }
+
+/-- The covering map from `ℝ` to the "additive circle" `ℝ ⧸ (ℤ ∙ T)` is measure-preserving,
+considered with respect to the standard measure (defined to be the Haar measure of total mass `T`)
+on the additive circle, and with respect to the restriction of Lebsegue measure on `ℝ` to an
+interval (t, t + T]. -/
+protected lemma measure_preserving_mk (t : ℝ) :
+  measure_preserving (coe : ℝ → add_circle T) (volume.restrict (Ioc t (t + T))) :=
+measure_preserving_quotient_add_group.mk'
+  (is_add_fundamental_domain_Ioc' hT.out t)
+  (⊤ : positive_compacts (add_circle T))
+  (by simp)
+  T.to_nnreal
+  (by simp [← ennreal.of_real_coe_nnreal, real.coe_to_nnreal T hT.out.le])
+
+lemma volume_closed_ball {x : add_circle T} (ε : ℝ) :
+  volume (metric.closed_ball x ε) = ennreal.of_real (min T (2 * ε)) :=
+begin
+  have hT' : |T| = T := abs_eq_self.mpr hT.out.le,
+  let I := Ioc (-(T / 2)) (T / 2),
+  have h₁ : ε < T/2 → (metric.closed_ball (0 : ℝ) ε) ∩ I = metric.closed_ball (0 : ℝ) ε,
+  { intros hε,
+    rw [inter_eq_left_iff_subset, real.closed_ball_eq_Icc, zero_sub, zero_add],
+    rintros y ⟨hy₁, hy₂⟩, split; linarith, },
+  have h₂ : coe⁻¹' metric.closed_ball (0 : add_circle T) ε ∩ I =
+    if ε < T/2 then metric.closed_ball (0 : ℝ) ε else I,
+  { conv_rhs { rw [← if_ctx_congr (iff.rfl : ε < T/2 ↔ ε < T/2) h₁ (λ _, rfl), ← hT'], },
+    apply coe_real_preimage_closed_ball_inter_eq,
+    simpa only [hT', real.closed_ball_eq_Icc, zero_add, zero_sub] using Ioc_subset_Icc_self, },
+  rw add_haar_closed_ball_center,
+  simp only [restrict_apply' measurable_set_Ioc, (by linarith : -(T/2) + T = T/2), h₂,
+    ← (add_circle.measure_preserving_mk T (-(T/2))).measure_preimage measurable_set_closed_ball],
+  by_cases hε : ε < T/2,
+  { simp [hε, min_eq_right (by linarith : 2 * ε ≤ T)], },
+  { simp [hε, min_eq_left (by linarith : T ≤ 2 * ε)], },
+end
+
+instance : is_unif_loc_doubling_measure (volume : measure (add_circle T)) :=
+begin
+  refine ⟨⟨real.to_nnreal 2, filter.eventually_of_forall $ λ ε x, _⟩⟩,
+  simp only [volume_closed_ball],
+  erw ← ennreal.of_real_mul zero_le_two,
+  apply ennreal.of_real_le_of_real,
+  rw mul_min_of_nonneg _ _ (zero_le_two : (0 : ℝ) ≤ 2),
+  exact min_le_min (by linarith [hT.out]) (le_refl _),
+end
+
+/-- The isomorphism `add_circle T ≃ Ioc a (a + T)` whose inverse is the natural quotient map,
+  as an equivalence of measurable spaces. -/
+noncomputable def measurable_equiv_Ioc (a : ℝ) : add_circle T ≃ᵐ Ioc a (a + T) :=
+{ measurable_to_fun   := measurable_of_measurable_on_compl_singleton _
+                          (continuous_on_iff_continuous_restrict.mp $ continuous_at.continuous_on $
+                          λ x hx, continuous_at_equiv_Ioc T a hx).measurable,
+  measurable_inv_fun  := add_circle.measurable_mk'.comp measurable_subtype_coe,
+                      .. equiv_Ioc T a }
+
+/-- The isomorphism `add_circle T ≃ Ico a (a + T)` whose inverse is the natural quotient map,
+  as an equivalence of measurable spaces. -/
+noncomputable def measurable_equiv_Ico (a : ℝ) : add_circle T ≃ᵐ Ico a (a + T) :=
+{ measurable_to_fun   := measurable_of_measurable_on_compl_singleton _
+                          (continuous_on_iff_continuous_restrict.mp $ continuous_at.continuous_on $
+                          λ x hx, continuous_at_equiv_Ico T a hx).measurable,
+  measurable_inv_fun  := add_circle.measurable_mk'.comp measurable_subtype_coe,
+                      .. equiv_Ico T a }
+
+/-- The lower integral of a function over `add_circle T` is equal to the lower integral over an
+interval (t, t + T] in `ℝ` of its lift to `ℝ`. -/
+protected lemma lintegral_preimage (t : ℝ) (f : add_circle T → ℝ≥0∞) :
+  ∫⁻ a in Ioc t (t + T), f a = ∫⁻ b : add_circle T, f b :=
+begin
+  have m : measurable_set (Ioc t (t + T)) := measurable_set_Ioc,
+  have := lintegral_map_equiv f (measurable_equiv_Ioc T t).symm,
+  swap, exact volume,
+  simp only [measurable_equiv_Ioc, equiv_Ioc, quotient_add_group.equiv_Ioc_mod,
+    measurable_equiv.symm_mk, measurable_equiv.coe_mk, equiv.coe_fn_symm_mk] at this,
+  rw ←(add_circle.measure_preserving_mk T t).map_eq,
+  convert this.symm using 1, -- TODO : there is no "set_lintegral_eq_subtype"?
+  { rw ←(map_comap_subtype_coe m _),
+    exact measurable_embedding.lintegral_map (measurable_embedding.subtype_coe m) _, },
+  { congr' 1,
+    have : (coe : Ioc t (t + T) → add_circle T) = (coe : ℝ → add_circle T) ∘ (coe : _ → ℝ),
+    { ext1 x, refl, },
+    simp_rw [this, ←map_map add_circle.measurable_mk' measurable_subtype_coe,
+      ←map_comap_subtype_coe m],
+    refl, }
+end
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+/-- The integral of an almost-everywhere strongly measurable function over `add_circle T` is equal
+to the integral over an interval (t, t + T] in `ℝ` of its lift to `ℝ`. -/
+protected lemma integral_preimage (t : ℝ) (f : add_circle T → E) :
+  ∫ a in Ioc t (t + T), f a = ∫ b : add_circle T, f b :=
+begin
+  have m : measurable_set (Ioc t (t + T)) := measurable_set_Ioc,
+  have := integral_map_equiv (measurable_equiv_Ioc T t).symm f,
+  simp only [measurable_equiv_Ioc, equiv_Ioc, quotient_add_group.equiv_Ioc_mod,
+    measurable_equiv.symm_mk, measurable_equiv.coe_mk, equiv.coe_fn_symm_mk, coe_coe] at this,
+  rw [←(add_circle.measure_preserving_mk T t).map_eq, set_integral_eq_subtype m, ←this],
+  have : (coe : Ioc t (t + T) → add_circle T) = (coe : ℝ → add_circle T) ∘ (coe : _ → ℝ),
+  { ext1 x, refl, },
+  simp_rw [this, ←map_map add_circle.measurable_mk' measurable_subtype_coe,
+    ←map_comap_subtype_coe m],
+  refl,
+end
+
+/-- The integral of an almost-everywhere strongly measurable function over `add_circle T` is equal
+to the integral over an interval (t, t + T] in `ℝ` of its lift to `ℝ`. -/
+protected lemma interval_integral_preimage (t : ℝ) (f : add_circle T → E) :
+  ∫ a in t..(t + T), f a = ∫ b : add_circle T, f b :=
+begin
+  rw [integral_of_le, add_circle.integral_preimage T t f],
+  linarith [hT.out],
+end
+
+end add_circle
+
+namespace unit_add_circle
+local attribute [instance] real.fact_zero_lt_one
+
+noncomputable instance measure_space : measure_space unit_add_circle := add_circle.measure_space 1
+
+@[simp] protected lemma measure_univ : volume (set.univ : set unit_add_circle) = 1 := by simp
+
+instance is_finite_measure : is_finite_measure (volume : measure unit_add_circle) :=
+add_circle.is_finite_measure 1
+
+/-- The covering map from `ℝ` to the "unit additive circle" `ℝ ⧸ ℤ` is measure-preserving,
+considered with respect to the standard measure (defined to be the Haar measure of total mass 1)
+on the additive circle, and with respect to the restriction of Lebsegue measure on `ℝ` to an
+interval (t, t + 1]. -/
+protected lemma measure_preserving_mk (t : ℝ) :
+  measure_preserving (coe : ℝ → unit_add_circle) (volume.restrict (Ioc t (t + 1))) :=
+add_circle.measure_preserving_mk 1 t
+
+/-- The integral of a measurable function over `unit_add_circle` is equal to the integral over an
+interval (t, t + 1] in `ℝ` of its lift to `ℝ`. -/
+protected lemma lintegral_preimage (t : ℝ) (f : unit_add_circle → ℝ≥0∞) :
+  ∫⁻ a in Ioc t (t + 1), f a = ∫⁻ b : unit_add_circle, f b :=
+add_circle.lintegral_preimage 1 t f
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+/-- The integral of an almost-everywhere strongly measurable function over `unit_add_circle` is
+equal to the integral over an interval (t, t + 1] in `ℝ` of its lift to `ℝ`. -/
+protected lemma integral_preimage (t : ℝ) (f : unit_add_circle → E) :
+  ∫ a in Ioc t (t + 1), f a = ∫ b : unit_add_circle, f b :=
+add_circle.integral_preimage 1 t f
+
+/-- The integral of an almost-everywhere strongly measurable function over `unit_add_circle` is
+equal to the integral over an interval (t, t + 1] in `ℝ` of its lift to `ℝ`. -/
+protected lemma interval_integral_preimage (t : ℝ) (f : unit_add_circle → E) :
+  ∫ a in t..(t + 1), f a = ∫ b : unit_add_circle, f b :=
+add_circle.interval_integral_preimage 1 t f
+
+end unit_add_circle
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
 
 namespace function
 
 namespace periodic
 
-open interval_integral
-
 variables {f : ℝ → E} {T : ℝ}
 
 /-- An auxiliary lemma for a more general `function.periodic.interval_integral_add_eq`. -/
 lemma interval_integral_add_eq_of_pos (hf : periodic f T)
   (hT : 0 < T) (t s : ℝ) : ∫ x in t..t + T, f x = ∫ x in s..s + T, f x :=
 begin
-  haveI : encodable (add_subgroup.zmultiples T) := (countable_range _).to_encodable,
   simp only [integral_of_le, hT.le, le_add_iff_nonneg_right],
   haveI : vadd_invariant_measure (add_subgroup.zmultiples T) ℝ volume :=
     ⟨λ c s hs, measure_preimage_add _ _ _⟩,
diff --git a/src/measure_theory/integral/riesz_markov_kakutani.lean b/src/measure_theory/integral/riesz_markov_kakutani.lean
new file mode 100644
index 0000000000000..6b25ad04cfa05
--- /dev/null
+++ b/src/measure_theory/integral/riesz_markov_kakutani.lean
@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2022 Jesse Reimann. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jesse Reimann, Kalle Kytölä
+-/
+import topology.continuous_function.bounded
+import topology.sets.compacts
+
+/-!
+#  Riesz–Markov–Kakutani representation theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file will prove different versions of the Riesz-Markov-Kakutani representation theorem.
+The theorem is first proven for compact spaces, from which the statements about linear functionals
+on bounded continuous functions or compactly supported functions on locally compact spaces follow.
+
+To make use of the existing API, the measure is constructed from a content `λ` on the
+compact subsets of the space X, rather than the usual construction of open sets in the literature.
+
+## References
+
+* [Walter Rudin, Real and Complex Analysis.][Rud87]
+
+-/
+
+noncomputable theory
+
+open_locale bounded_continuous_function nnreal ennreal
+open set function topological_space
+
+variables {X : Type*} [topological_space X]
+variables (Λ : (X →ᵇ ℝ≥0) →ₗ[ℝ≥0] ℝ≥0)
+
+/-! ### Construction of the content: -/
+
+/-- Given a positive linear functional Λ on X, for `K ⊆ X` compact define
+`λ(K) = inf {Λf | 1≤f on K}`. When X is a compact Hausdorff space, this will be shown to be a
+content, and will be shown to agree with the Riesz measure on the compact subsets `K ⊆ X`. -/
+def riesz_content_aux : (compacts X) → ℝ≥0 :=
+λ K, Inf (Λ '' {f : X →ᵇ ℝ≥0 | ∀ x ∈ K, (1 : ℝ≥0) ≤ f x})
+
+section riesz_monotone
+
+/-- For any compact subset `K ⊆ X`, there exist some bounded continuous nonnegative
+functions f on X such that `f ≥ 1` on K. -/
+lemma riesz_content_aux_image_nonempty (K : compacts X) :
+  (Λ '' {f : X →ᵇ ℝ≥0 | ∀ x ∈ K, (1 : ℝ≥0) ≤ f x}).nonempty :=
+begin
+  rw nonempty_image_iff,
+  use (1 : X →ᵇ ℝ≥0),
+  intros x x_in_K,
+  simp only [bounded_continuous_function.coe_one, pi.one_apply],
+end
+
+/-- Riesz content λ (associated with a positive linear functional Λ) is
+monotone: if `K₁ ⊆ K₂` are compact subsets in X, then `λ(K₁) ≤ λ(K₂)`. -/
+lemma riesz_content_aux_mono {K₁ K₂ : compacts X} (h : K₁ ≤ K₂) :
+  riesz_content_aux Λ K₁ ≤ riesz_content_aux Λ K₂ :=
+cInf_le_cInf (order_bot.bdd_below _) (riesz_content_aux_image_nonempty Λ K₂)
+  (image_subset Λ (set_of_subset_set_of.mpr (λ f f_hyp x x_in_K₁, f_hyp x (h x_in_K₁))))
+
+end riesz_monotone
+
+section riesz_subadditive
+
+/-- Any bounded continuous nonnegative f such that `f ≥ 1` on K gives an upper bound on the
+content of K; namely `λ(K) ≤ Λ f`. -/
+lemma riesz_content_aux_le {K : compacts X}
+  {f : X →ᵇ ℝ≥0} (h : ∀ x ∈ K, (1 : ℝ≥0) ≤ f x) :
+  riesz_content_aux Λ K ≤ Λ f := cInf_le (order_bot.bdd_below _) ⟨f, ⟨h, rfl⟩⟩
+
+/-- The Riesz content can be approximated arbitrarily well by evaluating the positive linear
+functional on test functions: for any `ε > 0`, there exists a bounded continuous nonnegative
+function f on X such that `f ≥ 1` on K and such that `λ(K) ≤ Λ f < λ(K) + ε`. -/
+lemma exists_lt_riesz_content_aux_add_pos (K : compacts X)
+  {ε : ℝ≥0} (εpos : 0 < ε) :
+  ∃ (f : X →ᵇ ℝ≥0), (∀ x ∈ K, (1 : ℝ≥0) ≤ f x) ∧ Λ f < riesz_content_aux Λ K + ε :=
+begin
+  --choose a test function `f` s.t. `Λf = α < λ(K) + ε`
+  obtain ⟨α, ⟨⟨f, f_hyp⟩, α_hyp⟩⟩ :=
+    exists_lt_of_cInf_lt (riesz_content_aux_image_nonempty Λ K)
+    (lt_add_of_pos_right (riesz_content_aux Λ K) εpos),
+  refine ⟨f, f_hyp.left, _ ⟩,
+  rw f_hyp.right,
+  exact α_hyp,
+end
+
+/-- The Riesz content λ associated to a given positive linear functional Λ is
+finitely subadditive: `λ(K₁ ∪ K₂) ≤ λ(K₁) + λ(K₂)` for any compact subsets `K₁, K₂ ⊆ X`. -/
+lemma riesz_content_aux_sup_le (K1 K2 : compacts X) :
+  riesz_content_aux Λ (K1 ⊔ K2) ≤ riesz_content_aux Λ (K1) + riesz_content_aux Λ (K2) :=
+begin
+  apply nnreal.le_of_forall_pos_le_add,
+  intros ε εpos,
+  --get test functions s.t. `λ(Ki) ≤ Λfi ≤ λ(Ki) + ε/2, i=1,2`
+  obtain ⟨f1, f_test_function_K1⟩ := exists_lt_riesz_content_aux_add_pos Λ K1
+    (half_pos εpos),
+  obtain ⟨f2, f_test_function_K2⟩ := exists_lt_riesz_content_aux_add_pos Λ K2
+    (half_pos εpos),
+  --let `f := f1 + f2` test function for the content of `K`
+  have f_test_function_union : (∀ x ∈ (K1 ⊔ K2), (1 : ℝ≥0) ≤ (f1 + f2) x),
+  { rintros x (x_in_K1 | x_in_K2),
+    { exact le_add_right (f_test_function_K1.left x x_in_K1) },
+    { exact le_add_left (f_test_function_K2.left x x_in_K2) }},
+  --use that `Λf` is an upper bound for `λ(K1⊔K2)`
+  apply (riesz_content_aux_le Λ f_test_function_union).trans (le_of_lt _),
+  rw map_add,
+  --use that `Λfi` are lower bounds for `λ(Ki) + ε/2`
+  apply lt_of_lt_of_le (add_lt_add f_test_function_K1.right f_test_function_K2.right) (le_of_eq _),
+  rw [add_assoc, add_comm (ε/2), add_assoc, add_halves ε, add_assoc],
+end
+
+end riesz_subadditive
diff --git a/src/measure_theory/integral/set_integral.lean b/src/measure_theory/integral/set_integral.lean
index 9b20f3ce4b6bf..a4ef51091adbb 100644
--- a/src/measure_theory/integral/set_integral.lean
+++ b/src/measure_theory/integral/set_integral.lean
@@ -5,11 +5,17 @@ Authors: Zhouhang Zhou, Yury Kudryashov
 -/
 import measure_theory.integral.integrable_on
 import measure_theory.integral.bochner
+import measure_theory.function.locally_integrable
 import order.filter.indicator_function
+import topology.metric_space.thickened_indicator
+import topology.continuous_function.compact
 
 /-!
 # Set integral
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove some properties of `∫ x in s, f x ∂μ`. Recall that this notation
 is defined as `∫ x, f x ∂(μ.restrict s)`. In `integral_indicator` we prove that for a measurable
 function `f` and a measurable set `s` this definition coincides with another natural definition:
@@ -31,7 +37,7 @@ for set integral, see `filter.tendsto.integral_sub_linear_is_o_ae` and its corol
 Namely, consider a measurably generated filter `l`, a measure `μ` finite at this filter, and
 a function `f` that has a finite limit `c` at `l ⊓ μ.ae`. Then `∫ x in s, f x ∂μ = μ s • c + o(μ s)`
 as `s` tends to `l.small_sets`, i.e. for any `ε>0` there exists `t ∈ l` such that
-`∥∫ x in s, f x ∂μ - μ s • c∥ ≤ ε * μ s` whenever `s ⊆ t`. We also formulate a version of this
+`‖∫ x in s, f x ∂μ - μ s • c‖ ≤ ε * μ s` whenever `s ⊆ t`. We also formulate a version of this
 theorem for a locally finite measure `μ` and a function `f` continuous at a point `a`.
 
 ## Notation
@@ -45,25 +51,35 @@ but we reference them here because all theorems about set integrals are in this
 
 -/
 
+assert_not_exists inner_product_space
+
 noncomputable theory
 open set filter topological_space measure_theory function
-open_locale classical topological_space interval big_operators filter ennreal nnreal measure_theory
+open_locale classical topology interval big_operators filter ennreal nnreal measure_theory
 
 variables {α β E F : Type*} [measurable_space α]
 
 namespace measure_theory
 
-section normed_group
+section normed_add_comm_group
 
-variables [normed_group E]  {f g : α → E} {s t : set α} {μ ν : measure α}
+variables [normed_add_comm_group E]  {f g : α → E} {s t : set α} {μ ν : measure α}
   {l l' : filter α}
 
 variables [complete_space E] [normed_space ℝ E]
 
+lemma set_integral_congr_ae₀ (hs : null_measurable_set s μ) (h : ∀ᵐ x ∂μ, x ∈ s → f x = g x) :
+  ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ :=
+integral_congr_ae ((ae_restrict_iff'₀ hs).2 h)
+
 lemma set_integral_congr_ae (hs : measurable_set s) (h : ∀ᵐ x ∂μ, x ∈ s → f x = g x) :
   ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ :=
 integral_congr_ae ((ae_restrict_iff' hs).2 h)
 
+lemma set_integral_congr₀ (hs : null_measurable_set s μ) (h : eq_on f g s) :
+  ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ :=
+set_integral_congr_ae₀ hs $ eventually_of_forall h
+
 lemma set_integral_congr (hs : measurable_set s) (h : eq_on f g s) :
   ∫ x in s, f x ∂μ = ∫ x in s, g x ∂μ :=
 set_integral_congr_ae hs $ eventually_of_forall h
@@ -82,14 +98,25 @@ lemma integral_union (hst : disjoint s t) (ht : measurable_set t)
   ∫ x in s ∪ t, f x ∂μ = ∫ x in s, f x ∂μ + ∫ x in t, f x ∂μ :=
 integral_union_ae hst.ae_disjoint ht.null_measurable_set hfs hft
 
-lemma integral_diff (ht : measurable_set t) (hfs : integrable_on f s μ)
-  (hft : integrable_on f t μ) (hts : t ⊆ s) :
+lemma integral_diff (ht : measurable_set t) (hfs : integrable_on f s μ) (hts : t ⊆ s) :
   ∫ x in s \ t, f x ∂μ = ∫ x in s, f x ∂μ - ∫ x in t, f x ∂μ :=
 begin
   rw [eq_sub_iff_add_eq, ← integral_union, diff_union_of_subset hts],
-  exacts [disjoint_diff.symm, ht, hfs.mono_set (diff_subset _ _), hft]
+  exacts [disjoint_sdiff_self_left, ht, hfs.mono_set (diff_subset _ _), hfs.mono_set hts]
 end
 
+lemma integral_inter_add_diff₀ (ht : null_measurable_set t μ) (hfs : integrable_on f s μ) :
+  ∫ x in s ∩ t, f x ∂μ + ∫ x in s \ t, f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  rw [← measure.restrict_inter_add_diff₀ s ht, integral_add_measure],
+  { exact integrable.mono_measure hfs (measure.restrict_mono (inter_subset_left _ _) le_rfl) },
+  { exact integrable.mono_measure hfs (measure.restrict_mono (diff_subset _ _) le_rfl) }
+end
+
+lemma integral_inter_add_diff (ht : measurable_set t) (hfs : integrable_on f s μ) :
+  ∫ x in s ∩ t, f x ∂μ + ∫ x in s \ t, f x ∂μ = ∫ x in s, f x ∂μ :=
+integral_inter_add_diff₀ ht.null_measurable_set hfs
+
 lemma integral_finset_bUnion {ι : Type*} (t : finset ι) {s : ι → set α}
   (hs : ∀ i ∈ t, measurable_set (s i)) (h's : set.pairwise ↑t (disjoint on s))
   (hf : ∀ i ∈ t, integrable_on f (s i) μ) :
@@ -120,11 +147,15 @@ lemma integral_empty : ∫ x in ∅, f x ∂μ = 0 := by rw [measure.restrict_em
 
 lemma integral_univ : ∫ x in univ, f x ∂μ = ∫ x, f x ∂μ := by rw [measure.restrict_univ]
 
-lemma integral_add_compl (hs : measurable_set s) (hfi : integrable f μ) :
+lemma integral_add_compl₀ (hs : null_measurable_set s μ) (hfi : integrable f μ) :
   ∫ x in s, f x ∂μ + ∫ x in sᶜ, f x ∂μ = ∫ x, f x ∂μ :=
-by rw [← integral_union (@disjoint_compl_right (set α) _ _) hs.compl
+by rw [← integral_union_ae (@disjoint_compl_right (set α) _ _).ae_disjoint hs.compl
     hfi.integrable_on hfi.integrable_on, union_compl_self, integral_univ]
 
+lemma integral_add_compl (hs : measurable_set s) (hfi : integrable f μ) :
+  ∫ x in s, f x ∂μ + ∫ x in sᶜ, f x ∂μ = ∫ x, f x ∂μ :=
+integral_add_compl₀ hs.null_measurable_set hfi
+
 /-- For a function `f` and a measurable set `s`, the integral of `indicator s f`
 over the whole space is equal to `∫ x in s, f x ∂μ` defined as `∫ x, f x ∂(μ.restrict s)`. -/
 lemma integral_indicator (hs : measurable_set s) :
@@ -134,19 +165,23 @@ begin
   { rwa [integral_undef, integral_undef],
     rwa integrable_indicator_iff hs },
   calc ∫ x, indicator s f x ∂μ = ∫ x in s, indicator s f x ∂μ + ∫ x in sᶜ, indicator s f x ∂μ :
-    (integral_add_compl hs (hfi.indicator hs)).symm
+    (integral_add_compl hs (hfi.integrable_indicator hs)).symm
   ... = ∫ x in s, f x ∂μ + ∫ x in sᶜ, 0 ∂μ :
     congr_arg2 (+) (integral_congr_ae (indicator_ae_eq_restrict hs))
       (integral_congr_ae (indicator_ae_eq_restrict_compl hs))
   ... = ∫ x in s, f x ∂μ : by simp
 end
 
+lemma set_integral_indicator (ht : measurable_set t) :
+  ∫ x in s, t.indicator f x ∂μ = ∫ x in s ∩ t, f x ∂μ :=
+by rw [integral_indicator ht, measure.restrict_restrict ht, set.inter_comm]
+
 lemma of_real_set_integral_one_of_measure_ne_top {α : Type*} {m : measurable_space α}
   {μ : measure α} {s : set α} (hs : μ s ≠ ∞) :
   ennreal.of_real (∫ x in s, (1 : ℝ) ∂μ) = μ s :=
 calc
 ennreal.of_real (∫ x in s, (1 : ℝ) ∂μ)
-    = ennreal.of_real (∫ x in s, ∥(1 : ℝ)∥ ∂μ) : by simp only [norm_one]
+    = ennreal.of_real (∫ x in s, ‖(1 : ℝ)‖ ∂μ) : by simp only [norm_one]
 ... = ∫⁻ x in s, 1 ∂μ :
 begin
   rw of_real_integral_norm_eq_lintegral_nnnorm (integrable_on_const.2 (or.inr hs.lt_top)),
@@ -160,29 +195,29 @@ lemma of_real_set_integral_one {α : Type*} {m : measurable_space α} (μ : meas
 of_real_set_integral_one_of_measure_ne_top (measure_ne_top μ s)
 
 lemma integral_piecewise [decidable_pred (∈ s)] (hs : measurable_set s)
-  {f g : α → E} (hf : integrable_on f s μ) (hg : integrable_on g sᶜ μ) :
+  (hf : integrable_on f s μ) (hg : integrable_on g sᶜ μ) :
   ∫ x, s.piecewise f g x ∂μ = ∫ x in s, f x ∂μ + ∫ x in sᶜ, g x ∂μ :=
 by rw [← set.indicator_add_compl_eq_piecewise,
-  integral_add' (hf.indicator hs) (hg.indicator hs.compl),
+  integral_add' (hf.integrable_indicator hs) (hg.integrable_indicator hs.compl),
   integral_indicator hs, integral_indicator hs.compl]
 
-lemma tendsto_set_integral_of_monotone {ι : Type*} [encodable ι] [semilattice_sup ι]
-  {s : ι → set α} {f : α → E} (hsm : ∀ i, measurable_set (s i))
+lemma tendsto_set_integral_of_monotone {ι : Type*} [countable ι] [semilattice_sup ι]
+  {s : ι → set α} (hsm : ∀ i, measurable_set (s i))
   (h_mono : monotone s) (hfi : integrable_on f (⋃ n, s n) μ) :
   tendsto (λ i, ∫ a in s i, f a ∂μ) at_top (𝓝 (∫ a in (⋃ n, s n), f a ∂μ)) :=
 begin
-  have hfi' : ∫⁻ x in ⋃ n, s n, ∥f x∥₊ ∂μ < ∞ := hfi.2,
+  have hfi' : ∫⁻ x in ⋃ n, s n, ‖f x‖₊ ∂μ < ∞ := hfi.2,
   set S := ⋃ i, s i,
   have hSm : measurable_set S := measurable_set.Union hsm,
   have hsub : ∀ {i}, s i ⊆ S, from subset_Union s,
   rw [← with_density_apply _ hSm] at hfi',
-  set ν := μ.with_density (λ x, ∥f x∥₊) with hν,
+  set ν := μ.with_density (λ x, ‖f x‖₊) with hν,
   refine metric.nhds_basis_closed_ball.tendsto_right_iff.2 (λ ε ε0, _),
   lift ε to ℝ≥0 using ε0.le,
   have : ∀ᶠ i in at_top, ν (s i) ∈ Icc (ν S - ε) (ν S + ε),
     from tendsto_measure_Union h_mono (ennreal.Icc_mem_nhds hfi'.ne (ennreal.coe_pos.2 ε0).ne'),
   refine this.mono (λ i hi, _),
-  rw [mem_closed_ball_iff_norm', ← integral_diff (hsm i) hfi (hfi.mono_set hsub) hsub,
+  rw [mem_closed_ball_iff_norm', ← integral_diff (hsm i) hfi hsub,
     ← coe_nnnorm, nnreal.coe_le_coe, ← ennreal.coe_le_coe],
   refine (ennnorm_integral_le_lintegral_ennnorm _).trans _,
   rw [← with_density_apply _ (hSm.diff (hsm _)), ← hν, measure_diff hsub (hsm _)],
@@ -190,7 +225,7 @@ begin
     (hi.2.trans_lt $ ennreal.add_lt_top.2 ⟨hfi', ennreal.coe_lt_top⟩).ne]
 end
 
-lemma has_sum_integral_Union_ae {ι : Type*} [encodable ι] {s : ι → set α} {f : α → E}
+lemma has_sum_integral_Union_ae {ι : Type*} [countable ι] {s : ι → set α}
   (hm : ∀ i, null_measurable_set (s i) μ) (hd : pairwise (ae_disjoint μ on s))
   (hfi : integrable_on f (⋃ i, s i) μ) :
   has_sum (λ n, ∫ a in s n, f a ∂ μ) (∫ a in ⋃ n, s n, f a ∂μ) :=
@@ -199,65 +234,208 @@ begin
   exact has_sum_integral_measure hfi
 end
 
-lemma has_sum_integral_Union {ι : Type*} [encodable ι] {s : ι → set α} {f : α → E}
+lemma has_sum_integral_Union {ι : Type*} [countable ι] {s : ι → set α}
   (hm : ∀ i, measurable_set (s i)) (hd : pairwise (disjoint on s))
   (hfi : integrable_on f (⋃ i, s i) μ) :
   has_sum (λ n, ∫ a in s n, f a ∂ μ) (∫ a in ⋃ n, s n, f a ∂μ) :=
 has_sum_integral_Union_ae (λ i, (hm i).null_measurable_set) (hd.mono (λ i j h, h.ae_disjoint)) hfi
 
-lemma integral_Union {ι : Type*} [encodable ι] {s : ι → set α} {f : α → E}
+lemma integral_Union {ι : Type*} [countable ι] {s : ι → set α}
   (hm : ∀ i, measurable_set (s i)) (hd : pairwise (disjoint on s))
   (hfi : integrable_on f (⋃ i, s i) μ) :
   (∫ a in (⋃ n, s n), f a ∂μ) = ∑' n, ∫ a in s n, f a ∂ μ :=
 (has_sum.tsum_eq (has_sum_integral_Union hm hd hfi)).symm
 
-lemma integral_Union_ae {ι : Type*} [encodable ι] {s : ι → set α} {f : α → E}
+lemma integral_Union_ae {ι : Type*} [countable ι] {s : ι → set α}
   (hm : ∀ i, null_measurable_set (s i) μ) (hd : pairwise (ae_disjoint μ on s))
   (hfi : integrable_on f (⋃ i, s i) μ) :
   (∫ a in (⋃ n, s n), f a ∂μ) = ∑' n, ∫ a in s n, f a ∂ μ :=
 (has_sum.tsum_eq (has_sum_integral_Union_ae hm hd hfi)).symm
 
-lemma set_integral_eq_zero_of_forall_eq_zero {f : α → E} (hf : strongly_measurable f)
-  (ht_eq : ∀ x ∈ t, f x = 0) :
+lemma set_integral_eq_zero_of_ae_eq_zero (ht_eq : ∀ᵐ x ∂μ, x ∈ t → f x = 0) :
   ∫ x in t, f x ∂μ = 0 :=
 begin
-  refine integral_eq_zero_of_ae _,
-  rw [eventually_eq, ae_restrict_iff (hf.measurable_set_eq_fun strongly_measurable_zero)],
-  refine eventually_of_forall (λ x hx, _),
-  rw pi.zero_apply,
-  exact ht_eq x hx,
+  by_cases hf : ae_strongly_measurable f (μ.restrict t), swap,
+  { rw integral_undef,
+    contrapose! hf,
+    exact hf.1 },
+  have : ∫ x in t, hf.mk f x ∂μ = 0,
+  { refine integral_eq_zero_of_ae _,
+    rw [eventually_eq, ae_restrict_iff
+      (hf.strongly_measurable_mk.measurable_set_eq_fun strongly_measurable_zero)],
+    filter_upwards [ae_imp_of_ae_restrict hf.ae_eq_mk, ht_eq] with x hx h'x h''x,
+    rw ← hx h''x,
+    exact h'x h''x },
+  rw ← this,
+  exact integral_congr_ae hf.ae_eq_mk,
 end
 
-lemma set_integral_union_eq_left {f : α → E} (hf : strongly_measurable f) (hfi : integrable f μ)
-  (hs : measurable_set s) (ht_eq : ∀ x ∈ t, f x = 0) :
+lemma set_integral_eq_zero_of_forall_eq_zero (ht_eq : ∀ x ∈ t, f x = 0) :
+  ∫ x in t, f x ∂μ = 0 :=
+set_integral_eq_zero_of_ae_eq_zero (eventually_of_forall ht_eq)
+
+lemma integral_union_eq_left_of_ae_aux (ht_eq : ∀ᵐ x ∂(μ.restrict t), f x = 0)
+  (haux : strongly_measurable f) (H : integrable_on f (s ∪ t) μ) :
   ∫ x in (s ∪ t), f x ∂μ = ∫ x in s, f x ∂μ :=
 begin
-  rw [← set.union_diff_self, union_comm, integral_union,
-    set_integral_eq_zero_of_forall_eq_zero _ (λ x hx, ht_eq x (diff_subset _ _ hx)), zero_add],
-  exacts [hf, disjoint_diff.symm, hs, hfi.integrable_on, hfi.integrable_on]
+  let k := f ⁻¹' {0},
+  have hk : measurable_set k,
+  { borelize E, exact haux.measurable (measurable_set_singleton _) },
+  have h's : integrable_on f s μ := H.mono (subset_union_left _ _) le_rfl,
+  have A : ∀ (u : set α), ∫ x in u ∩ k, f x ∂μ = 0 :=
+    λ u, set_integral_eq_zero_of_forall_eq_zero (λ x hx, hx.2),
+  rw [← integral_inter_add_diff hk h's, ← integral_inter_add_diff hk H, A, A, zero_add, zero_add,
+    union_diff_distrib, union_comm],
+  apply set_integral_congr_set_ae,
+  rw union_ae_eq_right,
+  apply measure_mono_null (diff_subset _ _),
+  rw measure_zero_iff_ae_nmem,
+  filter_upwards [ae_imp_of_ae_restrict ht_eq] with x hx h'x using h'x.2 (hx h'x.1),
 end
 
-lemma set_integral_neg_eq_set_integral_nonpos [linear_order E] [order_closed_topology E]
-  {f : α → E} (hf : strongly_measurable f) (hfi : integrable f μ) :
+lemma integral_union_eq_left_of_ae (ht_eq : ∀ᵐ x ∂(μ.restrict t), f x = 0) :
+  ∫ x in (s ∪ t), f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  have ht : integrable_on f t μ,
+  { apply integrable_on_zero.congr_fun_ae, symmetry, exact ht_eq },
+  by_cases H : integrable_on f (s ∪ t) μ, swap,
+  { rw [integral_undef H, integral_undef], simpa [integrable_on_union, ht] using H },
+  let f' := H.1.mk f,
+  calc ∫ (x : α) in s ∪ t, f x ∂μ
+      = ∫ (x : α) in s ∪ t, f' x ∂μ : integral_congr_ae H.1.ae_eq_mk
+  ... = ∫ x in s, f' x ∂μ :
+    begin
+      apply integral_union_eq_left_of_ae_aux _ H.1.strongly_measurable_mk
+        (H.congr_fun_ae H.1.ae_eq_mk),
+      filter_upwards [ht_eq, ae_mono (measure.restrict_mono (subset_union_right s t) le_rfl)
+        H.1.ae_eq_mk] with x hx h'x,
+      rw [← h'x, hx]
+    end
+  ... = ∫ x in s, f x ∂μ : integral_congr_ae
+    (ae_mono (measure.restrict_mono (subset_union_left s t) le_rfl) H.1.ae_eq_mk.symm)
+end
+
+lemma integral_union_eq_left_of_forall₀ {f : α → E}
+  (ht : null_measurable_set t μ) (ht_eq : ∀ x ∈ t, f x = 0) :
+  ∫ x in (s ∪ t), f x ∂μ = ∫ x in s, f x ∂μ :=
+integral_union_eq_left_of_ae ((ae_restrict_iff'₀ ht).2 (eventually_of_forall ht_eq))
+
+lemma integral_union_eq_left_of_forall {f : α → E}
+  (ht : measurable_set t) (ht_eq : ∀ x ∈ t, f x = 0) :
+  ∫ x in (s ∪ t), f x ∂μ = ∫ x in s, f x ∂μ :=
+integral_union_eq_left_of_forall₀ ht.null_measurable_set ht_eq
+
+lemma set_integral_eq_of_subset_of_ae_diff_eq_zero_aux
+  (hts : s ⊆ t) (h't : ∀ᵐ x ∂μ, x ∈ t \ s → f x = 0)
+  (haux : strongly_measurable f) (h'aux : integrable_on f t μ) :
+  ∫ x in t, f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  let k := f ⁻¹' {0},
+  have hk : measurable_set k,
+  { borelize E, exact haux.measurable (measurable_set_singleton _) },
+  calc
+  ∫ x in t, f x ∂μ
+      = ∫ x in t ∩ k, f x ∂μ + ∫ x in t \ k, f x ∂μ :
+    by rw integral_inter_add_diff hk h'aux
+  ... = ∫ x in t \ k, f x ∂μ :
+    by { rw [set_integral_eq_zero_of_forall_eq_zero (λ x hx, _), zero_add], exact hx.2 }
+  ... = ∫ x in s \ k, f x ∂μ :
+    begin
+      apply set_integral_congr_set_ae,
+      filter_upwards [h't] with x hx,
+      change (x ∈ t \ k) = (x ∈ s \ k),
+      simp only [mem_preimage, mem_singleton_iff, eq_iff_iff, and.congr_left_iff, mem_diff],
+      assume h'x,
+      by_cases xs : x ∈ s,
+      { simp only [xs, hts xs] },
+      { simp only [xs, iff_false],
+        assume xt,
+        exact h'x (hx ⟨xt, xs⟩) }
+    end
+  ... = ∫ x in s ∩ k, f x ∂μ + ∫ x in s \ k, f x ∂μ :
+    begin
+      have : ∀ x ∈ s ∩ k, f x = 0 := λ x hx, hx.2,
+      rw [set_integral_eq_zero_of_forall_eq_zero this, zero_add],
+    end
+  ... = ∫ x in s, f x ∂μ : by rw integral_inter_add_diff hk (h'aux.mono hts le_rfl)
+end
+
+/-- If a function vanishes almost everywhere on `t \ s` with `s ⊆ t`, then its integrals on `s`
+and `t` coincide if `t` is null-measurable. -/
+lemma set_integral_eq_of_subset_of_ae_diff_eq_zero
+  (ht : null_measurable_set t μ) (hts : s ⊆ t) (h't : ∀ᵐ x ∂μ, x ∈ t \ s → f x = 0) :
+  ∫ x in t, f x ∂μ = ∫ x in s, f x ∂μ :=
+begin
+  by_cases h : integrable_on f t μ, swap,
+  { have : ¬(integrable_on f s μ) := λ H, h (H.of_ae_diff_eq_zero ht h't),
+    rw [integral_undef h, integral_undef this] },
+  let f' := h.1.mk f,
+  calc ∫ x in t, f x ∂μ
+      = ∫ x in t, f' x ∂μ : integral_congr_ae h.1.ae_eq_mk
+  ... = ∫ x in s, f' x ∂μ :
+    begin
+      apply set_integral_eq_of_subset_of_ae_diff_eq_zero_aux hts _ h.1.strongly_measurable_mk
+        (h.congr h.1.ae_eq_mk),
+      filter_upwards [h't, ae_imp_of_ae_restrict h.1.ae_eq_mk] with x hx h'x h''x,
+      rw [← h'x h''x.1, hx h''x]
+    end
+  ... = ∫ x in s, f x ∂μ :
+    begin
+      apply integral_congr_ae,
+      apply ae_restrict_of_ae_restrict_of_subset hts,
+      exact h.1.ae_eq_mk.symm
+    end
+end
+
+/-- If a function vanishes on `t \ s` with `s ⊆ t`, then its integrals on `s`
+and `t` coincide if `t` is measurable. -/
+lemma set_integral_eq_of_subset_of_forall_diff_eq_zero
+  (ht : measurable_set t) (hts : s ⊆ t) (h't : ∀ x ∈ t \ s, f x = 0) :
+  ∫ x in t, f x ∂μ = ∫ x in s, f x ∂μ :=
+set_integral_eq_of_subset_of_ae_diff_eq_zero ht.null_measurable_set hts
+  (eventually_of_forall (λ x hx, h't x hx))
+
+/-- If a function vanishes almost everywhere on `sᶜ`, then its integral on `s`
+coincides with its integral on the whole space. -/
+lemma set_integral_eq_integral_of_ae_compl_eq_zero
+  (h : ∀ᵐ x ∂μ, x ∉ s → f x = 0) : ∫ x in s, f x ∂μ = ∫ x, f x ∂μ :=
+begin
+  conv_rhs { rw ← integral_univ },
+  symmetry,
+  apply set_integral_eq_of_subset_of_ae_diff_eq_zero null_measurable_set_univ (subset_univ _),
+  filter_upwards [h] with x hx h'x using hx h'x.2,
+end
+
+/-- If a function vanishes on `sᶜ`, then its integral on `s` coincides with its integral on the
+whole space. -/
+lemma set_integral_eq_integral_of_forall_compl_eq_zero
+  (h : ∀ x, x ∉ s → f x = 0) : ∫ x in s, f x ∂μ = ∫ x, f x ∂μ :=
+set_integral_eq_integral_of_ae_compl_eq_zero (eventually_of_forall h)
+
+lemma set_integral_neg_eq_set_integral_nonpos [linear_order E]
+  {f : α → E} (hf : ae_strongly_measurable f μ) :
   ∫ x in {x | f x < 0}, f x ∂μ = ∫ x in {x | f x ≤ 0}, f x ∂μ :=
 begin
   have h_union : {x | f x ≤ 0} = {x | f x < 0} ∪ {x | f x = 0},
-    by { ext, simp_rw [set.mem_union_eq, set.mem_set_of_eq], exact le_iff_lt_or_eq, },
+    by { ext, simp_rw [set.mem_union, set.mem_set_of_eq], exact le_iff_lt_or_eq, },
   rw h_union,
-  exact (set_integral_union_eq_left hf hfi (hf.measurable_set_lt strongly_measurable_const)
-    (λ x hx, hx)).symm,
+  have B : null_measurable_set {x | f x = 0} μ,
+    from hf.null_measurable_set_eq_fun ae_strongly_measurable_zero,
+  symmetry,
+  refine integral_union_eq_left_of_ae _,
+  filter_upwards [ae_restrict_mem₀ B] with x hx using hx,
 end
 
-lemma integral_norm_eq_pos_sub_neg {f : α → ℝ} (hf : strongly_measurable f)
-  (hfi : integrable f μ) :
-  ∫ x, ∥f x∥ ∂μ = ∫ x in {x | 0 ≤ f x}, f x ∂μ - ∫ x in {x | f x ≤ 0}, f x ∂μ :=
-have h_meas : measurable_set {x | 0 ≤ f x}, from strongly_measurable_const.measurable_set_le hf,
-calc ∫ x, ∥f x∥ ∂μ = ∫ x in {x | 0 ≤ f x}, ∥f x∥ ∂μ + ∫ x in {x | 0 ≤ f x}ᶜ, ∥f x∥ ∂μ :
-  by rw ← integral_add_compl h_meas hfi.norm
-... = ∫ x in {x | 0 ≤ f x}, f x ∂μ + ∫ x in {x | 0 ≤ f x}ᶜ, ∥f x∥ ∂μ :
+lemma integral_norm_eq_pos_sub_neg {f : α → ℝ} (hfi : integrable f μ) :
+  ∫ x, ‖f x‖ ∂μ = ∫ x in {x | 0 ≤ f x}, f x ∂μ - ∫ x in {x | f x ≤ 0}, f x ∂μ :=
+have h_meas : null_measurable_set {x | 0 ≤ f x} μ,
+  from ae_strongly_measurable_const.null_measurable_set_le hfi.1,
+calc ∫ x, ‖f x‖ ∂μ = ∫ x in {x | 0 ≤ f x}, ‖f x‖ ∂μ + ∫ x in {x | 0 ≤ f x}ᶜ, ‖f x‖ ∂μ :
+  by rw ← integral_add_compl₀ h_meas hfi.norm
+... = ∫ x in {x | 0 ≤ f x}, f x ∂μ + ∫ x in {x | 0 ≤ f x}ᶜ, ‖f x‖ ∂μ :
 begin
   congr' 1,
-  refine set_integral_congr h_meas (λ x hx, _),
+  refine set_integral_congr₀ h_meas (λ x hx, _),
   dsimp only,
   rw [real.norm_eq_abs, abs_eq_self.mpr _],
   exact hx,
@@ -266,14 +444,14 @@ end
 begin
   congr' 1,
   rw ← integral_neg,
-  refine set_integral_congr h_meas.compl (λ x hx, _),
+  refine set_integral_congr₀ h_meas.compl (λ x hx, _),
   dsimp only,
   rw [real.norm_eq_abs, abs_eq_neg_self.mpr _],
-  rw [set.mem_compl_iff, set.nmem_set_of_eq] at hx,
+  rw [set.mem_compl_iff, set.nmem_set_of_iff] at hx,
   linarith,
 end
 ... = ∫ x in {x | 0 ≤ f x}, f x ∂μ - ∫ x in {x | f x ≤ 0}, f x ∂μ :
-by { rw ← set_integral_neg_eq_set_integral_nonpos hf hfi, congr, ext1 x, simp, }
+by { rw ← set_integral_neg_eq_set_integral_nonpos hfi.1, congr, ext1 x, simp, }
 
 lemma set_integral_const (c : E) : ∫ x in s, c ∂μ = (μ s).to_real • c :=
 by rw [integral_const, measure.restrict_apply_univ]
@@ -339,8 +517,8 @@ lemma set_integral_map_equiv {β} [measurable_space β] (e : α ≃ᵐ β) (f :
 e.measurable_embedding.set_integral_map f s
 
 lemma norm_set_integral_le_of_norm_le_const_ae {C : ℝ} (hs : μ s < ∞)
-  (hC : ∀ᵐ x ∂μ.restrict s, ∥f x∥ ≤ C) :
-  ∥∫ x in s, f x ∂μ∥ ≤ C * (μ s).to_real :=
+  (hC : ∀ᵐ x ∂μ.restrict s, ‖f x‖ ≤ C) :
+  ‖∫ x in s, f x ∂μ‖ ≤ C * (μ s).to_real :=
 begin
   rw ← measure.restrict_apply_univ at *,
   haveI : is_finite_measure (μ.restrict s) := ⟨‹_›⟩,
@@ -348,33 +526,33 @@ begin
 end
 
 lemma norm_set_integral_le_of_norm_le_const_ae' {C : ℝ} (hs : μ s < ∞)
-  (hC : ∀ᵐ x ∂μ, x ∈ s → ∥f x∥ ≤ C) (hfm : ae_strongly_measurable f (μ.restrict s)) :
-  ∥∫ x in s, f x ∂μ∥ ≤ C * (μ s).to_real :=
+  (hC : ∀ᵐ x ∂μ, x ∈ s → ‖f x‖ ≤ C) (hfm : ae_strongly_measurable f (μ.restrict s)) :
+  ‖∫ x in s, f x ∂μ‖ ≤ C * (μ s).to_real :=
 begin
   apply norm_set_integral_le_of_norm_le_const_ae hs,
-  have A : ∀ᵐ (x : α) ∂μ, x ∈ s → ∥ae_strongly_measurable.mk f hfm x∥ ≤ C,
+  have A : ∀ᵐ (x : α) ∂μ, x ∈ s → ‖ae_strongly_measurable.mk f hfm x‖ ≤ C,
   { filter_upwards [hC, hfm.ae_mem_imp_eq_mk] with _ h1 h2 h3,
     rw [← h2 h3],
     exact h1 h3 },
-  have B : measurable_set {x | ∥(hfm.mk f) x∥ ≤ C} :=
+  have B : measurable_set {x | ‖(hfm.mk f) x‖ ≤ C} :=
     hfm.strongly_measurable_mk.norm.measurable measurable_set_Iic,
   filter_upwards [hfm.ae_eq_mk, (ae_restrict_iff B).2 A] with _ h1 _,
   rwa h1,
 end
 
 lemma norm_set_integral_le_of_norm_le_const_ae'' {C : ℝ} (hs : μ s < ∞) (hsm : measurable_set s)
-  (hC : ∀ᵐ x ∂μ, x ∈ s → ∥f x∥ ≤ C) :
-  ∥∫ x in s, f x ∂μ∥ ≤ C * (μ s).to_real :=
+  (hC : ∀ᵐ x ∂μ, x ∈ s → ‖f x‖ ≤ C) :
+  ‖∫ x in s, f x ∂μ‖ ≤ C * (μ s).to_real :=
 norm_set_integral_le_of_norm_le_const_ae hs $ by rwa [ae_restrict_eq hsm, eventually_inf_principal]
 
 lemma norm_set_integral_le_of_norm_le_const {C : ℝ} (hs : μ s < ∞)
-  (hC : ∀ x ∈ s, ∥f x∥ ≤ C) (hfm : ae_strongly_measurable f (μ.restrict s)) :
-  ∥∫ x in s, f x ∂μ∥ ≤ C * (μ s).to_real :=
+  (hC : ∀ x ∈ s, ‖f x‖ ≤ C) (hfm : ae_strongly_measurable f (μ.restrict s)) :
+  ‖∫ x in s, f x ∂μ‖ ≤ C * (μ s).to_real :=
 norm_set_integral_le_of_norm_le_const_ae' hs (eventually_of_forall hC) hfm
 
 lemma norm_set_integral_le_of_norm_le_const' {C : ℝ} (hs : μ s < ∞) (hsm : measurable_set s)
-  (hC : ∀ x ∈ s, ∥f x∥ ≤ C) :
-  ∥∫ x in s, f x ∂μ∥ ≤ C * (μ s).to_real :=
+  (hC : ∀ x ∈ s, ‖f x‖ ≤ C) :
+  ‖∫ x in s, f x ∂μ‖ ≤ C * (μ s).to_real :=
 norm_set_integral_le_of_norm_le_const_ae'' hs hsm $ eventually_of_forall hC
 
 lemma set_integral_eq_zero_iff_of_nonneg_ae {f : α → ℝ} (hf : 0 ≤ᵐ[μ.restrict s] f)
@@ -391,28 +569,99 @@ begin
   exact hfi.ae_strongly_measurable.ae_measurable.null_measurable (measurable_set_singleton 0).compl
 end
 
+lemma set_integral_gt_gt {R : ℝ} {f : α → ℝ} (hR : 0 ≤ R) (hfm : measurable f)
+  (hfint : integrable_on f {x | ↑R < f x} μ) (hμ : μ {x | ↑R < f x} ≠ 0):
+  (μ {x | ↑R < f x}).to_real * R < ∫ x in {x | ↑R < f x}, f x ∂μ :=
+begin
+  have : integrable_on (λ x, R) {x | ↑R < f x} μ,
+  { refine ⟨ae_strongly_measurable_const, lt_of_le_of_lt _ hfint.2⟩,
+    refine set_lintegral_mono (measurable.nnnorm _).coe_nnreal_ennreal
+      hfm.nnnorm.coe_nnreal_ennreal (λ x hx, _),
+    { exact measurable_const },
+    { simp only [ennreal.coe_le_coe, real.nnnorm_of_nonneg hR,
+        real.nnnorm_of_nonneg (hR.trans $ le_of_lt hx), subtype.mk_le_mk],
+      exact le_of_lt hx } },
+  rw [← sub_pos, ← smul_eq_mul, ← set_integral_const, ← integral_sub hfint this,
+    set_integral_pos_iff_support_of_nonneg_ae],
+  { rw ← zero_lt_iff at hμ,
+    rwa set.inter_eq_self_of_subset_right,
+    exact λ x hx, ne.symm (ne_of_lt $ sub_pos.2 hx) },
+  { change ∀ᵐ x ∂(μ.restrict _), _,
+    rw ae_restrict_iff,
+    { exact eventually_of_forall (λ x hx, sub_nonneg.2 $ le_of_lt hx) },
+    { exact measurable_set_le measurable_zero (hfm.sub measurable_const) } },
+  { exact integrable.sub hfint this },
+end
+
 lemma set_integral_trim {α} {m m0 : measurable_space α} {μ : measure α} (hm : m ≤ m0) {f : α → E}
   (hf_meas : strongly_measurable[m] f) {s : set α} (hs : measurable_set[m] s) :
   ∫ x in s, f x ∂μ = ∫ x in s, f x ∂(μ.trim hm) :=
 by rwa [integral_trim hm hf_meas, restrict_trim hm μ]
 
-lemma integral_Icc_eq_integral_Ioc' [partial_order α] {f : α → E} {a b : α} (ha : μ {a} = 0) :
+/-! ### Lemmas about adding and removing interval boundaries
+
+The primed lemmas take explicit arguments about the endpoint having zero measure, while the
+unprimed ones use `[has_no_atoms μ]`.
+-/
+
+section partial_order
+
+variables [partial_order α] {a b : α}
+
+lemma integral_Icc_eq_integral_Ioc' (ha : μ {a} = 0) :
   ∫ t in Icc a b, f t ∂μ = ∫ t in Ioc a b, f t ∂μ :=
 set_integral_congr_set_ae (Ioc_ae_eq_Icc' ha).symm
 
-lemma integral_Ioc_eq_integral_Ioo' [partial_order α] {f : α → E} {a b : α} (hb : μ {b} = 0) :
+lemma integral_Icc_eq_integral_Ico' (hb : μ {b} = 0) :
+  ∫ t in Icc a b, f t ∂μ = ∫ t in Ico a b, f t ∂μ :=
+set_integral_congr_set_ae (Ico_ae_eq_Icc' hb).symm
+
+lemma integral_Ioc_eq_integral_Ioo' (hb : μ {b} = 0) :
   ∫ t in Ioc a b, f t ∂μ = ∫ t in Ioo a b, f t ∂μ :=
 set_integral_congr_set_ae (Ioo_ae_eq_Ioc' hb).symm
 
-lemma integral_Icc_eq_integral_Ioc [partial_order α] {f : α → E} {a b : α} [has_no_atoms μ] :
-  ∫ t in Icc a b, f t ∂μ = ∫ t in Ioc a b, f t ∂μ :=
+lemma integral_Ico_eq_integral_Ioo' (ha : μ {a} = 0) :
+  ∫ t in Ico a b, f t ∂μ = ∫ t in Ioo a b, f t ∂μ :=
+set_integral_congr_set_ae (Ioo_ae_eq_Ico' ha).symm
+
+lemma integral_Icc_eq_integral_Ioo' (ha : μ {a} = 0) (hb : μ {b} = 0) :
+  ∫ t in Icc a b, f t ∂μ = ∫ t in Ioo a b, f t ∂μ :=
+set_integral_congr_set_ae (Ioo_ae_eq_Icc' ha hb).symm
+
+lemma integral_Iic_eq_integral_Iio' (ha : μ {a} = 0) :
+  ∫ t in Iic a, f t ∂μ = ∫ t in Iio a, f t ∂μ :=
+set_integral_congr_set_ae (Iio_ae_eq_Iic' ha).symm
+
+lemma integral_Ici_eq_integral_Ioi' (ha : μ {a} = 0) :
+  ∫ t in Ici a, f t ∂μ = ∫ t in Ioi a, f t ∂μ :=
+set_integral_congr_set_ae (Ioi_ae_eq_Ici' ha).symm
+
+variable [has_no_atoms μ]
+
+lemma integral_Icc_eq_integral_Ioc : ∫ t in Icc a b, f t ∂μ = ∫ t in Ioc a b, f t ∂μ :=
 integral_Icc_eq_integral_Ioc' $ measure_singleton a
 
-lemma integral_Ioc_eq_integral_Ioo [partial_order α] {f : α → E} {a b : α} [has_no_atoms μ] :
-  ∫ t in Ioc a b, f t ∂μ = ∫ t in Ioo a b, f t ∂μ :=
+lemma integral_Icc_eq_integral_Ico : ∫ t in Icc a b, f t ∂μ = ∫ t in Ico a b, f t ∂μ :=
+integral_Icc_eq_integral_Ico' $ measure_singleton b
+
+lemma integral_Ioc_eq_integral_Ioo : ∫ t in Ioc a b, f t ∂μ = ∫ t in Ioo a b, f t ∂μ :=
 integral_Ioc_eq_integral_Ioo' $ measure_singleton b
 
-end normed_group
+lemma integral_Ico_eq_integral_Ioo : ∫ t in Ico a b, f t ∂μ = ∫ t in Ioo a b, f t ∂μ :=
+integral_Ico_eq_integral_Ioo' $ measure_singleton a
+
+lemma integral_Icc_eq_integral_Ioo : ∫ t in Icc a b, f t ∂μ = ∫ t in Ico a b, f t ∂μ :=
+by rw [integral_Icc_eq_integral_Ico, integral_Ico_eq_integral_Ioo]
+
+lemma integral_Iic_eq_integral_Iio : ∫ t in Iic a, f t ∂μ = ∫ t in Iio a, f t ∂μ :=
+integral_Iic_eq_integral_Iio' $ measure_singleton a
+
+lemma integral_Ici_eq_integral_Ioi : ∫ t in Ici a, f t ∂μ = ∫ t in Ioi a, f t ∂μ :=
+integral_Ici_eq_integral_Ioi' $ measure_singleton a
+
+end partial_order
+
+end normed_add_comm_group
 
 section mono
 
@@ -447,6 +696,14 @@ lemma set_integral_mono_set (hfi : integrable_on f t μ) (hf : 0 ≤ᵐ[μ.restr
   ∫ x in s, f x ∂μ ≤ ∫ x in t, f x ∂μ :=
 integral_mono_measure (measure.restrict_mono_ae hst) hf hfi
 
+lemma set_integral_ge_of_const_le {c : ℝ} (hs : measurable_set s) (hμs : μ s ≠ ∞)
+  (hf : ∀ x ∈ s, c ≤ f x) (hfint : integrable_on (λ (x : α), f x) s μ) :
+  c * (μ s).to_real ≤ ∫ x in s, f x ∂μ :=
+begin
+  rw [mul_comm, ← smul_eq_mul, ← set_integral_const c],
+  exact set_integral_mono_on (integrable_on_const.2 (or.inr hμs.lt_top)) hfint hs hf,
+end
+
 end mono
 
 section nonneg
@@ -506,16 +763,64 @@ end
 
 end nonneg
 
+section integrable_Union
+
+variables {μ : measure α} [normed_add_comm_group E] [countable β]
+
+lemma integrable_on_Union_of_summable_integral_norm {f : α → E} {s : β → set α}
+  (hs : ∀ (b : β), measurable_set (s b)) (hi : ∀ (b : β), integrable_on f (s b) μ)
+  (h : summable (λ (b : β), ∫ (a : α) in s b, ‖f a‖ ∂μ)) :
+  integrable_on f (Union s) μ :=
+begin
+  refine ⟨ae_strongly_measurable.Union (λ i, (hi i).1), (lintegral_Union_le _ _).trans_lt _⟩,
+  have B := λ (b : β), lintegral_coe_eq_integral (λ (a : α), ‖f a‖₊) (hi b).norm,
+  rw tsum_congr B,
+  have S' : summable (λ (b : β), (⟨∫ (a : α) in s b, ‖f a‖₊ ∂μ,
+    set_integral_nonneg (hs b) (λ a ha, nnreal.coe_nonneg _)⟩ : nnreal)),
+  { rw ←nnreal.summable_coe, exact h },
+  have S'' := ennreal.tsum_coe_eq S'.has_sum,
+  simp_rw [ennreal.coe_nnreal_eq, nnreal.coe_mk, coe_nnnorm] at S'',
+  convert ennreal.of_real_lt_top,
+end
+
+variables [topological_space α] [borel_space α] [metrizable_space α] [is_locally_finite_measure μ]
+
+/-- If `s` is a countable family of compact sets, `f` is a continuous function, and the sequence
+`‖f.restrict (s i)‖ * μ (s i)` is summable, then `f` is integrable on the union of the `s i`. -/
+lemma integrable_on_Union_of_summable_norm_restrict {f : C(α, E)} {s : β → compacts α}
+  (hf : summable (λ i : β, ‖f.restrict (s i)‖ * ennreal.to_real (μ $ s i))) :
+  integrable_on f (⋃ i : β, s i) μ :=
+begin
+  refine integrable_on_Union_of_summable_integral_norm
+    (λ i, (s i).is_compact.is_closed.measurable_set)
+    (λ i, (map_continuous f).continuous_on.integrable_on_compact (s i).is_compact)
+    (summable_of_nonneg_of_le (λ ι, integral_nonneg (λ x, norm_nonneg _)) (λ i, _) hf),
+  rw ←(real.norm_of_nonneg (integral_nonneg (λ a, norm_nonneg _)) : ‖_‖ = ∫ x in s i, ‖f x‖ ∂μ),
+  exact norm_set_integral_le_of_norm_le_const' (s i).is_compact.measure_lt_top
+    (s i).is_compact.is_closed.measurable_set
+    (λ x hx, (norm_norm (f x)).symm ▸ (f.restrict ↑(s i)).norm_coe_le_norm ⟨x, hx⟩)
+end
+
+/-- If `s` is a countable family of compact sets covering `α`, `f` is a continuous function, and
+the sequence `‖f.restrict (s i)‖ * μ (s i)` is summable, then `f` is integrable. -/
+lemma integrable_of_summable_norm_restrict {f : C(α, E)} {s : β → compacts α}
+  (hf : summable (λ i : β, ‖f.restrict (s i)‖ * ennreal.to_real (μ $ s i)))
+  (hs : (⋃ i : β, ↑(s i)) = (univ : set α)) :
+  integrable f μ :=
+by simpa only [hs, integrable_on_univ] using integrable_on_Union_of_summable_norm_restrict hf
+
+end integrable_Union
+
 section tendsto_mono
 
-variables {μ : measure α} [normed_group E] [complete_space E] [normed_space ℝ E]
+variables {μ : measure α} [normed_add_comm_group E] [complete_space E] [normed_space ℝ E]
   {s : ℕ → set α} {f : α → E}
 
 lemma _root_.antitone.tendsto_set_integral (hsm : ∀ i, measurable_set (s i))
   (h_anti : antitone s) (hfi : integrable_on f (s 0) μ) :
   tendsto (λi, ∫ a in s i, f a ∂μ) at_top (𝓝 (∫ a in (⋂ n, s n), f a ∂μ)) :=
 begin
-  let bound : α → ℝ := indicator (s 0) (λ a, ∥f a∥),
+  let bound : α → ℝ := indicator (s 0) (λ a, ‖f a‖),
   have h_int_eq : (λ i, ∫ a in s i, f a ∂μ) = (λ i, ∫ a, (s i).indicator f a ∂μ),
     from funext (λ i, (integral_indicator (hsm i)).symm),
   rw h_int_eq,
@@ -539,8 +844,8 @@ end tendsto_mono
 We prove that for any set `s`, the function `λ f : α →₁[μ] E, ∫ x in s, f x ∂μ` is continuous. -/
 
 section continuous_set_integral
-variables [normed_group E] {𝕜 : Type*} [is_R_or_C 𝕜] [normed_group F] [normed_space 𝕜 F]
-  {p : ℝ≥0∞} {μ : measure α}
+variables [normed_add_comm_group E] {𝕜 : Type*} [normed_field 𝕜] [normed_add_comm_group F]
+  [normed_space 𝕜 F] {p : ℝ≥0∞} {μ : measure α}
 
 /-- For `f : Lp E p μ`, we can define an element of `Lp E p (μ.restrict s)` by
 `(Lp.mem_ℒp f).restrict s).to_Lp f`. This map is additive. -/
@@ -575,7 +880,7 @@ end
 /-- For `f : Lp E p μ`, we can define an element of `Lp E p (μ.restrict s)` by
 `(Lp.mem_ℒp f).restrict s).to_Lp f`. This map is non-expansive. -/
 lemma norm_Lp_to_Lp_restrict_le (s : set α) (f : Lp E p μ) :
-  ∥((Lp.mem_ℒp f).restrict s).to_Lp f∥ ≤ ∥f∥ :=
+  ‖((Lp.mem_ℒp f).restrict s).to_Lp f‖ ≤ ‖f‖ :=
 begin
   rw [Lp.norm_def, Lp.norm_def, ennreal.to_real_le_to_real (Lp.snorm_ne_top _) (Lp.snorm_ne_top _)],
   refine (le_of_eq _).trans (snorm_mono_measure _ measure.restrict_le_self),
@@ -621,7 +926,7 @@ end measure_theory
 
 open measure_theory asymptotics metric
 
-variables {ι : Type*} [normed_group E]
+variables {ι : Type*} [normed_add_comm_group E]
 
 /-- Fundamental theorem of calculus for set integrals: if `μ` is a measure that is finite at a
 filter `l` and `f` is a measurable function that has a finite limit `b` at `l ⊓ μ.ae`, then `∫ x in
@@ -639,9 +944,9 @@ lemma filter.tendsto.integral_sub_linear_is_o_ae
   {s : ι → set α} {li : filter ι} (hs : tendsto s li l.small_sets)
   (m : ι → ℝ := λ i, (μ (s i)).to_real)
   (hsμ : (λ i, (μ (s i)).to_real) =ᶠ[li] m . tactic.interactive.refl) :
-  is_o (λ i, ∫ x in s i, f x ∂μ - m i • b) m li :=
+  (λ i, ∫ x in s i, f x ∂μ - m i • b) =o[li] m :=
 begin
-  suffices : is_o (λ s, ∫ x in s, f x ∂μ - (μ s).to_real • b) (λ s, (μ s).to_real) l.small_sets,
+  suffices : (λ s, ∫ x in s, f x ∂μ - (μ s).to_real • b) =o[l.small_sets] (λ s, (μ s).to_real),
     from (this.comp_tendsto hs).congr' (hsμ.mono $ λ a ha, ha ▸ rfl) hsμ,
   refine is_o_iff.2 (λ ε ε₀, _),
   have : ∀ᶠ s in l.small_sets, ∀ᶠ x in μ.ae, x ∈ s → f x ∈ closed_ball b ε :=
@@ -673,7 +978,7 @@ lemma continuous_within_at.integral_sub_linear_is_o_ae
   {s : ι → set α} {li : filter ι} (hs : tendsto s li (𝓝[t] a).small_sets)
   (m : ι → ℝ := λ i, (μ (s i)).to_real)
   (hsμ : (λ i, (μ (s i)).to_real) =ᶠ[li] m . tactic.interactive.refl) :
-  is_o (λ i, ∫ x in s i, f x ∂μ - m i • f a) m li :=
+  (λ i, ∫ x in s i, f x ∂μ - m i • f a) =o[li] m :=
 by haveI : (𝓝[t] a).is_measurably_generated := ht.nhds_within_is_measurably_generated _;
 exact (ha.mono_left inf_le_left).integral_sub_linear_is_o_ae
   hfm (μ.finite_at_nhds_within a t) hs m hsμ
@@ -695,7 +1000,7 @@ lemma continuous_at.integral_sub_linear_is_o_ae
   {s : ι → set α} {li : filter ι} (hs : tendsto s li (𝓝 a).small_sets)
   (m : ι → ℝ := λ i, (μ (s i)).to_real)
   (hsμ : (λ i, (μ (s i)).to_real) =ᶠ[li] m . tactic.interactive.refl) :
-  is_o (λ i, ∫ x in s i, f x ∂μ - m i • f a) m li :=
+  (λ i, ∫ x in s i, f x ∂μ - m i • f a) =o[li] m :=
 (ha.mono_left inf_le_left).integral_sub_linear_is_o_ae hfm (μ.finite_at_nhds a) hs m hsμ
 
 /-- Fundamental theorem of calculus for set integrals, `nhds_within` version: if `μ` is a locally
@@ -714,7 +1019,7 @@ lemma continuous_on.integral_sub_linear_is_o_ae
   {s : ι → set α} {li : filter ι} (hs : tendsto s li (𝓝[t] a).small_sets)
   (m : ι → ℝ := λ i, (μ (s i)).to_real)
   (hsμ : (λ i, (μ (s i)).to_real) =ᶠ[li] m . tactic.interactive.refl) :
-  is_o (λ i, ∫ x in s i, f x ∂μ - m i • f a) m li :=
+  (λ i, ∫ x in s i, f x ∂μ - m i • f a) =o[li] m :=
 (hft a ha).integral_sub_linear_is_o_ae ht
   ⟨t, self_mem_nhds_within, hft.ae_strongly_measurable ht⟩ hs m hsμ
 
@@ -731,7 +1036,7 @@ as `continuous_linear_map.comp_Lp`. We take advantage of this construction here.
 open_locale complex_conjugate
 
 variables {μ : measure α} {𝕜 : Type*} [is_R_or_C 𝕜] [normed_space 𝕜 E]
-  [normed_group F] [normed_space 𝕜 F]
+  [normed_add_comm_group F] [normed_space 𝕜 F]
   {p : ennreal}
 
 namespace continuous_linear_map
@@ -773,7 +1078,7 @@ begin
   all_goals { assumption }
 end
 
-lemma integral_apply {H : Type*} [normed_group H] [normed_space 𝕜 H]
+lemma integral_apply {H : Type*} [normed_add_comm_group H] [normed_space 𝕜 H]
   {φ : α → H →L[𝕜] E} (φ_int : integrable φ μ) (v : H) :
   (∫ a, φ a ∂μ) v = ∫ a, φ a v ∂μ :=
 ((continuous_linear_map.apply 𝕜 E v).integral_comp_comm φ_int).symm
@@ -802,6 +1107,15 @@ L.to_continuous_linear_map.integral_comp_comm' L.antilipschitz _
 
 end linear_isometry
 
+namespace continuous_linear_equiv
+
+variables [complete_space F] [normed_space ℝ F] [complete_space E] [normed_space ℝ E]
+
+lemma integral_comp_comm (L : E ≃L[𝕜] F) (φ : α → E) : ∫ a, L (φ a) ∂μ = L (∫ a, φ a ∂μ) :=
+L.to_continuous_linear_map.integral_comp_comm' L.antilipschitz _
+
+end continuous_linear_equiv
+
 variables [complete_space E] [normed_space ℝ E] [complete_space F] [normed_space ℝ F]
 
 @[norm_cast] lemma integral_of_real {f : α → ℝ} : ∫ a, (f a : 𝕜) ∂μ = ↑∫ a, f a ∂μ :=
@@ -862,23 +1176,6 @@ begin
     simp_rw [integrable_smul_const hc, hf, not_false_iff] }
 end
 
-section inner
-
-variables {E' : Type*} [inner_product_space 𝕜 E'] [complete_space E'] [normed_space ℝ E']
-
-local notation `⟪`x`, `y`⟫` := @inner 𝕜 E' _ x y
-
-lemma integral_inner {f : α → E'} (hf : integrable f μ) (c : E') :
-  ∫ x, ⟪c, f x⟫ ∂μ = ⟪c, ∫ x, f x ∂μ⟫ :=
-((@innerSL 𝕜 E' _ _ c).restrict_scalars ℝ).integral_comp_comm hf
-
-lemma integral_eq_zero_of_forall_integral_inner_eq_zero (f : α → E') (hf : integrable f μ)
-  (hf_int : ∀ (c : E'), ∫ x, ⟪c, f x⟫ ∂μ = 0) :
-  ∫ x, f x ∂μ = 0 :=
-by { specialize hf_int (∫ x, f x ∂μ), rwa [integral_inner hf, inner_self_eq_zero] at hf_int }
-
-end inner
-
 lemma integral_with_density_eq_integral_smul
   {f : α → ℝ≥0} (f_meas : measurable f) (g : α → E) :
   ∫ a, g a ∂(μ.with_density (λ x, f x)) = ∫ a, f a • g a ∂μ :=
@@ -962,3 +1259,58 @@ lemma set_integral_with_density_eq_set_integral_smul₀ {f : α → ℝ≥0} {s
 by rw [restrict_with_density hs, integral_with_density_eq_integral_smul₀ hf]
 
 end
+
+section thickened_indicator
+
+variables [pseudo_emetric_space α]
+
+lemma measure_le_lintegral_thickened_indicator_aux
+  (μ : measure α) {E : set α} (E_mble : measurable_set E) (δ : ℝ) :
+  μ E ≤ ∫⁻ a, (thickened_indicator_aux δ E a : ℝ≥0∞) ∂μ :=
+begin
+  convert_to lintegral μ (E.indicator (λ _, (1 : ℝ≥0∞)))
+              ≤ lintegral μ (thickened_indicator_aux δ E),
+  { rw [lintegral_indicator _ E_mble],
+    simp only [lintegral_one, measure.restrict_apply, measurable_set.univ, univ_inter], },
+  { apply lintegral_mono,
+    apply indicator_le_thickened_indicator_aux, },
+end
+
+lemma measure_le_lintegral_thickened_indicator
+  (μ : measure α) {E : set α} (E_mble : measurable_set E) {δ : ℝ} (δ_pos : 0 < δ) :
+  μ E ≤ ∫⁻ a, (thickened_indicator δ_pos E a : ℝ≥0∞) ∂μ :=
+begin
+  convert measure_le_lintegral_thickened_indicator_aux μ E_mble δ,
+  dsimp,
+  simp only [thickened_indicator_aux_lt_top.ne, ennreal.coe_to_nnreal, ne.def, not_false_iff],
+end
+
+end thickened_indicator
+
+section bilinear_map
+namespace measure_theory
+
+variables {f : β → ℝ} {m m0 : measurable_space β} {μ : measure β}
+
+lemma integrable.simple_func_mul (g : simple_func β ℝ) (hf : integrable f μ) :
+  integrable (g * f) μ :=
+begin
+  refine simple_func.induction (λ c s hs, _) (λ g₁ g₂ h_disj h_int₁ h_int₂,
+    (h_int₁.add h_int₂).congr (by rw [simple_func.coe_add, add_mul])) g,
+  simp only [simple_func.const_zero, simple_func.coe_piecewise, simple_func.coe_const,
+    simple_func.coe_zero, set.piecewise_eq_indicator],
+  have : set.indicator s (function.const β c) * f = s.indicator (c • f),
+  { ext1 x,
+    by_cases hx : x ∈ s,
+    { simp only [hx, pi.mul_apply, set.indicator_of_mem, pi.smul_apply, algebra.id.smul_eq_mul] },
+    { simp only [hx, pi.mul_apply, set.indicator_of_not_mem, not_false_iff, zero_mul], }, },
+  rw [this, integrable_indicator_iff hs],
+  exact (hf.smul c).integrable_on,
+end
+
+lemma integrable.simple_func_mul' (hm : m ≤ m0) (g : @simple_func β m ℝ) (hf : integrable f μ) :
+  integrable (g * f) μ :=
+by { rw ← simple_func.coe_to_larger_space_eq hm g, exact hf.simple_func_mul (g.to_larger_space hm) }
+
+end measure_theory
+end bilinear_map
diff --git a/src/measure_theory/integral/set_to_l1.lean b/src/measure_theory/integral/set_to_l1.lean
index e98d1aac0ef20..fdb5dcd6ab6d7 100644
--- a/src/measure_theory/integral/set_to_l1.lean
+++ b/src/measure_theory/integral/set_to_l1.lean
@@ -8,6 +8,9 @@ import measure_theory.function.simple_func_dense_lp
 /-!
 # Extension of a linear function from indicators to L1
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `T : set α → E →L[ℝ] F` be additive for measurable sets with finite measure, in the sense that
 for `s, t` two such sets, `s ∩ t = ∅ → T (s ∪ t) = T s + T t`. `T` is akin to a bilinear map on
 `set α × E`, or a linear map on indicator functions.
@@ -24,7 +27,7 @@ expectation of an integrable function in `measure_theory.function.conditional_ex
 
 - `fin_meas_additive μ T`: the property that `T` is additive on measurable sets with finite measure.
   For two such sets, `s ∩ t = ∅ → T (s ∪ t) = T s + T t`.
-- `dominated_fin_meas_additive μ T C`: `fin_meas_additive μ T ∧ ∀ s, ∥T s∥ ≤ C * (μ s).to_real`.
+- `dominated_fin_meas_additive μ T C`: `fin_meas_additive μ T ∧ ∀ s, ‖T s‖ ≤ C * (μ s).to_real`.
   This is the property needed to perform the extension from indicators to L1.
 - `set_to_L1 (hT : dominated_fin_meas_additive μ T C) : (α →₁[μ] E) →L[ℝ] F`: the extension of `T`
   from indicators to L1.
@@ -68,16 +71,16 @@ with finite measure. Its value on other sets is ignored.
 -/
 
 noncomputable theory
-open_locale classical topological_space big_operators nnreal ennreal measure_theory pointwise
+open_locale classical topology big_operators nnreal ennreal measure_theory pointwise
 open set filter topological_space ennreal emetric
 
 namespace measure_theory
 
 variables {α E F F' G 𝕜 : Type*} {p : ℝ≥0∞}
-  [normed_group E] [normed_space ℝ E]
-  [normed_group F] [normed_space ℝ F]
-  [normed_group F'] [normed_space ℝ F']
-  [normed_group G]
+  [normed_add_comm_group E] [normed_space ℝ E]
+  [normed_add_comm_group F] [normed_space ℝ F]
+  [normed_add_comm_group F'] [normed_space ℝ F']
+  [normed_add_comm_group G]
   {m : measurable_space α} {μ : measure α}
 
 local infixr ` →ₛ `:25 := simple_func
@@ -156,7 +159,7 @@ lemma map_Union_fin_meas_set_eq_sum (T : set α → β) (T_empty : T ∅ = 0)
 begin
   revert hSp h_disj,
   refine finset.induction_on sι _ _,
-  { simp only [finset.not_mem_empty, forall_false_left, Union_false, Union_empty, sum_empty,
+  { simp only [finset.not_mem_empty, is_empty.forall_iff, Union_false, Union_empty, sum_empty,
     forall_2_true_iff, implies_true_iff, forall_true_left, not_false_iff, T_empty], },
   intros a s has h hps h_disj,
   rw [finset.sum_insert has, ← h],
@@ -180,13 +183,13 @@ end fin_meas_additive
 
 /-- A `fin_meas_additive` set function whose norm on every set is less than the measure of the
 set (up to a multiplicative constant). -/
-def dominated_fin_meas_additive {β} [semi_normed_group β] {m : measurable_space α}
+def dominated_fin_meas_additive {β} [seminormed_add_comm_group β] {m : measurable_space α}
   (μ : measure α) (T : set α → β) (C : ℝ) : Prop :=
-fin_meas_additive μ T ∧ ∀ s, measurable_set s → μ s < ∞ → ∥T s∥ ≤ C * (μ s).to_real
+fin_meas_additive μ T ∧ ∀ s, measurable_set s → μ s < ∞ → ‖T s‖ ≤ C * (μ s).to_real
 
 namespace dominated_fin_meas_additive
 
-variables {β : Type*} [semi_normed_group β] {T T' : set α → β} {C C' : ℝ}
+variables {β : Type*} [seminormed_add_comm_group β] {T T' : set α → β} {C C' : ℝ}
 
 lemma zero {m : measurable_space α} (μ : measure α) (hC : 0 ≤ C) :
   dominated_fin_meas_additive μ (0 : set α → β) C :=
@@ -196,7 +199,7 @@ begin
   exact mul_nonneg hC to_real_nonneg,
 end
 
-lemma eq_zero_of_measure_zero {β : Type*} [normed_group β] {T : set α → β} {C : ℝ}
+lemma eq_zero_of_measure_zero {β : Type*} [normed_add_comm_group β] {T : set α → β} {C : ℝ}
   (hT : dominated_fin_meas_additive μ T C) {s : set α}
   (hs : measurable_set s) (hs_zero : μ s = 0) :
   T s = 0 :=
@@ -206,7 +209,7 @@ begin
   rw [hs_zero, ennreal.zero_to_real, mul_zero],
 end
 
-lemma eq_zero {β : Type*} [normed_group β] {T : set α → β} {C : ℝ}
+lemma eq_zero {β : Type*} [normed_add_comm_group β] {T : set α → β} {C : ℝ}
   {m : measurable_space α} (hT : dominated_fin_meas_additive (0 : measure α) T C)
   {s : set α} (hs : measurable_set s) :
   T s = 0 :=
@@ -222,7 +225,7 @@ end
 
 lemma smul [normed_field 𝕜] [normed_space 𝕜 β] (hT : dominated_fin_meas_additive μ T C)
   (c : 𝕜) :
-  dominated_fin_meas_additive μ (λ s, c • (T s)) (∥c∥ * C) :=
+  dominated_fin_meas_additive μ (λ s, c • (T s)) (‖c‖ * C) :=
 begin
   refine ⟨hT.1.smul c, λ s hs hμs, _⟩,
   dsimp only,
@@ -511,7 +514,7 @@ calc set_to_simple_func T (c • f) = ∑ x in f.range, T (f ⁻¹' {x}) (c •
 ... = c • set_to_simple_func T f :
 by simp only [set_to_simple_func, smul_sum, smul_smul, mul_comm]
 
-lemma set_to_simple_func_smul {E} [normed_group E] [normed_field 𝕜]
+lemma set_to_simple_func_smul {E} [normed_add_comm_group E] [normed_field 𝕜]
   [normed_space 𝕜 E] [normed_space ℝ E] [normed_space 𝕜 F] (T : set α → E →L[ℝ] F)
   (h_add : fin_meas_additive μ T) (h_smul : ∀ c : 𝕜, ∀ s x, T s (c • x) = c • T s x)
   (c : 𝕜) {f : α →ₛ E} (hf : integrable f μ) :
@@ -588,46 +591,37 @@ end order
 
 lemma norm_set_to_simple_func_le_sum_op_norm {m : measurable_space α}
   (T : set α → F' →L[ℝ] F) (f : α →ₛ F') :
-  ∥f.set_to_simple_func T∥ ≤ ∑ x in f.range, ∥T (f ⁻¹' {x})∥ * ∥x∥ :=
-calc ∥∑ x in f.range, T (f ⁻¹' {x}) x∥
-    ≤ ∑ x in f.range, ∥T (f ⁻¹' {x}) x∥ : norm_sum_le _ _
-... ≤ ∑ x in f.range, ∥T (f ⁻¹' {x})∥ * ∥x∥ :
+  ‖f.set_to_simple_func T‖ ≤ ∑ x in f.range, ‖T (f ⁻¹' {x})‖ * ‖x‖ :=
+calc ‖∑ x in f.range, T (f ⁻¹' {x}) x‖
+    ≤ ∑ x in f.range, ‖T (f ⁻¹' {x}) x‖ : norm_sum_le _ _
+... ≤ ∑ x in f.range, ‖T (f ⁻¹' {x})‖ * ‖x‖ :
   by { refine finset.sum_le_sum (λb hb, _), simp_rw continuous_linear_map.le_op_norm, }
 
 lemma norm_set_to_simple_func_le_sum_mul_norm (T : set α → F →L[ℝ] F') {C : ℝ}
-  (hT_norm : ∀ s, measurable_set s → ∥T s∥ ≤ C * (μ s).to_real) (f : α →ₛ F) :
-  ∥f.set_to_simple_func T∥ ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ∥x∥ :=
-calc ∥f.set_to_simple_func T∥
-    ≤ ∑ x in f.range, ∥T (f ⁻¹' {x})∥ * ∥x∥ : norm_set_to_simple_func_le_sum_op_norm T f
-... ≤ ∑ x in f.range, C * (μ (f ⁻¹' {x})).to_real * ∥x∥ :
-  begin
-    refine finset.sum_le_sum (λ b hb, _),
-    by_cases hb : ∥b∥ = 0,
-    { rw hb, simp, },
-    rw _root_.mul_le_mul_right _,
-    { exact hT_norm _ (simple_func.measurable_set_fiber _ _), },
-    { exact lt_of_le_of_ne (norm_nonneg _) (ne.symm hb), },
-  end
-... ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ∥x∥ : by simp_rw [mul_sum, ← mul_assoc]
+  (hT_norm : ∀ s, measurable_set s → ‖T s‖ ≤ C * (μ s).to_real) (f : α →ₛ F) :
+  ‖f.set_to_simple_func T‖ ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ‖x‖ :=
+calc ‖f.set_to_simple_func T‖
+    ≤ ∑ x in f.range, ‖T (f ⁻¹' {x})‖ * ‖x‖ : norm_set_to_simple_func_le_sum_op_norm T f
+... ≤ ∑ x in f.range, C * (μ (f ⁻¹' {x})).to_real * ‖x‖
+    : sum_le_sum $ λ b hb, mul_le_mul_of_nonneg_right
+        (hT_norm _ $ simple_func.measurable_set_fiber _ _) $ norm_nonneg _
+... ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ‖x‖ : by simp_rw [mul_sum, ← mul_assoc]
 
 lemma norm_set_to_simple_func_le_sum_mul_norm_of_integrable (T : set α → E →L[ℝ] F') {C : ℝ}
-  (hT_norm : ∀ s, measurable_set s → μ s < ∞ → ∥T s∥ ≤ C * (μ s).to_real) (f : α →ₛ E)
+  (hT_norm : ∀ s, measurable_set s → μ s < ∞ → ‖T s‖ ≤ C * (μ s).to_real) (f : α →ₛ E)
   (hf : integrable f μ) :
-  ∥f.set_to_simple_func T∥ ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ∥x∥ :=
-calc ∥f.set_to_simple_func T∥
-    ≤ ∑ x in f.range, ∥T (f ⁻¹' {x})∥ * ∥x∥ : norm_set_to_simple_func_le_sum_op_norm T f
-... ≤ ∑ x in f.range, C * (μ (f ⁻¹' {x})).to_real * ∥x∥ :
+  ‖f.set_to_simple_func T‖ ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ‖x‖ :=
+calc ‖f.set_to_simple_func T‖
+    ≤ ∑ x in f.range, ‖T (f ⁻¹' {x})‖ * ‖x‖ : norm_set_to_simple_func_le_sum_op_norm T f
+... ≤ ∑ x in f.range, C * (μ (f ⁻¹' {x})).to_real * ‖x‖ :
   begin
     refine finset.sum_le_sum (λ b hb, _),
-    by_cases hb : ∥b∥ = 0,
-    { rw hb, simp, },
-    rw _root_.mul_le_mul_right _,
-    { refine hT_norm _ (simple_func.measurable_set_fiber _ _)
-        (simple_func.measure_preimage_lt_top_of_integrable _ hf _),
-      rwa norm_eq_zero at hb, },
-    { exact lt_of_le_of_ne (norm_nonneg _) (ne.symm hb), },
+    obtain rfl | hb := eq_or_ne b 0,
+    { simp },
+    exact mul_le_mul_of_nonneg_right (hT_norm _ (simple_func.measurable_set_fiber _ _) $
+      simple_func.measure_preimage_lt_top_of_integrable _ hf hb) (norm_nonneg _),
   end
-... ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ∥x∥ : by simp_rw [mul_sum, ← mul_assoc]
+... ≤ C * ∑ x in f.range, (μ (f ⁻¹' {x})).to_real * ‖x‖ : by simp_rw [mul_sum, ← mul_assoc]
 
 lemma set_to_simple_func_indicator (T : set α → F →L[ℝ] F') (hT_empty : T ∅ = 0)
   {m : measurable_space α} {s : set α} (hs : measurable_set s) (x : F) :
@@ -635,17 +629,13 @@ lemma set_to_simple_func_indicator (T : set α → F →L[ℝ] F') (hT_empty : T
     (simple_func.piecewise s hs (simple_func.const α x) (simple_func.const α 0))
   = T s x :=
 begin
-  by_cases hs_empty : s = ∅,
-  { simp only [hs_empty, hT_empty, continuous_linear_map.zero_apply, piecewise_empty, const_zero,
-    set_to_simple_func_zero_apply], },
-  by_cases hs_univ : s = univ,
-  { casesI hα : is_empty_or_nonempty α,
-    { refine absurd _ hs_empty,
-      haveI : subsingleton (set α), by { unfold set, apply_instance, },
-      exact subsingleton.elim s ∅, },
-    simp [hs_univ, set_to_simple_func], },
+  obtain rfl | hs_empty := s.eq_empty_or_nonempty,
+  { simp only [hT_empty, continuous_linear_map.zero_apply, piecewise_empty, const_zero,
+      set_to_simple_func_zero_apply], },
   simp_rw set_to_simple_func,
-  rw [← ne.def, set.ne_empty_iff_nonempty] at hs_empty,
+  obtain rfl | hs_univ := eq_or_ne s univ,
+  { haveI hα := hs_empty.to_type,
+    simp },
   rw range_indicator hs hs_empty hs_univ,
   by_cases hx0 : x = 0,
   { simp_rw hx0, simp, },
@@ -673,9 +663,7 @@ lemma set_to_simple_func_const (T : set α → F →L[ℝ] F') (hT_empty : T ∅
   simple_func.set_to_simple_func T (simple_func.const α x) = T univ x :=
 begin
   casesI hα : is_empty_or_nonempty α,
-  { have h_univ_empty : (univ : set α) = ∅,
-    { haveI : unique (set α) := unique_empty,
-      exact subsingleton.elim (univ : set α) (∅ : set α), },
+  { have h_univ_empty : (univ : set α) = ∅, from subsingleton.elim _ _,
     rw [h_univ_empty, hT_empty],
     simp only [set_to_simple_func, continuous_linear_map.zero_apply, sum_empty,
       range_eq_empty_of_is_empty], },
@@ -693,10 +681,10 @@ variables {α E μ}
 namespace simple_func
 
 lemma norm_eq_sum_mul (f : α →₁ₛ[μ] G) :
-  ∥f∥ = ∑ x in (to_simple_func f).range, (μ ((to_simple_func f) ⁻¹' {x})).to_real * ∥x∥ :=
+  ‖f‖ = ∑ x in (to_simple_func f).range, (μ ((to_simple_func f) ⁻¹' {x})).to_real * ‖x‖ :=
 begin
   rw [norm_to_simple_func, snorm_one_eq_lintegral_nnnorm],
-  have h_eq := simple_func.map_apply (λ x, (∥x∥₊ : ℝ≥0∞)) (to_simple_func f),
+  have h_eq := simple_func.map_apply (λ x, (‖x‖₊ : ℝ≥0∞)) (to_simple_func f),
   dsimp only at h_eq,
   simp_rw ← h_eq,
   rw [simple_func.lintegral_eq_lintegral, simple_func.map_lintegral, ennreal.to_real_sum],
@@ -820,7 +808,7 @@ begin
   exact smul_to_simple_func c f,
 end
 
-lemma set_to_L1s_smul {E} [normed_group E] [normed_space ℝ E]
+lemma set_to_L1s_smul {E} [normed_add_comm_group E] [normed_space ℝ E]
   [normed_space 𝕜 E] [normed_space 𝕜 F]
   (T : set α → E →L[ℝ] F) (h_zero : ∀ s, measurable_set s → μ s = 0 → T s = 0)
   (h_add : fin_meas_additive μ T)
@@ -834,8 +822,8 @@ begin
 end
 
 lemma norm_set_to_L1s_le (T : set α → E →L[ℝ] F) {C : ℝ}
-  (hT_norm : ∀ s, measurable_set s → μ s < ∞ → ∥T s∥ ≤ C * (μ s).to_real) (f : α →₁ₛ[μ] E) :
-  ∥set_to_L1s T f∥ ≤ C * ∥f∥ :=
+  (hT_norm : ∀ s, measurable_set s → μ s < ∞ → ‖T s‖ ≤ C * (μ s).to_real) (f : α →₁ₛ[μ] E) :
+  ‖set_to_L1s T f‖ ≤ C * ‖f‖ :=
 begin
   rw [set_to_L1s, norm_eq_sum_mul f],
   exact simple_func.norm_set_to_simple_func_le_sum_mul_norm_of_integrable T hT_norm _
@@ -976,12 +964,12 @@ set_to_L1s_smul_left' T T' c h_smul f
 
 lemma norm_set_to_L1s_clm_le {T : set α → E →L[ℝ] F} {C : ℝ}
   (hT : dominated_fin_meas_additive μ T C) (hC : 0 ≤ C) :
-  ∥set_to_L1s_clm α E μ hT∥ ≤ C :=
+  ‖set_to_L1s_clm α E μ hT‖ ≤ C :=
 linear_map.mk_continuous_norm_le _ hC _
 
 lemma norm_set_to_L1s_clm_le' {T : set α → E →L[ℝ] F} {C : ℝ}
   (hT : dominated_fin_meas_additive μ T C) :
-  ∥set_to_L1s_clm α E μ hT∥ ≤ max C 0 :=
+  ‖set_to_L1s_clm α E μ hT‖ ≤ max C 0 :=
 linear_map.mk_continuous_norm_le' _ _
 
 lemma set_to_L1s_clm_const [is_finite_measure μ] {T : set α → E →L[ℝ] F} {C : ℝ}
@@ -1034,7 +1022,7 @@ section set_to_L1
 local attribute [instance] Lp.simple_func.module
 local attribute [instance] Lp.simple_func.normed_space
 
-variables (𝕜) [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
+variables (𝕜) [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
   [normed_space 𝕜 F] [complete_space F]
   {T T' T'' : set α → E →L[ℝ] F} {C C' C'' : ℝ}
 
@@ -1257,38 +1245,38 @@ end
 end order
 
 lemma norm_set_to_L1_le_norm_set_to_L1s_clm (hT : dominated_fin_meas_additive μ T C) :
-  ∥set_to_L1 hT∥ ≤ ∥set_to_L1s_clm α E μ hT∥ :=
-calc ∥set_to_L1 hT∥
-    ≤ (1 : ℝ≥0) * ∥set_to_L1s_clm α E μ hT∥ : begin
+  ‖set_to_L1 hT‖ ≤ ‖set_to_L1s_clm α E μ hT‖ :=
+calc ‖set_to_L1 hT‖
+    ≤ (1 : ℝ≥0) * ‖set_to_L1s_clm α E μ hT‖ : begin
       refine continuous_linear_map.op_norm_extend_le (set_to_L1s_clm α E μ hT) (coe_to_Lp α E ℝ)
         (simple_func.dense_range one_ne_top) (λ x, le_of_eq _),
       rw [nnreal.coe_one, one_mul],
       refl,
     end
-... = ∥set_to_L1s_clm α E μ hT∥ : by rw [nnreal.coe_one, one_mul]
+... = ‖set_to_L1s_clm α E μ hT‖ : by rw [nnreal.coe_one, one_mul]
 
 lemma norm_set_to_L1_le_mul_norm (hT : dominated_fin_meas_additive μ T C) (hC : 0 ≤ C)
   (f : α →₁[μ] E) :
-  ∥set_to_L1 hT f∥ ≤ C * ∥f∥ :=
-calc ∥set_to_L1 hT f∥
-    ≤ ∥set_to_L1s_clm α E μ hT∥ * ∥f∥ :
+  ‖set_to_L1 hT f‖ ≤ C * ‖f‖ :=
+calc ‖set_to_L1 hT f‖
+    ≤ ‖set_to_L1s_clm α E μ hT‖ * ‖f‖ :
   continuous_linear_map.le_of_op_norm_le _ (norm_set_to_L1_le_norm_set_to_L1s_clm hT) _
-... ≤ C * ∥f∥ : mul_le_mul (norm_set_to_L1s_clm_le hT hC) le_rfl (norm_nonneg _) hC
+... ≤ C * ‖f‖ : mul_le_mul (norm_set_to_L1s_clm_le hT hC) le_rfl (norm_nonneg _) hC
 
 lemma norm_set_to_L1_le_mul_norm' (hT : dominated_fin_meas_additive μ T C) (f : α →₁[μ] E) :
-  ∥set_to_L1 hT f∥ ≤ max C 0 * ∥f∥ :=
-calc ∥set_to_L1 hT f∥
-    ≤ ∥set_to_L1s_clm α E μ hT∥ * ∥f∥ :
+  ‖set_to_L1 hT f‖ ≤ max C 0 * ‖f‖ :=
+calc ‖set_to_L1 hT f‖
+    ≤ ‖set_to_L1s_clm α E μ hT‖ * ‖f‖ :
   continuous_linear_map.le_of_op_norm_le _ (norm_set_to_L1_le_norm_set_to_L1s_clm hT) _
-... ≤ max C 0 * ∥f∥ :
+... ≤ max C 0 * ‖f‖ :
   mul_le_mul (norm_set_to_L1s_clm_le' hT) le_rfl (norm_nonneg _) (le_max_right _ _)
 
 lemma norm_set_to_L1_le (hT : dominated_fin_meas_additive μ T C) (hC : 0 ≤ C) :
-  ∥set_to_L1 hT∥ ≤ C :=
+  ‖set_to_L1 hT‖ ≤ C :=
 continuous_linear_map.op_norm_le_bound _ hC (norm_set_to_L1_le_mul_norm hT hC)
 
 lemma norm_set_to_L1_le' (hT : dominated_fin_meas_additive μ T C) :
-  ∥set_to_L1 hT∥ ≤ max C 0 :=
+  ‖set_to_L1 hT‖ ≤ max C 0 :=
 continuous_linear_map.op_norm_le_bound _ (le_max_right _ _) (norm_set_to_L1_le_mul_norm' hT)
 
 lemma set_to_L1_lipschitz (hT : dominated_fin_meas_additive μ T C) :
@@ -1459,7 +1447,7 @@ lemma set_to_fun_sub (hT : dominated_fin_meas_additive μ T C)
   set_to_fun μ T hT (f - g) = set_to_fun μ T hT f - set_to_fun μ T hT g :=
 by rw [sub_eq_add_neg, sub_eq_add_neg, set_to_fun_add hT hf hg.neg, set_to_fun_neg hT g]
 
-lemma set_to_fun_smul [nondiscrete_normed_field 𝕜]
+lemma set_to_fun_smul [nontrivially_normed_field 𝕜]
   [normed_space 𝕜 E] [normed_space 𝕜 F] (hT : dominated_fin_meas_additive μ T C)
   (h_smul : ∀ c : 𝕜, ∀ s x, T s (c • x) = c • T s x) (c : 𝕜) (f : α → E) :
   set_to_fun μ T hT (c • f) = c • set_to_fun μ T hT f :=
@@ -1572,6 +1560,57 @@ lemma continuous_set_to_fun (hT : dominated_fin_meas_additive μ T C) :
   continuous (λ (f : α →₁[μ] E), set_to_fun μ T hT f) :=
 by { simp_rw L1.set_to_fun_eq_set_to_L1 hT, exact continuous_linear_map.continuous _, }
 
+/-- If `F i → f` in `L1`, then `set_to_fun μ T hT (F i) → set_to_fun μ T hT f`. -/
+lemma tendsto_set_to_fun_of_L1 (hT : dominated_fin_meas_additive μ T C)
+  {ι} (f : α → E) (hfi : integrable f μ)
+  {fs : ι → α → E} {l : filter ι} (hfsi : ∀ᶠ i in l, integrable (fs i) μ)
+  (hfs : tendsto (λ i, ∫⁻ x, ‖fs i x - f x‖₊ ∂μ) l (𝓝 0)) :
+  tendsto (λ i, set_to_fun μ T hT (fs i)) l (𝓝 $ set_to_fun μ T hT f) :=
+begin
+  classical,
+  let f_lp := hfi.to_L1 f,
+  let F_lp := λ i, if hFi : integrable (fs i) μ then hFi.to_L1 (fs i) else 0,
+  have tendsto_L1 : tendsto F_lp l (𝓝 f_lp),
+  { rw Lp.tendsto_Lp_iff_tendsto_ℒp',
+    simp_rw [snorm_one_eq_lintegral_nnnorm, pi.sub_apply],
+    refine (tendsto_congr' _).mp hfs,
+    filter_upwards [hfsi] with i hi,
+    refine lintegral_congr_ae _,
+    filter_upwards [hi.coe_fn_to_L1, hfi.coe_fn_to_L1] with x hxi hxf,
+    simp_rw [F_lp, dif_pos hi, hxi, hxf], },
+  suffices : tendsto (λ i, set_to_fun μ T hT (F_lp i)) l (𝓝 (set_to_fun μ T hT f)),
+  { refine (tendsto_congr' _).mp this,
+    filter_upwards [hfsi] with i hi,
+    suffices h_ae_eq : F_lp i =ᵐ[μ] fs i, from set_to_fun_congr_ae hT h_ae_eq,
+    simp_rw [F_lp, dif_pos hi],
+    exact hi.coe_fn_to_L1, },
+  rw set_to_fun_congr_ae hT (hfi.coe_fn_to_L1).symm,
+  exact ((continuous_set_to_fun hT).tendsto f_lp).comp tendsto_L1,
+end
+
+lemma tendsto_set_to_fun_approx_on_of_measurable (hT : dominated_fin_meas_additive μ T C)
+  [measurable_space E] [borel_space E]
+  {f : α → E} {s : set E} [separable_space s] (hfi : integrable f μ)
+  (hfm : measurable f) (hs : ∀ᵐ x ∂μ, f x ∈ closure s) {y₀ : E} (h₀ : y₀ ∈ s)
+  (h₀i : integrable (λ x, y₀) μ) :
+  tendsto (λ n, set_to_fun μ T hT (simple_func.approx_on f hfm s y₀ h₀ n)) at_top
+    (𝓝 $ set_to_fun μ T hT f) :=
+tendsto_set_to_fun_of_L1 hT _ hfi
+  (eventually_of_forall (simple_func.integrable_approx_on hfm hfi h₀ h₀i))
+  (simple_func.tendsto_approx_on_L1_nnnorm hfm _ hs (hfi.sub h₀i).2)
+
+lemma tendsto_set_to_fun_approx_on_of_measurable_of_range_subset
+  (hT : dominated_fin_meas_additive μ T C)
+  [measurable_space E] [borel_space E] {f : α → E}
+  (fmeas : measurable f) (hf : integrable f μ) (s : set E) [separable_space s]
+  (hs : range f ∪ {0} ⊆ s) :
+  tendsto (λ n, set_to_fun μ T hT (simple_func.approx_on f fmeas s 0 (hs $ by simp) n)) at_top
+    (𝓝 $ set_to_fun μ T hT f) :=
+begin
+  refine tendsto_set_to_fun_approx_on_of_measurable hT hf fmeas _ _ (integrable_zero _ _ _),
+  exact eventually_of_forall (λ x, subset_closure (hs (set.mem_union_left _ (mem_range_self _)))),
+end
+
 /-- Auxiliary lemma for `set_to_fun_congr_measure`: the function sending `f : α →₁[μ] G` to
 `f : α →₁[μ'] G` is continuous when `μ' ≤ c' • μ` for `c' ≠ ∞`. -/
 lemma continuous_L1_to_L1
@@ -1712,20 +1751,20 @@ end
 
 lemma norm_set_to_fun_le_mul_norm (hT : dominated_fin_meas_additive μ T C) (f : α →₁[μ] E)
   (hC : 0 ≤ C) :
-  ∥set_to_fun μ T hT f∥ ≤ C * ∥f∥ :=
+  ‖set_to_fun μ T hT f‖ ≤ C * ‖f‖ :=
 by { rw L1.set_to_fun_eq_set_to_L1, exact L1.norm_set_to_L1_le_mul_norm hT hC f, }
 
 lemma norm_set_to_fun_le_mul_norm' (hT : dominated_fin_meas_additive μ T C) (f : α →₁[μ] E) :
-  ∥set_to_fun μ T hT f∥ ≤ max C 0 * ∥f∥ :=
+  ‖set_to_fun μ T hT f‖ ≤ max C 0 * ‖f‖ :=
 by { rw L1.set_to_fun_eq_set_to_L1, exact L1.norm_set_to_L1_le_mul_norm' hT f, }
 
 lemma norm_set_to_fun_le (hT : dominated_fin_meas_additive μ T C) (hf : integrable f μ)
   (hC : 0 ≤ C) :
-  ∥set_to_fun μ T hT f∥ ≤ C * ∥hf.to_L1 f∥ :=
+  ‖set_to_fun μ T hT f‖ ≤ C * ‖hf.to_L1 f‖ :=
 by { rw set_to_fun_eq hT hf, exact L1.norm_set_to_L1_le_mul_norm hT hC _, }
 
 lemma norm_set_to_fun_le' (hT : dominated_fin_meas_additive μ T C) (hf : integrable f μ) :
-  ∥set_to_fun μ T hT f∥ ≤ max C 0 * ∥hf.to_L1 f∥ :=
+  ‖set_to_fun μ T hT f‖ ≤ max C 0 * ‖hf.to_L1 f‖ :=
 by { rw set_to_fun_eq hT hf, exact L1.norm_set_to_L1_le_mul_norm' hT _, }
 
 /-- Lebesgue dominated convergence theorem provides sufficient conditions under which almost
@@ -1737,7 +1776,7 @@ by { rw set_to_fun_eq hT hf, exact L1.norm_set_to_L1_le_mul_norm' hT _, }
 theorem tendsto_set_to_fun_of_dominated_convergence (hT : dominated_fin_meas_additive μ T C)
   {fs : ℕ → α → E} {f : α → E} (bound : α → ℝ)
   (fs_measurable : ∀ n, ae_strongly_measurable (fs n) μ)
-  (bound_integrable : integrable bound μ) (h_bound : ∀ n, ∀ᵐ a ∂μ, ∥fs n a∥ ≤ bound a)
+  (bound_integrable : integrable bound μ) (h_bound : ∀ n, ∀ᵐ a ∂μ, ‖fs n a‖ ≤ bound a)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, fs n a) at_top (𝓝 (f a))) :
   tendsto (λ n, set_to_fun μ T hT (fs n)) at_top (𝓝 $ set_to_fun μ T hT f) :=
 begin
@@ -1761,7 +1800,7 @@ begin
   /- up to some rewriting, what we need to prove is `h_lim` -/
   rw tendsto_iff_norm_tendsto_zero,
   have lintegral_norm_tendsto_zero :
-    tendsto (λn, ennreal.to_real $ ∫⁻ a, (ennreal.of_real ∥fs n a - f a∥) ∂μ) at_top (𝓝 0) :=
+    tendsto (λn, ennreal.to_real $ ∫⁻ a, (ennreal.of_real ‖fs n a - f a‖) ∂μ) at_top (𝓝 0) :=
   (tendsto_to_real zero_ne_top).comp
     (tendsto_lintegral_norm_of_dominated_convergence
       fs_measurable bound_integrable.has_finite_integral h_bound h_lim),
@@ -1781,7 +1820,7 @@ lemma tendsto_set_to_fun_filter_of_dominated_convergence (hT : dominated_fin_mea
   {ι} {l : _root_.filter ι} [l.is_countably_generated]
   {fs : ι → α → E} {f : α → E} (bound : α → ℝ)
   (hfs_meas : ∀ᶠ n in l, ae_strongly_measurable (fs n) μ)
-  (h_bound : ∀ᶠ n in l, ∀ᵐ a ∂μ, ∥fs n a∥ ≤ bound a)
+  (h_bound : ∀ᶠ n in l, ∀ᵐ a ∂μ, ‖fs n a‖ ≤ bound a)
   (bound_integrable : integrable bound μ)
   (h_lim : ∀ᵐ a ∂μ, tendsto (λ n, fs n a) l (𝓝 (f a))) :
   tendsto (λ n, set_to_fun μ T hT (fs n)) l (𝓝 $ set_to_fun μ T hT f) :=
@@ -1790,7 +1829,7 @@ begin
   intros x xl,
   have hxl : ∀ s ∈ l, ∃ a, ∀ b ≥ a, x b ∈ s, by { rwa tendsto_at_top' at xl, },
   have h : {x : ι | (λ n, ae_strongly_measurable (fs n) μ) x}
-      ∩ {x : ι | (λ n, ∀ᵐ a ∂μ, ∥fs n a∥ ≤ bound a) x} ∈ l,
+      ∩ {x : ι | (λ n, ∀ᵐ a ∂μ, ‖fs n a‖ ≤ bound a) x} ∈ l,
     from inter_mem hfs_meas h_bound,
   obtain ⟨k, h⟩ := hxl _ h,
   rw ← tendsto_add_at_top_iff_nat k,
@@ -1805,17 +1844,40 @@ end
 
 variables {X : Type*} [topological_space X] [first_countable_topology X]
 
+lemma continuous_within_at_set_to_fun_of_dominated (hT : dominated_fin_meas_additive μ T C)
+  {fs : X → α → E} {x₀ : X} {bound : α → ℝ} {s : set X}
+  (hfs_meas : ∀ᶠ x in 𝓝[s] x₀, ae_strongly_measurable (fs x) μ)
+  (h_bound : ∀ᶠ x in 𝓝[s] x₀, ∀ᵐ a ∂μ, ‖fs x a‖ ≤ bound a)
+  (bound_integrable : integrable bound μ)
+  (h_cont : ∀ᵐ a ∂μ, continuous_within_at (λ x, fs x a) s x₀) :
+  continuous_within_at (λ x, set_to_fun μ T hT (fs x)) s x₀ :=
+tendsto_set_to_fun_filter_of_dominated_convergence hT bound ‹_› ‹_› ‹_› ‹_›
+
 lemma continuous_at_set_to_fun_of_dominated (hT : dominated_fin_meas_additive μ T C)
   {fs : X → α → E} {x₀ : X} {bound : α → ℝ}
   (hfs_meas : ∀ᶠ x in 𝓝 x₀, ae_strongly_measurable (fs x) μ)
-  (h_bound : ∀ᶠ x in 𝓝 x₀, ∀ᵐ a ∂μ, ∥fs x a∥ ≤ bound a)
+  (h_bound : ∀ᶠ x in 𝓝 x₀, ∀ᵐ a ∂μ, ‖fs x a‖ ≤ bound a)
   (bound_integrable : integrable bound μ) (h_cont : ∀ᵐ a ∂μ, continuous_at (λ x, fs x a) x₀) :
   continuous_at (λ x, set_to_fun μ T hT (fs x)) x₀ :=
 tendsto_set_to_fun_filter_of_dominated_convergence hT bound ‹_› ‹_› ‹_› ‹_›
 
+lemma continuous_on_set_to_fun_of_dominated (hT : dominated_fin_meas_additive μ T C)
+  {fs : X → α → E} {bound : α → ℝ} {s : set X}
+  (hfs_meas : ∀ x ∈ s, ae_strongly_measurable (fs x) μ)
+  (h_bound : ∀ x ∈ s, ∀ᵐ a ∂μ, ‖fs x a‖ ≤ bound a)
+  (bound_integrable : integrable bound μ) (h_cont : ∀ᵐ a ∂μ, continuous_on (λ x, fs x a) s) :
+  continuous_on (λ x, set_to_fun μ T hT (fs x)) s :=
+begin
+  assume x hx,
+  refine continuous_within_at_set_to_fun_of_dominated hT _ _ bound_integrable _,
+  { filter_upwards [self_mem_nhds_within] with x hx using hfs_meas x hx },
+  { filter_upwards [self_mem_nhds_within] with x hx using h_bound x hx },
+  { filter_upwards [h_cont] with a ha using ha x hx }
+end
+
 lemma continuous_set_to_fun_of_dominated (hT : dominated_fin_meas_additive μ T C)
   {fs : X → α → E} {bound : α → ℝ}
-  (hfs_meas : ∀ x, ae_strongly_measurable (fs x) μ) (h_bound : ∀ x, ∀ᵐ a ∂μ, ∥fs x a∥ ≤ bound a)
+  (hfs_meas : ∀ x, ae_strongly_measurable (fs x) μ) (h_bound : ∀ x, ∀ᵐ a ∂μ, ‖fs x a‖ ≤ bound a)
   (bound_integrable : integrable bound μ) (h_cont : ∀ᵐ a ∂μ, continuous (λ x, fs x a)) :
   continuous (λ x, set_to_fun μ T hT (fs x)) :=
 continuous_iff_continuous_at.mpr (λ x₀, continuous_at_set_to_fun_of_dominated hT
diff --git a/src/measure_theory/integral/torus_integral.lean b/src/measure_theory/integral/torus_integral.lean
index d4f8f02512a3e..57bd43db674a7 100644
--- a/src/measure_theory/integral/torus_integral.lean
+++ b/src/measure_theory/integral/torus_integral.lean
@@ -3,11 +3,15 @@ Copyright (c) 2022 Cuma Kökmen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Cuma Kökmen, Yury Kudryashov
 -/
+import measure_theory.constructions.prod.integral
 import measure_theory.integral.circle_integral
 
 /-!
 # Integral over a torus in `ℂⁿ`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the integral of a function `f : ℂⁿ → E` over a torus
 `{z : ℂⁿ | ∀ i, z i ∈ metric.sphere (c i) (R i)}`. In order to do this, we define
 `torus_map (c : ℂⁿ) (R θ : ℝⁿ)` to be the point in `ℂⁿ` given by $z_k=c_k+R_ke^{θ_ki}$,
@@ -53,21 +57,21 @@ integral, torus
 -/
 
 variable {n : ℕ}
-variables {E : Type*} [normed_group E]
+variables {E : Type*} [normed_add_comm_group E]
 
 noncomputable theory
 
 open complex set measure_theory function filter topological_space
 open_locale real big_operators
 
-local notation `ℝ⁰`:= fin 0 → ℝ
-local notation `ℂ⁰`:= fin 0 → ℂ
-local notation `ℝ¹`:= fin 1 → ℝ
-local notation `ℂ¹`:= fin 1 → ℂ
-local notation `ℝⁿ`:= fin n → ℝ
-local notation `ℂⁿ`:= fin n → ℂ
-local notation `ℝⁿ⁺¹`:= fin (n + 1) → ℝ
-local notation `ℂⁿ⁺¹`:= fin (n + 1) → ℂ
+local notation `ℝ⁰` := fin 0 → ℝ
+local notation `ℂ⁰` := fin 0 → ℂ
+local notation `ℝ¹` := fin 1 → ℝ
+local notation `ℂ¹` := fin 1 → ℂ
+local notation `ℝⁿ` := fin n → ℝ
+local notation `ℂⁿ` := fin n → ℂ
+local notation `ℝⁿ⁺¹` := fin (n + 1) → ℝ
+local notation `ℂⁿ⁺¹` := fin (n + 1) → ℂ
 
 /-!
 ### `torus_map`, a generalization of a torus
@@ -178,14 +182,14 @@ lemma torus_integral_const_mul (a : ℂ) (f : ℂⁿ → ℂ) (c : ℂⁿ) (R :
   ∯ x in T(c, R), a * f x = a * ∯ x in T(c, R), f x :=
 torus_integral_smul a f c R
 
-/--If for all `θ : ℝⁿ`, `∥f (torus_map c R θ)∥` is less than or equal to a constant `C : ℝ`, then
-`∥∯ x in T(c, R), f x∥` is less than or equal to `(2 * π)^n * (∏ i, |R i|) * C`-/
-lemma norm_torus_integral_le_of_norm_le_const {C : ℝ} (hf : ∀ θ, ∥f (torus_map c R θ)∥ ≤ C) :
-  ∥∯ x in T(c, R), f x∥ ≤ (2 * π)^(n: ℕ) * (∏ i, |R i|) * C :=
-calc ∥∯ x in T(c, R), f x∥ ≤ (∏ i, |R i|) * C * (volume (Icc (0 : ℝⁿ) (λ _, 2 * π))).to_real :
+/--If for all `θ : ℝⁿ`, `‖f (torus_map c R θ)‖` is less than or equal to a constant `C : ℝ`, then
+`‖∯ x in T(c, R), f x‖` is less than or equal to `(2 * π)^n * (∏ i, |R i|) * C`-/
+lemma norm_torus_integral_le_of_norm_le_const {C : ℝ} (hf : ∀ θ, ‖f (torus_map c R θ)‖ ≤ C) :
+  ‖∯ x in T(c, R), f x‖ ≤ (2 * π)^(n: ℕ) * (∏ i, |R i|) * C :=
+calc ‖∯ x in T(c, R), f x‖ ≤ (∏ i, |R i|) * C * (volume (Icc (0 : ℝⁿ) (λ _, 2 * π))).to_real :
   norm_set_integral_le_of_norm_le_const' measure_Icc_lt_top measurable_set_Icc $ λ θ hθ,
-    ( calc ∥(∏ i : fin n, R i * exp (θ i * I) * I : ℂ) • f (torus_map c R θ)∥
-          = (∏ i : fin n, |R i|) * ∥f (torus_map c R θ)∥ : by simp [norm_smul]
+    ( calc ‖(∏ i : fin n, R i * exp (θ i * I) * I : ℂ) • f (torus_map c R θ)‖
+          = (∏ i : fin n, |R i|) * ‖f (torus_map c R θ)‖ : by simp [norm_smul]
       ... ≤ (∏ i : fin n, |R i|) * C :
         mul_le_mul_of_nonneg_left (hf _) (finset.prod_nonneg $ λ _ _, abs_nonneg _) )
 ... = (2 * π)^(n: ℕ) * (∏ i, |R i|) * C :
diff --git a/src/measure_theory/integral/vitali_caratheodory.lean b/src/measure_theory/integral/vitali_caratheodory.lean
index aca51ddb1aa95..2de96efc96d3d 100644
--- a/src/measure_theory/integral/vitali_caratheodory.lean
+++ b/src/measure_theory/integral/vitali_caratheodory.lean
@@ -12,6 +12,9 @@ import topology.instances.ereal
 /-!
 # Vitali-Carathéodory theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Vitali-Carathéodory theorem asserts the following. Consider an integrable function `f : α → ℝ` on
 a space with a regular measure. Then there exists a function `g : α → ereal` such that `f x < g x`
 everywhere, `g` is lower semicontinuous, and the integral of `g` is arbitrarily close to that of
@@ -95,8 +98,7 @@ begin
   induction f using measure_theory.simple_func.induction with c s hs f₁ f₂ H h₁ h₂ generalizing ε,
   { let f := simple_func.piecewise s hs (simple_func.const α c) (simple_func.const α 0),
     by_cases h : ∫⁻ x, f x ∂μ = ⊤,
-    { refine ⟨λ x, c, λ x, _, lower_semicontinuous_const,
-             by simp only [ennreal.top_add, le_top, h]⟩,
+    { refine ⟨λ x, c, λ x, _, lower_semicontinuous_const, by simp only [_root_.top_add, le_top, h]⟩,
       simp only [simple_func.coe_const, simple_func.const_zero, simple_func.coe_zero,
         set.piecewise_eq_indicator, simple_func.coe_piecewise],
       exact set.indicator_le_self _ _ _ },
@@ -125,7 +127,7 @@ begin
           lintegral_const, ennreal.coe_indicator, set.univ_inter, measurable_set.univ,
           simple_func.const_zero, lintegral_indicator, simple_func.coe_zero,
           set.piecewise_eq_indicator, simple_func.coe_piecewise, restrict_apply],
-      calc (c : ℝ≥0∞) * μ u ≤ c * (μ s + ε / c) : ennreal.mul_le_mul le_rfl μu.le
+      calc (c : ℝ≥0∞) * μ u ≤ c * (μ s + ε / c) : mul_le_mul_left' μu.le _
       ... = c * μ s + ε :
         begin
           simp_rw [mul_add],
@@ -136,9 +138,10 @@ begin
     rcases h₂ (ennreal.half_pos ε0).ne' with ⟨g₂, f₂_le_g₂, g₂cont, g₂int⟩,
     refine ⟨λ x, g₁ x + g₂ x, λ x, add_le_add (f₁_le_g₁ x) (f₂_le_g₂ x), g₁cont.add g₂cont, _⟩,
     simp only [simple_func.coe_add, ennreal.coe_add, pi.add_apply],
-    rw [lintegral_add f₁.measurable.coe_nnreal_ennreal f₂.measurable.coe_nnreal_ennreal,
-        lintegral_add g₁cont.measurable.coe_nnreal_ennreal g₂cont.measurable.coe_nnreal_ennreal],
+    rw [lintegral_add_left f₁.measurable.coe_nnreal_ennreal,
+        lintegral_add_left g₁cont.measurable.coe_nnreal_ennreal],
     convert add_le_add g₁int g₂int using 1,
+    simp only [],
     conv_lhs { rw ← ennreal.add_halves ε },
     abel }
 end
@@ -153,7 +156,7 @@ lemma exists_le_lower_semicontinuous_lintegral_ge
   (f : α → ℝ≥0∞) (hf : measurable f) {ε : ℝ≥0∞} (εpos : ε ≠ 0) :
   ∃ g : α → ℝ≥0∞, (∀ x, f x ≤ g x) ∧ lower_semicontinuous g ∧ (∫⁻ x, g x ∂μ ≤ ∫⁻ x, f x ∂μ + ε) :=
 begin
-  rcases ennreal.exists_pos_sum_of_encodable' εpos ℕ with ⟨δ, δpos, hδ⟩,
+  rcases ennreal.exists_pos_sum_of_countable' εpos ℕ with ⟨δ, δpos, hδ⟩,
   have : ∀ n, ∃ g : α → ℝ≥0, (∀ x, simple_func.eapprox_diff f n x ≤ g x) ∧ lower_semicontinuous g ∧
     (∫⁻ x, g x ∂μ ≤ ∫⁻ x, simple_func.eapprox_diff f n x ∂μ + δ n) :=
   λ n, simple_func.exists_le_lower_semicontinuous_lintegral_ge μ
@@ -167,7 +170,7 @@ begin
       (λ x y hxy, ennreal.coe_le_coe.2 hxy) },
   { calc ∫⁻ x, ∑' (n : ℕ), g n x ∂μ
     = ∑' n, ∫⁻ x, g n x ∂μ :
-      by rw lintegral_tsum (λ n, (gcont n).measurable.coe_nnreal_ennreal)
+      by rw lintegral_tsum (λ n, (gcont n).measurable.coe_nnreal_ennreal.ae_measurable)
     ... ≤ ∑' n, (∫⁻ x, eapprox_diff f n x ∂μ + δ n) : ennreal.tsum_le_tsum hg
     ... = ∑' n, (∫⁻ x, eapprox_diff f n x ∂μ) + ∑' n, δ n : ennreal.tsum_add
     ... ≤ ∫⁻ (x : α), f x ∂μ + ε :
@@ -175,7 +178,7 @@ begin
         refine add_le_add _ hδ.le,
         rw [← lintegral_tsum],
         { simp_rw [tsum_eapprox_diff f hf, le_refl] },
-        { assume n, exact (simple_func.measurable _).coe_nnreal_ennreal }
+        { assume n, exact (simple_func.measurable _).coe_nnreal_ennreal.ae_measurable }
       end }
 end
 
@@ -199,7 +202,7 @@ begin
   { calc ∫⁻ (x : α), g x ∂μ
         ≤ ∫⁻ (x : α), f x + w x ∂μ + ε / 2 : gint
     ... = ∫⁻ (x : α), f x ∂ μ + ∫⁻ (x : α), w x ∂ μ + (ε / 2) :
-      by rw lintegral_add fmeas.coe_nnreal_ennreal wmeas.coe_nnreal_ennreal
+      by rw lintegral_add_right _ wmeas.coe_nnreal_ennreal
     ... ≤ ∫⁻ (x : α), f x ∂ μ + ε / 2 + ε / 2 :
       add_le_add_right (add_le_add_left wint.le _) _
     ... = ∫⁻ (x : α), f x ∂μ + ε : by rw [add_assoc, ennreal.add_halves] },
@@ -231,7 +234,7 @@ begin
       rw this,
       exact (f_lt_g0 x).trans_le le_self_add } },
   { calc ∫⁻ x, g0 x + g1 x ∂μ =  ∫⁻ x, g0 x ∂μ + ∫⁻ x, g1 x ∂μ :
-      lintegral_add g0_cont.measurable g1_cont.measurable
+      lintegral_add_left g0_cont.measurable _
     ... ≤ (∫⁻ x, f x ∂μ + ε / 2) + (0 + ε / 2) :
       begin
         refine add_le_add _ _,
@@ -337,7 +340,7 @@ begin
           lintegral_const, ennreal.coe_indicator, set.univ_inter, measurable_set.univ,
           simple_func.const_zero, lintegral_indicator, simple_func.coe_zero,
           set.piecewise_eq_indicator, simple_func.coe_piecewise, restrict_apply],
-      calc (c : ℝ≥0∞) * μ s ≤ c * (μ F + ε / c) : ennreal.mul_le_mul le_rfl μF.le
+      calc (c : ℝ≥0∞) * μ s ≤ c * (μ F + ε / c) : mul_le_mul_left' μF.le _
       ... = c * μ F + ε :
         begin
           simp_rw [mul_add],
@@ -345,16 +348,17 @@ begin
           simpa using hc,
         end } },
   { have A : ∫⁻ (x : α), f₁ x ∂μ + ∫⁻ (x : α), f₂ x ∂μ ≠ ⊤,
-      by rwa ← lintegral_add f₁.measurable.coe_nnreal_ennreal f₂.measurable.coe_nnreal_ennreal ,
+      by rwa ← lintegral_add_left f₁.measurable.coe_nnreal_ennreal,
     rcases h₁ (ennreal.add_ne_top.1 A).1 (ennreal.half_pos ε0).ne'
       with ⟨g₁, f₁_le_g₁, g₁cont, g₁int⟩,
     rcases h₂ (ennreal.add_ne_top.1 A).2 (ennreal.half_pos ε0).ne'
       with ⟨g₂, f₂_le_g₂, g₂cont, g₂int⟩,
     refine ⟨λ x, g₁ x + g₂ x, λ x, add_le_add (f₁_le_g₁ x) (f₂_le_g₂ x), g₁cont.add g₂cont, _⟩,
     simp only [simple_func.coe_add, ennreal.coe_add, pi.add_apply],
-    rw [lintegral_add f₁.measurable.coe_nnreal_ennreal f₂.measurable.coe_nnreal_ennreal,
-        lintegral_add g₁cont.measurable.coe_nnreal_ennreal g₂cont.measurable.coe_nnreal_ennreal],
+    rw [lintegral_add_left f₁.measurable.coe_nnreal_ennreal,
+        lintegral_add_left g₁cont.measurable.coe_nnreal_ennreal],
     convert add_le_add g₁int g₂int using 1,
+    simp only [],
     conv_lhs { rw ← ennreal.add_halves ε },
     abel }
 end
@@ -478,7 +482,9 @@ begin
       by { congr' 1, field_simp [δ, mul_comm] },
   show ∀ᵐ (x : α) ∂μ, g x < ⊤,
   { filter_upwards [gp_lt_top] with _ hx,
-    simp [g, ereal.sub_eq_add_neg, lt_top_iff_ne_top, lt_top_iff_ne_top.1 hx], },
+    simp only [g, sub_eq_add_neg, coe_coe, ne.def, (ereal.add_lt_top _ _).ne, lt_top_iff_ne_top,
+      lt_top_iff_ne_top.1 hx, ereal.coe_ennreal_eq_top_iff, not_false_iff, ereal.neg_eq_top_iff,
+      ereal.coe_ennreal_ne_bot] },
   show ∀ x, (f x : ereal) < g x,
   { assume x,
     rw ereal.coe_real_ereal_eq_coe_to_nnreal_sub_coe_to_nnreal (f x),
diff --git a/src/measure_theory/lattice.lean b/src/measure_theory/lattice.lean
index 87b9da7e7679c..24a1453a0d1ae 100644
--- a/src/measure_theory/lattice.lean
+++ b/src/measure_theory/lattice.lean
@@ -9,6 +9,9 @@ import measure_theory.measure.ae_measurable
 /-!
 # Typeclasses for measurability of lattice operations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define classes `has_measurable_sup` and `has_measurable_inf` and prove dot-style
 lemmas (`measurable.sup`, `ae_measurable.sup` etc). For binary operations we define two typeclasses:
 
@@ -197,3 +200,34 @@ include m
 end measurable_inf₂
 
 end inf
+
+section semilattice_sup
+
+open finset
+
+variables {δ : Type*} [measurable_space δ] [semilattice_sup α] [has_measurable_sup₂ α]
+
+@[measurability] lemma finset.measurable_sup' {ι : Type*} {s : finset ι} (hs : s.nonempty)
+  {f : ι → δ → α} (hf : ∀ n ∈ s, measurable (f n)) :
+  measurable (s.sup' hs f) :=
+finset.sup'_induction hs _ (λ f hf g hg, hf.sup hg) (λ n hn, hf n hn)
+
+@[measurability] lemma finset.measurable_range_sup'
+  {f : ℕ → δ → α} {n : ℕ} (hf : ∀ k ≤ n, measurable (f k)) :
+  measurable ((range (n + 1)).sup' nonempty_range_succ f) :=
+begin
+  simp_rw ← nat.lt_succ_iff at hf,
+  refine finset.measurable_sup' _ _,
+  simpa [finset.mem_range],
+end
+
+@[measurability] lemma finset.measurable_range_sup''
+  {f : ℕ → δ → α} {n : ℕ} (hf : ∀ k ≤ n, measurable (f k)) :
+  measurable (λ x, (range (n + 1)).sup' nonempty_range_succ (λ k, f k x)) :=
+begin
+  convert finset.measurable_range_sup' hf,
+  ext x,
+  simp,
+end
+
+end semilattice_sup
diff --git a/src/measure_theory/measurable_space.lean b/src/measure_theory/measurable_space.lean
index 8f41f84ede036..74b43d1b7bce7 100644
--- a/src/measure_theory/measurable_space.lean
+++ b/src/measure_theory/measurable_space.lean
@@ -4,17 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
 
-import algebra.indicator_function
-import data.tprod
+import data.prod.tprod
 import group_theory.coset
 import logic.equiv.fin
+import logic.lemmas
 import measure_theory.measurable_space_def
+import order.filter.small_sets
+import order.liminf_limsup
 import measure_theory.tactic
-import order.filter.lift
 
 /-!
 # Measurable spaces and measurable functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides properties of measurable spaces and the functions and isomorphisms
 between them. The definition of a measurable space is in `measure_theory.measurable_space_def`.
 
@@ -74,7 +78,7 @@ variables {m m₁ m₂ : measurable_space α} {m' : measurable_space β} {f : α
 /-- The forward image of a measurable space under a function. `map f m` contains the sets
   `s : set β` whose preimage under `f` is measurable. -/
 protected def map (f : α → β) (m : measurable_space α) : measurable_space β :=
-{ measurable_set'      := λ s, m.measurable_set' $ f ⁻¹' s,
+{ measurable_set'      := λ s, measurable_set[m] $ f ⁻¹' s,
   measurable_set_empty := m.measurable_set_empty,
   measurable_set_compl := assume s hs, m.measurable_set_compl _ hs,
   measurable_set_Union := assume f hf, by { rw preimage_Union, exact m.measurable_set_Union _ hf }}
@@ -88,13 +92,17 @@ measurable_space.ext $ assume s, iff.rfl
 /-- The reverse image of a measurable space under a function. `comap f m` contains the sets
   `s : set α` such that `s` is the `f`-preimage of a measurable set in `β`. -/
 protected def comap (f : α → β) (m : measurable_space β) : measurable_space α :=
-{ measurable_set'      := λ s, ∃s', m.measurable_set' s' ∧ f ⁻¹' s' = s,
+{ measurable_set'      := λ s, ∃s', measurable_set[m] s' ∧ f ⁻¹' s' = s,
   measurable_set_empty := ⟨∅, m.measurable_set_empty, rfl⟩,
   measurable_set_compl := assume s ⟨s', h₁, h₂⟩, ⟨s'ᶜ, m.measurable_set_compl _ h₁, h₂ ▸ rfl⟩,
   measurable_set_Union := assume s hs,
     let ⟨s', hs'⟩ := classical.axiom_of_choice hs in
     ⟨⋃ i, s' i, m.measurable_set_Union _ (λ i, (hs' i).left), by simp [hs'] ⟩ }
 
+lemma comap_eq_generate_from (m : measurable_space β) (f : α → β) :
+  m.comap f = generate_from {t | ∃ s, measurable_set s ∧ f ⁻¹' s = t} :=
+by convert generate_from_measurable_set.symm
+
 @[simp] lemma comap_id : m.comap id = m :=
 measurable_space.ext $ assume s, ⟨assume ⟨s', hs', h⟩, h ▸ hs', assume h, ⟨s, h, rfl⟩⟩
 
@@ -129,13 +137,11 @@ lemma le_map_comap : m ≤ (m.comap g).map g := (gc_comap_map g).le_u_l _
 
 end functors
 
-@[mono] lemma generate_from_mono {s t : set (set α)} (h : s ⊆ t) :
-  generate_from s ≤ generate_from t :=
-gi_generate_from.gc.monotone_l h
+@[simp] lemma map_const {m} (b : β) : measurable_space.map (λ a : α, b) m = ⊤ :=
+eq_top_iff.2 $ by { rintro s hs, by_cases b ∈ s; change measurable_set (preimage _ _); simp [*] }
 
-lemma generate_from_sup_generate_from {s t : set (set α)} :
-  generate_from s ⊔ generate_from t = generate_from (s ∪ t) :=
-(@gi_generate_from α).gc.l_sup.symm
+@[simp] lemma comap_const {m} (b : β) : measurable_space.comap (λ a : α, b) m = ⊥ :=
+eq_bot_iff.2 $ by { rintro _ ⟨s, -, rfl⟩, by_cases b ∈ s; simp [*] }
 
 lemma comap_generate_from {f : α → β} {s : set (set β)} :
   (generate_from s).comap f = generate_from (preimage f '' s) :=
@@ -161,6 +167,10 @@ comap_le_iff_le_map.symm
 
 alias measurable_iff_comap_le ↔ measurable.comap_le measurable.of_comap_le
 
+lemma comap_measurable {m : measurable_space β} (f : α → β) :
+  measurable[m.comap f] f :=
+λ s hs, ⟨s, hs, rfl⟩
+
 lemma measurable.mono {ma ma' : measurable_space α} {mb mb' : measurable_space β} {f : α → β}
   (hf : @measurable α β ma mb f) (ha : ma ≤ ma') (hb : mb' ≤ mb) :
   @measurable α β ma' mb' f :=
@@ -188,7 +198,7 @@ lemma measurable_of_subsingleton_codomain [subsingleton β] (f : α → β) :
   measurable f :=
 λ s hs, subsingleton.set_cases measurable_set.empty measurable_set.univ s
 
-@[to_additive]
+@[measurability, to_additive]
 lemma measurable_one [has_one α] : measurable (1 : β → α) := @measurable_const _ _ _ _ 1
 
 lemma measurable_of_empty [is_empty α] (f : α → β) : measurable f :=
@@ -206,9 +216,18 @@ begin
   { convert measurable_const, exact funext (λ x, hf x h.some) }
 end
 
-lemma measurable_of_fintype [fintype α] [measurable_singleton_class α] (f : α → β) :
+@[measurability] lemma measurable_nat_cast [has_nat_cast α] (n : ℕ) : measurable (n : β → α) :=
+@measurable_const α _ _ _ n
+
+@[measurability] lemma measurable_int_cast [has_int_cast α] (n : ℤ) : measurable (n : β → α) :=
+@measurable_const α _ _ _ n
+
+lemma measurable_of_finite [finite α] [measurable_singleton_class α] (f : α → β) : measurable f :=
+λ s hs, (f ⁻¹' s).to_finite.measurable_set
+
+lemma measurable_of_countable [countable α] [measurable_singleton_class α] (f : α → β) :
   measurable f :=
-λ s hs, (finite.of_fintype (f ⁻¹' s)).measurable_set
+λ s hs, (f ⁻¹' s).to_countable.measurable_set
 
 end typeclass_measurable_space
 
@@ -259,7 +278,7 @@ hf (measurable_set_singleton 1).compl
 /-- If a function coincides with a measurable function outside of a countable set, it is
 measurable. -/
 lemma measurable.measurable_of_countable_ne [measurable_singleton_class α]
-  (hf : measurable f) (h : countable {x | f x ≠ g x}) : measurable g :=
+  (hf : measurable f) (h : set.countable {x | f x ≠ g x}) : measurable g :=
 begin
   assume t ht,
   have : g ⁻¹' t = (g ⁻¹' t ∩ {x | f x = g x}ᶜ) ∪ (g ⁻¹' t ∩ {x | f x = g x}),
@@ -272,7 +291,6 @@ begin
   exact (hf ht).inter h.measurable_set.of_compl,
 end
 
-
 end measurable_functions
 
 section constructions
@@ -280,6 +298,7 @@ section constructions
 instance : measurable_space empty := ⊤
 instance : measurable_space punit := ⊤ -- this also works for `unit`
 instance : measurable_space bool := ⊤
+instance Prop.measurable_space : measurable_space Prop := ⊤
 instance : measurable_space ℕ := ⊤
 instance : measurable_space ℤ := ⊤
 instance : measurable_space ℚ := ⊤
@@ -287,23 +306,28 @@ instance : measurable_space ℚ := ⊤
 instance : measurable_singleton_class empty := ⟨λ _, trivial⟩
 instance : measurable_singleton_class punit := ⟨λ _, trivial⟩
 instance : measurable_singleton_class bool := ⟨λ _, trivial⟩
+instance Prop.measurable_singleton_class : measurable_singleton_class Prop := ⟨λ _, trivial⟩
 instance : measurable_singleton_class ℕ := ⟨λ _, trivial⟩
 instance : measurable_singleton_class ℤ := ⟨λ _, trivial⟩
 instance : measurable_singleton_class ℚ := ⟨λ _, trivial⟩
 
-lemma measurable_to_encodable [measurable_space α] [encodable α] [measurable_space β] {f : β → α}
+lemma measurable_to_countable [measurable_space α] [countable α] [measurable_space β] {f : β → α}
   (h : ∀ y, measurable_set (f ⁻¹' {f y})) :
   measurable f :=
 begin
   assume s hs,
   rw [← bUnion_preimage_singleton],
-  refine measurable_set.Union (λ y, measurable_set.Union_Prop $ λ hy, _),
+  refine measurable_set.Union (λ y, measurable_set.Union $ λ hy, _),
   by_cases hyf : y ∈ range f,
   { rcases hyf with ⟨y, rfl⟩,
     apply h },
   { simp only [preimage_singleton_eq_empty.2 hyf, measurable_set.empty] }
 end
 
+lemma measurable_to_countable' [measurable_space α] [countable α] [measurable_space β] {f : β → α}
+  (h : ∀ x, measurable_set (f ⁻¹' {x})) : measurable f :=
+measurable_to_countable (λ y, h (f y))
+
 @[measurability] lemma measurable_unit [measurable_space α] (f : unit → α) : measurable f :=
 measurable_from_top
 
@@ -314,7 +338,25 @@ variables [measurable_space α]
 measurable_from_top
 
 lemma measurable_to_nat {f : α → ℕ} : (∀ y, measurable_set (f ⁻¹' {f y})) → measurable f :=
-measurable_to_encodable
+measurable_to_countable
+
+lemma measurable_to_bool {f : α → bool} (h : measurable_set (f⁻¹' {tt})) : measurable f :=
+begin
+  apply measurable_to_countable',
+  rintros (-|-),
+  { convert h.compl,
+    rw [← preimage_compl, bool.compl_singleton, bool.bnot_tt] },
+  exact h,
+end
+
+lemma measurable_to_prop {f : α → Prop} (h : measurable_set (f⁻¹' {true})) : measurable f :=
+begin
+  refine measurable_to_countable' (λ x, _),
+  by_cases hx : x,
+  { simpa [hx] using h },
+  { simpa only [hx, ←preimage_compl, Prop.compl_singleton, not_true, preimage_singleton_false]
+      using h.compl }
+end
 
 lemma measurable_find_greatest' {p : α → ℕ → Prop} [∀ x, decidable_pred (p x)]
   {N : ℕ} (hN : ∀ k ≤ N, measurable_set {x | nat.find_greatest (p x) N = k}) :
@@ -328,7 +370,7 @@ begin
   refine measurable_find_greatest' (λ k hk, _),
   simp only [nat.find_greatest_eq_iff, set_of_and, set_of_forall, ← compl_set_of],
   repeat { apply_rules [measurable_set.inter, measurable_set.const, measurable_set.Inter,
-    measurable_set.Inter_Prop, measurable_set.compl, hN]; try { intros } }
+    measurable_set.compl, hN]; try { intros } }
 end
 
 lemma measurable_find {p : α → ℕ → Prop} [∀ x, decidable_pred (p x)]
@@ -458,12 +500,12 @@ lemma measurable.dite [∀ x, decidable (x ∈ s)] {f : s → β} (hf : measurab
 measurable_of_restrict_of_restrict_compl hs (by simpa) (by simpa)
 
 lemma measurable_of_measurable_on_compl_finite [measurable_singleton_class α]
-  {f : α → β} (s : set α) (hs : finite s) (hf : measurable (sᶜ.restrict f)) :
+  {f : α → β} (s : set α) (hs : s.finite) (hf : measurable (sᶜ.restrict f)) :
   measurable f :=
 begin
   letI : fintype s := finite.fintype hs,
   exact measurable_of_restrict_of_restrict_compl hs.measurable_set
-    (measurable_of_fintype _) hf
+    (measurable_of_finite _) hf
 end
 
 lemma measurable_of_measurable_on_compl_singleton [measurable_singleton_class α]
@@ -556,7 +598,7 @@ lemma measurable_set.prod {s : set α} {t : set β} (hs : measurable_set s) (ht
   measurable_set (s ×ˢ t) :=
 measurable_set.inter (measurable_fst hs) (measurable_snd ht)
 
-lemma measurable_set_prod_of_nonempty {s : set α} {t : set β} (h : (s ×ˢ t : set _).nonempty) :
+lemma measurable_set_prod_of_nonempty {s : set α} {t : set β} (h : (s ×ˢ t).nonempty) :
   measurable_set (s ×ˢ t) ↔ measurable_set s ∧ measurable_set t :=
 begin
   rcases h with ⟨⟨x, y⟩, hx, hy⟩,
@@ -569,7 +611,7 @@ end
 lemma measurable_set_prod {s : set α} {t : set β} :
   measurable_set (s ×ˢ t) ↔ (measurable_set s ∧ measurable_set t) ∨ s = ∅ ∨ t = ∅ :=
 begin
-  cases (s ×ˢ t : set _).eq_empty_or_nonempty with h h,
+  cases (s ×ˢ t).eq_empty_or_nonempty with h h,
   { simp [h, prod_eq_empty_iff.mp h] },
   { simp [←not_nonempty_iff_eq_empty, prod_nonempty_iff.mp h, measurable_set_prod_of_nonempty h] }
 end
@@ -578,7 +620,12 @@ lemma measurable_set_swap_iff {s : set (α × β)} :
   measurable_set (prod.swap ⁻¹' s) ↔ measurable_set s :=
 ⟨λ hs, by { convert measurable_swap hs, ext ⟨x, y⟩, refl }, λ hs, measurable_swap hs⟩
 
-lemma measurable_from_prod_encodable [encodable β] [measurable_singleton_class β]
+instance [measurable_singleton_class α] [measurable_singleton_class β] :
+  measurable_singleton_class (α × β) :=
+⟨λ ⟨a, b⟩, @singleton_prod_singleton _ _ a b ▸
+  (measurable_set_singleton a).prod (measurable_set_singleton b)⟩
+
+lemma measurable_from_prod_countable [countable β] [measurable_singleton_class β]
   {mγ : measurable_space γ} {f : α × β → γ} (hf : ∀ y, measurable (λ x, f (x, y))) :
   measurable f :=
 begin
@@ -597,7 +644,7 @@ lemma measurable.find {m : measurable_space α}
   (hf : ∀ n, measurable (f n)) (hp : ∀ n, measurable_set {x | p n x}) (h : ∀ x, ∃ n, p n x) :
   measurable (λ x, f (nat.find (h x)) x) :=
 begin
-  have : measurable (λ (p : α × ℕ), f p.2 p.1) := measurable_from_prod_encodable (λ n, hf n),
+  have : measurable (λ (p : α × ℕ), f p.2 p.1) := measurable_from_prod_countable (λ n, hf n),
   exact this.comp (measurable.prod_mk measurable_id (measurable_find h hp)),
 end
 
@@ -625,10 +672,10 @@ begin
   { have B : x ∈ t (nat.find (P x)) ∪ (⋃ k, t k)ᶜ := nat.find_spec (P x),
     have B' : (∀ (i : ℕ), x ∉ t i) ↔ false,
     { simp only [iff_false, not_forall, not_not_mem], exact ⟨n, hx⟩ },
-    simpa only [B', mem_union_eq, mem_Inter, or_false, compl_Union, mem_compl_eq] using B },
+    simpa only [B', mem_union, mem_Inter, or_false, compl_Union, mem_compl_iff] using B },
   congr,
   by_contra h,
-  exact t_disj n (nat.find (P x)) (ne.symm h) ⟨hx, this⟩
+  exact (t_disj (ne.symm h)).le_bot ⟨hx, this⟩
 end
 
 end prod
@@ -676,17 +723,17 @@ end
 /- Even though we cannot use projection notation, we still keep a dot to be consistent with similar
   lemmas, like `measurable_set.prod`. -/
 @[measurability]
-lemma measurable_set.pi {s : set δ} {t : Π i : δ, set (π i)} (hs : countable s)
+lemma measurable_set.pi {s : set δ} {t : Π i : δ, set (π i)} (hs : s.countable)
   (ht : ∀ i ∈ s, measurable_set (t i)) :
   measurable_set (s.pi t) :=
 by { rw [pi_def], exact measurable_set.bInter hs (λ i hi, measurable_pi_apply _ (ht i hi)) }
 
-lemma measurable_set.univ_pi [encodable δ] {t : Π i : δ, set (π i)}
+lemma measurable_set.univ_pi [countable δ] {t : Π i : δ, set (π i)}
   (ht : ∀ i, measurable_set (t i)) : measurable_set (pi univ t) :=
-measurable_set.pi (countable_encodable _) (λ i _, ht i)
+measurable_set.pi (to_countable _) (λ i _, ht i)
 
 lemma measurable_set_pi_of_nonempty
-  {s : set δ} {t : Π i, set (π i)} (hs : countable s)
+  {s : set δ} {t : Π i, set (π i)} (hs : s.countable)
   (h : (pi s t).nonempty) : measurable_set (pi s t) ↔ ∀ i ∈ s, measurable_set (t i) :=
 begin
   classical,
@@ -694,7 +741,7 @@ begin
   convert measurable_update f hst, rw [update_preimage_pi hi], exact λ j hj _, hf j hj
 end
 
-lemma measurable_set_pi {s : set δ} {t : Π i, set (π i)} (hs : countable s) :
+lemma measurable_set_pi {s : set δ} {t : Π i, set (π i)} (hs : s.countable) :
   measurable_set (pi s t) ↔ (∀ i ∈ s, measurable_set (t i)) ∨ pi s t = ∅ :=
 begin
   cases (pi s t).eq_empty_or_nonempty with h h,
@@ -702,7 +749,10 @@ begin
   { simp [measurable_set_pi_of_nonempty hs, h, ← not_nonempty_iff_eq_empty] }
 end
 
-section
+instance [countable δ] [Π a, measurable_singleton_class (π a)] :
+  measurable_singleton_class (Π a, π a) :=
+⟨λ f, univ_pi_singleton f ▸ measurable_set.univ_pi (λ t, measurable_set_singleton (f t))⟩
+
 variable (π)
 
 @[measurability]
@@ -731,21 +781,6 @@ begin
     simp only [pi_equiv_pi_subtype_prod_apply, measurable_pi_apply] }
 end
 
-end
-
-section fintype
-
-local attribute [instance] fintype.to_encodable
-
-lemma measurable_set.pi_fintype [fintype δ] {s : set δ} {t : Π i, set (π i)}
-  (ht : ∀ i ∈ s, measurable_set (t i)) : measurable_set (pi s t) :=
-measurable_set.pi (countable_encodable _) ht
-
-lemma measurable_set.univ_pi_fintype [fintype δ] {t : Π i, set (π i)}
-  (ht : ∀ i, measurable_set (t i)) : measurable_set (pi univ t) :=
-measurable_set.pi_fintype (λ i _, ht i)
-
-end fintype
 end pi
 
 instance tprod.measurable_space (π : δ → Type*) [∀ x, measurable_space (π x)] :
@@ -843,8 +878,38 @@ end sum
 instance {α} {β : α → Type*} [m : Πa, measurable_space (β a)] : measurable_space (sigma β) :=
 ⨅a, (m a).map (sigma.mk a)
 
+section prop
+variables {p : α → Prop}
+
+variables [measurable_space α]
+
+@[simp] lemma measurable_set_set_of : measurable_set {a | p a} ↔ measurable p :=
+⟨λ h, measurable_to_prop $ by simpa only [preimage_singleton_true], λ h,
+  by simpa using h (measurable_set_singleton true)⟩
+
+@[simp] lemma measurable_mem : measurable (∈ s) ↔ measurable_set s := measurable_set_set_of.symm
+
+alias measurable_set_set_of ↔ _ measurable.set_of
+alias measurable_mem ↔ _ measurable_set.mem
+
+end prop
 end constructions
 
+namespace measurable_space
+
+/-- The sigma-algebra generated by a single set `s` is `{∅, s, sᶜ, univ}`. -/
+@[simp] lemma generate_from_singleton (s : set α) :
+  generate_from {s} = measurable_space.comap (∈ s) ⊤ :=
+begin
+  classical,
+  letI : measurable_space α := generate_from {s},
+  refine le_antisymm (generate_from_le $ λ t ht, ⟨{true}, trivial, by simp [ht.symm]⟩) _,
+  rintro _ ⟨u, -, rfl⟩,
+  exact (show measurable_set s, from generate_measurable.basic _ $ mem_singleton s).mem trivial,
+end
+
+end measurable_space
+
 /-- A map `f : α → β` is called a *measurable embedding* if it is injective, measurable, and sends
 measurable sets to measurable sets. The latter assumption can be replaced with “`f` has measurable
 inverse `g : range f → α`”, see `measurable_embedding.measurable_range_splitting`,
@@ -916,7 +981,7 @@ lemma exists_measurable_extend (hf : measurable_embedding f) {g : α → γ} (hg
   ∃ g' : β → γ, measurable g' ∧ g' ∘ f = g :=
 ⟨extend f g (λ x, classical.choice (hne x)),
   hf.measurable_extend hg (measurable_const' $ λ _ _, rfl),
-  funext $ λ x, extend_apply hf.injective _ _ _⟩
+  funext $ λ x, hf.injective.extend_apply _ _ _⟩
 
 lemma measurable_comp_iff (hg : measurable_embedding g) : measurable (g ∘ f) ↔ measurable f :=
 begin
@@ -1035,6 +1100,9 @@ e.to_equiv.image_eq_preimage s
   measurable_set (e '' s) ↔ measurable_set s :=
 by rw [image_eq_preimage, measurable_set_preimage]
 
+@[simp] lemma map_eq (e : α ≃ᵐ β) : measurable_space.map e ‹_› = ‹_› :=
+e.measurable.le_map.antisymm' $ λ s, e.measurable_set_preimage.1
+
 /-- A measurable equivalence is a measurable embedding. -/
 protected lemma measurable_embedding (e : α ≃ᵐ β) : measurable_embedding e :=
 { injective := e.injective,
@@ -1059,7 +1127,7 @@ iff.intro
 /-- Any two types with unique elements are measurably equivalent. -/
 def of_unique_of_unique (α β : Type*) [measurable_space α] [measurable_space β]
   [unique α] [unique β] : α ≃ᵐ β :=
-{ to_equiv := equiv_of_unique_of_unique,
+{ to_equiv := equiv_of_unique α β,
   measurable_to_fun := subsingleton.measurable,
   measurable_inv_fun := subsingleton.measurable }
 
@@ -1117,27 +1185,6 @@ def set.singleton (a : α) : ({a} : set α) ≃ᵐ unit :=
   measurable_to_fun := measurable_const,
   measurable_inv_fun := measurable_const }
 
-/-- A set is equivalent to its image under a function `f` as measurable spaces,
-  if `f` is an injective measurable function that sends measurable sets to measurable sets. -/
-noncomputable def set.image (f : α → β) (s : set α) (hf : injective f)
-  (hfm : measurable f) (hfi : ∀ s, measurable_set s → measurable_set (f '' s)) : s ≃ᵐ (f '' s) :=
-{ to_equiv := equiv.set.image f s hf,
-  measurable_to_fun  := (hfm.comp measurable_id.subtype_coe).subtype_mk,
-  measurable_inv_fun :=
-    begin
-      rintro t ⟨u, hu, rfl⟩, simp [preimage_preimage, set.image_symm_preimage hf],
-      exact measurable_subtype_coe (hfi u hu)
-    end }
-
-/-- The domain of `f` is equivalent to its range as measurable spaces,
-  if `f` is an injective measurable function that sends measurable sets to measurable sets. -/
-noncomputable def set.range (f : α → β) (hf : injective f) (hfm : measurable f)
-  (hfi : ∀ s, measurable_set s → measurable_set (f '' s)) :
-  α ≃ᵐ (range f) :=
-(measurable_equiv.set.univ _).symm.trans $
-  (measurable_equiv.set.image f univ hf hfm hfi).trans $
-  measurable_equiv.cast (by rw image_univ) (by rw image_univ)
-
 /-- `α` is equivalent to its image in `α ⊕ β` as measurable spaces. -/
 def set.range_inl : (range sum.inl : set (α ⊕ β)) ≃ᵐ α :=
 { to_fun    := λ ab, match ab with
@@ -1274,20 +1321,66 @@ def pi_equiv_pi_subtype_prod (p : δ' → Prop) [decidable_pred p] :
   measurable_to_fun := measurable_pi_equiv_pi_subtype_prod π p,
   measurable_inv_fun := measurable_pi_equiv_pi_subtype_prod_symm π p }
 
+/-- If `s` is a measurable set in a measurable space, that space is equivalent
+to the sum of `s` and `sᶜ`.-/
+def sum_compl {s : set α} [decidable_pred s] (hs : measurable_set s) : s ⊕ (sᶜ : set α) ≃ᵐ α :=
+{ to_equiv := sum_compl s,
+  measurable_to_fun := by {apply measurable.sum_elim; exact measurable_subtype_coe},
+  measurable_inv_fun :=  measurable.dite measurable_inl measurable_inr hs }
+
+/-- Convert a measurable involutive function `f` to a measurable permutation with
+`to_fun = inv_fun = f`. See also `function.involutive.to_perm`. -/
+@[simps to_equiv] def of_involutive (f : α → α) (hf : involutive f) (hf' : measurable f) : α ≃ᵐ α :=
+{ measurable_to_fun := hf',
+  measurable_inv_fun := hf',
+  ..hf.to_perm _ }
+
+@[simp] lemma of_involutive_apply (f : α → α) (hf : involutive f) (hf' : measurable f) (a : α) :
+  of_involutive f hf hf' a = f a := rfl
+
+@[simp] lemma of_involutive_symm (f : α → α) (hf : involutive f) (hf' : measurable f) :
+  (of_involutive f hf hf').symm = of_involutive f hf hf' := rfl
+
 end measurable_equiv
 
 namespace measurable_embedding
 
-variables [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β}
+variables [measurable_space α] [measurable_space β] [measurable_space γ] {f : α → β} {g : β → α}
 
-/-- A measurable embedding defines a measurable equivalence between its domain
-and its range. -/
-noncomputable def equiv_range (f : α → β) (hf : measurable_embedding f) :
-  α ≃ᵐ range f :=
-{ to_equiv := equiv.of_injective f hf.injective,
-  measurable_to_fun := hf.measurable.subtype_mk,
+@[simp] lemma comap_eq (hf : measurable_embedding f) : measurable_space.comap f ‹_› = ‹_› :=
+hf.measurable.comap_le.antisymm $ λ s h,
+  ⟨_, hf.measurable_set_image' h, hf.injective.preimage_image _⟩
+
+lemma iff_comap_eq :
+  measurable_embedding f ↔
+    injective f ∧ measurable_space.comap f ‹_› = ‹_› ∧ measurable_set (range f) :=
+⟨λ hf, ⟨hf.injective, hf.comap_eq, hf.measurable_set_range⟩, λ hf,
+  { injective := hf.1,
+    measurable := by { rw ←hf.2.1, exact comap_measurable f },
+    measurable_set_image' := begin
+      rw ←hf.2.1,
+      rintro _ ⟨s, hs, rfl⟩,
+      simpa only [image_preimage_eq_inter_range] using hs.inter hf.2.2,
+    end }⟩
+
+/-- A set is equivalent to its image under a function `f` as measurable spaces,
+  if `f` is a measurable embedding -/
+noncomputable def equiv_image (s : set α) (hf : measurable_embedding f) :
+  s ≃ᵐ (f '' s) :=
+{ to_equiv := equiv.set.image f s hf.injective,
+  measurable_to_fun  := (hf.measurable.comp measurable_id.subtype_coe).subtype_mk,
   measurable_inv_fun :=
-    by { rw coe_of_injective_symm, exact hf.measurable_range_splitting } }
+    begin
+      rintro t ⟨u, hu, rfl⟩, simp [preimage_preimage, set.image_symm_preimage hf.injective],
+      exact measurable_subtype_coe (hf.measurable_set_image' hu)
+    end }
+
+/-- The domain of `f` is equivalent to its range as measurable spaces,
+  if `f` is a measurable embedding -/
+noncomputable def equiv_range (hf : measurable_embedding f) : α ≃ᵐ (range f) :=
+(measurable_equiv.set.univ _).symm.trans $
+  (hf.equiv_image univ).trans $
+  measurable_equiv.cast (by rw image_univ) (by rw image_univ)
 
 lemma of_measurable_inverse_on_range {g : range f → α} (hf₁ : measurable f)
   (hf₂ : measurable_set (range f)) (hg : measurable g)
@@ -1299,13 +1392,135 @@ begin
   exact (measurable_embedding.subtype_coe hf₂).comp e.measurable_embedding
 end
 
-lemma of_measurable_inverse {g : β → α} (hf₁ : measurable f)
+lemma of_measurable_inverse (hf₁ : measurable f)
   (hf₂ : measurable_set (range f)) (hg : measurable g)
   (H : left_inverse g f) : measurable_embedding f :=
 of_measurable_inverse_on_range hf₁ hf₂ (hg.comp measurable_subtype_coe) H
 
+open_locale classical
+
+/-- The **`measurable Schröder-Bernstein Theorem**: Given measurable embeddings
+`α → β` and `β → α`, we can find a measurable equivalence `α ≃ᵐ β`.-/
+noncomputable
+def schroeder_bernstein {f : α → β} {g : β → α}
+  (hf : measurable_embedding f)(hg : measurable_embedding g) : α ≃ᵐ β :=
+begin
+  let F : set α → set α := λ A, (g '' (f '' A)ᶜ)ᶜ,
+  -- We follow the proof of the usual SB theorem in mathlib,
+  -- the crux of which is finding a fixed point of this F.
+  -- However, we must find this fixed point manually instead of invoking Knaster-Tarski
+  -- in order to make sure it is measurable.
+  suffices : Σ' A : set α, measurable_set A ∧ F A = A,
+  { rcases this with ⟨A, Ameas, Afp⟩,
+    let B := f '' A,
+    have Bmeas : measurable_set B := hf.measurable_set_image' Ameas,
+    refine (measurable_equiv.sum_compl Ameas).symm.trans
+      (measurable_equiv.trans _ (measurable_equiv.sum_compl Bmeas)),
+    apply measurable_equiv.sum_congr (hf.equiv_image _),
+    have : Aᶜ = g '' Bᶜ,
+    { apply compl_injective,
+      rw ← Afp,
+      simp, },
+    rw this,
+    exact (hg.equiv_image _).symm, },
+  have Fmono : ∀ {A B}, A ⊆ B → F A ⊆ F B := λ A B hAB,
+    compl_subset_compl.mpr $ set.image_subset _ $
+    compl_subset_compl.mpr $ set.image_subset _ hAB,
+  let X : ℕ → set α := λ n, F^[n] univ,
+  refine ⟨Inter X, _, _⟩,
+  { apply measurable_set.Inter,
+    intros n,
+    induction n with n ih,
+    { exact measurable_set.univ },
+    rw [function.iterate_succ', function.comp_apply],
+    exact (hg.measurable_set_image' (hf.measurable_set_image' ih).compl).compl, },
+  apply subset_antisymm,
+  { apply subset_Inter,
+    intros n,
+    cases n,
+    { exact subset_univ _ },
+    rw [function.iterate_succ', function.comp_apply],
+    exact Fmono (Inter_subset _ _ ), },
+  rintros x hx ⟨y, hy, rfl⟩,
+  rw mem_Inter at hx,
+  apply hy,
+  rw (inj_on_of_injective hf.injective _).image_Inter_eq,
+  swap, { apply_instance },
+  rw mem_Inter,
+  intro n,
+  specialize hx n.succ,
+  rw [function.iterate_succ', function.comp_apply] at hx,
+  by_contradiction h,
+  apply hx,
+  exact ⟨y, h, rfl⟩,
+end
+
 end measurable_embedding
 
+lemma measurable_space.comap_compl {m' : measurable_space β} [boolean_algebra β]
+  (h : measurable (compl : β → β)) (f : α → β) :
+  measurable_space.comap (λ a, (f a)ᶜ) infer_instance = measurable_space.comap f infer_instance :=
+begin
+  rw ←measurable_space.comap_comp,
+  congr',
+  exact (measurable_equiv.of_involutive _ compl_involutive h).measurable_embedding.comap_eq,
+end
+
+@[simp] lemma measurable_space.comap_not (p : α → Prop) :
+  measurable_space.comap (λ a, ¬ p a) infer_instance = measurable_space.comap p infer_instance :=
+measurable_space.comap_compl (λ _ _, trivial) _
+
+section countably_generated
+
+namespace measurable_space
+
+variable (α)
+
+/-- We say a measurable space is countably generated
+if can be generated by a countable set of sets.-/
+class countably_generated [m : measurable_space α] : Prop :=
+  (is_countably_generated : ∃ b : set (set α), b.countable ∧ m = generate_from b)
+
+open_locale classical
+
+/-- If a measurable space is countably generated, it admits a measurable injection
+into the Cantor space `ℕ → bool` (equipped with the product sigma algebra). -/
+theorem measurable_injection_nat_bool_of_countably_generated
+[measurable_space α] [h : countably_generated α] [measurable_singleton_class α] :
+∃ f : α → (ℕ → bool), measurable f ∧ function.injective f :=
+begin
+  obtain ⟨b, bct, hb⟩ := h.is_countably_generated,
+  obtain ⟨e, he⟩ := set.countable.exists_eq_range (bct.insert ∅) (insert_nonempty _ _),
+  rw [← generate_from_insert_empty, he] at hb,
+  refine ⟨λ x n, to_bool (x ∈ e n), _, _⟩,
+  { rw measurable_pi_iff,
+    intro n,
+    apply measurable_to_bool,
+    simp only [preimage, mem_singleton_iff, to_bool_iff, set_of_mem_eq],
+    rw hb,
+    apply measurable_set_generate_from,
+    use n, },
+  intros x y hxy,
+  have : ∀ s : set α, measurable_set s → (x ∈ s ↔ y ∈ s) := λ s, by
+  { rw hb,
+    apply generate_from_induction,
+    { rintros - ⟨n, rfl⟩,
+      rw ← bool.to_bool_eq,
+      rw funext_iff at hxy,
+      exact hxy n },
+    { tauto },
+    { intro t,
+      tauto },
+    intros t ht,
+    simp_rw [mem_Union, ht], },
+  specialize this {y} measurable_set_eq,
+  simpa only [mem_singleton, iff_true],
+end
+
+end measurable_space
+
+end countably_generated
+
 namespace filter
 
 variables [measurable_space α]
@@ -1355,7 +1570,7 @@ begin
 end
 
 alias principal_is_measurably_generated_iff ↔
-  _ measurable_set.principal_is_measurably_generated
+  _ _root_.measurable_set.principal_is_measurably_generated
 
 instance infi_is_measurably_generated {f : ι → filter α} [∀ i, is_measurably_generated (f i)] :
   is_measurably_generated (⨅ i, f i) :=
@@ -1467,8 +1682,6 @@ instance : bounded_order (subtype (measurable_set : set α → Prop)) :=
 
 instance : boolean_algebra (subtype (measurable_set : set α → Prop)) :=
 { sdiff := (\),
-  sup_inf_sdiff := λ a b, subtype.eq $ sup_inf_sdiff a b,
-  inf_inf_sdiff := λ a b, subtype.eq $ inf_inf_sdiff a b,
   compl := has_compl.compl,
   inf_compl_le_bot := λ a, boolean_algebra.inf_compl_le_bot (a : set α),
   top_le_sup_compl := λ a, boolean_algebra.top_le_sup_compl (a : set α),
@@ -1476,4 +1689,36 @@ instance : boolean_algebra (subtype (measurable_set : set α → Prop)) :=
   .. measurable_set.subtype.bounded_order,
   .. measurable_set.subtype.distrib_lattice }
 
+@[measurability] lemma measurable_set_blimsup {s : ℕ → set α} {p : ℕ → Prop}
+  (h : ∀ n, p n → measurable_set (s n)) :
+  measurable_set $ filter.blimsup s filter.at_top p :=
+begin
+  simp only [filter.blimsup_eq_infi_bsupr_of_nat, supr_eq_Union, infi_eq_Inter],
+  exact measurable_set.Inter
+    (λ n, measurable_set.Union (λ m, measurable_set.Union $ λ hm, h m hm.1)),
+end
+
+@[measurability] lemma measurable_set_bliminf {s : ℕ → set α} {p : ℕ → Prop}
+  (h : ∀ n, p n → measurable_set (s n)) :
+  measurable_set $ filter.bliminf s filter.at_top p :=
+begin
+  simp only [filter.bliminf_eq_supr_binfi_of_nat, infi_eq_Inter, supr_eq_Union],
+  exact measurable_set.Union
+    (λ n, measurable_set.Inter (λ m, measurable_set.Inter $ λ hm, h m hm.1)),
+end
+
+@[measurability] lemma measurable_set_limsup {s : ℕ → set α} (hs : ∀ n, measurable_set $ s n) :
+  measurable_set $ filter.limsup s filter.at_top :=
+begin
+  convert measurable_set_blimsup (λ n h, hs n : ∀ n, true → measurable_set (s n)),
+  simp,
+end
+
+@[measurability] lemma measurable_set_liminf {s : ℕ → set α} (hs : ∀ n, measurable_set $ s n) :
+  measurable_set $ filter.liminf s filter.at_top :=
+begin
+  convert measurable_set_bliminf (λ n h, hs n : ∀ n, true → measurable_set (s n)),
+  simp,
+end
+
 end measurable_set
diff --git a/src/measure_theory/measurable_space_def.lean b/src/measure_theory/measurable_space_def.lean
index c7cf0139715b6..6fb980dffc3f7 100644
--- a/src/measure_theory/measurable_space_def.lean
+++ b/src/measure_theory/measurable_space_def.lean
@@ -5,13 +5,14 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import data.set.countable
 import logic.encodable.lattice
-import order.conditionally_complete_lattice
 import order.disjointed
-import order.symm_diff
 
 /-!
 # Measurable spaces and measurable functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines measurable spaces and measurable functions.
 
 A measurable space is a set equipped with a σ-algebra, a collection of
@@ -62,7 +63,8 @@ section
 /-- `measurable_set s` means that `s` is measurable (in the ambient measure space on `α`) -/
 def measurable_set [measurable_space α] : set α → Prop := ‹measurable_space α›.measurable_set'
 
-localized "notation `measurable_set[` m `]` := @measurable_set _ m" in measure_theory
+localized "notation (name := measurable_set_of)
+  `measurable_set[` m `]` := @measurable_set hole! m" in measure_theory
 
 @[simp] lemma measurable_set.empty [measurable_space α] : measurable_set (∅ : set α) :=
 ‹measurable_space α›.measurable_set_empty
@@ -95,14 +97,15 @@ lemma measurable_set.bUnion_decode₂ [encodable β] ⦃f : β → set α⦄ (h
   (n : ℕ) : measurable_set (⋃ b ∈ decode₂ β n, f b) :=
 encodable.Union_decode₂_cases measurable_set.empty h
 
-lemma measurable_set.Union [encodable β] ⦃f : β → set α⦄ (h : ∀ b, measurable_set (f b)) :
+lemma measurable_set.Union [countable ι] ⦃f : ι → set α⦄ (h : ∀ b, measurable_set (f b)) :
   measurable_set (⋃ b, f b) :=
 begin
-  rw ← encodable.Union_decode₂,
-  exact ‹measurable_space α›.measurable_set_Union _ (measurable_set.bUnion_decode₂ h)
+  casesI nonempty_encodable (plift ι),
+  rw [←Union_plift_down, ←encodable.Union_decode₂],
+  exact ‹measurable_space α›.measurable_set_Union _ (measurable_set.bUnion_decode₂ $ λ _, h _),
 end
 
-lemma measurable_set.bUnion {f : β → set α} {s : set β} (hs : countable s)
+lemma measurable_set.bUnion {f : β → set α} {s : set β} (hs : s.countable)
   (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋃ b ∈ s, f b) :=
 begin
   rw bUnion_eq_Union,
@@ -110,7 +113,7 @@ begin
   exact measurable_set.Union (by simpa using h)
 end
 
-lemma set.finite.measurable_set_bUnion {f : β → set α} {s : set β} (hs : finite s)
+lemma set.finite.measurable_set_bUnion {f : β → set α} {s : set β} (hs : s.finite)
   (h : ∀ b ∈ s, measurable_set (f b)) :
   measurable_set (⋃ b ∈ s, f b) :=
 measurable_set.bUnion hs.countable h
@@ -120,44 +123,26 @@ lemma finset.measurable_set_bUnion {f : β → set α} (s : finset β)
   measurable_set (⋃ b ∈ s, f b) :=
 s.finite_to_set.measurable_set_bUnion h
 
-lemma measurable_set.sUnion {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, measurable_set t) :
+lemma measurable_set.sUnion {s : set (set α)} (hs : s.countable) (h : ∀ t ∈ s, measurable_set t) :
   measurable_set (⋃₀ s) :=
 by { rw sUnion_eq_bUnion, exact measurable_set.bUnion hs h }
 
-lemma set.finite.measurable_set_sUnion {s : set (set α)} (hs : finite s)
+lemma set.finite.measurable_set_sUnion {s : set (set α)} (hs : s.finite)
   (h : ∀ t ∈ s, measurable_set t) :
   measurable_set (⋃₀ s) :=
 measurable_set.sUnion hs.countable h
 
-lemma measurable_set.Union_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
-  measurable_set (⋃ b, f b) :=
-by { by_cases p; simp [h, hf, measurable_set.empty] }
-
-lemma measurable_set.Inter [encodable β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
+lemma measurable_set.Inter [countable ι] {f : ι → set α} (h : ∀ b, measurable_set (f b)) :
   measurable_set (⋂ b, f b) :=
 measurable_set.compl_iff.1 $
 by { rw compl_Inter, exact measurable_set.Union (λ b, (h b).compl) }
 
-section fintype
-
-local attribute [instance] fintype.to_encodable
-
-lemma measurable_set.Union_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
-  measurable_set (⋃ b, f b) :=
-measurable_set.Union h
-
-lemma measurable_set.Inter_fintype [fintype β] {f : β → set α} (h : ∀ b, measurable_set (f b)) :
-  measurable_set (⋂ b, f b) :=
-measurable_set.Inter h
-
-end fintype
-
-lemma measurable_set.bInter {f : β → set α} {s : set β} (hs : countable s)
+lemma measurable_set.bInter {f : β → set α} {s : set β} (hs : s.countable)
   (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
 measurable_set.compl_iff.1 $
 by { rw compl_Inter₂, exact measurable_set.bUnion hs (λ b hb, (h b hb).compl) }
 
-lemma set.finite.measurable_set_bInter {f : β → set α} {s : set β} (hs : finite s)
+lemma set.finite.measurable_set_bInter {f : β → set α} {s : set β} (hs : s.finite)
   (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
 measurable_set.bInter hs.countable h
 
@@ -165,18 +150,14 @@ lemma finset.measurable_set_bInter {f : β → set α} (s : finset β)
   (h : ∀ b ∈ s, measurable_set (f b)) : measurable_set (⋂ b ∈ s, f b) :=
 s.finite_to_set.measurable_set_bInter h
 
-lemma measurable_set.sInter {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, measurable_set t) :
+lemma measurable_set.sInter {s : set (set α)} (hs : s.countable) (h : ∀ t ∈ s, measurable_set t) :
   measurable_set (⋂₀ s) :=
 by { rw sInter_eq_bInter, exact measurable_set.bInter hs h }
 
-lemma set.finite.measurable_set_sInter {s : set (set α)} (hs : finite s)
+lemma set.finite.measurable_set_sInter {s : set (set α)} (hs : s.finite)
   (h : ∀ t ∈ s, measurable_set t) : measurable_set (⋂₀ s) :=
 measurable_set.sInter hs.countable h
 
-lemma measurable_set.Inter_Prop {p : Prop} {f : p → set α} (hf : ∀ b, measurable_set (f b)) :
-  measurable_set (⋂ b, f b) :=
-by { by_cases p; simp [h, hf, measurable_set.univ] }
-
 @[simp] lemma measurable_set.union {s₁ s₂ : set α} (h₁ : measurable_set s₁)
   (h₂ : measurable_set s₂) :
   measurable_set (s₁ ∪ s₂) :=
@@ -202,6 +183,11 @@ h₁.inter h₂.compl
   measurable_set (t.ite s₁ s₂) :=
 (h₁.inter ht).union (h₂.diff ht)
 
+lemma measurable_set.ite' {s t : set α} {p : Prop}
+  (hs : p → measurable_set s) (ht : ¬ p → measurable_set t) :
+  measurable_set (ite p s t) :=
+by { split_ifs, exacts [hs h, ht h], }
+
 @[simp] lemma measurable_set.cond {s₁ s₂ : set α} (h₁ : measurable_set s₁) (h₂ : measurable_set s₂)
   {i : bool} : measurable_set (cond i s₁ s₂) :=
 by { cases i, exacts [h₂, h₁] }
@@ -210,7 +196,7 @@ by { cases i, exacts [h₂, h₁] }
   measurable_set (disjointed f n) :=
 disjointed_rec (λ t i ht, measurable_set.diff ht $ h _) (h n)
 
-@[simp] lemma measurable_set.const (p : Prop) : measurable_set {a : α | p} :=
+lemma measurable_set.const (p : Prop) : measurable_set {a : α | p} :=
 by { by_cases p; simp [h, measurable_set.empty]; apply measurable_set.univ }
 
 /-- Every set has a measurable superset. Declare this as local instance as needed. -/
@@ -219,14 +205,16 @@ lemma nonempty_measurable_superset (s : set α) : nonempty { t // s ⊆ t ∧ me
 
 end
 
+open_locale measure_theory
+
 @[ext] lemma measurable_space.ext : ∀ {m₁ m₂ : measurable_space α},
-  (∀ s : set α, m₁.measurable_set' s ↔ m₂.measurable_set' s) → m₁ = m₂
+  (∀ s : set α, measurable_set[m₁] s ↔ measurable_set[m₂] s) → m₁ = m₂
 | ⟨s₁, _, _, _⟩ ⟨s₂, _, _, _⟩ h :=
   have s₁ = s₂, from funext $ assume x, propext $ h x,
   by subst this
 
 @[ext] lemma measurable_space.ext_iff {m₁ m₂ : measurable_space α} :
-  m₁ = m₂ ↔ (∀ s : set α, m₁.measurable_set' s ↔ m₂.measurable_set' s) :=
+  m₁ = m₂ ↔ (∀ s : set α, measurable_set[m₁] s ↔ measurable_set[m₂] s) :=
 ⟨by { unfreezingI {rintro rfl}, intro s, refl }, measurable_space.ext⟩
 
 /-- A typeclass mixin for `measurable_space`s such that each singleton is measurable. -/
@@ -257,13 +245,13 @@ lemma measurable_set.insert {s : set α} (hs : measurable_set s) (a : α) :
 lemma set.subsingleton.measurable_set {s : set α} (hs : s.subsingleton) : measurable_set s :=
 hs.induction_on measurable_set.empty measurable_set_singleton
 
-lemma set.finite.measurable_set {s : set α} (hs : finite s) : measurable_set s :=
+lemma set.finite.measurable_set {s : set α} (hs : s.finite) : measurable_set s :=
 finite.induction_on hs measurable_set.empty $ λ a s ha hsf hsm, hsm.insert _
 
 protected lemma finset.measurable_set (s : finset α) : measurable_set (↑s : set α) :=
 s.finite_to_set.measurable_set
 
-lemma set.countable.measurable_set {s : set α} (hs : countable s) : measurable_set s :=
+lemma set.countable.measurable_set {s : set α} (hs : s.countable) : measurable_set s :=
 begin
   rw [← bUnion_of_singleton s],
   exact measurable_set.bUnion hs (λ b hb, measurable_set_singleton b)
@@ -276,16 +264,15 @@ namespace measurable_space
 section complete_lattice
 
 instance : has_le (measurable_space α) :=
-{ le          := λ m₁ m₂, m₁.measurable_set' ≤ m₂.measurable_set' }
+{ le          := λ m₁ m₂, ∀ s, measurable_set[m₁] s → measurable_set[m₂] s }
 
 lemma le_def {α} {a b : measurable_space α} :
   a ≤ b ↔ a.measurable_set' ≤ b.measurable_set' := iff.rfl
 
 instance : partial_order (measurable_space α) :=
-{ le_refl     := assume a b, le_rfl,
-  le_trans    := assume a b c hab hbc, le_def.mpr (le_trans hab hbc),
-  le_antisymm := assume a b h₁ h₂, measurable_space.ext $ assume s, ⟨h₁ s, h₂ s⟩,
-  ..measurable_space.has_le }
+{ lt := λ m₁ m₂, m₁ ≤ m₂ ∧ ¬m₂ ≤ m₁,
+  .. measurable_space.has_le,
+  .. partial_order.lift (@measurable_set α) (λ m₁ m₂ h, ext $ λ s, h ▸ iff.rfl) }
 
 /-- The smallest σ-algebra containing a collection `s` of basic sets -/
 inductive generate_measurable (s : set (set α)) : set α → Prop
@@ -305,15 +292,23 @@ lemma measurable_set_generate_from {s : set (set α)} {t : set α} (ht : t ∈ s
   @measurable_set _ (generate_from s) t :=
 generate_measurable.basic t ht
 
+@[elab_as_eliminator]
+lemma generate_from_induction (p : set α → Prop) (C : set (set α))
+  (hC : ∀ t ∈ C, p t) (h_empty : p ∅) (h_compl : ∀ t, p t → p tᶜ)
+  (h_Union : ∀ f : ℕ → set α, (∀ n, p (f n)) → p (⋃ i, f i))
+  {s : set α} (hs : measurable_set[generate_from C] s) :
+  p s :=
+by { induction hs, exacts [hC _ hs_H, h_empty, h_compl _ hs_ih, h_Union hs_f hs_ih], }
+
 lemma generate_from_le {s : set (set α)} {m : measurable_space α}
-  (h : ∀ t ∈ s, m.measurable_set' t) : generate_from s ≤ m :=
+  (h : ∀ t ∈ s, measurable_set[m] t) : generate_from s ≤ m :=
 assume t (ht : generate_measurable s t), ht.rec_on h
   (measurable_set_empty m)
   (assume s _ hs, measurable_set_compl m s hs)
   (assume f _ hf, measurable_set_Union m f hf)
 
 lemma generate_from_le_iff {s : set (set α)} (m : measurable_space α) :
-  generate_from s ≤ m ↔ s ⊆ {t | m.measurable_set' t} :=
+  generate_from s ≤ m ↔ s ⊆ {t | measurable_set[m] t} :=
 iff.intro
   (assume h u hu, h _ $ measurable_set_generate_from hu)
   (assume h, generate_from_le h)
@@ -324,7 +319,7 @@ le_antisymm (generate_from_le $ λ _, id) $ λ s, measurable_set_generate_from
 
 /-- If `g` is a collection of subsets of `α` such that the `σ`-algebra generated from `g` contains
 the same sets as `g`, then `g` was already a `σ`-algebra. -/
-protected def mk_of_closure (g : set (set α)) (hg : {t | (generate_from g).measurable_set' t} = g) :
+protected def mk_of_closure (g : set (set α)) (hg : {t | measurable_set[generate_from g] t} = g) :
   measurable_space α :=
 { measurable_set'      := λ s, s ∈ g,
   measurable_set_empty := hg ▸ measurable_set_empty _,
@@ -332,7 +327,7 @@ protected def mk_of_closure (g : set (set α)) (hg : {t | (generate_from g).meas
   measurable_set_Union := hg ▸ measurable_set_Union _ }
 
 lemma mk_of_closure_sets {s : set (set α)}
-  {hs : {t | (generate_from s).measurable_set' t} = s} :
+  {hs : {t | measurable_set[generate_from s] t} = s} :
   measurable_space.mk_of_closure s hs = generate_from s :=
 measurable_space.ext $ assume t, show t ∈ s ↔ _, by { conv_lhs { rw [← hs] }, refl }
 
@@ -350,6 +345,44 @@ gi_generate_from.lift_complete_lattice
 
 instance : inhabited (measurable_space α) := ⟨⊤⟩
 
+@[mono] lemma generate_from_mono {s t : set (set α)} (h : s ⊆ t) :
+  generate_from s ≤ generate_from t :=
+gi_generate_from.gc.monotone_l h
+
+lemma generate_from_sup_generate_from {s t : set (set α)} :
+  generate_from s ⊔ generate_from t = generate_from (s ∪ t) :=
+(@gi_generate_from α).gc.l_sup.symm
+
+@[simp] lemma generate_from_insert_univ (S : set (set α)) :
+  generate_from (insert set.univ S) = generate_from S :=
+begin
+  refine le_antisymm _ (generate_from_mono (set.subset_insert _ _)),
+  rw generate_from_le_iff,
+  intros t ht,
+  cases ht,
+  { rw ht,
+    exact measurable_set.univ, },
+  { exact measurable_set_generate_from ht, },
+end
+
+@[simp] lemma generate_from_insert_empty (S : set (set α)) :
+  generate_from (insert ∅ S) = generate_from S :=
+begin
+  refine le_antisymm _ (generate_from_mono (set.subset_insert _ _)),
+  rw generate_from_le_iff,
+  intros t ht,
+  cases ht,
+  { rw ht,
+    exact @measurable_set.empty _ (generate_from S), },
+  { exact measurable_set_generate_from ht, },
+end
+
+lemma generate_from_singleton_empty : generate_from {∅} = (⊥ : measurable_space α) :=
+by { rw [eq_bot_iff, generate_from_le_iff], simp, }
+
+lemma generate_from_singleton_univ : generate_from {set.univ} = (⊥ : measurable_space α) :=
+by { rw [eq_bot_iff, generate_from_le_iff], simp, }
+
 lemma measurable_set_bot_iff {s : set α} : @measurable_set α ⊥ s ↔ (s = ∅ ∨ s = univ) :=
 let b : measurable_space α :=
 { measurable_set'      := λ s, s = ∅ ∨ s = univ,
@@ -381,12 +414,12 @@ show s ∈ (⋂₀ _) ↔ _, by simp
 by rw [infi, measurable_set_Inf, forall_range_iff]
 
 theorem measurable_set_sup {m₁ m₂ : measurable_space α} {s : set α} :
-  @measurable_set _ (m₁ ⊔ m₂) s ↔ generate_measurable (m₁.measurable_set' ∪ m₂.measurable_set') s :=
+  measurable_set[m₁ ⊔ m₂] s ↔ generate_measurable (measurable_set[m₁] ∪ measurable_set[m₂]) s :=
 iff.refl _
 
 theorem measurable_set_Sup {ms : set (measurable_space α)} {s : set α} :
-  @measurable_set _ (Sup ms) s ↔
-    generate_measurable {s : set α | ∃ m ∈ ms, @measurable_set _ m s} s :=
+  measurable_set[Sup ms] s ↔
+    generate_measurable {s : set α | ∃ m ∈ ms, measurable_set[m] s} s :=
 begin
   change @measurable_set' _ (generate_from $ ⋃₀ _) _ ↔ _,
   simp [generate_from, ← set_of_exists]
@@ -394,14 +427,20 @@ end
 
 theorem measurable_set_supr {ι} {m : ι → measurable_space α} {s : set α} :
   @measurable_set _ (supr m) s ↔
-    generate_measurable {s : set α | ∃ i, @measurable_set _ (m i) s} s :=
+    generate_measurable {s : set α | ∃ i, measurable_set[m i] s} s :=
 by simp only [supr, measurable_set_Sup, exists_range_iff]
 
-end complete_lattice
+lemma measurable_space_supr_eq (m : ι → measurable_space α) :
+  (⨆ n, m n) = generate_from {s | ∃ n, measurable_set[m n] s} :=
+by { ext s, rw measurable_set_supr, refl, }
 
+lemma generate_from_Union_measurable_set (m : ι → measurable_space α) :
+  generate_from (⋃ n, {t | measurable_set[m n] t}) = ⨆ n, m n :=
+(@gi_generate_from α).l_supr_u m
 
-end measurable_space
+end complete_lattice
 
+end measurable_space
 
 section measurable_functions
 open measurable_space
@@ -411,7 +450,8 @@ open measurable_space
 def measurable [measurable_space α] [measurable_space β] (f : α → β) : Prop :=
 ∀ ⦃t : set β⦄, measurable_set t → measurable_set (f ⁻¹' t)
 
-localized "notation `measurable[` m `]` := @measurable _ _ m _" in measure_theory
+localized "notation (name := measurable_of)
+  `measurable[` m `]` := @measurable hole! hole! m hole!" in measure_theory
 
 lemma measurable_id {ma : measurable_space α} : measurable (@id α) := λ t, id
 
@@ -431,4 +471,8 @@ lemma measurable.le {α} {m m0 : measurable_space α} {mb : measurable_space β}
   (hf : measurable[m] f) : measurable[m0] f :=
 λ s hs, hm _ (hf hs)
 
+lemma measurable_space.top.measurable {α β : Type*} [measurable_space β] (f : α → β) :
+  @measurable α β ⊤ _ f :=
+λ s hs, measurable_space.measurable_set_top
+
 end measurable_functions
diff --git a/src/measure_theory/measure/ae_disjoint.lean b/src/measure_theory/measure/ae_disjoint.lean
index 6b272e35de93b..6b740e0197ffc 100644
--- a/src/measure_theory/measure/ae_disjoint.lean
+++ b/src/measure_theory/measure/ae_disjoint.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.measure_space_def
 /-!
 # Almost everywhere disjoint sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that sets `s` and `t` are `μ`-a.e. disjoint (see `measure_theory.ae_disjoint`) if their
 intersection has measure zero. This assumption can be used instead of `disjoint` in most theorems in
 measure theory.
@@ -26,19 +29,19 @@ variables {μ} {s t u v : set α}
 
 /-- If `s : ι → set α` is a countable family of pairwise a.e. disjoint sets, then there exists a
 family of measurable null sets `t i` such that `s i \ t i` are pairwise disjoint. -/
-lemma exists_null_pairwise_disjoint_diff [encodable ι] {s : ι → set α}
+lemma exists_null_pairwise_disjoint_diff [countable ι] {s : ι → set α}
   (hd : pairwise (ae_disjoint μ on s)) :
-  ∃ t : ι → set α, (∀ i, measurable_set (t i)) ∧ (∀ i, μ (t i) = 0) ∧ 
+  ∃ t : ι → set α, (∀ i, measurable_set (t i)) ∧ (∀ i, μ (t i) = 0) ∧
     pairwise (disjoint on (λ i, s i \ t i)) :=
 begin
   refine ⟨λ i, to_measurable μ (s i ∩ ⋃ j ∈ ({i}ᶜ : set ι), s j),
     λ i, measurable_set_to_measurable _ _, λ i, _, _⟩,
-  { simp only [measure_to_measurable, inter_Union, measure_bUnion_null_iff (countable_encodable _)],
-    exact λ j hj, hd _ _ (ne.symm hj) },
+  { simp only [measure_to_measurable, inter_Union],
+    exact (measure_bUnion_null_iff $ to_countable _).2 (λ j hj, hd (ne.symm hj)) },
   { simp only [pairwise, disjoint_left, on_fun, mem_diff, not_and, and_imp, not_not],
     intros i j hne x hi hU hj,
     replace hU : x ∉ s i ∩ ⋃ j ≠ i, s j := λ h, hU (subset_to_measurable _ _ h),
-    simp only [mem_inter_eq, mem_Union, not_and, not_exists] at hU,
+    simp only [mem_inter_iff, mem_Union, not_and, not_exists] at hU,
     exact (hU hi j hne.symm hj).elim }
 end
 
@@ -53,20 +56,33 @@ protected lemma symmetric : symmetric (ae_disjoint μ) := λ s t h, h.symm
 
 protected lemma comm : ae_disjoint μ s t ↔ ae_disjoint μ t s := ⟨λ h, h.symm, λ h, h.symm⟩
 
-lemma _root_.disjoint.ae_disjoint (h : disjoint s t) : ae_disjoint μ s t :=
+protected lemma _root_.disjoint.ae_disjoint (h : disjoint s t) : ae_disjoint μ s t :=
 by rw [ae_disjoint, disjoint_iff_inter_eq_empty.1 h, measure_empty]
 
+protected lemma _root_.pairwise.ae_disjoint {f : ι → set α} (hf : pairwise (disjoint on f)) :
+  pairwise (ae_disjoint μ on f) :=
+hf.mono $ λ i j h, h.ae_disjoint
+
+protected lemma _root_.set.pairwise_disjoint.ae_disjoint {f : ι → set α} {s : set ι}
+  (hf : s.pairwise_disjoint f) :
+  s.pairwise (ae_disjoint μ on f) :=
+hf.mono' $ λ i j h, h.ae_disjoint
+
 lemma mono_ae (h : ae_disjoint μ s t) (hu : u ≤ᵐ[μ] s) (hv : v ≤ᵐ[μ] t) : ae_disjoint μ u v :=
 measure_mono_null_ae (hu.inter hv) h
 
-lemma mono (h : ae_disjoint μ s t) (hu : u ⊆ s) (hv : v ⊆ t) : ae_disjoint μ u v :=
+protected lemma mono (h : ae_disjoint μ s t) (hu : u ⊆ s) (hv : v ⊆ t) : ae_disjoint μ u v :=
 h.mono_ae hu.eventually_le hv.eventually_le
 
-@[simp] lemma Union_left_iff [encodable ι] {s : ι → set α} :
+protected lemma congr (h : ae_disjoint μ s t) (hu : u =ᵐ[μ] s) (hv : v =ᵐ[μ] t) :
+  ae_disjoint μ u v :=
+h.mono_ae (filter.eventually_eq.le hu) (filter.eventually_eq.le hv)
+
+@[simp] lemma Union_left_iff [countable ι] {s : ι → set α} :
   ae_disjoint μ (⋃ i, s i) t ↔ ∀ i, ae_disjoint μ (s i) t :=
 by simp only [ae_disjoint, Union_inter, measure_Union_null_iff]
 
-@[simp] lemma Union_right_iff [encodable ι] {t : ι → set α} :
+@[simp] lemma Union_right_iff [countable ι] {t : ι → set α} :
   ae_disjoint μ s (⋃ i, t i) ↔ ∀ i, ae_disjoint μ s (t i) :=
 by simp only [ae_disjoint, inter_Union, measure_Union_null_iff]
 
@@ -97,7 +113,8 @@ set `u`. -/
 lemma exists_disjoint_diff (h : ae_disjoint μ s t) :
   ∃ u, measurable_set u ∧ μ u = 0 ∧ disjoint (s \ u) t :=
 ⟨to_measurable μ (s ∩ t), measurable_set_to_measurable _ _, (measure_to_measurable _).trans h,
-  disjoint_diff.symm.mono_left (λ x hx, ⟨hx.1, λ hxt, hx.2 $ subset_to_measurable _ _ ⟨hx.1, hxt⟩⟩)⟩
+  disjoint_sdiff_self_left.mono_left $ λ x hx, ⟨hx.1, λ hxt, hx.2 $
+    subset_to_measurable _ _ ⟨hx.1, hxt⟩⟩⟩
 
 lemma of_null_right (h : μ t = 0) : ae_disjoint μ s t :=
 measure_mono_null (inter_subset_right _ _) h
@@ -106,7 +123,7 @@ lemma of_null_left (h : μ s = 0) : ae_disjoint μ s t := (of_null_right h).symm
 
 end ae_disjoint
 
-lemma ae_disjoint_compl_left : ae_disjoint μ sᶜ s := (@disjoint_compl_left _ s _).ae_disjoint
-lemma ae_disjoint_compl_right : ae_disjoint μ s sᶜ := (@disjoint_compl_right _ s _).ae_disjoint
+lemma ae_disjoint_compl_left : ae_disjoint μ sᶜ s := (@disjoint_compl_left _ _ s).ae_disjoint
+lemma ae_disjoint_compl_right : ae_disjoint μ s sᶜ := (@disjoint_compl_right _ _ s).ae_disjoint
 
 end measure_theory
diff --git a/src/measure_theory/measure/ae_measurable.lean b/src/measure_theory/measure/ae_measurable.lean
index 13816f0ef631a..85d55ad2bf67a 100644
--- a/src/measure_theory/measure/ae_measurable.lean
+++ b/src/measure_theory/measure/ae_measurable.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.measure_space
 /-!
 # Almost everywhere measurable functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A function is almost everywhere measurable if it coincides almost everywhere with a measurable
 function. This property, called `ae_measurable f μ`, is defined in the file `measure_space_def`.
 We discuss several of its properties that are analogous to properties of measurable functions.
@@ -58,7 +61,7 @@ lemma ae_inf_principal_eq_mk {s} (h : ae_measurable f (μ.restrict s)) :
 le_ae_restrict h.ae_eq_mk
 
 @[measurability]
-lemma sum_measure [encodable ι] {μ : ι → measure α} (h : ∀ i, ae_measurable f (μ i)) :
+lemma sum_measure [countable ι] {μ : ι → measure α} (h : ∀ i, ae_measurable f (μ i)) :
   ae_measurable f (sum μ) :=
 begin
   nontriviality β, inhabit β,
@@ -77,7 +80,7 @@ begin
     refine ⟨⋃ i, ((h i).mk f ⁻¹' t) ∩ (s i)ᶜ, measurable_set.Union $
       λ i, (measurable_mk _ ht).inter (measurable_set_to_measurable _ _).compl, _⟩,
     ext ⟨x, hx⟩,
-    simp only [mem_preimage, mem_Union, subtype.coe_mk, set.restrict, mem_inter_eq,
+    simp only [mem_preimage, mem_Union, subtype.coe_mk, set.restrict, mem_inter_iff,
       mem_compl_iff] at hx ⊢,
     split,
     { rintro ⟨i, hxt, hxs⟩, rwa hs _ _ hxs },
@@ -87,7 +90,7 @@ begin
     exact λ h, hx (mem_Inter.1 h i) }
 end
 
-@[simp] lemma _root_.ae_measurable_sum_measure_iff [encodable ι] {μ : ι → measure α} :
+@[simp] lemma _root_.ae_measurable_sum_measure_iff [countable ι] {μ : ι → measure α} :
   ae_measurable f (sum μ) ↔ ∀ i, ae_measurable f (μ i) :=
 ⟨λ h i, h.mono_measure (le_sum _ _), sum_measure⟩
 
@@ -101,11 +104,11 @@ lemma add_measure {f : α → β} (hμ : ae_measurable f μ) (hν : ae_measurabl
 ae_measurable_add_measure_iff.2 ⟨hμ, hν⟩
 
 @[measurability]
-protected lemma Union [encodable ι] {s : ι → set α} (h : ∀ i, ae_measurable f (μ.restrict (s i))) :
+protected lemma Union [countable ι] {s : ι → set α} (h : ∀ i, ae_measurable f (μ.restrict (s i))) :
   ae_measurable f (μ.restrict (⋃ i, s i)) :=
 (sum_measure h).mono_measure $ restrict_Union_le
 
-@[simp] lemma _root_.ae_measurable_Union_iff [encodable ι] {s : ι → set α} :
+@[simp] lemma _root_.ae_measurable_Union_iff [countable ι] {s : ι → set α} :
   ae_measurable f (μ.restrict (⋃ i, s i)) ↔ ∀ i, ae_measurable f (μ.restrict (s i)) :=
 ⟨λ h i, h.mono_measure $ restrict_mono (subset_Union _ _) le_rfl, ae_measurable.Union⟩
 
@@ -129,9 +132,9 @@ lemma comp_measurable {f : α → δ} {g : δ → β}
   (hg : ae_measurable g (μ.map f)) (hf : measurable f) : ae_measurable (g ∘ f) μ :=
 hg.comp_ae_measurable hf.ae_measurable
 
-lemma comp_measurable' {ν : measure δ} {f : α → δ} {g : δ → β} (hg : ae_measurable g ν)
-  (hf : measurable f) (h : μ.map f ≪ ν) : ae_measurable (g ∘ f) μ :=
-(hg.mono' h).comp_measurable hf
+lemma comp_quasi_measure_preserving {ν : measure δ} {f : α → δ} {g : δ → β} (hg : ae_measurable g ν)
+  (hf : quasi_measure_preserving f μ ν) : ae_measurable (g ∘ f) μ :=
+(hg.mono' hf.absolutely_continuous).comp_measurable hf.measurable
 
 lemma map_map_of_ae_measurable {g : β → γ} {f : α → β}
   (hg : ae_measurable g (measure.map f μ)) (hf : ae_measurable f μ) :
@@ -165,13 +168,13 @@ begin
   refine ⟨g, _, _, _⟩,
   { exact measurable.piecewise (measurable_set_to_measurable _ _)
       measurable_const H.measurable_mk },
-  { rintros - ⟨x, rfl⟩,
+  { rintros _ ⟨x, rfl⟩,
     by_cases hx : x ∈ s,
     { simpa [g, hx] using h₀.some_mem },
     { simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
       contrapose! hx,
       apply subset_to_measurable,
-      simp only [hx, mem_compl_eq, mem_set_of_eq, not_and, not_false_iff, implies_true_iff]
+      simp only [hx, mem_compl_iff, mem_set_of_eq, not_and, not_false_iff, implies_true_iff]
         {contextual := tt} } },
   { have A : μ (to_measurable μ {x | f x = H.mk f x ∧ f x ∈ t}ᶜ) = 0,
     { rw [measure_to_measurable, ← compl_mem_ae_iff, compl_compl],
@@ -181,7 +184,15 @@ begin
     simp only [g, hx, piecewise_eq_of_not_mem, not_false_iff],
     contrapose! hx,
     apply subset_to_measurable,
-    simp only [hx, mem_compl_eq, mem_set_of_eq, false_and, not_false_iff] }
+    simp only [hx, mem_compl_iff, mem_set_of_eq, false_and, not_false_iff] }
+end
+
+lemma exists_measurable_nonneg {β} [preorder β] [has_zero β] {mβ : measurable_space β} {f : α → β}
+  (hf : ae_measurable f μ) (f_nn : ∀ᵐ t ∂μ, 0 ≤ f t) :
+  ∃ g, measurable g ∧ 0 ≤ g ∧ f =ᵐ[μ] g :=
+begin
+  obtain ⟨G, hG_meas, hG_mem, hG_ae_eq⟩ := hf.exists_ae_eq_range_subset f_nn ⟨0, le_rfl⟩,
+  exact ⟨G, hG_meas, λ x, hG_mem (mem_range_self x), hG_ae_eq⟩,
 end
 
 lemma subtype_mk (h : ae_measurable f μ) {s : set β} {hfs : ∀ x, f x ∈ s} :
@@ -200,10 +211,19 @@ let ⟨g, hgm, hg⟩ := h in hgm.null_measurable.congr hg.symm
 
 end ae_measurable
 
-lemma ae_measurable_interval_oc_iff [linear_order α] {f : α → β} {a b : α} :
+lemma ae_measurable_const' (h : ∀ᵐ x y ∂μ, f x = f y) : ae_measurable f μ :=
+begin
+  rcases eq_or_ne μ 0 with rfl | hμ,
+  { exact ae_measurable_zero_measure },
+  { haveI := ae_ne_bot.2 hμ,
+    rcases h.exists with ⟨x, hx⟩,
+    exact ⟨const α (f x), measurable_const, eventually_eq.symm hx⟩ }
+end
+
+lemma ae_measurable_uIoc_iff [linear_order α] {f : α → β} {a b : α} :
   (ae_measurable f $ μ.restrict $ Ι a b) ↔
     (ae_measurable f $ μ.restrict $ Ioc a b) ∧ (ae_measurable f $ μ.restrict $ Ioc b a) :=
-by rw [interval_oc_eq_union, ae_measurable_union_iff]
+by rw [uIoc_eq_union, ae_measurable_union_iff]
 
 lemma ae_measurable_iff_measurable [μ.is_complete] :
   ae_measurable f μ ↔ measurable f :=
@@ -260,6 +280,24 @@ lemma ae_measurable.restrict (hfm : ae_measurable f μ) {s} :
   ae_measurable f (μ.restrict s) :=
 ⟨ae_measurable.mk f hfm, hfm.measurable_mk, ae_restrict_of_ae hfm.ae_eq_mk⟩
 
+lemma ae_measurable_Ioi_of_forall_Ioc {β} {mβ : measurable_space β}
+  [linear_order α] [(at_top : filter α).is_countably_generated] {x : α} {g : α → β}
+  (g_meas : ∀ t > x, ae_measurable g (μ.restrict (Ioc x t))) :
+  ae_measurable g (μ.restrict (Ioi x)) :=
+begin
+  haveI : nonempty α := ⟨x⟩,
+  obtain ⟨u, hu_tendsto⟩ := exists_seq_tendsto (at_top : filter α),
+  have Ioi_eq_Union : Ioi x = ⋃ n : ℕ, Ioc x (u n),
+  { rw Union_Ioc_eq_Ioi_self_iff.mpr _,
+    exact λ y _, (hu_tendsto.eventually (eventually_ge_at_top y)).exists },
+  rw [Ioi_eq_Union, ae_measurable_Union_iff],
+  intros n,
+  cases lt_or_le x (u n),
+  { exact g_meas (u n) h, },
+  { rw [Ioc_eq_empty (not_lt.mpr h), measure.restrict_empty],
+    exact ae_measurable_zero_measure, },
+end
+
 variables [has_zero β]
 
 lemma ae_measurable_indicator_iff {s} (hs : measurable_set s) :
diff --git a/src/measure_theory/measure/complex.lean b/src/measure_theory/measure/complex.lean
index e401513ec3f08..3137af7de2b54 100644
--- a/src/measure_theory/measure/complex.lean
+++ b/src/measure_theory/measure/complex.lean
@@ -9,6 +9,9 @@ import measure_theory.measure.vector_measure
 /-!
 # Complex measure
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves some elementary results about complex measures. In particular, we prove that
 a complex measure is always in the form `s + it` where `s` and `t` are signed measures.
 
diff --git a/src/measure_theory/measure/complex_lebesgue.lean b/src/measure_theory/measure/complex_lebesgue.lean
deleted file mode 100644
index 5022bc9ea59bc..0000000000000
--- a/src/measure_theory/measure/complex_lebesgue.lean
+++ /dev/null
@@ -1,42 +0,0 @@
-/-
-Copyright (c) 2021 Yury Kudryashov. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yury Kudryashov
--/
-import measure_theory.measure.lebesgue
-
-/-!
-# Lebesgue measure on `ℂ`
-
-In this file we define Lebesgue measure on `ℂ`. Since `ℂ` is defined as a `structure` as the
-push-forward of the volume on `ℝ²` under the natural isomorphism. There are (at least) two
-frequently used ways to represent `ℝ²` in `mathlib`: `ℝ × ℝ` and `fin 2 → ℝ`. We define measurable
-equivalences (`measurable_equiv`) to both types and prove that both of them are volume preserving
-(in the sense of `measure_theory.measure_preserving`).
--/
-
-open measure_theory
-noncomputable theory
-
-namespace complex
-
-/-- Lebesgue measure on `ℂ`. -/
-instance measure_space : measure_space ℂ :=
-⟨measure.map basis_one_I.equiv_fun.symm volume⟩
-
-/-- Measurable equivalence between `ℂ` and `ℝ² = fin 2 → ℝ`. -/
-def measurable_equiv_pi : ℂ ≃ᵐ (fin 2 → ℝ) :=
-basis_one_I.equiv_fun.to_continuous_linear_equiv.to_homeomorph.to_measurable_equiv
-
-/-- Measurable equivalence between `ℂ` and `ℝ × ℝ`. -/
-def measurable_equiv_real_prod : ℂ ≃ᵐ (ℝ × ℝ) :=
-equiv_real_prodₗ.to_homeomorph.to_measurable_equiv
-
-lemma volume_preserving_equiv_pi :
-  measure_preserving measurable_equiv_pi :=
-(measurable_equiv_pi.symm.measurable.measure_preserving _).symm _
-
-lemma volume_preserving_equiv_real_prod : measure_preserving measurable_equiv_real_prod :=
-(volume_preserving_fin_two_arrow ℝ).comp volume_preserving_equiv_pi
-
-end complex
diff --git a/src/measure_theory/measure/content.lean b/src/measure_theory/measure/content.lean
index 6f90df0124975..b7c6e0d7cff91 100644
--- a/src/measure_theory/measure/content.lean
+++ b/src/measure_theory/measure/content.lean
@@ -10,6 +10,9 @@ import topology.sets.compacts
 /-!
 # Contents
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we work with *contents*. A content `λ` is a function from a certain class of subsets
 (such as the compact subsets) to `ℝ≥0` that is
 * additive: If `K₁` and `K₂` are disjoint sets in the domain of `λ`,
@@ -51,7 +54,7 @@ universes u v w
 noncomputable theory
 
 open set topological_space
-open_locale nnreal ennreal
+open_locale nnreal ennreal measure_theory
 
 namespace measure_theory
 
@@ -120,8 +123,8 @@ lemma inner_content_of_is_compact {K : set G} (h1K : is_compact K) (h2K : is_ope
 le_antisymm (supr₂_le $ λ K' hK', μ.mono _ ⟨K, h1K⟩ hK')
             (μ.le_inner_content _ _ subset.rfl)
 
-lemma inner_content_empty :
-  μ.inner_content ∅ = 0 :=
+lemma inner_content_bot :
+  μ.inner_content ⊥ = 0 :=
 begin
   refine le_antisymm _ (zero_le _), rw ←μ.empty,
   refine supr₂_le (λ K hK, _),
@@ -157,9 +160,9 @@ begin
     { intros n s hn ih, rw [finset.sup_insert, finset.sum_insert hn],
       exact le_trans (μ.sup_le _ _) (add_le_add_left ih _) }},
   refine supr₂_le (λ K hK, _),
-  obtain ⟨t, ht⟩ := K.compact.elim_finite_subcover  _ (λ i, (U i).prop) _, swap,
-  { convert hK, rw [opens.supr_def, subtype.coe_mk] },
-  rcases K.compact.finite_compact_cover t (coe ∘ U) (λ i _, (U _).prop) (by simp only [ht])
+  obtain ⟨t, ht⟩ := K.is_compact.elim_finite_subcover  _ (λ i, (U i).is_open) _, swap,
+  { rwa [← opens.coe_supr] },
+  rcases K.is_compact.finite_compact_cover t (coe ∘ U) (λ i _, (U _).is_open) (by simp only [ht])
     with ⟨K', h1K', h2K', h3K'⟩,
   let L : ℕ → compacts G := λ n, ⟨K' n, h1K' n⟩,
   convert le_trans (h3 t L) _,
@@ -198,14 +201,14 @@ lemma inner_content_pos_of_is_mul_left_invariant [t2_space G] [group G] [topolog
   (K : compacts G) (hK : μ K ≠ 0) (U : opens G) (hU : (U : set G).nonempty) :
   0 < μ.inner_content U :=
 begin
-  have : (interior (U : set G)).nonempty, rwa [U.prop.interior_eq],
+  have : (interior (U : set G)).nonempty, rwa [U.is_open.interior_eq],
   rcases compact_covered_by_mul_left_translates K.2 this with ⟨s, hs⟩,
   suffices : μ K ≤ s.card * μ.inner_content U,
   { exact (ennreal.mul_pos_iff.mp $ hK.bot_lt.trans_le this).2 },
   have : (K : set G) ⊆ ↑⨆ (g ∈ s), opens.comap (homeomorph.mul_left g).to_continuous_map U,
   { simpa only [opens.supr_def, opens.coe_comap, subtype.coe_mk] },
   refine (μ.le_inner_content _ _ this).trans _,
-  refine (rel_supr_sum (μ.inner_content) (μ.inner_content_empty) (≤)
+  refine (rel_supr_sum (μ.inner_content) (μ.inner_content_bot) (≤)
     (μ.inner_content_Sup_nat) _ _).trans _,
   simp only [μ.is_mul_left_invariant_inner_content h3, finset.sum_const, nsmul_eq_mul, le_refl]
 end
@@ -214,9 +217,11 @@ lemma inner_content_mono' ⦃U V : set G⦄ (hU : is_open U) (hV : is_open V) (h
   μ.inner_content ⟨U, hU⟩ ≤ μ.inner_content ⟨V, hV⟩ :=
 bsupr_mono $ λ K hK, hK.trans h2
 
+section outer_measure
+
 /-- Extending a content on compact sets to an outer measure on all sets. -/
 protected def outer_measure : outer_measure G :=
-induced_outer_measure (λ U hU, μ.inner_content ⟨U, hU⟩) is_open_empty μ.inner_content_empty
+induced_outer_measure (λ U hU, μ.inner_content ⟨U, hU⟩) is_open_empty μ.inner_content_bot
 
 variables [t2_space G]
 
@@ -288,10 +293,10 @@ lemma is_mul_left_invariant_outer_measure [group G] [topological_group G]
 by convert μ.outer_measure_preimage (homeomorph.mul_left g) (λ K, h g) A
 
 lemma outer_measure_caratheodory (A : set G) :
-  μ.outer_measure.caratheodory.measurable_set' A ↔ ∀ (U : opens G),
+  measurable_set[μ.outer_measure.caratheodory] A ↔ ∀ (U : opens G),
   μ.outer_measure (U ∩ A) + μ.outer_measure (U \ A) ≤ μ.outer_measure U :=
 begin
-  dsimp [opens], rw subtype.forall,
+  rw [opens.forall],
   apply induced_outer_measure_caratheodory,
   apply inner_content_Union_nat,
   apply inner_content_mono'
@@ -316,7 +321,7 @@ begin
   intros U hU,
   rw μ.outer_measure_caratheodory,
   intro U',
-  rw μ.outer_measure_of_is_open ((U' : set G) ∩ U) (is_open.inter U'.prop hU),
+  rw μ.outer_measure_of_is_open ((U' : set G) ∩ U) (U'.is_open.inter hU),
   simp only [inner_content, supr_subtype'], rw [opens.coe_mk],
   haveI : nonempty {L : compacts G // (L : set G) ⊆ U' ∩ U} := ⟨⟨⊥, empty_subset _⟩⟩,
   rw [ennreal.supr_add],
@@ -362,6 +367,56 @@ begin
   exact (μ.le_outer_measure_compacts K).trans (le_to_measure_apply _ _ _)
 end
 
+end outer_measure
+
+section regular_contents
+
+/-- A content `μ` is called regular if for every compact set `K`,
+  `μ(K) = inf {μ(K') : K ⊂ int K' ⊂ K'`. See Paul Halmos (1950), Measure Theory, §54-/
+def content_regular := ∀ ⦃K : topological_space.compacts G⦄,
+  μ K = ⨅ (K' : topological_space.compacts G) (hK: (K : set G) ⊆ interior (K' : set G) ), μ K'
+
+lemma content_regular_exists_compact (H : content_regular μ) (K : topological_space.compacts G)
+  {ε : nnreal} (hε : ε ≠ 0) :
+  ∃ (K' : topological_space.compacts G), (K.carrier ⊆ interior K'.carrier) ∧ μ K' ≤ μ K + ε :=
+begin
+  by_contra hc,
+  simp only [not_exists, not_and, not_le] at hc,
+  have lower_bound_infi : μ K + ε ≤ ⨅ (K' : topological_space.compacts G)
+    (h: (K : set G) ⊆ interior (K' : set G) ), μ K' :=
+    le_infi (λ K', le_infi ( λ K'_hyp, le_of_lt (hc K' K'_hyp))),
+  rw ← H at lower_bound_infi,
+  exact (lt_self_iff_false (μ K)).mp (lt_of_le_of_lt' lower_bound_infi
+    (ennreal.lt_add_right (ne_top_of_lt (μ.lt_top K)) (ennreal.coe_ne_zero.mpr hε))),
+end
+
+variables [measurable_space G] [t2_space G] [borel_space G]
+
+/--If `μ` is a regular content, then the measure induced by `μ` will agree with `μ`
+  on compact sets.-/
+lemma measure_eq_content_of_regular
+ (H : measure_theory.content.content_regular μ) (K : topological_space.compacts G) :
+  μ.measure ↑K = μ K :=
+begin
+  refine le_antisymm _ _,
+  { apply ennreal.le_of_forall_pos_le_add,
+    intros ε εpos content_K_finite,
+    obtain ⟨ K', K'_hyp ⟩ := content_regular_exists_compact μ H K (ne_bot_of_gt εpos),
+    calc μ.measure ↑K ≤ μ.measure (interior ↑K') : _
+                  ... ≤ μ K' : _
+                  ... ≤ μ K + ε : K'_hyp.right,
+
+    { rw [μ.measure_apply ((is_open_interior).measurable_set),
+        μ.measure_apply K.is_compact.measurable_set],
+      exact μ.outer_measure.mono K'_hyp.left },
+    { rw μ.measure_apply (is_open.measurable_set is_open_interior),
+      exact μ.outer_measure_interior_compacts K' } },
+  { rw (μ.measure_apply (is_compact.measurable_set K.is_compact)),
+    exact μ.le_outer_measure_compacts K },
+end
+
+end regular_contents
+
 end content
 
 end measure_theory
diff --git a/src/measure_theory/measure/doubling.lean b/src/measure_theory/measure/doubling.lean
new file mode 100644
index 0000000000000..c306deac59ea1
--- /dev/null
+++ b/src/measure_theory/measure/doubling.lean
@@ -0,0 +1,148 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import analysis.special_functions.log.base
+import measure_theory.measure.measure_space_def
+
+/-!
+# Uniformly locally doubling measures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A uniformly locally doubling measure `μ` on a metric space is a measure for which there exists a
+constant `C` such that for all sufficiently small radii `ε`, and for any centre, the measure of a
+ball of radius `2 * ε` is bounded by `C` times the measure of the concentric ball of radius `ε`.
+
+This file records basic facts about uniformly locally doubling measures.
+
+## Main definitions
+
+  * `is_unif_loc_doubling_measure`: the definition of a uniformly locally doubling measure (as a
+  typeclass).
+  * `is_unif_loc_doubling_measure.doubling_constant`: a function yielding the doubling constant `C`
+  appearing in the definition of a uniformly locally doubling measure.
+-/
+
+noncomputable theory
+
+open set filter metric measure_theory topological_space
+open_locale ennreal nnreal topology
+
+/-- A measure `μ` is said to be a uniformly locally doubling measure if there exists a constant `C`
+such that for all sufficiently small radii `ε`, and for any centre, the measure of a ball of radius
+`2 * ε` is bounded by `C` times the measure of the concentric ball of radius `ε`.
+
+Note: it is important that this definition makes a demand only for sufficiently small `ε`. For
+example we want hyperbolic space to carry the instance `is_unif_loc_doubling_measure volume` but
+volumes grow exponentially in hyperbolic space. To be really explicit, consider the hyperbolic plane
+of curvature -1, the area of a disc of radius `ε` is `A(ε) = 2π(cosh(ε) - 1)` so
+`A(2ε)/A(ε) ~ exp(ε)`. -/
+class is_unif_loc_doubling_measure
+  {α : Type*} [metric_space α] [measurable_space α] (μ : measure α) :=
+(exists_measure_closed_ball_le_mul [] :
+  ∃ (C : ℝ≥0), ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closed_ball x (2 * ε)) ≤ C * μ (closed_ball x ε))
+
+namespace is_unif_loc_doubling_measure
+
+variables {α : Type*} [metric_space α] [measurable_space α]
+          (μ : measure α) [is_unif_loc_doubling_measure μ]
+
+/-- A doubling constant for a uniformly locally doubling measure.
+
+See also `is_unif_loc_doubling_measure.scaling_constant_of`. -/
+def doubling_constant : ℝ≥0 := classical.some $ exists_measure_closed_ball_le_mul μ
+
+lemma exists_measure_closed_ball_le_mul' :
+  ∀ᶠ ε in 𝓝[>] 0, ∀ x, μ (closed_ball x (2 * ε)) ≤ doubling_constant μ * μ (closed_ball x ε) :=
+classical.some_spec $ exists_measure_closed_ball_le_mul μ
+
+lemma exists_eventually_forall_measure_closed_ball_le_mul (K : ℝ) :
+  ∃ (C : ℝ≥0), ∀ᶠ ε in 𝓝[>] 0, ∀ x t (ht : t ≤ K),
+    μ (closed_ball x (t * ε)) ≤ C * μ (closed_ball x ε) :=
+begin
+  let C := doubling_constant μ,
+  have hμ : ∀ (n : ℕ), ∀ᶠ ε in 𝓝[>] 0, ∀ x,
+    μ (closed_ball x (2^n * ε)) ≤ ↑(C^n) * μ (closed_ball x ε),
+  { intros n,
+    induction n with n ih, { simp, },
+    replace ih := eventually_nhds_within_pos_mul_left (two_pos : 0 < (2 : ℝ)) ih,
+    refine (ih.and (exists_measure_closed_ball_le_mul' μ)).mono (λ ε hε x, _),
+    calc μ (closed_ball x (2^(n + 1) * ε))
+          = μ (closed_ball x (2^n * (2 * ε))) : by rw [pow_succ', mul_assoc]
+      ... ≤ ↑(C^n) * μ (closed_ball x (2 * ε)) : hε.1 x
+      ... ≤ ↑(C^n) * (C * μ (closed_ball x ε)) : ennreal.mul_left_mono (hε.2 x)
+      ... = ↑(C^(n + 1)) * μ (closed_ball x ε) : by rw [← mul_assoc, pow_succ', ennreal.coe_mul], },
+  rcases lt_or_le K 1 with hK | hK,
+  { refine ⟨1, _⟩,
+    simp only [ennreal.coe_one, one_mul],
+    exact eventually_mem_nhds_within.mono (λ ε hε x t ht,
+      measure_mono $ closed_ball_subset_closed_ball (by nlinarith [mem_Ioi.mp hε])), },
+  { refine ⟨C^⌈real.logb 2 K⌉₊, ((hμ ⌈real.logb 2 K⌉₊).and eventually_mem_nhds_within).mono
+      (λ ε hε x t ht, le_trans (measure_mono $ closed_ball_subset_closed_ball _) (hε.1 x))⟩,
+    refine mul_le_mul_of_nonneg_right (ht.trans _) (mem_Ioi.mp hε.2).le,
+    conv_lhs { rw ← real.rpow_logb two_pos (by norm_num) (by linarith : 0 < K), },
+    rw ← real.rpow_nat_cast,
+    exact real.rpow_le_rpow_of_exponent_le one_le_two (nat.le_ceil (real.logb 2 K)), },
+end
+
+/-- A variant of `is_unif_loc_doubling_measure.doubling_constant` which allows for scaling the
+radius by values other than `2`. -/
+def scaling_constant_of (K : ℝ) : ℝ≥0 :=
+max (classical.some $ exists_eventually_forall_measure_closed_ball_le_mul μ K) 1
+
+@[simp] lemma one_le_scaling_constant_of (K : ℝ) : 1 ≤ scaling_constant_of μ K :=
+le_max_of_le_right $ le_refl 1
+
+lemma eventually_measure_mul_le_scaling_constant_of_mul (K : ℝ) :
+  ∃ (R : ℝ), 0 < R ∧ ∀ x t r (ht : t ∈ Ioc 0 K) (hr : r ≤ R),
+    μ (closed_ball x (t * r)) ≤ scaling_constant_of μ K * μ (closed_ball x r) :=
+begin
+  have h := classical.some_spec (exists_eventually_forall_measure_closed_ball_le_mul μ K),
+  rcases mem_nhds_within_Ioi_iff_exists_Ioc_subset.1 h with ⟨R, Rpos, hR⟩,
+  refine ⟨R, Rpos, λ x t r ht hr, _⟩,
+  rcases lt_trichotomy r 0 with rneg|rfl|rpos,
+  { have : t * r < 0, from mul_neg_of_pos_of_neg ht.1 rneg,
+    simp only [closed_ball_eq_empty.2 this, measure_empty, zero_le'] },
+  { simp only [mul_zero, closed_ball_zero],
+    refine le_mul_of_one_le_of_le _ le_rfl,
+    apply ennreal.one_le_coe_iff.2 (le_max_right _ _) },
+  { apply (hR ⟨rpos, hr⟩ x t ht.2).trans _,
+    exact mul_le_mul_right' (ennreal.coe_le_coe.2 (le_max_left _ _)) _ }
+end
+
+lemma eventually_measure_le_scaling_constant_mul (K : ℝ) :
+  ∀ᶠ r in 𝓝[>] 0, ∀ x,
+    μ (closed_ball x (K * r)) ≤ scaling_constant_of μ K * μ (closed_ball x r) :=
+begin
+  filter_upwards [classical.some_spec (exists_eventually_forall_measure_closed_ball_le_mul μ K)]
+    with r hr x,
+  exact (hr x K le_rfl).trans (mul_le_mul_right' (ennreal.coe_le_coe.2 (le_max_left _ _)) _)
+end
+
+lemma eventually_measure_le_scaling_constant_mul' (K : ℝ) (hK : 0 < K) :
+  ∀ᶠ r in 𝓝[>] 0, ∀ x,
+    μ (closed_ball x r) ≤ scaling_constant_of μ K⁻¹ * μ (closed_ball x (K * r)) :=
+begin
+  convert eventually_nhds_within_pos_mul_left hK (eventually_measure_le_scaling_constant_mul μ K⁻¹),
+  ext,
+  simp [inv_mul_cancel_left₀ hK.ne'],
+end
+
+/-- A scale below which the doubling measure `μ` satisfies good rescaling properties when one
+multiplies the radius of balls by at most `K`, as stated
+in `measure_mul_le_scaling_constant_of_mul`. -/
+def scaling_scale_of (K : ℝ) : ℝ :=
+(eventually_measure_mul_le_scaling_constant_of_mul μ K).some
+
+lemma scaling_scale_of_pos (K : ℝ) : 0 < scaling_scale_of μ K :=
+(eventually_measure_mul_le_scaling_constant_of_mul μ K).some_spec.1
+
+lemma measure_mul_le_scaling_constant_of_mul {K : ℝ} {x : α} {t r : ℝ}
+  (ht : t ∈ Ioc 0 K) (hr : r ≤ scaling_scale_of μ K) :
+  μ (closed_ball x (t * r)) ≤ scaling_constant_of μ K * μ (closed_ball x r) :=
+(eventually_measure_mul_le_scaling_constant_of_mul μ K).some_spec.2 x t r ht hr
+
+end is_unif_loc_doubling_measure
diff --git a/src/measure_theory/measure/finite_measure.lean b/src/measure_theory/measure/finite_measure.lean
new file mode 100644
index 0000000000000..3efd56a6070fe
--- /dev/null
+++ b/src/measure_theory/measure/finite_measure.lean
@@ -0,0 +1,691 @@
+/-
+Copyright (c) 2021 Kalle Kytölä. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kalle Kytölä
+-/
+import topology.continuous_function.bounded
+import topology.algebra.module.weak_dual
+import measure_theory.integral.bochner
+
+/-!
+# Finite measures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the type of finite measures on a given measurable space. When the underlying
+space has a topology and the measurable space structure (sigma algebra) is finer than the Borel
+sigma algebra, then the type of finite measures is equipped with the topology of weak convergence
+of measures. The topology of weak convergence is the coarsest topology w.r.t. which
+for every bounded continuous `ℝ≥0`-valued function `f`, the integration of `f` against the
+measure is continuous.
+
+## Main definitions
+
+The main definitions are
+ * the type `measure_theory.finite_measure Ω` with the topology of weak convergence;
+ * `measure_theory.finite_measure.to_weak_dual_bcnn : finite_measure Ω → (weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0))`
+   allowing to interpret a finite measure as a continuous linear functional on the space of
+   bounded continuous nonnegative functions on `Ω`. This is used for the definition of the
+   topology of weak convergence.
+
+## Main results
+
+ * Finite measures `μ` on `Ω` give rise to continuous linear functionals on the space of
+   bounded continuous nonnegative functions on `Ω` via integration:
+   `measure_theory.finite_measure.to_weak_dual_bcnn : finite_measure Ω → (weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0))`
+ * `measure_theory.finite_measure.tendsto_iff_forall_integral_tendsto`: Convergence of finite
+   measures is characterized by the convergence of integrals of all bounded continuous functions.
+   This shows that the chosen definition of topology coincides with the common textbook definition
+   of weak convergence of measures. A similar characterization by the convergence of integrals (in
+   the `measure_theory.lintegral` sense) of all bounded continuous nonnegative functions is
+   `measure_theory.finite_measure.tendsto_iff_forall_lintegral_tendsto`.
+
+## Implementation notes
+
+The topology of weak convergence of finite Borel measures is defined using a mapping from
+`measure_theory.finite_measure Ω` to `weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0)`, inheriting the topology from the
+latter.
+
+The implementation of `measure_theory.finite_measure Ω` and is directly as a subtype of
+`measure_theory.measure Ω`, and the coercion to a function is the composition `ennreal.to_nnreal`
+and the coercion to function of `measure_theory.measure Ω`. Another alternative would have been to
+use a bijection with `measure_theory.vector_measure Ω ℝ≥0` as an intermediate step. Some
+considerations:
+ * Potential advantages of using the `nnreal`-valued vector measure alternative:
+   * The coercion to function would avoid need to compose with `ennreal.to_nnreal`, the
+     `nnreal`-valued API could be more directly available.
+ * Potential drawbacks of the vector measure alternative:
+   * The coercion to function would lose monotonicity, as non-measurable sets would be defined to
+     have measure 0.
+   * No integration theory directly. E.g., the topology definition requires
+     `measure_theory.lintegral` w.r.t. a coercion to `measure_theory.measure Ω` in any case.
+
+## References
+
+* [Billingsley, *Convergence of probability measures*][billingsley1999]
+
+## Tags
+
+weak convergence of measures, finite measure
+
+-/
+
+noncomputable theory
+open measure_theory
+open set
+open filter
+open bounded_continuous_function
+open_locale topology ennreal nnreal bounded_continuous_function
+
+namespace measure_theory
+
+namespace finite_measure
+
+section finite_measure
+/-! ### Finite measures
+
+In this section we define the `Type` of `finite_measure Ω`, when `Ω` is a measurable space. Finite
+measures on `Ω` are a module over `ℝ≥0`.
+
+If `Ω` is moreover a topological space and the sigma algebra on `Ω` is finer than the Borel sigma
+algebra (i.e. `[opens_measurable_space Ω]`), then `finite_measure Ω` is equipped with the topology
+of weak convergence of measures. This is implemented by defining a pairing of finite measures `μ`
+on `Ω` with continuous bounded nonnegative functions `f : Ω →ᵇ ℝ≥0` via integration, and using the
+associated weak topology (essentially the weak-star topology on the dual of `Ω →ᵇ ℝ≥0`).
+-/
+
+variables {Ω : Type*} [measurable_space Ω]
+
+/-- Finite measures are defined as the subtype of measures that have the property of being finite
+measures (i.e., their total mass is finite). -/
+def _root_.measure_theory.finite_measure (Ω : Type*) [measurable_space Ω] : Type* :=
+{μ : measure Ω // is_finite_measure μ}
+
+/-- A finite measure can be interpreted as a measure. -/
+instance : has_coe (finite_measure Ω) (measure_theory.measure Ω) := coe_subtype
+
+instance is_finite_measure (μ : finite_measure Ω) :
+  is_finite_measure (μ : measure Ω) := μ.prop
+
+instance : has_coe_to_fun (finite_measure Ω) (λ _, set Ω → ℝ≥0) :=
+⟨λ μ s, (μ s).to_nnreal⟩
+
+lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : finite_measure Ω) :
+  (ν : set Ω → ℝ≥0) = λ s, ((ν : measure Ω) s).to_nnreal := rfl
+
+@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : finite_measure Ω) (s : set Ω) :
+  (ν s : ℝ≥0∞) = (ν : measure Ω) s := ennreal.coe_to_nnreal (measure_lt_top ↑ν s).ne
+
+@[simp] lemma val_eq_to_measure (ν : finite_measure Ω) : ν.val = (ν : measure Ω) := rfl
+
+lemma coe_injective : function.injective (coe : finite_measure Ω → measure Ω) :=
+subtype.coe_injective
+
+lemma apply_mono (μ : finite_measure Ω) {s₁ s₂ : set Ω} (h : s₁ ⊆ s₂) :
+  μ s₁ ≤ μ s₂ :=
+begin
+  change ((μ : measure Ω) s₁).to_nnreal ≤ ((μ : measure Ω) s₂).to_nnreal,
+  have key : (μ : measure Ω) s₁ ≤ (μ : measure Ω) s₂ := (μ : measure Ω).mono h,
+  apply (ennreal.to_nnreal_le_to_nnreal (measure_ne_top _ s₁) (measure_ne_top _ s₂)).mpr key,
+end
+
+/-- The (total) mass of a finite measure `μ` is `μ univ`, i.e., the cast to `nnreal` of
+`(μ : measure Ω) univ`. -/
+def mass (μ : finite_measure Ω) : ℝ≥0 := μ univ
+
+@[simp] lemma ennreal_mass {μ : finite_measure Ω} :
+  (μ.mass : ℝ≥0∞) = (μ : measure Ω) univ := ennreal_coe_fn_eq_coe_fn_to_measure μ set.univ
+
+instance has_zero : has_zero (finite_measure Ω) :=
+{ zero := ⟨0, measure_theory.is_finite_measure_zero⟩ }
+
+@[simp] lemma zero.mass : (0 : finite_measure Ω).mass = 0 := rfl
+
+@[simp] lemma mass_zero_iff (μ : finite_measure Ω) : μ.mass = 0 ↔ μ = 0 :=
+begin
+  refine ⟨λ μ_mass, _, (λ hμ, by simp only [hμ, zero.mass])⟩,
+  ext1,
+  apply measure.measure_univ_eq_zero.mp,
+  rwa [← ennreal_mass, ennreal.coe_eq_zero],
+end
+
+lemma mass_nonzero_iff (μ : finite_measure Ω) : μ.mass ≠ 0 ↔ μ ≠ 0 :=
+begin
+  rw not_iff_not,
+  exact finite_measure.mass_zero_iff μ,
+end
+
+@[ext] lemma eq_of_forall_measure_apply_eq (μ ν : finite_measure Ω)
+  (h : ∀ (s : set Ω), measurable_set s → (μ : measure Ω) s = (ν : measure Ω) s) :
+  μ = ν :=
+by { ext1, ext1 s s_mble, exact h s s_mble, }
+
+lemma eq_of_forall_apply_eq (μ ν : finite_measure Ω)
+  (h : ∀ (s : set Ω), measurable_set s → μ s = ν s) :
+  μ = ν :=
+begin
+  ext1 s s_mble,
+  simpa [ennreal_coe_fn_eq_coe_fn_to_measure] using congr_arg (coe : ℝ≥0 → ℝ≥0∞) (h s s_mble),
+end
+
+instance : inhabited (finite_measure Ω) := ⟨0⟩
+
+instance : has_add (finite_measure Ω) :=
+{ add := λ μ ν, ⟨μ + ν, measure_theory.is_finite_measure_add⟩ }
+
+variables {R : Type*} [has_smul R ℝ≥0] [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0 ℝ≥0∞]
+  [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+
+instance : has_smul R (finite_measure Ω) :=
+{ smul := λ (c : R) μ, ⟨c • μ, measure_theory.is_finite_measure_smul_of_nnreal_tower⟩, }
+
+@[simp, norm_cast] lemma coe_zero : (coe : finite_measure Ω → measure Ω) 0 = 0 := rfl
+
+@[simp, norm_cast] lemma coe_add (μ ν : finite_measure Ω) : ↑(μ + ν) = (↑μ + ↑ν : measure Ω) := rfl
+
+@[simp, norm_cast] lemma coe_smul (c : R) (μ : finite_measure Ω) :
+  ↑(c • μ) = (c • ↑μ : measure Ω) := rfl
+
+@[simp, norm_cast] lemma coe_fn_zero :
+  (⇑(0 : finite_measure Ω) : set Ω → ℝ≥0) = (0 : set Ω → ℝ≥0) := by { funext, refl, }
+
+@[simp, norm_cast] lemma coe_fn_add (μ ν : finite_measure Ω) :
+  (⇑(μ + ν) : set Ω → ℝ≥0) = (⇑μ + ⇑ν : set Ω → ℝ≥0) :=
+by { funext, simp [← ennreal.coe_eq_coe], }
+
+@[simp, norm_cast] lemma coe_fn_smul [is_scalar_tower R ℝ≥0 ℝ≥0] (c : R) (μ : finite_measure Ω) :
+  (⇑(c • μ) : set Ω → ℝ≥0) = c • (⇑μ : set Ω → ℝ≥0) :=
+by { funext, simp [← ennreal.coe_eq_coe, ennreal.coe_smul], }
+
+instance : add_comm_monoid (finite_measure Ω) :=
+coe_injective.add_comm_monoid coe coe_zero coe_add (λ _ _, coe_smul _ _)
+
+/-- Coercion is an `add_monoid_hom`. -/
+@[simps]
+def coe_add_monoid_hom : finite_measure Ω →+ measure Ω :=
+{ to_fun := coe, map_zero' := coe_zero, map_add' := coe_add }
+
+instance {Ω : Type*} [measurable_space Ω] : module ℝ≥0 (finite_measure Ω) :=
+function.injective.module _ coe_add_monoid_hom coe_injective coe_smul
+
+@[simp] lemma coe_fn_smul_apply [is_scalar_tower R ℝ≥0 ℝ≥0]
+  (c : R) (μ : finite_measure Ω) (s : set Ω) :
+  (c • μ) s  = c • (μ s) :=
+by { simp only [coe_fn_smul, pi.smul_apply], }
+
+/-- Restrict a finite measure μ to a set A. -/
+def restrict (μ : finite_measure Ω) (A : set Ω) : finite_measure Ω :=
+{ val := (μ : measure Ω).restrict A,
+  property := measure_theory.is_finite_measure_restrict μ A, }
+
+lemma restrict_measure_eq (μ : finite_measure Ω) (A : set Ω) :
+  (μ.restrict A : measure Ω) = (μ : measure Ω).restrict A := rfl
+
+lemma restrict_apply_measure (μ : finite_measure Ω) (A : set Ω)
+  {s : set Ω} (s_mble : measurable_set s) :
+  (μ.restrict A : measure Ω) s = (μ : measure Ω) (s ∩ A) :=
+measure.restrict_apply s_mble
+
+lemma restrict_apply (μ : finite_measure Ω) (A : set Ω)
+  {s : set Ω} (s_mble : measurable_set s) :
+  (μ.restrict A) s = μ (s ∩ A) :=
+begin
+  apply congr_arg ennreal.to_nnreal,
+  exact measure.restrict_apply s_mble,
+end
+
+lemma restrict_mass (μ : finite_measure Ω) (A : set Ω) :
+  (μ.restrict A).mass = μ A :=
+by simp only [mass, restrict_apply μ A measurable_set.univ, univ_inter]
+
+lemma restrict_eq_zero_iff (μ : finite_measure Ω) (A : set Ω) :
+  μ.restrict A = 0 ↔ μ A = 0 :=
+by rw [← mass_zero_iff, restrict_mass]
+
+lemma restrict_nonzero_iff (μ : finite_measure Ω) (A : set Ω) :
+  μ.restrict A ≠ 0 ↔ μ A ≠ 0 :=
+by rw [← mass_nonzero_iff, restrict_mass]
+
+variables [topological_space Ω]
+
+/-- The pairing of a finite (Borel) measure `μ` with a nonnegative bounded continuous
+function is obtained by (Lebesgue) integrating the (test) function against the measure.
+This is `finite_measure.test_against_nn`. -/
+def test_against_nn (μ : finite_measure Ω) (f : Ω →ᵇ ℝ≥0) : ℝ≥0 :=
+(∫⁻ ω, f ω ∂(μ : measure Ω)).to_nnreal
+
+lemma _root_.bounded_continuous_function.nnreal.to_ennreal_comp_measurable {Ω : Type*}
+  [topological_space Ω] [measurable_space Ω] [opens_measurable_space Ω] (f : Ω →ᵇ ℝ≥0) :
+  measurable (λ ω, (f ω : ℝ≥0∞)) :=
+measurable_coe_nnreal_ennreal.comp f.continuous.measurable
+
+lemma _root_.measure_theory.lintegral_lt_top_of_bounded_continuous_to_nnreal
+  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ≥0) :
+  ∫⁻ ω, f ω ∂μ < ∞ :=
+begin
+  apply is_finite_measure.lintegral_lt_top_of_bounded_to_ennreal,
+  use nndist f 0,
+  intros x,
+  have key := bounded_continuous_function.nnreal.upper_bound f x,
+  rw ennreal.coe_le_coe,
+  have eq : nndist f 0 = ⟨dist f 0, dist_nonneg⟩,
+  { ext,
+    simp only [real.coe_to_nnreal', max_eq_left_iff, subtype.coe_mk, coe_nndist], },
+  rwa eq at key,
+end
+
+@[simp] lemma test_against_nn_coe_eq {μ : finite_measure Ω} {f : Ω →ᵇ ℝ≥0} :
+  (μ.test_against_nn f : ℝ≥0∞) = ∫⁻ ω, f ω ∂(μ : measure Ω) :=
+ennreal.coe_to_nnreal (lintegral_lt_top_of_bounded_continuous_to_nnreal _ f).ne
+
+lemma test_against_nn_const (μ : finite_measure Ω) (c : ℝ≥0) :
+  μ.test_against_nn (bounded_continuous_function.const Ω c) = c * μ.mass :=
+by simp [← ennreal.coe_eq_coe]
+
+lemma test_against_nn_mono (μ : finite_measure Ω)
+  {f g : Ω →ᵇ ℝ≥0} (f_le_g : (f : Ω → ℝ≥0) ≤ g) :
+  μ.test_against_nn f ≤ μ.test_against_nn g :=
+begin
+  simp only [←ennreal.coe_le_coe, test_against_nn_coe_eq],
+  exact lintegral_mono (λ ω, ennreal.coe_mono (f_le_g ω)),
+end
+
+@[simp] lemma test_against_nn_zero (μ : finite_measure Ω) : μ.test_against_nn 0 = 0 :=
+by simpa only [zero_mul] using μ.test_against_nn_const 0
+
+@[simp] lemma test_against_nn_one (μ : finite_measure Ω) : μ.test_against_nn 1 = μ.mass :=
+begin
+  simp only [test_against_nn, coe_one, pi.one_apply, ennreal.coe_one, lintegral_one],
+  refl,
+end
+
+@[simp] lemma zero.test_against_nn_apply (f : Ω →ᵇ ℝ≥0) :
+  (0 : finite_measure Ω).test_against_nn f = 0 :=
+by simp only [test_against_nn, coe_zero, lintegral_zero_measure, ennreal.zero_to_nnreal]
+
+lemma zero.test_against_nn : (0 : finite_measure Ω).test_against_nn = 0 :=
+by { funext, simp only [zero.test_against_nn_apply, pi.zero_apply], }
+
+@[simp] lemma smul_test_against_nn_apply (c : ℝ≥0) (μ : finite_measure Ω) (f : Ω →ᵇ ℝ≥0) :
+  (c • μ).test_against_nn f  = c • (μ.test_against_nn f) :=
+by simp only [test_against_nn, coe_smul, smul_eq_mul, ← ennreal.smul_to_nnreal,
+  ennreal.smul_def, lintegral_smul_measure]
+
+variables [opens_measurable_space Ω]
+
+lemma test_against_nn_add (μ : finite_measure Ω) (f₁ f₂ : Ω →ᵇ ℝ≥0) :
+  μ.test_against_nn (f₁ + f₂) = μ.test_against_nn f₁ + μ.test_against_nn f₂ :=
+begin
+  simp only [←ennreal.coe_eq_coe, bounded_continuous_function.coe_add, ennreal.coe_add,
+             pi.add_apply, test_against_nn_coe_eq],
+  exact lintegral_add_left (bounded_continuous_function.nnreal.to_ennreal_comp_measurable _) _
+end
+
+lemma test_against_nn_smul [is_scalar_tower R ℝ≥0 ℝ≥0] [pseudo_metric_space R] [has_zero R]
+  [has_bounded_smul R ℝ≥0]
+  (μ : finite_measure Ω) (c : R) (f : Ω →ᵇ ℝ≥0) :
+  μ.test_against_nn (c • f) = c • μ.test_against_nn f :=
+begin
+  simp only [←ennreal.coe_eq_coe, bounded_continuous_function.coe_smul,
+             test_against_nn_coe_eq, ennreal.coe_smul],
+  simp_rw [←smul_one_smul ℝ≥0∞ c (f _ : ℝ≥0∞), ←smul_one_smul ℝ≥0∞ c (lintegral _ _ : ℝ≥0∞),
+           smul_eq_mul],
+  exact @lintegral_const_mul _ _ (μ : measure Ω) (c • 1)  _
+                   (bounded_continuous_function.nnreal.to_ennreal_comp_measurable f),
+end
+
+lemma test_against_nn_lipschitz_estimate (μ : finite_measure Ω) (f g : Ω →ᵇ ℝ≥0) :
+  μ.test_against_nn f ≤ μ.test_against_nn g + (nndist f g) * μ.mass :=
+begin
+  simp only [←μ.test_against_nn_const (nndist f g), ←test_against_nn_add, ←ennreal.coe_le_coe,
+             bounded_continuous_function.coe_add, const_apply, ennreal.coe_add, pi.add_apply,
+             coe_nnreal_ennreal_nndist, test_against_nn_coe_eq],
+  apply lintegral_mono,
+  have le_dist : ∀ ω, dist (f ω) (g ω) ≤ nndist f g :=
+  bounded_continuous_function.dist_coe_le_dist,
+  intros ω,
+  have le' : f ω ≤ g ω + nndist f g,
+  { apply (nnreal.le_add_nndist (f ω) (g ω)).trans,
+    rw add_le_add_iff_left,
+    exact dist_le_coe.mp (le_dist ω), },
+  have le : (f ω : ℝ≥0∞) ≤ (g ω : ℝ≥0∞) + (nndist f g),
+  by { rw ←ennreal.coe_add, exact ennreal.coe_mono le', },
+  rwa [coe_nnreal_ennreal_nndist] at le,
+end
+
+lemma test_against_nn_lipschitz (μ : finite_measure Ω) :
+  lipschitz_with μ.mass (λ (f : Ω →ᵇ ℝ≥0), μ.test_against_nn f) :=
+begin
+  rw lipschitz_with_iff_dist_le_mul,
+  intros f₁ f₂,
+  suffices : abs (μ.test_against_nn f₁ - μ.test_against_nn f₂ : ℝ) ≤ μ.mass * (dist f₁ f₂),
+  { rwa nnreal.dist_eq, },
+  apply abs_le.mpr,
+  split,
+  { have key' := μ.test_against_nn_lipschitz_estimate f₂ f₁,
+    rw mul_comm at key',
+    suffices : ↑(μ.test_against_nn f₂) ≤ ↑(μ.test_against_nn f₁) + ↑(μ.mass) * dist f₁ f₂,
+    { linarith, },
+    have key := nnreal.coe_mono key',
+    rwa [nnreal.coe_add, nnreal.coe_mul, nndist_comm] at key, },
+  { have key' := μ.test_against_nn_lipschitz_estimate f₁ f₂,
+    rw mul_comm at key',
+    suffices : ↑(μ.test_against_nn f₁) ≤ ↑(μ.test_against_nn f₂) + ↑(μ.mass) * dist f₁ f₂,
+    { linarith, },
+    have key := nnreal.coe_mono key',
+    rwa [nnreal.coe_add, nnreal.coe_mul] at key, },
+end
+
+/-- Finite measures yield elements of the `weak_dual` of bounded continuous nonnegative
+functions via `measure_theory.finite_measure.test_against_nn`, i.e., integration. -/
+def to_weak_dual_bcnn (μ : finite_measure Ω) :
+  weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0) :=
+{ to_fun := λ f, μ.test_against_nn f,
+  map_add' := test_against_nn_add μ,
+  map_smul' := test_against_nn_smul μ,
+  cont := μ.test_against_nn_lipschitz.continuous, }
+
+@[simp] lemma coe_to_weak_dual_bcnn (μ : finite_measure Ω) :
+  ⇑μ.to_weak_dual_bcnn = μ.test_against_nn := rfl
+
+@[simp] lemma to_weak_dual_bcnn_apply (μ : finite_measure Ω) (f : Ω →ᵇ ℝ≥0) :
+  μ.to_weak_dual_bcnn f = (∫⁻ x, f x ∂(μ : measure Ω)).to_nnreal := rfl
+
+/-- The topology of weak convergence on `measure_theory.finite_measure Ω` is inherited (induced)
+from the weak-* topology on `weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0)` via the function
+`measure_theory.finite_measure.to_weak_dual_bcnn`. -/
+instance : topological_space (finite_measure Ω) :=
+topological_space.induced to_weak_dual_bcnn infer_instance
+
+lemma to_weak_dual_bcnn_continuous :
+  continuous (@to_weak_dual_bcnn Ω _ _ _) :=
+continuous_induced_dom
+
+/- Integration of (nonnegative bounded continuous) test functions against finite Borel measures
+depends continuously on the measure. -/
+lemma continuous_test_against_nn_eval (f : Ω →ᵇ ℝ≥0) :
+  continuous (λ (μ : finite_measure Ω), μ.test_against_nn f) :=
+(by apply (weak_bilin.eval_continuous _ _).comp to_weak_dual_bcnn_continuous :
+  continuous ((λ φ : weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0), φ f) ∘ to_weak_dual_bcnn))
+
+/-- The total mass of a finite measure depends continuously on the measure. -/
+lemma continuous_mass : continuous (λ (μ : finite_measure Ω), μ.mass) :=
+by { simp_rw ←test_against_nn_one, exact continuous_test_against_nn_eval 1, }
+
+/-- Convergence of finite measures implies the convergence of their total masses. -/
+lemma _root_.filter.tendsto.mass {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} {μ : finite_measure Ω} (h : tendsto μs F (𝓝 μ)) :
+  tendsto (λ i, (μs i).mass) F (𝓝 μ.mass) :=
+(continuous_mass.tendsto μ).comp h
+
+lemma tendsto_iff_weak_star_tendsto {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔ tendsto (λ i, (μs(i)).to_weak_dual_bcnn) F (𝓝 μ.to_weak_dual_bcnn) :=
+inducing.tendsto_nhds_iff ⟨rfl⟩
+
+theorem tendsto_iff_forall_to_weak_dual_bcnn_tendsto
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔
+  ∀ (f : Ω →ᵇ ℝ≥0), tendsto (λ i, (μs i).to_weak_dual_bcnn f) F (𝓝 (μ.to_weak_dual_bcnn f)) :=
+by { rw [tendsto_iff_weak_star_tendsto, tendsto_iff_forall_eval_tendsto_top_dual_pairing], refl, }
+
+theorem tendsto_iff_forall_test_against_nn_tendsto
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔
+  ∀ (f : Ω →ᵇ ℝ≥0), tendsto (λ i, (μs i).test_against_nn f) F (𝓝 (μ.test_against_nn f)) :=
+by { rw finite_measure.tendsto_iff_forall_to_weak_dual_bcnn_tendsto, refl, }
+
+/-- If the total masses of finite measures tend to zero, then the measures tend to
+zero. This formulation concerns the associated functionals on bounded continuous
+nonnegative test functions. See `finite_measure.tendsto_zero_of_tendsto_zero_mass` for
+a formulation stating the weak convergence of measures. -/
+lemma tendsto_zero_test_against_nn_of_tendsto_zero_mass
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω}
+  (mass_lim : tendsto (λ i, (μs i).mass) F (𝓝 0)) (f : Ω →ᵇ ℝ≥0) :
+  tendsto (λ i, (μs i).test_against_nn f) F (𝓝 0) :=
+begin
+  apply tendsto_iff_dist_tendsto_zero.mpr,
+  have obs := λ i, (μs i).test_against_nn_lipschitz_estimate f 0,
+  simp_rw [test_against_nn_zero, zero_add] at obs,
+  simp_rw (show ∀ i, dist ((μs i).test_against_nn f) 0 = (μs i).test_against_nn f,
+    by simp only [dist_nndist, nnreal.nndist_zero_eq_val', eq_self_iff_true,
+                  implies_true_iff]),
+  refine squeeze_zero (λ i, nnreal.coe_nonneg _) obs _,
+  simp_rw nnreal.coe_mul,
+  have lim_pair : tendsto (λ i, (⟨nndist f 0, (μs i).mass⟩ : ℝ × ℝ)) F (𝓝 (⟨nndist f 0, 0⟩)),
+  { refine (prod.tendsto_iff _ _).mpr ⟨tendsto_const_nhds, _⟩,
+    exact (nnreal.continuous_coe.tendsto 0).comp mass_lim, },
+  have key := tendsto_mul.comp lim_pair,
+  rwa mul_zero at key,
+end
+
+/-- If the total masses of finite measures tend to zero, then the measures tend to zero. -/
+lemma tendsto_zero_of_tendsto_zero_mass {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} (mass_lim : tendsto (λ i, (μs i).mass) F (𝓝 0)) :
+  tendsto μs F (𝓝 0) :=
+begin
+  rw tendsto_iff_forall_test_against_nn_tendsto,
+  intro f,
+  convert tendsto_zero_test_against_nn_of_tendsto_zero_mass mass_lim f,
+  rw [zero.test_against_nn_apply],
+end
+
+/-- A characterization of weak convergence in terms of integrals of bounded continuous
+nonnegative functions. -/
+theorem tendsto_iff_forall_lintegral_tendsto {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔
+  ∀ (f : Ω →ᵇ ℝ≥0),
+    tendsto (λ i, (∫⁻ x, (f x) ∂(μs(i) : measure Ω))) F (𝓝 ((∫⁻ x, (f x) ∂(μ : measure Ω)))) :=
+begin
+  rw tendsto_iff_forall_to_weak_dual_bcnn_tendsto,
+  simp_rw [to_weak_dual_bcnn_apply _ _, ←test_against_nn_coe_eq,
+           ennreal.tendsto_coe, ennreal.to_nnreal_coe],
+end
+
+end finite_measure -- section
+
+section finite_measure_bounded_convergence
+/-! ### Bounded convergence results for finite measures
+
+This section is about bounded convergence theorems for finite measures.
+-/
+
+variables {Ω : Type*} [measurable_space Ω] [topological_space Ω] [opens_measurable_space Ω]
+
+/-- A bounded convergence theorem for a finite measure:
+If bounded continuous non-negative functions are uniformly bounded by a constant and tend to a
+limit, then their integrals against the finite measure tend to the integral of the limit.
+This formulation assumes:
+ * the functions tend to a limit along a countably generated filter;
+ * the limit is in the almost everywhere sense;
+ * boundedness holds almost everywhere;
+ * integration is `measure_theory.lintegral`, i.e., the functions and their integrals are
+   `ℝ≥0∞`-valued.
+-/
+lemma tendsto_lintegral_nn_filter_of_le_const {ι : Type*} {L : filter ι} [L.is_countably_generated]
+  (μ : measure Ω) [is_finite_measure μ] {fs : ι → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0}
+  (fs_le_const : ∀ᶠ i in L, ∀ᵐ (ω : Ω) ∂μ, fs i ω ≤ c) {f : Ω → ℝ≥0}
+  (fs_lim : ∀ᵐ (ω : Ω) ∂μ, tendsto (λ i, fs i ω) L (𝓝 (f ω))) :
+  tendsto (λ i, (∫⁻ ω, fs i ω ∂μ)) L (𝓝 (∫⁻ ω, (f ω) ∂μ)) :=
+begin
+  simpa only using tendsto_lintegral_filter_of_dominated_convergence (λ _, c)
+    (eventually_of_forall ((λ i, (ennreal.continuous_coe.comp (fs i).continuous).measurable)))
+    _ ((@lintegral_const_lt_top _ _ μ _ _ (@ennreal.coe_ne_top c)).ne) _,
+  { simpa only [ennreal.coe_le_coe] using fs_le_const, },
+  { simpa only [ennreal.tendsto_coe] using fs_lim, },
+end
+
+/-- A bounded convergence theorem for a finite measure:
+If a sequence of bounded continuous non-negative functions are uniformly bounded by a constant
+and tend pointwise to a limit, then their integrals (`measure_theory.lintegral`) against the finite
+measure tend to the integral of the limit.
+
+A related result with more general assumptions is
+`measure_theory.finite_measure.tendsto_lintegral_nn_filter_of_le_const`.
+-/
+lemma tendsto_lintegral_nn_of_le_const (μ : finite_measure Ω) {fs : ℕ → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0}
+  (fs_le_const : ∀ n ω, fs n ω ≤ c) {f : Ω → ℝ≥0}
+  (fs_lim : ∀ ω, tendsto (λ n, fs n ω) at_top (𝓝 (f ω))) :
+  tendsto (λ n, (∫⁻ ω, fs n ω ∂(μ : measure Ω))) at_top (𝓝 (∫⁻ ω, (f ω) ∂(μ : measure Ω))) :=
+tendsto_lintegral_nn_filter_of_le_const μ
+  (eventually_of_forall (λ n, eventually_of_forall (fs_le_const n))) (eventually_of_forall fs_lim)
+
+/-- A bounded convergence theorem for a finite measure:
+If bounded continuous non-negative functions are uniformly bounded by a constant and tend to a
+limit, then their integrals against the finite measure tend to the integral of the limit.
+This formulation assumes:
+ * the functions tend to a limit along a countably generated filter;
+ * the limit is in the almost everywhere sense;
+ * boundedness holds almost everywhere;
+ * integration is the pairing against non-negative continuous test functions
+   (`measure_theory.finite_measure.test_against_nn`).
+
+A related result using `measure_theory.lintegral` for integration is
+`measure_theory.finite_measure.tendsto_lintegral_nn_filter_of_le_const`.
+-/
+lemma tendsto_test_against_nn_filter_of_le_const {ι : Type*} {L : filter ι}
+  [L.is_countably_generated] {μ : finite_measure Ω} {fs : ι → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0}
+  (fs_le_const : ∀ᶠ i in L, ∀ᵐ (ω : Ω) ∂(μ : measure Ω), fs i ω ≤ c) {f : Ω →ᵇ ℝ≥0}
+  (fs_lim : ∀ᵐ (ω : Ω) ∂(μ : measure Ω), tendsto (λ i, fs i ω) L (𝓝 (f ω))) :
+  tendsto (λ i, μ.test_against_nn (fs i)) L (𝓝 (μ.test_against_nn f)) :=
+begin
+  apply (ennreal.tendsto_to_nnreal
+         (lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f).ne).comp,
+  exact tendsto_lintegral_nn_filter_of_le_const μ fs_le_const fs_lim,
+end
+
+/-- A bounded convergence theorem for a finite measure:
+If a sequence of bounded continuous non-negative functions are uniformly bounded by a constant and
+tend pointwise to a limit, then their integrals (`measure_theory.finite_measure.test_against_nn`)
+against the finite measure tend to the integral of the limit.
+
+Related results:
+ * `measure_theory.finite_measure.tendsto_test_against_nn_filter_of_le_const`:
+   more general assumptions
+ * `measure_theory.finite_measure.tendsto_lintegral_nn_of_le_const`:
+   using `measure_theory.lintegral` for integration.
+-/
+lemma tendsto_test_against_nn_of_le_const {μ : finite_measure Ω}
+  {fs : ℕ → (Ω →ᵇ ℝ≥0)} {c : ℝ≥0} (fs_le_const : ∀ n ω, fs n ω ≤ c) {f : Ω →ᵇ ℝ≥0}
+  (fs_lim : ∀ ω, tendsto (λ n, fs n ω) at_top (𝓝 (f ω))) :
+  tendsto (λ n, μ.test_against_nn (fs n)) at_top (𝓝 (μ.test_against_nn f)) :=
+tendsto_test_against_nn_filter_of_le_const
+  (eventually_of_forall (λ n, eventually_of_forall (fs_le_const n))) (eventually_of_forall fs_lim)
+
+end finite_measure_bounded_convergence -- section
+
+section finite_measure_convergence_by_bounded_continuous_functions
+/-! ### Weak convergence of finite measures with bounded continuous real-valued functions
+
+In this section we characterize the weak convergence of finite measures by the usual (defining)
+condition that the integrals of all bounded continuous real-valued functions converge.
+-/
+
+variables {Ω : Type*} [measurable_space Ω] [topological_space Ω] [opens_measurable_space Ω]
+
+lemma integrable_of_bounded_continuous_to_nnreal
+  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ≥0) :
+  integrable ((coe : ℝ≥0 → ℝ) ∘ ⇑f) μ :=
+begin
+  refine ⟨(nnreal.continuous_coe.comp f.continuous).measurable.ae_strongly_measurable, _⟩,
+  simp only [has_finite_integral, nnreal.nnnorm_eq],
+  exact lintegral_lt_top_of_bounded_continuous_to_nnreal _ f,
+end
+
+lemma integrable_of_bounded_continuous_to_real
+  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ) :
+  integrable ⇑f μ :=
+begin
+  refine ⟨f.continuous.measurable.ae_strongly_measurable, _⟩,
+  have aux : (coe : ℝ≥0 → ℝ) ∘ ⇑f.nnnorm = (λ x, ‖f x‖),
+  { ext ω,
+    simp only [function.comp_app, bounded_continuous_function.nnnorm_coe_fun_eq, coe_nnnorm], },
+  apply (has_finite_integral_iff_norm ⇑f).mpr,
+  rw ← of_real_integral_eq_lintegral_of_real,
+  { exact ennreal.of_real_lt_top, },
+  { exact aux ▸ integrable_of_bounded_continuous_to_nnreal μ f.nnnorm, },
+  { exact eventually_of_forall (λ ω, norm_nonneg (f ω)), },
+end
+
+lemma _root_.bounded_continuous_function.integral_eq_integral_nnreal_part_sub
+  (μ : measure Ω) [is_finite_measure μ] (f : Ω →ᵇ ℝ) :
+  ∫ ω, f ω ∂μ = ∫ ω, f.nnreal_part ω ∂μ - ∫ ω, (-f).nnreal_part ω ∂μ :=
+by simp only [f.self_eq_nnreal_part_sub_nnreal_part_neg,
+              pi.sub_apply, integral_sub, integrable_of_bounded_continuous_to_nnreal]
+
+lemma lintegral_lt_top_of_bounded_continuous_to_real
+  {Ω : Type*} [measurable_space Ω] [topological_space Ω] (μ : measure Ω) [is_finite_measure μ]
+  (f : Ω →ᵇ ℝ) :
+  ∫⁻ ω, ennreal.of_real (f ω) ∂μ < ∞ :=
+lintegral_lt_top_of_bounded_continuous_to_nnreal _ f.nnreal_part
+
+theorem tendsto_of_forall_integral_tendsto
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω}
+  (h : (∀ (f : Ω →ᵇ ℝ),
+       tendsto (λ i, (∫ x, (f x) ∂(μs i : measure Ω))) F (𝓝 ((∫ x, (f x) ∂(μ : measure Ω)))))) :
+  tendsto μs F (𝓝 μ) :=
+begin
+  apply (@tendsto_iff_forall_lintegral_tendsto Ω _ _ _ γ F μs μ).mpr,
+  intro f,
+  have key := @ennreal.tendsto_to_real_iff _ F
+              _ (λ i, (lintegral_lt_top_of_bounded_continuous_to_nnreal (μs i : measure Ω) f).ne)
+              _ (lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f).ne,
+  simp only [ennreal.of_real_coe_nnreal] at key,
+  apply key.mp,
+  have lip : lipschitz_with 1 (coe : ℝ≥0 → ℝ), from isometry_subtype_coe.lipschitz,
+  set f₀ := bounded_continuous_function.comp _ lip f with def_f₀,
+  have f₀_eq : ⇑f₀ = (coe : ℝ≥0 → ℝ) ∘ ⇑f, by refl,
+  have f₀_nn : 0 ≤ ⇑f₀, from λ _, by simp only [f₀_eq, pi.zero_apply, nnreal.zero_le_coe],
+  have f₀_ae_nn : 0 ≤ᵐ[(μ : measure Ω)] ⇑f₀, from eventually_of_forall f₀_nn,
+  have f₀_ae_nns : ∀ i, 0 ≤ᵐ[(μs i : measure Ω)] ⇑f₀, from λ i, eventually_of_forall f₀_nn,
+  have aux := integral_eq_lintegral_of_nonneg_ae f₀_ae_nn
+              f₀.continuous.measurable.ae_strongly_measurable,
+  have auxs := λ i, integral_eq_lintegral_of_nonneg_ae (f₀_ae_nns i)
+              f₀.continuous.measurable.ae_strongly_measurable,
+  simp only [f₀_eq, ennreal.of_real_coe_nnreal] at aux auxs,
+  simpa only [←aux, ←auxs] using h f₀,
+end
+
+lemma _root_.bounded_continuous_function.nnreal.to_real_lintegral_eq_integral
+  (f : Ω →ᵇ ℝ≥0) (μ : measure Ω) :
+  (∫⁻ x, (f x : ℝ≥0∞) ∂μ).to_real = (∫ x, f x ∂μ) :=
+begin
+  rw integral_eq_lintegral_of_nonneg_ae _
+     (nnreal.continuous_coe.comp f.continuous).measurable.ae_strongly_measurable,
+  { simp only [ennreal.of_real_coe_nnreal], },
+  { apply eventually_of_forall,
+    simp only [pi.zero_apply, nnreal.zero_le_coe, implies_true_iff], },
+end
+
+/-- A characterization of weak convergence in terms of integrals of bounded continuous
+real-valued functions. -/
+theorem tendsto_iff_forall_integral_tendsto
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω} {μ : finite_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔
+  ∀ (f : Ω →ᵇ ℝ),
+    tendsto (λ i, (∫ x, (f x) ∂(μs i : measure Ω))) F (𝓝 ((∫ x, (f x) ∂(μ : measure Ω)))) :=
+begin
+  refine ⟨_, tendsto_of_forall_integral_tendsto⟩,
+  rw tendsto_iff_forall_lintegral_tendsto,
+  intros h f,
+  simp_rw bounded_continuous_function.integral_eq_integral_nnreal_part_sub,
+  set f_pos := f.nnreal_part with def_f_pos,
+  set f_neg := (-f).nnreal_part with def_f_neg,
+  have tends_pos := (ennreal.tendsto_to_real
+    ((lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f_pos).ne)).comp (h f_pos),
+  have tends_neg := (ennreal.tendsto_to_real
+    ((lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) f_neg).ne)).comp (h f_neg),
+  have aux : ∀ (g : Ω →ᵇ ℝ≥0), ennreal.to_real ∘ (λ (i : γ), ∫⁻ (x : Ω), ↑(g x) ∂(μs i : measure Ω))
+         = λ (i : γ), (∫⁻ (x : Ω), ↑(g x) ∂(μs i : measure Ω)).to_real, from λ _, rfl,
+  simp_rw [aux, bounded_continuous_function.nnreal.to_real_lintegral_eq_integral]
+          at tends_pos tends_neg,
+  exact tendsto.sub tends_pos tends_neg,
+end
+
+end finite_measure_convergence_by_bounded_continuous_functions -- section
+
+end finite_measure -- namespace
+
+end measure_theory -- namespace
diff --git a/src/measure_theory/measure/finite_measure_weak_convergence.lean b/src/measure_theory/measure/finite_measure_weak_convergence.lean
deleted file mode 100644
index 48b58a3c8b60a..0000000000000
--- a/src/measure_theory/measure/finite_measure_weak_convergence.lean
+++ /dev/null
@@ -1,451 +0,0 @@
-/-
-Copyright (c) 2021 Kalle Kytölä. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kalle Kytölä
--/
-import measure_theory.measure.measure_space
-import measure_theory.integral.bochner
-import topology.continuous_function.bounded
-import topology.algebra.module.weak_dual
-
-/-!
-# Weak convergence of (finite) measures
-
-This file defines the topology of weak convergence of finite measures and probability measures
-on topological spaces. The topology of weak convergence is the coarsest topology w.r.t. which
-for every bounded continuous `ℝ≥0`-valued function `f`, the integration of `f` against the
-measure is continuous.
-
-TODOs:
-* Prove that an equivalent definition of the topologies is obtained requiring continuity of
-  integration of bounded continuous `ℝ`-valued functions instead.
-* Include the portmanteau theorem on characterizations of weak convergence of (Borel) probability
-  measures.
-
-## Main definitions
-
-The main definitions are the
- * types `finite_measure α` and `probability_measure α` with topologies of weak convergence;
- * `to_weak_dual_bcnn : finite_measure α → (weak_dual ℝ≥0 (α →ᵇ ℝ≥0))`
-   allowing to interpret a finite measure as a continuous linear functional on the space of
-   bounded continuous nonnegative functions on `α`. This is used for the definition of the
-   topology of weak convergence.
-
-## Main results
-
- * Finite measures `μ` on `α` give rise to continuous linear functionals on the space of
-   bounded continuous nonnegative functions on `α` via integration:
-   `to_weak_dual_bcnn : finite_measure α → (weak_dual ℝ≥0 (α →ᵇ ℝ≥0))`.
- * `tendsto_iff_forall_lintegral_tendsto`: Convergence of finite measures and probability measures
-   is characterized by the convergence of integrals of all bounded continuous (nonnegative)
-   functions. This essentially shows that the given definition of topology corresponds to the
-   common textbook definition of weak convergence of measures.
-
-TODO:
-* Portmanteau theorem.
-
-## Notations
-
-No new notation is introduced.
-
-## Implementation notes
-
-The topology of weak convergence of finite Borel measures will be defined using a mapping from
-`finite_measure α` to `weak_dual ℝ≥0 (α →ᵇ ℝ≥0)`, inheriting the topology from the latter.
-
-The current implementation of `finite_measure α` and `probability_measure α` is directly as
-subtypes of `measure α`, and the coercion to a function is the composition `ennreal.to_nnreal`
-and the coercion to function of `measure α`. Another alternative would be to use a bijection
-with `vector_measure α ℝ≥0` as an intermediate step. The choice of implementation should not have
-drastic downstream effects, so it can be changed later if appropriate.
-
-Potential advantages of using the `nnreal`-valued vector measure alternative:
- * The coercion to function would avoid need to compose with `ennreal.to_nnreal`, the
-   `nnreal`-valued API could be more directly available.
-Potential drawbacks of the vector measure alternative:
- * The coercion to function would lose monotonicity, as non-measurable sets would be defined to
-   have measure 0.
- * No integration theory directly. E.g., the topology definition requires `lintegral` w.r.t.
-   a coercion to `measure α` in any case.
-
-## References
-
-* [Billingsley, *Convergence of probability measures*][billingsley1999]
-
-## Tags
-
-weak convergence of measures, finite measure, probability measure
-
--/
-
-noncomputable theory
-open measure_theory
-open set
-open filter
-open bounded_continuous_function
-open_locale topological_space ennreal nnreal bounded_continuous_function
-
-namespace measure_theory
-
-variables {α : Type*} [measurable_space α]
-
-/-- Finite measures are defined as the subtype of measures that have the property of being finite
-measures (i.e., their total mass is finite). -/
-def finite_measure (α : Type*) [measurable_space α] : Type* :=
-{μ : measure α // is_finite_measure μ}
-
-namespace finite_measure
-
-/-- A finite measure can be interpreted as a measure. -/
-instance : has_coe (finite_measure α) (measure_theory.measure α) := coe_subtype
-
-instance is_finite_measure (μ : finite_measure α) :
-  is_finite_measure (μ : measure α) := μ.prop
-
-instance : has_coe_to_fun (finite_measure α) (λ _, set α → ℝ≥0) :=
-⟨λ μ s, (μ s).to_nnreal⟩
-
-lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : finite_measure α) :
-  (ν : set α → ℝ≥0) = λ s, ((ν : measure α) s).to_nnreal := rfl
-
-@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : finite_measure α) (s : set α) :
-  (ν s : ℝ≥0∞) = (ν : measure α) s := ennreal.coe_to_nnreal (measure_lt_top ↑ν s).ne
-
-@[simp] lemma val_eq_to_measure (ν : finite_measure α) : ν.val = (ν : measure α) := rfl
-
-lemma coe_injective : function.injective (coe : finite_measure α → measure α) :=
-subtype.coe_injective
-
-/-- The (total) mass of a finite measure `μ` is `μ univ`, i.e., the cast to `nnreal` of
-`(μ : measure α) univ`. -/
-def mass (μ : finite_measure α) : ℝ≥0 := μ univ
-
-@[simp] lemma ennreal_mass {μ : finite_measure α} :
-  (μ.mass : ℝ≥0∞) = (μ : measure α) univ := ennreal_coe_fn_eq_coe_fn_to_measure μ set.univ
-
-instance has_zero : has_zero (finite_measure α) :=
-{ zero := ⟨0, measure_theory.is_finite_measure_zero⟩ }
-
-instance : inhabited (finite_measure α) := ⟨0⟩
-
-instance : has_add (finite_measure α) :=
-{ add := λ μ ν, ⟨μ + ν, measure_theory.is_finite_measure_add⟩ }
-
-variables {R : Type*} [has_scalar R ℝ≥0] [has_scalar R ℝ≥0∞] [is_scalar_tower R ℝ≥0 ℝ≥0∞]
-  [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
-
-instance : has_scalar R (finite_measure α) :=
-{ smul := λ (c : R) μ, ⟨c • μ, measure_theory.is_finite_measure_smul_of_nnreal_tower⟩, }
-
-@[simp, norm_cast] lemma coe_zero : (coe : finite_measure α → measure α) 0 = 0 := rfl
-
-@[simp, norm_cast] lemma coe_add (μ ν : finite_measure α) : ↑(μ + ν) = (↑μ + ↑ν : measure α) := rfl
-
-@[simp, norm_cast] lemma coe_smul (c : R) (μ : finite_measure α) :
-  ↑(c • μ) = (c • ↑μ : measure α) := rfl
-
-@[simp, norm_cast] lemma coe_fn_zero :
-  (⇑(0 : finite_measure α) : set α → ℝ≥0) = (0 : set α → ℝ≥0) := by { funext, refl, }
-
-@[simp, norm_cast] lemma coe_fn_add (μ ν : finite_measure α) :
-  (⇑(μ + ν) : set α → ℝ≥0) = (⇑μ + ⇑ν : set α → ℝ≥0) :=
-by { funext, simp [← ennreal.coe_eq_coe], }
-
-@[simp, norm_cast] lemma coe_fn_smul [is_scalar_tower R ℝ≥0 ℝ≥0] (c : R) (μ : finite_measure α) :
-  (⇑(c • μ) : set α → ℝ≥0) = c • (⇑μ : set α → ℝ≥0) :=
-by { funext, simp [← ennreal.coe_eq_coe, ennreal.coe_smul], }
-
-instance : add_comm_monoid (finite_measure α) :=
-finite_measure.coe_injective.add_comm_monoid coe coe_zero coe_add (λ _ _, coe_smul _ _)
-
-/-- Coercion is an `add_monoid_hom`. -/
-@[simps]
-def coe_add_monoid_hom : finite_measure α →+ measure α :=
-{ to_fun := coe, map_zero' := coe_zero, map_add' := coe_add }
-
-instance {α : Type*} [measurable_space α] : module ℝ≥0 (finite_measure α) :=
-function.injective.module _ coe_add_monoid_hom finite_measure.coe_injective coe_smul
-
-variables [topological_space α]
-
-/-- The pairing of a finite (Borel) measure `μ` with a nonnegative bounded continuous
-function is obtained by (Lebesgue) integrating the (test) function against the measure.
-This is `finite_measure.test_against_nn`. -/
-def test_against_nn (μ : finite_measure α) (f : α →ᵇ ℝ≥0) : ℝ≥0 :=
-(∫⁻ x, f x ∂(μ : measure α)).to_nnreal
-
-lemma _root_.bounded_continuous_function.nnreal.to_ennreal_comp_measurable {α : Type*}
-  [topological_space α] [measurable_space α] [opens_measurable_space α] (f : α →ᵇ ℝ≥0) :
-  measurable (λ x, (f x : ℝ≥0∞)) :=
-measurable_coe_nnreal_ennreal.comp f.continuous.measurable
-
-lemma lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : finite_measure α) (f : α →ᵇ ℝ≥0) :
-  ∫⁻ x, f x ∂(μ : measure α) < ∞ :=
-begin
-  apply is_finite_measure.lintegral_lt_top_of_bounded_to_ennreal,
-  use nndist f 0,
-  intros x,
-  have key := bounded_continuous_function.nnreal.upper_bound f x,
-  rw ennreal.coe_le_coe,
-  have eq : nndist f 0 = ⟨dist f 0, dist_nonneg⟩,
-  { ext,
-    simp only [real.coe_to_nnreal', max_eq_left_iff, subtype.coe_mk, coe_nndist], },
-  rwa eq at key,
-end
-
-@[simp] lemma test_against_nn_coe_eq {μ : finite_measure α} {f : α →ᵇ ℝ≥0} :
-  (μ.test_against_nn f : ℝ≥0∞) = ∫⁻ x, f x ∂(μ : measure α) :=
-ennreal.coe_to_nnreal (lintegral_lt_top_of_bounded_continuous_to_nnreal μ f).ne
-
-lemma test_against_nn_const (μ : finite_measure α) (c : ℝ≥0) :
-  μ.test_against_nn (bounded_continuous_function.const α c) = c * μ.mass :=
-by simp [← ennreal.coe_eq_coe]
-
-lemma test_against_nn_mono (μ : finite_measure α)
-  {f g : α →ᵇ ℝ≥0} (f_le_g : (f : α → ℝ≥0) ≤ g) :
-  μ.test_against_nn f ≤ μ.test_against_nn g :=
-begin
-  simp only [←ennreal.coe_le_coe, test_against_nn_coe_eq],
-  apply lintegral_mono,
-  exact λ x, ennreal.coe_mono (f_le_g x),
-end
-
-variables [opens_measurable_space α]
-
-lemma test_against_nn_add (μ : finite_measure α) (f₁ f₂ : α →ᵇ ℝ≥0) :
-  μ.test_against_nn (f₁ + f₂) = μ.test_against_nn f₁ + μ.test_against_nn f₂ :=
-begin
-  simp only [←ennreal.coe_eq_coe, bounded_continuous_function.coe_add, ennreal.coe_add,
-             pi.add_apply, test_against_nn_coe_eq],
-  apply lintegral_add;
-  exact bounded_continuous_function.nnreal.to_ennreal_comp_measurable _,
-end
-
-lemma test_against_nn_smul [is_scalar_tower R ℝ≥0 ℝ≥0] [pseudo_metric_space R] [has_zero R]
-  [has_bounded_smul R ℝ≥0]
-  (μ : finite_measure α) (c : R) (f : α →ᵇ ℝ≥0) :
-  μ.test_against_nn (c • f) = c • μ.test_against_nn f :=
-begin
-  simp only [←ennreal.coe_eq_coe, bounded_continuous_function.coe_smul,
-             test_against_nn_coe_eq, ennreal.coe_smul],
-  simp_rw [←smul_one_smul ℝ≥0∞ c (f _ : ℝ≥0∞), ←smul_one_smul ℝ≥0∞ c (lintegral _ _ : ℝ≥0∞),
-           smul_eq_mul],
-  exact @lintegral_const_mul _ _ (μ : measure α) (c • 1)  _
-                   (bounded_continuous_function.nnreal.to_ennreal_comp_measurable f),
-end
-
-lemma test_against_nn_lipschitz_estimate (μ : finite_measure α) (f g : α →ᵇ ℝ≥0) :
-  μ.test_against_nn f ≤ μ.test_against_nn g + (nndist f g) * μ.mass :=
-begin
-  simp only [←μ.test_against_nn_const (nndist f g), ←test_against_nn_add, ←ennreal.coe_le_coe,
-             bounded_continuous_function.coe_add, const_apply, ennreal.coe_add, pi.add_apply,
-             coe_nnreal_ennreal_nndist, test_against_nn_coe_eq],
-  apply lintegral_mono,
-  have le_dist : ∀ x, dist (f x) (g x) ≤ nndist f g :=
-  bounded_continuous_function.dist_coe_le_dist,
-  intros x,
-  have le' : f(x) ≤ g(x) + nndist f g,
-  { apply (nnreal.le_add_nndist (f x) (g x)).trans,
-    rw add_le_add_iff_left,
-    exact dist_le_coe.mp (le_dist x), },
-  have le : (f(x) : ℝ≥0∞) ≤ (g(x) : ℝ≥0∞) + (nndist f g),
-  by { rw ←ennreal.coe_add, exact ennreal.coe_mono le', },
-  rwa [coe_nnreal_ennreal_nndist] at le,
-end
-
-lemma test_against_nn_lipschitz (μ : finite_measure α) :
-  lipschitz_with μ.mass (λ (f : α →ᵇ ℝ≥0), μ.test_against_nn f) :=
-begin
-  rw lipschitz_with_iff_dist_le_mul,
-  intros f₁ f₂,
-  suffices : abs (μ.test_against_nn f₁ - μ.test_against_nn f₂ : ℝ) ≤ μ.mass * (dist f₁ f₂),
-  { rwa nnreal.dist_eq, },
-  apply abs_le.mpr,
-  split,
-  { have key' := μ.test_against_nn_lipschitz_estimate f₂ f₁,
-    rw mul_comm at key',
-    suffices : ↑(μ.test_against_nn f₂) ≤ ↑(μ.test_against_nn f₁) + ↑(μ.mass) * dist f₁ f₂,
-    { linarith, },
-    have key := nnreal.coe_mono key',
-    rwa [nnreal.coe_add, nnreal.coe_mul, nndist_comm] at key, },
-  { have key' := μ.test_against_nn_lipschitz_estimate f₁ f₂,
-    rw mul_comm at key',
-    suffices : ↑(μ.test_against_nn f₁) ≤ ↑(μ.test_against_nn f₂) + ↑(μ.mass) * dist f₁ f₂,
-    { linarith, },
-    have key := nnreal.coe_mono key',
-    rwa [nnreal.coe_add, nnreal.coe_mul] at key, },
-end
-
-/-- Finite measures yield elements of the `weak_dual` of bounded continuous nonnegative
-functions via `finite_measure.test_against_nn`, i.e., integration. -/
-def to_weak_dual_bcnn (μ : finite_measure α) :
-  weak_dual ℝ≥0 (α →ᵇ ℝ≥0) :=
-{ to_fun := λ f, μ.test_against_nn f,
-  map_add' := test_against_nn_add μ,
-  map_smul' := test_against_nn_smul μ,
-  cont := μ.test_against_nn_lipschitz.continuous, }
-
-@[simp] lemma coe_to_weak_dual_bcnn (μ : finite_measure α) :
-  ⇑μ.to_weak_dual_bcnn = μ.test_against_nn := rfl
-
-@[simp] lemma to_weak_dual_bcnn_apply (μ : finite_measure α) (f : α →ᵇ ℝ≥0) :
-  μ.to_weak_dual_bcnn f = (∫⁻ x, f x ∂(μ : measure α)).to_nnreal := rfl
-
-/-- The topology of weak convergence on `finite_measures α` is inherited (induced) from the weak-*
-topology on `weak_dual ℝ≥0 (α →ᵇ ℝ≥0)` via the function `finite_measures.to_weak_dual_bcnn`. -/
-instance : topological_space (finite_measure α) :=
-topological_space.induced to_weak_dual_bcnn infer_instance
-
-lemma to_weak_dual_bcnn_continuous :
-  continuous (@finite_measure.to_weak_dual_bcnn α _ _ _) :=
-continuous_induced_dom
-
-/- Integration of (nonnegative bounded continuous) test functions against finite Borel measures
-depends continuously on the measure. -/
-lemma continuous_test_against_nn_eval (f : α →ᵇ ℝ≥0) :
-  continuous (λ (μ : finite_measure α), μ.test_against_nn f) :=
-(by apply (weak_bilin.eval_continuous _ _).comp to_weak_dual_bcnn_continuous :
-  continuous ((λ φ : weak_dual ℝ≥0 (α →ᵇ ℝ≥0), φ f) ∘ to_weak_dual_bcnn))
-
-lemma tendsto_iff_weak_star_tendsto {γ : Type*} {F : filter γ}
-  {μs : γ → finite_measure α} {μ : finite_measure α} :
-  tendsto μs F (𝓝 μ) ↔ tendsto (λ i, (μs(i)).to_weak_dual_bcnn) F (𝓝 μ.to_weak_dual_bcnn) :=
-inducing.tendsto_nhds_iff ⟨rfl⟩
-
-theorem tendsto_iff_forall_test_against_nn_tendsto {γ : Type*} {F : filter γ}
-  {μs : γ → finite_measure α} {μ : finite_measure α} :
-  tendsto μs F (𝓝 μ) ↔
-  ∀ (f : α →ᵇ ℝ≥0), tendsto (λ i, (μs(i)).to_weak_dual_bcnn f) F (𝓝 (μ.to_weak_dual_bcnn f)) :=
-by { rw [tendsto_iff_weak_star_tendsto, tendsto_iff_forall_eval_tendsto_top_dual_pairing], refl, }
-
-theorem tendsto_iff_forall_lintegral_tendsto {γ : Type*} {F : filter γ}
-  {μs : γ → finite_measure α} {μ : finite_measure α} :
-  tendsto μs F (𝓝 μ) ↔
-  ∀ (f : α →ᵇ ℝ≥0),
-    tendsto (λ i, (∫⁻ x, (f x) ∂(μs(i) : measure α))) F (𝓝 ((∫⁻ x, (f x) ∂(μ : measure α)))) :=
-begin
-  rw tendsto_iff_forall_test_against_nn_tendsto,
-  simp_rw [to_weak_dual_bcnn_apply _ _, ←test_against_nn_coe_eq,
-           ennreal.tendsto_coe, ennreal.to_nnreal_coe],
-end
-
-end finite_measure
-
-/-- Probability measures are defined as the subtype of measures that have the property of being
-probability measures (i.e., their total mass is one). -/
-def probability_measure (α : Type*) [measurable_space α] : Type* :=
-{μ : measure α // is_probability_measure μ}
-
-namespace probability_measure
-
-instance [inhabited α] : inhabited (probability_measure α) :=
-⟨⟨measure.dirac default, measure.dirac.is_probability_measure⟩⟩
-
-/-- A probability measure can be interpreted as a measure. -/
-instance : has_coe (probability_measure α) (measure_theory.measure α) := coe_subtype
-
-instance : has_coe_to_fun (probability_measure α) (λ _, set α → ℝ≥0) :=
-⟨λ μ s, (μ s).to_nnreal⟩
-
-instance (μ : probability_measure α) : is_probability_measure (μ : measure α) := μ.prop
-
-lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : probability_measure α) :
-  (ν : set α → ℝ≥0) = λ s, ((ν : measure α) s).to_nnreal := rfl
-
-@[simp] lemma val_eq_to_measure (ν : probability_measure α) : ν.val = (ν : measure α) := rfl
-
-lemma coe_injective : function.injective (coe : probability_measure α → measure α) :=
-subtype.coe_injective
-
-@[simp] lemma coe_fn_univ (ν : probability_measure α) : ν univ = 1 :=
-congr_arg ennreal.to_nnreal ν.prop.measure_univ
-
-/-- A probability measure can be interpreted as a finite measure. -/
-def to_finite_measure (μ : probability_measure α) : finite_measure α := ⟨μ, infer_instance⟩
-
-@[simp] lemma coe_comp_to_finite_measure_eq_coe (ν : probability_measure α) :
-  (ν.to_finite_measure : measure α) = (ν : measure α) := rfl
-
-@[simp] lemma coe_fn_comp_to_finite_measure_eq_coe_fn (ν : probability_measure α) :
-  (ν.to_finite_measure : set α → ℝ≥0) = (ν : set α → ℝ≥0) := rfl
-
-@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : probability_measure α) (s : set α) :
-  (ν s : ℝ≥0∞) = (ν : measure α) s :=
-by { rw [← coe_fn_comp_to_finite_measure_eq_coe_fn,
-     finite_measure.ennreal_coe_fn_eq_coe_fn_to_measure], refl, }
-
-@[simp] lemma mass_to_finite_measure (μ : probability_measure α) :
-  μ.to_finite_measure.mass = 1 := μ.coe_fn_univ
-
-variables [topological_space α]
-
-lemma lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : probability_measure α) (f : α →ᵇ ℝ≥0) :
-  ∫⁻ x, f x ∂(μ : measure α) < ∞ :=
-μ.to_finite_measure.lintegral_lt_top_of_bounded_continuous_to_nnreal f
-
-variables [opens_measurable_space α]
-
-lemma test_against_nn_lipschitz (μ : probability_measure α) :
-  lipschitz_with 1 (λ (f : α →ᵇ ℝ≥0), μ.to_finite_measure.test_against_nn f) :=
-μ.mass_to_finite_measure ▸ μ.to_finite_measure.test_against_nn_lipschitz
-
-/-- The topology of weak convergence on `probability_measures α`. This is inherited (induced) from
-the weak-*  topology on `weak_dual ℝ≥0 (α →ᵇ ℝ≥0)` via the function
-`probability_measures.to_weak_dual_bcnn`. -/
-instance : topological_space (probability_measure α) :=
-topological_space.induced to_finite_measure infer_instance
-
-lemma to_finite_measure_continuous :
-  continuous (to_finite_measure : probability_measure α → finite_measure α) :=
-continuous_induced_dom
-
-/-- Probability measures yield elements of the `weak_dual` of bounded continuous nonnegative
-functions via `finite_measure.test_against_nn`, i.e., integration. -/
-def to_weak_dual_bcnn : probability_measure α → weak_dual ℝ≥0 (α →ᵇ ℝ≥0) :=
-finite_measure.to_weak_dual_bcnn ∘ to_finite_measure
-
-@[simp] lemma coe_to_weak_dual_bcnn (μ : probability_measure α) :
-  ⇑μ.to_weak_dual_bcnn = μ.to_finite_measure.test_against_nn := rfl
-
-@[simp] lemma to_weak_dual_bcnn_apply (μ : probability_measure α) (f : α →ᵇ ℝ≥0) :
-  μ.to_weak_dual_bcnn f = (∫⁻ x, f x ∂(μ : measure α)).to_nnreal := rfl
-
-lemma to_weak_dual_bcnn_continuous :
-  continuous (λ (μ : probability_measure α), μ.to_weak_dual_bcnn) :=
-finite_measure.to_weak_dual_bcnn_continuous.comp to_finite_measure_continuous
-
-/- Integration of (nonnegative bounded continuous) test functions against Borel probability
-measures depends continuously on the measure. -/
-lemma continuous_test_against_nn_eval (f : α →ᵇ ℝ≥0) :
-  continuous (λ (μ : probability_measure α), μ.to_finite_measure.test_against_nn f) :=
-(finite_measure.continuous_test_against_nn_eval f).comp to_finite_measure_continuous
-
-/- The canonical mapping from probability measures to finite measures is an embedding. -/
-lemma to_finite_measure_embedding (α : Type*)
-  [measurable_space α] [topological_space α] [opens_measurable_space α] :
-  embedding (to_finite_measure : probability_measure α → finite_measure α) :=
-{ induced := rfl,
-  inj := λ μ ν h, subtype.eq (by convert congr_arg coe h) }
-
-lemma tendsto_nhds_iff_to_finite_measures_tendsto_nhds {δ : Type*}
-  (F : filter δ) {μs : δ → probability_measure α} {μ₀ : probability_measure α} :
-  tendsto μs F (𝓝 μ₀) ↔ tendsto (to_finite_measure ∘ μs) F (𝓝 (μ₀.to_finite_measure)) :=
-embedding.tendsto_nhds_iff (probability_measure.to_finite_measure_embedding α)
-
-/-- The usual definition of weak convergence of probability measures is given in terms of sequences
-of probability measures: it is the requirement that the integrals of all continuous bounded
-functions against members of the sequence converge. This version is a characterization using
-nonnegative bounded continuous functions. -/
-theorem tendsto_iff_forall_lintegral_tendsto {γ : Type*} {F : filter γ}
-  {μs : γ → probability_measure α} {μ : probability_measure α} :
-  tendsto μs F (𝓝 μ) ↔
-  ∀ (f : α →ᵇ ℝ≥0), tendsto (λ i, (∫⁻ x, (f x) ∂(μs(i) : measure α))) F
-    (𝓝 ((∫⁻ x, (f x) ∂(μ : measure α)))) :=
-begin
-  rw tendsto_nhds_iff_to_finite_measures_tendsto_nhds,
-  exact finite_measure.tendsto_iff_forall_lintegral_tendsto,
-end
-
-end probability_measure
-
-end measure_theory
diff --git a/src/measure_theory/measure/giry_monad.lean b/src/measure_theory/measure/giry_monad.lean
index 11b2f7ff2f024..54df828191871 100644
--- a/src/measure_theory/measure/giry_monad.lean
+++ b/src/measure_theory/measure/giry_monad.lean
@@ -8,6 +8,9 @@ import measure_theory.integral.lebesgue
 /-!
 # The Giry monad
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let X be a measurable space. The collection of all measures on X again
 forms a measurable space. This construction forms a monad on
 measurable spaces and measurable functions, called the Giry monad.
@@ -32,7 +35,7 @@ open_locale classical big_operators ennreal
 
 open classical set filter
 
-variables {α β γ δ ε : Type*}
+variables {α β : Type*}
 
 namespace measure_theory
 
@@ -42,38 +45,47 @@ variables [measurable_space α] [measurable_space β]
 
 /-- Measurability structure on `measure`: Measures are measurable w.r.t. all projections -/
 instance : measurable_space (measure α) :=
-⨆ (s : set α) (hs : measurable_set s), (borel ℝ≥0∞).comap (λμ, μ s)
+⨆ (s : set α) (hs : measurable_set s), (borel ℝ≥0∞).comap (λ μ, μ s)
 
-lemma measurable_coe {s : set α} (hs : measurable_set s) : measurable (λμ : measure α, μ s) :=
+lemma measurable_coe {s : set α} (hs : measurable_set s) : measurable (λ μ : measure α, μ s) :=
 measurable.of_comap_le $ le_supr_of_le s $ le_supr_of_le hs $ le_rfl
 
 lemma measurable_of_measurable_coe (f : β → measure α)
-  (h : ∀(s : set α) (hs : measurable_set s), measurable (λb, f b s)) :
+  (h : ∀ (s : set α) (hs : measurable_set s), measurable (λ b, f b s)) :
   measurable f :=
 measurable.of_le_map $ supr₂_le $ assume s hs, measurable_space.comap_le_iff_le_map.2 $
   by rw [measurable_space.map_comp]; exact h s hs
 
+instance {α : Type*} {m : measurable_space α} : has_measurable_add₂ (measure α) :=
+begin
+  refine ⟨measure.measurable_of_measurable_coe _ (λ s hs, _)⟩,
+  simp_rw [measure.coe_add, pi.add_apply],
+  refine measurable.add _ _,
+  { exact (measure.measurable_coe hs).comp measurable_fst, },
+  { exact (measure.measurable_coe hs).comp measurable_snd, },
+end
+
 lemma measurable_measure {μ : α → measure β} :
-  measurable μ ↔ ∀(s : set β) (hs : measurable_set s), measurable (λb, μ b s) :=
+  measurable μ ↔ ∀ (s : set β) (hs : measurable_set s), measurable (λ b, μ b s) :=
 ⟨λ hμ s hs, (measurable_coe hs).comp hμ, measurable_of_measurable_coe μ⟩
 
 lemma measurable_map (f : α → β) (hf : measurable f) :
-  measurable (λμ : measure α, map f μ) :=
-measurable_of_measurable_coe _ $ assume s hs,
-  suffices measurable (λ (μ : measure α), μ (f ⁻¹' s)),
-    by simpa [map_apply, hs, hf],
-  measurable_coe (hf hs)
+  measurable (λ μ : measure α, map f μ) :=
+begin
+  refine measurable_of_measurable_coe _ (λ s hs, _),
+  simp_rw map_apply hf hs,
+  exact measurable_coe (hf hs),
+end
 
-lemma measurable_dirac :
-  measurable (measure.dirac : α → measure α) :=
-measurable_of_measurable_coe _ $ assume s hs,
-  begin
-    simp only [dirac_apply', hs],
-    exact measurable_one.indicator hs
-  end
+lemma measurable_dirac : measurable (measure.dirac : α → measure α) :=
+begin
+  refine measurable_of_measurable_coe _ (λ s hs, _),
+  simp_rw [dirac_apply' _ hs],
+  exact measurable_one.indicator hs
+end
 
 lemma measurable_lintegral {f : α → ℝ≥0∞} (hf : measurable f) :
-  measurable (λμ : measure α, ∫⁻ x, f x ∂μ) :=
+  measurable (λ μ : measure α, ∫⁻ x, f x ∂μ) :=
 begin
   simp only [lintegral_eq_supr_eapprox_lintegral, hf, simple_func.lintegral],
   refine measurable_supr (λ n, finset.measurable_sum _ (λ i _, _)),
@@ -85,21 +97,21 @@ end
 functions. -/
 def join (m : measure (measure α)) : measure α :=
 measure.of_measurable
-  (λs hs, ∫⁻ μ, μ s ∂m)
-  (by simp)
+  (λ s hs, ∫⁻ μ, μ s ∂m)
+  (by simp only [measure_empty, lintegral_const, zero_mul])
   begin
     assume f hf h,
-    simp [measure_Union h hf],
+    simp_rw [measure_Union h hf],
     apply lintegral_tsum,
-    assume i, exact measurable_coe (hf i)
+    assume i, exact (measurable_coe (hf i)).ae_measurable
   end
 
-@[simp] lemma join_apply {m : measure (measure α)} :
-  ∀{s : set α}, measurable_set s → join m s = ∫⁻ μ, μ s ∂m :=
-measure.of_measurable_apply
+@[simp] lemma join_apply {m : measure (measure α)} {s : set α} (hs : measurable_set s) :
+  join m s = ∫⁻ μ, μ s ∂m :=
+measure.of_measurable_apply s hs
 
 @[simp] lemma join_zero : (0 : measure (measure α)).join = 0 :=
-by { ext1 s hs, simp [hs] }
+by { ext1 s hs, simp only [hs, join_apply, lintegral_zero_measure, coe_zero, pi.zero_apply], }
 
 lemma measurable_join : measurable (join : measure (measure α) → measure α) :=
 measurable_of_measurable_coe _ $ assume s hs,
@@ -108,47 +120,23 @@ measurable_of_measurable_coe _ $ assume s hs,
 lemma lintegral_join {m : measure (measure α)} {f : α → ℝ≥0∞} (hf : measurable f) :
   ∫⁻ x, f x ∂(join m) = ∫⁻ μ, ∫⁻ x, f x ∂μ ∂m :=
 begin
-  rw [lintegral_eq_supr_eapprox_lintegral hf],
-  have : ∀n x,
-    join m (⇑(simple_func.eapprox (λ (a : α), f a) n) ⁻¹' {x}) =
-      ∫⁻ μ, μ ((⇑(simple_func.eapprox (λ (a : α), f a) n) ⁻¹' {x})) ∂m :=
-    assume n x, join_apply (simple_func.measurable_set_preimage _ _),
-  simp only [simple_func.lintegral, this],
-  transitivity,
-  have : ∀(s : ℕ → finset ℝ≥0∞) (f : ℕ → ℝ≥0∞ → measure α → ℝ≥0∞)
-    (hf : ∀n r, measurable (f n r)) (hm : monotone (λn μ, ∑ r in s n, r * f n r μ)),
-    (⨆n:ℕ, ∑ r in s n, r * ∫⁻ μ, f n r μ ∂m) =
-    ∫⁻ μ, ⨆n:ℕ, ∑ r in s n, r * f n r μ ∂m,
-  { assume s f hf hm,
-    symmetry,
-    transitivity,
-    apply lintegral_supr,
-    { assume n,
-      exact finset.measurable_sum _ (assume r _, (hf _ _).const_mul _) },
-    { exact hm },
-    congr, funext n,
-    transitivity,
-    apply lintegral_finset_sum,
-    { assume r _, exact (hf _ _).const_mul _ },
-    congr, funext r,
-    apply lintegral_const_mul,
-    exact hf _ _ },
-  specialize this (λn, simple_func.range (simple_func.eapprox f n)),
-  specialize this
-    (λn r μ, μ (⇑(simple_func.eapprox (λ (a : α), f a) n) ⁻¹' {r})),
-  refine this _ _; clear this,
-  { assume n r,
-    apply measurable_coe,
-    exact simple_func.measurable_set_preimage _ _ },
-  { change monotone (λn μ, (simple_func.eapprox f n).lintegral μ),
-    assume n m h μ,
-    refine simple_func.lintegral_mono _ le_rfl,
-    apply simple_func.monotone_eapprox,
-    assumption },
-  congr, funext μ,
-  symmetry,
-  apply lintegral_eq_supr_eapprox_lintegral,
-  exact hf
+  simp_rw [lintegral_eq_supr_eapprox_lintegral hf,
+    simple_func.lintegral, join_apply (simple_func.measurable_set_preimage _ _)],
+  suffices : ∀ (s : ℕ → finset ℝ≥0∞) (f : ℕ → ℝ≥0∞ → measure α → ℝ≥0∞)
+    (hf : ∀ n r, measurable (f n r)) (hm : monotone (λ n μ, ∑ r in s n, r * f n r μ)),
+    (⨆ n, ∑ r in s n, r * ∫⁻ μ, f n r μ ∂m) = ∫⁻ μ, ⨆ n, ∑ r in s n, r * f n r μ ∂m,
+  { refine this (λ n, simple_func.range (simple_func.eapprox f n))
+      (λ n r μ, μ (simple_func.eapprox f n ⁻¹' {r})) _ _,
+    { exact λ n r, measurable_coe (simple_func.measurable_set_preimage _ _), },
+    { exact λ n m h μ, simple_func.lintegral_mono (simple_func.monotone_eapprox _ h) le_rfl, }, },
+  intros s f hf hm,
+  rw lintegral_supr _ hm,
+  swap, { exact λ n, finset.measurable_sum _ (λ r _, (hf _ _).const_mul _) },
+  congr,
+  funext n,
+  rw lintegral_finset_sum (s n),
+  { simp_rw lintegral_const_mul _ (hf _ _), },
+  { exact λ r _, (hf _ _).const_mul _ },
 end
 
 /-- Monadic bind on `measure`, only works in the category of measurable spaces and measurable
@@ -164,7 +152,7 @@ begin
   ext1 s hs,
   simp only [bind, hs, join_apply, coe_zero, pi.zero_apply],
   rw [lintegral_map (measurable_coe hs) measurable_zero],
-  simp
+  simp only [pi.zero_apply, coe_zero, lintegral_const, zero_mul],
 end
 
 @[simp] lemma bind_zero_right' (m : measure α) :
@@ -176,44 +164,44 @@ bind_zero_right m
   bind m f s = ∫⁻ a, f a s ∂m :=
 by rw [bind, join_apply hs, lintegral_map (measurable_coe hs) hf]
 
-lemma measurable_bind' {g : α → measure β} (hg : measurable g) : measurable (λm, bind m g) :=
+lemma measurable_bind' {g : α → measure β} (hg : measurable g) : measurable (λ m, bind m g) :=
 measurable_join.comp (measurable_map _ hg)
 
 lemma lintegral_bind {m : measure α} {μ : α → measure β} {f : β → ℝ≥0∞}
   (hμ : measurable μ) (hf : measurable f) :
-  ∫⁻ x, f x ∂ (bind m μ) = ∫⁻ a, ∫⁻ x, f x ∂(μ a) ∂m:=
+  ∫⁻ x, f x ∂ (bind m μ) = ∫⁻ a, ∫⁻ x, f x ∂(μ a) ∂m :=
 (lintegral_join hf).trans (lintegral_map (measurable_lintegral hf) hμ)
 
 lemma bind_bind {γ} [measurable_space γ] {m : measure α} {f : α → measure β} {g : β → measure γ}
   (hf : measurable f) (hg : measurable g) :
-  bind (bind m f) g = bind m (λa, bind (f a) g) :=
-measure.ext $ assume s hs,
+  bind (bind m f) g = bind m (λ a, bind (f a) g) :=
 begin
-  rw [bind_apply hs hg, bind_apply hs ((measurable_bind' hg).comp hf), lintegral_bind hf],
-  { congr, funext a,
-    exact (bind_apply hs hg).symm },
-  exact (measurable_coe hs).comp hg
+  ext1 s hs,
+  simp_rw [bind_apply hs hg, bind_apply hs ((measurable_bind' hg).comp hf),
+    lintegral_bind hf ((measurable_coe hs).comp hg), (bind_apply hs hg)],
 end
 
 lemma bind_dirac {f : α → measure β} (hf : measurable f) (a : α) : bind (dirac a) f = f a :=
-measure.ext $ λ s hs, by rw [bind_apply hs hf, lintegral_dirac' a ((measurable_coe hs).comp hf)]
+by { ext1 s hs, rw [bind_apply hs hf, lintegral_dirac' a ((measurable_coe hs).comp hf)], }
 
 lemma dirac_bind {m : measure α} : bind m dirac = m :=
-measure.ext $ assume s hs,
-by simp [bind_apply hs measurable_dirac, dirac_apply' _ hs, lintegral_indicator 1 hs]
+begin
+  ext1 s hs,
+  simp only [bind_apply hs measurable_dirac, dirac_apply' _ hs, lintegral_indicator 1 hs,
+    pi.one_apply, lintegral_one, restrict_apply, measurable_set.univ, univ_inter],
+end
 
 lemma join_eq_bind (μ : measure (measure α)) : join μ = bind μ id :=
 by rw [bind, map_id]
 
 lemma join_map_map {f : α → β} (hf : measurable f) (μ : measure (measure α)) :
   join (map (map f) μ) = map f (join μ) :=
-measure.ext $ assume s hs,
-  begin
-    rw [join_apply hs, map_apply hf hs, join_apply,
-      lintegral_map (measurable_coe hs) (measurable_map f hf)],
-    { congr, funext ν, exact map_apply hf hs },
-    exact hf hs
-  end
+begin
+  ext1 s hs,
+  rw [join_apply hs, map_apply hf hs, join_apply (hf hs),
+    lintegral_map (measurable_coe hs) (measurable_map f hf)],
+  simp_rw map_apply hf hs,
+end
 
 lemma join_map_join (μ : measure (measure (measure α))) :
   join (map join μ) = join (join μ) :=
@@ -229,7 +217,7 @@ lemma join_map_dirac (μ : measure α) : join (map dirac μ) = μ :=
 dirac_bind
 
 lemma join_dirac (μ : measure α) : join (dirac μ) = μ :=
-eq.trans (join_eq_bind (dirac μ)) (bind_dirac measurable_id _)
+(join_eq_bind (dirac μ)).trans (bind_dirac measurable_id _)
 
 end measure
 
diff --git a/src/measure_theory/measure/haar.lean b/src/measure_theory/measure/haar.lean
deleted file mode 100644
index 1edc6cbef6c3f..0000000000000
--- a/src/measure_theory/measure/haar.lean
+++ /dev/null
@@ -1,737 +0,0 @@
-/-
-Copyright (c) 2020 Floris van Doorn. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Floris van Doorn
--/
-import measure_theory.measure.content
-import measure_theory.group.prod
-
-/-!
-# Haar measure
-
-In this file we prove the existence of Haar measure for a locally compact Hausdorff topological
-group.
-
-For the construction, we follow the write-up by Jonathan Gleason,
-*Existence and Uniqueness of Haar Measure*.
-This is essentially the same argument as in
-https://en.wikipedia.org/wiki/Haar_measure#A_construction_using_compact_subsets.
-
-We construct the Haar measure first on compact sets. For this we define `(K : U)` as the (smallest)
-number of left-translates of `U` that are needed to cover `K` (`index` in the formalization).
-Then we define a function `h` on compact sets as `lim_U (K : U) / (K₀ : U)`,
-where `U` becomes a smaller and smaller open neighborhood of `1`, and `K₀` is a fixed compact set
-with nonempty interior. This function is `chaar` in the formalization, and we define the limit
-formally using Tychonoff's theorem.
-
-This function `h` forms a content, which we can extend to an outer measure and then a measure
-(`haar_measure`).
-We normalize the Haar measure so that the measure of `K₀` is `1`.
-We show that for second countable spaces any left invariant Borel measure is a scalar multiple of
-the Haar measure.
-
-Note that `μ` need not coincide with `h` on compact sets, according to
-[halmos1950measure, ch. X, §53 p.233]. However, we know that `h(K)` lies between `μ(Kᵒ)` and `μ(K)`,
-where `ᵒ` denotes the interior.
-
-## Main Declarations
-
-* `haar_measure`: the Haar measure on a locally compact Hausdorff group. This is a left invariant
-  regular measure. It takes as argument a compact set of the group (with non-empty interior),
-  and is normalized so that the measure of the given set is 1.
-* `haar_measure_self`: the Haar measure is normalized.
-* `is_left_invariant_haar_measure`: the Haar measure is left invariant.
-* `regular_haar_measure`: the Haar measure is a regular measure.
-* `is_haar_measure_haar_measure`: the Haar measure satisfies the `is_haar_measure` typeclass, i.e.,
-  it is invariant and gives finite mass to compact sets and positive mass to nonempty open sets.
-* `haar` : some choice of a Haar measure, on a locally compact Hausdorff group, constructed as
-  `haar_measure K` where `K` is some arbitrary choice of a compact set with nonempty interior.
-
-## References
-* Paul Halmos (1950), Measure Theory, §53
-* Jonathan Gleason, Existence and Uniqueness of Haar Measure
-  - Note: step 9, page 8 contains a mistake: the last defined `μ` does not extend the `μ` on compact
-    sets, see Halmos (1950) p. 233, bottom of the page. This makes some other steps (like step 11)
-    invalid.
-* https://en.wikipedia.org/wiki/Haar_measure
--/
-noncomputable theory
-
-open set has_inv function topological_space measurable_space
-open_locale nnreal classical ennreal pointwise topological_space
-
-variables {G : Type*} [group G]
-
-namespace measure_theory
-namespace measure
-
-/-! We put the internal functions in the construction of the Haar measure in a namespace,
-  so that the chosen names don't clash with other declarations.
-  We first define a couple of the functions before proving the properties (that require that `G`
-  is a topological group). -/
-namespace haar
-
-/-- The index or Haar covering number or ratio of `K` w.r.t. `V`, denoted `(K : V)`:
-  it is the smallest number of (left) translates of `V` that is necessary to cover `K`.
-  It is defined to be 0 if no finite number of translates cover `K`. -/
-@[to_additive add_index "additive version of `measure_theory.measure.haar.index`"]
-def index (K V : set G) : ℕ :=
-Inf $ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V }
-
-@[to_additive add_index_empty]
-lemma index_empty {V : set G} : index ∅ V = 0 :=
-begin
-  simp only [index, nat.Inf_eq_zero], left, use ∅,
-  simp only [finset.card_empty, empty_subset, mem_set_of_eq, eq_self_iff_true, and_self],
-end
-
-variables [topological_space G]
-
-/-- `prehaar K₀ U K` is a weighted version of the index, defined as `(K : U)/(K₀ : U)`.
-  In the applications `K₀` is compact with non-empty interior, `U` is open containing `1`,
-  and `K` is any compact set.
-  The argument `K` is a (bundled) compact set, so that we can consider `prehaar K₀ U` as an
-  element of `haar_product` (below). -/
-@[to_additive "additive version of `measure_theory.measure.haar.prehaar`"]
-def prehaar (K₀ U : set G) (K : compacts G) : ℝ := (index (K : set G) U : ℝ) / index K₀ U
-
-@[to_additive]
-lemma prehaar_empty (K₀ : positive_compacts G) {U : set G} : prehaar (K₀ : set G) U ⊥ = 0 :=
-by rw [prehaar, compacts.coe_bot, index_empty, nat.cast_zero, zero_div]
-
-@[to_additive]
-lemma prehaar_nonneg (K₀ : positive_compacts G) {U : set G} (K : compacts G) :
-  0 ≤ prehaar (K₀ : set G) U K :=
-by apply div_nonneg; norm_cast; apply zero_le
-
-/-- `haar_product K₀` is the product of intervals `[0, (K : K₀)]`, for all compact sets `K`.
-  For all `U`, we can show that `prehaar K₀ U ∈ haar_product K₀`. -/
-@[to_additive "additive version of `measure_theory.measure.haar.haar_product`"]
-def haar_product (K₀ : set G) : set (compacts G → ℝ) :=
-pi univ (λ K, Icc 0 $ index (K : set G) K₀)
-
-@[simp, to_additive]
-lemma mem_prehaar_empty {K₀ : set G} {f : compacts G → ℝ} :
-  f ∈ haar_product K₀ ↔ ∀ K : compacts G, f K ∈ Icc (0 : ℝ) (index (K : set G) K₀) :=
-by simp only [haar_product, pi, forall_prop_of_true, mem_univ, mem_set_of_eq]
-
-/-- The closure of the collection of elements of the form `prehaar K₀ U`,
-  for `U` open neighbourhoods of `1`, contained in `V`. The closure is taken in the space
-  `compacts G → ℝ`, with the topology of pointwise convergence.
-  We show that the intersection of all these sets is nonempty, and the Haar measure
-  on compact sets is defined to be an element in the closure of this intersection. -/
-@[to_additive "additive version of `measure_theory.measure.haar.cl_prehaar`"]
-def cl_prehaar (K₀ : set G) (V : open_nhds_of (1 : G)) : set (compacts G → ℝ) :=
-closure $ prehaar K₀ '' { U : set G | U ⊆ V.1 ∧ is_open U ∧ (1 : G) ∈ U }
-
-variables [topological_group G]
-
-/-!
-### Lemmas about `index`
--/
-
-/-- If `K` is compact and `V` has nonempty interior, then the index `(K : V)` is well-defined,
-  there is a finite set `t` satisfying the desired properties. -/
-@[to_additive add_index_defined]
-lemma index_defined {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
-  ∃ n : ℕ, n ∈ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V } :=
-by { rcases compact_covered_by_mul_left_translates hK hV with ⟨t, ht⟩, exact ⟨t.card, t, ht, rfl⟩ }
-
-@[to_additive add_index_elim]
-lemma index_elim {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
-  ∃ (t : finset G), K ⊆ (⋃ g ∈ t, (λ h, g * h) ⁻¹' V) ∧ finset.card t = index K V :=
-by { have := nat.Inf_mem (index_defined hK hV), rwa [mem_image] at this }
-
-@[to_additive le_add_index_mul]
-lemma le_index_mul (K₀ : positive_compacts G) (K : compacts G) {V : set G}
-  (hV : (interior V).nonempty) :
-  index (K : set G) V ≤ index (K : set G) K₀ * index (K₀ : set G) V :=
-begin
-  obtain ⟨s, h1s, h2s⟩ := index_elim K.compact K₀.interior_nonempty,
-  obtain ⟨t, h1t, h2t⟩ := index_elim K₀.compact hV,
-  rw [← h2s, ← h2t, mul_comm],
-  refine le_trans _ finset.mul_card_le,
-  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq], refine subset.trans h1s _,
-  apply Union₂_subset, intros g₁ hg₁, rw preimage_subset_iff, intros g₂ hg₂,
-  have := h1t hg₂,
-  rcases this with ⟨_, ⟨g₃, rfl⟩, A, ⟨hg₃, rfl⟩, h2V⟩, rw [mem_preimage, ← mul_assoc] at h2V,
-  exact mem_bUnion (finset.mul_mem_mul hg₃ hg₁) h2V
-end
-
-@[to_additive add_index_pos]
-lemma index_pos (K : positive_compacts G) {V : set G} (hV : (interior V).nonempty) :
-  0 < index (K : set G) V :=
-begin
-  unfold index, rw [nat.Inf_def, nat.find_pos, mem_image],
-  { rintro ⟨t, h1t, h2t⟩, rw [finset.card_eq_zero] at h2t, subst h2t,
-    obtain ⟨g, hg⟩ := K.interior_nonempty,
-    show g ∈ (∅ : set G), convert h1t (interior_subset hg), symmetry, apply bUnion_empty },
-  { exact index_defined K.compact hV }
-end
-
-@[to_additive add_index_mono]
-lemma index_mono {K K' V : set G} (hK' : is_compact K') (h : K ⊆ K')
-  (hV : (interior V).nonempty) : index K V ≤ index K' V :=
-begin
-  rcases index_elim hK' hV with ⟨s, h1s, h2s⟩,
-  apply nat.Inf_le, rw [mem_image], refine ⟨s, subset.trans h h1s, h2s⟩
-end
-
-@[to_additive add_index_union_le]
-lemma index_union_le (K₁ K₂ : compacts G) {V : set G} (hV : (interior V).nonempty) :
-  index (K₁.1 ∪ K₂.1) V ≤ index K₁.1 V + index K₂.1 V :=
-begin
-  rcases index_elim K₁.2 hV with ⟨s, h1s, h2s⟩,
-  rcases index_elim K₂.2 hV with ⟨t, h1t, h2t⟩,
-  rw [← h2s, ← h2t],
-  refine le_trans _ (finset.card_union_le _ _),
-  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
-  apply union_subset; refine subset.trans (by assumption) _; apply bUnion_subset_bUnion_left;
-    intros g hg; simp only [mem_def] at hg;
-    simp only [mem_def, multiset.mem_union, finset.union_val, hg, or_true, true_or]
-end
-
-@[to_additive add_index_union_eq]
-lemma index_union_eq (K₁ K₂ : compacts G) {V : set G} (hV : (interior V).nonempty)
-  (h : disjoint (K₁.1 * V⁻¹) (K₂.1 * V⁻¹)) :
-  index (K₁.1 ∪ K₂.1) V = index K₁.1 V + index K₂.1 V :=
-begin
-  apply le_antisymm (index_union_le K₁ K₂ hV),
-  rcases index_elim (K₁.2.union K₂.2) hV with ⟨s, h1s, h2s⟩, rw [← h2s],
-  have : ∀ (K : set G) , K ⊆ (⋃ g ∈ s, (λ h, g * h) ⁻¹' V) →
-    index K V ≤ (s.filter (λ g, ((λ (h : G), g * h) ⁻¹' V ∩ K).nonempty)).card,
-  { intros K hK, apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
-    intros g hg, rcases hK hg with ⟨_, ⟨g₀, rfl⟩, _, ⟨h1g₀, rfl⟩, h2g₀⟩,
-    simp only [mem_preimage] at h2g₀,
-    simp only [mem_Union], use g₀, split,
-    { simp only [finset.mem_filter, h1g₀, true_and], use g,
-      simp only [hg, h2g₀, mem_inter_eq, mem_preimage, and_self] },
-    exact h2g₀ },
-  refine le_trans (add_le_add (this K₁.1 $ subset.trans (subset_union_left _ _) h1s)
-    (this K₂.1 $ subset.trans (subset_union_right _ _) h1s)) _,
-  rw [← finset.card_union_eq, finset.filter_union_right],
-  exact s.card_filter_le _,
-  apply finset.disjoint_filter.mpr,
-  rintro g₁ h1g₁ ⟨g₂, h1g₂, h2g₂⟩ ⟨g₃, h1g₃, h2g₃⟩,
-  simp only [mem_preimage] at h1g₃ h1g₂,
-  apply @h g₁⁻¹,
-  split; simp only [set.mem_inv, set.mem_mul, exists_exists_and_eq_and, exists_and_distrib_left],
-  { refine ⟨_, h2g₂, (g₁ * g₂)⁻¹, _, _⟩, simp only [inv_inv, h1g₂],
-    simp only [mul_inv_rev, mul_inv_cancel_left] },
-  { refine ⟨_, h2g₃, (g₁ * g₃)⁻¹, _, _⟩, simp only [inv_inv, h1g₃],
-    simp only [mul_inv_rev, mul_inv_cancel_left] }
-end
-
-@[to_additive add_left_add_index_le]
-lemma mul_left_index_le {K : set G} (hK : is_compact K) {V : set G} (hV : (interior V).nonempty)
-  (g : G) : index ((λ h, g * h) '' K) V ≤ index K V :=
-begin
-  rcases index_elim hK hV with ⟨s, h1s, h2s⟩, rw [← h2s],
-  apply nat.Inf_le, rw [mem_image],
-  refine ⟨s.map (equiv.mul_right g⁻¹).to_embedding, _, finset.card_map _⟩,
-  { simp only [mem_set_of_eq], refine subset.trans (image_subset _ h1s) _,
-    rintro _ ⟨g₁, ⟨_, ⟨g₂, rfl⟩, ⟨_, ⟨hg₂, rfl⟩, hg₁⟩⟩, rfl⟩,
-    simp only [mem_preimage] at hg₁, simp only [exists_prop, mem_Union, finset.mem_map,
-      equiv.coe_mul_right, exists_exists_and_eq_and, mem_preimage, equiv.to_embedding_apply],
-    refine ⟨_, hg₂, _⟩, simp only [mul_assoc, hg₁, inv_mul_cancel_left] }
-end
-
-@[to_additive is_left_invariant_add_index]
-lemma is_left_invariant_index {K : set G} (hK : is_compact K) (g : G) {V : set G}
-  (hV : (interior V).nonempty) : index ((λ h, g * h) '' K) V = index K V :=
-begin
-  refine le_antisymm (mul_left_index_le hK hV g) _,
-  convert mul_left_index_le (hK.image $ continuous_mul_left g) hV g⁻¹,
-  rw [image_image], symmetry, convert image_id' _, ext h, apply inv_mul_cancel_left
-end
-
-/-!
-### Lemmas about `prehaar`
--/
-
-@[to_additive add_prehaar_le_add_index]
-lemma prehaar_le_index (K₀ : positive_compacts G) {U : set G} (K : compacts G)
-  (hU : (interior U).nonempty) : prehaar (K₀ : set G) U K ≤ index (K : set G) K₀ :=
-begin
-  unfold prehaar, rw [div_le_iff]; norm_cast,
-  { apply le_index_mul K₀ K hU },
-  { exact index_pos K₀ hU }
-end
-
-@[to_additive]
-lemma prehaar_pos (K₀ : positive_compacts G) {U : set G} (hU : (interior U).nonempty)
-  {K : set G} (h1K : is_compact K) (h2K : (interior K).nonempty) :
-  0 < prehaar (K₀ : set G) U ⟨K, h1K⟩ :=
-by { apply div_pos; norm_cast, apply index_pos ⟨⟨K, h1K⟩, h2K⟩ hU, exact index_pos K₀ hU }
-
-@[to_additive]
-lemma prehaar_mono {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
-  {K₁ K₂ : compacts G} (h : (K₁ : set G) ⊆ K₂.1) :
-  prehaar (K₀ : set G) U K₁ ≤ prehaar (K₀ : set G) U K₂ :=
-begin
-  simp only [prehaar], rw [div_le_div_right], exact_mod_cast index_mono K₂.2 h hU,
-  exact_mod_cast index_pos K₀ hU
-end
-
-@[to_additive]
-lemma prehaar_self {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty) :
-  prehaar (K₀ : set G) U K₀.to_compacts = 1 :=
-div_self $ ne_of_gt $ by exact_mod_cast index_pos K₀ hU
-
-@[to_additive]
-lemma prehaar_sup_le {K₀ : positive_compacts G} {U : set G} (K₁ K₂ : compacts G)
-  (hU : (interior U).nonempty) :
-  prehaar (K₀ : set G) U (K₁ ⊔ K₂) ≤ prehaar (K₀ : set G) U K₁ + prehaar (K₀ : set G) U K₂ :=
-begin
-  simp only [prehaar], rw [div_add_div_same, div_le_div_right],
-  exact_mod_cast index_union_le K₁ K₂ hU, exact_mod_cast index_pos K₀ hU
-end
-
-@[to_additive]
-lemma prehaar_sup_eq {K₀ : positive_compacts G} {U : set G} {K₁ K₂ : compacts G}
-  (hU : (interior U).nonempty) (h : disjoint (K₁.1 * U⁻¹) (K₂.1 * U⁻¹)) :
-  prehaar (K₀ : set G) U (K₁ ⊔ K₂) = prehaar (K₀ : set G) U K₁ + prehaar (K₀ : set G) U K₂ :=
-by { simp only [prehaar], rw [div_add_div_same], congr', exact_mod_cast index_union_eq K₁ K₂ hU h }
-
-@[to_additive]
-lemma is_left_invariant_prehaar {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
-  (g : G) (K : compacts G) :
-  prehaar (K₀ : set G) U (K.map _ $ continuous_mul_left g) = prehaar (K₀ : set G) U K :=
-by simp only [prehaar, compacts.coe_map, is_left_invariant_index K.compact _ hU]
-
-/-!
-### Lemmas about `haar_product`
--/
-
-@[to_additive]
-lemma prehaar_mem_haar_product (K₀ : positive_compacts G) {U : set G} (hU : (interior U).nonempty) :
-  prehaar (K₀ : set G) U ∈ haar_product (K₀ : set G) :=
-by { rintro ⟨K, hK⟩ h2K, rw [mem_Icc], exact ⟨prehaar_nonneg K₀ _, prehaar_le_index K₀ _ hU⟩ }
-
-@[to_additive]
-lemma nonempty_Inter_cl_prehaar (K₀ : positive_compacts G) :
-  (haar_product (K₀ : set G) ∩ ⋂ (V : open_nhds_of (1 : G)), cl_prehaar K₀ V).nonempty :=
-begin
-  have : is_compact (haar_product (K₀ : set G)),
-  { apply is_compact_univ_pi, intro K, apply is_compact_Icc },
-  refine this.inter_Inter_nonempty (cl_prehaar K₀) (λ s, is_closed_closure) (λ t, _),
-  let V₀ := ⋂ (V ∈ t), (V : open_nhds_of 1).1,
-  have h1V₀ : is_open V₀,
-  { apply is_open_bInter, apply finite_mem_finset, rintro ⟨V, hV⟩ h2V, exact hV.1 },
-  have h2V₀ : (1 : G) ∈ V₀, { simp only [mem_Inter], rintro ⟨V, hV⟩ h2V, exact hV.2 },
-  refine ⟨prehaar K₀ V₀, _⟩,
-  split,
-  { apply prehaar_mem_haar_product K₀, use 1, rwa h1V₀.interior_eq },
-  { simp only [mem_Inter], rintro ⟨V, hV⟩ h2V, apply subset_closure,
-    apply mem_image_of_mem, rw [mem_set_of_eq],
-    exact ⟨subset.trans (Inter_subset _ ⟨V, hV⟩) (Inter_subset _ h2V), h1V₀, h2V₀⟩ },
-end
-
-/-!
-### Lemmas about `chaar`
--/
-
-/-- This is the "limit" of `prehaar K₀ U K` as `U` becomes a smaller and smaller open
-  neighborhood of `(1 : G)`. More precisely, it is defined to be an arbitrary element
-  in the intersection of all the sets `cl_prehaar K₀ V` in `haar_product K₀`.
-  This is roughly equal to the Haar measure on compact sets,
-  but it can differ slightly. We do know that
-  `haar_measure K₀ (interior K) ≤ chaar K₀ K ≤ haar_measure K₀ K`. -/
-@[to_additive add_chaar "additive version of `measure_theory.measure.haar.chaar`"]
-def chaar (K₀ : positive_compacts G) (K : compacts G) : ℝ :=
-classical.some (nonempty_Inter_cl_prehaar K₀) K
-
-@[to_additive add_chaar_mem_add_haar_product]
-lemma chaar_mem_haar_product (K₀ : positive_compacts G) : chaar K₀ ∈ haar_product (K₀ : set G) :=
-(classical.some_spec (nonempty_Inter_cl_prehaar K₀)).1
-
-@[to_additive add_chaar_mem_cl_add_prehaar]
-lemma chaar_mem_cl_prehaar (K₀ : positive_compacts G) (V : open_nhds_of (1 : G)) :
-  chaar K₀ ∈ cl_prehaar (K₀ : set G) V :=
-by { have := (classical.some_spec (nonempty_Inter_cl_prehaar K₀)).2, rw [mem_Inter] at this,
-     exact this V }
-
-@[to_additive add_chaar_nonneg]
-lemma chaar_nonneg (K₀ : positive_compacts G) (K : compacts G) : 0 ≤ chaar K₀ K :=
-by { have := chaar_mem_haar_product K₀ K (mem_univ _), rw mem_Icc at this, exact this.1 }
-
-@[to_additive add_chaar_empty]
-lemma chaar_empty (K₀ : positive_compacts G) : chaar K₀ ⊥ = 0 :=
-begin
-  let eval : (compacts G → ℝ) → ℝ := λ f, f ⊥,
-  have : continuous eval := continuous_apply ⊥,
-  show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
-  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
-  unfold cl_prehaar, rw is_closed.closure_subset_iff,
-  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_empty },
-  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
-end
-
-@[to_additive add_chaar_self]
-lemma chaar_self (K₀ : positive_compacts G) : chaar K₀ K₀.to_compacts = 1 :=
-begin
-  let eval : (compacts G → ℝ) → ℝ := λ f, f K₀.to_compacts,
-  have : continuous eval := continuous_apply _,
-  show chaar K₀ ∈ eval ⁻¹' {(1 : ℝ)},
-  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
-  unfold cl_prehaar, rw is_closed.closure_subset_iff,
-  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_self,
-    rw h2U.interior_eq, exact ⟨1, h3U⟩ },
-  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton }
-end
-
-@[to_additive add_chaar_mono]
-lemma chaar_mono {K₀ : positive_compacts G} {K₁ K₂ : compacts G} (h : (K₁ : set G) ⊆ K₂) :
-  chaar K₀ K₁ ≤ chaar K₀ K₂ :=
-begin
-  let eval : (compacts G → ℝ) → ℝ := λ f, f K₂ - f K₁,
-  have : continuous eval := (continuous_apply K₂).sub (continuous_apply K₁),
-  rw [← sub_nonneg], show chaar K₀ ∈ eval ⁻¹' (Ici (0 : ℝ)),
-  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
-  unfold cl_prehaar, rw is_closed.closure_subset_iff,
-  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, simp only [mem_preimage, mem_Ici, eval, sub_nonneg],
-    apply prehaar_mono _ h, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
-  { apply continuous_iff_is_closed.mp this, exact is_closed_Ici },
-end
-
-@[to_additive add_chaar_sup_le]
-lemma chaar_sup_le {K₀ : positive_compacts G} (K₁ K₂ : compacts G) :
-  chaar K₀ (K₁ ⊔ K₂) ≤ chaar K₀ K₁ + chaar K₀ K₂ :=
-begin
-  let eval : (compacts G → ℝ) → ℝ := λ f, f K₁ + f K₂ - f (K₁ ⊔ K₂),
-  have : continuous eval :=
-    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
-      (continuous_apply (K₁ ⊔ K₂)),
-  rw [← sub_nonneg], show chaar K₀ ∈ eval ⁻¹' (Ici (0 : ℝ)),
-  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
-  unfold cl_prehaar, rw is_closed.closure_subset_iff,
-  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, simp only [mem_preimage, mem_Ici, eval, sub_nonneg],
-    apply prehaar_sup_le, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
-  { apply continuous_iff_is_closed.mp this, exact is_closed_Ici },
-end
-
-@[to_additive add_chaar_sup_eq]
-lemma chaar_sup_eq [t2_space G] {K₀ : positive_compacts G} {K₁ K₂ : compacts G}
-  (h : disjoint K₁.1 K₂.1) : chaar K₀ (K₁ ⊔ K₂) = chaar K₀ K₁ + chaar K₀ K₂ :=
-begin
-  rcases compact_compact_separated K₁.2 K₂.2 (disjoint_iff.mp h) with
-    ⟨U₁, U₂, h1U₁, h1U₂, h2U₁, h2U₂, hU⟩,
-  rw [← disjoint_iff_inter_eq_empty] at hU,
-  rcases compact_open_separated_mul_right K₁.2 h1U₁ h2U₁ with ⟨L₁, h1L₁, h2L₁⟩,
-  rcases mem_nhds_iff.mp h1L₁ with ⟨V₁, h1V₁, h2V₁, h3V₁⟩,
-  replace h2L₁ := subset.trans (mul_subset_mul_left h1V₁) h2L₁,
-  rcases compact_open_separated_mul_right K₂.2 h1U₂ h2U₂ with ⟨L₂, h1L₂, h2L₂⟩,
-  rcases mem_nhds_iff.mp h1L₂ with ⟨V₂, h1V₂, h2V₂, h3V₂⟩,
-  replace h2L₂ := subset.trans (mul_subset_mul_left h1V₂) h2L₂,
-  let eval : (compacts G → ℝ) → ℝ := λ f, f K₁ + f K₂ - f (K₁ ⊔ K₂),
-  have : continuous eval :=
-    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
-      (continuous_apply (K₁ ⊔ K₂)),
-  rw [eq_comm, ← sub_eq_zero], show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
-  let V := V₁ ∩ V₂,
-  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀
-    ⟨V⁻¹, (is_open.inter h2V₁ h2V₂).preimage continuous_inv,
-    by simp only [mem_inv, one_inv, h3V₁, h3V₂, V, mem_inter_eq, true_and]⟩),
-  unfold cl_prehaar, rw is_closed.closure_subset_iff,
-  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩,
-    simp only [mem_preimage, eval, sub_eq_zero, mem_singleton_iff], rw [eq_comm],
-    apply prehaar_sup_eq,
-    { rw h2U.interior_eq, exact ⟨1, h3U⟩ },
-    { refine disjoint_of_subset _ _ hU,
-      { refine subset.trans (mul_subset_mul subset.rfl _) h2L₁,
-        exact subset.trans (inv_subset.mpr h1U) (inter_subset_left _ _) },
-      { refine subset.trans (mul_subset_mul subset.rfl _) h2L₂,
-        exact subset.trans (inv_subset.mpr h1U) (inter_subset_right _ _) }}},
-  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton }
-end
-
-@[to_additive is_left_invariant_add_chaar]
-lemma is_left_invariant_chaar {K₀ : positive_compacts G} (g : G) (K : compacts G) :
-  chaar K₀ (K.map _ $ continuous_mul_left g) = chaar K₀ K :=
-begin
-  let eval : (compacts G → ℝ) → ℝ := λ f, f (K.map _ $ continuous_mul_left g) - f K,
-  have : continuous eval := (continuous_apply (K.map _ _)).sub (continuous_apply K),
-  rw [← sub_eq_zero], show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
-  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⟨set.univ, is_open_univ, mem_univ _⟩),
-  unfold cl_prehaar, rw is_closed.closure_subset_iff,
-  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩,
-    simp only [mem_singleton_iff, mem_preimage, eval, sub_eq_zero],
-    apply is_left_invariant_prehaar, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
-  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
-end
-
-variable [t2_space G]
-
-/-- The function `chaar` interpreted in `ℝ≥0`, as a content -/
-@[to_additive "additive version of `measure_theory.measure.haar.haar_content`"]
-def haar_content (K₀ : positive_compacts G) : content G :=
-{ to_fun        := λ K, ⟨chaar K₀ K, chaar_nonneg _ _⟩,
-  mono'         := λ K₁ K₂ h, by simp only [←nnreal.coe_le_coe, subtype.coe_mk, chaar_mono, h],
-  sup_disjoint' := λ K₁ K₂ h, by { simp only [chaar_sup_eq h], refl },
-  sup_le'       := λ K₁ K₂,
-    by simp only [←nnreal.coe_le_coe, nnreal.coe_add, subtype.coe_mk, chaar_sup_le] }
-
-/-! We only prove the properties for `haar_content` that we use at least twice below. -/
-
-@[to_additive]
-lemma haar_content_apply (K₀ : positive_compacts G) (K : compacts G) :
-  haar_content K₀ K = show nnreal, from ⟨chaar K₀ K, chaar_nonneg _ _⟩ := rfl
-
-/-- The variant of `chaar_self` for `haar_content` -/
-@[to_additive]
-lemma haar_content_self {K₀ : positive_compacts G} : haar_content K₀ K₀.to_compacts = 1 :=
-by { simp_rw [← ennreal.coe_one, haar_content_apply, ennreal.coe_eq_coe, chaar_self], refl }
-
-/-- The variant of `is_left_invariant_chaar` for `haar_content` -/
-@[to_additive]
-lemma is_left_invariant_haar_content {K₀ : positive_compacts G} (g : G) (K : compacts G) :
-  haar_content K₀ (K.map _ $ continuous_mul_left g) = haar_content K₀ K :=
-by simpa only [ennreal.coe_eq_coe, ←nnreal.coe_eq, haar_content_apply]
-  using is_left_invariant_chaar g K
-
-@[to_additive]
-lemma haar_content_outer_measure_self_pos {K₀ : positive_compacts G} :
-  0 < (haar_content K₀).outer_measure K₀ :=
-begin
-  apply ennreal.zero_lt_one.trans_le,
-  rw [content.outer_measure_eq_infi],
-  refine le_infi₂ (λ U hU, le_infi $ λ hK₀, le_trans _ $ le_supr₂ K₀.to_compacts hK₀),
-  exact haar_content_self.ge,
-end
-
-end haar
-open haar
-
-/-!
-### The Haar measure
--/
-
-variables [topological_space G] [t2_space G] [topological_group G] [measurable_space G]
-  [borel_space G]
-
-/-- The Haar measure on the locally compact group `G`, scaled so that `haar_measure K₀ K₀ = 1`. -/
-@[to_additive "The Haar measure on the locally compact additive group `G`,
-scaled so that `add_haar_measure K₀ K₀ = 1`."]
-def haar_measure (K₀ : positive_compacts G) : measure G :=
-((haar_content K₀).outer_measure K₀)⁻¹ • (haar_content K₀).measure
-
-@[to_additive]
-lemma haar_measure_apply {K₀ : positive_compacts G} {s : set G} (hs : measurable_set s) :
-  haar_measure K₀ s = (haar_content K₀).outer_measure s / (haar_content K₀).outer_measure K₀ :=
-begin
-  change (((haar_content K₀).outer_measure) K₀)⁻¹ * (haar_content K₀).measure s = _,
-  simp only [hs, div_eq_mul_inv, mul_comm, content.measure_apply],
-end
-
-@[to_additive]
-instance is_mul_left_invariant_haar_measure (K₀ : positive_compacts G) :
-  is_mul_left_invariant (haar_measure K₀) :=
-begin
-  rw [← forall_measure_preimage_mul_iff],
-  intros g A hA,
-  rw [haar_measure_apply hA, haar_measure_apply (measurable_const_mul g hA)],
-  congr' 1,
-  apply content.is_mul_left_invariant_outer_measure,
-  apply is_left_invariant_haar_content,
-end
-
-@[to_additive]
-lemma haar_measure_self {K₀ : positive_compacts G} : haar_measure K₀ K₀ = 1 :=
-begin
-  haveI : locally_compact_space G := K₀.locally_compact_space_of_group,
-  rw [haar_measure_apply K₀.compact.measurable_set, ennreal.div_self],
-  { rw [← pos_iff_ne_zero], exact haar_content_outer_measure_self_pos },
-  { exact (content.outer_measure_lt_top_of_is_compact _ K₀.compact).ne }
-end
-
-/-- The Haar measure is regular. -/
-@[to_additive]
-instance regular_haar_measure {K₀ : positive_compacts G} :
-  (haar_measure K₀).regular :=
-begin
-  haveI : locally_compact_space G := K₀.locally_compact_space_of_group,
-  apply regular.smul,
-  rw ennreal.inv_ne_top,
-  exact haar_content_outer_measure_self_pos.ne',
-end
-
-/-- The Haar measure is sigma-finite in a second countable group. -/
-@[to_additive]
-instance sigma_finite_haar_measure [second_countable_topology G] {K₀ : positive_compacts G} :
-  sigma_finite (haar_measure K₀) :=
-by { haveI : locally_compact_space G := K₀.locally_compact_space_of_group, apply_instance, }
-
-/-- The Haar measure is a Haar measure, i.e., it is invariant and gives finite mass to compact
-sets and positive mass to nonempty open sets. -/
-@[to_additive]
-instance is_haar_measure_haar_measure (K₀ : positive_compacts G) :
-  is_haar_measure (haar_measure K₀) :=
-begin
-  apply is_haar_measure_of_is_compact_nonempty_interior (haar_measure K₀) K₀ K₀.compact
-    K₀.interior_nonempty,
-  { simp only [haar_measure_self], exact one_ne_zero },
-  { simp only [haar_measure_self], exact ennreal.coe_ne_top },
-end
-
-/-- `haar` is some choice of a Haar measure, on a locally compact group. -/
-@[reducible, to_additive "`add_haar` is some choice of a Haar measure, on a locally compact
-additive group."]
-def haar [locally_compact_space G] : measure G := haar_measure $ classical.arbitrary _
-
-section second_countable
-
-variables [second_countable_topology G]
-
-/-- The Haar measure is unique up to scaling. More precisely: every σ-finite left invariant measure
-  is a scalar multiple of the Haar measure.
-  This is slightly weaker than assuming that `μ` is a Haar measure (in particular we don't require
-  `μ ≠ 0`). -/
-@[to_additive]
-theorem haar_measure_unique (μ : measure G) [sigma_finite μ] [is_mul_left_invariant μ]
-  (K₀ : positive_compacts G) : μ = μ K₀ • haar_measure K₀ :=
-begin
-  refine (measure_eq_div_smul μ (haar_measure K₀) K₀.compact.measurable_set
-    (measure_pos_of_nonempty_interior _ K₀.interior_nonempty).ne'
-    K₀.compact.measure_lt_top.ne).trans _,
-  rw [haar_measure_self, ennreal.div_one]
-end
-
-example [locally_compact_space G] (μ : measure G) [is_haar_measure μ] (K₀ : positive_compacts G) :
-  μ = μ K₀.1 • haar_measure K₀ :=
-haar_measure_unique μ K₀
-
-/-- To show that an invariant σ-finite measure is regular it is sufficient to show that it is finite
-  on some compact set with non-empty interior. -/
-@[to_additive]
-theorem regular_of_is_mul_left_invariant {μ : measure G} [sigma_finite μ] [is_mul_left_invariant μ]
-  {K : set G} (hK : is_compact K) (h2K : (interior K).nonempty) (hμK : μ K ≠ ∞) :
-  regular μ :=
-by { rw [haar_measure_unique μ ⟨⟨K, hK⟩, h2K⟩], exact regular.smul hμK }
-
-@[to_additive is_add_haar_measure_eq_smul_is_add_haar_measure]
-theorem is_haar_measure_eq_smul_is_haar_measure
-  [locally_compact_space G] (μ ν : measure G) [is_haar_measure μ] [is_haar_measure ν] :
-  ∃ (c : ℝ≥0∞), c ≠ 0 ∧ c ≠ ∞ ∧ μ = c • ν :=
-begin
-  have K : positive_compacts G := classical.arbitrary _,
-  have νpos : 0 < ν K := measure_pos_of_nonempty_interior _ K.interior_nonempty,
-  have νne : ν K ≠ ∞ := K.compact.measure_lt_top.ne,
-  refine ⟨μ K / ν K, _, _, _⟩,
-  { simp only [νne, (μ.measure_pos_of_nonempty_interior K.interior_nonempty).ne', ne.def,
-      ennreal.div_zero_iff, not_false_iff, or_self] },
-  { simp only [div_eq_mul_inv, νpos.ne', (K.compact.measure_lt_top).ne, or_self,
-      ennreal.inv_eq_top, with_top.mul_eq_top_iff, ne.def, not_false_iff, and_false, false_and] },
-  { calc
-    μ = μ K • haar_measure K : haar_measure_unique μ K
-    ... = (μ K / ν K) • (ν K • haar_measure K) :
-      by rw [smul_smul, div_eq_mul_inv, mul_assoc, ennreal.inv_mul_cancel νpos.ne' νne, mul_one]
-    ... = (μ K / ν K) • ν : by rw ← haar_measure_unique ν K }
-end
-
-@[priority 90, to_additive] -- see Note [lower instance priority]
-instance regular_of_is_haar_measure
-  [locally_compact_space G] (μ : measure G) [is_haar_measure μ] :
-  regular μ :=
-begin
-  have K : positive_compacts G := classical.arbitrary _,
-  obtain ⟨c, c0, ctop, hμ⟩ : ∃ (c : ℝ≥0∞), (c ≠ 0) ∧ (c ≠ ∞) ∧ (μ = c • haar_measure K) :=
-    is_haar_measure_eq_smul_is_haar_measure μ _,
-  rw hμ,
-  exact regular.smul ctop,
-end
-
-/-- **Steinhaus Theorem** In any locally compact group `G` with a haar measure `μ`, for any
-  measurable set `E` of positive measure, the set `E / E` is a neighbourhood of `1`. -/
-@[to_additive "**Steinhaus Theorem** In any locally compact group `G` with a haar measure `μ`,
-  for any measurable set `E` of positive measure, the set `E - E` is a neighbourhood of `0`."]
-theorem div_mem_nhds_one_of_haar_pos (μ : measure G) [is_haar_measure μ] [locally_compact_space G]
-  (E : set G) (hE : measurable_set E) (hEpos : 0 < μ E) :
-  E / E ∈ 𝓝 (1 : G) :=
-begin
-  /- For any regular measure `μ` and set `E` of positive measure, we can find a compact set `K` of
-     positive measure inside `E`. Further, for any outer regular measure `μ` there exists an open
-     set `U` containing `K` with measure arbitrarily close to `K` (here `μ U < 2 * μ K` suffices).
-     Then, we can pick an open neighborhood of `1`, say `V` such that such that `V * K` is contained
-     in `U`. Now note that for any `v` in `V`, the sets `K` and `{v} * K` can not be disjoint
-     because they are both of measure `μ K` (since `μ` is left regular) and also contained in `U`,
-     yet we have that `μ U < 2 * μ K`. This show that `K / K` contains the neighborhood `V` of `1`,
-     and therefore that it is itself such a neighborhood. -/
-  obtain ⟨L, hL, hLE, hLpos, hLtop⟩ : ∃ (L : set G), measurable_set L ∧ L ⊆ E ∧ 0 < μ L ∧ μ L < ∞,
-    from exists_subset_measure_lt_top hE hEpos,
-  obtain ⟨K, hKL, hK, hKpos⟩ : ∃ (K : set G) (H : K ⊆ L), is_compact K ∧ 0 < μ K,
-    from measurable_set.exists_lt_is_compact_of_ne_top hL (ne_of_lt hLtop) hLpos,
-  have hKtop : μ K ≠ ∞,
-  { apply ne_top_of_le_ne_top (ne_of_lt hLtop),
-    apply measure_mono hKL },
-  obtain ⟨U, hUK, hU, hμUK⟩ : ∃ (U : set G) (H : U ⊇ K), is_open U ∧ μ U < μ K + μ K,
-   from set.exists_is_open_lt_add K hKtop hKpos.ne',
-  obtain ⟨V, hV1, hVKU⟩ : ∃ (V ∈ 𝓝 (1 : G)), V * K ⊆ U,
-    from compact_open_separated_mul_left hK hU hUK,
-  have hv : ∀ (v : G), v ∈ V → ¬ disjoint ({v}* K) K,
-  { intros v hv hKv,
-    have hKvsub : {v} * K ∪ K ⊆ U,
-    { apply set.union_subset _ hUK,
-      apply subset_trans _ hVKU,
-      apply set.mul_subset_mul _ (set.subset.refl K),
-      simp only [set.singleton_subset_iff, hv] },
-    replace hKvsub := @measure_mono _ _ μ _ _ hKvsub,
-    have hcontr := lt_of_le_of_lt hKvsub hμUK,
-    rw measure_union hKv (is_compact.measurable_set hK) at hcontr,
-    have hKtranslate : μ ({v} * K) = μ K,
-      by simp only [singleton_mul, image_mul_left, measure_preimage_mul],
-    rw [hKtranslate, lt_self_iff_false] at hcontr,
-    assumption },
-  suffices : V ⊆ E / E, from filter.mem_of_superset hV1 this,
-  assume v hvV,
-  obtain ⟨x, hxK, hxvK⟩ : ∃ (x : G), x ∈ {v} * K ∧ x ∈ K, from set.not_disjoint_iff.1 (hv v hvV),
-  refine ⟨x, v⁻¹ * x, hLE (hKL hxvK), _, _⟩,
-  { apply hKL.trans hLE,
-    simpa only [singleton_mul, image_mul_left, mem_preimage] using hxK },
-  { simp only [div_eq_iff_eq_mul, ← mul_assoc, mul_right_inv, one_mul] },
-end
-
-end second_countable
-
-/-- Any Haar measure is invariant under inversion in a commutative group. -/
-@[to_additive]
-lemma map_haar_inv
-  {G : Type*} [comm_group G] [topological_space G] [topological_group G] [t2_space G]
-  [measurable_space G] [borel_space G] [locally_compact_space G] [second_countable_topology G]
-  (μ : measure G) [is_haar_measure μ] :
-  measure.map has_inv.inv μ = μ :=
-begin
-  -- the image measure is a Haar measure. By uniqueness up to multiplication, it is of the form
-  -- `c μ`. Applying again inversion, one gets the measure `c^2 μ`. But since inversion is an
-  -- involution, this is also `μ`. Hence, `c^2 = 1`, which implies `c = 1`.
-  haveI : is_haar_measure (measure.map has_inv.inv μ) :=
-    is_haar_measure_map μ (mul_equiv.inv G) continuous_inv continuous_inv,
-  obtain ⟨c, cpos, clt, hc⟩ : ∃ (c : ℝ≥0∞), (c ≠ 0) ∧ (c ≠ ∞) ∧ (measure.map has_inv.inv μ = c • μ)
-    := is_haar_measure_eq_smul_is_haar_measure _ _,
-  have : map has_inv.inv (map has_inv.inv μ) = c^2 • μ,
-    by simp only [hc, smul_smul, pow_two, map_smul],
-  have μeq : μ = c^2 • μ,
-  { rw [map_map continuous_inv.measurable continuous_inv.measurable] at this,
-    { simpa only [inv_involutive, involutive.comp_self, map_id] },
-    all_goals { apply_instance } },
-  have K : positive_compacts G := classical.arbitrary _,
-  have : c^2 * μ K = 1^2 * μ K,
-    by { conv_rhs { rw μeq },
-         simp, },
-  have : c^2 = 1^2 :=
-    (ennreal.mul_eq_mul_right (measure_pos_of_nonempty_interior _ K.interior_nonempty).ne'
-      K.compact.measure_lt_top.ne).1 this,
-  have : c = 1 := (ennreal.pow_strict_mono two_ne_zero).injective this,
-  rw [hc, this, one_smul]
-end
-
-@[simp, to_additive] lemma haar_preimage_inv
-  {G : Type*} [comm_group G] [topological_space G] [topological_group G] [t2_space G]
-  [measurable_space G] [borel_space G] [locally_compact_space G] [second_countable_topology G]
-  (μ : measure G) [is_haar_measure μ] (s : set G) :
-  μ (s⁻¹) = μ s :=
-calc μ (s⁻¹) = measure.map (has_inv.inv) μ s :
-  ((homeomorph.inv G).to_measurable_equiv.map_apply s).symm
-... = μ s : by rw map_haar_inv
-
-end measure
-end measure_theory
diff --git a/src/measure_theory/measure/haar/basic.lean b/src/measure_theory/measure/haar/basic.lean
new file mode 100644
index 0000000000000..8765941a9aa26
--- /dev/null
+++ b/src/measure_theory/measure/haar/basic.lean
@@ -0,0 +1,773 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import measure_theory.measure.content
+import measure_theory.group.prod
+import group_theory.divisible
+import topology.algebra.group.compact
+
+/-!
+# Haar measure
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove the existence and uniqueness (up to scalar multiples) of Haar measure
+for a locally compact Hausdorff topological group.
+
+For the construction, we follow the write-up by Jonathan Gleason,
+*Existence and Uniqueness of Haar Measure*.
+This is essentially the same argument as in
+https://en.wikipedia.org/wiki/Haar_measure#A_construction_using_compact_subsets.
+
+We construct the Haar measure first on compact sets. For this we define `(K : U)` as the (smallest)
+number of left-translates of `U` that are needed to cover `K` (`index` in the formalization).
+Then we define a function `h` on compact sets as `lim_U (K : U) / (K₀ : U)`,
+where `U` becomes a smaller and smaller open neighborhood of `1`, and `K₀` is a fixed compact set
+with nonempty interior. This function is `chaar` in the formalization, and we define the limit
+formally using Tychonoff's theorem.
+
+This function `h` forms a content, which we can extend to an outer measure and then a measure
+(`haar_measure`).
+We normalize the Haar measure so that the measure of `K₀` is `1`.
+We show that for second countable spaces any left invariant Borel measure is a scalar multiple of
+the Haar measure.
+
+Note that `μ` need not coincide with `h` on compact sets, according to
+[halmos1950measure, ch. X, §53 p.233]. However, we know that `h(K)` lies between `μ(Kᵒ)` and `μ(K)`,
+where `ᵒ` denotes the interior.
+
+## Main Declarations
+
+* `haar_measure`: the Haar measure on a locally compact Hausdorff group. This is a left invariant
+  regular measure. It takes as argument a compact set of the group (with non-empty interior),
+  and is normalized so that the measure of the given set is 1.
+* `haar_measure_self`: the Haar measure is normalized.
+* `is_left_invariant_haar_measure`: the Haar measure is left invariant.
+* `regular_haar_measure`: the Haar measure is a regular measure.
+* `is_haar_measure_haar_measure`: the Haar measure satisfies the `is_haar_measure` typeclass, i.e.,
+  it is invariant and gives finite mass to compact sets and positive mass to nonempty open sets.
+* `haar` : some choice of a Haar measure, on a locally compact Hausdorff group, constructed as
+  `haar_measure K` where `K` is some arbitrary choice of a compact set with nonempty interior.
+* `haar_measure_unique`: Every σ-finite left invariant measure on a locally compact Hausdorff group
+  is a scalar multiple of the Haar measure.
+
+## References
+* Paul Halmos (1950), Measure Theory, §53
+* Jonathan Gleason, Existence and Uniqueness of Haar Measure
+  - Note: step 9, page 8 contains a mistake: the last defined `μ` does not extend the `μ` on compact
+    sets, see Halmos (1950) p. 233, bottom of the page. This makes some other steps (like step 11)
+    invalid.
+* https://en.wikipedia.org/wiki/Haar_measure
+-/
+noncomputable theory
+
+open set has_inv function topological_space measurable_space
+open_locale nnreal classical ennreal pointwise topology
+
+namespace measure_theory
+namespace measure
+
+section group
+variables {G : Type*} [group G]
+
+/-! We put the internal functions in the construction of the Haar measure in a namespace,
+  so that the chosen names don't clash with other declarations.
+  We first define a couple of the functions before proving the properties (that require that `G`
+  is a topological group). -/
+namespace haar
+
+/-- The index or Haar covering number or ratio of `K` w.r.t. `V`, denoted `(K : V)`:
+  it is the smallest number of (left) translates of `V` that is necessary to cover `K`.
+  It is defined to be 0 if no finite number of translates cover `K`. -/
+@[to_additive add_index "additive version of `measure_theory.measure.haar.index`"]
+def index (K V : set G) : ℕ :=
+Inf $ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V }
+
+@[to_additive add_index_empty]
+lemma index_empty {V : set G} : index ∅ V = 0 :=
+begin
+  simp only [index, nat.Inf_eq_zero], left, use ∅,
+  simp only [finset.card_empty, empty_subset, mem_set_of_eq, eq_self_iff_true, and_self],
+end
+
+variables [topological_space G]
+
+/-- `prehaar K₀ U K` is a weighted version of the index, defined as `(K : U)/(K₀ : U)`.
+  In the applications `K₀` is compact with non-empty interior, `U` is open containing `1`,
+  and `K` is any compact set.
+  The argument `K` is a (bundled) compact set, so that we can consider `prehaar K₀ U` as an
+  element of `haar_product` (below). -/
+@[to_additive "additive version of `measure_theory.measure.haar.prehaar`"]
+def prehaar (K₀ U : set G) (K : compacts G) : ℝ := (index (K : set G) U : ℝ) / index K₀ U
+
+@[to_additive]
+lemma prehaar_empty (K₀ : positive_compacts G) {U : set G} : prehaar (K₀ : set G) U ⊥ = 0 :=
+by rw [prehaar, compacts.coe_bot, index_empty, nat.cast_zero, zero_div]
+
+@[to_additive]
+lemma prehaar_nonneg (K₀ : positive_compacts G) {U : set G} (K : compacts G) :
+  0 ≤ prehaar (K₀ : set G) U K :=
+by apply div_nonneg; norm_cast; apply zero_le
+
+/-- `haar_product K₀` is the product of intervals `[0, (K : K₀)]`, for all compact sets `K`.
+  For all `U`, we can show that `prehaar K₀ U ∈ haar_product K₀`. -/
+@[to_additive "additive version of `measure_theory.measure.haar.haar_product`"]
+def haar_product (K₀ : set G) : set (compacts G → ℝ) :=
+pi univ (λ K, Icc 0 $ index (K : set G) K₀)
+
+@[simp, to_additive]
+lemma mem_prehaar_empty {K₀ : set G} {f : compacts G → ℝ} :
+  f ∈ haar_product K₀ ↔ ∀ K : compacts G, f K ∈ Icc (0 : ℝ) (index (K : set G) K₀) :=
+by simp only [haar_product, pi, forall_prop_of_true, mem_univ, mem_set_of_eq]
+
+/-- The closure of the collection of elements of the form `prehaar K₀ U`,
+  for `U` open neighbourhoods of `1`, contained in `V`. The closure is taken in the space
+  `compacts G → ℝ`, with the topology of pointwise convergence.
+  We show that the intersection of all these sets is nonempty, and the Haar measure
+  on compact sets is defined to be an element in the closure of this intersection. -/
+@[to_additive "additive version of `measure_theory.measure.haar.cl_prehaar`"]
+def cl_prehaar (K₀ : set G) (V : open_nhds_of (1 : G)) : set (compacts G → ℝ) :=
+closure $ prehaar K₀ '' { U : set G | U ⊆ V.1 ∧ is_open U ∧ (1 : G) ∈ U }
+
+variables [topological_group G]
+
+/-!
+### Lemmas about `index`
+-/
+
+/-- If `K` is compact and `V` has nonempty interior, then the index `(K : V)` is well-defined,
+  there is a finite set `t` satisfying the desired properties. -/
+@[to_additive add_index_defined "If `K` is compact and `V` has nonempty interior, then the index
+`(K : V)` is well-defined, there is a finite set `t` satisfying the desired properties."]
+lemma index_defined {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
+  ∃ n : ℕ, n ∈ finset.card '' {t : finset G | K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V } :=
+by { rcases compact_covered_by_mul_left_translates hK hV with ⟨t, ht⟩, exact ⟨t.card, t, ht, rfl⟩ }
+
+@[to_additive add_index_elim]
+lemma index_elim {K V : set G} (hK : is_compact K) (hV : (interior V).nonempty) :
+  ∃ (t : finset G), K ⊆ (⋃ g ∈ t, (λ h, g * h) ⁻¹' V) ∧ finset.card t = index K V :=
+by { have := nat.Inf_mem (index_defined hK hV), rwa [mem_image] at this }
+
+@[to_additive le_add_index_mul]
+lemma le_index_mul (K₀ : positive_compacts G) (K : compacts G) {V : set G}
+  (hV : (interior V).nonempty) :
+  index (K : set G) V ≤ index (K : set G) K₀ * index (K₀ : set G) V :=
+begin
+  obtain ⟨s, h1s, h2s⟩ := index_elim K.is_compact K₀.interior_nonempty,
+  obtain ⟨t, h1t, h2t⟩ := index_elim K₀.is_compact hV,
+  rw [← h2s, ← h2t, mul_comm],
+  refine le_trans _ finset.card_mul_le,
+  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq], refine subset.trans h1s _,
+  apply Union₂_subset, intros g₁ hg₁, rw preimage_subset_iff, intros g₂ hg₂,
+  have := h1t hg₂,
+  rcases this with ⟨_, ⟨g₃, rfl⟩, A, ⟨hg₃, rfl⟩, h2V⟩, rw [mem_preimage, ← mul_assoc] at h2V,
+  exact mem_bUnion (finset.mul_mem_mul hg₃ hg₁) h2V
+end
+
+@[to_additive add_index_pos]
+lemma index_pos (K : positive_compacts G) {V : set G} (hV : (interior V).nonempty) :
+  0 < index (K : set G) V :=
+begin
+  unfold index, rw [nat.Inf_def, nat.find_pos, mem_image],
+  { rintro ⟨t, h1t, h2t⟩, rw [finset.card_eq_zero] at h2t, subst h2t,
+    obtain ⟨g, hg⟩ := K.interior_nonempty,
+    show g ∈ (∅ : set G), convert h1t (interior_subset hg), symmetry, apply bUnion_empty },
+  { exact index_defined K.is_compact hV }
+end
+
+@[to_additive add_index_mono]
+lemma index_mono {K K' V : set G} (hK' : is_compact K') (h : K ⊆ K')
+  (hV : (interior V).nonempty) : index K V ≤ index K' V :=
+begin
+  rcases index_elim hK' hV with ⟨s, h1s, h2s⟩,
+  apply nat.Inf_le, rw [mem_image], refine ⟨s, subset.trans h h1s, h2s⟩
+end
+
+@[to_additive add_index_union_le]
+lemma index_union_le (K₁ K₂ : compacts G) {V : set G} (hV : (interior V).nonempty) :
+  index (K₁.1 ∪ K₂.1) V ≤ index K₁.1 V + index K₂.1 V :=
+begin
+  rcases index_elim K₁.2 hV with ⟨s, h1s, h2s⟩,
+  rcases index_elim K₂.2 hV with ⟨t, h1t, h2t⟩,
+  rw [← h2s, ← h2t],
+  refine le_trans _ (finset.card_union_le _ _),
+  apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
+  apply union_subset; refine subset.trans (by assumption) _; apply bUnion_subset_bUnion_left;
+    intros g hg; simp only [mem_def] at hg;
+    simp only [mem_def, multiset.mem_union, finset.union_val, hg, or_true, true_or]
+end
+
+@[to_additive add_index_union_eq]
+lemma index_union_eq (K₁ K₂ : compacts G) {V : set G} (hV : (interior V).nonempty)
+  (h : disjoint (K₁.1 * V⁻¹) (K₂.1 * V⁻¹)) :
+  index (K₁.1 ∪ K₂.1) V = index K₁.1 V + index K₂.1 V :=
+begin
+  apply le_antisymm (index_union_le K₁ K₂ hV),
+  rcases index_elim (K₁.2.union K₂.2) hV with ⟨s, h1s, h2s⟩, rw [← h2s],
+  have : ∀ (K : set G) , K ⊆ (⋃ g ∈ s, (λ h, g * h) ⁻¹' V) →
+    index K V ≤ (s.filter (λ g, ((λ (h : G), g * h) ⁻¹' V ∩ K).nonempty)).card,
+  { intros K hK, apply nat.Inf_le, refine ⟨_, _, rfl⟩, rw [mem_set_of_eq],
+    intros g hg, rcases hK hg with ⟨_, ⟨g₀, rfl⟩, _, ⟨h1g₀, rfl⟩, h2g₀⟩,
+    simp only [mem_preimage] at h2g₀,
+    simp only [mem_Union], use g₀, split,
+    { simp only [finset.mem_filter, h1g₀, true_and], use g,
+      simp only [hg, h2g₀, mem_inter_iff, mem_preimage, and_self] },
+    exact h2g₀ },
+  refine le_trans (add_le_add (this K₁.1 $ subset.trans (subset_union_left _ _) h1s)
+    (this K₂.1 $ subset.trans (subset_union_right _ _) h1s)) _,
+  rw [← finset.card_union_eq, finset.filter_union_right],
+  exact s.card_filter_le _,
+  apply finset.disjoint_filter.mpr,
+  rintro g₁ h1g₁ ⟨g₂, h1g₂, h2g₂⟩ ⟨g₃, h1g₃, h2g₃⟩,
+  simp only [mem_preimage] at h1g₃ h1g₂,
+  refine h.le_bot (_ : g₁⁻¹ ∈ _),
+  split; simp only [set.mem_inv, set.mem_mul, exists_exists_and_eq_and, exists_and_distrib_left],
+  { refine ⟨_, h2g₂, (g₁ * g₂)⁻¹, _, _⟩, simp only [inv_inv, h1g₂],
+    simp only [mul_inv_rev, mul_inv_cancel_left] },
+  { refine ⟨_, h2g₃, (g₁ * g₃)⁻¹, _, _⟩, simp only [inv_inv, h1g₃],
+    simp only [mul_inv_rev, mul_inv_cancel_left] }
+
+end
+
+@[to_additive add_left_add_index_le]
+lemma mul_left_index_le {K : set G} (hK : is_compact K) {V : set G} (hV : (interior V).nonempty)
+  (g : G) : index ((λ h, g * h) '' K) V ≤ index K V :=
+begin
+  rcases index_elim hK hV with ⟨s, h1s, h2s⟩, rw [← h2s],
+  apply nat.Inf_le, rw [mem_image],
+  refine ⟨s.map (equiv.mul_right g⁻¹).to_embedding, _, finset.card_map _⟩,
+  { simp only [mem_set_of_eq], refine subset.trans (image_subset _ h1s) _,
+    rintro _ ⟨g₁, ⟨_, ⟨g₂, rfl⟩, ⟨_, ⟨hg₂, rfl⟩, hg₁⟩⟩, rfl⟩,
+    simp only [mem_preimage] at hg₁, simp only [exists_prop, mem_Union, finset.mem_map,
+      equiv.coe_mul_right, exists_exists_and_eq_and, mem_preimage, equiv.to_embedding_apply],
+    refine ⟨_, hg₂, _⟩, simp only [mul_assoc, hg₁, inv_mul_cancel_left] }
+end
+
+@[to_additive is_left_invariant_add_index]
+lemma is_left_invariant_index {K : set G} (hK : is_compact K) (g : G) {V : set G}
+  (hV : (interior V).nonempty) : index ((λ h, g * h) '' K) V = index K V :=
+begin
+  refine le_antisymm (mul_left_index_le hK hV g) _,
+  convert mul_left_index_le (hK.image $ continuous_mul_left g) hV g⁻¹,
+  rw [image_image], symmetry, convert image_id' _, ext h, apply inv_mul_cancel_left
+end
+
+/-!
+### Lemmas about `prehaar`
+-/
+
+@[to_additive add_prehaar_le_add_index]
+lemma prehaar_le_index (K₀ : positive_compacts G) {U : set G} (K : compacts G)
+  (hU : (interior U).nonempty) : prehaar (K₀ : set G) U K ≤ index (K : set G) K₀ :=
+begin
+  unfold prehaar, rw [div_le_iff]; norm_cast,
+  { apply le_index_mul K₀ K hU },
+  { exact index_pos K₀ hU }
+end
+
+@[to_additive]
+lemma prehaar_pos (K₀ : positive_compacts G) {U : set G} (hU : (interior U).nonempty)
+  {K : set G} (h1K : is_compact K) (h2K : (interior K).nonempty) :
+  0 < prehaar (K₀ : set G) U ⟨K, h1K⟩ :=
+by { apply div_pos; norm_cast, apply index_pos ⟨⟨K, h1K⟩, h2K⟩ hU, exact index_pos K₀ hU }
+
+@[to_additive]
+lemma prehaar_mono {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
+  {K₁ K₂ : compacts G} (h : (K₁ : set G) ⊆ K₂.1) :
+  prehaar (K₀ : set G) U K₁ ≤ prehaar (K₀ : set G) U K₂ :=
+begin
+  simp only [prehaar], rw [div_le_div_right], exact_mod_cast index_mono K₂.2 h hU,
+  exact_mod_cast index_pos K₀ hU
+end
+
+@[to_additive]
+lemma prehaar_self {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty) :
+  prehaar (K₀ : set G) U K₀.to_compacts = 1 :=
+div_self $ ne_of_gt $ by exact_mod_cast index_pos K₀ hU
+
+@[to_additive]
+lemma prehaar_sup_le {K₀ : positive_compacts G} {U : set G} (K₁ K₂ : compacts G)
+  (hU : (interior U).nonempty) :
+  prehaar (K₀ : set G) U (K₁ ⊔ K₂) ≤ prehaar (K₀ : set G) U K₁ + prehaar (K₀ : set G) U K₂ :=
+begin
+  simp only [prehaar], rw [div_add_div_same, div_le_div_right],
+  exact_mod_cast index_union_le K₁ K₂ hU, exact_mod_cast index_pos K₀ hU
+end
+
+@[to_additive]
+lemma prehaar_sup_eq {K₀ : positive_compacts G} {U : set G} {K₁ K₂ : compacts G}
+  (hU : (interior U).nonempty) (h : disjoint (K₁.1 * U⁻¹) (K₂.1 * U⁻¹)) :
+  prehaar (K₀ : set G) U (K₁ ⊔ K₂) = prehaar (K₀ : set G) U K₁ + prehaar (K₀ : set G) U K₂ :=
+by { simp only [prehaar], rw [div_add_div_same], congr', exact_mod_cast index_union_eq K₁ K₂ hU h }
+
+@[to_additive]
+lemma is_left_invariant_prehaar {K₀ : positive_compacts G} {U : set G} (hU : (interior U).nonempty)
+  (g : G) (K : compacts G) :
+  prehaar (K₀ : set G) U (K.map _ $ continuous_mul_left g) = prehaar (K₀ : set G) U K :=
+by simp only [prehaar, compacts.coe_map, is_left_invariant_index K.is_compact _ hU]
+
+/-!
+### Lemmas about `haar_product`
+-/
+
+@[to_additive]
+lemma prehaar_mem_haar_product (K₀ : positive_compacts G) {U : set G} (hU : (interior U).nonempty) :
+  prehaar (K₀ : set G) U ∈ haar_product (K₀ : set G) :=
+by { rintro ⟨K, hK⟩ h2K, rw [mem_Icc], exact ⟨prehaar_nonneg K₀ _, prehaar_le_index K₀ _ hU⟩ }
+
+@[to_additive]
+lemma nonempty_Inter_cl_prehaar (K₀ : positive_compacts G) :
+  (haar_product (K₀ : set G) ∩ ⋂ (V : open_nhds_of (1 : G)), cl_prehaar K₀ V).nonempty :=
+begin
+  have : is_compact (haar_product (K₀ : set G)),
+  { apply is_compact_univ_pi, intro K, apply is_compact_Icc },
+  refine this.inter_Inter_nonempty (cl_prehaar K₀) (λ s, is_closed_closure) (λ t, _),
+  let V₀ := ⋂ (V ∈ t), (V : open_nhds_of 1).carrier,
+  have h1V₀ : is_open V₀,
+  { apply is_open_bInter, apply finset.finite_to_set, rintro ⟨⟨V, hV₁⟩, hV₂⟩ h2V, exact hV₁ },
+  have h2V₀ : (1 : G) ∈ V₀, { simp only [mem_Inter], rintro ⟨⟨V, hV₁⟩, hV₂⟩ h2V, exact hV₂ },
+  refine ⟨prehaar K₀ V₀, _⟩,
+  split,
+  { apply prehaar_mem_haar_product K₀, use 1, rwa h1V₀.interior_eq },
+  { simp only [mem_Inter], rintro ⟨V, hV⟩ h2V, apply subset_closure,
+    apply mem_image_of_mem, rw [mem_set_of_eq],
+    exact ⟨subset.trans (Inter_subset _ ⟨V, hV⟩) (Inter_subset _ h2V), h1V₀, h2V₀⟩ },
+end
+
+/-!
+### Lemmas about `chaar`
+-/
+
+/-- This is the "limit" of `prehaar K₀ U K` as `U` becomes a smaller and smaller open
+  neighborhood of `(1 : G)`. More precisely, it is defined to be an arbitrary element
+  in the intersection of all the sets `cl_prehaar K₀ V` in `haar_product K₀`.
+  This is roughly equal to the Haar measure on compact sets,
+  but it can differ slightly. We do know that
+  `haar_measure K₀ (interior K) ≤ chaar K₀ K ≤ haar_measure K₀ K`. -/
+@[to_additive add_chaar "additive version of `measure_theory.measure.haar.chaar`"]
+def chaar (K₀ : positive_compacts G) (K : compacts G) : ℝ :=
+classical.some (nonempty_Inter_cl_prehaar K₀) K
+
+@[to_additive add_chaar_mem_add_haar_product]
+lemma chaar_mem_haar_product (K₀ : positive_compacts G) : chaar K₀ ∈ haar_product (K₀ : set G) :=
+(classical.some_spec (nonempty_Inter_cl_prehaar K₀)).1
+
+@[to_additive add_chaar_mem_cl_add_prehaar]
+lemma chaar_mem_cl_prehaar (K₀ : positive_compacts G) (V : open_nhds_of (1 : G)) :
+  chaar K₀ ∈ cl_prehaar (K₀ : set G) V :=
+by { have := (classical.some_spec (nonempty_Inter_cl_prehaar K₀)).2, rw [mem_Inter] at this,
+     exact this V }
+
+@[to_additive add_chaar_nonneg]
+lemma chaar_nonneg (K₀ : positive_compacts G) (K : compacts G) : 0 ≤ chaar K₀ K :=
+by { have := chaar_mem_haar_product K₀ K (mem_univ _), rw mem_Icc at this, exact this.1 }
+
+@[to_additive add_chaar_empty]
+lemma chaar_empty (K₀ : positive_compacts G) : chaar K₀ ⊥ = 0 :=
+begin
+  let eval : (compacts G → ℝ) → ℝ := λ f, f ⊥,
+  have : continuous eval := continuous_apply ⊥,
+  show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
+  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤),
+  unfold cl_prehaar, rw is_closed.closure_subset_iff,
+  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_empty },
+  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
+end
+
+@[to_additive add_chaar_self]
+lemma chaar_self (K₀ : positive_compacts G) : chaar K₀ K₀.to_compacts = 1 :=
+begin
+  let eval : (compacts G → ℝ) → ℝ := λ f, f K₀.to_compacts,
+  have : continuous eval := continuous_apply _,
+  show chaar K₀ ∈ eval ⁻¹' {(1 : ℝ)},
+  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤),
+  unfold cl_prehaar, rw is_closed.closure_subset_iff,
+  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, apply prehaar_self,
+    rw h2U.interior_eq, exact ⟨1, h3U⟩ },
+  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton }
+end
+
+@[to_additive add_chaar_mono]
+lemma chaar_mono {K₀ : positive_compacts G} {K₁ K₂ : compacts G} (h : (K₁ : set G) ⊆ K₂) :
+  chaar K₀ K₁ ≤ chaar K₀ K₂ :=
+begin
+  let eval : (compacts G → ℝ) → ℝ := λ f, f K₂ - f K₁,
+  have : continuous eval := (continuous_apply K₂).sub (continuous_apply K₁),
+  rw [← sub_nonneg], show chaar K₀ ∈ eval ⁻¹' (Ici (0 : ℝ)),
+  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤),
+  unfold cl_prehaar, rw is_closed.closure_subset_iff,
+  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, simp only [mem_preimage, mem_Ici, eval, sub_nonneg],
+    apply prehaar_mono _ h, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
+  { apply continuous_iff_is_closed.mp this, exact is_closed_Ici },
+end
+
+@[to_additive add_chaar_sup_le]
+lemma chaar_sup_le {K₀ : positive_compacts G} (K₁ K₂ : compacts G) :
+  chaar K₀ (K₁ ⊔ K₂) ≤ chaar K₀ K₁ + chaar K₀ K₂ :=
+begin
+  let eval : (compacts G → ℝ) → ℝ := λ f, f K₁ + f K₂ - f (K₁ ⊔ K₂),
+  have : continuous eval :=
+    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
+      (continuous_apply (K₁ ⊔ K₂)),
+  rw [← sub_nonneg], show chaar K₀ ∈ eval ⁻¹' (Ici (0 : ℝ)),
+  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤),
+  unfold cl_prehaar, rw is_closed.closure_subset_iff,
+  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩, simp only [mem_preimage, mem_Ici, eval, sub_nonneg],
+    apply prehaar_sup_le, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
+  { apply continuous_iff_is_closed.mp this, exact is_closed_Ici },
+end
+
+@[to_additive add_chaar_sup_eq]
+lemma chaar_sup_eq [t2_space G] {K₀ : positive_compacts G} {K₁ K₂ : compacts G}
+  (h : disjoint K₁.1 K₂.1) : chaar K₀ (K₁ ⊔ K₂) = chaar K₀ K₁ + chaar K₀ K₂ :=
+begin
+  rcases is_compact_is_compact_separated K₁.2 K₂.2 h with ⟨U₁, U₂, h1U₁, h1U₂, h2U₁, h2U₂, hU⟩,
+  rcases compact_open_separated_mul_right K₁.2 h1U₁ h2U₁ with ⟨L₁, h1L₁, h2L₁⟩,
+  rcases mem_nhds_iff.mp h1L₁ with ⟨V₁, h1V₁, h2V₁, h3V₁⟩,
+  replace h2L₁ := subset.trans (mul_subset_mul_left h1V₁) h2L₁,
+  rcases compact_open_separated_mul_right K₂.2 h1U₂ h2U₂ with ⟨L₂, h1L₂, h2L₂⟩,
+  rcases mem_nhds_iff.mp h1L₂ with ⟨V₂, h1V₂, h2V₂, h3V₂⟩,
+  replace h2L₂ := subset.trans (mul_subset_mul_left h1V₂) h2L₂,
+  let eval : (compacts G → ℝ) → ℝ := λ f, f K₁ + f K₂ - f (K₁ ⊔ K₂),
+  have : continuous eval :=
+    ((@continuous_add ℝ _ _ _).comp ((continuous_apply K₁).prod_mk (continuous_apply K₂))).sub
+      (continuous_apply (K₁ ⊔ K₂)),
+  rw [eq_comm, ← sub_eq_zero], show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
+  let V := V₁ ∩ V₂,
+  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀
+    ⟨⟨V⁻¹, (h2V₁.inter h2V₂).preimage continuous_inv⟩,
+    by simp only [mem_inv, inv_one, h3V₁, h3V₂, V, mem_inter_iff, true_and]⟩),
+  unfold cl_prehaar, rw is_closed.closure_subset_iff,
+  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩,
+    simp only [mem_preimage, eval, sub_eq_zero, mem_singleton_iff], rw [eq_comm],
+    apply prehaar_sup_eq,
+    { rw h2U.interior_eq, exact ⟨1, h3U⟩ },
+    { refine disjoint_of_subset _ _ hU,
+      { refine subset.trans (mul_subset_mul subset.rfl _) h2L₁,
+        exact subset.trans (inv_subset.mpr h1U) (inter_subset_left _ _) },
+      { refine subset.trans (mul_subset_mul subset.rfl _) h2L₂,
+        exact subset.trans (inv_subset.mpr h1U) (inter_subset_right _ _) }}},
+  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton }
+end
+
+@[to_additive is_left_invariant_add_chaar]
+lemma is_left_invariant_chaar {K₀ : positive_compacts G} (g : G) (K : compacts G) :
+  chaar K₀ (K.map _ $ continuous_mul_left g) = chaar K₀ K :=
+begin
+  let eval : (compacts G → ℝ) → ℝ := λ f, f (K.map _ $ continuous_mul_left g) - f K,
+  have : continuous eval := (continuous_apply (K.map _ _)).sub (continuous_apply K),
+  rw [← sub_eq_zero], show chaar K₀ ∈ eval ⁻¹' {(0 : ℝ)},
+  apply mem_of_subset_of_mem _ (chaar_mem_cl_prehaar K₀ ⊤),
+  unfold cl_prehaar, rw is_closed.closure_subset_iff,
+  { rintro _ ⟨U, ⟨h1U, h2U, h3U⟩, rfl⟩,
+    simp only [mem_singleton_iff, mem_preimage, eval, sub_eq_zero],
+    apply is_left_invariant_prehaar, rw h2U.interior_eq, exact ⟨1, h3U⟩ },
+  { apply continuous_iff_is_closed.mp this, exact is_closed_singleton },
+end
+
+variable [t2_space G]
+
+/-- The function `chaar` interpreted in `ℝ≥0`, as a content -/
+@[to_additive "additive version of `measure_theory.measure.haar.haar_content`"]
+def haar_content (K₀ : positive_compacts G) : content G :=
+{ to_fun        := λ K, ⟨chaar K₀ K, chaar_nonneg _ _⟩,
+  mono'         := λ K₁ K₂ h, by simp only [←nnreal.coe_le_coe, subtype.coe_mk, chaar_mono, h],
+  sup_disjoint' := λ K₁ K₂ h, by { simp only [chaar_sup_eq h], refl },
+  sup_le'       := λ K₁ K₂,
+    by simp only [←nnreal.coe_le_coe, nnreal.coe_add, subtype.coe_mk, chaar_sup_le] }
+
+/-! We only prove the properties for `haar_content` that we use at least twice below. -/
+
+@[to_additive]
+lemma haar_content_apply (K₀ : positive_compacts G) (K : compacts G) :
+  haar_content K₀ K = show nnreal, from ⟨chaar K₀ K, chaar_nonneg _ _⟩ := rfl
+
+/-- The variant of `chaar_self` for `haar_content` -/
+@[to_additive "The variant of `add_chaar_self` for `add_haar_content`."]
+lemma haar_content_self {K₀ : positive_compacts G} : haar_content K₀ K₀.to_compacts = 1 :=
+by { simp_rw [← ennreal.coe_one, haar_content_apply, ennreal.coe_eq_coe, chaar_self], refl }
+
+/-- The variant of `is_left_invariant_chaar` for `haar_content` -/
+@[to_additive "The variant of `is_left_invariant_add_chaar` for `add_haar_content`"]
+lemma is_left_invariant_haar_content {K₀ : positive_compacts G} (g : G) (K : compacts G) :
+  haar_content K₀ (K.map _ $ continuous_mul_left g) = haar_content K₀ K :=
+by simpa only [ennreal.coe_eq_coe, ←nnreal.coe_eq, haar_content_apply]
+  using is_left_invariant_chaar g K
+
+@[to_additive]
+lemma haar_content_outer_measure_self_pos {K₀ : positive_compacts G} :
+  0 < (haar_content K₀).outer_measure K₀ :=
+begin
+  refine zero_lt_one.trans_le _,
+  rw [content.outer_measure_eq_infi],
+  refine le_infi₂ (λ U hU, le_infi $ λ hK₀, le_trans _ $ le_supr₂ K₀.to_compacts hK₀),
+  exact haar_content_self.ge,
+end
+
+end haar
+open haar
+
+/-!
+### The Haar measure
+-/
+
+variables [topological_space G] [t2_space G] [topological_group G] [measurable_space G]
+  [borel_space G]
+
+/-- The Haar measure on the locally compact group `G`, scaled so that `haar_measure K₀ K₀ = 1`. -/
+@[to_additive "The Haar measure on the locally compact additive group `G`,
+scaled so that `add_haar_measure K₀ K₀ = 1`."]
+def haar_measure (K₀ : positive_compacts G) : measure G :=
+((haar_content K₀).outer_measure K₀)⁻¹ • (haar_content K₀).measure
+
+@[to_additive]
+lemma haar_measure_apply {K₀ : positive_compacts G} {s : set G} (hs : measurable_set s) :
+  haar_measure K₀ s = (haar_content K₀).outer_measure s / (haar_content K₀).outer_measure K₀ :=
+begin
+  change (((haar_content K₀).outer_measure) K₀)⁻¹ * (haar_content K₀).measure s = _,
+  simp only [hs, div_eq_mul_inv, mul_comm, content.measure_apply],
+end
+
+@[to_additive]
+instance is_mul_left_invariant_haar_measure (K₀ : positive_compacts G) :
+  is_mul_left_invariant (haar_measure K₀) :=
+begin
+  rw [← forall_measure_preimage_mul_iff],
+  intros g A hA,
+  rw [haar_measure_apply hA, haar_measure_apply (measurable_const_mul g hA)],
+  congr' 1,
+  apply content.is_mul_left_invariant_outer_measure,
+  apply is_left_invariant_haar_content,
+end
+
+@[to_additive]
+lemma haar_measure_self {K₀ : positive_compacts G} : haar_measure K₀ K₀ = 1 :=
+begin
+  haveI : locally_compact_space G := K₀.locally_compact_space_of_group,
+  rw [haar_measure_apply K₀.is_compact.measurable_set, ennreal.div_self],
+  { rw [← pos_iff_ne_zero], exact haar_content_outer_measure_self_pos },
+  { exact (content.outer_measure_lt_top_of_is_compact _ K₀.is_compact).ne }
+end
+
+/-- The Haar measure is regular. -/
+@[to_additive "The additive Haar measure is regular."]
+instance regular_haar_measure {K₀ : positive_compacts G} :
+  (haar_measure K₀).regular :=
+begin
+  haveI : locally_compact_space G := K₀.locally_compact_space_of_group,
+  apply regular.smul,
+  rw ennreal.inv_ne_top,
+  exact haar_content_outer_measure_self_pos.ne',
+end
+
+/-- The Haar measure is sigma-finite in a second countable group. -/
+@[to_additive "The additive Haar measure is sigma-finite in a second countable group."]
+instance sigma_finite_haar_measure [second_countable_topology G] {K₀ : positive_compacts G} :
+  sigma_finite (haar_measure K₀) :=
+by { haveI : locally_compact_space G := K₀.locally_compact_space_of_group, apply_instance, }
+
+/-- The Haar measure is a Haar measure, i.e., it is invariant and gives finite mass to compact
+sets and positive mass to nonempty open sets. -/
+@[to_additive "The additive Haar measure is an additive Haar measure, i.e., it is invariant and
+gives  finite mass to compact sets and positive mass to nonempty open sets."]
+instance is_haar_measure_haar_measure (K₀ : positive_compacts G) :
+  is_haar_measure (haar_measure K₀) :=
+begin
+  apply is_haar_measure_of_is_compact_nonempty_interior (haar_measure K₀) K₀ K₀.is_compact
+    K₀.interior_nonempty,
+  { simp only [haar_measure_self], exact one_ne_zero },
+  { simp only [haar_measure_self], exact ennreal.coe_ne_top },
+end
+
+/-- `haar` is some choice of a Haar measure, on a locally compact group. -/
+@[reducible, to_additive "`add_haar` is some choice of a Haar measure, on a locally compact
+additive group."]
+def haar [locally_compact_space G] : measure G := haar_measure $ classical.arbitrary _
+
+section second_countable
+
+variables [second_countable_topology G]
+
+/-- The Haar measure is unique up to scaling. More precisely: every σ-finite left invariant measure
+  is a scalar multiple of the Haar measure.
+  This is slightly weaker than assuming that `μ` is a Haar measure (in particular we don't require
+  `μ ≠ 0`). -/
+@[to_additive "The additive Haar measure is unique up to scaling. More precisely: every σ-finite
+left invariant measure is a scalar multiple of the additive Haar measure. This is slightly weaker
+than assuming that `μ` is an additive Haar measure (in particular we don't require `μ ≠ 0`)."]
+theorem haar_measure_unique (μ : measure G) [sigma_finite μ] [is_mul_left_invariant μ]
+  (K₀ : positive_compacts G) : μ = μ K₀ • haar_measure K₀ :=
+(measure_eq_div_smul μ (haar_measure K₀) K₀.is_compact.measurable_set
+  (measure_pos_of_nonempty_interior _ K₀.interior_nonempty).ne'
+  K₀.is_compact.measure_lt_top.ne).trans (by rw [haar_measure_self, div_one])
+
+example [locally_compact_space G] (μ : measure G) [is_haar_measure μ] (K₀ : positive_compacts G) :
+  μ = μ K₀.1 • haar_measure K₀ :=
+haar_measure_unique μ K₀
+
+/-- To show that an invariant σ-finite measure is regular it is sufficient to show that it is finite
+  on some compact set with non-empty interior. -/
+@[to_additive "To show that an invariant σ-finite measure is regular it is sufficient to show that
+it is finite on some compact set with non-empty interior."]
+theorem regular_of_is_mul_left_invariant {μ : measure G} [sigma_finite μ] [is_mul_left_invariant μ]
+  {K : set G} (hK : is_compact K) (h2K : (interior K).nonempty) (hμK : μ K ≠ ∞) :
+  regular μ :=
+by { rw [haar_measure_unique μ ⟨⟨K, hK⟩, h2K⟩], exact regular.smul hμK }
+
+@[to_additive is_add_haar_measure_eq_smul_is_add_haar_measure]
+theorem is_haar_measure_eq_smul_is_haar_measure
+  [locally_compact_space G] (μ ν : measure G) [is_haar_measure μ] [is_haar_measure ν] :
+  ∃ (c : ℝ≥0∞), c ≠ 0 ∧ c ≠ ∞ ∧ μ = c • ν :=
+begin
+  have K : positive_compacts G := classical.arbitrary _,
+  have νpos : 0 < ν K := measure_pos_of_nonempty_interior _ K.interior_nonempty,
+  have νne : ν K ≠ ∞ := K.is_compact.measure_lt_top.ne,
+  refine ⟨μ K / ν K, _, _, _⟩,
+  { simp only [νne, (μ.measure_pos_of_nonempty_interior K.interior_nonempty).ne', ne.def,
+      ennreal.div_zero_iff, not_false_iff, or_self] },
+  { simp only [div_eq_mul_inv, νpos.ne', (K.is_compact.measure_lt_top).ne, or_self,
+      ennreal.inv_eq_top, with_top.mul_eq_top_iff, ne.def, not_false_iff, and_false, false_and] },
+  { calc
+    μ = μ K • haar_measure K : haar_measure_unique μ K
+    ... = (μ K / ν K) • (ν K • haar_measure K) :
+      by rw [smul_smul, div_eq_mul_inv, mul_assoc, ennreal.inv_mul_cancel νpos.ne' νne, mul_one]
+    ... = (μ K / ν K) • ν : by rw ← haar_measure_unique ν K }
+end
+
+@[priority 90, to_additive] -- see Note [lower instance priority]
+instance regular_of_is_haar_measure
+  [locally_compact_space G] (μ : measure G) [is_haar_measure μ] :
+  regular μ :=
+begin
+  have K : positive_compacts G := classical.arbitrary _,
+  obtain ⟨c, c0, ctop, hμ⟩ : ∃ (c : ℝ≥0∞), (c ≠ 0) ∧ (c ≠ ∞) ∧ (μ = c • haar_measure K) :=
+    is_haar_measure_eq_smul_is_haar_measure μ _,
+  rw hμ,
+  exact regular.smul ctop,
+end
+
+/-- **Steinhaus Theorem** In any locally compact group `G` with a haar measure `μ`, for any
+  measurable set `E` of positive measure, the set `E / E` is a neighbourhood of `1`. -/
+@[to_additive "**Steinhaus Theorem** In any locally compact group `G` with a haar measure `μ`,
+  for any measurable set `E` of positive measure, the set `E - E` is a neighbourhood of `0`."]
+theorem div_mem_nhds_one_of_haar_pos (μ : measure G) [is_haar_measure μ] [locally_compact_space G]
+  (E : set G) (hE : measurable_set E) (hEpos : 0 < μ E) :
+  E / E ∈ 𝓝 (1 : G) :=
+begin
+  /- For any regular measure `μ` and set `E` of positive measure, we can find a compact set `K` of
+     positive measure inside `E`. Further, for any outer regular measure `μ` there exists an open
+     set `U` containing `K` with measure arbitrarily close to `K` (here `μ U < 2 * μ K` suffices).
+     Then, we can pick an open neighborhood of `1`, say `V` such that such that `V * K` is contained
+     in `U`. Now note that for any `v` in `V`, the sets `K` and `{v} * K` can not be disjoint
+     because they are both of measure `μ K` (since `μ` is left regular) and also contained in `U`,
+     yet we have that `μ U < 2 * μ K`. This show that `K / K` contains the neighborhood `V` of `1`,
+     and therefore that it is itself such a neighborhood. -/
+  obtain ⟨L, hL, hLE, hLpos, hLtop⟩ : ∃ (L : set G), measurable_set L ∧ L ⊆ E ∧ 0 < μ L ∧ μ L < ∞,
+    from exists_subset_measure_lt_top hE hEpos,
+  obtain ⟨K, hKL, hK, hKpos⟩ : ∃ (K : set G) (H : K ⊆ L), is_compact K ∧ 0 < μ K,
+    from measurable_set.exists_lt_is_compact_of_ne_top hL (ne_of_lt hLtop) hLpos,
+  have hKtop : μ K ≠ ∞,
+  { apply ne_top_of_le_ne_top (ne_of_lt hLtop),
+    apply measure_mono hKL },
+  obtain ⟨U, hUK, hU, hμUK⟩ : ∃ (U : set G) (H : U ⊇ K), is_open U ∧ μ U < μ K + μ K,
+   from set.exists_is_open_lt_add K hKtop hKpos.ne',
+  obtain ⟨V, hV1, hVKU⟩ : ∃ (V ∈ 𝓝 (1 : G)), V * K ⊆ U,
+    from compact_open_separated_mul_left hK hU hUK,
+  have hv : ∀ (v : G), v ∈ V → ¬ disjoint ({v}* K) K,
+  { intros v hv hKv,
+    have hKvsub : {v} * K ∪ K ⊆ U,
+    { apply set.union_subset _ hUK,
+      apply subset_trans _ hVKU,
+      apply set.mul_subset_mul _ (set.subset.refl K),
+      simp only [set.singleton_subset_iff, hv] },
+    replace hKvsub := @measure_mono _ _ μ _ _ hKvsub,
+    have hcontr := lt_of_le_of_lt hKvsub hμUK,
+    rw measure_union hKv (is_compact.measurable_set hK) at hcontr,
+    have hKtranslate : μ ({v} * K) = μ K,
+      by simp only [singleton_mul, image_mul_left, measure_preimage_mul],
+    rw [hKtranslate, lt_self_iff_false] at hcontr,
+    assumption },
+  suffices : V ⊆ E / E, from filter.mem_of_superset hV1 this,
+  assume v hvV,
+  obtain ⟨x, hxK, hxvK⟩ : ∃ (x : G), x ∈ {v} * K ∧ x ∈ K, from set.not_disjoint_iff.1 (hv v hvV),
+  refine ⟨x, v⁻¹ * x, hLE (hKL hxvK), _, _⟩,
+  { apply hKL.trans hLE,
+    simpa only [singleton_mul, image_mul_left, mem_preimage] using hxK },
+  { simp only [div_eq_iff_eq_mul, ← mul_assoc, mul_right_inv, one_mul] },
+end
+
+end second_countable
+
+end group
+
+section comm_group
+
+variables {G : Type*} [comm_group G] [topological_space G] [topological_group G] [t2_space G]
+  [measurable_space G] [borel_space G] [second_countable_topology G]
+  (μ : measure G) [is_haar_measure μ]
+
+/-- Any Haar measure is invariant under inversion in an abelian group. -/
+@[priority 100, to_additive
+  "Any additive Haar measure is invariant under negation in an abelian group."]
+instance is_haar_measure.is_inv_invariant [locally_compact_space G] :
+  is_inv_invariant μ :=
+begin
+  -- the image measure is a Haar measure. By uniqueness up to multiplication, it is of the form
+  -- `c μ`. Applying again inversion, one gets the measure `c^2 μ`. But since inversion is an
+  -- involution, this is also `μ`. Hence, `c^2 = 1`, which implies `c = 1`.
+  constructor,
+  haveI : is_haar_measure (measure.map has_inv.inv μ) :=
+    (mul_equiv.inv G).is_haar_measure_map μ continuous_inv continuous_inv,
+  obtain ⟨c, cpos, clt, hc⟩ : ∃ (c : ℝ≥0∞), (c ≠ 0) ∧ (c ≠ ∞) ∧ (measure.map has_inv.inv μ = c • μ)
+    := is_haar_measure_eq_smul_is_haar_measure _ _,
+  have : map has_inv.inv (map has_inv.inv μ) = c^2 • μ,
+    by simp only [hc, smul_smul, pow_two, measure.map_smul],
+  have μeq : μ = c^2 • μ,
+  { rw [map_map continuous_inv.measurable continuous_inv.measurable] at this,
+    { simpa only [inv_involutive, involutive.comp_self, map_id] },
+    all_goals { apply_instance } },
+  have K : positive_compacts G := classical.arbitrary _,
+  have : c^2 * μ K = 1^2 * μ K,
+    by { conv_rhs { rw μeq },
+         simp, },
+  have : c^2 = 1^2 :=
+    (ennreal.mul_eq_mul_right (measure_pos_of_nonempty_interior _ K.interior_nonempty).ne'
+      K.is_compact.measure_lt_top.ne).1 this,
+  have : c = 1 := (ennreal.pow_strict_mono two_ne_zero).injective this,
+  rw [measure.inv, hc, this, one_smul]
+end
+
+@[to_additive]
+lemma measure_preserving_zpow [compact_space G] [rootable_by G ℤ] {n : ℤ} (hn : n ≠ 0) :
+  measure_preserving (λ (g : G), g^n) μ μ :=
+{ measurable := (continuous_zpow n).measurable,
+  map_eq :=
+  begin
+    let f := @zpow_group_hom G _ n,
+    have hf : continuous f := continuous_zpow n,
+    haveI : (μ.map f).is_haar_measure :=
+      is_haar_measure_map μ f hf (rootable_by.surjective_pow G ℤ hn) (by simp),
+    obtain ⟨C, -, -, hC⟩ := is_haar_measure_eq_smul_is_haar_measure (μ.map f) μ,
+    suffices : C = 1, { rwa [this, one_smul] at hC, },
+    have h_univ : (μ.map f) univ = μ univ,
+    { rw [map_apply_of_ae_measurable hf.measurable.ae_measurable measurable_set.univ,
+        preimage_univ], },
+    have hμ₀ : μ univ ≠ 0 := is_open_pos_measure.open_pos univ is_open_univ univ_nonempty,
+    have hμ₁ : μ univ ≠ ∞ := compact_space.is_finite_measure.measure_univ_lt_top.ne,
+    rwa [hC, smul_apply, algebra.id.smul_eq_mul, mul_comm, ← ennreal.eq_div_iff hμ₀ hμ₁,
+      ennreal.div_self hμ₀ hμ₁] at h_univ,
+  end, }
+
+@[to_additive]
+lemma measure_preserving.zpow [compact_space G] [rootable_by G ℤ] {n : ℤ} (hn : n ≠ 0)
+  {X : Type*} [measurable_space X] {μ' : measure X} {f : X → G} (hf : measure_preserving f μ' μ) :
+  measure_preserving (λ x, (f x)^n) μ' μ :=
+(measure_preserving_zpow μ hn).comp hf
+
+end comm_group
+
+end measure
+end measure_theory
diff --git a/src/measure_theory/measure/haar/inner_product_space.lean b/src/measure_theory/measure/haar/inner_product_space.lean
new file mode 100644
index 0000000000000..8d7fed18e4f47
--- /dev/null
+++ b/src/measure_theory/measure/haar/inner_product_space.lean
@@ -0,0 +1,73 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import analysis.inner_product_space.orientation
+import measure_theory.measure.lebesgue.eq_haar
+
+/-!
+# Volume forms and measures on inner product spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A volume form induces a Lebesgue measure on general finite-dimensional real vector spaces. In this
+file, we discuss the specific situation of inner product spaces, where an orientation gives
+rise to a canonical volume form. We show that the measure coming from this volume form gives
+measure `1` to the parallelepiped spanned by any orthonormal basis, and that it coincides with
+the canonical `volume` from the `measure_space` instance.
+-/
+
+open finite_dimensional measure_theory measure_theory.measure set
+
+variables {ι F : Type*}
+variables [fintype ι] [normed_add_comm_group F] [inner_product_space ℝ F] [finite_dimensional ℝ F]
+  [measurable_space F] [borel_space F]
+
+section
+
+variables {m n : ℕ} [_i : fact (finrank ℝ F = n)]
+include _i
+
+/-- The volume form coming from an orientation in an inner product space gives measure `1` to the
+parallelepiped associated to any orthonormal basis. This is a rephrasing of
+`abs_volume_form_apply_of_orthonormal` in terms of measures. -/
+lemma orientation.measure_orthonormal_basis
+  (o : orientation ℝ F (fin n)) (b : orthonormal_basis ι ℝ F) :
+  o.volume_form.measure (parallelepiped b) = 1 :=
+begin
+  have e : ι ≃ fin n,
+  { refine fintype.equiv_fin_of_card_eq _,
+    rw [← _i.out, finrank_eq_card_basis b.to_basis] },
+  have A : ⇑b = (b.reindex e) ∘ e,
+  { ext x,
+    simp only [orthonormal_basis.coe_reindex, function.comp_app, equiv.symm_apply_apply] },
+  rw [A, parallelepiped_comp_equiv, alternating_map.measure_parallelepiped,
+    o.abs_volume_form_apply_of_orthonormal, ennreal.of_real_one],
+end
+
+/-- In an oriented inner product space, the measure coming from the canonical volume form
+associated to an orientation coincides with the volume. -/
+lemma orientation.measure_eq_volume (o : orientation ℝ F (fin n)) :
+  o.volume_form.measure = volume :=
+begin
+  have A : o.volume_form.measure ((std_orthonormal_basis ℝ F).to_basis.parallelepiped) = 1,
+    from orientation.measure_orthonormal_basis o (std_orthonormal_basis ℝ F),
+  rw [add_haar_measure_unique o.volume_form.measure
+    ((std_orthonormal_basis ℝ F).to_basis.parallelepiped), A, one_smul],
+  simp only [volume, basis.add_haar],
+end
+
+end
+
+/-- The volume measure in a finite-dimensional inner product space gives measure `1` to the
+parallelepiped spanned by any orthonormal basis. -/
+lemma orthonormal_basis.volume_parallelepiped (b : orthonormal_basis ι ℝ F) :
+  volume (parallelepiped b) = 1 :=
+begin
+  haveI : fact (finrank ℝ F = finrank ℝ F) := ⟨rfl⟩,
+  let o := (std_orthonormal_basis ℝ F).to_basis.orientation,
+  rw ← o.measure_eq_volume,
+  exact o.measure_orthonormal_basis b,
+end
diff --git a/src/measure_theory/measure/haar/normed_space.lean b/src/measure_theory/measure/haar/normed_space.lean
new file mode 100644
index 0000000000000..f4cae46185949
--- /dev/null
+++ b/src/measure_theory/measure/haar/normed_space.lean
@@ -0,0 +1,180 @@
+/-
+Copyright (c) 2020 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Sébastien Gouëzel
+-/
+import measure_theory.measure.lebesgue.eq_haar
+import measure_theory.integral.bochner
+
+/-!
+# Basic properties of Haar measures on real vector spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+noncomputable theory
+
+open_locale nnreal ennreal pointwise big_operators topology
+open has_inv set function measure_theory.measure filter
+open measure finite_dimensional
+
+namespace measure_theory
+
+namespace measure
+
+/- The instance `is_add_haar_measure.has_no_atoms` applies in particular to show that an additive
+Haar measure on a nontrivial finite-dimensional real vector space has no atom. -/
+example {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [nontrivial E]
+  [finite_dimensional ℝ E] [measurable_space E] [borel_space E] (μ : measure E)
+  [is_add_haar_measure μ] :
+  has_no_atoms μ := by apply_instance
+
+section continuous_linear_equiv
+
+variables {𝕜 G H : Type*} [measurable_space G] [measurable_space H]
+  [nontrivially_normed_field 𝕜] [topological_space G] [topological_space H]
+  [add_comm_group G] [add_comm_group H] [topological_add_group G] [topological_add_group H]
+  [module 𝕜 G] [module 𝕜 H] (μ : measure G) [is_add_haar_measure μ] [borel_space G] [borel_space H]
+  [t2_space H]
+
+instance map_continuous_linear_equiv.is_add_haar_measure (e : G ≃L[𝕜] H) :
+  is_add_haar_measure (μ.map e) :=
+e.to_add_equiv.is_add_haar_measure_map _ e.continuous e.symm.continuous
+
+variables [complete_space 𝕜] [t2_space G] [finite_dimensional 𝕜 G] [has_continuous_smul 𝕜 G]
+  [has_continuous_smul 𝕜 H]
+
+instance map_linear_equiv.is_add_haar_measure (e : G ≃ₗ[𝕜] H) : is_add_haar_measure (μ.map e) :=
+map_continuous_linear_equiv.is_add_haar_measure _ e.to_continuous_linear_equiv
+
+end continuous_linear_equiv
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E]
+  [borel_space E] [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
+  {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
+variables (μ) {s : set E}
+
+/-- The integral of `f (R • x)` with respect to an additive Haar measure is a multiple of the
+integral of `f`. The formula we give works even when `f` is not integrable or `R = 0`
+thanks to the convention that a non-integrable function has integral zero. -/
+lemma integral_comp_smul (f : E → F) (R : ℝ) :
+  ∫ x, f (R • x) ∂μ = |(R ^ finrank ℝ E)⁻¹| • ∫ x, f x ∂μ :=
+begin
+  rcases eq_or_ne R 0 with rfl|hR,
+  { simp only [zero_smul, integral_const],
+    rcases nat.eq_zero_or_pos (finrank ℝ E) with hE|hE,
+    { haveI : subsingleton E, from finrank_zero_iff.1 hE,
+      have : f = (λ x, f 0), { ext x, rw subsingleton.elim x 0 },
+      conv_rhs { rw this },
+      simp only [hE, pow_zero, inv_one, abs_one, one_smul, integral_const] },
+    { haveI : nontrivial E, from finrank_pos_iff.1 hE,
+      simp only [zero_pow hE, measure_univ_of_is_add_left_invariant, ennreal.top_to_real, zero_smul,
+        inv_zero, abs_zero]} },
+  { calc ∫ x, f (R • x) ∂μ = ∫ y, f y ∂(measure.map (λ x, R • x) μ) :
+      (integral_map_equiv (homeomorph.smul (is_unit_iff_ne_zero.2 hR).unit)
+        .to_measurable_equiv f).symm
+    ... = |(R ^ finrank ℝ E)⁻¹| • ∫ x, f x ∂μ :
+      by simp only [map_add_haar_smul μ hR, integral_smul_measure, ennreal.to_real_of_real,
+                    abs_nonneg] }
+end
+
+/-- The integral of `f (R • x)` with respect to an additive Haar measure is a multiple of the
+integral of `f`. The formula we give works even when `f` is not integrable or `R = 0`
+thanks to the convention that a non-integrable function has integral zero. -/
+lemma integral_comp_smul_of_nonneg (f : E → F) (R : ℝ) {hR : 0 ≤ R} :
+  ∫ x, f (R • x) ∂μ = (R ^ finrank ℝ E)⁻¹ • ∫ x, f x ∂μ :=
+by rw [integral_comp_smul μ f R, abs_of_nonneg (inv_nonneg.2 (pow_nonneg hR _))]
+
+/-- The integral of `f (R⁻¹ • x)` with respect to an additive Haar measure is a multiple of the
+integral of `f`. The formula we give works even when `f` is not integrable or `R = 0`
+thanks to the convention that a non-integrable function has integral zero. -/
+lemma integral_comp_inv_smul (f : E → F) (R : ℝ) :
+  ∫ x, f (R⁻¹ • x) ∂μ = |(R ^ finrank ℝ E)| • ∫ x, f x ∂μ :=
+by rw [integral_comp_smul μ f (R⁻¹), inv_pow, inv_inv]
+
+/-- The integral of `f (R⁻¹ • x)` with respect to an additive Haar measure is a multiple of the
+integral of `f`. The formula we give works even when `f` is not integrable or `R = 0`
+thanks to the convention that a non-integrable function has integral zero. -/
+lemma integral_comp_inv_smul_of_nonneg (f : E → F) {R : ℝ} (hR : 0 ≤ R) :
+  ∫ x, f (R⁻¹ • x) ∂μ = R ^ finrank ℝ E • ∫ x, f x ∂μ :=
+by rw [integral_comp_inv_smul μ f R, abs_of_nonneg ((pow_nonneg hR _))]
+
+lemma integral_comp_mul_left (g : ℝ → F) (a : ℝ) :
+  ∫ x : ℝ, g (a * x) = |a⁻¹| • ∫ y : ℝ, g y :=
+by simp_rw [←smul_eq_mul, measure.integral_comp_smul, finite_dimensional.finrank_self, pow_one]
+
+lemma integral_comp_inv_mul_left (g : ℝ → F) (a : ℝ) :
+  ∫ x : ℝ, g (a⁻¹ * x) = |a| • ∫ y : ℝ, g y :=
+by simp_rw [←smul_eq_mul, measure.integral_comp_inv_smul, finite_dimensional.finrank_self, pow_one]
+
+lemma integral_comp_mul_right (g : ℝ → F) (a : ℝ) :
+  ∫ x : ℝ, g (x * a) = |a⁻¹| • ∫ y : ℝ, g y :=
+by simpa only [mul_comm] using integral_comp_mul_left g a
+
+lemma integral_comp_inv_mul_right (g : ℝ → F) (a : ℝ) :
+  ∫ x : ℝ, g (x * a⁻¹) = |a| • ∫ y : ℝ, g y :=
+by simpa only [mul_comm] using integral_comp_inv_mul_left g a
+
+lemma integral_comp_div (g : ℝ → F) (a : ℝ) :
+  ∫ x : ℝ, g (x / a) = |a| • ∫ y : ℝ, g y :=
+integral_comp_inv_mul_right g a
+
+end measure
+
+variables {F : Type*} [normed_add_comm_group F]
+
+lemma integrable_comp_smul_iff {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [measurable_space E] [borel_space E] [finite_dimensional ℝ E]
+  (μ : measure E) [is_add_haar_measure μ] (f : E → F) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, f (R • x)) μ ↔ integrable f μ :=
+begin
+  -- reduce to one-way implication
+  suffices : ∀ {g : E → F} (hg : integrable g μ) {S : ℝ} (hS : S ≠ 0),
+    integrable (λ x, g (S • x)) μ,
+  { refine ⟨λ hf, _, λ hf, this hf hR⟩,
+    convert this hf (inv_ne_zero hR),
+    ext1 x,
+    rw [←mul_smul, mul_inv_cancel hR, one_smul], },
+  -- now prove
+  intros g hg S hS,
+  let t := ((homeomorph.smul (is_unit_iff_ne_zero.2 hS).unit).to_measurable_equiv : E ≃ᵐ E),
+  refine (integrable_map_equiv t g).mp (_ : integrable g (map (has_smul.smul S) μ)),
+  rwa [map_add_haar_smul μ hS, integrable_smul_measure _ ennreal.of_real_ne_top],
+  simpa only [ne.def, ennreal.of_real_eq_zero, not_le, abs_pos]
+    using inv_ne_zero (pow_ne_zero _ hS),
+end
+
+lemma integrable.comp_smul {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [measurable_space E] [borel_space E] [finite_dimensional ℝ E]
+  {μ : measure E} [is_add_haar_measure μ] {f : E → F} (hf : integrable f μ) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, f (R • x)) μ :=
+(integrable_comp_smul_iff μ f hR).2 hf
+
+lemma integrable_comp_mul_left_iff (g : ℝ → F) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, g (R * x)) ↔ integrable g :=
+by simpa only [smul_eq_mul] using integrable_comp_smul_iff volume g hR
+
+lemma integrable.comp_mul_left' {g : ℝ → F} (hg : integrable g) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, g (R * x)) :=
+(integrable_comp_mul_left_iff g hR).2 hg
+
+lemma integrable_comp_mul_right_iff (g : ℝ → F) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, g (x * R)) ↔ integrable g :=
+by simpa only [mul_comm] using integrable_comp_mul_left_iff g hR
+
+lemma integrable.comp_mul_right' {g : ℝ → F} (hg : integrable g) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, g (x * R)) :=
+(integrable_comp_mul_right_iff g hR).2 hg
+
+lemma integrable_comp_div_iff (g : ℝ → F) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, g (x / R)) ↔ integrable g :=
+integrable_comp_mul_right_iff g (inv_ne_zero hR)
+
+lemma integrable.comp_div {g : ℝ → F} (hg : integrable g) {R : ℝ} (hR : R ≠ 0) :
+  integrable (λ x, g (x / R)) :=
+(integrable_comp_div_iff g hR).2 hg
+
+
+end measure_theory
diff --git a/src/measure_theory/measure/haar/of_basis.lean b/src/measure_theory/measure/haar/of_basis.lean
new file mode 100644
index 0000000000000..dd1d618b23b18
--- /dev/null
+++ b/src/measure_theory/measure/haar/of_basis.lean
@@ -0,0 +1,262 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import measure_theory.measure.haar.basic
+import analysis.inner_product_space.pi_L2
+
+/-!
+# Additive Haar measure constructed from a basis
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a basis of a finite-dimensional real vector space, we define the corresponding Lebesgue
+measure, which gives measure `1` to the parallelepiped spanned by the basis.
+
+## Main definitions
+
+* `parallelepiped v` is the parallelepiped spanned by a finite family of vectors.
+* `basis.parallelepiped` is the parallelepiped associated to a basis, seen as a compact set with
+nonempty interior.
+* `basis.add_haar` is the Lebesgue measure associated to a basis, giving measure `1` to the
+corresponding parallelepiped.
+
+In particular, we declare a `measure_space` instance on any finite-dimensional inner product space,
+by using the Lebesgue measure associated to some orthonormal basis (which is in fact independent
+of the basis).
+-/
+
+open set topological_space measure_theory measure_theory.measure finite_dimensional
+open_locale big_operators pointwise
+
+noncomputable theory
+
+variables {ι ι' E F : Type*} [fintype ι] [fintype ι']
+
+section add_comm_group
+
+variables [add_comm_group E] [module ℝ E] [add_comm_group F] [module ℝ F]
+
+/-- The closed parallelepiped spanned by a finite family of vectors. -/
+def parallelepiped (v : ι → E) : set E :=
+(λ (t : ι → ℝ), ∑ i, t i • v i) '' (Icc 0 1)
+
+lemma mem_parallelepiped_iff (v : ι → E) (x : E) :
+  x ∈ parallelepiped v ↔ ∃ (t : ι → ℝ) (ht : t ∈ Icc (0 : ι → ℝ) 1), x = ∑ i, t i • v i :=
+by simp [parallelepiped, eq_comm]
+
+lemma image_parallelepiped (f : E →ₗ[ℝ] F) (v : ι → E) :
+  f '' (parallelepiped v) = parallelepiped (f ∘ v) :=
+begin
+  simp only [parallelepiped, ← image_comp],
+  congr' 1 with t,
+  simp only [function.comp_app, linear_map.map_sum, linear_map.map_smulₛₗ, ring_hom.id_apply],
+end
+
+/-- Reindexing a family of vectors does not change their parallelepiped. -/
+@[simp] lemma parallelepiped_comp_equiv (v : ι → E) (e : ι' ≃ ι) :
+  parallelepiped (v ∘ e) = parallelepiped v :=
+begin
+  simp only [parallelepiped],
+  let K : (ι' → ℝ) ≃ (ι → ℝ) := equiv.Pi_congr_left' (λ (a : ι'), ℝ) e,
+  have : Icc (0 : (ι → ℝ)) 1 = K '' (Icc (0 : (ι' → ℝ)) 1),
+  { rw ← equiv.preimage_eq_iff_eq_image,
+    ext x,
+    simp only [mem_preimage, mem_Icc, pi.le_def, pi.zero_apply, equiv.Pi_congr_left'_apply,
+      pi.one_apply],
+    refine ⟨λ h, ⟨λ i, _, λ i, _⟩, λ h, ⟨λ i, h.1 (e.symm i), λ i, h.2 (e.symm i)⟩⟩,
+    { simpa only [equiv.symm_apply_apply] using h.1 (e i) },
+    { simpa only [equiv.symm_apply_apply] using h.2 (e i) } },
+  rw [this, ← image_comp],
+  congr' 1 with x,
+  simpa only [orthonormal_basis.coe_reindex, function.comp_app, equiv.symm_apply_apply,
+    equiv.Pi_congr_left'_apply, equiv.apply_symm_apply]
+      using (e.symm.sum_comp (λ (i : ι'), x i • v (e i))).symm,
+end
+
+/- The parallelepiped associated to an orthonormal basis of `ℝ` is either `[0, 1]` or `[-1, 0]`. -/
+lemma parallelepiped_orthonormal_basis_one_dim (b : orthonormal_basis ι ℝ ℝ) :
+  parallelepiped b = Icc 0 1 ∨ parallelepiped b = Icc (-1) 0 :=
+begin
+  have e : ι ≃ fin 1,
+  { apply fintype.equiv_fin_of_card_eq,
+    simp only [← finrank_eq_card_basis b.to_basis, finrank_self] },
+  have B : parallelepiped (b.reindex e) = parallelepiped b,
+  { convert parallelepiped_comp_equiv b e.symm,
+    ext i,
+    simp only [orthonormal_basis.coe_reindex] },
+  rw ← B,
+  let F : ℝ → (fin 1 → ℝ) := λ t, (λ i, t),
+  have A : Icc (0 : fin 1 → ℝ) 1 = F '' (Icc (0 : ℝ) 1),
+  { apply subset.antisymm,
+    { assume x hx,
+      refine ⟨x 0, ⟨hx.1 0, hx.2 0⟩, _⟩,
+      ext j,
+      simp only [subsingleton.elim j 0] },
+    { rintros x ⟨y, hy, rfl⟩,
+      exact ⟨λ j, hy.1, λ j, hy.2⟩ } },
+  rcases orthonormal_basis_one_dim (b.reindex e) with H|H,
+  { left,
+    simp only [H, parallelepiped, algebra.id.smul_eq_mul, mul_one, A,
+      finset.sum_singleton, ←image_comp, image_id', finset.univ_unique], },
+  { right,
+    simp only [H, parallelepiped, algebra.id.smul_eq_mul, mul_one],
+    rw A,
+    simp only [←image_comp, mul_neg, mul_one, finset.sum_singleton, image_neg, preimage_neg_Icc,
+      neg_zero, finset.univ_unique] },
+end
+
+lemma parallelepiped_eq_sum_segment (v : ι → E) : parallelepiped v = ∑ i, segment ℝ 0 (v i) :=
+begin
+  ext,
+  simp only [mem_parallelepiped_iff, set.mem_finset_sum, finset.mem_univ, forall_true_left,
+    segment_eq_image, smul_zero, zero_add, ←set.pi_univ_Icc, set.mem_univ_pi],
+  split,
+  { rintro ⟨t, ht, rfl⟩,
+    exact ⟨t • v, λ i, ⟨t i, ht _, by simp⟩, rfl⟩ },
+  rintro ⟨g, hg, rfl⟩,
+  change ∀ i, _ at hg,
+  choose t ht hg using hg,
+  refine ⟨t, ht, _⟩,
+  simp_rw hg,
+end
+
+lemma convex_parallelepiped (v : ι → E) : convex ℝ (parallelepiped v) :=
+begin
+  rw parallelepiped_eq_sum_segment,
+  exact convex_sum _ (λ i hi, convex_segment  _ _),
+end
+
+/-- A `parallelepiped` is the convex hull of its vertices -/
+lemma parallelepiped_eq_convex_hull (v : ι → E) :
+  parallelepiped v = convex_hull ℝ (∑ i, {(0 : E), v i}) :=
+by simp_rw [convex_hull_sum, convex_hull_pair, parallelepiped_eq_sum_segment]
+
+/-- The axis aligned parallelepiped over `ι → ℝ` is a cuboid. -/
+lemma parallelepiped_single [decidable_eq ι] (a : ι → ℝ) :
+  parallelepiped (λ i, pi.single i (a i)) = set.uIcc 0 a :=
+begin
+  ext,
+  simp_rw [set.uIcc, mem_parallelepiped_iff, set.mem_Icc, pi.le_def, ←forall_and_distrib,
+    pi.inf_apply, pi.sup_apply, ←pi.single_smul', pi.one_apply, pi.zero_apply, ←pi.smul_apply',
+    finset.univ_sum_single (_ : ι → ℝ)],
+  split,
+  { rintros ⟨t, ht, rfl⟩ i,
+    specialize ht i,
+    simp_rw [smul_eq_mul, pi.mul_apply],
+    cases le_total (a i) 0 with hai hai,
+    { rw [sup_eq_left.mpr hai, inf_eq_right.mpr hai],
+      exact ⟨le_mul_of_le_one_left hai ht.2, mul_nonpos_of_nonneg_of_nonpos ht.1 hai⟩ },
+    { rw [sup_eq_right.mpr hai, inf_eq_left.mpr hai],
+      exact ⟨mul_nonneg ht.1 hai, mul_le_of_le_one_left hai ht.2⟩ } },
+  { intro h,
+    refine ⟨λ i, x i / a i, λ i, _, funext $ λ i, _⟩,
+    { specialize h i,
+      cases le_total (a i) 0 with hai hai,
+      { rw [sup_eq_left.mpr hai, inf_eq_right.mpr hai] at h,
+        exact ⟨div_nonneg_of_nonpos h.2 hai, div_le_one_of_ge h.1 hai⟩ },
+      { rw [sup_eq_right.mpr hai, inf_eq_left.mpr hai] at h,
+        exact ⟨div_nonneg h.1 hai, div_le_one_of_le h.2 hai⟩ } },
+    { specialize h i,
+      simp only [smul_eq_mul, pi.mul_apply],
+      cases eq_or_ne (a i) 0 with hai hai,
+      { rw [hai, inf_idem, sup_idem, ←le_antisymm_iff] at h,
+        rw [hai, ← h, zero_div, zero_mul] },
+      { rw div_mul_cancel _ hai } } },
+end
+
+end add_comm_group
+
+section normed_space
+
+variables [normed_add_comm_group E] [normed_add_comm_group F] [normed_space ℝ E] [normed_space ℝ F]
+
+/-- The parallelepiped spanned by a basis, as a compact set with nonempty interior. -/
+def basis.parallelepiped (b : basis ι ℝ E) : positive_compacts E :=
+{ carrier := parallelepiped b,
+  is_compact' := is_compact_Icc.image (continuous_finset_sum finset.univ
+    (λ (i : ι) (H : i ∈ finset.univ), (continuous_apply i).smul continuous_const)),
+  interior_nonempty' :=
+    begin
+      suffices H : set.nonempty (interior (b.equiv_funL.symm.to_homeomorph '' (Icc 0 1))),
+      { dsimp only [parallelepiped],
+        convert H,
+        ext t,
+        exact (b.equiv_fun_symm_apply t).symm },
+      have A : set.nonempty (interior (Icc (0 : ι → ℝ) 1)),
+      { rw [← pi_univ_Icc, interior_pi_set (@finite_univ ι _)],
+        simp only [univ_pi_nonempty_iff, pi.zero_apply, pi.one_apply, interior_Icc, nonempty_Ioo,
+          zero_lt_one, implies_true_iff] },
+      rwa [← homeomorph.image_interior, nonempty_image_iff],
+    end }
+
+@[simp] lemma basis.coe_parallelepiped (b : basis ι ℝ E) :
+  (b.parallelepiped : set E) = parallelepiped b :=
+rfl
+
+@[simp] lemma basis.parallelepiped_reindex (b : basis ι ℝ E) (e : ι ≃ ι') :
+  (b.reindex e).parallelepiped = b.parallelepiped :=
+positive_compacts.ext $
+  (congr_arg parallelepiped (b.coe_reindex _)).trans (parallelepiped_comp_equiv b e.symm)
+
+lemma basis.parallelepiped_map (b : basis ι ℝ E) (e : E ≃ₗ[ℝ] F) :
+  (b.map e).parallelepiped = b.parallelepiped.map e
+    (by haveI := finite_dimensional.of_fintype_basis b; exact
+      e.to_linear_map.continuous_of_finite_dimensional)
+    (by haveI := finite_dimensional.of_fintype_basis (b.map e); exact
+      e.to_linear_map.is_open_map_of_finite_dimensional e.surjective) :=
+positive_compacts.ext (image_parallelepiped e.to_linear_map _).symm
+
+variables [measurable_space E] [borel_space E]
+
+/-- The Lebesgue measure associated to a basis, giving measure `1` to the parallelepiped spanned
+by the basis. -/
+@[irreducible] def basis.add_haar (b : basis ι ℝ E) : measure E :=
+measure.add_haar_measure b.parallelepiped
+
+instance is_add_haar_measure_basis_add_haar (b : basis ι ℝ E) :
+  is_add_haar_measure b.add_haar :=
+by { rw basis.add_haar, exact measure.is_add_haar_measure_add_haar_measure _ }
+
+lemma basis.add_haar_self (b : basis ι ℝ E) : b.add_haar (parallelepiped b) = 1 :=
+by { rw [basis.add_haar], exact add_haar_measure_self }
+
+end normed_space
+
+/-- A finite dimensional inner product space has a canonical measure, the Lebesgue measure giving
+volume `1` to the parallelepiped spanned by any orthonormal basis. We define the measure using
+some arbitrary choice of orthonormal basis. The fact that it works with any orthonormal basis
+is proved in `orthonormal_basis.volume_parallelepiped`. -/
+@[priority 100] instance measure_space_of_inner_product_space
+  [normed_add_comm_group E] [inner_product_space ℝ E] [finite_dimensional ℝ E]
+  [measurable_space E] [borel_space E] :
+  measure_space E :=
+{ volume := (std_orthonormal_basis ℝ E).to_basis.add_haar }
+
+/- This instance should not be necessary, but Lean has difficulties to find it in product
+situations if we do not declare it explicitly. -/
+instance real.measure_space : measure_space ℝ := by apply_instance
+
+/-! # Miscellaneous instances for `euclidean_space`
+
+In combination with `measure_space_of_inner_product_space`, these put a `measure_space` structure
+on `euclidean_space`. -/
+namespace euclidean_space
+variables (ι)
+
+-- TODO: do we want these instances for `pi_Lp` too?
+instance : measurable_space (euclidean_space ℝ ι) := measurable_space.pi
+instance : borel_space (euclidean_space ℝ ι) := pi.borel_space
+
+/-- `pi_Lp.equiv` as a `measurable_equiv`. -/
+@[simps to_equiv]
+protected def measurable_equiv : euclidean_space ℝ ι ≃ᵐ (ι → ℝ) :=
+{ to_equiv := pi_Lp.equiv _ _,
+  measurable_to_fun := measurable_id,
+  measurable_inv_fun := measurable_id }
+
+lemma coe_measurable_equiv : ⇑(euclidean_space.measurable_equiv ι) = pi_Lp.equiv 2 _ := rfl
+
+end euclidean_space
diff --git a/src/measure_theory/measure/haar/quotient.lean b/src/measure_theory/measure/haar/quotient.lean
new file mode 100644
index 0000000000000..5bd1067dbc4e5
--- /dev/null
+++ b/src/measure_theory/measure/haar/quotient.lean
@@ -0,0 +1,329 @@
+/-
+Copyright (c) 2022 Alex Kontorovich and Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alex Kontorovich, Heather Macbeth
+-/
+
+import measure_theory.measure.haar.basic
+import measure_theory.group.fundamental_domain
+import algebra.group.opposite
+
+/-!
+# Haar quotient measure
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we consider properties of fundamental domains and measures for the action of a
+subgroup of a group `G` on `G` itself.
+
+## Main results
+
+* `measure_theory.is_fundamental_domain.smul_invariant_measure_map `: given a subgroup `Γ` of a
+  topological group `G`, the pushforward to the coset space `G ⧸ Γ` of the restriction of a both
+  left- and right-invariant measure on `G` to a fundamental domain `𝓕` is a `G`-invariant measure
+  on `G ⧸ Γ`.
+
+* `measure_theory.is_fundamental_domain.is_mul_left_invariant_map `: given a normal subgroup `Γ` of
+  a topological group `G`, the pushforward to the quotient group `G ⧸ Γ` of the restriction of
+  a both left- and right-invariant measure on `G` to a fundamental domain `𝓕` is a left-invariant
+  measure on `G ⧸ Γ`.
+
+Note that a group `G` with Haar measure that is both left and right invariant is called
+**unimodular**.
+-/
+
+noncomputable theory
+
+open set measure_theory topological_space measure_theory.measure quotient_group
+open_locale pointwise measure_theory topology big_operators nnreal ennreal
+
+variables {G : Type*} [group G] [measurable_space G] [topological_space G]
+  [topological_group G] [borel_space G]
+  {μ : measure G}
+  {Γ : subgroup G}
+
+/-- Measurability of the action of the topological group `G` on the left-coset space `G/Γ`. -/
+@[to_additive "Measurability of the action of the additive topological group `G` on the left-coset
+  space `G/Γ`."]
+instance quotient_group.has_measurable_smul [measurable_space (G ⧸ Γ)] [borel_space (G ⧸ Γ)] :
+  has_measurable_smul G (G ⧸ Γ) :=
+{ measurable_const_smul := λ g, (continuous_const_smul g).measurable,
+  measurable_smul_const := λ x, (quotient_group.continuous_smul₁ x).measurable }
+
+variables {𝓕 : set G} (h𝓕 : is_fundamental_domain Γ.opposite 𝓕 μ)
+include h𝓕
+
+variables [countable Γ] [measurable_space (G ⧸ Γ)] [borel_space (G ⧸ Γ)]
+
+/-- The pushforward to the coset space `G ⧸ Γ` of the restriction of a both left- and right-
+  invariant measure on `G` to a fundamental domain `𝓕` is a `G`-invariant measure on `G ⧸ Γ`. -/
+@[to_additive "The pushforward to the coset space `G ⧸ Γ` of the restriction of a both left- and
+  right-invariant measure on an additive topological group `G` to a fundamental domain `𝓕` is a
+  `G`-invariant measure on `G ⧸ Γ`."]
+lemma measure_theory.is_fundamental_domain.smul_invariant_measure_map
+  [μ.is_mul_left_invariant] [μ.is_mul_right_invariant] :
+  smul_invariant_measure G (G ⧸ Γ) (measure.map quotient_group.mk (μ.restrict 𝓕)) :=
+{ measure_preimage_smul :=
+  begin
+    let π : G → G ⧸ Γ := quotient_group.mk,
+    have meas_π : measurable π :=
+      continuous_quotient_mk.measurable,
+    have 𝓕meas : null_measurable_set 𝓕 μ := h𝓕.null_measurable_set,
+    intros g A hA,
+    have meas_πA : measurable_set (π ⁻¹' A) := measurable_set_preimage meas_π hA,
+    rw [measure.map_apply meas_π hA,
+      measure.map_apply meas_π (measurable_set_preimage (measurable_const_smul g) hA),
+      measure.restrict_apply₀' 𝓕meas, measure.restrict_apply₀' 𝓕meas],
+    set π_preA := π ⁻¹' A,
+    have : (quotient_group.mk ⁻¹' ((λ (x : G ⧸ Γ), g • x) ⁻¹' A)) = has_mul.mul g ⁻¹' π_preA,
+    { ext1, simp },
+    rw this,
+    have : μ (has_mul.mul g ⁻¹' π_preA ∩ 𝓕) = μ (π_preA ∩ has_mul.mul (g⁻¹) ⁻¹' 𝓕),
+    { transitivity μ (has_mul.mul g ⁻¹' (π_preA ∩ has_mul.mul g⁻¹ ⁻¹' 𝓕)),
+      { rw preimage_inter,
+        congr,
+        rw [← preimage_comp, comp_mul_left, mul_left_inv],
+        ext,
+        simp, },
+      rw measure_preimage_mul, },
+    rw this,
+    have h𝓕_translate_fundom : is_fundamental_domain Γ.opposite (g • 𝓕) μ := h𝓕.smul_of_comm g,
+    rw [h𝓕.measure_set_eq h𝓕_translate_fundom meas_πA, ← preimage_smul_inv], refl,
+    rintros ⟨γ, γ_in_Γ⟩,
+    ext,
+    have : π (x * (mul_opposite.unop γ)) = π (x) := by simpa [quotient_group.eq'] using γ_in_Γ,
+    simp [(•), this],
+  end }
+
+/-- Assuming `Γ` is a normal subgroup of a topological group `G`, the pushforward to the quotient
+  group `G ⧸ Γ` of the restriction of a both left- and right-invariant measure on `G` to a
+  fundamental domain `𝓕` is a left-invariant measure on `G ⧸ Γ`. -/
+@[to_additive "Assuming `Γ` is a normal subgroup of an additive topological group `G`, the
+  pushforward to the quotient group `G ⧸ Γ` of the restriction of a both left- and right-invariant
+  measure on `G` to a fundamental domain `𝓕` is a left-invariant measure on `G ⧸ Γ`."]
+lemma measure_theory.is_fundamental_domain.is_mul_left_invariant_map [subgroup.normal Γ]
+  [μ.is_mul_left_invariant] [μ.is_mul_right_invariant] :
+  (measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)).is_mul_left_invariant :=
+{ map_mul_left_eq_self := begin
+    intros x,
+    apply measure.ext,
+    intros A hA,
+    obtain ⟨x₁, _⟩ := @quotient.exists_rep _ (quotient_group.left_rel Γ) x,
+    haveI := h𝓕.smul_invariant_measure_map,
+    convert measure_preimage_smul x₁ ((measure.map quotient_group.mk) (μ.restrict 𝓕)) A using 1,
+    rw [← h, measure.map_apply],
+    { refl, },
+    { exact measurable_const_mul _, },
+    { exact hA, },
+  end }
+
+/-- Given a normal subgroup `Γ` of a topological group `G` with Haar measure `μ`, which is also
+  right-invariant, and a finite volume fundamental domain `𝓕`, the pushforward to the quotient
+  group `G ⧸ Γ` of the restriction of `μ` to `𝓕` is a multiple of Haar measure on `G ⧸ Γ`. -/
+@[to_additive "Given a normal subgroup `Γ` of an additive topological group `G` with Haar measure
+  `μ`, which is also right-invariant, and a finite volume fundamental domain `𝓕`, the pushforward
+  to the quotient group `G ⧸ Γ` of the restriction of `μ` to `𝓕` is a multiple of Haar measure on
+  `G ⧸ Γ`."]
+lemma measure_theory.is_fundamental_domain.map_restrict_quotient [t2_space (G ⧸ Γ)]
+  [second_countable_topology (G ⧸ Γ)] (K : positive_compacts (G ⧸ Γ)) [subgroup.normal Γ]
+  [measure_theory.measure.is_haar_measure μ] [μ.is_mul_right_invariant]
+  (h𝓕_finite : μ 𝓕 < ⊤) : measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)
+  = (μ (𝓕 ∩ (quotient_group.mk' Γ) ⁻¹' K)) • (measure_theory.measure.haar_measure K) :=
+begin
+  let π : G →* G ⧸ Γ := quotient_group.mk' Γ,
+  have meas_π : measurable π := continuous_quotient_mk.measurable,
+  have 𝓕meas : null_measurable_set 𝓕 μ := h𝓕.null_measurable_set,
+  haveI : is_finite_measure (μ.restrict 𝓕) :=
+    ⟨by { rw [measure.restrict_apply₀' 𝓕meas, univ_inter], exact h𝓕_finite }⟩,
+  -- the measure is left-invariant, so by the uniqueness of Haar measure it's enough to show that
+  -- it has the stated size on the reference compact set `K`.
+  haveI : (measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)).is_mul_left_invariant :=
+    h𝓕.is_mul_left_invariant_map,
+  rw [measure.haar_measure_unique (measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)) K,
+    measure.map_apply meas_π, measure.restrict_apply₀' 𝓕meas, inter_comm],
+  exact K.is_compact.measurable_set,
+end
+
+/-- Given a normal subgroup `Γ` of a topological group `G` with Haar measure `μ`, which is also
+  right-invariant, and a finite volume fundamental domain `𝓕`, the quotient map to `G ⧸ Γ` is
+  measure-preserving between appropriate multiples of Haar measure on `G` and `G ⧸ Γ`. -/
+@[to_additive measure_preserving_quotient_add_group.mk' "Given a normal subgroup `Γ` of an additive
+  topological group `G` with Haar measure `μ`, which is also right-invariant, and a finite volume
+  fundamental domain `𝓕`, the quotient map to `G ⧸ Γ` is measure-preserving between appropriate
+  multiples of Haar measure on `G` and `G ⧸ Γ`."]
+lemma measure_preserving_quotient_group.mk' [t2_space (G ⧸ Γ)] [second_countable_topology (G ⧸ Γ)]
+  (K : positive_compacts (G ⧸ Γ)) [subgroup.normal Γ] [measure_theory.measure.is_haar_measure μ]
+  [μ.is_mul_right_invariant] (h𝓕_finite : μ 𝓕 < ⊤) (c : ℝ≥0)
+  (h : μ (𝓕 ∩ (quotient_group.mk' Γ) ⁻¹' K) = c) :
+  measure_preserving
+    (quotient_group.mk' Γ)
+    (μ.restrict 𝓕)
+    (c • (measure_theory.measure.haar_measure K)) :=
+{ measurable := continuous_quotient_mk.measurable,
+  map_eq := by rw [h𝓕.map_restrict_quotient K h𝓕_finite, h]; refl }
+
+section
+
+local notation `μ_𝓕` := measure.map (@quotient_group.mk G _ Γ) (μ.restrict 𝓕)
+
+/-- The `ess_sup` of a function `g` on the quotient space `G ⧸ Γ` with respect to the pushforward
+  of the restriction, `μ_𝓕`, of a right-invariant measure `μ` to a fundamental domain `𝓕`, is the
+  same as the `ess_sup` of `g`'s lift to the universal cover `G` with respect to `μ`. -/
+@[to_additive "The `ess_sup` of a function `g` on the additive quotient space `G ⧸ Γ` with respect
+  to the pushforward of the restriction, `μ_𝓕`, of a right-invariant measure `μ` to a fundamental
+  domain `𝓕`, is the same as the `ess_sup` of `g`'s lift to the universal cover `G` with respect
+  to `μ`."]
+lemma ess_sup_comp_quotient_group_mk [μ.is_mul_right_invariant] {g : G ⧸ Γ → ℝ≥0∞}
+  (g_ae_measurable : ae_measurable g μ_𝓕) :
+  ess_sup g μ_𝓕 = ess_sup (λ (x : G), g x) μ :=
+begin
+  have hπ : measurable (quotient_group.mk : G → G ⧸ Γ) := continuous_quotient_mk.measurable,
+  rw ess_sup_map_measure g_ae_measurable hπ.ae_measurable,
+  refine h𝓕.ess_sup_measure_restrict _,
+  rintros ⟨γ, hγ⟩ x,
+  dsimp,
+  congr' 1,
+  exact quotient_group.mk_mul_of_mem x hγ,
+end
+
+/-- Given a quotient space `G ⧸ Γ` where `Γ` is `countable`, and the restriction,
+  `μ_𝓕`, of a right-invariant measure `μ` on `G` to a fundamental domain `𝓕`, a set
+  in the quotient which has `μ_𝓕`-measure zero, also has measure zero under the
+  folding of `μ` under the quotient. Note that, if `Γ` is infinite, then the folded map
+  will take the value `∞` on any open set in the quotient! -/
+@[to_additive "Given an additive quotient space `G ⧸ Γ` where `Γ` is `countable`, and the
+  restriction, `μ_𝓕`, of a right-invariant measure `μ` on `G` to a fundamental domain `𝓕`, a set
+  in the quotient which has `μ_𝓕`-measure zero, also has measure zero under the
+  folding of `μ` under the quotient. Note that, if `Γ` is infinite, then the folded map
+  will take the value `∞` on any open set in the quotient!"]
+lemma _root_.measure_theory.is_fundamental_domain.absolutely_continuous_map
+  [μ.is_mul_right_invariant] :
+  map (quotient_group.mk : G → G ⧸ Γ) μ ≪ map (quotient_group.mk : G → G ⧸ Γ) (μ.restrict 𝓕) :=
+begin
+  set π : G → G ⧸ Γ := quotient_group.mk,
+  have meas_π : measurable π := continuous_quotient_mk.measurable,
+  apply absolutely_continuous.mk,
+  intros s s_meas hs,
+  rw map_apply meas_π s_meas at hs ⊢,
+  rw measure.restrict_apply at hs,
+  apply h𝓕.measure_zero_of_invariant _ _ hs,
+  { intros γ,
+    ext g,
+    rw [set.mem_smul_set_iff_inv_smul_mem, mem_preimage, mem_preimage],
+    congrm _ ∈ s,
+    convert quotient_group.mk_mul_of_mem g (γ⁻¹).2, },
+  exact measurable_set_preimage meas_π s_meas,
+end
+
+local attribute [-instance] quotient.measurable_space
+
+/-- This is a simple version of the **Unfolding Trick**: Given a subgroup `Γ` of a group `G`, the
+  integral of a function `f` on `G` with respect to a right-invariant measure `μ` is equal to the
+  integral over the quotient `G ⧸ Γ` of the automorphization of `f`. -/
+@[to_additive "This is a simple version of the **Unfolding Trick**: Given a subgroup `Γ` of an
+  additive  group `G`, the integral of a function `f` on `G` with respect to a right-invariant
+  measure `μ` is equal to the integral over the quotient `G ⧸ Γ` of the automorphization of `f`."]
+lemma quotient_group.integral_eq_integral_automorphize {E : Type*} [normed_add_comm_group E]
+  [complete_space E] [normed_space ℝ E] [μ.is_mul_right_invariant] {f : G → E}
+  (hf₁ : integrable f μ) (hf₂ : ae_strongly_measurable (automorphize f) μ_𝓕) :
+  ∫ x : G, f x ∂μ = ∫ x : G ⧸ Γ, automorphize f x ∂μ_𝓕 :=
+calc ∫ x : G, f x ∂μ  = ∑' γ : Γ.opposite, ∫ x in 𝓕, f (γ • x) ∂μ : h𝓕.integral_eq_tsum'' f hf₁
+... = ∫ x in 𝓕, ∑' γ : Γ.opposite, f (γ • x) ∂μ :
+  begin
+    rw integral_tsum,
+    { exact λ i, (hf₁.1.comp_quasi_measure_preserving
+        (measure_preserving_smul i μ).quasi_measure_preserving).restrict, },
+    { rw ← h𝓕.lintegral_eq_tsum'' (λ x, ‖f x‖₊),
+      exact ne_of_lt hf₁.2, },
+  end
+... = ∫ x : G ⧸ Γ, automorphize f x ∂μ_𝓕 :
+  (integral_map continuous_quotient_mk.ae_measurable hf₂).symm
+
+/-- This is the **Unfolding Trick**: Given a subgroup `Γ` of a group `G`, the integral of a
+  function `f` on `G` times the lift to `G` of a function `g` on the quotient `G ⧸ Γ` with respect
+  to a right-invariant measure `μ` on `G`, is equal to the integral over the quotient of the
+  automorphization of `f` times `g`. -/
+lemma quotient_group.integral_mul_eq_integral_automorphize_mul {K : Type*} [normed_field K]
+  [complete_space K] [normed_space ℝ K] [μ.is_mul_right_invariant] {f : G → K}
+  (f_ℒ_1 : integrable f μ) {g : G ⧸ Γ → K} (hg : ae_strongly_measurable g μ_𝓕)
+  (g_ℒ_infinity : ess_sup (λ x, ↑‖g x‖₊) μ_𝓕 ≠ ∞)
+  (F_ae_measurable : ae_strongly_measurable (quotient_group.automorphize f) μ_𝓕) :
+  ∫ x : G, g (x : G ⧸ Γ) * (f x) ∂μ = ∫ x : G ⧸ Γ, g x * (quotient_group.automorphize f x) ∂μ_𝓕 :=
+begin
+  let π : G → G ⧸ Γ := quotient_group.mk,
+  have H₀ : quotient_group.automorphize ((g ∘ π) * f) = g * (quotient_group.automorphize f) :=
+    quotient_group.automorphize_smul_left f g,
+  calc ∫ (x : G), g (π x) * f x ∂μ =
+       ∫ (x : G ⧸ Γ), quotient_group.automorphize ((g ∘ π) * f) x ∂μ_𝓕 : _
+  ... = ∫ (x : G ⧸ Γ), g x * (quotient_group.automorphize f x) ∂μ_𝓕 : by simp [H₀],
+  have meas_π : measurable π := continuous_quotient_mk.measurable,
+  have H₁ : integrable ((g ∘ π) * f) μ,
+  { have : ae_strongly_measurable (λ x : G, g (x : G ⧸ Γ)) μ,
+    { refine (ae_strongly_measurable_of_absolutely_continuous _ _ hg).comp_measurable meas_π,
+      exact h𝓕.absolutely_continuous_map },
+    refine integrable.ess_sup_smul f_ℒ_1 this _,
+    { have hg' : ae_strongly_measurable (λ x, ↑‖g x‖₊) μ_𝓕 :=
+        (ennreal.continuous_coe.comp continuous_nnnorm).comp_ae_strongly_measurable hg,
+      rw [← ess_sup_comp_quotient_group_mk h𝓕 hg'.ae_measurable],
+      exact g_ℒ_infinity } },
+  have H₂ : ae_strongly_measurable (quotient_group.automorphize ((g ∘ π) * f)) μ_𝓕,
+  { simp_rw [H₀],
+    exact hg.mul F_ae_measurable },
+  apply quotient_group.integral_eq_integral_automorphize h𝓕 H₁ H₂,
+end
+
+end
+
+section
+
+variables {G' : Type*} [add_group G'] [measurable_space G'] [topological_space G']
+  [topological_add_group G'] [borel_space G']
+  {μ' : measure G'}
+  {Γ' : add_subgroup G'}
+  [countable Γ'] [measurable_space (G' ⧸ Γ')] [borel_space (G' ⧸ Γ')]
+  {𝓕' : set G'}
+
+local notation `μ_𝓕` := measure.map (@quotient_add_group.mk G' _ Γ') (μ'.restrict 𝓕')
+
+/-- This is the **Unfolding Trick**: Given an additive subgroup `Γ'` of an additive group `G'`, the
+  integral of a function `f` on `G'` times the lift to `G'` of a function `g` on the quotient
+  `G' ⧸ Γ'` with respect to a right-invariant measure `μ` on `G'`, is equal to the integral over
+  the quotient of the automorphization of `f` times `g`. -/
+lemma quotient_add_group.integral_mul_eq_integral_automorphize_mul
+{K : Type*} [normed_field K]
+  [complete_space K] [normed_space ℝ K] [μ'.is_add_right_invariant] {f : G' → K}
+  (f_ℒ_1 : integrable f μ') {g : G' ⧸ Γ' → K} (hg : ae_strongly_measurable g μ_𝓕)
+  (g_ℒ_infinity : ess_sup (λ x, ↑‖g x‖₊) μ_𝓕 ≠ ∞)
+  (F_ae_measurable : ae_strongly_measurable (quotient_add_group.automorphize f) μ_𝓕)
+  (h𝓕 : is_add_fundamental_domain Γ'.opposite 𝓕' μ') :
+  ∫ x : G', g (x : G' ⧸ Γ') * (f x) ∂μ'
+    = ∫ x : G' ⧸ Γ', g x * (quotient_add_group.automorphize f x) ∂μ_𝓕 :=
+begin
+  let π : G' → G' ⧸ Γ' := quotient_add_group.mk,
+  have H₀ : quotient_add_group.automorphize ((g ∘ π) * f)
+    = g * (quotient_add_group.automorphize f) :=
+    quotient_add_group.automorphize_smul_left f g,
+  calc ∫ (x : G'), g (π x) * f x ∂μ' =
+       ∫ (x : G' ⧸ Γ'), quotient_add_group.automorphize ((g ∘ π) * f) x ∂μ_𝓕 : _
+  ... = ∫ (x : G' ⧸ Γ'), g x * (quotient_add_group.automorphize f x) ∂μ_𝓕 : by simp [H₀],
+  have meas_π : measurable π := continuous_quotient_mk.measurable,
+  have H₁ : integrable ((g ∘ π) * f) μ',
+  { have : ae_strongly_measurable (λ x : G', g (x : G' ⧸ Γ')) μ',
+    { refine (ae_strongly_measurable_of_absolutely_continuous _ _ hg).comp_measurable meas_π,
+      exact h𝓕.absolutely_continuous_map },
+    refine integrable.ess_sup_smul f_ℒ_1 this _,
+    { have hg' : ae_strongly_measurable (λ x, ↑‖g x‖₊) μ_𝓕 :=
+        (ennreal.continuous_coe.comp continuous_nnnorm).comp_ae_strongly_measurable hg,
+      rw [← ess_sup_comp_quotient_add_group_mk h𝓕 hg'.ae_measurable],
+      exact g_ℒ_infinity } },
+  have H₂ : ae_strongly_measurable (quotient_add_group.automorphize ((g ∘ π) * f)) μ_𝓕,
+  { simp_rw [H₀],
+    exact hg.mul F_ae_measurable },
+  apply quotient_add_group.integral_eq_integral_automorphize h𝓕 H₁ H₂,
+end
+
+end
+
+attribute [to_additive quotient_group.integral_mul_eq_integral_automorphize_mul]
+  quotient_add_group.integral_mul_eq_integral_automorphize_mul
diff --git a/src/measure_theory/measure/haar_lebesgue.lean b/src/measure_theory/measure/haar_lebesgue.lean
deleted file mode 100644
index 6d9e86eb8b61c..0000000000000
--- a/src/measure_theory/measure/haar_lebesgue.lean
+++ /dev/null
@@ -1,776 +0,0 @@
-/-
-Copyright (c) 2021 Floris van Doorn. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Floris van Doorn, Sébastien Gouëzel
--/
-import measure_theory.measure.lebesgue
-import measure_theory.measure.haar
-import linear_algebra.finite_dimensional
-import analysis.normed_space.pointwise
-import measure_theory.group.pointwise
-
-/-!
-# Relationship between the Haar and Lebesgue measures
-
-We prove that the Haar measure and Lebesgue measure are equal on `ℝ` and on `ℝ^ι`, in
-`measure_theory.add_haar_measure_eq_volume` and `measure_theory.add_haar_measure_eq_volume_pi`.
-
-We deduce basic properties of any Haar measure on a finite dimensional real vector space:
-* `map_linear_map_add_haar_eq_smul_add_haar`: a linear map rescales the Haar measure by the
-  absolute value of its determinant.
-* `add_haar_preimage_linear_map` : when `f` is a linear map with nonzero determinant, the measure
-  of `f ⁻¹' s` is the measure of `s` multiplied by the absolute value of the inverse of the
-  determinant of `f`.
-* `add_haar_image_linear_map` :  when `f` is a linear map, the measure of `f '' s` is the
-  measure of `s` multiplied by the absolute value of the determinant of `f`.
-* `add_haar_submodule` : a strict submodule has measure `0`.
-* `add_haar_smul` : the measure of `r • s` is `|r| ^ dim * μ s`.
-* `add_haar_ball`: the measure of `ball x r` is `r ^ dim * μ (ball 0 1)`.
-* `add_haar_closed_ball`: the measure of `closed_ball x r` is `r ^ dim * μ (ball 0 1)`.
-* `add_haar_sphere`: spheres have zero measure.
-
-We also show that a Lebesgue density point `x` of a set `s` (with respect to closed balls) has
-density one for the rescaled copies `{x} + r • t` of a given set `t` with positive measure, in
-`tendsto_add_haar_inter_smul_one_of_density_one`. In particular, `s` intersects `{x} + r • t` for
-small `r`, see `eventually_nonempty_inter_smul_of_density_one`.
--/
-
-open topological_space set filter metric
-open_locale ennreal pointwise topological_space
-
-/-- The interval `[0,1]` as a compact set with non-empty interior. -/
-def topological_space.positive_compacts.Icc01 : positive_compacts ℝ :=
-{ carrier := Icc 0 1,
-  compact' := is_compact_Icc,
-  interior_nonempty' := by simp_rw [interior_Icc, nonempty_Ioo, zero_lt_one] }
-
-universe u
-
-/-- The set `[0,1]^ι` as a compact set with non-empty interior. -/
-def topological_space.positive_compacts.pi_Icc01 (ι : Type*) [fintype ι] :
-  positive_compacts (ι → ℝ) :=
-{ carrier := pi univ (λ i, Icc 0 1),
-  compact' := is_compact_univ_pi (λ i, is_compact_Icc),
-  interior_nonempty' := by simp only [interior_pi_set, finite.of_fintype, interior_Icc,
-    univ_pi_nonempty_iff, nonempty_Ioo, implies_true_iff, zero_lt_one] }
-
-namespace measure_theory
-
-open measure topological_space.positive_compacts finite_dimensional
-
-/-!
-### The Lebesgue measure is a Haar measure on `ℝ` and on `ℝ^ι`.
--/
-
-/-- The Haar measure equals the Lebesgue measure on `ℝ`. -/
-lemma add_haar_measure_eq_volume : add_haar_measure Icc01 = volume :=
-by { convert (add_haar_measure_unique volume Icc01).symm, simp [Icc01] }
-
-instance : is_add_haar_measure (volume : measure ℝ) :=
-by { rw ← add_haar_measure_eq_volume, apply_instance }
-
-/-- The Haar measure equals the Lebesgue measure on `ℝ^ι`. -/
-lemma add_haar_measure_eq_volume_pi (ι : Type*) [fintype ι] :
-  add_haar_measure (pi_Icc01 ι) = volume :=
-begin
-  convert (add_haar_measure_unique volume (pi_Icc01 ι)).symm,
-  simp only [pi_Icc01, volume_pi_pi (λ i, Icc (0 : ℝ) 1), positive_compacts.coe_mk,
-    compacts.coe_mk, finset.prod_const_one, ennreal.of_real_one, real.volume_Icc, one_smul,
-    sub_zero],
-end
-
-instance is_add_haar_measure_volume_pi (ι : Type*) [fintype ι] :
-  is_add_haar_measure (volume : measure (ι → ℝ)) :=
-by { rw ← add_haar_measure_eq_volume_pi, apply_instance }
-
-namespace measure
-
-/-!
-### Strict subspaces have zero measure
--/
-
-/-- If a set is disjoint of its translates by infinitely many bounded vectors, then it has measure
-zero. This auxiliary lemma proves this assuming additionally that the set is bounded. -/
-lemma add_haar_eq_zero_of_disjoint_translates_aux
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  {s : set E} (u : ℕ → E) (sb : bounded s) (hu : bounded (range u))
-  (hs : pairwise (disjoint on (λ n, {u n} + s))) (h's : measurable_set s) :
-  μ s = 0 :=
-begin
-  by_contra h,
-  apply lt_irrefl ∞,
-  calc
-  ∞ = ∑' (n : ℕ), μ s : (ennreal.tsum_const_eq_top_of_ne_zero h).symm
-  ... = ∑' (n : ℕ), μ ({u n} + s) :
-    by { congr' 1, ext1 n, simp only [image_add_left, measure_preimage_add, singleton_add] }
-  ... = μ (⋃ n, {u n} + s) :
-    by rw measure_Union hs
-      (λ n, by simpa only [image_add_left, singleton_add] using measurable_id.const_add _ h's)
-  ... = μ (range u + s) : by rw [← Union_add, Union_singleton_eq_range]
-  ... < ∞ : bounded.measure_lt_top (hu.add sb)
-end
-
-/-- If a set is disjoint of its translates by infinitely many bounded vectors, then it has measure
-zero. -/
-lemma add_haar_eq_zero_of_disjoint_translates
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  {s : set E} (u : ℕ → E) (hu : bounded (range u))
-  (hs : pairwise (disjoint on (λ n, {u n} + s))) (h's : measurable_set s) :
-  μ s = 0 :=
-begin
-  suffices H : ∀ R, μ (s ∩ closed_ball 0 R) = 0,
-  { apply le_antisymm _ (zero_le _),
-    calc μ s ≤ ∑' (n : ℕ), μ (s ∩ closed_ball 0 n) :
-      by { conv_lhs { rw ← Union_inter_closed_ball_nat s 0 }, exact measure_Union_le _ }
-    ... = 0 : by simp only [H, tsum_zero] },
-  assume R,
-  apply add_haar_eq_zero_of_disjoint_translates_aux μ u
-    (bounded.mono (inter_subset_right _ _) bounded_closed_ball) hu _
-    (h's.inter (measurable_set_closed_ball)),
-  apply pairwise_disjoint.mono hs (λ n, _),
-  exact add_subset_add (subset.refl _) (inter_subset_left _ _)
-end
-
-/-- A strict vector subspace has measure zero. -/
-lemma add_haar_submodule
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (s : submodule ℝ E) (hs : s ≠ ⊤) : μ s = 0 :=
-begin
-  obtain ⟨x, hx⟩ : ∃ x, x ∉ s,
-    by simpa only [submodule.eq_top_iff', not_exists, ne.def, not_forall] using hs,
-  obtain ⟨c, cpos, cone⟩ : ∃ (c : ℝ), 0 < c ∧ c < 1 := ⟨1/2, by norm_num, by norm_num⟩,
-  have A : bounded (range (λ (n : ℕ), (c ^ n) • x)),
-  { have : tendsto (λ (n : ℕ), (c ^ n) • x) at_top (𝓝 ((0 : ℝ) • x)) :=
-      (tendsto_pow_at_top_nhds_0_of_lt_1 cpos.le cone).smul_const x,
-    exact bounded_range_of_tendsto _ this },
-  apply add_haar_eq_zero_of_disjoint_translates μ _ A _
-    (submodule.closed_of_finite_dimensional s).measurable_set,
-  assume m n hmn,
-  simp only [function.on_fun, image_add_left, singleton_add, disjoint_left, mem_preimage,
-             set_like.mem_coe],
-  assume y hym hyn,
-  have A : (c ^ n - c ^ m) • x ∈ s,
-  { convert s.sub_mem hym hyn,
-    simp only [sub_smul, neg_sub_neg, add_sub_add_right_eq_sub] },
-  have H : c ^ n - c ^ m ≠ 0,
-    by simpa only [sub_eq_zero, ne.def] using (strict_anti_pow cpos cone).injective.ne hmn.symm,
-  have : x ∈ s,
-  { convert s.smul_mem (c ^ n - c ^ m)⁻¹ A,
-    rw [smul_smul, inv_mul_cancel H, one_smul] },
-  exact hx this
-end
-
-/-- A strict affine subspace has measure zero. -/
-lemma add_haar_affine_subspace
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (s : affine_subspace ℝ E) (hs : s ≠ ⊤) : μ s = 0 :=
-begin
-  rcases s.eq_bot_or_nonempty with rfl|hne,
-  { rw [affine_subspace.bot_coe, measure_empty] },
-  rw [ne.def, ← affine_subspace.direction_eq_top_iff_of_nonempty hne] at hs,
-  rcases hne with ⟨x, hx : x ∈ s⟩,
-  simpa only [affine_subspace.coe_direction_eq_vsub_set_right hx, vsub_eq_sub,
-    sub_eq_add_neg, image_add_right, neg_neg, measure_preimage_add_right]
-    using add_haar_submodule μ s.direction hs
-end
-
-/-!
-### Applying a linear map rescales Haar measure by the determinant
-
-We first prove this on `ι → ℝ`, using that this is already known for the product Lebesgue
-measure (thanks to matrices computations). Then, we extend this to any finite-dimensional real
-vector space by using a linear equiv with a space of the form `ι → ℝ`, and arguing that such a
-linear equiv maps Haar measure to Haar measure.
--/
-
-lemma map_linear_map_add_haar_pi_eq_smul_add_haar
-  {ι : Type*} [fintype ι] {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0)
-  (μ : measure (ι → ℝ)) [is_add_haar_measure μ] :
-  measure.map f μ = ennreal.of_real (abs (f.det)⁻¹) • μ :=
-begin
-  /- We have already proved the result for the Lebesgue product measure, using matrices.
-  We deduce it for any Haar measure by uniqueness (up to scalar multiplication). -/
-  have := add_haar_measure_unique μ (pi_Icc01 ι),
-  rw [this, add_haar_measure_eq_volume_pi, map_smul,
-    real.map_linear_map_volume_pi_eq_smul_volume_pi hf, smul_comm],
-end
-
-lemma map_linear_map_add_haar_eq_smul_add_haar
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  {f : E →ₗ[ℝ] E} (hf : f.det ≠ 0) :
-  measure.map f μ = ennreal.of_real (abs (f.det)⁻¹) • μ :=
-begin
-  -- we reduce to the case of `E = ι → ℝ`, for which we have already proved the result using
-  -- matrices in `map_linear_map_add_haar_pi_eq_smul_add_haar`.
-  let ι := fin (finrank ℝ E),
-  haveI : finite_dimensional ℝ (ι → ℝ) := by apply_instance,
-  have : finrank ℝ E = finrank ℝ (ι → ℝ), by simp,
-  have e : E ≃ₗ[ℝ] ι → ℝ := linear_equiv.of_finrank_eq E (ι → ℝ) this,
-  -- next line is to avoid `g` getting reduced by `simp`.
-  obtain ⟨g, hg⟩ : ∃ g, g = (e : E →ₗ[ℝ] (ι → ℝ)).comp (f.comp (e.symm : (ι → ℝ) →ₗ[ℝ] E)) :=
-    ⟨_, rfl⟩,
-  have gdet : g.det = f.det, by { rw [hg], exact linear_map.det_conj f e },
-  rw ← gdet at hf ⊢,
-  have fg : f = (e.symm : (ι → ℝ) →ₗ[ℝ] E).comp (g.comp (e : E →ₗ[ℝ] (ι → ℝ))),
-  { ext x,
-    simp only [linear_equiv.coe_coe, function.comp_app, linear_map.coe_comp,
-      linear_equiv.symm_apply_apply, hg] },
-  simp only [fg, linear_equiv.coe_coe, linear_map.coe_comp],
-  have Ce : continuous e := (e : E →ₗ[ℝ] (ι → ℝ)).continuous_of_finite_dimensional,
-  have Cg : continuous g := linear_map.continuous_of_finite_dimensional g,
-  have Cesymm : continuous e.symm := (e.symm : (ι → ℝ) →ₗ[ℝ] E).continuous_of_finite_dimensional,
-  rw [← map_map Cesymm.measurable (Cg.comp Ce).measurable, ← map_map Cg.measurable Ce.measurable],
-  haveI : is_add_haar_measure (map e μ) := is_add_haar_measure_map μ e.to_add_equiv Ce Cesymm,
-  have ecomp : (e.symm) ∘ e = id,
-    by { ext x, simp only [id.def, function.comp_app, linear_equiv.symm_apply_apply] },
-  rw [map_linear_map_add_haar_pi_eq_smul_add_haar hf (map e μ), map_smul,
-    map_map Cesymm.measurable Ce.measurable, ecomp, measure.map_id]
-end
-
-/-- The preimage of a set `s` under a linear map `f` with nonzero determinant has measure
-equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
-@[simp] lemma add_haar_preimage_linear_map
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  {f : E →ₗ[ℝ] E} (hf : f.det ≠ 0) (s : set E) :
-  μ (f ⁻¹' s) = ennreal.of_real (abs (f.det)⁻¹) * μ s :=
-calc μ (f ⁻¹' s) = measure.map f μ s :
-  ((f.equiv_of_det_ne_zero hf).to_continuous_linear_equiv.to_homeomorph
-    .to_measurable_equiv.map_apply s).symm
-... = ennreal.of_real (abs (f.det)⁻¹) * μ s :
-  by { rw map_linear_map_add_haar_eq_smul_add_haar μ hf, refl }
-
-/-- The preimage of a set `s` under a continuous linear map `f` with nonzero determinant has measure
-equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
-@[simp] lemma add_haar_preimage_continuous_linear_map
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  {f : E →L[ℝ] E} (hf : linear_map.det (f : E →ₗ[ℝ] E) ≠ 0) (s : set E) :
-  μ (f ⁻¹' s) = ennreal.of_real (abs (linear_map.det (f : E →ₗ[ℝ] E))⁻¹) * μ s :=
-add_haar_preimage_linear_map μ hf s
-
-/-- The preimage of a set `s` under a linear equiv `f` has measure
-equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
-@[simp] lemma add_haar_preimage_linear_equiv
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (f : E ≃ₗ[ℝ] E) (s : set E) :
-  μ (f ⁻¹' s) = ennreal.of_real (abs (f.symm : E →ₗ[ℝ] E).det) * μ s :=
-begin
-  have A : (f : E →ₗ[ℝ] E).det ≠ 0 := (linear_equiv.is_unit_det' f).ne_zero,
-  convert add_haar_preimage_linear_map μ A s,
-  simp only [linear_equiv.det_coe_symm]
-end
-
-/-- The preimage of a set `s` under a continuous linear equiv `f` has measure
-equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
-@[simp] lemma add_haar_preimage_continuous_linear_equiv
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (f : E ≃L[ℝ] E) (s : set E) :
-  μ (f ⁻¹' s) = ennreal.of_real (abs (f.symm : E →ₗ[ℝ] E).det) * μ s :=
-add_haar_preimage_linear_equiv μ _ s
-
-/-- The image of a set `s` under a linear map `f` has measure
-equal to `μ s` times the absolute value of the determinant of `f`. -/
-@[simp] lemma add_haar_image_linear_map
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (f : E →ₗ[ℝ] E) (s : set E) :
-  μ (f '' s) = ennreal.of_real (abs f.det) * μ s :=
-begin
-  rcases ne_or_eq f.det 0 with hf|hf,
-  { let g := (f.equiv_of_det_ne_zero hf).to_continuous_linear_equiv,
-    change μ (g '' s) = _,
-    rw [continuous_linear_equiv.image_eq_preimage g s, add_haar_preimage_continuous_linear_equiv],
-    congr,
-    ext x,
-    simp only [linear_equiv.coe_to_continuous_linear_equiv, linear_equiv.of_is_unit_det_apply,
-               linear_equiv.coe_coe, continuous_linear_equiv.symm_symm], },
-  { simp only [hf, zero_mul, ennreal.of_real_zero, abs_zero],
-    have : μ f.range = 0 :=
-      add_haar_submodule μ _ (linear_map.range_lt_top_of_det_eq_zero hf).ne,
-    exact le_antisymm (le_trans (measure_mono (image_subset_range _ _)) this.le) (zero_le _) }
-end
-
-/-- The image of a set `s` under a continuous linear map `f` has measure
-equal to `μ s` times the absolute value of the determinant of `f`. -/
-@[simp] lemma add_haar_image_continuous_linear_map
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (f : E →L[ℝ] E) (s : set E) :
-  μ (f '' s) = ennreal.of_real (abs (f : E →ₗ[ℝ] E).det) * μ s :=
-add_haar_image_linear_map μ _ s
-
-/-- The image of a set `s` under a continuous linear equiv `f` has measure
-equal to `μ s` times the absolute value of the determinant of `f`. -/
-@[simp] lemma add_haar_image_continuous_linear_equiv
-  {E : Type*} [normed_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
-  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
-  (f : E ≃L[ℝ] E) (s : set E) :
-  μ (f '' s) = ennreal.of_real (abs (f : E →ₗ[ℝ] E).det) * μ s :=
-add_haar_image_linear_map μ _ s
-
-/-!
-### Basic properties of Haar measures on real vector spaces
--/
-
-variables {E : Type*} [normed_group E] [measurable_space E] [normed_space ℝ E]
-  [finite_dimensional ℝ E] [borel_space E] (μ : measure E) [is_add_haar_measure μ]
-
-lemma map_add_haar_smul {r : ℝ} (hr : r ≠ 0) :
-  measure.map ((•) r) μ = ennreal.of_real (abs (r ^ (finrank ℝ E))⁻¹) • μ :=
-begin
-  let f : E →ₗ[ℝ] E := r • 1,
-  change measure.map f μ = _,
-  have hf : f.det ≠ 0,
-  { simp only [mul_one, linear_map.det_smul, ne.def, monoid_hom.map_one],
-    assume h,
-    exact hr (pow_eq_zero h) },
-  simp only [map_linear_map_add_haar_eq_smul_add_haar μ hf, mul_one, linear_map.det_smul,
-    monoid_hom.map_one],
-end
-
-@[simp] lemma add_haar_preimage_smul {r : ℝ} (hr : r ≠ 0) (s : set E) :
-  μ (((•) r) ⁻¹' s) = ennreal.of_real (abs (r ^ (finrank ℝ E))⁻¹) * μ s :=
-calc μ (((•) r) ⁻¹' s) = measure.map ((•) r) μ s :
-  ((homeomorph.smul (is_unit_iff_ne_zero.2 hr).unit).to_measurable_equiv.map_apply s).symm
-... = ennreal.of_real (abs (r^(finrank ℝ E))⁻¹) * μ s : by { rw map_add_haar_smul μ hr, refl }
-
-/-- Rescaling a set by a factor `r` multiplies its measure by `abs (r ^ dim)`. -/
-@[simp] lemma add_haar_smul (r : ℝ) (s : set E) :
-  μ (r • s) = ennreal.of_real (abs (r ^ (finrank ℝ E))) * μ s :=
-begin
-  rcases ne_or_eq r 0 with h|rfl,
-  { rw [← preimage_smul_inv₀ h, add_haar_preimage_smul μ (inv_ne_zero h), inv_pow₀, inv_inv] },
-  rcases eq_empty_or_nonempty s with rfl|hs,
-  { simp only [measure_empty, mul_zero, smul_set_empty] },
-  rw [zero_smul_set hs, ← singleton_zero],
-  by_cases h : finrank ℝ E = 0,
-  { haveI : subsingleton E := finrank_zero_iff.1 h,
-    simp only [h, one_mul, ennreal.of_real_one, abs_one, subsingleton.eq_univ_of_nonempty hs,
-      pow_zero, subsingleton.eq_univ_of_nonempty (singleton_nonempty (0 : E))] },
-  { haveI : nontrivial E := nontrivial_of_finrank_pos (bot_lt_iff_ne_bot.2 h),
-    simp only [h, zero_mul, ennreal.of_real_zero, abs_zero, ne.def, not_false_iff, zero_pow',
-      measure_singleton] }
-end
-
-@[simp] lemma add_haar_image_homothety (x : E) (r : ℝ) (s : set E) :
-  μ (affine_map.homothety x r '' s) = ennreal.of_real (abs (r ^ (finrank ℝ E))) * μ s :=
-calc μ (affine_map.homothety x r '' s) = μ ((λ y, y + x) '' (r • ((λ y, y + (-x)) '' s))) :
-  by { simp only [← image_smul, image_image, ← sub_eq_add_neg], refl }
-... = ennreal.of_real (abs (r ^ (finrank ℝ E))) * μ s :
-  by simp only [image_add_right, measure_preimage_add_right, add_haar_smul]
-
-/-! We don't need to state `map_add_haar_neg` here, because it has already been proved for
-general Haar measures on general commutative groups. -/
-
-/-! ### Measure of balls -/
-
-lemma add_haar_ball_center
-  {E : Type*} [normed_group E] [measurable_space E]
-  [borel_space E] (μ : measure E) [is_add_haar_measure μ] (x : E) (r : ℝ) :
-  μ (ball x r) = μ (ball (0 : E) r) :=
-begin
-  have : ball (0 : E) r = ((+) x) ⁻¹' (ball x r), by simp [preimage_add_ball],
-  rw [this, measure_preimage_add]
-end
-
-lemma add_haar_closed_ball_center
-  {E : Type*} [normed_group E] [measurable_space E]
-  [borel_space E] (μ : measure E) [is_add_haar_measure μ] (x : E) (r : ℝ) :
-  μ (closed_ball x r) = μ (closed_ball (0 : E) r) :=
-begin
-  have : closed_ball (0 : E) r = ((+) x) ⁻¹' (closed_ball x r), by simp [preimage_add_closed_ball],
-  rw [this, measure_preimage_add]
-end
-
-lemma add_haar_ball_mul_of_pos (x : E) {r : ℝ} (hr : 0 < r) (s : ℝ) :
-  μ (ball x (r * s)) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (ball 0 s) :=
-begin
-  have : ball (0 : E) (r * s) = r • ball 0 s,
-    by simp only [smul_ball hr.ne' (0 : E) s, real.norm_eq_abs, abs_of_nonneg hr.le, smul_zero],
-  simp only [this, add_haar_smul, abs_of_nonneg hr.le, add_haar_ball_center, abs_pow],
-end
-
-lemma add_haar_ball_of_pos (x : E) {r : ℝ} (hr : 0 < r) :
-  μ (ball x r) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (ball 0 1) :=
-by rw [← add_haar_ball_mul_of_pos μ x hr, mul_one]
-
-lemma add_haar_ball_mul [nontrivial E] (x : E) {r : ℝ} (hr : 0 ≤ r) (s : ℝ) :
-  μ (ball x (r * s)) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (ball 0 s) :=
-begin
-  rcases has_le.le.eq_or_lt hr with h|h,
-  { simp only [← h, zero_pow finrank_pos, measure_empty, zero_mul, ennreal.of_real_zero,
-               ball_zero] },
-  { exact add_haar_ball_mul_of_pos μ x h s }
-end
-
-lemma add_haar_ball [nontrivial E] (x : E) {r : ℝ} (hr : 0 ≤ r) :
-  μ (ball x r) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (ball 0 1) :=
-by rw [← add_haar_ball_mul μ x hr, mul_one]
-
-lemma add_haar_closed_ball_mul_of_pos (x : E) {r : ℝ} (hr : 0 < r) (s : ℝ) :
-  μ (closed_ball x (r * s)) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (closed_ball 0 s) :=
-begin
-  have : closed_ball (0 : E) (r * s) = r • closed_ball 0 s,
-    by simp [smul_closed_ball' hr.ne' (0 : E), real.norm_eq_abs, abs_of_nonneg hr.le],
-  simp only [this, add_haar_smul, abs_of_nonneg hr.le, add_haar_closed_ball_center, abs_pow],
-end
-
-lemma add_haar_closed_ball_mul (x : E) {r : ℝ} (hr : 0 ≤ r) {s : ℝ} (hs : 0 ≤ s) :
-  μ (closed_ball x (r * s)) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (closed_ball 0 s) :=
-begin
-  have : closed_ball (0 : E) (r * s) = r • closed_ball 0 s,
-    by simp [smul_closed_ball r (0 : E) hs, real.norm_eq_abs, abs_of_nonneg hr],
-  simp only [this, add_haar_smul, abs_of_nonneg hr, add_haar_closed_ball_center, abs_pow],
-end
-
-/-- The measure of a closed ball can be expressed in terms of the measure of the closed unit ball.
-Use instead `add_haar_closed_ball`, which uses the measure of the open unit ball as a standard
-form. -/
-lemma add_haar_closed_ball' (x : E) {r : ℝ} (hr : 0 ≤ r) :
-  μ (closed_ball x r) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (closed_ball 0 1) :=
-by rw [← add_haar_closed_ball_mul μ x hr zero_le_one, mul_one]
-
-lemma add_haar_closed_unit_ball_eq_add_haar_unit_ball :
-  μ (closed_ball (0 : E) 1) = μ (ball 0 1) :=
-begin
-  apply le_antisymm _ (measure_mono ball_subset_closed_ball),
-  have A : tendsto (λ (r : ℝ), ennreal.of_real (r ^ (finrank ℝ E)) * μ (closed_ball (0 : E) 1))
-    (𝓝[<] 1) (𝓝 (ennreal.of_real (1 ^ (finrank ℝ E)) * μ (closed_ball (0 : E) 1))),
-  { refine ennreal.tendsto.mul _ (by simp) tendsto_const_nhds (by simp),
-    exact ennreal.tendsto_of_real ((tendsto_id' nhds_within_le_nhds).pow _) },
-  simp only [one_pow, one_mul, ennreal.of_real_one] at A,
-  refine le_of_tendsto A _,
-  refine mem_nhds_within_Iio_iff_exists_Ioo_subset.2 ⟨(0 : ℝ), by simp, λ r hr, _⟩,
-  dsimp,
-  rw ← add_haar_closed_ball' μ (0 : E) hr.1.le,
-  exact measure_mono (closed_ball_subset_ball hr.2)
-end
-
-lemma add_haar_closed_ball (x : E) {r : ℝ} (hr : 0 ≤ r) :
-  μ (closed_ball x r) = ennreal.of_real (r ^ (finrank ℝ E)) * μ (ball 0 1) :=
-by rw [add_haar_closed_ball' μ x hr, add_haar_closed_unit_ball_eq_add_haar_unit_ball]
-
-lemma add_haar_sphere_of_ne_zero (x : E) {r : ℝ} (hr : r ≠ 0) :
-  μ (sphere x r) = 0 :=
-begin
-  rcases hr.lt_or_lt with h|h,
-  { simp only [empty_diff, measure_empty, ← closed_ball_diff_ball, closed_ball_eq_empty.2 h] },
-  { rw [← closed_ball_diff_ball,
-        measure_diff ball_subset_closed_ball measurable_set_ball measure_ball_lt_top.ne,
-        add_haar_ball_of_pos μ _ h, add_haar_closed_ball μ _ h.le, tsub_self];
-    apply_instance }
-end
-
-lemma add_haar_sphere [nontrivial E] (x : E) (r : ℝ) :
-  μ (sphere x r) = 0 :=
-begin
-  rcases eq_or_ne r 0 with rfl|h,
-  { rw [sphere_zero, measure_singleton] },
-  { exact add_haar_sphere_of_ne_zero μ x h }
-end
-
-lemma add_haar_singleton_add_smul_div_singleton_add_smul
-  {r : ℝ} (hr : r ≠ 0) (x y : E) (s t : set E) :
-  μ ({x} + r • s) / μ ({y} + r • t) = μ s / μ t :=
-calc
-μ ({x} + r • s) / μ ({y} + r • t)
-    = ennreal.of_real (|r| ^ finrank ℝ E) * μ s * (ennreal.of_real (|r| ^ finrank ℝ E) * μ t)⁻¹ :
-  by simp only [div_eq_mul_inv, add_haar_smul, image_add_left, measure_preimage_add, abs_pow,
-    singleton_add]
-... = ennreal.of_real (|r| ^ finrank ℝ E) * (ennreal.of_real (|r| ^ finrank ℝ E))⁻¹ *
-        (μ s * (μ t)⁻¹) :
-  begin
-    rw ennreal.mul_inv,
-    { ring },
-    { simp only [pow_pos (abs_pos.mpr hr), ennreal.of_real_eq_zero, not_le, ne.def, true_or] },
-    { simp only [ennreal.of_real_ne_top, true_or, ne.def, not_false_iff] },
-  end
-... = μ s / μ t :
-  begin
-    rw [ennreal.mul_inv_cancel, one_mul, div_eq_mul_inv],
-    { simp only [pow_pos (abs_pos.mpr hr), ennreal.of_real_eq_zero, not_le, ne.def], },
-    { simp only [ennreal.of_real_ne_top, ne.def, not_false_iff] }
-  end
-
-/-!
-### Density points
-
-Besicovitch covering theorem ensures that, for any locally finite measure on a finite-dimensional
-real vector space, almost every point of a set `s` is a density point, i.e.,
-`μ (s ∩ closed_ball x r) / μ (closed_ball x r)` tends to `1` as `r` tends to `0`
-(see `besicovitch.ae_tendsto_measure_inter_div`).
-When `μ` is a Haar measure, one can deduce the same property for any rescaling sequence of sets,
-of the form `{x} + r • t` where `t` is a set with positive finite measure, instead of the sequence
-of closed balls.
-
-We argue first for the dual property, i.e., if `s` has density `0` at `x`, then
-`μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)` tends to `0`. First when `t` is contained in the ball
-of radius `1`, in `tendsto_add_haar_inter_smul_zero_of_density_zero_aux1`,
-(by arguing by inclusion). Then when `t` is bounded, reducing to the previous one by rescaling, in
-`tendsto_add_haar_inter_smul_zero_of_density_zero_aux2`.
-Then for a general set `t`, by cutting it into a bounded part and a part with small measure, in
-`tendsto_add_haar_inter_smul_zero_of_density_zero`.
-Going to the complement, one obtains the desired property at points of density `1`, first when
-`s` is measurable in `tendsto_add_haar_inter_smul_one_of_density_one_aux`, and then without this
-assumption in `tendsto_add_haar_inter_smul_one_of_density_one` by applying the previous lemma to
-the measurable hull `to_measurable μ s`
--/
-
-lemma tendsto_add_haar_inter_smul_zero_of_density_zero_aux1
-  (s : set E) (x : E)
-  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0))
-  (t : set E) (u : set E) (h'u : μ u ≠ 0) (t_bound : t ⊆ closed_ball 0 1) :
-  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • u)) (𝓝[>] 0) (𝓝 0) :=
-begin
-  have A : tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0),
-  { apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds h
-      (eventually_of_forall (λ b, zero_le _)),
-    filter_upwards [self_mem_nhds_within],
-    rintros r (rpos : 0 < r),
-    apply ennreal.mul_le_mul (measure_mono (inter_subset_inter_right _ _)) le_rfl,
-    assume y hy,
-    have : y - x ∈ r • closed_ball (0 : E) 1,
-    { apply smul_set_mono t_bound,
-      simpa [neg_add_eq_sub] using hy },
-    simpa only [smul_closed_ball _ _ zero_le_one, real.norm_of_nonneg rpos.le,
-      mem_closed_ball_iff_norm, mul_one, sub_zero, smul_zero] },
-  have B : tendsto (λ (r : ℝ), μ (closed_ball x r) / μ ({x} + r • u)) (𝓝[>] 0)
-    (𝓝 (μ (closed_ball x 1) / μ ({x} + u))),
-  { apply tendsto_const_nhds.congr' _,
-    filter_upwards [self_mem_nhds_within],
-    rintros r (rpos : 0 < r),
-    have : closed_ball x r = {x} + r • closed_ball 0 1,
-      by simp only [smul_closed_ball, real.norm_of_nonneg rpos.le, zero_le_one, add_zero, mul_one,
-        singleton_add_closed_ball, smul_zero],
-    simp only [this, add_haar_singleton_add_smul_div_singleton_add_smul μ rpos.ne'],
-    simp only [add_haar_closed_ball_center, image_add_left, measure_preimage_add, singleton_add] },
-  have C : tendsto (λ (r : ℝ),
-    (μ (s ∩ ({x} + r • t)) / μ (closed_ball x r)) * (μ (closed_ball x r) / μ ({x} + r • u)))
-    (𝓝[>] 0) (𝓝 (0 * (μ (closed_ball x 1) / μ ({x} + u)))),
-  { apply ennreal.tendsto.mul A _ B (or.inr ennreal.zero_ne_top),
-    simp only [ennreal.div_eq_top, h'u, measure_closed_ball_lt_top.ne, false_or, image_add_left,
-      eq_self_iff_true, not_true, ne.def, not_false_iff, measure_preimage_add, singleton_add,
-      and_false, false_and] },
-  simp only [zero_mul] at C,
-  apply C.congr' _,
-  filter_upwards [self_mem_nhds_within],
-  rintros r (rpos : 0 < r),
-  calc μ (s ∩ ({x} + r • t)) / μ (closed_ball x r) * (μ (closed_ball x r) / μ ({x} + r • u))
-    = (μ (closed_ball x r) * (μ (closed_ball x r))⁻¹) * (μ (s ∩ ({x} + r • t)) / μ ({x} + r • u)) :
-      by { simp only [div_eq_mul_inv], ring }
-    ... = μ (s ∩ ({x} + r • t)) / μ ({x} + r • u) :
-      by rw [ennreal.mul_inv_cancel (measure_closed_ball_pos μ x rpos).ne'
-          measure_closed_ball_lt_top.ne, one_mul],
-end
-
-lemma tendsto_add_haar_inter_smul_zero_of_density_zero_aux2
-  (s : set E) (x : E)
-  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0))
-  (t : set E) (u : set E) (h'u : μ u ≠ 0)
-  (R : ℝ) (Rpos : 0 < R) (t_bound : t ⊆ closed_ball 0 R) :
-  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • u)) (𝓝[>] 0) (𝓝 0) :=
-begin
-  set t' := R⁻¹ • t with ht',
-  set u' := R⁻¹ • u with hu',
-  have A : tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t')) / μ ({x} + r • u')) (𝓝[>] 0) (𝓝 0),
-  { apply tendsto_add_haar_inter_smul_zero_of_density_zero_aux1 μ s x h
-      t' u',
-    { simp only [h'u, (pow_pos Rpos _).ne', abs_nonpos_iff, add_haar_smul, not_false_iff,
-        ennreal.of_real_eq_zero, inv_eq_zero, inv_pow₀, ne.def, or_self, mul_eq_zero] },
-    { convert smul_set_mono t_bound,
-      rw [smul_closed_ball _ _ Rpos.le, smul_zero, real.norm_of_nonneg (inv_nonneg.2 Rpos.le),
-        inv_mul_cancel Rpos.ne'] } },
-  have B : tendsto (λ (r : ℝ), R * r) (𝓝[>] 0) (𝓝[>] (R * 0)),
-  { apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within,
-    { exact (tendsto_const_nhds.mul tendsto_id).mono_left nhds_within_le_nhds },
-    { filter_upwards [self_mem_nhds_within],
-      assume r rpos,
-      rw mul_zero,
-      exact mul_pos Rpos rpos } },
-  rw mul_zero at B,
-  apply (A.comp B).congr' _,
-  filter_upwards [self_mem_nhds_within],
-  rintros r (rpos : 0 < r),
-  have T : (R * r) • t' = r • t,
-    by rw [mul_comm, ht', smul_smul, mul_assoc, mul_inv_cancel Rpos.ne', mul_one],
-  have U : (R * r) • u' = r • u,
-    by rw [mul_comm, hu', smul_smul, mul_assoc, mul_inv_cancel Rpos.ne', mul_one],
-  dsimp,
-  rw [T, U],
-end
-
-/-- Consider a point `x` at which a set `s` has density zero, with respect to closed balls. Then it
-also has density zero with respect to any measurable set `t`: the proportion of points in `s`
-belonging to a rescaled copy `{x} + r • t` of `t` tends to zero as `r` tends to zero. -/
-lemma tendsto_add_haar_inter_smul_zero_of_density_zero
-  (s : set E) (x : E)
-  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0))
-  (t : set E) (ht : measurable_set t) (h''t : μ t ≠ ∞) :
-  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 0) :=
-begin
-  refine tendsto_order.2 ⟨λ a' ha', (ennreal.not_lt_zero ha').elim, λ ε (εpos : 0 < ε), _⟩,
-  rcases eq_or_ne (μ t) 0 with h't|h't,
-  { apply eventually_of_forall (λ r, _),
-    suffices H : μ (s ∩ ({x} + r • t)) = 0,
-      by { rw H, simpa only [ennreal.zero_div] using εpos },
-    apply le_antisymm _ (zero_le _),
-    calc μ (s ∩ ({x} + r • t)) ≤ μ ({x} + r • t) : measure_mono (inter_subset_right _ _)
-    ... = 0 : by simp only [h't, add_haar_smul, image_add_left, measure_preimage_add,
-      singleton_add, mul_zero] },
-  obtain ⟨n, npos, hn⟩ : ∃ (n : ℕ), 0 < n ∧ μ (t \ closed_ball 0 n) < (ε / 2) * μ t,
-  { have A : tendsto (λ (n : ℕ), μ (t \ closed_ball 0 n)) at_top
-      (𝓝 (μ (⋂ (n : ℕ), t \ closed_ball 0 n))),
-    { have N : ∃ (n : ℕ), μ (t \ closed_ball 0 n) ≠ ∞ :=
-        ⟨0, ((measure_mono (diff_subset t _)).trans_lt h''t.lt_top).ne⟩,
-      refine tendsto_measure_Inter (λ n, ht.diff measurable_set_closed_ball) (λ m n hmn, _) N,
-      exact diff_subset_diff subset.rfl (closed_ball_subset_closed_ball (nat.cast_le.2 hmn)) },
-    have : (⋂ (n : ℕ), t \ closed_ball 0 n) = ∅,
-      by simp_rw [diff_eq, ← inter_Inter, Inter_eq_compl_Union_compl, compl_compl,
-          Union_closed_ball_nat, compl_univ, inter_empty],
-    simp only [this, measure_empty] at A,
-    have I : 0 < (ε / 2) * μ t := ennreal.mul_pos (ennreal.half_pos εpos.ne').ne' h't,
-    exact (eventually.and (Ioi_mem_at_top 0) ((tendsto_order.1 A).2 _ I)).exists },
-  have L : tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) / μ ({x} + r • t))
-    (𝓝[>] 0) (𝓝 0) :=
-      tendsto_add_haar_inter_smul_zero_of_density_zero_aux2 μ s x h
-        _ t h't n (nat.cast_pos.2 npos) (inter_subset_right _ _),
-  filter_upwards [(tendsto_order.1 L).2 _ (ennreal.half_pos εpos.ne'), self_mem_nhds_within],
-  rintros r hr (rpos : 0 < r),
-  have I : μ (s ∩ ({x} + r • t)) ≤
-    μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ ({x} + r • (t \ closed_ball 0 n)) := calc
-  μ (s ∩ ({x} + r • t))
-      = μ ((s ∩ ({x} + r • (t ∩ closed_ball 0 n))) ∪ (s ∩ ({x} + r • (t \ closed_ball 0 n)))) :
-    by rw [← inter_union_distrib_left, ← add_union, ← smul_set_union, inter_union_diff]
-  ... ≤ μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ (s ∩ ({x} + r • (t \ closed_ball 0 n))) :
-    measure_union_le _ _
-  ... ≤ μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ ({x} + r • (t \ closed_ball 0 n)) :
-    add_le_add le_rfl (measure_mono (inter_subset_right _ _)),
-  calc μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)
-  ≤ (μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ ({x} + r • (t \ closed_ball 0 n))) /
-      μ ({x} + r • t) : ennreal.mul_le_mul I le_rfl
-  ... < ε / 2 + ε / 2 :
-    begin
-      rw ennreal.add_div,
-      apply ennreal.add_lt_add hr _,
-      rwa [add_haar_singleton_add_smul_div_singleton_add_smul μ rpos.ne',
-           ennreal.div_lt_iff (or.inl h't) (or.inl h''t)],
-    end
-  ... = ε : ennreal.add_halves _
-end
-
-lemma tendsto_add_haar_inter_smul_one_of_density_one_aux
-  (s : set E) (hs : measurable_set s) (x : E)
-  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1))
-  (t : set E) (ht : measurable_set t) (h't : μ t ≠ 0) (h''t : μ t ≠ ∞) :
-  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 1) :=
-begin
-  have I : ∀ u v, μ u ≠ 0 → μ u ≠ ∞ → measurable_set v →
-    μ u / μ u - μ (vᶜ ∩ u) / μ u = μ (v ∩ u) / μ u,
-  { assume u v uzero utop vmeas,
-    simp_rw [div_eq_mul_inv],
-    rw ← ennreal.sub_mul, swap,
-    { simp only [uzero, ennreal.inv_eq_top, implies_true_iff, ne.def, not_false_iff] },
-    congr' 1,
-    apply ennreal.sub_eq_of_add_eq
-      (ne_top_of_le_ne_top utop (measure_mono (inter_subset_right _ _))),
-    rw [inter_comm _ u, inter_comm _ u],
-    exact measure_inter_add_diff u vmeas },
-  have L : tendsto (λ r, μ (sᶜ ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0),
-  { have A : tendsto (λ r, μ (closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1),
-    { apply tendsto_const_nhds.congr' _,
-      filter_upwards [self_mem_nhds_within],
-      assume r hr,
-      rw [div_eq_mul_inv, ennreal.mul_inv_cancel],
-      { exact (measure_closed_ball_pos μ _ hr).ne' },
-      { exact measure_closed_ball_lt_top.ne } },
-    have B := ennreal.tendsto.sub A h (or.inl ennreal.one_ne_top),
-    simp only [tsub_self] at B,
-    apply B.congr' _,
-    filter_upwards [self_mem_nhds_within],
-    rintros r (rpos : 0 < r),
-    convert I (closed_ball x r) sᶜ (measure_closed_ball_pos μ _ rpos).ne'
-      (measure_closed_ball_lt_top).ne hs.compl,
-    rw compl_compl },
-  have L' : tendsto (λ (r : ℝ), μ (sᶜ ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 0) :=
-    tendsto_add_haar_inter_smul_zero_of_density_zero μ sᶜ x L t ht h''t,
-  have L'' : tendsto (λ (r : ℝ), μ ({x} + r • t) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 1),
-  { apply tendsto_const_nhds.congr' _,
-    filter_upwards [self_mem_nhds_within],
-    rintros r (rpos : 0 < r),
-    rw [add_haar_singleton_add_smul_div_singleton_add_smul μ rpos.ne', ennreal.div_self h't h''t] },
-  have := ennreal.tendsto.sub L'' L' (or.inl ennreal.one_ne_top),
-  simp only [tsub_zero] at this,
-  apply this.congr' _,
-  filter_upwards [self_mem_nhds_within],
-  rintros r (rpos : 0 < r),
-  refine I ({x} + r • t) s _ _ hs,
-  { simp only [h't, abs_of_nonneg rpos.le, pow_pos rpos, add_haar_smul, image_add_left,
-      ennreal.of_real_eq_zero, not_le, or_false, ne.def, measure_preimage_add, abs_pow,
-      singleton_add, mul_eq_zero] },
-  { simp only [h''t, ennreal.of_real_ne_top, add_haar_smul, image_add_left, with_top.mul_eq_top_iff,
-      ne.def, not_false_iff, measure_preimage_add, singleton_add, and_false, false_and, or_self] }
-end
-
-/-- Consider a point `x` at which a set `s` has density one, with respect to closed balls (i.e.,
-a Lebesgue density point of `s`). Then `s` has also density one at `x` with respect to any
-measurable set `t`: the proportion of points in `s` belonging to a rescaled copy `{x} + r • t`
-of `t` tends to one as `r` tends to zero. -/
-lemma tendsto_add_haar_inter_smul_one_of_density_one
-  (s : set E) (x : E)
-  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1))
-  (t : set E) (ht : measurable_set t) (h't : μ t ≠ 0) (h''t : μ t ≠ ∞) :
-  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 1) :=
-begin
-  have : tendsto (λ (r : ℝ), μ (to_measurable μ s ∩ ({x} + r • t)) / μ ({x} + r • t))
-    (𝓝[>] 0) (𝓝 1),
-  { apply tendsto_add_haar_inter_smul_one_of_density_one_aux μ _
-      (measurable_set_to_measurable _ _) _ _ t ht h't h''t,
-    apply tendsto_of_tendsto_of_tendsto_of_le_of_le' h tendsto_const_nhds,
-    { apply eventually_of_forall (λ r, _),
-      apply ennreal.mul_le_mul _ le_rfl,
-      exact measure_mono (inter_subset_inter_left _ (subset_to_measurable _ _)) },
-    { filter_upwards [self_mem_nhds_within],
-      rintros r (rpos : 0 < r),
-      apply ennreal.div_le_of_le_mul,
-      rw one_mul,
-      exact measure_mono (inter_subset_right _ _) } },
-  apply this.congr (λ r, _),
-  congr' 1,
-  apply measure_to_measurable_inter_of_sigma_finite,
-  simp only [image_add_left, singleton_add],
-  apply (continuous_add_left (-x)).measurable (ht.const_smul₀ r)
-end
-
-/-- Consider a point `x` at which a set `s` has density one, with respect to closed balls (i.e.,
-a Lebesgue density point of `s`). Then `s` intersects the rescaled copies `{x} + r • t` of a given
-set `t` with positive measure, for any small enough `r`. -/
-lemma eventually_nonempty_inter_smul_of_density_one (s : set E) (x : E)
-  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1))
-  (t : set E) (ht : measurable_set t) (h't : μ t ≠ 0) :
-  ∀ᶠ r in 𝓝[>] (0 : ℝ), (s ∩ ({x} + r • t)).nonempty :=
-begin
-  obtain ⟨t', t'_meas, t't, t'pos, t'top⟩ :
-    ∃ t', measurable_set t' ∧ t' ⊆ t ∧ 0 < μ t' ∧ μ t' < ⊤ :=
-      exists_subset_measure_lt_top ht h't.bot_lt,
-  filter_upwards [(tendsto_order.1
-    (tendsto_add_haar_inter_smul_one_of_density_one μ s x h t'
-      t'_meas t'pos.ne' t'top.ne)).1 0 ennreal.zero_lt_one],
-  assume r hr,
-  have : μ (s ∩ ({x} + r • t')) ≠ 0 :=
-    λ h', by simpa only [ennreal.not_lt_zero, ennreal.zero_div, h'] using hr,
-  have : (s ∩ ({x} + r • t')).nonempty := nonempty_of_measure_ne_zero this,
-  apply this.mono (inter_subset_inter subset.rfl _),
-  exact add_subset_add subset.rfl (smul_set_mono t't),
-end
-
-end measure
-
-end measure_theory
diff --git a/src/measure_theory/measure/haar_quotient.lean b/src/measure_theory/measure/haar_quotient.lean
deleted file mode 100644
index d6a684326c9c7..0000000000000
--- a/src/measure_theory/measure/haar_quotient.lean
+++ /dev/null
@@ -1,160 +0,0 @@
-/-
-Copyright (c) 2022 Alex Kontorovich and Heather Macbeth. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Alex Kontorovich, Heather Macbeth
--/
-
-import measure_theory.measure.haar
-import measure_theory.group.fundamental_domain
-import topology.compact_open
-import algebra.group.opposite
-
-/-!
-# Haar quotient measure
-
-In this file, we consider properties of fundamental domains and measures for the action of a
-subgroup of a group `G` on `G` itself.
-
-## Main results
-
-* `measure_theory.is_fundamental_domain.smul_invariant_measure_map `: given a subgroup `Γ` of a
-  topological group `G`, the pushforward to the coset space `G ⧸ Γ` of the restriction of a both
-  left- and right-invariant measure on `G` to a fundamental domain `𝓕` is a `G`-invariant measure
-  on `G ⧸ Γ`.
-
-* `measure_theory.is_fundamental_domain.is_mul_left_invariant_map `: given a normal subgroup `Γ` of
-  a topological group `G`, the pushforward to the quotient group `G ⧸ Γ` of the restriction of
-  a both left- and right-invariant measure on `G` to a fundamental domain `𝓕` is a left-invariant
-  measure on `G ⧸ Γ`.
-
-Note that a group `G` with Haar measure that is both left and right invariant is called
-**unimodular**.
--/
-
-open set measure_theory topological_space measure_theory.measure
-open_locale pointwise
-
-variables {G : Type*} [group G] [measurable_space G] [topological_space G]
-  [topological_group G] [borel_space G]
-  {μ : measure G}
-  {Γ : subgroup G}
-
-/-- Given a subgroup `Γ` of `G` and a right invariant measure `μ` on `G`, the measure is also
-  invariant under the action of `Γ` on `G` by **right** multiplication. -/
-@[to_additive "Given a subgroup `Γ` of an additive group `G` and a right invariant measure `μ` on
-  `G`, the measure is also invariant under the action of `Γ` on `G` by **right** addition."]
-lemma subgroup.smul_invariant_measure [μ.is_mul_right_invariant] :
-  smul_invariant_measure Γ.opposite G μ :=
-{ measure_preimage_smul :=
-begin
-  rintros ⟨c, hc⟩ s hs,
-  dsimp [(•)],
-  refine measure_preimage_mul_right μ (mul_opposite.unop c) s,
-end}
-
-/-- Measurability of the action of the topological group `G` on the left-coset space `G/Γ`. -/
-@[to_additive "Measurability of the action of the additive topological group `G` on the left-coset
-  space `G/Γ`."]
-instance quotient_group.has_measurable_smul [measurable_space (G ⧸ Γ)] [borel_space (G ⧸ Γ)] :
-  has_measurable_smul G (G ⧸ Γ) :=
-{ measurable_const_smul := λ g, (continuous_const_smul g).measurable,
-  measurable_smul_const := λ x, (quotient_group.continuous_smul₁ x).measurable }
-
-variables {𝓕 : set G} (h𝓕 : is_fundamental_domain Γ.opposite 𝓕 μ)
-include h𝓕
-
-variables [encodable Γ] [measurable_space (G ⧸ Γ)] [borel_space (G ⧸ Γ)]
-
-/-- The pushforward to the coset space `G ⧸ Γ` of the restriction of a both left- and right-
-  invariant measure on `G` to a fundamental domain `𝓕` is a `G`-invariant measure on `G ⧸ Γ`. -/
-@[to_additive "The pushforward to the coset space `G ⧸ Γ` of the restriction of a both left- and
-  right-invariant measure on an additive topological group `G` to a fundamental domain `𝓕` is a
-  `G`-invariant measure on `G ⧸ Γ`."]
-lemma measure_theory.is_fundamental_domain.smul_invariant_measure_map
-  [μ.is_mul_left_invariant] [μ.is_mul_right_invariant] :
-  smul_invariant_measure G (G ⧸ Γ) (measure.map quotient_group.mk (μ.restrict 𝓕)) :=
-{ measure_preimage_smul :=
-  begin
-    let π : G → G ⧸ Γ := quotient_group.mk,
-    have meas_π : measurable π :=
-      continuous_quotient_mk.measurable,
-    have 𝓕meas : null_measurable_set 𝓕 μ := h𝓕.null_measurable_set,
-    intros g A hA,
-    have meas_πA : measurable_set (π ⁻¹' A) := measurable_set_preimage meas_π hA,
-    rw [measure.map_apply meas_π hA,
-      measure.map_apply meas_π (measurable_set_preimage (measurable_const_smul g) hA),
-      measure.restrict_apply₀' 𝓕meas, measure.restrict_apply₀' 𝓕meas],
-    set π_preA := π ⁻¹' A,
-    have : (quotient_group.mk ⁻¹' ((λ (x : G ⧸ Γ), g • x) ⁻¹' A)) = has_mul.mul g ⁻¹' π_preA,
-    { ext1, simp },
-    rw this,
-    have : μ (has_mul.mul g ⁻¹' π_preA ∩ 𝓕) = μ (π_preA ∩ has_mul.mul (g⁻¹) ⁻¹' 𝓕),
-    { transitivity μ (has_mul.mul g ⁻¹' (π_preA ∩ has_mul.mul g⁻¹ ⁻¹' 𝓕)),
-      { rw preimage_inter,
-        congr,
-        rw [← preimage_comp, comp_mul_left, mul_left_inv],
-        ext,
-        simp, },
-      rw measure_preimage_mul, },
-    rw this,
-    haveI : smul_invariant_measure ↥(Γ.opposite) G μ := subgroup.smul_invariant_measure,
-    haveI : smul_invariant_measure G G μ := ⟨λ c s hs, measure_preimage_mul μ c s⟩,
-    -- Lean can generate the next instance but it has no additive version of the autogenerated proof
-    haveI : smul_comm_class G Γ.opposite G := ⟨λ a b c, (mul_assoc _ _ _).symm⟩,
-    have h𝓕_translate_fundom : is_fundamental_domain Γ.opposite (g • 𝓕) μ := h𝓕.smul_of_comm g,
-    rw [h𝓕.measure_set_eq h𝓕_translate_fundom meas_πA, ← preimage_smul_inv], refl,
-    rintros ⟨γ, γ_in_Γ⟩,
-    ext,
-    have : π (x * (mul_opposite.unop γ)) = π (x) := by simpa [quotient_group.eq'] using γ_in_Γ,
-    simp [(•), this],
-  end }
-
-/-- Assuming `Γ` is a normal subgroup of a topological group `G`, the pushforward to the quotient
-  group `G ⧸ Γ` of the restriction of a both left- and right-invariant measure on `G` to a
-  fundamental domain `𝓕` is a left-invariant measure on `G ⧸ Γ`. -/
-@[to_additive "Assuming `Γ` is a normal subgroup of an additive topological group `G`, the
-  pushforward to the quotient group `G ⧸ Γ` of the restriction of a both left- and right-invariant
-  measure on `G` to a fundamental domain `𝓕` is a left-invariant measure on `G ⧸ Γ`."]
-lemma measure_theory.is_fundamental_domain.is_mul_left_invariant_map [subgroup.normal Γ]
-  [μ.is_mul_left_invariant] [μ.is_mul_right_invariant] :
-  (measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)).is_mul_left_invariant :=
-{ map_mul_left_eq_self := begin
-    intros x,
-    apply measure.ext,
-    intros A hA,
-    obtain ⟨x₁, _⟩ := @quotient.exists_rep _ (quotient_group.left_rel Γ) x,
-    haveI := h𝓕.smul_invariant_measure_map,
-    convert measure_preimage_smul x₁ ((measure.map quotient_group.mk) (μ.restrict 𝓕)) A using 1,
-    rw [← h, measure.map_apply],
-    { refl, },
-    { exact measurable_const_mul _, },
-    { exact hA, },
-  end }
-
-variables [t2_space (G ⧸ Γ)] [second_countable_topology (G ⧸ Γ)] (K : positive_compacts (G ⧸ Γ))
-
-/-- Given a normal subgroup `Γ` of a topological group `G` with Haar measure `μ`, which is also
-  right-invariant, and a finite volume fundamental domain `𝓕`, the pushforward to the quotient
-  group `G ⧸ Γ` of the restriction of `μ` to `𝓕` is a multiple of Haar measure on `G ⧸ Γ`. -/
-@[to_additive "Given a normal subgroup `Γ` of an additive topological group `G` with Haar measure
-  `μ`, which is also right-invariant, and a finite volume fundamental domain `𝓕`, the pushforward
-  to the quotient group `G ⧸ Γ` of the restriction of `μ` to `𝓕` is a multiple of Haar measure on
-  `G ⧸ Γ`."]
-lemma measure_theory.is_fundamental_domain.map_restrict_quotient [subgroup.normal Γ]
-  [measure_theory.measure.is_haar_measure μ] [μ.is_mul_right_invariant]
-  (h𝓕_finite : μ 𝓕 < ⊤) : measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)
-  = (μ (𝓕 ∩ (quotient_group.mk' Γ) ⁻¹' K)) • (measure_theory.measure.haar_measure K) :=
-begin
-  let π : G →* G ⧸ Γ := quotient_group.mk' Γ,
-  have meas_π : measurable π := continuous_quotient_mk.measurable,
-  have 𝓕meas : null_measurable_set 𝓕 μ := h𝓕.null_measurable_set,
-  haveI : is_finite_measure (μ.restrict 𝓕) :=
-    ⟨by { rw [measure.restrict_apply₀' 𝓕meas, univ_inter], exact h𝓕_finite }⟩,
-  -- the measure is left-invariant, so by the uniqueness of Haar measure it's enough to show that
-  -- it has the stated size on the reference compact set `K`.
-  haveI : (measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)).is_mul_left_invariant :=
-    h𝓕.is_mul_left_invariant_map,
-  rw [measure.haar_measure_unique (measure.map (quotient_group.mk' Γ) (μ.restrict 𝓕)) K,
-    measure.map_apply meas_π, measure.restrict_apply₀' 𝓕meas, inter_comm],
-  exact K.compact.measurable_set,
-end
diff --git a/src/measure_theory/measure/hausdorff.lean b/src/measure_theory/measure/hausdorff.lean
index 10076b104abbb..40b9e7863e06f 100644
--- a/src/measure_theory/measure/hausdorff.lean
+++ b/src/measure_theory/measure/hausdorff.lean
@@ -3,16 +3,19 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
-import analysis.special_functions.pow
-import logic.equiv.list
-import measure_theory.constructions.borel_space
-import measure_theory.measure.lebesgue
+import analysis.convex.between
+import measure_theory.constructions.borel_space.basic
+import measure_theory.measure.haar.inner_product_space
+import measure_theory.measure.lebesgue.basic
 import topology.metric_space.holder
 import topology.metric_space.metric_separated
 
 /-!
 # Hausdorff measure and metric (outer) measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the `d`-dimensional Hausdorff measure on an (extended) metric space `X` and
 the Hausdorff dimension of a set in an (extended) metric space. Let `μ d δ` be the maximal outer
 measure such that `μ d δ s ≤ (emetric.diam s) ^ d` for every set of diameter less than `δ`. Then
@@ -98,11 +101,6 @@ sources only allow coverings by balls and use `r ^ d` instead of `(diam s) ^ d`.
 construction lead to different Hausdorff measures, they lead to the same notion of the Hausdorff
 dimension.
 
-## TODO
-
-* prove that `1`-dimensional Hausdorff measure on `ℝ` equals `volume`;
-* prove a similar statement for `ℝ × ℝ`.
-
 ## References
 
 * [Herbert Federer, Geometric Measure Theory, Chapter 2.10][Federer1996]
@@ -112,7 +110,7 @@ dimension.
 Hausdorff measure, measure, metric measure
 -/
 
-open_locale nnreal ennreal topological_space big_operators
+open_locale nnreal ennreal topology big_operators
 
 open emetric set function filter encodable finite_dimensional topological_space
 
@@ -163,7 +161,7 @@ begin
   rw [borel_eq_generate_from_is_closed],
   refine measurable_space.generate_from_le (λ t ht, μ.is_caratheodory_iff_le.2 $ λ s, _),
   set S : ℕ → set X := λ n, {x ∈ s | (↑n)⁻¹ ≤ inf_edist x t},
-  have n0 : ∀ {n : ℕ}, (n⁻¹ : ℝ≥0∞) ≠ 0, from λ n, ennreal.inv_ne_zero.2 ennreal.coe_nat_ne_top,
+  have n0 : ∀ {n : ℕ}, (n⁻¹ : ℝ≥0∞) ≠ 0, from λ n, ennreal.inv_ne_zero.2 (ennreal.nat_ne_top _),
   have Ssep : ∀ n, is_metric_separated (S n) t,
     from λ n, ⟨n⁻¹, n0, λ x hx y hy, hx.2.trans $ inf_edist_le_edist_of_mem hy⟩,
   have Ssep' : ∀ n, is_metric_separated (S n) (s ∩ t),
@@ -185,7 +183,7 @@ begin
   `μ (s ∩ t) + μ (⋃ n, S n) ≤ μ s`. We can't pass to the limit because
   `μ` is only an outer measure. -/
   by_cases htop : μ (s \ t) = ∞,
-  { rw [htop, ennreal.add_top, ← htop],
+  { rw [htop, add_top, ← htop],
     exact μ.mono (diff_subset _ _) },
   suffices : μ (⋃ n, S n) ≤ ⨆ n, μ (S n),
   calc μ (s ∩ t) + μ (s \ t) = μ (s ∩ t) + μ (⋃ n, S n) :
@@ -199,7 +197,7 @@ begin
   and the second term tends to zero, see `outer_measure.Union_nat_of_monotone_of_tsum_ne_top`
   for details. -/
   have : ∀ n, S n ⊆ S (n + 1), from λ n x hx,
-    ⟨hx.1, le_trans (ennreal.inv_le_inv.2 $ ennreal.coe_nat_le_coe_nat.2 n.le_succ) hx.2⟩,
+    ⟨hx.1, le_trans (ennreal.inv_le_inv.2 $ nat.cast_le.2 n.le_succ) hx.2⟩,
   refine (μ.Union_nat_of_monotone_of_tsum_ne_top this _).le, clear this,
   /- While the sets `S (k + 1) \ S k` are not pairwise metric separated, the sets in each
   subsequence `S (2 * k + 1) \ S (2 * k)` and `S (2 * k + 2) \ S (2 * k)` are metric separated,
@@ -218,7 +216,7 @@ begin
       (λ h, (this j i h).symm.mono  (λ x hx, ⟨hx.1.1, hx.2⟩) (inter_subset_left _ _)),
   intros i j hj,
   have A : ((↑(2 * j + r))⁻¹ : ℝ≥0∞) < (↑(2 * i + 1 + r))⁻¹,
-    by { rw [ennreal.inv_lt_inv, ennreal.coe_nat_lt_coe_nat], linarith },
+    by { rw [ennreal.inv_lt_inv, nat.cast_lt], linarith },
   refine ⟨(↑(2 * i + 1 + r))⁻¹ - (↑(2 * j + r))⁻¹, by simpa using A, λ x hx y hy, _⟩,
   have : inf_edist y t < (↑(2 * j + r))⁻¹, from not_le.1 (λ hle, hy.2 ⟨hy.1, hle⟩),
   rcases inf_edist_lt_iff.mp this with ⟨z, hzt, hyz⟩,
@@ -345,7 +343,7 @@ lemma mk_metric_mono_smul {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} {c : ℝ≥0
   (mk_metric m₁ : outer_measure X) ≤ c • mk_metric m₂ :=
 begin
   classical,
-  rcases (mem_nhds_within_Ici_iff_exists_Ico_subset' ennreal.zero_lt_one).1 hle with ⟨r, hr0, hr⟩,
+  rcases (mem_nhds_within_Ici_iff_exists_Ico_subset' zero_lt_one).1 hle with ⟨r, hr0, hr⟩,
   refine λ s, le_of_tendsto_of_tendsto (mk_metric'.tendsto_pre _ s)
     (ennreal.tendsto.const_mul (mk_metric'.tendsto_pre _ s) (or.inr hc))
     (mem_of_superset (Ioo_mem_nhds_within_Ioi ⟨le_rfl, hr0⟩) (λ r' hr', _)),
@@ -359,11 +357,19 @@ begin
   { simp [h0] }
 end
 
+@[simp] lemma mk_metric_top : (mk_metric (λ _, ∞ : ℝ≥0∞ → ℝ≥0∞) : outer_measure X) = ⊤ :=
+begin
+  simp_rw [mk_metric, mk_metric', mk_metric'.pre, extend_top, bounded_by_top, eq_top_iff],
+  rw le_supr_iff,
+  intros b hb,
+  simpa using hb ⊤,
+end
+
 /-- If `m₁ d ≤ m₂ d` for `d < ε` for some `ε > 0` (we use `≤ᶠ[𝓝[≥] 0]` to state this), then
 `mk_metric m₁ hm₁ ≤ mk_metric m₂ hm₂`-/
 lemma mk_metric_mono {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} (hle : m₁ ≤ᶠ[𝓝[≥] 0] m₂) :
   (mk_metric m₁ : outer_measure X) ≤ mk_metric m₂ :=
-by { convert mk_metric_mono_smul ennreal.one_ne_top ennreal.zero_lt_one.ne' _; simp * }
+by { convert mk_metric_mono_smul ennreal.one_ne_top one_ne_zero _; simp * }
 
 lemma isometry_comap_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) {f : X → Y} (hf : isometry f)
   (H : monotone m ∨ surjective f) :
@@ -383,18 +389,31 @@ begin
     simp only [(diam_mono hst).trans ht, le_refl, cinfi_pos] }
 end
 
+lemma mk_metric_smul (m : ℝ≥0∞ → ℝ≥0∞) {c : ℝ≥0∞} (hc : c ≠ ∞) (hc' : c ≠ 0) :
+  (mk_metric (c • m) : outer_measure X) = c • mk_metric m :=
+begin
+  simp only [mk_metric, mk_metric', mk_metric'.pre, induced_outer_measure,
+    ennreal.smul_supr],
+  simp_rw [smul_supr, smul_bounded_by hc, smul_extend _ hc', pi.smul_apply],
+end
+
+lemma mk_metric_nnreal_smul (m : ℝ≥0∞ → ℝ≥0∞) {c : ℝ≥0} (hc : c ≠ 0) :
+  (mk_metric (c • m) : outer_measure X) = c • mk_metric m :=
+by rw [ennreal.smul_def, ennreal.smul_def,
+    mk_metric_smul m (ennreal.coe_ne_top) (ennreal.coe_ne_zero.mpr hc)]
+
 lemma isometry_map_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) {f : X → Y} (hf : isometry f)
   (H : monotone m ∨ surjective f) :
   map f (mk_metric m) = restrict (range f) (mk_metric m) :=
 by rw [← isometry_comap_mk_metric _ hf H, map_comap]
 
-lemma isometric_comap_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
+lemma isometry_equiv_comap_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
   comap f (mk_metric m) = mk_metric m :=
 isometry_comap_mk_metric _ f.isometry (or.inr f.surjective)
 
-lemma isometric_map_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
+lemma isometry_equiv_map_mk_metric (m : ℝ≥0∞ → ℝ≥0∞) (f : X ≃ᵢ Y) :
   map f (mk_metric m) = mk_metric m :=
-by rw [← isometric_comap_mk_metric _ f, map_comap_of_surjective f.surjective]
+by rw [← isometry_equiv_comap_mk_metric _ f, map_comap_of_surjective f.surjective]
 
 lemma trim_mk_metric [measurable_space X] [borel_space X] (m : ℝ≥0∞ → ℝ≥0∞) :
   (mk_metric m : outer_measure X).trim = mk_metric m :=
@@ -466,11 +485,17 @@ begin
   exact outer_measure.mk_metric_mono_smul hc h0 hle s
 end
 
+@[simp] lemma mk_metric_top : (mk_metric (λ _, ∞ : ℝ≥0∞ → ℝ≥0∞) : measure X) = ⊤ :=
+begin
+  apply to_outer_measure_injective,
+  rw [mk_metric_to_outer_measure, outer_measure.mk_metric_top, to_outer_measure_top],
+end
+
 /-- If `m₁ d ≤ m₂ d` for `d < ε` for some `ε > 0` (we use `≤ᶠ[𝓝[≥] 0]` to state this), then
 `mk_metric m₁ hm₁ ≤ mk_metric m₂ hm₂`-/
 lemma mk_metric_mono {m₁ m₂ : ℝ≥0∞ → ℝ≥0∞} (hle : m₁ ≤ᶠ[𝓝[≥] 0] m₂) :
   (mk_metric m₁ : measure X) ≤ mk_metric m₂ :=
-by { convert mk_metric_mono_smul ennreal.one_ne_top ennreal.zero_lt_one.ne' _; simp * }
+by { convert mk_metric_mono_smul ennreal.one_ne_top one_ne_zero _; simp * }
 
 /-- A formula for `measure_theory.measure.mk_metric`. -/
 lemma mk_metric_apply (m : ℝ≥0∞ → ℝ≥0∞) (s : set X) :
@@ -509,13 +534,14 @@ end
 
 /-- To bound the Hausdorff measure (or, more generally, for a measure defined using
 `measure_theory.measure.mk_metric`) of a set, one may use coverings with maximum diameter tending to
-`0`, indexed by any sequence of encodable types. -/
-lemma mk_metric_le_liminf_tsum {β : Type*} {ι : β → Type*} [∀ n, encodable (ι n)] (s : set X)
+`0`, indexed by any sequence of countable types. -/
+lemma mk_metric_le_liminf_tsum {β : Type*} {ι : β → Type*} [∀ n, countable (ι n)] (s : set X)
   {l : filter β} (r : β → ℝ≥0∞) (hr : tendsto r l (𝓝 0)) (t : Π (n : β), ι n → set X)
   (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n) (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i)
   (m : ℝ≥0∞ → ℝ≥0∞) :
-  mk_metric m s ≤ liminf l (λ n, ∑' i, m (diam (t n i))) :=
+  mk_metric m s ≤ liminf (λ n, ∑' i, m (diam (t n i))) l :=
 begin
+  haveI : Π n, encodable (ι n) := λ n, encodable.of_countable _,
   simp only [mk_metric_apply],
   refine supr₂_le (λ ε hε, _),
   refine le_of_forall_le_of_dense (λ c hc, _),
@@ -540,11 +566,8 @@ lemma mk_metric_le_liminf_sum {β : Type*} {ι : β → Type*} [hι : ∀ n, fin
   {l : filter β} (r : β → ℝ≥0∞) (hr : tendsto r l (𝓝 0)) (t : Π (n : β), ι n → set X)
   (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n) (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i)
   (m : ℝ≥0∞ → ℝ≥0∞) :
-  mk_metric m s ≤ liminf l (λ n, ∑ i, m (diam (t n i))) :=
-begin
-  haveI : ∀ n, encodable (ι n), from λ n, fintype.to_encodable _,
-  simpa only [tsum_fintype] using mk_metric_le_liminf_tsum s r hr t ht hst m,
-end
+  mk_metric m s ≤ liminf (λ n, ∑ i, m (diam (t n i))) l :=
+by simpa only [tsum_fintype] using mk_metric_le_liminf_tsum s r hr t ht hst m
 
 /-!
 ### Hausdorff measure and Hausdorff dimension
@@ -553,7 +576,8 @@ end
 /-- Hausdorff measure on an (e)metric space. -/
 def hausdorff_measure (d : ℝ) : measure X := mk_metric (λ r, r ^ d)
 
-localized "notation `μH[` d `]` := measure_theory.measure.hausdorff_measure d" in measure_theory
+localized "notation (name := hausdorff_measure)
+  `μH[` d `]` := measure_theory.measure.hausdorff_measure d" in measure_theory
 
 lemma le_hausdorff_measure (d : ℝ) (μ : measure X) (ε : ℝ≥0∞) (h₀ : 0 < ε)
   (h : ∀ s : set X, diam s ≤ ε → μ s ≤ diam s ^ d) :
@@ -567,12 +591,12 @@ lemma hausdorff_measure_apply (d : ℝ) (s : set X) :
 mk_metric_apply _ _
 
 /-- To bound the Hausdorff measure of a set, one may use coverings with maximum diameter tending
-to `0`, indexed by any sequence of encodable types. -/
-lemma hausdorff_measure_le_liminf_tsum {β : Type*}  {ι : β → Type*} [hι : ∀ n, encodable (ι n)]
+to `0`, indexed by any sequence of countable types. -/
+lemma hausdorff_measure_le_liminf_tsum {β : Type*}  {ι : β → Type*} [hι : ∀ n, countable (ι n)]
   (d : ℝ) (s : set X)
   {l : filter β} (r : β → ℝ≥0∞) (hr : tendsto r l (𝓝 0)) (t : Π (n : β), ι n → set X)
   (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n) (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i) :
-  μH[d] s ≤ liminf l (λ n, ∑' i, diam (t n i) ^ d) :=
+  μH[d] s ≤ liminf (λ n, ∑' i, diam (t n i) ^ d) l :=
 mk_metric_le_liminf_tsum s r hr t ht hst _
 
 /-- To bound the Hausdorff measure of a set, one may use coverings with maximum diameter tending
@@ -581,7 +605,7 @@ lemma hausdorff_measure_le_liminf_sum {β : Type*}  {ι : β → Type*} [hι : 
   (d : ℝ) (s : set X)
   {l : filter β} (r : β → ℝ≥0∞) (hr : tendsto r l (𝓝 0)) (t : Π (n : β), ι n → set X)
   (ht : ∀ᶠ n in l, ∀ i, diam (t n i) ≤ r n) (hst : ∀ᶠ n in l, s ⊆ ⋃ i, t n i) :
-  μH[d] s ≤ liminf l (λ n, ∑ i, diam (t n i) ^ d) :=
+  μH[d] s ≤ liminf (λ n, ∑ i, diam (t n i) ^ d) l :=
 mk_metric_le_liminf_sum s r hr t ht hst _
 
 /-- If `d₁ < d₂`, then for any set `s` we have either `μH[d₂] s = 0`, or `μH[d₁] s = ∞`. -/
@@ -605,10 +629,9 @@ begin
     (or.inr $ mt ennreal.coe_eq_zero.1 hc)],
   rcases eq_or_ne r 0 with rfl|hr₀,
   { rcases lt_or_le 0 d₂ with h₂|h₂,
-    { simp only [h₂, ennreal.zero_rpow_of_pos, zero_le', ennreal.coe_nonneg, ennreal.zero_div,
-        ennreal.coe_zero] },
-    { simp only [h.trans_le h₂, ennreal.div_top, zero_le', ennreal.coe_nonneg,
-        ennreal.zero_rpow_of_neg, ennreal.coe_zero] } },
+    { simp only [h₂, ennreal.zero_rpow_of_pos, zero_le, ennreal.zero_div, ennreal.coe_zero] },
+    { simp only [h.trans_le h₂, ennreal.div_top, zero_le, ennreal.zero_rpow_of_neg,
+        ennreal.coe_zero] } },
   { have : (r : ℝ≥0∞) ≠ 0, by simpa only [ennreal.coe_eq_zero, ne.def] using hr₀,
     rw [← ennreal.rpow_sub _ _ this ennreal.coe_ne_top],
     refine (ennreal.rpow_lt_rpow hrc (sub_pos.2 h)).le.trans _,
@@ -650,7 +673,7 @@ begin
     suffices : (1 : ℝ≥0∞) ≤ ⨅ (t : ℕ → set X) (hts : {x} ⊆ ⋃ n, t n)
       (ht : ∀ n, diam (t n) ≤ 1), ∑' n, ⨆ (h : (t n).nonempty), (diam (t n)) ^ (0 : ℝ),
     { apply le_trans this _,
-      convert le_supr₂ (1 : ℝ≥0∞) (ennreal.zero_lt_one),
+      convert le_supr₂ (1 : ℝ≥0∞) zero_lt_one,
       refl },
     simp only [ennreal.rpow_zero, le_infi_iff],
     assume t hst h't,
@@ -683,108 +706,6 @@ end
 
 end measure
 
-open_locale measure_theory
-open measure
-
-/-!
-### Hausdorff measure and Lebesgue measure
--/
-
-/-- In the space `ι → ℝ`, Hausdorff measure coincides exactly with Lebesgue measure. -/
-@[simp] theorem hausdorff_measure_pi_real {ι : Type*} [fintype ι] :
-  (μH[fintype.card ι] : measure (ι → ℝ)) = volume :=
-begin
-  classical,
-  -- it suffices to check that the two measures coincide on products of rational intervals
-  refine (pi_eq_generate_from (λ i, real.borel_eq_generate_from_Ioo_rat.symm)
-    (λ i, real.is_pi_system_Ioo_rat) (λ i, real.finite_spanning_sets_in_Ioo_rat _)
-    _).symm,
-  simp only [mem_Union, mem_singleton_iff],
-  -- fix such a product `s` of rational intervals, of the form `Π (a i, b i)`.
-  intros s hs,
-  choose a b H using hs,
-  obtain rfl : s = λ i, Ioo (a i) (b i), from funext (λ i, (H i).2), replace H := λ i, (H i).1,
-  apply le_antisymm _,
-  -- first check that `volume s ≤ μH s`
-  { have Hle : volume ≤ (μH[fintype.card ι] : measure (ι → ℝ)),
-    { refine le_hausdorff_measure _ _ ∞ ennreal.coe_lt_top (λ s _, _),
-      rw [ennreal.rpow_nat_cast],
-      exact real.volume_pi_le_diam_pow s },
-    rw [← volume_pi_pi (λ i, Ioo (a i : ℝ) (b i))],
-    exact measure.le_iff'.1 Hle _ },
-  /- For the other inequality `μH s ≤ volume s`, we use a covering of `s` by sets of small diameter
-  `1/n`, namely cubes with left-most point of the form `a i + f i / n` with `f i` ranging between
-  `0` and `⌈(b i - a i) * n⌉`. Their number is asymptotic to `n^d * Π (b i - a i)`. -/
-  have I : ∀ i, 0 ≤ (b i : ℝ) - a i := λ i, by simpa only [sub_nonneg, rat.cast_le] using (H i).le,
-  let γ := λ (n : ℕ), (Π (i : ι), fin ⌈((b i : ℝ) - a i) * n⌉₊),
-  let t : Π (n : ℕ), γ n → set (ι → ℝ) :=
-    λ n f, set.pi univ (λ i, Icc (a i + f i / n) (a i + (f i + 1) / n)),
-  have A : tendsto (λ (n : ℕ), 1/(n : ℝ≥0∞)) at_top (𝓝 0),
-    by simp only [one_div, ennreal.tendsto_inv_nat_nhds_zero],
-  have B : ∀ᶠ n in at_top, ∀ (i : γ n), diam (t n i) ≤ 1 / n,
-  { apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
-    assume f,
-    apply diam_pi_le_of_le (λ b, _),
-    simp only [real.ediam_Icc, add_div, ennreal.of_real_div_of_pos (nat.cast_pos.mpr hn), le_refl,
-      add_sub_add_left_eq_sub, add_sub_cancel', ennreal.of_real_one, ennreal.of_real_coe_nat] },
-  have C : ∀ᶠ n in at_top, set.pi univ (λ (i : ι), Ioo (a i : ℝ) (b i)) ⊆ ⋃ (i : γ n), t n i,
-  { apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
-    have npos : (0 : ℝ) < n := nat.cast_pos.2 hn,
-    assume x hx,
-    simp only [mem_Ioo, mem_univ_pi] at hx,
-    simp only [mem_Union, mem_Ioo, mem_univ_pi, coe_coe],
-    let f : γ n := λ i, ⟨⌊(x i - a i) * n⌋₊,
-    begin
-      apply nat.floor_lt_ceil_of_lt_of_pos,
-      { refine (mul_lt_mul_right npos).2 _,
-        simp only [(hx i).right, sub_lt_sub_iff_right] },
-      { refine mul_pos _ npos,
-        simpa only [rat.cast_lt, sub_pos] using H i }
-    end⟩,
-    refine ⟨f, λ i, ⟨_, _⟩⟩,
-    { calc (a i : ℝ) + ⌊(x i - a i) * n⌋₊ / n
-      ≤ (a i : ℝ) + ((x i - a i) * n) / n :
-          begin
-            refine add_le_add le_rfl ((div_le_div_right npos).2 _),
-            exact nat.floor_le (mul_nonneg (sub_nonneg.2 (hx i).1.le) npos.le),
-          end
-      ... = x i : by field_simp [npos.ne'] },
-    { calc x i
-      = (a i : ℝ) + ((x i - a i) * n) / n : by field_simp [npos.ne']
-      ... ≤ (a i : ℝ) + (⌊(x i - a i) * n⌋₊ + 1) / n :
-        add_le_add le_rfl ((div_le_div_right npos).2 (nat.lt_floor_add_one _).le) } },
-  calc μH[fintype.card ι] (set.pi univ (λ (i : ι), Ioo (a i : ℝ) (b i)))
-    ≤ liminf at_top (λ (n : ℕ), ∑ (i : γ n), diam (t n i) ^ ↑(fintype.card ι)) :
-      hausdorff_measure_le_liminf_sum _ (set.pi univ (λ i, Ioo (a i : ℝ) (b i)))
-        (λ (n : ℕ), 1/(n : ℝ≥0∞)) A t B C
-  ... ≤ liminf at_top (λ (n : ℕ), ∑ (i : γ n), (1/n) ^ (fintype.card ι)) :
-    begin
-      refine liminf_le_liminf _ (by is_bounded_default),
-      filter_upwards [B] with _ hn,
-      apply finset.sum_le_sum (λ i _, _),
-      rw ennreal.rpow_nat_cast,
-      exact pow_le_pow_of_le_left' (hn i) _,
-    end
-  ... = liminf at_top (λ (n : ℕ), ∏ (i : ι), (⌈((b i : ℝ) - a i) * n⌉₊ : ℝ≥0∞) / n) :
-  begin
-    simp only [finset.card_univ, nat.cast_prod, one_mul, fintype.card_fin,
-      finset.sum_const, nsmul_eq_mul, fintype.card_pi, div_eq_mul_inv, finset.prod_mul_distrib,
-      finset.prod_const]
-  end
-  ... = ∏ (i : ι), volume (Ioo (a i : ℝ) (b i)) :
-  begin
-    simp only [real.volume_Ioo],
-    apply tendsto.liminf_eq,
-    refine ennreal.tendsto_finset_prod_of_ne_top _ (λ i hi, _) (λ i hi, _),
-    { apply tendsto.congr' _ ((ennreal.continuous_of_real.tendsto _).comp
-        ((tendsto_nat_ceil_mul_div_at_top (I i)).comp tendsto_coe_nat_at_top_at_top)),
-      apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
-      simp only [ennreal.of_real_div_of_pos (nat.cast_pos.mpr hn), comp_app,
-        ennreal.of_real_coe_nat] },
-    { simp only [ennreal.of_real_ne_top, ne.def, not_false_iff] }
-  end
-end
-
 end measure_theory
 
 /-!
@@ -867,6 +788,25 @@ lemma hausdorff_measure_image_le (h : lipschitz_with K f) {d : ℝ} (hd : 0 ≤
 
 end lipschitz_with
 
+open_locale pointwise
+
+lemma measure_theory.measure.hausdorff_measure_smul₀
+  {𝕜 E : Type*} [normed_add_comm_group E] [normed_field 𝕜] [normed_space 𝕜 E] [measurable_space E]
+  [borel_space E]
+  {d : ℝ} (hd : 0 ≤ d) {r : 𝕜} (hr : r ≠ 0) (s : set E) :
+  μH[d] (r • s) = ‖r‖₊ ^ d • μH[d] s :=
+begin
+  suffices : ∀ {r : 𝕜}, r ≠ 0 → ∀ s : set E, μH[d] (r • s) ≤ ‖r‖₊ ^ d • μH[d] s,
+  { refine le_antisymm (this hr s) _,
+    rw [←ennreal.le_inv_smul_iff, ←nnreal.inv_rpow, ←nnnorm_inv],
+    { refine eq.trans_le _ (this (inv_ne_zero hr) (r • s)),
+      rw inv_smul_smul₀ hr },
+    { simp [hr] } },
+  intros r hr s,
+  simpa only [ennreal.smul_def, smul_eq_mul, ← ennreal.coe_rpow_of_nonneg _ hd]
+    using (@lipschitz_with_smul _ E _ _ _ _ r).hausdorff_measure_image_le hd s,
+end
+
 /-!
 ### Antilipschitz maps do not decrease Hausdorff measures and dimension
 -/
@@ -883,7 +823,7 @@ begin
     { simp only [hs, measure_empty, zero_le], },
     have : f ⁻¹' s = {x},
     { haveI : subsingleton X := hf.subsingleton,
-      have : (f ⁻¹' s).subsingleton, from subsingleton_univ.mono (subset_univ _),
+      have : (f ⁻¹' s).subsingleton, from subsingleton_univ.anti (subset_univ _),
       exact (subsingleton_iff_singleton hx).1 this },
     rw this,
     rcases eq_or_lt_of_le hd with rfl|h'd,
@@ -944,7 +884,7 @@ end
 
 end isometry
 
-namespace isometric
+namespace isometry_equiv
 
 @[simp] lemma hausdorff_measure_image (e : X ≃ᵢ Y) (d : ℝ) (s : set X) :
   μH[d] (e '' s) = μH[d] s :=
@@ -954,4 +894,255 @@ e.isometry.hausdorff_measure_image (or.inr e.surjective) s
   μH[d] (e ⁻¹' s) = μH[d] s :=
 by rw [← e.image_symm, e.symm.hausdorff_measure_image]
 
-end isometric
+@[simp] lemma map_hausdorff_measure (e : X ≃ᵢ Y) (d : ℝ) : measure.map e μH[d] = μH[d] :=
+by rw [e.isometry.map_hausdorff_measure (or.inr e.surjective), e.surjective.range_eq, restrict_univ]
+
+lemma measure_preserving_hausdorff_measure (e : X ≃ᵢ Y) (d : ℝ) :
+  measure_preserving e μH[d] μH[d] :=
+⟨e.continuous.measurable, map_hausdorff_measure _ _⟩
+
+end isometry_equiv
+
+namespace measure_theory
+
+@[to_additive]
+lemma hausdorff_measure_smul
+  {α : Type*} [has_smul α X] [has_isometric_smul α X]
+  {d : ℝ} (c : α) (h : 0 ≤ d ∨ surjective ((•) c : X → X)) (s : set X) :
+  μH[d] (c • s) = μH[d] s :=
+(isometry_smul X c).hausdorff_measure_image h _
+
+@[to_additive]
+instance {d : ℝ} [group X] [has_isometric_smul X X] : is_mul_left_invariant (μH[d] : measure X) :=
+{ map_mul_left_eq_self := λ x, (isometry_equiv.const_smul x).map_hausdorff_measure _ }
+
+@[to_additive]
+instance {d : ℝ} [group X] [has_isometric_smul Xᵐᵒᵖ X] :
+  is_mul_right_invariant (μH[d] : measure X) :=
+{ map_mul_right_eq_self := λ x,
+    (isometry_equiv.const_smul (mul_opposite.op x)).map_hausdorff_measure _ }
+
+/-!
+### Hausdorff measure and Lebesgue measure
+-/
+
+/-- In the space `ι → ℝ`, the Hausdorff measure coincides exactly with the Lebesgue measure. -/
+@[simp] theorem hausdorff_measure_pi_real {ι : Type*} [fintype ι] :
+  (μH[fintype.card ι] : measure (ι → ℝ)) = volume :=
+begin
+  classical,
+  -- it suffices to check that the two measures coincide on products of rational intervals
+  refine (pi_eq_generate_from (λ i, real.borel_eq_generate_from_Ioo_rat.symm)
+    (λ i, real.is_pi_system_Ioo_rat) (λ i, real.finite_spanning_sets_in_Ioo_rat _)
+    _).symm,
+  simp only [mem_Union, mem_singleton_iff],
+  -- fix such a product `s` of rational intervals, of the form `Π (a i, b i)`.
+  intros s hs,
+  choose a b H using hs,
+  obtain rfl : s = λ i, Ioo (a i) (b i), from funext (λ i, (H i).2), replace H := λ i, (H i).1,
+  apply le_antisymm _,
+  -- first check that `volume s ≤ μH s`
+  { have Hle : volume ≤ (μH[fintype.card ι] : measure (ι → ℝ)),
+    { refine le_hausdorff_measure _ _ ∞ ennreal.coe_lt_top (λ s _, _),
+      rw [ennreal.rpow_nat_cast],
+      exact real.volume_pi_le_diam_pow s },
+    rw [← volume_pi_pi (λ i, Ioo (a i : ℝ) (b i))],
+    exact measure.le_iff'.1 Hle _ },
+  /- For the other inequality `μH s ≤ volume s`, we use a covering of `s` by sets of small diameter
+  `1/n`, namely cubes with left-most point of the form `a i + f i / n` with `f i` ranging between
+  `0` and `⌈(b i - a i) * n⌉`. Their number is asymptotic to `n^d * Π (b i - a i)`. -/
+  have I : ∀ i, 0 ≤ (b i : ℝ) - a i := λ i, by simpa only [sub_nonneg, rat.cast_le] using (H i).le,
+  let γ := λ (n : ℕ), (Π (i : ι), fin ⌈((b i : ℝ) - a i) * n⌉₊),
+  let t : Π (n : ℕ), γ n → set (ι → ℝ) :=
+    λ n f, set.pi univ (λ i, Icc (a i + f i / n) (a i + (f i + 1) / n)),
+  have A : tendsto (λ (n : ℕ), 1/(n : ℝ≥0∞)) at_top (𝓝 0),
+    by simp only [one_div, ennreal.tendsto_inv_nat_nhds_zero],
+  have B : ∀ᶠ n in at_top, ∀ (i : γ n), diam (t n i) ≤ 1 / n,
+  { apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
+    assume f,
+    apply diam_pi_le_of_le (λ b, _),
+    simp only [real.ediam_Icc, add_div, ennreal.of_real_div_of_pos (nat.cast_pos.mpr hn), le_refl,
+      add_sub_add_left_eq_sub, add_sub_cancel', ennreal.of_real_one, ennreal.of_real_coe_nat] },
+  have C : ∀ᶠ n in at_top, set.pi univ (λ (i : ι), Ioo (a i : ℝ) (b i)) ⊆ ⋃ (i : γ n), t n i,
+  { apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
+    have npos : (0 : ℝ) < n := nat.cast_pos.2 hn,
+    assume x hx,
+    simp only [mem_Ioo, mem_univ_pi] at hx,
+    simp only [mem_Union, mem_Ioo, mem_univ_pi, coe_coe],
+    let f : γ n := λ i, ⟨⌊(x i - a i) * n⌋₊,
+    begin
+      apply nat.floor_lt_ceil_of_lt_of_pos,
+      { refine (mul_lt_mul_right npos).2 _,
+        simp only [(hx i).right, sub_lt_sub_iff_right] },
+      { refine mul_pos _ npos,
+        simpa only [rat.cast_lt, sub_pos] using H i }
+    end⟩,
+    refine ⟨f, λ i, ⟨_, _⟩⟩,
+    { calc (a i : ℝ) + ⌊(x i - a i) * n⌋₊ / n
+      ≤ (a i : ℝ) + ((x i - a i) * n) / n :
+          begin
+            refine add_le_add le_rfl ((div_le_div_right npos).2 _),
+            exact nat.floor_le (mul_nonneg (sub_nonneg.2 (hx i).1.le) npos.le),
+          end
+      ... = x i : by field_simp [npos.ne'] },
+    { calc x i
+      = (a i : ℝ) + ((x i - a i) * n) / n : by field_simp [npos.ne']
+      ... ≤ (a i : ℝ) + (⌊(x i - a i) * n⌋₊ + 1) / n :
+        add_le_add le_rfl ((div_le_div_right npos).2 (nat.lt_floor_add_one _).le) } },
+  calc μH[fintype.card ι] (set.pi univ (λ (i : ι), Ioo (a i : ℝ) (b i)))
+    ≤ liminf (λ (n : ℕ), ∑ (i : γ n), diam (t n i) ^ ↑(fintype.card ι)) at_top :
+      hausdorff_measure_le_liminf_sum _ (set.pi univ (λ i, Ioo (a i : ℝ) (b i)))
+        (λ (n : ℕ), 1/(n : ℝ≥0∞)) A t B C
+  ... ≤ liminf (λ (n : ℕ), ∑ (i : γ n), (1/n) ^ (fintype.card ι)) at_top :
+    begin
+      refine liminf_le_liminf _ (by is_bounded_default),
+      filter_upwards [B] with _ hn,
+      apply finset.sum_le_sum (λ i _, _),
+      rw ennreal.rpow_nat_cast,
+      exact pow_le_pow_of_le_left' (hn i) _,
+    end
+  ... = liminf (λ (n : ℕ), ∏ (i : ι), (⌈((b i : ℝ) - a i) * n⌉₊ : ℝ≥0∞) / n) at_top :
+  begin
+    simp only [finset.card_univ, nat.cast_prod, one_mul, fintype.card_fin,
+      finset.sum_const, nsmul_eq_mul, fintype.card_pi, div_eq_mul_inv, finset.prod_mul_distrib,
+      finset.prod_const]
+  end
+  ... = ∏ (i : ι), volume (Ioo (a i : ℝ) (b i)) :
+  begin
+    simp only [real.volume_Ioo],
+    apply tendsto.liminf_eq,
+    refine ennreal.tendsto_finset_prod_of_ne_top _ (λ i hi, _) (λ i hi, _),
+    { apply tendsto.congr' _ ((ennreal.continuous_of_real.tendsto _).comp
+        ((tendsto_nat_ceil_mul_div_at_top (I i)).comp tendsto_coe_nat_at_top_at_top)),
+      apply eventually_at_top.2 ⟨1, λ n hn, _⟩,
+      simp only [ennreal.of_real_div_of_pos (nat.cast_pos.mpr hn), comp_app,
+        ennreal.of_real_coe_nat] },
+    { simp only [ennreal.of_real_ne_top, ne.def, not_false_iff] }
+  end
+end
+
+variables (ι X)
+
+theorem hausdorff_measure_measure_preserving_fun_unique [unique ι]
+  [topological_space.second_countable_topology X] (d : ℝ) :
+  measure_preserving (measurable_equiv.fun_unique ι X) μH[d] μH[d] :=
+(isometry_equiv.fun_unique ι X).measure_preserving_hausdorff_measure _
+
+theorem hausdorff_measure_measure_preserving_pi_fin_two (α : fin 2 → Type*)
+  [Π i, measurable_space (α i)] [Π i, emetric_space (α i)] [Π i, borel_space (α i)]
+  [Π i, topological_space.second_countable_topology (α i)] (d : ℝ) :
+  measure_preserving (measurable_equiv.pi_fin_two α) μH[d] μH[d] :=
+(isometry_equiv.pi_fin_two α).measure_preserving_hausdorff_measure _
+
+/-- In the space `ℝ`, the Hausdorff measure coincides exactly with the Lebesgue measure. -/
+@[simp] theorem hausdorff_measure_real : (μH[1] : measure ℝ) = volume :=
+by rw [←(volume_preserving_fun_unique unit ℝ).map_eq,
+    ←(hausdorff_measure_measure_preserving_fun_unique unit ℝ 1).map_eq,
+    ←hausdorff_measure_pi_real, fintype.card_unit, nat.cast_one]
+
+/-- In the space `ℝ × ℝ`, the Hausdorff measure coincides exactly with the Lebesgue measure. -/
+@[simp] theorem hausdorff_measure_prod_real : (μH[2] : measure (ℝ × ℝ)) = volume :=
+by rw [←(volume_preserving_pi_fin_two (λ i, ℝ)).map_eq,
+    ←(hausdorff_measure_measure_preserving_pi_fin_two (λ i, ℝ) _).map_eq,
+    ←hausdorff_measure_pi_real, fintype.card_fin, nat.cast_two]
+
+/-! ### Geometric results in affine spaces -/
+
+section geometric
+variables {𝕜 E P : Type*}
+
+lemma hausdorff_measure_smul_right_image [normed_add_comm_group E] [normed_space ℝ E]
+  [measurable_space E] [borel_space E] (v : E) (s : set ℝ) :
+  μH[1] ((λ r, r • v) '' s) = ‖v‖₊ • μH[1] s :=
+begin
+  obtain rfl | hv := eq_or_ne v 0,
+  { haveI := no_atoms_hausdorff E one_pos,
+    obtain rfl | hs := s.eq_empty_or_nonempty,
+    { simp },
+    simp [hs] },
+  have hn : ‖v‖ ≠ 0 := norm_ne_zero_iff.mpr hv,
+  -- break line_map into pieces
+  suffices : μH[1] (
+      ((•) ‖v‖) '' (linear_map.to_span_singleton ℝ E (‖v‖⁻¹ • v) '' s)) = ‖v‖₊ • μH[1] s,
+  { simpa only [set.image_image, smul_comm (norm _), inv_smul_smul₀ hn,
+      linear_map.to_span_singleton_apply] using this },
+  have iso_smul : isometry (linear_map.to_span_singleton ℝ E (‖v‖⁻¹ • v)),
+  { refine add_monoid_hom_class.isometry_of_norm _ (λ x, (norm_smul _ _).trans _),
+    rw [norm_smul, norm_inv, norm_norm, inv_mul_cancel hn, mul_one, linear_map.id_apply] },
+  rw [set.image_smul,
+    measure.hausdorff_measure_smul₀ zero_le_one hn, nnnorm_norm, nnreal.rpow_one,
+    iso_smul.hausdorff_measure_image (or.inl $ zero_le_one' ℝ)],
+end
+
+section normed_field_affine
+variables [normed_field 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E] [measurable_space P]
+variables [metric_space P] [normed_add_torsor E P] [borel_space P]
+include E
+
+/-- Scaling by `c` around `x` scales the measure by `‖c‖₊ ^ d`. -/
+lemma hausdorff_measure_homothety_image
+  {d : ℝ} (hd : 0 ≤ d) (x : P) {c : 𝕜} (hc : c ≠ 0) (s : set P) :
+  μH[d] (affine_map.homothety x c '' s) = ‖c‖₊ ^ d • μH[d] s :=
+begin
+  suffices :
+    μH[d] (isometry_equiv.vadd_const x '' (((•) c) '' ((isometry_equiv.vadd_const x).symm '' s)))
+      = ‖c‖₊ ^ d • μH[d] s,
+  { simpa only [set.image_image] },
+  borelize E,
+  rw [isometry_equiv.hausdorff_measure_image, set.image_smul, measure.hausdorff_measure_smul₀ hd hc,
+    isometry_equiv.hausdorff_measure_image],
+end
+
+lemma hausdorff_measure_homothety_preimage
+  {d : ℝ} (hd : 0 ≤ d) (x : P) {c : 𝕜} (hc : c ≠ 0) (s : set P) :
+  μH[d] (affine_map.homothety x c ⁻¹' s) = ‖c‖₊⁻¹ ^ d • μH[d] s :=
+begin
+  change μH[d] (affine_equiv.homothety_units_mul_hom x (units.mk0 c hc) ⁻¹' s) = _,
+  rw [←affine_equiv.image_symm, affine_equiv.coe_homothety_units_mul_hom_apply_symm,
+    hausdorff_measure_homothety_image hd x (_ : 𝕜ˣ).is_unit.ne_zero, units.coe_inv, units.coe_mk0,
+    nnnorm_inv],
+end
+
+/-! TODO: prove `measure.map (affine_map.homothety x c) μH[d] = ‖c‖₊⁻¹ ^ d • μH[d]`, which needs a
+more general version of `affine_map.homothety_continuous` -/
+
+end normed_field_affine
+
+section real_affine
+variables [normed_add_comm_group E] [normed_space ℝ E] [measurable_space P]
+variables [metric_space P] [normed_add_torsor E P] [borel_space P]
+include E
+
+/-- Mapping a set of reals along a line segment scales the measure by the length of a segment.
+
+This is an auxiliary result used to prove `hausdorff_measure_affine_segment`. -/
+lemma hausdorff_measure_line_map_image (x y : P) (s : set ℝ) :
+  μH[1] (affine_map.line_map x y '' s) = nndist x y • μH[1] s :=
+begin
+  suffices : μH[1] (isometry_equiv.vadd_const x '' ((• y -ᵥ x) '' s)) = nndist x y • μH[1] s,
+  { simpa only [set.image_image] },
+  borelize E,
+  rw [isometry_equiv.hausdorff_measure_image, hausdorff_measure_smul_right_image,
+    nndist_eq_nnnorm_vsub' E],
+end
+
+/-- The measure of a segment is the distance between its endpoints. -/
+@[simp] lemma hausdorff_measure_affine_segment (x y : P) :
+  μH[1] (affine_segment ℝ x y) = edist x y :=
+begin
+  rw [affine_segment, hausdorff_measure_line_map_image, hausdorff_measure_real, real.volume_Icc,
+    sub_zero, ennreal.of_real_one, ← algebra.algebra_map_eq_smul_one],
+  exact (edist_nndist _ _).symm,
+end
+
+end real_affine
+
+/-- The measure of a segment is the distance between its endpoints. -/
+@[simp] lemma hausdorff_measure_segment {E : Type*} [normed_add_comm_group E]
+  [normed_space ℝ E] [measurable_space E] [borel_space E] (x y : E) :
+  μH[1] (segment ℝ x y) = edist x y :=
+by rw [←affine_segment_eq_segment, hausdorff_measure_affine_segment]
+
+end geometric
+
+end measure_theory
diff --git a/src/measure_theory/measure/lebesgue.lean b/src/measure_theory/measure/lebesgue.lean
deleted file mode 100644
index 698d983613721..0000000000000
--- a/src/measure_theory/measure/lebesgue.lean
+++ /dev/null
@@ -1,489 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Sébastien Gouëzel, Yury Kudryashov
--/
-import dynamics.ergodic.measure_preserving
-import linear_algebra.determinant
-import linear_algebra.matrix.diagonal
-import linear_algebra.matrix.transvection
-import measure_theory.constructions.pi
-import measure_theory.measure.stieltjes
-
-/-!
-# Lebesgue measure on the real line and on `ℝⁿ`
-
-We construct Lebesgue measure on the real line, as a particular case of Stieltjes measure associated
-to the function `x ↦ x`. We obtain as a consequence Lebesgue measure on `ℝⁿ`. We prove that they
-are translation invariant.
-
-We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
-value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.
-
-More properties of the Lebesgue measure are deduced from this in `haar_lebesgue.lean`, where they
-are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
--/
-
-noncomputable theory
-open classical set filter measure_theory measure_theory.measure
-open ennreal (of_real)
-open_locale big_operators ennreal nnreal topological_space
-
-/-!
-### Definition of the Lebesgue measure and lengths of intervals
--/
-
-/-- Lebesgue measure on the Borel sigma algebra, giving measure `b - a` to the interval `[a, b]`. -/
-instance real.measure_space : measure_space ℝ :=
-⟨stieltjes_function.id.measure⟩
-
-namespace real
-
-variables {ι : Type*} [fintype ι]
-
-open_locale topological_space
-
-theorem volume_val (s) : volume s = stieltjes_function.id.measure s := rfl
-
-@[simp] lemma volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) :=
-by simp [volume_val]
-
-@[simp] lemma volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) :=
-by simp [volume_val]
-
-@[simp] lemma volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) :=
-by simp [volume_val]
-
-@[simp] lemma volume_Ioc {a b : ℝ} : volume (Ioc a b) = of_real (b - a) :=
-by simp [volume_val]
-
-@[simp] lemma volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 :=
-by simp [volume_val]
-
-@[simp] lemma volume_univ : volume (univ : set ℝ) = ∞ :=
-ennreal.eq_top_of_forall_nnreal_le $ λ r,
-  calc (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) : by simp
-              ... ≤ volume univ            : measure_mono (subset_univ _)
-
-@[simp] lemma volume_ball (a r : ℝ) :
-  volume (metric.ball a r) = of_real (2 * r) :=
-by rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]
-
-@[simp] lemma volume_closed_ball (a r : ℝ) :
-  volume (metric.closed_ball a r) = of_real (2 * r) :=
-by rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]
-
-@[simp] lemma volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) :
-  volume (emetric.ball a r) = 2 * r :=
-begin
-  rcases eq_or_ne r ∞ with rfl|hr,
-  { rw [metric.emetric_ball_top, volume_univ, two_mul, ennreal.top_add] },
-  { lift r to ℝ≥0 using hr,
-    rw [metric.emetric_ball_nnreal, volume_ball, two_mul, ← nnreal.coe_add,
-      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
-end
-
-@[simp] lemma volume_emetric_closed_ball (a : ℝ) (r : ℝ≥0∞) :
-  volume (emetric.closed_ball a r) = 2 * r :=
-begin
-  rcases eq_or_ne r ∞ with rfl|hr,
-  { rw [emetric.closed_ball_top, volume_univ, two_mul, ennreal.top_add] },
-  { lift r to ℝ≥0 using hr,
-    rw [metric.emetric_closed_ball_nnreal, volume_closed_ball, two_mul, ← nnreal.coe_add,
-      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
-end
-
-instance has_no_atoms_volume : has_no_atoms (volume : measure ℝ) :=
-⟨λ x, volume_singleton⟩
-
-@[simp] lemma volume_interval {a b : ℝ} : volume (interval a b) = of_real (|b - a|) :=
-by rw [interval, volume_Icc, max_sub_min_eq_abs]
-
-@[simp] lemma volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
-top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
-calc (n : ℝ≥0∞) = volume (Ioo a (a + n)) : by simp
-... ≤ volume (Ioi a) : measure_mono Ioo_subset_Ioi_self
-
-@[simp] lemma volume_Ici {a : ℝ} : volume (Ici a) = ∞ :=
-by simp [← measure_congr Ioi_ae_eq_Ici]
-
-@[simp] lemma volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
-top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
-calc (n : ℝ≥0∞) = volume (Ioo (a - n) a) : by simp
-... ≤ volume (Iio a) : measure_mono Ioo_subset_Iio_self
-
-@[simp] lemma volume_Iic {a : ℝ} : volume (Iic a) = ∞ :=
-by simp [← measure_congr Iio_ae_eq_Iic]
-
-instance locally_finite_volume : is_locally_finite_measure (volume : measure ℝ) :=
-⟨λ x, ⟨Ioo (x - 1) (x + 1),
-  is_open.mem_nhds is_open_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩,
-  by simp only [real.volume_Ioo, ennreal.of_real_lt_top]⟩⟩
-
-instance is_finite_measure_restrict_Icc (x y : ℝ) : is_finite_measure (volume.restrict (Icc x y)) :=
-⟨by simp⟩
-
-instance is_finite_measure_restrict_Ico (x y : ℝ) : is_finite_measure (volume.restrict (Ico x y)) :=
-⟨by simp⟩
-
-instance is_finite_measure_restrict_Ioc (x y : ℝ) : is_finite_measure (volume.restrict (Ioc x y)) :=
- ⟨by simp⟩
-
-instance is_finite_measure_restrict_Ioo (x y : ℝ) : is_finite_measure (volume.restrict (Ioo x y)) :=
-⟨by simp⟩
-
-/-!
-### Volume of a box in `ℝⁿ`
--/
-
-lemma volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ennreal.of_real (b i - a i) :=
-begin
-  rw [← pi_univ_Icc, volume_pi_pi],
-  simp only [real.volume_Icc]
-end
-
-@[simp] lemma volume_Icc_pi_to_real {a b : ι → ℝ} (h : a ≤ b) :
-  (volume (Icc a b)).to_real = ∏ i, (b i - a i) :=
-by simp only [volume_Icc_pi, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
-
-lemma volume_pi_Ioo {a b : ι → ℝ} :
-  volume (pi univ (λ i, Ioo (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
-(measure_congr measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi
-
-@[simp] lemma volume_pi_Ioo_to_real {a b : ι → ℝ} (h : a ≤ b) :
-  (volume (pi univ (λ i, Ioo (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
-by simp only [volume_pi_Ioo, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
-
-lemma volume_pi_Ioc {a b : ι → ℝ} :
-  volume (pi univ (λ i, Ioc (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
-(measure_congr measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi
-
-@[simp] lemma volume_pi_Ioc_to_real {a b : ι → ℝ} (h : a ≤ b) :
-  (volume (pi univ (λ i, Ioc (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
-by simp only [volume_pi_Ioc, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
-
-lemma volume_pi_Ico {a b : ι → ℝ} :
-  volume (pi univ (λ i, Ico (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
-(measure_congr measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi
-
-@[simp] lemma volume_pi_Ico_to_real {a b : ι → ℝ} (h : a ≤ b) :
-  (volume (pi univ (λ i, Ico (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
-by simp only [volume_pi_Ico, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
-
-@[simp] lemma volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
-  volume (metric.ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
-begin
-  simp only [volume_pi_ball a hr, volume_ball, finset.prod_const],
-  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr.le) _).symm
-end
-
-@[simp] lemma volume_pi_closed_ball (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
-  volume (metric.closed_ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
-begin
-  simp only [volume_pi_closed_ball a hr, volume_closed_ball, finset.prod_const],
-  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr) _).symm
-end
-
-lemma volume_le_diam (s : set ℝ) : volume s ≤ emetric.diam s :=
-begin
-  by_cases hs : metric.bounded s,
-  { rw [real.ediam_eq hs, ← volume_Icc],
-    exact volume.mono (real.subset_Icc_Inf_Sup_of_bounded hs) },
-  { rw metric.ediam_of_unbounded hs, exact le_top }
-end
-
-lemma volume_pi_le_prod_diam (s : set (ι → ℝ)) :
-  volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :=
-calc volume s ≤ volume (pi univ (λ i, closure (function.eval i '' s))) :
-  volume.mono $ subset.trans (subset_pi_eval_image univ s) $ pi_mono $ λ i hi, subset_closure
-          ... = ∏ i, volume (closure $ function.eval i '' s) :
-  volume_pi_pi _
-          ... ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :
-  finset.prod_le_prod' $ λ i hi, (volume_le_diam _).trans_eq (emetric.diam_closure _)
-
-lemma volume_pi_le_diam_pow (s : set (ι → ℝ)) :
-  volume s ≤ emetric.diam s ^ fintype.card ι :=
-calc volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) : volume_pi_le_prod_diam s
-          ... ≤ ∏ i : ι, (1 : ℝ≥0) * emetric.diam s                      :
-  finset.prod_le_prod' $ λ i hi, (lipschitz_with.eval i).ediam_image_le s
-          ... = emetric.diam s ^ fintype.card ι              :
-  by simp only [ennreal.coe_one, one_mul, finset.prod_const, fintype.card]
-
-/-!
-### Images of the Lebesgue measure under translation/multiplication in ℝ
--/
-
-instance is_add_left_invariant_real_volume :
-  is_add_left_invariant (volume : measure ℝ) :=
-⟨λ a, eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
-  by simp [measure.map_apply (measurable_const_add a) measurable_set_Ioo, sub_sub_sub_cancel_right]⟩
-
-lemma smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
-  ennreal.of_real (|a|) • measure.map ((*) a) volume = volume :=
-begin
-  refine (real.measure_ext_Ioo_rat $ λ p q, _).symm,
-  cases lt_or_gt_of_ne h with h h,
-  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt $ neg_pos.2 h),
-      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, neg_sub_neg,
-      neg_mul, preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub, smul_eq_mul,
-      mul_div_cancel' _ (ne_of_lt h)] },
-  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt h),
-      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, preimage_const_mul_Ioo _ _ h,
-      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h), smul_eq_mul] }
-end
-
-lemma map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
-  measure.map ((*) a) volume = ennreal.of_real (|a⁻¹|) • volume :=
-by conv_rhs { rw [← real.smul_map_volume_mul_left h, smul_smul,
-  ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel h, abs_one, ennreal.of_real_one,
-  one_smul] }
-
-@[simp] lemma volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
-  volume (((*) a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
-calc volume (((*) a) ⁻¹' s) = measure.map ((*) a) volume s :
-  ((homeomorph.mul_left₀ a h).to_measurable_equiv.map_apply s).symm
-... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_left h, refl }
-
-lemma smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
-  ennreal.of_real (|a|) • measure.map (* a) volume = volume :=
-by simpa only [mul_comm] using real.smul_map_volume_mul_left h
-
-lemma map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
-  measure.map (* a) volume = ennreal.of_real (|a⁻¹|) • volume :=
-by simpa only [mul_comm] using real.map_volume_mul_left h
-
-@[simp] lemma volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
-  volume ((* a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
-calc volume ((* a) ⁻¹' s) = measure.map (* a) volume s :
-  ((homeomorph.mul_right₀ a h).to_measurable_equiv.map_apply s).symm
-... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_right h, refl }
-
-instance : is_neg_invariant (volume : measure ℝ) :=
-⟨eq.symm $ real.measure_ext_Ioo_rat $ λ p q, by simp [show volume.neg (Ioo (p : ℝ) q) = _,
-  from measure.map_apply measurable_neg measurable_set_Ioo]⟩
-
-/-!
-### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
--/
-
-open matrix
-
-/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
-`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
-uses this particular case). -/
-lemma smul_map_diagonal_volume_pi [decidable_eq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
-  ennreal.of_real (abs (det (diagonal D))) • measure.map ((diagonal D).to_lin') volume = volume :=
-begin
-  refine (measure.pi_eq (λ s hs, _)).symm,
-  simp only [det_diagonal, measure.coe_smul, algebra.id.smul_eq_mul, pi.smul_apply],
-  rw [measure.map_apply _ (measurable_set.univ_pi_fintype hs)],
-  swap, { exact continuous.measurable (linear_map.continuous_on_pi _) },
-  have : (matrix.to_lin' (diagonal D)) ⁻¹' (set.pi set.univ (λ (i : ι), s i))
-    = set.pi set.univ (λ (i : ι), ((*) (D i)) ⁻¹' (s i)),
-  { ext f,
-    simp only [linear_map.coe_proj, algebra.id.smul_eq_mul, linear_map.smul_apply, mem_univ_pi,
-      mem_preimage, linear_map.pi_apply, diagonal_to_lin'] },
-  have B : ∀ i, of_real (abs (D i)) * volume (has_mul.mul (D i) ⁻¹' s i) = volume (s i),
-  { assume i,
-    have A : D i ≠ 0,
-    { simp only [det_diagonal, ne.def] at h,
-      exact finset.prod_ne_zero_iff.1 h i (finset.mem_univ i) },
-    rw [volume_preimage_mul_left A, ← mul_assoc, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul,
-      mul_inv_cancel A, abs_one, ennreal.of_real_one, one_mul] },
-  rw [this, volume_pi_pi, finset.abs_prod,
-    ennreal.of_real_prod_of_nonneg (λ i hi, abs_nonneg (D i)), ← finset.prod_mul_distrib],
-  simp only [B]
-end
-
-/-- A transvection preserves Lebesgue measure. -/
-lemma volume_preserving_transvection_struct [decidable_eq ι] (t : transvection_struct ι ℝ) :
-  measure_preserving (t.to_matrix.to_lin') :=
-begin
-  /- We separate the coordinate along which there is a shearing from the other ones, and apply
-  Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
-  translation, and therefore preserves Lebesgue. -/
-  let p : ι → Prop := λ i, i ≠ t.i,
-  let α : Type* := {x // p x},
-  let β : Type* := {x // ¬ (p x)},
-  let g : (α → ℝ) → (β → ℝ) → (β → ℝ) := λ a b, (λ x, t.c * a ⟨t.j, t.hij.symm⟩) + b,
-  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) :=
-    λ p, (id p.1, g p.1 p.2),
-  let e : (ι → ℝ) ≃ᵐ (α → ℝ) × (β → ℝ) := measurable_equiv.pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p,
-  have : (t.to_matrix.to_lin' : (ι → ℝ) → (ι → ℝ)) = e.symm ∘ F ∘ e,
-  { cases t,
-    ext f k,
-    simp only [linear_equiv.map_smul, dite_eq_ite, linear_map.id_coe, p, ite_not,
-      algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
-      measurable_equiv.pi_equiv_pi_subtype_prod_symm_apply, id.def, transvection,
-      pi.add_apply, zero_mul, linear_map.smul_apply, function.comp_app,
-      measurable_equiv.pi_equiv_pi_subtype_prod_apply, matrix.transvection_struct.to_matrix_mk,
-      matrix.mul_vec, linear_equiv.map_add, ite_mul, e, matrix.to_lin'_apply,
-      pi.smul_apply, subtype.coe_mk, g, linear_map.add_apply, finset.sum_congr, matrix.to_lin'_one],
-    by_cases h : t_i = k,
-    { simp only [h, true_and, finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq,
-        one_apply, boole_mul, add_comm], },
-    { simp only [h, ne.symm h, add_zero, if_false, finset.sum_const_zero, false_and, mul_zero] } },
-  rw this,
-  have A : measure_preserving e,
-  { convert volume_preserving_pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p },
-  have B : measure_preserving F,
-  { have g_meas : measurable (function.uncurry g),
-    { have : measurable (λ (c : (α → ℝ)), c ⟨t.j, t.hij.symm⟩) :=
-        measurable_pi_apply ⟨t.j, t.hij.symm⟩,
-      refine (measurable_pi_lambda _ (λ i, measurable.const_mul _ _)).add measurable_snd,
-      exact this.comp measurable_fst },
-    exact (measure_preserving.id _).skew_product g_meas
-      (eventually_of_forall (λ a, map_add_left_eq_self _ _)) },
-  exact ((A.symm e).comp B).comp A,
-end
-
-/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
-determinant. -/
-lemma map_matrix_volume_pi_eq_smul_volume_pi [decidable_eq ι] {M : matrix ι ι ℝ} (hM : det M ≠ 0) :
-  measure.map M.to_lin' volume = ennreal.of_real (abs (det M)⁻¹) • volume :=
-begin
-  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
-  -- as these matrices generate all invertible matrices.
-  apply diagonal_transvection_induction_of_det_ne_zero _ M hM (λ D hD, _) (λ t, _)
-    (λ A B hA hB IHA IHB, _),
-  { conv_rhs { rw [← smul_map_diagonal_volume_pi hD] },
-    rw [smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
-      ennreal.of_real_one, one_smul] },
-  { simp only [matrix.transvection_struct.det, ennreal.of_real_one,
-      (volume_preserving_transvection_struct _).map_eq, one_smul, _root_.inv_one, abs_one] },
-  { rw [to_lin'_mul, det_mul, linear_map.coe_comp, ← measure.map_map, IHB, measure.map_smul,
-      IHA, smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv₀],
-    { apply continuous.measurable,
-      apply linear_map.continuous_on_pi },
-    { apply continuous.measurable,
-      apply linear_map.continuous_on_pi } }
-end
-
-/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
-determinant. -/
-lemma map_linear_map_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0) :
-  measure.map f volume = ennreal.of_real (abs (f.det)⁻¹) • volume :=
-begin
-  -- this is deduced from the matrix case
-  classical,
-  let M := f.to_matrix',
-  have A : f.det = det M, by simp only [linear_map.det_to_matrix'],
-  have B : f = M.to_lin', by simp only [to_lin'_to_matrix'],
-  rw [A, B],
-  apply map_matrix_volume_pi_eq_smul_volume_pi,
-  rwa A at hf
-end
-
-end real
-
-open_locale topological_space
-
-lemma filter.eventually.volume_pos_of_nhds_real {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
-  (0 : ℝ≥0∞) < volume {x | p x} :=
-begin
-  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩,
-  refine lt_of_lt_of_le _ (measure_mono hs),
-  simpa [-mem_Ioo] using hx.1.trans hx.2
-end
-
-section region_between
-
-open_locale classical
-
-variable {α : Type*}
-
-/-- The region between two real-valued functions on an arbitrary set. -/
-def region_between (f g : α → ℝ) (s : set α) : set (α × ℝ) :=
-{p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1)}
-
-lemma region_between_subset (f g : α → ℝ) (s : set α) :
-  region_between f g s ⊆ s ×ˢ (univ : set ℝ) :=
-by simpa only [prod_univ, region_between, set.preimage, set_of_subset_set_of] using λ a, and.left
-
-variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}
-
-/-- The region between two measurable functions on a measurable set is measurable. -/
-lemma measurable_set_region_between
-  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
-  measurable_set (region_between f g s) :=
-begin
-  dsimp only [region_between, Ioo, mem_set_of_eq, set_of_and],
-  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
-    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
-  exact measurable_fst hs
-end
-
-theorem volume_region_between_eq_lintegral'
-  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
-  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
-begin
-  rw measure.prod_apply,
-  { have h : (λ x, volume {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)})
-            = s.indicator (λ x, ennreal.of_real (g x - f x)),
-    { funext x,
-      rw indicator_apply,
-      split_ifs,
-      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = Ioo (f x) (g x) := by simp [h, Ioo],
-        simp only [hx, real.volume_Ioo, sub_zero] },
-      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = ∅ := by simp [h],
-        simp only [hx, measure_empty] } },
-    dsimp only [region_between, preimage_set_of_eq],
-    rw [h, lintegral_indicator];
-    simp only [hs, pi.sub_apply] },
-  { exact measurable_set_region_between hf hg hs },
-end
-
-/-- The volume of the region between two almost everywhere measurable functions on a measurable set
-    can be represented as a Lebesgue integral. -/
-theorem volume_region_between_eq_lintegral [sigma_finite μ]
-  (hf : ae_measurable f (μ.restrict s)) (hg : ae_measurable g (μ.restrict s))
-  (hs : measurable_set s) :
-  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
-begin
-  have h₁ : (λ y, ennreal.of_real ((g - f) y))
-          =ᵐ[μ.restrict s]
-              λ y, ennreal.of_real ((ae_measurable.mk g hg - ae_measurable.mk f hf) y) :=
-    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _,
-  have h₂ : (μ.restrict s).prod volume (region_between f g s) =
-    (μ.restrict s).prod volume (region_between (ae_measurable.mk f hf) (ae_measurable.mk g hg) s),
-  { apply measure_congr,
-    apply eventually_eq.rfl.inter,
-    exact
-      ((ae_eq_comp' measurable_fst.ae_measurable
-        hf.ae_eq_mk measure.prod_fst_absolutely_continuous).comp₂ _ eventually_eq.rfl).inter
-      (eventually_eq.rfl.comp₂ _ (ae_eq_comp' measurable_fst.ae_measurable
-        hg.ae_eq_mk measure.prod_fst_absolutely_continuous)) },
-  rw [lintegral_congr_ae h₁,
-      ← volume_region_between_eq_lintegral' hf.measurable_mk hg.measurable_mk hs],
-  convert h₂ using 1,
-  { rw measure.restrict_prod_eq_prod_univ,
-    exact (measure.restrict_eq_self _ (region_between_subset f g s)).symm, },
-  { rw measure.restrict_prod_eq_prod_univ,
-    exact (measure.restrict_eq_self _
-      (region_between_subset (ae_measurable.mk f hf) (ae_measurable.mk g hg) s)).symm },
-end
-
-theorem volume_region_between_eq_integral' [sigma_finite μ]
-  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
-  (hs : measurable_set s) (hfg : f ≤ᵐ[μ.restrict s] g ) :
-  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
-begin
-  have h : g - f =ᵐ[μ.restrict s] (λ x, real.to_nnreal (g x - f x)),
-    from hfg.mono (λ x hx, (real.coe_to_nnreal _ $ sub_nonneg.2 hx).symm),
-  rw [volume_region_between_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
-    integral_congr_ae h, lintegral_congr_ae,
-    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))],
-  simpa only,
-end
-
-/-- If two functions are integrable on a measurable set, and one function is less than
-    or equal to the other on that set, then the volume of the region
-    between the two functions can be represented as an integral. -/
-theorem volume_region_between_eq_integral [sigma_finite μ]
-  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
-  (hs : measurable_set s) (hfg : ∀ x ∈ s, f x ≤ g x) :
-  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
-volume_region_between_eq_integral' f_int g_int hs
-  ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))
-
-end region_between
diff --git a/src/measure_theory/measure/lebesgue/basic.lean b/src/measure_theory/measure/lebesgue/basic.lean
new file mode 100644
index 0000000000000..ba416fc42a780
--- /dev/null
+++ b/src/measure_theory/measure/lebesgue/basic.lean
@@ -0,0 +1,585 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Sébastien Gouëzel, Yury Kudryashov
+-/
+import dynamics.ergodic.measure_preserving
+import linear_algebra.determinant
+import linear_algebra.matrix.diagonal
+import linear_algebra.matrix.transvection
+import measure_theory.constructions.pi
+import measure_theory.measure.stieltjes
+import measure_theory.measure.haar.of_basis
+
+/-!
+# Lebesgue measure on the real line and on `ℝⁿ`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We show that the Lebesgue measure on the real line (constructed as a particular case of additive
+Haar measure on inner product spaces) coincides with the Stieltjes measure associated
+to the function `x ↦ x`. We deduce properties of this measure on `ℝ`, and then of the product
+Lebesgue measure on `ℝⁿ`. In particular, we prove that they are translation invariant.
+
+We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
+value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.
+
+More properties of the Lebesgue measure are deduced from this in `lebesgue.eq_haar.lean`, where they
+are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
+-/
+
+assert_not_exists measure_theory.integral
+
+noncomputable theory
+open classical set filter measure_theory measure_theory.measure topological_space
+open ennreal (of_real)
+open_locale big_operators ennreal nnreal topology
+
+/-!
+### Definition of the Lebesgue measure and lengths of intervals
+-/
+
+namespace real
+
+variables {ι : Type*} [fintype ι]
+
+/-- The volume on the real line (as a particular case of the volume on a finite-dimensional
+inner product space) coincides with the Stieltjes measure coming from the identity function. -/
+lemma volume_eq_stieltjes_id : (volume : measure ℝ) = stieltjes_function.id.measure :=
+begin
+  haveI : is_add_left_invariant stieltjes_function.id.measure :=
+  ⟨λ a, eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
+    by simp only [measure.map_apply (measurable_const_add a) measurable_set_Ioo,
+      sub_sub_sub_cancel_right, stieltjes_function.measure_Ioo, stieltjes_function.id_left_lim,
+      stieltjes_function.id_apply, id.def, preimage_const_add_Ioo]⟩,
+  have A : stieltjes_function.id.measure (std_orthonormal_basis ℝ ℝ).to_basis.parallelepiped = 1,
+  { change stieltjes_function.id.measure (parallelepiped (std_orthonormal_basis ℝ ℝ)) = 1,
+    rcases parallelepiped_orthonormal_basis_one_dim (std_orthonormal_basis ℝ ℝ) with H|H;
+    simp only [H, stieltjes_function.measure_Icc, stieltjes_function.id_apply, id.def, tsub_zero,
+      stieltjes_function.id_left_lim, sub_neg_eq_add, zero_add, ennreal.of_real_one] },
+  conv_rhs { rw [add_haar_measure_unique stieltjes_function.id.measure
+    (std_orthonormal_basis ℝ ℝ).to_basis.parallelepiped, A] },
+  simp only [volume, basis.add_haar, one_smul],
+end
+
+theorem volume_val (s) : volume s = stieltjes_function.id.measure s :=
+by simp [volume_eq_stieltjes_id]
+
+@[simp] lemma volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) :=
+by simp [volume_val]
+
+@[simp] lemma volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) :=
+by simp [volume_val]
+
+@[simp] lemma volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) :=
+by simp [volume_val]
+
+@[simp] lemma volume_Ioc {a b : ℝ} : volume (Ioc a b) = of_real (b - a) :=
+by simp [volume_val]
+
+@[simp] lemma volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 :=
+by simp [volume_val]
+
+@[simp] lemma volume_univ : volume (univ : set ℝ) = ∞ :=
+ennreal.eq_top_of_forall_nnreal_le $ λ r,
+  calc (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) : by simp
+              ... ≤ volume univ            : measure_mono (subset_univ _)
+
+@[simp] lemma volume_ball (a r : ℝ) :
+  volume (metric.ball a r) = of_real (2 * r) :=
+by rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]
+
+@[simp] lemma volume_closed_ball (a r : ℝ) :
+  volume (metric.closed_ball a r) = of_real (2 * r) :=
+by rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]
+
+@[simp] lemma volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) :
+  volume (emetric.ball a r) = 2 * r :=
+begin
+  rcases eq_or_ne r ∞ with rfl|hr,
+  { rw [metric.emetric_ball_top, volume_univ, two_mul, _root_.top_add] },
+  { lift r to ℝ≥0 using hr,
+    rw [metric.emetric_ball_nnreal, volume_ball, two_mul, ← nnreal.coe_add,
+      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
+end
+
+@[simp] lemma volume_emetric_closed_ball (a : ℝ) (r : ℝ≥0∞) :
+  volume (emetric.closed_ball a r) = 2 * r :=
+begin
+  rcases eq_or_ne r ∞ with rfl|hr,
+  { rw [emetric.closed_ball_top, volume_univ, two_mul, _root_.top_add] },
+  { lift r to ℝ≥0 using hr,
+    rw [metric.emetric_closed_ball_nnreal, volume_closed_ball, two_mul, ← nnreal.coe_add,
+      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
+end
+
+instance has_no_atoms_volume : has_no_atoms (volume : measure ℝ) :=
+⟨λ x, volume_singleton⟩
+
+@[simp] lemma volume_interval {a b : ℝ} : volume (uIcc a b) = of_real (|b - a|) :=
+by rw [←Icc_min_max, volume_Icc, max_sub_min_eq_abs]
+
+@[simp] lemma volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
+top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
+calc (n : ℝ≥0∞) = volume (Ioo a (a + n)) : by simp
+... ≤ volume (Ioi a) : measure_mono Ioo_subset_Ioi_self
+
+@[simp] lemma volume_Ici {a : ℝ} : volume (Ici a) = ∞ :=
+by simp [← measure_congr Ioi_ae_eq_Ici]
+
+@[simp] lemma volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
+top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
+calc (n : ℝ≥0∞) = volume (Ioo (a - n) a) : by simp
+... ≤ volume (Iio a) : measure_mono Ioo_subset_Iio_self
+
+@[simp] lemma volume_Iic {a : ℝ} : volume (Iic a) = ∞ :=
+by simp [← measure_congr Iio_ae_eq_Iic]
+
+instance locally_finite_volume : is_locally_finite_measure (volume : measure ℝ) :=
+⟨λ x, ⟨Ioo (x - 1) (x + 1),
+  is_open.mem_nhds is_open_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩,
+  by simp only [real.volume_Ioo, ennreal.of_real_lt_top]⟩⟩
+
+instance is_finite_measure_restrict_Icc (x y : ℝ) : is_finite_measure (volume.restrict (Icc x y)) :=
+⟨by simp⟩
+
+instance is_finite_measure_restrict_Ico (x y : ℝ) : is_finite_measure (volume.restrict (Ico x y)) :=
+⟨by simp⟩
+
+instance is_finite_measure_restrict_Ioc (x y : ℝ) : is_finite_measure (volume.restrict (Ioc x y)) :=
+ ⟨by simp⟩
+
+instance is_finite_measure_restrict_Ioo (x y : ℝ) : is_finite_measure (volume.restrict (Ioo x y)) :=
+⟨by simp⟩
+
+lemma volume_le_diam (s : set ℝ) : volume s ≤ emetric.diam s :=
+begin
+  by_cases hs : metric.bounded s,
+  { rw [real.ediam_eq hs, ← volume_Icc],
+    exact volume.mono (real.subset_Icc_Inf_Sup_of_bounded hs) },
+  { rw metric.ediam_of_unbounded hs, exact le_top }
+end
+
+lemma _root_.filter.eventually.volume_pos_of_nhds_real
+  {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
+  (0 : ℝ≥0∞) < volume {x | p x} :=
+begin
+  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩,
+  refine lt_of_lt_of_le _ (measure_mono hs),
+  simpa [-mem_Ioo] using hx.1.trans hx.2
+end
+
+/-!
+### Volume of a box in `ℝⁿ`
+-/
+
+lemma volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ennreal.of_real (b i - a i) :=
+begin
+  rw [← pi_univ_Icc, volume_pi_pi],
+  simp only [real.volume_Icc]
+end
+
+@[simp] lemma volume_Icc_pi_to_real {a b : ι → ℝ} (h : a ≤ b) :
+  (volume (Icc a b)).to_real = ∏ i, (b i - a i) :=
+by simp only [volume_Icc_pi, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
+
+lemma volume_pi_Ioo {a b : ι → ℝ} :
+  volume (pi univ (λ i, Ioo (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
+(measure_congr measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi
+
+@[simp] lemma volume_pi_Ioo_to_real {a b : ι → ℝ} (h : a ≤ b) :
+  (volume (pi univ (λ i, Ioo (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
+by simp only [volume_pi_Ioo, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
+
+lemma volume_pi_Ioc {a b : ι → ℝ} :
+  volume (pi univ (λ i, Ioc (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
+(measure_congr measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi
+
+@[simp] lemma volume_pi_Ioc_to_real {a b : ι → ℝ} (h : a ≤ b) :
+  (volume (pi univ (λ i, Ioc (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
+by simp only [volume_pi_Ioc, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
+
+lemma volume_pi_Ico {a b : ι → ℝ} :
+  volume (pi univ (λ i, Ico (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
+(measure_congr measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi
+
+@[simp] lemma volume_pi_Ico_to_real {a b : ι → ℝ} (h : a ≤ b) :
+  (volume (pi univ (λ i, Ico (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
+by simp only [volume_pi_Ico, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]
+
+@[simp] lemma volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
+  volume (metric.ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
+begin
+  simp only [volume_pi_ball a hr, volume_ball, finset.prod_const],
+  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr.le) _).symm
+end
+
+@[simp] lemma volume_pi_closed_ball (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
+  volume (metric.closed_ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
+begin
+  simp only [volume_pi_closed_ball a hr, volume_closed_ball, finset.prod_const],
+  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr) _).symm
+end
+
+lemma volume_pi_le_prod_diam (s : set (ι → ℝ)) :
+  volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :=
+calc volume s ≤ volume (pi univ (λ i, closure (function.eval i '' s))) :
+  volume.mono $ subset.trans (subset_pi_eval_image univ s) $ pi_mono $ λ i hi, subset_closure
+          ... = ∏ i, volume (closure $ function.eval i '' s) :
+  volume_pi_pi _
+          ... ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :
+  finset.prod_le_prod' $ λ i hi, (volume_le_diam _).trans_eq (emetric.diam_closure _)
+
+lemma volume_pi_le_diam_pow (s : set (ι → ℝ)) :
+  volume s ≤ emetric.diam s ^ fintype.card ι :=
+calc volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) : volume_pi_le_prod_diam s
+          ... ≤ ∏ i : ι, (1 : ℝ≥0) * emetric.diam s                      :
+  finset.prod_le_prod' $ λ i hi, (lipschitz_with.eval i).ediam_image_le s
+          ... = emetric.diam s ^ fintype.card ι              :
+  by simp only [ennreal.coe_one, one_mul, finset.prod_const, fintype.card]
+
+/-!
+### Images of the Lebesgue measure under multiplication in ℝ
+-/
+
+lemma smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
+  ennreal.of_real (|a|) • measure.map ((*) a) volume = volume :=
+begin
+  refine (real.measure_ext_Ioo_rat $ λ p q, _).symm,
+  cases lt_or_gt_of_ne h with h h,
+  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt $ neg_pos.2 h),
+      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, neg_sub_neg,
+      neg_mul, preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub, smul_eq_mul,
+      mul_div_cancel' _ (ne_of_lt h)] },
+  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt h),
+      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, preimage_const_mul_Ioo _ _ h,
+      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h), smul_eq_mul] }
+end
+
+lemma map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
+  measure.map ((*) a) volume = ennreal.of_real (|a⁻¹|) • volume :=
+by conv_rhs { rw [← real.smul_map_volume_mul_left h, smul_smul,
+  ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel h, abs_one, ennreal.of_real_one,
+  one_smul] }
+
+@[simp] lemma volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
+  volume (((*) a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
+calc volume (((*) a) ⁻¹' s) = measure.map ((*) a) volume s :
+  ((homeomorph.mul_left₀ a h).to_measurable_equiv.map_apply s).symm
+... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_left h, refl }
+
+lemma smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
+  ennreal.of_real (|a|) • measure.map (* a) volume = volume :=
+by simpa only [mul_comm] using real.smul_map_volume_mul_left h
+
+lemma map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
+  measure.map (* a) volume = ennreal.of_real (|a⁻¹|) • volume :=
+by simpa only [mul_comm] using real.map_volume_mul_left h
+
+@[simp] lemma volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
+  volume ((* a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
+calc volume ((* a) ⁻¹' s) = measure.map (* a) volume s :
+  ((homeomorph.mul_right₀ a h).to_measurable_equiv.map_apply s).symm
+... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_right h, refl }
+
+/-!
+### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
+-/
+
+open matrix
+
+/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
+`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
+uses this particular case). -/
+lemma smul_map_diagonal_volume_pi [decidable_eq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
+  ennreal.of_real (abs (det (diagonal D))) • measure.map ((diagonal D).to_lin') volume = volume :=
+begin
+  refine (measure.pi_eq (λ s hs, _)).symm,
+  simp only [det_diagonal, measure.coe_smul, algebra.id.smul_eq_mul, pi.smul_apply],
+  rw [measure.map_apply _ (measurable_set.univ_pi hs)],
+  swap, { exact continuous.measurable (linear_map.continuous_on_pi _) },
+  have : (matrix.to_lin' (diagonal D)) ⁻¹' (set.pi set.univ (λ (i : ι), s i))
+    = set.pi set.univ (λ (i : ι), ((*) (D i)) ⁻¹' (s i)),
+  { ext f,
+    simp only [linear_map.coe_proj, algebra.id.smul_eq_mul, linear_map.smul_apply, mem_univ_pi,
+      mem_preimage, linear_map.pi_apply, diagonal_to_lin'] },
+  have B : ∀ i, of_real (abs (D i)) * volume (has_mul.mul (D i) ⁻¹' s i) = volume (s i),
+  { assume i,
+    have A : D i ≠ 0,
+    { simp only [det_diagonal, ne.def] at h,
+      exact finset.prod_ne_zero_iff.1 h i (finset.mem_univ i) },
+    rw [volume_preimage_mul_left A, ← mul_assoc, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul,
+      mul_inv_cancel A, abs_one, ennreal.of_real_one, one_mul] },
+  rw [this, volume_pi_pi, finset.abs_prod,
+    ennreal.of_real_prod_of_nonneg (λ i hi, abs_nonneg (D i)), ← finset.prod_mul_distrib],
+  simp only [B]
+end
+
+/-- A transvection preserves Lebesgue measure. -/
+lemma volume_preserving_transvection_struct [decidable_eq ι] (t : transvection_struct ι ℝ) :
+  measure_preserving (t.to_matrix.to_lin') :=
+begin
+  /- We separate the coordinate along which there is a shearing from the other ones, and apply
+  Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
+  translation, and therefore preserves Lebesgue. -/
+  let p : ι → Prop := λ i, i ≠ t.i,
+  let α : Type* := {x // p x},
+  let β : Type* := {x // ¬ (p x)},
+  let g : (α → ℝ) → (β → ℝ) → (β → ℝ) := λ a b, (λ x, t.c * a ⟨t.j, t.hij.symm⟩) + b,
+  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) :=
+    λ p, (id p.1, g p.1 p.2),
+  let e : (ι → ℝ) ≃ᵐ (α → ℝ) × (β → ℝ) := measurable_equiv.pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p,
+  have : (t.to_matrix.to_lin' : (ι → ℝ) → (ι → ℝ)) = e.symm ∘ F ∘ e,
+  { cases t,
+    ext f k,
+    simp only [linear_equiv.map_smul, dite_eq_ite, linear_map.id_coe, p, ite_not,
+      algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
+      measurable_equiv.pi_equiv_pi_subtype_prod_symm_apply, id.def, transvection,
+      pi.add_apply, zero_mul, linear_map.smul_apply, function.comp_app,
+      measurable_equiv.pi_equiv_pi_subtype_prod_apply, matrix.transvection_struct.to_matrix_mk,
+      matrix.mul_vec, linear_equiv.map_add, ite_mul, e, matrix.to_lin'_apply,
+      pi.smul_apply, subtype.coe_mk, g, linear_map.add_apply, finset.sum_congr, matrix.to_lin'_one],
+    by_cases h : t_i = k,
+    { simp only [h, true_and, finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq,
+        one_apply, boole_mul, add_comm], },
+    { simp only [h, ne.symm h, add_zero, if_false, finset.sum_const_zero, false_and, mul_zero] } },
+  rw this,
+  have A : measure_preserving e,
+  { convert volume_preserving_pi_equiv_pi_subtype_prod (λ i : ι, ℝ) p },
+  have B : measure_preserving F,
+  { have g_meas : measurable (function.uncurry g),
+    { have : measurable (λ (c : (α → ℝ)), c ⟨t.j, t.hij.symm⟩) :=
+        measurable_pi_apply ⟨t.j, t.hij.symm⟩,
+      refine (measurable_pi_lambda _ (λ i, measurable.const_mul _ _)).add measurable_snd,
+      exact this.comp measurable_fst },
+    exact (measure_preserving.id _).skew_product g_meas
+      (eventually_of_forall (λ a, map_add_left_eq_self _ _)) },
+  exact ((A.symm e).comp B).comp A,
+end
+
+/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
+determinant. -/
+lemma map_matrix_volume_pi_eq_smul_volume_pi [decidable_eq ι] {M : matrix ι ι ℝ} (hM : det M ≠ 0) :
+  measure.map M.to_lin' volume = ennreal.of_real (abs (det M)⁻¹) • volume :=
+begin
+  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
+  -- as these matrices generate all invertible matrices.
+  apply diagonal_transvection_induction_of_det_ne_zero _ M hM (λ D hD, _) (λ t, _)
+    (λ A B hA hB IHA IHB, _),
+  { conv_rhs { rw [← smul_map_diagonal_volume_pi hD] },
+    rw [smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
+      ennreal.of_real_one, one_smul] },
+  { simp only [matrix.transvection_struct.det, ennreal.of_real_one,
+      (volume_preserving_transvection_struct _).map_eq, one_smul, _root_.inv_one, abs_one] },
+  { rw [to_lin'_mul, det_mul, linear_map.coe_comp, ← measure.map_map, IHB, measure.map_smul,
+      IHA, smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv],
+    { apply continuous.measurable,
+      apply linear_map.continuous_on_pi },
+    { apply continuous.measurable,
+      apply linear_map.continuous_on_pi } }
+end
+
+/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
+determinant. -/
+lemma map_linear_map_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0) :
+  measure.map f volume = ennreal.of_real (abs (f.det)⁻¹) • volume :=
+begin
+  -- this is deduced from the matrix case
+  classical,
+  let M := f.to_matrix',
+  have A : f.det = det M, by simp only [linear_map.det_to_matrix'],
+  have B : f = M.to_lin', by simp only [to_lin'_to_matrix'],
+  rw [A, B],
+  apply map_matrix_volume_pi_eq_smul_volume_pi,
+  rwa A at hf
+end
+
+end real
+
+section region_between
+
+variable {α : Type*}
+
+/-- The region between two real-valued functions on an arbitrary set. -/
+def region_between (f g : α → ℝ) (s : set α) : set (α × ℝ) :=
+{p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1)}
+
+lemma region_between_subset (f g : α → ℝ) (s : set α) : region_between f g s ⊆ s ×ˢ univ :=
+by simpa only [prod_univ, region_between, set.preimage, set_of_subset_set_of] using λ a, and.left
+
+variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}
+
+/-- The region between two measurable functions on a measurable set is measurable. -/
+lemma measurable_set_region_between
+  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
+  measurable_set (region_between f g s) :=
+begin
+  dsimp only [region_between, Ioo, mem_set_of_eq, set_of_and],
+  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
+    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
+  exact measurable_fst hs
+end
+
+/-- The region between two measurable functions on a measurable set is measurable;
+a version for the region together with the graph of the upper function. -/
+lemma measurable_set_region_between_oc
+  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
+  measurable_set {p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Ioc (f p.fst) (g p.fst)} :=
+begin
+  dsimp only [region_between, Ioc, mem_set_of_eq, set_of_and],
+  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
+    (measurable_set_le measurable_snd (hg.comp measurable_fst))),
+  exact measurable_fst hs,
+end
+
+/-- The region between two measurable functions on a measurable set is measurable;
+a version for the region together with the graph of the lower function. -/
+lemma measurable_set_region_between_co
+  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
+  measurable_set {p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Ico (f p.fst) (g p.fst)} :=
+begin
+  dsimp only [region_between, Ico, mem_set_of_eq, set_of_and],
+  refine measurable_set.inter _ ((measurable_set_le (hf.comp measurable_fst) measurable_snd).inter
+    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
+  exact measurable_fst hs,
+end
+
+/-- The region between two measurable functions on a measurable set is measurable;
+a version for the region together with the graphs of both functions. -/
+lemma measurable_set_region_between_cc
+  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
+  measurable_set {p : α × ℝ | p.fst ∈ s ∧ p.snd ∈ Icc (f p.fst) (g p.fst)} :=
+begin
+  dsimp only [region_between, Icc, mem_set_of_eq, set_of_and],
+  refine measurable_set.inter _ ((measurable_set_le (hf.comp measurable_fst) measurable_snd).inter
+    (measurable_set_le measurable_snd (hg.comp measurable_fst))),
+  exact measurable_fst hs,
+end
+
+/-- The graph of a measurable function is a measurable set. -/
+lemma measurable_set_graph (hf : measurable f) :
+  measurable_set {p : α × ℝ | p.snd = f p.fst} :=
+by simpa using measurable_set_region_between_cc hf hf measurable_set.univ
+
+theorem volume_region_between_eq_lintegral'
+  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
+  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
+begin
+  classical,
+  rw measure.prod_apply,
+  { have h : (λ x, volume {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)})
+            = s.indicator (λ x, ennreal.of_real (g x - f x)),
+    { funext x,
+      rw indicator_apply,
+      split_ifs,
+      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = Ioo (f x) (g x) := by simp [h, Ioo],
+        simp only [hx, real.volume_Ioo, sub_zero] },
+      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = ∅ := by simp [h],
+        simp only [hx, measure_empty] } },
+    dsimp only [region_between, preimage_set_of_eq],
+    rw [h, lintegral_indicator];
+    simp only [hs, pi.sub_apply] },
+  { exact measurable_set_region_between hf hg hs },
+end
+
+/-- The volume of the region between two almost everywhere measurable functions on a measurable set
+    can be represented as a Lebesgue integral. -/
+theorem volume_region_between_eq_lintegral [sigma_finite μ]
+  (hf : ae_measurable f (μ.restrict s)) (hg : ae_measurable g (μ.restrict s))
+  (hs : measurable_set s) :
+  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
+begin
+  have h₁ : (λ y, ennreal.of_real ((g - f) y))
+          =ᵐ[μ.restrict s]
+              λ y, ennreal.of_real ((ae_measurable.mk g hg - ae_measurable.mk f hf) y) :=
+    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _,
+  have h₂ : (μ.restrict s).prod volume (region_between f g s) =
+    (μ.restrict s).prod volume (region_between (ae_measurable.mk f hf) (ae_measurable.mk g hg) s),
+  { apply measure_congr,
+    apply eventually_eq.rfl.inter,
+    exact ((quasi_measure_preserving_fst.ae_eq_comp hf.ae_eq_mk).comp₂ _ eventually_eq.rfl).inter
+      (eventually_eq.rfl.comp₂ _ $ quasi_measure_preserving_fst.ae_eq_comp hg.ae_eq_mk) },
+  rw [lintegral_congr_ae h₁,
+      ← volume_region_between_eq_lintegral' hf.measurable_mk hg.measurable_mk hs],
+  convert h₂ using 1,
+  { rw measure.restrict_prod_eq_prod_univ,
+    exact (measure.restrict_eq_self _ (region_between_subset f g s)).symm, },
+  { rw measure.restrict_prod_eq_prod_univ,
+    exact (measure.restrict_eq_self _
+      (region_between_subset (ae_measurable.mk f hf) (ae_measurable.mk g hg) s)).symm },
+end
+
+end region_between
+
+/-- Consider a real set `s`. If a property is true almost everywhere in `s ∩ (a, b)` for
+all `a, b ∈ s`, then it is true almost everywhere in `s`. Formulated with `μ.restrict`.
+See also `ae_of_mem_of_ae_of_mem_inter_Ioo`. -/
+lemma ae_restrict_of_ae_restrict_inter_Ioo
+  {μ : measure ℝ} [has_no_atoms μ] {s : set ℝ} {p : ℝ → Prop}
+  (h : ∀ a b, a ∈ s → b ∈ s → a < b → ∀ᵐ x ∂(μ.restrict (s ∩ Ioo a b)), p x) :
+  ∀ᵐ x ∂(μ.restrict s), p x :=
+begin
+  /- By second-countability, we cover `s` by countably many intervals `(a, b)` (except maybe for
+  two endpoints, which don't matter since `μ` does not have any atom). -/
+  let T : s × s → set ℝ := λ p, Ioo p.1 p.2,
+  let u := ⋃ (i : ↥s × ↥s), T i,
+  have hfinite : (s \ u).finite := s.finite_diff_Union_Ioo',
+  obtain ⟨A, A_count, hA⟩ :
+    ∃ (A : set (↥s × ↥s)), A.countable ∧ (⋃ (i ∈ A), T i) = ⋃ (i : ↥s × ↥s), T i :=
+    is_open_Union_countable _ (λ p, is_open_Ioo),
+  have : s ⊆ (s \ u) ∪ (⋃ p ∈ A, s ∩ T p),
+  { assume x hx,
+    by_cases h'x : x ∈ ⋃ (i : ↥s × ↥s), T i,
+    { rw ← hA at h'x,
+      obtain ⟨p, pA, xp⟩ : ∃ (p : ↥s × ↥s), p ∈ A ∧ x ∈ T p,
+        by simpa only [mem_Union, exists_prop, set_coe.exists, exists_and_distrib_right] using h'x,
+      right,
+      exact mem_bUnion pA ⟨hx, xp⟩ },
+    { exact or.inl ⟨hx, h'x⟩ } },
+  apply ae_restrict_of_ae_restrict_of_subset this,
+  rw [ae_restrict_union_iff, ae_restrict_bUnion_iff _ A_count],
+  split,
+  { have : μ.restrict (s \ u) = 0, by simp only [restrict_eq_zero, hfinite.measure_zero],
+    simp only [this, ae_zero] },
+  { rintros ⟨⟨a, as⟩, ⟨b, bs⟩⟩ -,
+    dsimp [T],
+    rcases le_or_lt b a with hba|hab,
+    { simp only [Ioo_eq_empty_of_le hba, inter_empty, restrict_empty, ae_zero] },
+    { exact h a b as bs hab } }
+end
+
+/-- Consider a real set `s`. If a property is true almost everywhere in `s ∩ (a, b)` for
+all `a, b ∈ s`, then it is true almost everywhere in `s`. Formulated with bare membership.
+See also `ae_restrict_of_ae_restrict_inter_Ioo`. -/
+lemma ae_of_mem_of_ae_of_mem_inter_Ioo
+  {μ : measure ℝ} [has_no_atoms μ] {s : set ℝ} {p : ℝ → Prop}
+  (h : ∀ a b, a ∈ s → b ∈ s → a < b → ∀ᵐ x ∂μ, x ∈ s ∩ Ioo a b → p x) :
+  ∀ᵐ x ∂μ, x ∈ s → p x :=
+begin
+  /- By second-countability, we cover `s` by countably many intervals `(a, b)` (except maybe for
+  two endpoints, which don't matter since `μ` does not have any atom). -/
+  let T : s × s → set ℝ := λ p, Ioo p.1 p.2,
+  let u := ⋃ (i : ↥s × ↥s), T i,
+  have hfinite : (s \ u).finite := s.finite_diff_Union_Ioo',
+  obtain ⟨A, A_count, hA⟩ :
+    ∃ (A : set (↥s × ↥s)), A.countable ∧ (⋃ (i ∈ A), T i) = ⋃ (i : ↥s × ↥s), T i :=
+    is_open_Union_countable _ (λ p, is_open_Ioo),
+  have M : ∀ᵐ x ∂μ, x ∉ s \ u, from hfinite.countable.ae_not_mem _,
+  have M' : ∀ᵐ x ∂μ, ∀ (i : ↥s × ↥s) (H : i ∈ A), x ∈ s ∩ T i → p x,
+  { rw ae_ball_iff A_count,
+    rintros ⟨⟨a, as⟩, ⟨b, bs⟩⟩ -,
+    change ∀ᵐ (x : ℝ) ∂μ, x ∈ s ∩ Ioo a b → p x,
+    rcases le_or_lt b a with hba|hab,
+    { simp only [Ioo_eq_empty_of_le hba, inter_empty, is_empty.forall_iff, eventually_true,
+        mem_empty_iff_false], },
+    { exact h a b as bs hab } },
+  filter_upwards [M, M'] with x hx h'x,
+  assume xs,
+  by_cases Hx : x ∈ ⋃ (i : ↥s × ↥s), T i,
+  { rw ← hA at Hx,
+    obtain ⟨p, pA, xp⟩ : ∃ (p : ↥s × ↥s), p ∈ A ∧ x ∈ T p,
+      by simpa only [mem_Union, exists_prop, set_coe.exists, exists_and_distrib_right] using Hx,
+    apply h'x p pA ⟨xs, xp⟩ },
+  { exact false.elim (hx ⟨xs, Hx⟩) }
+end
diff --git a/src/measure_theory/measure/lebesgue/complex.lean b/src/measure_theory/measure/lebesgue/complex.lean
new file mode 100644
index 0000000000000..bc7a45288ab0a
--- /dev/null
+++ b/src/measure_theory/measure/lebesgue/complex.lean
@@ -0,0 +1,47 @@
+/-
+Copyright (c) 2021 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import measure_theory.constructions.borel_space.complex
+import measure_theory.measure.lebesgue.basic
+import measure_theory.measure.haar.of_basis
+
+/-!
+# Lebesgue measure on `ℂ`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define Lebesgue measure on `ℂ`. Since `ℂ` is defined as a `structure` as the
+push-forward of the volume on `ℝ²` under the natural isomorphism. There are (at least) two
+frequently used ways to represent `ℝ²` in `mathlib`: `ℝ × ℝ` and `fin 2 → ℝ`. We define measurable
+equivalences (`measurable_equiv`) to both types and prove that both of them are volume preserving
+(in the sense of `measure_theory.measure_preserving`).
+-/
+
+open measure_theory
+noncomputable theory
+
+namespace complex
+
+/-- Lebesgue measure on `ℂ`. -/
+instance measure_space : measure_space ℂ :=
+⟨measure.map basis_one_I.equiv_fun.symm volume⟩
+
+/-- Measurable equivalence between `ℂ` and `ℝ² = fin 2 → ℝ`. -/
+def measurable_equiv_pi : ℂ ≃ᵐ (fin 2 → ℝ) :=
+basis_one_I.equiv_fun.to_continuous_linear_equiv.to_homeomorph.to_measurable_equiv
+
+/-- Measurable equivalence between `ℂ` and `ℝ × ℝ`. -/
+def measurable_equiv_real_prod : ℂ ≃ᵐ (ℝ × ℝ) :=
+equiv_real_prod_clm.to_homeomorph.to_measurable_equiv
+
+lemma volume_preserving_equiv_pi :
+  measure_preserving measurable_equiv_pi :=
+(measurable_equiv_pi.symm.measurable.measure_preserving _).symm _
+
+lemma volume_preserving_equiv_real_prod : measure_preserving measurable_equiv_real_prod :=
+(volume_preserving_fin_two_arrow ℝ).comp volume_preserving_equiv_pi
+
+end complex
diff --git a/src/measure_theory/measure/lebesgue/eq_haar.lean b/src/measure_theory/measure/lebesgue/eq_haar.lean
new file mode 100644
index 0000000000000..649bd355f7b6a
--- /dev/null
+++ b/src/measure_theory/measure/lebesgue/eq_haar.lean
@@ -0,0 +1,870 @@
+/-
+Copyright (c) 2021 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn, Sébastien Gouëzel
+-/
+import analysis.normed_space.pointwise
+import linear_algebra.finite_dimensional
+import measure_theory.group.pointwise
+import measure_theory.measure.lebesgue.basic
+import measure_theory.measure.haar.basic
+import measure_theory.measure.doubling
+
+/-!
+# Relationship between the Haar and Lebesgue measures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We prove that the Haar measure and Lebesgue measure are equal on `ℝ` and on `ℝ^ι`, in
+`measure_theory.add_haar_measure_eq_volume` and `measure_theory.add_haar_measure_eq_volume_pi`.
+
+We deduce basic properties of any Haar measure on a finite dimensional real vector space:
+* `map_linear_map_add_haar_eq_smul_add_haar`: a linear map rescales the Haar measure by the
+  absolute value of its determinant.
+* `add_haar_preimage_linear_map` : when `f` is a linear map with nonzero determinant, the measure
+  of `f ⁻¹' s` is the measure of `s` multiplied by the absolute value of the inverse of the
+  determinant of `f`.
+* `add_haar_image_linear_map` : when `f` is a linear map, the measure of `f '' s` is the
+  measure of `s` multiplied by the absolute value of the determinant of `f`.
+* `add_haar_submodule` : a strict submodule has measure `0`.
+* `add_haar_smul` : the measure of `r • s` is `|r| ^ dim * μ s`.
+* `add_haar_ball`: the measure of `ball x r` is `r ^ dim * μ (ball 0 1)`.
+* `add_haar_closed_ball`: the measure of `closed_ball x r` is `r ^ dim * μ (ball 0 1)`.
+* `add_haar_sphere`: spheres have zero measure.
+
+This makes it possible to associate a Lebesgue measure to an `n`-alternating map in dimension `n`.
+This measure is called `alternating_map.measure`. Its main property is
+`ω.measure_parallelepiped v`, stating that the associated measure of the parallelepiped spanned
+by vectors `v₁, ..., vₙ` is given by `|ω v|`.
+
+We also show that a Lebesgue density point `x` of a set `s` (with respect to closed balls) has
+density one for the rescaled copies `{x} + r • t` of a given set `t` with positive measure, in
+`tendsto_add_haar_inter_smul_one_of_density_one`. In particular, `s` intersects `{x} + r • t` for
+small `r`, see `eventually_nonempty_inter_smul_of_density_one`.
+-/
+
+assert_not_exists measure_theory.integral
+
+open topological_space set filter metric
+open_locale ennreal pointwise topology nnreal
+
+/-- The interval `[0,1]` as a compact set with non-empty interior. -/
+def topological_space.positive_compacts.Icc01 : positive_compacts ℝ :=
+{ carrier := Icc 0 1,
+  is_compact' := is_compact_Icc,
+  interior_nonempty' := by simp_rw [interior_Icc, nonempty_Ioo, zero_lt_one] }
+
+universe u
+
+/-- The set `[0,1]^ι` as a compact set with non-empty interior. -/
+def topological_space.positive_compacts.pi_Icc01 (ι : Type*) [fintype ι] :
+  positive_compacts (ι → ℝ) :=
+{ carrier := pi univ (λ i, Icc 0 1),
+  is_compact' := is_compact_univ_pi (λ i, is_compact_Icc),
+  interior_nonempty' := by simp only [interior_pi_set, set.to_finite, interior_Icc,
+    univ_pi_nonempty_iff, nonempty_Ioo, implies_true_iff, zero_lt_one] }
+
+/-- The parallelepiped formed from the standard basis for `ι → ℝ` is `[0,1]^ι` -/
+lemma basis.parallelepiped_basis_fun (ι : Type*) [fintype ι] :
+  (pi.basis_fun ℝ ι).parallelepiped = topological_space.positive_compacts.pi_Icc01 ι :=
+set_like.coe_injective $ begin
+  refine eq.trans _ ((uIcc_of_le _).trans (set.pi_univ_Icc _ _).symm),
+  { convert (parallelepiped_single 1) },
+  { exact zero_le_one },
+end
+
+namespace measure_theory
+
+open measure topological_space.positive_compacts finite_dimensional
+
+/-!
+### The Lebesgue measure is a Haar measure on `ℝ` and on `ℝ^ι`.
+-/
+
+/-- The Haar measure equals the Lebesgue measure on `ℝ`. -/
+lemma add_haar_measure_eq_volume : add_haar_measure Icc01 = volume :=
+by { convert (add_haar_measure_unique volume Icc01).symm, simp [Icc01] }
+
+/-- The Haar measure equals the Lebesgue measure on `ℝ^ι`. -/
+lemma add_haar_measure_eq_volume_pi (ι : Type*) [fintype ι] :
+  add_haar_measure (pi_Icc01 ι) = volume :=
+begin
+  convert (add_haar_measure_unique volume (pi_Icc01 ι)).symm,
+  simp only [pi_Icc01, volume_pi_pi (λ i, Icc (0 : ℝ) 1), positive_compacts.coe_mk,
+    compacts.coe_mk, finset.prod_const_one, ennreal.of_real_one, real.volume_Icc, one_smul,
+    sub_zero],
+end
+
+instance is_add_haar_measure_volume_pi (ι : Type*) [fintype ι] :
+  is_add_haar_measure (volume : measure (ι → ℝ)) :=
+by { rw ← add_haar_measure_eq_volume_pi, apply_instance }
+
+namespace measure
+
+/-!
+### Strict subspaces have zero measure
+-/
+
+/-- If a set is disjoint of its translates by infinitely many bounded vectors, then it has measure
+zero. This auxiliary lemma proves this assuming additionally that the set is bounded. -/
+lemma add_haar_eq_zero_of_disjoint_translates_aux
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
+  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
+  {s : set E} (u : ℕ → E) (sb : bounded s) (hu : bounded (range u))
+  (hs : pairwise (disjoint on (λ n, {u n} + s))) (h's : measurable_set s) :
+  μ s = 0 :=
+begin
+  by_contra h,
+  apply lt_irrefl ∞,
+  calc
+  ∞ = ∑' (n : ℕ), μ s : (ennreal.tsum_const_eq_top_of_ne_zero h).symm
+  ... = ∑' (n : ℕ), μ ({u n} + s) :
+    by { congr' 1, ext1 n, simp only [image_add_left, measure_preimage_add, singleton_add] }
+  ... = μ (⋃ n, {u n} + s) :
+    by rw measure_Union hs
+      (λ n, by simpa only [image_add_left, singleton_add] using measurable_id.const_add _ h's)
+  ... = μ (range u + s) : by rw [← Union_add, Union_singleton_eq_range]
+  ... < ∞ : bounded.measure_lt_top (hu.add sb)
+end
+
+/-- If a set is disjoint of its translates by infinitely many bounded vectors, then it has measure
+zero. -/
+lemma add_haar_eq_zero_of_disjoint_translates
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
+  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
+  {s : set E} (u : ℕ → E) (hu : bounded (range u))
+  (hs : pairwise (disjoint on (λ n, {u n} + s))) (h's : measurable_set s) :
+  μ s = 0 :=
+begin
+  suffices H : ∀ R, μ (s ∩ closed_ball 0 R) = 0,
+  { apply le_antisymm _ (zero_le _),
+    calc μ s ≤ ∑' (n : ℕ), μ (s ∩ closed_ball 0 n) :
+      by { conv_lhs { rw ← Union_inter_closed_ball_nat s 0 }, exact measure_Union_le _ }
+    ... = 0 : by simp only [H, tsum_zero] },
+  assume R,
+  apply add_haar_eq_zero_of_disjoint_translates_aux μ u
+    (bounded.mono (inter_subset_right _ _) bounded_closed_ball) hu _
+    (h's.inter (measurable_set_closed_ball)),
+  apply pairwise_disjoint.mono hs (λ n, _),
+  exact add_subset_add (subset.refl _) (inter_subset_left _ _)
+end
+
+/-- A strict vector subspace has measure zero. -/
+lemma add_haar_submodule
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
+  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
+  (s : submodule ℝ E) (hs : s ≠ ⊤) : μ s = 0 :=
+begin
+  obtain ⟨x, hx⟩ : ∃ x, x ∉ s,
+    by simpa only [submodule.eq_top_iff', not_exists, ne.def, not_forall] using hs,
+  obtain ⟨c, cpos, cone⟩ : ∃ (c : ℝ), 0 < c ∧ c < 1 := ⟨1/2, by norm_num, by norm_num⟩,
+  have A : bounded (range (λ (n : ℕ), (c ^ n) • x)),
+  { have : tendsto (λ (n : ℕ), (c ^ n) • x) at_top (𝓝 ((0 : ℝ) • x)) :=
+      (tendsto_pow_at_top_nhds_0_of_lt_1 cpos.le cone).smul_const x,
+    exact bounded_range_of_tendsto _ this },
+  apply add_haar_eq_zero_of_disjoint_translates μ _ A _
+    (submodule.closed_of_finite_dimensional s).measurable_set,
+  assume m n hmn,
+  simp only [function.on_fun, image_add_left, singleton_add, disjoint_left, mem_preimage,
+             set_like.mem_coe],
+  assume y hym hyn,
+  have A : (c ^ n - c ^ m) • x ∈ s,
+  { convert s.sub_mem hym hyn,
+    simp only [sub_smul, neg_sub_neg, add_sub_add_right_eq_sub] },
+  have H : c ^ n - c ^ m ≠ 0,
+    by simpa only [sub_eq_zero, ne.def] using (strict_anti_pow cpos cone).injective.ne hmn.symm,
+  have : x ∈ s,
+  { convert s.smul_mem (c ^ n - c ^ m)⁻¹ A,
+    rw [smul_smul, inv_mul_cancel H, one_smul] },
+  exact hx this
+end
+
+/-- A strict affine subspace has measure zero. -/
+lemma add_haar_affine_subspace
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E] [borel_space E]
+  [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
+  (s : affine_subspace ℝ E) (hs : s ≠ ⊤) : μ s = 0 :=
+begin
+  rcases s.eq_bot_or_nonempty with rfl|hne,
+  { rw [affine_subspace.bot_coe, measure_empty] },
+  rw [ne.def, ← affine_subspace.direction_eq_top_iff_of_nonempty hne] at hs,
+  rcases hne with ⟨x, hx : x ∈ s⟩,
+  simpa only [affine_subspace.coe_direction_eq_vsub_set_right hx, vsub_eq_sub,
+    sub_eq_add_neg, image_add_right, neg_neg, measure_preimage_add_right]
+    using add_haar_submodule μ s.direction hs
+end
+
+/-!
+### Applying a linear map rescales Haar measure by the determinant
+
+We first prove this on `ι → ℝ`, using that this is already known for the product Lebesgue
+measure (thanks to matrices computations). Then, we extend this to any finite-dimensional real
+vector space by using a linear equiv with a space of the form `ι → ℝ`, and arguing that such a
+linear equiv maps Haar measure to Haar measure.
+-/
+
+lemma map_linear_map_add_haar_pi_eq_smul_add_haar
+  {ι : Type*} [finite ι] {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0)
+  (μ : measure (ι → ℝ)) [is_add_haar_measure μ] :
+  measure.map f μ = ennreal.of_real (abs (f.det)⁻¹) • μ :=
+begin
+  casesI nonempty_fintype ι,
+  /- We have already proved the result for the Lebesgue product measure, using matrices.
+  We deduce it for any Haar measure by uniqueness (up to scalar multiplication). -/
+  have := add_haar_measure_unique μ (pi_Icc01 ι),
+  rw [this, add_haar_measure_eq_volume_pi, measure.map_smul,
+    real.map_linear_map_volume_pi_eq_smul_volume_pi hf, smul_comm],
+end
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [measurable_space E]
+  [borel_space E] [finite_dimensional ℝ E] (μ : measure E) [is_add_haar_measure μ]
+  {F : Type*} [normed_add_comm_group F] [normed_space ℝ F] [complete_space F]
+
+lemma map_linear_map_add_haar_eq_smul_add_haar
+  {f : E →ₗ[ℝ] E} (hf : f.det ≠ 0) :
+  measure.map f μ = ennreal.of_real (abs (f.det)⁻¹) • μ :=
+begin
+  -- we reduce to the case of `E = ι → ℝ`, for which we have already proved the result using
+  -- matrices in `map_linear_map_add_haar_pi_eq_smul_add_haar`.
+  let ι := fin (finrank ℝ E),
+  haveI : finite_dimensional ℝ (ι → ℝ) := by apply_instance,
+  have : finrank ℝ E = finrank ℝ (ι → ℝ), by simp,
+  have e : E ≃ₗ[ℝ] ι → ℝ := linear_equiv.of_finrank_eq E (ι → ℝ) this,
+  -- next line is to avoid `g` getting reduced by `simp`.
+  obtain ⟨g, hg⟩ : ∃ g, g = (e : E →ₗ[ℝ] (ι → ℝ)).comp (f.comp (e.symm : (ι → ℝ) →ₗ[ℝ] E)) :=
+    ⟨_, rfl⟩,
+  have gdet : g.det = f.det, by { rw [hg], exact linear_map.det_conj f e },
+  rw ← gdet at hf ⊢,
+  have fg : f = (e.symm : (ι → ℝ) →ₗ[ℝ] E).comp (g.comp (e : E →ₗ[ℝ] (ι → ℝ))),
+  { ext x,
+    simp only [linear_equiv.coe_coe, function.comp_app, linear_map.coe_comp,
+      linear_equiv.symm_apply_apply, hg] },
+  simp only [fg, linear_equiv.coe_coe, linear_map.coe_comp],
+  have Ce : continuous e := (e : E →ₗ[ℝ] (ι → ℝ)).continuous_of_finite_dimensional,
+  have Cg : continuous g := linear_map.continuous_of_finite_dimensional g,
+  have Cesymm : continuous e.symm := (e.symm : (ι → ℝ) →ₗ[ℝ] E).continuous_of_finite_dimensional,
+  rw [← map_map Cesymm.measurable (Cg.comp Ce).measurable, ← map_map Cg.measurable Ce.measurable],
+  haveI : is_add_haar_measure (map e μ) := (e : E ≃+ (ι → ℝ)).is_add_haar_measure_map μ Ce Cesymm,
+  have ecomp : (e.symm) ∘ e = id,
+    by { ext x, simp only [id.def, function.comp_app, linear_equiv.symm_apply_apply] },
+  rw [map_linear_map_add_haar_pi_eq_smul_add_haar hf (map e μ), measure.map_smul,
+    map_map Cesymm.measurable Ce.measurable, ecomp, measure.map_id]
+end
+
+/-- The preimage of a set `s` under a linear map `f` with nonzero determinant has measure
+equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
+@[simp] lemma add_haar_preimage_linear_map
+  {f : E →ₗ[ℝ] E} (hf : f.det ≠ 0) (s : set E) :
+  μ (f ⁻¹' s) = ennreal.of_real (abs (f.det)⁻¹) * μ s :=
+calc μ (f ⁻¹' s) = measure.map f μ s :
+  ((f.equiv_of_det_ne_zero hf).to_continuous_linear_equiv.to_homeomorph
+    .to_measurable_equiv.map_apply s).symm
+... = ennreal.of_real (abs (f.det)⁻¹) * μ s :
+  by { rw map_linear_map_add_haar_eq_smul_add_haar μ hf, refl }
+
+/-- The preimage of a set `s` under a continuous linear map `f` with nonzero determinant has measure
+equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
+@[simp] lemma add_haar_preimage_continuous_linear_map
+  {f : E →L[ℝ] E} (hf : linear_map.det (f : E →ₗ[ℝ] E) ≠ 0) (s : set E) :
+  μ (f ⁻¹' s) = ennreal.of_real (abs (linear_map.det (f : E →ₗ[ℝ] E))⁻¹) * μ s :=
+add_haar_preimage_linear_map μ hf s
+
+/-- The preimage of a set `s` under a linear equiv `f` has measure
+equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
+@[simp] lemma add_haar_preimage_linear_equiv
+  (f : E ≃ₗ[ℝ] E) (s : set E) :
+  μ (f ⁻¹' s) = ennreal.of_real (abs (f.symm : E →ₗ[ℝ] E).det) * μ s :=
+begin
+  have A : (f : E →ₗ[ℝ] E).det ≠ 0 := (linear_equiv.is_unit_det' f).ne_zero,
+  convert add_haar_preimage_linear_map μ A s,
+  simp only [linear_equiv.det_coe_symm]
+end
+
+/-- The preimage of a set `s` under a continuous linear equiv `f` has measure
+equal to `μ s` times the absolute value of the inverse of the determinant of `f`. -/
+@[simp] lemma add_haar_preimage_continuous_linear_equiv
+  (f : E ≃L[ℝ] E) (s : set E) :
+  μ (f ⁻¹' s) = ennreal.of_real (abs (f.symm : E →ₗ[ℝ] E).det) * μ s :=
+add_haar_preimage_linear_equiv μ _ s
+
+/-- The image of a set `s` under a linear map `f` has measure
+equal to `μ s` times the absolute value of the determinant of `f`. -/
+@[simp] lemma add_haar_image_linear_map
+  (f : E →ₗ[ℝ] E) (s : set E) :
+  μ (f '' s) = ennreal.of_real (abs f.det) * μ s :=
+begin
+  rcases ne_or_eq f.det 0 with hf|hf,
+  { let g := (f.equiv_of_det_ne_zero hf).to_continuous_linear_equiv,
+    change μ (g '' s) = _,
+    rw [continuous_linear_equiv.image_eq_preimage g s, add_haar_preimage_continuous_linear_equiv],
+    congr,
+    ext x,
+    simp only [linear_equiv.coe_to_continuous_linear_equiv, linear_equiv.of_is_unit_det_apply,
+               linear_equiv.coe_coe, continuous_linear_equiv.symm_symm], },
+  { simp only [hf, zero_mul, ennreal.of_real_zero, abs_zero],
+    have : μ f.range = 0 :=
+      add_haar_submodule μ _ (linear_map.range_lt_top_of_det_eq_zero hf).ne,
+    exact le_antisymm (le_trans (measure_mono (image_subset_range _ _)) this.le) (zero_le _) }
+end
+
+/-- The image of a set `s` under a continuous linear map `f` has measure
+equal to `μ s` times the absolute value of the determinant of `f`. -/
+@[simp] lemma add_haar_image_continuous_linear_map
+  (f : E →L[ℝ] E) (s : set E) :
+  μ (f '' s) = ennreal.of_real (abs (f : E →ₗ[ℝ] E).det) * μ s :=
+add_haar_image_linear_map μ _ s
+
+/-- The image of a set `s` under a continuous linear equiv `f` has measure
+equal to `μ s` times the absolute value of the determinant of `f`. -/
+@[simp] lemma add_haar_image_continuous_linear_equiv
+  (f : E ≃L[ℝ] E) (s : set E) :
+  μ (f '' s) = ennreal.of_real (abs (f : E →ₗ[ℝ] E).det) * μ s :=
+μ.add_haar_image_linear_map (f : E →ₗ[ℝ] E) s
+
+/-!
+### Basic properties of Haar measures on real vector spaces
+-/
+
+lemma map_add_haar_smul {r : ℝ} (hr : r ≠ 0) :
+  measure.map ((•) r) μ = ennreal.of_real (abs (r ^ finrank ℝ E)⁻¹) • μ :=
+begin
+  let f : E →ₗ[ℝ] E := r • 1,
+  change measure.map f μ = _,
+  have hf : f.det ≠ 0,
+  { simp only [mul_one, linear_map.det_smul, ne.def, monoid_hom.map_one],
+    assume h,
+    exact hr (pow_eq_zero h) },
+  simp only [map_linear_map_add_haar_eq_smul_add_haar μ hf, mul_one, linear_map.det_smul,
+    monoid_hom.map_one],
+end
+
+@[simp] lemma add_haar_preimage_smul {r : ℝ} (hr : r ≠ 0) (s : set E) :
+  μ (((•) r) ⁻¹' s) = ennreal.of_real (abs (r ^ finrank ℝ E)⁻¹) * μ s :=
+calc μ (((•) r) ⁻¹' s) = measure.map ((•) r) μ s :
+  ((homeomorph.smul (is_unit_iff_ne_zero.2 hr).unit).to_measurable_equiv.map_apply s).symm
+... = ennreal.of_real (abs (r^finrank ℝ E)⁻¹) * μ s : by { rw map_add_haar_smul μ hr, refl }
+
+/-- Rescaling a set by a factor `r` multiplies its measure by `abs (r ^ dim)`. -/
+@[simp] lemma add_haar_smul (r : ℝ) (s : set E) :
+  μ (r • s) = ennreal.of_real (abs (r ^ finrank ℝ E)) * μ s :=
+begin
+  rcases ne_or_eq r 0 with h|rfl,
+  { rw [← preimage_smul_inv₀ h, add_haar_preimage_smul μ (inv_ne_zero h), inv_pow, inv_inv] },
+  rcases eq_empty_or_nonempty s with rfl|hs,
+  { simp only [measure_empty, mul_zero, smul_set_empty] },
+  rw [zero_smul_set hs, ← singleton_zero],
+  by_cases h : finrank ℝ E = 0,
+  { haveI : subsingleton E := finrank_zero_iff.1 h,
+    simp only [h, one_mul, ennreal.of_real_one, abs_one, subsingleton.eq_univ_of_nonempty hs,
+      pow_zero, subsingleton.eq_univ_of_nonempty (singleton_nonempty (0 : E))] },
+  { haveI : nontrivial E := nontrivial_of_finrank_pos (bot_lt_iff_ne_bot.2 h),
+    simp only [h, zero_mul, ennreal.of_real_zero, abs_zero, ne.def, not_false_iff, zero_pow',
+      measure_singleton] }
+end
+
+lemma add_haar_smul_of_nonneg {r : ℝ} (hr : 0 ≤ r) (s : set E) :
+  μ (r • s) = ennreal.of_real (r ^ finrank ℝ E) * μ s :=
+by rw [add_haar_smul, abs_pow, abs_of_nonneg hr]
+
+variables {μ} {s : set E}
+
+-- Note: We might want to rename this once we acquire the lemma corresponding to
+-- `measurable_set.const_smul`
+lemma null_measurable_set.const_smul (hs : null_measurable_set s μ) (r : ℝ) :
+  null_measurable_set (r • s) μ :=
+begin
+  obtain rfl | hs' := s.eq_empty_or_nonempty,
+  { simp },
+  obtain rfl | hr := eq_or_ne r 0,
+  { simpa [zero_smul_set hs'] using null_measurable_set_singleton _ },
+  obtain ⟨t, ht, hst⟩ := hs,
+  refine ⟨_, ht.const_smul_of_ne_zero hr, _⟩,
+  rw ←measure_symm_diff_eq_zero_iff at ⊢ hst,
+  rw [←smul_set_symm_diff₀ hr, add_haar_smul μ, hst, mul_zero],
+end
+
+variables (μ)
+
+@[simp] lemma add_haar_image_homothety (x : E) (r : ℝ) (s : set E) :
+  μ (affine_map.homothety x r '' s) = ennreal.of_real (abs (r ^ finrank ℝ E)) * μ s :=
+calc μ (affine_map.homothety x r '' s) = μ ((λ y, y + x) '' (r • ((λ y, y + (-x)) '' s))) :
+  by { simp only [← image_smul, image_image, ← sub_eq_add_neg], refl }
+... = ennreal.of_real (abs (r ^ finrank ℝ E)) * μ s :
+  by simp only [image_add_right, measure_preimage_add_right, add_haar_smul]
+
+/-! We don't need to state `map_add_haar_neg` here, because it has already been proved for
+general Haar measures on general commutative groups. -/
+
+/-! ### Measure of balls -/
+
+lemma add_haar_ball_center
+  {E : Type*} [normed_add_comm_group E] [measurable_space E]
+  [borel_space E] (μ : measure E) [is_add_haar_measure μ] (x : E) (r : ℝ) :
+  μ (ball x r) = μ (ball (0 : E) r) :=
+begin
+  have : ball (0 : E) r = ((+) x) ⁻¹' (ball x r), by simp [preimage_add_ball],
+  rw [this, measure_preimage_add]
+end
+
+lemma add_haar_closed_ball_center
+  {E : Type*} [normed_add_comm_group E] [measurable_space E]
+  [borel_space E] (μ : measure E) [is_add_haar_measure μ] (x : E) (r : ℝ) :
+  μ (closed_ball x r) = μ (closed_ball (0 : E) r) :=
+begin
+  have : closed_ball (0 : E) r = ((+) x) ⁻¹' (closed_ball x r), by simp [preimage_add_closed_ball],
+  rw [this, measure_preimage_add]
+end
+
+lemma add_haar_ball_mul_of_pos (x : E) {r : ℝ} (hr : 0 < r) (s : ℝ) :
+  μ (ball x (r * s)) = ennreal.of_real (r ^ finrank ℝ E) * μ (ball 0 s) :=
+begin
+  have : ball (0 : E) (r * s) = r • ball 0 s,
+    by simp only [smul_ball hr.ne' (0 : E) s, real.norm_eq_abs, abs_of_nonneg hr.le, smul_zero],
+  simp only [this, add_haar_smul, abs_of_nonneg hr.le, add_haar_ball_center, abs_pow],
+end
+
+lemma add_haar_ball_of_pos (x : E) {r : ℝ} (hr : 0 < r) :
+  μ (ball x r) = ennreal.of_real (r ^ finrank ℝ E) * μ (ball 0 1) :=
+by rw [← add_haar_ball_mul_of_pos μ x hr, mul_one]
+
+lemma add_haar_ball_mul [nontrivial E] (x : E) {r : ℝ} (hr : 0 ≤ r) (s : ℝ) :
+  μ (ball x (r * s)) = ennreal.of_real (r ^ finrank ℝ E) * μ (ball 0 s) :=
+begin
+  rcases has_le.le.eq_or_lt hr with h|h,
+  { simp only [← h, zero_pow finrank_pos, measure_empty, zero_mul, ennreal.of_real_zero,
+               ball_zero] },
+  { exact add_haar_ball_mul_of_pos μ x h s }
+end
+
+lemma add_haar_ball [nontrivial E] (x : E) {r : ℝ} (hr : 0 ≤ r) :
+  μ (ball x r) = ennreal.of_real (r ^ finrank ℝ E) * μ (ball 0 1) :=
+by rw [← add_haar_ball_mul μ x hr, mul_one]
+
+lemma add_haar_closed_ball_mul_of_pos (x : E) {r : ℝ} (hr : 0 < r) (s : ℝ) :
+  μ (closed_ball x (r * s)) = ennreal.of_real (r ^ finrank ℝ E) * μ (closed_ball 0 s) :=
+begin
+  have : closed_ball (0 : E) (r * s) = r • closed_ball 0 s,
+    by simp [smul_closed_ball' hr.ne' (0 : E), abs_of_nonneg hr.le],
+  simp only [this, add_haar_smul, abs_of_nonneg hr.le, add_haar_closed_ball_center, abs_pow],
+end
+
+lemma add_haar_closed_ball_mul (x : E) {r : ℝ} (hr : 0 ≤ r) {s : ℝ} (hs : 0 ≤ s) :
+  μ (closed_ball x (r * s)) = ennreal.of_real (r ^ finrank ℝ E) * μ (closed_ball 0 s) :=
+begin
+  have : closed_ball (0 : E) (r * s) = r • closed_ball 0 s,
+    by simp [smul_closed_ball r (0 : E) hs, abs_of_nonneg hr],
+  simp only [this, add_haar_smul, abs_of_nonneg hr, add_haar_closed_ball_center, abs_pow],
+end
+
+/-- The measure of a closed ball can be expressed in terms of the measure of the closed unit ball.
+Use instead `add_haar_closed_ball`, which uses the measure of the open unit ball as a standard
+form. -/
+lemma add_haar_closed_ball' (x : E) {r : ℝ} (hr : 0 ≤ r) :
+  μ (closed_ball x r) = ennreal.of_real (r ^ finrank ℝ E) * μ (closed_ball 0 1) :=
+by rw [← add_haar_closed_ball_mul μ x hr zero_le_one, mul_one]
+
+lemma add_haar_closed_unit_ball_eq_add_haar_unit_ball :
+  μ (closed_ball (0 : E) 1) = μ (ball 0 1) :=
+begin
+  apply le_antisymm _ (measure_mono ball_subset_closed_ball),
+  have A : tendsto (λ (r : ℝ), ennreal.of_real (r ^ finrank ℝ E) * μ (closed_ball (0 : E) 1))
+    (𝓝[<] 1) (𝓝 (ennreal.of_real (1 ^ finrank ℝ E) * μ (closed_ball (0 : E) 1))),
+  { refine ennreal.tendsto.mul _ (by simp) tendsto_const_nhds (by simp),
+    exact ennreal.tendsto_of_real ((tendsto_id'.2 nhds_within_le_nhds).pow _) },
+  simp only [one_pow, one_mul, ennreal.of_real_one] at A,
+  refine le_of_tendsto A _,
+  refine mem_nhds_within_Iio_iff_exists_Ioo_subset.2 ⟨(0 : ℝ), by simp, λ r hr, _⟩,
+  dsimp,
+  rw ← add_haar_closed_ball' μ (0 : E) hr.1.le,
+  exact measure_mono (closed_ball_subset_ball hr.2)
+end
+
+lemma add_haar_closed_ball (x : E) {r : ℝ} (hr : 0 ≤ r) :
+  μ (closed_ball x r) = ennreal.of_real (r ^ finrank ℝ E) * μ (ball 0 1) :=
+by rw [add_haar_closed_ball' μ x hr, add_haar_closed_unit_ball_eq_add_haar_unit_ball]
+
+lemma add_haar_closed_ball_eq_add_haar_ball [nontrivial E] (x : E) (r : ℝ) :
+  μ (closed_ball x r) = μ (ball x r) :=
+begin
+  by_cases h : r < 0,
+  { rw [metric.closed_ball_eq_empty.mpr h, metric.ball_eq_empty.mpr h.le] },
+  push_neg at h,
+  rw [add_haar_closed_ball μ x h, add_haar_ball μ x h],
+end
+
+lemma add_haar_sphere_of_ne_zero (x : E) {r : ℝ} (hr : r ≠ 0) :
+  μ (sphere x r) = 0 :=
+begin
+  rcases hr.lt_or_lt with h|h,
+  { simp only [empty_diff, measure_empty, ← closed_ball_diff_ball, closed_ball_eq_empty.2 h] },
+  { rw [← closed_ball_diff_ball,
+        measure_diff ball_subset_closed_ball measurable_set_ball measure_ball_lt_top.ne,
+        add_haar_ball_of_pos μ _ h, add_haar_closed_ball μ _ h.le, tsub_self];
+    apply_instance }
+end
+
+lemma add_haar_sphere [nontrivial E] (x : E) (r : ℝ) :
+  μ (sphere x r) = 0 :=
+begin
+  rcases eq_or_ne r 0 with rfl|h,
+  { rw [sphere_zero, measure_singleton] },
+  { exact add_haar_sphere_of_ne_zero μ x h }
+end
+
+lemma add_haar_singleton_add_smul_div_singleton_add_smul
+  {r : ℝ} (hr : r ≠ 0) (x y : E) (s t : set E) :
+  μ ({x} + r • s) / μ ({y} + r • t) = μ s / μ t :=
+calc
+μ ({x} + r • s) / μ ({y} + r • t)
+    = ennreal.of_real (|r| ^ finrank ℝ E) * μ s * (ennreal.of_real (|r| ^ finrank ℝ E) * μ t)⁻¹ :
+  by simp only [div_eq_mul_inv, add_haar_smul, image_add_left, measure_preimage_add, abs_pow,
+    singleton_add]
+... = ennreal.of_real (|r| ^ finrank ℝ E) * (ennreal.of_real (|r| ^ finrank ℝ E))⁻¹ *
+        (μ s * (μ t)⁻¹) :
+  begin
+    rw ennreal.mul_inv,
+    { ring },
+    { simp only [pow_pos (abs_pos.mpr hr), ennreal.of_real_eq_zero, not_le, ne.def, true_or] },
+    { simp only [ennreal.of_real_ne_top, true_or, ne.def, not_false_iff] },
+  end
+... = μ s / μ t :
+  begin
+    rw [ennreal.mul_inv_cancel, one_mul, div_eq_mul_inv],
+    { simp only [pow_pos (abs_pos.mpr hr), ennreal.of_real_eq_zero, not_le, ne.def], },
+    { simp only [ennreal.of_real_ne_top, ne.def, not_false_iff] }
+  end
+
+@[priority 100] instance is_unif_loc_doubling_measure_of_is_add_haar_measure :
+  is_unif_loc_doubling_measure μ :=
+begin
+  refine ⟨⟨(2 : ℝ≥0) ^ finrank ℝ E, _⟩⟩,
+  filter_upwards [self_mem_nhds_within] with r hr x,
+  rw [add_haar_closed_ball_mul μ x zero_le_two (le_of_lt hr), add_haar_closed_ball_center μ x,
+    ennreal.of_real, real.to_nnreal_pow zero_le_two],
+  simp only [real.to_nnreal_bit0, real.to_nnreal_one, le_refl],
+end
+
+section
+
+/-!
+### The Lebesgue measure associated to an alternating map
+-/
+
+variables {ι G : Type*} [fintype ι] [decidable_eq ι]
+[normed_add_comm_group G] [normed_space ℝ G] [measurable_space G] [borel_space G]
+
+lemma add_haar_parallelepiped (b : basis ι ℝ G) (v : ι → G) :
+  b.add_haar (parallelepiped v) = ennreal.of_real (|b.det v|) :=
+begin
+  haveI : finite_dimensional ℝ G, from finite_dimensional.of_fintype_basis b,
+  have A : parallelepiped v = (b.constr ℕ v) '' (parallelepiped b),
+  { rw image_parallelepiped,
+    congr' 1 with i,
+    exact (b.constr_basis ℕ v i).symm },
+  rw [A, add_haar_image_linear_map, basis.add_haar_self, mul_one,
+    ← linear_map.det_to_matrix b, ← basis.to_matrix_eq_to_matrix_constr],
+  refl,
+end
+
+variables [finite_dimensional ℝ G] {n : ℕ} [_i : fact (finrank ℝ G = n)]
+include _i
+
+/-- The Lebesgue measure associated to an alternating map. It gives measure `|ω v|` to the
+parallelepiped spanned by the vectors `v₁, ..., vₙ`. Note that it is not always a Haar measure,
+as it can be zero, but it is always locally finite and translation invariant. -/
+@[irreducible] noncomputable def _root_.alternating_map.measure
+  (ω : alternating_map ℝ G ℝ (fin n)) : measure G :=
+‖ω (fin_basis_of_finrank_eq ℝ G _i.out)‖₊ • (fin_basis_of_finrank_eq ℝ G _i.out).add_haar
+
+lemma _root_.alternating_map.measure_parallelepiped
+  (ω : alternating_map ℝ G ℝ (fin n)) (v : fin n → G) :
+  ω.measure (parallelepiped v) = ennreal.of_real (|ω v|) :=
+begin
+  conv_rhs { rw ω.eq_smul_basis_det (fin_basis_of_finrank_eq ℝ G _i.out) },
+  simp only [add_haar_parallelepiped, alternating_map.measure, coe_nnreal_smul_apply,
+    alternating_map.smul_apply, algebra.id.smul_eq_mul, abs_mul,
+    ennreal.of_real_mul (abs_nonneg _), real.ennnorm_eq_of_real_abs]
+end
+
+instance (ω : alternating_map ℝ G ℝ (fin n)) : is_add_left_invariant ω.measure :=
+by { rw [alternating_map.measure], apply_instance }
+
+instance (ω : alternating_map ℝ G ℝ (fin n)) : is_locally_finite_measure ω.measure :=
+by { rw [alternating_map.measure], apply_instance }
+
+end
+
+/-!
+### Density points
+
+Besicovitch covering theorem ensures that, for any locally finite measure on a finite-dimensional
+real vector space, almost every point of a set `s` is a density point, i.e.,
+`μ (s ∩ closed_ball x r) / μ (closed_ball x r)` tends to `1` as `r` tends to `0`
+(see `besicovitch.ae_tendsto_measure_inter_div`).
+When `μ` is a Haar measure, one can deduce the same property for any rescaling sequence of sets,
+of the form `{x} + r • t` where `t` is a set with positive finite measure, instead of the sequence
+of closed balls.
+
+We argue first for the dual property, i.e., if `s` has density `0` at `x`, then
+`μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)` tends to `0`. First when `t` is contained in the ball
+of radius `1`, in `tendsto_add_haar_inter_smul_zero_of_density_zero_aux1`,
+(by arguing by inclusion). Then when `t` is bounded, reducing to the previous one by rescaling, in
+`tendsto_add_haar_inter_smul_zero_of_density_zero_aux2`.
+Then for a general set `t`, by cutting it into a bounded part and a part with small measure, in
+`tendsto_add_haar_inter_smul_zero_of_density_zero`.
+Going to the complement, one obtains the desired property at points of density `1`, first when
+`s` is measurable in `tendsto_add_haar_inter_smul_one_of_density_one_aux`, and then without this
+assumption in `tendsto_add_haar_inter_smul_one_of_density_one` by applying the previous lemma to
+the measurable hull `to_measurable μ s`
+-/
+
+lemma tendsto_add_haar_inter_smul_zero_of_density_zero_aux1
+  (s : set E) (x : E)
+  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0))
+  (t : set E) (u : set E) (h'u : μ u ≠ 0) (t_bound : t ⊆ closed_ball 0 1) :
+  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • u)) (𝓝[>] 0) (𝓝 0) :=
+begin
+  have A : tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0),
+  { apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds h
+      (eventually_of_forall (λ b, zero_le _)),
+    filter_upwards [self_mem_nhds_within],
+    rintros r (rpos : 0 < r),
+    apply mul_le_mul_right' (measure_mono (inter_subset_inter_right _ _)) _,
+    assume y hy,
+    have : y - x ∈ r • closed_ball (0 : E) 1,
+    { apply smul_set_mono t_bound,
+      simpa [neg_add_eq_sub] using hy },
+    simpa only [smul_closed_ball _ _ zero_le_one, real.norm_of_nonneg rpos.le,
+      mem_closed_ball_iff_norm, mul_one, sub_zero, smul_zero] },
+  have B : tendsto (λ (r : ℝ), μ (closed_ball x r) / μ ({x} + r • u)) (𝓝[>] 0)
+    (𝓝 (μ (closed_ball x 1) / μ ({x} + u))),
+  { apply tendsto_const_nhds.congr' _,
+    filter_upwards [self_mem_nhds_within],
+    rintros r (rpos : 0 < r),
+    have : closed_ball x r = {x} + r • closed_ball 0 1,
+      by simp only [_root_.smul_closed_ball, real.norm_of_nonneg rpos.le, zero_le_one, add_zero,
+        mul_one, singleton_add_closed_ball, smul_zero],
+    simp only [this, add_haar_singleton_add_smul_div_singleton_add_smul μ rpos.ne'],
+    simp only [add_haar_closed_ball_center, image_add_left, measure_preimage_add, singleton_add] },
+  have C : tendsto (λ (r : ℝ),
+    (μ (s ∩ ({x} + r • t)) / μ (closed_ball x r)) * (μ (closed_ball x r) / μ ({x} + r • u)))
+    (𝓝[>] 0) (𝓝 (0 * (μ (closed_ball x 1) / μ ({x} + u)))),
+  { apply ennreal.tendsto.mul A _ B (or.inr ennreal.zero_ne_top),
+    simp only [ennreal.div_eq_top, h'u, measure_closed_ball_lt_top.ne, false_or, image_add_left,
+      eq_self_iff_true, not_true, ne.def, not_false_iff, measure_preimage_add, singleton_add,
+      and_false, false_and] },
+  simp only [zero_mul] at C,
+  apply C.congr' _,
+  filter_upwards [self_mem_nhds_within],
+  rintros r (rpos : 0 < r),
+  calc μ (s ∩ ({x} + r • t)) / μ (closed_ball x r) * (μ (closed_ball x r) / μ ({x} + r • u))
+    = (μ (closed_ball x r) * (μ (closed_ball x r))⁻¹) * (μ (s ∩ ({x} + r • t)) / μ ({x} + r • u)) :
+      by { simp only [div_eq_mul_inv], ring }
+    ... = μ (s ∩ ({x} + r • t)) / μ ({x} + r • u) :
+      by rw [ennreal.mul_inv_cancel (measure_closed_ball_pos μ x rpos).ne'
+          measure_closed_ball_lt_top.ne, one_mul],
+end
+
+lemma tendsto_add_haar_inter_smul_zero_of_density_zero_aux2
+  (s : set E) (x : E)
+  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0))
+  (t : set E) (u : set E) (h'u : μ u ≠ 0)
+  (R : ℝ) (Rpos : 0 < R) (t_bound : t ⊆ closed_ball 0 R) :
+  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • u)) (𝓝[>] 0) (𝓝 0) :=
+begin
+  set t' := R⁻¹ • t with ht',
+  set u' := R⁻¹ • u with hu',
+  have A : tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t')) / μ ({x} + r • u')) (𝓝[>] 0) (𝓝 0),
+  { apply tendsto_add_haar_inter_smul_zero_of_density_zero_aux1 μ s x h
+      t' u',
+    { simp only [h'u, (pow_pos Rpos _).ne', abs_nonpos_iff, add_haar_smul, not_false_iff,
+        ennreal.of_real_eq_zero, inv_eq_zero, inv_pow, ne.def, or_self, mul_eq_zero] },
+    { convert smul_set_mono t_bound,
+      rw [smul_closed_ball _ _ Rpos.le, smul_zero, real.norm_of_nonneg (inv_nonneg.2 Rpos.le),
+        inv_mul_cancel Rpos.ne'] } },
+  have B : tendsto (λ (r : ℝ), R * r) (𝓝[>] 0) (𝓝[>] (R * 0)),
+  { apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within,
+    { exact (tendsto_const_nhds.mul tendsto_id).mono_left nhds_within_le_nhds },
+    { filter_upwards [self_mem_nhds_within],
+      assume r rpos,
+      rw mul_zero,
+      exact mul_pos Rpos rpos } },
+  rw mul_zero at B,
+  apply (A.comp B).congr' _,
+  filter_upwards [self_mem_nhds_within],
+  rintros r (rpos : 0 < r),
+  have T : (R * r) • t' = r • t,
+    by rw [mul_comm, ht', smul_smul, mul_assoc, mul_inv_cancel Rpos.ne', mul_one],
+  have U : (R * r) • u' = r • u,
+    by rw [mul_comm, hu', smul_smul, mul_assoc, mul_inv_cancel Rpos.ne', mul_one],
+  dsimp,
+  rw [T, U],
+end
+
+/-- Consider a point `x` at which a set `s` has density zero, with respect to closed balls. Then it
+also has density zero with respect to any measurable set `t`: the proportion of points in `s`
+belonging to a rescaled copy `{x} + r • t` of `t` tends to zero as `r` tends to zero. -/
+lemma tendsto_add_haar_inter_smul_zero_of_density_zero
+  (s : set E) (x : E)
+  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0))
+  (t : set E) (ht : measurable_set t) (h''t : μ t ≠ ∞) :
+  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 0) :=
+begin
+  refine tendsto_order.2 ⟨λ a' ha', (ennreal.not_lt_zero ha').elim, λ ε (εpos : 0 < ε), _⟩,
+  rcases eq_or_ne (μ t) 0 with h't|h't,
+  { apply eventually_of_forall (λ r, _),
+    suffices H : μ (s ∩ ({x} + r • t)) = 0,
+      by { rw H, simpa only [ennreal.zero_div] using εpos },
+    apply le_antisymm _ (zero_le _),
+    calc μ (s ∩ ({x} + r • t)) ≤ μ ({x} + r • t) : measure_mono (inter_subset_right _ _)
+    ... = 0 : by simp only [h't, add_haar_smul, image_add_left, measure_preimage_add,
+      singleton_add, mul_zero] },
+  obtain ⟨n, npos, hn⟩ : ∃ (n : ℕ), 0 < n ∧ μ (t \ closed_ball 0 n) < (ε / 2) * μ t,
+  { have A : tendsto (λ (n : ℕ), μ (t \ closed_ball 0 n)) at_top
+      (𝓝 (μ (⋂ (n : ℕ), t \ closed_ball 0 n))),
+    { have N : ∃ (n : ℕ), μ (t \ closed_ball 0 n) ≠ ∞ :=
+        ⟨0, ((measure_mono (diff_subset t _)).trans_lt h''t.lt_top).ne⟩,
+      refine tendsto_measure_Inter (λ n, ht.diff measurable_set_closed_ball) (λ m n hmn, _) N,
+      exact diff_subset_diff subset.rfl (closed_ball_subset_closed_ball (nat.cast_le.2 hmn)) },
+    have : (⋂ (n : ℕ), t \ closed_ball 0 n) = ∅,
+      by simp_rw [diff_eq, ← inter_Inter, Inter_eq_compl_Union_compl, compl_compl,
+          Union_closed_ball_nat, compl_univ, inter_empty],
+    simp only [this, measure_empty] at A,
+    have I : 0 < (ε / 2) * μ t := ennreal.mul_pos (ennreal.half_pos εpos.ne').ne' h't,
+    exact (eventually.and (Ioi_mem_at_top 0) ((tendsto_order.1 A).2 _ I)).exists },
+  have L : tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) / μ ({x} + r • t))
+    (𝓝[>] 0) (𝓝 0) :=
+      tendsto_add_haar_inter_smul_zero_of_density_zero_aux2 μ s x h
+        _ t h't n (nat.cast_pos.2 npos) (inter_subset_right _ _),
+  filter_upwards [(tendsto_order.1 L).2 _ (ennreal.half_pos εpos.ne'), self_mem_nhds_within],
+  rintros r hr (rpos : 0 < r),
+  have I : μ (s ∩ ({x} + r • t)) ≤
+    μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ ({x} + r • (t \ closed_ball 0 n)) := calc
+  μ (s ∩ ({x} + r • t))
+      = μ ((s ∩ ({x} + r • (t ∩ closed_ball 0 n))) ∪ (s ∩ ({x} + r • (t \ closed_ball 0 n)))) :
+    by rw [← inter_union_distrib_left, ← add_union, ← smul_set_union, inter_union_diff]
+  ... ≤ μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ (s ∩ ({x} + r • (t \ closed_ball 0 n))) :
+    measure_union_le _ _
+  ... ≤ μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ ({x} + r • (t \ closed_ball 0 n)) :
+    add_le_add le_rfl (measure_mono (inter_subset_right _ _)),
+  calc μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)
+  ≤ (μ (s ∩ ({x} + r • (t ∩ closed_ball 0 n))) + μ ({x} + r • (t \ closed_ball 0 n))) /
+      μ ({x} + r • t) : mul_le_mul_right' I _
+  ... < ε / 2 + ε / 2 :
+    begin
+      rw ennreal.add_div,
+      apply ennreal.add_lt_add hr _,
+      rwa [add_haar_singleton_add_smul_div_singleton_add_smul μ rpos.ne',
+           ennreal.div_lt_iff (or.inl h't) (or.inl h''t)],
+    end
+  ... = ε : ennreal.add_halves _
+end
+
+lemma tendsto_add_haar_inter_smul_one_of_density_one_aux
+  (s : set E) (hs : measurable_set s) (x : E)
+  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1))
+  (t : set E) (ht : measurable_set t) (h't : μ t ≠ 0) (h''t : μ t ≠ ∞) :
+  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 1) :=
+begin
+  have I : ∀ u v, μ u ≠ 0 → μ u ≠ ∞ → measurable_set v →
+    μ u / μ u - μ (vᶜ ∩ u) / μ u = μ (v ∩ u) / μ u,
+  { assume u v uzero utop vmeas,
+    simp_rw [div_eq_mul_inv],
+    rw ← ennreal.sub_mul, swap,
+    { simp only [uzero, ennreal.inv_eq_top, implies_true_iff, ne.def, not_false_iff] },
+    congr' 1,
+    apply ennreal.sub_eq_of_add_eq
+      (ne_top_of_le_ne_top utop (measure_mono (inter_subset_right _ _))),
+    rw [inter_comm _ u, inter_comm _ u],
+    exact measure_inter_add_diff u vmeas },
+  have L : tendsto (λ r, μ (sᶜ ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 0),
+  { have A : tendsto (λ r, μ (closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1),
+    { apply tendsto_const_nhds.congr' _,
+      filter_upwards [self_mem_nhds_within],
+      assume r hr,
+      rw [div_eq_mul_inv, ennreal.mul_inv_cancel],
+      { exact (measure_closed_ball_pos μ _ hr).ne' },
+      { exact measure_closed_ball_lt_top.ne } },
+    have B := ennreal.tendsto.sub A h (or.inl ennreal.one_ne_top),
+    simp only [tsub_self] at B,
+    apply B.congr' _,
+    filter_upwards [self_mem_nhds_within],
+    rintros r (rpos : 0 < r),
+    convert I (closed_ball x r) sᶜ (measure_closed_ball_pos μ _ rpos).ne'
+      (measure_closed_ball_lt_top).ne hs.compl,
+    rw compl_compl },
+  have L' : tendsto (λ (r : ℝ), μ (sᶜ ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 0) :=
+    tendsto_add_haar_inter_smul_zero_of_density_zero μ sᶜ x L t ht h''t,
+  have L'' : tendsto (λ (r : ℝ), μ ({x} + r • t) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 1),
+  { apply tendsto_const_nhds.congr' _,
+    filter_upwards [self_mem_nhds_within],
+    rintros r (rpos : 0 < r),
+    rw [add_haar_singleton_add_smul_div_singleton_add_smul μ rpos.ne', ennreal.div_self h't h''t] },
+  have := ennreal.tendsto.sub L'' L' (or.inl ennreal.one_ne_top),
+  simp only [tsub_zero] at this,
+  apply this.congr' _,
+  filter_upwards [self_mem_nhds_within],
+  rintros r (rpos : 0 < r),
+  refine I ({x} + r • t) s _ _ hs,
+  { simp only [h't, abs_of_nonneg rpos.le, pow_pos rpos, add_haar_smul, image_add_left,
+      ennreal.of_real_eq_zero, not_le, or_false, ne.def, measure_preimage_add, abs_pow,
+      singleton_add, mul_eq_zero] },
+  { simp only [h''t, ennreal.of_real_ne_top, add_haar_smul, image_add_left, with_top.mul_eq_top_iff,
+      ne.def, not_false_iff, measure_preimage_add, singleton_add, and_false, false_and, or_self] }
+end
+
+/-- Consider a point `x` at which a set `s` has density one, with respect to closed balls (i.e.,
+a Lebesgue density point of `s`). Then `s` has also density one at `x` with respect to any
+measurable set `t`: the proportion of points in `s` belonging to a rescaled copy `{x} + r • t`
+of `t` tends to one as `r` tends to zero. -/
+lemma tendsto_add_haar_inter_smul_one_of_density_one
+  (s : set E) (x : E)
+  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1))
+  (t : set E) (ht : measurable_set t) (h't : μ t ≠ 0) (h''t : μ t ≠ ∞) :
+  tendsto (λ (r : ℝ), μ (s ∩ ({x} + r • t)) / μ ({x} + r • t)) (𝓝[>] 0) (𝓝 1) :=
+begin
+  have : tendsto (λ (r : ℝ), μ (to_measurable μ s ∩ ({x} + r • t)) / μ ({x} + r • t))
+    (𝓝[>] 0) (𝓝 1),
+  { apply tendsto_add_haar_inter_smul_one_of_density_one_aux μ _
+      (measurable_set_to_measurable _ _) _ _ t ht h't h''t,
+    apply tendsto_of_tendsto_of_tendsto_of_le_of_le' h tendsto_const_nhds,
+    { refine eventually_of_forall (λ r, mul_le_mul_right' _ _),
+      exact measure_mono (inter_subset_inter_left _ (subset_to_measurable _ _)) },
+    { filter_upwards [self_mem_nhds_within],
+      rintros r (rpos : 0 < r),
+      apply ennreal.div_le_of_le_mul,
+      rw one_mul,
+      exact measure_mono (inter_subset_right _ _) } },
+  apply this.congr (λ r, _),
+  congr' 1,
+  apply measure_to_measurable_inter_of_sigma_finite,
+  simp only [image_add_left, singleton_add],
+  apply (continuous_add_left (-x)).measurable (ht.const_smul₀ r)
+end
+
+/-- Consider a point `x` at which a set `s` has density one, with respect to closed balls (i.e.,
+a Lebesgue density point of `s`). Then `s` intersects the rescaled copies `{x} + r • t` of a given
+set `t` with positive measure, for any small enough `r`. -/
+lemma eventually_nonempty_inter_smul_of_density_one (s : set E) (x : E)
+  (h : tendsto (λ r, μ (s ∩ closed_ball x r) / μ (closed_ball x r)) (𝓝[>] 0) (𝓝 1))
+  (t : set E) (ht : measurable_set t) (h't : μ t ≠ 0) :
+  ∀ᶠ r in 𝓝[>] (0 : ℝ), (s ∩ ({x} + r • t)).nonempty :=
+begin
+  obtain ⟨t', t'_meas, t't, t'pos, t'top⟩ :
+    ∃ t', measurable_set t' ∧ t' ⊆ t ∧ 0 < μ t' ∧ μ t' < ⊤ :=
+      exists_subset_measure_lt_top ht h't.bot_lt,
+  filter_upwards [(tendsto_order.1
+    (tendsto_add_haar_inter_smul_one_of_density_one μ s x h t'
+      t'_meas t'pos.ne' t'top.ne)).1 0 zero_lt_one],
+  assume r hr,
+  have : μ (s ∩ ({x} + r • t')) ≠ 0 :=
+    λ h', by simpa only [ennreal.not_lt_zero, ennreal.zero_div, h'] using hr,
+  have : (s ∩ ({x} + r • t')).nonempty := nonempty_of_measure_ne_zero this,
+  apply this.mono (inter_subset_inter subset.rfl _),
+  exact add_subset_add subset.rfl (smul_set_mono t't),
+end
+
+end measure
+
+end measure_theory
diff --git a/src/measure_theory/measure/lebesgue/integral.lean b/src/measure_theory/measure/lebesgue/integral.lean
new file mode 100644
index 0000000000000..126802eae5fd5
--- /dev/null
+++ b/src/measure_theory/measure/lebesgue/integral.lean
@@ -0,0 +1,100 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Sébastien Gouëzel, Yury Kudryashov
+-/
+import measure_theory.integral.set_integral
+import measure_theory.measure.lebesgue.basic
+
+/-! # Properties of integration with respect to the Lebesgue measure 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
+
+open set filter measure_theory measure_theory.measure topological_space
+
+section region_between
+
+variable {α : Type*}
+variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}
+
+theorem volume_region_between_eq_integral' [sigma_finite μ]
+  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
+  (hs : measurable_set s) (hfg : f ≤ᵐ[μ.restrict s] g ) :
+  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
+begin
+  have h : g - f =ᵐ[μ.restrict s] (λ x, real.to_nnreal (g x - f x)),
+    from hfg.mono (λ x hx, (real.coe_to_nnreal _ $ sub_nonneg.2 hx).symm),
+  rw [volume_region_between_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
+    integral_congr_ae h, lintegral_congr_ae,
+    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))],
+  simpa only,
+end
+
+/-- If two functions are integrable on a measurable set, and one function is less than
+    or equal to the other on that set, then the volume of the region
+    between the two functions can be represented as an integral. -/
+theorem volume_region_between_eq_integral [sigma_finite μ]
+  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
+  (hs : measurable_set s) (hfg : ∀ x ∈ s, f x ≤ g x) :
+  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
+volume_region_between_eq_integral' f_int g_int hs
+  ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))
+
+end region_between
+
+section summable_norm_Icc
+
+open continuous_map
+
+/- The following lemma is a minor variation on `integrable_of_summable_norm_restrict` in
+`measure_theory.integral.set_integral`, but it is placed here because it needs to know that
+`Icc a b` has volume `b - a`. -/
+
+/-- If the sequence with `n`-th term the the sup norm of `λ x, f (x + n)` on the interval `Icc 0 1`,
+for `n ∈ ℤ`, is summable, then `f` is integrable on `ℝ`. -/
+lemma real.integrable_of_summable_norm_Icc {E : Type*} [normed_add_comm_group E] {f : C(ℝ, E)}
+  (hf : summable (λ n : ℤ, ‖(f.comp $ continuous_map.add_right n).restrict (Icc 0 1)‖)) :
+  integrable f :=
+begin
+  refine integrable_of_summable_norm_restrict (summable_of_nonneg_of_le
+    (λ n : ℤ, mul_nonneg (norm_nonneg (f.restrict (⟨Icc n (n + 1), is_compact_Icc⟩ : compacts ℝ)))
+    ennreal.to_real_nonneg) (λ n, _) hf) (Union_Icc_int_cast ℝ),
+  simp only [compacts.coe_mk, real.volume_Icc, add_sub_cancel', ennreal.to_real_of_real zero_le_one,
+    mul_one, norm_le _ (norm_nonneg _)],
+  intro x,
+  have := ((f.comp $ continuous_map.add_right n).restrict (Icc 0 1)).norm_coe_le_norm
+    ⟨x - n, ⟨sub_nonneg.mpr x.2.1, sub_le_iff_le_add'.mpr x.2.2⟩⟩,
+  simpa only [continuous_map.restrict_apply, comp_apply, coe_add_right, subtype.coe_mk,
+    sub_add_cancel]
+    using this,
+end
+
+end summable_norm_Icc
+
+/-!
+### Substituting `-x` for `x`
+
+These lemmas are stated in terms of either `Iic` or `Ioi` (neglecting `Iio` and `Ici`) to match
+mathlib's conventions for integrals over finite intervals (see `interval_integral`). For the case
+of finite integrals, see `interval_integral.integral_comp_neg`.
+-/
+
+@[simp] lemma integral_comp_neg_Iic {E : Type*}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] (c : ℝ) (f : ℝ → E) :
+  ∫ x in Iic c, f (-x) = ∫ x in Ioi (-c), f x :=
+begin
+  have A : measurable_embedding (λ x : ℝ, -x),
+    from (homeomorph.neg ℝ).closed_embedding.measurable_embedding,
+  have := A.set_integral_map f (Ici (-c)),
+  rw measure.map_neg_eq_self (volume : measure ℝ) at this,
+  simp_rw [←integral_Ici_eq_integral_Ioi, this, neg_preimage, preimage_neg_Ici, neg_neg],
+end
+
+@[simp] lemma integral_comp_neg_Ioi {E : Type*}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] (c : ℝ) (f : ℝ → E) :
+  ∫ x in Ioi c, f (-x) = ∫ x in Iic (-c), f x :=
+begin
+  rw [←neg_neg c, ←integral_comp_neg_Iic],
+  simp only [neg_neg],
+end
diff --git a/src/measure_theory/measure/measure_space.lean b/src/measure_theory/measure/measure_space.lean
index f8dfc0c70a098..9089d791ce8e2 100644
--- a/src/measure_theory/measure/measure_space.lean
+++ b/src/measure_theory/measure/measure_space.lean
@@ -5,10 +5,14 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import measure_theory.measure.null_measurable
 import measure_theory.measurable_space
+import topology.algebra.order.liminf_limsup
 
 /-!
 # Measure spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The definition of a measure and a measure space are in `measure_theory.measure_space_def`, with
 only a few basic properties. This file provides many more properties of these objects.
 This separation allows the measurability tactic to import only the file `measure_space_def`, and to
@@ -89,7 +93,7 @@ measure, almost everywhere, measure space, completion, null set, null measurable
 noncomputable theory
 
 open set filter (hiding map) function measurable_space topological_space (second_countable_topology)
-open_locale classical topological_space big_operators filter ennreal nnreal interval
+open_locale classical topology big_operators filter ennreal nnreal interval measure_theory
 
 variables {α β γ δ ι R R' : Type*}
 
@@ -103,10 +107,10 @@ instance ae_is_measurably_generated : is_measurably_generated μ.ae :=
 ⟨λ s hs, let ⟨t, hst, htm, htμ⟩ := exists_measurable_superset_of_null hs in
   ⟨tᶜ, compl_mem_ae_iff.2 htμ, htm.compl, compl_subset_comm.1 hst⟩⟩
 
-/-- See also `measure_theory.ae_restrict_interval_oc_iff`. -/
-lemma ae_interval_oc_iff [linear_order α] {a b : α} {P : α → Prop} :
+/-- See also `measure_theory.ae_restrict_uIoc_iff`. -/
+lemma ae_uIoc_iff [linear_order α] {a b : α} {P : α → Prop} :
   (∀ᵐ x ∂μ, x ∈ Ι a b → P x) ↔ (∀ᵐ x ∂μ, x ∈ Ioc a b → P x) ∧ (∀ᵐ x ∂μ, x ∈ Ioc b a → P x) :=
-by simp only [interval_oc_eq_union, mem_union_eq, or_imp_distrib, eventually_and]
+by simp only [uIoc_eq_union, mem_union, or_imp_distrib, eventually_and]
 
 lemma measure_union (hd : disjoint s₁ s₂) (h : measurable_set s₂) :
   μ (s₁ ∪ s₂) = μ s₁ + μ s₂ :=
@@ -135,33 +139,63 @@ by rw [union_comm, inter_comm, measure_union_add_inter t hs, add_comm]
 
 lemma measure_add_measure_compl (h : measurable_set s) :
   μ s + μ sᶜ = μ univ :=
-by { rw [← measure_union' _ h, union_compl_self], exact disjoint_compl_right }
+measure_add_measure_compl₀ h.null_measurable_set
 
-lemma measure_bUnion {s : set β} {f : β → set α} (hs : countable s)
-  (hd : s.pairwise (disjoint on f)) (h : ∀ b ∈ s, measurable_set (f b)) :
+lemma measure_bUnion₀ {s : set β} {f : β → set α} (hs : s.countable)
+  (hd : s.pairwise (ae_disjoint μ on f)) (h : ∀ b ∈ s, null_measurable_set (f b) μ) :
   μ (⋃ b ∈ s, f b) = ∑' p : s, μ (f p) :=
 begin
   haveI := hs.to_encodable,
   rw bUnion_eq_Union,
-  exact measure_Union (hd.on_injective subtype.coe_injective $ λ x, x.2) (λ x, h x x.2)
+  exact measure_Union₀ (hd.on_injective subtype.coe_injective $ λ x, x.2) (λ x, h x x.2)
 end
 
-lemma measure_sUnion {S : set (set α)} (hs : countable S)
+lemma measure_bUnion {s : set β} {f : β → set α} (hs : s.countable)
+  (hd : s.pairwise_disjoint f) (h : ∀ b ∈ s, measurable_set (f b)) :
+  μ (⋃ b ∈ s, f b) = ∑' p : s, μ (f p) :=
+measure_bUnion₀ hs hd.ae_disjoint (λ b hb, (h b hb).null_measurable_set)
+
+lemma measure_sUnion₀ {S : set (set α)} (hs : S.countable)
+  (hd : S.pairwise (ae_disjoint μ)) (h : ∀ s ∈ S, null_measurable_set s μ) :
+  μ (⋃₀ S) = ∑' s : S, μ s :=
+by rw [sUnion_eq_bUnion, measure_bUnion₀ hs hd h]
+
+lemma measure_sUnion {S : set (set α)} (hs : S.countable)
   (hd : S.pairwise disjoint) (h : ∀ s ∈ S, measurable_set s) :
   μ (⋃₀ S) = ∑' s : S, μ s :=
 by rw [sUnion_eq_bUnion, measure_bUnion hs hd h]
 
-lemma measure_bUnion_finset {s : finset ι} {f : ι → set α} (hd : set.pairwise ↑s (disjoint on f))
-  (hm : ∀ b ∈ s, measurable_set (f b)) :
+lemma measure_bUnion_finset₀ {s : finset ι} {f : ι → set α}
+  (hd : set.pairwise ↑s (ae_disjoint μ on f)) (hm : ∀ b ∈ s, null_measurable_set (f b) μ) :
   μ (⋃ b ∈ s, f b) = ∑ p in s, μ (f p) :=
 begin
   rw [← finset.sum_attach, finset.attach_eq_univ, ← tsum_fintype],
-  exact measure_bUnion s.countable_to_set hd hm
+  exact measure_bUnion₀ s.countable_to_set hd hm
+end
+
+lemma measure_bUnion_finset {s : finset ι} {f : ι → set α} (hd : pairwise_disjoint ↑s f)
+  (hm : ∀ b ∈ s, measurable_set (f b)) :
+  μ (⋃ b ∈ s, f b) = ∑ p in s, μ (f p) :=
+measure_bUnion_finset₀ hd.ae_disjoint (λ b hb, (hm b hb).null_measurable_set)
+
+/-- The measure of a disjoint union (even uncountable) of measurable sets is at least the sum of
+the measures of the sets. -/
+lemma tsum_meas_le_meas_Union_of_disjoint {ι : Type*} [measurable_space α] (μ : measure α)
+  {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) :
+  ∑' i, μ (As i) ≤ μ (⋃ i, As i) :=
+begin
+  rcases (show summable (λ i, μ (As i)), from ennreal.summable) with ⟨S, hS⟩,
+  rw [hS.tsum_eq],
+  refine tendsto_le_of_eventually_le hS tendsto_const_nhds (eventually_of_forall _),
+  intros s,
+  rw ← measure_bUnion_finset (λ i hi j hj hij, As_disj hij) (λ i _, As_mble i),
+  exact measure_mono (Union₂_subset_Union (λ (i : ι), i ∈ s) (λ (i : ι), As i)),
 end
 
 /-- If `s` is a countable set, then the measure of its preimage can be found as the sum of measures
 of the fibers `f ⁻¹' {y}`. -/
-lemma tsum_measure_preimage_singleton {s : set β} (hs : countable s) {f : α → β}
+lemma tsum_measure_preimage_singleton {s : set β} (hs : s.countable) {f : α → β}
   (hf : ∀ y ∈ s, measurable_set (f ⁻¹' {y})) :
   ∑' b : s, μ (f ⁻¹' {↑b}) = μ (f ⁻¹' s) :=
 by rw [← set.bUnion_preimage_singleton, measure_bUnion hs (pairwise_disjoint_fiber _ _) hf]
@@ -181,7 +215,7 @@ lemma measure_diff_null (h : μ s₂ = 0) : μ (s₁ \ s₂) = μ s₁ :=
 measure_diff_null' $ measure_mono_null (inter_subset_right _ _) h
 
 lemma measure_add_diff (hs : measurable_set s) (t : set α) : μ s + μ (t \ s) = μ (s ∪ t) :=
-by rw [← measure_union' disjoint_diff hs, union_diff_self]
+by rw [← measure_union' disjoint_sdiff_right hs, union_diff_self]
 
 lemma measure_diff' (s : set α) (hm : measurable_set t) (h_fin : μ t ≠ ∞) :
   μ (s \ t) = μ (s ∪ t) - μ t :=
@@ -226,24 +260,42 @@ begin
 end
 
 lemma measure_eq_measure_smaller_of_between_null_diff {s₁ s₂ s₃ : set α}
-  (h12 : s₁ ⊆ s₂) (h23 : s₂ ⊆ s₃) (h_nulldiff : μ (s₃.diff s₁) = 0) : μ s₁ = μ s₂ :=
+  (h12 : s₁ ⊆ s₂) (h23 : s₂ ⊆ s₃) (h_nulldiff : μ (s₃ \ s₁) = 0) : μ s₁ = μ s₂ :=
 (measure_eq_measure_of_between_null_diff h12 h23 h_nulldiff).1
 
 lemma measure_eq_measure_larger_of_between_null_diff {s₁ s₂ s₃ : set α}
-  (h12 : s₁ ⊆ s₂) (h23 : s₂ ⊆ s₃) (h_nulldiff : μ (s₃.diff s₁) = 0) : μ s₂ = μ s₃ :=
+  (h12 : s₁ ⊆ s₂) (h23 : s₂ ⊆ s₃) (h_nulldiff : μ (s₃ \ s₁) = 0) : μ s₂ = μ s₃ :=
 (measure_eq_measure_of_between_null_diff h12 h23 h_nulldiff).2
 
 lemma measure_compl (h₁ : measurable_set s) (h_fin : μ s ≠ ∞) : μ (sᶜ) = μ univ - μ s :=
 by { rw compl_eq_univ_diff, exact measure_diff (subset_univ s) h₁ h_fin }
 
+@[simp] lemma union_ae_eq_left_iff_ae_subset : (s ∪ t : set α) =ᵐ[μ] s ↔ t ≤ᵐ[μ] s :=
+begin
+  rw ae_le_set,
+  refine ⟨λ h, by simpa only [union_diff_left] using (ae_eq_set.mp h).1,
+    λ h, eventually_le_antisymm_iff.mpr
+    ⟨by rwa [ae_le_set, union_diff_left], has_subset.subset.eventually_le $ subset_union_left s t⟩⟩,
+end
+
+@[simp] lemma union_ae_eq_right_iff_ae_subset : (s ∪ t : set α) =ᵐ[μ] t ↔ s ≤ᵐ[μ] t :=
+by rw [union_comm, union_ae_eq_left_iff_ae_subset]
+
+lemma ae_eq_of_ae_subset_of_measure_ge (h₁ : s ≤ᵐ[μ] t) (h₂ : μ t ≤ μ s) (hsm : measurable_set s)
+  (ht : μ t ≠ ∞) : s =ᵐ[μ] t :=
+begin
+  refine eventually_le_antisymm_iff.mpr ⟨h₁, ae_le_set.mpr _⟩,
+  replace h₂ : μ t = μ s, from h₂.antisymm (measure_mono_ae h₁),
+  replace ht : μ s ≠ ∞, from h₂ ▸ ht,
+  rw [measure_diff' t hsm ht, measure_congr (union_ae_eq_left_iff_ae_subset.mpr h₁), h₂, tsub_self],
+end
+
 /-- If `s ⊆ t`, `μ t ≤ μ s`, `μ t ≠ ∞`, and `s` is measurable, then `s =ᵐ[μ] t`. -/
 lemma ae_eq_of_subset_of_measure_ge (h₁ : s ⊆ t) (h₂ : μ t ≤ μ s) (hsm : measurable_set s)
   (ht : μ t ≠ ∞) : s =ᵐ[μ] t :=
-have A : μ t = μ s, from h₂.antisymm (measure_mono h₁),
-have B : μ s ≠ ∞, from A ▸ ht,
-h₁.eventually_le.antisymm $ ae_le_set.2 $ by rw [measure_diff h₁ hsm B, A, tsub_self]
+ae_eq_of_ae_subset_of_measure_ge (has_subset.subset.eventually_le h₁) h₂ hsm ht
 
-lemma measure_Union_congr_of_subset [encodable β] {s : β → set α} {t : β → set α}
+lemma measure_Union_congr_of_subset [countable β] {s : β → set α} {t : β → set α}
   (hsub : ∀ b, s b ⊆ t b) (h_le : ∀ b, μ (t b) ≤ μ (s b)) :
   μ (⋃ b, s b) = μ (⋃ b, t b) :=
 begin
@@ -279,12 +331,12 @@ begin
   exact measure_Union_congr_of_subset (bool.forall_bool.2 ⟨ht, hs⟩) (bool.forall_bool.2 ⟨htμ, hsμ⟩)
 end
 
-@[simp] lemma measure_Union_to_measurable [encodable β] (s : β → set α) :
+@[simp] lemma measure_Union_to_measurable [countable β] (s : β → set α) :
   μ (⋃ b, to_measurable μ (s b)) = μ (⋃ b, s b) :=
 eq.symm $ measure_Union_congr_of_subset (λ b, subset_to_measurable _ _)
   (λ b, (measure_to_measurable _).le)
 
-lemma measure_bUnion_to_measurable {I : set β} (hc : countable I) (s : β → set α) :
+lemma measure_bUnion_to_measurable {I : set β} (hc : I.countable) (s : β → set α) :
   μ (⋃ b ∈ I, to_measurable μ (s b)) = μ (⋃ b ∈ I, s b) :=
 by { haveI := hc.to_encodable, simp only [bUnion_eq_Union, measure_Union_to_measurable] }
 
@@ -297,7 +349,7 @@ eq.symm $ measure_union_congr_of_subset subset.rfl le_rfl (subset_to_measurable
   (measure_to_measurable _).le
 
 lemma sum_measure_le_measure_univ {s : finset ι} {t : ι → set α} (h : ∀ i ∈ s, measurable_set (t i))
-  (H : set.pairwise ↑s (disjoint on t)) :
+  (H : set.pairwise_disjoint ↑s t) :
   ∑ i in s, μ (t i) ≤ μ (univ : set α) :=
 by { rw ← measure_bUnion_finset H h, exact measure_mono (subset_univ _) }
 
@@ -306,7 +358,7 @@ lemma tsum_measure_le_measure_univ {s : ι → set α} (hs : ∀ i, measurable_s
   ∑' i, μ (s i) ≤ μ (univ : set α) :=
 begin
   rw [ennreal.tsum_eq_supr_sum],
-  exact supr_le (λ s, sum_measure_le_measure_univ (λ i hi, hs i) (λ i hi j hj hij, H i j hij))
+  exact supr_le (λ s, sum_measure_le_measure_univ (λ i hi, hs i) (λ i hi j hj hij, H hij))
 end
 
 /-- Pigeonhole principle for measure spaces: if `∑' i, μ (s i) > μ univ`, then
@@ -317,7 +369,9 @@ lemma exists_nonempty_inter_of_measure_univ_lt_tsum_measure {m : measurable_spac
 begin
   contrapose! H,
   apply tsum_measure_le_measure_univ hs,
-  exact λ i j hij x hx, H i j hij ⟨x, hx⟩
+  intros i j hij,
+  rw [function.on_fun, disjoint_iff_inf_le],
+  exact λ x hx, H i j hij ⟨x, hx⟩
 end
 
 /-- Pigeonhole principle for measure spaces: if `s` is a `finset` and
@@ -329,7 +383,9 @@ lemma exists_nonempty_inter_of_measure_univ_lt_sum_measure {m : measurable_space
 begin
   contrapose! H,
   apply sum_measure_le_measure_univ h,
-  exact λ i hi j hj hij x hx, H i hi j hj hij ⟨x, hx⟩
+  intros i hi j hj hij,
+  rw [function.on_fun, disjoint_iff_inf_le],
+  exact λ x hx, H i hi j hj hij ⟨x, hx⟩
 end
 
 /-- If two sets `s` and `t` are included in a set `u`, and `μ s + μ t > μ u`,
@@ -340,9 +396,9 @@ lemma nonempty_inter_of_measure_lt_add
   (h : μ u < μ s + μ t) :
   (s ∩ t).nonempty :=
 begin
+  rw ←set.not_disjoint_iff_nonempty_inter,
   contrapose! h,
-  calc μ s + μ t = μ (s ∪ t) :
-    by { rw measure_union _ ht, exact λ x hx, h ⟨x, hx⟩ }
+  calc μ s + μ t = μ (s ∪ t) : (measure_union h ht).symm
   ... ≤ μ u : measure_mono (union_subset h's h't)
 end
 
@@ -361,14 +417,15 @@ end
 
 /-- Continuity from below: the measure of the union of a directed sequence of (not necessarily
 -measurable) sets is the supremum of the measures. -/
-lemma measure_Union_eq_supr [encodable ι] {s : ι → set α} (hd : directed (⊆) s) :
+lemma measure_Union_eq_supr [countable ι] {s : ι → set α} (hd : directed (⊆) s) :
   μ (⋃ i, s i) = ⨆ i, μ (s i) :=
 begin
+  casesI nonempty_encodable ι,
   -- WLOG, `ι = ℕ`
   generalize ht : function.extend encodable.encode s ⊥ = t,
   replace hd : directed (⊆) t := ht ▸ hd.extend_bot encodable.encode_injective,
   suffices : μ (⋃ n, t n) = ⨆ n, μ (t n),
-  { simp only [← ht, apply_extend encodable.encode_injective μ, ← supr_eq_Union,
+  { simp only [← ht, encodable.encode_injective.apply_extend μ, ← supr_eq_Union,
       supr_extend_bot encodable.encode_injective, (∘), pi.bot_apply, bot_eq_empty,
       measure_empty] at this,
     exact this.trans (supr_extend_bot encodable.encode_injective _) },
@@ -394,7 +451,7 @@ begin
   ... ≤ ⨆ n, μ (t n) : le_supr (μ ∘ t) N,
 end
 
-lemma measure_bUnion_eq_supr {s : ι → set α} {t : set ι} (ht : countable t)
+lemma measure_bUnion_eq_supr {s : ι → set α} {t : set ι} (ht : t.countable)
   (hd : directed_on ((⊆) on s) t) :
   μ (⋃ i ∈ t, s i) = ⨆ i ∈ t, μ (s i) :=
 begin
@@ -404,7 +461,7 @@ end
 
 /-- Continuity from above: the measure of the intersection of a decreasing sequence of measurable
 sets is the infimum of the measures. -/
-lemma measure_Inter_eq_infi [encodable ι] {s : ι → set α}
+lemma measure_Inter_eq_infi [countable ι] {s : ι → set α}
   (h : ∀ i, measurable_set (s i)) (hd : directed (⊇) s) (hfin : ∃ i, μ (s i) ≠ ∞) :
   μ (⋂ i, s i) = (⨅ i, μ (s i)) :=
 begin
@@ -420,14 +477,14 @@ begin
       use j,
       rw [← measure_diff hjk (h _) (this _ hjk)],
       exact measure_mono (diff_subset_diff_right hji) },
-    { rw [tsub_le_iff_right, ← measure_union disjoint_diff.symm (h i), set.union_comm],
+    { rw [tsub_le_iff_right, ← measure_union disjoint_sdiff_left (h i), set.union_comm],
       exact measure_mono (diff_subset_iff.1 $ subset.refl _) } },
   { exact hd.mono_comp _ (λ _ _, diff_subset_diff_right) }
 end
 
 /-- Continuity from below: the measure of the union of an increasing sequence of measurable sets
 is the limit of the measures. -/
-lemma tendsto_measure_Union [semilattice_sup ι] [encodable ι] {s : ι → set α} (hm : monotone s) :
+lemma tendsto_measure_Union [semilattice_sup ι] [countable ι] {s : ι → set α} (hm : monotone s) :
   tendsto (μ ∘ s) at_top (𝓝 (μ (⋃ n, s n))) :=
 begin
   rw measure_Union_eq_supr (directed_of_sup hm),
@@ -436,7 +493,7 @@ end
 
 /-- Continuity from above: the measure of the intersection of a decreasing sequence of measurable
 sets is the limit of the measures. -/
-lemma tendsto_measure_Inter [encodable ι] [semilattice_sup ι] {s : ι → set α}
+lemma tendsto_measure_Inter [countable ι] [semilattice_sup ι] {s : ι → set α}
   (hs : ∀ n, measurable_set (s n)) (hm : antitone s) (hf : ∃ i, μ (s i) ≠ ∞) :
   tendsto (μ ∘ s) at_top (𝓝 (μ (⋂ n, s n))) :=
 begin
@@ -487,13 +544,13 @@ end
 
 /-- One direction of the **Borel-Cantelli lemma**: if (sᵢ) is a sequence of sets such
 that `∑ μ sᵢ` is finite, then the limit superior of the `sᵢ` is a null set. -/
-lemma measure_limsup_eq_zero {s : ℕ → set α} (hs : ∑' i, μ (s i) ≠ ∞) : μ (limsup at_top s) = 0 :=
+lemma measure_limsup_eq_zero {s : ℕ → set α} (hs : ∑' i, μ (s i) ≠ ∞) : μ (limsup s at_top) = 0 :=
 begin
   -- First we replace the sequence `sₙ` with a sequence of measurable sets `tₙ ⊇ sₙ` of the same
   -- measure.
   set t : ℕ → set α := λ n, to_measurable μ (s n),
   have ht : ∑' i, μ (t i) ≠ ∞, by simpa only [t, measure_to_measurable] using hs,
-  suffices : μ (limsup at_top t) = 0,
+  suffices : μ (limsup t at_top) = 0,
   { have A : s ≤ t := λ n, subset_to_measurable μ (s n),
     -- TODO default args fail
     exact measure_mono_null (limsup_le_limsup (eventually_of_forall (pi.le_def.mp A))
@@ -511,6 +568,42 @@ begin
   exact λ ⟨i, hi⟩, ⟨i + (m - n), by simpa only [add_assoc, tsub_add_cancel_of_le hnm] using hi⟩
 end
 
+lemma measure_liminf_eq_zero {s : ℕ → set α} (h : ∑' i, μ (s i) ≠ ⊤) : μ (liminf s at_top) = 0 :=
+begin
+  rw ← le_zero_iff,
+  have : liminf s at_top ≤ limsup s at_top :=
+    liminf_le_limsup (by is_bounded_default) (by is_bounded_default),
+  exact (μ.mono this).trans (by simp [measure_limsup_eq_zero h]),
+end
+
+lemma limsup_ae_eq_of_forall_ae_eq (s : ℕ → set α) {t : set α} (h : ∀ n, s n =ᵐ[μ] t) :
+  -- Need `@` below because of diamond; see gh issue #16932
+  @limsup (set α) ℕ _ s at_top =ᵐ[μ] t :=
+begin
+  simp_rw ae_eq_set at h ⊢,
+  split,
+  { rw at_top.limsup_sdiff s t,
+    apply measure_limsup_eq_zero,
+    simp [h], },
+  { rw at_top.sdiff_limsup s t,
+    apply measure_liminf_eq_zero,
+    simp [h], },
+end
+
+lemma liminf_ae_eq_of_forall_ae_eq (s : ℕ → set α) {t : set α} (h : ∀ n, s n =ᵐ[μ] t) :
+  -- Need `@` below because of diamond; see gh issue #16932
+  @liminf (set α) ℕ _ s at_top =ᵐ[μ] t :=
+begin
+  simp_rw ae_eq_set at h ⊢,
+  split,
+  { rw at_top.liminf_sdiff s t,
+    apply measure_liminf_eq_zero,
+    simp [h], },
+  { rw at_top.sdiff_liminf s t,
+    apply measure_limsup_eq_zero,
+    simp [h], },
+end
+
 lemma measure_if {x : β} {t : set β} {s : set α} :
   μ (if x ∈ t then s else ∅) = indicator t (λ _, μ s) x :=
 by { split_ifs; simp [h] }
@@ -605,8 +698,11 @@ instance [measurable_space α] : has_zero (measure α) :=
 
 @[simp, norm_cast] theorem coe_zero {m : measurable_space α} : ⇑(0 : measure α) = 0 := rfl
 
+instance [is_empty α] {m : measurable_space α} : subsingleton (measure α) :=
+⟨λ μ ν, by{ ext1 s hs, simp only [eq_empty_of_is_empty s, measure_empty] }⟩
+
 lemma eq_zero_of_is_empty [is_empty α] {m : measurable_space α} (μ : measure α) : μ = 0 :=
-ext $ λ s hs, by simp only [eq_empty_of_is_empty s, measure_empty]
+subsingleton.elim μ 0
 
 instance [measurable_space α] : inhabited (measure α) := ⟨0⟩
 
@@ -627,11 +723,11 @@ instance [measurable_space α] : has_add (measure α) :=
 theorem add_apply {m : measurable_space α} (μ₁ μ₂ : measure α) (s : set α) :
   (μ₁ + μ₂) s = μ₁ s + μ₂ s := rfl
 
-section has_scalar
-variables [has_scalar R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
-variables [has_scalar R' ℝ≥0∞] [is_scalar_tower R' ℝ≥0∞ ℝ≥0∞]
+section has_smul
+variables [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+variables [has_smul R' ℝ≥0∞] [is_scalar_tower R' ℝ≥0∞ ℝ≥0∞]
 
-instance [measurable_space α] : has_scalar R (measure α) :=
+instance [measurable_space α] : has_smul R (measure α) :=
 ⟨λ c μ,
   { to_outer_measure := c • μ.to_outer_measure,
     m_Union := λ s hs hd, begin
@@ -657,15 +753,15 @@ instance [smul_comm_class R R' ℝ≥0∞] [measurable_space α] :
   smul_comm_class R R' (measure α) :=
 ⟨λ _ _ _, ext $ λ _ _, smul_comm _ _ _⟩
 
-instance [has_scalar R R'] [is_scalar_tower R R' ℝ≥0∞] [measurable_space α] :
+instance [has_smul R R'] [is_scalar_tower R R' ℝ≥0∞] [measurable_space α] :
   is_scalar_tower R R' (measure α) :=
 ⟨λ _ _ _, ext $ λ _ _, smul_assoc _ _ _⟩
 
-instance [has_scalar Rᵐᵒᵖ ℝ≥0∞] [is_central_scalar R ℝ≥0∞] [measurable_space α] :
+instance [has_smul Rᵐᵒᵖ ℝ≥0∞] [is_central_scalar R ℝ≥0∞] [measurable_space α] :
   is_central_scalar R (measure α) :=
 ⟨λ _ _, ext $ λ _ _, op_smul_eq_smul _ _⟩
 
-end has_scalar
+end has_smul
 
 instance [monoid R] [mul_action R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] [measurable_space α] :
   mul_action R (measure α) :=
@@ -790,7 +886,7 @@ section Inf
 variables {m : set (measure α)}
 
 lemma Inf_caratheodory (s : set α) (hs : measurable_set s) :
-  (Inf (to_outer_measure '' m)).caratheodory.measurable_set' s :=
+  measurable_set[(Inf (to_outer_measure '' m)).caratheodory] s :=
 begin
   rw [outer_measure.Inf_eq_bounded_by_Inf_gen],
   refine outer_measure.bounded_by_caratheodory (λ t, _),
@@ -842,6 +938,17 @@ instance [measurable_space α] : complete_lattice (measure α) :=
 
 end Inf
 
+@[simp] lemma _root_.measure_theory.outer_measure.to_measure_top [measurable_space α] :
+  (⊤ : outer_measure α).to_measure (by rw [outer_measure.top_caratheodory]; exact le_top)
+    = (⊤ : measure α) :=
+top_unique $ λ s hs,
+    by cases s.eq_empty_or_nonempty with h h;
+      simp [h, to_measure_apply ⊤ _ hs, outer_measure.top_apply]
+
+@[simp] lemma to_outer_measure_top [measurable_space α] :
+  (⊤ : measure α).to_outer_measure = (⊤ : outer_measure α) :=
+by rw [←outer_measure.to_measure_top, to_measure_to_outer_measure, outer_measure.trim_top]
+
 @[simp] lemma top_add : ⊤ + μ = ⊤ := top_unique $ measure.le_add_right le_rfl
 @[simp] lemma add_top : μ + ⊤ = ⊤ := top_unique $ measure.le_add_left le_rfl
 
@@ -853,6 +960,10 @@ lemma nonpos_iff_eq_zero' : μ ≤ 0 ↔ μ = 0 :=
 @[simp] lemma measure_univ_eq_zero : μ univ = 0 ↔ μ = 0 :=
 ⟨λ h, bot_unique $ λ s hs, trans_rel_left (≤) (measure_mono (subset_univ s)) h, λ h, h.symm ▸ rfl⟩
 
+lemma measure_univ_ne_zero : μ univ ≠ 0 ↔ μ ≠ 0 := measure_univ_eq_zero.not
+
+@[simp] lemma measure_univ_pos : 0 < μ univ ↔ μ ≠ 0 := pos_iff_ne_zero.trans measure_univ_ne_zero
+
 /-! ### Pushforward and pullback -/
 
 /-- Lift a linear map between `outer_measure` spaces such that for each measure `μ` every measurable
@@ -932,7 +1043,7 @@ begin
     simp [map_of_not_ae_measurable, hf, hg] }
 end
 
-@[simp] lemma map_smul (c : ℝ≥0∞) (μ : measure α) (f : α → β) :
+@[simp] protected lemma map_smul (c : ℝ≥0∞) (μ : measure α) (f : α → β) :
   (c • μ).map f = c • μ.map f :=
 begin
   rcases eq_or_ne c 0 with rfl|hc, { simp },
@@ -950,6 +1061,10 @@ begin
     simp [map_of_not_ae_measurable hf, map_of_not_ae_measurable hfc] }
 end
 
+@[simp] protected lemma map_smul_nnreal (c : ℝ≥0) (μ : measure α) (f : α → β) :
+  (c • μ).map f = c • μ.map f :=
+μ.map_smul (c : ℝ≥0∞) f
+
 /-- We can evaluate the pushforward on measurable sets. For non-measurable sets, see
   `measure_theory.measure.le_map_apply` and `measurable_equiv.map_apply`. -/
 @[simp] theorem map_apply_of_ae_measurable
@@ -1004,27 +1119,185 @@ lemma tendsto_ae_map {f : α → β} (hf : ae_measurable f μ) : tendsto f μ.ae
 
 omit m0
 
-/-- Pullback of a `measure`. If `f` sends each `measurable` set to a `measurable` set, then for each
-measurable set `s` we have `comap f μ s = μ (f '' s)`. -/
-def comap [measurable_space α] (f : α → β) : measure β →ₗ[ℝ≥0∞] measure α :=
+/-- Pullback of a `measure` as a linear map. If `f` sends each measurable set to a measurable
+set, then for each measurable set `s` we have `comapₗ f μ s = μ (f '' s)`.
+
+If the linearity is not needed, please use `comap` instead, which works for a larger class of
+functions. -/
+def comapₗ [measurable_space α] (f : α → β) : measure β →ₗ[ℝ≥0∞] measure α :=
 if hf : injective f ∧ ∀ s, measurable_set s → measurable_set (f '' s) then
   lift_linear (outer_measure.comap f) $ λ μ s hs t,
   begin
-    simp only [coe_to_outer_measure, outer_measure.comap_apply, ← image_inter hf.1,
-      image_diff hf.1],
+    simp only [coe_to_outer_measure, outer_measure.comap_apply, image_inter hf.1, image_diff hf.1],
     apply le_to_outer_measure_caratheodory,
     exact hf.2 s hs
   end
 else 0
 
+lemma comapₗ_apply {β} [measurable_space α] {mβ : measurable_space β}
+  (f : α → β) (hfi : injective f)
+  (hf : ∀ s, measurable_set s → measurable_set (f '' s)) (μ : measure β) (hs : measurable_set s) :
+  comapₗ f μ s = μ (f '' s) :=
+begin
+  rw [comapₗ, dif_pos, lift_linear_apply _ hs, outer_measure.comap_apply, coe_to_outer_measure],
+  exact ⟨hfi, hf⟩
+end
+
+/-- Pullback of a `measure`. If `f` sends each measurable set to a null-measurable set,
+then for each measurable set `s` we have `comap f μ s = μ (f '' s)`. -/
+def comap [measurable_space α] (f : α → β) (μ : measure β) : measure α :=
+if hf : injective f ∧ ∀ s, measurable_set s → null_measurable_set (f '' s) μ then
+  (outer_measure.comap f μ.to_outer_measure).to_measure $ λ s hs t,
+  begin
+    simp only [coe_to_outer_measure, outer_measure.comap_apply, image_inter hf.1, image_diff hf.1],
+    exact (measure_inter_add_diff₀ _ (hf.2 s hs)).symm
+  end
+else 0
+
+lemma comap_apply₀ [measurable_space α] (f : α → β) (μ : measure β) (hfi : injective f)
+  (hf : ∀ s, measurable_set s → null_measurable_set (f '' s) μ)
+  (hs : null_measurable_set s (comap f μ)) :
+   comap f μ s = μ (f '' s) :=
+begin
+  rw [comap, dif_pos (and.intro hfi hf)] at hs ⊢,
+  rw [to_measure_apply₀ _ _ hs, outer_measure.comap_apply, coe_to_outer_measure]
+end
+
+lemma le_comap_apply {β} [measurable_space α] {mβ : measurable_space β} (f : α → β) (μ : measure β)
+  (hfi : injective f) (hf : ∀ s, measurable_set s → null_measurable_set (f '' s) μ) (s : set α) :
+  μ (f '' s) ≤ comap f μ s :=
+by { rw [comap, dif_pos (and.intro hfi hf)], exact le_to_measure_apply _ _ _, }
+
 lemma comap_apply {β} [measurable_space α] {mβ : measurable_space β} (f : α → β) (hfi : injective f)
   (hf : ∀ s, measurable_set s → measurable_set (f '' s)) (μ : measure β) (hs : measurable_set s) :
   comap f μ s = μ (f '' s) :=
+comap_apply₀ f μ hfi (λ s hs, (hf s hs).null_measurable_set) hs.null_measurable_set
+
+lemma comapₗ_eq_comap {β} [measurable_space α] {mβ : measurable_space β} (f : α → β)
+  (hfi : injective f) (hf : ∀ s, measurable_set s → measurable_set (f '' s))
+  (μ : measure β) (hs : measurable_set s) :
+  comapₗ f μ s = comap f μ s :=
+(comapₗ_apply f hfi hf μ hs).trans (comap_apply f hfi hf μ hs).symm
+
+lemma measure_image_eq_zero_of_comap_eq_zero {β} [measurable_space α] {mβ : measurable_space β}
+  (f : α → β) (μ : measure β) (hfi : injective f)
+  (hf : ∀ s, measurable_set s → null_measurable_set (f '' s) μ) {s : set α} (hs : comap f μ s = 0) :
+  μ (f '' s) = 0 :=
+le_antisymm ((le_comap_apply f μ hfi hf s).trans hs.le) (zero_le _)
+
+lemma ae_eq_image_of_ae_eq_comap {β} [measurable_space α] {mβ : measurable_space β}
+  (f : α → β) (μ : measure β) (hfi : injective f)
+  (hf : ∀ s, measurable_set s → null_measurable_set (f '' s) μ) {s t : set α}
+  (hst : s =ᵐ[comap f μ] t) :
+  f '' s =ᵐ[μ] f '' t :=
 begin
-  rw [comap, dif_pos, lift_linear_apply _ hs, outer_measure.comap_apply, coe_to_outer_measure],
-  exact ⟨hfi, hf⟩
+  rw [eventually_eq, ae_iff] at hst ⊢,
+  have h_eq_α : {a : α | ¬s a = t a} = s \ t ∪ t \ s,
+  { ext1 x, simp only [eq_iff_iff, mem_set_of_eq, mem_union, mem_diff], tauto, },
+  have h_eq_β : {a : β | ¬(f '' s) a = (f '' t) a} = f '' s \ f '' t ∪ f '' t \ f '' s,
+  { ext1 x, simp only [eq_iff_iff, mem_set_of_eq, mem_union, mem_diff], tauto, },
+  rw [← set.image_diff hfi, ← set.image_diff hfi, ← set.image_union] at h_eq_β,
+  rw h_eq_β,
+  rw h_eq_α at hst,
+  exact measure_image_eq_zero_of_comap_eq_zero f μ hfi hf hst,
 end
 
+lemma null_measurable_set.image {β} [measurable_space α] {mβ : measurable_space β}
+  (f : α → β) (μ : measure β) (hfi : injective f)
+  (hf : ∀ s, measurable_set s → null_measurable_set (f '' s) μ) {s : set α}
+  (hs : null_measurable_set s (μ.comap f)) :
+  null_measurable_set (f '' s) μ :=
+begin
+  refine ⟨to_measurable μ (f '' (to_measurable (μ.comap f) s)),
+    measurable_set_to_measurable _ _, _⟩,
+  refine eventually_eq.trans _ (null_measurable_set.to_measurable_ae_eq _).symm,
+  swap, { exact hf _ (measurable_set_to_measurable _ _), },
+  have h : to_measurable (comap f μ) s =ᵐ[comap f μ] s,
+    from @null_measurable_set.to_measurable_ae_eq _ _ (μ.comap f : measure α) s hs,
+  exact ae_eq_image_of_ae_eq_comap f μ hfi hf h.symm,
+end
+
+lemma comap_preimage {β} [measurable_space α] {mβ : measurable_space β} (f : α → β) (μ : measure β)
+  {s : set β} (hf : injective f) (hf' : measurable f)
+  (h : ∀ t, measurable_set t → null_measurable_set (f '' t) μ) (hs : measurable_set s) :
+  μ.comap f (f ⁻¹' s) = μ (s ∩ range f) :=
+by rw [comap_apply₀ _ _ hf h (hf' hs).null_measurable_set, image_preimage_eq_inter_range]
+
+section subtype
+
+/-! ### Subtype of a measure space -/
+
+section comap_any_measure
+
+lemma measurable_set.null_measurable_set_subtype_coe
+  {t : set s} (hs : null_measurable_set s μ) (ht : measurable_set t) :
+  null_measurable_set ((coe : s → α) '' t) μ :=
+begin
+  rw [subtype.measurable_space, comap_eq_generate_from] at ht,
+  refine generate_from_induction
+    (λ t : set s, null_measurable_set (coe '' t) μ)
+    {t : set s | ∃ (s' : set α), measurable_set s' ∧ coe ⁻¹' s' = t} _ _ _ _ ht,
+  { rintros t' ⟨s', hs', rfl⟩,
+    rw [subtype.image_preimage_coe],
+    exact hs'.null_measurable_set.inter hs, },
+  { simp only [image_empty, null_measurable_set_empty], },
+  { intro t',
+    simp only [←range_diff_image subtype.coe_injective, subtype.range_coe_subtype, set_of_mem_eq],
+    exact hs.diff, },
+  { intro f,
+    rw image_Union,
+    exact null_measurable_set.Union, },
+end
+
+lemma null_measurable_set.subtype_coe {t : set s} (hs : null_measurable_set s μ)
+  (ht : null_measurable_set t (μ.comap subtype.val)) :
+  null_measurable_set ((coe : s → α) '' t) μ :=
+null_measurable_set.image coe μ subtype.coe_injective
+  (λ t, measurable_set.null_measurable_set_subtype_coe hs) ht
+
+lemma measure_subtype_coe_le_comap (hs : null_measurable_set s μ) (t : set s) :
+  μ ((coe : s → α) '' t) ≤ μ.comap subtype.val t :=
+le_comap_apply _ _ subtype.coe_injective (λ t, measurable_set.null_measurable_set_subtype_coe hs) _
+
+lemma measure_subtype_coe_eq_zero_of_comap_eq_zero (hs : null_measurable_set s μ)
+  {t : set s} (ht : μ.comap subtype.val t = 0) :
+  μ ((coe : s → α) '' t) = 0 :=
+eq_bot_iff.mpr $ (measure_subtype_coe_le_comap hs t).trans ht.le
+
+end comap_any_measure
+
+section measure_space
+variables [measure_space α] {p : α → Prop}
+
+instance subtype.measure_space : measure_space (subtype p) :=
+{ volume := measure.comap subtype.val volume,
+  ..subtype.measurable_space }
+
+lemma subtype.volume_def : (volume : measure s) = volume.comap subtype.val := rfl
+
+lemma subtype.volume_univ (hs : null_measurable_set s) :
+  volume (univ : set s) = volume s :=
+begin
+  rw [subtype.volume_def, comap_apply₀ _ _ _ _ measurable_set.univ.null_measurable_set],
+  { congr, simp only [subtype.val_eq_coe, image_univ, subtype.range_coe_subtype, set_of_mem_eq], },
+  { exact subtype.coe_injective, },
+  { exact λ t, measurable_set.null_measurable_set_subtype_coe hs, },
+end
+
+lemma volume_subtype_coe_le_volume (hs : null_measurable_set s) (t : set s) :
+  volume ((coe : s → α) '' t) ≤ volume t :=
+measure_subtype_coe_le_comap hs t
+
+lemma volume_subtype_coe_eq_zero_of_volume_eq_zero (hs : null_measurable_set s)
+  {t : set s} (ht : volume t = 0) :
+  volume ((coe : s → α) '' t) = 0 :=
+measure_subtype_coe_eq_zero_of_comap_eq_zero hs ht
+
+end measure_space
+
+end subtype
+
+
 /-! ### Restricting a measure -/
 
 /-- Restrict a measure `μ` to a set `s` as an `ℝ≥0∞`-linear map. -/
@@ -1187,15 +1460,23 @@ restrict_eq_zero.2 h
 
 @[simp] lemma restrict_univ : μ.restrict univ = μ := ext $ λ s hs, by simp [hs]
 
-lemma restrict_union_add_inter₀ (s : set α) (ht : null_measurable_set t μ) :
-  μ.restrict (s ∪ t) + μ.restrict (s ∩ t) = μ.restrict s + μ.restrict t :=
+lemma restrict_inter_add_diff₀ (s : set α) (ht : null_measurable_set t μ) :
+  μ.restrict (s ∩ t) + μ.restrict (s \ t) = μ.restrict s :=
 begin
   ext1 u hu,
-  simp only [add_apply, restrict_apply hu, inter_union_distrib_left],
-  convert measure_union_add_inter₀ (u ∩ s) (hu.null_measurable_set.inter ht) using 3,
-  rw [set.inter_left_comm (u ∩ s), set.inter_assoc, ← set.inter_assoc u u, set.inter_self]
+  simp only [add_apply, restrict_apply hu, ← inter_assoc, diff_eq],
+  exact measure_inter_add_diff₀ (u ∩ s) ht
 end
 
+lemma restrict_inter_add_diff (s : set α) (ht : measurable_set t) :
+  μ.restrict (s ∩ t) + μ.restrict (s \ t) = μ.restrict s :=
+restrict_inter_add_diff₀ s ht.null_measurable_set
+
+lemma restrict_union_add_inter₀ (s : set α) (ht : null_measurable_set t μ) :
+  μ.restrict (s ∪ t) + μ.restrict (s ∩ t) = μ.restrict s + μ.restrict t :=
+by rw [← restrict_inter_add_diff₀ (s ∪ t) ht, union_inter_cancel_right, union_diff_right,
+ ← restrict_inter_add_diff₀ s ht, add_comm, ← add_assoc, add_right_comm]
+
 lemma restrict_union_add_inter (s : set α) (ht : measurable_set t) :
   μ.restrict (s ∪ t) + μ.restrict (s ∩ t) = μ.restrict s + μ.restrict t :=
 restrict_union_add_inter₀ s ht.null_measurable_set
@@ -1233,7 +1514,7 @@ begin
   apply measure_union_le
 end
 
-lemma restrict_Union_apply_ae [encodable ι] {s : ι → set α}
+lemma restrict_Union_apply_ae [countable ι] {s : ι → set α}
   (hd : pairwise (ae_disjoint μ on s))
   (hm : ∀ i, null_measurable_set (s i) μ) {t : set α} (ht : measurable_set t) :
   μ.restrict (⋃ i, s i) t = ∑' i, μ.restrict (s i) t :=
@@ -1243,12 +1524,12 @@ begin
     (λ i, (ht.null_measurable_set.inter (hm i)))
 end
 
-lemma restrict_Union_apply [encodable ι] {s : ι → set α} (hd : pairwise (disjoint on s))
+lemma restrict_Union_apply [countable ι] {s : ι → set α} (hd : pairwise (disjoint on s))
   (hm : ∀ i, measurable_set (s i)) {t : set α} (ht : measurable_set t) :
   μ.restrict (⋃ i, s i) t = ∑' i, μ.restrict (s i) t :=
-restrict_Union_apply_ae (hd.mono $ λ i j h, h.ae_disjoint) (λ i, (hm i).null_measurable_set) ht
+restrict_Union_apply_ae hd.ae_disjoint (λ i, (hm i).null_measurable_set) ht
 
-lemma restrict_Union_apply_eq_supr [encodable ι] {s : ι → set α}
+lemma restrict_Union_apply_eq_supr [countable ι] {s : ι → set α}
   (hd : directed (⊆) s) {t : set α} (ht : measurable_set t) :
   μ.restrict (⋃ i, s i) t = ⨆ i, μ.restrict (s i) t :=
 begin
@@ -1318,7 +1599,7 @@ begin
   rw [restrict_union_congr, ← hs]
 end
 
-lemma restrict_Union_congr [encodable ι] {s : ι → set α} :
+lemma restrict_Union_congr [countable ι] {s : ι → set α} :
   μ.restrict (⋃ i, s i) = ν.restrict (⋃ i, s i) ↔
     ∀ i, μ.restrict (s i) = ν.restrict (s i) :=
 begin
@@ -1331,7 +1612,7 @@ begin
     restrict_finset_bUnion_congr.2 (λ i hi, h i)],
 end
 
-lemma restrict_bUnion_congr {s : set ι} {t : ι → set α} (hc : countable s) :
+lemma restrict_bUnion_congr {s : set ι} {t : ι → set α} (hc : s.countable) :
   μ.restrict (⋃ i ∈ s, t i) = ν.restrict (⋃ i ∈ s, t i) ↔
     ∀ i ∈ s, μ.restrict (t i) = ν.restrict (t i) :=
 begin
@@ -1339,7 +1620,7 @@ begin
   simp only [bUnion_eq_Union, set_coe.forall', restrict_Union_congr]
 end
 
-lemma restrict_sUnion_congr {S : set (set α)} (hc : countable S) :
+lemma restrict_sUnion_congr {S : set (set α)} (hc : S.countable) :
   μ.restrict (⋃₀ S) = ν.restrict (⋃₀ S) ↔ ∀ s ∈ S, μ.restrict s = ν.restrict s :=
 by rw [sUnion_eq_bUnion, restrict_bUnion_congr hc]
 
@@ -1355,35 +1636,43 @@ begin
     outer_measure.restrict_apply]
 end
 
+lemma exists_mem_of_measure_ne_zero_of_ae (hs : μ s ≠ 0)
+  {p : α → Prop} (hp : ∀ᵐ x ∂μ.restrict s, p x) :
+  ∃ x, x ∈ s ∧ p x :=
+begin
+  rw [← μ.restrict_apply_self, ← frequently_ae_mem_iff] at hs,
+  exact (hs.and_eventually hp).exists,
+end
+
 /-! ### Extensionality results -/
 
 /-- Two measures are equal if they have equal restrictions on a spanning collection of sets
   (formulated using `Union`). -/
-lemma ext_iff_of_Union_eq_univ [encodable ι] {s : ι → set α} (hs : (⋃ i, s i) = univ) :
+lemma ext_iff_of_Union_eq_univ [countable ι] {s : ι → set α} (hs : (⋃ i, s i) = univ) :
   μ = ν ↔ ∀ i, μ.restrict (s i) = ν.restrict (s i) :=
 by rw [← restrict_Union_congr, hs, restrict_univ, restrict_univ]
 
-alias ext_iff_of_Union_eq_univ ↔ _ measure_theory.measure.ext_of_Union_eq_univ
+alias ext_iff_of_Union_eq_univ ↔ _ ext_of_Union_eq_univ
 
 /-- Two measures are equal if they have equal restrictions on a spanning collection of sets
   (formulated using `bUnion`). -/
-lemma ext_iff_of_bUnion_eq_univ {S : set ι} {s : ι → set α} (hc : countable S)
+lemma ext_iff_of_bUnion_eq_univ {S : set ι} {s : ι → set α} (hc : S.countable)
   (hs : (⋃ i ∈ S, s i) = univ) :
   μ = ν ↔ ∀ i ∈ S, μ.restrict (s i) = ν.restrict (s i) :=
 by rw [← restrict_bUnion_congr hc, hs, restrict_univ, restrict_univ]
 
-alias ext_iff_of_bUnion_eq_univ ↔ _ measure_theory.measure.ext_of_bUnion_eq_univ
+alias ext_iff_of_bUnion_eq_univ ↔ _ ext_of_bUnion_eq_univ
 
 /-- Two measures are equal if they have equal restrictions on a spanning collection of sets
   (formulated using `sUnion`). -/
-lemma ext_iff_of_sUnion_eq_univ {S : set (set α)} (hc : countable S) (hs : (⋃₀ S) = univ) :
+lemma ext_iff_of_sUnion_eq_univ {S : set (set α)} (hc : S.countable) (hs : (⋃₀ S) = univ) :
   μ = ν ↔ ∀ s ∈ S, μ.restrict s = ν.restrict s :=
 ext_iff_of_bUnion_eq_univ hc $ by rwa ← sUnion_eq_bUnion
 
-alias ext_iff_of_sUnion_eq_univ ↔ _ measure_theory.measure.ext_of_sUnion_eq_univ
+alias ext_iff_of_sUnion_eq_univ ↔ _ ext_of_sUnion_eq_univ
 
 lemma ext_of_generate_from_of_cover {S T : set (set α)}
-  (h_gen : ‹_› = generate_from S) (hc : countable T)
+  (h_gen : ‹_› = generate_from S) (hc : T.countable)
   (h_inter : is_pi_system S) (hU : ⋃₀ T = univ) (htop : ∀ t ∈ T, μ t ≠ ∞)
   (ST_eq : ∀ (t ∈ T) (s ∈ S), μ (s ∩ t) = ν (s ∩ t)) (T_eq : ∀ t ∈ T, μ t = ν t) :
   μ = ν :=
@@ -1409,7 +1698,7 @@ end
   This lemma is formulated using `sUnion`. -/
 lemma ext_of_generate_from_of_cover_subset {S T : set (set α)}
   (h_gen : ‹_› = generate_from S) (h_inter : is_pi_system S)
-  (h_sub : T ⊆ S) (hc : countable T) (hU : ⋃₀ T = univ) (htop : ∀ s ∈ T, μ s ≠ ∞)
+  (h_sub : T ⊆ S) (hc : T.countable) (hU : ⋃₀ T = univ) (htop : ∀ s ∈ T, μ s ≠ ∞)
   (h_eq : ∀ s ∈ S, μ s = ν s) :
   μ = ν :=
 begin
@@ -1503,7 +1792,7 @@ to_measure_apply _ _ hs
 lemma le_sum (μ : ι → measure α) (i : ι) : μ i ≤ sum μ :=
 λ s hs, by simp only [sum_apply μ hs, ennreal.le_tsum i]
 
-@[simp] lemma sum_apply_eq_zero [encodable ι] {μ : ι → measure α} {s : set α} :
+@[simp] lemma sum_apply_eq_zero [countable ι] {μ : ι → measure α} {s : set α} :
   sum μ s = 0 ↔ ∀ i, μ i s = 0 :=
 begin
   refine ⟨λ h i, nonpos_iff_eq_zero.1 $ h ▸ le_iff'.1 (le_sum μ i) _, λ h, nonpos_iff_eq_zero.1 _⟩,
@@ -1516,7 +1805,11 @@ lemma sum_apply_eq_zero' {μ : ι → measure α} {s : set α} (hs : measurable_
   sum μ s = 0 ↔ ∀ i, μ i s = 0 :=
 by simp [hs]
 
-lemma ae_sum_iff [encodable ι] {μ : ι → measure α} {p : α → Prop} :
+lemma sum_comm {ι' : Type*} (μ : ι → ι' → measure α) :
+  sum (λ n, sum (μ n)) = sum (λ m, sum (λ n, μ n m)) :=
+by { ext1 s hs, simp_rw [sum_apply _ hs], rw ennreal.tsum_comm, }
+
+lemma ae_sum_iff [countable ι] {μ : ι → measure α} {p : α → Prop} :
   (∀ᵐ x ∂(sum μ), p x) ↔ ∀ i, ∀ᵐ x ∂(μ i), p x :=
 sum_apply_eq_zero
 
@@ -1531,7 +1824,7 @@ by { ext1 s hs, simp only [sum_apply, finset_sum_apply, hs, tsum_fintype] }
   sum (λ i : s, μ i) = ∑ i in s, μ i :=
 by rw [sum_fintype, finset.sum_coe_sort s μ]
 
-@[simp] lemma ae_sum_eq [encodable ι] (μ : ι → measure α) : (sum μ).ae = ⨆ i, (μ i).ae :=
+@[simp] lemma ae_sum_eq [countable ι] (μ : ι → measure α) : (sum μ).ae = ⨆ i, (μ i).ae :=
 filter.ext $ λ s, ae_sum_iff.trans mem_supr.symm
 
 @[simp] lemma sum_bool (f : bool → measure α) : sum f = f tt + f ff :=
@@ -1564,36 +1857,46 @@ begin
              tsum_add ennreal.summable ennreal.summable],
 end
 
-/-- If `f` is a map with encodable codomain, then `μ.map f` is the sum of Dirac measures -/
-lemma map_eq_sum [encodable β] [measurable_singleton_class β]
-  (μ : measure α) (f : α → β) (hf : measurable f) :
+/-- If `f` is a map with countable codomain, then `μ.map f` is a sum of Dirac measures. -/
+lemma map_eq_sum [countable β] [measurable_singleton_class β] (μ : measure α) (f : α → β)
+  (hf : measurable f) :
   μ.map f = sum (λ b : β, μ (f ⁻¹' {b}) • dirac b) :=
 begin
   ext1 s hs,
   have : ∀ y ∈ s, measurable_set (f ⁻¹' {y}), from λ y _, hf (measurable_set_singleton _),
-  simp [← tsum_measure_preimage_singleton (countable_encodable s) this, *,
+  simp [← tsum_measure_preimage_singleton (to_countable s) this, *,
     tsum_subtype s (λ b, μ (f ⁻¹' {b})), ← indicator_mul_right s (λ b, μ (f ⁻¹' {b}))]
 end
 
-/-- A measure on an encodable type is a sum of dirac measures. -/
-@[simp] lemma sum_smul_dirac [encodable α] [measurable_singleton_class α] (μ : measure α) :
+/-- A measure on a countable type is a sum of Dirac measures. -/
+@[simp] lemma sum_smul_dirac [countable α] [measurable_singleton_class α] (μ : measure α) :
   sum (λ a, μ {a} • dirac a) = μ :=
 by simpa using (map_eq_sum μ id measurable_id).symm
 
+/-- Given that `α` is a countable, measurable space with all singleton sets measurable,
+write the measure of a set `s` as the sum of the measure of `{x}` for all `x ∈ s`. -/
+lemma tsum_indicator_apply_singleton [countable α] [measurable_singleton_class α]
+  (μ : measure α) (s : set α) (hs : measurable_set s) :
+  ∑' (x : α), s.indicator (λ x, μ {x}) x = μ s :=
+calc ∑' (x : α), s.indicator (λ x, μ {x}) x = measure.sum (λ a, μ {a} • measure.dirac a) s :
+    by simp only [measure.sum_apply _ hs, measure.smul_apply, smul_eq_mul, measure.dirac_apply,
+      set.indicator_apply, mul_ite, pi.one_apply, mul_one, mul_zero]
+  ... = μ s : by rw μ.sum_smul_dirac
+
 omit m0
 end sum
 
-lemma restrict_Union_ae [encodable ι] {s : ι → set α} (hd : pairwise (ae_disjoint μ on s))
+lemma restrict_Union_ae [countable ι] {s : ι → set α} (hd : pairwise (ae_disjoint μ on s))
   (hm : ∀ i, null_measurable_set (s i) μ) :
   μ.restrict (⋃ i, s i) = sum (λ i, μ.restrict (s i)) :=
 ext $ λ t ht, by simp only [sum_apply _ ht, restrict_Union_apply_ae hd hm ht]
 
-lemma restrict_Union [encodable ι] {s : ι → set α} (hd : pairwise (disjoint on s))
+lemma restrict_Union [countable ι] {s : ι → set α} (hd : pairwise (disjoint on s))
   (hm : ∀ i, measurable_set (s i)) :
   μ.restrict (⋃ i, s i) = sum (λ i, μ.restrict (s i)) :=
-ext $ λ t ht, by simp only [sum_apply _ ht, restrict_Union_apply hd hm ht]
+restrict_Union_ae hd.ae_disjoint (λ i, (hm i).null_measurable_set)
 
-lemma restrict_Union_le [encodable ι] {s : ι → set α} :
+lemma restrict_Union_le [countable ι] {s : ι → set α} :
   μ.restrict (⋃ i, s i) ≤ sum (λ i, μ.restrict (s i)) :=
 begin
   intros t ht,
@@ -1619,13 +1922,22 @@ by simp only [count, sum_apply, hs, dirac_apply', ← tsum_subtype s 1, pi.one_a
 @[simp] lemma count_empty : count (∅ : set α) = 0 :=
 by rw [count_apply measurable_set.empty, tsum_empty]
 
-@[simp] lemma count_apply_finset [measurable_singleton_class α] (s : finset α) :
+@[simp] lemma count_apply_finset' {s : finset α} (s_mble : measurable_set (s : set α)) :
   count (↑s : set α) = s.card :=
-calc count (↑s : set α) = ∑' i : (↑s : set α), 1 : count_apply s.measurable_set
+calc count (↑s : set α) = ∑' i : (↑s : set α), 1 : count_apply s_mble
                     ... = ∑ i in s, 1 : s.tsum_subtype 1
                     ... = s.card : by simp
 
-lemma count_apply_finite [measurable_singleton_class α] (s : set α) (hs : finite s) :
+@[simp] lemma count_apply_finset [measurable_singleton_class α] (s : finset α) :
+  count (↑s : set α) = s.card :=
+count_apply_finset' s.measurable_set
+
+lemma count_apply_finite' {s : set α} (s_fin : s.finite) (s_mble : measurable_set s) :
+  count s = s_fin.to_finset.card :=
+by simp [← @count_apply_finset' _ _ s_fin.to_finset
+             (by simpa only [finite.coe_to_finset] using s_mble)]
+
+lemma count_apply_finite [measurable_singleton_class α] (s : set α) (hs : s.finite) :
   count s = hs.to_finset.card :=
 by rw [← count_apply_finset, finite.coe_to_finset]
 
@@ -1640,45 +1952,102 @@ begin
   ... ≤ count s : measure_mono ht
 end
 
-variable [measurable_singleton_class α]
 
-@[simp] lemma count_apply_eq_top : count s = ∞ ↔ s.infinite :=
+@[simp] lemma count_apply_eq_top' (s_mble : measurable_set s) : count s = ∞ ↔ s.infinite :=
+begin
+  by_cases hs : s.finite,
+  { simp [set.infinite, hs, count_apply_finite' hs s_mble], },
+  { change s.infinite at hs,
+    simp [hs, count_apply_infinite], }
+end
+
+@[simp] lemma count_apply_eq_top [measurable_singleton_class α] : count s = ∞ ↔ s.infinite :=
 begin
   by_cases hs : s.finite,
-  { simp [set.infinite, hs, count_apply_finite] },
+  { exact count_apply_eq_top' hs.measurable_set, },
   { change s.infinite at hs,
-    simp [hs, count_apply_infinite] }
+    simp [hs, count_apply_infinite], },
 end
 
-@[simp] lemma count_apply_lt_top : count s < ∞ ↔ s.finite :=
+@[simp] lemma count_apply_lt_top' (s_mble : measurable_set s) : count s < ∞ ↔ s.finite :=
+calc count s < ∞ ↔ count s ≠ ∞ : lt_top_iff_ne_top
+             ... ↔ ¬s.infinite : not_congr (count_apply_eq_top' s_mble)
+             ... ↔ s.finite    : not_not
+
+@[simp] lemma count_apply_lt_top [measurable_singleton_class α] : count s < ∞ ↔ s.finite :=
 calc count s < ∞ ↔ count s ≠ ∞ : lt_top_iff_ne_top
              ... ↔ ¬s.infinite : not_congr count_apply_eq_top
              ... ↔ s.finite    : not_not
 
-lemma empty_of_count_eq_zero (hsc : count s = 0) : s = ∅ :=
+lemma empty_of_count_eq_zero' (s_mble : measurable_set s) (hsc : count s = 0) : s = ∅ :=
+begin
+  have hs : s.finite,
+  { rw [← count_apply_lt_top' s_mble, hsc],
+    exact with_top.zero_lt_top },
+  simpa [count_apply_finite' hs s_mble] using hsc,
+end
+
+lemma empty_of_count_eq_zero [measurable_singleton_class α] (hsc : count s = 0) : s = ∅ :=
 begin
   have hs : s.finite,
   { rw [← count_apply_lt_top, hsc],
     exact with_top.zero_lt_top },
-  rw count_apply_finite _ hs at hsc,
-  simpa using hsc,
+  simpa [count_apply_finite _ hs] using hsc,
 end
 
-@[simp] lemma count_eq_zero_iff : count s = 0 ↔ s = ∅ :=
+@[simp] lemma count_eq_zero_iff' (s_mble : measurable_set s) : count s = 0 ↔ s = ∅ :=
+⟨empty_of_count_eq_zero' s_mble, λ h, h.symm ▸ count_empty⟩
+
+@[simp] lemma count_eq_zero_iff [measurable_singleton_class α] : count s = 0 ↔ s = ∅ :=
 ⟨empty_of_count_eq_zero, λ h, h.symm ▸ count_empty⟩
 
-lemma count_ne_zero (hs' : s.nonempty) : count s ≠ 0 :=
+lemma count_ne_zero' (hs' : s.nonempty) (s_mble : measurable_set s) : count s ≠ 0 :=
+begin
+  rw [ne.def, count_eq_zero_iff' s_mble],
+  exact hs'.ne_empty,
+end
+
+lemma count_ne_zero [measurable_singleton_class α] (hs' : s.nonempty) : count s ≠ 0 :=
 begin
   rw [ne.def, count_eq_zero_iff],
   exact hs'.ne_empty,
 end
 
-@[simp] lemma count_singleton (a : α) : count ({a} : set α) = 1 :=
+@[simp] lemma count_singleton' {a : α} (ha : measurable_set ({a} : set α)) :
+  count ({a} : set α) = 1 :=
 begin
-  rw [count_apply_finite ({a} : set α) (set.finite_singleton _), set.finite.to_finset],
+  rw [count_apply_finite' (set.finite_singleton a) ha, set.finite.to_finset],
   simp,
 end
 
+@[simp] lemma count_singleton [measurable_singleton_class α] (a : α) : count ({a} : set α) = 1 :=
+count_singleton' (measurable_set_singleton a)
+
+lemma count_injective_image' {f : β → α} (hf : function.injective f) {s : set β}
+  (s_mble : measurable_set s) (fs_mble : measurable_set (f '' s)):
+  count (f '' s) = count s :=
+begin
+  by_cases hs : s.finite,
+  { lift s to finset β using hs,
+    rw [← finset.coe_image, count_apply_finset' _, count_apply_finset' s_mble,
+        s.card_image_of_injective hf],
+    simpa only [finset.coe_image] using fs_mble, },
+  rw count_apply_infinite hs,
+  rw ← (finite_image_iff $ hf.inj_on _) at hs,
+  rw count_apply_infinite hs,
+end
+
+lemma count_injective_image [measurable_singleton_class α] [measurable_singleton_class β]
+  {f : β → α} (hf : function.injective f) (s : set β) :
+  count (f '' s) = count s :=
+begin
+  by_cases hs : s.finite,
+  { exact count_injective_image' hf hs.measurable_set (finite.image f hs).measurable_set, },
+  rw count_apply_infinite hs,
+  rw ← (finite_image_iff $ hf.inj_on _) at hs,
+  rw count_apply_infinite hs,
+end
+
 end count
 
 /-! ### Absolute continuity -/
@@ -1688,17 +2057,18 @@ end count
 def absolutely_continuous {m0 : measurable_space α} (μ ν : measure α) : Prop :=
 ∀ ⦃s : set α⦄, ν s = 0 → μ s = 0
 
-localized "infix ` ≪ `:50 := measure_theory.measure.absolutely_continuous" in measure_theory
+localized "infix (name := measure.absolutely_continuous)
+  ` ≪ `:50 := measure_theory.measure.absolutely_continuous" in measure_theory
 
 lemma absolutely_continuous_of_le (h : μ ≤ ν) : μ ≪ ν :=
 λ s hs, nonpos_iff_eq_zero.1 $ hs ▸ le_iff'.1 h s
 
-alias absolutely_continuous_of_le ← has_le.le.absolutely_continuous
+alias absolutely_continuous_of_le ← _root_.has_le.le.absolutely_continuous
 
 lemma absolutely_continuous_of_eq (h : μ = ν) : μ ≪ ν :=
 h.le.absolutely_continuous
 
-alias absolutely_continuous_of_eq ← eq.absolutely_continuous
+alias absolutely_continuous_of_eq ← _root_.eq.absolutely_continuous
 
 namespace absolutely_continuous
 
@@ -1736,8 +2106,8 @@ lemma ae_le_iff_absolutely_continuous : μ.ae ≤ ν.ae ↔ μ ≪ ν :=
 ⟨λ h s, by { rw [measure_zero_iff_ae_nmem, measure_zero_iff_ae_nmem], exact λ hs, h hs },
   λ h s hs, h hs⟩
 
-alias ae_le_iff_absolutely_continuous ↔ has_le.le.absolutely_continuous_of_ae
-  measure_theory.measure.absolutely_continuous.ae_le
+alias ae_le_iff_absolutely_continuous ↔
+  _root_.has_le.le.absolutely_continuous_of_ae absolutely_continuous.ae_le
 alias absolutely_continuous.ae_le ← ae_mono'
 
 lemma absolutely_continuous.ae_eq (h : μ ≪ ν) {f g : α → δ} (h' : f =ᵐ[ν] g) : f =ᵐ[μ] g :=
@@ -1807,8 +2177,108 @@ lemma preimage_null (h : quasi_measure_preserving f μa μb) {s : set β} (hs :
   μa (f ⁻¹' s) = 0 :=
 preimage_null_of_map_null h.ae_measurable (h.2 hs)
 
+lemma preimage_mono_ae {s t : set β} (hf : quasi_measure_preserving f μa μb) (h : s ≤ᵐ[μb] t) :
+   f⁻¹' s ≤ᵐ[μa] f⁻¹' t :=
+eventually_map.mp $ eventually.filter_mono (tendsto_ae_map hf.ae_measurable)
+  (eventually.filter_mono hf.ae_map_le h)
+
+lemma preimage_ae_eq {s t : set β} (hf : quasi_measure_preserving f μa μb) (h : s =ᵐ[μb] t) :
+  f⁻¹' s =ᵐ[μa] f⁻¹' t :=
+eventually_le.antisymm (hf.preimage_mono_ae h.le) (hf.preimage_mono_ae h.symm.le)
+
+lemma preimage_iterate_ae_eq {s : set α} {f : α → α} (hf : quasi_measure_preserving f μ μ) (k : ℕ)
+  (hs : f⁻¹' s =ᵐ[μ] s) : (f^[k])⁻¹' s =ᵐ[μ] s :=
+begin
+  induction k with k ih, { simp, },
+  rw [iterate_succ, preimage_comp],
+  exact eventually_eq.trans (hf.preimage_ae_eq ih) hs,
+end
+
+lemma image_zpow_ae_eq {s : set α} {e : α ≃ α} (he : quasi_measure_preserving e μ μ)
+  (he' : quasi_measure_preserving e.symm μ μ) (k : ℤ) (hs : e '' s =ᵐ[μ] s) : ⇑(e^k) '' s =ᵐ[μ] s :=
+begin
+  rw equiv.image_eq_preimage,
+  obtain ⟨k, rfl | rfl⟩ := k.eq_coe_or_neg,
+  { replace hs : ⇑(e⁻¹)⁻¹' s =ᵐ[μ] s, by rwa equiv.image_eq_preimage at hs,
+    replace he' : (⇑(e⁻¹)^[k])⁻¹' s =ᵐ[μ] s := he'.preimage_iterate_ae_eq k hs,
+    rwa [equiv.perm.iterate_eq_pow e⁻¹ k, inv_pow e k] at he', },
+  { rw [zpow_neg, zpow_coe_nat],
+    replace hs : e⁻¹' s =ᵐ[μ] s, { convert he.preimage_ae_eq hs.symm, rw equiv.preimage_image, },
+    replace he : (⇑e^[k])⁻¹' s =ᵐ[μ] s := he.preimage_iterate_ae_eq k hs,
+    rwa [equiv.perm.iterate_eq_pow e k] at he, },
+end
+
+lemma limsup_preimage_iterate_ae_eq {f : α → α} (hf : quasi_measure_preserving f μ μ)
+  (hs : f⁻¹' s =ᵐ[μ] s) :
+  -- Need `@` below because of diamond; see gh issue #16932
+  @limsup (set α) ℕ _ (λ n, (preimage f)^[n] s) at_top =ᵐ[μ] s :=
+begin
+  have : ∀ n, (preimage f)^[n] s =ᵐ[μ] s,
+  { intros n,
+    induction n with n ih, { simp, },
+    simpa only [iterate_succ', comp_app] using ae_eq_trans (hf.ae_eq ih) hs, },
+  exact (limsup_ae_eq_of_forall_ae_eq (λ n, (preimage f)^[n] s) this).trans (ae_eq_refl _),
+end
+
+lemma liminf_preimage_iterate_ae_eq {f : α → α} (hf : quasi_measure_preserving f μ μ)
+  (hs : f⁻¹' s =ᵐ[μ] s) :
+  -- Need `@` below because of diamond; see gh issue #16932
+  @liminf (set α) ℕ _ (λ n, (preimage f)^[n] s) at_top =ᵐ[μ] s :=
+begin
+  -- Need `@` below because of diamond; see gh issue #16932
+  rw [← ae_eq_set_compl_compl, @filter.liminf_compl (set α)],
+  rw [← ae_eq_set_compl_compl, ← preimage_compl] at hs,
+  convert hf.limsup_preimage_iterate_ae_eq hs,
+  ext1 n,
+  simp only [← set.preimage_iterate_eq, comp_app, preimage_compl],
+end
+
+/-- By replacing a measurable set that is almost invariant with the `limsup` of its preimages, we
+obtain a measurable set that is almost equal and strictly invariant.
+
+(The `liminf` would work just as well.) -/
+lemma exists_preimage_eq_of_preimage_ae {f : α → α} (h : quasi_measure_preserving f μ μ)
+  (hs : measurable_set s) (hs' : f⁻¹' s =ᵐ[μ] s) :
+  ∃ (t : set α), measurable_set t ∧ t =ᵐ[μ] s ∧ f⁻¹' t = t :=
+⟨limsup (λ n, (preimage f)^[n] s) at_top,
+ measurable_set.measurable_set_limsup $ λ n, @preimage_iterate_eq α f n ▸ h.measurable.iterate n hs,
+ h.limsup_preimage_iterate_ae_eq hs',
+ (complete_lattice_hom.set_preimage f).apply_limsup_iterate s⟩
+
+open_locale pointwise
+
+@[to_additive]
+lemma smul_ae_eq_of_ae_eq
+  {G α : Type*} [group G] [mul_action G α] [measurable_space α] {s t : set α} {μ : measure α}
+  (g : G) (h_qmp : quasi_measure_preserving ((•) g⁻¹ : α → α) μ μ) (h_ae_eq : s =ᵐ[μ] t) :
+  (g • s : set α) =ᵐ[μ] (g • t : set α) :=
+by simpa only [← preimage_smul_inv] using h_qmp.ae_eq h_ae_eq
+
 end quasi_measure_preserving
 
+section pointwise
+
+open_locale pointwise
+
+@[to_additive]
+lemma pairwise_ae_disjoint_of_ae_disjoint_forall_ne_one
+  {G α : Type*} [group G] [mul_action G α] [measurable_space α] {μ : measure α} {s : set α}
+  (h_ae_disjoint : ∀ g ≠ (1 : G), ae_disjoint μ (g • s) s)
+  (h_qmp : ∀ (g : G), quasi_measure_preserving ((•) g : α → α) μ μ) :
+  pairwise (ae_disjoint μ on (λ (g : G), g • s)) :=
+begin
+  intros g₁ g₂ hg,
+  let g := g₂⁻¹ * g₁,
+  replace hg : g ≠ 1, { rw [ne.def, inv_mul_eq_one], exact hg.symm, },
+  have : ((•) g₂⁻¹)⁻¹' (g • s ∩ s) = (g₁ • s) ∩ (g₂ • s),
+  { rw [preimage_eq_iff_eq_image (mul_action.bijective g₂⁻¹), image_smul, smul_set_inter,
+      smul_smul, smul_smul, inv_mul_self, one_smul], },
+  change μ ((g₁ • s) ∩ (g₂ • s)) = 0,
+  exact this ▸ (h_qmp g₂⁻¹).preimage_null (h_ae_disjoint g hg),
+end
+
+end pointwise
+
 /-! ### The `cofinite` filter -/
 
 /-- The filter of sets `s` such that `sᶜ` has finite measure. -/
@@ -1893,7 +2363,7 @@ begin
   { simp [map_of_not_ae_measurable h] }
 end
 
-@[simp] lemma ae_restrict_Union_eq [encodable ι] (s : ι → set α) :
+@[simp] lemma ae_restrict_Union_eq [countable ι] (s : ι → set α) :
   (μ.restrict (⋃ i, s i)).ae = ⨆ i, (μ.restrict (s i)).ae :=
 le_antisymm (ae_sum_eq (λ i, μ.restrict (s i)) ▸ ae_mono restrict_Union_le) $
   supr_le $ λ i, ae_mono $ restrict_mono (subset_Union s i) le_rfl
@@ -1902,15 +2372,55 @@ le_antisymm (ae_sum_eq (λ i, μ.restrict (s i)) ▸ ae_mono restrict_Union_le)
   (μ.restrict (s ∪ t)).ae = (μ.restrict s).ae ⊔ (μ.restrict t).ae :=
 by simp [union_eq_Union, supr_bool_eq]
 
-lemma ae_restrict_interval_oc_eq [linear_order α] (a b : α) :
+lemma ae_restrict_bUnion_eq (s : ι → set α) {t : set ι} (ht : t.countable) :
+  (μ.restrict (⋃ i ∈ t, s i)).ae = ⨆ i ∈ t, (μ.restrict (s i)).ae :=
+begin
+  haveI := ht.to_subtype,
+  rw [bUnion_eq_Union, ae_restrict_Union_eq, ← supr_subtype''],
+end
+
+lemma ae_restrict_bUnion_finset_eq (s : ι → set α) (t : finset ι) :
+  (μ.restrict (⋃ i ∈ t, s i)).ae = ⨆ i ∈ t, (μ.restrict (s i)).ae :=
+ae_restrict_bUnion_eq s t.countable_to_set
+
+lemma ae_restrict_Union_iff [countable ι] (s : ι → set α) (p : α → Prop) :
+  (∀ᵐ x ∂ (μ.restrict (⋃ i, s i)), p x) ↔ (∀ i, (∀ᵐ x ∂ (μ.restrict (s i)), p x)) :=
+by simp
+
+lemma ae_restrict_union_iff (s t : set α) (p : α → Prop) :
+  (∀ᵐ x ∂ (μ.restrict (s ∪ t)), p x) ↔
+    ((∀ᵐ x ∂ (μ.restrict s), p x) ∧ (∀ᵐ x ∂ (μ.restrict t), p x)) :=
+by simp
+
+lemma ae_restrict_bUnion_iff (s : ι → set α) {t : set ι} (ht : t.countable) (p : α → Prop) :
+  (∀ᵐ x ∂(μ.restrict (⋃ i ∈ t, s i)), p x) ↔ ∀ i ∈ t, ∀ᵐ x ∂(μ.restrict (s i)), p x :=
+by simp_rw [filter.eventually, ae_restrict_bUnion_eq s ht, mem_supr]
+
+@[simp] lemma ae_restrict_bUnion_finset_iff (s : ι → set α) (t : finset ι) (p : α → Prop) :
+  (∀ᵐ x ∂(μ.restrict (⋃ i ∈ t, s i)), p x) ↔ ∀ i ∈ t, ∀ᵐ x ∂(μ.restrict (s i)), p x :=
+by simp_rw [filter.eventually, ae_restrict_bUnion_finset_eq s, mem_supr]
+
+lemma ae_eq_restrict_Union_iff [countable ι] (s : ι → set α) (f g : α → δ) :
+  f =ᵐ[μ.restrict (⋃ i, s i)] g ↔ ∀ i, f =ᵐ[μ.restrict (s i)] g :=
+by simp_rw [eventually_eq, ae_restrict_Union_eq, eventually_supr]
+
+lemma ae_eq_restrict_bUnion_iff (s : ι → set α) {t : set ι} (ht : t.countable) (f g : α → δ) :
+  f =ᵐ[μ.restrict (⋃ i ∈ t, s i)] g ↔ ∀ i ∈ t, f =ᵐ[μ.restrict (s i)] g :=
+by simp_rw [ae_restrict_bUnion_eq s ht, eventually_eq, eventually_supr]
+
+lemma ae_eq_restrict_bUnion_finset_iff (s : ι → set α) (t : finset ι) (f g : α → δ) :
+  f =ᵐ[μ.restrict (⋃ i ∈ t, s i)] g ↔ ∀ i ∈ t, f =ᵐ[μ.restrict (s i)] g :=
+ae_eq_restrict_bUnion_iff s t.countable_to_set f g
+
+lemma ae_restrict_uIoc_eq [linear_order α] (a b : α) :
   (μ.restrict (Ι a b)).ae = (μ.restrict (Ioc a b)).ae ⊔ (μ.restrict (Ioc b a)).ae :=
-by simp only [interval_oc_eq_union, ae_restrict_union_eq]
+by simp only [uIoc_eq_union, ae_restrict_union_eq]
 
-/-- See also `measure_theory.ae_interval_oc_iff`. -/
-lemma ae_restrict_interval_oc_iff [linear_order α] {a b : α} {P : α → Prop} :
+/-- See also `measure_theory.ae_uIoc_iff`. -/
+lemma ae_restrict_uIoc_iff [linear_order α] {a b : α} {P : α → Prop} :
   (∀ᵐ x ∂μ.restrict (Ι a b), P x) ↔
     (∀ᵐ x ∂μ.restrict (Ioc a b), P x) ∧ (∀ᵐ x ∂μ.restrict (Ioc b a), P x) :=
-by rw [ae_restrict_interval_oc_eq, eventually_sup]
+by rw [ae_restrict_uIoc_eq, eventually_sup]
 
 lemma ae_restrict_iff {p : α → Prop} (hp : measurable_set {x | p x}) :
   (∀ᵐ x ∂(μ.restrict s), p x) ↔ ∀ᵐ x ∂μ, x ∈ s → p x :=
@@ -1956,6 +2466,13 @@ lemma ae_restrict_of_ae {s : set α} {p : α → Prop} (h : ∀ᵐ x ∂μ, p x)
   (∀ᵐ x ∂(μ.restrict s), p x) :=
 eventually.filter_mono (ae_mono measure.restrict_le_self) h
 
+lemma ae_restrict_iff'₀ {p : α → Prop} (hs : null_measurable_set s μ) :
+  (∀ᵐ x ∂(μ.restrict s), p x) ↔ ∀ᵐ x ∂μ, x ∈ s → p x :=
+begin
+  refine ⟨λ h, ae_imp_of_ae_restrict h, λ h, _⟩,
+  filter_upwards [ae_restrict_mem₀ hs, ae_restrict_of_ae h] with x hx h'x using h'x hx,
+end
+
 lemma ae_restrict_of_ae_restrict_of_subset {s t : set α} {p : α → Prop} (hst : s ⊆ t)
   (h : ∀ᵐ x ∂(μ.restrict t), p x) :
   (∀ᵐ x ∂(μ.restrict s), p x) :=
@@ -1988,6 +2505,10 @@ lemma ae_eq_comp' {ν : measure β} {f : α → β} {g g' : β → δ} (hf : ae_
   (h : g =ᵐ[ν] g') (h2 : μ.map f ≪ ν) : g ∘ f =ᵐ[μ] g' ∘ f :=
 (tendsto_ae_map hf).mono_right h2.ae_le h
 
+lemma measure.quasi_measure_preserving.ae_eq_comp {ν : measure β} {f : α → β} {g g' : β → δ}
+  (hf : quasi_measure_preserving f μ ν) (h : g =ᵐ[ν] g') : g ∘ f =ᵐ[μ] g' ∘ f :=
+ae_eq_comp' hf.ae_measurable h hf.absolutely_continuous
+
 lemma ae_eq_comp {f : α → β} {g g' : β → δ} (hf : ae_measurable f μ)
   (h : g =ᵐ[μ.map f] g') : g ∘ f =ᵐ[μ] g' ∘ f :=
 ae_eq_comp' hf h absolutely_continuous.rfl
@@ -2020,6 +2541,19 @@ lemma self_mem_ae_restrict {s} (hs : measurable_set s) : s ∈ (μ.restrict s).a
 by simp only [ae_restrict_eq hs, exists_prop, mem_principal, mem_inf_iff];
   exact ⟨_, univ_mem, s, subset.rfl, (univ_inter s).symm⟩
 
+/-- If two measurable sets are ae_eq then any proposition that is almost everywhere true on one
+is almost everywhere true on the other -/
+lemma ae_restrict_of_ae_eq_of_ae_restrict {s t} (hst : s =ᵐ[μ] t) {p : α → Prop} :
+  (∀ᵐ x ∂μ.restrict s, p x) → (∀ᵐ x ∂μ.restrict t, p x) :=
+by simp [measure.restrict_congr_set hst]
+
+/-- If two measurable sets are ae_eq then any proposition that is almost everywhere true on one
+is almost everywhere true on the other -/
+lemma ae_restrict_congr_set {s t} (hst : s =ᵐ[μ] t) {p : α → Prop} :
+  (∀ᵐ x ∂μ.restrict s, p x) ↔ (∀ᵐ x ∂μ.restrict t, p x) :=
+⟨ae_restrict_of_ae_eq_of_ae_restrict hst, ae_restrict_of_ae_eq_of_ae_restrict hst.symm⟩
+
+
 /-- A version of the **Borel-Cantelli lemma**: if `pᵢ` is a sequence of predicates such that
 `∑ μ {x | pᵢ x}` is finite, then the measure of `x` such that `pᵢ x` holds frequently as `i → ∞` (or
 equivalently, `pᵢ x` holds for infinitely many `i`) is equal to zero. -/
@@ -2036,7 +2570,7 @@ measure_set_of_frequently_eq_zero hs
 
 section intervals
 
-lemma bsupr_measure_Iic [preorder α] {s : set α} (hsc : countable s)
+lemma bsupr_measure_Iic [preorder α] {s : set α} (hsc : s.countable)
   (hst : ∀ x : α, ∃ y ∈ s, x ≤ y) (hdir : directed_on (≤) s) :
   (⨆ x ∈ s, μ (Iic x)) = μ univ :=
 begin
@@ -2102,6 +2636,13 @@ include m0
 /-- A measure `μ` is called finite if `μ univ < ∞`. -/
 class is_finite_measure (μ : measure α) : Prop := (measure_univ_lt_top : μ univ < ∞)
 
+lemma not_is_finite_measure_iff : ¬ is_finite_measure μ ↔ μ set.univ = ∞ :=
+begin
+  refine ⟨λ h, _, λ h, λ h', h'.measure_univ_lt_top.ne h⟩,
+  by_contra h',
+  exact h ⟨lt_top_iff_ne_top.mpr h'⟩,
+end
+
 instance restrict.is_finite_measure (μ : measure α) [hs : fact (μ s < ∞)] :
   is_finite_measure (μ.restrict s) :=
 ⟨by simp [hs.elim]⟩
@@ -2164,7 +2705,7 @@ instance is_finite_measure_smul_nnreal [is_finite_measure μ] {r : ℝ≥0} :
 { measure_univ_lt_top := ennreal.mul_lt_top ennreal.coe_ne_top (measure_ne_top _ _) }
 
 instance is_finite_measure_smul_of_nnreal_tower
-  {R} [has_scalar R ℝ≥0] [has_scalar R ℝ≥0∞] [is_scalar_tower R ℝ≥0 ℝ≥0∞]
+  {R} [has_smul R ℝ≥0] [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0 ℝ≥0∞]
   [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
   [is_finite_measure μ] {r : R} :
   is_finite_measure (r • μ) :=
@@ -2213,6 +2754,29 @@ begin
   exact ne_of_lt (measure_lt_top _ _)
 end
 
+lemma ae_eq_univ_iff_measure_eq [is_finite_measure μ] (hs : null_measurable_set s μ) :
+  s =ᵐ[μ] univ ↔ μ s = μ univ :=
+begin
+  refine ⟨measure_congr, λ h, _⟩,
+  obtain ⟨t, -, ht₁, ht₂⟩ := hs.exists_measurable_subset_ae_eq,
+  exact ht₂.symm.trans (ae_eq_of_subset_of_measure_ge (subset_univ t)
+    (eq.le ((measure_congr ht₂).trans h).symm) ht₁ (measure_ne_top μ univ)),
+end
+
+lemma ae_iff_measure_eq [is_finite_measure μ] {p : α → Prop}
+  (hp : null_measurable_set {a | p a} μ) :
+  (∀ᵐ a ∂μ, p a) ↔ μ {a | p a} = μ univ :=
+by rw [← ae_eq_univ_iff_measure_eq hp, eventually_eq_univ, eventually_iff]
+
+lemma ae_mem_iff_measure_eq [is_finite_measure μ] {s : set α}
+  (hs : null_measurable_set s μ) :
+  (∀ᵐ a ∂μ, a ∈ s) ↔ μ s = μ univ :=
+ae_iff_measure_eq hs
+
+instance [finite α] [measurable_space α] : is_finite_measure (measure.count : measure α) :=
+⟨by { casesI nonempty_fintype α,
+      simpa [measure.count_apply, tsum_fintype] using (ennreal.nat_ne_top _).lt_top }⟩
+
 end is_finite_measure
 
 section is_probability_measure
@@ -2263,6 +2827,24 @@ lemma is_probability_measure_map [is_probability_measure μ] {f : α → β} (hf
   is_probability_measure (map f μ) :=
 ⟨by simp [map_apply_of_ae_measurable, hf]⟩
 
+@[simp] lemma one_le_prob_iff [is_probability_measure μ] : 1 ≤ μ s ↔ μ s = 1 :=
+⟨λ h, le_antisymm prob_le_one h, λ h, h ▸ le_refl _⟩
+
+/-- Note that this is not quite as useful as it looks because the measure takes values in `ℝ≥0∞`.
+Thus the subtraction appearing is the truncated subtraction of `ℝ≥0∞`, rather than the
+better-behaved subtraction of `ℝ`. -/
+lemma prob_compl_eq_one_sub [is_probability_measure μ] (hs : measurable_set s) :
+  μ sᶜ = 1 - μ s :=
+by simpa only [measure_univ] using measure_compl hs (measure_lt_top μ s).ne
+
+@[simp] lemma prob_compl_eq_zero_iff [is_probability_measure μ] (hs : measurable_set s) :
+  μ sᶜ = 0 ↔ μ s = 1 :=
+by simp only [prob_compl_eq_one_sub hs, tsub_eq_zero_iff_le, one_le_prob_iff]
+
+@[simp] lemma prob_compl_eq_one_iff [is_probability_measure μ] (hs : measurable_set s) :
+  μ sᶜ = 1 ↔ μ s = 0 :=
+by rwa [← prob_compl_eq_zero_iff hs.compl, compl_compl]
+
 end is_probability_measure
 
 section no_atoms
@@ -2299,7 +2881,7 @@ begin
 end
 
 lemma _root_.set.countable.measure_zero {α : Type*} {m : measurable_space α} {s : set α}
-  (h : countable s) (μ : measure α) [has_no_atoms μ] :
+  (h : s.countable) (μ : measure α) [has_no_atoms μ] :
   μ s = 0 :=
 begin
   rw [← bUnion_of_singleton s, ← nonpos_iff_eq_zero],
@@ -2308,7 +2890,7 @@ begin
 end
 
 lemma _root_.set.countable.ae_not_mem {α : Type*} {m : measurable_space α} {s : set α}
-  (h : countable s) (μ : measure α) [has_no_atoms μ] :
+  (h : s.countable) (μ : measure α) [has_no_atoms μ] :
   ∀ᵐ x ∂μ, x ∉ s :=
 by simpa only [ae_iff, not_not] using h.measure_zero μ
 
@@ -2324,6 +2906,8 @@ lemma insert_ae_eq_self (a : α) (s : set α) :
   (insert a s : set α) =ᵐ[μ] s :=
 union_ae_eq_right.2 $ measure_mono_null (diff_subset _ _) (measure_singleton _)
 
+section
+
 variables [partial_order α] {a b : α}
 
 lemma Iio_ae_eq_Iic : Iio a =ᵐ[μ] Iic a :=
@@ -2350,6 +2934,12 @@ Ico_ae_eq_Icc' (measure_singleton b)
 lemma Ico_ae_eq_Ioc : Ico a b =ᵐ[μ] Ioc a b :=
 Ico_ae_eq_Ioc' (measure_singleton a) (measure_singleton b)
 
+end
+
+open_locale interval
+
+lemma uIoc_ae_eq_interval [linear_order α] {a b : α} : Ι a b =ᵐ[μ] [a, b] := Ioc_ae_eq_Icc
+
 end no_atoms
 
 lemma ite_ae_eq_of_measure_zero {γ} (f : α → γ) (g : α → γ) (s : set α) (hs_zero : μ s = 0) :
@@ -2391,7 +2981,7 @@ lemma finite_at_bot {m0 : measurable_space α} (μ : measure α) : μ.finite_at_
   about the sets, such as that they are monotone.
   `sigma_finite` is defined in terms of this: `μ` is σ-finite if there exists a sequence of
   finite spanning sets in the collection of all measurable sets. -/
-@[protect_proj, nolint has_inhabited_instance]
+@[protect_proj, nolint has_nonempty_instance]
 structure finite_spanning_sets_in {m0 : measurable_space α} (μ : measure α) (C : set (set α)) :=
 (set : ℕ → set α)
 (set_mem : ∀ i, set i ∈ C)
@@ -2436,7 +3026,7 @@ monotone_accumulate
 
 lemma measurable_spanning_sets (μ : measure α) [sigma_finite μ] (i : ℕ) :
   measurable_set (spanning_sets μ i) :=
-measurable_set.Union $ λ j, measurable_set.Union_Prop $
+measurable_set.Union $ λ j, measurable_set.Union $
   λ hij, μ.to_finite_spanning_sets_in.set_mem j
 
 lemma measure_spanning_sets_lt_top (μ : measure α) [sigma_finite μ] (i : ℕ) :
@@ -2509,12 +3099,101 @@ begin
   exact (measure_mono (inter_subset_right _ _)).trans_lt (measure_spanning_sets_lt_top _ _),
 end
 
-/-- The measurable superset `to_measurable μ t` of `t` (which has the same measure as `t`)
-satisfies, for any measurable set `s`, the equality `μ (to_measurable μ t ∩ s) = μ (t ∩ s)`.
-This only holds when `μ` is σ-finite. For a version without this assumption (but requiring
-that `t` has finite measure), see `measure_to_measurable_inter`. -/
-lemma measure_to_measurable_inter_of_sigma_finite
-  [sigma_finite μ] {s : set α} (hs : measurable_set s) (t : set α) :
+/-- A set in a σ-finite space has zero measure if and only if its intersection with
+all members of the countable family of finite measure spanning sets has zero measure. -/
+lemma forall_measure_inter_spanning_sets_eq_zero
+  [measurable_space α] {μ : measure α} [sigma_finite μ] (s : set α) :
+  (∀ n, μ (s ∩ (spanning_sets μ n)) = 0) ↔ μ s = 0 :=
+begin
+  nth_rewrite 0 (show s = ⋃ n, (s ∩ (spanning_sets μ n)),
+                 by rw [← inter_Union, Union_spanning_sets, inter_univ]),
+  rw [measure_Union_null_iff],
+end
+
+/-- A set in a σ-finite space has positive measure if and only if its intersection with
+some member of the countable family of finite measure spanning sets has positive measure. -/
+lemma exists_measure_inter_spanning_sets_pos
+  [measurable_space α] {μ : measure α} [sigma_finite μ] (s : set α) :
+  (∃ n, 0 < μ (s ∩ (spanning_sets μ n))) ↔ 0 < μ s :=
+begin
+  rw ← not_iff_not,
+  simp only [not_exists, not_lt, nonpos_iff_eq_zero],
+  exact forall_measure_inter_spanning_sets_eq_zero s,
+end
+
+/-- If the union of disjoint measurable sets has finite measure, then there are only
+finitely many members of the union whose measure exceeds any given positive number. -/
+lemma finite_const_le_meas_of_disjoint_Union {ι : Type*} [measurable_space α] (μ : measure α)
+  {ε : ℝ≥0∞} (ε_pos : 0 < ε) {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) (Union_As_finite : μ (⋃ i, As i) ≠ ∞) :
+  set.finite {i : ι | ε ≤ μ (As i)} :=
+begin
+  by_contradiction con,
+  have aux := lt_of_le_of_lt (tsum_meas_le_meas_Union_of_disjoint μ As_mble As_disj)
+                              (lt_top_iff_ne_top.mpr Union_As_finite),
+  exact con (ennreal.finite_const_le_of_tsum_ne_top aux.ne ε_pos.ne.symm),
+end
+
+/-- If the union of disjoint measurable sets has finite measure, then there are only
+countably many members of the union whose measure is positive. -/
+lemma countable_meas_pos_of_disjoint_of_meas_Union_ne_top {ι : Type*} [measurable_space α]
+  (μ : measure α) {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) (Union_As_finite : μ (⋃ i, As i) ≠ ∞) :
+  set.countable {i : ι | 0 < μ (As i)} :=
+begin
+  set posmeas := {i : ι | 0 < μ (As i)} with posmeas_def,
+  rcases exists_seq_strict_anti_tendsto' (zero_lt_one : (0 : ℝ≥0∞) < 1)
+    with ⟨as, as_decr, as_mem, as_lim⟩,
+  set fairmeas := λ (n : ℕ) , {i : ι | as n ≤ μ (As i)} with fairmeas_def,
+  have countable_union : posmeas = (⋃ n, fairmeas n) ,
+  { have fairmeas_eq : ∀ n, fairmeas n = (λ i, μ (As i)) ⁻¹' Ici (as n),
+      from λ n, by simpa only [fairmeas_def],
+    simpa only [fairmeas_eq, posmeas_def, ← preimage_Union,
+                Union_Ici_eq_Ioi_of_lt_of_tendsto (0 : ℝ≥0∞) (λ n, (as_mem n).1) as_lim], },
+  rw countable_union,
+  refine countable_Union (λ n, finite.countable _),
+  refine finite_const_le_meas_of_disjoint_Union μ (as_mem n).1 As_mble As_disj Union_As_finite,
+end
+
+/-- In a σ-finite space, among disjoint measurable sets, only countably many can have positive
+measure. -/
+lemma countable_meas_pos_of_disjoint_Union
+  {ι : Type*} [measurable_space α] {μ : measure α} [sigma_finite μ]
+  {As : ι → set α} (As_mble : ∀ (i : ι), measurable_set (As i))
+  (As_disj : pairwise (disjoint on As)) :
+  set.countable {i : ι | 0 < μ (As i)} :=
+begin
+  have obs : {i : ι | 0 < μ (As i)} ⊆ (⋃ n, {i : ι | 0 < μ ((As i) ∩ (spanning_sets μ n))}),
+  { intros i i_in_nonzeroes,
+    by_contra con,
+    simp only [mem_Union, mem_set_of_eq, not_exists, not_lt, nonpos_iff_eq_zero] at *,
+    simpa [(forall_measure_inter_spanning_sets_eq_zero _).mp con] using i_in_nonzeroes, },
+  apply countable.mono obs,
+  refine countable_Union (λ n, countable_meas_pos_of_disjoint_of_meas_Union_ne_top μ _ _ _),
+  { exact λ i, measurable_set.inter (As_mble i) (measurable_spanning_sets μ n), },
+  { exact λ i j i_ne_j b hbi hbj, As_disj i_ne_j
+            (hbi.trans (inter_subset_left _ _)) (hbj.trans (inter_subset_left _ _)), },
+  { refine (lt_of_le_of_lt (measure_mono _) (measure_spanning_sets_lt_top μ n)).ne,
+    exact Union_subset (λ i, inter_subset_right _ _), },
+end
+
+lemma countable_meas_level_set_pos {α β : Type*}
+  [measurable_space α] {μ : measure α} [sigma_finite μ]
+  [measurable_space β] [measurable_singleton_class β] {g : α → β} (g_mble : measurable g) :
+  set.countable {t : β | 0 < μ {a : α | g a = t}} :=
+begin
+  have level_sets_disjoint : pairwise (disjoint on (λ (t : β), {a : α | g a = t})),
+    from λ s t hst, disjoint.preimage g (disjoint_singleton.mpr hst),
+  exact measure.countable_meas_pos_of_disjoint_Union
+    (λ b, g_mble (‹measurable_singleton_class β›.measurable_set_singleton b)) level_sets_disjoint,
+end
+
+/-- If a set `t` is covered by a countable family of finite measure sets, then its measurable
+superset `to_measurable μ t` (which has the same measure as `t`) satisfies,
+for any measurable set `s`, the equality `μ (to_measurable μ t ∩ s) = μ (t ∩ s)`. -/
+lemma measure_to_measurable_inter_of_cover
+  {s : set α} (hs : measurable_set s) {t : set α} {v : ℕ → set α} (hv : t ⊆ ⋃ n, v n)
+  (h'v : ∀ n, μ (t ∩ v n) ≠ ∞) :
   μ (to_measurable μ t ∩ s) = μ (t ∩ s) :=
 begin
   -- we show that there is a measurable superset of `t` satisfying the conclusion for any
@@ -2522,43 +3201,57 @@ begin
   -- (which is well behaved for finite measure sets thanks to `measure_to_measurable_inter`), and
   -- the desired property passes to the union.
   have A : ∃ t' ⊇ t, measurable_set t' ∧ (∀ u, measurable_set u → μ (t' ∩ u) = μ (t ∩ u)),
-  { set t' := ⋃ n, to_measurable μ (t ∩ disjointed (spanning_sets μ) n) with ht',
+  { let w := λ n, to_measurable μ (t ∩ v n),
+    have hw : ∀ n, μ (w n) < ∞,
+    { assume n,
+      simp_rw [w, measure_to_measurable],
+      exact (h'v n).lt_top },
+    set t' := ⋃ n, to_measurable μ (t ∩ disjointed w n) with ht',
     have tt' : t ⊆ t' := calc
-      t ⊆ ⋃ n, t ∩ disjointed (spanning_sets μ) n :
-        by rw [← inter_Union, Union_disjointed, Union_spanning_sets, inter_univ]
-      ... ⊆ ⋃ n, to_measurable μ (t ∩ disjointed (spanning_sets μ) n) :
+      t ⊆ ⋃ n, t ∩ disjointed w n :
+        begin
+          rw [← inter_Union, Union_disjointed, inter_Union],
+          assume x hx,
+          rcases mem_Union.1 (hv hx) with ⟨n, hn⟩,
+          refine mem_Union.2 ⟨n, _⟩,
+          have : x ∈ t ∩ v n := ⟨hx, hn⟩,
+          exact ⟨hx, subset_to_measurable μ _ this⟩,
+        end
+      ... ⊆ ⋃ n, to_measurable μ (t ∩ disjointed w n) :
         Union_mono (λ n, subset_to_measurable _ _),
     refine ⟨t', tt', measurable_set.Union (λ n, measurable_set_to_measurable μ _), λ u hu, _⟩,
     apply le_antisymm _ (measure_mono (inter_subset_inter tt' subset.rfl)),
-    calc μ (t' ∩ u) ≤ ∑' n, μ (to_measurable μ (t ∩ disjointed (spanning_sets μ) n) ∩ u) :
+    calc μ (t' ∩ u) ≤ ∑' n, μ (to_measurable μ (t ∩ disjointed w n) ∩ u) :
       by { rw [ht', Union_inter], exact measure_Union_le _ }
-    ... = ∑' n, μ ((t ∩ disjointed (spanning_sets μ) n) ∩ u) :
+    ... = ∑' n, μ ((t ∩ disjointed w n) ∩ u) :
       begin
         congr' 1,
         ext1 n,
         apply measure_to_measurable_inter hu,
         apply ne_of_lt,
-        calc μ (t ∩ disjointed (spanning_sets μ) n)
-            ≤ μ (disjointed (spanning_sets μ) n) : measure_mono (inter_subset_right _ _)
-        ... ≤ μ (spanning_sets μ n) : measure_mono (disjointed_le (spanning_sets μ) n)
-        ... < ∞ : measure_spanning_sets_lt_top _ _
+        calc μ (t ∩ disjointed w n)
+            ≤ μ (t ∩ w n) : measure_mono ((inter_subset_inter_right _ (disjointed_le w n)))
+        ... ≤ μ (w n) : measure_mono (inter_subset_right _ _)
+        ... < ∞ : hw n
       end
-    ... = ∑' n, μ.restrict (t ∩ u) (disjointed (spanning_sets μ) n) :
+    ... = ∑' n, μ.restrict (t ∩ u) (disjointed w n) :
       begin
         congr' 1,
         ext1 n,
         rw [restrict_apply, inter_comm t _, inter_assoc],
-        exact measurable_set.disjointed (measurable_spanning_sets _) _
+        apply measurable_set.disjointed (λ n, _),
+        exact measurable_set_to_measurable _ _
       end
-    ... = μ.restrict (t ∩ u) (⋃ n, disjointed (spanning_sets μ) n) :
+    ... = μ.restrict (t ∩ u) (⋃ n, disjointed w n) :
       begin
         rw measure_Union,
         { exact disjoint_disjointed _ },
-        { intro i, exact measurable_set.disjointed (measurable_spanning_sets _) _ }
+        { intro i,
+          apply measurable_set.disjointed (λ n, _),
+          exact measurable_set_to_measurable _ _ }
       end
-    ... = μ (t ∩ u) :
-      by rw [Union_disjointed, Union_spanning_sets, restrict_apply measurable_set.univ,
-             univ_inter] },
+    ... ≤ μ.restrict (t ∩ u) univ : measure_mono (subset_univ _)
+    ... = μ (t ∩ u) : by rw [restrict_apply measurable_set.univ, univ_inter] },
   -- thanks to the definition of `to_measurable`, the previous property will also be shared
   -- by `to_measurable μ t`, which is enough to conclude the proof.
   rw [to_measurable],
@@ -2568,6 +3261,27 @@ begin
   { exact A.some_spec.snd.2 s hs },
 end
 
+lemma restrict_to_measurable_of_cover {s : set α} {v : ℕ → set α} (hv : s ⊆ ⋃ n, v n)
+  (h'v : ∀ n, μ (s ∩ v n) ≠ ∞) :
+  μ.restrict (to_measurable μ s) = μ.restrict s :=
+ext $ λ t ht, by simp only [restrict_apply ht, inter_comm t,
+  measure_to_measurable_inter_of_cover ht hv h'v]
+
+/-- The measurable superset `to_measurable μ t` of `t` (which has the same measure as `t`)
+satisfies, for any measurable set `s`, the equality `μ (to_measurable μ t ∩ s) = μ (t ∩ s)`.
+This only holds when `μ` is σ-finite. For a version without this assumption (but requiring
+that `t` has finite measure), see `measure_to_measurable_inter`. -/
+lemma measure_to_measurable_inter_of_sigma_finite
+  [sigma_finite μ] {s : set α} (hs : measurable_set s) (t : set α) :
+  μ (to_measurable μ t ∩ s) = μ (t ∩ s) :=
+begin
+  have : t ⊆ ⋃ n, spanning_sets μ n,
+  { rw Union_spanning_sets, exact subset_univ _ },
+  apply measure_to_measurable_inter_of_cover hs this (λ n, ne_of_lt _),
+  calc μ (t ∩ spanning_sets μ n) ≤ μ(spanning_sets μ n) : measure_mono (inter_subset_right _ _)
+  ... < ∞ : measure_spanning_sets_lt_top μ n,
+end
+
 @[simp] lemma restrict_to_measurable_of_sigma_finite [sigma_finite μ] (s : set α) :
   μ.restrict (to_measurable μ s) = μ.restrict s :=
 ext $ λ t ht, by simp only [restrict_apply ht, inter_comm t,
@@ -2604,7 +3318,7 @@ protected lemma is_countably_spanning (h : μ.finite_spanning_sets_in C) : is_co
 
 end finite_spanning_sets_in
 
-lemma sigma_finite_of_countable {S : set (set α)} (hc : countable S)
+lemma sigma_finite_of_countable {S : set (set α)} (hc : S.countable)
   (hμ : ∀ s ∈ S, μ s < ∞) (hU : ⋃₀ S = univ) :
   sigma_finite μ :=
 begin
@@ -2628,14 +3342,35 @@ lemma sigma_finite_of_le (μ : measure α) [hs : sigma_finite μ]
 
 end measure
 
-include m0
-
 /-- Every finite measure is σ-finite. -/
 @[priority 100]
-instance is_finite_measure.to_sigma_finite (μ : measure α) [is_finite_measure μ] :
+instance is_finite_measure.to_sigma_finite {m0 : measurable_space α} (μ : measure α)
+  [is_finite_measure μ] :
   sigma_finite μ :=
 ⟨⟨⟨λ _, univ, λ _, trivial, λ _, measure_lt_top μ _, Union_const _⟩⟩⟩
 
+lemma sigma_finite_bot_iff (μ : @measure α ⊥) : sigma_finite μ ↔ is_finite_measure μ :=
+begin
+  refine ⟨λ h, ⟨_⟩, λ h, by { haveI := h, apply_instance, }⟩,
+  haveI : sigma_finite μ := h,
+  let s := spanning_sets μ,
+  have hs_univ : (⋃ i, s i) = set.univ := Union_spanning_sets μ,
+  have hs_meas : ∀ i, measurable_set[⊥] (s i) := measurable_spanning_sets μ,
+  simp_rw measurable_space.measurable_set_bot_iff at hs_meas,
+  by_cases h_univ_empty : set.univ = ∅,
+  { rw [h_univ_empty, measure_empty], exact ennreal.zero_ne_top.lt_top, },
+  obtain ⟨i, hsi⟩ : ∃ i, s i = set.univ,
+  { by_contra h_not_univ,
+    push_neg at h_not_univ,
+    have h_empty : ∀ i, s i = ∅, by simpa [h_not_univ] using hs_meas,
+    simp [h_empty] at hs_univ,
+    exact h_univ_empty hs_univ.symm, },
+  rw ← hsi,
+  exact measure_spanning_sets_lt_top μ i,
+end
+
+include m0
+
 instance restrict.sigma_finite (μ : measure α) [sigma_finite μ] (s : set α) :
   sigma_finite (μ.restrict s) :=
 begin
@@ -2644,10 +3379,10 @@ begin
   exact (measure_mono $ inter_subset_left _ _).trans_lt (measure_spanning_sets_lt_top μ i)
 end
 
-instance sum.sigma_finite {ι} [fintype ι] (μ : ι → measure α) [∀ i, sigma_finite (μ i)] :
+instance sum.sigma_finite {ι} [finite ι] (μ : ι → measure α) [∀ i, sigma_finite (μ i)] :
   sigma_finite (sum μ) :=
 begin
-  haveI : encodable ι := fintype.to_encodable ι,
+  casesI nonempty_fintype ι,
   have : ∀ n, measurable_set (⋂ (i : ι), spanning_sets (μ i) n) :=
     λ n, measurable_set.Inter (λ i, measurable_spanning_sets (μ i) n),
   refine ⟨⟨⟨λ n, ⋂ i, spanning_sets (μ i) n, λ _, trivial, λ n, _, _⟩⟩⟩,
@@ -2738,6 +3473,17 @@ begin
     ennreal.coe_of_nnreal_hom, ne.def, not_false_iff],
 end
 
+protected lemma measure.is_topological_basis_is_open_lt_top [topological_space α] (μ : measure α)
+  [is_locally_finite_measure μ] :
+  topological_space.is_topological_basis {s | is_open s ∧ μ s < ∞} :=
+begin
+  refine topological_space.is_topological_basis_of_open_of_nhds (λ s hs, hs.1) _,
+  assume x s xs hs,
+  rcases μ.exists_is_open_measure_lt_top x with ⟨v, xv, hv, μv⟩,
+  refine ⟨v ∩ s, ⟨hv.inter hs, lt_of_le_of_lt _ μv⟩, ⟨xv, xs⟩, inter_subset_right _ _⟩,
+  exact measure_mono (inter_subset_left _ _),
+end
+
 /-- A measure `μ` is finite on compacts if any compact set `K` satisfies `μ K < ∞`. -/
 @[protect_proj] class is_finite_measure_on_compacts [topological_space α] (μ : measure α) : Prop :=
 (lt_top_of_is_compact : ∀ ⦃K : set α⦄, is_compact K → μ K < ∞)
@@ -2771,6 +3517,13 @@ protected lemma is_finite_measure_on_compacts.smul [topological_space α] (μ :
   is_finite_measure_on_compacts (c • μ) :=
 ⟨λ K hK, ennreal.mul_lt_top hc (hK.measure_lt_top).ne⟩
 
+/-- Note this cannot be an instance because it would form a typeclass loop with
+`is_finite_measure_on_compacts_of_is_locally_finite_measure`. -/
+lemma compact_space.is_finite_measure
+  [topological_space α] [compact_space α] [is_finite_measure_on_compacts μ] :
+  is_finite_measure μ :=
+⟨is_finite_measure_on_compacts.lt_top_of_is_compact is_compact_univ⟩
+
 omit m0
 
 @[priority 100] -- see Note [lower instance priority]
@@ -2795,6 +3548,22 @@ lemma is_locally_finite_measure_of_is_finite_measure_on_compacts [topological_sp
   exact ⟨K, K_mem, K_compact.measure_lt_top⟩,
 end⟩
 
+lemma exists_pos_measure_of_cover [countable ι] {U : ι → set α} (hU : (⋃ i, U i) = univ)
+  (hμ : μ ≠ 0) : ∃ i, 0 < μ (U i) :=
+begin
+  contrapose! hμ with H,
+  rw [← measure_univ_eq_zero, ← hU],
+  exact measure_Union_null (λ i, nonpos_iff_eq_zero.1 (H i))
+end
+
+lemma exists_pos_preimage_ball [pseudo_metric_space δ] (f : α → δ) (x : δ) (hμ : μ ≠ 0) :
+  ∃ n : ℕ, 0 < μ (f ⁻¹' metric.ball x n) :=
+exists_pos_measure_of_cover (by rw [← preimage_Union, metric.Union_ball_nat, preimage_univ]) hμ
+
+lemma exists_pos_ball [pseudo_metric_space α] (x : α) (hμ : μ ≠ 0) :
+  ∃ n : ℕ, 0 < μ (metric.ball x n) :=
+exists_pos_preimage_ball id x hμ
+
 /-- If a set has zero measure in a neighborhood of each of its points, then it has zero measure
 in a second-countable space. -/
 lemma null_of_locally_null [topological_space α] [second_countable_topology α]
@@ -2829,7 +3598,7 @@ lemma ext_on_measurable_space_of_generate_finite {α} (m₀ : measurable_space 
   {μ ν : measure α} [is_finite_measure μ]
   (C : set (set α)) (hμν : ∀ s ∈ C, μ s = ν s) {m : measurable_space α}
   (h : m ≤ m₀) (hA : m = measurable_space.generate_from C) (hC : is_pi_system C)
-  (h_univ : μ set.univ = ν set.univ) {s : set α} (hs : m.measurable_set' s) :
+  (h_univ : μ set.univ = ν set.univ) {s : set α} (hs : measurable_set[m] s) :
   μ s = ν s :=
 begin
   haveI : is_finite_measure ν := begin
@@ -2908,7 +3677,7 @@ begin
   exact measure_mono_ae (mem_of_superset hu (λ x hu ht, ⟨ht, hu⟩))
 end
 
-alias inf_ae_iff ↔ measure_theory.measure.finite_at_filter.of_inf_ae _
+alias inf_ae_iff ↔ of_inf_ae _
 
 lemma filter_mono_ae (h : f ⊓ μ.ae ≤ g) (hg : μ.finite_at_filter g) : μ.finite_at_filter f :=
 inf_ae_iff.1 (hg.filter_mono h)
@@ -2992,6 +3761,11 @@ lemma restrict_map (μ : measure α) (s : set β) :
   (μ.map f).restrict s = (μ.restrict $ f ⁻¹' s).map f :=
 measure.ext $ λ t ht, by simp [hf.map_apply, ht, hf.measurable ht]
 
+protected lemma comap_preimage (μ : measure β) {s : set β} (hs : measurable_set s) :
+  μ.comap f (f ⁻¹' s) = μ (s ∩ range f) :=
+comap_preimage _ _ hf.injective hf.measurable
+  (λ t ht, (hf.measurable_set_image' ht).null_measurable_set) hs
+
 end measurable_embedding
 
 section subtype
@@ -3010,7 +3784,7 @@ lemma ae_restrict_iff_subtype {m0 : measurable_space α} {μ : measure α} {s :
   (∀ᵐ x ∂(μ.restrict s), p x) ↔ ∀ᵐ x ∂(comap (coe : s → α) μ), p ↑x :=
 by rw [← map_comap_subtype_coe hs, (measurable_embedding.subtype_coe hs).ae_map_iff]
 
-variables [measure_space α]
+variables [measure_space α] {s t : set α}
 
 /-!
 ### Volume on `s : set α`
@@ -3022,7 +3796,7 @@ instance _root_.set_coe.measure_space (s : set α) : measure_space s :=
 lemma volume_set_coe_def (s : set α) : (volume : measure s) = comap (coe : s → α) volume := rfl
 
 lemma measurable_set.map_coe_volume {s : set α} (hs : measurable_set s) :
-  volume.map (coe : s → α)= restrict volume s :=
+  volume.map (coe : s → α) = restrict volume s :=
 by rw [volume_set_coe_def, (measurable_embedding.subtype_coe hs).map_comap volume,
   subtype.range_coe]
 
@@ -3030,6 +3804,12 @@ lemma volume_image_subtype_coe {s : set α} (hs : measurable_set s) (t : set s)
   volume (coe '' t : set α) = volume t :=
 (comap_subtype_coe_apply hs volume t).symm
 
+@[simp] lemma volume_preimage_coe (hs : null_measurable_set s) (ht : measurable_set t) :
+  volume ((coe : s → α) ⁻¹' t) = volume (t ∩ s) :=
+by rw [volume_set_coe_def, comap_apply₀ _ _ subtype.coe_injective
+  (λ h, measurable_set.null_measurable_set_subtype_coe hs)
+  (measurable_subtype_coe ht).null_measurable_set, image_preimage_eq_inter_range, subtype.range_coe]
+
 end subtype
 
 namespace measurable_equiv
@@ -3063,6 +3843,10 @@ e.measurable_embedding.restrict_map _ _
 lemma map_ae (f : α ≃ᵐ β) (μ : measure α) : filter.map f μ.ae = (map f μ).ae :=
 by { ext s, simp_rw [mem_map, mem_ae_iff, ← preimage_compl, f.map_apply] }
 
+lemma quasi_measure_preserving_symm (μ : measure α) (e : α ≃ᵐ β) :
+  quasi_measure_preserving e.symm (map e μ) μ :=
+⟨e.symm.measurable, by rw [measure.map_map, e.symm_comp_self, measure.map_id]; measurability⟩
+
 end measurable_equiv
 
 
@@ -3146,6 +3930,34 @@ instance is_finite_measure_trim (hm : m ≤ m0) [is_finite_measure μ] :
 { measure_univ_lt_top :=
     by { rw trim_measurable_set_eq hm (@measurable_set.univ _ m), exact measure_lt_top _ _, } }
 
+lemma sigma_finite_trim_mono {m m₂ m0 : measurable_space α} {μ : measure α} (hm : m ≤ m0)
+  (hm₂ : m₂ ≤ m) [sigma_finite (μ.trim (hm₂.trans hm))] :
+  sigma_finite (μ.trim hm) :=
+begin
+  have h := measure.finite_spanning_sets_in (μ.trim (hm₂.trans hm)) set.univ,
+  refine measure.finite_spanning_sets_in.sigma_finite _,
+  { use set.univ, },
+  { refine
+    { set := spanning_sets (μ.trim (hm₂.trans hm)),
+      set_mem := λ _, set.mem_univ _,
+      finite := λ i, _, -- This is the only one left to prove
+      spanning := Union_spanning_sets _, },
+    calc (μ.trim hm) (spanning_sets (μ.trim (hm₂.trans hm)) i)
+        = ((μ.trim hm).trim hm₂) (spanning_sets (μ.trim (hm₂.trans hm)) i) :
+      by rw @trim_measurable_set_eq α m₂ m (μ.trim hm) _ hm₂ (measurable_spanning_sets _ _)
+    ... = (μ.trim (hm₂.trans hm)) (spanning_sets (μ.trim (hm₂.trans hm)) i) :
+      by rw @trim_trim _ _ μ _ _ hm₂ hm
+    ... < ∞ : measure_spanning_sets_lt_top _ _, },
+end
+
+lemma sigma_finite_trim_bot_iff : sigma_finite (μ.trim bot_le) ↔ is_finite_measure μ :=
+begin
+  rw sigma_finite_bot_iff,
+  refine ⟨λ h, ⟨_⟩, λ h, ⟨_⟩⟩; have h_univ := h.measure_univ_lt_top,
+  { rwa trim_measurable_set_eq bot_le measurable_set.univ at h_univ, },
+  { rwa trim_measurable_set_eq bot_le measurable_set.univ, },
+end
+
 end trim
 
 end measure_theory
@@ -3195,6 +4007,15 @@ instance is_finite_measure_on_compacts_of_is_locally_finite_measure
   [is_locally_finite_measure μ] : is_finite_measure_on_compacts μ :=
 ⟨λ s hs, hs.measure_lt_top_of_nhds_within $ λ x hx, μ.finite_at_nhds_within _ _⟩
 
+lemma is_finite_measure_iff_is_finite_measure_on_compacts_of_compact_space
+  [topological_space α] [measurable_space α] {μ : measure α} [compact_space α] :
+  is_finite_measure μ ↔ is_finite_measure_on_compacts μ :=
+begin
+  split; introsI,
+  { apply_instance, },
+  { exact compact_space.is_finite_measure, },
+end
+
 /-- Compact covering of a `σ`-compact topological space as
 `measure_theory.measure.finite_spanning_sets_in`. -/
 def measure_theory.measure.finite_spanning_sets_in_compact [topological_space α]
@@ -3219,6 +4040,43 @@ def measure_theory.measure.finite_spanning_sets_in_open [topological_space α]
     ((is_compact_compact_covering α n).exists_open_superset_measure_lt_top μ).some_spec.fst)
     (Union_compact_covering α) }
 
+open topological_space
+
+/-- A locally finite measure on a second countable topological space admits a finite spanning
+sequence of open sets. -/
+@[irreducible] def measure_theory.measure.finite_spanning_sets_in_open' [topological_space α]
+  [second_countable_topology α] {m : measurable_space α} (μ : measure α)
+  [is_locally_finite_measure μ] :
+  μ.finite_spanning_sets_in {K | is_open K} :=
+begin
+  suffices H : nonempty (μ.finite_spanning_sets_in {K | is_open K}), from H.some,
+  casesI is_empty_or_nonempty α,
+  { exact
+      ⟨{ set := λ n, ∅, set_mem := λ n, by simp, finite := λ n, by simp, spanning := by simp }⟩ },
+  inhabit α,
+  let S : set (set α) := {s | is_open s ∧ μ s < ∞},
+  obtain ⟨T, T_count, TS, hT⟩ : ∃ T : set (set α), T.countable ∧ T ⊆ S ∧ ⋃₀ T = ⋃₀ S :=
+    is_open_sUnion_countable S (λ s hs, hs.1),
+  rw μ.is_topological_basis_is_open_lt_top.sUnion_eq at hT,
+  have T_ne : T.nonempty,
+  { by_contra h'T,
+    simp only [not_nonempty_iff_eq_empty.1 h'T, sUnion_empty] at hT,
+    simpa only [← hT] using mem_univ (default : α) },
+  obtain ⟨f, hf⟩ : ∃ f : ℕ → set α, T = range f, from T_count.exists_eq_range T_ne,
+  have fS : ∀ n, f n ∈ S,
+  { assume n,
+    apply TS,
+    rw hf,
+    exact mem_range_self n },
+  refine ⟨{ set := f, set_mem := λ n, (fS n).1, finite := λ n, (fS n).2, spanning := _ }⟩,
+  apply eq_univ_of_forall (λ x, _),
+  obtain ⟨t, tT, xt⟩ : ∃ (t : set α), t ∈ range f ∧ x ∈ t,
+  { have : x ∈ ⋃₀ T, by simp only [hT],
+    simpa only [mem_sUnion, exists_prop, ← hf] },
+  obtain ⟨n, rfl⟩ : ∃ (n : ℕ), f n = t, by simpa only using tT,
+  exact mem_Union_of_mem _ xt,
+end
+
 section measure_Ixx
 
 variables [preorder α] [topological_space α] [compact_Icc_space α]
@@ -3302,12 +4160,45 @@ piecewise_ae_eq_restrict hs
 lemma indicator_ae_eq_restrict_compl (hs : measurable_set s) : indicator s f =ᵐ[μ.restrict sᶜ] 0 :=
 piecewise_ae_eq_restrict_compl hs
 
+lemma indicator_ae_eq_of_restrict_compl_ae_eq_zero (hs : measurable_set s)
+  (hf : f =ᵐ[μ.restrict sᶜ] 0) :
+  s.indicator f =ᵐ[μ] f :=
+begin
+  rw [filter.eventually_eq, ae_restrict_iff' hs.compl] at hf,
+  filter_upwards [hf] with x hx,
+  by_cases hxs : x ∈ s,
+  { simp only [hxs, set.indicator_of_mem], },
+  { simp only [hx hxs, pi.zero_apply, set.indicator_apply_eq_zero, eq_self_iff_true,
+      implies_true_iff], },
+end
+
+lemma indicator_ae_eq_zero_of_restrict_ae_eq_zero (hs : measurable_set s)
+  (hf : f =ᵐ[μ.restrict s] 0) :
+  s.indicator f =ᵐ[μ] 0 :=
+begin
+  rw [filter.eventually_eq, ae_restrict_iff' hs] at hf,
+  filter_upwards [hf] with x hx,
+  by_cases hxs : x ∈ s,
+  { simp only [hxs, hx hxs, set.indicator_of_mem], },
+  { simp [hx, hxs], },
+end
+
 lemma indicator_ae_eq_of_ae_eq_set (hst : s =ᵐ[μ] t) : s.indicator f =ᵐ[μ] t.indicator f :=
 piecewise_ae_eq_of_ae_eq_set hst
 
 lemma indicator_meas_zero (hs : μ s = 0) : indicator s f =ᵐ[μ] 0 :=
 (indicator_empty' f) ▸ indicator_ae_eq_of_ae_eq_set (ae_eq_empty.2 hs)
 
-variables [measurable_space β]
+lemma ae_eq_restrict_iff_indicator_ae_eq {g : α → β} (hs : measurable_set s) :
+  f =ᵐ[μ.restrict s] g ↔ s.indicator f =ᵐ[μ] s.indicator g :=
+begin
+  rw [filter.eventually_eq, ae_restrict_iff' hs],
+  refine ⟨λ h, _, λ h, _⟩; filter_upwards [h] with x hx,
+  { by_cases hxs : x ∈ s,
+    { simp [hxs, hx hxs], },
+    { simp [hxs], }, },
+  { intros hxs,
+    simpa [hxs] using hx, },
+end
 
 end indicator_function
diff --git a/src/measure_theory/measure/measure_space_def.lean b/src/measure_theory/measure/measure_space_def.lean
index 6868f5d4042af..1669f42d69e17 100644
--- a/src/measure_theory/measure/measure_space_def.lean
+++ b/src/measure_theory/measure/measure_space_def.lean
@@ -5,11 +5,13 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import measure_theory.measure.outer_measure
 import order.filter.countable_Inter
-import data.set.accumulate
 
 /-!
 # Measure spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines measure spaces, the almost-everywhere filter and ae_measurable functions.
 See `measure_theory.measure_space` for their properties and for extended documentation.
 
@@ -17,10 +19,10 @@ Given a measurable space `α`, a measure on `α` is a function that sends measur
 extended nonnegative reals that satisfies the following conditions:
 1. `μ ∅ = 0`;
 2. `μ` is countably additive. This means that the measure of a countable union of pairwise disjoint
-   sets is equal to the measure of the individual sets.
+   sets is equal to the sum of the measures of the individual sets.
 
 Every measure can be canonically extended to an outer measure, so that it assigns values to
-all subsets, not just the measurable subsets. On the other hand, a measure that is countably
+all subsets, not just the measurable subsets. On the other hand, an outer measure that is countably
 additive on measurable sets can be restricted to measurable sets to obtain a measure.
 In this file a measure is defined to be an outer measure that is countably additive on
 measurable sets, with the additional assumption that the outer measure is the canonical
@@ -55,7 +57,7 @@ measure, almost everywhere, measure space
 noncomputable theory
 
 open classical set filter (hiding map) function measurable_space
-open_locale classical topological_space big_operators filter ennreal nnreal
+open_locale classical topology big_operators filter ennreal nnreal
 
 variables {α β γ δ ι : Type*}
 
@@ -157,7 +159,7 @@ lemma measure_eq_extend (hs : measurable_set s) :
 @[simp] lemma measure_empty : μ ∅ = 0 := μ.empty
 
 lemma nonempty_of_measure_ne_zero (h : μ s ≠ 0) : s.nonempty :=
-ne_empty_iff_nonempty.1 $ λ h', h $ h'.symm ▸ measure_empty
+nonempty_iff_ne_empty.2 $ λ h', h $ h'.symm ▸ measure_empty
 
 lemma measure_mono (h : s₁ ⊆ s₂) : μ s₁ ≤ μ s₂ := μ.mono h
 
@@ -174,7 +176,7 @@ by simpa only [← measure_eq_trim] using μ.to_outer_measure.exists_measurable_
 
 /-- For every set `s` and a countable collection of measures `μ i` there exists a measurable
 superset `t ⊇ s` such that each measure `μ i` takes the same value on `s` and `t`. -/
-lemma exists_measurable_superset_forall_eq {ι} [encodable ι] (μ : ι → measure α) (s : set α) :
+lemma exists_measurable_superset_forall_eq {ι} [countable ι] (μ : ι → measure α) (s : set α) :
   ∃ t, s ⊆ t ∧ measurable_set t ∧ ∀ i, μ i t = μ i s :=
 by simpa only [← measure_eq_trim]
   using outer_measure.exists_measurable_superset_forall_eq_trim (λ i, (μ i).to_outer_measure) s
@@ -192,16 +194,12 @@ lemma exists_measurable_superset_iff_measure_eq_zero :
   (∃ t, s ⊆ t ∧ measurable_set t ∧ μ t = 0) ↔ μ s = 0 :=
 ⟨λ ⟨t, hst, _, ht⟩, measure_mono_null hst ht, exists_measurable_superset_of_null⟩
 
-theorem measure_Union_le [encodable β] (s : β → set α) : μ (⋃ i, s i) ≤ ∑' i, μ (s i) :=
+theorem measure_Union_le [countable β] (s : β → set α) : μ (⋃ i, s i) ≤ ∑' i, μ (s i) :=
 μ.to_outer_measure.Union _
 
-lemma measure_bUnion_le {s : set β} (hs : countable s) (f : β → set α) :
+lemma measure_bUnion_le {s : set β} (hs : s.countable) (f : β → set α) :
   μ (⋃ b ∈ s, f b) ≤ ∑' p : s, μ (f p) :=
-begin
-  haveI := hs.to_encodable,
-  rw [bUnion_eq_Union],
-  apply measure_Union_le
-end
+by { haveI := hs.to_subtype, rw bUnion_eq_Union, apply measure_Union_le }
 
 lemma measure_bUnion_finset_le (s : finset β) (f : β → set α) :
   μ (⋃ b ∈ s, f b) ≤ ∑ p in s, μ (f p) :=
@@ -214,7 +212,7 @@ lemma measure_Union_fintype_le [fintype β] (f : β → set α) :
   μ (⋃ b, f b) ≤ ∑ p, μ (f p) :=
 by { convert measure_bUnion_finset_le finset.univ f, simp }
 
-lemma measure_bUnion_lt_top {s : set β} {f : β → set α} (hs : finite s)
+lemma measure_bUnion_lt_top {s : set β} {f : β → set α} (hs : s.finite)
   (hfin : ∀ i ∈ s, μ (f i) ≠ ∞) : μ (⋃ i ∈ s, f i) < ∞ :=
 begin
   convert (measure_bUnion_finset_le hs.to_finset f).trans_lt _,
@@ -222,19 +220,25 @@ begin
   apply ennreal.sum_lt_top, simpa only [finite.mem_to_finset]
 end
 
-lemma measure_Union_null [encodable β] {s : β → set α} :
-  (∀ i, μ (s i) = 0) → μ (⋃ i, s i) = 0 :=
+lemma measure_Union_null [countable β] {s : β → set α} : (∀ i, μ (s i) = 0) → μ (⋃ i, s i) = 0 :=
 μ.to_outer_measure.Union_null
 
-@[simp] lemma measure_Union_null_iff [encodable ι] {s : ι → set α} :
+@[simp] lemma measure_Union_null_iff [countable ι] {s : ι → set α} :
   μ (⋃ i, s i) = 0 ↔ ∀ i, μ (s i) = 0 :=
 μ.to_outer_measure.Union_null_iff
 
-lemma measure_bUnion_null_iff {s : set ι} (hs : countable s) {t : ι → set α} :
+/-- A version of `measure_Union_null_iff` for unions indexed by Props
+TODO: in the long run it would be better to combine this with `measure_Union_null_iff` by
+generalising to `Sort`. -/
+@[simp] lemma measure_Union_null_iff' {ι : Prop} {s : ι → set α} :
+  μ (⋃ i, s i) = 0 ↔ ∀ i, μ (s i) = 0 :=
+μ.to_outer_measure.Union_null_iff'
+
+lemma measure_bUnion_null_iff {s : set ι} (hs : s.countable) {t : ι → set α} :
   μ (⋃ i ∈ s, t i) = 0 ↔ ∀ i ∈ s, μ (t i) = 0 :=
 μ.to_outer_measure.bUnion_null_iff hs
 
-lemma measure_sUnion_null_iff {S : set (set α)} (hS : countable S) :
+lemma measure_sUnion_null_iff {S : set (set α)} (hS : S.countable) :
   μ (⋃₀ S) = 0 ↔ ∀ s ∈ S, μ s = 0 :=
 μ.to_outer_measure.sUnion_null_iff hS
 
@@ -265,12 +269,11 @@ lemma measure_union_ne_top (hs : μ s ≠ ∞) (ht : μ t ≠ ∞) : μ (s ∪ t
 not_iff_not.1 $ by simp only [← lt_top_iff_ne_top, ← ne.def, not_or_distrib,
   measure_union_lt_top_iff]
 
-lemma exists_measure_pos_of_not_measure_Union_null [encodable β] {s : β → set α}
+lemma exists_measure_pos_of_not_measure_Union_null [countable β] {s : β → set α}
   (hs : μ (⋃ n, s n) ≠ 0) : ∃ n, 0 < μ (s n) :=
 begin
-  by_contra' h,
-  simp_rw nonpos_iff_eq_zero at h,
-  exact hs (measure_Union_null h),
+  contrapose! hs,
+  exact measure_Union_null (λ n, nonpos_iff_eq_zero.1 (hs n))
 end
 
 lemma measure_inter_lt_top_of_left_ne_top (hs_finite : μ s ≠ ∞) : μ (s ∩ t) < ∞ :=
@@ -325,19 +328,15 @@ eventually_of_forall
 instance : countable_Inter_filter μ.ae :=
 ⟨begin
   intros S hSc hS,
-  simp only [mem_ae_iff, compl_sInter, sUnion_image, bUnion_eq_Union] at hS ⊢,
-  haveI := hSc.to_encodable,
-  exact measure_Union_null (subtype.forall.2 hS)
+  rw [mem_ae_iff, compl_sInter, sUnion_image],
+  exact (measure_bUnion_null_iff hSc).2 hS
 end⟩
 
-lemma ae_imp_iff {p : α → Prop} {q : Prop} : (∀ᵐ x ∂μ, q → p x) ↔ (q → ∀ᵐ x ∂μ, p x) :=
-filter.eventually_imp_distrib_left
-
-lemma ae_all_iff [encodable ι] {p : α → ι → Prop} :
-  (∀ᵐ a ∂ μ, ∀ i, p a i) ↔ (∀ i, ∀ᵐ a ∂ μ, p a i) :=
+lemma ae_all_iff {ι : Sort*} [countable ι] {p : α → ι → Prop} :
+  (∀ᵐ a ∂ μ, ∀ i, p a i) ↔ ∀ i, ∀ᵐ a ∂ μ, p a i :=
 eventually_countable_forall
 
-lemma ae_ball_iff {S : set ι} (hS : countable S) {p : Π (x : α) (i ∈ S), Prop} :
+lemma ae_ball_iff {S : set ι} (hS : S.countable) {p : Π (x : α) (i ∈ S), Prop} :
   (∀ᵐ x ∂ μ, ∀ i ∈ S, p x i ‹_›) ↔ ∀ i ∈ S, ∀ᵐ x ∂ μ, p x i ‹_› :=
 eventually_countable_ball hS
 
@@ -371,7 +370,11 @@ lemma ae_le_set_inter {s' t' : set α} (h : s ≤ᵐ[μ] t) (h' : s' ≤ᵐ[μ]
   (s ∩ s' : set α) ≤ᵐ[μ] (t ∩ t' : set α) :=
 h.inter h'
 
-@[simp] lemma union_ae_eq_right : (s ∪ t : set α) =ᵐ[μ] t ↔ μ (s \ t) = 0 :=
+lemma ae_le_set_union {s' t' : set α} (h : s ≤ᵐ[μ] t) (h' : s' ≤ᵐ[μ] t') :
+  (s ∪ s' : set α) ≤ᵐ[μ] (t ∪ t' : set α) :=
+h.union h'
+
+lemma union_ae_eq_right : (s ∪ t : set α) =ᵐ[μ] t ↔ μ (s \ t) = 0 :=
 by simp [eventually_le_antisymm_iff, ae_le_set, union_diff_right,
   diff_eq_empty.2 (set.subset_union_right _ _)]
 
@@ -386,14 +389,62 @@ lemma ae_eq_set {s t : set α} :
   s =ᵐ[μ] t ↔ μ (s \ t) = 0 ∧ μ (t \ s) = 0 :=
 by simp [eventually_le_antisymm_iff, ae_le_set]
 
+@[simp] lemma measure_symm_diff_eq_zero_iff {s t : set α} :
+  μ (s ∆ t) = 0 ↔ s =ᵐ[μ] t :=
+by simp [ae_eq_set, symm_diff_def]
+
+@[simp] lemma ae_eq_set_compl_compl {s t : set α} :
+  sᶜ =ᵐ[μ] tᶜ ↔ s =ᵐ[μ] t :=
+by simp only [← measure_symm_diff_eq_zero_iff, compl_symm_diff_compl]
+
+lemma ae_eq_set_compl {s t : set α} :
+  sᶜ =ᵐ[μ] t ↔ s =ᵐ[μ] tᶜ :=
+by rw [← ae_eq_set_compl_compl, compl_compl]
+
 lemma ae_eq_set_inter {s' t' : set α} (h : s =ᵐ[μ] t) (h' : s' =ᵐ[μ] t') :
   (s ∩ s' : set α) =ᵐ[μ] (t ∩ t' : set α) :=
 h.inter h'
 
+lemma ae_eq_set_union {s' t' : set α} (h : s =ᵐ[μ] t) (h' : s' =ᵐ[μ] t') :
+  (s ∪ s' : set α) =ᵐ[μ] (t ∪ t' : set α) :=
+h.union h'
+
+lemma union_ae_eq_univ_of_ae_eq_univ_left (h : s =ᵐ[μ] univ) :
+  (s ∪ t : set α) =ᵐ[μ] univ :=
+by { convert ae_eq_set_union h (ae_eq_refl t), rw univ_union, }
+
+lemma union_ae_eq_univ_of_ae_eq_univ_right (h : t =ᵐ[μ] univ) :
+  (s ∪ t : set α) =ᵐ[μ] univ :=
+by { convert ae_eq_set_union (ae_eq_refl s) h, rw union_univ, }
+
+lemma union_ae_eq_right_of_ae_eq_empty (h : s =ᵐ[μ] (∅ : set α)) :
+  (s ∪ t : set α) =ᵐ[μ] t :=
+by { convert ae_eq_set_union h (ae_eq_refl t), rw empty_union, }
+
+lemma union_ae_eq_left_of_ae_eq_empty (h : t =ᵐ[μ] (∅ : set α)) :
+  (s ∪ t : set α) =ᵐ[μ] s :=
+by { convert ae_eq_set_union (ae_eq_refl s) h, rw union_empty, }
+
+lemma inter_ae_eq_right_of_ae_eq_univ (h : s =ᵐ[μ] univ) :
+  (s ∩ t : set α) =ᵐ[μ] t :=
+by { convert ae_eq_set_inter h (ae_eq_refl t), rw univ_inter, }
+
+lemma inter_ae_eq_left_of_ae_eq_univ (h : t =ᵐ[μ] univ) :
+  (s ∩ t : set α) =ᵐ[μ] s :=
+by { convert ae_eq_set_inter (ae_eq_refl s) h, rw inter_univ, }
+
+lemma inter_ae_eq_empty_of_ae_eq_empty_left (h : s =ᵐ[μ] (∅ : set α)) :
+  (s ∩ t : set α) =ᵐ[μ] (∅ : set α) :=
+by { convert ae_eq_set_inter h (ae_eq_refl t), rw empty_inter, }
+
+lemma inter_ae_eq_empty_of_ae_eq_empty_right (h : t =ᵐ[μ] (∅ : set α)) :
+  (s ∩ t : set α) =ᵐ[μ] (∅ : set α) :=
+by { convert ae_eq_set_inter (ae_eq_refl s) h, rw inter_empty, }
+
 @[to_additive]
-lemma _root_.set.mul_indicator_ae_eq_one {M : Type*} [has_one M] {f : α → M} {s : set α}
-  (h : s.mul_indicator f =ᵐ[μ] 1) : μ (s ∩ function.mul_support f) = 0 :=
-by simpa [filter.eventually_eq, ae_iff] using h
+lemma _root_.set.mul_indicator_ae_eq_one {M : Type*} [has_one M] {f : α → M} {s : set α} :
+  s.mul_indicator f =ᵐ[μ] 1 ↔ μ (s ∩ f.mul_support) = 0 :=
+by simpa [eventually_eq, eventually_iff, measure.ae, compl_set_of]
 
 /-- If `s ⊆ t` modulo a set of measure `0`, then `μ s ≤ μ t`. -/
 @[mono] lemma measure_mono_ae (H : s ≤ᵐ[μ] t) : μ s ≤ μ t :=
@@ -402,13 +453,13 @@ calc μ s ≤ μ (s ∪ t)       : measure_mono $ subset_union_left s t
      ... ≤ μ t + μ (s \ t) : measure_union_le _ _
      ... = μ t             : by rw [ae_le_set.1 H, add_zero]
 
-alias measure_mono_ae ← filter.eventually_le.measure_le
+alias measure_mono_ae ← _root_.filter.eventually_le.measure_le
 
 /-- If two sets are equal modulo a set of measure zero, then `μ s = μ t`. -/
 lemma measure_congr (H : s =ᵐ[μ] t) : μ s = μ t :=
 le_antisymm H.le.measure_le H.symm.le.measure_le
 
-alias measure_congr ← filter.eventually_eq.measure_eq
+alias measure_congr ← _root_.filter.eventually_eq.measure_eq
 
 lemma measure_mono_null_ae (H : s ≤ᵐ[μ] t) (ht : μ t = 0) : μ s = 0 :=
 nonpos_iff_eq_zero.1 $ ht ▸ H.measure_le
diff --git a/src/measure_theory/measure/mutually_singular.lean b/src/measure_theory/measure/mutually_singular.lean
index 2df9de47e0ecd..a0744f3019349 100644
--- a/src/measure_theory/measure/mutually_singular.lean
+++ b/src/measure_theory/measure/mutually_singular.lean
@@ -7,10 +7,13 @@ import measure_theory.measure.measure_space
 
 /-! # Mutually singular measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Two measures `μ`, `ν` are said to be mutually singular (`measure_theory.measure.mutually_singular`,
-localized notation `μ ⊥ₘ ν`) if there exists a measurable set `s` such that `μ s = 0` and
+localized notation `μ ⟂ₘ ν`) if there exists a measurable set `s` such that `μ s = 0` and
 `ν sᶜ = 0`. The measurability of `s` is an unnecessary assumption (see
-`measure_theory.measure.mutually_singular.mk`) but we keep it because this way `rcases (h : μ ⊥ₘ ν)`
+`measure_theory.measure.mutually_singular.mk`) but we keep it because this way `rcases (h : μ ⟂ₘ ν)`
 gives us a measurable set and usually it is easy to prove measurability.
 
 In this file we define the predicate `measure_theory.measure.mutually_singular` and prove basic
@@ -35,7 +38,8 @@ such that `μ s = 0` and `ν sᶜ = 0`. -/
 def mutually_singular {m0 : measurable_space α} (μ ν : measure α) : Prop :=
 ∃ (s : set α), measurable_set s ∧ μ s = 0 ∧ ν sᶜ = 0
 
-localized "infix ` ⊥ₘ `:60 := measure_theory.measure.mutually_singular" in measure_theory
+localized "infix (name := measure.mutually_singular)
+  ` ⟂ₘ `:60 := measure_theory.measure.mutually_singular" in measure_theory
 
 namespace mutually_singular
 
@@ -47,23 +51,23 @@ begin
   exact subset_to_measurable _ _ hxs
 end
 
-@[simp] lemma zero_right : μ ⊥ₘ 0 := ⟨∅, measurable_set.empty, measure_empty, rfl⟩
+@[simp] lemma zero_right : μ ⟂ₘ 0 := ⟨∅, measurable_set.empty, measure_empty, rfl⟩
 
-@[symm] lemma symm (h : ν ⊥ₘ μ) : μ ⊥ₘ ν :=
+@[symm] lemma symm (h : ν ⟂ₘ μ) : μ ⟂ₘ ν :=
 let ⟨i, hi, his, hit⟩ := h in ⟨iᶜ, hi.compl, hit, (compl_compl i).symm ▸ his⟩
 
-lemma comm : μ ⊥ₘ ν ↔ ν ⊥ₘ μ := ⟨λ h, h.symm, λ h, h.symm⟩
+lemma comm : μ ⟂ₘ ν ↔ ν ⟂ₘ μ := ⟨λ h, h.symm, λ h, h.symm⟩
 
-@[simp] lemma zero_left : 0 ⊥ₘ μ := zero_right.symm
+@[simp] lemma zero_left : 0 ⟂ₘ μ := zero_right.symm
 
-lemma mono_ac (h : μ₁ ⊥ₘ ν₁) (hμ : μ₂ ≪ μ₁) (hν : ν₂ ≪ ν₁) : μ₂ ⊥ₘ ν₂ :=
+lemma mono_ac (h : μ₁ ⟂ₘ ν₁) (hμ : μ₂ ≪ μ₁) (hν : ν₂ ≪ ν₁) : μ₂ ⟂ₘ ν₂ :=
 let ⟨s, hs, h₁, h₂⟩ := h in ⟨s, hs, hμ h₁, hν h₂⟩
 
-lemma mono (h : μ₁ ⊥ₘ ν₁) (hμ : μ₂ ≤ μ₁) (hν : ν₂ ≤ ν₁) : μ₂ ⊥ₘ ν₂ :=
+lemma mono (h : μ₁ ⟂ₘ ν₁) (hμ : μ₂ ≤ μ₁) (hν : ν₂ ≤ ν₁) : μ₂ ⟂ₘ ν₂ :=
 h.mono_ac hμ.absolutely_continuous hν.absolutely_continuous
 
-@[simp] lemma sum_left {ι : Type*} [encodable ι] {μ : ι → measure α} :
-  (sum μ) ⊥ₘ ν ↔ ∀ i, μ i ⊥ₘ ν :=
+@[simp] lemma sum_left {ι : Type*} [countable ι] {μ : ι → measure α} :
+  (sum μ) ⟂ₘ ν ↔ ∀ i, μ i ⟂ₘ ν :=
 begin
   refine ⟨λ h i, h.mono (le_sum _ _) le_rfl, λ H, _⟩,
   choose s hsm hsμ hsν using H,
@@ -73,26 +77,26 @@ begin
   { rwa [compl_Inter, measure_Union_null_iff], }
 end
 
-@[simp] lemma sum_right {ι : Type*} [encodable ι] {ν : ι → measure α} :
-  μ ⊥ₘ sum ν ↔ ∀ i, μ ⊥ₘ ν i :=
+@[simp] lemma sum_right {ι : Type*} [countable ι] {ν : ι → measure α} :
+  μ ⟂ₘ sum ν ↔ ∀ i, μ ⟂ₘ ν i :=
 comm.trans $ sum_left.trans $ forall_congr $ λ i, comm
 
-@[simp] lemma add_left_iff : μ₁ + μ₂ ⊥ₘ ν ↔ μ₁ ⊥ₘ ν ∧ μ₂ ⊥ₘ ν :=
+@[simp] lemma add_left_iff : μ₁ + μ₂ ⟂ₘ ν ↔ μ₁ ⟂ₘ ν ∧ μ₂ ⟂ₘ ν :=
 by rw [← sum_cond, sum_left, bool.forall_bool, cond, cond, and.comm]
 
-@[simp] lemma add_right_iff : μ ⊥ₘ ν₁ + ν₂ ↔ μ ⊥ₘ ν₁ ∧ μ ⊥ₘ ν₂ :=
+@[simp] lemma add_right_iff : μ ⟂ₘ ν₁ + ν₂ ↔ μ ⟂ₘ ν₁ ∧ μ ⟂ₘ ν₂ :=
 comm.trans $ add_left_iff.trans $ and_congr comm comm
 
-lemma add_left (h₁ : ν₁ ⊥ₘ μ) (h₂ : ν₂ ⊥ₘ μ) : ν₁ + ν₂ ⊥ₘ μ :=
+lemma add_left (h₁ : ν₁ ⟂ₘ μ) (h₂ : ν₂ ⟂ₘ μ) : ν₁ + ν₂ ⟂ₘ μ :=
 add_left_iff.2 ⟨h₁, h₂⟩
 
-lemma add_right (h₁ : μ ⊥ₘ ν₁) (h₂ : μ ⊥ₘ ν₂) : μ ⊥ₘ ν₁ + ν₂ :=
+lemma add_right (h₁ : μ ⟂ₘ ν₁) (h₂ : μ ⟂ₘ ν₂) : μ ⟂ₘ ν₁ + ν₂ :=
 add_right_iff.2 ⟨h₁, h₂⟩
 
-lemma smul (r : ℝ≥0∞) (h : ν ⊥ₘ μ) : r • ν ⊥ₘ μ :=
+lemma smul (r : ℝ≥0∞) (h : ν ⟂ₘ μ) : r • ν ⟂ₘ μ :=
 h.mono_ac (absolutely_continuous.rfl.smul r) absolutely_continuous.rfl
 
-lemma smul_nnreal (r : ℝ≥0) (h : ν ⊥ₘ μ) : r • ν ⊥ₘ μ := h.smul r
+lemma smul_nnreal (r : ℝ≥0) (h : ν ⟂ₘ μ) : r • ν ⟂ₘ μ := h.smul r
 
 end mutually_singular
 
diff --git a/src/measure_theory/measure/null_measurable.lean b/src/measure_theory/measure/null_measurable.lean
index f64dcb5ca470d..1cdffc8d4a321 100644
--- a/src/measure_theory/measure/null_measurable.lean
+++ b/src/measure_theory/measure/null_measurable.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.ae_disjoint
 /-!
 # Null measurable sets and complete measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 ### Null measurable sets and functions
@@ -109,50 +112,36 @@ protected lemma congr (hs : null_measurable_set s μ) (h : s =ᵐ[μ] t) :
   null_measurable_set t μ :=
 let ⟨s', hm, hs'⟩ := hs in ⟨s', hm, h.symm.trans hs'⟩
 
-protected lemma Union [encodable ι] {s : ι → set α}
-  (h : ∀ i, null_measurable_set (s i) μ) : null_measurable_set (⋃ i, s i) μ :=
+protected lemma Union {ι : Sort*} [countable ι] {s : ι → set α}
+  (h : ∀ i, null_measurable_set (s i) μ) :
+  null_measurable_set (⋃ i, s i) μ :=
 measurable_set.Union h
 
 protected lemma bUnion_decode₂ [encodable ι] ⦃f : ι → set α⦄ (h : ∀ i, null_measurable_set (f i) μ)
   (n : ℕ) : null_measurable_set (⋃ b ∈ encodable.decode₂ ι n, f b) μ :=
 measurable_set.bUnion_decode₂ h n
 
-protected lemma bUnion {f : ι → set α} {s : set ι} (hs : countable s)
+protected lemma bUnion {f : ι → set α} {s : set ι} (hs : s.countable)
   (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋃ b ∈ s, f b) μ :=
 measurable_set.bUnion hs h
 
-protected lemma sUnion {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, null_measurable_set t μ) :
+protected lemma sUnion {s : set (set α)} (hs : s.countable) (h : ∀ t ∈ s, null_measurable_set t μ) :
   null_measurable_set (⋃₀ s) μ :=
 by { rw sUnion_eq_bUnion, exact measurable_set.bUnion hs h }
 
-lemma Union_Prop {p : Prop} {f : p → set α} (hf : ∀ i, null_measurable_set (f i) μ) :
-  null_measurable_set (⋃ i, f i) μ :=
-measurable_set.Union_Prop hf
-
-lemma Union_fintype [fintype ι] {f : ι → set α} (h : ∀ b, null_measurable_set (f b) μ) :
-  null_measurable_set (⋃ b, f b) μ :=
-measurable_set.Union_fintype h
-
-protected lemma Inter [encodable ι] {f : ι → set α} (h : ∀ i, null_measurable_set (f i) μ) :
+protected lemma Inter {ι : Sort*} [countable ι] {f : ι → set α}
+  (h : ∀ i, null_measurable_set (f i) μ) :
   null_measurable_set (⋂ i, f i) μ :=
 measurable_set.Inter h
 
-protected lemma bInter {f : β → set α} {s : set β} (hs : countable s)
+protected lemma bInter {f : β → set α} {s : set β} (hs : s.countable)
   (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋂ b ∈ s, f b) μ :=
 measurable_set.bInter hs h
 
-protected lemma sInter {s : set (set α)} (hs : countable s) (h : ∀ t ∈ s, null_measurable_set t μ) :
+protected lemma sInter {s : set (set α)} (hs : s.countable) (h : ∀ t ∈ s, null_measurable_set t μ) :
   null_measurable_set (⋂₀ s) μ :=
 measurable_set.sInter hs h
 
-lemma Inter_Prop {p : Prop} {f : p → set α} (hf : ∀ b, null_measurable_set (f b) μ) :
-  null_measurable_set (⋂ b, f b) μ :=
-measurable_set.Inter_Prop hf
-
-lemma Inter_fintype [fintype ι] {f : ι → set α} (h : ∀ b, null_measurable_set (f b) μ) :
-  null_measurable_set (⋂ b, f b) μ :=
-measurable_set.Inter_fintype h
-
 @[simp] protected lemma union (hs : null_measurable_set s μ) (ht : null_measurable_set t μ) :
   null_measurable_set (s ∪ t) μ :=
 hs.union ht
@@ -215,7 +204,7 @@ end null_measurable_set
 /-- If `sᵢ` is a countable family of (null) measurable pairwise `μ`-a.e. disjoint sets, then there
 exists a subordinate family `tᵢ ⊆ sᵢ` of measurable pairwise disjoint sets such that
 `tᵢ =ᵐ[μ] sᵢ`. -/
-lemma exists_subordinate_pairwise_disjoint [encodable ι] {s : ι → set α}
+lemma exists_subordinate_pairwise_disjoint [countable ι] {s : ι → set α}
   (h : ∀ i, null_measurable_set (s i) μ) (hd : pairwise (ae_disjoint μ on s)) :
   ∃ t : ι → set α, (∀ i, t i ⊆ s i) ∧ (∀ i, s i =ᵐ[μ] t i) ∧ (∀ i, measurable_set (t i)) ∧
     pairwise (disjoint on t) :=
@@ -228,7 +217,7 @@ begin
       λ i j h, h.mono (diff_subset_diff_left (ht_sub i)) (diff_subset_diff_left (ht_sub j))⟩
 end
 
-lemma measure_Union {m0 : measurable_space α} {μ : measure α} [encodable ι] {f : ι → set α}
+lemma measure_Union {m0 : measurable_space α} {μ : measure α} [countable ι] {f : ι → set α}
   (hn : pairwise (disjoint on f)) (h : ∀ i, measurable_set (f i)) :
   μ (⋃ i, f i) = ∑' i, μ (f i) :=
 begin
@@ -239,8 +228,8 @@ begin
   { exact μ.m_Union }
 end
 
-lemma measure_Union₀ [encodable ι] {f : ι → set α}
-  (hd : pairwise (ae_disjoint μ on f)) (h : ∀ i, null_measurable_set (f i) μ) :
+lemma measure_Union₀ [countable ι] {f : ι → set α} (hd : pairwise (ae_disjoint μ on f))
+  (h : ∀ i, null_measurable_set (f i) μ) :
   μ (⋃ i, f i) = ∑' i, μ (f i) :=
 begin
   rcases exists_subordinate_pairwise_disjoint h hd with ⟨t, ht_sub, ht_eq, htm, htd⟩,
@@ -294,6 +283,10 @@ lemma measure_union₀' (hs : null_measurable_set s μ) (hd : ae_disjoint μ s t
   μ (s ∪ t) = μ s + μ t :=
 by rw [union_comm, measure_union₀ hs hd.symm, add_comm]
 
+lemma measure_add_measure_compl₀ {s : set α} (hs : null_measurable_set s μ) :
+  μ s + μ sᶜ = μ univ :=
+by rw [← measure_union₀' hs ae_disjoint_compl_right, union_compl_self]
+
 section measurable_singleton_class
 
 variable [measurable_singleton_class (null_measurable_space α μ)]
@@ -308,7 +301,7 @@ measurable_set_insert
 lemma null_measurable_set_eq {a : α} : null_measurable_set {x | x = a} μ :=
 null_measurable_set_singleton a
 
-protected lemma _root_.set.finite.null_measurable_set (hs : finite s) : null_measurable_set s μ :=
+protected lemma _root_.set.finite.null_measurable_set (hs : s.finite) : null_measurable_set s μ :=
 finite.measurable_set hs
 
 protected lemma _root_.finset.null_measurable_set (s : finset α) : null_measurable_set ↑s μ :=
@@ -316,7 +309,7 @@ finset.measurable_set s
 
 end measurable_singleton_class
 
-lemma _root_.set.finite.null_measurable_set_bUnion {f : ι → set α} {s : set ι} (hs : finite s)
+lemma _root_.set.finite.null_measurable_set_bUnion {f : ι → set α} {s : set ι} (hs : s.finite)
   (h : ∀ b ∈ s, null_measurable_set (f b) μ) :
   null_measurable_set (⋃ b ∈ s, f b) μ :=
 finite.measurable_set_bUnion hs h
@@ -326,12 +319,12 @@ lemma _root_.finset.null_measurable_set_bUnion {f : ι → set α} (s : finset 
   null_measurable_set (⋃ b ∈ s, f b) μ :=
 finset.measurable_set_bUnion s h
 
-lemma _root_.set.finite.null_measurable_set_sUnion {s : set (set α)} (hs : finite s)
+lemma _root_.set.finite.null_measurable_set_sUnion {s : set (set α)} (hs : s.finite)
   (h : ∀ t ∈ s, null_measurable_set t μ) :
   null_measurable_set (⋃₀ s) μ :=
 finite.measurable_set_sUnion hs h
 
-lemma _root_.set.finite.null_measurable_set_bInter {f : ι → set α} {s : set ι} (hs : finite s)
+lemma _root_.set.finite.null_measurable_set_bInter {f : ι → set α} {s : set ι} (hs : s.finite)
   (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋂ b ∈ s, f b) μ :=
 finite.measurable_set_bInter hs h
 
@@ -339,7 +332,7 @@ lemma _root_.finset.null_measurable_set_bInter {f : ι → set α} (s : finset 
   (h : ∀ b ∈ s, null_measurable_set (f b) μ) : null_measurable_set (⋂ b ∈ s, f b) μ :=
 s.finite_to_set.null_measurable_set_bInter h
 
-lemma _root_.set.finite.null_measurable_set_sInter {s : set (set α)} (hs : finite s)
+lemma _root_.set.finite.null_measurable_set_sInter {s : set (set α)} (hs : s.finite)
   (h : ∀ t ∈ s, null_measurable_set t μ) : null_measurable_set (⋂₀ s) μ :=
 null_measurable_set.sInter hs.countable h
 
diff --git a/src/measure_theory/measure/open_pos.lean b/src/measure_theory/measure/open_pos.lean
index 2bea33870b654..08f94286ff3ee 100644
--- a/src/measure_theory/measure/open_pos.lean
+++ b/src/measure_theory/measure/open_pos.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.measure_space
 /-!
 # Measures positive on nonempty opens
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define a typeclass for measures that are positive on nonempty opens, see
 `measure_theory.measure.is_open_pos_measure`. Examples include (additive) Haar measures, as well as
 measures that have positive density with respect to a Haar measure. We also prove some basic facts
@@ -15,7 +18,7 @@ about these measures.
 
 -/
 
-open_locale topological_space ennreal measure_theory
+open_locale topology ennreal measure_theory
 open set function filter
 
 namespace measure_theory
@@ -40,7 +43,7 @@ lemma _root_.is_open.measure_pos (hU : is_open U) (hne : U.nonempty) : 0 < μ U
 (hU.measure_ne_zero μ hne).bot_lt
 
 lemma _root_.is_open.measure_pos_iff (hU : is_open U) : 0 < μ U ↔ U.nonempty :=
-⟨λ h, ne_empty_iff_nonempty.1 $ λ he, h.ne' $ he.symm ▸ measure_empty, hU.measure_pos μ⟩
+⟨λ h, nonempty_iff_ne_empty.2 $ λ he, h.ne' $ he.symm ▸ measure_empty, hU.measure_pos μ⟩
 
 lemma _root_.is_open.measure_eq_zero_iff (hU : is_open U) : μ U = 0 ↔ U = ∅ :=
 by simpa only [not_lt, nonpos_iff_eq_zero, not_nonempty_iff_eq_empty]
diff --git a/src/measure_theory/measure/outer_measure.lean b/src/measure_theory/measure/outer_measure.lean
index c098e9403dfac..d4f4103e49130 100644
--- a/src/measure_theory/measure/outer_measure.lean
+++ b/src/measure_theory/measure/outer_measure.lean
@@ -5,12 +5,15 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import analysis.specific_limits.basic
 import measure_theory.pi_system
+import data.countable.basic
 import data.fin.vec_notation
-import topology.algebra.infinite_sum
 
 /-!
 # Outer Measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 An outer measure is a function `μ : set α → ℝ≥0∞`, from the powerset of a type to the extended
 nonnegative real numbers that satisfies the following conditions:
 1. `μ ∅ = 0`;
@@ -52,8 +55,8 @@ outer measure, Carathéodory-measurable, Carathéodory's criterion
 
 noncomputable theory
 
-open set finset function filter encodable topological_space (second_countable_topology)
-open_locale classical big_operators nnreal topological_space ennreal
+open set function filter topological_space (second_countable_topology)
+open_locale classical big_operators nnreal topology ennreal measure_theory
 
 namespace measure_theory
 
@@ -86,24 +89,30 @@ lemma pos_of_subset_ne_zero (m : outer_measure α) {a b : set α} (hs : a ⊆ b)
   0 < m b :=
 (lt_of_lt_of_le (pos_iff_ne_zero.mpr hnz) (m.mono hs))
 
-protected theorem Union (m : outer_measure α)
-  {β} [encodable β] (s : β → set α) :
+protected theorem Union (m : outer_measure α) {β} [countable β] (s : β → set α) :
   m (⋃ i, s i) ≤ ∑' i, m (s i) :=
 rel_supr_tsum m m.empty (≤) m.Union_nat s
 
-lemma Union_null [encodable β] (m : outer_measure α) {s : β → set α} (h : ∀ i, m (s i) = 0) :
+lemma Union_null [countable β] (m : outer_measure α) {s : β → set α} (h : ∀ i, m (s i) = 0) :
   m (⋃ i, s i) = 0 :=
 by simpa [h] using m.Union s
 
-@[simp] lemma Union_null_iff [encodable β] (m : outer_measure α) {s : β → set α} :
+@[simp] lemma Union_null_iff [countable β] (m : outer_measure α) {s : β → set α} :
   m (⋃ i, s i) = 0 ↔ ∀ i, m (s i) = 0 :=
 ⟨λ h i, m.mono_null (subset_Union _ _) h, m.Union_null⟩
 
-lemma bUnion_null_iff (m : outer_measure α) {s : set β} (hs : countable s) {t : β → set α} :
+/-- A version of `Union_null_iff` for unions indexed by Props.
+TODO: in the long run it would be better to combine this with `Union_null_iff` by
+generalising to `Sort`. -/
+@[simp] lemma Union_null_iff' (m : outer_measure α) {ι : Prop} {s : ι → set α} :
+  m (⋃ i, s i) = 0 ↔ ∀ i, m (s i) = 0 :=
+by by_cases i : ι; simp [i]
+
+lemma bUnion_null_iff (m : outer_measure α) {s : set β} (hs : s.countable) {t : β → set α} :
   m (⋃ i ∈ s, t i) = 0 ↔ ∀ i ∈ s, m (t i) = 0 :=
 by { haveI := hs.to_encodable, rw [bUnion_eq_Union, Union_null_iff, set_coe.forall'] }
 
-lemma sUnion_null_iff (m : outer_measure α) {S : set (set α)} (hS : countable S) :
+lemma sUnion_null_iff (m : outer_measure α) {S : set (set α)} (hS : S.countable) :
   m (⋃₀ S) = 0 ↔ ∀ s ∈ S, m s = 0 :=
 by rw [sUnion_eq_bUnion, m.bUnion_null_iff hS]
 
@@ -233,11 +242,11 @@ instance : has_add (outer_measure α) :=
 
 theorem add_apply (m₁ m₂ : outer_measure α) (s : set α) : (m₁ + m₂) s = m₁ s + m₂ s := rfl
 
-section has_scalar
-variables [has_scalar R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
-variables [has_scalar R' ℝ≥0∞] [is_scalar_tower R' ℝ≥0∞ ℝ≥0∞]
+section has_smul
+variables [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+variables [has_smul R' ℝ≥0∞] [is_scalar_tower R' ℝ≥0∞ ℝ≥0∞]
 
-instance : has_scalar R (outer_measure α) :=
+instance : has_smul R (outer_measure α) :=
 ⟨λ c m,
   { measure_of := λ s, c • m s,
     empty      := by rw [←smul_one_mul c (_ : ℝ≥0∞), empty', mul_zero],
@@ -257,14 +266,14 @@ lemma smul_apply (c : R) (m : outer_measure α) (s : set α) : (c • m) s = c 
 instance [smul_comm_class R R' ℝ≥0∞] : smul_comm_class R R' (outer_measure α) :=
 ⟨λ _ _ _, ext $ λ _, smul_comm _ _ _⟩
 
-instance [has_scalar R R'] [is_scalar_tower R R' ℝ≥0∞] : is_scalar_tower R R' (outer_measure α) :=
+instance [has_smul R R'] [is_scalar_tower R R' ℝ≥0∞] : is_scalar_tower R R' (outer_measure α) :=
 ⟨λ _ _ _, ext $ λ _, smul_assoc _ _ _⟩
 
-instance [has_scalar Rᵐᵒᵖ ℝ≥0∞] [is_central_scalar R ℝ≥0∞] :
+instance [has_smul Rᵐᵒᵖ ℝ≥0∞] [is_central_scalar R ℝ≥0∞] :
   is_central_scalar R (outer_measure α) :=
 ⟨λ _ _, ext $ λ _, op_smul_eq_smul _ _⟩
 
-end has_scalar
+end has_smul
 
 instance [monoid R] [mul_action R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] :
   mul_action R (outer_measure α) :=
@@ -334,11 +343,10 @@ funext $ λ s, by rw [supr_apply, _root_.supr_apply]
 by have := supr_apply (λ b, cond b m₁ m₂) s;
   rwa [supr_bool_eq, supr_bool_eq] at this
 
-theorem smul_supr [has_scalar R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] {ι}
+theorem smul_supr [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] {ι}
   (f : ι → outer_measure α) (c : R) :
   c • (⨆ i, f i) = ⨆ i, c • f i :=
-ext $ λ s, by simp only [smul_apply, supr_apply, ←smul_one_mul c (f _ _),
-  ←smul_one_mul c (supr _), ennreal.mul_supr]
+ext $ λ s, by simp only [smul_apply, supr_apply, ennreal.smul_supr]
 
 end supremum
 
@@ -521,7 +529,7 @@ let μ := λs, ⨅{f : ℕ → set α} (h : s ⊆ ⋃i, f i), ∑'i, m (f i) in
     infi_mono' $ assume hb, ⟨hs.trans hb, le_rfl⟩,
   Union_nat := assume s, ennreal.le_of_forall_pos_le_add $ begin
     assume ε hε (hb : ∑'i, μ (s i) < ∞),
-    rcases ennreal.exists_pos_sum_of_encodable (ennreal.coe_pos.2 hε).ne' ℕ with ⟨ε', hε', hl⟩,
+    rcases ennreal.exists_pos_sum_of_countable (ennreal.coe_pos.2 hε).ne' ℕ with ⟨ε', hε', hl⟩,
     refine le_trans _ (add_le_add_left (le_of_lt hl) _),
     rw ← ennreal.tsum_add,
     choose f hf using show
@@ -533,12 +541,12 @@ let μ := λs, ⨅{f : ℕ → set α} (h : s ⊆ ⋃i, f i), ∑'i, m (f i) in
           (by simpa using (hε' i).ne'),
       simpa [μ, infi_lt_iff] },
     refine le_trans _ (ennreal.tsum_le_tsum $ λ i, le_of_lt (hf i).2),
-    rw [← ennreal.tsum_prod, ← equiv.nat_prod_nat_equiv_nat.symm.tsum_eq],
+    rw [← ennreal.tsum_prod, ← nat.mkpair_equiv.symm.tsum_eq],
     swap, {apply_instance},
     refine infi_le_of_le _ (infi_le _ _),
     exact Union_subset (λ i, subset.trans (hf i).1 $
       Union_subset $ λ j, subset.trans (by simp) $
-      subset_Union _ $ equiv.nat_prod_nat_equiv_nat (i, j)),
+      subset_Union _ $ nat.mkpair_equiv (i, j)),
   end }
 
 lemma of_function_apply (s : set α) :
@@ -588,7 +596,7 @@ begin
     ... = m (f i) : (h (f i) hs ht).symm
     ... ≤ ∑' i, m (f i) : ennreal.le_tsum i },
   set I := λ s, {i : ℕ | (s ∩ f i).nonempty},
-  have hd : disjoint (I s) (I t), from λ i hi, he ⟨i, hi⟩,
+  have hd : disjoint (I s) (I t), from disjoint_iff_inf_le.mpr (λ i hi, he ⟨i, hi⟩),
   have hI : ∀ u ⊆ s ∪ t, μ u ≤ ∑'  i : I u, μ (f i), from λ u hu,
   calc μ u ≤ μ (⋃ i : I u, f i) :
     μ.mono (λ x hx, let ⟨i, hi⟩ := mem_Union.1 (hf (hu hx)) in mem_Union.2 ⟨⟨i, ⟨x, hx, hi⟩⟩, hi⟩)
@@ -662,7 +670,7 @@ variables {α : Type*} (m : set α → ℝ≥0∞)
   satisfying `μ s ≤ m s` for all `s : set α`. This is the same as `outer_measure.of_function`,
   except that it doesn't require `m ∅ = 0`. -/
 def bounded_by : outer_measure α :=
-outer_measure.of_function (λ s, ⨆ (h : s.nonempty), m s) (by simp [empty_not_nonempty])
+outer_measure.of_function (λ s, ⨆ (h : s.nonempty), m s) (by simp [not_nonempty_empty])
 
 variables {m}
 theorem bounded_by_le (s : set α) : bounded_by m s ≤ m s :=
@@ -672,7 +680,7 @@ theorem bounded_by_eq_of_function (m_empty : m ∅ = 0) (s : set α) :
   bounded_by m s = outer_measure.of_function m m_empty s :=
 begin
   have : (λ s : set α, ⨆ (h : s.nonempty), m s) = m,
-  { ext1 t, cases t.eq_empty_or_nonempty with h h; simp [h, empty_not_nonempty, m_empty] },
+  { ext1 t, cases t.eq_empty_or_nonempty with h h; simp [h, not_nonempty_empty, m_empty] },
   simp [bounded_by, this]
 end
 theorem bounded_by_apply (s : set α) :
@@ -689,13 +697,27 @@ ext $ λ s, bounded_by_eq _ m.empty' (λ t ht, m.mono' ht) m.Union
 theorem le_bounded_by {μ : outer_measure α} : μ ≤ bounded_by m ↔ ∀ s, μ s ≤ m s :=
 begin
   rw [bounded_by, le_of_function, forall_congr], intro s,
-  cases s.eq_empty_or_nonempty with h h; simp [h, empty_not_nonempty]
+  cases s.eq_empty_or_nonempty with h h; simp [h, not_nonempty_empty]
 end
 
 theorem le_bounded_by' {μ : outer_measure α} :
   μ ≤ bounded_by m ↔ ∀ s : set α, s.nonempty → μ s ≤ m s :=
 by { rw [le_bounded_by, forall_congr], intro s, cases s.eq_empty_or_nonempty with h h; simp [h] }
 
+@[simp] lemma bounded_by_top : bounded_by (⊤ : set α → ℝ≥0∞) = ⊤ :=
+begin
+  rw [eq_top_iff, le_bounded_by'],
+  intros s hs,
+  rw top_apply hs,
+  exact le_rfl,
+end
+
+@[simp] lemma bounded_by_zero : bounded_by (0 : set α → ℝ≥0∞) = 0 :=
+begin
+  rw [←coe_bot, eq_bot_iff],
+  apply bounded_by_le,
+end
+
 lemma smul_bounded_by {c : ℝ≥0∞} (hc : c ≠ ∞) : c • bounded_by m = bounded_by (c • m) :=
 begin
   simp only [bounded_by, smul_of_function hc],
@@ -790,7 +812,7 @@ lemma is_caratheodory_sum {s : ℕ → set α} (h : ∀i, is_caratheodory (s i))
   rw [bUnion_lt_succ, finset.sum_range_succ, set.union_comm, is_caratheodory_sum,
     m.measure_inter_union _ (h n), add_comm],
   intro a,
-  simpa using λ (h₁ : a ∈ s n) i (hi : i < n) h₂, hd _ _ (ne_of_gt hi) ⟨h₁, h₂⟩
+  simpa using λ (h₁ : a ∈ s n) i (hi : i < n) h₂, (hd (ne_of_gt hi)).le_bot ⟨h₁, h₂⟩
 end
 
 lemma is_caratheodory_Union_nat {s : ℕ → set α} (h : ∀i, is_caratheodory (s i))
@@ -832,15 +854,15 @@ protected def caratheodory : measurable_space α :=
 caratheodory_dynkin.to_measurable_space $ assume s₁ s₂, is_caratheodory_inter
 
 lemma is_caratheodory_iff {s : set α} :
-  caratheodory.measurable_set' s ↔ ∀t, m t = m (t ∩ s) + m (t \ s) :=
+  measurable_set[caratheodory] s ↔ ∀t, m t = m (t ∩ s) + m (t \ s) :=
 iff.rfl
 
 lemma is_caratheodory_iff_le {s : set α} :
-  caratheodory.measurable_set' s ↔ ∀t, m (t ∩ s) + m (t \ s) ≤ m t :=
+  measurable_set[caratheodory] s ↔ ∀t, m (t ∩ s) + m (t \ s) ≤ m t :=
 is_caratheodory_iff_le'
 
 protected lemma Union_eq_of_caratheodory {s : ℕ → set α}
-  (h : ∀i, caratheodory.measurable_set' (s i)) (hd : pairwise (disjoint on s)) :
+  (h : ∀i, measurable_set[caratheodory] (s i)) (hd : pairwise (disjoint on s)) :
   m (⋃i, s i) = ∑'i, m (s i) :=
 f_Union h hd
 
@@ -850,7 +872,7 @@ variables {α : Type*}
 
 lemma of_function_caratheodory {m : set α → ℝ≥0∞} {s : set α}
   {h₀ : m ∅ = 0} (hs : ∀t, m (t ∩ s) + m (t \ s) ≤ m t) :
-  (outer_measure.of_function m h₀).caratheodory.measurable_set' s :=
+  measurable_set[(outer_measure.of_function m h₀).caratheodory] s :=
 begin
   apply (is_caratheodory_iff_le _).mpr,
   refine λ t, le_infi (λ f, le_infi $ λ hf, _),
@@ -863,11 +885,11 @@ begin
 end
 
 lemma bounded_by_caratheodory {m : set α → ℝ≥0∞} {s : set α}
-  (hs : ∀t, m (t ∩ s) + m (t \ s) ≤ m t) : (bounded_by m).caratheodory.measurable_set' s :=
+  (hs : ∀t, m (t ∩ s) + m (t \ s) ≤ m t) : measurable_set[(bounded_by m).caratheodory] s :=
 begin
   apply of_function_caratheodory, intro t,
   cases t.eq_empty_or_nonempty with h h,
-  { simp [h, empty_not_nonempty] },
+  { simp [h, not_nonempty_empty] },
   { convert le_trans _ (hs t), { simp [h] }, exact add_le_add supr_const_le supr_const_le }
 end
 
@@ -925,7 +947,7 @@ lemma supr_Inf_gen_nonempty {m : set (outer_measure α)} (h : m.nonempty) (t : s
 begin
   rcases t.eq_empty_or_nonempty with rfl|ht,
   { rcases h with ⟨μ, hμ⟩,
-    rw [eq_false_intro empty_not_nonempty, supr_false, eq_comm],
+    rw [eq_false_intro not_nonempty_empty, supr_false, eq_comm],
     simp_rw [empty'],
     apply bot_unique,
     refine infi_le_of_le μ (infi_le _ hμ) },
@@ -1060,6 +1082,17 @@ variables (m : Π (s : α), P s → ℝ≥0∞)
   to all objects by defining it to be `∞` on the objects not in the class. -/
 def extend (s : α) : ℝ≥0∞ := ⨅ h : P s, m s h
 
+lemma smul_extend {R} [has_zero R] [smul_with_zero R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+  [no_zero_smul_divisors R ℝ≥0∞] {c : R} (hc : c ≠ 0) :
+  c • extend m = extend (λ s h, c • m s h) :=
+begin
+  ext1 s,
+  dsimp [extend],
+  by_cases h : P s,
+  { simp [h] },
+  { simp [h, ennreal.smul_top, hc] },
+end
+
 lemma extend_eq {s : α} (h : P s) : extend m s = m s h :=
 by simp [extend, h]
 
@@ -1075,6 +1108,10 @@ lemma extend_congr {β : Type*} {Pb : β → Prop} {mb : Π s : β, Pb s → ℝ
   extend m sa = extend mb sb :=
 infi_congr_Prop hP (λ h, hm _ _)
 
+@[simp] lemma extend_top {α : Type*} {P : α → Prop} :
+  extend (λ s h, ∞ : Π (s : α), P s → ℝ≥0∞) = ⊤ :=
+funext $ λ x, infi_eq_top.mpr $ λ i, rfl
+
 end extend
 
 section extend_set
@@ -1121,10 +1158,11 @@ end mono
 
 section unions
 include P0 m0 PU mU
-lemma extend_Union {β} [encodable β] {f : β → set α}
-  (hd : pairwise (disjoint on f)) (hm : ∀i, P (f i)) :
+lemma extend_Union {β} [countable β] {f : β → set α} (hd : pairwise (disjoint on f))
+  (hm : ∀ i, P (f i)) :
   extend m (⋃i, f i) = ∑'i, extend m (f i) :=
 begin
+  casesI nonempty_encodable β,
   rw [← encodable.Union_decode₂, ← tsum_Union_decode₂],
   { exact extend_Union_nat PU
       (λ n, encodable.Union_decode₂_cases P0 hm)
@@ -1215,7 +1253,7 @@ end
   of `s`.
 -/
 lemma induced_outer_measure_caratheodory (s : set α) :
-  (induced_outer_measure m P0 m0).caratheodory.measurable_set' s ↔ ∀ (t : set α), P t →
+  measurable_set[(induced_outer_measure m P0 m0).caratheodory] s ↔ ∀ (t : set α), P t →
   induced_outer_measure m P0 m0 (t ∩ s) + induced_outer_measure m P0 m0 (t \ s) ≤
     induced_outer_measure m P0 m0 t :=
 begin
@@ -1246,7 +1284,7 @@ lemma extend_mono {s₁ s₂ : set α} (h₁ : measurable_set s₁) (hs : s₁ 
   extend m s₁ ≤ extend m s₂ :=
 begin
   refine le_infi _, intro h₂,
-  have := extend_union measurable_set.empty m0 measurable_set.Union mU disjoint_diff
+  have := extend_union measurable_set.empty m0 measurable_set.Union mU disjoint_sdiff_self_right
     h₁ (h₂.diff h₁),
   rw union_diff_cancel hs at this,
   rw ← extend_eq m,
@@ -1317,6 +1355,8 @@ by simp [infi_subtype, infi_and, trim_eq_infi]
 theorem trim_trim (m : outer_measure α) : m.trim.trim = m.trim :=
 trim_eq_trim_iff.2 $ λ s, m.trim_eq
 
+@[simp] theorem trim_top : (⊤ : outer_measure α).trim = ⊤ := eq_top_iff.2 $ le_trim _
+
 @[simp] theorem trim_zero : (0 : outer_measure α).trim = 0 :=
 ext $ λ s, le_antisymm
   (le_trans ((trim 0).mono (subset_univ s)) $
@@ -1365,7 +1405,7 @@ end
 
 /-- If `μ i` is a countable family of outer measures, then for every set `s` there exists
 a measurable set `t ⊇ s` such that `μ i t = (μ i).trim s` for all `i`. -/
-lemma exists_measurable_superset_forall_eq_trim {ι} [encodable ι] (μ : ι → outer_measure α)
+lemma exists_measurable_superset_forall_eq_trim {ι} [countable ι] (μ : ι → outer_measure α)
   (s : set α) : ∃ t, s ⊆ t ∧ measurable_set t ∧ ∀ i, μ i t = (μ i).trim s :=
 begin
   choose t hst ht hμt using λ i, (μ i).exists_measurable_superset_eq_trim s,
@@ -1399,7 +1439,7 @@ theorem trim_add (m₁ m₂ : outer_measure α) : (m₁ + m₂).trim = m₁.trim
 ext $ trim_binop (add_apply m₁ m₂)
 
 /-- `trim` respects scalar multiplication. -/
-theorem trim_smul {R : Type*} [has_scalar R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+theorem trim_smul {R : Type*} [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
   (c : R) (m : outer_measure α) :
   (c • m).trim = c • m.trim :=
 ext $ trim_op (smul_apply c m)
@@ -1410,12 +1450,13 @@ ext $ λ s, (trim_binop (sup_apply m₁ m₂) s).trans (sup_apply _ _ _).symm
 
 /-- `trim` sends the supremum of a countable family of outer measures to the supremum
 of the trimmed measures. -/
-lemma trim_supr {ι} [encodable ι] (μ : ι → outer_measure α) :
-  trim (⨆ i, μ i) = ⨆ i, trim (μ i) :=
+lemma trim_supr {ι} [countable ι] (μ : ι → outer_measure α) : trim (⨆ i, μ i) = ⨆ i, trim (μ i) :=
 begin
+  simp_rw [←@supr_plift_down _ ι],
   ext1 s,
-  rcases exists_measurable_superset_forall_eq_trim (λ o, option.elim o (supr μ) μ) s
-    with ⟨t, hst, ht, hμt⟩,
+  haveI : countable (option $ plift ι) := @option.countable (plift ι) _,
+  obtain ⟨t, hst, ht, hμt⟩ := exists_measurable_superset_forall_eq_trim
+    (option.elim (⨆ i, μ (plift.down i)) (μ ∘ plift.down)) s,
   simp only [option.forall, option.elim] at hμt,
   simp only [supr_apply, ← hμt.1, ← hμt.2]
 end
diff --git a/src/measure_theory/measure/portmanteau.lean b/src/measure_theory/measure/portmanteau.lean
new file mode 100644
index 0000000000000..12f92076938ed
--- /dev/null
+++ b/src/measure_theory/measure/portmanteau.lean
@@ -0,0 +1,482 @@
+/-
+Copyright (c) 2021 Kalle Kytölä. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kalle Kytölä
+-/
+import measure_theory.measure.probability_measure
+import measure_theory.measure.lebesgue.basic
+
+/-!
+# Characterizations of weak convergence of finite measures and probability measures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file will provide portmanteau characterizations of the weak convergence of finite measures
+and of probability measures, i.e., the standard characterizations of convergence in distribution.
+
+## Main definitions
+
+This file does not introduce substantial new definitions: the topologies of weak convergence on
+the types of finite measures and probability measures are already defined in their corresponding
+files.
+
+## Main results
+
+The main result will be the portmanteau theorem providing various characterizations of the
+weak convergence of measures. The separate implications are:
+ * `measure_theory.finite_measure.limsup_measure_closed_le_of_tendsto` proves that weak convergence
+   implies a limsup-condition for closed sets.
+ * `measure_theory.limsup_measure_closed_le_iff_liminf_measure_open_ge` proves for probability
+   measures the equivalence of the limsup condition for closed sets and the liminf condition for
+   open sets.
+ * `measure_theory.tendsto_measure_of_null_frontier` proves that the liminf condition for open
+   sets (which is equivalent to the limsup condition for closed sets) implies the convergence of
+   probabilities of sets whose boundary carries no mass under the limit measure.
+ * `measure_theory.probability_measure.tendsto_measure_of_null_frontier_of_tendsto` is a
+   combination of earlier implications, which shows that weak convergence of probability measures
+   implies the convergence of probabilities of sets whose boundary carries no mass under the
+   limit measure.
+
+TODO:
+ * Prove the rest of the implications.
+
+## Implementation notes
+
+Many of the characterizations of weak convergence hold for finite measures and are proven in that
+generality and then specialized to probability measures. Some implications hold with slightly
+weaker assumptions than usually stated. The full portmanteau theorem, however, is most convenient
+for probability measures on metrizable spaces with their Borel sigmas.
+
+Some specific considerations on the assumptions in the different implications:
+ * `measure_theory.finite_measure.limsup_measure_closed_le_of_tendsto` assumes
+   `pseudo_emetric_space`. The only reason is to have bounded continuous pointwise approximations
+   to the indicator function of a closed set. Clearly for example metrizability or
+   pseudo-emetrizability would be sufficient assumptions. The typeclass assumptions should be later
+   adjusted in a way that takes into account use cases, but the proof will presumably remain
+   essentially the same.
+ * Where formulations are currently only provided for probability measures, one can obtain the
+   finite measure formulations using the characterization of convergence of finite measures by
+   their total masses and their probability-normalized versions, i.e., by
+   `measure_theory.finite_measure.tendsto_normalize_iff_tendsto`.
+
+## References
+
+* [Billingsley, *Convergence of probability measures*][billingsley1999]
+
+## Tags
+
+weak convergence of measures, convergence in distribution, convergence in law, finite measure,
+probability measure
+
+-/
+
+noncomputable theory
+open measure_theory
+open set
+open filter
+open bounded_continuous_function
+open_locale topology ennreal nnreal bounded_continuous_function
+
+namespace measure_theory
+
+section limsup_closed_le_and_le_liminf_open
+/-! ### Portmanteau: limsup condition for closed sets iff liminf condition for open sets
+
+In this section we prove that for a sequence of Borel probability measures on a topological space
+and its candidate limit measure, the following two conditions are equivalent:
+  (C) For any closed set `F` in `Ω` the limsup of the measures of `F` is at most the limit
+      measure of `F`.
+  (O) For any open set `G` in `Ω` the liminf of the measures of `G` is at least the limit
+      measure of `G`.
+Either of these will later be shown to be equivalent to the weak convergence of the sequence
+of measures.
+-/
+
+variables {Ω : Type*} [measurable_space Ω]
+
+lemma le_measure_compl_liminf_of_limsup_measure_le
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
+  {E : set Ω} (E_mble : measurable_set E) (h : L.limsup (λ i, μs i E) ≤ μ E) :
+  μ Eᶜ ≤ L.liminf (λ i, μs i Eᶜ) :=
+begin
+  by_cases L_bot : L = ⊥,
+  { simp only [L_bot, le_top,
+      (show liminf (λ i, μs i Eᶜ) ⊥ = ⊤, by simp only [liminf, filter.map_bot, Liminf_bot])], },
+  haveI : L.ne_bot, from {ne' := L_bot},
+  have meas_Ec : μ Eᶜ = 1 - μ E,
+  { simpa only [measure_univ] using measure_compl E_mble (measure_lt_top μ E).ne, },
+  have meas_i_Ec : ∀ i, μs i Eᶜ = 1 - μs i E,
+  { intro i,
+    simpa only [measure_univ] using measure_compl E_mble (measure_lt_top (μs i) E).ne, },
+  simp_rw [meas_Ec, meas_i_Ec],
+  have obs : L.liminf (λ (i : ι), 1 - μs i E) = L.liminf ((λ x, 1 - x) ∘ (λ (i : ι), μs i E)),
+    by refl,
+  rw obs,
+  simp_rw ← antitone_const_tsub.map_limsup_of_continuous_at (λ i, μs i E)
+            (ennreal.continuous_sub_left ennreal.one_ne_top).continuous_at,
+  exact antitone_const_tsub h,
+end
+
+lemma le_measure_liminf_of_limsup_measure_compl_le
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
+  {E : set Ω} (E_mble : measurable_set E) (h : L.limsup (λ i, μs i Eᶜ) ≤ μ Eᶜ) :
+  μ E ≤ L.liminf (λ i, μs i E) :=
+compl_compl E ▸ (le_measure_compl_liminf_of_limsup_measure_le (measurable_set.compl E_mble) h)
+
+lemma limsup_measure_compl_le_of_le_liminf_measure
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
+  {E : set Ω} (E_mble : measurable_set E) (h : μ E ≤ L.liminf (λ i, μs i E)) :
+  L.limsup (λ i, μs i Eᶜ) ≤ μ Eᶜ :=
+begin
+  by_cases L_bot : L = ⊥,
+  { simp only [L_bot, bot_le,
+      (show limsup (λ i, μs i Eᶜ) ⊥ = ⊥, by simp only [limsup, filter.map_bot, Limsup_bot])], },
+  haveI : L.ne_bot, from {ne' := L_bot},
+  have meas_Ec : μ Eᶜ = 1 - μ E,
+  { simpa only [measure_univ] using measure_compl E_mble (measure_lt_top μ E).ne, },
+  have meas_i_Ec : ∀ i, μs i Eᶜ = 1 - μs i E,
+  { intro i,
+    simpa only [measure_univ] using measure_compl E_mble (measure_lt_top (μs i) E).ne, },
+  simp_rw [meas_Ec, meas_i_Ec],
+  have obs : L.limsup (λ (i : ι), 1 - μs i E) = L.limsup ((λ x, 1 - x) ∘ (λ (i : ι), μs i E)),
+    by refl,
+  rw obs,
+  simp_rw ← antitone_const_tsub.map_liminf_of_continuous_at (λ i, μs i E)
+            (ennreal.continuous_sub_left ennreal.one_ne_top).continuous_at,
+  exact antitone_const_tsub h,
+end
+
+lemma limsup_measure_le_of_le_liminf_measure_compl
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
+  {E : set Ω} (E_mble : measurable_set E) (h : μ Eᶜ ≤ L.liminf (λ i, μs i Eᶜ)) :
+  L.limsup (λ i, μs i E) ≤ μ E :=
+compl_compl E ▸ (limsup_measure_compl_le_of_le_liminf_measure (measurable_set.compl E_mble) h)
+
+variables [topological_space Ω] [opens_measurable_space Ω]
+
+/-- One pair of implications of the portmanteau theorem:
+For a sequence of Borel probability measures, the following two are equivalent:
+
+(C) The limsup of the measures of any closed set is at most the measure of the closed set
+under a candidate limit measure.
+
+(O) The liminf of the measures of any open set is at least the measure of the open set
+under a candidate limit measure.
+-/
+lemma limsup_measure_closed_le_iff_liminf_measure_open_ge
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)] :
+  (∀ F, is_closed F → L.limsup (λ i, μs i F) ≤ μ F)
+    ↔ (∀ G, is_open G → μ G ≤ L.liminf (λ i, μs i G)) :=
+begin
+  split,
+  { intros h G G_open,
+    exact le_measure_liminf_of_limsup_measure_compl_le
+          G_open.measurable_set (h Gᶜ (is_closed_compl_iff.mpr G_open)), },
+  { intros h F F_closed,
+    exact limsup_measure_le_of_le_liminf_measure_compl
+          F_closed.measurable_set (h Fᶜ (is_open_compl_iff.mpr F_closed)), },
+end
+
+end limsup_closed_le_and_le_liminf_open -- section
+
+section tendsto_of_null_frontier
+/-! ### Portmanteau: limit of measures of Borel sets whose boundary carries no mass in the limit
+
+In this section we prove that for a sequence of Borel probability measures on a topological space
+and its candidate limit measure, either of the following equivalent conditions:
+  (C) For any closed set `F` in `Ω` the limsup of the measures of `F` is at most the limit
+      measure of `F`
+  (O) For any open set `G` in `Ω` the liminf of the measures of `G` is at least the limit
+      measure of `G`
+implies that
+  (B) For any Borel set `E` in `Ω` whose boundary `∂E` carries no mass under the candidate limit
+      measure, we have that the limit of measures of `E` is the measure of `E` under the
+      candidate limit measure.
+-/
+
+variables {Ω : Type*} [measurable_space Ω]
+
+lemma tendsto_measure_of_le_liminf_measure_of_limsup_measure_le
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  {E₀ E E₁ : set Ω} (E₀_subset : E₀ ⊆ E) (subset_E₁ : E ⊆ E₁) (nulldiff : μ (E₁ \ E₀) = 0)
+  (h_E₀ : μ E₀ ≤ L.liminf (λ i, μs i E₀)) (h_E₁ : L.limsup (λ i, μs i E₁) ≤ μ E₁) :
+  L.tendsto (λ i, μs i E) (𝓝 (μ E)) :=
+begin
+  apply tendsto_of_le_liminf_of_limsup_le,
+  { have E₀_ae_eq_E : E₀ =ᵐ[μ] E,
+      from eventually_le.antisymm E₀_subset.eventually_le
+            (subset_E₁.eventually_le.trans (ae_le_set.mpr nulldiff)),
+    calc  μ(E)
+        = μ(E₀)                      : measure_congr E₀_ae_eq_E.symm
+    ... ≤ L.liminf (λ i, μs i E₀)    : h_E₀
+    ... ≤ L.liminf (λ i, μs i E)     : _,
+    { refine liminf_le_liminf (eventually_of_forall (λ _, measure_mono E₀_subset)) _,
+      apply_auto_param, }, },
+  { have E_ae_eq_E₁ : E =ᵐ[μ] E₁,
+      from eventually_le.antisymm subset_E₁.eventually_le
+            ((ae_le_set.mpr nulldiff).trans E₀_subset.eventually_le),
+    calc  L.limsup (λ i, μs i E)
+        ≤ L.limsup (λ i, μs i E₁)    : _
+    ... ≤ μ E₁                       : h_E₁
+    ... = μ E                        : measure_congr E_ae_eq_E₁.symm,
+    { refine limsup_le_limsup (eventually_of_forall (λ _, measure_mono subset_E₁)) _,
+      apply_auto_param, }, },
+end
+
+variables [topological_space Ω] [opens_measurable_space Ω]
+
+/-- One implication of the portmanteau theorem:
+For a sequence of Borel probability measures, if the liminf of the measures of any open set is at
+least the measure of the open set under a candidate limit measure, then for any set whose
+boundary carries no probability mass under the candidate limit measure, then its measures under the
+sequence converge to its measure under the candidate limit measure.
+-/
+lemma tendsto_measure_of_null_frontier
+  {ι : Type*} {L : filter ι} {μ : measure Ω} {μs : ι → measure Ω}
+  [is_probability_measure μ] [∀ i, is_probability_measure (μs i)]
+  (h_opens : ∀ G, is_open G → μ G ≤ L.liminf (λ i, μs i G))
+  {E : set Ω} (E_nullbdry : μ (frontier E) = 0) :
+  L.tendsto (λ i, μs i E) (𝓝 (μ E)) :=
+begin
+  have h_closeds : ∀ F, is_closed F → L.limsup (λ i, μs i F) ≤ μ F,
+    from limsup_measure_closed_le_iff_liminf_measure_open_ge.mpr h_opens,
+  exact tendsto_measure_of_le_liminf_measure_of_limsup_measure_le
+        interior_subset subset_closure E_nullbdry
+        (h_opens _ is_open_interior) (h_closeds _ is_closed_closure),
+end
+
+end tendsto_of_null_frontier --section
+
+section convergence_implies_limsup_closed_le
+/-! ### Portmanteau implication: weak convergence implies a limsup condition for closed sets
+
+In this section we prove, under the assumption that the underlying topological space `Ω` is
+pseudo-emetrizable, that the weak convergence of measures on `measure_theory.finite_measure Ω`
+implies that for any closed set `F` in `Ω` the limsup of the measures of `F` is at most the
+limit measure of `F`. This is one implication of the portmanteau theorem characterizing weak
+convergence of measures.
+
+Combining with an earlier implication we also get that weak convergence implies that for any Borel
+set `E` in `Ω` whose boundary `∂E` carries no mass under the limit measure, the limit of measures
+of `E` is the measure of `E` under the limit measure.
+-/
+
+variables {Ω : Type*} [measurable_space Ω]
+
+/-- If bounded continuous functions tend to the indicator of a measurable set and are
+uniformly bounded, then their integrals against a finite measure tend to the measure of the set.
+This formulation assumes:
+ * the functions tend to a limit along a countably generated filter;
+ * the limit is in the almost everywhere sense;
+ * boundedness holds almost everywhere.
+-/
+lemma measure_of_cont_bdd_of_tendsto_filter_indicator {ι : Type*} {L : filter ι}
+  [L.is_countably_generated] [topological_space Ω] [opens_measurable_space Ω]
+  (μ : measure Ω) [is_finite_measure μ] {c : ℝ≥0} {E : set Ω} (E_mble : measurable_set E)
+  (fs : ι → (Ω →ᵇ ℝ≥0)) (fs_bdd : ∀ᶠ i in L, ∀ᵐ (ω : Ω) ∂μ, fs i ω ≤ c)
+  (fs_lim : ∀ᵐ (ω : Ω) ∂μ,
+            tendsto (λ (i : ι), (coe_fn : (Ω →ᵇ ℝ≥0) → (Ω → ℝ≥0)) (fs i) ω) L
+                    (𝓝 (indicator E (λ x, (1 : ℝ≥0)) ω))) :
+  tendsto (λ n, lintegral μ (λ ω, fs n ω)) L (𝓝 (μ E)) :=
+begin
+  convert finite_measure.tendsto_lintegral_nn_filter_of_le_const μ fs_bdd fs_lim,
+  have aux : ∀ ω, indicator E (λ ω, (1 : ℝ≥0∞)) ω = ↑(indicator E (λ ω, (1 : ℝ≥0)) ω),
+  from λ ω, by simp only [ennreal.coe_indicator, ennreal.coe_one],
+  simp_rw [←aux, lintegral_indicator _ E_mble],
+  simp only [lintegral_one, measure.restrict_apply, measurable_set.univ, univ_inter],
+end
+
+/-- If a sequence of bounded continuous functions tends to the indicator of a measurable set and
+the functions are uniformly bounded, then their integrals against a finite measure tend to the
+measure of the set.
+
+A similar result with more general assumptions is
+`measure_theory.measure_of_cont_bdd_of_tendsto_filter_indicator`.
+-/
+lemma measure_of_cont_bdd_of_tendsto_indicator
+  [topological_space Ω] [opens_measurable_space Ω]
+  (μ : measure Ω) [is_finite_measure μ] {c : ℝ≥0} {E : set Ω} (E_mble : measurable_set E)
+  (fs : ℕ → (Ω →ᵇ ℝ≥0)) (fs_bdd : ∀ n ω, fs n ω ≤ c)
+  (fs_lim : tendsto (λ (n : ℕ), (coe_fn : (Ω →ᵇ ℝ≥0) → (Ω → ℝ≥0)) (fs n))
+            at_top (𝓝 (indicator E (λ x, (1 : ℝ≥0))))) :
+  tendsto (λ n, lintegral μ (λ ω, fs n ω)) at_top (𝓝 (μ E)) :=
+begin
+  have fs_lim' : ∀ ω, tendsto (λ (n : ℕ), (fs n ω : ℝ≥0))
+                 at_top (𝓝 (indicator E (λ x, (1 : ℝ≥0)) ω)),
+  by { rw tendsto_pi_nhds at fs_lim, exact λ ω, fs_lim ω, },
+  apply measure_of_cont_bdd_of_tendsto_filter_indicator μ E_mble fs
+      (eventually_of_forall (λ n, eventually_of_forall (fs_bdd n))) (eventually_of_forall fs_lim'),
+end
+
+/-- The integrals of thickened indicators of a closed set against a finite measure tend to the
+measure of the closed set if the thickening radii tend to zero.
+-/
+lemma tendsto_lintegral_thickened_indicator_of_is_closed
+  {Ω : Type*} [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
+  (μ : measure Ω) [is_finite_measure μ] {F : set Ω} (F_closed : is_closed F) {δs : ℕ → ℝ}
+  (δs_pos : ∀ n, 0 < δs n) (δs_lim : tendsto δs at_top (𝓝 0)) :
+  tendsto (λ n, lintegral μ (λ ω, (thickened_indicator (δs_pos n) F ω : ℝ≥0∞)))
+          at_top (𝓝 (μ F)) :=
+begin
+  apply measure_of_cont_bdd_of_tendsto_indicator μ F_closed.measurable_set
+          (λ n, thickened_indicator (δs_pos n) F)
+          (λ n ω, thickened_indicator_le_one (δs_pos n) F ω),
+  have key := thickened_indicator_tendsto_indicator_closure δs_pos δs_lim F,
+  rwa F_closed.closure_eq at key,
+end
+
+/-- One implication of the portmanteau theorem:
+Weak convergence of finite measures implies that the limsup of the measures of any closed set is
+at most the measure of the closed set under the limit measure.
+-/
+lemma finite_measure.limsup_measure_closed_le_of_tendsto
+  {Ω ι : Type*} {L : filter ι}
+  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
+  {μ : finite_measure Ω} {μs : ι → finite_measure Ω}
+  (μs_lim : tendsto μs L (𝓝 μ)) {F : set Ω} (F_closed : is_closed F) :
+  L.limsup (λ i, (μs i : measure Ω) F) ≤ (μ : measure Ω) F :=
+begin
+  by_cases L = ⊥,
+  { simp only [h, limsup, filter.map_bot, Limsup_bot, ennreal.bot_eq_zero, zero_le], },
+  apply ennreal.le_of_forall_pos_le_add,
+  intros ε ε_pos μ_F_finite,
+  set δs := λ (n : ℕ), (1 : ℝ) / (n+1) with def_δs,
+  have δs_pos : ∀ n, 0 < δs n, from λ n, nat.one_div_pos_of_nat,
+  have δs_lim : tendsto δs at_top (𝓝 0), from tendsto_one_div_add_at_top_nhds_0_nat,
+  have key₁ := tendsto_lintegral_thickened_indicator_of_is_closed
+                  (μ : measure Ω) F_closed δs_pos δs_lim,
+  have room₁ : (μ : measure Ω) F < (μ : measure Ω) F + ε / 2,
+  { apply ennreal.lt_add_right (measure_lt_top (μ : measure Ω) F).ne
+          ((ennreal.div_pos_iff.mpr
+              ⟨(ennreal.coe_pos.mpr ε_pos).ne.symm, ennreal.two_ne_top⟩).ne.symm), },
+  rcases eventually_at_top.mp (eventually_lt_of_tendsto_lt room₁ key₁) with ⟨M, hM⟩,
+  have key₂ := finite_measure.tendsto_iff_forall_lintegral_tendsto.mp
+                μs_lim (thickened_indicator (δs_pos M) F),
+  have room₂ : lintegral (μ : measure Ω) (λ a, thickened_indicator (δs_pos M) F a)
+                < lintegral (μ : measure Ω) (λ a, thickened_indicator (δs_pos M) F a) + ε / 2,
+  { apply ennreal.lt_add_right
+          (lintegral_lt_top_of_bounded_continuous_to_nnreal (μ : measure Ω) _).ne
+          ((ennreal.div_pos_iff.mpr
+              ⟨(ennreal.coe_pos.mpr ε_pos).ne.symm, ennreal.two_ne_top⟩).ne.symm), },
+  have ev_near := eventually.mono (eventually_lt_of_tendsto_lt room₂ key₂) (λ n, le_of_lt),
+  have aux := λ n, le_trans (measure_le_lintegral_thickened_indicator
+                            (μs n : measure Ω) F_closed.measurable_set (δs_pos M)),
+  have ev_near' := eventually.mono ev_near aux,
+  apply (filter.limsup_le_limsup ev_near').trans,
+  haveI : ne_bot L, from ⟨h⟩,
+  rw limsup_const,
+  apply le_trans (add_le_add (hM M rfl.le).le (le_refl (ε/2 : ℝ≥0∞))),
+  simp only [add_assoc, ennreal.add_halves, le_refl],
+end
+
+/-- One implication of the portmanteau theorem:
+Weak convergence of probability measures implies that the limsup of the measures of any closed
+set is at most the measure of the closed set under the limit probability measure.
+-/
+lemma probability_measure.limsup_measure_closed_le_of_tendsto
+  {Ω ι : Type*} {L : filter ι}
+  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
+  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
+  (μs_lim : tendsto μs L (𝓝 μ)) {F : set Ω} (F_closed : is_closed F) :
+  L.limsup (λ i, (μs i : measure Ω) F) ≤ (μ : measure Ω) F :=
+by apply finite_measure.limsup_measure_closed_le_of_tendsto
+         ((probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds L).mp μs_lim)
+         F_closed
+
+/-- One implication of the portmanteau theorem:
+Weak convergence of probability measures implies that the liminf of the measures of any open set
+is at least the measure of the open set under the limit probability measure.
+-/
+lemma probability_measure.le_liminf_measure_open_of_tendsto
+  {Ω ι : Type*} {L : filter ι}
+  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
+  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
+  (μs_lim : tendsto μs L (𝓝 μ)) {G : set Ω} (G_open : is_open G) :
+  (μ : measure Ω) G ≤ L.liminf (λ i, (μs i : measure Ω) G) :=
+begin
+  have h_closeds : ∀ F, is_closed F → L.limsup (λ i, (μs i : measure Ω) F) ≤ (μ : measure Ω) F,
+    from λ F F_closed, probability_measure.limsup_measure_closed_le_of_tendsto μs_lim F_closed,
+  exact le_measure_liminf_of_limsup_measure_compl_le
+        G_open.measurable_set (h_closeds _ (is_closed_compl_iff.mpr G_open)),
+end
+
+lemma probability_measure.tendsto_measure_of_null_frontier_of_tendsto'
+  {Ω ι : Type*} {L : filter ι}
+  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
+  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
+  (μs_lim : tendsto μs L (𝓝 μ)) {E : set Ω} (E_nullbdry : (μ : measure Ω) (frontier E) = 0) :
+  tendsto (λ i, (μs i : measure Ω) E) L (𝓝 ((μ : measure Ω) E)) :=
+begin
+  have h_opens : ∀ G, is_open G → (μ : measure Ω) G ≤ L.liminf (λ i, (μs i : measure Ω) G),
+    from λ G G_open, probability_measure.le_liminf_measure_open_of_tendsto μs_lim G_open,
+  exact tendsto_measure_of_null_frontier h_opens E_nullbdry,
+end
+
+/-- One implication of the portmanteau theorem:
+Weak convergence of probability measures implies that if the boundary of a Borel set
+carries no probability mass under the limit measure, then the limit of the measures of the set
+equals the measure of the set under the limit probability measure.
+
+A version with coercions to ordinary `ℝ≥0∞`-valued measures is
+`measure_theory.probability_measure.tendsto_measure_of_null_frontier_of_tendsto'`.
+-/
+lemma probability_measure.tendsto_measure_of_null_frontier_of_tendsto
+  {Ω ι : Type*} {L : filter ι}
+  [measurable_space Ω] [pseudo_emetric_space Ω] [opens_measurable_space Ω]
+  {μ : probability_measure Ω} {μs : ι → probability_measure Ω}
+  (μs_lim : tendsto μs L (𝓝 μ)) {E : set Ω} (E_nullbdry : μ (frontier E) = 0) :
+  tendsto (λ i, μs i E) L (𝓝 (μ E)) :=
+begin
+  have E_nullbdry' : (μ : measure Ω) (frontier E) = 0,
+    by rw [← probability_measure.ennreal_coe_fn_eq_coe_fn_to_measure, E_nullbdry, ennreal.coe_zero],
+  have key := probability_measure.tendsto_measure_of_null_frontier_of_tendsto' μs_lim E_nullbdry',
+  exact (ennreal.tendsto_to_nnreal (measure_ne_top ↑μ E)).comp key,
+end
+
+end convergence_implies_limsup_closed_le --section
+
+section limit_borel_implies_limsup_closed_le
+/-! ### Portmanteau implication: limit condition for Borel sets implies limsup for closed sets
+
+TODO: The proof of the implication is not yet here. Add it.
+-/
+
+variables {Ω : Type*} [pseudo_emetric_space Ω] [measurable_space Ω] [opens_measurable_space Ω]
+
+lemma exists_null_frontier_thickening
+  (μ : measure Ω) [sigma_finite μ] (s : set Ω) {a b : ℝ} (hab : a < b) :
+  ∃ r ∈ Ioo a b, μ (frontier (metric.thickening r s)) = 0 :=
+begin
+  have mbles : ∀ (r : ℝ), measurable_set (frontier (metric.thickening r s)),
+    from λ r, (is_closed_frontier).measurable_set,
+  have disjs := metric.frontier_thickening_disjoint s,
+  have key := @measure.countable_meas_pos_of_disjoint_Union Ω _ _ μ _ _ mbles disjs,
+  have aux := @measure_diff_null ℝ _ volume (Ioo a b) _ (set.countable.measure_zero key volume),
+  have len_pos : 0 < ennreal.of_real (b - a), by simp only [hab, ennreal.of_real_pos, sub_pos],
+  rw [← real.volume_Ioo, ← aux] at len_pos,
+  rcases nonempty_of_measure_ne_zero len_pos.ne.symm with ⟨r, ⟨r_in_Ioo, hr⟩⟩,
+  refine ⟨r, r_in_Ioo, _⟩,
+  simpa only [mem_set_of_eq, not_lt, le_zero_iff] using hr,
+end
+
+lemma exists_null_frontiers_thickening (μ : measure Ω) [sigma_finite μ] (s : set Ω) :
+  ∃ (rs : ℕ → ℝ), tendsto rs at_top (𝓝 0) ∧
+                  ∀ n, 0 < rs n ∧ μ (frontier (metric.thickening (rs n) s)) = 0 :=
+begin
+  rcases exists_seq_strict_anti_tendsto (0 : ℝ) with ⟨Rs, ⟨rubbish, ⟨Rs_pos, Rs_lim⟩⟩⟩,
+  have obs := λ (n : ℕ), exists_null_frontier_thickening μ s (Rs_pos n),
+  refine ⟨(λ (n : ℕ), (obs n).some), ⟨_, _⟩⟩,
+  { exact tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds Rs_lim
+              (λ n, (obs n).some_spec.some.1.le) (λ n, (obs n).some_spec.some.2.le), },
+  { exact λ n, ⟨(obs n).some_spec.some.1, (obs n).some_spec.some_spec⟩, },
+end
+
+end limit_borel_implies_limsup_closed_le --section
+
+end measure_theory --namespace
diff --git a/src/measure_theory/measure/probability_measure.lean b/src/measure_theory/measure/probability_measure.lean
new file mode 100644
index 0000000000000..f7222221eacd9
--- /dev/null
+++ b/src/measure_theory/measure/probability_measure.lean
@@ -0,0 +1,456 @@
+/-
+Copyright (c) 2021 Kalle Kytölä. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kalle Kytölä
+-/
+import measure_theory.measure.finite_measure
+import measure_theory.integral.average
+
+/-!
+# Probability measures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the type of probability measures on a given measurable space. When the underlying
+space has a topology and the measurable space structure (sigma algebra) is finer than the Borel
+sigma algebra, then the type of probability measures is equipped with the topology of convergence
+in distribution (weak convergence of measures). The topology of convergence in distribution is the
+coarsest topology w.r.t. which for every bounded continuous `ℝ≥0`-valued random variable `X`, the
+expected value of `X` depends continuously on the choice of probability measure. This is a special
+case of the topology of weak convergence of finite measures.
+
+## Main definitions
+
+The main definitions are
+ * the type `measure_theory.probability_measure Ω` with the topology of convergence in
+   distribution (a.k.a. convergence in law, weak convergence of measures);
+ * `measure_theory.probability_measure.to_finite_measure`: Interpret a probability measure as
+   a finite measure;
+ * `measure_theory.finite_measure.normalize`: Normalize a finite measure to a probability measure
+   (returns junk for the zero measure).
+
+## Main results
+
+ * `measure_theory.probability_measure.tendsto_iff_forall_integral_tendsto`: Convergence of
+   probability measures is characterized by the convergence of expected values of all bounded
+   continuous random variables. This shows that the chosen definition of topology coincides with
+   the common textbook definition of convergence in distribution, i.e., weak convergence of
+   measures. A similar characterization by the convergence of expected values (in the
+   `measure_theory.lintegral` sense) of all bounded continuous nonnegative random variables is
+   `measure_theory.probability_measure.tendsto_iff_forall_lintegral_tendsto`.
+ * `measure_theory.finite_measure.tendsto_normalize_iff_tendsto`: The convergence of finite
+   measures to a nonzero limit is characterized by the convergence of the probability-normalized
+   versions and of the total masses.
+
+TODO:
+ * Probability measures form a convex space.
+
+## Implementation notes
+
+The topology of convergence in distribution on `measure_theory.probability_measure Ω` is inherited
+weak convergence of finite measures via the mapping
+`measure_theory.probability_measure.to_finite_measure`.
+
+Like `measure_theory.finite_measure Ω`, the implementation of `measure_theory.probability_measure Ω`
+is directly as a subtype of `measure_theory.measure Ω`, and the coercion to a function is the
+composition `ennreal.to_nnreal` and the coercion to function of `measure_theory.measure Ω`.
+
+## References
+
+* [Billingsley, *Convergence of probability measures*][billingsley1999]
+
+## Tags
+
+convergence in distribution, convergence in law, weak convergence of measures, probability measure
+
+-/
+
+noncomputable theory
+open measure_theory
+open set
+open filter
+open bounded_continuous_function
+open_locale topology ennreal nnreal bounded_continuous_function
+
+namespace measure_theory
+
+section probability_measure
+/-! ### Probability measures
+
+In this section we define the type of probability measures on a measurable space `Ω`, denoted by
+`measure_theory.probability_measure Ω`.
+
+If `Ω` is moreover a topological space and the sigma algebra on `Ω` is finer than the Borel sigma
+algebra (i.e. `[opens_measurable_space Ω]`), then `measure_theory.probability_measure Ω` is
+equipped with the topology of weak convergence of measures. Since every probability measure is a
+finite measure, this is implemented as the induced topology from the mapping
+`measure_theory.probability_measure.to_finite_measure`.
+-/
+
+/-- Probability measures are defined as the subtype of measures that have the property of being
+probability measures (i.e., their total mass is one). -/
+def probability_measure (Ω : Type*) [measurable_space Ω] : Type* :=
+{μ : measure Ω // is_probability_measure μ}
+
+namespace probability_measure
+
+variables {Ω : Type*} [measurable_space Ω]
+
+instance [inhabited Ω] : inhabited (probability_measure Ω) :=
+⟨⟨measure.dirac default, measure.dirac.is_probability_measure⟩⟩
+
+/-- A probability measure can be interpreted as a measure. -/
+instance : has_coe (probability_measure Ω) (measure_theory.measure Ω) := coe_subtype
+
+instance : has_coe_to_fun (probability_measure Ω) (λ _, set Ω → ℝ≥0) :=
+⟨λ μ s, (μ s).to_nnreal⟩
+
+instance (μ : probability_measure Ω) : is_probability_measure (μ : measure Ω) := μ.prop
+
+lemma coe_fn_eq_to_nnreal_coe_fn_to_measure (ν : probability_measure Ω) :
+  (ν : set Ω → ℝ≥0) = λ s, ((ν : measure Ω) s).to_nnreal := rfl
+
+@[simp] lemma val_eq_to_measure (ν : probability_measure Ω) : ν.val = (ν : measure Ω) := rfl
+
+lemma coe_injective : function.injective (coe : probability_measure Ω → measure Ω) :=
+subtype.coe_injective
+
+@[simp] lemma coe_fn_univ (ν : probability_measure Ω) : ν univ = 1 :=
+congr_arg ennreal.to_nnreal ν.prop.measure_univ
+
+lemma coe_fn_univ_ne_zero (ν : probability_measure Ω) : ν univ ≠ 0 :=
+by simp only [coe_fn_univ, ne.def, one_ne_zero, not_false_iff]
+
+/-- A probability measure can be interpreted as a finite measure. -/
+def to_finite_measure (μ : probability_measure Ω) : finite_measure Ω := ⟨μ, infer_instance⟩
+
+@[simp] lemma coe_comp_to_finite_measure_eq_coe (ν : probability_measure Ω) :
+  (ν.to_finite_measure : measure Ω) = (ν : measure Ω) := rfl
+
+@[simp] lemma coe_fn_comp_to_finite_measure_eq_coe_fn (ν : probability_measure Ω) :
+  (ν.to_finite_measure : set Ω → ℝ≥0) = (ν : set Ω → ℝ≥0) := rfl
+
+@[simp] lemma ennreal_coe_fn_eq_coe_fn_to_measure (ν : probability_measure Ω) (s : set Ω) :
+  (ν s : ℝ≥0∞) = (ν : measure Ω) s :=
+by rw [← coe_fn_comp_to_finite_measure_eq_coe_fn,
+  finite_measure.ennreal_coe_fn_eq_coe_fn_to_measure, coe_comp_to_finite_measure_eq_coe]
+
+lemma apply_mono (μ : probability_measure Ω) {s₁ s₂ : set Ω} (h : s₁ ⊆ s₂) :
+  μ s₁ ≤ μ s₂ :=
+begin
+  rw ← coe_fn_comp_to_finite_measure_eq_coe_fn,
+  exact measure_theory.finite_measure.apply_mono _ h,
+end
+
+lemma nonempty_of_probability_measure (μ : probability_measure Ω) : nonempty Ω :=
+begin
+  by_contra maybe_empty,
+  have zero : (μ : measure Ω) univ = 0,
+    by rw [univ_eq_empty_iff.mpr (not_nonempty_iff.mp maybe_empty), measure_empty],
+  rw measure_univ at zero,
+  exact zero_ne_one zero.symm,
+end
+
+@[ext] lemma eq_of_forall_measure_apply_eq (μ ν : probability_measure Ω)
+  (h : ∀ (s : set Ω), measurable_set s → (μ : measure Ω) s = (ν : measure Ω) s) :
+  μ = ν :=
+by { ext1, ext1 s s_mble, exact h s s_mble, }
+
+lemma eq_of_forall_apply_eq (μ ν : probability_measure Ω)
+  (h : ∀ (s : set Ω), measurable_set s → μ s = ν s) :
+  μ = ν :=
+begin
+  ext1 s s_mble,
+  simpa [ennreal_coe_fn_eq_coe_fn_to_measure] using congr_arg (coe : ℝ≥0 → ℝ≥0∞) (h s s_mble),
+end
+
+@[simp] lemma mass_to_finite_measure (μ : probability_measure Ω) :
+  μ.to_finite_measure.mass = 1 := μ.coe_fn_univ
+
+lemma to_finite_measure_nonzero (μ : probability_measure Ω) :
+  μ.to_finite_measure ≠ 0 :=
+begin
+  rw [←finite_measure.mass_nonzero_iff, μ.mass_to_finite_measure],
+  exact one_ne_zero,
+end
+
+variables [topological_space Ω] [opens_measurable_space Ω]
+
+lemma test_against_nn_lipschitz (μ : probability_measure Ω) :
+  lipschitz_with 1 (λ (f : Ω →ᵇ ℝ≥0), μ.to_finite_measure.test_against_nn f) :=
+μ.mass_to_finite_measure ▸ μ.to_finite_measure.test_against_nn_lipschitz
+
+/-- The topology of weak convergence on `measure_theory.probability_measure Ω`. This is inherited
+(induced) from the topology of weak convergence of finite measures via the inclusion
+`measure_theory.probability_measure.to_finite_measure`. -/
+instance : topological_space (probability_measure Ω) :=
+topological_space.induced to_finite_measure infer_instance
+
+lemma to_finite_measure_continuous :
+  continuous (to_finite_measure : probability_measure Ω → finite_measure Ω) :=
+continuous_induced_dom
+
+/-- Probability measures yield elements of the `weak_dual` of bounded continuous nonnegative
+functions via `measure_theory.finite_measure.test_against_nn`, i.e., integration. -/
+def to_weak_dual_bcnn : probability_measure Ω → weak_dual ℝ≥0 (Ω →ᵇ ℝ≥0) :=
+finite_measure.to_weak_dual_bcnn ∘ to_finite_measure
+
+@[simp] lemma coe_to_weak_dual_bcnn (μ : probability_measure Ω) :
+  ⇑μ.to_weak_dual_bcnn = μ.to_finite_measure.test_against_nn := rfl
+
+@[simp] lemma to_weak_dual_bcnn_apply (μ : probability_measure Ω) (f : Ω →ᵇ ℝ≥0) :
+  μ.to_weak_dual_bcnn f = (∫⁻ ω, f ω ∂(μ : measure Ω)).to_nnreal := rfl
+
+lemma to_weak_dual_bcnn_continuous :
+  continuous (λ (μ : probability_measure Ω), μ.to_weak_dual_bcnn) :=
+finite_measure.to_weak_dual_bcnn_continuous.comp to_finite_measure_continuous
+
+/- Integration of (nonnegative bounded continuous) test functions against Borel probability
+measures depends continuously on the measure. -/
+lemma continuous_test_against_nn_eval (f : Ω →ᵇ ℝ≥0) :
+  continuous (λ (μ : probability_measure Ω), μ.to_finite_measure.test_against_nn f) :=
+(finite_measure.continuous_test_against_nn_eval f).comp to_finite_measure_continuous
+
+/- The canonical mapping from probability measures to finite measures is an embedding. -/
+lemma to_finite_measure_embedding (Ω : Type*)
+  [measurable_space Ω] [topological_space Ω] [opens_measurable_space Ω] :
+  embedding (to_finite_measure : probability_measure Ω → finite_measure Ω) :=
+{ induced := rfl,
+  inj := λ μ ν h, subtype.eq (by convert congr_arg coe h) }
+
+lemma tendsto_nhds_iff_to_finite_measures_tendsto_nhds {δ : Type*}
+  (F : filter δ) {μs : δ → probability_measure Ω} {μ₀ : probability_measure Ω} :
+  tendsto μs F (𝓝 μ₀) ↔ tendsto (to_finite_measure ∘ μs) F (𝓝 (μ₀.to_finite_measure)) :=
+embedding.tendsto_nhds_iff (to_finite_measure_embedding Ω)
+
+/-- A characterization of weak convergence of probability measures by the condition that the
+integrals of every continuous bounded nonnegative function converge to the integral of the function
+against the limit measure. -/
+theorem tendsto_iff_forall_lintegral_tendsto {γ : Type*} {F : filter γ}
+  {μs : γ → probability_measure Ω} {μ : probability_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔
+  ∀ (f : Ω →ᵇ ℝ≥0), tendsto (λ i, (∫⁻ ω, (f ω) ∂(μs(i) : measure Ω))) F
+    (𝓝 ((∫⁻ ω, (f ω) ∂(μ : measure Ω)))) :=
+begin
+  rw tendsto_nhds_iff_to_finite_measures_tendsto_nhds,
+  exact finite_measure.tendsto_iff_forall_lintegral_tendsto,
+end
+
+/-- The characterization of weak convergence of probability measures by the usual (defining)
+condition that the integrals of every continuous bounded function converge to the integral of the
+function against the limit measure. -/
+theorem tendsto_iff_forall_integral_tendsto
+  {γ : Type*} {F : filter γ} {μs : γ → probability_measure Ω} {μ : probability_measure Ω} :
+  tendsto μs F (𝓝 μ) ↔
+  ∀ (f : Ω →ᵇ ℝ),
+    tendsto (λ i, (∫ ω, (f ω) ∂(μs i : measure Ω))) F (𝓝 ((∫ ω, (f ω) ∂(μ : measure Ω)))) :=
+begin
+  rw tendsto_nhds_iff_to_finite_measures_tendsto_nhds,
+  rw finite_measure.tendsto_iff_forall_integral_tendsto,
+  simp only [coe_comp_to_finite_measure_eq_coe],
+end
+
+end probability_measure -- namespace
+
+end probability_measure -- section
+
+section normalize_finite_measure
+/-! ### Normalization of finite measures to probability measures
+
+This section is about normalizing finite measures to probability measures.
+
+The weak convergence of finite measures to nonzero limit measures is characterized by
+the convergence of the total mass and the convergence of the normalized probability
+measures.
+-/
+
+namespace finite_measure
+
+variables {Ω : Type*} [nonempty Ω] {m0 : measurable_space Ω} (μ : finite_measure Ω)
+
+/-- Normalize a finite measure so that it becomes a probability measure, i.e., divide by the
+total mass. -/
+def normalize : probability_measure Ω :=
+if zero : μ.mass = 0 then ⟨measure.dirac ‹nonempty Ω›.some, measure.dirac.is_probability_measure⟩
+  else {  val := (μ.mass)⁻¹ • μ,
+          property := begin
+            refine ⟨_⟩,
+            simp only [mass, measure.coe_nnreal_smul_apply,
+                        ←ennreal_coe_fn_eq_coe_fn_to_measure μ univ],
+            norm_cast,
+            exact inv_mul_cancel zero,
+          end }
+
+@[simp] lemma self_eq_mass_mul_normalize (s : set Ω) : μ s = μ.mass * μ.normalize s :=
+begin
+  obtain rfl|h := eq_or_ne μ 0,
+  { simp only [zero.mass, coe_fn_zero, pi.zero_apply, zero_mul], },
+  have mass_nonzero : μ.mass ≠ 0, by rwa μ.mass_nonzero_iff,
+  simp only [normalize, dif_neg mass_nonzero, ennreal.to_nnreal_mul, subtype.coe_mk,
+    probability_measure.coe_fn_eq_to_nnreal_coe_fn_to_measure, ennreal.to_nnreal_coe,
+    measure_theory.measure.coe_nnreal_smul_apply, mul_inv_cancel_left₀ mass_nonzero,
+    finite_measure.coe_fn_eq_to_nnreal_coe_fn_to_measure],
+end
+
+lemma self_eq_mass_smul_normalize : μ = μ.mass • μ.normalize.to_finite_measure :=
+begin
+  apply eq_of_forall_apply_eq,
+  intros s s_mble,
+  rw [μ.self_eq_mass_mul_normalize s, coe_fn_smul_apply, smul_eq_mul,
+    probability_measure.coe_fn_comp_to_finite_measure_eq_coe_fn],
+end
+
+lemma normalize_eq_of_nonzero (nonzero : μ ≠ 0) (s : set Ω) :
+  μ.normalize s = (μ.mass)⁻¹ * (μ s) :=
+by simp only [μ.self_eq_mass_mul_normalize, μ.mass_nonzero_iff.mpr nonzero,
+              inv_mul_cancel_left₀, ne.def, not_false_iff]
+
+lemma normalize_eq_inv_mass_smul_of_nonzero (nonzero : μ ≠ 0) :
+  μ.normalize.to_finite_measure = (μ.mass)⁻¹ • μ :=
+begin
+  nth_rewrite 2 μ.self_eq_mass_smul_normalize,
+  rw ← smul_assoc,
+  simp only [μ.mass_nonzero_iff.mpr nonzero, algebra.id.smul_eq_mul,
+             inv_mul_cancel, ne.def, not_false_iff, one_smul],
+end
+
+lemma coe_normalize_eq_of_nonzero (nonzero : μ ≠ 0) : (μ.normalize : measure Ω) = (μ.mass)⁻¹ • μ :=
+begin
+  ext1 s s_mble,
+  simp only [← μ.normalize.ennreal_coe_fn_eq_coe_fn_to_measure s,
+             μ.normalize_eq_of_nonzero nonzero s, ennreal.coe_mul,
+             ennreal_coe_fn_eq_coe_fn_to_measure, measure.coe_nnreal_smul_apply],
+end
+
+@[simp] lemma _root_.probability_measure.to_finite_measure_normalize_eq_self
+  {m0 : measurable_space Ω} (μ : probability_measure Ω) :
+  μ.to_finite_measure.normalize = μ :=
+begin
+  apply probability_measure.eq_of_forall_apply_eq,
+  intros s s_mble,
+  rw μ.to_finite_measure.normalize_eq_of_nonzero μ.to_finite_measure_nonzero s,
+  simp only [probability_measure.mass_to_finite_measure, inv_one, one_mul,
+             probability_measure.coe_fn_comp_to_finite_measure_eq_coe_fn],
+end
+
+/-- Averaging with respect to a finite measure is the same as integraing against
+`measure_theory.finite_measure.normalize`. -/
+lemma average_eq_integral_normalize
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  (nonzero : μ ≠ 0) (f : Ω → E) :
+  average (μ : measure Ω) f = ∫ ω, f ω ∂(μ.normalize : measure Ω) :=
+begin
+  rw [μ.coe_normalize_eq_of_nonzero nonzero, average],
+  congr,
+  simp only [ring_hom.to_fun_eq_coe, ennreal.coe_of_nnreal_hom,
+             ennreal.coe_inv (μ.mass_nonzero_iff.mpr nonzero), ennreal_mass],
+end
+
+variables [topological_space Ω]
+
+lemma test_against_nn_eq_mass_mul (f : Ω →ᵇ ℝ≥0) :
+  μ.test_against_nn f = μ.mass * μ.normalize.to_finite_measure.test_against_nn f :=
+begin
+  nth_rewrite 0 μ.self_eq_mass_smul_normalize,
+  rw [μ.normalize.to_finite_measure.smul_test_against_nn_apply μ.mass f, smul_eq_mul],
+end
+
+lemma normalize_test_against_nn (nonzero : μ ≠ 0) (f : Ω →ᵇ ℝ≥0) :
+  μ.normalize.to_finite_measure.test_against_nn f = (μ.mass)⁻¹ * μ.test_against_nn f :=
+by simp [μ.test_against_nn_eq_mass_mul, μ.mass_nonzero_iff.mpr nonzero]
+
+variables [opens_measurable_space Ω]
+
+variables {μ}
+
+lemma tendsto_test_against_nn_of_tendsto_normalize_test_against_nn_of_tendsto_mass
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω}
+  (μs_lim : tendsto (λ i, (μs i).normalize) F (𝓝 μ.normalize))
+  (mass_lim : tendsto (λ i, (μs i).mass) F (𝓝 μ.mass)) (f : Ω →ᵇ ℝ≥0) :
+  tendsto (λ i, (μs i).test_against_nn f) F (𝓝 (μ.test_against_nn f)) :=
+begin
+  by_cases h_mass : μ.mass = 0,
+  { simp only [μ.mass_zero_iff.mp h_mass, zero.test_against_nn_apply,
+               zero.mass, eq_self_iff_true] at *,
+    exact tendsto_zero_test_against_nn_of_tendsto_zero_mass mass_lim f, },
+  simp_rw [(λ i, (μs i).test_against_nn_eq_mass_mul f), μ.test_against_nn_eq_mass_mul f],
+  rw probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds at μs_lim,
+  rw tendsto_iff_forall_test_against_nn_tendsto at μs_lim,
+  have lim_pair : tendsto
+        (λ i, (⟨(μs i).mass, (μs i).normalize.to_finite_measure.test_against_nn f⟩ : ℝ≥0 × ℝ≥0))
+        F (𝓝 (⟨μ.mass, μ.normalize.to_finite_measure.test_against_nn f⟩)),
+    from (prod.tendsto_iff _ _).mpr ⟨mass_lim, μs_lim f⟩,
+  exact tendsto_mul.comp lim_pair,
+end
+
+lemma tendsto_normalize_test_against_nn_of_tendsto {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} (μs_lim : tendsto μs F (𝓝 μ)) (nonzero : μ ≠ 0) (f : Ω →ᵇ ℝ≥0) :
+  tendsto (λ i, (μs i).normalize.to_finite_measure.test_against_nn f) F
+          (𝓝 (μ.normalize.to_finite_measure.test_against_nn f)) :=
+begin
+  have lim_mass := μs_lim.mass,
+  have aux : {(0 : ℝ≥0)}ᶜ ∈ 𝓝 (μ.mass),
+    from is_open_compl_singleton.mem_nhds (μ.mass_nonzero_iff.mpr nonzero),
+  have eventually_nonzero : ∀ᶠ i in F, μs i ≠ 0,
+  { simp_rw ← mass_nonzero_iff,
+    exact lim_mass aux, },
+  have eve : ∀ᶠ i in F,
+    (μs i).normalize.to_finite_measure.test_against_nn f
+    = ((μs i).mass)⁻¹ * (μs i).test_against_nn f,
+  { filter_upwards [eventually_iff.mp eventually_nonzero],
+    intros i hi,
+    apply normalize_test_against_nn _ hi, },
+  simp_rw [tendsto_congr' eve, μ.normalize_test_against_nn nonzero],
+  have lim_pair : tendsto
+        (λ i, (⟨((μs i).mass)⁻¹, (μs i).test_against_nn f⟩ : ℝ≥0 × ℝ≥0))
+        F (𝓝 (⟨(μ.mass)⁻¹, μ.test_against_nn f⟩)),
+  { refine (prod.tendsto_iff _ _).mpr ⟨_, _⟩,
+    { exact (continuous_on_inv₀.continuous_at aux).tendsto.comp lim_mass, },
+    { exact tendsto_iff_forall_test_against_nn_tendsto.mp μs_lim f, }, },
+  exact tendsto_mul.comp lim_pair,
+end
+
+/-- If the normalized versions of finite measures converge weakly and their total masses
+also converge, then the finite measures themselves converge weakly. -/
+lemma tendsto_of_tendsto_normalize_test_against_nn_of_tendsto_mass
+  {γ : Type*} {F : filter γ} {μs : γ → finite_measure Ω}
+  (μs_lim : tendsto (λ i, (μs i).normalize) F (𝓝 μ.normalize))
+  (mass_lim : tendsto (λ i, (μs i).mass) F (𝓝 μ.mass)) :
+  tendsto μs F (𝓝 μ) :=
+begin
+  rw tendsto_iff_forall_test_against_nn_tendsto,
+  exact λ f, tendsto_test_against_nn_of_tendsto_normalize_test_against_nn_of_tendsto_mass
+             μs_lim mass_lim f,
+end
+
+/-- If finite measures themselves converge weakly to a nonzero limit measure, then their
+normalized versions also converge weakly. -/
+lemma tendsto_normalize_of_tendsto {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} (μs_lim : tendsto μs F (𝓝 μ)) (nonzero : μ ≠ 0) :
+  tendsto (λ i, (μs i).normalize) F (𝓝 (μ.normalize)) :=
+begin
+  rw [probability_measure.tendsto_nhds_iff_to_finite_measures_tendsto_nhds,
+      tendsto_iff_forall_test_against_nn_tendsto],
+  exact λ f, tendsto_normalize_test_against_nn_of_tendsto μs_lim nonzero f,
+end
+
+/-- The weak convergence of finite measures to a nonzero limit can be characterized by the weak
+convergence of both their normalized versions (probability measures) and their total masses. -/
+theorem tendsto_normalize_iff_tendsto {γ : Type*} {F : filter γ}
+  {μs : γ → finite_measure Ω} (nonzero : μ ≠ 0) :
+  tendsto (λ i, (μs i).normalize) F (𝓝 (μ.normalize)) ∧ tendsto (λ i, (μs i).mass) F (𝓝 (μ.mass))
+  ↔ tendsto μs F (𝓝 μ) :=
+begin
+  split,
+  { rintros ⟨normalized_lim, mass_lim⟩,
+    exact tendsto_of_tendsto_normalize_test_against_nn_of_tendsto_mass normalized_lim mass_lim, },
+  { intro μs_lim,
+    refine ⟨tendsto_normalize_of_tendsto μs_lim nonzero, μs_lim.mass⟩, },
+end
+
+end finite_measure --namespace
+
+end normalize_finite_measure -- section
+
+end measure_theory
diff --git a/src/measure_theory/measure/regular.lean b/src/measure_theory/measure/regular.lean
index 49c5c34b32eb7..26bb77f77822e 100644
--- a/src/measure_theory/measure/regular.lean
+++ b/src/measure_theory/measure/regular.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris Van Doorn, Yury Kudryashov
 -/
 
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
 
 /-!
 # Regular measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A measure is `outer_regular` if the measure of any measurable set `A` is the infimum of `μ U` over
 all open sets `U` containing `A`.
 
@@ -21,7 +24,7 @@ A measure is `regular` if it satisfies the following properties:
 A measure is `weakly_regular` if it satisfies the following properties:
 * it is outer regular;
 * it is inner regular for open sets with respect to closed sets: the measure of any open set `U`
-  is the supremum of `μ F` over all compact sets `F` contained in `U`.
+  is the supremum of `μ F` over all closed sets `F` contained in `U`.
 
 In a Hausdorff topological space, regularity implies weak regularity. These three conditions are
 registered as typeclasses for a measure `μ`, and this implication is recorded as an instance.
@@ -66,12 +69,10 @@ is automatically satisfied by any finite measure on a metric space.
 
 * `set.measure_eq_infi_is_open` asserts that, when `μ` is outer regular, the measure of a
   set is the infimum of the measure of open sets containing it.
-* `set.exists_is_open_lt_of_lt'` asserts that, when `μ` is outer regular, for every set `s`
+* `set.exists_is_open_lt_of_lt` asserts that, when `μ` is outer regular, for every set `s`
   and `r > μ s` there exists an open superset `U ⊇ s` of measure less than `r`.
 * push forward of an outer regular measure is outer regular, and scalar multiplication of a regular
   measure by a finite number is outer regular.
-* `measure_theory.measure.outer_regular.of_sigma_compact_space_of_is_locally_finite_measure`:
-  a locally finite measure on a `σ`-compact metric (or even pseudo emetric) space is outer regular.
 
 ### Weakly regular measures
 
@@ -87,9 +88,9 @@ is automatically satisfied by any finite measure on a metric space.
 * `measure_theory.measure.weakly_regular.of_pseudo_emetric_space_of_is_finite_measure` is an
   instance registering that a finite measure on a metric space is weakly regular (in fact, a pseudo
   emetric space is enough);
-* `measure_theory.measure.weakly_regular.of_pseudo_emetric_sigma_compact_space_of_locally_finite`
-  is an instance registering that a locally finite measure on a `σ`-compact metric space (or even
-  a pseudo emetric space) is weakly regular.
+* `measure_theory.measure.weakly_regular.of_pseudo_emetric_second_countable_of_locally_finite`
+  is an instance registering that a locally finite measure on a second countable metric space (or
+  even a pseudo emetric space) is weakly regular.
 
 ### Regular measures
 
@@ -130,7 +131,7 @@ proofs or statements do not apply directly.
 -/
 
 open set filter
-open_locale ennreal topological_space nnreal big_operators
+open_locale ennreal topology nnreal big_operators
 
 namespace measure_theory
 namespace measure
@@ -261,10 +262,9 @@ lemma _root_.set.exists_is_open_le_add (A : set α) (μ : measure α) [outer_reg
   {ε : ℝ≥0∞} (hε : ε ≠ 0) :
   ∃ U ⊇ A, is_open U ∧ μ U ≤ μ A + ε :=
 begin
-  rcases le_or_lt ∞ (μ A) with H|H,
-  { exact ⟨univ, subset_univ _, is_open_univ,
-      by simp only [top_le_iff.mp H, ennreal.top_add, le_top]⟩ },
-  { rcases A.exists_is_open_lt_add H.ne hε with ⟨U, AU, U_open, hU⟩,
+  rcases eq_or_ne (μ A) ∞ with H|H,
+  { exact ⟨univ, subset_univ _, is_open_univ, by simp only [H, _root_.top_add, le_top]⟩ },
+  { rcases A.exists_is_open_lt_add H hε with ⟨U, AU, U_open, hU⟩,
     exact ⟨U, AU, U_open, hU.le⟩ }
 end
 
@@ -317,7 +317,7 @@ begin
       λ n, (inter_subset_right _ _).trans (disjointed_subset _ _),
       (disjoint_disjointed s.set).mono (λ k l hkl, hkl.mono inf_le_right inf_le_right), _⟩,
     rw [← inter_Union, Union_disjointed, s.spanning, inter_univ] },
-  rcases ennreal.exists_pos_sum_of_encodable' (tsub_pos_iff_lt.2 hr).ne' ℕ with ⟨δ, δ0, hδε⟩,
+  rcases ennreal.exists_pos_sum_of_countable' (tsub_pos_iff_lt.2 hr).ne' ℕ with ⟨δ, δ0, hδε⟩,
   rw [lt_tsub_iff_right, add_comm] at hδε,
   have : ∀ n, ∃ U ⊇ A n, is_open U ∧ μ U < μ (A n) + δ n,
   { intro n,
@@ -394,7 +394,7 @@ begin
     simp only [measure_compl_le_add_iff, *, hUo.measurable_set, hFc.measurable_set, true_and] },
   -- check for disjoint unions
   { intros s hsd hsm H ε ε0, have ε0' : ε / 2 ≠ 0, from (ennreal.half_pos ε0).ne',
-    rcases ennreal.exists_pos_sum_of_encodable' ε0' ℕ with ⟨δ, δ0, hδε⟩,
+    rcases ennreal.exists_pos_sum_of_countable' ε0' ℕ with ⟨δ, δ0, hδε⟩,
     choose F hFs U hsU hFc hUo hF hU using λ n, H n (δ n) (δ0 n).ne',
     -- the approximating closed set is constructed by considering finitely many sets `s i`, which
     -- cover all the measure up to `ε/2`, approximating each of these by a closed set `F i`, and
@@ -413,7 +413,7 @@ begin
         add_le_add_right (add_le_add_left ((ennreal.sum_le_tsum _).trans hδε.le) _) _
       ... = μ (⋃ k ∈ t, F k) + ε : _,
       rw [measure_bUnion_finset, add_assoc, ennreal.add_halves],
-      exacts [λ k _ n _ hkn, (hsd k n hkn).mono (hFs k) (hFs n), λ k hk, (hFc k).measurable_set] },
+      exacts [λ k _ n _ hkn, (hsd hkn).mono (hFs k) (hFs n), λ k hk, (hFc k).measurable_set] },
     { calc μ (⋃ n, U n) ≤ ∑' n, μ (U n) : measure_Union_le _
       ... ≤ ∑' n, (μ (s n) + δ n) : ennreal.tsum_le_tsum hU
       ... = μ (⋃ n, s n) + ∑' n, δ n : by rw [measure_Union hsd hsm, ennreal.tsum_add]
@@ -613,16 +613,16 @@ instance of_pseudo_emetric_space_of_is_finite_measure {X : Type*} [pseudo_emetri
   weakly_regular μ :=
 (inner_regular.of_pseudo_emetric_space μ).weakly_regular_of_finite μ
 
-/-- Any locally finite measure on a `σ`-compact metric space (or even a pseudo emetric space) is
-weakly regular. -/
+/-- Any locally finite measure on a second countable metric space (or even a pseudo emetric space)
+is weakly regular. -/
 @[priority 100] -- see Note [lower instance priority]
-instance of_pseudo_emetric_sigma_compact_space_of_locally_finite {X : Type*}
-  [pseudo_emetric_space X] [sigma_compact_space X] [measurable_space X] [borel_space X]
+instance of_pseudo_emetric_second_countable_of_locally_finite {X : Type*} [pseudo_emetric_space X]
+  [topological_space.second_countable_topology X] [measurable_space X] [borel_space X]
   (μ : measure X) [is_locally_finite_measure μ] :
   weakly_regular μ :=
 begin
   haveI : outer_regular μ,
-  { refine (μ.finite_spanning_sets_in_open.mono' $ λ U hU, _).outer_regular,
+  { refine (μ.finite_spanning_sets_in_open'.mono' $ λ U hU, _).outer_regular,
     haveI : fact (μ U < ∞), from ⟨hU.2⟩,
     exact ⟨hU.1, infer_instance⟩ },
   exact ⟨inner_regular.of_pseudo_emetric_space μ⟩
@@ -630,6 +630,8 @@ end
 
 end weakly_regular
 
+local attribute [instance] emetric.second_countable_of_sigma_compact
+
 /-- Any locally finite measure on a `σ`-compact (e)metric space is regular. -/
 @[priority 100] -- see Note [lower instance priority]
 instance regular.of_sigma_compact_space_of_is_locally_finite_measure {X : Type*}
diff --git a/src/measure_theory/measure/stieltjes.lean b/src/measure_theory/measure/stieltjes.lean
index b9658b31a4774..cd65059c9a0bc 100644
--- a/src/measure_theory/measure/stieltjes.lean
+++ b/src/measure_theory/measure/stieltjes.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Yury Kudryashov, Sébastien Gouëzel
 -/
-import measure_theory.constructions.borel_space
+import measure_theory.constructions.borel_space.basic
+import topology.algebra.order.left_right_lim
 
 /-!
 # Stieltjes measures on the real line
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Consider a function `f : ℝ → ℝ` which is monotone and right-continuous. Then one can define a
 corrresponding measure, giving mass `f b - f a` to the interval `(a, b]`.
 
@@ -16,16 +20,181 @@ corrresponding measure, giving mass `f b - f a` to the interval `(a, b]`.
 * `stieltjes_function` is a structure containing a function from `ℝ → ℝ`, together with the
 assertions that it is monotone and right-continuous. To `f : stieltjes_function`, one associates
 a Borel measure `f.measure`.
-* `f.left_lim x` is the limit of `f` to the left of `x`.
 * `f.measure_Ioc` asserts that `f.measure (Ioc a b) = of_real (f b - f a)`
-* `f.measure_Ioo` asserts that `f.measure (Ioo a b) = of_real (f.left_lim b - f a)`.
+* `f.measure_Ioo` asserts that `f.measure (Ioo a b) = of_real (left_lim f b - f a)`.
 * `f.measure_Icc` and `f.measure_Ico` are analogous.
 -/
 
+
+section move_this
+-- this section contains lemmas that should be moved to appropriate places after the port to lean 4
+
+open filter set
+open_locale topology
+
+lemma infi_Ioi_eq_infi_rat_gt {f : ℝ → ℝ} (x : ℝ) (hf : bdd_below (f '' Ioi x))
+  (hf_mono : monotone f) :
+  (⨅ r : Ioi x, f r) = ⨅ q : {q' : ℚ // x < q'}, f q :=
+begin
+  refine le_antisymm _ _,
+  { haveI : nonempty {r' : ℚ // x < ↑r'},
+    { obtain ⟨r, hrx⟩ := exists_rat_gt x,
+      exact ⟨⟨r, hrx⟩⟩, },
+    refine le_cinfi (λ r, _),
+    obtain ⟨y, hxy, hyr⟩ := exists_rat_btwn r.prop,
+    refine cinfi_set_le hf (hxy.trans _),
+    exact_mod_cast hyr, },
+  { refine le_cinfi (λ q, _),
+    have hq := q.prop,
+    rw mem_Ioi at hq,
+    obtain ⟨y, hxy, hyq⟩ := exists_rat_btwn hq,
+    refine (cinfi_le _ _).trans _,
+    { exact ⟨y, hxy⟩, },
+    { refine ⟨hf.some, λ z, _⟩,
+      rintros ⟨u, rfl⟩,
+      suffices hfu : f u ∈ f '' Ioi x, from hf.some_spec hfu,
+      exact ⟨u, u.prop, rfl⟩, },
+    { refine hf_mono (le_trans _ hyq.le),
+      norm_cast, }, },
+end
+
+-- todo after the port: move to topology/algebra/order/left_right_lim
+lemma right_lim_eq_of_tendsto {α β : Type*} [linear_order α] [topological_space β]
+  [hα : topological_space α] [h'α : order_topology α] [t2_space β]
+  {f : α → β} {a : α} {y : β} (h : 𝓝[>] a ≠ ⊥) (h' : tendsto f (𝓝[>] a) (𝓝 y)) :
+  function.right_lim f a = y :=
+@left_lim_eq_of_tendsto αᵒᵈ _ _ _ _ _ _ f a y h h'
+
+-- todo after the port: move to topology/algebra/order/left_right_lim
+lemma right_lim_eq_Inf {α β : Type*} [linear_order α] [topological_space β]
+  [conditionally_complete_linear_order β] [order_topology β] {f : α → β}
+  (hf : monotone f) {x : α}
+  [topological_space α] [order_topology α] (h : 𝓝[>] x ≠ ⊥) :
+  function.right_lim f x = Inf (f '' (Ioi x)) :=
+right_lim_eq_of_tendsto h (hf.tendsto_nhds_within_Ioi x)
+
+-- todo after the port: move to order/filter/at_top_bot
+lemma exists_seq_monotone_tendsto_at_top_at_top (α : Type*) [semilattice_sup α] [nonempty α]
+  [(at_top : filter α).is_countably_generated] :
+  ∃ xs : ℕ → α, monotone xs ∧ tendsto xs at_top at_top :=
+begin
+  haveI h_ne_bot : (at_top : filter α).ne_bot := at_top_ne_bot,
+  obtain ⟨ys, h⟩ := exists_seq_tendsto (at_top : filter α),
+  let xs : ℕ → α := λ n, finset.sup' (finset.range (n + 1)) finset.nonempty_range_succ ys,
+  have h_mono : monotone xs,
+  { intros i j hij,
+    rw finset.sup'_le_iff,
+    intros k hk,
+    refine finset.le_sup'_of_le _ _ le_rfl,
+    rw finset.mem_range at hk ⊢,
+    exact hk.trans_le (add_le_add_right hij _), },
+  refine ⟨xs, h_mono, _⟩,
+  { refine tendsto_at_top_at_top_of_monotone h_mono _,
+    have : ∀ (a : α), ∃ (n : ℕ), a ≤ ys n,
+    { rw tendsto_at_top_at_top at h,
+      intro a,
+      obtain ⟨i, hi⟩ := h a,
+      exact ⟨i, hi i le_rfl⟩, },
+    intro a,
+    obtain ⟨i, hi⟩ := this a,
+    refine ⟨i, hi.trans _⟩,
+    refine finset.le_sup'_of_le _ _ le_rfl,
+    rw finset.mem_range_succ_iff, },
+end
+
+lemma exists_seq_antitone_tendsto_at_top_at_bot (α : Type*) [semilattice_inf α] [nonempty α]
+  [h2 : (at_bot : filter α).is_countably_generated] :
+  ∃ xs : ℕ → α, antitone xs ∧ tendsto xs at_top at_bot :=
+@exists_seq_monotone_tendsto_at_top_at_top αᵒᵈ _ _ h2
+
+-- todo after the port: move to topology/algebra/order/monotone_convergence
+lemma supr_eq_supr_subseq_of_antitone {ι₁ ι₂ α : Type*} [preorder ι₂] [complete_lattice α]
+  {l : filter ι₁} [l.ne_bot] {f : ι₂ → α} {φ : ι₁ → ι₂} (hf : antitone f)
+  (hφ : tendsto φ l at_bot) :
+  (⨆ i, f i) = (⨆ i, f (φ i)) :=
+le_antisymm
+  (supr_mono' (λ i, exists_imp_exists (λ j (hj : φ j ≤ i), hf hj)
+    (hφ.eventually $ eventually_le_at_bot i).exists))
+  (supr_mono' (λ i, ⟨φ i, le_rfl⟩))
+
+namespace measure_theory
+-- todo after the port: move these lemmas to measure_theory/measure/measure_space?
+variables {α : Type*} {mα : measurable_space α}
+include mα
+
+lemma tendsto_measure_Ico_at_top [semilattice_sup α] [no_max_order α]
+  [(at_top : filter α).is_countably_generated] (μ : measure α) (a : α) :
+  tendsto (λ x, μ (Ico a x)) at_top (𝓝 (μ (Ici a))) :=
+begin
+  haveI : nonempty α := ⟨a⟩,
+  have h_mono : monotone (λ x, μ (Ico a x)) := λ i j hij, measure_mono (Ico_subset_Ico_right hij),
+  convert tendsto_at_top_supr h_mono,
+  obtain ⟨xs, hxs_mono, hxs_tendsto⟩ := exists_seq_monotone_tendsto_at_top_at_top α,
+  have h_Ici : Ici a = ⋃ n, Ico a (xs n),
+  { ext1 x,
+    simp only [mem_Ici, mem_Union, mem_Ico, exists_and_distrib_left, iff_self_and],
+    intro _,
+    obtain ⟨y, hxy⟩ := no_max_order.exists_gt x,
+    obtain ⟨n, hn⟩ := tendsto_at_top_at_top.mp hxs_tendsto y,
+    exact ⟨n, hxy.trans_le (hn n le_rfl)⟩, },
+  rw [h_Ici, measure_Union_eq_supr, supr_eq_supr_subseq_of_monotone h_mono hxs_tendsto],
+  exact monotone.directed_le (λ i j hij, Ico_subset_Ico_right (hxs_mono hij)),
+end
+
+lemma tendsto_measure_Ioc_at_bot [semilattice_inf α] [no_min_order α]
+  [(at_bot : filter α).is_countably_generated] (μ : measure α) (a : α) :
+  tendsto (λ x, μ (Ioc x a)) at_bot (𝓝 (μ (Iic a))) :=
+begin
+  haveI : nonempty α := ⟨a⟩,
+  have h_mono : antitone (λ x, μ (Ioc x a)) := λ i j hij, measure_mono (Ioc_subset_Ioc_left hij),
+  convert tendsto_at_bot_supr h_mono,
+  obtain ⟨xs, hxs_mono, hxs_tendsto⟩ := exists_seq_antitone_tendsto_at_top_at_bot α,
+  have h_Iic : Iic a = ⋃ n, Ioc (xs n) a,
+  { ext1 x,
+    simp only [mem_Iic, mem_Union, mem_Ioc, exists_and_distrib_right, iff_and_self],
+    intro _,
+    obtain ⟨y, hxy⟩ := no_min_order.exists_lt x,
+    obtain ⟨n, hn⟩ := tendsto_at_top_at_bot.mp hxs_tendsto y,
+    exact ⟨n, (hn n le_rfl).trans_lt hxy⟩, },
+  rw [h_Iic, measure_Union_eq_supr, supr_eq_supr_subseq_of_antitone h_mono hxs_tendsto],
+  exact monotone.directed_le (λ i j hij, Ioc_subset_Ioc_left (hxs_mono hij)),
+end
+
+lemma tendsto_measure_Iic_at_top [semilattice_sup α] [(at_top : filter α).is_countably_generated]
+  (μ : measure α) :
+  tendsto (λ x, μ (Iic x)) at_top (𝓝 (μ univ)) :=
+begin
+  casesI is_empty_or_nonempty α,
+  { have h1 : ∀ x : α, Iic x = ∅ := λ x, subsingleton.elim _ _,
+    have h2 : (univ : set α) = ∅ := subsingleton.elim _ _,
+    simp_rw [h1, h2],
+    exact tendsto_const_nhds, },
+  have h_mono : monotone (λ x, μ (Iic x)) := λ i j hij, measure_mono (Iic_subset_Iic.mpr hij),
+  convert tendsto_at_top_supr h_mono,
+  obtain ⟨xs, hxs_mono, hxs_tendsto⟩ := exists_seq_monotone_tendsto_at_top_at_top α,
+  have h_univ : (univ : set α) = ⋃ n, Iic (xs n),
+  { ext1 x,
+    simp only [mem_univ, mem_Union, mem_Iic, true_iff],
+    obtain ⟨n, hn⟩ := tendsto_at_top_at_top.mp hxs_tendsto x,
+    exact ⟨n, hn n le_rfl⟩, },
+  rw [h_univ, measure_Union_eq_supr, supr_eq_supr_subseq_of_monotone h_mono hxs_tendsto],
+  exact monotone.directed_le (λ i j hij, Iic_subset_Iic.mpr (hxs_mono hij)),
+end
+
+lemma tendsto_measure_Ici_at_bot [semilattice_inf α]
+  [h : (at_bot : filter α).is_countably_generated] (μ : measure α) :
+  tendsto (λ x, μ (Ici x)) at_bot (𝓝 (μ univ)) :=
+@tendsto_measure_Iic_at_top αᵒᵈ _ _ h μ
+
+end measure_theory
+
+end move_this
+
+
 noncomputable theory
-open classical set filter
+open classical set filter function
 open ennreal (of_real)
-open_locale big_operators ennreal nnreal topological_space
+open_locale big_operators ennreal nnreal topology measure_theory
 
 /-! ### Basic properties of Stieltjes functions -/
 
@@ -47,32 +216,31 @@ lemma mono : monotone f := f.mono'
 
 lemma right_continuous (x : ℝ) : continuous_within_at f (Ici x) x := f.right_continuous' x
 
-/-- The limit of a Stieltjes function to the left of `x` (it exists by monotonicity). The fact that
-it is indeed a left limit is asserted in `tendsto_left_lim` -/
-@[irreducible] def left_lim (x : ℝ) := Sup (f '' (Iio x))
-
-lemma tendsto_left_lim (x : ℝ) : tendsto f (𝓝[<] x) (𝓝 (f.left_lim x)) :=
-by { rw left_lim, exact f.mono.tendsto_nhds_within_Iio x }
-
-lemma left_lim_le {x y : ℝ} (h : x ≤ y) : f.left_lim x ≤ f y :=
+lemma right_lim_eq (f : stieltjes_function) (x : ℝ) :
+  function.right_lim f x = f x :=
 begin
-  apply le_of_tendsto (f.tendsto_left_lim x),
-  filter_upwards [self_mem_nhds_within] with _ hz using (f.mono (le_of_lt hz)).trans (f.mono h),
+  rw [← f.mono.continuous_within_at_Ioi_iff_right_lim_eq, continuous_within_at_Ioi_iff_Ici],
+  exact f.right_continuous' x,
 end
 
-lemma le_left_lim {x y : ℝ} (h : x < y) : f x ≤ f.left_lim y :=
+lemma infi_Ioi_eq (f : stieltjes_function) (x : ℝ) :
+  (⨅ r : Ioi x, f r) = f x :=
 begin
-  apply ge_of_tendsto (f.tendsto_left_lim y),
-  apply mem_nhds_within_Iio_iff_exists_Ioo_subset.2 ⟨x, h, _⟩,
-  assume z hz,
-  exact f.mono hz.1.le,
+  suffices : function.right_lim f x = ⨅ r : Ioi x, f r,
+  { rw [← this, f.right_lim_eq], },
+  rw [right_lim_eq_Inf f.mono, Inf_image'],
+  rw ← ne_bot_iff,
+  apply_instance,
 end
 
-lemma left_lim_le_left_lim {x y : ℝ} (h : x ≤ y) : f.left_lim x ≤ f.left_lim y :=
+lemma infi_rat_gt_eq (f : stieltjes_function) (x : ℝ) :
+  (⨅ r : {r' : ℚ // x < r'}, f r) = f x :=
 begin
-  rcases eq_or_lt_of_le h with rfl|hxy,
-  { exact le_rfl },
-  { exact (f.left_lim_le le_rfl).trans (f.le_left_lim hxy) }
+  rw ← infi_Ioi_eq f x,
+  refine (infi_Ioi_eq_infi_rat_gt _ _ f.mono).symm,
+  refine ⟨f x, λ y, _⟩,
+  rintros ⟨y, hy_mem, rfl⟩,
+  exact f.mono (le_of_lt hy_mem),
 end
 
 /-- The identity of `ℝ` as a Stieltjes function, used to construct Lebesgue measure. -/
@@ -81,12 +249,48 @@ end
   mono' := λ x y, id,
   right_continuous' := λ x, continuous_within_at_id }
 
-@[simp] lemma id_left_lim (x : ℝ) : stieltjes_function.id.left_lim x = x :=
-tendsto_nhds_unique (stieltjes_function.id.tendsto_left_lim x) $
+@[simp] lemma id_left_lim (x : ℝ) : left_lim stieltjes_function.id x = x :=
+tendsto_nhds_unique (stieltjes_function.id.mono.tendsto_left_lim x) $
   (continuous_at_id).tendsto.mono_left nhds_within_le_nhds
 
 instance : inhabited stieltjes_function := ⟨stieltjes_function.id⟩
 
+/-- If a function `f : ℝ → ℝ` is monotone, then the function mapping `x` to the right limit of `f`
+at `x` is a Stieltjes function, i.e., it is monotone and right-continuous. -/
+noncomputable def _root_.monotone.stieltjes_function {f : ℝ → ℝ} (hf : monotone f) :
+  stieltjes_function :=
+{ to_fun := right_lim f,
+  mono' := λ x y hxy, hf.right_lim hxy,
+  right_continuous' :=
+  begin
+    assume x s hs,
+    obtain ⟨l, u, hlu, lus⟩ : ∃ (l u : ℝ), right_lim f x ∈ Ioo l u ∧ Ioo l u ⊆ s :=
+      mem_nhds_iff_exists_Ioo_subset.1 hs,
+    obtain ⟨y, xy, h'y⟩ : ∃ (y : ℝ) (H : x < y), Ioc x y ⊆ f ⁻¹' (Ioo l u) :=
+      mem_nhds_within_Ioi_iff_exists_Ioc_subset.1
+        (hf.tendsto_right_lim x (Ioo_mem_nhds hlu.1 hlu.2)),
+    change ∀ᶠ y in 𝓝[≥] x, right_lim f y ∈ s,
+    filter_upwards [Ico_mem_nhds_within_Ici ⟨le_refl x, xy⟩] with z hz,
+    apply lus,
+    refine ⟨hlu.1.trans_le (hf.right_lim hz.1), _⟩,
+    obtain ⟨a, za, ay⟩ : ∃ (a : ℝ), z < a ∧ a < y := exists_between hz.2,
+    calc right_lim f z ≤ f a : hf.right_lim_le za
+                   ... < u   : (h'y ⟨hz.1.trans_lt za, ay.le⟩).2,
+  end }
+
+lemma _root_.monotone.stieltjes_function_eq {f : ℝ → ℝ} (hf : monotone f) (x : ℝ) :
+  hf.stieltjes_function x = right_lim f x := rfl
+
+lemma countable_left_lim_ne (f : stieltjes_function) :
+  set.countable {x | left_lim f x ≠ f x} :=
+begin
+  apply countable.mono _ (f.mono.countable_not_continuous_at),
+  assume x hx h'x,
+  apply hx,
+  exact tendsto_nhds_unique (f.mono.tendsto_left_lim x) (h'x.tendsto.mono_left nhds_within_le_nhds),
+end
+
+
 /-! ### The outer measure associated to a Stieltjes function -/
 
 /-- Length of an interval. This is the largest monotone function which correctly measures all
@@ -174,7 +378,7 @@ begin
     (le_infi₂ $ λ s hs, ennreal.le_of_forall_pos_le_add $ λ ε εpos h, _),
   let δ := ε / 2,
   have δpos : 0 < (δ : ℝ≥0∞), by simpa using εpos.ne',
-  rcases ennreal.exists_pos_sum_of_encodable δpos.ne' ℕ with ⟨ε', ε'0, hε⟩,
+  rcases ennreal.exists_pos_sum_of_countable δpos.ne' ℕ with ⟨ε', ε'0, hε⟩,
   obtain ⟨a', ha', aa'⟩ : ∃ a', f a' - f a < δ ∧ a < a',
   { have A : continuous_within_at (λ r, f r - f a) (Ioi a) a,
     { refine continuous_within_at.sub _ continuous_within_at_const,
@@ -214,7 +418,7 @@ begin
 end
 
 lemma measurable_set_Ioi {c : ℝ} :
-  f.outer.caratheodory.measurable_set' (Ioi c) :=
+  measurable_set[f.outer.caratheodory] (Ioi c) :=
 begin
   apply outer_measure.of_function_caratheodory (λ t, _),
   refine le_infi (λ a, le_infi (λ b, le_infi (λ h, _))),
@@ -239,7 +443,7 @@ begin
   rw outer_measure.trim_eq_infi,
   refine le_infi (λ t, le_infi $ λ ht,
     ennreal.le_of_forall_pos_le_add $ λ ε ε0 h, _),
-  rcases ennreal.exists_pos_sum_of_encodable
+  rcases ennreal.exists_pos_sum_of_countable
     (ennreal.coe_pos.2 ε0).ne' ℕ with ⟨ε', ε'0, hε⟩,
   refine le_trans _ (add_le_add_left (le_of_lt hε) _),
   rw ← ennreal.tsum_add,
@@ -281,7 +485,7 @@ interval `(a, b]`. -/
 @[simp] lemma measure_Ioc (a b : ℝ) : f.measure (Ioc a b) = of_real (f b - f a) :=
 by { rw stieltjes_function.measure, exact f.outer_Ioc a b }
 
-@[simp] lemma measure_singleton (a : ℝ) : f.measure {a} = of_real (f a - f.left_lim a) :=
+@[simp] lemma measure_singleton (a : ℝ) : f.measure {a} = of_real (f a - left_lim f a) :=
 begin
   obtain ⟨u, u_mono, u_lt_a, u_lim⟩ : ∃ (u : ℕ → ℝ), strict_mono u ∧ (∀ (n : ℕ), u n < a)
     ∧ tendsto u at_top (𝓝 a) := exists_seq_strict_mono_tendsto a,
@@ -295,54 +499,85 @@ begin
     refine tendsto_measure_Inter (λ n, measurable_set_Ioc) (λ m n hmn, _) _,
     { exact Ioc_subset_Ioc (u_mono.monotone hmn) le_rfl },
     { exact ⟨0, by simpa only [measure_Ioc] using ennreal.of_real_ne_top⟩ } },
-  have L2 : tendsto (λ n, f.measure (Ioc (u n) a)) at_top (𝓝 (of_real (f a - f.left_lim a))),
+  have L2 : tendsto (λ n, f.measure (Ioc (u n) a)) at_top (𝓝 (of_real (f a - left_lim f a))),
   { simp only [measure_Ioc],
-    have : tendsto (λ n, f (u n)) at_top (𝓝 (f.left_lim a)),
-    { apply (f.tendsto_left_lim a).comp,
+    have : tendsto (λ n, f (u n)) at_top (𝓝 (left_lim f a)),
+    { apply (f.mono.tendsto_left_lim a).comp,
       exact tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ u_lim
         (eventually_of_forall (λ n, u_lt_a n)) },
     exact ennreal.continuous_of_real.continuous_at.tendsto.comp (tendsto_const_nhds.sub this) },
   exact tendsto_nhds_unique L1 L2
 end
 
-@[simp] lemma measure_Icc (a b : ℝ) : f.measure (Icc a b) = of_real (f b - f.left_lim a) :=
+@[simp] lemma measure_Icc (a b : ℝ) : f.measure (Icc a b) = of_real (f b - left_lim f a) :=
 begin
   rcases le_or_lt a b with hab|hab,
   { have A : disjoint {a} (Ioc a b), by simp,
-    simp [← Icc_union_Ioc_eq_Icc le_rfl hab, -singleton_union, ← ennreal.of_real_add, f.left_lim_le,
-      measure_union A measurable_set_Ioc, f.mono hab] },
+    simp [← Icc_union_Ioc_eq_Icc le_rfl hab, -singleton_union, ← ennreal.of_real_add,
+      f.mono.left_lim_le, measure_union A measurable_set_Ioc, f.mono hab] },
   { simp only [hab, measure_empty, Icc_eq_empty, not_le],
     symmetry,
-    simp [ennreal.of_real_eq_zero, f.le_left_lim hab] }
+    simp [ennreal.of_real_eq_zero, f.mono.le_left_lim hab] }
 end
 
-@[simp] lemma measure_Ioo {a b : ℝ} : f.measure (Ioo a b) = of_real (f.left_lim b - f a) :=
+@[simp] lemma measure_Ioo {a b : ℝ} : f.measure (Ioo a b) = of_real (left_lim f b - f a) :=
 begin
   rcases le_or_lt b a with hab|hab,
   { simp only [hab, measure_empty, Ioo_eq_empty, not_lt],
     symmetry,
-    simp [ennreal.of_real_eq_zero, f.left_lim_le hab] },
+    simp [ennreal.of_real_eq_zero, f.mono.left_lim_le hab] },
   { have A : disjoint (Ioo a b) {b}, by simp,
-    have D : f b - f a = (f b - f.left_lim b) + (f.left_lim b - f a), by abel,
+    have D : f b - f a = (f b - left_lim f b) + (left_lim f b - f a), by abel,
     have := f.measure_Ioc a b,
     simp only [←Ioo_union_Icc_eq_Ioc hab le_rfl, measure_singleton,
       measure_union A (measurable_set_singleton b), Icc_self] at this,
     rw [D, ennreal.of_real_add, add_comm] at this,
     { simpa only [ennreal.add_right_inj ennreal.of_real_ne_top] },
-    { simp only [f.left_lim_le, sub_nonneg] },
-    { simp only [f.le_left_lim hab, sub_nonneg] } },
+    { simp only [f.mono.left_lim_le, sub_nonneg] },
+    { simp only [f.mono.le_left_lim hab, sub_nonneg] } },
 end
 
-@[simp] lemma measure_Ico (a b : ℝ) : f.measure (Ico a b) = of_real (f.left_lim b - f.left_lim a) :=
+@[simp] lemma measure_Ico (a b : ℝ) : f.measure (Ico a b) = of_real (left_lim f b - left_lim f a) :=
 begin
   rcases le_or_lt b a with hab|hab,
   { simp only [hab, measure_empty, Ico_eq_empty, not_lt],
     symmetry,
-    simp [ennreal.of_real_eq_zero, f.left_lim_le_left_lim hab] },
+    simp [ennreal.of_real_eq_zero, f.mono.left_lim hab] },
   { have A : disjoint {a} (Ioo a b) := by simp,
-    simp [← Icc_union_Ioo_eq_Ico le_rfl hab, -singleton_union, hab.ne, f.left_lim_le,
-      measure_union A measurable_set_Ioo, f.le_left_lim hab,
-      ← ennreal.of_real_add] }
+    simp [← Icc_union_Ioo_eq_Ico le_rfl hab, -singleton_union, hab.ne, f.mono.left_lim_le,
+      measure_union A measurable_set_Ioo, f.mono.le_left_lim hab, ← ennreal.of_real_add] }
 end
 
+lemma measure_Iic {l : ℝ} (hf : tendsto f at_bot (𝓝 l)) (x : ℝ) :
+  f.measure (Iic x) = of_real (f x - l) :=
+begin
+  refine tendsto_nhds_unique (tendsto_measure_Ioc_at_bot _ _) _,
+  simp_rw measure_Ioc,
+  exact ennreal.tendsto_of_real (tendsto.const_sub _ hf),
+end
+
+lemma measure_Ici {l : ℝ} (hf : tendsto f at_top (𝓝 l)) (x : ℝ) :
+  f.measure (Ici x) = of_real (l - left_lim f x) :=
+begin
+  refine tendsto_nhds_unique (tendsto_measure_Ico_at_top _ _) _,
+  simp_rw measure_Ico,
+  refine ennreal.tendsto_of_real (tendsto.sub_const _ _),
+  have h_le1 : ∀ x, f (x - 1) ≤ left_lim f x := λ x, monotone.le_left_lim f.mono (sub_one_lt x),
+  have h_le2 : ∀ x, left_lim f x ≤ f x := λ x, monotone.left_lim_le f.mono le_rfl,
+  refine tendsto_of_tendsto_of_tendsto_of_le_of_le (hf.comp _) hf h_le1 h_le2,
+  rw tendsto_at_top_at_top,
+  exact λ y, ⟨y + 1, λ z hyz, by rwa le_sub_iff_add_le⟩,
+end
+
+lemma measure_univ {l u : ℝ} (hfl : tendsto f at_bot (𝓝 l)) (hfu : tendsto f at_top (𝓝 u)) :
+  f.measure univ = of_real (u - l) :=
+begin
+  refine tendsto_nhds_unique (tendsto_measure_Iic_at_top _) _,
+  simp_rw measure_Iic f hfl,
+  exact ennreal.tendsto_of_real (tendsto.sub_const hfu _),
+end
+
+instance : is_locally_finite_measure f.measure :=
+⟨λ x, ⟨Ioo (x-1) (x+1), Ioo_mem_nhds (by linarith) (by linarith), by simp⟩⟩
+
 end stieltjes_function
diff --git a/src/measure_theory/measure/sub.lean b/src/measure_theory/measure/sub.lean
index cb8d1b097292a..fb3ce98e4bde6 100644
--- a/src/measure_theory/measure/sub.lean
+++ b/src/measure_theory/measure/sub.lean
@@ -8,6 +8,9 @@ import measure_theory.measure.measure_space
 /-!
 # Subtraction of measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `μ - ν` to be the least measure `τ` such that `μ ≤ τ + ν`.
 It is the equivalent of `(μ - ν) ⊔ 0` if `μ` and `ν` were signed measures.
 Compare with `ennreal.has_sub`.
diff --git a/src/measure_theory/measure/vector_measure.lean b/src/measure_theory/measure/vector_measure.lean
index c6600b51af642..2bb06f31d6fcb 100644
--- a/src/measure_theory/measure/vector_measure.lean
+++ b/src/measure_theory/measure/vector_measure.lean
@@ -10,6 +10,9 @@ import analysis.complex.basic
 
 # Vector valued measures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines vector valued measures, which are σ-additive functions from a set to a add monoid
 `M` such that it maps the empty set and non-measurable sets to zero. In the case
 that `M = ℝ`, we called the vector measure a signed measure and write `signed_measure α`.
@@ -123,13 +126,14 @@ end
 
 variables [t2_space M] {v : vector_measure α M} {f : ℕ → set α}
 
-lemma has_sum_of_disjoint_Union [encodable β] {f : β → set α}
+lemma has_sum_of_disjoint_Union [countable β] {f : β → set α}
   (hf₁ : ∀ i, measurable_set (f i)) (hf₂ : pairwise (disjoint on f)) :
   has_sum (λ i, v (f i)) (v (⋃ i, f i)) :=
 begin
+  casesI nonempty_encodable β,
   set g := λ i : ℕ, ⋃ (b : β) (H : b ∈ encodable.decode₂ β i), f b with hg,
   have hg₁ : ∀ i, measurable_set (g i),
-  { exact λ _, measurable_set.Union (λ b, measurable_set.Union_Prop $ λ _, hf₁ b) },
+  { exact λ _, measurable_set.Union (λ b, measurable_set.Union $ λ _, hf₁ b) },
   have hg₂ : pairwise (disjoint on g),
   { exact encodable.Union_decode₂_disjoint_on hf₂ },
   have := v.of_disjoint_Union_nat hg₁ hg₂,
@@ -157,7 +161,7 @@ begin
       exact false.elim ((hx i) ((encodable.decode₂_is_partial_inv _ _).1 hi)) } }
 end
 
-lemma of_disjoint_Union [encodable β] {f : β → set α}
+lemma of_disjoint_Union [countable β] {f : β → set α}
   (hf₁ : ∀ i, measurable_set (f i)) (hf₂ : pairwise (disjoint on f)) :
   v (⋃ i, f i) = ∑' i, v (f i) :=
 (has_sum_of_disjoint_Union hf₁ hf₂).tsum_eq.symm
@@ -173,7 +177,7 @@ end
 lemma of_add_of_diff {A B : set α} (hA : measurable_set A) (hB : measurable_set B)
   (h : A ⊆ B) : v A + v (B \ A) = v B :=
 begin
-  rw [← of_union disjoint_diff hA (hB.diff hA), union_diff_cancel h],
+  rw [← of_union disjoint_sdiff_right hA (hB.diff hA), union_diff_cancel h],
   apply_instance,
 end
 
@@ -195,12 +199,12 @@ begin
        ... = v (A \ B) + v (A ∩ B) :
   by { rw of_union,
        { rw disjoint.comm,
-         exact set.disjoint_of_subset_left (A.inter_subset_right B) set.disjoint_diff },
+         exact set.disjoint_of_subset_left (A.inter_subset_right B) disjoint_sdiff_self_right },
        { exact hA.diff hB },
        { exact hA.inter hB } }
        ... = v (A \ B) + v (A ∩ B ∪ B \ A) :
   by { rw [of_union, h', add_zero],
-       { exact set.disjoint_of_subset_left (A.inter_subset_left B) set.disjoint_diff },
+       { exact set.disjoint_of_subset_left (A.inter_subset_left B) disjoint_sdiff_self_right },
        { exact hA.inter hB },
        { exact hB.diff hA } }
        ... = v (A \ B) + v B :
@@ -243,7 +247,7 @@ end
 
 end
 
-section has_scalar
+section has_smul
 variables {M : Type*} [add_comm_monoid M] [topological_space M]
 variables {R : Type*} [semiring R] [distrib_mul_action R M] [has_continuous_const_smul R M]
 
@@ -255,15 +259,15 @@ def smul (r : R) (v : vector_measure α M) : vector_measure α M :=
 { measure_of' := r • v,
   empty' := by rw [pi.smul_apply, empty, smul_zero],
   not_measurable' := λ _ hi, by rw [pi.smul_apply, v.not_measurable hi, smul_zero],
-  m_Union' := λ _ hf₁ hf₂, has_sum.const_smul (v.m_Union hf₁ hf₂) }
+  m_Union' := λ _ hf₁ hf₂, has_sum.const_smul _ (v.m_Union hf₁ hf₂) }
 
-instance : has_scalar R (vector_measure α M) := ⟨smul⟩
+instance : has_smul R (vector_measure α M) := ⟨smul⟩
 
 @[simp] lemma coe_smul (r : R) (v : vector_measure α M) : ⇑(r • v) = r • v := rfl
 lemma smul_apply (r : R) (v : vector_measure α M) (i : set α) :
   (r • v) i = r • v i := rfl
 
-end has_scalar
+end has_smul
 
 section add_comm_monoid
 
@@ -529,9 +533,9 @@ if hf : measurable f then
   m_Union' :=
   begin
     intros g hg₁ hg₂,
-    convert v.m_Union (λ i, hf (hg₁ i)) (λ i j hij x hx, hg₂ i j hij hx),
+    convert v.m_Union (λ i, hf (hg₁ i)) (λ i j hij, (hg₂ hij).preimage _),
     { ext i, rw if_pos (hg₁ i) },
-    { rw [preimage_Union, if_pos (measurable_set.Union hg₁)] }
+    { rw [preimage_Union, if_pos (measurable_set.Union hg₁)] },
   end } else 0
 
 lemma map_not_measurable {f : α → β} (hf : ¬ measurable f) : v.map f = 0 :=
@@ -775,9 +779,9 @@ end
 
 end
 
-localized "notation v ` ≤[`:50 i:50 `] `:0 w:50 :=
-measure_theory.vector_measure.restrict v i ≤ measure_theory.vector_measure.restrict w i"
-in measure_theory
+localized "notation (name := vector_measure.restrict) v ` ≤[`:50 i:50 `] `:0 w:50 :=
+  measure_theory.vector_measure.restrict v i ≤ measure_theory.vector_measure.restrict w i"
+  in measure_theory
 
 section
 
@@ -882,10 +886,11 @@ begin
   { exact λ n, ha₁.inter (measurable_set.disjointed hf₁ n) }
 end
 
-lemma restrict_le_restrict_encodable_Union [encodable β] {f : β → set α}
+lemma restrict_le_restrict_countable_Union [countable β] {f : β → set α}
   (hf₁ : ∀ b, measurable_set (f b)) (hf₂ : ∀ b, v ≤[f b] w) :
   v ≤[⋃ b, f b] w :=
 begin
+  casesI nonempty_encodable β,
   rw ← encodable.Union_decode₂,
   refine restrict_le_restrict_Union v w _ _,
   { intro n, measurability },
@@ -901,7 +906,7 @@ lemma restrict_le_restrict_union
   v ≤[i ∪ j] w :=
 begin
   rw union_eq_Union,
-  refine restrict_le_restrict_encodable_Union v w _ _,
+  refine restrict_le_restrict_countable_Union v w _ _,
   { measurability },
   { rintro (_ | _); simpa }
 end
@@ -1007,7 +1012,8 @@ def absolutely_continuous (v : vector_measure α M) (w : vector_measure α N) :=
 ∀ ⦃s : set α⦄, w s = 0 → v s = 0
 
 
-localized "infix ` ≪ᵥ `:50 := measure_theory.vector_measure.absolutely_continuous"
+localized "infix (name := vector_measure.absolutely_continuous)
+  ` ≪ᵥ `:50 := measure_theory.vector_measure.absolutely_continuous"
   in measure_theory
 
 open_locale measure_theory
@@ -1099,7 +1105,8 @@ to use. This is equivalent to the definition which requires measurability. To pr
 def mutually_singular (v : vector_measure α M) (w : vector_measure α N) : Prop :=
 ∃ (s : set α), measurable_set s ∧ (∀ t ⊆ s, v t = 0) ∧ (∀ t ⊆ sᶜ, w t = 0)
 
-localized "infix ` ⊥ᵥ `:60 := measure_theory.vector_measure.mutually_singular" in measure_theory
+localized "infix (name := vector_measure.mutually_singular)
+  ` ⟂ᵥ `:60 := measure_theory.vector_measure.mutually_singular" in measure_theory
 
 namespace mutually_singular
 
@@ -1107,7 +1114,7 @@ variables {v v₁ v₂ : vector_measure α M} {w w₁ w₂ : vector_measure α N
 
 lemma mk (s : set α) (hs : measurable_set s)
   (h₁ : ∀ t ⊆ s, measurable_set t → v t = 0)
-  (h₂ : ∀ t ⊆ sᶜ, measurable_set t → w t = 0) : v ⊥ᵥ w :=
+  (h₂ : ∀ t ⊆ sᶜ, measurable_set t → w t = 0) : v ⟂ᵥ w :=
 begin
   refine ⟨s, hs, λ t hst, _, λ t hst, _⟩;
   by_cases ht : measurable_set t,
@@ -1117,17 +1124,17 @@ begin
   { exact not_measurable w ht }
 end
 
-lemma symm (h : v ⊥ᵥ w) : w ⊥ᵥ v :=
+lemma symm (h : v ⟂ᵥ w) : w ⟂ᵥ v :=
 let ⟨s, hmeas, hs₁, hs₂⟩ := h in
   ⟨sᶜ, hmeas.compl, hs₂, λ t ht, hs₁ _ (compl_compl s ▸ ht : t ⊆ s)⟩
 
-lemma zero_right : v ⊥ᵥ (0 : vector_measure α N) :=
+lemma zero_right : v ⟂ᵥ (0 : vector_measure α N) :=
 ⟨∅, measurable_set.empty, λ t ht, (subset_empty_iff.1 ht).symm ▸ v.empty, λ _ _, zero_apply _⟩
 
-lemma zero_left : (0 : vector_measure α M) ⊥ᵥ w :=
+lemma zero_left : (0 : vector_measure α M) ⟂ᵥ w :=
 zero_right.symm
 
-lemma add_left [t2_space N] [has_continuous_add M] (h₁ : v₁ ⊥ᵥ w) (h₂ : v₂ ⊥ᵥ w) : v₁ + v₂ ⊥ᵥ w :=
+lemma add_left [t2_space N] [has_continuous_add M] (h₁ : v₁ ⟂ᵥ w) (h₂ : v₂ ⟂ᵥ w) : v₁ + v₂ ⟂ᵥ w :=
 begin
   obtain ⟨u, hmu, hu₁, hu₂⟩ := h₁,
   obtain ⟨v, hmv, hv₁, hv₂⟩ := h₂,
@@ -1140,7 +1147,7 @@ begin
     { exact subset.trans (inter_subset_left _ _) (diff_subset _ _) },
     { exact inter_subset_left _ _ },
     { apply_instance },
-    { exact disjoint.mono (inter_subset_left _ _) (inter_subset_left _ _) disjoint_diff },
+    { exact disjoint_sdiff_self_right.mono (inter_subset_left _ _) (inter_subset_left _ _) },
     { apply subset.antisymm;
       intros x hx,
       { by_cases hxu' : x ∈ uᶜ,
@@ -1150,20 +1157,20 @@ begin
       { rcases hx; exact hx.2 } } },
 end
 
-lemma add_right [t2_space M] [has_continuous_add N] (h₁ : v ⊥ᵥ w₁) (h₂ : v ⊥ᵥ w₂) : v ⊥ᵥ w₁ + w₂ :=
+lemma add_right [t2_space M] [has_continuous_add N] (h₁ : v ⟂ᵥ w₁) (h₂ : v ⟂ᵥ w₂) : v ⟂ᵥ w₁ + w₂ :=
 (add_left h₁.symm h₂.symm).symm
 
 lemma smul_right {R : Type*} [semiring R] [distrib_mul_action R N] [has_continuous_const_smul R N]
-  (r : R) (h : v ⊥ᵥ w) : v ⊥ᵥ r • w :=
+  (r : R) (h : v ⟂ᵥ w) : v ⟂ᵥ r • w :=
 let ⟨s, hmeas, hs₁, hs₂⟩ := h in
   ⟨s, hmeas, hs₁, λ t ht, by simp only [coe_smul, pi.smul_apply, hs₂ t ht, smul_zero]⟩
 
 lemma smul_left {R : Type*} [semiring R] [distrib_mul_action R M] [has_continuous_const_smul R M]
-  (r : R) (h : v ⊥ᵥ w) : r • v ⊥ᵥ w :=
+  (r : R) (h : v ⟂ᵥ w) : r • v ⟂ᵥ w :=
 (smul_right r h.symm).symm
 
 lemma neg_left {M : Type*} [add_comm_group M] [topological_space M] [topological_add_group M]
-  {v : vector_measure α M} {w : vector_measure α N} (h : v ⊥ᵥ w) : -v ⊥ᵥ w :=
+  {v : vector_measure α M} {w : vector_measure α N} (h : v ⟂ᵥ w) : -v ⟂ᵥ w :=
 begin
   obtain ⟨u, hmu, hu₁, hu₂⟩ := h,
   refine ⟨u, hmu, λ s hs, _, hu₂⟩,
@@ -1172,19 +1179,19 @@ begin
 end
 
 lemma neg_right {N : Type*} [add_comm_group N] [topological_space N] [topological_add_group N]
-  {v : vector_measure α M} {w : vector_measure α N} (h : v ⊥ᵥ w) : v ⊥ᵥ -w :=
+  {v : vector_measure α M} {w : vector_measure α N} (h : v ⟂ᵥ w) : v ⟂ᵥ -w :=
 h.symm.neg_left.symm
 
 @[simp]
 lemma neg_left_iff {M : Type*} [add_comm_group M] [topological_space M] [topological_add_group M]
   {v : vector_measure α M} {w : vector_measure α N} :
-  -v ⊥ᵥ w ↔ v ⊥ᵥ w :=
+  -v ⟂ᵥ w ↔ v ⟂ᵥ w :=
 ⟨λ h, neg_neg v ▸ h.neg_left, neg_left⟩
 
 @[simp]
 lemma neg_right_iff {N : Type*} [add_comm_group N] [topological_space N] [topological_add_group N]
   {v : vector_measure α M} {w : vector_measure α N} :
-  v ⊥ᵥ -w ↔ v ⊥ᵥ w :=
+  v ⟂ᵥ -w ↔ v ⟂ᵥ w :=
 ⟨λ h, neg_neg w ▸ h.neg_right, neg_right⟩
 
 end mutually_singular
@@ -1264,8 +1271,8 @@ measure.of_measurable (s.to_measure_of_zero_le' i hi₂)
     intros f hf₁ hf₂,
     have h₁ : ∀ n, measurable_set (i ∩ f n) := λ n, hi₁.inter (hf₁ n),
     have h₂ : pairwise (disjoint on λ (n : ℕ), i ∩ f n),
-    { rintro n m hnm x ⟨⟨_, hx₁⟩, _, hx₂⟩,
-      exact hf₂ n m hnm ⟨hx₁, hx₂⟩ },
+    { intros n m hnm,
+      exact (((hf₂ hnm).inf_left' i).inf_right' i) },
     simp only [to_measure_of_zero_le', s.restrict_apply hi₁ (measurable_set.Union hf₁),
                set.inter_comm, set.inter_Union, s.of_disjoint_Union_nat h₁ h₂,
                ennreal.some_eq_coe, id.def],
diff --git a/src/measure_theory/measure/with_density_vector_measure.lean b/src/measure_theory/measure/with_density_vector_measure.lean
index 711693e337091..20d61de0cff09 100644
--- a/src/measure_theory/measure/with_density_vector_measure.lean
+++ b/src/measure_theory/measure/with_density_vector_measure.lean
@@ -10,6 +10,9 @@ import measure_theory.function.ae_eq_of_integral
 
 # Vector measure defined by an integral
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a measure `μ` and an integrable function `f : α → E`, we can define a vector measure `v` such
 that for all measurable set `s`, `v i = ∫ x in s, f x ∂μ`. This definition is useful for
 the Radon-Nikodym theorem for signed measures.
@@ -31,7 +34,7 @@ namespace measure_theory
 open topological_space
 
 variables {μ ν : measure α}
-variables {E : Type*} [normed_group E] [normed_space ℝ E] [complete_space E]
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
 
 /-- Given a measure `μ` and an integrable function `f`, `μ.with_densityᵥ f` is
 the vector measure which maps the set `s` to `∫ₛ f ∂μ`. -/
@@ -100,7 +103,7 @@ lemma with_densityᵥ_sub' (hf : integrable f μ) (hg : integrable g μ) :
   μ.with_densityᵥ (λ x, f x - g x) = μ.with_densityᵥ f - μ.with_densityᵥ g :=
 with_densityᵥ_sub hf hg
 
-@[simp] lemma with_densityᵥ_smul {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
+@[simp] lemma with_densityᵥ_smul {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
   [smul_comm_class ℝ 𝕜 E] (f : α → E) (r : 𝕜) :
   μ.with_densityᵥ (r • f) = r • μ.with_densityᵥ f :=
 begin
@@ -115,7 +118,7 @@ begin
       rwa integrable_smul_iff hr f } }
 end
 
-lemma with_densityᵥ_smul' {𝕜 : Type*} [nondiscrete_normed_field 𝕜] [normed_space 𝕜 E]
+lemma with_densityᵥ_smul' {𝕜 : Type*} [nontrivially_normed_field 𝕜] [normed_space 𝕜 E]
   [smul_comm_class ℝ 𝕜 E] (f : α → E) (r : 𝕜) :
   μ.with_densityᵥ (λ x, r • f x) = r • μ.with_densityᵥ f :=
 with_densityᵥ_smul f r
diff --git a/src/measure_theory/order/upper_lower.lean b/src/measure_theory/order/upper_lower.lean
new file mode 100644
index 0000000000000..d6bc49a4cfffa
--- /dev/null
+++ b/src/measure_theory/order/upper_lower.lean
@@ -0,0 +1,131 @@
+/-
+Copyright (c) 2022 Yaël Dillies, Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies, Kexing Ying
+-/
+import analysis.normed.order.upper_lower
+import logic.lemmas
+import measure_theory.covering.besicovitch_vector_space
+
+/-!
+# Order-connected sets are null-measurable
+
+This file proves that order-connected sets in `ℝⁿ` under the pointwise order are null-measurable.
+Recall that `x ≤ y` iff `∀ i, x i ≤ y i`, and `s` is order-connected iff
+`∀ x y ∈ s, ∀ z, x ≤ z → z ≤ y → z ∈ s`.
+
+## Main declarations
+
+* `set.ord_connected.null_frontier`: The frontier of an order-connected set in `ℝⁿ` has measure `0`.
+
+## Notes
+
+We prove null-measurability in `ℝⁿ` with the `∞`-metric, but this transfers directly to `ℝⁿ` with
+the Euclidean metric because they have the same measurable sets.
+
+Null-measurability can't be strengthened to measurability because any antichain (and in particular
+any subset of the antidiagonal `{(x, y) | x + y = 0}`) is order-connected.
+
+## TODO
+
+Generalize so that it also applies to `ℝ × ℝ`, for example.
+-/
+
+open filter measure_theory metric set
+open_locale topology
+
+variables {ι : Type*} [fintype ι] {s : set (ι → ℝ)} {x y : ι → ℝ} {δ : ℝ}
+
+/-- If we can fit a small ball inside a set `s` intersected with any neighborhood of `x`, then the
+density of `s` near `x` is not `0`. Along with `aux₁`, this proves that `x` is a Lebesgue point of
+`s`. This will be used to prove that the frontier of an order-connected set is null. -/
+private lemma aux₀
+  (h : ∀ δ, 0 < δ → ∃ y, closed_ball y (δ/4) ⊆ closed_ball x δ ∧ closed_ball y (δ/4) ⊆ interior s) :
+  ¬ tendsto (λ r, volume (closure s ∩ closed_ball x r) / volume (closed_ball x r)) (𝓝[>] 0)
+    (𝓝 0) :=
+begin
+  choose f hf₀ hf₁ using h,
+  intros H,
+  obtain ⟨ε, hε, hε', hε₀⟩ := exists_seq_strict_anti_tendsto_nhds_within (0 : ℝ),
+  refine not_eventually.2 (frequently_of_forall $ λ _, lt_irrefl $
+    ennreal.of_real $ 4⁻¹ ^ fintype.card ι)
+   ((tendsto.eventually_lt (H.comp hε₀) tendsto_const_nhds _).mono $ λ n, lt_of_le_of_lt _),
+  swap,
+  refine (ennreal.div_le_div_right (volume.mono $ subset_inter
+    ((hf₁ _ $ hε' n).trans interior_subset_closure) $ hf₀ _ $ hε' n) _).trans_eq' _,
+  dsimp,
+  have := hε' n,
+  rw [real.volume_pi_closed_ball, real.volume_pi_closed_ball, ←ennreal.of_real_div_of_pos, ←div_pow,
+    mul_div_mul_left _ _ (two_ne_zero' ℝ), div_right_comm, div_self, one_div],
+  all_goals { positivity },
+end
+
+/-- If we can fit a small ball inside a set `sᶜ` intersected with any neighborhood of `x`, then the
+density of `s` near `x` is not `1`. Along with `aux₀`, this proves that `x` is a Lebesgue point of
+`s`. This will be used to prove that the frontier of an order-connected set is null. -/
+private lemma aux₁
+  (h : ∀ δ, 0 < δ →
+    ∃ y, closed_ball y (δ/4) ⊆ closed_ball x δ ∧ closed_ball y (δ/4) ⊆ interior sᶜ) :
+  ¬ tendsto (λ r, volume (closure s ∩ closed_ball x r) / volume (closed_ball x r)) (𝓝[>] 0)
+    (𝓝 1) :=
+begin
+  choose f hf₀ hf₁ using h,
+  intros H,
+  obtain ⟨ε, hε, hε', hε₀⟩ := exists_seq_strict_anti_tendsto_nhds_within (0 : ℝ),
+  refine not_eventually.2 (frequently_of_forall $ λ _, lt_irrefl $
+    1 - ennreal.of_real (4⁻¹ ^ fintype.card ι))
+    ((tendsto.eventually_lt tendsto_const_nhds (H.comp hε₀) $
+    ennreal.sub_lt_self ennreal.one_ne_top one_ne_zero _).mono $ λ n, lt_of_le_of_lt' _),
+  swap,
+  refine (ennreal.div_le_div_right (volume.mono _) _).trans_eq _,
+  { exact closed_ball x (ε n) \ closed_ball (f (ε n) $ hε' n) (ε n / 4) },
+  { rw diff_eq_compl_inter,
+    refine inter_subset_inter_left _ _,
+    rw [subset_compl_comm, ←interior_compl],
+    exact hf₁ _ _ },
+  dsimp,
+  have := hε' n,
+  rw [measure_diff (hf₀ _ _) _ ((real.volume_pi_closed_ball _ _).trans_ne ennreal.of_real_ne_top),
+    real.volume_pi_closed_ball, real.volume_pi_closed_ball,  ennreal.sub_div (λ _ _, _),
+    ennreal.div_self _ ennreal.of_real_ne_top, ←ennreal.of_real_div_of_pos, ←div_pow,
+    mul_div_mul_left _ _ (two_ne_zero' ℝ), div_right_comm, div_self, one_div],
+  all_goals { positivity <|> measurability },
+end
+
+lemma is_upper_set.null_frontier (hs : is_upper_set s) : volume (frontier s) = 0 :=
+begin
+  refine eq_bot_mono (volume.mono $ λ x hx, _)
+    (besicovitch.ae_tendsto_measure_inter_div_of_measurable_set _ is_closed_closure.measurable_set),
+  { exact s },
+  by_cases x ∈ closure s; simp [h],
+  { exact aux₁ (λ _, hs.compl.exists_subset_ball $ frontier_subset_closure $
+      by rwa frontier_compl) },
+  { exact aux₀ (λ _, hs.exists_subset_ball $ frontier_subset_closure hx) }
+end
+
+lemma is_lower_set.null_frontier (hs : is_lower_set s) : volume (frontier s) = 0 :=
+begin
+  refine eq_bot_mono (volume.mono $ λ x hx, _)
+    (besicovitch.ae_tendsto_measure_inter_div_of_measurable_set _ is_closed_closure.measurable_set),
+  { exact s },
+  by_cases x ∈ closure s; simp [h],
+  { exact aux₁ (λ _, hs.compl.exists_subset_ball $ frontier_subset_closure $
+      by rwa frontier_compl) },
+  { exact aux₀ (λ _, hs.exists_subset_ball $ frontier_subset_closure hx) }
+end
+
+lemma set.ord_connected.null_frontier (hs : s.ord_connected) : volume (frontier s) = 0 :=
+begin
+  rw ← hs.upper_closure_inter_lower_closure,
+  refine le_bot_iff.1 ((volume.mono $ (frontier_inter_subset _ _).trans $ union_subset_union
+    (inter_subset_left _ _) $ inter_subset_right _ _).trans $ (measure_union_le _ _).trans_eq _),
+  rw [(upper_set.upper _).null_frontier, (lower_set.lower _).null_frontier, zero_add, bot_eq_zero],
+end
+
+protected lemma set.ord_connected.null_measurable_set (hs : s.ord_connected) :
+  null_measurable_set s :=
+null_measurable_set_of_null_frontier hs.null_frontier
+
+lemma is_antichain.volume_eq_zero [nonempty ι] (hs : is_antichain (≤) s) : volume s = 0 :=
+le_bot_iff.1 $ (volume.mono $ by { rw [←closure_diff_interior, hs.interior_eq_empty, diff_empty],
+  exact subset_closure }).trans_eq hs.ord_connected.null_frontier
diff --git a/src/measure_theory/pi_system.lean b/src/measure_theory/pi_system.lean
index efaaa9aa0f3cb..6b51be17b3438 100644
--- a/src/measure_theory/pi_system.lean
+++ b/src/measure_theory/pi_system.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2021 Martin Zinkevich. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Martin Zinkevich
+Authors: Johannes Hölzl, Martin Zinkevich, Rémy Degenne
 -/
 import logic.encodable.lattice
 import measure_theory.measurable_space_def
@@ -9,6 +9,9 @@ import measure_theory.measurable_space_def
 /-!
 # Induction principles for measurable sets, related to π-systems and λ-systems.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main statements
 
 * The main theorem of this file is Dynkin's π-λ theorem, which appears
@@ -42,6 +45,10 @@ import measure_theory.measurable_space_def
   element of the π-system generated from the union of a set of π-systems can be
   represented as the intersection of a finite number of elements from these sets.
 
+* `pi_Union_Inter` defines a new π-system from a family of π-systems `π : ι → set (set α)` and a
+  set of indices `S : set ι`. `pi_Union_Inter π S` is the set of sets that can be written
+  as `⋂ x ∈ t, f x` for some finset `t ∈ S` and sets `f x ∈ π x`.
+
 ## Implementation details
 
 * `is_pi_system` is a predicate, not a type. Thus, we don't explicitly define the galois
@@ -50,7 +57,7 @@ import measure_theory.measurable_space_def
 -/
 
 open measurable_space set
-open_locale classical
+open_locale classical measure_theory
 
 /-- A π-system is a collection of subsets of `α` that is closed under binary intersection of
   non-disjoint sets. Usually it is also required that the collection is nonempty, but we don't do
@@ -73,6 +80,57 @@ begin
       set.mem_singleton_iff],
 end
 
+lemma is_pi_system.insert_empty {α} {S : set (set α)} (h_pi : is_pi_system S) :
+  is_pi_system (insert ∅ S) :=
+begin
+  intros s hs t ht hst,
+  cases hs,
+  { simp [hs], },
+  { cases ht,
+    { simp [ht], },
+    { exact set.mem_insert_of_mem _ (h_pi s hs t ht hst), }, },
+end
+
+lemma is_pi_system.insert_univ {α} {S : set (set α)} (h_pi : is_pi_system S) :
+  is_pi_system (insert set.univ S) :=
+begin
+  intros s hs t ht hst,
+  cases hs,
+  { cases ht; simp [hs, ht], },
+  { cases ht,
+    { simp [hs, ht], },
+    { exact set.mem_insert_of_mem _ (h_pi s hs t ht hst), }, },
+end
+
+lemma is_pi_system.comap {α β} {S : set (set β)} (h_pi : is_pi_system S) (f : α → β) :
+  is_pi_system {s : set α | ∃ t ∈ S, f ⁻¹' t = s} :=
+begin
+  rintros _ ⟨s, hs_mem, rfl⟩ _ ⟨t, ht_mem, rfl⟩ hst,
+  rw ← set.preimage_inter at hst ⊢,
+  refine ⟨s ∩ t, h_pi s hs_mem t ht_mem _, rfl⟩,
+  by_contra,
+  rw set.not_nonempty_iff_eq_empty at h,
+  rw h at hst,
+  simpa using hst,
+end
+
+lemma is_pi_system_Union_of_directed_le {α ι} (p : ι → set (set α))
+  (hp_pi : ∀ n, is_pi_system (p n)) (hp_directed : directed (≤) p) :
+  is_pi_system (⋃ n, p n) :=
+begin
+  intros t1 ht1 t2 ht2 h,
+  rw set.mem_Union at ht1 ht2 ⊢,
+  cases ht1 with n ht1,
+  cases ht2 with m ht2,
+  obtain ⟨k, hpnk, hpmk⟩ : ∃ k, p n ≤ p k ∧ p m ≤ p k := hp_directed n m,
+  exact ⟨k, hp_pi k t1 (hpnk ht1) t2 (hpmk ht2) h⟩,
+end
+
+lemma is_pi_system_Union_of_monotone {α ι} [semilattice_sup ι] (p : ι → set (set α))
+  (hp_pi : ∀ n, is_pi_system (p n)) (hp_mono : monotone p) :
+  is_pi_system (⋃ n, p n) :=
+is_pi_system_Union_of_directed_le p hp_pi (monotone.directed_le hp_mono)
+
 section order
 
 variables {α : Type*} {ι ι' : Sort*} [linear_order α]
@@ -190,7 +248,7 @@ end
 
 lemma generate_from_measurable_set_of_generate_pi_system {α} {g : set (set α)} (t : set α)
   (ht : t ∈ generate_pi_system g) :
-  (generate_from g).measurable_set' t :=
+  measurable_set[generate_from g] t :=
 @generate_pi_system_measurable_set α (generate_from g) g
   (λ s h_s_in_g, measurable_set_generate_from h_s_in_g) t ht
 
@@ -239,38 +297,217 @@ end
 /- Every element of the π-system generated by an indexed union of a family of π-systems
 is a finite intersection of elements from the π-systems.
 For a total union version, see `mem_generate_pi_system_Union_elim`. -/
-lemma mem_generate_pi_system_Union_elim' {α β} {g : β → set (set α)} {s: set β}
+lemma mem_generate_pi_system_Union_elim' {α β} {g : β → set (set α)} {s : set β}
   (h_pi : ∀ b ∈ s, is_pi_system (g b)) (t : set α) (h_t : t ∈ generate_pi_system (⋃ b ∈ s, g b)) :
   ∃ (T : finset β) (f : β → set α), (↑T ⊆ s) ∧ (t = ⋂ b ∈ T, f b) ∧ (∀ b ∈ T, f b ∈ g b) :=
 begin
   have : t ∈ generate_pi_system (⋃ (b : subtype s), (g ∘ subtype.val) b),
-  { suffices h1 : (⋃ (b : subtype s), (g ∘ subtype.val) b) = (⋃ b (H : b ∈ s), g b), by rwa h1,
+  { suffices h1 : (⋃ (b : subtype s), (g ∘ subtype.val) b) = (⋃ b ∈ s, g b), by rwa h1,
     ext x,
     simp only [exists_prop, set.mem_Union, function.comp_app, subtype.exists, subtype.coe_mk],
     refl },
   rcases @mem_generate_pi_system_Union_elim α (subtype s) (g ∘ subtype.val)
-    (λ b, h_pi b.val b.property) t this with ⟨T, ⟨f,⟨ rfl, h_t'⟩⟩⟩,
-  refine ⟨T.image subtype.val, function.extend subtype.val f (λ (b:β), (∅ : set α)), by simp, _, _⟩,
+    (λ b, h_pi b.val b.property) t this with ⟨T, ⟨f, ⟨rfl, h_t'⟩⟩⟩,
+  refine ⟨T.image subtype.val, function.extend subtype.val f (λ b : β, (∅ : set α)), by simp, _, _⟩,
   { ext a, split;
     { simp only [set.mem_Inter, subtype.forall, finset.set_bInter_finset_image],
       intros h1 b h_b h_b_in_T,
       have h2 := h1 b h_b h_b_in_T,
       revert h2,
-      rw function.extend_apply subtype.val_injective,
+      rw subtype.val_injective.extend_apply,
       apply id } },
   { intros b h_b,
     simp_rw [finset.mem_image, exists_prop, subtype.exists,
              exists_and_distrib_right, exists_eq_right] at h_b,
     cases h_b,
     have h_b_alt : b = (subtype.mk b h_b_w).val := rfl,
-    rw [h_b_alt, function.extend_apply subtype.val_injective],
+    rw [h_b_alt, subtype.val_injective.extend_apply],
     apply h_t',
     apply h_b_h },
 end
 
+section Union_Inter
+
+variables {α ι : Type*}
+
+/-! ### π-system generated by finite intersections of sets of a π-system family -/
+
+/-- From a set of indices `S : set ι` and a family of sets of sets `π : ι → set (set α)`,
+define the set of sets that can be written as `⋂ x ∈ t, f x` for some finset `t ⊆ S` and sets
+`f x ∈ π x`. If `π` is a family of π-systems, then it is a π-system. -/
+def pi_Union_Inter (π : ι → set (set α)) (S : set ι) : set (set α) :=
+{s : set α | ∃ (t : finset ι) (htS : ↑t ⊆ S) (f : ι → set α) (hf : ∀ x, x ∈ t → f x ∈ π x),
+  s = ⋂ x ∈ t, f x}
+
+lemma pi_Union_Inter_singleton (π : ι → set (set α)) (i : ι) :
+  pi_Union_Inter π {i} = π i ∪ {univ} :=
+begin
+  ext1 s,
+  simp only [pi_Union_Inter, exists_prop, mem_union],
+  refine ⟨_, λ h, _⟩,
+  { rintros ⟨t, hti, f, hfπ, rfl⟩,
+    simp only [subset_singleton_iff, finset.mem_coe] at hti,
+    by_cases hi : i ∈ t,
+    { have ht_eq_i : t = {i},
+      { ext1 x, rw finset.mem_singleton, exact ⟨λ h, hti x h, λ h, h.symm ▸ hi⟩, },
+      simp only [ht_eq_i, finset.mem_singleton, Inter_Inter_eq_left],
+      exact or.inl (hfπ i hi), },
+     { have ht_empty : t = ∅,
+      { ext1 x,
+        simp only [finset.not_mem_empty, iff_false],
+        exact λ hx, hi (hti x hx ▸ hx), },
+      simp only [ht_empty, Inter_false, Inter_univ, set.mem_singleton univ, or_true], }, },
+  { cases h with hs hs,
+    { refine ⟨{i}, _, λ _, s, ⟨λ x hx, _, _⟩⟩,
+      { rw finset.coe_singleton, },
+      { rw finset.mem_singleton at hx,
+        rwa hx, },
+      { simp only [finset.mem_singleton, Inter_Inter_eq_left], }, },
+    { refine ⟨∅, _⟩,
+      simpa only [finset.coe_empty, subset_singleton_iff, mem_empty_iff_false, is_empty.forall_iff,
+        implies_true_iff, finset.not_mem_empty, Inter_false, Inter_univ, true_and, exists_const]
+        using hs, }, },
+end
+
+lemma pi_Union_Inter_singleton_left (s : ι → set α) (S : set ι) :
+  pi_Union_Inter (λ i, ({s i} : set (set α))) S
+    = {s' : set α | ∃ (t : finset ι) (htS : ↑t ⊆ S), s' = ⋂ i ∈ t, s i} :=
+begin
+  ext1 s',
+  simp_rw [pi_Union_Inter, set.mem_singleton_iff, exists_prop, set.mem_set_of_eq],
+  refine ⟨λ h, _, λ ⟨t, htS, h_eq⟩, ⟨t, htS, s, λ _ _, rfl, h_eq⟩⟩,
+  obtain ⟨t, htS, f, hft_eq, rfl⟩ := h,
+  refine ⟨t, htS, _⟩,
+  congr' with i x,
+  simp_rw set.mem_Inter,
+  exact ⟨λ h hit, by { rw ← hft_eq i hit, exact h hit, },
+    λ h hit, by { rw hft_eq i hit, exact h hit, }⟩,
+end
+
+lemma generate_from_pi_Union_Inter_singleton_left (s : ι → set α) (S : set ι) :
+  generate_from (pi_Union_Inter (λ k, {s k}) S) = generate_from {t | ∃ k ∈ S, s k = t} :=
+begin
+  refine le_antisymm (generate_from_le _) (generate_from_mono _),
+  { rintro _ ⟨I, hI, f, hf, rfl⟩,
+    refine finset.measurable_set_bInter _ (λ m hm, measurable_set_generate_from _),
+    exact ⟨m, hI hm, (hf m hm).symm⟩, },
+  { rintro _ ⟨k, hk, rfl⟩,
+    refine ⟨{k}, λ m hm, _, s, λ i hi, _, _⟩,
+    { rw [finset.mem_coe, finset.mem_singleton] at hm,
+      rwa hm, },
+    { exact set.mem_singleton _, },
+    { simp only [finset.mem_singleton, set.Inter_Inter_eq_left], }, },
+end
+
+/-- If `π` is a family of π-systems, then `pi_Union_Inter π S` is a π-system. -/
+lemma is_pi_system_pi_Union_Inter (π : ι → set (set α))
+  (hpi : ∀ x, is_pi_system (π x)) (S : set ι) :
+  is_pi_system (pi_Union_Inter π S) :=
+begin
+  rintros t1 ⟨p1, hp1S, f1, hf1m, ht1_eq⟩ t2 ⟨p2, hp2S, f2, hf2m, ht2_eq⟩ h_nonempty,
+  simp_rw [pi_Union_Inter, set.mem_set_of_eq],
+  let g := λ n, (ite (n ∈ p1) (f1 n) set.univ) ∩ (ite (n ∈ p2) (f2 n) set.univ),
+  have hp_union_ss : ↑(p1 ∪ p2) ⊆ S,
+  { simp only [hp1S, hp2S, finset.coe_union, union_subset_iff, and_self], },
+  use [p1 ∪ p2, hp_union_ss, g],
+  have h_inter_eq : t1 ∩ t2 = ⋂ i ∈ p1 ∪ p2, g i,
+  { rw [ht1_eq, ht2_eq],
+    simp_rw [← set.inf_eq_inter, g],
+    ext1 x,
+    simp only [inf_eq_inter, mem_inter_iff, mem_Inter, finset.mem_union],
+    refine ⟨λ h i hi_mem_union, _, λ h, ⟨λ i hi1, _, λ i hi2, _⟩⟩,
+    { split_ifs,
+      exacts [⟨h.1 i h_1, h.2 i h_2⟩, ⟨h.1 i h_1, set.mem_univ _⟩,
+        ⟨set.mem_univ _, h.2 i h_2⟩, ⟨set.mem_univ _, set.mem_univ _⟩], },
+    { specialize h i (or.inl hi1),
+      rw if_pos hi1 at h,
+      exact h.1, },
+    { specialize h i (or.inr hi2),
+      rw if_pos hi2 at h,
+      exact h.2, }, },
+  refine ⟨λ n hn, _, h_inter_eq⟩,
+  simp_rw g,
+  split_ifs with hn1 hn2,
+  { refine hpi n (f1 n) (hf1m n hn1) (f2 n) (hf2m n hn2) (set.nonempty_iff_ne_empty.2 (λ h, _)),
+    rw h_inter_eq at h_nonempty,
+    suffices h_empty : (⋂ i ∈ p1 ∪ p2, g i) = ∅,
+      from (set.not_nonempty_iff_eq_empty.mpr h_empty) h_nonempty,
+    refine le_antisymm (set.Inter_subset_of_subset n _) (set.empty_subset _),
+    refine set.Inter_subset_of_subset hn _,
+    simp_rw [g, if_pos hn1, if_pos hn2],
+    exact h.subset, },
+  { simp [hf1m n hn1], },
+  { simp [hf2m n h], },
+  { exact absurd hn (by simp [hn1, h]), },
+end
+
+lemma pi_Union_Inter_mono_left {π π' : ι → set (set α)} (h_le : ∀ i, π i ⊆ π' i) (S : set ι) :
+  pi_Union_Inter π S ⊆ pi_Union_Inter π' S :=
+λ s ⟨t, ht_mem, ft, hft_mem_pi, h_eq⟩, ⟨t, ht_mem, ft, λ x hxt, h_le x (hft_mem_pi x hxt), h_eq⟩
+
+lemma pi_Union_Inter_mono_right {π : ι → set (set α)} {S T : set ι} (hST : S ⊆ T) :
+  pi_Union_Inter π S ⊆ pi_Union_Inter π T :=
+λ s ⟨t, ht_mem, ft, hft_mem_pi, h_eq⟩, ⟨t, ht_mem.trans hST, ft, hft_mem_pi, h_eq⟩
+
+lemma generate_from_pi_Union_Inter_le {m : measurable_space α}
+  (π : ι → set (set α)) (h : ∀ n, generate_from (π n) ≤ m) (S : set ι) :
+  generate_from (pi_Union_Inter π S) ≤ m :=
+begin
+  refine generate_from_le _,
+  rintros t ⟨ht_p, ht_p_mem, ft, hft_mem_pi, rfl⟩,
+  refine finset.measurable_set_bInter _ (λ x hx_mem, (h x) _ _),
+  exact measurable_set_generate_from (hft_mem_pi x hx_mem),
+end
+
+lemma subset_pi_Union_Inter {π : ι → set (set α)} {S : set ι} {i : ι} (his : i ∈ S) :
+  π i ⊆ pi_Union_Inter π S :=
+begin
+  have h_ss : {i} ⊆ S,
+  { intros j hj, rw mem_singleton_iff at hj, rwa hj, },
+  refine subset.trans _ (pi_Union_Inter_mono_right h_ss),
+  rw pi_Union_Inter_singleton,
+  exact subset_union_left _ _,
+end
+
+lemma mem_pi_Union_Inter_of_measurable_set (m : ι → measurable_space α)
+  {S : set ι} {i : ι} (hiS : i ∈ S) (s : set α)
+  (hs : measurable_set[m i] s) :
+  s ∈ pi_Union_Inter (λ n, {s | measurable_set[m n] s}) S :=
+subset_pi_Union_Inter hiS hs
+
+lemma le_generate_from_pi_Union_Inter {π : ι → set (set α)} (S : set ι) {x : ι} (hxS : x ∈ S) :
+  generate_from (π x) ≤ generate_from (pi_Union_Inter π S) :=
+generate_from_mono (subset_pi_Union_Inter hxS)
+
+lemma measurable_set_supr_of_mem_pi_Union_Inter (m : ι → measurable_space α)
+  (S : set ι) (t : set α) (ht : t ∈ pi_Union_Inter (λ n, {s | measurable_set[m n] s}) S) :
+  measurable_set[⨆ i ∈ S, m i] t :=
+begin
+  rcases ht with ⟨pt, hpt, ft, ht_m, rfl⟩,
+  refine pt.measurable_set_bInter (λ i hi, _),
+  suffices h_le : m i ≤ (⨆ i ∈ S, m i), from h_le (ft i) (ht_m i hi),
+  have hi' : i ∈ S := hpt hi,
+  exact le_supr₂ i hi',
+end
+
+lemma generate_from_pi_Union_Inter_measurable_set (m : ι → measurable_space α) (S : set ι) :
+  generate_from (pi_Union_Inter (λ n, {s | measurable_set[m n] s}) S) = ⨆ i ∈ S, m i :=
+begin
+  refine le_antisymm _ _,
+  { rw ← @generate_from_measurable_set α (⨆ i ∈ S, m i),
+    exact generate_from_mono (measurable_set_supr_of_mem_pi_Union_Inter m S), },
+  { refine supr₂_le (λ i hi, _),
+    rw ← @generate_from_measurable_set α (m i),
+    exact generate_from_mono (mem_pi_Union_Inter_of_measurable_set m hi), },
+end
+
+end Union_Inter
+
 namespace measurable_space
 variable {α : Type*}
 
+/-! ## Dynkin systems and Π-λ theorem -/
+
 /-- A Dynkin system is a collection of subsets of a type `α` that contains the empty set,
   is closed under complementation and under countable union of pairwise disjoint sets.
   The disjointness condition is the only difference with `σ`-algebras.
@@ -300,14 +537,14 @@ lemma has_compl_iff {a} : d.has aᶜ ↔ d.has a :=
 lemma has_univ : d.has univ :=
 by simpa using d.has_compl d.has_empty
 
-theorem has_Union {β} [encodable β] {f : β → set α}
-  (hd : pairwise (disjoint on f)) (h : ∀ i, d.has (f i)) : d.has (⋃ i, f i) :=
-by { rw ← encodable.Union_decode₂, exact
+lemma has_Union {β} [countable β] {f : β → set α} (hd : pairwise (disjoint on f))
+  (h : ∀ i, d.has (f i)) : d.has (⋃ i, f i) :=
+by { casesI nonempty_encodable β, rw ← encodable.Union_decode₂, exact
   d.has_Union_nat (encodable.Union_decode₂_disjoint_on hd)
     (λ n, encodable.Union_decode₂_cases d.has_empty h) }
 
 theorem has_union {s₁ s₂ : set α}
-  (h₁ : d.has s₁) (h₂ : d.has s₂) (h : s₁ ∩ s₂ ⊆ ∅) : d.has (s₁ ∪ s₂) :=
+  (h₁ : d.has s₁) (h₂ : d.has s₂) (h : disjoint s₁ s₂) : d.has (s₁ ∪ s₂) :=
 by { rw union_eq_Union, exact
   d.has_Union (pairwise_disjoint_on_bool.2 h) (bool.forall_bool.2 ⟨h₂, h₁⟩) }
 
@@ -315,7 +552,7 @@ lemma has_diff {s₁ s₂ : set α} (h₁ : d.has s₁) (h₂ : d.has s₂) (h :
 begin
   apply d.has_compl_iff.1,
   simp [diff_eq, compl_inter],
-  exact d.has_union (d.has_compl h₁) h₂ (λ x ⟨h₁, h₂⟩, h₁ (h h₂)),
+  exact d.has_union (d.has_compl h₁) h₂ (disjoint_compl_left.mono_right h),
 end
 
 instance : has_le (dynkin_system α) :=
@@ -392,10 +629,10 @@ def restrict_on {s : set α} (h : d.has s) : dynkin_system α :=
       (compl_subset_compl.mpr $ inter_subset_right _ _) },
   has_Union_nat := assume f hd hf,
     begin
-      rw [inter_comm, inter_Union],
-      apply d.has_Union_nat,
-      { exact λ i j h x ⟨⟨_, h₁⟩, _, h₂⟩, hd i j h ⟨h₁, h₂⟩ },
-      { simpa [inter_comm] using hf },
+      rw [Union_inter],
+      refine d.has_Union_nat _ hf,
+      exact hd.mono (λ i j,
+        disjoint.mono (inter_subset_left _ _) (inter_subset_left _ _)),
     end }
 
 lemma generate_le {s : set (set α)} (h : ∀ t ∈ s, d.has t) : generate s ≤ d :=
@@ -404,7 +641,7 @@ lemma generate_le {s : set (set α)} (h : ∀ t ∈ s, d.has t) : generate s ≤
   (assume f hd _ hf, d.has_Union hd hf)
 
 lemma generate_has_subset_generate_measurable {C : set (set α)} {s : set α}
-  (hs : (generate C).has s) : (generate_from C).measurable_set' s :=
+  (hs : (generate C).has s) : measurable_set[generate_from C] s :=
 generate_le (of_measurable_space (generate_from C)) (λ t, measurable_set_generate_from) s hs
 
 lemma generate_inter {s : set (set α)}
diff --git a/src/measure_theory/probability_mass_function/basic.lean b/src/measure_theory/probability_mass_function/basic.lean
deleted file mode 100644
index b772140c53cea..0000000000000
--- a/src/measure_theory/probability_mass_function/basic.lean
+++ /dev/null
@@ -1,215 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Devon Tuma
--/
-import topology.instances.ennreal
-import measure_theory.measure.measure_space
-
-/-!
-# Probability mass functions
-
-This file is about probability mass functions or discrete probability measures:
-a function `α → ℝ≥0` such that the values have (infinite) sum `1`.
-
-Construction of monadic `pure` and `bind` is found in `probability_mass_function/monad.lean`,
-other constructions of `pmf`s are found in `probability_mass_function/constructions.lean`.
-
-Given `p : pmf α`, `pmf.to_outer_measure` constructs an `outer_measure` on `α`,
-by assigning each set the sum of the probabilities of each of its elements.
-Under this outer measure, every set is Carathéodory-measurable,
-so we can further extend this to a `measure` on `α`, see `pmf.to_measure`.
-`pmf.to_measure.is_probability_measure` shows this associated measure is a probability measure.
-
-## Tags
-
-probability mass function, discrete probability measure
--/
-noncomputable theory
-variables {α : Type*} {β : Type*} {γ : Type*}
-open_locale classical big_operators nnreal ennreal
-
-/-- A probability mass function, or discrete probability measures is a function `α → ℝ≥0` such that
-  the values have (infinite) sum `1`. -/
-def {u} pmf (α : Type u) : Type u := { f : α → ℝ≥0 // has_sum f 1 }
-
-namespace pmf
-
-instance : has_coe_to_fun (pmf α) (λ p, α → ℝ≥0) := ⟨λ p a, p.1 a⟩
-
-@[ext] protected lemma ext : ∀ {p q : pmf α}, (∀ a, p a = q a) → p = q
-| ⟨f, hf⟩ ⟨g, hg⟩ eq :=  subtype.eq $ funext eq
-
-lemma has_sum_coe_one (p : pmf α) : has_sum p 1 := p.2
-
-lemma summable_coe (p : pmf α) : summable p := (p.has_sum_coe_one).summable
-
-@[simp] lemma tsum_coe (p : pmf α) : ∑' a, p a = 1 := p.has_sum_coe_one.tsum_eq
-
-/-- The support of a `pmf` is the set where it is nonzero. -/
-def support (p : pmf α) : set α := function.support p
-
-@[simp] lemma mem_support_iff (p : pmf α) (a : α) : a ∈ p.support ↔ p a ≠ 0 := iff.rfl
-
-lemma apply_eq_zero_iff (p : pmf α) (a : α) : p a = 0 ↔ a ∉ p.support :=
-by rw [mem_support_iff, not_not]
-
-lemma coe_le_one (p : pmf α) (a : α) : p a ≤ 1 :=
-has_sum_le (by { intro b, split_ifs; simp only [h, zero_le'] })
-  (has_sum_ite_eq a (p a)) (has_sum_coe_one p)
-
-section outer_measure
-
-open measure_theory measure_theory.outer_measure
-
-/-- Construct an `outer_measure` from a `pmf`, by assigning measure to each set `s : set α` equal
-  to the sum of `p x` for for each `x ∈ α` -/
-def to_outer_measure (p : pmf α) : outer_measure α :=
-outer_measure.sum (λ (x : α), p x • dirac x)
-
-variables (p : pmf α) (s t : set α)
-
-lemma to_outer_measure_apply : p.to_outer_measure s = ∑' x, s.indicator (coe ∘ p) x :=
-tsum_congr (λ x, smul_dirac_apply (p x) x s)
-
-lemma to_outer_measure_apply' : p.to_outer_measure s = ↑(∑' (x : α), s.indicator p x) :=
-by simp only [ennreal.coe_tsum (nnreal.indicator_summable (summable_coe p) s),
-  ennreal.coe_indicator, to_outer_measure_apply]
-
-@[simp]
-lemma to_outer_measure_apply_finset (s : finset α) : p.to_outer_measure s = ∑ x in s, ↑(p x) :=
-begin
-  refine (to_outer_measure_apply p s).trans ((@tsum_eq_sum _ _ _ _ _ _ s _).trans _),
-  { exact λ x hx, set.indicator_of_not_mem hx _ },
-  { exact finset.sum_congr rfl (λ x hx, set.indicator_of_mem hx _) }
-end
-
-lemma to_outer_measure_apply_eq_zero_iff : p.to_outer_measure s = 0 ↔ disjoint p.support s :=
-begin
-  rw [to_outer_measure_apply', ennreal.coe_eq_zero,
-    tsum_eq_zero_iff (nnreal.indicator_summable (summable_coe p) s)],
-  exact function.funext_iff.symm.trans set.indicator_eq_zero',
-end
-
-lemma to_outer_measure_apply_eq_one_iff : p.to_outer_measure s = 1 ↔ p.support ⊆ s :=
-begin
-  rw [to_outer_measure_apply', ennreal.coe_eq_one],
-  refine ⟨λ h a ha, _, λ h, _⟩,
-  { have hsp : ∀ x, s.indicator p x ≤ p x := λ _, set.indicator_apply_le (λ _, le_rfl),
-    have := λ hpa, ne_of_lt (nnreal.tsum_lt_tsum hsp hpa p.summable_coe) (h.trans p.tsum_coe.symm),
-    exact not_not.1 (λ has, ha $ set.indicator_apply_eq_self.1 (le_antisymm
-      (set.indicator_apply_le $ λ _, le_rfl) $ le_of_not_lt $ this) has) },
-  { suffices : ∀ x, x ∉ s → p x = 0,
-    from trans (tsum_congr $ λ a, (set.indicator_apply s p a).trans
-      (ite_eq_left_iff.2 $ symm ∘ (this a))) p.tsum_coe,
-    exact λ a ha, (p.apply_eq_zero_iff a).2 $ set.not_mem_subset h ha }
-end
-
-@[simp]
-lemma to_outer_measure_apply_inter_support :
-  p.to_outer_measure (s ∩ p.support) = p.to_outer_measure s :=
-by simp only [to_outer_measure_apply', ennreal.coe_eq_coe,
-  pmf.support, set.indicator_inter_support]
-
-/-- Slightly stronger than `outer_measure.mono` having an intersection with `p.support` -/
-lemma to_outer_measure_mono {s t : set α} (h : s ∩ p.support ⊆ t) :
-  p.to_outer_measure s ≤ p.to_outer_measure t :=
-le_trans (le_of_eq (to_outer_measure_apply_inter_support p s).symm) (p.to_outer_measure.mono h)
-
-lemma to_outer_measure_apply_eq_of_inter_support_eq {s t : set α}
-  (h : s ∩ p.support = t ∩ p.support) : p.to_outer_measure s = p.to_outer_measure t :=
-le_antisymm (p.to_outer_measure_mono (h.symm ▸ (set.inter_subset_left t p.support)))
-  (p.to_outer_measure_mono (h ▸ (set.inter_subset_left s p.support)))
-
-@[simp]
-lemma to_outer_measure_apply_fintype [fintype α] :
-  p.to_outer_measure s = ↑(∑ x, (s.indicator p x)) :=
-(p.to_outer_measure_apply' s).trans
-  (ennreal.coe_eq_coe.2 $ tsum_eq_sum (λ x h, absurd (finset.mem_univ x) h))
-
-@[simp]
-lemma to_outer_measure_caratheodory (p : pmf α) :
-  (to_outer_measure p).caratheodory = ⊤ :=
-begin
-  refine (eq_top_iff.2 $ le_trans (le_Inf $ λ x hx, _) (le_sum_caratheodory _)),
-  obtain ⟨y, hy⟩ := hx,
-  exact ((le_of_eq (dirac_caratheodory y).symm).trans
-    (le_smul_caratheodory _ _)).trans (le_of_eq hy),
-end
-
-end outer_measure
-
-section measure
-
-open measure_theory
-
-/-- Since every set is Carathéodory-measurable under `pmf.to_outer_measure`,
-  we can further extend this `outer_measure` to a `measure` on `α` -/
-def to_measure [measurable_space α] (p : pmf α) : measure α :=
-p.to_outer_measure.to_measure ((to_outer_measure_caratheodory p).symm ▸ le_top)
-
-variables [measurable_space α] (p : pmf α) (s t : set α)
-
-lemma to_outer_measure_apply_le_to_measure_apply : p.to_outer_measure s ≤ p.to_measure s :=
-le_to_measure_apply p.to_outer_measure _ s
-
-lemma to_measure_apply_eq_to_outer_measure_apply (hs : measurable_set s) :
-  p.to_measure s = p.to_outer_measure s :=
-to_measure_apply p.to_outer_measure _ hs
-
-lemma to_measure_apply (hs : measurable_set s) : p.to_measure s = ∑' x, s.indicator (coe ∘ p) x :=
-(p.to_measure_apply_eq_to_outer_measure_apply s hs).trans (p.to_outer_measure_apply s)
-
-lemma to_measure_apply' (hs : measurable_set s) : p.to_measure s = ↑(∑' x, s.indicator p x) :=
-(p.to_measure_apply_eq_to_outer_measure_apply s hs).trans (p.to_outer_measure_apply' s)
-
-lemma to_measure_apply_eq_one_iff (hs : measurable_set s) : p.to_measure s = 1 ↔ p.support ⊆ s :=
-(p.to_measure_apply_eq_to_outer_measure_apply s hs : p.to_measure s = p.to_outer_measure s).symm
-  ▸ (p.to_outer_measure_apply_eq_one_iff s)
-
-@[simp]
-lemma to_measure_apply_inter_support (hs : measurable_set s) (hp : measurable_set p.support) :
-  p.to_measure (s ∩ p.support) = p.to_measure s :=
-by simp [p.to_measure_apply_eq_to_outer_measure_apply s hs,
-  p.to_measure_apply_eq_to_outer_measure_apply _ (hs.inter hp)]
-
-lemma to_measure_mono {s t : set α} (hs : measurable_set s) (ht : measurable_set t)
-  (h : s ∩ p.support ⊆ t) : p.to_measure s ≤ p.to_measure t :=
-by simpa only [p.to_measure_apply_eq_to_outer_measure_apply, hs, ht]
-  using to_outer_measure_mono p h
-
-lemma to_measure_apply_eq_of_inter_support_eq {s t : set α} (hs : measurable_set s)
-  (ht : measurable_set t) (h : s ∩ p.support = t ∩ p.support) : p.to_measure s = p.to_measure t :=
-by simpa only [p.to_measure_apply_eq_to_outer_measure_apply, hs, ht]
-  using to_outer_measure_apply_eq_of_inter_support_eq p h
-
-section measurable_singleton_class
-
-variables [measurable_singleton_class α]
-
-@[simp]
-lemma to_measure_apply_finset (s : finset α) : p.to_measure s = ∑ x in s, (p x : ℝ≥0∞) :=
-(p.to_measure_apply_eq_to_outer_measure_apply s s.measurable_set).trans
-  (p.to_outer_measure_apply_finset s)
-
-lemma to_measure_apply_of_finite (hs : s.finite) :
-  p.to_measure s = ↑(∑' x, s.indicator p x) :=
-(p.to_measure_apply_eq_to_outer_measure_apply s hs.measurable_set).trans
-  (p.to_outer_measure_apply' s)
-
-@[simp]
-lemma to_measure_apply_fintype [fintype α] :
-  p.to_measure s = ↑(∑ x, s.indicator p x) :=
-(p.to_measure_apply_eq_to_outer_measure_apply s (set.finite.of_fintype s).measurable_set).trans
-  (p.to_outer_measure_apply_fintype s)
-
-end measurable_singleton_class
-
-/-- The measure associated to a `pmf` by `to_measure` is a probability measure -/
-instance to_measure.is_probability_measure (p : pmf α) : is_probability_measure (p.to_measure) :=
-⟨by simpa only [measurable_set.univ, to_measure_apply_eq_to_outer_measure_apply, set.indicator_univ,
-  to_outer_measure_apply', ennreal.coe_eq_one] using tsum_coe p⟩
-
-end measure
-
-end pmf
diff --git a/src/measure_theory/probability_mass_function/constructions.lean b/src/measure_theory/probability_mass_function/constructions.lean
deleted file mode 100644
index 2591ecc36ebf1..0000000000000
--- a/src/measure_theory/probability_mass_function/constructions.lean
+++ /dev/null
@@ -1,398 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Devon Tuma
--/
-import measure_theory.probability_mass_function.monad
-
-/-!
-# Specific Constructions of Probability Mass Functions
-
-This file gives a number of different `pmf` constructions for common probability distributions.
-
-`map` and `seq` allow pushing a `pmf α` along a function `f : α → β` (or distribution of
-functions `f : pmf (α → β)`) to get a `pmf β`
-
-`of_finset` and `of_fintype` simplify the construction of a `pmf α` from a function `f : α → ℝ≥0`,
-by allowing the "sum equals 1" constraint to be in terms of `finset.sum` instead of `tsum`.
-`of_multiset`, `uniform_of_finset`, and `uniform_of_fintype` construct probability mass functions
-from the corresponding object, with proportional weighting for each element of the object.
-
-`normalize` constructs a `pmf α` by normalizing a function `f : α → ℝ≥0` by its sum,
-and `filter` uses this to filter the support of a `pmf` and re-normalize the new distribution.
-
-`bernoulli` represents the bernoulli distribution on `bool`
-
--/
-
-namespace pmf
-
-noncomputable theory
-variables {α : Type*} {β : Type*} {γ : Type*}
-open_locale classical big_operators nnreal ennreal
-
-section map
-
-/-- The functorial action of a function on a `pmf`. -/
-def map (f : α → β) (p : pmf α) : pmf β := bind p (pure ∘ f)
-
-variables (f : α → β) (p : pmf α) (b : β)
-
-@[simp] lemma map_apply : (map f p) b = ∑' a, if b = f a then p a else 0 := by simp [map]
-
-@[simp] lemma support_map : (map f p).support = f '' p.support :=
-set.ext (λ b, by simp [map, @eq_comm β b])
-
-lemma mem_support_map_iff : b ∈ (map f p).support ↔ ∃ a ∈ p.support, f a = b := by simp
-
-lemma bind_pure_comp : bind p (pure ∘ f) = map f p := rfl
-
-lemma map_id : map id p = p := by simp [map]
-
-lemma map_comp (g : β → γ) : (p.map f).map g = p.map (g ∘ f) :=
-by simp [map]
-
-lemma pure_map (a : α) : (pure a).map f = pure (f a) :=
-by simp [map]
-
-section measure
-
-variable (s : set β)
-
-@[simp] lemma to_outer_measure_map_apply :
-  (p.map f).to_outer_measure s = p.to_outer_measure (f ⁻¹' s) :=
-by simp [map, set.indicator, to_outer_measure_apply p (f ⁻¹' s)]
-
-@[simp] lemma to_measure_map_apply [measurable_space α] [measurable_space β] (hf : measurable f)
-  (hs : measurable_set s) : (p.map f).to_measure s = p.to_measure (f ⁻¹' s) :=
-begin
-  rw [to_measure_apply_eq_to_outer_measure_apply _ s hs,
-    to_measure_apply_eq_to_outer_measure_apply _ (f ⁻¹' s) (measurable_set_preimage hf hs)],
-  exact to_outer_measure_map_apply f p s,
-end
-
-end measure
-
-end map
-
-section seq
-
-/-- The monadic sequencing operation for `pmf`. -/
-def seq (q : pmf (α → β)) (p : pmf α) : pmf β := q.bind (λ m, p.bind $ λ a, pure (m a))
-
-variables (q : pmf (α → β)) (p : pmf α) (b : β)
-
-@[simp] lemma seq_apply : (seq q p) b = ∑' (f : α → β) (a : α), if b = f a then q f * p a else 0 :=
-begin
-  simp only [seq, mul_boole, bind_apply, pure_apply],
-  refine tsum_congr (λ f, (nnreal.tsum_mul_left (q f) _).symm.trans (tsum_congr (λ a, _))),
-  simpa only [mul_zero] using mul_ite (b = f a) (q f) (p a) 0
-end
-
-@[simp] lemma support_seq : (seq q p).support = ⋃ f ∈ q.support, f '' p.support :=
-set.ext (λ b, by simp [-mem_support_iff, seq, @eq_comm β b])
-
-lemma mem_support_seq_iff : b ∈ (seq q p).support ↔ ∃ (f ∈ q.support), b ∈ f '' p.support :=
-by simp
-
-end seq
-
-section of_finset
-
-/-- Given a finset `s` and a function `f : α → ℝ≥0` with sum `1` on `s`,
-  such that `f a = 0` for `a ∉ s`, we get a `pmf` -/
-def of_finset (f : α → ℝ≥0) (s : finset α) (h : ∑ a in s, f a = 1)
-  (h' : ∀ a ∉ s, f a = 0) : pmf α :=
-⟨f, h ▸ has_sum_sum_of_ne_finset_zero h'⟩
-
-variables {f : α → ℝ≥0} {s : finset α} (h : ∑ a in s, f a = 1) (h' : ∀ a ∉ s, f a = 0)
-
-@[simp] lemma of_finset_apply (a : α) : of_finset f s h h' a = f a := rfl
-
-@[simp] lemma support_of_finset : (of_finset f s h h').support = s ∩ (function.support f) :=
-set.ext (λ a, by simpa [mem_support_iff] using mt (h' a))
-
-lemma mem_support_of_finset_iff (a : α) : a ∈ (of_finset f s h h').support ↔ a ∈ s ∧ f a ≠ 0 :=
-by simp
-
-lemma of_finset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_finset f s h h' a = 0 :=
-h' a ha
-
-section measure
-
-variable (t : set α)
-
-@[simp] lemma to_outer_measure_of_finset_apply :
-  (of_finset f s h h').to_outer_measure t = ↑(∑' x, t.indicator f x) :=
-to_outer_measure_apply' (of_finset f s h h') t
-
-@[simp] lemma to_measure_of_finset_apply [measurable_space α] (ht : measurable_set t) :
-  (of_finset f s h h').to_measure t = ↑(∑' x, t.indicator f x) :=
-(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
-  (to_outer_measure_of_finset_apply h h' t)
-
-end measure
-
-end of_finset
-
-section of_fintype
-
-/-- Given a finite type `α` and a function `f : α → ℝ≥0` with sum 1, we get a `pmf`. -/
-def of_fintype [fintype α] (f : α → ℝ≥0) (h : ∑ a, f a = 1) : pmf α :=
-of_finset f finset.univ h (λ a ha, absurd (finset.mem_univ a) ha)
-
-variables [fintype α] {f : α → ℝ≥0} (h : ∑ a, f a = 1)
-
-@[simp] lemma of_fintype_apply (a : α) : of_fintype f h a = f a := rfl
-
-@[simp] lemma support_of_fintype : (of_fintype f h).support = function.support f := rfl
-
-lemma mem_support_of_fintype_iff (a : α) : a ∈ (of_fintype f h).support ↔ f a ≠ 0 := iff.rfl
-
-section measure
-
-variable (s : set α)
-
-@[simp] lemma to_outer_measure_of_fintype_apply :
-  (of_fintype f h).to_outer_measure s = ↑(∑' x, s.indicator f x) :=
-to_outer_measure_apply' (of_fintype f h) s
-
-@[simp] lemma to_measure_of_fintype_apply [measurable_space α] (hs : measurable_set s) :
-  (of_fintype f h).to_measure s = ↑(∑' x, s.indicator f x) :=
-(to_measure_apply_eq_to_outer_measure_apply _ s hs).trans
-  (to_outer_measure_of_fintype_apply h s)
-
-end measure
-
-end of_fintype
-
-section of_multiset
-
-/-- Given a non-empty multiset `s` we construct the `pmf` which sends `a` to the fraction of
-  elements in `s` that are `a`. -/
-def of_multiset (s : multiset α) (hs : s ≠ 0) : pmf α :=
-⟨λ a, s.count a / s.card,
-  have ∑ a in s.to_finset, (s.count a : ℝ) / s.card = 1,
-    by simp [div_eq_inv_mul, finset.mul_sum.symm, (nat.cast_sum _ _).symm, hs],
-  have ∑ a in s.to_finset, (s.count a : ℝ≥0) / s.card = 1,
-    by rw [← nnreal.eq_iff, nnreal.coe_one, ← this, nnreal.coe_sum]; simp,
-  begin
-    rw ← this,
-    apply has_sum_sum_of_ne_finset_zero,
-    simp {contextual := tt},
-  end⟩
-
-variables {s : multiset α} (hs : s ≠ 0)
-
-@[simp] lemma of_multiset_apply (a : α) : of_multiset s hs a = s.count a / s.card := rfl
-
-@[simp] lemma support_of_multiset : (of_multiset s hs).support = s.to_finset :=
-set.ext (by simp [mem_support_iff, hs])
-
-lemma mem_support_of_multiset_iff (a : α) : a ∈ (of_multiset s hs).support ↔ a ∈ s.to_finset :=
-by simp
-
-lemma of_multiset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_multiset s hs a = 0 :=
-div_eq_zero_iff.2 (or.inl $ nat.cast_eq_zero.2 $ multiset.count_eq_zero_of_not_mem ha)
-
-section measure
-
-variable (t : set α)
-
-@[simp] lemma to_outer_measure_of_multiset_apply :
-  (of_multiset s hs).to_outer_measure t = (∑' x, (s.filter (∈ t)).count x) / s.card :=
-begin
-  rw [div_eq_mul_inv, ← ennreal.tsum_mul_right, to_outer_measure_apply],
-  refine tsum_congr (λ x, _),
-  by_cases hx : x ∈ t,
-  { have : (multiset.card s : ℝ≥0) ≠ 0 := by simp [hs],
-    simp [set.indicator, hx, div_eq_mul_inv, ennreal.coe_inv this] },
-  { simp [hx] }
-end
-
-@[simp] lemma to_measure_of_multiset_apply [measurable_space α] (ht : measurable_set t) :
-  (of_multiset s hs).to_measure t = (∑' x, (s.filter (∈ t)).count x) / s.card :=
-(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
-  (to_outer_measure_of_multiset_apply hs t)
-
-end measure
-
-end of_multiset
-
-section uniform
-
-section uniform_of_finset
-
-/-- Uniform distribution taking the same non-zero probability on the nonempty finset `s` -/
-def uniform_of_finset (s : finset α) (hs : s.nonempty) : pmf α :=
-of_finset (λ a, if a ∈ s then (s.card : ℝ≥0)⁻¹ else 0) s (Exists.rec_on hs (λ x hx,
-  calc ∑ (a : α) in s, ite (a ∈ s) (s.card : ℝ≥0)⁻¹ 0
-    = ∑ (a : α) in s, (s.card : ℝ≥0)⁻¹ : finset.sum_congr rfl (λ x hx, by simp [hx])
-    ... = s.card • (s.card : ℝ≥0)⁻¹ : finset.sum_const _
-    ... = (s.card : ℝ≥0) * (s.card : ℝ≥0)⁻¹ : by rw nsmul_eq_mul
-    ... = 1 : div_self (nat.cast_ne_zero.2 $ finset.card_ne_zero_of_mem hx)
-  )) (λ x hx, by simp only [hx, if_false])
-
-variables {s : finset α} (hs : s.nonempty) {a : α}
-
-@[simp] lemma uniform_of_finset_apply (a : α) :
-  uniform_of_finset s hs a = if a ∈ s then (s.card : ℝ≥0)⁻¹ else 0 := rfl
-
-lemma uniform_of_finset_apply_of_mem (ha : a ∈ s) : uniform_of_finset s hs a = (s.card)⁻¹ :=
-by simp [ha]
-
-lemma uniform_of_finset_apply_of_not_mem (ha : a ∉ s) : uniform_of_finset s hs a = 0 :=
-by simp [ha]
-
-@[simp] lemma support_uniform_of_finset : (uniform_of_finset s hs).support = s :=
-set.ext (let ⟨a, ha⟩ := hs in by simp [mem_support_iff, finset.ne_empty_of_mem ha])
-
-lemma mem_support_uniform_of_finset_iff (a : α) : a ∈ (uniform_of_finset s hs).support ↔ a ∈ s :=
-by simp
-
-section measure
-
-variable (t : set α)
-
-@[simp] lemma to_outer_measure_uniform_of_finset_apply :
-  (uniform_of_finset s hs).to_outer_measure t = (s.filter (∈ t)).card / s.card :=
-calc (uniform_of_finset s hs).to_outer_measure t
-  = ↑(∑' x, if x ∈ t then (uniform_of_finset s hs x) else 0) :
-    to_outer_measure_apply' (uniform_of_finset s hs) t
-  ... = ↑(∑' x, if x ∈ s ∧ x ∈ t then (s.card : ℝ≥0)⁻¹ else 0) :
-    begin
-      refine (ennreal.coe_eq_coe.2 $ tsum_congr (λ x, _)),
-      by_cases hxt : x ∈ t,
-      { by_cases hxs : x ∈ s; simp [hxt, hxs] },
-      { simp [hxt] }
-    end
-  ... = ↑(∑ x in (s.filter (∈ t)), if x ∈ s ∧ x ∈ t then (s.card : ℝ≥0)⁻¹ else 0) :
-    begin
-      refine ennreal.coe_eq_coe.2 (tsum_eq_sum (λ x hx, _)),
-      have : ¬ (x ∈ s ∧ x ∈ t) := λ h, hx (finset.mem_filter.2 h),
-      simp [this]
-    end
-  ... = ↑(∑ x in (s.filter (∈ t)), (s.card : ℝ≥0)⁻¹) :
-    ennreal.coe_eq_coe.2 (finset.sum_congr rfl $
-      λ x hx, let this : x ∈ s ∧ x ∈ t := by simpa using hx in by simp [this])
-  ... = (s.filter (∈ t)).card / s.card :
-    let this : (s.card : ℝ≥0) ≠ 0 := nat.cast_ne_zero.2
-      (hs.rec_on $ λ _, finset.card_ne_zero_of_mem) in
-    by simp [div_eq_mul_inv, ennreal.coe_inv this]
-
-@[simp] lemma to_measure_uniform_of_finset_apply [measurable_space α] (ht : measurable_set t) :
-  (uniform_of_finset s hs).to_measure t = (s.filter (∈ t)).card / s.card :=
-(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
-  (to_outer_measure_uniform_of_finset_apply hs t)
-
-end measure
-
-end uniform_of_finset
-
-section uniform_of_fintype
-
-/-- The uniform pmf taking the same uniform value on all of the fintype `α` -/
-def uniform_of_fintype (α : Type*) [fintype α] [nonempty α] : pmf α :=
-  uniform_of_finset (finset.univ) (finset.univ_nonempty)
-
-variables [fintype α] [nonempty α]
-
-@[simp] lemma uniform_of_fintype_apply (a : α) : uniform_of_fintype α a = (fintype.card α)⁻¹ :=
-by simpa only [uniform_of_fintype, finset.mem_univ, if_true, uniform_of_finset_apply]
-
-@[simp] lemma support_uniform_of_fintype (α : Type*) [fintype α] [nonempty α] :
-  (uniform_of_fintype α).support = ⊤ :=
-set.ext (λ x, by simpa [mem_support_iff] using fintype.card_ne_zero)
-
-lemma mem_support_uniform_of_fintype (a : α) : a ∈ (uniform_of_fintype α).support := by simp
-
-section measure
-
-variable (s : set α)
-
-lemma to_outer_measure_uniform_of_fintype_apply :
-  (uniform_of_fintype α).to_outer_measure s = fintype.card s / fintype.card α :=
-by simpa [uniform_of_fintype]
-
-lemma to_measure_uniform_of_fintype_apply [measurable_space α] (hs : measurable_set s) :
-  (uniform_of_fintype α).to_measure s = fintype.card s / fintype.card α :=
-by simpa [uniform_of_fintype, hs]
-
-end measure
-
-end uniform_of_fintype
-
-end uniform
-
-section normalize
-
-/-- Given a `f` with non-zero sum, we get a `pmf` by normalizing `f` by it's `tsum` -/
-def normalize (f : α → ℝ≥0) (hf0 : tsum f ≠ 0) : pmf α :=
-⟨λ a, f a * (∑' x, f x)⁻¹,
-  (mul_inv_cancel hf0) ▸ has_sum.mul_right (∑' x, f x)⁻¹
-    (not_not.mp (mt tsum_eq_zero_of_not_summable hf0 : ¬¬summable f)).has_sum⟩
-
-variables {f : α → ℝ≥0} (hf0 : tsum f ≠ 0)
-
-@[simp] lemma normalize_apply (a : α) : (normalize f hf0) a = f a * (∑' x, f x)⁻¹ := rfl
-
-@[simp] lemma support_normalize : (normalize f hf0).support = function.support f :=
-set.ext (by simp [mem_support_iff, hf0])
-
-lemma mem_support_normalize_iff (a : α) : a ∈ (normalize f hf0).support ↔ f a ≠ 0 := by simp
-
-end normalize
-
-section filter
-
-/-- Create new `pmf` by filtering on a set with non-zero measure and normalizing -/
-def filter (p : pmf α) (s : set α) (h : ∃ a ∈ s, a ∈ p.support) : pmf α :=
-pmf.normalize (s.indicator p) $ nnreal.tsum_indicator_ne_zero p.2.summable h
-
-variables {p : pmf α} {s : set α} (h : ∃ a ∈ s, a ∈ p.support)
-
-@[simp]
-lemma filter_apply (a : α) : (p.filter s h) a = (s.indicator p a) * (∑' a', (s.indicator p) a')⁻¹ :=
-by rw [filter, normalize_apply]
-
-lemma filter_apply_eq_zero_of_not_mem {a : α} (ha : a ∉ s) : (p.filter s h) a = 0 :=
-by rw [filter_apply, set.indicator_apply_eq_zero.mpr (λ ha', absurd ha' ha), zero_mul]
-
-lemma mem_support_filter_iff {a : α} : a ∈ (p.filter s h).support ↔ a ∈ s ∧ a ∈ p.support :=
-(mem_support_normalize_iff _ _).trans set.indicator_apply_ne_zero
-
-@[simp] lemma support_filter : (p.filter s h).support = s ∩ p.support:=
-set.ext $ λ x, (mem_support_filter_iff _)
-
-lemma filter_apply_eq_zero_iff (a : α) : (p.filter s h) a = 0 ↔ a ∉ s ∨ a ∉ p.support :=
-by erw [apply_eq_zero_iff, support_filter, set.mem_inter_iff, not_and_distrib]
-
-lemma filter_apply_ne_zero_iff (a : α) : (p.filter s h) a ≠ 0 ↔ a ∈ s ∧ a ∈ p.support :=
-by rw [ne.def, filter_apply_eq_zero_iff, not_or_distrib, not_not, not_not]
-
-end filter
-
-section bernoulli
-
-/-- A `pmf` which assigns probability `p` to `tt` and `1 - p` to `ff`. -/
-def bernoulli (p : ℝ≥0) (h : p ≤ 1) : pmf bool :=
-of_fintype (λ b, cond b p (1 - p)) (nnreal.eq $ by simp [h])
-
-variables {p : ℝ≥0} (h : p ≤ 1) (b : bool)
-
-@[simp] lemma bernoulli_apply : bernoulli p h b = cond b p (1 - p) := rfl
-
-@[simp] lemma support_bernoulli : (bernoulli p h).support = {b | cond b (p ≠ 0) (p ≠ 1)} :=
-begin
-  refine set.ext (λ b, _),
-  induction b,
-  { simp_rw [mem_support_iff, bernoulli_apply, bool.cond_ff, ne.def, tsub_eq_zero_iff_le, not_le],
-    exact ⟨ne_of_lt, lt_of_le_of_ne h⟩ },
-  { simp only [mem_support_iff, bernoulli_apply, bool.cond_tt, set.mem_set_of_eq], }
-end
-
-lemma mem_support_bernoulli_iff : b ∈ (bernoulli p h).support ↔ cond b (p ≠ 0) (p ≠ 1) := by simp
-
-end bernoulli
-
-end pmf
diff --git a/src/measure_theory/probability_mass_function/monad.lean b/src/measure_theory/probability_mass_function/monad.lean
deleted file mode 100644
index 683b1245c9090..0000000000000
--- a/src/measure_theory/probability_mass_function/monad.lean
+++ /dev/null
@@ -1,330 +0,0 @@
-/-
-Copyright (c) 2020 Devon Tuma. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Devon Tuma
--/
-import measure_theory.probability_mass_function.basic
-
-/-!
-# Monad Operations for Probability Mass Functions
-
-This file constructs two operations on `pmf` that give it a monad structure.
-`pure a` is the distribution where a single value `a` has probability `1`.
-`bind pa pb : pmf β` is the distribution given by sampling `a : α` from `pa : pmf α`,
-and then sampling from `pb a : pmf β` to get a final result `b : β`.
-
-`bind_on_support` generalizes `bind` to allow binding to a partial function,
-so that the second argument only needs to be defined on the support of the first argument.
-
--/
-
-noncomputable theory
-variables {α β γ : Type*}
-open_locale classical big_operators nnreal ennreal
-
-namespace pmf
-
-section pure
-
-/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
-  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
-def pure (a : α) : pmf α := ⟨λ a', if a' = a then 1 else 0, has_sum_ite_eq _ _⟩
-
-variables (a a' : α)
-
-@[simp] lemma pure_apply : pure a a' = (if a' = a then 1 else 0) := rfl
-
-@[simp] lemma support_pure : (pure a).support = {a} := set.ext (λ a', by simp [mem_support_iff])
-
-lemma mem_support_pure_iff: a' ∈ (pure a).support ↔ a' = a := by simp
-
-instance [inhabited α] : inhabited (pmf α) := ⟨pure default⟩
-
-section measure
-
-variable (s : set α)
-
-@[simp] lemma to_outer_measure_pure_apply : (pure a).to_outer_measure s = if a ∈ s then 1 else 0 :=
-begin
-  refine (to_outer_measure_apply' (pure a) s).trans _,
-  split_ifs with ha ha,
-  { refine ennreal.coe_eq_one.2 ((tsum_congr (λ b, _)).trans (tsum_ite_eq a 1)),
-    exact ite_eq_left_iff.2 (λ hb, symm (ite_eq_right_iff.2 (λ h, (hb $ h.symm ▸ ha).elim))) },
-  { refine ennreal.coe_eq_zero.2 ((tsum_congr (λ b, _)).trans (tsum_zero)),
-    exact ite_eq_right_iff.2 (λ hb, ite_eq_right_iff.2 (λ h, (ha $ h ▸ hb).elim)) }
-end
-
-/-- The measure of a set under `pure a` is `1` for sets containing `a` and `0` otherwise -/
-@[simp] lemma to_measure_pure_apply [measurable_space α] (hs : measurable_set s) :
-  (pure a).to_measure s = if a ∈ s then 1 else 0 :=
-(to_measure_apply_eq_to_outer_measure_apply (pure a) s hs).trans (to_outer_measure_pure_apply a s)
-
-end measure
-
-end pure
-
-section bind
-
-protected lemma bind.summable (p : pmf α) (f : α → pmf β) (b : β) :
-  summable (λ a : α, p a * f a b) :=
-begin
-  refine nnreal.summable_of_le (assume a, _) p.summable_coe,
-  suffices : p a * f a b ≤ p a * 1, { simpa },
-  exact mul_le_mul_of_nonneg_left ((f a).coe_le_one _) (p a).2
-end
-
-/-- The monadic bind operation for `pmf`. -/
-def bind (p : pmf α) (f : α → pmf β) : pmf β :=
-⟨λ b, ∑'a, p a * f a b,
-  begin
-    apply ennreal.has_sum_coe.1,
-    simp only [ennreal.coe_tsum (bind.summable p f _)],
-    rw [ennreal.summable.has_sum_iff, ennreal.tsum_comm],
-    simp [ennreal.tsum_mul_left, (ennreal.coe_tsum (f _).summable_coe).symm,
-      (ennreal.coe_tsum p.summable_coe).symm]
-  end⟩
-
-variables (p : pmf α) (f : α → pmf β) (g : β → pmf γ)
-
-@[simp] lemma bind_apply (b : β) : p.bind f b = ∑'a, p a * f a b := rfl
-
-@[simp] lemma support_bind : (p.bind f).support = {b | ∃ a ∈ p.support, b ∈ (f a).support} :=
-set.ext (λ b, by simp [mem_support_iff, tsum_eq_zero_iff (bind.summable p f b), not_or_distrib])
-
-lemma mem_support_bind_iff (b : β) : b ∈ (p.bind f).support ↔ ∃ a ∈ p.support, b ∈ (f a).support :=
-by simp
-
-lemma coe_bind_apply (b : β) : (p.bind f b : ℝ≥0∞) = ∑'a, p a * f a b :=
-eq.trans (ennreal.coe_tsum $ bind.summable p f b) $ by simp
-
-@[simp] lemma pure_bind (a : α) : (pure a).bind f = f a :=
-have ∀ b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0, from
-  assume b a', by split_ifs; simp; subst h; simp,
-by ext b; simp [this]
-
-@[simp] lemma bind_pure : p.bind pure = p :=
-have ∀ a a', (p a * ite (a' = a) 1 0) = ite (a = a') (p a') 0, from
-  assume a a', begin split_ifs; try { subst a }; try { subst a' }; simp * at * end,
-by ext b; simp [this]
-
-@[simp] lemma bind_bind : (p.bind f).bind g = p.bind (λ a, (f a).bind g) :=
-begin
-  ext1 b,
-  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.tsum_mul_left.symm,
-             ennreal.tsum_mul_right.symm],
-  rw [ennreal.tsum_comm],
-  simp [mul_assoc, mul_left_comm, mul_comm]
-end
-
-lemma bind_comm (p : pmf α) (q : pmf β) (f : α → β → pmf γ) :
-  p.bind (λ a, q.bind (f a)) = q.bind (λ b, p.bind (λ a, f a b)) :=
-begin
-  ext1 b,
-  simp only [ennreal.coe_eq_coe.symm, coe_bind_apply, ennreal.tsum_mul_left.symm,
-             ennreal.tsum_mul_right.symm],
-  rw [ennreal.tsum_comm],
-  simp [mul_assoc, mul_left_comm, mul_comm]
-end
-
-section measure
-
-variable (s : set β)
-
-@[simp] lemma to_outer_measure_bind_apply :
-  (p.bind f).to_outer_measure s = ∑' (a : α), (p a : ℝ≥0∞) * (f a).to_outer_measure s :=
-calc (p.bind f).to_outer_measure s
-  = ∑' (b : β), if b ∈ s then (↑(∑' (a : α), p a * f a b) : ℝ≥0∞) else 0 :
-    by simp [to_outer_measure_apply, set.indicator_apply]
-  ... = ∑' (b : β), ↑(∑' (a : α), p a * (if b ∈ s then f a b else 0)) :
-    tsum_congr (λ b, by split_ifs; simp)
-  ... = ∑' (b : β) (a : α), ↑(p a * (if b ∈ s then f a b else 0)) :
-    tsum_congr (λ b, ennreal.coe_tsum $
-      nnreal.summable_of_le (by split_ifs; simp) (bind.summable p f b))
-  ... = ∑' (a : α) (b : β), ↑(p a) * ↑(if b ∈ s then f a b else 0) :
-    ennreal.tsum_comm.trans (tsum_congr $ λ a, tsum_congr $ λ b, ennreal.coe_mul)
-  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), ↑(if b ∈ s then f a b else 0) :
-    tsum_congr (λ a, ennreal.tsum_mul_left)
-  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), if b ∈ s then ↑(f a b) else (0 : ℝ≥0∞) :
-    tsum_congr (λ a, congr_arg (λ x, ↑(p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
-  ... = ∑' (a : α), ↑(p a) * (f a).to_outer_measure s :
-    tsum_congr (λ a, by simp only [to_outer_measure_apply, set.indicator_apply])
-
-/-- The measure of a set under `p.bind f` is the sum over `a : α`
-  of the probability of `a` under `p` times the measure of the set under `f a` -/
-@[simp] lemma to_measure_bind_apply [measurable_space β] (hs : measurable_set s) :
-  (p.bind f).to_measure s = ∑' (a : α), (p a : ℝ≥0∞) * (f a).to_measure s :=
-(to_measure_apply_eq_to_outer_measure_apply (p.bind f) s hs).trans
-  ((to_outer_measure_bind_apply p f s).trans (tsum_congr (λ a, congr_arg (λ x, p a * x)
-  (to_measure_apply_eq_to_outer_measure_apply (f a) s hs).symm)))
-
-end measure
-
-end bind
-
-instance : monad pmf :=
-{ pure := λ A a, pure a,
-  bind := λ A B pa pb, pa.bind pb }
-
-
-section bind_on_support
-
-protected lemma bind_on_support.summable (p : pmf α) (f : Π a ∈ p.support, pmf β) (b : β) :
-  summable (λ a : α, p a * if h : p a = 0 then 0 else f a h b) :=
-begin
-  refine nnreal.summable_of_le (assume a, _) p.summable_coe,
-  split_ifs,
-  { refine (mul_zero (p a)).symm ▸ le_of_eq h.symm },
-  { suffices : p a * f a h b ≤ p a * 1, { simpa },
-    exact mul_le_mul_of_nonneg_left ((f a h).coe_le_one _) (p a).2 }
-end
-
-/-- Generalized version of `bind` allowing `f` to only be defined on the support of `p`.
-  `p.bind f` is equivalent to `p.bind_on_support (λ a _, f a)`, see `bind_on_support_eq_bind` -/
-def bind_on_support (p : pmf α) (f : Π a ∈ p.support, pmf β) : pmf β :=
-⟨λ b, ∑' a, p a * if h : p a = 0 then 0 else f a h b,
-ennreal.has_sum_coe.1 begin
-  simp only [ennreal.coe_tsum (bind_on_support.summable p f _)],
-  rw [ennreal.summable.has_sum_iff, ennreal.tsum_comm],
-  simp only [ennreal.coe_mul, ennreal.coe_one, ennreal.tsum_mul_left],
-  have : ∑' (a : α), (p a : ennreal) = 1 :=
-    by simp only [←ennreal.coe_tsum p.summable_coe, ennreal.coe_one, tsum_coe],
-  refine trans (tsum_congr (λ a, _)) this,
-  split_ifs with h,
-  { simp [h] },
-  { simp [← ennreal.coe_tsum (f a h).summable_coe, (f a h).tsum_coe] }
-end⟩
-
-variables {p : pmf α} (f : Π a ∈ p.support, pmf β)
-
-@[simp] lemma bind_on_support_apply (b : β) :
-  p.bind_on_support f b = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
-rfl
-
-@[simp] lemma support_bind_on_support :
-  (p.bind_on_support f).support = {b | ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support} :=
-begin
-  refine set.ext (λ b, _),
-  simp only [tsum_eq_zero_iff (bind_on_support.summable p f b), not_or_distrib, mem_support_iff,
-    bind_on_support_apply, ne.def, not_forall, mul_eq_zero],
-  exact ⟨λ hb, let ⟨a, ⟨ha, ha'⟩⟩ := hb in ⟨a, ha, by simpa [ha] using ha'⟩,
-    λ hb, let ⟨a, ha, ha'⟩ := hb in ⟨a, ⟨ha, by simpa [(mem_support_iff _ a).1 ha] using ha'⟩⟩⟩
-end
-
-lemma mem_support_bind_on_support_iff (b : β) :
-  b ∈ (p.bind_on_support f).support ↔ ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support :=
-by simp
-
-/-- `bind_on_support` reduces to `bind` if `f` doesn't depend on the additional hypothesis -/
-@[simp] lemma bind_on_support_eq_bind (p : pmf α) (f : α → pmf β) :
-  p.bind_on_support (λ a _, f a) = p.bind f :=
-begin
-  ext b,
-  simp only [bind_on_support_apply (λ a _, f a), p.bind_apply f,
-    dite_eq_ite, nnreal.coe_eq, mul_ite, mul_zero],
-  refine congr_arg _ (funext (λ a, _)),
-  split_ifs with h; simp [h],
-end
-
-lemma coe_bind_on_support_apply (b : β) :
-  (p.bind_on_support f b : ℝ≥0∞) = ∑' a, p a * if h : p a = 0 then 0 else f a h b :=
-by simp only [bind_on_support_apply, ennreal.coe_tsum (bind_on_support.summable p f b),
-    dite_cast, ennreal.coe_mul, ennreal.coe_zero]
-
-lemma bind_on_support_eq_zero_iff (b : β) :
-  p.bind_on_support f b = 0 ↔ ∀ a (ha : p a ≠ 0), f a ha b = 0 :=
-begin
-  simp only [bind_on_support_apply, tsum_eq_zero_iff (bind_on_support.summable p f b),
-    mul_eq_zero, or_iff_not_imp_left],
-  exact ⟨λ h a ha, trans (dif_neg ha).symm (h a ha), λ h a ha, trans (dif_neg ha) (h a ha)⟩,
-end
-
-@[simp] lemma pure_bind_on_support (a : α) (f : Π (a' : α) (ha : a' ∈ (pure a).support), pmf β) :
-  (pure a).bind_on_support f = f a ((mem_support_pure_iff a a).mpr rfl) :=
-begin
-  refine pmf.ext (λ b, _),
-  simp only [nnreal.coe_eq, bind_on_support_apply, pure_apply],
-  refine trans (tsum_congr (λ a', _)) (tsum_ite_eq a _),
-  by_cases h : (a' = a); simp [h],
-end
-
-lemma bind_on_support_pure (p : pmf α) :
-  p.bind_on_support (λ a _, pure a) = p :=
-by simp only [pmf.bind_pure, pmf.bind_on_support_eq_bind]
-
-@[simp] lemma bind_on_support_bind_on_support (p : pmf α)
-  (f : ∀ a ∈ p.support, pmf β)
-  (g : ∀ (b ∈ (p.bind_on_support f).support), pmf γ) :
-  (p.bind_on_support f).bind_on_support g =
-    p.bind_on_support (λ a ha, (f a ha).bind_on_support
-      (λ b hb, g b ((mem_support_bind_on_support_iff f b).mpr ⟨a, ha, hb⟩))) :=
-begin
-  refine pmf.ext (λ a, _),
-  simp only [ennreal.coe_eq_coe.symm, coe_bind_on_support_apply, ← tsum_dite_right,
-    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
-  simp only [ennreal.tsum_eq_zero, ennreal.coe_eq_coe, ennreal.coe_eq_zero, ennreal.coe_zero,
-    dite_eq_left_iff, mul_eq_zero],
-  refine ennreal.tsum_comm.trans (tsum_congr (λ a', tsum_congr (λ b, _))),
-  split_ifs,
-  any_goals { ring1 },
-  { have := h_1 a', simp [h] at this, contradiction },
-  { simp [h_2], },
-end
-
-lemma bind_on_support_comm (p : pmf α) (q : pmf β)
-  (f : ∀ (a ∈ p.support) (b ∈ q.support), pmf γ) :
-  p.bind_on_support (λ a ha, q.bind_on_support (f a ha)) =
-    q.bind_on_support (λ b hb, p.bind_on_support (λ a ha, f a ha b hb)) :=
-begin
-  apply pmf.ext, rintro c,
-  simp only [ennreal.coe_eq_coe.symm, coe_bind_on_support_apply, ← tsum_dite_right,
-    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
-  refine trans (ennreal.tsum_comm) (tsum_congr (λ b, tsum_congr (λ a, _))),
-  split_ifs with h1 h2 h2; ring,
-end
-
-section measure
-
-variable (s : set β)
-
-@[simp] lemma to_outer_measure_bind_on_support_apply :
-  (p.bind_on_support f).to_outer_measure s =
-    ∑' (a : α), (p a : ℝ≥0) * if h : p a = 0 then 0 else (f a h).to_outer_measure s :=
-let g : α → β → ℝ≥0 := λ a b, if h : p a = 0 then 0 else f a h b in
-calc (p.bind_on_support f).to_outer_measure s
-  = ∑' (b : β), if b ∈ s then ↑(∑' (a : α), p a * g a b) else 0 :
-    by simp [to_outer_measure_apply, set.indicator_apply]
-  ... = ∑' (b : β), ↑(∑' (a : α), p a * (if b ∈ s then g a b else 0)) :
-    tsum_congr (λ b, by split_ifs; simp)
-  ... = ∑' (b : β) (a : α), ↑(p a * (if b ∈ s then g a b else 0)) :
-    tsum_congr (λ b, ennreal.coe_tsum $
-      nnreal.summable_of_le (by split_ifs; simp) (bind_on_support.summable p f b))
-  ... = ∑' (a : α) (b : β), ↑(p a) * ↑(if b ∈ s then g a b else 0) :
-    ennreal.tsum_comm.trans (tsum_congr $ λ a, tsum_congr $ λ b, ennreal.coe_mul)
-  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), ↑(if b ∈ s then g a b else 0) :
-    tsum_congr (λ a, ennreal.tsum_mul_left)
-  ... = ∑' (a : α), ↑(p a) * ∑' (b : β), if b ∈ s then ↑(g a b) else (0 : ℝ≥0∞) :
-    tsum_congr (λ a, congr_arg (λ x, ↑(p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
-  ... = ∑' (a : α), ↑(p a) * if h : p a = 0 then 0 else (f a h).to_outer_measure s :
-    tsum_congr (λ a, congr_arg (has_mul.mul ↑(p a)) begin
-      split_ifs with h h,
-      { exact ennreal.tsum_eq_zero.mpr (λ x,
-          (by simp [g, h] : (0 : ℝ≥0∞) = ↑(g a x)) ▸ (if_t_t (x ∈ s) 0)) },
-      { simp [to_outer_measure_apply, g, h, set.indicator_apply] }
-    end)
-
-/-- The measure of a set under `p.bind_on_support f` is the sum over `a : α`
-  of the probability of `a` under `p` times the measure of the set under `f a _`.
-  The additional if statement is needed since `f` is only a partial function -/
-@[simp] lemma to_measure_bind_on_support_apply [measurable_space β] (hs : measurable_set s) :
-  (p.bind_on_support f).to_measure s =
-    ∑' (a : α), (p a : ℝ≥0∞) * if h : p a = 0 then 0 else (f a h).to_measure s :=
-(to_measure_apply_eq_to_outer_measure_apply (p.bind_on_support f) s hs).trans
-  ((to_outer_measure_bind_on_support_apply f s).trans
-  (tsum_congr $ λ a, congr_arg (has_mul.mul ↑(p a)) (congr_arg (dite (p a = 0) (λ _, 0))
-    $ funext (λ h, symm $ to_measure_apply_eq_to_outer_measure_apply (f a h) s hs))))
-
-end measure
-
-end bind_on_support
-
-end pmf
diff --git a/src/measure_theory/tactic.lean b/src/measure_theory/tactic.lean
index 9b414c2682dc2..cbbc77040535d 100644
--- a/src/measure_theory/tactic.lean
+++ b/src/measure_theory/tactic.lean
@@ -7,9 +7,13 @@ import measure_theory.measure.measure_space_def
 import tactic.auto_cases
 import tactic.tidy
 import tactic.with_local_reducibility
+
 /-!
 # Tactics for measure theory
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Currently we have one domain-specific tactic for measure theory: `measurability`.
 
 This tactic is to a large extent a copy of the `continuity` tactic by Reid Barton.
@@ -47,8 +51,6 @@ attribute [measurability]
   subsingleton.measurable_set
   measurable_set.Union
   measurable_set.Inter
-  measurable_set.Union_Prop
-  measurable_set.Inter_Prop
   measurable_set.union
   measurable_set.inter
   measurable_set.diff
@@ -59,9 +61,7 @@ attribute [measurability]
   measurable_set.const
   measurable_set.insert
   measurable_set_eq
-  set.finite.measurable_set
   finset.measurable_set
-  set.countable.measurable_set
   measurable_space.measurable_set_top
 
 namespace tactic
@@ -124,11 +124,13 @@ do t ← tactic.target,
   | _ := skip
   end
 
-/-- List of tactics used by `measurability` internally. -/
+/-- List of tactics used by `measurability` internally. The option `use_exfalso := ff` is passed to
+the tactic `apply_assumption` in order to avoid loops in the presence of negated hypotheses in
+the context. -/
 meta def measurability_tactics (md : transparency := semireducible) : list (tactic string) :=
 [
-  propositional_goal >> apply_assumption
-                        >> pure "apply_assumption",
+  propositional_goal >> tactic.interactive.apply_assumption none {use_exfalso := ff}
+                        >> pure "apply_assumption {use_exfalso := ff}",
   goal_is_not_measurable >> intro1
                         >>= λ ns, pure ("intro " ++ ns.to_string),
   apply_rules [] [``measurability] 50 { md := md }
diff --git a/src/meta/coinductive_predicates.lean b/src/meta/coinductive_predicates.lean
index 1d9941f26d960..e84ad42a8491f 100644
--- a/src/meta/coinductive_predicates.lean
+++ b/src/meta/coinductive_predicates.lean
@@ -517,7 +517,7 @@ do
 namespace interactive
 open interactive interactive.types expr lean.parser
 local postfix `?`:9001 := optional
-local postfix *:9001 := many
+local postfix (name := parser.many) *:9001 := many
 
 meta def coinduction (corec_name : parse ident)
   (ns : parse with_ident_list)
diff --git a/src/meta/expr.lean b/src/meta/expr.lean
index 9d2c045dca993..0ba45514fd614 100644
--- a/src/meta/expr.lean
+++ b/src/meta/expr.lean
@@ -3,6 +3,7 @@ Copyright (c) 2019 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Simon Hudon, Scott Morrison, Keeley Hoek, Robert Y. Lewis, Floris van Doorn
 -/
+import data.option.defs
 import data.string.defs
 import tactic.derive_inhabited
 /-!
@@ -21,9 +22,6 @@ open tactic
 
 attribute [derive has_reflect, derive decidable_eq] binder_info congr_arg_kind
 
-@[priority 100] meta instance has_reflect.has_to_pexpr {α} [has_reflect α] : has_to_pexpr α :=
-⟨λ b, pexpr.of_expr (reflect b)⟩
-
 namespace binder_info
 
 /-! ### Declarations about `binder_info` -/
@@ -123,12 +121,6 @@ meta def head : name → string
 meta def is_private (n : name) : bool :=
 n.head = "_private"
 
-/-- Get the last component of a name, and convert it to a string. -/
-meta def last : name → string
-| (mk_string s _)  := s
-| (mk_numeral n _) := repr n
-| anonymous        := "[anonymous]"
-
 /-- Returns the number of characters used to print all the string components of a name,
   including periods between name segments. Ignores numerical parts of a name. -/
 meta def length : name → ℕ
@@ -155,6 +147,19 @@ def last_string : name → string
 | (mk_string s _)  := s
 | (mk_numeral _ n) := last_string n
 
+/-- Like `++`, except that if the right argument starts with `_root_` the namespace will be
+ignored.
+```
+append_namespace `a.b `c.d = `a.b.c.d
+append_namespace `a.b `_root_.c.d = `c.d
+```
+-/
+meta def append_namespace (ns : name) : name → name
+| (mk_string s anonymous) := if s = "_root_" then anonymous else mk_string s ns
+| (mk_string s p)         := mk_string s (append_namespace p)
+| (mk_numeral n p)        := mk_numeral n (append_namespace p)
+| anonymous               := ns
+
 /--
 Constructs a (non-simple) name from a string.
 
@@ -382,6 +387,48 @@ meta def is_num_eq : expr → expr → bool
 
 end expr
 
+/-! ### Declarations about `pexpr` -/
+
+namespace pexpr
+
+/--
+If `e` is an annotation of `frozen_name` to `expr.const n`,
+`e.get_frozen_name` returns `n`.
+Otherwise, returns `name.anonymous`.
+-/
+meta def get_frozen_name (e : pexpr) : name :=
+match e.is_annotation with
+| some (`frozen_name, expr.const n _) := n
+| _ := name.anonymous
+end
+
+/--
+If `e : pexpr` is a sequence of applications `f e₁ e₂ ... eₙ`,
+`e.get_app_fn_args` returns `(f, [e₁, ... eₙ])`.
+See also `expr.get_app_fn_args`.
+-/
+meta def get_app_fn_args : pexpr → opt_param (list pexpr) [] → pexpr × list pexpr
+| (expr.app e1 e2) r := get_app_fn_args e1 (e2::r)
+| e1 r := (e1, r)
+
+/--
+If `e : pexpr` is a sequence of applications `f e₁ e₂ ... eₙ`,
+`e.get_app_fn` returns `f`.
+See also `expr.get_app_fn`.
+-/
+meta def get_app_fn : pexpr → list pexpr :=
+prod.snd ∘ get_app_fn_args
+
+/--
+If `e : pexpr` is a sequence of applications `f e₁ e₂ ... eₙ`,
+`e.get_app_args` returns `[e₁, ... eₙ]`.
+See also `expr.get_app_args`.
+-/
+meta def get_app_args : pexpr → list pexpr :=
+prod.snd ∘ get_app_fn_args
+
+end pexpr
+
 /-! ### Declarations about `expr` -/
 
 namespace expr
@@ -847,6 +894,19 @@ private meta def all_implicitly_included_variables_aux
 meta def all_implicitly_included_variables (es vs : list expr) : list expr :=
 all_implicitly_included_variables_aux es vs [] ff
 
+/-- Get the list of explicit arguments of a function. -/
+meta def list_explicit_args (f : expr) : tactic (list expr) :=
+tactic.fold_explicit_args f [] (λ ll e, return $ ll ++ [e])
+
+/--  `replace_explicit_args f parg` assumes that `f` is an expression corresponding to a function
+application.  It replaces the explicit arguments of `f`, in succession, by the elements of `parg`.
+The implicit arguments of `f` remain unchanged. -/
+meta def replace_explicit_args (f : expr) (parg : list expr) : tactic expr :=
+do finf ← (get_fun_info f.get_app_fn),
+  let is_ex_arg : list bool := finf.params.map (λ e, ¬ e.is_implicit ∧ ¬ e.is_inst_implicit),
+  let nargs := list.replace_if f.get_app_args is_ex_arg parg,
+  return $ expr.mk_app f.get_app_fn nargs
+
 /-- Infer the type of an application of the form `f x1 x2 ... xn`, where `f` is an identifier.
 This also works if `x1, ... xn` contain free variables. -/
 protected meta def simple_infer_type (env : environment) (e : expr) : exceptional expr := do
@@ -1153,3 +1213,9 @@ end declaration
 meta instance pexpr.decidable_eq {elab} : decidable_eq (expr elab) :=
 unchecked_cast
 expr.has_decidable_eq
+
+section
+local attribute [semireducible] reflected
+meta instance {α} [has_reflect α] : has_reflect (thunk α) | a :=
+expr.lam `x binder_info.default (reflect unit) (reflect $ a ())
+end
diff --git a/src/meta/rb_map.lean b/src/meta/rb_map.lean
index 27ae900a748d3..d2948c921be32 100644
--- a/src/meta/rb_map.lean
+++ b/src/meta/rb_map.lean
@@ -3,6 +3,7 @@ Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
+import data.option.defs
 import data.list.defs
 
 /-!
diff --git a/src/meta/univs.lean b/src/meta/univs.lean
new file mode 100644
index 0000000000000..48bb6413bf941
--- /dev/null
+++ b/src/meta/univs.lean
@@ -0,0 +1,117 @@
+/-
+Copyright (c) 2022 Gabriel Ebner. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Gabriel Ebner, Eric Wieser
+-/
+
+/-!
+# Reflection of universe variables
+
+The `reflect` and `has_reflect` machinery (sometimes via the `` `(expr) `` syntax) allows
+terms to be converted to the expression that constructs them. However, this construction does not
+support universe variables.
+
+This file provides a typeclass `reflected_univ.{u}` to match a universe variable `u` with a level
+`l`, which allows `reflect` to be used universe-polymorphically.
+
+## Main definitions
+
+* `reflected_univ.{u}`: A typeclass for reflecting the universe `u` to a `level`.
+* `reflect_univ.{u} : level`: Obtain the level of a universe by typeclass search.
+* `tactic.interactive.reflect_name`: solve goals of the form `reflected (@foo.{u v})` by searching
+  for `reflected_univ.{u}` instances.
+
+-/
+
+/-- A typeclass to translate a universe argument into a `level`. Note that `level.mvar` and
+`level.param` are not supported.
+
+Note that the `instance_priority` linter will complain if instance of this class have the default
+priority, as it takes no arguments! Since it doesn't make any difference, we do what the linter
+asks. -/
+meta class {u} reflected_univ :=
+(lvl : level)
+
+universes u v w x y
+
+/-- Reflect a universe variable `u` into a `level` via typeclass search. -/
+meta def reflect_univ [reflected_univ.{u}] : level :=
+reflected_univ.lvl
+
+@[priority 100]
+meta instance reflect_univ.zero : reflected_univ.{0} :=
+⟨level.zero⟩
+
+@[priority 100]
+meta instance reflect_univ.succ [reflected_univ.{u}] : reflected_univ.{u+1} :=
+⟨level.succ reflect_univ.{u}⟩
+
+@[priority 100]
+meta instance reflect_univ.max [reflected_univ.{u}] [reflected_univ.{v}] :
+  reflected_univ.{max u v} :=
+⟨level.max reflect_univ.{u} reflect_univ.{v}⟩
+
+@[priority 100]
+meta instance reflect_univ.imax [reflected_univ.{u}] [reflected_univ.{v}] :
+  reflected_univ.{imax u v} :=
+⟨level.imax reflect_univ.{u} reflect_univ.{v}⟩
+
+section
+local attribute [semireducible] reflected
+/-- This definition circumvents the protection that `reflected` tried to enforce; so is private
+such that it is only used by `tactic.interactive.reflect_name` where we have enforced the protection
+manually. -/
+private meta def reflected.of {α : Sort*} {a : α} (e : expr) : reflected _ a := e
+end
+
+/-- Reflect a universe-polymorphic name, by searching for `reflected_univ` instances. -/
+meta def tactic.interactive.reflect_name : tactic unit :=
+do
+  tgt ← tactic.target,
+  `(reflected _ %%x) ← pure tgt,
+  expr.const name levels ← pure x,
+  levels ← levels.mmap (λ l, do
+    inst ← tactic.mk_instance (expr.const `reflected_univ [l]),
+    pure $ expr.app (expr.const `reflect_univ [l]) inst),
+  let levels := list.foldr (λ a l, `(@list.cons level %%a %%l)) `(@list.nil level) levels,
+  let e := `(@expr.const tt %%`(name) %%levels),
+  let e2 := ``(reflected.of %%e : %%tgt),
+  e2 ← tactic.to_expr e2,
+  tactic.exact e2
+
+/-- Convenience helper for two consecutive `reflected.subst` applications -/
+meta def reflected.subst₂ {α : Sort u} {β : α → Sort v} {γ : Π a, β a → Sort w}
+  {f : Π a b, γ a b} {a : α} {b : β a} :
+  reflected _ f → reflected _ a → reflected _ b → reflected _ (f a b) :=
+(∘) reflected.subst ∘ reflected.subst
+
+/-- Convenience helper for three consecutive `reflected.subst` applications -/
+meta def reflected.subst₃ {α : Sort u} {β : α → Sort v} {γ : Π a, β a → Sort w}
+  {δ : Π a b, γ a b → Sort x}
+  {f : Π a b c, δ a b c} {a : α} {b : β a} {c : γ a b}:
+  reflected _ f → reflected _ a → reflected _ b → reflected _ c → reflected _ (f a b c) :=
+(∘) reflected.subst₂ ∘ reflected.subst
+
+/-- Convenience helper for four consecutive `reflected.subst` applications -/
+meta def reflected.subst₄ {α : Sort u} {β : α → Sort v} {γ : Π a, β a → Sort w}
+  {δ : Π a b, γ a b → Sort x} {ε : Π a b c, δ a b c → Sort y}
+  {f : Π a b c d, ε a b c d} {a : α} {b : β a} {c : γ a b} {d : δ a b c} :
+  reflected _ f → reflected _ a → reflected _ b → reflected _ c → reflected _ d →
+    reflected _ (f a b c d) :=
+(∘) reflected.subst₃ ∘ reflected.subst
+
+/-! ### Universe-polymorphic `has_reflect` instances -/
+
+/-- Universe polymorphic version of the builtin `punit.reflect`. -/
+meta instance punit.reflect' [reflected_univ.{u}] : has_reflect punit.{u}
+| punit.star := by reflect_name
+
+/-- Universe polymorphic version of the builtin `list.reflect`. -/
+meta instance list.reflect' [reflected_univ.{u}] {α : Type u} [has_reflect α] [reflected _ α] :
+  has_reflect (list α)
+| []     := (by reflect_name : reflected _ @list.nil.{u}).subst `(α)
+| (h::t) := (by reflect_name : reflected _ @list.cons.{u}).subst₃ `(α) `(h) (list.reflect' t)
+
+meta instance ulift.reflect' [reflected_univ.{u}] [reflected_univ.{v}] {α : Type v}
+  [reflected _ α] [has_reflect α] : has_reflect (ulift.{u v} α)
+| (ulift.up x) := (by reflect_name : reflected _ @ulift.up.{u v}).subst₂ `(α) `(x)
diff --git a/src/model_theory/basic.lean b/src/model_theory/basic.lean
index 09401033c2b53..b9381bcfcd2e6 100644
--- a/src/model_theory/basic.lean
+++ b/src/model_theory/basic.lean
@@ -3,16 +3,15 @@ Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All righ
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
 -/
-import category_theory.concrete_category.bundled
-import data.fin.tuple.basic
 import data.fin.vec_notation
-import logic.encodable.basic
-import logic.small
 import set_theory.cardinal.basic
 
 
 /-!
 # Basics on First-Order Structures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines first-order languages and structures in the style of the
 [Flypitch project](https://flypitch.github.io/), as well as several important maps between
 structures.
@@ -35,6 +34,10 @@ structures.
   to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
   the interpretations of relations in both directions.
 
+## TODO
+
+Use `[countable L.symbols]` instead of `[L.countable]`.
+
 ## References
 For the Flypitch project:
 - [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
@@ -59,19 +62,45 @@ structure language :=
 (functions : ℕ → Type u) (relations : ℕ → Type v)
 
 /-- Used to define `first_order.language₂`. -/
-def sequence₂ (a₀ a₁ a₂ : Type u) : ℕ → Type u
+@[simp] def sequence₂ (a₀ a₁ a₂ : Type u) : ℕ → Type u
 | 0 := a₀
 | 1 := a₁
 | 2 := a₂
 | _ := pempty
 
-instance {a₀ a₁ a₂ : Type u} [h : inhabited a₀] : inhabited (sequence₂ a₀ a₁ a₂ 0) := h
+namespace sequence₂
+
+variables (a₀ a₁ a₂ : Type u)
+
+instance inhabited₀ [h : inhabited a₀] : inhabited (sequence₂ a₀ a₁ a₂ 0) := h
+
+instance inhabited₁ [h : inhabited a₁] : inhabited (sequence₂ a₀ a₁ a₂ 1) := h
+
+instance inhabited₂ [h : inhabited a₂] : inhabited (sequence₂ a₀ a₁ a₂ 2) := h
+
+instance {n : ℕ} : is_empty (sequence₂ a₀ a₁ a₂ (n + 3)) := pempty.is_empty
+
+@[simp] lemma lift_mk {i : ℕ} :
+  cardinal.lift (# (sequence₂ a₀ a₁ a₂ i)) = # (sequence₂ (ulift a₀) (ulift a₁) (ulift a₂) i) :=
+begin
+  rcases i with (_ | _ | _ | i);
+  simp only [sequence₂, mk_ulift, mk_fintype, fintype.card_of_is_empty, nat.cast_zero, lift_zero],
+end
+
+@[simp] lemma sum_card :
+  cardinal.sum (λ i, # (sequence₂ a₀ a₁ a₂ i)) = # a₀ + # a₁ + # a₂ :=
+begin
+  rw [sum_nat_eq_add_sum_succ, sum_nat_eq_add_sum_succ, sum_nat_eq_add_sum_succ],
+  simp [add_assoc],
+end
+
+end sequence₂
 
 namespace language
 
 /-- A constructor for languages with only constants, unary and binary functions, and
 unary and binary relations. -/
-protected def mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) : language :=
+@[simps] protected def mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) : language :=
 ⟨sequence₂ c f₁ f₂, sequence₂ pempty r₁ r₂⟩
 
 /-- The empty language has no symbols. -/
@@ -86,19 +115,18 @@ protected def sum (L : language.{u v}) (L' : language.{u' v'}) : language :=
 variable (L : language.{u v})
 
 /-- The type of constants in a given language. -/
-@[nolint has_inhabited_instance] protected def «constants» := L.functions 0
+@[nolint has_nonempty_instance] protected def «constants» := L.functions 0
+
+@[simp] lemma constants_mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) :
+  (language.mk₂ c f₁ f₂ r₁ r₂).constants = c :=
+rfl
 
 /-- The type of symbols in a given language. -/
-@[nolint has_inhabited_instance] def symbols := (Σl, L.functions l) ⊕ (Σl, L.relations l)
+@[nolint has_nonempty_instance] def symbols := (Σl, L.functions l) ⊕ (Σl, L.relations l)
 
 /-- The cardinality of a language is the cardinality of its type of symbols. -/
 def card : cardinal := # L.symbols
 
-/-- A language is countable when it has countably many symbols. -/
-class countable : Prop := (card_le_omega' : L.card ≤ ω)
-
-lemma card_le_omega [L.countable] : L.card ≤ ω := countable.card_le_omega'
-
 /-- A language is relational when it has no function symbols. -/
 class is_relational : Prop :=
 (empty_functions : ∀ n, is_empty (L.functions n))
@@ -107,13 +135,6 @@ class is_relational : Prop :=
 class is_algebraic : Prop :=
 (empty_relations : ∀ n, is_empty (L.relations n))
 
-/-- A language is countable when it has countably many symbols. -/
-class countable_functions : Prop := (card_functions_le_omega' : # (Σl, L.functions l) ≤ ω)
-
-lemma card_functions_le_omega [L.countable_functions] :
-  # (Σl, L.functions l) ≤ ω :=
-countable_functions.card_functions_le_omega'
-
 variables {L} {L' : language.{u' v'}}
 
 lemma card_eq_card_functions_add_card_relations :
@@ -165,31 +186,18 @@ instance subsingleton_mk₂_relations {c f₁ f₂ : Type u} {r₁ r₂ : Type v
 nat.cases_on n ⟨λ x, pempty.elim x⟩
   (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ n, ⟨λ x, pempty.elim x⟩)))
 
-lemma encodable.countable [h : encodable L.symbols] :
-  L.countable :=
-⟨cardinal.encodable_iff.1 ⟨h⟩⟩
-
 @[simp] lemma empty_card : language.empty.card = 0 :=
 by simp [card_eq_card_functions_add_card_relations]
 
-instance countable_empty : language.empty.countable :=
-⟨by simp⟩
-
-@[priority 100] instance countable.countable_functions [L.countable] :
-  L.countable_functions :=
-⟨begin
-  refine lift_le_omega.1 (trans _ L.card_le_omega),
-  rw [card, symbols, mk_sum],
-  exact le_self_add,
-end⟩
-
-lemma encodable.countable_functions [h : encodable (Σl, L.functions l)] :
-  L.countable_functions :=
-⟨cardinal.encodable_iff.1 ⟨h⟩⟩
+instance is_empty_empty : is_empty language.empty.symbols :=
+begin
+  simp only [language.symbols, is_empty_sum, is_empty_sigma],
+  exact ⟨λ _, infer_instance, λ _, infer_instance⟩,
+end
 
-@[priority 100] instance is_relational.countable_functions [L.is_relational] :
-  L.countable_functions :=
-encodable.countable_functions
+instance countable.countable_functions [h : countable L.symbols] :
+  countable (Σl, L.functions l) :=
+@function.injective.countable _ _ h _ sum.inl_injective
 
 @[simp] lemma card_functions_sum (i : ℕ) :
   #((L.sum L').functions i) = (#(L.functions i)).lift + cardinal.lift.{u} (#(L'.functions i)) :=
@@ -208,6 +216,12 @@ begin
     add_comm (cardinal.sum (λ i, (# (L'.functions i)).lift)), add_assoc, add_assoc]
 end
 
+@[simp] lemma card_mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) :
+  (language.mk₂ c f₁ f₂ r₁ r₂).card =
+    cardinal.lift.{v} (# c) + cardinal.lift.{v} (# f₁) + cardinal.lift.{v} (# f₂)
+    + cardinal.lift.{u} (# r₁) + cardinal.lift.{u} (# r₂) :=
+by simp [card_eq_card_functions_add_card_relations, add_assoc]
+
 variables (L) (M : Type w)
 
 /-- A first-order structure on a type `M` consists of interpretations of all the symbols in a given
@@ -223,7 +237,7 @@ variables (N : Type w') [L.Structure M] [L.Structure N]
 open Structure
 
 /-- Used for defining `first_order.language.Theory.Model.inhabited`. -/
-def trivial_unit_structure : L.Structure unit := ⟨default, default⟩
+def inhabited.trivial_structure {α : Type*} [inhabited α] : L.Structure α := ⟨default, default⟩
 
 /-! ### Maps -/
 
@@ -235,7 +249,8 @@ structure hom :=
 (map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
 (map_rel' : ∀{n} (r : L.relations n) x, rel_map r x → rel_map r (to_fun ∘ x) . obviously)
 
-localized "notation A ` →[`:25 L `] ` B := first_order.language.hom L A B" in first_order
+localized "notation (name := language.hom) A ` →[`:25 L `] ` B :=
+  first_order.language.hom L A B" in first_order
 
 /-- An embedding of first-order structures is an embedding that commutes with the
   interpretations of functions and relations. -/
@@ -243,7 +258,8 @@ localized "notation A ` →[`:25 L `] ` B := first_order.language.hom L A B" in
 (map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
 (map_rel' : ∀{n} (r : L.relations n) x, rel_map r (to_fun ∘ x) ↔ rel_map r x . obviously)
 
-localized "notation A ` ↪[`:25 L `] ` B := first_order.language.embedding L A B" in first_order
+localized "notation (name := language.embedding) A ` ↪[`:25 L `] ` B :=
+  first_order.language.embedding L A B" in first_order
 
 /-- An equivalence of first-order structures is an equivalence that commutes with the
   interpretations of functions and relations. -/
@@ -251,7 +267,8 @@ structure equiv extends M ≃ N :=
 (map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
 (map_rel' : ∀{n} (r : L.relations n) x, rel_map r (to_fun ∘ x) ↔ rel_map r x . obviously)
 
-localized "notation A ` ≃[`:25 L `] ` B := first_order.language.equiv L A B" in first_order
+localized "notation (name := language.equiv) A ` ≃[`:25 L `] ` B :=
+  first_order.language.equiv L A B" in first_order
 
 variables {L M N} {P : Type*} [L.Structure P] {Q : Type*} [L.Structure Q]
 
diff --git a/src/model_theory/bundled.lean b/src/model_theory/bundled.lean
index 998983e4450ee..4f7f34dc38f06 100644
--- a/src/model_theory/bundled.lean
+++ b/src/model_theory/bundled.lean
@@ -7,6 +7,9 @@ import model_theory.elementary_maps
 import category_theory.concrete_category.bundled
 /-!
 # Bundled First-Order Structures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file bundles types together with their first-order structure.
 
 ## Main Definitions
@@ -27,9 +30,27 @@ variables {L : first_order.language.{u v}}
   L.Structure M :=
 M.str
 
+open_locale first_order cardinal
+
+namespace equiv
+
+variables (L) {M : Type w} [L.Structure M] {N : Type w'} (g : M ≃ N)
+
+/-- A type bundled with the structure induced by an equivalence. -/
+@[simps] def bundled_induced  :
+  category_theory.bundled.{w'} L.Structure :=
+⟨N, g.induced_Structure⟩
+
+/-- An equivalence of types as a first-order equivalence to the bundled structure on the codomain.
+-/
+@[simp] def bundled_induced_equiv :
+  M ≃[L] g.bundled_induced L :=
+g.induced_Structure_equiv
+
+end equiv
+
 namespace first_order
 namespace language
-open_locale first_order
 
 /-- The equivalence relation on bundled `L.Structure`s indicating that they are isomorphic. -/
 instance equiv_setoid : setoid (category_theory.bundled L.Structure) :=
@@ -68,10 +89,10 @@ instance (M : T.Model) : nonempty M := infer_instance
 
 section inhabited
 
-local attribute [instance] trivial_unit_structure
+local attribute [instance] inhabited.trivial_structure
 
-instance : inhabited (Model (∅ : L.Theory)) :=
-⟨Model.of _ unit⟩
+instance : inhabited (Model.{u v w} (∅ : L.Theory)) :=
+⟨Model.of _ punit⟩
 
 end inhabited
 
@@ -85,6 +106,9 @@ def equiv_induced {M : Model.{u v w} T} {N : Type w'} (e : M ≃ N) :
   is_model := @equiv.Theory_model L M N _ e.induced_Structure T e.induced_Structure_equiv _,
   nonempty' := e.symm.nonempty }
 
+instance of_small (M : Type w) [nonempty M] [L.Structure M] [M ⊨ T] [h : small.{w'} M] :
+  small.{w'} (Model.of T M) := h
+
 /-- Shrinks a small model to a particular universe. -/
 noncomputable def shrink (M : Model.{u v w} T) [small.{w'} M] :
   Model.{u v w'} T := equiv_induced (equiv_shrink M)
@@ -101,6 +125,37 @@ def ulift (M : Model.{u v w} T) : Model.{u v (max w w')} T :=
   nonempty' := M.nonempty',
   is_model := (@Lhom.on_Theory_model L L' M (φ.reduct M) _ φ _ T).1 M.is_model, }
 
+/-- When `φ` is injective, `default_expansion` expands a model of `T` to a model of `φ.on_Theory T`
+  arbitrarily. -/
+@[simps] noncomputable def default_expansion {L' : language} {φ : L →ᴸ L'} (h : φ.injective)
+  [∀ n (f : L'.functions n), decidable (f ∈ set.range (λ (f : L.functions n), φ.on_function f))]
+  [∀ n (r : L'.relations n), decidable (r ∈ set.range (λ (r : L.relations n), φ.on_relation r))]
+  (M : T.Model) [inhabited M] :
+  (φ.on_Theory T).Model :=
+{ carrier := M,
+  struc := φ.default_expansion M,
+  nonempty' := M.nonempty',
+  is_model := (@Lhom.on_Theory_model L L' M _ (φ.default_expansion M) φ
+    (h.is_expansion_on_default M) T).2 M.is_model, }
+
+instance left_Structure {L' : language} {T : (L.sum L').Theory} (M : T.Model) :
+  L.Structure M :=
+(Lhom.sum_inl : L →ᴸ L.sum L').reduct M
+
+instance right_Structure {L' : language} {T : (L.sum L').Theory} (M : T.Model) :
+  L'.Structure M :=
+(Lhom.sum_inr : L' →ᴸ L.sum L').reduct M
+
+/-- A model of a theory is also a model of any subtheory. -/
+@[simps] def subtheory_Model (M : T.Model) {T' : L.Theory} (h : T' ⊆ T) :
+  T'.Model :=
+{ carrier := M,
+  is_model := ⟨λ φ hφ, realize_sentence_of_mem T (h hφ)⟩ }
+
+instance subtheory_Model_models (M : T.Model) {T' : L.Theory} (h : T' ⊆ T) :
+  M.subtheory_Model h ⊨ T :=
+M.is_model
+
 end Model
 
 variables {T}
@@ -116,9 +171,17 @@ lemma coe_of {M : Type w} [L.Structure M] [nonempty M] (h : M ⊨ T) :
 
 end Theory
 
+/-- A structure that is elementarily equivalent to a model, bundled as a model. -/
+def elementarily_equivalent.to_Model {M : T.Model} {N : Type*} [LN : L.Structure N] (h : M ≅[L] N) :
+  T.Model :=
+{ carrier := N,
+  struc := LN,
+  nonempty' := h.nonempty,
+  is_model := h.Theory_model }
+
 /-- An elementary substructure of a bundled model as a bundled model. -/
 def elementary_substructure.to_Model {M : T.Model} (S : L.elementary_substructure M) : T.Model :=
-Theory.Model.of T S
+S.elementarily_equivalent.symm.to_Model T
 
 instance {M : T.Model} (S : L.elementary_substructure M) [h : small S] :
   small (S.to_Model T) :=
diff --git a/src/model_theory/definability.lean b/src/model_theory/definability.lean
index 529c0e5338890..b38b5f355e3ba 100644
--- a/src/model_theory/definability.lean
+++ b/src/model_theory/definability.lean
@@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
 import data.set_like.basic
-import logic.equiv.fintype
 import model_theory.semantics
 
 /-!
 # Definable Sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines what it means for a set over a first-order structure to be definable.
 
 ## Main Definitions
@@ -100,7 +102,7 @@ begin
   rcases hg with ⟨θ, hθ⟩,
   refine ⟨φ ⊔ θ, _⟩,
   ext,
-  rw [hφ, hθ, mem_set_of_eq, formula.realize_sup, mem_union_eq, mem_set_of_eq,
+  rw [hφ, hθ, mem_set_of_eq, formula.realize_sup, mem_union, mem_set_of_eq,
     mem_set_of_eq],
 end
 
@@ -180,9 +182,6 @@ begin
     simp }
 end
 
-lemma fin.coe_cast_add_zero {m : ℕ} : (fin.cast_add 0 : fin m → fin (m + 0)) = id :=
-funext (λ _, fin.ext rfl)
-
 /-- This lemma is only intended as a helper for `definable.image_comp. -/
 lemma definable.image_comp_sum_inl_fin (m : ℕ) {s : set ((α ⊕ fin m) → M)}
   (h : A.definable L s) :
@@ -192,7 +191,7 @@ begin
   refine ⟨(bounded_formula.relabel id φ).exs, _⟩,
   ext x,
   simp only [set.mem_image, mem_set_of_eq, bounded_formula.realize_exs,
-    bounded_formula.realize_relabel, function.comp.right_id, fin.coe_cast_add_zero],
+    bounded_formula.realize_relabel, function.comp.right_id, fin.cast_add_zero, fin.cast_refl],
   split,
   { rintro ⟨y, hy, rfl⟩,
     exact ⟨y ∘ sum.inr,
@@ -203,10 +202,11 @@ end
 
 /-- Shows that definability is closed under finite projections. -/
 lemma definable.image_comp_embedding {s : set (β → M)} (h : A.definable L s)
-  (f : α ↪ β) [fintype β] :
+  (f : α ↪ β) [finite β] :
   A.definable L ((λ g : β → M, g ∘ f) '' s) :=
 begin
   classical,
+  casesI nonempty_fintype β,
   refine (congr rfl (ext (λ x, _))).mp (((h.image_comp_equiv
     (equiv.set.sum_compl (range f))).image_comp_equiv (equiv.sum_congr
     (equiv.of_injective f f.injective) (fintype.equiv_fin _).symm)).image_comp_sum_inl_fin _),
@@ -217,10 +217,12 @@ end
 
 /-- Shows that definability is closed under finite projections. -/
 lemma definable.image_comp {s : set (β → M)} (h : A.definable L s)
-  (f : α → β) [fintype α] [fintype β] :
+  (f : α → β) [finite α] [finite β] :
   A.definable L ((λ g : β → M, g ∘ f) '' s) :=
 begin
   classical,
+  casesI nonempty_fintype α,
+  casesI nonempty_fintype β,
   have h := (((h.image_comp_equiv (equiv.set.sum_compl (range f))).image_comp_equiv
     (equiv.sum_congr (_root_.equiv.refl _)
     (fintype.equiv_fin _).symm)).image_comp_sum_inl_fin _).preimage_comp (range_splitting f),
@@ -233,7 +235,7 @@ begin
     refine (congr rfl (ext _)).mp (definable_finset_bInter h' finset.univ),
     simp },
   refine (congr rfl (ext (λ x, _))).mp (h.inter h'),
-  simp only [equiv.coe_trans, mem_inter_eq, mem_preimage, mem_image,
+  simp only [equiv.coe_trans, mem_inter_iff, mem_preimage, mem_image,
     exists_exists_and_eq_and, mem_set_of_eq],
   split,
   { rintro ⟨⟨y, ys, hy⟩, hx⟩,
@@ -270,103 +272,42 @@ variables (L : first_order.language.{u v}) {M : Type w} [L.Structure M] (A : set
 def definable_set := { s : set (α → M) // A.definable L s}
 
 namespace definable_set
-variables {L} {A} {α}
-
-instance : has_top (L.definable_set A α) := ⟨⟨⊤, definable_univ⟩⟩
-
-instance : has_bot (L.definable_set A α) := ⟨⟨⊥, definable_empty⟩⟩
-
-instance : inhabited (L.definable_set A α) := ⟨⊥⟩
+variables {L A α} {s t : L.definable_set A α} {x : α → M}
 
 instance : set_like (L.definable_set A α) (α → M) :=
 { coe := subtype.val,
   coe_injective' := subtype.val_injective }
 
-@[simp]
-lemma mem_top {x : α → M} : x ∈ (⊤ : L.definable_set A α) := mem_univ x
-
-@[simp]
-lemma coe_top : ((⊤ : L.definable_set A α) : set (α → M)) = ⊤ := rfl
-
-@[simp]
-lemma not_mem_bot {x : α → M} : ¬ x ∈ (⊥ : L.definable_set A α) := not_mem_empty x
+instance : has_top (L.definable_set A α) := ⟨⟨⊤, definable_univ⟩⟩
+instance : has_bot (L.definable_set A α) := ⟨⟨⊥, definable_empty⟩⟩
+instance : has_sup (L.definable_set A α) := ⟨λ s t, ⟨s ∪ t, s.2.union t.2⟩⟩
+instance : has_inf (L.definable_set A α) := ⟨λ s t, ⟨s ∩ t, s.2.inter t.2⟩⟩
+instance : has_compl (L.definable_set A α) := ⟨λ s, ⟨sᶜ, s.2.compl⟩⟩
+instance : has_sdiff (L.definable_set A α) := ⟨λ s t, ⟨s \ t, s.2.sdiff t.2⟩⟩
 
-@[simp]
-lemma coe_bot : ((⊥ : L.definable_set A α) : set (α → M)) = ⊥ := rfl
+instance : inhabited (L.definable_set A α) := ⟨⊥⟩
 
-instance : lattice (L.definable_set A α) :=
-subtype.lattice (λ _ _, definable.union) (λ _ _, definable.inter)
+lemma le_iff : s ≤ t ↔ (s : set (α → M)) ≤ (t : set (α → M)) := iff.rfl
 
-lemma le_iff {s t : L.definable_set A α} : s ≤ t ↔ (s : set (α → M)) ≤ (t : set (α → M)) := iff.rfl
+@[simp] lemma mem_top : x ∈ (⊤ : L.definable_set A α) := mem_univ x
+@[simp] lemma not_mem_bot {x : α → M} : ¬ x ∈ (⊥ : L.definable_set A α) := not_mem_empty x
+@[simp] lemma mem_sup : x ∈ s ⊔ t ↔ x ∈ s ∨ x ∈ t := iff.rfl
+@[simp] lemma mem_inf : x ∈ s ⊓ t ↔ x ∈ s ∧ x ∈ t := iff.rfl
+@[simp] lemma mem_compl : x ∈ sᶜ ↔ ¬ x ∈ s := iff.rfl
+@[simp] lemma mem_sdiff : x ∈ s \ t ↔ x ∈ s ∧ ¬ x ∈ t := iff.rfl
 
-@[simp]
-lemma coe_sup {s t : L.definable_set A α} : ((s ⊔ t : L.definable_set A α) : set (α → M)) = s ∪ t :=
+@[simp, norm_cast] lemma coe_top : ((⊤ : L.definable_set A α) : set (α → M)) = univ := rfl
+@[simp, norm_cast] lemma coe_bot : ((⊥ : L.definable_set A α) : set (α → M)) = ∅ := rfl
+@[simp, norm_cast] lemma coe_sup (s t : L.definable_set A α) : (↑(s ⊔ t) : set (α → M)) = s ∪ t :=
 rfl
-
-@[simp]
-lemma mem_sup {s t : L.definable_set A α} {x : α → M} : x ∈ s ⊔ t ↔ x ∈ s ∨ x ∈ t := iff.rfl
-
-@[simp]
-lemma coe_inf {s t : L.definable_set A α} : ((s ⊓ t : L.definable_set A α) : set (α → M)) = s ∩ t :=
+@[simp, norm_cast] lemma coe_inf (s t : L.definable_set A α) : (↑(s ⊓ t) : set (α → M)) = s ∩ t :=
+rfl
+@[simp, norm_cast] lemma coe_compl (s : L.definable_set A α) : (↑(sᶜ) : set (α → M)) = sᶜ := rfl
+@[simp, norm_cast] lemma coe_sdiff (s t : L.definable_set A α) : (↑(s \ t) : set (α → M)) = s \ t :=
 rfl
-
-@[simp]
-lemma mem_inf {s t : L.definable_set A α} {x : α → M} : x ∈ s ⊓ t ↔ x ∈ s ∧ x ∈ t := iff.rfl
-
-instance : bounded_order (L.definable_set A α) :=
-{ bot_le := λ s x hx, false.elim hx,
-  le_top := λ s x hx, mem_univ x,
-  .. definable_set.has_top,
-  .. definable_set.has_bot }
-
-instance : distrib_lattice (L.definable_set A α) :=
-{ le_sup_inf := begin
-    intros s t u x,
-    simp only [and_imp, mem_inter_eq, set_like.mem_coe, coe_sup, coe_inf, mem_union_eq,
-      subtype.val_eq_coe],
-    tauto,
-  end,
-  .. definable_set.lattice }
-
-/-- The complement of a definable set is also definable. -/
-@[reducible] instance : has_compl (L.definable_set A α) :=
-⟨λ ⟨s, hs⟩, ⟨sᶜ, hs.compl⟩⟩
-
-@[simp]
-lemma mem_compl {s : L.definable_set A α} {x : α → M} : x ∈ sᶜ ↔ ¬ x ∈ s :=
-begin
-  cases s with s hs,
-  refl,
-end
-
-@[simp]
-lemma coe_compl {s : L.definable_set A α} : ((sᶜ : L.definable_set A α) : set (α → M)) = sᶜ :=
-begin
-  ext,
-  simp,
-end
 
 instance : boolean_algebra (L.definable_set A α) :=
-{ sdiff := λ s t, s ⊓ tᶜ,
-  sdiff_eq := λ s t, rfl,
-  sup_inf_sdiff := λ ⟨s, hs⟩ ⟨t, ht⟩,
-  begin
-    apply le_antisymm;
-    simp [le_iff],
-  end,
-  inf_inf_sdiff := λ ⟨s, hs⟩ ⟨t, ht⟩, begin
-    rw eq_bot_iff,
-    simp only [coe_compl, le_iff, coe_bot, coe_inf, subtype.coe_mk,
-      le_eq_subset],
-    intros x hx,
-    simp only [set.mem_inter_eq, mem_compl_eq] at hx,
-    tauto,
-  end,
-  inf_compl_le_bot := λ ⟨s, hs⟩, by simp [le_iff],
-  top_le_sup_compl := λ ⟨s, hs⟩, by simp [le_iff],
-  .. definable_set.has_compl,
-  .. definable_set.bounded_order,
-  .. definable_set.distrib_lattice }
+subtype.coe_injective.boolean_algebra _ coe_sup coe_inf coe_top coe_bot coe_compl coe_sdiff
 
 end definable_set
 end language
diff --git a/src/model_theory/direct_limit.lean b/src/model_theory/direct_limit.lean
index b228a91cfa896..7833595665f85 100644
--- a/src/model_theory/direct_limit.lean
+++ b/src/model_theory/direct_limit.lean
@@ -10,6 +10,9 @@ import model_theory.finitely_generated
 
 /-!
 # Direct Limits of First-Order Structures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file constructs the direct limit of a directed system of first-order embeddings.
 
 ## Main Definitions
diff --git a/src/model_theory/elementary_maps.lean b/src/model_theory/elementary_maps.lean
index 3a32fae56b587..4d014c5ae8aa8 100644
--- a/src/model_theory/elementary_maps.lean
+++ b/src/model_theory/elementary_maps.lean
@@ -9,6 +9,9 @@ import model_theory.substructures
 /-!
 # Elementary Maps Between First-Order Structures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 * A `first_order.language.elementary_embedding` is an embedding that commutes with the
   realizations of formulas.
@@ -38,11 +41,11 @@ variables [L.Structure M] [L.Structure N] [L.Structure P] [L.Structure Q]
   realizations of formulas. -/
 structure elementary_embedding :=
 (to_fun : M → N)
-(map_formula' : ∀{n} (φ : L.formula (fin n)) (x : fin n → M),
+(map_formula' : ∀ {{n}} (φ : L.formula (fin n)) (x : fin n → M),
   φ.realize (to_fun ∘ x) ↔ φ.realize x . obviously)
 
-localized "notation A ` ↪ₑ[`:25 L `] ` B := first_order.language.elementary_embedding L A B"
-  in first_order
+localized "notation (name := elementary_embedding)
+  A ` ↪ₑ[`:25 L `] ` B := first_order.language.elementary_embedding L A B" in first_order
 
 variables {L} {M} {N}
 
@@ -57,19 +60,44 @@ instance fun_like : fun_like (M ↪ₑ[L] N) M (λ _, N) :=
     ext x,
     exact function.funext_iff.1 h x end }
 
-@[simp] lemma map_formula (f : M ↪ₑ[L] N) {α : Type} [fintype α] (φ : L.formula α) (x : α → M) :
-  φ.realize (f ∘ x) ↔ φ.realize x :=
+instance : has_coe_to_fun (M ↪ₑ[L] N) (λ _, M → N) := fun_like.has_coe_to_fun
+
+@[simp] lemma map_bounded_formula (f : M ↪ₑ[L] N) {α : Type*} {n : ℕ}
+  (φ : L.bounded_formula α n) (v : α → M) (xs : fin n → M) :
+  φ.realize (f ∘ v) (f ∘ xs) ↔ φ.realize v xs :=
 begin
-  have g := fintype.equiv_fin α,
-  have h := f.map_formula' (φ.relabel g) (x ∘ g.symm),
-  rw [formula.realize_relabel, formula.realize_relabel, function.comp.assoc x g.symm g,
-    g.symm_comp_self, function.comp.right_id] at h,
-  rw [← h, iff_eq_eq],
-  congr,
-  ext y,
-  simp,
+  classical,
+  rw [← bounded_formula.realize_restrict_free_var set.subset.rfl, set.inclusion_eq_id, iff_eq_eq],
+  swap, { apply_instance },
+  have h := f.map_formula' ((φ.restrict_free_var id).to_formula.relabel (fintype.equiv_fin _))
+    ((sum.elim (v ∘ coe) xs) ∘ (fintype.equiv_fin _).symm),
+  simp only [formula.realize_relabel, bounded_formula.realize_to_formula, iff_eq_eq] at h,
+  rw [← function.comp.assoc _ _ ((fintype.equiv_fin _).symm),
+    function.comp.assoc _ ((fintype.equiv_fin _).symm) (fintype.equiv_fin _),
+    equiv.symm_comp_self, function.comp.right_id, function.comp.assoc, sum.elim_comp_inl,
+    function.comp.assoc _ _ sum.inr, sum.elim_comp_inr,
+    ← function.comp.assoc] at h,
+  refine h.trans _,
+  rw [function.comp.assoc _ _ (fintype.equiv_fin _), equiv.symm_comp_self,
+    function.comp.right_id, sum.elim_comp_inl, sum.elim_comp_inr, ← set.inclusion_eq_id,
+    bounded_formula.realize_restrict_free_var set.subset.rfl],
 end
 
+@[simp] lemma map_formula (f : M ↪ₑ[L] N) {α : Type*} (φ : L.formula α) (x : α → M) :
+  φ.realize (f ∘ x) ↔ φ.realize x :=
+by rw [formula.realize, formula.realize, ← f.map_bounded_formula, unique.eq_default (f ∘ default)]
+
+lemma map_sentence (f : M ↪ₑ[L] N) (φ : L.sentence) :
+  M ⊨ φ ↔ N ⊨ φ :=
+by rw [sentence.realize, sentence.realize, ← f.map_formula, unique.eq_default (f ∘ default)]
+
+lemma Theory_model_iff (f : M ↪ₑ[L] N) (T : L.Theory) :
+  M ⊨ T ↔ N ⊨ T :=
+by simp only [Theory.model_iff, f.map_sentence]
+
+lemma elementarily_equivalent (f : M ↪ₑ[L] N) : M ≅[L] N :=
+elementarily_equivalent_iff.2 f.map_sentence
+
 @[simp] lemma injective (φ : M ↪ₑ[L] N) :
   function.injective φ :=
 begin
@@ -82,10 +110,8 @@ begin
 end
 
 instance embedding_like : embedding_like (M ↪ₑ[L] N) M N :=
-{ injective' := injective }
-
-instance has_coe_to_fun : has_coe_to_fun (M ↪ₑ[L] N) (λ _, M → N) :=
-⟨λ f, f.to_fun⟩
+{ injective' := injective,
+  .. show fun_like (M ↪ₑ[L] N) M (λ _, N), from infer_instance }
 
 @[simp] lemma map_fun (φ : M ↪ₑ[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
   φ (fun_map f x) = fun_map f (φ ∘ x) :=
@@ -268,18 +294,18 @@ end
 /-- A substructure is elementary when every formula applied to a tuple in the subtructure
   agrees with its value in the overall structure. -/
 def is_elementary (S : L.substructure M) : Prop :=
-∀{n} (φ : L.formula (fin n)) (x : fin n → S), φ.realize ((coe : _ → M) ∘ x) ↔ φ.realize x
+∀ {{n}} (φ : L.formula (fin n)) (x : fin n → S), φ.realize ((coe : _ → M) ∘ x) ↔ φ.realize x
 
 end substructure
 
-variables (L) (M)
+variables (L M)
 /-- An elementary substructure is one in which every formula applied to a tuple in the subtructure
   agrees with its value in the overall structure. -/
 structure elementary_substructure :=
 (to_substructure : L.substructure M)
 (is_elementary' : to_substructure.is_elementary)
 
-variables {L} {M}
+variables {L M}
 
 namespace elementary_substructure
 
@@ -292,13 +318,16 @@ instance : set_like (L.elementary_substructure M) M :=
   exact h,
 end⟩
 
+instance induced_Structure (S : L.elementary_substructure M) : L.Structure S :=
+substructure.induced_Structure
+
 @[simp] lemma is_elementary (S : L.elementary_substructure M) :
   (S : L.substructure M).is_elementary := S.is_elementary'
 
 /-- The natural embedding of an `L.substructure` of `M` into `M`. -/
 def subtype (S : L.elementary_substructure M) : S ↪ₑ[L] M :=
 { to_fun := coe,
-  map_formula' := λ n, S.is_elementary }
+  map_formula' := S.is_elementary }
 
 @[simp] theorem coe_subtype {S : L.elementary_substructure M} : ⇑S.subtype = coe := rfl
 
@@ -314,12 +343,7 @@ instance : inhabited (L.elementary_substructure M) := ⟨⊤⟩
 
 @[simp] lemma realize_sentence (S : L.elementary_substructure M) (φ : L.sentence)  :
   S ⊨ φ ↔ M ⊨ φ :=
-begin
-  have h := S.is_elementary (φ.relabel (empty.elim : empty → fin 0)) default,
-  rw [formula.realize_relabel, formula.realize_relabel] at h,
-  exact (congr (congr rfl (congr rfl (unique.eq_default _))) (congr rfl (unique.eq_default _))).mp
-    h.symm,
-end
+S.subtype.map_sentence φ
 
 @[simp] lemma Theory_model_iff (S : L.elementary_substructure M) (T : L.Theory) :
   S ⊨ T ↔ M ⊨ T :=
@@ -331,6 +355,9 @@ instance Theory_model {T : L.Theory} [h : M ⊨ T] {S : L.elementary_substructur
 instance [h : nonempty M] {S : L.elementary_substructure M} : nonempty S :=
 (model_nonempty_theory_iff L).1 infer_instance
 
+lemma elementarily_equivalent (S : L.elementary_substructure M) : S ≅[L] M :=
+S.subtype.elementarily_equivalent
+
 end elementary_substructure
 
 namespace substructure
@@ -349,7 +376,7 @@ theorem is_elementary_of_exists (S : L.substructure M)
     φ.realize default (fin.snoc (coe ∘ x) a : _ → M) →
     ∃ b : S, φ.realize default (fin.snoc (coe ∘ x) b : _ → M)) :
   L.elementary_substructure M :=
-⟨S, λ _, S.is_elementary_of_exists htv⟩
+⟨S, S.is_elementary_of_exists htv⟩
 
 end substructure
 
diff --git a/src/model_theory/encoding.lean b/src/model_theory/encoding.lean
index 131d479944f9c..68e4c9e97bf9f 100644
--- a/src/model_theory/encoding.lean
+++ b/src/model_theory/encoding.lean
@@ -5,21 +5,25 @@ Authors: Aaron Anderson
 -/
 
 import computability.encoding
+import logic.small.list
 import model_theory.syntax
 import set_theory.cardinal.ordinal
 
 /-! # Encodings and Cardinality of First-Order Syntax
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 * `first_order.language.term.encoding` encodes terms as lists.
 * `first_order.language.bounded_formula.encoding` encodes bounded formulas as lists.
 
 ## Main Results
 * `first_order.language.term.card_le` shows that the number of terms in `L.term α` is at most
-`max ω # (α ⊕ Σ i, L.functions i)`.
+`max ℵ₀ # (α ⊕ Σ i, L.functions i)`.
 * `first_order.language.bounded_formula.card_le` shows that the number of bounded formulas in
 `Σ n, L.bounded_formula α n` is at most
-`max ω (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card)`.
+`max ℵ₀ (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card)`.
 
 ## TODO
 * `primcodable` instances for terms and formulas, based on the `encoding`s
@@ -73,7 +77,7 @@ begin
         (fin_range n).map (option.some ∘ ts) ++ list_decode l,
       { induction (fin_range n) with i l' l'ih,
         { refl },
-        { rw [cons_bind, append_assoc, ih, map_cons, l'ih, cons_append] } },
+        { rw [cons_bind, list.append_assoc, ih, map_cons, l'ih, cons_append] } },
       have h' : ∀ i, (list_decode ((fin_range n).bind (λ (i : fin n), (ts i).list_encode) ++ l)).nth
         ↑i = some (some (ts i)),
       { intro i,
@@ -106,25 +110,23 @@ lemma list_encode_injective :
   function.injective (list_encode : L.term α → list (α ⊕ Σ i, L.functions i)) :=
 term.encoding.encode_injective
 
-theorem card_le : # (L.term α) ≤ max ω (# (α ⊕ Σ i, L.functions i)) :=
+theorem card_le : # (L.term α) ≤ max ℵ₀ (# (α ⊕ Σ i, L.functions i)) :=
 lift_le.1 (trans term.encoding.card_le_card_list (lift_le.2 (mk_list_le_max _)))
 
-theorem card_sigma : # (Σ n, (L.term (α ⊕ fin n))) = max ω (# (α ⊕ Σ i, L.functions i)) :=
+theorem card_sigma : # (Σ n, (L.term (α ⊕ fin n))) = max ℵ₀ (# (α ⊕ Σ i, L.functions i)) :=
 begin
   refine le_antisymm _ _,
-  { rw [mk_sigma],
-    refine (sum_le_sup_lift _).trans _,
-    rw [mk_nat, lift_omega, mul_eq_max_of_omega_le_left le_rfl, max_le_iff, cardinal.sup_le_iff],
+  { rw mk_sigma,
+    refine (sum_le_supr_lift _).trans _,
+    rw [mk_nat, lift_aleph_0, mul_eq_max_of_aleph_0_le_left le_rfl, max_le_iff,
+      csupr_le_iff' (bdd_above_range _)],
     { refine ⟨le_max_left _ _, λ i, card_le.trans _⟩,
-      rw max_le_iff,
-      refine ⟨le_max_left _ _, _⟩,
+      refine max_le (le_max_left _ _) _,
       rw [← add_eq_max le_rfl, mk_sum, mk_sum, mk_sum, add_comm (cardinal.lift (#α)), lift_add,
-        add_assoc, lift_lift, lift_lift],
-      refine add_le_add_right _ _,
-      rw [lift_le_omega, ← encodable_iff],
-      exact ⟨infer_instance⟩ },
+        add_assoc, lift_lift, lift_lift, mk_fin, lift_nat_cast],
+      exact add_le_add_right (nat_lt_aleph_0 _).le _ },
     { rw [← one_le_iff_ne_zero],
-      refine trans _ (le_sup _ 1),
+      refine trans _ (le_csupr (bdd_above_range _) 1),
       rw [one_le_iff_ne_zero, mk_ne_zero_iff],
       exact ⟨var (sum.inr 0)⟩ } },
   { rw [max_le_iff, ← infinite_iff],
@@ -153,13 +155,12 @@ encodable.of_left_injection list_encode (λ l, (list_decode l).head'.join)
     simp only [option.join, head', list.map, option.some_bind, id.def],
   end)
 
-lemma card_le_omega [h1 : nonempty (encodable α)] [h2 : L.countable_functions] :
-  # (L.term α) ≤ ω :=
+instance [h1 : countable α] [h2 : countable (Σl, L.functions l)] :
+  countable (L.term α) :=
 begin
-  refine (card_le.trans _),
-  rw [max_le_iff],
-  simp only [le_refl, mk_sum, add_le_omega, lift_le_omega, true_and],
-  exact ⟨encodable_iff.1 h1, L.card_functions_le_omega⟩,
+  refine mk_le_aleph_0_iff.1 (card_le.trans (max_le_iff.2 _)),
+  simp only [le_refl, mk_sum, add_le_aleph_0, lift_le_aleph_0, true_and],
+  exact ⟨cardinal.mk_le_aleph_0, cardinal.mk_le_aleph_0⟩,
 end
 
 instance small [small.{u} α] :
@@ -270,7 +271,7 @@ begin
         rw [list.drop_append_eq_append_drop, length_map, length_fin_range, nat.sub_self, drop,
           drop_eq_nil_of_le, nil_append],
         rw [length_map, length_fin_range], }, },
-    { rw [list_encode, append_assoc, cons_append, list_decode],
+    { rw [list_encode, list.append_assoc, cons_append, list_decode],
       simp only [subtype.val_eq_coe] at *,
       rw [(ih1 _).1, (ih1 _).2, (ih2 _).1, (ih2 _).2, sigma_imp, dif_pos rfl],
       exact ⟨rfl, rfl⟩, },
@@ -298,14 +299,15 @@ lemma list_encode_sigma_injective :
 bounded_formula.encoding.encode_injective
 
 theorem card_le : # (Σ n, L.bounded_formula α n) ≤
-  max ω (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card) :=
+  max ℵ₀ (cardinal.lift.{max u v} (#α) + cardinal.lift.{u'} L.card) :=
 begin
   refine lift_le.1 ((bounded_formula.encoding.card_le_card_list).trans _),
-  rw [encoding_Γ, mk_list_eq_max_mk_omega, lift_max',lift_omega, lift_max', lift_omega, max_le_iff],
+  rw [encoding_Γ, mk_list_eq_max_mk_aleph_0, lift_max, lift_aleph_0, lift_max, lift_aleph_0,
+    max_le_iff],
   refine ⟨_, le_max_left _ _⟩,
   rw [mk_sum, term.card_sigma, mk_sum, ← add_eq_max le_rfl, mk_sum, mk_nat],
-  simp only [lift_add, lift_lift, lift_omega],
-  rw [← add_assoc, add_comm, ← add_assoc, ← add_assoc, omega_add_omega, add_assoc,
+  simp only [lift_add, lift_lift, lift_aleph_0],
+  rw [← add_assoc, add_comm, ← add_assoc, ← add_assoc, aleph_0_add_aleph_0, add_assoc,
     add_eq_max le_rfl, add_assoc, card, symbols, mk_sum, lift_add, lift_lift, lift_lift],
 end
 
diff --git a/src/model_theory/finitely_generated.lean b/src/model_theory/finitely_generated.lean
index 1ce88447d7115..2eee09bdd08a2 100644
--- a/src/model_theory/finitely_generated.lean
+++ b/src/model_theory/finitely_generated.lean
@@ -7,6 +7,9 @@ import model_theory.substructures
 
 /-!
 # Finitely Generated First-Order Structures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines what it means for a first-order (sub)structure to be finitely or countably
 generated, similarly to other finitely-generated objects in the algebra library.
 
@@ -60,7 +63,7 @@ end
 theorem fg_bot : (⊥ : L.substructure M).fg :=
 ⟨∅, by rw [finset.coe_empty, closure_empty]⟩
 
-theorem fg_closure {s : set M} (hs : finite s) : fg (closure L s) :=
+theorem fg_closure {s : set M} (hs : s.finite) : fg (closure L s) :=
 ⟨hs.to_finset, by rw [hs.coe_to_finset]⟩
 
 theorem fg_closure_singleton (x : M) : fg (closure L ({x} : set M)) :=
@@ -111,7 +114,7 @@ begin
   { rintros ⟨S, Scount, hS⟩,
     cases eq_empty_or_nonempty ↑N with h h,
     { exact or.intro_left _ h },
-    obtain ⟨f, h'⟩ := (Scount.union (set.countable_singleton h.some)).exists_surjective
+    obtain ⟨f, h'⟩ := (Scount.union (set.countable_singleton h.some)).exists_eq_range
       (singleton_nonempty h.some).inr,
     refine or.intro_right _ ⟨f, _⟩,
     rw [← h', closure_union, hS, sup_eq_left, closure_le],
@@ -156,10 +159,10 @@ begin
   exact hom.map_le_range h'
 end
 
-theorem cg_iff_countable [L.countable_functions] {s : L.substructure M} :
-  s.cg ↔ nonempty (encodable s) :=
+theorem cg_iff_countable [countable (Σl, L.functions l)] {s : L.substructure M} :
+  s.cg ↔ countable s :=
 begin
-  refine ⟨_, λ h, ⟨s, h, s.closure_eq⟩⟩,
+  refine ⟨_, λ h, ⟨s, h.to_set, s.closure_eq⟩⟩,
   rintro ⟨s, h, rfl⟩,
   exact h.substructure_closure L
 end
@@ -224,10 +227,8 @@ begin
   exact h.range f,
 end
 
-lemma cg_iff_countable [L.countable_functions] :
-  cg L M ↔ nonempty (encodable M) :=
-by rw [cg_def, cg_iff_countable, cardinal.encodable_iff, cardinal.encodable_iff,
-  top_equiv.to_equiv.cardinal_eq]
+lemma cg_iff_countable [countable (Σl, L.functions l)] : cg L M ↔ countable M :=
+by rw [cg_def, cg_iff_countable, top_equiv.to_equiv.countable_iff]
 
 lemma fg.cg (h : fg L M) : cg L M :=
 cg_def.2 (fg_def.1 h).cg
diff --git a/src/model_theory/fraisse.lean b/src/model_theory/fraisse.lean
index d4cd022be841e..2f372ad156a27 100644
--- a/src/model_theory/fraisse.lean
+++ b/src/model_theory/fraisse.lean
@@ -11,6 +11,9 @@ import model_theory.bundled
 /-!
 # Fraïssé Classes and Fraïssé Limits
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file pertains to the ages of countable first-order structures. The age of a structure is the
 class of all finitely-generated structures that embed into it.
 
@@ -146,21 +149,20 @@ lemma age.joint_embedding : joint_embedding (L.age M) :=
 
 /-- The age of a countable structure is essentially countable (has countably many isomorphism
 classes). -/
-lemma age.countable_quotient (h : (univ : set M).countable) :
-  (quotient.mk '' (L.age M)).countable :=
+lemma age.countable_quotient [h : countable M] :
+  (quotient.mk '' L.age M).countable :=
 begin
-  refine eq.mp (congr rfl (set.ext _)) ((countable_set_of_finite_subset h).image
-    (λ s, ⟦⟨closure L s, infer_instance⟩⟧)),
-  rw forall_quotient_iff,
-  intro N,
-  simp only [subset_univ, and_true, mem_image, mem_set_of_eq, quotient.eq],
+  classical,
+  refine (congr_arg _ (set.ext $ forall_quotient_iff.2 $ λ N, _)).mp
+    (countable_range $ λ s : finset M, ⟦⟨closure L (s : set M), infer_instance⟩⟧),
+  simp only [mem_image, mem_range, mem_set_of_eq, quotient.eq],
   split,
-  { rintro ⟨s, hs1, hs2⟩,
-    use bundled.of ↥(closure L s),
-    exact ⟨⟨(fg_iff_Structure_fg _).1 (fg_closure hs1), ⟨subtype _⟩⟩, hs2⟩ },
+  { rintro ⟨s, hs⟩,
+    use bundled.of ↥(closure L (s : set M)),
+    exact ⟨⟨(fg_iff_Structure_fg _).1 (fg_closure s.finite_to_set), ⟨subtype _⟩⟩, hs⟩ },
   { rintro ⟨P, ⟨⟨s, hs⟩, ⟨PM⟩⟩, hP2⟩,
-    refine ⟨PM '' s, set.finite.image PM s.finite_to_set, setoid.trans _ hP2⟩,
-    rw [← embedding.coe_to_hom, closure_image PM.to_hom, hs, ← hom.range_eq_map],
+    refine ⟨s.image PM, setoid.trans _ hP2⟩,
+    rw [← embedding.coe_to_hom, finset.coe_image, closure_image PM.to_hom, hs, ← hom.range_eq_map],
     exact ⟨PM.equiv_range.symm⟩ }
 end
 
@@ -200,7 +202,7 @@ theorem exists_cg_is_age_of (hn : K.nonempty)
   (jep : joint_embedding K) :
   ∃ (M : bundled.{w} L.Structure), Structure.cg L M ∧ L.age M = K :=
 begin
-  obtain ⟨F, hF⟩ := hc.exists_surjective (hn.image _),
+  obtain ⟨F, hF⟩ := hc.exists_eq_range (hn.image _),
   simp only [set.ext_iff, forall_quotient_iff, mem_image, mem_range, quotient.eq] at hF,
   simp_rw [quotient.eq_mk_iff_out] at hF,
   have hF' : ∀ n : ℕ, (F n).out ∈ K,
@@ -221,8 +223,8 @@ begin
   { exact (hFP _ n).some }
 end
 
-theorem exists_countable_is_age_of_iff [L.countable_functions] :
-  (∃ (M : bundled.{w} L.Structure), (univ : set M).countable ∧ L.age M = K) ↔
+theorem exists_countable_is_age_of_iff [countable (Σl, L.functions l)] :
+  (∃ (M : bundled.{w} L.Structure), countable M ∧ L.age M = K) ↔
     K.nonempty ∧
     (∀ (M N : bundled.{w} L.Structure), nonempty (M ≃[L] N) → (M ∈ K ↔ N ∈ K)) ∧
     (quotient.mk '' K).countable ∧
@@ -233,12 +235,11 @@ begin
   split,
   { rintros ⟨M, h1, h2, rfl⟩,
     resetI,
-    refine ⟨age.nonempty M, age.is_equiv_invariant L M, age.countable_quotient M h1, λ N hN, hN.1,
+    refine ⟨age.nonempty M, age.is_equiv_invariant L M, age.countable_quotient M, λ N hN, hN.1,
       age.hereditary M, age.joint_embedding M⟩, },
   { rintros ⟨Kn, eqinv, cq, hfg, hp, jep⟩,
     obtain ⟨M, hM, rfl⟩ := exists_cg_is_age_of Kn eqinv cq hfg hp jep,
-    haveI := ((Structure.cg_iff_countable).1 hM).some,
-    refine ⟨M, countable_encodable _, rfl⟩, }
+    exact ⟨M, Structure.cg_iff_countable.1 hM, rfl⟩ }
 end
 
 variables {K} (L) (M)
@@ -253,9 +254,9 @@ variables {L} (K)
 
 /-- A structure `M` is a Fraïssé limit for a class `K` if it is countably generated,
 ultrahomogeneous, and has age `K`. -/
-structure is_fraisse_limit [countable_functions L] : Prop :=
+@[protect_proj] structure is_fraisse_limit [countable (Σl, L.functions l)]
+  [countable M] : Prop :=
 (ultrahomogeneous : is_ultrahomogeneous L M)
-(countable : (univ : set M).countable)
 (age : L.age M = K)
 
 variables {L} {M}
@@ -279,17 +280,18 @@ begin
     set.coe_inclusion, embedding.equiv_range_apply, hgn],
 end
 
-lemma is_ultrahomogeneous.age_is_fraisse (hc : (univ : set M).countable)
+lemma is_ultrahomogeneous.age_is_fraisse [countable M]
   (h : L.is_ultrahomogeneous M) :
   is_fraisse (L.age M) :=
-⟨age.nonempty M, λ _ hN, hN.1, age.is_equiv_invariant L M, age.countable_quotient M hc,
+⟨age.nonempty M, λ _ hN, hN.1, age.is_equiv_invariant L M, age.countable_quotient M,
   age.hereditary M, age.joint_embedding M, h.amalgamation_age⟩
 
 namespace is_fraisse_limit
 
 /-- If a class has a Fraïssé limit, it must be Fraïssé. -/
-theorem is_fraisse [countable_functions L] (h : is_fraisse_limit K M) : is_fraisse K :=
-(congr rfl h.age).mp (h.ultrahomogeneous.age_is_fraisse h.countable)
+theorem is_fraisse [countable (Σl, L.functions l)] [countable M] (h : is_fraisse_limit K M) :
+  is_fraisse K :=
+(congr rfl h.age).mp h.ultrahomogeneous.age_is_fraisse
 
 end is_fraisse_limit
 
diff --git a/src/model_theory/graph.lean b/src/model_theory/graph.lean
index e5d2763808457..f95115deb3c5f 100644
--- a/src/model_theory/graph.lean
+++ b/src/model_theory/graph.lean
@@ -8,6 +8,9 @@ import combinatorics.simple_graph.basic
 
 /-!
 # First-Ordered Structures in Graph Theory
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines first-order languages, structures, and theories in graph theory.
 
 ## Main Definitions
diff --git a/src/model_theory/language_map.lean b/src/model_theory/language_map.lean
index dc0668eb06cff..a6a5e85c3d534 100644
--- a/src/model_theory/language_map.lean
+++ b/src/model_theory/language_map.lean
@@ -6,6 +6,9 @@ Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
 import model_theory.basic
 /-!
 # Language Maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 Maps between first-order languages in the style of the
 [Flypitch project](https://flypitch.github.io/), as well as several important maps between
 structures.
@@ -27,18 +30,19 @@ the continuum hypothesis*][flypitch_itp]
 
 -/
 
-universes u v u' v' w
+universes u v u' v' w w'
 
 namespace first_order
 namespace language
-open Structure
+open Structure cardinal
+open_locale cardinal
 
 variables (L : language.{u v}) (L' : language.{u' v'}) {M : Type w} [L.Structure M]
 
 /-- A language homomorphism maps the symbols of one language to symbols of another. -/
 structure Lhom :=
-(on_function : ∀{n}, L.functions n → L'.functions n)
-(on_relation : ∀{n}, L.relations n → L'.relations n)
+(on_function : ∀ ⦃n⦄, L.functions n → L'.functions n)
+(on_relation : ∀ ⦃n⦄, L.relations n → L'.relations n)
 
 infix ` →ᴸ `:10 := Lhom -- \^L
 
@@ -107,7 +111,7 @@ Lhom.funext (funext (λ n, nat.cases_on n (funext h0) (λ n, nat.cases_on n (fun
 @[simps] def comp (g : L' →ᴸ L'') (f : L →ᴸ L') : L →ᴸ L'' :=
 ⟨λ n F, g.1 (f.1 F), λ _ R, g.2 (f.2 R)⟩
 
-local infix ` ∘ `:60 := Lhom.comp
+local infix (name := Lhom.comp) ` ∘ `:60 := Lhom.comp
 
 @[simp] lemma id_comp (F : L →ᴸ L') : (Lhom.id L') ∘ F = F :=
 by {cases F, refl}
@@ -167,8 +171,19 @@ end sum_map
 
 /-- A language homomorphism is injective when all the maps between symbol types are. -/
 protected structure injective : Prop :=
-(on_function {n} : function.injective (on_function ϕ : L.functions n → L'.functions n))
-(on_relation {n} : function.injective (on_relation ϕ : L.relations n → L'.relations n))
+(on_function {n} : function.injective (λ f : L.functions n, on_function ϕ f))
+(on_relation {n} : function.injective (λ R : L.relations n, on_relation ϕ R))
+
+/-- Pulls a `L`-structure along a language map `ϕ : L →ᴸ L'`, and then expands it
+  to an `L'`-structure arbitrarily. -/
+noncomputable def default_expansion (ϕ : L →ᴸ L')
+  [∀ n (f : L'.functions n), decidable (f ∈ set.range (λ (f : L.functions n), on_function ϕ f))]
+  [∀ n (r : L'.relations n), decidable (r ∈ set.range (λ (r : L.relations n), on_relation ϕ r))]
+  (M : Type*) [inhabited M] [L.Structure M] : L'.Structure M :=
+{ fun_map := λ n f xs, if h' : f ∈ set.range (λ (f : L.functions n), on_function ϕ f) then
+    fun_map h'.some xs else default,
+  rel_map := λ n r xs, if h' : r ∈ set.range (λ (r : L.relations n), on_relation ϕ r) then
+    rel_map h'.some xs else default }
 
 /-- A language homomorphism is an expansion on a structure if it commutes with the interpretation of
 all symbols on that structure. -/
@@ -178,7 +193,17 @@ class is_expansion_on (M : Type*) [L.Structure M] [L'.Structure M] : Prop :=
 (map_on_relation : ∀ {n} (R : L.relations n) (x : fin n → M),
   rel_map (ϕ.on_relation R) x = rel_map R x)
 
-attribute [simp] is_expansion_on.map_on_function is_expansion_on.map_on_relation
+@[simp] lemma map_on_function {M : Type*}
+  [L.Structure M] [L'.Structure M] [ϕ.is_expansion_on M]
+  {n} (f : L.functions n) (x : fin n → M) :
+  fun_map (ϕ.on_function f) x = fun_map f x :=
+is_expansion_on.map_on_function f x
+
+@[simp] lemma map_on_relation {M : Type*}
+  [L.Structure M] [L'.Structure M] [ϕ.is_expansion_on M]
+  {n} (R : L.relations n) (x : fin n → M) :
+  rel_map (ϕ.on_relation R) x = rel_map R x :=
+is_expansion_on.map_on_relation R x
 
 instance id_is_expansion_on (M : Type*) [L.Structure M] : is_expansion_on (Lhom.id L) M :=
 ⟨λ _ _ _, rfl, λ _ _ _, rfl⟩
@@ -210,6 +235,24 @@ instance sum_inr_is_expansion_on (M : Type*)
   (Lhom.sum_inr : L' →ᴸ L.sum L').is_expansion_on M :=
 ⟨λ _ f _, rfl, λ _ R _, rfl⟩
 
+@[simp] lemma fun_map_sum_inl [(L.sum L').Structure M]
+  [(Lhom.sum_inl : L →ᴸ L.sum L').is_expansion_on M]
+  {n} {f : L.functions n} {x : fin n → M} :
+  @fun_map (L.sum L') M _ n (sum.inl f) x = fun_map f x :=
+(Lhom.sum_inl : L →ᴸ L.sum L').map_on_function f x
+
+@[simp] lemma fun_map_sum_inr [(L'.sum L).Structure M]
+  [(Lhom.sum_inr : L →ᴸ L'.sum L).is_expansion_on M]
+  {n} {f : L.functions n} {x : fin n → M} :
+  @fun_map (L'.sum L) M _ n (sum.inr f) x = fun_map f x :=
+(Lhom.sum_inr : L →ᴸ L'.sum L).map_on_function f x
+
+lemma sum_inl_injective : (Lhom.sum_inl : L →ᴸ L.sum L').injective :=
+⟨λ n, sum.inl_injective, λ n, sum.inl_injective⟩
+
+lemma sum_inr_injective : (Lhom.sum_inr : L' →ᴸ L.sum L').injective :=
+⟨λ n, sum.inr_injective, λ n, sum.inr_injective⟩
+
 @[priority 100] instance is_expansion_on_reduct (ϕ : L →ᴸ L') (M : Type*) [L'.Structure M] :
   @is_expansion_on L L' ϕ M (ϕ.reduct M) _ :=
 begin
@@ -217,6 +260,22 @@ begin
   exact ⟨λ _ f _, rfl, λ _ R _, rfl⟩,
 end
 
+lemma injective.is_expansion_on_default {ϕ : L →ᴸ L'}
+  [∀ n (f : L'.functions n), decidable (f ∈ set.range (λ (f : L.functions n), on_function ϕ f))]
+  [∀ n (r : L'.relations n), decidable (r ∈ set.range (λ (r : L.relations n), on_relation ϕ r))]
+  (h : ϕ.injective) (M : Type*) [inhabited M] [L.Structure M] :
+  @is_expansion_on L L' ϕ M _ (ϕ.default_expansion M) :=
+begin
+  letI := ϕ.default_expansion M,
+  refine ⟨λ n f xs, _, λ n r xs, _⟩,
+  { have hf : ϕ.on_function f ∈ set.range (λ (f : L.functions n), ϕ.on_function f) := ⟨f, rfl⟩,
+    refine (dif_pos hf).trans _,
+    rw h.on_function hf.some_spec },
+  { have hr : ϕ.on_relation r ∈ set.range (λ (r : L.relations n), ϕ.on_relation r) := ⟨r, rfl⟩,
+    refine (dif_pos hr).trans _,
+    rw h.on_relation hr.some_spec },
+end
+
 end Lhom
 
 /-- A language equivalence maps the symbols of one language to symbols of another bijectively. -/
@@ -257,36 +316,36 @@ end Lequiv
 section constants_on
 variables (α : Type u')
 
-/-- The function symbols of a language with constants indexed by a type. -/
-def constants_on_functions : ℕ → Type u'
-| 0 := α
-| _ := pempty
-
-instance [h : inhabited α] : inhabited (constants_on_functions α 0) := h
-
 /-- A language with constants indexed by a type. -/
-def constants_on : language.{u' 0} := ⟨constants_on_functions α, λ _, empty⟩
+@[simp] def constants_on : language.{u' 0} :=
+  language.mk₂ α pempty pempty pempty pempty
 
 variables {α}
 
-@[simp] lemma constants_on_constants : (constants_on α).constants = α := rfl
+lemma constants_on_constants : (constants_on α).constants = α := rfl
 
 instance is_algebraic_constants_on : is_algebraic (constants_on α) :=
-language.is_algebraic_of_empty_relations
+language.is_algebraic_mk₂
 
 instance is_relational_constants_on [ie : is_empty α] : is_relational (constants_on α) :=
-⟨λ n, nat.cases_on n ie (λ _, pempty.is_empty)⟩
+language.is_relational_mk₂
+
+instance is_empty_functions_constants_on_succ {n : ℕ} :
+  is_empty ((constants_on α).functions (n + 1)) :=
+nat.cases_on n pempty.is_empty (λ n, nat.cases_on n pempty.is_empty (λ _, pempty.is_empty))
+
+lemma card_constants_on : (constants_on α).card = # α :=
+by simp
 
 /-- Gives a `constants_on α` structure to a type by assigning each constant a value. -/
 def constants_on.Structure (f : α → M) : (constants_on α).Structure M :=
-{ fun_map := λ n, nat.cases_on n (λ a _, f a) (λ _, pempty.elim),
-  rel_map := λ _, empty.elim }
+Structure.mk₂ f pempty.elim pempty.elim pempty.elim pempty.elim
 
 variables {β : Type v'}
 
 /-- A map between index types induces a map between constant languages. -/
 def Lhom.constants_on_map (f : α → β) : (constants_on α) →ᴸ (constants_on β) :=
-⟨λ n, nat.cases_on n f (λ _, pempty.elim), λ n, empty.elim⟩
+Lhom.mk₂ f pempty.elim pempty.elim pempty.elim pempty.elim
 
 lemma constants_on_map_is_expansion_on {f : α → β} {fα : α → M} {fβ : β → M}
   (h : fβ ∘ f = fα) :
@@ -295,8 +354,8 @@ lemma constants_on_map_is_expansion_on {f : α → β} {fα : α → M} {fβ : 
 begin
   letI := constants_on.Structure fα,
   letI := constants_on.Structure fβ,
-  exact ⟨λ n, nat.cases_on n (λ F x, (congr_fun h F : _)) (λ n F, pempty.elim F),
-    λ _ R, empty.elim R⟩,
+  exact ⟨λ n, nat.cases_on n (λ F x, (congr_fun h F : _)) (λ n F, is_empty_elim F),
+    λ _ R, is_empty_elim R⟩
 end
 
 end constants_on
@@ -306,16 +365,24 @@ section with_constants
 variable (L)
 
 section
-variables (α : Type w)
+variables (α : Type w')
 
 /-- Extends a language with a constant for each element of a parameter set in `M`. -/
-def with_constants : language.{(max u w) v} := L.sum (constants_on α)
+def with_constants : language.{(max u w') v} := L.sum (constants_on α)
 
-localized "notation L`[[`:95 α`]]`:90 := L.with_constants α" in first_order
+localized "notation (name := language.with_constants)
+  L`[[`:95 α`]]`:90 := L.with_constants α" in first_order
+
+@[simp] lemma card_with_constants :
+  (L[[α]]).card = cardinal.lift.{w'} L.card + cardinal.lift.{max u v} (# α) :=
+by rw [with_constants, card_sum, card_constants_on]
 
 /-- The language map adding constants.  -/
 @[simps] def Lhom_with_constants : L →ᴸ L[[α]] := Lhom.sum_inl
 
+lemma Lhom_with_constants_injective : (L.Lhom_with_constants α).injective :=
+Lhom.sum_inl_injective
+
 variables {α}
 
 /-- The constant symbol indexed by a particular element. -/
@@ -341,6 +408,18 @@ variables (L) (α)
 
 variables {α} {β : Type*}
 
+@[simp] lemma with_constants_fun_map_sum_inl [L[[α]].Structure M]
+  [(Lhom_with_constants L α).is_expansion_on M]
+  {n} {f : L.functions n} {x : fin n → M} :
+  @fun_map (L[[α]]) M _ n (sum.inl f) x = fun_map f x :=
+(Lhom_with_constants L α).map_on_function f x
+
+@[simp] lemma with_constants_rel_map_sum_inl [L[[α]].Structure M]
+  [(Lhom_with_constants L α).is_expansion_on M]
+  {n} {R : L.relations n} {x : fin n → M} :
+  @rel_map (L[[α]]) M _ n (sum.inl R) x = rel_map R x :=
+(Lhom_with_constants L α).map_on_relation R x
+
 /-- The language map extending the constant set.  -/
 def Lhom_with_constants_map (f : α → β) : L[[α]] →ᴸ L[[β]] :=
 Lhom.sum_map (Lhom.id L) (Lhom.constants_on_map f)
@@ -383,6 +462,13 @@ instance add_constants_expansion {L' : language} [L'.Structure M] (φ : L →ᴸ
   (φ.add_constants α).is_expansion_on M :=
 Lhom.sum_map_is_expansion_on _ _ M
 
+@[simp] lemma with_constants_fun_map_sum_inr {a : α} {x : fin 0 → M} :
+  @fun_map (L[[α]]) M _ 0 (sum.inr a : L[[α]].functions 0) x = L.con a :=
+begin
+  rw unique.eq_default x,
+  exact (Lhom.sum_inr : (constants_on α) →ᴸ L.sum _).map_on_function _ _,
+end
+
 variables {α} (A : set M)
 
 @[simp] lemma coe_con {a : A} : ((L.con a) : M) = a := rfl
diff --git a/src/model_theory/order.lean b/src/model_theory/order.lean
index f483e7782e196..d610e1d92fa01 100644
--- a/src/model_theory/order.lean
+++ b/src/model_theory/order.lean
@@ -7,6 +7,9 @@ import model_theory.semantics
 
 /-!
 # Ordered First-Ordered Structures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines ordered first-order languages and structures, as well as their theories.
 
 ## Main Definitions
@@ -14,13 +17,13 @@ This file defines ordered first-order languages and structures, as well as their
 * `first_order.language.order_Structure` is the structure on an ordered type, assigning the symbol
 representing `≤` to the actual relation `≤`.
 * `first_order.language.is_ordered` points out a specific symbol in a language as representing `≤`.
-* `first_order.language.is_ordered_structure` indicates that a structure over a
-* `first_order.language.Theory.linear_order` and similar define the theories of preorders,
+* `first_order.language.ordered_structure` indicates that the `≤` symbol in an ordered language
+is interpreted as the actual relation `≤` in a particular structure.
+* `first_order.language.linear_order_theory` and similar define the theories of preorders,
 partial orders, and linear orders.
-* `first_order.language.Theory.DLO` defines the theory of dense linear orders without endpoints, a
+* `first_order.language.DLO` defines the theory of dense linear orders without endpoints, a
 particularly useful example in model theory.
 
-
 ## Main Results
 * `partial_order`s model the theory of partial orders, `linear_order`s model the theory of
 linear orders, and dense linear orders without endpoints model `Theory.DLO`.
@@ -40,11 +43,11 @@ variables {L : language.{u v}} {α : Type w} {M : Type w'} {n : ℕ}
 protected def order : language :=
 language.mk₂ empty empty empty empty unit
 
-namespace order
-
-instance Structure [has_le M] : language.order.Structure M :=
+instance order_Structure [has_le M] : language.order.Structure M :=
 Structure.mk₂ empty.elim empty.elim empty.elim empty.elim (λ _, (≤))
 
+namespace order
+
 instance : is_relational (language.order) := language.is_relational_mk₂
 
 instance : subsingleton (language.order.relations n) :=
@@ -89,108 +92,114 @@ Lhom.funext (subsingleton.elim _ _) (subsingleton.elim _ _)
 
 instance : is_ordered (L.sum language.order) := ⟨sum.inr is_ordered.le_symb⟩
 
+section
+variables (L) [is_ordered L]
+
 /-- The theory of preorders. -/
-protected def Theory.preorder : language.order.Theory :=
+def preorder_theory : L.Theory :=
 {le_symb.reflexive, le_symb.transitive}
 
 /-- The theory of partial orders. -/
-protected def Theory.partial_order : language.order.Theory :=
+def partial_order_theory : L.Theory :=
 {le_symb.reflexive, le_symb.antisymmetric, le_symb.transitive}
 
 /-- The theory of linear orders. -/
-protected def Theory.linear_order : language.order.Theory :=
+def linear_order_theory : L.Theory :=
 {le_symb.reflexive, le_symb.antisymmetric, le_symb.transitive, le_symb.total}
 
 /-- A sentence indicating that an order has no top element:
 $\forall x, \exists y, \neg y \le x$.   -/
-protected def sentence.no_top_order : language.order.sentence := ∀' ∃' ∼ ((&1).le &0)
+def no_top_order_sentence : L.sentence := ∀' ∃' ∼ ((&1).le &0)
 
 /-- A sentence indicating that an order has no bottom element:
 $\forall x, \exists y, \neg x \le y$. -/
-protected def sentence.no_bot_order : language.order.sentence := ∀' ∃' ∼ ((&0).le &1)
+def no_bot_order_sentence : L.sentence := ∀' ∃' ∼ ((&0).le &1)
 
 /-- A sentence indicating that an order is dense:
 $\forall x, \forall y, x < y \to \exists z, x < z \wedge z < y$. -/
-protected def sentence.densely_ordered : language.order.sentence :=
+def densely_ordered_sentence : L.sentence :=
 ∀' ∀' (((&0).lt &1) ⟹ (∃' (((&0).lt &2) ⊓ ((&2).lt &1))))
 
 /-- The theory of dense linear orders without endpoints. -/
-protected def Theory.DLO : language.order.Theory :=
-Theory.linear_order ∪ {sentence.no_top_order, sentence.no_bot_order, sentence.densely_ordered}
+def DLO : L.Theory :=
+L.linear_order_theory ∪
+  {L.no_top_order_sentence, L.no_bot_order_sentence, L.densely_ordered_sentence}
+
+end
 
 variables (L M)
 
 /-- A structure is ordered if its language has a `≤` symbol whose interpretation is -/
-abbreviation is_ordered_structure [is_ordered L] [has_le M] [L.Structure M] : Prop :=
+abbreviation ordered_structure [is_ordered L] [has_le M] [L.Structure M] : Prop :=
 Lhom.is_expansion_on (order_Lhom L) M
 
 variables {L M}
 
-@[simp] lemma is_ordered_structure_iff [is_ordered L] [has_le M] [L.Structure M] :
-  L.is_ordered_structure M ↔ Lhom.is_expansion_on (order_Lhom L) M := iff.rfl
+@[simp] lemma ordered_structure_iff [is_ordered L] [has_le M] [L.Structure M] :
+  L.ordered_structure M ↔ Lhom.is_expansion_on (order_Lhom L) M := iff.rfl
 
-instance is_ordered_structure_has_le [has_le M] :
-  is_ordered_structure language.order M :=
+instance ordered_structure_has_le [has_le M] :
+  ordered_structure language.order M :=
 begin
-  rw [is_ordered_structure_iff, order_Lhom_order],
+  rw [ordered_structure_iff, order_Lhom_order],
   exact Lhom.id_is_expansion_on M,
 end
 
 instance model_preorder [preorder M] :
-  M ⊨ Theory.preorder :=
+  M ⊨ language.order.preorder_theory :=
 begin
-  simp only [Theory.preorder, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
+  simp only [preorder_theory, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
     forall_eq_or_imp, relations.realize_reflexive, rel_map_apply₂, forall_eq,
     relations.realize_transitive],
   exact ⟨le_refl, λ _ _ _, le_trans⟩
 end
 
 instance model_partial_order [partial_order M] :
-  M ⊨ Theory.partial_order :=
+  M ⊨ language.order.partial_order_theory :=
 begin
-  simp only [Theory.partial_order, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
+  simp only [partial_order_theory, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
     forall_eq_or_imp, relations.realize_reflexive, rel_map_apply₂, relations.realize_antisymmetric,
     forall_eq, relations.realize_transitive],
   exact ⟨le_refl, λ _ _, le_antisymm, λ _ _ _, le_trans⟩,
 end
 
 instance model_linear_order [linear_order M] :
-  M ⊨ Theory.linear_order :=
+  M ⊨ language.order.linear_order_theory :=
 begin
-  simp only [Theory.linear_order, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
+  simp only [linear_order_theory, Theory.model_iff, set.mem_insert_iff, set.mem_singleton_iff,
     forall_eq_or_imp, relations.realize_reflexive, rel_map_apply₂, relations.realize_antisymmetric,
     relations.realize_transitive, forall_eq, relations.realize_total],
   exact ⟨le_refl, λ _ _, le_antisymm, λ _ _ _, le_trans, le_total⟩,
 end
 
-section is_ordered_structure
+section ordered_structure
 variables [is_ordered L] [L.Structure M]
 
-@[simp] lemma rel_map_le_symb [has_le M] [L.is_ordered_structure M] {a b : M} :
+@[simp] lemma rel_map_le_symb [has_le M] [L.ordered_structure M] {a b : M} :
   rel_map (le_symb : L.relations 2) ![a, b] ↔ a ≤ b :=
 begin
-  rw [← order_Lhom_le_symb, Lhom.is_expansion_on.map_on_relation],
+  rw [← order_Lhom_le_symb, Lhom.map_on_relation],
   refl,
 end
 
-@[simp] lemma term.realize_le [has_le M] [L.is_ordered_structure M]
+@[simp] lemma term.realize_le [has_le M] [L.ordered_structure M]
   {t₁ t₂ : L.term (α ⊕ fin n)} {v : α → M} {xs : fin n → M} :
   (t₁.le t₂).realize v xs ↔ t₁.realize (sum.elim v xs) ≤ t₂.realize (sum.elim v xs) :=
 by simp [term.le]
 
-@[simp] lemma term.realize_lt [preorder M] [L.is_ordered_structure M]
+@[simp] lemma term.realize_lt [preorder M] [L.ordered_structure M]
   {t₁ t₂ : L.term (α ⊕ fin n)} {v : α → M} {xs : fin n → M} :
   (t₁.lt t₂).realize v xs ↔ t₁.realize (sum.elim v xs) < t₂.realize (sum.elim v xs) :=
 by simp [term.lt, lt_iff_le_not_le]
 
-end is_ordered_structure
+end ordered_structure
 
 section has_le
 variables [has_le M]
 
-theorem realize_no_top_order_iff : M ⊨ sentence.no_top_order ↔ no_top_order M :=
+theorem realize_no_top_order_iff : M ⊨ language.order.no_top_order_sentence ↔ no_top_order M :=
 begin
-  simp only [sentence.no_top_order, sentence.realize, formula.realize, bounded_formula.realize_all,
+  simp only [no_top_order_sentence, sentence.realize, formula.realize, bounded_formula.realize_all,
     bounded_formula.realize_ex, bounded_formula.realize_not, realize, term.realize_le,
     sum.elim_inr],
   refine ⟨λ h, ⟨λ a, h a⟩, _⟩,
@@ -198,12 +207,13 @@ begin
   exact exists_not_le a,
 end
 
-@[simp] lemma realize_no_top_order [h : no_top_order M] : M ⊨ sentence.no_top_order :=
+@[simp] lemma realize_no_top_order [h : no_top_order M] :
+  M ⊨ language.order.no_top_order_sentence :=
 realize_no_top_order_iff.2 h
 
-theorem realize_no_bot_order_iff : M ⊨ sentence.no_bot_order ↔ no_bot_order M :=
+theorem realize_no_bot_order_iff : M ⊨ language.order.no_bot_order_sentence ↔ no_bot_order M :=
 begin
-  simp only [sentence.no_bot_order, sentence.realize, formula.realize, bounded_formula.realize_all,
+  simp only [no_bot_order_sentence, sentence.realize, formula.realize, bounded_formula.realize_all,
     bounded_formula.realize_ex, bounded_formula.realize_not, realize, term.realize_le,
     sum.elim_inr],
   refine ⟨λ h, ⟨λ a, h a⟩, _⟩,
@@ -211,15 +221,16 @@ begin
   exact exists_not_ge a,
 end
 
-@[simp] lemma realize_no_bot_order [h : no_bot_order M] : M ⊨ sentence.no_bot_order :=
+@[simp] lemma realize_no_bot_order [h : no_bot_order M] :
+  M ⊨ language.order.no_bot_order_sentence :=
 realize_no_bot_order_iff.2 h
 
 end has_le
 
 theorem realize_densely_ordered_iff [preorder M] :
-  M ⊨ sentence.densely_ordered ↔ densely_ordered M :=
+  M ⊨ language.order.densely_ordered_sentence ↔ densely_ordered M :=
 begin
-  simp only [sentence.densely_ordered, sentence.realize, formula.realize,
+  simp only [densely_ordered_sentence, sentence.realize, formula.realize,
     bounded_formula.realize_imp, bounded_formula.realize_all, realize, term.realize_lt,
     sum.elim_inr, bounded_formula.realize_ex, bounded_formula.realize_inf],
   refine ⟨λ h, ⟨λ a b ab, h a b ab⟩, _⟩,
@@ -228,13 +239,13 @@ begin
 end
 
 @[simp] lemma realize_densely_ordered [preorder M] [h : densely_ordered M] :
-  M ⊨ sentence.densely_ordered :=
+  M ⊨ language.order.densely_ordered_sentence :=
 realize_densely_ordered_iff.2 h
 
 instance model_DLO [linear_order M] [densely_ordered M] [no_top_order M] [no_bot_order M] :
-  M ⊨ Theory.DLO :=
+  M ⊨ language.order.DLO :=
 begin
-  simp only [Theory.DLO, set.union_insert, set.union_singleton, Theory.model_iff,
+  simp only [DLO, set.union_insert, set.union_singleton, Theory.model_iff,
     set.mem_insert_iff, forall_eq_or_imp, realize_no_top_order, realize_no_bot_order,
     realize_densely_ordered, true_and],
   rw ← Theory.model_iff,
diff --git a/src/model_theory/quotients.lean b/src/model_theory/quotients.lean
index f29518061d4c4..43966d7f0fbe4 100644
--- a/src/model_theory/quotients.lean
+++ b/src/model_theory/quotients.lean
@@ -3,11 +3,14 @@ Copyright (c) 2022 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
-import data.fintype.basic
+import data.fintype.quotient
 import model_theory.semantics
 
 /-!
 # Quotients of First-Order Structures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines prestructures and quotients of first-order structures.
 
 ## Main Definitions
diff --git a/src/model_theory/satisfiability.lean b/src/model_theory/satisfiability.lean
index b32b1236cb5cb..11d17f341a5f3 100644
--- a/src/model_theory/satisfiability.lean
+++ b/src/model_theory/satisfiability.lean
@@ -9,6 +9,9 @@ import model_theory.skolem
 
 /-!
 # First-Order Satisfiability
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file deals with the satisfiability of first-order theories, as well as equivalence over them.
 
 ## Main Definitions
@@ -20,6 +23,7 @@ every finite subset of `T` is satisfiable.
 models each sentence or its negation.
 * `first_order.language.Theory.semantically_equivalent`: `T.semantically_equivalent φ ψ` indicates
 that `φ` and `ψ` are equivalent formulas or sentences in models of `T`.
+* `cardinal.categorical`: A theory is `κ`-categorical if all models of size `κ` are isomorphic.
 
 ## Main Results
 * The Compactness Theorem, `first_order.language.Theory.is_satisfiable_iff_is_finitely_satisfiable`,
@@ -28,6 +32,9 @@ shows that a theory is satisfiable iff it is finitely satisfiable.
 complete.
 * `first_order.language.Theory.exists_large_model_of_infinite_model` shows that any theory with an
 infinite model has arbitrarily large models.
+* `first_order.language.Theory.exists_elementary_embedding_card_eq`: The Upward Löwenheim–Skolem
+Theorem: If `κ` is a cardinal greater than the cardinalities of `L` and an infinite `L`-structure
+`M`, then `M` has an elementary extension of cardinality `κ`.
 
 ## Implementation Details
 * Satisfiability of an `L.Theory` `T` is defined in the minimal universe containing all the symbols
@@ -37,7 +44,7 @@ of `L`. By Löwenheim-Skolem, this is equivalent to satisfiability in any univer
 
 universes u v w w'
 
-open cardinal
+open cardinal category_theory
 open_locale cardinal first_order
 
 namespace first_order
@@ -66,6 +73,26 @@ lemma is_satisfiable.mono (h : T'.is_satisfiable) (hs : T ⊆ T') :
   T.is_satisfiable :=
 ⟨(Theory.model.mono (Model.is_model h.some) hs).bundled⟩
 
+lemma is_satisfiable_empty (L : language.{u v}) :
+  is_satisfiable (∅ : L.Theory) :=
+⟨default⟩
+
+lemma is_satisfiable_of_is_satisfiable_on_Theory {L' : language.{w w'}} (φ : L →ᴸ L')
+  (h : (φ.on_Theory T).is_satisfiable) :
+  T.is_satisfiable :=
+model.is_satisfiable (h.some.reduct φ)
+
+lemma is_satisfiable_on_Theory_iff {L' : language.{w w'}} {φ : L →ᴸ L'}
+  (h : φ.injective) :
+  (φ.on_Theory T).is_satisfiable ↔ T.is_satisfiable :=
+begin
+  classical,
+  refine ⟨is_satisfiable_of_is_satisfiable_on_Theory φ,
+    λ h', _⟩,
+  haveI : inhabited (h'.some) := classical.inhabited_of_nonempty',
+  exact model.is_satisfiable (h'.some.default_expansion h),
+end
+
 lemma is_satisfiable.is_finitely_satisfiable (h : T.is_satisfiable) :
   T.is_finitely_satisfiable :=
 λ _, h.mono
@@ -118,8 +145,8 @@ begin
     refine λ a as b bs ab, _,
     rw [← subtype.coe_mk a as, ← subtype.coe_mk b bs, ← subtype.ext_iff],
     exact h.some.injective
-      ((function.extend_apply subtype.coe_injective h.some default ⟨a, as⟩).symm.trans
-      (ab.trans (function.extend_apply subtype.coe_injective h.some default ⟨b, bs⟩))), },
+      ((subtype.coe_injective.extend_apply h.some default ⟨a, as⟩).symm.trans
+      (ab.trans (subtype.coe_injective.extend_apply h.some default ⟨b, bs⟩))), },
   exact model.is_satisfiable M,
 end
 
@@ -129,8 +156,8 @@ theorem is_satisfiable_union_distinct_constants_theory_of_infinite (T : L.Theory
 begin
   classical,
   rw [distinct_constants_theory_eq_Union, set.union_Union, is_satisfiable_directed_union_iff],
-  { exact λ t, is_satisfiable_union_distinct_constants_theory_of_card_le T _ M ((lift_le_omega.2
-      (le_of_lt (finset_card_lt_omega _))).trans (omega_le_lift.2 (omega_le_mk M))), },
+  { exact λ t, is_satisfiable_union_distinct_constants_theory_of_card_le T _ M ((lift_le_aleph_0.2
+      ((finset_card_lt_aleph_0 _).le)).trans (aleph_0_le_lift.2 (aleph_0_le_mk M))) },
   { refine (monotone_const.union (monotone_distinct_constants_theory.comp _)).directed_le,
     simp only [finset.coe_map, function.embedding.coe_subtype],
     exact set.monotone_image.comp (λ _ _, finset.coe_subset.2) }
@@ -152,6 +179,117 @@ begin
   rw lift_lift,
 end
 
+lemma is_satisfiable_Union_iff_is_satisfiable_Union_finset {ι : Type*} (T : ι → L.Theory) :
+  is_satisfiable (⋃ i, T i) ↔ ∀ (s : finset ι), is_satisfiable (⋃ (i ∈ s), T i) :=
+begin
+  classical,
+  refine ⟨λ h s, h.mono (set.Union_mono (λ _, set.Union_subset_iff.2 (λ _, refl _))), λ h, _⟩,
+  rw is_satisfiable_iff_is_finitely_satisfiable,
+  intros s hs,
+  rw set.Union_eq_Union_finset at hs,
+  obtain ⟨t, ht⟩ := directed.exists_mem_subset_of_finset_subset_bUnion _ hs,
+  { exact (h t).mono ht },
+  { exact (monotone.directed_le (λ t1 t2 h, set.Union_mono (λ _, set.Union_mono'
+    (λ h1, ⟨h h1, refl _⟩)))) },
+end
+
+end Theory
+
+variables (L)
+
+/-- A version of The Downward Löwenheim–Skolem theorem where the structure `N` elementarily embeds
+into `M`, but is not by type a substructure of `M`, and thus can be chosen to belong to the universe
+of the cardinal `κ`.
+ -/
+lemma exists_elementary_embedding_card_eq_of_le (M : Type w') [L.Structure M] [nonempty M]
+  (κ : cardinal.{w})
+  (h1 : ℵ₀ ≤ κ)
+  (h2 : lift.{w} L.card ≤ cardinal.lift.{max u v} κ)
+  (h3 : lift.{w'} κ ≤ cardinal.lift.{w} (# M)) :
+  ∃ (N : bundled L.Structure), nonempty (N ↪ₑ[L] M) ∧ # N = κ :=
+begin
+  obtain ⟨S, _, hS⟩ := exists_elementary_substructure_card_eq L ∅ κ h1 (by simp) h2 h3,
+  haveI : small.{w} S,
+  { rw [← lift_inj.{_ (w + 1)}, lift_lift, lift_lift] at hS,
+    exact small_iff_lift_mk_lt_univ.2 (lt_of_eq_of_lt hS κ.lift_lt_univ') },
+  refine ⟨(equiv_shrink S).bundled_induced L,
+    ⟨S.subtype.comp (equiv.bundled_induced_equiv L _).symm.to_elementary_embedding⟩,
+    lift_inj.1 (trans _ hS)⟩,
+  simp only [equiv.bundled_induced_α, lift_mk_shrink'],
+end
+
+/-- The Upward Löwenheim–Skolem Theorem: If `κ` is a cardinal greater than the cardinalities of `L`
+and an infinite `L`-structure `M`, then `M` has an elementary extension of cardinality `κ`. -/
+theorem exists_elementary_embedding_card_eq_of_ge (M : Type w') [L.Structure M] [iM : infinite M]
+  (κ : cardinal.{w})
+  (h1 : cardinal.lift.{w} L.card ≤ cardinal.lift.{max u v} κ)
+  (h2 : cardinal.lift.{w} (# M) ≤ cardinal.lift.{w'} κ) :
+  ∃ (N : bundled L.Structure), nonempty (M ↪ₑ[L] N) ∧ # N = κ :=
+begin
+  obtain ⟨N0, hN0⟩ := (L.elementary_diagram M).exists_large_model_of_infinite_model κ M,
+  let f0 := elementary_embedding.of_models_elementary_diagram L M N0,
+  rw [← lift_le.{(max w w') (max u v)}, lift_lift, lift_lift] at h2,
+  obtain ⟨N, ⟨NN0⟩, hN⟩ := exists_elementary_embedding_card_eq_of_le (L[[M]]) N0 κ
+    (aleph_0_le_lift.1 ((aleph_0_le_lift.2 (aleph_0_le_mk M)).trans h2)) _ (hN0.trans _),
+  { letI := (Lhom_with_constants L M).reduct N,
+    haveI h : N ⊨ L.elementary_diagram M :=
+      (NN0.Theory_model_iff (L.elementary_diagram M)).2 infer_instance,
+    refine ⟨bundled.of N, ⟨_⟩, hN⟩,
+    apply elementary_embedding.of_models_elementary_diagram L M N, },
+  { simp only [card_with_constants, lift_add, lift_lift],
+    rw [add_comm, add_eq_max (aleph_0_le_lift.2 (infinite_iff.1 iM)), max_le_iff],
+    rw [← lift_le.{_ w'}, lift_lift, lift_lift] at h1,
+    exact ⟨h2, h1⟩, },
+  { rw [← lift_umax', lift_id] },
+end
+
+/-- The Löwenheim–Skolem Theorem: If `κ` is a cardinal greater than the cardinalities of `L`
+and an infinite `L`-structure `M`, then there is an elementary embedding in the appropriate
+direction between then `M` and a structure of cardinality `κ`. -/
+theorem exists_elementary_embedding_card_eq (M : Type w') [L.Structure M] [iM : infinite M]
+  (κ : cardinal.{w})
+  (h1 : ℵ₀ ≤ κ)
+  (h2 : lift.{w} L.card ≤ cardinal.lift.{max u v} κ) :
+  ∃ (N : bundled L.Structure), (nonempty (N ↪ₑ[L] M) ∨ nonempty (M ↪ₑ[L] N)) ∧ # N = κ :=
+begin
+  cases le_or_gt (lift.{w'} κ) (cardinal.lift.{w} (# M)),
+  { obtain ⟨N, hN1, hN2⟩ := exists_elementary_embedding_card_eq_of_le L M κ h1 h2 h,
+    exact ⟨N, or.inl hN1, hN2⟩ },
+  { obtain ⟨N, hN1, hN2⟩ := exists_elementary_embedding_card_eq_of_ge L M κ h2 (le_of_lt h),
+    exact ⟨N, or.inr hN1, hN2⟩ }
+end
+
+/-- A consequence of the Löwenheim–Skolem Theorem: If `κ` is a cardinal greater than the
+cardinalities of `L` and an infinite `L`-structure `M`, then there is a structure of cardinality `κ`
+elementarily equivalent to `M`. -/
+lemma exists_elementarily_equivalent_card_eq (M : Type w') [L.Structure M] [infinite M]
+  (κ : cardinal.{w})
+  (h1 : ℵ₀ ≤ κ)
+  (h2 : lift.{w} L.card ≤ cardinal.lift.{max u v} κ) :
+  ∃ (N : category_theory.bundled L.Structure), M ≅[L] N ∧ # N = κ :=
+begin
+  obtain ⟨N, (NM | MN), hNκ⟩ := exists_elementary_embedding_card_eq L M κ h1 h2,
+  { exact ⟨N, NM.some.elementarily_equivalent.symm, hNκ⟩ },
+  { exact ⟨N, MN.some.elementarily_equivalent, hNκ⟩ }
+end
+
+variable {L}
+
+namespace Theory
+
+theorem exists_model_card_eq
+  (h : ∃ (M : Model.{u v (max u v)} T), infinite M)
+  (κ : cardinal.{w})
+  (h1 : ℵ₀ ≤ κ)
+  (h2 : cardinal.lift.{w} L.card ≤ cardinal.lift.{max u v} κ) :
+  ∃ (N : Model.{u v w} T), # N = κ :=
+begin
+  casesI h with M MI,
+  obtain ⟨N, hN, rfl⟩ := exists_elementarily_equivalent_card_eq L M κ h1 h2,
+  haveI : nonempty N := hN.nonempty,
+  exact ⟨hN.Theory_model.bundled, rfl⟩,
+end
+
 variable (T)
 
 /-- A theory models a (bounded) formula when any of its nonempty models realizes that formula on all
@@ -159,7 +297,8 @@ variable (T)
 def models_bounded_formula (φ : L.bounded_formula α n) : Prop :=
   ∀ (M : Model.{u v (max u v)} T) (v : α → M) (xs : fin n → M), φ.realize v xs
 
-infix ` ⊨ `:51 := models_bounded_formula -- input using \|= or \vDash, but not using \models
+-- input using \|= or \vDash, but not using \models
+infix (name := models_bounded_formula) ` ⊨ `:51 := models_bounded_formula
 
 variable {T}
 
@@ -175,10 +314,93 @@ lemma models_sentence_of_mem {φ : L.sentence} (h : φ ∈ T) :
   T ⊨ φ :=
 models_sentence_iff.2 (λ _, realize_sentence_of_mem T h)
 
+lemma models_iff_not_satisfiable (φ : L.sentence) :
+  T ⊨ φ ↔ ¬ is_satisfiable (T ∪ {φ.not}) :=
+begin
+  rw [models_sentence_iff, is_satisfiable],
+  refine ⟨λ h1 h2, (sentence.realize_not _).1 (realize_sentence_of_mem (T ∪ {formula.not φ})
+    (set.subset_union_right _ _ (set.mem_singleton _)))
+    (h1 (h2.some.subtheory_Model (set.subset_union_left _ _))), λ h M, _⟩,
+  contrapose! h,
+  rw ← sentence.realize_not at h,
+  refine ⟨{ carrier := M,
+    is_model := ⟨λ ψ hψ, hψ.elim (realize_sentence_of_mem _) (λ h', _)⟩, }⟩,
+  rw set.mem_singleton_iff.1 h',
+  exact h,
+end
+
+lemma models_bounded_formula.realize_sentence {φ : L.sentence} (h : T ⊨ φ)
+  (M : Type*) [L.Structure M] [M ⊨ T] [nonempty M] :
+  M ⊨ φ :=
+begin
+  rw models_iff_not_satisfiable at h,
+  contrapose! h,
+  haveI : M ⊨ (T ∪ {formula.not φ}),
+  { simp only [set.union_singleton, model_iff, set.mem_insert_iff, forall_eq_or_imp,
+      sentence.realize_not],
+    rw ← model_iff,
+    exact ⟨h, infer_instance⟩ },
+  exact model.is_satisfiable M,
+end
+
 /-- A theory is complete when it is satisfiable and models each sentence or its negation. -/
 def is_complete (T : L.Theory) : Prop :=
 T.is_satisfiable ∧ ∀ (φ : L.sentence), (T ⊨ φ) ∨ (T ⊨ φ.not)
 
+namespace is_complete
+
+lemma models_not_iff (h : T.is_complete) (φ : L.sentence)  :
+  T ⊨ φ.not ↔ ¬ T ⊨ φ :=
+begin
+  cases h.2 φ with hφ hφn,
+  { simp only [hφ, not_true, iff_false],
+    rw [models_sentence_iff, not_forall],
+    refine ⟨h.1.some, _⟩,
+    simp only [sentence.realize_not, not_not],
+    exact models_sentence_iff.1 hφ _ },
+  { simp only [hφn, true_iff],
+    intro hφ,
+    rw models_sentence_iff at *,
+    exact hφn h.1.some (hφ _) }
+end
+
+lemma realize_sentence_iff (h : T.is_complete) (φ : L.sentence)
+  (M : Type*) [L.Structure M] [M ⊨ T] [nonempty M] :
+  M ⊨ φ ↔ T ⊨ φ :=
+begin
+  cases h.2 φ with hφ hφn,
+  { exact iff_of_true (hφ.realize_sentence M) hφ },
+  { exact iff_of_false ((sentence.realize_not M).1 (hφn.realize_sentence M))
+      ((h.models_not_iff φ).1 hφn), }
+end
+
+end is_complete
+
+/-- A theory is maximal when it is satisfiable and contains each sentence or its negation.
+  Maximal theories are complete. -/
+def is_maximal (T : L.Theory) : Prop :=
+T.is_satisfiable ∧ ∀ (φ : L.sentence), φ ∈ T ∨ φ.not ∈ T
+
+lemma is_maximal.is_complete (h : T.is_maximal) : T.is_complete :=
+h.imp_right (forall_imp (λ _, or.imp models_sentence_of_mem models_sentence_of_mem))
+
+lemma is_maximal.mem_or_not_mem (h : T.is_maximal) (φ : L.sentence) :
+  φ ∈ T ∨ φ.not ∈ T :=
+h.2 φ
+
+lemma is_maximal.mem_of_models (h : T.is_maximal) {φ : L.sentence}
+  (hφ : T ⊨ φ) :
+  φ ∈ T :=
+begin
+  refine (h.mem_or_not_mem φ).resolve_right (λ con, _),
+  rw [models_iff_not_satisfiable, set.union_singleton, set.insert_eq_of_mem con] at hφ,
+  exact hφ h.1,
+end
+
+lemma is_maximal.mem_iff_models (h : T.is_maximal) (φ : L.sentence) :
+  φ ∈ T ↔ T ⊨ φ :=
+⟨models_sentence_of_mem, h.mem_of_models⟩
+
 /-- Two (bounded) formulas are semantically equivalent over a theory `T` when they have the same
 interpretation in every model of `T`. (This is also known as logical equivalence, which also has a
 proof-theoretic definition.) -/
@@ -273,9 +495,11 @@ lemma mem_or_not_mem (φ : L.sentence) :
   φ ∈ L.complete_theory M ∨ φ.not ∈ L.complete_theory M :=
 by simp_rw [complete_theory, set.mem_set_of_eq, sentence.realize, formula.realize_not, or_not]
 
+lemma is_maximal [nonempty M] : (L.complete_theory M).is_maximal :=
+⟨is_satisfiable L M, mem_or_not_mem L M⟩
+
 lemma is_complete [nonempty M] : (L.complete_theory M).is_complete :=
-⟨is_satisfiable L M,
-  λ φ, ((mem_or_not_mem L M φ).imp Theory.models_sentence_of_mem Theory.models_sentence_of_mem)⟩
+(complete_theory.is_maximal L M).is_complete
 
 end complete_theory
 
@@ -395,3 +619,48 @@ lemma induction_on_exists_not {P : Π {m}, L.bounded_formula α m → Prop} (φ
 end bounded_formula
 end language
 end first_order
+
+namespace cardinal
+open first_order first_order.language
+
+variables {L : language.{u v}} (κ : cardinal.{w}) (T : L.Theory)
+
+/-- A theory is `κ`-categorical if all models of size `κ` are isomorphic. -/
+def categorical : Prop :=
+∀ (M N : T.Model), # M = κ → # N = κ → nonempty (M ≃[L] N)
+
+/-- The Łoś–Vaught Test : a criterion for categorical theories to be complete. -/
+lemma categorical.is_complete (h : κ.categorical T)
+  (h1 : ℵ₀ ≤ κ)
+  (h2 : cardinal.lift.{w} L.card ≤ cardinal.lift.{max u v} κ)
+  (hS : T.is_satisfiable)
+  (hT : ∀ (M : Theory.Model.{u v max u v} T), infinite M) :
+  T.is_complete :=
+⟨hS, λ φ, begin
+  obtain ⟨N, hN⟩ := Theory.exists_model_card_eq ⟨hS.some, hT hS.some⟩ κ h1 h2,
+  rw [Theory.models_sentence_iff, Theory.models_sentence_iff],
+  by_contra con,
+  push_neg at con,
+  obtain ⟨⟨MF, hMF⟩, MT, hMT⟩ := con,
+  rw [sentence.realize_not, not_not] at hMT,
+  refine hMF _,
+  haveI := hT MT,
+  haveI := hT MF,
+  obtain ⟨NT, MNT, hNT⟩ := exists_elementarily_equivalent_card_eq L MT κ h1 h2,
+  obtain ⟨NF, MNF, hNF⟩ := exists_elementarily_equivalent_card_eq L MF κ h1 h2,
+  obtain ⟨TF⟩ := h (MNT.to_Model T) (MNF.to_Model T) hNT hNF,
+  exact ((MNT.realize_sentence φ).trans
+    ((TF.realize_sentence φ).trans (MNF.realize_sentence φ).symm)).1 hMT,
+end⟩
+
+theorem empty_Theory_categorical (T : language.empty.Theory) :
+  κ.categorical T :=
+λ M N hM hN, by rw [empty.nonempty_equiv_iff, hM, hN]
+
+theorem empty_infinite_Theory_is_complete :
+  language.empty.infinite_theory.is_complete :=
+(empty_Theory_categorical ℵ₀ _).is_complete ℵ₀ _ le_rfl (by simp)
+  ⟨Theory.model.bundled ((model_infinite_theory_iff language.empty).2 nat.infinite)⟩
+  (λ M, (model_infinite_theory_iff language.empty).1 M.is_model)
+
+end cardinal
diff --git a/src/model_theory/semantics.lean b/src/model_theory/semantics.lean
index 847c637f45663..a305b8a4449d8 100644
--- a/src/model_theory/semantics.lean
+++ b/src/model_theory/semantics.lean
@@ -8,6 +8,9 @@ import model_theory.syntax
 
 /-!
 # Basics on First-Order Semantics
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines the interpretations of first-order terms, formulas, sentences, and theories
 in a style inspired by the [Flypitch project](https://flypitch.github.io/).
 
@@ -74,7 +77,7 @@ begin
 end
 
 @[simp] lemma realize_lift_at {n n' m : ℕ} {t : L.term (α ⊕ fin n)}
-  {v : (α ⊕ fin (n + n')) → M} :
+  {v : α ⊕ fin (n + n') → M} :
   (t.lift_at n' m).realize v = t.realize (v ∘
     (sum.map id (λ i, if ↑i < m then fin.cast_add n' i else fin.add_nat n' i))) :=
 realize_relabel
@@ -111,6 +114,71 @@ begin
   { simp [ih] }
 end
 
+@[simp] lemma realize_restrict_var [decidable_eq α] {t : L.term α} {s : set α}
+  (h : ↑t.var_finset ⊆ s) {v : α → M} :
+  (t.restrict_var (set.inclusion h)).realize (v ∘ coe) = t.realize v :=
+begin
+  induction t with _ _ _ _ ih,
+  { refl },
+  { simp_rw [var_finset, finset.coe_bUnion, set.Union_subset_iff] at h,
+    exact congr rfl (funext (λ i, ih i (h i (finset.mem_univ i)))) },
+end
+
+@[simp] lemma realize_restrict_var_left [decidable_eq α] {γ : Type*}
+  {t : L.term (α ⊕ γ)} {s : set α}
+  (h : ↑t.var_finset_left ⊆ s) {v : α → M} {xs : γ → M} :
+  (t.restrict_var_left (set.inclusion h)).realize (sum.elim (v ∘ coe) xs) =
+    t.realize (sum.elim v xs) :=
+begin
+  induction t with a _ _ _ ih,
+  { cases a;
+    refl },
+  { simp_rw [var_finset_left, finset.coe_bUnion, set.Union_subset_iff] at h,
+    exact congr rfl (funext (λ i, ih i (h i (finset.mem_univ i)))) },
+end
+
+@[simp] lemma realize_constants_to_vars [L[[α]].Structure M]
+  [(Lhom_with_constants L α).is_expansion_on M]
+  {t : L[[α]].term β} {v : β → M} :
+  t.constants_to_vars.realize (sum.elim (λ a, ↑(L.con a)) v) = t.realize v :=
+begin
+  induction t with _ n f _ ih,
+  { simp },
+  { cases n,
+    { cases f,
+      { simp [ih], },
+      { simp only [realize, constants_to_vars, sum.elim_inl, fun_map_eq_coe_constants],
+        refl } },
+    { cases f,
+      { simp [ih] },
+      { exact is_empty_elim f } } }
+end
+
+@[simp] lemma realize_vars_to_constants [L[[α]].Structure M]
+  [(Lhom_with_constants L α).is_expansion_on M]
+  {t : L.term (α ⊕ β)} {v : β → M} :
+  t.vars_to_constants.realize v = t.realize (sum.elim (λ a, ↑(L.con a)) v) :=
+begin
+  induction t with ab n f ts ih,
+  { cases ab;
+    simp [language.con], },
+  { simp [ih], }
+end
+
+lemma realize_constants_vars_equiv_left [L[[α]].Structure M]
+  [(Lhom_with_constants L α).is_expansion_on M]
+  {n} {t : L[[α]].term (β ⊕ fin n)} {v : β → M} {xs : fin n → M} :
+  (constants_vars_equiv_left t).realize (sum.elim (sum.elim (λ a, ↑(L.con a)) v) xs) =
+    t.realize (sum.elim v xs) :=
+begin
+  simp only [constants_vars_equiv_left, realize_relabel, equiv.coe_trans, function.comp_app,
+    constants_vars_equiv_apply, relabel_equiv_symm_apply],
+  refine trans _ (realize_constants_to_vars),
+  rcongr,
+  rcases x with (a | (b | i));
+  simp,
+end
+
 end term
 
 namespace Lhom
@@ -121,7 +189,7 @@ namespace Lhom
 begin
   induction t with _ n f ts ih,
   { refl },
-  { simp only [term.realize, Lhom.on_term, Lhom.is_expansion_on.map_on_function, ih] }
+  { simp only [term.realize, Lhom.on_term, Lhom.map_on_function, ih] }
 end
 
 end Lhom
@@ -250,53 +318,69 @@ lemma realize_cast_le_of_eq {m n : ℕ} (h : m = n) {h' : m ≤ n} {φ : L.bound
   {v : α → M} {xs : fin n → M} :
   (φ.cast_le h').realize v xs ↔ φ.realize v (xs ∘ fin.cast h) :=
 begin
-  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 k _ ih3 generalizing n xs h h',
-  { simp [cast_le, realize] },
-  { simp only [cast_le, realize, realize_bd_equal, term.realize_relabel, sum.elim_comp_map,
-      function.comp.right_id, cast_le_of_eq h], },
-  { simp only [cast_le, realize, realize_rel, term.realize_relabel, sum.elim_comp_map,
-      function.comp.right_id, cast_le_of_eq h] },
-  { simp only [cast_le, realize, ih1 h, ih2 h], },
-  { simp only [cast_le, realize, ih3 (nat.succ_inj'.2 h)],
-    refine forall_congr (λ x, iff_eq_eq.mpr (congr rfl (funext (last_cases _ (λ i, _))))),
-    { rw [function.comp_app, snoc_last, cast_last, snoc_last] },
-    { rw [function.comp_app, snoc_cast_succ, cast_cast_succ, snoc_cast_succ] } }
+  subst h,
+  simp only [cast_le_rfl, cast_refl, order_iso.coe_refl, function.comp.right_id],
 end
 
-lemma realize_relabel {m n : ℕ}
-  {φ : L.bounded_formula α n} {g : α → (β ⊕ fin m)} {v : β → M} {xs : fin (m + n) → M} :
-  (φ.relabel g).realize v xs ↔
-    φ.realize (sum.elim v (xs ∘ (fin.cast_add n)) ∘ g) (xs ∘ (fin.nat_add m)) :=
+lemma realize_map_term_rel_id [L'.Structure M]
+  {ft : ∀ n, L.term (α ⊕ fin n) → L'.term (β ⊕ fin n)}
+  {fr : ∀ n, L.relations n → L'.relations n}
+  {n} {φ : L.bounded_formula α n} {v : α → M} {v' : β → M} {xs : fin n → M}
+  (h1 : ∀ n (t : L.term (α ⊕ fin n)) (xs : fin n → M),
+    (ft n t).realize (sum.elim v' xs) = t.realize (sum.elim v xs))
+  (h2 : ∀ n (R : L.relations n) (x : fin n → M), rel_map (fr n R) x = rel_map R x) :
+  (φ.map_term_rel ft fr (λ _, id)).realize v' xs ↔ φ.realize v xs :=
+begin
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih,
+  { refl },
+  { simp [map_term_rel, realize, h1] },
+  { simp [map_term_rel, realize, h1, h2] },
+  { simp [map_term_rel, realize, ih1, ih2], },
+  { simp only [map_term_rel, realize, ih, id.def] },
+end
+
+lemma realize_map_term_rel_add_cast_le [L'.Structure M]
+  {k : ℕ}
+  {ft : ∀ n, L.term (α ⊕ fin n) → L'.term (β ⊕ fin (k + n))}
+  {fr : ∀ n, L.relations n → L'.relations n}
+  {n} {φ : L.bounded_formula α n} (v : ∀ {n}, (fin (k + n) → M) → α → M) {v' : β → M}
+  (xs : fin (k + n) → M)
+  (h1 : ∀ n (t : L.term (α ⊕ fin n)) (xs' : fin (k + n) → M),
+    (ft n t).realize (sum.elim v' xs') =
+    t.realize (sum.elim (v xs') (xs' ∘ fin.nat_add _)))
+  (h2 : ∀ n (R : L.relations n) (x : fin n → M), rel_map (fr n R) x = rel_map R x)
+  (hv : ∀ n (xs : fin (k + n) → M) (x : M), @v (n+1) (snoc xs x : fin _ → M) = v xs):
+  (φ.map_term_rel ft fr (λ n, cast_le (add_assoc _ _ _).symm.le)).realize v' xs ↔
+    φ.realize (v xs) (xs ∘ fin.nat_add _) :=
 begin
-  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 n' _ ih3,
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih,
   { refl },
-  { simp [realize, relabel] },
-  { simp [realize, relabel] },
-  { simp [realize, relabel, ih1, ih2] },
-  { simp only [ih3, realize, relabel],
-    refine forall_congr (λ a, (iff_eq_eq.mpr (congr (congr rfl (congr (congr rfl (congr rfl
-      (funext (λ i, (dif_pos _).trans rfl)))) rfl)) _))),
-    { ext i,
-      by_cases h : i.val < n',
-      { exact (dif_pos (nat.add_lt_add_left h m)).trans (dif_pos h).symm },
-      { exact (dif_neg (λ h', h (nat.lt_of_add_lt_add_left h'))).trans (dif_neg h).symm } } }
+  { simp [map_term_rel, realize, h1] },
+  { simp [map_term_rel, realize, h1, h2] },
+  { simp [map_term_rel, realize, ih1, ih2], },
+  { simp [map_term_rel, realize, ih, hv] },
 end
 
+lemma realize_relabel {m n : ℕ}
+  {φ : L.bounded_formula α n} {g : α → β ⊕ fin m} {v : β → M} {xs : fin (m + n) → M} :
+  (φ.relabel g).realize v xs ↔
+    φ.realize (sum.elim v (xs ∘ fin.cast_add n) ∘ g) (xs ∘ fin.nat_add m) :=
+by rw [relabel, realize_map_term_rel_add_cast_le]; intros; simp
+
 lemma realize_lift_at {n n' m : ℕ} {φ : L.bounded_formula α n}
   {v : α → M} {xs : fin (n + n') → M} (hmn : m + n' ≤ n + 1) :
   (φ.lift_at n' m).realize v xs ↔ φ.realize v (xs ∘
     (λ i, if ↑i < m then fin.cast_add n' i else fin.add_nat n' i)) :=
 begin
+  rw lift_at,
   induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 k _ ih3,
-  { simp [lift_at, realize] },
-  { simp only [lift_at, realize, realize_bd_equal, realize_lift_at, sum.elim_comp_map,
-      function.comp.right_id] },
-  { simp only [lift_at, realize, realize_rel, realize_lift_at, sum.elim_comp_map,
-      function.comp.right_id] },
-  { simp only [lift_at, realize, ih1 hmn, ih2 hmn], },
+  { simp [realize, map_term_rel], },
+  { simp [realize, map_term_rel, realize_rel, realize_lift_at, sum.elim_comp_map], },
+  { simp [realize, map_term_rel, realize_rel, realize_lift_at, sum.elim_comp_map], },
+  { simp only [map_term_rel, realize, ih1 hmn, ih2 hmn] },
   { have h : k + 1 + n' = k + n'+ 1,
     { rw [add_assoc, add_comm 1 n', ← add_assoc], },
-    simp only [lift_at, realize, realize_cast_le_of_eq h, ih3 (hmn.trans k.succ.le_succ)],
+    simp only [map_term_rel, realize, realize_cast_le_of_eq h, ih3 (hmn.trans k.succ.le_succ)],
     refine forall_congr (λ x, iff_eq_eq.mpr (congr rfl (funext (fin.last_cases _ (λ i, _))))),
     { simp only [function.comp_app, coe_last, snoc_last],
       by_cases (k < m),
@@ -331,21 +415,53 @@ begin
   rw [if_pos i.is_lt],
 end
 
-@[simp] lemma realize_subst_aux {tf : α → L.term β} {v : β → M} {xs : fin n → M} :
-  (λ x, term.realize (sum.elim v xs) (sum.elim (term.relabel sum.inl ∘ tf) (var ∘ sum.inr) x)) =
-    sum.elim (λ (a : α), term.realize v (tf a)) xs :=
-funext (λ x, sum.cases_on x (λ x,
-  by simp only [sum.elim_inl, term.realize_relabel, sum.elim_comp_inl]) (λ x, rfl))
-
 lemma realize_subst {φ : L.bounded_formula α n} {tf : α → L.term β} {v : β → M} {xs : fin n → M} :
   (φ.subst tf).realize v xs ↔ φ.realize (λ a, (tf a).realize v) xs :=
+realize_map_term_rel_id (λ n t x, begin
+  rw term.realize_subst,
+  rcongr a,
+  { cases a,
+    { simp only [sum.elim_inl, term.realize_relabel, sum.elim_comp_inl] },
+    { refl } }
+end) (by simp)
+
+@[simp] lemma realize_restrict_free_var [decidable_eq α] {n : ℕ} {φ : L.bounded_formula α n}
+  {s : set α} (h : ↑φ.free_var_finset ⊆ s) {v : α → M} {xs : fin n → M} :
+  (φ.restrict_free_var (set.inclusion h)).realize (v ∘ coe) xs ↔
+    φ.realize v xs :=
 begin
-  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih,
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
   { refl },
-  { simp only [subst, bounded_formula.realize, realize_subst, realize_subst_aux] },
-  { simp only [subst, bounded_formula.realize, realize_subst, realize_subst_aux] },
-  { simp only [subst, realize_imp, ih1, ih2] },
-  { simp only [ih, subst, realize_all] }
+  { simp [restrict_free_var, realize] },
+  { simp [restrict_free_var, realize] },
+  { simp [restrict_free_var, realize, ih1, ih2] },
+  { simp [restrict_free_var, realize, ih3] },
+end
+
+lemma realize_constants_vars_equiv [L[[α]].Structure M]
+  [(Lhom_with_constants L α).is_expansion_on M]
+  {n} {φ : L[[α]].bounded_formula β n} {v : β → M} {xs : fin n → M} :
+  (constants_vars_equiv φ).realize (sum.elim (λ a, ↑(L.con a)) v) xs ↔ φ.realize v xs :=
+begin
+  refine realize_map_term_rel_id (λ n t xs, realize_constants_vars_equiv_left) (λ n R xs, _),
+  rw ← (Lhom_with_constants L α).map_on_relation (equiv.sum_empty (L.relations n)
+    ((constants_on α).relations n) R) xs,
+  rcongr,
+  cases R,
+  { simp, },
+  { exact is_empty_elim R }
+end
+
+@[simp] lemma realize_relabel_equiv {g : α ≃ β} {k} {φ : L.bounded_formula α k}
+  {v : β → M} {xs : fin k → M} :
+  (relabel_equiv g φ).realize v xs ↔ φ.realize (v ∘ g) xs :=
+begin
+  simp only [relabel_equiv, map_term_rel_equiv_apply, equiv.coe_refl],
+  refine realize_map_term_rel_id (λ n t xs, _) (λ _ _ _, rfl),
+  simp only [relabel_equiv_apply, term.realize_relabel],
+  refine congr (congr rfl _) rfl,
+  ext (i | i);
+  refl,
 end
 
 variables [nonempty M]
@@ -441,7 +557,7 @@ begin
   { refl },
   { simp only [on_bounded_formula, realize_bd_equal, realize_on_term],
     refl, },
-  { simp only [on_bounded_formula, realize_rel, realize_on_term, is_expansion_on.map_on_relation],
+  { simp only [on_bounded_formula, realize_rel, realize_on_term, Lhom.map_on_relation],
     refl, },
   { simp only [on_bounded_formula, ih1, ih2, realize_imp], },
   { simp only [on_bounded_formula, ih3, realize_all], },
@@ -551,12 +667,45 @@ variable (M)
 def sentence.realize (φ : L.sentence) : Prop :=
 φ.realize (default : _ → M)
 
-infix ` ⊨ `:51 := sentence.realize -- input using \|= or \vDash, but not using \models
+-- input using \|= or \vDash, but not using \models
+infix (name := sentence.realize) ` ⊨ `:51 := sentence.realize
 
 @[simp] lemma sentence.realize_not {φ : L.sentence} :
   M ⊨ φ.not ↔ ¬ M ⊨ φ :=
 iff.rfl
 
+namespace formula
+
+@[simp] lemma realize_equiv_sentence_symm_con
+  [L[[α]].Structure M] [(L.Lhom_with_constants α).is_expansion_on M]
+  (φ : L[[α]].sentence) :
+  (equiv_sentence.symm φ).realize (λ a, (L.con a : M)) ↔ φ.realize M :=
+begin
+  simp only [equiv_sentence, equiv.symm_symm, equiv.coe_trans, realize,
+    bounded_formula.realize_relabel_equiv],
+  refine trans _ bounded_formula.realize_constants_vars_equiv,
+  congr' with (i | i),
+  { refl },
+  { exact i.elim }
+end
+
+@[simp] lemma realize_equiv_sentence
+  [L[[α]].Structure M] [(L.Lhom_with_constants α).is_expansion_on M]
+  (φ : L.formula α) :
+  (equiv_sentence φ).realize M ↔ φ.realize (λ a, (L.con a : M)) :=
+by rw [← realize_equiv_sentence_symm_con M (equiv_sentence φ),
+    _root_.equiv.symm_apply_apply]
+
+lemma realize_equiv_sentence_symm (φ : L[[α]].sentence) (v : α → M) :
+  (equiv_sentence.symm φ).realize v ↔ @sentence.realize _ M
+    (@language.with_constants_Structure L M _ α (constants_on.Structure v)) φ :=
+begin
+  letI := constants_on.Structure v,
+  exact realize_equiv_sentence_symm_con M φ,
+end
+
+end formula
+
 @[simp] lemma Lhom.realize_on_sentence [L'.Structure M] (φ : L →ᴸ L') [φ.is_expansion_on M]
   (ψ : L.sentence) :
   M ⊨ φ.on_sentence ψ ↔ M ⊨ ψ :=
@@ -567,13 +716,29 @@ variables (L)
 /-- The complete theory of a structure `M` is the set of all sentences `M` satisfies. -/
 def complete_theory : L.Theory := { φ | M ⊨ φ }
 
-variables {L}
+variable (N)
+
+/-- Two structures are elementarily equivalent when they satisfy the same sentences. -/
+def elementarily_equivalent : Prop := L.complete_theory M = L.complete_theory N
+
+localized "notation (name := elementarily_equivalent) A ` ≅[`:25 L `] ` B:50 :=
+  first_order.language.elementarily_equivalent L A B" in first_order
+
+variables {L} {M} {N}
+
+@[simp] lemma mem_complete_theory {φ : sentence L} : φ ∈ L.complete_theory M ↔ M ⊨ φ := iff.rfl
+
+lemma elementarily_equivalent_iff : M ≅[L] N ↔ ∀ φ : L.sentence, M ⊨ φ ↔ N ⊨ φ :=
+by simp only [elementarily_equivalent, set.ext_iff, complete_theory, set.mem_set_of_eq]
+
+variables (M)
 
 /-- A model of a theory is a structure in which every sentence is realized as true. -/
 class Theory.model (T : L.Theory) : Prop :=
 (realize_of_mem : ∀ φ ∈ T, M ⊨ φ)
 
-infix ` ⊨ `:51 := Theory.model -- input using \|= or \vDash, but not using \models
+-- input using \|= or \vDash, but not using \models
+infix (name := Theory.model) ` ⊨ `:51 := Theory.model
 
 variables {M} (T : L.Theory)
 
@@ -601,7 +766,7 @@ lemma model.mono {T' : L.Theory} (h : M ⊨ T') (hs : T ⊆ T') :
 lemma model.union {T' : L.Theory} (h : M ⊨ T) (h' : M ⊨ T') :
   M ⊨ T ∪ T' :=
 begin
-  simp only [model_iff, set.mem_union_eq] at *,
+  simp only [model_iff, set.mem_union] at *,
   exact λ φ hφ, hφ.elim (h _) (h' _),
 end
 
@@ -617,6 +782,9 @@ theorem model_iff_subset_complete_theory :
   M ⊨ T ↔ T ⊆ L.complete_theory M :=
 T.model_iff
 
+theorem complete_theory.subset [MT : M ⊨ T] : T ⊆ L.complete_theory M :=
+model_iff_subset_complete_theory.1 MT
+
 end Theory
 
 instance model_complete_theory : M ⊨ L.complete_theory M :=
@@ -627,10 +795,10 @@ variables (M N)
 theorem realize_iff_of_model_complete_theory [N ⊨ L.complete_theory M] (φ : L.sentence) :
   N ⊨ φ ↔ M ⊨ φ :=
 begin
-  refine ⟨λ h, _, Theory.realize_sentence_of_mem (L.complete_theory M)⟩,
+  refine ⟨λ h, _, (L.complete_theory M).realize_sentence_of_mem⟩,
   contrapose! h,
   rw [← sentence.realize_not] at *,
-  exact Theory.realize_sentence_of_mem (L.complete_theory M) h,
+  exact (L.complete_theory M).realize_sentence_of_mem (mem_complete_theory.2 h)
 end
 
 variables {M N}
@@ -661,6 +829,33 @@ begin
       exact ⟨_, _, h⟩ } }
 end
 
+@[simp] lemma realize_to_formula (φ : L.bounded_formula α n) (v : α ⊕ fin n → M) :
+  φ.to_formula.realize v ↔ φ.realize (v ∘ sum.inl) (v ∘ sum.inr) :=
+begin
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3 a8 a9 a0,
+  { refl },
+  { simp [bounded_formula.realize] },
+  { simp [bounded_formula.realize] },
+  { rw [to_formula, formula.realize, realize_imp, ← formula.realize, ih1, ← formula.realize, ih2,
+      realize_imp], },
+  { rw [to_formula, formula.realize, realize_all, realize_all],
+    refine forall_congr (λ a, _),
+    have h := ih3 (sum.elim (v ∘ sum.inl) (snoc (v ∘ sum.inr) a)),
+    simp only [sum.elim_comp_inl, sum.elim_comp_inr] at h,
+    rw [← h, realize_relabel, formula.realize],
+    rcongr,
+    { cases x,
+      { simp },
+      { refine fin.last_cases _ (λ i, _) x,
+        { rw [sum.elim_inr, snoc_last, function.comp_app, sum.elim_inr, function.comp_app,
+            fin_sum_fin_equiv_symm_last, sum.map_inr, sum.elim_inr, function.comp_app],
+          exact (congr rfl (subsingleton.elim _ _)).trans (snoc_last _ _) },
+        { simp only [cast_succ, function.comp_app, sum.elim_inr,
+            fin_sum_fin_equiv_symm_apply_cast_add, sum.map_inl, sum.elim_inl],
+          rw [← cast_succ, snoc_cast_succ] } } },
+    { exact subsingleton.elim _ _ } }
+end
+
 end bounded_formula
 
 namespace equiv
@@ -698,6 +893,9 @@ by rw [sentence.realize, sentence.realize, ← g.realize_formula, unique.eq_defa
 lemma Theory_model (g : M ≃[L] N) [M ⊨ T] : N ⊨ T :=
 ⟨λ φ hφ, (g.realize_sentence φ).1 (Theory.realize_sentence_of_mem T hφ)⟩
 
+lemma elementarily_equivalent (g : M ≃[L] N) : M ≅[L] N :=
+elementarily_equivalent_iff.2 g.realize_sentence
+
 end equiv
 
 namespace relations
@@ -762,7 +960,7 @@ begin
 end
 
 @[simp] lemma model_infinite_theory_iff : M ⊨ L.infinite_theory ↔ infinite M :=
-by simp [infinite_theory, infinite_iff, omega_le]
+by simp [infinite_theory, infinite_iff, aleph_0_le]
 
 instance model_infinite_theory [h : infinite M] :
   M ⊨ L.infinite_theory :=
@@ -780,15 +978,15 @@ L.model_nonempty_theory_iff.2 h
 lemma model_distinct_constants_theory {M : Type w} [L[[α]].Structure M] (s : set α) :
   M ⊨ L.distinct_constants_theory s ↔ set.inj_on (λ (i : α), (L.con i : M)) s :=
 begin
-  simp only [distinct_constants_theory, set.compl_eq_compl, Theory.model_iff, set.mem_image,
-    set.mem_inter_eq, set.mem_prod, set.mem_compl_eq, prod.exists, forall_exists_index, and_imp],
+  simp only [distinct_constants_theory, Theory.model_iff, set.mem_image,
+    set.mem_inter, set.mem_prod, set.mem_compl, prod.exists, forall_exists_index, and_imp],
   refine ⟨λ h a as b bs ab, _, _⟩,
   { contrapose! ab,
-    have h' := h _ a b as bs ab rfl,
+    have h' := h _ a b ⟨⟨as, bs⟩, ab⟩ rfl,
     simp only [sentence.realize, formula.realize_not, formula.realize_equal,
       term.realize_constants] at h',
     exact h', },
-  { rintros h φ a b as bs ab rfl,
+  { rintros h φ a b ⟨⟨as, bs⟩, ab⟩ rfl,
     simp only [sentence.realize, formula.realize_not, formula.realize_equal,
       term.realize_constants],
     exact λ contra, ab (h as bs contra) }
@@ -801,5 +999,35 @@ lift_mk_le'.2 ⟨⟨_, set.inj_on_iff_injective.1 ((L.model_distinct_constants_t
 
 end cardinality
 
+namespace elementarily_equivalent
+
+@[symm] lemma symm (h : M ≅[L] N) : N ≅[L] M := h.symm
+
+@[trans] lemma trans (MN : M ≅[L] N) (NP : N ≅[L] P) : M ≅[L] P := MN.trans NP
+
+lemma complete_theory_eq (h : M ≅[L] N) : L.complete_theory M = L.complete_theory N := h
+
+lemma realize_sentence (h : M ≅[L] N) (φ : L.sentence) : M ⊨ φ ↔ N ⊨ φ :=
+(elementarily_equivalent_iff.1 h) φ
+
+lemma Theory_model_iff (h : M ≅[L] N) : M ⊨ T ↔ N ⊨ T :=
+by rw [Theory.model_iff_subset_complete_theory, Theory.model_iff_subset_complete_theory,
+    h.complete_theory_eq]
+
+lemma Theory_model [MT : M ⊨ T] (h : M ≅[L] N) : N ⊨ T :=
+h.Theory_model_iff.1 MT
+
+lemma nonempty_iff (h : M ≅[L] N) : nonempty M ↔ nonempty N :=
+(model_nonempty_theory_iff L).symm.trans (h.Theory_model_iff.trans (model_nonempty_theory_iff L))
+
+lemma nonempty [Mn : nonempty M] (h : M ≅[L] N) : nonempty N := h.nonempty_iff.1 Mn
+
+lemma infinite_iff (h : M ≅[L] N) : infinite M ↔ infinite N :=
+(model_infinite_theory_iff L).symm.trans (h.Theory_model_iff.trans (model_infinite_theory_iff L))
+
+lemma infinite [Mi : infinite M] (h : M ≅[L] N) : infinite N := h.infinite_iff.1 Mi
+
+end elementarily_equivalent
+
 end language
 end first_order
diff --git a/src/model_theory/skolem.lean b/src/model_theory/skolem.lean
index dcc2bb75a2a6e..517db8987361f 100644
--- a/src/model_theory/skolem.lean
+++ b/src/model_theory/skolem.lean
@@ -8,6 +8,9 @@ import model_theory.elementary_maps
 /-!
 # Skolem Functions and Downward Löwenheim–Skolem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 * `first_order.language.skolem₁` is a language consisting of Skolem functions for another language.
 
@@ -22,7 +25,7 @@ import model_theory.elementary_maps
 
 -/
 
-universes u v w
+universes u v w w'
 
 namespace first_order
 namespace language
@@ -52,7 +55,7 @@ begin
 end
 
 theorem card_functions_sum_skolem₁_le :
-  # (Σ n, (L.sum L.skolem₁).functions n) ≤ max ω L.card :=
+  # (Σ n, (L.sum L.skolem₁).functions n) ≤ max ℵ₀ L.card :=
 begin
   rw card_functions_sum_skolem₁,
   transitivity # (Σ n, L.bounded_formula empty n),
@@ -82,7 +85,7 @@ end
 /-- Any `L.sum L.skolem₁`-substructure is an elementary `L`-substructure. -/
 noncomputable def elementary_skolem₁_reduct (S : (L.sum L.skolem₁).substructure M) :
   L.elementary_substructure M :=
-⟨Lhom.sum_inl.substructure_reduct S, λ _, S.skolem₁_reduct_is_elementary⟩
+⟨Lhom.sum_inl.substructure_reduct S, S.skolem₁_reduct_is_elementary⟩
 
 lemma coe_sort_elementary_skolem₁_reduct
   (S : (L.sum L.skolem₁).substructure M) :
@@ -105,42 +108,45 @@ theorem exists_small_elementary_substructure :
   ∃ (S : L.elementary_substructure M), small.{max u v} S :=
 ⟨substructure.elementary_skolem₁_reduct ⊥, infer_instance⟩
 
-variables {L M}
+variables {M}
 
-/-- The Downward Löwenheim–Skolem Theorem :
+/-- The Downward Löwenheim–Skolem theorem :
   If `s` is a set in an `L`-structure `M` and `κ` an infinite cardinal such that
   `max (# s, L.card) ≤ κ` and `κ ≤ # M`, then `M` has an elementary substructure containing `s` of
   cardinality `κ`.  -/
-theorem exists_elementary_substructure_card_eq (s : set M) (κ : cardinal.{max u v w})
-  (h1 : ω ≤ κ)
-  (h2 : cardinal.lift.{max u v} (# s) ≤ κ)
-  (h3 : cardinal.lift.{w} L.card ≤ κ)
-  (h4 : κ ≤ cardinal.lift.{max u v} (# M)) :
-  ∃ (S : L.elementary_substructure M), s ⊆ S ∧ cardinal.lift.{max u v} (# S) = κ :=
+theorem exists_elementary_substructure_card_eq (s : set M) (κ : cardinal.{w'})
+  (h1 : ℵ₀ ≤ κ)
+  (h2 : cardinal.lift.{w'} (# s) ≤ cardinal.lift.{w} κ)
+  (h3 : cardinal.lift.{w'} L.card ≤ cardinal.lift.{max u v} κ)
+  (h4 : cardinal.lift.{w} κ ≤ cardinal.lift.{w'} (# M)) :
+  ∃ (S : L.elementary_substructure M), s ⊆ S ∧
+    cardinal.lift.{w'} (# S) = cardinal.lift.{w} κ :=
 begin
-  obtain ⟨s', rfl⟩ := cardinal.le_mk_iff_exists_set.1 h4,
+  obtain ⟨s', hs'⟩ := cardinal.le_mk_iff_exists_set.1 h4,
+  rw ← aleph_0_le_lift at h1,
+  rw ← hs' at *,
   refine ⟨elementary_skolem₁_reduct (closure (L.sum L.skolem₁)
-    (s ∪ (equiv.ulift.{(max u v) w} '' s'))),
+    (s ∪ (equiv.ulift '' s'))),
     (s.subset_union_left _).trans subset_closure, _⟩,
-  rw [coe_sort_elementary_skolem₁_reduct],
-  refine le_antisymm (lift_le.1 _) _,
-  { rw lift_lift,
-    refine lift_card_closure_le.trans _,
-    rw max_le_iff at *,
-    rw [← lift_le, lift_lift, lift_le, add_comm, add_eq_max, max_le_iff, lift_id'],
-    { refine ⟨h1, _, _⟩,
-      { refine (lift_le.2 card_functions_sum_skolem₁_le).trans _,
-        rw [lift_max', lift_omega, max_le_iff, ← lift_lift, lift_id],
-        exact ⟨h1, h3⟩, },
-      { refine ((lift_le.2 (mk_union_le _ _)).trans _),
-        rw [lift_add, add_comm, mk_image_eq_lift _ _ equiv.ulift.injective, ← lift_lift, lift_id',
-          add_eq_max h1, lift_id', max_eq_left h2] } },
-    { rw [← lift_lift, lift_id, ← lift_omega, lift_le, ← infinite_iff],
-      exact infinite.of_injective (λ n, ⟨n, sum.inr bounded_formula.falsum⟩)
-        (λ x y xy, (sigma.ext_iff.1 xy).1) } },
-  { rw [← lift_le, lift_lift, ← mk_image_eq_lift _ s' equiv.ulift.injective, lift_mk_le],
-    exact ⟨⟨set.inclusion ((set.subset_union_right _ _).trans subset_closure),
-      set.inclusion_injective _⟩⟩ },
+  have h := mk_image_eq_lift _ s' equiv.ulift.injective,
+  rw [lift_umax, lift_id'] at h,
+  rw [coe_sort_elementary_skolem₁_reduct, ← h, lift_inj],
+  refine le_antisymm (lift_le.1 (lift_card_closure_le.trans _))
+    (mk_le_mk_of_subset ((set.subset_union_right _ _).trans subset_closure)),
+  rw [max_le_iff, aleph_0_le_lift, ← aleph_0_le_lift, h, add_eq_max, max_le_iff, lift_le],
+  refine ⟨h1, (mk_union_le _ _).trans _, (lift_le.2 card_functions_sum_skolem₁_le).trans _⟩,
+  { rw [← lift_le, lift_add, h, add_comm, add_eq_max h1],
+    exact max_le le_rfl h2 },
+  { rw [lift_max, lift_aleph_0, max_le_iff, aleph_0_le_lift, and_comm,
+      ← lift_le.{_ w'}, lift_lift, lift_lift, ← aleph_0_le_lift, h],
+    refine ⟨_, h1⟩,
+    simp only [← lift_lift, lift_umax, lift_umax'],
+    rw [lift_lift, ← lift_lift.{w' w} L.card],
+    refine trans ((lift_le.{_ w}).2 h3) _,
+    rw [lift_lift, ← lift_lift.{w (max u v)}, ← hs', ← h, lift_lift, lift_lift, lift_lift] },
+  { refine trans _ (lift_le.2 (mk_le_mk_of_subset (set.subset_union_right _ _))),
+    rw [aleph_0_le_lift, ← aleph_0_le_lift, h],
+    exact h1 }
 end
 
 end language
diff --git a/src/model_theory/substructures.lean b/src/model_theory/substructures.lean
index b69df45bb4db5..bd98b13c40d2c 100644
--- a/src/model_theory/substructures.lean
+++ b/src/model_theory/substructures.lean
@@ -10,6 +10,9 @@ import model_theory.encoding
 
 /-!
 # First-Order Substructures
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines substructures of first-order structures in a similar manner to the various
 substructures appearing in the algebra library.
 
@@ -262,22 +265,23 @@ begin
   exact cardinal.mk_range_le_lift,
 end
 
-theorem lift_card_closure_le : cardinal.lift.{(max u w) w} (# (closure L s)) ≤
-  max ω (cardinal.lift.{(max u w) w} (#s) + cardinal.lift.{(max u w) u} (#(Σ i, L.functions i))) :=
+theorem lift_card_closure_le : cardinal.lift.{u w} (# (closure L s)) ≤
+  max ℵ₀ (cardinal.lift.{u w} (#s) + cardinal.lift.{w u} (#(Σ i, L.functions i))) :=
 begin
+  rw ←lift_umax,
   refine lift_card_closure_le_card_term.trans (term.card_le.trans _),
-  rw [mk_sum, lift_umax', lift_umax],
+  rw [mk_sum, lift_umax],
 end
 
 variable (L)
 
-lemma _root_.set.countable.substructure_closure
-  [L.countable_functions] (h : s.countable) :
-  nonempty (encodable (closure L s)) :=
+lemma _root_.set.countable.substructure_closure [countable (Σl, L.functions l)]
+  (h : s.countable) :
+  countable.{w + 1} (closure L s) :=
 begin
-  haveI : nonempty (encodable s) := h,
-  rw [encodable_iff, ← lift_le_omega],
-  exact lift_card_closure_le_card_term.trans term.card_le_omega,
+  haveI : countable s := h.to_subtype,
+  rw [← mk_le_aleph_0_iff, ← lift_le_aleph_0],
+  exact lift_card_closure_le_card_term.trans mk_le_aleph_0
 end
 
 variables {L} (S)
@@ -576,7 +580,7 @@ def substructure_reduct : L'.substructure M ↪o L.substructure M :=
 { to_fun := λ S, { carrier := S,
     fun_mem := λ n f x hx, begin
       have h := S.fun_mem (φ.on_function f) x hx,
-      simp only [is_expansion_on.map_on_function, substructure.mem_carrier] at h,
+      simp only [Lhom.map_on_function, substructure.mem_carrier] at h,
       exact h,
     end },
   inj' := λ S T h, begin
@@ -603,7 +607,7 @@ def with_constants (S : L.substructure M) {A : set M} (h : A ⊆ S) : L[[A]].sub
     { exact S.fun_mem f },
     { cases n,
       { exact λ _ _, h f.2 },
-      { exact pempty.elim f } }
+      { exact is_empty_elim f } }
   end }
 
 variables {A : set M} {s : set M} (h : A ⊆ S)
diff --git a/src/model_theory/syntax.lean b/src/model_theory/syntax.lean
index c00dd715c4412..288d455200966 100644
--- a/src/model_theory/syntax.lean
+++ b/src/model_theory/syntax.lean
@@ -10,6 +10,9 @@ import model_theory.language_map
 
 /-!
 # Basics on First-Order Syntax
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines first-order terms, formulas, sentences, and theories in a style inspired by the
 [Flypitch project](https://flypitch.github.io/).
 
@@ -22,6 +25,8 @@ This file defines first-order terms, formulas, sentences, and theories in a styl
 * A `first_order.language.Theory` is a set of sentences.
 * The variables of terms and formulas can be relabelled with `first_order.language.term.relabel`,
 `first_order.language.bounded_formula.relabel`, and `first_order.language.formula.relabel`.
+* Given an operation on terms and an operation on relations,
+  `first_order.language.bounded_formula.map_term_rel` gives an operation on formulas.
 * `first_order.language.bounded_formula.cast_le` adds more `fin`-indexed variables.
 * `first_order.language.bounded_formula.lift_at` raises the indexes of the `fin`-indexed variables
 above a particular index.
@@ -29,6 +34,9 @@ above a particular index.
 variables with given terms.
 * Language maps can act on syntactic objects with functions such as
 `first_order.language.Lhom.on_formula`.
+* `first_order.language.term.constants_vars_equiv` and
+`first_order.language.bounded_formula.constants_vars_equiv` switch terms and formulas between having
+constants in the language and having extra variables indexed by the same type.
 
 ## Implementation Notes
 * Formulas use a modified version of de Bruijn variables. Specifically, a `L.bounded_formula α n`
@@ -53,7 +61,7 @@ namespace language
 
 variables (L : language.{u v}) {L' : language}
 variables {M : Type w} {N P : Type*} [L.Structure M] [L.Structure N] [L.Structure P]
-variables {α : Type u'} {β : Type v'}
+variables {α : Type u'} {β : Type v'} {γ : Type*}
 open_locale first_order
 open Structure fin
 
@@ -86,11 +94,39 @@ open finset
 | (var i) := var (g i)
 | (func f ts) := func f (λ i, (ts i).relabel)
 
+lemma relabel_id (t : L.term α) :
+  t.relabel id = t :=
+begin
+  induction t with _ _ _ _ ih,
+  { refl, },
+  { simp [ih] },
+end
+
+@[simp] lemma relabel_id_eq_id :
+  (term.relabel id : L.term α → L.term α) = id :=
+funext relabel_id
+
+@[simp] lemma relabel_relabel (f : α → β) (g : β → γ) (t : L.term α) :
+  (t.relabel f).relabel g = t.relabel (g ∘ f) :=
+begin
+  induction t with _ _ _ _ ih,
+  { refl, },
+  { simp [ih] },
+end
+
+@[simp] lemma relabel_comp_relabel (f : α → β) (g : β → γ) :
+  (term.relabel g ∘ term.relabel f : L.term α → L.term γ) = term.relabel (g ∘ f) :=
+funext (relabel_relabel f g)
+
+/-- Relabels a term's variables along a bijection. -/
+@[simps] def relabel_equiv (g : α ≃ β) : L.term α ≃ L.term β :=
+⟨relabel g, relabel g.symm, λ t, by simp, λ t, by simp⟩
+
 /-- Restricts a term to use only a set of the given variables. -/
 def restrict_var [decidable_eq α] : Π (t : L.term α) (f : t.var_finset → β), L.term β
 | (var a) f := var (f ⟨a, mem_singleton_self a⟩)
 | (func F ts) f := func F (λ i, (ts i).restrict_var
-  (f ∘ (set.inclusion (subset_bUnion_of_mem _ (mem_univ i)))))
+  (f ∘ set.inclusion (subset_bUnion_of_mem _ (mem_univ i))))
 
 /-- Restricts a term to use only a set of the given variables on the left side of a sum. -/
 def restrict_var_left [decidable_eq α] {γ : Type*} :
@@ -98,7 +134,7 @@ def restrict_var_left [decidable_eq α] {γ : Type*} :
 | (var (sum.inl a)) f := var (sum.inl (f ⟨a, mem_singleton_self a⟩))
 | (var (sum.inr a)) f := var (sum.inr a)
 | (func F ts) f := func F (λ i, (ts i).restrict_var_left
-  (f ∘ (set.inclusion (subset_bUnion_of_mem _ (mem_univ i)))))
+  (f ∘ set.inclusion (subset_bUnion_of_mem _ (mem_univ i))))
 
 end term
 
@@ -114,6 +150,54 @@ def functions.apply₂ (f : L.functions 2) (t₁ t₂ : L.term α) : L.term α :
 
 namespace term
 
+/-- Sends a term with constants to a term with extra variables. -/
+@[simp] def constants_to_vars : L[[γ]].term α → L.term (γ ⊕ α)
+| (var a) := var (sum.inr a)
+| (@func _ _ 0 f ts) := sum.cases_on f (λ f, func f (λ i, (ts i).constants_to_vars))
+    (λ c, var (sum.inl c))
+| (@func _ _ (n + 1) f ts) := sum.cases_on f (λ f, func f (λ i, (ts i).constants_to_vars))
+    (λ c, is_empty_elim c)
+
+/-- Sends a term with extra variables to a term with constants. -/
+@[simp] def vars_to_constants : L.term (γ ⊕ α) → L[[γ]].term α
+| (var (sum.inr a)) := var a
+| (var (sum.inl c)) := constants.term (sum.inr c)
+| (func f ts) := func (sum.inl f) (λ i, (ts i).vars_to_constants)
+
+/-- A bijection between terms with constants and terms with extra variables. -/
+@[simps] def constants_vars_equiv : L[[γ]].term α ≃ L.term (γ ⊕ α) :=
+⟨constants_to_vars, vars_to_constants, begin
+  intro t,
+  induction t with _ n f _ ih,
+  { refl },
+  { cases n,
+    { cases f,
+      { simp [constants_to_vars, vars_to_constants, ih] },
+      { simp [constants_to_vars, vars_to_constants, constants.term] } },
+    { cases f,
+      { simp [constants_to_vars, vars_to_constants, ih] },
+      { exact is_empty_elim f } } }
+end, begin
+  intro t,
+  induction t with x n f _ ih,
+  { cases x;
+    refl },
+  { cases n;
+    { simp [vars_to_constants, constants_to_vars, ih] } }
+end⟩
+
+/-- A bijection between terms with constants and terms with extra variables. -/
+def constants_vars_equiv_left : L[[γ]].term (α ⊕ β) ≃ L.term ((γ ⊕ α) ⊕ β) :=
+constants_vars_equiv.trans (relabel_equiv (equiv.sum_assoc _ _ _)).symm
+
+@[simp] lemma constants_vars_equiv_left_apply (t : L[[γ]].term (α ⊕ β)) :
+  constants_vars_equiv_left t = (constants_to_vars t).relabel (equiv.sum_assoc _ _ _).symm :=
+rfl
+
+@[simp] lemma constants_vars_equiv_left_symm_apply (t : L.term ((γ ⊕ α) ⊕ β)) :
+  constants_vars_equiv_left.symm t = vars_to_constants (t.relabel (equiv.sum_assoc _ _ _)) :=
+rfl
+
 instance inhabited_of_var [inhabited α] : inhabited (L.term α) :=
 ⟨var default⟩
 
@@ -131,7 +215,8 @@ relabel (sum.map id (λ i, if ↑i < m then fin.cast_add n' i else fin.add_nat n
 
 end term
 
-localized "prefix `&`:max := first_order.language.term.var ∘ sum.inr" in first_order
+localized "prefix (name := language.term.var) `&`:max :=
+  first_order.language.term.var ∘ sum.inr" in first_order
 
 namespace Lhom
 
@@ -263,53 +348,58 @@ open finset
 | n (all f) := f.free_var_finset
 
 /-- Casts `L.bounded_formula α m` as `L.bounded_formula α n`, where `m ≤ n`. -/
-def cast_le : ∀ {m n : ℕ} (h : m ≤ n), L.bounded_formula α m → L.bounded_formula α n
+@[simp] def cast_le : ∀ {m n : ℕ} (h : m ≤ n), L.bounded_formula α m → L.bounded_formula α n
 | m n h falsum := falsum
-| m n h (equal t₁ t₂) := (t₁.relabel (sum.map id (fin.cast_le h))).bd_equal
+| m n h (equal t₁ t₂) := equal (t₁.relabel (sum.map id (fin.cast_le h)))
     (t₂.relabel (sum.map id (fin.cast_le h)))
-| m n h (rel R ts) := R.bounded_formula (term.relabel (sum.map id (fin.cast_le h)) ∘ ts)
+| m n h (rel R ts) := rel R (term.relabel (sum.map id (fin.cast_le h)) ∘ ts)
 | m n h (imp f₁ f₂) := (f₁.cast_le h).imp (f₂.cast_le h)
 | m n h (all f) := (f.cast_le (add_le_add_right h 1)).all
 
-/-- A function to help relabel the variables in bounded formulas. -/
-def relabel_aux (g : α → (β ⊕ fin n)) (k : ℕ) :
-  α ⊕ fin k → β ⊕ fin (n + k) :=
-(sum.map id fin_sum_fin_equiv) ∘ (equiv.sum_assoc _ _ _) ∘ (sum.map g id)
+@[simp] lemma cast_le_rfl {n} (h : n ≤ n) (φ : L.bounded_formula α n) :
+  φ.cast_le h = φ :=
+begin
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
+  { refl },
+  { simp [fin.cast_le_of_eq], },
+  { simp [fin.cast_le_of_eq], },
+  { simp [fin.cast_le_of_eq, ih1, ih2], },
+  { simp [fin.cast_le_of_eq, ih3], },
+end
 
-@[simp] lemma sum_elim_comp_relabel_aux {m : ℕ} {g : α → (β ⊕ fin n)}
-  {v : β → M} {xs : fin (n + m) → M} :
-  sum.elim v xs ∘ relabel_aux g m =
-    sum.elim (sum.elim v (xs ∘ cast_add m) ∘ g) (xs ∘ nat_add n) :=
+@[simp] lemma cast_le_cast_le {k m n} (km : k ≤ m) (mn : m ≤ n) (φ : L.bounded_formula α k) :
+  (φ.cast_le km).cast_le mn = φ.cast_le (km.trans mn) :=
 begin
-  ext x,
-  cases x,
-  { simp only [bounded_formula.relabel_aux, function.comp_app, sum.map_inl, sum.elim_inl],
-    cases g x with l r;
+  revert m n,
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3;
+  intros m n km mn,
+  { refl },
+  { simp },
+  { simp only [cast_le, eq_self_iff_true, heq_iff_eq, true_and],
+    rw [← function.comp.assoc, relabel_comp_relabel],
     simp },
-  { simp [bounded_formula.relabel_aux] }
+  { simp [ih1, ih2] },
+  { simp only [cast_le, ih3] }
 end
 
-/-- Relabels a bounded formula's variables along a particular function. -/
-def relabel (g : α → (β ⊕ fin n)) :
-  ∀ {k : ℕ}, L.bounded_formula α k → L.bounded_formula β (n + k)
-| k falsum := falsum
-| k (equal t₁ t₂) := (t₁.relabel (relabel_aux g k)).bd_equal (t₂.relabel (relabel_aux g k))
-| k (rel R ts) := R.bounded_formula (term.relabel (relabel_aux g k) ∘ ts)
-| k (imp f₁ f₂) := f₁.relabel.imp f₂.relabel
-| k (all f) := f.relabel.all
+@[simp] lemma cast_le_comp_cast_le {k m n} (km : k ≤ m) (mn : m ≤ n) :
+  (bounded_formula.cast_le mn ∘ bounded_formula.cast_le km :
+    L.bounded_formula α k → L.bounded_formula α n) =
+    bounded_formula.cast_le (km.trans mn) :=
+funext (cast_le_cast_le km mn)
 
 /-- Restricts a bounded formula to only use a particular set of free variables. -/
 def restrict_free_var [decidable_eq α] : Π {n : ℕ} (φ : L.bounded_formula α n)
   (f : φ.free_var_finset → β), L.bounded_formula β n
 | n falsum f := falsum
 | n (equal t₁ t₂) f := equal
-  (t₁.restrict_var_left (f ∘ (set.inclusion (subset_union_left _ _))))
-  (t₂.restrict_var_left (f ∘ (set.inclusion (subset_union_right _ _))))
+  (t₁.restrict_var_left (f ∘ set.inclusion (subset_union_left _ _)))
+  (t₂.restrict_var_left (f ∘ set.inclusion (subset_union_right _ _)))
 | n (rel R ts) f := rel R (λ i, (ts i).restrict_var_left
   (f ∘ set.inclusion (subset_bUnion_of_mem _ (mem_univ i))))
 | n (imp φ₁ φ₂) f :=
-  (φ₁.restrict_free_var (f ∘ (set.inclusion (subset_union_left _ _)))).imp
-  (φ₂.restrict_free_var (f ∘ (set.inclusion (subset_union_right _ _))))
+  (φ₁.restrict_free_var (f ∘ set.inclusion (subset_union_left _ _))).imp
+  (φ₂.restrict_free_var (f ∘ set.inclusion (subset_union_right _ _)))
 | n (all φ) f := (φ.restrict_free_var f).all
 
 /-- Places universal quantifiers on all extra variables of a bounded formula. -/
@@ -322,23 +412,156 @@ def exs : ∀ {n}, L.bounded_formula α n → L.formula α
 | 0 φ := φ
 | (n + 1) φ := φ.ex.exs
 
+/-- Maps bounded formulas along a map of terms and a map of relations. -/
+def map_term_rel {g : ℕ → ℕ}
+  (ft : ∀ n, L.term (α ⊕ fin n) → L'.term (β ⊕ fin (g n)))
+  (fr : ∀ n, L.relations n → L'.relations n)
+  (h : ∀ n, L'.bounded_formula β (g (n + 1)) → L'.bounded_formula β (g n + 1)) :
+  ∀ {n}, L.bounded_formula α n → L'.bounded_formula β (g n)
+| n falsum := falsum
+| n (equal t₁ t₂) := equal (ft _ t₁) (ft _ t₂)
+| n (rel R ts) := rel (fr _ R) (λ i, ft _ (ts i))
+| n (imp φ₁ φ₂) := φ₁.map_term_rel.imp φ₂.map_term_rel
+| n (all φ) := (h n φ.map_term_rel).all
+
 /-- Raises all of the `fin`-indexed variables of a formula greater than or equal to `m` by `n'`. -/
-def lift_at : ∀ {n : ℕ} (n' m : ℕ), L.bounded_formula α n → L.bounded_formula α (n + n')
-| n n' m falsum := falsum
-| n n' m (equal t₁ t₂) := (t₁.lift_at n' m).bd_equal (t₂.lift_at n' m)
-| n n' m (rel R ts) := R.bounded_formula (term.lift_at n' m ∘ ts)
-| n n' m (imp f₁ f₂) := (f₁.lift_at n' m).imp (f₂.lift_at n' m)
-| n n' m (all f) := ((f.lift_at n' m).cast_le (by rw [add_assoc, add_comm 1, ← add_assoc])).all
+def lift_at : ∀ {n : ℕ} (n' m : ℕ), L.bounded_formula α n → L.bounded_formula α (n + n') :=
+λ n n' m φ, φ.map_term_rel (λ k t, t.lift_at n' m) (λ _, id)
+  (λ _, cast_le (by rw [add_assoc, add_comm 1, add_assoc]))
+
+@[simp] lemma map_term_rel_map_term_rel {L'' : language}
+  (ft : ∀ n, L.term (α ⊕ fin n) → L'.term (β ⊕ fin n))
+  (fr : ∀ n, L.relations n → L'.relations n)
+  (ft' : ∀ n, L'.term (β ⊕ fin n) → L''.term (γ ⊕ fin n))
+  (fr' : ∀ n, L'.relations n → L''.relations n)
+  {n} (φ : L.bounded_formula α n) :
+  (φ.map_term_rel ft fr (λ _, id)).map_term_rel ft' fr' (λ _, id) =
+    φ.map_term_rel (λ _, (ft' _) ∘ (ft _)) (λ _, (fr' _) ∘ (fr _)) (λ _, id) :=
+begin
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
+  { refl },
+  { simp [map_term_rel] },
+  { simp [map_term_rel] },
+  { simp [map_term_rel, ih1, ih2] },
+  { simp [map_term_rel, ih3], }
+end
+
+@[simp] lemma map_term_rel_id_id_id {n} (φ : L.bounded_formula α n) :
+  φ.map_term_rel (λ _, id) (λ _, id) (λ _, id) = φ :=
+begin
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
+  { refl },
+  { simp [map_term_rel] },
+  { simp [map_term_rel] },
+  { simp [map_term_rel, ih1, ih2] },
+  { simp [map_term_rel, ih3], }
+end
+
+/-- An equivalence of bounded formulas given by an equivalence of terms and an equivalence of
+relations. -/
+@[simps] def map_term_rel_equiv (ft : ∀ n, L.term (α ⊕ fin n) ≃ L'.term (β ⊕ fin n))
+  (fr : ∀ n, L.relations n ≃ L'.relations n) {n} :
+  L.bounded_formula α n ≃ L'.bounded_formula β n :=
+⟨map_term_rel (λ n, ft n) (λ n, fr n) (λ _, id),
+  map_term_rel (λ n, (ft n).symm) (λ n, (fr n).symm) (λ _, id),
+  λ φ, by simp, λ φ, by simp⟩
+
+/-- A function to help relabel the variables in bounded formulas. -/
+def relabel_aux (g : α → β ⊕ fin n) (k : ℕ) :
+  α ⊕ fin k → β ⊕ fin (n + k) :=
+sum.map id fin_sum_fin_equiv ∘ equiv.sum_assoc _ _ _ ∘ sum.map g id
+
+@[simp] lemma sum_elim_comp_relabel_aux {m : ℕ} {g : α → (β ⊕ fin n)}
+  {v : β → M} {xs : fin (n + m) → M} :
+  sum.elim v xs ∘ relabel_aux g m =
+    sum.elim (sum.elim v (xs ∘ cast_add m) ∘ g) (xs ∘ nat_add n) :=
+begin
+  ext x,
+  cases x,
+  { simp only [bounded_formula.relabel_aux, function.comp_app, sum.map_inl, sum.elim_inl],
+    cases g x with l r;
+    simp },
+  { simp [bounded_formula.relabel_aux] }
+end
+
+@[simp] lemma relabel_aux_sum_inl (k : ℕ) :
+  relabel_aux (sum.inl : α → α ⊕ fin n) k =
+  sum.map id (nat_add n) :=
+begin
+  ext x,
+  cases x;
+  { simp [relabel_aux] },
+end
+
+/-- Relabels a bounded formula's variables along a particular function. -/
+def relabel (g : α → (β ⊕ fin n)) {k} (φ : L.bounded_formula α k) :
+  L.bounded_formula β (n + k) :=
+φ.map_term_rel (λ _ t, t.relabel (relabel_aux g _)) (λ _, id)
+  (λ _, cast_le (ge_of_eq (add_assoc _ _ _)))
+
+/-- Relabels a bounded formula's free variables along a bijection. -/
+def relabel_equiv (g : α ≃ β) {k} :
+  L.bounded_formula α k ≃ L.bounded_formula β k :=
+map_term_rel_equiv (λ n, term.relabel_equiv (g.sum_congr (_root_.equiv.refl _)))
+  (λ n, _root_.equiv.refl _)
+
+@[simp] lemma relabel_falsum (g : α → (β ⊕ fin n)) {k} :
+  (falsum : L.bounded_formula α k).relabel g = falsum :=
+rfl
+
+@[simp] lemma relabel_bot (g : α → (β ⊕ fin n)) {k} :
+  (⊥ : L.bounded_formula α k).relabel g = ⊥ :=
+rfl
+
+@[simp] lemma relabel_imp (g : α → (β ⊕ fin n)) {k} (φ ψ : L.bounded_formula α k) :
+  (φ.imp ψ).relabel g = (φ.relabel g).imp (ψ.relabel g) :=
+rfl
+
+@[simp] lemma relabel_not (g : α → (β ⊕ fin n)) {k} (φ : L.bounded_formula α k) :
+  φ.not.relabel g = (φ.relabel g).not :=
+by simp [bounded_formula.not]
+
+@[simp] lemma relabel_all (g : α → (β ⊕ fin n)) {k} (φ : L.bounded_formula α (k + 1)) :
+  φ.all.relabel g = (φ.relabel g).all :=
+begin
+  rw [relabel, map_term_rel, relabel],
+  simp,
+end
+
+@[simp] lemma relabel_ex (g : α → (β ⊕ fin n)) {k} (φ : L.bounded_formula α (k + 1)) :
+  φ.ex.relabel g = (φ.relabel g).ex :=
+by simp [bounded_formula.ex]
+
+@[simp] lemma relabel_sum_inl (φ : L.bounded_formula α n) :
+  (φ.relabel sum.inl : L.bounded_formula α (0 + n)) =
+  φ.cast_le (ge_of_eq (zero_add n)) :=
+begin
+  simp only [relabel, relabel_aux_sum_inl],
+  induction φ with _ _ _ _ _ _ _ _ _ _ _ ih1 ih2 _ _ ih3,
+  { refl },
+  { simp [fin.nat_add_zero, cast_le_of_eq, map_term_rel] },
+  { simp [fin.nat_add_zero, cast_le_of_eq, map_term_rel] },
+  { simp [map_term_rel, ih1, ih2], },
+  { simp [map_term_rel, ih3, cast_le], },
+end
 
 /-- Substitutes the variables in a given formula with terms. -/
-@[simp] def subst : ∀ {n : ℕ}, L.bounded_formula α n → (α → L.term β) → L.bounded_formula β n
-| n falsum tf := falsum
-| n (equal t₁ t₂) tf := equal (t₁.subst (sum.elim (term.relabel sum.inl ∘ tf) (var ∘ sum.inr)))
-  (t₂.subst (sum.elim (term.relabel sum.inl ∘ tf) (var ∘ sum.inr)))
-| n (rel R ts) tf := rel R
-  (λ i, (ts i).subst (sum.elim (term.relabel sum.inl ∘ tf) (var ∘ sum.inr)))
-| n (imp φ₁ φ₂) tf := (φ₁.subst tf).imp (φ₂.subst tf)
-| n (all φ) tf := (φ.subst tf).all
+@[simp] def subst {n : ℕ} (φ : L.bounded_formula α n) (f : α → L.term β) : L.bounded_formula β n :=
+φ.map_term_rel (λ _ t, t.subst (sum.elim (term.relabel sum.inl ∘ f) (var ∘ sum.inr)))
+  (λ _, id) (λ _, id)
+
+/-- A bijection sending formulas with constants to formulas with extra variables. -/
+def constants_vars_equiv : L[[γ]].bounded_formula α n ≃ L.bounded_formula (γ ⊕ α) n :=
+map_term_rel_equiv (λ _, term.constants_vars_equiv_left) (λ _, equiv.sum_empty _ _)
+
+/-- Turns the extra variables of a bounded formula into free variables. -/
+@[simp] def to_formula : ∀ {n : ℕ}, L.bounded_formula α n → L.formula (α ⊕ fin n)
+| n falsum := falsum
+| n (equal t₁ t₂) := t₁.equal t₂
+| n (rel R ts) := R.formula ts
+| n (imp φ₁ φ₂) := φ₁.to_formula.imp φ₂.to_formula
+| n (all φ) := (φ.to_formula.relabel
+  (sum.elim (sum.inl ∘ sum.inl) (sum.map sum.inr id ∘ fin_sum_fin_equiv.symm))).all
 
 variables {l : ℕ} {φ ψ : L.bounded_formula α l} {θ : L.bounded_formula α l.succ}
 variables {v : α → M} {xs : fin l → M}
@@ -439,7 +662,10 @@ is_prenex.rec_on h (λ _ _, hq) (λ _ _ _, ha) (λ _ _ _ ih, hn (ha (hn ih)))
 lemma is_prenex.relabel {m : ℕ} {φ : L.bounded_formula α m} (h : φ.is_prenex)
   (f : α → β ⊕ (fin n)) :
   (φ.relabel f).is_prenex :=
-is_prenex.rec_on h (λ _ _ h, (h.relabel f).is_prenex) (λ _ _ _ h, h.all) (λ _ _ _ h, h.ex)
+is_prenex.rec_on h
+  (λ _ _ h, (h.relabel f).is_prenex)
+  (λ _ _ _ h, by simp [h.all])
+  (λ _ _ _ h, by simp [h.ex])
 
 lemma is_prenex.cast_le (hφ : is_prenex φ) :
   ∀ {n} {h : l ≤ n}, (φ.cast_le h).is_prenex :=
@@ -629,15 +855,21 @@ rfl
 
 end Lequiv
 
-localized "infix ` =' `:88 := first_order.language.term.bd_equal" in first_order
+localized "infix (name := term.bd_equal)
+  ` =' `:88 := first_order.language.term.bd_equal" in first_order
   -- input \~- or \simeq
-localized "infixr ` ⟹ `:62 := first_order.language.bounded_formula.imp" in first_order
+localized "infixr (name := bounded_formula.imp)
+  ` ⟹ `:62 := first_order.language.bounded_formula.imp" in first_order
   -- input \==>
-localized "prefix `∀'`:110 := first_order.language.bounded_formula.all" in first_order
-localized "prefix `∼`:max := first_order.language.bounded_formula.not" in first_order
+localized "prefix (name := bounded_formula.all)
+  `∀'`:110 := first_order.language.bounded_formula.all" in first_order
+localized "prefix (name := bounded_formula.not)
+  `∼`:max := first_order.language.bounded_formula.not" in first_order
   -- input \~, the ASCII character ~ has too low precedence
-localized "infix ` ⇔ `:61 := first_order.language.bounded_formula.iff" in first_order -- input \<=>
-localized "prefix `∃'`:110 := first_order.language.bounded_formula.ex" in first_order -- input \ex
+localized "infix (name := bounded_formula.iff)
+  ` ⇔ `:61 := first_order.language.bounded_formula.iff" in first_order -- input \<=>
+localized "prefix (name := bounded_formula.ex)
+  `∃'`:110 := first_order.language.bounded_formula.ex" in first_order -- input \ex
 
 namespace formula
 
@@ -661,6 +893,19 @@ protected def iff (φ ψ : L.formula α) : L.formula α := φ.iff ψ
 lemma is_atomic_graph (f : L.functions n) : (graph f).is_atomic :=
 bounded_formula.is_atomic.equal _ _
 
+/-- A bijection sending formulas to sentences with constants. -/
+def equiv_sentence : L.formula α ≃ L[[α]].sentence :=
+(bounded_formula.constants_vars_equiv.trans
+  (bounded_formula.relabel_equiv (equiv.sum_empty _ _))).symm
+
+lemma equiv_sentence_not (φ : L.formula α) :
+  equiv_sentence φ.not = (equiv_sentence φ).not :=
+rfl
+
+lemma equiv_sentence_inf (φ ψ : L.formula α) :
+  equiv_sentence (φ ⊓ ψ) = equiv_sentence φ ⊓ equiv_sentence ψ :=
+rfl
+
 end formula
 
 namespace relations
@@ -707,7 +952,7 @@ def nonempty_theory : L.Theory := {sentence.card_ge L 1}
 
 /-- A theory indicating that each of a set of constants is distinct. -/
 def distinct_constants_theory (s : set α) : L[[α]].Theory :=
-((s ×ˢ s) ∩ (set.diagonal α).compl).image (λ ab, (((L.con ab.1).term.equal (L.con ab.2).term).not))
+(λ ab : α × α, (((L.con ab.1).term.equal (L.con ab.2).term).not)) '' (s ×ˢ s ∩ (set.diagonal α)ᶜ)
 
 variables {L} {α}
 
diff --git a/src/model_theory/types.lean b/src/model_theory/types.lean
new file mode 100644
index 0000000000000..bcc49d9b00d11
--- /dev/null
+++ b/src/model_theory/types.lean
@@ -0,0 +1,212 @@
+/-
+Copyright (c) 2022 Aaron Anderson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Aaron Anderson
+-/
+import model_theory.satisfiability
+
+/-!
+# Type Spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+This file defines the space of complete types over a first-order theory.
+(Note that types in model theory are different from types in type theory.)
+
+## Main Definitions
+* `first_order.language.Theory.complete_type`:
+  `T.complete_type α` consists of complete types over the theory `T` with variables `α`.
+* `first_order.language.Theory.type_of` is the type of a given tuple.
+* `first_order.language.Theory.realized_types`: `T.realized_types M α` is the set of
+  types in `T.complete_type α` that are realized in `M` - that is, the type of some tuple in `M`.
+
+## Main Results
+* `first_order.language.Theory.complete_type.nonempty_iff`:
+  The space `T.complete_type α` is nonempty exactly when `T` is satisfiable.
+* `first_order.language.Theory.complete_type.exists_Model_is_realized_in`: Every type is realized in
+some model.
+
+## Implementation Notes
+* Complete types are implemented as maximal consistent theories in an expanded language.
+More frequently they are described as maximal consistent sets of formulas, but this is equivalent.
+
+## TODO
+* Connect `T.complete_type α` to sets of formulas `L.formula α`.
+
+-/
+
+universes u v w w'
+
+open cardinal set
+open_locale cardinal first_order classical
+
+namespace first_order
+namespace language
+namespace Theory
+
+variables {L : language.{u v}} (T : L.Theory) (α : Type w)
+
+/-- A complete type over a given theory in a certain type of variables is a maximally
+  consistent (with the theory) set of formulas in that type. -/
+structure complete_type :=
+(to_Theory : L[[α]].Theory)
+(subset' : (L.Lhom_with_constants α).on_Theory T ⊆ to_Theory)
+(is_maximal' : to_Theory.is_maximal)
+
+variables {T α}
+
+namespace complete_type
+
+instance : set_like (T.complete_type α) (L[[α]].sentence) :=
+⟨λ p, p.to_Theory, λ p q h, begin
+  cases p,
+  cases q,
+  congr',
+end⟩
+
+lemma is_maximal (p : T.complete_type α) : is_maximal (p : L[[α]].Theory) :=
+p.is_maximal'
+
+lemma subset (p : T.complete_type α) :
+  (L.Lhom_with_constants α).on_Theory T ⊆ (p : L[[α]].Theory) :=
+p.subset'
+
+lemma mem_or_not_mem (p : T.complete_type α) (φ : L[[α]].sentence) : φ ∈ p ∨ φ.not ∈ p :=
+p.is_maximal.mem_or_not_mem φ
+
+lemma mem_of_models (p : T.complete_type α) {φ : L[[α]].sentence}
+  (h : (L.Lhom_with_constants α).on_Theory T ⊨ φ) :
+  φ ∈ p :=
+(p.mem_or_not_mem φ).resolve_right (λ con, ((models_iff_not_satisfiable _).1 h)
+  (p.is_maximal.1.mono (union_subset p.subset (singleton_subset_iff.2 con))))
+
+lemma not_mem_iff (p : T.complete_type α) (φ : L[[α]].sentence) :
+  φ.not ∈ p ↔ ¬ φ ∈ p :=
+⟨λ hf ht, begin
+  have h : ¬ is_satisfiable ({φ, φ.not} : L[[α]].Theory),
+  { rintro ⟨@⟨_, _, h, _⟩⟩,
+    simp only [model_iff, mem_insert_iff, mem_singleton_iff, forall_eq_or_imp,
+      forall_eq] at h,
+    exact h.2 h.1 },
+  refine h (p.is_maximal.1.mono _),
+  rw [insert_subset, singleton_subset_iff],
+  exact ⟨ht, hf⟩,
+end, (p.mem_or_not_mem φ).resolve_left⟩
+
+@[simp] lemma compl_set_of_mem {φ : L[[α]].sentence} :
+  {p : T.complete_type α | φ ∈ p}ᶜ = {p : T.complete_type α | φ.not ∈ p} :=
+ext (λ _, (not_mem_iff _ _).symm)
+
+lemma set_of_subset_eq_empty_iff (S : L[[α]].Theory) :
+  {p : T.complete_type α | S ⊆ ↑p} = ∅ ↔
+    ¬ ((L.Lhom_with_constants α).on_Theory T ∪ S).is_satisfiable :=
+begin
+  rw [iff_not_comm, ← not_nonempty_iff_eq_empty, not_not, set.nonempty],
+  refine ⟨λ h, ⟨⟨L[[α]].complete_theory h.some, (subset_union_left _ S).trans
+    complete_theory.subset, complete_theory.is_maximal _ _⟩, (subset_union_right
+      ((L.Lhom_with_constants α).on_Theory T) _).trans complete_theory.subset⟩, _⟩,
+  rintro ⟨p, hp⟩,
+  exact p.is_maximal.1.mono (union_subset p.subset hp),
+end
+
+lemma set_of_mem_eq_univ_iff (φ : L[[α]].sentence) :
+  {p : T.complete_type α | φ ∈ p} = univ ↔ (L.Lhom_with_constants α).on_Theory T ⊨ φ :=
+begin
+  rw [models_iff_not_satisfiable, ← compl_empty_iff, compl_set_of_mem,
+    ← set_of_subset_eq_empty_iff],
+  simp,
+end
+
+lemma set_of_subset_eq_univ_iff (S : L[[α]].Theory) :
+  {p : T.complete_type α | S ⊆ ↑p} = univ ↔
+    (∀ φ, φ ∈ S → (L.Lhom_with_constants α).on_Theory T ⊨ φ) :=
+begin
+  have h : {p : T.complete_type α | S ⊆ ↑p} = ⋂₀ ((λ φ, {p | φ ∈ p}) '' S),
+  { ext,
+    simp [subset_def] },
+  simp_rw [h, sInter_eq_univ, ← set_of_mem_eq_univ_iff],
+  refine ⟨λ h φ φS, h _ ⟨_, φS, rfl⟩, _⟩,
+  rintro h _ ⟨φ, h1, rfl⟩,
+  exact h _ h1,
+end
+
+lemma nonempty_iff : nonempty (T.complete_type α) ↔
+  T.is_satisfiable :=
+begin
+  rw ← is_satisfiable_on_Theory_iff (Lhom_with_constants_injective L α),
+  rw [nonempty_iff_univ_nonempty, nonempty_iff_ne_empty, ne.def, not_iff_comm,
+    ← union_empty ((L.Lhom_with_constants α).on_Theory T), ← set_of_subset_eq_empty_iff],
+  simp,
+end
+
+instance : nonempty (complete_type ∅ α) :=
+nonempty_iff.2 (is_satisfiable_empty L)
+
+lemma Inter_set_of_subset {ι : Type*} (S : ι → L[[α]].Theory) :
+  (⋂ (i : ι), {p : T.complete_type α | S i ⊆ p}) = {p | (⋃ (i : ι), S i) ⊆ p} :=
+begin
+  ext,
+  simp only [mem_Inter, mem_set_of_eq, Union_subset_iff],
+end
+
+lemma to_list_foldr_inf_mem {p : T.complete_type α} {t : finset (L[[α]]).sentence} :
+  t.to_list.foldr (⊓) ⊤ ∈ p ↔ (t : L[[α]].Theory) ⊆ ↑p :=
+begin
+  simp_rw [subset_def, ← set_like.mem_coe, p.is_maximal.mem_iff_models, models_sentence_iff,
+    sentence.realize, formula.realize, bounded_formula.realize_foldr_inf, finset.mem_to_list],
+  exact ⟨λ h φ hφ M, h _ _ hφ, λ h M φ hφ, h _ hφ _⟩,
+end
+
+end complete_type
+
+variables {M : Type w'} [L.Structure M] [nonempty M] [M ⊨ T] (T)
+
+/-- The set of all formulas true at a tuple in a structure forms a complete type. -/
+def type_of (v : α → M) : T.complete_type α :=
+begin
+  haveI : (constants_on α).Structure M := constants_on.Structure v,
+  exact { to_Theory := L[[α]].complete_theory M,
+    subset' := model_iff_subset_complete_theory.1 ((Lhom.on_Theory_model _ T).2 infer_instance),
+    is_maximal' := complete_theory.is_maximal _ _ },
+end
+
+namespace complete_type
+
+variables {T} {v : α → M}
+
+@[simp] lemma mem_type_of {φ : L[[α]].sentence} :
+  φ ∈ T.type_of v ↔ (formula.equiv_sentence.symm φ).realize v :=
+begin
+  letI : (constants_on α).Structure M := constants_on.Structure v,
+  exact mem_complete_theory.trans (formula.realize_equiv_sentence_symm _ _ _).symm,
+end
+
+lemma formula_mem_type_of {φ : L.formula α} :
+  formula.equiv_sentence φ ∈ T.type_of v ↔ φ.realize v :=
+by simp
+
+end complete_type
+
+variable (M)
+
+/-- A complete type `p` is realized in a particular structure when there is some
+  tuple `v` whose type is `p`. -/
+@[simp] def realized_types (α : Type w) : set (T.complete_type α) :=
+set.range (T.type_of : (α → M) → T.complete_type α)
+
+theorem exists_Model_is_realized_in (p : T.complete_type α) :
+  ∃ (M : Theory.Model.{u v (max u v w)} T),
+    p ∈ T.realized_types M α :=
+begin
+  obtain ⟨M⟩ := p.is_maximal.1,
+  refine ⟨(M.subtheory_Model p.subset).reduct (L.Lhom_with_constants α), (λ a, (L.con a : M)), _⟩,
+  refine set_like.ext (λ φ, _),
+  simp only [complete_type.mem_type_of],
+  refine (formula.realize_equiv_sentence_symm_con _ _).trans (trans (trans _
+    (p.is_maximal.is_complete.realize_sentence_iff φ M)) (p.is_maximal.mem_iff_models φ).symm),
+  refl,
+end
+
+end Theory
+end language
+end first_order
diff --git a/src/model_theory/ultraproducts.lean b/src/model_theory/ultraproducts.lean
index 4c9363e172200..e8608d43a9b42 100644
--- a/src/model_theory/ultraproducts.lean
+++ b/src/model_theory/ultraproducts.lean
@@ -9,6 +9,9 @@ import order.filter.ultrafilter
 
 /-! # Ultraproducts and Łoś's Theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 * `first_order.language.ultraproduct.Structure` is the ultraproduct structure on `filter.product`.
 
diff --git a/src/number_theory/ADE_inequality.lean b/src/number_theory/ADE_inequality.lean
index a0e005f382dc4..5ba14070ab98c 100644
--- a/src/number_theory/ADE_inequality.lean
+++ b/src/number_theory/ADE_inequality.lean
@@ -7,7 +7,7 @@ Authors: Johan Commelin
 import data.multiset.sort
 import data.pnat.interval
 import data.rat.order
-
+import data.pnat.basic
 import tactic.norm_num
 import tactic.field_simp
 import tactic.interval_cases
@@ -16,6 +16,9 @@ import tactic.interval_cases
 /-!
 # The inequality `p⁻¹ + q⁻¹ + r⁻¹ > 1`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we classify solutions to the inequality
 `(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`, for positive natural numbers `p`, `q`, and `r`.
 
diff --git a/src/number_theory/arithmetic_function.lean b/src/number_theory/arithmetic_function.lean
index 967b2ddb6d76a..066d7936becc0 100644
--- a/src/number_theory/arithmetic_function.lean
+++ b/src/number_theory/arithmetic_function.lean
@@ -4,14 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
 import algebra.big_operators.ring
+import algebra.module.big_operators
 import number_theory.divisors
-import algebra.squarefree
+import data.nat.squarefree
+import data.nat.gcd.big_operators
 import algebra.invertible
-import data.nat.factorization
+import data.nat.factorization.basic
 
 /-!
 # Arithmetic Functions and Dirichlet Convolution
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines arithmetic functions, which are functions from `ℕ` to a specified type that map 0
 to 0. In the literature, they are often instead defined as functions from `ℕ+`. These arithmetic
 functions are endowed with a multiplication, given by Dirichlet convolution, and pointwise addition,
@@ -91,16 +96,16 @@ variable [has_one R]
 
 instance : has_one (arithmetic_function R) := ⟨⟨λ x, ite (x = 1) 1 0, rfl⟩⟩
 
-@[simp]
-lemma one_one : (1 : arithmetic_function R) 1 = 1 := rfl
+lemma one_apply {x : ℕ} : (1 : arithmetic_function R) x = ite (x = 1) 1 0 := rfl
 
-@[simp]
-lemma one_apply_ne {x : ℕ} (h : x ≠ 1) : (1 : arithmetic_function R) x = 0 := if_neg h
+@[simp] lemma one_one : (1 : arithmetic_function R) 1 = 1 := rfl
+
+@[simp] lemma one_apply_ne {x : ℕ} (h : x ≠ 1) : (1 : arithmetic_function R) x = 0 := if_neg h
 
 end has_one
 end has_zero
 
-instance nat_coe [has_zero R] [has_one R] [has_add R] :
+instance nat_coe [add_monoid_with_one R] :
   has_coe (arithmetic_function ℕ) (arithmetic_function R) :=
 ⟨λ f, ⟨↑(f : ℕ → ℕ), by { transitivity ↑(f 0), refl, simp }⟩⟩
 
@@ -110,10 +115,10 @@ lemma nat_coe_nat (f : arithmetic_function ℕ) :
 ext $ λ _, cast_id _
 
 @[simp]
-lemma nat_coe_apply [has_zero R] [has_one R] [has_add R] {f : arithmetic_function ℕ} {x : ℕ} :
+lemma nat_coe_apply [add_monoid_with_one R] {f : arithmetic_function ℕ} {x : ℕ} :
   (f : arithmetic_function R) x = f x := rfl
 
-instance int_coe [has_zero R] [has_one R] [has_add R] [has_neg R] :
+instance int_coe [add_group_with_one R] :
   has_coe (arithmetic_function ℤ) (arithmetic_function R) :=
 ⟨λ f, ⟨↑(f : ℕ → ℤ), by { transitivity ↑(f 0), refl, simp }⟩⟩
 
@@ -123,15 +128,23 @@ lemma int_coe_int (f : arithmetic_function ℤ) :
 ext $ λ _, int.cast_id _
 
 @[simp]
-lemma int_coe_apply [has_zero R] [has_one R] [has_add R] [has_neg R]
+lemma int_coe_apply [add_group_with_one R]
   {f : arithmetic_function ℤ} {x : ℕ} :
   (f : arithmetic_function R) x = f x := rfl
 
 @[simp]
-lemma coe_coe [has_zero R] [has_one R] [has_add R] [has_neg R] {f : arithmetic_function ℕ} :
+lemma coe_coe [add_group_with_one R] {f : arithmetic_function ℕ} :
   ((f : arithmetic_function ℤ) : arithmetic_function R) = f :=
 by { ext, simp, }
 
+@[simp] lemma nat_coe_one [add_monoid_with_one R] :
+  ((1 : arithmetic_function ℕ) : arithmetic_function R) = 1 :=
+by { ext n, simp [one_apply] }
+
+@[simp] lemma int_coe_one [add_group_with_one R] :
+  ((1 : arithmetic_function ℤ) : arithmetic_function R) = 1 :=
+by { ext n, simp [one_apply] }
+
 section add_monoid
 
 variable [add_monoid R]
@@ -150,6 +163,12 @@ instance : add_monoid (arithmetic_function R) :=
 
 end add_monoid
 
+instance [add_monoid_with_one R] : add_monoid_with_one (arithmetic_function R) :=
+{ nat_cast := λ n, ⟨λ x, if x = 1 then (n : R) else 0, by simp⟩,
+  nat_cast_zero := by ext; simp [nat.cast],
+  nat_cast_succ := λ _, by ext; by_cases x = 1; simp [nat.cast, *],
+  .. arithmetic_function.add_monoid, .. arithmetic_function.has_one }
+
 instance [add_comm_monoid R] : add_comm_monoid (arithmetic_function R) :=
 { add_comm := λ _ _, ext (λ _, add_comm _ _),
   .. arithmetic_function.add_monoid }
@@ -163,19 +182,19 @@ instance [add_comm_group R] : add_comm_group (arithmetic_function R) :=
 { .. arithmetic_function.add_comm_monoid,
   .. arithmetic_function.add_group }
 
-section has_scalar
-variables {M : Type*} [has_zero R] [add_comm_monoid M] [has_scalar R M]
+section has_smul
+variables {M : Type*} [has_zero R] [add_comm_monoid M] [has_smul R M]
 
 /-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
   such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
-instance : has_scalar (arithmetic_function R) (arithmetic_function M) :=
+instance : has_smul (arithmetic_function R) (arithmetic_function M) :=
 ⟨λ f g, ⟨λ n, ∑ x in divisors_antidiagonal n, f x.fst • g x.snd, by simp⟩⟩
 
 @[simp]
 lemma smul_apply {f : arithmetic_function R} {g : arithmetic_function M} {n : ℕ} :
   (f • g) n = ∑ x in divisors_antidiagonal n, f x.fst • g x.snd := rfl
 
-end has_scalar
+end has_smul
 
 /-- The Dirichlet convolution of two arithmetic functions `f` and `g` is another arithmetic function
   such that `(f * g) n` is the sum of `f x * g y` over all `(x,y)` such that `x * y = n`. -/
@@ -185,6 +204,18 @@ instance [semiring R] : has_mul (arithmetic_function R) := ⟨(•)⟩
 lemma mul_apply [semiring R] {f g : arithmetic_function R} {n : ℕ} :
   (f * g) n = ∑ x in divisors_antidiagonal n, f x.fst * g x.snd := rfl
 
+lemma mul_apply_one [semiring R] {f g : arithmetic_function R} :
+  (f * g) 1 = f 1 * g 1 :=
+by simp
+
+@[simp, norm_cast] lemma nat_coe_mul [semiring R] {f g : arithmetic_function ℕ} :
+  (↑(f * g) : arithmetic_function R) = f * g :=
+by { ext n, simp }
+
+@[simp, norm_cast] lemma int_coe_mul [ring R] {f g : arithmetic_function ℤ} :
+  (↑(f * g) : arithmetic_function R) = f * g :=
+by { ext n, simp }
+
 section module
 variables {M : Type*} [semiring R] [add_comm_monoid M] [module R M]
 
@@ -271,6 +302,7 @@ instance : semiring (arithmetic_function R) :=
   .. arithmetic_function.has_mul,
   .. arithmetic_function.has_add,
   .. arithmetic_function.add_comm_monoid,
+  .. arithmetic_function.add_monoid_with_one,
   .. arithmetic_function.monoid }
 
 end semiring
@@ -300,85 +332,41 @@ section zeta
 def zeta : arithmetic_function ℕ :=
 ⟨λ x, ite (x = 0) 0 1, rfl⟩
 
-localized "notation `ζ` := nat.arithmetic_function.zeta" in arithmetic_function
+localized "notation (name := arithmetic_function.zeta)
+  `ζ` := nat.arithmetic_function.zeta" in arithmetic_function
 
 @[simp]
 lemma zeta_apply {x : ℕ} : ζ x = if (x = 0) then 0 else 1 := rfl
 
 lemma zeta_apply_ne {x : ℕ} (h : x ≠ 0) : ζ x = 1 := if_neg h
 
-@[simp]
-theorem coe_zeta_mul_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
-  (↑ζ * f) x = ∑ i in divisors x, f i :=
-begin
-  rw mul_apply,
-  transitivity ∑ i in divisors_antidiagonal x, f i.snd,
-  { apply sum_congr rfl,
-    intros i hi,
-    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
-    rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_mul] },
-  { apply sum_bij (λ i h, prod.snd i),
-    { rintros ⟨a, b⟩ h, simp [snd_mem_divisors_of_mem_antidiagonal h] },
-    { rintros ⟨a, b⟩ h, refl },
-    { rintros ⟨a1, b1⟩ ⟨a2, b2⟩ h1 h2 h,
-      dsimp at h,
-      rw h at *,
-      rw mem_divisors_antidiagonal at *,
-      ext, swap, {refl},
-      simp only [prod.fst, prod.snd] at *,
-      apply nat.eq_of_mul_eq_mul_right _ (eq.trans h1.1 h2.1.symm),
-      rcases h1 with ⟨rfl, h⟩,
-      apply nat.pos_of_ne_zero (right_ne_zero_of_mul h) },
-    { intros a ha,
-      rcases mem_divisors.1 ha with ⟨⟨b, rfl⟩, ne0⟩,
-      use (b, a),
-      simp [ne0, mul_comm] } }
-end
-
-theorem coe_zeta_smul_apply {M : Type*} [comm_ring R] [add_comm_group M] [module R M]
+@[simp] theorem coe_zeta_smul_apply {M} [semiring R] [add_comm_monoid M] [module R M]
   {f : arithmetic_function M} {x : ℕ} :
   ((↑ζ : arithmetic_function R) • f) x = ∑ i in divisors x, f i :=
 begin
   rw smul_apply,
   transitivity ∑ i in divisors_antidiagonal x, f i.snd,
-  { apply sum_congr rfl,
-    intros i hi,
+  { refine sum_congr rfl (λ i hi, _),
     rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
     rw [nat_coe_apply, zeta_apply_ne (left_ne_zero_of_mul h), cast_one, one_smul] },
-  { apply sum_bij (λ i h, prod.snd i),
-    { rintros ⟨a, b⟩ h, simp [snd_mem_divisors_of_mem_antidiagonal h] },
-    { rintros ⟨a, b⟩ h, refl },
-    { rintros ⟨a1, b1⟩ ⟨a2, b2⟩ h1 h2 h,
-      dsimp at h,
-      rw h at *,
-      rw mem_divisors_antidiagonal at *,
-      ext, swap, {refl},
-      simp only [prod.fst, prod.snd] at *,
-      apply nat.eq_of_mul_eq_mul_right _ (eq.trans h1.1 h2.1.symm),
-      rcases h1 with ⟨rfl, h⟩,
-      apply nat.pos_of_ne_zero (right_ne_zero_of_mul h) },
-    { intros a ha,
-      rcases mem_divisors.1 ha with ⟨⟨b, rfl⟩, ne0⟩,
-      use (b, a),
-      simp [ne0, mul_comm] } }
+  { rw [← map_div_left_divisors, sum_map, function.embedding.coe_fn_mk] }
 end
 
+@[simp]
+theorem coe_zeta_mul_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
+  (↑ζ * f) x = ∑ i in divisors x, f i :=
+coe_zeta_smul_apply
+
 @[simp]
 theorem coe_mul_zeta_apply [semiring R] {f : arithmetic_function R} {x : ℕ} :
   (f * ζ) x = ∑ i in divisors x, f i :=
 begin
-  apply mul_opposite.op_injective,
-  rw [op_sum],
-  convert @coe_zeta_mul_apply Rᵐᵒᵖ _ { to_fun := mul_opposite.op ∘ f, map_zero' := by simp} x,
-  rw [mul_apply, mul_apply, op_sum],
-  conv_lhs { rw ← map_swap_divisors_antidiagonal, },
-  rw sum_map,
-  apply sum_congr rfl,
-  intros y hy,
-  by_cases h1 : y.fst = 0,
-  { simp [function.comp_apply, h1] },
-  { simp only [h1, mul_one, one_mul, prod.fst_swap, function.embedding.coe_fn_mk, prod.snd_swap,
-      if_false, zeta_apply, zero_hom.coe_mk, nat_coe_apply, cast_one] }
+  rw mul_apply,
+  transitivity ∑ i in divisors_antidiagonal x, f i.1,
+  { refine sum_congr rfl (λ i hi, _),
+    rcases mem_divisors_antidiagonal.1 hi with ⟨rfl, h⟩,
+    rw [nat_coe_apply, zeta_apply_ne (right_ne_zero_of_mul h), cast_one, mul_one] },
+  { rw [← map_div_right_divisors, sum_map, function.embedding.coe_fn_mk] }
 end
 
 theorem zeta_mul_apply {f : arithmetic_function ℕ} {x : ℕ} :
@@ -484,6 +472,18 @@ hf.2 h
 
 end monoid_with_zero
 
+lemma map_prod {ι : Type*} [comm_monoid_with_zero R] (g : ι → ℕ) {f : nat.arithmetic_function R}
+  (hf : f.is_multiplicative) (s : finset ι) (hs : (s : set ι).pairwise (coprime on g)):
+  f (∏ i in s, g i) = ∏ i in s, f (g i) :=
+begin
+  classical,
+  induction s using finset.induction_on with a s has ih hs,
+  { simp [hf] },
+  rw [coe_insert, set.pairwise_insert_of_symmetric (coprime.symmetric.comap g)] at hs,
+  rw [prod_insert has, prod_insert has, hf.map_mul_of_coprime, ih hs.1],
+  exact nat.coprime_prod_right (λ i hi, hs.2 _ hi (hi.ne_of_not_mem has).symm),
+end
+
 lemma nat_cast {f : arithmetic_function ℕ} [semiring R] (h : f.is_multiplicative) :
   is_multiplicative (f : arithmetic_function R) :=
 ⟨by simp [h], λ m n cop, by simp [cop, h]⟩
@@ -565,9 +565,8 @@ end⟩
 /-- For any multiplicative function `f` and any `n > 0`,
 we can evaluate `f n` by evaluating `f` at `p ^ k` over the factorization of `n` -/
 lemma multiplicative_factorization [comm_monoid_with_zero R] (f : arithmetic_function R)
-  (hf : f.is_multiplicative) :
-  ∀ {n : ℕ}, n ≠ 0 → f n = n.factorization.prod (λ p k, f (p ^ k)) :=
-λ n hn, multiplicative_factorization f hf.2 hf.1 hn
+  (hf : f.is_multiplicative) {n : ℕ} (hn : n ≠ 0) : f n = n.factorization.prod (λ p k, f (p ^ k)) :=
+multiplicative_factorization f (λ _ _, hf.2) hf.1 hn
 
 /-- A recapitulation of the definition of multiplicative that is simpler for proofs -/
 lemma iff_ne_zero [monoid_with_zero R] {f : arithmetic_function R} :
@@ -623,16 +622,24 @@ begin
   simp [pow, (ne_of_lt (nat.succ_pos k)).symm],
 end
 
+lemma pow_zero_eq_zeta : pow 0 = ζ := by { ext n, simp }
+
 /-- `σ k n` is the sum of the `k`th powers of the divisors of `n` -/
 def sigma (k : ℕ) : arithmetic_function ℕ :=
 ⟨λ n, ∑ d in divisors n, d ^ k, by simp⟩
 
-localized "notation `σ` := nat.arithmetic_function.sigma" in arithmetic_function
+localized "notation (name := arithmetic_function.sigma)
+  `σ` := nat.arithmetic_function.sigma" in arithmetic_function
 
-@[simp]
 lemma sigma_apply {k n : ℕ} : σ k n = ∑ d in divisors n, d ^ k := rfl
 
-lemma sigma_one_apply {n : ℕ} : σ 1 n = ∑ d in divisors n, d := by simp
+lemma sigma_one_apply (n : ℕ) : σ 1 n = ∑ d in divisors n, d := by simp [sigma_apply]
+
+lemma sigma_zero_apply (n : ℕ) : σ 0 n = (divisors n).card := by simp [sigma_apply]
+
+lemma sigma_zero_apply_prime_pow {p i : ℕ} (hp : p.prime) :
+  σ 0 (p ^ i) = i + 1 :=
+by rw [sigma_zero_apply, divisors_prime_pow hp, card_map, card_range]
 
 lemma zeta_mul_pow_eq_sigma {k : ℕ} : ζ * pow k = σ k :=
 begin
@@ -645,13 +652,20 @@ begin
   simp [hx],
 end
 
-lemma is_multiplicative_zeta : is_multiplicative ζ :=
-⟨by simp, λ m n cop, begin
-  cases m, {simp},
-  cases n, {simp},
-  simp [nat.succ_ne_zero]
+lemma is_multiplicative_one [monoid_with_zero R] : is_multiplicative (1 : arithmetic_function R) :=
+is_multiplicative.iff_ne_zero.2 ⟨by simp,
+begin
+  intros m n hm hn hmn,
+  rcases eq_or_ne m 1 with rfl | hm',
+  { simp },
+  rw [one_apply_ne, one_apply_ne hm', zero_mul],
+  rw [ne.def, mul_eq_one, not_and_distrib],
+  exact or.inl hm'
 end⟩
 
+lemma is_multiplicative_zeta : is_multiplicative ζ :=
+is_multiplicative.iff_ne_zero.2 ⟨by simp, by simp {contextual := tt}⟩
+
 lemma is_multiplicative_id : is_multiplicative arithmetic_function.id :=
 ⟨rfl, λ _ _ _, rfl⟩
 
@@ -669,7 +683,7 @@ lemma is_multiplicative_pow {k : ℕ} : is_multiplicative (pow k) :=
 is_multiplicative_id.ppow
 
 lemma is_multiplicative_sigma {k : ℕ} :
-  is_multiplicative (sigma k) :=
+  is_multiplicative (σ k) :=
 begin
   rw [← zeta_mul_pow_eq_sigma],
   apply ((is_multiplicative_zeta).mul is_multiplicative_pow)
@@ -679,7 +693,8 @@ end
 def card_factors : arithmetic_function ℕ :=
 ⟨λ n, n.factors.length, by simp⟩
 
-localized "notation `Ω` := nat.arithmetic_function.card_factors" in arithmetic_function
+localized "notation (name := card_factors)
+  `Ω` := nat.arithmetic_function.card_factors" in arithmetic_function
 
 lemma card_factors_apply {n : ℕ} :
   Ω n = n.factors.length := rfl
@@ -716,14 +731,23 @@ begin
   simp [h0, card_factors_mul, h],
 end
 
+@[simp] lemma card_factors_apply_prime {p : ℕ} (hp : p.prime) : Ω p = 1 :=
+card_factors_eq_one_iff_prime.2 hp
+
+@[simp] lemma card_factors_apply_prime_pow {p k : ℕ} (hp : p.prime) : Ω (p ^ k) = k :=
+by rw [card_factors_apply, hp.factors_pow, list.length_replicate]
+
 /-- `ω n` is the number of distinct prime factors of `n`. -/
 def card_distinct_factors : arithmetic_function ℕ :=
 ⟨λ n, n.factors.dedup.length, by simp⟩
 
-localized "notation `ω` := nat.arithmetic_function.card_distinct_factors" in arithmetic_function
+localized "notation (name := card_distinct_factors)
+  `ω` := nat.arithmetic_function.card_distinct_factors" in arithmetic_function
 
 lemma card_distinct_factors_zero : ω 0 = 0 := by simp
 
+@[simp] lemma card_distinct_factors_one : ω 1 = 0 := by simp [card_distinct_factors]
+
 lemma card_distinct_factors_apply {n : ℕ} :
   ω n = n.factors.dedup.length := rfl
 
@@ -732,26 +756,35 @@ lemma card_distinct_factors_eq_card_factors_iff_squarefree {n : ℕ} (h0 : n ≠
 begin
   rw [squarefree_iff_nodup_factors h0, card_distinct_factors_apply],
   split; intro h,
-  { rw ← list.eq_of_sublist_of_length_eq n.factors.dedup_sublist h,
+  { rw ←n.factors.dedup_sublist.eq_of_length h,
     apply list.nodup_dedup },
   { rw h.dedup,
     refl }
 end
 
+@[simp] lemma card_distinct_factors_apply_prime_pow {p k : ℕ} (hp : p.prime) (hk : k ≠ 0) :
+  ω (p ^ k) = 1 :=
+by rw [card_distinct_factors_apply, hp.factors_pow, list.replicate_dedup hk, list.length_singleton]
+
+@[simp] lemma card_distinct_factors_apply_prime {p : ℕ} (hp : p.prime) : ω p = 1 :=
+by rw [←pow_one p, card_distinct_factors_apply_prime_pow hp one_ne_zero]
+
 /-- `μ` is the Möbius function. If `n` is squarefree with an even number of distinct prime factors,
   `μ n = 1`. If `n` is squarefree with an odd number of distinct prime factors, `μ n = -1`.
   If `n` is not squarefree, `μ n = 0`. -/
 def moebius : arithmetic_function ℤ :=
 ⟨λ n, if squarefree n then (-1) ^ (card_factors n) else 0, by simp⟩
 
-localized "notation `μ` := nat.arithmetic_function.moebius" in arithmetic_function
+localized "notation (name := moebius)
+  `μ` := nat.arithmetic_function.moebius" in arithmetic_function
 
 @[simp]
-lemma moebius_apply_of_squarefree {n : ℕ} (h : squarefree n): μ n = (-1) ^ (card_factors n) :=
+lemma moebius_apply_of_squarefree {n : ℕ} (h : squarefree n) : μ n = (-1) ^ card_factors n :=
 if_pos h
 
-@[simp]
-lemma moebius_eq_zero_of_not_squarefree {n : ℕ} (h : ¬ squarefree n): μ n = 0 := if_neg h
+@[simp] lemma moebius_eq_zero_of_not_squarefree {n : ℕ} (h : ¬ squarefree n) : μ n = 0 := if_neg h
+
+lemma moebius_apply_one : μ 1 = 1 := by simp
 
 lemma moebius_ne_zero_iff_squarefree {n : ℕ} : μ n ≠ 0 ↔ squarefree n :=
 begin
@@ -770,6 +803,28 @@ begin
   { rcases h with h | h; simp [h] }
 end
 
+lemma moebius_apply_prime {p : ℕ} (hp : p.prime) : μ p = -1 :=
+by rw [moebius_apply_of_squarefree hp.squarefree, card_factors_apply_prime hp, pow_one]
+
+lemma moebius_apply_prime_pow {p k : ℕ} (hp : p.prime) (hk : k ≠ 0) :
+  μ (p ^ k) = if k = 1 then -1 else 0 :=
+begin
+  split_ifs,
+  { rw [h, pow_one, moebius_apply_prime hp] },
+  rw [moebius_eq_zero_of_not_squarefree],
+  rw [squarefree_pow_iff hp.ne_one hk, not_and_distrib],
+  exact or.inr h,
+end
+
+lemma moebius_apply_is_prime_pow_not_prime {n : ℕ} (hn : is_prime_pow n) (hn' : ¬ n.prime) :
+  μ n = 0 :=
+begin
+  obtain ⟨p, k, hp, hk, rfl⟩ := (is_prime_pow_nat_iff _).1 hn,
+  rw [moebius_apply_prime_pow hp hk.ne', if_neg],
+  rintro rfl,
+  exact hn' (by simpa),
+end
+
 lemma is_multiplicative_moebius : is_multiplicative μ :=
 begin
   rw is_multiplicative.iff_ne_zero,
@@ -780,60 +835,35 @@ end
 
 open unique_factorization_monoid
 
-@[simp] lemma coe_moebius_mul_coe_zeta [ring R] : (μ * ζ : arithmetic_function R) = 1 :=
+@[simp] lemma moebius_mul_coe_zeta : (μ * ζ : arithmetic_function ℤ) = 1 :=
 begin
-  ext x,
-  cases x,
-  { simp only [divisors_zero, sum_empty, ne.def, not_false_iff, coe_mul_zeta_apply,
-      zero_ne_one, one_apply_ne] },
-  cases x,
-  { simp only [moebius_apply_of_squarefree, card_factors_one, squarefree_one, divisors_one,
-      int.cast_one, sum_singleton, coe_mul_zeta_apply, one_one, int_coe_apply, pow_zero] },
-  rw [coe_mul_zeta_apply, one_apply_ne (ne_of_gt (succ_lt_succ (nat.succ_pos _)))],
-  simp_rw [int_coe_apply],
-  rw [←int.cast_sum, ← sum_filter_ne_zero],
-  convert int.cast_zero,
-  simp only [moebius_ne_zero_iff_squarefree],
-  suffices :
-    ∑ (y : finset ℕ) in
-      (unique_factorization_monoid.normalized_factors x.succ.succ).to_finset.powerset,
-    ite (squarefree y.val.prod) ((-1:ℤ) ^ Ω y.val.prod) 0 = 0,
-  { have h : ∑ i in _, ite (squarefree i) ((-1:ℤ) ^ Ω i) 0 = _ :=
-      (sum_divisors_filter_squarefree (nat.succ_ne_zero _)),
-    exact (eq.trans (by congr') h).trans this },
-  apply eq.trans (sum_congr rfl _) (sum_powerset_neg_one_pow_card_of_nonempty _),
-  { intros y hy,
-    rw [finset.mem_powerset, ← finset.val_le_iff, multiset.to_finset_val] at hy,
-    have h : unique_factorization_monoid.normalized_factors y.val.prod = y.val,
-    { apply factors_multiset_prod_of_irreducible,
-      intros z hz,
-      apply irreducible_of_normalized_factor _ (multiset.subset_of_le
-        (le_trans hy (multiset.dedup_le _)) hz) },
-    rw [if_pos],
-    { rw [card_factors_apply, ← multiset.coe_card, ← factors_eq, h, finset.card] },
-    rw [unique_factorization_monoid.squarefree_iff_nodup_normalized_factors, h],
-    { apply y.nodup },
-    rw [ne.def, multiset.prod_eq_zero_iff],
-    intro con,
-    rw ← h at con,
-    exact not_irreducible_zero (irreducible_of_normalized_factor 0 con) },
-  { rw finset.nonempty,
-    rcases wf_dvd_monoid.exists_irreducible_factor _ (nat.succ_ne_zero _) with ⟨i, hi⟩,
-    { rcases exists_mem_normalized_factors_of_dvd (nat.succ_ne_zero _) hi.1 hi.2 with ⟨j, hj, hj2⟩,
-      use j,
-      apply multiset.mem_to_finset.2 hj },
-    rw nat.is_unit_iff,
-    norm_num },
+  ext n,
+  refine rec_on_pos_prime_pos_coprime _ _ _ _ n,
+  { intros p n hp hn,
+    rw [coe_mul_zeta_apply, sum_divisors_prime_pow hp, sum_range_succ'],
+    simp_rw [function.embedding.coe_fn_mk, pow_zero, moebius_apply_one,
+      moebius_apply_prime_pow hp (nat.succ_ne_zero _), nat.succ_inj', sum_ite_eq', mem_range,
+      if_pos hn, add_left_neg],
+    rw one_apply_ne,
+    rw [ne.def, pow_eq_one_iff],
+    { exact hp.ne_one },
+    { exact hn.ne' } },
+  { rw [zero_hom.map_zero, zero_hom.map_zero] },
+  { simp },
+  { intros a b ha hb hab ha' hb',
+    rw [is_multiplicative.map_mul_of_coprime _ hab, ha', hb',
+      is_multiplicative.map_mul_of_coprime is_multiplicative_one hab],
+    exact is_multiplicative_moebius.mul is_multiplicative_zeta.nat_cast }
 end
 
-@[simp] lemma coe_zeta_mul_coe_moebius [comm_ring R] : (ζ * μ : arithmetic_function R) = 1 :=
-by rw [mul_comm, coe_moebius_mul_coe_zeta]
+@[simp] lemma coe_zeta_mul_moebius : (ζ * μ : arithmetic_function ℤ) = 1 :=
+by rw [mul_comm, moebius_mul_coe_zeta]
 
-@[simp] lemma moebius_mul_coe_zeta : (μ * ζ : arithmetic_function ℤ) = 1 :=
-by rw [← int_coe_int μ, coe_moebius_mul_coe_zeta]
+@[simp] lemma coe_moebius_mul_coe_zeta [ring R] : (μ * ζ : arithmetic_function R) = 1 :=
+by rw [←coe_coe, ←int_coe_mul, moebius_mul_coe_zeta, int_coe_one]
 
-@[simp] lemma coe_zeta_mul_moebius : (ζ * μ : arithmetic_function ℤ) = 1 :=
-by rw [← int_coe_int μ, coe_zeta_mul_coe_moebius]
+@[simp] lemma coe_zeta_mul_coe_moebius [ring R] : (ζ * μ : arithmetic_function R) = 1 :=
+by rw [←coe_coe, ←int_coe_mul, coe_zeta_mul_moebius, int_coe_one]
 
 section comm_ring
 variable [comm_ring R]
@@ -925,7 +955,7 @@ begin
       prod_congr rfl _],
     intros x hx,
     rw [dif_pos (nat.pos_of_mem_divisors (nat.snd_mem_divisors_of_mem_antidiagonal hx)),
-      units.coe_hom_apply, units.coe_zpow₀, units.coe_mk0] }
+      units.coe_hom_apply, units.coe_zpow, units.coe_mk0] }
 end
 
 end special_functions
diff --git a/src/number_theory/basic.lean b/src/number_theory/basic.lean
index 0accec3918f5b..17b26e3f795c8 100644
--- a/src/number_theory/basic.lean
+++ b/src/number_theory/basic.lean
@@ -10,6 +10,9 @@ import ring_theory.ideal.quotient
 /-!
 # Basic results in number theory
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file should contain basic results in number theory. So far, it only contains the essential
 lemma in the construction of the ring of Witt vectors.
 
diff --git a/src/number_theory/bernoulli.lean b/src/number_theory/bernoulli.lean
index 79ed8ebba04e6..6e204582ab37a 100644
--- a/src/number_theory/bernoulli.lean
+++ b/src/number_theory/bernoulli.lean
@@ -5,13 +5,16 @@ Authors: Johan Commelin, Kevin Buzzard
 -/
 import algebra.big_operators.nat_antidiagonal
 import algebra.geom_sum
-import data.fintype.card
+import data.fintype.big_operators
 import ring_theory.power_series.well_known
 import tactic.field_simp
 
 /-!
 # Bernoulli numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Bernoulli numbers are a sequence of rational numbers that frequently show up in
 number theory.
 
@@ -137,7 +140,7 @@ begin
   rw [bernoulli'_power_series, coeff_mul, mul_comm X, sum_antidiagonal_succ'],
   suffices : ∑ p in antidiagonal n, (bernoulli' p.1 / p.1!) * ((p.2 + 1) * p.2!)⁻¹ = n!⁻¹,
   { simpa [ring_hom.map_sum] using congr_arg (algebra_map ℚ A) this },
-  apply eq_inv_of_mul_left_eq_one,
+  apply eq_inv_of_mul_eq_one_left,
   rw sum_mul,
   convert bernoulli'_spec' n using 1,
   apply sum_congr rfl,
@@ -149,7 +152,7 @@ begin
   field_simp [mul_comm _ (bernoulli' i), mul_assoc, add_choose],
   rw_mod_cast [mul_comm (j + 1), mul_div_assoc, ← mul_assoc],
   rw [cast_mul, cast_mul, mul_div_mul_right, cast_div_char_zero, cast_mul],
-  assumption',
+  assumption, rwa nat.cast_succ,
 end
 
 /-- Odd Bernoulli numbers (greater than 1) are zero. -/
@@ -166,9 +169,9 @@ begin
     { simpa using h 1 } },
   have h : B * (exp ℚ - 1) = X * exp ℚ,
   { simpa [bernoulli'_power_series] using bernoulli'_power_series_mul_exp_sub_one ℚ },
-  rw [sub_mul, h, mul_sub X, sub_right_inj, ← neg_sub, mul_neg, neg_eq_iff_neg_eq],
+  rw [sub_mul, h, mul_sub X, sub_right_inj, ← neg_sub, mul_neg, neg_eq_iff_eq_neg],
   suffices : eval_neg_hom (B * (exp ℚ - 1)) * exp ℚ = eval_neg_hom (X * exp ℚ) * exp ℚ,
-  { simpa [mul_assoc, sub_mul, mul_comm (eval_neg_hom (exp ℚ)), exp_mul_exp_neg_eq_one, eq_comm] },
+  { simpa [mul_assoc, sub_mul, mul_comm (eval_neg_hom (exp ℚ)), exp_mul_exp_neg_eq_one] },
   congr',
 end
 
@@ -250,11 +253,11 @@ begin
   rw [←map_zero (algebra_map ℚ A), ←zero_div (n.succ! : ℚ), ←hite2, ← bernoulli_spec', sum_div],
   refine congr_arg (algebra_map ℚ A) (sum_congr rfl $ λ x h, eq_div_of_mul_eq (hfact n.succ) _),
   rw mem_antidiagonal at h,
-  have hj : (x.2.succ : ℚ) ≠ 0 := by exact_mod_cast succ_ne_zero _,
-  field_simp [← h, mul_ne_zero hj (hfact x.2), hfact x.1, mul_comm _ (bernoulli x.1), mul_assoc],
-  rw_mod_cast [mul_comm (x.2 + 1), mul_div_assoc, ← mul_assoc],
-  rw [cast_mul, cast_mul, mul_div_mul_right _ _ hj, add_choose, cast_div_char_zero],
-  apply factorial_mul_factorial_dvd_factorial_add,
+  have hj : (x.2 + 1 : ℚ) ≠ 0 := by exact_mod_cast succ_ne_zero _,
+  field_simp [← h, mul_ne_zero hj (hfact x.2), hfact x.1, mul_comm _ (bernoulli x.1), mul_assoc,
+    add_choose, cast_div_char_zero (factorial_mul_factorial_dvd_factorial_add _ _),
+    nat.factorial_ne_zero, hj],
+  cc,
 end
 
 section faulhaber
@@ -284,7 +287,7 @@ begin
     rw [choose_eq_factorial_div_factorial h.le, eq_comm, div_eq_iff (hne q.succ), succ_eq_add_one,
         mul_assoc _ _ ↑q.succ!, mul_comm _ ↑q.succ!, ← mul_assoc, div_mul_eq_mul_div,
         mul_comm (↑n ^ (q - m + 1)), ← mul_assoc _ _ (↑n ^ (q - m + 1)), ← one_div, mul_one_div,
-        div_div_eq_div_mul, tsub_add_eq_add_tsub (le_of_lt_succ h), cast_div, cast_mul],
+        div_div, tsub_add_eq_add_tsub (le_of_lt_succ h), cast_div, cast_mul],
     { ring },
     { exact factorial_mul_factorial_dvd_factorial h.le },
     { simp [hne] } },
@@ -307,7 +310,7 @@ begin
     { have h_const : C ℚ (constant_coeff ℚ (exp ℚ ^ n)) = 1 := by simp,
       rw [← h_const, sub_const_eq_X_mul_shift] },
     -- key step: a chain of equalities of power series
-    rw [← mul_right_inj' hexp, mul_comm, ← exp_pow_sum, ← geom_sum_def, geom_sum_mul, h_r,
+    rw [← mul_right_inj' hexp, mul_comm, ← exp_pow_sum, geom_sum_mul, h_r,
         ← bernoulli_power_series_mul_exp_sub_one, bernoulli_power_series, mul_right_comm],
     simp [h_cauchy, mul_comm] },
   -- massage `hps` into our goal
@@ -323,6 +326,7 @@ theorem sum_Ico_pow (n p : ℕ) :
   ∑ k in Ico 1 (n + 1), (k : ℚ) ^ p =
     ∑ i in range (p + 1), bernoulli' i * (p + 1).choose i * n ^ (p + 1 - i) / (p + 1) :=
 begin
+  rw ← nat.cast_succ,
   -- dispose of the trivial case
   cases p, { simp },
   let f := λ i, bernoulli i * p.succ.succ.choose i * n ^ (p.succ.succ - i) / p.succ.succ,
@@ -351,7 +355,8 @@ begin
   ... = ∑ i in range p, f i.succ.succ + (f 1 + n ^ p.succ) + f 0 : by ring
   ... = ∑ i in range p, f i.succ.succ + 1 / 2 * n ^ p.succ + f 0 : by rw h2
         -- convert from `bernoulli` to `bernoulli'`
-  ... = ∑ i in range p, f' i.succ.succ + f' 1 + f' 0 : by { simp only [f, f'], simpa [h1] }
+  ... = ∑ i in range p, f' i.succ.succ + f' 1 + f' 0 :
+        by { simp only [f, f'], simpa [h1, λ i, show i + 2 = i + 1 + 1, from rfl] }
         -- rejoin the first two terms of the sum
   ... = ∑ i in range p.succ.succ, f' i : by simp_rw [sum_range_succ'],
 end
diff --git a/src/number_theory/bernoulli_polynomials.lean b/src/number_theory/bernoulli_polynomials.lean
index 87118d073ee3a..82df7a3f2e5bd 100644
--- a/src/number_theory/bernoulli_polynomials.lean
+++ b/src/number_theory/bernoulli_polynomials.lean
@@ -1,24 +1,28 @@
 /-
 Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Ashvni Narayanan
+Authors: Ashvni Narayanan, David Loeffler
 -/
 import data.polynomial.algebra_map
+import data.polynomial.derivative
 import data.nat.choose.cast
 import number_theory.bernoulli
 
 /-!
 # Bernoulli polynomials
 
-The Bernoulli polynomials (defined here : https://en.wikipedia.org/wiki/Bernoulli_polynomials)
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The [Bernoulli polynomials](https://en.wikipedia.org/wiki/Bernoulli_polynomials)
 are an important tool obtained from Bernoulli numbers.
 
 ## Mathematical overview
 
 The $n$-th Bernoulli polynomial is defined as
-$$ B_n(X) = ∑_{k = 0}^n {n \choose k} (-1)^k * B_k * X^{n - k} $$
+$$ B_n(X) = ∑_{k = 0}^n {n \choose k} (-1)^k  B_k  X^{n - k} $$
 where $B_k$ is the $k$-th Bernoulli number. The Bernoulli polynomials are generating functions,
-$$ t * e^{tX} / (e^t - 1) = ∑_{n = 0}^{\infty} B_n(X) * \frac{t^n}{n!} $$
+$$ \frac{t  e^{tX} }{ e^t - 1} = ∑_{n = 0}^{\infty} B_n(X)  \frac{t^n}{n!} $$
 
 ## Implementation detail
 
@@ -27,13 +31,13 @@ Bernoulli polynomials are defined using `bernoulli`, the Bernoulli numbers.
 ## Main theorems
 
 - `sum_bernoulli`: The sum of the $k^\mathrm{th}$ Bernoulli polynomial with binomial
-  coefficients up to n is `(n + 1) * X^n`.
-- `bernoulli_generating_function`: The Bernoulli polynomials act as generating functions
+  coefficients up to `n` is `(n + 1) * X^n`.
+- `polynomial.bernoulli_generating_function`: The Bernoulli polynomials act as generating functions
   for the exponential.
 
 ## TODO
 
-- `bernoulli_eval_one_neg` : $$ B_n(1 - x) = (-1)^n*B_n(x) $$
+- `bernoulli_eval_one_neg` : $$ B_n(1 - x) = (-1)^n B_n(x) $$
 
 -/
 
@@ -69,7 +73,7 @@ by simp [bernoulli]
 
 @[simp] lemma bernoulli_eval_zero (n : ℕ) : (bernoulli n).eval 0 = _root_.bernoulli n :=
 begin
- rw [bernoulli, polynomial.eval_finset_sum, sum_range_succ],
+ rw [bernoulli, eval_finset_sum, sum_range_succ],
   have : ∑ (x : ℕ) in range n, _root_.bernoulli x * (n.choose x) * 0 ^ (n - x) = 0,
   { apply sum_eq_zero (λ x hx, _),
     have h : 0 < n - x := tsub_pos_of_lt (mem_range.1 hx),
@@ -79,10 +83,9 @@ end
 
 @[simp] lemma bernoulli_eval_one (n : ℕ) : (bernoulli n).eval 1 = _root_.bernoulli' n :=
 begin
-  simp only [bernoulli, polynomial.eval_finset_sum],
+  simp only [bernoulli, eval_finset_sum],
   simp only [←succ_eq_add_one, sum_range_succ, mul_one, cast_one, choose_self,
-    (_root_.bernoulli _).mul_comm, sum_bernoulli, one_pow, mul_one, polynomial.eval_C,
-    polynomial.eval_monomial],
+    (_root_.bernoulli _).mul_comm, sum_bernoulli, one_pow, mul_one, eval_C, eval_monomial],
   by_cases h : n = 1,
   { norm_num [h], },
   { simp [h],
@@ -91,22 +94,43 @@ end
 
 end examples
 
+lemma derivative_bernoulli_add_one (k : ℕ) :
+  (bernoulli (k + 1)).derivative = (k + 1) * bernoulli k :=
+begin
+  simp_rw [bernoulli, derivative_sum, derivative_monomial, nat.sub_sub, nat.add_sub_add_right],
+  -- LHS sum has an extra term, but the coefficient is zero:
+  rw [range_add_one, sum_insert not_mem_range_self, tsub_self, cast_zero, mul_zero, map_zero,
+    zero_add, mul_sum],
+  -- the rest of the sum is termwise equal:
+  refine sum_congr (by refl) (λ m hm, _),
+  conv_rhs { rw [←nat.cast_one, ←nat.cast_add, ←C_eq_nat_cast, C_mul_monomial, mul_comm], },
+  rw [mul_assoc, mul_assoc, ←nat.cast_mul, ←nat.cast_mul],
+  congr' 3,
+  rw [(choose_mul_succ_eq k m).symm, mul_comm],
+end
+
+lemma derivative_bernoulli (k : ℕ) : (bernoulli k).derivative = k * bernoulli (k - 1) :=
+begin
+  cases k,
+  { rw [nat.cast_zero, zero_mul, bernoulli_zero, derivative_one], },
+  { exact_mod_cast derivative_bernoulli_add_one k, }
+end
+
 @[simp] theorem sum_bernoulli (n : ℕ) :
-  ∑ k in range (n + 1), ((n + 1).choose k : ℚ) • bernoulli k =
-    polynomial.monomial n (n + 1 : ℚ) :=
+  ∑ k in range (n + 1), ((n + 1).choose k : ℚ) • bernoulli k = monomial n (n + 1 : ℚ) :=
 begin
  simp_rw [bernoulli_def, finset.smul_sum, finset.range_eq_Ico, ←finset.sum_Ico_Ico_comm,
     finset.sum_Ico_eq_sum_range],
-  simp only [cast_succ, add_tsub_cancel_left, tsub_zero, zero_add, linear_map.map_add],
-  simp_rw [polynomial.smul_monomial, mul_comm (_root_.bernoulli _) _, smul_eq_mul, ←mul_assoc],
+  simp only [add_tsub_cancel_left, tsub_zero, zero_add, linear_map.map_add],
+  simp_rw [smul_monomial, mul_comm (_root_.bernoulli _) _, smul_eq_mul, ←mul_assoc],
   conv_lhs { apply_congr, skip, conv
     { apply_congr, skip,
       rw [← nat.cast_mul, choose_mul ((le_tsub_iff_left $ mem_range_le H).1
         $ mem_range_le H_1) (le.intro rfl), nat.cast_mul, add_comm x x_1, add_tsub_cancel_right,
-        mul_assoc, mul_comm, ←smul_eq_mul, ←polynomial.smul_monomial] },
+        mul_assoc, mul_comm, ←smul_eq_mul, ←smul_monomial] },
     rw [←sum_smul], },
   rw [sum_range_succ_comm],
-  simp only [add_right_eq_self, cast_succ, mul_one, cast_one, cast_add, add_tsub_cancel_left,
+  simp only [add_right_eq_self, mul_one, cast_one, cast_add, add_tsub_cancel_left,
     choose_succ_self_right, one_smul, _root_.bernoulli_zero, sum_singleton, zero_add,
     linear_map.map_add, range_one],
   apply sum_eq_zero (λ x hx, _),
@@ -122,13 +146,60 @@ begin
   rw [g, zero_smul],
 end
 
+/-- Another version of `polynomial.sum_bernoulli`. -/
+lemma bernoulli_eq_sub_sum (n : ℕ) : (n.succ : ℚ) • bernoulli n = monomial n (n.succ : ℚ) -
+  ∑ k in finset.range n, ((n + 1).choose k : ℚ) • bernoulli k :=
+by rw [nat.cast_succ, ← sum_bernoulli n, sum_range_succ, add_sub_cancel',
+  choose_succ_self_right, nat.cast_succ]
+
+/-- Another version of `bernoulli.sum_range_pow`. -/
+lemma sum_range_pow_eq_bernoulli_sub (n p : ℕ) :
+  (p + 1 : ℚ) * ∑ k in range n, (k : ℚ) ^ p = (bernoulli p.succ).eval n -
+  (_root_.bernoulli p.succ) :=
+begin
+  rw [sum_range_pow, bernoulli_def, eval_finset_sum, ←sum_div, mul_div_cancel' _ _],
+  { simp_rw [eval_monomial],
+    symmetry,
+    rw [←sum_flip _, sum_range_succ],
+    simp only [tsub_self, tsub_zero, choose_zero_right, cast_one, mul_one, pow_zero,
+      add_tsub_cancel_right],
+    apply sum_congr rfl (λ x hx, _),
+    apply congr_arg2 _ (congr_arg2 _ _ _) rfl,
+    { rw nat.sub_sub_self (mem_range_le hx), },
+    { rw ←choose_symm (mem_range_le hx), }, },
+  { norm_cast, apply succ_ne_zero _, },
+end
+
+/-- Rearrangement of `polynomial.sum_range_pow_eq_bernoulli_sub`. -/
+lemma bernoulli_succ_eval (n p : ℕ) : (bernoulli p.succ).eval n =
+  _root_.bernoulli (p.succ) + (p + 1 : ℚ) * ∑ k in range n, (k : ℚ) ^ p :=
+by { apply eq_add_of_sub_eq', rw sum_range_pow_eq_bernoulli_sub, }
+
+lemma bernoulli_eval_one_add (n : ℕ) (x : ℚ) :
+  (bernoulli n).eval (1 + x) = (bernoulli n).eval x + n * x^(n - 1) :=
+begin
+  apply nat.strong_induction_on n (λ d hd, _),
+  have nz : ((d.succ : ℕ): ℚ) ≠ 0,
+  { norm_cast, exact d.succ_ne_zero, },
+  apply (mul_right_inj' nz).1,
+  rw [← smul_eq_mul, ←eval_smul, bernoulli_eq_sub_sum, mul_add, ←smul_eq_mul,
+    ←eval_smul, bernoulli_eq_sub_sum, eval_sub, eval_finset_sum],
+  conv_lhs { congr, skip, apply_congr, skip, rw [eval_smul, hd x_1 (mem_range.1 H)], },
+  rw [eval_sub, eval_finset_sum],
+  simp_rw [eval_smul, smul_add],
+  rw [sum_add_distrib, sub_add, sub_eq_sub_iff_sub_eq_sub, _root_.add_sub_sub_cancel],
+  conv_rhs { congr, skip, congr, rw [succ_eq_add_one, ←choose_succ_self_right d], },
+  rw [nat.cast_succ, ← smul_eq_mul, ←sum_range_succ _ d, eval_monomial_one_add_sub],
+  simp_rw [smul_eq_mul],
+end
+
 open power_series
 variables {A : Type*} [comm_ring A] [algebra ℚ A]
 
 -- TODO: define exponential generating functions, and use them here
 -- This name should probably be updated afterwards
 
-/-- The theorem that `∑ Bₙ(t)X^n/n!)(e^X-1)=Xe^{tX}`  -/
+/-- The theorem that $(e^X - 1) * ∑ Bₙ(t)* X^n/n! = Xe^{tX}$ -/
 theorem bernoulli_generating_function (t : A) :
   mk (λ n, aeval t ((1 / n! : ℚ) • bernoulli n)) * (exp A - 1) =
     power_series.X * rescale t (exp A) :=
@@ -145,18 +216,14 @@ begin
   simp only [ring_hom.map_sub, tsub_self, constant_coeff_one, constant_coeff_exp,
     coeff_zero_eq_constant_coeff, mul_zero, sub_self, add_zero],
   -- Let's multiply both sides by (n+1)! (OK because it's a unit)
-  set u : units ℚ := ⟨(n+1)!, (n+1)!⁻¹,
-    mul_inv_cancel (by exact_mod_cast factorial_ne_zero (n+1)),
-      inv_mul_cancel (by exact_mod_cast factorial_ne_zero (n+1))⟩ with hu,
-  rw ←units.mul_right_inj (units.map (algebra_map ℚ A).to_monoid_hom u),
-  -- now tidy up unit mess and generally do trivial rearrangements
-  -- to make RHS (n+1)*t^n
-  rw [units.coe_map, mul_left_comm, ring_hom.to_monoid_hom_eq_coe,
-      ring_hom.coe_monoid_hom, ←ring_hom.map_mul, hu, units.coe_mk],
+  have hnp1 : is_unit ((n+1)! : ℚ) := is_unit.mk0 _ (by exact_mod_cast factorial_ne_zero (n+1)),
+  rw ←(hnp1.map (algebra_map ℚ A)).mul_right_inj,
+  -- do trivial rearrangements to make RHS (n+1)*t^n
+  rw [mul_left_comm, ←ring_hom.map_mul],
   change _ = t^n * algebra_map ℚ A (((n+1)*n! : ℕ)*(1/n!)),
   rw [cast_mul, mul_assoc, mul_one_div_cancel
     (show (n! : ℚ) ≠ 0, from cast_ne_zero.2 (factorial_ne_zero n)), mul_one, mul_comm (t^n),
-    ← polynomial.aeval_monomial, cast_add, cast_one],
+    ← aeval_monomial, cast_add, cast_one],
   -- But this is the RHS of `sum_bernoulli_poly`
   rw [← sum_bernoulli, finset.mul_sum, alg_hom.map_sum],
   -- and now we have to prove a sum is a sum, but all the terms are equal.
@@ -167,12 +234,13 @@ begin
   -- deal with coefficients of e^X-1
   simp only [nat.cast_choose ℚ (mem_range_le hi), coeff_mk,
     if_neg (mem_range_sub_ne_zero hi), one_div, alg_hom.map_smul, power_series.coeff_one,
-    units.coe_mk, coeff_exp, sub_zero, linear_map.map_sub, algebra.smul_mul_assoc, algebra.smul_def,
-    mul_right_comm _ ((aeval t) _), ←mul_assoc, ← ring_hom.map_mul, succ_eq_add_one],
+    coeff_exp, sub_zero, linear_map.map_sub, algebra.smul_mul_assoc, algebra.smul_def,
+    mul_right_comm _ ((aeval t) _), ←mul_assoc, ← ring_hom.map_mul, succ_eq_add_one,
+    ← polynomial.C_eq_algebra_map, polynomial.aeval_mul, polynomial.aeval_C],
   -- finally cancel the Bernoulli polynomial and the algebra_map
   congr',
   apply congr_arg,
-  rw [mul_assoc, div_eq_mul_inv, ← mul_inv₀],
+  rw [mul_assoc, div_eq_mul_inv, ← mul_inv],
 end
 
 end polynomial
diff --git a/src/number_theory/bertrand.lean b/src/number_theory/bertrand.lean
new file mode 100644
index 0000000000000..73927a0e9b79c
--- /dev/null
+++ b/src/number_theory/bertrand.lean
@@ -0,0 +1,239 @@
+/-
+Copyright (c) 2020 Patrick Stevens. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Stevens, Bolton Bailey
+-/
+import data.nat.choose.factorization
+import data.nat.prime_norm_num
+import number_theory.primorial
+import analysis.convex.specific_functions.basic
+import analysis.convex.specific_functions.deriv
+
+/-!
+# Bertrand's Postulate
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains a proof of Bertrand's postulate: That between any positive number and its
+double there is a prime.
+
+The proof follows the outline of the Erdős proof presented in "Proofs from THE BOOK": One considers
+the prime factorization of `(2 * n).choose n`, and splits the constituent primes up into various
+groups, then upper bounds the contribution of each group. This upper bounds the central binomial
+coefficient, and if the postulate does not hold, this upper bound conflicts with a simple lower
+bound for large enough `n`. This proves the result holds for large enough `n`, and for smaller `n`
+an explicit list of primes is provided which covers the remaining cases.
+
+As in the [Metamath implementation](carneiro2015arithmetic), we rely on some optimizations from
+[Shigenori Tochiori](tochiori_bertrand). In particular we use the cleaner bound on the central
+binomial coefficient given in `nat.four_pow_lt_mul_central_binom`.
+
+## References
+
+* [M. Aigner and G. M. Ziegler _Proofs from THE BOOK_][aigner1999proofs]
+* [S. Tochiori, _Considering the Proof of “There is a Prime between n and 2n”_][tochiori_bertrand]
+* [M. Carneiro, _Arithmetic in Metamath, Case Study: Bertrand's Postulate_][carneiro2015arithmetic]
+
+## Tags
+
+Bertrand, prime, binomial coefficients
+-/
+
+open_locale big_operators
+
+section real
+
+open real
+
+namespace bertrand
+
+/--
+A reified version of the `bertrand.main_inequality` below.
+This is not best possible: it actually holds for 464 ≤ x.
+-/
+lemma real_main_inequality {x : ℝ} (n_large : (512 : ℝ) ≤ x) :
+  x * (2 * x) ^ (sqrt (2 * x)) * 4 ^ (2 * x / 3) ≤ 4 ^ x :=
+begin
+  let f : ℝ → ℝ := λ x, log x + sqrt (2 * x) * log (2 * x) - log 4 / 3 * x,
+  have hf' : ∀ x, 0 < x → 0 < x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3) :=
+  λ x h, div_pos (mul_pos h (rpow_pos_of_pos (mul_pos two_pos h) _)) (rpow_pos_of_pos four_pos _),
+  have hf : ∀ x, 0 < x → f x = log (x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3)),
+  { intros x h5,
+    have h6 := mul_pos (zero_lt_two' ℝ) h5,
+    have h7 := rpow_pos_of_pos h6 (sqrt (2 * x)),
+    rw [log_div (mul_pos h5 h7).ne' (rpow_pos_of_pos four_pos _).ne', log_mul h5.ne' h7.ne',
+      log_rpow h6, log_rpow zero_lt_four, ← mul_div_right_comm, ← mul_div, mul_comm x] },
+  have h5 : 0 < x := lt_of_lt_of_le (by norm_num1) n_large,
+  rw [← div_le_one (rpow_pos_of_pos four_pos x), ← div_div_eq_mul_div, ← rpow_sub four_pos,
+      ← mul_div 2 x, mul_div_left_comm, ← mul_one_sub, (by norm_num1 : (1 : ℝ) - 2 / 3 = 1 / 3),
+      mul_one_div, ← log_nonpos_iff (hf' x h5), ← hf x h5],
+  have h : concave_on ℝ (set.Ioi 0.5) f,
+  { refine ((strict_concave_on_log_Ioi.concave_on.subset (set.Ioi_subset_Ioi _)
+      (convex_Ioi 0.5)).add ((strict_concave_on_sqrt_mul_log_Ioi.concave_on.comp_linear_map
+      ((2 : ℝ) • linear_map.id)).subset
+      (λ a ha, lt_of_eq_of_lt _ ((mul_lt_mul_left two_pos).mpr ha)) (convex_Ioi 0.5))).sub
+      ((convex_on_id (convex_Ioi (0.5 : ℝ))).smul (div_nonneg (log_nonneg _) _)); norm_num1 },
+  suffices : ∃ x1 x2, 0.5 < x1 ∧ x1 < x2 ∧ x2 ≤ x ∧ 0 ≤ f x1 ∧ f x2 ≤ 0,
+  { obtain ⟨x1, x2, h1, h2, h0, h3, h4⟩ := this,
+    exact (h.right_le_of_le_left'' h1 ((h1.trans h2).trans_le h0) h2 h0 (h4.trans h3)).trans h4 },
+  refine ⟨18, 512, by norm_num1, by norm_num1, le_trans (by norm_num1) n_large, _, _⟩,
+  { have : sqrt (2 * 18) = 6 :=
+    (sqrt_eq_iff_mul_self_eq_of_pos (by norm_num1)).mpr (by norm_num1),
+    rw [hf, log_nonneg_iff (hf' 18 _), this]; norm_num1 },
+  { have : sqrt (2 * 512) = 32,
+    { exact (sqrt_eq_iff_mul_self_eq_of_pos (by norm_num1)).mpr (by norm_num1) },
+    rw [hf, log_nonpos_iff (hf' _ _), this, div_le_one (rpow_pos_of_pos four_pos _),
+      ← rpow_le_rpow_iff _ (rpow_pos_of_pos four_pos _).le three_pos, ← rpow_mul]; norm_num1 },
+end
+
+end bertrand
+
+end real
+
+section nat
+
+open nat
+
+/--
+The inequality which contradicts Bertrand's postulate, for large enough `n`.
+-/
+lemma bertrand_main_inequality {n : ℕ} (n_large : 512 ≤ n) :
+  n * (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) ≤ 4 ^ n :=
+begin
+  rw ← @cast_le ℝ,
+  simp only [cast_bit0, cast_add, cast_one, cast_mul, cast_pow, ← real.rpow_nat_cast],
+  have n_pos : 0 < n := (dec_trivial : 0 < 512).trans_le n_large,
+  have n2_pos : 1 ≤ 2 * n := mul_pos dec_trivial n_pos,
+  refine trans (mul_le_mul _ _ _ _) (bertrand.real_main_inequality (by exact_mod_cast n_large)),
+  { refine mul_le_mul_of_nonneg_left _ (nat.cast_nonneg _),
+    refine real.rpow_le_rpow_of_exponent_le (by exact_mod_cast n2_pos) _,
+    exact_mod_cast real.nat_sqrt_le_real_sqrt },
+  { exact real.rpow_le_rpow_of_exponent_le (by norm_num1) (cast_div_le.trans (by norm_cast)) },
+  { exact real.rpow_nonneg_of_nonneg (by norm_num1) _ },
+  { refine mul_nonneg (nat.cast_nonneg _) _,
+    exact real.rpow_nonneg_of_nonneg (mul_nonneg zero_le_two (nat.cast_nonneg _)) _, },
+end
+
+/--
+A lemma that tells us that, in the case where Bertrand's postulate does not hold, the prime
+factorization of the central binomial coefficent only has factors at most `2 * n / 3 + 1`.
+-/
+lemma central_binom_factorization_small (n : ℕ) (n_large : 2 < n)
+  (no_prime: ¬∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n) :
+  central_binom n = ∏ p in finset.range (2 * n / 3 + 1), p ^ ((central_binom n).factorization p) :=
+begin
+  refine (eq.trans _ n.prod_pow_factorization_central_binom).symm,
+  apply finset.prod_subset,
+  { exact finset.range_subset.2 (add_le_add_right (nat.div_le_self _ _) _) },
+  intros x hx h2x,
+  rw [finset.mem_range, lt_succ_iff] at hx h2x,
+  rw [not_le, div_lt_iff_lt_mul' three_pos, mul_comm x] at h2x,
+  replace no_prime := not_exists.mp no_prime x,
+  rw [←and_assoc, not_and', not_and_distrib, not_lt] at no_prime,
+  cases no_prime hx with h h,
+  { rw [factorization_eq_zero_of_non_prime n.central_binom h, pow_zero] },
+  { rw [factorization_central_binom_of_two_mul_self_lt_three_mul n_large h h2x, pow_zero] },
+end
+
+/--
+An upper bound on the central binomial coefficient used in the proof of Bertrand's postulate.
+The bound splits the prime factors of `central_binom n` into those
+1. At most `sqrt (2 * n)`, which contribute at most `2 * n` for each such prime.
+2. Between `sqrt (2 * n)` and `2 * n / 3`, which contribute at most `4^(2 * n / 3)` in total.
+3. Between `2 * n / 3` and `n`, which do not exist.
+4. Between `n` and `2 * n`, which would not exist in the case where Bertrand's postulate is false.
+5. Above `2 * n`, which do not exist.
+-/
+lemma central_binom_le_of_no_bertrand_prime (n : ℕ) (n_big : 2 < n)
+  (no_prime : ¬∃ (p : ℕ), nat.prime p ∧ n < p ∧ p ≤ 2 * n) :
+  central_binom n ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
+begin
+  have n_pos : 0 < n := (nat.zero_le _).trans_lt n_big,
+  have n2_pos : 1 ≤ 2 * n := mul_pos (zero_lt_two' ℕ) n_pos,
+  let S := (finset.range (2 * n / 3 + 1)).filter nat.prime,
+  let f := λ x, x ^ n.central_binom.factorization x,
+  have : ∏ (x : ℕ) in S, f x = ∏ (x : ℕ) in finset.range (2 * n / 3 + 1), f x,
+  { refine finset.prod_filter_of_ne (λ p hp h, _),
+    contrapose! h, dsimp only [f],
+    rw [factorization_eq_zero_of_non_prime n.central_binom h, pow_zero] },
+  rw [central_binom_factorization_small n n_big no_prime, ← this,
+    ← finset.prod_filter_mul_prod_filter_not S (≤ sqrt (2 * n))],
+  apply mul_le_mul',
+  { refine (finset.prod_le_prod' (λ p hp, (_ : f p ≤ 2 * n))).trans _,
+    { exact pow_factorization_choose_le (mul_pos two_pos n_pos) },
+    have : (finset.Icc 1 (sqrt (2 * n))).card = sqrt (2 * n),
+    { rw [card_Icc, nat.add_sub_cancel] },
+    rw finset.prod_const,
+    refine pow_le_pow n2_pos ((finset.card_le_of_subset (λ x hx, _)).trans this.le),
+    obtain ⟨h1, h2⟩ := finset.mem_filter.1 hx,
+    exact finset.mem_Icc.mpr ⟨(finset.mem_filter.1 h1).2.one_lt.le, h2⟩ },
+  { refine le_trans _ (primorial_le_4_pow (2 * n / 3)),
+    refine (finset.prod_le_prod' (λ p hp, (_ : f p ≤ p))).trans _,
+    { obtain ⟨h1, h2⟩ := finset.mem_filter.1 hp,
+      refine (pow_le_pow (finset.mem_filter.1 h1).2.one_lt.le _).trans (pow_one p).le,
+      exact nat.factorization_choose_le_one (sqrt_lt'.mp $ not_le.1 h2) },
+    refine finset.prod_le_prod_of_subset_of_one_le' (finset.filter_subset _ _) _,
+    exact λ p hp _, (finset.mem_filter.1 hp).2.one_lt.le }
+end
+
+namespace nat
+
+/--
+Proves that Bertrand's postulate holds for all sufficiently large `n`.
+-/
+lemma exists_prime_lt_and_le_two_mul_eventually (n : ℕ) (n_big : 512 ≤ n) :
+  ∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n :=
+begin
+  -- Assume there is no prime in the range.
+  by_contradiction no_prime,
+  -- Then we have the above sub-exponential bound on the size of this central binomial coefficient.
+  -- We now couple this bound with an exponential lower bound on the central binomial coefficient,
+  -- yielding an inequality which we have seen is false for large enough n.
+  have H1 : n * (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) ≤ 4 ^ n := bertrand_main_inequality n_big,
+  have H2 : 4 ^ n < n * n.central_binom :=
+    nat.four_pow_lt_mul_central_binom n (le_trans (by norm_num1) n_big),
+  have H3 : n.central_binom ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
+    central_binom_le_of_no_bertrand_prime n (lt_of_lt_of_le (by norm_num1) n_big) no_prime,
+  rw mul_assoc at H1, exact not_le.2 H2 ((mul_le_mul_left' H3 n).trans H1),
+end
+
+/--
+Proves that Bertrand's postulate holds over all positive naturals less than n by identifying a
+descending list of primes, each no more than twice the next, such that the list contains a witness
+for each number ≤ n.
+-/
+lemma exists_prime_lt_and_le_two_mul_succ {n} (q)
+  {p : ℕ} (prime_p : nat.prime p) (covering : p ≤ 2 * q)
+  (H : n < q → ∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n)
+  (hn : n < p) : ∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n :=
+begin
+  by_cases p ≤ 2 * n, { exact ⟨p, prime_p, hn, h⟩ },
+  exact H (lt_of_mul_lt_mul_left' (lt_of_lt_of_le (not_le.1 h) covering))
+end
+
+/--
+**Bertrand's Postulate**: For any positive natural number, there is a prime which is greater than
+it, but no more than twice as large.
+-/
+theorem exists_prime_lt_and_le_two_mul (n : ℕ) (hn0 : n ≠ 0) :
+  ∃ p, nat.prime p ∧ n < p ∧ p ≤ 2 * n :=
+begin
+  -- Split into cases whether `n` is large or small
+  cases lt_or_le 511 n,
+  -- If `n` is large, apply the lemma derived from the inequalities on the central binomial
+  -- coefficient.
+  { exact exists_prime_lt_and_le_two_mul_eventually n h, },
+  replace h : n < 521 := h.trans_lt (by norm_num1),
+  revert h,
+  -- For small `n`, supply a list of primes to cover the initial cases.
+  ([317, 163, 83, 43, 23, 13, 7, 5, 3, 2].mmap' $ λ n,
+    `[refine exists_prime_lt_and_le_two_mul_succ %%(reflect n) (by norm_num1) (by norm_num1) _]),
+  exact λ h2, ⟨2, prime_two, h2, nat.mul_le_mul_left 2 (nat.pos_of_ne_zero hn0)⟩,
+end
+
+alias nat.exists_prime_lt_and_le_two_mul ← bertrand
+
+end nat
+
+end nat
diff --git a/src/number_theory/class_number/admissible_abs.lean b/src/number_theory/class_number/admissible_abs.lean
index 32ba0d18c63d5..b93949539f369 100644
--- a/src/number_theory/class_number/admissible_abs.lean
+++ b/src/number_theory/class_number/admissible_abs.lean
@@ -8,6 +8,9 @@ import number_theory.class_number.admissible_absolute_value
 
 /-!
 # Admissible absolute value on the integers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines an admissible absolute value `absolute_value.abs_is_admissible`
 which we use to show the class number of the ring of integers of a number field
 is finite.
@@ -38,12 +41,12 @@ begin
   refine ⟨λ i, ⟨nat_abs (floor ((A i % b : ℤ) / (abs b • ε) : ℝ)), _⟩, _⟩,
   { rw [← coe_nat_lt, nat_abs_of_nonneg (hfloor i), floor_lt],
     apply lt_of_lt_of_le _ (nat.le_ceil _),
-    rw [algebra.smul_def, ring_hom.eq_int_cast, ← div_div_eq_div_mul, div_lt_div_right hε,
+    rw [algebra.smul_def, eq_int_cast, ← div_div, div_lt_div_right hε,
         div_lt_iff hb', one_mul, cast_lt],
     exact int.mod_lt _ hb },
   intros i₀ i₁ hi,
   have hi : (⌊↑(A i₀ % b) / abs b • ε⌋.nat_abs : ℤ) = ⌊↑(A i₁ % b) / abs b • ε⌋.nat_abs :=
-    congr_arg (coe : ℕ → ℤ) (subtype.mk_eq_mk.mp hi),
+    congr_arg (coe : ℕ → ℤ) (fin.mk_eq_mk.mp hi),
   rw [nat_abs_of_nonneg (hfloor i₀), nat_abs_of_nonneg (hfloor i₁)] at hi,
   have hi := abs_sub_lt_one_of_floor_eq_floor hi,
   rw [abs_sub_comm, ← sub_div, abs_div, abs_of_nonneg hbε.le, div_lt_iff hbε, one_mul] at hi,
diff --git a/src/number_theory/class_number/admissible_absolute_value.lean b/src/number_theory/class_number/admissible_absolute_value.lean
index 9ba9b4345a66b..745d6a7b62df4 100644
--- a/src/number_theory/class_number/admissible_absolute_value.lean
+++ b/src/number_theory/class_number/admissible_absolute_value.lean
@@ -3,13 +3,15 @@ Copyright (c) 2021 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
-import data.fin.tuple
 import data.real.basic
 import combinatorics.pigeonhole
 import algebra.order.euclidean_absolute_value
 
 /-!
 # Admissible absolute values
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file defines a structure `absolute_value.is_admissible` which we use to show the class number
 of the ring of integers of a global field is finite.
 
@@ -96,7 +98,7 @@ begin
     { intros i j h, ext, exact list.nodup_iff_nth_le_inj.mp (finset.nodup_to_list _) _ _ _ _ h },
     have : ∀ i h, (finset.univ.filter (λ x, t x = s)).to_list.nth_le i h ∈
       finset.univ.filter (λ x, t x = s),
-    { intros i h, exact (finset.mem_to_list _).mp (list.nth_le_mem _ _ _) },
+    { intros i h, exact finset.mem_to_list.mp (list.nth_le_mem _ _ _) },
     obtain ⟨_, h₀⟩ := finset.mem_filter.mp (this i₀ _),
     obtain ⟨_, h₁⟩ := finset.mem_filter.mp (this i₁ _),
     exact h₀.trans h₁.symm },
diff --git a/src/number_theory/class_number/admissible_card_pow_degree.lean b/src/number_theory/class_number/admissible_card_pow_degree.lean
index 528ee0d617d9d..dfb55c2f566e6 100644
--- a/src/number_theory/class_number/admissible_card_pow_degree.lean
+++ b/src/number_theory/class_number/admissible_card_pow_degree.lean
@@ -4,15 +4,18 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
 import number_theory.class_number.admissible_absolute_value
-import analysis.special_functions.pow
+import analysis.special_functions.pow.real
 import ring_theory.ideal.local_ring
 import data.polynomial.degree.card_pow_degree
 
 /-!
 # Admissible absolute values on polynomials
-This file defines an admissible absolute value
-`polynomial.card_pow_degree_is_admissible` which we use to show the class number
-of the ring of integers of a function field is finite.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines an admissible absolute value `polynomial.card_pow_degree_is_admissible` which we
+use to show the class number of the ring of integers of a function field is finite.
 
 ## Main results
 
@@ -105,7 +108,7 @@ lemma exists_approx_polynomial {b : Fq[X]} (hb : b ≠ 0)
   ∃ i₀ i₁, i₀ ≠ i₁ ∧ (card_pow_degree (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree b • ε :=
 begin
   have hbε : 0 < card_pow_degree b • ε,
-  { rw [algebra.smul_def, ring_hom.eq_int_cast],
+  { rw [algebra.smul_def, eq_int_cast],
     exact mul_pos (int.cast_pos.mpr (absolute_value.pos _ hb)) hε },
   have one_lt_q : 1 < fintype.card Fq := fintype.one_lt_card,
   have one_lt_q' : (1 : ℝ) < fintype.card Fq, { assumption_mod_cast },
@@ -134,7 +137,7 @@ begin
     b.nat_degree + log ε / log (fintype.card Fq),
   { rwa [← real.log_lt_log_iff (int.cast_pos.mpr (card_pow_degree.pos h')) hbε,
         card_pow_degree_nonzero _ h', card_pow_degree_nonzero _ hb,
-        algebra.smul_def, ring_hom.eq_int_cast,
+        algebra.smul_def, eq_int_cast,
         int.cast_pow, int.cast_coe_nat, int.cast_pow, int.cast_coe_nat,
         log_mul (pow_ne_zero _ q_pos'.ne') hε.ne',
         ← rpow_nat_cast, ← rpow_nat_cast, log_rpow q_pos', log_rpow q_pos',
@@ -184,7 +187,7 @@ lemma exists_partition_polynomial_aux (n : ℕ) {ε : ℝ} (hε : 0 < ε)
   t i₀ = t i₁ ↔ (card_pow_degree (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree b • ε :=
 begin
   have hbε : 0 < card_pow_degree b • ε,
-  { rw [algebra.smul_def, ring_hom.eq_int_cast],
+  { rw [algebra.smul_def, eq_int_cast],
     exact mul_pos (int.cast_pos.mpr (absolute_value.pos _ hb)) hε },
   -- We go by induction on the size `A`.
   induction n with n ih,
@@ -199,10 +202,9 @@ begin
 
   obtain ⟨t', ht'⟩ := ih (fin.tail A),
   -- We got rid of `A 0`, so determine the index `j` of the partition we'll re-add it to.
-  suffices : ∃ j,
+  rsuffices ⟨j, hj⟩ : ∃ j,
     ∀ i, t' i = j ↔ (card_pow_degree (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree b • ε,
-  { obtain ⟨j, hj⟩ := this,
-    refine ⟨fin.cons j t', λ i₀ i₁, _⟩,
+  { refine ⟨fin.cons j t', λ i₀ i₁, _⟩,
     refine fin.cases _ (λ i₀, _) i₀; refine fin.cases _ (λ i₁, _) i₁,
     { simpa using hbε },
     { rw [fin.cons_succ, fin.cons_zero, eq_comm, absolute_value.map_sub],
diff --git a/src/number_theory/class_number/finite.lean b/src/number_theory/class_number/finite.lean
index 353d6ff7ca5a8..bae910d2a816e 100644
--- a/src/number_theory/class_number/finite.lean
+++ b/src/number_theory/class_number/finite.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
 
-import analysis.special_functions.pow
+import analysis.special_functions.pow.real
 import linear_algebra.free_module.pid
 import linear_algebra.matrix.absolute_value
 import number_theory.class_number.admissible_absolute_value
@@ -14,6 +14,9 @@ import ring_theory.norm
 
 /-!
 # Class numbers of global fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 In this file, we use the notion of "admissible absolute value" to prove
 finiteness of the class group for number fields and function fields,
 and define `class_number` as the order of this group.
@@ -66,7 +69,7 @@ begin
       (algebra.left_mul_matrix_injective bS),
     ext j k,
     simp [h, dmatrix.zero_apply] },
-  simp only [norm_bound, algebra.smul_def, eq_nat_cast, int.nat_cast_eq_coe_nat],
+  simp only [norm_bound, algebra.smul_def, eq_nat_cast],
   refine mul_pos (int.coe_nat_pos.mpr (nat.factorial_pos _)) _,
   refine pow_pos (mul_pos (int.coe_nat_pos.mpr (fintype.card_pos_iff.mpr ⟨i⟩)) _) _,
   refine lt_of_lt_of_le (abv.pos hijk) (finset.le_max' _ _ _),
@@ -158,16 +161,14 @@ variables [infinite R]
 
 /-- In the following results, we need a large set of distinct elements of `R`. -/
 noncomputable def distinct_elems : fin (cardM bS adm).succ ↪ R :=
-function.embedding.trans (fin.coe_embedding _).to_embedding (infinite.nat_embedding R)
+fin.coe_embedding.trans (infinite.nat_embedding R)
 
 variables [decidable_eq R]
 
 /-- `finset_approx` is a finite set such that each fractional ideal in the integral closure
 contains an element close to `finset_approx`. -/
 noncomputable def finset_approx : finset R :=
-((finset.univ.product finset.univ)
-  .image (λ (xy : _ × _), distinct_elems bS adm xy.1 - distinct_elems bS adm xy.2))
-  .erase 0
+(finset.univ.image $ λ xy : _ × _, distinct_elems bS adm xy.1 - distinct_elems bS adm xy.2).erase 0
 
 lemma finset_approx.zero_not_mem : (0 : R) ∉ finset_approx bS adm :=
 finset.not_mem_erase _ _
@@ -183,7 +184,7 @@ begin
     rintro rfl,
     simpa using hx },
   { rintros ⟨i, j, hij, rfl⟩,
-    refine ⟨_, ⟨i, j⟩, finset.mem_product.mpr ⟨finset.mem_univ _, finset.mem_univ _⟩, rfl⟩,
+    refine ⟨_, ⟨i, j⟩, finset.mem_univ _, rfl⟩,
     rw [ne.def, sub_eq_zero],
     exact λ h, hij ((distinct_elems bS adm).injective h) }
 end
@@ -206,7 +207,7 @@ begin
                 (abv b ^ fintype.card ι),
   { have := norm_bound_pos abv bS,
     have := abv.nonneg b,
-    rw [ε_eq, algebra.smul_def, ring_hom.eq_int_cast, ← rpow_nat_cast, mul_rpow, ← rpow_mul,
+    rw [ε_eq, algebra.smul_def, eq_int_cast, ← rpow_nat_cast, mul_rpow, ← rpow_mul,
         div_mul_cancel, rpow_neg_one, mul_left_comm, mul_inv_cancel, mul_one, rpow_nat_cast];
       try { norm_cast, linarith },
     { apply rpow_nonneg_of_nonneg,
@@ -294,9 +295,8 @@ include ist iic
 
 /-- Each class in the class group contains an ideal `J`
 such that `M := Π m ∈ finset_approx` is in `J`. -/
-theorem exists_mk0_eq_mk0 [is_dedekind_domain S] [is_fraction_ring S L]
-  (h : algebra.is_algebraic R L) (I : (ideal S)⁰) :
-  ∃ (J : (ideal S)⁰), class_group.mk0 L I = class_group.mk0 L J ∧
+theorem exists_mk0_eq_mk0 [is_dedekind_domain S] (h : algebra.is_algebraic R L) (I : (ideal S)⁰) :
+  ∃ (J : (ideal S)⁰), class_group.mk0 I = class_group.mk0 J ∧
     algebra_map _ _ (∏ m in finset_approx bS adm, m) ∈ (J : ideal S) :=
 begin
   set M := ∏ m in finset_approx bS adm, m with M_eq,
@@ -334,17 +334,16 @@ omit iic ist
 /-- `class_group.mk_M_mem` is a specialization of `class_group.mk0` to (the finite set of)
 ideals that contain `M := ∏ m in finset_approx L f abs, m`.
 By showing this function is surjective, we prove that the class group is finite. -/
-noncomputable def mk_M_mem [is_fraction_ring S L] [is_dedekind_domain S]
+noncomputable def mk_M_mem [is_dedekind_domain S]
   (J : {J : ideal S // algebra_map _ _ (∏ m in finset_approx bS adm, m) ∈ J}) :
-  class_group S L :=
-class_group.mk0 _ ⟨J.1, mem_non_zero_divisors_iff_ne_zero.mpr
+  class_group S :=
+class_group.mk0 ⟨J.1, mem_non_zero_divisors_iff_ne_zero.mpr
   (ne_bot_of_prod_finset_approx_mem bS adm J.1 J.2)⟩
 
 include iic ist
 
-lemma mk_M_mem_surjective [is_fraction_ring S L] [is_dedekind_domain S]
-  (h : algebra.is_algebraic R L) :
-  function.surjective (class_group.mk_M_mem L bS adm) :=
+lemma mk_M_mem_surjective [is_dedekind_domain S] (h : algebra.is_algebraic R L) :
+  function.surjective (class_group.mk_M_mem bS adm) :=
 begin
   intro I',
   obtain ⟨⟨I, hI⟩, rfl⟩ := class_group.mk0_surjective I',
@@ -360,8 +359,8 @@ algebraic extension `L` is finite if there is an admissible absolute value.
 See also `class_group.fintype_of_admissible_of_finite` where `L` is a finite
 extension of `K = Frac(R)`, supplying most of the required assumptions automatically.
 -/
-noncomputable def fintype_of_admissible_of_algebraic [is_fraction_ring S L] [is_dedekind_domain S]
-  (h : algebra.is_algebraic R L) : fintype (class_group S L) :=
+noncomputable def fintype_of_admissible_of_algebraic [is_dedekind_domain S]
+  (h : algebra.is_algebraic R L) : fintype (class_group S) :=
 @fintype.of_surjective _ _ _
   (@fintype.of_equiv _
     {J // J ∣ ideal.span ({algebra_map R S (∏ (m : R) in finset_approx bS adm, m)} : set S)}
@@ -370,9 +369,11 @@ noncomputable def fintype_of_admissible_of_algebraic [is_fraction_ring S L] [is_
             exact prod_finset_approx_ne_zero bS adm }))
     ((equiv.refl _).subtype_equiv (λ I, ideal.dvd_iff_le.trans
       (by rw [equiv.refl_apply, ideal.span_le, set.singleton_subset_iff]))))
-  (class_group.mk_M_mem L bS adm)
+  (class_group.mk_M_mem bS adm)
   (class_group.mk_M_mem_surjective L bS adm h)
 
+include K
+
 /-- The main theorem: the class group of an integral closure `S` of `R` in a
 finite extension `L` of `K = Frac(R)` is finite if there is an admissible
 absolute value.
@@ -380,9 +381,7 @@ absolute value.
 See also `class_group.fintype_of_admissible_of_algebraic` where `L` is an
 algebraic extension of `R`, that includes some extra assumptions.
 -/
-noncomputable def fintype_of_admissible_of_finite [is_dedekind_domain R] :
-  fintype (@class_group S L _ _ _
-    (is_integral_closure.is_fraction_ring_of_finite_extension R K L S)) :=
+noncomputable def fintype_of_admissible_of_finite : fintype (class_group S) :=
 begin
   letI := classical.dec_eq L,
   letI := is_integral_closure.is_fraction_ring_of_finite_extension R K L S,
diff --git a/src/number_theory/class_number/function_field.lean b/src/number_theory/class_number/function_field.lean
index 1ee867b982a75..90b7241ccafc3 100644
--- a/src/number_theory/class_number/function_field.lean
+++ b/src/number_theory/class_number/function_field.lean
@@ -10,6 +10,9 @@ import number_theory.function_field
 /-!
 # Class numbers of function fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the class number of a function field as the (finite) cardinality of
 the class group of its ring of integers. It also proves some elementary results
 on the class number.
@@ -33,7 +36,7 @@ namespace ring_of_integers
 
 open function_field
 
-noncomputable instance  : fintype (class_group (ring_of_integers Fq F) F) :=
+noncomputable instance  : fintype (class_group (ring_of_integers Fq F)) :=
 class_group.fintype_of_admissible_of_finite (ratfunc Fq) F
   (polynomial.card_pow_degree_is_admissible : absolute_value.is_admissible
     (polynomial.card_pow_degree : absolute_value Fq[X] ℤ))
@@ -41,7 +44,7 @@ class_group.fintype_of_admissible_of_finite (ratfunc Fq) F
 end ring_of_integers
 
 /-- The class number in a function field is the (finite) cardinality of the class group. -/
-noncomputable def class_number : ℕ := fintype.card (class_group (ring_of_integers Fq F) F)
+noncomputable def class_number : ℕ := fintype.card (class_group (ring_of_integers Fq F))
 
 /-- The class number of a function field is `1` iff the ring of integers is a PID. -/
 theorem class_number_eq_one_iff :
diff --git a/src/number_theory/class_number/number_field.lean b/src/number_theory/class_number/number_field.lean
deleted file mode 100644
index 19deef684a86e..0000000000000
--- a/src/number_theory/class_number/number_field.lean
+++ /dev/null
@@ -1,54 +0,0 @@
-/-
-Copyright (c) 2021 Anne Baanen. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Anne Baanen
--/
-import number_theory.class_number.admissible_abs
-import number_theory.class_number.finite
-import number_theory.number_field
-
-/-!
-# Class numbers of number fields
-
-This file defines the class number of a number field as the (finite) cardinality of
-the class group of its ring of integers. It also proves some elementary results
-on the class number.
-
-## Main definitions
-- `number_field.class_number`: the class number of a number field is the (finite)
-cardinality of the class group of its ring of integers
--/
-
-namespace number_field
-
-variables (K : Type*) [field K] [number_field K]
-
-namespace ring_of_integers
-
-noncomputable instance : fintype (class_group (ring_of_integers K) K) :=
-class_group.fintype_of_admissible_of_finite ℚ _ absolute_value.abs_is_admissible
-
-end ring_of_integers
-
-/-- The class number of a number field is the (finite) cardinality of the class group. -/
-noncomputable def class_number : ℕ := fintype.card (class_group (ring_of_integers K) K)
-
-variables {K}
-
-/-- The class number of a number field is `1` iff the ring of integers is a PID. -/
-theorem class_number_eq_one_iff :
-  class_number K = 1 ↔ is_principal_ideal_ring (ring_of_integers K) :=
-card_class_group_eq_one_iff
-
-end number_field
-
-namespace rat
-
-open number_field
-
-theorem class_number_eq : number_field.class_number ℚ = 1 :=
-class_number_eq_one_iff.mpr $ by convert is_principal_ideal_ring.of_surjective
-  (rat.ring_of_integers_equiv.symm : ℤ →+* ring_of_integers ℚ)
-  (rat.ring_of_integers_equiv.symm.surjective)
-
-end rat
diff --git a/src/number_theory/cyclotomic/basic.lean b/src/number_theory/cyclotomic/basic.lean
index df2ab5d3a0fb8..cc16b9b61dbfc 100644
--- a/src/number_theory/cyclotomic/basic.lean
+++ b/src/number_theory/cyclotomic/basic.lean
@@ -3,16 +3,16 @@ Copyright (c) 2021 Riccardo Brasca. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
-
-import ring_theory.polynomial.cyclotomic.basic
-import number_theory.number_field
-import algebra.char_p.algebra
+import ring_theory.polynomial.cyclotomic.roots
+import number_theory.number_field.basic
 import field_theory.galois
-import analysis.complex.polynomial
 
 /-!
 # Cyclotomic extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `A` and `B` be commutative rings with `algebra A B`. For `S : set ℕ+`, we define a class
 `is_cyclotomic_extension S A B` expressing the fact that `B` is obtained from `A` by adding `n`-th
 primitive roots of unity, for all `n ∈ S`.
@@ -32,7 +32,8 @@ primitive roots of unity, for all `n ∈ S`.
 ## Main results
 
 * `is_cyclotomic_extension.trans` : if `is_cyclotomic_extension S A B` and
-  `is_cyclotomic_extension T B C`, then `is_cyclotomic_extension (S ∪ T) A C`.
+  `is_cyclotomic_extension T B C`, then `is_cyclotomic_extension (S ∪ T) A C` if
+  `function.injective (algebra_map B C)`.
 * `is_cyclotomic_extension.union_right` : given `is_cyclotomic_extension (S ∪ T) A B`, then
   `is_cyclotomic_extension T (adjoin A { b : B | ∃ a : ℕ+, a ∈ S ∧ b ^ (a : ℕ) = 1 }) B`.
 * `is_cyclotomic_extension.union_right` : given `is_cyclotomic_extension T A B` and `S ⊆ T`, then
@@ -41,16 +42,15 @@ primitive roots of unity, for all `n ∈ S`.
   `B` is a finite `A`-algebra.
 * `is_cyclotomic_extension.number_field` : a finite cyclotomic extension of a number field is a
   number field.
-* `is_cyclotomic_extension.splitting_field_X_pow_sub_one` : if `is_cyclotomic_extension {n} K L`
-  and `ne_zero ((n : ℕ) : K)`, then `L` is the splitting field of `X ^ n - 1`.
-* `is_cyclotomic_extension.splitting_field_cyclotomic` : if `is_cyclotomic_extension {n} K L`
-  and `ne_zero ((n : ℕ) : K)`, then `L` is the splitting field of `cyclotomic n K`.
+* `is_cyclotomic_extension.splitting_field_X_pow_sub_one` : if `is_cyclotomic_extension {n} K L`,
+  then `L` is the splitting field of `X ^ n - 1`.
+* `is_cyclotomic_extension.splitting_field_cyclotomic` : if `is_cyclotomic_extension {n} K L`,
+  then `L` is the splitting field of `cyclotomic n K`.
 
 ## Implementation details
 
 Our definition of `is_cyclotomic_extension` is very general, to allow rings of any characteristic
-and infinite extensions, but it will mainly be used in the case `S = {n}` with `(n : A) ≠ 0` (and
-for integral domains).
+and infinite extensions, but it will mainly be used in the case `S = {n}` and for integral domains.
 All results are in the `is_cyclotomic_extension` namespace.
 Note that some results, for example `is_cyclotomic_extension.trans`,
 `is_cyclotomic_extension.finite`, `is_cyclotomic_extension.number_field`,
@@ -60,7 +60,7 @@ included in the `cyclotomic` locale.
 
 -/
 
-open polynomial algebra finite_dimensional module set
+open polynomial algebra finite_dimensional set
 
 open_locale big_operators
 
@@ -73,11 +73,11 @@ variables [field K] [field L] [algebra K L]
 noncomputable theory
 
 /-- Given an `A`-algebra `B` and `S : set ℕ+`, we define `is_cyclotomic_extension S A B` requiring
-that `cyclotomic a A` has a root in `B` for all `a ∈ S` and that `B` is generated over `A` by the
-roots of `X ^ n - 1`. -/
+that there is a `n`-th primitive root of unity in `B` for all `n ∈ S` and that `B` is generated
+over `A` by the roots of `X ^ n - 1`. -/
 @[mk_iff] class is_cyclotomic_extension : Prop :=
-(exists_root {a : ℕ+} (ha : a ∈ S) : ∃ r : B, aeval r (cyclotomic a A) = 0)
-(adjoin_roots : ∀ (x : B), x ∈ adjoin A { b : B | ∃ a : ℕ+, a ∈ S ∧ b ^ (a : ℕ) = 1 })
+(exists_prim_root {n : ℕ+} (ha : n ∈ S) : ∃ r : B, is_primitive_root r n)
+(adjoin_roots : ∀ (x : B), x ∈ adjoin A { b : B | ∃ n : ℕ+, n ∈ S ∧ b ^ (n : ℕ) = 1 })
 
 namespace is_cyclotomic_extension
 
@@ -85,42 +85,51 @@ section basic
 
 /-- A reformulation of `is_cyclotomic_extension` that uses `⊤`. -/
 lemma iff_adjoin_eq_top : is_cyclotomic_extension S A B ↔
- (∀ (a : ℕ+), a ∈ S → ∃ r : B, aeval r (cyclotomic a A) = 0) ∧
- (adjoin A { b : B | ∃ a : ℕ+, a ∈ S ∧ b ^ (a : ℕ) = 1 } = ⊤) :=
-⟨λ h, ⟨h.exists_root, algebra.eq_top_iff.2 h.adjoin_roots⟩, λ h, ⟨h.1, algebra.eq_top_iff.1 h.2⟩⟩
+ (∀ (n : ℕ+), n ∈ S → ∃ r : B, is_primitive_root r n) ∧
+ (adjoin A { b : B | ∃ n : ℕ+, n ∈ S ∧ b ^ (n : ℕ) = 1 } = ⊤) :=
+⟨λ h, ⟨λ _, h.exists_prim_root, algebra.eq_top_iff.2 h.adjoin_roots⟩,
+  λ h, ⟨h.1, algebra.eq_top_iff.1 h.2⟩⟩
 
 /-- A reformulation of `is_cyclotomic_extension` in the case `S` is a singleton. -/
 lemma iff_singleton : is_cyclotomic_extension {n} A B ↔
- (∃ r : B, aeval r (cyclotomic n A) = 0) ∧
+ (∃ r : B, is_primitive_root r n) ∧
  (∀ x, x ∈ adjoin A { b : B | b ^ (n : ℕ) = 1 }) :=
 by simp [is_cyclotomic_extension_iff]
 
-/-- If `is_cyclotomic_extension ∅ A B`, then `A = B`. -/
+/-- If `is_cyclotomic_extension ∅ A B`, then the image of `A` in `B` equals `B`. -/
 lemma empty [h : is_cyclotomic_extension ∅ A B] : (⊥ : subalgebra A B) = ⊤ :=
 by simpa [algebra.eq_top_iff, is_cyclotomic_extension_iff] using h
 
-/-- If `is_cyclotomic_extension {1} A B`, then `A = B`. -/
+/-- If `is_cyclotomic_extension {1} A B`, then the image of `A` in `B` equals `B`. -/
 lemma singleton_one [h : is_cyclotomic_extension {1} A B] : (⊥ : subalgebra A B) = ⊤ :=
 algebra.eq_top_iff.2 (λ x, by simpa [adjoin_singleton_one]
   using ((is_cyclotomic_extension_iff _ _ _).1 h).2 x)
 
+variables {A B}
+
+/-- If `(⊥ : subalgebra A B) = ⊤`, then `is_cyclotomic_extension ∅ A B`. -/
+lemma singleton_zero_of_bot_eq_top (h : (⊥ : subalgebra A B) = ⊤) :
+  is_cyclotomic_extension ∅ A B :=
+begin
+  refine (iff_adjoin_eq_top _ _ _).2 ⟨λ s hs, by simpa using hs, _root_.eq_top_iff.2 (λ x hx, _)⟩,
+  rw [← h] at hx,
+  simpa using hx,
+end
+
+variables (A B)
+
 /-- Transitivity of cyclotomic extensions. -/
 lemma trans (C : Type w) [comm_ring C] [algebra A C] [algebra B C]
   [is_scalar_tower A B C] [hS : is_cyclotomic_extension S A B]
-  [hT : is_cyclotomic_extension T B C] : is_cyclotomic_extension (S ∪ T) A C :=
+  [hT : is_cyclotomic_extension T B C] (h : function.injective (algebra_map B C)) :
+  is_cyclotomic_extension (S ∪ T) A C :=
 begin
   refine ⟨λ n hn, _, λ x, _⟩,
   { cases hn,
     { obtain ⟨b, hb⟩ := ((is_cyclotomic_extension_iff _ _ _).1 hS).1 hn,
       refine ⟨algebra_map B C b, _⟩,
-      replace hb := congr_arg (algebra_map B C) hb,
-      rw [aeval_def, eval₂_eq_eval_map, map_cyclotomic, ring_hom.map_zero, ← eval₂_at_apply,
-        eval₂_eq_eval_map, map_cyclotomic] at hb,
-      rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic] },
-    { obtain ⟨c, hc⟩ := ((is_cyclotomic_extension_iff _ _ _).1 hT).1 hn,
-      refine ⟨c, _⟩,
-      rw [aeval_def, eval₂_eq_eval_map, map_cyclotomic] at hc,
-      rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic] } },
+      exact hb.map_of_injective h },
+    { exact ((is_cyclotomic_extension_iff _ _ _).1 hT).1 hn } },
   { refine adjoin_induction (((is_cyclotomic_extension_iff _ _ _).1 hT).2 x) (λ c ⟨n, hn⟩,
       subset_adjoin ⟨n, or.inr hn.1, hn.2⟩) (λ b, _) (λ x y hx hy, subalgebra.add_mem _ hx hy)
       (λ x y hx hy, subalgebra.mul_mem _ hx hy),
@@ -133,6 +142,22 @@ begin
       exact ⟨n, ⟨mem_union_left T hn.1, by rw [← h₁, ← alg_hom.map_pow, hn.2, alg_hom.map_one]⟩⟩ } }
 end
 
+@[nontriviality] lemma subsingleton_iff [subsingleton B] :
+  is_cyclotomic_extension S A B ↔ S = {} ∨ S = {1} :=
+begin
+  split,
+  { rintro ⟨hprim, -⟩,
+    rw ←subset_singleton_iff_eq,
+    intros t ht,
+    obtain ⟨ζ, hζ⟩ := hprim ht,
+    rw [mem_singleton_iff, ←pnat.coe_eq_one_iff],
+    exact_mod_cast hζ.unique (is_primitive_root.of_subsingleton ζ) },
+  { rintro (rfl|rfl),
+    { refine ⟨λ _ h, h.elim, λ x, by convert (mem_top : x ∈ ⊤)⟩ },
+    { rw iff_singleton,
+      refine ⟨⟨0, is_primitive_root.of_subsingleton 0⟩, λ x, by convert (mem_top : x ∈ ⊤)⟩ } }
+end
+
 /-- If `B` is a cyclotomic extension of `A` given by roots of unity of order in `S ∪ T`, then `B`
 is a cyclotomic extension of `adjoin A { b : B | ∃ a : ℕ+, a ∈ S ∧ b ^ (a : ℕ) = 1 } ` given by
 roots of unity of order in `T`. -/
@@ -150,14 +175,9 @@ begin
       { exact ⟨n, or.inl hn.1, hn.2⟩ },
       { exact ⟨n, or.inr hn.1, hn.2⟩ } } },
 
-  refine ⟨λ n hn, _, λ b, _⟩,
-  { obtain ⟨b, hb⟩ := ((is_cyclotomic_extension_iff _ _ _).1 h).1 (mem_union_right S hn),
-    refine ⟨b, _⟩,
-    rw [aeval_def, eval₂_eq_eval_map, map_cyclotomic] at hb,
-    rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic] },
-  { replace h := ((is_cyclotomic_extension_iff _ _ _).1 h).2 b,
-    rwa [this, adjoin_union_eq_adjoin_adjoin,
-      subalgebra.mem_restrict_scalars] at h }
+  refine ⟨λ n hn, ((is_cyclotomic_extension_iff _ _ _).1 h).1 (mem_union_right S hn), λ b, _⟩,
+  replace h := ((is_cyclotomic_extension_iff _ _ _).1 h).2 b,
+  rwa [this, adjoin_union_eq_adjoin_adjoin, subalgebra.mem_restrict_scalars] at h
 end
 
 /-- If `B` is a cyclotomic extension of `A` given by roots of unity of order in `T` and `S ⊆ T`,
@@ -168,22 +188,119 @@ lemma union_left [h : is_cyclotomic_extension T A B] (hS : S ⊆ T) :
 begin
   refine ⟨λ n hn, _, λ b, _⟩,
   { obtain ⟨b, hb⟩ := ((is_cyclotomic_extension_iff _ _ _).1 h).1 (hS hn),
-    refine ⟨⟨b, subset_adjoin ⟨n, hn, _⟩⟩, _⟩,
-    { rw [aeval_def, eval₂_eq_eval_map, map_cyclotomic, ← is_root.def] at hb,
-      suffices : (X ^ (n : ℕ) - 1).is_root b,
-      { simpa [sub_eq_zero] using this },
-      exact hb.dvd (cyclotomic.dvd_X_pow_sub_one _ _) },
-      rwa [← subalgebra.coe_eq_zero, aeval_subalgebra_coe, subtype.coe_mk] },
+    refine ⟨⟨b, subset_adjoin ⟨n, hn, hb.pow_eq_one⟩⟩, _⟩,
+    rwa [← is_primitive_root.coe_submonoid_class_iff, subtype.coe_mk] },
   { convert mem_top,
     rw [← adjoin_adjoin_coe_preimage, preimage_set_of_eq],
-    norm_cast, }
+    norm_cast }
+end
+
+variables {n S}
+
+/-- If `∀ s ∈ S, n ∣ s` and `S` is not empty, then `is_cyclotomic_extension S A B` implies
+`is_cyclotomic_extension (S ∪ {n}) A B`. -/
+lemma of_union_of_dvd (h : ∀ s ∈ S, n ∣ s) (hS : S.nonempty) [H : is_cyclotomic_extension S A B] :
+  is_cyclotomic_extension (S ∪ {n}) A B :=
+begin
+  refine (iff_adjoin_eq_top _ _ _).2 ⟨λ s hs, _, _⟩,
+  { rw [mem_union, mem_singleton_iff] at hs,
+    obtain hs|rfl := hs,
+    { exact H.exists_prim_root hs },
+    { obtain ⟨m, hm⟩ := hS,
+      obtain ⟨x, rfl⟩ := h m hm,
+      obtain ⟨ζ, hζ⟩ := H.exists_prim_root hm,
+      refine ⟨ζ ^ (x : ℕ), _⟩,
+      convert hζ.pow_of_dvd x.ne_zero (dvd_mul_left (x : ℕ) s),
+      simp only [pnat.mul_coe, nat.mul_div_left, pnat.pos] } },
+  { refine _root_.eq_top_iff.2 _,
+    rw [← ((iff_adjoin_eq_top S A B).1 H).2],
+    refine adjoin_mono (λ x hx, _),
+    simp only [union_singleton, mem_insert_iff, mem_set_of_eq] at ⊢ hx,
+    obtain ⟨m, hm⟩ := hx,
+    exact ⟨m, ⟨or.inr hm.1, hm.2⟩⟩ }
+end
+
+/-- If `∀ s ∈ S, n ∣ s` and `S` is not empty, then `is_cyclotomic_extension S A B` if and only if
+`is_cyclotomic_extension (S ∪ {n}) A B`. -/
+lemma iff_union_of_dvd (h : ∀ s ∈ S, n ∣ s) (hS : S.nonempty) :
+  is_cyclotomic_extension S A B ↔ is_cyclotomic_extension (S ∪ {n}) A B :=
+begin
+  refine ⟨λ H, by exactI of_union_of_dvd A B h hS, λ H, (iff_adjoin_eq_top _ _ _).2 ⟨λ s hs, _, _⟩⟩,
+  { exact H.exists_prim_root (subset_union_left _ _ hs) },
+  { rw [_root_.eq_top_iff, ← ((iff_adjoin_eq_top _ A B).1 H).2],
+    refine adjoin_mono (λ x hx, _),
+    simp only [union_singleton, mem_insert_iff, mem_set_of_eq] at ⊢ hx,
+    obtain ⟨m, rfl|hm, hxpow⟩ := hx,
+    { obtain ⟨y, hy⟩ := hS,
+      refine ⟨y, ⟨hy, _⟩⟩,
+      obtain ⟨z, rfl⟩ := h y hy,
+      simp only [pnat.mul_coe, pow_mul, hxpow, one_pow] },
+    { exact ⟨m, ⟨hm, hxpow⟩⟩ } }
+end
+
+variables (n S)
+
+/-- `is_cyclotomic_extension S A B` is equivalent to `is_cyclotomic_extension (S ∪ {1}) A B`. -/
+lemma iff_union_singleton_one :
+  is_cyclotomic_extension S A B ↔ is_cyclotomic_extension (S ∪ {1}) A B :=
+begin
+  obtain hS|rfl := S.eq_empty_or_nonempty.symm,
+  { exact iff_union_of_dvd _ _ (λ s hs, one_dvd _) hS },
+  rw [empty_union],
+  refine ⟨λ H, _, λ H, _⟩,
+  { refine (iff_adjoin_eq_top _ _ _).2 ⟨λ s hs, ⟨1, by simp [mem_singleton_iff.1 hs]⟩, _⟩,
+    simp [adjoin_singleton_one, @empty _ _ _ _ _ H] },
+  { refine (iff_adjoin_eq_top _ _ _).2 ⟨λ s hs, (not_mem_empty s hs).elim, _⟩,
+    simp [@singleton_one A B _ _ _ H] }
+end
+
+variables {A B}
+
+/-- If `(⊥ : subalgebra A B) = ⊤`, then `is_cyclotomic_extension {1} A B`. -/
+lemma singleton_one_of_bot_eq_top (h : (⊥ : subalgebra A B) = ⊤) :
+  is_cyclotomic_extension {1} A B :=
+begin
+  convert (iff_union_singleton_one _ _ _).1 (singleton_zero_of_bot_eq_top h),
+  simp
+end
+
+/-- If `function.surjective (algebra_map A B)`, then `is_cyclotomic_extension {1} A B`. -/
+lemma singleton_one_of_algebra_map_bijective (h : function.surjective (algebra_map A B)) :
+  is_cyclotomic_extension {1} A B :=
+singleton_one_of_bot_eq_top (surjective_algebra_map_iff.1 h).symm
+
+variables (A B)
+
+/-- Given `(f : B ≃ₐ[A] C)`, if `is_cyclotomic_extension S A B` then
+`is_cyclotomic_extension S A C`. -/
+@[protected] lemma equiv {C : Type*} [comm_ring C] [algebra A C] [h : is_cyclotomic_extension S A B]
+  (f : B ≃ₐ[A] C) : is_cyclotomic_extension S A C :=
+begin
+  letI : algebra B C := f.to_alg_hom.to_ring_hom.to_algebra,
+  haveI : is_cyclotomic_extension {1} B C := singleton_one_of_algebra_map_bijective f.surjective,
+  haveI : is_scalar_tower A B C := is_scalar_tower.of_ring_hom f.to_alg_hom,
+  exact (iff_union_singleton_one _ _ _).2 (trans S {1} A B C f.injective)
+end
+
+@[protected]
+lemma ne_zero [h : is_cyclotomic_extension {n} A B] [is_domain B] : ne_zero ((n : ℕ) : B) :=
+begin
+  obtain ⟨⟨r, hr⟩, -⟩ := (iff_singleton n A B).1 h,
+  exact hr.ne_zero'
+end
+
+@[protected]
+lemma ne_zero' [is_cyclotomic_extension {n} A B] [is_domain B] : ne_zero ((n : ℕ) : A) :=
+begin
+  apply ne_zero.nat_of_ne_zero (algebra_map A B),
+  exact ne_zero n A B,
 end
 
 end basic
 
 section fintype
 
-lemma finite_of_singleton [is_domain B] [h : is_cyclotomic_extension {n} A B] : finite A B :=
+lemma finite_of_singleton [is_domain B] [h : is_cyclotomic_extension {n} A B] : module.finite A B :=
 begin
   classical,
   rw [module.finite_def, ← top_to_submodule, ← ((iff_adjoin_eq_top _ _ _).1 h).2],
@@ -198,10 +315,13 @@ begin
 end
 
 /-- If `S` is finite and `is_cyclotomic_extension S A B`, then `B` is a finite `A`-algebra. -/
-lemma finite [is_domain B] [h₁ : fintype S] [h₂ : is_cyclotomic_extension S A B] : finite A B :=
+@[protected]
+lemma finite [is_domain B] [h₁ : finite S] [h₂ : is_cyclotomic_extension S A B] :
+  module.finite A B :=
 begin
+  casesI nonempty_fintype S with h,
   unfreezingI {revert h₂ A B},
-  refine set.finite.induction_on (set.finite.intro h₁) (λ A B, _) (λ n S hn hS H A B, _),
+  refine set.finite.induction_on (set.finite.intro h) (λ A B, _) (λ n S hn hS H A B, _),
   { introsI _ _ _ _ _,
     refine module.finite_def.2 ⟨({1} : finset B), _⟩,
     simp [← top_to_submodule, ← empty, to_submodule_bot] },
@@ -209,32 +329,34 @@ begin
     haveI : is_cyclotomic_extension S A (adjoin A { b : B | ∃ (n : ℕ+),
       n ∈ S ∧ b ^ (n : ℕ) = 1 }) := union_left _ (insert n S) _ _ (subset_insert n S),
     haveI := H A (adjoin A { b : B | ∃ (n : ℕ+), n ∈ S ∧ b ^ (n : ℕ) = 1 }),
-    haveI : finite (adjoin A { b : B | ∃ (n : ℕ+), n ∈ S ∧ b ^ (n : ℕ) = 1 }) B,
+    haveI : module.finite (adjoin A { b : B | ∃ (n : ℕ+), n ∈ S ∧ b ^ (n : ℕ) = 1 }) B,
     { rw [← union_singleton] at h,
       letI := @union_right S {n} A B _ _ _ h,
       exact finite_of_singleton n _ _ },
-    exact finite.trans (adjoin A { b : B | ∃ (n : ℕ+), n ∈ S ∧ b ^ (n : ℕ) = 1 }) _ }
+    exact module.finite.trans (adjoin A { b : B | ∃ (n : ℕ+), n ∈ S ∧ b ^ (n : ℕ) = 1 }) _ }
 end
 
 /-- A cyclotomic finite extension of a number field is a number field. -/
-lemma number_field [h : number_field K] [fintype S] [is_cyclotomic_extension S K L] :
+lemma number_field [h : number_field K] [_root_.finite S] [is_cyclotomic_extension S K L] :
   number_field L :=
 { to_char_zero := char_zero_of_injective_algebra_map (algebra_map K L).injective,
-  to_finite_dimensional := @finite.trans _ K L _ _ _ _
-    (@algebra_rat L _ (char_zero_of_injective_algebra_map (algebra_map K L).injective)) _ _
-    h.to_finite_dimensional (finite S K L) }
+  to_finite_dimensional := begin
+    haveI := char_zero_of_injective_algebra_map (algebra_map K L).injective,
+    haveI := finite S K L,
+    exact module.finite.trans K _
+  end }
 
 localized "attribute [instance] is_cyclotomic_extension.number_field" in cyclotomic
 
 /-- A finite cyclotomic extension of an integral noetherian domain is integral -/
-lemma integral [is_domain B] [is_noetherian_ring A] [fintype S] [is_cyclotomic_extension S A B] :
-  algebra.is_integral A B :=
+lemma integral [is_domain B] [is_noetherian_ring A] [_root_.finite S]
+  [is_cyclotomic_extension S A B] : algebra.is_integral A B :=
 is_integral_of_noetherian $ is_noetherian_of_fg_of_noetherian' $ (finite S A B).out
 
 /-- If `S` is finite and `is_cyclotomic_extension S K A`, then `finite_dimensional K A`. -/
-lemma finite_dimensional (C : Type z) [fintype S] [comm_ring C] [algebra K C] [is_domain C]
+lemma finite_dimensional (C : Type z) [_root_.finite S] [comm_ring C] [algebra K C] [is_domain C]
   [is_cyclotomic_extension S K C] : finite_dimensional K C :=
-finite S K C
+is_cyclotomic_extension.finite S K C
 
 localized "attribute [instance] is_cyclotomic_extension.finite_dimensional" in cyclotomic
 
@@ -244,28 +366,29 @@ section
 
 variables {A B}
 
-lemma adjoin_roots_cyclotomic_eq_adjoin_nth_roots [decidable_eq B] [is_domain B] {ζ : B}
-  (hζ : is_primitive_root ζ n) :
-  adjoin A ↑((map (algebra_map A B) (cyclotomic n A)).roots.to_finset) =
+lemma adjoin_roots_cyclotomic_eq_adjoin_nth_roots [is_domain B] {ζ : B}
+  {n : ℕ+} (hζ : is_primitive_root ζ n) :
+  adjoin A ((cyclotomic n A).root_set B) =
   adjoin A {b : B | ∃ (a : ℕ+), a ∈ ({n} : set ℕ+) ∧ b ^ (a : ℕ) = 1} :=
 begin
   simp only [mem_singleton_iff, exists_eq_left, map_cyclotomic],
   refine le_antisymm (adjoin_mono (λ x hx, _)) (adjoin_le (λ x hx, _)),
-  { simp only [multiset.mem_to_finset, finset.mem_coe,
-               map_cyclotomic, mem_roots (cyclotomic_ne_zero n B)] at hx,
+  { rw [mem_root_set'] at hx,
     simp only [mem_singleton_iff, exists_eq_left, mem_set_of_eq],
     rw is_root_of_unity_iff n.pos,
-    exact ⟨n, nat.mem_divisors_self n n.ne_zero, hx⟩ },
+    refine ⟨n, nat.mem_divisors_self n n.ne_zero, _⟩,
+    rw [is_root.def, ←map_cyclotomic n (algebra_map A B), eval_map, ←aeval_def],
+    exact hx.2 },
   { simp only [mem_singleton_iff, exists_eq_left, mem_set_of_eq] at hx,
     obtain ⟨i, hin, rfl⟩ := hζ.eq_pow_of_pow_eq_one hx n.pos,
     refine set_like.mem_coe.2 (subalgebra.pow_mem _ (subset_adjoin _) _),
-    rwa [finset.mem_coe, multiset.mem_to_finset, mem_roots $ cyclotomic_ne_zero n B],
-    exact hζ.is_root_cyclotomic n.pos }
+    rw [mem_root_set', map_cyclotomic, aeval_def, ←eval_map, map_cyclotomic, ←is_root],
+    refine ⟨cyclotomic_ne_zero n B, hζ.is_root_cyclotomic n.pos⟩ }
 end
 
-lemma adjoin_roots_cyclotomic_eq_adjoin_root_cyclotomic [decidable_eq B] [is_domain B]
-  (ζ : B) (hζ : is_primitive_root ζ n) :
-  adjoin A (((map (algebra_map A B) (cyclotomic n A)).roots.to_finset) : set B) = adjoin A ({ζ}) :=
+lemma adjoin_roots_cyclotomic_eq_adjoin_root_cyclotomic {n : ℕ+} [is_domain B]
+  {ζ : B} (hζ : is_primitive_root ζ n) :
+  adjoin A ((cyclotomic n A).root_set B) = adjoin A ({ζ}) :=
 begin
   refine le_antisymm (adjoin_le (λ x hx, _)) (adjoin_mono (λ x hx, _)),
   { suffices hx : x ^ ↑n = 1,
@@ -273,33 +396,31 @@ begin
     exact set_like.mem_coe.2 (subalgebra.pow_mem _ (subset_adjoin $ mem_singleton ζ) _),
     rw is_root_of_unity_iff n.pos,
     refine ⟨n, nat.mem_divisors_self n n.ne_zero, _⟩,
-    rwa [finset.mem_coe, multiset.mem_to_finset,
-         map_cyclotomic, mem_roots $ cyclotomic_ne_zero n B] at hx },
+    rw [mem_root_set', aeval_def, ←eval_map, map_cyclotomic, ←is_root] at hx,
+    exact hx.2 },
   { simp only [mem_singleton_iff, exists_eq_left, mem_set_of_eq] at hx,
-    simpa only [hx, multiset.mem_to_finset, finset.mem_coe, map_cyclotomic,
-                mem_roots (cyclotomic_ne_zero n B)] using hζ.is_root_cyclotomic n.pos }
+    simpa only [hx, mem_root_set', map_cyclotomic, aeval_def, ←eval_map, is_root]
+      using and.intro (cyclotomic_ne_zero n B) (hζ.is_root_cyclotomic n.pos) }
 end
 
-lemma adjoin_primitive_root_eq_top [is_domain B] [h : is_cyclotomic_extension {n} A B]
-  (ζ : B) (hζ : is_primitive_root ζ n) : adjoin A ({ζ} : set B) = ⊤ :=
+lemma adjoin_primitive_root_eq_top {n : ℕ+} [is_domain B] [h : is_cyclotomic_extension {n} A B]
+  {ζ : B} (hζ : is_primitive_root ζ n) : adjoin A ({ζ} : set B) = ⊤ :=
 begin
   classical,
-  rw ←adjoin_roots_cyclotomic_eq_adjoin_root_cyclotomic n ζ hζ,
-  rw adjoin_roots_cyclotomic_eq_adjoin_nth_roots n hζ,
+  rw ←adjoin_roots_cyclotomic_eq_adjoin_root_cyclotomic hζ,
+  rw adjoin_roots_cyclotomic_eq_adjoin_nth_roots hζ,
   exact ((iff_adjoin_eq_top {n} A B).mp h).2,
 end
 
 variable (A)
 
-lemma _root_.is_primitive_root.adjoin_is_cyclotomic_extension [is_domain B] {ζ : B} {n : ℕ+}
+lemma _root_.is_primitive_root.adjoin_is_cyclotomic_extension {ζ : B} {n : ℕ+}
   (h : is_primitive_root ζ n) : is_cyclotomic_extension {n} A (adjoin A ({ζ} : set B)) :=
-{ exists_root := λ i hi,
+{ exists_prim_root := λ i hi,
   begin
     rw [set.mem_singleton_iff] at hi,
     refine ⟨⟨ζ, subset_adjoin $ set.mem_singleton ζ⟩, _⟩,
-    replace h := h.is_root_cyclotomic n.pos,
-    rw [is_root.def, ← map_cyclotomic _ (algebra_map A B), eval_map, ← aeval_def, ← hi] at h,
-    rwa [← subalgebra.coe_eq_zero, aeval_subalgebra_coe, subtype.coe_mk]
+    rwa [← is_primitive_root.coe_submonoid_class_iff, subtype.coe_mk, hi],
   end,
   adjoin_roots := λ x,
   begin
@@ -318,18 +439,16 @@ end
 
 section field
 
-variable [ne_zero ((n : ℕ) : K)]
+variables {n S}
 
-/-- A cyclotomic extension splits `X ^ n - 1` if `n ∈ S` and `ne_zero (n : K)`.-/
+/-- A cyclotomic extension splits `X ^ n - 1` if `n ∈ S`.-/
 lemma splits_X_pow_sub_one [H : is_cyclotomic_extension S K L] (hS : n ∈ S) :
   splits (algebra_map K L) (X ^ (n : ℕ) - 1) :=
 begin
   rw [← splits_id_iff_splits, polynomial.map_sub, polynomial.map_one,
       polynomial.map_pow, polynomial.map_X],
   obtain ⟨z, hz⟩ := ((is_cyclotomic_extension_iff _ _ _).1 H).1 hS,
-  rw [aeval_def, eval₂_eq_eval_map, map_cyclotomic] at hz,
-  haveI := ne_zero.of_no_zero_smul_divisors K L n,
-  exact X_pow_sub_one_splits (is_root_cyclotomic_iff.1 hz),
+  exact X_pow_sub_one_splits hz,
 end
 
 /-- A cyclotomic extension splits `cyclotomic n K` if `n ∈ S` and `ne_zero (n : K)`.-/
@@ -337,30 +456,40 @@ lemma splits_cyclotomic [is_cyclotomic_extension S K L] (hS : n ∈ S) :
   splits (algebra_map K L) (cyclotomic n K) :=
 begin
   refine splits_of_splits_of_dvd _ (X_pow_sub_C_ne_zero n.pos _)
-    (splits_X_pow_sub_one n S K L hS) _,
+    (splits_X_pow_sub_one K L hS) _,
   use (∏ (i : ℕ) in (n : ℕ).proper_divisors, polynomial.cyclotomic i K),
   rw [(eq_cyclotomic_iff n.pos _).1 rfl, ring_hom.map_one],
 end
 
+variables (n S)
+
 section singleton
 
 variables [is_cyclotomic_extension {n} K L]
 
-/-- If `is_cyclotomic_extension {n} K L` and `ne_zero ((n : ℕ) : K)`, then `L` is the splitting
-field of `X ^ n - 1`. -/
+/-- If `is_cyclotomic_extension {n} K L`, then `L` is the splitting field of `X ^ n - 1`. -/
 lemma splitting_field_X_pow_sub_one : is_splitting_field K L (X ^ (n : ℕ) - 1) :=
-{ splits := splits_X_pow_sub_one n {n} K L (mem_singleton n),
-  adjoin_roots :=
+{ splits := splits_X_pow_sub_one K L (mem_singleton n),
+  adjoin_root_set :=
   begin
     rw [← ((iff_adjoin_eq_top {n} K L).1 infer_instance).2],
     congr,
     refine set.ext (λ x, _),
     simp only [polynomial.map_pow, mem_singleton_iff, multiset.mem_to_finset, exists_eq_left,
       mem_set_of_eq, polynomial.map_X, polynomial.map_one, finset.mem_coe, polynomial.map_sub],
-    rwa [← ring_hom.map_one C, mem_roots (@X_pow_sub_C_ne_zero _ _ (field.to_nontrivial L) _
-      n.pos _), is_root.def, eval_sub, eval_pow, eval_C, eval_X, sub_eq_zero]
+    simp only [mem_root_set', map_sub, map_pow, aeval_one, aeval_X, sub_eq_zero, map_X,
+               and_iff_right_iff_imp, polynomial.map_sub, polynomial.map_pow, polynomial.map_one],
+    exact λ _, X_pow_sub_C_ne_zero n.pos (1 : L)
   end }
 
+/-- Any two `n`-th cyclotomic extensions are isomorphic. -/
+def alg_equiv (L' : Type*) [field L'] [algebra K L'] [is_cyclotomic_extension {n} K L'] :
+  L ≃ₐ[K] L' :=
+let h₁ := splitting_field_X_pow_sub_one n K L in
+let h₂ := splitting_field_X_pow_sub_one n K L' in
+((@is_splitting_field.alg_equiv K L _ _ _ (X ^ (n : ℕ) - 1) h₁).trans
+  (@is_splitting_field.alg_equiv K L' _ _ _ (X ^ (n : ℕ) - 1) h₂).symm)
+
 localized "attribute [instance] is_cyclotomic_extension.splitting_field_X_pow_sub_one" in cyclotomic
 
 include n
@@ -368,24 +497,22 @@ include n
 lemma is_galois : is_galois K L :=
 begin
   letI := splitting_field_X_pow_sub_one n K L,
-  exact is_galois.of_separable_splitting_field (X_pow_sub_one_separable_iff.2
-    (ne_zero.ne _ : ((n : ℕ) : K) ≠ 0)),
+  exact is_galois.of_separable_splitting_field (X_pow_sub_one_separable_iff.2 ((ne_zero' n K L).1))
 end
 
 localized "attribute [instance] is_cyclotomic_extension.is_galois" in cyclotomic
 
-/-- If `is_cyclotomic_extension {n} K L` and `ne_zero ((n : ℕ) : K)`, then `L` is the splitting
-field of `cyclotomic n K`. -/
+/-- If `is_cyclotomic_extension {n} K L`, then `L` is the splitting field of `cyclotomic n K`. -/
 lemma splitting_field_cyclotomic : is_splitting_field K L (cyclotomic n K) :=
-{ splits := splits_cyclotomic n {n} K L (mem_singleton n),
-  adjoin_roots :=
+{ splits := splits_cyclotomic K L (mem_singleton n),
+  adjoin_root_set :=
   begin
     rw [← ((iff_adjoin_eq_top {n} K L).1 infer_instance).2],
     letI := classical.dec_eq L,
-    obtain ⟨ζ, hζ⟩ := @is_cyclotomic_extension.exists_root {n} K L _ _ _ _ _ (mem_singleton n),
-    haveI : ne_zero ((n : ℕ) : L) := ne_zero.nat_of_injective (algebra_map K L).injective,
-    rw [aeval_def, eval₂_eq_eval_map, map_cyclotomic, ← is_root.def, is_root_cyclotomic_iff] at hζ,
-    refine adjoin_roots_cyclotomic_eq_adjoin_nth_roots n hζ
+    -- todo: make `exists_prim_root` take an explicit `L`
+    obtain ⟨ζ : L, hζ⟩ := is_cyclotomic_extension.exists_prim_root K (mem_singleton n),
+    exact adjoin_roots_cyclotomic_eq_adjoin_nth_roots hζ,
+    all_goals { apply_instance }
   end }
 
 localized "attribute [instance] is_cyclotomic_extension.splitting_field_cyclotomic" in cyclotomic
@@ -406,25 +533,22 @@ def cyclotomic_field : Type w := (cyclotomic n K).splitting_field
 
 namespace cyclotomic_field
 
+instance [char_zero K] : char_zero (cyclotomic_field n K) :=
+char_zero_of_injective_algebra_map ((algebra_map K _).injective)
+
 instance is_cyclotomic_extension [ne_zero ((n : ℕ) : K)] :
   is_cyclotomic_extension {n} K (cyclotomic_field n K) :=
-{ exists_root := λ a han,
-  begin
-    rw mem_singleton_iff at han,
-    subst a,
-    exact exists_root_of_splits _ (splitting_field.splits _) (degree_cyclotomic_pos n K (n.pos)).ne'
-  end,
-  adjoin_roots :=
-  begin
-    rw [←algebra.eq_top_iff, ←splitting_field.adjoin_roots, eq_comm],
-    letI := classical.dec_eq (cyclotomic_field n K),
-    obtain ⟨ζ, hζ⟩ := exists_root_of_splits _ (splitting_field.splits (cyclotomic n K))
-      (degree_cyclotomic_pos n _ n.pos).ne',
-    haveI : ne_zero ((n : ℕ) : (cyclotomic_field n K)) :=
-      ne_zero.nat_of_injective (algebra_map K _).injective,
-    rw [eval₂_eq_eval_map, map_cyclotomic, ← is_root.def, is_root_cyclotomic_iff] at hζ,
-    exact is_cyclotomic_extension.adjoin_roots_cyclotomic_eq_adjoin_nth_roots n hζ,
-  end }
+begin
+  haveI : ne_zero ((n : ℕ) : (cyclotomic_field n K)) :=
+    ne_zero.nat_of_injective (algebra_map K _).injective,
+  letI := classical.dec_eq (cyclotomic_field n K),
+  obtain ⟨ζ, hζ⟩ := exists_root_of_splits (algebra_map K (cyclotomic_field n K))
+    (splitting_field.splits _) (degree_cyclotomic_pos n K n.pos).ne',
+  rw [← eval_map, ← is_root.def, map_cyclotomic, is_root_cyclotomic_iff] at hζ,
+  refine ⟨forall_eq.2 ⟨ζ, hζ⟩, _⟩,
+  rw [←algebra.eq_top_iff, ←splitting_field.adjoin_root_set, eq_comm],
+  exact is_cyclotomic_extension.adjoin_roots_cyclotomic_eq_adjoin_nth_roots hζ,
+end
 
 end cyclotomic_field
 
@@ -432,35 +556,48 @@ end cyclotomic_field
 
 section is_domain
 
-variables [is_domain A] [algebra A K] [is_fraction_ring A K]
+variables [algebra A K] [is_fraction_ring A K]
 
 section cyclotomic_ring
 
 /-- If `K` is the fraction field of `A`, the `A`-algebra structure on `cyclotomic_field n K`.
-This is not an instance since it causes diamonds when `A = ℤ`. -/
+-/
 @[nolint unused_arguments]
-def cyclotomic_field.algebra_base : algebra A (cyclotomic_field n K) :=
-((algebra_map K (cyclotomic_field n K)).comp (algebra_map A K)).to_algebra
+instance cyclotomic_field.algebra_base : algebra A (cyclotomic_field n K) :=
+splitting_field.algebra' (cyclotomic n K)
+
+/-- Ensure there are no diamonds when `A = ℤ`. -/
+example : algebra_int (cyclotomic_field n ℚ) = cyclotomic_field.algebra_base _ _ _ := rfl
+
+instance cyclotomic_field.algebra' {R : Type*} [comm_ring R] [algebra R K] :
+  algebra R (cyclotomic_field n K) :=
+splitting_field.algebra' (cyclotomic n K)
 
-local attribute [instance] cyclotomic_field.algebra_base
+instance {R : Type*} [comm_ring R] [algebra R K] : is_scalar_tower R K (cyclotomic_field n K) :=
+splitting_field.is_scalar_tower _
 
 instance cyclotomic_field.no_zero_smul_divisors : no_zero_smul_divisors A (cyclotomic_field n K) :=
-no_zero_smul_divisors.of_algebra_map_injective $ function.injective.comp
-(no_zero_smul_divisors.algebra_map_injective _ _) $ is_fraction_ring.injective A K
+begin
+  refine no_zero_smul_divisors.of_algebra_map_injective _,
+  rw is_scalar_tower.algebra_map_eq A K (cyclotomic_field n K),
+  exact function.injective.comp
+    (no_zero_smul_divisors.algebra_map_injective K (cyclotomic_field n K))
+    (is_fraction_ring.injective A K),
+end
 
 /-- If `A` is a domain with fraction field `K` and `n : ℕ+`, we define `cyclotomic_ring n A K` as
 the `A`-subalgebra of `cyclotomic_field n K` generated by the roots of `X ^ n - 1`. If `n`
 is nonzero in `A`, it has the instance `is_cyclotomic_extension {n} A (cyclotomic_ring n A K)`. -/
-@[derive [comm_ring, is_domain, inhabited]]
+@[derive [comm_ring, is_domain, inhabited], nolint unused_arguments]
 def cyclotomic_ring : Type w := adjoin A { b : (cyclotomic_field n K) | b ^ (n : ℕ) = 1 }
 
 namespace cyclotomic_ring
 
-/-- The `A`-algebra structure on `cyclotomic_ring n A K`.
-This is not an instance since it causes diamonds when `A = ℤ`. -/
-def algebra_base : algebra A (cyclotomic_ring n A K) := (adjoin A _).algebra
+/-- The `A`-algebra structure on `cyclotomic_ring n A K`. -/
+instance algebra_base : algebra A (cyclotomic_ring n A K) := (adjoin A _).algebra
 
-local attribute [instance] cyclotomic_ring.algebra_base
+-- Ensure that there is no diamonds with ℤ.
+example {n : ℕ+} : cyclotomic_ring.algebra_base n ℤ ℚ = algebra_int _ := rfl
 
 instance : no_zero_smul_divisors A (cyclotomic_ring n A K) := (adjoin A _).no_zero_smul_divisors_bot
 
@@ -482,22 +619,19 @@ is_scalar_tower.subalgebra' _ _ _ _
 
 instance is_cyclotomic_extension [ne_zero ((n : ℕ) : A)] :
   is_cyclotomic_extension {n} A (cyclotomic_ring n A K) :=
-{ exists_root := λ a han,
+{ exists_prim_root := λ a han,
   begin
     rw mem_singleton_iff at han,
     subst a,
     haveI := ne_zero.of_no_zero_smul_divisors A K n,
-    haveI := ne_zero.of_no_zero_smul_divisors A (cyclotomic_ring n A K) n,
     haveI := ne_zero.of_no_zero_smul_divisors A (cyclotomic_field n K) n,
-    obtain ⟨μ, hμ⟩ := let h := (cyclotomic_field.is_cyclotomic_extension n K).exists_root
-                      in h $ mem_singleton n,
+    obtain ⟨μ, hμ⟩ :=
+      (cyclotomic_field.is_cyclotomic_extension n K).exists_prim_root (mem_singleton n),
     refine ⟨⟨μ, subset_adjoin _⟩, _⟩,
     { apply (is_root_of_unity_iff n.pos (cyclotomic_field n K)).mpr,
       refine ⟨n, nat.mem_divisors_self _ n.ne_zero, _⟩,
-      rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic] at hμ },
-    simp_rw [aeval_def, eval₂_eq_eval_map,
-      map_cyclotomic, ←is_root.def, is_root_cyclotomic_iff] at hμ ⊢,
-    rwa ←is_primitive_root.map_iff_of_injective (adjoin_algebra_injective n A K)
+      rwa [← is_root_cyclotomic_iff] at hμ },
+    { rwa [← is_primitive_root.coe_submonoid_class_iff, subtype.coe_mk] }
   end,
   adjoin_roots := λ x,
   begin
@@ -510,7 +644,7 @@ instance is_cyclotomic_extension [ne_zero ((n : ℕ) : A)] :
     { exact subalgebra.mul_mem _ hy hz },
   end }
 
-instance [ne_zero ((n : ℕ) : A)] :
+instance [is_domain A] [ne_zero ((n : ℕ) : A)] :
   is_fraction_ring (cyclotomic_ring n A K) (cyclotomic_field n K) :=
 { map_units := λ ⟨x, hx⟩, begin
     rw is_unit_iff_ne_zero,
@@ -539,22 +673,21 @@ instance [ne_zero ((n : ℕ) : A)] :
       refine ⟨⟨a.1 * b.2 + b.1 * a.2, a.2 * b.2, mul_mem_non_zero_divisors.2 ⟨a.2.2, b.2.2⟩⟩, _⟩,
       rw [set_like.coe_mk, ring_hom.map_mul, add_mul, ← mul_assoc, ha,
         mul_comm ((algebra_map _ _) ↑a.2), ← mul_assoc, hb],
-      simp },
+      simp only [map_add, map_mul] },
     { rintro y z ⟨a, ha⟩ ⟨b, hb⟩,
       refine ⟨⟨a.1 * b.1, a.2 * b.2, mul_mem_non_zero_divisors.2 ⟨a.2.2, b.2.2⟩⟩, _⟩,
       rw [set_like.coe_mk, ring_hom.map_mul, mul_comm ((algebra_map _ _) ↑a.2), mul_assoc,
         ← mul_assoc z, hb, ← mul_comm ((algebra_map _ _) ↑a.2), ← mul_assoc, ha],
-      simp }
+      simp only [map_mul] }
   end,
   eq_iff_exists := λ x y, ⟨λ h, ⟨1, by rw adjoin_algebra_injective n A K h⟩,
-    λ ⟨c, hc⟩, by rw mul_right_cancel₀ (non_zero_divisors.ne_zero c.prop) hc⟩ }
+    λ ⟨c, hc⟩, by rw mul_left_cancel₀ (non_zero_divisors.ne_zero c.prop) hc⟩ }
 
 lemma eq_adjoin_primitive_root {μ : (cyclotomic_field n K)} (h : is_primitive_root μ n) :
   cyclotomic_ring n A K = adjoin A ({μ} : set ((cyclotomic_field n K))) :=
 begin
-  letI := classical.prop_decidable,
-  rw [←is_cyclotomic_extension.adjoin_roots_cyclotomic_eq_adjoin_root_cyclotomic n μ h,
-      is_cyclotomic_extension.adjoin_roots_cyclotomic_eq_adjoin_nth_roots n h],
+  rw [←is_cyclotomic_extension.adjoin_roots_cyclotomic_eq_adjoin_root_cyclotomic h,
+      is_cyclotomic_extension.adjoin_roots_cyclotomic_eq_adjoin_nth_roots h],
   simp [cyclotomic_ring]
 end
 
@@ -564,10 +697,24 @@ end cyclotomic_ring
 
 end is_domain
 
-/-- Algebraically closed fields are cyclotomic extensions over themselves. -/
-lemma is_alg_closed.is_cyclotomic_extension (K) [field K] [is_alg_closed K] (S) :
+section is_alg_closed
+
+variables [is_alg_closed K]
+
+/-- Algebraically closed fields are `S`-cyclotomic extensions over themselves if
+`ne_zero ((a : ℕ) : K))` for all `a ∈ S`. -/
+lemma is_alg_closed.is_cyclotomic_extension (h : ∀ a ∈ S, ne_zero ((a : ℕ) : K)) :
   is_cyclotomic_extension S K K :=
-⟨λ a _, is_alg_closed.exists_aeval_eq_zero _ _ (degree_cyclotomic_pos _ _ a.pos).ne',
- algebra.eq_top_iff.mp $ subsingleton.elim _ _ ⟩
+begin
+  refine ⟨λ a ha, _,  algebra.eq_top_iff.mp $ subsingleton.elim _ _ ⟩,
+  obtain ⟨r, hr⟩ := is_alg_closed.exists_aeval_eq_zero K _ (degree_cyclotomic_pos a K a.pos).ne',
+  refine ⟨r, _⟩,
+  haveI := h a ha,
+  rwa [coe_aeval_eq_eval, ← is_root.def, is_root_cyclotomic_iff] at hr,
+end
+
+instance is_alg_closed_of_char_zero.is_cyclotomic_extension [char_zero K] :
+  ∀ S, is_cyclotomic_extension S K K :=
+λ S, is_alg_closed.is_cyclotomic_extension S K (λ a ha, infer_instance)
 
-instance : ∀ S, is_cyclotomic_extension S ℂ ℂ := is_alg_closed.is_cyclotomic_extension ℂ
+end is_alg_closed
diff --git a/src/number_theory/cyclotomic/discriminant.lean b/src/number_theory/cyclotomic/discriminant.lean
index ef6c2e982b731..1875990e97556 100644
--- a/src/number_theory/cyclotomic/discriminant.lean
+++ b/src/number_theory/cyclotomic/discriminant.lean
@@ -9,6 +9,9 @@ import ring_theory.discriminant
 
 /-!
 # Discriminant of cyclotomic fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 We compute the discriminant of a `p ^ n`-th cyclotomic extension.
 
 ## Main results
@@ -35,17 +38,18 @@ discriminant of the power basis given by `ζ - 1`. -/
 lemma discr_zeta_eq_discr_zeta_sub_one (hζ : is_primitive_root ζ n) :
   discr ℚ (hζ.power_basis ℚ).basis = discr ℚ (hζ.sub_one_power_basis ℚ).basis :=
 begin
+  haveI : number_field K := number_field.mk,
   have H₁ : (aeval (hζ.power_basis ℚ).gen) (X - 1 : ℤ[X]) = (hζ.sub_one_power_basis ℚ).gen :=
     by simp,
   have H₂ : (aeval (hζ.sub_one_power_basis ℚ).gen) (X + 1 : ℤ[X]) = (hζ.power_basis ℚ).gen :=
     by simp,
   refine discr_eq_discr_of_to_matrix_coeff_is_integral _
-    (λ i j, to_matrix_is_integral H₁ _  _ _ _)
-    (λ i j, to_matrix_is_integral H₂ _  _ _ _),
+    (λ i j, to_matrix_is_integral H₁ _ _ _ _)
+    (λ i j, to_matrix_is_integral H₂ _ _ _ _),
   { exact hζ.is_integral n.pos },
-  { refine minpoly.gcd_domain_eq_field_fractions _ (hζ.is_integral n.pos) },
+  { refine minpoly.is_integrally_closed_eq_field_fractions' _ (hζ.is_integral n.pos) },
   { exact is_integral_sub (hζ.is_integral n.pos) is_integral_one },
-  { refine minpoly.gcd_domain_eq_field_fractions _ _,
+  { refine minpoly.is_integrally_closed_eq_field_fractions' _ _,
     exact is_integral_sub (hζ.is_integral n.pos) is_integral_one }
 end
 
@@ -60,85 +64,70 @@ variables [algebra K L]
 `hζ.power_basis K` is `(-1) ^ ((p ^ (k + 1).totient) / 2) * p ^ (p ^ k * ((p - 1) * (k + 1) - 1))`
 if `irreducible (cyclotomic (p ^ (k + 1)) K))`, and `p ^ (k + 1) ≠ 2`. -/
 lemma discr_prime_pow_ne_two [is_cyclotomic_extension {p ^ (k + 1)} K L] [hp : fact (p : ℕ).prime]
-  [ne_zero ((p : ℕ) : K)] (hζ : is_primitive_root ζ ↑(p ^ (k + 1)))
-  (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K))
+  (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K))
   (hk : p ^ (k + 1) ≠ 2) :
   discr K (hζ.power_basis K).basis =
   (-1) ^ (((p ^ (k + 1) : ℕ).totient) / 2) * p ^ ((p : ℕ) ^ k * ((p - 1) * (k + 1) - 1)) :=
 begin
-  haveI : ne_zero ((↑(p ^ (k + 1)) : ℕ) : K),
-  { refine ⟨λ hzero, _⟩,
-    rw [pnat.pow_coe] at hzero,
-    simpa [ne_zero.ne ((p : ℕ) : K)] using hzero },
-  have hp2 : p = 2 → 1 ≤ k,
-  { intro hp,
-    refine one_le_iff_ne_zero.2 (λ h, _),
-    rw [h, hp, zero_add, pow_one] at hk,
-    exact hk rfl },
-
-  rw [discr_power_basis_eq_norm, finrank _ hirr, hζ.power_basis_gen _,
-    ← hζ.minpoly_eq_cyclotomic_of_irreducible hirr, pnat.pow_coe, totient_prime_pow hp.out
-    (succ_pos k)],
+  haveI hne := is_cyclotomic_extension.ne_zero' (p ^ (k + 1)) K L,
+  rw [discr_power_basis_eq_norm, finrank L hirr, hζ.power_basis_gen _,
+    ← hζ.minpoly_eq_cyclotomic_of_irreducible hirr, pnat.pow_coe,
+    totient_prime_pow hp.out (succ_pos k), succ_sub_one],
+  have hp2 : p = 2 → k ≠ 0,
+  { unfreezingI { rintro rfl rfl },
+    exact absurd rfl hk },
   congr' 1,
-  { by_cases hptwo : p = 2,
-    { obtain ⟨k₁, hk₁⟩ := nat.exists_eq_succ_of_ne_zero (one_le_iff_ne_zero.1 (hp2 hptwo)),
-      rw [hk₁, succ_sub_one, hptwo, pnat.coe_bit0, pnat.one_coe, succ_sub_succ_eq_sub, tsub_zero,
+  { unfreezingI { rcases eq_or_ne p 2 with rfl | hp2 },
+    { unfreezingI { rcases nat.exists_eq_succ_of_ne_zero (hp2 rfl) with ⟨k, rfl⟩ },
+      rw [pnat.coe_bit0, pnat.one_coe, succ_sub_succ_eq_sub, tsub_zero,
         mul_one, pow_succ, mul_assoc, nat.mul_div_cancel_left _ zero_lt_two,
         nat.mul_div_cancel_left _ zero_lt_two],
-      by_cases hk₁zero : k₁ = 0,
-      { simp [hk₁zero] },
-      obtain ⟨k₂, rfl⟩ := nat.exists_eq_succ_of_ne_zero hk₁zero,
-      rw [pow_succ, mul_assoc, pow_mul (-1 : K), pow_mul (-1 : K), neg_one_sq, one_pow, one_pow] },
-    { simp only [succ_sub_succ_eq_sub, tsub_zero],
-      replace hptwo : ↑p ≠ 2,
-      { intro h,
-        rw [← pnat.one_coe, ← pnat.coe_bit0, pnat.coe_inj] at h,
-        exact hptwo h },
-      obtain ⟨a, ha⟩ := even_sub_one_of_prime_ne_two hp.out hptwo,
-      rw [mul_comm ((p : ℕ) ^ k), mul_assoc, ha],
-      nth_rewrite 0 [← mul_one a],
-      nth_rewrite 4 [← mul_one a],
-      rw [← nat.mul_succ, mul_comm a, mul_assoc, mul_assoc 2, nat.mul_div_cancel_left _
-        zero_lt_two, nat.mul_div_cancel_left _ zero_lt_two, ← mul_assoc, mul_comm
-        (a * (p : ℕ) ^ k), pow_mul, ← ha],
-      congr' 1,
-      refine odd.neg_one_pow (nat.even.sub_odd (nat.succ_le_iff.2 (mul_pos (tsub_pos_iff_lt.2
-        hp.out.one_lt) (pow_pos hp.out.pos _))) (even.mul_right (nat.even_sub_one_of_prime_ne_two
-        hp.out hptwo) _) odd_one) } },
+      unfreezingI { cases k },
+      { simp },
+      { rw [pow_succ, (even_two.mul_right _).neg_one_pow,
+          ((even_two.mul_right _).mul_right _).neg_one_pow] } },
+    { replace hp2 : (p : ℕ) ≠ 2,
+      { rwa [ne.def, ← pnat.one_coe, ← pnat.coe_bit0, pnat.coe_inj] },
+      have hpo : odd (p : ℕ) := hp.out.odd_of_ne_two hp2,
+      obtain ⟨a, ha⟩ := (hp.out.even_sub_one hp2).two_dvd,
+      rw [ha, mul_left_comm, mul_assoc, nat.mul_div_cancel_left _ two_pos,
+        nat.mul_div_cancel_left _ two_pos, mul_right_comm, pow_mul, (hpo.pow.mul _).neg_one_pow,
+        pow_mul, hpo.pow.neg_one_pow],
+      refine nat.even.sub_odd _ (even_two_mul _) odd_one,
+      rw [mul_left_comm, ← ha],
+      exact one_le_mul (one_le_pow _ _ hp.1.pos) (succ_le_iff.2 $ tsub_pos_of_lt hp.1.one_lt) } },
   { have H := congr_arg derivative (cyclotomic_prime_pow_mul_X_pow_sub_one K p k),
-    rw [derivative_mul, derivative_sub, derivative_one, sub_zero, derivative_pow,
-      derivative_X, mul_one, derivative_sub, derivative_one, sub_zero, derivative_pow,
-      derivative_X, mul_one, ← pnat.pow_coe, hζ.minpoly_eq_cyclotomic_of_irreducible hirr] at H,
+    rw [derivative_mul, derivative_sub, derivative_one, sub_zero, derivative_X_pow, C_eq_nat_cast,
+      derivative_sub, derivative_one, sub_zero, derivative_X_pow, C_eq_nat_cast, ← pnat.pow_coe,
+      hζ.minpoly_eq_cyclotomic_of_irreducible hirr] at H,
     replace H := congr_arg (λ P, aeval ζ P) H,
     simp only [aeval_add, aeval_mul, minpoly.aeval, zero_mul, add_zero, aeval_nat_cast,
       _root_.map_sub, aeval_one, aeval_X_pow] at H,
     replace H := congr_arg (algebra.norm K) H,
     have hnorm : (norm K) (ζ ^ (p : ℕ) ^ k - 1) = p ^ ((p : ℕ) ^ k),
     { by_cases hp : p = 2,
-      { exact hζ.pow_sub_one_norm_prime_pow_of_one_le hirr rfl.le (hp2 hp) },
-      { exact hζ.pow_sub_one_norm_prime_ne_two hirr rfl.le hp } },
+      { exact hζ.pow_sub_one_norm_prime_pow_of_ne_zero hirr le_rfl (hp2 hp) },
+      { exact hζ.pow_sub_one_norm_prime_ne_two hirr le_rfl hp } },
     rw [monoid_hom.map_mul, hnorm, monoid_hom.map_mul, ← map_nat_cast (algebra_map K L),
-      algebra.norm_algebra_map, finrank _ hirr, pnat.pow_coe, totient_prime_pow hp.out (succ_pos k),
+      algebra.norm_algebra_map, finrank L hirr, pnat.pow_coe, totient_prime_pow hp.out (succ_pos k),
       nat.sub_one, nat.pred_succ, ← hζ.minpoly_eq_cyclotomic_of_irreducible hirr, map_pow,
       hζ.norm_eq_one hk hirr, one_pow, mul_one, cast_pow, ← coe_coe, ← pow_mul, ← mul_assoc,
       mul_comm (k + 1), mul_assoc] at H,
-    { have := mul_pos (succ_pos k) (tsub_pos_iff_lt.2 hp.out.one_lt),
+    { have := mul_pos (succ_pos k) (tsub_pos_of_lt hp.out.one_lt),
       rw [← succ_pred_eq_of_pos this, mul_succ, pow_add _ _ ((p : ℕ) ^ k)] at H,
       replace H := (mul_left_inj' (λ h, _)).1 H,
       { simpa only [← pnat.pow_coe, H, mul_comm _ (k + 1)] },
       { replace h := pow_eq_zero h,
         rw [coe_coe] at h,
-        exact ne_zero.ne _ h } },
-    { apply_instance } },
-  { apply_instance }
+        simpa using hne.1 } } }
 end
 
 /-- If `p` is a prime and `is_cyclotomic_extension {p ^ (k + 1)} K L`, then the discriminant of
 `hζ.power_basis K` is `(-1) ^ (p ^ k * (p - 1) / 2) * p ^ (p ^ k * ((p - 1) * (k + 1) - 1))`
 if `irreducible (cyclotomic (p ^ (k + 1)) K))`, and `p ^ (k + 1) ≠ 2`. -/
 lemma discr_prime_pow_ne_two' [is_cyclotomic_extension {p ^ (k + 1)} K L] [hp : fact (p : ℕ).prime]
-  [ne_zero ((p : ℕ) : K)] (hζ : is_primitive_root ζ ↑(p ^ (k + 1)))
-  (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (hk : p ^ (k + 1) ≠ 2) :
+  (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K))
+  (hk : p ^ (k + 1) ≠ 2) :
   discr K (hζ.power_basis K).basis =
   (-1) ^ (((p : ℕ) ^ k  * (p - 1)) / 2) * p ^ ((p : ℕ) ^ k * ((p - 1) * (k + 1) - 1)) :=
 by simpa [totient_prime_pow hp.out (succ_pos k)] using discr_prime_pow_ne_two hζ hirr hk
@@ -149,14 +138,12 @@ if `irreducible (cyclotomic (p ^ k) K))`. Beware that in the cases `p ^ k = 1` a
 the formula uses `1 / 2 = 0` and `0 - 1 = 0`. It is useful only to have a uniform result.
 See also `is_cyclotomic_extension.discr_prime_pow_eq_unit_mul_pow`. -/
 lemma discr_prime_pow [hcycl : is_cyclotomic_extension {p ^ k} K L] [hp : fact (p : ℕ).prime]
-  [ne_zero ((p : ℕ) : K)] (hζ : is_primitive_root ζ ↑(p ^ k))
-  (hirr : irreducible (cyclotomic (↑(p ^ k) : ℕ) K)) :
+  (hζ : is_primitive_root ζ ↑(p ^ k)) (hirr : irreducible (cyclotomic (↑(p ^ k) : ℕ) K)) :
   discr K (hζ.power_basis K).basis =
   (-1) ^ (((p ^ k : ℕ).totient) / 2) * p ^ ((p : ℕ) ^ (k - 1) * ((p - 1) * k - 1)) :=
 begin
   unfreezingI { cases k },
-  { haveI : ne_zero ((↑(p ^ 0) : ℕ) : K) := ⟨by simp⟩,
-    simp only [coe_basis, pow_zero, power_basis_gen, totient_one, mul_zero, mul_one, show 1 / 2 = 0,
+  { simp only [coe_basis, pow_zero, power_basis_gen, totient_one, mul_zero, mul_one, show 1 / 2 = 0,
       by refl, discr, trace_matrix],
     have hζone : ζ = 1 := by simpa using hζ,
     rw [hζ.power_basis_dim _, hζone, ← (algebra_map K L).map_one,
@@ -164,13 +151,10 @@ begin
     simp only [trace_matrix, map_one, one_pow, matrix.det_unique, trace_form_apply, mul_one],
     rw [← (algebra_map K L).map_one, trace_algebra_map, finrank _ hirr],
     { simp },
-    { simpa using hcycl } },
+    { apply_instance },
+    { exact hcycl } },
   { by_cases hk : p ^ (k + 1) = 2,
-    { haveI : ne_zero ((↑(p ^ (k + 1)) : ℕ) : K),
-      { refine ⟨λ hzero, _⟩,
-        rw [pnat.pow_coe] at hzero,
-        simpa [ne_zero.ne ((p : ℕ) : K)] using hzero },
-      have hp : p = 2,
+    { have hp : p = 2,
       { rw [← pnat.coe_inj, pnat.coe_bit0, pnat.one_coe, pnat.pow_coe, ← pow_one 2] at hk,
       replace hk := eq_of_prime_pow_eq (prime_iff.1 hp.out) (prime_iff.1 nat.prime_two)
         (succ_pos _) hk,
@@ -185,11 +169,12 @@ begin
       rw [power_basis_dim, hζ.eq_neg_one_of_two_right, show (-1 : L) = algebra_map K L (-1),
         by simp, minpoly.eq_X_sub_C_of_algebra_map_inj _ (algebra_map K L).injective,
         nat_degree_X_sub_C],
-      simp only [discr, trace_matrix, matrix.det_unique, fin.default_eq_zero, fin.coe_zero,
+      simp only [discr, trace_matrix_apply, matrix.det_unique, fin.default_eq_zero, fin.coe_zero,
         pow_zero, trace_form_apply, mul_one],
       rw [← (algebra_map K L).map_one, trace_algebra_map, finrank _ hirr, hp, hk],
       { simp },
-      { apply_instance } },
+      { apply_instance },
+      { exact hcycl } },
     { exact discr_prime_pow_ne_two hζ hirr hk } }
 end
 
@@ -197,7 +182,7 @@ end
 `n : ℕ` such that the discriminant of `hζ.power_basis K` is `u * p ^ n`. Often this is enough and
 less cumbersome to use than `is_cyclotomic_extension.discr_prime_pow`. -/
 lemma discr_prime_pow_eq_unit_mul_pow [is_cyclotomic_extension {p ^ k} K L]
-  [hp : fact (p : ℕ).prime] [ne_zero ((p : ℕ) : K)] (hζ : is_primitive_root ζ ↑(p ^ k))
+  [hp : fact (p : ℕ).prime] (hζ : is_primitive_root ζ ↑(p ^ k))
   (hirr : irreducible (cyclotomic (↑(p ^ k) : ℕ) K)) :
   ∃ (u : ℤˣ) (n : ℕ), discr K (hζ.power_basis K).basis = u * p ^ n :=
 begin
@@ -212,8 +197,7 @@ end
 `discr K (hζ.power_basis K).basis = (-1) ^ ((p - 1) / 2) * p ^ (p - 2)` if
 `irreducible (cyclotomic p K)`. -/
 lemma discr_odd_prime [is_cyclotomic_extension {p} K L] [hp : fact (p : ℕ).prime]
-  [ne_zero ((p : ℕ) : K)] (hζ : is_primitive_root ζ p) (hirr : irreducible (cyclotomic p K))
-  (hodd : p ≠ 2) :
+  (hζ : is_primitive_root ζ p) (hirr : irreducible (cyclotomic p K)) (hodd : p ≠ 2) :
   discr K (hζ.power_basis K).basis = (-1) ^ (((p : ℕ) - 1) / 2) * p ^ ((p : ℕ) - 2) :=
 begin
   haveI : is_cyclotomic_extension {p ^ (0 + 1)} K L,
diff --git a/src/number_theory/cyclotomic/gal.lean b/src/number_theory/cyclotomic/gal.lean
index 7b4245028d376..168f3db2ae45e 100644
--- a/src/number_theory/cyclotomic/gal.lean
+++ b/src/number_theory/cyclotomic/gal.lean
@@ -10,18 +10,20 @@ import field_theory.polynomial_galois_group
 /-!
 # Galois group of cyclotomic extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we show the relationship between the Galois group of `K(ζₙ)` and `(zmod n)ˣ`;
 it is always a subgroup, and if the `n`th cyclotomic polynomial is irreducible, they are isomorphic.
 
 ## Main results
 
 * `is_primitive_root.aut_to_pow_injective`: `is_primitive_root.aut_to_pow` is injective
-  in the case that it's considered over a cyclotomic field extension, where `n` does not divide
-  the characteristic of K.
-* `is_cyclotomic_extension.aut_equiv_pow`: If, additionally, the `n`th cyclotomic polynomial is
-  irreducible in K, then `aut_to_pow` is a `mul_equiv` (for example, in ℚ and certain 𝔽ₚ).
-* `gal_X_pow_equiv_units_zmod`, `gal_cyclotomic_equiv_units_zmod`: Repackage `aut_equiv_pow` in
-  terms of `polynomial.gal`.
+  in the case that it's considered over a cyclotomic field extension.
+* `is_cyclotomic_extension.aut_equiv_pow`: If the `n`th cyclotomic polynomial is irreducible in `K`,
+  then `is_primitive_root.aut_to_pow` is a `mul_equiv` (for example, in `ℚ` and certain `𝔽ₚ`).
+* `gal_X_pow_equiv_units_zmod`, `gal_cyclotomic_equiv_units_zmod`: Repackage
+  `is_cyclotomic_extension.aut_equiv_pow` in terms of `polynomial.gal`.
 * `is_cyclotomic_extension.aut.comm_group`: Cyclotomic extensions are abelian.
 
 ## References
@@ -38,19 +40,19 @@ it is always a subgroup, and if the `n`th cyclotomic polynomial is irreducible,
 
 -/
 
-local attribute [instance] pnat.fact_pos
-
-variables {n : ℕ+} (K : Type*) [field K] {L : Type*} [field L] {μ : L} (hμ : is_primitive_root μ n)
-          [algebra K L] [is_cyclotomic_extension {n} K L]
+variables {n : ℕ+} (K : Type*) [field K] {L : Type*} {μ : L}
 
-open polynomial ne_zero is_cyclotomic_extension
+open polynomial is_cyclotomic_extension
 
 open_locale cyclotomic
 
 namespace is_primitive_root
 
+variables [comm_ring L] [is_domain L] (hμ : is_primitive_root μ n) [algebra K L]
+          [is_cyclotomic_extension {n} K L]
+
 /-- `is_primitive_root.aut_to_pow` is injective in the case that it's considered over a cyclotomic
-field extension, where `n` does not divide the characteristic of K. -/
+field extension. -/
 lemma aut_to_pow_injective : function.injective $ hμ.aut_to_pow K :=
 begin
   intros f g hfg,
@@ -79,10 +81,12 @@ end is_primitive_root
 
 namespace is_cyclotomic_extension
 
+variables [comm_ring L] [is_domain L] (hμ : is_primitive_root μ n) [algebra K L]
+          [is_cyclotomic_extension {n} K L]
+
 /-- Cyclotomic extensions are abelian. -/
-noncomputable def aut.comm_group [ne_zero ((n : ℕ) : K)] : comm_group (L ≃ₐ[K] L) :=
-let _ := of_no_zero_smul_divisors K L n in by exactI
-((zeta_primitive_root n K L).aut_to_pow_injective K).comm_group _
+noncomputable def aut.comm_group : comm_group (L ≃ₐ[K] L) :=
+((zeta_spec n K L).aut_to_pow_injective K).comm_group _
   (map_one _) (map_mul _) (map_inv _) (map_div _) (map_pow _) (map_zpow _)
 
 variables (h : irreducible (cyclotomic n K)) {K} (L)
@@ -90,18 +94,17 @@ variables (h : irreducible (cyclotomic n K)) {K} (L)
 include h
 
 /-- The `mul_equiv` that takes an automorphism `f` to the element `k : (zmod n)ˣ` such that
-  `f μ = μ ^ k`. A stronger version of `is_primitive_root.aut_to_pow`. -/
-@[simps] noncomputable def aut_equiv_pow [ne_zero ((n : ℕ) : K)] : (L ≃ₐ[K] L) ≃* (zmod n)ˣ :=
-let hn := of_no_zero_smul_divisors K L n in
-by exactI
-let hζ := zeta_primitive_root n K L,
+  `f μ = μ ^ k` for any root of unity `μ`. A  strengthening of `is_primitive_root.aut_to_pow`. -/
+@[simps] noncomputable def aut_equiv_pow : (L ≃ₐ[K] L) ≃* (zmod n)ˣ :=
+let hζ := zeta_spec n K L,
     hμ := λ t, hζ.pow_of_coprime _ (zmod.val_coe_unit_coprime t) in
 { inv_fun := λ t, (hζ.power_basis K).equiv_of_minpoly ((hμ t).power_basis K)
   begin
+    haveI := is_cyclotomic_extension.ne_zero' n K L,
     simp only [is_primitive_root.power_basis_gen],
     have hr := is_primitive_root.minpoly_eq_cyclotomic_of_irreducible
-               ((zeta_primitive_root n K L).pow_of_coprime _ (zmod.val_coe_unit_coprime t)) h,
-    exact ((zeta_primitive_root n K L).minpoly_eq_cyclotomic_of_irreducible h).symm.trans hr
+               ((zeta_spec n K L).pow_of_coprime _ (zmod.val_coe_unit_coprime t)) h,
+    exact ((zeta_spec n K L).minpoly_eq_cyclotomic_of_irreducible h).symm.trans hr
   end,
   left_inv := λ f, begin
     simp only [monoid_hom.to_fun_eq_coe],
@@ -113,9 +116,8 @@ let hζ := zeta_primitive_root n K L,
   end,
   right_inv := λ x, begin
     simp only [monoid_hom.to_fun_eq_coe],
-    generalize_proofs _ _ _ h,
-    have key := hζ.aut_to_pow_spec K ((hζ.power_basis K).equiv_of_minpoly
-                                      ((hμ x).power_basis K) h),
+    generalize_proofs _ h,
+    have key := hζ.aut_to_pow_spec K ((hζ.power_basis K).equiv_of_minpoly ((hμ x).power_basis K) h),
     have := (hζ.power_basis K).equiv_of_minpoly_gen ((hμ x).power_basis K) h,
     rw hζ.power_basis_gen K at this,
     rw [this, is_primitive_root.power_basis_gen] at key,
@@ -123,27 +125,26 @@ let hζ := zeta_primitive_root n K L,
     simp only [←coe_coe, ←roots_of_unity.coe_pow] at key,
     replace key := roots_of_unity.coe_injective key,
     rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hζ.coe_to_roots_of_unity_coe,
-        ←(zeta_primitive_root n K L).eq_order_of, ←zmod.eq_iff_modeq_nat] at key,
+        ←(zeta_spec n K L).eq_order_of, ←zmod.eq_iff_modeq_nat] at key,
     simp only [zmod.nat_cast_val, zmod.cast_id', id.def] at key,
     exact units.ext key
   end,
-  .. (zeta_primitive_root n K L).aut_to_pow K }
+  .. (zeta_spec n K L).aut_to_pow K }
 
 include hμ
 
 variables {L}
 
 /-- Maps `μ` to the `alg_equiv` that sends `is_cyclotomic_extension.zeta` to `μ`. -/
-noncomputable def from_zeta_aut [ne_zero ((n : ℕ) : K)] : L ≃ₐ[K] L :=
-have _ := of_no_zero_smul_divisors K L n, by exactI
-let hζ := (zeta_primitive_root n K L).eq_pow_of_pow_eq_one hμ.pow_eq_one n.pos in
+noncomputable def from_zeta_aut : L ≃ₐ[K] L :=
+let hζ := (zeta_spec n K L).eq_pow_of_pow_eq_one hμ.pow_eq_one n.pos in
 (aut_equiv_pow L h).symm $ zmod.unit_of_coprime hζ.some $
-((zeta_primitive_root n K L).pow_iff_coprime n.pos hζ.some).mp $ hζ.some_spec.some_spec.symm ▸ hμ
+((zeta_spec n K L).pow_iff_coprime n.pos hζ.some).mp $ hζ.some_spec.some_spec.symm ▸ hμ
 
-lemma from_zeta_aut_spec [ne_zero ((n : ℕ) : K)] : from_zeta_aut hμ h (zeta n K L) = μ :=
+lemma from_zeta_aut_spec : from_zeta_aut hμ h (zeta n K L) = μ :=
 begin
   simp_rw [from_zeta_aut, aut_equiv_pow_symm_apply],
-  generalize_proofs _ hζ h _ hμ _,
+  generalize_proofs hζ h _ hμ _,
   rw [←hζ.power_basis_gen K] {occs := occurrences.pos [4]},
   rw [power_basis.equiv_of_minpoly_gen, hμ.power_basis_gen K],
   convert h.some_spec.some_spec,
@@ -154,22 +155,25 @@ end is_cyclotomic_extension
 
 section gal
 
-variables (h : irreducible (cyclotomic n K)) {K}
+variables [field L] (hμ : is_primitive_root μ n) [algebra K L]
+          [is_cyclotomic_extension {n} K L] (h : irreducible (cyclotomic n K)) {K}
 
-/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`. Asserts that the
-Galois group of `cyclotomic n K` is equivalent to `(zmod n)ˣ` if `n` does not divide the
-characteristic of `K`, and `cyclotomic n K` is irreducible in the base field. -/
-noncomputable def gal_cyclotomic_equiv_units_zmod [ne_zero ((n : ℕ) : K)] :
+/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`.
+Asserts that the Galois group of `cyclotomic n K` is equivalent to `(zmod n)ˣ`
+if `cyclotomic n K` is irreducible in the base field. -/
+noncomputable def gal_cyclotomic_equiv_units_zmod :
   (cyclotomic n K).gal ≃* (zmod n)ˣ :=
-(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
-(is_cyclotomic_extension.aut_equiv_pow L h)
-
-/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`. Asserts that the
-Galois group of `X ^ n - 1` is equivalent to `(zmod n)ˣ` if `n` does not divide the characteristic
-of `K`, and `cyclotomic n K` is irreducible in the base field. -/
-noncomputable def gal_X_pow_equiv_units_zmod [ne_zero ((n : ℕ) : K)] :
+(alg_equiv.aut_congr
+  ((is_splitting_field.alg_equiv L _) : L ≃ₐ[K] (cyclotomic n K).splitting_field)).symm.trans
+    (is_cyclotomic_extension.aut_equiv_pow L h)
+
+/-- `is_cyclotomic_extension.aut_equiv_pow` repackaged in terms of `gal`.
+Asserts that the Galois group of `X ^ n - 1` is equivalent to `(zmod n)ˣ`
+if `cyclotomic n K` is irreducible in the base field. -/
+noncomputable def gal_X_pow_equiv_units_zmod :
   (X ^ (n : ℕ) - 1).gal ≃* (zmod n)ˣ :=
-(alg_equiv.aut_congr (is_splitting_field.alg_equiv _ _)).symm.trans
-(is_cyclotomic_extension.aut_equiv_pow L h)
+(alg_equiv.aut_congr
+  ((is_splitting_field.alg_equiv L _) : L ≃ₐ[K] (X ^ (n : ℕ) - 1).splitting_field)).symm.trans
+    (is_cyclotomic_extension.aut_equiv_pow L h)
 
 end gal
diff --git a/src/number_theory/cyclotomic/primitive_roots.lean b/src/number_theory/cyclotomic/primitive_roots.lean
index a5db1f513fb72..af57304165afc 100644
--- a/src/number_theory/cyclotomic/primitive_roots.lean
+++ b/src/number_theory/cyclotomic/primitive_roots.lean
@@ -10,33 +10,36 @@ import number_theory.cyclotomic.basic
 import ring_theory.adjoin.power_basis
 import ring_theory.polynomial.cyclotomic.eval
 import ring_theory.norm
+import ring_theory.polynomial.cyclotomic.expand
 
 /-!
 # Primitive roots in cyclotomic fields
-If `is_cyclotomic_extension {n} A B`, we define an element `zeta n A B : B` that is (under certain
-assumptions) a primitive `n`-root of unity in `B` and we study its properties. We also prove related
-theorems under the more general assumption of just being a primitive root, for reasons described
-in the implementation details section.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+If `is_cyclotomic_extension {n} A B`, we define an element `zeta n A B : B` that is a primitive
+`n`th-root of unity in `B` and we study its properties. We also prove related theorems under the
+more general assumption of just being a primitive root, for reasons described in the implementation
+details section.
 
 ## Main definitions
 * `is_cyclotomic_extension.zeta n A B`: if `is_cyclotomic_extension {n} A B`, than `zeta n A B`
-  is an element of `B` that plays the role of a primitive `n`-th root of unity.
+  is a primitive `n`-th root of unity in `B`.
 * `is_primitive_root.power_basis`: if `K` and `L` are fields such that
-  `is_cyclotomic_extension {n} K L` and `ne_zero (↑n : K)`, then `is_primitive_root.power_basis`
+  `is_cyclotomic_extension {n} K L`, then `is_primitive_root.power_basis`
   gives a K-power basis for L given a primitive root `ζ`.
 * `is_primitive_root.embeddings_equiv_primitive_roots`: the equivalence between `L →ₐ[K] A`
   and `primitive_roots n A` given by the choice of `ζ`.
 
 ## Main results
-* `is_cyclotomic_extension.zeta_primitive_root`: if `is_domain B` and `ne_zero (↑n : B)`, then
-  `zeta n A B` is a primitive `n`-th root of unity.
+* `is_cyclotomic_extension.zeta_spec`: `zeta n A B` is a primitive `n`-th root of unity.
 * `is_cyclotomic_extension.finrank`: if `irreducible (cyclotomic n K)` (in particular for
   `K = ℚ`), then the `finrank` of a cyclotomic extension is `n.totient`.
 * `is_primitive_root.norm_eq_one`: if `irreducible (cyclotomic n K)` (in particular for `K = ℚ`),
   the norm of a primitive root is `1` if `n ≠ 2`.
 * `is_primitive_root.sub_one_norm_eq_eval_cyclotomic`: if `irreducible (cyclotomic n K)`
   (in particular for `K = ℚ`), then the norm of `ζ - 1` is `eval 1 (cyclotomic n ℤ)`, for a
-  primitive root ζ. We also prove the analogous of this result for `zeta`.
+  primitive root `ζ`. We also prove the analogous of this result for `zeta`.
 * `is_primitive_root.pow_sub_one_norm_prime_pow_ne_two` : if
   `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
   then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` `p ^ (k - s + 1) ≠ 2`. See the following
@@ -48,9 +51,9 @@ in the implementation details section.
   and `primitive_roots n A` given by the choice of `ζ`.
 
 ## Implementation details
-`zeta n A B` is defined as any root of `cyclotomic n A` in `B`, that exists because of
-`is_cyclotomic_extension {n} A B`. It is not true in general that it is a primitive `n`-th root of
-unity, but this holds if `is_domain B` and `ne_zero (↑n : B)`.
+`zeta n A B` is defined as any primitive root of unity in `B`, - this must exist, by definition of
+`is_cyclotomic_extension`. It is not true in general that it is a root of `cyclotomic n B`,
+but this holds if `is_domain B` and `ne_zero (↑n : B)`.
 
 `zeta n A B` is defined using `exists.some`, which means we cannot control it.
 For example, in normal mathematics, we can demand that `(zeta p ℤ ℤ[ζₚ] : ℚ(ζₚ))` is equal to
@@ -63,7 +66,6 @@ and only at the "final step", when we need to provide an "explicit" primitive ro
 
 open polynomial algebra finset finite_dimensional is_cyclotomic_extension nat pnat set
 
-
 universes u v w z
 
 variables {p n : ℕ+} (A : Type w) (B : Type z) (K : Type u) {L : Type v} (C : Type w)
@@ -75,25 +77,28 @@ namespace is_cyclotomic_extension
 
 variables (n)
 
-/-- If `B` is a `n`-th cyclotomic extension of `A`, then `zeta n A B` is any root of
-`cyclotomic n A` in L. -/
+/-- If `B` is a `n`-th cyclotomic extension of `A`, then `zeta n A B` is a primitive root of
+unity in `B`. -/
 noncomputable def zeta : B :=
-  (exists_root $ set.mem_singleton n : ∃ r : B, aeval r (cyclotomic n A) = 0).some
+(exists_prim_root A $ set.mem_singleton n : ∃ r : B, is_primitive_root r n).some
 
-@[simp] lemma zeta_spec : aeval (zeta n A B) (cyclotomic n A) = 0 :=
-classical.some_spec (exists_root (set.mem_singleton n) : ∃ r : B, aeval r (cyclotomic n A) = 0)
+/-- `zeta n A B` is a primitive `n`-th root of unity. -/
+@[simp] lemma zeta_spec : is_primitive_root (zeta n A B) n :=
+classical.some_spec (exists_prim_root A (set.mem_singleton n) : ∃ r : B, is_primitive_root r n)
 
-lemma zeta_spec' : is_root (cyclotomic n B) (zeta n A B) :=
-by { convert zeta_spec n A B, rw [is_root.def, aeval_def, eval₂_eq_eval_map, map_cyclotomic] }
+lemma aeval_zeta [is_domain B] [ne_zero ((n : ℕ) : B)] :
+  aeval (zeta n A B) (cyclotomic n A) = 0 :=
+begin
+  rw [aeval_def,  ← eval_map, ← is_root.def, map_cyclotomic, is_root_cyclotomic_iff],
+  exact zeta_spec n A B
+end
 
-lemma zeta_pow : (zeta n A B) ^ (n : ℕ) = 1 :=
-is_root_of_unity_of_root_cyclotomic (nat.mem_divisors_self _ n.pos.ne') (zeta_spec' _ _ _)
+lemma zeta_is_root [is_domain B] [ne_zero ((n : ℕ) : B)] :
+  is_root (cyclotomic n B) (zeta n A B) :=
+by { convert aeval_zeta n A B, rw [is_root.def, aeval_def, eval₂_eq_eval_map, map_cyclotomic] }
 
-/-- If `is_domain B` and `ne_zero (↑n : B)` then `zeta n A B` is a primitive `n`-th root of
-unity. -/
-lemma zeta_primitive_root [is_domain B] [ne_zero ((n : ℕ) : B)] :
-  is_primitive_root (zeta n A B) n :=
-by { rw ←is_root_cyclotomic_iff, exact zeta_spec' n A B }
+lemma zeta_pow : (zeta n A B) ^ (n : ℕ) = 1 :=
+(zeta_spec n A B).pow_eq_one
 
 end is_cyclotomic_extension
 
@@ -101,40 +106,43 @@ end zeta
 
 section no_order
 
-variables [field K] [field L] [comm_ring C] [algebra K L] [algebra K C]
-          [is_cyclotomic_extension {n} K L]
+variables [field K] [comm_ring L] [is_domain L] [algebra K L] [is_cyclotomic_extension {n} K L]
           {ζ : L} (hζ : is_primitive_root ζ n)
 
 namespace is_primitive_root
 
-/-- The `power_basis` given by a primitive root `ζ`. -/
-@[simps] noncomputable def power_basis : power_basis K L :=
+variable {C}
+
+/-- The `power_basis` given by a primitive root `η`. -/
+@[simps] protected noncomputable def power_basis : power_basis K L :=
 power_basis.map (algebra.adjoin.power_basis $ integral {n} K L ζ) $
-  (subalgebra.equiv_of_eq _ _ (is_cyclotomic_extension.adjoin_primitive_root_eq_top n _ hζ)).trans
+  (subalgebra.equiv_of_eq _ _ (is_cyclotomic_extension.adjoin_primitive_root_eq_top hζ)).trans
   subalgebra.top_equiv
 
 lemma power_basis_gen_mem_adjoin_zeta_sub_one :
-  (power_basis K hζ).gen ∈ adjoin K ({ζ - 1} : set L) :=
+  (hζ.power_basis K).gen ∈ adjoin K ({ζ - 1} : set L) :=
 begin
   rw [power_basis_gen, adjoin_singleton_eq_range_aeval, alg_hom.mem_range],
   exact ⟨X + 1, by simp⟩
 end
 
-/-- The `power_basis` given by `ζ - 1`. -/
-@[simps] noncomputable def sub_one_power_basis (hζ : is_primitive_root ζ n) :
-  _root_.power_basis K L :=
+/-- The `power_basis` given by `η - 1`. -/
+@[simps] noncomputable def sub_one_power_basis : power_basis K L :=
   (hζ.power_basis K).of_gen_mem_adjoin
     (is_integral_sub (is_cyclotomic_extension.integral {n} K L ζ) is_integral_one)
     (hζ.power_basis_gen_mem_adjoin_zeta_sub_one _)
 
-variables {K}
+variables {K} (C)
 
-/-- The equivalence between `L →ₐ[K] A` and `primitive_roots n A` given by a primitive root `ζ`. -/
-@[simps] noncomputable def embeddings_equiv_primitive_roots [is_domain C] [ne_zero ((n : ℕ) : K)]
-  (hirr : irreducible (cyclotomic n K)) : (L →ₐ[K] C) ≃ primitive_roots n C :=
+-- We are not using @[simps] to avoid a timeout.
+
+/-- The equivalence between `L →ₐ[K] C` and `primitive_roots n C` given by a primitive root `ζ`. -/
+noncomputable def embeddings_equiv_primitive_roots (C : Type*) [comm_ring C] [is_domain C]
+  [algebra K C] (hirr : irreducible (cyclotomic n K)) : (L →ₐ[K] C) ≃ primitive_roots n C :=
 ((hζ.power_basis K).lift_equiv).trans
 { to_fun    := λ x,
   begin
+    haveI := is_cyclotomic_extension.ne_zero' n K L,
     haveI hn := ne_zero.of_no_zero_smul_divisors K C n,
     refine ⟨x.1, _⟩,
     cases x,
@@ -144,6 +152,7 @@ variables {K}
   end,
   inv_fun   := λ x,
   begin
+    haveI := is_cyclotomic_extension.ne_zero' n K L,
     haveI hn := ne_zero.of_no_zero_smul_divisors K C n,
     refine ⟨x.1, _⟩,
     cases x,
@@ -154,6 +163,11 @@ variables {K}
   left_inv  := λ x, subtype.ext rfl,
   right_inv := λ x, subtype.ext rfl }
 
+@[simp]
+lemma embeddings_equiv_primitive_roots_apply_coe (C : Type*) [comm_ring C] [is_domain C]
+  [algebra K C] (hirr : irreducible (cyclotomic n K)) (φ : L →ₐ[K] C) :
+  (hζ.embeddings_equiv_primitive_roots C hirr φ : C) = φ ζ := rfl
+
 end is_primitive_root
 
 namespace is_cyclotomic_extension
@@ -162,12 +176,12 @@ variables {K} (L)
 
 /-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), then the `finrank` of a
 cyclotomic extension is `n.totient`. -/
-lemma finrank (hirr : irreducible (cyclotomic n K)) [ne_zero ((n : ℕ) : K)] :
+lemma finrank (hirr : irreducible (cyclotomic n K)) :
   finrank K L = (n : ℕ).totient :=
 begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L n,
-  rw [((zeta_primitive_root n K L).power_basis K).finrank, is_primitive_root.power_basis_dim,
-      ←(zeta_primitive_root n K L).minpoly_eq_cyclotomic_of_irreducible hirr, nat_degree_cyclotomic]
+  haveI := is_cyclotomic_extension.ne_zero' n K L,
+  rw [((zeta_spec n K L).power_basis K).finrank, is_primitive_root.power_basis_dim,
+      ←(zeta_spec n K L).minpoly_eq_cyclotomic_of_irreducible hirr, nat_degree_cyclotomic]
 end
 
 end is_cyclotomic_extension
@@ -178,21 +192,25 @@ section norm
 
 namespace is_primitive_root
 
-variables [field L] {ζ : L} (hζ : is_primitive_root ζ n)
-variables {K} [field K] [algebra K L] [ne_zero ((n : ℕ) : K)]
+section comm_ring
+
+variables [comm_ring L] {ζ : L} (hζ : is_primitive_root ζ n)
+variables {K} [field K] [algebra K L]
 
 /-- This mathematically trivial result is complementary to `norm_eq_one` below. -/
-lemma norm_eq_neg_one_pow (hζ : is_primitive_root ζ 2) : norm K ζ = (-1) ^ finrank K L :=
-by rw [hζ.eq_neg_one_of_two_right , show -1 = algebra_map K L (-1), by simp,
-  algebra.norm_algebra_map]
+lemma norm_eq_neg_one_pow (hζ : is_primitive_root ζ 2) [is_domain L] :
+  norm K ζ = (-1) ^ finrank K L :=
+by rw [hζ.eq_neg_one_of_two_right, show -1 = algebra_map K L (-1), by simp,
+       algebra.norm_algebra_map]
 
 include hζ
 
 /-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), the norm of a primitive root is
 `1` if `n ≠ 2`. -/
-lemma norm_eq_one [is_cyclotomic_extension {n} K L] (hn : n ≠ 2)
+lemma norm_eq_one [is_domain L] [is_cyclotomic_extension {n} K L] (hn : n ≠ 2)
   (hirr : irreducible (cyclotomic n K)) : norm K ζ = 1 :=
 begin
+  haveI := is_cyclotomic_extension.ne_zero' n K L,
   by_cases h1 : n = 1,
   { rw [h1, one_coe, one_right_iff] at hζ,
     rw [hζ, show 1 = algebra_map K L 1, by simp, algebra.norm_algebra_map, one_pow] },
@@ -209,31 +227,30 @@ end
 lemma norm_eq_one_of_linearly_ordered {K : Type*} [linear_ordered_field K] [algebra K L]
   (hodd : odd (n : ℕ)) : norm K ζ = 1 :=
 begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L n,
   have hz := congr_arg (norm K) ((is_primitive_root.iff_def _ n).1 hζ).1,
   rw [←(algebra_map K L).map_one , algebra.norm_algebra_map, one_pow, map_pow, ←one_pow ↑n] at hz,
   exact strict_mono.injective hodd.strict_mono_pow hz
 end
 
-lemma norm_of_cyclotomic_irreducible [is_cyclotomic_extension {n} K L]
+lemma norm_of_cyclotomic_irreducible [is_domain L] [is_cyclotomic_extension {n} K L]
   (hirr : irreducible (cyclotomic n K)) : norm K ζ = ite (n = 2) (-1) 1 :=
 begin
   split_ifs with hn,
   { unfreezingI {subst hn},
     convert norm_eq_neg_one_pow hζ,
     erw [is_cyclotomic_extension.finrank _ hirr, totient_two, pow_one],
-    apply_instance },
+    all_goals { apply_instance } },
   { exact hζ.norm_eq_one hn hirr }
 end
 
-lemma minpoly_sub_one_eq_cyclotomic_comp [is_cyclotomic_extension {n} K L]
-  (h : irreducible (polynomial.cyclotomic n K)) :
-  minpoly K (ζ - 1) = (cyclotomic n K).comp (X + 1) :=
-begin
-  rw [show ζ - 1 = ζ + (algebra_map K L (-1)), by simp [sub_eq_add_neg], minpoly.add_algebra_map
-    (is_cyclotomic_extension.integral {n} K L ζ), hζ.minpoly_eq_cyclotomic_of_irreducible h],
-  simp
-end
+end comm_ring
+
+section field
+
+variables [field L] {ζ : L} (hζ : is_primitive_root ζ n)
+variables {K} [field K] [algebra K L]
+
+include hζ
 
 /-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), then the norm of
 `ζ - 1` is `eval 1 (cyclotomic n ℤ)`. -/
@@ -241,6 +258,7 @@ lemma sub_one_norm_eq_eval_cyclotomic [is_cyclotomic_extension {n} K L]
   (h : 2 < (n : ℕ)) (hirr : irreducible (cyclotomic n K)) :
   norm K (ζ - 1) = ↑(eval 1 (cyclotomic n ℤ)) :=
 begin
+  haveI := is_cyclotomic_extension.ne_zero' n K L,
   let E := algebraic_closure L,
   obtain ⟨z, hz⟩ := is_alg_closed.exists_root _ (degree_cyclotomic_pos n E n.pos).ne.symm,
   apply (algebra_map K E).injective,
@@ -257,8 +275,8 @@ begin
     simp },
   haveI : ne_zero ((n : ℕ) : E) := (ne_zero.of_no_zero_smul_divisors K _ (n : ℕ)),
   rw [this, cyclotomic', ← cyclotomic_eq_prod_X_sub_primitive_roots (is_root_cyclotomic_iff.1 hz),
-      ← map_cyclotomic_int, (algebra_map K E).map_int_cast, ←int.cast_one, eval_int_cast_map,
-      ring_hom.eq_int_cast, int.cast_id]
+    ← map_cyclotomic_int, _root_.map_int_cast, ←int.cast_one, eval_int_cast_map, eq_int_cast,
+    int.cast_id]
 end
 
 /-- If `is_prime_pow (n : ℕ)`, `n ≠ 2` and `irreducible (cyclotomic n K)` (in particular for
@@ -281,27 +299,29 @@ end
 
 omit hζ
 
-local attribute [instance] is_cyclotomic_extension.finite_dimensional
-local attribute [instance] is_cyclotomic_extension.is_galois
+variable {A}
+
+lemma minpoly_sub_one_eq_cyclotomic_comp [algebra K A] [is_domain A] {ζ : A}
+  [is_cyclotomic_extension {n} K A] (hζ : is_primitive_root ζ n)
+  (h : irreducible (polynomial.cyclotomic n K)) :
+  minpoly K (ζ - 1) = (cyclotomic n K).comp (X + 1) :=
+begin
+  haveI := is_cyclotomic_extension.ne_zero' n K A,
+  rw [show ζ - 1 = ζ + (algebra_map K A (-1)), by simp [sub_eq_add_neg], minpoly.add_algebra_map
+    (is_cyclotomic_extension.integral {n} K A ζ), hζ.minpoly_eq_cyclotomic_of_irreducible h],
+  simp
+end
+
+open_locale cyclotomic
 
 /-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
 then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `p ^ (k - s + 1) ≠ 2`. See the next lemmas
 for similar results. -/
-lemma pow_sub_one_norm_prime_pow_ne_two [ne_zero ((p : ℕ) : K)] {k s : ℕ}
-  (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) [hpri : fact (p : ℕ).prime]
-  [is_cyclotomic_extension {p ^ (k + 1)} K L]
+lemma pow_sub_one_norm_prime_pow_ne_two {k s : ℕ} (hζ : is_primitive_root ζ ↑(p ^ (k + 1)))
+  [hpri : fact (p : ℕ).prime] [is_cyclotomic_extension {p ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (hs : s ≤ k)
   (htwo : p ^ (k - s + 1) ≠ 2) : norm K (ζ ^ ((p : ℕ) ^ s) - 1) = p ^ ((p : ℕ) ^ s) :=
 begin
-  haveI : ne_zero ((↑(p ^ (k + 1)) : ℕ) : K),
-  { refine ⟨λ hzero, _⟩,
-    rw [pnat.pow_coe] at hzero,
-    simpa [ne_zero.ne ((p : ℕ) : K)] using hzero },
-  haveI : ne_zero ((↑(p ^ (k - s + 1)) : ℕ) : K),
-  { refine ⟨λ hzero, _⟩,
-    rw [pnat.pow_coe] at hzero,
-    simpa [ne_zero.ne ((p : ℕ) : K)] using hzero },
-
   have hirr₁ : irreducible (cyclotomic (p ^ (k - s + 1)) K) :=
   cyclotomic_irreducible_pow_of_irreducible_pow hpri.1 (by linarith) hirr,
   rw ←pnat.pow_coe at hirr₁,
@@ -314,7 +334,7 @@ begin
   haveI : is_cyclotomic_extension {p ^ (k - s + 1)} K K⟮η⟯,
   { suffices : is_cyclotomic_extension {p ^ (k - s + 1)} K K⟮η + 1⟯.to_subalgebra,
     { have H : K⟮η + 1⟯.to_subalgebra = K⟮η⟯.to_subalgebra,
-      { simp only [intermediate_field.adjoin_simple_to_subalgebra_of_integral _ _
+      { simp only [intermediate_field.adjoin_simple_to_subalgebra_of_integral
           (is_cyclotomic_extension.integral {p ^ (k + 1)} K L _)],
         refine subalgebra.ext (λ x, ⟨λ hx, adjoin_le _ hx, λ hx, adjoin_le _ hx⟩),
         { simp only [set.singleton_subset_iff, set_like.mem_coe],
@@ -324,7 +344,7 @@ begin
           refine subalgebra.sub_mem _ (subset_adjoin (mem_singleton _)) (subalgebra.one_mem _) } },
       rw [H] at this,
       exact this },
-    rw [intermediate_field.adjoin_simple_to_subalgebra_of_integral _ _
+    rw [intermediate_field.adjoin_simple_to_subalgebra_of_integral
       (is_cyclotomic_extension.integral {p ^ (k + 1)} K L _)],
     have hη' : is_primitive_root (η + 1) ↑(p ^ (k + 1 - s)) := by simpa using hη,
     convert hη'.adjoin_is_cyclotomic_extension K,
@@ -345,20 +365,19 @@ begin
       pnat.pow_coe, pnat.pow_coe, nat.totient_prime_pow hpri.out (k - s).succ_pos,
       nat.totient_prime_pow hpri.out k.succ_pos, mul_comm _ (↑p - 1), mul_assoc,
       mul_comm (↑p ^ (k.succ - 1))] at this,
-    replace this := nat.eq_of_mul_eq_mul_left (tsub_pos_iff_lt.2 (nat.prime.one_lt hpri.out)) this,
+    replace this := mul_left_cancel₀ (tsub_pos_iff_lt.2 hpri.out.one_lt).ne' this,
     have Hex : k.succ - 1 = (k - s).succ - 1 + s,
     { simp only [nat.succ_sub_succ_eq_sub, tsub_zero],
       exact (nat.sub_add_cancel hs).symm },
     rw [Hex, pow_add] at this,
-    exact nat.eq_of_mul_eq_mul_left (pow_pos hpri.out.pos _) this },
+    exact mul_left_cancel₀ (pow_ne_zero _ hpri.out.ne_zero) this },
   all_goals { apply_instance }
 end
 
 /-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
 then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `p ≠ 2`. -/
-lemma pow_sub_one_norm_prime_ne_two [ne_zero ((p : ℕ) : K)] {k : ℕ}
-  (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) [hpri : fact (p : ℕ).prime]
-  [is_cyclotomic_extension {p ^ (k + 1)} K L]
+lemma pow_sub_one_norm_prime_ne_two {k : ℕ} (hζ : is_primitive_root ζ ↑(p ^ (k + 1)))
+  [hpri : fact (p : ℕ).prime] [is_cyclotomic_extension {p ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) {s : ℕ} (hs : s ≤ k)
   (hodd : p ≠ 2) : norm K (ζ ^ ((p : ℕ) ^ s) - 1) = p ^ ((p : ℕ) ^ s) :=
 begin
@@ -372,39 +391,31 @@ end
 
 /-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is an odd
 prime, then the norm of `ζ - 1` is `p`. -/
-lemma sub_one_norm_prime_ne_two [ne_zero ((p : ℕ) : K)] {k : ℕ}
-  (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) [hpri : fact (p : ℕ).prime]
-  [is_cyclotomic_extension {p ^ (k + 1)} K L]
+lemma sub_one_norm_prime_ne_two {k : ℕ} (hζ : is_primitive_root ζ ↑(p ^ (k + 1)))
+  [hpri : fact (p : ℕ).prime] [is_cyclotomic_extension {p ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (h : p ≠ 2) :
   norm K (ζ - 1) = p :=
 by simpa using hζ.pow_sub_one_norm_prime_ne_two hirr k.zero_le h
 
 /-- If `irreducible (cyclotomic p K)` (in particular for `K = ℚ`) and `p` is an odd prime,
 then the norm of `ζ - 1` is `p`. -/
-lemma sub_one_norm_prime [ne_zero ((p : ℕ) : K)] [hpri : fact (p : ℕ).prime]
-  [hcyc : is_cyclotomic_extension {p} K L] (hζ: is_primitive_root ζ p)
-  (hirr : irreducible (cyclotomic p K)) (h : p ≠ 2) :
+lemma sub_one_norm_prime [hpri : fact (p : ℕ).prime] [hcyc : is_cyclotomic_extension {p} K L]
+  (hζ: is_primitive_root ζ p) (hirr : irreducible (cyclotomic p K)) (h : p ≠ 2) :
   norm K (ζ - 1) = p :=
 begin
   replace hirr : irreducible (cyclotomic (↑(p ^ (0 + 1)) : ℕ) K) := by simp [hirr],
   replace hζ : is_primitive_root ζ (↑(p ^ (0 + 1)) : ℕ) := by simp [hζ],
-  haveI : ne_zero ((↑(p ^ (0 + 1)) : ℕ) : K) := ⟨by simp [ne_zero.ne ((p : ℕ) : K)]⟩,
   haveI : is_cyclotomic_extension {p ^ (0 + 1)} K L := by simp [hcyc],
   simpa using sub_one_norm_prime_ne_two hζ hirr h
 end
 
 /-- If `irreducible (cyclotomic (2 ^ (k + 1)) K)` (in particular for `K = ℚ`), then the norm of
 `ζ ^ (2 ^ k) - 1` is `(-2) ^ (2 ^ k)`. -/
-lemma pow_sub_one_norm_two [ne_zero (2 : K)] {k : ℕ} (hζ : is_primitive_root ζ (2 ^ (k + 1)))
+lemma pow_sub_one_norm_two {k : ℕ} (hζ : is_primitive_root ζ (2 ^ (k + 1)))
   [is_cyclotomic_extension {2 ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (2 ^ (k + 1)) K)) :
   norm K (ζ ^ (2 ^ k) - 1) = (-2) ^ (2 ^ k) :=
 begin
-  haveI : ne_zero (((2 ^ (k + 1) : ℕ+) : ℕ) : K),
-  { refine ⟨λ hzero, _⟩,
-    rw [pow_coe, pnat.coe_bit0, one_coe, cast_pow, cast_bit0, cast_one] at hzero,
-    exact (ne_zero.ne (2 : K)) (pow_eq_zero hzero) },
-
   have := hζ.pow_of_dvd (λ h, two_ne_zero (pow_eq_zero h)) (pow_dvd_pow 2 (le_succ k)),
   rw [nat.pow_div (le_succ k) zero_lt_two, nat.succ_sub (le_refl k), nat.sub_self, pow_one] at this,
   have H : (-1 : L) - (1 : L) = algebra_map K L (-2),
@@ -419,16 +430,10 @@ end
 
 /-- If `irreducible (cyclotomic (2 ^ k) K)` (in particular for `K = ℚ`) and `k` is at least `2`,
 then the norm of `ζ - 1` is `2`. -/
-lemma sub_one_norm_two [ne_zero (2 : K)] {k : ℕ} (hζ : is_primitive_root ζ (2 ^ k))
-  (hk : 2 ≤ k) [H : is_cyclotomic_extension {2 ^ k} K L]
-  (hirr : irreducible (cyclotomic (2 ^ k) K)) : norm K (ζ - 1) = 2 :=
+lemma sub_one_norm_two {k : ℕ} (hζ : is_primitive_root ζ (2 ^ k)) (hk : 2 ≤ k)
+  [H : is_cyclotomic_extension {2 ^ k} K L] (hirr : irreducible (cyclotomic (2 ^ k) K)) :
+  norm K (ζ - 1) = 2 :=
 begin
-  haveI : ne_zero (((2 ^ k : ℕ+) : ℕ) : K),
-  { refine ⟨λ hzero, _⟩,
-    rw [pow_coe, pnat.coe_bit0, one_coe, cast_pow, cast_bit0, cast_one,
-      pow_eq_zero_iff (lt_of_lt_of_le zero_lt_two hk)] at hzero,
-    exact (ne_zero.ne (2 : K)) hzero,
-    apply_instance },
   have : 2 < (2 ^ k : ℕ+),
   { simp only [← coe_lt_coe, pnat.coe_bit0, one_coe, pow_coe],
     nth_rewrite 0 [← pow_one 2],
@@ -440,12 +445,11 @@ begin
 end
 
 /-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
-then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `1 ≤ k`. -/
-lemma pow_sub_one_norm_prime_pow_of_one_le [hne : ne_zero ((p : ℕ) : K)] {k s : ℕ}
-  (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) [hpri : fact (p : ℕ).prime]
-  [hcycl : is_cyclotomic_extension {p ^ (k + 1)} K L]
+then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `k ≠ 0` and `s ≤ k`. -/
+lemma pow_sub_one_norm_prime_pow_of_ne_zero {k s : ℕ} (hζ : is_primitive_root ζ ↑(p ^ (k + 1)))
+  [hpri : fact (p : ℕ).prime] [hcycl : is_cyclotomic_extension {p ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (hs : s ≤ k)
-  (hk : 1 ≤ k) : norm K (ζ ^ ((p : ℕ) ^ s) - 1) = p ^ ((p : ℕ) ^ s) :=
+  (hk : k ≠ 0) : norm K (ζ ^ ((p : ℕ) ^ s) - 1) = p ^ ((p : ℕ) ^ s) :=
 begin
   by_cases htwo : p ^ (k - s + 1) = 2,
   { have hp : p = 2,
@@ -459,36 +463,30 @@ begin
       replace htwo := nat.pow_right_injective rfl.le htwo,
       rw [add_left_eq_self, nat.sub_eq_zero_iff_le] at htwo,
       refine le_antisymm hs htwo },
-    haveI : ne_zero (2 : K),
-    { refine ⟨λ h, _⟩,
-      rw [hp, pnat.coe_bit0, one_coe, cast_bit0, cast_one, h] at hne,
-      simpa using hne.out },
     simp only [hs, hp, pnat.coe_bit0, one_coe, coe_coe, cast_bit0, cast_one,
       pow_coe] at ⊢ hζ hirr hcycl,
     haveI := hcycl,
-    obtain ⟨k₁, hk₁⟩ := nat.exists_eq_succ_of_ne_zero (one_le_iff_ne_zero.1 hk),
+    obtain ⟨k₁, hk₁⟩ := nat.exists_eq_succ_of_ne_zero hk,
     rw [hζ.pow_sub_one_norm_two hirr],
     rw [hk₁, pow_succ, pow_mul, neg_eq_neg_one_mul, mul_pow, neg_one_sq, one_mul, ← pow_mul,
       ← pow_succ] },
   { exact hζ.pow_sub_one_norm_prime_pow_ne_two hirr hs htwo }
 end
 
+end field
+
 end is_primitive_root
 
 namespace is_cyclotomic_extension
 
 open is_primitive_root
 
-variables {K} (L) [field K] [field L] [algebra K L] [ne_zero ((n : ℕ) : K)]
-
+variables {K} (L) [field K] [field L] [algebra K L]
 /-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), the norm of `zeta n K L` is `1`
 if `n` is odd. -/
 lemma norm_zeta_eq_one [is_cyclotomic_extension {n} K L] (hn : n ≠ 2)
   (hirr : irreducible (cyclotomic n K)) : norm K (zeta n K L) = 1 :=
-begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L n,
-  exact (zeta_primitive_root n K L).norm_eq_one hn hirr,
-end
+(zeta_spec n K L).norm_eq_one hn hirr
 
 /-- If `is_prime_pow (n : ℕ)`, `n ≠ 2` and `irreducible (cyclotomic n K)` (in particular for
 `K = ℚ`), then the norm of `zeta n K L - 1` is `(n : ℕ).min_fac`. -/
@@ -496,70 +494,39 @@ lemma is_prime_pow_norm_zeta_sub_one (hn : is_prime_pow (n : ℕ))
   [is_cyclotomic_extension {n} K L]
   (hirr : irreducible (cyclotomic (n : ℕ) K)) (h : n ≠ 2) :
   norm K (zeta n K L - 1) = (n : ℕ).min_fac :=
-begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L n,
-  exact (zeta_primitive_root n K L).sub_one_norm_is_prime_pow hn hirr h,
-end
+(zeta_spec n K L).sub_one_norm_is_prime_pow hn hirr h
 
 /-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
 then the norm of `(zeta (p ^ (k + 1)) K L) ^ (p ^ s) - 1` is `p ^ (p ^ s)`
 if `p ^ (k - s + 1) ≠ 2`. -/
-lemma prime_ne_two_pow_norm_zeta_pow_sub_one [ne_zero ((p : ℕ) : K)] {k : ℕ}
-  [hpri : fact (p : ℕ).prime]
+lemma prime_ne_two_pow_norm_zeta_pow_sub_one {k : ℕ} [hpri : fact (p : ℕ).prime]
   [is_cyclotomic_extension {p ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K))  {s : ℕ} (hs : s ≤ k)
   (htwo : p ^ (k - s + 1) ≠ 2) :
   norm K ((zeta (p ^ (k + 1)) K L) ^ ((p : ℕ) ^ s) - 1) = p ^ ((p : ℕ) ^ s) :=
-begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L p,
-  haveI : ne_zero ((↑(p ^ (k + 1)) : ℕ) : L),
-  { refine ⟨λ hzero, _⟩,
-    rw [pow_coe] at hzero,
-    simpa [ne_zero.ne ((p : ℕ) : L)] using hzero },
-  exact (zeta_primitive_root _ K L).pow_sub_one_norm_prime_pow_ne_two hirr hs htwo
-end
+(zeta_spec _ K L).pow_sub_one_norm_prime_pow_ne_two hirr hs htwo
 
 /-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is an odd
 prime, then the norm of `zeta (p ^ (k + 1)) K L - 1` is `p`. -/
-lemma prime_ne_two_pow_norm_zeta_sub_one [ne_zero ((p : ℕ) : K)] {k : ℕ}
-  [hpri : fact (p : ℕ).prime] [is_cyclotomic_extension {p ^ (k + 1)} K L]
+lemma prime_ne_two_pow_norm_zeta_sub_one {k : ℕ} [hpri : fact (p : ℕ).prime]
+  [is_cyclotomic_extension {p ^ (k + 1)} K L]
   (hirr : irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (h : p ≠ 2) :
   norm K (zeta (p ^ (k + 1)) K L - 1) = p :=
-begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L p,
-  haveI : ne_zero ((↑(p ^ (k + 1)) : ℕ) : L),
-  { refine ⟨λ hzero, _⟩,
-    rw [pow_coe] at hzero,
-    simpa [ne_zero.ne ((p : ℕ) : L)] using hzero },
-  exact (zeta_primitive_root _ K L).sub_one_norm_prime_ne_two hirr h,
-end
+(zeta_spec _ K L).sub_one_norm_prime_ne_two hirr h
 
 /-- If `irreducible (cyclotomic p K)` (in particular for `K = ℚ`) and `p` is an odd prime,
 then the norm of `zeta p K L - 1` is `p`. -/
-lemma prime_ne_two_norm_zeta_sub_one [ne_zero ((p : ℕ) : K)] [hpri : fact (p : ℕ).prime]
+lemma prime_ne_two_norm_zeta_sub_one [hpri : fact (p : ℕ).prime]
   [hcyc : is_cyclotomic_extension {p} K L] (hirr : irreducible (cyclotomic p K)) (h : p ≠ 2) :
   norm K (zeta p K L - 1) = p :=
-begin
-  haveI := ne_zero.of_no_zero_smul_divisors K L p,
-  exact (zeta_primitive_root _ K L).sub_one_norm_prime hirr h,
-end
+(zeta_spec _ K L).sub_one_norm_prime hirr h
 
 /-- If `irreducible (cyclotomic (2 ^ k) K)` (in particular for `K = ℚ`) and `k` is at least `2`,
 then the norm of `zeta (2 ^ k) K L - 1` is `2`. -/
-lemma two_pow_norm_zeta_sub_one [ne_zero (2 : K)] {k : ℕ} (hk : 2 ≤ k)
+lemma two_pow_norm_zeta_sub_one {k : ℕ} (hk : 2 ≤ k)
   [is_cyclotomic_extension {2 ^ k} K L] (hirr : irreducible (cyclotomic (2 ^ k) K)) :
   norm K (zeta (2 ^ k) K L - 1) = 2 :=
-begin
-  haveI : ne_zero (((2 ^ k : ℕ+) : ℕ) : L),
-  { refine ⟨λ hzero, _⟩,
-    rw [pow_coe, pnat.coe_bit0, one_coe, cast_pow, cast_bit0, cast_one, pow_eq_zero_iff
-      (lt_of_lt_of_le zero_lt_two hk), show (2 : L) = algebra_map K L 2, by simp,
-      show (0 : L) = algebra_map K L 0, by simp] at hzero,
-    exact (ne_zero.ne (2 : K)) ((algebra_map K L).injective hzero),
-    apply_instance },
-  refine sub_one_norm_two _ hk hirr,
-  simpa using zeta_primitive_root (2 ^ k) K L,
-end
+sub_one_norm_two (zeta_spec (2 ^ k) K L) hk hirr
 
 end is_cyclotomic_extension
 
diff --git a/src/number_theory/cyclotomic/rat.lean b/src/number_theory/cyclotomic/rat.lean
index d02a490ee2967..f285b2f60cf6d 100644
--- a/src/number_theory/cyclotomic/rat.lean
+++ b/src/number_theory/cyclotomic/rat.lean
@@ -5,14 +5,18 @@ Authors: Riccardo Brasca
 -/
 
 import number_theory.cyclotomic.discriminant
-import ring_theory.polynomial.eisenstein
+import ring_theory.polynomial.eisenstein.is_integral
 
 /-!
 # Ring of integers of `p ^ n`-th cyclotomic fields
-We compute the ring of integers of a `p ^ n`-th cyclotomic extension of `ℚ`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+We gather results about cyclotomic extensions of `ℚ`. In particular, we compute the ring of
+integers of a `p ^ n`-th cyclotomic extension of `ℚ`.
 
 ## Main results
-* `is_cyclotomic_extension.rat.is_integral_closure_adjoing_singleton_of_prime_pow`: if `K` is a
+* `is_cyclotomic_extension.rat.is_integral_closure_adjoin_singleton_of_prime_pow`: if `K` is a
   `p ^ k`-th cyclotomic extension of `ℚ`, then `(adjoin ℤ {ζ})` is the integral closure of
   `ℤ` in `K`.
 * `is_cyclotomic_extension.rat.cyclotomic_ring_is_integral_closure_of_prime_pow`: the integral
@@ -21,16 +25,16 @@ We compute the ring of integers of a `p ^ n`-th cyclotomic extension of `ℚ`.
 
 universes u
 
-open algebra is_cyclotomic_extension polynomial
-
-open_locale cyclotomic
+open algebra is_cyclotomic_extension polynomial number_field
 
-namespace is_cyclotomic_extension.rat
+open_locale cyclotomic number_field nat
 
 variables {p : ℕ+} {k : ℕ} {K : Type u} [field K] [char_zero K] {ζ : K} [hp : fact (p : ℕ).prime]
 
 include hp
 
+namespace is_cyclotomic_extension.rat
+
 /-- The discriminant of the power basis given by `ζ - 1`. -/
 lemma discr_prime_pow_ne_two' [is_cyclotomic_extension {p ^ (k + 1)} ℚ K]
   (hζ : is_primitive_root ζ ↑(p ^ (k + 1))) (hk : p ^ (k + 1) ≠ 2) :
@@ -74,7 +78,7 @@ end
 
 /-- If `K` is a `p ^ k`-th cyclotomic extension of `ℚ`, then `(adjoin ℤ {ζ})` is the
 integral closure of `ℤ` in `K`. -/
-lemma is_integral_closure_adjoing_singleton_of_prime_pow
+lemma is_integral_closure_adjoin_singleton_of_prime_pow
   [hcycl : is_cyclotomic_extension {p ^ k} ℚ K] (hζ : is_primitive_root ζ ↑(p ^ k)) :
   is_integral_closure (adjoin ℤ ({ζ} : set K)) ℤ K :=
 begin
@@ -104,12 +108,13 @@ begin
     rw [← hz, ← is_scalar_tower.algebra_map_apply],
     exact subalgebra.algebra_map_mem  _ _ },
   { have hmin : (minpoly ℤ B.gen).is_eisenstein_at (submodule.span ℤ {((p : ℕ) : ℤ)}),
-    { have h₁ := minpoly.gcd_domain_eq_field_fractions ℚ hint,
+    { have h₁ := minpoly.is_integrally_closed_eq_field_fractions' ℚ hint,
       have h₂ := hζ.minpoly_sub_one_eq_cyclotomic_comp
         (cyclotomic.irreducible_rat (p ^ _).pos),
       rw [is_primitive_root.sub_one_power_basis_gen] at h₁,
       rw [h₁, ← map_cyclotomic_int, show int.cast_ring_hom ℚ = algebra_map ℤ ℚ, by refl,
         show ((X + 1)) = map (algebra_map ℤ ℚ) (X + 1), by simp, ← map_comp] at h₂,
+      haveI : char_zero ℚ := strict_ordered_semiring.to_char_zero,
       rw [is_primitive_root.sub_one_power_basis_gen, map_injective (algebra_map ℤ ℚ)
         ((algebra_map ℤ ℚ).injective_int) h₂],
       exact cyclotomic_prime_pow_comp_X_add_one_is_eisenstein_at _ _ },
@@ -119,40 +124,28 @@ begin
     exact subalgebra.sub_mem _ (self_mem_adjoin_singleton ℤ _) (subalgebra.one_mem _) }
 end
 
-lemma is_integral_closure_adjoing_singleton_of_prime [hcycl : is_cyclotomic_extension {p} ℚ K]
+lemma is_integral_closure_adjoin_singleton_of_prime [hcycl : is_cyclotomic_extension {p} ℚ K]
   (hζ : is_primitive_root ζ ↑p) :
   is_integral_closure (adjoin ℤ ({ζ} : set K)) ℤ K :=
 begin
   rw [← pow_one p] at hζ hcycl,
-  exactI is_integral_closure_adjoing_singleton_of_prime_pow hζ,
+  exactI is_integral_closure_adjoin_singleton_of_prime_pow hζ,
 end
 
-local attribute [-instance] cyclotomic_field.algebra
-local attribute [instance] algebra_rat_subsingleton
-
 /-- The integral closure of `ℤ` inside `cyclotomic_field (p ^ k) ℚ` is
 `cyclotomic_ring (p ^ k) ℤ ℚ`. -/
 lemma cyclotomic_ring_is_integral_closure_of_prime_pow :
   is_integral_closure (cyclotomic_ring (p ^ k) ℤ ℚ) ℤ (cyclotomic_field (p ^ k) ℚ) :=
 begin
-  haveI : is_cyclotomic_extension {p ^ k} ℚ (cyclotomic_field (p ^ k) ℚ),
-  { convert cyclotomic_field.is_cyclotomic_extension (p ^ k) _,
-    { exact subsingleton.elim _ _ },
-    { exact ne_zero.char_zero } },
-  have hζ := zeta_primitive_root (p ^ k) ℚ (cyclotomic_field (p ^ k) ℚ),
+  haveI : char_zero ℚ := strict_ordered_semiring.to_char_zero,
+  have hζ := zeta_spec (p ^ k) ℚ (cyclotomic_field (p ^ k) ℚ),
   refine ⟨is_fraction_ring.injective _ _, λ x, ⟨λ h, ⟨⟨x, _⟩, rfl⟩, _⟩⟩,
-  { have := (is_integral_closure_adjoing_singleton_of_prime_pow hζ).is_integral_iff,
+  { have := (is_integral_closure_adjoin_singleton_of_prime_pow hζ).is_integral_iff,
     obtain ⟨y, rfl⟩ := this.1 h,
-    convert adjoin_mono _ y.2,
-    { simp only [eq_iff_true_of_subsingleton] },
-    { simp only [eq_iff_true_of_subsingleton] },
-    { simp only [pnat.pow_coe, set.singleton_subset_iff, set.mem_set_of_eq],
-      exact hζ.pow_eq_one } },
-  { haveI : is_cyclotomic_extension {p ^ k} ℤ (cyclotomic_ring (p ^ k) ℤ ℚ),
-    { convert cyclotomic_ring.is_cyclotomic_extension _ ℤ ℚ,
-      { exact subsingleton.elim _ _ },
-      { exact ne_zero.char_zero } },
-    rintro ⟨y, rfl⟩,
+    refine adjoin_mono _ y.2,
+    simp only [pnat.pow_coe, set.singleton_subset_iff, set.mem_set_of_eq],
+    exact hζ.pow_eq_one },
+  { rintro ⟨y, rfl⟩,
     exact is_integral.algebra_map ((is_cyclotomic_extension.integral {p ^ k} ℤ _) _) }
 end
 
@@ -164,3 +157,102 @@ begin
 end
 
 end is_cyclotomic_extension.rat
+
+section power_basis
+
+open is_cyclotomic_extension.rat
+
+namespace is_primitive_root
+
+/-- The algebra isomorphism `adjoin ℤ {ζ} ≃ₐ[ℤ] (𝓞 K)`, where `ζ` is a primitive `p ^ k`-th root of
+unity and `K` is a `p ^ k`-th cyclotomic extension of `ℚ`. -/
+@[simps] noncomputable def _root_.is_primitive_root.adjoin_equiv_ring_of_integers
+  [hcycl : is_cyclotomic_extension {p ^ k} ℚ K] (hζ : is_primitive_root ζ ↑(p ^ k)) :
+  adjoin ℤ ({ζ} : set K) ≃ₐ[ℤ] (𝓞 K) :=
+let _ := is_integral_closure_adjoin_singleton_of_prime_pow hζ in
+  by exactI (is_integral_closure.equiv ℤ (adjoin ℤ ({ζ} : set K)) K (𝓞 K))
+
+/-- The ring of integers of a `p ^ k`-th cyclotomic extension of `ℚ` is a cyclotomic extension. -/
+instance _root_.is_cyclotomic_extension.ring_of_integers
+  [is_cyclotomic_extension {p ^ k} ℚ K] : is_cyclotomic_extension {p ^ k} ℤ (𝓞 K) :=
+let _ := (zeta_spec (p ^ k) ℚ K).adjoin_is_cyclotomic_extension ℤ in by exactI
+  is_cyclotomic_extension.equiv _ ℤ _ ((zeta_spec (p ^ k) ℚ K).adjoin_equiv_ring_of_integers)
+
+/-- The integral `power_basis` of `𝓞 K` given by a primitive root of unity, where `K` is a `p ^ k`
+cyclotomic extension of `ℚ`. -/
+noncomputable def integral_power_basis [hcycl : is_cyclotomic_extension {p ^ k} ℚ K]
+  (hζ : is_primitive_root ζ ↑(p ^ k)) : power_basis ℤ (𝓞 K) :=
+(adjoin.power_basis' (hζ.is_integral (p ^ k).pos)).map hζ.adjoin_equiv_ring_of_integers
+
+@[simp] lemma integral_power_basis_gen [hcycl : is_cyclotomic_extension {p ^ k} ℚ K]
+  (hζ : is_primitive_root ζ ↑(p ^ k)) :
+  hζ.integral_power_basis.gen = ⟨ζ, hζ.is_integral (p ^ k).pos⟩ :=
+subtype.ext $ show algebra_map _ K hζ.integral_power_basis.gen = _, by simpa [integral_power_basis]
+
+@[simp] lemma integral_power_basis_dim [hcycl : is_cyclotomic_extension {p ^ k} ℚ K]
+  (hζ : is_primitive_root ζ ↑(p ^ k)) : hζ.integral_power_basis.dim = φ (p ^ k) :=
+by simp [integral_power_basis, ←cyclotomic_eq_minpoly hζ, nat_degree_cyclotomic]
+
+/-- The algebra isomorphism `adjoin ℤ {ζ} ≃ₐ[ℤ] (𝓞 K)`, where `ζ` is a primitive `p`-th root of
+unity and `K` is a `p`-th cyclotomic extension of `ℚ`. -/
+@[simps] noncomputable def _root_.is_primitive_root.adjoin_equiv_ring_of_integers'
+  [hcycl : is_cyclotomic_extension {p} ℚ K] (hζ : is_primitive_root ζ p) :
+  adjoin ℤ ({ζ} : set K) ≃ₐ[ℤ] (𝓞 K) :=
+@adjoin_equiv_ring_of_integers p 1 K _ _ _ _ (by { convert hcycl, rw pow_one }) (by rwa pow_one)
+
+/-- The ring of integers of a `p`-th cyclotomic extension of `ℚ` is a cyclotomic extension. -/
+instance _root_.is_cyclotomic_extension.ring_of_integers'
+  [is_cyclotomic_extension {p} ℚ K] : is_cyclotomic_extension {p} ℤ (𝓞 K) :=
+let _ := (zeta_spec p ℚ K).adjoin_is_cyclotomic_extension ℤ in by exactI
+  is_cyclotomic_extension.equiv _ ℤ _ ((zeta_spec p ℚ K).adjoin_equiv_ring_of_integers')
+
+/-- The integral `power_basis` of `𝓞 K` given by a primitive root of unity, where `K` is a `p`-th
+cyclotomic extension of `ℚ`. -/
+noncomputable def integral_power_basis' [hcycl : is_cyclotomic_extension {p} ℚ K]
+  (hζ : is_primitive_root ζ p) : power_basis ℤ (𝓞 K) :=
+@integral_power_basis p 1 K _ _ _ _ (by { convert hcycl, rw pow_one }) (by rwa pow_one)
+
+@[simp] lemma integral_power_basis'_gen [hcycl : is_cyclotomic_extension {p} ℚ K]
+  (hζ : is_primitive_root ζ p) : hζ.integral_power_basis'.gen = ⟨ζ, hζ.is_integral p.pos⟩ :=
+@integral_power_basis_gen p 1 K _ _ _ _ (by { convert hcycl, rw pow_one }) (by rwa pow_one)
+
+@[simp] lemma power_basis_int'_dim [hcycl : is_cyclotomic_extension {p} ℚ K]
+  (hζ : is_primitive_root ζ p) : hζ.integral_power_basis'.dim = φ p :=
+by erw [@integral_power_basis_dim p 1 K _ _ _ _ (by { convert hcycl, rw pow_one })
+  (by rwa pow_one), pow_one]
+
+/-- The integral `power_basis` of `𝓞 K` given by `ζ - 1`, where `K` is a `p ^ k` cyclotomic
+extension of `ℚ`. -/
+noncomputable def sub_one_integral_power_basis [is_cyclotomic_extension {p ^ k} ℚ K]
+  (hζ : is_primitive_root ζ ↑(p ^ k)) : power_basis ℤ (𝓞 K) :=
+power_basis.of_gen_mem_adjoin' hζ.integral_power_basis (is_integral_of_mem_ring_of_integers $
+  subalgebra.sub_mem _ (hζ.is_integral (p ^ k).pos) (subalgebra.one_mem _))
+begin
+  simp only [integral_power_basis_gen],
+  convert subalgebra.add_mem _
+    (self_mem_adjoin_singleton ℤ (⟨ζ - 1, _⟩ : 𝓞 K))
+    (subalgebra.one_mem _),
+  simp
+end
+
+@[simp] lemma sub_one_integral_power_basis_gen [is_cyclotomic_extension {p ^ k} ℚ K]
+  (hζ : is_primitive_root ζ ↑(p ^ k)) :
+  hζ.sub_one_integral_power_basis.gen =
+  ⟨ζ - 1, subalgebra.sub_mem _ (hζ.is_integral (p ^ k).pos) (subalgebra.one_mem _)⟩ :=
+by simp [sub_one_integral_power_basis]
+
+/-- The integral `power_basis` of `𝓞 K` given by `ζ - 1`, where `K` is a `p`-th cyclotomic
+extension of `ℚ`. -/
+noncomputable def sub_one_integral_power_basis' [hcycl : is_cyclotomic_extension {p} ℚ K]
+  (hζ : is_primitive_root ζ p) : power_basis ℤ (𝓞 K) :=
+@sub_one_integral_power_basis p 1 K _ _ _ _ (by { convert hcycl, rw pow_one }) (by rwa pow_one)
+
+@[simp] lemma sub_one_integral_power_basis'_gen [hcycl : is_cyclotomic_extension {p} ℚ K]
+  (hζ : is_primitive_root ζ p) :
+  hζ.sub_one_integral_power_basis'.gen =
+  ⟨ζ - 1, subalgebra.sub_mem _ (hζ.is_integral p.pos) (subalgebra.one_mem _)⟩ :=
+@sub_one_integral_power_basis_gen p 1 K _ _ _ _ (by { convert hcycl, rw pow_one }) (by rwa pow_one)
+
+end is_primitive_root
+
+end power_basis
diff --git a/src/number_theory/dioph.lean b/src/number_theory/dioph.lean
index dd5945c511e24..7cb13e17d1d05 100644
--- a/src/number_theory/dioph.lean
+++ b/src/number_theory/dioph.lean
@@ -6,11 +6,14 @@ Authors: Mario Carneiro
 import data.fin.fin2
 import data.pfun
 import data.vector3
-import number_theory.pell
+import number_theory.pell_matiyasevic
 
 /-!
 # Diophantine functions and Matiyasevic's theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Hilbert's tenth problem asked whether there exists an algorithm which for a given integer polynomial
 determines whether this polynomial has integer solutions. It was answered in the negative in 1970,
 the final step being completed by Matiyasevic who showed that the power function is Diophantine.
@@ -51,7 +54,7 @@ Matiyasevic's theorem, Hilbert's tenth problem
 
 open fin2 function nat sum
 
-local infixr ` ::ₒ `:67 := option.cons
+local infixr ` ::ₒ `:67 := option.elim
 local infixr ` ⊗ `:65 := sum.elim
 
 universe u
@@ -130,16 +133,29 @@ instance : has_mul (poly α) := ⟨λ f g, ⟨f * g, f.2.mul g.2⟩⟩
 
 instance (α : Type*) : inhabited (poly α) := ⟨0⟩
 
+instance : add_comm_group (poly α) := by refine_struct
+{ add   := ((+) : poly α → poly α → poly α),
+  neg   := (has_neg.neg : poly α → poly α),
+  sub   := (has_sub.sub),
+  zero  := 0,
+  zsmul := @zsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ ⟨has_neg.neg⟩,
+  nsmul := @nsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ };
+intros; try { refl }; refine ext (λ _, _);
+simp [sub_eq_add_neg, add_comm, add_assoc]
+
+instance : add_group_with_one (poly α) :=
+{ one := 1,
+  nat_cast := λ n, poly.const n,
+  int_cast := poly.const,
+  .. poly.add_comm_group }
+
 instance : comm_ring (poly α) := by refine_struct
 { add   := ((+) : poly α → poly α → poly α),
   zero  := 0,
-  neg   := (has_neg.neg),
   mul   := (*),
   one   := 1,
-  sub   := (has_sub.sub),
   npow  := @npow_rec _ ⟨(1 : poly α)⟩ ⟨(*)⟩,
-  nsmul := @nsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩,
-  zsmul := @zsmul_rec _ ⟨(0 : poly α)⟩ ⟨(+)⟩ ⟨has_neg.neg⟩ };
+  .. poly.add_group_with_one, .. poly.add_comm_group };
 intros; try { refl }; refine ext (λ _, _);
 simp [sub_eq_add_neg, mul_add, mul_left_comm, mul_comm, add_comm, add_assoc]
 
@@ -349,7 +365,7 @@ ext (dioph_fn_comp1 (reindex_dioph _ (none :: some) d) df) $ λ v,
 theorem vec_ex1_dioph (n) {S : set (vector3 ℕ (succ n))} (d : dioph S) :
   dioph {v : fin2 n → ℕ | ∃ x, x :: v ∈ S} :=
 ext (ex1_dioph $ reindex_dioph _ (none :: some) d) $ λ v, exists_congr $ λ x, by { dsimp,
-  rw [show (option.cons x v) ∘ (cons none some) = x :: v,
+  rw [show option.elim x v ∘ cons none some = x :: v,
   from funext $ λ s, by cases s with a b; refl] }
 
 lemma dioph_fn_vec (f : vector3 ℕ n → ℕ) : dioph_fn f ↔ dioph {v | f (v ∘ fs) = v fz} :=
@@ -370,7 +386,7 @@ lemma dioph_fn_compn : ∀ {n} {S : set (α ⊕ fin2 n → ℕ)} (d : dioph S)
   by { dsimp, congr', ext x, obtain (_ | _ | _) := x; refl },
   have dioph {v | v ⊗ f v :: (λ (i : fin2 n), fl i v) ∈ S},
   from @dioph_fn_compn n (λ v, S (v ∘ inl ⊗ f (v ∘ inl) :: v ∘ inr)) this _ dfl,
-  ext this $ λ v, by { dsimp, congr', ext x, obtain (_ | _ | _) := x; refl }
+  ext this $ λ v, by { dsimp, congr', ext x, obtain _ | _ | _ := x; refl }
 
 lemma dioph_comp {S : set (vector3 ℕ n)} (d : dioph S) (f : vector3 ((α → ℕ) → ℕ) n)
   (df : vector_allp dioph_fn f) : dioph {v | (λ i, f i v) ∈ S} :=
@@ -382,19 +398,19 @@ dioph_comp ((dioph_fn_vec _).1 df) ((λ v, v none) :: λ i v, g i (v ∘ some))
 by simp; exact ⟨proj_dioph none, (vector_allp_iff_forall _ _).2 $ λ i,
   reindex_dioph_fn _ $ (vector_allp_iff_forall _ _).1 dg _⟩
 
-localized "notation x ` D∧ `:35 y := dioph.inter x y" in dioph
-localized "notation x ` D∨ `:35 y := dioph.union x y" in dioph
+localized "notation (name := dioph.inter) x ` D∧ `:35 y := dioph.inter x y" in dioph
+localized "notation (name := dioph.union) x ` D∨ `:35 y := dioph.union x y" in dioph
 
-localized "notation `D∃`:30 := dioph.vec_ex1_dioph" in dioph
+localized "notation (name := dioph.vec_ex1_dioph) `D∃`:30 := dioph.vec_ex1_dioph" in dioph
 
-localized "prefix `&`:max := fin2.of_nat'" in dioph
+localized "prefix (name := fin2.of_nat') `&`:max := fin2.of_nat'" in dioph
 theorem proj_dioph_of_nat {n : ℕ} (m : ℕ) [is_lt m n] : dioph_fn (λ v : vector3 ℕ n, v &m) :=
 proj_dioph &m
-localized "prefix `D&`:100 := dioph.proj_dioph_of_nat" in dioph
+localized "prefix (name := proj_dioph_of_nat) `D&`:100 := dioph.proj_dioph_of_nat" in dioph
 
 theorem const_dioph (n : ℕ) : dioph_fn (const (α → ℕ) n) :=
 abs_poly_dioph (poly.const n)
-localized "prefix `D.`:100 := dioph.const_dioph" in dioph
+localized "prefix (name := const_dioph) `D.`:100 := dioph.const_dioph" in dioph
 
 variables {f g : (α → ℕ) → ℕ} (df : dioph_fn f) (dg : dioph_fn g)
 include df dg
@@ -411,26 +427,26 @@ lemma eq_dioph : dioph (λ v, f v = g v) :=
 dioph_comp2 df dg $ of_no_dummies _ (poly.proj &0 - poly.proj &1)
   (λ v, (int.coe_nat_eq_coe_nat_iff _ _).symm.trans
   ⟨@sub_eq_zero_of_eq ℤ _ (v &0) (v &1), eq_of_sub_eq_zero⟩)
-localized "infix ` D= `:50 := dioph.eq_dioph" in dioph
+localized "infix (name := eq_dioph) ` D= `:50 := dioph.eq_dioph" in dioph
 
 lemma add_dioph : dioph_fn (λ v, f v + g v) :=
 dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 + poly.proj &1)
-localized "infix ` D+ `:80 := dioph.add_dioph" in dioph
+localized "infix (name := add_dioph) ` D+ `:80 := dioph.add_dioph" in dioph
 
 lemma mul_dioph : dioph_fn (λ v, f v * g v) :=
 dioph_fn_comp2 df dg $ abs_poly_dioph (poly.proj &0 * poly.proj &1)
-localized "infix ` D* `:90 := dioph.mul_dioph" in dioph
+localized "infix (name := mul_dioph) ` D* `:90 := dioph.mul_dioph" in dioph
 
 lemma le_dioph : dioph {v | f v ≤ g v} :=
 dioph_comp2 df dg $ ext (D∃2 $ D&1 D+ D&0 D= D&2) (λ v, ⟨λ ⟨x, hx⟩, le.intro hx, le.dest⟩)
-localized "infix ` D≤ `:50 := dioph.le_dioph" in dioph
+localized "infix (name := le_dioph) ` D≤ `:50 := dioph.le_dioph" in dioph
 
 lemma lt_dioph : dioph {v | f v < g v} := df D+ (D. 1) D≤ dg
-localized "infix ` D< `:50 := dioph.lt_dioph" in dioph
+localized "infix (name := lt_dioph) ` D< `:50 := dioph.lt_dioph" in dioph
 
 lemma ne_dioph : dioph {v | f v ≠ g v} :=
 ext (df D< dg D∨ dg D< df) $ λ v, by { dsimp, exact lt_or_lt_iff_ne }
-localized "infix ` D≠ `:50 := dioph.ne_dioph" in dioph
+localized "infix (name := ne_dioph) ` D≠ `:50 := dioph.ne_dioph" in dioph
 
 lemma sub_dioph : dioph_fn (λ v, f v - g v) :=
 dioph_fn_comp2 df dg $ (dioph_fn_vec _).2 $
@@ -446,11 +462,11 @@ end, begin
   { exact or.inr ⟨yz, tsub_eq_zero_iff_le.mpr yz⟩ },
   { exact or.inl (tsub_add_cancel_of_le zy).symm },
 end⟩
-localized "infix ` D- `:80 := dioph.sub_dioph" in dioph
+localized "infix (name := sub_dioph) ` D- `:80 := dioph.sub_dioph" in dioph
 
 lemma dvd_dioph : dioph (λ v, f v ∣ g v) :=
 dioph_comp (D∃2 $ D&2 D= D&1 D* D&0) [f, g] (by exact ⟨df, dg⟩)
-localized "infix ` D∣ `:50 := dioph.dvd_dioph" in dioph
+localized "infix (name := dvd_dioph) ` D∣ `:50 := dioph.dvd_dioph" in dioph
 
 lemma mod_dioph : dioph_fn (λ v, f v % g v) :=
 have dioph (λ v : vector3 ℕ 3, (v &2 = 0 ∨ v &0 < v &2) ∧ ∃ (x : ℕ), v &0 + v &2 * x = v &1),
@@ -462,11 +478,11 @@ show ((y = 0 ∨ z < y) ∧ ∃ c, z + y * c = x) ↔ x % y = z, from
 λ e, by rw ← e; exact ⟨or_iff_not_imp_left.2 $ λ h, mod_lt _ (nat.pos_of_ne_zero h), x / y,
   mod_add_div _ _⟩⟩
 
-localized "infix ` D% `:80 := dioph.mod_dioph" in dioph
+localized "infix (name := mod_dioph) ` D% `:80 := dioph.mod_dioph" in dioph
 
 lemma modeq_dioph {h : (α → ℕ) → ℕ} (dh : dioph_fn h) : dioph (λ v, f v ≡ g v [MOD h v]) :=
 df D% dh D= dg D% dh
-localized "notation `D≡` := dioph.modeq_dioph" in dioph
+localized "notation (name := modeq_dioph) ` D≡ ` := dioph.modeq_dioph" in dioph
 
 lemma div_dioph : dioph_fn (λ v, f v / g v) :=
 have dioph (λ v : vector3 ℕ 3, v &2 = 0 ∧ v &0 = 0 ∨ v &0 * v &2 ≤ v &1 ∧ v &1 < (v &0 + 1) * v &2),
@@ -477,9 +493,9 @@ by refine iff.trans _ eq_comm; exact y.eq_zero_or_pos.elim
   (λ y0, by rw [y0, nat.div_zero]; exact
     ⟨λ o, (o.resolve_right $ λ ⟨_, h2⟩, nat.not_lt_zero _ h2).right, λ z0, or.inl ⟨rfl, z0⟩⟩)
   (λ ypos, iff.trans ⟨λ o, o.resolve_left $ λ ⟨h1, _⟩, ne_of_gt ypos h1, or.inr⟩
-    (le_antisymm_iff.trans $ and_congr (nat.le_div_iff_mul_le _ _ ypos) $
-      iff.trans ⟨lt_succ_of_le, le_of_lt_succ⟩ (div_lt_iff_lt_mul _ _ ypos)).symm)
-localized "infix ` D/ `:80 := dioph.div_dioph" in dioph
+    (le_antisymm_iff.trans $ and_congr (nat.le_div_iff_mul_le ypos) $
+      iff.trans ⟨lt_succ_of_le, le_of_lt_succ⟩ (div_lt_iff_lt_mul ypos)).symm)
+localized "infix (name := div_dioph) ` D/ `:80 := dioph.div_dioph" in dioph
 
 omit df dg
 open pell
diff --git a/src/number_theory/diophantine_approximation.lean b/src/number_theory/diophantine_approximation.lean
new file mode 100644
index 0000000000000..772f7e19881e2
--- /dev/null
+++ b/src/number_theory/diophantine_approximation.lean
@@ -0,0 +1,596 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Geißer, Michael Stoll
+-/
+import algebra.continued_fractions.computation.approximation_corollaries
+import algebra.continued_fractions.computation.translations
+import combinatorics.pigeonhole
+import data.int.units
+import data.real.irrational
+import ring_theory.coprime.lemmas
+import tactic.basic
+
+/-!
+# Diophantine Approximation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The first part of this file gives proofs of various versions of
+**Dirichlet's approximation theorem** and its important consequence that when $\xi$ is an
+irrational real number, then there are infinitely many rationals $x/y$ (in lowest terms)
+such that
+$$\left|\xi - \frac{x}{y}\right| < \frac{1}{y^2} \,.$$
+The proof is based on the pigeonhole principle.
+
+The second part of the file gives a proof of **Legendre's Theorem** on rational approximation,
+which states that if $\xi$ is a real number and $x/y$ is a rational number such that
+$$\left|\xi - \frac{x}{y}\right| < \frac{1}{2y^2} \,,$$
+then $x/y$ must be a convergent of the continued fraction expansion of $\xi$.
+
+## Main statements
+
+The main results are three variants of Dirichlet's approximation theorem:
+* `real.exists_int_int_abs_mul_sub_le`, which states that for all real `ξ` and natural `0 < n`,
+  there are integers `j` and `k` with `0 < k ≤ n` and `|k*ξ - j| ≤ 1/(n+1)`,
+* `real.exists_nat_abs_mul_sub_round_le`, which replaces `j` by `round(k*ξ)` and uses
+  a natural number `k`,
+* `real.exists_rat_abs_sub_le_and_denom_le`, which says that there is a rational number `q`
+  satisfying `|ξ - q| ≤ 1/((n+1)*q.denom)` and `q.denom ≤ n`,
+
+and
+* `real.infinite_rat_abs_sub_lt_one_div_denom_sq_of_irrational`, which states that
+  for irrational `ξ`, the set `{q : ℚ | |ξ - q| < 1/q.denom^2}` is infinite.
+
+We also show a converse,
+* `rat.finite_rat_abs_sub_lt_one_div_denom_sq`, which states that the set above is finite
+  when `ξ` is a rational number.
+
+Both statements are combined to give an equivalence,
+`real.infinite_rat_abs_sub_lt_one_div_denom_sq_iff_irrational`.
+
+There are two versions of Legendre's Theorem. One, `real.exists_rat_eq_convergent`, uses
+`real.convergent`, a simple recursive definition of the convergents that is also defined
+in this file, whereas the other, `real.exists_continued_fraction_convergent_eq_rat`, uses
+`generalized_continued_fraction.convergents` of `generalized_continued_fraction.of ξ`.
+
+## Implementation notes
+
+We use the namespace `real` for the results on real numbers and `rat` for the results
+on rational numbers. We introduce a secondary namespace `real.contfrac_legendre`
+to separate off a definition and some technical auxiliary lemmas used in the proof
+of Legendre's Theorem. For remarks on the proof of Legendre's Theorem, see below.
+
+## References
+
+
+ (The German Wikipedia page on continued
+fractions is much more extensive than the English one.)
+
+## Tags
+
+Diophantine approximation, Dirichlet's approximation theorem, continued fraction
+-/
+
+namespace real
+
+section dirichlet
+
+/-!
+### Dirichlet's approximation theorem
+
+We show that for any real number `ξ` and positive natural `n`, there is a fraction `q`
+such that `q.denom ≤ n` and `|ξ - q| ≤ 1/((n+1)*q.denom)`.
+-/
+
+open finset int
+
+/-- *Dirichlet's approximation theorem:*
+For any real number `ξ` and positive natural `n`, there are integers `j` and `k`,
+with `0 < k ≤ n` and `|k*ξ - j| ≤ 1/(n+1)`.
+
+See also `real.exists_nat_abs_mul_sub_round_le`. -/
+lemma exists_int_int_abs_mul_sub_le (ξ : ℝ) {n : ℕ} (n_pos : 0 < n) :
+  ∃ j k : ℤ, 0 < k ∧ k ≤ n ∧ |↑k * ξ - j| ≤ 1 / (n + 1) :=
+begin
+  let f : ℤ → ℤ := λ m, ⌊fract (ξ * m) * (n + 1)⌋,
+  have hn : 0 < (n : ℝ) + 1 := by exact_mod_cast nat.succ_pos _,
+  have hfu := λ m : ℤ, mul_lt_of_lt_one_left hn $ fract_lt_one (ξ * ↑m),
+  conv in (|_| ≤ _) { rw [mul_comm, le_div_iff hn, ← abs_of_pos hn, ← abs_mul], },
+  let D := Icc (0 : ℤ) n,
+  by_cases H : ∃ m ∈ D, f m = n,
+  { obtain ⟨m, hm, hf⟩ := H,
+    have hf' : ((n : ℤ) : ℝ) ≤ fract (ξ * m) * (n + 1) := hf ▸ floor_le (fract (ξ * m) * (n + 1)),
+    have hm₀ : 0 < m,
+    { have hf₀ : f 0 = 0,
+      { simp only [floor_eq_zero_iff, algebra_map.coe_zero, mul_zero, fract_zero, zero_mul,
+                   set.left_mem_Ico, zero_lt_one], },
+      refine ne.lt_of_le (λ h, n_pos.ne _) (mem_Icc.mp hm).1,
+      exact_mod_cast hf₀.symm.trans (h.symm ▸ hf : f 0 = n), },
+    refine ⟨⌊ξ * m⌋ + 1, m, hm₀, (mem_Icc.mp hm).2, _⟩,
+    rw [cast_add, ← sub_sub, sub_mul, cast_one, one_mul, abs_le],
+    refine ⟨le_sub_iff_add_le.mpr _,
+            sub_le_iff_le_add.mpr $ le_of_lt $ (hfu m).trans $ lt_one_add _⟩,
+    simpa only [neg_add_cancel_comm_assoc] using hf', },
+  { simp_rw [not_exists] at H,
+    have hD : (Ico (0 : ℤ) n).card < D.card,
+    { rw [card_Icc, card_Ico], exact lt_add_one n, },
+    have hfu' : ∀ m, f m ≤ n := λ m, lt_add_one_iff.mp (floor_lt.mpr (by exact_mod_cast hfu m)),
+    have hwd : ∀ m : ℤ, m ∈ D → f m ∈ Ico (0 : ℤ) n :=
+      λ x hx, mem_Ico.mpr ⟨floor_nonneg.mpr (mul_nonneg (fract_nonneg (ξ * x)) hn.le),
+                           ne.lt_of_le (H x hx) (hfu' x)⟩,
+    have : ∃ (x : ℤ) (hx : x ∈ D) (y : ℤ) (hy : y ∈ D), x < y ∧ f x = f y,
+    { obtain ⟨x, hx, y, hy, x_ne_y, hxy⟩ := exists_ne_map_eq_of_card_lt_of_maps_to hD hwd,
+      rcases lt_trichotomy x y with h | h | h,
+      exacts [⟨x, hx, y, hy, h, hxy⟩, false.elim (x_ne_y h), ⟨y, hy, x, hx, h, hxy.symm⟩], },
+    obtain ⟨x, hx, y, hy, x_lt_y, hxy⟩ := this,
+    refine ⟨⌊ξ * y⌋ - ⌊ξ * x⌋, y - x, sub_pos_of_lt x_lt_y,
+            sub_le_iff_le_add.mpr $ le_add_of_le_of_nonneg (mem_Icc.mp hy).2 (mem_Icc.mp hx).1, _⟩,
+    convert_to |fract (ξ * y) * (n + 1) - fract (ξ * x) * (n + 1)| ≤ 1,
+    { congr, push_cast, simp only [fract], ring, },
+    exact (abs_sub_lt_one_of_floor_eq_floor hxy.symm).le, }
+end
+
+/-- *Dirichlet's approximation theorem:*
+For any real number `ξ` and positive natural `n`, there is a natural number `k`,
+with `0 < k ≤ n` such that `|k*ξ - round(k*ξ)| ≤ 1/(n+1)`.
+-/
+lemma exists_nat_abs_mul_sub_round_le (ξ : ℝ) {n : ℕ} (n_pos : 0 < n) :
+  ∃ k : ℕ, 0 < k ∧ k ≤ n ∧ |↑k * ξ - round (↑k * ξ)| ≤ 1 / (n + 1) :=
+begin
+  obtain ⟨j, k, hk₀, hk₁, h⟩ := exists_int_int_abs_mul_sub_le ξ n_pos,
+  have hk := to_nat_of_nonneg hk₀.le,
+  rw [← hk] at hk₀ hk₁ h,
+  exact ⟨k.to_nat, coe_nat_pos.mp hk₀, nat.cast_le.mp hk₁, (round_le (↑k.to_nat * ξ) j).trans h⟩,
+end
+
+/-- *Dirichlet's approximation theorem:*
+For any real number `ξ` and positive natural `n`, there is a fraction `q`
+such that `q.denom ≤ n` and `|ξ - q| ≤ 1/((n+1)*q.denom)`. -/
+lemma exists_rat_abs_sub_le_and_denom_le (ξ : ℝ) {n : ℕ} (n_pos : 0 < n) :
+  ∃ q : ℚ, |ξ - q| ≤ 1 / ((n + 1) * q.denom) ∧ q.denom ≤ n :=
+begin
+  obtain ⟨j, k, hk₀, hk₁, h⟩ := exists_int_int_abs_mul_sub_le ξ n_pos,
+  have hk₀' : (0 : ℝ) < k := int.cast_pos.mpr hk₀,
+  have hden : ((j / k : ℚ).denom : ℤ) ≤ k,
+  { convert le_of_dvd hk₀ (rat.denom_dvd j k), exact rat.coe_int_div_eq_mk, },
+  refine ⟨j / k, _, nat.cast_le.mp (hden.trans hk₁)⟩,
+  rw [← div_div, le_div_iff (nat.cast_pos.mpr $ rat.pos _ : (0 : ℝ) < _)],
+  refine (mul_le_mul_of_nonneg_left (int.cast_le.mpr hden : _ ≤ (k : ℝ)) (abs_nonneg _)).trans _,
+  rwa [← abs_of_pos hk₀', rat.cast_div, rat.cast_coe_int, rat.cast_coe_int,
+       ← abs_mul, sub_mul, div_mul_cancel _ hk₀'.ne', mul_comm],
+end
+
+end dirichlet
+
+section rat_approx
+
+/-!
+### Infinitely many good approximations to irrational numbers
+
+We show that an irrational real number `ξ` has infinitely many "good rational approximations",
+i.e., fractions `x/y` in lowest terms such that `|ξ - x/y| < 1/y^2`.
+-/
+
+open set
+
+/-- Given any rational approximation `q` to the irrational real number `ξ`, there is
+a good rational approximation `q'` such that `|ξ - q'| < |ξ - q|`. -/
+lemma exists_rat_abs_sub_lt_and_lt_of_irrational {ξ : ℝ} (hξ : irrational ξ) (q : ℚ) :
+  ∃ q' : ℚ, |ξ - q'| < 1 / q'.denom ^ 2 ∧ |ξ - q'| < |ξ - q| :=
+begin
+  have h := abs_pos.mpr (sub_ne_zero.mpr $ irrational.ne_rat hξ q),
+  obtain ⟨m, hm⟩ := exists_nat_gt (1 / |ξ - q|),
+  have m_pos : (0 : ℝ) < m := (one_div_pos.mpr h).trans hm,
+  obtain ⟨q', hbd, hden⟩ := exists_rat_abs_sub_le_and_denom_le ξ (nat.cast_pos.mp m_pos),
+  have den_pos : (0 : ℝ) < q'.denom := nat.cast_pos.mpr q'.pos,
+  have md_pos := mul_pos (add_pos m_pos zero_lt_one) den_pos,
+  refine ⟨q', lt_of_le_of_lt hbd _,
+          lt_of_le_of_lt hbd $ (one_div_lt md_pos h).mpr $ hm.trans $
+            lt_of_lt_of_le (lt_add_one _) $ (le_mul_iff_one_le_right $
+            add_pos m_pos zero_lt_one).mpr $ by exact_mod_cast (q'.pos : 1 ≤ q'.denom)⟩,
+  rw [sq, one_div_lt_one_div md_pos (mul_pos den_pos den_pos), mul_lt_mul_right den_pos],
+  exact lt_add_of_le_of_pos (nat.cast_le.mpr hden) zero_lt_one,
+end
+
+/-- If `ξ` is an irrational real number, then there are infinitely many good
+rational approximations to `ξ`. -/
+lemma infinite_rat_abs_sub_lt_one_div_denom_sq_of_irrational {ξ : ℝ} (hξ : irrational ξ) :
+  {q : ℚ | |ξ - q| < 1 / q.denom ^ 2}.infinite :=
+begin
+  refine or.resolve_left (set.finite_or_infinite _) (λ h, _),
+  obtain ⟨q, _, hq⟩ := exists_min_image {q : ℚ | |ξ - q| < 1 / q.denom ^ 2} (λ q, |ξ - q|) h
+                                        ⟨⌊ξ⌋, by simp [abs_of_nonneg, int.fract_lt_one]⟩,
+  obtain ⟨q', hmem, hbetter⟩ := exists_rat_abs_sub_lt_and_lt_of_irrational hξ q,
+  exact lt_irrefl _ (lt_of_le_of_lt (hq q' hmem) hbetter),
+end
+
+end rat_approx
+
+end real
+
+namespace rat
+
+/-!
+### Finitely many good approximations to rational numbers
+
+We now show that a rational number `ξ` has only finitely many good rational
+approximations.
+-/
+
+open set
+
+/-- If `ξ` is rational, then the good rational approximations to `ξ` have bounded
+numerator and denominator. -/
+lemma denom_le_and_le_num_le_of_sub_lt_one_div_denom_sq {ξ q : ℚ} (h : |ξ - q| < 1 / q.denom ^ 2) :
+  q.denom ≤ ξ.denom ∧ ⌈ξ * q.denom⌉ - 1 ≤ q.num ∧ q.num ≤ ⌊ξ * q.denom⌋ + 1 :=
+begin
+  have hq₀ : (0 : ℚ) < q.denom := nat.cast_pos.mpr q.pos,
+  replace h : |ξ * q.denom - q.num| < 1 / q.denom,
+  { rw ← mul_lt_mul_right hq₀ at h,
+    conv_lhs at h { rw [← abs_of_pos hq₀, ← abs_mul, sub_mul, mul_denom_eq_num], },
+    rwa [sq, div_mul, mul_div_cancel_left _ hq₀.ne'] at h, },
+  split,
+  { rcases eq_or_ne ξ q with rfl | H,
+    { exact le_rfl, },
+    { have hξ₀ : (0 : ℚ) < ξ.denom := nat.cast_pos.mpr ξ.pos,
+      rw [← rat.num_div_denom ξ, div_mul_eq_mul_div, div_sub' _ _ _ hξ₀.ne', abs_div,
+          abs_of_pos hξ₀, div_lt_iff hξ₀, div_mul_comm, mul_one] at h,
+      refine nat.cast_le.mp (((one_lt_div hq₀).mp $ lt_of_le_of_lt _ h).le),
+      norm_cast,
+      rw [mul_comm _ q.num],
+      exact int.one_le_abs (sub_ne_zero_of_ne $ mt rat.eq_iff_mul_eq_mul.mpr H), } },
+  { obtain ⟨h₁, h₂⟩ := abs_sub_lt_iff.mp (h.trans_le $ (one_div_le zero_lt_one hq₀).mp $
+                        (@one_div_one ℚ _).symm ▸ nat.cast_le.mpr q.pos),
+    rw [sub_lt_iff_lt_add, add_comm] at h₁ h₂,
+    rw [← sub_lt_iff_lt_add] at h₂,
+    norm_cast at h₁ h₂,
+    exact ⟨sub_le_iff_le_add.mpr (int.ceil_le.mpr h₁.le),
+           sub_le_iff_le_add.mp (int.le_floor.mpr h₂.le)⟩, }
+end
+
+/-- A rational number has only finitely many good rational approximations. -/
+lemma finite_rat_abs_sub_lt_one_div_denom_sq (ξ : ℚ) :
+  {q : ℚ | |ξ - q| < 1 / q.denom ^ 2}.finite :=
+begin
+  let f : ℚ → ℤ × ℕ := λ q, (q.num, q.denom),
+  set s := {q : ℚ | |ξ - q| < 1 / q.denom ^ 2},
+  have hinj : function.injective f,
+  { intros a b hab,
+    simp only [prod.mk.inj_iff] at hab,
+    rw [← rat.num_div_denom a, ← rat.num_div_denom b, hab.1, hab.2], },
+  have H : f '' s ⊆ ⋃ (y : ℕ) (hy : y ∈ Ioc 0 ξ.denom), Icc (⌈ξ * y⌉ - 1) (⌊ξ * y⌋ + 1) ×ˢ {y},
+  { intros xy hxy,
+    simp only [mem_image, mem_set_of_eq] at hxy,
+    obtain ⟨q, hq₁, hq₂⟩ := hxy,
+    obtain ⟨hd, hn⟩ := denom_le_and_le_num_le_of_sub_lt_one_div_denom_sq hq₁,
+    simp_rw [mem_Union],
+    refine ⟨q.denom, set.mem_Ioc.mpr ⟨q.pos, hd⟩, _⟩,
+    simp only [prod_singleton, mem_image, mem_Icc, (congr_arg prod.snd (eq.symm hq₂)).trans rfl],
+    exact ⟨q.num, hn, hq₂⟩, },
+  refine finite.of_finite_image (finite.subset _ H) (inj_on_of_injective hinj s),
+  exact finite.bUnion (finite_Ioc _ _) (λ x hx, finite.prod (finite_Icc _ _) (finite_singleton _)),
+end
+
+end rat
+
+/-- The set of good rational approximations to a real number `ξ` is infinite if and only if
+`ξ` is irrational. -/
+lemma real.infinite_rat_abs_sub_lt_one_div_denom_sq_iff_irrational (ξ : ℝ) :
+  {q : ℚ | |ξ - q| < 1 / q.denom ^ 2}.infinite ↔ irrational ξ :=
+begin
+  refine ⟨λ h, (irrational_iff_ne_rational ξ).mpr (λ a b H, set.not_infinite.mpr _ h),
+          real.infinite_rat_abs_sub_lt_one_div_denom_sq_of_irrational⟩,
+  convert rat.finite_rat_abs_sub_lt_one_div_denom_sq ((a : ℚ) / b),
+  ext q,
+  rw [H, (by push_cast : (1 : ℝ) / q.denom ^ 2 = (1 / q.denom ^ 2 : ℚ))],
+  norm_cast,
+end
+
+/-!
+### Legendre's Theorem on Rational Approximation
+
+We prove **Legendre's Theorem** on rational approximation: If $\xi$ is a real number and
+$x/y$ is a rational number such that $|\xi - x/y| < 1/(2y^2)$,
+then $x/y$ is a convergent of the continued fraction expansion of $\xi$.
+
+The proof is by induction. However, the induction proof does not work with the
+statement as given, since the assumption is too weak to imply the corresponding
+statement for the application of the induction hypothesis. This can be remedied
+by making the statement slightly stronger. Namely, we assume that $|\xi - x/y| < 1/(y(2y-1))$
+when $y \ge 2$ and $-\frac{1}{2} < \xi - x < 1$ when $y = 1$.
+-/
+
+section convergent
+
+namespace real
+
+open int
+
+/-!
+### Convergents: definition and API lemmas
+-/
+
+/-- We give a direct recursive definition of the convergents of the continued fraction
+expansion of a real number `ξ`. The main reason for that is that we want to have the
+convergents as rational numbers; the versions
+`(generalized_continued_fraction.of ξ).convergents` and
+`(generalized_continued_fraction.of ξ).convergents'` always give something of the
+same type as `ξ`. We can then also use dot notation `ξ.convergent n`.
+Another minor reason is that this demonstrates that the proof
+of Legendre's theorem does not need anything beyond this definition.
+We provide a proof that this definition agrees with the other one;
+see `real.continued_fraction_convergent_eq_convergent`.
+(Note that we use the fact that `1/0 = 0` here to make it work for rational `ξ`.) -/
+noncomputable def convergent : ℝ → ℕ → ℚ
+| ξ 0 := ⌊ξ⌋
+| ξ (n + 1) := ⌊ξ⌋ + (convergent (fract ξ)⁻¹ n)⁻¹
+
+/-- The zeroth convergent of `ξ` is `⌊ξ⌋`. -/
+@[simp]
+lemma convergent_zero (ξ : ℝ) : ξ.convergent 0 = ⌊ξ⌋ := rfl
+
+/-- The `(n+1)`th convergent of `ξ` is the `n`th convergent of `1/(fract ξ)`. -/
+@[simp]
+lemma convergent_succ (ξ : ℝ) (n : ℕ) :
+  ξ.convergent (n + 1) = ⌊ξ⌋ + ((fract ξ)⁻¹.convergent n)⁻¹ :=
+by simp only [convergent]
+
+/-- All convergents of `0` are zero. -/
+@[simp]
+lemma convergent_of_zero (n : ℕ) : convergent 0 n = 0 :=
+begin
+  induction n with n ih,
+  { simp only [convergent_zero, floor_zero, cast_zero], },
+  { simp only [ih, convergent_succ, floor_zero, cast_zero, fract_zero, add_zero, inv_zero], }
+end
+
+/-- If `ξ` is an integer, all its convergents equal `ξ`. -/
+@[simp]
+lemma convergent_of_int {ξ : ℤ} (n : ℕ) : convergent ξ n = ξ :=
+begin
+  cases n,
+  { simp only [convergent_zero, floor_int_cast], },
+  { simp only [convergent_succ, floor_int_cast, fract_int_cast, convergent_of_zero, add_zero,
+               inv_zero], }
+end
+
+/-!
+Our `convergent`s agree with `generalized_continued_fraction.convergents`.
+-/
+
+open generalized_continued_fraction
+
+/-- The `n`th convergent of the `generalized_continued_fraction.of ξ`
+agrees with `ξ.convergent n`. -/
+lemma continued_fraction_convergent_eq_convergent (ξ : ℝ) (n : ℕ) :
+  (generalized_continued_fraction.of ξ).convergents n = ξ.convergent n :=
+begin
+  induction n with n ih generalizing ξ,
+  { simp only [zeroth_convergent_eq_h, of_h_eq_floor, convergent_zero, rat.cast_coe_int], },
+  { rw [convergents_succ, ih (fract ξ)⁻¹, convergent_succ, one_div],
+    norm_cast, }
+end
+
+end real
+
+end convergent
+
+/-!
+### The key technical condition for the induction proof
+-/
+
+namespace real
+
+open int
+
+/-- Define the technical condition to be used as assumption in the inductive proof. -/
+-- this is not `private`, as it is used in the public `exists_rat_eq_convergent'` below.
+def contfrac_legendre.ass (ξ : ℝ) (u v : ℤ) : Prop :=
+is_coprime u v ∧ (v = 1 → (-(1 / 2) : ℝ) < ξ - u) ∧ |ξ - u / v| < (v * (2 * v - 1))⁻¹
+
+-- ### Auxiliary lemmas
+
+-- This saves a few lines below, as it is frequently needed.
+private lemma aux₀ {v : ℤ} (hv : 0 < v) : (0 : ℝ) < v ∧ (0 : ℝ) < 2 * v - 1 :=
+⟨cast_pos.mpr hv, by {norm_cast, linarith}⟩
+
+-- In the following, we assume that `ass ξ u v` holds and `v ≥ 2`.
+
+variables {ξ : ℝ} {u v : ℤ} (hv : 2 ≤ v) (h : contfrac_legendre.ass ξ u v)
+include hv h
+
+-- The fractional part of `ξ` is positive.
+private lemma aux₁ : 0 < fract ξ :=
+begin
+  have hv₀ : (0 : ℝ) < v := cast_pos.mpr (zero_lt_two.trans_le hv),
+  obtain ⟨hv₁, hv₂⟩ := aux₀ (zero_lt_two.trans_le hv),
+  obtain ⟨hcop, _, h⟩ := h,
+  refine fract_pos.mpr (λ hf, _),
+  rw [hf] at h,
+  have H : (2 * v - 1 : ℝ) < 1,
+  { refine (mul_lt_iff_lt_one_right hv₀).mp
+             ((inv_lt_inv hv₀ (mul_pos hv₁ hv₂)).mp (lt_of_le_of_lt _ h)),
+    have h' : (⌊ξ⌋ : ℝ) - u / v = (⌊ξ⌋ * v - u) / v := by field_simp [hv₀.ne'],
+    rw [h', abs_div, abs_of_pos hv₀, ← one_div, div_le_div_right hv₀],
+    norm_cast,
+    rw [← zero_add (1 : ℤ), add_one_le_iff, abs_pos, sub_ne_zero],
+    rintro rfl,
+    cases is_unit_iff.mp (is_coprime_self.mp (is_coprime.mul_left_iff.mp hcop).2); linarith, },
+  norm_cast at H,
+  linarith only [hv, H],
+end
+
+-- An auxiliary lemma for the inductive step.
+private lemma aux₂ : 0 < u - ⌊ξ⌋ * v ∧ u - ⌊ξ⌋ * v < v :=
+begin
+  obtain ⟨hcop, _, h⟩ := h,
+  obtain ⟨hv₀, hv₀'⟩ := aux₀ (zero_lt_two.trans_le hv),
+  have hv₁ : 0 < 2 * v - 1 := by linarith only [hv],
+  rw [← one_div, lt_div_iff (mul_pos hv₀ hv₀'), ← abs_of_pos (mul_pos hv₀ hv₀'), ← abs_mul,
+      sub_mul, ← mul_assoc, ← mul_assoc, div_mul_cancel _ hv₀.ne', abs_sub_comm, abs_lt,
+      lt_sub_iff_add_lt, sub_lt_iff_lt_add, mul_assoc] at h,
+  have hu₀ : 0 ≤ u - ⌊ξ⌋ * v,
+  { refine (zero_le_mul_right hv₁).mp ((lt_iff_add_one_le (-1 : ℤ) _).mp _),
+    replace h := h.1,
+    rw [← lt_sub_iff_add_lt, ← mul_assoc, ← sub_mul] at h,
+    exact_mod_cast h.trans_le ((mul_le_mul_right $ hv₀').mpr $
+             (sub_le_sub_iff_left (u : ℝ)).mpr ((mul_le_mul_right hv₀).mpr (floor_le ξ))), },
+  have hu₁ : u - ⌊ξ⌋ * v ≤ v,
+  { refine le_of_mul_le_mul_right (le_of_lt_add_one _) hv₁,
+    replace h := h.2,
+    rw [← sub_lt_iff_lt_add, ← mul_assoc, ← sub_mul,
+        ← add_lt_add_iff_right (v * (2 * v - 1) : ℝ), add_comm (1 : ℝ)] at h,
+    have := (mul_lt_mul_right $ hv₀').mpr ((sub_lt_sub_iff_left (u : ℝ)).mpr $
+               (mul_lt_mul_right hv₀).mpr $ sub_right_lt_of_lt_add $ lt_floor_add_one ξ),
+    rw [sub_mul ξ, one_mul, ← sub_add, add_mul] at this,
+    exact_mod_cast this.trans h, },
+  have huv_cop : is_coprime (u - ⌊ξ⌋ * v) v,
+  { rwa [sub_eq_add_neg, ← neg_mul, is_coprime.add_mul_right_left_iff], },
+  refine ⟨lt_of_le_of_ne' hu₀ (λ hf, _), lt_of_le_of_ne hu₁ (λ hf, _)⟩;
+  { rw hf at huv_cop,
+    simp only [is_coprime_zero_left, is_coprime_self, is_unit_iff] at huv_cop,
+    cases huv_cop; linarith only [hv, huv_cop], },
+end
+
+-- The key step: the relevant inequality persists in the inductive step.
+private
+lemma aux₃ : |(fract ξ)⁻¹ - v / (u - ⌊ξ⌋ * v)| < ((u - ⌊ξ⌋ * v) * (2 * (u - ⌊ξ⌋ * v) - 1))⁻¹ :=
+begin
+  obtain ⟨hu₀, huv⟩ := aux₂ hv h,
+  have hξ₀ := aux₁ hv h,
+  set u' := u - ⌊ξ⌋ * v with hu',
+  have hu'ℝ : (u' : ℝ) = u - ⌊ξ⌋ * v := by exact_mod_cast hu',
+  rw ← hu'ℝ,
+  replace hu'ℝ := (eq_sub_iff_add_eq.mp hu'ℝ).symm,
+  obtain ⟨Hu, Hu'⟩ := aux₀ hu₀,
+  obtain ⟨Hv, Hv'⟩ := aux₀ (zero_lt_two.trans_le hv),
+  have H₁ := div_pos (div_pos Hv Hu) hξ₀,
+  replace h := h.2.2,
+  have h' : |fract ξ - u' / v| < (v * (2 * v - 1))⁻¹,
+  { rwa [hu'ℝ, add_div, mul_div_cancel _ Hv.ne', ← sub_sub, sub_right_comm] at h, },
+  have H : (2 * u' - 1 : ℝ) ≤ (2 * v - 1) * fract ξ,
+  { replace h := (abs_lt.mp h).1,
+    have : (2 * (v : ℝ) - 1) * (-(v * (2 * v - 1))⁻¹ + u' / v) = 2 * u' - (1 + u') / v,
+    { field_simp [Hv.ne', Hv'.ne'], ring, },
+    rw [hu'ℝ, add_div, mul_div_cancel _ Hv.ne', ← sub_sub, sub_right_comm, self_sub_floor,
+        lt_sub_iff_add_lt, ← mul_lt_mul_left Hv', this] at h,
+    refine has_le.le.trans _ h.le,
+    rw [sub_le_sub_iff_left, div_le_one Hv, add_comm],
+    exact_mod_cast huv, },
+  have help₁ : ∀ {a b c : ℝ}, a ≠ 0 → b ≠ 0 → c ≠ 0 →
+                 |a⁻¹ - b / c| = |(a - c / b) * (b / c / a)|,
+  { intros, rw abs_sub_comm, congr' 1, field_simp, ring },
+  have help₂ : ∀ {a b c d : ℝ}, a ≠ 0 → b ≠ 0 → c ≠ 0 → d ≠ 0 →
+                 (b * c)⁻¹ * (b / d / a) = (d * c * a)⁻¹,
+  { intros, field_simp, ring },
+  calc
+    |(fract ξ)⁻¹ - v / u'|
+        = |(fract ξ - u' / v) * (v / u' / fract ξ)| : help₁ hξ₀.ne' Hv.ne' Hu.ne'
+    ... = |fract ξ - u' / v| * (v / u' / fract ξ) :   by rw [abs_mul, abs_of_pos H₁, abs_sub_comm]
+    ... < (v * (2 * v - 1))⁻¹ * (v / u' / fract ξ) :  (mul_lt_mul_right H₁).mpr h'
+    ... = (u' * (2 * v - 1) * fract ξ)⁻¹ :            help₂ hξ₀.ne' Hv.ne' Hv'.ne' Hu.ne'
+    ... ≤ (u' * (2 * u' - 1))⁻¹ : by rwa [inv_le_inv (mul_pos (mul_pos Hu Hv') hξ₀) $
+                                              mul_pos Hu Hu', mul_assoc, mul_le_mul_left Hu],
+end
+
+-- The conditions `ass ξ u v` persist in the inductive step.
+private lemma invariant : contfrac_legendre.ass (fract ξ)⁻¹ v (u - ⌊ξ⌋ * v) :=
+begin
+  refine ⟨_, λ huv, _, by exact_mod_cast aux₃ hv h⟩,
+  { rw [sub_eq_add_neg, ← neg_mul, is_coprime_comm, is_coprime.add_mul_right_left_iff],
+    exact h.1, },
+  { obtain ⟨hv₀, hv₀'⟩ := aux₀ (zero_lt_two.trans_le hv),
+    have Hv : (v * (2 * v - 1) : ℝ)⁻¹ + v⁻¹ = 2 / (2 * v - 1),
+    { field_simp [hv₀.ne', hv₀'.ne'], ring, },
+    have Huv : (u / v : ℝ) = ⌊ξ⌋ + v⁻¹,
+    { rw [sub_eq_iff_eq_add'.mp huv], field_simp [hv₀.ne'], },
+    have h' := (abs_sub_lt_iff.mp h.2.2).1,
+    rw [Huv, ← sub_sub, sub_lt_iff_lt_add, self_sub_floor, Hv] at h',
+    rwa [lt_sub_iff_add_lt', (by ring : (v : ℝ) + -(1 / 2) = (2 * v - 1) / 2),
+         lt_inv (div_pos hv₀' zero_lt_two) (aux₁ hv h), inv_div], }
+end
+
+omit h hv
+
+/-!
+### The main result
+-/
+
+/-- The technical version of *Legendre's Theorem*. -/
+lemma exists_rat_eq_convergent' {v : ℕ} (h : contfrac_legendre.ass ξ u v) :
+  ∃ n, (u / v : ℚ) = ξ.convergent n :=
+begin
+  induction v using nat.strong_induction_on with v ih generalizing ξ u,
+  rcases lt_trichotomy v 1 with ht | rfl | ht,
+  { replace h := h.2.2,
+    simp only [nat.lt_one_iff.mp ht, nat.cast_zero, div_zero, tsub_zero, zero_mul, cast_zero,
+               inv_zero] at h,
+    exact false.elim (lt_irrefl _ $ (abs_nonneg ξ).trans_lt h), },
+  { rw [nat.cast_one, div_one],
+    obtain ⟨_, h₁, h₂⟩ := h,
+    cases le_or_lt (u : ℝ) ξ with ht ht,
+    { use 0,
+      rw [convergent_zero, rat.coe_int_inj, eq_comm, floor_eq_iff],
+      convert and.intro ht (sub_lt_iff_lt_add'.mp (abs_lt.mp h₂).2); norm_num, },
+    { replace h₁ := lt_sub_iff_add_lt'.mp (h₁ rfl),
+      have hξ₁ : ⌊ξ⌋ = u - 1,
+      { rw [floor_eq_iff, cast_sub, cast_one, sub_add_cancel],
+        exact ⟨(((sub_lt_sub_iff_left _).mpr one_half_lt_one).trans h₁).le, ht⟩, },
+      cases eq_or_ne ξ ⌊ξ⌋ with Hξ Hξ,
+      { rw [Hξ, hξ₁, cast_sub, cast_one, ← sub_eq_add_neg, sub_lt_sub_iff_left] at h₁,
+        exact false.elim (lt_irrefl _ $ h₁.trans one_half_lt_one), },
+      { have hξ₂ : ⌊(fract ξ)⁻¹⌋ = 1,
+        { rw [floor_eq_iff, cast_one, le_inv zero_lt_one (fract_pos.mpr Hξ), inv_one,
+              one_add_one_eq_two, inv_lt (fract_pos.mpr Hξ) zero_lt_two],
+          refine ⟨(fract_lt_one ξ).le, _⟩,
+          rw [fract, hξ₁, cast_sub, cast_one, lt_sub_iff_add_lt', sub_add],
+          convert h₁,
+          norm_num, },
+        use 1,
+        simp [convergent, hξ₁, hξ₂, cast_sub, cast_one], } } },
+  { obtain ⟨huv₀, huv₁⟩ := aux₂ (nat.cast_le.mpr  ht) h,
+    have Hv : (v : ℚ) ≠ 0 := (nat.cast_pos.mpr (zero_lt_one.trans ht)).ne',
+    have huv₁' : (u - ⌊ξ⌋ * v).to_nat < v := by { zify, rwa to_nat_of_nonneg huv₀.le, },
+    have inv : contfrac_legendre.ass (fract ξ)⁻¹ v (u - ⌊ξ⌋ * ↑v).to_nat :=
+    (to_nat_of_nonneg huv₀.le).symm ▸ invariant (nat.cast_le.mpr ht) h,
+    obtain ⟨n, hn⟩ := ih (u - ⌊ξ⌋ * v).to_nat huv₁' inv,
+    use (n + 1),
+    rw [convergent_succ, ← hn,
+        (by exact_mod_cast to_nat_of_nonneg huv₀.le : ((u - ⌊ξ⌋ * v).to_nat : ℚ) = u - ⌊ξ⌋ * v),
+        ← coe_coe, inv_div, sub_div, mul_div_cancel _ Hv, add_sub_cancel'_right], }
+end
+
+/-- The main result, *Legendre's Theorem* on rational approximation:
+if `ξ` is a real number and  `q` is a rational number such that `|ξ - q| < 1/(2*q.denom^2)`,
+then `q` is a convergent of the continued fraction expansion of `ξ`.
+This version uses `real.convergent`. -/
+lemma exists_rat_eq_convergent {q : ℚ} (h : |ξ - q| < 1 / (2 * q.denom ^ 2)) :
+  ∃ n, q = ξ.convergent n :=
+begin
+  refine q.num_div_denom ▸ exists_rat_eq_convergent' ⟨_, λ hd, _, _⟩,
+  { exact coprime_iff_nat_coprime.mpr (nat_abs_of_nat q.denom ▸ q.cop), },
+  { rw ← q.denom_eq_one_iff.mp (nat.cast_eq_one.mp hd) at h,
+    simpa only [rat.coe_int_denom, nat.cast_one, one_pow, mul_one] using (abs_lt.mp h).1 },
+  { obtain ⟨hq₀, hq₁⟩ := aux₀ (nat.cast_pos.mpr q.pos),
+    replace hq₁ := mul_pos hq₀ hq₁,
+    have hq₂ : (0 : ℝ) < 2 * (q.denom * q.denom) := mul_pos zero_lt_two (mul_pos hq₀ hq₀),
+    rw ← coe_coe at *,
+    rw [(by norm_cast : (q.num / q.denom : ℝ) = (q.num / q.denom : ℚ)), rat.num_div_denom],
+    exact h.trans
+          (by {rw [← one_div, sq, one_div_lt_one_div hq₂ hq₁, ← sub_pos], ring_nf, exact hq₀}), }
+end
+
+/-- The main result, *Legendre's Theorem* on rational approximation:
+if `ξ` is a real number and  `q` is a rational number such that `|ξ - q| < 1/(2*q.denom^2)`,
+then `q` is a convergent of the continued fraction expansion of `ξ`.
+This is the version using `generalized_contined_fraction.convergents`. -/
+lemma exists_continued_fraction_convergent_eq_rat {q : ℚ} (h : |ξ - q| < 1 / (2 * q.denom ^ 2)) :
+  ∃ n, (generalized_continued_fraction.of ξ).convergents n = q :=
+begin
+  obtain ⟨n, hn⟩ := exists_rat_eq_convergent h,
+  exact ⟨n, hn.symm ▸ continued_fraction_convergent_eq_convergent ξ n⟩,
+end
+
+end real
diff --git a/src/number_theory/divisors.lean b/src/number_theory/divisors.lean
index c2fcf48645ec3..f069d24981d60 100644
--- a/src/number_theory/divisors.lean
+++ b/src/number_theory/divisors.lean
@@ -5,11 +5,14 @@ Authors: Aaron Anderson
 -/
 import algebra.big_operators.order
 import data.nat.interval
-import data.nat.prime
+import data.nat.factors
 
 /-!
 # Divisor finsets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines sets of divisors of a natural number. This is particularly useful as background
 for defining Dirichlet convolution.
 
@@ -45,52 +48,57 @@ def proper_divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.
 /-- `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
   As a special case, `divisors_antidiagonal 0 = ∅`. -/
 def divisors_antidiagonal : finset (ℕ × ℕ) :=
-((finset.Ico 1 (n + 1)).product (finset.Ico 1 (n + 1))).filter (λ x, x.fst * x.snd = n)
+(Ico 1 (n + 1) ×ˢ Ico 1 (n + 1)).filter (λ x, x.fst * x.snd = n)
 
 variable {n}
 
-lemma proper_divisors.not_self_mem : ¬ n ∈ proper_divisors n :=
+@[simp]
+lemma filter_dvd_eq_divisors (h : n ≠ 0) :
+  (finset.range n.succ).filter (∣ n) = n.divisors :=
 begin
-  rw proper_divisors,
-  simp,
+  ext,
+  simp only [divisors, mem_filter, mem_range, mem_Ico, and.congr_left_iff, iff_and_self],
+  exact λ ha _, succ_le_iff.mpr (pos_of_dvd_of_pos ha h.bot_lt),
 end
 
+@[simp]
+lemma filter_dvd_eq_proper_divisors (h : n ≠ 0) :
+  (finset.range n).filter (∣ n) = n.proper_divisors :=
+begin
+  ext,
+  simp only [proper_divisors, mem_filter, mem_range, mem_Ico, and.congr_left_iff, iff_and_self],
+  exact λ ha _, succ_le_iff.mpr (pos_of_dvd_of_pos ha h.bot_lt),
+end
+
+lemma proper_divisors.not_self_mem : ¬ n ∈ proper_divisors n :=
+by simp [proper_divisors]
+
 @[simp]
 lemma mem_proper_divisors {m : ℕ} : n ∈ proper_divisors m ↔ n ∣ m ∧ n < m :=
 begin
-  rw [proper_divisors, finset.mem_filter, finset.mem_Ico, and_comm],
-  apply and_congr_right,
-  rw and_iff_right_iff_imp,
-  intros hdvd hlt,
-  apply nat.pos_of_ne_zero _,
-  rintro rfl,
-  rw zero_dvd_iff.1 hdvd at hlt,
-  apply lt_irrefl 0 hlt,
+  rcases eq_or_ne m 0 with rfl | hm, { simp [proper_divisors] },
+  simp only [and_comm, ←filter_dvd_eq_proper_divisors hm, mem_filter, mem_range],
 end
 
-lemma divisors_eq_proper_divisors_insert_self_of_pos (h : 0 < n):
-  divisors n = has_insert.insert n (proper_divisors n) :=
-by rw [divisors, proper_divisors, Ico_succ_right_eq_insert_Ico h, finset.filter_insert,
-  if_pos (dvd_refl n)]
+lemma insert_self_proper_divisors (h : n ≠ 0): insert n (proper_divisors n) = divisors n :=
+by rw [divisors, proper_divisors, Ico_succ_right_eq_insert_Ico (one_le_iff_ne_zero.2 h),
+  finset.filter_insert, if_pos (dvd_refl n)]
+
+lemma cons_self_proper_divisors (h : n ≠ 0) :
+  cons n (proper_divisors n) proper_divisors.not_self_mem = divisors n :=
+by rw [cons_eq_insert, insert_self_proper_divisors h]
 
 @[simp]
-lemma mem_divisors {m : ℕ} :
-  n ∈ divisors m ↔ (n ∣ m ∧ m ≠ 0) :=
+lemma mem_divisors {m : ℕ} : n ∈ divisors m ↔ (n ∣ m ∧ m ≠ 0) :=
 begin
-  cases m,
-  { simp [divisors] },
-  simp only [divisors, finset.mem_Ico, ne.def, finset.mem_filter, succ_ne_zero, and_true,
-             and_iff_right_iff_imp, not_false_iff],
-  intro hdvd,
-  split,
-  { apply nat.pos_of_ne_zero,
-    rintro rfl,
-    apply nat.succ_ne_zero,
-    rwa zero_dvd_iff at hdvd },
-  { rw nat.lt_succ_iff,
-    apply nat.le_of_dvd (nat.succ_pos m) hdvd }
+  rcases eq_or_ne m 0 with rfl | hm, { simp [divisors] },
+  simp only [hm, ne.def, not_false_iff, and_true, ←filter_dvd_eq_divisors hm, mem_filter,
+    mem_range, and_iff_right_iff_imp, lt_succ_iff],
+  exact le_of_dvd hm.bot_lt,
 end
 
+lemma one_mem_divisors : 1 ∈ divisors n ↔ n ≠ 0 := by simp
+
 lemma mem_divisors_self (n : ℕ) (h : n ≠ 0) : n ∈ n.divisors := mem_divisors.2 ⟨dvd_rfl, h⟩
 
 lemma dvd_of_mem_divisors {m : ℕ} (h : n ∈ divisors m) : n ∣ m :=
@@ -149,31 +157,19 @@ lemma divisors_zero : divisors 0 = ∅ := by { ext, simp }
 lemma proper_divisors_zero : proper_divisors 0 = ∅ := by { ext, simp }
 
 lemma proper_divisors_subset_divisors : proper_divisors n ⊆ divisors n :=
-begin
-  cases n,
-  { simp },
-  rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _)],
-  apply subset_insert,
-end
+filter_subset_filter _ $ Ico_subset_Ico_right n.le_succ
 
 @[simp]
 lemma divisors_one : divisors 1 = {1} := by { ext, simp }
 
 @[simp]
 lemma proper_divisors_one : proper_divisors 1 = ∅ :=
-begin
-  ext,
-  simp only [finset.not_mem_empty, nat.dvd_one, not_and, not_lt, mem_proper_divisors, iff_false],
-  apply ge_of_eq,
-end
+by rw [proper_divisors, Ico_self, filter_empty]
 
 lemma pos_of_mem_divisors {m : ℕ} (h : m ∈ n.divisors) : 0 < m :=
 begin
   cases m,
-  { rw [mem_divisors, zero_dvd_iff] at h,
-    rcases h with ⟨rfl, h⟩,
-    exfalso,
-    apply h rfl },
+  { rw [mem_divisors, zero_dvd_iff] at h, cases h.2 h.1 },
   apply nat.succ_pos,
 end
 
@@ -189,14 +185,11 @@ lemma divisors_antidiagonal_zero : divisors_antidiagonal 0 = ∅ := by { ext, si
 
 @[simp]
 lemma divisors_antidiagonal_one : divisors_antidiagonal 1 = {(1,1)} :=
-by { ext, simp [nat.mul_eq_one_iff, prod.ext_iff], }
+by { ext, simp [mul_eq_one, prod.ext_iff], }
 
-lemma swap_mem_divisors_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
-  x.swap ∈ divisors_antidiagonal n :=
-begin
-  rw [mem_divisors_antidiagonal, mul_comm] at h,
-  simp [h.1, h.2],
-end
+@[simp] lemma swap_mem_divisors_antidiagonal {x : ℕ × ℕ} :
+  x.swap ∈ divisors_antidiagonal n ↔ x ∈ divisors_antidiagonal n :=
+by rw [mem_divisors_antidiagonal, mem_divisors_antidiagonal, mul_comm, prod.swap]
 
 lemma fst_mem_divisors_of_mem_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
   x.fst ∈ divisors n :=
@@ -214,28 +207,53 @@ end
 
 @[simp]
 lemma map_swap_divisors_antidiagonal :
-  (divisors_antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩
-  = divisors_antidiagonal n :=
+  (divisors_antidiagonal n).map (equiv.prod_comm _ _).to_embedding = divisors_antidiagonal n :=
 begin
+  rw [← coe_inj, coe_map, equiv.coe_to_embedding, equiv.coe_prod_comm,
+    set.image_swap_eq_preimage_swap],
   ext,
-  simp only [exists_prop, mem_divisors_antidiagonal, finset.mem_map, function.embedding.coe_fn_mk,
-             ne.def, prod.swap_prod_mk, prod.exists],
+  exact swap_mem_divisors_antidiagonal,
+end
+
+@[simp] lemma image_fst_divisors_antidiagonal :
+  (divisors_antidiagonal n).image prod.fst = divisors n :=
+by { ext, simp [has_dvd.dvd, @eq_comm _ n (_ * _)] }
+
+@[simp] lemma image_snd_divisors_antidiagonal :
+  (divisors_antidiagonal n).image prod.snd = divisors n :=
+begin
+  rw [←map_swap_divisors_antidiagonal, map_eq_image, image_image],
+  exact image_fst_divisors_antidiagonal
+end
+
+lemma map_div_right_divisors :
+  n.divisors.map ⟨λ d, (d, n/d), λ p₁ p₂, congr_arg prod.fst⟩ = n.divisors_antidiagonal :=
+begin
+  ext ⟨d, nd⟩,
+  simp only [mem_map, mem_divisors_antidiagonal, function.embedding.coe_fn_mk, mem_divisors,
+    prod.ext_iff, exists_prop, and.left_comm, exists_eq_left],
   split,
-  { rintros ⟨x, y, ⟨⟨rfl, h⟩, rfl⟩⟩,
-    simp [mul_comm, h], },
-  { rintros ⟨rfl, h⟩,
-    use [a.snd, a.fst],
-    rw mul_comm,
-    simp [h] }
+  { rintro ⟨⟨⟨k, rfl⟩, hn⟩, rfl⟩,
+    rw [nat.mul_div_cancel_left _ (left_ne_zero_of_mul hn).bot_lt],
+    exact ⟨rfl, hn⟩ },
+  { rintro ⟨rfl, hn⟩,
+    exact ⟨⟨dvd_mul_right _ _, hn⟩, nat.mul_div_cancel_left _ (left_ne_zero_of_mul hn).bot_lt⟩ }
+end
+
+lemma map_div_left_divisors :
+  n.divisors.map ⟨λ d, (n/d, d), λ p₁ p₂, congr_arg prod.snd⟩ = n.divisors_antidiagonal :=
+begin
+  apply finset.map_injective (equiv.prod_comm _ _).to_embedding,
+  rw [map_swap_divisors_antidiagonal, ←map_div_right_divisors, finset.map_map],
+  refl,
 end
 
 lemma sum_divisors_eq_sum_proper_divisors_add_self :
-∑ i in divisors n, i = ∑ i in proper_divisors n, i + n :=
+  ∑ i in divisors n, i = ∑ i in proper_divisors n, i + n :=
 begin
-  cases n,
+  rcases decidable.eq_or_ne n 0 with rfl|hn,
   { simp },
-  { rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _),
-        finset.sum_insert (proper_divisors.not_self_mem), add_comm] }
+  { rw [← cons_self_proper_divisors hn, finset.sum_cons, add_comm] }
 end
 
 /-- `n : ℕ` is perfect if and only the sum of the proper divisors of `n` is `n` and `n`
@@ -267,9 +285,8 @@ end
 
 lemma prime.proper_divisors {p : ℕ} (pp : p.prime) :
   proper_divisors p = {1} :=
-by rw [← erase_insert (proper_divisors.not_self_mem),
-    ← divisors_eq_proper_divisors_insert_self_of_pos pp.pos,
-    pp.divisors, insert_singleton_comm, erase_insert (λ con, pp.ne_one (mem_singleton.1 con))]
+by rw [← erase_insert proper_divisors.not_self_mem, insert_self_proper_divisors pp.ne_zero,
+    pp.divisors, pair_comm, erase_insert (λ con, pp.ne_one (mem_singleton.1 con))]
 
 lemma divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) :
   divisors (p ^ k) = (finset.range (k + 1)).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
@@ -322,8 +339,7 @@ by simp [h.proper_divisors]
 @[simp, to_additive]
 lemma prime.prod_divisors {α : Type*} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
   ∏ x in p.divisors, f x = f p * f 1 :=
-by rw [divisors_eq_proper_divisors_insert_self_of_pos h.pos,
-       prod_insert proper_divisors.not_self_mem, h.prod_proper_divisors]
+by rw [← cons_self_proper_divisors h.ne_zero, prod_cons, h.prod_proper_divisors]
 
 lemma proper_divisors_eq_singleton_one_iff_prime :
   n.proper_divisors = {1} ↔ n.prime :=
@@ -385,25 +401,8 @@ by simp [h, divisors_prime_pow]
 lemma prod_divisors_antidiagonal {M : Type*} [comm_monoid M] (f : ℕ → ℕ → M) {n : ℕ} :
   ∏ i in n.divisors_antidiagonal, f i.1 i.2 = ∏ i in n.divisors, f i (n / i) :=
 begin
-  refine prod_bij (λ i _, i.1) _ _ _ _,
-  { intro i,
-    apply fst_mem_divisors_of_mem_antidiagonal },
-  { rintro ⟨i, j⟩ hij,
-    simp only [mem_divisors_antidiagonal, ne.def] at hij,
-    rw [←hij.1, nat.mul_div_cancel_left],
-    apply nat.pos_of_ne_zero,
-    rintro rfl,
-    simp only [zero_mul] at hij,
-    apply hij.2 hij.1.symm },
-  { simp only [and_imp, prod.forall, mem_divisors_antidiagonal, ne.def],
-    rintro i₁ j₁ ⟨i₂, j₂⟩ h - (rfl : i₂ * j₂ = _) h₁ (rfl : _ = i₂),
-    simp only [nat.mul_eq_zero, not_or_distrib, ←ne.def] at h₁,
-    rw mul_right_inj' h₁.1 at h,
-    simp [h] },
-  simp only [and_imp, exists_prop, mem_divisors_antidiagonal, exists_and_distrib_right, ne.def,
-    exists_eq_right', mem_divisors, prod.exists],
-  rintro _ ⟨k, rfl⟩ hn,
-  exact ⟨⟨k, rfl⟩, hn⟩,
+  rw [←map_div_right_divisors, finset.prod_map],
+  refl,
 end
 
 @[to_additive]
@@ -414,17 +413,6 @@ begin
   exact prod_divisors_antidiagonal (λ i j, f j i),
 end
 
-@[simp]
-lemma filter_dvd_eq_divisors {n : ℕ} (h : n ≠ 0) :
-  finset.filter (λ (x : ℕ), x ∣ n) (finset.range (n : ℕ).succ) = (n : ℕ).divisors :=
-begin
-  apply finset.ext,
-  simp only [h, mem_filter, and_true, and_iff_right_iff_imp, cast_id, mem_range, ne.def,
-  not_false_iff, mem_divisors],
-  intros a ha,
-  exact nat.lt_succ_of_le (nat.divisor_le (nat.mem_divisors.2 ⟨ha, h⟩))
-end
-
 /-- The factors of `n` are the prime divisors -/
 lemma prime_divisors_eq_to_filter_divisors_prime (n : ℕ) :
   n.factors.to_finset = (divisors n).filter prime :=
@@ -449,8 +437,7 @@ begin
     exact div_dvd_of_dvd hx1.1 },
   { rw [mem_divisors, mem_image],
     rintros ⟨h1, -⟩,
-    exact ⟨n/a, mem_divisors.mpr ⟨div_dvd_of_dvd h1, hn⟩,
-           nat.div_div_self h1 (pos_iff_ne_zero.mpr hn)⟩ },
+    exact ⟨n/a, mem_divisors.mpr ⟨div_dvd_of_dvd h1, hn⟩, nat.div_div_self h1 hn⟩ },
 end
 
 @[simp, to_additive sum_div_divisors]
diff --git a/src/number_theory/fermat4.lean b/src/number_theory/fermat4.lean
index 5f3fe6387b5b3..e802a60fc2046 100644
--- a/src/number_theory/fermat4.lean
+++ b/src/number_theory/fermat4.lean
@@ -9,6 +9,9 @@ import tactic.linear_combination
 
 /-!
 # Fermat's Last Theorem for the case n = 4
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 There are no non-zero integers `a`, `b` and `c` such that `a ^ 4 + b ^ 4 = c ^ 4`.
 -/
 
@@ -35,13 +38,12 @@ begin
     split, { exact mul_ne_zero hk0 f42.1 },
     split, { exact mul_ne_zero hk0 f42.2.1 },
     { have H : a ^ 4 + b ^ 4 = c ^ 2 := f42.2.2,
-      linear_combination (H, k ^ 4) } },
+      linear_combination k ^ 4 * H } },
   { intro f42,
     split, { exact right_ne_zero_of_mul f42.1 },
     split, { exact right_ne_zero_of_mul f42.2.1 },
     apply (mul_right_inj' (pow_ne_zero 4 hk0)).mp,
-    have H : (k * a) ^ 4 + (k * b) ^ 4 = (k ^ 2 * c) ^ 2 := f42.2.2,
-    linear_combination H }
+    linear_combination f42.2.2 }
 end
 
 lemma ne_zero {a b c : ℤ} (h : fermat_42 a b c) : c ≠ 0 :=
@@ -167,8 +169,7 @@ begin
   -- first the formula:
   have ht : pythagorean_triple (a ^ 2) (b ^ 2) c,
   { delta pythagorean_triple,
-    have H := h.1.2.2,
-    linear_combination H },
+    linear_combination h.1.2.2 },
   -- coprime requirement:
   have h2 : int.gcd (a ^ 2) (b ^ 2) = 1 :=
     int.gcd_eq_one_iff_coprime.mpr (coprime_of_minimal h).pow,
@@ -181,7 +182,7 @@ begin
   -- formula:
   have htt : pythagorean_triple a n m,
   { delta pythagorean_triple,
-    linear_combination ht1 },
+    linear_combination (ht1) },
   -- a and n are coprime, because a ^ 2 = m ^ 2 - n ^ 2 and m and n are coprime.
   have h3 : int.gcd a n = 1,
   { apply int.gcd_eq_one_iff_coprime.mpr,
@@ -205,12 +206,12 @@ begin
       (int.gcd_eq_one_iff_coprime.mp htt4)) },
   -- b is even because b ^ 2 = 2 * m * n.
   have hb2 : 2 ∣ b,
-  { apply @int.prime.dvd_pow' _ 2 _ (by norm_num : nat.prime 2),
+  { apply @int.prime.dvd_pow' _ 2 _ nat.prime_two,
     rw [ht2, mul_assoc], exact dvd_mul_right 2 (m * n) },
   cases hb2 with b' hb2',
   have hs : b' ^ 2 = m * (r * s),
   { apply (mul_right_inj' (by norm_num : (4 : ℤ) ≠ 0)).mp,
-    linear_combination (hb2', - b - 2 * b') (ht2, 1) (htt2, 2 * m) },
+    linear_combination (- b - 2 * b') * hb2' + ht2 + 2 * m * htt2 },
   have hrsz : r * s ≠ 0, -- because b ^ 2 is not zero and (b / 2) ^ 2 = m * (r * s)
   { by_contradiction hrsz,
     revert hb20, rw [ht2, htt2, mul_assoc, @mul_assoc _ _ _ r s, hrsz],
diff --git a/src/number_theory/fermat_psp.lean b/src/number_theory/fermat_psp.lean
new file mode 100644
index 0000000000000..cde8495f8b725
--- /dev/null
+++ b/src/number_theory/fermat_psp.lean
@@ -0,0 +1,424 @@
+/-
+Copyright (c) 2022 Niels Voss. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Niels Voss
+-/
+import data.nat.prime
+import field_theory.finite.basic
+import order.filter.cofinite
+
+/-!
+# Fermat Pseudoprimes
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define Fermat pseudoprimes: composite numbers that pass the Fermat primality test.
+A natural number `n` passes the Fermat primality test to base `b` (and is therefore deemed a
+"probable prime") if `n` divides `b ^ (n - 1) - 1`. `n` is a Fermat pseudoprime to base `b` if `n`
+is a composite number that passes the Fermat primality test to base `b` and is coprime with `b`.
+
+Fermat pseudoprimes can also be seen as composite numbers for which Fermat's little theorem holds
+true.
+
+Numbers which are Fermat pseudoprimes to all bases are known as Carmichael numbers (not yet defined
+in this file).
+
+## Main Results
+
+The main definitions for this file are
+
+- `fermat_psp.probable_prime`: A number `n` is a probable prime to base `b` if it passes the Fermat
+  primality test; that is, if `n` divides `b ^ (n - 1) - 1`
+- `fermat_psp`: A number `n` is a pseudoprime to base `b` if it is a probable prime to base `b`, is
+  composite, and is coprime with `b` (this last condition is automatically true if `n` divides
+  `b ^ (n - 1) - 1`, but some sources include it in the definition).
+
+Note that all composite numbers are pseudoprimes to base 0 and 1, and that the definiton of
+`probable_prime` in this file implies that all numbers are probable primes to bases 0 and 1, and
+that 0 and 1 are probable primes to any base.
+
+The main theorems are
+- `fermat_psp.exists_infinite_pseudoprimes`: there are infinite pseudoprimes to any base `b ≥ 1`
+-/
+
+/--
+`n` is a probable prime to base `b` if `n` passes the Fermat primality test; that is, `n` divides
+`b ^ (n - 1) - 1`.
+This definition implies that all numbers are probable primes to base 0 or 1, and that 0 and 1 are
+probable primes to any base.
+-/
+def fermat_psp.probable_prime (n b : ℕ) : Prop := n ∣ b ^ (n - 1) - 1
+
+/--
+`n` is a Fermat pseudoprime to base `b` if `n` is a probable prime to base `b` and is composite. By
+this definition, all composite natural numbers are pseudoprimes to base 0 and 1. This definition
+also permits `n` to be less than `b`, so that 4 is a pseudoprime to base 5, for example.
+-/
+def fermat_psp (n b : ℕ) : Prop := fermat_psp.probable_prime n b ∧ ¬n.prime ∧ 1 < n
+
+namespace fermat_psp
+
+instance decidable_probable_prime (n b : ℕ) : decidable (probable_prime n b) :=
+nat.decidable_dvd _ _
+
+instance decidable_psp (n b : ℕ) : decidable (fermat_psp n b) := and.decidable
+
+/--
+If `n` passes the Fermat primality test to base `b`, then `n` is coprime with `b`, assuming that
+`n` and `b` are both positive.
+-/
+lemma coprime_of_probable_prime {n b : ℕ} (h : probable_prime n b) (h₁ : 1 ≤ n) (h₂ : 1 ≤ b) :
+  nat.coprime n b :=
+begin
+  by_cases h₃ : 2 ≤ n,
+
+  { -- To prove that `n` is coprime with `b`, we we need to show that for all prime factors of `n`,
+    -- we can derive a contradiction if `n` divides `b`.
+    apply nat.coprime_of_dvd,
+
+    -- If `k` is a prime number that divides both `n` and `b`, then we know that `n = m * k` and
+    -- `b = j * k` for some natural numbers `m` and `j`. We substitute these into the hypothesis.
+    rintros k hk ⟨m, rfl⟩ ⟨j, rfl⟩,
+
+    -- Because prime numbers do not divide 1, it suffices to show that `k ∣ 1` to prove a
+    -- contradiction
+    apply nat.prime.not_dvd_one hk,
+
+    -- Since `n` divides `b ^ (n - 1) - 1`, `k` also divides `b ^ (n - 1) - 1`
+    replace h := dvd_of_mul_right_dvd h,
+
+    -- Because `k` divides `b ^ (n - 1) - 1`, if we can show that `k` also divides `b ^ (n - 1)`,
+    -- then we know `k` divides 1.
+    rw [nat.dvd_add_iff_right h, nat.sub_add_cancel (nat.one_le_pow _ _ h₂)],
+
+    -- Since `k` divides `b`, `k` also divides any power of `b` except `b ^ 0`. Therefore, it
+    -- suffices to show that `n - 1` isn't zero. However, we know that `n - 1` isn't zero because we
+    -- assumed `2 ≤ n` when doing `by_cases`.
+    refine dvd_of_mul_right_dvd (dvd_pow_self (k * j) _),
+    linarith },
+
+  -- If `n = 1`, then it follows trivially that `n` is coprime with `b`.
+  { rw (show n = 1, by linarith),
+    norm_num }
+end
+
+lemma probable_prime_iff_modeq (n : ℕ) {b : ℕ} (h : 1 ≤ b) :
+  probable_prime n b ↔ b ^ (n - 1) ≡ 1 [MOD n] :=
+begin
+  have : 1 ≤ b ^ (n - 1) := one_le_pow_of_one_le h (n - 1), -- For exact_mod_cast
+  rw nat.modeq.comm,
+  split,
+  { intro h₁,
+    apply nat.modeq_of_dvd,
+    exact_mod_cast h₁, },
+  { intro h₁,
+    exact_mod_cast nat.modeq.dvd h₁, },
+end
+
+/--
+If `n` is a Fermat pseudoprime to base `b`, then `n` is coprime with `b`, assuming that `b` is
+positive.
+
+This lemma is a small wrapper based on `coprime_of_probable_prime`
+-/
+lemma coprime_of_fermat_psp {n b : ℕ} (h : fermat_psp n b) (h₁ : 1 ≤ b) : nat.coprime n b :=
+begin
+  rcases h with ⟨hp, hn₁, hn₂⟩,
+  exact coprime_of_probable_prime hp (by linarith) h₁,
+end
+
+/--
+All composite numbers are Fermat pseudoprimes to base 1.
+-/
+lemma base_one {n : ℕ} (h₁ : 1 < n) (h₂ : ¬n.prime) : fermat_psp n 1 :=
+begin
+  refine ⟨show n ∣ 1 ^ (n - 1) - 1, from _, h₂, h₁⟩,
+  exact (show 0 = 1 ^ (n - 1) - 1, by norm_num) ▸ dvd_zero n,
+end
+
+-- Lemmas that are needed to prove statements in this file, but aren't directly related to Fermat
+-- pseudoprimes
+section helper_lemmas
+
+private lemma pow_gt_exponent {a : ℕ} (b : ℕ) (h : 2 ≤ a) : b < a ^ b :=
+lt_of_lt_of_le (nat.lt_two_pow b) $ nat.pow_le_pow_of_le_left h _
+
+private lemma a_id_helper {a b : ℕ} (ha : 2 ≤ a) (hb : 2 ≤ b) : 2 ≤ (a ^ b - 1) / (a - 1) :=
+begin
+  change 1 < _,
+  have h₁ : a - 1 ∣ a ^ b - 1 := by simpa only [one_pow] using nat_sub_dvd_pow_sub_pow a 1 b,
+  rw [nat.lt_div_iff_mul_lt h₁, mul_one, tsub_lt_tsub_iff_right (nat.le_of_succ_le ha)],
+  convert pow_lt_pow (nat.lt_of_succ_le ha) hb,
+  rw pow_one
+end
+
+private lemma b_id_helper {a b : ℕ} (ha : 2 ≤ a) (hb : 2 < b) : 2 ≤ (a ^ b + 1) / (a + 1) :=
+begin
+  rw nat.le_div_iff_mul_le (nat.zero_lt_succ _),
+  apply nat.succ_le_succ,
+  calc 2 * a + 1 ≤ a ^ 2 * a : by nlinarith
+             ... = a ^ 3     : by rw pow_succ' a 2
+             ... ≤ a ^ b     : pow_le_pow (nat.le_of_succ_le ha) hb
+end
+
+private lemma AB_id_helper (b p : ℕ) (hb : 2 ≤ b) (hp : odd p)
+  : (b ^ p - 1) / (b - 1) * ((b ^ p + 1) / (b + 1)) = (b ^ (2 * p) - 1) / (b ^ 2 - 1) :=
+begin
+  have q₁ : b - 1 ∣ b ^ p - 1 := by simpa only [one_pow] using nat_sub_dvd_pow_sub_pow b 1 p,
+  have q₂ : b + 1 ∣ b ^ p + 1 := by simpa only [one_pow] using hp.nat_add_dvd_pow_add_pow b 1,
+  convert nat.div_mul_div_comm q₁ q₂; rw [mul_comm (_ - 1), ←nat.sq_sub_sq],
+  { ring_exp },
+  { simp }
+end
+
+/--
+Used in the proof of `psp_from_prime_psp`
+-/
+private lemma bp_helper {b p : ℕ} (hb : 0 < b) (hp : 1 ≤ p) :
+  b ^ (2 * p) - 1 - (b ^ 2 - 1) =  b * (b ^ (p - 1) - 1) * (b ^ p + b) :=
+have hi_bsquared : 1 ≤ b ^ 2 := nat.one_le_pow _ _ hb,
+calc b ^ (2 * p) - 1 - (b ^ 2 - 1) = b ^ (2 * p) - (1 + (b ^ 2 - 1)) : by rw nat.sub_sub
+      ... = b ^ (2 * p) - (1 + b ^ 2 - 1)           : by rw nat.add_sub_assoc hi_bsquared
+      ... = b ^ (2 * p) - (b ^ 2)                   : by rw nat.add_sub_cancel_left
+      ... = b ^ (p * 2) - (b ^ 2)                   : by rw mul_comm
+      ... = (b ^ p) ^ 2 - (b ^ 2)                   : by rw pow_mul
+      ... = (b ^ p + b) * (b ^ p - b)               : by rw nat.sq_sub_sq
+      ... = (b ^ p - b) * (b ^ p + b)               : by rw mul_comm
+      ... = (b ^ (p - 1 + 1) - b) * (b ^ p + b)     : by rw nat.sub_add_cancel hp
+      ... = (b * b ^ (p - 1) - b) * (b ^ p + b)     : by rw pow_succ
+      ... = (b * b ^ (p - 1) - b * 1) * (b ^ p + b) : by rw mul_one
+      ... = b * (b ^ (p - 1) - 1) * (b ^ p + b)     : by rw nat.mul_sub_left_distrib
+
+end helper_lemmas
+
+/--
+Given a prime `p` which does not divide `b * (b ^ 2 - 1)`, we can produce a number `n` which is
+larger than `p` and pseudoprime to base `b`. We do this by defining
+`n = ((b ^ p - 1) / (b - 1)) * ((b ^ p + 1) / (b + 1))`
+
+The primary purpose of this definition is to help prove `exists_infinite_pseudoprimes`. For a proof
+that `n` is actually pseudoprime to base `b`, see `psp_from_prime_psp`, and for a proof that `n` is
+greater than `p`, see `psp_from_prime_gt_p`.
+
+This lemma is intended to be used when `2 ≤ b`, `2 < p`, `p` is prime, and `¬p ∣ b * (b ^ 2 - 1)`,
+because those are the hypotheses for `psp_from_prime_psp`.
+-/
+private def psp_from_prime (b : ℕ) (p : ℕ) : ℕ := (b ^ p - 1) / (b - 1) * ((b ^ p + 1) / (b + 1))
+
+/--
+This is a proof that the number produced using `psp_from_prime` is actually pseudoprime to base `b`.
+The primary purpose of this lemma is to help prove `exists_infinite_pseudoprimes`.
+
+We use  as a rough outline of the proof.
+-/
+private lemma psp_from_prime_psp {b : ℕ} (b_ge_two : 2 ≤ b) {p : ℕ} (p_prime : p.prime)
+  (p_gt_two : 2 < p) (not_dvd : ¬p ∣ b * (b ^ 2 - 1)) :
+  fermat_psp (psp_from_prime b p) b :=
+begin
+  unfold psp_from_prime,
+  set A := (b ^ p - 1) / (b - 1),
+  set B := (b ^ p + 1) / (b + 1),
+
+  -- Inequalities
+  have hi_A : 1 < A := a_id_helper (nat.succ_le_iff.mp b_ge_two) (nat.prime.one_lt p_prime),
+  have hi_B : 1 < B := b_id_helper (nat.succ_le_iff.mp b_ge_two) p_gt_two,
+  have hi_AB : 1 < A * B := one_lt_mul'' hi_A hi_B,
+  have hi_b : 0 < b := by linarith,
+  have hi_p : 1 ≤ p := nat.one_le_of_lt p_gt_two,
+  have hi_bsquared : 0 < b ^ 2 - 1 := by nlinarith [nat.one_le_pow 2 b hi_b],
+  have hi_bpowtwop : 1 ≤ b ^ (2 * p) := nat.one_le_pow (2 * p) b hi_b,
+  have hi_bpowpsubone : 1 ≤ b ^ (p - 1) := nat.one_le_pow (p - 1) b hi_b,
+
+  -- Other useful facts
+  have p_odd : odd p := p_prime.odd_of_ne_two p_gt_two.ne.symm,
+  have AB_not_prime : ¬nat.prime (A * B) := nat.not_prime_mul hi_A hi_B,
+  have AB_id : A * B = (b ^ (2 * p) - 1) / (b ^ 2 - 1) := AB_id_helper _ _ b_ge_two p_odd,
+  have hd : b ^ 2 - 1 ∣ b ^ (2 * p) - 1,
+  { simpa only [one_pow, pow_mul] using nat_sub_dvd_pow_sub_pow _ 1 p },
+
+  -- We know that `A * B` is not prime, and that `1 < A * B`. Since two conditions of being
+  -- pseudoprime are satisfied, we only need to show that `A * B` is probable prime to base `b`
+  refine ⟨_, AB_not_prime, hi_AB⟩,
+
+  -- Used to prove that `2 * p * (b ^ 2 - 1) ∣ (b ^ 2 - 1) * (A * B - 1)`.
+  have ha₁ : (b ^ 2 - 1) * (A * B - 1) = b * (b ^ (p - 1) - 1) * (b ^ p + b),
+  { apply_fun (λ x, x * (b ^ 2 - 1)) at AB_id,
+    rw nat.div_mul_cancel hd at AB_id,
+    apply_fun (λ x, x - (b ^ 2 - 1)) at AB_id,
+    nth_rewrite 1 ←one_mul (b ^ 2 - 1) at AB_id,
+    rw [←nat.mul_sub_right_distrib, mul_comm] at AB_id,
+    rw AB_id,
+    exact bp_helper hi_b hi_p },
+  -- If `b` is even, then `b^p` is also even, so `2 ∣ b^p + b`
+  -- If `b` is odd, then `b^p` is also odd, so `2 ∣ b^p + b`
+  have ha₂ : 2 ∣ b ^ p + b,
+  { by_cases h : even b,
+    { replace h : 2 ∣ b := even_iff_two_dvd.mp h,
+      have : p ≠ 0 := by linarith,
+      have : 2 ∣ b^p := dvd_pow h this,
+      exact dvd_add this h },
+    { have h : odd b := nat.odd_iff_not_even.mpr h,
+      have : odd (b ^ p) := odd.pow h,
+      have : even (b ^ p + b) := odd.add_odd this h,
+      exact even_iff_two_dvd.mp this } },
+  -- Since `b` isn't divisible by `p`, `b` is coprime with `p`. we can use Fermat's Little Theorem
+  -- to prove this.
+  have ha₃ : p ∣ b ^ (p - 1) - 1,
+  { have : ¬p ∣ b := mt (assume h : p ∣ b, dvd_mul_of_dvd_left h _) not_dvd,
+    have : p.coprime b := or.resolve_right (nat.coprime_or_dvd_of_prime p_prime b) this,
+    have : is_coprime (b : ℤ) ↑p := this.symm.is_coprime,
+    have : ↑b ^ (p - 1) ≡ 1 [ZMOD ↑p] := int.modeq.pow_card_sub_one_eq_one p_prime this,
+    have : ↑p ∣ ↑b ^ (p - 1) - ↑1 := int.modeq.dvd (int.modeq.symm this),
+    exact_mod_cast this },
+  -- Because `p - 1` is even, there is a `c` such that `2 * c = p - 1`. `nat_sub_dvd_pow_sub_pow`
+  -- implies that `b ^ c - 1 ∣ (b ^ c) ^ 2 - 1`, and `(b ^ c) ^ 2 = b ^ (p - 1)`.
+  have ha₄ : b ^ 2 - 1 ∣ b ^ (p - 1) - 1,
+  { cases p_odd with k hk,
+    have : 2 ∣ p - 1 := ⟨k, by simp [hk]⟩,
+    cases this with c hc,
+    have : b ^ 2 - 1 ∣ (b ^ 2) ^ c - 1 :=
+      by simpa only [one_pow] using nat_sub_dvd_pow_sub_pow _ 1 c,
+    have : b ^ 2 - 1 ∣ b ^ (2 * c) - 1 := by rwa ←pow_mul at this,
+    rwa ←hc at this },
+  -- Used to prove that `2 * p` divides `A * B - 1`
+  have ha₅ : 2 * p * (b ^ 2 - 1) ∣ (b ^ 2 - 1) * (A * B - 1),
+  { suffices q : 2 * p * (b ^ 2 - 1) ∣ b * (b ^ (p - 1) - 1) * (b ^ p + b),
+    { rwa ha₁ },
+    -- We already proved that `b ^ 2 - 1 ∣ b ^ (p - 1) - 1`.
+    -- Since `2 ∣ b ^ p + b` and `p ∣ b ^ p + b`, if we show that 2 and p are coprime, then we
+    -- know that `2 * p ∣ b ^ p + b`
+    have q₁ : nat.coprime p (b ^ 2 - 1),
+    { have q₂ : ¬p ∣ b ^ 2 - 1,
+      { rw mul_comm at not_dvd,
+        exact mt (assume h : p ∣ b ^ 2 - 1, dvd_mul_of_dvd_left h _) not_dvd },
+      exact (nat.prime.coprime_iff_not_dvd p_prime).mpr q₂ },
+    have q₂ : p * (b ^ 2 - 1) ∣ b ^ (p - 1) - 1 := nat.coprime.mul_dvd_of_dvd_of_dvd q₁ ha₃ ha₄,
+    have q₃ : p * (b ^ 2 - 1) * 2 ∣ (b ^ (p - 1) - 1) * (b ^ p + b) := mul_dvd_mul q₂ ha₂,
+    have q₄ : p * (b ^ 2 - 1) * 2 ∣ b * ((b ^ (p - 1) - 1) * (b ^ p + b)),
+      from dvd_mul_of_dvd_right q₃ _,
+    rwa [mul_assoc, mul_comm, mul_assoc b] },
+  have ha₆ : 2 * p ∣ A * B - 1,
+  { rw mul_comm at ha₅,
+    exact nat.dvd_of_mul_dvd_mul_left hi_bsquared ha₅ },
+  -- `A * B` divides `b ^ (2 * p) - 1` because `A * B * (b ^ 2 - 1) = b ^ (2 * p) - 1`.
+  -- This can be proven by multiplying both sides of `AB_id` by `b ^ 2 - 1`.
+  have ha₇ : A * B ∣ b ^ (2 * p) - 1,
+  { use b ^ 2 - 1,
+    have : A * B * (b ^ 2 - 1) = (b ^ (2 * p) - 1) / (b ^ 2 - 1) * (b ^ 2 - 1),
+      from congr_arg (λ x : ℕ, x * (b ^ 2 - 1)) AB_id,
+    simpa only [add_comm, nat.div_mul_cancel hd, nat.sub_add_cancel hi_bpowtwop] using this.symm },
+  -- Since `2 * p ∣ A * B - 1`, there is a number `q` such that `2 * p * q = A * B - 1`.
+  -- By `nat_sub_dvd_pow_sub_pow`, we know that `b ^ (2 * p) - 1 ∣ b ^ (2 * p * q) - 1`.
+  -- This means that `b ^ (2 * p) - 1 ∣ b ^ (A * B - 1) - 1`.
+  cases ha₆ with q hq,
+  have ha₈ : b ^ (2 * p) - 1 ∣ b ^ (A * B - 1) - 1 :=
+    by simpa only [one_pow, pow_mul, hq] using nat_sub_dvd_pow_sub_pow _ 1 q,
+  -- We have proved that `A * B ∣ b ^ (2 * p) - 1` and `b ^ (2 * p) - 1 ∣ b ^ (A * B - 1) - 1`.
+  -- Therefore, `A * B ∣ b ^ (A * B - 1) - 1`.
+  exact dvd_trans ha₇ ha₈
+end
+
+/--
+This is a proof that the number produced using `psp_from_prime` is greater than the prime `p` used
+to create it. The primary purpose of this lemma is to help prove `exists_infinite_pseudoprimes`.
+-/
+private lemma psp_from_prime_gt_p {b : ℕ} (b_ge_two : 2 ≤ b) {p : ℕ} (p_prime : p.prime)
+  (p_gt_two : 2 < p) :
+  p < psp_from_prime b p :=
+begin
+  unfold psp_from_prime,
+  set A := (b ^ p - 1) / (b - 1),
+  set B := (b ^ p + 1) / (b + 1),
+  rw show A * B = (b ^ (2 * p) - 1) / (b ^ 2 - 1),
+    from AB_id_helper _ _ b_ge_two (p_prime.odd_of_ne_two p_gt_two.ne.symm),
+  have AB_dvd : b ^ 2 - 1 ∣ b ^ (2 * p) - 1,
+    by simpa only [one_pow, pow_mul] using nat_sub_dvd_pow_sub_pow _ 1 p,
+
+  suffices h : p * (b ^ 2 - 1) < b ^ (2 * p) - 1,
+  { have h₁ : (p * (b ^ 2 - 1)) / (b ^ 2 - 1) < (b ^ (2 * p) - 1) / (b ^ 2 - 1),
+      from nat.div_lt_div_of_lt_of_dvd AB_dvd h,
+    have h₂ : 0 < b ^ 2 - 1,
+      by linarith [show 3 ≤ b ^ 2 - 1, from le_tsub_of_add_le_left (show 4 ≤ b ^ 2, by nlinarith)],
+    rwa nat.mul_div_cancel _ h₂ at h₁ },
+
+  rw [nat.mul_sub_left_distrib, mul_one, pow_mul],
+  nth_rewrite_rhs 0 ←nat.sub_add_cancel (show 1 ≤ p, by linarith),
+  rw pow_succ (b ^ 2),
+  suffices h : p * b ^ 2 < b ^ 2 * (b ^ 2) ^ (p - 1),
+  { apply gt_of_ge_of_gt,
+    { exact tsub_le_tsub_left (show 1 ≤ p, by linarith) (b ^ 2 * (b ^ 2) ^ (p - 1)) },
+    { have : p ≤ p * b ^ 2 := nat.le_mul_of_pos_right (show 0 < b ^ 2, by nlinarith),
+      exact tsub_lt_tsub_right_of_le this h } },
+
+  suffices h : p < (b ^ 2) ^ (p - 1),
+  { rw mul_comm (b ^ 2),
+    have : 4 ≤ b ^ 2 := by nlinarith,
+    have : 0 < b ^ 2 := by linarith,
+    exact mul_lt_mul_of_pos_right h this },
+
+  rw [←pow_mul, nat.mul_sub_left_distrib, mul_one],
+  have : 2 ≤ 2 * p - 2 := le_tsub_of_add_le_left (show 4 ≤ 2 * p, by linarith),
+  have : 2 + p ≤ 2 * p := by linarith,
+  have : p ≤ 2 * p - 2 := le_tsub_of_add_le_left this,
+  exact nat.lt_of_le_of_lt this (pow_gt_exponent _ b_ge_two)
+end
+
+/--
+For all positive bases, there exist Fermat infinite pseudoprimes to that base.
+Given in this form: for all numbers `b ≥ 1` and `m`, there exists a pseudoprime `n` to base `b` such
+that `m ≤ n`. This form is similar to `nat.exists_infinite_primes`.
+-/
+theorem exists_infinite_pseudoprimes {b : ℕ} (h : 1 ≤ b) (m : ℕ) : ∃ n : ℕ, fermat_psp n b ∧ m ≤ n
+:=
+begin
+  by_cases b_ge_two : 2 ≤ b,
+  -- If `2 ≤ b`, then because there exist infinite prime numbers, there is a prime number p such
+  -- `m ≤ p` and `¬p ∣ b*(b^2 - 1)`. We pick a prime number `b*(b^2 - 1) + 1 + m ≤ p` because we
+  -- automatically know that `p` is greater than m and that it does not divide `b*(b^2 - 1)`
+  -- (because `p` can't divide a number less than `p`).
+  -- From `p`, we can use the lemmas we proved earlier to show that
+  -- `((b^p - 1)/(b - 1)) * ((b^p + 1)/(b + 1))` is a pseudoprime to base `b`.
+  { have h := nat.exists_infinite_primes (b * (b ^ 2 - 1) + 1 + m),
+    cases h with p hp,
+    cases hp with hp₁ hp₂,
+    have h₁ : 0 < b := pos_of_gt (nat.succ_le_iff.mp b_ge_two),
+    have h₂ : 4 ≤ b ^ 2 := pow_le_pow_of_le_left' b_ge_two 2,
+    have h₃ : 0 < b ^ 2 - 1 := tsub_pos_of_lt (gt_of_ge_of_gt h₂ (by norm_num)),
+    have h₄ : 0 < b * (b ^ 2 - 1) := mul_pos h₁ h₃,
+    have h₅ : b * (b ^ 2 - 1) < p := by linarith,
+    have h₆ : ¬p ∣ b * (b ^ 2 - 1) := nat.not_dvd_of_pos_of_lt h₄ h₅,
+    have h₇ : b ≤ b * (b ^ 2 - 1) := nat.le_mul_of_pos_right h₃,
+    have h₈ : 2 ≤ b * (b ^ 2 - 1) := le_trans b_ge_two h₇,
+    have h₉ : 2 < p := gt_of_gt_of_ge h₅ h₈,
+    have h₁₀ := psp_from_prime_gt_p b_ge_two hp₂ h₉,
+    use psp_from_prime b p,
+    split,
+    { exact psp_from_prime_psp b_ge_two hp₂ h₉ h₆ },
+    { exact le_trans (show m ≤ p, by linarith) (le_of_lt h₁₀) } },
+  -- If `¬2 ≤ b`, then `b = 1`. Since all composite numbers are pseudoprimes to base 1, we can pick
+  -- any composite number greater than m. We choose `2 * (m + 2)` because it is greater than `m` and
+  -- is composite for all natural numbers `m`.
+  { have h₁ : b = 1 := by linarith,
+    rw h₁,
+    use 2 * (m + 2),
+    have : ¬nat.prime (2 * (m + 2)) := nat.not_prime_mul (by norm_num) (by norm_num),
+    exact ⟨base_one (by linarith) this, by linarith⟩ }
+end
+
+theorem frequently_at_top_fermat_psp {b : ℕ} (h : 1 ≤ b) : ∃ᶠ n in filter.at_top, fermat_psp n b :=
+begin
+  -- Based on the proof of `nat.frequently_at_top_modeq_one`
+  refine filter.frequently_at_top.2 (λ n, _),
+  obtain ⟨p, hp⟩ := exists_infinite_pseudoprimes h n,
+  exact ⟨p, hp.2, hp.1⟩
+end
+
+/--
+Infinite set variant of `exists_infinite_pseudoprimes`
+-/
+theorem infinite_set_of_prime_modeq_one {b : ℕ} (h : 1 ≤ b) :
+  set.infinite {n : ℕ | fermat_psp n b} :=
+nat.frequently_at_top_iff_infinite.mp (frequently_at_top_fermat_psp h)
+
+end fermat_psp
diff --git a/src/number_theory/frobenius_number.lean b/src/number_theory/frobenius_number.lean
index 5d6ce548e546f..2a9c1f7a36f1e 100644
--- a/src/number_theory/frobenius_number.lean
+++ b/src/number_theory/frobenius_number.lean
@@ -6,10 +6,15 @@ Authors: Alex Zhao
 import data.nat.modeq
 import group_theory.submonoid.basic
 import group_theory.submonoid.membership
+import tactic.ring
+import tactic.zify
 
 /-!
 # Frobenius Number in Two Variables
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we first define a predicate for Frobenius numbers, then solve the 2-variable variant
 of this problem.
 
diff --git a/src/number_theory/function_field.lean b/src/number_theory/function_field.lean
index 02bb4888a386d..491ce0bc15592 100644
--- a/src/number_theory/function_field.lean
+++ b/src/number_theory/function_field.lean
@@ -3,8 +3,8 @@ Copyright (c) 2021 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen, Ashvni Narayanan
 -/
+import algebra.order.group.type_tags
 import field_theory.ratfunc
-import ring_theory.algebraic
 import ring_theory.dedekind_domain.integral_closure
 import ring_theory.integrally_closed
 import topology.algebra.valued_field
@@ -12,13 +12,16 @@ import topology.algebra.valued_field
 /-!
 # Function fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a function field and the ring of integers corresponding to it.
 
 ## Main definitions
  - `function_field Fq F` states that `F` is a function field over the (finite) field `Fq`,
    i.e. it is a finite extension of the field of rational functions in one variable over `Fq`.
  - `function_field.ring_of_integers` defines the ring of integers corresponding to a function field
-    as the integral closure of `polynomial Fq` in the function field.
+    as the integral closure of `Fq[X]` in the function field.
  - `function_field.infty_valuation` : The place at infinity on `Fq(t)` is the nonarchimedean
     valuation on `Fq(t)` with uniformizer `1/t`.
  -  `function_field.Fqt_infty` : The completion `Fq((t⁻¹))`  of `Fq(t)` with respect to the
@@ -40,7 +43,7 @@ function field, ring of integers
 -/
 
 noncomputable theory
-open_locale non_zero_divisors polynomial
+open_locale non_zero_divisors polynomial discrete_valuation
 
 variables (Fq F : Type) [field Fq] [field F]
 
@@ -122,7 +125,7 @@ begin
 end
 
 lemma not_is_field : ¬ is_field (ring_of_integers Fq F) :=
-by simpa [← (is_integral.is_field_iff_is_field (is_integral_closure.is_integral_algebra Fq[X] F)
+by simpa [← ((is_integral_closure.is_integral_algebra Fq[X] F).is_field_iff_is_field
   (algebra_map_injective Fq F))] using (polynomial.not_is_field Fq)
 
 variables [function_field Fq F]
@@ -133,6 +136,9 @@ integral_closure.is_fraction_ring_of_finite_extension (ratfunc Fq) F
 instance : is_integrally_closed (ring_of_integers Fq F) :=
 integral_closure.is_integrally_closed_of_finite_extension (ratfunc Fq)
 
+instance [is_separable (ratfunc Fq) F] : is_noetherian Fq[X] (ring_of_integers Fq F) :=
+is_integral_closure.is_noetherian _ (ratfunc Fq) F _
+
 instance [is_separable (ratfunc Fq) F] :
   is_dedekind_domain (ring_of_integers Fq F) :=
 is_integral_closure.is_dedekind_domain Fq[X] (ratfunc Fq) F _
@@ -148,7 +154,7 @@ variable [decidable_eq (ratfunc Fq)]
 /-- The valuation at infinity is the nonarchimedean valuation on `Fq(t)` with uniformizer `1/t`.
 Explicitly, if `f/g ∈ Fq(t)` is a nonzero quotient of polynomials, its valuation at infinity is
 `multiplicative.of_add(degree(f) - degree(g))`. -/
-def infty_valuation_def (r : ratfunc Fq) : with_zero (multiplicative ℤ) :=
+def infty_valuation_def (r : ratfunc Fq) : ℤₘ₀ :=
 if r = 0 then 0 else (multiplicative.of_add r.int_degree)
 
 lemma infty_valuation.map_zero' : infty_valuation_def Fq 0 = 0 := if_pos rfl
@@ -197,7 +203,7 @@ end
 by rw [infty_valuation_def, if_neg hx]
 
 /-- The valuation at infinity on `Fq(t)`. -/
-def infty_valuation  : valuation (ratfunc Fq) (with_zero (multiplicative ℤ)) :=
+def infty_valuation  : valuation (ratfunc Fq) ℤₘ₀ :=
 { to_fun          := infty_valuation_def Fq,
   map_zero'       := infty_valuation.map_zero' Fq,
   map_one'        := infty_valuation.map_one' Fq,
@@ -210,7 +216,7 @@ def infty_valuation  : valuation (ratfunc Fq) (with_zero (multiplicative ℤ)) :
 @[simp] lemma infty_valuation.C {k : Fq} (hk : k ≠ 0) :
   infty_valuation_def Fq (ratfunc.C k) = (multiplicative.of_add (0 : ℤ)) :=
 begin
-  have hCk : ratfunc.C k ≠ 0 := (ring_hom.map_ne_zero _).mpr hk,
+  have hCk : ratfunc.C k ≠ 0 := (map_ne_zero _).mpr hk,
   rw [infty_valuation_def, if_neg hCk, ratfunc.int_degree_C],
 end
 
@@ -218,17 +224,17 @@ end
   infty_valuation_def Fq (ratfunc.X) = (multiplicative.of_add (1 : ℤ)) :=
 by rw [infty_valuation_def, if_neg ratfunc.X_ne_zero, ratfunc.int_degree_X]
 
-@[simp] lemma infty_valuation.polynomial {p : polynomial Fq} (hp : p ≠ 0) :
-  infty_valuation_def Fq (algebra_map (polynomial Fq) (ratfunc Fq) p) =
+@[simp] lemma infty_valuation.polynomial {p : Fq[X]} (hp : p ≠ 0) :
+  infty_valuation_def Fq (algebra_map Fq[X] (ratfunc Fq) p) =
     (multiplicative.of_add (p.nat_degree : ℤ)) :=
 begin
-  have hp' : algebra_map (polynomial Fq) (ratfunc Fq) p ≠ 0,
+  have hp' : algebra_map Fq[X] (ratfunc Fq) p ≠ 0,
   { rw [ne.def, ratfunc.algebra_map_eq_zero_iff], exact hp },
   rw [infty_valuation_def, if_neg hp', ratfunc.int_degree_polynomial]
 end
 
 /-- The valued field `Fq(t)` with the valuation at infinity. -/
-def infty_valued_Fqt : valued (ratfunc Fq) (with_zero (multiplicative ℤ)) :=
+def infty_valued_Fqt : valued (ratfunc Fq) ℤₘ₀ :=
 valued.mk' $ infty_valuation Fq
 
 lemma infty_valued_Fqt.def {x : ratfunc Fq} :
@@ -238,15 +244,12 @@ lemma infty_valued_Fqt.def {x : ratfunc Fq} :
 def Fqt_infty := @uniform_space.completion (ratfunc Fq) $ (infty_valued_Fqt Fq).to_uniform_space
 
 instance : field (Fqt_infty Fq) :=
-begin
-  letI := infty_valued_Fqt Fq,
-  exact field_completion,
-end
+by { letI := infty_valued_Fqt Fq, exact uniform_space.completion.field }
 
 instance : inhabited (Fqt_infty Fq) := ⟨(0 : Fqt_infty Fq)⟩
 
 /-- The valuation at infinity on `k(t)` extends to a valuation on `Fqt_infty`. -/
-instance valued_Fqt_infty : valued (Fqt_infty Fq) (with_zero (multiplicative ℤ)) :=
+instance valued_Fqt_infty : valued (Fqt_infty Fq) ℤₘ₀ :=
 @valued.valued_completion _ _ _ _ (infty_valued_Fqt Fq)
 
 lemma valued_Fqt_infty.def {x : Fqt_infty Fq} :
diff --git a/src/number_theory/kummer_dedekind.lean b/src/number_theory/kummer_dedekind.lean
new file mode 100644
index 0000000000000..381da69360e7e
--- /dev/null
+++ b/src/number_theory/kummer_dedekind.lean
@@ -0,0 +1,334 @@
+/-
+Copyright (c) 2021 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen, Paul Lezeau
+-/
+
+import ring_theory.dedekind_domain.ideal
+import ring_theory.is_adjoin_root
+
+/-!
+# Kummer-Dedekind theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves the monogenic version of the Kummer-Dedekind theorem on the splitting of prime
+ideals in an extension of the ring of integers. This states that if `I` is a prime ideal of
+Dedekind domain `R` and `S = R[α]` for some `α` that is integral over `R` with minimal polynomial
+`f`, then the prime factorisations of `I * S` and `f mod I` have the same shape, i.e. they have the
+same number of prime factors, and each prime factors of `I * S` can be paired with a prime factor
+of `f mod I` in a way that ensures multiplicities match (in fact, this pairing can be made explicit
+with a formula).
+
+## Main definitions
+
+ * `normalized_factors_map_equiv_normalized_factors_min_poly_mk` : The bijection in the
+    Kummer-Dedekind theorem. This is the pairing between the prime factors of `I * S` and the prime
+    factors of `f mod I`.
+
+## Main results
+
+ * `normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map` : The Kummer-Dedekind
+    theorem.
+ * `ideal.irreducible_map_of_irreducible_minpoly` : `I.map (algebra_map R S)` is irreducible if
+    `(map I^.quotient.mk (minpoly R pb.gen))` is irreducible, where `pb` is a power basis of `S`
+    over `R`.
+
+## TODO
+
+ * Prove the Kummer-Dedekind theorem in full generality.
+
+ * Prove the converse of `ideal.irreducible_map_of_irreducible_minpoly`.
+
+ * Prove that `normalized_factors_map_equiv_normalized_factors_min_poly_mk` can be expressed as
+    `normalized_factors_map_equiv_normalized_factors_min_poly_mk g = ⟨I, G(α)⟩` for `g` a prime
+    factor of `f mod I` and `G` a lift of `g` to `R[X]`.
+
+## References
+
+ * [J. Neukirch, *Algebraic Number Theory*][Neukirch1992]
+
+## Tags
+
+kummer, dedekind, kummer dedekind, dedekind-kummer, dedekind kummer
+-/
+
+variables (R : Type*) {S : Type*} [comm_ring R] [comm_ring S] [algebra R S]
+
+open ideal polynomial double_quot unique_factorization_monoid algebra ring_hom
+
+local notation R`<`:std.prec.max_plus x `>` := adjoin R ({x} : set S)
+
+/-- Let `S / R` be a ring extension and `x : S`, then the conductor of `R` is the
+    biggest ideal of `S` contained in `R`. -/
+def conductor (x : S) : ideal S :=
+{ carrier := {a | ∀ (b : S), a * b ∈ R },
+  zero_mem' := λ b, by simpa only [zero_mul] using subalgebra.zero_mem _,
+  add_mem' := λ a b ha hb c, by simpa only [add_mul] using subalgebra.add_mem _ (ha c) (hb c),
+  smul_mem' := λ c a ha b, by simpa only [smul_eq_mul, mul_left_comm, mul_assoc] using ha (c * b) }
+
+variables {R} {x : S}
+
+lemma conductor_eq_of_eq {y : S} (h : (R : set S) = R):
+  conductor R x = conductor R y :=
+ideal.ext $ λ a, forall_congr $ λ b, set.ext_iff.mp h _
+
+lemma conductor_subset_adjoin : (conductor R x : set S) ⊆ R :=
+λ y hy, by simpa only [mul_one] using hy 1
+
+lemma mem_conductor_iff {y : S} : y ∈ conductor R x ↔ ∀ (b : S), y * b ∈ R :=
+⟨λ h, h, λ h, h⟩
+
+lemma conductor_eq_top_of_adjoin_eq_top (h : R = ⊤) : conductor R x = ⊤ :=
+by simp only [ideal.eq_top_iff_one, mem_conductor_iff, h, mem_top, forall_const]
+
+lemma conductor_eq_top_of_power_basis (pb : power_basis R S) : conductor R pb.gen = ⊤ :=
+conductor_eq_top_of_adjoin_eq_top pb.adjoin_gen_eq_top
+
+variables {I : ideal R}
+
+/-- This technical lemma tell us that if `C` is the conductor of `R` and `I` is an ideal of `R`
+  then `p * (I * S) ⊆ I * R` for any `p` in `C ∩ R` -/
+lemma prod_mem_ideal_map_of_mem_conductor {p : R} {z : S}
+  (hp : p ∈ ideal.comap (algebra_map R S) (conductor R x)) (hz' : z ∈ (I.map (algebra_map R S))) :
+  (algebra_map R S p) * z ∈
+    algebra_map R S '' ↑(I.map (algebra_map R R)) :=
+begin
+  rw [ideal.map, ideal.span, finsupp.mem_span_image_iff_total] at hz',
+  obtain ⟨l, H, H'⟩ := hz',
+  rw finsupp.total_apply at H',
+  rw [← H', mul_comm, finsupp.sum_mul],
+  have lem : ∀ {a : R}, a ∈ I → (l a • (algebra_map R S a) * (algebra_map R S p)) ∈
+    (algebra_map R S) '' (I.map (algebra_map R R)),
+  { intros a ha,
+    rw [algebra.id.smul_eq_mul, mul_assoc, mul_comm, mul_assoc, set.mem_image],
+    refine exists.intro (algebra_map R R a * ⟨l a * algebra_map R S p,
+      show l a * algebra_map R S p ∈ R, from _ ⟩) _,
+    { rw mul_comm,
+      exact mem_conductor_iff.mp (ideal.mem_comap.mp hp) _ },
+    refine ⟨_, by simpa only [ring_hom.map_mul, mul_comm (algebra_map R S p) (l a)]⟩,
+    rw mul_comm,
+    apply ideal.mul_mem_left (I.map (algebra_map R R)) _
+      (ideal.mem_map_of_mem _ ha) },
+  refine finset.sum_induction _ (λ u, u ∈ (algebra_map R S) ''
+    (I.map (algebra_map R R)))
+    (λ a b, _) _ _,
+  rintro ⟨z, hz, rfl⟩ ⟨y, hy, rfl⟩,
+  rw [← ring_hom.map_add],
+  exact ⟨z + y, ideal.add_mem _ (set_like.mem_coe.mp hz) hy, rfl⟩,
+  { refine ⟨0, set_like.mem_coe.mpr $ ideal.zero_mem _, ring_hom.map_zero _⟩ },
+  { intros y hy,
+    exact lem ((finsupp.mem_supported _ l).mp H hy) },
+end
+
+/-- A technical result telling us that `(I * S) ∩ R = I * R` for any ideal `I` of `R`. -/
+lemma comap_map_eq_map_adjoin_of_coprime_conductor
+  (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
+  (h_alg : function.injective (algebra_map R S)):
+  (I.map (algebra_map R S)).comap (algebra_map R S) = I.map (algebra_map R R) :=
+begin
+  apply le_antisymm,
+  { -- This is adapted from [Neukirch1992]. Let `C = (conductor R x)`. The idea of the proof
+    -- is that since `I` and `C ∩ R` are coprime, we have
+    -- `(I * S) ∩ R ⊆ (I + C) * ((I * S) ∩ R) ⊆ I * R + I * C * S ⊆ I * R`.
+    intros y hy,
+    obtain ⟨z, hz⟩ := y,
+    obtain ⟨p, hp, q, hq, hpq⟩ := submodule.mem_sup.mp ((ideal.eq_top_iff_one _).mp hx),
+    have temp : (algebra_map R S p)*z + (algebra_map R S q)*z = z,
+    { simp only [←add_mul, ←ring_hom.map_add (algebra_map R S), hpq, map_one, one_mul] },
+    suffices : z ∈ algebra_map R S '' (I.map (algebra_map R R)) ↔ (⟨z, hz⟩ : R) ∈
+      I.map (algebra_map R R),
+    { rw [← this, ← temp],
+      obtain ⟨a, ha⟩ := (set.mem_image _ _ _).mp (prod_mem_ideal_map_of_mem_conductor hp
+        (show z ∈ I.map (algebra_map R S), by rwa ideal.mem_comap at hy )),
+      use a + (algebra_map R R q) * ⟨z, hz⟩,
+      refine ⟨ ideal.add_mem (I.map (algebra_map R R)) ha.left _,
+        by simpa only [ha.right, map_add, alg_hom.map_mul, add_right_inj] ⟩,
+      rw mul_comm,
+        exact ideal.mul_mem_left (I.map (algebra_map R R)) _ (ideal.mem_map_of_mem _ hq) },
+    refine ⟨ λ h, _, λ h, (set.mem_image _ _ _).mpr (exists.intro ⟨z, hz⟩ ⟨by simp [h], rfl⟩ ) ⟩,
+    { obtain ⟨x₁, hx₁, hx₂⟩ := (set.mem_image _ _ _).mp h,
+      have : x₁ = ⟨z, hz⟩,
+      { apply h_alg,
+        simpa [hx₂], },
+      rwa ← this }  },
+
+  { -- The converse inclusion is trivial
+    have : algebra_map R S = (algebra_map _ S).comp (algebra_map R R) := by { ext, refl },
+    rw [this, ← ideal.map_map],
+    apply ideal.le_comap_map }
+end
+
+/-- The canonical morphism of rings from `R ⧸ (I*R)` to `S ⧸ (I*S)` is an isomorphism
+    when `I` and `(conductor R x) ∩ R` are coprime. -/
+noncomputable def quot_adjoin_equiv_quot_map (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
+  (h_alg : function.injective (algebra_map R S)) :
+  R ⧸ (I.map (algebra_map R R)) ≃+* S ⧸ (I.map (algebra_map R S)) :=
+ring_equiv.of_bijective (ideal.quotient.lift (I.map (algebra_map R R))
+  (((I.map (algebra_map R S))^.quotient.mk).comp (algebra_map R S )) (λ r hr,
+    begin
+      have : algebra_map R S = (algebra_map R S).comp
+        (algebra_map R R) := by { ext, refl },
+      rw [ring_hom.comp_apply, ideal.quotient.eq_zero_iff_mem, this, ← ideal.map_map],
+      exact ideal.mem_map_of_mem _ hr
+    end))
+begin
+  split,
+  { --the kernel of the map is clearly `(I * S) ∩ R`. To get injectivity, we need to show that
+    --this is contained in `I * R`, which is the content of the previous lemma.
+    refine ring_hom.lift_injective_of_ker_le_ideal _ _ (λ u hu, _),
+    rwa [ring_hom.mem_ker, ring_hom.comp_apply, ideal.quotient.eq_zero_iff_mem,
+      ← ideal.mem_comap, comap_map_eq_map_adjoin_of_coprime_conductor hx h_alg] at hu },
+  { -- Surjectivity follows from the surjectivity of the canonical map `R → S ⧸ (I * S)`,
+    -- which in turn follows from the fact that `I * S + (conductor R x) = S`.
+    refine ideal.quotient.lift_surjective_of_surjective _ _ (λ y, _),
+    obtain ⟨z, hz⟩ := ideal.quotient.mk_surjective y,
+    have : z ∈ conductor R x ⊔ (I.map (algebra_map R S)),
+    { suffices : conductor R x ⊔ (I.map (algebra_map R S)) = ⊤,
+      { simp only [this] },
+      rw ideal.eq_top_iff_one at hx ⊢,
+      replace hx := ideal.mem_map_of_mem (algebra_map R S) hx,
+      rw [ideal.map_sup, ring_hom.map_one] at hx,
+      exact (sup_le_sup (show  ((conductor R x).comap (algebra_map R S)).map (algebra_map R S) ≤
+        conductor R x, from ideal.map_comap_le) (le_refl (I.map (algebra_map R S)))) hx },
+    rw [← ideal.mem_quotient_iff_mem_sup, hz, ideal.mem_map_iff_of_surjective] at this,
+    obtain ⟨u, hu, hu'⟩ := this,
+    use ⟨u, conductor_subset_adjoin hu⟩,
+    simpa only [← hu'],
+    { exact ideal.quotient.mk_surjective } }
+end
+
+@[simp]
+lemma quot_adjoin_equiv_quot_map_apply_mk (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
+  (h_alg : function.injective (algebra_map R S)) (a : R) :
+   quot_adjoin_equiv_quot_map hx h_alg ((I.map (algebra_map R R))^.quotient.mk a)
+   = (I.map (algebra_map R S))^.quotient.mk ↑a :=
+rfl
+
+namespace kummer_dedekind
+
+open_locale big_operators polynomial classical
+
+variables [is_domain R] [is_integrally_closed R]
+variables [is_domain S] [is_dedekind_domain S]
+variable [no_zero_smul_divisors R S]
+
+local attribute [instance] ideal.quotient.field
+
+/-- The first half of the **Kummer-Dedekind Theorem** in the monogenic case, stating that the prime
+    factors of `I*S` are in bijection with those of the minimal polynomial of the generator of `S`
+    over `R`, taken `mod I`.-/
+noncomputable def normalized_factors_map_equiv_normalized_factors_min_poly_mk (hI : is_maximal I)
+  (hI' : I ≠ ⊥) (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
+  (hx' : is_integral R x) :
+  {J : ideal S | J ∈ normalized_factors (I.map (algebra_map R S) )} ≃
+    {d : (R ⧸ I)[X] | d ∈ normalized_factors (map I^.quotient.mk (minpoly R x))} :=
+(normalized_factors_equiv_of_quot_equiv
+  ((quot_adjoin_equiv_quot_map hx
+    (by { apply no_zero_smul_divisors.algebra_map_injective (algebra.adjoin R {x}) S,
+          exact subalgebra.no_zero_smul_divisors_top (algebra.adjoin R {x}) })).symm.trans
+  (((algebra.adjoin.power_basis' hx').quotient_equiv_quotient_minpoly_map I).to_ring_equiv.trans
+    (quot_equiv_of_eq (show (ideal.span ({(minpoly R (algebra.adjoin.power_basis' hx').gen).map
+    I^.quotient.mk})) = (ideal.span ({(minpoly R x).map I^.quotient.mk})),
+      by rw algebra.adjoin.power_basis'_minpoly_gen hx'))))
+  --show that `I * S` ≠ ⊥
+  (show I.map (algebra_map R S) ≠ ⊥,
+    by rwa [ne.def, map_eq_bot_iff_of_injective (no_zero_smul_divisors.algebra_map_injective R S),
+         ← ne.def])
+  --show that the ideal spanned by `(minpoly R pb.gen) mod I` is non-zero
+  (by {by_contra, exact (show (map I^.quotient.mk (minpoly R x) ≠ 0), from
+    polynomial.map_monic_ne_zero (minpoly.monic hx')) (span_singleton_eq_bot.mp h) } )).trans
+  (normalized_factors_equiv_span_normalized_factors
+    (show (map I^.quotient.mk (minpoly R x)) ≠ 0, from
+      polynomial.map_monic_ne_zero (minpoly.monic hx'))).symm
+
+/-- The second half of the **Kummer-Dedekind Theorem** in the monogenic case, stating that the
+    bijection `factors_equiv'` defined in the first half preserves multiplicities. -/
+theorem multiplicity_factors_map_eq_multiplicity (hI : is_maximal I) (hI' : I ≠ ⊥)
+  (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤) (hx' : is_integral R x)
+  {J : ideal S} (hJ : J ∈ normalized_factors (I.map (algebra_map R S))) :
+  multiplicity J (I.map (algebra_map R S)) =
+    multiplicity ↑(normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx'
+      ⟨J, hJ⟩) (map I^.quotient.mk (minpoly R x)) :=
+by rw [normalized_factors_map_equiv_normalized_factors_min_poly_mk, equiv.coe_trans,
+       function.comp_app,
+       multiplicity_normalized_factors_equiv_span_normalized_factors_symm_eq_multiplicity,
+       normalized_factors_equiv_of_quot_equiv_multiplicity_eq_multiplicity]
+
+/-- The **Kummer-Dedekind Theorem**. -/
+theorem normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map (hI : is_maximal I)
+  (hI' : I ≠ ⊥) (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
+  (hx' : is_integral R x) :
+  normalized_factors (I.map (algebra_map R S)) =
+    multiset.map
+      (λ f, ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm f :
+        ideal S))
+      (normalized_factors (polynomial.map I^.quotient.mk (minpoly R x))).attach :=
+begin
+  ext J,
+  -- WLOG, assume J is a normalized factor
+  by_cases hJ : J ∈ normalized_factors (I.map (algebra_map R S)), swap,
+  { rw [multiset.count_eq_zero.mpr hJ, eq_comm, multiset.count_eq_zero, multiset.mem_map],
+    simp only [multiset.mem_attach, true_and, not_exists],
+    rintros J' rfl,
+    exact hJ
+      ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm J').prop },
+
+  -- Then we just have to compare the multiplicities, which we already proved are equal.
+  have := multiplicity_factors_map_eq_multiplicity hI hI' hx hx' hJ,
+  rw [multiplicity_eq_count_normalized_factors, multiplicity_eq_count_normalized_factors,
+      unique_factorization_monoid.normalize_normalized_factor _ hJ,
+      unique_factorization_monoid.normalize_normalized_factor,
+      part_enat.coe_inj]
+    at this,
+  refine this.trans _,
+  -- Get rid of the `map` by applying the equiv to both sides.
+  generalize hJ' : (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx')
+    ⟨J, hJ⟩ = J',
+  have : ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm J' :
+    ideal S) = J,
+  { rw [← hJ', equiv.symm_apply_apply _ _, subtype.coe_mk] },
+  subst this,
+  -- Get rid of the `attach` by applying the subtype `coe` to both sides.
+  rw [multiset.count_map_eq_count' (λ f,
+      ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm f
+        : ideal S)),
+      multiset.count_attach],
+  { exact subtype.coe_injective.comp (equiv.injective _) },
+  { exact (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx' _).prop},
+  { exact irreducible_of_normalized_factor _
+    (normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx' _).prop },
+  { exact polynomial.map_monic_ne_zero (minpoly.monic hx') },
+  { exact irreducible_of_normalized_factor _ hJ },
+  { rwa [← bot_eq_zero, ne.def, map_eq_bot_iff_of_injective
+    (no_zero_smul_divisors.algebra_map_injective R S)] },
+end
+
+theorem ideal.irreducible_map_of_irreducible_minpoly (hI : is_maximal I) (hI' : I ≠ ⊥)
+  (hx : (conductor R x).comap (algebra_map R S) ⊔ I = ⊤)
+  (hx' : is_integral R x) (hf : irreducible (map I^.quotient.mk (minpoly R x))) :
+  irreducible (I.map (algebra_map R S)) :=
+begin
+  have mem_norm_factors : normalize (map I^.quotient.mk (minpoly R x)) ∈ normalized_factors
+    (map I^.quotient.mk (minpoly R x)) := by simp [normalized_factors_irreducible hf],
+  suffices : ∃ y, normalized_factors (I.map (algebra_map R S)) = {y},
+  { obtain ⟨y, hy⟩ := this,
+    have h := normalized_factors_prod (show I.map (algebra_map R S) ≠ 0, by rwa [← bot_eq_zero,
+      ne.def, map_eq_bot_iff_of_injective (no_zero_smul_divisors.algebra_map_injective R S)]),
+    rw [associated_iff_eq, hy, multiset.prod_singleton] at h,
+    rw ← h,
+    exact irreducible_of_normalized_factor y
+      (show y ∈ normalized_factors (I.map (algebra_map R S)), by simp [hy]) },
+  rw normalized_factors_ideal_map_eq_normalized_factors_min_poly_mk_map hI hI' hx hx',
+  use ((normalized_factors_map_equiv_normalized_factors_min_poly_mk hI hI' hx hx').symm
+    ⟨normalize (map I^.quotient.mk (minpoly R x)), mem_norm_factors⟩ : ideal S),
+  rw multiset.map_eq_singleton,
+  use ⟨normalize (map I^.quotient.mk (minpoly R x)), mem_norm_factors⟩,
+  refine ⟨_, rfl⟩,
+  apply multiset.map_injective subtype.coe_injective,
+  rw [multiset.attach_map_coe, multiset.map_singleton, subtype.coe_mk],
+  exact normalized_factors_irreducible hf
+end
+
+end kummer_dedekind
diff --git a/src/number_theory/l_series.lean b/src/number_theory/l_series.lean
index b010d326c6b85..13575962b2973 100644
--- a/src/number_theory/l_series.lean
+++ b/src/number_theory/l_series.lean
@@ -3,13 +3,17 @@ Copyright (c) 2021 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
+import analysis.normed_space.finite_dimension
 import analysis.p_series
 import number_theory.arithmetic_function
-import topology.algebra.infinite_sum
+import topology.algebra.infinite_sum.basic
 
 /-!
 # L-series
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given an arithmetic function, we define the corresponding L-series.
 
 ## Main Definitions
@@ -52,17 +56,17 @@ theorem l_series_summable_of_bounded_of_one_lt_real {f : arithmetic_function ℂ
 begin
   by_cases h0 : m = 0,
   { subst h0,
-    have hf : f = 0 := arithmetic_function.ext (λ n, complex.abs_eq_zero.1
-        (le_antisymm (h n) (complex.abs_nonneg _))),
+    have hf : f = 0 := arithmetic_function.ext (λ n, complex.abs.eq_zero.1
+        (le_antisymm (h n) (complex.abs.nonneg _))),
     simp [hf] },
   refine summable_of_norm_bounded (λ (n : ℕ), m / (n ^ z)) _ _,
   { simp_rw [div_eq_mul_inv],
-    exact (summable_mul_left_iff h0).1 (real.summable_nat_rpow_inv.2 hz) },
+    exact (summable_mul_left_iff h0).2 (real.summable_nat_rpow_inv.2 hz) },
   { intro n,
-    have hm : 0 ≤ m := le_trans (complex.abs_nonneg _) (h 0),
+    have hm : 0 ≤ m := le_trans (complex.abs.nonneg _) (h 0),
     cases n,
     { simp [hm, real.zero_rpow (ne_of_gt (lt_trans real.zero_lt_one hz))] },
-    simp only [complex.abs_div, complex.norm_eq_abs],
+    simp only [map_div₀, complex.norm_eq_abs],
     apply div_le_div hm (h _) (real.rpow_pos_of_pos (nat.cast_pos.2 n.succ_pos) _) (le_of_eq _),
     rw [complex.abs_cpow_real, complex.abs_cast_nat] }
 end
@@ -109,10 +113,11 @@ begin
     ext n,
     simp [n.succ_ne_zero] },
   { apply congr rfl,
-    ext n,
-    cases n, { simp [h0] },
-    simp only [n.succ_ne_zero, one_div, cast_one, nat_coe_apply, complex.abs_cpow_real, inv_inj,
-      complex.abs_inv, if_false, zeta_apply, complex.norm_eq_abs, complex.abs_of_nat] }
+    ext ⟨-|n⟩,
+    { simp [h0] },
+    simp only [cast_zero, nat_coe_apply, zeta_apply, succ_ne_zero, if_false, cast_succ, one_div,
+               complex.norm_eq_abs, map_inv₀, complex.abs_cpow_real, inv_inj, zero_add],
+    rw [←cast_one, ←cast_add, complex.abs_of_nat, cast_add, cast_one] }
 end
 
 @[simp] theorem l_series_add {f g : arithmetic_function ℂ} {z : ℂ}
diff --git a/src/number_theory/legendre_symbol/add_character.lean b/src/number_theory/legendre_symbol/add_character.lean
new file mode 100644
index 0000000000000..47de7d6d7729b
--- /dev/null
+++ b/src/number_theory/legendre_symbol/add_character.lean
@@ -0,0 +1,421 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import number_theory.cyclotomic.primitive_roots
+import field_theory.finite.trace
+
+/-!
+# Additive characters of finite rings and fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `R` be a finite commutative ring. An *additive character* of `R` with values
+in another commutative ring `R'` is simply a morphism from the additive group
+of `R` into the multiplicative monoid of `R'`.
+
+The additive characters on `R` with values in `R'` form a commutative group.
+
+We use the namespace `add_char`.
+
+## Main definitions and results
+
+We define `mul_shift ψ a`, where `ψ : add_char R R'` and `a : R`, to be the
+character defined by `x ↦ ψ (a * x)`. An additive character `ψ` is *primitive*
+if `mul_shift ψ a` is trivial only when `a = 0`.
+
+We show that when `ψ` is primitive, then the map `a ↦ mul_shift ψ a` is injective
+(`add_char.to_mul_shift_inj_of_is_primitive`) and that `ψ` is primitive when `R` is a field
+and `ψ` is nontrivial (`add_char.is_nontrivial.is_primitive`).
+
+We also show that there are primitive additive characters on `R` (with suitable
+target `R'`) when `R` is a field or `R = zmod n` (`add_char.primitive_char_finite_field`
+and `add_char.primitive_zmod_char`).
+
+Finally, we show that the sum of all character values is zero when the character
+is nontrivial (and the target is a domain); see `add_char.sum_eq_zero_of_is_nontrivial`.
+
+## Tags
+
+additive character
+-/
+
+universes u v
+
+/-!
+### Definitions related to and results on additive characters
+-/
+
+section add_char_def
+
+-- The domain of our additive characters
+variables (R : Type u) [add_monoid R]
+-- The target
+variables (R' : Type v) [comm_monoid R']
+
+/-- Define `add_char R R'` as `(multiplicative R) →* R'`.
+The definition works for an additive monoid `R` and a monoid `R'`,
+but we will restrict to the case that both are commutative rings below.
+We assume right away that `R'` is commutative, so that `add_char R R'` carries
+a structure of commutative monoid.
+The trivial additive character (sending everything to `1`) is `(1 : add_char R R').` -/
+@[derive [comm_monoid, inhabited]]
+def add_char : Type (max u v) := (multiplicative R) →* R'
+
+end add_char_def
+
+namespace add_char
+
+section coe_to_fun
+
+variables {R : Type u} [add_monoid R] {R' : Type v} [comm_monoid R']
+
+/-- Interpret an additive character as a monoid homomorphism. -/
+def to_monoid_hom : (add_char R R') → (multiplicative R →* R') := id
+
+open multiplicative
+
+/-- Define coercion to a function so that it includes the move from `R` to `multiplicative R`.
+After we have proved the API lemmas below, we don't need to worry about writing `of_add a`
+when we want to apply an additive character. -/
+instance has_coe_to_fun : has_coe_to_fun (add_char R R') (λ x, R → R') :=
+{ coe := λ ψ x, ψ.to_monoid_hom (of_add x) }
+
+lemma coe_to_fun_apply (ψ : add_char R R') (a : R) : ψ a = ψ.to_monoid_hom (of_add a) := rfl
+
+instance monoid_hom_class : monoid_hom_class (add_char R R') (multiplicative R) R' :=
+monoid_hom.monoid_hom_class
+
+/-- An additive character maps `0` to `1`. -/
+@[simp]
+lemma map_zero_one (ψ : add_char R R') : ψ 0 = 1 :=
+by rw [coe_to_fun_apply, of_add_zero, map_one]
+
+/-- An additive character maps sums to products. -/
+@[simp]
+lemma map_add_mul (ψ : add_char R R') (x y : R) : ψ (x + y) = ψ x * ψ y :=
+by rw [coe_to_fun_apply, coe_to_fun_apply _ x, coe_to_fun_apply _ y, of_add_add, map_mul]
+
+/-- An additive character maps multiples by natural numbers to powers. -/
+@[simp]
+lemma map_nsmul_pow (ψ : add_char R R') (n : ℕ) (x : R) : ψ (n • x) = (ψ x) ^ n :=
+by rw [coe_to_fun_apply, coe_to_fun_apply _ x, of_add_nsmul, map_pow]
+
+end coe_to_fun
+
+section group_structure
+
+open multiplicative
+
+variables {R : Type u} [add_comm_group R] {R' : Type v} [comm_monoid R']
+
+/-- An additive character on a commutative additive group has an inverse.
+
+Note that this is a different inverse to the one provided by `monoid_hom.has_inv`,
+as it acts on the domain instead of the codomain. -/
+instance has_inv : has_inv (add_char R R') := ⟨λ ψ, ψ.comp inv_monoid_hom⟩
+
+lemma inv_apply (ψ : add_char R R') (x : R) : ψ⁻¹ x = ψ (-x) := rfl
+
+/-- An additive character maps multiples by integers to powers. -/
+@[simp]
+lemma map_zsmul_zpow {R' : Type v} [comm_group R'] (ψ : add_char R R') (n : ℤ) (x : R) :
+  ψ (n • x) = (ψ x) ^ n :=
+by rw [coe_to_fun_apply, coe_to_fun_apply _ x, of_add_zsmul, map_zpow]
+
+/-- The additive characters on a commutative additive group form a commutative group. -/
+instance comm_group : comm_group (add_char R R') :=
+{ inv := has_inv.inv,
+  mul_left_inv :=
+  λ ψ, by { ext, rw [monoid_hom.mul_apply, monoid_hom.one_apply, inv_apply, ← map_add_mul,
+                     add_left_neg, map_zero_one], },
+  ..monoid_hom.comm_monoid }
+
+end group_structure
+
+section additive
+
+-- The domain and target of our additive characters. Now we restrict to rings on both sides.
+variables {R : Type u} [comm_ring R] {R' : Type v} [comm_ring R']
+
+/-- An additive character is *nontrivial* if it takes a value `≠ 1`. -/
+def is_nontrivial (ψ : add_char R R') : Prop := ∃ (a : R), ψ a ≠ 1
+
+/-- An additive character is nontrivial iff it is not the trivial character. -/
+lemma is_nontrivial_iff_ne_trivial (ψ : add_char R R') : is_nontrivial ψ ↔ ψ ≠ 1 :=
+begin
+  refine not_forall.symm.trans (iff.not _),
+  rw fun_like.ext_iff,
+  refl,
+end
+
+/-- Define the multiplicative shift of an additive character.
+This satisfies `mul_shift ψ a x = ψ (a * x)`. -/
+def mul_shift (ψ : add_char R R') (a : R) : add_char R R' :=
+ψ.comp (add_monoid_hom.mul_left a).to_multiplicative
+
+@[simp] lemma mul_shift_apply {ψ : add_char R R'} {a : R} {x : R} : mul_shift ψ a x = ψ (a * x) :=
+rfl
+
+/-- `ψ⁻¹ = mul_shift ψ (-1))`. -/
+lemma inv_mul_shift (ψ : add_char R R') : ψ⁻¹ = mul_shift ψ (-1) :=
+begin
+  ext,
+  rw [inv_apply, mul_shift_apply, neg_mul, one_mul],
+end
+
+/-- If `n` is a natural number, then `mul_shift ψ n x = (ψ x) ^ n`. -/
+lemma mul_shift_spec' (ψ : add_char R R') (n : ℕ) (x : R) : mul_shift ψ n x = (ψ x) ^ n :=
+by rw [mul_shift_apply, ← nsmul_eq_mul, map_nsmul_pow]
+
+/-- If `n` is a natural number, then `ψ ^ n = mul_shift ψ n`. -/
+lemma pow_mul_shift (ψ : add_char R R') (n : ℕ) : ψ ^ n = mul_shift ψ n :=
+begin
+  ext x,
+  rw [show (ψ ^ n) x = (ψ x) ^ n, from rfl, ← mul_shift_spec'],
+end
+
+/-- The product of `mul_shift ψ a` and `mul_shift ψ b` is `mul_shift ψ (a + b)`. -/
+lemma mul_shift_mul (ψ : add_char R R') (a b : R) :
+  mul_shift ψ a * mul_shift ψ b = mul_shift ψ (a + b) :=
+begin
+  ext,
+  simp only [right_distrib, monoid_hom.mul_apply, mul_shift_apply, map_add_mul],
+end
+
+/-- `mul_shift ψ 0` is the trivial character. -/
+@[simp]
+lemma mul_shift_zero (ψ : add_char R R') : mul_shift ψ 0 = 1 :=
+begin
+  ext,
+  simp only [mul_shift_apply, zero_mul, map_zero_one, monoid_hom.one_apply],
+end
+
+/-- An additive character is *primitive* iff all its multiplicative shifts by nonzero
+elements are nontrivial. -/
+def is_primitive (ψ : add_char R R') : Prop :=
+∀ (a : R), a ≠ 0 → is_nontrivial (mul_shift ψ a)
+
+/-- The map associating to `a : R` the multiplicative shift of `ψ` by `a`
+is injective when `ψ` is primitive. -/
+lemma to_mul_shift_inj_of_is_primitive {ψ : add_char R R'} (hψ : is_primitive ψ) :
+  function.injective ψ.mul_shift :=
+begin
+  intros a b h,
+  apply_fun (λ x, x * mul_shift ψ (-b)) at h,
+  simp only [mul_shift_mul, mul_shift_zero, add_right_neg] at h,
+  have h₂ := hψ (a + (-b)),
+  rw [h, is_nontrivial_iff_ne_trivial, ← sub_eq_add_neg, sub_ne_zero] at h₂,
+  exact not_not.mp (λ h, h₂ h rfl),
+end
+
+-- `add_comm_group.equiv_direct_sum_zmod_of_fintype`
+-- gives the structure theorem for finite abelian groups.
+-- This could be used to show that the map above is a bijection.
+-- We leave this for a later occasion.
+
+/-- When `R` is a field `F`, then a nontrivial additive character is primitive -/
+lemma is_nontrivial.is_primitive {F : Type u} [field F] {ψ : add_char F R'}
+  (hψ : is_nontrivial ψ) :
+  is_primitive ψ :=
+begin
+  intros a ha,
+  cases hψ with x h,
+  use (a⁻¹ * x),
+  rwa [mul_shift_apply, mul_inv_cancel_left₀ ha],
+end
+
+/-- Definition for a primitive additive character on a finite ring `R` into a cyclotomic extension
+of a field `R'`. It records which cyclotomic extension it is, the character, and the
+fact that the character is primitive. -/
+-- Using `structure` gives a timeout, see
+-- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/mysterious.20finsupp.20related.20timeout/near/365719262 and
+-- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/mysterious.20finsupp.20related.20timeout
+-- In Lean4, `set_option genInjectivity false in` may solve this issue.
+@[nolint has_nonempty_instance] -- can't prove that they always exist
+def primitive_add_char (R : Type u) [comm_ring R] (R' : Type v) [field R'] :=
+Σ (n : ℕ+), (Σ' (char : add_char R (cyclotomic_field n R')), is_primitive char)
+
+/-- The first projection from `primitive_add_char`, giving the cyclotomic field. -/
+noncomputable! def primitive_add_char.n {R : Type u} [comm_ring R] {R' : Type v}
+  [field R'] : primitive_add_char R R' → ℕ+ := λ χ, χ.1
+
+/-- The second projection from `primitive_add_char`, giving the character. -/
+noncomputable! def primitive_add_char.char {R : Type u} [comm_ring R] {R' : Type v}
+  [field R'] : Π (χ : primitive_add_char R R'), add_char R (cyclotomic_field χ.n R') :=
+  λ χ, χ.2.1
+
+/-- The third projection from `primitive_add_char`, showing that `χ.2` is primitive. -/
+lemma primitive_add_char.prim {R : Type u} [comm_ring R] {R' : Type v}
+  [field R'] : Π (χ : primitive_add_char R R'), is_primitive χ.char :=
+  λ χ, χ.2.2
+
+/-!
+### Additive characters on `zmod n`
+-/
+
+variables {C : Type v} [comm_ring C]
+
+section zmod_char_def
+
+open multiplicative -- so we can write simply `to_add`, which we need here again
+
+/-- We can define an additive character on `zmod n` when we have an `n`th root of unity `ζ : C`. -/
+def zmod_char (n : ℕ+) {ζ : C} (hζ : ζ ^ ↑n = 1) : add_char (zmod n) C :=
+{ to_fun := λ (a : multiplicative (zmod n)), ζ ^ a.to_add.val,
+  map_one' := by simp only [to_add_one, zmod.val_zero, pow_zero],
+  map_mul' := λ x y, by rw [to_add_mul, ← pow_add, zmod.val_add (to_add x) (to_add y),
+                            ← pow_eq_pow_mod _ hζ] }
+
+/-- The additive character on `zmod n` defined using `ζ` sends `a` to `ζ^a`. -/
+lemma zmod_char_apply {n : ℕ+} {ζ : C} (hζ : ζ ^ ↑n = 1) (a : zmod n) :
+  zmod_char n hζ a = ζ ^ a.val := rfl
+
+lemma zmod_char_apply' {n : ℕ+} {ζ : C} (hζ : ζ ^ ↑n = 1) (a : ℕ) : zmod_char n hζ a = ζ ^ a :=
+by rw [pow_eq_pow_mod a hζ, zmod_char_apply, zmod.val_nat_cast a]
+
+end zmod_char_def
+
+/-- An additive character on `zmod n` is nontrivial iff it takes a value `≠ 1` on `1`. -/
+lemma zmod_char_is_nontrivial_iff (n : ℕ+) (ψ : add_char (zmod n) C) : is_nontrivial ψ ↔ ψ 1 ≠ 1 :=
+begin
+  refine ⟨_, λ h, ⟨1, h⟩⟩,
+  contrapose!,
+  rintros h₁ ⟨a, ha⟩,
+  have ha₁ : a = a.val • 1,
+  { rw [nsmul_eq_mul, mul_one], exact (zmod.nat_cast_zmod_val a).symm },
+  rw [ha₁, map_nsmul_pow, h₁, one_pow] at ha,
+  exact ha rfl,
+end
+
+/-- A primitive additive character on `zmod n` takes the value `1` only at `0`. -/
+lemma is_primitive.zmod_char_eq_one_iff (n : ℕ+) {ψ : add_char (zmod n) C} (hψ : is_primitive ψ)
+  (a : zmod n) :
+  ψ a = 1 ↔ a = 0 :=
+begin
+  refine ⟨λ h, not_imp_comm.mp (hψ a) _, λ ha, (by rw [ha, map_zero_one])⟩,
+  rw [zmod_char_is_nontrivial_iff n (mul_shift ψ a), mul_shift_apply, mul_one, h, not_not],
+end
+
+/-- The converse: if the additive character takes the value `1` only at `0`,
+then it is primitive. -/
+lemma zmod_char_primitive_of_eq_one_only_at_zero (n : ℕ) (ψ : add_char (zmod n) C)
+  (hψ : ∀ a, ψ a = 1 → a = 0) :
+  is_primitive ψ :=
+begin
+  refine λ a ha, (is_nontrivial_iff_ne_trivial _).mpr (λ hf, _),
+  have h : mul_shift ψ a 1 = (1 : add_char (zmod n) C) (1 : zmod n) :=
+    congr_fun (congr_arg coe_fn hf) 1,
+  rw [mul_shift_apply, mul_one, monoid_hom.one_apply] at h,
+  exact ha (hψ a h),
+end
+
+/-- The additive character on `zmod n` associated to a primitive `n`th root of unity
+is primitive -/
+lemma zmod_char_primitive_of_primitive_root (n : ℕ+) {ζ : C} (h : is_primitive_root ζ n) :
+  is_primitive (zmod_char n ((is_primitive_root.iff_def ζ n).mp h).left) :=
+begin
+  apply zmod_char_primitive_of_eq_one_only_at_zero,
+  intros a ha,
+  rw [zmod_char_apply, ← pow_zero ζ] at ha,
+  exact (zmod.val_eq_zero a).mp (is_primitive_root.pow_inj h (zmod.val_lt a) n.pos ha),
+end
+
+/-- There is a primitive additive character on `zmod n` if the characteristic of the target
+does not divide `n` -/
+noncomputable
+def primitive_zmod_char (n : ℕ+) (F' : Type v) [field F'] (h : (n : F') ≠ 0) :
+  primitive_add_char (zmod n) F' :=
+begin
+  haveI : ne_zero ((n : ℕ) : F') := ⟨h⟩,
+  exact ⟨n, zmod_char n (is_cyclotomic_extension.zeta_pow n F' _),
+    zmod_char_primitive_of_primitive_root n (is_cyclotomic_extension.zeta_spec n F' _)⟩
+end
+
+/-!
+### Existence of a primitive additive character on a finite field
+-/
+
+/-- There is a primitive additive character on the finite field `F` if the characteristic
+of the target is different from that of `F`.
+We obtain it as the composition of the trace from `F` to `zmod p` with a primitive
+additive character on `zmod p`, where `p` is the characteristic of `F`. -/
+noncomputable
+def primitive_char_finite_field (F F': Type*) [field F] [fintype F] [field F']
+  (h : ring_char F' ≠ ring_char F) :
+  primitive_add_char F F' :=
+begin
+  let p := ring_char F,
+  haveI hp : fact p.prime := ⟨char_p.char_is_prime F _⟩,
+  let pp := p.to_pnat hp.1.pos,
+  have hp₂ : ¬ ring_char F' ∣ p :=
+  begin
+    cases char_p.char_is_prime_or_zero F' (ring_char F') with hq hq,
+    { exact mt (nat.prime.dvd_iff_eq hp.1 (nat.prime.ne_one hq)).mp h.symm, },
+    { rw [hq],
+      exact λ hf, nat.prime.ne_zero hp.1 (zero_dvd_iff.mp hf), },
+  end,
+  let ψ := primitive_zmod_char pp F' (ne_zero_iff.mp (ne_zero.of_not_dvd F' hp₂)),
+  letI : algebra (zmod p) F := zmod.algebra _ _,
+  let ψ' := ψ.char.comp (algebra.trace (zmod p) F).to_add_monoid_hom.to_multiplicative,
+  have hψ' : is_nontrivial ψ' :=
+  begin
+    obtain ⟨a, ha⟩ := finite_field.trace_to_zmod_nondegenerate F one_ne_zero,
+    rw one_mul at ha,
+    exact ⟨a, λ hf, ha $ (ψ.prim.zmod_char_eq_one_iff pp $ algebra.trace (zmod p) F a).mp hf⟩,
+  end,
+  exact ⟨ψ.n, ψ', hψ'.is_primitive⟩
+end
+
+/-!
+### The sum of all character values
+-/
+
+open_locale big_operators
+
+variables [fintype R]
+
+/-- The sum over the values of a nontrivial additive character vanishes if the target ring
+is a domain. -/
+lemma sum_eq_zero_of_is_nontrivial [is_domain R'] {ψ : add_char R R'} (hψ : is_nontrivial ψ) :
+  ∑ a, ψ a = 0 :=
+begin
+  rcases hψ with ⟨b, hb⟩,
+  have h₁ : ∑ (a : R), ψ (b + a) = ∑ (a : R), ψ a :=
+    fintype.sum_bijective _ (add_group.add_left_bijective b) _ _ (λ x, rfl),
+  simp_rw [map_add_mul] at h₁,
+  have h₂ : ∑ (a : R), ψ a = finset.univ.sum ⇑ψ := rfl,
+  rw [← finset.mul_sum, h₂] at h₁,
+  exact eq_zero_of_mul_eq_self_left hb h₁,
+end
+
+/-- The sum over the values of the trivial additive character is the cardinality of the source. -/
+lemma sum_eq_card_of_is_trivial {ψ : add_char R R'} (hψ : ¬ is_nontrivial ψ) :
+  ∑ a, ψ a = fintype.card R :=
+begin
+  simp only [is_nontrivial] at hψ,
+  push_neg at hψ,
+  simp only [hψ, finset.sum_const, nat.smul_one_eq_coe],
+  refl,
+end
+
+/-- The sum over the values of `mul_shift ψ b` for `ψ` primitive is zero when `b ≠ 0`
+and `#R` otherwise. -/
+lemma sum_mul_shift [decidable_eq R] [is_domain R'] {ψ : add_char R R'} (b : R)
+  (hψ : is_primitive ψ) :
+  ∑ (x : R), ψ (x * b) = if b = 0 then fintype.card R else 0 :=
+begin
+  split_ifs with h,
+  { -- case `b = 0`
+    simp only [h, mul_zero, map_zero_one, finset.sum_const, nat.smul_one_eq_coe],
+    refl, },
+  { -- case `b ≠ 0`
+    simp_rw mul_comm,
+    exact sum_eq_zero_of_is_nontrivial (hψ b h), },
+end
+
+end additive
+
+end add_char
diff --git a/src/number_theory/legendre_symbol/basic.lean b/src/number_theory/legendre_symbol/basic.lean
new file mode 100644
index 0000000000000..4427fe06ad800
--- /dev/null
+++ b/src/number_theory/legendre_symbol/basic.lean
@@ -0,0 +1,301 @@
+/-
+Copyright (c) 2018 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes, Michael Stoll
+-/
+import number_theory.legendre_symbol.quadratic_char.basic
+
+/-!
+# Legendre symbol
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains results about Legendre symbols.
+
+We define the Legendre symbol $\Bigl(\frac{a}{p}\Bigr)$ as `legendre_sym p a`.
+Note the order of arguments! The advantage of this form is that then `legendre_sym p`
+is a multiplicative map.
+
+The Legendre symbol is used to define the Jacobi symbol, `jacobi_sym a b`, for integers `a`
+and (odd) natural numbers `b`, which extends the Legendre symbol.
+
+## Main results
+
+We also prove the supplementary laws that give conditions for when `-1`
+is a square modulo a prime `p`:
+`legendre_sym.at_neg_one` and `zmod.exists_sq_eq_neg_one_iff` for `-1`.
+
+See `number_theory.legendre_symbol.quadratic_reciprocity` for the conditions when `2` and `-2`
+are squares:
+`legendre_sym.at_two` and `zmod.exists_sq_eq_two_iff` for `2`,
+`legendre_sym.at_neg_two` and `zmod.exists_sq_eq_neg_two_iff` for `-2`.
+
+## Tags
+
+quadratic residue, quadratic nonresidue, Legendre symbol
+-/
+
+open nat
+
+section euler
+
+namespace zmod
+
+variables (p : ℕ) [fact p.prime]
+
+/-- Euler's Criterion: A unit `x` of `zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
+lemma euler_criterion_units (x : (zmod p)ˣ) : (∃ y : (zmod p)ˣ, y ^ 2 = x) ↔ x ^ (p / 2) = 1 :=
+begin
+  by_cases hc : p = 2,
+  { substI hc,
+    simp only [eq_iff_true_of_subsingleton, exists_const], },
+  { have h₀ := finite_field.unit_is_square_iff (by rwa ring_char_zmod_n) x,
+    have hs : (∃ y : (zmod p)ˣ, y ^ 2 = x) ↔ is_square(x) :=
+    by { rw is_square_iff_exists_sq x,
+         simp_rw eq_comm, },
+    rw hs,
+    rwa card p at h₀, },
+end
+
+/-- Euler's Criterion: a nonzero `a : zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
+lemma euler_criterion {a : zmod p} (ha : a ≠ 0) : is_square (a : zmod p) ↔ a ^ (p / 2) = 1 :=
+begin
+  apply (iff_congr _ (by simp [units.ext_iff])).mp (euler_criterion_units p (units.mk0 a ha)),
+  simp only [units.ext_iff, sq, units.coe_mk0, units.coe_mul],
+  split, { rintro ⟨y, hy⟩, exact ⟨y, hy.symm⟩ },
+  { rintro ⟨y, rfl⟩,
+    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
+    refine ⟨units.mk0 y hy, _⟩, simp, }
+end
+
+/-- If `a : zmod p` is nonzero, then `a^(p/2)` is either `1` or `-1`. -/
+lemma pow_div_two_eq_neg_one_or_one {a : zmod p} (ha : a ≠ 0) :
+  a ^ (p / 2) = 1 ∨ a ^ (p / 2) = -1 :=
+begin
+  cases prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
+  { substI p, revert a ha, dec_trivial },
+  rw [← mul_self_eq_one_iff, ← pow_add, ← two_mul, two_mul_odd_div_two hp_odd],
+  exact pow_card_sub_one_eq_one ha
+end
+
+end zmod
+
+end euler
+
+section legendre
+
+/-!
+### Definition of the Legendre symbol and basic properties
+-/
+
+open zmod
+
+variables (p : ℕ) [fact p.prime]
+
+/-- The Legendre symbol of `a : ℤ` and a prime `p`, `legendre_sym p a`,
+is an integer defined as
+
+* `0` if `a` is `0` modulo `p`;
+* `1` if `a` is a nonzero square modulo `p`
+* `-1` otherwise.
+
+Note the order of the arguments! The advantage of the order chosen here is
+that `legendre_sym p` is a multiplicative function `ℤ → ℤ`.
+-/
+def legendre_sym (a : ℤ) : ℤ := quadratic_char (zmod p) a
+
+namespace legendre_sym
+
+/-- We have the congruence `legendre_sym p a ≡ a ^ (p / 2) mod p`. -/
+lemma eq_pow (a : ℤ) : (legendre_sym p a : zmod p) = a ^ (p / 2) :=
+begin
+  cases eq_or_ne (ring_char (zmod p)) 2 with hc hc,
+  { by_cases ha : (a : zmod p) = 0,
+    { rw [legendre_sym, ha, quadratic_char_zero,
+          zero_pow (nat.div_pos (fact.out p.prime).two_le (succ_pos 1))],
+      norm_cast, },
+    { have := (ring_char_zmod_n p).symm.trans hc, -- p = 2
+      substI p,
+      rw [legendre_sym, quadratic_char_eq_one_of_char_two hc ha],
+      revert ha,
+      generalize : (a : zmod 2) = b, revert b, dec_trivial } },
+  { convert quadratic_char_eq_pow_of_char_ne_two' hc (a : zmod p),
+    exact (card p).symm },
+end
+
+/-- If `p ∤ a`, then `legendre_sym p a` is `1` or `-1`. -/
+lemma eq_one_or_neg_one {a : ℤ} (ha : (a : zmod p) ≠ 0) :
+  legendre_sym p a = 1 ∨ legendre_sym p a = -1 :=
+quadratic_char_dichotomy ha
+
+lemma eq_neg_one_iff_not_one {a : ℤ} (ha : (a : zmod p) ≠ 0) :
+  legendre_sym p a = -1 ↔ ¬ legendre_sym p a = 1 :=
+quadratic_char_eq_neg_one_iff_not_one ha
+
+/-- The Legendre symbol of `p` and `a` is zero iff `p ∣ a`. -/
+lemma eq_zero_iff (a : ℤ) : legendre_sym p a = 0 ↔ (a : zmod p) = 0 :=
+quadratic_char_eq_zero_iff
+
+@[simp] lemma at_zero : legendre_sym p 0 = 0 :=
+by rw [legendre_sym, int.cast_zero, mul_char.map_zero]
+
+@[simp] lemma at_one : legendre_sym p 1 = 1 :=
+by rw [legendre_sym, int.cast_one, mul_char.map_one]
+
+/-- The Legendre symbol is multiplicative in `a` for `p` fixed. -/
+protected
+lemma mul (a b : ℤ) : legendre_sym p (a * b) = legendre_sym p a * legendre_sym p b :=
+by simp only [legendre_sym, int.cast_mul, map_mul]
+
+/-- The Legendre symbol is a homomorphism of monoids with zero. -/
+@[simps] def hom : ℤ →*₀ ℤ :=
+{ to_fun := legendre_sym p,
+  map_zero' := at_zero p,
+  map_one' := at_one p,
+  map_mul' := legendre_sym.mul p }
+
+/-- The square of the symbol is 1 if `p ∤ a`. -/
+theorem sq_one {a : ℤ} (ha : (a : zmod p) ≠ 0) : (legendre_sym p a) ^ 2 = 1 :=
+quadratic_char_sq_one ha
+
+/-- The Legendre symbol of `a^2` at `p` is 1 if `p ∤ a`. -/
+theorem sq_one' {a : ℤ} (ha : (a : zmod p) ≠ 0) : legendre_sym p (a ^ 2) = 1 :=
+by exact_mod_cast quadratic_char_sq_one' ha
+
+/-- The Legendre symbol depends only on `a` mod `p`. -/
+protected
+theorem mod (a : ℤ) : legendre_sym p a = legendre_sym p (a % p) :=
+by simp only [legendre_sym, int_cast_mod]
+
+/-- When `p ∤ a`, then `legendre_sym p a = 1` iff `a` is a square mod `p`. -/
+lemma eq_one_iff {a : ℤ} (ha0 : (a : zmod p) ≠ 0) :
+  legendre_sym p a = 1 ↔ is_square (a : zmod p) :=
+quadratic_char_one_iff_is_square ha0
+
+lemma eq_one_iff' {a : ℕ} (ha0 : (a : zmod p) ≠ 0) :
+  legendre_sym p a = 1 ↔ is_square (a : zmod p) :=
+by {rw eq_one_iff, norm_cast, exact_mod_cast ha0}
+
+/-- `legendre_sym p a = -1` iff `a` is a nonsquare mod `p`. -/
+lemma eq_neg_one_iff {a : ℤ} : legendre_sym p a = -1 ↔ ¬ is_square (a : zmod p) :=
+quadratic_char_neg_one_iff_not_is_square
+
+lemma eq_neg_one_iff' {a : ℕ} : legendre_sym p a = -1 ↔ ¬ is_square (a : zmod p) :=
+by {rw eq_neg_one_iff, norm_cast}
+
+/-- The number of square roots of `a` modulo `p` is determined by the Legendre symbol. -/
+lemma card_sqrts (hp : p ≠ 2) (a : ℤ) :
+  ↑{x : zmod p | x^2 = a}.to_finset.card = legendre_sym p a + 1 :=
+quadratic_char_card_sqrts ((ring_char_zmod_n p).substr hp) a
+
+end legendre_sym
+
+end legendre
+
+section quadratic_form
+
+/-!
+### Applications to binary quadratic forms
+-/
+
+namespace legendre_sym
+
+/-- The Legendre symbol `legendre_sym p a = 1` if there is a solution in `ℤ/pℤ`
+of the equation `x^2 - a*y^2 = 0` with `y ≠ 0`. -/
+lemma eq_one_of_sq_sub_mul_sq_eq_zero {p : ℕ} [fact p.prime]
+  {a : ℤ} (ha : (a : zmod p) ≠ 0) {x y : zmod p} (hy : y ≠ 0) (hxy : x ^ 2 - a * y ^ 2 = 0) :
+  legendre_sym p a = 1 :=
+begin
+  apply_fun (* y⁻¹ ^ 2) at hxy,
+  simp only [zero_mul] at hxy,
+  rw [(by ring : (x ^ 2 - ↑a * y ^ 2) * y⁻¹ ^ 2 = (x * y⁻¹) ^ 2 - a * (y * y⁻¹) ^ 2),
+      mul_inv_cancel hy, one_pow, mul_one, sub_eq_zero, pow_two] at hxy,
+  exact (eq_one_iff p ha).mpr ⟨x * y⁻¹, hxy.symm⟩,
+end
+
+/-- The Legendre symbol `legendre_sym p a = 1` if there is a solution in `ℤ/pℤ`
+of the equation `x^2 - a*y^2 = 0` with `x ≠ 0`. -/
+lemma eq_one_of_sq_sub_mul_sq_eq_zero' {p : ℕ} [fact p.prime]
+  {a : ℤ} (ha : (a : zmod p) ≠ 0) {x y : zmod p} (hx : x ≠ 0) (hxy : x ^ 2 - a * y ^ 2 = 0) :
+  legendre_sym p a = 1 :=
+begin
+  have hy : y ≠ 0,
+  { rintro rfl,
+    rw [zero_pow' 2 (by norm_num), mul_zero, sub_zero, pow_eq_zero_iff (by norm_num : 0 < 2)]
+      at hxy,
+    exacts [hx hxy, infer_instance], }, -- why is the instance not inferred automatically?
+  exact eq_one_of_sq_sub_mul_sq_eq_zero ha hy hxy,
+end
+
+/-- If `legendre_sym p a = -1`, then the only solution of `x^2 - a*y^2 = 0` in `ℤ/pℤ`
+is the trivial one. -/
+lemma eq_zero_mod_of_eq_neg_one {p : ℕ} [fact p.prime] {a : ℤ}
+  (h : legendre_sym p a = -1) {x y : zmod p} (hxy : x ^ 2 - a * y ^ 2 = 0) : x = 0 ∧ y = 0 :=
+begin
+  have ha : (a : zmod p) ≠ 0,
+  { intro hf,
+    rw (eq_zero_iff p a).mpr hf at h,
+    exact int.zero_ne_neg_of_ne zero_ne_one h, },
+  by_contra hf,
+  cases not_and_distrib.mp hf with hx hy,
+  { rw [eq_one_of_sq_sub_mul_sq_eq_zero' ha hx hxy, eq_neg_self_iff] at h,
+    exact one_ne_zero h, },
+  { rw [eq_one_of_sq_sub_mul_sq_eq_zero ha hy hxy, eq_neg_self_iff] at h,
+    exact one_ne_zero h, }
+end
+
+/-- If `legendre_sym p a = -1` and `p` divides `x^2 - a*y^2`, then `p` must divide `x` and `y`. -/
+lemma prime_dvd_of_eq_neg_one {p : ℕ} [fact p.prime] {a : ℤ}
+  (h : legendre_sym p a = -1) {x y : ℤ} (hxy : ↑p ∣ x ^ 2 - a * y ^ 2) : ↑p ∣ x ∧ ↑p ∣ y :=
+begin
+  simp_rw ← zmod.int_coe_zmod_eq_zero_iff_dvd at hxy ⊢,
+  push_cast at hxy,
+  exact eq_zero_mod_of_eq_neg_one h hxy,
+end
+
+end legendre_sym
+
+end quadratic_form
+
+section values
+
+/-!
+### The value of the Legendre symbol at `-1`
+
+See `jacobi_sym.at_neg_one` for the corresponding statement for the Jacobi symbol.
+-/
+
+variables {p : ℕ} [fact p.prime]
+
+open zmod
+
+/-- `legendre_sym p (-1)` is given by `χ₄ p`. -/
+lemma legendre_sym.at_neg_one (hp : p ≠ 2) : legendre_sym p (-1) = χ₄ p :=
+by simp only [legendre_sym, card p, quadratic_char_neg_one ((ring_char_zmod_n p).substr hp),
+              int.cast_neg, int.cast_one]
+
+namespace zmod
+
+/-- `-1` is a square in `zmod p` iff `p` is not congruent to `3` mod `4`. -/
+lemma exists_sq_eq_neg_one_iff : is_square (-1 : zmod p) ↔ p % 4 ≠ 3 :=
+by rw [finite_field.is_square_neg_one_iff, card p]
+
+lemma mod_four_ne_three_of_sq_eq_neg_one {y : zmod p} (hy : y ^ 2 = -1) : p % 4 ≠ 3 :=
+exists_sq_eq_neg_one_iff.1 ⟨y, hy ▸ pow_two y⟩
+
+/-- If two nonzero squares are negatives of each other in `zmod p`, then `p % 4 ≠ 3`. -/
+lemma mod_four_ne_three_of_sq_eq_neg_sq' {x y : zmod p} (hy : y ≠ 0) (hxy : x ^ 2 = - y ^ 2) :
+  p % 4 ≠ 3 :=
+@mod_four_ne_three_of_sq_eq_neg_one p _ (x / y) begin
+  apply_fun (λ z, z / y ^ 2) at hxy,
+  rwa [neg_div, ←div_pow, ←div_pow, div_self hy, one_pow] at hxy
+end
+
+lemma mod_four_ne_three_of_sq_eq_neg_sq {x y : zmod p} (hx : x ≠ 0) (hxy : x ^ 2 = - y ^ 2) :
+  p % 4 ≠ 3 :=
+mod_four_ne_three_of_sq_eq_neg_sq' hx (neg_eq_iff_eq_neg.mpr hxy).symm
+
+end zmod
+
+end values
diff --git a/src/number_theory/legendre_symbol/gauss_eisenstein_lemmas.lean b/src/number_theory/legendre_symbol/gauss_eisenstein_lemmas.lean
index be4dcb44bc93b..293f6f86796bb 100644
--- a/src/number_theory/legendre_symbol/gauss_eisenstein_lemmas.lean
+++ b/src/number_theory/legendre_symbol/gauss_eisenstein_lemmas.lean
@@ -3,70 +3,24 @@ Copyright (c) 2018 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
-import field_theory.finite.basic
-import data.zmod.basic
+import number_theory.legendre_symbol.quadratic_reciprocity
 
 /-!
 # Lemmas of Gauss and Eisenstein
 
-This file contains code for the proof of the Lemmas of Gauss and Eisenstein
-on the Legendre symbol. The main results are `gauss_lemma_aux` and
-`eisenstein_lemma_aux`; they are used in `quadratic_reciprocity.lean`
-to prove `gauss_lemma` and `eisenstein_lemma`, respectively.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains the Lemmas of Gauss and Eisenstein on the Legendre symbol.
+The main results are `zmod.gauss_lemma` and `zmod.eisenstein_lemma`.
 -/
 
-open function finset nat finite_field zmod
+open finset nat
 open_locale big_operators nat
 
-namespace zmod
-
-section wilson
-
-variables (p : ℕ) [fact p.prime]
-
--- One can probably deduce the following from `finite_field.prod_univ_units_id_eq_neg_one`
-/-- **Wilson's Lemma**: the product of `1`, ..., `p-1` is `-1` modulo `p`. -/
-@[simp] lemma wilsons_lemma : ((p - 1)! : zmod p) = -1 :=
-begin
-  refine
-  calc ((p - 1)! : zmod p) = (∏ x in Ico 1 (succ (p - 1)), x) :
-    by rw [← finset.prod_Ico_id_eq_factorial, prod_nat_cast]
-                               ... = (∏ x : (zmod p)ˣ, x) : _
-                               ... = -1 : by simp_rw [← units.coe_hom_apply,
-    ← (units.coe_hom (zmod p)).map_prod, prod_univ_units_id_eq_neg_one, units.coe_hom_apply,
-    units.coe_neg, units.coe_one],
-  have hp : 0 < p := (fact.out p.prime).pos,
-  symmetry,
-  refine prod_bij (λ a _, (a : zmod p).val) _ _ _ _,
-  { intros a ha,
-    rw [mem_Ico, ← nat.succ_sub hp, nat.succ_sub_one],
-    split,
-    { apply nat.pos_of_ne_zero, rw ← @val_zero p,
-      assume h, apply units.ne_zero a (val_injective p h) },
-    { exact val_lt _ } },
-  { intros a ha, simp only [cast_id, nat_cast_val], },
-  { intros _ _ _ _ h, rw units.ext_iff, exact val_injective p h },
-  { intros b hb,
-    rw [mem_Ico, nat.succ_le_iff, ← succ_sub hp, succ_sub_one, pos_iff_ne_zero] at hb,
-    refine ⟨units.mk0 b _, finset.mem_univ _, _⟩,
-    { assume h, apply hb.1, apply_fun val at h,
-      simpa only [val_cast_of_lt hb.right, val_zero] using h },
-    { simp only [val_cast_of_lt hb.right, units.coe_mk0], } }
-end
-
-@[simp] lemma prod_Ico_one_prime : (∏ x in Ico 1 p, (x : zmod p)) = -1 :=
-begin
-  conv in (Ico 1 p) { rw [← succ_sub_one p, succ_sub (fact.out p.prime).pos] },
-  rw [← prod_nat_cast, finset.prod_Ico_id_eq_factorial, wilsons_lemma]
-end
-
-end wilson
-
-end zmod
-
 section gauss_eisenstein
 
-namespace legendre_symbol
+namespace zmod
 
 /-- The image of the map sending a non zero natural number `x ≤ p / 2` to the absolute value
   of the element of interger in the interval `(-p/2, p/2]` congruent to `a * x` mod p is the set
@@ -136,7 +90,7 @@ calc (a ^ (p / 2) * (p / 2)! : zmod p) =
       (λ _ _ _ _ _ _, id)
       (λ b h _, ⟨b, by simp [-not_le, *] at *⟩)
       (by intros; split_ifs at *; simp * at *),
-  by rw [prod_mul_distrib, this]; simp
+  by rw [prod_mul_distrib, this, prod_const]
 ... = (-1)^((Ico 1 (p / 2).succ).filter
       (λ x : ℕ, ¬(a * x : zmod p).val ≤ p / 2)).card * (p / 2)! :
   by rw [← prod_nat_cast, finset.prod_eq_multiset_prod,
@@ -153,6 +107,23 @@ lemma gauss_lemma_aux (p : ℕ) [hp : fact p.prime] [fact (p % 2 = 1)]
           exact nat.div_lt_self hp.1.pos dec_trivial)).1 $
   by simpa using gauss_lemma_aux₁ p hap
 
+/-- Gauss' lemma. The legendre symbol can be computed by considering the number of naturals less
+  than `p/2` such that `(a * x) % p > p / 2` -/
+lemma gauss_lemma {p : ℕ} [fact p.prime] {a : ℤ} (hp : p ≠ 2) (ha0 : (a : zmod p) ≠ 0) :
+  legendre_sym p a = (-1) ^ ((Ico 1 (p / 2).succ).filter
+    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card :=
+begin
+  haveI hp' : fact (p % 2 = 1) := ⟨nat.prime.mod_two_eq_one_iff_ne_two.mpr hp⟩,
+  haveI : fact (2 < p) := ⟨hp.lt_of_le' (fact.out p.prime).two_le⟩,
+  have : (legendre_sym p a : zmod p) = (((-1)^((Ico 1 (p / 2).succ).filter
+    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card : ℤ) : zmod p) :=
+    by { rw [legendre_sym.eq_pow, gauss_lemma_aux p ha0]; simp },
+  cases legendre_sym.eq_one_or_neg_one p ha0;
+  cases neg_one_pow_eq_or ℤ ((Ico 1 (p / 2).succ).filter
+    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card;
+  simp only [*, neg_one_ne_one, neg_one_ne_one.symm, algebra_map.coe_one, int.cast_neg] at *,
+end
+
 private lemma eisenstein_lemma_aux₁ (p : ℕ) [fact p.prime] [hp2 : fact (p % 2 = 1)]
   {a : ℕ} (hap : (a : zmod p) ≠ 0) :
   ((∑ x in Ico 1 (p / 2).succ, a * x : ℕ) : zmod 2) =
@@ -200,15 +171,14 @@ calc a / b = (Ico 1 (a / b).succ).card : by simp
 ... = ((Ico 1 c.succ).filter (λ x, x * b ≤ a)).card :
   congr_arg _ $ finset.ext $ λ x,
     have x * b ≤ a → x ≤ c,
-      from λ h, le_trans (by rwa [le_div_iff_mul_le _ _ hb0]) hc,
-    by simp [lt_succ_iff, le_div_iff_mul_le _ _ hb0]; tauto
+      from λ h, le_trans (by rwa [le_div_iff_mul_le hb0]) hc,
+    by simp [lt_succ_iff, le_div_iff_mul_le hb0]; tauto
 
 /-- The given sum is the number of integer points in the triangle formed by the diagonal of the
   rectangle `(0, p/2) × (0, q/2)`  -/
 private lemma sum_Ico_eq_card_lt {p q : ℕ} :
-  ∑ a in Ico 1 (p / 2).succ, (a * q) / p =
-  (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
-  (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q)).card :=
+  ∑ a in Ico 1 (p / 2).succ, (a * q) / p = ((Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ).filter $
+    λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q).card :=
 if hp0 : p = 0 then by simp [hp0, finset.ext_iff]
 else
   calc ∑ a in Ico 1 (p / 2).succ, (a * q) / p =
@@ -240,9 +210,9 @@ lemma sum_mul_div_add_sum_mul_div_eq_mul (p q : ℕ) [hp : fact p.prime]
   ∑ a in Ico 1 (q / 2).succ, (a * p) / q =
   (p / 2) * (q / 2) :=
 begin
-  have hswap : (((Ico 1 (q / 2).succ).product (Ico 1 (p / 2).succ)).filter
+  have hswap : ((Ico 1 (q / 2).succ ×ˢ Ico 1 (p / 2).succ).filter
     (λ x : ℕ × ℕ, x.2 * q ≤ x.1 * p)).card =
-  (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
+  ((Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ).filter
     (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p)).card :=
   card_congr (λ x _, prod.swap x)
     (λ ⟨_, _⟩, by simp only [mem_filter, and_self, prod.swap_prod_mk, forall_true_iff, mem_product]
@@ -252,9 +222,9 @@ begin
     (λ ⟨x₁, x₂⟩ h, ⟨⟨x₂, x₁⟩, by revert h; simp only [mem_filter, eq_self_iff_true, and_self,
       exists_prop_of_true, prod.swap_prod_mk, forall_true_iff, mem_product] {contextual := tt}⟩),
   have hdisj : disjoint
-    (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
+    ((Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ).filter
       (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q))
-    (((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
+    ((Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ).filter
       (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p)),
   { apply disjoint_filter.2 (λ x hx hpq hqp, _),
     have hxp : x.1 < p, from lt_of_le_of_lt
@@ -265,11 +235,11 @@ begin
     apply_fun zmod.val at this,
     rw [val_cast_of_lt hxp, val_zero] at this,
     simpa only [this, nonpos_iff_eq_zero, mem_Ico, one_ne_zero, false_and, mem_product] using hx },
-  have hunion : ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
+  have hunion : (Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ).filter
       (λ x : ℕ × ℕ, x.2 * p ≤ x.1 * q) ∪
-    ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)).filter
+    (Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ).filter
       (λ x : ℕ × ℕ, x.1 * q ≤ x.2 * p) =
-    ((Ico 1 (p / 2).succ).product (Ico 1 (q / 2).succ)),
+    (Ico 1 (p / 2).succ ×ˢ Ico 1 (q / 2).succ),
   from finset.ext (λ x, by have := le_total (x.2 * p) (x.1 * q);
     simp only [mem_union, mem_filter, mem_Ico, mem_product]; tauto),
   rw [sum_Ico_eq_card_lt, sum_Ico_eq_card_lt, hswap, ← card_disjoint_union hdisj, hunion,
@@ -277,6 +247,17 @@ begin
   simp only [card_Ico, tsub_zero, succ_sub_succ_eq_sub]
 end
 
-end legendre_symbol
+lemma eisenstein_lemma {p : ℕ} [fact p.prime] (hp : p ≠ 2) {a : ℕ} (ha1 : a % 2 = 1)
+  (ha0 : (a : zmod p) ≠ 0) :
+  legendre_sym p a = (-1)^∑ x in Ico 1 (p / 2).succ, (x * a) / p :=
+begin
+  haveI hp' : fact (p % 2 = 1) := ⟨nat.prime.mod_two_eq_one_iff_ne_two.mpr hp⟩,
+  have ha0' : ((a : ℤ) : zmod p) ≠ 0 := by { norm_cast, exact ha0 },
+  rw [neg_one_pow_eq_pow_mod_two, gauss_lemma hp ha0', neg_one_pow_eq_pow_mod_two,
+      (by norm_cast : ((a : ℤ) : zmod p) = (a : zmod p)),
+      show _ = _, from eisenstein_lemma_aux p ha1 ha0]
+end
+
+end zmod
 
 end gauss_eisenstein
diff --git a/src/number_theory/legendre_symbol/gauss_sum.lean b/src/number_theory/legendre_symbol/gauss_sum.lean
new file mode 100644
index 0000000000000..d3eec3b506a90
--- /dev/null
+++ b/src/number_theory/legendre_symbol/gauss_sum.lean
@@ -0,0 +1,321 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import number_theory.legendre_symbol.add_character
+import number_theory.legendre_symbol.zmod_char
+import algebra.char_p.char_and_card
+
+/-!
+# Gauss sums
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the Gauss sum associated to a multiplicative and an additive
+character of a finite field and prove some results about them.
+
+## Main definition
+
+Let `R` be a finite commutative ring and let `R'` be another commutative ring.
+If `χ` is a multiplicative character `R → R'` (type `mul_char R R'`) and `ψ`
+is an additive character `R → R'` (type `add_char R R'`, which abbreviates
+`(multiplicative R) →* R'`), then the *Gauss sum* of `χ` and `ψ` is `∑ a, χ a * ψ a`.
+
+## Main results
+
+Some important results are as follows.
+
+* `gauss_sum_mul_gauss_sum_eq_card`: The product of the Gauss
+  sums of `χ` and `ψ` and that of `χ⁻¹` and `ψ⁻¹` is the cardinality
+  of the source ring `R` (if `χ` is nontrivial, `ψ` is primitive and `R` is a field).
+* `gauss_sum_sq`: The square of the Gauss sum is `χ(-1)` times
+  the cardinality of `R` if in addition `χ` is a quadratic character.
+* `quad_gauss_sum_frob`: For a quadratic character `χ`, raising
+  the Gauss sum to the `p`th power (where `p` is the characteristic of
+  the target ring `R'`) multiplies it by `χ p`.
+* `char.card_pow_card`: When `F` and `F'` are finite fields and `χ : F → F'`
+  is a nontrivial quadratic character, then `(χ (-1) * #F)^(#F'/2) = χ (#F')`.
+* `finite_field.two_pow_card`: For every finite field `F` of odd characteristic,
+  we have `2^(#F/2) = χ₈(#F)` in `F`.
+
+This machinery can be used to derive (a generalization of) the Law of
+Quadratic Reciprocity.
+
+## Tags
+
+additive character, multiplicative character, Gauss sum
+-/
+
+universes u v
+
+open_locale big_operators
+
+open add_char mul_char
+
+section gauss_sum_def
+
+-- `R` is the domain of the characters
+variables {R : Type u} [comm_ring R] [fintype R]
+-- `R'` is the target of the characters
+variables {R' : Type v} [comm_ring R']
+
+/-!
+### Definition and first properties
+-/
+
+/-- Definition of the Gauss sum associated to a multiplicative and an additive character. -/
+def gauss_sum (χ : mul_char R R') (ψ : add_char R R') : R' := ∑ a, χ a * ψ a
+
+/-- Replacing `ψ` by `mul_shift ψ a` and multiplying the Gauss sum by `χ a` does not change it. -/
+lemma gauss_sum_mul_shift (χ : mul_char R R') (ψ : add_char R R') (a : Rˣ) :
+  χ a * gauss_sum χ (mul_shift ψ a) = gauss_sum χ ψ :=
+begin
+  simp only [gauss_sum, mul_shift_apply, finset.mul_sum],
+  simp_rw [← mul_assoc, ← map_mul],
+  exact fintype.sum_bijective _ a.mul_left_bijective _ _ (λ x, rfl),
+end
+
+end gauss_sum_def
+
+/-!
+### The product of two Gauss sums
+-/
+
+section gauss_sum_prod
+
+-- In the following, we need `R` to be a finite field and `R'` to be a domain.
+variables {R : Type u} [field R] [fintype R] {R' : Type v} [comm_ring R'] [is_domain R']
+
+-- A helper lemma for `gauss_sum_mul_gauss_sum_eq_card` below
+-- Is this useful enough in other contexts to be public?
+private
+lemma gauss_sum_mul_aux {χ : mul_char R R'} (hχ : is_nontrivial χ) (ψ : add_char R R') (b : R) :
+  ∑ a, χ (a * b⁻¹) * ψ (a - b) = ∑ c, χ c * ψ (b * (c - 1)) :=
+begin
+  cases eq_or_ne b 0 with hb hb,
+  { -- case `b = 0`
+    simp only [hb, inv_zero, mul_zero, mul_char.map_zero, zero_mul, finset.sum_const_zero,
+               map_zero_one, mul_one],
+    exact hχ.sum_eq_zero.symm, },
+  { -- case `b ≠ 0`
+    refine (fintype.sum_bijective _ (mul_left_bijective₀ b hb) _ _ $ λ x, _).symm,
+    rw [mul_assoc, mul_comm x, ← mul_assoc, mul_inv_cancel hb, one_mul, mul_sub, mul_one] },
+end
+
+/-- We have `gauss_sum χ ψ * gauss_sum χ⁻¹ ψ⁻¹ = fintype.card R`
+when `χ` is nontrivial and `ψ` is primitive (and `R` is a field). -/
+lemma gauss_sum_mul_gauss_sum_eq_card  {χ : mul_char R R'} (hχ : is_nontrivial χ)
+  {ψ : add_char R R'} (hψ : is_primitive ψ) :
+  gauss_sum χ ψ * gauss_sum χ⁻¹ ψ⁻¹ = fintype.card R :=
+begin
+  simp only [gauss_sum, add_char.inv_apply, finset.sum_mul, finset.mul_sum, mul_char.inv_apply'],
+  conv in (_ * _ * (_ * _))
+    { rw [mul_mul_mul_comm, ← map_mul, ← map_add_mul, ← sub_eq_add_neg], },
+  simp_rw gauss_sum_mul_aux hχ ψ,
+  rw [finset.sum_comm],
+  classical, -- to get `[decidable_eq R]` for `sum_mul_shift`
+  simp_rw [← finset.mul_sum, sum_mul_shift _ hψ, sub_eq_zero, mul_ite, mul_zero],
+  rw [finset.sum_ite_eq' finset.univ (1 : R)],
+  simp only [finset.mem_univ, map_one, one_mul, if_true],
+end
+
+/-- When `χ` is a nontrivial quadratic character, then the square of `gauss_sum χ ψ`
+is `χ(-1)` times the cardinality of `R`. -/
+lemma gauss_sum_sq  {χ : mul_char R R'} (hχ₁ : is_nontrivial χ) (hχ₂ : is_quadratic χ)
+  {ψ : add_char R R'} (hψ : is_primitive ψ) :
+  (gauss_sum χ ψ) ^ 2 = χ (-1) * fintype.card R :=
+begin
+  rw [pow_two, ← gauss_sum_mul_gauss_sum_eq_card hχ₁ hψ, hχ₂.inv, mul_rotate'],
+  congr,
+  rw [mul_comm, ← gauss_sum_mul_shift _ _ (-1 : Rˣ), inv_mul_shift],
+  refl,
+end
+
+end gauss_sum_prod
+
+/-!
+### Gauss sums and Frobenius
+-/
+
+section gauss_sum_frob
+
+variables {R : Type u} [comm_ring R] [fintype R] {R' : Type v} [comm_ring R']
+-- We assume that the target ring `R'` has prime characteristic `p`.
+variables (p : ℕ) [fp : fact p.prime] [hch : char_p R' p]
+include fp hch
+
+/-- When `R'` has prime characteristic `p`, then the `p`th power of the Gauss sum
+of `χ` and `ψ` is the Gauss sum of `χ^p` and `ψ^p`. -/
+lemma gauss_sum_frob (χ : mul_char R R') (ψ : add_char R R') :
+  gauss_sum χ ψ ^ p = gauss_sum (χ ^ p) (ψ ^ p) :=
+begin
+  rw [← frobenius_def, gauss_sum, gauss_sum, map_sum],
+  simp_rw [pow_apply' χ fp.1.pos, map_mul, frobenius_def],
+  refl,
+end
+
+/-- For a quadratic character `χ` and when the characteristic `p` of the target ring
+is a unit in the source ring, the `p`th power of the Gauss sum of`χ` and `ψ` is
+`χ p` times the original Gauss sum. -/
+lemma mul_char.is_quadratic.gauss_sum_frob (hp : is_unit (p : R)) {χ : mul_char R R'}
+  (hχ : is_quadratic χ) (ψ : add_char R R') :
+  gauss_sum χ ψ ^ p = χ p * gauss_sum χ ψ :=
+by rw [gauss_sum_frob, pow_mul_shift, hχ.pow_char p, ← gauss_sum_mul_shift χ ψ hp.unit,
+       ← mul_assoc, hp.unit_spec, ← pow_two, ← pow_apply' _ (by norm_num : 0 < 2),
+       hχ.sq_eq_one, ← hp.unit_spec, one_apply_coe, one_mul]
+
+/-- For a quadratic character `χ` and when the characteristic `p` of the target ring
+is a unit in the source ring and `n` is a natural number, the `p^n`th power of the Gauss
+sum of`χ` and `ψ` is `χ (p^n)` times the original Gauss sum. -/
+lemma mul_char.is_quadratic.gauss_sum_frob_iter (n : ℕ) (hp : is_unit (p : R))
+  {χ : mul_char R R'} (hχ : is_quadratic χ) (ψ : add_char R R') :
+  gauss_sum χ ψ ^ (p ^ n) = χ (p ^ n) * gauss_sum χ ψ :=
+begin
+  induction n with n ih,
+  { rw [pow_zero, pow_one, pow_zero, mul_char.map_one, one_mul], },
+  { rw [pow_succ, mul_comm p, pow_mul, ih, mul_pow, hχ.gauss_sum_frob _ hp,
+        ← mul_assoc, pow_succ, mul_comm (p : R), map_mul,
+        ← pow_apply' χ fp.1.pos (p ^ n), hχ.pow_char p], },
+end
+
+end gauss_sum_frob
+
+/-!
+### Values of quadratic characters
+-/
+
+section gauss_sum_values
+
+variables {R : Type u} [comm_ring R] [fintype R] {R' : Type v} [comm_ring R'] [is_domain R']
+
+/-- If the square of the Gauss sum of a quadratic character is `χ(-1) * #R`,
+then we get, for all `n : ℕ`, the relation `(χ(-1) * #R) ^ (p^n/2) = χ(p^n)`,
+where `p` is the (odd) characteristic of the target ring `R'`.
+This version can be used when `R` is not a field, e.g., `ℤ/8ℤ`. -/
+lemma char.card_pow_char_pow {χ : mul_char R R'} (hχ : is_quadratic χ) (ψ : add_char R R') (p n : ℕ)
+  [fp : fact p.prime] [hch : char_p R' p] (hp : is_unit (p : R)) (hp' : p ≠ 2)
+  (hg : (gauss_sum χ ψ) ^ 2 = χ (-1) * fintype.card R) :
+  (χ (-1) * fintype.card R) ^ (p ^ n / 2) = χ (p ^ n) :=
+begin
+  have : gauss_sum χ ψ ≠ 0,
+  { intro hf, rw [hf, zero_pow (by norm_num : 0 < 2), eq_comm, mul_eq_zero] at hg,
+    exact not_is_unit_prime_of_dvd_card p
+      ((char_p.cast_eq_zero_iff R' p _).mp $ hg.resolve_left (is_unit_one.neg.map χ).ne_zero) hp },
+  rw ← hg, apply mul_right_cancel₀ this,
+  rw [← hχ.gauss_sum_frob_iter p n hp ψ, ← pow_mul, mul_comm, ← pow_succ,
+      nat.two_mul_div_two_add_one_of_odd ((fp.1.eq_two_or_odd').resolve_left hp').pow],
+end
+
+/-- When `F` and `F'` are finite fields and `χ : F → F'` is a nontrivial quadratic character,
+then `(χ(-1) * #F)^(#F'/2) = χ(#F')`. -/
+lemma char.card_pow_card {F : Type*} [field F] [fintype F] {F' : Type*} [field F'] [fintype F']
+  {χ : mul_char F F'} (hχ₁ : is_nontrivial χ) (hχ₂ : is_quadratic χ)
+  (hch₁ : ring_char F' ≠ ring_char F) (hch₂ : ring_char F' ≠ 2) :
+  (χ (-1) * fintype.card F) ^ (fintype.card F' / 2) = χ (fintype.card F') :=
+begin
+  obtain ⟨n, hp, hc⟩ := finite_field.card F (ring_char F),
+  obtain ⟨n', hp', hc'⟩ := finite_field.card F' (ring_char F'),
+  let ψ := primitive_char_finite_field F F' hch₁,
+  let FF' := cyclotomic_field ψ.n F',
+  have hchar := algebra.ring_char_eq F' FF',
+  apply (algebra_map F' FF').injective,
+  rw [map_pow, map_mul, map_nat_cast, hc', hchar, nat.cast_pow],
+  simp only [← mul_char.ring_hom_comp_apply],
+  haveI := fact.mk hp',
+  haveI := fact.mk (hchar.subst hp'),
+  rw [ne, ← nat.prime_dvd_prime_iff_eq hp' hp, ← is_unit_iff_not_dvd_char, hchar] at hch₁,
+  exact char.card_pow_char_pow (hχ₂.comp _) ψ.char (ring_char FF') n' hch₁ (hchar ▸ hch₂)
+    (gauss_sum_sq (hχ₁.comp $ ring_hom.injective _) (hχ₂.comp _) ψ.prim),
+end
+
+end gauss_sum_values
+
+section gauss_sum_two
+
+/-!
+### The quadratic character of 2
+
+This section proves the following result.
+
+For every finite field `F` of odd characteristic, we have `2^(#F/2) = χ₈(#F)` in `F`.
+This can be used to show that the quadratic character of `F` takes the value
+`χ₈(#F)` at `2`.
+
+The proof uses the Gauss sum of `χ₈` and a primitive additive character on `ℤ/8ℤ`;
+in this way, the result is reduced to `card_pow_char_pow`.
+-/
+
+open zmod
+
+/-- For every finite field `F` of odd characteristic, we have `2^(#F/2) = χ₈(#F)` in `F`. -/
+lemma finite_field.two_pow_card {F : Type*} [fintype F] [field F] (hF : ring_char F ≠ 2) :
+  (2 : F) ^ (fintype.card F / 2) = χ₈ (fintype.card F) :=
+begin
+  have hp2 : ∀ (n : ℕ), (2 ^ n : F) ≠ 0 := λ n, pow_ne_zero n (ring.two_ne_zero hF),
+  obtain ⟨n, hp, hc⟩ := finite_field.card F (ring_char F),
+
+  -- we work in `FF`, the eighth cyclotomic field extension of `F`
+  let FF := (polynomial.cyclotomic 8 F).splitting_field,
+  haveI : finite_dimensional F FF :=
+    polynomial.is_splitting_field.finite_dimensional FF (polynomial.cyclotomic 8 F),
+  haveI : fintype FF := finite_dimensional.fintype_of_fintype F FF,
+  have hchar := algebra.ring_char_eq F FF,
+  have FFp := hchar.subst hp,
+  haveI := fact.mk FFp,
+  have hFF := ne_of_eq_of_ne hchar.symm hF, -- `ring_char FF ≠ 2`
+  have hu : is_unit (ring_char FF : zmod 8),
+  { rw [is_unit_iff_not_dvd_char, ring_char_zmod_n],
+    rw [ne, ← nat.prime_dvd_prime_iff_eq FFp nat.prime_two] at hFF,
+    change ¬ _ ∣ 2 ^ 3,
+    exact mt FFp.dvd_of_dvd_pow hFF },
+
+  -- there is a primitive additive character `ℤ/8ℤ → FF`, sending `a + 8ℤ ↦ τ^a`
+  -- with a primitive eighth root of unity `τ`
+  let ψ₈ := primitive_zmod_char 8 F (by convert hp2 3; norm_num),
+  let τ : FF := ψ₈.char 1,
+  have τ_spec : τ ^ 4 = -1,
+  { refine (sq_eq_one_iff.1 _).resolve_left _;
+    { simp only [τ, ← map_nsmul_pow],
+      erw add_char.is_primitive.zmod_char_eq_one_iff 8 ψ₈.prim,
+      dec_trivial } },
+
+  -- we consider `χ₈` as a multiplicative character `ℤ/8ℤ → FF`
+  let χ := χ₈.ring_hom_comp (int.cast_ring_hom FF),
+  have hχ : χ (-1) = 1 := norm_num.int_cast_one,
+  have hq : is_quadratic χ := is_quadratic_χ₈.comp _,
+
+  -- we now show that the Gauss sum of `χ` and `ψ₈` has the relevant property
+  have hg : gauss_sum χ ψ₈.char ^ 2 = χ (-1) * fintype.card (zmod 8),
+  { have h := congr_arg (^ 2) (fin.sum_univ_eight $ λ x, (χ₈ x : FF) * τ ^ x.1),
+    have h₁ : (λ (i : fin 8), ↑(χ₈ i) * τ ^ i.val) = λ (a : zmod 8), χ a * ψ₈.char a,
+    { ext, congr, apply pow_one },
+    have h₂ : (0 + 1 * τ ^ 1 + 0 + (-1) * τ ^ 3 + 0 + (-1) * τ ^ 5 + 0 + 1 * τ ^ 7) ^ 2 =
+      8 + (τ ^ 4 + 1) * (τ ^ 10 - 2 * τ ^ 8 - 2 * τ ^ 6 + 6 * τ ^ 4 + τ ^ 2 - 8) := by ring,
+    have h₃ : 8 + (τ ^ 4 + 1) * (τ ^ 10 - 2 * τ ^ 8 - 2 * τ ^ 6 + 6 * τ ^ 4 + τ ^ 2 - 8) =
+      ↑8 := by { rw τ_spec, norm_num },
+    have h₄ : (0 + 1 * τ ^ 1 + 0 + (-1) * τ ^ 3 + 0 + (-1) * τ ^ 5 + 0 + 1 * τ ^ 7) ^ 2 = ↑8,
+    { rw [← h₃, ← h₂] },
+    have h₅ : (λ (x : FF), x ^ 2) (↑(χ₈ 0) * τ ^ 0 + ↑(χ₈ 1) * τ ^ 1 + ↑(χ₈ 2) * τ ^ 2 +
+      ↑(χ₈ 3) * τ ^ 3 + ↑(χ₈ 4) * τ ^ 4 + ↑(χ₈ 5) * τ ^ 5 + ↑(χ₈ 6) * τ ^ 6 + ↑(χ₈ 7) * τ ^ 7) = ↑8,
+    { simp only [←h₄, χ₈_apply, matrix.cons_val_zero, algebra_map.coe_zero, zero_mul,
+        matrix.cons_val_one, matrix.head_cons, algebra_map.coe_one, matrix.cons_vec_bit0_eq_alt0,
+        matrix.cons_vec_append, matrix.cons_vec_alt0, matrix.cons_vec_bit1_eq_alt1,
+        matrix.cons_vec_alt1, int.cast_neg] },
+    simpa only [hχ, one_mul, card, gauss_sum, ← h₅, h₁] using h, },
+
+  -- this allows us to apply `card_pow_char_pow` to our situation
+  have h := char.card_pow_char_pow hq ψ₈.char (ring_char FF) n hu hFF hg,
+  rw [card, ← hchar, hχ, one_mul, ← hc, ← nat.cast_pow (ring_char F), ← hc] at h,
+
+  -- finally, we change `2` to `8` on the left hand side
+  convert_to (8 : F) ^ (fintype.card F / 2) = _,
+  { rw [(by norm_num : (8 : F) = 2 ^ 2 * 2), mul_pow,
+      (finite_field.is_square_iff hF $ hp2 2).mp ⟨2, pow_two 2⟩, one_mul] },
+  apply (algebra_map F FF).injective,
+  simp only [map_pow, map_bit0, map_one, map_int_cast],
+  convert h, norm_num,
+end
+
+end gauss_sum_two
diff --git a/src/number_theory/legendre_symbol/jacobi_symbol.lean b/src/number_theory/legendre_symbol/jacobi_symbol.lean
new file mode 100644
index 0000000000000..7cead399fc0db
--- /dev/null
+++ b/src/number_theory/legendre_symbol/jacobi_symbol.lean
@@ -0,0 +1,446 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import number_theory.legendre_symbol.quadratic_reciprocity
+
+/-!
+# The Jacobi Symbol
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the Jacobi symbol and prove its main properties.
+
+## Main definitions
+
+We define the Jacobi symbol, `jacobi_sym a b`, for integers `a` and natural numbers `b`
+as the product over the prime factors `p` of `b` of the Legendre symbols `legendre_sym p a`.
+This agrees with the mathematical definition when `b` is odd.
+
+The prime factors are obtained via `nat.factors`. Since `nat.factors 0 = []`,
+this implies in particular that `jacobi_sym a 0 = 1` for all `a`.
+
+## Main statements
+
+We prove the main properties of the Jacobi symbol, including the following.
+
+* Multiplicativity in both arguments (`jacobi_sym.mul_left`, `jacobi_sym.mul_right`)
+
+* The value of the symbol is `1` or `-1` when the arguments are coprime
+  (`jacobi_sym.eq_one_or_neg_one`)
+
+* The symbol vanishes if and only if `b ≠ 0` and the arguments are not coprime
+  (`jacobi_sym.eq_zero_iff`)
+
+* If the symbol has the value `-1`, then `a : zmod b` is not a square
+  (`zmod.nonsquare_of_jacobi_sym_eq_neg_one`); the converse holds when `b = p` is a prime
+  (`zmod.nonsquare_iff_jacobi_sym_eq_neg_one`); in particular, in this case `a` is a
+  square mod `p` when the symbol has the value `1` (`zmod.is_square_of_jacobi_sym_eq_one`).
+
+* Quadratic reciprocity (`jacobi_sym.quadratic_reciprocity`,
+  `jacobi_sym.quadratic_reciprocity_one_mod_four`,
+  `jacobi_sym.quadratic_reciprocity_three_mod_four`)
+
+* The supplementary laws for `a = -1`, `a = 2`, `a = -2` (`jacobi_sym.at_neg_one`,
+  `jacobi_sym.at_two`, `jacobi_sym.at_neg_two`)
+
+* The symbol depends on `a` only via its residue class mod `b` (`jacobi_sym.mod_left`)
+  and on `b` only via its residue class mod `4*a` (`jacobi_sym.mod_right`)
+
+## Notations
+
+We define the notation `J(a | b)` for `jacobi_sym a b`, localized to `number_theory_symbols`.
+
+## Tags
+Jacobi symbol, quadratic reciprocity
+-/
+
+section jacobi
+
+/-!
+### Definition of the Jacobi symbol
+
+We define the Jacobi symbol $\Bigl(\frac{a}{b}\Bigr)$ for integers `a` and natural numbers `b`
+as the product of the Legendre symbols $\Bigl(\frac{a}{p}\Bigr)$, where `p` runs through the
+prime divisors (with multiplicity) of `b`, as provided by `b.factors`. This agrees with the
+Jacobi symbol when `b` is odd and gives less meaningful values when it is not (e.g., the symbol
+is `1` when `b = 0`). This is called `jacobi_sym a b`.
+
+We define localized notation (locale `number_theory_symbols`) `J(a | b)` for the Jacobi
+symbol `jacobi_sym a b`.
+-/
+
+open nat zmod
+
+/-- The Jacobi symbol of `a` and `b` -/
+-- Since we need the fact that the factors are prime, we use `list.pmap`.
+def jacobi_sym (a : ℤ) (b : ℕ) : ℤ :=
+(b.factors.pmap (λ p pp, @legendre_sym p ⟨pp⟩ a) (λ p pf, prime_of_mem_factors pf)).prod
+
+-- Notation for the Jacobi symbol.
+localized "notation `J(` a ` | ` b `)` := jacobi_sym a b" in number_theory_symbols
+
+/-!
+### Properties of the Jacobi symbol
+-/
+namespace jacobi_sym
+
+/-- The symbol `J(a | 0)` has the value `1`. -/
+@[simp] lemma zero_right (a : ℤ) : J(a | 0) = 1 :=
+by simp only [jacobi_sym, factors_zero, list.prod_nil, list.pmap]
+
+/-- The symbol `J(a | 1)` has the value `1`. -/
+@[simp] lemma one_right (a : ℤ) : J(a | 1) = 1 :=
+by simp only [jacobi_sym, factors_one, list.prod_nil, list.pmap]
+
+/-- The Legendre symbol `legendre_sym p a` with an integer `a` and a prime number `p`
+is the same as the Jacobi symbol `J(a | p)`. -/
+lemma _root_.legendre_sym.to_jacobi_sym (p : ℕ) [fp : fact p.prime] (a : ℤ) :
+  legendre_sym p a = J(a | p) :=
+by simp only [jacobi_sym, factors_prime fp.1, list.prod_cons, list.prod_nil, mul_one, list.pmap]
+
+/-- The Jacobi symbol is multiplicative in its second argument. -/
+lemma mul_right' (a : ℤ) {b₁ b₂ : ℕ} (hb₁ : b₁ ≠ 0) (hb₂ : b₂ ≠ 0) :
+  J(a | b₁ * b₂) = J(a | b₁) * J(a | b₂) :=
+begin
+  rw [jacobi_sym, ((perm_factors_mul hb₁ hb₂).pmap _).prod_eq, list.pmap_append, list.prod_append],
+  exacts [rfl, λ p hp, (list.mem_append.mp hp).elim prime_of_mem_factors prime_of_mem_factors],
+end
+
+/-- The Jacobi symbol is multiplicative in its second argument. -/
+lemma mul_right (a : ℤ) (b₁ b₂ : ℕ) [ne_zero b₁] [ne_zero b₂] :
+  J(a | b₁ * b₂) = J(a | b₁) * J(a | b₂) :=
+mul_right' a (ne_zero.ne b₁) (ne_zero.ne b₂)
+
+/-- The Jacobi symbol takes only the values `0`, `1` and `-1`. -/
+lemma trichotomy (a : ℤ) (b : ℕ) : J(a | b) = 0 ∨ J(a | b) = 1 ∨ J(a | b) = -1 :=
+((@sign_type.cast_hom ℤ _ _).to_monoid_hom.mrange.copy {0, 1, -1} $
+  by {rw set.pair_comm, exact (sign_type.range_eq sign_type.cast_hom).symm}).list_prod_mem
+begin
+  intros _ ha',
+  rcases list.mem_pmap.mp ha' with ⟨p, hp, rfl⟩,
+  haveI : fact p.prime := ⟨prime_of_mem_factors hp⟩,
+  exact quadratic_char_is_quadratic (zmod p) a,
+end
+
+/-- The symbol `J(1 | b)` has the value `1`. -/
+@[simp] lemma one_left (b : ℕ) : J(1 | b) = 1 :=
+list.prod_eq_one (λ z hz,
+                  let ⟨p, hp, he⟩ := list.mem_pmap.1 hz in by rw [← he, legendre_sym.at_one])
+
+/-- The Jacobi symbol is multiplicative in its first argument. -/
+lemma mul_left (a₁ a₂ : ℤ) (b : ℕ) : J(a₁ * a₂ | b) = J(a₁ | b) * J(a₂ | b) :=
+by { simp_rw [jacobi_sym, list.pmap_eq_map_attach, legendre_sym.mul], exact list.prod_map_mul }
+
+/-- The symbol `J(a | b)` vanishes iff `a` and `b` are not coprime (assuming `b ≠ 0`). -/
+lemma eq_zero_iff_not_coprime {a : ℤ} {b : ℕ} [ne_zero b] : J(a | b) = 0 ↔ a.gcd b ≠ 1 :=
+list.prod_eq_zero_iff.trans begin
+  rw [list.mem_pmap, int.gcd_eq_nat_abs, ne, prime.not_coprime_iff_dvd],
+  simp_rw [legendre_sym.eq_zero_iff, int_coe_zmod_eq_zero_iff_dvd, mem_factors (ne_zero.ne b),
+    ← int.coe_nat_dvd_left, int.coe_nat_dvd, exists_prop, and_assoc, and_comm],
+end
+
+/-- The symbol `J(a | b)` is nonzero when `a` and `b` are coprime. -/
+protected
+lemma ne_zero {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a | b) ≠ 0 :=
+begin
+  casesI eq_zero_or_ne_zero b with hb,
+  { rw [hb, zero_right],
+    exact one_ne_zero },
+  { contrapose! h, exact eq_zero_iff_not_coprime.1 h },
+end
+
+/-- The symbol `J(a | b)` vanishes if and only if `b ≠ 0` and `a` and `b` are not coprime. -/
+lemma eq_zero_iff {a : ℤ} {b : ℕ} : J(a | b) = 0 ↔ b ≠ 0 ∧ a.gcd b ≠ 1 :=
+⟨λ h, begin
+  casesI eq_or_ne b 0 with hb hb,
+  { rw [hb, zero_right] at h, cases h },
+  exact ⟨hb, mt jacobi_sym.ne_zero $ not_not.2 h⟩,
+end, λ ⟨hb, h⟩, by { rw ← ne_zero_iff at hb, exactI eq_zero_iff_not_coprime.2 h }⟩
+
+/-- The symbol `J(0 | b)` vanishes when `b > 1`. -/
+lemma zero_left {b : ℕ} (hb : 1 < b) : J(0 | b) = 0 :=
+(@eq_zero_iff_not_coprime 0 b ⟨ne_zero_of_lt hb⟩).mpr $
+  by { rw [int.gcd_zero_left, int.nat_abs_of_nat], exact hb.ne' }
+
+/-- The symbol `J(a | b)` takes the value `1` or `-1` if `a` and `b` are coprime. -/
+lemma eq_one_or_neg_one {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a | b) = 1 ∨ J(a | b) = -1 :=
+(trichotomy a b).resolve_left $ jacobi_sym.ne_zero h
+
+/-- We have that `J(a^e | b) = J(a | b)^e`. -/
+lemma pow_left (a : ℤ) (e b : ℕ) : J(a ^ e | b) = J(a | b) ^ e :=
+nat.rec_on e (by rw [pow_zero, pow_zero, one_left]) $
+  λ _ ih, by rw [pow_succ, pow_succ, mul_left, ih]
+
+/-- We have that `J(a | b^e) = J(a | b)^e`. -/
+lemma pow_right (a : ℤ) (b e : ℕ) : J(a | b ^ e) = J(a | b) ^ e :=
+begin
+  induction e with e ih,
+  { rw [pow_zero, pow_zero, one_right], },
+  { casesI eq_zero_or_ne_zero b with hb,
+    { rw [hb, zero_pow (succ_pos e), zero_right, one_pow], },
+    { rw [pow_succ, pow_succ, mul_right, ih], } }
+end
+
+/-- The square of `J(a | b)` is `1` when `a` and `b` are coprime. -/
+lemma sq_one {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a | b) ^ 2 = 1 :=
+by cases eq_one_or_neg_one h with h₁ h₁; rw h₁; refl
+
+/-- The symbol `J(a^2 | b)` is `1` when `a` and `b` are coprime. -/
+lemma sq_one' {a : ℤ} {b : ℕ} (h : a.gcd b = 1) : J(a ^ 2 | b) = 1 :=
+by rw [pow_left, sq_one h]
+
+/-- The symbol `J(a | b)` depends only on `a` mod `b`. -/
+lemma mod_left (a : ℤ) (b : ℕ) : J(a | b) = J(a % b | b) :=
+congr_arg list.prod $ list.pmap_congr _ begin
+  rintro p hp _ _,
+  conv_rhs { rw [legendre_sym.mod, int.mod_mod_of_dvd _
+    (int.coe_nat_dvd.2 $ dvd_of_mem_factors hp), ← legendre_sym.mod] },
+end
+
+/-- The symbol `J(a | b)` depends only on `a` mod `b`. -/
+lemma mod_left' {a₁ a₂ : ℤ} {b : ℕ} (h : a₁ % b = a₂ % b) : J(a₁ | b) = J(a₂ | b) :=
+by rw [mod_left, h, ← mod_left]
+
+/-- If `p` is prime, `J(a | p) = -1` and `p` divides `x^2 - a*y^2`, then `p` must divide
+`x` and `y`. -/
+lemma prime_dvd_of_eq_neg_one {p : ℕ} [fact p.prime] {a : ℤ} (h : J(a | p) = -1)
+  {x y : ℤ} (hxy : ↑p ∣ x ^ 2 - a * y ^ 2) : ↑p ∣ x ∧ ↑p ∣ y :=
+begin
+  rw [← legendre_sym.to_jacobi_sym] at h,
+  exact legendre_sym.prime_dvd_of_eq_neg_one h hxy,
+end
+
+/-- We can pull out a product over a list in the first argument of the Jacobi symbol. -/
+lemma list_prod_left {l : list ℤ} {n : ℕ} :
+  J(l.prod | n) = (l.map (λ a, J(a | n))).prod :=
+begin
+  induction l with n l' ih,
+  { simp only [list.prod_nil, list.map_nil, one_left], },
+  { rw [list.map, list.prod_cons, list.prod_cons, mul_left, ih], }
+end
+
+/-- We can pull out a product over a list in the second argument of the Jacobi symbol. -/
+lemma list_prod_right {a : ℤ} {l : list ℕ} (hl : ∀ n ∈ l, n ≠ 0) :
+  J(a | l.prod) = (l.map (λ n, J(a | n))).prod :=
+begin
+  induction l with n l' ih,
+  { simp only [list.prod_nil, one_right, list.map_nil], },
+  { have hn := hl n (list.mem_cons_self n l'), -- `n ≠ 0`
+    have hl' := list.prod_ne_zero (λ hf, hl 0 (list.mem_cons_of_mem _ hf) rfl), -- `l'.prod ≠ 0`
+    have h := λ m hm, hl m (list.mem_cons_of_mem _ hm), -- `∀ (m : ℕ), m ∈ l' → m ≠ 0`
+    rw [list.map, list.prod_cons, list.prod_cons, mul_right' a hn hl', ih h], }
+end
+
+/-- If `J(a | n) = -1`, then `n` has a prime divisor `p` such that `J(a | p) = -1`. -/
+lemma eq_neg_one_at_prime_divisor_of_eq_neg_one {a : ℤ} {n : ℕ} (h : J(a | n) = -1) :
+  ∃ (p : ℕ) (hp : p.prime), p ∣ n ∧ J(a | p) = -1 :=
+begin
+  have hn₀ : n ≠ 0,
+  { rintro rfl,
+    rw [zero_right, eq_neg_self_iff] at h,
+    exact one_ne_zero h, },
+  have hf₀ : ∀ p ∈ n.factors, p ≠ 0 := λ p hp, (nat.pos_of_mem_factors hp).ne.symm,
+  rw [← nat.prod_factors hn₀, list_prod_right hf₀] at h,
+  obtain ⟨p, hmem, hj⟩ := list.mem_map.mp (list.neg_one_mem_of_prod_eq_neg_one h),
+  exact ⟨p, nat.prime_of_mem_factors hmem, nat.dvd_of_mem_factors hmem, hj⟩,
+end
+
+end jacobi_sym
+
+namespace zmod
+
+open jacobi_sym
+
+/-- If `J(a | b)` is `-1`, then `a` is not a square modulo `b`. -/
+lemma nonsquare_of_jacobi_sym_eq_neg_one {a : ℤ} {b : ℕ} (h : J(a | b) = -1) :
+  ¬ is_square (a : zmod b) :=
+λ ⟨r, ha⟩, begin
+  rw [← r.coe_val_min_abs, ← int.cast_mul, int_coe_eq_int_coe_iff', ← sq] at ha,
+  apply (by norm_num : ¬ (0 : ℤ) ≤ -1),
+  rw [← h, mod_left, ha, ← mod_left, pow_left],
+  apply sq_nonneg,
+end
+
+/-- If `p` is prime, then `J(a | p)` is `-1` iff `a` is not a square modulo `p`. -/
+lemma nonsquare_iff_jacobi_sym_eq_neg_one {a : ℤ} {p : ℕ} [fact p.prime] :
+  J(a | p) = -1 ↔ ¬ is_square (a : zmod p) :=
+by { rw [← legendre_sym.to_jacobi_sym], exact legendre_sym.eq_neg_one_iff p }
+
+/-- If `p` is prime and `J(a | p) = 1`, then `a` is q square mod `p`. -/
+lemma is_square_of_jacobi_sym_eq_one {a : ℤ} {p : ℕ} [fact p.prime] (h : J(a | p) = 1) :
+  is_square (a : zmod p) :=
+not_not.mp $ by { rw [← nonsquare_iff_jacobi_sym_eq_neg_one, h], dec_trivial }
+
+end zmod
+
+/-!
+### Values at `-1`, `2` and `-2`
+-/
+
+namespace jacobi_sym
+
+/-- If `χ` is a multiplicative function such that `J(a | p) = χ p` for all odd primes `p`,
+then `J(a | b)` equals `χ b` for all odd natural numbers `b`. -/
+lemma value_at (a : ℤ) {R : Type*} [comm_semiring R] (χ : R →* ℤ)
+  (hp : ∀ (p : ℕ) (pp : p.prime) (h2 : p ≠ 2), @legendre_sym p ⟨pp⟩ a = χ p) {b : ℕ} (hb : odd b) :
+  J(a | b) = χ b :=
+begin
+  conv_rhs { rw [← prod_factors hb.pos.ne', cast_list_prod, χ.map_list_prod] },
+  rw [jacobi_sym, list.map_map, ← list.pmap_eq_map nat.prime _ _ (λ _, prime_of_mem_factors)],
+  congr' 1, apply list.pmap_congr,
+  exact λ p h pp _, hp p pp (hb.ne_two_of_dvd_nat $ dvd_of_mem_factors h)
+end
+
+/-- If `b` is odd, then `J(-1 | b)` is given by `χ₄ b`. -/
+lemma at_neg_one {b : ℕ} (hb : odd b) : J(-1 | b) = χ₄ b :=
+value_at (-1) χ₄ (λ p pp, @legendre_sym.at_neg_one p ⟨pp⟩) hb
+
+/-- If `b` is odd, then `J(-a | b) = χ₄ b * J(a | b)`. -/
+protected
+lemma neg (a : ℤ) {b : ℕ} (hb : odd b) : J(-a | b) = χ₄ b * J(a | b) :=
+by rw [neg_eq_neg_one_mul, mul_left, at_neg_one hb]
+
+/-- If `b` is odd, then `J(2 | b)` is given by `χ₈ b`. -/
+lemma at_two {b : ℕ} (hb : odd b) : J(2 | b) = χ₈ b :=
+value_at 2 χ₈ (λ p pp, @legendre_sym.at_two p ⟨pp⟩) hb
+
+/-- If `b` is odd, then `J(-2 | b)` is given by `χ₈' b`. -/
+lemma at_neg_two {b : ℕ} (hb : odd b) : J(-2 | b) = χ₈' b :=
+value_at (-2) χ₈' (λ p pp, @legendre_sym.at_neg_two p ⟨pp⟩) hb
+
+end jacobi_sym
+
+/-!
+### Quadratic Reciprocity
+-/
+
+/-- The bi-multiplicative map giving the sign in the Law of Quadratic Reciprocity -/
+def qr_sign (m n : ℕ) : ℤ := J(χ₄ m | n)
+
+namespace qr_sign
+
+/-- We can express `qr_sign m n` as a power of `-1` when `m` and `n` are odd. -/
+lemma neg_one_pow {m n : ℕ} (hm : odd m) (hn : odd n) :
+  qr_sign m n = (-1) ^ ((m / 2) * (n / 2)) :=
+begin
+  rw [qr_sign, pow_mul, ← χ₄_eq_neg_one_pow (odd_iff.mp hm)],
+  cases odd_mod_four_iff.mp (odd_iff.mp hm) with h h,
+  { rw [χ₄_nat_one_mod_four h, jacobi_sym.one_left, one_pow], },
+  { rw [χ₄_nat_three_mod_four h, ← χ₄_eq_neg_one_pow (odd_iff.mp hn), jacobi_sym.at_neg_one hn], }
+end
+
+/-- When `m` and `n` are odd, then the square of `qr_sign m n` is `1`. -/
+lemma sq_eq_one {m n : ℕ} (hm : odd m) (hn : odd n) : (qr_sign m n) ^ 2 = 1 :=
+by rw [neg_one_pow hm hn, ← pow_mul, mul_comm, pow_mul, neg_one_sq, one_pow]
+
+/-- `qr_sign` is multiplicative in the first argument. -/
+lemma mul_left (m₁ m₂ n : ℕ) : qr_sign (m₁ * m₂) n = qr_sign m₁ n * qr_sign m₂ n :=
+by simp_rw [qr_sign, nat.cast_mul, map_mul, jacobi_sym.mul_left]
+
+/-- `qr_sign` is multiplicative in the second argument. -/
+lemma mul_right (m n₁ n₂ : ℕ) [ne_zero n₁] [ne_zero n₂] :
+  qr_sign m (n₁ * n₂) = qr_sign m n₁ * qr_sign m n₂ :=
+jacobi_sym.mul_right (χ₄ m) n₁ n₂
+
+/-- `qr_sign` is symmetric when both arguments are odd. -/
+protected
+lemma symm {m n : ℕ} (hm : odd m) (hn : odd n) : qr_sign m n = qr_sign n m :=
+by rw [neg_one_pow hm hn, neg_one_pow hn hm, mul_comm (m / 2)]
+
+/-- We can move `qr_sign m n` from one side of an equality to the other when `m` and `n` are odd. -/
+lemma eq_iff_eq {m n : ℕ} (hm : odd m) (hn : odd n) (x y : ℤ) :
+  qr_sign m n * x = y ↔ x = qr_sign m n * y :=
+by refine ⟨λ h', let h := h'.symm in _, λ h, _⟩;
+   rw [h, ← mul_assoc, ← pow_two, sq_eq_one hm hn, one_mul]
+
+end qr_sign
+
+namespace jacobi_sym
+
+/-- The Law of Quadratic Reciprocity for the Jacobi symbol, version with `qr_sign` -/
+lemma quadratic_reciprocity' {a b : ℕ} (ha : odd a) (hb : odd b) :
+  J(a | b) = qr_sign b a * J(b | a) :=
+begin
+  -- define the right hand side for fixed `a` as a `ℕ →* ℤ`
+  let rhs : ℕ → ℕ →* ℤ := λ a,
+  { to_fun := λ x, qr_sign x a * J(x | a),
+    map_one' := by { convert ← mul_one _, symmetry, all_goals { apply one_left } },
+    map_mul' := λ x y, by rw [qr_sign.mul_left, nat.cast_mul, mul_left,
+                              mul_mul_mul_comm] },
+  have rhs_apply : ∀ (a b : ℕ), rhs a b = qr_sign b a * J(b | a) := λ a b, rfl,
+  refine value_at a (rhs a) (λ p pp hp, eq.symm _) hb,
+  have hpo := pp.eq_two_or_odd'.resolve_left hp,
+  rw [@legendre_sym.to_jacobi_sym p ⟨pp⟩, rhs_apply, nat.cast_id,
+      qr_sign.eq_iff_eq hpo ha, qr_sign.symm hpo ha],
+  refine value_at p (rhs p) (λ q pq hq, _) ha,
+  have hqo := pq.eq_two_or_odd'.resolve_left hq,
+  rw [rhs_apply, nat.cast_id, ← @legendre_sym.to_jacobi_sym p ⟨pp⟩, qr_sign.symm hqo hpo,
+      qr_sign.neg_one_pow hpo hqo, @legendre_sym.quadratic_reciprocity' p q ⟨pp⟩ ⟨pq⟩ hp hq],
+end
+
+/-- The Law of Quadratic Reciprocity for the Jacobi symbol -/
+lemma quadratic_reciprocity {a b : ℕ} (ha : odd a) (hb : odd b) :
+  J(a | b) = (-1) ^ ((a / 2) * (b / 2)) * J(b | a) :=
+by rw [← qr_sign.neg_one_pow ha hb, qr_sign.symm ha hb, quadratic_reciprocity' ha hb]
+
+/-- The Law of Quadratic Reciprocity for the Jacobi symbol: if `a` and `b` are natural numbers
+with `a % 4 = 1` and `b` odd, then `J(a | b) = J(b | a)`. -/
+theorem quadratic_reciprocity_one_mod_four {a b : ℕ} (ha : a % 4 = 1) (hb : odd b) :
+  J(a | b) = J(b | a) :=
+by rw [quadratic_reciprocity (odd_iff.mpr (odd_of_mod_four_eq_one ha)) hb,
+       pow_mul, neg_one_pow_div_two_of_one_mod_four ha, one_pow, one_mul]
+
+/-- The Law of Quadratic Reciprocity for the Jacobi symbol: if `a` and `b` are natural numbers
+with `a` odd and `b % 4 = 1`, then `J(a | b) = J(b | a)`. -/
+theorem quadratic_reciprocity_one_mod_four' {a b : ℕ} (ha : odd a) (hb : b % 4 = 1) :
+  J(a | b) = J(b | a) :=
+(quadratic_reciprocity_one_mod_four hb ha).symm
+
+/-- The Law of Quadratic Reciprocityfor the Jacobi symbol: if `a` and `b` are natural numbers
+both congruent to `3` mod `4`, then `J(a | b) = -J(b | a)`. -/
+theorem quadratic_reciprocity_three_mod_four {a b : ℕ} (ha : a % 4 = 3) (hb : b % 4 = 3) :
+  J(a | b) = - J(b | a) :=
+let nop := @neg_one_pow_div_two_of_three_mod_four in begin
+  rw [quadratic_reciprocity, pow_mul, nop ha, nop hb, neg_one_mul];
+  rwa [odd_iff, odd_of_mod_four_eq_three],
+end
+
+/-- The Jacobi symbol `J(a | b)` depends only on `b` mod `4*a` (version for `a : ℕ`). -/
+lemma mod_right' (a : ℕ) {b : ℕ} (hb : odd b) : J(a | b) = J(a | b % (4 * a)) :=
+begin
+  rcases eq_or_ne a 0 with rfl | ha₀,
+  { rw [mul_zero, mod_zero], },
+  have hb' : odd (b % (4 * a)) := hb.mod_even (even.mul_right (by norm_num) _),
+  rcases exists_eq_pow_mul_and_not_dvd ha₀ 2 (by norm_num) with ⟨e, a', ha₁', ha₂⟩,
+  have ha₁ := odd_iff.mpr (two_dvd_ne_zero.mp ha₁'),
+  nth_rewrite 1 [ha₂], nth_rewrite 0 [ha₂],
+  rw [nat.cast_mul, mul_left, mul_left, quadratic_reciprocity' ha₁ hb,
+      quadratic_reciprocity' ha₁ hb', nat.cast_pow, pow_left, pow_left,
+      nat.cast_two, at_two hb, at_two hb'],
+  congr' 1, swap, congr' 1,
+  { simp_rw [qr_sign],
+    rw [χ₄_nat_mod_four, χ₄_nat_mod_four (b % (4 * a)), mod_mod_of_dvd b (dvd_mul_right 4 a) ] },
+  { rw [mod_left ↑(b % _), mod_left b, int.coe_nat_mod, int.mod_mod_of_dvd b],
+    simp only [ha₂, nat.cast_mul, ← mul_assoc],
+    exact dvd_mul_left a' _, },
+  cases e, { refl },
+  { rw [χ₈_nat_mod_eight, χ₈_nat_mod_eight (b % (4 * a)), mod_mod_of_dvd b],
+    use 2 ^ e * a', rw [ha₂, pow_succ], ring, }
+end
+
+/-- The Jacobi symbol `J(a | b)` depends only on `b` mod `4*a`. -/
+lemma mod_right (a : ℤ) {b : ℕ} (hb : odd b) : J(a | b) = J(a | b % (4 * a.nat_abs)) :=
+begin
+  cases int.nat_abs_eq a with ha ha; nth_rewrite 1 [ha]; nth_rewrite 0 [ha],
+  { exact mod_right' a.nat_abs hb, },
+  { have hb' : odd (b % (4 * a.nat_abs)) := hb.mod_even (even.mul_right (by norm_num) _),
+    rw [jacobi_sym.neg _ hb, jacobi_sym.neg _ hb', mod_right' _ hb, χ₄_nat_mod_four,
+        χ₄_nat_mod_four (b % (4 * _)), mod_mod_of_dvd b (dvd_mul_right 4 _)], }
+end
+
+end jacobi_sym
+
+end jacobi
diff --git a/src/number_theory/legendre_symbol/mul_character.lean b/src/number_theory/legendre_symbol/mul_character.lean
new file mode 100644
index 0000000000000..3fa2fd2b10673
--- /dev/null
+++ b/src/number_theory/legendre_symbol/mul_character.lean
@@ -0,0 +1,509 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import algebra.char_p.basic
+import algebra.euclidean_domain.instances
+import data.fintype.units
+
+/-!
+# Multiplicative characters of finite rings and fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `R` and `R'` be a commutative rings.
+A *multiplicative character* of `R` with values in `R'` is a morphism of
+monoids from the multiplicative monoid of `R` into that of `R'`
+that sends non-units to zero.
+
+We use the namespace `mul_char` for the definitions and results.
+
+## Main results
+
+We show that the multiplicative characters form a group (if `R'` is commutative);
+see `mul_char.comm_group`. We also provide an equivalence with the
+homomorphisms `Rˣ →* R'ˣ`; see `mul_char.equiv_to_unit_hom`.
+
+We define a multiplicative character to be *quadratic* if its values
+are among `0`, `1` and `-1`, and we prove some properties of quadratic characters.
+
+Finally, we show that the sum of all values of a nontrivial multiplicative
+character vanishes; see `mul_char.is_nontrivial.sum_eq_zero`.
+
+## Tags
+
+multiplicative character
+-/
+
+section definition_and_group
+
+/-!
+### Definitions related to multiplicative characters
+
+Even though the intended use is when domain and target of the characters
+are commutative rings, we define them in the more general setting when
+the domain is a commutative monoid and the target is a commutative monoid
+with zero. (We need a zero in the target, since non-units are supposed
+to map to zero.)
+
+In this setting, there is an equivalence between multiplicative characters
+`R → R'` and group homomorphisms `Rˣ → R'ˣ`, and the multiplicative characters
+have a natural structure as a commutative group.
+-/
+
+universes u v
+
+section defi
+
+-- The domain of our multiplicative characters
+variables (R : Type u) [comm_monoid R]
+-- The target
+variables (R' : Type v) [comm_monoid_with_zero R']
+
+/-- Define a structure for multiplicative characters.
+A multiplicative character from a commutative monoid `R` to a commutative monoid with zero `R'`
+is a homomorphism of (multiplicative) monoids that sends non-units to zero. -/
+structure mul_char extends monoid_hom R R' :=
+(map_nonunit' : ∀ a : R, ¬ is_unit a → to_fun a = 0)
+
+/-- This is the corresponding extension of `monoid_hom_class`. -/
+class mul_char_class (F : Type*) (R R' : out_param $ Type*) [comm_monoid R]
+ [comm_monoid_with_zero R']
+  extends monoid_hom_class F R R' :=
+(map_nonunit : ∀ (χ : F) {a : R} (ha : ¬ is_unit a), χ a = 0)
+
+attribute [simp] mul_char_class.map_nonunit
+
+end defi
+
+section group
+
+namespace mul_char
+
+-- The domain of our multiplicative characters
+variables {R : Type u} [comm_monoid R]
+-- The target
+variables {R' : Type v} [comm_monoid_with_zero R']
+
+instance coe_to_fun : has_coe_to_fun (mul_char R R') (λ _, R → R') :=
+⟨λ χ, χ.to_fun⟩
+
+/-- See note [custom simps projection] -/
+protected def simps.apply (χ : mul_char R R') : R → R' := χ
+initialize_simps_projections mul_char (to_monoid_hom_to_fun → apply, -to_monoid_hom)
+
+section trivial
+
+variables (R R')
+
+/-- The trivial multiplicative character. It takes the value `0` on non-units and
+the value `1` on units. -/
+@[simps]
+noncomputable
+def trivial : mul_char R R' :=
+{ to_fun := by { classical, exact λ x, if is_unit x then 1 else 0 },
+  map_nonunit' := by { intros a ha, simp only [ha, if_false], },
+  map_one' := by simp only [is_unit_one, if_true],
+  map_mul' := by { intros x y,
+                   classical,
+                   simp only [is_unit.mul_iff, boole_mul],
+                   split_ifs; tauto, } }
+
+end trivial
+
+
+@[simp]
+lemma coe_coe (χ : mul_char R R') : (χ.to_monoid_hom : R → R') = χ := rfl
+
+@[simp]
+lemma to_fun_eq_coe (χ : mul_char R R') : χ.to_fun = χ := rfl
+
+@[simp]
+lemma coe_mk (f : R →* R') (hf) : (mul_char.mk f hf : R → R') = f := rfl
+
+/-- Extensionality. See `ext` below for the version that will actually be used. -/
+lemma ext' {χ χ' : mul_char R R'} (h : ∀ a, χ a = χ' a) : χ = χ' :=
+begin
+  cases χ,
+  cases χ',
+  congr,
+  exact monoid_hom.ext h,
+end
+
+instance : mul_char_class (mul_char R R') R R' :=
+{ coe := λ χ, χ.to_monoid_hom.to_fun,
+  coe_injective' := λ f g h, ext' (λ a, congr_fun h a),
+  map_mul := λ χ, χ.map_mul',
+  map_one := λ χ, χ.map_one',
+  map_nonunit := λ χ, χ.map_nonunit', }
+
+lemma map_nonunit (χ : mul_char R R') {a : R} (ha : ¬ is_unit a) : χ a = 0 :=
+χ.map_nonunit' a ha
+
+/-- Extensionality. Since `mul_char`s always take the value zero on non-units, it is sufficient
+to compare the values on units. -/
+@[ext]
+lemma ext {χ χ' : mul_char R R'} (h : ∀ a : Rˣ, χ a = χ' a) : χ = χ' :=
+begin
+  apply ext',
+  intro a,
+  by_cases ha : is_unit a,
+  { exact h ha.unit, },
+  { rw [map_nonunit χ ha, map_nonunit χ' ha], },
+end
+
+lemma ext_iff {χ χ' : mul_char R R'} : χ = χ' ↔ ∀ a : Rˣ, χ a = χ' a :=
+⟨by { rintro rfl a, refl }, ext⟩
+
+/-!
+### Equivalence of multiplicative characters with homomorphisms on units
+
+We show that restriction / extension by zero gives an equivalence
+between `mul_char R R'` and `Rˣ →* R'ˣ`.
+-/
+
+/-- Turn a `mul_char` into a homomorphism between the unit groups. -/
+def to_unit_hom (χ : mul_char R R') : Rˣ →* R'ˣ := units.map χ
+
+lemma coe_to_unit_hom (χ : mul_char R R') (a : Rˣ) :
+  ↑(χ.to_unit_hom a) = χ a :=
+rfl
+
+/-- Turn a homomorphism between unit groups into a `mul_char`. -/
+noncomputable
+def of_unit_hom (f : Rˣ →* R'ˣ) : mul_char R R' :=
+{ to_fun := by { classical, exact λ x, if hx : is_unit x then f hx.unit else 0 },
+  map_one' := by { have h1 : (is_unit_one.unit : Rˣ) = 1 := units.eq_iff.mp rfl,
+                   simp only [h1, dif_pos, units.coe_eq_one, map_one, is_unit_one], },
+  map_mul' :=
+  begin
+    classical,
+    intros x y,
+    by_cases hx : is_unit x,
+    { simp only [hx, is_unit.mul_iff, true_and, dif_pos],
+      by_cases hy : is_unit y,
+      { simp only [hy, dif_pos],
+        have hm : (is_unit.mul_iff.mpr ⟨hx, hy⟩).unit = hx.unit * hy.unit := units.eq_iff.mp rfl,
+        rw [hm, map_mul],
+        norm_cast, },
+      { simp only [hy, not_false_iff, dif_neg, mul_zero], }, },
+    { simp only [hx, is_unit.mul_iff, false_and, not_false_iff, dif_neg, zero_mul], },
+  end ,
+  map_nonunit' := by { intros a ha, simp only [ha, not_false_iff, dif_neg], }, }
+
+lemma of_unit_hom_coe (f : Rˣ →* R'ˣ) (a : Rˣ) :
+  of_unit_hom f ↑a = f a :=
+by simp [of_unit_hom]
+
+/-- The equivalence between multiplicative characters and homomorphisms of unit groups. -/
+noncomputable
+def equiv_to_unit_hom : mul_char R R' ≃ (Rˣ →* R'ˣ) :=
+{ to_fun := to_unit_hom,
+  inv_fun := of_unit_hom,
+  left_inv :=
+  by { intro χ, ext x, rw [of_unit_hom_coe, coe_to_unit_hom] },
+  right_inv :=
+  by { intro f, ext x, rw [coe_to_unit_hom, of_unit_hom_coe], } }
+
+@[simp]
+lemma to_unit_hom_eq (χ : mul_char R R') : to_unit_hom χ = equiv_to_unit_hom χ := rfl
+
+@[simp]
+lemma of_unit_hom_eq (χ : Rˣ →* R'ˣ) : of_unit_hom χ = equiv_to_unit_hom.symm χ := rfl
+
+@[simp]
+lemma coe_equiv_to_unit_hom (χ : mul_char R R') (a : Rˣ) :
+  ↑(equiv_to_unit_hom χ a) = χ a :=
+coe_to_unit_hom χ a
+
+@[simp]
+lemma equiv_unit_hom_symm_coe (f : Rˣ →* R'ˣ) (a : Rˣ) :
+  equiv_to_unit_hom.symm f ↑a = f a :=
+of_unit_hom_coe f a
+
+
+/-!
+### Commutative group structure on multiplicative characters
+
+The multiplicative characters `R → R'` form a commutative group.
+-/
+
+protected
+lemma map_one (χ : mul_char R R') : χ (1 : R) = 1 :=
+χ.map_one'
+
+/-- If the domain has a zero (and is nontrivial), then `χ 0 = 0`. -/
+protected
+lemma map_zero {R : Type u} [comm_monoid_with_zero R] [nontrivial R] (χ : mul_char R R') :
+  χ (0 : R) = 0 :=
+by rw [map_nonunit χ not_is_unit_zero]
+
+/-- If the domain is a ring `R`, then `χ (ring_char R) = 0`. -/
+lemma map_ring_char {R : Type u} [comm_ring R] [nontrivial R] (χ : mul_char R R') :
+  χ (ring_char R) = 0 :=
+by rw [ring_char.nat.cast_ring_char, χ.map_zero]
+
+noncomputable
+instance has_one : has_one (mul_char R R') := ⟨trivial R R'⟩
+
+noncomputable
+instance inhabited : inhabited (mul_char R R') := ⟨1⟩
+
+/-- Evaluation of the trivial character -/
+@[simp]
+lemma one_apply_coe (a : Rˣ) : (1 : mul_char R R') a = 1 :=
+by { classical, exact dif_pos a.is_unit }
+
+/-- Multiplication of multiplicative characters. (This needs the target to be commutative.) -/
+def mul (χ χ' : mul_char R R') : mul_char R R' :=
+{ to_fun := χ * χ',
+  map_nonunit' := λ a ha, by simp [map_nonunit χ ha],
+  ..χ.to_monoid_hom * χ'.to_monoid_hom }
+
+instance has_mul : has_mul (mul_char R R') := ⟨mul⟩
+
+lemma mul_apply (χ χ' : mul_char R R') (a : R) : (χ * χ') a = χ a * χ' a := rfl
+
+@[simp]
+lemma coe_to_fun_mul (χ χ' : mul_char R R') : ⇑(χ * χ') = χ * χ' := rfl
+
+protected
+lemma one_mul (χ : mul_char R R') : (1 : mul_char R R') * χ = χ := by { ext, simp }
+
+protected
+lemma mul_one (χ : mul_char R R') : χ * 1 = χ := by { ext, simp }
+
+/-- The inverse of a multiplicative character. We define it as `inverse ∘ χ`. -/
+noncomputable
+def inv (χ : mul_char R R') : mul_char R R' :=
+{ to_fun := λ a, monoid_with_zero.inverse (χ a),
+  map_nonunit' := λ a ha, by simp [map_nonunit _ ha],
+  ..monoid_with_zero.inverse.to_monoid_hom.comp χ.to_monoid_hom }
+
+noncomputable
+instance has_inv : has_inv (mul_char R R') := ⟨inv⟩
+
+/-- The inverse of a multiplicative character `χ`, applied to `a`, is the inverse of `χ a`. -/
+lemma inv_apply_eq_inv (χ : mul_char R R') (a : R) :
+  χ⁻¹ a = ring.inverse (χ a) :=
+eq.refl $ inv χ a
+
+/-- The inverse of a multiplicative character `χ`, applied to `a`, is the inverse of `χ a`.
+Variant when the target is a field -/
+lemma inv_apply_eq_inv' {R' : Type v} [field R'] (χ : mul_char R R') (a : R) :
+  χ⁻¹ a = (χ a)⁻¹ :=
+(inv_apply_eq_inv χ a).trans $ ring.inverse_eq_inv (χ a)
+
+/-- When the domain has a zero, then the inverse of a multiplicative character `χ`,
+applied to `a`, is `χ` applied to the inverse of `a`. -/
+lemma inv_apply {R : Type u} [comm_monoid_with_zero R] (χ : mul_char R R') (a : R) :
+  χ⁻¹ a = χ (ring.inverse a) :=
+begin
+  by_cases ha : is_unit a,
+  { rw [inv_apply_eq_inv],
+    have h := is_unit.map χ ha,
+    apply_fun ((*) (χ a)) using is_unit.mul_right_injective h,
+    rw [ring.mul_inverse_cancel _ h, ← map_mul, ring.mul_inverse_cancel _ ha, mul_char.map_one], },
+  { revert ha, nontriviality R, intro ha, -- `nontriviality R` by itself doesn't do it
+    rw [map_nonunit _ ha, ring.inverse_non_unit a ha, mul_char.map_zero χ], },
+end
+
+/-- When the domain has a zero, then the inverse of a multiplicative character `χ`,
+applied to `a`, is `χ` applied to the inverse of `a`. -/
+lemma inv_apply' {R : Type u} [field R] (χ : mul_char R R') (a : R) : χ⁻¹ a = χ a⁻¹ :=
+(inv_apply χ a).trans $ congr_arg _ (ring.inverse_eq_inv a)
+
+/-- The product of a character with its inverse is the trivial character. -/
+@[simp]
+lemma inv_mul (χ : mul_char R R') : χ⁻¹ * χ = 1 :=
+begin
+  ext x,
+  rw [coe_to_fun_mul, pi.mul_apply, inv_apply_eq_inv,
+      ring.inverse_mul_cancel _ (is_unit.map _ x.is_unit), one_apply_coe],
+end
+
+/-- The commutative group structure on `mul_char R R'`. -/
+noncomputable
+instance comm_group : comm_group (mul_char R R') :=
+{ one := 1,
+  mul := (*),
+  inv := has_inv.inv,
+  mul_left_inv := inv_mul,
+  mul_assoc := by { intros χ₁ χ₂ χ₃, ext a, simp [mul_assoc], },
+  mul_comm := by { intros χ₁ χ₂, ext a, simp [mul_comm], },
+  one_mul := one_mul,
+  mul_one := mul_one, }
+
+/-- If `a` is a unit and `n : ℕ`, then `(χ ^ n) a = (χ a) ^ n`. -/
+lemma pow_apply_coe (χ : mul_char R R') (n : ℕ) (a : Rˣ) :
+  (χ ^ n) a = (χ a) ^ n :=
+begin
+  induction n with n ih,
+  { rw [pow_zero, pow_zero, one_apply_coe], },
+  { rw [pow_succ, pow_succ, mul_apply, ih], },
+end
+
+/-- If `n` is positive, then `(χ ^ n) a = (χ a) ^ n`. -/
+lemma pow_apply' (χ : mul_char R R') {n : ℕ} (hn : 0 < n) (a : R) :
+  (χ ^ n) a = (χ a) ^ n :=
+begin
+  by_cases ha : is_unit a,
+  { exact pow_apply_coe χ n ha.unit, },
+  { rw [map_nonunit (χ ^ n) ha, map_nonunit χ ha, zero_pow hn], },
+end
+
+end mul_char
+
+end group
+
+end definition_and_group
+
+/-!
+### Properties of multiplicative characters
+
+We introduce the properties of being nontrivial or quadratic and prove
+some basic facts about them.
+
+We now assume that domain and target are commutative rings.
+-/
+
+section properties
+
+namespace mul_char
+
+universes u v w
+
+variables {R : Type u} [comm_ring R] {R' : Type v} [comm_ring R'] {R'' : Type w} [comm_ring R'']
+
+/-- A multiplicative character is *nontrivial* if it takes a value `≠ 1` on a unit. -/
+def is_nontrivial (χ : mul_char R R') : Prop := ∃ a : Rˣ, χ a ≠ 1
+
+/-- A multiplicative character is nontrivial iff it is not the trivial character. -/
+lemma is_nontrivial_iff (χ : mul_char R R') : χ.is_nontrivial ↔ χ ≠ 1 :=
+by simp only [is_nontrivial, ne.def, ext_iff, not_forall, one_apply_coe]
+
+/-- A multiplicative character is *quadratic* if it takes only the values `0`, `1`, `-1`. -/
+def is_quadratic (χ : mul_char R R') : Prop := ∀ a, χ a = 0 ∨ χ a = 1 ∨ χ a = -1
+
+/-- If two values of quadratic characters with target `ℤ` agree after coercion into a ring
+of characteristic not `2`, then they agree in `ℤ`. -/
+lemma is_quadratic.eq_of_eq_coe {χ : mul_char R ℤ} (hχ : is_quadratic χ)
+  {χ' : mul_char R' ℤ} (hχ' : is_quadratic χ') [nontrivial R''] (hR'' : ring_char R'' ≠ 2)
+  {a : R} {a' : R'} (h : (χ a : R'') = χ' a') :
+  χ a = χ' a' :=
+int.cast_inj_on_of_ring_char_ne_two hR'' (hχ a) (hχ' a') h
+
+/-- We can post-compose a multiplicative character with a ring homomorphism. -/
+@[simps]
+def ring_hom_comp (χ : mul_char R R') (f : R' →+* R'') : mul_char R R'' :=
+{ to_fun := λ a, f (χ a),
+  map_nonunit' := λ a ha, by simp only [map_nonunit χ ha, map_zero],
+  ..f.to_monoid_hom.comp χ.to_monoid_hom }
+
+/-- Composition with an injective ring homomorphism preserves nontriviality. -/
+lemma is_nontrivial.comp {χ : mul_char R R'} (hχ : χ.is_nontrivial)
+ {f : R' →+* R''} (hf : function.injective f) :
+  (χ.ring_hom_comp f).is_nontrivial :=
+begin
+  obtain ⟨a, ha⟩ := hχ,
+  use a,
+  rw [ring_hom_comp_apply, ← ring_hom.map_one f],
+  exact λ h, ha (hf h),
+end
+
+/-- Composition with a ring homomorphism preserves the property of being a quadratic character. -/
+lemma is_quadratic.comp {χ : mul_char R R'} (hχ : χ.is_quadratic) (f : R' →+* R'') :
+  (χ.ring_hom_comp f).is_quadratic :=
+begin
+  intro a,
+  rcases hχ a with (ha | ha | ha);
+    simp [ha],
+end
+
+/-- The inverse of a quadratic character is itself. →  -/
+lemma is_quadratic.inv {χ : mul_char R R'} (hχ : χ.is_quadratic) : χ⁻¹ = χ :=
+begin
+  ext x,
+  rw [inv_apply_eq_inv],
+  rcases hχ x with h₀ | h₁ | h₂,
+  { rw [h₀, ring.inverse_zero], },
+  { rw [h₁, ring.inverse_one], },
+  { rw [h₂, (by norm_cast : (-1 : R') = (-1 : R'ˣ)), ring.inverse_unit (-1 : R'ˣ)],
+    refl, },
+end
+
+/-- The square of a quadratic character is the trivial character. -/
+lemma is_quadratic.sq_eq_one {χ : mul_char R R'} (hχ : χ.is_quadratic) : χ ^ 2 = 1 :=
+begin
+  convert mul_left_inv _,
+  rw [pow_two, hχ.inv],
+end
+
+/-- The `p`th power of a quadratic character is itself, when `p` is the (prime) characteristic
+of the target ring. -/
+lemma is_quadratic.pow_char {χ : mul_char R R'} (hχ : χ.is_quadratic)
+ (p : ℕ) [hp : fact p.prime] [char_p R' p] :
+  χ ^ p = χ :=
+begin
+  ext x,
+  rw [pow_apply_coe],
+  rcases hχ x with (hx | hx | hx); rw hx,
+  { rw [zero_pow (fact.out p.prime).pos], },
+  { rw [one_pow], },
+  { exact char_p.neg_one_pow_char R' p, },
+end
+
+/-- The `n`th power of a quadratic character is the trivial character, when `n` is even. -/
+lemma is_quadratic.pow_even {χ : mul_char R R'} (hχ : χ.is_quadratic) {n : ℕ} (hn : even n) :
+  χ ^ n = 1 :=
+begin
+  obtain ⟨n, rfl⟩ := even_iff_two_dvd.mp hn,
+  rw [pow_mul, hχ.sq_eq_one, one_pow]
+end
+
+/-- The `n`th power of a quadratic character is itself, when `n` is odd. -/
+lemma is_quadratic.pow_odd {χ : mul_char R R'} (hχ : χ.is_quadratic) {n : ℕ} (hn : odd n) :
+  χ ^ n = χ :=
+begin
+  obtain ⟨n, rfl⟩ := hn,
+  rw [pow_add, pow_one, hχ.pow_even (even_two_mul _), one_mul]
+end
+
+open_locale big_operators
+
+/-- The sum over all values of a nontrivial multiplicative character on a finite ring is zero
+(when the target is a domain). -/
+lemma is_nontrivial.sum_eq_zero [fintype R] [is_domain R'] {χ : mul_char R R'}
+ (hχ : χ.is_nontrivial) :
+  ∑ a, χ a = 0 :=
+begin
+  rcases hχ with ⟨b, hb⟩,
+  refine eq_zero_of_mul_eq_self_left hb _,
+  simp only [finset.mul_sum, ← map_mul],
+  exact fintype.sum_bijective _ (units.mul_left_bijective b) _ _ (λ x, rfl)
+end
+
+/-- The sum over all values of the trivial multiplicative character on a finite ring is
+the cardinality of its unit group. -/
+lemma sum_one_eq_card_units [fintype R] [decidable_eq R] :
+  ∑ a, (1 : mul_char R R') a = fintype.card Rˣ :=
+begin
+  calc ∑ a, (1 : mul_char R R') a
+      = ∑ a : R, if is_unit a then 1 else 0 : finset.sum_congr rfl (λ a _, _)
+  ... = ((finset.univ : finset R).filter is_unit).card : finset.sum_boole
+  ... = (finset.univ.map (⟨(coe : Rˣ → R), units.ext⟩)).card : _
+  ... = fintype.card Rˣ : congr_arg _ (finset.card_map _),
+  { split_ifs with h h,
+    { exact one_apply_coe h.unit },
+    { exact map_nonunit _ h } },
+  { congr,
+    ext a,
+    simp only [finset.mem_filter, finset.mem_univ, true_and, finset.mem_map,
+               function.embedding.coe_fn_mk, exists_true_left, is_unit], },
+end
+
+end mul_char
+
+end properties
diff --git a/src/number_theory/legendre_symbol/norm_num.lean b/src/number_theory/legendre_symbol/norm_num.lean
new file mode 100644
index 0000000000000..a47ded8453ec7
--- /dev/null
+++ b/src/number_theory/legendre_symbol/norm_num.lean
@@ -0,0 +1,440 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import number_theory.legendre_symbol.jacobi_symbol
+
+/-!
+# A `norm_num` extension for Jacobi and Legendre symbols
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We extend the `tactic.interactive.norm_num` tactic so that it can be used to provably compute
+the value of the Jacobi symbol `J(a | b)` or the Legendre symbol `legendre_sym p a` when
+the arguments are numerals.
+
+## Implementation notes
+
+We use the Law of Quadratic Reciprocity for the Jacobi symbol to compute the value of `J(a | b)`
+efficiently, roughly comparable in effort with the euclidean algorithm for the computation
+of the gcd of `a` and `b`. More precisely, the computation is done in the following steps.
+
+* Use `J(a | 0) = 1` (an artifact of the definition) and `J(a | 1) = 1` to deal
+  with corner cases.
+
+* Use `J(a | b) = J(a % b | b)` to reduce to the case that `a` is a natural number.
+  We define a version of the Jacobi symbol restricted to natural numbers for use in
+  the following steps; see `norm_num.jacobi_sym_nat`. (But we'll continue to write `J(a | b)`
+  in this description.)
+
+* Remove powers of two from `b`. This is done via `J(2a | 2b) = 0` and
+  `J(2a+1 | 2b) = J(2a+1 | b)` (another artifact of the definition).
+
+* Now `0 ≤ a < b` and `b` is odd. If `b = 1`, then the value is `1`.
+  If `a = 0` (and `b > 1`), then the value is `0`. Otherwise, we remove powers of two from `a`
+  via `J(4a | b) = J(a | b)` and `J(2a | b) = ±J(a | b)`, where the sign is determined
+  by the residue class of `b` mod 8, to reduce to `a` odd.
+
+* Once `a` is odd, we use Quadratic Reciprocity (QR) in the form
+  `J(a | b) = ±J(b % a | a)`, where the sign is determined by the residue classes
+  of `a` and `b` mod 4. We are then back in the previous case.
+
+We provide customized versions of these results for the various reduction steps,
+where we encode the residue classes mod 2, mod 4, or mod 8 by using terms like
+`bit1 (bit0 a)`. In this way, the only divisions we have to compute and prove
+are the ones occurring in the use of QR above.
+-/
+
+section lemmas
+
+namespace norm_num
+
+/-- The Jacobi symbol restricted to natural numbers in both arguments. -/
+def jacobi_sym_nat (a b : ℕ) : ℤ  := jacobi_sym a b
+
+/-!
+### API Lemmas
+
+We repeat part of the API for `jacobi_sym` with `norm_num.jacobi_sym_nat` and without implicit
+arguments, in a form that is suitable for constructing proofs in `norm_num`.
+-/
+
+/-- Base cases: `b = 0`, `b = 1`, `a = 0`, `a = 1`. -/
+lemma jacobi_sym_nat.zero_right (a : ℕ) : jacobi_sym_nat a 0 = 1 :=
+by rwa [jacobi_sym_nat, jacobi_sym.zero_right]
+
+lemma jacobi_sym_nat.one_right (a : ℕ) : jacobi_sym_nat a 1 = 1 :=
+by rwa [jacobi_sym_nat, jacobi_sym.one_right]
+
+lemma jacobi_sym_nat.zero_left_even (b : ℕ) (hb : b ≠ 0) : jacobi_sym_nat 0 (bit0 b) = 0 :=
+by rw [jacobi_sym_nat, nat.cast_zero, jacobi_sym.zero_left (nat.one_lt_bit0 hb)]
+
+lemma jacobi_sym_nat.zero_left_odd (b : ℕ) (hb : b ≠ 0) : jacobi_sym_nat 0 (bit1 b) = 0 :=
+by rw [jacobi_sym_nat, nat.cast_zero, jacobi_sym.zero_left (nat.one_lt_bit1 hb)]
+
+lemma jacobi_sym_nat.one_left_even (b : ℕ) : jacobi_sym_nat 1 (bit0 b) = 1 :=
+by rw [jacobi_sym_nat, nat.cast_one, jacobi_sym.one_left]
+
+lemma jacobi_sym_nat.one_left_odd (b : ℕ) : jacobi_sym_nat 1 (bit1 b) = 1 :=
+by rw [jacobi_sym_nat, nat.cast_one, jacobi_sym.one_left]
+
+/-- Turn a Legendre symbol into a Jacobi symbol. -/
+lemma legendre_sym.to_jacobi_sym (p : ℕ) (pp : fact (p.prime)) (a r : ℤ) (hr : jacobi_sym a p = r) :
+  legendre_sym p a = r :=
+by rwa [@legendre_sym.to_jacobi_sym p pp a]
+
+/-- The value depends only on the residue class of `a` mod `b`. -/
+lemma jacobi_sym.mod_left (a : ℤ) (b ab' : ℕ) (ab r b' : ℤ) (hb' : (b : ℤ) = b')
+  (hab : a % b' = ab) (h : (ab' : ℤ) = ab) (hr : jacobi_sym_nat ab' b = r) :
+  jacobi_sym a b = r :=
+by rw [← hr, jacobi_sym_nat, jacobi_sym.mod_left, hb', hab, ← h]
+
+lemma jacobi_sym_nat.mod_left (a b ab : ℕ) (r : ℤ) (hab : a % b = ab)
+  (hr : jacobi_sym_nat ab b = r) :
+  jacobi_sym_nat a b = r :=
+by { rw [← hr, jacobi_sym_nat, jacobi_sym_nat, _root_.jacobi_sym.mod_left a b, ← hab], refl, }
+
+/-- The symbol vanishes when both entries are even (and `b ≠ 0`). -/
+lemma jacobi_sym_nat.even_even (a b : ℕ) (hb₀ : b ≠ 0) :
+  jacobi_sym_nat (bit0 a) (bit0 b) = 0 :=
+begin
+  refine jacobi_sym.eq_zero_iff.mpr ⟨nat.bit0_ne_zero hb₀, λ hf, _⟩,
+  have h : 2 ∣ (bit0 a).gcd (bit0 b) := nat.dvd_gcd two_dvd_bit0 two_dvd_bit0,
+  change 2 ∣ (bit0 a : ℤ).gcd (bit0 b) at h,
+  rw [← nat.cast_bit0, ← nat.cast_bit0, hf, ← even_iff_two_dvd] at h,
+  exact nat.not_even_one h,
+end
+
+/-- When `a` is odd and `b` is even, we can replace `b` by `b / 2`. -/
+lemma jacobi_sym_nat.odd_even (a b : ℕ) (r : ℤ) (hr : jacobi_sym_nat (bit1 a) b = r) :
+  jacobi_sym_nat (bit1 a) (bit0 b) = r :=
+begin
+  have ha : legendre_sym 2 (bit1 a) = 1 :=
+  by simp only [legendre_sym, quadratic_char_apply, quadratic_char_fun_one, int.cast_bit1,
+                char_two.bit1_eq_one, pi.one_apply],
+  cases eq_or_ne b 0 with hb hb,
+  { rw [← hr, hb, jacobi_sym_nat.zero_right], },
+  { haveI : ne_zero b := ⟨hb⟩, -- for `jacobi_sym.mul_right`
+    rwa [bit0_eq_two_mul b, jacobi_sym_nat, jacobi_sym.mul_right,
+         ← _root_.legendre_sym.to_jacobi_sym, nat.cast_bit1, ha, one_mul], }
+end
+
+/-- If `a` is divisible by `4` and `b` is odd, then we can remove the factor `4` from `a`. -/
+lemma jacobi_sym_nat.double_even (a b : ℕ) (r : ℤ) (hr : jacobi_sym_nat a (bit1 b) = r) :
+  jacobi_sym_nat (bit0 (bit0 a)) (bit1 b) = r :=
+begin
+  have : ((2 : ℕ) : ℤ).gcd ((bit1 b) : ℕ) = 1,
+  { rw [int.coe_nat_gcd, nat.bit1_eq_succ_bit0, bit0_eq_two_mul b, nat.succ_eq_add_one,
+        nat.gcd_mul_left_add_right, nat.gcd_one_right], },
+  rwa [bit0_eq_two_mul a, bit0_eq_two_mul (2 * a), ← mul_assoc, ← pow_two, jacobi_sym_nat,
+       nat.cast_mul, nat.cast_pow, jacobi_sym.mul_left, jacobi_sym.sq_one' this, one_mul],
+end
+
+/-- If `a` is even and `b` is odd, then we can remove a factor `2` from `a`,
+but we may have to change the sign, depending on `b % 8`.
+We give one version for each of the four odd residue classes mod `8`. -/
+lemma jacobi_sym_nat.even_odd₁ (a b : ℕ) (r : ℤ)
+  (hr : jacobi_sym_nat a (bit1 (bit0 (bit0 b))) = r) :
+  jacobi_sym_nat (bit0 a) (bit1 (bit0 (bit0 b))) = r :=
+begin
+  have hb : (bit1 (bit0 (bit0 b))) % 8 = 1,
+  { rw [nat.bit1_mod_bit0, nat.bit0_mod_bit0, nat.bit0_mod_two], },
+  rw [jacobi_sym_nat, bit0_eq_two_mul a, nat.cast_mul, jacobi_sym.mul_left,
+      nat.cast_two, jacobi_sym.at_two (odd_bit1 _), zmod.χ₈_nat_mod_eight, hb],
+  norm_num,
+  exact hr,
+end
+
+lemma jacobi_sym_nat.even_odd₇ (a b : ℕ) (r : ℤ)
+  (hr : jacobi_sym_nat a (bit1 (bit1 (bit1 b))) = r) :
+  jacobi_sym_nat (bit0 a) (bit1 (bit1 (bit1 b))) = r :=
+begin
+  have hb : (bit1 (bit1 (bit1 b))) % 8 = 7,
+  { rw [nat.bit1_mod_bit0, nat.bit1_mod_bit0, nat.bit1_mod_two], },
+  rw [jacobi_sym_nat, bit0_eq_two_mul a, nat.cast_mul, jacobi_sym.mul_left,
+      nat.cast_two, jacobi_sym.at_two (odd_bit1 _), zmod.χ₈_nat_mod_eight, hb],
+  norm_num,
+  exact hr,
+end
+
+lemma jacobi_sym_nat.even_odd₃ (a b : ℕ) (r : ℤ)
+  (hr : jacobi_sym_nat a (bit1 (bit1 (bit0 b))) = r) :
+  jacobi_sym_nat (bit0 a) (bit1 (bit1 (bit0 b))) = -r :=
+begin
+  have hb : (bit1 (bit1 (bit0 b))) % 8 = 3,
+  { rw [nat.bit1_mod_bit0, nat.bit1_mod_bit0, nat.bit0_mod_two], },
+  rw [jacobi_sym_nat, bit0_eq_two_mul a, nat.cast_mul, jacobi_sym.mul_left,
+      nat.cast_two, jacobi_sym.at_two (odd_bit1 _), zmod.χ₈_nat_mod_eight, hb],
+  norm_num,
+  exact hr,
+end
+
+lemma jacobi_sym_nat.even_odd₅ (a b : ℕ) (r : ℤ)
+  (hr : jacobi_sym_nat a (bit1 (bit0 (bit1 b))) = r) :
+  jacobi_sym_nat (bit0 a) (bit1 (bit0 (bit1 b))) = -r :=
+begin
+  have hb : (bit1 (bit0 (bit1 b))) % 8 = 5,
+  { rw [nat.bit1_mod_bit0, nat.bit0_mod_bit0, nat.bit1_mod_two], },
+  rw [jacobi_sym_nat, bit0_eq_two_mul a, nat.cast_mul, jacobi_sym.mul_left,
+      nat.cast_two, jacobi_sym.at_two (odd_bit1 _), zmod.χ₈_nat_mod_eight, hb],
+  norm_num,
+  exact hr,
+end
+
+/-- Use quadratic reciproity to reduce to smaller `b`. -/
+lemma jacobi_sym_nat.qr₁ (a b : ℕ) (r : ℤ) (hr : jacobi_sym_nat (bit1 b) (bit1 (bit0 a)) = r) :
+  jacobi_sym_nat (bit1 (bit0 a)) (bit1 b) = r :=
+begin
+  have ha : (bit1 (bit0 a)) % 4 = 1,
+  { rw [nat.bit1_mod_bit0, nat.bit0_mod_two], },
+  have hb := nat.bit1_mod_two,
+  rwa [jacobi_sym_nat, jacobi_sym.quadratic_reciprocity_one_mod_four ha (nat.odd_iff.mpr hb)],
+end
+
+lemma jacobi_sym_nat.qr₁_mod (a b ab : ℕ) (r : ℤ) (hab : (bit1 b) % (bit1 (bit0 a)) = ab)
+  (hr : jacobi_sym_nat ab (bit1 (bit0 a)) = r) :
+  jacobi_sym_nat (bit1 (bit0 a)) (bit1 b) = r :=
+jacobi_sym_nat.qr₁ _ _ _ $ jacobi_sym_nat.mod_left _ _ ab r hab hr
+
+lemma jacobi_sym_nat.qr₁' (a b : ℕ) (r : ℤ) (hr : jacobi_sym_nat (bit1 (bit0 b)) (bit1 a) = r) :
+  jacobi_sym_nat (bit1 a) (bit1 (bit0 b)) = r :=
+begin
+  have hb : (bit1 (bit0 b)) % 4 = 1,
+  { rw [nat.bit1_mod_bit0, nat.bit0_mod_two], },
+  have ha := nat.bit1_mod_two,
+  rwa [jacobi_sym_nat, ← jacobi_sym.quadratic_reciprocity_one_mod_four hb (nat.odd_iff.mpr ha)]
+end
+
+lemma jacobi_sym_nat.qr₁'_mod (a b ab : ℕ) (r : ℤ) (hab : (bit1 (bit0 b)) % (bit1 a) = ab)
+  (hr : jacobi_sym_nat ab (bit1 a) = r) :
+  jacobi_sym_nat (bit1 a) (bit1 (bit0 b)) = r :=
+jacobi_sym_nat.qr₁' _ _ _ $ jacobi_sym_nat.mod_left _ _ ab r hab hr
+
+lemma jacobi_sym_nat.qr₃ (a b : ℕ) (r : ℤ)
+  (hr : jacobi_sym_nat (bit1 (bit1 b)) (bit1 (bit1 a)) = r) :
+  jacobi_sym_nat (bit1 (bit1 a)) (bit1 (bit1 b)) = -r :=
+begin
+  have hb : (bit1 (bit1 b)) % 4 = 3,
+  { rw [nat.bit1_mod_bit0, nat.bit1_mod_two], },
+  have ha : (bit1 (bit1 a)) % 4 = 3,
+  { rw [nat.bit1_mod_bit0, nat.bit1_mod_two], },
+  rwa [jacobi_sym_nat, jacobi_sym.quadratic_reciprocity_three_mod_four ha hb, neg_inj]
+end
+
+lemma jacobi_sym_nat.qr₃_mod (a b ab : ℕ) (r : ℤ) (hab : (bit1 (bit1 b)) % (bit1 (bit1 a)) = ab)
+  (hr : jacobi_sym_nat ab (bit1 (bit1 a)) = r) :
+  jacobi_sym_nat (bit1 (bit1 a)) (bit1 (bit1 b)) = -r :=
+jacobi_sym_nat.qr₃ _ _ _ $ jacobi_sym_nat.mod_left _ _ ab r hab hr
+
+end norm_num
+
+end lemmas
+
+section evaluation
+
+/-!
+### Certified evaluation of the Jacobi symbol
+
+The following functions recursively evaluate a Jacobi symbol and construct the
+corresponding proof term.
+-/
+
+namespace norm_num
+open tactic
+
+/-- This evaluates `r := jacobi_sym_nat a b` recursively using quadratic reciprocity
+and produces a proof term for the equality, assuming that `a < b` and `b` is odd. -/
+meta def prove_jacobi_sym_odd : instance_cache → instance_cache → expr → expr →
+   tactic (instance_cache × instance_cache × expr × expr)
+| zc nc ea eb := do
+  match match_numeral eb with
+  | match_numeral_result.one :=  -- `b = 1`, result is `1`
+    pure (zc, nc, `(1 : ℤ), `(jacobi_sym_nat.one_right).mk_app [ea])
+  | match_numeral_result.bit1 eb₁ := do -- `b > 1` (recall that `b` is odd)
+    match match_numeral ea with
+    | match_numeral_result.zero := do -- `a = 0`, result is `0`
+      b ← eb₁.to_nat,
+      (nc, phb₀) ← prove_ne nc eb₁ `(0 : ℕ) b 0, -- proof of `b ≠ 0`
+      pure (zc, nc, `(0 : ℤ), `(jacobi_sym_nat.zero_left_odd).mk_app [eb₁, phb₀])
+    | match_numeral_result.one := do -- `a = 1`, result is `1`
+      pure (zc, nc, `(1 : ℤ), `(jacobi_sym_nat.one_left_odd).mk_app [eb₁])
+    | match_numeral_result.bit0 ea₁ := do -- `a` is even; check if divisible by `4`
+      match match_numeral ea₁ with
+      | match_numeral_result.bit0 ea₂ := do
+        (zc, nc, er, p) ← prove_jacobi_sym_odd zc nc ea₂ eb, -- compute `jacobi_sym_nat (a / 4) b`
+        pure (zc, nc, er, `(jacobi_sym_nat.double_even).mk_app [ea₂, eb₁, er, p])
+      | _ := do -- reduce to `a / 2`; need to consider `b % 8`
+        (zc, nc, er, p) ← prove_jacobi_sym_odd zc nc ea₁ eb, -- compute `jacobi_sym_nat (a / 2) b`
+        match match_numeral eb₁ with
+        -- | match_numeral_result.zero := -- `b = 1`, not reached
+        | match_numeral_result.one := do -- `b = 3`
+          r ← er.to_int,
+          (zc, er') ← zc.of_int (- r),
+          pure (zc, nc, er', `(jacobi_sym_nat.even_odd₃).mk_app [ea₁, `(0 : ℕ), er, p])
+        | match_numeral_result.bit0 eb₂ := do -- `b % 4 = 1`
+          match match_numeral eb₂ with
+          -- | match_numeral_result.zero := -- not reached
+          | match_numeral_result.one := do -- `b = 5`
+            r ← er.to_int,
+            (zc, er') ← zc.of_int (- r),
+            pure (zc, nc, er', `(jacobi_sym_nat.even_odd₅).mk_app [ea₁, `(0 : ℕ), er, p])
+          | match_numeral_result.bit0 eb₃ := do -- `b % 8 = 1`
+            pure (zc, nc, er, `(jacobi_sym_nat.even_odd₁).mk_app [ea₁, eb₃, er, p])
+          | match_numeral_result.bit1 eb₃ := do -- `b % 8 = 5`
+            r ← er.to_int,
+            (zc, er') ← zc.of_int (- r),
+            pure (zc, nc, er', `(jacobi_sym_nat.even_odd₅).mk_app [ea₁, eb₃, er, p])
+          | _ := failed
+          end
+        | match_numeral_result.bit1 eb₂ := do -- `b % 4 = 3`
+          match match_numeral eb₂ with
+          -- | match_numeral_result.zero := -- not reached
+          | match_numeral_result.one := do -- `b = 7`
+            pure (zc, nc, er, `(jacobi_sym_nat.even_odd₇).mk_app [ea₁, `(0 : ℕ), er, p])
+          | match_numeral_result.bit0 eb₃ := do -- `b % 8 = 3`
+            r ← er.to_int,
+            (zc, er') ← zc.of_int (- r),
+            pure (zc, nc, er', `(jacobi_sym_nat.even_odd₃).mk_app [ea₁, eb₃, er, p])
+          | match_numeral_result.bit1 eb₃ := do -- `b % 8 = 7`
+            pure (zc, nc, er, `(jacobi_sym_nat.even_odd₇).mk_app [ea₁, eb₃, er, p])
+          | _ := failed
+          end
+        | _ := failed
+        end
+      end
+    | match_numeral_result.bit1 ea₁ := do -- `a` is odd
+      -- use Quadratic Reciprocity; look at `a` and `b` mod `4`
+      (nc, bma, phab) ← prove_div_mod nc eb ea tt, -- compute `b % a`
+      (zc, nc, er, p) ← prove_jacobi_sym_odd zc nc bma ea, -- compute `jacobi_sym_nat (b % a) a`
+      match match_numeral ea₁ with
+      -- | match_numeral_result.zero :=  -- `a = 1`, not reached
+      | match_numeral_result.one := do -- `a = 3`; need to consider `b`
+        match match_numeral eb₁ with
+        -- | match_numeral_result.zero := -- `b = 1`, not reached
+        -- | match_numeral_result.one := -- `b = 3`, not reached, since `a < b`
+        | match_numeral_result.bit0 eb₂ := do -- `b % 4 = 1`
+          pure (zc, nc, er, `(jacobi_sym_nat.qr₁'_mod).mk_app [ea₁, eb₂, bma, er, phab, p])
+        | match_numeral_result.bit1 eb₂ := do -- `b % 4 = 3`
+          r ← er.to_int,
+          (zc, er') ← zc.of_int (- r),
+          pure (zc, nc, er', `(jacobi_sym_nat.qr₃_mod).mk_app [`(0 : ℕ), eb₂, bma, er, phab, p])
+        | _ := failed
+        end
+      | match_numeral_result.bit0 ea₂ := do -- `a % 4 = 1`
+        pure (zc, nc, er, `(jacobi_sym_nat.qr₁_mod).mk_app [ea₂, eb₁, bma, er, phab, p])
+      | match_numeral_result.bit1 ea₂ := do -- `a % 4 = 3`; need to consider `b`
+        match match_numeral eb₁ with
+        -- | match_numeral_result.zero := do -- `b = 1`, not reached
+        -- | match_numeral_result.one := do -- `b = 3`, not reached, since `a < b`
+        | match_numeral_result.bit0 eb₂ := do -- `b % 4 = 1`
+          pure (zc, nc, er, `(jacobi_sym_nat.qr₁'_mod).mk_app [ea₁, eb₂, bma, er, phab, p])
+        | match_numeral_result.bit1 eb₂ := do -- `b % 4 = 3`
+          r ← er.to_int,
+          (zc, er') ← zc.of_int (- r),
+          pure (zc, nc, er', `(jacobi_sym_nat.qr₃_mod).mk_app [ea₂, eb₂, bma, er, phab, p])
+        | _ := failed
+        end
+      | _ := failed
+      end
+    | _ := failed
+    end
+  | _ := failed
+  end
+
+/-- This evaluates `r := jacobi_sym_nat a b` and produces a proof term for the equality
+by removing powers of `2` from `b` and then calling `prove_jacobi_sym_odd`. -/
+meta def prove_jacobi_sym_nat : instance_cache → instance_cache → expr → expr →
+   tactic (instance_cache × instance_cache × expr × expr)
+| zc nc ea eb := do
+  match match_numeral eb with
+  | match_numeral_result.zero := -- `b = 0`, result is `1`
+    pure (zc, nc, `(1 : ℤ), `(jacobi_sym_nat.zero_right).mk_app [ea])
+  | match_numeral_result.one :=  -- `b = 1`, result is `1`
+    pure (zc, nc, `(1 : ℤ), `(jacobi_sym_nat.one_right).mk_app [ea])
+  | match_numeral_result.bit0 eb₁ := -- `b` is even and nonzero
+    match match_numeral ea with
+    | match_numeral_result.zero := do -- `a = 0`, result is `0`
+      b ← eb₁.to_nat,
+      (nc, phb₀) ← prove_ne nc eb₁ `(0 : ℕ) b 0, -- proof of `b ≠ 0`
+      pure (zc, nc, `(0 : ℤ), `(jacobi_sym_nat.zero_left_even).mk_app [eb₁, phb₀])
+    | match_numeral_result.one := do -- `a = 1`, result is `1`
+      pure (zc, nc, `(1 : ℤ), `(jacobi_sym_nat.one_left_even).mk_app [eb₁])
+    | match_numeral_result.bit0 ea₁ := do -- `a` is even, result is `0`
+      b ← eb₁.to_nat,
+      (nc, phb₀) ← prove_ne nc eb₁ `(0 : ℕ) b 0, -- proof of `b ≠ 0`
+      let er : expr := `(0 : ℤ),
+      pure (zc, nc, er, `(jacobi_sym_nat.even_even).mk_app [ea₁, eb₁, phb₀])
+    | match_numeral_result.bit1 ea₁ := do -- `a` is odd, reduce to `b / 2`
+      (zc, nc, er, p) ← prove_jacobi_sym_nat zc nc ea eb₁,
+      pure (zc, nc, er, `(jacobi_sym_nat.odd_even).mk_app [ea₁, eb₁, er, p])
+    | _ := failed
+    end
+  | match_numeral_result.bit1 eb₁ := do -- `b` is odd
+    a ← ea.to_nat,
+    b ← eb.to_nat,
+    if b ≤ a then do -- reduce to `jacobi_sym_nat (a % b) b`
+      (nc, amb, phab) ← prove_div_mod nc ea eb tt, -- compute `a % b`
+      (zc, nc, er, p) ← prove_jacobi_sym_odd zc nc amb eb, -- compute `jacobi_sym_nat (a % b) b`
+      pure (zc, nc, er, `(jacobi_sym_nat.mod_left).mk_app [ea, eb, amb, er, phab, p])
+    else
+    prove_jacobi_sym_odd zc nc ea eb
+  | _ := failed
+  end
+
+/-- This evaluates `r := jacobi_sym a b` and produces a proof term for the equality.
+This is done by reducing to `r := jacobi_sym_nat (a % b) b`. -/
+meta def prove_jacobi_sym : instance_cache → instance_cache → expr → expr
+    → tactic (instance_cache × instance_cache × expr × expr)
+| zc nc ea eb := do
+  match match_numeral eb with -- deal with simple cases right away
+  | match_numeral_result.zero := pure (zc, nc, `(1 : ℤ), `(jacobi_sym.zero_right).mk_app [ea])
+  | match_numeral_result.one := pure (zc, nc, `(1 : ℤ), `(jacobi_sym.one_right).mk_app [ea])
+  | _ := do -- Now `1 < b`. Compute `jacobi_sym_nat (a % b) b` instead.
+    b ← eb.to_nat,
+    (zc, eb') ← zc.of_int (b : ℤ),
+    -- Get the proof that `(b : ℤ) = b'` (where `eb'` is the numeral representing `b'`).
+    -- This is important to avoid inefficient matching between the two.
+    (zc, nc, eb₁, pb') ← prove_nat_uncast zc nc eb',
+    (zc, amb, phab) ← prove_div_mod zc ea eb' tt, -- compute `a % b`
+    (zc, nc, amb', phab') ← prove_nat_uncast zc nc amb, -- `a % b` as a natural number
+    (zc, nc, er, p) ← prove_jacobi_sym_nat zc nc amb' eb₁, -- compute `jacobi_sym_nat (a % b) b`
+    pure (zc, nc, er,
+          `(jacobi_sym.mod_left).mk_app [ea, eb₁, amb', amb, er, eb', pb', phab, phab', p])
+  end
+
+end norm_num
+
+end evaluation
+
+section tactic
+
+/-!
+### The `norm_num` plug-in
+-/
+
+namespace tactic
+namespace norm_num
+
+/-- This is the `norm_num` plug-in that evaluates Jacobi and Legendre symbols. -/
+@[norm_num] meta def eval_jacobi_sym : expr → tactic (expr × expr)
+| `(jacobi_sym %%ea %%eb) := do -- Jacobi symbol
+    zc ← mk_instance_cache `(ℤ),
+    nc ← mk_instance_cache `(ℕ),
+    (prod.snd ∘ prod.snd) <$> norm_num.prove_jacobi_sym zc nc ea eb
+| `(norm_num.jacobi_sym_nat %%ea %%eb) := do -- Jacobi symbol on natural numbers
+    zc ← mk_instance_cache `(ℤ),
+    nc ← mk_instance_cache `(ℕ),
+    (prod.snd ∘ prod.snd) <$> norm_num.prove_jacobi_sym_nat zc nc ea eb
+| `(@legendre_sym %%ep %%inst %%ea) := do -- Legendre symbol
+    zc ← mk_instance_cache `(ℤ),
+    nc ← mk_instance_cache `(ℕ),
+    (zc, nc, er, pf) ← norm_num.prove_jacobi_sym zc nc ea ep,
+    pure (er, `(norm_num.legendre_sym.to_jacobi_sym).mk_app [ep, inst, ea, er, pf])
+| _ := failed
+
+end norm_num
+end tactic
+
+end tactic
diff --git a/src/number_theory/legendre_symbol/quadratic_char.lean b/src/number_theory/legendre_symbol/quadratic_char.lean
deleted file mode 100644
index c13e166ce5d7d..0000000000000
--- a/src/number_theory/legendre_symbol/quadratic_char.lean
+++ /dev/null
@@ -1,509 +0,0 @@
-/-
-Copyright (c) 2022 Michael Stoll. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Michael Stoll
--/
-import tactic.basic
-import field_theory.finite.basic
-import data.int.range
-
-/-!
-# Quadratic characters of finite fields
-
-This file defines the quadratic character on a finite field `F` and proves
-some basic statements about it.
-
-## Tags
-
-quadratic character
--/
-
-/-!
-### Some general results, mostly on finite fields
-
-We collect some results here that are not specific to quadratic characters
-but are needed below. They will be moved to appropriate places eventually.
--/
-
-section general
-
-/-- A natural number is odd iff it has residue `1` or `3` mod `4`-/
-lemma nat.odd_mod_four_iff {n : ℕ} : n % 2 = 1 ↔ n % 4 = 1 ∨ n % 4 = 3 :=
-begin
-  split,
-  { have help : ∀ (m : ℕ), 0 ≤ m → m < 4 → m % 2 = 1 → m = 1 ∨ m = 3 := dec_trivial,
-    intro hn,
-    rw [← nat.mod_mod_of_dvd n (by norm_num : 2 ∣ 4)] at hn,
-    exact help (n % 4) zero_le' (nat.mod_lt n (by norm_num)) hn, },
-  { intro h,
-    cases h with h h,
-    { exact nat.odd_of_mod_four_eq_one h, },
-    { exact nat.odd_of_mod_four_eq_three h }, },
-end
-
-/-- If `ring_char R = 2`, where `R` is a finite reduced commutative ring,
-then every `a : R` is a square. -/
-lemma is_square_of_char_two' {R : Type*} [fintype R] [comm_ring R] [is_reduced R] [char_p R 2]
- (a : R) : is_square a :=
-exists_imp_exists (λ b h, pow_two b ▸ eq.symm h) $
-  ((fintype.bijective_iff_injective_and_card _).mpr ⟨frobenius_inj R 2, rfl⟩).surjective a
-
-namespace finite_field
-
-variables {F : Type*} [field F] [fintype F]
-
-/-- In a finite field of characteristic `2`, all elements are squares. -/
-lemma is_square_of_char_two (hF : ring_char F = 2) (a : F) : is_square a :=
-begin
-  haveI hF' : char_p F 2 := ring_char.of_eq hF,
-  exact is_square_of_char_two' a,
-end
-
-/-- The finite field `F` has even cardinality iff it has characteristic `2`. -/
-lemma even_card_iff_char_two : ring_char F = 2 ↔ fintype.card F % 2 = 0 :=
-begin
-  rcases finite_field.card F (ring_char F) with ⟨n, hp, h⟩,
-  rw [h, nat.pow_mod],
-  split,
-  { intro hF,
-    rw hF,
-    simp only [nat.bit0_mod_two, zero_pow', ne.def, pnat.ne_zero, not_false_iff, nat.zero_mod], },
-  { rw [← nat.even_iff, nat.even_pow],
-    rintros ⟨hev, hnz⟩,
-    rw [nat.even_iff, nat.mod_mod] at hev,
-    cases (nat.prime.eq_two_or_odd hp) with h₁ h₁,
-    { exact h₁, },
-    { exact false.rec (ring_char F = 2) (one_ne_zero ((eq.symm h₁).trans hev)), }, },
-end
-
-lemma even_card_of_char_two (hF : ring_char F = 2) : fintype.card F % 2 = 0 :=
-even_card_iff_char_two.mp hF
-
-lemma odd_card_of_char_ne_two (hF : ring_char F ≠ 2) : fintype.card F % 2 = 1 :=
-nat.mod_two_ne_zero.mp (mt even_card_iff_char_two.mpr hF)
-
-/-- Characteristic `≠ 2` implies that `-1 ≠ 1`. -/
-lemma neg_one_ne_one_of_char_ne_two (hF : ring_char F ≠ 2) : (-1 : F) ≠ 1 :=
-begin
-  have hc := char_p.char_is_prime F (ring_char F),
-  haveI hF' : fact (2 < ring_char F) := ⟨ lt_of_le_of_ne (nat.prime.two_le hc) (ne.symm hF) ⟩,
-  exact char_p.neg_one_ne_one _ (ring_char F),
-end
-
-/-- Characteristic `≠ 2` implies that `-a ≠ a` when `a ≠ 0`. -/
-lemma neg_ne_self_of_char_ne_two (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) : a ≠ -a :=
-begin
-  intro hf,
-  apply (neg_one_ne_one_of_char_ne_two hF).symm,
-  rw [eq_neg_iff_add_eq_zero, ←two_mul, mul_one],
-  rw [eq_neg_iff_add_eq_zero, ←two_mul, mul_eq_zero] at hf,
-  exact hf.resolve_right ha,
-end
-
-/-- If `F` has odd characteristic, then for nonzero `a : F`, we have that `a ^ (#F / 2) = ±1`. -/
-lemma pow_dichotomy (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
-  a^(fintype.card F / 2) = 1 ∨ a^(fintype.card F / 2) = -1 :=
-begin
-  have h₁ := finite_field.pow_card_sub_one_eq_one a ha,
-  set q := fintype.card F with hq,
-  have hq : q % 2 = 1 := finite_field.odd_card_of_char_ne_two hF,
-  have h₂ := nat.two_mul_odd_div_two hq,
-  rw [← h₂, mul_comm, pow_mul, pow_two] at h₁,
-  exact mul_self_eq_one_iff.mp h₁,
-end
-
-/-- A unit `a` of a finite field `F` of odd characteristic is a square
-if and only if `a ^ (#F / 2) = 1`. -/
-lemma unit_is_square_iff (hF : ring_char F ≠ 2) (a : Fˣ) :
-  is_square a ↔ a ^ (fintype.card F / 2) = 1 :=
-begin
-  classical,
-  obtain ⟨g, hg⟩ := is_cyclic.exists_generator Fˣ,
-  obtain ⟨n, hn⟩ : a ∈ submonoid.powers g, { rw mem_powers_iff_mem_zpowers, apply hg },
-  have hodd := nat.two_mul_odd_div_two (finite_field.odd_card_of_char_ne_two hF),
-  split,
-  { rintro ⟨y, rfl⟩,
-    rw [← pow_two, ← pow_mul, hodd],
-    apply_fun (@coe Fˣ F _),
-    { push_cast,
-      exact finite_field.pow_card_sub_one_eq_one (y : F) (units.ne_zero y), },
-    { exact units.ext, }, },
-  { subst a, assume h,
-    have key : 2 * (fintype.card F / 2) ∣ n * (fintype.card F / 2),
-    { rw [← pow_mul] at h,
-      rw [hodd, ← fintype.card_units, ← order_of_eq_card_of_forall_mem_zpowers hg],
-      apply order_of_dvd_of_pow_eq_one h },
-    have : 0 < fintype.card F / 2 := nat.div_pos fintype.one_lt_card (by norm_num),
-    obtain ⟨m, rfl⟩ := nat.dvd_of_mul_dvd_mul_right this key,
-    refine ⟨g ^ m, _⟩,
-    rw [mul_comm, pow_mul, pow_two], },
-end
-
-/-- A non-zero `a : F` is a square if and only if `a ^ (#F / 2) = 1`. -/
-lemma is_square_iff (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
-  is_square a ↔ a ^ (fintype.card F / 2) = 1 :=
-begin
-  apply (iff_congr _ (by simp [units.ext_iff])).mp
-        (finite_field.unit_is_square_iff hF (units.mk0 a ha)),
-  simp only [is_square, units.ext_iff, units.coe_mk0, units.coe_mul],
-  split, { rintro ⟨y, hy⟩, exact ⟨y, hy⟩ },
-  { rintro ⟨y, rfl⟩,
-    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
-    refine ⟨units.mk0 y hy, _⟩, simp, }
-end
-
-/-- In a finite field of odd characteristic, not every element is a square. -/
-lemma exists_nonsquare (hF : ring_char F ≠ 2) : ∃ (a : F), ¬ is_square a :=
-begin
-  -- idea: the squaring map on `F` is not injetive, hence not surjective
-  let sq : F → F := λ x, x^2,
-  have h : ¬ function.injective sq,
-  { simp only [function.injective, not_forall, exists_prop],
-    use [-1, 1],
-    split,
-    { simp only [sq, one_pow, neg_one_sq], },
-    { exact finite_field.neg_one_ne_one_of_char_ne_two hF, }, },
-  have h₁ := mt (fintype.injective_iff_surjective.mpr) h, -- sq not surjective
-  push_neg at h₁,
-  cases h₁ with a h₁,
-  use a,
-  simp only [is_square, sq, not_exists, ne.def] at h₁ ⊢,
-  intros b hb,
-  rw ← pow_two at hb,
-  exact (h₁ b hb.symm),
-end
-
-end finite_field
-
-end general
-
-namespace char
-
-/-!
-### Definition of the quadratic character
-
-We define the quadratic character of a finite field `F` with values in ℤ.
--/
-
-section define
-
-/-- Define the quadratic character with values in ℤ on a monoid with zero `α`.
-It takes the value zero at zero; for non-zero argument `a : α`, it is `1`
-if `a` is a square, otherwise it is `-1`.
-
-This only deserves the name "character" when it is multiplicative,
-e.g., when `α` is a finite field. See `quadratic_char_mul`.
--/
-def quadratic_char (α : Type*) [monoid_with_zero α] [decidable_eq α]
-  [decidable_pred (is_square : α → Prop)] (a : α) : ℤ :=
-if a = 0 then 0 else if is_square a then 1 else -1
-
-end define
-
-/-!
-### Basic properties of the quadratic character
-
-We prove some properties of the quadratic character.
-We work with a finite field `F` here.
-The interesting case is when the characteristic of `F` is odd.
--/
-
-section quadratic_char
-
-variables {F : Type*} [field F] [fintype F] [decidable_eq F]
-
-/-- Some basic API lemmas -/
-lemma quadratic_char_eq_zero_iff (a : F) : quadratic_char F a = 0 ↔ a = 0 :=
-begin
-  simp only [quadratic_char],
-  by_cases ha : a = 0,
-  { simp only [ha, eq_self_iff_true, if_true], },
-  { simp only [ha, if_false, iff_false],
-    split_ifs; simp only [neg_eq_zero, one_ne_zero, not_false_iff], },
-end
-
-@[simp]
-lemma quadratic_char_zero : quadratic_char F 0 = 0 :=
-by simp only [quadratic_char, eq_self_iff_true, if_true, id.def]
-
-@[simp]
-lemma quadratic_char_one : quadratic_char F 1 = 1 :=
-by simp only [quadratic_char, one_ne_zero, is_square_one, if_true, if_false, id.def]
-
-/-- For nonzero `a : F`, `quadratic_char F a = 1 ↔ is_square a`. -/
-lemma quadratic_char_one_iff_is_square {a : F} (ha : a ≠ 0) :
-  quadratic_char F a = 1 ↔ is_square a :=
-by { simp only [quadratic_char, ha, (dec_trivial : (-1 : ℤ) ≠ 1), if_false, ite_eq_left_iff],
-     tauto, }
-
-/-- The quadratic character takes the value `1` on nonzero squares. -/
-lemma quadratic_char_sq_one' {a : F} (ha : a ≠ 0) : quadratic_char F (a ^ 2) = 1 :=
-by simp only [quadratic_char, ha, pow_eq_zero_iff, nat.succ_pos', is_square_sq, if_true, if_false]
-
-/-- If `ring_char F = 2`, then `quadratic_char F` takes the value `1` on nonzero elements. -/
-lemma quadratic_char_eq_one_of_char_two (hF : ring_char F = 2) {a : F} (ha : a ≠ 0) :
-  quadratic_char F a = 1 :=
-begin
-  simp only [quadratic_char, ha, if_false, ite_eq_left_iff],
-  intro h,
-  exfalso,
-  exact h (finite_field.is_square_of_char_two hF a),
-end
-
-/-- If `ring_char F` is odd, then `quadratic_char F a` can be computed in
-terms of `a ^ (fintype.card F / 2)`. -/
-lemma quadratic_char_eq_pow_of_char_ne_two (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
-  quadratic_char F a = if a ^ (fintype.card F / 2) = 1 then 1 else -1 :=
-begin
-  simp only [quadratic_char, ha, if_false],
-  simp_rw finite_field.is_square_iff hF ha,
-end
-
-/-- The quadratic character is multiplicative. -/
-lemma quadratic_char_mul (a b : F) :
-  quadratic_char F (a * b) = quadratic_char F a * quadratic_char F b :=
-begin
-  by_cases ha : a = 0,
-  { rw [ha, zero_mul, quadratic_char_zero, zero_mul], },
-  -- now `a ≠ 0`
-  by_cases hb : b = 0,
-  { rw [hb, mul_zero, quadratic_char_zero, mul_zero], },
-  -- now `a ≠ 0` and `b ≠ 0`
-  have hab := mul_ne_zero ha hb,
-  by_cases hF : ring_char F = 2,
-  { -- case `ring_char F = 2`
-    rw [quadratic_char_eq_one_of_char_two hF ha,
-        quadratic_char_eq_one_of_char_two hF hb,
-        quadratic_char_eq_one_of_char_two hF hab,
-        mul_one], },
-  { -- case of odd characteristic
-    rw [quadratic_char_eq_pow_of_char_ne_two hF ha,
-        quadratic_char_eq_pow_of_char_ne_two hF hb,
-        quadratic_char_eq_pow_of_char_ne_two hF hab,
-        mul_pow],
-    cases finite_field.pow_dichotomy hF hb with hb' hb',
-    { simp only [hb', mul_one, eq_self_iff_true, if_true], },
-    { have h := finite_field.neg_one_ne_one_of_char_ne_two hF, -- `-1 ≠ 1`
-      simp only [hb', h, mul_neg, mul_one, if_false, ite_mul, neg_mul],
-      cases finite_field.pow_dichotomy hF ha with ha' ha';
-        simp only [ha', h, neg_neg, eq_self_iff_true, if_true, if_false], }, },
-end
-
-/-- The quadratic character is a homomorphism of monoids with zero. -/
-@[simps] def quadratic_char_hom : F →*₀ ℤ :=
-{ to_fun := quadratic_char F,
-  map_zero' := quadratic_char_zero,
-  map_one' := quadratic_char_one,
-  map_mul' := quadratic_char_mul }
-
-/-- The square of the quadratic character on nonzero arguments is `1`. -/
-lemma quadratic_char_sq_one {a : F} (ha : a ≠ 0) : (quadratic_char F a) ^ 2 = 1 :=
-by rwa [pow_two, ← quadratic_char_mul, ← pow_two, quadratic_char_sq_one']
-
-/-- The quadratic character is `1` or `-1` on nonzero arguments. -/
-lemma quadratic_char_dichotomy {a : F} (ha : a ≠ 0) :
-  quadratic_char F a = 1 ∨ quadratic_char F a = -1 :=
-(sq_eq_one_iff (quadratic_char F a)).mp (quadratic_char_sq_one ha)
-
-/-- A variant -/
-lemma quadratic_char_eq_neg_one_iff_not_one {a : F} (ha : a ≠ 0) :
-  quadratic_char F a = -1 ↔ ¬ quadratic_char F a = 1 :=
-begin
-  refine ⟨λ h, _, λ h₂, (or_iff_right h₂).mp (quadratic_char_dichotomy ha)⟩,
-  rw h,
-  norm_num,
-end
-
-/-- For `a : F`, `quadratic_char F a = -1 ↔ ¬ is_square a`. -/
-lemma quadratic_char_neg_one_iff_not_is_square {a : F} :
-  quadratic_char F a = -1 ↔ ¬ is_square a :=
-begin
-  by_cases ha : a = 0,
-  { simp only [ha, is_square_zero, quadratic_char_zero, zero_eq_neg, one_ne_zero, not_true], },
-  { rw [quadratic_char_eq_neg_one_iff_not_one ha, quadratic_char_one_iff_is_square ha] },
-end
-
-/-- If `F` has odd characteristic, then `quadratic_char F` takes the value `-1`. -/
-lemma quadratic_char_exists_neg_one (hF : ring_char F ≠ 2) : ∃ a, quadratic_char F a = -1 :=
-(finite_field.exists_nonsquare hF).imp (λ b h₁, quadratic_char_neg_one_iff_not_is_square.mpr h₁)
-
-/-- The number of solutions to `x^2 = a` is determined by the quadratic character. -/
-lemma quadratic_char_card_sqrts (hF : ring_char F ≠ 2) (a : F) :
-  ↑{x : F | x^2 = a}.to_finset.card = quadratic_char F a + 1 :=
-begin
-  -- we consider the cases `a = 0`, `a` is a nonzero square and `a` is a nonsquare in turn
-  by_cases h₀ : a = 0,
-  { simp only [h₀, pow_eq_zero_iff, nat.succ_pos', int.coe_nat_succ, int.coe_nat_zero, zero_add,
-               quadratic_char_zero, add_zero, set.set_of_eq_eq_singleton, set.to_finset_card,
-               set.card_singleton], },
-  { set s := {x : F | x^2 = a}.to_finset with hs,
-    by_cases h : is_square a,
-    { rw (quadratic_char_one_iff_is_square h₀).mpr h,
-      rcases h with ⟨b, h⟩,
-      rw [h, mul_self_eq_zero] at h₀,
-      have h₁ : s = [b, -b].to_finset := by
-      { ext x,
-        simp only [finset.mem_filter, finset.mem_univ, true_and, list.to_finset_cons,
-                   list.to_finset_nil, insert_emptyc_eq, finset.mem_insert, finset.mem_singleton],
-        rw ← pow_two at h,
-        simp only [hs, set.mem_to_finset, set.mem_set_of_eq, h],
-        split,
-        { exact eq_or_eq_neg_of_sq_eq_sq _ _, },
-        { rintro (h₂ | h₂); rw h₂,
-          simp only [neg_sq], }, },
-      simp only [h₁, finset.card_doubleton (finite_field.neg_ne_self_of_char_ne_two hF h₀),
-                 list.to_finset_cons, list.to_finset_nil, insert_emptyc_eq, int.coe_nat_succ,
-                 int.coe_nat_zero, zero_add], },
-    { rw quadratic_char_neg_one_iff_not_is_square.mpr h,
-      simp only [int.coe_nat_eq_zero, finset.card_eq_zero, set.to_finset_card,
-                 fintype.card_of_finset, set.mem_set_of_eq, add_left_neg],
-      ext x,
-      simp only [iff_false, finset.mem_filter, finset.mem_univ, true_and, finset.not_mem_empty],
-      rw is_square_iff_exists_sq at h,
-      exact λ h', h ⟨_, h'.symm⟩, }, },
-end
-
-open_locale big_operators
-
-/-- The sum over the values of the quadratic character is zero when the characteristic is odd. -/
-lemma quadratic_char_sum_zero (hF : ring_char F ≠ 2) : ∑ (a : F), quadratic_char F a = 0 :=
-begin
-  cases (quadratic_char_exists_neg_one hF) with b hb,
-  have h₀ : b ≠ 0 := by
-  { intro hf,
-    rw [hf, quadratic_char_zero, zero_eq_neg] at hb,
-    exact one_ne_zero hb, },
-  have h₁ : ∑ (a : F), quadratic_char F (b * a) = ∑ (a : F), quadratic_char F a :=
-    fintype.sum_bijective _ (mul_left_bijective₀ b h₀) _ _ (λ x, rfl),
-  simp only [quadratic_char_mul] at h₁,
-  rw [← finset.mul_sum, hb, neg_mul, one_mul] at h₁,
-  exact eq_zero_of_neg_eq h₁,
-end
-
-end quadratic_char
-
-end char
-
-/-!
-### Quadratic characters mod 4 and 8
-
-We define the primitive quadratic characters `χ₄`on `zmod 4`
-and `χ₈`, `χ₈'` on `zmod 8`.
--/
-
-namespace zmod
-
-section quad_char_mod_p
-
-/-- Define the nontrivial quadratic character on `zmod 4`, `χ₄`.
-It corresponds to the extension `ℚ(√-1)/ℚ`. -/
-@[simps] def χ₄ : (zmod 4) →*₀ ℤ :=
-{ to_fun := (![0,1,0,-1] : (zmod 4 → ℤ)),
-  map_zero' := rfl, map_one' := rfl, map_mul' := dec_trivial }
-
-/-- An explicit description of `χ₄` on integers / naturals -/
-lemma χ₄_int_eq_if_mod_four (n : ℤ) : χ₄ n = if n % 2 = 0 then 0 else if n % 4 = 1 then 1 else -1 :=
-begin
-  have help : ∀ (m : ℤ), 0 ≤ m → m < 4 → χ₄ m = if m % 2 = 0 then 0 else if m = 1 then 1 else -1 :=
-  dec_trivial,
-  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 4), ← zmod.int_cast_mod n 4],
-  exact help (n % 4) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
-end
-
-lemma χ₄_nat_eq_if_mod_four (n : ℕ) : χ₄ n = if n % 2 = 0 then 0 else if n % 4 = 1 then 1 else -1 :=
-by exact_mod_cast χ₄_int_eq_if_mod_four n
-
-/-- Alternative description for odd `n : ℕ` in terms of powers of `-1` -/
-lemma χ₄_eq_neg_one_pow {n : ℕ} (hn : n % 2 = 1) : χ₄ n = (-1)^(n / 2) :=
-begin
-  rw χ₄_nat_eq_if_mod_four,
-  simp only [hn, nat.one_ne_zero, if_false],
-  have h := (nat.div_add_mod n 4).symm,
-  cases (nat.odd_mod_four_iff.mp hn) with h4 h4,
-  { split_ifs,
-    rw h4 at h,
-    rw [h],
-    nth_rewrite 0 (by norm_num : 4 = 2 * 2),
-    rw [mul_assoc, add_comm, nat.add_mul_div_left _ _ (by norm_num : 0 < 2), pow_add, pow_mul],
-    norm_num, },
-  { split_ifs,
-    { exfalso,
-      rw h4 at h_1,
-      norm_num at h_1, },
-    { rw h4 at h,
-      rw [h],
-      nth_rewrite 0 (by norm_num : 4 = 2 * 2),
-      rw [mul_assoc, add_comm, nat.add_mul_div_left _ _ (by norm_num : 0 < 2), pow_add, pow_mul],
-      norm_num, }, },
-end
-
-/-- Define the first primitive quadratic character on `zmod 8`, `χ₈`.
-It corresponds to the extension `ℚ(√2)/ℚ`. -/
-@[simps] def χ₈ : (zmod 8) →*₀ ℤ :=
-{ to_fun := (![0,1,0,-1,0,-1,0,1] : (zmod 8 → ℤ)),
-  map_zero' := rfl, map_one' := rfl, map_mul' := by dec_trivial }
-
-/-- Define the second primitive quadratic character on `zmod 8`, `χ₈'`.
-It corresponds to the extension `ℚ(√-2)/ℚ`. -/
-@[simps] def χ₈' : (zmod 8) →*₀ ℤ :=
-{ to_fun := (![0,1,0,1,0,-1,0,-1] : (zmod 8 → ℤ)),
-  map_zero' := rfl, map_one' := rfl, map_mul' := by dec_trivial }
-
-end quad_char_mod_p
-
-end zmod
-
-/-!
-### Special values of the quadratic character
-
-We express `quadratic_char F (-1)` in terms of `χ₄`.
--/
-
-section special_values
-
-namespace char
-
-open zmod
-
-variables {F : Type*} [field F] [fintype F]
-
-/-- The value of the quadratic character at `-1` -/
-lemma quadratic_char_neg_one [decidable_eq F] (hF : ring_char F ≠ 2) :
-  quadratic_char F (-1) = χ₄ (fintype.card F) :=
-begin
-  have h₁ : (-1 : F) ≠ 0 := by { rw neg_ne_zero, exact one_ne_zero },
-  have h := quadratic_char_eq_pow_of_char_ne_two hF h₁,
-  rw [h, χ₄_eq_neg_one_pow (finite_field.odd_card_of_char_ne_two hF)],
-  set n := fintype.card F / 2,
-  cases (nat.even_or_odd n) with h₂ h₂,
-  { simp only [even.neg_one_pow h₂, eq_self_iff_true, if_true], },
-  { simp only [odd.neg_one_pow h₂, ite_eq_right_iff],
-    exact λ (hf : -1 = 1),
-            false.rec (1 = -1) (finite_field.neg_one_ne_one_of_char_ne_two hF hf), },
-end
-
-/-- The interpretation in terms of whether `-1` is a square in `F` -/
-lemma is_square_neg_one_iff : is_square (-1 : F) ↔ fintype.card F % 4 ≠ 3 :=
-begin
-  classical, -- suggested by the linter (instead of `[decidable_eq F]`)
-  by_cases hF : (ring_char F = 2),
-  { simp only [finite_field.is_square_of_char_two hF, ne.def, true_iff],
-    exact (λ hf, one_ne_zero ((nat.odd_of_mod_four_eq_three hf).symm.trans
-                                (finite_field.even_card_of_char_two hF)))},
-  { have h₁ : (-1 : F) ≠ 0 := by { rw neg_ne_zero, exact one_ne_zero },
-    have h₂ := finite_field.odd_card_of_char_ne_two hF,
-    rw [← quadratic_char_one_iff_is_square h₁, quadratic_char_neg_one hF,
-        χ₄_nat_eq_if_mod_four, h₂],
-    have h₃ := nat.odd_mod_four_iff.mp h₂,
-    simp only [nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def],
-    norm_num,
-    split,
-    { intros h h',
-      have t := (of_not_not h).symm.trans h',
-      norm_num at t, },
-    exact λ h h', h' ((or_iff_left h).mp h₃), },
-end
-
-end char
-
-end special_values
diff --git a/src/number_theory/legendre_symbol/quadratic_char/basic.lean b/src/number_theory/legendre_symbol/quadratic_char/basic.lean
new file mode 100644
index 0000000000000..8d64425b47fff
--- /dev/null
+++ b/src/number_theory/legendre_symbol/quadratic_char/basic.lean
@@ -0,0 +1,324 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import data.fintype.parity
+import number_theory.legendre_symbol.zmod_char
+import field_theory.finite.basic
+
+/-!
+# Quadratic characters of finite fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the quadratic character on a finite field `F` and proves
+some basic statements about it.
+
+## Tags
+
+quadratic character
+-/
+
+/-!
+### Definition of the quadratic character
+
+We define the quadratic character of a finite field `F` with values in ℤ.
+-/
+
+section define
+
+/-- Define the quadratic character with values in ℤ on a monoid with zero `α`.
+It takes the value zero at zero; for non-zero argument `a : α`, it is `1`
+if `a` is a square, otherwise it is `-1`.
+
+This only deserves the name "character" when it is multiplicative,
+e.g., when `α` is a finite field. See `quadratic_char_fun_mul`.
+
+We will later define `quadratic_char` to be a multiplicative character
+of type `mul_char F ℤ`, when the domain is a finite field `F`.
+-/
+def quadratic_char_fun (α : Type*) [monoid_with_zero α] [decidable_eq α]
+  [decidable_pred (is_square : α → Prop)] (a : α) : ℤ :=
+if a = 0 then 0 else if is_square a then 1 else -1
+
+end define
+
+/-!
+### Basic properties of the quadratic character
+
+We prove some properties of the quadratic character.
+We work with a finite field `F` here.
+The interesting case is when the characteristic of `F` is odd.
+-/
+
+section quadratic_char
+
+open mul_char
+
+variables {F : Type*} [field F] [fintype F] [decidable_eq F]
+
+/-- Some basic API lemmas -/
+lemma quadratic_char_fun_eq_zero_iff {a : F} : quadratic_char_fun F a = 0 ↔ a = 0 :=
+begin
+  simp only [quadratic_char_fun],
+  by_cases ha : a = 0,
+  { simp only [ha, eq_self_iff_true, if_true], },
+  { simp only [ha, if_false, iff_false],
+    split_ifs; simp only [neg_eq_zero, one_ne_zero, not_false_iff], },
+end
+
+@[simp]
+lemma quadratic_char_fun_zero : quadratic_char_fun F 0 = 0 :=
+by simp only [quadratic_char_fun, eq_self_iff_true, if_true, id.def]
+
+@[simp]
+lemma quadratic_char_fun_one : quadratic_char_fun F 1 = 1 :=
+by simp only [quadratic_char_fun, one_ne_zero, is_square_one, if_true, if_false, id.def]
+
+/-- If `ring_char F = 2`, then `quadratic_char_fun F` takes the value `1` on nonzero elements. -/
+lemma quadratic_char_fun_eq_one_of_char_two (hF : ring_char F = 2) {a : F} (ha : a ≠ 0) :
+  quadratic_char_fun F a = 1 :=
+begin
+  simp only [quadratic_char_fun, ha, if_false, ite_eq_left_iff],
+  exact λ h, false.rec _ (h (finite_field.is_square_of_char_two hF a))
+end
+
+/-- If `ring_char F` is odd, then `quadratic_char_fun F a` can be computed in
+terms of `a ^ (fintype.card F / 2)`. -/
+lemma quadratic_char_fun_eq_pow_of_char_ne_two (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
+  quadratic_char_fun F a = if a ^ (fintype.card F / 2) = 1 then 1 else -1 :=
+begin
+  simp only [quadratic_char_fun, ha, if_false],
+  simp_rw finite_field.is_square_iff hF ha,
+end
+
+/-- The quadratic character is multiplicative. -/
+lemma quadratic_char_fun_mul (a b : F) :
+  quadratic_char_fun F (a * b) = quadratic_char_fun F a * quadratic_char_fun F b :=
+begin
+  by_cases ha : a = 0,
+  { rw [ha, zero_mul, quadratic_char_fun_zero, zero_mul], },
+  -- now `a ≠ 0`
+  by_cases hb : b = 0,
+  { rw [hb, mul_zero, quadratic_char_fun_zero, mul_zero], },
+  -- now `a ≠ 0` and `b ≠ 0`
+  have hab := mul_ne_zero ha hb,
+  by_cases hF : ring_char F = 2,
+  { -- case `ring_char F = 2`
+    rw [quadratic_char_fun_eq_one_of_char_two hF ha,
+        quadratic_char_fun_eq_one_of_char_two hF hb,
+        quadratic_char_fun_eq_one_of_char_two hF hab,
+        mul_one], },
+  { -- case of odd characteristic
+    rw [quadratic_char_fun_eq_pow_of_char_ne_two hF ha,
+        quadratic_char_fun_eq_pow_of_char_ne_two hF hb,
+        quadratic_char_fun_eq_pow_of_char_ne_two hF hab,
+        mul_pow],
+    cases finite_field.pow_dichotomy hF hb with hb' hb',
+    { simp only [hb', mul_one, eq_self_iff_true, if_true], },
+    { have h := ring.neg_one_ne_one_of_char_ne_two hF, -- `-1 ≠ 1`
+      simp only [hb', h, mul_neg, mul_one, if_false, ite_mul, neg_mul],
+      cases finite_field.pow_dichotomy hF ha with ha' ha';
+        simp only [ha', h, neg_neg, eq_self_iff_true, if_true, if_false], }, },
+end
+
+variables (F)
+
+/-- The quadratic character as a multiplicative character. -/
+@[simps] def quadratic_char : mul_char F ℤ :=
+{ to_fun := quadratic_char_fun F,
+  map_one' := quadratic_char_fun_one,
+  map_mul' := quadratic_char_fun_mul,
+  map_nonunit' := λ a ha, by { rw of_not_not (mt ne.is_unit ha), exact quadratic_char_fun_zero, } }
+
+variables {F}
+
+/-- The value of the quadratic character on `a` is zero iff `a = 0`. -/
+lemma quadratic_char_eq_zero_iff {a : F} : quadratic_char F a = 0 ↔ a = 0 :=
+quadratic_char_fun_eq_zero_iff
+
+@[simp]
+lemma quadratic_char_zero : quadratic_char F 0 = 0 :=
+by simp only [quadratic_char_apply, quadratic_char_fun_zero]
+
+/-- For nonzero `a : F`, `quadratic_char F a = 1 ↔ is_square a`. -/
+lemma quadratic_char_one_iff_is_square {a : F} (ha : a ≠ 0) :
+  quadratic_char F a = 1 ↔ is_square a :=
+by simp only [quadratic_char_apply, quadratic_char_fun, ha, (dec_trivial : (-1 : ℤ) ≠ 1),
+              if_false, ite_eq_left_iff, imp_false, not_not]
+
+/-- The quadratic character takes the value `1` on nonzero squares. -/
+lemma quadratic_char_sq_one' {a : F} (ha : a ≠ 0) : quadratic_char F (a ^ 2) = 1 :=
+by simp only [quadratic_char_fun, ha, pow_eq_zero_iff, nat.succ_pos', is_square_sq, if_true,
+              if_false, quadratic_char_apply]
+
+/-- The square of the quadratic character on nonzero arguments is `1`. -/
+lemma quadratic_char_sq_one {a : F} (ha : a ≠ 0) : (quadratic_char F a) ^ 2 = 1 :=
+by rwa [pow_two, ← map_mul, ← pow_two, quadratic_char_sq_one']
+
+/-- The quadratic character is `1` or `-1` on nonzero arguments. -/
+lemma quadratic_char_dichotomy {a : F} (ha : a ≠ 0) :
+  quadratic_char F a = 1 ∨ quadratic_char F a = -1 :=
+sq_eq_one_iff.1 $ quadratic_char_sq_one ha
+
+/-- The quadratic character is `1` or `-1` on nonzero arguments. -/
+lemma quadratic_char_eq_neg_one_iff_not_one {a : F} (ha : a ≠ 0) :
+  quadratic_char F a = -1 ↔ ¬ quadratic_char F a = 1 :=
+begin
+  refine ⟨λ h, _, λ h₂, (or_iff_right h₂).mp (quadratic_char_dichotomy ha)⟩,
+  rw h,
+  norm_num,
+end
+
+/-- For `a : F`, `quadratic_char F a = -1 ↔ ¬ is_square a`. -/
+lemma quadratic_char_neg_one_iff_not_is_square {a : F} :
+  quadratic_char F a = -1 ↔ ¬ is_square a :=
+begin
+  by_cases ha : a = 0,
+  { simp only [ha, is_square_zero, mul_char.map_zero, zero_eq_neg, one_ne_zero, not_true], },
+  { rw [quadratic_char_eq_neg_one_iff_not_one ha, quadratic_char_one_iff_is_square ha] },
+end
+
+/-- If `F` has odd characteristic, then `quadratic_char F` takes the value `-1`. -/
+lemma quadratic_char_exists_neg_one (hF : ring_char F ≠ 2) : ∃ a, quadratic_char F a = -1 :=
+(finite_field.exists_nonsquare hF).imp $ λ b h₁, quadratic_char_neg_one_iff_not_is_square.mpr h₁
+
+/-- If `ring_char F = 2`, then `quadratic_char F` takes the value `1` on nonzero elements. -/
+lemma quadratic_char_eq_one_of_char_two (hF : ring_char F = 2) {a : F} (ha : a ≠ 0) :
+  quadratic_char F a = 1 :=
+quadratic_char_fun_eq_one_of_char_two hF ha
+
+/-- If `ring_char F` is odd, then `quadratic_char F a` can be computed in
+terms of `a ^ (fintype.card F / 2)`. -/
+lemma quadratic_char_eq_pow_of_char_ne_two (hF : ring_char F ≠ 2) {a : F} (ha : a ≠ 0) :
+  quadratic_char F a = if a ^ (fintype.card F / 2) = 1 then 1 else -1 :=
+quadratic_char_fun_eq_pow_of_char_ne_two hF ha
+
+lemma quadratic_char_eq_pow_of_char_ne_two' (hF : ring_char F ≠ 2) (a : F) :
+  (quadratic_char F a : F) = a ^ (fintype.card F / 2) :=
+begin
+  by_cases ha : a = 0,
+  { have : 0 < fintype.card F / 2 := nat.div_pos fintype.one_lt_card two_pos,
+    simp only [ha, zero_pow this, quadratic_char_apply, quadratic_char_zero, int.cast_zero], },
+  { rw [quadratic_char_eq_pow_of_char_ne_two hF ha],
+    by_cases ha' : a ^ (fintype.card F / 2) = 1,
+    { simp only [ha', eq_self_iff_true, if_true, int.cast_one], },
+    { have ha'' := or.resolve_left (finite_field.pow_dichotomy hF ha) ha',
+      simp only [ha'', int.cast_ite, int.cast_one, int.cast_neg, ite_eq_right_iff],
+      exact eq.symm, } }
+end
+
+variables (F)
+
+/-- The quadratic character is quadratic as a multiplicative character. -/
+lemma quadratic_char_is_quadratic : (quadratic_char F).is_quadratic :=
+begin
+  intro a,
+  by_cases ha : a = 0,
+  { left, rw ha, exact quadratic_char_zero, },
+  { right, exact quadratic_char_dichotomy ha, },
+end
+
+variables {F}
+
+/-- The quadratic character is nontrivial as a multiplicative character
+when the domain has odd characteristic. -/
+lemma quadratic_char_is_nontrivial (hF : ring_char F ≠ 2) : (quadratic_char F).is_nontrivial :=
+begin
+  rcases quadratic_char_exists_neg_one hF with ⟨a, ha⟩,
+  have hu : is_unit a := by { by_contra hf, rw map_nonunit _ hf at ha, norm_num at ha, },
+  refine ⟨hu.unit, (_ : quadratic_char F a ≠ 1)⟩,
+  rw ha,
+  norm_num,
+end
+
+/-- The number of solutions to `x^2 = a` is determined by the quadratic character. -/
+lemma quadratic_char_card_sqrts (hF : ring_char F ≠ 2) (a : F) :
+  ↑{x : F | x^2 = a}.to_finset.card = quadratic_char F a + 1 :=
+begin
+  -- we consider the cases `a = 0`, `a` is a nonzero square and `a` is a nonsquare in turn
+  by_cases h₀ : a = 0,
+  { simp only [h₀, pow_eq_zero_iff, nat.succ_pos', int.coe_nat_succ, int.coe_nat_zero,
+               mul_char.map_zero, set.set_of_eq_eq_singleton, set.to_finset_card,
+               set.card_singleton], },
+  { set s := {x : F | x^2 = a}.to_finset with hs,
+    by_cases h : is_square a,
+    { rw (quadratic_char_one_iff_is_square h₀).mpr h,
+      rcases h with ⟨b, h⟩,
+      rw [h, mul_self_eq_zero] at h₀,
+      have h₁ : s = [b, -b].to_finset := by
+      { ext x,
+        simp only [finset.mem_filter, finset.mem_univ, true_and, list.to_finset_cons,
+                   list.to_finset_nil, insert_emptyc_eq, finset.mem_insert, finset.mem_singleton],
+        rw ← pow_two at h,
+        simp only [hs, set.mem_to_finset, set.mem_set_of_eq, h],
+        split,
+        { exact eq_or_eq_neg_of_sq_eq_sq _ _, },
+        { rintro (h₂ | h₂); rw h₂,
+          simp only [neg_sq], }, },
+      norm_cast,
+      rw  [h₁, list.to_finset_cons, list.to_finset_cons, list.to_finset_nil],
+      exact finset.card_doubleton
+              (ne.symm (mt (ring.eq_self_iff_eq_zero_of_char_ne_two hF).mp h₀)), },
+    { rw quadratic_char_neg_one_iff_not_is_square.mpr h,
+      simp only [int.coe_nat_eq_zero, finset.card_eq_zero, set.to_finset_card,
+                 fintype.card_of_finset, set.mem_set_of_eq, add_left_neg],
+      ext x,
+      simp only [iff_false, finset.mem_filter, finset.mem_univ, true_and, finset.not_mem_empty],
+      rw is_square_iff_exists_sq at h,
+      exact λ h', h ⟨_, h'.symm⟩, }, },
+end
+
+open_locale big_operators
+
+/-- The sum over the values of the quadratic character is zero when the characteristic is odd. -/
+lemma quadratic_char_sum_zero (hF : ring_char F ≠ 2) : ∑ (a : F), quadratic_char F a = 0 :=
+is_nontrivial.sum_eq_zero (quadratic_char_is_nontrivial hF)
+
+end quadratic_char
+
+/-!
+### Special values of the quadratic character
+
+We express `quadratic_char F (-1)` in terms of `χ₄`.
+-/
+
+section special_values
+
+open zmod mul_char
+
+variables {F : Type*} [field F] [fintype F]
+
+/-- The value of the quadratic character at `-1` -/
+lemma quadratic_char_neg_one [decidable_eq F] (hF : ring_char F ≠ 2) :
+  quadratic_char F (-1) = χ₄ (fintype.card F) :=
+begin
+  have h := quadratic_char_eq_pow_of_char_ne_two hF (neg_ne_zero.mpr one_ne_zero),
+  rw [h, χ₄_eq_neg_one_pow (finite_field.odd_card_of_char_ne_two hF)],
+  set n := fintype.card F / 2,
+  cases (nat.even_or_odd n) with h₂ h₂,
+  { simp only [even.neg_one_pow h₂, eq_self_iff_true, if_true], },
+  { simp only [odd.neg_one_pow h₂, ite_eq_right_iff],
+    exact λ hf, false.rec (1 = -1) (ring.neg_one_ne_one_of_char_ne_two hF hf), },
+end
+
+/-- `-1` is a square in `F` iff `#F` is not congruent to `3` mod `4`. -/
+lemma finite_field.is_square_neg_one_iff : is_square (-1 : F) ↔ fintype.card F % 4 ≠ 3 :=
+begin
+  classical, -- suggested by the linter (instead of `[decidable_eq F]`)
+  by_cases hF : ring_char F = 2,
+  { simp only [finite_field.is_square_of_char_two hF, ne.def, true_iff],
+    exact (λ hf, one_ne_zero  $ (nat.odd_of_mod_four_eq_three hf).symm.trans
+                              $ finite_field.even_card_of_char_two hF) },
+  { have h₁ := finite_field.odd_card_of_char_ne_two hF,
+    rw [← quadratic_char_one_iff_is_square (neg_ne_zero.mpr (one_ne_zero' F)),
+        quadratic_char_neg_one hF, χ₄_nat_eq_if_mod_four, h₁],
+    simp only [nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def, (dec_trivial : (-1 : ℤ) ≠ 1),
+               imp_false, not_not],
+    exact ⟨λ h, ne_of_eq_of_ne h (dec_trivial : 1 ≠ 3),
+           or.resolve_right (nat.odd_mod_four_iff.mp h₁)⟩, },
+end
+
+end special_values
diff --git a/src/number_theory/legendre_symbol/quadratic_char/gauss_sum.lean b/src/number_theory/legendre_symbol/quadratic_char/gauss_sum.lean
new file mode 100644
index 0000000000000..ef6cb184b7bcd
--- /dev/null
+++ b/src/number_theory/legendre_symbol/quadratic_char/gauss_sum.lean
@@ -0,0 +1,148 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import number_theory.legendre_symbol.quadratic_char.basic
+import number_theory.legendre_symbol.gauss_sum
+
+/-!
+# Quadratic characters of finite fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Further facts relying on Gauss sums.
+
+-/
+
+/-!
+### Basic properties of the quadratic character
+
+We prove some properties of the quadratic character.
+We work with a finite field `F` here.
+The interesting case is when the characteristic of `F` is odd.
+-/
+
+section special_values
+
+open zmod mul_char
+
+variables {F : Type*} [field F] [fintype F]
+
+/-- The value of the quadratic character at `2` -/
+lemma quadratic_char_two [decidable_eq F] (hF : ring_char F ≠ 2) :
+  quadratic_char F 2 = χ₈ (fintype.card F) :=
+is_quadratic.eq_of_eq_coe (quadratic_char_is_quadratic F) is_quadratic_χ₈ hF
+  ((quadratic_char_eq_pow_of_char_ne_two' hF 2).trans (finite_field.two_pow_card hF))
+
+/-- `2` is a square in `F` iff `#F` is not congruent to `3` or `5` mod `8`. -/
+lemma finite_field.is_square_two_iff :
+  is_square (2 : F) ↔ fintype.card F % 8 ≠ 3 ∧ fintype.card F % 8 ≠ 5 :=
+begin
+  classical,
+  by_cases hF : ring_char F = 2,
+  focus
+  { have h := finite_field.even_card_of_char_two hF,
+    simp only [finite_field.is_square_of_char_two hF, true_iff], },
+  rotate, focus
+  { have h := finite_field.odd_card_of_char_ne_two hF,
+    rw [← quadratic_char_one_iff_is_square (ring.two_ne_zero hF), quadratic_char_two hF,
+        χ₈_nat_eq_if_mod_eight],
+    simp only [h, nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def, (dec_trivial : (-1 : ℤ) ≠ 1),
+               imp_false, not_not], },
+  all_goals
+  { rw [← nat.mod_mod_of_dvd _ (by norm_num : 2 ∣ 8)] at h,
+    have h₁ := nat.mod_lt (fintype.card F) (dec_trivial : 0 < 8),
+    revert h₁ h,
+    generalize : fintype.card F % 8 = n,
+    dec_trivial!, }
+end
+
+/-- The value of the quadratic character at `-2` -/
+lemma quadratic_char_neg_two [decidable_eq F] (hF : ring_char F ≠ 2) :
+  quadratic_char F (-2) = χ₈' (fintype.card F) :=
+begin
+  rw [(by norm_num : (-2 : F) = (-1) * 2), map_mul, χ₈'_eq_χ₄_mul_χ₈, quadratic_char_neg_one hF,
+      quadratic_char_two hF, @cast_nat_cast _ (zmod 4) _ _ _ (by norm_num : 4 ∣ 8)],
+end
+
+/-- `-2` is a square in `F` iff `#F` is not congruent to `5` or `7` mod `8`. -/
+lemma finite_field.is_square_neg_two_iff :
+  is_square (-2 : F) ↔ fintype.card F % 8 ≠ 5 ∧ fintype.card F % 8 ≠ 7 :=
+begin
+  classical,
+  by_cases hF : ring_char F = 2,
+  focus
+  { have h := finite_field.even_card_of_char_two hF,
+    simp only [finite_field.is_square_of_char_two hF, true_iff], },
+  rotate, focus
+  { have h := finite_field.odd_card_of_char_ne_two hF,
+    rw [← quadratic_char_one_iff_is_square (neg_ne_zero.mpr (ring.two_ne_zero hF)),
+        quadratic_char_neg_two hF, χ₈'_nat_eq_if_mod_eight],
+    simp only [h, nat.one_ne_zero, if_false, ite_eq_left_iff, ne.def, (dec_trivial : (-1 : ℤ) ≠ 1),
+               imp_false, not_not], },
+  all_goals
+  { rw [← nat.mod_mod_of_dvd _ (by norm_num : 2 ∣ 8)] at h,
+    have h₁ := nat.mod_lt (fintype.card F) (dec_trivial : 0 < 8),
+    revert h₁ h,
+    generalize : fintype.card F % 8 = n,
+    dec_trivial! }
+end
+
+/-- The relation between the values of the quadratic character of one field `F` at the
+cardinality of another field `F'` and of the quadratic character of `F'` at the cardinality
+of `F`. -/
+lemma quadratic_char_card_card [decidable_eq F] (hF : ring_char F ≠ 2) {F' : Type*} [field F']
+  [fintype F'] [decidable_eq F'] (hF' : ring_char F' ≠ 2) (h : ring_char F' ≠ ring_char F) :
+  quadratic_char F (fintype.card F') = quadratic_char F' (quadratic_char F (-1) * fintype.card F) :=
+begin
+  let χ := (quadratic_char F).ring_hom_comp (algebra_map ℤ F'),
+  have hχ₁ : χ.is_nontrivial,
+  { obtain ⟨a, ha⟩ := quadratic_char_exists_neg_one hF,
+    have hu : is_unit a,
+    { contrapose ha,
+      exact ne_of_eq_of_ne (map_nonunit (quadratic_char F) ha)
+             (mt zero_eq_neg.mp one_ne_zero), },
+    use hu.unit,
+    simp only [is_unit.unit_spec, ring_hom_comp_apply, eq_int_cast, ne.def, ha],
+    rw [int.cast_neg, int.cast_one],
+    exact ring.neg_one_ne_one_of_char_ne_two hF', },
+  have hχ₂ : χ.is_quadratic := is_quadratic.comp (quadratic_char_is_quadratic F) _,
+  have h := char.card_pow_card hχ₁ hχ₂ h hF',
+  rw [← quadratic_char_eq_pow_of_char_ne_two' hF'] at h,
+  exact (is_quadratic.eq_of_eq_coe (quadratic_char_is_quadratic F')
+             (quadratic_char_is_quadratic F) hF' h).symm,
+end
+
+/-- The value of the quadratic character at an odd prime `p` different from `ring_char F`. -/
+lemma quadratic_char_odd_prime [decidable_eq F] (hF : ring_char F ≠ 2) {p : ℕ} [fact p.prime]
+  (hp₁ : p ≠ 2) (hp₂ : ring_char F ≠ p) :
+  quadratic_char F p = quadratic_char (zmod p) (χ₄ (fintype.card F) * fintype.card F) :=
+begin
+  rw [← quadratic_char_neg_one hF],
+  have h := quadratic_char_card_card hF (ne_of_eq_of_ne (ring_char_zmod_n p) hp₁)
+              (ne_of_eq_of_ne (ring_char_zmod_n p) hp₂.symm),
+  rwa [card p] at h,
+end
+
+/-- An odd prime `p` is a square in `F` iff the quadratic character of `zmod p` does not
+take the value `-1` on `χ₄(#F) * #F`. -/
+lemma finite_field.is_square_odd_prime_iff (hF : ring_char F ≠ 2) {p : ℕ} [fact p.prime]
+  (hp : p ≠ 2) :
+  is_square (p : F) ↔ quadratic_char (zmod p) (χ₄ (fintype.card F) * fintype.card F) ≠ -1 :=
+begin
+  classical,
+  by_cases hFp : ring_char F = p,
+  { rw [show (p : F) = 0, by { rw ← hFp, exact ring_char.nat.cast_ring_char }],
+    simp only [is_square_zero, ne.def, true_iff, map_mul],
+    obtain ⟨n, _, hc⟩ := finite_field.card F (ring_char F),
+    have hchar : ring_char F = ring_char (zmod p) := by {rw hFp, exact (ring_char_zmod_n p).symm},
+    conv {congr, to_lhs, congr, skip, rw [hc, nat.cast_pow, map_pow, hchar, map_ring_char], },
+    simp only [zero_pow n.pos, mul_zero, zero_eq_neg, one_ne_zero, not_false_iff], },
+  { rw [← iff.not_left (@quadratic_char_neg_one_iff_not_is_square F _ _ _ _),
+        quadratic_char_odd_prime hF hp],
+    exact hFp, },
+end
+
+end special_values
diff --git a/src/number_theory/legendre_symbol/quadratic_reciprocity.lean b/src/number_theory/legendre_symbol/quadratic_reciprocity.lean
index 9f97b90b400a4..c8b13ea94189e 100644
--- a/src/number_theory/legendre_symbol/quadratic_reciprocity.lean
+++ b/src/number_theory/legendre_symbol/quadratic_reciprocity.lean
@@ -3,357 +3,193 @@ Copyright (c) 2018 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes, Michael Stoll
 -/
-import number_theory.legendre_symbol.gauss_eisenstein_lemmas
-import number_theory.legendre_symbol.quadratic_char
+import number_theory.legendre_symbol.basic
+import number_theory.legendre_symbol.quadratic_char.gauss_sum
 
 /-!
-# Legendre symbol and quadratic reciprocity.
+# Quadratic reciprocity.
 
-This file contains results about quadratic residues modulo a prime number.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-We define the Legendre symbol `(a / p)` as `legendre_sym p a`.
-Note the order of arguments! The advantage of this form is that then `legendre_sym p`
-is a multiplicative map.
+## Main results
 
-The main results are the law of quadratic reciprocity, `quadratic_reciprocity`, as well as the
+We prove the law of quadratic reciprocity, see `legendre_sym.quadratic_reciprocity` and
+`legendre_sym.quadratic_reciprocity'`, as well as the
 interpretations in terms of existence of square roots depending on the congruence mod 4,
-`exists_sq_eq_prime_iff_of_mod_four_eq_one`, and
-`exists_sq_eq_prime_iff_of_mod_four_eq_three`.
+`zmod.exists_sq_eq_prime_iff_of_mod_four_eq_one`, and
+`zmod.exists_sq_eq_prime_iff_of_mod_four_eq_three`.
 
-Also proven are conditions for `-1` and `2` to be a square modulo a prime,
-`legende_sym_neg_one` and `exists_sq_eq_neg_one_iff` for `-1`, and
-`exists_sq_eq_two_iff` for `2`
+We also prove the supplementary laws that give conditions for when `-1` or `2`
+(or `-2`) is a square modulo a prime `p`:
+`legendre_sym.at_neg_one` and `zmod.exists_sq_eq_neg_one_iff` for `-1`,
+`legendre_sym.at_two` and `zmod.exists_sq_eq_two_iff` for `2`,
+`legendre_sym.at_neg_two` and `zmod.exists_sq_eq_neg_two_iff` for `-2`.
 
 ## Implementation notes
 
-The proof of quadratic reciprocity implemented uses Gauss' lemma and Eisenstein's lemma
--/
-
-open finset nat char
-
-namespace zmod
+The proofs use results for quadratic characters on arbitrary finite fields
+from `number_theory.legendre_symbol.quadratic_char.gauss_sum`, which in turn are based on
+properties of quadratic Gauss sums as provided by `number_theory.legendre_symbol.gauss_sum`.
 
-variables (p q : ℕ) [fact p.prime] [fact q.prime]
+## Tags
 
-/-- Euler's Criterion: A unit `x` of `zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
-lemma euler_criterion_units (x : (zmod p)ˣ) :
-  (∃ y : (zmod p)ˣ, y ^ 2 = x) ↔ x ^ (p / 2) = 1 :=
-begin
-  by_cases hc : p = 2,
-  { substI hc,
-    simp only [eq_iff_true_of_subsingleton, exists_const], },
-  { have h₀ := finite_field.unit_is_square_iff (by rwa ring_char_zmod_n) x,
-    have hs : (∃ y : (zmod p)ˣ, y ^ 2 = x) ↔ is_square(x) :=
-    by { rw is_square_iff_exists_sq x,
-         simp_rw eq_comm, },
-    rw hs,
-    rwa card p at h₀, },
-end
+quadratic residue, quadratic nonresidue, Legendre symbol, quadratic reciprocity
+-/
 
-/-- Euler's Criterion: a nonzero `a : zmod p` is a square if and only if `x ^ (p / 2) = 1`. -/
-lemma euler_criterion {a : zmod p} (ha : a ≠ 0) :
-  is_square (a : zmod p) ↔ a ^ (p / 2) = 1 :=
-begin
-  apply (iff_congr _ (by simp [units.ext_iff])).mp (euler_criterion_units p (units.mk0 a ha)),
-  simp only [units.ext_iff, sq, units.coe_mk0, units.coe_mul],
-  split, { rintro ⟨y, hy⟩, exact ⟨y, hy.symm⟩ },
-  { rintro ⟨y, rfl⟩,
-    have hy : y ≠ 0, { rintro rfl, simpa [zero_pow] using ha, },
-    refine ⟨units.mk0 y hy, _⟩, simp, }
-end
+open nat
 
-lemma exists_sq_eq_neg_one_iff : is_square (-1 : zmod p) ↔ p % 4 ≠ 3 :=
-begin
-  have h := @is_square_neg_one_iff (zmod p) _ _,
-  rw card p at h,
-  exact h,
-end
+section values
 
-lemma mod_four_ne_three_of_sq_eq_neg_one {y : zmod p} (hy : y ^ 2 = -1) : p % 4 ≠ 3 :=
-begin
-  rw pow_two at hy,
-  exact (exists_sq_eq_neg_one_iff p).1 ⟨y, hy.symm⟩
-end
+variables {p : ℕ} [fact p.prime]
 
-lemma mod_four_ne_three_of_sq_eq_neg_sq' {x y : zmod p} (hy : y ≠ 0) (hxy : x ^ 2 = - y ^ 2) :
-  p % 4 ≠ 3 :=
-@mod_four_ne_three_of_sq_eq_neg_one p _ (x / y) begin
-  apply_fun (λ z, z / y ^ 2) at hxy,
-  rwa [neg_div, ←div_pow, ←div_pow, div_self hy, one_pow] at hxy
-end
+open zmod
 
-lemma mod_four_ne_three_of_sq_eq_neg_sq {x y : zmod p} (hx : x ≠ 0) (hxy : x ^ 2 = - y ^ 2) :
-  p % 4 ≠ 3 :=
-begin
-  apply_fun (λ x, -x) at hxy,
-  rw neg_neg at hxy,
-  exact mod_four_ne_three_of_sq_eq_neg_sq' p hx hxy.symm
-end
+/-!
+### The value of the Legendre symbol at `2` and `-2`
 
-lemma pow_div_two_eq_neg_one_or_one {a : zmod p} (ha : a ≠ 0) :
-  a ^ (p / 2) = 1 ∨ a ^ (p / 2) = -1 :=
-begin
-  cases nat.prime.eq_two_or_odd (fact.out p.prime) with hp2 hp_odd,
-  { substI p, revert a ha, dec_trivial },
-  rw [← mul_self_eq_one_iff, ← pow_add, ← two_mul, two_mul_odd_div_two hp_odd],
-  exact pow_card_sub_one_eq_one ha
-end
+See `jacobi_sym.at_two` and `jacobi_sym.at_neg_two` for the corresponding statements
+for the Jacobi symbol.
+-/
 
-/-- The Legendre symbol of `a : ℤ` and a prime `p`, `legendre_sym p a`,
-is an integer defined as
+namespace legendre_sym
 
-* `0` if `a` is `0` modulo `p`;
-* `1` if `a` is a square modulo `p`
-* `-1` otherwise.
+variables (hp : p ≠ 2)
+include hp
 
-Note the order of the arguments! The advantage of the order chosen here is
-that `legendre_sym p` is a multiplicative function `ℤ → ℤ`.
--/
-def legendre_sym (p : ℕ) [fact p.prime] (a : ℤ) : ℤ := quadratic_char (zmod p) a
+/-- `legendre_sym p 2` is given by `χ₈ p`. -/
+lemma at_two : legendre_sym p 2 = χ₈ p :=
+by simp only [legendre_sym, card p, quadratic_char_two ((ring_char_zmod_n p).substr hp),
+              int.cast_bit0, int.cast_one]
 
-/-- We have the congruence `legendre_sym p a ≡ a ^ (p / 2) mod p`. -/
-lemma legendre_sym_eq_pow (p : ℕ) (a : ℤ) [hp : fact p.prime] :
-  (legendre_sym p a : zmod p) = (a ^ (p / 2)) :=
-begin
-  rw legendre_sym,
-  by_cases ha : (a : zmod p) = 0,
-  { simp only [ha, zero_pow (nat.div_pos (hp.1.two_le) (succ_pos 1)), quadratic_char_zero,
-               int.cast_zero], },
-  by_cases hp₁ : p = 2,
-  { substI p,
-    generalize : (a : (zmod 2)) = b, revert b, dec_trivial, },
-  { have h₁ := quadratic_char_eq_pow_of_char_ne_two (by rwa ring_char_zmod_n p) ha,
-    rw card p at h₁,
-    rw h₁,
-    have h₂ := finite_field.neg_one_ne_one_of_char_ne_two (by rwa ring_char_zmod_n p),
-    cases pow_div_two_eq_neg_one_or_one p ha with h h,
-    { rw [if_pos h, h, int.cast_one], },
-    { rw [h, if_neg h₂, int.cast_neg, int.cast_one], } }
-end
+/-- `legendre_sym p (-2)` is given by `χ₈' p`. -/
+lemma at_neg_two : legendre_sym p (-2) = χ₈' p :=
+by simp only [legendre_sym, card p, quadratic_char_neg_two ((ring_char_zmod_n p).substr hp),
+              int.cast_bit0, int.cast_one, int.cast_neg]
 
-/-- If `p ∤ a`, then `legendre_sym p a` is `1` or `-1`. -/
-lemma legendre_sym_eq_one_or_neg_one (p : ℕ) [fact p.prime] (a : ℤ) (ha : (a : zmod p) ≠ 0) :
-  legendre_sym p a = 1 ∨ legendre_sym p a = -1 :=
-quadratic_char_dichotomy ha
+end legendre_sym
 
-lemma legendre_sym_eq_neg_one_iff_not_one {a : ℤ} (ha : (a : zmod p) ≠ 0) :
-  legendre_sym p a = -1 ↔ ¬ legendre_sym p a = 1 :=
-quadratic_char_eq_neg_one_iff_not_one ha
+namespace zmod
 
-/-- The Legendre symbol of `p` and `a` is zero iff `p ∣ a`. -/
-lemma legendre_sym_eq_zero_iff (p : ℕ) [fact p.prime] (a : ℤ) :
-  legendre_sym p a = 0 ↔ (a : zmod p) = 0 :=
-quadratic_char_eq_zero_iff a
+variables (hp : p ≠ 2)
+include hp
 
-@[simp] lemma legendre_sym_zero (p : ℕ) [fact p.prime] : legendre_sym p 0 = 0 :=
+/-- `2` is a square modulo an odd prime `p` iff `p` is congruent to `1` or `7` mod `8`. -/
+lemma exists_sq_eq_two_iff : is_square (2 : zmod p) ↔ p % 8 = 1 ∨ p % 8 = 7 :=
 begin
-  rw legendre_sym,
-  exact quadratic_char_zero,
+  rw [finite_field.is_square_two_iff, card p],
+  have h₁ := prime.mod_two_eq_one_iff_ne_two.mpr hp,
+  rw [← mod_mod_of_dvd p (by norm_num : 2 ∣ 8)] at h₁,
+  have h₂ := mod_lt p (by norm_num : 0 < 8),
+  revert h₂ h₁,
+  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
+  dec_trivial!,
 end
 
-@[simp] lemma legendre_sym_one (p : ℕ) [fact p.prime] : legendre_sym p 1 = 1 :=
+/-- `-2` is a square modulo an odd prime `p` iff `p` is congruent to `1` or `3` mod `8`. -/
+lemma exists_sq_eq_neg_two_iff : is_square (-2 : zmod p) ↔ p % 8 = 1 ∨ p % 8 = 3 :=
 begin
-  rw [legendre_sym, (by norm_cast : ((1 : ℤ) : zmod p) = 1)],
-  exact quadratic_char_one,
+  rw [finite_field.is_square_neg_two_iff, card p],
+  have h₁ := prime.mod_two_eq_one_iff_ne_two.mpr hp,
+  rw [← mod_mod_of_dvd p (by norm_num : 2 ∣ 8)] at h₁,
+  have h₂ := mod_lt p (by norm_num : 0 < 8),
+  revert h₂ h₁,
+  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
+  dec_trivial!,
 end
 
-/-- The Legendre symbol is multiplicative in `a` for `p` fixed. -/
-lemma legendre_sym_mul (p : ℕ) [fact p.prime] (a b : ℤ) :
-  legendre_sym p (a * b) = legendre_sym p a * legendre_sym p b :=
-begin
-  rw [legendre_sym, legendre_sym, legendre_sym],
-  push_cast,
-  exact quadratic_char_mul (a : zmod p) b,
-end
+end zmod
 
-/-- The Legendre symbol is a homomorphism of monoids with zero. -/
-@[simps] def legendre_sym_hom (p : ℕ) [fact p.prime] : ℤ →*₀ ℤ :=
-{ to_fun := legendre_sym p,
-  map_zero' := legendre_sym_zero p,
-  map_one' := legendre_sym_one p,
-  map_mul' := legendre_sym_mul p }
-
-/-- The square of the symbol is 1 if `p ∤ a`. -/
-theorem legendre_sym_sq_one (p : ℕ) [fact p.prime] (a : ℤ) (ha : (a : zmod p) ≠ 0) :
-  (legendre_sym p a)^2 = 1 :=
-quadratic_char_sq_one ha
-
-/-- The Legendre symbol of `a^2` at `p` is 1 if `p ∤ a`. -/
-theorem legendre_sym_sq_one'  (p : ℕ) [fact p.prime] (a : ℤ) (ha : (a : zmod p) ≠ 0) :
-  legendre_sym p (a ^ 2) = 1 :=
-begin
-  rw [legendre_sym],
-  push_cast,
-  exact quadratic_char_sq_one' ha,
-end
+end values
 
-/-- The Legendre symbol depends only on `a` mod `p`. -/
-theorem legendre_sym_mod (p : ℕ) [fact p.prime] (a : ℤ) :
-  legendre_sym p a = legendre_sym p (a % p) :=
-by simp only [legendre_sym, int_cast_mod]
+section reciprocity
 
+/-!
+### The Law of Quadratic Reciprocity
 
-/-- Gauss' lemma. The legendre symbol can be computed by considering the number of naturals less
-  than `p/2` such that `(a * x) % p > p / 2` -/
-lemma gauss_lemma {a : ℤ} (hp : p ≠ 2) (ha0 : (a : zmod p) ≠ 0) :
-  legendre_sym p a = (-1) ^ ((Ico 1 (p / 2).succ).filter
-    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card :=
-begin
-  haveI hp' : fact (p % 2 = 1) := ⟨nat.prime.mod_two_eq_one_iff_ne_two.mpr hp⟩,
-  have : (legendre_sym p a : zmod p) = (((-1)^((Ico 1 (p / 2).succ).filter
-    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card : ℤ) : zmod p) :=
-    by { rw [legendre_sym_eq_pow, legendre_symbol.gauss_lemma_aux p ha0]; simp },
-  cases legendre_sym_eq_one_or_neg_one p a ha0;
-  cases neg_one_pow_eq_or ℤ ((Ico 1 (p / 2).succ).filter
-    (λ x : ℕ, p / 2 < (a * x : zmod p).val)).card;
-  simp [*, ne_neg_self p one_ne_zero, (ne_neg_self p one_ne_zero).symm] at *
-end
+See `jacobi_sym.quadratic_reciprocity` and variants for a version of Quadratic Reciprocity
+for the Jacobi symbol.
+-/
 
-/-- When `p ∤ a`, then `legendre_sym p a = 1` iff `a` is a square mod `p`. -/
-lemma legendre_sym_eq_one_iff {a : ℤ} (ha0 : (a : zmod p) ≠ 0) :
-  legendre_sym p a = 1 ↔ is_square (a : zmod p) :=
-quadratic_char_one_iff_is_square ha0
+variables {p q : ℕ} [fact p.prime] [fact q.prime]
 
-/-- `legendre_sym p a = -1` iff`a` is a nonsquare mod `p`. -/
-lemma legendre_sym_eq_neg_one_iff {a : ℤ} :
-  legendre_sym p a = -1 ↔ ¬ is_square (a : zmod p) :=
-quadratic_char_neg_one_iff_not_is_square
+namespace legendre_sym
 
-/-- The number of square roots of `a` modulo `p` is determined by the Legendre symbol. -/
-lemma legendre_sym_card_sqrts (hp : p ≠ 2) (a : ℤ) :
-  ↑{x : zmod p | x^2 = a}.to_finset.card = legendre_sym p a + 1 :=
-begin
-  have h : ring_char (zmod p) ≠ 2 := by { rw ring_char_zmod_n, exact hp, },
-  exact quadratic_char_card_sqrts h a,
-end
+open zmod
 
-/-- `legendre_sym p (-1)` is given by `χ₄ p`. -/
-lemma legendre_sym_neg_one (hp : p ≠ 2) : legendre_sym p (-1) = χ₄ p :=
+/-- The Law of Quadratic Reciprocity: if `p` and `q` are distinct odd primes, then
+`(q / p) * (p / q) = (-1)^((p-1)(q-1)/4)`. -/
+theorem quadratic_reciprocity (hp : p ≠ 2) (hq : q ≠ 2) (hpq : p ≠ q) :
+  legendre_sym q p * legendre_sym p q = (-1) ^ ((p / 2) * (q / 2)) :=
 begin
-  have h : ring_char (zmod p) ≠ 2 := by { rw ring_char_zmod_n, exact hp, },
-  have h₁ := quadratic_char_neg_one h,
-  rw card p at h₁,
-  exact_mod_cast h₁,
+  have hp₁ := (prime.eq_two_or_odd $ fact.out p.prime).resolve_left hp,
+  have hq₁ := (prime.eq_two_or_odd $ fact.out q.prime).resolve_left hq,
+  have hq₂ := (ring_char_zmod_n q).substr hq,
+  have h := quadratic_char_odd_prime ((ring_char_zmod_n p).substr hp) hq
+              ((ring_char_zmod_n p).substr hpq),
+  rw [card p] at h,
+  have nc : ∀ (n r : ℕ), ((n : ℤ) : zmod r) = n := λ n r, by norm_cast,
+  have nc' : (((-1) ^ (p / 2) : ℤ) : zmod q) = (-1) ^ (p / 2) := by norm_cast,
+  rw [legendre_sym, legendre_sym, nc, nc, h, map_mul, mul_rotate', mul_comm (p / 2), ← pow_two,
+      quadratic_char_sq_one (prime_ne_zero q p hpq.symm), mul_one, pow_mul, χ₄_eq_neg_one_pow hp₁,
+      nc', map_pow, quadratic_char_neg_one hq₂, card q, χ₄_eq_neg_one_pow hq₁],
+end
+
+/-- The Law of Quadratic Reciprocity: if `p` and `q` are odd primes, then
+`(q / p) = (-1)^((p-1)(q-1)/4) * (p / q)`. -/
+theorem quadratic_reciprocity' (hp : p ≠ 2) (hq : q ≠ 2) :
+  legendre_sym q p = (-1) ^ ((p / 2) * (q / 2)) * legendre_sym p q :=
+begin
+  cases eq_or_ne p q with h h,
+  { substI p,
+    rw [(eq_zero_iff q q).mpr (by exact_mod_cast nat_cast_self q), mul_zero] },
+  { have qr := congr_arg (* legendre_sym p q) (quadratic_reciprocity hp hq h),
+    have : ((q : ℤ) : zmod p) ≠ 0 := by exact_mod_cast prime_ne_zero p q h,
+    simpa only [mul_assoc, ← pow_two, sq_one p this, mul_one] using qr }
 end
 
-open_locale big_operators
+/-- The Law of Quadratic Reciprocity: if `p` and `q` are odd primes and `p % 4 = 1`,
+then `(q / p) = (p / q)`. -/
+theorem quadratic_reciprocity_one_mod_four (hp : p % 4 = 1) (hq : q ≠ 2) :
+  legendre_sym q p = legendre_sym p q :=
+by rw [quadratic_reciprocity' (prime.mod_two_eq_one_iff_ne_two.mp
+                                             (odd_of_mod_four_eq_one hp)) hq,
+       pow_mul, neg_one_pow_div_two_of_one_mod_four hp, one_pow, one_mul]
 
-lemma eisenstein_lemma (hp : p ≠ 2) {a : ℕ} (ha1 : a % 2 = 1) (ha0 : (a : zmod p) ≠ 0) :
-  legendre_sym p a = (-1)^∑ x in Ico 1 (p / 2).succ, (x * a) / p :=
-begin
-  haveI hp' : fact (p % 2 = 1) := ⟨nat.prime.mod_two_eq_one_iff_ne_two.mpr hp⟩,
-  have ha0' : ((a : ℤ) : zmod p) ≠ 0 := by { norm_cast, exact ha0 },
-  rw [neg_one_pow_eq_pow_mod_two, gauss_lemma p hp ha0', neg_one_pow_eq_pow_mod_two,
-      (by norm_cast : ((a : ℤ) : zmod p) = (a : zmod p)),
-      show _ = _, from legendre_symbol.eisenstein_lemma_aux p ha1 ha0]
+/-- The Law of Quadratic Reciprocity: if `p` and `q` are primes that are both congruent
+to `3` mod `4`, then `(q / p) = -(p / q)`. -/
+theorem quadratic_reciprocity_three_mod_four (hp : p % 4 = 3) (hq : q % 4 = 3):
+  legendre_sym q p = -legendre_sym p q :=
+let nop := @neg_one_pow_div_two_of_three_mod_four in begin
+  rw [quadratic_reciprocity', pow_mul, nop hp, nop hq, neg_one_mul];
+  rwa [← prime.mod_two_eq_one_iff_ne_two, odd_of_mod_four_eq_three],
 end
 
-/-- **Quadratic reciprocity theorem** -/
-theorem quadratic_reciprocity (hp1 : p ≠ 2) (hq1 : q ≠ 2) (hpq : p ≠ q) :
-  legendre_sym q p * legendre_sym p q = (-1) ^ ((p / 2) * (q / 2)) :=
-have hpq0 : (p : zmod q) ≠ 0, from prime_ne_zero q p hpq.symm,
-have hqp0 : (q : zmod p) ≠ 0, from prime_ne_zero p q hpq,
-by rw [eisenstein_lemma q hq1 (nat.prime.mod_two_eq_one_iff_ne_two.mpr hp1) hpq0,
-       eisenstein_lemma p hp1 (nat.prime.mod_two_eq_one_iff_ne_two.mpr hq1) hqp0,
-  ← pow_add, legendre_symbol.sum_mul_div_add_sum_mul_div_eq_mul q p hpq0, mul_comm]
+end legendre_sym
 
-lemma legendre_sym_two (hp2 : p ≠ 2) : legendre_sym p 2 = (-1) ^ (p / 4 + p / 2) :=
-begin
-  have hp1 := nat.prime.mod_two_eq_one_iff_ne_two.mpr hp2,
-  have hp22 : p / 2 / 2 = _ := legendre_symbol.div_eq_filter_card (show 0 < 2, from dec_trivial)
-    (nat.div_le_self (p / 2) 2),
-  have hcard : (Ico 1 (p / 2).succ).card = p / 2, by simp,
-  have hx2 : ∀ x ∈ Ico 1 (p / 2).succ, (2 * x : zmod p).val = 2 * x,
-    from λ x hx, have h2xp : 2 * x < p,
-        from calc 2 * x ≤ 2 * (p / 2) : mul_le_mul_of_nonneg_left
-          (le_of_lt_succ $ (mem_Ico.mp hx).2) dec_trivial
-        ... < _ : by conv_rhs {rw [← div_add_mod p 2, hp1]}; exact lt_succ_self _,
-      by rw [← nat.cast_two, ← nat.cast_mul, val_cast_of_lt h2xp],
-  have hdisj : disjoint
-      ((Ico 1 (p / 2).succ).filter (λ x, p / 2 < ((2 : ℕ) * x : zmod p).val))
-      ((Ico 1 (p / 2).succ).filter (λ x, x * 2 ≤ p / 2)),
-    from disjoint_filter.2 (λ x hx, by simp [hx2 _ hx, mul_comm]),
-  have hunion :
-      ((Ico 1 (p / 2).succ).filter (λ x, p / 2 < ((2 : ℕ) * x : zmod p).val)) ∪
-      ((Ico 1 (p / 2).succ).filter (λ x, x * 2 ≤ p / 2)) =
-      Ico 1 (p / 2).succ,
-    begin
-      rw [filter_union_right],
-      conv_rhs {rw [← @filter_true _ (Ico 1 (p / 2).succ)]},
-      exact filter_congr (λ x hx, by simp [hx2 _ hx, lt_or_le, mul_comm])
-    end,
-  have hp2' := prime_ne_zero p 2 hp2,
-  rw (by norm_cast : ((2 : ℕ) : zmod p) = (2 : ℤ)) at *,
-  erw [gauss_lemma p hp2 hp2',
-      neg_one_pow_eq_pow_mod_two, @neg_one_pow_eq_pow_mod_two _ _ (p / 4 + p / 2)],
-  refine congr_arg2 _ rfl ((eq_iff_modeq_nat 2).1 _),
-  rw [show 4 = 2 * 2, from rfl, ← nat.div_div_eq_div_mul, hp22, nat.cast_add,
-      ← sub_eq_iff_eq_add', sub_eq_add_neg, neg_eq_self_mod_two,
-      ← nat.cast_add, ← card_disjoint_union hdisj, hunion, hcard]
-end
+namespace zmod
 
-lemma exists_sq_eq_two_iff (hp1 : p ≠ 2) :
-  is_square (2 : zmod p) ↔ p % 8 = 1 ∨ p % 8 = 7 :=
-begin
-  have hp2 : ((2 : ℤ) : zmod p) ≠ 0,
-    from prime_ne_zero p 2 (λ h, by simpa [h] using hp1),
-  have hpm4 : p % 4 = p % 8 % 4, from (nat.mod_mul_left_mod p 2 4).symm,
-  have hpm2 : p % 2 = p % 8 % 2, from (nat.mod_mul_left_mod p 4 2).symm,
-  rw [show (2 : zmod p) = (2 : ℤ), by simp, ← legendre_sym_eq_one_iff p hp2],
-  erw [legendre_sym_two p hp1, neg_one_pow_eq_one_iff_even (show (-1 : ℤ) ≠ 1, from dec_trivial),
-    even_add, even_div, even_div],
-  have := nat.mod_lt p (show 0 < 8, from dec_trivial),
-  have hp := nat.prime.mod_two_eq_one_iff_ne_two.mpr hp1,
-  revert this hp,
-  erw [hpm4, hpm2],
-  generalize hm : p % 8 = m, unfreezingI {clear_dependent p},
-  dec_trivial!,
-end
+open legendre_sym
 
+/-- If `p` and `q` are odd primes and `p % 4 = 1`, then `q` is a square mod `p` iff
+`p` is a square mod `q`. -/
 lemma exists_sq_eq_prime_iff_of_mod_four_eq_one (hp1 : p % 4 = 1) (hq1 : q ≠ 2) :
   is_square (q : zmod p) ↔ is_square (p : zmod q) :=
-if hpq : p = q then by substI hpq else
-have h1 : ((p / 2) * (q / 2)) % 2 = 0,
-  from (dvd_iff_mod_eq_zero _ _).1
-    (dvd_mul_of_dvd_left ((dvd_iff_mod_eq_zero _ _).2 $
-    by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp1]; refl) _),
 begin
-  have hp_odd : p ≠ 2 := by { by_contra, simp [h] at hp1, norm_num at hp1, },
-  have hpq0 : ((p : ℤ) : zmod q) ≠ 0 := prime_ne_zero q p (ne.symm hpq),
-  have hqp0 : ((q : ℤ) : zmod p) ≠ 0 := prime_ne_zero p q hpq,
-  have := quadratic_reciprocity p q hp_odd hq1 hpq,
-  rw [neg_one_pow_eq_pow_mod_two, h1, pow_zero] at this,
-  rw [(by norm_cast : (p : zmod q) = (p : ℤ)), (by norm_cast : (q : zmod p) = (q : ℤ)),
-       ← legendre_sym_eq_one_iff _ hpq0, ← legendre_sym_eq_one_iff _ hqp0],
-  cases (legendre_sym_eq_one_or_neg_one p q hqp0) with h h,
-  { simp only [h, eq_self_iff_true, true_iff, mul_one] at this ⊢,
-    exact this, },
-  { simp only [h, mul_neg, mul_one] at this ⊢,
-    rw eq_neg_of_eq_neg this.symm, },
+  cases eq_or_ne p q with h h,
+  { substI p },
+  { rw [← eq_one_iff' p (prime_ne_zero p q h), ← eq_one_iff' q (prime_ne_zero q p h.symm),
+        quadratic_reciprocity_one_mod_four hp1 hq1], }
 end
 
-lemma exists_sq_eq_prime_iff_of_mod_four_eq_three (hp3 : p % 4 = 3)
-  (hq3 : q % 4 = 3) (hpq : p ≠ q) : is_square (q : zmod p) ↔ ¬ is_square (p : zmod q) :=
-have h1 : ((p / 2) * (q / 2)) % 2 = 1,
-  from nat.odd_mul_odd
-    (by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hp3]; refl)
-    (by rw [← mod_mul_right_div_self, show 2 * 2 = 4, from rfl, hq3]; refl),
-begin
-  have hp_odd : p ≠ 2 := by { by_contra, simp [h] at hp3, norm_num at hp3, },
-  have hq_odd : q ≠ 2 := by { by_contra, simp [h] at hq3, norm_num at hq3, },
-  have hpq0 : ((p : ℤ) : zmod q) ≠ 0 := prime_ne_zero q p (ne.symm hpq),
-  have hqp0 : ((q : ℤ) : zmod p) ≠ 0 := prime_ne_zero p q hpq,
-  have := quadratic_reciprocity p q hp_odd hq_odd hpq,
-  rw [neg_one_pow_eq_pow_mod_two, h1, pow_one] at this,
-  rw [(by norm_cast : (p : zmod q) = (p : ℤ)), (by norm_cast : (q : zmod p) = (q : ℤ)),
-       ← legendre_sym_eq_one_iff _ hpq0, ← legendre_sym_eq_one_iff _ hqp0],
-  cases (legendre_sym_eq_one_or_neg_one q p hpq0) with h h,
-  { simp only [h, eq_self_iff_true, not_true, iff_false, one_mul] at this ⊢,
-    simp only [this],
-    norm_num, },
-  { simp only [h, neg_mul, one_mul, neg_inj] at this ⊢,
-    simp only [this, eq_self_iff_true, true_iff],
-    norm_num, },
-end
+/-- If `p` and `q` are distinct primes that are both congruent to `3` mod `4`, then `q` is
+a square mod `p` iff `p` is a nonsquare mod `q`. -/
+lemma exists_sq_eq_prime_iff_of_mod_four_eq_three (hp3 : p % 4 = 3) (hq3 : q % 4 = 3)
+  (hpq : p ≠ q) :
+  is_square (q : zmod p) ↔ ¬ is_square (p : zmod q) :=
+by rw [← eq_one_iff' p (prime_ne_zero p q hpq), ← eq_neg_one_iff' q,
+       quadratic_reciprocity_three_mod_four hp3 hq3, neg_inj]
 
 end zmod
+
+end reciprocity
diff --git a/src/number_theory/legendre_symbol/zmod_char.lean b/src/number_theory/legendre_symbol/zmod_char.lean
new file mode 100644
index 0000000000000..5921d6bbd543d
--- /dev/null
+++ b/src/number_theory/legendre_symbol/zmod_char.lean
@@ -0,0 +1,173 @@
+/-
+Copyright (c) 2022 Michael Stoll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michael Stoll
+-/
+import data.int.range
+import data.zmod.basic
+import number_theory.legendre_symbol.mul_character
+
+/-!
+# Quadratic characters on ℤ/nℤ
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines some quadratic characters on the rings ℤ/4ℤ and ℤ/8ℤ.
+
+We set them up to be of type `mul_char (zmod n) ℤ`, where `n` is `4` or `8`.
+
+## Tags
+
+quadratic character, zmod
+-/
+
+/-!
+### Quadratic characters mod 4 and 8
+
+We define the primitive quadratic characters `χ₄`on `zmod 4`
+and `χ₈`, `χ₈'` on `zmod 8`.
+-/
+
+namespace zmod
+
+section quad_char_mod_p
+
+/-- Define the nontrivial quadratic character on `zmod 4`, `χ₄`.
+It corresponds to the extension `ℚ(√-1)/ℚ`. -/
+@[simps] def χ₄ : mul_char (zmod 4) ℤ :=
+{ to_fun := (![0,1,0,-1] : (zmod 4 → ℤ)),
+  map_one' := rfl, map_mul' := dec_trivial, map_nonunit' := dec_trivial }
+
+/-- `χ₄` takes values in `{0, 1, -1}` -/
+lemma is_quadratic_χ₄ : χ₄.is_quadratic := by { intro a, dec_trivial!, }
+
+/-- The value of `χ₄ n`, for `n : ℕ`, depends only on `n % 4`. -/
+lemma χ₄_nat_mod_four (n : ℕ) : χ₄ n = χ₄ (n % 4 : ℕ) :=
+by rw ← zmod.nat_cast_mod n 4
+
+/-- The value of `χ₄ n`, for `n : ℤ`, depends only on `n % 4`. -/
+lemma χ₄_int_mod_four (n : ℤ) : χ₄ n = χ₄ (n % 4 : ℤ) :=
+by { rw ← zmod.int_cast_mod n 4, norm_cast, }
+
+/-- An explicit description of `χ₄` on integers / naturals -/
+lemma χ₄_int_eq_if_mod_four (n : ℤ) : χ₄ n = if n % 2 = 0 then 0 else if n % 4 = 1 then 1 else -1 :=
+begin
+  have help : ∀ (m : ℤ), 0 ≤ m → m < 4 → χ₄ m = if m % 2 = 0 then 0 else if m = 1 then 1 else -1 :=
+  dec_trivial,
+  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 4), ← zmod.int_cast_mod n 4],
+  exact help (n % 4) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
+end
+
+lemma χ₄_nat_eq_if_mod_four (n : ℕ) : χ₄ n = if n % 2 = 0 then 0 else if n % 4 = 1 then 1 else -1 :=
+by exact_mod_cast χ₄_int_eq_if_mod_four n
+
+/-- Alternative description of `χ₄ n` for odd `n : ℕ` in terms of powers of `-1` -/
+lemma χ₄_eq_neg_one_pow {n : ℕ} (hn : n % 2 = 1) : χ₄ n = (-1)^(n / 2) :=
+begin
+  rw χ₄_nat_eq_if_mod_four,
+  simp only [hn, nat.one_ne_zero, if_false],
+  nth_rewrite 0 ← nat.div_add_mod n 4,
+  nth_rewrite 0 (by norm_num : 4 = 2 * 2),
+  rw [mul_assoc, add_comm, nat.add_mul_div_left _ _ (by norm_num : 0 < 2),
+      pow_add, pow_mul, neg_one_sq, one_pow, mul_one],
+  have help : ∀ m : ℕ, m < 4 → m % 2 = 1 → ite (m = 1) (1 : ℤ) (-1) = (-1) ^ (m / 2) :=
+  dec_trivial,
+  exact help (n % 4) (nat.mod_lt n (by norm_num))
+    ((nat.mod_mod_of_dvd n (by norm_num : 2 ∣ 4)).trans hn),
+end
+
+/-- If `n % 4 = 1`, then `χ₄ n = 1`. -/
+lemma χ₄_nat_one_mod_four {n : ℕ} (hn : n % 4 = 1) : χ₄ n = 1 :=
+by { rw [χ₄_nat_mod_four, hn], refl }
+
+/-- If `n % 4 = 3`, then `χ₄ n = -1`. -/
+lemma χ₄_nat_three_mod_four {n : ℕ} (hn : n % 4 = 3) : χ₄ n = -1 :=
+by { rw [χ₄_nat_mod_four, hn], refl }
+
+/-- If `n % 4 = 1`, then `χ₄ n = 1`. -/
+lemma χ₄_int_one_mod_four {n : ℤ} (hn : n % 4 = 1) : χ₄ n = 1 :=
+by { rw [χ₄_int_mod_four, hn], refl }
+
+/-- If `n % 4 = 3`, then `χ₄ n = -1`. -/
+lemma χ₄_int_three_mod_four {n : ℤ} (hn : n % 4 = 3) : χ₄ n = -1 :=
+by { rw [χ₄_int_mod_four, hn], refl }
+
+/-- If `n % 4 = 1`, then `(-1)^(n/2) = 1`. -/
+lemma _root_.neg_one_pow_div_two_of_one_mod_four {n : ℕ} (hn : n % 4 = 1) :
+  (-1 : ℤ) ^ (n / 2) = 1 :=
+by { rw [← χ₄_eq_neg_one_pow (nat.odd_of_mod_four_eq_one hn), ← nat_cast_mod, hn], refl }
+
+/-- If `n % 4 = 3`, then `(-1)^(n/2) = -1`. -/
+lemma _root_.neg_one_pow_div_two_of_three_mod_four {n : ℕ} (hn : n % 4 = 3) :
+  (-1 : ℤ) ^ (n / 2) = -1 :=
+by { rw [← χ₄_eq_neg_one_pow (nat.odd_of_mod_four_eq_three hn), ← nat_cast_mod, hn], refl }
+
+/-- Define the first primitive quadratic character on `zmod 8`, `χ₈`.
+It corresponds to the extension `ℚ(√2)/ℚ`. -/
+@[simps] def χ₈ : mul_char (zmod 8) ℤ :=
+{ to_fun := (![0,1,0,-1,0,-1,0,1] : (zmod 8 → ℤ)),
+  map_one' := rfl, map_mul' := dec_trivial, map_nonunit' := dec_trivial }
+
+/-- `χ₈` takes values in `{0, 1, -1}` -/
+lemma is_quadratic_χ₈ : χ₈.is_quadratic := by { intro a, dec_trivial!, }
+
+/-- The value of `χ₈ n`, for `n : ℕ`, depends only on `n % 8`. -/
+lemma χ₈_nat_mod_eight (n : ℕ) : χ₈ n = χ₈ (n % 8 : ℕ) :=
+by rw ← zmod.nat_cast_mod n 8
+
+/-- The value of `χ₈ n`, for `n : ℤ`, depends only on `n % 8`. -/
+lemma χ₈_int_mod_eight (n : ℤ) : χ₈ n = χ₈ (n % 8 : ℤ) :=
+by { rw ← zmod.int_cast_mod n 8, norm_cast, }
+
+/-- An explicit description of `χ₈` on integers / naturals -/
+lemma χ₈_int_eq_if_mod_eight (n : ℤ) :
+  χ₈ n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 7 then 1 else -1 :=
+begin
+  have help : ∀ (m : ℤ), 0 ≤ m → m < 8 → χ₈ m = if m % 2 = 0 then 0
+                                                else if m = 1 ∨ m = 7 then 1 else -1 :=
+  dec_trivial,
+  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 8), ← zmod.int_cast_mod n 8],
+  exact help (n % 8) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
+end
+
+lemma χ₈_nat_eq_if_mod_eight (n : ℕ) :
+  χ₈ n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 7 then 1 else -1 :=
+by exact_mod_cast χ₈_int_eq_if_mod_eight n
+
+/-- Define the second primitive quadratic character on `zmod 8`, `χ₈'`.
+It corresponds to the extension `ℚ(√-2)/ℚ`. -/
+@[simps] def χ₈' : mul_char (zmod 8) ℤ :=
+{ to_fun := (![0,1,0,1,0,-1,0,-1] : (zmod 8 → ℤ)),
+  map_one' := rfl, map_mul' := dec_trivial, map_nonunit' := dec_trivial }
+
+/-- `χ₈'` takes values in `{0, 1, -1}` -/
+lemma is_quadratic_χ₈' : χ₈'.is_quadratic := by { intro a, dec_trivial!, }
+
+/-- An explicit description of `χ₈'` on integers / naturals -/
+lemma χ₈'_int_eq_if_mod_eight (n : ℤ) :
+  χ₈' n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 3 then 1 else -1 :=
+begin
+  have help : ∀ (m : ℤ), 0 ≤ m → m < 8 → χ₈' m = if m % 2 = 0 then 0
+                                                 else if m = 1 ∨ m = 3 then 1 else -1 :=
+  dec_trivial,
+  rw [← int.mod_mod_of_dvd n (by norm_num : (2 : ℤ) ∣ 8), ← zmod.int_cast_mod n 8],
+  exact help (n % 8) (int.mod_nonneg n (by norm_num)) (int.mod_lt n (by norm_num)),
+end
+
+lemma χ₈'_nat_eq_if_mod_eight (n : ℕ) :
+  χ₈' n = if n % 2 = 0 then 0 else if n % 8 = 1 ∨ n % 8 = 3 then 1 else -1 :=
+by exact_mod_cast χ₈'_int_eq_if_mod_eight n
+
+/-- The relation between `χ₄`, `χ₈` and `χ₈'` -/
+lemma χ₈'_eq_χ₄_mul_χ₈ (a : zmod 8) : χ₈' a = χ₄ a * χ₈ a := by dec_trivial!
+
+lemma χ₈'_int_eq_χ₄_mul_χ₈ (a : ℤ) : χ₈' a = χ₄ a * χ₈ a :=
+begin
+  rw ← @cast_int_cast 8 (zmod 4) _ 4 _ (by norm_num) a,
+  exact χ₈'_eq_χ₄_mul_χ₈ a,
+end
+
+end quad_char_mod_p
+
+end zmod
diff --git a/src/number_theory/liouville/basic.lean b/src/number_theory/liouville/basic.lean
index c58cfb8886f4c..2f52313ceaa08 100644
--- a/src/number_theory/liouville/basic.lean
+++ b/src/number_theory/liouville/basic.lean
@@ -10,6 +10,9 @@ import data.real.irrational
 
 # Liouville's theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains a proof of Liouville's theorem stating that all Liouville numbers are
 transcendental.
 
@@ -29,12 +32,12 @@ def liouville (x : ℝ) := ∀ n : ℕ, ∃ a b : ℤ, 1 < b ∧ x ≠ a / b ∧
 
 namespace liouville
 
-@[protected] lemma irrational {x : ℝ} (h : liouville x) : irrational x :=
+protected lemma irrational {x : ℝ} (h : liouville x) : irrational x :=
 begin
   -- By contradiction, `x = a / b`, with `a ∈ ℤ`, `0 < b ∈ ℕ` is a Liouville number,
   rintros ⟨⟨a, b, bN0, cop⟩, rfl⟩,
   -- clear up the mess of constructions of rationals
-  change (liouville (a / b)) at h,
+  rw [rat.cast_mk', ←div_eq_mul_inv] at h,
   -- Since `a / b` is a Liouville number, there are `p, q ∈ ℤ`, with `q1 : 1 < q`,
   -- `a0 : a / b ≠ p / q` and `a1 : |a / b - p / q| < 1 / q ^ (b + 1)`
   rcases h (b + 1) with ⟨p, q, q1, a0, a1⟩,
@@ -69,6 +72,7 @@ begin
 end
 
 open polynomial metric set real ring_hom
+open_locale polynomial
 
 /-- Let `Z, N` be types, let `R` be a metric space, let `α : R` be a point and let
 `j : Z → N → R` be a function.  We aim to estimate how close we can get to `α`, while staying
@@ -117,12 +121,12 @@ begin
 end
 
 lemma exists_pos_real_of_irrational_root {α : ℝ} (ha : irrational α)
-  {f : polynomial ℤ} (f0 : f ≠ 0) (fa : eval α (map (algebra_map ℤ ℝ) f) = 0):
+  {f : ℤ[X]} (f0 : f ≠ 0) (fa : eval α (map (algebra_map ℤ ℝ) f) = 0):
   ∃ A : ℝ, 0 < A ∧
     ∀ (a : ℤ), ∀ (b : ℕ), (1 : ℝ) ≤ (b + 1) ^ f.nat_degree * (|α - (a / (b + 1))| * A) :=
 begin
   -- `fR` is `f` viewed as a polynomial with `ℝ` coefficients.
-  set fR : polynomial ℝ := map (algebra_map ℤ ℝ) f,
+  set fR : ℝ[X] := map (algebra_map ℤ ℝ) f,
   -- `fR` is non-zero, since `f` is non-zero.
   obtain fR0 : fR ≠ 0 := λ fR0, (map_injective (algebra_map ℤ ℝ) (λ _ _ A, int.cast_inj.mp A)).ne
     f0 (fR0.trans (polynomial.map_zero _).symm),
@@ -154,6 +158,7 @@ begin
   -- 3: the weird inequality of Liouville type with powers of the denominators.
   { show 1 ≤ (a + 1 : ℝ) ^ f.nat_degree * |eval α fR - eval (z / (a + 1)) fR|,
     rw [fa, zero_sub, abs_neg],
+    rw [show (a + 1 : ℝ) = ((a + 1 : ℕ) : ℤ), by norm_cast] at hq ⊢,
     -- key observation: the right-hand side of the inequality is an *integer*.  Therefore,
     -- if its absolute value is not at least one, then it vanishes.  Proceed by contradiction
     refine one_le_pow_mul_abs_eval_div (int.coe_nat_succ_pos a) (λ hy, _),
@@ -167,18 +172,18 @@ begin
 end
 
 /-- **Liouville's Theorem** -/
-theorem transcendental {x : ℝ} (lx : liouville x) :
+protected theorem transcendental {x : ℝ} (lx : liouville x) :
   transcendental ℤ x :=
 begin
   -- Proceed by contradiction: if `x` is algebraic, then `x` is the root (`ef0`) of a
   -- non-zero (`f0`) polynomial `f`
-  rintros ⟨f : polynomial ℤ, f0, ef0⟩,
+  rintros ⟨f : ℤ[X], f0, ef0⟩,
   -- Change `aeval x f = 0` to `eval (map _ f) = 0`, who knew.
   replace ef0 : (f.map (algebra_map ℤ ℝ)).eval x = 0, { rwa [aeval_def, ← eval_map] at ef0 },
   -- There is a "large" real number `A` such that `(b + 1) ^ (deg f) * |f (x - a / (b + 1))| * A`
   -- is at least one.  This is obtained from lemma `exists_pos_real_of_irrational_root`.
   obtain ⟨A, hA, h⟩ : ∃ (A : ℝ), 0 < A ∧
-    ∀ (a : ℤ) (b : ℕ), (1 : ℝ) ≤ (b.succ) ^ f.nat_degree * (|x - a / (b.succ)| * A) :=
+    ∀ (a : ℤ) (b : ℕ), (1 : ℝ) ≤ (b + 1) ^ f.nat_degree * (|x - a / (b + 1)| * A) :=
     exists_pos_real_of_irrational_root lx.irrational f0 ef0,
   -- Since the real numbers are Archimedean, a power of `2` exceeds `A`: `hn : A < 2 ^ r`.
   rcases pow_unbounded_of_one_lt A (lt_add_one 1) with ⟨r, hn⟩,
@@ -204,7 +209,8 @@ begin
   -- at ratios of integers.
   { lift b to ℕ using zero_le_one.trans b1.le,
     specialize h a b.pred,
-    rwa [nat.succ_pred_eq_of_pos (zero_lt_one.trans _), ← mul_assoc, ← (div_le_iff hA)] at h,
+    rwa [← nat.cast_succ, nat.succ_pred_eq_of_pos (zero_lt_one.trans _),
+      ← mul_assoc, ← (div_le_iff hA)] at h,
     exact int.coe_nat_lt.mp b1 }
 end
 
diff --git a/src/number_theory/liouville/liouville_constant.lean b/src/number_theory/liouville/liouville_constant.lean
deleted file mode 100644
index 981d728046b42..0000000000000
--- a/src/number_theory/liouville/liouville_constant.lean
+++ /dev/null
@@ -1,193 +0,0 @@
-/-
-Copyright (c) 2020 Jujian Zhang. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Damiano Testa, Jujian Zhang
--/
-import number_theory.liouville.basic
-/-!
-
-# Liouville constants
-
-This file contains a construction of a family of Liouville numbers, indexed by a natural number $m$.
-The most important property is that they are examples of transcendental real numbers.
-This fact is recorded in `liouville.is_transcendental`.
-
-More precisely, for a real number $m$, Liouville's constant is
-$$
-\sum_{i=0}^\infty\frac{1}{m^{i!}}.
-$$
-The series converges only for $1 < m$.  However, there is no restriction on $m$, since,
-if the series does not converge, then the sum of the series is defined to be zero.
-
-We prove that, for $m \in \mathbb{N}$ satisfying $2 \le m$, Liouville's constant associated to $m$
-is a transcendental number.  Classically, the Liouville number for $m = 2$ is the one called
-``Liouville's constant''.
-
-## Implementation notes
-
-The indexing $m$ is eventually a natural number satisfying $2 ≤ m$.  However, we prove the first few
-lemmas for $m \in \mathbb{R}$.
--/
-
-noncomputable theory
-open_locale nat big_operators
-open real finset
-
-namespace liouville
-
-/--
-For a real number `m`, Liouville's constant is
-$$
-\sum_{i=0}^\infty\frac{1}{m^{i!}}.
-$$
-The series converges only for `1 < m`.  However, there is no restriction on `m`, since,
-if the series does not converge, then the sum of the series is defined to be zero.
--/
-def liouville_number (m : ℝ) : ℝ := ∑' (i : ℕ), 1 / m ^ i!
-
-/--
-`liouville_number_initial_terms` is the sum of the first `k + 1` terms of Liouville's constant,
-i.e.
-$$
-\sum_{i=0}^k\frac{1}{m^{i!}}.
-$$
--/
-def liouville_number_initial_terms (m : ℝ) (k : ℕ) : ℝ := ∑ i in range (k+1), 1 / m ^ i!
-
-/--
-`liouville_number_tail` is the sum of the series of the terms in `liouville_number m`
-starting from `k+1`, i.e
-$$
-\sum_{i=k+1}^\infty\frac{1}{m^{i!}}.
-$$
--/
-def liouville_number_tail (m : ℝ) (k : ℕ) : ℝ := ∑' i, 1 / m ^ (i + (k+1))!
-
-lemma liouville_number_tail_pos {m : ℝ} (hm : 1 < m) (k : ℕ) :
-  0 < liouville_number_tail m k :=
--- replace `0` with the constantly zero series `∑ i : ℕ, 0`
-calc  (0 : ℝ) = ∑' i : ℕ, 0 : tsum_zero.symm
-          ... < liouville_number_tail m k :
-  -- to show that a series with non-negative terms has strictly positive sum it suffices
-  -- to prove that
-  tsum_lt_tsum_of_nonneg
-    -- 1. the terms of the zero series are indeed non-negative
-    (λ _, rfl.le)
-    -- 2. the terms of our series are non-negative
-    (λ i, one_div_nonneg.mpr (pow_nonneg (zero_le_one.trans hm.le) _))
-    -- 3. one term of our series is strictly positive -- they all are, we use the first term
-    (one_div_pos.mpr (pow_pos (zero_lt_one.trans hm) (0 + (k + 1))!)) $
-    -- 4. our series converges -- it does since it is the tail of a converging series, though
-    -- this is not the argument here.
-    summable_one_div_pow_of_le hm (λ i, trans le_self_add (nat.self_le_factorial _))
-
-/--  Split the sum definining a Liouville number into the first `k` term and the rest. -/
-lemma liouville_number_eq_initial_terms_add_tail {m : ℝ} (hm : 1 < m) (k : ℕ) :
-  liouville_number m = liouville_number_initial_terms m k +
-  liouville_number_tail m k :=
-(sum_add_tsum_nat_add _ (summable_one_div_pow_of_le hm (λ i, i.self_le_factorial))).symm
-
-/-! We now prove two useful inequalities, before collecting everything together. -/
-
-/--  Partial inequality, works with `m ∈ ℝ` satisfying `1 < m`. -/
-lemma tsum_one_div_pow_factorial_lt (n : ℕ) {m : ℝ} (m1 : 1 < m) :
-  ∑' (i : ℕ), 1 / m ^ (i + (n + 1))! < (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :=
--- two useful inequalities
-have m0 : 0 < m := (zero_lt_one.trans m1),
-have mi : |1 / m| < 1 :=
-  (le_of_eq (abs_of_pos (one_div_pos.mpr m0))).trans_lt ((div_lt_one m0).mpr m1),
-calc (∑' i, 1 / m ^ (i + (n + 1))!)
-    < ∑' i, 1 / m ^ (i + (n + 1)!) :
-    -- to show the strict inequality between these series, we prove that:
-    tsum_lt_tsum_of_nonneg
-      -- 1. the first series has non-negative terms
-      (λ b, one_div_nonneg.mpr (pow_nonneg m0.le _))
-      -- 2. the second series dominates the first
-      (λ b, one_div_pow_le_one_div_pow_of_le m1.le (b.add_factorial_succ_le_factorial_add_succ n))
-      -- 3. the term with index `i = 2` of the first series is strictly smaller than
-      -- the corresponding term of the second series
-      (one_div_pow_strict_anti m1 (n.add_factorial_succ_lt_factorial_add_succ rfl.le))
-      -- 4. the second series is summable, since its terms grow quickly
-      (summable_one_div_pow_of_le m1 (λ j, nat.le.intro rfl))
-... = ∑' i, (1 / m) ^ i * (1 / m ^ (n + 1)!) :
-    -- split the sum in the exponent and massage
-    by { congr, ext i, rw [pow_add, ← div_div_eq_div_mul, div_eq_mul_one_div, ← one_div_pow i] }
--- factor the constant `(1 / m ^ (n + 1)!)` out of the series
-... = (∑' i, (1 / m) ^ i) * (1 / m ^ (n + 1)!) : tsum_mul_right
-... = (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :
-    -- the series if the geometric series
-    mul_eq_mul_right_iff.mpr (or.inl (tsum_geometric_of_abs_lt_1 mi))
-
-lemma aux_calc (n : ℕ) {m : ℝ} (hm : 2 ≤ m) :
-  (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 1 / (m ^ n!) ^ n :=
-calc (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 2 * (1 / m ^ (n + 1)!) :
-  -- the second factors coincide (and are non-negative),
-  -- the first factors, satisfy the inequality `sub_one_div_inv_le_two`
-  mul_mono_nonneg (one_div_nonneg.mpr (pow_nonneg (zero_le_two.trans hm) _))
-    (sub_one_div_inv_le_two hm)
-... = 2 / m ^ (n + 1)! : mul_one_div 2 _
-... = 2 / m ^ (n! * (n + 1)) : congr_arg ((/) 2) (congr_arg (pow m) (mul_comm _ _))
-... ≤ 1 / m ^ (n! * n) :
-  begin
-    -- [ NB: in this block, I do not follow the brace convention for subgoals -- I wait until
-    --   I solve all extraneous goals at once with `exact pow_pos (zero_lt_two.trans_le hm) _`. ]
-    -- Clear denominators and massage*
-    apply (div_le_div_iff _ _).mpr,
-    conv_rhs { rw [one_mul, mul_add, pow_add, mul_one, pow_mul, mul_comm, ← pow_mul] },
-    -- the second factors coincide, so we prove the inequality of the first factors*
-    apply (mul_le_mul_right _).mpr,
-    -- solve all the inequalities `0 < m ^ ??`
-    any_goals { exact pow_pos (zero_lt_two.trans_le hm) _ },
-    -- `2 ≤ m ^ n!` is a consequence of monotonicity of exponentiation at `2 ≤ m`.
-    exact trans (trans hm (pow_one _).symm.le) (pow_mono (one_le_two.trans hm) n.factorial_pos)
-  end
-... = 1 / (m ^ n!) ^ n : congr_arg ((/) 1) (pow_mul m n! n)
-
-/-!  Starting from here, we specialize to the case in which `m` is a natural number. -/
-
-/--  The sum of the `k` initial terms of the Liouville number to base `m` is a ratio of natural
-numbers where the denominator is `m ^ k!`. -/
-lemma liouville_number_rat_initial_terms {m : ℕ} (hm : 0 < m) (k : ℕ) :
-∃ p : ℕ, liouville_number_initial_terms m k = p / m ^ k! :=
-begin
-  induction k with k h,
-  { exact ⟨1, by rw [liouville_number_initial_terms, range_one, sum_singleton, nat.cast_one]⟩ },
-  { rcases h with ⟨p_k, h_k⟩,
-    use p_k * (m ^ ((k + 1)! - k!)) + 1,
-    unfold liouville_number_initial_terms at h_k ⊢,
-    rw [sum_range_succ, h_k, div_add_div, div_eq_div_iff, add_mul],
-    { norm_cast,
-      rw [add_mul, one_mul, nat.factorial_succ,
-        show k.succ * k! - k! = (k.succ - 1) * k!, by rw [tsub_mul, one_mul],
-        nat.succ_sub_one, add_mul, one_mul, pow_add],
-      simp [mul_assoc] },
-    refine mul_ne_zero_iff.mpr ⟨_, _⟩,
-    all_goals { exact pow_ne_zero _ (nat.cast_ne_zero.mpr hm.ne.symm) } }
-end
-
-theorem is_liouville {m : ℕ} (hm : 2 ≤ m) :
-  liouville (liouville_number m) :=
-begin
-  -- two useful inequalities
-  have mZ1 : 1 < (m : ℤ), { norm_cast, exact one_lt_two.trans_le hm },
-  have m1 : 1 < (m : ℝ), { norm_cast, exact one_lt_two.trans_le hm },
-  intro n,
-  -- the first `n` terms sum to `p / m ^ k!`
-  rcases liouville_number_rat_initial_terms (zero_lt_two.trans_le hm) n with ⟨p, hp⟩,
-  refine ⟨p, m ^ n!, one_lt_pow mZ1 n.factorial_ne_zero, _⟩,
-  push_cast,
-  -- separate out the sum of the first `n` terms and the rest
-  rw [liouville_number_eq_initial_terms_add_tail m1 n,
-    ← hp, add_sub_cancel', abs_of_nonneg (liouville_number_tail_pos m1 _).le],
-  exact ⟨((lt_add_iff_pos_right _).mpr (liouville_number_tail_pos m1 n)).ne.symm,
-    (tsum_one_div_pow_factorial_lt n m1).trans_le
-    (aux_calc _ (nat.cast_two.symm.le.trans (nat.cast_le.mpr hm)))⟩
-end
-
-/- Placing this lemma outside of the `open/closed liouville`-namespace would allow to remove
-`_root_.`, at the cost of some other small weirdness. -/
-lemma is_transcendental {m : ℕ} (hm : 2 ≤ m) :
-  _root_.transcendental ℤ (liouville_number m) :=
-transcendental (is_liouville hm)
-
-end liouville
diff --git a/src/number_theory/liouville/liouville_number.lean b/src/number_theory/liouville/liouville_number.lean
new file mode 100644
index 0000000000000..5af7ad7379eae
--- /dev/null
+++ b/src/number_theory/liouville/liouville_number.lean
@@ -0,0 +1,196 @@
+/-
+Copyright (c) 2020 Jujian Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Damiano Testa, Jujian Zhang
+-/
+import number_theory.liouville.basic
+/-!
+
+# Liouville constants
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains a construction of a family of Liouville numbers, indexed by a natural number $m$.
+The most important property is that they are examples of transcendental real numbers.
+This fact is recorded in `transcendental_liouville_number`.
+
+More precisely, for a real number $m$, Liouville's constant is
+$$
+\sum_{i=0}^\infty\frac{1}{m^{i!}}.
+$$
+The series converges only for $1 < m$.  However, there is no restriction on $m$, since,
+if the series does not converge, then the sum of the series is defined to be zero.
+
+We prove that, for $m \in \mathbb{N}$ satisfying $2 \le m$, Liouville's constant associated to $m$
+is a transcendental number.  Classically, the Liouville number for $m = 2$ is the one called
+``Liouville's constant''.
+
+## Implementation notes
+
+The indexing $m$ is eventually a natural number satisfying $2 ≤ m$.  However, we prove the first few
+lemmas for $m \in \mathbb{R}$.
+-/
+
+noncomputable theory
+open_locale nat big_operators
+open real finset
+
+/--
+For a real number `m`, Liouville's constant is
+$$
+\sum_{i=0}^\infty\frac{1}{m^{i!}}.
+$$
+The series converges only for `1 < m`.  However, there is no restriction on `m`, since,
+if the series does not converge, then the sum of the series is defined to be zero.
+-/
+def liouville_number (m : ℝ) : ℝ := ∑' (i : ℕ), 1 / m ^ i!
+
+namespace liouville_number
+
+/--
+`liouville_number.partial_sum` is the sum of the first `k + 1` terms of Liouville's constant,
+i.e.
+$$
+\sum_{i=0}^k\frac{1}{m^{i!}}.
+$$
+-/
+def partial_sum (m : ℝ) (k : ℕ) : ℝ := ∑ i in range (k+1), 1 / m ^ i!
+
+/--
+`liouville_number.remainder` is the sum of the series of the terms in `liouville_number m`
+starting from `k+1`, i.e
+$$
+\sum_{i=k+1}^\infty\frac{1}{m^{i!}}.
+$$
+-/
+def remainder (m : ℝ) (k : ℕ) : ℝ := ∑' i, 1 / m ^ (i + (k+1))!
+
+/-!
+We start with simple observations.
+-/
+
+protected lemma summable {m : ℝ} (hm : 1 < m) : summable (λ i : ℕ, 1 / m ^ i!) :=
+summable_one_div_pow_of_le hm nat.self_le_factorial
+
+lemma remainder_summable {m : ℝ} (hm : 1 < m) (k : ℕ) :
+  summable (λ i : ℕ, 1 / m ^ (i + (k + 1))!) :=
+by convert (summable_nat_add_iff (k + 1)).2 (liouville_number.summable hm)
+
+lemma remainder_pos {m : ℝ} (hm : 1 < m) (k : ℕ) : 0 < remainder m k :=
+tsum_pos (remainder_summable hm k) (λ _, by positivity) 0 (by positivity)
+
+lemma partial_sum_succ (m : ℝ) (n : ℕ) :
+  partial_sum m (n + 1) = partial_sum m n + 1 / m ^ (n + 1)! :=
+sum_range_succ _ _
+
+/--  Split the sum definining a Liouville number into the first `k` term and the rest. -/
+lemma partial_sum_add_remainder {m : ℝ} (hm : 1 < m) (k : ℕ) :
+  partial_sum m k + remainder m k = liouville_number m  :=
+sum_add_tsum_nat_add _ (liouville_number.summable hm)
+
+/-! We now prove two useful inequalities, before collecting everything together. -/
+
+/--  An upper estimate on the remainder. This estimate works with `m ∈ ℝ` satisfying `1 < m` and is
+stronger than the estimate `liouville_number.remainder_lt` below. However, the latter estimate is
+more useful for the proof. -/
+lemma remainder_lt' (n : ℕ) {m : ℝ} (m1 : 1 < m) :
+  remainder m n < (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :=
+-- two useful inequalities
+have m0 : 0 < m := zero_lt_one.trans m1,
+have mi : 1 / m < 1 := (div_lt_one m0).mpr m1,
+calc (∑' i, 1 / m ^ (i + (n + 1))!)
+    < ∑' i, 1 / m ^ (i + (n + 1)!) :
+    -- to show the strict inequality between these series, we prove that:
+    tsum_lt_tsum
+      -- 1. the second series dominates the first
+      (λ b, one_div_pow_le_one_div_pow_of_le m1.le (b.add_factorial_succ_le_factorial_add_succ n))
+      -- 2. the term with index `i = 2` of the first series is strictly smaller than
+      -- the corresponding term of the second series
+      (one_div_pow_strict_anti m1 (n.add_factorial_succ_lt_factorial_add_succ le_rfl))
+      -- 3. the first series is summable
+      (remainder_summable m1 n)
+      -- 4. the second series is summable, since its terms grow quickly
+      (summable_one_div_pow_of_le m1 (λ j, le_self_add))
+... = ∑' i : ℕ, (1 / m) ^ i * (1 / m ^ (n + 1)!) :
+    -- split the sum in the exponent and massage
+    by simp only [pow_add, one_div, mul_inv, inv_pow]
+-- factor the constant `(1 / m ^ (n + 1)!)` out of the series
+... = (∑' i, (1 / m) ^ i) * (1 / m ^ (n + 1)!) : tsum_mul_right
+... = (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) :
+    -- the series if the geometric series
+    by rw [tsum_geometric_of_lt_1 (by positivity) mi]
+
+lemma aux_calc (n : ℕ) {m : ℝ} (hm : 2 ≤ m) :
+  (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 1 / (m ^ n!) ^ n :=
+calc (1 - 1 / m)⁻¹ * (1 / m ^ (n + 1)!) ≤ 2 * (1 / m ^ (n + 1)!) :
+  -- the second factors coincide (and are non-negative),
+  -- the first factors, satisfy the inequality `sub_one_div_inv_le_two`
+  mul_le_mul_of_nonneg_right (sub_one_div_inv_le_two hm) (by positivity)
+... = 2 / m ^ (n + 1)! : mul_one_div 2 _
+... = 2 / m ^ (n! * (n + 1)) : congr_arg ((/) 2) (congr_arg (pow m) (mul_comm _ _))
+... ≤ 1 / m ^ (n! * n) :
+  begin
+    -- [ NB: in this block, I do not follow the brace convention for subgoals -- I wait until
+    --   I solve all extraneous goals at once with `exact pow_pos (zero_lt_two.trans_le hm) _`. ]
+    -- Clear denominators and massage*
+    apply (div_le_div_iff _ _).mpr,
+    conv_rhs { rw [one_mul, mul_add, pow_add, mul_one, pow_mul, mul_comm, ← pow_mul] },
+    -- the second factors coincide, so we prove the inequality of the first factors*
+    refine (mul_le_mul_right _).mpr _,
+    -- solve all the inequalities `0 < m ^ ??`
+    any_goals { exact pow_pos (zero_lt_two.trans_le hm) _ },
+    -- `2 ≤ m ^ n!` is a consequence of monotonicity of exponentiation at `2 ≤ m`.
+    exact trans (trans hm (pow_one _).symm.le) (pow_mono (one_le_two.trans hm) n.factorial_pos)
+  end
+... = 1 / (m ^ n!) ^ n : congr_arg ((/) 1) (pow_mul m n! n)
+
+/--  An upper estimate on the remainder. This estimate works with `m ∈ ℝ` satisfying `2 ≤ m` and is
+weaker than the estimate `liouville_number.remainder_lt'` above. However, this estimate is
+more useful for the proof. -/
+lemma remainder_lt (n : ℕ) {m : ℝ} (m2 : 2 ≤  m) :
+  remainder m n < 1 / (m ^ n!) ^ n :=
+(remainder_lt' n $ one_lt_two.trans_le m2).trans_le (aux_calc _ m2)
+
+/-!  Starting from here, we specialize to the case in which `m` is a natural number. -/
+
+/--  The sum of the `k` initial terms of the Liouville number to base `m` is a ratio of natural
+numbers where the denominator is `m ^ k!`. -/
+lemma partial_sum_eq_rat {m : ℕ} (hm : 0 < m) (k : ℕ) :
+  ∃ p : ℕ, partial_sum m k = p / m ^ k! :=
+begin
+  induction k with k h,
+  { exact ⟨1, by rw [partial_sum, range_one, sum_singleton, nat.cast_one]⟩ },
+  { rcases h with ⟨p_k, h_k⟩,
+    use p_k * (m ^ ((k + 1)! - k!)) + 1,
+    rw [partial_sum_succ, h_k, div_add_div, div_eq_div_iff, add_mul],
+    { norm_cast,
+      rw [add_mul, one_mul, nat.factorial_succ, add_mul, one_mul, add_tsub_cancel_right, pow_add],
+      simp [mul_assoc] },
+    all_goals { positivity } }
+end
+
+end liouville_number
+
+open liouville_number
+
+theorem liouville_liouville_number {m : ℕ} (hm : 2 ≤ m) :
+  liouville (liouville_number m) :=
+begin
+  -- two useful inequalities
+  have mZ1 : 1 < (m : ℤ), { norm_cast, exact one_lt_two.trans_le hm },
+  have m1 : 1 < (m : ℝ), { norm_cast, exact one_lt_two.trans_le hm },
+  intro n,
+  -- the first `n` terms sum to `p / m ^ k!`
+  rcases partial_sum_eq_rat (zero_lt_two.trans_le hm) n with ⟨p, hp⟩,
+  refine ⟨p, m ^ n!, one_lt_pow mZ1 n.factorial_ne_zero, _⟩,
+  push_cast,
+  -- separate out the sum of the first `n` terms and the rest
+  rw [← partial_sum_add_remainder m1 n, ← hp],
+  have hpos := remainder_pos m1 n,
+  simpa [abs_of_pos hpos, hpos.ne'] using @remainder_lt n m (by assumption_mod_cast)
+end
+
+lemma transcendental_liouville_number {m : ℕ} (hm : 2 ≤ m) :
+  transcendental ℤ (liouville_number m) :=
+(liouville_liouville_number hm).transcendental
diff --git a/src/number_theory/liouville/liouville_with.lean b/src/number_theory/liouville/liouville_with.lean
index c7b54ebd2040a..f202e4554a99c 100644
--- a/src/number_theory/liouville/liouville_with.lean
+++ b/src/number_theory/liouville/liouville_with.lean
@@ -3,13 +3,16 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import analysis.special_functions.pow
+import analysis.special_functions.pow.asymptotics
 import number_theory.liouville.basic
 import topology.instances.irrational
 
 /-!
 # Liouville numbers with a given exponent
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that a real number `x` is a Liouville number with exponent `p : ℝ` if there exists a real
 number `C` such that for infinitely many denominators `n` there exists a numerator `m` such that
 `x ≠ m / n` and `|x - m / n| < C / n ^ p`. A number is a Liouville number in the sense of
@@ -34,7 +37,7 @@ Liouville number, irrational, irrationality exponent
 -/
 
 open filter metric real set
-open_locale filter topological_space
+open_locale filter topology
 
 /-- We say that a real number `x` is a Liouville number with exponent `p : ℝ` if there exists a real
 number `C` such that for infinitely many denominators `n` there exists a numerator `m` such that
@@ -111,7 +114,7 @@ begin
   refine ⟨r.denom ^ p * (|r| * C), (tendsto_id.nsmul_at_top r.pos).frequently (hC.mono _)⟩,
   rintro n ⟨hn, m, hne, hlt⟩,
   have A : (↑(r.num * m) : ℝ) / ↑(r.denom • id n) = (m / n) * r,
-    by simp [← div_mul_div_comm₀, ← r.cast_def, mul_comm],
+    by simp [← div_mul_div_comm, ← r.cast_def, mul_comm],
   refine ⟨r.num * m, _, _⟩,
   { rw A, simp [hne, hr] },
   { rw [A, ← sub_mul, abs_mul],
@@ -286,9 +289,7 @@ begin
   rcases H with ⟨N, hN⟩,
   have : ∀ b > (1 : ℕ), ∀ᶠ m : ℕ in at_top, ∀ a : ℤ, (1 / b ^ m : ℝ) ≤ |x - a / b|,
   { intros b hb,
-    have hb0' : (b : ℚ) ≠ 0 := (zero_lt_one.trans (nat.one_lt_cast.2 hb)).ne',
     replace hb : (1 : ℝ) < b := nat.one_lt_cast.2 hb,
-    have hb0 : (0 : ℝ) < b := zero_lt_one.trans hb,
     have H : tendsto (λ m, 1 / b ^ m : ℕ → ℝ) at_top (𝓝 0),
     { simp only [one_div],
       exact tendsto_inv_at_top_zero.comp (tendsto_pow_at_top_at_top_of_one_lt hb) },
diff --git a/src/number_theory/liouville/measure.lean b/src/number_theory/liouville/measure.lean
index 1211eae475035..b8fc7040fa943 100644
--- a/src/number_theory/liouville/measure.lean
+++ b/src/number_theory/liouville/measure.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import measure_theory.measure.lebesgue
+import measure_theory.measure.lebesgue.basic
 import number_theory.liouville.residual
 import number_theory.liouville.liouville_with
 import analysis.p_series
@@ -11,6 +11,9 @@ import analysis.p_series
 /-!
 # Volume of the set of Liouville numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that the set of Liouville numbers with exponent (irrationality measure)
 strictly greater than two is a set of Lebesuge measure zero, see
 `volume_Union_set_of_liouville_with`.
@@ -25,7 +28,7 @@ measure. The fact that the filters are disjoint means that two mutually exclusiv
 Liouville number, Lebesgue measure, residual, generic property
 -/
 
-open_locale filter big_operators ennreal topological_space nnreal
+open_locale filter big_operators ennreal topology nnreal
 open filter set metric measure_theory real
 
 lemma set_of_liouville_with_subset_aux :
@@ -38,7 +41,7 @@ begin
   rcases exists_nat_one_div_lt (sub_pos.2 hp) with ⟨n, hn⟩,
   rw lt_sub_iff_add_lt' at hn,
   suffices : ∀ y : ℝ, liouville_with p y → y ∈ Ico (0 : ℝ) 1 →
-    ∃ᶠ b : ℕ in at_top, ∃ a ∈ finset.Icc (0 : ℤ) b, |y - a / b| < 1 / b ^ (2 + 1 / (n + 1) : ℝ),
+    ∃ᶠ b : ℕ in at_top, ∃ a ∈ finset.Icc (0 : ℤ) b, |y - a / b| < 1 / b ^ (2 + 1 / (n + 1 : ℕ) : ℝ),
   { simp only [mem_Union, mem_preimage],
     have hx : x + ↑(-⌊x⌋) ∈ Ico (0 : ℝ) 1,
     { simp only [int.floor_le, int.lt_floor_add_one, add_neg_lt_iff_le_add', zero_add, and_self,
@@ -47,14 +50,14 @@ begin
   clear hxp x, intros x hxp hx01,
   refine ((hxp.frequently_lt_rpow_neg hn).and_eventually (eventually_ge_at_top 1)).mono _,
   rintro b ⟨⟨a, hne, hlt⟩, hb⟩,
-  rw [rpow_neg b.cast_nonneg, ← one_div] at hlt,
+  rw [rpow_neg b.cast_nonneg, ← one_div, ← nat.cast_succ] at hlt,
   refine ⟨a, _, hlt⟩,
   replace hb : (1 : ℝ) ≤ b, from nat.one_le_cast.2 hb,
   have hb0 : (0 : ℝ) < b := zero_lt_one.trans_le hb,
   replace hlt : |x - a / b| < 1 / b,
   { refine hlt.trans_le (one_div_le_one_div_of_le hb0 _),
     calc (b : ℝ) = b ^ (1 : ℝ) : (rpow_one _).symm
-    ... ≤ b ^ (2 + 1 / (n + 1) : ℝ) : rpow_le_rpow_of_exponent_le hb (one_le_two.trans _),
+    ... ≤ b ^ (2 + 1 / (n + 1 : ℕ) : ℝ) : rpow_le_rpow_of_exponent_le hb (one_le_two.trans _),
     simpa using n.cast_add_one_pos.le },
   rw [sub_div' _ _ _ hb0.ne', abs_div, abs_of_pos hb0, div_lt_div_right hb0,
     abs_sub_lt_iff, sub_lt_iff_lt_add, sub_lt_iff_lt_add, ← sub_lt_iff_lt_add'] at hlt,
@@ -75,16 +78,16 @@ begin
   simp only [← set_of_exists],
   refine measure_mono_null set_of_liouville_with_subset_aux _,
   rw measure_Union_null_iff, intro m, rw measure_preimage_add_right, clear m,
-  refine (measure_bUnion_null_iff $ countable_encodable _).2 (λ n (hn : 1 ≤ n), _),
+  refine (measure_bUnion_null_iff $ to_countable _).2 (λ n (hn : 1 ≤ n), _),
   generalize hr : (2 + 1 / n : ℝ) = r,
   replace hr : 2 < r, by simp [← hr, zero_lt_one.trans_le hn], clear hn n,
   refine measure_set_of_frequently_eq_zero _,
   simp only [set_of_exists, ← real.dist_eq, ← mem_ball, set_of_mem_eq],
   set B : ℤ → ℕ → set ℝ := λ a b, ball (a / b) (1 / b ^ r),
   have hB : ∀ a b, volume (B a b) = ↑(2 / b ^ r : ℝ≥0),
-  { intros a b, simp only [B, real.volume_ball],
-    rw [ennreal.of_real, mul_one_div, to_nnreal_div zero_le_two, to_nnreal_bit0 zero_le_one,
-      to_nnreal_one, to_nnreal_rpow_of_nonneg (nat.cast_nonneg _), nnreal.to_nnreal_coe_nat] },
+  { intros a b,
+    rw [real.volume_ball, mul_one_div, ← nnreal.coe_two, ← nnreal.coe_nat_cast, ← nnreal.coe_rpow,
+      ← nnreal.coe_div, ennreal.of_real_coe_nnreal] },
   have : ∀ b : ℕ, volume (⋃ a ∈ finset.Icc (0 : ℤ) b, B a b) ≤ (2 * (b ^ (1 - r) + b ^ (-r)) : ℝ≥0),
   { intro b,
     calc volume (⋃ a ∈ finset.Icc (0 : ℤ) b, B a b)
diff --git a/src/number_theory/liouville/residual.lean b/src/number_theory/liouville/residual.lean
index 18c376df92c2f..7188ad925b896 100644
--- a/src/number_theory/liouville/residual.lean
+++ b/src/number_theory/liouville/residual.lean
@@ -10,6 +10,9 @@ import topology.instances.irrational
 /-!
 # Density of Liouville numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that the set of Liouville numbers form a dense `Gδ` set. We also prove a
 similar statement about irrational numbers.
 -/
@@ -62,7 +65,7 @@ begin
     refine λ n, ⟨r.num * 2, r.denom * 2, _, _⟩,
     { have := int.coe_nat_le.2 r.pos, rw int.coe_nat_one at this, linarith },
     { convert mem_ball_self _ using 2,
-      { norm_cast, field_simp },
+      { push_cast, norm_cast, norm_num },
       { refine one_div_pos.2 (pow_pos (int.cast_pos.2 _) _),
         exact mul_pos (int.coe_nat_pos.2 r.pos) zero_lt_two } } }
 end
diff --git a/src/number_theory/lucas_lehmer.lean b/src/number_theory/lucas_lehmer.lean
index cbef60a48fff0..f05fc1a16b458 100644
--- a/src/number_theory/lucas_lehmer.lean
+++ b/src/number_theory/lucas_lehmer.lean
@@ -14,6 +14,9 @@ import tactic.ring_exp
 /-!
 # The Lucas-Lehmer test for Mersenne primes.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `lucas_lehmer_residue : Π p : ℕ, zmod (2^p - 1)`, and
 prove `lucas_lehmer_residue p = 0 → prime (mersenne p)`.
 
@@ -94,7 +97,7 @@ end
 lemma s_mod_nonneg (p : ℕ) (w : 0 < p) (i : ℕ) : 0 ≤ s_mod p i :=
 begin
   cases i; dsimp [s_mod],
-  { exact sup_eq_left.mp rfl },
+  { exact sup_eq_right.mp rfl },
   { apply int.mod_nonneg, exact mersenne_int_ne_zero p w },
 end
 
@@ -122,7 +125,7 @@ end
 lemma int.coe_nat_pow_pred (b p : ℕ) (w : 0 < b) : ((b^p - 1 : ℕ) : ℤ) = (b^p - 1 : ℤ) :=
 begin
   have : 1 ≤ b^p := nat.one_le_pow p b w,
-  push_cast [this],
+  norm_cast
 end
 
 lemma int.coe_nat_two_pow_pred (p : ℕ) : ((2^p - 1 : ℕ) : ℤ) = (2^p - 1 : ℤ) :=
@@ -146,9 +149,7 @@ begin
     simp [zmod.int_coe_zmod_eq_zero_iff_dvd] at h,
     apply int.eq_zero_of_dvd_of_nonneg_of_lt _ _ h; clear h,
     apply s_mod_nonneg _ (nat.lt_of_succ_lt w),
-    convert s_mod_lt _ (nat.lt_of_succ_lt w) (p-2),
-    push_cast [nat.one_le_two_pow p],
-    refl, },
+    exact s_mod_lt _ (nat.lt_of_succ_lt w) (p-2) },
   { intro h, rw h, simp, },
 end
 
@@ -162,9 +163,6 @@ def lucas_lehmer_test (p : ℕ) : Prop := lucas_lehmer_residue p = 0
 /-- `q` is defined as the minimum factor of `mersenne p`, bundled as an `ℕ+`. -/
 def q (p : ℕ) : ℕ+ := ⟨nat.min_fac (mersenne p), nat.min_fac_pos (mersenne p)⟩
 
-local attribute [instance]
-lemma fact_pnat_pos (q : ℕ+) : fact (0 < (q : ℕ)) := ⟨q.2⟩
-
 /-- We construct the ring `X q` as ℤ/qℤ + √3 ℤ/qℤ. -/
 -- It would be nice to define this as (ℤ/qℤ)[x] / (x^2 - 3),
 -- obtaining the ring structure for free,
@@ -214,6 +212,15 @@ instance : monoid (X q) :=
   mul_one := λ x, by { ext; simp, },
   ..(infer_instance : has_mul (X q)) }
 
+instance : add_group_with_one (X q) :=
+{ nat_cast := λ n, ⟨n, 0⟩,
+  nat_cast_zero := by simp,
+  nat_cast_succ := by simp [nat.cast, monoid.one],
+  int_cast := λ n, ⟨n, 0⟩,
+  int_cast_of_nat := λ n, by simp; refl,
+  int_cast_neg_succ_of_nat := λ n, by ext; simp; refl,
+  .. X.monoid, .. X.add_comm_group _ }
+
 lemma left_distrib (x y z : X q) : x * (y + z) = x * y + x * z :=
 by { ext; { dsimp, ring }, }
 
@@ -223,6 +230,7 @@ by { ext; { dsimp, ring }, }
 instance : ring (X q) :=
 { left_distrib := left_distrib,
   right_distrib := right_distrib,
+  .. X.add_group_with_one,
   ..(infer_instance : add_comm_group (X q)),
   ..(infer_instance : monoid (X q)) }
 
@@ -233,27 +241,11 @@ instance : comm_ring (X q) :=
 instance [fact (1 < (q : ℕ))] : nontrivial (X q) :=
 ⟨⟨0, 1, λ h, by { injection h with h1 _, exact zero_ne_one h1 } ⟩⟩
 
-@[simp]
-lemma nat_coe_fst (n : ℕ) : (n : X q).fst = (n : zmod q) :=
-begin
-  induction n,
-  { refl, },
-  { dsimp, simp only [add_left_inj], exact n_ih, }
-end
-@[simp]
-lemma nat_coe_snd (n : ℕ) : (n : X q).snd = (0 : zmod q) :=
-begin
-  induction n,
-  { refl, },
-  { dsimp, simp only [add_zero], exact n_ih, }
-end
+@[simp] lemma nat_coe_fst (n : ℕ) : (n : X q).fst = (n : zmod q) := rfl
+@[simp] lemma nat_coe_snd (n : ℕ) : (n : X q).snd = (0 : zmod q) := rfl
 
-@[simp]
-lemma int_coe_fst (n : ℤ) : (n : X q).fst = (n : zmod q) :=
-by { induction n; simp, }
-@[simp]
-lemma int_coe_snd (n : ℤ) : (n : X q).snd = (0 : zmod q) :=
-by { induction n; simp, }
+@[simp] lemma int_coe_fst (n : ℤ) : (n : X q).fst = (n : zmod q) := rfl
+@[simp] lemma int_coe_snd (n : ℤ) : (n : X q).snd = (0 : zmod q) := rfl
 
 @[norm_cast]
 lemma coe_mul (n m : ℤ) : ((n * m : ℤ) : X q) = (n : X q) * (m : X q) :=
@@ -324,7 +316,7 @@ Here and below, we introduce `p' = p - 2`, in order to avoid using subtraction i
 lemma two_lt_q (p' : ℕ) : 2 < q (p'+2) := begin
   by_contradiction H,
   simp at H,
-  interval_cases q (p'+2); clear H,
+  interval_cases q (p'+2), clear H,
   { -- If q = 1, we get a contradiction from 2^p = 2
     dsimp [q] at h, injection h with h', clear h,
     simp [mersenne] at h',
@@ -357,6 +349,7 @@ begin
   rw [mul_comm, coe_mul] at h,
   rw [mul_comm _ (k : X (q (p'+2)))] at h,
   replace h := eq_sub_of_add_eq h,
+  have : 1 ≤ 2 ^ (p' + 2) := nat.one_le_pow _ _ dec_trivial,
   exact_mod_cast h,
 end
 
@@ -396,7 +389,7 @@ theorem order_ω (p' : ℕ) (h : lucas_lehmer_residue (p'+2) = 0) :
   order_of (ω_unit (p'+2)) = 2^(p'+2) :=
 begin
   apply nat.eq_prime_pow_of_dvd_least_prime_pow, -- the order of ω divides 2^p
-  { norm_num, },
+  { exact nat.prime_two, },
   { intro o,
     have ω_pow := order_of_dvd_iff_pow_eq_one.1 o,
     replace ω_pow := congr_arg (units.coe_hom (X (q (p'+2))) :
@@ -445,9 +438,6 @@ example : (mersenne 5).prime := lucas_lehmer_sufficiency 5 (by norm_num) dec_tri
 namespace lucas_lehmer
 open tactic
 
-meta instance nat_pexpr : has_to_pexpr ℕ := ⟨pexpr.of_expr ∘ λ n, reflect n⟩
-meta instance int_pexpr : has_to_pexpr ℤ := ⟨pexpr.of_expr ∘ λ n, reflect n⟩
-
 lemma s_mod_succ {p a i b c}
   (h1 : (2^p - 1 : ℤ) = a)
   (h2 : s_mod p i = b)
@@ -466,16 +456,12 @@ do `(lucas_lehmer_test %%p) ← target,
    p ← eval_expr ℕ p,
    -- Calculate the candidate Mersenne prime
    let M : ℤ := 2^p - 1,
-   t ← to_expr ``(2^%%p - 1 = %%M),
-   v ← to_expr ``(by norm_num : 2^%%p - 1 = %%M),
+   t ← to_expr ``(2^%%`(p) - 1 = %%`(M)),
+   v ← to_expr ``(by norm_num : 2^%%`(p) - 1 = %%`(M)),
    w ← assertv `w t v,
-   -- Unfortunately this creates something like `w : 2^5 - 1 = int.of_nat 31`.
-   -- We could make a better `has_to_pexpr ℤ` instance, or just:
-   `[simp only [int.coe_nat_zero, int.coe_nat_succ,
-       int.of_nat_eq_coe, zero_add, int.coe_nat_bit1] at w],
    -- base case
-   t ← to_expr ``(s_mod %%p 0 = 4),
-   v ← to_expr ``(by norm_num [lucas_lehmer.s_mod] : s_mod %%p 0 = 4),
+   t ← to_expr ``(s_mod %%`(p) 0 = 4),
+   v ← to_expr ``(by norm_num [lucas_lehmer.s_mod] : s_mod %%`(p) 0 = 4),
    h ← assertv `h t v,
    -- step case, repeated p-2 times
    iterate_exactly (p-2) `[replace h := lucas_lehmer.s_mod_succ w h (by { norm_num, refl })],
@@ -499,7 +485,9 @@ is out of reach with the current implementation.
 
 There's still low hanging fruit available to do faster computations
 based on the formula
-  n ≡ (n % 2^p) + (n / 2^p) [MOD 2^p - 1]
+```
+n ≡ (n % 2^p) + (n / 2^p) [MOD 2^p - 1]
+```
 and the fact that `% 2^p` and `/ 2^p` can be very efficient on the binary representation.
 Someone should do this, too!
 -/
diff --git a/src/number_theory/lucas_primality.lean b/src/number_theory/lucas_primality.lean
index b7d0084fffc26..f2b85d805b377 100644
--- a/src/number_theory/lucas_primality.lean
+++ b/src/number_theory/lucas_primality.lean
@@ -7,11 +7,13 @@ import data.fintype.basic
 import group_theory.order_of_element
 import tactic.zify
 import data.nat.totient
-import data.zmod.basic
 
 /-!
 # The Lucas test for primes.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file implements the Lucas test for primes (not to be confused with the Lucas-Lehmer test for
 Mersenne primes). A number `a` witnesses that `n` is prime if `a` has order `n-1` in the
 multiplicative group of integers mod `n`. This is checked by verifying that `a^(n-1) = 1 (mod n)`
@@ -47,7 +49,7 @@ begin
   have order_of_a : order_of a = p-1,
   { apply order_of_eq_of_pow_and_pow_div_prime _ ha hd,
     exact tsub_pos_of_lt hp1, },
-  haveI fhp0 : fact (0 < p) := ⟨h0.bot_lt⟩,
+  haveI : ne_zero p := ⟨h0⟩,
   rw nat.prime_iff_card_units,
   -- Prove cardinality of `units` of `zmod p` is both `≤ p-1` and `≥ p-1`
   refine le_antisymm (nat.card_units_zmod_lt_sub_one hp1) _,
diff --git a/src/number_theory/modular.lean b/src/number_theory/modular.lean
index 7f2d5c9ba7599..01ee6d1c547db 100644
--- a/src/number_theory/modular.lean
+++ b/src/number_theory/modular.lean
@@ -4,13 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Alex Kontorovich, Heather Macbeth, Marc Masdeu
 -/
 
-import analysis.complex.upper_half_plane
+import analysis.complex.upper_half_plane.basic
+import analysis.normed_space.finite_dimension
 import linear_algebra.general_linear_group
-import analysis.matrix
+import linear_algebra.matrix.general_linear_group
 
 /-!
 # The action of the modular group SL(2, ℤ) on the upper half-plane
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the action of `SL(2,ℤ)` on `ℍ` (via restriction of the `SL(2,ℝ)` action in
 `analysis.complex.upper_half_plane`). We then define the standard fundamental domain
 (`modular_group.fd`, `𝒟`) for this action and show
@@ -62,49 +66,20 @@ we state lemmas in this file without spurious `coe_fn` terms. -/
 local attribute [-instance] matrix.special_linear_group.has_coe_to_fun
 local attribute [-instance] matrix.general_linear_group.has_coe_to_fun
 
-open complex (hiding abs_one abs_two abs_mul abs_add)
+open complex (hiding abs_two)
 open matrix (hiding mul_smul) matrix.special_linear_group upper_half_plane
 noncomputable theory
 
 local notation `SL(` n `, ` R `)`:= special_linear_group (fin n) R
 local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) ℤ) _
 
-
 open_locale upper_half_plane complex_conjugate
 
 local attribute [instance] fintype.card_fin_even
 
 namespace modular_group
 
-variables (g : SL(2, ℤ)) (z : ℍ)
-
-section upper_half_plane_action
-
-/-- For a subring `R` of `ℝ`, the action of `SL(2, R)` on the upper half-plane, as a restriction of
-the `SL(2, ℝ)`-action defined by `upper_half_plane.mul_action`. -/
-instance {R : Type*} [comm_ring R] [algebra R ℝ] : mul_action SL(2, R) ℍ :=
-mul_action.comp_hom ℍ (map (algebra_map R ℝ))
-
-lemma coe_smul : ↑(g • z) = num g z / denom g z := rfl
-
-lemma re_smul : (g • z).re = (num g z / denom g z).re := rfl
-
-@[simp] lemma smul_coe : (g : SL(2,ℝ)) • z = g • z := rfl
-
-@[simp] lemma neg_smul : -g • z = g • z :=
-show ↑(-g) • _ = _, by simp [neg_smul g z]
-
-lemma im_smul : (g • z).im = (num g z / denom g z).im := rfl
-
-lemma im_smul_eq_div_norm_sq :
-  (g • z).im = z.im / (complex.norm_sq (denom g z)) :=
-im_smul_eq_div_norm_sq g z
-
-@[simp] lemma denom_apply : denom g z = ↑ₘg 1 0 * z + ↑ₘg 1 1 := by simp
-
-end upper_half_plane_action
-
-variables {g}
+variables {g : SL(2, ℤ)} (z : ℍ)
 
 section bottom_row
 
@@ -124,7 +99,7 @@ lemma bottom_row_surj {R : Type*} [comm_ring R] :
     {cd | is_coprime (cd 0) (cd 1)} :=
 begin
   rintros cd ⟨b₀, a, gcd_eqn⟩,
-  let A := ![![a, -b₀], cd],
+  let A := of ![![a, -b₀], cd],
   have det_A_1 : det A = 1,
   { convert gcd_eqn,
     simp [A, det_fin_two, (by ring : a * (cd 1) + b₀ * (cd 0) = b₀ * (cd 0) + a * (cd 1))] },
@@ -137,7 +112,6 @@ end bottom_row
 section tendsto_lemmas
 
 open filter continuous_linear_map
-local attribute [instance] matrix.normed_group matrix.normed_space
 local attribute [simp] coe_smul
 
 /-- The function `(c,d) → |cz+d|^2` is proper, that is, preimages of bounded-above sets are finite.
@@ -146,6 +120,9 @@ lemma tendsto_norm_sq_coprime_pair :
   filter.tendsto (λ p : fin 2 → ℤ, ((p 0 : ℂ) * z + p 1).norm_sq)
   cofinite at_top :=
 begin
+  -- using this instance rather than the automatic `function.module` makes unification issues in
+  -- `linear_equiv.closed_embedding_of_injective` less bad later in the proof.
+  letI : module ℝ (fin 2 → ℝ) := normed_space.to_module,
   let π₀ : (fin 2 → ℝ) →ₗ[ℝ] ℝ := linear_map.proj 0,
   let π₁ : (fin 2 → ℝ) →ₗ[ℝ] ℝ := linear_map.proj 1,
   let f : (fin 2 → ℝ) →ₗ[ℝ] ℂ := π₀.smul_right (z:ℂ) + π₁.smul_right 1,
@@ -163,7 +140,7 @@ begin
   rw this,
   have hf : f.ker = ⊥,
   { let g : ℂ →ₗ[ℝ] (fin 2 → ℝ) :=
-      linear_map.pi ![im_lm, im_lm.comp ((z:ℂ) • (conj_ae  : ℂ →ₗ[ℝ] ℂ))],
+      linear_map.pi ![im_lm, im_lm.comp ((z:ℂ) • ((conj_ae : ℂ →ₐ[ℝ] ℂ) : ℂ →ₗ[ℝ] ℂ))],
     suffices : ((z:ℂ).im⁻¹ • g).comp f = linear_map.id,
     { exact linear_map.ker_eq_bot_of_inverse this },
     apply linear_map.ext,
@@ -181,15 +158,19 @@ begin
         conj_of_real, conj_of_real, ← of_real_mul, add_im, of_real_im, zero_add,
         inv_mul_eq_iff_eq_mul₀ hz],
       simp only [of_real_im, of_real_re, mul_im, zero_add, mul_zero] } },
-  have h₁ := (linear_equiv.closed_embedding_of_injective hf).tendsto_cocompact,
+  have hf' : closed_embedding f,
+  { -- for some reason we get a timeout if we try and apply this lemma in a more sensible way
+    have := @linear_equiv.closed_embedding_of_injective ℝ _ (fin 2 → ℝ) _ (id _) ℂ _ _ _ _,
+    rotate 2,
+    exact f,
+    exact this hf },
   have h₂ : tendsto (λ p : fin 2 → ℤ, (coe : ℤ → ℝ) ∘ p) cofinite (cocompact _),
   { convert tendsto.pi_map_Coprod (λ i, int.tendsto_coe_cofinite),
     { rw Coprod_cofinite },
     { rw Coprod_cocompact } },
-  exact tendsto_norm_sq_cocompact_at_top.comp (h₁.comp h₂)
+  exact tendsto_norm_sq_cocompact_at_top.comp (hf'.tendsto_cocompact.comp h₂),
 end
 
-
 /-- Given `coprime_pair` `p=(c,d)`, the matrix `[[a,b],[*,*]]` is sent to `a*c+b*d`.
   This is the linear map version of this operation.
 -/
@@ -221,11 +202,11 @@ theorem tendsto_lc_row0 {cd : fin 2 → ℤ} (hcd : is_coprime (cd 0) (cd 1)) :
   tendsto (λ g : {g : SL(2, ℤ) // ↑ₘg 1 = cd}, lc_row0 cd ↑(↑g : SL(2, ℝ)))
     cofinite (cocompact ℝ) :=
 begin
-  let mB : ℝ → (matrix (fin 2) (fin 2)  ℝ) := λ t, ![![t, (-(1:ℤ):ℝ)], coe ∘ cd],
+  let mB : ℝ → (matrix (fin 2) (fin 2) ℝ) := λ t, of ![![t, (-(1:ℤ):ℝ)], coe ∘ cd],
   have hmB : continuous mB,
-  { simp only [continuous_pi_iff, fin.forall_fin_two],
-    have : ∀ c : ℝ, continuous (λ x : ℝ, c) := λ c, continuous_const,
-    exact ⟨⟨continuous_id, @this (-1 : ℤ)⟩, ⟨this (cd 0), this (cd 1)⟩⟩ },
+  { refine continuous_matrix _,
+    simp only [fin.forall_fin_two, mB, continuous_const, continuous_id', of_apply,
+      cons_val_zero, cons_val_one, and_self ] },
   refine filter.tendsto.of_tendsto_comp _ (comap_cocompact_le hmB),
   let f₁ : SL(2, ℤ) → matrix (fin 2) (fin 2) ℝ :=
     λ g, matrix.map (↑g : matrix _ _ ℤ) (coe : ℤ → ℝ),
@@ -246,34 +227,32 @@ begin
       int.coe_cast_ring_hom, lc_row0_apply, function.comp_app, cons_val_zero, lc_row0_extend_apply,
       linear_map.general_linear_group.coe_fn_general_linear_equiv,
       general_linear_group.to_linear_apply, coe_plane_conformal_matrix, neg_neg, mul_vec_lin_apply,
-      cons_val_one, head_cons] },
+      cons_val_one, head_cons, of_apply] },
   { convert congr_arg (λ n : ℤ, (-n:ℝ)) g.det_coe.symm using 1,
     simp only [f₁, mul_vec, dot_product, fin.sum_univ_two, matrix.det_fin_two, function.comp_app,
       subtype.coe_mk, lc_row0_extend_apply, cons_val_zero,
       linear_map.general_linear_group.coe_fn_general_linear_equiv,
       general_linear_group.to_linear_apply, coe_plane_conformal_matrix, mul_vec_lin_apply,
-      cons_val_one, head_cons, map_apply, neg_mul, int.cast_sub, int.cast_mul, neg_sub],
+      cons_val_one, head_cons, map_apply, neg_mul, int.cast_sub, int.cast_mul, neg_sub, of_apply],
     ring },
   { refl }
 end
 
 /-- This replaces `(g•z).re = a/c + *` in the standard theory with the following novel identity:
-
   `g • z = (a c + b d) / (c^2 + d^2) + (d z - c) / ((c^2 + d^2) (c z + d))`
-
   which does not need to be decomposed depending on whether `c = 0`. -/
 lemma smul_eq_lc_row0_add {p : fin 2 → ℤ} (hp : is_coprime (p 0) (p 1)) (hg : ↑ₘg 1 = p) :
   ↑(g • z) = ((lc_row0 p ↑(g : SL(2, ℝ))) : ℂ) / (p 0 ^ 2 + p 1 ^ 2)
     + ((p 1 : ℂ) * z - p 0) / ((p 0 ^ 2 + p 1 ^ 2) * (p 0 * z + p 1)) :=
 begin
   have nonZ1 : (p 0 : ℂ) ^ 2 + (p 1) ^ 2 ≠ 0 := by exact_mod_cast hp.sq_add_sq_ne_zero,
-  have : (coe : ℤ → ℝ) ∘ p ≠ 0 := λ h, hp.ne_zero ((@int.cast_injective ℝ _ _ _).comp_left h),
+  have : (coe : ℤ → ℝ) ∘ p ≠ 0 := λ h, hp.ne_zero (by ext i; simpa using congr_fun h i),
   have nonZ2 : (p 0 : ℂ) * z + p 1 ≠ 0 := by simpa using linear_ne_zero _ z this,
   field_simp [nonZ1, nonZ2, denom_ne_zero, -upper_half_plane.denom, -denom_apply],
   rw (by simp : (p 1 : ℂ) * z - p 0 = ((p 1) * z - p 0) * ↑(det (↑g : matrix (fin 2) (fin 2) ℤ))),
   rw [←hg, det_fin_two],
-  simp only [int.coe_cast_ring_hom, coe_matrix_coe, coe_fn_eq_coe,
-    int.cast_mul, of_real_int_cast, map_apply, denom, int.cast_sub],
+  simp only [int.coe_cast_ring_hom, coe_matrix_coe, int.cast_mul, of_real_int_cast, map_apply,
+  denom, int.cast_sub, _root_.coe_coe,coe_GL_pos_coe_GL_coe_matrix],
   ring,
 end
 
@@ -313,7 +292,8 @@ begin
     filter.tendsto.exists_within_forall_le hs (tendsto_norm_sq_coprime_pair z),
   obtain ⟨g, -, hg⟩ := bottom_row_surj hp_coprime,
   refine ⟨g, λ g', _⟩,
-  rw [im_smul_eq_div_norm_sq, im_smul_eq_div_norm_sq, div_le_div_left],
+  rw [special_linear_group.im_smul_eq_div_norm_sq, special_linear_group.im_smul_eq_div_norm_sq,
+    div_le_div_left],
   { simpa [← hg] using hp (↑ₘg' 1) (bottom_row_coprime g') },
   { exact z.im_pos },
   { exact norm_sq_denom_pos g' z },
@@ -337,36 +317,22 @@ begin
     exact hg ⟨g1, this⟩ },
 end
 
-/-- The matrix `T = [[1,1],[0,1]]` as an element of `SL(2,ℤ)` -/
-def T : SL(2,ℤ) := ⟨![![1, 1], ![0, 1]], by norm_num [matrix.det_fin_two]⟩
-
-/-- The matrix `S = [[0,-1],[1,0]]` as an element of `SL(2,ℤ)` -/
-def S : SL(2,ℤ) := ⟨![![0, -1], ![1, 0]], by norm_num [matrix.det_fin_two]⟩
-
-lemma coe_S : ↑ₘS = ![![0, -1], ![1, 0]] := rfl
+lemma coe_T_zpow_smul_eq {n : ℤ} : (↑((T^n) • z) : ℂ) = z + n :=
+by simp [coe_T_zpow]
 
-lemma coe_T : ↑ₘT = ![![1, 1], ![0, 1]] := rfl
+lemma re_T_zpow_smul (n : ℤ) : ((T^n) • z).re = z.re + n :=
+by rw [←coe_re, coe_T_zpow_smul_eq, add_re, int_cast_re, coe_re]
 
-lemma coe_T_inv : ↑ₘ(T⁻¹) = ![![1, -1], ![0, 1]] := by simp [coe_inv, coe_T, adjugate_fin_two]
+lemma im_T_zpow_smul (n : ℤ) : ((T^n) • z).im = z.im :=
+by rw [←coe_im, coe_T_zpow_smul_eq, add_im, int_cast_im, add_zero, coe_im]
 
-lemma coe_T_zpow (n : ℤ) : ↑ₘ(T ^ n) = ![![1, n], ![0,1]] :=
-begin
-  induction n using int.induction_on with n h n h,
-  { ext i j, fin_cases i; fin_cases j;
-    simp, },
-  { rw [zpow_add, zpow_one, coe_mul, h, coe_T],
-    ext i j, fin_cases i; fin_cases j;
-    simp [matrix.mul_apply, fin.sum_univ_succ, add_comm (1 : ℤ)], },
-  { rw [zpow_sub, zpow_one, coe_mul, h, coe_T_inv],
-    ext i j, fin_cases i; fin_cases j;
-    simp [matrix.mul_apply, fin.sum_univ_succ, neg_add_eq_sub (1 : ℤ)], },
-end
+lemma re_T_smul : (T • z).re = z.re + 1 := by simpa using re_T_zpow_smul z 1
+lemma im_T_smul : (T • z).im = z.im := by simpa using im_T_zpow_smul z 1
+lemma re_T_inv_smul : (T⁻¹ • z).re = z.re - 1 := by simpa using re_T_zpow_smul z (-1)
+lemma im_T_inv_smul : (T⁻¹ • z).im = z.im := by simpa using im_T_zpow_smul z (-1)
 
 variables {z}
 
-@[simp] lemma coe_T_zpow_smul_eq {n : ℤ} : (↑((T^n) • z) : ℂ) = z + n :=
-by simp [coe_T_zpow]
-
 -- If instead we had `g` and `T` of type `PSL(2, ℤ)`, then we could simply state `g = T^n`.
 lemma exists_eq_T_zpow_of_c_eq_zero (hc : ↑ₘg 1 0 = 0) :
   ∃ (n : ℤ), ∀ (z : ℍ), g • z = T^n • z :=
@@ -379,7 +345,7 @@ begin
     ext i j, fin_cases i; fin_cases j;
     simp [ha, hc, hd, coe_T_zpow], },
   { use -↑ₘg 0 1,
-    suffices : g = -T^(-↑ₘg 0 1), { intros z, conv_lhs { rw [this, neg_smul], }, },
+    suffices : g = -T^(-↑ₘg 0 1), { intros z, conv_lhs { rw [this, SL_neg_smul], }, },
     ext i j, fin_cases i; fin_cases j;
     simp [ha, hc, hd, coe_T_zpow], },
 end
@@ -390,8 +356,11 @@ lemma g_eq_of_c_eq_one (hc : ↑ₘg 1 0 = 1) :
 begin
   have hg := g.det_coe.symm,
   replace hg : ↑ₘg 0 1 = ↑ₘg 0 0 * ↑ₘg 1 1 - 1, { rw [det_fin_two, hc] at hg, linarith, },
-  ext i j, fin_cases i; fin_cases j;
-  simp [coe_S, coe_T_zpow, matrix.mul_apply, fin.sum_univ_succ, hg, hc],
+  refine subtype.ext _,
+  conv_lhs { rw matrix.eta_fin_two ↑ₘg },
+  rw [hc, hg],
+  simp only [coe_mul, coe_T_zpow, coe_S, mul_fin_two],
+  congrm !![_, _; _, _]; ring
 end
 
 /-- If `1 < |z|`, then `|S • z| < 1`. -/
@@ -406,7 +375,7 @@ begin
     apply (lt_div_iff z.norm_sq_pos).mpr,
     nlinarith },
   convert this,
-  simp only [im_smul_eq_div_norm_sq],
+  simp only [special_linear_group.im_smul_eq_div_norm_sq],
   field_simp [norm_sq_denom_ne_zero, norm_sq_ne_zero, S]
 end
 
@@ -418,13 +387,13 @@ def fd : set ℍ :=
 def fdo : set ℍ :=
 {z | 1 < (z : ℂ).norm_sq ∧ |z.re| < (1 : ℝ) / 2}
 
-localized "notation `𝒟` := modular_group.fd" in modular
+localized "notation (name := modular_group.fd) `𝒟` := modular_group.fd" in modular
 
-localized "notation `𝒟ᵒ` := modular_group.fdo" in modular
+localized "notation (name := modular_group.fdo) `𝒟ᵒ` := modular_group.fdo" in modular
 
 lemma abs_two_mul_re_lt_one_of_mem_fdo (h : z ∈ 𝒟ᵒ) : |2 * z.re| < 1 :=
 begin
-  rw [abs_mul, abs_two, ← lt_div_iff' (@two_pos ℝ _ _)],
+  rw [abs_mul, abs_two, ← lt_div_iff' (zero_lt_two' ℝ)],
   exact h.2,
 end
 
@@ -451,7 +420,7 @@ begin
   { rwa [← int.cast_abs, ← int.cast_one, int.cast_lt, int.abs_lt_one_iff] at this, },
   have h₁ := hz.2,
   have h₂ := hg.2,
-  rw [← coe_re, coe_T_zpow_smul_eq, add_re, int_cast_re, coe_re] at h₂,
+  rw [re_T_zpow_smul] at h₂,
   calc |(n : ℝ)| ≤ |z.re| + |z.re + (n : ℝ)| : abs_add' (n : ℝ) z.re
              ... < 1/2 + 1/2 : add_lt_add h₁ h₂
              ... = 1 : add_halves 1,
@@ -468,31 +437,26 @@ begin
   -- `g` has same max im property as `g₀`
   have hg₀' : ∀ (g' : SL(2,ℤ)), (g' • z).im ≤ (g • z).im,
   { have hg'' : (g • z).im = (g₀ • z).im,
-    { rw [im_smul_eq_div_norm_sq, im_smul_eq_div_norm_sq, denom_apply, denom_apply, hg] },
+    { rw [special_linear_group.im_smul_eq_div_norm_sq, special_linear_group.im_smul_eq_div_norm_sq,
+      denom_apply, denom_apply, hg]},
     simpa only [hg''] using hg₀ },
   split,
   { -- Claim: `1 ≤ ⇑norm_sq ↑(g • z)`. If not, then `S•g•z` has larger imaginary part
     contrapose! hg₀',
     refine ⟨S * g, _⟩,
-    rw mul_action.mul_smul,
+    rw mul_smul,
     exact im_lt_im_S_smul hg₀' },
   { show |(g • z).re| ≤ 1 / 2, -- if not, then either `T` or `T'` decrease |Re|.
     rw abs_le,
     split,
     { contrapose! hg',
-      refine ⟨T * g, by simp [T, matrix.mul, matrix.dot_product, fin.sum_univ_succ], _⟩,
-      rw mul_action.mul_smul,
-      have : |(g • z).re + 1| < |(g • z).re| :=
-        by cases abs_cases ((g • z).re + 1); cases abs_cases (g • z).re; linarith,
-      convert this,
-      simp [T] },
+      refine ⟨T * g, (T_mul_apply_one _).symm, _⟩,
+      rw [mul_smul, re_T_smul],
+      cases abs_cases ((g • z).re + 1); cases abs_cases (g • z).re; linarith },
     { contrapose! hg',
-      refine ⟨T⁻¹ * g, by simp [coe_T_inv, matrix.mul, matrix.dot_product, fin.sum_univ_succ], _⟩,
-      rw mul_action.mul_smul,
-      have : |(g • z).re - 1| < |(g • z).re| :=
-        by cases abs_cases ((g • z).re - 1); cases abs_cases (g • z).re; linarith,
-      convert this,
-      simp [coe_T_inv, sub_eq_add_neg] } }
+      refine ⟨T⁻¹ * g, (T_inv_mul_apply_one _).symm, _⟩,
+      rw [mul_smul, re_T_inv_smul],
+      cases abs_cases ((g • z).re - 1); cases abs_cases (g • z).re; linarith } }
 end
 
 section unique_representative
@@ -506,9 +470,8 @@ begin
   let c : ℝ := (c' : ℝ),
   suffices : 3 * c^2 < 4,
   { rw [← int.cast_pow, ← int.cast_three, ← int.cast_four, ← int.cast_mul, int.cast_lt] at this,
-    replace this : c'^2 ≤ 1^2, { linarith, },
-    rw ← abs_one,
-    exact abs_le_abs_of_sq_le_sq this, },
+    replace this : c' ^ 2 ≤ 1 ^ 2, { linarith, },
+    rwa [sq_le_sq, abs_one] at this },
   suffices : c ≠ 0 → 9 * c^4 < 16,
   { rcases eq_or_ne c 0 with hc | hc,
     { rw hc, norm_num, },
@@ -524,7 +487,8 @@ begin
       (upper_half_plane.c_mul_im_sq_le_norm_sq_denom z g)) (sq_nonneg _),
   let nsq := norm_sq (denom g z),
   calc 9 * c^4 < c^4 * z.im^2 * (g • z).im^2 * 16 : by linarith
-           ... = c^4 * z.im^4 / nsq^2 * 16 : by { rw [im_smul_eq_div_norm_sq, div_pow], ring, }
+           ... = c^4 * z.im^4 / nsq^2 * 16 : by { rw [special_linear_group.im_smul_eq_div_norm_sq,
+            div_pow], ring, }
            ... ≤ 16 : by { rw ← mul_pow, linarith, },
 end
 
@@ -544,8 +508,8 @@ begin
     linarith, },
   have hn : ↑ₘg 1 0 ≠ -1,
   { intros hc,
-    replace hc : ↑ₘ(-g) 1 0 = 1, { simp [eq_neg_of_eq_neg hc], },
-    replace hg : (-g) • z ∈ 𝒟ᵒ := (neg_smul g z).symm ▸ hg,
+    replace hc : ↑ₘ(-g) 1 0 = 1, { simp [← neg_eq_iff_eq_neg.mpr hc], },
+    replace hg : (-g) • z ∈ 𝒟ᵒ := (SL_neg_smul g z).symm ▸ hg,
     exact hp hg hc, },
   specialize hp hg,
   rcases (int.abs_le_one_iff.mp $ abs_c_le_one hz hg);
@@ -558,7 +522,7 @@ lemma eq_smul_self_of_mem_fdo_mem_fdo (hz : z ∈ 𝒟ᵒ) (hg : g • z ∈ 
 begin
   obtain ⟨n, hn⟩ := exists_eq_T_zpow_of_c_eq_zero (c_eq_zero hz hg),
   rw hn at hg ⊢,
-  simp [eq_zero_of_mem_fdo_of_T_zpow_mem_fdo hz hg],
+  simp [eq_zero_of_mem_fdo_of_T_zpow_mem_fdo hz hg, one_smul],
 end
 
 end unique_representative
diff --git a/src/number_theory/modular_forms/basic.lean b/src/number_theory/modular_forms/basic.lean
new file mode 100644
index 0000000000000..01c52760e61b2
--- /dev/null
+++ b/src/number_theory/modular_forms/basic.lean
@@ -0,0 +1,294 @@
+/-
+Copyright (c) 2022 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck
+-/
+import analysis.complex.upper_half_plane.functions_bounded_at_infty
+import analysis.complex.upper_half_plane.manifold
+import number_theory.modular_forms.slash_invariant_forms
+/-!
+# Modular forms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines modular forms and proves some basic properties about them.
+
+We begin by defining modular forms and cusp forms as extension of `slash_invariant_forms` then we
+define the space of modular forms, cusp forms and prove that the product of two modular forms is a
+modular form.
+-/
+
+open complex upper_half_plane
+
+open_locale topology manifold upper_half_plane
+
+noncomputable theory
+
+local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _
+
+local notation `GL(` n `, ` R `)`⁺ := matrix.GL_pos (fin n) R
+
+local notation `SL(` n `, ` R `)` := matrix.special_linear_group (fin n) R
+
+section modular_form
+
+open modular_form
+
+variables (F : Type*) (Γ : subgroup SL(2, ℤ)) (k : ℤ)
+
+open_locale modular_form
+
+set_option old_structure_cmd true
+
+/--These are `slash_invariant_form`'s that are holomophic and bounded at infinity. -/
+structure modular_form extends slash_invariant_form Γ k :=
+(holo' : mdifferentiable 𝓘(ℂ) 𝓘(ℂ) (to_fun : ℍ → ℂ))
+(bdd_at_infty' : ∀ (A : SL(2, ℤ)), is_bounded_at_im_infty (to_fun ∣[k] A))
+
+/-- The `slash_invariant_form` associated to a `modular_form`. -/
+add_decl_doc modular_form.to_slash_invariant_form
+
+/--These are `slash_invariant_form`s that are holomophic and zero at infinity. -/
+structure cusp_form extends slash_invariant_form Γ k :=
+(holo' : mdifferentiable 𝓘(ℂ) 𝓘(ℂ) (to_fun : ℍ → ℂ))
+(zero_at_infty' : ∀ (A : SL(2, ℤ)), is_zero_at_im_infty (to_fun ∣[k] A))
+
+/-- The `slash_invariant_form` associated to a `cusp_form`. -/
+add_decl_doc cusp_form.to_slash_invariant_form
+
+/--`modular_form_class F Γ k` says that `F` is a type of bundled functions that extend
+`slash_invariant_form_class` by requiring that the functions be holomorphic and bounded
+at infinity. -/
+class modular_form_class extends slash_invariant_form_class F Γ k :=
+(holo: ∀ f : F, mdifferentiable 𝓘(ℂ) 𝓘(ℂ) (f : ℍ → ℂ))
+(bdd_at_infty : ∀ (f : F) (A : SL(2, ℤ)), is_bounded_at_im_infty (f ∣[k] A))
+
+/--`cusp_form_class F Γ k` says that `F` is a type of bundled functions that extend
+`slash_invariant_form_class` by requiring that the functions be holomorphic and zero
+at infinity. -/
+class cusp_form_class extends slash_invariant_form_class F Γ k :=
+(holo: ∀ f : F, mdifferentiable 𝓘(ℂ) 𝓘(ℂ) (f : ℍ → ℂ))
+(zero_at_infty : ∀ (f : F) (A : SL(2, ℤ)), is_zero_at_im_infty (f ∣[k] A))
+
+@[priority 100]
+instance modular_form_class.modular_form : modular_form_class (modular_form Γ k) Γ k :=
+{ coe := modular_form.to_fun,
+  coe_injective' := λ f g h, by cases f; cases g; congr',
+  slash_action_eq := modular_form.slash_action_eq',
+  holo:= modular_form.holo',
+  bdd_at_infty := modular_form.bdd_at_infty' }
+
+@[priority 100]
+instance cusp_form_class.cusp_form : cusp_form_class (cusp_form Γ k) Γ k :=
+{ coe := cusp_form.to_fun,
+  coe_injective' := λ f g h, by cases f; cases g; congr',
+  slash_action_eq := cusp_form.slash_action_eq',
+  holo:= cusp_form.holo',
+  zero_at_infty := cusp_form.zero_at_infty' }
+
+variables {F Γ k}
+
+@[simp] lemma modular_form_to_fun_eq_coe {f : modular_form Γ k} : f.to_fun = (f : ℍ → ℂ) := rfl
+@[simp] lemma cusp_form_to_fun_eq_coe {f : cusp_form Γ k} : f.to_fun = (f : ℍ → ℂ) := rfl
+
+@[ext] theorem modular_form.ext {f g : modular_form Γ k} (h : ∀ x, f x = g x) : f = g :=
+fun_like.ext f g h
+
+@[ext] theorem cusp_form.ext {f g : cusp_form Γ k} (h : ∀ x, f x = g x) : f = g :=
+fun_like.ext f g h
+
+/-- Copy of a `modular_form` with a new `to_fun` equal to the old one. Useful to fix
+definitional equalities. -/
+protected def modular_form.copy (f : modular_form Γ k) (f' : ℍ → ℂ) (h : f' = ⇑f) :
+  modular_form Γ k :=
+{ to_fun := f',
+  slash_action_eq' := h.symm ▸ f.slash_action_eq',
+  holo' := h.symm ▸ f.holo',
+  bdd_at_infty' := λ A, h.symm ▸ f.bdd_at_infty' A }
+
+/-- Copy of a `cusp_form` with a new `to_fun` equal to the old one. Useful to fix
+definitional equalities. -/
+protected def cusp_form.copy (f : cusp_form Γ k) (f' : ℍ → ℂ) (h : f' = ⇑f) :
+  cusp_form Γ k :=
+{ to_fun := f',
+  slash_action_eq' := h.symm ▸ f.slash_action_eq',
+  holo' := h.symm ▸ f.holo',
+  zero_at_infty' := λ A, h.symm ▸ f.zero_at_infty' A }
+
+end modular_form
+
+namespace modular_form
+
+open slash_invariant_form
+
+variables {F : Type*} {Γ : subgroup SL(2, ℤ)} {k : ℤ}
+
+instance has_add : has_add (modular_form Γ k) :=
+⟨ λ f g,
+  { holo' := f.holo'.add g.holo',
+    bdd_at_infty' := λ A, by simpa using (f.bdd_at_infty' A).add (g.bdd_at_infty' A),
+    .. (f : slash_invariant_form Γ k) + g }⟩
+
+@[simp] lemma coe_add (f g : modular_form Γ k) : ⇑(f + g) = f + g := rfl
+
+@[simp] lemma add_apply (f g : modular_form Γ k) (z : ℍ) : (f + g) z = f z + g z := rfl
+
+instance has_zero : has_zero (modular_form Γ k) :=
+⟨ { holo' := (λ _, mdifferentiable_at_const 𝓘(ℂ, ℂ) 𝓘(ℂ, ℂ)),
+    bdd_at_infty' := λ A, by simpa using zero_form_is_bounded_at_im_infty,
+    .. (0 : slash_invariant_form Γ k) } ⟩
+
+@[simp] lemma coe_zero : ⇑(0 : modular_form Γ k) = (0 : ℍ → ℂ) := rfl
+
+@[simp] lemma zero_apply (z : ℍ) : (0 : modular_form Γ k) z = 0 := rfl
+
+section
+variables {α : Type*} [has_smul α ℂ] [is_scalar_tower α ℂ ℂ]
+
+instance has_smul : has_smul α (modular_form Γ k) :=
+⟨ λ c f,
+  { to_fun := c • f,
+    holo' := by simpa using f.holo'.const_smul (c • (1 : ℂ)),
+    bdd_at_infty' := λ A, by simpa using (f.bdd_at_infty' A).const_smul_left (c • (1 : ℂ)),
+     .. c • (f : slash_invariant_form Γ k)}⟩
+
+@[simp] lemma coe_smul (f : (modular_form Γ k)) (n : α) : ⇑(n • f) = n • f := rfl
+@[simp] lemma smul_apply (f : (modular_form Γ k)) (n : α) (z : ℍ) :
+   (n • f) z = n • (f z) := rfl
+end
+
+instance has_neg : has_neg (modular_form Γ k) :=
+⟨λ f,
+  { to_fun := -f,
+    holo' := f.holo'.neg,
+    bdd_at_infty':= λ A, by simpa using (f.bdd_at_infty' A).neg,
+    .. -(f : slash_invariant_form Γ k) }⟩
+
+@[simp] lemma coe_neg (f : modular_form Γ k) : ⇑(-f) = -f := rfl
+
+@[simp] lemma neg_apply (f : modular_form Γ k) (z : ℍ) : (-f) z = - (f z) := rfl
+
+instance has_sub : has_sub (modular_form Γ k) :=
+⟨ λ f g, f + -g ⟩
+
+@[simp] lemma coe_sub (f g : (modular_form Γ k)) : ⇑(f - g) = f - g := rfl
+
+@[simp] lemma sub_apply (f g : modular_form Γ k) (z : ℍ) : (f - g) z = f z - g z := rfl
+
+instance : add_comm_group (modular_form Γ k) :=
+fun_like.coe_injective.add_comm_group _ rfl coe_add coe_neg coe_sub coe_smul coe_smul
+
+/--Additive coercion from `modular_form` to `ℍ → ℂ`. -/
+@[simps] def coe_hom : (modular_form Γ k) →+ (ℍ → ℂ) :=
+{ to_fun := λ f, f,
+  map_zero' := coe_zero,
+  map_add' := λ _ _, rfl }
+
+instance : module ℂ (modular_form Γ k) :=
+function.injective.module ℂ coe_hom fun_like.coe_injective (λ _ _, rfl)
+
+instance : inhabited (modular_form Γ k) := ⟨0⟩
+
+/--The modular form of weight `k_1 + k_2` given by the product of two modular forms of weights
+`k_1` and `k_2`. -/
+def mul {k_1 k_2 : ℤ} {Γ : subgroup SL(2, ℤ)} (f : (modular_form Γ k_1))
+  (g : (modular_form Γ k_2)) : (modular_form Γ (k_1 + k_2)) :=
+{ to_fun := f * g,
+  slash_action_eq' := λ A, by simp_rw [mul_slash_subgroup, modular_form_class.slash_action_eq],
+  holo' := f.holo'.mul g.holo',
+  bdd_at_infty' := λ A, by simpa using (f.bdd_at_infty' A).mul (g.bdd_at_infty' A) }
+
+@[simp] lemma mul_coe {k_1 k_2 : ℤ} {Γ : subgroup SL(2, ℤ)} (f : (modular_form Γ k_1))
+  (g : (modular_form Γ k_2)) : ((f.mul g) : ℍ → ℂ) = f * g := rfl
+
+instance : has_one (modular_form Γ 0) :=
+⟨{  holo' := λ x, mdifferentiable_at_const 𝓘(ℂ, ℂ) 𝓘(ℂ, ℂ),
+    bdd_at_infty' := λ A, by simpa using at_im_infty.const_bounded_at_filter (1:ℂ),
+      .. (1 : slash_invariant_form Γ 0) }⟩
+
+@[simp] lemma one_coe_eq_one : ((1 : modular_form Γ 0) : ℍ → ℂ) = 1 := rfl
+
+end modular_form
+
+namespace cusp_form
+open modular_form
+
+variables {F : Type*} {Γ : subgroup SL(2, ℤ)} {k : ℤ}
+
+instance has_add : has_add (cusp_form Γ k) :=
+⟨ λ f g,
+  { to_fun := f + g,
+    holo' := f.holo'.add g.holo',
+    zero_at_infty' := λ A, by simpa using (f.zero_at_infty' A).add (g.zero_at_infty' A),
+    .. (f : slash_invariant_form Γ k) + g }⟩
+
+@[simp] lemma coe_add (f g : cusp_form Γ k) : ⇑(f + g) = f + g := rfl
+
+@[simp] lemma add_apply (f g : cusp_form Γ k) (z : ℍ) : (f + g) z = f z + g z := rfl
+
+instance has_zero : has_zero (cusp_form Γ k) :=
+⟨ { to_fun := 0,
+    holo' := (λ _, mdifferentiable_at_const 𝓘(ℂ, ℂ) 𝓘(ℂ, ℂ)),
+    zero_at_infty' := by simpa using filter.zero_zero_at_filter _,
+    .. (0 : slash_invariant_form Γ k) }⟩
+
+@[simp] lemma coe_zero : ⇑(0 : cusp_form Γ k) = (0 : ℍ → ℂ) := rfl
+
+@[simp] lemma zero_apply (z : ℍ) : (0 : cusp_form Γ k) z = 0 := rfl
+
+section
+variables {α : Type*} [has_smul α ℂ] [is_scalar_tower α ℂ ℂ]
+
+instance has_smul : has_smul α (cusp_form Γ k) :=
+⟨ λ c f,
+  { to_fun := c • f,
+    holo' := by simpa using f.holo'.const_smul (c • (1 : ℂ)),
+    zero_at_infty' := λ A, by simpa using (f.zero_at_infty' A).smul (c • (1 : ℂ)),
+    .. c • (f : slash_invariant_form Γ k) }⟩
+
+@[simp] lemma coe_smul (f : (cusp_form Γ k)) (n : α) : ⇑(n • f) = n • f := rfl
+@[simp] lemma smul_apply (f : (cusp_form Γ k)) (n : α) {z : ℍ} :
+   (n • f) z = n • (f z) := rfl
+
+end
+
+instance has_neg : has_neg (cusp_form Γ k) :=
+⟨λ f,
+  { to_fun := -f,
+    holo' := f.holo'.neg,
+    zero_at_infty':= λ A, by simpa using (f.zero_at_infty' A).neg,
+    .. -(f : slash_invariant_form Γ k)} ⟩
+
+@[simp] lemma coe_neg (f : cusp_form Γ k) : ⇑(-f) = -f := rfl
+@[simp] lemma neg_apply (f : cusp_form Γ k) (z : ℍ) : (-f) z = -(f z) := rfl
+
+instance has_sub : has_sub (cusp_form Γ k) :=
+⟨ λ f g, f + -g ⟩
+
+@[simp] lemma coe_sub (f g : cusp_form Γ k) : ⇑(f - g) = f - g := rfl
+@[simp] lemma sub_apply (f g : cusp_form Γ k) (z : ℍ) : (f - g) z = f z - g z := rfl
+
+instance : add_comm_group (cusp_form Γ k) :=
+fun_like.coe_injective.add_comm_group _ rfl coe_add coe_neg coe_sub coe_smul coe_smul
+
+/--Additive coercion from `cusp_form` to `ℍ → ℂ`. -/
+@[simps] def coe_hom : (cusp_form Γ k) →+ (ℍ → ℂ) :=
+{ to_fun := λ f, f,
+  map_zero' := cusp_form.coe_zero,
+  map_add' := λ _ _, rfl }
+
+instance : module ℂ (cusp_form Γ k) :=
+function.injective.module ℂ coe_hom fun_like.coe_injective (λ _ _, rfl)
+
+instance : inhabited (cusp_form Γ k) := ⟨0⟩
+
+@[priority 99]
+instance [cusp_form_class F Γ k] : modular_form_class F Γ k :=
+{ coe := fun_like.coe,
+  coe_injective' := fun_like.coe_injective',
+  slash_action_eq := cusp_form_class.slash_action_eq,
+  holo:= cusp_form_class.holo,
+  bdd_at_infty := λ _ _, (cusp_form_class.zero_at_infty _ _).bounded_at_filter}
+
+end cusp_form
diff --git a/src/number_theory/modular_forms/congruence_subgroups.lean b/src/number_theory/modular_forms/congruence_subgroups.lean
new file mode 100644
index 0000000000000..aa1a2c3e4ba21
--- /dev/null
+++ b/src/number_theory/modular_forms/congruence_subgroups.lean
@@ -0,0 +1,236 @@
+/-
+Copyright (c) 2022 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck
+-/
+import data.zmod.basic
+import group_theory.group_action.conj_act
+import group_theory.subgroup.pointwise
+import linear_algebra.matrix.special_linear_group
+/-!
+# Congruence subgroups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines congruence subgroups of `SL(2, ℤ)` such as `Γ(N)`, `Γ₀(N)` and `Γ₁(N)` for `N` a
+natural number.
+
+It also contains basic results about congruence subgroups.
+
+-/
+
+local notation `SL(` n `, ` R `)`:= matrix.special_linear_group (fin n) R
+
+local attribute [-instance] matrix.special_linear_group.has_coe_to_fun
+
+local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _
+
+open matrix.special_linear_group matrix
+
+variable (N : ℕ)
+
+local notation `SLMOD(`N`)`  := @matrix.special_linear_group.map (fin 2) _ _ _ _ _ _
+  (int.cast_ring_hom (zmod N))
+
+@[simp]
+lemma SL_reduction_mod_hom_val (N : ℕ) (γ : SL(2, ℤ)) : ∀ (i j : fin 2),
+  ((SLMOD(N) γ) : (matrix (fin 2) (fin 2) (zmod N))) i j =
+  (((↑ₘγ i j) : ℤ) : zmod N) := λ i j, rfl
+
+/--The full level `N` congruence subgroup of `SL(2, ℤ)` of matrices that reduce to the identity
+modulo `N`.-/
+def Gamma (N : ℕ) : subgroup SL(2, ℤ) := (SLMOD(N)).ker
+
+lemma Gamma_mem' (N : ℕ) (γ : SL(2, ℤ)) : γ ∈ Gamma N ↔ SLMOD(N) γ = 1 := iff.rfl
+
+@[simp]
+lemma Gamma_mem (N : ℕ) (γ : SL(2, ℤ)) : γ ∈ Gamma N ↔ (((↑ₘγ 0 0) : ℤ) : zmod N) = 1 ∧
+  (((↑ₘγ 0 1) : ℤ) : zmod N) = 0 ∧ (((↑ₘγ 1 0) : ℤ) : zmod N) = 0 ∧
+  (((↑ₘγ 1 1) : ℤ) : zmod N) = 1 :=
+begin
+  rw Gamma_mem',
+  split,
+  { intro h,
+    simp [←(SL_reduction_mod_hom_val N γ), h] },
+  { intro h,
+    ext,
+    rw SL_reduction_mod_hom_val N γ,
+    fin_cases i; fin_cases j,
+    all_goals {simp_rw h, refl} }
+end
+
+lemma Gamma_normal (N : ℕ) : subgroup.normal (Gamma N) := (SLMOD(N)).normal_ker
+
+lemma Gamma_one_top : Gamma 1 = ⊤ :=
+begin
+  ext,
+  simp,
+end
+
+lemma Gamma_zero_bot : Gamma 0 = ⊥ :=
+begin
+  ext,
+  simp only [Gamma_mem, coe_coe, coe_matrix_coe, int.coe_cast_ring_hom, map_apply, int.cast_id,
+    subgroup.mem_bot],
+  split,
+  { intro h,
+    ext,
+    fin_cases i; fin_cases j,
+    any_goals {simp [h]} },
+  { intro h,
+    simp [h] }
+end
+
+/--The congruence subgroup of `SL(2, ℤ)` of matrices whose lower left-hand entry reduces to zero
+modulo `N`. -/
+def Gamma0 (N : ℕ) : subgroup SL(2, ℤ) :=
+{ carrier := { g : SL(2, ℤ) | ((↑ₘg 1 0 : ℤ) : zmod N) = 0 },
+  one_mem' := by { simp },
+  mul_mem':= by {intros a b ha hb,
+    simp only [ set.mem_set_of_eq],
+    have h := ((matrix.two_mul_expl a.1 b.1).2.2.1),
+    simp only [coe_coe, coe_matrix_coe, coe_mul, int.coe_cast_ring_hom, map_apply,
+      set.mem_set_of_eq, subtype.val_eq_coe, mul_eq_mul] at *,
+    rw h,
+    simp [ha, hb] },
+  inv_mem':= by {intros a ha,
+    simp only [ set.mem_set_of_eq, subtype.val_eq_coe],
+    rw (SL2_inv_expl a),
+    simp only [subtype.val_eq_coe, cons_val_zero, cons_val_one, head_cons, coe_coe, coe_matrix_coe,
+      coe_mk, int.coe_cast_ring_hom, map_apply, int.cast_neg, neg_eq_zero, set.mem_set_of_eq] at *,
+    exact ha } }
+
+@[simp]
+lemma Gamma0_mem (N : ℕ) (A: SL(2, ℤ)) : A ∈ Gamma0 N ↔ (((↑ₘA) 1 0 : ℤ) : zmod N) = 0 := iff.rfl
+
+lemma Gamma0_det (N : ℕ) (A : Gamma0 N) : (A.1.1.det : zmod N) = 1 :=
+by {simp [A.1.property]}
+
+/--The group homomorphism from `Gamma0` to `zmod N` given by mapping a matrix to its lower
+right-hand entry. -/
+def Gamma_0_map (N : ℕ): Gamma0 N →* zmod N :=
+{ to_fun := λ g, ((↑ₘg 1 1 : ℤ) : zmod N),
+  map_one' := by { simp, },
+  map_mul' := by {intros A B,
+  have := (two_mul_expl A.1.1 B.1.1).2.2.2,
+  simp only [coe_coe, subgroup.coe_mul, coe_matrix_coe, coe_mul, int.coe_cast_ring_hom, map_apply,
+    subtype.val_eq_coe, mul_eq_mul] at *,
+  rw this,
+  have ha := A.property,
+  simp only [int.cast_add, int.cast_mul, add_left_eq_self, subtype.val_eq_coe, Gamma0_mem, coe_coe,
+    coe_matrix_coe, int.coe_cast_ring_hom, map_apply] at *,
+  rw ha,
+  simp,} }
+
+/--The congruence subgroup `Gamma1` (as a subgroup of `Gamma0`) of matrices whose bottom
+row is congruent to `(0,1)` modulo `N`.-/
+def Gamma1' (N : ℕ) : subgroup (Gamma0 N) := (Gamma_0_map N).ker
+
+@[simp]
+lemma Gamma1_mem' (N : ℕ) (γ : Gamma0 N) : γ ∈ Gamma1' N ↔ (Gamma_0_map N) γ = 1 := iff.rfl
+
+lemma Gamma1_to_Gamma0_mem (N : ℕ) (A : Gamma0 N) : A ∈ Gamma1' N ↔
+  ((↑ₘA 0 0 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 1 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 0 : ℤ) : zmod N) = 0 :=
+begin
+  split,
+  { intro ha,
+    have hA := A.property,
+    rw Gamma0_mem at hA,
+    have adet := Gamma0_det N A,
+    rw matrix.det_fin_two at adet,
+    simp only [Gamma_0_map, coe_coe, coe_matrix_coe, int.coe_cast_ring_hom, map_apply, Gamma1_mem',
+      monoid_hom.coe_mk, subtype.val_eq_coe, int.cast_sub, int.cast_mul] at *,
+    rw [hA, ha] at adet,
+    simp only [mul_one, mul_zero, sub_zero] at adet,
+    simp only [adet, hA, ha, eq_self_iff_true, and_self]},
+  { intro ha,
+    simp only [Gamma1_mem', Gamma_0_map, monoid_hom.coe_mk, coe_coe, coe_matrix_coe,
+      int.coe_cast_ring_hom, map_apply],
+    exact ha.2.1,}
+end
+
+/--The congruence subgroup `Gamma1` of `SL(2, ℤ)` consisting of matrices whose bottom
+row is congruent to `(0,1)` modulo `N`. -/
+def Gamma1 (N : ℕ) : subgroup SL(2, ℤ) := subgroup.map
+(((Gamma0 N).subtype).comp (Gamma1' N).subtype) ⊤
+
+@[simp]
+lemma Gamma1_mem (N : ℕ) (A : SL(2, ℤ)) : A ∈ Gamma1 N ↔
+  ((↑ₘA 0 0 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 1 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 0 : ℤ) : zmod N) = 0 :=
+begin
+  split,
+  { intro ha,
+    simp_rw [Gamma1, subgroup.mem_map] at ha,
+    simp at ha,
+    obtain ⟨⟨x, hx⟩, hxx⟩ := ha,
+    rw Gamma1_to_Gamma0_mem at hx,
+    rw ←hxx,
+    convert hx },
+  { intro ha,
+    simp_rw [Gamma1, subgroup.mem_map],
+    have hA : A ∈ (Gamma0 N), by {simp [ha.right.right, Gamma0_mem, subtype.val_eq_coe],},
+    have HA : (⟨A , hA⟩ : Gamma0 N) ∈ Gamma1' N,
+      by {simp only [Gamma1_to_Gamma0_mem, subgroup.coe_mk, coe_coe, coe_matrix_coe,
+        int.coe_cast_ring_hom, map_apply],
+      exact ha,},
+    refine ⟨(⟨(⟨A , hA⟩ : Gamma0 N), HA ⟩ : (( Gamma1' N ) : subgroup (Gamma0 N))), _⟩,
+    simp }
+end
+
+lemma Gamma1_in_Gamma0 (N : ℕ) : Gamma1 N ≤ Gamma0 N :=
+begin
+  intros x HA,
+  simp only [Gamma0_mem, Gamma1_mem, coe_coe, coe_matrix_coe, int.coe_cast_ring_hom,
+    map_apply] at *,
+  exact HA.2.2,
+end
+
+section congruence_subgroup
+
+/--A congruence subgroup is a subgroup of `SL(2, ℤ)` which contains some `Gamma N` for some
+`(N : ℕ+)`. -/
+def is_congruence_subgroup (Γ : subgroup SL(2, ℤ)) : Prop := ∃ (N : ℕ+), Gamma N ≤ Γ
+
+lemma is_congruence_subgroup_trans (H K : subgroup SL(2, ℤ)) (h: H ≤ K)
+  (h2 : is_congruence_subgroup H) : is_congruence_subgroup K :=
+begin
+  obtain ⟨N , hN⟩ := h2,
+  refine ⟨N, le_trans hN h⟩,
+end
+
+lemma Gamma_is_cong_sub (N : ℕ+) : is_congruence_subgroup (Gamma N) :=
+⟨N, by {simp only [le_refl]}⟩
+
+lemma Gamma1_is_congruence (N : ℕ+) : is_congruence_subgroup (Gamma1 N) :=
+begin
+  refine ⟨N, _⟩,
+  intros A hA,
+  simp only [Gamma1_mem, Gamma_mem] at *,
+  simp only [hA, eq_self_iff_true, and_self],
+end
+
+lemma Gamma0_is_congruence (N : ℕ+) : is_congruence_subgroup (Gamma0 N) :=
+is_congruence_subgroup_trans _ _ (Gamma1_in_Gamma0 N) (Gamma1_is_congruence N)
+
+end congruence_subgroup
+
+section conjugation
+
+open_locale pointwise
+
+lemma Gamma_cong_eq_self (N : ℕ) (g : conj_act SL(2, ℤ)) : g • (Gamma N) = Gamma N :=
+begin
+  apply subgroup.normal.conj_act (Gamma_normal N),
+end
+
+lemma conj_cong_is_cong (g : conj_act SL(2, ℤ)) (Γ : subgroup SL(2, ℤ))
+  (h : is_congruence_subgroup Γ) : is_congruence_subgroup (g • Γ) :=
+begin
+  obtain ⟨N, HN⟩ := h,
+  refine ⟨N, _⟩,
+  rw [←Gamma_cong_eq_self N g, subgroup.pointwise_smul_le_pointwise_smul_iff],
+  exact HN,
+end
+
+end conjugation
diff --git a/src/number_theory/modular_forms/jacobi_theta/basic.lean b/src/number_theory/modular_forms/jacobi_theta/basic.lean
new file mode 100644
index 0000000000000..86c8bd4862385
--- /dev/null
+++ b/src/number_theory/modular_forms/jacobi_theta/basic.lean
@@ -0,0 +1,187 @@
+/-
+Copyright (c) 2023 David Loeffler. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: David Loeffler
+-/
+import analysis.special_functions.gaussian
+import analysis.complex.locally_uniform_limit
+import analysis.complex.upper_half_plane.functions_bounded_at_infty
+import analysis.complex.upper_half_plane.topology
+
+/-! # Jacobi's theta function
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the Jacobi theta function
+
+$$\theta(\tau) = \sum_{n \in \mathbb{Z}} \exp (i \pi n ^ 2 \tau),$$
+
+and proves the modular transformation properties `θ (τ + 2) = θ τ` and
+`θ (-1 / τ) = (-I * τ) ^ (1 / 2) * θ τ`, using Poisson's summation formula for the latter. We also
+show that `θ` is differentiable on `ℍ`, and `θ(τ) - 1` has exponential decay as `im τ → ∞`.
+-/
+
+open complex real asymptotics filter
+open_locale real big_operators upper_half_plane
+
+/-- Jacobi's theta function `∑' (n : ℤ), exp (π * I * n ^ 2 * τ)`. -/
+noncomputable def jacobi_theta (z : ℂ) : ℂ := ∑' (n : ℤ), cexp (π * I * n ^ 2 * z)
+
+lemma norm_exp_mul_sq_le {z : ℂ} (hz : 0 < z.im) (n : ℤ) :
+  ‖cexp (π * I * n ^ 2 * z)‖ ≤ exp (-π * z.im) ^ n.nat_abs :=
+begin
+  let y := rexp (-π * z.im),
+  have h : y < 1, from exp_lt_one_iff.mpr (mul_neg_of_neg_of_pos (neg_lt_zero.mpr pi_pos) hz),
+  refine (le_of_eq _).trans (_ : y ^ (n ^ 2) ≤ _),
+  { rw [complex.norm_eq_abs, complex.abs_exp],
+    have : (↑π * I * n ^ 2 * z).re = (-π * z.im) * n ^ 2,
+    { rw [(by { push_cast, ring } : ↑π * I * n ^ 2 * z = ↑(π * n ^ 2) * (z * I)),
+        of_real_mul_re, mul_I_re],
+      ring },
+    obtain ⟨m, hm⟩ := int.eq_coe_of_zero_le (sq_nonneg n),
+    rw [this, exp_mul, ←int.cast_pow, rpow_int_cast, hm, zpow_coe_nat] },
+  { have : n ^ 2 = ↑(n.nat_abs ^ 2), by rw [nat.cast_pow, int.nat_abs_sq],
+    rw [this, zpow_coe_nat],
+    exact pow_le_pow_of_le_one (exp_pos _).le h.le ((sq n.nat_abs).symm ▸ n.nat_abs.le_mul_self) },
+end
+
+lemma exists_summable_bound_exp_mul_sq {R : ℝ} (hR : 0 < R) :
+  ∃ (bd : ℤ → ℝ), (summable bd) ∧
+  (∀ {τ : ℂ} (hτ : R ≤ τ.im) (n : ℤ), ‖cexp (π * I * n ^ 2 * τ)‖ ≤ bd n) :=
+begin
+  let y := rexp (-π * R),
+  have h : y < 1, from exp_lt_one_iff.mpr (mul_neg_of_neg_of_pos (neg_lt_zero.mpr pi_pos) hR),
+  refine ⟨λ n, y ^ n.nat_abs, summable_int_of_summable_nat _ _, λ τ hτ n, _⟩, swap 3,
+  { refine (norm_exp_mul_sq_le (hR.trans_le hτ) n).trans _,
+    refine pow_le_pow_of_le_left (exp_pos _).le (real.exp_le_exp.mpr _) _,
+    rwa [mul_le_mul_left_of_neg (neg_lt_zero.mpr pi_pos)] },
+  all_goals { simpa only [int.nat_abs_neg, int.nat_abs_of_nat]
+    using summable_geometric_of_lt_1 (real.exp_pos _).le h },
+end
+
+lemma summable_exp_mul_sq {z : ℂ} (hz : 0 < z.im) :
+  summable (λ n : ℤ, cexp (π * I * n ^ 2 * z)) :=
+let ⟨bd, h, h'⟩ := exists_summable_bound_exp_mul_sq hz in
+  summable_norm_iff.mp (summable_of_nonneg_of_le (λ n, norm_nonneg _) (h' $ le_refl _) h)
+
+lemma jacobi_theta_two_add (z : ℂ) : jacobi_theta (2 + z) = jacobi_theta z :=
+begin
+  refine tsum_congr (λ n, _),
+  suffices : cexp (↑π * I * ↑n ^ 2 * 2) = 1, by rw [mul_add, complex.exp_add, this, one_mul],
+  rw [(by { push_cast, ring } : ↑π * I * ↑n ^ 2 * 2 = ↑(n ^ 2) * (2 * π * I)),
+    complex.exp_int_mul, complex.exp_two_pi_mul_I, one_zpow],
+end
+
+lemma jacobi_theta_T_sq_smul (τ : ℍ) :
+  jacobi_theta ↑(modular_group.T ^ 2 • τ) = jacobi_theta τ :=
+begin
+  suffices : ↑(modular_group.T ^ 2 • τ) = (2 : ℂ) + ↑τ,
+  { simp_rw [this, jacobi_theta_two_add] },
+  have : modular_group.T ^ (2 : ℕ) = modular_group.T ^ (2 : ℤ), by refl,
+  simp_rw [this, upper_half_plane.modular_T_zpow_smul, upper_half_plane.coe_vadd],
+  push_cast,
+end
+
+lemma jacobi_theta_S_smul (τ : ℍ) :
+  jacobi_theta ↑(modular_group.S • τ) = (-I * τ) ^ (1 / 2 : ℂ) * jacobi_theta τ :=
+begin
+  unfold jacobi_theta,
+  rw [upper_half_plane.modular_S_smul, upper_half_plane.coe_mk],
+  have ha : 0 < (-I * τ).re,
+  { rw [neg_mul, neg_re, mul_re, I_re, I_im, zero_mul, one_mul, zero_sub, neg_neg],
+    exact τ.im_pos },
+  have ha' : (-I * τ) ^ (1 / 2 : ℂ) ≠ 0,
+  { rw [ne.def, cpow_eq_zero_iff],
+    contrapose! ha,
+    rw [ha.1, zero_re] },
+  have hτ : (τ : ℂ) ≠ 0, from τ.ne_zero,
+  have := complex.tsum_exp_neg_mul_int_sq ha,
+  rw [mul_comm ((1:ℂ) / _) _, mul_one_div, eq_div_iff ha', mul_comm _ (_ ^ _), eq_comm] at this,
+  convert this using 3,
+  { ext1 n,
+    congr' 1,
+    field_simp [hτ, I_ne_zero],
+    ring_nf,
+    rw [I_sq, mul_neg, mul_one, neg_mul, neg_neg] },
+  { ext1 n,
+    congr' 1,
+    ring_nf }
+end
+
+lemma has_sum_nat_jacobi_theta {z : ℂ} (hz : 0 < im z) :
+  has_sum (λ (n : ℕ), cexp (π * I * (n + 1) ^ 2 * z)) ((jacobi_theta z - 1) / 2) :=
+begin
+  have := (summable_exp_mul_sq hz).has_sum.sum_nat_of_sum_int,
+  rw ←@has_sum_nat_add_iff' ℂ _ _ _ _ 1 at this,
+  simp_rw [finset.sum_range_one, int.cast_neg, int.cast_coe_nat, nat.cast_zero, neg_zero,
+    int.cast_zero, sq (0:ℂ), mul_zero, zero_mul, neg_sq, ←mul_two, complex.exp_zero,
+    add_sub_assoc, (by norm_num : (1 : ℂ) - 1 * 2 = -1), ←sub_eq_add_neg,
+    nat.cast_add, nat.cast_one] at this,
+  convert this.div_const 2,
+  simp_rw mul_div_cancel _ two_ne_zero,
+end
+
+lemma jacobi_theta_eq_tsum_nat {z : ℂ} (hz : 0 < im z) :
+  jacobi_theta z = 1 + 2 * ∑' (n : ℕ), cexp (π * I * (n + 1) ^ 2 * z) :=
+by rw [(has_sum_nat_jacobi_theta hz).tsum_eq, mul_div_cancel' _ (two_ne_zero' ℂ), ←add_sub_assoc,
+  add_sub_cancel']
+
+/-- An explicit upper bound for `‖jacobi_theta τ - 1‖`. -/
+lemma norm_jacobi_theta_sub_one_le {z : ℂ} (hz : 0 < im z) :
+  ‖jacobi_theta z - 1‖ ≤ 2 / (1 - exp (-π * z.im)) * exp (-π * z.im) :=
+begin
+  suffices : ‖∑' (n : ℕ), cexp (π * I * (n + 1) ^ 2 * z)‖ ≤ exp (-π * z.im) / (1 - exp (-π * z.im)),
+  { calc ‖jacobi_theta z - 1‖ = 2 * ‖∑' (n : ℕ), cexp (π * I * (n + 1) ^ 2 * z)‖ :
+      by rw [sub_eq_iff_eq_add'.mpr (jacobi_theta_eq_tsum_nat hz), norm_mul, complex.norm_eq_abs,
+        complex.abs_two]
+    ... ≤ 2 * (rexp (-π * z.im) / (1 - rexp (-π * z.im))) :
+      by rwa [mul_le_mul_left (zero_lt_two' ℝ)]
+    ... = 2 / (1 - rexp (-π * z.im)) * rexp (-π * z.im) : by rw [div_mul_comm, mul_comm] },
+  have : ∀ (n : ℕ), ‖cexp (π * I * (n + 1) ^ 2 * z)‖ ≤ exp (-π * z.im) ^ (n + 1),
+  { intro n,
+    simpa only [int.cast_add, int.cast_one] using norm_exp_mul_sq_le hz (n + 1) },
+  have s : has_sum (λ n : ℕ, rexp (-π * z.im) ^ (n + 1)) (exp (-π * z.im) / (1 - exp (-π * z.im))),
+  { simp_rw [pow_succ, div_eq_mul_inv, has_sum_mul_left_iff (real.exp_ne_zero _)],
+    exact has_sum_geometric_of_lt_1 (exp_pos (-π * z.im)).le
+      (exp_lt_one_iff.mpr $ (mul_neg_of_neg_of_pos (neg_lt_zero.mpr pi_pos) hz)) },
+  have aux : summable (λ (n : ℕ), ‖cexp (↑π * I * (↑n + 1) ^ 2 * z)‖),
+    from summable_of_nonneg_of_le (λ n, norm_nonneg _) this s.summable,
+  exact (norm_tsum_le_tsum_norm aux).trans
+    ((tsum_mono aux s.summable this).trans (le_of_eq s.tsum_eq)),
+end
+
+/-- The norm of `jacobi_theta τ - 1` decays exponentially as `im τ → ∞`. -/
+lemma is_O_at_im_infty_jacobi_theta_sub_one :
+  (λ τ, jacobi_theta τ - 1) =O[comap im at_top] (λ τ, rexp (-π * τ.im)) :=
+begin
+  simp_rw [is_O, is_O_with, filter.eventually_comap, filter.eventually_at_top],
+  refine ⟨2 / (1 - rexp (-π)), 1, λ y hy z hz, (norm_jacobi_theta_sub_one_le
+    (hz.symm ▸ (zero_lt_one.trans_le hy) : 0 < im z)).trans _⟩,
+  rw [real.norm_eq_abs, real.abs_exp],
+  refine mul_le_mul_of_nonneg_right _ (exp_pos _).le,
+  rw [div_le_div_left (zero_lt_two' ℝ), sub_le_sub_iff_left, exp_le_exp, neg_mul, neg_le_neg_iff],
+  { exact le_mul_of_one_le_right pi_pos.le (hz.symm ▸ hy) },
+  { rw [sub_pos, exp_lt_one_iff, neg_mul, neg_lt_zero],
+    exact mul_pos pi_pos (hz.symm ▸ (zero_lt_one.trans_le hy)) },
+  { rw [sub_pos, exp_lt_one_iff, neg_lt_zero], exact pi_pos }
+end
+
+lemma differentiable_at_jacobi_theta {z : ℂ} (hz : 0 < im z) :
+  differentiable_at ℂ jacobi_theta z :=
+begin
+  suffices : ∀ (y : ℝ) (hy : 0 < y),
+    differentiable_on ℂ (λ z, ∑' (n : ℤ), cexp (π * I * n ^ 2 * z)) {w : ℂ | y < im w},
+  from let ⟨y, hy, hy'⟩ := exists_between hz in (this y hy).differentiable_at
+    ((complex.continuous_im.is_open_preimage _ is_open_Ioi).mem_nhds hy'),
+  intros y hy,
+  have h1 : ∀ (n : ℤ) (w : ℂ) (hw : y < im w), differentiable_within_at ℂ
+    (λ (v : ℂ), cexp (↑π * I * ↑n ^ 2 * v)) {z : ℂ | y < im z} w,
+  from λ n w hw, (differentiable_at_id.const_mul _).cexp.differentiable_within_at,
+  have h2 : is_open {w : ℂ | y < im w}, from continuous_im.is_open_preimage _ is_open_Ioi,
+  obtain ⟨bd, bd_s, le_bd⟩ := exists_summable_bound_exp_mul_sq hy,
+  exact differentiable_on_tsum_of_summable_norm bd_s h1 h2 (λ i w hw, le_bd (le_of_lt hw) i),
+end
+
+lemma continuous_at_jacobi_theta {z : ℂ} (hz : 0 < im z) :
+  continuous_at jacobi_theta z := (differentiable_at_jacobi_theta hz).continuous_at
diff --git a/src/number_theory/modular_forms/jacobi_theta/manifold.lean b/src/number_theory/modular_forms/jacobi_theta/manifold.lean
new file mode 100644
index 0000000000000..81a9584cd7556
--- /dev/null
+++ b/src/number_theory/modular_forms/jacobi_theta/manifold.lean
@@ -0,0 +1,26 @@
+/-
+Copyright (c) 2023 David Loeffler. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: David Loeffler
+-/
+import number_theory.modular_forms.jacobi_theta.basic
+import analysis.complex.upper_half_plane.manifold
+
+/-!
+# Manifold differentiability of the Jacobi's theta function
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we reformulate differentiability of the Jacobi's theta function in terms of manifold
+differentiability.
+
+## TODO
+
+Prove smoothness (in terms of `smooth`).
+-/
+
+open_locale upper_half_plane manifold
+
+lemma mdifferentiable_jacobi_theta : mdifferentiable 𝓘(ℂ) 𝓘(ℂ) (jacobi_theta ∘ coe : ℍ → ℂ) :=
+λ τ, (differentiable_at_jacobi_theta τ.2).mdifferentiable_at.comp τ τ.mdifferentiable_coe
diff --git a/src/number_theory/modular_forms/slash_actions.lean b/src/number_theory/modular_forms/slash_actions.lean
new file mode 100644
index 0000000000000..591978ad458c7
--- /dev/null
+++ b/src/number_theory/modular_forms/slash_actions.lean
@@ -0,0 +1,226 @@
+/-
+Copyright (c) 2022 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck
+-/
+import analysis.complex.upper_half_plane.basic
+import linear_algebra.matrix.general_linear_group
+import linear_algebra.matrix.special_linear_group
+/-!
+# Slash actions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines a class of slash actions, which are families of right actions of a given group
+parametrized by some Type. This is modeled on the slash action of `GL_pos (fin 2) ℝ` on the space
+of modular forms.
+
+## Notation
+
+In the `modular_form` locale, this provides
+
+* `f ∣[k;γ] A`: the `k`th `γ`-compatible slash action by `A` on `f`
+* `f ∣[k] A`: the `k`th `ℂ`-compatible slash action by `A` on `f`; a shorthand for `f ∣[k;ℂ] A`
+-/
+
+open complex upper_half_plane
+
+open_locale upper_half_plane
+
+local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _
+
+-- like `↑ₘ`, but allows the user to specify the ring `R`. Useful to help Lean elaborate.
+local notation `↑ₘ[` R `]` := @coe _ (matrix (fin 2) (fin 2) R) _
+
+local notation `GL(` n `, ` R `)`⁺ := matrix.GL_pos (fin n) R
+
+local notation `SL(` n `, ` R `)` := matrix.special_linear_group (fin n) R
+
+/--A general version of the slash action of the space of modular forms.-/
+class slash_action (β G α γ : Type*) [group G] [add_monoid α] [has_smul γ α] :=
+(map : β → G → α → α)
+(zero_slash : ∀ (k : β) (g : G), map k g 0 = 0)
+(slash_one : ∀ (k : β) (a : α) , map k 1 a = a)
+(slash_mul : ∀ (k : β) (g h : G) (a : α), map k (g * h) a =map k h (map k g a))
+(smul_slash : ∀ (k : β) (g : G) (a : α) (z : γ), map k g (z • a) = z • (map k g a))
+(add_slash : ∀ (k : β) (g : G) (a b : α), map k g (a + b) = map k g a + map k g b)
+
+localized "notation (name := modular_form.slash) f ` ∣[`:100 k `;` γ `] `:0 a :100 :=
+  slash_action.map γ k a f" in modular_form
+
+localized "notation (name := modular_form.slash_complex) f ` ∣[`:100 k `] `:0 a :100 :=
+  slash_action.map ℂ k a f" in modular_form
+
+@[simp] lemma slash_action.neg_slash {β G α γ : Type*} [group G] [add_group α] [has_smul γ α]
+  [slash_action β G α γ] (k : β) (g : G) (a : α) :
+  (-a) ∣[k;γ] g = - (a ∣[k;γ] g) :=
+eq_neg_of_add_eq_zero_left $ by rw [←slash_action.add_slash, add_left_neg, slash_action.zero_slash]
+
+@[simp] lemma slash_action.smul_slash_of_tower {R β G α : Type*} (γ : Type*) [group G] [add_group α]
+  [monoid γ] [mul_action γ α]
+  [has_smul R γ] [has_smul R α] [is_scalar_tower R γ α]
+  [slash_action β G α γ] (k : β) (g : G) (a : α) (r : R) :
+  (r • a) ∣[k;γ] g = r • (a ∣[k;γ] g) :=
+by rw [←smul_one_smul γ r a, slash_action.smul_slash, smul_one_smul]
+
+attribute [simp]
+  slash_action.zero_slash slash_action.slash_one
+  slash_action.smul_slash slash_action.add_slash
+
+/--Slash_action induced by a monoid homomorphism.-/
+def monoid_hom_slash_action {β G H α γ : Type*} [group G] [add_monoid α] [has_smul γ α]
+  [group H] [slash_action β G α γ] (h : H →* G) : slash_action β H α γ :=
+{ map := λ k g, slash_action.map γ k (h g),
+  zero_slash := λ k g, slash_action.zero_slash k (h g),
+  slash_one := λ k a, by simp only [map_one, slash_action.slash_one],
+  slash_mul := λ k g gg a, by simp only [map_mul, slash_action.slash_mul],
+  smul_slash := λ _ _, slash_action.smul_slash _ _,
+  add_slash := λ _ g _ _, slash_action.add_slash _ (h g) _ _,}
+
+namespace modular_form
+
+noncomputable theory
+
+/--The weight `k` action of `GL(2, ℝ)⁺` on functions `f : ℍ → ℂ`. -/
+def slash (k : ℤ) (γ : GL(2, ℝ)⁺) (f : ℍ → ℂ) (x : ℍ) : ℂ :=
+f (γ • x) * (((↑ₘ γ).det) : ℝ)^(k-1) * (upper_half_plane.denom γ x)^(-k)
+
+variables {Γ : subgroup SL(2, ℤ)} {k: ℤ} (f : ℍ → ℂ)
+
+section
+
+-- temporary notation until the instance is built
+local notation f ` ∣[`:100 k `]`:0 γ :100 := modular_form.slash k γ f
+
+private lemma slash_mul (k : ℤ) (A B : GL(2, ℝ)⁺) (f : ℍ → ℂ) :
+  f ∣[k] (A * B) = (f ∣[k] A) ∣[k] B :=
+begin
+  ext1,
+  simp_rw [slash,(upper_half_plane.denom_cocycle A B x)],
+  have e3 : (A * B) • x = A • B • x , by { convert (upper_half_plane.mul_smul' A B x), } ,
+  rw e3,
+  simp only [upper_half_plane.num, upper_half_plane.denom, of_real_mul, subgroup.coe_mul, coe_coe,
+    upper_half_plane.coe_smul, units.coe_mul, matrix.mul_eq_mul, matrix.det_mul,
+    upper_half_plane.smul_aux, upper_half_plane.smul_aux', subtype.coe_mk] at *,
+  field_simp,
+  have : (((↑(↑A : GL (fin 2) ℝ) : (matrix (fin 2) (fin 2) ℝ)).det : ℂ) *
+    ((↑(↑B : GL (fin 2) ℝ) : (matrix (fin 2) (fin 2) ℝ)).det : ℂ))^(k-1) =
+    ((↑(↑A : GL (fin 2) ℝ) : (matrix (fin 2) (fin 2) ℝ)).det : ℂ)^(k-1) *
+    ((↑(↑B : GL (fin 2) ℝ) : (matrix (fin 2) (fin 2) ℝ)).det : ℂ)^(k-1) ,
+    by {simp_rw [←mul_zpow]},
+  simp_rw [this, ← mul_assoc, ←mul_zpow],
+end
+
+private lemma add_slash (k : ℤ) (A : GL(2, ℝ)⁺) (f g : ℍ → ℂ) :
+  (f + g) ∣[k] A = (f ∣[k] A) + (g ∣[k] A) :=
+begin
+  ext1,
+  simp only [slash, pi.add_apply, denom, coe_coe, zpow_neg],
+  ring,
+end
+
+private lemma slash_one (k : ℤ) (f : ℍ → ℂ) : (f ∣[k] 1) = f :=
+funext $ by simp [slash]
+
+variables {α : Type*} [has_smul α ℂ] [is_scalar_tower α ℂ ℂ]
+
+private lemma smul_slash (k : ℤ) (A : GL(2, ℝ)⁺) (f : ℍ → ℂ) (c : α) :
+  (c • f) ∣[k] A = c • (f ∣[k] A) :=
+begin
+  simp_rw [←smul_one_smul ℂ c f, ←smul_one_smul ℂ c (f ∣[k] A)],
+  ext1,
+  simp_rw slash,
+  simp only [slash, algebra.id.smul_eq_mul, matrix.general_linear_group.coe_det_apply,
+    pi.smul_apply, subtype.val_eq_coe, coe_coe],
+  ring,
+end
+
+private lemma zero_slash (k : ℤ) (A : GL(2, ℝ)⁺) : (0 : ℍ → ℂ) ∣[k] A = 0 :=
+funext $ λ _, by simp only [slash, pi.zero_apply, zero_mul]
+
+instance : slash_action ℤ GL(2, ℝ)⁺ (ℍ → ℂ) ℂ :=
+{ map := slash,
+  zero_slash := zero_slash,
+  slash_one := slash_one,
+  slash_mul := slash_mul,
+  smul_slash := smul_slash,
+  add_slash := add_slash }
+
+end
+
+lemma slash_def (A : GL(2, ℝ)⁺) : f ∣[k] A = slash k A f := rfl
+
+instance subgroup_action (Γ : subgroup SL(2, ℤ)) : slash_action ℤ Γ (ℍ → ℂ) ℂ :=
+monoid_hom_slash_action (monoid_hom.comp (matrix.special_linear_group.to_GL_pos)
+  (monoid_hom.comp (matrix.special_linear_group.map (int.cast_ring_hom ℝ)) (subgroup.subtype Γ)))
+
+@[simp] lemma subgroup_slash (Γ : subgroup SL(2, ℤ)) (γ : Γ):
+  (f ∣[k] γ) = f ∣[k] (γ : GL(2,ℝ)⁺) := rfl
+
+instance SL_action : slash_action ℤ SL(2, ℤ) (ℍ → ℂ) ℂ :=
+monoid_hom_slash_action (monoid_hom.comp (matrix.special_linear_group.to_GL_pos)
+  (matrix.special_linear_group.map (int.cast_ring_hom ℝ)))
+
+@[simp] lemma SL_slash (γ : SL(2, ℤ)): f ∣[k] γ = f ∣[k] (γ : GL(2,ℝ)⁺) := rfl
+
+/-- The constant function 1 is invariant under any element of `SL(2, ℤ)`. -/
+@[simp] lemma is_invariant_one (A : SL(2, ℤ)) : (1 : ℍ → ℂ) ∣[(0 : ℤ)] A = (1 : ℍ → ℂ) :=
+begin
+  have : (((↑ₘ(A : GL(2,ℝ)⁺)).det) : ℝ) = 1,
+  { simp only [coe_coe,
+      matrix.special_linear_group.coe_GL_pos_coe_GL_coe_matrix,
+      matrix.special_linear_group.det_coe], },
+  funext,
+  rw [SL_slash, slash_def, slash, zero_sub, this],
+  simp,
+end
+
+/-- A function `f : ℍ → ℂ` is `slash_invariant`, of weight `k ∈ ℤ` and level `Γ`,
+  if for every matrix `γ ∈ Γ` we have `f(γ • z)= (c*z+d)^k f(z)` where `γ= ![![a, b], ![c, d]]`,
+  and it acts on `ℍ` via Möbius transformations. -/
+lemma slash_action_eq'_iff (k : ℤ) (Γ : subgroup SL(2, ℤ)) (f : ℍ → ℂ) (γ : Γ)  (z : ℍ) :
+  (f ∣[k] γ) z = f z ↔ f (γ • z) = ((↑ₘ[ℤ]γ 1 0 : ℂ) * z + (↑ₘ[ℤ]γ 1 1 : ℂ))^k * f z :=
+begin
+  simp only [subgroup_slash, slash_def, modular_form.slash],
+  convert inv_mul_eq_iff_eq_mul₀ _ using 2,
+  { rw mul_comm,
+    simp only [denom, coe_coe, matrix.special_linear_group.coe_GL_pos_coe_GL_coe_matrix, zpow_neg,
+      matrix.special_linear_group.det_coe, of_real_one, one_zpow, mul_one, subgroup_to_sl_moeb,
+      sl_moeb],
+    refl, },
+  { convert zpow_ne_zero k (denom_ne_zero γ z) },
+end
+
+lemma mul_slash (k1 k2 : ℤ) (A : GL(2, ℝ)⁺) (f g : ℍ → ℂ) :
+  (f * g) ∣[k1 + k2] A = (((↑ₘ A).det) : ℝ) • (f ∣[k1] A) * (g ∣[k2] A) :=
+begin
+  ext1,
+  simp only [slash_def, slash, matrix.general_linear_group.coe_det_apply, subtype.val_eq_coe,
+    pi.mul_apply, pi.smul_apply, algebra.smul_mul_assoc, real_smul],
+  set d : ℂ := ↑((↑ₘ A).det : ℝ),
+  have h1 : d ^ (k1 + k2 - 1) = d * d ^ (k1 - 1) * d ^ (k2 - 1),
+  { have : d ≠ 0,
+    { dsimp [d],
+      norm_cast,
+      exact matrix.GL_pos.det_ne_zero A },
+    rw [← zpow_one_add₀ this, ← zpow_add₀ this],
+    ring_exp },
+  have h22 : denom A x ^ (- (k1 + k2)) = denom A x ^ (- k1) * denom A x ^ (- k2),
+  { rw [int.neg_add, zpow_add₀],
+    exact upper_half_plane.denom_ne_zero A x, },
+  rw [h1, h22],
+  ring,
+end
+
+@[simp] lemma mul_slash_SL2 (k1 k2 : ℤ) (A : SL(2, ℤ)) (f g : ℍ → ℂ) :
+  (f * g) ∣[k1 + k2] A = (f ∣[k1] A) * (g ∣[k2] A) :=
+calc (f * g) ∣[k1 + k2] (A : GL(2, ℝ)⁺) = _ • (f ∣[k1] A) * (g ∣[k2] A) : mul_slash _ _ _ _ _
+... = (1:ℝ) • (f ∣[k1] A) * (g ∣[k2] A) : by simp [-matrix.special_linear_group.coe_matrix_coe]
+... = (f ∣[k1] A) * (g ∣[k2] A) : by simp
+
+lemma mul_slash_subgroup (k1 k2 : ℤ) (Γ : subgroup SL(2, ℤ)) (A : Γ) (f g : ℍ → ℂ) :
+  (f * g) ∣[k1 + k2] A = (f ∣[k1] A) * (g ∣[k2] A) :=
+mul_slash_SL2 k1 k2 A f g
+
+end modular_form
diff --git a/src/number_theory/modular_forms/slash_invariant_forms.lean b/src/number_theory/modular_forms/slash_invariant_forms.lean
new file mode 100644
index 0000000000000..701fe0e66479a
--- /dev/null
+++ b/src/number_theory/modular_forms/slash_invariant_forms.lean
@@ -0,0 +1,170 @@
+/-
+Copyright (c) 2022 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck
+-/
+import number_theory.modular_forms.slash_actions
+
+/-!
+# Slash invariant forms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines functions that are invariant under a `slash_action` which forms the basis for
+defining `modular_form` and `cusp_form`. We prove several instances for such spaces, in particular
+that they form a module.
+-/
+
+open complex upper_half_plane
+
+open_locale upper_half_plane modular_form
+
+noncomputable theory
+
+local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _
+
+-- like `↑ₘ`, but allows the user to specify the ring `R`. Useful to help Lean elaborate.
+local notation `↑ₘ[` R `]` := @coe _ (matrix (fin 2) (fin 2) R) _
+
+local notation `GL(` n `, ` R `)`⁺ := matrix.GL_pos (fin n) R
+
+local notation `SL(` n `, ` R `)` := matrix.special_linear_group (fin n) R
+
+section slash_invariant_forms
+
+set_option old_structure_cmd true
+
+open modular_form
+
+variables (F : Type*) (Γ : out_param $ subgroup SL(2, ℤ)) (k : out_param ℤ)
+
+/--Functions `ℍ → ℂ` that are invariant under the `slash_action`. -/
+structure slash_invariant_form :=
+(to_fun : ℍ → ℂ)
+(slash_action_eq' : ∀ γ : Γ, to_fun ∣[k] γ = to_fun)
+
+/--`slash_invariant_form_class F Γ k` asserts `F` is a type of bundled functions that are invariant
+under the `slash_action`. -/
+class slash_invariant_form_class extends fun_like F ℍ (λ _, ℂ) :=
+(slash_action_eq : ∀ (f : F) (γ : Γ), (f : ℍ → ℂ) ∣[k] γ = f)
+
+attribute [nolint dangerous_instance] slash_invariant_form_class.to_fun_like
+
+@[priority 100]
+instance slash_invariant_form_class.slash_invariant_form :
+   slash_invariant_form_class (slash_invariant_form Γ k) Γ k :=
+{ coe := slash_invariant_form.to_fun,
+  coe_injective' := λ f g h, by cases f; cases g; congr',
+  slash_action_eq := slash_invariant_form.slash_action_eq' }
+
+variables {F Γ k}
+
+instance : has_coe_to_fun (slash_invariant_form Γ k) (λ _, ℍ → ℂ) := fun_like.has_coe_to_fun
+
+@[simp] lemma slash_invariant_form_to_fun_eq_coe {f : slash_invariant_form Γ k} :
+  f.to_fun = (f : ℍ → ℂ) := rfl
+
+@[ext] theorem slash_invariant_form_ext {f g : slash_invariant_form Γ k} (h : ∀ x, f x = g x) :
+  f = g := fun_like.ext f g h
+
+/-- Copy of a `slash_invariant_form` with a new `to_fun` equal to the old one.
+Useful to fix definitional equalities. -/
+protected def slash_invariant_form.copy (f : slash_invariant_form Γ k) (f' : ℍ → ℂ) (h : f' = ⇑f) :
+  slash_invariant_form Γ k :=
+{ to_fun := f',
+  slash_action_eq' := h.symm ▸ f.slash_action_eq',}
+
+end slash_invariant_forms
+
+namespace slash_invariant_form
+
+open slash_invariant_form
+
+variables {F : Type*} {Γ : out_param $ subgroup SL(2, ℤ)} {k : out_param ℤ}
+
+@[priority 100, nolint dangerous_instance]
+instance slash_invariant_form_class.coe_to_fun [slash_invariant_form_class F Γ k] :
+  has_coe_to_fun F (λ _, ℍ → ℂ) := fun_like.has_coe_to_fun
+
+@[simp] lemma slash_action_eqn [slash_invariant_form_class F Γ k] (f : F) (γ : Γ) :
+  ⇑f ∣[k] γ = ⇑f := slash_invariant_form_class.slash_action_eq f γ
+
+lemma slash_action_eqn' (k : ℤ) (Γ : subgroup SL(2, ℤ)) [slash_invariant_form_class F Γ k] (f : F)
+  (γ : Γ) (z : ℍ) : f (γ • z) = ((↑ₘ[ℤ]γ 1 0 : ℂ) * z +(↑ₘ[ℤ]γ 1 1 : ℂ))^k * f z :=
+begin
+  rw ←modular_form.slash_action_eq'_iff,
+  simp,
+end
+
+instance [slash_invariant_form_class F Γ k] : has_coe_t F (slash_invariant_form Γ k) :=
+⟨λ f, { to_fun := f, slash_action_eq' := slash_action_eqn f }⟩
+
+@[simp] lemma slash_invariant_form_class.coe_coe [slash_invariant_form_class F Γ k] (f : F) :
+  ((f : slash_invariant_form Γ k) : ℍ → ℂ) = f := rfl
+
+instance has_add : has_add (slash_invariant_form Γ k) :=
+⟨ λ f g,
+  { to_fun := f + g,
+    slash_action_eq' := λ γ, by rw [slash_action.add_slash, slash_action_eqn, slash_action_eqn] }⟩
+
+@[simp] lemma coe_add (f g : slash_invariant_form Γ k) : ⇑(f + g) = f + g := rfl
+@[simp] lemma add_apply (f g : slash_invariant_form Γ k) (z : ℍ) : (f + g) z = f z + g z := rfl
+
+instance has_zero : has_zero (slash_invariant_form Γ k) :=
+⟨ { to_fun := 0,
+    slash_action_eq' := slash_action.zero_slash _} ⟩
+
+@[simp] lemma coe_zero : ⇑(0 : slash_invariant_form Γ k) = (0 : ℍ → ℂ) := rfl
+
+section
+variables {α : Type*} [has_smul α ℂ] [is_scalar_tower α ℂ ℂ]
+
+instance has_smul : has_smul α (slash_invariant_form Γ k) :=
+⟨ λ c f,
+  { to_fun := c • f,
+    slash_action_eq' := λ γ, by rw [slash_action.smul_slash_of_tower, slash_action_eqn] }⟩
+
+@[simp] lemma coe_smul (f : slash_invariant_form Γ k) (n : α) : ⇑(n • f) = n • f := rfl
+@[simp] lemma smul_apply (f : slash_invariant_form Γ k) (n : α) (z : ℍ) :
+  (n • f) z = n • (f z) := rfl
+
+end
+
+instance has_neg : has_neg (slash_invariant_form Γ k) :=
+⟨ λ f,
+  { to_fun := -f,
+    slash_action_eq' := λ γ, by rw [slash_action.neg_slash, slash_action_eqn] } ⟩
+
+@[simp] lemma coe_neg (f : slash_invariant_form Γ k) : ⇑(-f) = -f := rfl
+@[simp] lemma neg_apply (f : slash_invariant_form Γ k) (z : ℍ) : (-f) z = - (f z) := rfl
+
+instance has_sub : has_sub (slash_invariant_form Γ k) := ⟨ λ f g, f + -g ⟩
+
+@[simp] lemma coe_sub (f g : slash_invariant_form Γ k) : ⇑(f - g) = f - g := rfl
+@[simp] lemma sub_apply (f g : slash_invariant_form Γ k) (z : ℍ) : (f - g) z = f z - g z := rfl
+
+instance : add_comm_group (slash_invariant_form Γ k) :=
+fun_like.coe_injective.add_comm_group _ rfl coe_add coe_neg coe_sub coe_smul coe_smul
+
+/--Additive coercion from `slash_invariant_form` to `ℍ → ℂ`.-/
+def coe_hom : slash_invariant_form Γ k →+ (ℍ → ℂ) :=
+{ to_fun := λ f, f,
+  map_zero' := rfl,
+  map_add' := λ _ _, rfl }
+
+lemma coe_hom_injective : function.injective (@coe_hom Γ k) :=
+fun_like.coe_injective
+
+instance : module ℂ (slash_invariant_form Γ k) :=
+coe_hom_injective.module ℂ coe_hom (λ _ _, rfl)
+
+instance : has_one (slash_invariant_form Γ 0) :=
+⟨ { to_fun := 1,
+    slash_action_eq' := λ A, modular_form.is_invariant_one A } ⟩
+
+@[simp] lemma one_coe_eq_one : ((1 : slash_invariant_form Γ 0) : ℍ → ℂ) = 1 := rfl
+
+instance : inhabited (slash_invariant_form Γ k) := ⟨0⟩
+
+end slash_invariant_form
diff --git a/src/number_theory/multiplicity.lean b/src/number_theory/multiplicity.lean
new file mode 100644
index 0000000000000..8231f6de58a91
--- /dev/null
+++ b/src/number_theory/multiplicity.lean
@@ -0,0 +1,413 @@
+/-
+Copyright (c) 2022 Tian Chen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Tian Chen, Mantas Bakšys
+-/
+import algebra.geom_sum
+import data.int.parity
+import data.zmod.basic
+import number_theory.padics.padic_val
+import ring_theory.ideal.quotient_operations
+
+/-!
+# Multiplicity in Number Theory
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains results in number theory relating to multiplicity.
+
+## Main statements
+
+* `multiplicity.int.pow_sub_pow` is the lifting the exponent lemma for odd primes.
+  We also prove several variations of the lemma.
+
+## References
+
+* [Wikipedia, *Lifting-the-exponent lemma*]
+  (https://en.wikipedia.org/wiki/Lifting-the-exponent_lemma)
+-/
+
+open ideal ideal.quotient finset
+open_locale big_operators
+
+variables {R : Type*} {n : ℕ}
+
+
+section comm_ring
+variables [comm_ring R] {a b x y : R}
+
+
+lemma dvd_geom_sum₂_iff_of_dvd_sub {x y p : R} (h : p ∣ x - y) :
+  p ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i) ↔ p ∣ n * y ^ (n - 1) :=
+begin
+  rw [← mem_span_singleton, ← ideal.quotient.eq] at h,
+  simp only [← mem_span_singleton, ← eq_zero_iff_mem, ring_hom.map_geom_sum₂, h, geom_sum₂_self,
+    _root_.map_mul, map_pow, map_nat_cast]
+end
+
+lemma dvd_geom_sum₂_iff_of_dvd_sub' {x y p : R} (h : p ∣ x - y) :
+  p ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i) ↔ p ∣ n * x ^ (n - 1) :=
+by rw [geom_sum₂_comm, dvd_geom_sum₂_iff_of_dvd_sub]; simpa using h.neg_right
+
+lemma dvd_geom_sum₂_self {x y : R} (h : ↑n ∣ x - y) : ↑n ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i):=
+(dvd_geom_sum₂_iff_of_dvd_sub h).mpr (dvd_mul_right _ _)
+
+lemma sq_dvd_add_pow_sub_sub (p x : R) (n : ℕ) :
+  p ^ 2 ∣ (x + p) ^ n - x ^ (n - 1) * p * n - x ^ n :=
+begin
+  cases n,
+  { simp only [pow_zero, nat.cast_zero, mul_zero, sub_zero, sub_self, dvd_zero]},
+  { simp only [nat.succ_sub_succ_eq_sub, tsub_zero, nat.cast_succ, add_pow,
+      finset.sum_range_succ, nat.choose_self, nat.succ_sub _, tsub_self, pow_one,
+      nat.choose_succ_self_right, pow_zero, mul_one, nat.cast_zero, zero_add, nat.succ_eq_add_one],
+    suffices : p ^ 2 ∣ ∑ (i : ℕ) in range n, x ^ i * p ^ (n + 1 - i) * ↑((n + 1).choose i),
+    { convert this; abel },
+    { apply finset.dvd_sum,
+      intros y hy,
+      calc p ^ 2 ∣ p ^ (n + 1 - y) : pow_dvd_pow p (le_tsub_of_add_le_left
+        (by linarith [finset.mem_range.mp hy]))
+      ... ∣ x ^ y * p ^ (n + 1 - y) * ↑((n + 1).choose y) : dvd_mul_of_dvd_left (dvd_mul_left _ _)
+        ((n + 1).choose y) }}
+end
+
+lemma not_dvd_geom_sum₂ {p : R} (hp : prime p)
+  (hxy : p ∣ x - y) (hx : ¬p ∣ x) (hn : ¬p ∣ n) :
+  ¬p ∣ ∑ i in range n, x ^ i * y ^ (n - 1 - i) :=
+λ h, hx $ hp.dvd_of_dvd_pow $
+(hp.dvd_or_dvd $ (dvd_geom_sum₂_iff_of_dvd_sub' hxy).mp h).resolve_left hn
+
+variables {p : ℕ} (a b)
+
+lemma odd_sq_dvd_geom_sum₂_sub (hp : odd p) :
+  ↑p ^ 2 ∣ ∑ i in range p, (a + p * b) ^ i * a ^ (p - 1 - i) - p * a ^ (p - 1) :=
+begin
+  have h1 : ∀ i, ↑p ^ 2 ∣ (a + ↑p * b) ^ i - (a ^ (i - 1) * (↑p * b) * ↑i + a ^ i),
+  { intro i,
+    calc ↑p ^ 2 ∣ (↑p * b) ^ 2 : by simp only [mul_pow, dvd_mul_right]
+    ... ∣ (a + ↑p * b) ^ i - (a ^ (i - 1) * (↑p * b) * ↑i + a ^ i) :
+      by simp only [sq_dvd_add_pow_sub_sub (↑p * b) a i, ← sub_sub] },
+  simp_rw [← mem_span_singleton, ← ideal.quotient.eq] at *,
+  calc ideal.quotient.mk (span {↑p ^ 2}) (∑ i in range p, (a + ↑p * b) ^ i * a ^ (p - 1 - i))
+      = ∑ (i : ℕ) in finset.range p, mk (span {↑p ^ 2})
+          ((a ^ (i - 1) * (↑p * b) * ↑i + a ^ i) * a ^ (p - 1 - i)) :
+    by simp_rw [ring_hom.map_geom_sum₂, ← map_pow, h1, ← _root_.map_mul]
+  ... = mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p,
+          a ^ (x - 1) * (a ^ (p - 1 - x) * (↑p * (b * ↑x)))) +
+        mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p, a ^ (x + (p - 1 - x))) :
+    by { ring_exp,
+         simp only [← pow_add, map_add, finset.sum_add_distrib, ← map_sum] }
+  ... = mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p,
+          a ^ (x - 1) * (a ^ (p - 1 - x) * (↑p * (b * ↑x)))) +
+        mk (span {↑ p ^ 2}) ∑ (x : ℕ) in finset.range p, a ^ (p - 1) :
+    by { rw [add_right_inj, finset.sum_congr rfl],
+         intros x hx,
+         rw [← nat.add_sub_assoc _ x, nat.add_sub_cancel_left],
+         exact nat.le_pred_of_lt (finset.mem_range.mp hx) }
+  ... = mk (span {↑p ^ 2}) (∑ (x : ℕ) in finset.range p,
+          a ^ (x - 1) * (a ^ (p - 1 - x) * (↑p * (b * ↑x)))) +
+        mk (span {↑ p ^ 2}) (↑p * a ^ (p - 1)) :
+    by simp only [add_right_inj, finset.sum_const, finset.card_range, nsmul_eq_mul]
+  ... = mk (span {↑p ^ 2}) (↑p * b * ∑ (x : ℕ) in finset.range p, a ^ (p - 2) * x) +
+        mk (span {↑p ^ 2}) (↑p * a ^ (p - 1)) :
+    by { simp only [finset.mul_sum, ← mul_assoc, ← pow_add],
+         rw finset.sum_congr rfl,
+         rintros (⟨⟩|⟨x⟩) hx,
+         { rw [nat.cast_zero, mul_zero, mul_zero] },
+         { have : x.succ - 1 + (p - 1 - x.succ) = p - 2,
+           { rw ← nat.add_sub_assoc (nat.le_pred_of_lt (finset.mem_range.mp hx)),
+             exact congr_arg nat.pred (nat.add_sub_cancel_left _ _)},
+           rw this,
+           ring_exp_eq }}
+  ... = mk (span {↑p ^ 2}) (↑p * a ^ (p - 1)) :
+    by { simp only [add_left_eq_self, ← finset.mul_sum],
+         norm_cast,
+         simp only [finset.sum_range_id, nat.cast_mul, _root_.map_mul,
+           nat.mul_div_assoc _ (even_iff_two_dvd.mp (nat.odd.sub_odd hp odd_one))],
+         ring_exp,
+         simp only [← map_pow, mul_eq_zero_of_left, ideal.quotient.eq_zero_iff_mem,
+           mem_span_singleton] }
+end
+
+
+namespace multiplicity
+
+section integral_domain
+variables [is_domain R] [@decidable_rel R (∣)]
+
+lemma pow_sub_pow_of_prime {p : R} (hp : prime p) {x y : R} (hxy : p ∣ x - y) (hx : ¬p ∣ x)
+  {n : ℕ} (hn : ¬p ∣ n) :
+  multiplicity p (x ^ n - y ^ n) = multiplicity p (x - y) :=
+by rw [←geom_sum₂_mul, multiplicity.mul hp,
+  multiplicity_eq_zero.2 (not_dvd_geom_sum₂ hp hxy hx hn), zero_add]
+
+variables (hp : prime (p : R)) (hp1 : odd p) (hxy : ↑p ∣ x - y) (hx : ¬↑p ∣ x)
+include hp hp1 hxy hx
+
+lemma geom_sum₂_eq_one : multiplicity ↑p (∑ i in range p, x ^ i * y ^ (p - 1 - i)) = 1 :=
+begin
+  rw ← nat.cast_one,
+  refine multiplicity.eq_coe_iff.2 ⟨_, _⟩,
+  { rw pow_one,
+    exact dvd_geom_sum₂_self hxy },
+  rw dvd_iff_dvd_of_dvd_sub hxy at hx,
+  cases hxy with k hk,
+  rw [one_add_one_eq_two, eq_add_of_sub_eq' hk],
+  refine mt (dvd_iff_dvd_of_dvd_sub (@odd_sq_dvd_geom_sum₂_sub _ _ y k _ hp1)).mp _,
+  rw [pow_two, mul_dvd_mul_iff_left hp.ne_zero],
+  exact mt hp.dvd_of_dvd_pow hx
+end
+
+lemma pow_prime_sub_pow_prime : multiplicity ↑p (x ^ p - y ^ p) = multiplicity ↑p (x - y) + 1 :=
+by rw [←geom_sum₂_mul, multiplicity.mul hp, geom_sum₂_eq_one hp hp1 hxy hx, add_comm]
+
+lemma pow_prime_pow_sub_pow_prime_pow (a : ℕ) :
+  multiplicity ↑p (x ^ p ^ a - y ^ p ^ a) = multiplicity ↑p (x - y) + a :=
+begin
+  induction a with a h_ind,
+  { rw [nat.cast_zero, add_zero, pow_zero, pow_one, pow_one] },
+  rw [←nat.add_one, nat.cast_add, nat.cast_one, ←add_assoc, ←h_ind, pow_succ', pow_mul, pow_mul],
+  apply pow_prime_sub_pow_prime hp hp1,
+  { rw ←geom_sum₂_mul,
+    exact dvd_mul_of_dvd_right hxy _ },
+  { exact λ h, hx (hp.dvd_of_dvd_pow h) }
+end
+
+end integral_domain
+
+section lifting_the_exponent
+variables (hp : nat.prime p) (hp1 : odd p)
+include hp hp1
+
+/-- **Lifting the exponent lemma** for odd primes. -/
+lemma int.pow_sub_pow {x y : ℤ} (hxy : ↑p ∣ x - y) (hx : ¬↑p ∣ x) (n : ℕ) :
+  multiplicity ↑p (x ^ n - y ^ n) = multiplicity ↑p (x - y) + multiplicity p n :=
+begin
+  cases n,
+  { simp only [multiplicity.zero, add_top, pow_zero, sub_self] },
+  have h : (multiplicity _ _).dom := finite_nat_iff.mpr ⟨hp.ne_one, n.succ_pos⟩,
+  rcases eq_coe_iff.mp (part_enat.coe_get h).symm with ⟨⟨k, hk⟩, hpn⟩,
+  conv_lhs { rw [hk, pow_mul, pow_mul] },
+  rw nat.prime_iff_prime_int at hp,
+  rw [pow_sub_pow_of_prime hp, pow_prime_pow_sub_pow_prime_pow hp hp1 hxy hx, part_enat.coe_get],
+  { rw ←geom_sum₂_mul,
+    exact dvd_mul_of_dvd_right hxy _ },
+  { exact λ h, hx (hp.dvd_of_dvd_pow h) },
+  { rw int.coe_nat_dvd,
+    rintro ⟨c, rfl⟩,
+    refine hpn ⟨c, _⟩,
+    rwa [pow_succ', mul_assoc] }
+end
+lemma int.pow_add_pow {x y : ℤ} (hxy : ↑p ∣ x + y) (hx : ¬↑p ∣ x) {n : ℕ} (hn : odd n) :
+  multiplicity ↑p (x ^ n + y ^ n) = multiplicity ↑p (x + y) + multiplicity p n :=
+begin
+  rw ←sub_neg_eq_add at hxy,
+  rw [←sub_neg_eq_add, ←sub_neg_eq_add, ←odd.neg_pow hn],
+  exact int.pow_sub_pow hp hp1 hxy hx n
+end
+
+lemma nat.pow_sub_pow {x y : ℕ} (hxy : p ∣ x - y) (hx : ¬p ∣ x) (n : ℕ) :
+  multiplicity p (x ^ n - y ^ n) = multiplicity p (x - y) + multiplicity p n :=
+begin
+  obtain hyx | hyx := le_total y x,
+ { iterate 2 { rw ← int.coe_nat_multiplicity },
+    rw int.coe_nat_sub (nat.pow_le_pow_of_le_left hyx n),
+    rw ← int.coe_nat_dvd at hxy hx,
+    push_cast at *,
+    exact int.pow_sub_pow hp hp1 hxy hx n },
+  { simp only [nat.sub_eq_zero_iff_le.mpr hyx,
+      nat.sub_eq_zero_iff_le.mpr (nat.pow_le_pow_of_le_left hyx n), multiplicity.zero,
+      part_enat.top_add] }
+end
+
+lemma nat.pow_add_pow {x y : ℕ} (hxy : p ∣ x + y) (hx : ¬p ∣ x) {n : ℕ} (hn : odd n) :
+  multiplicity p (x ^ n + y ^ n) = multiplicity p (x + y) + multiplicity p n :=
+begin
+  iterate 2 { rw [←int.coe_nat_multiplicity] },
+  rw ←int.coe_nat_dvd at hxy hx,
+  push_cast at *,
+  exact int.pow_add_pow hp hp1 hxy hx hn
+end
+
+end lifting_the_exponent
+end multiplicity
+end comm_ring
+
+lemma pow_two_pow_sub_pow_two_pow [comm_ring R] {x y : R} (n : ℕ) :
+  x ^ (2 ^ n) - y ^ (2 ^ n) = (∏ i in finset.range n, (x ^ (2 ^ i) + y ^ (2 ^ i))) * (x - y) :=
+begin
+  induction n with d hd,
+  { simp only [pow_zero, pow_one, finset.range_zero, finset.prod_empty, one_mul] },
+  { suffices : x ^ 2 ^ d.succ - y ^ 2 ^ d.succ = (x ^ 2 ^ d + y ^ 2 ^ d) * (x ^ 2 ^ d - y ^ 2 ^ d),
+    { rw [this, hd, finset.prod_range_succ, ← mul_assoc, mul_comm (x ^ 2 ^ d + y ^ 2 ^ d)] },
+    { ring_exp_eq } }
+end
+
+lemma _root_.int.sq_mod_four_eq_one_of_odd {x : ℤ} : odd x → x ^ 2 % 4 = 1 :=
+begin
+  intro hx,
+  -- Replace `x : ℤ` with `y : zmod 4`
+  replace hx : x % (2 : ℕ) = 1 % (2 : ℕ), { rw int.odd_iff at hx, norm_num [hx] },
+  calc x^2 % (4 : ℕ)
+      = 1 % (4 : ℕ) : _
+  ... = 1 : by norm_num,
+  rw ← zmod.int_coe_eq_int_coe_iff' at hx ⊢,
+  push_cast,
+  rw [← map_int_cast (zmod.cast_hom (show 2 ∣ 4, by norm_num) (zmod 2)) x] at hx,
+  set y : zmod 4 := x,
+  change zmod.cast_hom _ (zmod 2) y = _ at hx,
+  -- Now we can just consider each of the 4 possible values for y
+  fin_cases y using hy;
+    rw hy at ⊢ hx; revert hx; dec_trivial
+end
+
+lemma int.two_pow_two_pow_add_two_pow_two_pow {x y : ℤ}
+  (hx : ¬ 2 ∣ x) (hxy : 4 ∣ (x - y))
+  (i : ℕ) : multiplicity 2 (x ^ 2 ^ i + y ^ 2 ^ i) = ↑(1 : ℕ) :=
+begin
+  have hx_odd : odd x, { rwa [int.odd_iff_not_even, even_iff_two_dvd] },
+  have hxy_even : even (x - y) := even_iff_two_dvd.mpr (dvd_trans (by norm_num) hxy),
+  have hy_odd : odd y := by simpa using hx_odd.sub_even hxy_even,
+  refine multiplicity.eq_coe_iff.mpr ⟨_, _⟩,
+  { rw [pow_one, ← even_iff_two_dvd],
+    exact (hx_odd.pow).add_odd hy_odd.pow },
+  cases i with i,
+  { intro hxy',
+    have : 2 * 2 ∣ 2 * x, { convert dvd_add hxy hxy', ring_exp },
+    have : 2 ∣ x := (mul_dvd_mul_iff_left (by norm_num)).mp this,
+    contradiction },
+  suffices : ∀ (x : ℤ), odd x → x ^ (2 ^ (i + 1)) % 4 = 1,
+  { rw [show (2 ^ (1 + 1) : ℤ) = 4, by norm_num, int.dvd_iff_mod_eq_zero, int.add_mod,
+        this _ hx_odd, this _ hy_odd],
+    norm_num },
+  intros x hx,
+  rw [pow_succ, mul_comm, pow_mul, int.sq_mod_four_eq_one_of_odd hx.pow]
+end
+
+lemma int.two_pow_two_pow_sub_pow_two_pow {x y : ℤ} (n : ℕ) (hxy : 4 ∣ x - y) (hx : ¬ 2 ∣ x) :
+  multiplicity 2 (x ^ (2 ^ n) - y ^ (2 ^ n)) = multiplicity 2 (x - y) + n :=
+by simp only [pow_two_pow_sub_pow_two_pow  n, multiplicity.mul int.prime_two,
+    multiplicity.finset.prod (int.prime_two), add_comm, nat.cast_one, finset.sum_const,
+    finset.card_range, nsmul_one, int.two_pow_two_pow_add_two_pow_two_pow hx hxy]
+
+lemma int.two_pow_sub_pow' {x y : ℤ} (n : ℕ) (hxy : 4 ∣ x - y) (hx : ¬ 2 ∣ x) :
+  multiplicity 2 (x ^ n - y ^ n) = multiplicity 2 (x - y) + multiplicity (2 : ℤ) n :=
+begin
+  have hx_odd : odd x, { rwa [int.odd_iff_not_even, even_iff_two_dvd] },
+  have hxy_even : even (x - y) := even_iff_two_dvd.mpr (dvd_trans (by norm_num) hxy),
+  have hy_odd : odd y := by simpa using hx_odd.sub_even hxy_even,
+  cases n,
+  { simp only [pow_zero, sub_self, multiplicity.zero, int.coe_nat_zero, part_enat.add_top] },
+  have h : (multiplicity 2 n.succ).dom := multiplicity.finite_nat_iff.mpr ⟨by norm_num, n.succ_pos⟩,
+  rcases multiplicity.eq_coe_iff.mp (part_enat.coe_get h).symm with ⟨⟨k, hk⟩, hpn⟩,
+  rw [hk, pow_mul, pow_mul, multiplicity.pow_sub_pow_of_prime,
+      int.two_pow_two_pow_sub_pow_two_pow _ hxy hx,
+      ← hk, part_enat.coe_get],
+  { norm_cast },
+  { exact int.prime_two },
+  { simpa only [even_iff_two_dvd] using hx_odd.pow.sub_odd hy_odd.pow },
+  { simpa only [even_iff_two_dvd, int.odd_iff_not_even] using hx_odd.pow },
+  erw [int.coe_nat_dvd], -- `erw` to deal with `2 : ℤ` vs `(2 : ℕ) : ℤ`
+  contrapose! hpn,
+  rw pow_succ',
+  conv_rhs { rw hk },
+  exact mul_dvd_mul_left _ hpn
+end
+
+/-- **Lifting the exponent lemma** for `p = 2` -/
+lemma int.two_pow_sub_pow {x y : ℤ} {n : ℕ} (hxy : 2 ∣ x - y) (hx : ¬ 2 ∣ x) (hn : even n) :
+  multiplicity 2 (x ^ n - y ^ n) + 1 = multiplicity 2 (x + y) + multiplicity 2 (x - y) +
+    multiplicity (2 : ℤ) n :=
+begin
+  have hy : odd y,
+  { rw [← even_iff_two_dvd, ← int.odd_iff_not_even] at hx,
+    replace hxy := (@even_neg _ _ (x - y)).mpr (even_iff_two_dvd.mpr hxy),
+    convert even.add_odd hxy hx,
+    abel },
+  cases hn with d hd,
+  subst hd,
+  simp only [← two_mul, pow_mul],
+  have hxy4 : 4 ∣ x ^ 2 - y ^ 2,
+  { rw [int.dvd_iff_mod_eq_zero, int.sub_mod, int.sq_mod_four_eq_one_of_odd _,
+      int.sq_mod_four_eq_one_of_odd hy],
+    { norm_num },
+    { simp only [int.odd_iff_not_even, even_iff_two_dvd, hx, not_false_iff] }},
+  rw [int.two_pow_sub_pow' d hxy4 _, sq_sub_sq, ← int.coe_nat_mul_out,
+    multiplicity.mul (int.prime_two), multiplicity.mul (int.prime_two)],
+  suffices : multiplicity (2 : ℤ) ↑(2 : ℕ) = 1,
+  { rw [this, add_comm (1 : part_enat), ← add_assoc] },
+  { norm_cast,
+    rw multiplicity.multiplicity_self _ _,
+    { apply prime.not_unit,
+      simp only [← nat.prime_iff, nat.prime_two] },
+    { exact two_ne_zero }},
+  { rw [← even_iff_two_dvd, ← int.odd_iff_not_even],
+    apply odd.pow,
+    simp only [int.odd_iff_not_even, even_iff_two_dvd, hx, not_false_iff] }
+end
+
+lemma nat.two_pow_sub_pow {x y : ℕ} (hxy : 2 ∣ x - y) (hx : ¬2 ∣ x) {n : ℕ} (hn : even n) :
+  multiplicity 2 (x ^ n - y ^ n) + 1 = multiplicity 2 (x + y) + multiplicity 2 (x - y) +
+    multiplicity 2 n :=
+begin
+  obtain hyx | hyx := le_total y x,
+  { iterate 3 { rw ←multiplicity.int.coe_nat_multiplicity },
+    have hxyn : y ^ n ≤ x ^ n := pow_le_pow_of_le_left' hyx _,
+    simp only [int.coe_nat_sub hyx, int.coe_nat_sub (pow_le_pow_of_le_left' hyx _), int.coe_nat_add,
+      int.coe_nat_pow],
+    rw ←int.coe_nat_dvd at hx,
+    rw [←int.coe_nat_dvd, int.coe_nat_sub hyx] at hxy,
+    convert int.two_pow_sub_pow hxy hx hn using 2,
+    rw ← multiplicity.int.coe_nat_multiplicity,
+    refl },
+  { simp only [nat.sub_eq_zero_iff_le.mpr hyx,
+      nat.sub_eq_zero_iff_le.mpr (pow_le_pow_of_le_left' hyx n), multiplicity.zero,
+      part_enat.top_add, part_enat.add_top] }
+end
+
+namespace padic_val_nat
+
+variables {x y : ℕ}
+
+lemma pow_two_sub_pow (hyx : y < x) (hxy : 2 ∣ x - y) (hx : ¬ 2 ∣ x) {n : ℕ} (hn : 0 < n)
+  (hneven : even n) :
+  padic_val_nat 2 (x ^ n - y ^ n) + 1 =
+    padic_val_nat 2 (x + y) + padic_val_nat 2 (x - y) + padic_val_nat 2 n :=
+begin
+  simp only [←part_enat.coe_inj, nat.cast_add],
+  iterate 4 { rw [padic_val_nat_def, part_enat.coe_get] },
+  { convert nat.two_pow_sub_pow hxy hx hneven using 2 },
+  { exact hn },
+  { exact (nat.sub_pos_of_lt hyx) },
+  { linarith },
+  { simp only [tsub_pos_iff_lt, pow_lt_pow_of_lt_left hyx (@zero_le' _ y _) hn] }
+end
+
+variables {p : ℕ} [hp : fact p.prime] (hp1 : odd p)
+include hp hp1
+
+lemma pow_sub_pow (hyx : y < x) (hxy : p ∣ x - y) (hx : ¬p ∣ x) {n : ℕ} (hn : 0 < n) :
+  padic_val_nat p (x ^ n - y ^ n) = padic_val_nat p (x - y) + padic_val_nat p n :=
+begin
+  rw [←part_enat.coe_inj, nat.cast_add],
+  iterate 3 { rw [padic_val_nat_def, part_enat.coe_get] },
+  { exact multiplicity.nat.pow_sub_pow hp.out hp1 hxy hx n },
+  { exact hn },
+  { exact nat.sub_pos_of_lt hyx },
+  { exact nat.sub_pos_of_lt (nat.pow_lt_pow_of_lt_left hyx hn) }
+end
+
+lemma pow_add_pow (hxy : p ∣ x + y) (hx : ¬p ∣ x) {n : ℕ} (hn : odd n) :
+  padic_val_nat p (x ^ n + y ^ n) = padic_val_nat p (x + y) + padic_val_nat p n :=
+begin
+  cases y,
+  { have := dvd_zero p, contradiction },
+  rw [←part_enat.coe_inj, nat.cast_add],
+  iterate 3 { rw [padic_val_nat_def, part_enat.coe_get] },
+  { exact multiplicity.nat.pow_add_pow hp.out hp1 hxy hx hn },
+  { exact (odd.pos hn) },
+  { simp only [add_pos_iff, nat.succ_pos', or_true] },
+  { exact (nat.lt_add_left _ _ _ (pow_pos y.succ_pos _)) }
+end
+
+end padic_val_nat
diff --git a/src/number_theory/number_field.lean b/src/number_theory/number_field.lean
deleted file mode 100644
index ff728d4bf992c..0000000000000
--- a/src/number_theory/number_field.lean
+++ /dev/null
@@ -1,144 +0,0 @@
-/-
-Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Ashvni Narayanan, Anne Baanen
--/
-
-import algebra.field.basic
-import data.rat.basic
-import ring_theory.algebraic
-import ring_theory.dedekind_domain.integral_closure
-import ring_theory.integral_closure
-import ring_theory.polynomial.rational_root
-
-/-!
-# Number fields
-This file defines a number field and the ring of integers corresponding to it.
-
-## Main definitions
- - `number_field` defines a number field as a field which has characteristic zero and is finite
-    dimensional over ℚ.
- - `ring_of_integers` defines the ring of integers (or number ring) corresponding to a number field
-    as the integral closure of ℤ in the number field.
-
-## Implementation notes
-The definitions that involve a field of fractions choose a canonical field of fractions,
-but are independent of that choice.
-
-## References
-* [D. Marcus, *Number Fields*][marcus1977number]
-* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
-* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]
-
-## Tags
-number field, ring of integers
--/
-
-/-- A number field is a field which has characteristic zero and is finite
-dimensional over ℚ. -/
-class number_field (K : Type*) [field K] : Prop :=
-[to_char_zero : char_zero K]
-[to_finite_dimensional : finite_dimensional ℚ K]
-
-open function
-open_locale classical big_operators
-
-/-- `ℤ` with its usual ring structure is not a field. -/
-lemma int.not_is_field : ¬ is_field ℤ :=
-λ h, int.not_even_one $ (h.mul_inv_cancel two_ne_zero).imp $ λ a, (by rw ← two_mul; exact eq.symm)
-
-namespace number_field
-
-variables (K L : Type*) [field K] [field L] [nf : number_field K]
-
-include nf
-
--- See note [lower instance priority]
-attribute [priority 100, instance] number_field.to_char_zero number_field.to_finite_dimensional
-
-protected lemma is_algebraic : algebra.is_algebraic ℚ K := algebra.is_algebraic_of_finite _ _
-
-omit nf
-
-/-- The ring of integers (or number ring) corresponding to a number field
-is the integral closure of ℤ in the number field. -/
-def ring_of_integers := integral_closure ℤ K
-
-localized "notation `𝓞` := number_field.ring_of_integers" in number_field
-
-lemma mem_ring_of_integers (x : K) : x ∈ 𝓞 K ↔ is_integral ℤ x := iff.rfl
-
-/-- Given an algebra between two fields, create an algebra between their two rings of integers.
-
-For now, this is not an instance by default as it creates an equal-but-not-defeq diamond with
-`algebra.id` when `K = L`. This is caused by `x = ⟨x, x.prop⟩` not being defeq on subtypes. This
-will likely change in Lean 4. -/
-def ring_of_integers_algebra [algebra K L] : algebra (𝓞 K) (𝓞 L) := ring_hom.to_algebra
-{ to_fun := λ k, ⟨algebra_map K L k, is_integral.algebra_map k.2⟩,
-  map_zero' := subtype.ext $ by simp only [subtype.coe_mk, subalgebra.coe_zero, map_zero],
-  map_one'  := subtype.ext $ by simp only [subtype.coe_mk, subalgebra.coe_one, map_one],
-  map_add' := λ x y, subtype.ext $ by simp only [map_add, subalgebra.coe_add, subtype.coe_mk],
-  map_mul' := λ x y, subtype.ext $ by simp only [subalgebra.coe_mul, map_mul, subtype.coe_mk] }
-
-namespace ring_of_integers
-
-variables {K}
-
-instance [number_field K] : is_fraction_ring (𝓞 K) K :=
-integral_closure.is_fraction_ring_of_finite_extension ℚ _
-
-instance : is_integral_closure (𝓞 K) ℤ K :=
-integral_closure.is_integral_closure _ _
-
-instance [number_field K] : is_integrally_closed (𝓞 K) :=
-integral_closure.is_integrally_closed_of_finite_extension ℚ
-
-lemma is_integral_coe (x : 𝓞 K) : is_integral ℤ (x : K) :=
-x.2
-
-/-- The ring of integers of `K` are equivalent to any integral closure of `ℤ` in `K` -/
-protected noncomputable def equiv (R : Type*) [comm_ring R] [algebra R K]
-  [is_integral_closure R ℤ K] : 𝓞 K ≃+* R :=
-(is_integral_closure.equiv ℤ R K _).symm.to_ring_equiv
-
-variables (K)
-
-instance [number_field K] : char_zero (𝓞 K) := char_zero.of_module _ K
-
-/-- The ring of integers of a number field is not a field. -/
-lemma not_is_field [number_field K] : ¬ is_field (𝓞 K) :=
-begin
-  have h_inj : function.injective ⇑(algebra_map ℤ (𝓞 K)),
-  { exact ring_hom.injective_int (algebra_map ℤ (𝓞 K)) },
-  intro hf,
-  exact int.not_is_field ((is_integral.is_field_iff_is_field
-    (is_integral_closure.is_integral_algebra ℤ K) h_inj).mpr hf)
-end
-
-instance [number_field K] : is_dedekind_domain (𝓞 K) :=
-is_integral_closure.is_dedekind_domain ℤ ℚ K _
-
-end ring_of_integers
-
-end number_field
-
-namespace rat
-
-open number_field
-
-local attribute [instance] subsingleton_rat_module
-
-instance rat.number_field : number_field ℚ :=
-{ to_char_zero := infer_instance,
-  to_finite_dimensional :=
-    -- The vector space structure of `ℚ` over itself can arise in multiple ways:
-    -- all fields are vector spaces over themselves (used in `rat.finite_dimensional`)
-    -- all char 0 fields have a canonical embedding of `ℚ` (used in `number_field`).
-    -- Show that these coincide:
-    by convert (infer_instance : finite_dimensional ℚ ℚ), }
-
-/-- The ring of integers of `ℚ` as a number field is just `ℤ`. -/
-noncomputable def ring_of_integers_equiv : ring_of_integers ℚ ≃+* ℤ :=
-ring_of_integers.equiv ℤ
-
-end rat
diff --git a/src/number_theory/number_field/basic.lean b/src/number_theory/number_field/basic.lean
new file mode 100644
index 0000000000000..a426ce89fb1e7
--- /dev/null
+++ b/src/number_theory/number_field/basic.lean
@@ -0,0 +1,198 @@
+/-
+Copyright (c) 2021 Ashvni Narayanan. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ashvni Narayanan, Anne Baanen
+-/
+import algebra.char_p.algebra
+import ring_theory.dedekind_domain.integral_closure
+
+/-!
+# Number fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+This file defines a number field and the ring of integers corresponding to it.
+
+## Main definitions
+ - `number_field` defines a number field as a field which has characteristic zero and is finite
+    dimensional over ℚ.
+ - `ring_of_integers` defines the ring of integers (or number ring) corresponding to a number field
+    as the integral closure of ℤ in the number field.
+
+## Implementation notes
+The definitions that involve a field of fractions choose a canonical field of fractions,
+but are independent of that choice.
+
+## References
+* [D. Marcus, *Number Fields*][marcus1977number]
+* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
+* [P. Samuel, *Algebraic Theory of Numbers*][samuel1970algebraic]
+
+## Tags
+number field, ring of integers
+-/
+
+/-- A number field is a field which has characteristic zero and is finite
+dimensional over ℚ. -/
+class number_field (K : Type*) [field K] : Prop :=
+[to_char_zero : char_zero K]
+[to_finite_dimensional : finite_dimensional ℚ K]
+
+open function module
+open_locale classical big_operators non_zero_divisors
+
+/-- `ℤ` with its usual ring structure is not a field. -/
+lemma int.not_is_field : ¬ is_field ℤ :=
+λ h, int.not_even_one $ (h.mul_inv_cancel two_ne_zero).imp $ λ a, (by rw ← two_mul; exact eq.symm)
+
+namespace number_field
+
+variables (K L : Type*) [field K] [field L] [nf : number_field K]
+
+include nf
+
+-- See note [lower instance priority]
+attribute [priority 100, instance] number_field.to_char_zero number_field.to_finite_dimensional
+
+protected lemma is_algebraic : algebra.is_algebraic ℚ K := algebra.is_algebraic_of_finite _ _
+
+omit nf
+
+/-- The ring of integers (or number ring) corresponding to a number field
+is the integral closure of ℤ in the number field. -/
+def ring_of_integers := integral_closure ℤ K
+
+localized "notation (name := ring_of_integers)
+  `𝓞` := number_field.ring_of_integers" in number_field
+
+lemma mem_ring_of_integers (x : K) : x ∈ 𝓞 K ↔ is_integral ℤ x := iff.rfl
+
+lemma is_integral_of_mem_ring_of_integers {K : Type*} [field K] {x : K} (hx : x ∈ 𝓞 K) :
+  is_integral ℤ (⟨x, hx⟩ : 𝓞 K) :=
+begin
+  obtain ⟨P, hPm, hP⟩ := hx,
+  refine ⟨P, hPm, _⟩,
+  rw [← polynomial.aeval_def, ← subalgebra.coe_eq_zero, polynomial.aeval_subalgebra_coe,
+    polynomial.aeval_def,  subtype.coe_mk, hP]
+end
+
+/-- Given an algebra between two fields, create an algebra between their two rings of integers.
+
+For now, this is not an instance by default as it creates an equal-but-not-defeq diamond with
+`algebra.id` when `K = L`. This is caused by `x = ⟨x, x.prop⟩` not being defeq on subtypes. This
+will likely change in Lean 4. -/
+def ring_of_integers_algebra [algebra K L] : algebra (𝓞 K) (𝓞 L) := ring_hom.to_algebra
+{ to_fun := λ k, ⟨algebra_map K L k, is_integral.algebra_map k.2⟩,
+  map_zero' := subtype.ext $ by simp only [subtype.coe_mk, subalgebra.coe_zero, map_zero],
+  map_one'  := subtype.ext $ by simp only [subtype.coe_mk, subalgebra.coe_one, map_one],
+  map_add' := λ x y, subtype.ext $ by simp only [map_add, subalgebra.coe_add, subtype.coe_mk],
+  map_mul' := λ x y, subtype.ext $ by simp only [subalgebra.coe_mul, map_mul, subtype.coe_mk] }
+
+namespace ring_of_integers
+
+variables {K}
+
+instance [number_field K] : is_fraction_ring (𝓞 K) K :=
+integral_closure.is_fraction_ring_of_finite_extension ℚ _
+
+instance : is_integral_closure (𝓞 K) ℤ K :=
+integral_closure.is_integral_closure _ _
+
+instance [number_field K] : is_integrally_closed (𝓞 K) :=
+integral_closure.is_integrally_closed_of_finite_extension ℚ
+
+lemma is_integral_coe (x : 𝓞 K) : is_integral ℤ (x : K) :=
+x.2
+
+lemma map_mem {F L : Type*} [field L] [char_zero K] [char_zero L]
+  [alg_hom_class F ℚ K L] (f : F) (x : 𝓞 K) : f x ∈ 𝓞 L :=
+(mem_ring_of_integers _ _).2 $ map_is_integral_int f $ ring_of_integers.is_integral_coe x
+
+/-- The ring of integers of `K` are equivalent to any integral closure of `ℤ` in `K` -/
+protected noncomputable def equiv (R : Type*) [comm_ring R] [algebra R K]
+  [is_integral_closure R ℤ K] : 𝓞 K ≃+* R :=
+(is_integral_closure.equiv ℤ R K _).symm.to_ring_equiv
+
+variable (K)
+include nf
+
+instance : char_zero (𝓞 K) := char_zero.of_module _ K
+
+instance : is_noetherian ℤ (𝓞 K) := is_integral_closure.is_noetherian _ ℚ K _
+
+/-- The ring of integers of a number field is not a field. -/
+lemma not_is_field : ¬ is_field (𝓞 K) :=
+begin
+  have h_inj : function.injective ⇑(algebra_map ℤ (𝓞 K)),
+  { exact ring_hom.injective_int (algebra_map ℤ (𝓞 K)) },
+  intro hf,
+  exact int.not_is_field
+    (((is_integral_closure.is_integral_algebra ℤ K).is_field_iff_is_field h_inj).mpr hf)
+end
+
+instance : is_dedekind_domain (𝓞 K) :=
+is_integral_closure.is_dedekind_domain ℤ ℚ K _
+
+instance : free ℤ (𝓞 K) := is_integral_closure.module_free ℤ ℚ K (𝓞 K)
+
+instance : is_localization (algebra.algebra_map_submonoid (𝓞 K) ℤ⁰) K :=
+is_integral_closure.is_localization ℤ ℚ K (𝓞 K)
+
+/-- A ℤ-basis of the ring of integers of `K`. -/
+noncomputable def basis : basis (free.choose_basis_index ℤ (𝓞 K)) ℤ (𝓞 K) :=
+free.choose_basis ℤ (𝓞 K)
+
+end ring_of_integers
+
+include nf
+
+/-- A basis of `K` over `ℚ` that is also a basis of `𝓞 K` over `ℤ`. -/
+noncomputable def integral_basis : basis (free.choose_basis_index ℤ (𝓞 K)) ℚ K :=
+basis.localization_localization ℚ (non_zero_divisors ℤ) K (ring_of_integers.basis K)
+
+@[simp]
+lemma integral_basis_apply (i : free.choose_basis_index ℤ (𝓞 K)) :
+  integral_basis K i = algebra_map (𝓞 K) K (ring_of_integers.basis K i) :=
+basis.localization_localization_apply ℚ (non_zero_divisors ℤ) K (ring_of_integers.basis K) i
+
+lemma ring_of_integers.rank  :
+  finite_dimensional.finrank ℤ (𝓞 K) = finite_dimensional.finrank ℚ K :=
+is_integral_closure.rank ℤ ℚ K (𝓞 K)
+
+end number_field
+
+namespace rat
+
+open number_field
+
+instance number_field : number_field ℚ :=
+{ to_char_zero := infer_instance,
+  to_finite_dimensional :=
+    -- The vector space structure of `ℚ` over itself can arise in multiple ways:
+    -- all fields are vector spaces over themselves (used in `rat.finite_dimensional`)
+    -- all char 0 fields have a canonical embedding of `ℚ` (used in `number_field`).
+    -- Show that these coincide:
+    by convert (infer_instance : finite_dimensional ℚ ℚ), }
+
+/-- The ring of integers of `ℚ` as a number field is just `ℤ`. -/
+noncomputable def ring_of_integers_equiv : ring_of_integers ℚ ≃+* ℤ :=
+ring_of_integers.equiv ℤ
+
+end rat
+
+namespace adjoin_root
+
+section
+
+open_locale polynomial
+
+local attribute [-instance] algebra_rat
+
+/-- The quotient of `ℚ[X]` by the ideal generated by an irreducible polynomial of `ℚ[X]`
+is a number field. -/
+instance {f : ℚ[X]} [hf : fact (irreducible f)] : number_field (adjoin_root f) :=
+{ to_char_zero := char_zero_of_injective_algebra_map (algebra_map ℚ _).injective,
+  to_finite_dimensional := by convert (adjoin_root.power_basis hf.out.ne_zero).finite_dimensional }
+end
+
+end adjoin_root
diff --git a/src/number_theory/number_field/canonical_embedding.lean b/src/number_theory/number_field/canonical_embedding.lean
new file mode 100644
index 0000000000000..d3b0066683505
--- /dev/null
+++ b/src/number_theory/number_field/canonical_embedding.lean
@@ -0,0 +1,169 @@
+/-
+Copyright (c) 2022 Xavier Roblot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Xavier Roblot
+-/
+import number_theory.number_field.embeddings
+
+/-!
+# Canonical embedding of a number field
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The canonical embedding of a number field `K` of signature `(r₁, r₂)` is the ring homomorphism
+`K →+* ℝ^r₁ × ℂ^r₂` that sends `x ∈ K` to `(φ_₁(x),...,φ_r₁(x)) × (ψ_₁(x),..., ψ_r₂(x))` where
+`φ_₁,...,φ_r₁` are its real embeddings and `ψ_₁,..., ψ_r₂` are its complex embeddings (up to
+complex conjugation).
+
+## Main definitions and results
+
+* `number_field.canonical_embedding.ring_of_integers.inter_ball_finite`: the intersection of the
+image of the ring of integers by the canonical embedding and any ball centered at `0` of finite
+radius is finite.
+
+## Tags
+
+number field, infinite places
+-/
+
+noncomputable theory
+
+open function finite_dimensional finset fintype number_field number_field.infinite_place metric
+module
+open_locale classical number_field
+
+variables (K : Type*) [field K]
+
+namespace number_field.canonical_embedding
+
+-- The ambient space `ℝ^r₁ × ℂ^r₂` with `(r₁, r₂)` the signature of `K`.
+localized "notation `E` :=
+  ({w : infinite_place K // is_real w} → ℝ) × ({w : infinite_place K // is_complex w} → ℂ)"
+  in canonical_embedding
+
+lemma space_rank [number_field K] :
+  finrank ℝ E = finrank ℚ K :=
+begin
+  haveI : module.free ℝ ℂ := infer_instance,
+  rw [finrank_prod, finrank_pi, finrank_pi_fintype, complex.finrank_real_complex,
+    finset.sum_const, finset.card_univ, ← card_real_embeddings, algebra.id.smul_eq_mul, mul_comm,
+    ← card_complex_embeddings, ← number_field.embeddings.card K ℂ, fintype.card_subtype_compl,
+    nat.add_sub_of_le (fintype.card_subtype_le _)],
+end
+
+lemma non_trivial_space [number_field K] : nontrivial E :=
+begin
+  obtain ⟨w⟩ := infinite_place.nonempty K,
+  obtain hw | hw := w.is_real_or_is_complex,
+  { haveI : nonempty {w : infinite_place K // is_real w} := ⟨⟨w, hw⟩⟩,
+    exact nontrivial_prod_left },
+  { haveI : nonempty {w : infinite_place K // is_complex w} := ⟨⟨w, hw⟩⟩,
+    exact nontrivial_prod_right }
+end
+
+/-- The canonical embedding of a number field `K` of signature `(r₁, r₂)` into `ℝ^r₁ × ℂ^r₂`. -/
+def _root_.number_field.canonical_embedding : K →+* E :=
+ring_hom.prod (pi.ring_hom (λ w, w.prop.embedding)) (pi.ring_hom (λ w, w.val.embedding))
+
+lemma _root_.number_field.canonical_embedding_injective [number_field K] :
+  injective (number_field.canonical_embedding K) :=
+  @ring_hom.injective _ _ _ _ (non_trivial_space K) _
+
+open number_field
+
+variable {K}
+
+@[simp]
+lemma apply_at_real_infinite_place (w : {w : infinite_place K // is_real w}) (x : K) :
+  (number_field.canonical_embedding K x).1 w = w.prop.embedding x :=
+by simp only [canonical_embedding, ring_hom.prod_apply, pi.ring_hom_apply]
+
+@[simp]
+lemma apply_at_complex_infinite_place (w : { w : infinite_place K // is_complex w}) (x : K) :
+  (number_field.canonical_embedding K x).2 w = embedding w.val x :=
+by simp only [canonical_embedding, ring_hom.prod_apply, pi.ring_hom_apply]
+
+lemma nnnorm_eq [number_field K] (x : K) :
+  ‖canonical_embedding K x‖₊ = finset.univ.sup (λ w : infinite_place K, ⟨w x, map_nonneg w x⟩) :=
+begin
+  rw [prod.nnnorm_def', pi.nnnorm_def, pi.nnnorm_def],
+  rw ( _ : finset.univ = {w : infinite_place K | is_real w}.to_finset
+    ∪ {w : infinite_place K | is_complex w}.to_finset),
+  { rw [finset.sup_union, sup_eq_max],
+    refine congr_arg2 _ _ _,
+    { convert (finset.univ.sup_map (function.embedding.subtype (λ w : infinite_place K, is_real w))
+        (λ w, (⟨w x, map_nonneg w x⟩ : nnreal))).symm using 2,
+      ext w,
+      simp only [apply_at_real_infinite_place, coe_nnnorm, real.norm_eq_abs,
+        function.embedding.coe_subtype, subtype.coe_mk, is_real.abs_embedding_apply], },
+    { convert (finset.univ.sup_map (function.embedding.subtype (λ w : infinite_place K,
+        is_complex w)) (λ w, (⟨w x, map_nonneg w x⟩ : nnreal))).symm using 2,
+      ext w,
+      simp only [apply_at_complex_infinite_place, subtype.val_eq_coe, coe_nnnorm,
+        complex.norm_eq_abs, function.embedding.coe_subtype, subtype.coe_mk, abs_embedding], }},
+  { ext w,
+    simp only [w.is_real_or_is_complex, set.mem_set_of_eq, finset.mem_union, set.mem_to_finset,
+      finset.mem_univ], },
+end
+
+lemma norm_le_iff [number_field K] (x : K) (r : ℝ) :
+  ‖canonical_embedding K x‖ ≤ r ↔ ∀ w : infinite_place K, w x ≤ r :=
+begin
+  obtain hr | hr := lt_or_le r 0,
+  { obtain ⟨w⟩ := infinite_place.nonempty K,
+    exact iff_of_false (hr.trans_le $ norm_nonneg _).not_le
+      (λ h, hr.not_le $ (map_nonneg w _).trans $ h _) },
+  { lift r to nnreal using hr,
+    simp_rw [← coe_nnnorm, nnnorm_eq, nnreal.coe_le_coe, finset.sup_le_iff, finset.mem_univ,
+      forall_true_left, ←nnreal.coe_le_coe, subtype.coe_mk] }
+end
+
+variables (K)
+
+/-- The image of `𝓞 K` as a subring of `ℝ^r₁ × ℂ^r₂`. -/
+def integer_lattice : subring E :=
+(ring_hom.range (algebra_map (𝓞 K) K)).map (canonical_embedding K)
+
+/-- The linear equiv between `𝓞 K` and the integer lattice. -/
+def equiv_integer_lattice [number_field K] :
+  𝓞 K ≃ₗ[ℤ] integer_lattice K :=
+linear_equiv.of_bijective
+  { to_fun := λ x, ⟨canonical_embedding K (algebra_map (𝓞 K) K x), algebra_map (𝓞 K) K x,
+      by simp only [subring.mem_carrier, ring_hom.mem_range, exists_apply_eq_apply], rfl⟩,
+    map_add' := λ x y, by simpa only [map_add],
+    map_smul' := λ c x, by simpa only [zsmul_eq_mul, map_mul, map_int_cast] }
+  begin
+    refine ⟨λ _ _ h, _,  λ ⟨_, _, ⟨a, rfl⟩, rfl⟩, ⟨a, rfl⟩⟩,
+    rw [linear_map.coe_mk, subtype.mk_eq_mk] at h,
+    exact is_fraction_ring.injective (𝓞 K) K (canonical_embedding_injective K h),
+  end
+
+lemma integer_lattice.inter_ball_finite [number_field K] (r : ℝ) :
+  ((integer_lattice K : set E) ∩ (closed_ball 0 r)).finite :=
+begin
+  obtain hr | hr := lt_or_le r 0,
+  {  simp [closed_ball_eq_empty.2 hr] },
+  have heq :
+    ∀ x, canonical_embedding K x ∈ closed_ball (0 : E) r ↔ ∀ φ : K →+* ℂ, ‖φ x‖ ≤ r,
+  { simp only [← place_apply, ← infinite_place.coe_mk, mem_closed_ball_zero_iff, norm_le_iff],
+    exact λ x, le_iff_le x r, },
+  convert (embeddings.finite_of_norm_le K ℂ r).image (canonical_embedding K),
+  ext, split,
+  { rintro ⟨⟨_, ⟨x, rfl⟩, rfl⟩, hx2⟩,
+    exact ⟨x, ⟨set_like.coe_mem x, (heq x).mp hx2⟩, rfl⟩, },
+  { rintro ⟨x, ⟨hx1, hx2⟩, rfl⟩,
+    exact ⟨⟨x, ⟨⟨x, hx1⟩, rfl⟩, rfl⟩, (heq x).mpr hx2⟩, }
+end
+
+instance [number_field K] : countable (integer_lattice K) :=
+begin
+  have : (⋃ n : ℕ, ((integer_lattice K : set E) ∩ (closed_ball 0 n))).countable,
+  { exact set.countable_Union (λ n, (integer_lattice.inter_ball_finite K n).countable) },
+  refine (this.mono _).to_subtype,
+  rintro _ ⟨x, hx, rfl⟩,
+  rw set.mem_Union,
+  exact ⟨⌈‖canonical_embedding K x‖⌉₊, ⟨x, hx, rfl⟩, mem_closed_ball_zero_iff.2 (nat.le_ceil _)⟩,
+end
+
+end number_field.canonical_embedding
diff --git a/src/number_theory/number_field/class_number.lean b/src/number_theory/number_field/class_number.lean
new file mode 100644
index 0000000000000..4958f37408dfe
--- /dev/null
+++ b/src/number_theory/number_field/class_number.lean
@@ -0,0 +1,57 @@
+/-
+Copyright (c) 2021 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+import number_theory.class_number.admissible_abs
+import number_theory.class_number.finite
+import number_theory.number_field.basic
+
+/-!
+# Class numbers of number fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the class number of a number field as the (finite) cardinality of
+the class group of its ring of integers. It also proves some elementary results
+on the class number.
+
+## Main definitions
+- `number_field.class_number`: the class number of a number field is the (finite)
+cardinality of the class group of its ring of integers
+-/
+
+namespace number_field
+
+variables (K : Type*) [field K] [number_field K]
+
+namespace ring_of_integers
+
+noncomputable instance : fintype (class_group (ring_of_integers K)) :=
+class_group.fintype_of_admissible_of_finite ℚ K absolute_value.abs_is_admissible
+
+end ring_of_integers
+
+/-- The class number of a number field is the (finite) cardinality of the class group. -/
+noncomputable def class_number : ℕ := fintype.card (class_group (ring_of_integers K))
+
+variables {K}
+
+/-- The class number of a number field is `1` iff the ring of integers is a PID. -/
+theorem class_number_eq_one_iff :
+  class_number K = 1 ↔ is_principal_ideal_ring (ring_of_integers K) :=
+card_class_group_eq_one_iff
+
+end number_field
+
+namespace rat
+
+open number_field
+
+theorem class_number_eq : number_field.class_number ℚ = 1 :=
+class_number_eq_one_iff.mpr $ by convert is_principal_ideal_ring.of_surjective
+  (rat.ring_of_integers_equiv.symm : ℤ →+* ring_of_integers ℚ)
+  (rat.ring_of_integers_equiv.symm.surjective)
+
+end rat
diff --git a/src/number_theory/number_field/embeddings.lean b/src/number_theory/number_field/embeddings.lean
new file mode 100644
index 0000000000000..a42a2fc245ed5
--- /dev/null
+++ b/src/number_theory/number_field/embeddings.lean
@@ -0,0 +1,487 @@
+/-
+Copyright (c) 2022 Xavier Roblot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alex J. Best, Xavier Roblot
+-/
+
+import analysis.complex.polynomial
+import field_theory.minpoly.is_integrally_closed
+import number_theory.number_field.basic
+import ring_theory.norm
+import topology.instances.complex
+
+
+/-!
+# Embeddings of number fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+This file defines the embeddings of a number field into an algebraic closed field.
+
+## Main Results
+* `number_field.embeddings.range_eval_eq_root_set_minpoly`: let `x ∈ K` with `K` number field and
+  let `A` be an algebraic closed field of char. 0, then the images of `x` by the embeddings of `K`
+   in `A` are exactly the roots in `A` of the minimal polynomial of `x` over `ℚ`.
+* `number_field.embeddings.pow_eq_one_of_norm_eq_one`: an algebraic integer whose conjugates are
+  all of norm one is a root of unity.
+
+## Tags
+number field, embeddings, places, infinite places
+-/
+
+open_locale classical
+
+namespace number_field.embeddings
+
+section fintype
+
+open finite_dimensional
+
+variables (K : Type*) [field K] [number_field K]
+variables (A : Type*) [field A] [char_zero A]
+
+/-- There are finitely many embeddings of a number field. -/
+noncomputable instance : fintype (K →+* A) := fintype.of_equiv (K →ₐ[ℚ] A)
+ring_hom.equiv_rat_alg_hom.symm
+
+variables [is_alg_closed A]
+
+/-- The number of embeddings of a number field is equal to its finrank. -/
+lemma card : fintype.card (K →+* A) = finrank ℚ K :=
+by rw [fintype.of_equiv_card ring_hom.equiv_rat_alg_hom.symm, alg_hom.card]
+
+instance : nonempty (K →+* A) :=
+begin
+  rw [← fintype.card_pos_iff, number_field.embeddings.card K A],
+  exact finite_dimensional.finrank_pos,
+end
+
+end fintype
+
+section roots
+
+open set polynomial
+
+variables (K A : Type*) [field K] [number_field K]
+  [field A] [algebra ℚ A] [is_alg_closed A] (x : K)
+
+/-- Let `A` be an algebraically closed field and let `x ∈ K`, with `K` a number field.
+The images of `x` by the embeddings of `K` in `A` are exactly the roots in `A` of
+the minimal polynomial of `x` over `ℚ`. -/
+lemma range_eval_eq_root_set_minpoly : range (λ φ : K →+* A, φ x) = (minpoly ℚ x).root_set A :=
+begin
+  convert (number_field.is_algebraic K).range_eval_eq_root_set_minpoly A x using 1,
+  ext a,
+  exact ⟨λ ⟨φ, hφ⟩, ⟨φ.to_rat_alg_hom, hφ⟩, λ ⟨φ, hφ⟩, ⟨φ.to_ring_hom, hφ⟩⟩,
+end
+
+end roots
+
+section bounded
+
+open finite_dimensional polynomial set
+
+variables {K : Type*} [field K] [number_field K]
+variables {A : Type*} [normed_field A] [is_alg_closed A] [normed_algebra ℚ A]
+
+lemma coeff_bdd_of_norm_le {B : ℝ} {x : K} (h : ∀ φ : K →+* A, ‖φ x‖ ≤ B) (i : ℕ) :
+  ‖(minpoly ℚ x).coeff i‖ ≤ (max B 1) ^ (finrank ℚ K) * (finrank ℚ K).choose ((finrank ℚ K) / 2) :=
+begin
+  have hx := is_separable.is_integral ℚ x,
+  rw [← norm_algebra_map' A, ← coeff_map (algebra_map ℚ A)],
+  refine coeff_bdd_of_roots_le _ (minpoly.monic hx) (is_alg_closed.splits_codomain _)
+    (minpoly.nat_degree_le hx) (λ z hz, _) i,
+  classical, rw ← multiset.mem_to_finset at hz,
+  obtain ⟨φ, rfl⟩ := (range_eval_eq_root_set_minpoly K A x).symm.subset hz,
+  exact h φ,
+end
+
+variables (K A)
+
+/-- Let `B` be a real number. The set of algebraic integers in `K` whose conjugates are all
+smaller in norm than `B` is finite. -/
+lemma finite_of_norm_le (B : ℝ) :
+  {x : K | is_integral ℤ x ∧ ∀ φ : K →+* A, ‖φ x‖ ≤ B}.finite :=
+begin
+  let C := nat.ceil ((max B 1) ^ (finrank ℚ K) * (finrank ℚ K).choose ((finrank ℚ K) / 2)),
+  have := bUnion_roots_finite (algebra_map ℤ K) (finrank ℚ K) (finite_Icc (-C : ℤ) C),
+  refine this.subset (λ x hx, _), simp_rw mem_Union,
+  have h_map_ℚ_minpoly := minpoly.is_integrally_closed_eq_field_fractions' ℚ hx.1,
+  refine ⟨_, ⟨_, λ i, _⟩, mem_root_set.2 ⟨minpoly.ne_zero hx.1, minpoly.aeval ℤ x⟩⟩,
+  { rw [← (minpoly.monic hx.1).nat_degree_map (algebra_map ℤ ℚ), ← h_map_ℚ_minpoly],
+    exact minpoly.nat_degree_le (is_integral_of_is_scalar_tower hx.1) },
+  rw [mem_Icc, ← abs_le, ← @int.cast_le ℝ],
+  refine (eq.trans_le _ $ coeff_bdd_of_norm_le hx.2 i).trans (nat.le_ceil _),
+  rw [h_map_ℚ_minpoly, coeff_map, eq_int_cast, int.norm_cast_rat, int.norm_eq_abs, int.cast_abs],
+end
+
+/-- An algebraic integer whose conjugates are all of norm one is a root of unity. -/
+lemma pow_eq_one_of_norm_eq_one {x : K}
+  (hxi : is_integral ℤ x) (hx : ∀ φ : K →+* A, ‖φ x‖ = 1) :
+  ∃ (n : ℕ) (hn : 0 < n), x ^ n = 1 :=
+begin
+  obtain ⟨a, -, b, -, habne, h⟩ := @set.infinite.exists_ne_map_eq_of_maps_to _ _ _ _
+    ((^) x : ℕ → K) set.infinite_univ _ (finite_of_norm_le K A (1:ℝ)),
+  { wlog hlt : b < a,
+    { exact this hxi hx b a habne.symm h.symm (habne.lt_or_lt.resolve_right hlt) },
+    refine ⟨a - b, tsub_pos_of_lt hlt, _⟩,
+    rw [← nat.sub_add_cancel hlt.le, pow_add, mul_left_eq_self₀] at h,
+    refine h.resolve_right (λ hp, _),
+    specialize hx (is_alg_closed.lift (number_field.is_algebraic K)).to_ring_hom,
+    rw [pow_eq_zero hp, map_zero, norm_zero] at hx, norm_num at hx },
+  { exact λ a _, ⟨hxi.pow a, λ φ, by simp only [hx φ, norm_pow, one_pow, map_pow]⟩ },
+end
+
+end bounded
+
+end number_field.embeddings
+
+section place
+
+variables {K : Type*} [field K] {A : Type*} [normed_division_ring A] [nontrivial A] (φ : K →+* A)
+
+/-- An embedding into a normed division ring defines a place of `K` -/
+def number_field.place : absolute_value K ℝ :=
+(is_absolute_value.to_absolute_value (norm : A → ℝ)).comp φ.injective
+
+@[simp]
+lemma number_field.place_apply (x : K) : (number_field.place φ) x = norm (φ x) := rfl
+
+end place
+
+namespace number_field.complex_embedding
+
+open complex number_field
+
+open_locale complex_conjugate
+
+variables {K : Type*} [field K]
+
+/-- The conjugate of a complex embedding as a complex embedding. -/
+@[reducible] def conjugate (φ : K →+* ℂ) : K →+* ℂ := star φ
+
+@[simp]
+lemma conjugate_coe_eq (φ : K →+* ℂ) (x : K) : (conjugate φ) x = conj (φ x) := rfl
+
+lemma place_conjugate (φ : K →+* ℂ) : place (conjugate φ) = place φ :=
+by { ext, simp only [place_apply, norm_eq_abs, abs_conj, conjugate_coe_eq] }
+
+/-- A embedding into `ℂ` is real if it is fixed by complex conjugation. -/
+@[reducible] def is_real (φ : K →+* ℂ) : Prop := is_self_adjoint φ
+
+lemma is_real_iff {φ : K →+* ℂ} : is_real φ ↔ conjugate φ = φ := is_self_adjoint_iff
+
+/-- A real embedding as a ring homomorphism from `K` to `ℝ` . -/
+def is_real.embedding {φ : K →+* ℂ} (hφ : is_real φ) : K →+* ℝ :=
+{ to_fun := λ x, (φ x).re,
+  map_one' := by simp only [map_one, one_re],
+  map_mul' := by simp only [complex.conj_eq_iff_im.mp (ring_hom.congr_fun hφ _), map_mul, mul_re,
+  mul_zero, tsub_zero, eq_self_iff_true, forall_const],
+  map_zero' := by simp only [map_zero, zero_re],
+  map_add' := by simp only [map_add, add_re, eq_self_iff_true, forall_const], }
+
+@[simp]
+lemma is_real.coe_embedding_apply {φ : K →+* ℂ} (hφ : is_real φ) (x : K) :
+  (hφ.embedding x : ℂ) = φ x :=
+begin
+  ext, { refl, },
+  { rw [of_real_im, eq_comm, ← complex.conj_eq_iff_im],
+    rw is_real at hφ,
+    exact ring_hom.congr_fun hφ x, },
+end
+
+lemma is_real.place_embedding {φ : K →+* ℂ} (hφ : is_real φ) :
+  place hφ.embedding = place φ :=
+by { ext x, simp only [place_apply, real.norm_eq_abs, ←abs_of_real, norm_eq_abs,
+  hφ.coe_embedding_apply x], }
+
+lemma is_real_conjugate_iff {φ : K →+* ℂ} :
+  is_real (conjugate φ) ↔ is_real φ := is_self_adjoint.star_iff
+
+end number_field.complex_embedding
+
+section infinite_place
+
+open number_field
+
+variables (K : Type*) [field K]
+
+/-- An infinite place of a number field `K` is a place associated to a complex embedding. -/
+def number_field.infinite_place := { w : absolute_value K ℝ  // ∃ φ : K →+* ℂ, place φ = w}
+
+instance [number_field K] : nonempty (number_field.infinite_place K) := set.range.nonempty _
+
+variables {K}
+
+/-- Return the infinite place defined by a complex embedding `φ`. -/
+noncomputable def number_field.infinite_place.mk (φ : K →+* ℂ) : number_field.infinite_place K :=
+⟨place φ, ⟨φ, rfl⟩⟩
+
+namespace number_field.infinite_place
+
+open number_field
+
+instance : has_coe_to_fun (infinite_place K) (λ _, K → ℝ) := { coe := λ w, w.1 }
+
+instance : monoid_with_zero_hom_class (infinite_place K) K ℝ :=
+{ coe := λ w x, w.1 x,
+  coe_injective' := λ _ _ h, subtype.eq (absolute_value.ext (λ x, congr_fun h x)),
+  map_mul := λ w _ _, w.1.map_mul _ _,
+  map_one := λ w, w.1.map_one,
+  map_zero := λ w, w.1.map_zero, }
+
+instance : nonneg_hom_class (infinite_place K) K ℝ :=
+{ coe :=  λ w x, w x,
+  coe_injective' := λ _ _ h, subtype.eq (absolute_value.ext (λ x, congr_fun h x)),
+  map_nonneg := λ w x, w.1.nonneg _ }
+
+lemma coe_mk (φ : K →+* ℂ) : ⇑(mk φ) = place φ := rfl
+
+lemma apply (φ : K →+* ℂ) (x : K) : (mk φ) x = complex.abs (φ x) := rfl
+
+/-- For an infinite place `w`, return an embedding `φ` such that `w = infinite_place φ` . -/
+noncomputable def embedding (w : infinite_place K) : K →+* ℂ := (w.2).some
+
+@[simp]
+lemma mk_embedding (w : infinite_place K) :
+  mk (embedding w) = w :=
+subtype.ext (w.2).some_spec
+
+@[simp]
+lemma abs_embedding (w : infinite_place K) (x : K) :
+  complex.abs (embedding w x) = w x := congr_fun (congr_arg coe_fn w.2.some_spec) x
+
+lemma eq_iff_eq (x : K) (r : ℝ) :
+  (∀ w : infinite_place K, w x = r) ↔ (∀ φ : K →+* ℂ, ‖φ x‖ = r) :=
+⟨λ hw φ, hw (mk φ), λ hφ ⟨w, ⟨φ, rfl⟩⟩, hφ φ⟩
+
+lemma le_iff_le (x : K) (r : ℝ) :
+  (∀ w : infinite_place K, w x ≤ r) ↔ (∀ φ : K →+* ℂ, ‖φ x‖ ≤ r) :=
+⟨λ hw φ, hw (mk φ), λ hφ ⟨w, ⟨φ, rfl⟩⟩, hφ φ⟩
+
+lemma pos_iff {w : infinite_place K} {x : K} : 0 < w x ↔ x ≠ 0 := absolute_value.pos_iff w.1
+
+@[simp]
+lemma mk_conjugate_eq (φ : K →+* ℂ) :
+  mk (complex_embedding.conjugate φ) = mk φ :=
+begin
+  ext x,
+  exact congr_fun (congr_arg coe_fn (complex_embedding.place_conjugate φ)) x,
+end
+
+@[simp]
+lemma mk_eq_iff {φ ψ : K →+* ℂ} :
+  mk φ = mk ψ ↔ φ = ψ ∨ complex_embedding.conjugate φ = ψ :=
+begin
+  split,
+  { -- We prove that the map ψ ∘ φ⁻¹ between φ(K) and ℂ is uniform continuous, thus it is either the
+    -- inclusion or the complex conjugation using complex.uniform_continuous_ring_hom_eq_id_or_conj
+    intro h₀,
+    obtain ⟨j, hiφ⟩ := φ.injective.has_left_inverse,
+    let ι := ring_equiv.of_left_inverse hiφ,
+    have hlip : lipschitz_with 1 (ring_hom.comp ψ ι.symm.to_ring_hom),
+    { change lipschitz_with 1 (ψ ∘ ι.symm),
+      apply lipschitz_with.of_dist_le_mul,
+      intros x y,
+      rw [nonneg.coe_one, one_mul, normed_field.dist_eq, ← map_sub, ← map_sub],
+      apply le_of_eq,
+      suffices : ‖φ ((ι.symm) (x - y))‖ = ‖ψ ((ι.symm) (x - y))‖,
+      { rw [← this, ← ring_equiv.of_left_inverse_apply hiφ _ , ring_equiv.apply_symm_apply ι _],
+        refl, },
+      exact congr_fun (congr_arg coe_fn h₀) _, },
+    cases (complex.uniform_continuous_ring_hom_eq_id_or_conj φ.field_range hlip.uniform_continuous),
+    { left, ext1 x,
+      convert (congr_fun h (ι x)).symm,
+      exact (ring_equiv.apply_symm_apply ι.symm x).symm, },
+    { right, ext1 x,
+      convert (congr_fun h (ι x)).symm,
+      exact (ring_equiv.apply_symm_apply ι.symm x).symm, }},
+  { rintros (⟨h⟩ | ⟨h⟩),
+    { exact congr_arg mk h, },
+    { rw ← mk_conjugate_eq,
+      exact congr_arg mk h, }},
+end
+
+/-- An infinite place is real if it is defined by a real embedding. -/
+def is_real (w : infinite_place K) : Prop :=
+  ∃ φ : K →+* ℂ, complex_embedding.is_real φ ∧ mk φ = w
+
+/-- An infinite place is complex if it is defined by a complex (ie. not real) embedding. -/
+def is_complex (w : infinite_place K) : Prop :=
+  ∃ φ : K →+* ℂ, ¬ complex_embedding.is_real φ ∧ mk φ = w
+
+@[simp]
+lemma _root_.number_field.complex_embeddings.is_real.embedding_mk {φ : K →+* ℂ}
+  (h : complex_embedding.is_real φ) :
+  embedding (mk φ) = φ :=
+begin
+  have := mk_eq_iff.mp (mk_embedding (mk φ)).symm,
+  rwa [complex_embedding.is_real_iff.mp h, or_self, eq_comm] at this,
+end
+
+lemma is_real_iff {w : infinite_place K} :
+  is_real w ↔ complex_embedding.is_real (embedding w) :=
+begin
+  split,
+  { rintros ⟨φ, ⟨hφ, rfl⟩⟩,
+    rwa _root_.number_field.complex_embeddings.is_real.embedding_mk hφ, },
+  { exact λ h, ⟨embedding w, h, mk_embedding w⟩, },
+end
+
+lemma is_complex_iff {w : infinite_place K} :
+  is_complex w ↔ ¬ complex_embedding.is_real (embedding w) :=
+begin
+  split,
+  { rintros ⟨φ, ⟨hφ, rfl⟩⟩,
+    contrapose! hφ,
+    cases mk_eq_iff.mp (mk_embedding (mk φ)),
+    { rwa ← h, },
+    { rw ← complex_embedding.is_real_conjugate_iff at hφ,
+      rwa ← h, }},
+  { exact λ h, ⟨embedding w, h, mk_embedding w⟩, },
+end
+
+@[simp] lemma not_is_real_iff_is_complex {w : infinite_place K} : ¬ is_real w ↔ is_complex w :=
+by rw [is_complex_iff, is_real_iff]
+
+@[simp] lemma not_is_complex_iff_is_real {w : infinite_place K} : ¬ is_complex w ↔ is_real w :=
+by rw [←not_is_real_iff_is_complex, not_not]
+
+lemma is_real_or_is_complex (w : infinite_place K) : is_real w ∨ is_complex w :=
+by { rw ←not_is_real_iff_is_complex, exact em _ }
+
+/-- For `w` a real infinite place, return the corresponding embedding as a morphism `K →+* ℝ`. -/
+noncomputable def is_real.embedding {w : infinite_place K} (hw : is_real w) : K →+* ℝ :=
+(is_real_iff.mp hw).embedding
+
+@[simp]
+lemma is_real.place_embedding_apply {w : infinite_place K} (hw : is_real w) (x : K):
+  place (is_real.embedding hw) x = w x :=
+begin
+  rw [is_real.embedding, complex_embedding.is_real.place_embedding, ← coe_mk],
+  exact congr_fun (congr_arg coe_fn (mk_embedding w)) x,
+end
+
+@[simp]
+lemma is_real.abs_embedding_apply {w : infinite_place K} (hw : is_real w) (x : K) :
+  |is_real.embedding hw x| = w x :=
+by { rw ← is_real.place_embedding_apply hw x, congr, }
+
+variable (K)
+
+/-- The map from real embeddings to real infinite places as an equiv -/
+noncomputable def mk_real :
+  {φ : K →+* ℂ // complex_embedding.is_real φ} ≃ {w : infinite_place K // is_real w} :=
+{ to_fun := subtype.map mk (λ φ hφ, ⟨φ, hφ, rfl⟩),
+  inv_fun :=  λ w, ⟨w.1.embedding, is_real_iff.1 w.2⟩,
+  left_inv := λ φ, subtype.ext_iff.2 (number_field.complex_embeddings.is_real.embedding_mk φ.2),
+  right_inv := λ w, subtype.ext_iff.2 (mk_embedding w.1), }
+
+/-- The map from nonreal embeddings to complex infinite places -/
+noncomputable def mk_complex :
+  {φ : K →+* ℂ // ¬ complex_embedding.is_real φ} → {w : infinite_place K // is_complex w} :=
+subtype.map mk (λ φ hφ, ⟨φ, hφ, rfl⟩)
+
+lemma mk_complex_embedding (φ : {φ : K →+* ℂ // ¬ complex_embedding.is_real φ}) :
+  ((mk_complex K φ) : infinite_place K).embedding = φ ∨
+    ((mk_complex K φ) : infinite_place K).embedding = complex_embedding.conjugate φ :=
+begin
+  rw [@eq_comm _ _ ↑φ, @eq_comm _ _ (complex_embedding.conjugate ↑φ), ← mk_eq_iff, mk_embedding],
+  refl,
+end
+
+@[simp]
+lemma mk_real_coe (φ : {φ : K →+* ℂ // complex_embedding.is_real φ}) :
+  (mk_real K φ : infinite_place K) = mk (φ : K →+* ℂ) := rfl
+
+@[simp]
+lemma mk_complex_coe (φ : {φ : K →+* ℂ // ¬ complex_embedding.is_real φ}) :
+  (mk_complex K φ : infinite_place K) = mk (φ : K →+* ℂ) := rfl
+
+@[simp]
+lemma mk_real.apply (φ : {φ : K →+* ℂ // complex_embedding.is_real φ}) (x : K) :
+  mk_real K φ x = complex.abs (φ x) := apply φ x
+
+@[simp]
+lemma mk_complex.apply (φ : {φ : K →+* ℂ // ¬ complex_embedding.is_real φ}) (x : K) :
+  mk_complex K φ x = complex.abs (φ x) := apply φ x
+
+variable [number_field K]
+
+lemma mk_complex.filter (w : { w : infinite_place K // w.is_complex }) :
+  finset.univ.filter (λ φ, mk_complex K φ = w) =
+    { ⟨w.1.embedding, is_complex_iff.1 w.2⟩,
+      ⟨complex_embedding.conjugate w.1.embedding,
+        complex_embedding.is_real_conjugate_iff.not.2 (is_complex_iff.1 w.2)⟩ } :=
+begin
+  ext φ,
+  simp_rw [finset.mem_filter, subtype.val_eq_coe, finset.mem_insert, finset.mem_singleton,
+    @subtype.ext_iff_val (infinite_place K), @subtype.ext_iff_val (K →+* ℂ), @eq_comm _ φ.val,
+    ← mk_eq_iff, mk_embedding, @eq_comm _ _ w.val],
+  simpa only [finset.mem_univ, true_and],
+end
+
+lemma mk_complex.filter_card (w : { w : infinite_place K // w.is_complex }) :
+  (finset.univ.filter (λ φ, mk_complex K φ = w)).card = 2 :=
+begin
+  rw mk_complex.filter,
+  exact finset.card_doubleton
+    (subtype.mk_eq_mk.not.2 $ ne_comm.1 $
+      complex_embedding.is_real_iff.not.1 $ is_complex_iff.1 w.2),
+end
+
+noncomputable instance number_field.infinite_place.fintype : fintype (infinite_place K) :=
+set.fintype_range _
+
+/-- The infinite part of the product formula : for `x ∈ K`, we have `Π_w ‖x‖_w = |norm(x)|` where
+`‖·‖_w` is the normalized absolute value for `w`.  -/
+lemma prod_eq_abs_norm (x : K) :
+  finset.univ.prod (λ w : infinite_place K, ite (w.is_real) (w x) ((w x) ^ 2)) =
+    abs (algebra.norm ℚ x) :=
+begin
+  convert (congr_arg complex.abs (@algebra.norm_eq_prod_embeddings ℚ _ _ _ _ ℂ _ _ _ _ _ x)).symm,
+  { rw [map_prod, ← equiv.prod_comp' ring_hom.equiv_rat_alg_hom (λ f, complex.abs (f x))
+      (λ φ, complex.abs (φ x)) (λ _, by simpa only [ring_hom.equiv_rat_alg_hom_apply])],
+    dsimp only,
+    conv { to_rhs, congr, skip, funext,
+      rw ( by simp only [if_t_t] : complex.abs (f x) =
+        ite (complex_embedding.is_real f) (complex.abs (f x)) (complex.abs (f x))) },
+    rw [finset.prod_ite, finset.prod_ite],
+    refine congr (congr_arg has_mul.mul _) _,
+    { rw [← finset.prod_subtype_eq_prod_filter, ← finset.prod_subtype_eq_prod_filter],
+      convert (equiv.prod_comp' (mk_real K) (λ φ, complex.abs (φ x)) (λ w, w x) _).symm,
+      any_goals { ext, simp only [finset.mem_subtype, finset.mem_univ], },
+      exact λ φ, mk_real.apply K φ x, },
+    { rw [finset.filter_congr (λ (w : infinite_place K) _, @not_is_real_iff_is_complex K _ w),
+        ← finset.prod_subtype_eq_prod_filter, ← finset.prod_subtype_eq_prod_filter],
+      convert finset.prod_fiberwise finset.univ (λ φ, mk_complex K φ) (λ φ, complex.abs (φ x)),
+      any_goals
+      { ext, simp only [finset.mem_subtype, finset.mem_univ, not_is_real_iff_is_complex], },
+      { ext w,
+        rw [@finset.prod_congr _ _ _ _ _ (λ φ, w x) _ (eq.refl _)
+          (λ φ hφ, (mk_complex.apply K φ x).symm.trans
+          (congr_fun (congr_arg coe_fn (finset.mem_filter.1 hφ).2) x)), finset.prod_const,
+          mk_complex.filter_card K w],
+        refl, }}},
+  { rw [eq_rat_cast, ← complex.abs_of_real, complex.of_real_rat_cast], },
+end
+
+open fintype
+
+lemma card_real_embeddings :
+  card {φ : K →+* ℂ // complex_embedding.is_real φ} = card {w : infinite_place K // is_real w} :=
+by convert (fintype.of_equiv_card (mk_real K)).symm
+
+lemma card_complex_embeddings :
+  card {φ : K →+* ℂ // ¬ complex_embedding.is_real φ} =
+    2 * card {w : infinite_place K // is_complex w} :=
+begin
+  rw [fintype.card, fintype.card, mul_comm, ← algebra.id.smul_eq_mul, ← finset.sum_const],
+  conv { to_rhs, congr, skip, funext, rw ← mk_complex.filter_card K x },
+  simp_rw finset.card_eq_sum_ones,
+  exact (finset.sum_fiberwise finset.univ (λ φ, mk_complex K φ) (λ φ, 1)).symm
+end
+
+end number_field.infinite_place
+
+end infinite_place
diff --git a/src/number_theory/number_field/norm.lean b/src/number_theory/number_field/norm.lean
new file mode 100644
index 0000000000000..1699edeb6c4c3
--- /dev/null
+++ b/src/number_theory/number_field/norm.lean
@@ -0,0 +1,110 @@
+/-
+Copyright (c) 2022 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca, Eric Rodriguez
+-/
+
+import number_theory.number_field.basic
+import ring_theory.norm
+
+/-!
+# Norm in number fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+Given a finite extension of number fields, we define the norm morphism as a function between the
+rings of integers.
+
+## Main definitions
+* `ring_of_integers.norm K` : `algebra.norm` as a morphism `(𝓞 L) →* (𝓞 K)`.
+## Main results
+* `algebra.dvd_norm` : if `L/K` is a finite Galois extension of fields, then, for all `(x : 𝓞 L)`
+  we have that `x ∣ algebra_map (𝓞 K) (𝓞 L) (norm K x)`.
+
+-/
+
+open_locale number_field big_operators
+
+open finset number_field algebra finite_dimensional
+
+namespace ring_of_integers
+
+variables {L : Type*} (K : Type*) [field K] [field L] [algebra K L] [finite_dimensional K L]
+
+/-- `algebra.norm` as a morphism betwen the rings of integers. -/
+@[simps] noncomputable def norm [is_separable K L] : (𝓞 L) →* (𝓞 K) :=
+((algebra.norm K).restrict (𝓞 L)).cod_restrict (𝓞 K) (λ x, is_integral_norm K x.2)
+
+local attribute [instance] number_field.ring_of_integers_algebra
+
+lemma coe_algebra_map_norm [is_separable K L] (x : 𝓞 L) :
+  (algebra_map (𝓞 K) (𝓞 L) (norm K x) : L) = algebra_map K L (algebra.norm K (x : L)) := rfl
+
+lemma coe_norm_algebra_map [is_separable K L] (x : 𝓞 K) :
+  (norm K (algebra_map (𝓞 K) (𝓞 L) x) : K) = algebra.norm K (algebra_map K L x) := rfl
+
+lemma norm_algebra_map [is_separable K L] (x : 𝓞 K) :
+  norm K (algebra_map (𝓞 K) (𝓞 L) x) = x ^ finrank K L :=
+by rw [← subtype.coe_inj, ring_of_integers.coe_norm_algebra_map, algebra.norm_algebra_map,
+  subsemiring_class.coe_pow]
+
+lemma is_unit_norm_of_is_galois [is_galois K L] {x : 𝓞 L} :
+  is_unit (norm K x) ↔ is_unit x :=
+begin
+  classical,
+  refine ⟨λ hx, _, is_unit.map _⟩,
+  replace hx : is_unit (algebra_map (𝓞 K) (𝓞 L) $ norm K x) := hx.map (algebra_map (𝓞 K) $ 𝓞 L),
+  refine @is_unit_of_mul_is_unit_right (𝓞 L) _
+         ⟨(univ \ { alg_equiv.refl }).prod (λ (σ : L ≃ₐ[K] L), σ x),
+          prod_mem (λ σ hσ, map_is_integral (σ : L →+* L).to_int_alg_hom x.2)⟩ _ _,
+  convert hx using 1,
+  ext,
+  push_cast,
+  convert_to (univ \ { alg_equiv.refl }).prod (λ (σ : L ≃ₐ[K] L), σ x) * (∏ (σ : L ≃ₐ[K] L) in
+    {alg_equiv.refl}, σ (x : L)) = _,
+  { rw [prod_singleton, alg_equiv.coe_refl, id] },
+  { rw [prod_sdiff $ subset_univ _, ←norm_eq_prod_automorphisms, coe_algebra_map_norm] }
+end
+
+/-- If `L/K` is a finite Galois extension of fields, then, for all `(x : 𝓞 L)` we have that
+`x ∣ algebra_map (𝓞 K) (𝓞 L) (norm K x)`. -/
+lemma dvd_norm [is_galois K L] (x : 𝓞 L) : x ∣ algebra_map (𝓞 K) (𝓞 L) (norm K x) :=
+begin
+  classical,
+  have hint : (∏ (σ : L ≃ₐ[K] L) in univ.erase alg_equiv.refl, σ x) ∈ 𝓞 L :=
+    subalgebra.prod_mem _ (λ σ hσ, (mem_ring_of_integers _ _).2
+    (map_is_integral σ (ring_of_integers.is_integral_coe x))),
+  refine ⟨⟨_, hint⟩, subtype.ext _⟩,
+  rw [coe_algebra_map_norm K x, norm_eq_prod_automorphisms],
+  simp [← finset.mul_prod_erase _ _ (mem_univ alg_equiv.refl)]
+end
+
+variables (F : Type*) [field F] [algebra K F] [is_separable K F] [finite_dimensional K F]
+
+lemma norm_norm [is_separable K L] [algebra F L] [is_separable F L] [finite_dimensional F L]
+  [is_scalar_tower K F L] (x : 𝓞 L) : norm K (norm F x) = norm K x :=
+by rw [← subtype.coe_inj, norm_apply_coe, norm_apply_coe, norm_apply_coe, algebra.norm_norm]
+
+variable {F}
+
+lemma is_unit_norm [char_zero K] {x : 𝓞 F} :
+  is_unit (norm K x) ↔ is_unit x :=
+begin
+  letI : algebra K (algebraic_closure K) := algebraic_closure.algebra K,
+  let L := normal_closure K F (algebraic_closure F),
+  haveI : finite_dimensional F L := finite_dimensional.right K F L,
+  haveI : is_alg_closure K (algebraic_closure F) :=
+    is_alg_closure.of_algebraic K F (algebraic_closure F) (algebra.is_algebraic_of_finite K F),
+  haveI : is_galois F L := is_galois.tower_top_of_is_galois K F L,
+  calc
+    is_unit (norm K x) ↔ is_unit ((norm K) x ^ finrank F L) :
+        (is_unit_pow_iff (pos_iff_ne_zero.mp finrank_pos)).symm
+      ... ↔ is_unit (norm K (algebra_map (𝓞 F) (𝓞 L) x)) :
+        by rw [← norm_norm K F (algebra_map (𝓞 F) (𝓞 L) x), norm_algebra_map F _, map_pow]
+      ... ↔ is_unit (algebra_map (𝓞 F) (𝓞 L) x) : is_unit_norm_of_is_galois K
+      ... ↔ is_unit (norm F (algebra_map (𝓞 F) (𝓞 L) x)) : (is_unit_norm_of_is_galois F).symm
+      ... ↔ is_unit (x ^ finrank F L) : (congr_arg is_unit (norm_algebra_map F _)).to_iff
+      ... ↔ is_unit x : is_unit_pow_iff (pos_iff_ne_zero.mp finrank_pos),
+end
+
+end ring_of_integers
diff --git a/src/number_theory/number_field/units.lean b/src/number_theory/number_field/units.lean
new file mode 100644
index 0000000000000..26fae65f4afee
--- /dev/null
+++ b/src/number_theory/number_field/units.lean
@@ -0,0 +1,53 @@
+/-
+Copyright (c) 2023 Xavier Roblot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Xavier Roblot
+-/
+import number_theory.number_field.norm
+
+/-!
+# Units of a number field
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+We prove results about the group `(𝓞 K)ˣ` of units of the ring of integers `𝓞 K` of a number
+field `K`.
+
+## Main results
+* `number_field.is_unit_iff_norm`: an algebraic integer `x : 𝓞 K` is a unit if and only if
+`|norm ℚ x| = 1`
+
+## Tags
+number field, units
+ -/
+
+open_locale number_field
+
+noncomputable theory
+
+open number_field units
+
+section rat
+
+lemma rat.ring_of_integers.is_unit_iff {x : 𝓞 ℚ} :
+  is_unit x ↔ ((x : ℚ) = 1) ∨ ((x : ℚ) = -1) :=
+by simp_rw [(is_unit_map_iff (rat.ring_of_integers_equiv : 𝓞 ℚ →+* ℤ) x).symm, int.is_unit_iff,
+  ring_equiv.coe_to_ring_hom, ring_equiv.map_eq_one_iff, ring_equiv.map_eq_neg_one_iff,
+  ← subtype.coe_injective.eq_iff, add_subgroup_class.coe_neg, algebra_map.coe_one]
+
+end rat
+
+variables (K : Type*) [field K]
+
+section is_unit
+
+local attribute [instance] number_field.ring_of_integers_algebra
+
+variable {K}
+
+lemma is_unit_iff_norm [number_field K] (x : 𝓞 K) :
+  is_unit x ↔ |(ring_of_integers.norm ℚ x : ℚ)| = 1 :=
+by { convert (ring_of_integers.is_unit_norm ℚ).symm,
+  rw [← abs_one, abs_eq_abs, ← rat.ring_of_integers.is_unit_iff], }
+
+end is_unit
diff --git a/src/number_theory/padics/default.lean b/src/number_theory/padics/default.lean
deleted file mode 100644
index 9eaf5cc607bb8..0000000000000
--- a/src/number_theory/padics/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import number_theory.padics.padic_integers
diff --git a/src/number_theory/padics/hensel.lean b/src/number_theory/padics/hensel.lean
index eaa9576eba627..e541fd41c24d7 100644
--- a/src/number_theory/padics/hensel.lean
+++ b/src/number_theory/padics/hensel.lean
@@ -12,6 +12,9 @@ import topology.metric_space.cau_seq_filter
 /-!
 # Hensel's lemma on ℤ_p
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves Hensel's lemma on ℤ_p, roughly following Keith Conrad's writeup:
 
 
@@ -33,16 +36,16 @@ p-adic, p adic, padic, p-adic integer
 
 noncomputable theory
 
-open_locale classical topological_space
+open_locale classical topology
 
 -- We begin with some general lemmas that are used below in the computation.
 
 lemma padic_polynomial_dist {p : ℕ} [fact p.prime] (F : polynomial ℤ_[p]) (x y : ℤ_[p]) :
-  ∥F.eval x - F.eval y∥ ≤ ∥x - y∥ :=
+  ‖F.eval x - F.eval y‖ ≤ ‖x - y‖ :=
 let ⟨z, hz⟩ := F.eval_sub_factor x y in calc
-  ∥F.eval x - F.eval y∥ = ∥z∥ * ∥x - y∥ : by simp [hz]
-    ... ≤ 1 * ∥x - y∥ : mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _)
-    ... = ∥x - y∥ : by simp
+  ‖F.eval x - F.eval y‖ = ‖z‖ * ‖x - y‖ : by simp [hz]
+    ... ≤ 1 * ‖x - y‖ : mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _)
+    ... = ‖x - y‖ : by simp
 
 open filter metric
 
@@ -53,25 +56,25 @@ F.continuous_at.tendsto.comp ncs.tendsto_limit
 
 section
 parameters {p : ℕ} [fact p.prime] {ncs : cau_seq ℤ_[p] norm} {F : polynomial ℤ_[p]} {a : ℤ_[p]}
-           (ncs_der_val : ∀ n, ∥F.derivative.eval (ncs n)∥ = ∥F.derivative.eval a∥)
+           (ncs_der_val : ∀ n, ‖F.derivative.eval (ncs n)‖ = ‖F.derivative.eval a‖)
 include ncs_der_val
 
 private lemma ncs_tendsto_const :
-  tendsto (λ i, ∥F.derivative.eval (ncs i)∥) at_top (𝓝 ∥F.derivative.eval a∥) :=
+  tendsto (λ i, ‖F.derivative.eval (ncs i)‖) at_top (𝓝 ‖F.derivative.eval a‖) :=
 by convert tendsto_const_nhds; ext; rw ncs_der_val
 
 private lemma ncs_tendsto_lim :
-  tendsto (λ i, ∥F.derivative.eval (ncs i)∥) at_top (𝓝 (∥F.derivative.eval ncs.lim∥)) :=
+  tendsto (λ i, ‖F.derivative.eval (ncs i)‖) at_top (𝓝 (‖F.derivative.eval ncs.lim‖)) :=
 tendsto.comp (continuous_iff_continuous_at.1 continuous_norm _) (comp_tendsto_lim _)
 
-private lemma norm_deriv_eq : ∥F.derivative.eval ncs.lim∥ = ∥F.derivative.eval a∥ :=
+private lemma norm_deriv_eq : ‖F.derivative.eval ncs.lim‖ = ‖F.derivative.eval a‖ :=
 tendsto_nhds_unique ncs_tendsto_lim ncs_tendsto_const
 
 end
 
 section
 parameters {p : ℕ} [fact p.prime] {ncs : cau_seq ℤ_[p] norm} {F : polynomial ℤ_[p]}
-           (hnorm : tendsto (λ i, ∥F.eval (ncs i)∥) at_top (𝓝 0))
+           (hnorm : tendsto (λ i, ‖F.eval (ncs i)‖) at_top (𝓝 0))
 include hnorm
 
 private lemma tendsto_zero_of_norm_tendsto_zero : tendsto (λ i, F.eval (ncs i)) at_top (𝓝 0) :=
@@ -86,129 +89,125 @@ section hensel
 open nat
 
 parameters {p : ℕ} [fact p.prime] {F : polynomial ℤ_[p]} {a : ℤ_[p]}
-           (hnorm : ∥F.eval a∥ < ∥F.derivative.eval a∥^2) (hnsol : F.eval a ≠ 0)
+           (hnorm : ‖F.eval a‖ < ‖F.derivative.eval a‖^2) (hnsol : F.eval a ≠ 0)
 include hnorm
 
 /-- `T` is an auxiliary value that is used to control the behavior of the polynomial `F`. -/
-private def T : ℝ := ∥(F.eval a / (F.derivative.eval a)^2 : ℚ_[p])∥
+private def T : ℝ := ‖(F.eval a / (F.derivative.eval a)^2 : ℚ_[p])‖
 
-private lemma deriv_sq_norm_pos : 0 < ∥F.derivative.eval a∥ ^ 2 :=
+private lemma deriv_sq_norm_pos : 0 < ‖F.derivative.eval a‖ ^ 2 :=
 lt_of_le_of_lt (norm_nonneg _) hnorm
 
-private lemma deriv_sq_norm_ne_zero : ∥F.derivative.eval a∥^2 ≠ 0 := ne_of_gt deriv_sq_norm_pos
+private lemma deriv_sq_norm_ne_zero : ‖F.derivative.eval a‖^2 ≠ 0 := ne_of_gt deriv_sq_norm_pos
 
-private lemma deriv_norm_ne_zero : ∥F.derivative.eval a∥ ≠ 0 :=
+private lemma deriv_norm_ne_zero : ‖F.derivative.eval a‖ ≠ 0 :=
 λ h, deriv_sq_norm_ne_zero (by simp [*, sq])
 
-private lemma deriv_norm_pos : 0 < ∥F.derivative.eval a∥ :=
+private lemma deriv_norm_pos : 0 < ‖F.derivative.eval a‖ :=
 lt_of_le_of_ne (norm_nonneg _) (ne.symm deriv_norm_ne_zero)
 
 private lemma deriv_ne_zero : F.derivative.eval a ≠ 0 := mt norm_eq_zero.2 deriv_norm_ne_zero
 
-private lemma T_def : T = ∥F.eval a∥ / ∥F.derivative.eval a∥^2 :=
-calc T = ∥F.eval a∥ / ∥((F.derivative.eval a)^2 : ℚ_[p])∥ : norm_div _ _
-   ... = ∥F.eval a∥ / ∥(F.derivative.eval a)^2∥ : by simp [norm, padic_int.norm_def]
-   ... = ∥F.eval a∥ / ∥(F.derivative.eval a)∥^2 : by simp
+private lemma T_def : T = ‖F.eval a‖ / ‖F.derivative.eval a‖^2 :=
+by simp [T, ← padic_int.norm_def]
 
 private lemma T_lt_one : T < 1 :=
 let h := (div_lt_one deriv_sq_norm_pos).2 hnorm in
 by rw T_def; apply h
 
-private lemma T_pow {n : ℕ} (hn : n > 0) : T ^ n < 1 :=
-have T ^ n ≤ T ^ 1,
-from pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) (succ_le_of_lt hn),
-lt_of_le_of_lt (by simpa) T_lt_one
+private lemma T_nonneg : 0 ≤ T := norm_nonneg _
+
+private lemma T_pow_nonneg (n : ℕ) : 0 ≤ T ^ n := pow_nonneg T_nonneg _
 
-private lemma T_pow' (n : ℕ) : T ^ (2 ^ n) < 1 := (T_pow (pow_pos (by norm_num) _))
+private lemma T_pow {n : ℕ} (hn : n ≠ 0) : T ^ n < 1 := pow_lt_one T_nonneg T_lt_one hn
 
-private lemma T_pow_nonneg (n : ℕ) : 0 ≤ T ^ n := pow_nonneg (norm_nonneg _) _
+private lemma T_pow' (n : ℕ) : T ^ (2 ^ n) < 1 := T_pow (pow_ne_zero _ two_ne_zero)
 
 /-- We will construct a sequence of elements of ℤ_p satisfying successive values of `ih`. -/
 private def ih (n : ℕ) (z : ℤ_[p]) : Prop :=
-∥F.derivative.eval z∥ = ∥F.derivative.eval a∥ ∧ ∥F.eval z∥ ≤ ∥F.derivative.eval a∥^2 * T ^ (2^n)
+‖F.derivative.eval z‖ = ‖F.derivative.eval a‖ ∧ ‖F.eval z‖ ≤ ‖F.derivative.eval a‖^2 * T ^ (2^n)
 
 private lemma ih_0 : ih 0 a :=
 ⟨ rfl, by simp [T_def, mul_div_cancel' _ (ne_of_gt (deriv_sq_norm_pos hnorm))] ⟩
 
 private lemma calc_norm_le_one {n : ℕ} {z : ℤ_[p]} (hz : ih n z) :
-         ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1 :=
-calc ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥
-    = ∥(↑(F.eval z) : ℚ_[p])∥ / ∥(↑(F.derivative.eval z) : ℚ_[p])∥ : norm_div _ _
-... = ∥F.eval z∥ / ∥F.derivative.eval a∥ : by simp [hz.1]
-... ≤ ∥F.derivative.eval a∥^2 * T^(2^n) / ∥F.derivative.eval a∥ :
+         ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1 :=
+calc ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖
+    = ‖(↑(F.eval z) : ℚ_[p])‖ / ‖(↑(F.derivative.eval z) : ℚ_[p])‖ : norm_div _ _
+... = ‖F.eval z‖ / ‖F.derivative.eval a‖ : by simp [hz.1]
+... ≤ ‖F.derivative.eval a‖^2 * T^(2^n) / ‖F.derivative.eval a‖ :
   (div_le_div_right deriv_norm_pos).2 hz.2
-... = ∥F.derivative.eval a∥ * T^(2^n) : div_sq_cancel _ _
+... = ‖F.derivative.eval a‖ * T^(2^n) : div_sq_cancel _ _
 ... ≤ 1 : mul_le_one (padic_int.norm_le_one _) (T_pow_nonneg _) (le_of_lt (T_pow' _))
 
 private lemma calc_deriv_dist {z z' z1 : ℤ_[p]} (hz' : z' = z - z1)
-  (hz1 : ∥z1∥ = ∥F.eval z∥ / ∥F.derivative.eval a∥) {n} (hz : ih n z) :
-  ∥F.derivative.eval z' - F.derivative.eval z∥ < ∥F.derivative.eval a∥ :=
+  (hz1 : ‖z1‖ = ‖F.eval z‖ / ‖F.derivative.eval a‖) {n} (hz : ih n z) :
+  ‖F.derivative.eval z' - F.derivative.eval z‖ < ‖F.derivative.eval a‖ :=
 calc
-  ∥F.derivative.eval z' - F.derivative.eval z∥
-    ≤ ∥z' - z∥ : padic_polynomial_dist _ _ _
-... = ∥z1∥ : by simp only [sub_eq_add_neg, add_assoc, hz', add_add_neg_cancel'_right, norm_neg]
-... = ∥F.eval z∥ / ∥F.derivative.eval a∥ : hz1
-... ≤ ∥F.derivative.eval a∥^2 * T^(2^n) / ∥F.derivative.eval a∥ :
+  ‖F.derivative.eval z' - F.derivative.eval z‖
+    ≤ ‖z' - z‖ : padic_polynomial_dist _ _ _
+... = ‖z1‖ : by simp only [sub_eq_add_neg, add_assoc, hz', add_add_neg_cancel'_right, norm_neg]
+... = ‖F.eval z‖ / ‖F.derivative.eval a‖ : hz1
+... ≤ ‖F.derivative.eval a‖^2 * T^(2^n) / ‖F.derivative.eval a‖ :
   (div_le_div_right deriv_norm_pos).2 hz.2
-... = ∥F.derivative.eval a∥ * T^(2^n) : div_sq_cancel _ _
-... < ∥F.derivative.eval a∥ :
-  (mul_lt_iff_lt_one_right deriv_norm_pos).2 (T_pow (pow_pos (by norm_num) _))
+... = ‖F.derivative.eval a‖ * T^(2^n) : div_sq_cancel _ _
+... < ‖F.derivative.eval a‖ :
+  (mul_lt_iff_lt_one_right deriv_norm_pos).2 (T_pow' _)
 
 private def calc_eval_z'  {z z' z1 : ℤ_[p]} (hz' : z' = z - z1) {n} (hz : ih n z)
-  (h1 : ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1) (hzeq : z1 = ⟨_, h1⟩) :
+  (h1 : ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1) (hzeq : z1 = ⟨_, h1⟩) :
   {q : ℤ_[p] // F.eval z' = q * z1^2} :=
-have hdzne' : (↑(F.derivative.eval z) : ℚ_[p]) ≠ 0, from
-  have hdzne : F.derivative.eval z ≠ 0,
-    from mt norm_eq_zero.2 (by rw hz.1; apply deriv_norm_ne_zero; assumption),
-  λ h, hdzne $ subtype.ext_iff_val.2 h,
-let ⟨q, hq⟩ := F.binom_expansion z (-z1) in
-have ∥(↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)) : ℚ_[p])∥ ≤ 1,
-  by { rw padic_norm_e.mul, exact mul_le_one (padic_int.norm_le_one _) (norm_nonneg _) h1 },
-have F.derivative.eval z * (-z1) = -F.eval z, from calc
-  F.derivative.eval z * (-z1)
-    = (F.derivative.eval z) * -⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩ : by rw [hzeq]
-... = -((F.derivative.eval z) * ⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩) :
-  by simp [subtype.ext_iff_val]
-... = -(⟨↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)), this⟩) :
-  subtype.ext $ by simp
-... = -(F.eval z) : by simp [mul_div_cancel' _ hdzne'],
-have heq : F.eval z' = q * z1^2, by simpa [sub_eq_add_neg, this, hz'] using hq,
-⟨q, heq⟩
+begin
+  have hdzne : F.derivative.eval z ≠ 0 :=
+    mt norm_eq_zero.2 (by rw hz.1; apply deriv_norm_ne_zero; assumption),
+  have hdzne' : (↑(F.derivative.eval z) : ℚ_[p]) ≠ 0 := λ h, hdzne (subtype.ext_iff_val.2 h),
+  obtain ⟨q, hq⟩ := F.binom_expansion z (-z1),
+  have : ‖(↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)) : ℚ_[p])‖ ≤ 1,
+  { rw padic_norm_e.mul, exact mul_le_one (padic_int.norm_le_one _) (norm_nonneg _) h1 },
+  have : F.derivative.eval z * (-z1) = -F.eval z,
+  { calc F.derivative.eval z * (-z1)
+        = (F.derivative.eval z) * -⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩ : by rw [hzeq]
+    ... = -((F.derivative.eval z) * ⟨↑(F.eval z) / ↑(F.derivative.eval z), h1⟩) : mul_neg _ _
+    ... = -(⟨↑(F.derivative.eval z) * (↑(F.eval z) / ↑(F.derivative.eval z)), this⟩) :
+      subtype.ext $ by simp only [padic_int.coe_neg, padic_int.coe_mul, subtype.coe_mk]
+    ... = -(F.eval z) : by simp only [mul_div_cancel' _ hdzne', subtype.coe_eta] },
+  exact ⟨q, by simpa only [sub_eq_add_neg, this, hz', add_right_neg, neg_sq, zero_add] using hq⟩,
+end
 
 private def calc_eval_z'_norm {z z' z1 : ℤ_[p]} {n} (hz : ih n z) {q}
-  (heq : F.eval z' = q * z1^2) (h1 : ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1)
-  (hzeq : z1 = ⟨_, h1⟩) : ∥F.eval z'∥ ≤ ∥F.derivative.eval a∥^2 * T^(2^(n+1)) :=
-calc ∥F.eval z'∥
-    = ∥q∥ * ∥z1∥^2 : by simp [heq]
-... ≤ 1 * ∥z1∥^2 :
+  (heq : F.eval z' = q * z1^2) (h1 : ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1)
+  (hzeq : z1 = ⟨_, h1⟩) : ‖F.eval z'‖ ≤ ‖F.derivative.eval a‖^2 * T^(2^(n+1)) :=
+calc ‖F.eval z'‖
+    = ‖q‖ * ‖z1‖^2 : by simp [heq]
+... ≤ 1 * ‖z1‖^2 :
   mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (pow_nonneg (norm_nonneg _) _)
-... = ∥F.eval z∥^2 / ∥F.derivative.eval a∥^2 :
+... = ‖F.eval z‖^2 / ‖F.derivative.eval a‖^2 :
   by simp [hzeq, hz.1, div_pow]
-... ≤ (∥F.derivative.eval a∥^2 * T^(2^n))^2 / ∥F.derivative.eval a∥^2 :
+... ≤ (‖F.derivative.eval a‖^2 * T^(2^n))^2 / ‖F.derivative.eval a‖^2 :
   (div_le_div_right deriv_sq_norm_pos).2 (pow_le_pow_of_le_left (norm_nonneg _) hz.2 _)
-... = (∥F.derivative.eval a∥^2)^2 * (T^(2^n))^2 / ∥F.derivative.eval a∥^2 : by simp only [mul_pow]
-... = ∥F.derivative.eval a∥^2 * (T^(2^n))^2 : div_sq_cancel _ _
-... = ∥F.derivative.eval a∥^2 * T^(2^(n + 1)) : by rw [←pow_mul, pow_succ' 2]
+... = (‖F.derivative.eval a‖^2)^2 * (T^(2^n))^2 / ‖F.derivative.eval a‖^2 : by simp only [mul_pow]
+... = ‖F.derivative.eval a‖^2 * (T^(2^n))^2 : div_sq_cancel _ _
+... = ‖F.derivative.eval a‖^2 * T^(2^(n + 1)) : by rw [←pow_mul, pow_succ' 2]
 
 set_option eqn_compiler.zeta true
 
 /-- Given `z : ℤ_[p]` satisfying `ih n z`, construct `z' : ℤ_[p]` satisfying `ih (n+1) z'`. We need
 the hypothesis `ih n z`, since otherwise `z'` is not necessarily an integer. -/
 private def ih_n {n : ℕ} {z : ℤ_[p]} (hz : ih n z) : {z' : ℤ_[p] // ih (n+1) z'} :=
-have h1 : ∥(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)∥ ≤ 1, from calc_norm_le_one hz,
+have h1 : ‖(↑(F.eval z) : ℚ_[p]) / ↑(F.derivative.eval z)‖ ≤ 1, from calc_norm_le_one hz,
 let z1 : ℤ_[p] := ⟨_, h1⟩,
     z' : ℤ_[p] := z - z1 in
 ⟨ z',
-  have hdist : ∥F.derivative.eval z' - F.derivative.eval z∥ < ∥F.derivative.eval a∥,
+  have hdist : ‖F.derivative.eval z' - F.derivative.eval z‖ < ‖F.derivative.eval a‖,
     from calc_deriv_dist rfl (by simp [z1, hz.1]) hz,
-  have hfeq : ∥F.derivative.eval z'∥ = ∥F.derivative.eval a∥,
+  have hfeq : ‖F.derivative.eval z'‖ = ‖F.derivative.eval a‖,
     begin
       rw [sub_eq_add_neg, ← hz.1, ←norm_neg (F.derivative.eval z)] at hdist,
       have := padic_int.norm_eq_of_norm_add_lt_right hdist,
       rwa [norm_neg, hz.1] at this
     end,
   let ⟨q, heq⟩ := calc_eval_z' rfl hz h1 rfl in
-  have hnle : ∥F.eval z'∥ ≤ ∥F.derivative.eval a∥^2 * T^(2^(n+1)),
+  have hnle : ‖F.eval z'‖ ≤ ‖F.derivative.eval a‖^2 * T^(2^(n+1)),
     from calc_eval_z'_norm hz heq h1 rfl,
   ⟨hfeq, hnle⟩⟩
 
@@ -222,26 +221,26 @@ private noncomputable def newton_seq_aux : Π n : ℕ, {z : ℤ_[p] // ih n z}
 private def newton_seq (n : ℕ) : ℤ_[p] := (newton_seq_aux n).1
 
 private lemma newton_seq_deriv_norm (n : ℕ) :
-  ∥F.derivative.eval (newton_seq n)∥ = ∥F.derivative.eval a∥ :=
+  ‖F.derivative.eval (newton_seq n)‖ = ‖F.derivative.eval a‖ :=
 (newton_seq_aux n).2.1
 
 private lemma newton_seq_norm_le (n : ℕ) :
-  ∥F.eval (newton_seq n)∥ ≤ ∥F.derivative.eval a∥^2 * T ^ (2^n) :=
+  ‖F.eval (newton_seq n)‖ ≤ ‖F.derivative.eval a‖^2 * T ^ (2^n) :=
 (newton_seq_aux n).2.2
 
 private lemma newton_seq_norm_eq (n : ℕ) :
-  ∥newton_seq (n+1) - newton_seq n∥ =
-    ∥F.eval (newton_seq n)∥ / ∥F.derivative.eval (newton_seq n)∥ :=
+  ‖newton_seq (n+1) - newton_seq n‖ =
+    ‖F.eval (newton_seq n)‖ / ‖F.derivative.eval (newton_seq n)‖ :=
 by simp [newton_seq, newton_seq_aux, ih_n, sub_eq_add_neg, add_comm]
 
 private lemma newton_seq_succ_dist (n : ℕ) :
-  ∥newton_seq (n+1) - newton_seq n∥ ≤ ∥F.derivative.eval a∥ * T^(2^n) :=
-calc ∥newton_seq (n+1) - newton_seq n∥
-    = ∥F.eval (newton_seq n)∥ / ∥F.derivative.eval (newton_seq n)∥ : newton_seq_norm_eq _
-... = ∥F.eval (newton_seq n)∥ / ∥F.derivative.eval a∥ : by rw newton_seq_deriv_norm
-... ≤ ∥F.derivative.eval a∥^2 * T ^ (2^n) / ∥F.derivative.eval a∥ :
+  ‖newton_seq (n+1) - newton_seq n‖ ≤ ‖F.derivative.eval a‖ * T^(2^n) :=
+calc ‖newton_seq (n+1) - newton_seq n‖
+    = ‖F.eval (newton_seq n)‖ / ‖F.derivative.eval (newton_seq n)‖ : newton_seq_norm_eq _
+... = ‖F.eval (newton_seq n)‖ / ‖F.derivative.eval a‖ : by rw newton_seq_deriv_norm
+... ≤ ‖F.derivative.eval a‖^2 * T ^ (2^n) / ‖F.derivative.eval a‖ :
   (div_le_div_right deriv_norm_pos).2 (newton_seq_norm_le _)
-... = ∥F.derivative.eval a∥ * T^(2^n) : div_sq_cancel _ _
+... = ‖F.derivative.eval a‖ * T^(2^n) : div_sq_cancel _ _
 
 include hnsol
 private lemma T_pos : T > 0 :=
@@ -251,18 +250,18 @@ begin
 end
 
 private lemma newton_seq_succ_dist_weak (n : ℕ) :
-  ∥newton_seq (n+2) - newton_seq (n+1)∥ < ∥F.eval a∥ / ∥F.derivative.eval a∥ :=
+  ‖newton_seq (n+2) - newton_seq (n+1)‖ < ‖F.eval a‖ / ‖F.derivative.eval a‖ :=
 have 2 ≤ 2^(n+1),
   from have _, from pow_le_pow (by norm_num : 1 ≤ 2) (nat.le_add_left _ _ : 1 ≤ n + 1),
     by simpa using this,
-calc ∥newton_seq (n+2) - newton_seq (n+1)∥
-    ≤ ∥F.derivative.eval a∥ * T^(2^(n+1)) : newton_seq_succ_dist _
-... ≤ ∥F.derivative.eval a∥ * T^2 :
+calc ‖newton_seq (n+2) - newton_seq (n+1)‖
+    ≤ ‖F.derivative.eval a‖ * T^(2^(n+1)) : newton_seq_succ_dist _
+... ≤ ‖F.derivative.eval a‖ * T^2 :
   mul_le_mul_of_nonneg_left (pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) this)
     (norm_nonneg _)
-... < ∥F.derivative.eval a∥ * T^1 :
+... < ‖F.derivative.eval a‖ * T^1 :
   mul_lt_mul_of_pos_left (pow_lt_pow_of_lt_one T_pos T_lt_one (by norm_num)) deriv_norm_pos
-... = ∥F.eval a∥ / ∥F.derivative.eval a∥ :
+... = ‖F.eval a‖ / ‖F.derivative.eval a‖ :
   begin
     rw [T, sq, pow_one, norm_div, ←mul_div_assoc, padic_norm_e.mul],
     apply mul_div_mul_left,
@@ -270,69 +269,67 @@ calc ∥newton_seq (n+2) - newton_seq (n+1)∥
   end
 
 private lemma newton_seq_dist_aux (n : ℕ) :
-  ∀ k : ℕ, ∥newton_seq (n + k) - newton_seq n∥ ≤ ∥F.derivative.eval a∥ * T^(2^n)
+  ∀ k : ℕ, ‖newton_seq (n + k) - newton_seq n‖ ≤ ‖F.derivative.eval a‖ * T^(2^n)
 | 0 := by simp [T_pow_nonneg hnorm, mul_nonneg]
 | (k+1) :=
   have 2^n ≤ 2^(n+k),
     by {apply pow_le_pow, norm_num, apply nat.le_add_right},
   calc
-  ∥newton_seq (n + (k + 1)) - newton_seq n∥
-    = ∥newton_seq ((n + k) + 1) - newton_seq n∥ : by rw add_assoc
-... = ∥(newton_seq ((n + k) + 1) - newton_seq (n+k)) + (newton_seq (n+k) - newton_seq n)∥ :
+  ‖newton_seq (n + (k + 1)) - newton_seq n‖
+    = ‖newton_seq ((n + k) + 1) - newton_seq n‖ : by rw add_assoc
+... = ‖(newton_seq ((n + k) + 1) - newton_seq (n+k)) + (newton_seq (n+k) - newton_seq n)‖ :
   by rw ←sub_add_sub_cancel
-... ≤ max (∥newton_seq ((n + k) + 1) - newton_seq (n+k)∥) (∥newton_seq (n+k) - newton_seq n∥) :
+... ≤ max (‖newton_seq ((n + k) + 1) - newton_seq (n+k)‖) (‖newton_seq (n+k) - newton_seq n‖) :
   padic_int.nonarchimedean _ _
-... ≤ max (∥F.derivative.eval a∥ * T^(2^((n + k)))) (∥F.derivative.eval a∥ * T^(2^n)) :
+... ≤ max (‖F.derivative.eval a‖ * T^(2^((n + k)))) (‖F.derivative.eval a‖ * T^(2^n)) :
   max_le_max (newton_seq_succ_dist _) (newton_seq_dist_aux _)
-... = ∥F.derivative.eval a∥ * T^(2^n) :
+... = ‖F.derivative.eval a‖ * T^(2^n) :
   max_eq_right $ mul_le_mul_of_nonneg_left
     (pow_le_pow_of_le_one (norm_nonneg _) (le_of_lt T_lt_one) this) (norm_nonneg _)
 
 private lemma newton_seq_dist {n k : ℕ} (hnk : n ≤ k) :
-  ∥newton_seq k - newton_seq n∥ ≤ ∥F.derivative.eval a∥ * T^(2^n) :=
+  ‖newton_seq k - newton_seq n‖ ≤ ‖F.derivative.eval a‖ * T^(2^n) :=
 have hex : ∃ m, k = n + m, from exists_eq_add_of_le hnk,
 let ⟨_, hex'⟩ := hex in
 by rw hex'; apply newton_seq_dist_aux; assumption
 
 private lemma newton_seq_dist_to_a :
-  ∀ n : ℕ, 0 < n → ∥newton_seq n - a∥ = ∥F.eval a∥ / ∥F.derivative.eval a∥
+  ∀ n : ℕ, 0 < n → ‖newton_seq n - a‖ = ‖F.eval a‖ / ‖F.derivative.eval a‖
 | 1 h := by simp [sub_eq_add_neg, add_assoc, newton_seq, newton_seq_aux, ih_n]
 | (k+2) h :=
-  have hlt : ∥newton_seq (k+2) - newton_seq (k+1)∥ < ∥newton_seq (k+1) - a∥,
+  have hlt : ‖newton_seq (k+2) - newton_seq (k+1)‖ < ‖newton_seq (k+1) - a‖,
     by rw newton_seq_dist_to_a (k+1) (succ_pos _); apply newton_seq_succ_dist_weak; assumption,
-  have hne' : ∥newton_seq (k + 2) - newton_seq (k+1)∥ ≠ ∥newton_seq (k+1) - a∥, from ne_of_lt hlt,
-  calc  ∥newton_seq (k + 2) - a∥
-    = ∥(newton_seq (k + 2) - newton_seq (k+1)) + (newton_seq (k+1) - a)∥ : by rw ←sub_add_sub_cancel
-... = max (∥newton_seq (k + 2) - newton_seq (k+1)∥) (∥newton_seq (k+1) - a∥) :
+  have hne' : ‖newton_seq (k + 2) - newton_seq (k+1)‖ ≠ ‖newton_seq (k+1) - a‖, from ne_of_lt hlt,
+  calc  ‖newton_seq (k + 2) - a‖
+    = ‖(newton_seq (k + 2) - newton_seq (k+1)) + (newton_seq (k+1) - a)‖ : by rw ←sub_add_sub_cancel
+... = max (‖newton_seq (k + 2) - newton_seq (k+1)‖) (‖newton_seq (k+1) - a‖) :
   padic_int.norm_add_eq_max_of_ne hne'
-... = ∥newton_seq (k+1) - a∥ : max_eq_right_of_lt hlt
-... = ∥polynomial.eval a F∥ / ∥polynomial.eval a (polynomial.derivative F)∥ :
+... = ‖newton_seq (k+1) - a‖ : max_eq_right_of_lt hlt
+... = ‖polynomial.eval a F‖ / ‖polynomial.eval a (polynomial.derivative F)‖ :
   newton_seq_dist_to_a (k+1) (succ_pos _)
 
-private lemma bound' : tendsto (λ n : ℕ, ∥F.derivative.eval a∥ * T^(2^n)) at_top (𝓝 0) :=
+private lemma bound' : tendsto (λ n : ℕ, ‖F.derivative.eval a‖ * T^(2^n)) at_top (𝓝 0) :=
 begin
-  rw ←mul_zero (∥F.derivative.eval a∥),
+  rw ←mul_zero (‖F.derivative.eval a‖),
   exact tendsto_const_nhds.mul
                     (tendsto.comp
                       (tendsto_pow_at_top_nhds_0_of_lt_1 (norm_nonneg _) (T_lt_one hnorm))
                       (nat.tendsto_pow_at_top_at_top_of_one_lt (by norm_num)))
 end
 
-private lemma bound : ∀ {ε}, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → ∥F.derivative.eval a∥ * T^(2^n) < ε :=
-have mtn : ∀ n : ℕ, ∥polynomial.eval a (polynomial.derivative F)∥ * T ^ (2 ^ n) ≥ 0,
-  from λ n, mul_nonneg (norm_nonneg _) (T_pow_nonneg _),
+private lemma bound : ∀ {ε}, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → ‖F.derivative.eval a‖ * T^(2^n) < ε :=
 begin
   have := bound' hnorm hnsol,
   simp [tendsto, nhds] at this,
   intros ε hε,
   cases this (ball 0 ε) (mem_ball_self hε) (is_open_ball) with N hN,
   existsi N, intros n hn,
-  simpa [norm_mul, real.norm_eq_abs, abs_of_nonneg (mtn n)] using hN _ hn
+  simpa [abs_of_nonneg (T_nonneg _)] using hN _ hn
 end
 
-private lemma bound'_sq : tendsto (λ n : ℕ, ∥F.derivative.eval a∥^2 * T^(2^n)) at_top (𝓝 0) :=
+private lemma bound'_sq : tendsto (λ n : ℕ, ‖F.derivative.eval a‖^2 * T^(2^n)) at_top (𝓝 0) :=
 begin
-  rw [←mul_zero (∥F.derivative.eval a∥), sq],
+  rw [←mul_zero (‖F.derivative.eval a‖), sq],
   simp only [mul_assoc],
   apply tendsto.mul,
   { apply tendsto_const_nhds },
@@ -355,28 +352,28 @@ private def newton_cau_seq : cau_seq ℤ_[p] norm := ⟨_, newton_seq_is_cauchy
 private def soln : ℤ_[p] := newton_cau_seq.lim
 
 private lemma soln_spec {ε : ℝ} (hε : ε > 0) :
-  ∃ (N : ℕ), ∀ {i : ℕ}, i ≥ N → ∥soln - newton_cau_seq i∥ < ε :=
+  ∃ (N : ℕ), ∀ {i : ℕ}, i ≥ N → ‖soln - newton_cau_seq i‖ < ε :=
 setoid.symm (cau_seq.equiv_lim newton_cau_seq) _ hε
 
-private lemma soln_deriv_norm : ∥F.derivative.eval soln∥ = ∥F.derivative.eval a∥ :=
+private lemma soln_deriv_norm : ‖F.derivative.eval soln‖ = ‖F.derivative.eval a‖ :=
 norm_deriv_eq newton_seq_deriv_norm
 
 private lemma newton_seq_norm_tendsto_zero :
-  tendsto (λ i, ∥F.eval (newton_cau_seq i)∥) at_top (𝓝 0) :=
+  tendsto (λ i, ‖F.eval (newton_cau_seq i)‖) at_top (𝓝 0) :=
 squeeze_zero (λ _, norm_nonneg _) newton_seq_norm_le bound'_sq
 
 private lemma newton_seq_dist_tendsto :
-  tendsto (λ n, ∥newton_cau_seq n - a∥) at_top (𝓝 (∥F.eval a∥ / ∥F.derivative.eval a∥)) :=
+  tendsto (λ n, ‖newton_cau_seq n - a‖) at_top (𝓝 (‖F.eval a‖ / ‖F.derivative.eval a‖)) :=
 tendsto_const_nhds.congr' $ eventually_at_top.2 ⟨1, λ _ hx, (newton_seq_dist_to_a _ hx).symm⟩
 
 private lemma newton_seq_dist_tendsto' :
-  tendsto (λ n, ∥newton_cau_seq n - a∥) at_top (𝓝 ∥soln - a∥) :=
+  tendsto (λ n, ‖newton_cau_seq n - a‖) at_top (𝓝 ‖soln - a‖) :=
 (continuous_norm.tendsto _).comp (newton_cau_seq.tendsto_limit.sub tendsto_const_nhds)
 
-private lemma soln_dist_to_a : ∥soln - a∥ = ∥F.eval a∥ / ∥F.derivative.eval a∥ :=
+private lemma soln_dist_to_a : ‖soln - a‖ = ‖F.eval a‖ / ‖F.derivative.eval a‖ :=
 tendsto_nhds_unique newton_seq_dist_tendsto' newton_seq_dist_tendsto
 
-private lemma soln_dist_to_a_lt_deriv : ∥soln - a∥ < ∥F.derivative.eval a∥ :=
+private lemma soln_dist_to_a_lt_deriv : ‖soln - a‖ < ‖F.derivative.eval a‖ :=
 begin
   rw [soln_dist_to_a, div_lt_iff],
   { rwa sq at hnorm },
@@ -387,12 +384,12 @@ private lemma eval_soln : F.eval soln = 0 :=
 limit_zero_of_norm_tendsto_zero newton_seq_norm_tendsto_zero
 
 private lemma soln_unique (z : ℤ_[p]) (hev : F.eval z = 0)
-  (hnlt : ∥z - a∥ < ∥F.derivative.eval a∥) :
+  (hnlt : ‖z - a‖ < ‖F.derivative.eval a‖) :
   z = soln :=
-have soln_dist : ∥z - soln∥ < ∥F.derivative.eval a∥, from calc
-  ∥z - soln∥ = ∥(z - a) + (a - soln)∥ : by rw sub_add_sub_cancel
-        ... ≤ max (∥z - a∥) (∥a - soln∥) : padic_int.nonarchimedean _ _
-        ... < ∥F.derivative.eval a∥ : max_lt hnlt (norm_sub_rev soln a ▸ soln_dist_to_a_lt_deriv),
+have soln_dist : ‖z - soln‖ < ‖F.derivative.eval a‖, from calc
+  ‖z - soln‖ = ‖(z - a) + (a - soln)‖ : by rw sub_add_sub_cancel
+        ... ≤ max (‖z - a‖) (‖a - soln‖) : padic_int.nonarchimedean _ _
+        ... < ‖F.derivative.eval a‖ : max_lt hnlt (norm_sub_rev soln a ▸ soln_dist_to_a_lt_deriv),
 let h := z - soln,
     ⟨q, hq⟩ := F.binom_expansion soln h in
 have (F.derivative.eval soln + q * h) * h = 0, from eq.symm (calc
@@ -402,14 +399,14 @@ have (F.derivative.eval soln + q * h) * h = 0, from eq.symm (calc
 have h = 0, from by_contradiction $ λ hne,
   have F.derivative.eval soln + q * h = 0,
     from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hne,
-  have F.derivative.eval soln = (-q) * h, by simpa using eq_neg_of_add_eq_zero this,
-  lt_irrefl ∥F.derivative.eval soln∥ (calc
-  ∥F.derivative.eval soln∥ = ∥(-q) * h∥ : by rw this
-... ≤ 1 * ∥h∥ :
+  have F.derivative.eval soln = (-q) * h, by simpa using eq_neg_of_add_eq_zero_left this,
+  lt_irrefl ‖F.derivative.eval soln‖ (calc
+  ‖F.derivative.eval soln‖ = ‖(-q) * h‖ : by rw this
+... ≤ 1 * ‖h‖ :
   by { rw padic_int.norm_mul,
        exact mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _) }
-... = ∥z - soln∥ : by simp [h]
-... < ∥F.derivative.eval soln∥ : by rw soln_deriv_norm; apply soln_dist),
+... = ‖z - soln‖ : by simp [h]
+... < ‖F.derivative.eval soln‖ : by rw soln_deriv_norm; apply soln_dist),
 eq_of_sub_eq_zero (by rw ←this; refl)
 
 end hensel
@@ -417,7 +414,7 @@ end hensel
 variables {p : ℕ} [fact p.prime] {F : polynomial ℤ_[p]} {a : ℤ_[p]}
 
 private lemma a_soln_is_unique (ha : F.eval a = 0) (z' : ℤ_[p]) (hz' : F.eval z' = 0)
-  (hnormz' : ∥z' - a∥ < ∥F.derivative.eval a∥) : z' = a :=
+  (hnormz' : ‖z' - a‖ < ‖F.derivative.eval a‖) : z' = a :=
 let h := z' - a,
     ⟨q, hq⟩ := F.binom_expansion a h in
 have (F.derivative.eval a + q * h) * h = 0, from eq.symm (calc
@@ -427,24 +424,24 @@ have (F.derivative.eval a + q * h) * h = 0, from eq.symm (calc
 have h = 0, from by_contradiction $ λ hne,
   have F.derivative.eval a + q * h = 0,
     from (eq_zero_or_eq_zero_of_mul_eq_zero this).resolve_right hne,
-  have F.derivative.eval a = (-q) * h, by simpa using eq_neg_of_add_eq_zero this,
-  lt_irrefl ∥F.derivative.eval a∥ (calc
-    ∥F.derivative.eval a∥ = ∥q∥*∥h∥ : by simp [this]
-    ... ≤ 1*∥h∥ : mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _)
-    ... < ∥F.derivative.eval a∥ : by simpa [h]),
+  have F.derivative.eval a = (-q) * h, by simpa using eq_neg_of_add_eq_zero_left this,
+  lt_irrefl ‖F.derivative.eval a‖ (calc
+    ‖F.derivative.eval a‖ = ‖q‖*‖h‖ : by simp [this]
+    ... ≤ 1*‖h‖ : mul_le_mul_of_nonneg_right (padic_int.norm_le_one _) (norm_nonneg _)
+    ... < ‖F.derivative.eval a‖ : by simpa [h]),
 eq_of_sub_eq_zero (by rw ←this; refl)
 
-variable (hnorm : ∥F.eval a∥ < ∥F.derivative.eval a∥^2)
+variable (hnorm : ‖F.eval a‖ < ‖F.derivative.eval a‖^2)
 include hnorm
 
 private lemma a_is_soln (ha : F.eval a = 0) :
-  F.eval a = 0 ∧ ∥a - a∥ < ∥F.derivative.eval a∥ ∧ ∥F.derivative.eval a∥ = ∥F.derivative.eval a∥ ∧
-  ∀ z', F.eval z' = 0 → ∥z' - a∥ < ∥F.derivative.eval a∥ → z' = a :=
+  F.eval a = 0 ∧ ‖a - a‖ < ‖F.derivative.eval a‖ ∧ ‖F.derivative.eval a‖ = ‖F.derivative.eval a‖ ∧
+  ∀ z', F.eval z' = 0 → ‖z' - a‖ < ‖F.derivative.eval a‖ → z' = a :=
 ⟨ha, by simp [deriv_ne_zero hnorm], rfl, a_soln_is_unique ha⟩
 
-lemma hensels_lemma : ∃ z : ℤ_[p], F.eval z = 0 ∧ ∥z - a∥ < ∥F.derivative.eval a∥ ∧
-  ∥F.derivative.eval z∥ = ∥F.derivative.eval a∥ ∧
-  ∀ z', F.eval z' = 0 → ∥z' - a∥ < ∥F.derivative.eval a∥ → z' = z :=
+lemma hensels_lemma : ∃ z : ℤ_[p], F.eval z = 0 ∧ ‖z - a‖ < ‖F.derivative.eval a‖ ∧
+  ‖F.derivative.eval z‖ = ‖F.derivative.eval a‖ ∧
+  ∀ z', F.eval z' = 0 → ‖z' - a‖ < ‖F.derivative.eval a‖ → z' = z :=
 if ha : F.eval a = 0 then ⟨a, a_is_soln hnorm ha⟩ else
 by refine ⟨soln _ _, eval_soln _ _, soln_dist_to_a_lt_deriv _ _, soln_deriv_norm _ _,
   soln_unique _ _⟩; assumption
diff --git a/src/number_theory/padics/padic_integers.lean b/src/number_theory/padics/padic_integers.lean
index 509275061ac22..d0c66151065c3 100644
--- a/src/number_theory/padics/padic_integers.lean
+++ b/src/number_theory/padics/padic_integers.lean
@@ -3,38 +3,39 @@ Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis, Mario Carneiro, Johan Commelin
 -/
-import data.int.modeq
 import number_theory.padics.padic_numbers
-import ring_theory.discrete_valuation_ring
-import topology.metric_space.cau_seq_filter
+import ring_theory.discrete_valuation_ring.basic
 
 /-!
 # p-adic integers
 
-This file defines the p-adic integers `ℤ_p` as the subtype of `ℚ_p` with norm `≤ 1`.
-We show that `ℤ_p`
-* is complete
-* is nonarchimedean
-* is a normed ring
-* is a local ring
-* is a discrete valuation ring
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the `p`-adic integers `ℤ_[p]` as the subtype of `ℚ_[p]` with norm `≤ 1`.
+We show that `ℤ_[p]`
+* is complete,
+* is nonarchimedean,
+* is a normed ring,
+* is a local ring, and
+* is a discrete valuation ring.
 
 The relation between `ℤ_[p]` and `zmod p` is established in another file.
 
 ## Important definitions
 
-* `padic_int` : the type of p-adic numbers
+* `padic_int` : the type of `p`-adic integers
 
 ## Notation
 
-We introduce the notation `ℤ_[p]` for the p-adic integers.
+We introduce the notation `ℤ_[p]` for the `p`-adic integers.
 
 ## Implementation notes
 
 Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
-by taking `[fact (nat.prime p)] as a type class argument.
+by taking `[fact p.prime]` as a type class argument.
 
-Coercions into `ℤ_p` are set up to work with the `norm_cast` tactic.
+Coercions into `ℤ_[p]` are set up to work with the `norm_cast` tactic.
 
 ## References
 
@@ -51,108 +52,92 @@ open padic metric local_ring
 noncomputable theory
 open_locale classical
 
-/-- The p-adic integers ℤ_p are the p-adic numbers with norm ≤ 1. -/
-def padic_int (p : ℕ) [fact p.prime] := {x : ℚ_[p] // ∥x∥ ≤ 1}
+/-- The `p`-adic integers `ℤ_[p]` are the `p`-adic numbers with norm `≤ 1`. -/
+def padic_int (p : ℕ) [fact p.prime] := {x : ℚ_[p] // ‖x‖ ≤ 1}
+
 notation `ℤ_[`p`]` := padic_int p
 
 namespace padic_int
+
 /-! ### Ring structure and coercion to `ℚ_[p]` -/
+
 variables {p : ℕ} [fact p.prime]
 
 instance : has_coe ℤ_[p] ℚ_[p] := ⟨subtype.val⟩
 
-lemma ext {x y : ℤ_[p]} : (x : ℚ_[p]) = y → x = y := subtype.ext_iff_val.2
+lemma ext {x y : ℤ_[p]} : (x : ℚ_[p]) = y → x = y := subtype.ext
 
-/-- Addition on ℤ_p is inherited from ℚ_p. -/
-instance : has_add ℤ_[p] :=
-⟨λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨x+y,
-    le_trans (padic_norm_e.nonarchimedean _ _) (max_le_iff.2 ⟨hx,hy⟩)⟩⟩
+variables (p)
+
+/-- The `p`-adic integers as a subring of `ℚ_[p]`. -/
+def subring : subring (ℚ_[p]) :=
+{ carrier := {x : ℚ_[p] | ‖x‖ ≤ 1},
+  zero_mem' := by norm_num,
+  one_mem' := by norm_num,
+  add_mem' := λ x y hx hy, (padic_norm_e.nonarchimedean _ _).trans $ max_le_iff.2 ⟨hx, hy⟩,
+  mul_mem' := λ x y hx hy, (padic_norm_e.mul _ _).trans_le $ mul_le_one hx (norm_nonneg _) hy,
+  neg_mem' := λ x hx, (norm_neg _).trans_le hx }
+
+@[simp] lemma mem_subring_iff {x : ℚ_[p]} : x ∈ subring p ↔ ‖x‖ ≤ 1 := iff.rfl
+
+variables {p}
 
-/-- Multiplication on ℤ_p is inherited from ℚ_p. -/
-instance : has_mul ℤ_[p] :=
-⟨λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨x*y,
-    begin rw padic_norm_e.mul, apply mul_le_one; {assumption <|> apply norm_nonneg} end⟩⟩
+/-- Addition on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
+instance : has_add ℤ_[p] := (by apply_instance : has_add (subring p))
 
-/-- Negation on ℤ_p is inherited from ℚ_p. -/
-instance : has_neg ℤ_[p] :=
-⟨λ ⟨x, hx⟩, ⟨-x, by simpa⟩⟩
+/-- Multiplication on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
+instance : has_mul ℤ_[p] := (by apply_instance : has_mul (subring p))
 
-/-- Subtraction on ℤ_p is inherited from ℚ_p. -/
-instance : has_sub ℤ_[p] :=
-⟨λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨x - y,
-  by { rw sub_eq_add_neg, rw ← norm_neg at hy,
-       exact le_trans (padic_norm_e.nonarchimedean _ _) (max_le_iff.2 ⟨hx, hy⟩) }⟩⟩
+/-- Negation on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
+instance : has_neg ℤ_[p] := (by apply_instance : has_neg (subring p))
 
-/-- Zero on ℤ_p is inherited from ℚ_p. -/
-instance : has_zero ℤ_[p] :=
-⟨⟨0, by norm_num⟩⟩
+/-- Subtraction on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
+instance : has_sub ℤ_[p] := (by apply_instance : has_sub (subring p))
+
+/-- Zero on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
+instance : has_zero ℤ_[p] := (by apply_instance : has_zero (subring p))
 
 instance : inhabited ℤ_[p] := ⟨0⟩
 
-/-- One on ℤ_p is inherited from ℚ_p. -/
-instance : has_one ℤ_[p] :=
-⟨⟨1, by norm_num⟩⟩
+/-- One on `ℤ_[p]` is inherited from `ℚ_[p]`. -/
+instance : has_one ℤ_[p] := ⟨⟨1, by norm_num⟩⟩
 
 @[simp] lemma mk_zero {h} : (⟨0, h⟩ : ℤ_[p]) = (0 : ℤ_[p]) := rfl
 
 @[simp] lemma val_eq_coe (z : ℤ_[p]) : z.val = z := rfl
 
-@[simp, norm_cast] lemma coe_add : ∀ (z1 z2 : ℤ_[p]), ((z1 + z2 : ℤ_[p]) : ℚ_[p]) = z1 + z2
-| ⟨_, _⟩ ⟨_, _⟩ := rfl
+@[simp, norm_cast] lemma coe_add (z1 z2 : ℤ_[p]) : ((z1 + z2 : ℤ_[p]) : ℚ_[p]) = z1 + z2 := rfl
+@[simp, norm_cast] lemma coe_mul (z1 z2 : ℤ_[p]) : ((z1 * z2 : ℤ_[p]) : ℚ_[p]) = z1 * z2 := rfl
+@[simp, norm_cast] lemma coe_neg (z1 : ℤ_[p]) : ((-z1 : ℤ_[p]) : ℚ_[p]) = -z1 := rfl
+@[simp, norm_cast] lemma coe_sub (z1 z2 : ℤ_[p]) : ((z1 - z2 : ℤ_[p]) : ℚ_[p]) = z1 - z2 := rfl
+@[simp, norm_cast] lemma coe_one : ((1 : ℤ_[p]) : ℚ_[p]) = 1 := rfl
+@[simp, norm_cast] lemma coe_zero : ((0 : ℤ_[p]) : ℚ_[p]) = 0 := rfl
 
-@[simp, norm_cast] lemma coe_mul : ∀ (z1 z2 : ℤ_[p]), ((z1 * z2 : ℤ_[p]) : ℚ_[p]) = z1 * z2
-| ⟨_, _⟩ ⟨_, _⟩ := rfl
+lemma coe_eq_zero (z : ℤ_[p]) : (z : ℚ_[p]) = 0 ↔ z = 0 :=
+by rw [← coe_zero, subtype.coe_inj]
 
-@[simp, norm_cast] lemma coe_neg : ∀ (z1 : ℤ_[p]), ((-z1 : ℤ_[p]) : ℚ_[p]) = -z1
-| ⟨_, _⟩ := rfl
+lemma coe_ne_zero (z : ℤ_[p]) : (z : ℚ_[p]) ≠ 0 ↔ z ≠ 0 := z.coe_eq_zero.not
 
-@[simp, norm_cast] lemma coe_sub : ∀ (z1 z2 : ℤ_[p]), ((z1 - z2 : ℤ_[p]) : ℚ_[p]) = z1 - z2
-| ⟨_, _⟩ ⟨_, _⟩ := rfl
+instance : add_comm_group ℤ_[p] :=
+(by apply_instance : add_comm_group (subring p))
 
-@[simp, norm_cast] lemma coe_one : ((1 : ℤ_[p]) : ℚ_[p]) = 1 := rfl
+instance : comm_ring ℤ_[p] :=
+(by apply_instance : comm_ring (subring p))
 
-@[simp, norm_cast] lemma coe_coe : ∀ n : ℕ, ((n : ℤ_[p]) : ℚ_[p]) = n
-| 0 := rfl
-| (k+1) := by simp [coe_coe]
+@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ((n : ℤ_[p]) : ℚ_[p]) = n := rfl
+@[simp, norm_cast] lemma coe_int_cast (z : ℤ) : ((z : ℤ_[p]) : ℚ_[p]) = z := rfl
 
+/-- The coercion from `ℤ_[p]` to `ℚ_[p]` as a ring homomorphism. -/
+def coe.ring_hom : ℤ_[p] →+* ℚ_[p] := (subring p).subtype
 
-@[simp, norm_cast] lemma coe_coe_int : ∀ (z : ℤ), ((z : ℤ_[p]) : ℚ_[p]) = z
-| (int.of_nat n) := by simp
-| -[1+n] := by simp
+@[simp, norm_cast] lemma coe_pow (x : ℤ_[p]) (n : ℕ) : (↑(x^n) : ℚ_[p]) = (↑x : ℚ_[p])^n := rfl
 
-@[simp, norm_cast] lemma coe_zero : ((0 : ℤ_[p]) : ℚ_[p]) = 0 := rfl
+@[simp] lemma mk_coe (k : ℤ_[p]) : (⟨k, k.2⟩ : ℤ_[p]) = k := subtype.coe_eta _ _
 
-instance : ring ℤ_[p] :=
-by refine_struct
-{ add   := (+),
-  mul   := (*),
-  neg   := has_neg.neg,
-  zero  := (0 : ℤ_[p]),
-  one   := 1,
-  sub   := has_sub.sub,
-  npow  := @npow_rec _ ⟨(1 : ℤ_[p])⟩ ⟨(*)⟩,
-  nsmul := @nsmul_rec _ ⟨(0 : ℤ_[p])⟩ ⟨(+)⟩,
-  zsmul := @zsmul_rec _ ⟨(0 : ℤ_[p])⟩ ⟨(+)⟩ ⟨has_neg.neg⟩ };
-intros; try { refl }; ext; simp; ring
-
-/-- The coercion from ℤ[p] to ℚ[p] as a ring homomorphism. -/
-def coe.ring_hom : ℤ_[p] →+* ℚ_[p]  :=
-{ to_fun := (coe : ℤ_[p] → ℚ_[p]),
-  map_zero' := rfl,
-  map_one' := rfl,
-  map_mul' := coe_mul,
-  map_add' := coe_add }
-
-@[simp, norm_cast] lemma coe_pow (x : ℤ_[p]) (n : ℕ) : (↑(x^n) : ℚ_[p]) = (↑x : ℚ_[p])^n :=
-(coe.ring_hom : ℤ_[p] →+* ℚ_[p]).map_pow x n
-
-@[simp] lemma mk_coe : ∀ (k : ℤ_[p]), (⟨k, k.2⟩ : ℤ_[p]) = k
-| ⟨_, _⟩ := rfl
-
-/-- The inverse of a p-adic integer with norm equal to 1 is also a p-adic integer. Otherwise, the
-inverse is defined to be 0. -/
+/-- The inverse of a `p`-adic integer with norm equal to `1` is also a `p`-adic integer.
+Otherwise, the inverse is defined to be `0`. -/
 def inv : ℤ_[p] → ℤ_[p]
-| ⟨k, _⟩ := if h : ∥k∥ = 1 then ⟨1/k, by simp [h]⟩ else 0
+| ⟨k, _⟩ := if h : ‖k‖ = 1 then ⟨k⁻¹, by simp [h]⟩ else 0
 
 instance : char_zero ℤ_[p] :=
 { cast_injective :=
@@ -163,10 +148,8 @@ instance : char_zero ℤ_[p] :=
 suffices (z1 : ℚ_[p]) = z2 ↔ z1 = z2, from iff.trans (by norm_cast) this,
 by norm_cast
 
-/--
-A sequence of integers that is Cauchy with respect to the `p`-adic norm
-converges to a `p`-adic integer.
--/
+/-- A sequence of integers that is Cauchy with respect to the `p`-adic norm converges to a `p`-adic
+integer. -/
 def of_int_seq (seq : ℕ → ℤ) (h : is_cau_seq (padic_norm p) (λ n, seq n)) : ℤ_[p] :=
 ⟨⟦⟨_, h⟩⟧,
  show ↑(padic_seq.norm _) ≤ (1 : ℝ), begin
@@ -179,8 +162,8 @@ def of_int_seq (seq : ℕ → ℤ) (h : is_cau_seq (padic_norm p) (λ n, seq n))
 end padic_int
 
 namespace padic_int
-/-!
-### Instances
+
+/-! ### Instances
 
 We now show that `ℤ_[p]` is a
 * complete metric space
@@ -193,137 +176,105 @@ variables (p : ℕ) [fact p.prime]
 instance : metric_space ℤ_[p] := subtype.metric_space
 
 instance complete_space : complete_space ℤ_[p] :=
-have is_closed {x : ℚ_[p] | ∥x∥ ≤ 1}, from is_closed_le continuous_norm continuous_const,
+have is_closed {x : ℚ_[p] | ‖x‖ ≤ 1}, from is_closed_le continuous_norm continuous_const,
 this.complete_space_coe
 
-instance : has_norm ℤ_[p] := ⟨λ z, ∥(z : ℚ_[p])∥⟩
+instance : has_norm ℤ_[p] := ⟨λ z, ‖(z : ℚ_[p])‖⟩
 
 variables {p}
 
-protected lemma mul_comm : ∀ z1 z2 : ℤ_[p], z1*z2 = z2*z1
-| ⟨q1, h1⟩ ⟨q2, h2⟩ := show (⟨q1*q2, _⟩ : ℤ_[p]) = ⟨q2*q1, _⟩, by simp [_root_.mul_comm]
-
-protected lemma zero_ne_one : (0 : ℤ_[p]) ≠ 1 :=
-show (⟨(0 : ℚ_[p]), _⟩ : ℤ_[p]) ≠ ⟨(1 : ℚ_[p]), _⟩, from mt subtype.ext_iff_val.1 zero_ne_one
-
-protected lemma eq_zero_or_eq_zero_of_mul_eq_zero :
-          ∀ (a b : ℤ_[p]), a * b = 0 → a = 0 ∨ b = 0
-| ⟨a, ha⟩ ⟨b, hb⟩ := λ h : (⟨a * b, _⟩ : ℤ_[p]) = ⟨0, _⟩,
-have a * b = 0, from subtype.ext_iff_val.1 h,
-(mul_eq_zero.1 this).elim
-  (λ h1, or.inl (by simp [h1]; refl))
-  (λ h2, or.inr (by simp [h2]; refl))
-
-lemma norm_def {z : ℤ_[p]} : ∥z∥ = ∥(z : ℚ_[p])∥ := rfl
+lemma norm_def {z : ℤ_[p]} : ‖z‖ = ‖(z : ℚ_[p])‖ := rfl
 
 variables (p)
 
 instance : normed_comm_ring ℤ_[p] :=
 { dist_eq := λ ⟨_, _⟩ ⟨_, _⟩, rfl,
-  norm_mul := λ ⟨_, _⟩ ⟨_, _⟩, norm_mul_le _ _,
-  mul_comm := padic_int.mul_comm }
+  norm_mul := by simp [norm_def],
+  norm := norm, .. padic_int.comm_ring, .. padic_int.metric_space p }
 
 instance : norm_one_class ℤ_[p] := ⟨norm_def.trans norm_one⟩
 
-instance is_absolute_value : is_absolute_value (λ z : ℤ_[p], ∥z∥) :=
+instance is_absolute_value : is_absolute_value (λ z : ℤ_[p], ‖z‖) :=
 { abv_nonneg := norm_nonneg,
   abv_eq_zero := λ ⟨_, _⟩, by simp [norm_eq_zero],
   abv_add := λ ⟨_,_⟩ ⟨_, _⟩, norm_add_le _ _,
-  abv_mul := λ _ _, by simp only [norm_def, padic_norm_e.mul, padic_int.coe_mul]}
+  abv_mul := λ _ _, by simp only [norm_def, padic_norm_e.mul, padic_int.coe_mul] }
 
 variables {p}
 
-instance : is_domain ℤ_[p] :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y, padic_int.eq_zero_or_eq_zero_of_mul_eq_zero x y,
-  exists_pair_ne := ⟨0, 1, padic_int.zero_ne_one⟩,
-  .. padic_int.normed_comm_ring p }
+instance : is_domain ℤ_[p] := function.injective.is_domain (subring p).subtype subtype.coe_injective
 
 end padic_int
 
 namespace padic_int
+
 /-! ### Norm -/
+
 variables {p : ℕ} [fact p.prime]
 
-lemma norm_le_one : ∀ z : ℤ_[p], ∥z∥ ≤ 1
-| ⟨_, h⟩ := h
+lemma norm_le_one (z : ℤ_[p]) : ‖z‖ ≤ 1 := z.2
 
-@[simp] lemma norm_mul (z1 z2 : ℤ_[p]) : ∥z1 * z2∥ = ∥z1∥ * ∥z2∥ :=
-by simp [norm_def]
+@[simp] lemma norm_mul (z1 z2 : ℤ_[p]) : ‖z1 * z2‖ = ‖z1‖ * ‖z2‖ := by simp [norm_def]
 
-@[simp] lemma norm_pow (z : ℤ_[p]) : ∀ n : ℕ, ∥z^n∥ = ∥z∥^n
+@[simp] lemma norm_pow (z : ℤ_[p]) : ∀ n : ℕ, ‖z ^ n‖ = ‖z‖ ^ n
 | 0 := by simp
-| (k+1) := by { rw [pow_succ, pow_succ, norm_mul], congr, apply norm_pow }
+| (k + 1) := by { rw [pow_succ, pow_succ, norm_mul], congr, apply norm_pow }
 
-theorem nonarchimedean : ∀ (q r : ℤ_[p]), ∥q + r∥ ≤ max (∥q∥) (∥r∥)
-| ⟨_, _⟩ ⟨_, _⟩ := padic_norm_e.nonarchimedean _ _
+theorem nonarchimedean (q r : ℤ_[p]) : ‖q + r‖ ≤ max (‖q‖) (‖r‖) := padic_norm_e.nonarchimedean _ _
 
-theorem norm_add_eq_max_of_ne : ∀ {q r : ℤ_[p]}, ∥q∥ ≠ ∥r∥ → ∥q+r∥ = max (∥q∥) (∥r∥)
-| ⟨_, _⟩ ⟨_, _⟩ := padic_norm_e.add_eq_max_of_ne
+theorem norm_add_eq_max_of_ne {q r : ℤ_[p]} : ‖q‖ ≠ ‖r‖ → ‖q+r‖ = max (‖q‖) (‖r‖) :=
+padic_norm_e.add_eq_max_of_ne
 
-lemma norm_eq_of_norm_add_lt_right {z1 z2 : ℤ_[p]}
-  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
-by_contradiction $ λ hne,
-  not_lt_of_ge (by rw norm_add_eq_max_of_ne hne; apply le_max_right) h
+lemma norm_eq_of_norm_add_lt_right {z1 z2 : ℤ_[p]} (h : ‖z1 + z2‖ < ‖z2‖) : ‖z1‖ = ‖z2‖ :=
+by_contradiction $ λ hne, not_lt_of_ge (by rw norm_add_eq_max_of_ne hne; apply le_max_right) h
 
-lemma norm_eq_of_norm_add_lt_left {z1 z2 : ℤ_[p]}
-  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
-by_contradiction $ λ hne,
-  not_lt_of_ge (by rw norm_add_eq_max_of_ne hne; apply le_max_left) h
+lemma norm_eq_of_norm_add_lt_left {z1 z2 : ℤ_[p]} (h : ‖z1 + z2‖ < ‖z1‖) : ‖z1‖ = ‖z2‖ :=
+by_contradiction $ λ hne, not_lt_of_ge (by rw norm_add_eq_max_of_ne hne; apply le_max_left) h
 
-@[simp] lemma padic_norm_e_of_padic_int (z : ℤ_[p]) : ∥(↑z : ℚ_[p])∥ = ∥z∥ :=
-by simp [norm_def]
+@[simp] lemma padic_norm_e_of_padic_int (z : ℤ_[p]) : ‖(z : ℚ_[p])‖ = ‖z‖ := by simp [norm_def]
 
-lemma norm_int_cast_eq_padic_norm (z : ℤ) : ∥(z : ℤ_[p])∥ = ∥(z : ℚ_[p])∥ :=
-by simp [norm_def]
+lemma norm_int_cast_eq_padic_norm (z : ℤ) : ‖(z : ℤ_[p])‖ = ‖(z : ℚ_[p])‖ := by simp [norm_def]
 
-@[simp] lemma norm_eq_padic_norm {q : ℚ_[p]} (hq : ∥q∥ ≤ 1) :
-  @norm ℤ_[p] _ ⟨q, hq⟩ = ∥q∥ := rfl
+@[simp] lemma norm_eq_padic_norm {q : ℚ_[p]} (hq : ‖q‖ ≤ 1) : @norm ℤ_[p] _ ⟨q, hq⟩ = ‖q‖ := rfl
 
-@[simp] lemma norm_p : ∥(p : ℤ_[p])∥ = p⁻¹ :=
-show ∥((p : ℤ_[p]) : ℚ_[p])∥ = p⁻¹, by exact_mod_cast padic_norm_e.norm_p
+@[simp] lemma norm_p : ‖(p : ℤ_[p])‖ = p⁻¹ := padic_norm_e.norm_p
 
-@[simp] lemma norm_p_pow (n : ℕ) : ∥(p : ℤ_[p])^n∥ = p^(-n:ℤ) :=
-show ∥((p^n : ℤ_[p]) : ℚ_[p])∥ = p^(-n:ℤ),
-by { convert padic_norm_e.norm_p_pow n, simp, }
+@[simp] lemma norm_p_pow (n : ℕ) : ‖(p : ℤ_[p])^n‖ = p^(-n:ℤ) := padic_norm_e.norm_p_pow n
 
-private def cau_seq_to_rat_cau_seq (f : cau_seq ℤ_[p] norm) :
-  cau_seq ℚ_[p] (λ a, ∥a∥) :=
-⟨ λ n, f n,
-  λ _ hε, by simpa [norm, norm_def] using f.cauchy hε ⟩
+private def cau_seq_to_rat_cau_seq (f : cau_seq ℤ_[p] norm) : cau_seq ℚ_[p] (λ a, ‖a‖) :=
+⟨ λ n, f n, λ _ hε, by simpa [norm, norm_def] using f.cauchy hε ⟩
 
 variables (p)
 
 instance complete : cau_seq.is_complete ℤ_[p] norm :=
 ⟨ λ f,
-  have hqn : ∥cau_seq.lim (cau_seq_to_rat_cau_seq f)∥ ≤ 1,
+  have hqn : ‖cau_seq.lim (cau_seq_to_rat_cau_seq f)‖ ≤ 1,
     from padic_norm_e_lim_le zero_lt_one (λ _, norm_le_one _),
-  ⟨ ⟨_, hqn⟩,
-    λ ε, by simpa [norm, norm_def] using cau_seq.equiv_lim (cau_seq_to_rat_cau_seq f) ε⟩⟩
+  ⟨⟨_, hqn⟩, λ ε, by simpa [norm, norm_def] using cau_seq.equiv_lim (cau_seq_to_rat_cau_seq f) ε⟩⟩
 
 end padic_int
 
 namespace padic_int
 
-variables (p : ℕ) [hp_prime : fact p.prime]
-include hp_prime
+variables (p : ℕ) [hp : fact p.prime]
 
-lemma exists_pow_neg_lt {ε : ℝ} (hε : 0 < ε) :
-  ∃ (k : ℕ), ↑p ^ -((k : ℕ) : ℤ) < ε :=
+include hp
+
+lemma exists_pow_neg_lt {ε : ℝ} (hε : 0 < ε) : ∃ k : ℕ, ↑p ^ -(k : ℤ) < ε :=
 begin
   obtain ⟨k, hk⟩ := exists_nat_gt ε⁻¹,
   use k,
   rw ← inv_lt_inv hε (_root_.zpow_pos_of_pos _ _),
-  { rw [zpow_neg₀, inv_inv, zpow_coe_nat],
+  { rw [zpow_neg, inv_inv, zpow_coe_nat],
     apply lt_of_lt_of_le hk,
     norm_cast,
     apply le_of_lt,
     convert nat.lt_pow_self _ _ using 1,
-    exact hp_prime.1.one_lt },
-  { exact_mod_cast hp_prime.1.pos }
+    exact hp.1.one_lt },
+  { exact_mod_cast hp.1.pos }
 end
 
-lemma exists_pow_neg_lt_rat {ε : ℚ} (hε : 0 < ε) :
-  ∃ (k : ℕ), ↑p ^ -((k : ℕ) : ℤ) < ε :=
+lemma exists_pow_neg_lt_rat {ε : ℚ} (hε : 0 < ε) : ∃ k : ℕ, ↑p ^ -(k : ℤ) < ε :=
 begin
   obtain ⟨k, hk⟩ := @exists_pow_neg_lt p _ ε (by exact_mod_cast hε),
   use k,
@@ -333,84 +284,80 @@ end
 
 variable {p}
 
-lemma norm_int_lt_one_iff_dvd (k : ℤ) : ∥(k : ℤ_[p])∥ < 1 ↔ ↑p ∣ k :=
-suffices ∥(k : ℚ_[p])∥ < 1 ↔ ↑p ∣ k, by rwa norm_int_cast_eq_padic_norm,
+lemma norm_int_lt_one_iff_dvd (k : ℤ) : ‖(k : ℤ_[p])‖ < 1 ↔ (p : ℤ) ∣ k :=
+suffices ‖(k : ℚ_[p])‖ < 1 ↔ ↑p ∣ k, by rwa norm_int_cast_eq_padic_norm,
 padic_norm_e.norm_int_lt_one_iff_dvd k
 
-lemma norm_int_le_pow_iff_dvd {k : ℤ} {n : ℕ} : ∥(k : ℤ_[p])∥ ≤ ((↑p)^(-n : ℤ)) ↔ ↑p^n ∣ k :=
-suffices ∥(k : ℚ_[p])∥ ≤ ((↑p)^(-n : ℤ)) ↔ ↑(p^n) ∣ k, by simpa [norm_int_cast_eq_padic_norm],
-padic_norm_e.norm_int_le_pow_iff_dvd _ _
+lemma norm_int_le_pow_iff_dvd {k : ℤ} {n : ℕ} : ‖(k : ℤ_[p])‖ ≤ p ^ (-n : ℤ) ↔ (p ^ n : ℤ) ∣ k :=
+suffices ‖(k : ℚ_[p])‖ ≤ p ^ (-n : ℤ) ↔ ↑(p ^ n) ∣ k,
+by simpa [norm_int_cast_eq_padic_norm], padic_norm_e.norm_int_le_pow_iff_dvd _ _
 
 /-! ### Valuation on `ℤ_[p]` -/
 
-/-- `padic_int.valuation` lifts the p-adic valuation on `ℚ` to `ℤ_[p]`.  -/
+/-- `padic_int.valuation` lifts the `p`-adic valuation on `ℚ` to `ℤ_[p]`.  -/
 def valuation (x : ℤ_[p]) := padic.valuation (x : ℚ_[p])
 
-lemma norm_eq_pow_val {x : ℤ_[p]} (hx : x ≠ 0) :
-  ∥x∥ = p^(-x.valuation) :=
+lemma norm_eq_pow_val {x : ℤ_[p]} (hx : x ≠ 0) : ‖x‖ = (p : ℝ) ^ -x.valuation :=
 begin
   convert padic.norm_eq_pow_val _,
   contrapose! hx,
   exact subtype.val_injective hx
 end
 
-@[simp] lemma valuation_zero : valuation (0 : ℤ_[p]) = 0 :=
-padic.valuation_zero
+@[simp] lemma valuation_zero : valuation (0 : ℤ_[p]) = 0 := padic.valuation_zero
 
-@[simp] lemma valuation_one : valuation (1 : ℤ_[p]) = 0 :=
-padic.valuation_one
+@[simp] lemma valuation_one : valuation (1 : ℤ_[p]) = 0 := padic.valuation_one
 
-@[simp] lemma valuation_p : valuation (p : ℤ_[p]) = 1 :=
-by simp [valuation, -cast_eq_of_rat_of_nat]
+@[simp] lemma valuation_p : valuation (p : ℤ_[p]) = 1 := by simp [valuation]
 
 lemma valuation_nonneg (x : ℤ_[p]) : 0 ≤ x.valuation :=
 begin
   by_cases hx : x = 0,
   { simp [hx] },
-  have h : (1 : ℝ) < p := by exact_mod_cast hp_prime.1.one_lt,
+  have h : (1 : ℝ) < p := by exact_mod_cast hp.1.one_lt,
   rw [← neg_nonpos, ← (zpow_strict_mono h).le_iff_le],
-  show (p : ℝ) ^ -valuation x ≤ p ^ 0,
+  show (p : ℝ) ^ -valuation x ≤ p ^ (0 : ℤ),
   rw [← norm_eq_pow_val hx],
-  simpa using x.property,
+  simpa using x.property
 end
 
 @[simp] lemma valuation_p_pow_mul (n : ℕ) (c : ℤ_[p]) (hc : c ≠ 0) :
   (↑p ^ n * c).valuation = n + c.valuation :=
 begin
-  have : ∥↑p ^ n * c∥ = ∥(p ^ n : ℤ_[p])∥ * ∥c∥,
+  have : ‖(↑p ^ n * c)‖ = ‖(p ^ n : ℤ_[p])‖ * ‖c‖,
   { exact norm_mul _ _ },
-  have aux : ↑p ^ n * c ≠ 0,
+  have aux : (↑p ^ n * c) ≠ 0,
   { contrapose! hc, rw mul_eq_zero at hc, cases hc,
-    { refine (hp_prime.1.ne_zero _).elim,
+    { refine (hp.1.ne_zero _).elim,
       exact_mod_cast (pow_eq_zero hc) },
     { exact hc } },
   rwa [norm_eq_pow_val aux, norm_p_pow, norm_eq_pow_val hc,
       ← zpow_add₀, ← neg_add, zpow_inj, neg_inj] at this,
-  { exact_mod_cast hp_prime.1.pos },
-  { exact_mod_cast hp_prime.1.ne_one },
-  { exact_mod_cast hp_prime.1.ne_zero },
+  { exact_mod_cast hp.1.pos },
+  { exact_mod_cast hp.1.ne_one },
+  { exact_mod_cast hp.1.ne_zero }
 end
 
 section units
+
 /-! ### Units of `ℤ_[p]` -/
 
 local attribute [reducible] padic_int
 
-lemma mul_inv : ∀ {z : ℤ_[p]}, ∥z∥ = 1 → z * z.inv = 1
+lemma mul_inv : ∀ {z : ℤ_[p]}, ‖z‖ = 1 → z * z.inv = 1
 | ⟨k, _⟩ h :=
   begin
-    have hk : k ≠ 0, from λ h', @zero_ne_one ℚ_[p] _ _ (by simpa [h'] using h),
+    have hk : k ≠ 0, from λ h', zero_ne_one' ℚ_[p] (by simpa [h'] using h),
     unfold padic_int.inv,
     rw [norm_eq_padic_norm] at h,
     rw dif_pos h,
     apply subtype.ext_iff_val.2,
-    simp [mul_inv_cancel hk],
+    simp [mul_inv_cancel hk]
   end
 
-lemma inv_mul {z : ℤ_[p]} (hz : ∥z∥ = 1) : z.inv * z = 1 :=
-by rw [mul_comm, mul_inv hz]
+lemma inv_mul {z : ℤ_[p]} (hz : ‖z‖ = 1) : z.inv * z = 1 := by rw [mul_comm, mul_inv hz]
 
-lemma is_unit_iff {z : ℤ_[p]} : is_unit z ↔ ∥z∥ = 1 :=
+lemma is_unit_iff {z : ℤ_[p]} : is_unit z ↔ ‖z‖ = 1 :=
 ⟨λ h, begin
   rcases is_unit_iff_dvd_one.1 h with ⟨w, eq⟩,
   refine le_antisymm (norm_le_one _) _,
@@ -418,38 +365,35 @@ lemma is_unit_iff {z : ℤ_[p]} : is_unit z ↔ ∥z∥ = 1 :=
   rwa [mul_one, ← norm_mul, ← eq, norm_one] at this
 end, λ h, ⟨⟨z, z.inv, mul_inv h, inv_mul h⟩, rfl⟩⟩
 
-lemma norm_lt_one_add {z1 z2 : ℤ_[p]} (hz1 : ∥z1∥ < 1) (hz2 : ∥z2∥ < 1) : ∥z1 + z2∥ < 1 :=
+lemma norm_lt_one_add {z1 z2 : ℤ_[p]} (hz1 : ‖z1‖ < 1) (hz2 : ‖z2‖ < 1) : ‖z1 + z2‖ < 1 :=
 lt_of_le_of_lt (nonarchimedean _ _) (max_lt hz1 hz2)
 
-lemma norm_lt_one_mul {z1 z2 : ℤ_[p]} (hz2 : ∥z2∥ < 1) : ∥z1 * z2∥ < 1 :=
-calc  ∥z1 * z2∥ = ∥z1∥ * ∥z2∥ : by simp
-           ... < 1 : mul_lt_one_of_nonneg_of_lt_one_right (norm_le_one _) (norm_nonneg _) hz2
+lemma norm_lt_one_mul {z1 z2 : ℤ_[p]} (hz2 : ‖z2‖ < 1) : ‖z1 * z2‖ < 1 :=
+calc ‖z1 * z2‖ = ‖z1‖ * ‖z2‖ : by simp
+          ... < 1 : mul_lt_one_of_nonneg_of_lt_one_right (norm_le_one _) (norm_nonneg _) hz2
 
-@[simp] lemma mem_nonunits {z : ℤ_[p]} : z ∈ nonunits ℤ_[p] ↔ ∥z∥ < 1 :=
+@[simp] lemma mem_nonunits {z : ℤ_[p]} : z ∈ nonunits ℤ_[p] ↔ ‖z‖ < 1 :=
 by rw lt_iff_le_and_ne; simp [norm_le_one z, nonunits, is_unit_iff]
 
-/-- A `p`-adic number `u` with `∥u∥ = 1` is a unit of `ℤ_[p]`. -/
-def mk_units {u : ℚ_[p]} (h : ∥u∥ = 1) : ℤ_[p]ˣ :=
+/-- A `p`-adic number `u` with `‖u‖ = 1` is a unit of `ℤ_[p]`. -/
+def mk_units {u : ℚ_[p]} (h : ‖u‖ = 1) : ℤ_[p]ˣ :=
 let z : ℤ_[p] := ⟨u, le_of_eq h⟩ in ⟨z, z.inv, mul_inv h, inv_mul h⟩
 
-@[simp]
-lemma mk_units_eq {u : ℚ_[p]} (h : ∥u∥ = 1) : ((mk_units h : ℤ_[p]) : ℚ_[p]) = u :=
-rfl
+@[simp] lemma mk_units_eq {u : ℚ_[p]} (h : ‖u‖ = 1) : ((mk_units h : ℤ_[p]) : ℚ_[p]) = u := rfl
 
-@[simp] lemma norm_units (u : ℤ_[p]ˣ) : ∥(u : ℤ_[p])∥ = 1 :=
-is_unit_iff.mp $ by simp
+@[simp] lemma norm_units (u : ℤ_[p]ˣ) : ‖(u : ℤ_[p])‖ = 1 := is_unit_iff.mp $ by simp
 
 /-- `unit_coeff hx` is the unit `u` in the unique representation `x = u * p ^ n`.
 See `unit_coeff_spec`. -/
 def unit_coeff {x : ℤ_[p]} (hx : x ≠ 0) : ℤ_[p]ˣ :=
-let u : ℚ_[p] := x*p^(-x.valuation) in
-have hu : ∥u∥ = 1,
-by simp [hx, nat.zpow_ne_zero_of_pos (by exact_mod_cast hp_prime.1.pos) x.valuation,
-         norm_eq_pow_val, zpow_neg, inv_mul_cancel, -cast_eq_of_rat_of_nat],
+let u : ℚ_[p] := x * p ^ -x.valuation in
+have hu : ‖u‖ = 1,
+by simp [hx, nat.zpow_ne_zero_of_pos (by exact_mod_cast hp.1.pos) x.valuation,
+         norm_eq_pow_val, zpow_neg, inv_mul_cancel],
 mk_units hu
 
 @[simp] lemma unit_coeff_coe {x : ℤ_[p]} (hx : x ≠ 0) :
-  (unit_coeff hx : ℚ_[p]) = x * p ^ (-x.valuation) := rfl
+  (unit_coeff hx : ℚ_[p]) = x * p ^ -x.valuation := rfl
 
 lemma unit_coeff_spec {x : ℤ_[p]} (hx : x ≠ 0) :
   x = (unit_coeff hx : ℤ_[p]) * p ^ int.nat_abs (valuation x) :=
@@ -459,28 +403,29 @@ begin
   have repr : (x : ℚ_[p]) = (unit_coeff hx) * p ^ x.valuation,
   { rw [unit_coeff_coe, mul_assoc, ← zpow_add₀],
     { simp },
-    { exact_mod_cast hp_prime.1.ne_zero } },
+    { exact_mod_cast hp.1.ne_zero } },
   convert repr using 2,
-  rw [← zpow_coe_nat, int.nat_abs_of_nonneg (valuation_nonneg x)],
+  rw [← zpow_coe_nat, int.nat_abs_of_nonneg (valuation_nonneg x)]
 end
 
 end units
 
 section norm_le_iff
+
 /-! ### Various characterizations of open unit balls -/
 
 lemma norm_le_pow_iff_le_valuation (x : ℤ_[p]) (hx : x ≠ 0) (n : ℕ) :
-  ∥x∥ ≤ p ^ (-n : ℤ) ↔ ↑n ≤ x.valuation :=
+  ‖x‖ ≤ p ^ (-n : ℤ) ↔ ↑n ≤ x.valuation :=
 begin
   rw norm_eq_pow_val hx,
   lift x.valuation to ℕ using x.valuation_nonneg with k hk,
-  simp only [int.coe_nat_le, zpow_neg₀, zpow_coe_nat],
+  simp only [int.coe_nat_le, zpow_neg, zpow_coe_nat],
   have aux : ∀ n : ℕ, 0 < (p ^ n : ℝ),
-  { apply pow_pos, exact_mod_cast hp_prime.1.pos },
+  { apply pow_pos, exact_mod_cast hp.1.pos },
   rw [inv_le_inv (aux _) (aux _)],
-  have : p ^ n ≤ p ^ k ↔ n ≤ k := (strict_mono_pow hp_prime.1.one_lt).le_iff_le,
+  have : p ^ n ≤ p ^ k ↔ n ≤ k := (pow_strict_mono_right hp.1.one_lt).le_iff_le,
   rw [← this],
-  norm_cast,
+  norm_cast
 end
 
 lemma mem_span_pow_iff_le_valuation (x : ℤ_[p]) (hx : x ≠ 0) (n : ℕ) :
@@ -490,42 +435,40 @@ begin
   split,
   { rintro ⟨c, rfl⟩,
     suffices : c ≠ 0,
-    { rw [valuation_p_pow_mul _ _ this, le_add_iff_nonneg_right], apply valuation_nonneg, },
-    contrapose! hx, rw [hx, mul_zero], },
+    { rw [valuation_p_pow_mul _ _ this, le_add_iff_nonneg_right], apply valuation_nonneg },
+    contrapose! hx, rw [hx, mul_zero] },
   { rw [unit_coeff_spec hx] { occs := occurrences.pos [2] },
     lift x.valuation to ℕ using x.valuation_nonneg with k hk,
     simp only [int.nat_abs_of_nat, units.is_unit, is_unit.dvd_mul_left, int.coe_nat_le],
     intro H,
     obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le H,
-    simp only [pow_add, dvd_mul_right], }
+    simp only [pow_add, dvd_mul_right] }
 end
 
 lemma norm_le_pow_iff_mem_span_pow (x : ℤ_[p]) (n : ℕ) :
-  ∥x∥ ≤ p ^ (-n : ℤ) ↔ x ∈ (ideal.span {p ^ n} : ideal ℤ_[p]) :=
+  ‖x‖ ≤ p ^ (-n : ℤ) ↔ x ∈ (ideal.span {p ^ n} : ideal ℤ_[p]) :=
 begin
   by_cases hx : x = 0,
   { subst hx,
-    simp only [norm_zero, zpow_neg₀, zpow_coe_nat, inv_nonneg, iff_true, submodule.zero_mem],
+    simp only [norm_zero, zpow_neg, zpow_coe_nat, inv_nonneg, iff_true, submodule.zero_mem],
     exact_mod_cast nat.zero_le _ },
-  rw [norm_le_pow_iff_le_valuation x hx, mem_span_pow_iff_le_valuation x hx],
+  rw [norm_le_pow_iff_le_valuation x hx, mem_span_pow_iff_le_valuation x hx]
 end
 
-lemma norm_le_pow_iff_norm_lt_pow_add_one (x : ℤ_[p]) (n : ℤ) :
-  ∥x∥ ≤ p ^ n ↔ ∥x∥ < p ^ (n + 1) :=
+lemma norm_le_pow_iff_norm_lt_pow_add_one (x : ℤ_[p]) (n : ℤ) : ‖x‖ ≤ p ^ n ↔ ‖x‖ < p ^ (n + 1) :=
 begin
   rw norm_def, exact padic.norm_le_pow_iff_norm_lt_pow_add_one _ _,
 end
 
-lemma norm_lt_pow_iff_norm_le_pow_sub_one (x : ℤ_[p]) (n : ℤ) :
-  ∥x∥ < p ^ n ↔ ∥x∥ ≤ p ^ (n - 1) :=
+lemma norm_lt_pow_iff_norm_le_pow_sub_one (x : ℤ_[p]) (n : ℤ) : ‖x‖ < p ^ n ↔ ‖x‖ ≤ p ^ (n - 1) :=
 by rw [norm_le_pow_iff_norm_lt_pow_add_one, sub_add_cancel]
 
-lemma norm_lt_one_iff_dvd (x : ℤ_[p]) : ∥x∥ < 1 ↔ ↑p ∣ x :=
+lemma norm_lt_one_iff_dvd (x : ℤ_[p]) : ‖x‖ < 1 ↔ ↑p ∣ x :=
 begin
   have := norm_le_pow_iff_mem_span_pow x 1,
   rw [ideal.mem_span_singleton, pow_one] at this,
   rw [← this, norm_le_pow_iff_norm_lt_pow_add_one],
-  simp only [zpow_zero, int.coe_nat_zero, int.coe_nat_succ, add_left_neg, zero_add],
+  simp only [zpow_zero, int.coe_nat_zero, int.coe_nat_succ, add_left_neg, zero_add]
 end
 
 @[simp] lemma pow_p_dvd_int_iff (n : ℕ) (a : ℤ) : (p ^ n : ℤ_[p]) ∣ a ↔ ↑p ^ n ∣ a :=
@@ -534,22 +477,22 @@ by rw [← norm_int_le_pow_iff_dvd, norm_le_pow_iff_mem_span_pow, ideal.mem_span
 end norm_le_iff
 
 section dvr
+
 /-! ### Discrete valuation ring -/
 
 instance : local_ring ℤ_[p] :=
 local_ring.of_nonunits_add $ by simp only [mem_nonunits]; exact λ x y, norm_lt_one_add
 
 lemma p_nonnunit : (p : ℤ_[p]) ∈ nonunits ℤ_[p] :=
-have (p : ℝ)⁻¹ < 1, from inv_lt_one $ by exact_mod_cast hp_prime.1.one_lt,
+have (p : ℝ)⁻¹ < 1, from inv_lt_one $ by exact_mod_cast hp.1.one_lt,
 by simp [this]
 
 lemma maximal_ideal_eq_span_p : maximal_ideal ℤ_[p] = ideal.span {p} :=
 begin
   apply le_antisymm,
   { intros x hx,
-    rw ideal.mem_span_singleton,
     simp only [local_ring.mem_maximal_ideal, mem_nonunits] at hx,
-    rwa ← norm_lt_one_iff_dvd, },
+    rwa [ideal.mem_span_singleton, ← norm_lt_one_iff_dvd] },
   { rw [ideal.span_le, set.singleton_subset_iff], exact p_nonnunit }
 end
 
@@ -557,19 +500,17 @@ lemma prime_p : prime (p : ℤ_[p]) :=
 begin
   rw [← ideal.span_singleton_prime, ← maximal_ideal_eq_span_p],
   { apply_instance },
-  { exact_mod_cast hp_prime.1.ne_zero }
+  { exact_mod_cast hp.1.ne_zero }
 end
 
-lemma irreducible_p : irreducible (p : ℤ_[p]) :=
-prime.irreducible prime_p
+lemma irreducible_p : irreducible (p : ℤ_[p]) := prime.irreducible prime_p
 
 instance : discrete_valuation_ring ℤ_[p] :=
 discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization
 ⟨p, irreducible_p, λ x hx, ⟨x.valuation.nat_abs, unit_coeff hx,
   by rw [mul_comm, ← unit_coeff_spec hx]⟩⟩
 
-lemma ideal_eq_span_pow_p {s : ideal ℤ_[p]} (hs : s ≠ ⊥) :
-  ∃ n : ℕ, s = ideal.span {p ^ n} :=
+lemma ideal_eq_span_pow_p {s : ideal ℤ_[p]} (hs : s ≠ ⊥) : ∃ n : ℕ, s = ideal.span {p ^ n} :=
 discrete_valuation_ring.ideal_eq_span_pow_irreducible hs irreducible_p
 
 open cau_seq
@@ -583,16 +524,61 @@ instance : is_adic_complete (maximal_ideal ℤ_[p]) ℤ_[p] :=
     { intros ε hε, obtain ⟨m, hm⟩ := exists_pow_neg_lt p hε,
       refine ⟨m, λ n hn, lt_of_le_of_lt _ hm⟩, rw [← neg_sub, norm_neg], exact hx hn },
     { refine ⟨x'.lim, λ n, _⟩,
-      have : (0:ℝ) < p ^ (-n : ℤ), { apply zpow_pos_of_pos, exact_mod_cast hp_prime.1.pos },
+      have : (0:ℝ) < p ^ (-n : ℤ), { apply zpow_pos_of_pos, exact_mod_cast hp.1.pos },
       obtain ⟨i, hi⟩ := equiv_def₃ (equiv_lim x') this,
       by_cases hin : i ≤ n,
-      { exact (hi i le_rfl n hin).le, },
+      { exact (hi i le_rfl n hin).le },
       { push_neg at hin, specialize hi i le_rfl i le_rfl, specialize hx hin.le,
         have := nonarchimedean (x n - x i) (x i - x'.lim),
         rw [sub_add_sub_cancel] at this,
-        refine this.trans (max_le_iff.mpr ⟨hx, hi.le⟩), } },
+        refine this.trans (max_le_iff.mpr ⟨hx, hi.le⟩) } }
   end }
 
 end dvr
 
+section fraction_ring
+
+instance algebra : algebra ℤ_[p] ℚ_[p] := algebra.of_subring (subring p)
+
+@[simp] lemma algebra_map_apply (x : ℤ_[p]) : algebra_map ℤ_[p] ℚ_[p] x = x := rfl
+
+instance is_fraction_ring : is_fraction_ring ℤ_[p] ℚ_[p] :=
+{ map_units := λ ⟨x, hx⟩,
+  by rwa [set_like.coe_mk, algebra_map_apply, is_unit_iff_ne_zero, padic_int.coe_ne_zero,
+      ←mem_non_zero_divisors_iff_ne_zero],
+  surj := λ x,
+  begin
+    by_cases hx : ‖ x ‖ ≤ 1,
+    { use (⟨x, hx⟩, 1),
+      rw [submonoid.coe_one, map_one, mul_one, padic_int.algebra_map_apply, subtype.coe_mk] },
+    { set n := int.to_nat(- x.valuation) with hn,
+      have hn_coe : (n : ℤ) = -x.valuation,
+      { rw [hn, int.to_nat_of_nonneg],
+        rw right.nonneg_neg_iff,
+        rw [padic.norm_le_one_iff_val_nonneg, not_le] at hx,
+        exact hx.le },
+      set a := x * p^n with ha,
+      have ha_norm : ‖ a ‖ = 1,
+      { have hx : x ≠ 0,
+        { intro h0,
+          rw [h0, norm_zero] at hx,
+          exact hx (zero_le_one) },
+        rw [ha, padic_norm_e.mul, padic_norm_e.norm_p_pow,
+          padic.norm_eq_pow_val hx, ← zpow_add', hn_coe, neg_neg, add_left_neg, zpow_zero],
+        exact or.inl (nat.cast_ne_zero.mpr (ne_zero.ne p)), },
+      use (⟨a, le_of_eq ha_norm⟩,
+        ⟨(p^n : ℤ_[p]), mem_non_zero_divisors_iff_ne_zero.mpr (ne_zero.ne _)⟩),
+      simp only [set_like.coe_mk, map_pow, map_nat_cast, algebra_map_apply,
+        padic_int.coe_pow, padic_int.coe_nat_cast, subtype.coe_mk] }
+  end,
+  eq_iff_exists := λ x y,
+  begin
+    rw [algebra_map_apply, algebra_map_apply, subtype.coe_inj],
+    refine ⟨λ h, ⟨1, by rw h⟩, _⟩,
+    rintro ⟨⟨c, hc⟩, h⟩,
+    exact (mul_eq_mul_left_iff.mp h).resolve_right (mem_non_zero_divisors_iff_ne_zero.mp hc)
+  end }
+
+end fraction_ring
+
 end padic_int
diff --git a/src/number_theory/padics/padic_norm.lean b/src/number_theory/padics/padic_norm.lean
index a405927ecfe66..6b5c5cd89fc68 100644
--- a/src/number_theory/padics/padic_norm.lean
+++ b/src/number_theory/padics/padic_norm.lean
@@ -8,13 +8,16 @@ import number_theory.padics.padic_val
 /-!
 # p-adic norm
 
-This file defines the p-adic norm on ℚ.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
+This file defines the `p`-adic norm on `ℚ`.
+
+The `p`-adic valuation on `ℚ` is the difference of the multiplicities of `p` in the numerator and
 denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
-assumptions on p.
+assumptions on `p`.
 
-The valuation induces a norm on ℚ. This norm is a nonarchimedean absolute value.
+The valuation induces a norm on `ℚ`. This norm is a nonarchimedean absolute value.
 It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.
 
 ## Notations
@@ -24,7 +27,7 @@ This file uses the local notation `/.` for `rat.mk`.
 ## Implementation notes
 
 Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
-by taking `[fact (prime p)]` as a type class argument.
+by taking `[fact p.prime]` as a type class argument.
 
 ## References
 
@@ -37,25 +40,21 @@ by taking `[fact (prime p)]` as a type class argument.
 p-adic, p adic, padic, norm, valuation
 -/
 
-/--
-If `q ≠ 0`, the p-adic norm of a rational `q` is `p ^ (-(padic_val_rat p q))`.
-If `q = 0`, the p-adic norm of `q` is 0.
--/
-def padic_norm (p : ℕ) (q : ℚ) : ℚ :=
-if q = 0 then 0 else (↑p : ℚ) ^ (-(padic_val_rat p q))
+/-- If `q ≠ 0`, the `p`-adic norm of a rational `q` is `p ^ -padic_val_rat p q`.
+If `q = 0`, the `p`-adic norm of `q` is `0`. -/
+def padic_norm (p : ℕ) (q : ℚ) : ℚ := if q = 0 then 0 else (p : ℚ) ^ -padic_val_rat p q
 
 namespace padic_norm
 
-section padic_norm
 open padic_val_rat
-variables (p : ℕ)
+variables {p : ℕ}
 
-/-- Unfolds the definition of the p-adic norm of `q` when `q ≠ 0`. -/
+/-- Unfolds the definition of the `p`-adic norm of `q` when `q ≠ 0`. -/
 @[simp] protected lemma eq_zpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
-  padic_norm p q = p ^ (-(padic_val_rat p q)) :=
+  padic_norm p q = p ^ -padic_val_rat p q :=
 by simp [hq, padic_norm]
 
-/-- The p-adic norm is nonnegative. -/
+/-- The `p`-adic norm is nonnegative. -/
 protected lemma nonneg (q : ℚ) : 0 ≤ padic_norm p q :=
 if hq : q = 0 then by simp [hq, padic_norm]
 else
@@ -65,30 +64,26 @@ else
     exact_mod_cast nat.zero_le _
   end
 
-/-- The p-adic norm of 0 is 0. -/
+/-- The `p`-adic norm of `0` is `0`. -/
 @[simp] protected lemma zero : padic_norm p 0 = 0 := by simp [padic_norm]
 
-/-- The p-adic norm of 1 is 1. -/
+/-- The `p`-adic norm of `1` is `1`. -/
 @[simp] protected lemma one : padic_norm p 1 = 1 := by simp [padic_norm]
 
-/--
-The p-adic norm of `p` is `1/p` if `p > 1`.
+/-- The `p`-adic norm of `p` is `p⁻¹` if `p > 1`.
 
-See also `padic_norm.padic_norm_p_of_prime` for a version that assumes `p` is prime.
--/
-lemma padic_norm_p {p : ℕ} (hp : 1 < p) : padic_norm p p = 1 / p :=
+See also `padic_norm.padic_norm_p_of_prime` for a version assuming `p` is prime. -/
+lemma padic_norm_p (hp : 1 < p) : padic_norm p p = p⁻¹ :=
 by simp [padic_norm, (pos_of_gt hp).ne', padic_val_nat.self hp]
 
-/--
-The p-adic norm of `p` is `1/p` if `p` is prime.
+/-- The `p`-adic norm of `p` is `p⁻¹` if `p` is prime.
 
-See also `padic_norm.padic_norm_p` for a version that assumes `1 < p`.
--/
-@[simp] lemma padic_norm_p_of_prime (p : ℕ) [fact p.prime] : padic_norm p p = 1 / p :=
+See also `padic_norm.padic_norm_p` for a version assuming `1 < p`. -/
+@[simp] lemma padic_norm_p_of_prime [fact p.prime] : padic_norm p p = p⁻¹ :=
 padic_norm_p $ nat.prime.one_lt (fact.out _)
 
-/-- The p-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
-lemma padic_norm_of_prime_of_ne {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
+/-- The `p`-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
+lemma padic_norm_of_prime_of_ne {q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
   (neq : p ≠ q) : padic_norm p q = 1 :=
 begin
   have p : padic_val_rat p q = 0,
@@ -96,28 +91,23 @@ begin
   simp [padic_norm, p, q_prime.1.1, q_prime.1.ne_zero],
 end
 
-/--
-The p-adic norm of `p` is less than 1 if `1 < p`.
+/-- The `p`-adic norm of `p` is less than `1` if `1 < p`.
 
-See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `prime p`.
--/
-lemma padic_norm_p_lt_one {p : ℕ} (hp : 1 < p) : padic_norm p p < 1 :=
+See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `p` is prime. -/
+lemma padic_norm_p_lt_one (hp : 1 < p) : padic_norm p p < 1 :=
 begin
-  rw [padic_norm_p hp, div_lt_iff, one_mul],
-  { exact_mod_cast hp },
-  { exact_mod_cast zero_lt_one.trans hp },
+  rw [padic_norm_p hp, inv_lt_one_iff],
+  exact_mod_cast (or.inr hp)
 end
 
-/--
-The p-adic norm of `p` is less than 1 if `p` is prime.
+/-- The `p`-adic norm of `p` is less than `1` if `p` is prime.
 
-See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`.
--/
-lemma padic_norm_p_lt_one_of_prime (p : ℕ) [fact p.prime] : padic_norm p p < 1 :=
+See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`. -/
+lemma padic_norm_p_lt_one_of_prime [fact p.prime] : padic_norm p p < 1 :=
 padic_norm_p_lt_one $ nat.prime.one_lt (fact.out _)
 
 /-- `padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`. -/
-protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padic_norm p q = p ^ (-z) :=
+protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padic_norm p q = p ^ -z :=
 ⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩
 
 /-- `padic_norm p` is symmetric. -/
@@ -131,12 +121,12 @@ include hp
 /-- If `q ≠ 0`, then `padic_norm p q ≠ 0`. -/
 protected lemma nonzero {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 :=
 begin
-  rw padic_norm.eq_zpow_of_nonzero p hq,
+  rw padic_norm.eq_zpow_of_nonzero hq,
   apply zpow_ne_zero_of_ne_zero,
   exact_mod_cast ne_of_gt hp.1.pos
 end
 
-/-- If the p-adic norm of `q` is 0, then `q` is 0. -/
+/-- If the `p`-adic norm of `q` is 0, then `q` is `0`. -/
 lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm p q = 0) : q = 0 :=
 begin
   apply by_contradiction, intro hq,
@@ -146,30 +136,30 @@ begin
   exact_mod_cast hp.1.ne_zero
 end
 
-/-- The p-adic norm is multiplicative. -/
-@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q*r) = padic_norm p q * padic_norm p r :=
+/-- The `p`-adic norm is multiplicative. -/
+@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q * r) = padic_norm p q * padic_norm p r :=
 if hq : q = 0 then
   by simp [hq]
 else if hr : r = 0 then
   by simp [hr]
 else
-  have q*r ≠ 0, from mul_ne_zero hq hr,
-  have (↑p : ℚ) ≠ 0, by simp [hp.1.ne_zero],
+  have q * r ≠ 0, from mul_ne_zero hq hr,
+  have (p : ℚ) ≠ 0, by simp [hp.1.ne_zero],
   by simp [padic_norm, *, padic_val_rat.mul, zpow_add₀ this, mul_comm]
 
-/-- The p-adic norm respects division. -/
+/-- The `p`-adic norm respects division. -/
 @[simp] protected theorem div (q r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
 if hr : r = 0 then by simp [hr] else
-eq_div_of_mul_eq (padic_norm.nonzero _ hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])
+eq_div_of_mul_eq (padic_norm.nonzero hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])
 
-/-- The p-adic norm of an integer is at most 1. -/
-protected theorem of_int (z : ℤ) : padic_norm p ↑z ≤ 1 :=
+/-- The `p`-adic norm of an integer is at most `1`. -/
+protected theorem of_int (z : ℤ) : padic_norm p z ≤ 1 :=
 if hz : z = 0 then by simp [hz, zero_le_one] else
 begin
   unfold padic_norm,
   rw [if_neg _],
   { refine zpow_le_one_of_nonpos _ _,
-    { exact_mod_cast le_of_lt hp.1.one_lt, },
+    { exact_mod_cast le_of_lt hp.1.one_lt },
     { rw [padic_val_rat.of_int, neg_nonpos],
       norm_cast, simp }},
   exact_mod_cast hz,
@@ -177,8 +167,8 @@ end
 
 private lemma nonarchimedean_aux {q r : ℚ} (h : padic_val_rat p q ≤ padic_val_rat p r) :
   padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
-have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _ _,
-have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _ _,
+have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _,
+have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _,
 if hq : q = 0 then
   by simp [hq, max_eq_right hnrp, le_max_right]
 else if hr : r = 0 then
@@ -200,45 +190,38 @@ else
       apply min_le_padic_val_rat_add; assumption }
   end
 
-/--
-The p-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p` and
-the norm of `q`.
--/
+/-- The `p`-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p`
+and the norm of `q`. -/
 protected theorem nonarchimedean {q r : ℚ} :
   padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
 begin
-    wlog hle := le_total (padic_val_rat p q) (padic_val_rat p r) using [q r],
-    exact nonarchimedean_aux p hle
+  wlog hle : (padic_val_rat p q) ≤ (padic_val_rat p r) generalizing q r,
+  { rw [add_comm, max_comm], exact this (le_of_not_le hle) },
+  exact nonarchimedean_aux hle
 end
 
-/--
-The p-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of `p`
-plus the norm of `q`.
--/
+/-- The `p`-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of
+`p` plus the norm of `q`. -/
 theorem triangle_ineq (q r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
-calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean p
+calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean
                        ... ≤ padic_norm p q + padic_norm p r :
-                         max_le_add_of_nonneg (padic_norm.nonneg p _) (padic_norm.nonneg p _)
+                         max_le_add_of_nonneg (padic_norm.nonneg _) (padic_norm.nonneg _)
 
-/--
-The p-adic norm of a difference is at most the max of each component. Restates the archimedean
-property of the p-adic norm.
--/
+/-- The `p`-adic norm of a difference is at most the max of each component. Restates the archimedean
+property of the `p`-adic norm. -/
 protected theorem sub {q r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
-by rw [sub_eq_add_neg, ←padic_norm.neg p r]; apply padic_norm.nonarchimedean
+by rw [sub_eq_add_neg, ←padic_norm.neg r]; apply padic_norm.nonarchimedean
 
-/--
-If the p-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max of
-the norms of `q` and `r`.
--/
+/-- If the `p`-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max
+of the norms of `q` and `r`. -/
 lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) :
   padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
 begin
-  wlog hle := le_total (padic_norm p r) (padic_norm p q) using [q r],
-  have hlt : padic_norm p r < padic_norm p q, from lt_of_le_of_ne hle hne.symm,
+  wlog hlt : (padic_norm p r) < (padic_norm p q),
+  { rw [add_comm, max_comm], exact this hne.symm (hne.lt_or_lt.resolve_right hlt) },
   have : padic_norm p q ≤ max (padic_norm p (q + r)) (padic_norm p r), from calc
    padic_norm p q = padic_norm p (q + r - r) : by congr; ring
-               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean p
+               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean
                ... = max (padic_norm p (q + r)) (padic_norm p r) : by simp,
   have hnge : padic_norm p r ≤ padic_norm p (q + r),
   { apply le_of_not_gt,
@@ -248,43 +231,115 @@ begin
     assumption },
   have : padic_norm p q ≤ padic_norm p (q + r), by rwa [max_eq_left hnge] at this,
   apply _root_.le_antisymm,
-  { apply padic_norm.nonarchimedean p },
-  { rw max_eq_left_of_lt hlt,
-    assumption }
+  { apply padic_norm.nonarchimedean },
+  { rwa max_eq_left_of_lt hlt }
 end
 
-/--
-The p-adic norm is an absolute value: positive-definite and multiplicative, satisfying the triangle
-inequality.
--/
+/-- The `p`-adic norm is an absolute value: positive-definite and multiplicative, satisfying the
+triangle inequality. -/
 instance : is_absolute_value (padic_norm p) :=
-{ abv_nonneg := padic_norm.nonneg p,
-  abv_eq_zero :=
-    begin
-      intros,
-      constructor; intro,
-      { apply zero_of_padic_norm_eq_zero p, assumption },
-      { simp [*] }
-    end,
-  abv_add := padic_norm.triangle_ineq p,
-  abv_mul := padic_norm.mul p }
-
-variable {p}
-
-lemma dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p^n) ∣ z ↔ padic_norm p z ≤ ↑p ^ (-n : ℤ) :=
+{ abv_nonneg := padic_norm.nonneg,
+  abv_eq_zero := λ _, ⟨zero_of_padic_norm_eq_zero, λ hx, by simpa only [hx]⟩,
+  abv_add := padic_norm.triangle_ineq,
+  abv_mul := padic_norm.mul }
+
+lemma dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p ^ n) ∣ z ↔ padic_norm p z ≤ p ^ (-n : ℤ) :=
 begin
   unfold padic_norm, split_ifs with hz,
   { norm_cast at hz,
-    have : 0 ≤ (p^n : ℚ), {apply pow_nonneg, exact_mod_cast le_of_lt hp.1.pos },
+    have : 0 ≤ (p ^ n : ℚ), {apply pow_nonneg, exact_mod_cast le_of_lt hp.1.pos },
     simp [hz, this] },
   { rw [zpow_le_iff_le, neg_le_neg_iff, padic_val_rat.of_int,
       padic_val_int.of_ne_one_ne_zero hp.1.ne_one _],
     { norm_cast,
-      rw [← enat.coe_le_coe, enat.coe_get, ← multiplicity.pow_dvd_iff_le_multiplicity],
+      rw [← part_enat.coe_le_coe, part_enat.coe_get, ← multiplicity.pow_dvd_iff_le_multiplicity],
       simp },
     { exact_mod_cast hz },
     { exact_mod_cast hp.1.one_lt } }
 end
 
-end padic_norm
+/-- The `p`-adic norm of an integer `m` is one iff `p` doesn't divide `m`. -/
+lemma int_eq_one_iff (m : ℤ) : padic_norm p m = 1 ↔ ¬ (p : ℤ) ∣ m :=
+begin
+  nth_rewrite 1 ← pow_one p,
+  simp only [dvd_iff_norm_le, int.cast_coe_nat, nat.cast_one, zpow_neg, zpow_one, not_le],
+  split,
+  { intro h,
+    rw [h, inv_lt_one_iff_of_pos];
+    norm_cast,
+    { exact nat.prime.one_lt (fact.out _), },
+    { exact nat.prime.pos (fact.out _), }, },
+  { simp only [padic_norm],
+    split_ifs,
+    { rw [inv_lt_zero, ← nat.cast_zero, nat.cast_lt],
+      intro h, exact (nat.not_lt_zero p h).elim, },
+    { have : 1 < (p : ℚ) := by norm_cast; exact (nat.prime.one_lt (fact.out _ : nat.prime p)),
+      rw [← zpow_neg_one, zpow_lt_iff_lt this],
+      have : 0 ≤ padic_val_rat p m, simp only [of_int, nat.cast_nonneg],
+      intro h,
+      rw [← zpow_zero (p : ℚ), zpow_inj];
+      linarith, } },
+end
+
+lemma int_lt_one_iff (m : ℤ) : padic_norm p m < 1 ↔ (p : ℤ) ∣ m :=
+begin
+  rw [← not_iff_not, ← int_eq_one_iff, eq_iff_le_not_lt],
+  simp only [padic_norm.of_int, true_and],
+end
+
+lemma of_nat (m : ℕ) : padic_norm p m ≤ 1 := padic_norm.of_int (m : ℤ)
+
+/-- The `p`-adic norm of a natural `m` is one iff `p` doesn't divide `m`. -/
+lemma nat_eq_one_iff (m : ℕ) : padic_norm p m = 1 ↔ ¬ p ∣ m :=
+by simp only [←int.coe_nat_dvd, ←int_eq_one_iff, int.cast_coe_nat]
+
+lemma nat_lt_one_iff (m : ℕ) : padic_norm p m < 1 ↔ p ∣ m :=
+by simp only [←int.coe_nat_dvd, ←int_lt_one_iff, int.cast_coe_nat]
+
+open_locale big_operators
+
+lemma sum_lt {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} :
+  s.nonempty → (∀ i ∈ s, padic_norm p (F i) < t) → padic_norm p (∑ i in s, F i) < t :=
+begin
+  classical,
+  refine s.induction_on (by { rintro ⟨-, ⟨⟩⟩, }) _,
+  rintro a S haS IH - ht,
+  by_cases hs : S.nonempty,
+  { rw finset.sum_insert haS,
+    exact lt_of_le_of_lt padic_norm.nonarchimedean (max_lt
+      (ht a (finset.mem_insert_self a S))
+      (IH hs (λ b hb, ht b (finset.mem_insert_of_mem hb)))), },
+  { simp * at *, },
+end
+
+lemma sum_le {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} :
+  s.nonempty → (∀ i ∈ s, padic_norm p (F i) ≤ t) → padic_norm p (∑ i in s, F i) ≤ t :=
+begin
+  classical,
+  refine s.induction_on (by { rintro ⟨-, ⟨⟩⟩, }) _,
+  rintro a S haS IH - ht,
+  by_cases hs : S.nonempty,
+  { rw finset.sum_insert haS,
+    exact padic_norm.nonarchimedean.trans (max_le
+      (ht a (finset.mem_insert_self a S))
+      (IH hs (λ b hb, ht b (finset.mem_insert_of_mem hb)))), },
+  { simp * at *, },
+end
+
+lemma sum_lt' {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} (hF : ∀ i ∈ s, padic_norm p (F i) < t)
+  (ht : 0 < t) : padic_norm p (∑ i in s, F i) < t :=
+begin
+  obtain rfl | hs := finset.eq_empty_or_nonempty s,
+  { simp [ht], },
+  { exact sum_lt hs hF, },
+end
+
+lemma sum_le' {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} (hF : ∀ i ∈ s, padic_norm p (F i) ≤ t)
+  (ht : 0 ≤ t) : padic_norm p (∑ i in s, F i) ≤ t :=
+begin
+  obtain rfl | hs := finset.eq_empty_or_nonempty s,
+  { simp [ht], },
+  { exact sum_le hs hF, },
+end
+
 end padic_norm
diff --git a/src/number_theory/padics/padic_numbers.lean b/src/number_theory/padics/padic_numbers.lean
index d48b61bcbc334..778e8937e1c6e 100644
--- a/src/number_theory/padics/padic_numbers.lean
+++ b/src/number_theory/padics/padic_numbers.lean
@@ -3,49 +3,52 @@ Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-import analysis.normed_space.basic
 import number_theory.padics.padic_norm
+import analysis.normed.field.basic
 
 /-!
 # p-adic numbers
 
-This file defines the p-adic numbers (rationals) `ℚ_p` as
-the completion of `ℚ` with respect to the p-adic norm.
-We show that the p-adic norm on ℚ extends to `ℚ_p`, that `ℚ` is embedded in `ℚ_p`,
-and that `ℚ_p` is Cauchy complete.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the `p`-adic numbers (rationals) `ℚ_[p]` as
+the completion of `ℚ` with respect to the `p`-adic norm.
+We show that the `p`-adic norm on `ℚ` extends to `ℚ_[p]`, that `ℚ` is embedded in `ℚ_[p]`,
+and that `ℚ_[p]` is Cauchy complete.
 
 ## Important definitions
 
-* `padic` : the type of p-adic numbers
-* `padic_norm_e` : the rational valued p-adic norm on `ℚ_p`
-* `padic.add_valuation` : the additive `p`-adic valuation on `ℚ_p`, with values in `with_top ℤ`.
+* `padic` : the type of `p`-adic numbers
+* `padic_norm_e` : the rational valued `p`-adic norm on `ℚ_[p]`
+* `padic.add_valuation` : the additive `p`-adic valuation on `ℚ_[p]`, with values in `with_top ℤ`
 
 ## Notation
 
-We introduce the notation `ℚ_[p]` for the p-adic numbers.
+We introduce the notation `ℚ_[p]` for the `p`-adic numbers.
 
 ## Implementation notes
 
 Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
-by taking `[fact (prime p)]` as a type class argument.
+by taking `[fact p.prime]` as a type class argument.
 
-We use the same concrete Cauchy sequence construction that is used to construct ℝ.
-`ℚ_p` inherits a field structure from this construction.
-The extension of the norm on ℚ to `ℚ_p` is *not* analogous to extending the absolute value to ℝ,
-and hence the proof that `ℚ_p` is complete is different from the proof that ℝ is complete.
+We use the same concrete Cauchy sequence construction that is used to construct `ℝ`.
+`ℚ_[p]` inherits a field structure from this construction.
+The extension of the norm on `ℚ` to `ℚ_[p]` is *not* analogous to extending the absolute value to
+`ℝ` and hence the proof that `ℚ_[p]` is complete is different from the proof that ℝ is complete.
 
 A small special-purpose simplification tactic, `padic_index_simp`, is used to manipulate sequence
 indices in the proof that the norm extends.
 
-`padic_norm_e` is the rational-valued p-adic norm on `ℚ_p`.
-To instantiate `ℚ_p` as a normed field, we must cast this into a ℝ-valued norm.
-The `ℝ`-valued norm, using notation `∥ ∥` from normed spaces,
+`padic_norm_e` is the rational-valued `p`-adic norm on `ℚ_[p]`.
+To instantiate `ℚ_[p]` as a normed field, we must cast this into a `ℝ`-valued norm.
+The `ℝ`-valued norm, using notation `‖ ‖` from normed spaces,
 is the canonical representation of this norm.
 
 `simp` prefers `padic_norm` to `padic_norm_e` when possible.
-Since `padic_norm_e` and `∥ ∥` have different types, `simp` does not rewrite one to the other.
+Since `padic_norm_e` and `‖ ‖` have different types, `simp` does not rewrite one to the other.
 
-Coercions from `ℚ` to `ℚ_p` are set up to work with the `norm_cast` tactic.
+Coercions from `ℚ` to `ℚ_[p]` are set up to work with the `norm_cast` tactic.
 
 ## References
 
@@ -63,7 +66,7 @@ open_locale classical
 
 open nat multiplicity padic_norm cau_seq cau_seq.completion metric
 
-/-- The type of Cauchy sequences of rationals with respect to the p-adic norm. -/
+/-- The type of Cauchy sequences of rationals with respect to the `p`-adic norm. -/
 @[reducible] def padic_seq (p : ℕ) := cau_seq _ (padic_norm p)
 
 namespace padic_seq
@@ -71,7 +74,7 @@ namespace padic_seq
 section
 variables {p : ℕ} [fact p.prime]
 
-/-- The p-adic norm of the entries of a nonzero Cauchy sequence of rationals is eventually
+/-- The `p`-adic norm of the entries of a nonzero Cauchy sequence of rationals is eventually
 constant. -/
 lemma stationary {f : cau_seq ℚ (padic_norm p)} (hf : ¬ f ≈ 0) :
   ∃ N, ∀ m n, N ≤ m → N ≤ n → padic_norm p (f n) = padic_norm p (f m) :=
@@ -88,16 +91,15 @@ let ⟨ε, hε, N1, hN1⟩ := this,
     from lt_max_iff.2 (or.inl this),
   begin
     by_contradiction hne,
-    rw ←padic_norm.neg p (f m) at hne,
-    have hnam := add_eq_max_of_ne p hne,
+    rw ← padic_norm.neg (f m) at hne,
+    have hnam := add_eq_max_of_ne hne,
     rw [padic_norm.neg, max_comm] at hnam,
-    rw [←hnam, sub_eq_add_neg, add_comm] at this,
+    rw [← hnam, sub_eq_add_neg, add_comm] at this,
     apply _root_.lt_irrefl _ this
   end ⟩
 
-/-- For all n ≥ stationary_point f hf, the p-adic norm of f n is the same. -/
-def stationary_point {f : padic_seq p} (hf : ¬ f ≈ 0) : ℕ :=
-classical.some $ stationary hf
+/-- For all `n ≥ stationary_point f hf`, the `p`-adic norm of `f n` is the same. -/
+def stationary_point {f : padic_seq p} (hf : ¬ f ≈ 0) : ℕ := classical.some $ stationary hf
 
 lemma stationary_point_spec {f : padic_seq p} (hf : ¬ f ≈ 0) :
   ∀ {m n}, stationary_point hf ≤ m → stationary_point hf ≤ n →
@@ -106,8 +108,7 @@ classical.some_spec $ stationary hf
 
 /-- Since the norm of the entries of a Cauchy sequence is eventually stationary,
 we can lift the norm to sequences. -/
-def norm (f : padic_seq p) : ℚ :=
-if hf : f ≈ 0 then 0 else padic_norm p (f (stationary_point hf))
+def norm (f : padic_seq p) : ℚ := if hf : f ≈ 0 then 0 else padic_norm p (f (stationary_point hf))
 
 lemma norm_zero_iff (f : padic_seq p) : f.norm = 0 ↔ f ≈ 0 :=
 begin
@@ -133,28 +134,24 @@ variables {p : ℕ} [fact p.prime]
 
 lemma equiv_zero_of_val_eq_of_equiv_zero {f g : padic_seq p}
   (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) (hf : f ≈ 0) : g ≈ 0 :=
-λ ε hε, let ⟨i, hi⟩ := hf _ hε in
-⟨i, λ j hj, by simpa [h] using hi _ hj⟩
+λ ε hε, let ⟨i, hi⟩ := hf _ hε in ⟨i, λ j hj, by simpa [h] using hi _ hj⟩
 
-lemma norm_nonzero_of_not_equiv_zero {f : padic_seq p} (hf : ¬ f ≈ 0) :
-  f.norm ≠ 0 :=
+lemma norm_nonzero_of_not_equiv_zero {f : padic_seq p} (hf : ¬ f ≈ 0) : f.norm ≠ 0 :=
 hf ∘ f.norm_zero_iff.1
 
 lemma norm_eq_norm_app_of_nonzero {f : padic_seq p} (hf : ¬ f ≈ 0) :
   ∃ k, f.norm = padic_norm p k ∧ k ≠ 0 :=
 have heq : f.norm = padic_norm p (f $ stationary_point hf), by simp [norm, hf],
-⟨f $ stationary_point hf, heq,
-  λ h, norm_nonzero_of_not_equiv_zero hf (by simpa [h] using heq)⟩
+⟨f $ stationary_point hf, heq, λ h, norm_nonzero_of_not_equiv_zero hf (by simpa [h] using heq)⟩
 
 lemma not_lim_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ lim_zero (const (padic_norm p) q) :=
 λ h', hq $ const_lim_zero.1 h'
 
-lemma not_equiv_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ (const (padic_norm p) q) ≈ 0 :=
+lemma not_equiv_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ const (padic_norm p) q ≈ 0 :=
 λ h : lim_zero (const (padic_norm p) q - 0), not_lim_zero_const_of_nonzero hq $ by simpa using h
 
 lemma norm_nonneg (f : padic_seq p) : 0 ≤ f.norm :=
-if hf : f ≈ 0 then by simp [hf, norm]
-else by simp [norm, hf, padic_norm.nonneg]
+if hf : f ≈ 0 then by simp [hf, norm] else by simp [norm, hf, padic_norm.nonneg]
 
 /-- An auxiliary lemma for manipulating sequence indices. -/
 lemma lift_index_left_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v2 v3 : ℕ) :
@@ -198,15 +195,12 @@ variables {p : ℕ} [fact p.prime]
 
 /-! ### Valuation on `padic_seq` -/
 
-/--
-The `p`-adic valuation on `ℚ` lifts to `padic_seq p`.
-`valuation f` is defined to be the valuation of the (`ℚ`-valued) stationary point of `f`.
--/
+/-- The `p`-adic valuation on `ℚ` lifts to `padic_seq p`.
+`valuation f` is defined to be the valuation of the (`ℚ`-valued) stationary point of `f`. -/
 def valuation (f : padic_seq p) : ℤ :=
 if hf : f ≈ 0 then 0 else padic_val_rat p (f (stationary_point hf))
 
-lemma norm_eq_pow_val {f : padic_seq p} (hf : ¬ f ≈ 0) :
-  f.norm = p^(-f.valuation : ℤ) :=
+lemma norm_eq_pow_val {f : padic_seq p} (hf : ¬ f ≈ 0) : f.norm = p ^ (-f.valuation : ℤ) :=
 begin
   rw [norm, valuation, dif_neg hf, dif_neg hf, padic_norm, if_neg],
   intro H,
@@ -215,7 +209,7 @@ begin
   use (stationary_point hf),
   intros n hn,
   rw stationary_point_spec hf le_rfl hn,
-  simpa [H] using hε,
+  simpa [H] using hε
 end
 
 lemma val_eq_iff_norm_eq {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) :
@@ -223,7 +217,7 @@ lemma val_eq_iff_norm_eq {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0)
 begin
   rw [norm_eq_pow_val hf, norm_eq_pow_val hg, ← neg_inj, zpow_inj],
   { exact_mod_cast (fact.out p.prime).pos },
-  { exact_mod_cast (fact.out p.prime).ne_one },
+  { exact_mod_cast (fact.out p.prime).ne_one }
 end
 
 end valuation
@@ -244,10 +238,8 @@ do [v1, v2, v3] ← [hh, hf, hg].mmap
    when at_.include_goal (tactic.simp_target sl >> tactic.skip),
    hs ← at_.get_locals, hs.mmap' (tactic.simp_hyp sl [])
 
-/--
-  This is a special-purpose tactic that lifts padic_norm (f (stationary_point f)) to
-  padic_norm (f (max _ _ _)).
--/
+/-- This is a special-purpose tactic that lifts `padic_norm (f (stationary_point f))` to
+`padic_norm (f (max _ _ _))`. -/
 meta def tactic.interactive.padic_index_simp (l : interactive.parse interactive.types.pexpr_list)
   (at_ : interactive.parse interactive.types.location) : tactic unit :=
 do [h, f, g] ← l.mmap tactic.i_to_expr,
@@ -277,8 +269,7 @@ else
     apply padic_norm.mul
   end
 
-lemma eq_zero_iff_equiv_zero (f : padic_seq p) : mk f = 0 ↔ f ≈ 0 :=
-mk_eq
+lemma eq_zero_iff_equiv_zero (f : padic_seq p) : mk f = 0 ↔ f ≈ 0 := mk_eq
 
 lemma ne_zero_iff_nequiv_zero (f : padic_seq p) : mk f ≠ 0 ↔ ¬ f ≈ 0 :=
 not_iff_not.2 (eq_zero_iff_equiv_zero _)
@@ -292,10 +283,9 @@ else
   have ¬ (const (padic_norm p) q) ≈ 0, from not_equiv_zero_const_of_nonzero hq,
   by simp [norm, this]
 
-lemma norm_values_discrete (a : padic_seq p) (ha : ¬ a ≈ 0) :
-  (∃ (z : ℤ), a.norm = ↑p ^ (-z)) :=
+lemma norm_values_discrete (a : padic_seq p) (ha : ¬ a ≈ 0) : ∃ z : ℤ, a.norm = p ^ -z :=
 let ⟨k, hk, hk'⟩ := norm_eq_norm_app_of_nonzero ha in
-by simpa [hk] using padic_norm.values_discrete p hk'
+by simpa [hk] using padic_norm.values_discrete hk'
 
 lemma norm_one : norm (1 : padic_seq p) = 1 :=
 have h1 : ¬ (1 : padic_seq p) ≈ 0, from one_not_equiv_zero _,
@@ -303,8 +293,7 @@ by simp [h1, norm, hp.1.one_lt]
 
 private lemma norm_eq_of_equiv_aux {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g)
   (h : padic_norm p (f (stationary_point hf)) ≠ padic_norm p (g (stationary_point hg)))
-  (hlt : padic_norm p (g (stationary_point hg)) < padic_norm p (f (stationary_point hf))) :
-  false :=
+  (hlt : padic_norm p (g (stationary_point hg)) < padic_norm p (f (stationary_point hf))) : false :=
 begin
   have hpn : 0 < padic_norm p (f (stationary_point hf)) - padic_norm p (g (stationary_point hg)),
     from sub_pos_of_lt hlt,
@@ -314,8 +303,8 @@ begin
   have hN' := hN _ hi,
   padic_index_simp [N, hf, hg] at hN' h hlt,
   have hpne : padic_norm p (f i) ≠ padic_norm p (-(g i)),
-    by rwa [ ←padic_norm.neg p (g i)] at h,
-  let hpnem := add_eq_max_of_ne p hpne,
+    by rwa [← padic_norm.neg (g i)] at h,
+  let hpnem := add_eq_max_of_ne hpne,
   have hpeq : padic_norm p ((f - g) i) = max (padic_norm p (f i)) (padic_norm p (g i)),
   { rwa padic_norm.neg at hpnem },
   rw [hpeq, max_eq_left_of_lt hlt] at hN',
@@ -346,16 +335,16 @@ else have hg : ¬ g ≈ 0, from hf ∘ setoid.trans hfg,
 by unfold norm; split_ifs; exact norm_eq_of_equiv hf hg hfg
 
 private lemma norm_nonarchimedean_aux {f g : padic_seq p}
-  (hfg : ¬ f + g ≈ 0) (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : (f + g).norm ≤ max (f.norm) (g.norm) :=
+  (hfg : ¬ f + g ≈ 0) (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : (f + g).norm ≤ max f.norm g.norm :=
 begin
   unfold norm, split_ifs,
   padic_index_simp [hfg, hf, hg],
   apply padic_norm.nonarchimedean
 end
 
-theorem norm_nonarchimedean (f g : padic_seq p) : (f + g).norm ≤ max (f.norm) (g.norm) :=
+theorem norm_nonarchimedean (f g : padic_seq p) : (f + g).norm ≤ max f.norm g.norm :=
 if hfg : f + g ≈ 0 then
-  have 0 ≤ max (f.norm) (g.norm), from le_max_of_le_left (norm_nonneg _),
+  have 0 ≤ max f.norm g.norm, from le_max_of_le_left (norm_nonneg _),
   by simpa only [hfg, norm, ne.def, le_max_iff, cau_seq.add_apply, not_true, dif_pos]
 else if hf : f ≈ 0 then
   have hfg' : f + g ≈ g,
@@ -363,7 +352,7 @@ else if hf : f ≈ 0 then
     show lim_zero (f + g - g), by simpa only [sub_zero, add_sub_cancel] using hf },
   have hcfg : (f + g).norm = g.norm, from norm_equiv hfg',
   have hcl : f.norm = 0, from (norm_zero_iff f).2 hf,
-  have max (f.norm) (g.norm) = g.norm,
+  have max f.norm g.norm = g.norm,
     by rw hcl; exact max_eq_right (norm_nonneg _),
   by rw [this, hcfg]
 else if hg : g ≈ 0 then
@@ -372,7 +361,7 @@ else if hg : g ≈ 0 then
     show lim_zero (f + g - f), by simpa only [add_sub_cancel', sub_zero] using hg },
   have hcfg : (f + g).norm = f.norm, from norm_equiv hfg',
   have hcl : g.norm = 0, from (norm_zero_iff g).2 hg,
-  have max (f.norm) (g.norm) = f.norm,
+  have max f.norm g.norm = f.norm,
     by rw hcl; exact max_eq_left (norm_nonneg _),
   by rw [this, hcfg]
 else norm_nonarchimedean_aux hfg hf hg
@@ -395,8 +384,7 @@ else
     rw [hpf, hpg, h]
   end
 
-lemma norm_neg (a : padic_seq p) : (-a).norm = a.norm :=
-norm_eq $ by simp
+lemma norm_neg (a : padic_seq p) : (-a).norm = a.norm := norm_eq $ by simp
 
 lemma norm_eq_of_add_equiv_zero {f g : padic_seq p} (h : f + g ≈ 0) : f.norm = g.norm :=
 have lim_zero (f + g - 0), from h,
@@ -410,26 +398,27 @@ have hfg : ¬f + g ≈ 0, from mt norm_eq_of_add_equiv_zero hfgne,
 if hf : f ≈ 0 then
   have lim_zero (f - 0), from hf,
   have f + g ≈ g, from show lim_zero ((f + g) - g), by simpa only [sub_zero, add_sub_cancel],
-  have h1 : (f+g).norm = g.norm, from norm_equiv this,
+  have h1 : (f + g).norm = g.norm, from norm_equiv this,
   have h2 : f.norm = 0, from (norm_zero_iff _).2 hf,
   by rw [h1, h2]; rw max_eq_right (norm_nonneg _)
 else if hg : g ≈ 0 then
   have lim_zero (g - 0), from hg,
   have f + g ≈ f, from show lim_zero ((f + g) - f), by rw [add_sub_cancel']; simpa only [sub_zero],
-  have h1 : (f+g).norm = f.norm, from norm_equiv this,
+  have h1 : (f + g).norm = f.norm, from norm_equiv this,
   have h2 : g.norm = 0, from (norm_zero_iff _).2 hg,
   by rw [h1, h2]; rw max_eq_left (norm_nonneg _)
 else
 begin
   unfold norm at ⊢ hfgne, split_ifs at ⊢ hfgne,
   padic_index_simp [hfg, hf, hg] at ⊢ hfgne,
-  exact padic_norm.add_eq_max_of_ne p hfgne
+  exact padic_norm.add_eq_max_of_ne hfgne
 end
 
 end embedding
 end padic_seq
 
-/-- The p-adic numbers `Q_[p]` are the Cauchy completion of `ℚ` with respect to the p-adic norm. -/
+/-- The `p`-adic numbers `ℚ_[p]` are the Cauchy completion of `ℚ` with respect to the `p`-adic norm.
+-/
 def padic (p : ℕ) [fact p.prime] := @cau_seq.completion.Cauchy _ _ _ _ (padic_norm p) _
 notation `ℚ_[` p `]` := padic p
 
@@ -438,14 +427,14 @@ namespace padic
 section completion
 variables {p : ℕ} [fact p.prime]
 
-/-- The discrete field structure on `ℚ_p` is inherited from the Cauchy completion construction. -/
-instance field : field (ℚ_[p]) :=
-cau_seq.completion.field
+instance : field (ℚ_[p]) := Cauchy.field
 
 instance : inhabited ℚ_[p] := ⟨0⟩
 
 -- short circuits
 
+instance : comm_ring (ℚ_[p]) := Cauchy.comm_ring
+instance : ring (ℚ_[p]) := Cauchy.ring
 instance : has_zero ℚ_[p] := by apply_instance
 instance : has_one ℚ_[p] := by apply_instance
 instance : has_add ℚ_[p] := by apply_instance
@@ -454,85 +443,50 @@ instance : has_sub ℚ_[p] := by apply_instance
 instance : has_neg ℚ_[p] := by apply_instance
 instance : has_div ℚ_[p] := by apply_instance
 instance : add_comm_group ℚ_[p] := by apply_instance
-instance : comm_ring ℚ_[p] := by apply_instance
 
 /-- Builds the equivalence class of a Cauchy sequence of rationals. -/
 def mk : padic_seq p → ℚ_[p] := quotient.mk
-end completion
-
-section completion
-variables (p : ℕ) [fact p.prime]
-
-lemma mk_eq {f g : padic_seq p} : mk f = mk g ↔ f ≈ g := quotient.eq
-
-/-- Embeds the rational numbers in the p-adic numbers. -/
-def of_rat : ℚ → ℚ_[p] := cau_seq.completion.of_rat
-
-@[simp] lemma of_rat_add : ∀ (x y : ℚ), of_rat p (x + y) = of_rat p x + of_rat p y :=
-cau_seq.completion.of_rat_add
-
-@[simp] lemma of_rat_neg : ∀ (x : ℚ), of_rat p (-x) = -of_rat p x :=
-cau_seq.completion.of_rat_neg
-
-@[simp] lemma of_rat_mul : ∀ (x y : ℚ), of_rat p (x * y) = of_rat p x * of_rat p y :=
-cau_seq.completion.of_rat_mul
 
-@[simp] lemma of_rat_sub : ∀ (x y : ℚ), of_rat p (x - y) = of_rat p x - of_rat p y :=
-cau_seq.completion.of_rat_sub
+variables (p)
 
-@[simp] lemma of_rat_div : ∀ (x y : ℚ), of_rat p (x / y) = of_rat p x / of_rat p y :=
-cau_seq.completion.of_rat_div
-
-@[simp] lemma of_rat_one : of_rat p 1 = 1 := rfl
-
-@[simp] lemma of_rat_zero : of_rat p 0 = 0 := rfl
-
-lemma cast_eq_of_rat_of_nat (n : ℕ) : (↑n : ℚ_[p]) = of_rat p n :=
-begin
-  induction n with n ih,
-  { refl },
-  { simpa using ih }
-end
-
-lemma cast_eq_of_rat_of_int (n : ℤ) : ↑n = of_rat p n :=
-by induction n; simp [cast_eq_of_rat_of_nat]
-
-lemma cast_eq_of_rat : ∀ (q : ℚ), (↑q : ℚ_[p]) = of_rat p q
-| ⟨n, d, h1, h2⟩ :=
-  show ↑n / ↑d = _, from
-    have (⟨n, d, h1, h2⟩ : ℚ) = rat.mk n d, from rat.num_denom',
-    by simp [this, rat.mk_eq_div, of_rat_div, cast_eq_of_rat_of_int, cast_eq_of_rat_of_nat]
-
-@[norm_cast] lemma coe_add : ∀ {x y : ℚ}, (↑(x + y) : ℚ_[p]) = ↑x + ↑y := by simp [cast_eq_of_rat]
-@[norm_cast] lemma coe_neg : ∀ {x : ℚ}, (↑(-x) : ℚ_[p]) = -↑x := by simp [cast_eq_of_rat]
-@[norm_cast] lemma coe_mul : ∀ {x y : ℚ}, (↑(x * y) : ℚ_[p]) = ↑x * ↑y := by simp [cast_eq_of_rat]
-@[norm_cast] lemma coe_sub : ∀ {x y : ℚ}, (↑(x - y) : ℚ_[p]) = ↑x - ↑y := by simp [cast_eq_of_rat]
-@[norm_cast] lemma coe_div : ∀ {x y : ℚ}, (↑(x / y) : ℚ_[p]) = ↑x / ↑y := by simp [cast_eq_of_rat]
+lemma zero_def : (0 : ℚ_[p]) = ⟦0⟧ := rfl
 
-@[norm_cast] lemma coe_one : (↑1 : ℚ_[p]) = 1 := by simp [cast_eq_of_rat]
-@[norm_cast] lemma coe_zero : (↑0 : ℚ_[p]) = 0 := rfl
+lemma mk_eq {f g : padic_seq p} : mk f = mk g ↔ f ≈ g := quotient.eq
 
 lemma const_equiv {q r : ℚ} : const (padic_norm p) q ≈ const (padic_norm p) r ↔ q = r :=
-⟨ λ heq : lim_zero (const (padic_norm p) (q - r)),
-    eq_of_sub_eq_zero $ const_lim_zero.1 heq,
-  λ heq, by rw heq; apply setoid.refl _ ⟩
+⟨ λ heq, eq_of_sub_eq_zero $ const_lim_zero.1 heq, λ heq, by rw heq; apply setoid.refl _ ⟩
 
-lemma of_rat_eq {q r : ℚ} : of_rat p q = of_rat p r ↔ q = r :=
+@[norm_cast] lemma coe_inj {q r : ℚ} : (↑q : ℚ_[p]) = ↑r ↔ q = r :=
 ⟨(const_equiv p).1 ∘ quotient.eq.1, λ h, by rw h⟩
 
-@[norm_cast] lemma coe_inj {q r : ℚ} : (↑q : ℚ_[p]) = ↑r ↔ q = r :=
-by simp [cast_eq_of_rat, of_rat_eq]
+instance : char_zero ℚ_[p] := ⟨λ m n, by { rw ← rat.cast_coe_nat, norm_cast, exact id }⟩
 
-instance : char_zero ℚ_[p] :=
-⟨λ m n, by { rw ← rat.cast_coe_nat, norm_cast, exact id }⟩
+@[norm_cast] lemma coe_add : ∀ {x y : ℚ}, (↑(x + y) : ℚ_[p]) = ↑x + ↑y := rat.cast_add
+@[norm_cast] lemma coe_neg : ∀ {x : ℚ}, (↑(-x) : ℚ_[p]) = -↑x := rat.cast_neg
+@[norm_cast] lemma coe_mul : ∀ {x y : ℚ}, (↑(x * y) : ℚ_[p]) = ↑x * ↑y := rat.cast_mul
+@[norm_cast] lemma coe_sub : ∀ {x y : ℚ}, (↑(x - y) : ℚ_[p]) = ↑x - ↑y := rat.cast_sub
+@[norm_cast] lemma coe_div : ∀ {x y : ℚ}, (↑(x / y) : ℚ_[p]) = ↑x / ↑y := rat.cast_div
+@[norm_cast] lemma coe_one : (↑1 : ℚ_[p]) = 1 := rfl
+@[norm_cast] lemma coe_zero : (↑0 : ℚ_[p]) = 0 := rfl
 
 end completion
 end padic
 
-/-- The rational-valued p-adic norm on `ℚ_p` is lifted from the norm on Cauchy sequences. The
-canonical form of this function is the normed space instance, with notation `∥ ∥`. -/
-def padic_norm_e {p : ℕ} [hp : fact p.prime] : ℚ_[p] → ℚ :=
-quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _
+/-- The rational-valued `p`-adic norm on `ℚ_[p]` is lifted from the norm on Cauchy sequences. The
+canonical form of this function is the normed space instance, with notation `‖ ‖`. -/
+def padic_norm_e {p : ℕ} [hp : fact p.prime] : absolute_value ℚ_[p] ℚ :=
+{ to_fun := quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _,
+  map_mul' := λ q r, quotient.induction_on₂ q r $ padic_seq.norm_mul,
+  nonneg' := λ q, quotient.induction_on q $ padic_seq.norm_nonneg,
+  eq_zero' := λ q, quotient.induction_on q $
+                    by simpa only [padic.zero_def, quotient.eq] using padic_seq.norm_zero_iff,
+  add_le' := λ q r, begin
+    transitivity max ((quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _) q)
+                     ((quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _) r),
+    exact (quotient.induction_on₂ q r $ padic_seq.norm_nonarchimedean),
+    refine max_le_add_of_nonneg (quotient.induction_on q $ padic_seq.norm_nonneg) _,
+    exact (quotient.induction_on r $ padic_seq.norm_nonneg)
+  end }
 
 namespace padic_norm_e
 section embedding
@@ -541,7 +495,7 @@ variables {p : ℕ} [fact p.prime]
 
 lemma defn (f : padic_seq p) {ε : ℚ} (hε : 0 < ε) : ∃ N, ∀ i ≥ N, padic_norm_e (⟦f⟧ - f i) < ε :=
 begin
-  simp only [padic.cast_eq_of_rat],
+  dsimp [padic_norm_e],
   change ∃ N, ∀ i ≥ N, (f - const _ (f i)).norm < ε,
   by_contra' h,
   cases cauchy₂ f hε with N hN,
@@ -553,75 +507,30 @@ begin
   cases em (N ≤ stationary_point hne) with hgen hngen,
   { apply hN _ hgen _ hi },
   { have := stationary_point_spec hne le_rfl (le_of_not_le hngen),
-    rw ←this,
-    exact hN _ le_rfl _ hi },
+    rw ← this,
+    exact hN _ le_rfl _ hi }
 end
 
-protected lemma nonneg (q : ℚ_[p]) : 0 ≤ padic_norm_e q :=
-quotient.induction_on q $ norm_nonneg
-
-lemma zero_def : (0 : ℚ_[p]) = ⟦0⟧ := rfl
-
-lemma zero_iff (q : ℚ_[p]) : padic_norm_e q = 0 ↔ q = 0 :=
-quotient.induction_on q $
-  by simpa only [zero_def, quotient.eq] using norm_zero_iff
-
-@[simp] protected lemma zero : padic_norm_e (0 : ℚ_[p]) = 0 :=
-(zero_iff _).2 rfl
-
-/-- Theorems about `padic_norm_e` are named with a `'` so the names do not conflict with the
-equivalent theorems about `norm` (`∥ ∥`). -/
-@[simp] protected lemma one' : padic_norm_e (1 : ℚ_[p]) = 1 :=
-norm_one
-
-@[simp] protected lemma neg (q : ℚ_[p]) : padic_norm_e (-q) = padic_norm_e q :=
-quotient.induction_on q $ norm_neg
-
 /-- Theorems about `padic_norm_e` are named with a `'` so the names do not conflict with the
-equivalent theorems about `norm` (`∥ ∥`). -/
+equivalent theorems about `norm` (`‖ ‖`). -/
 theorem nonarchimedean' (q r : ℚ_[p]) :
   padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) :=
 quotient.induction_on₂ q r $ norm_nonarchimedean
 
 /-- Theorems about `padic_norm_e` are named with a `'` so the names do not conflict with the
-equivalent theorems about `norm` (`∥ ∥`). -/
+equivalent theorems about `norm` (`‖ ‖`). -/
 theorem add_eq_max_of_ne' {q r : ℚ_[p]} :
   padic_norm_e q ≠ padic_norm_e r → padic_norm_e (q + r) = max (padic_norm_e q) (padic_norm_e r) :=
 quotient.induction_on₂ q r $ λ _ _, padic_seq.add_eq_max_of_ne
 
-lemma triangle_ineq (x y z : ℚ_[p]) :
-  padic_norm_e (x - z) ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :=
-calc padic_norm_e (x - z) = padic_norm_e ((x - y) + (y - z)) : by rw sub_add_sub_cancel
-  ... ≤ max (padic_norm_e (x - y)) (padic_norm_e (y - z)) : padic_norm_e.nonarchimedean' _ _
-  ... ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :
-    max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)
-
-protected lemma add (q r : ℚ_[p]) : padic_norm_e (q + r) ≤ (padic_norm_e q) + (padic_norm_e r) :=
-calc
-  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) : nonarchimedean' _ _
-                      ... ≤ (padic_norm_e q) + (padic_norm_e r) :
-                              max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)
-
-protected lemma mul' (q r : ℚ_[p]) : padic_norm_e (q * r) = (padic_norm_e q) * (padic_norm_e r) :=
-quotient.induction_on₂ q r $ norm_mul
-
-instance : is_absolute_value (@padic_norm_e p _) :=
-{ abv_nonneg := padic_norm_e.nonneg,
-  abv_eq_zero := zero_iff,
-  abv_add := padic_norm_e.add,
-  abv_mul := padic_norm_e.mul' }
-
-@[simp] lemma eq_padic_norm' (q : ℚ) : padic_norm_e (padic.of_rat p q) = padic_norm p q :=
+@[simp] lemma eq_padic_norm' (q : ℚ) : padic_norm_e (q : ℚ_[p]) = padic_norm p q :=
 norm_const _
 
-protected theorem image' {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, padic_norm_e q = p ^ (-n) :=
+protected theorem image' {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, padic_norm_e q = p ^ -n :=
 quotient.induction_on q $ λ f hf,
   have ¬ f ≈ 0, from (ne_zero_iff_nequiv_zero f).1 hf,
   norm_values_discrete f this
 
-lemma sub_rev (q r : ℚ_[p]) : padic_norm_e (q - r) = padic_norm_e (r - q) :=
-by rw ←(padic_norm_e.neg); simp
-
 end embedding
 end padic_norm_e
 
@@ -630,14 +539,16 @@ namespace padic
 section complete
 open padic_seq padic
 
-theorem rat_dense' {p : ℕ} [fact p.prime] (q : ℚ_[p]) {ε : ℚ} (hε : 0 < ε) :
+variables {p : ℕ} [fact p.prime] (f : cau_seq _ (@padic_norm_e p _))
+
+theorem rat_dense' (q : ℚ_[p]) {ε : ℚ} (hε : 0 < ε) :
   ∃ r : ℚ, padic_norm_e (q - r) < ε :=
 quotient.induction_on q $ λ q',
   have ∃ N, ∀ m n ≥ N, padic_norm p (q' m - q' n) < ε, from cauchy₂ _ hε,
   let ⟨N, hN⟩ := this in
   ⟨q' N,
     begin
-      simp only [padic.cast_eq_of_rat],
+      dsimp [padic_norm_e],
       change padic_seq.norm (q' - const _ (q' N)) < ε,
       cases decidable.em ((q' - const (padic_norm p) (q' N)) ≈ 0) with heq hne',
       { simpa only [heq, padic_seq.norm, dif_pos] },
@@ -651,20 +562,19 @@ quotient.induction_on q $ λ q',
         { exact hN _ (lt_of_not_ge hle).le _ le_rfl } }
     end⟩
 
-variables {p : ℕ} [fact p.prime] (f : cau_seq _ (@padic_norm_e p _))
 open classical
 
-private lemma div_nat_pos (n : ℕ) : 0 < (1 / ((n + 1): ℚ)) :=
+private lemma div_nat_pos (n : ℕ) : 0 < 1 / (n + 1 : ℚ) :=
 div_pos zero_lt_one (by exact_mod_cast succ_pos _)
 
-/-- `lim_seq f`, for `f` a Cauchy sequence of `p`-adic numbers,
-is a sequence of rationals with the same limit point as `f`. -/
+/-- `lim_seq f`, for `f` a Cauchy sequence of `p`-adic numbers, is a sequence of rationals with the
+same limit point as `f`. -/
 def lim_seq : ℕ → ℚ := λ n, classical.some (rat_dense' (f n) (div_nat_pos n))
 
 lemma exi_rat_seq_conv {ε : ℚ} (hε : 0 < ε) :
-  ∃ N, ∀ i ≥ N, padic_norm_e (f i - ((lim_seq f) i : ℚ_[p])) < ε :=
+  ∃ N, ∀ i ≥ N, padic_norm_e (f i - (lim_seq f i : ℚ_[p])) < ε :=
 begin
-  refine (exists_nat_gt (1/ε)).imp (λ N hN i hi, _),
+  refine (exists_nat_gt (1 / ε)).imp (λ N hN i hi, _),
   have h := classical.some_spec (rat_dense' (f i) (div_nat_pos i)),
   refine lt_of_lt_of_le h ((div_le_iff' $ by exact_mod_cast succ_pos _).mpr _),
   rw right_distrib,
@@ -682,23 +592,23 @@ begin
   existsi max N N2,
   intros j hj,
   suffices :
-    padic_norm_e ((↑(lim_seq f j) - f (max N N2)) + (f (max N N2) - lim_seq f (max N N2))) < ε,
+    padic_norm_e ((lim_seq f j - f (max N N2)) + (f (max N N2) - lim_seq f (max N N2))) < ε,
   { ring_nf at this ⊢,
-    rw [← padic_norm_e.eq_padic_norm', ← padic.cast_eq_of_rat],
+    rw [← padic_norm_e.eq_padic_norm'],
     exact_mod_cast this },
   { apply lt_of_le_of_lt,
-    { apply padic_norm_e.add },
+    { apply padic_norm_e.add_le },
     { have : (3 : ℚ) ≠ 0, by norm_num,
       have : ε = ε / 3 + ε / 3 + ε / 3,
       { field_simp [this], simp only [bit0, bit1, mul_add, mul_one] },
       rw this,
       apply add_lt_add,
-      { suffices : padic_norm_e ((↑(lim_seq f j) - f j) + (f j - f (max N N2))) < ε / 3 + ε / 3,
+      { suffices : padic_norm_e ((lim_seq f j - f j) + (f j - f (max N N2))) < ε / 3 + ε / 3,
           by simpa only [sub_add_sub_cancel],
         apply lt_of_le_of_lt,
-        { apply padic_norm_e.add },
+        { apply padic_norm_e.add_le },
         { apply add_lt_add,
-          { rw [padic_norm_e.sub_rev],
+          { rw [padic_norm_e.map_sub],
             apply_mod_cast hN,
             exact le_of_max_le_left hj },
           { exact hN2 _ (le_of_max_le_right hj) _ (le_max_right _ _) } } },
@@ -713,22 +623,17 @@ private def lim : ℚ_[p] := ⟦lim' f⟧
 theorem complete' : ∃ q : ℚ_[p], ∀ ε > 0, ∃ N, ∀ i ≥ N, padic_norm_e (q - f i) < ε :=
 ⟨ lim f,
   λ ε hε,
-  let ⟨N, hN⟩ := exi_rat_seq_conv f (show 0 < ε / 2, from div_pos hε (by norm_num)),
-      ⟨N2, hN2⟩ := padic_norm_e.defn (lim' f) (show 0 < ε / 2, from div_pos hε (by norm_num)) in
   begin
-    existsi max N N2,
-    intros i hi,
-    suffices : padic_norm_e ((lim f - lim' f i) + (lim' f i - f i)) < ε,
-    { ring_nf at this; exact this },
-    { apply lt_of_le_of_lt,
-      { apply padic_norm_e.add },
-      { have : ε = ε / 2 + ε / 2, by rw ←(add_self_div_two ε); simp,
-        rw this,
-        apply add_lt_add,
-        { apply hN2, exact le_of_max_le_right hi },
-        { rw_mod_cast [padic_norm_e.sub_rev],
-          apply hN,
-          exact le_of_max_le_left hi }}}
+    obtain ⟨N, hN⟩ := exi_rat_seq_conv f (half_pos hε),
+    obtain ⟨N2, hN2⟩ := padic_norm_e.defn (lim' f) (half_pos hε),
+    refine ⟨max N N2, λ i hi, _⟩,
+    rw ←sub_add_sub_cancel _ (lim' f i : ℚ_[p]) _,
+    refine (padic_norm_e.add_le _ _).trans_lt _,
+    rw ←add_halves ε,
+    apply add_lt_add,
+    { apply hN2 _ (le_of_max_le_right hi) },
+    { rw [padic_norm_e.map_sub],
+      exact hN _ (le_of_max_le_left hi) }
   end ⟩
 
 end complete
@@ -740,17 +645,18 @@ instance : has_dist ℚ_[p] := ⟨λ x y, padic_norm_e (x - y)⟩
 
 instance : metric_space ℚ_[p] :=
 { dist_self := by simp [dist],
-  dist_comm := λ x y, by unfold dist; rw ←padic_norm_e.neg (x - y); simp,
-  dist_triangle :=
-    begin
-      intros, unfold dist,
-      exact_mod_cast padic_norm_e.triangle_ineq _ _ _,
-    end,
+  dist := dist,
+  dist_comm := λ x y, by simp [dist, ←padic_norm_e.map_neg (x - y)],
+  dist_triangle := λ x y z,
+  begin
+    unfold dist,
+    exact_mod_cast padic_norm_e.sub_le _ _ _,
+  end,
   eq_of_dist_eq_zero :=
     begin
       unfold dist, intros _ _ h,
       apply eq_of_sub_eq_zero,
-      apply (padic_norm_e.zero_iff _).1,
+      apply padic_norm_e.eq_zero.1,
       exact_mod_cast h
     end }
 
@@ -758,16 +664,16 @@ instance : has_norm ℚ_[p] := ⟨λ x, padic_norm_e x⟩
 
 instance : normed_field ℚ_[p] :=
 { dist_eq := λ _ _, rfl,
-  norm_mul' := by simp [has_norm.norm, padic_norm_e.mul'] }
+  norm_mul' := by simp [has_norm.norm, map_mul],
+  norm := norm, .. padic.field, .. padic.metric_space p }
 
-instance is_absolute_value : is_absolute_value (λ a : ℚ_[p], ∥a∥) :=
+instance is_absolute_value : is_absolute_value (λ a : ℚ_[p], ‖a‖) :=
 { abv_nonneg := norm_nonneg,
   abv_eq_zero := λ _, norm_eq_zero,
   abv_add := norm_add_le,
-  abv_mul := by simp [has_norm.norm, padic_norm_e.mul'] }
+  abv_mul := by simp [has_norm.norm, map_mul] }
 
-theorem rat_dense {p : ℕ} {hp : fact p.prime} (q : ℚ_[p]) {ε : ℝ} (hε : 0 < ε) :
-        ∃ r : ℚ, ∥q - r∥ < ε :=
+theorem rat_dense (q : ℚ_[p]) {ε : ℝ} (hε : 0 < ε) : ∃ r : ℚ, ‖q - r‖ < ε :=
 let ⟨ε', hε'l, hε'r⟩ := exists_rat_btwn hε,
     ⟨r, hr⟩ := rat_dense' q (by simpa using hε'l)  in
 ⟨r, lt_trans (by simpa [has_norm.norm] using hr) hε'r⟩
@@ -780,18 +686,18 @@ section normed_space
 variables {p : ℕ} [hp : fact p.prime]
 include hp
 
-@[simp] protected lemma mul (q r : ℚ_[p]) : ∥q * r∥ = ∥q∥ * ∥r∥ :=
-by simp [has_norm.norm, padic_norm_e.mul']
+@[simp] protected lemma mul (q r : ℚ_[p]) : ‖q * r‖ = ‖q‖ * ‖r‖ :=
+by simp [has_norm.norm, map_mul]
 
-protected lemma is_norm (q : ℚ_[p]) : ↑(padic_norm_e q) = ∥q∥ := rfl
+protected lemma is_norm (q : ℚ_[p]) : ↑(padic_norm_e q) = ‖q‖ := rfl
 
-theorem nonarchimedean (q r : ℚ_[p]) : ∥q + r∥ ≤ max (∥q∥) (∥r∥) :=
+theorem nonarchimedean (q r : ℚ_[p]) : ‖q + r‖ ≤ max (‖q‖) (‖r‖) :=
 begin
   unfold has_norm.norm,
   exact_mod_cast nonarchimedean' _ _
 end
 
-theorem add_eq_max_of_ne {q r : ℚ_[p]} (h : ∥q∥ ≠ ∥r∥) : ∥q+r∥ = max (∥q∥) (∥r∥) :=
+theorem add_eq_max_of_ne {q r : ℚ_[p]} (h : ‖q‖ ≠ ‖r‖) : ‖q + r‖ = max (‖q‖) (‖r‖) :=
 begin
   unfold has_norm.norm,
   apply_mod_cast add_eq_max_of_ne',
@@ -801,54 +707,58 @@ begin
   exact_mod_cast h'
 end
 
-@[simp] lemma eq_padic_norm (q : ℚ) : ∥(↑q : ℚ_[p])∥ = padic_norm p q :=
+@[simp] lemma eq_padic_norm (q : ℚ) : ‖(q : ℚ_[p])‖ = padic_norm p q :=
 begin
   unfold has_norm.norm,
-  rw [← padic_norm_e.eq_padic_norm', ← padic.cast_eq_of_rat]
+  rw [← padic_norm_e.eq_padic_norm']
 end
 
-@[simp] lemma norm_p : ∥(p : ℚ_[p])∥ = p⁻¹ :=
+@[simp] lemma norm_p : ‖(p : ℚ_[p])‖ = p⁻¹ :=
 begin
   have p₀ : p ≠ 0 := hp.1.ne_zero,
   have p₁ : p ≠ 1 := hp.1.ne_one,
-  simp [p₀, p₁, norm, padic_norm, padic_val_rat, padic_val_int, zpow_neg,
-    padic.cast_eq_of_rat_of_nat],
+  rw ← @rat.cast_coe_nat ℝ _ p,
+  rw ← @rat.cast_coe_nat (ℚ_[p]) _ p,
+  simp [p₀, p₁, norm, padic_norm, padic_val_rat, padic_val_int, zpow_neg, -rat.cast_coe_nat],
 end
 
-lemma norm_p_lt_one : ∥(p : ℚ_[p])∥ < 1 :=
+lemma norm_p_lt_one : ‖(p : ℚ_[p])‖ < 1 :=
 begin
   rw norm_p,
   apply inv_lt_one,
   exact_mod_cast hp.1.one_lt
 end
 
-@[simp] lemma norm_p_pow (n : ℤ) : ∥(p^n : ℚ_[p])∥ = p^-n :=
-by rw [norm_zpow, norm_p]; field_simp
+@[simp] lemma norm_p_zpow (n : ℤ) : ‖(p ^ n : ℚ_[p])‖ = p ^ -n :=
+by rw [norm_zpow, norm_p, zpow_neg, inv_zpow]
+
+@[simp] lemma norm_p_pow (n : ℕ) : ‖(p ^ n : ℚ_[p])‖ = p ^ (-n : ℤ) :=
+by rw [←norm_p_zpow, zpow_coe_nat]
 
-instance : nondiscrete_normed_field ℚ_[p] :=
+instance : nontrivially_normed_field ℚ_[p] :=
 { non_trivial := ⟨p⁻¹, begin
     rw [norm_inv, norm_p, inv_inv],
     exact_mod_cast hp.1.one_lt
-  end⟩ }
+  end⟩,
+  .. padic.normed_field p }
 
-protected theorem image {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, ∥q∥ = ↑((↑p : ℚ) ^ (-n)) :=
+protected theorem image {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, ‖q‖ = ↑((p : ℚ) ^ -n) :=
 quotient.induction_on q $ λ f hf,
   have ¬ f ≈ 0, from (padic_seq.ne_zero_iff_nequiv_zero f).1 hf,
   let ⟨n, hn⟩ := padic_seq.norm_values_discrete f this in
   ⟨n, congr_arg coe hn⟩
 
-protected lemma is_rat (q : ℚ_[p]) : ∃ q' : ℚ, ∥q∥ = ↑q' :=
-if h : q = 0 then ⟨0, by simp [h]⟩
-else let ⟨n, hn⟩ := padic_norm_e.image h in ⟨_, hn⟩
+protected lemma is_rat (q : ℚ_[p]) : ∃ q' : ℚ, ‖q‖ = q' :=
+if h : q = 0 then ⟨0, by simp [h]⟩ else let ⟨n, hn⟩ := padic_norm_e.image h in ⟨_, hn⟩
 
 /--`rat_norm q`, for a `p`-adic number `q` is the `p`-adic norm of `q`, as rational number.
 
-The lemma `padic_norm_e.eq_rat_norm` asserts `∥q∥ = rat_norm q`. -/
+The lemma `padic_norm_e.eq_rat_norm` asserts `‖q‖ = rat_norm q`. -/
 def rat_norm (q : ℚ_[p]) : ℚ := classical.some (padic_norm_e.is_rat q)
 
-lemma eq_rat_norm (q : ℚ_[p]) : ∥q∥ = rat_norm q := classical.some_spec (padic_norm_e.is_rat q)
+lemma eq_rat_norm (q : ℚ_[p]) : ‖q‖ = rat_norm q := classical.some_spec (padic_norm_e.is_rat q)
 
-theorem norm_rat_le_one : ∀ {q : ℚ} (hq : ¬ p ∣ q.denom), ∥(q : ℚ_[p])∥ ≤ 1
+theorem norm_rat_le_one : ∀ {q : ℚ} (hq : ¬ p ∣ q.denom), ‖(q : ℚ_[p])‖ ≤ 1
 | ⟨n, d, hn, hd⟩ := λ hq : ¬ p ∣ d,
   if hnz : n = 0 then
     have (⟨n, d, hn, hd⟩ : ℚ) = 0,
@@ -860,28 +770,27 @@ theorem norm_rat_le_one : ∀ {q : ℚ} (hq : ¬ p ∣ q.denom), ∥(q : ℚ_[p]
         from mt rat.zero_iff_num_zero.1 hnz,
       rw [padic_norm_e.eq_padic_norm],
       norm_cast,
-      rw [padic_norm.eq_zpow_of_nonzero p hnz', padic_val_rat, neg_sub,
+      rw [padic_norm.eq_zpow_of_nonzero hnz', padic_val_rat, neg_sub,
         padic_val_nat.eq_zero_of_not_dvd hq],
       norm_cast,
-      rw [zero_sub, zpow_neg₀, zpow_coe_nat],
+      rw [zero_sub, zpow_neg, zpow_coe_nat],
       apply inv_le_one,
       { norm_cast,
         apply one_le_pow,
-        exact hp.1.pos, },
+        exact hp.1.pos }
     end
 
-theorem norm_int_le_one (z : ℤ) : ∥(z : ℚ_[p])∥ ≤ 1 :=
-suffices ∥((z : ℚ) : ℚ_[p])∥ ≤ 1, by simpa,
-norm_rat_le_one $ by simp [hp.1.ne_one]
+theorem norm_int_le_one (z : ℤ) : ‖(z : ℚ_[p])‖ ≤ 1 :=
+suffices ‖((z : ℚ) : ℚ_[p])‖ ≤ 1, by simpa, norm_rat_le_one $ by simp [hp.1.ne_one]
 
-lemma norm_int_lt_one_iff_dvd (k : ℤ) : ∥(k : ℚ_[p])∥ < 1 ↔ ↑p ∣ k :=
+lemma norm_int_lt_one_iff_dvd (k : ℤ) : ‖(k : ℚ_[p])‖ < 1 ↔ ↑p ∣ k :=
 begin
   split,
   { intro h,
     contrapose! h,
     apply le_of_eq,
     rw eq_comm,
-    calc ∥(k : ℚ_[p])∥ = ∥((k : ℚ) : ℚ_[p])∥ : by { norm_cast }
+    calc ‖(k : ℚ_[p])‖ = ‖((k : ℚ) : ℚ_[p])‖ : by { norm_cast }
     ... = padic_norm p k : padic_norm_e.eq_padic_norm _
     ... = 1 : _,
     rw padic_norm,
@@ -895,33 +804,31 @@ begin
       convert zpow_zero _,
       rw [neg_eq_zero, padic_val_rat.of_int],
       norm_cast,
-      apply padic_val_int.eq_zero_of_not_dvd h, } },
+      apply padic_val_int.eq_zero_of_not_dvd h } },
   { rintro ⟨x, rfl⟩,
     push_cast,
     rw padic_norm_e.mul,
-    calc _ ≤ ∥(p : ℚ_[p])∥ * 1 : mul_le_mul le_rfl (by simpa using norm_int_le_one _)
+    calc _ ≤ ‖(p : ℚ_[p])‖ * 1 : mul_le_mul le_rfl (by simpa using norm_int_le_one _)
                                             (norm_nonneg _) (norm_nonneg _)
     ... < 1 : _,
     { rw [mul_one, padic_norm_e.norm_p],
       apply inv_lt_one,
-      exact_mod_cast hp.1.one_lt }, },
+      exact_mod_cast hp.1.one_lt } }
 end
 
-lemma norm_int_le_pow_iff_dvd (k : ℤ) (n : ℕ) : ∥(k : ℚ_[p])∥ ≤ ((↑p)^(-n : ℤ)) ↔ ↑(p^n) ∣ k :=
+lemma norm_int_le_pow_iff_dvd (k : ℤ) (n : ℕ) : ‖(k : ℚ_[p])‖ ≤ ↑p ^ (-n : ℤ) ↔ ↑(p ^ n) ∣ k :=
 begin
-  have : (p : ℝ) ^ (-n : ℤ) = ↑((p ^ (-n : ℤ) : ℚ)), {simp},
+  have : (p : ℝ) ^ (-n : ℤ) = ↑(p ^ (-n : ℤ) : ℚ), {simp},
   rw [show (k : ℚ_[p]) = ((k : ℚ) : ℚ_[p]), by norm_cast, eq_padic_norm, this],
   norm_cast,
-  rw padic_norm.dvd_iff_norm_le,
+  rw ← padic_norm.dvd_iff_norm_le
 end
 
-lemma eq_of_norm_add_lt_right {p : ℕ} {hp : fact p.prime} {z1 z2 : ℚ_[p]}
-  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
+lemma eq_of_norm_add_lt_right {z1 z2 : ℚ_[p]} (h : ‖z1 + z2‖ < ‖z2‖) : ‖z1‖ = ‖z2‖ :=
 by_contradiction $ λ hne,
   not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_right) h
 
-lemma eq_of_norm_add_lt_left {p : ℕ} {hp : fact p.prime} {z1 z2 : ℚ_[p]}
-  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
+lemma eq_of_norm_add_lt_left {z1 z2 : ℚ_[p]} (h : ‖z1 + z2‖ < ‖z1‖) : ‖z1‖ = ‖z2‖ :=
 by_contradiction $ λ hne,
   not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_left) h
 
@@ -929,8 +836,8 @@ end normed_space
 end padic_norm_e
 
 namespace padic
-variables {p : ℕ} [hp_prime : fact p.prime]
-include hp_prime
+variables {p : ℕ} [hp : fact p.prime]
+include hp
 
 set_option eqn_compiler.zeta true
 instance complete : cau_seq.is_complete ℚ_[p] norm :=
@@ -949,16 +856,16 @@ begin
   cases hq ε' hε'.1 with N hN, existsi N,
   intros i hi, let h := hN i hi,
   unfold norm,
-  rw_mod_cast [cau_seq.sub_apply, padic_norm_e.sub_rev],
+  rw_mod_cast [padic_norm_e.map_sub],
   refine lt_trans _ hε'.2,
   exact_mod_cast hN i hi
 end
 
-lemma padic_norm_e_lim_le {f : cau_seq ℚ_[p] norm} {a : ℝ} (ha : 0 < a)
-      (hf : ∀ i, ∥f i∥ ≤ a) : ∥f.lim∥ ≤ a :=
+lemma padic_norm_e_lim_le {f : cau_seq ℚ_[p] norm} {a : ℝ} (ha : 0 < a) (hf : ∀ i, ‖f i‖ ≤ a) :
+  ‖f.lim‖ ≤ a :=
 let ⟨N, hN⟩ := setoid.symm (cau_seq.equiv_lim f) _ ha in
-calc ∥f.lim∥ = ∥f.lim - f N + f N∥ : by simp
-                ... ≤ max (∥f.lim - f N∥) (∥f N∥) : padic_norm_e.nonarchimedean _ _
+calc ‖f.lim‖ = ‖f.lim - f N + f N‖ : by simp
+                ... ≤ max (‖f.lim - f N‖) (‖f N‖) : padic_norm_e.nonarchimedean _ _
                 ... ≤ a : max_le (le_of_lt (hN _ le_rfl)) (hf _)
 
 open filter set
@@ -975,26 +882,20 @@ begin
   exact this.imp (λ N hN n hn, hε (hN n hn))
 end
 
-/-!
-### Valuation on `ℚ_[p]`
--/
+/-! ### Valuation on `ℚ_[p]` -/
 
-/--
-`padic.valuation` lifts the p-adic valuation on rationals to `ℚ_[p]`.
--/
-def valuation : ℚ_[p] → ℤ :=
-quotient.lift (@padic_seq.valuation p _) (λ f g h,
+/-- `padic.valuation` lifts the `p`-adic valuation on rationals to `ℚ_[p]`. -/
+def valuation : ℚ_[p] → ℤ := quotient.lift (@padic_seq.valuation p _) (λ f g h,
 begin
   by_cases hf : f ≈ 0,
   { have hg : g ≈ 0, from setoid.trans (setoid.symm h) hf,
     simp [hf, hg, padic_seq.valuation] },
   { have hg : ¬ g ≈ 0, from (λ hg, hf (setoid.trans h hg)),
     rw padic_seq.val_eq_iff_norm_eq hf hg,
-    exact padic_seq.norm_equiv h },
+    exact padic_seq.norm_equiv h }
 end)
 
-@[simp] lemma valuation_zero : valuation (0 : ℚ_[p]) = 0 :=
-dif_pos ((const_equiv p).2 rfl)
+@[simp] lemma valuation_zero : valuation (0 : ℚ_[p]) = 0 := dif_pos ((const_equiv p).2 rfl)
 
 @[simp] lemma valuation_one : valuation (1 : ℚ_[p]) = 0 :=
 begin
@@ -1002,34 +903,29 @@ begin
   have h : ¬ cau_seq.const (padic_norm p) 1 ≈ 0,
   { assume H, erw const_equiv p at H, exact one_ne_zero H },
   rw dif_neg h,
-  simp,
+  simp
 end
 
-lemma norm_eq_pow_val {x : ℚ_[p]} : x ≠ 0 → ∥x∥ = p^(-x.valuation) :=
+lemma norm_eq_pow_val {x : ℚ_[p]} : x ≠ 0 → ‖x‖ = p ^ -x.valuation :=
 begin
   apply quotient.induction_on' x, clear x,
   intros f hf,
   change (padic_seq.norm _ : ℝ) = (p : ℝ) ^ -padic_seq.valuation _,
   rw padic_seq.norm_eq_pow_val,
   change ↑((p : ℚ) ^ -padic_seq.valuation f) = (p : ℝ) ^ -padic_seq.valuation f,
-  { rw rat.cast_zpow,
-    congr' 1,
-    norm_cast },
+  { rw [rat.cast_zpow, rat.cast_coe_nat] },
   { apply cau_seq.not_lim_zero_of_not_congr_zero,
     contrapose! hf,
     apply quotient.sound,
-    simpa using hf, }
+    simpa using hf }
 end
 
 @[simp] lemma valuation_p : valuation (p : ℚ_[p]) = 1 :=
 begin
   have h : (1 : ℝ) < p := by exact_mod_cast (fact.out p.prime).one_lt,
-  rw ← neg_inj,
-  apply (zpow_strict_mono h).injective,
-  dsimp only,
-  rw ← norm_eq_pow_val,
-  { simp },
-  { exact_mod_cast (fact.out p.prime).ne_zero }
+  refine neg_injective ((zpow_strict_mono h).injective $ (norm_eq_pow_val _).symm.trans _),
+  { exact_mod_cast (fact.out p.prime).ne_zero },
+  { simp }
 end
 
 lemma valuation_map_add {x y : ℚ_[p]} (hxy : x + y ≠ 0) :
@@ -1041,39 +937,37 @@ begin
   { by_cases hy : y = 0,
     { rw [hy, add_zero],
       exact min_le_left _ _ },
-    { have h_norm : ∥x + y∥ ≤ (max ∥x∥ ∥y∥) := padic_norm_e.nonarchimedean x y,
+    { have h_norm : ‖x + y‖ ≤ (max ‖x‖ ‖y‖) := padic_norm_e.nonarchimedean x y,
       have hp_one : (1 : ℝ) < p,
       { rw [← nat.cast_one, nat.cast_lt],
-        exact nat.prime.one_lt hp_prime.elim, },
-      rw [norm_eq_pow_val hx, norm_eq_pow_val hy, norm_eq_pow_val hxy] at h_norm,
-      exact min_le_of_zpow_le_max hp_one h_norm }}
+        exact nat.prime.one_lt hp.elim },
+      rwa [norm_eq_pow_val hx, norm_eq_pow_val hy, norm_eq_pow_val hxy,
+        zpow_le_max_iff_min_le hp_one] at h_norm } }
 end
 
 @[simp] lemma valuation_map_mul {x y : ℚ_[p]} (hx : x ≠ 0) (hy : y ≠ 0) :
   valuation (x * y) = valuation x + valuation y :=
 begin
-  have h_norm : ∥x * y∥ = ∥x∥ * ∥y∥ := norm_mul x y,
+  have h_norm : ‖x * y‖ = ‖x‖ * ‖y‖ := norm_mul x y,
   have hp_ne_one : (p : ℝ) ≠ 1,
   { rw [← nat.cast_one, ne.def, nat.cast_inj],
-    exact nat.prime.ne_one hp_prime.elim, },
+    exact nat.prime.ne_one hp.elim },
   have hp_pos : (0 : ℝ) < p,
   { rw [← nat.cast_zero, nat.cast_lt],
-    exact nat.prime.pos hp_prime.elim },
+    exact nat.prime.pos hp.elim },
   rw [norm_eq_pow_val hx, norm_eq_pow_val hy, norm_eq_pow_val (mul_ne_zero hx hy),
     ← zpow_add₀ (ne_of_gt hp_pos), zpow_inj hp_pos hp_ne_one, ← neg_add, neg_inj] at h_norm,
-  exact h_norm,
+  exact h_norm
 end
 
-/-- The additive p-adic valuation on `ℚ_p`, with values in `with_top ℤ`. -/
-def add_valuation_def : ℚ_[p] → (with_top ℤ) :=
-λ x, if x = 0 then ⊤ else x.valuation
+/-- The additive `p`-adic valuation on `ℚ_[p]`, with values in `with_top ℤ`. -/
+def add_valuation_def : ℚ_[p] → with_top ℤ := λ x, if x = 0 then ⊤ else x.valuation
 
 @[simp] lemma add_valuation.map_zero : add_valuation_def (0 : ℚ_[p]) = ⊤ :=
 by simp only [add_valuation_def, if_pos (eq.refl _)]
 
 @[simp] lemma add_valuation.map_one : add_valuation_def (1 : ℚ_[p]) = 0 :=
-by simp only [add_valuation_def, if_neg (one_ne_zero), valuation_one,
-  with_top.coe_zero]
+by simp only [add_valuation_def, if_neg one_ne_zero, valuation_one, with_top.coe_zero]
 
 lemma add_valuation.map_mul (x y : ℚ_[p]) :
   add_valuation_def (x * y) = add_valuation_def x + add_valuation_def y :=
@@ -1093,41 +987,48 @@ begin
   simp only [add_valuation_def],
   by_cases hxy : x + y = 0,
   { rw [hxy, if_pos (eq.refl _)],
-    exact le_top, },
+    exact le_top },
   { by_cases hx : x = 0,
     { simp only [hx, if_pos (eq.refl _), min_eq_right, le_top, zero_add, le_refl] },
     { by_cases hy : y = 0,
-      { simp only [hy, if_pos (eq.refl _), min_eq_left, le_top, add_zero, le_refl], },
+      { simp only [hy, if_pos (eq.refl _), min_eq_left, le_top, add_zero, le_refl] },
       { rw [if_neg hx, if_neg hy, if_neg hxy, ← with_top.coe_min, with_top.coe_le_coe],
         exact valuation_map_add hxy }}}
 end
 
-/-- The additive `p`-adic valuation on `ℚ_p`, as an `add_valuation`. -/
+/-- The additive `p`-adic valuation on `ℚ_[p]`, as an `add_valuation`. -/
 def add_valuation : add_valuation ℚ_[p] (with_top ℤ) :=
 add_valuation.of add_valuation_def add_valuation.map_zero add_valuation.map_one
   add_valuation.map_add add_valuation.map_mul
 
-@[simp] lemma add_valuation.apply {x : ℚ_[p]} (hx : x ≠ 0) :
-  x.add_valuation = x.valuation :=
+@[simp] lemma add_valuation.apply {x : ℚ_[p]} (hx : x ≠ 0) : x.add_valuation = x.valuation :=
 by simp only [add_valuation, add_valuation.of_apply, add_valuation_def, if_neg hx]
 
 section norm_le_iff
+
 /-! ### Various characterizations of open unit balls -/
-lemma norm_le_pow_iff_norm_lt_pow_add_one (x : ℚ_[p]) (n : ℤ) :
-  ∥x∥ ≤ p ^ n ↔ ∥x∥ < p ^ (n + 1) :=
+
+lemma norm_le_pow_iff_norm_lt_pow_add_one (x : ℚ_[p]) (n : ℤ) : ‖x‖ ≤ p ^ n ↔ ‖x‖ < p ^ (n + 1) :=
 begin
   have aux : ∀ n : ℤ, 0 < (p ^ n : ℝ),
-  { apply nat.zpow_pos_of_pos, exact hp_prime.1.pos },
-  by_cases hx0 : x = 0, { simp [hx0, norm_zero, aux, le_of_lt (aux _)], },
+  { apply nat.zpow_pos_of_pos, exact hp.1.pos },
+  by_cases hx0 : x = 0, { simp [hx0, norm_zero, aux, le_of_lt (aux _)] },
   rw norm_eq_pow_val hx0,
-  have h1p : 1 < (p : ℝ), { exact_mod_cast hp_prime.1.one_lt },
+  have h1p : 1 < (p : ℝ), { exact_mod_cast hp.1.one_lt },
   have H := zpow_strict_mono h1p,
-  rw [H.le_iff_le, H.lt_iff_lt, int.lt_add_one_iff],
+  rw [H.le_iff_le, H.lt_iff_lt, int.lt_add_one_iff]
 end
 
-lemma norm_lt_pow_iff_norm_le_pow_sub_one (x : ℚ_[p]) (n : ℤ) :
-  ∥x∥ < p ^ n ↔ ∥x∥ ≤ p ^ (n - 1) :=
+lemma norm_lt_pow_iff_norm_le_pow_sub_one (x : ℚ_[p]) (n : ℤ) : ‖x‖ < p ^ n ↔ ‖x‖ ≤ p ^ (n - 1) :=
 by rw [norm_le_pow_iff_norm_lt_pow_add_one, sub_add_cancel]
 
+lemma norm_le_one_iff_val_nonneg (x : ℚ_[p]) : ‖ x ‖ ≤ 1 ↔ 0 ≤ x.valuation :=
+begin
+  by_cases hx : x = 0,
+  { simp only [hx, norm_zero, valuation_zero, zero_le_one, le_refl], },
+  { rw [norm_eq_pow_val hx, ← zpow_zero (p : ℝ), zpow_le_iff_le, right.neg_nonpos_iff],
+    exact nat.one_lt_cast.2 (nat.prime.one_lt' p).1 }
+end
+
 end norm_le_iff
 end padic
diff --git a/src/number_theory/padics/padic_val.lean b/src/number_theory/padics/padic_val.lean
index 80fd6b1f19230..f6689bb034751 100644
--- a/src/number_theory/padics/padic_val.lean
+++ b/src/number_theory/padics/padic_val.lean
@@ -3,24 +3,23 @@ Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-import algebra.order.absolute_value
-import algebra.field_power
+import number_theory.divisors
 import ring_theory.int.basic
-import tactic.basic
 import tactic.ring_exp
-import number_theory.divisors
-import data.nat.factorization
 
 /-!
 # p-adic Valuation
 
-This file defines the p-adic valuation on ℕ, ℤ, and ℚ.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
+This file defines the `p`-adic valuation on `ℕ`, `ℤ`, and `ℚ`.
+
+The `p`-adic valuation on `ℚ` is the difference of the multiplicities of `p` in the numerator and
 denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
-assumptions on p. The p-adic valuations on ℕ and ℤ agree with that on ℚ.
+assumptions on `p`. The `p`-adic valuations on `ℕ` and `ℤ` agree with that on `ℚ`.
 
-The valuation induces a norm on ℚ. This norm is defined in padic_norm.lean.
+The valuation induces a norm on `ℚ`. This norm is defined in padic_norm.lean.
 
 ## Notations
 
@@ -29,7 +28,7 @@ This file uses the local notation `/.` for `rat.mk`.
 ## Implementation notes
 
 Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
-by taking `[fact (prime p)]` as a type class argument.
+by taking `[fact p.prime]` as a type class argument.
 
 ## References
 
@@ -50,261 +49,232 @@ open_locale rat
 
 open multiplicity
 
-/--
-For `p ≠ 1`, the p-adic valuation of a natural `n ≠ 0` is the largest natural number `k` such that
-p^k divides z.
-If `n = 0` or `p = 1`, then `padic_val_nat p q` defaults to 0.
--/
+/-- For `p ≠ 1`, the `p`-adic valuation of a natural `n ≠ 0` is the largest natural number `k` such
+that `p^k` divides `z`. If `n = 0` or `p = 1`, then `padic_val_nat p q` defaults to `0`. -/
 def padic_val_nat (p : ℕ) (n : ℕ) : ℕ :=
-if h : p ≠ 1 ∧ 0 < n
-then (multiplicity p n).get (multiplicity.finite_nat_iff.2 h)
-else 0
+if h : p ≠ 1 ∧ 0 < n then (multiplicity p n).get (multiplicity.finite_nat_iff.2 h) else 0
 
 namespace padic_val_nat
+
 open multiplicity
+
 variables {p : ℕ}
 
-/-- `padic_val_nat p 0` is 0 for any `p`. -/
-@[simp] protected lemma zero : padic_val_nat p 0 = 0 :=
-by simp [padic_val_nat]
+/-- `padic_val_nat p 0` is `0` for any `p`. -/
+@[simp] protected lemma zero : padic_val_nat p 0 = 0 := by simp [padic_val_nat]
 
-/-- `padic_val_nat p 1` is 0 for any `p`. -/
-@[simp] protected lemma one : padic_val_nat p 1 = 0 :=
-by unfold padic_val_nat; split_ifs; simp *
+/-- `padic_val_nat p 1` is `0` for any `p`. -/
+@[simp] protected lemma one : padic_val_nat p 1 = 0 := by { unfold padic_val_nat, split_ifs, simp }
 
-/-- For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1. -/
+/-- If `p ≠ 0` and `p ≠ 1`, then `padic_val_rat p p` is `1`. -/
 @[simp] lemma self (hp : 1 < p) : padic_val_nat p p = 1 :=
 begin
   have neq_one : (¬ p = 1) ↔ true,
-  { exact iff_of_true ((ne_of_lt hp).symm) trivial, },
-  have eq_zero_false : (p = 0) ↔ false,
+  { exact iff_of_true ((ne_of_lt hp).symm) trivial },
+  have eq_zero_false : p = 0 ↔ false,
   { exact iff_false_intro ((ne_of_lt (trans zero_lt_one hp)).symm) },
-  simp [padic_val_nat, neq_one, eq_zero_false],
+  simp [padic_val_nat, neq_one, eq_zero_false]
 end
 
+@[simp] lemma eq_zero_iff {n : ℕ} : padic_val_nat p n = 0 ↔ p = 1 ∨ n = 0 ∨ ¬ p ∣ n :=
+by simp only [padic_val_nat, dite_eq_right_iff, part_enat.get_eq_iff_eq_coe, nat.cast_zero,
+  multiplicity_eq_zero, and_imp, pos_iff_ne_zero, ne.def, ← or_iff_not_imp_left]
+
 lemma eq_zero_of_not_dvd {n : ℕ} (h : ¬ p ∣ n) : padic_val_nat p n = 0 :=
-begin
-  rw padic_val_nat,
-  split_ifs,
-  { simp [multiplicity_eq_zero_of_not_dvd h], },
-  refl,
-end
+eq_zero_iff.2 $ or.inr $ or.inr h
 
 end padic_val_nat
 
-/--
-For `p ≠ 1`, the p-adic valuation of an integer `z ≠ 0` is the largest natural number `k` such that
-p^k divides z.
-If `x = 0` or `p = 1`, then `padic_val_int p q` defaults to 0.
--/
-def padic_val_int (p : ℕ) (z : ℤ) : ℕ :=
-padic_val_nat p (z.nat_abs)
+/-- For `p ≠ 1`, the `p`-adic valuation of an integer `z ≠ 0` is the largest natural number `k` such
+that `p^k` divides `z`. If `x = 0` or `p = 1`, then `padic_val_int p q` defaults to `0`. -/
+def padic_val_int (p : ℕ) (z : ℤ) : ℕ := padic_val_nat p z.nat_abs
 
 namespace padic_val_int
+
 open multiplicity
+
 variables {p : ℕ}
 
 lemma of_ne_one_ne_zero {z : ℤ} (hp : p ≠ 1) (hz : z ≠ 0) : padic_val_int p z =
   (multiplicity (p : ℤ) z).get (by {apply multiplicity.finite_int_iff.2, simp [hp, hz]}) :=
 begin
   rw [padic_val_int, padic_val_nat, dif_pos (and.intro hp (int.nat_abs_pos_of_ne_zero hz))],
-  simp_rw multiplicity.int.nat_abs p z,
-  refl,
+  simp only [multiplicity.int.nat_abs p z],
+  refl
 end
 
-/-- `padic_val_int p 0` is 0 for any `p`. -/
-@[simp] protected lemma zero : padic_val_int p 0 = 0 :=
-by simp [padic_val_int]
+/-- `padic_val_int p 0` is `0` for any `p`. -/
+@[simp] protected lemma zero : padic_val_int p 0 = 0 := by simp [padic_val_int]
 
-/-- `padic_val_int p 1` is 0 for any `p`. -/
-@[simp] protected lemma one : padic_val_int p 1 = 0 :=
-by simp [padic_val_int]
+/-- `padic_val_int p 1` is `0` for any `p`. -/
+@[simp] protected lemma one : padic_val_int p 1 = 0 := by simp [padic_val_int]
 
-/-- The p-adic value of an natural is its p-adic_value as an integer -/
-@[simp] lemma of_nat {n : ℕ} : padic_val_int p (n : ℤ) = padic_val_nat p n :=
-by simp [padic_val_int]
+/-- The `p`-adic value of a natural is its `p`-adic value as an integer. -/
+@[simp] lemma of_nat {n : ℕ} : padic_val_int p n = padic_val_nat p n := by simp [padic_val_int]
 
-/-- For `p ≠ 0, p ≠ 1, `padic_val_int p p` is 1. -/
-lemma self (hp : 1 < p) : padic_val_int p p = 1 :=
-by simp [padic_val_nat.self hp]
+/-- If `p ≠ 0` and `p ≠ 1`, then `padic_val_int p p` is `1`. -/
+lemma self (hp : 1 < p) : padic_val_int p p = 1 := by simp [padic_val_nat.self hp]
 
 lemma eq_zero_of_not_dvd {z : ℤ} (h : ¬ (p : ℤ) ∣ z) : padic_val_int p z = 0 :=
 begin
   rw [padic_val_int, padic_val_nat],
-  split_ifs,
-  { simp_rw multiplicity.int.nat_abs,
-    simp [multiplicity_eq_zero_of_not_dvd h], },
-  refl,
+  split_ifs; simp [multiplicity.int.nat_abs, multiplicity_eq_zero.2 h],
 end
 
 end padic_val_int
 
-/--
-`padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
-valuation of `q.denom`.
-If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to 0.
--/
-def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
-padic_val_int p q.num - padic_val_nat p q.denom
+/-- `padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
+valuation of `q.denom`. If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to `0`. -/
+def padic_val_rat (p : ℕ) (q : ℚ) : ℤ := padic_val_int p q.num - padic_val_nat p q.denom
 
 namespace padic_val_rat
+
 open multiplicity
+
 variables {p : ℕ}
 
 /-- `padic_val_rat p q` is symmetric in `q`. -/
 @[simp] protected lemma neg (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q :=
 by simp [padic_val_rat, padic_val_int]
 
-/-- `padic_val_rat p 0` is 0 for any `p`. -/
-@[simp]
-protected lemma zero (m : nat) : padic_val_rat m 0 = 0 := by simp [padic_val_rat, padic_val_int]
+/-- `padic_val_rat p 0` is `0` for any `p`. -/
+@[simp] protected lemma zero : padic_val_rat p 0 = 0 := by simp [padic_val_rat]
 
-/-- `padic_val_rat p 1` is 0 for any `p`. -/
-@[simp] protected lemma one : padic_val_rat p 1 = 0 := by simp [padic_val_rat, padic_val_int]
+/-- `padic_val_rat p 1` is `0` for any `p`. -/
+@[simp] protected lemma one : padic_val_rat p 1 = 0 := by simp [padic_val_rat]
 
-/-- The p-adic value of an integer `z ≠ 0` is its p-adic_value as a rational -/
-@[simp] lemma of_int {z : ℤ} : padic_val_rat p (z : ℚ) = padic_val_int p z :=
-by simp [padic_val_rat]
+/-- The `p`-adic value of an integer `z ≠ 0` is its `p`-adic_value as a rational. -/
+@[simp] lemma of_int {z : ℤ} : padic_val_rat p z = padic_val_int p z := by simp [padic_val_rat]
 
-/-- The p-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`. -/
-lemma of_int_multiplicity (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) :
-  padic_val_rat p (z : ℚ) = (multiplicity (p : ℤ) z).get
-    (finite_int_iff.2 ⟨hp, hz⟩) :=
+/-- The `p`-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`. -/
+lemma of_int_multiplicity {z : ℤ} (hp : p ≠ 1) (hz : z ≠ 0) :
+  padic_val_rat p (z : ℚ) = (multiplicity (p : ℤ) z).get (finite_int_iff.2 ⟨hp, hz⟩) :=
 by rw [of_int, padic_val_int.of_ne_one_ne_zero hp hz]
 
-lemma multiplicity_sub_multiplicity {q : ℚ} (hp : p ≠ 1) (hq : q ≠ 0) :
-  padic_val_rat p q =
+lemma multiplicity_sub_multiplicity {q : ℚ} (hp : p ≠ 1) (hq : q ≠ 0) : padic_val_rat p q =
   (multiplicity (p : ℤ) q.num).get (finite_int_iff.2 ⟨hp, rat.num_ne_zero_of_ne_zero hq⟩) -
-  (multiplicity p q.denom).get
-    (by { rw [←finite_iff_dom, finite_nat_iff, and_iff_right hp], exact q.pos }) :=
+  (multiplicity p q.denom).get (by { rw [← finite_iff_dom, finite_nat_iff], exact ⟨hp, q.pos⟩ }) :=
 begin
   rw [padic_val_rat, padic_val_int.of_ne_one_ne_zero hp, padic_val_nat, dif_pos],
   { refl },
   { exact ⟨hp, q.pos⟩ },
-  { exact rat.num_ne_zero_of_ne_zero hq },
+  { exact rat.num_ne_zero_of_ne_zero hq }
 end
 
-/-- The p-adic value of an integer `z ≠ 0` is its p-adic_value as a rational -/
-@[simp] lemma of_nat {n : ℕ} : padic_val_rat p (n : ℚ) = padic_val_nat p n :=
-by simp [padic_val_rat, padic_val_int]
+/-- The `p`-adic value of an integer `z ≠ 0` is its `p`-adic value as a rational. -/
+@[simp] lemma of_nat {n : ℕ} : padic_val_rat p n = padic_val_nat p n := by simp [padic_val_rat]
 
-/-- For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1. -/
-lemma self (hp : 1 < p) : padic_val_rat p p = 1 := by simp [of_nat, hp]
+/-- If `p ≠ 0` and `p ≠ 1`, then `padic_val_rat p p` is `1`. -/
+lemma self (hp : 1 < p) : padic_val_rat p p = 1 := by simp [hp]
 
 end padic_val_rat
 
 section padic_val_nat
 
-lemma zero_le_padic_val_rat_of_nat (p n : ℕ) : 0 ≤ padic_val_rat p n := by simp
+variables {p : ℕ}
 
--- /-- `padic_val_rat` coincides with `padic_val_nat`. -/
-@[norm_cast] lemma padic_val_rat_of_nat (p n : ℕ) :
-  ↑(padic_val_nat p n) = padic_val_rat p n :=
-by simp [padic_val_rat, padic_val_int]
+lemma zero_le_padic_val_rat_of_nat (n : ℕ) : 0 ≤ padic_val_rat p n := by simp
 
-/--
-A simplification of `padic_val_nat` when one input is prime, by analogy with `padic_val_rat_def`.
--/
-lemma padic_val_nat_def {p : ℕ} [hp : fact p.prime] {n : ℕ} (hn : 0 < n) :
-  padic_val_nat p n =
-  (multiplicity p n).get
-    (multiplicity.finite_nat_iff.2 ⟨nat.prime.ne_one hp.1, hn⟩) :=
-begin
-  simp [padic_val_nat],
-  split_ifs,
-  { refl, },
-  { exfalso,
-    apply h ⟨(hp.out).ne_one, hn⟩, }
-end
+/-- `padic_val_rat` coincides with `padic_val_nat`. -/
+@[norm_cast] lemma padic_val_rat_of_nat (n : ℕ) : ↑(padic_val_nat p n) = padic_val_rat p n :=
+by simp
 
-@[simp] lemma padic_val_nat_self (p : ℕ) [fact p.prime] : padic_val_nat p p = 1 :=
+/-- A simplification of `padic_val_nat` when one input is prime, by analogy with
+`padic_val_rat_def`. -/
+lemma padic_val_nat_def [hp : fact p.prime] {n : ℕ} (hn : 0 < n) :
+  padic_val_nat p n
+    = (multiplicity p n).get (multiplicity.finite_nat_iff.2 ⟨hp.out.ne_one, hn⟩) :=
+dif_pos ⟨hp.out.ne_one, hn⟩
+
+lemma padic_val_nat_def' {n : ℕ} (hp : p ≠ 1) (hn : 0 < n) :
+  ↑(padic_val_nat p n) = multiplicity p n :=
+by simp [padic_val_nat, hp, hn]
+
+@[simp] lemma padic_val_nat_self [fact p.prime] : padic_val_nat p p = 1 :=
 by simp [padic_val_nat_def (fact.out p.prime).pos]
 
-lemma one_le_padic_val_nat_of_dvd
-  {n p : nat} [prime : fact p.prime] (n_pos : 0 < n) (div : p ∣ n) :
+lemma one_le_padic_val_nat_of_dvd {n : ℕ} [hp : fact p.prime] (hn : 0 < n) (div : p ∣ n) :
   1 ≤ padic_val_nat p n :=
-begin
-  rw @padic_val_nat_def _ prime _ n_pos,
-  let one_le_mul : _ ≤ multiplicity p n :=
-    @multiplicity.le_multiplicity_of_pow_dvd _ _ _ p n 1 (begin norm_num, exact div end),
-  simp only [nat.cast_one] at one_le_mul,
-  rcases one_le_mul with ⟨_, q⟩,
-  dsimp at q,
-  solve_by_elim,
-end
+by rwa [← part_enat.coe_le_coe, padic_val_nat_def' hp.out.ne_one hn, ← pow_dvd_iff_le_multiplicity,
+  pow_one]
+
+lemma dvd_iff_padic_val_nat_ne_zero {p n : ℕ} [fact p.prime] (hn0 : n ≠ 0) :
+  (p ∣ n) ↔ padic_val_nat p n ≠ 0 :=
+⟨λ h, one_le_iff_ne_zero.mp (one_le_padic_val_nat_of_dvd hn0.bot_lt h),
+ λ h, not_not.1 (mt padic_val_nat.eq_zero_of_not_dvd h)⟩
 
 end padic_val_nat
 
 namespace padic_val_rat
+
 open multiplicity
-variables (p : ℕ) [p_prime : fact p.prime]
-include p_prime
+
+variables {p : ℕ} [hp : fact p.prime]
+
+include hp
 
 /-- The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`. -/
-lemma finite_int_prime_iff {p : ℕ} [p_prime : fact p.prime] {a : ℤ} : finite (p : ℤ) a ↔ a ≠ 0 :=
-by simp [finite_int_iff, ne.symm (ne_of_lt (p_prime.1.one_lt))]
+lemma finite_int_prime_iff {a : ℤ} : finite (p : ℤ) a ↔ a ≠ 0 :=
+by simp [finite_int_iff, ne.symm (ne_of_lt hp.1.one_lt)]
 
 /-- A rewrite lemma for `padic_val_rat p q` when `q` is expressed in terms of `rat.mk`. -/
-protected lemma defn {q : ℚ} {n d : ℤ} (hqz : q ≠ 0) (qdf : q = n /. d) :
-  padic_val_rat p q = (multiplicity (p : ℤ) n).get (finite_int_iff.2
-    ⟨ne.symm $ ne_of_lt p_prime.1.one_lt, λ hn, by simp * at *⟩) -
-  (multiplicity (p : ℤ) d).get (finite_int_iff.2 ⟨ne.symm $ ne_of_lt p_prime.1.one_lt,
-    λ hd, by simp * at *⟩) :=
+protected lemma defn (p : ℕ) [hp : fact p.prime] {q : ℚ} {n d : ℤ} (hqz : q ≠ 0)
+  (qdf : q = n /. d) : padic_val_rat p q
+    = (multiplicity (p : ℤ) n).get
+      (finite_int_iff.2 ⟨ne.symm $ ne_of_lt hp.1.one_lt, λ hn, by simp * at *⟩)
+    - (multiplicity (p : ℤ) d).get
+      (finite_int_iff.2 ⟨ne.symm $ ne_of_lt hp.1.one_lt, λ hd, by simp * at *⟩) :=
 have hd : d ≠ 0, from rat.mk_denom_ne_zero_of_ne_zero hqz qdf,
 let ⟨c, hc1, hc2⟩ := rat.num_denom_mk hd qdf in
 begin
   rw [padic_val_rat.multiplicity_sub_multiplicity];
-  simp [hc1, hc2, multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1),
-    (ne.symm (ne_of_lt p_prime.1.one_lt)), hqz, pos_iff_ne_zero],
-  simp_rw [int.coe_nat_multiplicity p q.denom],
+  simp [hc1, hc2, multiplicity.mul' (nat.prime_iff_prime_int.1 hp.1),
+    ne.symm (ne_of_lt hp.1.one_lt), hqz, pos_iff_ne_zero, int.coe_nat_multiplicity p q.denom]
 end
 
 /-- A rewrite lemma for `padic_val_rat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
 protected lemma mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
   padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r :=
-have q*r = (q.num * r.num) /. (↑q.denom * ↑r.denom), by rw_mod_cast rat.mul_num_denom,
+have q * r = (q.num * r.num) /. (q.denom * r.denom), by rw_mod_cast rat.mul_num_denom,
 have hq' : q.num /. q.denom ≠ 0, by rw rat.num_denom; exact hq,
 have hr' : r.num /. r.denom ≠ 0, by rw rat.num_denom; exact hr,
-have hp' : _root_.prime (p : ℤ), from nat.prime_iff_prime_int.1 p_prime.1,
+have hp' : _root_.prime (p : ℤ), from nat.prime_iff_prime_int.1 hp.1,
 begin
   rw [padic_val_rat.defn p (mul_ne_zero hq hr) this],
-  conv_rhs { rw [←(@rat.num_denom q), padic_val_rat.defn p hq',
-    ←(@rat.num_denom r), padic_val_rat.defn p hr'] },
+  conv_rhs { rw [← @rat.num_denom q, padic_val_rat.defn p hq', ← @rat.num_denom r,
+    padic_val_rat.defn p hr'] },
   rw [multiplicity.mul' hp', multiplicity.mul' hp']; simp [add_comm, add_left_comm, sub_eq_add_neg]
 end
 
 /-- A rewrite lemma for `padic_val_rat p (q^k)` with condition `q ≠ 0`. -/
 protected lemma pow {q : ℚ} (hq : q ≠ 0) {k : ℕ} :
-    padic_val_rat p (q ^ k) = k * padic_val_rat p q :=
-by induction k; simp [*, padic_val_rat.mul _ hq (pow_ne_zero _ hq),
-  pow_succ, add_mul, add_comm]
+  padic_val_rat p (q ^ k) = k * padic_val_rat p q :=
+by induction k; simp [*, padic_val_rat.mul hq (pow_ne_zero _ hq), pow_succ, add_mul, add_comm]
 
-/--
-A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`.
--/
-protected lemma inv (q : ℚ) :
-  padic_val_rat p (q⁻¹) = -padic_val_rat p q :=
+/-- A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`. -/
+protected lemma inv (q : ℚ) : padic_val_rat p q⁻¹ = -padic_val_rat p q :=
 begin
   by_cases hq : q = 0,
-  { simp [hq], },
-  { rw [eq_neg_iff_add_eq_zero, ← padic_val_rat.mul p (inv_ne_zero hq) hq,
-      inv_mul_cancel hq, padic_val_rat.one] },
+  { simp [hq] },
+  { rw [eq_neg_iff_add_eq_zero, ← padic_val_rat.mul (inv_ne_zero hq) hq, inv_mul_cancel hq,
+      padic_val_rat.one],
+    exact hp },
 end
 
 /-- A rewrite lemma for `padic_val_rat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
 protected lemma div {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
   padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r :=
-by rw [div_eq_mul_inv, padic_val_rat.mul p hq (inv_ne_zero hr),
-    padic_val_rat.inv p r, sub_eq_add_neg]
+begin
+  rw [div_eq_mul_inv, padic_val_rat.mul hq (inv_ne_zero hr), padic_val_rat.inv r, sub_eq_add_neg],
+  all_goals { exact hp }
+end
 
-/--
-A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂),
-in terms of divisibility by `p^n`.
--/
+/-- A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂)`, in terms of
+divisibility by `p^n`. -/
 lemma padic_val_rat_le_padic_val_rat_iff {n₁ n₂ d₁ d₂ : ℤ}
   (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
   padic_val_rat p (n₁ /. d₁) ≤ padic_val_rat p (n₂ /. d₂) ↔
-  ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
+  ∀ n : ℕ, ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
 have hf1 : finite (p : ℤ) (n₁ * d₂),
   from finite_int_prime_iff.2 (mul_ne_zero hn₁ hd₂),
 have hf2 : finite (p : ℤ) (n₂ * d₁),
@@ -313,65 +283,55 @@ have hf2 : finite (p : ℤ) (n₂ * d₁),
   { to_lhs,
     rw [padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₁ hd₁) rfl,
       padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₂ hd₂) rfl,
-      sub_le_iff_le_add',
-      ← add_sub_assoc,
-      le_sub_iff_add_le],
+      sub_le_iff_le_add', ← add_sub_assoc, le_sub_iff_add_le],
     norm_cast,
-    rw [← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf1, add_comm,
-      ← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf2,
-      enat.get_le_get, multiplicity_le_multiplicity_iff] }
-
-/--
-Sufficient conditions to show that the p-adic valuation of `q` is less than or equal to the
-p-adic vlauation of `q + r`.
--/
-theorem le_padic_val_rat_add_of_le {q r : ℚ}
-  (hqr : q + r ≠ 0)
-  (h : padic_val_rat p q ≤ padic_val_rat p r) :
-  padic_val_rat p q ≤ padic_val_rat p (q + r) :=
+    rw [← multiplicity.mul' (nat.prime_iff_prime_int.1 hp.1) hf1, add_comm,
+      ← multiplicity.mul' (nat.prime_iff_prime_int.1 hp.1) hf2,
+      part_enat.get_le_get, multiplicity_le_multiplicity_iff] }
+
+/-- Sufficient conditions to show that the `p`-adic valuation of `q` is less than or equal to the
+`p`-adic valuation of `q + r`. -/
+theorem le_padic_val_rat_add_of_le {q r : ℚ} (hqr : q + r ≠ 0)
+  (h : padic_val_rat p q ≤ padic_val_rat p r) : padic_val_rat p q ≤ padic_val_rat p (q + r) :=
 if hq : q = 0 then by simpa [hq] using h else
 if hr : r = 0 then by simp [hr] else
 have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hq,
 have hqd : (q.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
 have hrn : r.num ≠ 0, from rat.num_ne_zero_of_ne_zero hr,
 have hrd : (r.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
-have hqreq : q + r = (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)),
+have hqreq : q + r = (q.num * r.denom + q.denom * r.num) /. (q.denom * r.denom),
   from rat.add_num_denom _ _,
-have hqrd : q.num * ↑(r.denom) + ↑(q.denom) * r.num ≠ 0,
+have hqrd : q.num * r.denom + q.denom * r.num ≠ 0,
   from rat.mk_num_ne_zero_of_ne_zero hqr hqreq,
 begin
-  conv_lhs { rw ←(@rat.num_denom q) },
-  rw [hqreq, padic_val_rat_le_padic_val_rat_iff p hqn hqrd hqd (mul_ne_zero hqd hrd),
+  conv_lhs { rw ← @rat.num_denom q },
+  rw [hqreq, padic_val_rat_le_padic_val_rat_iff hqn hqrd hqd (mul_ne_zero hqd hrd),
     ← multiplicity_le_multiplicity_iff, mul_left_comm,
-    multiplicity.mul (nat.prime_iff_prime_int.1 p_prime.1), add_mul],
-  rw [←(@rat.num_denom q), ←(@rat.num_denom r),
-    padic_val_rat_le_padic_val_rat_iff p hqn hrn hqd hrd, ← multiplicity_le_multiplicity_iff] at h,
-  calc _ ≤ min (multiplicity ↑p (q.num * ↑(r.denom) * ↑(q.denom)))
-    (multiplicity ↑p (↑(q.denom) * r.num * ↑(q.denom))) : (le_min
-    (by rw [@multiplicity.mul _ _ _ _ (_ * _) _ (nat.prime_iff_prime_int.1 p_prime.1), add_comm])
+    multiplicity.mul (nat.prime_iff_prime_int.1 hp.1), add_mul],
+  rw [← @rat.num_denom q, ← @rat.num_denom r, padic_val_rat_le_padic_val_rat_iff hqn hrn hqd hrd,
+    ← multiplicity_le_multiplicity_iff] at h,
+  calc _ ≤ min (multiplicity ↑p (q.num * ↑r.denom * ↑q.denom))
+    (multiplicity ↑p (↑q.denom * r.num * ↑q.denom)) : (le_min
+    (by rw [@multiplicity.mul _ _ _ _ (_ * _) _ (nat.prime_iff_prime_int.1 hp.1), add_comm])
     (by rw [mul_assoc, @multiplicity.mul _ _ _ _ (q.denom : ℤ)
-        (_ * _) (nat.prime_iff_prime_int.1 p_prime.1)];
-      exact add_le_add_left h _))
-    ... ≤ _ : min_le_multiplicity_add
+        (_ * _) (nat.prime_iff_prime_int.1 hp.1)]; exact add_le_add_left h _))
+    ... ≤ _ : min_le_multiplicity_add,
+  all_goals { exact hp }
 end
 
-/--
-The minimum of the valuations of `q` and `r` is less than or equal to the valuation of `q + r`.
--/
+/-- The minimum of the valuations of `q` and `r` is at most the valuation of `q + r`. -/
 theorem min_le_padic_val_rat_add {q r : ℚ} (hqr : q + r ≠ 0) :
   min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) :=
 (le_total (padic_val_rat p q) (padic_val_rat p r)).elim
-  (λ h, by rw [min_eq_left h]; exact le_padic_val_rat_add_of_le _ hqr h)
-  (λ h, by rw [min_eq_right h, add_comm]; exact le_padic_val_rat_add_of_le _
-    (by rwa add_comm) h)
+  (λ h, by rw [min_eq_left h]; exact le_padic_val_rat_add_of_le hqr h)
+  (λ h, by rw [min_eq_right h, add_comm]; exact le_padic_val_rat_add_of_le (by rwa add_comm) h)
 
 open_locale big_operators
 
-/-- A finite sum of rationals with positive p-adic valuation has positive p-adic valuation
-  (if the sum is non-zero). -/
-theorem sum_pos_of_pos {n : ℕ} {F : ℕ → ℚ}
-  (hF : ∀ i, i < n → 0 < padic_val_rat p (F i)) (hn0 : ∑ i in finset.range n, F i ≠ 0) :
-  0 < padic_val_rat p (∑ i in finset.range n, F i) :=
+/-- A finite sum of rationals with positive `p`-adic valuation has positive `p`-adic valuation
+(if the sum is non-zero). -/
+theorem sum_pos_of_pos {n : ℕ} {F : ℕ → ℚ} (hF : ∀ i, i < n → 0 < padic_val_rat p (F i))
+  (hn0 : ∑ i in finset.range n, F i ≠ 0) : 0 < padic_val_rat p (∑ i in finset.range n, F i) :=
 begin
   induction n with d hd,
   { exact false.elim (hn0 rfl) },
@@ -379,167 +339,110 @@ begin
     by_cases h : ∑ (x : ℕ) in finset.range d, F x = 0,
     { rw [h, zero_add],
       exact hF d (lt_add_one _) },
-    { refine lt_of_lt_of_le _ (min_le_padic_val_rat_add p hn0),
+    { refine lt_of_lt_of_le _ (min_le_padic_val_rat_add hn0),
       { refine lt_min (hd (λ i hi, _) h) (hF d (lt_add_one _)),
-        exact hF _ (lt_trans hi (lt_add_one _)) }, } }
+        exact hF _ (lt_trans hi (lt_add_one _)) } } }
 end
 
 end padic_val_rat
 
 namespace padic_val_nat
 
-/-- A rewrite lemma for `padic_val_nat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
-protected lemma mul (p : ℕ) [p_prime : fact p.prime] {q r : ℕ} (hq : q ≠ 0) (hr : r ≠ 0) :
-  padic_val_nat p (q * r) = padic_val_nat p q + padic_val_nat p r :=
-begin
-  apply int.coe_nat_inj,
-  simp only [padic_val_rat_of_nat, nat.cast_mul],
-  rw padic_val_rat.mul,
-  norm_cast,
-  exact cast_ne_zero.mpr hq,
-  exact cast_ne_zero.mpr hr,
-end
+variables {p a b : ℕ} [hp : fact p.prime]
+
+include hp
 
-protected lemma div_of_dvd (p : ℕ) [hp : fact p.prime] {a b : ℕ} (h : b ∣ a) :
+/-- A rewrite lemma for `padic_val_nat p (a * b)` with conditions `a ≠ 0`, `b ≠ 0`. -/
+protected lemma mul : a ≠ 0 → b ≠ 0 →
+  padic_val_nat p (a * b) = padic_val_nat p a + padic_val_nat p b :=
+by exact_mod_cast @padic_val_rat.mul p _ a b
+
+protected lemma div_of_dvd (h : b ∣ a) :
   padic_val_nat p (a / b) = padic_val_nat p a - padic_val_nat p b :=
 begin
   rcases eq_or_ne a 0 with rfl | ha,
   { simp },
   obtain ⟨k, rfl⟩ := h,
   obtain ⟨hb, hk⟩ := mul_ne_zero_iff.mp ha,
-  rw [mul_comm, k.mul_div_cancel hb.bot_lt, padic_val_nat.mul p hk hb, nat.add_sub_cancel]
+  rw [mul_comm, k.mul_div_cancel hb.bot_lt, padic_val_nat.mul hk hb, nat.add_sub_cancel],
+  exact hp
 end
 
-/-- Dividing out by a prime factor reduces the padic_val_nat by 1. -/
-protected lemma div {p : ℕ} [p_prime : fact p.prime] {b : ℕ} (dvd : p ∣ b) :
-  (padic_val_nat p (b / p)) = (padic_val_nat p b) - 1 :=
+/-- Dividing out by a prime factor reduces the `padic_val_nat` by `1`. -/
+protected lemma div (dvd : p ∣ b) : padic_val_nat p (b / p) = (padic_val_nat p b) - 1 :=
 begin
-  convert padic_val_nat.div_of_dvd p dvd,
-  rw padic_val_nat_self p
+  convert padic_val_nat.div_of_dvd dvd,
+  rw padic_val_nat_self,
+  exact hp
 end
 
-/-- A version of `padic_val_rat.pow` for `padic_val_nat` -/
-protected lemma pow (p q n : ℕ) [fact p.prime] (hq : q ≠ 0) :
-  padic_val_nat p (q ^ n) = n * padic_val_nat p q :=
-begin
-  apply @nat.cast_injective ℤ,
-  push_cast,
-  exact padic_val_rat.pow _ (cast_ne_zero.mpr hq),
-end
+/-- A version of `padic_val_rat.pow` for `padic_val_nat`. -/
+protected lemma pow (n : ℕ) (ha : a ≠ 0) :
+  padic_val_nat p (a ^ n) = n * padic_val_nat p a :=
+by simpa only [← @nat.cast_inj ℤ] with push_cast using padic_val_rat.pow (cast_ne_zero.mpr ha)
 
-@[simp] protected lemma prime_pow (p n : ℕ) [fact p.prime] : padic_val_nat p (p ^ n) = n :=
-by rw [padic_val_nat.pow p _ _ (fact.out p.prime).ne_zero, padic_val_nat_self p, mul_one]
+@[simp] protected lemma prime_pow (n : ℕ) : padic_val_nat p (p ^ n) = n :=
+by rwa [padic_val_nat.pow _ (fact.out p.prime).ne_zero, padic_val_nat_self, mul_one]
 
-protected lemma div_pow {p : ℕ} [p_prime : fact p.prime] {b k : ℕ} (dvd : p ^ k ∣ b) :
-  (padic_val_nat p (b / p ^ k)) = (padic_val_nat p b) - k :=
+protected lemma div_pow (dvd : p ^ a ∣ b) : padic_val_nat p (b / p ^ a) = (padic_val_nat p b) - a :=
 begin
-  convert padic_val_nat.div_of_dvd p dvd,
-  rw padic_val_nat.prime_pow
+  rw [padic_val_nat.div_of_dvd dvd, padic_val_nat.prime_pow],
+  exact hp
 end
 
+protected lemma div' {m : ℕ} (cpm : coprime p m) {b : ℕ} (dvd : m ∣ b) :
+  padic_val_nat p (b / m) = padic_val_nat p b :=
+by rw [padic_val_nat.div_of_dvd dvd, eq_zero_of_not_dvd (hp.out.coprime_iff_not_dvd.mp cpm),
+  nat.sub_zero]; assumption
+
 end padic_val_nat
 
 section padic_val_nat
 
-lemma dvd_of_one_le_padic_val_nat {n p : nat} (hp : 1 ≤ padic_val_nat p n) :
-  p ∣ n :=
+variables {p : ℕ}
+
+lemma dvd_of_one_le_padic_val_nat {n : ℕ} (hp : 1 ≤ padic_val_nat p n) : p ∣ n :=
 begin
   by_contra h,
   rw padic_val_nat.eq_zero_of_not_dvd h at hp,
-  exact lt_irrefl 0 (lt_of_lt_of_le zero_lt_one hp),
+  exact lt_irrefl 0 (lt_of_lt_of_le zero_lt_one hp)
 end
 
-lemma pow_padic_val_nat_dvd {p n : ℕ} [fact (nat.prime p)] : p ^ (padic_val_nat p n) ∣ n :=
+lemma pow_padic_val_nat_dvd {n : ℕ} : p ^ padic_val_nat p n ∣ n :=
 begin
-  cases nat.eq_zero_or_pos n with hn hn,
-  { rw hn, exact dvd_zero (p ^ padic_val_nat p 0) },
-  { rw multiplicity.pow_dvd_iff_le_multiplicity,
-    apply le_of_eq,
-    rw padic_val_nat_def hn,
-    { apply enat.coe_get },
-    { apply_instance } }
+  rcases n.eq_zero_or_pos with rfl | hn, { simp },
+  rcases eq_or_ne p 1 with rfl | hp, { simp },
+  rw [multiplicity.pow_dvd_iff_le_multiplicity, padic_val_nat_def']; assumption
 end
 
-lemma pow_succ_padic_val_nat_not_dvd {p n : ℕ} [hp : fact (nat.prime p)] (hn : 0 < n) :
-  ¬ p ^ (padic_val_nat p n + 1) ∣ n :=
+lemma padic_val_nat_dvd_iff_le [hp : fact p.prime] {a n : ℕ} (ha : a ≠ 0) :
+  p ^ n ∣ a ↔ n ≤ padic_val_nat p a :=
+by rw [pow_dvd_iff_le_multiplicity, ← padic_val_nat_def' hp.out.ne_one ha.bot_lt,
+  part_enat.coe_le_coe]
+
+lemma padic_val_nat_dvd_iff (n : ℕ) [hp : fact p.prime] (a : ℕ) :
+  p ^ n ∣ a ↔ a = 0 ∨ n ≤ padic_val_nat p a :=
 begin
-  rw multiplicity.pow_dvd_iff_le_multiplicity,
-  rw padic_val_nat_def hn,
-  { rw [nat.cast_add, enat.coe_get],
-    simp only [nat.cast_one, not_le],
-    exact enat.lt_add_one (ne_top_iff_finite.mpr
-      (finite_nat_iff.mpr ⟨(fact.elim hp).ne_one, hn⟩)), },
-  { apply_instance }
+  rcases eq_or_ne a 0 with rfl | ha,
+  { exact iff_of_true (dvd_zero _) (or.inl rfl) },
+  { simp only [ha, false_or, padic_val_nat_dvd_iff_le ha] }
 end
 
-lemma padic_val_nat_dvd_iff (p : ℕ) [hp :fact p.prime] (n : ℕ) (a : ℕ) :
-  p^n ∣ a ↔ a = 0 ∨ n ≤ padic_val_nat p a :=
+lemma pow_succ_padic_val_nat_not_dvd {n : ℕ} [hp : fact p.prime] (hn : n ≠ 0) :
+  ¬ p ^ (padic_val_nat p n + 1) ∣ n :=
 begin
-  split,
-  { rw [pow_dvd_iff_le_multiplicity, padic_val_nat],
-    split_ifs,
-    { rw enat.coe_le_iff,
-      exact λ hn, or.inr (hn _) },
-    { simp only [true_and, not_lt, ne.def, not_false_iff, nat.le_zero_iff, hp.out.ne_one] at h,
-      exact λ hn, or.inl h } },
-  { rintro (rfl|h),
-    { exact dvd_zero (p ^ n) },
-    { exact dvd_trans (pow_dvd_pow p h) pow_padic_val_nat_dvd } },
+  rw [padic_val_nat_dvd_iff_le hn, not_le],
+  exacts [nat.lt_succ_self _, hp]
 end
 
-lemma padic_val_nat_primes {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
-  (neq : p ≠ q) : padic_val_nat p q = 0 :=
+lemma padic_val_nat_primes {q : ℕ} [hp : fact p.prime] [hq : fact q.prime] (neq : p ≠ q) :
+  padic_val_nat p q = 0 :=
 @padic_val_nat.eq_zero_of_not_dvd p q $
-(not_congr (iff.symm (prime_dvd_prime_iff_eq p_prime.1 q_prime.1))).mp neq
-
-protected lemma padic_val_nat.div' {p : ℕ} [p_prime : fact p.prime] :
-  ∀ {m : ℕ} (cpm : coprime p m) {b : ℕ} (dvd : m ∣ b), padic_val_nat p (b / m) = padic_val_nat p b
-| 0 := λ cpm b dvd, by { rw zero_dvd_iff at dvd, rw [dvd, nat.zero_div], }
-| (n + 1) :=
-  λ cpm b dvd,
-  begin
-    rcases dvd with ⟨c, rfl⟩,
-    rw [mul_div_right c (nat.succ_pos _)],by_cases hc : c = 0,
-    { rw [hc, mul_zero] },
-    { rw padic_val_nat.mul,
-      { suffices : ¬ p ∣ (n+1),
-        { rw [padic_val_nat.eq_zero_of_not_dvd this, zero_add] },
-        contrapose! cpm,
-        exact p_prime.1.dvd_iff_not_coprime.mp cpm },
-      { exact nat.succ_ne_zero _ },
-      { exact hc } },
-  end
-
-lemma padic_val_nat_eq_factorization (p n : ℕ) [hp : fact p.prime] :
-  padic_val_nat p n = n.factorization p :=
-begin
-  by_cases hn : n = 0, { subst hn, simp },
-  rw @padic_val_nat_def p _ n (nat.pos_of_ne_zero hn),
-  simp [@multiplicity_eq_factorization n p hp.elim hn],
-end
+  (not_congr (iff.symm (prime_dvd_prime_iff_eq hp.1 hq.1))).mp neq
 
 open_locale big_operators
 
-lemma prod_pow_prime_padic_val_nat (n : nat) (hn : n ≠ 0) (m : nat) (pr : n < m) :
-  ∏ p in finset.filter nat.prime (finset.range m), p ^ (padic_val_nat p n) = n :=
-begin
-  nth_rewrite_rhs 0 ←factorization_prod_pow_eq_self hn,
-  rw eq_comm,
-  apply finset.prod_subset_one_on_sdiff,
-  { exact λ p hp, finset.mem_filter.mpr
-      ⟨finset.mem_range.mpr (gt_of_gt_of_ge pr (le_of_mem_factorization hp)),
-       prime_of_mem_factorization hp⟩ },
-  { intros p hp,
-    cases finset.mem_sdiff.mp hp with hp1 hp2,
-    haveI := fact_iff.mpr (finset.mem_filter.mp hp1).2,
-    rw padic_val_nat_eq_factorization p n,
-    simp [finsupp.not_mem_support_iff.mp hp2] },
-  { intros p hp,
-    haveI := fact_iff.mpr (prime_of_mem_factorization hp),
-    simp [padic_val_nat_eq_factorization] }
-end
-
-lemma range_pow_padic_val_nat_subset_divisors {n : ℕ} (p : ℕ) [fact p.prime] (hn : n ≠ 0) :
+lemma range_pow_padic_val_nat_subset_divisors {n : ℕ} (hn : n ≠ 0) :
   (finset.range (padic_val_nat p n + 1)).image (pow p) ⊆ n.divisors :=
 begin
   intros t ht,
@@ -549,53 +452,53 @@ begin
   exact ⟨(pow_dvd_pow p $ by linarith).trans pow_padic_val_nat_dvd, hn⟩
 end
 
-lemma range_pow_padic_val_nat_subset_divisors' {n : ℕ} (p : ℕ) [h : fact p.prime] :
-  (finset.range (padic_val_nat p n)).image (λ t, p ^ (t + 1)) ⊆ (n.divisors \ {1}) :=
+lemma range_pow_padic_val_nat_subset_divisors' {n : ℕ} [hp : fact p.prime] :
+  (finset.range (padic_val_nat p n)).image (λ t, p ^ (t + 1)) ⊆ n.divisors.erase 1 :=
 begin
   rcases eq_or_ne n 0 with rfl | hn,
   { simp },
   intros t ht,
   simp only [exists_prop, finset.mem_image, finset.mem_range] at ht,
   obtain ⟨k, hk, rfl⟩ := ht,
-  rw [finset.mem_sdiff, nat.mem_divisors],
-  refine ⟨⟨(pow_dvd_pow p $ by linarith).trans pow_padic_val_nat_dvd, hn⟩, _⟩,
-  rw [finset.mem_singleton],
-  nth_rewrite 1 ←one_pow (k + 1),
-  exact (nat.pow_lt_pow_of_lt_left h.1.one_lt $ nat.succ_pos k).ne',
+  rw [finset.mem_erase, nat.mem_divisors],
+  refine ⟨_, (pow_dvd_pow p $ succ_le_iff.2 hk).trans pow_padic_val_nat_dvd, hn⟩,
+  exact (nat.one_lt_pow _ _ k.succ_pos hp.out.one_lt).ne'
 end
 
 end padic_val_nat
 
 section padic_val_int
-variables (p : ℕ) [p_prime : fact p.prime]
 
-lemma padic_val_int_dvd_iff (p : ℕ) [fact p.prime] (n : ℕ) (a : ℤ) :
-  ↑p^n ∣ a ↔ a = 0 ∨ n ≤ padic_val_int p a :=
-by rw [padic_val_int, ←int.nat_abs_eq_zero, ←padic_val_nat_dvd_iff, ←int.coe_nat_dvd_left,
-       int.coe_nat_pow]
+variables {p : ℕ} [hp : fact p.prime]
+
+include hp
+
+lemma padic_val_int_dvd_iff (n : ℕ) (a : ℤ) : (p : ℤ) ^ n ∣ a ↔ a = 0 ∨ n ≤ padic_val_int p a :=
+by rw [padic_val_int, ← int.nat_abs_eq_zero, ← padic_val_nat_dvd_iff, ← int.coe_nat_dvd_left,
+    int.coe_nat_pow]
 
-lemma padic_val_int_dvd (p : ℕ) [fact p.prime] (a : ℤ) : ↑p^(padic_val_int p a) ∣ a :=
+lemma padic_val_int_dvd (a : ℤ) : (p : ℤ) ^ padic_val_int p a ∣ a :=
 begin
   rw padic_val_int_dvd_iff,
-  exact or.inr le_rfl,
+  exact or.inr le_rfl
 end
 
-lemma padic_val_int_self (p : ℕ) [pp : fact p.prime] : padic_val_int p p = 1 :=
-padic_val_int.self pp.out.one_lt
+lemma padic_val_int_self : padic_val_int p p = 1 := padic_val_int.self hp.out.one_lt
 
-lemma padic_val_int.mul (p : ℕ) [fact p.prime] {a b : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
-  padic_val_int p (a*b) = padic_val_int p a + padic_val_int p b :=
+lemma padic_val_int.mul {a b : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
+  padic_val_int p (a * b) = padic_val_int p a + padic_val_int p b :=
 begin
   simp_rw padic_val_int,
   rw [int.nat_abs_mul, padic_val_nat.mul];
-  rwa int.nat_abs_ne_zero,
+  rwa int.nat_abs_ne_zero
 end
 
-lemma padic_val_int_mul_eq_succ (p : ℕ) [pp : fact p.prime] (a : ℤ) (ha : a ≠ 0) :
+lemma padic_val_int_mul_eq_succ (a : ℤ) (ha : a ≠ 0) :
   padic_val_int p (a * p) = (padic_val_int p a) + 1 :=
 begin
-  rw padic_val_int.mul p ha (int.coe_nat_ne_zero.mpr (pp.out).ne_zero),
+  rw padic_val_int.mul ha (int.coe_nat_ne_zero.mpr hp.out.ne_zero),
   simp only [eq_self_iff_true, padic_val_int.of_nat, padic_val_nat_self],
+  exact hp
 end
 
 end padic_val_int
diff --git a/src/number_theory/padics/ring_homs.lean b/src/number_theory/padics/ring_homs.lean
index c5e60e21d5870..1fb617a8d2683 100644
--- a/src/number_theory/padics/ring_homs.lean
+++ b/src/number_theory/padics/ring_homs.lean
@@ -11,6 +11,9 @@ import number_theory.padics.padic_integers
 
 # Relating `ℤ_[p]` to `zmod (p ^ n)`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we establish connections between the `p`-adic integers $\mathbb{Z}_p$
 and the integers modulo powers of `p`, $\mathbb{Z}/p^n\mathbb{Z}$.
 
@@ -44,7 +47,7 @@ open nat local_ring padic
 
 namespace padic_int
 
-variables {p : ℕ} [hp_prime : fact (p.prime)]
+variables {p : ℕ} [hp_prime : fact p.prime]
 include hp_prime
 
 section ring_homs
@@ -54,7 +57,7 @@ variables (p) (r : ℚ)
 omit hp_prime
 /--
 `mod_part p r` is an integer that satisfies
-`∥(r - mod_part p r : ℚ_[p])∥ < 1` when `∥(r : ℚ_[p])∥ ≤ 1`,
+`‖(r - mod_part p r : ℚ_[p])‖ < 1` when `‖(r : ℚ_[p])‖ ≤ 1`,
 see `padic_int.norm_sub_mod_part`.
 It is the unique non-negative integer that is `< p` with this property.
 
@@ -77,16 +80,16 @@ end
 lemma mod_part_nonneg : 0 ≤ mod_part p r :=
 int.mod_nonneg _ $ by exact_mod_cast hp_prime.1.ne_zero
 
-lemma is_unit_denom (r : ℚ) (h : ∥(r : ℚ_[p])∥ ≤ 1) : is_unit (r.denom : ℤ_[p]) :=
+lemma is_unit_denom (r : ℚ) (h : ‖(r : ℚ_[p])‖ ≤ 1) : is_unit (r.denom : ℤ_[p]) :=
 begin
   rw is_unit_iff,
   apply le_antisymm (r.denom : ℤ_[p]).2,
-  rw [← not_lt, val_eq_coe, coe_coe],
+  rw [← not_lt, val_eq_coe, coe_nat_cast],
   intro norm_denom_lt,
-  have hr : ∥(r * r.denom : ℚ_[p])∥ = ∥(r.num : ℚ_[p])∥,
+  have hr : ‖(r * r.denom : ℚ_[p])‖ = ‖(r.num : ℚ_[p])‖,
   { rw_mod_cast @rat.mul_denom_eq_num r, refl, },
   rw padic_norm_e.mul at hr,
-  have key : ∥(r.num : ℚ_[p])∥ < 1,
+  have key : ‖(r.num : ℚ_[p])‖ < 1,
   { calc _ = _ : hr.symm
     ... < 1 * 1 : mul_lt_mul' h norm_denom_lt (norm_nonneg _) zero_lt_one
     ... = 1 : mul_one 1 },
@@ -97,7 +100,7 @@ begin
   rwa [← r.cop.gcd_eq_one, nat.dvd_gcd_iff, ← int.coe_nat_dvd_left, ← int.coe_nat_dvd],
 end
 
-lemma norm_sub_mod_part_aux (r : ℚ) (h : ∥(r : ℚ_[p])∥ ≤ 1) :
+lemma norm_sub_mod_part_aux (r : ℚ) (h : ‖(r : ℚ_[p])‖ ≤ 1) :
   ↑p ∣ r.num - r.num * r.denom.gcd_a p % p * ↑(r.denom) :=
 begin
   rw ← zmod.int_coe_zmod_eq_zero_iff_dvd,
@@ -117,22 +120,22 @@ begin
   exact is_unit_denom r h,
 end
 
-lemma norm_sub_mod_part (h : ∥(r : ℚ_[p])∥ ≤ 1) : ∥(⟨r,h⟩ - mod_part p r : ℤ_[p])∥ < 1 :=
+lemma norm_sub_mod_part (h : ‖(r : ℚ_[p])‖ ≤ 1) : ‖(⟨r,h⟩ - mod_part p r : ℤ_[p])‖ < 1 :=
 begin
   let n := mod_part p r,
   rw [norm_lt_one_iff_dvd, ← (is_unit_denom r h).dvd_mul_right],
   suffices : ↑p ∣ r.num - n * r.denom,
   { convert (int.cast_ring_hom ℤ_[p]).map_dvd this,
-    simp only [sub_mul, int.cast_coe_nat, ring_hom.eq_int_cast, int.cast_mul,
+    simp only [sub_mul, int.cast_coe_nat, eq_int_cast, int.cast_mul,
       sub_left_inj, int.cast_sub],
     apply subtype.coe_injective,
-    simp only [coe_mul, subtype.coe_mk, coe_coe],
+    simp only [coe_mul, subtype.coe_mk, coe_nat_cast],
     rw_mod_cast @rat.mul_denom_eq_num r, refl },
   exact norm_sub_mod_part_aux r h
 end
 
-lemma exists_mem_range_of_norm_rat_le_one (h : ∥(r : ℚ_[p])∥ ≤ 1) :
-  ∃ n : ℤ, 0 ≤ n ∧ n < p ∧ ∥(⟨r,h⟩ - n : ℤ_[p])∥ < 1 :=
+lemma exists_mem_range_of_norm_rat_le_one (h : ‖(r : ℚ_[p])‖ ≤ 1) :
+  ∃ n : ℤ, 0 ≤ n ∧ n < p ∧ ‖(⟨r,h⟩ - n : ℤ_[p])‖ < 1 :=
 ⟨mod_part p r, mod_part_nonneg _, mod_part_lt_p _, norm_sub_mod_part _ h⟩
 
 lemma zmod_congr_of_sub_mem_span_aux (n : ℕ) (x : ℤ_[p]) (a b : ℤ)
@@ -153,7 +156,7 @@ lemma zmod_congr_of_sub_mem_span (n : ℕ) (x : ℤ_[p]) (a b : ℕ)
   (ha : x - a ∈ (ideal.span {p ^ n} : ideal ℤ_[p]))
   (hb : x - b ∈ (ideal.span {p ^ n} : ideal ℤ_[p])) :
   (a : zmod (p ^ n)) = b :=
-zmod_congr_of_sub_mem_span_aux n x a b ha hb
+by simpa using zmod_congr_of_sub_mem_span_aux n x a b ha hb
 
 lemma zmod_congr_of_sub_mem_max_ideal (x : ℤ_[p]) (m n : ℕ)
   (hm : x - m ∈ maximal_ideal ℤ_[p]) (hn : x - n ∈ maximal_ideal ℤ_[p]) :
@@ -164,24 +167,25 @@ begin
   simp only [pow_one] at this,
   specialize this hm hn,
   apply_fun zmod.cast_hom (show p ∣ p ^ 1, by rw pow_one) (zmod p) at this,
-  simpa only [ring_hom.map_int_cast],
+  simp only [map_int_cast] at this,
+  simpa only [int.cast_coe_nat] using this
 end
 
 variable (x : ℤ_[p])
 lemma exists_mem_range : ∃ n : ℕ, n < p ∧ (x - n ∈ maximal_ideal ℤ_[p]) :=
 begin
   simp only [maximal_ideal_eq_span_p, ideal.mem_span_singleton, ← norm_lt_one_iff_dvd],
-  obtain ⟨r, hr⟩ := rat_dense (x : ℚ_[p]) zero_lt_one,
-  have H : ∥(r : ℚ_[p])∥ ≤ 1,
+  obtain ⟨r, hr⟩ := rat_dense p (x : ℚ_[p]) zero_lt_one,
+  have H : ‖(r : ℚ_[p])‖ ≤ 1,
   { rw norm_sub_rev at hr,
-    calc _ = ∥(r : ℚ_[p]) - x + x∥ : by ring_nf
+    calc _ = ‖(r : ℚ_[p]) - x + x‖ : by ring_nf
        ... ≤ _ : padic_norm_e.nonarchimedean _ _
        ... ≤ _ :  max_le (le_of_lt hr) x.2 },
   obtain ⟨n, hzn, hnp, hn⟩ := exists_mem_range_of_norm_rat_le_one r H,
   lift n to ℕ using hzn,
   use n,
   split, {exact_mod_cast hnp},
-  simp only [norm_def, coe_sub, subtype.coe_mk, coe_coe] at hn ⊢,
+  simp only [norm_def, coe_sub, subtype.coe_mk, coe_nat_cast] at hn ⊢,
   rw show (x - n : ℚ_[p]) = (x - r) + (r - n), by ring,
   apply lt_of_le_of_lt (padic_norm_e.nonarchimedean _ _),
   apply max_lt hr,
@@ -190,7 +194,7 @@ end
 
 /--
 `zmod_repr x` is the unique natural number smaller than `p`
-satisfying `∥(x - zmod_repr x : ℤ_[p])∥ < 1`.
+satisfying `‖(x - zmod_repr x : ℤ_[p])‖ < 1`.
 -/
 def zmod_repr : ℕ :=
 classical.some (exists_mem_range x)
@@ -284,12 +288,12 @@ begin
     rw ← sub_zero x at h,
     dsimp [to_zmod, to_zmod_hom],
     convert zmod_congr_of_sub_mem_max_ideal x _ 0 _ h,
-    apply sub_zmod_repr_mem, }
+    norm_cast, apply sub_zmod_repr_mem, }
 end
 
 /-- `appr n x` gives a value `v : ℕ` such that `x` and `↑v : ℤ_p` are congruent mod `p^n`.
 See `appr_spec`. -/
-noncomputable def appr : ℤ_[p] → ℕ → ℕ
+@[irreducible] noncomputable def appr : ℤ_[p] → ℕ → ℕ
 | x 0     := 0
 | x (n+1) :=
 let y := x - appr x n in
@@ -381,8 +385,6 @@ begin
     exact (dvd_pow_self (p : ℤ_[p]) hc0.ne').mul_left _, },
 end
 
-attribute [irreducible] appr
-
 /-- A ring hom from `ℤ_[p]` to `zmod (p^n)`, with underlying function `padic_int.appr n`. -/
 def to_zmod_pow (n : ℕ) : ℤ_[p] →+* zmod (p ^ n) :=
 to_zmod_hom (p^n) (λ x, appr x n)
@@ -495,9 +497,7 @@ begin
       int.cast_sub],
   dsimp [nth_hom],
   rw [← f_compat, ring_hom.comp_apply],
-  have : fact (p ^ i > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
-  have : fact (p ^ j > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
-  unfreezingI { simp only [zmod.cast_id, zmod.cast_hom_apply, sub_self, zmod.nat_cast_val], },
+  simp only [zmod.cast_id, zmod.cast_hom_apply, sub_self, zmod.nat_cast_val, zmod.int_cast_cast],
 end
 
 lemma is_cau_seq_nth_hom (r : R): is_cau_seq (padic_norm p) (λ n, nth_hom f r n) :=
@@ -519,14 +519,16 @@ The `n`th value of the sequence is `((f n r).val : ℚ)`.
 -/
 def nth_hom_seq (r : R) : padic_seq p := ⟨λ n, nth_hom f r n, is_cau_seq_nth_hom f_compat r⟩
 
+-- this lemma ran into issues after changing to `ne_zero` and I'm not sure why.
 lemma nth_hom_seq_one : nth_hom_seq f_compat 1 ≈ 1 :=
 begin
   intros ε hε,
   change _ < _ at hε,
   use 1,
   intros j hj,
-  haveI : fact (1 < p^j) := ⟨nat.one_lt_pow _ _ (by linarith) hp_prime.1.one_lt⟩,
-  simp [nth_hom_seq, nth_hom, zmod.val_one, hε],
+  haveI : fact (1 < p ^ j) := ⟨nat.one_lt_pow _ _ (by linarith) hp_prime.1.one_lt⟩,
+  suffices : ((1 : zmod (p ^ j)) : ℚ) = 1, by simp [nth_hom_seq, nth_hom, this, hε],
+  rw [zmod.cast_eq_val, zmod.val_one, nat.cast_one]
 end
 
 lemma nth_hom_seq_add (r s : R) :
@@ -541,13 +543,9 @@ begin
   rw [← int.cast_add, ← int.cast_sub, ← padic_norm.dvd_iff_norm_le,
      ← zmod.int_coe_zmod_eq_zero_iff_dvd],
   dsimp [nth_hom],
-  have : fact (p ^ n > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
-  have : fact (p ^ j > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
-  unfreezingI
-  { simp only [int.cast_coe_nat, int.cast_add, ring_hom.map_add, int.cast_sub, zmod.nat_cast_val] },
-  rw [zmod.cast_add (show p ^ n ∣ p ^ j, from _), sub_self],
+  simp only [zmod.nat_cast_val, ring_hom.map_add, int.cast_sub, zmod.int_cast_cast, int.cast_add],
+  rw [zmod.cast_add (show p^n ∣ p^j, from pow_dvd_pow _ hj), sub_self],
   { apply_instance },
-  { apply pow_dvd_pow, linarith only [hj] },
 end
 
 lemma nth_hom_seq_mul (r s : R) :
@@ -562,13 +560,9 @@ begin
   rw [← int.cast_mul, ← int.cast_sub, ← padic_norm.dvd_iff_norm_le,
      ← zmod.int_coe_zmod_eq_zero_iff_dvd],
   dsimp [nth_hom],
-  have : fact (p ^ n > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
-  have : fact (p ^ j > 0) := ⟨pow_pos hp_prime.1.pos _⟩,
-  unfreezingI
-  { simp only [int.cast_coe_nat, int.cast_mul, int.cast_sub, ring_hom.map_mul, zmod.nat_cast_val] },
-  rw [zmod.cast_mul (show p ^ n ∣ p ^ j, from _), sub_self],
+  simp only [zmod.nat_cast_val, ring_hom.map_mul, int.cast_sub, zmod.int_cast_cast, int.cast_mul],
+  rw [zmod.cast_mul (show p^n ∣ p^j, from pow_dvd_pow _ hj), sub_self],
   { apply_instance },
-  { apply pow_dvd_pow, linarith only [hj] },
 end
 
 /--
@@ -579,7 +573,7 @@ def lim_nth_hom (r : R) : ℤ_[p] :=
 of_int_seq (nth_hom f r) (is_cau_seq_nth_hom f_compat r)
 
 lemma lim_nth_hom_spec (r : R) :
-  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n ≥ N, ∥lim_nth_hom f_compat r - nth_hom f r n∥ < ε :=
+  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n ≥ N, ‖lim_nth_hom f_compat r - nth_hom f r n‖ < ε :=
 begin
   intros ε hε,
   obtain ⟨ε', hε'0, hε'⟩ : ∃ v : ℚ, (0 : ℝ) < v ∧ ↑v < ε := exists_rat_btwn hε,
@@ -590,8 +584,7 @@ begin
   apply lt_trans _ hε',
   change ↑(padic_norm_e _) < _,
   norm_cast,
-  convert hN _ hn,
-  simp [nth_hom, lim_nth_hom, nth_hom_seq, of_int_seq],
+  exact hN _ hn,
 end
 
 lemma lim_nth_hom_zero : lim_nth_hom f_compat 0 = 0 :=
@@ -633,7 +626,7 @@ begin
   rw sub_eq_sub_add_sub (lim_nth_hom f_compat r) _ ↑(nth_hom f r (max n k)),
   apply ideal.add_mem _ _ this,
   rw [ideal.mem_span_singleton],
-  simpa only [ring_hom.eq_int_cast, ring_hom.map_pow, int.cast_sub] using
+  simpa only [eq_int_cast, ring_hom.map_pow, int.cast_sub] using
     (int.cast_ring_hom ℤ_[p]).map_dvd
       (pow_dvd_nth_hom_sub f_compat r n (max n k) (le_max_left _ _)),
 end
@@ -645,7 +638,6 @@ See also `padic_int.lift_unique`.
 lemma lift_spec (n : ℕ) : (to_zmod_pow n).comp (lift f_compat) = f n :=
 begin
   ext r,
-  haveI : fact (0 < p ^ n) := ⟨pow_pos hp_prime.1.pos n⟩,
   rw [ring_hom.comp_apply, ← zmod.nat_cast_zmod_val (f n r), ← map_nat_cast $ to_zmod_pow n,
       ← sub_eq_zero, ← ring_hom.map_sub, ← ring_hom.mem_ker, ker_to_zmod_pow],
   apply lift_sub_val_mem_span,
diff --git a/src/number_theory/pell.lean b/src/number_theory/pell.lean
index dfb7feb2e244f..a9f498d0bd0fd 100644
--- a/src/number_theory/pell.lean
+++ b/src/number_theory/pell.lean
@@ -1,801 +1,711 @@
 /-
-Copyright (c) 2017 Mario Carneiro. All rights reserved.
+Copyright (c) 2023 Michael Stoll. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Mario Carneiro
+Authors: Michael Geißer, Michael Stoll
 -/
 
-import data.nat.modeq
+import tactic.qify
+import data.zmod.basic
+import number_theory.diophantine_approximation
 import number_theory.zsqrtd.basic
 
 /-!
-# Pell's equation and Matiyasevic's theorem
+# Pell's Equation
 
-This file solves Pell's equation, i.e. integer solutions to `x ^ 2 - d * y ^ 2 = 1` in the special
-case that `d = a ^ 2 - 1`. This is then applied to prove Matiyasevic's theorem that the power
-function is Diophantine, which is the last key ingredient in the solution to Hilbert's tenth
-problem. For the definition of Diophantine function, see `dioph.lean`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-## Main definition
+*Pell's Equation* is the equation $x^2 - d y^2 = 1$, where $d$ is a positive integer
+that is not a square, and one is interested in solutions in integers $x$ and $y$.
 
-* `pell` is a function assigning to a natural number `n` the `n`-th solution to Pell's equation
-  constructed recursively from the initial solution `(0, 1)`.
+In this file, we aim at providing all of the essential theory of Pell's Equation for general $d$
+(as opposed to the contents of `number_theory.pell_matiyasevic`, which is specific to the case
+$d = a^2 - 1$ for some $a > 1$).
 
-## Main statements
+We begin by defining a type `pell.solution₁ d` for solutions of the equation,
+show that it has a natural structure as an abelian group, and prove some basic
+properties.
 
-* `eq_pell` shows that every solution to Pell's equation is recursively obtained using `pell`
-* `matiyasevic` shows that a certain system of Diophantine equations has a solution if and only if
-  the first variable is the `x`-component in a solution to Pell's equation - the key step towards
-  Hilbert's tenth problem in Davis' version of Matiyasevic's theorem.
-* `eq_pow_of_pell` shows that the power function is Diophantine.
+We then prove the following
 
-## Implementation notes
+**Theorem.** Let $d$ be a positive integer that is not a square. Then the equation
+$x^2 - d y^2 = 1$ has a nontrivial (i.e., with $y \ne 0$) solution in integers.
 
-The proof of Matiyasevic's theorem doesn't follow Matiyasevic's original account of using Fibonacci
-numbers but instead Davis' variant of using solutions to Pell's equation.
+See `pell.exists_of_not_is_square` and `pell.solution₁.exists_nontrivial_of_not_is_square`.
+
+We then define the *fundamental solution* to be the solution
+with smallest $x$ among all solutions satisfying $x > 1$ and $y > 0$.
+We show that every solution is a power (in the sense of the group structure mentioned above)
+of the fundamental solution up to a (common) sign,
+see `pell.is_fundamental.eq_zpow_or_neg_zpow`, and that a (positive) solution has this property
+if and only if it is fundamental, see `pell.pos_generator_iff_fundamental`.
 
 ## References
 
-* [M. Carneiro, _A Lean formalization of Matiyasevič's theorem_][carneiro2018matiyasevic]
-* [M. Davis, _Hilbert's tenth problem is unsolvable_][MR317916]
+* [K. Ireland, M. Rosen, *A classical introduction to modern number theory*
+   (Section 17.5)][IrelandRosen1990]
 
 ## Tags
 
-Pell's equation, Matiyasevic's theorem, Hilbert's tenth problem
+Pell's equation
 
 ## TODO
 
-* Provide solutions to Pell's equation for the case of arbitrary `d` (not just `d = a ^ 2 - 1` like
-  in the current version) and furthermore also for `x ^ 2 - d * y ^ 2 = -1`.
+* Extend to `x ^ 2 - d * y ^ 2 = -1` and further generalizations.
 * Connect solutions to the continued fraction expansion of `√d`.
 -/
 
 namespace pell
-open nat
 
-section
-parameters {a : ℕ} (a1 : 1 < a)
+/-!
+### Group structure of the solution set
+
+We define a structure of a commutative multiplicative group with distributive negation
+on the set of all solutions to the Pell equation `x^2 - d*y^2 = 1`.
+
+The type of such solutions is `pell.solution₁ d`. It corresponds to a pair of integers `x` and `y`
+and a proof that `(x, y)` is indeed a solution.
+
+The multiplication is given by `(x, y) * (x', y') = (x*y' + d*y*y', x*y' + y*x')`.
+This is obtained by mapping `(x, y)` to `x + y*√d` and multiplying the results.
+In fact, we define `pell.solution₁ d` to be `↥(unitary (ℤ√d))` and transport
+the "commutative group with distributive negation" structure from `↥(unitary (ℤ√d))`.
+
+We then set up an API for `pell.solution₁ d`.
+-/
+
+open zsqrtd
+
+/-- An element of `ℤ√d` has norm one (i.e., `a.re^2 - d*a.im^2 = 1`) if and only if
+it is contained in the submonoid of unitary elements.
+
+TODO: merge this result with `pell.is_pell_iff_mem_unitary`. -/
+lemma is_pell_solution_iff_mem_unitary {d : ℤ} {a : ℤ√d} :
+  a.re ^ 2 - d * a.im ^ 2 = 1 ↔ a ∈ unitary ℤ√d :=
+by rw [← norm_eq_one_iff_mem_unitary, norm_def, sq, sq, ← mul_assoc]
+
+-- We use `solution₁ d` to allow for a more general structure `solution d m` that
+-- encodes solutions to `x^2 - d*y^2 = m` to be added later.
+
+/-- `pell.solution₁ d` is the type of solutions to the Pell equation `x^2 - d*y^2 = 1`.
+We define this in terms of elements of `ℤ√d` of norm one.
+-/
+@[derive [comm_group, has_distrib_neg, inhabited]]
+def solution₁ (d : ℤ) : Type := ↥(unitary ℤ√d)
+
+namespace solution₁
+
+variables {d : ℤ}
+
+instance : has_coe (solution₁ d) ℤ√d := { coe := subtype.val }
+
+/-- The `x` component of a solution to the Pell equation `x^2 - d*y^2 = 1` -/
+protected def x (a : solution₁ d) : ℤ := (a : ℤ√d).re
+
+/-- The `y` component of a solution to the Pell equation `x^2 - d*y^2 = 1` -/
+protected def y (a : solution₁ d) : ℤ := (a : ℤ√d).im
+
+/-- The proof that `a` is a solution to the Pell equation `x^2 - d*y^2 = 1` -/
+lemma prop (a : solution₁ d) : a.x ^ 2 - d * a.y ^ 2 = 1 :=
+is_pell_solution_iff_mem_unitary.mpr a.property
+
+/-- An alternative form of the equation, suitable for rewriting `x^2`. -/
+lemma prop_x (a : solution₁ d) : a.x ^ 2 = 1 + d * a.y ^ 2 := by {rw ← a.prop, ring}
+
+/-- An alternative form of the equation, suitable for rewriting `d * y^2`. -/
+lemma prop_y (a : solution₁ d) : d * a.y ^ 2 = a.x ^ 2 - 1 := by {rw ← a.prop, ring}
+
+/-- Two solutions are equal if their `x` and `y` components are equal. -/
+@[ext]
+lemma ext {a b : solution₁ d} (hx : a.x = b.x) (hy : a.y = b.y) : a = b :=
+subtype.ext $ ext.mpr ⟨hx, hy⟩
+
+/-- Construct a solution from `x`, `y` and a proof that the equation is satisfied. -/
+def mk (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : solution₁ d :=
+{ val := ⟨x, y⟩,
+  property := is_pell_solution_iff_mem_unitary.mp prop }
+
+@[simp]
+lemma x_mk (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : (mk x y prop).x = x := rfl
+
+@[simp]
+lemma y_mk (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : (mk x y prop).y = y := rfl
+
+@[simp]
+lemma coe_mk  (x y : ℤ) (prop : x ^ 2 - d * y ^ 2 = 1) : (↑(mk x y prop) : ℤ√d) = ⟨x,y⟩ :=
+zsqrtd.ext.mpr ⟨x_mk x y prop, y_mk x y prop⟩
+
+@[simp]
+lemma x_one : (1 : solution₁ d).x = 1 := rfl
+
+@[simp]
+lemma y_one : (1 : solution₁ d).y = 0 := rfl
+
+@[simp]
+lemma x_mul (a b : solution₁ d) : (a * b).x = a.x * b.x + d * (a.y * b.y) :=
+by {rw ← mul_assoc, refl}
+
+@[simp]
+lemma y_mul (a b : solution₁ d) : (a * b).y = a.x * b.y + a.y * b.x := rfl
+
+@[simp]
+lemma x_inv (a : solution₁ d) : a⁻¹.x = a.x := rfl
+
+@[simp]
+lemma y_inv (a : solution₁ d) : a⁻¹.y = -a.y := rfl
+
+@[simp]
+lemma x_neg (a : solution₁ d) : (-a).x = -a.x := rfl
+
+@[simp]
+lemma y_neg (a : solution₁ d) : (-a).y = -a.y := rfl
+
+/-- When `d` is negative, then `x` or `y` must be zero in a solution. -/
+lemma eq_zero_of_d_neg (h₀ : d < 0) (a : solution₁ d) : a.x = 0 ∨ a.y = 0 :=
+begin
+  have h := a.prop,
+  contrapose! h,
+  have h1 := sq_pos_of_ne_zero a.x h.1,
+  have h2 := sq_pos_of_ne_zero a.y h.2,
+  nlinarith,
+end
+
+/-- A solution has `x ≠ 0`. -/
+lemma x_ne_zero (h₀ : 0 ≤ d) (a : solution₁ d) : a.x ≠ 0 :=
+begin
+  intro hx,
+  have h : 0 ≤ d * a.y ^ 2 := mul_nonneg h₀ (sq_nonneg _),
+  rw [a.prop_y, hx, sq, zero_mul, zero_sub] at h,
+  exact not_le.mpr (neg_one_lt_zero : (-1 : ℤ) < 0) h,
+end
+
+/-- A solution with `x > 1` must have `y ≠ 0`. -/
+lemma y_ne_zero_of_one_lt_x {a : solution₁ d} (ha : 1 < a.x) : a.y ≠ 0 :=
+begin
+  intro hy,
+  have prop := a.prop,
+  rw [hy, sq (0 : ℤ), zero_mul, mul_zero, sub_zero] at prop,
+  exact lt_irrefl _ (((one_lt_sq_iff $ zero_le_one.trans ha.le).mpr ha).trans_eq prop),
+end
+
+/-- If a solution has `x > 1`, then `d` is positive. -/
+lemma d_pos_of_one_lt_x {a : solution₁ d} (ha : 1 < a.x) : 0 < d :=
+begin
+  refine pos_of_mul_pos_left _ (sq_nonneg a.y),
+  rw [a.prop_y, sub_pos],
+  exact one_lt_pow ha two_ne_zero,
+end
+
+/-- If a solution has `x > 1`, then `d` is not a square. -/
+lemma d_nonsquare_of_one_lt_x {a : solution₁ d} (ha : 1 < a.x) : ¬ is_square d :=
+begin
+  have hp := a.prop,
+  rintros ⟨b, rfl⟩,
+  simp_rw [← sq, ← mul_pow, sq_sub_sq, int.mul_eq_one_iff_eq_one_or_neg_one] at hp,
+  rcases hp with ⟨hp₁, hp₂⟩ | ⟨hp₁, hp₂⟩; linarith [ha, hp₁, hp₂],
+end
+
+/-- A solution with `x = 1` is trivial. -/
+lemma eq_one_of_x_eq_one (h₀ : d ≠ 0) {a : solution₁ d} (ha : a.x = 1) : a = 1 :=
+begin
+  have prop := a.prop_y,
+  rw [ha, one_pow, sub_self, mul_eq_zero, or_iff_right h₀, sq_eq_zero_iff] at prop,
+  exact ext ha prop,
+end
+
+/-- A solution is `1` or `-1` if and only if `y = 0`. -/
+lemma eq_one_or_neg_one_iff_y_eq_zero {a : solution₁ d} : a = 1 ∨ a = -1 ↔ a.y = 0 :=
+begin
+  refine ⟨λ H, H.elim (λ h, by simp [h]) (λ h, by simp [h]), λ H, _⟩,
+  have prop := a.prop,
+  rw [H, sq (0 : ℤ), mul_zero, mul_zero, sub_zero, sq_eq_one_iff] at prop,
+  exact prop.imp (λ h, ext h H) (λ h, ext h H),
+end
+
+/-- The set of solutions with `x > 0` is closed under multiplication. -/
+lemma x_mul_pos {a b : solution₁ d} (ha : 0 < a.x) (hb : 0 < b.x) : 0 < (a * b).x :=
+begin
+  simp only [x_mul],
+  refine neg_lt_iff_pos_add'.mp (abs_lt.mp _).1,
+  rw [← abs_of_pos ha, ← abs_of_pos hb, ← abs_mul, ← sq_lt_sq, mul_pow a.x, a.prop_x, b.prop_x,
+      ← sub_pos],
+  ring_nf,
+  cases le_or_lt 0 d with h h,
+  { positivity, },
+  { rw [(eq_zero_of_d_neg h a).resolve_left ha.ne', (eq_zero_of_d_neg h b).resolve_left hb.ne',
+        zero_pow two_pos, zero_add, zero_mul, zero_add],
+    exact one_pos, },
+end
+
+/-- The set of solutions with `x` and `y` positive is closed under multiplication. -/
+lemma y_mul_pos {a b : solution₁ d} (hax : 0 < a.x) (hay : 0 < a.y) (hbx : 0 < b.x)
+  (hby : 0 < b.y) :
+  0 < (a * b).y :=
+begin
+  simp only [y_mul],
+  positivity,
+end
+
+/-- If `(x, y)` is a solution with `x` positive, then all its powers with natural exponents
+have positive `x`. -/
+lemma x_pow_pos {a : solution₁ d} (hax : 0 < a.x) (n : ℕ) : 0 < (a ^ n).x :=
+begin
+  induction n with n ih,
+  { simp only [pow_zero, x_one, zero_lt_one], },
+  { rw [pow_succ],
+    exact x_mul_pos hax ih, }
+end
+
+/-- If `(x, y)` is a solution with `x` and `y` positive, then all its powers with positive
+natural exponents have positive `y`. -/
+lemma y_pow_succ_pos {a : solution₁ d} (hax : 0 < a.x) (hay : 0 < a.y) (n : ℕ) :
+  0 < (a ^ n.succ).y :=
+begin
+  induction n with n ih,
+  { simp only [hay, pow_one], },
+  { rw [pow_succ],
+    exact y_mul_pos hax hay (x_pow_pos hax _) ih, }
+end
+
+/-- If `(x, y)` is a solution with `x` and `y` positive, then all its powers with positive
+exponents have positive `y`. -/
+lemma y_zpow_pos {a : solution₁ d} (hax : 0 < a.x) (hay : 0 < a.y) {n : ℤ} (hn : 0 < n) :
+  0 < (a ^ n).y :=
+begin
+  lift n to ℕ using hn.le,
+  norm_cast at hn ⊢,
+  rw ← nat.succ_pred_eq_of_pos hn,
+  exact y_pow_succ_pos hax hay _,
+end
+
+/-- If `(x, y)` is a solution with `x` positive, then all its powers have positive `x`. -/
+lemma x_zpow_pos {a : solution₁ d} (hax : 0 < a.x) (n : ℤ) : 0 < (a ^ n).x :=
+begin
+  cases n,
+  { rw zpow_of_nat,
+    exact x_pow_pos hax n },
+  { rw zpow_neg_succ_of_nat,
+    exact x_pow_pos hax (n + 1) },
+end
+
+/-- If `(x, y)` is a solution with `x` and `y` positive, then the `y` component of any power
+has the same sign as the exponent. -/
+lemma sign_y_zpow_eq_sign_of_x_pos_of_y_pos {a : solution₁ d} (hax : 0 < a.x) (hay : 0 < a.y)
+  (n : ℤ) :
+  (a ^ n).y.sign = n.sign :=
+begin
+  rcases n with (_ | _) | _,
+  { refl },
+  { rw zpow_of_nat,
+    exact int.sign_eq_one_of_pos (y_pow_succ_pos hax hay n) },
+  { rw zpow_neg_succ_of_nat,
+    exact int.sign_eq_neg_one_of_neg (neg_neg_of_pos (y_pow_succ_pos hax hay n)) },
+end
+
+/-- If `a` is any solution, then one of `a`, `a⁻¹`, `-a`, `-a⁻¹` has
+positive `x` and nonnegative `y`. -/
+lemma exists_pos_variant (h₀ : 0 < d) (a : solution₁ d) :
+  ∃ b : solution₁ d, 0 < b.x ∧ 0 ≤ b.y ∧ a ∈ ({b, b⁻¹, -b, -b⁻¹} : set (solution₁ d)) :=
+begin
+  refine (lt_or_gt_of_ne (a.x_ne_zero h₀.le)).elim
+           ((le_total 0 a.y).elim (λ hy hx, ⟨-a⁻¹, _, _, _⟩) (λ hy hx, ⟨-a, _, _, _⟩))
+           ((le_total 0 a.y).elim (λ hy hx, ⟨a, hx, hy, _⟩) (λ hy hx, ⟨a⁻¹, hx, _, _⟩));
+      simp only [neg_neg, inv_inv, neg_inv, set.mem_insert_iff, set.mem_singleton_iff, true_or,
+                 eq_self_iff_true, x_neg, x_inv, y_neg, y_inv, neg_pos, neg_nonneg, or_true];
+      assumption,
+end
+
+end solution₁
+
+section existence
+
+/-!
+### Existence of nontrivial solutions
+-/
+
+variables {d : ℤ}
+
+open set real
+
+/-- If `d` is a positive integer that is not a square, then there is a nontrivial solution
+to the Pell equation `x^2 - d*y^2 = 1`. -/
+theorem exists_of_not_is_square (h₀ : 0 < d) (hd : ¬ is_square d) :
+  ∃ x y : ℤ, x ^ 2 - d * y ^ 2 = 1 ∧ y ≠ 0 :=
+begin
+  let ξ : ℝ := sqrt d,
+  have hξ : irrational ξ,
+  { refine irrational_nrt_of_notint_nrt 2 d (sq_sqrt $ int.cast_nonneg.mpr h₀.le) _ two_pos,
+    rintro ⟨x, hx⟩,
+    refine hd ⟨x, @int.cast_injective ℝ _ _ d (x * x) _⟩,
+    rw [← sq_sqrt $ int.cast_nonneg.mpr h₀.le, int.cast_mul, ← hx, sq], },
+  obtain ⟨M, hM₁⟩ := exists_int_gt (2 * |ξ| + 1),
+  have hM : {q : ℚ | |q.1 ^ 2 - d * q.2 ^ 2| < M}.infinite,
+  { refine infinite.mono (λ q h, _) (infinite_rat_abs_sub_lt_one_div_denom_sq_of_irrational hξ),
+    have h0 : 0 < (q.2 : ℝ) ^ 2 := pow_pos (nat.cast_pos.mpr q.pos) 2,
+    have h1 : (q.num : ℝ) / (q.denom : ℝ) = q := by exact_mod_cast q.num_div_denom,
+    rw [mem_set_of, abs_sub_comm, ← @int.cast_lt ℝ, ← div_lt_div_right (abs_pos_of_pos h0)],
+    push_cast,
+    rw [← abs_div, abs_sq, sub_div, mul_div_cancel _ h0.ne',
+        ← div_pow, h1, ← sq_sqrt (int.cast_pos.mpr h₀).le, sq_sub_sq, abs_mul, ← mul_one_div],
+    refine mul_lt_mul'' (((abs_add ξ q).trans _).trans_lt hM₁) h (abs_nonneg _) (abs_nonneg _),
+    rw [two_mul, add_assoc, add_le_add_iff_left, ← sub_le_iff_le_add'],
+    rw [mem_set_of, abs_sub_comm] at h,
+    refine (abs_sub_abs_le_abs_sub (q : ℝ) ξ).trans (h.le.trans _),
+    rw [div_le_one h0, one_le_sq_iff_one_le_abs, nat.abs_cast, nat.one_le_cast],
+    exact q.pos, },
+  obtain ⟨m, hm⟩ : ∃ m : ℤ, {q : ℚ | q.1 ^ 2 - d * q.2 ^ 2 = m}.infinite,
+  { contrapose! hM,
+    simp only [not_infinite] at hM ⊢,
+    refine (congr_arg _ (ext (λ x, _))).mp (finite.bUnion (finite_Ioo (-M) M) (λ m _, hM m)),
+    simp only [abs_lt, mem_set_of_eq, mem_Ioo, mem_Union, exists_prop, exists_eq_right'], },
+  have hm₀ : m ≠ 0,
+  { rintro rfl,
+    obtain ⟨q, hq⟩ := hm.nonempty,
+    rw [mem_set_of, sub_eq_zero, mul_comm] at hq,
+    obtain ⟨a, ha⟩ := (int.pow_dvd_pow_iff two_pos).mp ⟨d, hq⟩,
+    rw [ha, mul_pow, mul_right_inj' (pow_pos (int.coe_nat_pos.mpr q.pos) 2).ne'] at hq,
+    exact hd ⟨a, sq a ▸ hq.symm⟩, },
+  haveI := ne_zero_iff.mpr (int.nat_abs_ne_zero.mpr hm₀),
+  let f : ℚ → (zmod m.nat_abs) × (zmod m.nat_abs) := λ q, (q.1, q.2),
+  obtain ⟨q₁, h₁ : q₁.1 ^ 2 - d * q₁.2 ^ 2 = m, q₂, h₂ : q₂.1 ^ 2 - d * q₂.2 ^ 2 = m, hne, hqf⟩ :=
+    hm.exists_ne_map_eq_of_maps_to (maps_to_univ f _) finite_univ,
+  obtain ⟨hq1 : (q₁.1 : zmod m.nat_abs) = q₂.1, hq2 : (q₁.2 : zmod m.nat_abs) = q₂.2⟩ :=
+    prod.ext_iff.mp hqf,
+  have hd₁ : m ∣ q₁.1 * q₂.1 - d * (q₁.2 * q₂.2),
+  { rw [← int.nat_abs_dvd, ← zmod.int_coe_zmod_eq_zero_iff_dvd],
+    push_cast,
+    rw [hq1, hq2, ← sq, ← sq],
+    norm_cast,
+    rw [zmod.int_coe_zmod_eq_zero_iff_dvd, int.nat_abs_dvd, nat.cast_pow, ← h₂], },
+  have hd₂ : m ∣ q₁.1 * q₂.2 - q₂.1 * q₁.2,
+  { rw [← int.nat_abs_dvd, ← zmod.int_coe_eq_int_coe_iff_dvd_sub],
+    push_cast,
+    rw [hq1, hq2], },
+  replace hm₀ : (m : ℚ) ≠ 0 := int.cast_ne_zero.mpr hm₀,
+  refine ⟨(q₁.1 * q₂.1 - d * (q₁.2 * q₂.2)) / m, (q₁.1 * q₂.2 - q₂.1 * q₁.2) / m, _, _⟩,
+  { qify [hd₁, hd₂],
+    field_simp [hm₀],
+    norm_cast,
+    conv_rhs {congr, rw sq, congr, rw ← h₁, skip, rw ← h₂},
+    push_cast,
+    ring, },
+  { qify [hd₂],
+    refine div_ne_zero_iff.mpr ⟨_, hm₀⟩,
+    exact_mod_cast mt sub_eq_zero.mp (mt rat.eq_iff_mul_eq_mul.mpr hne), },
+end
+
+/-- If `d` is a positive integer, then there is a nontrivial solution
+to the Pell equation `x^2 - d*y^2 = 1` if and only if `d` is not a square. -/
+theorem exists_iff_not_is_square (h₀ : 0 < d) :
+  (∃ x y : ℤ, x ^ 2 - d * y ^ 2 = 1 ∧ y ≠ 0) ↔ ¬ is_square d :=
+begin
+  refine ⟨_, exists_of_not_is_square h₀⟩,
+  rintros ⟨x, y, hxy, hy⟩ ⟨a, rfl⟩,
+  rw [← sq, ← mul_pow, sq_sub_sq] at hxy,
+  simpa [mul_self_pos.mp h₀, sub_eq_add_neg, eq_neg_self_iff] using int.eq_of_mul_eq_one hxy,
+end
+
+namespace solution₁
+
+/-- If `d` is a positive integer that is not a square, then there exists a nontrivial solution
+to the Pell equation `x^2 - d*y^2 = 1`. -/
+theorem exists_nontrivial_of_not_is_square (h₀ : 0 < d) (hd : ¬ is_square d) :
+  ∃ a : solution₁ d, a ≠ 1 ∧ a ≠ -1 :=
+begin
+  obtain ⟨x, y, prop, hy⟩ := exists_of_not_is_square h₀ hd,
+  refine ⟨mk x y prop, λ H, _, λ H, _⟩; apply_fun solution₁.y at H; simpa only [hy] using H,
+end
+
+/-- If `d` is a positive integer that is not a square, then there exists a solution
+to the Pell equation `x^2 - d*y^2 = 1` with `x > 1` and `y > 0`. -/
+lemma exists_pos_of_not_is_square (h₀ : 0 < d) (hd : ¬ is_square d) :
+  ∃ a : solution₁ d, 1 < a.x ∧ 0 < a.y :=
+begin
+  obtain ⟨x, y, h, hy⟩ := exists_of_not_is_square h₀ hd,
+  refine ⟨mk (|x|) (|y|) (by rwa [sq_abs, sq_abs]), _, abs_pos.mpr hy⟩,
+  rw [x_mk, ← one_lt_sq_iff_one_lt_abs, eq_add_of_sub_eq h, lt_add_iff_pos_right],
+  exact mul_pos h₀ (sq_pos_of_ne_zero y hy),
+end
+
+end solution₁
+
+end existence
+
+/-! ### Fundamental solutions
+
+We define the notion of a *fundamental solution* of Pell's equation and
+show that it exists and is unique (when `d` is positive and non-square)
+and generates the group of solutions up to sign.
+-/
+
+variables {d : ℤ}
+
+/-- We define a solution to be *fundamental* if it has `x > 1` and `y > 0`
+and its `x` is the smallest possible among solutions with `x > 1`. -/
+def is_fundamental (a : solution₁ d) : Prop :=
+1 < a.x ∧ 0 < a.y ∧ ∀ {b : solution₁ d}, 1 < b.x → a.x ≤ b.x
+
+namespace is_fundamental
+
+open solution₁
 
-include a1
-private def d := a*a - 1
+/-- A fundamental solution has positive `x`. -/
+lemma x_pos {a : solution₁ d} (h : is_fundamental a) : 0 < a.x := zero_lt_one.trans h.1
 
-@[simp] theorem d_pos : 0 < d :=
-tsub_pos_of_lt (mul_lt_mul a1 (le_of_lt a1) dec_trivial dec_trivial : 1*1 rw ← int.coe_nat_mul at h};
-    exact int.coe_nat_inj h
-
-theorem yn_add (m n) : yn (m + n) = xn m * yn n + yn m * xn n :=
-by injection (pell_zd_add _ m n) with _ h;
-    repeat {rw ← int.coe_nat_add at h <|> rw ← int.coe_nat_mul at h};
-    exact int.coe_nat_inj h
-
-theorem pell_zd_sub {m n} (h : n ≤ m) : pell_zd (m - n) = pell_zd m * (pell_zd n).conj :=
-let t := pell_zd_add n (m - n) in
-by rw [add_tsub_cancel_of_le h] at t;
-    rw [t, mul_comm (pell_zd _ n) _, mul_assoc, (is_pell_norm _).1 (is_pell_pell_zd _ _), mul_one]
-
-theorem xz_sub {m n} (h : n ≤ m) : xz (m - n) = xz m * xz n - d * yz m * yz n :=
-by { rw [sub_eq_add_neg, ←mul_neg], exact congr_arg zsqrtd.re (pell_zd_sub a1 h) }
-
-theorem yz_sub {m n} (h : n ≤ m) : yz (m - n) = xz n * yz m - xz m * yz n :=
-by { rw [sub_eq_add_neg, ←mul_neg, mul_comm, add_comm],
-  exact congr_arg zsqrtd.im (pell_zd_sub a1 h) }
-
-theorem xy_coprime (n) : (xn n).coprime (yn n) :=
-nat.coprime_of_dvd' $ λk kp kx ky,
-let p := pell_eq n in by rw ← p; exact
-nat.dvd_sub (le_of_lt $ nat.lt_of_sub_eq_succ p)
-  (kx.mul_left _) (ky.mul_left _)
-
-theorem strict_mono_y : strict_mono yn
-| m 0     h := absurd h $ nat.not_lt_zero _
-| m (n+1) h :=
-  have yn m ≤ yn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
-    (λhl, le_of_lt $ strict_mono_y hl) (λe, by rw e),
-  by simp; refine lt_of_le_of_lt _ (nat.lt_add_of_pos_left $ x_pos a1 n);
-      rw ← mul_one (yn a1 m);
-      exact mul_le_mul this (le_of_lt a1) (nat.zero_le _) (nat.zero_le _)
-
-theorem strict_mono_x : strict_mono xn
-| m 0     h := absurd h $ nat.not_lt_zero _
-| m (n+1) h :=
-  have xn m ≤ xn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
-    (λhl, le_of_lt $ strict_mono_x hl) (λe, by rw e),
-  by simp; refine lt_of_lt_of_le (lt_of_le_of_lt this _) (nat.le_add_right _ _);
-      have t := nat.mul_lt_mul_of_pos_left a1 (x_pos a1 n); rwa mul_one at t
-
-theorem yn_ge_n : Π n, n ≤ yn n
-| 0 := nat.zero_le _
-| (n+1) := show n < yn (n+1), from lt_of_le_of_lt (yn_ge_n n) (strict_mono_y $ nat.lt_succ_self n)
-
-theorem y_mul_dvd (n) : ∀k, yn n ∣ yn (n * k)
-| 0     := dvd_zero _
-| (k+1) := by rw [nat.mul_succ, yn_add]; exact
-  dvd_add (dvd_mul_left _ _) ((y_mul_dvd k).mul_right _)
-
-theorem y_dvd_iff (m n) : yn m ∣ yn n ↔ m ∣ n :=
-⟨λh, nat.dvd_of_mod_eq_zero $ (nat.eq_zero_or_pos _).resolve_right $ λhp,
-  have co : nat.coprime (yn m) (xn (m * (n / m))), from nat.coprime.symm $
-    (xy_coprime _).coprime_dvd_right (y_mul_dvd m (n / m)),
-  have m0 : 0 < m, from m.eq_zero_or_pos.resolve_left $
-    λe, by rw [e, nat.mod_zero] at hp; rw [e] at h; exact
-    ne_of_lt (strict_mono_y a1 hp) (eq_zero_of_zero_dvd h).symm,
-  by rw [← nat.mod_add_div n m, yn_add] at h; exact
-  not_le_of_gt (strict_mono_y _ $ nat.mod_lt n m0)
-    (nat.le_of_dvd (strict_mono_y _ hp) $ co.dvd_of_dvd_mul_right $
-    (nat.dvd_add_iff_right $ (y_mul_dvd _ _ _).mul_left _).2 h),
-λ⟨k, e⟩, by rw e; apply y_mul_dvd⟩
-
-theorem xy_modeq_yn (n) :
-  ∀ k, xn (n * k) ≡ (xn n)^k [MOD (yn n)^2]
-    ∧ yn (n * k) ≡ k * (xn n)^(k-1) * yn n [MOD (yn n)^3]
-| 0     := by constructor; simp
-| (k+1) :=
-  let ⟨hx, hy⟩ := xy_modeq_yn k in
-  have L : xn (n * k) * xn n + d * yn (n * k) * yn n ≡ xn n^k * xn n + 0 [MOD yn n^2], from
-    (hx.mul_right _ ).add $ modeq_zero_iff_dvd.2 $
-    by rw pow_succ'; exact
-    mul_dvd_mul_right (dvd_mul_of_dvd_right (modeq_zero_iff_dvd.1 $
-      (hy.modeq_of_dvd $ by simp [pow_succ']).trans $ modeq_zero_iff_dvd.2 $
-      by simp [-mul_comm, -mul_assoc]) _) _,
-  have R : xn (n * k) * yn n + yn (n * k) * xn n ≡
-            xn n^k * yn n + k * xn n^k * yn n [MOD yn n^3], from
-  modeq.add (by { rw pow_succ', exact hx.mul_right' _ }) $
-    have k * xn n^(k - 1) * yn n * xn n = k * xn n^k * yn n,
-      by clear _let_match; cases k with k; simp [pow_succ', mul_comm, mul_left_comm],
-    by { rw ← this, exact hy.mul_right _ },
-  by { rw [add_tsub_cancel_right, nat.mul_succ, xn_add, yn_add, pow_succ' (xn _ n),
-          nat.succ_mul, add_comm (k * xn _ n^k) (xn _ n^k), right_distrib],
-      exact ⟨L, R⟩ }
-
-theorem ysq_dvd_yy (n) : yn n * yn n ∣ yn (n * yn n) :=
-modeq_zero_iff_dvd.1 $
-  ((xy_modeq_yn n (yn n)).right.modeq_of_dvd $ by simp [pow_succ]).trans
-  (modeq_zero_iff_dvd.2 $ by simp [mul_dvd_mul_left, mul_assoc])
-
-theorem dvd_of_ysq_dvd {n t} (h : yn n * yn n ∣ yn t) : yn n ∣ t :=
-have nt : n ∣ t, from (y_dvd_iff n t).1 $ dvd_of_mul_left_dvd h,
-n.eq_zero_or_pos.elim (λ n0, by rwa n0 at ⊢ nt) $ λ (n0l : 0 < n),
-let ⟨k, ke⟩ := nt in
-have yn n ∣ k * (xn n)^(k-1), from
-nat.dvd_of_mul_dvd_mul_right (strict_mono_y n0l) $ modeq_zero_iff_dvd.1 $
-  by have xm := (xy_modeq_yn a1 n k).right; rw ← ke at xm; exact
-  (xm.modeq_of_dvd $ by simp [pow_succ]).symm.trans h.modeq_zero_nat,
-by rw ke; exact dvd_mul_of_dvd_right
-  (((xy_coprime _ _).pow_left _).symm.dvd_of_dvd_mul_right this) _
-
-theorem pell_zd_succ_succ (n) : pell_zd (n + 2) + pell_zd n = (2 * a : ℕ) * pell_zd (n + 1) :=
-have (1:ℤ√d) + ⟨a, 1⟩ * ⟨a, 1⟩ = ⟨a, 1⟩ * (2 * a),
-by { rw zsqrtd.coe_nat_val, change (⟨_,_⟩:ℤ√(d a1))=⟨_,_⟩,
-    rw dz_val, dsimp [az], rw zsqrtd.ext, dsimp, split; ring },
-by simpa [mul_add, mul_comm, mul_left_comm, add_comm] using congr_arg (* pell_zd a1 n) this
-
-theorem xy_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) ∧
-                            yn (n + 2) + yn n = (2 * a) * yn (n + 1) := begin
-  have := pell_zd_succ_succ a1 n, unfold pell_zd at this,
-  rw [← int.cast_coe_nat, zsqrtd.smul_val] at this,
-  injection this with h₁ h₂,
-  split; apply int.coe_nat_inj; [simpa using h₁, simpa using h₂]
-end
-
-theorem xn_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) := (xy_succ_succ n).1
-theorem yn_succ_succ (n) : yn (n + 2) + yn n = (2 * a) * yn (n + 1) := (xy_succ_succ n).2
-
-theorem xz_succ_succ (n) : xz (n + 2) = (2 * a : ℕ) * xz (n + 1) - xz n :=
-eq_sub_of_add_eq $ by delta xz; rw [← int.coe_nat_add, ← int.coe_nat_mul, xn_succ_succ]
-
-theorem yz_succ_succ (n) : yz (n + 2) = (2 * a : ℕ) * yz (n + 1) - yz n :=
-eq_sub_of_add_eq $ by delta yz; rw [← int.coe_nat_add, ← int.coe_nat_mul, yn_succ_succ]
-
-theorem yn_modeq_a_sub_one : ∀ n, yn n ≡ n [MOD a-1]
-| 0 := by simp
-| 1 := by simp
-| (n+2) := (yn_modeq_a_sub_one n).add_right_cancel $
-  begin
-    rw [yn_succ_succ, (by ring : n + 2 + n = 2 * (n + 1))],
-    exact ((modeq_sub a1.le).mul_left 2).mul (yn_modeq_a_sub_one (n+1)),
-  end
-
-theorem yn_modeq_two : ∀ n, yn n ≡ n [MOD 2]
-| 0 := by simp
-| 1 := by simp
-| (n+2) := (yn_modeq_two n).add_right_cancel $
-  begin
-    rw [yn_succ_succ, mul_assoc, (by ring : n + 2 + n = 2 * (n + 1))],
-    exact (dvd_mul_right 2 _).modeq_zero_nat.trans (dvd_mul_right 2 _).zero_modeq_nat,
-  end
-
-section
-
-omit a1
-lemma x_sub_y_dvd_pow_lem (y2 y1 y0 yn1 yn0 xn1 xn0 ay a2 : ℤ) :
-  (a2 * yn1 - yn0) * ay + y2 - (a2 * xn1 - xn0) =
-    y2 - a2 * y1 + y0 + a2 * (yn1 * ay + y1 - xn1) - (yn0 * ay + y0 - xn0) := by ring
-
-end
-
-theorem x_sub_y_dvd_pow (y : ℕ) :
-  ∀ n, (2*a*y - y*y - 1 : ℤ) ∣ yz n * (a - y) + ↑(y^n) - xz n
-| 0 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
-| 1 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
-| (n+2) :=
-  have (2*a*y - y*y - 1 : ℤ) ∣ ↑(y^(n + 2)) - ↑(2 * a) * ↑(y^(n + 1)) + ↑(y^n), from
-  ⟨-↑(y^n), by { simp [pow_succ, mul_add, int.coe_nat_mul,
-      show ((2:ℕ):ℤ) = 2, from rfl, mul_comm, mul_left_comm], ring }⟩,
-  by { rw [xz_succ_succ, yz_succ_succ, x_sub_y_dvd_pow_lem ↑(y^(n+2)) ↑(y^(n+1)) ↑(y^n)],
-  exact
-    dvd_sub (dvd_add this $ (x_sub_y_dvd_pow (n+1)).mul_left _) (x_sub_y_dvd_pow n) }
-
-theorem xn_modeq_x2n_add_lem (n j) : xn n ∣ d * yn n * (yn n * xn j) + xn j :=
-have h1 : d * yn n * (yn n * xn j) + xn j = (d * yn n * yn n + 1) * xn j,
-  by simp [add_mul, mul_assoc],
-have h2 : d * yn n * yn n + 1 = xn n * xn n, by apply int.coe_nat_inj;
-  repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul}; exact
-  add_eq_of_eq_sub' (eq.symm $ pell_eqz _ _),
-by rw h2 at h1; rw [h1, mul_assoc]; exact dvd_mul_right _ _
-
-theorem xn_modeq_x2n_add (n j) : xn (2 * n + j) + xn j ≡ 0 [MOD xn n] :=
-begin
-  rw [two_mul, add_assoc, xn_add, add_assoc, ←zero_add 0],
-  refine (dvd_mul_right (xn a1 n) (xn a1 (n + j))).modeq_zero_nat.add _,
-  rw [yn_add, left_distrib, add_assoc, ←zero_add 0],
-  exact ((dvd_mul_right _ _).mul_left _).modeq_zero_nat.add
-    (xn_modeq_x2n_add_lem _ _ _).modeq_zero_nat,
-end
-
-lemma xn_modeq_x2n_sub_lem {n j} (h : j ≤ n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
-have h1 : xz n ∣ ↑d * yz n * yz (n - j) + xz j,
-  by rw [yz_sub _ h, mul_sub_left_distrib, sub_add_eq_add_sub]; exact
-dvd_sub
-  (by delta xz; delta yz;
-      repeat {rw ← int.coe_nat_add <|> rw ← int.coe_nat_mul}; rw mul_comm (xn a1 j) (yn a1 n);
-      exact int.coe_nat_dvd.2 (xn_modeq_x2n_add_lem _ _ _))
-  ((dvd_mul_right _ _).mul_left _),
-begin
-  rw [two_mul, add_tsub_assoc_of_le h, xn_add, add_assoc, ←zero_add 0],
-  exact (dvd_mul_right _ _).modeq_zero_nat.add
-    (int.coe_nat_dvd.1 $ by simpa [xz, yz] using h1).modeq_zero_nat,
-end
-
-theorem xn_modeq_x2n_sub {n j} (h : j ≤ 2 * n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
-(le_total j n).elim xn_modeq_x2n_sub_lem
-  (λjn, have 2 * n - j + j ≤ n + j, by rw [tsub_add_cancel_of_le h, two_mul];
-    exact nat.add_le_add_left jn _,
-    let t := xn_modeq_x2n_sub_lem (nat.le_of_add_le_add_right this) in
-      by rwa [tsub_tsub_cancel_of_le h, add_comm] at t)
-
-theorem xn_modeq_x4n_add (n j) : xn (4 * n + j) ≡ xn j [MOD xn n] :=
-modeq.add_right_cancel' (xn (2 * n + j)) $
-by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_add _ _ _).symm);
-    rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_assoc]; apply xn_modeq_x2n_add
-
-theorem xn_modeq_x4n_sub {n j} (h : j ≤ 2 * n) : xn (4 * n - j) ≡ xn j [MOD xn n] :=
-have h' : j ≤ 2*n, from le_trans h (by rw nat.succ_mul; apply nat.le_add_left),
-modeq.add_right_cancel' (xn (2 * n - j)) $
-by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_sub _ h).symm);
-    rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_tsub_assoc_of_le h'];
-      apply xn_modeq_x2n_add
-
-theorem eq_of_xn_modeq_lem1 {i n} : Π {j}, i < j → j < n → xn i % xn n < xn j % xn n
-| 0     ij _  := absurd ij (nat.not_lt_zero _)
-| (j+1) ij jn :=
-    suffices xn j % xn n < xn (j + 1) % xn n, from
-    (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
-      (λh, lt_trans (eq_of_xn_modeq_lem1 h (le_of_lt jn)) this)
-      (λh, by rw h; exact this),
-  by rw [nat.mod_eq_of_lt (strict_mono_x _ (nat.lt_of_succ_lt jn)),
-          nat.mod_eq_of_lt (strict_mono_x _ jn)];
-      exact strict_mono_x _ (nat.lt_succ_self _)
-
-theorem eq_of_xn_modeq_lem2 {n} (h : 2 * xn n = xn (n + 1)) : a = 2 ∧ n = 0 :=
-by rw [xn_succ, mul_comm] at h; exact
-have n = 0, from n.eq_zero_or_pos.resolve_right $ λnp,
-  ne_of_lt (lt_of_le_of_lt (nat.mul_le_mul_left _ a1)
-    (nat.lt_add_of_pos_right $ mul_pos (d_pos a1) (strict_mono_y a1 np))) h,
-by cases this; simp at h; exact ⟨h.symm, rfl⟩
-
-theorem eq_of_xn_modeq_lem3 {i n} (npos : 0 < n) :
-  Π {j}, i < j → j ≤ 2 * n → j ≠ n → ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2) → xn i % xn n < xn j % xn n
-| 0     ij _   _   _     := absurd ij (nat.not_lt_zero _)
-| (j+1) ij j2n jnn ntriv :=
-  have lem2 : ∀k > n, k ≤ 2*n → (↑(xn k % xn n) : ℤ) = xn n - xn (2 * n - k), from λk kn k2n,
-    let k2nl := lt_of_add_lt_add_right $ show 2*n-k+k < n+k, by
-      {rw tsub_add_cancel_of_le, rw two_mul; exact (add_lt_add_left kn n), exact k2n } in
-    have xle : xn (2 * n - k) ≤ xn n, from le_of_lt $ strict_mono_x k2nl,
-    suffices xn k % xn n = xn n - xn (2 * n - k), by rw [this, int.coe_nat_sub xle],
-    by
-    { rw ← nat.mod_eq_of_lt (nat.sub_lt (x_pos a1 n) (x_pos a1 (2 * n - k))),
-      apply modeq.add_right_cancel' (xn a1 (2 * n - k)),
-      rw [tsub_add_cancel_of_le xle],
-      have t := xn_modeq_x2n_sub_lem a1 k2nl.le,
-      rw tsub_tsub_cancel_of_le k2n at t,
-      exact t.trans dvd_rfl.zero_modeq_nat },
-  (lt_trichotomy j n).elim
-  (λ (jn : j < n), eq_of_xn_modeq_lem1 ij (lt_of_le_of_ne jn jnn)) $ λ o, o.elim
-  (λ (jn : j = n), by
-  { cases jn,
-    apply int.lt_of_coe_nat_lt_coe_nat,
-    rw [lem2 (n+1) (nat.lt_succ_self _) j2n,
-        show 2 * n - (n + 1) = n - 1, by rw[two_mul, tsub_add_eq_tsub_tsub, add_tsub_cancel_right]],
-    refine lt_sub_left_of_add_lt (int.coe_nat_lt_coe_nat_of_lt _),
-    cases (lt_or_eq_of_le $ nat.le_of_succ_le_succ ij) with lin ein,
-    { rw nat.mod_eq_of_lt (strict_mono_x _ lin),
-      have ll : xn a1 (n-1) + xn a1 (n-1) ≤ xn a1 n,
-      { rw [← two_mul, mul_comm, show xn a1 n = xn a1 (n-1+1),
-                                  by rw [tsub_add_cancel_of_le (succ_le_of_lt npos)], xn_succ],
-        exact le_trans (nat.mul_le_mul_left _ a1) (nat.le_add_right _ _) },
-      have npm : (n-1).succ = n := nat.succ_pred_eq_of_pos npos,
-      have il : i ≤ n - 1, { apply nat.le_of_succ_le_succ, rw npm, exact lin },
-      cases lt_or_eq_of_le il with ill ile,
-      { exact lt_of_lt_of_le (nat.add_lt_add_left (strict_mono_x a1 ill) _) ll },
-      { rw ile,
-        apply lt_of_le_of_ne ll,
-        rw ← two_mul,
-        exact λe, ntriv $
-          let ⟨a2, s1⟩ := @eq_of_xn_modeq_lem2 _ a1 (n-1)
-            (by rwa [tsub_add_cancel_of_le (succ_le_of_lt npos)]) in
-          have n1 : n = 1, from le_antisymm (tsub_eq_zero_iff_le.mp s1) npos,
-          by rw [ile, a2, n1]; exact ⟨rfl, rfl, rfl, rfl⟩ } },
-    { rw [ein, nat.mod_self, add_zero],
-      exact strict_mono_x _ (nat.pred_lt npos.ne') } })
-  (λ (jn : j > n),
-    have lem1 : j ≠ n → xn j % xn n < xn (j + 1) % xn n → xn i % xn n < xn (j + 1) % xn n,
-      from λjn s,
-    (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
-      (λh, lt_trans (eq_of_xn_modeq_lem3 h (le_of_lt j2n) jn $ λ⟨a1, n1, i0, j2⟩,
-        by rw [n1, j2] at j2n; exact absurd j2n dec_trivial) s)
-      (λh, by rw h; exact s),
-    lem1 (ne_of_gt jn) $ int.lt_of_coe_nat_lt_coe_nat $ by
-    { rw [lem2 j jn (le_of_lt j2n), lem2 (j+1) (nat.le_succ_of_le jn) j2n],
-      refine sub_lt_sub_left (int.coe_nat_lt_coe_nat_of_lt $ strict_mono_x _ _) _,
-      rw [nat.sub_succ],
-      exact nat.pred_lt (ne_of_gt $ tsub_pos_of_lt j2n) })
-
-theorem eq_of_xn_modeq_le {i j n} (ij : i ≤ j) (j2n : j ≤ 2 * n)
-  (h : xn i ≡ xn j [MOD xn n]) (ntriv : ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2)) : i = j :=
-if npos : n = 0 then by simp [*] at * else
-(lt_or_eq_of_le ij).resolve_left $ λij',
-if jn : j = n then by
-{ refine ne_of_gt _ h,
-  rw [jn, nat.mod_self],
-  have x0 : 0 < xn a1 0 % xn a1 n :=
-    by rw [nat.mod_eq_of_lt (strict_mono_x a1 (nat.pos_of_ne_zero npos))]; exact dec_trivial,
-  cases i with i, exact x0,
-  rw jn at ij',
-  exact x0.trans (eq_of_xn_modeq_lem3 _ (nat.pos_of_ne_zero npos) (nat.succ_pos _)
-    (le_trans ij j2n) (ne_of_lt ij') $
-    λ⟨a1, n1, _, i2⟩, by rw [n1, i2] at ij'; exact absurd ij' dec_trivial) }
-else ne_of_lt (eq_of_xn_modeq_lem3 (nat.pos_of_ne_zero npos) ij' j2n jn ntriv) h
-
-theorem eq_of_xn_modeq {i j n} (i2n : i ≤ 2 * n) (j2n : j ≤ 2 * n)
-  (h : xn i ≡ xn j [MOD xn n]) (ntriv : a = 2 → n = 1 → (i = 0 → j ≠ 2) ∧ (i = 2 → j ≠ 0)) :
-  i = j :=
-(le_total i j).elim
-  (λij, eq_of_xn_modeq_le ij j2n h $ λ⟨a2, n1, i0, j2⟩, (ntriv a2 n1).left i0 j2)
-  (λij, (eq_of_xn_modeq_le ij i2n h.symm $ λ⟨a2, n1, j0, i2⟩,
-    (ntriv a2 n1).right i2 j0).symm)
-
-theorem eq_of_xn_modeq' {i j n} (ipos : 0 < i) (hin : i ≤ n) (j4n : j ≤ 4 * n)
-  (h : xn j ≡ xn i [MOD xn n]) : j = i ∨ j + i = 4 * n :=
-have i2n : i ≤ 2*n, by apply le_trans hin; rw two_mul; apply nat.le_add_left,
-(le_or_gt j (2 * n)).imp
-  (λj2n : j ≤ 2 * n, eq_of_xn_modeq j2n i2n h $
-    λa2 n1, ⟨λj0 i2, by rw [n1, i2] at hin; exact absurd hin dec_trivial,
-              λj2 i0, ne_of_gt ipos i0⟩)
-  (λj2n : 2 * n < j, suffices i = 4*n - j, by rw [this, add_tsub_cancel_of_le j4n],
-    have j42n : 4*n - j ≤ 2*n, from @nat.le_of_add_le_add_right j _ _ $
-    by rw [tsub_add_cancel_of_le j4n, show 4*n = 2*n + 2*n, from right_distrib 2 2 n];
-      exact nat.add_le_add_left (le_of_lt j2n) _,
-    eq_of_xn_modeq i2n j42n
-      (h.symm.trans $ let t := xn_modeq_x4n_sub j42n in by rwa [tsub_tsub_cancel_of_le j4n] at t)
-      (λa2 n1, ⟨λi0, absurd i0 (ne_of_gt ipos), λi2, by { rw [n1, i2] at hin,
-        exact absurd hin dec_trivial }⟩))
-
-theorem modeq_of_xn_modeq {i j n} (ipos : 0 < i) (hin : i ≤ n) (h : xn j ≡ xn i [MOD xn n]) :
-  j ≡ i [MOD 4 * n] ∨ j + i ≡ 0 [MOD 4 * n] :=
-let j' := j % (4 * n) in
-have n4 : 0 < 4 * n, from mul_pos dec_trivial (ipos.trans_le hin),
-have jl : j' < 4 * n, from nat.mod_lt _ n4,
-have jj : j ≡ j' [MOD 4 * n], by delta modeq; rw nat.mod_eq_of_lt jl,
-have ∀j q, xn (j + 4 * n * q) ≡ xn j [MOD xn n], begin
-  intros j q, induction q with q IH, { simp },
-  rw [nat.mul_succ, ← add_assoc, add_comm],
-  exact (xn_modeq_x4n_add _ _ _).trans IH
-end,
-or.imp
-  (λ(ji : j' = i), by rwa ← ji)
-  (λ(ji : j' + i = 4 * n), (jj.add_right _).trans $
-    by { rw ji, exact dvd_rfl.modeq_zero_nat })
-  (eq_of_xn_modeq' ipos hin jl.le $
-    (h.symm.trans $ by { rw ← nat.mod_add_div j (4*n), exact this j' _ }).symm)
-end
-
-theorem xy_modeq_of_modeq {a b c} (a1 : 1 < a) (b1 : 1 < b) (h : a ≡ b [MOD c]) :
-  ∀ n, xn a1 n ≡ xn b1 n [MOD c] ∧ yn a1 n ≡ yn b1 n [MOD c]
-| 0 := by constructor; refl
-| 1 := by simp; exact ⟨h, modeq.refl 1⟩
-| (n+2) := ⟨
-  (xy_modeq_of_modeq n).left.add_right_cancel $
-    by { rw [xn_succ_succ a1, xn_succ_succ b1], exact
-    (h.mul_left _ ).mul (xy_modeq_of_modeq (n+1)).left },
-  (xy_modeq_of_modeq n).right.add_right_cancel $
-    by { rw [yn_succ_succ a1, yn_succ_succ b1], exact
-    (h.mul_left _ ).mul (xy_modeq_of_modeq (n+1)).right }⟩
-
-theorem matiyasevic {a k x y} : (∃ a1 : 1 < a, xn a1 k = x ∧ yn a1 k = y) ↔
-1 < a ∧ k ≤ y ∧
-(x = 1 ∧ y = 0 ∨
-∃ (u v s t b : ℕ),
-  x * x - (a * a - 1) * y * y = 1 ∧
-  u * u - (a * a - 1) * v * v = 1 ∧
-  s * s - (b * b - 1) * t * t = 1 ∧
-  1 < b ∧ b ≡ 1 [MOD 4 * y] ∧ b ≡ a [MOD u] ∧
-  0 < v ∧ y * y ∣ v ∧
-  s ≡ x [MOD u] ∧
-  t ≡ k [MOD 4 * y]) :=
-⟨λ⟨a1, hx, hy⟩, by rw [← hx, ← hy];
-  refine ⟨a1, (nat.eq_zero_or_pos k).elim
-    (λk0, by rw k0; exact ⟨le_rfl, or.inl ⟨rfl, rfl⟩⟩) (λkpos, _)⟩; exact
-  let x := xn a1 k, y := yn a1 k,
-      m := 2 * (k * y),
-      u := xn a1 m, v := yn a1 m in
-  have ky : k ≤ y, from yn_ge_n a1 k,
-  have yv : y * y ∣ v, from (ysq_dvd_yy a1 k).trans $ (y_dvd_iff _ _ _).2 $ dvd_mul_left _ _,
-  have uco : nat.coprime u (4 * y), from
-    have 2 ∣ v, from modeq_zero_iff_dvd.1 $ (yn_modeq_two _ _).trans
-      (dvd_mul_right _ _).modeq_zero_nat,
-    have nat.coprime u 2, from
-      (xy_coprime a1 m).coprime_dvd_right this,
-    (this.mul_right this).mul_right $
-      (xy_coprime _ _).coprime_dvd_right (dvd_of_mul_left_dvd yv),
-  let ⟨b, ba, bm1⟩ := chinese_remainder uco a 1 in
-  have m1 : 1 < m, from
-    have 0 < k * y, from mul_pos kpos (strict_mono_y a1 kpos),
-    nat.mul_le_mul_left 2 this,
-  have vp : 0 < v, from strict_mono_y a1 (lt_trans zero_lt_one m1),
-  have b1 : 1 < b, from
-    have xn a1 1 < u, from strict_mono_x a1 m1,
-    have a < u, by simp at this; exact this,
-    lt_of_lt_of_le a1 $ by delta modeq at ba;
-      rw nat.mod_eq_of_lt this at ba; rw ← ba; apply nat.mod_le,
-  let s := xn b1 k, t := yn b1 k in
-  have sx : s ≡ x [MOD u], from (xy_modeq_of_modeq b1 a1 ba k).left,
-  have tk : t ≡ k [MOD 4 * y], from
-      have 4 * y ∣ b - 1, from int.coe_nat_dvd.1 $
-        by rw int.coe_nat_sub (le_of_lt b1);
-           exact bm1.symm.dvd,
-      (yn_modeq_a_sub_one _ _).modeq_of_dvd this,
-  ⟨ky, or.inr ⟨u, v, s, t, b,
-    pell_eq _ _, pell_eq _ _, pell_eq _ _, b1, bm1, ba, vp, yv, sx, tk⟩⟩,
-λ⟨a1, ky, o⟩, ⟨a1, match o with
-| or.inl ⟨x1, y0⟩ := by rw y0 at ky; rw [nat.eq_zero_of_le_zero ky, x1, y0]; exact ⟨rfl, rfl⟩
-| or.inr ⟨u, v, s, t, b, xy, uv, st, b1, rem⟩ :=
-  match x, y, eq_pell a1 xy, u, v, eq_pell a1 uv, s, t, eq_pell b1 st, rem, ky with
-  | ._, ._, ⟨i, rfl, rfl⟩, ._, ._, ⟨n, rfl, rfl⟩, ._, ._, ⟨j, rfl, rfl⟩,
-    ⟨(bm1 : b ≡ 1 [MOD 4 * yn a1 i]),
-     (ba : b ≡ a [MOD xn a1 n]),
-     (vp : 0 < yn a1 n),
-     (yv : yn a1 i * yn a1 i ∣ yn a1 n),
-     (sx : xn b1 j ≡ xn a1 i [MOD xn a1 n]),
-     (tk : yn b1 j ≡ k [MOD 4 * yn a1 i])⟩,
-     (ky : k ≤ yn a1 i) :=
-    (nat.eq_zero_or_pos i).elim
-      (λi0, by simp [i0] at ky; rw [i0, ky]; exact ⟨rfl, rfl⟩) $ λipos,
-    suffices i = k, by rw this; exact ⟨rfl, rfl⟩,
-    by clear _x o rem xy uv st _match _match _fun_match; exact
-    have iln : i ≤ n, from le_of_not_gt $ λhin,
-    not_lt_of_ge (nat.le_of_dvd vp (dvd_of_mul_left_dvd yv)) (strict_mono_y a1 hin),
-    have yd : 4 * yn a1 i ∣ 4 * n, from mul_dvd_mul_left _ $ dvd_of_ysq_dvd a1 yv,
-    have jk : j ≡ k [MOD 4 * yn a1 i], from
-      have 4 * yn a1 i ∣ b - 1, from int.coe_nat_dvd.1 $
-        by rw int.coe_nat_sub (le_of_lt b1); exact bm1.symm.dvd,
-      ((yn_modeq_a_sub_one b1 _).modeq_of_dvd this).symm.trans tk,
-    have ki : k + i < 4 * yn a1 i, from
-      lt_of_le_of_lt (add_le_add ky (yn_ge_n a1 i)) $
-      by rw ← two_mul; exact nat.mul_lt_mul_of_pos_right dec_trivial (strict_mono_y a1 ipos),
-    have ji : j ≡ i [MOD 4 * n], from
-      have xn a1 j ≡ xn a1 i [MOD xn a1 n], from (xy_modeq_of_modeq b1 a1 ba j).left.symm.trans sx,
-      (modeq_of_xn_modeq a1 ipos iln this).resolve_right $ λ (ji : j + i ≡ 0 [MOD 4 * n]),
-      not_le_of_gt ki $ nat.le_of_dvd (lt_of_lt_of_le ipos $ nat.le_add_left _ _) $
-      modeq_zero_iff_dvd.1 $ (jk.symm.add_right i).trans $
-      ji.modeq_of_dvd yd,
-    by have : i % (4 * yn a1 i) = k % (4 * yn a1 i) :=
-         (ji.modeq_of_dvd yd).symm.trans jk;
-       rwa [nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_left _ _) ki),
-            nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_right _ _) ki)] at this
-  end
-end⟩⟩
-
-lemma eq_pow_of_pell_lem {a y k} (a1 : 1 < a) (ypos : 0 < y) : 0 < k → y^k < a →
-  (↑(y^k) : ℤ) < 2*a*y - y*y - 1 :=
-have y < a → a + (y*y + 1) ≤ 2*a*y, begin
-  intro ya, induction y with y IH, exact absurd ypos (lt_irrefl _),
-  cases nat.eq_zero_or_pos y with y0 ypos,
-  { rw y0, simpa [two_mul], },
-  { rw [nat.mul_succ, nat.mul_succ, nat.succ_mul y],
-    have : y + nat.succ y ≤ 2 * a,
-    { change y + y < 2 * a, rw ← two_mul,
-      exact mul_lt_mul_of_pos_left (nat.lt_of_succ_lt ya) dec_trivial },
-    have := add_le_add (IH ypos (nat.lt_of_succ_lt ya)) this,
-    convert this using 1,
-    ring }
-end, λk0 yak,
-lt_of_lt_of_le (int.coe_nat_lt_coe_nat_of_lt yak) $
-by rw sub_sub; apply le_sub_right_of_add_le;
-   apply int.coe_nat_le_coe_nat_of_le;
-   have y1 := nat.pow_le_pow_of_le_right ypos k0; simp at y1;
-   exact this (lt_of_le_of_lt y1 yak)
-
-theorem eq_pow_of_pell {m n k} : (n^k = m ↔
-k = 0 ∧ m = 1 ∨ 0 < k ∧
-(n = 0 ∧ m = 0 ∨ 0 < n ∧
-∃ (w a t z : ℕ) (a1 : 1 < a),
-  xn a1 k ≡ yn a1 k * (a - n) + m [MOD t] ∧
-  2 * a * n = t + (n * n + 1) ∧
-  m < t ∧ n ≤ w ∧ k ≤ w ∧
-  a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)) :=
-⟨λe, by rw ← e;
-  refine (nat.eq_zero_or_pos k).elim
-    (λk0, by rw k0; exact or.inl ⟨rfl, rfl⟩)
-    (λkpos, or.inr ⟨kpos, _⟩);
-  refine (nat.eq_zero_or_pos n).elim
-    (λn0, by rw [n0, zero_pow kpos]; exact or.inl ⟨rfl, rfl⟩)
-    (λnpos, or.inr ⟨npos, _⟩); exact
-  let w := max n k in
-  have nw : n ≤ w, from le_max_left _ _,
-  have kw : k ≤ w, from le_max_right _ _,
-  have wpos : 0 < w, from lt_of_lt_of_le npos nw,
-  have w1 : 1 < w + 1, from nat.succ_lt_succ wpos,
-  let a := xn w1 w in
-  have a1 : 1 < a, from strict_mono_x w1 wpos,
-  let x := xn a1 k, y := yn a1 k in
-  let ⟨z, ze⟩ := show w ∣ yn w1 w, from modeq_zero_iff_dvd.1 $
-    (yn_modeq_a_sub_one w1 w).trans dvd_rfl.modeq_zero_nat in
-  have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1, from
-    eq_pow_of_pell_lem a1 npos kpos $ calc
-      n^k ≤ n^w       : nat.pow_le_pow_of_le_right npos kw
-      ... < (w + 1)^w : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) wpos
-      ... ≤ a         : xn_ge_a_pow w1 w,
-  let ⟨t, te⟩ := int.eq_coe_of_zero_le $
-    le_trans (int.coe_zero_le _) nt.le in
-  have na : n ≤ a, from nw.trans $ le_of_lt $ n_lt_xn w1 w,
-  have tm : x ≡ y * (a - n) + n^k [MOD t], begin
-    apply modeq_of_dvd,
-    rw [int.coe_nat_add, int.coe_nat_mul, int.coe_nat_sub na, ← te],
-    exact x_sub_y_dvd_pow a1 n k
-  end,
-  have ta : 2 * a * n = t + (n * n + 1), from int.coe_nat_inj $
-    by rw [int.coe_nat_add, ← te, sub_sub];
-       repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul};
-       rw [int.coe_nat_one, sub_add_cancel]; refl,
-  have mt : n^k < t, from int.lt_of_coe_nat_lt_coe_nat $
-    by rw ← te; exact nt,
-  have zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1,
-    by rw ← ze; exact pell_eq w1 w,
-  ⟨w, a, t, z, a1, tm, ta, mt, nw, kw, zp⟩,
-λo, match o with
-| or.inl ⟨k0, m1⟩ := by rw [k0, m1]; refl
-| or.inr ⟨kpos, or.inl ⟨n0, m0⟩⟩ := by rw [n0, m0, zero_pow kpos]
-| or.inr ⟨kpos, or.inr ⟨npos, w, a, t, z,
-   (a1 : 1 < a),
-   (tm : xn a1 k ≡ yn a1 k * (a - n) + m [MOD t]),
-   (ta : 2 * a * n = t + (n * n + 1)),
-   (mt : m < t),
-   (nw : n ≤ w),
-   (kw : k ≤ w),
-   (zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1)⟩⟩ :=
-  have wpos : 0 < w, from lt_of_lt_of_le npos nw,
-  have w1 : 1 < w + 1, from nat.succ_lt_succ wpos,
-  let ⟨j, xj, yj⟩ := eq_pell w1 zp in
-  by clear _match o _let_match; exact
-  have jpos : 0 < j, from (nat.eq_zero_or_pos j).resolve_left $ λj0,
-    have a1 : a = 1, by rw j0 at xj; exact xj,
-    have 2 * n = t + (n * n + 1), by rw a1 at ta; exact ta,
-    have n1 : n = 1, from
-      have n * n < n * 2, by rw [mul_comm n 2, this]; apply nat.le_add_left,
-      have n ≤ 1, from nat.le_of_lt_succ $ lt_of_mul_lt_mul_left this (nat.zero_le _),
-      le_antisymm this npos,
-    by rw n1 at this;
-      rw ← @nat.add_right_cancel 0 2 t this at mt;
-      exact nat.not_lt_zero _ mt,
-  have wj : w ≤ j, from nat.le_of_dvd jpos $ modeq_zero_iff_dvd.1 $
-    (yn_modeq_a_sub_one w1 j).symm.trans $
-    modeq_zero_iff_dvd.2 ⟨z, yj.symm⟩,
-  have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1, from
-    eq_pow_of_pell_lem a1 npos kpos $ calc
-      n^k ≤ n^j       : nat.pow_le_pow_of_le_right npos (le_trans kw wj)
-      ... < (w + 1)^j : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) jpos
-      ... ≤ xn w1 j   : xn_ge_a_pow w1 j
-      ... = a         : xj.symm,
-  have na : n ≤ a, by rw xj; exact
-    le_trans (le_trans nw wj) (le_of_lt $ n_lt_xn _ _),
-  have te : (t : ℤ) = 2 * ↑a * ↑n - ↑n * ↑n - 1, by
-    rw sub_sub; apply eq_sub_of_add_eq; apply (int.coe_nat_eq_coe_nat_iff _ _).2;
-    exact ta.symm,
-  have xn a1 k ≡ yn a1 k * (a - n) + n^k [MOD t],
-    by have := x_sub_y_dvd_pow a1 n k;
-       rw [← te, ← int.coe_nat_sub na] at this; exact modeq_of_dvd this,
-  have n^k % t = m % t, from
-    (this.symm.trans tm).add_left_cancel' _,
-  by rw ← te at nt;
-     rwa [nat.mod_eq_of_lt (int.lt_of_coe_nat_lt_coe_nat nt), nat.mod_eq_of_lt mt] at this
-end⟩
+/-- A positive solution is a generator (up to sign) of the group of all solutions to the
+Pell equation `x^2 - d*y^2 = 1` if and only if it is a fundamental solution. -/
+theorem pos_generator_iff_fundamental (a : solution₁ d) :
+  (1 < a.x ∧ 0 < a.y ∧ ∀ b : solution₁ d, ∃ n : ℤ, b = a ^ n ∨ b = -a ^ n) ↔ is_fundamental a :=
+begin
+  refine ⟨λ h, _, λ H, ⟨H.1, H.2.1, H.eq_zpow_or_neg_zpow⟩⟩,
+  have h₀ := d_pos_of_one_lt_x h.1,
+  have hd := d_nonsquare_of_one_lt_x h.1,
+  obtain ⟨a₁, ha₁⟩ := is_fundamental.exists_of_not_is_square h₀ hd,
+  obtain ⟨b, hb₁, hb₂⟩ := exists_unique_pos_generator h₀ hd,
+  rwa [hb₂ a h, ← hb₂ a₁ ⟨ha₁.1, ha₁.2.1, ha₁.eq_zpow_or_neg_zpow⟩],
+end
 
 end pell
diff --git a/src/number_theory/pell_matiyasevic.lean b/src/number_theory/pell_matiyasevic.lean
new file mode 100644
index 0000000000000..0884c8773a3b1
--- /dev/null
+++ b/src/number_theory/pell_matiyasevic.lean
@@ -0,0 +1,781 @@
+/-
+Copyright (c) 2017 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+
+import algebra.star.unitary
+import data.nat.modeq
+import number_theory.zsqrtd.basic
+
+/-!
+# Pell's equation and Matiyasevic's theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file solves Pell's equation, i.e. integer solutions to `x ^ 2 - d * y ^ 2 = 1`
+*in the special case that `d = a ^ 2 - 1`*.
+This is then applied to prove Matiyasevic's theorem that the power
+function is Diophantine, which is the last key ingredient in the solution to Hilbert's tenth
+problem. For the definition of Diophantine function, see `number_theory.dioph.lean`.
+
+For results on Pell's equation for arbitrary (positive, non-square) `d`, see
+`number_theory.pell`.
+
+## Main definition
+
+* `pell` is a function assigning to a natural number `n` the `n`-th solution to Pell's equation
+  constructed recursively from the initial solution `(0, 1)`.
+
+## Main statements
+
+* `eq_pell` shows that every solution to Pell's equation is recursively obtained using `pell`
+* `matiyasevic` shows that a certain system of Diophantine equations has a solution if and only if
+  the first variable is the `x`-component in a solution to Pell's equation - the key step towards
+  Hilbert's tenth problem in Davis' version of Matiyasevic's theorem.
+* `eq_pow_of_pell` shows that the power function is Diophantine.
+
+## Implementation notes
+
+The proof of Matiyasevic's theorem doesn't follow Matiyasevic's original account of using Fibonacci
+numbers but instead Davis' variant of using solutions to Pell's equation.
+
+## References
+
+* [M. Carneiro, _A Lean formalization of Matiyasevič's theorem_][carneiro2018matiyasevic]
+* [M. Davis, _Hilbert's tenth problem is unsolvable_][MR317916]
+
+## Tags
+
+Pell's equation, Matiyasevic's theorem, Hilbert's tenth problem
+
+-/
+
+namespace pell
+open nat
+
+section
+variables {d : ℤ}
+
+/-- The property of being a solution to the Pell equation, expressed
+  as a property of elements of `ℤ√d`. -/
+def is_pell : ℤ√d → Prop | ⟨x, y⟩ := x*x - d*y*y = 1
+
+theorem is_pell_norm : Π {b : ℤ√d}, is_pell b ↔ b * star b = 1
+| ⟨x, y⟩ := by simp [zsqrtd.ext, is_pell, mul_comm]; ring_nf
+
+theorem is_pell_iff_mem_unitary : Π {b : ℤ√d}, is_pell b ↔ b ∈ unitary ℤ√d
+| ⟨x, y⟩ := by rw [unitary.mem_iff, is_pell_norm, mul_comm (star _), and_self]
+
+theorem is_pell_mul {b c : ℤ√d} (hb : is_pell b) (hc : is_pell c) : is_pell (b * c) :=
+is_pell_norm.2 (by simp [mul_comm, mul_left_comm, star_mul, is_pell_norm.1 hb, is_pell_norm.1 hc])
+
+theorem is_pell_star : ∀ {b : ℤ√d}, is_pell b ↔ is_pell (star b) | ⟨x, y⟩ :=
+by simp [is_pell, zsqrtd.star_mk]
+
+end
+
+section
+parameters {a : ℕ} (a1 : 1 < a)
+
+include a1
+private def d := a*a - 1
+
+@[simp] theorem d_pos : 0 < d :=
+tsub_pos_of_lt (mul_lt_mul a1 (le_of_lt a1) dec_trivial dec_trivial : 1*1 rw ← int.coe_nat_mul at h};
+    exact int.coe_nat_inj h
+
+theorem yn_add (m n) : yn (m + n) = xn m * yn n + yn m * xn n :=
+by injection (pell_zd_add _ m n) with _ h;
+    repeat {rw ← int.coe_nat_add at h <|> rw ← int.coe_nat_mul at h};
+    exact int.coe_nat_inj h
+
+theorem pell_zd_sub {m n} (h : n ≤ m) : pell_zd (m - n) = pell_zd m * star (pell_zd n) :=
+let t := pell_zd_add n (m - n) in
+by rw [add_tsub_cancel_of_le h] at t;
+    rw [t, mul_comm (pell_zd _ n) _, mul_assoc, is_pell_norm.1 (is_pell_pell_zd _ _), mul_one]
+
+theorem xz_sub {m n} (h : n ≤ m) : xz (m - n) = xz m * xz n - d * yz m * yz n :=
+by { rw [sub_eq_add_neg, ←mul_neg], exact congr_arg zsqrtd.re (pell_zd_sub a1 h) }
+
+theorem yz_sub {m n} (h : n ≤ m) : yz (m - n) = xz n * yz m - xz m * yz n :=
+by { rw [sub_eq_add_neg, ←mul_neg, mul_comm, add_comm],
+  exact congr_arg zsqrtd.im (pell_zd_sub a1 h) }
+
+theorem xy_coprime (n) : (xn n).coprime (yn n) :=
+nat.coprime_of_dvd' $ λk kp kx ky,
+let p := pell_eq n in by rw ← p; exact
+nat.dvd_sub (le_of_lt $ nat.lt_of_sub_eq_succ p)
+  (kx.mul_left _) (ky.mul_left _)
+
+theorem strict_mono_y : strict_mono yn
+| m 0     h := absurd h $ nat.not_lt_zero _
+| m (n+1) h :=
+  have yn m ≤ yn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
+    (λhl, le_of_lt $ strict_mono_y hl) (λe, by rw e),
+  by simp; refine lt_of_le_of_lt _ (nat.lt_add_of_pos_left $ x_pos a1 n);
+      rw ← mul_one (yn a1 m);
+      exact mul_le_mul this (le_of_lt a1) (nat.zero_le _) (nat.zero_le _)
+
+theorem strict_mono_x : strict_mono xn
+| m 0     h := absurd h $ nat.not_lt_zero _
+| m (n+1) h :=
+  have xn m ≤ xn n, from or.elim (lt_or_eq_of_le $ nat.le_of_succ_le_succ h)
+    (λhl, le_of_lt $ strict_mono_x hl) (λe, by rw e),
+  by simp; refine lt_of_lt_of_le (lt_of_le_of_lt this _) (nat.le_add_right _ _);
+      have t := nat.mul_lt_mul_of_pos_left a1 (x_pos a1 n); rwa mul_one at t
+
+theorem yn_ge_n : Π n, n ≤ yn n
+| 0 := nat.zero_le _
+| (n+1) := show n < yn (n+1), from lt_of_le_of_lt (yn_ge_n n) (strict_mono_y $ nat.lt_succ_self n)
+
+theorem y_mul_dvd (n) : ∀k, yn n ∣ yn (n * k)
+| 0     := dvd_zero _
+| (k+1) := by rw [nat.mul_succ, yn_add]; exact
+  dvd_add (dvd_mul_left _ _) ((y_mul_dvd k).mul_right _)
+
+theorem y_dvd_iff (m n) : yn m ∣ yn n ↔ m ∣ n :=
+⟨λh, nat.dvd_of_mod_eq_zero $ (nat.eq_zero_or_pos _).resolve_right $ λhp,
+  have co : nat.coprime (yn m) (xn (m * (n / m))), from nat.coprime.symm $
+    (xy_coprime _).coprime_dvd_right (y_mul_dvd m (n / m)),
+  have m0 : 0 < m, from m.eq_zero_or_pos.resolve_left $
+    λe, by rw [e, nat.mod_zero] at hp; rw [e] at h; exact
+    ne_of_lt (strict_mono_y a1 hp) (eq_zero_of_zero_dvd h).symm,
+  by rw [← nat.mod_add_div n m, yn_add] at h; exact
+  not_le_of_gt (strict_mono_y _ $ nat.mod_lt n m0)
+    (nat.le_of_dvd (strict_mono_y _ hp) $ co.dvd_of_dvd_mul_right $
+    (nat.dvd_add_iff_right $ (y_mul_dvd _ _ _).mul_left _).2 h),
+λ⟨k, e⟩, by rw e; apply y_mul_dvd⟩
+
+theorem xy_modeq_yn (n) :
+  ∀ k, xn (n * k) ≡ (xn n)^k [MOD (yn n)^2]
+    ∧ yn (n * k) ≡ k * (xn n)^(k-1) * yn n [MOD (yn n)^3]
+| 0     := by constructor; simp
+| (k+1) :=
+  let ⟨hx, hy⟩ := xy_modeq_yn k in
+  have L : xn (n * k) * xn n + d * yn (n * k) * yn n ≡ xn n^k * xn n + 0 [MOD yn n^2], from
+    (hx.mul_right _ ).add $ modeq_zero_iff_dvd.2 $
+    by rw pow_succ'; exact
+    mul_dvd_mul_right (dvd_mul_of_dvd_right (modeq_zero_iff_dvd.1 $
+      (hy.of_dvd $ by simp [pow_succ']).trans $ modeq_zero_iff_dvd.2 $
+      by simp [-mul_comm, -mul_assoc]) _) _,
+  have R : xn (n * k) * yn n + yn (n * k) * xn n ≡
+            xn n^k * yn n + k * xn n^k * yn n [MOD yn n^3], from
+  modeq.add (by { rw pow_succ', exact hx.mul_right' _ }) $
+    have k * xn n^(k - 1) * yn n * xn n = k * xn n^k * yn n,
+      by clear _let_match; cases k with k; simp [pow_succ', mul_comm, mul_left_comm],
+    by { rw ← this, exact hy.mul_right _ },
+  by { rw [add_tsub_cancel_right, nat.mul_succ, xn_add, yn_add, pow_succ' (xn _ n),
+          nat.succ_mul, add_comm (k * xn _ n^k) (xn _ n^k), right_distrib],
+      exact ⟨L, R⟩ }
+
+theorem ysq_dvd_yy (n) : yn n * yn n ∣ yn (n * yn n) :=
+modeq_zero_iff_dvd.1 $
+  ((xy_modeq_yn n (yn n)).right.of_dvd $ by simp [pow_succ]).trans
+  (modeq_zero_iff_dvd.2 $ by simp [mul_dvd_mul_left, mul_assoc])
+
+theorem dvd_of_ysq_dvd {n t} (h : yn n * yn n ∣ yn t) : yn n ∣ t :=
+have nt : n ∣ t, from (y_dvd_iff n t).1 $ dvd_of_mul_left_dvd h,
+n.eq_zero_or_pos.elim (λ n0, by rwa n0 at ⊢ nt) $ λ (n0l : 0 < n),
+let ⟨k, ke⟩ := nt in
+have yn n ∣ k * (xn n)^(k-1), from
+nat.dvd_of_mul_dvd_mul_right (strict_mono_y n0l) $ modeq_zero_iff_dvd.1 $
+  by have xm := (xy_modeq_yn a1 n k).right; rw ← ke at xm; exact
+  (xm.of_dvd $ by simp [pow_succ]).symm.trans h.modeq_zero_nat,
+by rw ke; exact dvd_mul_of_dvd_right
+  (((xy_coprime _ _).pow_left _).symm.dvd_of_dvd_mul_right this) _
+
+theorem pell_zd_succ_succ (n) : pell_zd (n + 2) + pell_zd n = (2 * a : ℕ) * pell_zd (n + 1) :=
+have (1:ℤ√d) + ⟨a, 1⟩ * ⟨a, 1⟩ = ⟨a, 1⟩ * (2 * a),
+by { rw zsqrtd.coe_nat_val, change (⟨_,_⟩:ℤ√(d a1))=⟨_,_⟩,
+    rw dz_val, dsimp [az], rw zsqrtd.ext, dsimp, split; ring },
+by simpa [mul_add, mul_comm, mul_left_comm, add_comm] using congr_arg (* pell_zd a1 n) this
+
+theorem xy_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) ∧
+                            yn (n + 2) + yn n = (2 * a) * yn (n + 1) := begin
+  have := pell_zd_succ_succ a1 n, unfold pell_zd at this,
+  erw [zsqrtd.smul_val (2 * a : ℕ)] at this,
+  injection this with h₁ h₂,
+  split; apply int.coe_nat_inj; [simpa using h₁, simpa using h₂]
+end
+
+theorem xn_succ_succ (n) : xn (n + 2) + xn n = (2 * a) * xn (n + 1) := (xy_succ_succ n).1
+theorem yn_succ_succ (n) : yn (n + 2) + yn n = (2 * a) * yn (n + 1) := (xy_succ_succ n).2
+
+theorem xz_succ_succ (n) : xz (n + 2) = (2 * a : ℕ) * xz (n + 1) - xz n :=
+eq_sub_of_add_eq $ by delta xz; rw [← int.coe_nat_add, ← int.coe_nat_mul, xn_succ_succ]
+
+theorem yz_succ_succ (n) : yz (n + 2) = (2 * a : ℕ) * yz (n + 1) - yz n :=
+eq_sub_of_add_eq $ by delta yz; rw [← int.coe_nat_add, ← int.coe_nat_mul, yn_succ_succ]
+
+theorem yn_modeq_a_sub_one : ∀ n, yn n ≡ n [MOD a-1]
+| 0 := by simp
+| 1 := by simp
+| (n+2) := (yn_modeq_a_sub_one n).add_right_cancel $
+  begin
+    rw [yn_succ_succ, (by ring : n + 2 + n = 2 * (n + 1))],
+    exact ((modeq_sub a1.le).mul_left 2).mul (yn_modeq_a_sub_one (n+1)),
+  end
+
+theorem yn_modeq_two : ∀ n, yn n ≡ n [MOD 2]
+| 0 := by simp
+| 1 := by simp
+| (n+2) := (yn_modeq_two n).add_right_cancel $
+  begin
+    rw [yn_succ_succ, mul_assoc, (by ring : n + 2 + n = 2 * (n + 1))],
+    exact (dvd_mul_right 2 _).modeq_zero_nat.trans (dvd_mul_right 2 _).zero_modeq_nat,
+  end
+
+section
+
+omit a1
+lemma x_sub_y_dvd_pow_lem (y2 y1 y0 yn1 yn0 xn1 xn0 ay a2 : ℤ) :
+  (a2 * yn1 - yn0) * ay + y2 - (a2 * xn1 - xn0) =
+    y2 - a2 * y1 + y0 + a2 * (yn1 * ay + y1 - xn1) - (yn0 * ay + y0 - xn0) := by ring
+
+end
+
+theorem x_sub_y_dvd_pow (y : ℕ) :
+  ∀ n, (2*a*y - y*y - 1 : ℤ) ∣ yz n * (a - y) + ↑(y^n) - xz n
+| 0 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
+| 1 := by simp [xz, yz, int.coe_nat_zero, int.coe_nat_one]
+| (n+2) :=
+  have (2*a*y - y*y - 1 : ℤ) ∣ ↑(y^(n + 2)) - ↑(2 * a) * ↑(y^(n + 1)) + ↑(y^n), from
+  ⟨-↑(y^n), by { simp [pow_succ, mul_add, int.coe_nat_mul,
+      show ((2:ℕ):ℤ) = 2, from rfl, mul_comm, mul_left_comm], ring }⟩,
+  by { rw [xz_succ_succ, yz_succ_succ, x_sub_y_dvd_pow_lem ↑(y^(n+2)) ↑(y^(n+1)) ↑(y^n)],
+  exact
+    dvd_sub (dvd_add this $ (x_sub_y_dvd_pow (n+1)).mul_left _) (x_sub_y_dvd_pow n) }
+
+theorem xn_modeq_x2n_add_lem (n j) : xn n ∣ d * yn n * (yn n * xn j) + xn j :=
+have h1 : d * yn n * (yn n * xn j) + xn j = (d * yn n * yn n + 1) * xn j,
+  by simp [add_mul, mul_assoc],
+have h2 : d * yn n * yn n + 1 = xn n * xn n, by apply int.coe_nat_inj;
+  repeat {rw int.coe_nat_add <|> rw int.coe_nat_mul}; exact
+  add_eq_of_eq_sub' (eq.symm $ pell_eqz _ _),
+by rw h2 at h1; rw [h1, mul_assoc]; exact dvd_mul_right _ _
+
+theorem xn_modeq_x2n_add (n j) : xn (2 * n + j) + xn j ≡ 0 [MOD xn n] :=
+begin
+  rw [two_mul, add_assoc, xn_add, add_assoc, ←zero_add 0],
+  refine (dvd_mul_right (xn a1 n) (xn a1 (n + j))).modeq_zero_nat.add _,
+  rw [yn_add, left_distrib, add_assoc, ←zero_add 0],
+  exact ((dvd_mul_right _ _).mul_left _).modeq_zero_nat.add
+    (xn_modeq_x2n_add_lem _ _ _).modeq_zero_nat,
+end
+
+lemma xn_modeq_x2n_sub_lem {n j} (h : j ≤ n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
+have h1 : xz n ∣ ↑d * yz n * yz (n - j) + xz j,
+  by rw [yz_sub _ h, mul_sub_left_distrib, sub_add_eq_add_sub]; exact
+dvd_sub
+  (by delta xz; delta yz;
+      repeat {rw ← int.coe_nat_add <|> rw ← int.coe_nat_mul}; rw mul_comm (xn a1 j) (yn a1 n);
+      exact int.coe_nat_dvd.2 (xn_modeq_x2n_add_lem _ _ _))
+  ((dvd_mul_right _ _).mul_left _),
+begin
+  rw [two_mul, add_tsub_assoc_of_le h, xn_add, add_assoc, ←zero_add 0],
+  exact (dvd_mul_right _ _).modeq_zero_nat.add
+    (int.coe_nat_dvd.1 $ by simpa [xz, yz] using h1).modeq_zero_nat,
+end
+
+theorem xn_modeq_x2n_sub {n j} (h : j ≤ 2 * n) : xn (2 * n - j) + xn j ≡ 0 [MOD xn n] :=
+(le_total j n).elim xn_modeq_x2n_sub_lem
+  (λjn, have 2 * n - j + j ≤ n + j, by rw [tsub_add_cancel_of_le h, two_mul];
+    exact nat.add_le_add_left jn _,
+    let t := xn_modeq_x2n_sub_lem (nat.le_of_add_le_add_right this) in
+      by rwa [tsub_tsub_cancel_of_le h, add_comm] at t)
+
+theorem xn_modeq_x4n_add (n j) : xn (4 * n + j) ≡ xn j [MOD xn n] :=
+modeq.add_right_cancel' (xn (2 * n + j)) $
+by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_add _ _ _).symm);
+    rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_assoc]; apply xn_modeq_x2n_add
+
+theorem xn_modeq_x4n_sub {n j} (h : j ≤ 2 * n) : xn (4 * n - j) ≡ xn j [MOD xn n] :=
+have h' : j ≤ 2*n, from le_trans h (by rw nat.succ_mul; apply nat.le_add_left),
+modeq.add_right_cancel' (xn (2 * n - j)) $
+by refine @modeq.trans _ _ 0 _ _ (by rw add_comm; exact (xn_modeq_x2n_sub _ h).symm);
+    rw [show 4*n = 2*n + 2*n, from right_distrib 2 2 n, add_tsub_assoc_of_le h'];
+      apply xn_modeq_x2n_add
+
+theorem eq_of_xn_modeq_lem1 {i n} : Π {j}, i < j → j < n → xn i % xn n < xn j % xn n
+| 0     ij _  := absurd ij (nat.not_lt_zero _)
+| (j+1) ij jn :=
+    suffices xn j % xn n < xn (j + 1) % xn n, from
+    (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
+      (λh, lt_trans (eq_of_xn_modeq_lem1 h (le_of_lt jn)) this)
+      (λh, by rw h; exact this),
+  by rw [nat.mod_eq_of_lt (strict_mono_x _ (nat.lt_of_succ_lt jn)),
+          nat.mod_eq_of_lt (strict_mono_x _ jn)];
+      exact strict_mono_x _ (nat.lt_succ_self _)
+
+theorem eq_of_xn_modeq_lem2 {n} (h : 2 * xn n = xn (n + 1)) : a = 2 ∧ n = 0 :=
+by rw [xn_succ, mul_comm] at h; exact
+have n = 0, from n.eq_zero_or_pos.resolve_right $ λnp,
+  ne_of_lt (lt_of_le_of_lt (nat.mul_le_mul_left _ a1)
+    (nat.lt_add_of_pos_right $ mul_pos (d_pos a1) (strict_mono_y a1 np))) h,
+by cases this; simp at h; exact ⟨h.symm, rfl⟩
+
+theorem eq_of_xn_modeq_lem3 {i n} (npos : 0 < n) :
+  Π {j}, i < j → j ≤ 2 * n → j ≠ n → ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2) → xn i % xn n < xn j % xn n
+| 0     ij _   _   _     := absurd ij (nat.not_lt_zero _)
+| (j+1) ij j2n jnn ntriv :=
+  have lem2 : ∀k > n, k ≤ 2*n → (↑(xn k % xn n) : ℤ) = xn n - xn (2 * n - k), from λk kn k2n,
+    let k2nl := lt_of_add_lt_add_right $ show 2*n-k+k < n+k, by
+      {rw tsub_add_cancel_of_le, rw two_mul; exact (add_lt_add_left kn n), exact k2n } in
+    have xle : xn (2 * n - k) ≤ xn n, from le_of_lt $ strict_mono_x k2nl,
+    suffices xn k % xn n = xn n - xn (2 * n - k), by rw [this, int.coe_nat_sub xle],
+    by
+    { rw ← nat.mod_eq_of_lt (nat.sub_lt (x_pos a1 n) (x_pos a1 (2 * n - k))),
+      apply modeq.add_right_cancel' (xn a1 (2 * n - k)),
+      rw [tsub_add_cancel_of_le xle],
+      have t := xn_modeq_x2n_sub_lem a1 k2nl.le,
+      rw tsub_tsub_cancel_of_le k2n at t,
+      exact t.trans dvd_rfl.zero_modeq_nat },
+  (lt_trichotomy j n).elim
+  (λ (jn : j < n), eq_of_xn_modeq_lem1 ij (lt_of_le_of_ne jn jnn)) $ λ o, o.elim
+  (λ (jn : j = n), by
+  { cases jn,
+    apply int.lt_of_coe_nat_lt_coe_nat,
+    rw [lem2 (n+1) (nat.lt_succ_self _) j2n,
+        show 2 * n - (n + 1) = n - 1, by rw[two_mul, tsub_add_eq_tsub_tsub, add_tsub_cancel_right]],
+    refine lt_sub_left_of_add_lt (int.coe_nat_lt_coe_nat_of_lt _),
+    cases (lt_or_eq_of_le $ nat.le_of_succ_le_succ ij) with lin ein,
+    { rw nat.mod_eq_of_lt (strict_mono_x _ lin),
+      have ll : xn a1 (n-1) + xn a1 (n-1) ≤ xn a1 n,
+      { rw [← two_mul, mul_comm, show xn a1 n = xn a1 (n-1+1),
+                                  by rw [tsub_add_cancel_of_le (succ_le_of_lt npos)], xn_succ],
+        exact le_trans (nat.mul_le_mul_left _ a1) (nat.le_add_right _ _) },
+      have npm : (n-1).succ = n := nat.succ_pred_eq_of_pos npos,
+      have il : i ≤ n - 1, { apply nat.le_of_succ_le_succ, rw npm, exact lin },
+      cases lt_or_eq_of_le il with ill ile,
+      { exact lt_of_lt_of_le (nat.add_lt_add_left (strict_mono_x a1 ill) _) ll },
+      { rw ile,
+        apply lt_of_le_of_ne ll,
+        rw ← two_mul,
+        exact λe, ntriv $
+          let ⟨a2, s1⟩ := @eq_of_xn_modeq_lem2 _ a1 (n-1)
+            (by rwa [tsub_add_cancel_of_le (succ_le_of_lt npos)]) in
+          have n1 : n = 1, from le_antisymm (tsub_eq_zero_iff_le.mp s1) npos,
+          by rw [ile, a2, n1]; exact ⟨rfl, rfl, rfl, rfl⟩ } },
+    { rw [ein, nat.mod_self, add_zero],
+      exact strict_mono_x _ (nat.pred_lt npos.ne') } })
+  (λ (jn : j > n),
+    have lem1 : j ≠ n → xn j % xn n < xn (j + 1) % xn n → xn i % xn n < xn (j + 1) % xn n,
+      from λjn s,
+    (lt_or_eq_of_le (nat.le_of_succ_le_succ ij)).elim
+      (λh, lt_trans (eq_of_xn_modeq_lem3 h (le_of_lt j2n) jn $ λ⟨a1, n1, i0, j2⟩,
+        by rw [n1, j2] at j2n; exact absurd j2n dec_trivial) s)
+      (λh, by rw h; exact s),
+    lem1 (ne_of_gt jn) $ int.lt_of_coe_nat_lt_coe_nat $ by
+    { rw [lem2 j jn (le_of_lt j2n), lem2 (j+1) (nat.le_succ_of_le jn) j2n],
+      refine sub_lt_sub_left (int.coe_nat_lt_coe_nat_of_lt $ strict_mono_x _ _) _,
+      rw [nat.sub_succ],
+      exact nat.pred_lt (ne_of_gt $ tsub_pos_of_lt j2n) })
+
+theorem eq_of_xn_modeq_le {i j n} (ij : i ≤ j) (j2n : j ≤ 2 * n)
+  (h : xn i ≡ xn j [MOD xn n]) (ntriv : ¬(a = 2 ∧ n = 1 ∧ i = 0 ∧ j = 2)) : i = j :=
+if npos : n = 0 then by simp [*] at * else
+(lt_or_eq_of_le ij).resolve_left $ λij',
+if jn : j = n then by
+{ refine ne_of_gt _ h,
+  rw [jn, nat.mod_self],
+  have x0 : 0 < xn a1 0 % xn a1 n :=
+    by rw [nat.mod_eq_of_lt (strict_mono_x a1 (nat.pos_of_ne_zero npos))]; exact dec_trivial,
+  cases i with i, exact x0,
+  rw jn at ij',
+  exact x0.trans (eq_of_xn_modeq_lem3 _ (nat.pos_of_ne_zero npos) (nat.succ_pos _)
+    (le_trans ij j2n) (ne_of_lt ij') $
+    λ⟨a1, n1, _, i2⟩, by rw [n1, i2] at ij'; exact absurd ij' dec_trivial) }
+else ne_of_lt (eq_of_xn_modeq_lem3 (nat.pos_of_ne_zero npos) ij' j2n jn ntriv) h
+
+theorem eq_of_xn_modeq {i j n} (i2n : i ≤ 2 * n) (j2n : j ≤ 2 * n)
+  (h : xn i ≡ xn j [MOD xn n]) (ntriv : a = 2 → n = 1 → (i = 0 → j ≠ 2) ∧ (i = 2 → j ≠ 0)) :
+  i = j :=
+(le_total i j).elim
+  (λij, eq_of_xn_modeq_le ij j2n h $ λ⟨a2, n1, i0, j2⟩, (ntriv a2 n1).left i0 j2)
+  (λij, (eq_of_xn_modeq_le ij i2n h.symm $ λ⟨a2, n1, j0, i2⟩,
+    (ntriv a2 n1).right i2 j0).symm)
+
+theorem eq_of_xn_modeq' {i j n} (ipos : 0 < i) (hin : i ≤ n) (j4n : j ≤ 4 * n)
+  (h : xn j ≡ xn i [MOD xn n]) : j = i ∨ j + i = 4 * n :=
+have i2n : i ≤ 2*n, by apply le_trans hin; rw two_mul; apply nat.le_add_left,
+(le_or_gt j (2 * n)).imp
+  (λj2n : j ≤ 2 * n, eq_of_xn_modeq j2n i2n h $
+    λa2 n1, ⟨λj0 i2, by rw [n1, i2] at hin; exact absurd hin dec_trivial,
+              λj2 i0, ne_of_gt ipos i0⟩)
+  (λj2n : 2 * n < j, suffices i = 4*n - j, by rw [this, add_tsub_cancel_of_le j4n],
+    have j42n : 4*n - j ≤ 2*n, from @nat.le_of_add_le_add_right j _ _ $
+    by rw [tsub_add_cancel_of_le j4n, show 4*n = 2*n + 2*n, from right_distrib 2 2 n];
+      exact nat.add_le_add_left (le_of_lt j2n) _,
+    eq_of_xn_modeq i2n j42n
+      (h.symm.trans $ let t := xn_modeq_x4n_sub j42n in by rwa [tsub_tsub_cancel_of_le j4n] at t)
+      (λa2 n1, ⟨λi0, absurd i0 (ne_of_gt ipos), λi2, by { rw [n1, i2] at hin,
+        exact absurd hin dec_trivial }⟩))
+
+theorem modeq_of_xn_modeq {i j n} (ipos : 0 < i) (hin : i ≤ n) (h : xn j ≡ xn i [MOD xn n]) :
+  j ≡ i [MOD 4 * n] ∨ j + i ≡ 0 [MOD 4 * n] :=
+let j' := j % (4 * n) in
+have n4 : 0 < 4 * n, from mul_pos dec_trivial (ipos.trans_le hin),
+have jl : j' < 4 * n, from nat.mod_lt _ n4,
+have jj : j ≡ j' [MOD 4 * n], by delta modeq; rw nat.mod_eq_of_lt jl,
+have ∀j q, xn (j + 4 * n * q) ≡ xn j [MOD xn n], begin
+  intros j q, induction q with q IH, { simp },
+  rw [nat.mul_succ, ← add_assoc, add_comm],
+  exact (xn_modeq_x4n_add _ _ _).trans IH
+end,
+or.imp
+  (λ(ji : j' = i), by rwa ← ji)
+  (λ(ji : j' + i = 4 * n), (jj.add_right _).trans $
+    by { rw ji, exact dvd_rfl.modeq_zero_nat })
+  (eq_of_xn_modeq' ipos hin jl.le $
+    (h.symm.trans $ by { rw ← nat.mod_add_div j (4*n), exact this j' _ }).symm)
+end
+
+theorem xy_modeq_of_modeq {a b c} (a1 : 1 < a) (b1 : 1 < b) (h : a ≡ b [MOD c]) :
+  ∀ n, xn a1 n ≡ xn b1 n [MOD c] ∧ yn a1 n ≡ yn b1 n [MOD c]
+| 0 := by constructor; refl
+| 1 := by simp; exact ⟨h, modeq.refl 1⟩
+| (n+2) := ⟨
+  (xy_modeq_of_modeq n).left.add_right_cancel $
+    by { rw [xn_succ_succ a1, xn_succ_succ b1], exact
+    (h.mul_left _ ).mul (xy_modeq_of_modeq (n+1)).left },
+  (xy_modeq_of_modeq n).right.add_right_cancel $
+    by { rw [yn_succ_succ a1, yn_succ_succ b1], exact
+    (h.mul_left _ ).mul (xy_modeq_of_modeq (n+1)).right }⟩
+
+theorem matiyasevic {a k x y} : (∃ a1 : 1 < a, xn a1 k = x ∧ yn a1 k = y) ↔
+1 < a ∧ k ≤ y ∧
+(x = 1 ∧ y = 0 ∨
+∃ (u v s t b : ℕ),
+  x * x - (a * a - 1) * y * y = 1 ∧
+  u * u - (a * a - 1) * v * v = 1 ∧
+  s * s - (b * b - 1) * t * t = 1 ∧
+  1 < b ∧ b ≡ 1 [MOD 4 * y] ∧ b ≡ a [MOD u] ∧
+  0 < v ∧ y * y ∣ v ∧
+  s ≡ x [MOD u] ∧
+  t ≡ k [MOD 4 * y]) :=
+⟨λ⟨a1, hx, hy⟩, by rw [← hx, ← hy];
+  refine ⟨a1, (nat.eq_zero_or_pos k).elim
+    (λk0, by rw k0; exact ⟨le_rfl, or.inl ⟨rfl, rfl⟩⟩) (λkpos, _)⟩; exact
+  let x := xn a1 k, y := yn a1 k,
+      m := 2 * (k * y),
+      u := xn a1 m, v := yn a1 m in
+  have ky : k ≤ y, from yn_ge_n a1 k,
+  have yv : y * y ∣ v, from (ysq_dvd_yy a1 k).trans $ (y_dvd_iff _ _ _).2 $ dvd_mul_left _ _,
+  have uco : nat.coprime u (4 * y), from
+    have 2 ∣ v, from modeq_zero_iff_dvd.1 $ (yn_modeq_two _ _).trans
+      (dvd_mul_right _ _).modeq_zero_nat,
+    have nat.coprime u 2, from
+      (xy_coprime a1 m).coprime_dvd_right this,
+    (this.mul_right this).mul_right $
+      (xy_coprime _ _).coprime_dvd_right (dvd_of_mul_left_dvd yv),
+  let ⟨b, ba, bm1⟩ := chinese_remainder uco a 1 in
+  have m1 : 1 < m, from
+    have 0 < k * y, from mul_pos kpos (strict_mono_y a1 kpos),
+    nat.mul_le_mul_left 2 this,
+  have vp : 0 < v, from strict_mono_y a1 (lt_trans zero_lt_one m1),
+  have b1 : 1 < b, from
+    have xn a1 1 < u, from strict_mono_x a1 m1,
+    have a < u, by simp at this; exact this,
+    lt_of_lt_of_le a1 $ by delta modeq at ba;
+      rw nat.mod_eq_of_lt this at ba; rw ← ba; apply nat.mod_le,
+  let s := xn b1 k, t := yn b1 k in
+  have sx : s ≡ x [MOD u], from (xy_modeq_of_modeq b1 a1 ba k).left,
+  have tk : t ≡ k [MOD 4 * y], from
+      have 4 * y ∣ b - 1, from int.coe_nat_dvd.1 $
+        by rw int.coe_nat_sub (le_of_lt b1);
+           exact bm1.symm.dvd,
+      (yn_modeq_a_sub_one _ _).of_dvd this,
+  ⟨ky, or.inr ⟨u, v, s, t, b,
+    pell_eq _ _, pell_eq _ _, pell_eq _ _, b1, bm1, ba, vp, yv, sx, tk⟩⟩,
+λ⟨a1, ky, o⟩, ⟨a1, match o with
+| or.inl ⟨x1, y0⟩ := by rw y0 at ky; rw [nat.eq_zero_of_le_zero ky, x1, y0]; exact ⟨rfl, rfl⟩
+| or.inr ⟨u, v, s, t, b, xy, uv, st, b1, rem⟩ :=
+  match x, y, eq_pell a1 xy, u, v, eq_pell a1 uv, s, t, eq_pell b1 st, rem, ky with
+  | ._, ._, ⟨i, rfl, rfl⟩, ._, ._, ⟨n, rfl, rfl⟩, ._, ._, ⟨j, rfl, rfl⟩,
+    ⟨(bm1 : b ≡ 1 [MOD 4 * yn a1 i]),
+     (ba : b ≡ a [MOD xn a1 n]),
+     (vp : 0 < yn a1 n),
+     (yv : yn a1 i * yn a1 i ∣ yn a1 n),
+     (sx : xn b1 j ≡ xn a1 i [MOD xn a1 n]),
+     (tk : yn b1 j ≡ k [MOD 4 * yn a1 i])⟩,
+     (ky : k ≤ yn a1 i) :=
+    (nat.eq_zero_or_pos i).elim
+      (λi0, by simp [i0] at ky; rw [i0, ky]; exact ⟨rfl, rfl⟩) $ λipos,
+    suffices i = k, by rw this; exact ⟨rfl, rfl⟩,
+    by clear _x o rem xy uv st _match _match _fun_match; exact
+    have iln : i ≤ n, from le_of_not_gt $ λhin,
+    not_lt_of_ge (nat.le_of_dvd vp (dvd_of_mul_left_dvd yv)) (strict_mono_y a1 hin),
+    have yd : 4 * yn a1 i ∣ 4 * n, from mul_dvd_mul_left _ $ dvd_of_ysq_dvd a1 yv,
+    have jk : j ≡ k [MOD 4 * yn a1 i], from
+      have 4 * yn a1 i ∣ b - 1, from int.coe_nat_dvd.1 $
+        by rw int.coe_nat_sub (le_of_lt b1); exact bm1.symm.dvd,
+      ((yn_modeq_a_sub_one b1 _).of_dvd this).symm.trans tk,
+    have ki : k + i < 4 * yn a1 i, from
+      lt_of_le_of_lt (add_le_add ky (yn_ge_n a1 i)) $
+      by rw ← two_mul; exact nat.mul_lt_mul_of_pos_right dec_trivial (strict_mono_y a1 ipos),
+    have ji : j ≡ i [MOD 4 * n], from
+      have xn a1 j ≡ xn a1 i [MOD xn a1 n], from (xy_modeq_of_modeq b1 a1 ba j).left.symm.trans sx,
+      (modeq_of_xn_modeq a1 ipos iln this).resolve_right $ λ (ji : j + i ≡ 0 [MOD 4 * n]),
+      not_le_of_gt ki $ nat.le_of_dvd (lt_of_lt_of_le ipos $ nat.le_add_left _ _) $
+      modeq_zero_iff_dvd.1 $ (jk.symm.add_right i).trans $
+      ji.of_dvd yd,
+    by have : i % (4 * yn a1 i) = k % (4 * yn a1 i) :=
+         (ji.of_dvd yd).symm.trans jk;
+       rwa [nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_left _ _) ki),
+            nat.mod_eq_of_lt (lt_of_le_of_lt (nat.le_add_right _ _) ki)] at this
+  end
+end⟩⟩
+
+lemma eq_pow_of_pell_lem {a y k} (hy0 : y ≠ 0) (hk0 : k ≠ 0) (hyk : y^k < a) :
+  (↑(y^k) : ℤ) < 2*a*y - y*y - 1 :=
+have hya : y < a, from (nat.le_self_pow hk0 _).trans_lt hyk,
+calc (↑(y ^ k) : ℤ) < a : nat.cast_lt.2 hyk
+... ≤ a ^ 2 - (a - 1) ^ 2 - 1 :
+  begin
+    rw [sub_sq, mul_one, one_pow, sub_add, sub_sub_cancel, two_mul, sub_sub, ← add_sub,
+      le_add_iff_nonneg_right, ← bit0, sub_nonneg, ← nat.cast_two, nat.cast_le, nat.succ_le_iff],
+    exact (one_le_iff_ne_zero.2 hy0).trans_lt hya
+  end
+... ≤ a ^ 2 - (a - y) ^ 2 - 1 : have _ := hya.le,
+  by { mono*; simpa only [sub_nonneg, nat.cast_le, nat.one_le_cast, nat.one_le_iff_ne_zero] }
+... = 2*a*y - y*y - 1 : by ring
+
+theorem eq_pow_of_pell {m n k} : n^k = m ↔
+  k = 0 ∧ m = 1 ∨
+    0 < k ∧ (n = 0 ∧ m = 0 ∨
+      0 < n ∧ ∃ (w a t z : ℕ) (a1 : 1 < a),
+        xn a1 k ≡ yn a1 k * (a - n) + m [MOD t] ∧
+        2 * a * n = t + (n * n + 1) ∧
+        m < t ∧ n ≤ w ∧ k ≤ w ∧
+        a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1) :=
+begin
+  split,
+  { rintro rfl,
+    refine k.eq_zero_or_pos.imp (λ k0, k0.symm ▸ ⟨rfl, rfl⟩) (λ hk, ⟨hk, _⟩),
+    refine n.eq_zero_or_pos.imp (λ n0, n0.symm ▸ ⟨rfl, zero_pow hk⟩) (λ hn, ⟨hn, _⟩),
+    set w := max n k,
+    have nw : n ≤ w, from le_max_left _ _,
+    have kw : k ≤ w, from le_max_right _ _,
+    have wpos : 0 < w, from hn.trans_le nw,
+    have w1 : 1 < w + 1, from nat.succ_lt_succ wpos,
+    set a := xn w1 w,
+    have a1 : 1 < a, from strict_mono_x w1 wpos,
+    have na : n ≤ a, from nw.trans (n_lt_xn w1 w).le,
+    set x := xn a1 k, set y := yn a1 k,
+    obtain ⟨z, ze⟩ : w ∣ yn w1 w,
+      from modeq_zero_iff_dvd.1 ((yn_modeq_a_sub_one w1 w).trans dvd_rfl.modeq_zero_nat),
+    have nt : (↑(n^k) : ℤ) < 2 * a * n - n * n - 1,
+    { refine eq_pow_of_pell_lem hn.ne' hk.ne' _,
+      calc n^k ≤ n^w       : nat.pow_le_pow_of_le_right hn kw
+           ... < (w + 1)^w : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) wpos
+           ... ≤ a         : xn_ge_a_pow w1 w },
+    lift (2 * a * n - n * n - 1 : ℤ) to ℕ using ((nat.cast_nonneg _).trans nt.le) with t te,
+    have tm : x ≡ y * (a - n) + n^k [MOD t],
+    { apply modeq_of_dvd,
+      rw [int.coe_nat_add, int.coe_nat_mul, int.coe_nat_sub na, te],
+      exact x_sub_y_dvd_pow a1 n k },
+    have ta : 2 * a * n = t + (n * n + 1),
+    { rw [← @nat.cast_inj ℤ, int.coe_nat_add, te, sub_sub],
+      repeat { rw nat.cast_add <|> rw nat.cast_mul },
+      rw [nat.cast_one, sub_add_cancel, nat.cast_two] },
+    have zp : a * a - ((w + 1) * (w + 1) - 1) * (w * z) * (w * z) = 1,
+      from ze ▸ pell_eq w1 w,
+    exact ⟨w, a, t, z, a1, tm, ta, nat.cast_lt.1 nt, nw, kw, zp⟩ },
+  { rintro (⟨rfl, rfl⟩ | ⟨hk0, ⟨rfl, rfl⟩ | ⟨hn0, w, a, t, z, a1, tm, ta, mt, nw, kw, zp⟩⟩),
+    { exact pow_zero n }, { exact zero_pow hk0 },
+    have hw0 : 0 < w, from hn0.trans_le nw,
+    have hw1 : 1 < w + 1, from nat.succ_lt_succ hw0,
+    rcases eq_pell hw1 zp with ⟨j, rfl, yj⟩,
+    have hj0 : 0 < j,
+    { apply nat.pos_of_ne_zero,
+      rintro rfl,
+      exact lt_irrefl 1 a1 },
+    have wj : w ≤ j := nat.le_of_dvd hj0 (modeq_zero_iff_dvd.1 $
+      (yn_modeq_a_sub_one hw1 j).symm.trans $ modeq_zero_iff_dvd.2 ⟨z, yj.symm⟩),
+    have hnka : n ^ k < xn hw1 j,
+    calc n^k ≤ n^j       : nat.pow_le_pow_of_le_right hn0 (le_trans kw wj)
+         ... < (w + 1)^j : nat.pow_lt_pow_of_lt_left (nat.lt_succ_of_le nw) hj0
+         ... ≤ xn hw1 j  : xn_ge_a_pow hw1 j,
+    have nt : (↑(n^k) : ℤ) < 2 * xn hw1 j * n - n * n - 1,
+      from eq_pow_of_pell_lem hn0.ne' hk0.ne' hnka,
+    have na : n ≤ xn hw1 j, from (nat.le_self_pow hk0.ne' _).trans hnka.le,
+    have te : (t : ℤ) = 2 * xn hw1 j * n - n * n - 1,
+    { rw [sub_sub, eq_sub_iff_add_eq],
+      exact_mod_cast ta.symm },
+    have : xn a1 k ≡ yn a1 k * (xn hw1 j - n) + n^k [MOD t],
+    { apply modeq_of_dvd,
+      rw [te, nat.cast_add, nat.cast_mul, int.coe_nat_sub na],
+      exact x_sub_y_dvd_pow a1 n k },
+    have : n^k % t = m % t, from (this.symm.trans tm).add_left_cancel' _,
+    rw [← te] at nt,
+    rwa [nat.mod_eq_of_lt (nat.cast_lt.1 nt), nat.mod_eq_of_lt mt] at this }
+end
+
+end pell
diff --git a/src/number_theory/prime_counting.lean b/src/number_theory/prime_counting.lean
index 1054b077f7add..6a699a1ae127d 100644
--- a/src/number_theory/prime_counting.lean
+++ b/src/number_theory/prime_counting.lean
@@ -4,9 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Bolton Bailey
 -/
 
-import data.nat.prime
+import data.nat.prime_fin
 import data.nat.totient
-import algebra.periodic
 import data.finset.locally_finite
 import data.nat.count
 import data.nat.nth
@@ -14,6 +13,9 @@ import data.nat.nth
 /-!
 # The Prime Counting Function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the prime counting function: the function on natural numbers that returns
 the number of primes less than or equal to its input.
 
@@ -48,19 +50,19 @@ def prime_counting' : ℕ → ℕ := nat.count prime
 /-- The prime counting function: Returns the number of primes less than or equal to the input. -/
 def prime_counting (n : ℕ) : ℕ := prime_counting' (n + 1)
 
-localized "notation `π` := nat.prime_counting" in nat
-localized "notation `π'` := nat.prime_counting'" in nat
+localized "notation (name := prime_counting) `π` := nat.prime_counting" in nat
+localized "notation (name := prime_counting') `π'` := nat.prime_counting'" in nat
 
 lemma monotone_prime_counting' : monotone prime_counting' := count_monotone prime
 
 lemma monotone_prime_counting : monotone prime_counting :=
-λ a b a_le_b, monotone_prime_counting' (add_le_add_right a_le_b 1)
+monotone_prime_counting'.comp (monotone_id.add_const _)
 
 @[simp] lemma prime_counting'_nth_eq (n : ℕ) : π' (nth prime n) = n :=
-count_nth_of_infinite _ infinite_set_of_prime _
+count_nth_of_infinite infinite_set_of_prime _
 
 @[simp] lemma prime_nth_prime (n : ℕ) : prime (nth prime n) :=
-nth_mem_of_infinite _ infinite_set_of_prime _
+nth_mem_of_infinite infinite_set_of_prime _
 
 /-- A linear upper bound on the size of the `prime_counting'` function -/
 lemma prime_counting'_add_le {a k : ℕ} (h0 : 0 < a) (h1 : a < k) (n : ℕ) :
diff --git a/src/number_theory/primes_congruent_one.lean b/src/number_theory/primes_congruent_one.lean
index 213f45cc3b483..68d6d0d28d4d5 100644
--- a/src/number_theory/primes_congruent_one.lean
+++ b/src/number_theory/primes_congruent_one.lean
@@ -9,6 +9,9 @@ import ring_theory.polynomial.cyclotomic.eval
 /-!
 # Primes congruent to one
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We prove that, for any positive `k : ℕ`, there are infinitely many primes `p` such that
 `p ≡ 1 [MOD k]`.
 -/
@@ -16,60 +19,55 @@ We prove that, for any positive `k : ℕ`, there are infinitely many primes `p`
 namespace nat
 
 open polynomial nat filter
+open_locale nat
 
-/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
-lemma exists_prime_ge_modeq_one {k : ℕ} (n : ℕ) (hpos : 0 < k) :
-  ∃ (p : ℕ), nat.prime p ∧ n ≤ p ∧ p ≡ 1 [MOD k] :=
+/-- For any positive `k : ℕ` there exists an arbitrarily large prime `p` such that
+`p ≡ 1 [MOD k]`. -/
+lemma exists_prime_gt_modeq_one {k : ℕ} (n : ℕ) (hk0 : k ≠ 0) :
+  ∃ (p : ℕ), nat.prime p ∧ n < p ∧ p ≡ 1 [MOD k] :=
 begin
-  let b := 3 * (k * n.factorial),
+  rcases (one_le_iff_ne_zero.2 hk0).eq_or_lt with rfl | hk1,
+  { rcases exists_infinite_primes (n + 1) with ⟨p, hnp, hp⟩,
+    exact ⟨p, hp, hnp, modeq_one⟩ },
+  let b := k * n!,
   have hgt : 1 < (eval ↑b (cyclotomic k ℤ)).nat_abs,
-  { have hkey : ∀ l : ℕ, 2 < 3 * (l.succ * n.factorial) := λ l, lt_mul_of_lt_of_one_le
-          (2 : ℕ).lt_succ_self (le_mul_of_le_of_le_one (nat.succ_pos _) n.factorial_pos),
-    rcases k with _ | _ | k,
-    { simpa using hpos, },
-    { simp only [one_mul, int.coe_nat_mul, int.coe_nat_succ, int.coe_nat_zero, zero_add,
-        cyclotomic_one, eval_sub, eval_X, eval_one],
-      convert int.nat_abs_lt_nat_abs_of_nonneg_of_lt int.one_nonneg _,
-      rw lt_sub_iff_add_lt,
-      specialize hkey 0,
-      norm_cast,
-      rwa one_mul at hkey, },
-    calc 1 ≤ _ : by { rw le_tsub_iff_left (one_le_two.trans (hkey _).le), exact (hkey _).le, }
-       ... < _ : sub_one_lt_nat_abs_cyclotomic_eval (one_lt_succ_succ k)
-                   (one_lt_two.trans (hkey k.succ)).ne.symm, },
+  { rcases le_iff_exists_add'.1 hk1.le with ⟨k, rfl⟩,
+    have hb : 2 ≤ b := le_mul_of_le_of_one_le hk1 n.factorial_pos,
+    calc 1 ≤ b - 1 : le_tsub_of_add_le_left hb
+    ... < (eval (b : ℤ) (cyclotomic (k + 1) ℤ)).nat_abs :
+      sub_one_lt_nat_abs_cyclotomic_eval hk1 (succ_le_iff.1 hb).ne' },
   let p := min_fac (eval ↑b (cyclotomic k ℤ)).nat_abs,
   haveI hprime : fact p.prime := ⟨min_fac_prime (ne_of_lt hgt).symm⟩,
   have hroot : is_root (cyclotomic k (zmod p)) (cast_ring_hom (zmod p) b),
   { rw [is_root.def, ← map_cyclotomic_int k (zmod p), eval_map, coe_cast_ring_hom,
-    ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval₂_hom, int.coe_cast_ring_hom,
+      ← int.cast_coe_nat, ← int.coe_cast_ring_hom, eval₂_hom, int.coe_cast_ring_hom,
       zmod.int_coe_zmod_eq_zero_iff_dvd _ _],
     apply int.dvd_nat_abs.1,
     exact_mod_cast min_fac_dvd (eval ↑b (cyclotomic k ℤ)).nat_abs },
-  refine ⟨p, hprime.1, _, _⟩,
-  { by_contra habs,
-    exact (prime.dvd_iff_not_coprime hprime.1).1
-      (dvd_factorial (min_fac_pos _) (le_of_not_ge habs))
-      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_left_right },
-  { have hdiv := order_of_dvd_of_pow_eq_one (zmod.units_pow_card_sub_one_eq_one p
-      (zmod.unit_of_coprime b (coprime_of_root_cyclotomic hpos hroot))),
-    have : ¬p ∣ k := hprime.1.coprime_iff_not_dvd.1
-      (coprime_of_root_cyclotomic hpos hroot).symm.coprime_mul_left_right.coprime_mul_right_right,
-    haveI := ne_zero.of_not_dvd (zmod p) this,
+  have hpb : ¬(p ∣ b) :=
+    hprime.1.coprime_iff_not_dvd.1 (coprime_of_root_cyclotomic hk0.bot_lt hroot).symm,
+  refine ⟨p, hprime.1, not_le.1 $ λ habs, _, _⟩,
+  { exact hpb (dvd_mul_of_dvd_right (dvd_factorial (min_fac_pos _) habs) _) },
+  { have hdiv : order_of (b : zmod p) ∣ p - 1 :=
+      zmod.order_of_dvd_card_sub_one (mt (char_p.cast_eq_zero_iff _ _ _).1 hpb),
+    haveI : ne_zero (k : zmod p) :=
+      ne_zero.of_not_dvd (zmod p) (λ hpk, hpb (dvd_mul_of_dvd_left hpk _)),
     have : k = order_of (b : zmod p) := (is_root_cyclotomic_iff.mp hroot).eq_order_of,
-    rw [←order_of_units, zmod.coe_unit_of_coprime, ←this] at hdiv,
+    rw [← this] at hdiv,
     exact ((modeq_iff_dvd' hprime.1.pos).2 hdiv).symm }
 end
 
-lemma frequently_at_top_modeq_one {k : ℕ} (hpos : 0 < k) :
+lemma frequently_at_top_modeq_one {k : ℕ} (hk0 : k ≠ 0) :
   ∃ᶠ p in at_top, nat.prime p ∧ p ≡ 1 [MOD k] :=
 begin
   refine frequently_at_top.2 (λ n, _),
-  obtain ⟨p, hp⟩ := exists_prime_ge_modeq_one n hpos,
-  exact ⟨p, ⟨hp.2.1, hp.1, hp.2.2⟩⟩
+  obtain ⟨p, hp⟩ := exists_prime_gt_modeq_one n hk0,
+  exact ⟨p, ⟨hp.2.1.le, hp.1, hp.2.2⟩⟩
 end
 
-lemma infinite_set_of_prime_modeq_one {k : ℕ} (hpos : 0 < k) :
+/-- For any positive `k : ℕ` there are infinitely many primes `p` such that `p ≡ 1 [MOD k]`. -/
+lemma infinite_set_of_prime_modeq_one {k : ℕ} (hk0 : k ≠ 0) :
   set.infinite {p : ℕ | nat.prime p ∧ p ≡ 1 [MOD k]} :=
-frequently_at_top_iff_infinite.1 (frequently_at_top_modeq_one hpos)
+frequently_at_top_iff_infinite.1 (frequently_at_top_modeq_one hk0)
 
 end nat
diff --git a/src/number_theory/primorial.lean b/src/number_theory/primorial.lean
index 2c4354995fe52..5eea76e716d1e 100644
--- a/src/number_theory/primorial.lean
+++ b/src/number_theory/primorial.lean
@@ -1,16 +1,20 @@
 /-
 Copyright (c) 2020 Patrick Stevens. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Patrick Stevens
+Authors: Patrick Stevens, Yury Kudryashov
 -/
 import algebra.big_operators.associated
 import data.nat.choose.sum
+import data.nat.choose.dvd
 import data.nat.parity
-import tactic.ring_exp
+import data.nat.prime
 
 /-!
 # Primorial
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the primorial function (the product of primes less than or equal to some bound),
 and proves that `primorial n ≤ 4 ^ n`.
 
@@ -29,105 +33,54 @@ open_locale big_operators nat
 def primorial (n : ℕ) : ℕ := ∏ p in (filter nat.prime (range (n + 1))), p
 local notation x`#` := primorial x
 
-lemma primorial_succ {n : ℕ} (n_big : 1 < n) (r : n % 2 = 1) : (n + 1)# = n# :=
+lemma primorial_pos (n : ℕ) : 0 < n# :=
+prod_pos $ λ p hp, (mem_filter.1 hp).2.pos
+
+lemma primorial_succ {n : ℕ} (hn1 : n ≠ 1) (hn : odd n) : (n + 1)# = n# :=
 begin
   refine prod_congr _ (λ _ _, rfl),
-  rw [range_succ, filter_insert, if_neg (λ h, _)],
-  have two_dvd : 2 ∣ n + 1 := (dvd_iff_mod_eq_zero _ _).mpr (by rw [← mod_add_mod, r, mod_self]),
-  linarith [(h.dvd_iff_eq (nat.bit0_ne_one 1)).mp two_dvd],
+  rw [range_succ, filter_insert, if_neg (λ h, odd_iff_not_even.mp hn _)],
+  exact (h.even_sub_one $ mt succ.inj hn1)
 end
 
-lemma dvd_choose_of_middling_prime (p : ℕ) (is_prime : nat.prime p) (m : ℕ)
-  (p_big : m + 1 < p) (p_small : p ≤ 2 * m + 1) : p ∣ choose (2 * m + 1) (m + 1) :=
+lemma primorial_add (m n : ℕ) :
+  (m + n)# = m# * ∏ p in filter nat.prime (Ico (m + 1) (m + n + 1)), p :=
 begin
-  have m_size : m + 1 ≤ 2 * m + 1 := le_of_lt (lt_of_lt_of_le p_big p_small),
-  have s : ¬(p ∣ (m + 1)!),
-  { intros p_div_fact,
-    exact lt_le_antisymm p_big (is_prime.dvd_factorial.mp p_div_fact), },
-  have t : ¬(p ∣ (2 * m + 1 - (m + 1))!),
-  { intros p_div_fact,
-    refine lt_le_antisymm (lt_of_succ_lt p_big) _,
-    convert is_prime.dvd_factorial.mp p_div_fact,
-    rw [two_mul, add_assoc, nat.add_sub_cancel] },
-  have expanded :
-    choose (2 * m + 1) (m + 1) * (m + 1)! * (2 * m + 1 - (m + 1))! = (2 * m + 1)! :=
-    @choose_mul_factorial_mul_factorial (2 * m + 1) (m + 1) m_size,
-  have p_div_big_fact : p ∣ (2 * m + 1)! := (prime.dvd_factorial is_prime).mpr p_small,
-  rw [←expanded, mul_assoc] at p_div_big_fact,
-  obtain p_div_choose | p_div_facts : p ∣ choose (2 * m + 1) (m + 1) ∨ p ∣ _! * _! :=
-    (prime.dvd_mul is_prime).1 p_div_big_fact,
-  { exact p_div_choose, },
-  cases (prime.dvd_mul is_prime).1 p_div_facts,
-  exacts [(s h).elim, (t h).elim],
+  rw [primorial, primorial, ← Ico_zero_eq_range, ← prod_union, ← filter_union,
+    Ico_union_Ico_eq_Ico],
+  exacts [zero_le _, add_le_add_right (nat.le_add_right _ _) _,
+    disjoint_filter_filter $ Ico_disjoint_Ico_consecutive _ _ _]
 end
 
-lemma primorial_le_4_pow : ∀ (n : ℕ), n# ≤ 4 ^ n
-| 0 := le_rfl
-| 1 := le_of_inf_eq rfl
-| (n + 2) :=
-  match nat.mod_two_eq_zero_or_one (n + 1) with
-  | or.inl n_odd :=
-    match nat.even_iff.2 n_odd with
-    | ⟨m, twice_m⟩ :=
-      have recurse : m + 1 < n + 2 := by linarith,
-      begin
-        calc (n + 2)#
-            = ∏ i in filter nat.prime (range (2 * m + 2)), i : by simpa [two_mul, ←twice_m]
-        ... = ∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2) ∪ range (m + 2)), i :
-              begin
-                rw [range_eq_Ico, finset.union_comm, finset.Ico_union_Ico_eq_Ico],
-                { exact bot_le },
-                { simpa only [add_le_add_iff_right, two_mul] using nat.le_add_left m m },
-              end
-        ... = ∏ i in (filter nat.prime (finset.Ico (m + 2) (2 * m + 2))
-              ∪ (filter nat.prime (range (m + 2)))), i :
-              by rw filter_union
-        ... = (∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)), i)
-              * (∏ i in filter nat.prime (range (m + 2)), i) :
-              begin
-                apply finset.prod_union,
-                have disj : disjoint (finset.Ico (m + 2) (2 * m + 2)) (range (m + 2)),
-                { simp only [finset.disjoint_left, and_imp, finset.mem_Ico, not_lt,
-                    finset.mem_range],
-                  intros _ pr _, exact pr, },
-                exact finset.disjoint_filter_filter disj,
-              end
-        ... ≤ (∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)), i) * 4 ^ (m + 1) :
-              nat.mul_le_mul_left _ (primorial_le_4_pow (m + 1))
-        ... ≤ (choose (2 * m + 1) (m + 1)) * 4 ^ (m + 1) :
-              begin
-                have s : ∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)),
-                  i ∣ choose (2 * m + 1) (m + 1),
-                { refine prod_primes_dvd  (choose (2 * m + 1) (m + 1)) _ _,
-                  { intros a, rw [finset.mem_filter, nat.prime_iff], apply and.right, },
-                  { intros a, rw finset.mem_filter,
-                    intros pr,
-                    rcases pr with ⟨ size, is_prime ⟩,
-                    simp only [finset.mem_Ico] at size,
-                    rcases size with ⟨ a_big , a_small ⟩,
-                    exact dvd_choose_of_middling_prime a is_prime m a_big
-                      (nat.lt_succ_iff.mp a_small), }, },
-                have r : ∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)),
-                  i ≤ choose (2 * m + 1) (m + 1),
-                { refine @nat.le_of_dvd _ _ _ s,
-                  exact @choose_pos (2 * m + 1) (m + 1) (by linarith), },
-                exact nat.mul_le_mul_right _ r,
-              end
-        ... = (choose (2 * m + 1) m) * 4 ^ (m + 1) : by rw choose_symm_half m
-        ... ≤ 4 ^ m * 4 ^ (m + 1) : nat.mul_le_mul_right _ (choose_middle_le_pow m)
-        ... = 4 ^ (2 * m + 1) : by ring_exp
-        ... = 4 ^ (n + 2) : by rw [two_mul, ←twice_m],
-      end
-    end
-  | or.inr n_even :=
+lemma primorial_add_dvd {m n : ℕ} (h : n ≤ m) : (m + n)# ∣ m# * choose (m + n) m :=
+calc (m + n)# = m# * ∏ p in filter nat.prime (Ico (m + 1) (m + n + 1)), p :
+  primorial_add _ _
+... ∣ m# * choose (m + n) m :
+  mul_dvd_mul_left _ $ prod_primes_dvd _ (λ k hk, (mem_filter.1 hk).2.prime) $ λ p hp,
     begin
-      obtain one_lt_n | n_le_one : 1 < n + 1 ∨ n + 1 ≤ 1 := lt_or_le 1 (n + 1),
-      { rw primorial_succ one_lt_n n_even,
-        calc (n + 1)#
-              ≤ 4 ^ n.succ : primorial_le_4_pow (n + 1)
-          ... ≤ 4 ^ (n + 2) : pow_le_pow (by norm_num) (nat.le_succ _), },
-      { have n_zero : n = 0 := eq_bot_iff.2 (succ_le_succ_iff.1 n_le_one),
-        norm_num [n_zero, primorial, range_succ, prod_filter, nat.not_prime_zero, nat.prime_two] },
+      rw [mem_filter, mem_Ico] at hp,
+      exact hp.2.dvd_choose_add hp.1.1 (h.trans_lt (m.lt_succ_self.trans_le hp.1.1))
+        (nat.lt_succ_iff.1 hp.1.2)
     end
 
+lemma primorial_add_le {m n : ℕ} (h : n ≤ m) : (m + n)# ≤ m# * choose (m + n) m :=
+le_of_dvd (mul_pos (primorial_pos _) (choose_pos $ nat.le_add_right _ _)) (primorial_add_dvd h)
+
+lemma primorial_le_4_pow (n : ℕ) : n# ≤ 4 ^ n :=
+begin
+  induction n using nat.strong_induction_on with n ihn,
+  cases n, { refl },
+  rcases n.even_or_odd with (⟨m, rfl⟩ | ho),
+  { rcases m.eq_zero_or_pos with rfl | hm, { dec_trivial },
+    calc (m + m + 1)# = (m + 1 + m)# : by rw [add_right_comm]
+    ... ≤ (m + 1)# * choose (m + 1 + m) (m + 1) : primorial_add_le m.le_succ
+    ... = (m + 1)# * choose (2 * m + 1) m : by rw [choose_symm_add, two_mul, add_right_comm]
+    ... ≤ 4 ^ (m + 1) * 4 ^ m :
+      mul_le_mul' (ihn _ $ succ_lt_succ $ (lt_add_iff_pos_left _).2 hm) (choose_middle_le_pow _)
+    ... ≤ 4 ^ (m + m + 1) : by rw [← pow_add, add_right_comm] },
+  { rcases decidable.eq_or_ne n 1 with rfl | hn,
+    { dec_trivial },
+    { calc (n + 1)# = n# : primorial_succ hn ho
+      ... ≤ 4 ^ n : ihn n n.lt_succ_self
+      ... ≤ 4 ^ (n + 1) : pow_le_pow_of_le_right  four_pos n.le_succ } }
 end
diff --git a/src/number_theory/pythagorean_triples.lean b/src/number_theory/pythagorean_triples.lean
index 7af2d59a0aac5..dfbe9fe522e63 100644
--- a/src/number_theory/pythagorean_triples.lean
+++ b/src/number_theory/pythagorean_triples.lean
@@ -5,15 +5,18 @@ Authors: Paul van Wamelen
 -/
 import algebra.field.basic
 import ring_theory.int.basic
-import algebra.group_with_zero.power
 import tactic.ring
 import tactic.ring_exp
 import tactic.field_simp
+import data.int.nat_prime
 import data.zmod.basic
 
 /-!
 # Pythagorean Triples
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The main result is the classification of Pythagorean triples. The final result is for general
 Pythagorean triples. It follows from the more interesting relatively prime case. We use the
 "rational parametrization of the circle" method for the proof. The parametrization maps the point
@@ -126,8 +129,8 @@ begin
   { -- x even, y even
     exfalso,
     apply nat.not_coprime_of_dvd_of_dvd (dec_trivial : 1 < 2) _ _ hc,
-    { apply int.dvd_nat_abs_of_of_nat_dvd, apply int.dvd_of_mod_eq_zero hx },
-    { apply int.dvd_nat_abs_of_of_nat_dvd, apply int.dvd_of_mod_eq_zero hy } },
+    { apply int.coe_nat_dvd_left.1, apply int.dvd_of_mod_eq_zero hx },
+    { apply int.coe_nat_dvd_left.1, apply int.dvd_of_mod_eq_zero hy } },
   { left, exact ⟨hx, hy⟩ },  -- x even, y odd
   { right, exact ⟨hx, hy⟩ }, -- x odd, y even
   { -- x odd, y odd
@@ -262,7 +265,7 @@ def circle_equiv_gen (hk : ∀ x : K, 1 + x^2 ≠ 0) :
   right_inv := λ ⟨⟨x, y⟩, hxy, hy⟩,
   begin
     change x ^ 2 + y ^ 2 = 1 at hxy,
-    have h2 : y + 1 ≠ 0, { apply mt eq_neg_of_add_eq_zero, exact hy },
+    have h2 : y + 1 ≠ 0 := mt eq_neg_of_add_eq_zero_left hy,
     have h3 : (y + 1) ^ 2 + x ^ 2 = 2 * (y + 1),
     { rw [(add_neg_eq_iff_eq_add.mpr hxy.symm).symm], ring },
     have h4 : (2 : K) ≠ 0, { convert hk 1, rw one_pow 2, refl },
@@ -331,8 +334,7 @@ begin
     apply mt (int.dvd_gcd (int.coe_nat_dvd_left.mpr hpm)) hnp,
     apply (or_self _).mp, apply int.prime.dvd_mul' hp,
     rw (by ring : n * n = - (m ^ 2 - n ^ 2) + m * m),
-    apply dvd_add (dvd_neg_of_dvd hp1),
-    exact dvd_mul_of_dvd_left (int.coe_nat_dvd_left.mpr hpm) m },
+    exact hp1.neg_right.add ((int.coe_nat_dvd_left.2 hpm).mul_right _) },
   rw int.gcd_comm at hnp,
   apply mt (int.dvd_gcd (int.coe_nat_dvd_left.mpr hpn)) hnp,
   apply (or_self _).mp, apply int.prime.dvd_mul' hp,
diff --git a/src/number_theory/ramification_inertia.lean b/src/number_theory/ramification_inertia.lean
new file mode 100644
index 0000000000000..91585ce4cc595
--- /dev/null
+++ b/src/number_theory/ramification_inertia.lean
@@ -0,0 +1,835 @@
+/-
+Copyright (c) 2022 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+
+import linear_algebra.free_module.finite.rank
+import ring_theory.dedekind_domain.ideal
+
+/-!
+# Ramification index and inertia degree
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given `P : ideal S` lying over `p : ideal R` for the ring extension `f : R →+* S`
+(assuming `P` and `p` are prime or maximal where needed),
+the **ramification index** `ideal.ramification_idx f p P` is the multiplicity of `P` in `map f p`,
+and the **inertia degree** `ideal.inertia_deg f p P` is the degree of the field extension
+`(S / P) : (R / p)`.
+
+## Main results
+
+The main theorem `ideal.sum_ramification_inertia` states that for all coprime `P` lying over `p`,
+`Σ P, ramification_idx f p P * inertia_deg f p P` equals the degree of the field extension
+`Frac(S) : Frac(R)`.
+
+## Implementation notes
+
+Often the above theory is set up in the case where:
+ * `R` is the ring of integers of a number field `K`,
+ * `L` is a finite separable extension of `K`,
+ * `S` is the integral closure of `R` in `L`,
+ * `p` and `P` are maximal ideals,
+ * `P` is an ideal lying over `p`
+We will try to relax the above hypotheses as much as possible.
+
+## Notation
+
+In this file, `e` stands for the ramification index and `f` for the inertia degree of `P` over `p`,
+leaving `p` and `P` implicit.
+
+-/
+
+namespace ideal
+
+universes u v
+
+variables {R : Type u} [comm_ring R]
+variables {S : Type v} [comm_ring S] (f : R →+* S)
+variables (p : ideal R) (P : ideal S)
+
+open finite_dimensional
+open unique_factorization_monoid
+
+section dec_eq
+
+open_locale classical
+
+/-- The ramification index of `P` over `p` is the largest exponent `n` such that
+`p` is contained in `P^n`.
+
+In particular, if `p` is not contained in `P^n`, then the ramification index is 0.
+
+If there is no largest such `n` (e.g. because `p = ⊥`), then `ramification_idx` is
+defined to be 0.
+-/
+noncomputable def ramification_idx : ℕ :=
+Sup {n | map f p ≤ P ^ n}
+
+variables {f p P}
+
+lemma ramification_idx_eq_find (h : ∃ n, ∀ k, map f p ≤ P ^ k → k ≤ n) :
+  ramification_idx f p P = nat.find h :=
+nat.Sup_def h
+
+lemma ramification_idx_eq_zero (h : ∀ n : ℕ, ∃ k, map f p ≤ P ^ k ∧ n < k) :
+  ramification_idx f p P = 0 :=
+dif_neg (by push_neg; exact h)
+
+lemma ramification_idx_spec {n : ℕ} (hle : map f p ≤ P ^ n) (hgt : ¬ map f p ≤ P ^ (n + 1)) :
+  ramification_idx f p P = n :=
+begin
+  have : ∀ (k : ℕ), map f p ≤ P ^ k → k ≤ n,
+  { intros k hk,
+    refine le_of_not_lt (λ hnk, _),
+    exact hgt (hk.trans (ideal.pow_le_pow hnk)) },
+  rw ramification_idx_eq_find ⟨n, this⟩,
+  { refine le_antisymm (nat.find_min' _ this) (le_of_not_gt (λ (h : nat.find _ < n), _)),
+    obtain this' := nat.find_spec ⟨n, this⟩,
+    exact h.not_le (this' _ hle) },
+end
+
+lemma ramification_idx_lt {n : ℕ} (hgt : ¬ (map f p ≤ P ^ n)) :
+  ramification_idx f p P < n :=
+begin
+  cases n,
+  { simpa using hgt },
+  rw nat.lt_succ_iff,
+  have : ∀ k, map f p ≤ P ^ k → k ≤ n,
+  { refine λ k hk, le_of_not_lt (λ hnk, _),
+    exact hgt (hk.trans (ideal.pow_le_pow hnk)) },
+  rw ramification_idx_eq_find ⟨n, this⟩,
+  exact nat.find_min' ⟨n, this⟩ this
+end
+
+@[simp] lemma ramification_idx_bot : ramification_idx f ⊥ P = 0 :=
+dif_neg $ not_exists.mpr $ λ n hn, n.lt_succ_self.not_le (hn _ (by simp))
+
+@[simp] lemma ramification_idx_of_not_le (h : ¬ map f p ≤ P) : ramification_idx f p P = 0 :=
+ramification_idx_spec (by simp) (by simpa using h)
+
+lemma ramification_idx_ne_zero {e : ℕ} (he : e ≠ 0)
+  (hle : map f p ≤ P ^ e) (hnle : ¬ map f p ≤ P ^ (e + 1)):
+  ramification_idx f p P ≠ 0 :=
+by rwa ramification_idx_spec hle hnle
+
+lemma le_pow_of_le_ramification_idx {n : ℕ} (hn : n ≤ ramification_idx f p P) :
+  map f p ≤ P ^ n :=
+begin
+  contrapose! hn,
+  exact ramification_idx_lt hn
+end
+
+lemma le_pow_ramification_idx :
+  map f p ≤ P ^ ramification_idx f p P :=
+le_pow_of_le_ramification_idx (le_refl _)
+
+lemma le_comap_pow_ramification_idx :
+  p ≤ comap f (P ^ ramification_idx f p P) :=
+map_le_iff_le_comap.mp le_pow_ramification_idx
+
+lemma le_comap_of_ramification_idx_ne_zero (h : ramification_idx f p P ≠ 0) : p ≤ comap f P :=
+ideal.map_le_iff_le_comap.mp $ le_pow_ramification_idx.trans $ ideal.pow_le_self $ h
+
+namespace is_dedekind_domain
+
+variables [is_domain S] [is_dedekind_domain S]
+
+lemma ramification_idx_eq_normalized_factors_count
+  (hp0 : map f p ≠ ⊥) (hP : P.is_prime) (hP0 : P ≠ ⊥) :
+  ramification_idx f p P = (normalized_factors (map f p)).count P :=
+begin
+  have hPirr := (ideal.prime_of_is_prime hP0 hP).irreducible,
+  refine ramification_idx_spec (ideal.le_of_dvd _) (mt ideal.dvd_iff_le.mpr _);
+    rw [dvd_iff_normalized_factors_le_normalized_factors (pow_ne_zero _ hP0) hp0,
+        normalized_factors_pow, normalized_factors_irreducible hPirr, normalize_eq,
+        multiset.nsmul_singleton, ← multiset.le_count_iff_replicate_le],
+  { exact (nat.lt_succ_self _).not_le },
+end
+
+lemma ramification_idx_eq_factors_count (hp0 : map f p ≠ ⊥) (hP : P.is_prime) (hP0 : P ≠ ⊥) :
+  ramification_idx f p P = (factors (map f p)).count P :=
+by rw [is_dedekind_domain.ramification_idx_eq_normalized_factors_count hp0 hP hP0,
+       factors_eq_normalized_factors]
+
+lemma ramification_idx_ne_zero (hp0 : map f p ≠ ⊥) (hP : P.is_prime) (le : map f p ≤ P) :
+  ramification_idx f p P ≠ 0 :=
+begin
+  have hP0 : P ≠ ⊥,
+  { unfreezingI { rintro rfl },
+    have := le_bot_iff.mp le,
+    contradiction },
+  have hPirr := (ideal.prime_of_is_prime hP0 hP).irreducible,
+  rw is_dedekind_domain.ramification_idx_eq_normalized_factors_count hp0 hP hP0,
+  obtain ⟨P', hP', P'_eq⟩ :=
+    exists_mem_normalized_factors_of_dvd hp0 hPirr (ideal.dvd_iff_le.mpr le),
+  rwa [multiset.count_ne_zero, associated_iff_eq.mp P'_eq],
+end
+
+end is_dedekind_domain
+
+variables (f p P)
+
+local attribute [instance] ideal.quotient.field
+
+/-- The inertia degree of `P : ideal S` lying over `p : ideal R` is the degree of the
+extension `(S / P) : (R / p)`.
+
+We do not assume `P` lies over `p` in the definition; we return `0` instead.
+
+See `inertia_deg_algebra_map` for the common case where `f = algebra_map R S`
+and there is an algebra structure `R / p → S / P`.
+-/
+noncomputable def inertia_deg [hp : p.is_maximal] : ℕ :=
+if hPp : comap f P = p
+then @finrank (R ⧸ p) (S ⧸ P) _ _ $ @algebra.to_module _ _ _ _ $ ring_hom.to_algebra $
+  ideal.quotient.lift p (P^.quotient.mk^.comp f) $
+  λ a ha, quotient.eq_zero_iff_mem.mpr $ mem_comap.mp $ hPp.symm ▸ ha
+else 0
+
+-- Useful for the `nontriviality` tactic using `comap_eq_of_scalar_tower_quotient`.
+@[simp] lemma inertia_deg_of_subsingleton [hp : p.is_maximal] [hQ : subsingleton (S ⧸ P)] :
+  inertia_deg f p P = 0 :=
+begin
+  have := ideal.quotient.subsingleton_iff.mp hQ,
+  unfreezingI { subst this },
+  exact dif_neg (λ h, hp.ne_top $ h.symm.trans comap_top)
+end
+
+@[simp] lemma inertia_deg_algebra_map [algebra R S] [algebra (R ⧸ p) (S ⧸ P)]
+  [is_scalar_tower R (R ⧸ p) (S ⧸ P)]
+  [hp : p.is_maximal] :
+  inertia_deg (algebra_map R S) p P = finrank (R ⧸ p) (S ⧸ P) :=
+begin
+  nontriviality (S ⧸ P) using [inertia_deg_of_subsingleton, finrank_zero_of_subsingleton],
+  have := comap_eq_of_scalar_tower_quotient (algebra_map (R ⧸ p) (S ⧸ P)).injective,
+  rw [inertia_deg, dif_pos this],
+  congr,
+  refine algebra.algebra_ext _ _ (λ x', quotient.induction_on' x' $ λ x, _),
+  change ideal.quotient.lift p _ _ (ideal.quotient.mk p x) =
+    algebra_map _ _ (ideal.quotient.mk p x),
+  rw [ideal.quotient.lift_mk, ← ideal.quotient.algebra_map_eq, ← is_scalar_tower.algebra_map_eq,
+      ← ideal.quotient.algebra_map_eq, ← is_scalar_tower.algebra_map_apply]
+end
+
+end dec_eq
+
+section finrank_quotient_map
+
+open_locale big_operators
+open_locale non_zero_divisors
+
+variables [algebra R S]
+variables {K : Type*} [field K] [algebra R K] [hRK : is_fraction_ring R K]
+variables {L : Type*} [field L] [algebra S L] [is_fraction_ring S L]
+variables {V V' V'' : Type*}
+variables [add_comm_group V] [module R V] [module K V] [is_scalar_tower R K V]
+variables [add_comm_group V'] [module R V'] [module S V'] [is_scalar_tower R S V']
+variables [add_comm_group V''] [module R V'']
+
+variables (K)
+include hRK
+/-- Let `V` be a vector space over `K = Frac(R)`, `S / R` a ring extension
+and `V'` a module over `S`. If `b`, in the intersection `V''` of `V` and `V'`,
+is linear independent over `S` in `V'`, then it is linear independent over `R` in `V`.
+
+The statement we prove is actually slightly more general:
+ * it suffices that the inclusion `algebra_map R S : R → S` is nontrivial
+ * the function `f' : V'' → V'` doesn't need to be injective
+-/
+lemma finrank_quotient_map.linear_independent_of_nontrivial
+  [is_domain R] [is_dedekind_domain R] (hRS : (algebra_map R S).ker ≠ ⊤)
+  (f : V'' →ₗ[R] V) (hf : function.injective f) (f' : V'' →ₗ[R] V')
+  {ι : Type*} {b : ι → V''} (hb' : linear_independent S (f' ∘ b)) :
+  linear_independent K (f ∘ b) :=
+begin
+  contrapose! hb' with hb,
+  -- Informally, if we have a nontrivial linear dependence with coefficients `g` in `K`,
+  -- then we can find a linear dependence with coefficients `I.quotient.mk g'` in `R/I`,
+  -- where `I = ker (algebra_map R S)`.
+  -- We make use of the same principle but stay in `R` everywhere.
+  simp only [linear_independent_iff', not_forall] at hb ⊢,
+  obtain ⟨s, g, eq, j', hj's, hj'g⟩ := hb,
+  use s,
+  obtain ⟨a, hag, j, hjs, hgI⟩ :=
+    ideal.exist_integer_multiples_not_mem hRS s g hj's hj'g,
+  choose g'' hg'' using hag,
+  letI := classical.prop_decidable,
+  let g' := λ i, if h : i ∈ s then g'' i h else 0,
+  have hg' : ∀ i ∈ s, algebra_map _ _ (g' i) = a * g i,
+  { intros i hi, exact (congr_arg _ (dif_pos hi)).trans (hg'' i hi) },
+  -- Because `R/I` is nontrivial, we can lift `g` to a nontrivial linear dependence in `S`.
+  have hgI : algebra_map R S (g' j) ≠ 0,
+  { simp only [fractional_ideal.mem_coe_ideal, not_exists, not_and'] at hgI,
+    exact hgI _ (hg' j hjs) },
+  refine ⟨λ i, algebra_map R S (g' i), _, j, hjs, hgI⟩,
+  have eq : f (∑ i in s, g' i • (b i)) = 0,
+  { rw [linear_map.map_sum, ← smul_zero a, ← eq, finset.smul_sum, finset.sum_congr rfl],
+    intros i hi,
+    rw [linear_map.map_smul, ← is_scalar_tower.algebra_map_smul K, hg' i hi, ← smul_assoc,
+        smul_eq_mul],
+    apply_instance },
+  simp only [is_scalar_tower.algebra_map_smul, ← linear_map.map_smul, ← linear_map.map_sum,
+          (f.map_eq_zero_iff hf).mp eq, linear_map.map_zero],
+end
+
+open_locale matrix
+
+variables {K}
+omit hRK
+/-- If `b` mod `p` spans `S/p` as `R/p`-space, then `b` itself spans `Frac(S)` as `K`-space.
+
+Here,
+ * `p` is an ideal of `R` such that `R / p` is nontrivial
+ * `K` is a field that has an embedding of `R` (in particular we can take `K = Frac(R)`)
+ * `L` is a field extension of `K`
+ * `S` is the integral closure of `R` in `L`
+
+More precisely, we avoid quotients in this statement and instead require that `b ∪ pS` spans `S`.
+-/
+lemma finrank_quotient_map.span_eq_top [is_domain R] [is_domain S] [algebra K L] [is_noetherian R S]
+  [algebra R L] [is_scalar_tower R S L] [is_scalar_tower R K L] [is_integral_closure S R L]
+  [no_zero_smul_divisors R K]
+  (hp : p ≠ ⊤)
+  (b : set S) (hb' : submodule.span R b ⊔ (p.map (algebra_map R S)).restrict_scalars R = ⊤) :
+  submodule.span K (algebra_map S L '' b) = ⊤ :=
+begin
+  have hRL : function.injective (algebra_map R L),
+  { rw is_scalar_tower.algebra_map_eq R K L,
+    exact (algebra_map K L).injective.comp (no_zero_smul_divisors.algebra_map_injective R K) },
+  -- Let `M` be the `R`-module spanned by the proposed basis elements.
+  set M : submodule R S := submodule.span R b with hM,
+  -- Then `S / M` is generated by some finite set of `n` vectors `a`.
+  letI h : module.finite R (S ⧸ M) :=
+    module.finite.of_surjective (submodule.mkq _) (submodule.quotient.mk_surjective _),
+  obtain ⟨n, a, ha⟩ := @@module.finite.exists_fin _ _ _ h,
+  -- Because the image of `p` in `S / M` is `⊤`,
+  have smul_top_eq : p • (⊤ : submodule R (S ⧸ M)) = ⊤,
+  { calc p • ⊤ = submodule.map M.mkq (p • ⊤) :
+      by rw [submodule.map_smul'', submodule.map_top, M.range_mkq]
+    ... = ⊤ : by rw [ideal.smul_top_eq_map, (submodule.map_mkq_eq_top M _).mpr hb'] },
+  -- we can write the elements of `a` as `p`-linear combinations of other elements of `a`.
+  have exists_sum : ∀ x : (S ⧸ M), ∃ a' : fin n → R, (∀ i, a' i ∈ p) ∧ ∑ i, a' i • a i = x,
+  { intro x,
+    obtain ⟨a'', ha'', hx⟩ := (submodule.mem_ideal_smul_span_iff_exists_sum p a x).1 _,
+    { refine ⟨λ i, a'' i, λ i, ha'' _, _⟩,
+      rw [← hx, finsupp.sum_fintype],
+      exact λ _, zero_smul _ _ },
+    { rw [ha, smul_top_eq],
+      exact submodule.mem_top } },
+  choose A' hA'p hA' using λ i, exists_sum (a i),
+  -- This gives us a(n invertible) matrix `A` such that `det A ∈ (M = span R b)`,
+  let A : matrix (fin n) (fin n) R := A' - 1,
+  let B := A.adjugate,
+  have A_smul : ∀ i, ∑ j, A i j • a j = 0,
+  { intros,
+    simp only [A, pi.sub_apply, sub_smul, finset.sum_sub_distrib, hA', matrix.one_apply, ite_smul,
+      one_smul, zero_smul, finset.sum_ite_eq, finset.mem_univ, if_true, sub_self] },
+  -- since `span S {det A} / M = 0`.
+  have d_smul : ∀ i, A.det • a i = 0,
+  { intro i,
+    calc A.det • a i = ∑ j, (B ⬝ A) i j • a j : _
+                 ... = ∑ k, B i k • ∑ j, (A k j • a j) : _
+                 ... = 0 : finset.sum_eq_zero (λ k _, _),
+    { simp only [matrix.adjugate_mul, pi.smul_apply, matrix.one_apply, mul_ite, ite_smul,
+        smul_eq_mul, mul_one, mul_zero, one_smul, zero_smul, finset.sum_ite_eq, finset.mem_univ,
+        if_true] },
+    { simp only [matrix.mul_apply, finset.smul_sum, finset.sum_smul, smul_smul],
+      rw finset.sum_comm },
+    { rw [A_smul, smul_zero] } },
+  -- In the rings of integers we have the desired inclusion.
+  have span_d : (submodule.span S ({algebra_map R S A.det} : set S)).restrict_scalars R ≤ M,
+  { intros x hx,
+    rw submodule.restrict_scalars_mem at hx,
+    obtain ⟨x', rfl⟩ := submodule.mem_span_singleton.mp hx,
+    rw [smul_eq_mul, mul_comm, ← algebra.smul_def] at ⊢ hx,
+    rw [← submodule.quotient.mk_eq_zero, submodule.quotient.mk_smul],
+    obtain ⟨a', _, quot_x_eq⟩ := exists_sum (submodule.quotient.mk x'),
+    simp_rw [← quot_x_eq, finset.smul_sum, smul_comm A.det, d_smul, smul_zero,
+      finset.sum_const_zero] },
+  -- So now we lift everything to the fraction field.
+  refine top_le_iff.mp (calc ⊤ = (ideal.span {algebra_map R L A.det}).restrict_scalars K : _
+                           ... ≤ submodule.span K (algebra_map S L '' b) : _),
+  -- Because `det A ≠ 0`, we have `span L {det A} = ⊤`.
+  { rw [eq_comm, submodule.restrict_scalars_eq_top_iff, ideal.span_singleton_eq_top],
+    refine is_unit.mk0 _ ((map_ne_zero_iff ((algebra_map R L)) hRL).mpr (
+      @ne_zero_of_map _ _ _ _ _ _ (ideal.quotient.mk p) _ _)),
+    haveI := ideal.quotient.nontrivial hp,
+    calc ideal.quotient.mk p (A.det)
+          = matrix.det ((ideal.quotient.mk p).map_matrix A) :
+        by rw [ring_hom.map_det, ring_hom.map_matrix_apply]
+      ... = matrix.det ((ideal.quotient.mk p).map_matrix (A' - 1)) : rfl
+      ... = matrix.det (λ i j, (ideal.quotient.mk p) (A' i j) -
+              (1 : matrix (fin n) (fin n) (R ⧸ p)) i j) : _
+      ... = matrix.det (-1 : matrix (fin n) (fin n) (R ⧸ p)) : _
+      ... = (-1 : R ⧸ p) ^ n : by rw [matrix.det_neg, fintype.card_fin, matrix.det_one, mul_one]
+      ... ≠ 0 : is_unit.ne_zero (is_unit_one.neg.pow _),
+    { refine congr_arg matrix.det (matrix.ext (λ i j, _)),
+      rw [map_sub, ring_hom.map_matrix_apply, map_one],
+      refl },
+    { refine congr_arg matrix.det (matrix.ext (λ i j, _)),
+      rw [ideal.quotient.eq_zero_iff_mem.mpr (hA'p i j), zero_sub],
+      refl } },
+  -- And we conclude `L = span L {det A} ≤ span K b`, so `span K b` spans everything.
+  { intros x hx,
+    rw [submodule.restrict_scalars_mem, is_scalar_tower.algebra_map_apply R S L] at hx,
+    refine is_fraction_ring.ideal_span_singleton_map_subset R _ hRL span_d hx,
+    haveI : no_zero_smul_divisors R L := no_zero_smul_divisors.of_algebra_map_injective hRL,
+    rw ← is_fraction_ring.is_algebraic_iff' R S,
+    intros x,
+    exact is_integral.is_algebraic _ (is_integral_of_noetherian infer_instance _) },
+end
+
+include hRK
+variables (K L)
+/-- If `p` is a maximal ideal of `R`, and `S` is the integral closure of `R` in `L`,
+then the dimension `[S/pS : R/p]` is equal to `[Frac(S) : Frac(R)]`. -/
+lemma finrank_quotient_map [is_domain R] [is_domain S] [is_dedekind_domain R]
+  [algebra K L] [algebra R L] [is_scalar_tower R K L] [is_scalar_tower R S L]
+  [is_integral_closure S R L]
+  [hp : p.is_maximal] [is_noetherian R S] :
+  finrank (R ⧸ p) (S ⧸ map (algebra_map R S) p) = finrank K L :=
+begin
+  -- Choose an arbitrary basis `b` for `[S/pS : R/p]`.
+  -- We'll use the previous results to turn it into a basis on `[Frac(S) : Frac(R)]`.
+  letI : field (R ⧸ p) := ideal.quotient.field _,
+  let ι := module.free.choose_basis_index (R ⧸ p) (S ⧸ map (algebra_map R S) p),
+  let b : basis ι (R ⧸ p) (S ⧸ map (algebra_map R S) p) := module.free.choose_basis _ _,
+  -- Namely, choose a representative `b' i : S` for each `b i : S / pS`.
+  let b' : ι → S := λ i, (ideal.quotient.mk_surjective (b i)).some,
+  have b_eq_b' : ⇑ b = (submodule.mkq _).restrict_scalars R ∘ b' :=
+    funext (λ i, (ideal.quotient.mk_surjective (b i)).some_spec.symm),
+  -- We claim `b'` is a basis for `Frac(S)` over `Frac(R)` because it is linear independent
+  -- and spans the whole of `Frac(S)`.
+  let b'' : ι → L := algebra_map S L ∘ b',
+  have b''_li : linear_independent _ b'' := _,
+  have b''_sp : submodule.span _ (set.range b'') = ⊤ := _,
+  -- Since the two bases have the same index set, the spaces have the same dimension.
+  let c : basis ι K L := basis.mk b''_li b''_sp.ge,
+  rw [finrank_eq_card_basis b, finrank_eq_card_basis c],
+  -- It remains to show that the basis is indeed linear independent and spans the whole space.
+  { rw set.range_comp,
+    refine finrank_quotient_map.span_eq_top p hp.ne_top _ (top_le_iff.mp _),
+    -- The nicest way to show `S ≤ span b' ⊔ pS` is by reducing both sides modulo pS.
+    -- However, this would imply distinguishing between `pS` as `S`-ideal,
+    -- and `pS` as `R`-submodule, since they have different (non-defeq) quotients.
+    -- Instead we'll lift `x mod pS ∈ span b` to `y ∈ span b'` for some `y - x ∈ pS`.
+    intros x hx,
+    have mem_span_b :
+      ((submodule.mkq (map (algebra_map R S) p)) x :
+        S ⧸ map (algebra_map R S) p) ∈ submodule.span (R ⧸ p) (set.range b) := b.mem_span _,
+    rw [← @submodule.restrict_scalars_mem R,
+        submodule.restrict_scalars_span R (R ⧸ p) ideal.quotient.mk_surjective,
+        b_eq_b', set.range_comp, ← submodule.map_span]
+      at mem_span_b,
+    obtain ⟨y, y_mem, y_eq⟩ := submodule.mem_map.mp mem_span_b,
+    suffices : y + -(y - x) ∈ _, { simpa },
+    rw [linear_map.restrict_scalars_apply, submodule.mkq_apply, submodule.mkq_apply,
+        submodule.quotient.eq] at y_eq,
+    exact add_mem (submodule.mem_sup_left y_mem) (neg_mem $ submodule.mem_sup_right y_eq) },
+  { have := b.linear_independent, rw b_eq_b' at this,
+    convert finrank_quotient_map.linear_independent_of_nontrivial K _
+      ((algebra.linear_map S L).restrict_scalars R) _
+      ((submodule.mkq _).restrict_scalars R)
+      this,
+    { rw [quotient.algebra_map_eq, ideal.mk_ker],
+      exact hp.ne_top },
+    { exact is_fraction_ring.injective S L } },
+end
+
+end finrank_quotient_map
+
+section fact_le_comap
+
+local notation `e` := ramification_idx f p P
+
+/-- `R / p` has a canonical map to `S / (P ^ e)`, where `e` is the ramification index
+of `P` over `p`. -/
+noncomputable instance quotient.algebra_quotient_pow_ramification_idx :
+  algebra (R ⧸ p) (S ⧸ (P ^ e)) :=
+quotient.algebra_quotient_of_le_comap (ideal.map_le_iff_le_comap.mp le_pow_ramification_idx)
+
+@[simp] lemma quotient.algebra_map_quotient_pow_ramification_idx (x : R) :
+  algebra_map (R ⧸ p) (S ⧸ P ^ e) (ideal.quotient.mk p x) = ideal.quotient.mk _ (f x) :=
+rfl
+
+variables [hfp : ne_zero (ramification_idx f p P)]
+include hfp
+
+/-- If `P` lies over `p`, then `R / p` has a canonical map to `S / P`.
+
+This can't be an instance since the map `f : R → S` is generally not inferrable.
+-/
+def quotient.algebra_quotient_of_ramification_idx_ne_zero :
+  algebra (R ⧸ p) (S ⧸ P) :=
+quotient.algebra_quotient_of_le_comap (le_comap_of_ramification_idx_ne_zero hfp.out)
+
+-- In this file, the value for `f` can be inferred.
+local attribute [instance] ideal.quotient.algebra_quotient_of_ramification_idx_ne_zero
+
+@[simp] lemma quotient.algebra_map_quotient_of_ramification_idx_ne_zero (x : R) :
+  algebra_map (R ⧸ p) (S ⧸ P) (ideal.quotient.mk p x) = ideal.quotient.mk _ (f x) :=
+rfl
+
+omit hfp
+
+/-- The inclusion `(P^(i + 1) / P^e) ⊂ (P^i / P^e)`. -/
+@[simps]
+def pow_quot_succ_inclusion (i : ℕ) :
+  ideal.map (P^e)^.quotient.mk (P ^ (i + 1)) →ₗ[R ⧸ p] ideal.map (P^e)^.quotient.mk (P ^ i) :=
+{ to_fun := λ x, ⟨x, ideal.map_mono (ideal.pow_le_pow i.le_succ) x.2⟩,
+  map_add' := λ x y, rfl,
+  map_smul' := λ c x, rfl }
+
+lemma pow_quot_succ_inclusion_injective (i : ℕ) :
+  function.injective (pow_quot_succ_inclusion f p P i) :=
+begin
+  rw [← linear_map.ker_eq_bot, linear_map.ker_eq_bot'],
+  rintro ⟨x, hx⟩ hx0,
+  rw subtype.ext_iff at hx0 ⊢,
+  rwa pow_quot_succ_inclusion_apply_coe at hx0
+end
+
+/-- `S ⧸ P` embeds into the quotient by `P^(i+1) ⧸ P^e` as a subspace of `P^i ⧸ P^e`.
+See `quotient_to_quotient_range_pow_quot_succ` for this as a linear map,
+and `quotient_range_pow_quot_succ_inclusion_equiv` for this as a linear equivalence.
+-/
+noncomputable def quotient_to_quotient_range_pow_quot_succ_aux {i : ℕ} {a : S} (a_mem : a ∈ P^i) :
+  S ⧸ P → ((P ^ i).map (P ^ e)^.quotient.mk ⧸ (pow_quot_succ_inclusion f p P i).range) :=
+quotient.map' (λ (x : S), ⟨_, ideal.mem_map_of_mem _ (ideal.mul_mem_left _ x a_mem)⟩)
+  (λ x y h, begin
+    rw submodule.quotient_rel_r_def at ⊢ h,
+    simp only [_root_.map_mul, linear_map.mem_range],
+    refine ⟨⟨_, ideal.mem_map_of_mem _ (ideal.mul_mem_mul h a_mem)⟩, _⟩,
+    ext,
+    rw [pow_quot_succ_inclusion_apply_coe, subtype.coe_mk, submodule.coe_sub, subtype.coe_mk,
+        subtype.coe_mk, _root_.map_mul, map_sub, sub_mul]
+  end)
+
+lemma quotient_to_quotient_range_pow_quot_succ_aux_mk {i : ℕ} {a : S} (a_mem : a ∈ P^i) (x : S) :
+  quotient_to_quotient_range_pow_quot_succ_aux f p P a_mem (submodule.quotient.mk x) =
+    submodule.quotient.mk ⟨_, ideal.mem_map_of_mem _ (ideal.mul_mem_left _ x a_mem)⟩ :=
+by apply quotient.map'_mk'
+
+include hfp
+
+/-- `S ⧸ P` embeds into the quotient by `P^(i+1) ⧸ P^e` as a subspace of `P^i ⧸ P^e`. -/
+noncomputable def quotient_to_quotient_range_pow_quot_succ {i : ℕ} {a : S} (a_mem : a ∈ P^i) :
+  S ⧸ P →ₗ[R ⧸ p] ((P ^ i).map (P ^ e)^.quotient.mk ⧸ (pow_quot_succ_inclusion f p P i).range) :=
+{ to_fun := quotient_to_quotient_range_pow_quot_succ_aux f p P a_mem,
+  map_add' := begin
+    intros x y, refine quotient.induction_on' x (λ x, quotient.induction_on' y (λ y, _)),
+    simp only [submodule.quotient.mk'_eq_mk, ← submodule.quotient.mk_add,
+              quotient_to_quotient_range_pow_quot_succ_aux_mk, add_mul],
+    refine congr_arg submodule.quotient.mk _,
+    ext,
+    refl
+  end,
+  map_smul' := begin
+    intros x y, refine quotient.induction_on' x (λ x, quotient.induction_on' y (λ y, _)),
+    simp only [submodule.quotient.mk'_eq_mk, ← submodule.quotient.mk_add,
+              quotient_to_quotient_range_pow_quot_succ_aux_mk, ring_hom.id_apply],
+    refine congr_arg submodule.quotient.mk _,
+    ext,
+    simp only [subtype.coe_mk, _root_.map_mul, algebra.smul_def, submodule.coe_mk, mul_assoc,
+              ideal.quotient.mk_eq_mk, submodule.coe_smul_of_tower,
+              ideal.quotient.algebra_map_quotient_pow_ramification_idx]
+  end }
+
+lemma quotient_to_quotient_range_pow_quot_succ_mk {i : ℕ} {a : S} (a_mem : a ∈ P^i) (x : S) :
+  quotient_to_quotient_range_pow_quot_succ f p P a_mem (submodule.quotient.mk x) =
+    submodule.quotient.mk ⟨_, ideal.mem_map_of_mem _ (ideal.mul_mem_left _ x a_mem)⟩ :=
+quotient_to_quotient_range_pow_quot_succ_aux_mk f p P a_mem x
+
+lemma quotient_to_quotient_range_pow_quot_succ_injective [is_domain S] [is_dedekind_domain S]
+  [P.is_prime] {i : ℕ} (hi : i < e) {a : S} (a_mem : a ∈ P^i) (a_not_mem : a ∉ P^(i + 1)) :
+  function.injective (quotient_to_quotient_range_pow_quot_succ f p P a_mem) :=
+λ x, quotient.induction_on' x $ λ x y, quotient.induction_on' y $ λ y h,
+begin
+  have Pe_le_Pi1 : P^e ≤ P^(i + 1) := ideal.pow_le_pow hi,
+  simp only [submodule.quotient.mk'_eq_mk, quotient_to_quotient_range_pow_quot_succ_mk,
+    submodule.quotient.eq, linear_map.mem_range, subtype.ext_iff, subtype.coe_mk,
+    submodule.coe_sub] at ⊢ h,
+  rcases h with ⟨⟨⟨z⟩, hz⟩, h⟩,
+  rw [submodule.quotient.quot_mk_eq_mk, ideal.quotient.mk_eq_mk, ideal.mem_quotient_iff_mem_sup,
+      sup_eq_left.mpr Pe_le_Pi1] at hz,
+  rw [pow_quot_succ_inclusion_apply_coe, subtype.coe_mk, submodule.quotient.quot_mk_eq_mk,
+      ideal.quotient.mk_eq_mk, ← map_sub, ideal.quotient.eq, ← sub_mul] at h,
+  exact (ideal.is_prime.mul_mem_pow _
+    ((submodule.sub_mem_iff_right _ hz).mp (Pe_le_Pi1 h))).resolve_right a_not_mem,
+end
+
+lemma quotient_to_quotient_range_pow_quot_succ_surjective [is_domain S] [is_dedekind_domain S]
+  (hP0 : P ≠ ⊥) [hP : P.is_prime] {i : ℕ} (hi : i < e)
+  {a : S} (a_mem : a ∈ P^i) (a_not_mem : a ∉ P^(i + 1)) :
+  function.surjective (quotient_to_quotient_range_pow_quot_succ f p P a_mem) :=
+begin
+  rintro ⟨⟨⟨x⟩, hx⟩⟩,
+  have Pe_le_Pi : P^e ≤ P^i := ideal.pow_le_pow hi.le,
+  have Pe_le_Pi1 : P^e ≤ P^(i + 1) := ideal.pow_le_pow hi,
+  rw [submodule.quotient.quot_mk_eq_mk, ideal.quotient.mk_eq_mk, ideal.mem_quotient_iff_mem_sup,
+      sup_eq_left.mpr Pe_le_Pi] at hx,
+  suffices hx' : x ∈ ideal.span {a} ⊔ P^(i+1),
+  { obtain ⟨y', hy', z, hz, rfl⟩ := submodule.mem_sup.mp hx',
+    obtain ⟨y, rfl⟩ := ideal.mem_span_singleton.mp hy',
+    refine ⟨submodule.quotient.mk y, _⟩,
+    simp only [submodule.quotient.quot_mk_eq_mk, quotient_to_quotient_range_pow_quot_succ_mk,
+        submodule.quotient.eq, linear_map.mem_range, subtype.ext_iff, subtype.coe_mk,
+        submodule.coe_sub],
+    refine ⟨⟨_, ideal.mem_map_of_mem _ (submodule.neg_mem _ hz)⟩, _⟩,
+    rw [pow_quot_succ_inclusion_apply_coe, subtype.coe_mk, ideal.quotient.mk_eq_mk, map_add,
+        mul_comm y a, sub_add_cancel', map_neg] },
+  letI := classical.dec_eq (ideal S),
+  rw [sup_eq_prod_inf_factors _ (pow_ne_zero _ hP0), normalized_factors_pow,
+      normalized_factors_irreducible ((ideal.prime_iff_is_prime hP0).mpr hP).irreducible,
+      normalize_eq, multiset.nsmul_singleton, multiset.inter_replicate, multiset.prod_replicate],
+  rw [← submodule.span_singleton_le_iff_mem, ideal.submodule_span_eq] at a_mem a_not_mem,
+  rwa [ideal.count_normalized_factors_eq a_mem a_not_mem, min_eq_left i.le_succ],
+  { intro ha,
+    rw ideal.span_singleton_eq_bot.mp ha at a_not_mem,
+    have := (P^(i+1)).zero_mem,
+    contradiction },
+end
+
+/-- Quotienting `P^i / P^e` by its subspace `P^(i+1) ⧸ P^e` is
+`R ⧸ p`-linearly isomorphic to `S ⧸ P`. -/
+noncomputable def quotient_range_pow_quot_succ_inclusion_equiv [is_domain S] [is_dedekind_domain S]
+  [P.is_prime] (hP : P ≠ ⊥) {i : ℕ} (hi : i < e) :
+  ((P ^ i).map (P ^ e)^.quotient.mk ⧸ (pow_quot_succ_inclusion f p P i).range) ≃ₗ[R ⧸ p] S ⧸ P :=
+begin
+  choose a a_mem a_not_mem using set_like.exists_of_lt
+    (ideal.strict_anti_pow P hP (ideal.is_prime.ne_top infer_instance) (le_refl i.succ)),
+  refine (linear_equiv.of_bijective _ ⟨_, _⟩).symm,
+  { exact quotient_to_quotient_range_pow_quot_succ f p P a_mem },
+  { exact quotient_to_quotient_range_pow_quot_succ_injective f p P hi a_mem a_not_mem },
+  { exact quotient_to_quotient_range_pow_quot_succ_surjective f p P hP hi a_mem a_not_mem }
+end
+
+/-- Since the inclusion `(P^(i + 1) / P^e) ⊂ (P^i / P^e)` has a kernel isomorphic to `P / S`,
+`[P^i / P^e : R / p] = [P^(i+1) / P^e : R / p] + [P / S : R / p]` -/
+lemma rank_pow_quot_aux [is_domain S] [is_dedekind_domain S] [p.is_maximal] [P.is_prime]
+  (hP0 : P ≠ ⊥) {i : ℕ} (hi : i < e) :
+  module.rank (R ⧸ p) (ideal.map (P^e)^.quotient.mk (P ^ i)) =
+  module.rank (R ⧸ p) (S ⧸ P) + module.rank (R ⧸ p) (ideal.map (P^e)^.quotient.mk (P ^ (i + 1))) :=
+begin
+  letI : field (R ⧸ p) := ideal.quotient.field _,
+  rw [rank_eq_of_injective _ (pow_quot_succ_inclusion_injective f p P i),
+      (quotient_range_pow_quot_succ_inclusion_equiv f p P hP0 hi).symm.rank_eq],
+  exact (rank_quotient_add_rank (linear_map.range (pow_quot_succ_inclusion f p P i))).symm,
+end
+
+lemma rank_pow_quot [is_domain S] [is_dedekind_domain S] [p.is_maximal] [P.is_prime]
+  (hP0 : P ≠ ⊥) (i : ℕ) (hi : i ≤ e) :
+  module.rank (R ⧸ p) (ideal.map (P^e)^.quotient.mk (P ^ i)) =
+  (e - i) • module.rank (R ⧸ p) (S ⧸ P) :=
+begin
+  refine @nat.decreasing_induction' _ i e (λ j lt_e le_j ih, _) hi _,
+  { rw [rank_pow_quot_aux f p P _ lt_e, ih, ← succ_nsmul, nat.sub_succ, ← nat.succ_eq_add_one,
+      nat.succ_pred_eq_of_pos (nat.sub_pos_of_lt lt_e)],
+    assumption },
+  { rw [nat.sub_self, zero_nsmul, map_quotient_self],
+    exact rank_bot (R ⧸ p) (S ⧸ (P^e)) }
+end
+
+omit hfp
+
+/-- If `p` is a maximal ideal of `R`, `S` extends `R` and `P^e` lies over `p`,
+then the dimension `[S/(P^e) : R/p]` is equal to `e * [S/P : R/p]`. -/
+lemma rank_prime_pow_ramification_idx [is_domain S] [is_dedekind_domain S] [p.is_maximal]
+  [P.is_prime] (hP0 : P ≠ ⊥) (he : e ≠ 0) :
+  module.rank (R ⧸ p) (S ⧸ P^e) =
+  e • @module.rank (R ⧸ p) (S ⧸ P) _ _ (@algebra.to_module _ _ _ _ $
+    @@quotient.algebra_quotient_of_ramification_idx_ne_zero _ _ _ _ _ ⟨he⟩) :=
+begin
+  letI : ne_zero e := ⟨he⟩,
+  have := rank_pow_quot f p P hP0 0 (nat.zero_le e),
+  rw [pow_zero, nat.sub_zero, ideal.one_eq_top, ideal.map_top] at this,
+  exact (rank_top (R ⧸ p) _).symm.trans this
+end
+
+/-- If `p` is a maximal ideal of `R`, `S` extends `R` and `P^e` lies over `p`,
+then the dimension `[S/(P^e) : R/p]`, as a natural number, is equal to `e * [S/P : R/p]`. -/
+lemma finrank_prime_pow_ramification_idx [is_domain S] [is_dedekind_domain S]
+  (hP0 : P ≠ ⊥) [p.is_maximal] [P.is_prime] (he : e ≠ 0) :
+  finrank (R ⧸ p) (S ⧸ P^e) =
+  e * @finrank (R ⧸ p) (S ⧸ P) _ _ (@algebra.to_module _ _ _ _ $
+    @@quotient.algebra_quotient_of_ramification_idx_ne_zero _ _ _ _ _ ⟨he⟩) :=
+begin
+  letI : ne_zero e := ⟨he⟩,
+  letI : algebra (R ⧸ p) (S ⧸ P) := quotient.algebra_quotient_of_ramification_idx_ne_zero f p P,
+  letI := ideal.quotient.field p,
+  have hdim := rank_prime_pow_ramification_idx _ _ _ hP0 he,
+  by_cases hP : finite_dimensional (R ⧸ p) (S ⧸ P),
+  { haveI := hP,
+    haveI := (finite_dimensional_iff_of_rank_eq_nsmul he hdim).mpr hP,
+    refine cardinal.nat_cast_injective _,
+    rw [finrank_eq_rank', nat.cast_mul, finrank_eq_rank', hdim, nsmul_eq_mul] },
+  have hPe := mt (finite_dimensional_iff_of_rank_eq_nsmul he hdim).mp hP,
+  simp only [finrank_of_infinite_dimensional hP, finrank_of_infinite_dimensional hPe, mul_zero],
+end
+
+end fact_le_comap
+
+section factors_map
+
+open_locale classical
+
+/-! ## Properties of the factors of `p.map (algebra_map R S)` -/
+
+variables [is_domain S] [is_dedekind_domain S] [algebra R S]
+
+lemma factors.ne_bot (P : (factors (map (algebra_map R S) p)).to_finset) :
+  (P : ideal S) ≠ ⊥ :=
+(prime_of_factor _ (multiset.mem_to_finset.mp P.2)).ne_zero
+
+instance factors.is_prime (P : (factors (map (algebra_map R S) p)).to_finset) :
+  is_prime (P : ideal S) :=
+ideal.is_prime_of_prime (prime_of_factor _ (multiset.mem_to_finset.mp P.2))
+
+lemma factors.ramification_idx_ne_zero (P : (factors (map (algebra_map R S) p)).to_finset) :
+  ramification_idx (algebra_map R S) p P ≠ 0 :=
+is_dedekind_domain.ramification_idx_ne_zero
+  (ne_zero_of_mem_factors (multiset.mem_to_finset.mp P.2))
+  (factors.is_prime p P)
+  (ideal.le_of_dvd (dvd_of_mem_factors (multiset.mem_to_finset.mp P.2)))
+
+instance factors.fact_ramification_idx_ne_zero (P : (factors (map (algebra_map R S) p)).to_finset) :
+  ne_zero (ramification_idx (algebra_map R S) p P) :=
+⟨factors.ramification_idx_ne_zero p P⟩
+
+local attribute [instance] quotient.algebra_quotient_of_ramification_idx_ne_zero
+
+instance factors.is_scalar_tower
+  (P : (factors (map (algebra_map R S) p)).to_finset) :
+  is_scalar_tower R (R ⧸ p) (S ⧸ (P : ideal S)) :=
+is_scalar_tower.of_algebra_map_eq (λ x, by simp)
+
+local attribute [instance] ideal.quotient.field
+
+lemma factors.finrank_pow_ramification_idx [p.is_maximal]
+  (P : (factors (map (algebra_map R S) p)).to_finset) :
+  finrank (R ⧸ p) (S ⧸ (P : ideal S) ^ ramification_idx (algebra_map R S) p P) =
+    ramification_idx (algebra_map R S) p P * inertia_deg (algebra_map R S) p P :=
+begin
+  rw [finrank_prime_pow_ramification_idx, inertia_deg_algebra_map],
+  exact factors.ne_bot p P,
+end
+
+instance factors.finite_dimensional_quotient [is_noetherian R S] [p.is_maximal]
+  (P : (factors (map (algebra_map R S) p)).to_finset) :
+  finite_dimensional (R ⧸ p) (S ⧸ (P : ideal S)) :=
+is_noetherian.iff_fg.mp $
+is_noetherian_of_tower R $
+is_noetherian_of_surjective S (ideal.quotient.mkₐ _ _).to_linear_map $
+linear_map.range_eq_top.mpr ideal.quotient.mk_surjective
+
+lemma factors.inertia_deg_ne_zero [is_noetherian R S] [p.is_maximal]
+  (P : (factors (map (algebra_map R S) p)).to_finset) :
+  inertia_deg (algebra_map R S) p P ≠ 0 :=
+by { rw inertia_deg_algebra_map, exact (finite_dimensional.finrank_pos_iff.mpr infer_instance).ne' }
+
+instance factors.finite_dimensional_quotient_pow [is_noetherian R S] [p.is_maximal]
+  (P : (factors (map (algebra_map R S) p)).to_finset) :
+  finite_dimensional (R ⧸ p) (S ⧸ (P : ideal S) ^ ramification_idx (algebra_map R S) p P) :=
+begin
+  refine finite_dimensional.finite_dimensional_of_finrank _,
+  rw [pos_iff_ne_zero, factors.finrank_pow_ramification_idx],
+  exact mul_ne_zero (factors.ramification_idx_ne_zero p P) (factors.inertia_deg_ne_zero p P)
+end
+
+universes w
+
+/-- **Chinese remainder theorem** for a ring of integers: if the prime ideal `p : ideal R`
+factors in `S` as `∏ i, P i ^ e i`, then `S ⧸ I` factors as `Π i, R ⧸ (P i ^ e i)`. -/
+noncomputable def factors.pi_quotient_equiv
+  (p : ideal R) (hp : map (algebra_map R S) p ≠ ⊥) :
+  (S ⧸ map (algebra_map R S) p) ≃+* Π (P : (factors (map (algebra_map R S) p)).to_finset),
+    S ⧸ ((P : ideal S) ^ ramification_idx (algebra_map R S) p P) :=
+(is_dedekind_domain.quotient_equiv_pi_factors hp).trans $
+(@ring_equiv.Pi_congr_right (factors (map (algebra_map R S) p)).to_finset
+  (λ P, S ⧸ (P : ideal S) ^ (factors (map (algebra_map R S) p)).count P)
+  (λ P, S ⧸ (P : ideal S) ^ ramification_idx (algebra_map R S) p P) _ _
+  (λ P : (factors (map (algebra_map R S) p)).to_finset, ideal.quot_equiv_of_eq $
+  by rw is_dedekind_domain.ramification_idx_eq_factors_count hp
+    (factors.is_prime p P) (factors.ne_bot p P)))
+
+@[simp] lemma factors.pi_quotient_equiv_mk
+  (p : ideal R) (hp : map (algebra_map R S) p ≠ ⊥) (x : S) :
+  factors.pi_quotient_equiv p hp (ideal.quotient.mk _ x) = λ P, ideal.quotient.mk _ x :=
+rfl
+
+@[simp] lemma factors.pi_quotient_equiv_map
+  (p : ideal R) (hp : map (algebra_map R S) p ≠ ⊥) (x : R) :
+  factors.pi_quotient_equiv p hp (algebra_map _ _ x) =
+    λ P, ideal.quotient.mk _ (algebra_map _ _ x) :=
+rfl
+
+variables (S)
+
+/-- **Chinese remainder theorem** for a ring of integers: if the prime ideal `p : ideal R`
+factors in `S` as `∏ i, P i ^ e i`,
+then `S ⧸ I` factors `R ⧸ I`-linearly as `Π i, R ⧸ (P i ^ e i)`. -/
+noncomputable def factors.pi_quotient_linear_equiv
+  (p : ideal R) (hp : map (algebra_map R S) p ≠ ⊥) :
+  (S ⧸ map (algebra_map R S) p) ≃ₗ[R ⧸ p] Π (P : (factors (map (algebra_map R S) p)).to_finset),
+    S ⧸ ((P : ideal S) ^ ramification_idx (algebra_map R S) p P) :=
+{ map_smul' := begin
+   rintro ⟨c⟩ ⟨x⟩, ext P,
+   simp only [ideal.quotient.mk_algebra_map,
+     factors.pi_quotient_equiv_mk, factors.pi_quotient_equiv_map, submodule.quotient.quot_mk_eq_mk,
+     pi.algebra_map_apply, ring_equiv.to_fun_eq_coe, pi.mul_apply,
+     ideal.quotient.algebra_map_quotient_map_quotient, ideal.quotient.mk_eq_mk, algebra.smul_def,
+     _root_.map_mul, ring_hom_comp_triple.comp_apply],
+   congr
+  end,
+  .. factors.pi_quotient_equiv p hp }
+
+variables {S}
+
+open_locale big_operators
+
+/-- The **fundamental identity** of ramification index `e` and inertia degree `f`:
+for `P` ranging over the primes lying over `p`, `∑ P, e P * f P = [Frac(S) : Frac(R)]`;
+here `S` is a finite `R`-module (and thus `Frac(S) : Frac(R)` is a finite extension) and `p`
+is maximal.
+-/
+theorem sum_ramification_inertia (K L : Type*) [field K] [field L]
+  [is_domain R] [is_dedekind_domain R]
+  [algebra R K] [is_fraction_ring R K] [algebra S L] [is_fraction_ring S L]
+  [algebra K L] [algebra R L] [is_scalar_tower R S L] [is_scalar_tower R K L]
+  [is_noetherian R S] [is_integral_closure S R L] [p.is_maximal] (hp0 : p ≠ ⊥) :
+  ∑ P in (factors (map (algebra_map R S) p)).to_finset,
+    ramification_idx (algebra_map R S) p P * inertia_deg (algebra_map R S) p P =
+    finrank K L :=
+begin
+  set e := ramification_idx (algebra_map R S) p,
+  set f := inertia_deg (algebra_map R S) p,
+  have inj_RL : function.injective (algebra_map R L),
+  { rw [is_scalar_tower.algebra_map_eq R K L, ring_hom.coe_comp],
+    exact (ring_hom.injective _).comp (is_fraction_ring.injective R K) },
+  have inj_RS : function.injective (algebra_map R S),
+  { refine function.injective.of_comp (show function.injective (algebra_map S L ∘ _), from _),
+    rw [← ring_hom.coe_comp, ← is_scalar_tower.algebra_map_eq],
+    exact inj_RL },
+  calc  ∑ P in (factors (map (algebra_map R S) p)).to_finset, e P * f P
+      = ∑ P in (factors (map (algebra_map R S) p)).to_finset.attach,
+          finrank (R ⧸ p) (S ⧸ (P : ideal S)^(e P)) : _
+  ... = finrank (R ⧸ p) (Π P : (factors (map (algebra_map R S) p)).to_finset,
+          (S ⧸ (P : ideal S)^(e P))) :
+    (finrank_pi_fintype (R ⧸ p)).symm
+  ... = finrank (R ⧸ p) (S ⧸ map (algebra_map R S) p) : _
+  ... = finrank K L : _,
+  { rw ← finset.sum_attach,
+    refine finset.sum_congr rfl (λ P _, _),
+    rw factors.finrank_pow_ramification_idx },
+  { refine linear_equiv.finrank_eq (factors.pi_quotient_linear_equiv S p _).symm,
+    rwa [ne.def, ideal.map_eq_bot_iff_le_ker, (ring_hom.injective_iff_ker_eq_bot _).mp inj_RS,
+         le_bot_iff] },
+  { exact finrank_quotient_map p K L },
+end
+
+end factors_map
+
+end ideal
diff --git a/src/number_theory/sum_four_squares.lean b/src/number_theory/sum_four_squares.lean
index 18e2a198015dc..8ea1a82447bc6 100644
--- a/src/number_theory/sum_four_squares.lean
+++ b/src/number_theory/sum_four_squares.lean
@@ -8,11 +8,14 @@ import algebra.group_power.identities
 import data.zmod.basic
 import field_theory.finite.basic
 import data.int.parity
-import data.fintype.card
+import data.fintype.big_operators
 
 /-!
 # Lagrange's four square theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The main result in this file is `sum_four_squares`,
 a proof that every natural number is the sum of four square numbers.
 
@@ -28,7 +31,7 @@ namespace int
 
 lemma sq_add_sq_of_two_mul_sq_add_sq {m x y : ℤ} (h : 2 * m = x^2 + y^2) :
   m = ((x - y) / 2) ^ 2 + ((x + y) / 2) ^ 2 :=
-have even (x^2 + y^2), by simp [h.symm, even_mul],
+have even (x^2 + y^2), by simp [←h, even_mul],
 have hxaddy : even (x + y), by simpa [sq] with parity_simps,
 have hxsuby : even (x - y), by simpa [sq] with parity_simps,
 (mul_right_inj' (show (2*2 : ℤ) ≠ 0, from dec_trivial)).1 $
@@ -46,7 +49,7 @@ let ⟨a, b, hab⟩ := zmod.sq_add_sq p (-1) in
 have hab' : (p : ℤ) ∣ a.val_min_abs ^ 2 + b.val_min_abs ^ 2 + 1,
   from (char_p.int_cast_eq_zero_iff (zmod p) p _).1 $ by simpa [eq_neg_iff_add_eq_zero] using hab,
 let ⟨k, hk⟩ := hab' in
-have hk0 : 0 ≤ k, from nonneg_of_mul_nonneg_left
+have hk0 : 0 ≤ k, from nonneg_of_mul_nonneg_right
   (by rw ← hk; exact (add_nonneg (add_nonneg (sq_nonneg _) (sq_nonneg _)) zero_le_one))
   (int.coe_nat_pos.2 hp.1.pos),
 ⟨a.val_min_abs, b.val_min_abs, k.nat_abs,
@@ -85,14 +88,16 @@ have ∀ f : fin 4 → zmod 2, (f 0)^2 + (f 1)^2 + (f 2)^2 + (f 3)^2 = 0 →
   from dec_trivial,
 let f : fin 4 → ℤ :=
   vector.nth (a ::ᵥ b ::ᵥ c ::ᵥ d ::ᵥ vector.nil) in
-let ⟨i, hσ⟩ := this (coe ∘ f) (by rw [← @zero_mul (zmod 2) _ m,
+let ⟨i, hσ⟩ := this (λ x, coe (f x)) (by rw [← @zero_mul (zmod 2) _ m,
   ← show ((2 : ℤ) : zmod 2) = 0, from rfl,
   ← int.cast_mul, ← h]; simp only [int.cast_add, int.cast_pow]; refl) in
 let σ := swap i 0 in
 have h01 : 2 ∣ f (σ 0) ^ 2 + f (σ 1) ^ 2,
-  from (char_p.int_cast_eq_zero_iff (zmod 2) 2 _).1 $ by simpa [σ] using hσ.1,
+  from (char_p.int_cast_eq_zero_iff (zmod 2) 2 _).1 $
+    by simpa only [int.cast_pow, int.cast_add, equiv.swap_apply_right, zmod.pow_card] using hσ.1,
 have h23 : 2 ∣ f (σ 2) ^ 2 + f (σ 3) ^ 2,
-  from (char_p.int_cast_eq_zero_iff (zmod 2) 2 _).1 $ by simpa using hσ.2,
+  from (char_p.int_cast_eq_zero_iff (zmod 2) 2 _).1 $
+    by simpa only [int.cast_pow, int.cast_add, zmod.pow_card] using hσ.2,
 let ⟨x, hx⟩ := h01 in let ⟨y, hy⟩ := h23 in
 ⟨(f (σ 0) - f (σ 1)) / 2, (f (σ 0) + f (σ 1)) / 2, (f (σ 2) - f (σ 3)) / 2, (f (σ 2) + f (σ 3)) / 2,
   begin
@@ -101,11 +106,10 @@ let ⟨x, hx⟩ := h01 in let ⟨y, hy⟩ := h23 in
       ← mul_right_inj' (show (2 : ℤ) ≠ 0, from dec_trivial), ← h, mul_add, ← hx, ← hy],
     have : ∑ x, f (σ x)^2 = ∑ x, f x^2,
     { conv_rhs { rw ←equiv.sum_comp σ } },
-    have fin4univ : (univ : finset (fin 4)).1 = 0 ::ₘ 1 ::ₘ 2 ::ₘ 3 ::ₘ 0, from dec_trivial,
-    simpa [finset.sum_eq_multiset_sum, fin4univ, multiset.sum_cons, f, add_assoc]
+    simpa only [fin.sum_univ_four, add_assoc] using this,
   end⟩
 
-private lemma prime_sum_four_squares (p : ℕ) [hp : _root_.fact p.prime] :
+private lemma prime_sum_four_squares (p : ℕ) [hp : fact p.prime] :
   ∃ a b c d : ℤ, a^2 + b^2 + c^2 + d^2 = p :=
 have hm : ∃ m < p, 0 < m ∧ ∃ a b c d : ℤ, a^2 + b^2 + c^2 + d^2 = m * p,
   from let ⟨a, b, k, hk⟩ := exists_sq_add_sq_add_one_eq_k p in
@@ -113,20 +117,21 @@ have hm : ∃ m < p, 0 < m ∧ ∃ a b c d : ℤ, a^2 + b^2 + c^2 + d^2 = m * p,
     (λ hk0, by { rw [hk0, int.coe_nat_zero, zero_mul] at hk,
       exact ne_of_gt (show a^2 + b^2 + 1 > 0, from add_pos_of_nonneg_of_pos
         (add_nonneg (sq_nonneg _) (sq_nonneg _)) zero_lt_one) hk.1 }),
-    a, b, 1, 0, by simpa [sq] using hk.1⟩,
+    a, b, 1, 0, by simpa only [zero_pow two_pos, one_pow, add_zero] using hk.1⟩,
 let m := nat.find hm in
 let ⟨a, b, c, d, (habcd : a^2 + b^2 + c^2 + d^2 = m * p)⟩ := (nat.find_spec hm).snd.2 in
-by haveI hm0 : _root_.fact (0 < m) := ⟨(nat.find_spec hm).snd.1⟩; exact
+by haveI hm0 : ne_zero m := ne_zero.of_pos (nat.find_spec hm).snd.1; exact
 have hmp : m < p, from (nat.find_spec hm).fst,
 m.mod_two_eq_zero_or_one.elim
   (λ hm2 : m % 2 = 0,
-    let ⟨k, hk⟩ := (nat.dvd_iff_mod_eq_zero _ _).2 hm2 in
-    have hk0 : 0 < k, from nat.pos_of_ne_zero $ λ _, by { simp [*, lt_irrefl] at * },
+    let ⟨k, hk⟩ := nat.dvd_iff_mod_eq_zero.2 hm2 in
+    have hk0 : 0 < k, from nat.pos_of_ne_zero $
+      by { rintro rfl, rw mul_zero at hk, exact ne_zero.ne m hk },
     have hkm : k < m, { rw [hk, two_mul], exact (lt_add_iff_pos_left _).2 hk0 },
     false.elim $ nat.find_min hm hkm ⟨lt_trans hkm hmp, hk0,
       sum_four_squares_of_two_mul_sum_four_squares
         (show a^2 + b^2 + c^2 + d^2 = 2 * (k * p),
-          by { rw [habcd, hk, int.coe_nat_mul, mul_assoc], simp })⟩)
+          by { rw [habcd, hk, int.coe_nat_mul, mul_assoc], norm_num })⟩)
   (λ hm2 : m % 2 = 1,
     if hm1 : m = 1 then ⟨a, b, c, d, by simp only [hm1, habcd, int.coe_nat_one, one_mul]⟩
     else
@@ -134,7 +139,7 @@ m.mod_two_eq_zero_or_one.elim
           y := (c : zmod m).val_min_abs, z := (d : zmod m).val_min_abs in
       have hnat_abs : w^2 + x^2 + y^2 + z^2 =
           (w.nat_abs^2 + x.nat_abs^2 + y.nat_abs ^2 + z.nat_abs ^ 2 : ℕ),
-        by simp [sq],
+        by { push_cast, simp_rw sq_abs, },
       have hwxyzlt : w^2 + x^2 + y^2 + z^2 < m^2,
         from calc w^2 + x^2 + y^2 + z^2
             = (w.nat_abs^2 + x.nat_abs^2 + y.nat_abs ^2 + z.nat_abs ^ 2 : ℕ) : hnat_abs
@@ -144,7 +149,8 @@ m.mod_two_eq_zero_or_one.elim
             (nat.pow_le_pow_of_le_left (zmod.nat_abs_val_min_abs_le _) _))
             (nat.pow_le_pow_of_le_left (zmod.nat_abs_val_min_abs_le _) _))
             (nat.pow_le_pow_of_le_left (zmod.nat_abs_val_min_abs_le _) _)
-        ... = 4 * (m / 2 : ℕ) ^ 2 : by simp [sq, bit0, bit1, mul_add, add_mul, add_assoc]
+        ... = 4 * (m / 2 : ℕ) ^ 2 : by simp only [bit0_mul, one_mul, two_smul,
+                                                  nat.cast_add, nat.cast_pow, add_assoc]
         ... < 4 * (m / 2 : ℕ) ^ 2 + ((4 * (m / 2) : ℕ) * (m % 2 : ℕ) + (m % 2 : ℕ)^2) :
           (lt_add_iff_pos_right _).2 (by { rw [hm2, int.coe_nat_one, one_pow, mul_one],
             exact add_pos_of_nonneg_of_pos (int.coe_nat_nonneg _) zero_lt_one })
@@ -153,7 +159,7 @@ m.mod_two_eq_zero_or_one.elim
             pow_add, add_comm, add_left_comm] },
       have hwxyzabcd : ((w^2 + x^2 + y^2 + z^2 : ℤ) : zmod m) =
           ((a^2 + b^2 + c^2 + d^2 : ℤ) : zmod m),
-        by simp [w, x, y, z, sq],
+        by push_cast,
       have hwxyz0 : ((w^2 + x^2 + y^2 + z^2 : ℤ) : zmod m) = 0,
         by rw [hwxyzabcd, habcd, int.cast_mul, cast_coe_nat, zmod.nat_cast_self, zero_mul],
       let ⟨n, hn⟩ := ((char_p.int_cast_eq_zero_iff _ m _).1 hwxyz0) in
@@ -161,36 +167,37 @@ m.mod_two_eq_zero_or_one.elim
         have hwxyz0 : (w.nat_abs^2 + x.nat_abs^2 + y.nat_abs^2 + z.nat_abs^2 : ℕ) = 0,
           by { rw [← int.coe_nat_eq_zero, ← hnat_abs], rwa [hn0, mul_zero] at hn },
         have habcd0 : (m : ℤ) ∣ a ∧ (m : ℤ) ∣ b ∧ (m : ℤ) ∣ c ∧ (m : ℤ) ∣ d,
-          by simpa [add_eq_zero_iff' (sq_nonneg (_ : ℤ)) (sq_nonneg _),
-            pow_two, w, x, y, z, (char_p.int_cast_eq_zero_iff _ m _), and.assoc] using hwxyz0,
+          by simpa only [add_eq_zero_iff, int.nat_abs_eq_zero, zmod.val_min_abs_eq_zero, and.assoc,
+                         pow_eq_zero_iff two_pos, char_p.int_cast_eq_zero_iff _ m _] using hwxyz0,
         let ⟨ma, hma⟩ := habcd0.1,     ⟨mb, hmb⟩ := habcd0.2.1,
             ⟨mc, hmc⟩ := habcd0.2.2.1, ⟨md, hmd⟩ := habcd0.2.2.2 in
         have hmdvdp : m ∣ p,
           from int.coe_nat_dvd.1 ⟨ma^2 + mb^2 + mc^2 + md^2,
-            (mul_right_inj' (show (m : ℤ) ≠ 0, from int.coe_nat_ne_zero_iff_pos.2 hm0.1)).1 $
+            (mul_right_inj' (show (m : ℤ) ≠ 0, from int.coe_nat_ne_zero.2 hm0.1)).1 $
               by { rw [← habcd, hma, hmb, hmc, hmd], ring }⟩,
         (hp.1.eq_one_or_self_of_dvd _ hmdvdp).elim hm1
         (λ hmeqp, by simpa [lt_irrefl, hmeqp] using hmp)),
       have hawbxcydz : ((m : ℕ) : ℤ) ∣ a * w + b * x + c * y + d * z,
-        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { rw [← hwxyz0], simp, ring },
+        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $
+          by { rw [← hwxyz0], simp_rw [sq], push_cast },
       have haxbwczdy : ((m : ℕ) : ℤ) ∣ a * x - b * w - c * z + d * y,
-        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { simp [sub_eq_add_neg], ring },
+        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { push_cast, ring },
       have haybzcwdx : ((m : ℕ) : ℤ) ∣ a * y + b * z - c * w - d * x,
-        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { simp [sub_eq_add_neg], ring },
+        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { push_cast, ring },
       have hazbycxdw : ((m : ℕ) : ℤ) ∣ a * z - b * y + c * x - d * w,
-        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { simp [sub_eq_add_neg], ring },
+        from (char_p.int_cast_eq_zero_iff (zmod m) m _).1 $ by { push_cast, ring },
       let ⟨s, hs⟩ := hawbxcydz, ⟨t, ht⟩ := haxbwczdy, ⟨u, hu⟩ := haybzcwdx, ⟨v, hv⟩ := hazbycxdw in
       have hn_nonneg : 0 ≤ n,
-        from nonneg_of_mul_nonneg_left
+        from nonneg_of_mul_nonneg_right
           (by { erw [← hn], repeat {try {refine add_nonneg _ _}, try {exact sq_nonneg _}} })
-          (int.coe_nat_pos.2 hm0.1),
+          (int.coe_nat_pos.2 $ ne_zero.pos m),
       have hnm : n.nat_abs < m,
         from int.coe_nat_lt.1 (lt_of_mul_lt_mul_left
           (by { rw [int.nat_abs_of_nonneg hn_nonneg, ← hn, ← sq], exact hwxyzlt })
           (int.coe_nat_nonneg m)),
       have hstuv : s^2 + t^2 + u^2 + v^2 = n.nat_abs * p,
         from (mul_right_inj' (show (m^2 : ℤ) ≠ 0, from pow_ne_zero 2
-            (int.coe_nat_ne_zero_iff_pos.2 hm0.1))).1 $
+            (int.coe_nat_ne_zero.2 hm0.1))).1 $
           calc (m : ℤ)^2 * (s^2 + t^2 + u^2 + v^2) = ((m : ℕ) * s)^2 + ((m : ℕ) * t)^2 +
               ((m : ℕ) * u)^2 + ((m : ℕ) * v)^2 :
             by { simp [mul_pow], ring }
@@ -204,7 +211,7 @@ lemma sum_four_squares : ∀ n : ℕ, ∃ a b c d : ℕ, a^2 + b^2 + c^2 + d^2 =
 | 0 := ⟨0, 0, 0, 0, rfl⟩
 | 1 := ⟨1, 0, 0, 0, rfl⟩
 | n@(k+2) :=
-have hm : _root_.fact (min_fac (k+2)).prime := ⟨min_fac_prime dec_trivial⟩,
+have hm : fact (min_fac (k+2)).prime := ⟨min_fac_prime dec_trivial⟩,
 have n / min_fac n < n := factors_lemma,
 let ⟨a, b, c, d, h₁⟩ := show ∃ a b c d : ℤ, a^2 + b^2 + c^2 + d^2 = min_fac n,
   by exactI prime_sum_four_squares (min_fac (k+2)) in
diff --git a/src/number_theory/sum_two_squares.lean b/src/number_theory/sum_two_squares.lean
index 098a5058731c6..863876134230f 100644
--- a/src/number_theory/sum_two_squares.lean
+++ b/src/number_theory/sum_two_squares.lean
@@ -1,31 +1,248 @@
 /-
 Copyright (c) 2019 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Chris Hughes
+Authors: Chris Hughes, Michael Stoll
 -/
 
-import number_theory.zsqrtd.gaussian_int
+import number_theory.zsqrtd.quadratic_reciprocity
+import tactic.linear_combination
 
 /-!
 # Sums of two squares
 
-Proof of Fermat's theorem on the sum of two squares. Every prime congruent to 1 mod 4 is the sum
-of two squares.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-# Todo
+Fermat's theorem on the sum of two squares. Every prime `p` congruent to 1 mod 4 is the
+sum of two squares; see `nat.prime.sq_add_sq` (which has the weaker assumption `p % 4 ≠ 3`).
 
-Fully characterize the natural numbers that are the sum of two squares: those such that for every
-prime p congruent to 3 mod 4, the largest power of p dividing them is even.
+We also give the result that characterizes the (positive) natural numbers that are sums
+of two squares as those numbers `n` such that for every prime `q` congruent to 3 mod 4, the
+exponent of the largest power of `q` dividing `n` is even; see `nat.eq_sq_add_sq_iff`.
+
+There is an alternative characterization as the numbers of the form `a^2 * b`, where `b` is a
+natural number such that `-1` is a square modulo `b`; see `nat.eq_sq_add_sq_iff_eq_sq_mul`.
 -/
 
+section Fermat
+
 open gaussian_int
 
-/-- **Fermat's theorem on the sum of two squares**. Every prime congruent to 1 mod 4 is the sum
+/-- **Fermat's theorem on the sum of two squares**. Every prime not congruent to 3 mod 4 is the sum
 of two squares. Also known as **Fermat's Christmas theorem**. -/
-lemma nat.prime.sq_add_sq {p : ℕ} [fact p.prime] (hp : p % 4 = 1) :
+theorem nat.prime.sq_add_sq {p : ℕ} [fact p.prime] (hp : p % 4 ≠ 3) :
   ∃ a b : ℕ, a ^ 2 + b ^ 2 = p :=
 begin
   apply sq_add_sq_of_nat_prime_of_not_irreducible p,
-  rw [principal_ideal_ring.irreducible_iff_prime, prime_iff_mod_four_eq_three_of_nat_prime p, hp],
-  norm_num
+  rwa [principal_ideal_ring.irreducible_iff_prime, prime_iff_mod_four_eq_three_of_nat_prime p],
+end
+
+end Fermat
+
+/-!
+### Generalities on sums of two squares
+-/
+
+section general
+
+/-- The set of sums of two squares is closed under multiplication in any commutative ring.
+See also `sq_add_sq_mul_sq_add_sq`. -/
+lemma sq_add_sq_mul {R} [comm_ring R] {a b x y u v : R} (ha : a = x ^ 2 + y ^ 2)
+  (hb : b = u ^ 2 + v ^ 2) : ∃ r s : R, a * b = r ^ 2 + s ^ 2 :=
+⟨x * u - y * v, x * v + y * u, by {rw [ha, hb], ring}⟩
+
+/-- The set of natural numbers that are sums of two squares is closed under multiplication. -/
+lemma nat.sq_add_sq_mul {a b x y u v : ℕ} (ha : a = x ^ 2 + y ^ 2) (hb : b = u ^ 2 + v ^ 2) :
+  ∃ r s : ℕ, a * b = r ^ 2 + s ^ 2 :=
+begin
+  zify at ha hb ⊢,
+  obtain ⟨r, s, h⟩ := sq_add_sq_mul ha hb,
+  refine ⟨r.nat_abs, s.nat_abs, _⟩,
+  simpa only [int.coe_nat_abs, sq_abs],
+end
+
+end general
+
+/-!
+### Results on when -1 is a square modulo a natural number
+-/
+
+section neg_one_square
+
+/-- If `-1` is a square modulo `n` and `m` divides `n`, then `-1` is also a square modulo `m`. -/
+-- This could be formulated for a general integer `a` in place of `-1`,
+-- but it would not directly specialize to `-1`,
+-- because `((-1 : ℤ) : zmod n)` is not the same as `(-1 : zmod n)`.
+lemma zmod.is_square_neg_one_of_dvd {m n : ℕ} (hd : m ∣ n) (hs : is_square (-1 : zmod n)) :
+  is_square (-1 : zmod m) :=
+begin
+  let f : zmod n →+* zmod m := zmod.cast_hom hd _,
+  rw [← ring_hom.map_one f, ← ring_hom.map_neg],
+  exact hs.map f,
+end
+
+/-- If `-1` is a square modulo coprime natural numbers `m` and `n`, then `-1` is also
+a square modulo `m*n`. -/
+lemma zmod.is_square_neg_one_mul {m n : ℕ} (hc : m.coprime n) (hm : is_square (-1 : zmod m))
+  (hn : is_square (-1 : zmod n)) : is_square (-1 : zmod (m * n)) :=
+begin
+  have : is_square (-1 : (zmod m) × (zmod n)),
+  { rw show (-1 : (zmod m) × (zmod n)) = ((-1 : zmod m), (-1 : zmod n)), from rfl,
+    obtain ⟨x, hx⟩ := hm,
+    obtain ⟨y, hy⟩ := hn,
+    rw [hx, hy],
+    exact ⟨(x, y), rfl⟩, },
+  simpa only [ring_equiv.map_neg_one] using this.map (zmod.chinese_remainder hc).symm,
+end
+
+/-- If a prime `p` divides `n` such that `-1` is a square modulo `n`, then `p % 4 ≠ 3`. -/
+lemma nat.prime.mod_four_ne_three_of_dvd_is_square_neg_one {p n : ℕ} (hpp : p.prime) (hp : p ∣ n)
+  (hs : is_square (-1 : zmod n)) : p % 4 ≠ 3 :=
+begin
+  obtain ⟨y, h⟩ := zmod.is_square_neg_one_of_dvd hp hs,
+  rw [← sq, eq_comm, show (-1 : zmod p) = -1 ^ 2, from by ring] at h,
+  haveI : fact p.prime := ⟨hpp⟩,
+  exact zmod.mod_four_ne_three_of_sq_eq_neg_sq' one_ne_zero h,
+end
+
+/-- If `n` is a squarefree natural number, then `-1` is a square modulo `n` if and only if
+`n` is not divisible by a prime `q` such that `q % 4 = 3`. -/
+lemma zmod.is_square_neg_one_iff {n : ℕ} (hn : squarefree n) :
+  is_square (-1 : zmod n) ↔ ∀ {q : ℕ}, q.prime → q ∣ n → q % 4 ≠ 3 :=
+begin
+  refine ⟨λ H q hqp hqd, hqp.mod_four_ne_three_of_dvd_is_square_neg_one hqd H, λ H, _⟩,
+  induction n using induction_on_primes with p n hpp ih,
+  { exact false.elim (hn.ne_zero rfl), },
+  { exact ⟨0, by simp only [fin.zero_mul, neg_eq_zero, fin.one_eq_zero_iff]⟩, },
+  { haveI : fact p.prime := ⟨hpp⟩,
+    have hcp : p.coprime n,
+    { by_contra hc,
+      exact hpp.not_unit (hn p $ mul_dvd_mul_left p $ hpp.dvd_iff_not_coprime.mpr hc), },
+    have hp₁ := zmod.exists_sq_eq_neg_one_iff.mpr (H hpp (dvd_mul_right p n)),
+    exact zmod.is_square_neg_one_mul hcp hp₁
+      (ih hn.of_mul_right (λ q hqp hqd, H hqp $ dvd_mul_of_dvd_right hqd _)), }
 end
+
+/-- If `n` is a squarefree natural number, then `-1` is a square modulo `n` if and only if
+`n` has no divisor `q` that is `≡ 3 mod 4`. -/
+lemma zmod.is_square_neg_one_iff' {n : ℕ} (hn : squarefree n) :
+  is_square (-1 : zmod n) ↔ ∀ {q : ℕ}, q ∣ n → q % 4 ≠ 3 :=
+begin
+  have help : ∀ a b : zmod 4, a ≠ 3 → b ≠ 3 → a * b ≠ 3 := by dec_trivial,
+  rw zmod.is_square_neg_one_iff hn,
+  refine ⟨λ H, induction_on_primes _ _ (λ p q hp hq hpq, _), λ H q hq₁, H⟩,
+  { exact λ _, by norm_num, },
+  { exact λ _, by norm_num, },
+  { replace hp := H hp (dvd_of_mul_right_dvd hpq),
+    replace hq := hq (dvd_of_mul_left_dvd hpq),
+    rw [(show 3 = 3 % 4, from by norm_num), ne.def, ← zmod.nat_coe_eq_nat_coe_iff'] at hp hq ⊢,
+    rw nat.cast_mul,
+    exact help p q hp hq, }
+end
+
+/-!
+### Relation to sums of two squares
+-/
+
+/-- If `-1` is a square modulo the natural number `n`, then `n` is a sum of two squares. -/
+lemma nat.eq_sq_add_sq_of_is_square_mod_neg_one {n : ℕ} (h : is_square (-1 : zmod n)) :
+  ∃ x y : ℕ, n = x ^ 2 + y ^ 2 :=
+begin
+  induction n using induction_on_primes with p n hpp ih,
+  { exact ⟨0, 0, rfl⟩, },
+  { exact ⟨0, 1, rfl⟩, },
+  { haveI : fact p.prime := ⟨hpp⟩,
+    have hp : is_square (-1 : zmod p) := zmod.is_square_neg_one_of_dvd ⟨n, rfl⟩ h,
+    obtain ⟨u, v, huv⟩ := nat.prime.sq_add_sq (zmod.exists_sq_eq_neg_one_iff.mp hp),
+    obtain ⟨x, y, hxy⟩ := ih (zmod.is_square_neg_one_of_dvd ⟨p, mul_comm _ _⟩ h),
+    exact nat.sq_add_sq_mul huv.symm hxy, }
+end
+
+/-- If the integer `n` is a sum of two squares of coprime integers,
+then `-1` is a square modulo `n`. -/
+lemma zmod.is_square_neg_one_of_eq_sq_add_sq_of_is_coprime {n x y : ℤ} (h : n = x ^ 2 + y ^ 2)
+  (hc : is_coprime x y) : is_square (-1 : zmod n.nat_abs) :=
+begin
+  obtain ⟨u, v, huv⟩ : is_coprime x n,
+  { have hc2 : is_coprime (x ^ 2) (y ^ 2) := hc.pow,
+    rw show y ^ 2 = n + (-1) * x ^ 2, from by {rw h, ring} at hc2,
+    exact (is_coprime.pow_left_iff zero_lt_two).mp hc2.of_add_mul_right_right, },
+  have H : (u * y) * (u * y) - (-1) = n * (-v ^ 2 * n + u ^ 2 + 2 * v) :=
+    by linear_combination -u ^ 2 * h + (n * v - u * x - 1) * huv,
+  refine ⟨u * y, _⟩,
+  norm_cast,
+  rw (by push_cast : (-1 : zmod n.nat_abs) = (-1 : ℤ)),
+  exact (zmod.int_coe_eq_int_coe_iff_dvd_sub _ _ _).mpr (int.nat_abs_dvd.mpr ⟨_, H⟩),
+end
+
+/-- If the natural number `n` is a sum of two squares of coprime natural numbers, then
+`-1` is a square modulo `n`. -/
+lemma zmod.is_square_neg_one_of_eq_sq_add_sq_of_coprime {n x y : ℕ} (h : n = x ^ 2 + y ^ 2)
+  (hc : x.coprime y) : is_square (-1 : zmod n) :=
+begin
+  zify at *,
+  exact zmod.is_square_neg_one_of_eq_sq_add_sq_of_is_coprime h hc.is_coprime,
+end
+
+/-- A natural number `n` is a sum of two squares if and only if `n = a^2 * b` with natural
+numbers `a` and `b` such that `-1` is a square modulo `b`. -/
+lemma nat.eq_sq_add_sq_iff_eq_sq_mul {n : ℕ} :
+  (∃ x y : ℕ, n = x ^ 2 + y ^ 2) ↔ ∃ a b : ℕ, n = a ^ 2 * b ∧ is_square (-1 : zmod b) :=
+begin
+  split,
+  { rintros ⟨x, y, h⟩,
+    by_cases hxy : x = 0 ∧ y = 0,
+    { exact ⟨0, 1, by rw [h, hxy.1, hxy.2, zero_pow zero_lt_two, add_zero, zero_mul],
+             ⟨0, by rw [zero_mul, neg_eq_zero, fin.one_eq_zero_iff]⟩⟩, },
+    { have hg := nat.pos_of_ne_zero (mt nat.gcd_eq_zero_iff.mp hxy),
+      obtain ⟨g, x₁, y₁, h₁, h₂, h₃, h₄⟩ := nat.exists_coprime' hg,
+      exact ⟨g, x₁ ^ 2 + y₁ ^ 2, by {rw [h, h₃, h₄], ring},
+             zmod.is_square_neg_one_of_eq_sq_add_sq_of_coprime rfl h₂⟩, } },
+  { rintros ⟨a, b, h₁, h₂⟩,
+    obtain ⟨x', y', h⟩ := nat.eq_sq_add_sq_of_is_square_mod_neg_one h₂,
+    exact ⟨a * x', a * y', by {rw [h₁, h], ring}⟩, }
+end
+
+end neg_one_square
+
+/-!
+### Characterization in terms of the prime factorization
+-/
+
+section main
+
+/-- A (positive) natural number `n` is a sum of two squares if and only if the exponent of
+every prime `q` such that `q % 4 = 3` in the prime factorization of `n` is even.
+(The assumption `0 < n` is not present, since for `n = 0`, both sides are satisfied;
+the right hand side holds, since `padic_val_nat q 0 = 0` by definition.) -/
+lemma nat.eq_sq_add_sq_iff {n : ℕ} :
+  (∃ x y : ℕ, n = x ^ 2 + y ^ 2) ↔ ∀ {q : ℕ}, q.prime → q % 4 = 3 → even (padic_val_nat q n) :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hn₀,
+  { exact ⟨λ H q hq h, (@padic_val_nat.zero q).symm ▸ even_zero, λ H, ⟨0, 0, rfl⟩⟩, },
+  -- now `0 < n`
+  rw nat.eq_sq_add_sq_iff_eq_sq_mul,
+  refine ⟨λ H q hq h, _, λ H, _⟩,
+  { obtain ⟨a, b, h₁, h₂⟩ := H,
+    have hqb := padic_val_nat.eq_zero_of_not_dvd
+                  (λ hf, (hq.mod_four_ne_three_of_dvd_is_square_neg_one hf h₂) h),
+    have hab : a ^ 2 * b ≠ 0 := h₁ ▸ hn₀.ne',
+    have ha₂ := left_ne_zero_of_mul hab,
+    have ha := mt sq_eq_zero_iff.mpr ha₂,
+    have hb := right_ne_zero_of_mul hab,
+    haveI hqi : fact q.prime := ⟨hq⟩,
+    simp_rw [h₁, padic_val_nat.mul ha₂ hb, padic_val_nat.pow 2 ha, hqb, add_zero],
+    exact even_two_mul _, },
+  { obtain ⟨b, a, hb₀, ha₀, hab, hb⟩ := nat.sq_mul_squarefree_of_pos hn₀,
+    refine ⟨a, b, hab.symm, (zmod.is_square_neg_one_iff hb).mpr (λ q hqp hqb hq4, _)⟩,
+    refine nat.odd_iff_not_even.mp _ (H hqp hq4),
+    have hqb' : padic_val_nat q b = 1 :=
+      b.factorization_def hqp ▸ le_antisymm (nat.squarefree.factorization_le_one _ hb)
+                                            ((hqp.dvd_iff_one_le_factorization hb₀.ne').mp hqb),
+    haveI hqi : fact q.prime := ⟨hqp⟩,
+    simp_rw [← hab, padic_val_nat.mul (pow_ne_zero 2 ha₀.ne') hb₀.ne', hqb',
+             padic_val_nat.pow 2 ha₀.ne'],
+    exact odd_two_mul_add_one _, }
+end
+
+end main
diff --git a/src/number_theory/von_mangoldt.lean b/src/number_theory/von_mangoldt.lean
index 999937c3d0cb5..0d062b3984f10 100644
--- a/src/number_theory/von_mangoldt.lean
+++ b/src/number_theory/von_mangoldt.lean
@@ -11,6 +11,9 @@ import analysis.special_functions.log.basic
 /-!
 # The von Mangoldt Function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the von Mangoldt function: the function on natural numbers that returns
 `log p` if the input can be expressed as `p^k` for a prime `p`.
 
@@ -57,7 +60,8 @@ In the `arithmetic_function` locale, we have the notation `Λ` for this function
 noncomputable def von_mangoldt : arithmetic_function ℝ :=
 ⟨λ n, if is_prime_pow n then real.log (min_fac n) else 0, if_neg not_is_prime_pow_zero⟩
 
-localized "notation `Λ` := nat.arithmetic_function.von_mangoldt" in arithmetic_function
+localized "notation (name := von_mangoldt)
+  `Λ` := nat.arithmetic_function.von_mangoldt" in arithmetic_function
 
 lemma von_mangoldt_apply {n : ℕ} :
   Λ n = if is_prime_pow n then real.log (min_fac n) else 0 := rfl
@@ -76,7 +80,19 @@ lemma von_mangoldt_apply_pow {n k : ℕ} (hk : k ≠ 0) : Λ (n ^ k) = Λ n :=
 by simp only [von_mangoldt_apply, is_prime_pow_pow_iff hk, pow_min_fac hk]
 
 lemma von_mangoldt_apply_prime {p : ℕ} (hp : p.prime) : Λ p = real.log p :=
-by rw [von_mangoldt_apply, prime.min_fac_eq hp, if_pos (nat.prime_iff.1 hp).is_prime_pow]
+by rw [von_mangoldt_apply, prime.min_fac_eq hp, if_pos hp.prime.is_prime_pow]
+
+lemma von_mangoldt_ne_zero_iff {n : ℕ} : Λ n ≠ 0 ↔ is_prime_pow n :=
+begin
+  rcases eq_or_ne n 1 with rfl | hn, { simp [not_is_prime_pow_one] },
+  exact (real.log_pos (one_lt_cast.2 (min_fac_prime hn).one_lt)).ne'.ite_ne_right_iff
+end
+
+lemma von_mangoldt_pos_iff {n : ℕ} : 0 < Λ n ↔ is_prime_pow n :=
+von_mangoldt_nonneg.lt_iff_ne.trans (ne_comm.trans von_mangoldt_ne_zero_iff)
+
+lemma von_mangoldt_eq_zero_iff {n : ℕ} : Λ n = 0 ↔ ¬is_prime_pow n :=
+von_mangoldt_ne_zero_iff.not_right
 
 open_locale big_operators
 
@@ -93,8 +109,7 @@ begin
   simp only [von_mangoldt_apply, ←sum_filter] at ha hb ⊢,
   rw [mul_divisors_filter_prime_pow hab, filter_union,
     sum_union (disjoint_divisors_filter_prime_pow hab), ha, hb, nat.cast_mul,
-    real.log_mul (nat.cast_ne_zero.2 (pos_of_gt ha').ne')
-      (nat.cast_ne_zero.2 (pos_of_gt hb').ne')],
+    real.log_mul (cast_ne_zero.2 (pos_of_gt ha').ne') (cast_ne_zero.2 (pos_of_gt hb').ne')],
 end
 
 @[simp] lemma von_mangoldt_mul_zeta : Λ * ζ = log :=
@@ -131,5 +146,13 @@ begin
   simp [hn],
 end
 
+lemma von_mangoldt_le_log : ∀ {n : ℕ}, Λ n ≤ real.log (n : ℝ)
+| 0 := by simp
+| (n+1) :=
+  begin
+    rw ←von_mangoldt_sum,
+    exact single_le_sum (λ _ _, von_mangoldt_nonneg) (mem_divisors_self _ n.succ_ne_zero),
+  end
+
 end arithmetic_function
 end nat
diff --git a/src/number_theory/well_approximable.lean b/src/number_theory/well_approximable.lean
new file mode 100644
index 0000000000000..dc65fb61b0c4e
--- /dev/null
+++ b/src/number_theory/well_approximable.lean
@@ -0,0 +1,322 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import dynamics.ergodic.add_circle
+import measure_theory.covering.liminf_limsup
+
+/-!
+# Well-approximable numbers and Gallagher's ergodic theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Gallagher's ergodic theorem is a result in metric number theory. It thus belongs to that branch of
+mathematics concerning arithmetic properties of real numbers which hold almost eveywhere with
+respect to the Lebesgue measure.
+
+Gallagher's theorem concerns the approximation of real numbers by rational numbers. The input is a
+sequence of distances `δ₁, δ₂, ...`, and the theorem concerns the set of real numbers `x` for which
+there is an infinity of solutions to:
+$$
+  |x - m/n| < δₙ,
+$$
+where the rational number `m/n` is in lowest terms. The result is that for any `δ`, this set is
+either almost all `x` or almost no `x`.
+
+This result was proved by Gallagher in 1959
+[P. Gallagher, *Approximation by reduced fractions*](Gallagher1961). It is formalised here as
+`add_circle.add_well_approximable_ae_empty_or_univ` except with `x` belonging to the circle `ℝ ⧸ ℤ`
+since this turns out to be more natural.
+
+Given a particular `δ`, the Duffin-Schaeffer conjecture (now a theorem) gives a criterion for
+deciding which of the two cases in the conclusion of Gallagher's theorem actually occurs. It was
+proved by Koukoulopoulos and Maynard in 2019
+[D. Koukoulopoulos, J. Maynard, *On the Duffin-Schaeffer conjecture*](KoukoulopoulosMaynard2020).
+We do *not* include a formalisation of the Koukoulopoulos-Maynard result here.
+
+## Main definitions and results:
+
+ * `approx_order_of`: in a seminormed group `A`, given `n : ℕ` and `δ : ℝ`, `approx_order_of A n δ`
+   is the set of elements within a distance `δ` of a point of order `n`.
+ * `well_approximable`: in a seminormed group `A`, given a sequence of distances `δ₁, δ₂, ...`,
+   `well_approximable A δ` is the limsup as `n → ∞` of the sets `approx_order_of A n δₙ`. Thus, it
+   is the set of points that lie in infinitely many of the sets `approx_order_of A n δₙ`.
+ * `add_circle.add_well_approximable_ae_empty_or_univ`: *Gallagher's ergodic theorem* says that for
+   for the (additive) circle `𝕊`, for any sequence of distances `δ`, the set
+   `add_well_approximable 𝕊 δ` is almost empty or almost full.
+
+## TODO:
+
+The hypothesis `hδ` in `add_circle.add_well_approximable_ae_empty_or_univ` can be dropped.
+An elementary (non-measure-theoretic) argument shows that if `¬ hδ` holds then
+`add_well_approximable 𝕊 δ = univ` (provided `δ` is non-negative).
+-/
+
+open set filter function metric measure_theory
+open_locale measure_theory topology pointwise
+
+/-- In a seminormed group `A`, given `n : ℕ` and `δ : ℝ`, `approx_order_of A n δ` is the set of
+elements within a distance `δ` of a point of order `n`. -/
+@[to_additive approx_add_order_of "In a seminormed additive group `A`, given `n : ℕ` and `δ : ℝ`,
+`approx_add_order_of A n δ` is the set of elements within a distance `δ` of a point of order `n`."]
+def approx_order_of (A : Type*) [seminormed_group A] (n : ℕ) (δ : ℝ) : set A :=
+thickening δ {y | order_of y = n}
+
+@[to_additive mem_approx_add_order_of_iff]
+lemma mem_approx_order_of_iff {A : Type*} [seminormed_group A] {n : ℕ} {δ : ℝ} {a : A} :
+  a ∈ approx_order_of A n δ ↔ ∃ (b : A), order_of b = n ∧ a ∈ ball b δ :=
+by simp only [approx_order_of, thickening_eq_bUnion_ball, mem_Union₂, mem_set_of_eq, exists_prop]
+
+/-- In a seminormed group `A`, given a sequence of distances `δ₁, δ₂, ...`, `well_approximable A δ`
+is the limsup as `n → ∞` of the sets `approx_order_of A n δₙ`. Thus, it is the set of points that
+lie in infinitely many of the sets `approx_order_of A n δₙ`. -/
+@[to_additive add_well_approximable "In a seminormed additive group `A`, given a sequence of
+distances `δ₁, δ₂, ...`, `add_well_approximable A δ` is the limsup as `n → ∞` of the sets
+`approx_add_order_of A n δₙ`. Thus, it is the set of points that lie in infinitely many of the sets
+`approx_add_order_of A n δₙ`."]
+def well_approximable (A : Type*) [seminormed_group A] (δ : ℕ → ℝ) : set A :=
+blimsup (λ n, approx_order_of A n (δ n)) at_top (λ n, 0 < n)
+
+@[to_additive mem_add_well_approximable_iff]
+lemma mem_well_approximable_iff {A : Type*} [seminormed_group A] {δ : ℕ → ℝ} {a : A} :
+  a ∈ well_approximable A δ ↔ a ∈ blimsup (λ n, approx_order_of A n (δ n)) at_top (λ n, 0 < n) :=
+iff.rfl
+
+namespace approx_order_of
+
+variables {A : Type*} [seminormed_comm_group A] {a : A} {m n : ℕ} (δ : ℝ)
+
+@[to_additive]
+lemma image_pow_subset_of_coprime (hm : 0 < m) (hmn : n.coprime m) :
+  (λ y, y^m) '' (approx_order_of A n δ) ⊆ approx_order_of A n (m * δ) :=
+begin
+  rintros - ⟨a, ha, rfl⟩,
+  obtain ⟨b, hb, hab⟩ := mem_approx_order_of_iff.mp ha,
+  replace hb : b^m ∈ {u : A | order_of u = n}, { rw ← hb at hmn ⊢, exact order_of_pow_coprime hmn },
+  apply ball_subset_thickening hb ((m : ℝ) • δ),
+  convert pow_mem_ball hm hab using 1,
+  simp only [nsmul_eq_mul, algebra.id.smul_eq_mul],
+end
+
+@[to_additive]
+lemma image_pow_subset (n : ℕ) (hm : 0 < m) :
+  (λ y, y^m) '' (approx_order_of A (n * m) δ) ⊆ approx_order_of A n (m * δ) :=
+begin
+  rintros - ⟨a, ha, rfl⟩,
+  obtain ⟨b, hb : order_of b = n * m, hab : a ∈ ball b δ⟩ := mem_approx_order_of_iff.mp ha,
+  replace hb : b^m ∈ {y : A | order_of y = n},
+  { rw [mem_set_of_eq, order_of_pow' b hm.ne', hb, nat.gcd_mul_left_left, n.mul_div_cancel hm], },
+  apply ball_subset_thickening hb (m * δ),
+  convert pow_mem_ball hm hab,
+  simp only [nsmul_eq_mul],
+end
+
+@[to_additive]
+lemma smul_subset_of_coprime (han : (order_of a).coprime n) :
+  a • approx_order_of A n δ ⊆ approx_order_of A ((order_of a) * n) δ :=
+begin
+  simp_rw [approx_order_of, thickening_eq_bUnion_ball, ← image_smul, image_Union₂,
+    image_smul, smul_ball'', smul_eq_mul, mem_set_of_eq],
+  refine Union₂_subset_iff.mpr (λ b hb c hc, _),
+  simp only [mem_Union, exists_prop],
+  refine ⟨a * b, _, hc⟩,
+  rw ← hb at ⊢ han,
+  exact (commute.all a b).order_of_mul_eq_mul_order_of_of_coprime han,
+end
+
+@[to_additive vadd_eq_of_mul_dvd]
+lemma smul_eq_of_mul_dvd (hn : 0 < n) (han : (order_of a)^2 ∣ n) :
+  a • approx_order_of A n δ = approx_order_of A n δ :=
+begin
+  simp_rw [approx_order_of, thickening_eq_bUnion_ball, ← image_smul, image_Union₂,
+    image_smul, smul_ball'', smul_eq_mul, mem_set_of_eq],
+  replace han : ∀ {b : A}, order_of b = n → order_of (a * b) = n,
+  { intros b hb,
+    rw ← hb at han hn,
+    rw sq at han,
+    rwa [(commute.all a b).order_of_mul_eq_right_of_forall_prime_mul_dvd (order_of_pos_iff.mp hn)
+      (λ p hp hp', dvd_trans (mul_dvd_mul_right hp' $ order_of a) han)], },
+  let f : {b : A | order_of b = n} → {b : A | order_of b = n} := λ b, ⟨a * b, han b.property⟩,
+  have hf : surjective f,
+  { rintros ⟨b, hb⟩,
+    refine ⟨⟨a⁻¹ * b, _⟩, _⟩,
+    { rw [mem_set_of_eq, ← order_of_inv, mul_inv_rev, inv_inv, mul_comm],
+      apply han,
+      simpa, },
+    { simp only [subtype.mk_eq_mk, subtype.coe_mk, mul_inv_cancel_left], }, },
+  simpa only [f, mem_set_of_eq, subtype.coe_mk, Union_coe_set] using
+    hf.Union_comp (λ b, ball (b : A) δ),
+end
+
+end approx_order_of
+
+namespace unit_add_circle
+
+lemma mem_approx_add_order_of_iff {δ : ℝ} {x : unit_add_circle} {n : ℕ} (hn : 0 < n) :
+  x ∈ approx_add_order_of unit_add_circle n δ ↔
+  ∃ m < n, gcd m n = 1 ∧ ‖x - ↑((m : ℝ) / n)‖ < δ :=
+begin
+  haveI := real.fact_zero_lt_one,
+  simp only [mem_approx_add_order_of_iff, mem_set_of_eq, ball, exists_prop, dist_eq_norm,
+    add_circle.add_order_of_eq_pos_iff hn, mul_one],
+  split,
+  { rintros ⟨y, ⟨m, hm₁, hm₂, rfl⟩, hx⟩, exact ⟨m, hm₁, hm₂, hx⟩, },
+  { rintros ⟨m, hm₁, hm₂, hx⟩, exact ⟨↑((m : ℝ) / n), ⟨m, hm₁, hm₂, rfl⟩, hx⟩, },
+end
+
+lemma mem_add_well_approximable_iff (δ : ℕ → ℝ) (x : unit_add_circle) :
+  x ∈ add_well_approximable unit_add_circle δ ↔
+  {n : ℕ | ∃ m < n, gcd m n = 1 ∧ ‖x - ↑((m : ℝ) / n)‖ < δ n}.infinite :=
+begin
+  simp only [mem_add_well_approximable_iff, ← nat.cofinite_eq_at_top, cofinite.blimsup_set_eq,
+    mem_set_of_eq],
+  refine iff_of_eq (congr_arg set.infinite $ ext (λ n, ⟨λ hn, _, λ hn, _⟩)),
+  { exact (mem_approx_add_order_of_iff hn.1).mp hn.2, },
+  { have h : 0 < n := by { obtain ⟨m, hm₁, hm₂, hm₃⟩ := hn, exact pos_of_gt hm₁, },
+    exact ⟨h, (mem_approx_add_order_of_iff h).mpr hn⟩, },
+end
+
+end unit_add_circle
+
+namespace add_circle
+
+variables {T : ℝ} [hT : fact (0 < T)]
+include hT
+
+local notation a `∤` b := ¬ a ∣ b
+local notation a `∣∣` b := (a ∣ b) ∧ (a*a ∤ b)
+local notation `𝕊` := add_circle T
+
+/-- *Gallagher's ergodic theorem* on Diophantine approximation. -/
+theorem add_well_approximable_ae_empty_or_univ (δ : ℕ → ℝ) (hδ : tendsto δ at_top (𝓝 0)) :
+  (∀ᵐ x, ¬ add_well_approximable 𝕊 δ x) ∨ ∀ᵐ x, add_well_approximable 𝕊 δ x :=
+begin
+  /- Sketch of proof:
+
+  Let `E := add_well_approximable 𝕊 δ`. For each prime `p : ℕ`, we can partition `E` into three
+  pieces `E = (A p) ∪ (B p) ∪ (C p)` where:
+    `A p = blimsup (approx_add_order_of 𝕊 n (δ n)) at_top (λ n, 0 < n ∧ (p ∤ n))`
+    `B p = blimsup (approx_add_order_of 𝕊 n (δ n)) at_top (λ n, 0 < n ∧ (p ∣∣ n))`
+    `C p = blimsup (approx_add_order_of 𝕊 n (δ n)) at_top (λ n, 0 < n ∧ (p*p ∣ n))`.
+  (In other words, `A p` is the set of points `x` for which there exist infinitely-many `n` such
+  that `x` is within a distance `δ n` of a point of order `n` and `p ∤ n`. Similarly for `B`, `C`.)
+
+  These sets have the following key properties:
+    1. `A p` is almost invariant under the ergodic map `y ↦ p • y`
+    2. `B p` is almost invariant under the ergodic map `y ↦ p • y + 1/p`
+    3. `C p` is invariant under the map `y ↦ y + 1/p`
+  To prove 1 and 2 we need the key result `blimsup_thickening_mul_ae_eq` but 3 is elementary.
+
+  It follows from `add_circle.ergodic_nsmul_add` and `ergodic.ae_empty_or_univ_of_image_ae_le` that
+  if either `A p` or `B p` is not almost empty for any `p`, then it is almost full and thus so is
+  `E`. We may therefore assume that both `A p` and `B p` are almost empty for all `p`. We thus have
+  `E` is almost equal to `C p` for every prime. Combining this with 3 we find that `E` is almost
+  invariant under the map `y ↦ y + 1/p` for every prime `p`. The required result then follows from
+  `add_circle.ae_empty_or_univ_of_forall_vadd_ae_eq_self`. -/
+  letI : semilattice_sup nat.primes := nat.subtype.semilattice_sup _,
+  set μ : measure 𝕊 := volume,
+  set u : nat.primes → 𝕊 := λ p, ↑(((↑(1 : ℕ) : ℝ) / p) * T),
+  have hu₀ : ∀ (p : nat.primes), add_order_of (u p) = (p : ℕ),
+  { rintros ⟨p, hp⟩, exact add_order_of_div_of_gcd_eq_one hp.pos (gcd_one_left p), },
+  have hu : tendsto (add_order_of ∘ u) at_top at_top,
+  { rw (funext hu₀ : add_order_of ∘ u = coe),
+    have h_mono : monotone (coe : nat.primes → ℕ) := λ p q hpq, hpq,
+    refine h_mono.tendsto_at_top_at_top (λ n, _),
+    obtain ⟨p, hp, hp'⟩ := n.exists_infinite_primes,
+    exact ⟨⟨p, hp'⟩, hp⟩, },
+  set E := add_well_approximable 𝕊 δ,
+  set X : ℕ → set 𝕊 := λ n, approx_add_order_of 𝕊 n (δ n),
+  set A : ℕ → set 𝕊 := λ p, blimsup X at_top (λ n, 0 < n ∧ (p ∤ n)),
+  set B : ℕ → set 𝕊 := λ p, blimsup X at_top (λ n, 0 < n ∧ (p ∣∣ n)),
+  set C : ℕ → set 𝕊 := λ p, blimsup X at_top (λ n, 0 < n ∧ (p^2 ∣ n)),
+  have hA₀ : ∀ p, measurable_set (A p) :=
+    λ p, measurable_set.measurable_set_blimsup (λ n hn, is_open_thickening.measurable_set),
+  have hB₀ : ∀ p, measurable_set (B p) :=
+    λ p, measurable_set.measurable_set_blimsup (λ n hn, is_open_thickening.measurable_set),
+  have hE₀ : null_measurable_set E μ,
+  { refine (measurable_set.measurable_set_blimsup
+      (λ n hn, is_open.measurable_set _)).null_measurable_set,
+    exact is_open_thickening, },
+  have hE₁ : ∀ p, E = (A p) ∪ (B p) ∪ (C p),
+  { intros p,
+    simp only [E, add_well_approximable, ← blimsup_or_eq_sup, ← and_or_distrib_left, ← sup_eq_union,
+      sq],
+    congr,
+    refine funext (λ n, propext $ iff_self_and.mpr (λ hn, _)),
+    -- `tauto` can finish from here but unfortunately it's very slow.
+    simp only [(em (p ∣ n)).symm, (em (p*p ∣ n)).symm, or_and_distrib_left, or_true, true_and,
+      or_assoc], },
+  have hE₂ : ∀ (p : nat.primes), A p =ᵐ[μ] (∅ : set 𝕊) ∧ B p =ᵐ[μ] (∅ : set 𝕊) → E =ᵐ[μ] C p,
+  { rintros p ⟨hA, hB⟩,
+    rw hE₁ p,
+    exact union_ae_eq_right_of_ae_eq_empty ((union_ae_eq_right_of_ae_eq_empty hA).trans hB), },
+  have hA : ∀ (p : nat.primes), A p =ᵐ[μ] (∅ : set 𝕊) ∨ A p =ᵐ[μ] univ,
+  { rintros ⟨p, hp⟩,
+    let f : 𝕊 → 𝕊 := λ y, (p : ℕ) • y,
+    suffices : f '' (A p) ⊆
+      blimsup (λ n, approx_add_order_of 𝕊 n (p * δ n)) at_top (λ n, 0 < n ∧ (p ∤ n)),
+    { apply (ergodic_nsmul hp.one_lt).ae_empty_or_univ_of_image_ae_le (hA₀ p),
+      apply (has_subset.subset.eventually_le this).congr eventually_eq.rfl,
+      exact blimsup_thickening_mul_ae_eq μ
+        (λ n, 0 < n ∧ (p ∤ n)) (λ n, {y | add_order_of y = n}) (nat.cast_pos.mpr hp.pos) _ hδ, },
+    refine (Sup_hom.set_image f).apply_blimsup_le.trans (mono_blimsup $ λ n hn, _),
+    replace hn := nat.coprime_comm.mp (hp.coprime_iff_not_dvd.2 hn.2),
+    exact approx_add_order_of.image_nsmul_subset_of_coprime (δ n) hp.pos hn, },
+  have hB : ∀ (p : nat.primes), B p =ᵐ[μ] (∅ : set 𝕊) ∨ B p =ᵐ[μ] univ,
+  { rintros ⟨p, hp⟩,
+    let x := u ⟨p, hp⟩,
+    let f : 𝕊 → 𝕊 := λ y, p • y + x,
+    suffices : f '' (B p) ⊆
+      blimsup (λ n, approx_add_order_of 𝕊 n (p * δ n)) at_top (λ n, 0 < n ∧ (p ∣∣ n)),
+    { apply (ergodic_nsmul_add x hp.one_lt).ae_empty_or_univ_of_image_ae_le (hB₀ p),
+      apply (has_subset.subset.eventually_le this).congr eventually_eq.rfl,
+      exact blimsup_thickening_mul_ae_eq μ
+        (λ n, 0 < n ∧ (p ∣∣ n)) (λ n, {y | add_order_of y = n}) (nat.cast_pos.mpr hp.pos) _ hδ, },
+    refine (Sup_hom.set_image f).apply_blimsup_le.trans (mono_blimsup _),
+    rintros n ⟨hn, h_div, h_ndiv⟩,
+    have h_cop : (add_order_of x).coprime (n/p),
+    { obtain ⟨q, rfl⟩ := h_div,
+      rw [hu₀, subtype.coe_mk, hp.coprime_iff_not_dvd, q.mul_div_cancel_left hp.pos],
+      exact λ contra, h_ndiv (mul_dvd_mul_left p contra), },
+    replace h_div : n / p * p = n := nat.div_mul_cancel h_div,
+    have hf : f = (λ y, x + y) ∘ (λ y, p • y), { ext, simp [add_comm x], },
+    simp_rw [comp_app],
+    rw [le_eq_subset, Sup_hom.set_image_to_fun, hf, image_comp],
+    have := @monotone_image 𝕊 𝕊 (λ y, x + y),
+    specialize this (approx_add_order_of.image_nsmul_subset (δ n) (n/p) hp.pos),
+    simp only [h_div] at this ⊢,
+    refine this.trans _,
+    convert approx_add_order_of.vadd_subset_of_coprime (p * δ n) h_cop,
+    simp only [hu₀, subtype.coe_mk, h_div, mul_comm p], },
+  change (∀ᵐ x, x ∉ E) ∨ E ∈ volume.ae,
+  rw [← eventually_eq_empty, ← eventually_eq_univ],
+  have hC : ∀ (p : nat.primes), (u p) +ᵥ C p = C p,
+  { intros p,
+    let e := (add_action.to_perm (u p) : equiv.perm 𝕊).to_order_iso_set,
+    change e (C p) = C p,
+    rw [e.apply_blimsup, ← hu₀ p],
+    exact blimsup_congr (eventually_of_forall $ λ n hn,
+      approx_add_order_of.vadd_eq_of_mul_dvd (δ n) hn.1 hn.2), },
+  by_cases h : ∀ (p : nat.primes), A p =ᵐ[μ] (∅ : set 𝕊) ∧ B p =ᵐ[μ] (∅ : set 𝕊),
+  { replace h : ∀ (p : nat.primes), ((u p) +ᵥ E : set _) =ᵐ[μ] E,
+    { intros p,
+      replace hE₂ : E =ᵐ[μ] C p := hE₂ p (h p),
+      have h_qmp : measure_theory.measure.quasi_measure_preserving ((+ᵥ) (-u p)) μ μ :=
+        (measure_preserving_vadd _ μ).quasi_measure_preserving,
+      refine (h_qmp.vadd_ae_eq_of_ae_eq (u p) hE₂).trans (ae_eq_trans _ hE₂.symm),
+      rw hC, },
+    exact ae_empty_or_univ_of_forall_vadd_ae_eq_self hE₀ h hu, },
+  { right,
+    simp only [not_forall, not_and_distrib] at h,
+    obtain ⟨p, hp⟩ := h,
+    rw hE₁ p,
+    cases hp,
+    { cases hA p, { contradiction, },
+      simp only [h, union_ae_eq_univ_of_ae_eq_univ_left], },
+    { cases hB p, { contradiction, },
+      simp only [h, union_ae_eq_univ_of_ae_eq_univ_left, union_ae_eq_univ_of_ae_eq_univ_right], } },
+end
+
+end add_circle
diff --git a/src/number_theory/wilson.lean b/src/number_theory/wilson.lean
new file mode 100644
index 0000000000000..c077fc3d2fbec
--- /dev/null
+++ b/src/number_theory/wilson.lean
@@ -0,0 +1,102 @@
+/-
+Copyright (c) 2022 John Nicol. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: John Nicol
+-/
+import field_theory.finite.basic
+
+/-!
+# Wilson's theorem.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains a proof of Wilson's theorem.
+
+The heavy lifting is mostly done by the previous `wilsons_lemma`,
+but here we also prove the other logical direction.
+
+This could be generalized to similar results about finite abelian groups.
+
+## References
+
+* [Wilson's Theorem](https://en.wikipedia.org/wiki/Wilson%27s_theorem)
+
+## TODO
+
+* Give `wilsons_lemma` a descriptive name.
+-/
+
+open finset nat finite_field zmod
+open_locale big_operators nat
+
+namespace zmod
+
+variables (p : ℕ) [fact p.prime]
+
+/-- **Wilson's Lemma**: the product of `1`, ..., `p-1` is `-1` modulo `p`. -/
+@[simp] lemma wilsons_lemma : ((p - 1)! : zmod p) = -1 :=
+begin
+  refine
+  calc ((p - 1)! : zmod p) = (∏ x in Ico 1 (succ (p - 1)), x) :
+    by rw [← finset.prod_Ico_id_eq_factorial, prod_nat_cast]
+                               ... = (∏ x : (zmod p)ˣ, x) : _
+                               ... = -1 : by simp_rw [← units.coe_hom_apply,
+    ← (units.coe_hom (zmod p)).map_prod, prod_univ_units_id_eq_neg_one, units.coe_hom_apply,
+    units.coe_neg, units.coe_one],
+  have hp : 0 < p := (fact.out p.prime).pos,
+  symmetry,
+  refine prod_bij (λ a _, (a : zmod p).val) _ _ _ _,
+  { intros a ha,
+    rw [mem_Ico, ← nat.succ_sub hp, nat.succ_sub_one],
+    split,
+    { apply nat.pos_of_ne_zero, rw ← @val_zero p,
+      assume h, apply units.ne_zero a (val_injective p h) },
+    { exact val_lt _ } },
+  { intros a ha, simp only [cast_id, nat_cast_val], },
+  { intros _ _ _ _ h, rw units.ext_iff, exact val_injective p h },
+  { intros b hb,
+    rw [mem_Ico, nat.succ_le_iff, ← succ_sub hp, succ_sub_one, pos_iff_ne_zero] at hb,
+    refine ⟨units.mk0 b _, finset.mem_univ _, _⟩,
+    { assume h, apply hb.1, apply_fun val at h,
+      simpa only [val_cast_of_lt hb.right, val_zero] using h },
+    { simp only [val_cast_of_lt hb.right, units.coe_mk0], } }
+end
+
+@[simp] lemma prod_Ico_one_prime : (∏ x in Ico 1 p, (x : zmod p)) = -1 :=
+begin
+  conv in (Ico 1 p) { rw [← succ_sub_one p, succ_sub (fact.out p.prime).pos] },
+  rw [← prod_nat_cast, finset.prod_Ico_id_eq_factorial, wilsons_lemma]
+end
+
+end zmod
+
+namespace nat
+variable {n : ℕ}
+
+/-- For `n ≠ 1`, `(n-1)!` is congruent to `-1` modulo `n` only if n is prime. -/
+lemma prime_of_fac_equiv_neg_one
+  (h : ((n - 1)! : zmod n) = -1) (h1 : n ≠ 1) : prime n :=
+begin
+  rcases eq_or_ne n 0 with rfl | h0,
+  { norm_num at h },
+  replace h1 : 1 < n := n.two_le_iff.mpr ⟨h0, h1⟩,
+  by_contradiction h2,
+  obtain ⟨m, hm1, hm2 : 1 < m, hm3⟩ := exists_dvd_of_not_prime2 h1 h2,
+  have hm : m ∣ (n - 1)! := nat.dvd_factorial (pos_of_gt hm2) (le_pred_of_lt hm3),
+  refine hm2.ne' (nat.dvd_one.mp ((nat.dvd_add_right hm).mp (hm1.trans _))),
+  rw [←zmod.nat_coe_zmod_eq_zero_iff_dvd, cast_add, cast_one, h, add_left_neg],
+end
+
+/-- **Wilson's Theorem**: For `n ≠ 1`, `(n-1)!` is congruent to `-1` modulo `n` iff n is prime. -/
+theorem prime_iff_fac_equiv_neg_one (h : n ≠ 1) :
+  prime n ↔ ((n - 1)! : zmod n) = -1 :=
+begin
+  refine ⟨λ h1, _, λ h2, prime_of_fac_equiv_neg_one h2 h⟩,
+  haveI := fact.mk h1,
+  exact zmod.wilsons_lemma n,
+end
+
+end nat
+
+assert_not_exists legendre_sym.quadratic_reciprocity
diff --git a/src/number_theory/zeta_function.lean b/src/number_theory/zeta_function.lean
new file mode 100644
index 0000000000000..cda925a279f9f
--- /dev/null
+++ b/src/number_theory/zeta_function.lean
@@ -0,0 +1,770 @@
+/-
+Copyright (c) 2023 David Loeffler. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: David Loeffler
+-/
+import analysis.special_functions.gamma.beta
+import number_theory.modular_forms.jacobi_theta.basic
+import number_theory.zeta_values
+
+/-!
+# Definition of the Riemann zeta function
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions:
+
+* `riemann_zeta`: the Riemann zeta function `ζ : ℂ → ℂ`.
+* `riemann_completed_zeta`: the completed zeta function `Λ : ℂ → ℂ`, which satisfies
+  `Λ(s) = π ^ (-s / 2) Γ(s / 2) ζ(s)` (away from the poles of `Γ(s / 2)`).
+* `riemann_completed_zeta₀`: the entire function `Λ₀` satisfying
+  `Λ₀(s) = Λ(s) + 1 / (s - 1) - 1 / s` wherever the RHS is defined.
+
+Note that mathematically `ζ(s)` is undefined at `s = 1`, while `Λ(s)` is undefined at both `s = 0`
+and `s = 1`. Our construction assigns some values at these points (which are not arbitrary, but
+I haven't checked exactly what they are).
+
+## Main results:
+
+* `differentiable_completed_zeta₀` : the function `Λ₀(s)` is entire.
+* `differentiable_at_completed_zeta` : the function `Λ(s)` is differentiable away from `s = 0` and
+  `s = 1`.
+* `differentiable_at_riemann_zeta` : the function `ζ(s)` is differentiable away from `s = 1`.
+* `zeta_eq_tsum_of_one_lt_re` : for `1 < re s`, we have
+  `ζ(s) = ∑' (n : ℕ), 1 / (n + 1) ^ s`.
+* `riemann_completed_zeta₀_one_sub`, `riemann_completed_zeta_one_sub`, and `riemann_zeta_one_sub` :
+  functional equation relating values at `s` and `1 - s`
+* `riemann_zeta_neg_nat_eq_bernoulli` : for any `k ∈ ℕ` we have the formula
+  `riemann_zeta (-k) = (-1) ^ k * bernoulli (k + 1) / (k + 1)`
+* `riemann_zeta_two_mul_nat`: formula for `ζ(2 * k)` for `k ∈ ℕ, k ≠ 0` in terms of Bernoulli
+  numbers
+
+## Outline of proofs:
+
+We define two related functions on the reals, `zeta_kernel₁` and `zeta_kernel₂`. The first is
+`(θ (t * I) - 1) / 2`, where `θ` is Jacobi's theta function; its Mellin transform is exactly the
+completed zeta function. The second is obtained by subtracting a linear combination of powers on
+the interval `Ioc 0 1` to give a function with exponential decay at both `0` and `∞`. We then define
+`riemann_completed_zeta₀` as the Mellin transform of the second zeta kernel, and define
+`riemann_completed_zeta` and `riemann_zeta` from this.
+
+Since `zeta_kernel₂` has rapid decay and satisfies a functional equation relating its values at `t`
+and `1 / t`, we deduce the analyticity of `riemann_completed_zeta₀` and the functional equation
+relating its values at `s` and `1 - s`. On the other hand, since `zeta_kernel₁` can be expanded in
+powers of `exp (-π * t)` and the Mellin transform integrated term-by-term, we obtain the relation
+to the naive Dirichlet series `∑' (n : ℕ), 1 / (n + 1) ^ s`.
+-/
+
+open measure_theory set filter asymptotics topological_space real asymptotics
+open complex (hiding exp norm_eq_abs abs_of_nonneg abs_two continuous_exp)
+
+open_locale topology real nat
+
+noncomputable theory
+
+/-!
+## Definition of the Riemann zeta function and related functions
+-/
+
+/-- Function whose Mellin transform is `π ^ (-s) * Γ(s) * zeta (2 * s)`, for `1 / 2 < Re s`. -/
+def zeta_kernel₁ (t : ℝ) : ℂ := ∑' (n : ℕ), rexp (-π * t * (n + 1) ^ 2)
+
+/-- Modified zeta kernel, whose Mellin transform is entire. --/
+def zeta_kernel₂ : ℝ → ℂ := zeta_kernel₁ + indicator (Ioc 0 1) (λ t, (1 - 1 / sqrt t) / 2)
+
+/-- The completed Riemann zeta function with its poles removed, `Λ(s) + 1 / s - 1 / (s - 1)`. -/
+def riemann_completed_zeta₀ (s : ℂ) : ℂ := mellin zeta_kernel₂ (s / 2)
+
+/-- The completed Riemann zeta function, `Λ(s)`, which satisfies
+`Λ(s) = π ^ (-s / 2) Γ(s / 2) ζ(s)` (up to a minor correction at `s = 0`). -/
+def riemann_completed_zeta (s : ℂ) : ℂ := riemann_completed_zeta₀ s - 1 / s + 1 / (s - 1)
+
+/-- The Riemann zeta function `ζ(s)`. We set this to be irreducible to hide messy implementation
+details. -/
+@[irreducible] def riemann_zeta := function.update
+  (λ s : ℂ, ↑π ^ (s / 2) * riemann_completed_zeta s / Gamma (s / 2)) 0 (-1 / 2)
+
+/- Note the next lemma is true by definition; what's hard is to show that with this definition, `ζ`
+is continuous (and indeed analytic) at 0, see `differentiable_riemann_zeta` below. -/
+/-- We have `ζ(0) = -1 / 2`. -/
+lemma riemann_zeta_zero : riemann_zeta 0 = -1 / 2 :=
+begin
+  unfold riemann_zeta,
+  exact function.update_same _ _ _
+end
+
+/-!
+## First properties of the zeta kernels
+-/
+
+/-- The sum defining `zeta_kernel₁` is convergent. -/
+lemma summable_exp_neg_pi_mul_nat_sq {t : ℝ} (ht : 0 < t) :
+  summable (λ n : ℕ, rexp (-π * t * (n + 1) ^ 2)) :=
+begin
+  have : 0 < (↑t * I).im, by rwa [of_real_mul_im, I_im, mul_one],
+  convert summable_norm_iff.mpr (has_sum_nat_jacobi_theta this).summable,
+  ext1 n,
+  rw [complex.norm_eq_abs, complex.abs_exp],
+  rw show ↑π * I * (↑n + 1) ^ 2 * (↑t * I) = ↑(π * t * (n + 1) ^ 2) * I ^ 2, by { push_cast, ring },
+  rw [I_sq, mul_neg_one, ←of_real_neg, of_real_re, neg_mul, neg_mul],
+end
+
+/-- Relate `zeta_kernel₁` to the Jacobi theta function on `ℍ`. (We don't use this as the definition
+of `zeta_kernel₁`, since the sum over `ℕ` rather than `ℤ` is more convenient for relating zeta to
+the Dirichlet series for `re s > 1`.) -/
+lemma zeta_kernel₁_eq_jacobi_theta {t : ℝ} (ht : 0 < t) :
+  zeta_kernel₁ t = (jacobi_theta (t * I) - 1) / 2 :=
+begin
+  rw [jacobi_theta_eq_tsum_nat ((mul_I_im t).symm ▸ ht : 0 < (↑t * I).im), add_comm, add_sub_cancel,
+    mul_div_cancel_left _ (two_ne_zero' ℂ), zeta_kernel₁],
+  congr' 1 with n : 1,
+  push_cast,
+  rw [(by ring : ↑π * I * (n + 1) ^ 2 * (t * I) = I ^ 2 * π * t * (n + 1) ^ 2), I_sq, neg_one_mul],
+end
+
+/-- Continuity of `zeta_kernel₁`. -/
+lemma continuous_at_zeta_kernel₁ {t : ℝ} (ht : 0 < t) : continuous_at zeta_kernel₁ t :=
+begin
+  have : continuous_at (λ u : ℝ, (jacobi_theta (u * I) - 1) / 2) t,
+  { refine (continuous_at.sub _ continuous_at_const).div_const _,
+    refine (continuous_at_jacobi_theta _).comp (continuous_at.mul _ continuous_at_const),
+    { rwa [mul_I_im, of_real_re] },
+    { exact continuous_of_real.continuous_at } },
+  refine this.congr (eventually_of_mem (Ioi_mem_nhds ht) (λ u hu, _)),
+  rw zeta_kernel₁_eq_jacobi_theta hu,
+end
+
+/-- Local integrability of `zeta_kernel₁`. -/
+lemma locally_integrable_zeta_kernel₁ : locally_integrable_on zeta_kernel₁ (Ioi 0) :=
+(continuous_at.continuous_on $ λ t ht, continuous_at_zeta_kernel₁ ht).locally_integrable_on
+  measurable_set_Ioi
+
+/-- Local integrability of `zeta_kernel₂`. -/
+lemma locally_integrable_zeta_kernel₂ : locally_integrable_on zeta_kernel₂ (Ioi 0) :=
+begin
+  refine (locally_integrable_on_iff (or.inr is_open_Ioi)).mpr (λ k hk hk', integrable.add _ _),
+  { refine continuous_on.integrable_on_compact hk' _,
+    exact continuous_at.continuous_on (λ x hx, continuous_at_zeta_kernel₁ (hk hx)) },
+  { refine (integrable_indicator_iff measurable_set_Ioc).mpr _,
+    rw [integrable_on, measure.restrict_restrict, ←integrable_on],
+    swap, { exact measurable_set_Ioc },
+    apply continuous_on.integrable_on_compact,
+    { convert (is_compact_Icc : is_compact $ Icc 0 1).inter hk' using 1,
+      exact set.ext (λ t, ⟨λ h, ⟨Ioc_subset_Icc_self h.1, h.2⟩, λ h, ⟨⟨hk h.2, h.1.2⟩, h.2⟩⟩) },
+    { refine continuous_on.mono _ ((inter_subset_right _ _).trans hk),
+      refine (continuous_on_const.sub _).div_const _,
+      refine continuous_on.div continuous_on_const _ (λ x hx, _),
+      { exact (continuous_of_real.comp continuous_sqrt).continuous_on },
+      exact of_real_ne_zero.mpr (sqrt_ne_zero'.mpr hx) } }
+end
+
+/-- Functional equation for `zeta_kernel₂`. -/
+lemma zeta_kernel₂_one_div {t : ℝ} (ht : 0 < t) :
+  zeta_kernel₂ (1 / t) = sqrt t * zeta_kernel₂ t :=
+begin
+  have aux : ∀ {u : ℝ} (hu : 1 < u), zeta_kernel₂ (1 / u) = sqrt u * zeta_kernel₂ u,
+  { intros u hu,
+    simp_rw [zeta_kernel₂, pi.add_apply],
+    rw [indicator_of_mem, indicator_of_not_mem (not_mem_Ioc_of_gt hu), add_zero],
+    swap, { exact ⟨one_div_pos.mpr (zero_lt_one.trans hu), (one_div u).symm ▸ (inv_le_one hu.le)⟩ },
+    rw [zeta_kernel₁_eq_jacobi_theta (one_div_pos.mpr $ zero_lt_one.trans hu),
+      zeta_kernel₁_eq_jacobi_theta (zero_lt_one.trans hu), ←add_div, ←mul_div_assoc, add_sub,
+      sub_add_cancel, sqrt_div zero_le_one, sqrt_one, one_div (sqrt _), of_real_inv,
+      ←one_div, one_div_one_div, mul_sub, mul_one],
+    congr' 2,
+    let τ : upper_half_plane := ⟨u * I, (mul_I_im u).symm ▸ (zero_lt_one.trans hu)⟩,
+    convert jacobi_theta_S_smul τ using 2,
+    { rw [upper_half_plane.modular_S_smul, upper_half_plane.coe_mk, subtype.coe_mk, ←neg_inv,
+        mul_inv, inv_I, mul_neg, neg_neg, one_div, of_real_inv], },
+    { rw [subtype.coe_mk, mul_comm, mul_assoc, mul_neg, I_mul_I, neg_neg, mul_one,
+        sqrt_eq_rpow, of_real_cpow (zero_lt_one.trans hu).le],
+      push_cast } },
+  rcases lt_trichotomy 1 t with h | rfl | h,
+  { exact aux h },
+  { simp only [div_self, ne.def, one_ne_zero, not_false_iff, sqrt_one, of_real_one, one_mul], },
+  { have := aux (show 1 < 1 / t, by rwa [lt_one_div (zero_lt_one' ℝ) ht, div_one]),
+    rw one_div_one_div at this,
+    rw [this, ←mul_assoc, ←of_real_mul, ←sqrt_mul ht.le, mul_one_div_cancel ht.ne', sqrt_one,
+      of_real_one, one_mul] },
+end
+
+/-!
+## Bounds for zeta kernels
+
+We now establish asymptotic bounds for the zeta kernels as `t → ∞` and `t → 0`, and use these to
+show holomorphy of their Mellin transforms (for `1 / 2 < re s` for `zeta_kernel₁`, and all `s` for
+`zeta_kernel₂`). -/
+
+/-- Bound for `zeta_kernel₁` for large `t`. -/
+lemma is_O_at_top_zeta_kernel₁ : is_O at_top zeta_kernel₁ (λ t, exp (-π * t)) :=
+begin
+  have h := (is_O_at_im_infty_jacobi_theta_sub_one).const_mul_left (1 / 2),
+  simp_rw [(mul_comm (1 / 2 : ℂ) _), mul_one_div] at h,
+  have h' : tendsto (λ t : ℝ, ↑t * I) at_top (comap im at_top),
+  { rw tendsto_comap_iff,
+    convert tendsto_id,
+    ext1 t,
+    rw [function.comp_app, mul_I_im, of_real_re, id.def] },
+  convert ((h.norm_left.comp_tendsto h').congr' (eventually_of_mem (Ioi_mem_at_top 0) (λ t ht, _))
+    (eventually_of_mem (Ioi_mem_at_top 0) (λ t ht, _))).of_norm_left,
+  { rw [function.comp_app, ←zeta_kernel₁_eq_jacobi_theta ht] },
+  { rw [function.comp_app, mul_I_im, of_real_re] }
+end
+
+/-- Bound for `zeta_kernel₂` for large `t`. -/
+lemma is_O_at_top_zeta_kernel₂ : is_O at_top zeta_kernel₂ (λ t, exp (-π * t)) :=
+begin
+  refine (eventually_eq_of_mem (Ioi_mem_at_top (1 : ℝ)) (λ t ht, _)).trans_is_O
+    is_O_at_top_zeta_kernel₁,
+  rw [zeta_kernel₂, pi.add_apply, indicator_of_not_mem (not_mem_Ioc_of_gt ht), add_zero],
+end
+
+/-- Precise but awkward-to-use bound for `zeta_kernel₂` for `t → 0`. -/
+lemma is_O_zero_zeta_kernel₂ : is_O (𝓝[>] 0) zeta_kernel₂ (λ t, exp (-π / t) / sqrt t) :=
+begin
+  have h1 := (is_O_at_top_zeta_kernel₂).comp_tendsto tendsto_inv_zero_at_top,
+  simp_rw ←one_div at h1,
+  have h2 : (zeta_kernel₂ ∘ has_div.div 1) =ᶠ[𝓝[>] 0] λ t, sqrt t * zeta_kernel₂ t,
+    from eventually_of_mem self_mem_nhds_within (λ t ht, by simp_rw ←zeta_kernel₂_one_div ht),
+  have h3 := (h1.congr' h2 (eventually_eq.refl _ _)),
+  have h4 := h3.mul (is_O_refl (λ t : ℝ, 1 / (sqrt t : ℂ)) (𝓝[>] 0)).norm_right,
+  refine h4.congr' _ _,
+  { refine eventually_of_mem self_mem_nhds_within (λ x hx, _),
+    simp_rw [←mul_assoc],
+    rw [mul_comm, ←mul_assoc, one_div_mul_cancel, one_mul],
+    exact of_real_ne_zero.mpr ((sqrt_ne_zero $ le_of_lt hx).mpr (ne_of_gt hx)) },
+  { refine eventually_of_mem self_mem_nhds_within (λ x hx, _),
+    dsimp only,
+    rw [function.comp_app, mul_one_div, one_div (↑(sqrt _)), ←of_real_inv, is_R_or_C.norm_of_real,
+      abs_inv, abs_of_nonneg (sqrt_nonneg _), ←div_eq_mul_inv] },
+end
+
+/-- Weaker but more usable bound for `zeta_kernel₂` for `t → 0`. -/
+lemma is_O_zero_zeta_kernel₂_rpow (a : ℝ) : is_O (𝓝[>] 0) zeta_kernel₂ (λ t, t ^ a) :=
+begin
+  have aux1 : is_O at_top (λ t, exp (-π * t)) (λ t, t ^ (-a - 1 / 2)),
+    from (is_o_exp_neg_mul_rpow_at_top pi_pos _).is_O,
+  have aux2 : is_O at_top (λ t, exp (-π * t) * sqrt t) (λ t, t ^ (-a)),
+  { refine (aux1.mul (is_O_refl sqrt _)).congr' (eventually_eq.refl _ _) _,
+    refine (eventually_gt_at_top 0).mp (eventually_of_forall (λ t ht, _)),
+    simp_rw [sqrt_eq_rpow, ←rpow_add ht, sub_add_cancel] },
+  refine is_O_zero_zeta_kernel₂.trans ((aux2.comp_tendsto tendsto_inv_zero_at_top).congr' _ _),
+  { refine eventually_of_mem self_mem_nhds_within (λ x hx, _),
+    simp_rw [function.comp_app, sqrt_inv, ←div_eq_mul_inv] },
+  { refine eventually_of_mem self_mem_nhds_within (λ x hx, _),
+    simp_rw [function.comp_app, inv_rpow (le_of_lt hx), rpow_neg (le_of_lt hx), inv_inv] }
+end
+
+/-- Bound for `zeta_kernel₁` for `t → 0`. -/
+lemma is_O_zero_zeta_kernel₁ : is_O (𝓝[>] 0) zeta_kernel₁ (λ t, t ^ (-(1 / 2) : ℝ)) :=
+begin
+  have : zeta_kernel₁ =ᶠ[𝓝[>] 0] zeta_kernel₂ + (λ t, (1 / sqrt t - 1) / 2),
+  { refine eventually_eq_of_mem (Ioc_mem_nhds_within_Ioi $ left_mem_Ico.mpr zero_lt_one) (λ t h, _),
+    rw [pi.add_apply, zeta_kernel₂, pi.add_apply, indicator_of_mem h],
+    ring },
+  refine ((is_O_zero_zeta_kernel₂_rpow _).add _).congr' this.symm (eventually_eq.refl _ _),
+  simp_rw sub_div,
+  apply is_O.sub,
+  { apply is_O.of_norm_left,
+    simp_rw [norm_div, norm_one, div_eq_mul_inv, one_mul, mul_comm _ (‖(2 : ℂ)‖)⁻¹],
+    refine ((is_O_refl _ _).congr' (eventually_eq.refl _ _)
+      (eventually_eq_of_mem self_mem_nhds_within (λ x hx, _))).const_mul_left _,
+    rw [is_R_or_C.norm_of_real, abs_of_nonneg (sqrt_nonneg _)],
+    simp_rw [sqrt_eq_rpow, rpow_neg (le_of_lt hx), one_div] },
+  { refine is_O_iff.mpr ⟨‖(1 / 2 : ℂ)‖, _⟩,
+    refine eventually_of_mem (Ioc_mem_nhds_within_Ioi $ left_mem_Ico.mpr zero_lt_one) (λ t ht, _),
+    refine le_mul_of_one_le_right (norm_nonneg _) _,
+    rw [norm_of_nonneg (rpow_nonneg_of_nonneg ht.1.le _), rpow_neg ht.1.le],
+    exact one_le_inv (rpow_pos_of_pos ht.1 _) (rpow_le_one ht.1.le ht.2 one_half_pos.le) }
+end
+
+/-!
+## Differentiability of the completed zeta function
+-/
+
+/-- The Mellin transform of the first zeta kernel is holomorphic for `1 / 2 < re s`. -/
+lemma differentiable_at_mellin_zeta_kernel₁ {s : ℂ} (hs : 1 / 2 < s.re) :
+  differentiable_at ℂ (mellin zeta_kernel₁) s :=
+mellin_differentiable_at_of_is_O_rpow_exp pi_pos locally_integrable_zeta_kernel₁
+  is_O_at_top_zeta_kernel₁ is_O_zero_zeta_kernel₁ hs
+
+/-- The Mellin transform of the second zeta kernel is entire. -/
+lemma differentiable_mellin_zeta_kernel₂ : differentiable ℂ (mellin zeta_kernel₂) :=
+λ s, mellin_differentiable_at_of_is_O_rpow_exp pi_pos locally_integrable_zeta_kernel₂
+  is_O_at_top_zeta_kernel₂ (is_O_zero_zeta_kernel₂_rpow _) ((sub_lt_self_iff _).mpr zero_lt_one)
+
+/-- The modified completed Riemann zeta function `Λ(s) + 1 / s - 1 / (s - 1)` is entire. -/
+theorem differentiable_completed_zeta₀ : differentiable ℂ riemann_completed_zeta₀ :=
+differentiable_mellin_zeta_kernel₂.comp (differentiable.div_const differentiable_id 2)
+
+/-- The completed Riemann zeta function `Λ(s)` is differentiable away from `s = 0` and `s = 1`
+(where it has simple poles). -/
+theorem differentiable_at_completed_zeta {s : ℂ} (hs : s ≠ 0) (hs' : s ≠ 1) :
+  differentiable_at ℂ riemann_completed_zeta s :=
+begin
+  refine (differentiable_completed_zeta₀.differentiable_at.sub _).add _,
+  { exact (differentiable.differentiable_at (differentiable_const _)).div differentiable_at_id hs },
+  { refine ((differentiable_const _).differentiable_at).div _ (sub_ne_zero.mpr hs'),
+    exact differentiable_at_id.sub (differentiable_at_const _) },
+end
+
+/-- The Riemann zeta function is differentiable away from `s = 1`. -/
+theorem differentiable_at_riemann_zeta {s : ℂ} (hs' : s ≠ 1) :
+  differentiable_at ℂ riemann_zeta s :=
+begin
+  /- First claim: the result holds at `t` for `t ≠ 0`. Note we will need to use this for the case
+  `s = 0` also, as a hypothesis for the removable-singularity criterion. -/
+  have c1 : ∀ (t : ℂ) (ht : t ≠ 0) (ht' : t ≠ 1), differentiable_at ℂ
+      (λ u : ℂ, ↑π ^ (u / 2) * riemann_completed_zeta u / Gamma (u / 2)) t,
+  { intros t ht ht',
+    apply differentiable_at.mul,
+    { refine (differentiable_at.const_cpow _ _).mul (differentiable_at_completed_zeta ht ht'),
+      { exact differentiable_at.div_const differentiable_at_id _ },
+      { exact or.inl (of_real_ne_zero.mpr pi_pos.ne') } },
+    { refine differentiable_one_div_Gamma.differentiable_at.comp t _,
+      exact differentiable_at.div_const differentiable_at_id _ } },
+  /- Second claim: the limit at `s = 0` exists and is equal to `-1 / 2`. -/
+  have c2 : tendsto (λ s : ℂ, ↑π ^ (s / 2) * riemann_completed_zeta s / Gamma (s / 2))
+    (𝓝[≠] 0) (𝓝 $ -1 / 2),
+  { have h1 : tendsto (λ z : ℂ, (π : ℂ) ^ (z / 2)) (𝓝 0) (𝓝 1),
+    { convert (continuous_at_const_cpow (of_real_ne_zero.mpr pi_pos.ne')).comp _,
+      { simp_rw [function.comp_app, zero_div, cpow_zero] },
+      { exact continuous_at_id.div continuous_at_const two_ne_zero } },
+    suffices h2 : tendsto (λ z, riemann_completed_zeta z / Gamma (z / 2)) (𝓝[≠] 0) (𝓝 $ -1 / 2),
+    { convert (h1.mono_left nhds_within_le_nhds).mul h2,
+      { ext1 x, rw mul_div }, { simp only [one_mul] } },
+    suffices h3 : tendsto (λ z, (riemann_completed_zeta z * (z / 2)) / (z / 2 * Gamma (z / 2)))
+      (𝓝[≠] 0) (𝓝 $ -1 / 2),
+    { refine tendsto.congr' (eventually_eq_of_mem self_mem_nhds_within (λ z hz, _)) h3,
+      rw [←div_div, mul_div_cancel _ (div_ne_zero hz two_ne_zero)] },
+    have h4 : tendsto (λ z : ℂ, z / 2 * Gamma (z / 2)) (𝓝[≠] 0) (𝓝 1),
+    { refine tendsto_self_mul_Gamma_nhds_zero.comp _,
+      rw [tendsto_nhds_within_iff, (by simp : 𝓝 (0 : ℂ) = 𝓝 (0 / 2))],
+      exact ⟨(tendsto_id.div_const _).mono_left nhds_within_le_nhds,
+        eventually_of_mem self_mem_nhds_within (λ x hx, div_ne_zero hx two_ne_zero)⟩ },
+    suffices : tendsto (λ z, riemann_completed_zeta z * z / 2) (𝓝[≠] 0) (𝓝 (-1 / 2 : ℂ)),
+    { have := this.div h4 one_ne_zero,
+      simp_rw [div_one, mul_div_assoc] at this,
+      exact this },
+    refine tendsto.div _ tendsto_const_nhds two_ne_zero,
+    simp_rw [riemann_completed_zeta, add_mul, sub_mul],
+    rw show 𝓝 (-1 : ℂ) = 𝓝 (0 - 1 + 0), by rw [zero_sub, add_zero],
+    refine (tendsto.sub _ _).add _,
+    { refine tendsto.mono_left _ nhds_within_le_nhds,
+      have : continuous_at riemann_completed_zeta₀ 0,
+        from (differentiable_completed_zeta₀).continuous.continuous_at,
+      simpa only [id.def, mul_zero] using tendsto.mul this tendsto_id },
+    { refine tendsto_const_nhds.congr' (eventually_eq_of_mem self_mem_nhds_within (λ t ht, _)),
+      simp_rw one_div_mul_cancel ht },
+    { refine tendsto.mono_left _ nhds_within_le_nhds,
+      suffices : continuous_at (λ z : ℂ, 1 / (z - 1)) 0,
+        by simpa only [id.def, mul_zero] using tendsto.mul this tendsto_id,
+      refine continuous_at_const.div (continuous_at_id.sub continuous_at_const) _,
+      simpa only [zero_sub] using neg_ne_zero.mpr one_ne_zero } },
+  -- Now the main proof.
+  rcases ne_or_eq s 0 with hs | rfl,
+  { -- The easy case: `s ≠ 0`
+    have : {(0 : ℂ)}ᶜ ∈ 𝓝 s, from is_open_compl_singleton.mem_nhds hs,
+    refine (c1 s hs hs').congr_of_eventually_eq (eventually_eq_of_mem this (λ x hx, _)),
+    unfold riemann_zeta,
+    apply function.update_noteq hx },
+  { -- The hard case: `s = 0`.
+    rw [riemann_zeta, ←(lim_eq_iff ⟨-1 / 2, c2⟩).mpr c2],
+    have S_nhds : {(1 : ℂ)}ᶜ ∈ 𝓝 (0 : ℂ), from is_open_compl_singleton.mem_nhds hs',
+    refine ((complex.differentiable_on_update_lim_of_is_o S_nhds
+      (λ t ht, (c1 t ht.2 ht.1).differentiable_within_at) _) 0 hs').differentiable_at S_nhds,
+    simp only [zero_div, div_zero, complex.Gamma_zero, mul_zero, cpow_zero, sub_zero],
+    -- Remains to show completed zeta is `o (s ^ (-1))` near 0.
+    refine (is_O_const_of_tendsto c2 $ one_ne_zero' ℂ).trans_is_o _,
+    rw is_o_iff_tendsto',
+    { exact tendsto.congr (λ x, by rw [←one_div, one_div_one_div]) nhds_within_le_nhds },
+    { exact eventually_of_mem self_mem_nhds_within (λ x hx hx', (hx $ inv_eq_zero.mp hx').elim) } }
+end
+
+/-- The trivial zeroes of the zeta function. -/
+lemma riemann_zeta_neg_two_mul_nat_add_one (n : ℕ) : riemann_zeta (-2 * (n + 1)) = 0 :=
+begin
+  have : (-2 : ℂ) * (n + 1) ≠ 0,
+    from mul_ne_zero (neg_ne_zero.mpr two_ne_zero) (nat.cast_add_one_ne_zero n),
+  rw [riemann_zeta, function.update_noteq this,
+    (show (-2) * ((n : ℂ) + 1) / 2 = -↑(n + 1), by { push_cast, ring }),
+    complex.Gamma_neg_nat_eq_zero, div_zero],
+end
+
+/-- A formal statement of the Riemann hypothesis – constructing a term of this type is worth a
+million dollars. -/
+def riemann_hypothesis : Prop :=
+∀ (s : ℂ) (hs : riemann_completed_zeta s = 0) (hs' : ¬∃ (n : ℕ), s = -2 * (n + 1)), s.re = 1 / 2
+
+/-!
+## Relating the Mellin transforms of the two zeta kernels
+-/
+
+lemma has_mellin_one_div_sqrt_Ioc {s : ℂ} (hs : 1 / 2 < re s) :
+  has_mellin (indicator (Ioc 0 1) (λ t, 1 / ↑(sqrt t) : ℝ → ℂ)) s (1 / (s - 1 / 2)) :=
+begin
+  have h1 : eq_on (λ t, 1 / ↑(sqrt t) : ℝ → ℂ) (λ t, ↑t ^ (-1 / 2 : ℂ)) (Ioc 0 1),
+  { intros t ht,
+    simp_rw [neg_div, cpow_neg, ←one_div, sqrt_eq_rpow, of_real_cpow ht.1.le],
+    push_cast },
+  simp_rw [indicator_congr h1, (by ring : s - 1/2 = s + (-1) / 2)],
+  convert has_mellin_cpow_Ioc (-1 / 2) _,
+  rwa [(by push_cast : (-1 / 2 : ℂ) = (-1 / 2 : ℝ)), of_real_re, neg_div, ←sub_eq_add_neg, sub_pos]
+end
+
+/-- Evaluate the Mellin transform of the "fudge factor" in `zeta_kernel₂` -/
+lemma has_mellin_one_div_sqrt_sub_one_div_two_Ioc {s : ℂ} (hs : 1 / 2 < s.re) :
+  has_mellin ((Ioc 0 1).indicator (λ t, (1 - 1 / (sqrt t : ℂ)) / 2)) s
+  (1 / (2 * s) - 1 / (2 * s - 1)) :=
+begin
+  have step1 : has_mellin (indicator (Ioc 0 1) (λ t, 1 - 1 / ↑(sqrt t) : ℝ → ℂ)) s
+    (1 / s - 1 / (s - 1 / 2)),
+  { have a := has_mellin_one_Ioc (one_half_pos.trans hs),
+    have b := has_mellin_one_div_sqrt_Ioc hs,
+    simpa only [a.2, b.2, ←indicator_sub] using has_mellin_sub a.1 b.1 },
+  -- todo: implement something like "indicator.const_div" (blocked by the port for now)
+  rw (show (Ioc 0 1).indicator (λ t, (1 - 1 / (sqrt t : ℂ)) / 2) =
+    λ t, ((Ioc 0 1).indicator (λ t, (1 - 1 / (sqrt t : ℂ))) t) / 2,
+    by { ext1 t, simp_rw [div_eq_inv_mul, indicator_mul_right] }),
+  simp_rw [has_mellin, mellin_div_const, step1.2, sub_div, div_div],
+  refine ⟨step1.1.div_const _, _⟩,
+  rw [mul_comm, sub_mul, div_mul_cancel _ (two_ne_zero' ℂ), mul_comm s 2],
+end
+
+lemma mellin_zeta_kernel₂_eq_of_lt_re {s : ℂ} (hs : 1 / 2 < s.re) :
+  mellin zeta_kernel₂ s = mellin zeta_kernel₁ s + 1 / (2 * s) - 1 / (2 * s - 1) :=
+begin
+  have h := mellin_convergent_of_is_O_rpow_exp pi_pos locally_integrable_zeta_kernel₁
+    is_O_at_top_zeta_kernel₁ is_O_zero_zeta_kernel₁ hs,
+  have h' := has_mellin_one_div_sqrt_sub_one_div_two_Ioc hs,
+  simp_rw [zeta_kernel₂, pi.add_def, add_sub_assoc, (has_mellin_add h h'.1).2, h'.2],
+end
+
+lemma completed_zeta_eq_mellin_of_one_lt_re {s : ℂ} (hs : 1 < re s) :
+  riemann_completed_zeta s = mellin zeta_kernel₁ (s / 2) :=
+begin
+  have : 1 / 2 < (s / 2).re,
+  { rw (show s / 2 = ↑(2⁻¹ : ℝ) * s, by { push_cast, rw mul_comm, refl }),
+    rwa [of_real_mul_re, ←div_eq_inv_mul, div_lt_div_right (zero_lt_two' ℝ)] },
+  rw [riemann_completed_zeta, riemann_completed_zeta₀, mellin_zeta_kernel₂_eq_of_lt_re this,
+    sub_add, sub_sub, ←add_sub],
+  conv_rhs { rw ←add_zero (mellin zeta_kernel₁ $ s / 2) },
+  congr' 1,
+  rw mul_div_cancel' _ (two_ne_zero' ℂ),
+  abel
+end
+
+/-!
+## Relating the first zeta kernel to the Dirichlet series
+-/
+
+/-- Auxiliary lemma for `mellin_zeta_kernel₁_eq_tsum`, computing the Mellin transform of an
+individual term in the series. -/
+lemma integral_cpow_mul_exp_neg_pi_mul_sq {s : ℂ} (hs : 0 < s.re) (n : ℕ) :
+  ∫ t : ℝ in Ioi 0, (t : ℂ) ^ (s - 1) * rexp (-π * t * (n + 1) ^ 2) =
+  ↑π ^ -s * complex.Gamma s * (1 / (n + 1) ^ (2 * s)) :=
+begin
+  rw [complex.Gamma_eq_integral hs, Gamma_integral_eq_mellin],
+  conv_rhs { congr, rw [←smul_eq_mul, ←mellin_comp_mul_left _ _ pi_pos] },
+  have : (1 / ((n : ℂ) + 1) ^ (2 * s)) = ↑(((n : ℝ) + 1) ^ (2 : ℝ)) ^ (-s),
+  { rw [(by push_cast: ((n : ℂ) + 1) = ↑( (n : ℝ) + 1)),
+      (by push_cast : (2 * s) = (↑(2 : ℝ) * s)),
+      cpow_mul_of_real_nonneg, one_div, cpow_neg],
+    rw [←nat.cast_succ],
+    exact nat.cast_nonneg _ },
+  conv_rhs { rw [this, mul_comm, ←smul_eq_mul] },
+  rw [← mellin_comp_mul_right _ _ (show 0 < ((n : ℝ) + 1) ^ (2 : ℝ), by positivity)],
+  refine set_integral_congr measurable_set_Ioi (λ t ht, _),
+  simp_rw smul_eq_mul,
+  congr' 3,
+  conv_rhs { rw [←nat.cast_two, rpow_nat_cast] },
+  ring
+end
+
+lemma mellin_zeta_kernel₁_eq_tsum {s : ℂ} (hs : 1 / 2 < s.re):
+  mellin zeta_kernel₁ s = π ^ (-s) * Gamma s * ∑' (n : ℕ), 1 / (n + 1) ^ (2 * s) :=
+begin
+  let bd : ℕ → ℝ → ℝ := λ n t, t ^ (s.re - 1) * exp (-π * t * (n + 1) ^ 2),
+  let f : ℕ → ℝ → ℂ := λ n t, t ^ (s - 1) * exp (-π * t * (n + 1) ^ 2),
+  have hm : measurable_set (Ioi (0:ℝ)), from measurable_set_Ioi,
+  have h_norm : ∀ (n : ℕ) {t : ℝ} (ht : 0 < t), ‖f n t‖ = bd n t,
+  { intros n t ht,
+    rw [norm_mul, complex.norm_eq_abs, complex.norm_eq_abs, complex.abs_of_nonneg (exp_pos _).le,
+      abs_cpow_eq_rpow_re_of_pos ht, sub_re, one_re] },
+  have hf_meas : ∀ (n : ℕ), ae_strongly_measurable (f n) (volume.restrict $ Ioi 0),
+  { intro n,
+    refine (continuous_on.mul _ _).ae_strongly_measurable hm,
+    { exact (continuous_at.continuous_on
+      (λ x hx, continuous_at_of_real_cpow_const _ _ $ or.inr $ ne_of_gt hx)) },
+    { apply continuous.continuous_on,
+      exact continuous_of_real.comp (continuous_exp.comp
+        ((continuous_const.mul continuous_id').mul continuous_const)) } },
+  have h_le : ∀ (n : ℕ), ∀ᵐ (t : ℝ) ∂volume.restrict (Ioi 0), ‖f n t‖ ≤ bd n t,
+    from λ n, (ae_restrict_iff' hm).mpr (ae_of_all _ (λ t ht, le_of_eq (h_norm n ht))),
+  have h_sum0 : ∀ {t : ℝ} (ht : 0 < t), has_sum (λ n, f n t) (t ^ (s - 1) * zeta_kernel₁ t),
+  { intros t ht,
+    have := (has_sum_of_real.mpr (summable_exp_neg_pi_mul_nat_sq ht).has_sum).mul_left
+      ((t : ℂ) ^ (s - 1)),
+    simpa only [of_real_mul, ←mul_assoc, of_real_bit0, of_real_one, mul_comm _ (2 : ℂ),
+      of_real_sub, of_real_one, of_real_tsum] using this },
+  have h_sum' : ∀ᵐ (t : ℝ) ∂volume.restrict (Ioi 0), has_sum (λ (n : ℕ), f n t)
+    (t ^ (s - 1) * zeta_kernel₁ t),
+    from (ae_restrict_iff' hm).mpr (ae_of_all _ (λ t ht, h_sum0 ht)),
+  have h_sum : ∀ᵐ (t : ℝ) ∂volume.restrict (Ioi 0), summable (λ n : ℕ, bd n t),
+  { refine (ae_restrict_iff' hm).mpr (ae_of_all _ (λ t ht, _)),
+    simpa only [λ n, h_norm n ht] using summable_norm_iff.mpr (h_sum0 ht).summable },
+  have h_int : integrable (λ t : ℝ, ∑' (n : ℕ), bd n t) (volume.restrict (Ioi 0)),
+  { refine integrable_on.congr_fun (mellin_convergent_of_is_O_rpow_exp pi_pos
+      locally_integrable_zeta_kernel₁ is_O_at_top_zeta_kernel₁ is_O_zero_zeta_kernel₁ hs).norm
+      (λ t ht, _) hm,
+    simp_rw [tsum_mul_left, norm_smul, complex.norm_eq_abs ((t : ℂ) ^ _),
+      abs_cpow_eq_rpow_re_of_pos ht, sub_re, one_re],
+    rw [zeta_kernel₁, ←of_real_tsum, complex.norm_eq_abs, complex.abs_of_nonneg],
+    exact tsum_nonneg (λ n, (exp_pos _).le) },
+  simpa only [integral_cpow_mul_exp_neg_pi_mul_sq (one_half_pos.trans hs), tsum_mul_left] using
+    (has_sum_integral_of_dominated_convergence bd hf_meas h_le h_sum h_int h_sum').tsum_eq.symm,
+end
+
+lemma completed_zeta_eq_tsum_of_one_lt_re {s : ℂ} (hs : 1 < re s) :
+  riemann_completed_zeta s = π ^ (-s / 2) * Gamma (s / 2) * ∑' (n : ℕ), 1 / (n + 1) ^ s :=
+begin
+  rw [completed_zeta_eq_mellin_of_one_lt_re hs, mellin_zeta_kernel₁_eq_tsum, neg_div,
+    mul_div_cancel' _ (two_ne_zero' ℂ)],
+  rw (show s / 2 = ↑(2⁻¹ : ℝ) * s, by { push_cast, rw mul_comm, refl }),
+  rwa [of_real_mul_re, ←div_eq_inv_mul, div_lt_div_right (zero_lt_two' ℝ)]
+end
+
+/-- The Riemann zeta function agrees with the naive Dirichlet-series definition when the latter
+converges. (Note that this is false without the assumption: when `re s ≤ 1` the sum is divergent,
+and we use a different definition to obtain the analytic continuation to all `s`.) -/
+theorem zeta_eq_tsum_one_div_nat_add_one_cpow {s : ℂ} (hs : 1 < re s) :
+  riemann_zeta s = ∑' (n : ℕ), 1 / (n + 1) ^ s :=
+begin
+  have : s ≠ 0, by { contrapose! hs, rw [hs, zero_re], exact zero_le_one },
+  rw [riemann_zeta, function.update_noteq this, completed_zeta_eq_tsum_of_one_lt_re hs,
+    ←mul_assoc, neg_div, cpow_neg, mul_inv_cancel_left₀, mul_div_cancel_left],
+  { apply Gamma_ne_zero_of_re_pos,
+    rw [←of_real_one, ←of_real_bit0, div_eq_mul_inv, ←of_real_inv, mul_comm, of_real_mul_re],
+    exact mul_pos (inv_pos_of_pos two_pos) (zero_lt_one.trans hs), },
+  { rw [ne.def, cpow_eq_zero_iff, not_and_distrib, ←ne.def, of_real_ne_zero],
+    exact or.inl (pi_pos.ne') }
+end
+
+/-- Alternate formulation of `zeta_eq_tsum_one_div_nat_add_one_cpow` without the `+ 1`, using the
+fact that for `s ≠ 0` we define `0 ^ s = 0`.  -/
+lemma zeta_eq_tsum_one_div_nat_cpow {s : ℂ} (hs : 1 < re s) :
+  riemann_zeta s = ∑' (n : ℕ), 1 / n ^ s :=
+begin
+  have hs' : s ≠ 0, by { contrapose! hs, rw [hs, zero_re], exact zero_le_one },
+  rw [tsum_eq_zero_add],
+  { simp_rw [nat.cast_zero, zero_cpow hs', div_zero, zero_add,
+    zeta_eq_tsum_one_div_nat_add_one_cpow hs, nat.cast_add, nat.cast_one] },
+  { rw ←summable_norm_iff,
+    simp_rw [norm_div, norm_one, complex.norm_eq_abs, ←of_real_nat_cast,
+      abs_cpow_eq_rpow_re_of_nonneg (nat.cast_nonneg _) (zero_lt_one.trans hs).ne',
+      summable_one_div_nat_rpow],
+    assumption }
+end
+
+/-- Special case of `zeta_eq_tsum_one_div_nat_cpow` when the argument is in `ℕ`, so the power
+function can be expressed using naïve `pow` rather than `cpow`. -/
+lemma zeta_nat_eq_tsum_of_gt_one {k : ℕ} (hk : 1 < k) : riemann_zeta k = ∑' (n : ℕ), 1 / n ^ k :=
+by simp only [zeta_eq_tsum_one_div_nat_cpow (by rwa [←of_real_nat_cast, of_real_re, ←nat.cast_one,
+    nat.cast_lt] : 1 < re k), cpow_nat_cast]
+
+/-- Explicit formula for `ζ (2 * k)`, for `k ∈ ℕ` with `k ≠ 0`: we have
+`ζ (2 * k) = (-1) ^ (k + 1) * 2 ^ (2 * k - 1) * π ^ (2 * k) * bernoulli (2 * k) / (2 * k)!`.
+Compare `has_sum_zeta_nat` for a version formulated explicitly as a sum, and
+`riemann_zeta_neg_nat_eq_bernoulli` for values at negative integers (equivalent to the above via
+the functional equation). -/
+lemma riemann_zeta_two_mul_nat {k : ℕ} (hk : k ≠ 0) :
+  riemann_zeta (2 * k) =
+  (-1) ^ (k + 1) * 2 ^ (2 * k - 1) * π ^ (2 * k) * bernoulli (2 * k) / (2 * k)! :=
+begin
+  convert congr_arg (coe : ℝ → ℂ) (has_sum_zeta_nat hk).tsum_eq,
+  { rw [←nat.cast_two, ←nat.cast_mul, zeta_nat_eq_tsum_of_gt_one],
+    { push_cast },
+    { refine (one_lt_two).trans_le _,
+      conv_lhs { rw ←mul_one 2 },
+      rwa [mul_le_mul_left (zero_lt_two' ℕ), nat.one_le_iff_ne_zero] } },
+  { push_cast }
+end
+
+lemma riemann_zeta_two : riemann_zeta 2 = π ^ 2 / 6 :=
+begin
+  convert congr_arg coe has_sum_zeta_two.tsum_eq,
+  { rw [←nat.cast_two, zeta_nat_eq_tsum_of_gt_one one_lt_two, of_real_tsum],
+    push_cast },
+  { push_cast }
+end
+
+lemma riemann_zeta_four : riemann_zeta 4 = π ^ 4 / 90 :=
+begin
+  convert congr_arg coe has_sum_zeta_four.tsum_eq,
+  { rw [←nat.cast_one, ←nat.cast_bit0, ←nat.cast_bit0, zeta_nat_eq_tsum_of_gt_one
+      (by norm_num : 1 < 4), of_real_tsum],
+    push_cast },
+  { push_cast }
+end
+
+/-!
+## Functional equation
+-/
+
+/-- Riemann zeta functional equation, formulated for `Λ₀`: for any complex `s` we have
+`Λ₀(1 - s) = Λ₀ s`. -/
+lemma riemann_completed_zeta₀_one_sub (s : ℂ) :
+  riemann_completed_zeta₀ (1 - s) = riemann_completed_zeta₀ s :=
+begin
+  have := mellin_comp_rpow (zeta_kernel₂) (s / 2 - 1 / 2) neg_one_lt_zero.ne,
+  simp_rw [rpow_neg_one, ←one_div, abs_neg, abs_one, div_one, one_smul, of_real_neg,
+    of_real_one, div_neg, div_one, neg_sub] at this,
+  conv_lhs { rw [riemann_completed_zeta₀, sub_div, ←this] },
+  refine set_integral_congr measurable_set_Ioi (λ t ht, _),
+  simp_rw [zeta_kernel₂_one_div ht, smul_eq_mul, ←mul_assoc, sqrt_eq_rpow,
+    of_real_cpow (le_of_lt ht), ←cpow_add _ _ (of_real_ne_zero.mpr $ ne_of_gt ht)],
+  congr' 2,
+  push_cast,
+  ring,
+end
+
+/-- Riemann zeta functional equation, formulated for `Λ`: for any complex `s` we have
+`Λ (1 - s) = Λ s`. -/
+lemma riemann_completed_zeta_one_sub (s : ℂ) :
+  riemann_completed_zeta (1 - s) = riemann_completed_zeta s :=
+by simp_rw [riemann_completed_zeta, riemann_completed_zeta₀_one_sub, sub_add,
+    (by abel : 1 - s - 1 = -s), (by abel : 1 - s = -(s - 1)), div_neg, neg_sub_neg]
+
+/-- Riemann zeta functional equation, formulated for `ζ`: if `1 - s ∉ ℕ`, then we have
+`ζ (1 - s) = 2 ^ (1 - s) * π ^ (-s) * Γ s * sin (π * (1 - s) / 2) * ζ s`. -/
+lemma riemann_zeta_one_sub {s : ℂ} (hs : ∀ (n : ℕ), s ≠ -n) (hs' : s ≠ 1) :
+  riemann_zeta (1 - s) =
+  2 ^ (1 - s) * π ^ (-s) * Gamma s * sin (π * (1 - s) / 2) * riemann_zeta s :=
+begin
+  -- Deducing this from the previous formulations is quite involved. The proof uses two
+  -- nontrivial facts (the doubling formula and reflection formula for Gamma) and a lot of careful
+  -- rearrangement, requiring several non-vanishing statements as input to `field_simp`.
+  have hs_ne : s ≠ 0, by { contrapose! hs, rw hs, exact ⟨0, by rw [nat.cast_zero, neg_zero]⟩ },
+  have h_sqrt : (sqrt π : ℂ) ≠ 0, from of_real_ne_zero.mpr (sqrt_ne_zero'.mpr pi_pos),
+  have h_pow : (2 : ℂ) ^ (s - 1) ≠ 0,
+  { rw [ne.def, cpow_eq_zero_iff, not_and_distrib], exact or.inl two_ne_zero },
+  have h_Ga_ne1 : Gamma (s / 2) ≠ 0,
+  { rw [ne.def, complex.Gamma_eq_zero_iff],
+    contrapose! hs,
+    obtain ⟨m, hm⟩ := hs,
+    rw [div_eq_iff (two_ne_zero' ℂ), ←nat.cast_two, neg_mul, ←nat.cast_mul] at hm,
+    exact ⟨m * 2, by rw hm⟩ },
+  have h_Ga_eq : Gamma s = Gamma (s / 2) * Gamma ((s + 1) / 2) * 2 ^ (s - 1) / sqrt π,
+  { rw [add_div, complex.Gamma_mul_Gamma_add_half, mul_div_cancel' _ (two_ne_zero' ℂ),
+      (by ring : 1 - s = -(s - 1)), cpow_neg, ←div_eq_mul_inv, eq_div_iff h_sqrt,
+      div_mul_eq_mul_div₀, div_mul_cancel _ h_pow] },
+  have h_Ga_ne3 : Gamma ((s + 1) / 2) ≠ 0,
+  { have h_Ga_aux : Gamma s ≠ 0, from complex.Gamma_ne_zero hs,
+    contrapose! h_Ga_aux,
+    rw [h_Ga_eq, h_Ga_aux, mul_zero, zero_mul, zero_div] },
+  rw [riemann_zeta, function.update_noteq (by rwa [sub_ne_zero, ne_comm] : 1 - s ≠ 0),
+    function.update_noteq hs_ne, riemann_completed_zeta_one_sub, mul_div, eq_div_iff h_Ga_ne1,
+    mul_comm, ←mul_div_assoc],
+  -- Now rule out case of s = positive odd integer & deduce further non-vanishing statements
+  by_cases hs_pos_odd : ∃ (n : ℕ), s = 1 + 2 * n,
+  { -- Note the case n = 0 (i.e. s = 1) works OK here, but only because we have used
+    -- `function.update_noteq` to change the goal; the original goal is genuinely false for s = 1.
+    obtain ⟨n, rfl⟩ := hs_pos_odd,
+    have : (1 - (1 + 2 * (n : ℂ))) / 2 = -↑n,
+    { rw [←sub_sub, sub_self, zero_sub, neg_div, mul_div_cancel_left _ (two_ne_zero' ℂ)] },
+    rw [this, complex.Gamma_neg_nat_eq_zero, div_zero],
+    have : (π : ℂ) * (1 - (1 + 2 * ↑n)) / 2 = ↑(-n : ℤ) * π,
+    { push_cast, field_simp, ring },
+    rw [this, complex.sin_int_mul_pi, mul_zero, zero_mul] },
+  have h_Ga_ne4 : Gamma ((1 - s) / 2) ≠ 0,
+  { rw [ne.def, complex.Gamma_eq_zero_iff],
+    contrapose! hs_pos_odd,
+    obtain ⟨m, hm⟩ := hs_pos_odd,
+    rw [div_eq_iff (two_ne_zero' ℂ), sub_eq_iff_eq_add, neg_mul, ←sub_eq_neg_add,
+      eq_sub_iff_add_eq] at hm,
+    exact ⟨m, by rw [←hm, mul_comm]⟩ },
+  -- At last the main proof
+  rw show sin (↑π * (1 - s) / 2) = π * (Gamma ((1 - s) / 2) * Gamma (s / 2 + 1 / 2))⁻¹, by
+  { have := congr_arg has_inv.inv (complex.Gamma_mul_Gamma_one_sub ((1 - s) / 2)).symm,
+    rwa [(by ring : 1 - (1 - s) / 2 = s / 2 + 1 / 2), inv_div,
+      div_eq_iff (of_real_ne_zero.mpr pi_pos.ne'), mul_comm _ ↑π, mul_div_assoc'] at this },
+  rw [(by rw ←neg_sub : (2 : ℂ) ^ (1 - s) = 2 ^ -(s - 1)), cpow_neg, h_Ga_eq],
+  suffices : (π : ℂ)  ^ ((1 - s) / 2)  = π ^ -s * sqrt π * π ^ (s / 2),
+  { rw this, field_simp, ring_nf, rw [←of_real_pow, sq_sqrt pi_pos.le], ring },
+  simp_rw [sqrt_eq_rpow, of_real_cpow pi_pos.le, ←cpow_add _ _ (of_real_ne_zero.mpr pi_pos.ne')],
+  congr' 1,
+  push_cast,
+  field_simp,
+  ring,
+end
+
+lemma riemann_zeta_neg_nat_eq_bernoulli (k : ℕ) :
+  riemann_zeta (-k) = (-1) ^ k * bernoulli (k + 1) / (k + 1) :=
+begin
+  rcases nat.even_or_odd' k with ⟨m, rfl | rfl⟩,
+  { cases m,
+    { -- k = 0 : evaluate explicitly
+      rw [mul_zero, nat.cast_zero, pow_zero, one_mul, zero_add, neg_zero, zero_add, div_one,
+        bernoulli_one, riemann_zeta_zero, rat.cast_div, rat.cast_neg, rat.cast_one,
+        rat.cast_bit0, rat.cast_one] },
+    { -- k = 2 * (m + 1) : both sides "trivially" zero
+      rw [nat.cast_mul, ←neg_mul, nat.cast_two, nat.cast_succ,
+        riemann_zeta_neg_two_mul_nat_add_one, bernoulli_eq_bernoulli'_of_ne_one],
+      swap, { apply ne_of_gt, norm_num },
+      rw [bernoulli'_odd_eq_zero ⟨m + 1, rfl⟩ (by norm_num), rat.cast_zero, mul_zero, zero_div] } },
+  { -- k = 2 * m + 1 : the interesting case
+    rw odd.neg_one_pow ⟨m, rfl⟩,
+    rw (show -(↑(2 * m + 1) : ℂ) = 1 - (2 * m + 2), by { push_cast, ring }),
+    rw riemann_zeta_one_sub,
+    rotate,
+    { intro n,
+      rw [(by norm_cast : (2 * (m : ℂ) + 2) = ↑(2 * m + 2)), ←int.cast_neg_nat_cast,
+        ←int.cast_coe_nat, ne.def, int.cast_inj],
+      apply ne_of_gt,
+      refine lt_of_le_of_lt (by norm_num : (-n : ℤ) ≤ 0) (by positivity) },
+    { rw [(by norm_cast : (2 * (m : ℂ) + 2) = ↑(2 * m + 2)), ne.def, nat.cast_eq_one], norm_num },
+    -- get rid of sine term
+    rw show complex.sin (↑π * (1 - (2 * ↑m + 2)) / 2) = -(-1) ^ m,
+    { rw (by { field_simp, ring } : (π : ℂ) * (1 - (2 * ↑m + 2)) / 2 = π / 2 - (π * m + π)),
+      rw [complex.sin_pi_div_two_sub, complex.cos_add_pi, neg_inj],
+      rcases nat.even_or_odd' m with ⟨t, rfl | rfl⟩,
+      { rw [pow_mul, neg_one_sq, one_pow],
+        convert complex.cos_nat_mul_two_pi t using 2, push_cast, ring },
+      { rw [pow_add, pow_one, pow_mul, neg_one_sq, one_pow, one_mul],
+        convert complex.cos_nat_mul_two_pi_add_pi t using 2, push_cast, ring } },
+    -- substitute in what we know about zeta values at positive integers
+    have step1 := congr_arg (coe : ℝ → ℂ) (has_sum_zeta_nat (by norm_num : m + 1 ≠ 0)).tsum_eq,
+    have step2 := zeta_nat_eq_tsum_of_gt_one (by { rw mul_add, norm_num } : 1 < 2 * (m + 1)),
+    simp_rw [of_real_tsum, of_real_div, of_real_one, of_real_pow, of_real_nat_cast] at step1,
+    rw [step1, (by norm_cast : (↑(2 * (m + 1)) : ℂ) = 2 * ↑m + 2)] at step2,
+    rw [step2, mul_div],
+    -- now the rest is just a lengthy but elementary rearrangement
+    rw show ((2 * (m + 1))! : ℂ) = Gamma (2 * m + 2) * (↑(2 * m + 1) + 1), by
+    { rw [(by { push_cast, ring } : (2 * m + 2 : ℂ) = ↑(2 * m + 1) + 1),
+        complex.Gamma_nat_eq_factorial,
+        (by ring : 2 * (m + 1) = (2 * m + 1) + 1), nat.factorial_succ, nat.cast_mul, mul_comm],
+      push_cast },
+    rw [←div_div, neg_one_mul],
+    congr' 1,
+    rw [div_eq_iff (Gamma_ne_zero_of_re_pos _)],
+    swap, { rw [(by push_cast : 2 * (m : ℂ) + 2 = ↑(2 * (m : ℝ) + 2)), of_real_re], positivity },
+    simp_rw [of_real_mul, ←mul_assoc, of_real_rat_cast, mul_add, nat.add_assoc, mul_one,
+      one_add_one_eq_two, mul_neg, neg_mul, neg_inj],
+    conv_rhs { rw mul_comm },
+    congr' 1,
+    rw [of_real_pow, of_real_neg, of_real_one, pow_add, neg_one_sq, mul_one],
+    conv_lhs { congr, congr,
+      rw [mul_assoc, ←pow_add, ←two_mul, pow_mul, neg_one_sq, one_pow, mul_one] },
+    rw show (2 : ℂ) ^ (1 - (2 * (m : ℂ) + 2)) = (↑((2 : ℝ) ^ ((2 * m + 2) - 1)))⁻¹,
+    { rw [of_real_pow, ←cpow_nat_cast, ←cpow_neg, of_real_bit0, of_real_one],
+      congr' 1,
+      rw [nat.add_sub_assoc one_le_two, nat.cast_add, nat.cast_mul, nat.cast_two,
+        (by norm_num : 2 - 1 = 1)],
+      push_cast, ring },
+    rw show (π : ℂ) ^ -(2 * (m : ℂ) + 2) = (↑(π ^ (2 * m + 2)))⁻¹,
+    { rw [of_real_pow, ←cpow_nat_cast, ←cpow_neg, nat.cast_add, nat.cast_mul, nat.cast_two] },
+    rw (by { intros, ring } : ∀ (a b c d e : ℂ), a * b * c * d * e = (a * d) * (b * e) * c),
+    rw [inv_mul_cancel (of_real_ne_zero.mpr $ pow_ne_zero _ pi_pos.ne'),
+      inv_mul_cancel (of_real_ne_zero.mpr $ pow_ne_zero _ two_ne_zero), one_mul, one_mul] }
+end
diff --git a/src/number_theory/zeta_values.lean b/src/number_theory/zeta_values.lean
new file mode 100644
index 0000000000000..296f70123d559
--- /dev/null
+++ b/src/number_theory/zeta_values.lean
@@ -0,0 +1,373 @@
+/-
+Copyright (c) 2022 David Loeffler. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: David Loeffler
+-/
+
+import number_theory.bernoulli_polynomials
+import measure_theory.integral.interval_integral
+import analysis.fourier.add_circle
+import analysis.p_series
+
+/-!
+# Critical values of the Riemann zeta function
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove formulae for the critical values of `ζ(s)`, and more generally of Hurwitz
+zeta functions, in terms of Bernoulli polynomials.
+
+## Main results:
+
+* `has_sum_zeta_nat`: the final formula for zeta values,
+  $$\zeta(2k) = \frac{(-1)^{(k + 1)} 2 ^ {2k - 1} \pi^{2k} B_{2 k}}{(2 k)!}.$$
+* `has_sum_zeta_two` and `has_sum_zeta_four`: special cases given explicitly.
+* `has_sum_one_div_nat_pow_mul_cos`: a formula for the sum `∑ (n : ℕ), cos (2 π i n x) / n ^ k` as
+  an explicit multiple of `Bₖ(x)`, for any `x ∈ [0, 1]` and `k ≥ 2` even.
+* `has_sum_one_div_nat_pow_mul_sin`: a formula for the sum `∑ (n : ℕ), sin (2 π i n x) / n ^ k` as
+  an explicit multiple of `Bₖ(x)`, for any `x ∈ [0, 1]` and `k ≥ 3` odd.
+-/
+
+
+noncomputable theory
+open_locale nat real interval
+open complex measure_theory set interval_integral
+
+local notation `𝕌` := unit_add_circle
+local attribute [instance] real.fact_zero_lt_one
+
+section bernoulli_fun_props
+/-! Simple properties of the Bernoulli polynomial, as a function `ℝ → ℝ`. -/
+
+/-- The function `x ↦ Bₖ(x) : ℝ → ℝ`. -/
+def bernoulli_fun (k : ℕ) (x : ℝ) : ℝ :=
+(polynomial.map (algebra_map ℚ ℝ) (polynomial.bernoulli k)).eval x
+
+lemma bernoulli_fun_eval_zero (k : ℕ) : bernoulli_fun k 0 = bernoulli k :=
+by rw [bernoulli_fun, polynomial.eval_zero_map, polynomial.bernoulli_eval_zero, eq_rat_cast]
+
+lemma bernoulli_fun_endpoints_eq_of_ne_one {k : ℕ} (hk : k ≠ 1) :
+  bernoulli_fun k 1 = bernoulli_fun k 0 :=
+by rw [bernoulli_fun_eval_zero, bernoulli_fun, polynomial.eval_one_map,
+  polynomial.bernoulli_eval_one, bernoulli_eq_bernoulli'_of_ne_one hk, eq_rat_cast]
+
+lemma bernoulli_fun_eval_one (k : ℕ) : bernoulli_fun k 1 = bernoulli_fun k 0 + ite (k = 1) 1 0 :=
+begin
+  rw [bernoulli_fun, bernoulli_fun_eval_zero, polynomial.eval_one_map,
+    polynomial.bernoulli_eval_one],
+  split_ifs,
+  { rw [h, bernoulli_one, bernoulli'_one, eq_rat_cast],
+    push_cast, ring },
+  { rw [bernoulli_eq_bernoulli'_of_ne_one h, add_zero, eq_rat_cast], }
+end
+
+lemma has_deriv_at_bernoulli_fun (k : ℕ) (x : ℝ) :
+  has_deriv_at (bernoulli_fun k) (k * bernoulli_fun (k - 1) x) x :=
+begin
+  convert ((polynomial.bernoulli k).map $ algebra_map ℚ ℝ).has_deriv_at x using 1,
+  simp only [bernoulli_fun, polynomial.derivative_map, polynomial.derivative_bernoulli k,
+    polynomial.map_mul, polynomial.map_nat_cast, polynomial.eval_mul, polynomial.eval_nat_cast],
+end
+
+lemma antideriv_bernoulli_fun (k : ℕ) (x : ℝ) :
+  has_deriv_at (λ x, (bernoulli_fun (k + 1) x) / (k + 1)) (bernoulli_fun k x) x :=
+begin
+  convert (has_deriv_at_bernoulli_fun (k + 1) x).div_const _,
+  field_simp [nat.cast_add_one_ne_zero k],
+  ring,
+end
+
+lemma integral_bernoulli_fun_eq_zero {k : ℕ} (hk : k ≠ 0) :
+  ∫ (x : ℝ) in 0..1, bernoulli_fun k x = 0 :=
+begin
+  rw integral_eq_sub_of_has_deriv_at (λ x hx, antideriv_bernoulli_fun k x)
+    ((polynomial.continuous _).interval_integrable _ _),
+  dsimp only,
+  rw bernoulli_fun_eval_one,
+  split_ifs,
+  { exfalso, exact hk (nat.succ_inj'.mp h), }, { simp },
+end
+
+end bernoulli_fun_props
+
+section bernoulli_fourier_coeffs
+/-! Compute the Fourier coefficients of the Bernoulli functions via integration by parts. -/
+
+/-- The `n`-th Fourier coefficient of the `k`-th Bernoulli function on the interval `[0, 1]`. -/
+def bernoulli_fourier_coeff (k : ℕ) (n : ℤ) : ℂ :=
+fourier_coeff_on zero_lt_one (λ x, bernoulli_fun k x) n
+
+/-- Recurrence relation (in `k`) for the `n`-th Fourier coefficient of `Bₖ`. -/
+lemma bernoulli_fourier_coeff_recurrence (k : ℕ) {n : ℤ} (hn : n ≠ 0) :
+  bernoulli_fourier_coeff k n = 1 / ((-2) * π * I * n) *
+  (ite (k = 1) 1 0 - k * bernoulli_fourier_coeff (k - 1) n) :=
+begin
+  unfold bernoulli_fourier_coeff,
+  rw [fourier_coeff_on_of_has_deriv_at zero_lt_one
+    hn (λ x hx, (has_deriv_at_bernoulli_fun k x).of_real_comp)
+    ((continuous_of_real.comp $ continuous_const.mul
+      $ polynomial.continuous _).interval_integrable _ _)],
+  dsimp only,
+  simp_rw [of_real_one, of_real_zero, sub_zero, one_mul],
+  rw [quotient_add_group.coe_zero, fourier_eval_zero, one_mul,
+    ←of_real_sub, bernoulli_fun_eval_one, add_sub_cancel'],
+  congr' 2,
+  { split_ifs, all_goals { simp only [of_real_one, of_real_zero, one_mul]}, },
+  { simp_rw [of_real_mul, of_real_nat_cast, fourier_coeff_on.const_mul] },
+end
+
+/-- The Fourier coefficients of `B₀(x) = 1`. -/
+lemma bernoulli_zero_fourier_coeff {n : ℤ} (hn : n ≠ 0) : bernoulli_fourier_coeff 0 n = 0 :=
+by simpa using bernoulli_fourier_coeff_recurrence 0 hn
+
+/-- The `0`-th Fourier coefficient of `Bₖ(x)`. -/
+lemma bernoulli_fourier_coeff_zero {k : ℕ} (hk : k ≠ 0) : bernoulli_fourier_coeff k 0 = 0 :=
+by simp_rw [bernoulli_fourier_coeff, fourier_coeff_on_eq_integral, neg_zero, fourier_zero, sub_zero,
+  div_one, one_smul, interval_integral.integral_of_real, integral_bernoulli_fun_eq_zero hk,
+  of_real_zero]
+
+lemma bernoulli_fourier_coeff_eq {k : ℕ} (hk : k ≠ 0) (n : ℤ) :
+  bernoulli_fourier_coeff k n = - k! / (2 * π * I * n) ^ k :=
+begin
+  rcases eq_or_ne n 0 with rfl|hn,
+  { rw [bernoulli_fourier_coeff_zero hk, int.cast_zero, mul_zero,
+    zero_pow' _ hk, div_zero] },
+  refine nat.le_induction _ (λ k hk h'k, _) k (nat.one_le_iff_ne_zero.mpr hk),
+  { rw bernoulli_fourier_coeff_recurrence 1 hn,
+    simp only [nat.cast_one, tsub_self, neg_mul, one_mul, eq_self_iff_true, if_true,
+      nat.factorial_one, pow_one, inv_I, mul_neg],
+    rw [bernoulli_zero_fourier_coeff hn, sub_zero, mul_one, div_neg, neg_div], },
+  { rw [bernoulli_fourier_coeff_recurrence (k + 1) hn, nat.add_sub_cancel k 1],
+    split_ifs,
+    { exfalso, exact (ne_of_gt (nat.lt_succ_iff.mpr hk)) h,},
+    { rw [h'k, nat.factorial_succ, zero_sub, nat.cast_mul, pow_add, pow_one, neg_div,
+        mul_neg, mul_neg, mul_neg, neg_neg, neg_mul, neg_mul, neg_mul, div_neg],
+      field_simp [int.cast_ne_zero.mpr hn, I_ne_zero],
+      ring_nf, } }
+end
+
+end bernoulli_fourier_coeffs
+
+section bernoulli_periodized
+/-! In this section we use the above evaluations of the Fourier coefficients of Bernoulli
+polynomials, together with the theorem `has_pointwise_sum_fourier_series_of_summable` from Fourier
+theory, to obtain an explicit formula for `∑ (n:ℤ), 1 / n ^ k * fourier n x`. -/
+
+/-- The Bernoulli polynomial, extended from `[0, 1)` to the unit circle. -/
+def periodized_bernoulli (k : ℕ) : 𝕌 → ℝ := add_circle.lift_Ico 1 0 (bernoulli_fun k)
+
+lemma periodized_bernoulli.continuous {k : ℕ} (hk : k ≠ 1) : continuous (periodized_bernoulli k) :=
+add_circle.lift_Ico_zero_continuous
+  (by exact_mod_cast (bernoulli_fun_endpoints_eq_of_ne_one hk).symm)
+  (polynomial.continuous _).continuous_on
+
+lemma fourier_coeff_bernoulli_eq {k : ℕ} (hk : k ≠ 0) (n : ℤ) :
+  fourier_coeff (coe ∘ periodized_bernoulli k : 𝕌 → ℂ) n = -k! / (2 * π * I * n) ^ k :=
+begin
+  have : (coe ∘ periodized_bernoulli k : 𝕌 → ℂ) = add_circle.lift_Ico 1 0 (coe ∘ bernoulli_fun k),
+  { ext1 x, refl },
+  rw [this, fourier_coeff_lift_Ico_eq],
+  simpa only [zero_add] using bernoulli_fourier_coeff_eq hk n,
+end
+
+lemma summable_bernoulli_fourier {k : ℕ} (hk : 2 ≤ k) :
+  summable (λ n, -k! / (2 * π * I * n) ^ k : ℤ → ℂ) :=
+begin
+  have : ∀ (n : ℤ), -(k! : ℂ) / (2 * π * I * n) ^ k
+    = (-k! / (2 * π * I) ^ k) * (1 / n ^ k),
+  { intro n, rw [mul_one_div, div_div, ←mul_pow], },
+  simp_rw this,
+  apply summable.mul_left,
+  rw ←summable_norm_iff,
+  have : (λ (x : ℤ), ‖1 / (x:ℂ) ^ k‖) = (λ (x : ℤ), |1 / (x:ℝ) ^ k|),
+  { ext1 x,
+    rw [norm_eq_abs, ←complex.abs_of_real],
+    congr' 1,
+    norm_cast },
+  simp_rw this,
+  rw [summable_abs_iff],
+  exact real.summable_one_div_int_pow.mpr (one_lt_two.trans_le hk),
+end
+
+lemma has_sum_one_div_pow_mul_fourier_mul_bernoulli_fun {k : ℕ} (hk : 2 ≤ k)
+  {x : ℝ} (hx : x ∈ Icc (0:ℝ) 1) :
+  has_sum (λ n:ℤ, 1 / (n:ℂ) ^ k * fourier n (x : 𝕌)) (-(2 * π * I) ^ k / k! * bernoulli_fun k x) :=
+begin
+  -- first show it suffices to prove result for `Ico 0 1`
+  suffices : ∀ {y : ℝ}, y ∈ Ico (0:ℝ) 1 → has_sum _ _,
+  { rw [←Ico_insert_right (zero_le_one' ℝ), mem_insert_iff, or.comm] at hx,
+    rcases hx with hx | rfl,
+    { exact this hx },
+    { convert this (left_mem_Ico.mpr zero_lt_one) using 1,
+      { rw [add_circle.coe_period, quotient_add_group.coe_zero], },
+      { rw bernoulli_fun_endpoints_eq_of_ne_one (by linarith : k ≠ 1) } } },
+  intros y hy,
+  let B : C(𝕌, ℂ) := continuous_map.mk (coe ∘ periodized_bernoulli k)
+    (continuous_of_real.comp (periodized_bernoulli.continuous (by linarith))),
+  have step1 : ∀ (n:ℤ), fourier_coeff B n = -k! / (2 * π * I * n) ^ k,
+  { rw continuous_map.coe_mk, exact fourier_coeff_bernoulli_eq (by linarith : k ≠ 0) },
+  have step2 := has_pointwise_sum_fourier_series_of_summable ((summable_bernoulli_fourier hk).congr
+    (λ n, (step1 n).symm)) y,
+  simp_rw step1 at step2,
+  convert step2.mul_left ((-(2 * ↑π * I) ^ k) / (k! : ℂ)) using 2,
+  ext1 n,
+  rw [smul_eq_mul, ←mul_assoc, mul_div, mul_neg, div_mul_cancel, neg_neg, mul_pow _ ↑n, ←div_div,
+    div_self],
+  { rw [ne.def, pow_eq_zero_iff', not_and_distrib],
+    exact or.inl two_pi_I_ne_zero, },
+  { exact nat.cast_ne_zero.mpr (nat.factorial_ne_zero _), },
+  { rw [continuous_map.coe_mk, function.comp_app, of_real_inj,
+      periodized_bernoulli, add_circle.lift_Ico_coe_apply (by rwa zero_add)] },
+end
+
+end bernoulli_periodized
+
+section cleanup
+/- This section is just reformulating the results in a nicer form. -/
+
+lemma has_sum_one_div_nat_pow_mul_fourier {k : ℕ} (hk : 2 ≤ k) {x : ℝ} (hx : x ∈ Icc (0:ℝ) 1) :
+  has_sum (λ n:ℕ, 1 / (n:ℂ) ^ k * (fourier n (x : 𝕌) + (-1) ^ k * fourier (-n) (x : 𝕌)))
+  (-(2 * π * I) ^ k / k! * bernoulli_fun k x) :=
+begin
+  convert (has_sum_one_div_pow_mul_fourier_mul_bernoulli_fun hk hx).sum_nat_of_sum_int,
+  { ext1 n,
+    rw [int.cast_neg, mul_add, ←mul_assoc],
+    conv_rhs { rw [neg_eq_neg_one_mul, mul_pow, ←div_div] },
+    congr' 2,
+    rw [div_mul_eq_mul_div₀, one_mul],
+    congr' 1,
+    rw [eq_div_iff, ←mul_pow, ←neg_eq_neg_one_mul, neg_neg, one_pow],
+    apply pow_ne_zero, rw neg_ne_zero, exact one_ne_zero, },
+  { rw [int.cast_zero, zero_pow (by linarith : 0 < k), div_zero, zero_mul, add_zero] },
+end
+
+lemma has_sum_one_div_nat_pow_mul_cos {k : ℕ} (hk : k ≠ 0) {x : ℝ} (hx : x ∈ Icc (0:ℝ) 1) :
+  has_sum (λ n:ℕ, 1 / (n:ℝ) ^ (2 * k) * real.cos (2 * π * n * x))
+  ((-1) ^ (k + 1) * (2 * π) ^ (2 * k) / 2 / (2 * k)! *
+  (polynomial.map (algebra_map ℚ ℝ) (polynomial.bernoulli (2 * k))).eval x) :=
+begin
+  have : has_sum (λ n:ℕ, 1 / (n:ℂ) ^ (2 * k) * (fourier n (x : 𝕌) + fourier (-n) (x : 𝕌)))
+  ((-1) ^ (k + 1) * (2 * π) ^ (2 * k) / (2 * k)! * bernoulli_fun (2 * k) x),
+  { convert (has_sum_one_div_nat_pow_mul_fourier
+      (by linarith [nat.one_le_iff_ne_zero.mpr hk] : 2 ≤ 2 * k) hx),
+    { ext1 n,
+      rw [pow_mul (-1 : ℂ),neg_one_sq, one_pow, one_mul], },
+    { rw [pow_add, pow_one],
+      conv_rhs { rw [mul_pow], congr, congr, skip, rw [pow_mul, I_sq] },
+      ring, } },
+  convert ((has_sum_iff _ _).mp (this.div_const 2)).1,
+  { ext1 n,
+    convert (of_real_re _).symm,
+    rw of_real_mul,rw ←mul_div, congr,
+    { rw [of_real_div, of_real_one, of_real_pow], refl, },
+    { rw [of_real_cos, of_real_mul, fourier_coe_apply, fourier_coe_apply, cos, of_real_one, div_one,
+        div_one, of_real_mul, of_real_mul, of_real_bit0, of_real_one, int.cast_neg,
+        int.cast_coe_nat, of_real_nat_cast],
+      congr' 3,
+      { ring }, { ring }, }, },
+  { convert (of_real_re _).symm,
+    rw [of_real_mul, of_real_div, of_real_div, of_real_mul, of_real_pow, of_real_pow, of_real_neg,
+      of_real_nat_cast, of_real_mul, of_real_bit0, of_real_one],
+    ring },
+end
+
+lemma has_sum_one_div_nat_pow_mul_sin {k : ℕ} (hk : k ≠ 0) {x : ℝ} (hx : x ∈ Icc (0:ℝ) 1) :
+  has_sum (λ n:ℕ, 1 / (n:ℝ) ^ (2 * k + 1) * real.sin (2 * π * n * x))
+  ((-1) ^ (k + 1) * (2 * π) ^ (2 * k + 1) / 2 / (2 * k + 1)! *
+  (polynomial.map (algebra_map ℚ ℝ) (polynomial.bernoulli (2 * k + 1))).eval x) :=
+begin
+  have : has_sum (λ n:ℕ, 1 / (n:ℂ) ^ (2 * k + 1) * (fourier n (x : 𝕌) - fourier (-n) (x : 𝕌)))
+  ((-1)^(k + 1) * I * (2 * π)^(2 * k + 1) / (2 * k + 1)! * bernoulli_fun (2 * k + 1) x),
+  { convert (has_sum_one_div_nat_pow_mul_fourier
+    (by linarith [nat.one_le_iff_ne_zero.mpr hk] : 2 ≤ 2 * k + 1) hx),
+    { ext1 n,
+      rw [pow_add (-1: ℂ), pow_mul (-1 : ℂ), neg_one_sq, one_pow, one_mul, pow_one,
+        ←neg_eq_neg_one_mul, ←sub_eq_add_neg], },
+    { rw [pow_add, pow_one],
+      conv_rhs { rw [mul_pow], congr, congr, skip, rw [pow_add, pow_one, pow_mul, I_sq] },
+      ring, }, },
+  convert ((has_sum_iff _ _).mp (this.div_const (2 * I))).1,
+  { ext1 n,
+    convert (of_real_re _).symm,
+    rw of_real_mul,rw ←mul_div, congr,
+    { rw [of_real_div, of_real_one, of_real_pow], refl, },
+    { rw [of_real_sin, of_real_mul, fourier_coe_apply, fourier_coe_apply, sin, of_real_one, div_one,
+        div_one, of_real_mul, of_real_mul, of_real_bit0, of_real_one, int.cast_neg,
+        int.cast_coe_nat, of_real_nat_cast, ←div_div, div_I, div_mul_eq_mul_div₀, ←neg_div,
+        ←neg_mul, neg_sub],
+      congr' 4,
+      { ring, }, { ring }, }, },
+  { convert (of_real_re _).symm,
+    rw [of_real_mul, of_real_div, of_real_div, of_real_mul, of_real_pow, of_real_pow, of_real_neg,
+      of_real_nat_cast, of_real_mul, of_real_bit0, of_real_one,
+      ←div_div, div_I, div_mul_eq_mul_div₀],
+    have : ∀ (α β γ δ : ℂ), α * I * β / γ * δ * I = I ^ 2 * α * β / γ * δ := by { intros, ring },
+    rw [this, I_sq],
+    ring, },
+end
+
+lemma has_sum_zeta_nat {k : ℕ} (hk : k ≠ 0) : has_sum (λ n:ℕ, 1 / (n:ℝ) ^ (2 * k))
+  ((-1) ^ (k + 1) * 2 ^ (2 * k - 1) * π ^ (2 * k) * bernoulli (2 * k) / (2 * k)!) :=
+begin
+  convert has_sum_one_div_nat_pow_mul_cos hk (left_mem_Icc.mpr zero_le_one),
+  { ext1 n, rw [mul_zero, real.cos_zero, mul_one], },
+  rw [polynomial.eval_zero_map, polynomial.bernoulli_eval_zero, eq_rat_cast],
+  have : (2:ℝ) ^ (2 * k - 1) = (2:ℝ) ^ (2 * k) / 2,
+  { rw eq_div_iff (two_ne_zero' ℝ),
+    conv_lhs { congr, skip, rw ←pow_one (2:ℝ) },
+    rw [←pow_add, nat.sub_add_cancel],
+    linarith [nat.one_le_iff_ne_zero.mpr hk], },
+  rw [this, mul_pow],
+  ring,
+end
+
+end cleanup
+
+section examples
+
+lemma has_sum_zeta_two : has_sum (λ n:ℕ, 1 / (n : ℝ) ^ 2) (π ^ 2 / 6) :=
+begin
+  convert has_sum_zeta_nat one_ne_zero using 1, rw mul_one,
+  rw [bernoulli_eq_bernoulli'_of_ne_one (by dec_trivial : 2 ≠ 1), bernoulli'_two],
+  norm_num, field_simp, ring,
+end
+
+lemma has_sum_zeta_four : has_sum (λ n:ℕ, 1 / (n : ℝ) ^ 4) (π ^ 4 / 90) :=
+begin
+  convert has_sum_zeta_nat two_ne_zero using 1, norm_num,
+  rw [bernoulli_eq_bernoulli'_of_ne_one, bernoulli'_four],
+  norm_num, field_simp, ring, dec_trivial,
+end
+
+lemma polynomial.bernoulli_three_eval_one_quarter :
+  (polynomial.bernoulli 3).eval (1 / 4) = 3 / 64 :=
+begin
+  simp_rw [polynomial.bernoulli, finset.sum_range_succ, polynomial.eval_add,
+    polynomial.eval_monomial],
+  rw [finset.sum_range_zero, polynomial.eval_zero, zero_add, bernoulli_one],
+  rw [bernoulli_eq_bernoulli'_of_ne_one zero_ne_one, bernoulli'_zero,
+      bernoulli_eq_bernoulli'_of_ne_one (by dec_trivial : 2 ≠ 1), bernoulli'_two,
+      bernoulli_eq_bernoulli'_of_ne_one (by dec_trivial : 3 ≠ 1), bernoulli'_three],
+  norm_num,
+end
+
+/-- Explicit formula for `L(χ, 3)`, where `χ` is the unique nontrivial Dirichlet character modulo 4.
+-/
+lemma has_sum_L_function_mod_four_eval_three :
+  has_sum (λ n:ℕ, (1 / (n:ℝ) ^ 3 * real.sin (π * n / 2))) (π ^ 3 / 32) :=
+begin
+  convert has_sum_one_div_nat_pow_mul_sin one_ne_zero (_ : 1 / 4 ∈ Icc (0:ℝ) 1),
+  { ext1 n,
+    norm_num,
+    left,
+    congr' 1,
+    ring, },
+  { have : (1 / 4 : ℝ) = (algebra_map ℚ ℝ) (1 / 4 : ℚ), by norm_num,
+    rw [this, mul_pow, polynomial.eval_map, polynomial.eval₂_at_apply,
+      (by dec_trivial : 2 * 1 + 1 = 3), polynomial.bernoulli_three_eval_one_quarter],
+    norm_num, field_simp, ring },
+  { rw mem_Icc, split, linarith, linarith, },
+end
+
+end examples
diff --git a/src/number_theory/zsqrtd/basic.lean b/src/number_theory/zsqrtd/basic.lean
index 4406377bee55b..339fa34f9b9fe 100644
--- a/src/number_theory/zsqrtd/basic.lean
+++ b/src/number_theory/zsqrtd/basic.lean
@@ -6,9 +6,13 @@ Authors: Mario Carneiro
 import algebra.associated
 import ring_theory.int.basic
 import tactic.ring
+import algebra.star.unitary
 
 /-! # ℤ[√d]
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The ring of integers adjoined with a square root of `d : ℤ`.
 
 After defining the norm, we show that it is a linearly ordered commutative ring,
@@ -83,20 +87,32 @@ instance : has_mul ℤ√d := ⟨λ z w, ⟨z.1 * w.1 + d * z.2 * w.2, z.1 * w.2
 @[simp] lemma mul_re (z w : ℤ√d) : (z * w).re = z.re * w.re + d * z.im * w.im := rfl
 @[simp] lemma mul_im (z w : ℤ√d) : (z * w).im = z.re * w.im + z.im * w.re := rfl
 
-instance : comm_ring ℤ√d :=
+instance : add_comm_group ℤ√d :=
 by refine_struct
 { add            := (+),
   zero           := (0 : ℤ√d),
+  sub            := λ a b, a + -b,
   neg            := has_neg.neg,
+  zsmul          := @zsmul_rec (ℤ√d) ⟨0⟩ ⟨(+)⟩ ⟨has_neg.neg⟩,
+  nsmul          := @nsmul_rec (ℤ√d) ⟨0⟩ ⟨(+)⟩ };
+intros; try { refl }; simp [ext, add_comm, add_left_comm]
+
+instance : add_group_with_one ℤ√d :=
+{ nat_cast := λ n, of_int n,
+  int_cast := of_int,
+  one := 1,
+  .. zsqrtd.add_comm_group }
+
+instance : comm_ring ℤ√d :=
+by refine_struct
+{ add            := (+),
+  zero           := (0 : ℤ√d),
   mul            := (*),
-  sub            := λ a b, a + -b,
   one            := 1,
   npow           := @npow_rec (ℤ√d) ⟨1⟩ ⟨(*)⟩,
-  nsmul          := @nsmul_rec (ℤ√d) ⟨0⟩ ⟨(+)⟩,
-  zsmul          := @zsmul_rec (ℤ√d) ⟨0⟩ ⟨(+)⟩ ⟨has_neg.neg⟩ };
+  .. zsqrtd.add_group_with_one };
 intros; try { refl }; simp [ext, add_mul, mul_add, add_comm, add_left_comm, mul_comm, mul_left_comm]
 
-instance : add_comm_monoid ℤ√d    := by apply_instance
 instance : add_monoid ℤ√d         := by apply_instance
 instance : monoid ℤ√d             := by apply_instance
 instance : comm_monoid ℤ√d        := by apply_instance
@@ -110,48 +126,28 @@ instance : ring ℤ√d               := by apply_instance
 instance : distrib ℤ√d            := by apply_instance
 
 /-- Conjugation in `ℤ√d`. The conjugate of `a + b √d` is `a - b √d`. -/
-def conj (z : ℤ√d) : ℤ√d := ⟨z.1, -z.2⟩
-@[simp] lemma conj_re (z : ℤ√d) : (conj z).re = z.re := rfl
-@[simp] lemma conj_im (z : ℤ√d) : (conj z).im = -z.im := rfl
-
-/-- `conj` as an `add_monoid_hom`. -/
-def conj_hom : ℤ√d →+ ℤ√d :=
-{ to_fun := conj,
-  map_add' := λ ⟨a, ai⟩ ⟨b, bi⟩, ext.mpr ⟨rfl, neg_add _ _⟩,
-  map_zero' := ext.mpr ⟨rfl, neg_zero⟩ }
-
-@[simp] lemma conj_zero : conj (0 : ℤ√d) = 0 :=
-conj_hom.map_zero
+instance : has_star ℤ√d :=
+{ star := λ z, ⟨z.1, -z.2⟩ }
+@[simp] lemma star_mk (x y : ℤ) : star (⟨x, y⟩ : ℤ√d) = ⟨x, -y⟩ := rfl
+@[simp] lemma star_re (z : ℤ√d) : (star z).re = z.re := rfl
+@[simp] lemma star_im (z : ℤ√d) : (star z).im = -z.im := rfl
 
-@[simp] lemma conj_one : conj (1 : ℤ√d) = 1 :=
-by simp only [zsqrtd.ext, zsqrtd.conj_re, zsqrtd.conj_im, zsqrtd.one_im, neg_zero, eq_self_iff_true,
-  and_self]
-
-@[simp] lemma conj_neg (x : ℤ√d) : (-x).conj = -x.conj := rfl
-
-@[simp] lemma conj_add (x y : ℤ√d) : (x + y).conj = x.conj + y.conj :=
-conj_hom.map_add x y
-
-@[simp] lemma conj_sub (x y : ℤ√d) : (x - y).conj = x.conj - y.conj :=
-conj_hom.map_sub x y
-
-@[simp] lemma conj_conj {d : ℤ} (x : ℤ√d) : x.conj.conj = x :=
-by simp only [ext, true_and, conj_re, eq_self_iff_true, neg_neg, conj_im]
+instance : star_ring ℤ√d :=
+{ star_involutive := λ x, ext.mpr ⟨rfl, neg_neg _⟩,
+  star_mul := λ a b, ext.mpr ⟨by simp; ring, by simp; ring⟩,
+  star_add := λ a b, ext.mpr ⟨rfl, neg_add _ _⟩ }
 
 instance : nontrivial ℤ√d :=
 ⟨⟨0, 1, dec_trivial⟩⟩
 
-@[simp] theorem coe_nat_re (n : ℕ) : (n : ℤ√d).re = n :=
-by induction n; simp *
-@[simp] theorem coe_nat_im (n : ℕ) : (n : ℤ√d).im = 0 :=
-by induction n; simp *
-theorem coe_nat_val (n : ℕ) : (n : ℤ√d) = ⟨n, 0⟩ :=
-by simp [ext]
+@[simp] theorem coe_nat_re (n : ℕ) : (n : ℤ√d).re = n := rfl
+@[simp] theorem coe_nat_im (n : ℕ) : (n : ℤ√d).im = 0 := rfl
+theorem coe_nat_val (n : ℕ) : (n : ℤ√d) = ⟨n, 0⟩ := rfl
 
 @[simp] theorem coe_int_re (n : ℤ) : (n : ℤ√d).re = n :=
-by cases n; simp [*, int.of_nat_eq_coe, int.neg_succ_of_nat_eq]
+by cases n; refl
 @[simp] theorem coe_int_im (n : ℤ) : (n : ℤ√d).im = 0 :=
-by cases n; simp *
+by cases n; refl
 theorem coe_int_val (n : ℤ) : (n : ℤ√d) = ⟨n, 0⟩ :=
 by simp [ext]
 
@@ -179,12 +175,9 @@ by simp [ext]
 theorem decompose {x y : ℤ} : (⟨x, y⟩ : ℤ√d) = x + sqrtd * y :=
 by simp [ext]
 
-theorem mul_conj {x y : ℤ} : (⟨x, y⟩ * conj ⟨x, y⟩ : ℤ√d) = x * x - d * y * y :=
+theorem mul_star {x y : ℤ} : (⟨x, y⟩ * star ⟨x, y⟩ : ℤ√d) = x * x - d * y * y :=
 by simp [ext, sub_eq_add_neg, mul_comm]
 
-theorem conj_mul {a b : ℤ√d} : conj (a * b) = conj a * conj b :=
-by { simp [ext], ring }
-
 protected lemma coe_int_add (m n : ℤ) : (↑(m + n) : ℤ√d) = ↑m + ↑n :=
 (int.cast_ring_hom _).map_add _ _
 protected lemma coe_int_sub (m n : ℤ) : (↑(m - n) : ℤ√d) = ↑m - ↑n :=
@@ -222,8 +215,7 @@ protected lemma eq_of_smul_eq_smul_left {a : ℤ} {b c : ℤ√d}
 begin
   rw ext at h ⊢,
   apply and.imp _ _ h;
-  { simp only [smul_re, smul_im],
-    exact int.eq_of_mul_eq_mul_left ha },
+  { simpa only [smul_re, smul_im] using mul_left_cancel₀ ha },
 end
 
 section gcd
@@ -368,15 +360,15 @@ def norm_monoid_hom : ℤ√d →* ℤ :=
   map_mul' := norm_mul,
   map_one' := norm_one }
 
-lemma norm_eq_mul_conj (n : ℤ√d) : (norm n : ℤ√d) = n * n.conj :=
-by cases n; simp [norm, conj, zsqrtd.ext, mul_comm, sub_eq_add_neg]
+lemma norm_eq_mul_conj (n : ℤ√d) : (norm n : ℤ√d) = n * star n :=
+by cases n; simp [norm, star, zsqrtd.ext, mul_comm, sub_eq_add_neg]
 
 @[simp] lemma norm_neg (x : ℤ√d) : (-x).norm = x.norm :=
-coe_int_inj $ by simp only [norm_eq_mul_conj, conj_neg, neg_mul,
+coe_int_inj $ by simp only [norm_eq_mul_conj, star_neg, neg_mul,
   mul_neg, neg_neg]
 
-@[simp] lemma norm_conj (x : ℤ√d) : x.conj.norm = x.norm :=
-coe_int_inj $ by simp only [norm_eq_mul_conj, conj_conj, mul_comm]
+@[simp] lemma norm_conj (x : ℤ√d) : (star x).norm = x.norm :=
+coe_int_inj $ by simp only [norm_eq_mul_conj, star_star, mul_comm]
 
 lemma norm_nonneg (hd : d ≤ 0) (n : ℤ√d) : 0 ≤ n.norm :=
 add_nonneg (mul_self_nonneg _)
@@ -386,17 +378,17 @@ add_nonneg (mul_self_nonneg _)
 lemma norm_eq_one_iff {x : ℤ√d} : x.norm.nat_abs = 1 ↔ is_unit x :=
 ⟨λ h, is_unit_iff_dvd_one.2 $
   (le_total 0 (norm x)).cases_on
-    (λ hx, show x ∣ 1, from ⟨x.conj,
+    (λ hx, show x ∣ 1, from ⟨star x,
       by rwa [← int.coe_nat_inj', int.nat_abs_of_nonneg hx,
         ← @int.cast_inj (ℤ√d) _ _, norm_eq_mul_conj, eq_comm] at h⟩)
-    (λ hx, show x ∣ 1, from ⟨- x.conj,
+    (λ hx, show x ∣ 1, from ⟨- star x,
       by rwa [← int.coe_nat_inj', int.of_nat_nat_abs_of_nonpos hx,
         ← @int.cast_inj (ℤ√d) _ _, int.cast_neg, norm_eq_mul_conj, neg_mul_eq_mul_neg,
         eq_comm] at h⟩),
 λ h, let ⟨y, hy⟩ := is_unit_iff_dvd_one.1 h in begin
   have := congr_arg (int.nat_abs ∘ norm) hy,
   rw [function.comp_app, function.comp_app, norm_mul, int.nat_abs_mul,
-    norm_one, int.nat_abs_one, eq_comm, nat.mul_eq_one_iff] at this,
+    norm_one, int.nat_abs_one, eq_comm, mul_eq_one] at this,
   exact this.1
 end⟩
 
@@ -537,7 +529,6 @@ let ⟨x, y, (h : a ≤ ⟨x, y⟩)⟩ := show ∃x y : ℕ, nonneg (⟨x, y⟩
 | ⟨-[1+ x],      -[1+ y]⟩      := ⟨x+1, y+1, by simp [int.neg_succ_of_nat_coe, add_assoc]⟩
 end in begin
   refine ⟨x + d*y, h.trans _⟩,
-  rw [← int.cast_coe_nat, ← of_int_eq_coe],
   change nonneg ⟨(↑x + d*y) - ↑x, 0-↑y⟩,
   cases y with y,
   { simp },
@@ -558,7 +549,8 @@ protected theorem add_lt_add_left (a b : ℤ√d) (h : a < b) (c) : c + a < c +
 λ h', h (zsqrtd.le_of_add_le_add_left _ _ _ h')
 
 theorem nonneg_smul {a : ℤ√d} {n : ℕ} (ha : nonneg a) : nonneg (n * a) :=
-by rw ← int.cast_coe_nat; exact match a, nonneg_cases ha, ha with
+by simp only [← int.cast_coe_nat] {single_pass := tt}; exact
+match a, nonneg_cases ha, ha with
 | ._, ⟨x, y, or.inl rfl⟩,          ha := by rw smul_val; trivial
 | ._, ⟨x, y, or.inr $ or.inl rfl⟩, ha := by rw smul_val; simpa using
   nonnegg_pos_neg.2 (sq_le_smul n $ nonnegg_pos_neg.1 ha)
@@ -632,7 +624,7 @@ let g := x.gcd y in or.elim g.eq_zero_or_pos
     let ⟨m, n, co, (hx : x = m * g), (hy : y = n * g)⟩ := nat.exists_coprime gpos in
     begin
       rw [hx, hy] at h,
-      have : m * m = d * (n * n) := nat.eq_of_mul_eq_mul_left (mul_pos gpos gpos)
+      have : m * m = d * (n * n) := mul_left_cancel₀ (mul_pos gpos gpos).ne'
         (by simpa [mul_comm, mul_left_comm] using h),
       have co2 := let co1 := co.mul_right co in co1.mul co1,
       exact nonsquare.ns d m (nat.dvd_antisymm (by rw this; apply dvd_mul_right) $
@@ -672,8 +664,8 @@ instance : linear_order ℤ√d :=
 
 protected theorem eq_zero_or_eq_zero_of_mul_eq_zero : Π {a b : ℤ√d}, a * b = 0 → a = 0 ∨ b = 0
 | ⟨x, y⟩ ⟨z, w⟩ h := by injection h with h1 h2; exact
-  have h1 : x*z = -(d*y*w), from eq_neg_of_add_eq_zero h1,
-  have h2 : x*w = -(y*z), from eq_neg_of_add_eq_zero h2,
+  have h1 : x*z = -(d*y*w), from eq_neg_of_add_eq_zero_left h1,
+  have h2 : x*w = -(y*z), from eq_neg_of_add_eq_zero_left h2,
   have fin : x*x = d*y*y → (⟨x, y⟩:ℤ√d) = 0, from
   λe, match x, y, divides_sq_eq_zero_z e with ._, ._, ⟨rfl, rfl⟩ := rfl end,
   if z0 : z = 0 then if w0 : w = 0 then
@@ -687,9 +679,11 @@ protected theorem eq_zero_or_eq_zero_of_mul_eq_zero : Π {a b : ℤ√d}, a * b
        x * x * z = d * -y * (x * w) : by simp [h1, mul_assoc, mul_left_comm]
              ... = d * y * y * z : by simp [h2, mul_assoc, mul_left_comm]
 
+instance : no_zero_divisors ℤ√d :=
+{ eq_zero_or_eq_zero_of_mul_eq_zero := @zsqrtd.eq_zero_or_eq_zero_of_mul_eq_zero }
+
 instance : is_domain ℤ√d :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := @zsqrtd.eq_zero_or_eq_zero_of_mul_eq_zero,
-  .. zsqrtd.comm_ring, .. zsqrtd.nontrivial }
+by exact no_zero_divisors.to_is_domain _
 
 protected theorem mul_pos (a b : ℤ√d) (a0 : 0 < a) (b0 : 0 < b) : 0 < a * b := λab,
 or.elim (eq_zero_or_eq_zero_of_mul_eq_zero
@@ -752,7 +746,7 @@ def lift {d : ℤ} : {r : R // r * r = ↑d} ≃ (ℤ√d →+* R) :=
               a.re * b.re + (a.re * b.im + a.im * b.re) * r + a.im * b.im * (r * r) := by ring,
       simp [this, r.prop],
       ring, } },
-  inv_fun := λ f, ⟨f sqrtd, by rw [←f.map_mul, dmuld, ring_hom.map_int_cast]⟩,
+  inv_fun := λ f, ⟨f sqrtd, by rw [←f.map_mul, dmuld, map_int_cast]⟩,
   left_inv := λ r, by { ext, simp },
   right_inv := λ f, by { ext, simp } }
 
@@ -769,4 +763,16 @@ begin
   rw [norm_eq_mul_conj, ring_hom.map_mul, ha, zero_mul]
 end
 
+/-- An element of `ℤ√d` has norm equal to `1` if and only if it is contained in the submonoid
+of unitary elements. -/
+lemma norm_eq_one_iff_mem_unitary {d : ℤ} {a : ℤ√d} : a.norm = 1 ↔ a ∈ unitary ℤ√d :=
+begin
+  rw [unitary.mem_iff_self_mul_star, ← norm_eq_mul_conj],
+  norm_cast,
+end
+
+/-- The kernel of the norm map on `ℤ√d` equals the submonoid of unitary elements. -/
+lemma mker_norm_eq_unitary {d : ℤ} : (@norm_monoid_hom d).mker = unitary ℤ√d :=
+submonoid.ext (λ x, norm_eq_one_iff_mem_unitary)
+
 end zsqrtd
diff --git a/src/number_theory/zsqrtd/gaussian_int.lean b/src/number_theory/zsqrtd/gaussian_int.lean
index 6f8d254623e9f..dc145904b9aaa 100644
--- a/src/number_theory/zsqrtd/gaussian_int.lean
+++ b/src/number_theory/zsqrtd/gaussian_int.lean
@@ -6,10 +6,14 @@ Authors: Chris Hughes
 import number_theory.zsqrtd.basic
 import data.complex.basic
 import ring_theory.principal_ideal_domain
-import number_theory.legendre_symbol.quadratic_reciprocity
+
+
 /-!
 # Gaussian integers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Gaussian integers are complex integer, complex numbers whose real and imaginary parts are both
 integers.
 
@@ -19,10 +23,11 @@ The Euclidean domain structure on `ℤ[i]` is defined in this file.
 
 The homomorphism `to_complex` into the complex numbers is also defined in this file.
 
-## Main statements
+## See also
 
-`prime_iff_mod_four_eq_three_of_nat_prime`
-A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`
+See `number_theory.zsqrtd.gaussian_int` for:
+* `prime_iff_mod_four_eq_three_of_nat_prime`:
+  A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`
 
 ## Notations
 
@@ -36,6 +41,7 @@ and definitions about `zsqrtd` can easily be used.
 -/
 
 open zsqrtd complex
+open_locale complex_conjugate
 
 /-- The Gaussian integers, defined as `ℤ√(-1)`. -/
 @[reducible] def gaussian_int : Type := zsqrtd (-1)
@@ -75,6 +81,11 @@ by apply complex.ext; simp [to_complex_def]
 @[simp] lemma to_complex_zero : ((0 : ℤ[i]) : ℂ) = 0 := to_complex.map_zero
 @[simp] lemma to_complex_neg (x : ℤ[i]) : ((-x : ℤ[i]) : ℂ) = -x := to_complex.map_neg _
 @[simp] lemma to_complex_sub (x y : ℤ[i]) : ((x - y : ℤ[i]) : ℂ) = x - y := to_complex.map_sub _ _
+@[simp] lemma to_complex_star (x : ℤ[i]) : ((star x : ℤ[i]) : ℂ) = conj (x : ℂ) :=
+begin
+  rw [to_complex_def₂, to_complex_def₂],
+  exact congr_arg2 _ rfl (int.cast_neg _),
+end
 
 @[simp] lemma to_complex_inj {x y : ℤ[i]} : (x : ℂ) = y ↔ x = y :=
 by cases x; cases y; simp [to_complex_def₂]
@@ -83,10 +94,10 @@ by cases x; cases y; simp [to_complex_def₂]
 by rw [← to_complex_zero, to_complex_inj]
 
 @[simp] lemma nat_cast_real_norm (x : ℤ[i]) : (x.norm : ℝ) = (x : ℂ).norm_sq :=
-by rw [norm, norm_sq]; simp
+by rw [zsqrtd.norm, norm_sq]; simp
 
 @[simp] lemma nat_cast_complex_norm (x : ℤ[i]) : (x.norm : ℂ) = (x : ℂ).norm_sq :=
-by cases x; rw [norm, norm_sq]; simp
+by cases x; rw [zsqrtd.norm, norm_sq]; simp
 
 lemma norm_nonneg (x : ℤ[i]) : 0 ≤ norm x := norm_nonneg (by norm_num) _
 
@@ -96,24 +107,24 @@ by rw [← @int.cast_inj ℝ _ _ _]; simp
 lemma norm_pos {x : ℤ[i]} : 0 < norm x ↔ x ≠ 0 :=
 by rw [lt_iff_le_and_ne, ne.def, eq_comm, norm_eq_zero]; simp [norm_nonneg]
 
-@[simp] lemma coe_nat_abs_norm (x : ℤ[i]) : (x.norm.nat_abs : ℤ) = x.norm :=
+lemma abs_coe_nat_norm (x : ℤ[i]) : (x.norm.nat_abs : ℤ) = x.norm :=
 int.nat_abs_of_nonneg (norm_nonneg _)
 
 @[simp] lemma nat_cast_nat_abs_norm {α : Type*} [ring α]
   (x : ℤ[i]) : (x.norm.nat_abs : α) = x.norm :=
-by rw [← int.cast_coe_nat, coe_nat_abs_norm]
+by rw [← int.cast_coe_nat, abs_coe_nat_norm]
 
 lemma nat_abs_norm_eq (x : ℤ[i]) : x.norm.nat_abs =
   x.re.nat_abs * x.re.nat_abs + x.im.nat_abs * x.im.nat_abs :=
-int.coe_nat_inj $ begin simp, simp [norm] end
+int.coe_nat_inj $ begin simp, simp [zsqrtd.norm] end
 
 instance : has_div ℤ[i] :=
-⟨λ x y, let n := (rat.of_int (norm y))⁻¹, c := y.conj in
-  ⟨round (rat.of_int (x * c).re * n : ℚ), round (rat.of_int (x * c).im * n : ℚ)⟩⟩
+⟨λ x y, let n := (norm y : ℚ)⁻¹, c := star y in
+  ⟨round ((x * c).re * n : ℚ), round ((x * c).im * n : ℚ)⟩⟩
 
-lemma div_def (x y : ℤ[i]) : x / y = ⟨round ((x * conj y).re / norm y : ℚ),
-  round ((x * conj y).im / norm y : ℚ)⟩ :=
-show zsqrtd.mk _ _ = _, by simp [rat.of_int_eq_mk, rat.mk_eq_div, div_eq_mul_inv]
+lemma div_def (x y : ℤ[i]) : x / y = ⟨round ((x * star y).re / norm y : ℚ),
+  round ((x * star y).im / norm y : ℚ)⟩ :=
+show zsqrtd.mk _ _ = _, by simp [div_eq_mul_inv]
 
 lemma to_complex_div_re (x y : ℤ[i]) : ((x / y : ℤ[i]) : ℂ).re = round ((x / y : ℂ).re) :=
 by rw [div_def, ← @rat.round_cast ℝ _ _];
@@ -154,12 +165,12 @@ lemma mod_def (x y : ℤ[i]) : x % y = x - y * (x / y) := rfl
 lemma norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) : (x % y).norm < y.norm :=
 have (y : ℂ) ≠ 0, by rwa [ne.def, ← to_complex_zero, to_complex_inj],
 (@int.cast_lt ℝ _ _ _ _).1 $
-  calc ↑(norm (x % y)) = (x - y * (x / y : ℤ[i]) : ℂ).norm_sq : by simp [mod_def]
+  calc ↑(zsqrtd.norm (x % y)) = (x - y * (x / y : ℤ[i]) : ℂ).norm_sq : by simp [mod_def]
   ... = (y : ℂ).norm_sq * (((x / y) - (x / y : ℤ[i])) : ℂ).norm_sq :
     by rw [← norm_sq_mul, mul_sub, mul_div_cancel' _ this]
   ... < (y : ℂ).norm_sq * 1 : mul_lt_mul_of_pos_left (norm_sq_div_sub_div_lt_one _ _)
     (norm_sq_pos.2 this)
-  ... = norm y : by simp
+  ... = zsqrtd.norm y : by simp
 
 lemma nat_abs_norm_mod_lt (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
   (x % y).norm.nat_abs < y.norm.nat_abs :=
@@ -167,9 +178,9 @@ int.coe_nat_lt.1 (by simp [-int.coe_nat_lt, norm_mod_lt x hy])
 
 lemma norm_le_norm_mul_left (x : ℤ[i]) {y : ℤ[i]} (hy : y ≠ 0) :
   (norm x).nat_abs ≤ (norm (x * y)).nat_abs :=
-by rw [norm_mul, int.nat_abs_mul];
+by rw [zsqrtd.norm_mul, int.nat_abs_mul];
   exact le_mul_of_one_le_right (nat.zero_le _)
-    (int.coe_nat_le.1 (by rw [coe_nat_abs_norm]; exact int.add_one_le_of_lt (norm_pos.2 hy)))
+    (int.coe_nat_le.1 (by rw [abs_coe_nat_norm]; exact int.add_one_le_of_lt (norm_pos.2 hy)))
 
 instance : nontrivial ℤ[i] :=
 ⟨⟨0, 1, dec_trivial⟩⟩
@@ -188,66 +199,10 @@ instance : euclidean_domain ℤ[i] :=
 
 open principal_ideal_ring
 
-lemma mod_four_eq_three_of_nat_prime_of_prime (p : ℕ) [hp : fact p.prime] (hpi : prime (p : ℤ[i])) :
-  p % 4 = 3 :=
-hp.1.eq_two_or_odd.elim
-  (λ hp2, absurd hpi (mt irreducible_iff_prime.2 $
-    λ ⟨hu, h⟩, begin
-      have := h ⟨1, 1⟩ ⟨1, -1⟩ (hp2.symm ▸ rfl),
-      rw [← norm_eq_one_iff, ← norm_eq_one_iff] at this,
-      exact absurd this dec_trivial
-    end))
-  (λ hp1, by_contradiction $ λ hp3 : p % 4 ≠ 3,
-    have hp41 : p % 4 = 1,
-      begin
-        rw [← nat.mod_mul_left_mod p 2 2, show 2 * 2 = 4, from rfl] at hp1,
-        have := nat.mod_lt p (show 0 < 4, from dec_trivial),
-        revert this hp3 hp1,
-        generalize : p % 4 = m, dec_trivial!,
-      end,
-    let ⟨k, hk⟩ := (zmod.exists_sq_eq_neg_one_iff p).2 $
-      by rw hp41; exact dec_trivial in
-    begin
-      obtain ⟨k, k_lt_p, rfl⟩ : ∃ (k' : ℕ) (h : k' < p), (k' : zmod p) = k,
-      { refine ⟨k.val, k.val_lt, zmod.nat_cast_zmod_val k⟩ },
-      have hpk : p ∣ k ^ 2 + 1,
-        by { rw [pow_two, ← char_p.cast_eq_zero_iff (zmod p) p, nat.cast_add, nat.cast_mul,
-                 nat.cast_one, ← hk, add_left_neg], },
-      have hkmul : (k ^ 2 + 1 : ℤ[i]) = ⟨k, 1⟩ * ⟨k, -1⟩ :=
-        by simp [sq, zsqrtd.ext],
-      have hpne1 : p ≠ 1 := ne_of_gt hp.1.one_lt,
-      have hkltp : 1 + k * k < p * p,
-        from calc 1 + k * k ≤ k + k * k :
-          add_le_add_right (nat.pos_of_ne_zero
-            (λ hk0, by clear_aux_decl; simp [*, pow_succ'] at *)) _
-        ... = k * (k + 1) : by simp [add_comm, mul_add]
-        ... < p * p : mul_lt_mul k_lt_p k_lt_p (nat.succ_pos _) (nat.zero_le _),
-      have hpk₁ : ¬ (p : ℤ[i]) ∣ ⟨k, -1⟩ :=
-        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
-          calc (norm (p * x : ℤ[i])).nat_abs = (norm ⟨k, -1⟩).nat_abs : by rw hx
-          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, norm] using hkltp
-          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
-            (λ hx0, (show (-1 : ℤ) ≠ 0, from dec_trivial) $
-              by simpa [hx0] using congr_arg zsqrtd.im hx),
-      have hpk₂ : ¬ (p : ℤ[i]) ∣ ⟨k, 1⟩ :=
-        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
-          calc (norm (p * x : ℤ[i])).nat_abs = (norm ⟨k, 1⟩).nat_abs : by rw hx
-          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, norm] using hkltp
-          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
-            (λ hx0, (show (1 : ℤ) ≠ 0, from dec_trivial) $
-                by simpa [hx0] using congr_arg zsqrtd.im hx),
-      have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2
-        (by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
-        exact λ h, (ne_of_lt hp.1.one_lt).symm h.1),
-      obtain ⟨y, hy⟩ := hpk,
-      have := hpi.2.2 ⟨k, 1⟩ ⟨k, -1⟩ ⟨y, by rw [← hkmul, ← nat.cast_mul p, ← hy]; simp⟩,
-      clear_aux_decl, tauto
-    end)
-
 lemma sq_add_sq_of_nat_prime_of_not_irreducible (p : ℕ) [hp : fact p.prime]
   (hpi : ¬irreducible (p : ℤ[i])) : ∃ a b, a^2 + b^2 = p :=
 have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2 $
-  by rw [norm_nat_cast, int.nat_abs_mul, nat.mul_eq_one_iff];
+  by rw [norm_nat_cast, int.nat_abs_mul, mul_eq_one];
     exact λ h, (ne_of_lt hp.1.one_lt).symm h.1,
 have hab : ∃ a b, (p : ℤ[i]) = a * b ∧ ¬ is_unit a ∧ ¬ is_unit b,
   by simpa [irreducible_iff, hpu, not_forall, not_or_distrib] using hpi,
@@ -259,16 +214,4 @@ have hnap : (norm a).nat_abs = p, from ((hp.1.mul_eq_prime_sq_iff
     simp).1,
 ⟨a.re.nat_abs, a.im.nat_abs, by simpa [nat_abs_norm_eq, sq] using hnap⟩
 
-lemma prime_of_nat_prime_of_mod_four_eq_three (p : ℕ) [hp : fact p.prime] (hp3 : p % 4 = 3) :
-  prime (p : ℤ[i]) :=
-irreducible_iff_prime.1 $ classical.by_contradiction $ λ hpi,
-  let ⟨a, b, hab⟩ := sq_add_sq_of_nat_prime_of_not_irreducible p hpi in
-have ∀ a b : zmod 4, a^2 + b^2 ≠ p, by erw [← zmod.nat_cast_mod p 4, hp3]; exact dec_trivial,
-this a b (hab ▸ by simp)
-
-/-- A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4` -/
-lemma prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : fact p.prime] :
-  prime (p : ℤ[i]) ↔ p % 4 = 3 :=
-⟨mod_four_eq_three_of_nat_prime_of_prime p, prime_of_nat_prime_of_mod_four_eq_three p⟩
-
 end gaussian_int
diff --git a/src/number_theory/zsqrtd/quadratic_reciprocity.lean b/src/number_theory/zsqrtd/quadratic_reciprocity.lean
new file mode 100644
index 0000000000000..bb4db5899c3c4
--- /dev/null
+++ b/src/number_theory/zsqrtd/quadratic_reciprocity.lean
@@ -0,0 +1,99 @@
+/-
+Copyright (c) 2019 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes
+-/
+import number_theory.zsqrtd.gaussian_int
+import number_theory.legendre_symbol.quadratic_reciprocity
+
+/-!
+# Facts about the gaussian integers relying on quadratic reciprocity.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main statements
+
+`prime_iff_mod_four_eq_three_of_nat_prime`
+A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4`
+
+-/
+
+open zsqrtd complex
+open_locale complex_conjugate
+
+local notation `ℤ[i]` := gaussian_int
+
+namespace gaussian_int
+
+open principal_ideal_ring
+
+lemma mod_four_eq_three_of_nat_prime_of_prime (p : ℕ) [hp : fact p.prime] (hpi : prime (p : ℤ[i])) :
+  p % 4 = 3 :=
+hp.1.eq_two_or_odd.elim
+  (λ hp2, absurd hpi (mt irreducible_iff_prime.2 $
+    λ ⟨hu, h⟩, begin
+      have := h ⟨1, 1⟩ ⟨1, -1⟩ (hp2.symm ▸ rfl),
+      rw [← norm_eq_one_iff, ← norm_eq_one_iff] at this,
+      exact absurd this dec_trivial
+    end))
+  (λ hp1, by_contradiction $ λ hp3 : p % 4 ≠ 3,
+    have hp41 : p % 4 = 1,
+      begin
+        rw [← nat.mod_mul_left_mod p 2 2, show 2 * 2 = 4, from rfl] at hp1,
+        have := nat.mod_lt p (show 0 < 4, from dec_trivial),
+        revert this hp3 hp1,
+        generalize : p % 4 = m, dec_trivial!,
+      end,
+    let ⟨k, hk⟩ := zmod.exists_sq_eq_neg_one_iff.2 $
+      by rw hp41; exact dec_trivial in
+    begin
+      obtain ⟨k, k_lt_p, rfl⟩ : ∃ (k' : ℕ) (h : k' < p), (k' : zmod p) = k,
+      { refine ⟨k.val, k.val_lt, zmod.nat_cast_zmod_val k⟩ },
+      have hpk : p ∣ k ^ 2 + 1,
+        by { rw [pow_two, ← char_p.cast_eq_zero_iff (zmod p) p, nat.cast_add, nat.cast_mul,
+                 nat.cast_one, ← hk, add_left_neg], },
+      have hkmul : (k ^ 2 + 1 : ℤ[i]) = ⟨k, 1⟩ * ⟨k, -1⟩ :=
+        by simp [sq, zsqrtd.ext],
+      have hpne1 : p ≠ 1 := ne_of_gt hp.1.one_lt,
+      have hkltp : 1 + k * k < p * p,
+        from calc 1 + k * k ≤ k + k * k :
+          add_le_add_right (nat.pos_of_ne_zero
+            (λ hk0, by clear_aux_decl; simp [*, pow_succ'] at *)) _
+        ... = k * (k + 1) : by simp [add_comm, mul_add]
+        ... < p * p : mul_lt_mul k_lt_p k_lt_p (nat.succ_pos _) (nat.zero_le _),
+      have hpk₁ : ¬ (p : ℤ[i]) ∣ ⟨k, -1⟩ :=
+        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
+          calc (norm (p * x : ℤ[i])).nat_abs = (zsqrtd.norm ⟨k, -1⟩).nat_abs : by rw hx
+          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, zsqrtd.norm] using hkltp
+          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
+            (λ hx0, (show (-1 : ℤ) ≠ 0, from dec_trivial) $
+              by simpa [hx0] using congr_arg zsqrtd.im hx),
+      have hpk₂ : ¬ (p : ℤ[i]) ∣ ⟨k, 1⟩ :=
+        λ ⟨x, hx⟩, lt_irrefl (p * x : ℤ[i]).norm.nat_abs $
+          calc (norm (p * x : ℤ[i])).nat_abs = (zsqrtd.norm ⟨k, 1⟩).nat_abs : by rw hx
+          ... < (norm (p : ℤ[i])).nat_abs : by simpa [add_comm, zsqrtd.norm] using hkltp
+          ... ≤ (norm (p * x : ℤ[i])).nat_abs : norm_le_norm_mul_left _
+            (λ hx0, (show (1 : ℤ) ≠ 0, from dec_trivial) $
+                by simpa [hx0] using congr_arg zsqrtd.im hx),
+      have hpu : ¬ is_unit (p : ℤ[i]), from mt norm_eq_one_iff.2
+        (by rw [norm_nat_cast, int.nat_abs_mul, mul_eq_one];
+        exact λ h, (ne_of_lt hp.1.one_lt).symm h.1),
+      obtain ⟨y, hy⟩ := hpk,
+      have := hpi.2.2 ⟨k, 1⟩ ⟨k, -1⟩ ⟨y, by rw [← hkmul, ← nat.cast_mul p, ← hy]; simp⟩,
+      clear_aux_decl, tauto
+    end)
+
+lemma prime_of_nat_prime_of_mod_four_eq_three (p : ℕ) [hp : fact p.prime] (hp3 : p % 4 = 3) :
+  prime (p : ℤ[i]) :=
+irreducible_iff_prime.1 $ classical.by_contradiction $ λ hpi,
+  let ⟨a, b, hab⟩ := sq_add_sq_of_nat_prime_of_not_irreducible p hpi in
+have ∀ a b : zmod 4, a^2 + b^2 ≠ p, by erw [← zmod.nat_cast_mod p 4, hp3]; exact dec_trivial,
+this a b (hab ▸ by simp)
+
+/-- A prime natural number is prime in `ℤ[i]` if and only if it is `3` mod `4` -/
+lemma prime_iff_mod_four_eq_three_of_nat_prime (p : ℕ) [hp : fact p.prime] :
+  prime (p : ℤ[i]) ↔ p % 4 = 3 :=
+⟨mod_four_eq_three_of_nat_prime_of_prime p, prime_of_nat_prime_of_mod_four_eq_three p⟩
+
+end gaussian_int
diff --git a/src/number_theory/zsqrtd/to_real.lean b/src/number_theory/zsqrtd/to_real.lean
index aeb45b6ec98a8..8277868f99867 100644
--- a/src/number_theory/zsqrtd/to_real.lean
+++ b/src/number_theory/zsqrtd/to_real.lean
@@ -9,6 +9,9 @@ import number_theory.zsqrtd.basic
 /-!
 # Image of `zsqrtd` in `ℝ`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `zsqrtd.to_real` and related lemmas.
 It is in a separate file to avoid pulling in all of `data.real` into `data.zsqrtd`.
 -/
diff --git a/src/order/antichain.lean b/src/order/antichain.lean
index 38add3e010816..0e62ef2616deb 100644
--- a/src/order/antichain.lean
+++ b/src/order/antichain.lean
@@ -3,11 +3,17 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import data.set.pairwise
+import data.set.pairwise.basic
+import order.bounds.basic
+import order.directed
+import order.hom.set
 
 /-!
 # Antichains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines antichains. An antichain is a set where any two distinct elements are not related.
 If the relation is `(≤)`, this corresponds to incomparability and usual order antichains. If the
 relation is `G.adj` for `G : simple_graph α`, this corresponds to independent sets of `G`.
@@ -22,7 +28,8 @@ relation is `G.adj` for `G : simple_graph α`, this corresponds to independent s
 
 open function set
 
-variables {α β : Type*} {r r₁ r₂ : α → α → Prop} {r' : β → β → Prop} {s t : set α} {a : α}
+section general
+variables {α β : Type*} {r r₁ r₂ : α → α → Prop} {r' : β → β → Prop} {s t : set α} {a b : α}
 
 protected lemma symmetric.compl (h : symmetric r) : symmetric rᶜ := λ x y hr hr', hr $ h hr'
 
@@ -94,6 +101,73 @@ lemma insert_of_symmetric (hs : is_antichain r s) (hr : symmetric r)
   is_antichain r (insert a s) :=
 (is_antichain_insert_of_symmetric hr).2 ⟨hs, h⟩
 
+lemma image_rel_embedding (hs : is_antichain r s) (φ : r ↪r r') : is_antichain r' (φ '' s) :=
+begin
+  intros b hb b' hb' h₁ h₂,
+  rw set.mem_image at hb hb',
+  obtain ⟨⟨a,has,rfl⟩,⟨a',has',rfl⟩⟩ := ⟨hb,hb'⟩,
+  exact hs has has' (λ haa', h₁ (haa'.subst (by refl))) (φ.map_rel_iff.mp h₂),
+end
+
+lemma preimage_rel_embedding {t : set β} (ht : is_antichain r' t) (φ : r ↪r r') :
+  is_antichain r (φ ⁻¹' t) :=
+λ a ha a' ha' hne hle, ht ha ha' (λ h, hne (φ.injective h)) (φ.map_rel_iff.mpr hle)
+
+lemma image_rel_iso (hs : is_antichain r s) (φ : r ≃r r') : is_antichain r' (φ '' s) :=
+hs.image_rel_embedding φ
+
+lemma preimage_rel_iso {t : set β} (hs : is_antichain r' t) (φ : r ≃r r') :
+  is_antichain r (φ ⁻¹' t) :=
+hs.preimage_rel_embedding φ
+
+lemma image_rel_embedding_iff {φ : r ↪r r'} : is_antichain r' (φ '' s) ↔ is_antichain r s :=
+⟨λ h, (φ.injective.preimage_image s).subst (h.preimage_rel_embedding φ),
+  λ h, h.image_rel_embedding φ⟩
+
+lemma image_rel_iso_iff {φ : r ≃r r'} : is_antichain r' (φ '' s) ↔ is_antichain r s :=
+  @image_rel_embedding_iff _ _ _ _ _ (φ : r ↪r r')
+
+lemma image_embedding [has_le α] [has_le β] (hs : is_antichain (≤) s) (φ : α ↪o β) :
+  is_antichain (≤) (φ '' s) :=
+image_rel_embedding hs _
+
+lemma preimage_embedding [has_le α] [has_le β] {t : set β} (ht : is_antichain (≤) t) (φ : α ↪o β) :
+  is_antichain (≤) (φ ⁻¹' t) :=
+preimage_rel_embedding ht _
+
+lemma image_embedding_iff [has_le α] [has_le β] {φ : α ↪o β} :
+  is_antichain (≤) (φ '' s) ↔ is_antichain (≤) s :=
+image_rel_embedding_iff
+
+lemma image_iso [has_le α] [has_le β] (hs : is_antichain (≤) s) (φ : α ≃o β) :
+  is_antichain (≤) (φ '' s) :=
+image_rel_embedding hs _
+
+lemma image_iso_iff [has_le α] [has_le β] {φ : α ≃o β} :
+  is_antichain (≤) (φ '' s) ↔ is_antichain (≤) s :=
+image_rel_embedding_iff
+
+lemma preimage_iso [has_le α] [has_le β] {t : set β} (ht : is_antichain (≤) t) (φ : α ≃o β) :
+  is_antichain (≤) (φ ⁻¹' t) :=
+preimage_rel_embedding ht _
+
+lemma preimage_iso_iff [has_le α] [has_le β] {t : set β} {φ : α ≃o β} :
+  is_antichain (≤) (φ ⁻¹' t) ↔ is_antichain (≤) t :=
+⟨λ h, (φ.image_preimage t).subst (h.image_iso φ), λ h, h.preimage_iso _⟩
+
+lemma to_dual [has_le α] (hs : is_antichain (≤) s) : @is_antichain αᵒᵈ (≤) s :=
+λ a ha b hb hab, hs hb ha hab.symm
+
+lemma to_dual_iff [has_le α] : is_antichain (≤) s ↔ @is_antichain αᵒᵈ (≤) s := ⟨to_dual, to_dual⟩
+
+lemma image_compl [boolean_algebra α] (hs : is_antichain (≤) s) :
+  is_antichain (≤) (compl '' s) :=
+(hs.image_embedding (order_iso.compl α).to_order_embedding).flip
+
+lemma preimage_compl [boolean_algebra α] (hs : is_antichain (≤) s) :
+  is_antichain (≤) (compl ⁻¹' s) :=
+λ a ha a' ha' hne hle, hs ha' ha (λ h, hne (compl_inj_iff.mp h.symm)) (compl_le_compl hle)
+
 end is_antichain
 
 lemma is_antichain_singleton (a : α) (r : α → α → Prop) : is_antichain r {a} :=
@@ -105,6 +179,9 @@ hs.pairwise _
 section preorder
 variables [preorder α]
 
+lemma is_antichain.not_lt (hs : is_antichain (≤) s) (ha : a ∈ s) (hb : b ∈ s) : ¬ a < b :=
+λ h, hs ha hb h.ne h.le
+
 lemma is_antichain_and_least_iff : is_antichain (≤) s ∧ is_least s a ↔ s = {a} :=
 ⟨λ h, eq_singleton_iff_unique_mem.2 ⟨h.2.1, λ b hb, h.1.eq' hb h.2.1 (h.2.2 hb)⟩,
   by { rintro rfl, exact ⟨is_antichain_singleton _ _, is_least_singleton⟩ }⟩
@@ -133,9 +210,17 @@ is_greatest_top_iff.symm.trans hs.greatest_iff
 
 end preorder
 
+section partial_order
+variables [partial_order α]
+
+lemma is_antichain_iff_forall_not_lt : is_antichain (≤) s ↔ ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → ¬ a < b :=
+⟨λ hs a ha b, hs.not_lt ha, λ hs a ha b hb h h', hs ha hb $ h'.lt_of_ne h⟩
+
+end partial_order
+
 /-! ### Strong antichains -/
 
-/-- An strong (upward) antichain is a set such that no two distinct elements are related to a common
+/-- A strong (upward) antichain is a set such that no two distinct elements are related to a common
 element. -/
 def is_strong_antichain (r : α → α → Prop) (s : set α) : Prop :=
 s.pairwise $ λ a b, ∀ c, ¬ r a c ∨ ¬ r b c
@@ -194,3 +279,40 @@ end is_strong_antichain
 lemma set.subsingleton.is_strong_antichain (hs : s.subsingleton) (r : α → α → Prop) :
   is_strong_antichain r s :=
 hs.pairwise _
+
+end general
+
+/-! ### Weak antichains -/
+
+section pi
+variables {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s t : set (Π i, α i)}
+  {a b c : Π i, α i}
+
+local infix ` ≺ `:50 := strong_lt
+
+/-- A weak antichain in `Π i, α i` is a set such that no two distinct elements are strongly less
+than each other. -/
+def is_weak_antichain (s : set (Π i, α i)) : Prop := is_antichain (≺) s
+
+namespace is_weak_antichain
+
+protected lemma subset (hs : is_weak_antichain s) : t ⊆ s → is_weak_antichain t := hs.subset
+protected lemma eq (hs : is_weak_antichain s) : a ∈ s → b ∈ s → a ≺ b → a = b := hs.eq
+
+protected lemma insert (hs : is_weak_antichain s) : (∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ b ≺ a) →
+  (∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ a ≺ b) → is_weak_antichain (insert a s) :=
+hs.insert
+
+end is_weak_antichain
+
+lemma is_weak_antichain_insert :
+  is_weak_antichain (insert a s) ↔ is_weak_antichain s ∧ ∀ ⦃b⦄, b ∈ s → a ≠ b → ¬ a ≺ b ∧ ¬ b ≺ a :=
+is_antichain_insert
+
+protected lemma is_antichain.is_weak_antichain (hs : is_antichain (≤) s) : is_weak_antichain s :=
+hs.mono $ λ a b, le_of_strong_lt
+
+lemma set.subsingleton.is_weak_antichain (hs : s.subsingleton) : is_weak_antichain s :=
+hs.is_antichain _
+
+end pi
diff --git a/src/order/antisymmetrization.lean b/src/order/antisymmetrization.lean
index 4e8098fb5a811..fbb41b3be81ad 100644
--- a/src/order/antisymmetrization.lean
+++ b/src/order/antisymmetrization.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import order.hom.basic
+import logic.relation
 
 /-!
 # Turning a preorder into a partial order
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file allows to make a preorder into a partial order by quotienting out the elements `a`, `b`
 such that `a ≤ b` and `b ≤ a`.
 
@@ -108,6 +112,20 @@ instance : partial_order (antisymmetrization α (≤)) :=
   lt_iff_le_not_le := λ a b, quotient.induction_on₂' a b $ λ a b, lt_iff_le_not_le,
   le_antisymm := λ a b, quotient.induction_on₂' a b $ λ a b hab hba, quotient.sound' ⟨hab, hba⟩ }
 
+lemma antisymmetrization_fibration :
+  relation.fibration (<) (<) (@to_antisymmetrization α (≤) _) :=
+by { rintro a ⟨b⟩ h, exact ⟨b, h, rfl⟩ }
+
+lemma acc_antisymmetrization_iff : acc (<) (to_antisymmetrization (≤) a) ↔ acc (<) a :=
+acc_lift_on₂'_iff
+
+lemma well_founded_antisymmetrization_iff :
+  well_founded (@has_lt.lt (antisymmetrization α (≤)) _) ↔ well_founded (@has_lt.lt α _) :=
+well_founded_lift_on₂'_iff
+
+instance [well_founded_lt α] : well_founded_lt (antisymmetrization α (≤)) :=
+⟨well_founded_antisymmetrization_iff.2 is_well_founded.wf⟩
+
 instance [@decidable_rel α (≤)] [@decidable_rel α (<)] [is_total α (≤)] :
   linear_order (antisymmetrization α (≤)) :=
 { le_total := λ a b, quotient.induction_on₂' a b $ total_of (≤),
@@ -124,13 +142,11 @@ instance [@decidable_rel α (≤)] [@decidable_rel α (<)] [is_total α (≤)] :
 
 @[simp] lemma of_antisymmetrization_le_of_antisymmetrization_iff {a b : antisymmetrization α (≤)} :
   of_antisymmetrization (≤) a ≤ of_antisymmetrization (≤) b ↔ a ≤ b :=
-by convert to_antisymmetrization_le_to_antisymmetrization_iff.symm;
-  exact (to_antisymmetrization_of_antisymmetrization _ _).symm
+rel_embedding.map_rel_iff (quotient.out'_rel_embedding _)
 
 @[simp] lemma of_antisymmetrization_lt_of_antisymmetrization_iff {a b : antisymmetrization α (≤)} :
   of_antisymmetrization (≤) a < of_antisymmetrization (≤) b ↔ a < b :=
-by convert to_antisymmetrization_lt_to_antisymmetrization_iff.symm;
-  exact (to_antisymmetrization_of_antisymmetrization _ _).symm
+(quotient.out'_rel_embedding _).map_rel_iff
 
 @[mono] lemma to_antisymmetrization_mono : monotone (@to_antisymmetrization α (≤) _) := λ a b, id
 
@@ -164,8 +180,7 @@ variables (α)
 /-- `of_antisymmetrization` as an order embedding. -/
 @[simps] noncomputable def order_embedding.of_antisymmetrization : antisymmetrization α (≤) ↪o α :=
 { to_fun := of_antisymmetrization _,
-  inj' := λ _ _, quotient.out_inj.1,
-  map_rel_iff' := λ a b, of_antisymmetrization_le_of_antisymmetrization_iff }
+  ..quotient.out'_rel_embedding _ }
 
 /-- `antisymmetrization` and `order_dual` commute. -/
 def order_iso.dual_antisymmetrization :
diff --git a/src/order/atoms.lean b/src/order/atoms.lean
index 67113c02b8548..e7863c9974d32 100644
--- a/src/order/atoms.lean
+++ b/src/order/atoms.lean
@@ -3,15 +3,15 @@ Copyright (c) 2020 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
-
-import order.complete_boolean_algebra
-import order.cover
 import order.modular_lattice
-import data.fintype.basic
+import order.well_founded
 
 /-!
 # Atoms, Coatoms, and Simple Lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This module defines atoms, which are minimal non-`⊥` elements in bounded lattices, simple lattices,
 which are lattices with only two elements, and related ideas.
 
@@ -45,25 +45,22 @@ which are lattices with only two elements, and related ideas.
   * `is_compl.is_atom_iff_is_coatom` and `is_compl.is_coatom_if_is_atom`: In a modular
   bounded lattice, a complement of an atom is a coatom and vice versa.
   * `is_atomic_iff_is_coatomic`: A modular complemented lattice is atomic iff it is coatomic.
-  * `fintype.to_is_atomic`, `fintype.to_is_coatomic`: Finite partial orders with bottom resp. top
-    are atomic resp. coatomic.
 
 -/
 
-variable {α : Type*}
+variables {α β : Type*}
 
 section atoms
 
 section is_atom
 
-/-- An atom of an `order_bot` is an element with no other element between it and `⊥`,
-  which is not `⊥`. -/
-def is_atom [preorder α] [order_bot α] (a : α) : Prop := a ≠ ⊥ ∧ (∀ b, b < a → b = ⊥)
+section preorder
 
-variables [partial_order α] [order_bot α] {a b x : α}
+variables [preorder α] [order_bot α] {a b x : α}
 
-lemma eq_bot_or_eq_of_le_atom (ha : is_atom a) (hab : b ≤ a) : b = ⊥ ∨ b = a :=
-hab.lt_or_eq.imp_left (ha.2 b)
+/-- An atom of an `order_bot` is an element with no other element between it and `⊥`,
+  which is not `⊥`. -/
+def is_atom (a : α) : Prop := a ≠ ⊥ ∧ (∀ b, b < a → b = ⊥)
 
 lemma is_atom.Iic (ha : is_atom a) (hax : a ≤ x) : is_atom (⟨a, hax⟩ : set.Iic x) :=
 ⟨λ con, ha.1 (subtype.mk_eq_mk.1 con), λ ⟨b, hb⟩ hba, subtype.mk_eq_mk.2 (ha.2 b hba)⟩
@@ -71,9 +68,23 @@ lemma is_atom.Iic (ha : is_atom a) (hax : a ≤ x) : is_atom (⟨a, hax⟩ : set
 lemma is_atom.of_is_atom_coe_Iic {a : set.Iic x} (ha : is_atom a) : is_atom (a : α) :=
 ⟨λ con, ha.1 (subtype.ext con), λ b hba, subtype.mk_eq_mk.1 (ha.2 ⟨b, hba.le.trans a.prop⟩ hba)⟩
 
+lemma is_atom_iff {a : α} : is_atom a ↔ a ≠ ⊥ ∧ ∀ b ≠ ⊥, b ≤ a → a ≤ b :=
+and_congr iff.rfl $ forall_congr $
+  λ b, by simp only [ne.def, @not_imp_comm (b = ⊥), not_imp, lt_iff_le_not_le]
+
+end preorder
+
+variables [partial_order α] [order_bot α] {a b x : α}
+
+lemma is_atom.lt_iff (h : is_atom a) : x < a ↔ x = ⊥ := ⟨h.2 x, λ hx, hx.symm ▸ h.1.bot_lt⟩
+
+lemma is_atom.le_iff (h : is_atom a) : x ≤ a ↔ x = ⊥ ∨ x = a :=
+by rw [le_iff_lt_or_eq, h.lt_iff]
+
+lemma is_atom.Iic_eq (h : is_atom a) : set.Iic a = {⊥, a} := set.ext $ λ x, h.le_iff
+
 @[simp] lemma bot_covby_iff : ⊥ ⋖ a ↔ is_atom a :=
-⟨λ h, ⟨h.lt.ne', λ b hba, not_not.1 $ λ hb, h.2 (ne.bot_lt hb) hba⟩,
-  λ h, ⟨h.1.bot_lt, λ b hb hba, hb.ne' $ h.2 _ hba⟩⟩
+by simp only [covby, bot_lt_iff_ne_bot, is_atom, not_imp_not]
 
 alias bot_covby_iff ↔ covby.is_atom is_atom.bot_covby
 
@@ -81,37 +92,78 @@ end is_atom
 
 section is_coatom
 
+section preorder
+
+variables [preorder α]
+
 /-- A coatom of an `order_top` is an element with no other element between it and `⊤`,
   which is not `⊤`. -/
-def is_coatom [preorder α] [order_top α] (a : α) : Prop := a ≠ ⊤ ∧ (∀ b, a < b → b = ⊤)
+def is_coatom [order_top α] (a : α) : Prop := a ≠ ⊤ ∧ (∀ b, a < b → b = ⊤)
 
-variables [partial_order α] [order_top α] {a b x : α}
+@[simp] lemma is_coatom_dual_iff_is_atom [order_bot α] {a : α}:
+  is_coatom (order_dual.to_dual a) ↔ is_atom a :=
+iff.rfl
+
+@[simp] lemma is_atom_dual_iff_is_coatom [order_top α] {a : α} :
+  is_atom (order_dual.to_dual a) ↔ is_coatom a :=
+iff.rfl
 
-lemma eq_top_or_eq_of_coatom_le (ha : is_coatom a) (hab : a ≤ b) : b = ⊤ ∨ b = a :=
-hab.lt_or_eq.imp (ha.2 b) eq_comm.2
+alias is_coatom_dual_iff_is_atom ↔ _ is_atom.dual
+alias is_atom_dual_iff_is_coatom ↔ _ is_coatom.dual
+
+variables [order_top α] {a x : α}
 
 lemma is_coatom.Ici (ha : is_coatom a) (hax : x ≤ a) : is_coatom (⟨a, hax⟩ : set.Ici x) :=
-⟨λ con, ha.1 (subtype.mk_eq_mk.1 con), λ ⟨b, hb⟩ hba, subtype.mk_eq_mk.2 (ha.2 b hba)⟩
+ha.dual.Iic hax
 
 lemma is_coatom.of_is_coatom_coe_Ici {a : set.Ici x} (ha : is_coatom a) :
   is_coatom (a : α) :=
-⟨λ con, ha.1 (subtype.ext con), λ b hba, subtype.mk_eq_mk.1 (ha.2 ⟨b, le_trans a.prop hba.le⟩ hba)⟩
+@is_atom.of_is_atom_coe_Iic αᵒᵈ _ _ x a ha
+
+lemma is_coatom_iff {a : α} : is_coatom a ↔ a ≠ ⊤ ∧ ∀ b ≠ ⊤, a ≤ b → b ≤ a := @is_atom_iff αᵒᵈ _ _ _
+
+end preorder
+
+variables [partial_order α] [order_top α] {a b x : α}
+
+lemma is_coatom.lt_iff (h : is_coatom a) : a < x ↔ x = ⊤ := h.dual.lt_iff
+lemma is_coatom.le_iff (h : is_coatom a) : a ≤ x ↔ x = ⊤ ∨ x = a := h.dual.le_iff
+lemma is_coatom.Ici_eq (h : is_coatom a) : set.Ici a = {⊤, a} := h.dual.Iic_eq
 
 @[simp] lemma covby_top_iff : a ⋖ ⊤ ↔ is_coatom a :=
-⟨λ h, ⟨h.ne, λ b hab, not_not.1 $ λ hb, h.2 hab $ ne.lt_top hb⟩,
-  λ h, ⟨h.1.lt_top, λ b hab hb, hb.ne $ h.2 _ hab⟩⟩
+to_dual_covby_to_dual_iff.symm.trans bot_covby_iff
 
 alias covby_top_iff ↔ covby.is_coatom is_coatom.covby_top
 
 end is_coatom
 
+section partial_order
+variables [partial_order α] {a b : α}
+
+@[simp] lemma set.Ici.is_atom_iff {b : set.Ici a} : is_atom b ↔ a ⋖ b :=
+begin
+  rw ←bot_covby_iff,
+  refine (set.ord_connected.apply_covby_apply_iff (order_embedding.subtype $ λ c, a ≤ c) _).symm,
+  simpa only [order_embedding.subtype_apply, subtype.range_coe_subtype] using set.ord_connected_Ici,
+end
+
+@[simp] lemma set.Iic.is_coatom_iff {a : set.Iic b} : is_coatom a ↔ ↑a ⋖ b :=
+begin
+  rw ←covby_top_iff,
+  refine (set.ord_connected.apply_covby_apply_iff (order_embedding.subtype $ λ c, c ≤ b) _).symm,
+  simpa only [order_embedding.subtype_apply, subtype.range_coe_subtype] using set.ord_connected_Iic,
+end
+
+lemma covby_iff_atom_Ici (h : a ≤ b) : a ⋖ b ↔ is_atom (⟨b, h⟩ : set.Ici a) := by simp
+lemma covby_iff_coatom_Iic (h : a ≤ b) : a ⋖ b ↔ is_coatom (⟨a, h⟩ : set.Iic b) := by simp
+
+end partial_order
+
 section pairwise
 
 lemma is_atom.inf_eq_bot_of_ne [semilattice_inf α] [order_bot α] {a b : α}
   (ha : is_atom a) (hb : is_atom b) (hab : a ≠ b) : a ⊓ b = ⊥ :=
-or.elim (eq_bot_or_eq_of_le_atom ha inf_le_left) id
-  (λ h1, or.elim (eq_bot_or_eq_of_le_atom hb inf_le_right) id
-  (λ h2, false.rec _ (hab (le_antisymm (inf_eq_left.mp h1) (inf_eq_right.mp h2)))))
+hab.not_le_or_not_le.elim (ha.lt_iff.1 ∘ inf_lt_left.2) (hb.lt_iff.1 ∘ inf_lt_right.2)
 
 lemma is_atom.disjoint_of_ne [semilattice_inf α] [order_bot α] {a b : α}
   (ha : is_atom a) (hb : is_atom b) (hab : a ≠ b) : disjoint a b :=
@@ -119,24 +171,10 @@ disjoint_iff.mpr (is_atom.inf_eq_bot_of_ne ha hb hab)
 
 lemma is_coatom.sup_eq_top_of_ne [semilattice_sup α] [order_top α] {a b : α}
   (ha : is_coatom a) (hb : is_coatom b) (hab : a ≠ b) : a ⊔ b = ⊤ :=
-or.elim (eq_top_or_eq_of_coatom_le ha le_sup_left) id
-  (λ h1, or.elim (eq_top_or_eq_of_coatom_le hb le_sup_right) id
-  (λ h2, false.rec _ (hab (le_antisymm (sup_eq_right.mp h2) (sup_eq_left.mp h1)))))
+ha.dual.inf_eq_bot_of_ne hb.dual hab
 
 end pairwise
 
-variables [preorder α] {a : α}
-
-@[simp]
-lemma is_coatom_dual_iff_is_atom [order_bot α] :
-  is_coatom (order_dual.to_dual a) ↔ is_atom a :=
-iff.rfl
-
-@[simp]
-lemma is_atom_dual_iff_is_coatom [order_top α] :
-  is_atom (order_dual.to_dual a) ↔ is_coatom a :=
-iff.rfl
-
 end atoms
 
 section atomic
@@ -144,11 +182,11 @@ section atomic
 variables [partial_order α] (α)
 
 /-- A lattice is atomic iff every element other than `⊥` has an atom below it. -/
-class is_atomic [order_bot α] : Prop :=
+@[mk_iff] class is_atomic [order_bot α] : Prop :=
 (eq_bot_or_exists_atom_le : ∀ (b : α), b = ⊥ ∨ ∃ (a : α), is_atom a ∧ a ≤ b)
 
 /-- A lattice is coatomic iff every element other than `⊤` has a coatom above it. -/
-class is_coatomic [order_top α] : Prop :=
+@[mk_iff] class is_coatomic [order_top α] : Prop :=
 (eq_top_or_exists_le_coatom : ∀ (b : α), b = ⊤ ∨ ∃ (a : α), is_coatom a ∧ b ≤ a)
 
 export is_atomic (eq_bot_or_exists_atom_le) is_coatomic (eq_top_or_exists_le_coatom)
@@ -421,12 +459,6 @@ def order_iso_bool : α ≃o bool :=
   end,
   ..equiv_bool }
 
-/- It is important that `is_simple_order` is the last type-class argument of this instance,
-so that type-class inference fails quickly if it doesn't apply. -/
-@[priority 200]
-instance {α} [decidable_eq α] [has_le α] [bounded_order α] [is_simple_order α] : fintype α :=
-fintype.of_equiv bool equiv_bool.symm
-
 /-- A simple `bounded_order` is also a `boolean_algebra`. -/
 protected def boolean_algebra {α} [decidable_eq α] [lattice α] [bounded_order α]
   [is_simple_order α] : boolean_algebra α :=
@@ -442,17 +474,6 @@ protected def boolean_algebra {α} [decidable_eq α] [lattice α] [bounded_order
         simp [h] }
     end,
   top_le_sup_compl := λ x, by rcases eq_bot_or_eq_top x with rfl | rfl; simp,
-  sup_inf_sdiff := λ x y, by rcases eq_bot_or_eq_top x with rfl | rfl;
-      rcases eq_bot_or_eq_top y with rfl | rfl; simp [bot_ne_top],
-  inf_inf_sdiff := λ x y, begin
-      rcases eq_bot_or_eq_top x with rfl | rfl,
-      { simpa },
-      rcases eq_bot_or_eq_top y with rfl | rfl,
-      { simpa },
-      { simp only [true_and, top_inf_eq, eq_self_iff_true],
-        split_ifs with h h;
-        simpa [h] }
-    end,
   .. (show bounded_order α, by apply_instance),
   .. is_simple_order.distrib_lattice }
 
@@ -509,34 +530,6 @@ instance : is_atomistic α :=
 instance : is_coatomistic α := is_atomistic_dual_iff_is_coatomistic.1 is_simple_order.is_atomistic
 
 end is_simple_order
-namespace fintype
-namespace is_simple_order
-variables [partial_order α] [bounded_order α] [is_simple_order α] [decidable_eq α]
-
-lemma univ : (finset.univ : finset α) = {⊤, ⊥} :=
-begin
-  change finset.map _ (finset.univ : finset bool) = _,
-  rw fintype.univ_bool,
-  simp only [finset.map_insert, function.embedding.coe_fn_mk, finset.map_singleton],
-  refl,
-end
-
-lemma card : fintype.card α = 2 :=
-(fintype.of_equiv_card _).trans fintype.card_bool
-
-end is_simple_order
-end fintype
-
-namespace bool
-
-instance : is_simple_order bool :=
-⟨λ a, begin
-  rw [← finset.mem_singleton, or.comm, ← finset.mem_insert,
-      top_eq_tt, bot_eq_ff, ← fintype.univ_bool],
-  apply finset.mem_univ,
-end⟩
-
-end bool
 
 theorem is_simple_order_iff_is_atom_top [partial_order α] [bounded_order α] :
   is_simple_order α ↔ is_atom (⊤ : α) :=
@@ -564,59 +557,127 @@ is_simple_order_iff_is_coatom_bot.trans $ and_congr (not_congr subtype.mk_eq_mk)
 
 end set
 
+namespace order_embedding
+
+variables [partial_order α] [partial_order β]
+
+lemma is_atom_of_map_bot_of_image [order_bot α] [order_bot β] (f : β ↪o α) (hbot : f ⊥ = ⊥) {b : β}
+  (hb : is_atom (f b)) : is_atom b :=
+by { simp only [←bot_covby_iff] at hb ⊢, exact covby.of_image f (hbot.symm ▸ hb) }
+
+lemma is_coatom_of_map_top_of_image [order_top α] [order_top β] (f : β ↪o α) (htop : f ⊤ = ⊤)
+  {b : β} (hb : is_coatom (f b)) : is_coatom b :=
+f.dual.is_atom_of_map_bot_of_image htop hb
+
+end order_embedding
+
+namespace galois_insertion
+
+variables [partial_order α] [partial_order β]
+
+lemma is_atom_of_u_bot [order_bot α] [order_bot β] {l : α → β} {u : β → α}
+  (gi : galois_insertion l u) (hbot : u ⊥ = ⊥) {b : β} (hb : is_atom (u b)) : is_atom b :=
+order_embedding.is_atom_of_map_bot_of_image
+  ⟨⟨u, gi.u_injective⟩, @galois_insertion.u_le_u_iff _ _ _ _ _ _ gi⟩ hbot hb
+
+lemma is_atom_iff [order_bot α] [is_atomic α] [order_bot β] {l : α → β} {u : β → α}
+  (gi : galois_insertion l u) (hbot : u ⊥ = ⊥) (h_atom : ∀ a, is_atom a → u (l a) = a) (a : α) :
+  is_atom (l a) ↔ is_atom a :=
+begin
+  refine ⟨λ hla, _, λ ha, gi.is_atom_of_u_bot hbot ((h_atom a ha).symm ▸ ha)⟩,
+  obtain ⟨a', ha', hab'⟩ := (eq_bot_or_exists_atom_le (u (l a))).resolve_left
+    (hbot ▸ λ h, hla.1 (gi.u_injective h)),
+  have := (hla.le_iff.mp $ (gi.l_u_eq (l a) ▸ gi.gc.monotone_l hab' : l a' ≤ l a)).resolve_left
+    (λ h, ha'.1 (hbot ▸ (h_atom a' ha') ▸ congr_arg u h)),
+  have haa' : a = a' := (ha'.le_iff.mp $
+    (gi.gc.le_u_l a).trans_eq (h_atom a' ha' ▸ congr_arg u this.symm)).resolve_left
+    (mt (congr_arg l) (gi.gc.l_bot.symm ▸ hla.1)),
+  exact haa'.symm ▸ ha'
+end
+
+lemma is_atom_iff' [order_bot α] [is_atomic α] [order_bot β] {l : α → β} {u : β → α}
+  (gi : galois_insertion l u) (hbot : u ⊥ = ⊥) (h_atom : ∀ a, is_atom a → u (l a) = a) (b : β) :
+  is_atom (u b) ↔ is_atom b :=
+by rw [←gi.is_atom_iff hbot h_atom, gi.l_u_eq]
+
+lemma is_coatom_of_image [order_top α] [order_top β] {l : α → β} {u : β → α}
+  (gi : galois_insertion l u) {b : β} (hb : is_coatom (u b)) : is_coatom b :=
+order_embedding.is_coatom_of_map_top_of_image
+  ⟨⟨u, gi.u_injective⟩, @galois_insertion.u_le_u_iff _ _ _ _ _ _ gi⟩ gi.gc.u_top hb
+
+lemma is_coatom_iff [order_top α] [is_coatomic α] [order_top β] {l : α → β} {u : β → α}
+  (gi : galois_insertion l u) (h_coatom : ∀ a : α, is_coatom a → u (l a) = a) (b : β) :
+  is_coatom (u b) ↔ is_coatom b :=
+begin
+  refine ⟨λ hb, gi.is_coatom_of_image hb, λ hb, _⟩,
+  obtain ⟨a, ha, hab⟩ := (eq_top_or_exists_le_coatom (u b)).resolve_left
+    (λ h, hb.1 $ (gi.gc.u_top ▸ gi.l_u_eq ⊤ : l ⊤ = ⊤) ▸ gi.l_u_eq b ▸ congr_arg l h),
+  have : l a = b := (hb.le_iff.mp ((gi.l_u_eq b ▸ gi.gc.monotone_l hab) : b ≤ l a)).resolve_left
+    (λ hla, ha.1 (gi.gc.u_top ▸ h_coatom a ha ▸ congr_arg u hla)),
+  exact this ▸ (h_coatom a ha).symm ▸ ha,
+end
+
+end galois_insertion
+
+namespace galois_coinsertion
+
+variables [partial_order α] [partial_order β]
+
+lemma is_coatom_of_l_top [order_top α] [order_top β] {l : α → β} {u : β → α}
+  (gi : galois_coinsertion l u) (hbot : l ⊤ = ⊤) {a : α} (hb : is_coatom (l a)) : is_coatom a :=
+gi.dual.is_atom_of_u_bot hbot hb.dual
+
+lemma is_coatom_iff [order_top α] [order_top β] [is_coatomic β] {l : α → β} {u : β → α}
+  (gi : galois_coinsertion l u) (htop : l ⊤ = ⊤) (h_coatom : ∀ b, is_coatom b → l (u b) = b)
+  (b : β) : is_coatom (u b) ↔ is_coatom b :=
+gi.dual.is_atom_iff htop h_coatom b
+
+lemma is_coatom_iff' [order_top α] [order_top β] [is_coatomic β] {l : α → β} {u : β → α}
+  (gi : galois_coinsertion l u) (htop : l ⊤ = ⊤) (h_coatom : ∀ b, is_coatom b → l (u b) = b)
+  (a : α) : is_coatom (l a) ↔ is_coatom a :=
+gi.dual.is_atom_iff' htop h_coatom a
+
+lemma is_atom_of_image [order_bot α] [order_bot β] {l : α → β} {u : β → α}
+  (gi : galois_coinsertion l u) {a : α} (hb : is_atom (l a)) : is_atom a :=
+gi.dual.is_coatom_of_image hb.dual
+
+lemma is_atom_iff [order_bot α] [order_bot β] [is_atomic β] {l : α → β} {u : β → α}
+  (gi : galois_coinsertion l u) (h_atom : ∀ b, is_atom b → l (u b) = b) (a : α) :
+  is_atom (l a) ↔ is_atom a :=
+gi.dual.is_coatom_iff h_atom a
+
+end galois_coinsertion
+
 namespace order_iso
 
-variables {β : Type*}
+variables [partial_order α] [partial_order β]
 
-@[simp] lemma is_atom_iff [partial_order α] [order_bot α] [partial_order β] [order_bot β]
-  (f : α ≃o β) (a : α) :
+@[simp] lemma is_atom_iff [order_bot α] [order_bot β] (f : α ≃o β) (a : α) :
   is_atom (f a) ↔ is_atom a :=
-and_congr (not_congr ⟨λ h, f.injective (f.map_bot.symm ▸ h), λ h, f.map_bot ▸ (congr rfl h)⟩)
-  ⟨λ h b hb, f.injective ((h (f b) ((f : α ↪o β).lt_iff_lt.2 hb)).trans f.map_bot.symm),
-  λ h b hb, f.symm.injective begin
-    rw f.symm.map_bot,
-    apply h,
-    rw [← f.symm_apply_apply a],
-    exact (f.symm : β ↪o α).lt_iff_lt.2 hb,
-  end⟩
-
-@[simp] lemma is_coatom_iff [partial_order α] [order_top α] [partial_order β] [order_top β]
-  (f : α ≃o β) (a : α) :
+⟨f.to_galois_coinsertion.is_atom_of_image,
+ λ ha, f.to_galois_insertion.is_atom_of_u_bot (map_bot f.symm) $ (f.symm_apply_apply a).symm ▸ ha⟩
+
+@[simp] lemma is_coatom_iff [order_top α] [order_top β] (f : α ≃o β) (a : α) :
   is_coatom (f a) ↔ is_coatom a :=
 f.dual.is_atom_iff a
 
-lemma is_simple_order_iff [partial_order α] [bounded_order α] [partial_order β] [bounded_order β]
-  (f : α ≃o β) :
+lemma is_simple_order_iff [bounded_order α] [bounded_order β] (f : α ≃o β) :
   is_simple_order α ↔ is_simple_order β :=
 by rw [is_simple_order_iff_is_atom_top, is_simple_order_iff_is_atom_top,
   ← f.is_atom_iff ⊤, f.map_top]
 
-lemma is_simple_order [partial_order α] [bounded_order α] [partial_order β] [bounded_order β]
-  [h : is_simple_order β] (f : α ≃o β) :
+lemma is_simple_order [bounded_order α] [bounded_order β] [h : is_simple_order β] (f : α ≃o β) :
   is_simple_order α :=
 f.is_simple_order_iff.mpr h
 
-lemma is_atomic_iff [partial_order α] [order_bot α] [partial_order β] [order_bot β] (f : α ≃o β) :
+protected lemma is_atomic_iff [order_bot α] [order_bot β] (f : α ≃o β) :
   is_atomic α ↔ is_atomic β :=
-begin
-  suffices : (∀ b : α, b = ⊥ ∨ ∃ (a : α), is_atom a ∧ a ≤ b) ↔
-    (∀ b : β, b = ⊥ ∨ ∃ (a : β), is_atom a ∧ a ≤ b),
-  from ⟨λ ⟨p⟩, ⟨this.mp p⟩, λ ⟨p⟩, ⟨this.mpr p⟩⟩,
-  apply f.to_equiv.forall_congr,
-  simp_rw [rel_iso.coe_fn_to_equiv],
-  intro b, apply or_congr,
-  { rw [f.apply_eq_iff_eq_symm_apply, map_bot], },
-  { split,
-    { exact λ ⟨a, ha⟩, ⟨f a, ⟨(f.is_atom_iff a).mpr ha.1, f.le_iff_le.mpr ha.2⟩⟩, },
-    { rintros ⟨b, ⟨hb1, hb2⟩⟩,
-      refine ⟨f.symm b, ⟨(f.symm.is_atom_iff b).mpr hb1, _⟩⟩,
-      rwa [←f.le_iff_le, f.apply_symm_apply], }, },
-end
+by simp only [is_atomic_iff, f.surjective.forall, f.surjective.exists, ← map_bot f, f.eq_iff_eq,
+  f.le_iff_le, f.is_atom_iff]
 
-lemma is_coatomic_iff [partial_order α] [order_top α] [partial_order β] [order_top β] (f : α ≃o β) :
+protected lemma is_coatomic_iff [order_top α] [order_top β] (f : α ≃o β) :
   is_coatomic α ↔ is_coatomic β :=
-by { rw [←is_atomic_dual_iff_is_coatomic, ←is_atomic_dual_iff_is_coatomic],
-  exact f.dual.is_atomic_iff }
+by simp only [← is_atomic_dual_iff_is_coatomic, f.dual.is_atomic_iff]
 
 end order_iso
 
@@ -635,9 +696,10 @@ lemma is_coatom_iff_is_atom : is_coatom a ↔ is_atom b := hc.symm.is_atom_iff_i
 
 end is_compl
 
-variables [is_complemented α]
+variables [complemented_lattice α]
 
-lemma is_coatomic_of_is_atomic_of_is_complemented_of_is_modular [is_atomic α] : is_coatomic α :=
+lemma is_coatomic_of_is_atomic_of_complemented_lattice_of_is_modular [is_atomic α] :
+  is_coatomic α :=
 ⟨λ x, begin
   rcases exists_is_compl x with ⟨y, xy⟩,
   apply (eq_bot_or_exists_atom_le y).imp _ _,
@@ -650,33 +712,44 @@ lemma is_coatomic_of_is_atomic_of_is_complemented_of_is_modular [is_atomic α] :
     apply ha.Iic }
 end⟩
 
-lemma is_atomic_of_is_coatomic_of_is_complemented_of_is_modular [is_coatomic α] : is_atomic α :=
-is_coatomic_dual_iff_is_atomic.1 is_coatomic_of_is_atomic_of_is_complemented_of_is_modular
+lemma is_atomic_of_is_coatomic_of_complemented_lattice_of_is_modular [is_coatomic α] :
+  is_atomic α :=
+is_coatomic_dual_iff_is_atomic.1 is_coatomic_of_is_atomic_of_complemented_lattice_of_is_modular
 
 theorem is_atomic_iff_is_coatomic : is_atomic α ↔ is_coatomic α :=
-⟨λ h, @is_coatomic_of_is_atomic_of_is_complemented_of_is_modular _ _ _ _ _ h,
-  λ h, @is_atomic_of_is_coatomic_of_is_complemented_of_is_modular _ _ _ _ _ h⟩
+⟨λ h, @is_coatomic_of_is_atomic_of_complemented_lattice_of_is_modular _ _ _ _ _ h,
+  λ h, @is_atomic_of_is_coatomic_of_complemented_lattice_of_is_modular _ _ _ _ _ h⟩
 
 end is_modular_lattice
 
-section fintype
+namespace set
 
-open finset
+lemma is_atom_singleton (x : α) : is_atom ({x} : set α) :=
+⟨singleton_ne_empty _, λ s hs, ssubset_singleton_iff.mp hs⟩
 
-@[priority 100]  -- see Note [lower instance priority]
-instance fintype.to_is_coatomic [partial_order α] [order_top α] [fintype α] : is_coatomic α :=
+lemma is_atom_iff (s : set α) : is_atom s ↔ ∃ x, s = {x} :=
 begin
-  refine is_coatomic.mk (λ b, or_iff_not_imp_left.2 (λ ht, _)),
-  obtain ⟨c, hc, hmax⟩ := set.finite.exists_maximal_wrt id { x : α | b ≤ x ∧ x ≠ ⊤ }
-    (set.finite.of_fintype _) ⟨b, le_rfl, ht⟩,
-  refine ⟨c, ⟨hc.2, λ y hcy, _⟩, hc.1⟩,
-  by_contra hyt,
-  obtain rfl : c = y := hmax y ⟨hc.1.trans hcy.le, hyt⟩ hcy.le,
-  exact (lt_self_iff_false _).mp hcy
+  refine ⟨_, by { rintro ⟨x, rfl⟩, exact is_atom_singleton x }⟩,
+  rw [is_atom_iff, bot_eq_empty, ←nonempty_iff_ne_empty],
+  rintro ⟨⟨x, hx⟩, hs⟩,
+  exact ⟨x, eq_singleton_iff_unique_mem.2 ⟨hx, λ y hy,
+    (hs {y} (singleton_ne_empty _) (singleton_subset_iff.2 hy) hx).symm⟩⟩,
 end
 
-@[priority 100]  -- see Note [lower instance priority]
-instance fintype.to_is_atomic [partial_order α] [order_bot α] [fintype α] : is_atomic α :=
-is_coatomic_dual_iff_is_atomic.mp fintype.to_is_coatomic
+lemma is_coatom_iff (s : set α) : is_coatom s ↔ ∃ x, s = {x}ᶜ :=
+by simp_rw [is_compl_compl.is_coatom_iff_is_atom, is_atom_iff, @eq_comm _ s, compl_eq_comm]
+
+lemma is_coatom_singleton_compl (x : α) : is_coatom ({x}ᶜ : set α) :=
+(is_coatom_iff {x}ᶜ).mpr ⟨x, rfl⟩
 
-end fintype
+instance : is_atomistic (set α) :=
+{ eq_Sup_atoms := λ s, ⟨(λ x, {x}) '' s,
+    by rw [Sup_eq_sUnion, sUnion_image, bUnion_of_singleton],
+    by { rintro - ⟨x, hx, rfl⟩, exact is_atom_singleton x }⟩ }
+
+instance : is_coatomistic (set α) :=
+{ eq_Inf_coatoms := λ s, ⟨(λ x, {x}ᶜ) '' sᶜ,
+    by rw [Inf_eq_sInter, sInter_image, ←compl_Union₂, bUnion_of_singleton, compl_compl],
+    by { rintro - ⟨x, hx, rfl⟩, exact is_coatom_singleton_compl x }⟩ }
+
+end set
diff --git a/src/order/atoms/finite.lean b/src/order/atoms/finite.lean
new file mode 100644
index 0000000000000..1f10d0ff97cba
--- /dev/null
+++ b/src/order/atoms/finite.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2020 Aaron Anderson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Aaron Anderson
+-/
+import data.set.finite
+import order.atoms
+
+/-!
+# Atoms, Coatoms, Simple Lattices, and Finiteness
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This module contains some results on atoms and simple lattices in the finite context.
+
+## Main results
+  * `finite.to_is_atomic`, `finite.to_is_coatomic`: Finite partial orders with bottom resp. top
+    are atomic resp. coatomic.
+
+-/
+
+variables {α β : Type*}
+
+namespace is_simple_order
+section decidable_eq
+
+/- It is important that `is_simple_order` is the last type-class argument of this instance,
+so that type-class inference fails quickly if it doesn't apply. -/
+@[priority 200]
+instance {α} [decidable_eq α] [has_le α] [bounded_order α] [is_simple_order α] : fintype α :=
+fintype.of_equiv bool equiv_bool.symm
+
+end decidable_eq
+end is_simple_order
+
+namespace fintype
+namespace is_simple_order
+variables [partial_order α] [bounded_order α] [is_simple_order α] [decidable_eq α]
+
+lemma univ : (finset.univ : finset α) = {⊤, ⊥} :=
+begin
+  change finset.map _ (finset.univ : finset bool) = _,
+  rw fintype.univ_bool,
+  simp only [finset.map_insert, function.embedding.coe_fn_mk, finset.map_singleton],
+  refl,
+end
+
+lemma card : fintype.card α = 2 :=
+(fintype.of_equiv_card _).trans fintype.card_bool
+
+end is_simple_order
+end fintype
+
+namespace bool
+
+instance : is_simple_order bool :=
+⟨λ a, begin
+  rw [← finset.mem_singleton, or.comm, ← finset.mem_insert,
+      top_eq_tt, bot_eq_ff, ← fintype.univ_bool],
+  apply finset.mem_univ,
+end⟩
+
+end bool
+
+section fintype
+
+open finset
+
+@[priority 100]  -- see Note [lower instance priority]
+instance finite.to_is_coatomic [partial_order α] [order_top α] [finite α] : is_coatomic α :=
+begin
+  refine is_coatomic.mk (λ b, or_iff_not_imp_left.2 (λ ht, _)),
+  obtain ⟨c, hc, hmax⟩ := set.finite.exists_maximal_wrt id { x : α | b ≤ x ∧ x ≠ ⊤ }
+    (set.to_finite _) ⟨b, le_rfl, ht⟩,
+  refine ⟨c, ⟨hc.2, λ y hcy, _⟩, hc.1⟩,
+  by_contra hyt,
+  obtain rfl : c = y := hmax y ⟨hc.1.trans hcy.le, hyt⟩ hcy.le,
+  exact (lt_self_iff_false _).mp hcy
+end
+
+@[priority 100]  -- see Note [lower instance priority]
+instance finite.to_is_atomic [partial_order α] [order_bot α] [finite α] : is_atomic α :=
+is_coatomic_dual_iff_is_atomic.mp finite.to_is_coatomic
+
+end fintype
diff --git a/src/order/basic.lean b/src/order/basic.lean
index d5ed39b3f15f1..da3341b7806f3 100644
--- a/src/order/basic.lean
+++ b/src/order/basic.lean
@@ -3,12 +3,15 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Mario Carneiro
 -/
-import data.prod
+import data.prod.basic
 import data.subtype
 
 /-!
 # Basic definitions about `≤` and `<`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves basic results about orders, provides extensive dot notation, defines useful order
 classes and allows to transfer order instances.
 
@@ -27,7 +30,10 @@ classes and allows to transfer order instances.
 
 ### Extra class
 
-- `densely_ordered`: An order with no gap, i.e. for any two elements `a < b` there exists `c` such
+* `has_sup`: type class for the `⊔` notation
+* `has_inf`: type class for the `⊓` notation
+* `has_compl`: type class for the `ᶜ` notation
+* `densely_ordered`: An order with no gap, i.e. for any two elements `a < b` there exists `c` such
   that `a < c < b`.
 
 ## Notes
@@ -55,7 +61,7 @@ preorder, order, partial order, poset, linear order, chain
 open function
 
 universes u v w
-variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}
+variables {ι : Type*} {α : Type u} {β : Type v} {γ : Type w} {π : ι → Type*} {r : α → α → Prop}
 
 section preorder
 variables [preorder α] {a b c : α}
@@ -149,10 +155,18 @@ namespace has_le.le
 @[nolint ge_or_gt] -- see Note [nolint_ge]
 protected lemma ge [has_le α] {x y : α} (h : x ≤ y) : y ≥ x := h
 
-lemma lt_iff_ne [partial_order α] {x y : α} (h : x ≤ y) : x < y ↔ x ≠ y := ⟨λ h, h.ne, h.lt_of_ne⟩
+section partial_order
+variables [partial_order α] {a b : α}
+
+lemma lt_iff_ne (h : a ≤ b) : a < b ↔ a ≠ b := ⟨λ h, h.ne, h.lt_of_ne⟩
+lemma gt_iff_ne (h : a ≤ b) : a < b ↔ b ≠ a := ⟨λ h, h.ne.symm, h.lt_of_ne'⟩
+lemma not_lt_iff_eq (h : a ≤ b) : ¬ a < b ↔ a = b := h.lt_iff_ne.not_left
+lemma not_gt_iff_eq (h : a ≤ b) : ¬ a < b ↔ b = a := h.gt_iff_ne.not_left
 
-lemma le_iff_eq [partial_order α] {x y : α} (h : x ≤ y) : y ≤ x ↔ y = x :=
-⟨λ h', h'.antisymm h, eq.le⟩
+lemma le_iff_eq (h : a ≤ b) : b ≤ a ↔ b = a := ⟨λ h', h'.antisymm h, eq.le⟩
+lemma ge_iff_eq (h : a ≤ b) : b ≤ a ↔ a = b := ⟨h.antisymm, eq.ge⟩
+
+end partial_order
 
 lemma lt_or_le [linear_order α] {a b : α} (h : a ≤ b) (c : α) : a < c ∨ c ≤ b :=
 (lt_or_ge a c).imp id $ λ hc, le_trans hc h
@@ -213,6 +227,9 @@ le_iff_lt_or_eq.trans or.comm
 lemma lt_iff_le_and_ne [partial_order α] {a b : α} : a < b ↔ a ≤ b ∧ a ≠ b :=
 ⟨λ h, ⟨le_of_lt h, ne_of_lt h⟩, λ ⟨h1, h2⟩, h1.lt_of_ne h2⟩
 
+lemma eq_iff_not_lt_of_le {α} [partial_order α] {x y : α} : x ≤ y → y = x ↔ ¬ x < y :=
+by rw [lt_iff_le_and_ne, not_and, not_not, eq_comm]
+
 -- See Note [decidable namespace]
 protected lemma decidable.eq_iff_le_not_lt [partial_order α] [@decidable_rel α (≤)]
   {a b : α} : a = b ↔ a ≤ b ∧ ¬ a < b :=
@@ -225,10 +242,13 @@ by haveI := classical.dec; exact decidable.eq_iff_le_not_lt
 lemma eq_or_lt_of_le [partial_order α] {a b : α} (h : a ≤ b) : a = b ∨ a < b := h.lt_or_eq.symm
 lemma eq_or_gt_of_le [partial_order α] {a b : α} (h : a ≤ b) : b = a ∨ a < b :=
 h.lt_or_eq.symm.imp eq.symm id
+lemma gt_or_eq_of_le [partial_order α] {a b : α} (hab : a ≤ b) : a < b ∨ b = a :=
+(eq_or_gt_of_le hab).symm
 
 alias decidable.eq_or_lt_of_le ← has_le.le.eq_or_lt_dec
 alias eq_or_lt_of_le ← has_le.le.eq_or_lt
 alias eq_or_gt_of_le ← has_le.le.eq_or_gt
+alias gt_or_eq_of_le ← has_le.le.gt_or_eq
 
 attribute [nolint decidable_classical] has_le.le.eq_or_lt_dec
 
@@ -255,6 +275,26 @@ protected lemma decidable.ne_iff_lt_iff_le [partial_order α] [decidable_eq α]
 @[simp] lemma ne_iff_lt_iff_le [partial_order α] {a b : α} : (a ≠ b ↔ a < b) ↔ a ≤ b :=
 by haveI := classical.dec; exact decidable.ne_iff_lt_iff_le
 
+-- Variant of `min_def` with the branches reversed.
+lemma min_def' [linear_order α] (a b : α) : min a b = if b ≤ a then b else a :=
+begin
+  rw [min_def],
+  rcases lt_trichotomy a b with lt | eq | gt,
+  { rw [if_pos lt.le, if_neg (not_le.mpr lt)], },
+  { rw [if_pos eq.le, if_pos eq.ge, eq], },
+  { rw [if_neg (not_le.mpr gt), if_pos gt.le], }
+end
+-- Variant of `min_def` with the branches reversed.
+-- This is sometimes useful as it used to be the default.
+lemma max_def' [linear_order α] (a b : α) : max a b = if b ≤ a then a else b :=
+begin
+  rw [max_def],
+  rcases lt_trichotomy a b with lt | eq | gt,
+  { rw [if_pos lt.le, if_neg (not_le.mpr lt)], },
+  { rw [if_pos eq.le, if_pos eq.ge, eq], },
+  { rw [if_neg (not_le.mpr gt), if_pos gt.le], }
+end
+
 lemma lt_of_not_le [linear_order α] {a b : α} (h : ¬ b ≤ a) : a < b :=
 ((le_total _ _).resolve_right h).lt_of_not_le h
 
@@ -327,11 +367,39 @@ lemma eq_of_forall_ge_iff [partial_order α] {a b : α}
   (H : ∀ c, a ≤ c ↔ b ≤ c) : a = b :=
 ((H _).2 le_rfl).antisymm ((H _).1 le_rfl)
 
+lemma eq_of_forall_lt_iff [linear_order α] {a b : α} (h : ∀ c, c < a ↔ c < b) : a = b :=
+(le_of_forall_lt $ λ _, (h _).1).antisymm $ le_of_forall_lt $ λ _, (h _).2
+
+lemma eq_of_forall_gt_iff [linear_order α] {a b : α} (h : ∀ c, a < c ↔ b < c) : a = b :=
+(le_of_forall_lt' $ λ _, (h _).2).antisymm $ le_of_forall_lt' $ λ _, (h _).1
+
+/-- A symmetric relation implies two values are equal, when it implies they're less-equal.  -/
+lemma rel_imp_eq_of_rel_imp_le [partial_order β] (r : α → α → Prop) [is_symm α r] {f : α → β}
+  (h : ∀ a b, r a b → f a ≤ f b) {a b : α} : r a b → f a = f b :=
+λ hab, le_antisymm (h a b hab) (h b a $ symm hab)
+
 /-- monotonicity of `≤` with respect to `→` -/
 lemma le_implies_le_of_le_of_le {a b c d : α} [preorder α] (hca : c ≤ a) (hbd : b ≤ d) :
   a ≤ b → c ≤ d :=
 λ hab, (hca.trans hab).trans hbd
 
+section partial_order
+variables [partial_order α]
+
+/-- To prove commutativity of a binary operation `○`, we only to check `a ○ b ≤ b ○ a` for all `a`,
+`b`. -/
+lemma commutative_of_le {f : β → β → α} (comm : ∀ a b, f a b ≤ f b a) : ∀ a b, f a b = f b a :=
+λ a b, (comm _ _).antisymm $ comm _ _
+
+/-- To prove associativity of a commutative binary operation `○`, we only to check
+`(a ○ b) ○ c ≤ a ○ (b ○ c)` for all `a`, `b`, `c`. -/
+lemma associative_of_commutative_of_le {f : α → α → α} (comm : commutative f)
+  (assoc : ∀ a b c, f (f a b) c ≤ f a (f b c)) :
+  associative f :=
+λ a b c, le_antisymm (assoc _ _ _) $ by { rw [comm, comm b, comm _ c, comm a], exact assoc _ _ _ }
+
+end partial_order
+
 @[ext]
 lemma preorder.to_has_le_injective {α : Type*} :
   function.injective (@preorder.to_has_le α) :=
@@ -401,16 +469,6 @@ instance (α : Type*) [h : nonempty α] : nonempty αᵒᵈ := h
 instance (α : Type*) [h : subsingleton α] : subsingleton αᵒᵈ := h
 instance (α : Type*) [has_le α] : has_le αᵒᵈ := ⟨λ x y : α, y ≤ x⟩
 instance (α : Type*) [has_lt α] : has_lt αᵒᵈ := ⟨λ x y : α, y < x⟩
-instance (α : Type*) [has_zero α] : has_zero αᵒᵈ := ⟨(0 : α)⟩
-
--- `dual_le` and `dual_lt` should not be simp lemmas:
--- they cause a loop since `α` and `αᵒᵈ` are definitionally equal
-
-lemma dual_le [has_le α] {a b : α} :
-  @has_le.le αᵒᵈ _ a b ↔ @has_le.le α _ b a := iff.rfl
-
-lemma dual_lt [has_lt α] {a b : α} :
-  @has_lt.lt αᵒᵈ _ a b ↔ @has_lt.lt α _ b a := iff.rfl
 
 instance (α : Type*) [preorder α] : preorder αᵒᵈ :=
 { le_refl          := le_refl,
@@ -428,8 +486,8 @@ instance (α : Type*) [linear_order α] : linear_order αᵒᵈ :=
   decidable_lt := (infer_instance : decidable_rel (λ a b : α, b < a)),
   min := @max α _,
   max := @min α _,
-  min_def := @linear_order.max_def α _,
-  max_def := @linear_order.min_def α _,
+  min_def := funext₂ $ @max_def' α _,
+  max_def := funext₂ $ @min_def' α _,
   .. order_dual.partial_order α }
 
 instance : Π [inhabited α], inhabited αᵒᵈ := id
@@ -448,6 +506,31 @@ linear_order.ext $ λ _ _, iff.rfl
 
 end order_dual
 
+/-! ### `has_compl` -/
+
+/-- Set / lattice complement -/
+@[notation_class] class has_compl (α : Type*) := (compl : α → α)
+
+export has_compl (compl)
+
+postfix `ᶜ`:(max+1) := compl
+
+instance Prop.has_compl : has_compl Prop := ⟨not⟩
+
+instance pi.has_compl {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] :
+  has_compl (Π i, α i) :=
+⟨λ x i, (x i)ᶜ⟩
+
+lemma pi.compl_def {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] (x : Π i, α i) :
+  xᶜ = λ i, (x i)ᶜ := rfl
+
+@[simp]
+lemma pi.compl_apply {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] (x : Π i, α i) (i : ι)  :
+  xᶜ i = (x i)ᶜ := rfl
+
+instance is_irrefl.compl (r) [is_irrefl α r] : is_refl α rᶜ := ⟨@irrefl α r _⟩
+instance is_refl.compl (r) [is_refl α r] : is_irrefl α rᶜ := ⟨λ a, not_not_intro (refl a)⟩
+
 /-! ### Order instances on the function space -/
 
 instance pi.has_le {ι : Type u} {α : ι → Type v} [∀ i, has_le (α i)] : has_le (Π i, α i) :=
@@ -466,25 +549,119 @@ lemma pi.lt_def {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] {x y
   x < y ↔ x ≤ y ∧ ∃ i, x i < y i :=
 by simp [lt_iff_le_not_le, pi.le_def] {contextual := tt}
 
-lemma le_update_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
-  {x y : Π i, α i} {i : ι} {a : α i} :
-  x ≤ function.update y i a ↔ x i ≤ a ∧ ∀ j ≠ i, x j ≤ y j :=
+instance pi.partial_order [Π i, partial_order (π i)] : partial_order (Π i, π i) :=
+{ le_antisymm := λ f g h1 h2, funext $ λ b, (h1 b).antisymm (h2 b),
+  ..pi.preorder }
+
+section pi
+
+/-- A function `a` is strongly less than a function `b`  if `a i < b i` for all `i`. -/
+def strong_lt [Π i, has_lt (π i)] (a b : Π i, π i) : Prop := ∀ i, a i < b i
+
+local infix ` ≺ `:50 := strong_lt
+
+variables [Π i, preorder (π i)] {a b c : Π i, π i}
+
+lemma le_of_strong_lt (h : a ≺ b) : a ≤ b := λ i, (h _).le
+
+lemma lt_of_strong_lt [nonempty ι] (h : a ≺ b) : a < b :=
+by { inhabit ι, exact pi.lt_def.2 ⟨le_of_strong_lt h, default, h _⟩ }
+
+lemma strong_lt_of_strong_lt_of_le (hab : a ≺ b) (hbc : b ≤ c) : a ≺ c :=
+λ i, (hab _).trans_le $ hbc _
+
+lemma strong_lt_of_le_of_strong_lt (hab : a ≤ b) (hbc : b ≺ c) : a ≺ c :=
+λ i, (hab _).trans_lt $ hbc _
+
+alias le_of_strong_lt ← strong_lt.le
+alias lt_of_strong_lt ← strong_lt.lt
+alias strong_lt_of_strong_lt_of_le ← strong_lt.trans_le
+alias strong_lt_of_le_of_strong_lt ← has_le.le.trans_strong_lt
+
+end pi
+
+section function
+variables [decidable_eq ι] [Π i, preorder (π i)] {x y : Π i, π i} {i : ι} {a b : π i}
+
+lemma le_update_iff : x ≤ function.update y i a ↔ x i ≤ a ∧ ∀ j ≠ i, x j ≤ y j :=
 function.forall_update_iff _ (λ j z, x j ≤ z)
 
-lemma update_le_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
-  {x y : Π i, α i} {i : ι} {a : α i} :
-  function.update x i a ≤ y ↔ a ≤ y i ∧ ∀ j ≠ i, x j ≤ y j :=
+lemma update_le_iff : function.update x i a ≤ y ↔ a ≤ y i ∧ ∀ j ≠ i, x j ≤ y j :=
 function.forall_update_iff _ (λ j z, z ≤ y j)
 
-lemma update_le_update_iff {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] [decidable_eq ι]
-  {x y : Π i, α i} {i : ι} {a b : α i} :
+lemma update_le_update_iff :
   function.update x i a ≤ function.update y i b ↔ a ≤ b ∧ ∀ j ≠ i, x j ≤ y j :=
 by simp [update_le_iff] {contextual := tt}
 
-instance pi.partial_order {ι : Type u} {α : ι → Type v} [∀ i, partial_order (α i)] :
-  partial_order (Π i, α i) :=
-{ le_antisymm := λ f g h1 h2, funext (λ b, (h1 b).antisymm (h2 b)),
-  ..pi.preorder }
+@[simp] lemma update_le_update_iff' : update x i a ≤ update x i b ↔ a ≤ b :=
+by simp [update_le_update_iff]
+
+@[simp] lemma update_lt_update_iff : update x i a < update x i b ↔ a < b :=
+lt_iff_lt_of_le_iff_le' update_le_update_iff' update_le_update_iff'
+
+@[simp] lemma le_update_self_iff : x ≤ update x i a ↔ x i ≤ a := by simp [le_update_iff]
+@[simp] lemma update_le_self_iff : update x i a ≤ x ↔ a ≤ x i := by simp [update_le_iff]
+@[simp] lemma lt_update_self_iff : x < update x i a ↔ x i < a := by simp [lt_iff_le_not_le]
+@[simp] lemma update_lt_self_iff : update x i a < x ↔ a < x i := by simp [lt_iff_le_not_le]
+
+end function
+
+instance pi.has_sdiff {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] :
+  has_sdiff (Π i, α i) :=
+⟨λ x y i, x i \ y i⟩
+
+lemma pi.sdiff_def {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] (x y : Π i, α i) :
+  (x \ y) = λ i, x i \ y i := rfl
+
+@[simp]
+lemma pi.sdiff_apply {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] (x y : Π i, α i) (i : ι) :
+  (x \ y) i = x i \ y i := rfl
+
+namespace function
+variables [preorder α] [nonempty β] {a b : α}
+
+@[simp] lemma const_le_const : const β a ≤ const β b ↔ a ≤ b := by simp [pi.le_def]
+@[simp] lemma const_lt_const : const β a < const β b ↔ a < b := by simpa [pi.lt_def] using le_of_lt
+
+end function
+
+/-! ### `min`/`max` recursors -/
+
+section min_max_rec
+
+variables [linear_order α] {p : α → Prop} {x y : α}
+
+lemma min_rec (hx : x ≤ y → p x) (hy : y ≤ x → p y) : p (min x y) :=
+(le_total x y).rec (λ h, (min_eq_left h).symm.subst (hx h))
+  (λ h, (min_eq_right h).symm.subst (hy h))
+
+lemma max_rec (hx : y ≤ x → p x) (hy : x ≤ y → p y) : p (max x y) := @min_rec αᵒᵈ _ _ _ _ hx hy
+lemma min_rec' (p : α → Prop) (hx : p x) (hy : p y) : p (min x y) := min_rec (λ _, hx) (λ _, hy)
+lemma max_rec' (p : α → Prop) (hx : p x) (hy : p y) : p (max x y) := max_rec (λ _, hx) (λ _, hy)
+
+lemma min_def_lt (x y : α) : min x y = if x < y then x else y :=
+begin
+  rw [min_comm, min_def, ← ite_not],
+  simp only [not_le],
+end
+
+lemma max_def_lt (x y : α) : max x y = if x < y then y else x :=
+begin
+  rw [max_comm, max_def, ← ite_not],
+  simp only [not_le],
+end
+
+end min_max_rec
+
+/-! ### `has_sup` and `has_inf` -/
+
+/-- Typeclass for the `⊔` (`\lub`) notation -/
+@[notation_class] class has_sup (α : Type u) := (sup : α → α → α)
+/-- Typeclass for the `⊓` (`\glb`) notation -/
+@[notation_class] class has_inf (α : Type u) := (inf : α → α → α)
+
+infix ` ⊔ ` := has_sup.sup
+infix ` ⊓ ` := has_inf.inf
 
 /-! ### Lifts of order instances -/
 
@@ -504,15 +681,33 @@ function `f : α → β`. See note [reducible non-instances]. -/
 { le_antisymm := λ a b h₁ h₂, inj (h₁.antisymm h₂), .. preorder.lift f }
 
 /-- Transfer a `linear_order` on `β` to a `linear_order` on `α` using an injective
-function `f : α → β`. See note [reducible non-instances]. -/
-@[reducible] def linear_order.lift {α β} [linear_order β] (f : α → β) (inj : injective f) :
+function `f : α → β`. This version takes `[has_sup α]` and `[has_inf α]` as arguments, then uses
+them for `max` and `min` fields. See `linear_order.lift'` for a version that autogenerates `min` and
+`max` fields. See note [reducible non-instances]. -/
+@[reducible] def linear_order.lift {α β} [linear_order β] [has_sup α] [has_inf α] (f : α → β)
+  (inj : injective f) (hsup : ∀ x y, f (x ⊔ y) = max (f x) (f y))
+  (hinf : ∀ x y, f (x ⊓ y) = min (f x) (f y)) :
   linear_order α :=
 { le_total     := λ x y, le_total (f x) (f y),
   decidable_le := λ x y, (infer_instance : decidable (f x ≤ f y)),
   decidable_lt := λ x y, (infer_instance : decidable (f x < f y)),
-  decidable_eq := λ x y, decidable_of_iff _ inj.eq_iff,
+  decidable_eq := λ x y, decidable_of_iff (f x = f y) inj.eq_iff,
+  min := (⊓),
+  max := (⊔),
+  min_def := by { ext x y, apply inj, rw [hinf, min_def, min_default, apply_ite f], refl },
+  max_def := by { ext x y, apply inj, rw [hsup, max_def, max_default, apply_ite f], refl },
   .. partial_order.lift f inj }
 
+/-- Transfer a `linear_order` on `β` to a `linear_order` on `α` using an injective
+function `f : α → β`. This version autogenerates `min` and `max` fields. See `linear_order.lift`
+for a version that takes `[has_sup α]` and `[has_inf α]`, then uses them as `max` and `min`.
+See note [reducible non-instances]. -/
+@[reducible] def linear_order.lift' {α β} [linear_order β] (f : α → β) (inj : injective f) :
+  linear_order α :=
+@linear_order.lift α β _ ⟨λ x y, if f x ≤ f y then y else x⟩ ⟨λ x y, if f x ≤ f y then x else y⟩
+  f inj (λ x y, (apply_ite f _ _ _).trans (max_def _ _).symm)
+  (λ x y, (apply_ite f _ _ _).trans (min_def _ _).symm)
+
 /-! ### Subtype of an order -/
 
 namespace subtype
@@ -540,31 +735,27 @@ instance partial_order [partial_order α] (p : α → Prop) :
   partial_order (subtype p) :=
 partial_order.lift coe subtype.coe_injective
 
-instance decidable_le [preorder α] [@decidable_rel α (≤)] {p : α → Prop} :
+instance decidable_le [preorder α] [h : @decidable_rel α (≤)] {p : α → Prop} :
   @decidable_rel (subtype p) (≤) :=
-λ a b, decidable_of_iff _ subtype.coe_le_coe
+λ a b, h a b
 
-instance decidable_lt [preorder α] [@decidable_rel α (<)] {p : α → Prop} :
+instance decidable_lt [preorder α] [h : @decidable_rel α (<)] {p : α → Prop} :
   @decidable_rel (subtype p) (<) :=
-λ a b, decidable_of_iff _ subtype.coe_lt_coe
+λ a b, h a b
 
 /-- A subtype of a linear order is a linear order. We explicitly give the proofs of decidable
 equality and decidable order in order to ensure the decidability instances are all definitionally
 equal. -/
 instance [linear_order α] (p : α → Prop) : linear_order (subtype p) :=
-{ decidable_eq := subtype.decidable_eq,
-  decidable_le := subtype.decidable_le,
-  decidable_lt := subtype.decidable_lt,
-  max_def := by { ext a b, convert rfl },
-  min_def := by { ext a b, convert rfl },
-  .. linear_order.lift coe subtype.coe_injective }
+@linear_order.lift (subtype p) _ _ ⟨λ x y, ⟨max x y, max_rec' _ x.2 y.2⟩⟩
+  ⟨λ x y, ⟨min x y, min_rec' _ x.2 y.2⟩⟩ coe subtype.coe_injective (λ _ _, rfl) (λ _ _, rfl)
 
 end subtype
 
 /-!
 ### Pointwise order on `α × β`
 
-The lexicographic order is defined in `order.lexicographic`, and the instances are available via the
+The lexicographic order is defined in `data.prod.lex`, and the instances are available via the
 type synonym `α ×ₗ β = α × β`.
 -/
 
@@ -582,20 +773,31 @@ iff.rfl
 @[simp] lemma swap_le_swap [has_le α] [has_le β] {x y : α × β} : x.swap ≤ y.swap ↔ x ≤ y :=
 and_comm _ _
 
+section preorder
+variables [preorder α] [preorder β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}
+
 instance (α : Type u) (β : Type v) [preorder α] [preorder β] : preorder (α × β) :=
 { le_refl  := λ ⟨a, b⟩, ⟨le_refl a, le_refl b⟩,
   le_trans := λ ⟨a, b⟩ ⟨c, d⟩ ⟨e, f⟩ ⟨hac, hbd⟩ ⟨hce, hdf⟩,
     ⟨le_trans hac hce, le_trans hbd hdf⟩,
   .. prod.has_le α β }
 
-@[simp] lemma swap_lt_swap [preorder α] [preorder β] {x y : α × β} : x.swap < y.swap ↔ x < y :=
+@[simp] lemma swap_lt_swap : x.swap < y.swap ↔ x < y :=
 and_congr swap_le_swap (not_congr swap_le_swap)
 
-lemma lt_iff [preorder α] [preorder β] {a b : α × β} :
-  a < b ↔ a.1 < b.1 ∧ a.2 ≤ b.2 ∨ a.1 ≤ b.1 ∧ a.2 < b.2 :=
+lemma mk_le_mk_iff_left : (a₁, b) ≤ (a₂, b) ↔ a₁ ≤ a₂ := and_iff_left le_rfl
+lemma mk_le_mk_iff_right : (a, b₁) ≤ (a, b₂) ↔ b₁ ≤ b₂ := and_iff_right le_rfl
+
+lemma mk_lt_mk_iff_left : (a₁, b) < (a₂, b) ↔ a₁ < a₂ :=
+lt_iff_lt_of_le_iff_le' mk_le_mk_iff_left mk_le_mk_iff_left
+
+lemma mk_lt_mk_iff_right : (a, b₁) < (a, b₂) ↔ b₁ < b₂ :=
+lt_iff_lt_of_le_iff_le' mk_le_mk_iff_right mk_le_mk_iff_right
+
+lemma lt_iff : x < y ↔ x.1 < y.1 ∧ x.2 ≤ y.2 ∨ x.1 ≤ y.1 ∧ x.2 < y.2 :=
 begin
   refine ⟨λ h, _, _⟩,
-  { by_cases h₁ : b.1 ≤ a.1,
+  { by_cases h₁ : y.1 ≤ x.1,
     { exact or.inr ⟨h.1.1, h.1.2.lt_of_not_le $ λ h₂, h.2 ⟨h₁, h₂⟩⟩ },
     { exact or.inl ⟨h.1.1.lt_of_not_le h₁, h.1.2⟩ } },
   { rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩),
@@ -603,9 +805,9 @@ begin
     { exact ⟨⟨h₁, h₂.le⟩, λ h, h₂.not_le h.2⟩ } }
 end
 
-@[simp] lemma mk_lt_mk [preorder α] [preorder β] {x₁ x₂ : α} {y₁ y₂ : β} :
-  (x₁, y₁) < (x₂, y₂) ↔ x₁ < x₂ ∧ y₁ ≤ y₂ ∨ x₁ ≤ x₂ ∧ y₁ < y₂ :=
-lt_iff
+@[simp] lemma mk_lt_mk : (a₁, b₁) < (a₂, b₂) ↔ a₁ < a₂ ∧ b₁ ≤ b₂ ∨ a₁ ≤ a₂ ∧ b₁ < b₂ := lt_iff
+
+end preorder
 
 /-- The pointwise partial order on a product.
     (The lexicographic ordering is defined in order/lexicographic.lean, and the instances are
@@ -620,7 +822,7 @@ end prod
 
 /-! ### Additional order classes -/
 
-/-- An order is dense if there is an element between any pair of distinct elements. -/
+/-- An order is dense if there is an element between any pair of distinct comparable elements. -/
 class densely_ordered (α : Type u) [has_lt α] : Prop :=
 (dense : ∀ a₁ a₂ : α, a₁ < a₂ → ∃ a, a₁ < a ∧ a < a₂)
 
@@ -632,6 +834,32 @@ instance order_dual.densely_ordered (α : Type u) [has_lt α] [densely_ordered 
   densely_ordered αᵒᵈ :=
 ⟨λ a₁ a₂ ha, (@exists_between α _ _ _ _ ha).imp $ λ a, and.symm⟩
 
+@[simp] lemma densely_ordered_order_dual [has_lt α] : densely_ordered αᵒᵈ ↔ densely_ordered α :=
+⟨by { convert @order_dual.densely_ordered αᵒᵈ _, casesI ‹has_lt α›, refl },
+  @order_dual.densely_ordered α _⟩
+
+instance [preorder α] [preorder β] [densely_ordered α] [densely_ordered β] :
+  densely_ordered (α × β) :=
+⟨λ a b, begin
+  simp_rw prod.lt_iff,
+  rintro (⟨h₁, h₂⟩ | ⟨h₁, h₂⟩),
+  { obtain ⟨c, ha, hb⟩ := exists_between h₁,
+    exact ⟨(c, _), or.inl ⟨ha, h₂⟩, or.inl ⟨hb, le_rfl⟩⟩ },
+  { obtain ⟨c, ha, hb⟩ := exists_between h₂,
+    exact ⟨(_, c), or.inr ⟨h₁, ha⟩, or.inr ⟨le_rfl, hb⟩⟩ }
+end⟩
+
+instance {α : ι → Type*} [Π i, preorder (α i)] [Π i, densely_ordered (α i)] :
+  densely_ordered (Π i, α i) :=
+⟨λ a b, begin
+  classical,
+  simp_rw pi.lt_def,
+  rintro ⟨hab, i, hi⟩,
+  obtain ⟨c, ha, hb⟩ := exists_between hi,
+  exact ⟨a.update i c, ⟨le_update_iff.2 ⟨ha.le, λ _ _, le_rfl⟩, i, by rwa update_same⟩,
+    update_le_iff.2 ⟨hb.le, λ _ _, hab _⟩, i, by rwa update_same⟩,
+end⟩
+
 lemma le_of_forall_le_of_dense [linear_order α] [densely_ordered α] {a₁ a₂ : α}
   (h : ∀ a, a₂ < a → a₁ ≤ a) :
   a₁ ≤ a₂ :=
@@ -660,6 +888,57 @@ or_iff_not_imp_left.2 $ λ h,
   ⟨λ a ha₁, le_of_not_gt $ λ ha₂, h ⟨a, ha₁, ha₂⟩,
     λ a ha₂, le_of_not_gt $ λ ha₁, h ⟨a, ha₁, ha₂⟩⟩
 
+/-- If a linear order has no elements `x < y < z`, then it has at most two elements. -/
+lemma eq_or_eq_or_eq_of_forall_not_lt_lt {α : Type*} [linear_order α]
+  (h : ∀ ⦃x y z : α⦄, x < y → y < z → false) (x y z : α) : x = y ∨ y = z ∨ x = z :=
+begin
+  by_contra hne, push_neg at hne,
+  cases hne.1.lt_or_lt with h₁ h₁; cases hne.2.1.lt_or_lt with h₂ h₂;
+    cases hne.2.2.lt_or_lt with h₃ h₃,
+  exacts [h h₁ h₂, h h₂ h₃, h h₃ h₂, h h₃ h₁, h h₁ h₃, h h₂ h₃, h h₁ h₃, h h₂ h₁]
+end
+
+namespace punit
+variables (a b : punit.{u+1})
+
+instance : linear_order punit :=
+by refine_struct
+{ le := λ _ _, true,
+  lt := λ _ _, false,
+  max := λ _ _, star,
+  min := λ _ _, star,
+  decidable_eq := punit.decidable_eq,
+  decidable_le := λ _ _, decidable.true,
+  decidable_lt := λ _ _, decidable.false };
+    intros; trivial <|> simp only [eq_iff_true_of_subsingleton, not_true, and_false] <|>
+      exact or.inl trivial
+
+lemma max_eq : max a b = star := rfl
+lemma min_eq : min a b = star := rfl
+@[simp] protected lemma le : a ≤ b := trivial
+@[simp] lemma not_lt : ¬ a < b := not_false
+
+instance : densely_ordered punit := ⟨λ _ _, false.elim⟩
+
+end punit
+
+section prop
+
+/-- Propositions form a complete boolean algebra, where the `≤` relation is given by implication. -/
+instance Prop.has_le : has_le Prop := ⟨(→)⟩
+
+@[simp] lemma le_Prop_eq : ((≤) : Prop → Prop → Prop) = (→) := rfl
+
+lemma subrelation_iff_le {r s : α → α → Prop} : subrelation r s ↔ r ≤ s := iff.rfl
+
+instance Prop.partial_order : partial_order Prop :=
+{ le_refl      := λ _, id,
+  le_trans     := λ a b c f g, g ∘ f,
+  le_antisymm  := λ a b Hab Hba, propext ⟨Hab, Hba⟩,
+  ..Prop.has_le }
+
+end prop
+
 variables {s : β → β → Prop} {t : γ → γ → Prop}
 
 /-! ### Linear order from a total partial order -/
diff --git a/src/order/boolean_algebra.lean b/src/order/boolean_algebra.lean
index beaa2b5a72bc3..b6772b7ac56b7 100644
--- a/src/order/boolean_algebra.lean
+++ b/src/order/boolean_algebra.lean
@@ -3,10 +3,14 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Bryan Gin-ge Chen
 -/
-import order.bounded_order
+import order.heyting.basic
+
 /-!
 # (Generalized) Boolean algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A Boolean algebra is a bounded distributive lattice with a complement operator. Boolean algebras
 generalize the (classical) logic of propositions and the lattice of subsets of a set.
 
@@ -26,12 +30,8 @@ intervals.)
 
 ## Main declarations
 
-* `has_compl`: a type class for the complement operator
 * `generalized_boolean_algebra`: a type class for generalized Boolean algebras
-* `boolean_algebra.core`: a type class with the minimal assumptions for a Boolean algebras
-* `boolean_algebra`: the main type class for Boolean algebras; it extends both
-  `generalized_boolean_algebra` and `boolean_algebra.core`. An instance of `boolean_algebra` can be
-  obtained from one of `boolean_algebra.core` using `boolean_algebra.of_core`.
+* `boolean_algebra`: a type class for Boolean algebras.
 * `Prop.boolean_algebra`: the Boolean algebra instance on `Prop`
 
 ## Implementation notes
@@ -45,11 +45,6 @@ complement operator `a \ b` for all `a`, `b`. Instead, the postulates there amou
 that for all `a, b : α` where `a ≤ b`, the equations `x ⊔ a = b` and `x ⊓ a = ⊥` have a solution
 `x`. `disjoint.sdiff_unique` proves that this `x` is in fact `b \ a`.
 
-## Notations
-
-* `xᶜ` is notation for `compl x`
-* `x \ y` is notation for `sdiff x y`.
-
 ## References
 
 * 
@@ -78,11 +73,9 @@ Some of the lemmas in this section are from:
 
 -/
 
-export has_sdiff (sdiff)
-
 /-- A generalized Boolean algebra is a distributive lattice with `⊥` and a relative complement
 operation `\` (called `sdiff`, after "set difference") satisfying `(a ⊓ b) ⊔ (a \ b) = a` and
-`(a ⊓ b) ⊓ (a \ b) = b`, i.e. `a \ b` is the complement of `b` in `a`.
+`(a ⊓ b) ⊓ (a \ b) = ⊥`, i.e. `a \ b` is the complement of `b` in `a`.
 
 This is a generalization of Boolean algebras which applies to `finset α` for arbitrary
 (not-necessarily-`fintype`) `α`. -/
@@ -111,7 +104,8 @@ instance generalized_boolean_algebra.to_order_bot : order_bot α :=
 { bot_le := λ a, by { rw [←inf_inf_sdiff a a, inf_assoc], exact inf_le_left },
   ..generalized_boolean_algebra.to_has_bot α }
 
-theorem disjoint_inf_sdiff : disjoint (x ⊓ y) (x \ y) := (inf_inf_sdiff x y).le
+theorem disjoint_inf_sdiff : disjoint (x ⊓ y) (x \ y) :=
+disjoint_iff_inf_le.mpr (inf_inf_sdiff x y).le
 
 -- TODO: in distributive lattices, relative complements are unique when they exist
 theorem sdiff_unique (s : (x ⊓ y) ⊔ z = x) (i : (x ⊓ y) ⊓ z = ⊥) : x \ y = z :=
@@ -123,43 +117,17 @@ begin
   exact (eq_of_inf_eq_sup_eq i s).symm,
 end
 
-lemma sdiff_le : x \ y ≤ x :=
+-- Use `sdiff_le`
+private lemma sdiff_le' : x \ y ≤ x :=
 calc x \ y ≤ (x ⊓ y) ⊔ (x \ y) : le_sup_right
        ... = x                 : sup_inf_sdiff x y
 
-@[simp] lemma bot_sdiff : ⊥ \ x = ⊥ := le_bot_iff.1 sdiff_le
-
-lemma inf_sdiff_right : x ⊓ (x \ y) = x \ y := by rw [inf_of_le_right (@sdiff_le _ x y _)]
-lemma inf_sdiff_left : (x \ y) ⊓ x = x \ y := by rw [inf_comm, inf_sdiff_right]
-
--- cf. `is_compl_top_bot`
-@[simp] lemma sdiff_self : x \ x = ⊥ :=
-by rw [←inf_inf_sdiff, inf_idem, inf_of_le_right (@sdiff_le _ x x _)]
-
-@[simp] theorem sup_sdiff_self_right : x ⊔ (y \ x) = x ⊔ y :=
-calc x ⊔ (y \ x) = (x ⊔ (x ⊓ y)) ⊔ (y \ x) : by rw sup_inf_self
-             ... = x ⊔ ((y ⊓ x) ⊔ (y \ x)) : by ac_refl
-             ... = x ⊔ y                   : by rw sup_inf_sdiff
-
-@[simp] theorem sup_sdiff_self_left : (y \ x) ⊔ x = y ⊔ x :=
-by rw [sup_comm, sup_sdiff_self_right, sup_comm]
-
-lemma sup_sdiff_symm : x ⊔ (y \ x) = y ⊔ (x \ y) :=
-by rw [sup_sdiff_self_right, sup_sdiff_self_right, sup_comm]
-
-lemma sup_sdiff_cancel_right (h : x ≤ y) : x ⊔ (y \ x) = y :=
-by conv_rhs { rw [←sup_inf_sdiff y x, inf_eq_right.2 h] }
-
-lemma sdiff_sup_cancel (h : y ≤ x) : x \ y ⊔ y = x := by rw [sup_comm, sup_sdiff_cancel_right h]
-
-lemma sup_le_of_le_sdiff_left (h : y ≤ z \ x) (hxz : x ≤ z) : x ⊔ y ≤ z :=
-(sup_le_sup_left h x).trans (sup_sdiff_cancel_right hxz).le
+-- Use `sdiff_sup_self`
+private lemma sdiff_sup_self' : y \ x ⊔ x = y ⊔ x :=
+calc y \ x ⊔ x = y \ x ⊔ (x ⊔ x ⊓ y) : by rw sup_inf_self
+           ... = (y ⊓ x) ⊔ y \ x ⊔ x : by ac_refl
+           ... = y ⊔ x                   : by rw sup_inf_sdiff
 
-lemma sup_le_of_le_sdiff_right (h : x ≤ z \ y) (hyz : y ≤ z) : x ⊔ y ≤ z :=
-(sup_le_sup_right h y).trans (sdiff_sup_cancel hyz).le
-
-@[simp] lemma sup_sdiff_left : x ⊔ (x \ y) = x := by { rw sup_eq_left, exact sdiff_le }
-lemma sup_sdiff_right : (x \ y) ⊔ x = x := by rw [sup_comm, sup_sdiff_left]
 
 @[simp] lemma sdiff_inf_sdiff : x \ y ⊓ (y \ x) = ⊥ :=
 eq.symm $
@@ -171,15 +139,9 @@ eq.symm $
      ... = (x ⊓ y ⊓ (x \ y)) ⊔ (x ⊓ (y \ x) ⊓ (x \ y)) : by rw [inf_sup_right, @inf_comm _ _ x y]
      ... = x ⊓ (y \ x) ⊓ (x \ y)                       : by rw [inf_inf_sdiff, bot_sup_eq]
      ... = x ⊓ (x \ y) ⊓ (y \ x)                       : by ac_refl
-     ... = (x \ y) ⊓ (y \ x)                           : by rw inf_sdiff_right
-
-lemma disjoint_sdiff_sdiff : disjoint (x \ y) (y \ x) := sdiff_inf_sdiff.le
-
-theorem le_sup_sdiff : y ≤ x ⊔ (y \ x) :=
-by { rw [sup_sdiff_self_right], exact le_sup_right }
+     ... = (x \ y) ⊓ (y \ x)                           : by rw inf_of_le_right sdiff_le'
 
-theorem le_sdiff_sup : y ≤ (y \ x) ⊔ x :=
-by { rw [sup_comm], exact le_sup_sdiff }
+lemma disjoint_sdiff_sdiff : disjoint (x \ y) (y \ x) := disjoint_iff_inf_le.mpr sdiff_inf_sdiff.le
 
 @[simp] theorem inf_sdiff_self_right : x ⊓ (y \ x) = ⊥ :=
 calc x ⊓ (y \ x) = ((x ⊓ y) ⊔ (x \ y)) ⊓ (y \ x)         : by rw sup_inf_sdiff
@@ -187,11 +149,39 @@ calc x ⊓ (y \ x) = ((x ⊓ y) ⊔ (x \ y)) ⊓ (y \ x)         : by rw sup_inf
              ... = ⊥         : by rw [@inf_comm _ _ x y, inf_inf_sdiff, sdiff_inf_sdiff, bot_sup_eq]
 @[simp] theorem inf_sdiff_self_left : (y \ x) ⊓ x = ⊥ := by rw [inf_comm, inf_sdiff_self_right]
 
-theorem disjoint_sdiff_self_left : disjoint (y \ x) x := inf_sdiff_self_left.le
-theorem disjoint_sdiff_self_right : disjoint x (y \ x) := inf_sdiff_self_right.le
-
-lemma disjoint.disjoint_sdiff_left (h : disjoint x y) : disjoint (x \ z) y := h.mono_left sdiff_le
-lemma disjoint.disjoint_sdiff_right (h : disjoint x y) : disjoint x (y \ z) := h.mono_right sdiff_le
+@[priority 100] -- see Note [lower instance priority]
+instance generalized_boolean_algebra.to_generalized_coheyting_algebra :
+  generalized_coheyting_algebra α :=
+{ sdiff := (\),
+  sdiff_le_iff := λ y x z, ⟨λ h, le_of_inf_le_sup_le
+    (le_of_eq
+      (calc y ⊓ (y \ x) = y \ x                         : inf_of_le_right sdiff_le'
+                    ... = (x ⊓ (y \ x)) ⊔ (z ⊓ (y \ x))
+                        : by rw [inf_eq_right.2 h, inf_sdiff_self_right, bot_sup_eq]
+                    ... = (x ⊔ z) ⊓ (y \ x)             : inf_sup_right.symm))
+    (calc y ⊔ y \ x = y                 : sup_of_le_left sdiff_le'
+                ... ≤ y ⊔ (x ⊔ z)       : le_sup_left
+                ... = ((y \ x) ⊔ x) ⊔ z : by rw [←sup_assoc, ←@sdiff_sup_self' _ x y]
+                ... = x ⊔ z ⊔ y \ x     : by ac_refl),
+   λ h, le_of_inf_le_sup_le
+    (calc y \ x ⊓ x = ⊥     : inf_sdiff_self_left
+                ... ≤ z ⊓ x : bot_le)
+    (calc y \ x ⊔ x = y ⊔ x       : sdiff_sup_self'
+                ... ≤ (x ⊔ z) ⊔ x : sup_le_sup_right h x
+                ... ≤ z ⊔ x       : by rw [sup_assoc, sup_comm, sup_assoc, sup_idem])⟩,
+  ..‹generalized_boolean_algebra α›, ..generalized_boolean_algebra.to_order_bot }
+
+theorem disjoint_sdiff_self_left : disjoint (y \ x) x :=
+disjoint_iff_inf_le.mpr inf_sdiff_self_left.le
+theorem disjoint_sdiff_self_right : disjoint x (y \ x) :=
+disjoint_iff_inf_le.mpr inf_sdiff_self_right.le
+
+lemma le_sdiff : x ≤ y \ z ↔ x ≤ y ∧ disjoint x z :=
+⟨λ h, ⟨h.trans sdiff_le, disjoint_sdiff_self_left.mono_left h⟩, λ h,
+  by { rw ←h.2.sdiff_eq_left, exact sdiff_le_sdiff_right h.1 }⟩
+
+@[simp] lemma sdiff_eq_left : x \ y = x ↔ disjoint x y :=
+⟨λ h, disjoint_sdiff_self_left.mono_left h.ge, disjoint.sdiff_eq_left⟩
 
 /- TODO: we could make an alternative constructor for `generalized_boolean_algebra` using
 `disjoint x (y \ x)` and `x ⊔ (y \ x) = y` as axioms. -/
@@ -199,11 +189,6 @@ theorem disjoint.sdiff_eq_of_sup_eq (hi : disjoint x z) (hs : x ⊔ z = y) : y \
 have h : y ⊓ x = x := inf_eq_right.2 $ le_sup_left.trans hs.le,
 sdiff_unique (by rw [h, hs]) (by rw [h, hi.eq_bot])
 
-lemma disjoint.sup_sdiff_cancel_left (h : disjoint x y) : (x ⊔ y) \ x = y :=
-h.sdiff_eq_of_sup_eq rfl
-lemma disjoint.sup_sdiff_cancel_right (h : disjoint x y) : (x ⊔ y) \ y = x :=
-h.symm.sdiff_eq_of_sup_eq sup_comm
-
 protected theorem disjoint.sdiff_unique (hd : disjoint x z) (hz : z ≤ y) (hs : y ≤ x ⊔ z) :
   y \ x = z :=
 sdiff_unique
@@ -217,7 +202,7 @@ sdiff_unique
 -- cf. `is_compl.disjoint_left_iff` and `is_compl.disjoint_right_iff`
 lemma disjoint_sdiff_iff_le (hz : z ≤ y) (hx : x ≤ y) : disjoint z (y \ x) ↔ z ≤ x :=
 ⟨λ H, le_of_inf_le_sup_le
-    (le_trans H bot_le)
+    (le_trans H.le_bot bot_le)
     (begin
       rw sup_sdiff_cancel_right hx,
       refine le_trans (sup_le_sup_left sdiff_le z) _,
@@ -253,10 +238,6 @@ lemma le_iff_eq_sup_sdiff (hz : z ≤ y) (hx : x ≤ y) : x ≤ z ↔ y = z ⊔
     exact bot_le,
   end⟩
 
--- cf. `set.union_diff_cancel'`
-lemma sup_sdiff_cancel' (hx : x ≤ z) (hz : z ≤ y) : z ⊔ (y \ x) = y :=
-((le_iff_eq_sup_sdiff hz (hx.trans hz)).1 hx).symm
-
 -- cf. `is_compl.sup_inf`
 lemma sdiff_sup : y \ (x ⊔ z) = (y \ x) ⊓ (y \ z) :=
 sdiff_unique
@@ -274,40 +255,11 @@ sdiff_unique
   ... = ⊥ : by rw [inf_inf_sdiff, bot_inf_eq, bot_sup_eq, @inf_comm _ _ (y \ z), inf_inf_sdiff,
               inf_bot_eq])
 
--- cf. `is_compl.inf_sup`
-lemma sdiff_inf : y \ (x ⊓ z) = y \ x ⊔ y \ z :=
-sdiff_unique
-  (calc y ⊓ (x ⊓ z) ⊔ (y \ x ⊔ y \ z) =
-        (z ⊓ (y ⊓ x)) ⊔ (y \ x ⊔ y \ z)                     : by ac_refl
-  ... = (z ⊔ (y \ x ⊔ y \ z)) ⊓ ((y ⊓ x) ⊔ (y \ x ⊔ y \ z)) : by rw sup_inf_right
-  ... = (y \ x ⊔ (y \ z ⊔ z)) ⊓ (y ⊓ x ⊔ (y \ x ⊔ y \ z))   : by ac_refl
-  ... = (y ⊔ z) ⊓ ((y ⊓ x) ⊔ (y \ x ⊔ y \ z)) :
-                                            by rw [sup_sdiff_self_left, ←sup_assoc, sup_sdiff_right]
-  ... = (y ⊔ z) ⊓ y                              : by rw [←sup_assoc, sup_inf_sdiff, sup_sdiff_left]
-  ... = y                                                   : by rw [inf_comm, inf_sup_self])
-  (calc y ⊓ (x ⊓ z) ⊓ ((y \ x) ⊔ (y \ z)) =
-        (y ⊓ (x ⊓ z) ⊓ (y \ x)) ⊔ (y ⊓ (x ⊓ z) ⊓ (y \ z)) : by rw inf_sup_left
-  ... = z ⊓ (y ⊓ x ⊓ (y \ x)) ⊔ z ⊓ (y ⊓ x) ⊓ (y \ z)     : by ac_refl
-  ... = z ⊓ (y ⊓ x) ⊓ (y \ z)                        : by rw [inf_inf_sdiff, inf_bot_eq, bot_sup_eq]
-  ... = x ⊓ ((y ⊓ z) ⊓ (y \ z))                           : by ac_refl
-  ... = ⊥                                                 : by rw [inf_inf_sdiff, inf_bot_eq])
-
-@[simp] lemma sdiff_inf_self_right : y \ (x ⊓ y) = y \ x :=
-by rw [sdiff_inf, sdiff_self, sup_bot_eq]
-@[simp] lemma sdiff_inf_self_left : y \ (y ⊓ x) = y \ x := by rw [inf_comm, sdiff_inf_self_right]
-
 lemma sdiff_eq_sdiff_iff_inf_eq_inf : y \ x = y \ z ↔ y ⊓ x = y ⊓ z :=
 ⟨λ h, eq_of_inf_eq_sup_eq
   (by rw [inf_inf_sdiff, h, inf_inf_sdiff])
   (by rw [sup_inf_sdiff, h, sup_inf_sdiff]),
- λ h, by rw [←sdiff_inf_self_right, ←@sdiff_inf_self_right _ z y, inf_comm, h, inf_comm]⟩
-
-theorem disjoint.sdiff_eq_left (h : disjoint x y) : x \ y = x :=
-by conv_rhs { rw [←sup_inf_sdiff x y, h.eq_bot, bot_sup_eq] }
-theorem disjoint.sdiff_eq_right (h : disjoint x y) : y \ x = y := h.symm.sdiff_eq_left
-
--- cf. `is_compl_bot_top`
-@[simp] theorem sdiff_bot : x \ ⊥ = x := disjoint_bot_right.sdiff_eq_left
+ λ h, by rw [←sdiff_inf_self_right, ←sdiff_inf_self_right z y, inf_comm, h, inf_comm]⟩
 
 theorem sdiff_eq_self_iff_disjoint : x \ y = x ↔ disjoint y x :=
 calc x \ y = x ↔ x \ y = x \ ⊥ : by rw sdiff_bot
@@ -325,63 +277,9 @@ begin
   rw [←h, inf_eq_right.mpr hx],
 end
 
--- cf. `is_compl.antitone`
-lemma sdiff_le_sdiff_left (h : z ≤ x) : w \ x ≤ w \ z :=
-le_of_inf_le_sup_le
-  (calc (w \ x) ⊓ (w ⊓ z) ≤ (w \ x) ⊓ (w ⊓ x) : inf_le_inf le_rfl (inf_le_inf le_rfl h)
-              ... = ⊥                         : by rw [inf_comm, inf_inf_sdiff]
-              ... ≤ (w \ z) ⊓ (w ⊓ z)         : bot_le)
-  (calc w \ x ⊔ (w ⊓ z) ≤ w \ x ⊔ (w ⊓ x)   : sup_le_sup le_rfl (inf_le_inf le_rfl h)
-                    ... ≤ w                 : by rw [sup_comm, sup_inf_sdiff]
-                    ... = (w \ z) ⊔ (w ⊓ z) : by rw [sup_comm, sup_inf_sdiff])
-
-lemma sdiff_le_iff : y \ x ≤ z ↔ y ≤ x ⊔ z :=
-⟨λ h, le_of_inf_le_sup_le
-  (le_of_eq
-    (calc y ⊓ (y \ x) = y \ x                         : inf_sdiff_right
-                  ... = (x ⊓ (y \ x)) ⊔ (z ⊓ (y \ x)) :
-                                          by rw [inf_eq_right.2 h, inf_sdiff_self_right, bot_sup_eq]
-                  ... = (x ⊔ z) ⊓ (y \ x)             : inf_sup_right.symm))
-  (calc y ⊔ y \ x = y                 : sup_sdiff_left
-              ... ≤ y ⊔ (x ⊔ z)       : le_sup_left
-              ... = ((y \ x) ⊔ x) ⊔ z : by rw [←sup_assoc, ←@sup_sdiff_self_left _ x y]
-              ... = x ⊔ z ⊔ y \ x     : by ac_refl),
- λ h, le_of_inf_le_sup_le
-  (calc y \ x ⊓ x = ⊥     : inf_sdiff_self_left
-              ... ≤ z ⊓ x : bot_le)
-  (calc y \ x ⊔ x = y ⊔ x       : sup_sdiff_self_left
-              ... ≤ (x ⊔ z) ⊔ x : sup_le_sup_right h x
-              ... ≤ z ⊔ x       : by rw [sup_assoc, sup_comm, sup_assoc, sup_idem])⟩
-
-lemma sdiff_sdiff_le : x \ (x \ y) ≤ y := sdiff_le_iff.2 le_sdiff_sup
-
 @[simp] lemma le_sdiff_iff : x ≤ y \ x ↔ x = ⊥ :=
 ⟨λ h, disjoint_self.1 (disjoint_sdiff_self_right.mono_right h), λ h, h.le.trans bot_le⟩
 
-@[simp] lemma sdiff_eq_bot_iff : y \ x = ⊥ ↔ y ≤ x :=
-by rw [←le_bot_iff, sdiff_le_iff, sup_bot_eq]
-
-lemma sdiff_le_comm : x \ y ≤ z ↔ x \ z ≤ y :=
-by rw [sdiff_le_iff, sup_comm, sdiff_le_iff]
-
-lemma sdiff_le_sdiff_right (h : w ≤ y) : w \ x ≤ y \ x :=
-le_of_inf_le_sup_le
-  (calc (w \ x) ⊓ (w ⊓ x) = ⊥                 : by rw [inf_comm, inf_inf_sdiff]
-                      ... ≤ (y \ x) ⊓ (w ⊓ x) : bot_le)
-  (calc w \ x ⊔ (w ⊓ x) = w                       : by rw [sup_comm, sup_inf_sdiff]
-                    ... ≤ (y ⊓ (y \ x)) ⊔ w       : le_sup_right
-                    ... = (y ⊓ (y \ x)) ⊔ (y ⊓ w) : by rw inf_eq_right.2 h
-                    ... = y ⊓ ((y \ x) ⊔ w)       : by rw inf_sup_left
-                    ... = ((y \ x) ⊔ (y ⊓ x)) ⊓ ((y \ x) ⊔ w) :
-                                                by rw [@sup_comm _ _ (y \ x) (y ⊓ x), sup_inf_sdiff]
-                    ... = (y \ x) ⊔ ((y ⊓ x) ⊓ w) : by rw ←sup_inf_left
-                    ... = (y \ x) ⊔ ((w ⊓ y) ⊓ x) : by ac_refl
-                    ... = (y \ x) ⊔ (w ⊓ x)       : by rw inf_eq_left.2 h)
-
-theorem sdiff_le_sdiff (h₁ : w ≤ y) (h₂ : z ≤ x) : w \ x ≤ y \ z :=
-calc w \ x ≤ w \ z : sdiff_le_sdiff_left h₂
-       ... ≤ y \ z : sdiff_le_sdiff_right h₁
-
 lemma sdiff_lt_sdiff_right (h : x < y) (hz : z ≤ x) : x \ z < y \ z :=
 (sdiff_le_sdiff_right h.le).lt_of_not_le $ λ h', h.not_le $
   le_sdiff_sup.trans $ sup_le_of_le_sdiff_right h' hz
@@ -391,11 +289,6 @@ calc (x ⊓ y) ⊓ z ⊔ (y \ z) = x ⊓ (y ⊓ z) ⊔ (y \ z) : by rw inf_assoc
                        ... = (x ⊔ (y \ z)) ⊓ y     : by rw [sup_inf_right, sup_inf_sdiff]
                        ... = (x ⊓ y) ⊔ (y \ z)     : by rw [inf_sup_right, inf_sdiff_left]
 
-@[simp] lemma inf_sdiff_sup_left : (x \ z) ⊓ (x ⊔ y) = x \ z :=
-by rw [inf_sup_left, inf_sdiff_left, sup_inf_self]
-@[simp] lemma inf_sdiff_sup_right : (x \ z) ⊓ (y ⊔ x) = x \ z :=
-by rw [sup_comm, inf_sdiff_sup_left]
-
 lemma sdiff_sdiff_right : x \ (y \ z) = (x \ y) ⊔ (x ⊓ y ⊓ z) :=
 begin
   rw [sup_comm, inf_comm, ←inf_assoc, sup_inf_inf_sdiff],
@@ -405,7 +298,7 @@ begin
     ... = (x ⊔ x ⊓ z ⊔ x \ y) ⊓ (y \ z ⊔ (x ⊓ z ⊔ x \ y))   : by ac_refl
     ... = x ⊓ (y \ z ⊔ x ⊓ z ⊔ x \ y)             : by rw [sup_inf_self, sup_sdiff_left, ←sup_assoc]
     ... = x ⊓ (y \ z ⊓ (z ⊔ y) ⊔ x ⊓ (z ⊔ y) ⊔ x \ y) :
-                           by rw [sup_inf_left, sup_sdiff_self_left, inf_sup_right, @sup_comm _ _ y]
+                          by rw [sup_inf_left, sdiff_sup_self', inf_sup_right, @sup_comm _ _ y]
     ... = x ⊓ (y \ z ⊔ (x ⊓ z ⊔ x ⊓ y) ⊔ x \ y) :
                                                 by rw [inf_sdiff_sup_right, @inf_sup_left _ _ x z y]
     ... = x ⊓ (y \ z ⊔ (x ⊓ z ⊔ (x ⊓ y ⊔ x \ y)))           : by ac_refl
@@ -441,24 +334,9 @@ lemma sdiff_eq_comm (hy : y ≤ x) (hz : z ≤ x) : x \ y = z ↔ x \ z = y :=
 lemma eq_of_sdiff_eq_sdiff (hxz : x ≤ z) (hyz : y ≤ z) (h : z \ x = z \ y) : x = y :=
 by rw [←sdiff_sdiff_eq_self hxz, h, sdiff_sdiff_eq_self hyz]
 
-lemma sdiff_sdiff_left : (x \ y) \ z = x \ (y ⊔ z) :=
-begin
-  rw sdiff_sup,
-  apply sdiff_unique,
-  { rw [←inf_sup_left, sup_sdiff_self_right, inf_sdiff_sup_right] },
-  { rw [inf_assoc, @inf_comm _ _ z, inf_assoc, inf_sdiff_self_left, inf_bot_eq, inf_bot_eq] }
-end
-
 lemma sdiff_sdiff_left' : (x \ y) \ z = (x \ y) ⊓ (x \ z) :=
 by rw [sdiff_sdiff_left, sdiff_sup]
 
-lemma sdiff_sdiff_comm : (x \ y) \ z = (x \ z) \ y :=
-by rw [sdiff_sdiff_left, sup_comm, sdiff_sdiff_left]
-
-@[simp] lemma sdiff_idem : x \ y \ y = x \ y := by rw [sdiff_sdiff_left, sup_idem]
-
-@[simp] lemma sdiff_sdiff_self : x \ y \ x = ⊥ := by rw [sdiff_sdiff_comm, sdiff_self, bot_sdiff]
-
 lemma sdiff_sdiff_sup_sdiff : z \ (x \ y ⊔ y \ x) = z ⊓ (z \ x ⊔ y) ⊓ (z \ y ⊔ x) :=
 calc z \ (x \ y ⊔ y \ x) = (z \ x ⊔ z ⊓ x ⊓ y) ⊓ (z \ y ⊔ z ⊓ y ⊓ x) :
                                              by rw [sdiff_sup, sdiff_sdiff_right, sdiff_sdiff_right]
@@ -476,29 +354,6 @@ calc z \ (x \ y ⊔ y \ x) =
 ... = (z \ x) ⊓ (z \ y) ⊔ z ⊓ y ⊓ x             : sup_inf_right.symm
 ... = z ⊓ x ⊓ y ⊔ ((z \ x) ⊓ (z \ y))           : by ac_refl
 
-lemma sup_sdiff : (x ⊔ y) \ z = (x \ z) ⊔ (y \ z) :=
-sdiff_unique
-  (calc (x ⊔ y) ⊓ z ⊔ (x \ z ⊔ y \ z) =
-        (x ⊓ z ⊔ y ⊓ z) ⊔ (x \ z ⊔ y \ z) : by rw inf_sup_right
-  ... = x ⊓ z ⊔ x \ z ⊔ y \ z ⊔ y ⊓ z     : by ac_refl
-  ... = x ⊔ (y ⊓ z ⊔ y \ z)               : by rw [sup_inf_sdiff, sup_assoc, @sup_comm _ _ (y \ z)]
-  ... = x ⊔ y                             : by rw sup_inf_sdiff)
-  (calc (x ⊔ y) ⊓ z ⊓ (x \ z ⊔ y \ z) =
-        (x ⊓ z ⊔ y ⊓ z) ⊓ (x \ z ⊔ y \ z)                       : by rw inf_sup_right
-  ... = (x ⊓ z ⊔ y ⊓ z) ⊓ (x \ z) ⊔ ((x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)) :
-                                                           by rw [@inf_sup_left _ _ (x ⊓ z ⊔ y ⊓ z)]
-  ... = (y ⊓ z ⊓ (x \ z)) ⊔ ((x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)) :
-                                                    by rw [inf_sup_right, inf_inf_sdiff, bot_sup_eq]
-  ... = (x ⊓ z ⊔ y ⊓ z) ⊓ (y \ z)  : by rw [inf_assoc, inf_sdiff_self_right, inf_bot_eq, bot_sup_eq]
-  ... = x ⊓ z ⊓ (y \ z)                           : by rw [inf_sup_right, inf_inf_sdiff, sup_bot_eq]
-  ... = ⊥                                     : by rw [inf_assoc, inf_sdiff_self_right, inf_bot_eq])
-
-lemma sup_sdiff_right_self : (x ⊔ y) \ y = x \ y :=
-by rw [sup_sdiff, sdiff_self, sup_bot_eq]
-
-lemma sup_sdiff_left_self : (x ⊔ y) \ x = y \ x :=
-by rw [sup_comm, sup_sdiff_right_self]
-
 lemma inf_sdiff : (x ⊓ y) \ z = (x \ z) ⊓ (y \ z) :=
 sdiff_unique
   (calc (x ⊓ y) ⊓ z ⊔ ((x \ z) ⊓ (y \ z)) =
@@ -530,9 +385,8 @@ by rw [sdiff_inf, sdiff_eq_bot_iff.2 inf_le_left, bot_sup_eq, inf_sdiff_assoc]
 lemma inf_sdiff_distrib_right (a b c : α) : a \ b ⊓ c = (a ⊓ c) \ (b ⊓ c) :=
 by simp_rw [@inf_comm _ _ _ c, inf_sdiff_distrib_left]
 
-lemma sdiff_sup_sdiff_cancel (hyx : y ≤ x) (hzy : z ≤ y) : x \ y ⊔ y \ z = x \ z :=
-by rw [←sup_sdiff_inf (x \ z) y, sdiff_sdiff_left, sup_eq_right.2 hzy, inf_sdiff_right_comm,
-  inf_eq_right.2 hyx]
+lemma disjoint_sdiff_comm : disjoint (x \ z) y ↔ disjoint x (y \ z) :=
+by simp_rw [disjoint_iff, inf_sdiff_right_comm, inf_sdiff_assoc]
 
 lemma sup_eq_sdiff_sup_sdiff_sup_inf : x ⊔ y = (x \ y) ⊔ (y \ x) ⊔ (x ⊓ y) :=
 eq.symm $
@@ -542,18 +396,6 @@ eq.symm $
   ... = (x ⊔ (y \ x)) ⊓ ((x \ y) ⊔ y)                     : by rw [sup_sdiff_right, sup_sdiff_right]
   ... = x ⊔ y                          : by rw [sup_sdiff_self_right, sup_sdiff_self_left, inf_idem]
 
-lemma sdiff_le_sdiff_of_sup_le_sup_left (h : z ⊔ x ≤ z ⊔ y) : x \ z ≤ y \ z :=
-begin
-  rw [←sup_sdiff_left_self, ←@sup_sdiff_left_self _ _ y],
-  exact sdiff_le_sdiff_right h,
-end
-
-lemma sdiff_le_sdiff_of_sup_le_sup_right (h : x ⊔ z ≤ y ⊔ z) : x \ z ≤ y \ z :=
-begin
-  rw [←sup_sdiff_right_self, ←@sup_sdiff_right_self _ y],
-  exact sdiff_le_sdiff_right h,
-end
-
 lemma sup_lt_of_lt_sdiff_left (h : y < z \ x) (hxz : x ≤ z) : x ⊔ y < z :=
 begin
   rw ←sup_sdiff_cancel_right hxz,
@@ -579,57 +421,76 @@ end generalized_boolean_algebra
 /-!
 ### Boolean algebras
 -/
+/-- A Boolean algebra is a bounded distributive lattice with a complement operator `ᶜ` such that
+`x ⊓ xᶜ = ⊥` and `x ⊔ xᶜ = ⊤`. For convenience, it must also provide a set difference operation `\`
+and a Heyting implication `⇨` satisfying `x \ y = x ⊓ yᶜ` and `x ⇨ y = y ⊔ xᶜ`.
 
-
-/-- Set / lattice complement -/
-@[notation_class] class has_compl (α : Type*) := (compl : α → α)
-
-export has_compl (compl)
-
-postfix `ᶜ`:(max+1) := compl
-
-/-- This class contains the core axioms of a Boolean algebra. The `boolean_algebra` class extends
-both this class and `generalized_boolean_algebra`, see Note [forgetful inheritance].
+This is a generalization of (classical) logic of propositions, or the powerset lattice.
 
 Since `bounded_order`, `order_bot`, and `order_top` are mixins that require `has_le`
 to be present at define-time, the `extends` mechanism does not work with them.
 Instead, we extend using the underlying `has_bot` and `has_top` data typeclasses, and replicate the
 order axioms of those classes here. A "forgetful" instance back to `bounded_order` is provided.
 -/
-class boolean_algebra.core (α : Type u) extends distrib_lattice α, has_compl α,
+class boolean_algebra (α : Type u) extends distrib_lattice α, has_compl α, has_sdiff α, has_himp α,
   has_top α, has_bot α :=
 (inf_compl_le_bot : ∀x:α, x ⊓ xᶜ ≤ ⊥)
 (top_le_sup_compl : ∀x:α, ⊤ ≤ x ⊔ xᶜ)
 (le_top : ∀ a : α, a ≤ ⊤)
 (bot_le : ∀ a : α, ⊥ ≤ a)
+(sdiff := λ x y, x ⊓ yᶜ)
+(himp := λ x y, y ⊔ xᶜ)
+(sdiff_eq : ∀ x y : α, x \ y = x ⊓ yᶜ . obviously)
+(himp_eq : ∀ x y : α, x ⇨ y = y ⊔ xᶜ . obviously)
 
-@[priority 100]  -- see Note [lower instance priority]
-instance boolean_algebra.core.to_bounded_order [h : boolean_algebra.core α] : bounded_order α :=
+@[priority 100] -- see Note [lower instance priority]
+instance boolean_algebra.to_bounded_order [h : boolean_algebra α] : bounded_order α :=
 { ..h }
 
-section boolean_algebra_core
-variables [boolean_algebra.core α]
+/-- A bounded generalized boolean algebra is a boolean algebra. -/
+@[reducible] -- See note [reducible non instances]
+def generalized_boolean_algebra.to_boolean_algebra [generalized_boolean_algebra α] [order_top α] :
+  boolean_algebra α :=
+{ compl := λ a, ⊤ \ a,
+  inf_compl_le_bot := λ _, disjoint_sdiff_self_right.le_bot,
+  top_le_sup_compl := λ _, le_sup_sdiff,
+  sdiff_eq := λ _ _, by { rw [←inf_sdiff_assoc, inf_top_eq], refl },
+  ..‹generalized_boolean_algebra α›, ..generalized_boolean_algebra.to_order_bot, ..‹order_top α› }
+
+section boolean_algebra
+variables [boolean_algebra α]
 
-@[simp] theorem inf_compl_eq_bot : x ⊓ xᶜ = ⊥ :=
-bot_unique $ boolean_algebra.core.inf_compl_le_bot x
+@[simp] lemma inf_compl_eq_bot' : x ⊓ xᶜ = ⊥ := bot_unique $ boolean_algebra.inf_compl_le_bot x
+@[simp] lemma sup_compl_eq_top : x ⊔ xᶜ = ⊤ := top_unique $ boolean_algebra.top_le_sup_compl x
+@[simp] lemma compl_sup_eq_top : xᶜ ⊔ x = ⊤ := sup_comm.trans sup_compl_eq_top
 
-@[simp] theorem compl_inf_eq_bot : xᶜ ⊓ x = ⊥ :=
-eq.trans inf_comm inf_compl_eq_bot
+lemma is_compl_compl : is_compl x xᶜ := is_compl.of_eq inf_compl_eq_bot' sup_compl_eq_top
 
-@[simp] theorem sup_compl_eq_top : x ⊔ xᶜ = ⊤ :=
-top_unique $ boolean_algebra.core.top_le_sup_compl x
+lemma sdiff_eq : x \ y = x ⊓ yᶜ := boolean_algebra.sdiff_eq x y
+lemma himp_eq : x ⇨ y = y ⊔ xᶜ := boolean_algebra.himp_eq x y
+
+@[priority 100]
+instance boolean_algebra.to_complemented_lattice : complemented_lattice α :=
+⟨λ x, ⟨xᶜ, is_compl_compl⟩⟩
 
-@[simp] theorem compl_sup_eq_top : xᶜ ⊔ x = ⊤ :=
-eq.trans sup_comm sup_compl_eq_top
+@[priority 100] -- see Note [lower instance priority]
+instance boolean_algebra.to_generalized_boolean_algebra : generalized_boolean_algebra α :=
+{ sup_inf_sdiff := λ a b, by rw [sdiff_eq, ←inf_sup_left, sup_compl_eq_top, inf_top_eq],
+  inf_inf_sdiff := λ a b, by { rw [sdiff_eq, ←inf_inf_distrib_left, inf_compl_eq_bot', inf_bot_eq],
+    congr },
+  ..‹boolean_algebra α› }
 
-theorem is_compl_compl : is_compl x xᶜ :=
-is_compl.of_eq inf_compl_eq_bot sup_compl_eq_top
+@[priority 100] -- See note [lower instance priority]
+instance boolean_algebra.to_biheyting_algebra : biheyting_algebra α :=
+{ hnot := compl,
+  le_himp_iff := λ a b c, by rw [himp_eq, is_compl_compl.le_sup_right_iff_inf_left_le],
+  himp_bot := λ _, himp_eq.trans bot_sup_eq,
+  top_sdiff := λ a, by rw [sdiff_eq, top_inf_eq],
+  ..‹boolean_algebra α›, ..generalized_boolean_algebra.to_generalized_coheyting_algebra }
 
-theorem is_compl.eq_compl (h : is_compl x y) : x = yᶜ :=
-h.left_unique is_compl_compl.symm
+@[simp] lemma hnot_eq_compl : ￢x = xᶜ := rfl
 
-theorem is_compl.compl_eq (h : is_compl x y) : xᶜ = y :=
-(h.right_unique is_compl_compl).symm
+@[simp] lemma top_sdiff : ⊤ \ x = xᶜ := top_sdiff' _
 
 theorem eq_compl_iff_is_compl : x = yᶜ ↔ is_compl x y :=
 ⟨λ h, by { rw h, exact is_compl_compl.symm }, is_compl.eq_compl⟩
@@ -637,20 +498,15 @@ theorem eq_compl_iff_is_compl : x = yᶜ ↔ is_compl x y :=
 theorem compl_eq_iff_is_compl : xᶜ = y ↔ is_compl x y :=
 ⟨λ h, by { rw ←h, exact is_compl_compl }, is_compl.compl_eq⟩
 
-theorem disjoint_compl_right : disjoint x xᶜ := is_compl_compl.disjoint
-theorem disjoint_compl_left : disjoint xᶜ x := disjoint_compl_right.symm
+theorem compl_eq_comm : xᶜ = y ↔ yᶜ = x :=
+by rw [eq_comm, compl_eq_iff_is_compl, eq_compl_iff_is_compl]
 
-theorem compl_unique (i : x ⊓ y = ⊥) (s : x ⊔ y = ⊤) : xᶜ = y :=
-(is_compl.of_eq i s).compl_eq
+theorem eq_compl_comm : x = yᶜ ↔ y = xᶜ :=
+by rw [eq_comm, compl_eq_iff_is_compl, eq_compl_iff_is_compl]
 
-@[simp] theorem compl_top : ⊤ᶜ = (⊥:α) :=
-is_compl_top_bot.compl_eq
+@[simp] theorem compl_compl (x : α) : xᶜᶜ = x := (@is_compl_compl _ x _).symm.compl_eq
 
-@[simp] theorem compl_bot : ⊥ᶜ = (⊤:α) :=
-is_compl_bot_top.compl_eq
-
-@[simp] theorem compl_compl (x : α) : xᶜᶜ = x :=
-is_compl_compl.symm.compl_eq
+theorem compl_comp_compl : compl ∘ compl = @id α := funext compl_compl
 
 @[simp] theorem compl_involutive : function.involutive (compl : α → α) := compl_compl
 
@@ -675,157 +531,73 @@ is_compl_bot_top.compl_eq_iff
 @[simp] theorem compl_eq_bot : xᶜ = ⊥ ↔ x = ⊤ :=
 is_compl_top_bot.compl_eq_iff
 
-@[simp] theorem compl_inf : (x ⊓ y)ᶜ = xᶜ ⊔ yᶜ :=
-(is_compl_compl.inf_sup is_compl_compl).compl_eq
-
-@[simp] theorem compl_sup : (x ⊔ y)ᶜ = xᶜ ⊓ yᶜ :=
-(is_compl_compl.sup_inf is_compl_compl).compl_eq
-
-theorem compl_le_compl (h : y ≤ x) : xᶜ ≤ yᶜ :=
-is_compl_compl.antitone is_compl_compl h
+@[simp] theorem compl_inf : (x ⊓ y)ᶜ = xᶜ ⊔ yᶜ := hnot_inf_distrib _ _
 
 @[simp] theorem compl_le_compl_iff_le : yᶜ ≤ xᶜ ↔ x ≤ y :=
 ⟨assume h, by have h := compl_le_compl h; simp at h; assumption,
   compl_le_compl⟩
 
-theorem le_compl_of_le_compl (h : y ≤ xᶜ) : x ≤ yᶜ :=
-by simpa only [compl_compl] using compl_le_compl h
-
 theorem compl_le_of_compl_le (h : yᶜ ≤ x) : xᶜ ≤ y :=
 by simpa only [compl_compl] using compl_le_compl h
 
-theorem le_compl_iff_le_compl : y ≤ xᶜ ↔ x ≤ yᶜ :=
-⟨le_compl_of_le_compl, le_compl_of_le_compl⟩
-
 theorem compl_le_iff_compl_le : xᶜ ≤ y ↔ yᶜ ≤ x :=
 ⟨compl_le_of_compl_le, compl_le_of_compl_le⟩
 
-namespace boolean_algebra
-
-@[priority 100]
-instance : is_complemented α := ⟨λ x, ⟨xᶜ, is_compl_compl⟩⟩
-
-end boolean_algebra
-
-end boolean_algebra_core
-
-/-- A Boolean algebra is a bounded distributive lattice with
-a complement operator `ᶜ` such that `x ⊓ xᶜ = ⊥` and `x ⊔ xᶜ = ⊤`.
-For convenience, it must also provide a set difference operation `\`
-satisfying `x \ y = x ⊓ yᶜ`.
-
-This is a generalization of (classical) logic of propositions, or
-the powerset lattice. -/
--- Lean complains about metavariables in the type if the universe is not specified
-class boolean_algebra (α : Type u) extends generalized_boolean_algebra α, boolean_algebra.core α :=
-(sdiff_eq : ∀x y:α, x \ y = x ⊓ yᶜ)
--- TODO: is there a way to automatically fill in the proofs of sup_inf_sdiff and inf_inf_sdiff given
--- everything in `boolean_algebra.core` and `sdiff_eq`? The following doesn't work:
--- (sup_inf_sdiff := λ a b, by rw [sdiff_eq, ←inf_sup_left, sup_compl_eq_top, inf_top_eq])
-
-
-section of_core
-
-/-- Create a `has_sdiff` instance from a `boolean_algebra.core` instance, defining `x \ y` to
-be `x ⊓ yᶜ`.
-
-For some types, it may be more convenient to create the `boolean_algebra` instance by hand in order
-to have a simpler `sdiff` operation.
-
-See note [reducible non-instances]. -/
-@[reducible]
-def boolean_algebra.core.sdiff [boolean_algebra.core α] : has_sdiff α := ⟨λ x y, x ⊓ yᶜ⟩
-
-local attribute [instance] boolean_algebra.core.sdiff
-
-lemma boolean_algebra.core.sdiff_eq [boolean_algebra.core α] (a b : α) :
-  a \ b = a ⊓ bᶜ := rfl
-
-/-- Create a `boolean_algebra` instance from a `boolean_algebra.core` instance, defining `x \ y` to
-be `x ⊓ yᶜ`.
+@[simp] lemma sdiff_compl : x \ yᶜ = x ⊓ y := by rw [sdiff_eq, compl_compl]
 
-For some types, it may be more convenient to create the `boolean_algebra` instance by hand in order
-to have a simpler `sdiff` operation. -/
-def boolean_algebra.of_core (B : boolean_algebra.core α) :
-  boolean_algebra α :=
-{ sdiff := λ x y, x ⊓ yᶜ,
-  sdiff_eq := λ _ _, rfl,
-  sup_inf_sdiff := λ a b, by rw [←inf_sup_left, sup_compl_eq_top, inf_top_eq],
-  inf_inf_sdiff := λ a b, by { rw [inf_left_right_swap, boolean_algebra.core.sdiff_eq,
-    @inf_assoc _ _ _ _ b, compl_inf_eq_bot, inf_bot_eq, bot_inf_eq], congr },
-  ..B }
-
-end of_core
-
-section boolean_algebra
-variables [boolean_algebra α]
-
---TODO@Yaël: Once we have co-Heyting algebras, we won't need to go through `boolean_algebra.of_core`
 instance : boolean_algebra αᵒᵈ :=
-boolean_algebra.of_core
 { compl := λ a, to_dual (of_dual a)ᶜ,
-  inf_compl_le_bot := λ _, sup_compl_eq_top.ge,
-  top_le_sup_compl := λ _, inf_compl_eq_bot.ge,
+  sdiff := λ a b, to_dual (of_dual b ⇨ of_dual a),
+  himp := λ a b, to_dual (of_dual b \ of_dual a),
+  inf_compl_le_bot := λ a, (@codisjoint_hnot_right _ _ (of_dual a)).top_le,
+  top_le_sup_compl := λ a, (@disjoint_compl_right _ _ (of_dual a)).le_bot,
+  sdiff_eq := λ _ _, himp_eq,
+  himp_eq := λ _ _, sdiff_eq,
   ..order_dual.distrib_lattice α, ..order_dual.bounded_order α }
 
-theorem sdiff_eq : x \ y = x ⊓ yᶜ := boolean_algebra.sdiff_eq x y
-
-@[simp] theorem sdiff_compl : x \ yᶜ = x ⊓ y := by rw [sdiff_eq, compl_compl]
-
-@[simp] theorem top_sdiff : ⊤ \ x = xᶜ := by rw [sdiff_eq, top_inf_eq]
-@[simp] theorem sdiff_top : x \ ⊤ = ⊥ := by rw [sdiff_eq, compl_top, inf_bot_eq]
-
 @[simp] lemma sup_inf_inf_compl : (x ⊓ y) ⊔ (x ⊓ yᶜ) = x :=
 by rw [← sdiff_eq, sup_inf_sdiff _ _]
 
-@[simp] lemma compl_sdiff : (x \ y)ᶜ = xᶜ ⊔ y :=
-by rw [sdiff_eq, compl_inf, compl_compl]
+@[simp] lemma compl_sdiff : (x \ y)ᶜ = x ⇨ y :=
+by rw [sdiff_eq, himp_eq, compl_inf, compl_compl, sup_comm]
 
-end boolean_algebra
+@[simp] lemma compl_himp : (x ⇨ y)ᶜ = x \ y := @compl_sdiff αᵒᵈ _ _ _
 
-instance Prop.boolean_algebra : boolean_algebra Prop :=
-boolean_algebra.of_core
-{ compl := not,
-  inf_compl_le_bot := λ p ⟨Hp, Hpc⟩, Hpc Hp,
-  top_le_sup_compl := λ p H, classical.em p,
-  .. Prop.distrib_lattice,
-  .. Prop.bounded_order }
+@[simp] lemma compl_sdiff_compl : xᶜ \ yᶜ = y \ x := by rw [sdiff_compl, sdiff_eq, inf_comm]
+@[simp] lemma compl_himp_compl : xᶜ ⇨ yᶜ = y ⇨ x := @compl_sdiff_compl αᵒᵈ _ _ _
 
-instance pi.has_sdiff {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] :
-  has_sdiff (Π i, α i) :=
-⟨λ x y i, x i \ y i⟩
+lemma disjoint_compl_left_iff : disjoint xᶜ y ↔ y ≤ x :=
+by rw [←le_compl_iff_disjoint_left, compl_compl]
 
-lemma pi.sdiff_def {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] (x y : Π i, α i) :
-  (x \ y) = λ i, x i \ y i := rfl
+lemma disjoint_compl_right_iff : disjoint x yᶜ ↔ x ≤ y :=
+by rw [←le_compl_iff_disjoint_right, compl_compl]
 
-@[simp]
-lemma pi.sdiff_apply {ι : Type u} {α : ι → Type v} [∀ i, has_sdiff (α i)] (x y : Π i, α i) (i : ι) :
-  (x \ y) i = x i \ y i := rfl
+lemma codisjoint_himp_self_left : codisjoint (x ⇨ y) x := @disjoint_sdiff_self_left αᵒᵈ _ _ _
+lemma codisjoint_himp_self_right : codisjoint x (x ⇨ y) := @disjoint_sdiff_self_right αᵒᵈ _ _ _
 
-instance pi.has_compl {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] :
-  has_compl (Π i, α i) :=
-⟨λ x i, (x i)ᶜ⟩
+lemma himp_le : x ⇨ y ≤ z ↔ y ≤ z ∧ codisjoint x z :=
+(@le_sdiff αᵒᵈ _ _ _ _).trans $ and_congr_right' codisjoint.comm
 
-lemma pi.compl_def {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] (x : Π i, α i) :
-  xᶜ = λ i, (x i)ᶜ := rfl
+end boolean_algebra
 
-@[simp]
-lemma pi.compl_apply {ι : Type u} {α : ι → Type v} [∀ i, has_compl (α i)] (x : Π i, α i) (i : ι)  :
-  xᶜ i = (x i)ᶜ := rfl
+instance Prop.boolean_algebra : boolean_algebra Prop :=
+{ compl := not,
+  himp_eq := λ p q, propext imp_iff_or_not,
+  inf_compl_le_bot := λ p ⟨Hp, Hpc⟩, Hpc Hp,
+  top_le_sup_compl := λ p H, classical.em p,
+  .. Prop.heyting_algebra, ..generalized_heyting_algebra.to_distrib_lattice }
 
 instance pi.boolean_algebra {ι : Type u} {α : ι → Type v} [∀ i, boolean_algebra (α i)] :
   boolean_algebra (Π i, α i) :=
 { sdiff_eq := λ x y, funext $ λ i, sdiff_eq,
-  sup_inf_sdiff := λ x y, funext $ λ i, sup_inf_sdiff (x i) (y i),
-  inf_inf_sdiff := λ x y, funext $ λ i, inf_inf_sdiff (x i) (y i),
+  himp_eq := λ x y, funext $ λ i, himp_eq,
   inf_compl_le_bot := λ _ _, boolean_algebra.inf_compl_le_bot _,
   top_le_sup_compl := λ _ _, boolean_algebra.top_le_sup_compl _,
   .. pi.has_sdiff,
-  .. pi.has_compl,
-  .. pi.bounded_order,
+  .. pi.heyting_algebra,
   .. pi.distrib_lattice }
 
-instance : boolean_algebra bool := boolean_algebra.of_core
+instance : boolean_algebra bool :=
 { sup := bor,
   le_sup_left := bool.left_le_bor,
   le_sup_right := bool.right_le_bor,
@@ -840,6 +612,10 @@ instance : boolean_algebra bool := boolean_algebra.of_core
   top_le_sup_compl := λ a, a.bor_bnot_self.ge,
   ..bool.linear_order, ..bool.bounded_order }
 
+@[simp] lemma bool.sup_eq_bor : (⊔) = bor := rfl
+@[simp] lemma bool.inf_eq_band : (⊓) = band := rfl
+@[simp] lemma bool.compl_eq_bnot : has_compl.compl = bnot := rfl
+
 section lift
 
 /-- Pullback a `generalized_boolean_algebra` along an injection. -/
@@ -849,21 +625,10 @@ protected def function.injective.generalized_boolean_algebra [has_sup α] [has_i
   (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b)
   (map_bot : f ⊥ = ⊥) (map_sdiff : ∀ a b, f (a \ b) = f a \ f b) :
   generalized_boolean_algebra α :=
-{ sdiff := (\),
-  bot := ⊥,
-  sup_inf_sdiff := λ a b, hf $ (map_sup _ _).trans begin
-    rw map_sdiff,
-    convert sup_inf_sdiff _ _,
-    exact map_inf _ _,
-  end,
-  inf_inf_sdiff := λ a b, hf $ (map_inf _ _).trans begin
-    rw map_sdiff,
-    convert inf_inf_sdiff _ _,
-    exact map_inf _ _,
-  end,
-  le_sup_inf := λ a b c, (map_inf _ _).le.trans $ by { convert le_sup_inf, exact map_sup _ _,
-    exact map_sup _ _, convert map_sup _ _, exact (map_inf _ _).symm },
-  ..hf.lattice f map_sup map_inf }
+{ sup_inf_sdiff := λ a b, hf $ by erw [map_sup, map_sdiff, map_inf, sup_inf_sdiff],
+  inf_inf_sdiff := λ a b, hf $ by erw [map_inf, map_sdiff, map_inf, inf_inf_sdiff, map_bot],
+  ..hf.generalized_coheyting_algebra f map_sup map_inf map_bot map_sdiff,
+  ..hf.distrib_lattice f map_sup map_inf }
 
 /-- Pullback a `boolean_algebra` along an injection. -/
 @[reducible] -- See note [reducible non-instances]
@@ -884,3 +649,8 @@ protected def function.injective.boolean_algebra [has_sup α] [has_inf α] [has_
   ..hf.generalized_boolean_algebra f map_sup map_inf map_bot map_sdiff }
 
 end lift
+
+instance : boolean_algebra punit :=
+by refine_struct
+{ ..punit.biheyting_algebra };
+    intros; trivial <|> exact subsingleton.elim _ _
diff --git a/src/order/bounded.lean b/src/order/bounded.lean
index 4c29d5138dae0..052e94d418516 100644
--- a/src/order/bounded.lean
+++ b/src/order/bounded.lean
@@ -3,13 +3,15 @@ Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Violeta Hernández Palacios
 -/
-import order.min_max
 import order.rel_classes
 import data.set.intervals.basic
 
 /-!
 # Bounded and unbounded sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We prove miscellaneous lemmas about bounded and unbounded sets. Many of these are just variations on
 the same ideas, or similar results with a few minor differences. The file is divided into these
 different general ideas.
diff --git a/src/order/bounded_order.lean b/src/order/bounded_order.lean
index 1b937d2324ae8..c9c998236dcf0 100644
--- a/src/order/bounded_order.lean
+++ b/src/order/bounded_order.lean
@@ -3,15 +3,15 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import data.option.basic
-import logic.nontrivial
 import order.lattice
-import order.max
-import tactic.pi_instances
+import data.option.basic
 
 /-!
 # ⊤ and ⊥, bounded lattices and variants
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines top and bottom elements (greatest and least elements) of a type, the bounded
 variants of different kinds of lattices, sets up the typeclass hierarchy between them and provides
 instances for `Prop` and `fun`.
@@ -21,10 +21,6 @@ instances for `Prop` and `fun`.
 * `has_ α`: Typeclasses to declare the `⊤`/`⊥` notation.
 * `order_ α`: Order with a top/bottom element.
 * `bounded_order α`: Order with a top and bottom element.
-* `with_ α`: Equips `option α` with the order on `α` plus `none` as the top/bottom element.
-* `is_compl x y`: In a bounded lattice, predicate for "`x` is a complement of `y`". Note that in a
-  non distributive lattice, an element can have several complements.
-* `is_complemented α`: Typeclass stating that any element of a lattice has a complement.
 
 ## Common lattices
 
@@ -33,20 +29,17 @@ instances for `Prop` and `fun`.
   `distrib_lattice` when `order_bot`.
 * Bounded and distributive lattice. Notated by `[distrib_lattice α] [bounded_order α]`.
   Typical examples include `Prop` and `set α`.
-
-## Implementation notes
-
-We didn't prove things about `[distrib_lattice α] [order_top α]` because the dual notion of
-`disjoint` isn't really used anywhere.
 -/
 
-/-! ### Top, bottom element -/
+open function order_dual
 
 set_option old_structure_cmd true
 
 universes u v
 
-variables {α : Type u} {β : Type v}
+variables {α : Type u} {β : Type v} {γ δ : Type*}
+
+/-! ### Top, bottom element -/
 
 /-- Typeclass for the `⊤` (`\top`) notation -/
 @[notation_class] class has_top (α : Type u) := (top : α)
@@ -68,6 +61,18 @@ class order_top (α : Type u) [has_le α] extends has_top α :=
 (le_top : ∀ a : α, a ≤ ⊤)
 
 section order_top
+
+/-- An order is (noncomputably) either an `order_top` or a `no_order_top`. Use as
+`casesI bot_order_or_no_bot_order α`. -/
+noncomputable def top_order_or_no_top_order (α : Type*) [has_le α] :
+  psum (order_top α) (no_top_order α) :=
+begin
+  by_cases H : ∀ a : α, ∃ b, ¬ b ≤ a,
+  { exact psum.inr ⟨H⟩ },
+  { push_neg at H,
+    exact psum.inl ⟨_, classical.some_spec H⟩ }
+end
+
 section has_le
 variables [has_le α] [order_top α] {a : α}
 
@@ -152,6 +157,18 @@ class order_bot (α : Type u) [has_le α] extends has_bot α :=
 (bot_le : ∀ a : α, ⊥ ≤ a)
 
 section order_bot
+
+/-- An order is (noncomputably) either an `order_bot` or a `no_order_bot`. Use as
+`casesI bot_order_or_no_bot_order α`. -/
+noncomputable def bot_order_or_no_bot_order (α : Type*) [has_le α] :
+  psum (order_bot α) (no_bot_order α) :=
+begin
+  by_cases H : ∀ a : α, ∃ b, ¬ a ≤ b,
+  { exact psum.inr ⟨H⟩ },
+  { push_neg at H,
+    exact psum.inl ⟨_, classical.some_spec H⟩ }
+end
+
 section has_le
 variables [has_le α] [order_bot α] {a : α}
 
@@ -160,6 +177,27 @@ variables [has_le α] [order_bot α] {a : α}
 
 end has_le
 
+namespace order_dual
+variable (α)
+
+instance [has_bot α] : has_top αᵒᵈ := ⟨(⊥ : α)⟩
+instance [has_top α] : has_bot αᵒᵈ := ⟨(⊤ : α)⟩
+
+instance [has_le α] [order_bot α] : order_top αᵒᵈ :=
+{ le_top := @bot_le α _ _,
+  .. order_dual.has_top α }
+
+instance [has_le α] [order_top α] : order_bot αᵒᵈ :=
+{ bot_le := @le_top α _ _,
+  .. order_dual.has_bot α }
+
+@[simp] lemma of_dual_bot [has_top α] : of_dual ⊥ = (⊤ : α) := rfl
+@[simp] lemma of_dual_top [has_bot α] : of_dual ⊤ = (⊥ : α) := rfl
+@[simp] lemma to_dual_bot [has_bot α] : to_dual (⊥ : α) = ⊤ := rfl
+@[simp] lemma to_dual_top [has_top α] : to_dual (⊤ : α) = ⊥ := rfl
+
+end order_dual
+
 section preorder
 variables [preorder α] [order_bot α] {a b : α}
 
@@ -199,15 +237,14 @@ lemma ne.bot_lt' (h : ⊥ ≠ a) : ⊥ < a := h.symm.bot_lt
 lemma ne_bot_of_le_ne_bot (hb : b ≠ ⊥) (hab : b ≤ a) : a ≠ ⊥ := (hb.bot_lt.trans_le hab).ne'
 
 lemma strict_mono.apply_eq_bot_iff (hf : strict_mono f) : f a = f ⊥ ↔ a = ⊥ :=
-⟨λ h, not_bot_lt_iff.1 $ λ ha, (hf ha).ne' h, congr_arg _⟩
+hf.dual.apply_eq_top_iff
 
 lemma strict_anti.apply_eq_bot_iff (hf : strict_anti f) : f a = f ⊥ ↔ a = ⊥ :=
-⟨λ h, not_bot_lt_iff.1 $ λ ha, (hf ha).ne h, congr_arg _⟩
+hf.dual.apply_eq_top_iff
 
 variables [nontrivial α]
 
-lemma not_is_max_bot : ¬ is_max (⊥ : α) :=
-λ h, let ⟨a, ha⟩ := exists_ne (⊥ : α) in ha $ le_bot_iff.1 $ h bot_le
+lemma not_is_max_bot : ¬ is_max (⊥ : α) := @not_is_min_top αᵒᵈ _ _ _
 
 end order_bot
 
@@ -265,7 +302,7 @@ inf_of_le_right le_top
 inf_of_le_left le_top
 
 @[simp] theorem inf_eq_top_iff : a ⊓ b = ⊤ ↔ (a = ⊤ ∧ b = ⊤) :=
-by rw [eq_top_iff, le_inf_iff]; simp
+@sup_eq_bot_iff αᵒᵈ _ _ _ _
 
 end semilattice_inf_top
 
@@ -287,6 +324,9 @@ end semilattice_inf_bot
 @[ancestor order_top order_bot]
 class bounded_order (α : Type u) [has_le α] extends order_top α, order_bot α.
 
+instance (α : Type u) [has_le α] [bounded_order α] : bounded_order αᵒᵈ :=
+{ .. order_dual.order_top α, .. order_dual.order_bot α }
+
 theorem bounded_order.ext {α} [partial_order α] {A B : bounded_order α} : A = B :=
 begin
   have ht : @bounded_order.to_order_top α _ A = @bounded_order.to_order_top α _ B := order_top.ext,
@@ -300,42 +340,6 @@ begin
   { exact h'.symm }
 end
 
-/-- Propositions form a distributive lattice. -/
-instance Prop.distrib_lattice : distrib_lattice Prop :=
-{ le           := λ a b, a → b,
-  le_refl      := λ _, id,
-  le_trans     := λ a b c f g, g ∘ f,
-  le_antisymm  := λ a b Hab Hba, propext ⟨Hab, Hba⟩,
-
-  sup          := or,
-  le_sup_left  := @or.inl,
-  le_sup_right := @or.inr,
-  sup_le       := λ a b c, or.rec,
-
-  inf          := and,
-  inf_le_left  := @and.left,
-  inf_le_right := @and.right,
-  le_inf       := λ a b c Hab Hac Ha, and.intro (Hab Ha) (Hac Ha),
-  le_sup_inf   := λ a b c H, or_iff_not_imp_left.2 $
-    λ Ha, ⟨H.1.resolve_left Ha, H.2.resolve_left Ha⟩ }
-
-/-- Propositions form a bounded order. -/
-instance Prop.bounded_order : bounded_order Prop :=
-{ top          := true,
-  le_top       := λ a Ha, true.intro,
-  bot          := false,
-  bot_le       := @false.elim }
-
-instance Prop.le_is_total : is_total Prop (≤) :=
-⟨λ p q, by { change (p → q) ∨ (q → p), tauto! }⟩
-
-noncomputable instance Prop.linear_order : linear_order Prop :=
-by classical; exact lattice.to_linear_order Prop
-
-@[simp] lemma le_Prop_eq : ((≤) : Prop → Prop → Prop) = (→) := rfl
-@[simp] lemma sup_Prop_eq : (⊔) = (∨) := rfl
-@[simp] lemma inf_Prop_eq : (⊓) = (∧) := rfl
-
 section logic
 /-!
 #### In this section we prove some properties about monotone and antitone operations on `Prop`
@@ -482,553 +486,6 @@ def bounded_order.lift [has_le α] [has_top α] [has_bot α] [has_le β] [bounde
 
 end lift
 
-/-! ### `with_bot`, `with_top` -/
-
-/-- Attach `⊥` to a type. -/
-def with_bot (α : Type*) := option α
-
-namespace with_bot
-variables {a b : α}
-
-meta instance [has_to_format α] : has_to_format (with_bot α) :=
-{ to_format := λ x,
-  match x with
-  | none := "⊥"
-  | (some x) := to_fmt x
-  end }
-
-instance [has_repr α] : has_repr (with_bot α) :=
-⟨λ o, match o with | none := "⊥" | (some a) := "↑" ++ repr a end⟩
-
-instance : has_coe_t α (with_bot α) := ⟨some⟩
-instance : has_bot (with_bot α) := ⟨none⟩
-
-instance : inhabited (with_bot α) := ⟨⊥⟩
-
-lemma none_eq_bot : (none : with_bot α) = (⊥ : with_bot α) := rfl
-lemma some_eq_coe (a : α) : (some a : with_bot α) = (↑a : with_bot α) := rfl
-
-@[simp] lemma bot_ne_coe : ⊥ ≠ (a : with_bot α) .
-@[simp] lemma coe_ne_bot : (a : with_bot α) ≠ ⊥ .
-
-/-- Recursor for `with_bot` using the preferred forms `⊥` and `↑a`. -/
-@[elab_as_eliminator]
-def rec_bot_coe {C : with_bot α → Sort*} (h₁ : C ⊥) (h₂ : Π (a : α), C a) :
-  Π (n : with_bot α), C n :=
-option.rec h₁ h₂
-
-@[norm_cast] lemma coe_eq_coe : (a : with_bot α) = b ↔ a = b := option.some_inj
-
--- the `by exact` here forces the type of the equality to be `@eq (with_bot α)`
-@[simp] lemma map_bot (f : α → β) :
-  (by exact option.map f (⊥ : with_bot α)) = (⊥ : with_bot β) := rfl
-lemma map_coe (f : α → β) (a : α) :
-  (by exact option.map f (a : with_bot α)) = (f a : with_bot β) := rfl
-
-lemma ne_bot_iff_exists {x : with_bot α} : x ≠ ⊥ ↔ ∃ (a : α), ↑a = x := option.ne_none_iff_exists
-
-/-- Deconstruct a `x : with_bot α` to the underlying value in `α`, given a proof that `x ≠ ⊥`. -/
-def unbot : Π (x : with_bot α), x ≠ ⊥ → α
-| ⊥        h := absurd rfl h
-| (some x) h := x
-
-@[simp] lemma coe_unbot (x : with_bot α) (h : x ≠ ⊥) : (x.unbot h : with_bot α) = x :=
-by { cases x, simpa using h, refl, }
-
-@[simp] lemma unbot_coe (x : α) (h : (x : with_bot α) ≠ ⊥ := coe_ne_bot) :
-  (x : with_bot α).unbot h = x := rfl
-
-instance : can_lift (with_bot α) α :=
-{ coe := coe,
-  cond := λ r, r ≠ ⊥,
-  prf := λ x h, ⟨x.unbot h, coe_unbot _ _⟩ }
-
-section has_le
-variables [has_le α]
-
-@[priority 10]
-instance : has_le (with_bot α) := ⟨λ o₁ o₂ : option α, ∀ a ∈ o₁, ∃ b ∈ o₂, a ≤ b⟩
-
-@[simp] lemma some_le_some : @has_le.le (with_bot α) _ (some a) (some b) ↔ a ≤ b := by simp [(≤)]
-@[simp, norm_cast] lemma coe_le_coe : (a : with_bot α) ≤ b ↔ a ≤ b := some_le_some
-
-@[simp] lemma none_le {a : with_bot α} : @has_le.le (with_bot α) _ none a :=
-λ b h, option.no_confusion h
-
-instance : order_bot (with_bot α) := { bot_le := λ a, none_le, ..with_bot.has_bot }
-
-instance [order_top α] : order_top (with_bot α) :=
-{ top := some ⊤,
-  le_top := λ o a ha, by cases ha; exact ⟨_, rfl, le_top⟩ }
-
-instance [order_top α] : bounded_order (with_bot α) :=
-{ ..with_bot.order_top, ..with_bot.order_bot }
-
-lemma not_coe_le_bot (a : α) : ¬ (a : with_bot α) ≤ ⊥ :=
-λ h, let ⟨b, hb, _⟩ := h _ rfl in option.not_mem_none _ hb
-
-lemma coe_le : ∀ {o : option α}, b ∈ o → ((a : with_bot α) ≤ o ↔ a ≤ b) | _ rfl := coe_le_coe
-
-lemma coe_le_iff : ∀ {x : with_bot α}, ↑a ≤ x ↔ ∃ b : α, x = b ∧ a ≤ b
-| (some a) := by simp [some_eq_coe, coe_eq_coe]
-| none     := iff_of_false (not_coe_le_bot _) $ by simp [none_eq_bot]
-
-lemma le_coe_iff : ∀ {x : with_bot α}, x ≤ b ↔ ∀ a, x = ↑a → a ≤ b
-| (some b) := by simp [some_eq_coe, coe_eq_coe]
-| none     := by simp [none_eq_bot]
-
-protected lemma _root_.is_max.with_bot (h : is_max a) : is_max (a : with_bot α)
-| none _ := bot_le
-| (some b) hb := some_le_some.2 $ h $ some_le_some.1 hb
-
-end has_le
-
-section has_lt
-variables [has_lt α]
-
-@[priority 10]
-instance : has_lt (with_bot α) := ⟨λ o₁ o₂ : option α, ∃ b ∈ o₂, ∀ a ∈ o₁, a < b⟩
-
-@[simp] lemma some_lt_some : @has_lt.lt (with_bot α) _ (some a) (some b) ↔ a < b := by simp [(<)]
-@[simp, norm_cast] lemma coe_lt_coe : (a : with_bot α) < b ↔ a < b := some_lt_some
-
-@[simp] lemma none_lt_some (a : α) : @has_lt.lt (with_bot α) _ none (some a) :=
-⟨a, rfl, λ b hb, (option.not_mem_none _ hb).elim⟩
-lemma bot_lt_coe (a : α) : (⊥ : with_bot α) < a := none_lt_some a
-
-@[simp] lemma not_lt_none (a : with_bot α) : ¬ @has_lt.lt (with_bot α) _ a none :=
-λ ⟨_, h, _⟩, option.not_mem_none _ h
-
-lemma lt_iff_exists_coe : ∀ {a b : with_bot α}, a < b ↔ ∃ p : α, b = p ∧ a < p
-| a (some b) := by simp [some_eq_coe, coe_eq_coe]
-| a none     := iff_of_false (not_lt_none _) $ by simp [none_eq_bot]
-
-lemma lt_coe_iff : ∀ {x : with_bot α}, x < b ↔ ∀ a, x = ↑a → a < b
-| (some b) := by simp [some_eq_coe, coe_eq_coe, coe_lt_coe]
-| none     := by simp [none_eq_bot, bot_lt_coe]
-
-end has_lt
-
-instance [preorder α] : preorder (with_bot α) :=
-{ le          := (≤),
-  lt          := (<),
-  lt_iff_le_not_le := by { intros, cases a; cases b; simp [lt_iff_le_not_le]; simp [(<), (≤)] },
-  le_refl     := λ o a ha, ⟨a, ha, le_rfl⟩,
-  le_trans    := λ o₁ o₂ o₃ h₁ h₂ a ha,
-    let ⟨b, hb, ab⟩ := h₁ a ha, ⟨c, hc, bc⟩ := h₂ b hb in
-    ⟨c, hc, le_trans ab bc⟩ }
-
-instance [partial_order α] : partial_order (with_bot α) :=
-{ le_antisymm := λ o₁ o₂ h₁ h₂, begin
-    cases o₁ with a,
-    { cases o₂ with b, {refl},
-      rcases h₂ b rfl with ⟨_, ⟨⟩, _⟩ },
-    { rcases h₁ a rfl with ⟨b, ⟨⟩, h₁'⟩,
-      rcases h₂ b rfl with ⟨_, ⟨⟩, h₂'⟩,
-      rw le_antisymm h₁' h₂' }
-  end,
-  .. with_bot.preorder }
-
-lemma le_coe_get_or_else [preorder α] : ∀ (a : with_bot α) (b : α), a ≤ a.get_or_else b
-| (some a) b := le_refl a
-| none     b := λ _ h, option.no_confusion h
-
-@[simp] lemma get_or_else_bot (a : α) : option.get_or_else (⊥ : with_bot α) a = a := rfl
-
-lemma get_or_else_bot_le_iff [has_le α] [order_bot α] {a : with_bot α} {b : α} :
-  a.get_or_else ⊥ ≤ b ↔ a ≤ b :=
-by cases a; simp [none_eq_bot, some_eq_coe]
-
-lemma get_or_else_bot_lt_iff [partial_order α] [order_bot α] {a : with_bot α} {b : α}
-  (ha : a ≠ ⊥) :
-  a.get_or_else ⊥ < b ↔ a < b :=
-begin
-  obtain ⟨a, rfl⟩ := ne_bot_iff_exists.mp ha,
-  simp only [lt_iff_le_and_ne, get_or_else_bot_le_iff, and.congr_right_iff],
-  intro h,
-  apply iff.not,
-  simp only [with_bot.coe_eq_coe, option.get_or_else_coe, iff_self],
-end
-
-instance [semilattice_sup α] : semilattice_sup (with_bot α) :=
-{ sup          := option.lift_or_get (⊔),
-  le_sup_left  := λ o₁ o₂ a ha,
-    by cases ha; cases o₂; simp [option.lift_or_get],
-  le_sup_right := λ o₁ o₂ a ha,
-    by cases ha; cases o₁; simp [option.lift_or_get],
-  sup_le       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
-    cases o₁ with b; cases o₂ with c; cases ha,
-    { exact h₂ a rfl },
-    { exact h₁ a rfl },
-    { rcases h₁ b rfl with ⟨d, ⟨⟩, h₁'⟩,
-      simp at h₂,
-      exact ⟨d, rfl, sup_le h₁' h₂⟩ }
-  end,
-  ..with_bot.order_bot,
-  ..with_bot.partial_order }
-
-lemma coe_sup [semilattice_sup α] (a b : α) : ((a ⊔ b : α) : with_bot α) = a ⊔ b := rfl
-
-instance [semilattice_inf α] : semilattice_inf (with_bot α) :=
-{ inf          := λ o₁ o₂, o₁.bind (λ a, o₂.map (λ b, a ⊓ b)),
-  inf_le_left  := λ o₁ o₂ a ha, begin
-    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
-    exact ⟨_, rfl, inf_le_left⟩
-  end,
-  inf_le_right := λ o₁ o₂ a ha, begin
-    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
-    exact ⟨_, rfl, inf_le_right⟩
-  end,
-  le_inf       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
-    cases ha,
-    rcases h₁ a rfl with ⟨b, ⟨⟩, ab⟩,
-    rcases h₂ a rfl with ⟨c, ⟨⟩, ac⟩,
-    exact ⟨_, rfl, le_inf ab ac⟩
-  end,
-  ..with_bot.order_bot,
-  ..with_bot.partial_order }
-
-lemma coe_inf [semilattice_inf α] (a b : α) : ((a ⊓ b : α) : with_bot α) = a ⊓ b := rfl
-
-instance [lattice α] : lattice (with_bot α) :=
-{ ..with_bot.semilattice_sup, ..with_bot.semilattice_inf }
-
-instance decidable_le [has_le α] [@decidable_rel α (≤)] : @decidable_rel (with_bot α) (≤)
-| none x := is_true $ λ a h, option.no_confusion h
-| (some x) (some y) :=
-  if h : x ≤ y
-  then is_true (some_le_some.2 h)
-  else is_false $ by simp *
-| (some x) none := is_false $ λ h, by rcases h x rfl with ⟨y, ⟨_⟩, _⟩
-
-instance decidable_lt [has_lt α] [@decidable_rel α (<)] : @decidable_rel (with_bot α) (<)
-| none (some x) := is_true $ by existsi [x,rfl]; rintros _ ⟨⟩
-| (some x) (some y) :=
-  if h : x < y
-  then is_true $ by simp *
-  else is_false $ by simp *
-| x none := is_false $ by rintro ⟨a,⟨⟨⟩⟩⟩
-
-instance is_total_le [has_le α] [is_total α (≤)] : is_total (with_bot α) (≤) :=
-⟨λ a b, match a, b with
-  | none  , _      := or.inl bot_le
-  | _     , none   := or.inr bot_le
-  | some x, some y := (total_of (≤) x y).imp some_le_some.2 some_le_some.2
-  end⟩
-
-instance [linear_order α] : linear_order (with_bot α) := lattice.to_linear_order _
-
-@[norm_cast] -- this is not marked simp because the corresponding with_top lemmas are used
-lemma coe_min [linear_order α] (x y : α) : ((min x y : α) : with_bot α) = min x y := rfl
-
-@[norm_cast] -- this is not marked simp because the corresponding with_top lemmas are used
-lemma coe_max [linear_order α] (x y : α) : ((max x y : α) : with_bot α) = max x y := rfl
-
-lemma well_founded_lt [preorder α] (h : @well_founded α (<)) : @well_founded (with_bot α) (<) :=
-have acc_bot : acc ((<) : with_bot α → with_bot α → Prop) ⊥ :=
-  acc.intro _ (λ a ha, (not_le_of_gt ha bot_le).elim),
-⟨λ a, option.rec_on a acc_bot (λ a, acc.intro _ (λ b, option.rec_on b (λ _, acc_bot)
-(λ b, well_founded.induction h b
-  (show ∀ b : α, (∀ c, c < b → (c : with_bot α) < a →
-      acc ((<) : with_bot α → with_bot α → Prop) c) → (b : with_bot α) < a →
-        acc ((<) : with_bot α → with_bot α → Prop) b,
-  from λ b ih hba, acc.intro _ (λ c, option.rec_on c (λ _, acc_bot)
-    (λ c hc, ih _ (some_lt_some.1 hc) (lt_trans hc hba)))))))⟩
-
-instance [has_lt α] [densely_ordered α] [no_min_order α] : densely_ordered (with_bot α) :=
-⟨ λ a b,
-  match a, b with
-  | a,      none   := λ h : a < ⊥, (not_lt_none _ h).elim
-  | none,   some b := λ h, let ⟨a, ha⟩ := exists_lt b in ⟨a, bot_lt_coe a, coe_lt_coe.2 ha⟩
-  | some a, some b := λ h, let ⟨a, ha₁, ha₂⟩ := exists_between (coe_lt_coe.1 h) in
-    ⟨a, coe_lt_coe.2 ha₁, coe_lt_coe.2 ha₂⟩
-  end⟩
-
-lemma lt_iff_exists_coe_btwn [preorder α] [densely_ordered α] [no_min_order α] {a b : with_bot α} :
-  a < b ↔ ∃ x : α, a < ↑x ∧ ↑x < b :=
-⟨λ h, let ⟨y, hy⟩ := exists_between h, ⟨x, hx⟩ := lt_iff_exists_coe.1 hy.1 in ⟨x, hx.1 ▸ hy⟩,
- λ ⟨x, hx⟩, lt_trans hx.1 hx.2⟩
-
-instance [has_le α] [no_top_order α] [nonempty α] : no_top_order (with_bot α) :=
-⟨begin
-  apply rec_bot_coe,
-  { exact ‹nonempty α›.elim (λ a, ⟨a, not_coe_le_bot a⟩) },
-  { intro a,
-    obtain ⟨b, h⟩ := exists_not_le a,
-    exact ⟨b, by rwa coe_le_coe⟩ }
-end⟩
-
-instance [has_lt α] [no_max_order α] [nonempty α] : no_max_order (with_bot α) :=
-⟨begin
-  apply with_bot.rec_bot_coe,
-  { apply ‹nonempty α›.elim,
-    exact λ a, ⟨a, with_bot.bot_lt_coe a⟩, },
-  { intro a,
-    obtain ⟨b, ha⟩ := exists_gt a,
-    exact ⟨b, with_bot.coe_lt_coe.mpr ha⟩, }
-end⟩
-
-end with_bot
-
---TODO(Mario): Construct using order dual on with_bot
-/-- Attach `⊤` to a type. -/
-def with_top (α : Type*) := option α
-
-namespace with_top
-variables {a b : α}
-
-meta instance [has_to_format α] : has_to_format (with_top α) :=
-{ to_format := λ x,
-  match x with
-  | none := "⊤"
-  | (some x) := to_fmt x
-  end }
-
-instance [has_repr α] : has_repr (with_top α) :=
-⟨λ o, match o with | none := "⊤" | (some a) := "↑" ++ repr a end⟩
-
-instance : has_coe_t α (with_top α) := ⟨some⟩
-instance : has_top (with_top α) := ⟨none⟩
-
-instance : inhabited (with_top α) := ⟨⊤⟩
-
-lemma none_eq_top : (none : with_top α) = (⊤ : with_top α) := rfl
-lemma some_eq_coe (a : α) : (some a : with_top α) = (↑a : with_top α) := rfl
-
-@[simp] lemma top_ne_coe : ⊤ ≠ (a : with_top α) .
-@[simp] lemma coe_ne_top : (a : with_top α) ≠ ⊤ .
-
-/-- Recursor for `with_top` using the preferred forms `⊤` and `↑a`. -/
-@[elab_as_eliminator]
-def rec_top_coe {C : with_top α → Sort*} (h₁ : C ⊤) (h₂ : Π (a : α), C a) :
-  Π (n : with_top α), C n :=
-option.rec h₁ h₂
-
-@[norm_cast] lemma coe_eq_coe : (a : with_top α) = b ↔ a = b := option.some_inj
-
--- the `by exact` here forces the type of the equality to be `@eq (with_top α)`
-@[simp] lemma map_top (f : α → β) :
-  (by exact option.map f (⊤ : with_top α)) = (⊤ : with_top β) := rfl
-lemma map_coe (f : α → β) (a : α) :
-  (by exact option.map f (a : with_top α)) = (f a : with_top β) := rfl
-
-lemma ne_top_iff_exists {x : with_top α} : x ≠ ⊤ ↔ ∃ (a : α), ↑a = x := option.ne_none_iff_exists
-
-/-- Deconstruct a `x : with_top α` to the underlying value in `α`, given a proof that `x ≠ ⊤`. -/
-def untop : Π (x : with_top α), x ≠ ⊤ → α :=
-with_bot.unbot
-
-@[simp] lemma coe_untop (x : with_top α) (h : x ≠ ⊤) : (x.untop h : with_top α) = x :=
-by { cases x, simpa using h, refl, }
-
-@[simp] lemma untop_coe (x : α) (h : (x : with_top α) ≠ ⊤ := coe_ne_top) :
-  (x : with_top α).untop h = x := rfl
-
-instance : can_lift (with_top α) α :=
-{ coe := coe,
-  cond := λ r, r ≠ ⊤,
-  prf := λ x h, ⟨x.untop h, coe_untop _ _⟩ }
-
-section has_le
-variables [has_le α]
-
-@[priority 10]
-instance : has_le (with_top α) := ⟨λ o₁ o₂ : option α, ∀ a ∈ o₂, ∃ b ∈ o₁, b ≤ a⟩
-
-@[simp] lemma some_le_some : @has_le.le (with_top α) _ (some a) (some b) ↔ a ≤ b := by simp [(≤)]
-@[simp, norm_cast] lemma coe_le_coe : (a : with_top α) ≤ b ↔ a ≤ b := some_le_some
-
-@[simp] lemma le_none {a : with_top α} : @has_le.le (with_top α) _ a none :=
-λ b h, option.no_confusion h
-
-instance : order_top (with_top α) := { le_top := λ a, le_none, .. with_top.has_top }
-
-instance [order_bot α] : order_bot (with_top α) :=
-{ bot := some ⊥,
-  bot_le := λ o a ha, by cases ha; exact ⟨_, rfl, bot_le⟩ }
-
-instance [order_bot α] : bounded_order (with_top α) :=
-{ ..with_top.order_top, ..with_top.order_bot }
-
-lemma not_top_le_coe (a : α) : ¬ (⊤ : with_top α) ≤ ↑a :=
-λ h, let ⟨b, hb, _⟩ := h _ rfl in option.not_mem_none _ hb
-
-lemma le_coe : ∀ {o : option α}, a ∈ o → (@has_le.le (with_top α) _ o b ↔ a ≤ b) | _ rfl :=
-coe_le_coe
-
-lemma le_coe_iff : ∀ {x : with_top α}, x ≤ b ↔ ∃ a : α, x = a ∧ a ≤ b
-| (some a) := by simp [some_eq_coe, coe_eq_coe]
-| none     := iff_of_false (not_top_le_coe _) $ by simp [none_eq_top]
-
-lemma coe_le_iff : ∀ {x : with_top α}, ↑a ≤ x ↔ ∀ b, x = ↑b → a ≤ b
-| (some b) := by simp [some_eq_coe, coe_eq_coe]
-| none     := by simp [none_eq_top]
-
-protected lemma _root_.is_min.with_top (h : is_min a) : is_min (a : with_top α)
-| none _ := le_top
-| (some b) hb := some_le_some.2 $ h $ some_le_some.1 hb
-
-end has_le
-
-section has_lt
-variables [has_lt α]
-
-@[priority 10]
-instance : has_lt (with_top α) := ⟨λ o₁ o₂ : option α, ∃ b ∈ o₁, ∀ a ∈ o₂, b < a⟩
-
-@[simp] lemma some_lt_some : @has_lt.lt (with_top α) _ (some a) (some b) ↔ a < b := by simp [(<)]
-@[simp, norm_cast] lemma coe_lt_coe : (a : with_top α) < b ↔ a < b := some_lt_some
-
-@[simp] lemma some_lt_none (a : α) : @has_lt.lt (with_top α) _ (some a) none :=
-⟨a, rfl, λ b hb, (option.not_mem_none _ hb).elim⟩
-lemma coe_lt_top (a : α) : (a : with_top α) < ⊤ := some_lt_none a
-
-@[simp] lemma not_none_lt (a : with_top α) : ¬ @has_lt.lt (with_top α) _ none a :=
-λ ⟨_, h, _⟩, option.not_mem_none _ h
-
-lemma lt_iff_exists_coe : ∀ {a b : with_top α}, a < b ↔ ∃ p : α, a = p ∧ ↑p < b
-| (some a) b := by simp [some_eq_coe, coe_eq_coe]
-| none     b := iff_of_false (not_none_lt _) $ by simp [none_eq_top]
-
-lemma coe_lt_iff : ∀ {x : with_top α}, ↑a < x ↔ ∀ b, x = ↑b → a < b
-| (some b) := by simp [some_eq_coe, coe_eq_coe, coe_lt_coe]
-| none     := by simp [none_eq_top, coe_lt_top]
-
-end has_lt
-
-instance [preorder α] : preorder (with_top α) :=
-{ le          := (≤),
-  lt          := (<),
-  lt_iff_le_not_le := by { intros, cases a; cases b; simp [lt_iff_le_not_le]; simp [(<), (≤)] },
-  le_refl     := λ o a ha, ⟨a, ha, le_rfl⟩,
-  le_trans    := λ o₁ o₂ o₃ h₁ h₂ c hc,
-    let ⟨b, hb, bc⟩ := h₂ c hc, ⟨a, ha, ab⟩ := h₁ b hb in
-    ⟨a, ha, le_trans ab bc⟩ }
-
-instance [partial_order α] : partial_order (with_top α) :=
-{ le_antisymm := λ o₁ o₂ h₁ h₂, begin
-    cases o₂ with b,
-    { cases o₁ with a, {refl},
-      rcases h₂ a rfl with ⟨_, ⟨⟩, _⟩ },
-    { rcases h₁ b rfl with ⟨a, ⟨⟩, h₁'⟩,
-      rcases h₂ a rfl with ⟨_, ⟨⟩, h₂'⟩,
-      rw le_antisymm h₁' h₂' }
-  end,
-  .. with_top.preorder }
-
-instance [semilattice_inf α] : semilattice_inf (with_top α) :=
-{ inf          := option.lift_or_get (⊓),
-  inf_le_left  := λ o₁ o₂ a ha,
-    by cases ha; cases o₂; simp [option.lift_or_get],
-  inf_le_right := λ o₁ o₂ a ha,
-    by cases ha; cases o₁; simp [option.lift_or_get],
-  le_inf       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
-    cases o₂ with b; cases o₃ with c; cases ha,
-    { exact h₂ a rfl },
-    { exact h₁ a rfl },
-    { rcases h₁ b rfl with ⟨d, ⟨⟩, h₁'⟩,
-      simp at h₂,
-      exact ⟨d, rfl, le_inf h₁' h₂⟩ }
-  end,
-  ..with_top.partial_order }
-
-lemma coe_inf [semilattice_inf α] (a b : α) : ((a ⊓ b : α) : with_top α) = a ⊓ b := rfl
-
-instance [semilattice_sup α] : semilattice_sup (with_top α) :=
-{ sup          := λ o₁ o₂, o₁.bind (λ a, o₂.map (λ b, a ⊔ b)),
-  le_sup_left  := λ o₁ o₂ a ha, begin
-    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
-    exact ⟨_, rfl, le_sup_left⟩
-  end,
-  le_sup_right := λ o₁ o₂ a ha, begin
-    simp at ha, rcases ha with ⟨b, rfl, c, rfl, rfl⟩,
-    exact ⟨_, rfl, le_sup_right⟩
-  end,
-  sup_le       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
-    cases ha,
-    rcases h₁ a rfl with ⟨b, ⟨⟩, ab⟩,
-    rcases h₂ a rfl with ⟨c, ⟨⟩, ac⟩,
-    exact ⟨_, rfl, sup_le ab ac⟩
-  end,
-  ..with_top.partial_order }
-
-lemma coe_sup [semilattice_sup α] (a b : α) : ((a ⊔ b : α) : with_top α) = a ⊔ b := rfl
-
-instance [lattice α] : lattice (with_top α) :=
-{ ..with_top.semilattice_sup, ..with_top.semilattice_inf }
-
-instance decidable_le [has_le α] [@decidable_rel α (≤)] : @decidable_rel (with_top α) (≤) :=
-λ x y, @with_bot.decidable_le αᵒᵈ _ _ y x
-
-instance decidable_lt [has_lt α] [@decidable_rel α (<)] : @decidable_rel (with_top α) (<) :=
-λ x y, @with_bot.decidable_lt αᵒᵈ _ _ y x
-
-instance is_total_le [has_le α] [is_total α (≤)] : is_total (with_top α) (≤) :=
-⟨λ a b, match a, b with
-  | _     , none   := or.inl le_top
-  | none  , _      := or.inr le_top
-  | some x, some y := (total_of (≤) x y).imp some_le_some.2 some_le_some.2
-  end⟩
-
-instance [linear_order α] : linear_order (with_top α) := lattice.to_linear_order _
-
-@[simp, norm_cast]
-lemma coe_min [linear_order α] (x y : α) : (↑(min x y) : with_top α) = min x y := rfl
-
-@[simp, norm_cast]
-lemma coe_max [linear_order α] (x y : α) : (↑(max x y) : with_top α) = max x y := rfl
-
-lemma well_founded_lt [preorder α] (h : @well_founded α (<)) : @well_founded (with_top α) (<) :=
-have acc_some : ∀ a : α, acc ((<) : with_top α → with_top α → Prop) (some a) :=
-λ a, acc.intro _ (well_founded.induction h a
-  (show ∀ b, (∀ c, c < b → ∀ d : with_top α, d < some c → acc (<) d) →
-    ∀ y : with_top α, y < some b → acc (<) y,
-  from λ b ih c, option.rec_on c (λ hc, (not_lt_of_ge le_top hc).elim)
-    (λ c hc, acc.intro _ (ih _ (some_lt_some.1 hc))))),
-⟨λ a, option.rec_on a (acc.intro _ (λ y, option.rec_on y (λ h, (lt_irrefl _ h).elim)
-  (λ _ _, acc_some _))) acc_some⟩
-
-lemma well_founded_gt [preorder α] (h : @well_founded α (>)) : @well_founded (with_top α) (>) :=
-@with_bot.well_founded_lt αᵒᵈ _ h
-
-lemma _root_.with_bot.well_founded_gt [preorder α] (h : @well_founded α (>)) :
-  @well_founded (with_bot α) (>) :=
-@with_top.well_founded_lt αᵒᵈ _ h
-
-instance [has_lt α] [densely_ordered α] [no_max_order α] : densely_ordered (with_top α) :=
-⟨ λ a b,
-  match a, b with
-  | none,   a   := λ h : ⊤ < a, (not_none_lt _ h).elim
-  | some a, none := λ h, let ⟨b, hb⟩ := exists_gt a in ⟨b, coe_lt_coe.2 hb, coe_lt_top b⟩
-  | some a, some b := λ h, let ⟨a, ha₁, ha₂⟩ := exists_between (coe_lt_coe.1 h) in
-    ⟨a, coe_lt_coe.2 ha₁, coe_lt_coe.2 ha₂⟩
-  end⟩
-
-lemma lt_iff_exists_coe_btwn [preorder α] [densely_ordered α] [no_max_order α] {a b : with_top α} :
-  a < b ↔ ∃ x : α, a < ↑x ∧ ↑x < b :=
-⟨λ h, let ⟨y, hy⟩ := exists_between h, ⟨x, hx⟩ := lt_iff_exists_coe.1 hy.2 in ⟨x, hx.1 ▸ hy⟩,
- λ ⟨x, hx⟩, lt_trans hx.1 hx.2⟩
-
-instance [has_le α] [no_bot_order α] [nonempty α] : no_bot_order (with_top α) :=
-⟨begin
-  apply with_top.rec_top_coe,
-  { exact ‹nonempty α›.elim (λ a, ⟨a, not_top_le_coe a⟩) },
-  { intro a,
-    obtain ⟨b, h⟩ := exists_not_ge a,
-    exact ⟨b, by rwa coe_le_coe⟩ }
-end⟩
-
-instance [has_lt α] [no_min_order α] [nonempty α] : no_min_order (with_top α) :=
-⟨begin
-  apply rec_top_coe,
-  { exact ‹nonempty α›.elim (λ a, ⟨a, with_top.coe_lt_top a⟩) },
-  { intro a,
-    obtain ⟨b, ha⟩ := exists_lt a,
-    exact ⟨b, coe_lt_coe.mpr ha⟩ }
-end⟩
-
-end with_top
-
 /-! ### Subtype, order dual, product lattices -/
 
 namespace subtype
@@ -1084,25 +541,6 @@ by rw [←coe_top htop, ext_iff]
 
 end subtype
 
-namespace order_dual
-variable (α)
-
-instance [has_bot α] : has_top αᵒᵈ := ⟨(⊥ : α)⟩
-instance [has_top α] : has_bot αᵒᵈ := ⟨(⊤ : α)⟩
-
-instance [has_le α] [order_bot α] : order_top αᵒᵈ :=
-{ le_top := @bot_le α _ _,
-  .. order_dual.has_top α }
-
-instance [has_le α] [order_top α] : order_bot αᵒᵈ :=
-{ bot_le := @le_top α _ _,
-  .. order_dual.has_bot α }
-
-instance [has_le α] [bounded_order α] : bounded_order αᵒᵈ :=
-{ .. order_dual.order_top α, .. order_dual.order_bot α }
-
-end order_dual
-
 namespace prod
 variables (α β)
 
@@ -1120,105 +558,23 @@ instance [has_le α] [has_le β] [order_bot α] [order_bot β] : order_bot (α 
 instance [has_le α] [has_le β] [bounded_order α] [bounded_order β] : bounded_order (α × β) :=
 { .. prod.order_top α β, .. prod.order_bot α β }
 
-
 end prod
 
-/-! ### Disjointness and complements -/
-
-section disjoint
-section semilattice_inf_bot
-variables [semilattice_inf α] [order_bot α]
-
-/-- Two elements of a lattice are disjoint if their inf is the bottom element.
-  (This generalizes disjoint sets, viewed as members of the subset lattice.) -/
-def disjoint (a b : α) : Prop := a ⊓ b ≤ ⊥
-
-theorem disjoint.eq_bot {a b : α} (h : disjoint a b) : a ⊓ b = ⊥ :=
-eq_bot_iff.2 h
-
-theorem disjoint_iff {a b : α} : disjoint a b ↔ a ⊓ b = ⊥ :=
-eq_bot_iff.symm
-
-theorem disjoint.comm {a b : α} : disjoint a b ↔ disjoint b a :=
-by rw [disjoint, disjoint, inf_comm]
-
-@[symm] theorem disjoint.symm ⦃a b : α⦄ : disjoint a b → disjoint b a :=
-disjoint.comm.1
-
-lemma symmetric_disjoint : symmetric (disjoint : α → α → Prop) := disjoint.symm
-
-@[simp] theorem disjoint_bot_left {a : α} : disjoint ⊥ a := inf_le_left
-@[simp] theorem disjoint_bot_right {a : α} : disjoint a ⊥ := inf_le_right
-
-theorem disjoint.mono {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) :
-  disjoint b d → disjoint a c := le_trans (inf_le_inf h₁ h₂)
-
-theorem disjoint.mono_left {a b c : α} (h : a ≤ b) : disjoint b c → disjoint a c :=
-disjoint.mono h le_rfl
-
-theorem disjoint.mono_right {a b c : α} (h : b ≤ c) : disjoint a c → disjoint a b :=
-disjoint.mono le_rfl h
-
-@[simp] lemma disjoint_self {a : α} : disjoint a a ↔ a = ⊥ :=
-by simp [disjoint]
-
-lemma disjoint.ne {a b : α} (ha : a ≠ ⊥) (hab : disjoint a b) : a ≠ b :=
-by { intro h, rw [←h, disjoint_self] at hab, exact ha hab }
-
-lemma disjoint.eq_bot_of_le {a b : α} (hab : disjoint a b) (h : a ≤ b) : a = ⊥ :=
-eq_bot_iff.2 (by rwa ←inf_eq_left.2 h)
-
-lemma disjoint_assoc {a b c : α} : disjoint (a ⊓ b) c ↔ disjoint a (b ⊓ c) :=
-by rw [disjoint, disjoint, inf_assoc]
-
-lemma disjoint.of_disjoint_inf_of_le {a b c : α} (h : disjoint (a ⊓ b) c) (hle : a ≤ c) :
-  disjoint a b := by rw [disjoint_iff, h.eq_bot_of_le (inf_le_left.trans hle)]
-
-lemma disjoint.of_disjoint_inf_of_le' {a b c : α} (h : disjoint (a ⊓ b) c) (hle : b ≤ c) :
-  disjoint a b := by rw [disjoint_iff, h.eq_bot_of_le (inf_le_right.trans hle)]
-
-end semilattice_inf_bot
-
-section order_bot
-
-variables [lattice α] [order_bot α]
-
-lemma eq_bot_of_disjoint_absorbs
-  {a b : α} (w : disjoint a b) (h : a ⊔ b = a) : b = ⊥ :=
-begin
-  rw disjoint_iff at w,
-  rw [←w, right_eq_inf],
-  rwa sup_eq_left at h,
-end
-
-end order_bot
-
-section bounded_order
-
-variables [lattice α] [bounded_order α] {a : α}
-
-@[simp] theorem disjoint_top : disjoint a ⊤ ↔ a = ⊥ := by simp [disjoint_iff]
-@[simp] theorem top_disjoint : disjoint ⊤ a ↔ a = ⊥ := by simp [disjoint_iff]
-
-end bounded_order
-
 section linear_order
-
 variables [linear_order α]
 
-lemma min_top_left [order_top α] (a : α) : min (⊤ : α) a = a := min_eq_right le_top
-lemma min_top_right [order_top α] (a : α) : min a ⊤ = a := min_eq_left le_top
-lemma max_bot_left [order_bot α] (a : α) : max (⊥ : α) a = a := max_eq_right bot_le
-lemma max_bot_right [order_bot α] (a : α) : max a ⊥ = a := max_eq_left bot_le
-
 -- `simp` can prove these, so they shouldn't be simp-lemmas.
-lemma min_bot_left [order_bot α] (a : α) : min ⊥ a = ⊥ := min_eq_left bot_le
-lemma min_bot_right [order_bot α] (a : α) : min a ⊥ = ⊥ := min_eq_right bot_le
-lemma max_top_left [order_top α] (a : α) : max ⊤ a = ⊤ := max_eq_left le_top
-lemma max_top_right [order_top α] (a : α) : max a ⊤ = ⊤ := max_eq_right le_top
+lemma min_bot_left [order_bot α] (a : α) : min ⊥ a = ⊥ := bot_inf_eq
+lemma max_top_left [order_top α] (a : α) : max ⊤ a = ⊤ := top_sup_eq
+lemma min_top_left [order_top α] (a : α) : min ⊤ a = a := top_inf_eq
+lemma max_bot_left [order_bot α] (a : α) : max ⊥ a = a := bot_sup_eq
+lemma min_top_right [order_top α] (a : α) : min a ⊤ = a := inf_top_eq
+lemma max_bot_right [order_bot α] (a : α) : max a ⊥ = a := sup_bot_eq
+lemma min_bot_right [order_bot α] (a : α) : min a ⊥ = ⊥ := inf_bot_eq
+lemma max_top_right [order_top α] (a : α) : max a ⊤ = ⊤ := sup_top_eq
 
 @[simp] lemma min_eq_bot [order_bot α] {a b : α} : min a b = ⊥ ↔ a = ⊥ ∨ b = ⊥ :=
-by { symmetry, cases le_total a b; simpa [*, min_eq_left, min_eq_right] using eq_bot_mono h }
+by simp only [←inf_eq_min, ←le_bot_iff, inf_le_iff]
 
 @[simp] lemma max_eq_top [order_top α] {a b : α} : max a b = ⊤ ↔ a = ⊤ ∨ b = ⊤ :=
 @min_eq_bot αᵒᵈ _ _ a b
@@ -1228,221 +584,29 @@ by { symmetry, cases le_total a b; simpa [*, min_eq_left, min_eq_right] using eq
 
 end linear_order
 
-section distrib_lattice_bot
-variables [distrib_lattice α] [order_bot α] {a b c : α}
-
-@[simp] lemma disjoint_sup_left : disjoint (a ⊔ b) c ↔ disjoint a c ∧ disjoint b c :=
-by simp only [disjoint_iff, inf_sup_right, sup_eq_bot_iff]
-
-@[simp] lemma disjoint_sup_right : disjoint a (b ⊔ c) ↔ disjoint a b ∧ disjoint a c :=
-by simp only [disjoint_iff, inf_sup_left, sup_eq_bot_iff]
-
-lemma disjoint.sup_left (ha : disjoint a c) (hb : disjoint b c) : disjoint (a ⊔ b) c :=
-disjoint_sup_left.2 ⟨ha, hb⟩
-
-lemma disjoint.sup_right (hb : disjoint a b) (hc : disjoint a c) : disjoint a (b ⊔ c) :=
-disjoint_sup_right.2 ⟨hb, hc⟩
-
-lemma disjoint.left_le_of_le_sup_right {a b c : α} (h : a ≤ b ⊔ c) (hd : disjoint a c) : a ≤ b :=
-(λ x, le_of_inf_le_sup_le x (sup_le h le_sup_right)) ((disjoint_iff.mp hd).symm ▸ bot_le)
-
-lemma disjoint.left_le_of_le_sup_left {a b c : α} (h : a ≤ c ⊔ b) (hd : disjoint a c) : a ≤ b :=
-@le_of_inf_le_sup_le _ _ a b c ((disjoint_iff.mp hd).symm ▸ bot_le)
-  ((@sup_comm _ _ c b) ▸ (sup_le h le_sup_left))
-
-end distrib_lattice_bot
-
-section semilattice_inf_bot
-
-variables [semilattice_inf α] [order_bot α] {a b : α} (c : α)
-
-lemma disjoint.inf_left (h : disjoint a b) : disjoint (a ⊓ c) b :=
-h.mono_left inf_le_left
-
-lemma disjoint.inf_left' (h : disjoint a b) : disjoint (c ⊓ a) b :=
-h.mono_left inf_le_right
-
-lemma disjoint.inf_right (h : disjoint a b) : disjoint a (b ⊓ c) :=
-h.mono_right inf_le_left
-
-lemma disjoint.inf_right' (h : disjoint a b) : disjoint a (c ⊓ b) :=
-h.mono_right inf_le_right
-
-end semilattice_inf_bot
-
-end disjoint
 
-lemma inf_eq_bot_iff_le_compl [distrib_lattice α] [bounded_order α] {a b c : α}
-  (h₁ : b ⊔ c = ⊤) (h₂ : b ⊓ c = ⊥) : a ⊓ b = ⊥ ↔ a ≤ c :=
-⟨λ h,
-  calc a ≤ a ⊓ (b ⊔ c) : by simp [h₁]
-    ... = (a ⊓ b) ⊔ (a ⊓ c) : by simp [inf_sup_left]
-    ... ≤ c : by simp [h, inf_le_right],
-  λ h,
-  bot_unique $
-    calc a ⊓ b ≤ b ⊓ c : by { rw inf_comm, exact inf_le_inf_left _ h }
-      ... = ⊥ : h₂⟩
-
-section is_compl
-
-/-- Two elements `x` and `y` are complements of each other if `x ⊔ y = ⊤` and `x ⊓ y = ⊥`. -/
-structure is_compl [lattice α] [bounded_order α] (x y : α) : Prop :=
-(inf_le_bot : x ⊓ y ≤ ⊥)
-(top_le_sup : ⊤ ≤ x ⊔ y)
-
-namespace is_compl
-
-section bounded_order
-
-variables [lattice α] [bounded_order α] {x y z : α}
-
-protected lemma disjoint (h : is_compl x y) : disjoint x y := h.1
-
-@[symm] protected lemma symm (h : is_compl x y) : is_compl y x :=
-⟨by { rw inf_comm, exact h.1 }, by { rw sup_comm, exact h.2 }⟩
-
-lemma of_eq (h₁ : x ⊓ y = ⊥) (h₂ : x ⊔ y = ⊤) : is_compl x y :=
-⟨le_of_eq h₁, le_of_eq h₂.symm⟩
-
-lemma inf_eq_bot (h : is_compl x y) : x ⊓ y = ⊥ := h.disjoint.eq_bot
-
-lemma sup_eq_top (h : is_compl x y) : x ⊔ y = ⊤ := top_unique h.top_le_sup
-
-open order_dual (to_dual)
-
-lemma to_order_dual (h : is_compl x y) : is_compl (to_dual x) (to_dual y) := ⟨h.2, h.1⟩
-
-end bounded_order
-
-variables [distrib_lattice α] [bounded_order α] {a b x y z : α}
-
-lemma inf_left_le_of_le_sup_right (h : is_compl x y) (hle : a ≤ b ⊔ y) : a ⊓ x ≤ b :=
-calc a ⊓ x ≤ (b ⊔ y) ⊓ x : inf_le_inf hle le_rfl
-... = (b ⊓ x) ⊔ (y ⊓ x) : inf_sup_right
-... = b ⊓ x : by rw [h.symm.inf_eq_bot, sup_bot_eq]
-... ≤ b : inf_le_left
-
-lemma le_sup_right_iff_inf_left_le {a b} (h : is_compl x y) : a ≤ b ⊔ y ↔ a ⊓ x ≤ b :=
-⟨h.inf_left_le_of_le_sup_right, h.symm.to_order_dual.inf_left_le_of_le_sup_right⟩
-
-lemma inf_left_eq_bot_iff (h : is_compl y z) : x ⊓ y = ⊥ ↔ x ≤ z :=
-by rw [← le_bot_iff, ← h.le_sup_right_iff_inf_left_le, bot_sup_eq]
-
-lemma inf_right_eq_bot_iff (h : is_compl y z) : x ⊓ z = ⊥ ↔ x ≤ y :=
-h.symm.inf_left_eq_bot_iff
-
-lemma disjoint_left_iff (h : is_compl y z) : disjoint x y ↔ x ≤ z :=
-by { rw disjoint_iff, exact h.inf_left_eq_bot_iff }
-
-lemma disjoint_right_iff (h : is_compl y z) : disjoint x z ↔ x ≤ y :=
-h.symm.disjoint_left_iff
-
-lemma le_left_iff (h : is_compl x y) : z ≤ x ↔ disjoint z y :=
-h.disjoint_right_iff.symm
-
-lemma le_right_iff (h : is_compl x y) : z ≤ y ↔ disjoint z x :=
-h.symm.le_left_iff
-
-lemma left_le_iff (h : is_compl x y) : x ≤ z ↔ ⊤ ≤ z ⊔ y :=
-h.to_order_dual.le_left_iff
-
-lemma right_le_iff (h : is_compl x y) : y ≤ z ↔ ⊤ ≤ z ⊔ x :=
-h.symm.left_le_iff
-
-protected lemma antitone {x' y'} (h : is_compl x y) (h' : is_compl x' y') (hx : x ≤ x') :
-  y' ≤ y :=
-h'.right_le_iff.2 $ le_trans h.symm.top_le_sup (sup_le_sup_left hx _)
-
-lemma right_unique (hxy : is_compl x y) (hxz : is_compl x z) :
-  y = z :=
-le_antisymm (hxz.antitone hxy $ le_refl x) (hxy.antitone hxz $ le_refl x)
-
-lemma left_unique (hxz : is_compl x z) (hyz : is_compl y z) :
-  x = y :=
-hxz.symm.right_unique hyz.symm
-
-lemma sup_inf {x' y'} (h : is_compl x y) (h' : is_compl x' y') :
-  is_compl (x ⊔ x') (y ⊓ y') :=
-of_eq
-  (by rw [inf_sup_right, ← inf_assoc, h.inf_eq_bot, bot_inf_eq, bot_sup_eq, inf_left_comm,
-    h'.inf_eq_bot, inf_bot_eq])
-  (by rw [sup_inf_left, @sup_comm _ _ x, sup_assoc, h.sup_eq_top, sup_top_eq, top_inf_eq,
-    sup_assoc, sup_left_comm, h'.sup_eq_top, sup_top_eq])
-
-lemma inf_sup {x' y'} (h : is_compl x y) (h' : is_compl x' y') :
-  is_compl (x ⊓ x') (y ⊔ y') :=
-(h.symm.sup_inf h'.symm).symm
-
-end is_compl
-
-lemma is_compl_bot_top [lattice α] [bounded_order α] : is_compl (⊥ : α) ⊤ :=
-is_compl.of_eq bot_inf_eq sup_top_eq
-
-lemma is_compl_top_bot [lattice α] [bounded_order α] : is_compl (⊤ : α) ⊥ :=
-is_compl.of_eq inf_bot_eq top_sup_eq
-
-section
-variables [lattice α] [bounded_order α] {x : α}
-
-lemma eq_top_of_is_compl_bot (h : is_compl x ⊥) : x = ⊤ :=
-sup_bot_eq.symm.trans h.sup_eq_top
-
-lemma eq_top_of_bot_is_compl (h : is_compl ⊥ x) : x = ⊤ :=
-eq_top_of_is_compl_bot h.symm
-
-lemma eq_bot_of_is_compl_top (h : is_compl x ⊤) : x = ⊥ :=
-eq_top_of_is_compl_bot h.to_order_dual
-
-lemma eq_bot_of_top_is_compl (h : is_compl ⊤ x) : x = ⊥ :=
-eq_top_of_bot_is_compl h.to_order_dual
-
-end
-
-/-- A complemented bounded lattice is one where every element has a (not necessarily unique)
-complement. -/
-class is_complemented (α) [lattice α] [bounded_order α] : Prop :=
-(exists_is_compl : ∀ (a : α), ∃ (b : α), is_compl a b)
-
-export is_complemented (exists_is_compl)
-
-namespace is_complemented
-variables [lattice α] [bounded_order α] [is_complemented α]
-
-instance : is_complemented αᵒᵈ :=
-⟨λ a, let ⟨b, hb⟩ := exists_is_compl (show α, from a) in ⟨b, hb.to_order_dual⟩⟩
-
-end is_complemented
-
-end is_compl
 
 section nontrivial
 
 variables [partial_order α] [bounded_order α] [nontrivial α]
 
-lemma bot_ne_top : (⊥ : α) ≠ ⊤ :=
-λ H, not_nontrivial_iff_subsingleton.mpr (subsingleton_of_bot_eq_top H) ‹_›
-
-lemma top_ne_bot : (⊤ : α) ≠ ⊥ := bot_ne_top.symm
-lemma bot_lt_top : (⊥ : α) < ⊤ := lt_top_iff_ne_top.2 bot_ne_top
+@[simp] lemma bot_ne_top : (⊥ : α) ≠ ⊤ := λ h, not_subsingleton _ $ subsingleton_of_bot_eq_top h
+@[simp] lemma top_ne_bot : (⊤ : α) ≠ ⊥ := bot_ne_top.symm
+@[simp] lemma bot_lt_top : (⊥ : α) < ⊤ := lt_top_iff_ne_top.2 bot_ne_top
 
 end nontrivial
 
-namespace bool
+section bool
+
+open bool
 
--- TODO: is this comment relevant now that `bounded_order` is factored out?
--- Could be generalised to `bounded_distrib_lattice` and `is_complemented`
 instance : bounded_order bool :=
 { top := tt,
   le_top := λ x, le_tt,
   bot := ff,
   bot_le := λ x, ff_le }
 
-end bool
-
-section bool
-
 @[simp] lemma top_eq_tt : ⊤ = tt := rfl
-
 @[simp] lemma bot_eq_ff : ⊥ = ff := rfl
 
 end bool
diff --git a/src/order/bounds.lean b/src/order/bounds.lean
deleted file mode 100644
index d9972992fe65d..0000000000000
--- a/src/order/bounds.lean
+++ /dev/null
@@ -1,1117 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Yury Kudryashov
--/
-import data.set.intervals.basic
-
-/-!
-
-# Upper / lower bounds
-
-In this file we define:
-
-* `upper_bounds`, `lower_bounds` : the set of upper bounds (resp., lower bounds) of a set;
-* `bdd_above s`, `bdd_below s` : the set `s` is bounded above (resp., below), i.e., the set of upper
-  (resp., lower) bounds of `s` is nonempty;
-* `is_least s a`, `is_greatest s a` : `a` is a least (resp., greatest) element of `s`;
-  for a partial order, it is unique if exists;
-* `is_lub s a`, `is_glb s a` : `a` is a least upper bound (resp., a greatest lower bound)
-  of `s`; for a partial order, it is unique if exists.
-
-We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
-formulas for `∅`, `univ`, and intervals.
--/
-open set order_dual (to_dual of_dual)
-
-universes u v w x
-variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}
-
-section
-variables [preorder α] [preorder β] {s t : set α} {a b : α}
-
-/-!
-### Definitions
--/
-
-/-- The set of upper bounds of a set. -/
-def upper_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → a ≤ x }
-/-- The set of lower bounds of a set. -/
-def lower_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → x ≤ a }
-
-/-- A set is bounded above if there exists an upper bound. -/
-def bdd_above (s : set α) := (upper_bounds s).nonempty
-/-- A set is bounded below if there exists a lower bound. -/
-def bdd_below (s : set α) := (lower_bounds s).nonempty
-
-/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
-def is_least (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ lower_bounds s
-/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
-def is_greatest (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ upper_bounds s
-
-/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
-def is_lub (s : set α) : α → Prop := is_least (upper_bounds s)
-/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
-def is_glb (s : set α) : α → Prop := is_greatest (lower_bounds s)
-
-lemma mem_upper_bounds : a ∈ upper_bounds s ↔ ∀ x ∈ s, x ≤ a := iff.rfl
-lemma mem_lower_bounds : a ∈ lower_bounds s ↔ ∀ x ∈ s, a ≤ x := iff.rfl
-
-lemma bdd_above_def : bdd_above s ↔ ∃ x, ∀ y ∈ s, y ≤ x := iff.rfl
-lemma bdd_below_def : bdd_below s ↔ ∃ x, ∀ y ∈ s, x ≤ y := iff.rfl
-
-lemma bot_mem_lower_bounds [order_bot α] (s : set α) : ⊥ ∈ lower_bounds s := λ _ _, bot_le
-lemma top_mem_upper_bounds [order_top α] (s : set α) : ⊤ ∈ upper_bounds s := λ _ _, le_top
-
-@[simp] lemma is_least_bot_iff [order_bot α] : is_least s ⊥ ↔ ⊥ ∈ s :=
-and_iff_left $ bot_mem_lower_bounds _
-
-@[simp] lemma is_greatest_top_iff [order_top α] : is_greatest s ⊤ ↔ ⊤ ∈ s :=
-and_iff_left $ top_mem_upper_bounds _
-
-/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
-is not greater than or equal to `y`. This version only assumes `preorder` structure and uses
-`¬(y ≤ x)`. A version for linear orders is called `not_bdd_above_iff`. -/
-lemma not_bdd_above_iff' : ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, ¬(y ≤ x) :=
-by simp [bdd_above, upper_bounds, set.nonempty]
-
-/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
-is not less than or equal to `y`. This version only assumes `preorder` structure and uses
-`¬(x ≤ y)`. A version for linear orders is called `not_bdd_below_iff`. -/
-lemma not_bdd_below_iff' : ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, ¬ x ≤ y := @not_bdd_above_iff' αᵒᵈ _ _
-
-/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
-than `x`. A version for preorders is called `not_bdd_above_iff'`. -/
-lemma not_bdd_above_iff {α : Type*} [linear_order α] {s : set α} :
-  ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, x < y :=
-by simp only [not_bdd_above_iff', not_le]
-
-/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
-than `x`. A version for preorders is called `not_bdd_below_iff'`. -/
-lemma not_bdd_below_iff {α : Type*} [linear_order α] {s : set α} :
-  ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, y < x :=
-@not_bdd_above_iff αᵒᵈ _ _
-
-lemma bdd_above.dual (h : bdd_above s) : bdd_below (of_dual ⁻¹' s) := h
-
-lemma bdd_below.dual (h : bdd_below s) : bdd_above (of_dual ⁻¹' s) := h
-
-lemma is_least.dual (h : is_least s a) : is_greatest (of_dual ⁻¹' s) (to_dual a) := h
-
-lemma is_greatest.dual (h : is_greatest s a) : is_least (of_dual ⁻¹' s) (to_dual a) := h
-
-lemma is_lub.dual (h : is_lub s a) : is_glb (of_dual ⁻¹' s) (to_dual a) := h
-
-lemma is_glb.dual (h : is_glb s a) : is_lub (of_dual ⁻¹' s) (to_dual a) := h
-
-/-- If `a` is the least element of a set `s`, then subtype `s` is an order with bottom element. -/
-@[reducible] def is_least.order_bot (h : is_least s a) : order_bot s :=
-{ bot := ⟨a, h.1⟩,
-  bot_le := subtype.forall.2 h.2 }
-
-/-- If `a` is the greatest element of a set `s`, then subtype `s` is an order with top element. -/
-@[reducible] def is_greatest.order_top (h : is_greatest s a) : order_top s :=
-{ top := ⟨a, h.1⟩,
-  le_top := subtype.forall.2 h.2 }
-
-/-!
-### Monotonicity
--/
-
-lemma upper_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
-  upper_bounds t ⊆ upper_bounds s :=
-λ b hb x h, hb $ hst h
-
-lemma lower_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
-  lower_bounds t ⊆ lower_bounds s :=
-λ b hb x h, hb $ hst h
-
-lemma upper_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : a ∈ upper_bounds s → b ∈ upper_bounds s :=
-λ ha x h, le_trans (ha h) hab
-
-lemma lower_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : b ∈ lower_bounds s → a ∈ lower_bounds s :=
-λ hb x h, le_trans hab (hb h)
-
-lemma upper_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
-  a ∈ upper_bounds t → b ∈ upper_bounds s :=
-λ ha, upper_bounds_mono_set hst $ upper_bounds_mono_mem hab ha
-
-lemma lower_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
-  b ∈ lower_bounds t → a ∈ lower_bounds s :=
-λ hb, lower_bounds_mono_set hst $ lower_bounds_mono_mem hab hb
-
-/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
-lemma bdd_above.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_above t → bdd_above s :=
-nonempty.mono $ upper_bounds_mono_set h
-
-/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
-lemma bdd_below.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_below t → bdd_below s :=
-nonempty.mono $ lower_bounds_mono_set h
-
-/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
-set `t`, `s ⊆ t ⊆ p`. -/
-lemma is_lub.of_subset_of_superset {s t p : set α} (hs : is_lub s a) (hp : is_lub p a)
-  (hst : s ⊆ t) (htp : t ⊆ p) : is_lub t a :=
-⟨upper_bounds_mono_set htp hp.1, lower_bounds_mono_set (upper_bounds_mono_set hst) hs.2⟩
-
-/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
-set `t`, `s ⊆ t ⊆ p`. -/
-lemma is_glb.of_subset_of_superset {s t p : set α} (hs : is_glb s a) (hp : is_glb p a)
-  (hst : s ⊆ t) (htp : t ⊆ p) : is_glb t a :=
-hs.dual.of_subset_of_superset hp hst htp
-
-lemma is_least.mono (ha : is_least s a) (hb : is_least t b) (hst : s ⊆ t) : b ≤ a :=
-hb.2 (hst ha.1)
-
-lemma is_greatest.mono (ha : is_greatest s a) (hb : is_greatest t b) (hst : s ⊆ t) : a ≤ b :=
-hb.2 (hst ha.1)
-
-lemma is_lub.mono (ha : is_lub s a) (hb : is_lub t b) (hst : s ⊆ t) : a ≤ b :=
-hb.mono ha $ upper_bounds_mono_set hst
-
-lemma is_glb.mono (ha : is_glb s a) (hb : is_glb t b) (hst : s ⊆ t) : b ≤ a :=
-hb.mono ha $ lower_bounds_mono_set hst
-
-lemma subset_lower_bounds_upper_bounds (s : set α) : s ⊆ lower_bounds (upper_bounds s) :=
-λ x hx y hy, hy hx
-
-lemma subset_upper_bounds_lower_bounds (s : set α) : s ⊆ upper_bounds (lower_bounds s) :=
-λ x hx y hy, hy hx
-
-lemma set.nonempty.bdd_above_lower_bounds (hs : s.nonempty) : bdd_above (lower_bounds s) :=
-hs.mono (subset_upper_bounds_lower_bounds s)
-
-lemma set.nonempty.bdd_below_upper_bounds (hs : s.nonempty) : bdd_below (upper_bounds s) :=
-hs.mono (subset_lower_bounds_upper_bounds s)
-
-/-!
-### Conversions
--/
-
-lemma is_least.is_glb (h : is_least s a) : is_glb s a := ⟨h.2, λ b hb, hb h.1⟩
-
-lemma is_greatest.is_lub (h : is_greatest s a) : is_lub s a := ⟨h.2, λ b hb, hb h.1⟩
-
-lemma is_lub.upper_bounds_eq (h : is_lub s a) : upper_bounds s = Ici a :=
-set.ext $ λ b, ⟨λ hb, h.2 hb, λ hb, upper_bounds_mono_mem hb h.1⟩
-
-lemma is_glb.lower_bounds_eq (h : is_glb s a) : lower_bounds s = Iic a := h.dual.upper_bounds_eq
-
-lemma is_least.lower_bounds_eq (h : is_least s a) : lower_bounds s = Iic a :=
-h.is_glb.lower_bounds_eq
-
-lemma is_greatest.upper_bounds_eq (h : is_greatest s a) : upper_bounds s = Ici a :=
-h.is_lub.upper_bounds_eq
-
-lemma is_lub_le_iff (h : is_lub s a) : a ≤ b ↔ b ∈ upper_bounds s :=
-by { rw h.upper_bounds_eq, refl }
-
-lemma le_is_glb_iff (h : is_glb s a) : b ≤ a ↔ b ∈ lower_bounds s :=
-by { rw h.lower_bounds_eq, refl }
-
-lemma is_lub_iff_le_iff : is_lub s a ↔ ∀ b, a ≤ b ↔ b ∈ upper_bounds s :=
-⟨λ h b, is_lub_le_iff h, λ H, ⟨(H _).1 le_rfl, λ b hb, (H b).2 hb⟩⟩
-
-lemma is_glb_iff_le_iff : is_glb s a ↔ ∀ b, b ≤ a ↔ b ∈ lower_bounds s :=
-@is_lub_iff_le_iff αᵒᵈ _ _ _
-
-/-- If `s` has a least upper bound, then it is bounded above. -/
-lemma is_lub.bdd_above (h : is_lub s a) : bdd_above s := ⟨a, h.1⟩
-
-/-- If `s` has a greatest lower bound, then it is bounded below. -/
-lemma is_glb.bdd_below (h : is_glb s a) : bdd_below s := ⟨a, h.1⟩
-
-/-- If `s` has a greatest element, then it is bounded above. -/
-lemma is_greatest.bdd_above (h : is_greatest s a) : bdd_above s := ⟨a, h.2⟩
-
-/-- If `s` has a least element, then it is bounded below. -/
-lemma is_least.bdd_below (h : is_least s a) : bdd_below s := ⟨a, h.2⟩
-
-lemma is_least.nonempty (h : is_least s a) : s.nonempty := ⟨a, h.1⟩
-
-lemma is_greatest.nonempty (h : is_greatest s a) : s.nonempty := ⟨a, h.1⟩
-
-/-!
-### Union and intersection
--/
-
-@[simp] lemma upper_bounds_union : upper_bounds (s ∪ t) = upper_bounds s ∩ upper_bounds t :=
-subset.antisymm
-  (λ b hb, ⟨λ x hx, hb (or.inl hx), λ x hx, hb (or.inr hx)⟩)
-  (λ b hb x hx, hx.elim (λ hs, hb.1 hs) (λ ht, hb.2 ht))
-
-@[simp] lemma lower_bounds_union : lower_bounds (s ∪ t) = lower_bounds s ∩ lower_bounds t :=
-@upper_bounds_union αᵒᵈ _ s t
-
-lemma union_upper_bounds_subset_upper_bounds_inter :
-  upper_bounds s ∪ upper_bounds t ⊆ upper_bounds (s ∩ t) :=
-union_subset
-  (upper_bounds_mono_set $ inter_subset_left _ _)
-  (upper_bounds_mono_set $ inter_subset_right _ _)
-
-lemma union_lower_bounds_subset_lower_bounds_inter :
-  lower_bounds s ∪ lower_bounds t ⊆ lower_bounds (s ∩ t) :=
-@union_upper_bounds_subset_upper_bounds_inter αᵒᵈ _ s t
-
-lemma is_least_union_iff {a : α} {s t : set α} :
-  is_least (s ∪ t) a ↔ (is_least s a ∧ a ∈ lower_bounds t ∨ a ∈ lower_bounds s ∧ is_least t a) :=
-by simp [is_least, lower_bounds_union, or_and_distrib_right, and_comm (a ∈ t), and_assoc]
-
-lemma is_greatest_union_iff :
-  is_greatest (s ∪ t) a ↔ (is_greatest s a ∧ a ∈ upper_bounds t ∨
-    a ∈ upper_bounds s ∧ is_greatest t a) :=
-@is_least_union_iff αᵒᵈ _ a s t
-
-/-- If `s` is bounded, then so is `s ∩ t` -/
-lemma bdd_above.inter_of_left (h : bdd_above s) : bdd_above (s ∩ t) :=
-h.mono $ inter_subset_left s t
-
-/-- If `t` is bounded, then so is `s ∩ t` -/
-lemma bdd_above.inter_of_right (h : bdd_above t) : bdd_above (s ∩ t) :=
-h.mono $ inter_subset_right s t
-
-/-- If `s` is bounded, then so is `s ∩ t` -/
-lemma bdd_below.inter_of_left (h : bdd_below s) : bdd_below (s ∩ t) :=
-h.mono $ inter_subset_left s t
-
-/-- If `t` is bounded, then so is `s ∩ t` -/
-lemma bdd_below.inter_of_right (h : bdd_below t) : bdd_below (s ∩ t) :=
-h.mono $ inter_subset_right s t
-
-/-- If `s` and `t` are bounded above sets in a `semilattice_sup`, then so is `s ∪ t`. -/
-lemma bdd_above.union [semilattice_sup γ] {s t : set γ} :
-  bdd_above s → bdd_above t → bdd_above (s ∪ t) :=
-begin
-  rintros ⟨bs, hs⟩ ⟨bt, ht⟩,
-  use bs ⊔ bt,
-  rw upper_bounds_union,
-  exact ⟨upper_bounds_mono_mem le_sup_left hs,
-    upper_bounds_mono_mem le_sup_right ht⟩
-end
-
-/-- The union of two sets is bounded above if and only if each of the sets is. -/
-lemma bdd_above_union [semilattice_sup γ] {s t : set γ} :
-  bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t :=
-⟨λ h, ⟨h.mono $ subset_union_left s t, h.mono $ subset_union_right s t⟩,
-  λ h, h.1.union h.2⟩
-
-lemma bdd_below.union [semilattice_inf γ] {s t : set γ} :
-  bdd_below s → bdd_below t → bdd_below (s ∪ t) :=
-@bdd_above.union γᵒᵈ _ s t
-
-/--The union of two sets is bounded above if and only if each of the sets is.-/
-lemma bdd_below_union [semilattice_inf γ] {s t : set γ} :
-  bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
-@bdd_above_union γᵒᵈ _ s t
-
-/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
-then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
-lemma is_lub.union [semilattice_sup γ] {a b : γ} {s t : set γ}
-  (hs : is_lub s a) (ht : is_lub t b) :
-  is_lub (s ∪ t) (a ⊔ b) :=
-⟨λ c h, h.cases_on (λ h, le_sup_of_le_left $ hs.left h) (λ h, le_sup_of_le_right $ ht.left h),
-  assume c hc, sup_le
-    (hs.right $ assume d hd, hc $ or.inl hd) (ht.right $ assume d hd, hc $ or.inr hd)⟩
-
-/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
-then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
-lemma is_glb.union [semilattice_inf γ] {a₁ a₂ : γ} {s t : set γ}
-  (hs : is_glb s a₁) (ht : is_glb t a₂) :
-  is_glb (s ∪ t) (a₁ ⊓ a₂) :=
-hs.dual.union ht
-
-/-- If `a` is the least element of `s` and `b` is the least element of `t`,
-then `min a b` is the least element of `s ∪ t`. -/
-lemma is_least.union [linear_order γ] {a b : γ} {s t : set γ}
-  (ha : is_least s a) (hb : is_least t b) : is_least (s ∪ t) (min a b) :=
-⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
-  (ha.is_glb.union hb.is_glb).1⟩
-
-/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
-then `max a b` is the greatest element of `s ∪ t`. -/
-lemma is_greatest.union [linear_order γ] {a b : γ} {s t : set γ}
-  (ha : is_greatest s a) (hb : is_greatest t b) : is_greatest (s ∪ t) (max a b) :=
-⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
-  (ha.is_lub.union hb.is_lub).1⟩
-
-lemma is_lub.inter_Ici_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_lub s a)
-  (hb : b ∈ s) : is_lub (s ∩ Ici b) a :=
-⟨λ x hx, ha.1 hx.1, λ c hc, have hbc : b ≤ c, from hc ⟨hb, le_rfl⟩,
-  ha.2 $ λ x hx, (le_total x b).elim (λ hxb, hxb.trans hbc) $ λ hbx, hc ⟨hx, hbx⟩⟩
-
-lemma is_glb.inter_Iic_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_glb s a)
-  (hb : b ∈ s) : is_glb (s ∩ Iic b) a :=
-ha.dual.inter_Ici_of_mem hb
-
-lemma bdd_above_iff_exists_ge [semilattice_sup γ] {s : set γ} (x₀ : γ) :
-  bdd_above s ↔ ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
-by { rw [bdd_above_def, exists_ge_and_iff_exists], exact monotone.ball (λ x hx, monotone_le) }
-
-lemma bdd_below_iff_exists_le [semilattice_inf γ] {s : set γ} (x₀ : γ) :
-  bdd_below s ↔ ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
-bdd_above_iff_exists_ge (to_dual x₀)
-
-lemma bdd_above.exists_ge  [semilattice_sup γ] {s : set γ} (hs : bdd_above s) (x₀ : γ) :
-  ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
-(bdd_above_iff_exists_ge x₀).mp hs
-
-lemma bdd_below.exists_le  [semilattice_inf γ] {s : set γ} (hs : bdd_below s) (x₀ : γ) :
-  ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
-(bdd_below_iff_exists_le x₀).mp hs
-
-/-!
-### Specific sets
-
-#### Unbounded intervals
--/
-
-lemma is_least_Ici : is_least (Ici a) a := ⟨left_mem_Ici, λ x, id⟩
-
-lemma is_greatest_Iic : is_greatest (Iic a) a := ⟨right_mem_Iic, λ x, id⟩
-
-lemma is_lub_Iic : is_lub (Iic a) a := is_greatest_Iic.is_lub
-
-lemma is_glb_Ici : is_glb (Ici a) a := is_least_Ici.is_glb
-
-lemma upper_bounds_Iic : upper_bounds (Iic a) = Ici a := is_lub_Iic.upper_bounds_eq
-
-lemma lower_bounds_Ici : lower_bounds (Ici a) = Iic a := is_glb_Ici.lower_bounds_eq
-
-lemma bdd_above_Iic : bdd_above (Iic a) := is_lub_Iic.bdd_above
-
-lemma bdd_below_Ici : bdd_below (Ici a) := is_glb_Ici.bdd_below
-
-lemma bdd_above_Iio : bdd_above (Iio a) := ⟨a, λ x hx, le_of_lt hx⟩
-
-lemma bdd_below_Ioi : bdd_below (Ioi a) := ⟨a, λ x hx, le_of_lt hx⟩
-
-lemma lub_Iio_le (a : α) (hb : is_lub (set.Iio a) b) : b ≤ a :=
-(is_lub_le_iff hb).mpr $ λ k hk, le_of_lt hk
-
-lemma le_glb_Ioi (a : α) (hb : is_glb (set.Ioi a) b) : a ≤ b := @lub_Iio_le αᵒᵈ _ _ a hb
-
-lemma lub_Iio_eq_self_or_Iio_eq_Iic [partial_order γ] {j : γ} (i : γ) (hj : is_lub (set.Iio i) j) :
-  j = i ∨ set.Iio i = set.Iic j :=
-begin
-  cases eq_or_lt_of_le (lub_Iio_le i hj) with hj_eq_i hj_lt_i,
-  { exact or.inl hj_eq_i, },
-  { right,
-    exact set.ext (λ k, ⟨λ hk_lt, hj.1 hk_lt, λ hk_le_j, lt_of_le_of_lt hk_le_j hj_lt_i⟩), },
-end
-
-lemma glb_Ioi_eq_self_or_Ioi_eq_Ici [partial_order γ] {j : γ} (i : γ) (hj : is_glb (set.Ioi i) j) :
-  j = i ∨ set.Ioi i = set.Ici j :=
-@lub_Iio_eq_self_or_Iio_eq_Iic γᵒᵈ _ j i hj
-
-section
-
-variables [linear_order γ]
-
-lemma exists_lub_Iio (i : γ) : ∃ j, is_lub (set.Iio i) j :=
-begin
-  by_cases h_exists_lt : ∃ j, j ∈ upper_bounds (set.Iio i) ∧ j < i,
-  { obtain ⟨j, hj_ub, hj_lt_i⟩ := h_exists_lt,
-    exact ⟨j, hj_ub, λ k hk_ub, hk_ub hj_lt_i⟩, },
-  { refine ⟨i, λ j hj, le_of_lt hj, _⟩,
-    rw mem_lower_bounds,
-    by_contra,
-    refine h_exists_lt _,
-    push_neg at h,
-    exact h, },
-end
-
-lemma exists_glb_Ioi (i : γ) : ∃ j, is_glb (set.Ioi i) j := @exists_lub_Iio γᵒᵈ _ i
-
-variables [densely_ordered γ]
-
-lemma is_lub_Iio {a : γ} : is_lub (Iio a) a :=
-⟨λ x hx, le_of_lt hx, λ y hy, le_of_forall_ge_of_dense hy⟩
-
-lemma is_glb_Ioi {a : γ} : is_glb (Ioi a) a := @is_lub_Iio γᵒᵈ _ _ a
-
-lemma upper_bounds_Iio {a : γ} : upper_bounds (Iio a) = Ici a := is_lub_Iio.upper_bounds_eq
-
-lemma lower_bounds_Ioi {a : γ} : lower_bounds (Ioi a) = Iic a := is_glb_Ioi.lower_bounds_eq
-
-end
-
-/-!
-#### Singleton
--/
-
-lemma is_greatest_singleton : is_greatest {a} a :=
-⟨mem_singleton a, λ x hx, le_of_eq $ eq_of_mem_singleton hx⟩
-
-lemma is_least_singleton : is_least {a} a := @is_greatest_singleton αᵒᵈ _ a
-
-lemma is_lub_singleton : is_lub {a} a := is_greatest_singleton.is_lub
-
-lemma is_glb_singleton : is_glb {a} a := is_least_singleton.is_glb
-
-lemma bdd_above_singleton : bdd_above ({a} : set α) := is_lub_singleton.bdd_above
-
-lemma bdd_below_singleton : bdd_below ({a} : set α) := is_glb_singleton.bdd_below
-
-@[simp] lemma upper_bounds_singleton : upper_bounds {a} = Ici a := is_lub_singleton.upper_bounds_eq
-
-@[simp] lemma lower_bounds_singleton : lower_bounds {a} = Iic a := is_glb_singleton.lower_bounds_eq
-
-/-!
-#### Bounded intervals
--/
-
-lemma bdd_above_Icc : bdd_above (Icc a b) := ⟨b, λ _, and.right⟩
-
-lemma bdd_below_Icc : bdd_below (Icc a b) := ⟨a, λ _, and.left⟩
-
-lemma bdd_above_Ico : bdd_above (Ico a b) := bdd_above_Icc.mono Ico_subset_Icc_self
-
-lemma bdd_below_Ico : bdd_below (Ico a b) := bdd_below_Icc.mono Ico_subset_Icc_self
-
-lemma bdd_above_Ioc : bdd_above (Ioc a b) := bdd_above_Icc.mono Ioc_subset_Icc_self
-
-lemma bdd_below_Ioc : bdd_below (Ioc a b) := bdd_below_Icc.mono Ioc_subset_Icc_self
-
-lemma bdd_above_Ioo : bdd_above (Ioo a b) := bdd_above_Icc.mono Ioo_subset_Icc_self
-
-lemma bdd_below_Ioo : bdd_below (Ioo a b) := bdd_below_Icc.mono Ioo_subset_Icc_self
-
-lemma is_greatest_Icc (h : a ≤ b) : is_greatest (Icc a b) b :=
-⟨right_mem_Icc.2 h, λ x, and.right⟩
-
-lemma is_lub_Icc (h : a ≤ b) : is_lub (Icc a b) b := (is_greatest_Icc h).is_lub
-
-lemma upper_bounds_Icc (h : a ≤ b) : upper_bounds (Icc a b) = Ici b :=
-(is_lub_Icc h).upper_bounds_eq
-
-lemma is_least_Icc (h : a ≤ b) : is_least (Icc a b) a :=
-⟨left_mem_Icc.2 h, λ x, and.left⟩
-
-lemma is_glb_Icc (h : a ≤ b) : is_glb (Icc a b) a := (is_least_Icc h).is_glb
-
-lemma lower_bounds_Icc (h : a ≤ b) : lower_bounds (Icc a b) = Iic a :=
-(is_glb_Icc h).lower_bounds_eq
-
-lemma is_greatest_Ioc (h : a < b) : is_greatest (Ioc a b) b :=
-⟨right_mem_Ioc.2 h, λ x, and.right⟩
-
-lemma is_lub_Ioc (h : a < b) : is_lub (Ioc a b) b :=
-(is_greatest_Ioc h).is_lub
-
-lemma upper_bounds_Ioc (h : a < b) : upper_bounds (Ioc a b) = Ici b :=
-(is_lub_Ioc h).upper_bounds_eq
-
-lemma is_least_Ico (h : a < b) : is_least (Ico a b) a :=
-⟨left_mem_Ico.2 h, λ x, and.left⟩
-
-lemma is_glb_Ico (h : a < b) : is_glb (Ico a b) a :=
-(is_least_Ico h).is_glb
-
-lemma lower_bounds_Ico (h : a < b) : lower_bounds (Ico a b) = Iic a :=
-(is_glb_Ico h).lower_bounds_eq
-
-section
-
-variables [semilattice_sup γ] [densely_ordered γ]
-
-lemma is_glb_Ioo {a b : γ} (h : a < b) :
-  is_glb (Ioo a b) a :=
-⟨λ x hx, hx.1.le, λ x hx,
-begin
-  cases eq_or_lt_of_le (le_sup_right : a ≤ x ⊔ a) with h₁ h₂,
-  { exact h₁.symm ▸ le_sup_left },
-  obtain ⟨y, lty, ylt⟩ := exists_between h₂,
-  apply (not_lt_of_le (sup_le (hx ⟨lty, ylt.trans_le (sup_le _ h.le)⟩) lty.le) ylt).elim,
-  obtain ⟨u, au, ub⟩ := exists_between h,
-  apply (hx ⟨au, ub⟩).trans ub.le,
-end⟩
-
-lemma lower_bounds_Ioo {a b : γ} (hab : a < b) : lower_bounds (Ioo a b) = Iic a :=
-(is_glb_Ioo hab).lower_bounds_eq
-
-lemma is_glb_Ioc {a b : γ} (hab : a < b) : is_glb (Ioc a b) a :=
-(is_glb_Ioo hab).of_subset_of_superset (is_glb_Icc hab.le) Ioo_subset_Ioc_self Ioc_subset_Icc_self
-
-lemma lower_bound_Ioc {a b : γ} (hab : a < b) : lower_bounds (Ioc a b) = Iic a :=
-(is_glb_Ioc hab).lower_bounds_eq
-
-end
-
-section
-
-variables [semilattice_inf γ] [densely_ordered γ]
-
-lemma is_lub_Ioo {a b : γ} (hab : a < b) : is_lub (Ioo a b) b :=
-by simpa only [dual_Ioo] using is_glb_Ioo hab.dual
-
-lemma upper_bounds_Ioo {a b : γ} (hab : a < b) : upper_bounds (Ioo a b) = Ici b :=
-(is_lub_Ioo hab).upper_bounds_eq
-
-lemma is_lub_Ico {a b : γ} (hab : a < b) : is_lub (Ico a b) b :=
-by simpa only [dual_Ioc] using is_glb_Ioc hab.dual
-
-lemma upper_bounds_Ico {a b : γ} (hab : a < b) : upper_bounds (Ico a b) = Ici b :=
-(is_lub_Ico hab).upper_bounds_eq
-
-end
-
-lemma bdd_below_iff_subset_Ici : bdd_below s ↔ ∃ a, s ⊆ Ici a := iff.rfl
-
-lemma bdd_above_iff_subset_Iic : bdd_above s ↔ ∃ a, s ⊆ Iic a := iff.rfl
-
-lemma bdd_below_bdd_above_iff_subset_Icc : bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ Icc a b :=
-by simp only [Ici_inter_Iic.symm, subset_inter_iff, bdd_below_iff_subset_Ici,
-  bdd_above_iff_subset_Iic, exists_and_distrib_left, exists_and_distrib_right]
-
-/-!
-#### Univ
--/
-
-lemma is_greatest_univ [preorder γ] [order_top γ] : is_greatest (univ : set γ) ⊤ :=
-⟨mem_univ _, λ x hx, le_top⟩
-
-@[simp] lemma order_top.upper_bounds_univ [partial_order γ] [order_top γ] :
-  upper_bounds (univ : set γ) = {⊤} :=
-by rw [is_greatest_univ.upper_bounds_eq, Ici_top]
-
-lemma is_lub_univ [preorder γ] [order_top γ] : is_lub (univ : set γ) ⊤ :=
-is_greatest_univ.is_lub
-
-@[simp] lemma order_bot.lower_bounds_univ [partial_order γ] [order_bot γ] :
-  lower_bounds (univ : set γ) = {⊥} :=
-@order_top.upper_bounds_univ γᵒᵈ _ _
-
-lemma is_least_univ [preorder γ] [order_bot γ] : is_least (univ : set γ) ⊥ :=
-@is_greatest_univ γᵒᵈ _ _
-
-lemma is_glb_univ [preorder γ] [order_bot γ] : is_glb (univ : set γ) ⊥ :=
-is_least_univ.is_glb
-
-@[simp] lemma no_max_order.upper_bounds_univ [no_max_order α] : upper_bounds (univ : set α) = ∅ :=
-eq_empty_of_subset_empty $ λ b hb, let ⟨x, hx⟩ := exists_gt b in
-not_le_of_lt hx (hb trivial)
-
-@[simp] lemma no_min_order.lower_bounds_univ [no_min_order α] : lower_bounds (univ : set α) = ∅ :=
-@no_max_order.upper_bounds_univ αᵒᵈ _ _
-
-@[simp] lemma not_bdd_above_univ [no_max_order α] : ¬bdd_above (univ : set α) :=
-by simp [bdd_above]
-
-@[simp] lemma not_bdd_below_univ [no_min_order α] : ¬bdd_below (univ : set α) :=
-@not_bdd_above_univ αᵒᵈ _ _
-
-/-!
-#### Empty set
--/
-
-@[simp] lemma upper_bounds_empty : upper_bounds (∅ : set α) = univ :=
-by simp only [upper_bounds, eq_univ_iff_forall, mem_set_of_eq, ball_empty_iff, forall_true_iff]
-
-@[simp] lemma lower_bounds_empty : lower_bounds (∅ : set α) = univ := @upper_bounds_empty αᵒᵈ _
-
-@[simp] lemma bdd_above_empty [nonempty α] : bdd_above (∅ : set α) :=
-by simp only [bdd_above, upper_bounds_empty, univ_nonempty]
-
-@[simp] lemma bdd_below_empty [nonempty α] : bdd_below (∅ : set α) :=
-by simp only [bdd_below, lower_bounds_empty, univ_nonempty]
-
-lemma is_glb_empty [preorder γ] [order_top γ] : is_glb ∅ (⊤:γ) :=
-by simp only [is_glb, lower_bounds_empty, is_greatest_univ]
-
-lemma is_lub_empty [preorder γ] [order_bot γ] : is_lub ∅ (⊥:γ) := @is_glb_empty γᵒᵈ _ _
-
-lemma is_lub.nonempty [no_min_order α] (hs : is_lub s a) : s.nonempty :=
-let ⟨a', ha'⟩ := exists_lt a in
-ne_empty_iff_nonempty.1 $ assume h,
-have a ≤ a', from hs.right $ by simp only [h, upper_bounds_empty],
-not_le_of_lt ha' this
-
-lemma is_glb.nonempty [no_max_order α] (hs : is_glb s a) : s.nonempty := hs.dual.nonempty
-
-lemma nonempty_of_not_bdd_above [ha : nonempty α] (h : ¬bdd_above s) : s.nonempty :=
-nonempty.elim ha $ λ x, (not_bdd_above_iff'.1 h x).imp $ λ a ha, ha.fst
-
-lemma nonempty_of_not_bdd_below [ha : nonempty α] (h : ¬bdd_below s) : s.nonempty :=
-@nonempty_of_not_bdd_above αᵒᵈ _ _ _ h
-
-/-!
-#### insert
--/
-
-/-- Adding a point to a set preserves its boundedness above. -/
-@[simp] lemma bdd_above_insert [semilattice_sup γ] (a : γ) {s : set γ} :
-  bdd_above (insert a s) ↔ bdd_above s :=
-by simp only [insert_eq, bdd_above_union, bdd_above_singleton, true_and]
-
-lemma bdd_above.insert [semilattice_sup γ] (a : γ) {s : set γ} (hs : bdd_above s) :
-  bdd_above (insert a s) :=
-(bdd_above_insert a).2 hs
-
-/--Adding a point to a set preserves its boundedness below.-/
-@[simp] lemma bdd_below_insert [semilattice_inf γ] (a : γ) {s : set γ} :
-  bdd_below (insert a s) ↔ bdd_below s :=
-by simp only [insert_eq, bdd_below_union, bdd_below_singleton, true_and]
-
-lemma bdd_below.insert [semilattice_inf γ] (a : γ) {s : set γ} (hs : bdd_below s) :
-  bdd_below (insert a s) :=
-(bdd_below_insert a).2 hs
-
-lemma is_lub.insert [semilattice_sup γ] (a) {b} {s : set γ} (hs : is_lub s b) :
-  is_lub (insert a s) (a ⊔ b) :=
-by { rw insert_eq, exact is_lub_singleton.union hs }
-
-lemma is_glb.insert [semilattice_inf γ] (a) {b} {s : set γ} (hs : is_glb s b) :
-  is_glb (insert a s) (a ⊓ b) :=
-by { rw insert_eq, exact is_glb_singleton.union hs }
-
-lemma is_greatest.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_greatest s b) :
-  is_greatest (insert a s) (max a b) :=
-by { rw insert_eq, exact is_greatest_singleton.union hs }
-
-lemma is_least.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_least s b) :
-  is_least (insert a s) (min a b) :=
-by { rw insert_eq, exact is_least_singleton.union hs }
-
-@[simp] lemma upper_bounds_insert (a : α) (s : set α) :
-  upper_bounds (insert a s) = Ici a ∩ upper_bounds s :=
-by rw [insert_eq, upper_bounds_union, upper_bounds_singleton]
-
-@[simp] lemma lower_bounds_insert (a : α) (s : set α) :
-  lower_bounds (insert a s) = Iic a ∩ lower_bounds s :=
-by rw [insert_eq, lower_bounds_union, lower_bounds_singleton]
-
-/-- When there is a global maximum, every set is bounded above. -/
-@[simp] protected lemma order_top.bdd_above [preorder γ] [order_top γ] (s : set γ) : bdd_above s :=
-⟨⊤, assume a ha, order_top.le_top a⟩
-
-/-- When there is a global minimum, every set is bounded below. -/
-@[simp] protected lemma order_bot.bdd_below [preorder γ] [order_bot γ] (s : set γ) : bdd_below s :=
-⟨⊥, assume a ha, order_bot.bot_le a⟩
-
-/-!
-#### Pair
--/
-
-lemma is_lub_pair [semilattice_sup γ] {a b : γ} : is_lub {a, b} (a ⊔ b) :=
-is_lub_singleton.insert _
-
-lemma is_glb_pair [semilattice_inf γ] {a b : γ} : is_glb {a, b} (a ⊓ b) :=
-is_glb_singleton.insert _
-
-lemma is_least_pair [linear_order γ] {a b : γ} : is_least {a, b} (min a b) :=
-is_least_singleton.insert _
-
-lemma is_greatest_pair [linear_order γ] {a b : γ} : is_greatest {a, b} (max a b) :=
-is_greatest_singleton.insert _
-
-/-!
-#### Lower/upper bounds
--/
-
-@[simp] lemma is_lub_lower_bounds : is_lub (lower_bounds s) a ↔ is_glb s a :=
-⟨λ H, ⟨λ x hx, H.2 $ subset_upper_bounds_lower_bounds s hx, H.1⟩, is_greatest.is_lub⟩
-
-@[simp] lemma is_glb_upper_bounds : is_glb (upper_bounds s) a ↔ is_lub s a :=
-@is_lub_lower_bounds αᵒᵈ _ _ _
-
-end
-
-/-!
-### (In)equalities with the least upper bound and the greatest lower bound
--/
-
-section preorder
-variables [preorder α] {s : set α} {a b : α}
-
-lemma lower_bounds_le_upper_bounds (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) :
-  s.nonempty → a ≤ b
-| ⟨c, hc⟩ := le_trans (ha hc) (hb hc)
-
-lemma is_glb_le_is_lub (ha : is_glb s a) (hb : is_lub s b) (hs : s.nonempty) : a ≤ b :=
-lower_bounds_le_upper_bounds ha.1 hb.1 hs
-
-lemma is_lub_lt_iff (ha : is_lub s a) : a < b ↔ ∃ c ∈ upper_bounds s, c < b :=
-⟨λ hb, ⟨a, ha.1, hb⟩, λ ⟨c, hcs, hcb⟩, lt_of_le_of_lt (ha.2 hcs) hcb⟩
-
-lemma lt_is_glb_iff (ha : is_glb s a) : b < a ↔ ∃ c ∈ lower_bounds s, b < c := is_lub_lt_iff ha.dual
-
-lemma le_of_is_lub_le_is_glb {x y} (ha : is_glb s a) (hb : is_lub s b) (hab : b ≤ a)
-  (hx : x ∈ s) (hy : y ∈ s) : x ≤ y :=
-calc x ≤ b : hb.1 hx
-   ... ≤ a : hab
-   ... ≤ y : ha.1 hy
-
-end preorder
-
-section partial_order
-variables [partial_order α] {s : set α} {a b : α}
-
-lemma is_least.unique (Ha : is_least s a) (Hb : is_least s b) : a = b :=
-le_antisymm (Ha.right Hb.left) (Hb.right Ha.left)
-
-lemma is_least.is_least_iff_eq (Ha : is_least s a) : is_least s b ↔ a = b :=
-iff.intro Ha.unique (assume h, h ▸ Ha)
-
-lemma is_greatest.unique (Ha : is_greatest s a) (Hb : is_greatest s b) : a = b :=
-le_antisymm (Hb.right Ha.left) (Ha.right Hb.left)
-
-lemma is_greatest.is_greatest_iff_eq (Ha : is_greatest s a) : is_greatest s b ↔ a = b :=
-iff.intro Ha.unique (assume h, h ▸ Ha)
-
-lemma is_lub.unique (Ha : is_lub s a) (Hb : is_lub s b) : a = b :=
-Ha.unique Hb
-
-lemma is_glb.unique (Ha : is_glb s a) (Hb : is_glb s b) : a = b :=
-Ha.unique Hb
-
-lemma set.subsingleton_of_is_lub_le_is_glb (Ha : is_glb s a) (Hb : is_lub s b) (hab : b ≤ a) :
-  s.subsingleton :=
-λ x hx y hy, le_antisymm (le_of_is_lub_le_is_glb Ha Hb hab hx hy)
-  (le_of_is_lub_le_is_glb Ha Hb hab hy hx)
-
-lemma is_glb_lt_is_lub_of_ne (Ha : is_glb s a) (Hb : is_lub s b)
-  {x y} (Hx : x ∈ s) (Hy : y ∈ s) (Hxy : x ≠ y) :
-  a < b :=
-lt_iff_le_not_le.2
-  ⟨lower_bounds_le_upper_bounds Ha.1 Hb.1 ⟨x, Hx⟩,
-    λ hab, Hxy $ set.subsingleton_of_is_lub_le_is_glb Ha Hb hab Hx Hy⟩
-
-end partial_order
-
-section linear_order
-variables [linear_order α] {s : set α} {a b : α}
-
-lemma lt_is_lub_iff (h : is_lub s a) : b < a ↔ ∃ c ∈ s, b < c :=
-by simp only [← not_le, is_lub_le_iff h, mem_upper_bounds, not_forall]
-
-lemma is_glb_lt_iff (h : is_glb s a) : a < b ↔ ∃ c ∈ s, c < b := lt_is_lub_iff h.dual
-
-lemma is_lub.exists_between (h : is_lub s a) (hb : b < a) :
-  ∃ c ∈ s, b < c ∧ c ≤ a :=
-let ⟨c, hcs, hbc⟩ := (lt_is_lub_iff h).1 hb in ⟨c, hcs, hbc, h.1 hcs⟩
-
-lemma is_lub.exists_between' (h : is_lub s a) (h' : a ∉ s) (hb : b < a) :
-  ∃ c ∈ s, b < c ∧ c < a :=
-let ⟨c, hcs, hbc, hca⟩ := h.exists_between hb
-in ⟨c, hcs, hbc, hca.lt_of_ne $ λ hac, h' $ hac ▸ hcs⟩
-
-lemma is_glb.exists_between (h : is_glb s a) (hb : a < b) :
-  ∃ c ∈ s, a ≤ c ∧ c < b :=
-let ⟨c, hcs, hbc⟩ := (is_glb_lt_iff h).1 hb in ⟨c, hcs, h.1 hcs, hbc⟩
-
-lemma is_glb.exists_between' (h : is_glb s a) (h' : a ∉ s) (hb : a < b) :
-  ∃ c ∈ s, a < c ∧ c < b :=
-let ⟨c, hcs, hac, hcb⟩ := h.exists_between hb
-in ⟨c, hcs, hac.lt_of_ne $ λ hac, h' $ hac.symm ▸ hcs, hcb⟩
-
-end linear_order
-
-/-!
-### Least upper bound and the greatest lower bound in linear ordered additive commutative groups
--/
-
-section linear_ordered_add_comm_group
-
-variables [linear_ordered_add_comm_group α] {s : set α} {a ε : α}
-
-lemma is_glb.exists_between_self_add (h : is_glb s a) (hε : 0 < ε) :
-  ∃ b ∈ s, a ≤ b ∧ b < a + ε :=
-h.exists_between $ lt_add_of_pos_right _ hε
-
-lemma is_glb.exists_between_self_add' (h : is_glb s a) (h₂ : a ∉ s) (hε : 0 < ε) :
-  ∃ b ∈ s, a < b ∧ b < a + ε :=
-h.exists_between' h₂ $ lt_add_of_pos_right _ hε
-
-lemma is_lub.exists_between_sub_self  (h : is_lub s a) (hε : 0 < ε) : ∃ b ∈ s, a - ε < b ∧ b ≤ a :=
-h.exists_between $ sub_lt_self _ hε
-
-lemma is_lub.exists_between_sub_self' (h : is_lub s a) (h₂ : a ∉ s) (hε : 0 < ε) :
-  ∃ b ∈ s, a - ε < b ∧ b < a :=
-h.exists_between' h₂ $ sub_lt_self _ hε
-
-end linear_ordered_add_comm_group
-
-/-!
-### Images of upper/lower bounds under monotone functions
--/
-
-namespace monotone_on
-
-variables [preorder α] [preorder β] {f : α → β} {s t : set α}
-  (Hf : monotone_on f t) {a : α} (Hst : s ⊆ t)
-include Hf Hst
-
-lemma mem_upper_bounds_image (Has : a ∈ upper_bounds s) (Hat : a ∈ t) :
-  f a ∈ upper_bounds (f '' s) :=
-ball_image_of_ball (assume x H,  Hf (Hst H) Hat (Has H))
-
-lemma mem_lower_bounds_image (Has : a ∈ lower_bounds s) (Hat : a ∈ t) :
-  f a ∈ lower_bounds (f '' s) :=
-ball_image_of_ball (assume x H,  Hf Hat (Hst H) (Has H))
-
-lemma image_upper_bounds_subset_upper_bounds_image :
-  f '' (upper_bounds s ∩ t) ⊆ upper_bounds (f '' s) :=
-by { rintro _ ⟨a, ha, rfl⟩, exact Hf.mem_upper_bounds_image Hst ha.1 ha.2 }
-
-lemma image_lower_bounds_subset_lower_bounds_image :
-  f '' (lower_bounds s ∩ t) ⊆ lower_bounds (f '' s) :=
-Hf.dual.image_upper_bounds_subset_upper_bounds_image Hst
-
-/-- The image under a monotone function on a set `t` of a subset which has an upper bound in `t`
-  is bounded above. -/
-lemma map_bdd_above : (upper_bounds s ∩ t).nonempty → bdd_above (f '' s) :=
-λ ⟨C, hs, ht⟩, ⟨f C, Hf.mem_upper_bounds_image Hst hs ht⟩
-
-/-- The image under a monotone function on a set `t` of a subset which has a lower bound in `t`
-  is bounded below. -/
-lemma map_bdd_below : (lower_bounds s ∩ t).nonempty → bdd_below (f '' s) :=
-λ ⟨C, hs, ht⟩, ⟨f C, Hf.mem_lower_bounds_image Hst hs ht⟩
-
-/-- A monotone map sends a least element of a set to a least element of its image. -/
-lemma map_is_least (Ha : is_least s a) : is_least (f '' s) (f a) :=
-⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image Hst Ha.2 (Hst Ha.1)⟩
-
-/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
-lemma map_is_greatest (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
-⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image Hst Ha.2 (Hst Ha.1)⟩
-
-lemma is_lub_image_le (Ha : is_lub s a) (Hat : a ∈ t) {b : β} (Hb : is_lub (f '' s) b) :
-  b ≤ f a :=
-Hb.2 (Hf.mem_upper_bounds_image Hst Ha.1 Hat)
-
-lemma le_is_glb_image (Ha : is_glb s a) (Hat : a ∈ t) {b : β} (Hb : is_glb (f '' s) b) :
-  f a ≤ b :=
-Hb.2 (Hf.mem_lower_bounds_image Hst Ha.1 Hat)
-
-end monotone_on
-
-namespace antitone_on
-
-variables [preorder α] [preorder β] {f : α → β} {s t : set α}
-  (Hf : antitone_on f t) {a : α} (Hst : s ⊆ t)
-include Hf Hst
-
-lemma mem_upper_bounds_image (Has : a ∈ lower_bounds s) (Hat : a ∈ t) :
-  f a ∈ upper_bounds (f '' s) :=
-Hf.dual_right.mem_lower_bounds_image Hst Has Hat
-
-lemma mem_lower_bounds_image (Has : a ∈ upper_bounds s) (Hat : a ∈ t) :
-  f a ∈ lower_bounds (f '' s) :=
-Hf.dual_right.mem_upper_bounds_image Hst Has Hat
-
-lemma image_lower_bounds_subset_upper_bounds_image :
-  f '' (lower_bounds s ∩ t) ⊆ upper_bounds (f '' s) :=
-Hf.dual_right.image_lower_bounds_subset_lower_bounds_image Hst
-
-lemma image_upper_bounds_subset_lower_bounds_image :
-  f '' (upper_bounds s ∩ t) ⊆ lower_bounds (f '' s) :=
-Hf.dual_right.image_upper_bounds_subset_upper_bounds_image Hst
-
-/-- The image under an antitone function of a set which is bounded above is bounded below. -/
-lemma map_bdd_above : (upper_bounds s ∩ t).nonempty → bdd_below (f '' s) :=
-Hf.dual_right.map_bdd_above Hst
-
-/-- The image under an antitone function of a set which is bounded below is bounded above. -/
-lemma map_bdd_below : (lower_bounds s ∩ t).nonempty → bdd_above (f '' s) :=
-Hf.dual_right.map_bdd_below Hst
-
-/-- An antitone map sends a greatest element of a set to a least element of its image. -/
-lemma map_is_greatest (Ha : is_greatest s a) : is_least (f '' s) (f a) :=
-Hf.dual_right.map_is_greatest Hst Ha
-
-/-- An antitone map sends a least element of a set to a greatest element of its image. -/
-lemma map_is_least (Ha : is_least s a) : is_greatest (f '' s) (f a) :=
-Hf.dual_right.map_is_least Hst Ha
-
-lemma is_lub_image_le (Ha : is_glb s a) (Hat : a ∈ t) {b : β} (Hb : is_lub (f '' s) b) : b ≤ f a :=
-Hf.dual_left.is_lub_image_le Hst Ha Hat Hb
-
-lemma le_is_glb_image (Ha : is_lub s a) (Hat : a ∈ t) {b : β} (Hb : is_glb (f '' s) b) : f a ≤ b :=
-Hf.dual_left.le_is_glb_image Hst Ha Hat Hb
-
-end antitone_on
-
-namespace monotone
-
-variables [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α}
-
-lemma mem_upper_bounds_image (Ha : a ∈ upper_bounds s) :
-  f a ∈ upper_bounds (f '' s) :=
-ball_image_of_ball (assume x H, Hf (Ha ‹x ∈ s›))
-
-lemma mem_lower_bounds_image (Ha : a ∈ lower_bounds s) :
-  f a ∈ lower_bounds (f '' s) :=
-ball_image_of_ball (assume x H, Hf (Ha ‹x ∈ s›))
-
-lemma image_upper_bounds_subset_upper_bounds_image (hf : monotone f) :
-  f '' upper_bounds s ⊆ upper_bounds (f '' s) :=
-begin
-  rintro _ ⟨a, ha, rfl⟩,
-  exact hf.mem_upper_bounds_image ha,
-end
-
-lemma image_lower_bounds_subset_lower_bounds_image (hf : monotone f) :
-  f '' lower_bounds s ⊆ lower_bounds (f '' s) :=
-hf.dual.image_upper_bounds_subset_upper_bounds_image
-
-/-- The image under a monotone function of a set which is bounded above is bounded above. -/
-lemma map_bdd_above (hf : monotone f) : bdd_above s → bdd_above (f '' s)
-| ⟨C, hC⟩ := ⟨f C, hf.mem_upper_bounds_image hC⟩
-
-/-- The image under a monotone function of a set which is bounded below is bounded below. -/
-lemma map_bdd_below (hf : monotone f) : bdd_below s → bdd_below (f '' s)
-| ⟨C, hC⟩ := ⟨f C, hf.mem_lower_bounds_image hC⟩
-
-/-- A monotone map sends a least element of a set to a least element of its image. -/
-lemma map_is_least (Ha : is_least s a) : is_least (f '' s) (f a) :=
-⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image Ha.2⟩
-
-/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
-lemma map_is_greatest (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
-⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image Ha.2⟩
-
-lemma is_lub_image_le (Ha : is_lub s a) {b : β} (Hb : is_lub (f '' s) b) :
-  b ≤ f a :=
-Hb.2 (Hf.mem_upper_bounds_image Ha.1)
-
-lemma le_is_glb_image (Ha : is_glb s a) {b : β} (Hb : is_glb (f '' s) b) :
-  f a ≤ b :=
-Hb.2 (Hf.mem_lower_bounds_image Ha.1)
-
-end monotone
-
-namespace antitone
-variables [preorder α] [preorder β] {f : α → β} (hf : antitone f) {a : α} {s : set α}
-
-lemma mem_upper_bounds_image (ha : a ∈ lower_bounds s) :
-  f a ∈ upper_bounds (f '' s) :=
-hf.dual_right.mem_lower_bounds_image ha
-
-lemma mem_lower_bounds_image (ha : a ∈ upper_bounds s) :
-  f a ∈ lower_bounds (f '' s) :=
-hf.dual_right.mem_upper_bounds_image ha
-
-lemma image_lower_bounds_subset_upper_bounds_image (hf : antitone f) :
-  f '' lower_bounds s ⊆ upper_bounds (f '' s) :=
-hf.dual_right.image_lower_bounds_subset_lower_bounds_image
-
-lemma image_upper_bounds_subset_lower_bounds_image (hf : antitone f) :
-  f '' upper_bounds s ⊆ lower_bounds (f '' s) :=
-hf.dual_right.image_upper_bounds_subset_upper_bounds_image
-
-/-- The image under an antitone function of a set which is bounded above is bounded below. -/
-lemma map_bdd_above (hf : antitone f) : bdd_above s → bdd_below (f '' s) :=
-hf.dual_right.map_bdd_above
-
-/-- The image under an antitone function of a set which is bounded below is bounded above. -/
-lemma map_bdd_below (hf : antitone f) : bdd_below s → bdd_above (f '' s) :=
-hf.dual_right.map_bdd_below
-
-/-- An antitone map sends a greatest element of a set to a least element of its image. -/
-lemma map_is_greatest (ha : is_greatest s a) : is_least (f '' s) (f a) :=
-hf.dual_right.map_is_greatest ha
-
-/-- An antitone map sends a least element of a set to a greatest element of its image. -/
-lemma map_is_least (ha : is_least s a) : is_greatest (f '' s) (f a) :=
-hf.dual_right.map_is_least ha
-
-lemma is_lub_image_le (ha : is_glb s a) {b : β} (hb : is_lub (f '' s) b) : b ≤ f a :=
-hf.dual_left.is_lub_image_le ha hb
-
-lemma le_is_glb_image (ha : is_lub s a) {b : β} (hb : is_glb (f '' s) b) : f a ≤ b :=
-hf.dual_left.le_is_glb_image ha hb
-
-end antitone
-
-lemma is_glb.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
-  {s : set α} {x : α} (hx : is_glb (f '' s) (f x)) :
-  is_glb s x :=
-⟨λ y hy, hf.1 $ hx.1 $ mem_image_of_mem _ hy,
-  λ y hy, hf.1 $ hx.2 $ monotone.mem_lower_bounds_image (λ x y, hf.2) hy⟩
-
-lemma is_lub.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
-  {s : set α} {x : α} (hx : is_lub (f '' s) (f x)) :
-  is_lub s x :=
-@is_glb.of_image αᵒᵈ βᵒᵈ _ _ f (λ x y, hf) _ _ hx
-
-lemma is_lub_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
-  is_lub s f ↔ ∀ a, is_lub (function.eval a '' s) (f a) :=
-begin
-  classical,
-  refine ⟨λ H a, ⟨(function.monotone_eval a).mem_upper_bounds_image H.1, λ b hb, _⟩, λ H, ⟨_, _⟩⟩,
-  { suffices : function.update f a b ∈ upper_bounds s,
-      from function.update_same a b f ▸ H.2 this a,
-    refine λ g hg, le_update_iff.2 ⟨hb $ mem_image_of_mem _ hg, λ i hi, H.1 hg i⟩ },
-  { exact λ g hg a, (H a).1 (mem_image_of_mem _ hg) },
-  { exact λ g hg a, (H a).2 ((function.monotone_eval a).mem_upper_bounds_image hg) }
-end
-
-lemma is_glb_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
-  is_glb s f ↔ ∀ a, is_glb (function.eval a '' s) (f a) :=
-@is_lub_pi α (λ a, (π a)ᵒᵈ) _ s f
-
-lemma is_lub_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
-  is_lub s p ↔ is_lub (prod.fst '' s) p.1 ∧ is_lub (prod.snd '' s) p.2 :=
-begin
-  refine ⟨λ H, ⟨⟨monotone_fst.mem_upper_bounds_image H.1, λ a ha, _⟩,
-    ⟨monotone_snd.mem_upper_bounds_image H.1, λ a ha, _⟩⟩, λ H, ⟨_, _⟩⟩,
-  { suffices : (a, p.2) ∈ upper_bounds s, from (H.2 this).1,
-    exact λ q hq, ⟨ha $ mem_image_of_mem _ hq, (H.1 hq).2⟩ },
-  { suffices : (p.1, a) ∈ upper_bounds s, from (H.2 this).2,
-    exact λ q hq, ⟨(H.1 hq).1, ha $ mem_image_of_mem _ hq⟩ },
-  { exact λ q hq, ⟨H.1.1 $ mem_image_of_mem _ hq, H.2.1 $ mem_image_of_mem _ hq⟩ },
-  { exact λ q hq, ⟨H.1.2 $ monotone_fst.mem_upper_bounds_image hq,
-      H.2.2 $ monotone_snd.mem_upper_bounds_image hq⟩ }
-end
-
-lemma is_glb_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
-  is_glb s p ↔ is_glb (prod.fst '' s) p.1 ∧ is_glb (prod.snd '' s) p.2 :=
-@is_lub_prod αᵒᵈ βᵒᵈ _ _ _ _
-
-namespace order_iso
-
-variables [preorder α] [preorder β] (f : α ≃o β)
-
-lemma upper_bounds_image {s : set α} :
-  upper_bounds (f '' s) = f '' upper_bounds s :=
-subset.antisymm
-  (λ x hx, ⟨f.symm x, λ y hy, f.le_symm_apply.2 (hx $ mem_image_of_mem _ hy), f.apply_symm_apply x⟩)
-  f.monotone.image_upper_bounds_subset_upper_bounds_image
-
-lemma lower_bounds_image {s : set α} : lower_bounds (f '' s) = f '' lower_bounds s :=
-@upper_bounds_image αᵒᵈ βᵒᵈ _ _ f.dual _
-
-@[simp] lemma is_lub_image {s : set α} {x : β} :
-  is_lub (f '' s) x ↔ is_lub s (f.symm x) :=
-⟨λ h, is_lub.of_image (λ _ _, f.le_iff_le) ((f.apply_symm_apply x).symm ▸ h),
-  λ h, is_lub.of_image (λ _ _, f.symm.le_iff_le) $ (f.symm_image_image s).symm ▸ h⟩
-
-lemma is_lub_image' {s : set α} {x : α} :
-  is_lub (f '' s) (f x) ↔ is_lub s x :=
-by rw [is_lub_image, f.symm_apply_apply]
-
-@[simp] lemma is_glb_image {s : set α} {x : β} :
-  is_glb (f '' s) x ↔ is_glb s (f.symm x) :=
-f.dual.is_lub_image
-
-lemma is_glb_image' {s : set α} {x : α} :
-  is_glb (f '' s) (f x) ↔ is_glb s x :=
-f.dual.is_lub_image'
-
-@[simp] lemma is_lub_preimage {s : set β} {x : α} :
-  is_lub (f ⁻¹' s) x ↔ is_lub s (f x) :=
-by rw [← f.symm_symm, ← image_eq_preimage, is_lub_image]
-
-lemma is_lub_preimage' {s : set β} {x : β} :
-  is_lub (f ⁻¹' s) (f.symm x) ↔ is_lub s x :=
-by rw [is_lub_preimage, f.apply_symm_apply]
-
-@[simp] lemma is_glb_preimage {s : set β} {x : α} :
-  is_glb (f ⁻¹' s) x ↔ is_glb s (f x) :=
-f.dual.is_lub_preimage
-
-lemma is_glb_preimage' {s : set β} {x : β} :
-  is_glb (f ⁻¹' s) (f.symm x) ↔ is_glb s x :=
-f.dual.is_lub_preimage'
-
-end order_iso
diff --git a/src/order/bounds/basic.lean b/src/order/bounds/basic.lean
new file mode 100644
index 0000000000000..ab986bd7f2fd4
--- /dev/null
+++ b/src/order/bounds/basic.lean
@@ -0,0 +1,1224 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Yury Kudryashov
+-/
+import data.set.intervals.basic
+import data.set.n_ary
+import order.directed
+
+/-!
+
+# Upper / lower bounds
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define:
+
+* `upper_bounds`, `lower_bounds` : the set of upper bounds (resp., lower bounds) of a set;
+* `bdd_above s`, `bdd_below s` : the set `s` is bounded above (resp., below), i.e., the set of upper
+  (resp., lower) bounds of `s` is nonempty;
+* `is_least s a`, `is_greatest s a` : `a` is a least (resp., greatest) element of `s`;
+  for a partial order, it is unique if exists;
+* `is_lub s a`, `is_glb s a` : `a` is a least upper bound (resp., a greatest lower bound)
+  of `s`; for a partial order, it is unique if exists.
+
+We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
+formulas for `∅`, `univ`, and intervals.
+-/
+
+open function set order_dual (to_dual of_dual)
+
+universes u v w x
+variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}
+
+section
+variables [preorder α] [preorder β] {s t : set α} {a b : α}
+
+/-!
+### Definitions
+-/
+
+/-- The set of upper bounds of a set. -/
+def upper_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → a ≤ x }
+/-- The set of lower bounds of a set. -/
+def lower_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → x ≤ a }
+
+/-- A set is bounded above if there exists an upper bound. -/
+def bdd_above (s : set α) := (upper_bounds s).nonempty
+/-- A set is bounded below if there exists a lower bound. -/
+def bdd_below (s : set α) := (lower_bounds s).nonempty
+
+/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
+def is_least (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ lower_bounds s
+/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
+def is_greatest (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ upper_bounds s
+
+/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
+def is_lub (s : set α) : α → Prop := is_least (upper_bounds s)
+/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
+def is_glb (s : set α) : α → Prop := is_greatest (lower_bounds s)
+
+lemma mem_upper_bounds : a ∈ upper_bounds s ↔ ∀ x ∈ s, x ≤ a := iff.rfl
+lemma mem_lower_bounds : a ∈ lower_bounds s ↔ ∀ x ∈ s, a ≤ x := iff.rfl
+lemma mem_upper_bounds_iff_subset_Iic : a ∈ upper_bounds s ↔ s ⊆ Iic a := iff.rfl
+lemma mem_lower_bounds_iff_subset_Ici : a ∈ lower_bounds s ↔ s ⊆ Ici a := iff.rfl
+
+lemma bdd_above_def : bdd_above s ↔ ∃ x, ∀ y ∈ s, y ≤ x := iff.rfl
+lemma bdd_below_def : bdd_below s ↔ ∃ x, ∀ y ∈ s, x ≤ y := iff.rfl
+
+lemma bot_mem_lower_bounds [order_bot α] (s : set α) : ⊥ ∈ lower_bounds s := λ _ _, bot_le
+lemma top_mem_upper_bounds [order_top α] (s : set α) : ⊤ ∈ upper_bounds s := λ _ _, le_top
+
+@[simp] lemma is_least_bot_iff [order_bot α] : is_least s ⊥ ↔ ⊥ ∈ s :=
+and_iff_left $ bot_mem_lower_bounds _
+
+@[simp] lemma is_greatest_top_iff [order_top α] : is_greatest s ⊤ ↔ ⊤ ∈ s :=
+and_iff_left $ top_mem_upper_bounds _
+
+/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
+is not greater than or equal to `y`. This version only assumes `preorder` structure and uses
+`¬(y ≤ x)`. A version for linear orders is called `not_bdd_above_iff`. -/
+lemma not_bdd_above_iff' : ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, ¬(y ≤ x) :=
+by simp [bdd_above, upper_bounds, set.nonempty]
+
+/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
+is not less than or equal to `y`. This version only assumes `preorder` structure and uses
+`¬(x ≤ y)`. A version for linear orders is called `not_bdd_below_iff`. -/
+lemma not_bdd_below_iff' : ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, ¬ x ≤ y := @not_bdd_above_iff' αᵒᵈ _ _
+
+/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
+than `x`. A version for preorders is called `not_bdd_above_iff'`. -/
+lemma not_bdd_above_iff {α : Type*} [linear_order α] {s : set α} :
+  ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, x < y :=
+by simp only [not_bdd_above_iff', not_le]
+
+/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
+than `x`. A version for preorders is called `not_bdd_below_iff'`. -/
+lemma not_bdd_below_iff {α : Type*} [linear_order α] {s : set α} :
+  ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, y < x :=
+@not_bdd_above_iff αᵒᵈ _ _
+
+lemma bdd_above.dual (h : bdd_above s) : bdd_below (of_dual ⁻¹' s) := h
+
+lemma bdd_below.dual (h : bdd_below s) : bdd_above (of_dual ⁻¹' s) := h
+
+lemma is_least.dual (h : is_least s a) : is_greatest (of_dual ⁻¹' s) (to_dual a) := h
+
+lemma is_greatest.dual (h : is_greatest s a) : is_least (of_dual ⁻¹' s) (to_dual a) := h
+
+lemma is_lub.dual (h : is_lub s a) : is_glb (of_dual ⁻¹' s) (to_dual a) := h
+
+lemma is_glb.dual (h : is_glb s a) : is_lub (of_dual ⁻¹' s) (to_dual a) := h
+
+/-- If `a` is the least element of a set `s`, then subtype `s` is an order with bottom element. -/
+@[reducible] def is_least.order_bot (h : is_least s a) : order_bot s :=
+{ bot := ⟨a, h.1⟩,
+  bot_le := subtype.forall.2 h.2 }
+
+/-- If `a` is the greatest element of a set `s`, then subtype `s` is an order with top element. -/
+@[reducible] def is_greatest.order_top (h : is_greatest s a) : order_top s :=
+{ top := ⟨a, h.1⟩,
+  le_top := subtype.forall.2 h.2 }
+
+/-!
+### Monotonicity
+-/
+
+lemma upper_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
+  upper_bounds t ⊆ upper_bounds s :=
+λ b hb x h, hb $ hst h
+
+lemma lower_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
+  lower_bounds t ⊆ lower_bounds s :=
+λ b hb x h, hb $ hst h
+
+lemma upper_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : a ∈ upper_bounds s → b ∈ upper_bounds s :=
+λ ha x h, le_trans (ha h) hab
+
+lemma lower_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : b ∈ lower_bounds s → a ∈ lower_bounds s :=
+λ hb x h, le_trans hab (hb h)
+
+lemma upper_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
+  a ∈ upper_bounds t → b ∈ upper_bounds s :=
+λ ha, upper_bounds_mono_set hst $ upper_bounds_mono_mem hab ha
+
+lemma lower_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
+  b ∈ lower_bounds t → a ∈ lower_bounds s :=
+λ hb, lower_bounds_mono_set hst $ lower_bounds_mono_mem hab hb
+
+/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
+lemma bdd_above.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_above t → bdd_above s :=
+nonempty.mono $ upper_bounds_mono_set h
+
+/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
+lemma bdd_below.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_below t → bdd_below s :=
+nonempty.mono $ lower_bounds_mono_set h
+
+/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
+set `t`, `s ⊆ t ⊆ p`. -/
+lemma is_lub.of_subset_of_superset {s t p : set α} (hs : is_lub s a) (hp : is_lub p a)
+  (hst : s ⊆ t) (htp : t ⊆ p) : is_lub t a :=
+⟨upper_bounds_mono_set htp hp.1, lower_bounds_mono_set (upper_bounds_mono_set hst) hs.2⟩
+
+/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
+set `t`, `s ⊆ t ⊆ p`. -/
+lemma is_glb.of_subset_of_superset {s t p : set α} (hs : is_glb s a) (hp : is_glb p a)
+  (hst : s ⊆ t) (htp : t ⊆ p) : is_glb t a :=
+hs.dual.of_subset_of_superset hp hst htp
+
+lemma is_least.mono (ha : is_least s a) (hb : is_least t b) (hst : s ⊆ t) : b ≤ a :=
+hb.2 (hst ha.1)
+
+lemma is_greatest.mono (ha : is_greatest s a) (hb : is_greatest t b) (hst : s ⊆ t) : a ≤ b :=
+hb.2 (hst ha.1)
+
+lemma is_lub.mono (ha : is_lub s a) (hb : is_lub t b) (hst : s ⊆ t) : a ≤ b :=
+hb.mono ha $ upper_bounds_mono_set hst
+
+lemma is_glb.mono (ha : is_glb s a) (hb : is_glb t b) (hst : s ⊆ t) : b ≤ a :=
+hb.mono ha $ lower_bounds_mono_set hst
+
+lemma subset_lower_bounds_upper_bounds (s : set α) : s ⊆ lower_bounds (upper_bounds s) :=
+λ x hx y hy, hy hx
+
+lemma subset_upper_bounds_lower_bounds (s : set α) : s ⊆ upper_bounds (lower_bounds s) :=
+λ x hx y hy, hy hx
+
+lemma set.nonempty.bdd_above_lower_bounds (hs : s.nonempty) : bdd_above (lower_bounds s) :=
+hs.mono (subset_upper_bounds_lower_bounds s)
+
+lemma set.nonempty.bdd_below_upper_bounds (hs : s.nonempty) : bdd_below (upper_bounds s) :=
+hs.mono (subset_lower_bounds_upper_bounds s)
+
+/-!
+### Conversions
+-/
+
+lemma is_least.is_glb (h : is_least s a) : is_glb s a := ⟨h.2, λ b hb, hb h.1⟩
+
+lemma is_greatest.is_lub (h : is_greatest s a) : is_lub s a := ⟨h.2, λ b hb, hb h.1⟩
+
+lemma is_lub.upper_bounds_eq (h : is_lub s a) : upper_bounds s = Ici a :=
+set.ext $ λ b, ⟨λ hb, h.2 hb, λ hb, upper_bounds_mono_mem hb h.1⟩
+
+lemma is_glb.lower_bounds_eq (h : is_glb s a) : lower_bounds s = Iic a := h.dual.upper_bounds_eq
+
+lemma is_least.lower_bounds_eq (h : is_least s a) : lower_bounds s = Iic a :=
+h.is_glb.lower_bounds_eq
+
+lemma is_greatest.upper_bounds_eq (h : is_greatest s a) : upper_bounds s = Ici a :=
+h.is_lub.upper_bounds_eq
+
+lemma is_lub_le_iff (h : is_lub s a) : a ≤ b ↔ b ∈ upper_bounds s :=
+by { rw h.upper_bounds_eq, refl }
+
+lemma le_is_glb_iff (h : is_glb s a) : b ≤ a ↔ b ∈ lower_bounds s :=
+by { rw h.lower_bounds_eq, refl }
+
+lemma is_lub_iff_le_iff : is_lub s a ↔ ∀ b, a ≤ b ↔ b ∈ upper_bounds s :=
+⟨λ h b, is_lub_le_iff h, λ H, ⟨(H _).1 le_rfl, λ b hb, (H b).2 hb⟩⟩
+
+lemma is_glb_iff_le_iff : is_glb s a ↔ ∀ b, b ≤ a ↔ b ∈ lower_bounds s :=
+@is_lub_iff_le_iff αᵒᵈ _ _ _
+
+/-- If `s` has a least upper bound, then it is bounded above. -/
+lemma is_lub.bdd_above (h : is_lub s a) : bdd_above s := ⟨a, h.1⟩
+
+/-- If `s` has a greatest lower bound, then it is bounded below. -/
+lemma is_glb.bdd_below (h : is_glb s a) : bdd_below s := ⟨a, h.1⟩
+
+/-- If `s` has a greatest element, then it is bounded above. -/
+lemma is_greatest.bdd_above (h : is_greatest s a) : bdd_above s := ⟨a, h.2⟩
+
+/-- If `s` has a least element, then it is bounded below. -/
+lemma is_least.bdd_below (h : is_least s a) : bdd_below s := ⟨a, h.2⟩
+
+lemma is_least.nonempty (h : is_least s a) : s.nonempty := ⟨a, h.1⟩
+
+lemma is_greatest.nonempty (h : is_greatest s a) : s.nonempty := ⟨a, h.1⟩
+
+/-!
+### Union and intersection
+-/
+
+@[simp] lemma upper_bounds_union : upper_bounds (s ∪ t) = upper_bounds s ∩ upper_bounds t :=
+subset.antisymm
+  (λ b hb, ⟨λ x hx, hb (or.inl hx), λ x hx, hb (or.inr hx)⟩)
+  (λ b hb x hx, hx.elim (λ hs, hb.1 hs) (λ ht, hb.2 ht))
+
+@[simp] lemma lower_bounds_union : lower_bounds (s ∪ t) = lower_bounds s ∩ lower_bounds t :=
+@upper_bounds_union αᵒᵈ _ s t
+
+lemma union_upper_bounds_subset_upper_bounds_inter :
+  upper_bounds s ∪ upper_bounds t ⊆ upper_bounds (s ∩ t) :=
+union_subset
+  (upper_bounds_mono_set $ inter_subset_left _ _)
+  (upper_bounds_mono_set $ inter_subset_right _ _)
+
+lemma union_lower_bounds_subset_lower_bounds_inter :
+  lower_bounds s ∪ lower_bounds t ⊆ lower_bounds (s ∩ t) :=
+@union_upper_bounds_subset_upper_bounds_inter αᵒᵈ _ s t
+
+lemma is_least_union_iff {a : α} {s t : set α} :
+  is_least (s ∪ t) a ↔ (is_least s a ∧ a ∈ lower_bounds t ∨ a ∈ lower_bounds s ∧ is_least t a) :=
+by simp [is_least, lower_bounds_union, or_and_distrib_right, and_comm (a ∈ t), and_assoc]
+
+lemma is_greatest_union_iff :
+  is_greatest (s ∪ t) a ↔ (is_greatest s a ∧ a ∈ upper_bounds t ∨
+    a ∈ upper_bounds s ∧ is_greatest t a) :=
+@is_least_union_iff αᵒᵈ _ a s t
+
+/-- If `s` is bounded, then so is `s ∩ t` -/
+lemma bdd_above.inter_of_left (h : bdd_above s) : bdd_above (s ∩ t) :=
+h.mono $ inter_subset_left s t
+
+/-- If `t` is bounded, then so is `s ∩ t` -/
+lemma bdd_above.inter_of_right (h : bdd_above t) : bdd_above (s ∩ t) :=
+h.mono $ inter_subset_right s t
+
+/-- If `s` is bounded, then so is `s ∩ t` -/
+lemma bdd_below.inter_of_left (h : bdd_below s) : bdd_below (s ∩ t) :=
+h.mono $ inter_subset_left s t
+
+/-- If `t` is bounded, then so is `s ∩ t` -/
+lemma bdd_below.inter_of_right (h : bdd_below t) : bdd_below (s ∩ t) :=
+h.mono $ inter_subset_right s t
+
+/-- In a directed order, the union of bounded above sets is bounded above. -/
+lemma bdd_above.union [is_directed α (≤)] {s t : set α} :
+  bdd_above s → bdd_above t → bdd_above (s ∪ t) :=
+begin
+  rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  obtain ⟨c, hca, hcb⟩ := exists_ge_ge a b,
+  rw [bdd_above, upper_bounds_union],
+  exact ⟨c, upper_bounds_mono_mem hca ha, upper_bounds_mono_mem hcb hb⟩,
+end
+
+/-- In a directed order, the union of two sets is bounded above if and only if both sets are. -/
+lemma bdd_above_union [is_directed α (≤)] {s t : set α} :
+  bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t :=
+⟨λ h, ⟨h.mono $ subset_union_left _ _, h.mono $ subset_union_right _ _⟩, λ h, h.1.union h.2⟩
+
+/-- In a codirected order, the union of bounded below sets is bounded below. -/
+lemma bdd_below.union [is_directed α (≥)] {s t : set α} :
+  bdd_below s → bdd_below t → bdd_below (s ∪ t) :=
+@bdd_above.union αᵒᵈ _ _ _ _
+
+/-- In a codirected order, the union of two sets is bounded below if and only if both sets are. -/
+lemma bdd_below_union [is_directed α (≥)] {s t : set α} :
+  bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
+@bdd_above_union αᵒᵈ _ _ _ _
+
+/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
+then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
+lemma is_lub.union [semilattice_sup γ] {a b : γ} {s t : set γ}
+  (hs : is_lub s a) (ht : is_lub t b) :
+  is_lub (s ∪ t) (a ⊔ b) :=
+⟨λ c h, h.cases_on (λ h, le_sup_of_le_left $ hs.left h) (λ h, le_sup_of_le_right $ ht.left h),
+  λ c hc, sup_le (hs.right $ λ d hd, hc $ or.inl hd) (ht.right $ λ d hd, hc $ or.inr hd)⟩
+
+/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
+then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
+lemma is_glb.union [semilattice_inf γ] {a₁ a₂ : γ} {s t : set γ}
+  (hs : is_glb s a₁) (ht : is_glb t a₂) :
+  is_glb (s ∪ t) (a₁ ⊓ a₂) :=
+hs.dual.union ht
+
+/-- If `a` is the least element of `s` and `b` is the least element of `t`,
+then `min a b` is the least element of `s ∪ t`. -/
+lemma is_least.union [linear_order γ] {a b : γ} {s t : set γ}
+  (ha : is_least s a) (hb : is_least t b) : is_least (s ∪ t) (min a b) :=
+⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
+  (ha.is_glb.union hb.is_glb).1⟩
+
+/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
+then `max a b` is the greatest element of `s ∪ t`. -/
+lemma is_greatest.union [linear_order γ] {a b : γ} {s t : set γ}
+  (ha : is_greatest s a) (hb : is_greatest t b) : is_greatest (s ∪ t) (max a b) :=
+⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
+  (ha.is_lub.union hb.is_lub).1⟩
+
+lemma is_lub.inter_Ici_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_lub s a)
+  (hb : b ∈ s) : is_lub (s ∩ Ici b) a :=
+⟨λ x hx, ha.1 hx.1, λ c hc, have hbc : b ≤ c, from hc ⟨hb, le_rfl⟩,
+  ha.2 $ λ x hx, (le_total x b).elim (λ hxb, hxb.trans hbc) $ λ hbx, hc ⟨hx, hbx⟩⟩
+
+lemma is_glb.inter_Iic_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_glb s a)
+  (hb : b ∈ s) : is_glb (s ∩ Iic b) a :=
+ha.dual.inter_Ici_of_mem hb
+
+lemma bdd_above_iff_exists_ge [semilattice_sup γ] {s : set γ} (x₀ : γ) :
+  bdd_above s ↔ ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
+by { rw [bdd_above_def, exists_ge_and_iff_exists], exact monotone.ball (λ x hx, monotone_le) }
+
+lemma bdd_below_iff_exists_le [semilattice_inf γ] {s : set γ} (x₀ : γ) :
+  bdd_below s ↔ ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
+bdd_above_iff_exists_ge (to_dual x₀)
+
+lemma bdd_above.exists_ge  [semilattice_sup γ] {s : set γ} (hs : bdd_above s) (x₀ : γ) :
+  ∃ x, x₀ ≤ x ∧ ∀ y ∈ s, y ≤ x :=
+(bdd_above_iff_exists_ge x₀).mp hs
+
+lemma bdd_below.exists_le  [semilattice_inf γ] {s : set γ} (hs : bdd_below s) (x₀ : γ) :
+  ∃ x, x ≤ x₀ ∧ ∀ y ∈ s, x ≤ y :=
+(bdd_below_iff_exists_le x₀).mp hs
+
+/-!
+### Specific sets
+
+#### Unbounded intervals
+-/
+
+lemma is_least_Ici : is_least (Ici a) a := ⟨left_mem_Ici, λ x, id⟩
+
+lemma is_greatest_Iic : is_greatest (Iic a) a := ⟨right_mem_Iic, λ x, id⟩
+
+lemma is_lub_Iic : is_lub (Iic a) a := is_greatest_Iic.is_lub
+
+lemma is_glb_Ici : is_glb (Ici a) a := is_least_Ici.is_glb
+
+lemma upper_bounds_Iic : upper_bounds (Iic a) = Ici a := is_lub_Iic.upper_bounds_eq
+
+lemma lower_bounds_Ici : lower_bounds (Ici a) = Iic a := is_glb_Ici.lower_bounds_eq
+
+lemma bdd_above_Iic : bdd_above (Iic a) := is_lub_Iic.bdd_above
+
+lemma bdd_below_Ici : bdd_below (Ici a) := is_glb_Ici.bdd_below
+
+lemma bdd_above_Iio : bdd_above (Iio a) := ⟨a, λ x hx, le_of_lt hx⟩
+
+lemma bdd_below_Ioi : bdd_below (Ioi a) := ⟨a, λ x hx, le_of_lt hx⟩
+
+lemma lub_Iio_le (a : α) (hb : is_lub (set.Iio a) b) : b ≤ a :=
+(is_lub_le_iff hb).mpr $ λ k hk, le_of_lt hk
+
+lemma le_glb_Ioi (a : α) (hb : is_glb (set.Ioi a) b) : a ≤ b := @lub_Iio_le αᵒᵈ _ _ a hb
+
+lemma lub_Iio_eq_self_or_Iio_eq_Iic [partial_order γ] {j : γ} (i : γ) (hj : is_lub (set.Iio i) j) :
+  j = i ∨ set.Iio i = set.Iic j :=
+begin
+  cases eq_or_lt_of_le (lub_Iio_le i hj) with hj_eq_i hj_lt_i,
+  { exact or.inl hj_eq_i, },
+  { right,
+    exact set.ext (λ k, ⟨λ hk_lt, hj.1 hk_lt, λ hk_le_j, lt_of_le_of_lt hk_le_j hj_lt_i⟩), },
+end
+
+lemma glb_Ioi_eq_self_or_Ioi_eq_Ici [partial_order γ] {j : γ} (i : γ) (hj : is_glb (set.Ioi i) j) :
+  j = i ∨ set.Ioi i = set.Ici j :=
+@lub_Iio_eq_self_or_Iio_eq_Iic γᵒᵈ _ j i hj
+
+section
+
+variables [linear_order γ]
+
+lemma exists_lub_Iio (i : γ) : ∃ j, is_lub (set.Iio i) j :=
+begin
+  by_cases h_exists_lt : ∃ j, j ∈ upper_bounds (set.Iio i) ∧ j < i,
+  { obtain ⟨j, hj_ub, hj_lt_i⟩ := h_exists_lt,
+    exact ⟨j, hj_ub, λ k hk_ub, hk_ub hj_lt_i⟩, },
+  { refine ⟨i, λ j hj, le_of_lt hj, _⟩,
+    rw mem_lower_bounds,
+    by_contra,
+    refine h_exists_lt _,
+    push_neg at h,
+    exact h, },
+end
+
+lemma exists_glb_Ioi (i : γ) : ∃ j, is_glb (set.Ioi i) j := @exists_lub_Iio γᵒᵈ _ i
+
+variables [densely_ordered γ]
+
+lemma is_lub_Iio {a : γ} : is_lub (Iio a) a :=
+⟨λ x hx, le_of_lt hx, λ y hy, le_of_forall_ge_of_dense hy⟩
+
+lemma is_glb_Ioi {a : γ} : is_glb (Ioi a) a := @is_lub_Iio γᵒᵈ _ _ a
+
+lemma upper_bounds_Iio {a : γ} : upper_bounds (Iio a) = Ici a := is_lub_Iio.upper_bounds_eq
+
+lemma lower_bounds_Ioi {a : γ} : lower_bounds (Ioi a) = Iic a := is_glb_Ioi.lower_bounds_eq
+
+end
+
+/-!
+#### Singleton
+-/
+
+lemma is_greatest_singleton : is_greatest {a} a :=
+⟨mem_singleton a, λ x hx, le_of_eq $ eq_of_mem_singleton hx⟩
+
+lemma is_least_singleton : is_least {a} a := @is_greatest_singleton αᵒᵈ _ a
+
+lemma is_lub_singleton : is_lub {a} a := is_greatest_singleton.is_lub
+
+lemma is_glb_singleton : is_glb {a} a := is_least_singleton.is_glb
+
+lemma bdd_above_singleton : bdd_above ({a} : set α) := is_lub_singleton.bdd_above
+
+lemma bdd_below_singleton : bdd_below ({a} : set α) := is_glb_singleton.bdd_below
+
+@[simp] lemma upper_bounds_singleton : upper_bounds {a} = Ici a := is_lub_singleton.upper_bounds_eq
+
+@[simp] lemma lower_bounds_singleton : lower_bounds {a} = Iic a := is_glb_singleton.lower_bounds_eq
+
+/-!
+#### Bounded intervals
+-/
+
+lemma bdd_above_Icc : bdd_above (Icc a b) := ⟨b, λ _, and.right⟩
+
+lemma bdd_below_Icc : bdd_below (Icc a b) := ⟨a, λ _, and.left⟩
+
+lemma bdd_above_Ico : bdd_above (Ico a b) := bdd_above_Icc.mono Ico_subset_Icc_self
+
+lemma bdd_below_Ico : bdd_below (Ico a b) := bdd_below_Icc.mono Ico_subset_Icc_self
+
+lemma bdd_above_Ioc : bdd_above (Ioc a b) := bdd_above_Icc.mono Ioc_subset_Icc_self
+
+lemma bdd_below_Ioc : bdd_below (Ioc a b) := bdd_below_Icc.mono Ioc_subset_Icc_self
+
+lemma bdd_above_Ioo : bdd_above (Ioo a b) := bdd_above_Icc.mono Ioo_subset_Icc_self
+
+lemma bdd_below_Ioo : bdd_below (Ioo a b) := bdd_below_Icc.mono Ioo_subset_Icc_self
+
+lemma is_greatest_Icc (h : a ≤ b) : is_greatest (Icc a b) b :=
+⟨right_mem_Icc.2 h, λ x, and.right⟩
+
+lemma is_lub_Icc (h : a ≤ b) : is_lub (Icc a b) b := (is_greatest_Icc h).is_lub
+
+lemma upper_bounds_Icc (h : a ≤ b) : upper_bounds (Icc a b) = Ici b :=
+(is_lub_Icc h).upper_bounds_eq
+
+lemma is_least_Icc (h : a ≤ b) : is_least (Icc a b) a :=
+⟨left_mem_Icc.2 h, λ x, and.left⟩
+
+lemma is_glb_Icc (h : a ≤ b) : is_glb (Icc a b) a := (is_least_Icc h).is_glb
+
+lemma lower_bounds_Icc (h : a ≤ b) : lower_bounds (Icc a b) = Iic a :=
+(is_glb_Icc h).lower_bounds_eq
+
+lemma is_greatest_Ioc (h : a < b) : is_greatest (Ioc a b) b :=
+⟨right_mem_Ioc.2 h, λ x, and.right⟩
+
+lemma is_lub_Ioc (h : a < b) : is_lub (Ioc a b) b :=
+(is_greatest_Ioc h).is_lub
+
+lemma upper_bounds_Ioc (h : a < b) : upper_bounds (Ioc a b) = Ici b :=
+(is_lub_Ioc h).upper_bounds_eq
+
+lemma is_least_Ico (h : a < b) : is_least (Ico a b) a :=
+⟨left_mem_Ico.2 h, λ x, and.left⟩
+
+lemma is_glb_Ico (h : a < b) : is_glb (Ico a b) a :=
+(is_least_Ico h).is_glb
+
+lemma lower_bounds_Ico (h : a < b) : lower_bounds (Ico a b) = Iic a :=
+(is_glb_Ico h).lower_bounds_eq
+
+section
+
+variables [semilattice_sup γ] [densely_ordered γ]
+
+lemma is_glb_Ioo {a b : γ} (h : a < b) :
+  is_glb (Ioo a b) a :=
+⟨λ x hx, hx.1.le, λ x hx,
+begin
+  cases eq_or_lt_of_le (le_sup_right : a ≤ x ⊔ a) with h₁ h₂,
+  { exact h₁.symm ▸ le_sup_left },
+  obtain ⟨y, lty, ylt⟩ := exists_between h₂,
+  apply (not_lt_of_le (sup_le (hx ⟨lty, ylt.trans_le (sup_le _ h.le)⟩) lty.le) ylt).elim,
+  obtain ⟨u, au, ub⟩ := exists_between h,
+  apply (hx ⟨au, ub⟩).trans ub.le,
+end⟩
+
+lemma lower_bounds_Ioo {a b : γ} (hab : a < b) : lower_bounds (Ioo a b) = Iic a :=
+(is_glb_Ioo hab).lower_bounds_eq
+
+lemma is_glb_Ioc {a b : γ} (hab : a < b) : is_glb (Ioc a b) a :=
+(is_glb_Ioo hab).of_subset_of_superset (is_glb_Icc hab.le) Ioo_subset_Ioc_self Ioc_subset_Icc_self
+
+lemma lower_bound_Ioc {a b : γ} (hab : a < b) : lower_bounds (Ioc a b) = Iic a :=
+(is_glb_Ioc hab).lower_bounds_eq
+
+end
+
+section
+
+variables [semilattice_inf γ] [densely_ordered γ]
+
+lemma is_lub_Ioo {a b : γ} (hab : a < b) : is_lub (Ioo a b) b :=
+by simpa only [dual_Ioo] using is_glb_Ioo hab.dual
+
+lemma upper_bounds_Ioo {a b : γ} (hab : a < b) : upper_bounds (Ioo a b) = Ici b :=
+(is_lub_Ioo hab).upper_bounds_eq
+
+lemma is_lub_Ico {a b : γ} (hab : a < b) : is_lub (Ico a b) b :=
+by simpa only [dual_Ioc] using is_glb_Ioc hab.dual
+
+lemma upper_bounds_Ico {a b : γ} (hab : a < b) : upper_bounds (Ico a b) = Ici b :=
+(is_lub_Ico hab).upper_bounds_eq
+
+end
+
+lemma bdd_below_iff_subset_Ici : bdd_below s ↔ ∃ a, s ⊆ Ici a := iff.rfl
+
+lemma bdd_above_iff_subset_Iic : bdd_above s ↔ ∃ a, s ⊆ Iic a := iff.rfl
+
+lemma bdd_below_bdd_above_iff_subset_Icc : bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ Icc a b :=
+by simp only [Ici_inter_Iic.symm, subset_inter_iff, bdd_below_iff_subset_Ici,
+  bdd_above_iff_subset_Iic, exists_and_distrib_left, exists_and_distrib_right]
+
+/-!
+#### Univ
+-/
+
+@[simp] lemma is_greatest_univ_iff : is_greatest univ a ↔ is_top a :=
+by simp [is_greatest, mem_upper_bounds, is_top]
+
+lemma is_greatest_univ [order_top α] : is_greatest (univ : set α) ⊤ :=
+is_greatest_univ_iff.2 is_top_top
+
+@[simp] lemma order_top.upper_bounds_univ [partial_order γ] [order_top γ] :
+  upper_bounds (univ : set γ) = {⊤} :=
+by rw [is_greatest_univ.upper_bounds_eq, Ici_top]
+
+lemma is_lub_univ [order_top α] : is_lub (univ : set α) ⊤ := is_greatest_univ.is_lub
+
+@[simp] lemma order_bot.lower_bounds_univ [partial_order γ] [order_bot γ] :
+  lower_bounds (univ : set γ) = {⊥} :=
+@order_top.upper_bounds_univ γᵒᵈ _ _
+
+@[simp] lemma is_least_univ_iff : is_least univ a ↔ is_bot a := @is_greatest_univ_iff αᵒᵈ _ _
+lemma is_least_univ [order_bot α] : is_least (univ : set α) ⊥ := @is_greatest_univ αᵒᵈ _ _
+lemma is_glb_univ [order_bot α] : is_glb (univ : set α) ⊥ := is_least_univ.is_glb
+
+@[simp] lemma no_max_order.upper_bounds_univ [no_max_order α] : upper_bounds (univ : set α) = ∅ :=
+eq_empty_of_subset_empty $ λ b hb, let ⟨x, hx⟩ := exists_gt b in
+not_le_of_lt hx (hb trivial)
+
+@[simp] lemma no_min_order.lower_bounds_univ [no_min_order α] : lower_bounds (univ : set α) = ∅ :=
+@no_max_order.upper_bounds_univ αᵒᵈ _ _
+
+@[simp] lemma not_bdd_above_univ [no_max_order α] : ¬bdd_above (univ : set α) :=
+by simp [bdd_above]
+
+@[simp] lemma not_bdd_below_univ [no_min_order α] : ¬bdd_below (univ : set α) :=
+@not_bdd_above_univ αᵒᵈ _ _
+
+/-!
+#### Empty set
+-/
+
+@[simp] lemma upper_bounds_empty : upper_bounds (∅ : set α) = univ :=
+by simp only [upper_bounds, eq_univ_iff_forall, mem_set_of_eq, ball_empty_iff, forall_true_iff]
+
+@[simp] lemma lower_bounds_empty : lower_bounds (∅ : set α) = univ := @upper_bounds_empty αᵒᵈ _
+
+@[simp] lemma bdd_above_empty [nonempty α] : bdd_above (∅ : set α) :=
+by simp only [bdd_above, upper_bounds_empty, univ_nonempty]
+
+@[simp] lemma bdd_below_empty [nonempty α] : bdd_below (∅ : set α) :=
+by simp only [bdd_below, lower_bounds_empty, univ_nonempty]
+
+@[simp] lemma is_glb_empty_iff : is_glb ∅ a ↔ is_top a := by simp [is_glb]
+@[simp] lemma is_lub_empty_iff : is_lub ∅ a ↔ is_bot a := @is_glb_empty_iff αᵒᵈ _ _
+
+lemma is_glb_empty [order_top α] : is_glb ∅ (⊤:α) := is_glb_empty_iff.2 is_top_top
+lemma is_lub_empty [order_bot α] : is_lub ∅ (⊥:α) := @is_glb_empty αᵒᵈ _ _
+
+lemma is_lub.nonempty [no_min_order α] (hs : is_lub s a) : s.nonempty :=
+let ⟨a', ha'⟩ := exists_lt a in
+nonempty_iff_ne_empty.2 $ λ h, not_le_of_lt ha' $ hs.right $ by simp only [h, upper_bounds_empty]
+
+lemma is_glb.nonempty [no_max_order α] (hs : is_glb s a) : s.nonempty := hs.dual.nonempty
+
+lemma nonempty_of_not_bdd_above [ha : nonempty α] (h : ¬bdd_above s) : s.nonempty :=
+nonempty.elim ha $ λ x, (not_bdd_above_iff'.1 h x).imp $ λ a ha, ha.fst
+
+lemma nonempty_of_not_bdd_below [ha : nonempty α] (h : ¬bdd_below s) : s.nonempty :=
+@nonempty_of_not_bdd_above αᵒᵈ _ _ _ h
+
+/-!
+#### insert
+-/
+
+/-- Adding a point to a set preserves its boundedness above. -/
+@[simp] lemma bdd_above_insert [is_directed α (≤)] {s : set α} {a : α} :
+  bdd_above (insert a s) ↔ bdd_above s :=
+by simp only [insert_eq, bdd_above_union, bdd_above_singleton, true_and]
+
+protected lemma bdd_above.insert [is_directed α (≤)] {s : set α} (a : α) :
+  bdd_above s → bdd_above (insert a s) :=
+bdd_above_insert.2
+
+/--Adding a point to a set preserves its boundedness below.-/
+@[simp] lemma bdd_below_insert [is_directed α (≥)] {s : set α} {a : α} :
+  bdd_below (insert a s) ↔ bdd_below s :=
+by simp only [insert_eq, bdd_below_union, bdd_below_singleton, true_and]
+
+lemma bdd_below.insert [is_directed α (≥)] {s : set α} (a : α) :
+  bdd_below s → bdd_below (insert a s) :=
+bdd_below_insert.2
+
+lemma is_lub.insert [semilattice_sup γ] (a) {b} {s : set γ} (hs : is_lub s b) :
+  is_lub (insert a s) (a ⊔ b) :=
+by { rw insert_eq, exact is_lub_singleton.union hs }
+
+lemma is_glb.insert [semilattice_inf γ] (a) {b} {s : set γ} (hs : is_glb s b) :
+  is_glb (insert a s) (a ⊓ b) :=
+by { rw insert_eq, exact is_glb_singleton.union hs }
+
+lemma is_greatest.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_greatest s b) :
+  is_greatest (insert a s) (max a b) :=
+by { rw insert_eq, exact is_greatest_singleton.union hs }
+
+lemma is_least.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_least s b) :
+  is_least (insert a s) (min a b) :=
+by { rw insert_eq, exact is_least_singleton.union hs }
+
+@[simp] lemma upper_bounds_insert (a : α) (s : set α) :
+  upper_bounds (insert a s) = Ici a ∩ upper_bounds s :=
+by rw [insert_eq, upper_bounds_union, upper_bounds_singleton]
+
+@[simp] lemma lower_bounds_insert (a : α) (s : set α) :
+  lower_bounds (insert a s) = Iic a ∩ lower_bounds s :=
+by rw [insert_eq, lower_bounds_union, lower_bounds_singleton]
+
+/-- When there is a global maximum, every set is bounded above. -/
+@[simp] protected lemma order_top.bdd_above [order_top α] (s : set α) : bdd_above s :=
+⟨⊤, λ a ha, order_top.le_top a⟩
+
+/-- When there is a global minimum, every set is bounded below. -/
+@[simp] protected lemma order_bot.bdd_below [order_bot α] (s : set α) : bdd_below s :=
+⟨⊥, λ a ha, order_bot.bot_le a⟩
+
+/-!
+#### Pair
+-/
+
+lemma is_lub_pair [semilattice_sup γ] {a b : γ} : is_lub {a, b} (a ⊔ b) :=
+is_lub_singleton.insert _
+
+lemma is_glb_pair [semilattice_inf γ] {a b : γ} : is_glb {a, b} (a ⊓ b) :=
+is_glb_singleton.insert _
+
+lemma is_least_pair [linear_order γ] {a b : γ} : is_least {a, b} (min a b) :=
+is_least_singleton.insert _
+
+lemma is_greatest_pair [linear_order γ] {a b : γ} : is_greatest {a, b} (max a b) :=
+is_greatest_singleton.insert _
+
+/-!
+#### Lower/upper bounds
+-/
+
+@[simp] lemma is_lub_lower_bounds : is_lub (lower_bounds s) a ↔ is_glb s a :=
+⟨λ H, ⟨λ x hx, H.2 $ subset_upper_bounds_lower_bounds s hx, H.1⟩, is_greatest.is_lub⟩
+
+@[simp] lemma is_glb_upper_bounds : is_glb (upper_bounds s) a ↔ is_lub s a :=
+@is_lub_lower_bounds αᵒᵈ _ _ _
+
+end
+
+/-!
+### (In)equalities with the least upper bound and the greatest lower bound
+-/
+
+section preorder
+variables [preorder α] {s : set α} {a b : α}
+
+lemma lower_bounds_le_upper_bounds (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) :
+  s.nonempty → a ≤ b
+| ⟨c, hc⟩ := le_trans (ha hc) (hb hc)
+
+lemma is_glb_le_is_lub (ha : is_glb s a) (hb : is_lub s b) (hs : s.nonempty) : a ≤ b :=
+lower_bounds_le_upper_bounds ha.1 hb.1 hs
+
+lemma is_lub_lt_iff (ha : is_lub s a) : a < b ↔ ∃ c ∈ upper_bounds s, c < b :=
+⟨λ hb, ⟨a, ha.1, hb⟩, λ ⟨c, hcs, hcb⟩, lt_of_le_of_lt (ha.2 hcs) hcb⟩
+
+lemma lt_is_glb_iff (ha : is_glb s a) : b < a ↔ ∃ c ∈ lower_bounds s, b < c := is_lub_lt_iff ha.dual
+
+lemma le_of_is_lub_le_is_glb {x y} (ha : is_glb s a) (hb : is_lub s b) (hab : b ≤ a)
+  (hx : x ∈ s) (hy : y ∈ s) : x ≤ y :=
+calc x ≤ b : hb.1 hx
+   ... ≤ a : hab
+   ... ≤ y : ha.1 hy
+
+end preorder
+
+section partial_order
+variables [partial_order α] {s : set α} {a b : α}
+
+lemma is_least.unique (Ha : is_least s a) (Hb : is_least s b) : a = b :=
+le_antisymm (Ha.right Hb.left) (Hb.right Ha.left)
+
+lemma is_least.is_least_iff_eq (Ha : is_least s a) : is_least s b ↔ a = b :=
+iff.intro Ha.unique (λ h, h ▸ Ha)
+
+lemma is_greatest.unique (Ha : is_greatest s a) (Hb : is_greatest s b) : a = b :=
+le_antisymm (Hb.right Ha.left) (Ha.right Hb.left)
+
+lemma is_greatest.is_greatest_iff_eq (Ha : is_greatest s a) : is_greatest s b ↔ a = b :=
+iff.intro Ha.unique (λ h, h ▸ Ha)
+
+lemma is_lub.unique (Ha : is_lub s a) (Hb : is_lub s b) : a = b :=
+Ha.unique Hb
+
+lemma is_glb.unique (Ha : is_glb s a) (Hb : is_glb s b) : a = b :=
+Ha.unique Hb
+
+lemma set.subsingleton_of_is_lub_le_is_glb (Ha : is_glb s a) (Hb : is_lub s b) (hab : b ≤ a) :
+  s.subsingleton :=
+λ x hx y hy, le_antisymm (le_of_is_lub_le_is_glb Ha Hb hab hx hy)
+  (le_of_is_lub_le_is_glb Ha Hb hab hy hx)
+
+lemma is_glb_lt_is_lub_of_ne (Ha : is_glb s a) (Hb : is_lub s b)
+  {x y} (Hx : x ∈ s) (Hy : y ∈ s) (Hxy : x ≠ y) :
+  a < b :=
+lt_iff_le_not_le.2
+  ⟨lower_bounds_le_upper_bounds Ha.1 Hb.1 ⟨x, Hx⟩,
+    λ hab, Hxy $ set.subsingleton_of_is_lub_le_is_glb Ha Hb hab Hx Hy⟩
+
+end partial_order
+
+section linear_order
+variables [linear_order α] {s : set α} {a b : α}
+
+lemma lt_is_lub_iff (h : is_lub s a) : b < a ↔ ∃ c ∈ s, b < c :=
+by simp only [← not_le, is_lub_le_iff h, mem_upper_bounds, not_forall]
+
+lemma is_glb_lt_iff (h : is_glb s a) : a < b ↔ ∃ c ∈ s, c < b := lt_is_lub_iff h.dual
+
+lemma is_lub.exists_between (h : is_lub s a) (hb : b < a) :
+  ∃ c ∈ s, b < c ∧ c ≤ a :=
+let ⟨c, hcs, hbc⟩ := (lt_is_lub_iff h).1 hb in ⟨c, hcs, hbc, h.1 hcs⟩
+
+lemma is_lub.exists_between' (h : is_lub s a) (h' : a ∉ s) (hb : b < a) :
+  ∃ c ∈ s, b < c ∧ c < a :=
+let ⟨c, hcs, hbc, hca⟩ := h.exists_between hb
+in ⟨c, hcs, hbc, hca.lt_of_ne $ λ hac, h' $ hac ▸ hcs⟩
+
+lemma is_glb.exists_between (h : is_glb s a) (hb : a < b) :
+  ∃ c ∈ s, a ≤ c ∧ c < b :=
+let ⟨c, hcs, hbc⟩ := (is_glb_lt_iff h).1 hb in ⟨c, hcs, h.1 hcs, hbc⟩
+
+lemma is_glb.exists_between' (h : is_glb s a) (h' : a ∉ s) (hb : a < b) :
+  ∃ c ∈ s, a < c ∧ c < b :=
+let ⟨c, hcs, hac, hcb⟩ := h.exists_between hb
+in ⟨c, hcs, hac.lt_of_ne $ λ hac, h' $ hac.symm ▸ hcs, hcb⟩
+
+end linear_order
+
+
+
+/-!
+### Images of upper/lower bounds under monotone functions
+-/
+
+namespace monotone_on
+
+variables [preorder α] [preorder β] {f : α → β} {s t : set α}
+  (Hf : monotone_on f t) {a : α} (Hst : s ⊆ t)
+include Hf
+
+lemma mem_upper_bounds_image (Has : a ∈ upper_bounds s) (Hat : a ∈ t) :
+  f a ∈ upper_bounds (f '' s) :=
+ball_image_of_ball (λ x H, Hf (Hst H) Hat (Has H))
+
+lemma mem_upper_bounds_image_self : a ∈ upper_bounds t → a ∈ t → f a ∈ upper_bounds (f '' t) :=
+Hf.mem_upper_bounds_image subset_rfl
+
+lemma mem_lower_bounds_image (Has : a ∈ lower_bounds s) (Hat : a ∈ t) :
+  f a ∈ lower_bounds (f '' s) :=
+ball_image_of_ball (λ x H, Hf Hat (Hst H) (Has H))
+
+lemma mem_lower_bounds_image_self : a ∈ lower_bounds t → a ∈ t → f a ∈ lower_bounds (f '' t) :=
+Hf.mem_lower_bounds_image subset_rfl
+
+lemma image_upper_bounds_subset_upper_bounds_image (Hst : s ⊆ t) :
+  f '' (upper_bounds s ∩ t) ⊆ upper_bounds (f '' s) :=
+by { rintro _ ⟨a, ha, rfl⟩, exact Hf.mem_upper_bounds_image Hst ha.1 ha.2 }
+
+lemma image_lower_bounds_subset_lower_bounds_image :
+  f '' (lower_bounds s ∩ t) ⊆ lower_bounds (f '' s) :=
+Hf.dual.image_upper_bounds_subset_upper_bounds_image Hst
+
+/-- The image under a monotone function on a set `t` of a subset which has an upper bound in `t`
+  is bounded above. -/
+lemma map_bdd_above : (upper_bounds s ∩ t).nonempty → bdd_above (f '' s) :=
+λ ⟨C, hs, ht⟩, ⟨f C, Hf.mem_upper_bounds_image Hst hs ht⟩
+
+/-- The image under a monotone function on a set `t` of a subset which has a lower bound in `t`
+  is bounded below. -/
+lemma map_bdd_below : (lower_bounds s ∩ t).nonempty → bdd_below (f '' s) :=
+λ ⟨C, hs, ht⟩, ⟨f C, Hf.mem_lower_bounds_image Hst hs ht⟩
+
+/-- A monotone map sends a least element of a set to a least element of its image. -/
+lemma map_is_least (Ha : is_least t a) : is_least (f '' t) (f a) :=
+⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image_self Ha.2 Ha.1⟩
+
+/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
+lemma map_is_greatest (Ha : is_greatest t a) : is_greatest (f '' t) (f a) :=
+⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image_self Ha.2 Ha.1⟩
+
+end monotone_on
+
+namespace antitone_on
+
+variables [preorder α] [preorder β] {f : α → β} {s t : set α}
+  (Hf : antitone_on f t) {a : α} (Hst : s ⊆ t)
+include Hf
+
+lemma mem_upper_bounds_image (Has : a ∈ lower_bounds s) : a ∈ t → f a ∈ upper_bounds (f '' s) :=
+Hf.dual_right.mem_lower_bounds_image Hst Has
+
+lemma mem_upper_bounds_image_self : a ∈ lower_bounds t → a ∈ t → f a ∈ upper_bounds (f '' t) :=
+Hf.dual_right.mem_lower_bounds_image_self
+
+lemma mem_lower_bounds_image : a ∈ upper_bounds s → a ∈ t → f a ∈ lower_bounds (f '' s) :=
+Hf.dual_right.mem_upper_bounds_image Hst
+
+lemma mem_lower_bounds_image_self : a ∈ upper_bounds t → a ∈ t → f a ∈ lower_bounds (f '' t) :=
+Hf.dual_right.mem_upper_bounds_image_self
+
+lemma image_lower_bounds_subset_upper_bounds_image :
+  f '' (lower_bounds s ∩ t) ⊆ upper_bounds (f '' s) :=
+Hf.dual_right.image_lower_bounds_subset_lower_bounds_image Hst
+
+lemma image_upper_bounds_subset_lower_bounds_image :
+  f '' (upper_bounds s ∩ t) ⊆ lower_bounds (f '' s) :=
+Hf.dual_right.image_upper_bounds_subset_upper_bounds_image Hst
+
+/-- The image under an antitone function of a set which is bounded above is bounded below. -/
+lemma map_bdd_above : (upper_bounds s ∩ t).nonempty → bdd_below (f '' s) :=
+Hf.dual_right.map_bdd_above Hst
+
+/-- The image under an antitone function of a set which is bounded below is bounded above. -/
+lemma map_bdd_below : (lower_bounds s ∩ t).nonempty → bdd_above (f '' s) :=
+Hf.dual_right.map_bdd_below Hst
+
+/-- An antitone map sends a greatest element of a set to a least element of its image. -/
+lemma map_is_greatest : is_greatest t a → is_least (f '' t) (f a) :=
+Hf.dual_right.map_is_greatest
+
+/-- An antitone map sends a least element of a set to a greatest element of its image. -/
+lemma map_is_least : is_least t a → is_greatest (f '' t) (f a) :=
+Hf.dual_right.map_is_least
+
+end antitone_on
+
+namespace monotone
+
+variables [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α}
+include Hf
+
+lemma mem_upper_bounds_image (Ha : a ∈ upper_bounds s) : f a ∈ upper_bounds (f '' s) :=
+ball_image_of_ball (λ x H, Hf (Ha H))
+
+lemma mem_lower_bounds_image (Ha : a ∈ lower_bounds s) : f a ∈ lower_bounds (f '' s) :=
+ball_image_of_ball (λ x H, Hf (Ha H))
+
+lemma image_upper_bounds_subset_upper_bounds_image : f '' upper_bounds s ⊆ upper_bounds (f '' s) :=
+by { rintro _ ⟨a, ha, rfl⟩, exact Hf.mem_upper_bounds_image ha }
+
+lemma image_lower_bounds_subset_lower_bounds_image : f '' lower_bounds s ⊆ lower_bounds (f '' s) :=
+Hf.dual.image_upper_bounds_subset_upper_bounds_image
+
+/-- The image under a monotone function of a set which is bounded above is bounded above. See also
+`bdd_above.image2`. -/
+lemma map_bdd_above : bdd_above s → bdd_above (f '' s)
+| ⟨C, hC⟩ := ⟨f C, Hf.mem_upper_bounds_image hC⟩
+
+/-- The image under a monotone function of a set which is bounded below is bounded below. See also
+`bdd_below.image2`. -/
+lemma map_bdd_below : bdd_below s → bdd_below (f '' s)
+| ⟨C, hC⟩ := ⟨f C, Hf.mem_lower_bounds_image hC⟩
+
+/-- A monotone map sends a least element of a set to a least element of its image. -/
+lemma map_is_least (Ha : is_least s a) : is_least (f '' s) (f a) :=
+⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image Ha.2⟩
+
+/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
+lemma map_is_greatest (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
+⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image Ha.2⟩
+
+end monotone
+
+namespace antitone
+variables [preorder α] [preorder β] {f : α → β} (hf : antitone f) {a : α} {s : set α}
+
+lemma mem_upper_bounds_image : a ∈ lower_bounds s → f a ∈ upper_bounds (f '' s) :=
+hf.dual_right.mem_lower_bounds_image
+
+lemma mem_lower_bounds_image : a ∈ upper_bounds s → f a ∈ lower_bounds (f '' s) :=
+hf.dual_right.mem_upper_bounds_image
+
+lemma image_lower_bounds_subset_upper_bounds_image : f '' lower_bounds s ⊆ upper_bounds (f '' s) :=
+hf.dual_right.image_lower_bounds_subset_lower_bounds_image
+
+lemma image_upper_bounds_subset_lower_bounds_image : f '' upper_bounds s ⊆ lower_bounds (f '' s) :=
+hf.dual_right.image_upper_bounds_subset_upper_bounds_image
+
+/-- The image under an antitone function of a set which is bounded above is bounded below. -/
+lemma map_bdd_above : bdd_above s → bdd_below (f '' s) :=
+hf.dual_right.map_bdd_above
+
+/-- The image under an antitone function of a set which is bounded below is bounded above. -/
+lemma map_bdd_below : bdd_below s → bdd_above (f '' s) :=
+hf.dual_right.map_bdd_below
+
+/-- An antitone map sends a greatest element of a set to a least element of its image. -/
+lemma map_is_greatest : is_greatest s a → is_least (f '' s) (f a) :=
+hf.dual_right.map_is_greatest
+
+/-- An antitone map sends a least element of a set to a greatest element of its image. -/
+lemma map_is_least : is_least s a → is_greatest (f '' s) (f a) :=
+hf.dual_right.map_is_least
+
+end antitone
+
+section image2
+variables [preorder α] [preorder β] [preorder γ] {f : α → β → γ} {s : set α} {t : set β} {a : α}
+  {b : β}
+
+section monotone_monotone
+variables (h₀ : ∀ b, monotone (swap f b)) (h₁ : ∀ a, monotone (f a))
+include h₀ h₁
+
+lemma mem_upper_bounds_image2 (ha : a ∈ upper_bounds s) (hb : b ∈ upper_bounds t) :
+  f a b ∈ upper_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma mem_lower_bounds_image2 (ha : a ∈ lower_bounds s) (hb : b ∈ lower_bounds t) :
+  f a b ∈ lower_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma image2_upper_bounds_upper_bounds_subset :
+  image2 f (upper_bounds s) (upper_bounds t) ⊆ upper_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_upper_bounds_image2 h₀ h₁ ha hb }
+
+lemma image2_lower_bounds_lower_bounds_subset :
+  image2 f (lower_bounds s) (lower_bounds t) ⊆ lower_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_lower_bounds_image2 h₀ h₁ ha hb }
+
+/-- See also `monotone.map_bdd_above`. -/
+lemma bdd_above.image2 : bdd_above s → bdd_above t → bdd_above (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩, exact ⟨f a b, mem_upper_bounds_image2 h₀ h₁ ha hb⟩ }
+
+/-- See also `monotone.map_bdd_below`. -/
+lemma bdd_below.image2 : bdd_below s → bdd_below t → bdd_below (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩, exact ⟨f a b, mem_lower_bounds_image2 h₀ h₁ ha hb⟩ }
+
+lemma is_greatest.image2 (ha : is_greatest s a) (hb : is_greatest t b) :
+  is_greatest (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1, mem_upper_bounds_image2 h₀ h₁ ha.2 hb.2⟩
+
+lemma is_least.image2 (ha : is_least s a) (hb : is_least t b) : is_least (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1, mem_lower_bounds_image2 h₀ h₁ ha.2 hb.2⟩
+
+end monotone_monotone
+
+section monotone_antitone
+variables (h₀ : ∀ b, monotone (swap f b)) (h₁ : ∀ a, antitone (f a))
+include h₀ h₁
+
+lemma mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds (ha : a ∈ upper_bounds s)
+  (hb : b ∈ lower_bounds t) : f a b ∈ upper_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds (ha : a ∈ lower_bounds s)
+  (hb : b ∈ upper_bounds t) : f a b ∈ lower_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma image2_upper_bounds_lower_bounds_subset_upper_bounds_image2 :
+  image2 f (upper_bounds s) (lower_bounds t) ⊆ upper_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩,
+  exact mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds h₀ h₁ ha hb }
+
+lemma image2_lower_bounds_upper_bounds_subset_lower_bounds_image2 :
+  image2 f (lower_bounds s) (upper_bounds t) ⊆ lower_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩,
+  exact mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds h₀ h₁ ha hb }
+
+lemma bdd_above.bdd_above_image2_of_bdd_below :
+  bdd_above s → bdd_below t → bdd_above (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  exact ⟨f a b, mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds h₀ h₁ ha hb⟩ }
+
+lemma bdd_below.bdd_below_image2_of_bdd_above :
+  bdd_below s → bdd_above t → bdd_below (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  exact ⟨f a b, mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds h₀ h₁ ha hb⟩ }
+
+lemma is_greatest.is_greatest_image2_of_is_least (ha : is_greatest s a) (hb : is_least t b) :
+  is_greatest (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1,
+  mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_lower_bounds h₀ h₁ ha.2 hb.2⟩
+
+lemma is_least.is_least_image2_of_is_greatest (ha : is_least s a) (hb : is_greatest t b) :
+  is_least (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1,
+  mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_upper_bounds h₀ h₁ ha.2 hb.2⟩
+
+end monotone_antitone
+
+section antitone_antitone
+variables (h₀ : ∀ b, antitone (swap f b)) (h₁ : ∀ a, antitone (f a))
+include h₀ h₁
+
+lemma mem_upper_bounds_image2_of_mem_lower_bounds (ha : a ∈ lower_bounds s)
+  (hb : b ∈ lower_bounds t) :
+  f a b ∈ upper_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma mem_lower_bounds_image2_of_mem_upper_bounds (ha : a ∈ upper_bounds s)
+  (hb : b ∈ upper_bounds t) :
+  f a b ∈ lower_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma image2_upper_bounds_upper_bounds_subset_upper_bounds_image2 :
+  image2 f (lower_bounds s) (lower_bounds t) ⊆ upper_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_upper_bounds_image2_of_mem_lower_bounds h₀ h₁ ha hb }
+
+lemma image2_lower_bounds_lower_bounds_subset_lower_bounds_image2 :
+  image2 f (upper_bounds s) (upper_bounds t) ⊆ lower_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩, exact mem_lower_bounds_image2_of_mem_upper_bounds h₀ h₁ ha hb }
+
+lemma bdd_below.image2_bdd_above : bdd_below s → bdd_below t → bdd_above (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  exact ⟨f a b, mem_upper_bounds_image2_of_mem_lower_bounds h₀ h₁ ha hb⟩ }
+
+lemma bdd_above.image2_bdd_below : bdd_above s → bdd_above t → bdd_below (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  exact ⟨f a b, mem_lower_bounds_image2_of_mem_upper_bounds h₀ h₁ ha hb⟩ }
+
+lemma is_least.is_greatest_image2 (ha : is_least s a) (hb : is_least t b) :
+  is_greatest (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1, mem_upper_bounds_image2_of_mem_lower_bounds h₀ h₁ ha.2 hb.2⟩
+
+lemma is_greatest.is_least_image2 (ha : is_greatest s a) (hb : is_greatest t b) :
+  is_least (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1, mem_lower_bounds_image2_of_mem_upper_bounds h₀ h₁ ha.2 hb.2⟩
+
+end antitone_antitone
+
+section antitone_monotone
+variables (h₀ : ∀ b, antitone (swap f b)) (h₁ : ∀ a, monotone (f a))
+include h₀ h₁
+
+lemma mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds (ha : a ∈ lower_bounds s)
+  (hb : b ∈ upper_bounds t) : f a b ∈ upper_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds (ha : a ∈ upper_bounds s)
+  (hb : b ∈ lower_bounds t) : f a b ∈ lower_bounds (image2 f s t) :=
+forall_image2_iff.2 $ λ x hx y hy, (h₀ _ $ ha hx).trans $ h₁ _ $ hb hy
+
+lemma image2_lower_bounds_upper_bounds_subset_upper_bounds_image2 :
+  image2 f (lower_bounds s) (upper_bounds t) ⊆ upper_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩,
+  exact mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds h₀ h₁ ha hb }
+
+lemma image2_upper_bounds_lower_bounds_subset_lower_bounds_image2 :
+  image2 f (upper_bounds s) (lower_bounds t) ⊆ lower_bounds (image2 f s t) :=
+by { rintro _ ⟨a, b, ha, hb, rfl⟩,
+  exact mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds h₀ h₁ ha hb }
+
+lemma bdd_below.bdd_above_image2_of_bdd_above :
+  bdd_below s → bdd_above t → bdd_above (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  exact ⟨f a b, mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds h₀ h₁ ha hb⟩ }
+
+lemma bdd_above.bdd_below_image2_of_bdd_above :
+  bdd_above s → bdd_below t → bdd_below (image2 f s t) :=
+by { rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  exact ⟨f a b, mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds h₀ h₁ ha hb⟩ }
+
+lemma is_least.is_greatest_image2_of_is_greatest (ha : is_least s a) (hb : is_greatest t b) :
+  is_greatest (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1,
+  mem_upper_bounds_image2_of_mem_upper_bounds_of_mem_upper_bounds h₀ h₁ ha.2 hb.2⟩
+
+lemma is_greatest.is_least_image2_of_is_least (ha : is_greatest s a) (hb : is_least t b) :
+  is_least (image2 f s t) (f a b) :=
+⟨mem_image2_of_mem ha.1 hb.1,
+  mem_lower_bounds_image2_of_mem_lower_bounds_of_mem_lower_bounds h₀ h₁ ha.2 hb.2⟩
+
+end antitone_monotone
+end image2
+
+lemma is_glb.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
+  {s : set α} {x : α} (hx : is_glb (f '' s) (f x)) :
+  is_glb s x :=
+⟨λ y hy, hf.1 $ hx.1 $ mem_image_of_mem _ hy,
+  λ y hy, hf.1 $ hx.2 $ monotone.mem_lower_bounds_image (λ x y, hf.2) hy⟩
+
+lemma is_lub.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
+  {s : set α} {x : α} (hx : is_lub (f '' s) (f x)) :
+  is_lub s x :=
+@is_glb.of_image αᵒᵈ βᵒᵈ _ _ f (λ x y, hf) _ _ hx
+
+lemma is_lub_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
+  is_lub s f ↔ ∀ a, is_lub (function.eval a '' s) (f a) :=
+begin
+  classical,
+  refine ⟨λ H a, ⟨(function.monotone_eval a).mem_upper_bounds_image H.1, λ b hb, _⟩, λ H, ⟨_, _⟩⟩,
+  { suffices : function.update f a b ∈ upper_bounds s,
+      from function.update_same a b f ▸ H.2 this a,
+    refine λ g hg, le_update_iff.2 ⟨hb $ mem_image_of_mem _ hg, λ i hi, H.1 hg i⟩ },
+  { exact λ g hg a, (H a).1 (mem_image_of_mem _ hg) },
+  { exact λ g hg a, (H a).2 ((function.monotone_eval a).mem_upper_bounds_image hg) }
+end
+
+lemma is_glb_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
+  is_glb s f ↔ ∀ a, is_glb (function.eval a '' s) (f a) :=
+@is_lub_pi α (λ a, (π a)ᵒᵈ) _ s f
+
+lemma is_lub_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
+  is_lub s p ↔ is_lub (prod.fst '' s) p.1 ∧ is_lub (prod.snd '' s) p.2 :=
+begin
+  refine ⟨λ H, ⟨⟨monotone_fst.mem_upper_bounds_image H.1, λ a ha, _⟩,
+    ⟨monotone_snd.mem_upper_bounds_image H.1, λ a ha, _⟩⟩, λ H, ⟨_, _⟩⟩,
+  { suffices : (a, p.2) ∈ upper_bounds s, from (H.2 this).1,
+    exact λ q hq, ⟨ha $ mem_image_of_mem _ hq, (H.1 hq).2⟩ },
+  { suffices : (p.1, a) ∈ upper_bounds s, from (H.2 this).2,
+    exact λ q hq, ⟨(H.1 hq).1, ha $ mem_image_of_mem _ hq⟩ },
+  { exact λ q hq, ⟨H.1.1 $ mem_image_of_mem _ hq, H.2.1 $ mem_image_of_mem _ hq⟩ },
+  { exact λ q hq, ⟨H.1.2 $ monotone_fst.mem_upper_bounds_image hq,
+      H.2.2 $ monotone_snd.mem_upper_bounds_image hq⟩ }
+end
+
+lemma is_glb_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
+  is_glb s p ↔ is_glb (prod.fst '' s) p.1 ∧ is_glb (prod.snd '' s) p.2 :=
+@is_lub_prod αᵒᵈ βᵒᵈ _ _ _ _
+
+section scott_continuous
+variables [preorder α] [preorder β] {f : α → β} {a : α}
+
+/-- A function between preorders is said to be Scott continuous if it preserves `is_lub` on directed
+sets. It can be shown that a function is Scott continuous if and only if it is continuous wrt the
+Scott topology.
+
+The dual notion
+
+```lean
+∀ ⦃d : set α⦄, d.nonempty → directed_on (≥) d → ∀ ⦃a⦄, is_glb d a → is_glb (f '' d) (f a)
+```
+
+does not appear to play a significant role in the literature, so is omitted here.
+-/
+def scott_continuous (f : α → β) : Prop :=
+∀ ⦃d : set α⦄, d.nonempty → directed_on (≤) d → ∀ ⦃a⦄, is_lub d a → is_lub (f '' d) (f a)
+
+protected lemma scott_continuous.monotone (h : scott_continuous f) : monotone f :=
+begin
+  refine λ a b hab, (h (insert_nonempty _ _) (directed_on_pair le_refl hab) _).1
+    (mem_image_of_mem _ $ mem_insert _ _),
+  rw [is_lub, upper_bounds_insert, upper_bounds_singleton,
+    inter_eq_self_of_subset_right (Ici_subset_Ici.2 hab)],
+  exact is_least_Ici,
+end
+
+end scott_continuous
diff --git a/src/order/bounds/order_iso.lean b/src/order/bounds/order_iso.lean
new file mode 100644
index 0000000000000..b90ea907458e5
--- /dev/null
+++ b/src/order/bounds/order_iso.lean
@@ -0,0 +1,65 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Yury Kudryashov
+-/
+import order.bounds.basic
+import order.hom.set
+
+/-!
+# Order isomorhpisms and bounds.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α β : Type*}
+open set
+
+namespace order_iso
+
+variables [preorder α] [preorder β] (f : α ≃o β)
+
+lemma upper_bounds_image {s : set α} :
+  upper_bounds (f '' s) = f '' upper_bounds s :=
+subset.antisymm
+  (λ x hx, ⟨f.symm x, λ y hy, f.le_symm_apply.2 (hx $ mem_image_of_mem _ hy), f.apply_symm_apply x⟩)
+  f.monotone.image_upper_bounds_subset_upper_bounds_image
+
+lemma lower_bounds_image {s : set α} : lower_bounds (f '' s) = f '' lower_bounds s :=
+@upper_bounds_image αᵒᵈ βᵒᵈ _ _ f.dual _
+
+@[simp] lemma is_lub_image {s : set α} {x : β} :
+  is_lub (f '' s) x ↔ is_lub s (f.symm x) :=
+⟨λ h, is_lub.of_image (λ _ _, f.le_iff_le) ((f.apply_symm_apply x).symm ▸ h),
+  λ h, is_lub.of_image (λ _ _, f.symm.le_iff_le) $ (f.symm_image_image s).symm ▸ h⟩
+
+lemma is_lub_image' {s : set α} {x : α} :
+  is_lub (f '' s) (f x) ↔ is_lub s x :=
+by rw [is_lub_image, f.symm_apply_apply]
+
+@[simp] lemma is_glb_image {s : set α} {x : β} :
+  is_glb (f '' s) x ↔ is_glb s (f.symm x) :=
+f.dual.is_lub_image
+
+lemma is_glb_image' {s : set α} {x : α} :
+  is_glb (f '' s) (f x) ↔ is_glb s x :=
+f.dual.is_lub_image'
+
+@[simp] lemma is_lub_preimage {s : set β} {x : α} :
+  is_lub (f ⁻¹' s) x ↔ is_lub s (f x) :=
+by rw [← f.symm_symm, ← image_eq_preimage, is_lub_image]
+
+lemma is_lub_preimage' {s : set β} {x : β} :
+  is_lub (f ⁻¹' s) (f.symm x) ↔ is_lub s x :=
+by rw [is_lub_preimage, f.apply_symm_apply]
+
+@[simp] lemma is_glb_preimage {s : set β} {x : α} :
+  is_glb (f ⁻¹' s) x ↔ is_glb s (f x) :=
+f.dual.is_lub_preimage
+
+lemma is_glb_preimage' {s : set β} {x : β} :
+  is_glb (f ⁻¹' s) (f.symm x) ↔ is_glb s x :=
+f.dual.is_lub_preimage'
+
+end order_iso
diff --git a/src/order/category/BddDistLat.lean b/src/order/category/BddDistLat.lean
new file mode 100644
index 0000000000000..1741ae9c5256a
--- /dev/null
+++ b/src/order/category/BddDistLat.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.BddLat
+import order.category.DistLat
+
+/-!
+# The category of bounded distributive lattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `BddDistLat`, the category of bounded distributive lattices.
+
+Note that this category is sometimes called [`DistLat`](https://ncatlab.org/nlab/show/DistLat) when
+being a lattice is understood to entail having a bottom and a top element.
+-/
+
+universes u
+
+open category_theory
+
+/-- The category of bounded distributive lattices with bounded lattice morphisms. -/
+structure BddDistLat :=
+(to_DistLat : DistLat)
+[is_bounded_order : bounded_order to_DistLat]
+
+namespace BddDistLat
+
+instance : has_coe_to_sort BddDistLat Type* := ⟨λ X, X.to_DistLat⟩
+instance (X : BddDistLat) : distrib_lattice X := X.to_DistLat.str
+
+attribute [instance] BddDistLat.is_bounded_order
+
+/-- Construct a bundled `BddDistLat` from a `bounded_order` `distrib_lattice`. -/
+def of (α : Type*) [distrib_lattice α] [bounded_order α] : BddDistLat := ⟨⟨α⟩⟩
+
+@[simp] lemma coe_of (α : Type*) [distrib_lattice α] [bounded_order α] : ↥(of α) = α := rfl
+
+instance : inhabited BddDistLat := ⟨of punit⟩
+
+/-- Turn a `BddDistLat` into a `BddLat` by forgetting it is distributive. -/
+def to_BddLat (X : BddDistLat) : BddLat := BddLat.of X
+
+@[simp] lemma coe_to_BddLat (X : BddDistLat) : ↥X.to_BddLat = ↥X := rfl
+
+instance : large_category.{u} BddDistLat := induced_category.category to_BddLat
+
+instance : concrete_category BddDistLat :=
+induced_category.concrete_category to_BddLat
+
+instance has_forget_to_DistLat : has_forget₂ BddDistLat DistLat :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_lattice_hom } }
+
+instance has_forget_to_BddLat : has_forget₂ BddDistLat BddLat :=
+induced_category.has_forget₂ to_BddLat
+
+lemma forget_BddLat_Lat_eq_forget_DistLat_Lat :
+  forget₂ BddDistLat BddLat ⋙ forget₂ BddLat Lat =
+    forget₂ BddDistLat DistLat ⋙ forget₂ DistLat Lat := rfl
+
+/-- Constructs an equivalence between bounded distributive lattices from an order isomorphism
+between them. -/
+@[simps] def iso.mk {α β : BddDistLat.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := (e : bounded_lattice_hom α β),
+  inv := (e.symm : bounded_lattice_hom β α),
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : BddDistLat ⥤ BddDistLat :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_lattice_hom.dual }
+
+/-- The equivalence between `BddDistLat` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : BddDistLat ≌ BddDistLat :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end BddDistLat
+
+lemma BddDistLat_dual_comp_forget_to_DistLat :
+  BddDistLat.dual ⋙ forget₂ BddDistLat DistLat =
+    forget₂ BddDistLat DistLat ⋙ DistLat.dual := rfl
diff --git a/src/order/category/BddLat.lean b/src/order/category/BddLat.lean
new file mode 100644
index 0000000000000..99d624ae156e3
--- /dev/null
+++ b/src/order/category/BddLat.lean
@@ -0,0 +1,167 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import category_theory.adjunction.opposites
+import order.category.BddOrd
+import order.category.Lat
+import order.category.Semilat
+
+/-!
+# The category of bounded lattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `BddLat`, the category of bounded lattices.
+
+In literature, this is sometimes called `Lat`, the category of lattices, because being a lattice is
+understood to entail having a bottom and a top element.
+-/
+
+universes u
+
+open category_theory
+
+/-- The category of bounded lattices with bounded lattice morphisms. -/
+structure BddLat :=
+(to_Lat : Lat)
+[is_bounded_order : bounded_order to_Lat]
+
+namespace BddLat
+
+instance : has_coe_to_sort BddLat Type* := ⟨λ X, X.to_Lat⟩
+instance (X : BddLat) : lattice X := X.to_Lat.str
+
+attribute [instance] BddLat.is_bounded_order
+
+/-- Construct a bundled `BddLat` from `lattice` + `bounded_order`. -/
+def of (α : Type*) [lattice α] [bounded_order α] : BddLat := ⟨⟨α⟩⟩
+
+@[simp] lemma coe_of (α : Type*) [lattice α] [bounded_order α] : ↥(of α) = α := rfl
+
+instance : inhabited BddLat := ⟨of punit⟩
+
+instance : large_category.{u} BddLat :=
+{ hom := λ X Y, bounded_lattice_hom X Y,
+  id := λ X, bounded_lattice_hom.id X,
+  comp := λ X Y Z f g, g.comp f,
+  id_comp' := λ X Y, bounded_lattice_hom.comp_id,
+  comp_id' := λ X Y, bounded_lattice_hom.id_comp,
+  assoc' := λ W X Y Z _ _ _, bounded_lattice_hom.comp_assoc _ _ _ }
+
+instance : concrete_category BddLat :=
+{ forget := ⟨coe_sort, λ X Y, coe_fn, λ X, rfl, λ X Y Z f g, rfl⟩,
+  forget_faithful := ⟨λ X Y, by convert fun_like.coe_injective⟩ }
+
+instance has_forget_to_BddOrd : has_forget₂ BddLat BddOrd :=
+{ forget₂ := { obj := λ X, BddOrd.of X,
+               map := λ X Y, bounded_lattice_hom.to_bounded_order_hom } }
+
+instance has_forget_to_Lat : has_forget₂ BddLat Lat :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_lattice_hom } }
+
+instance has_forget_to_SemilatSup : has_forget₂ BddLat SemilatSup :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_sup_bot_hom } }
+
+instance has_forget_to_SemilatInf : has_forget₂ BddLat SemilatInf :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_inf_top_hom } }
+
+@[simp] lemma coe_forget_to_BddOrd (X : BddLat) :
+  ↥((forget₂ BddLat BddOrd).obj X) = ↥X := rfl
+
+@[simp] lemma coe_forget_to_Lat (X : BddLat) :
+  ↥((forget₂ BddLat Lat).obj X) = ↥X := rfl
+
+@[simp] lemma coe_forget_to_SemilatSup (X : BddLat) :
+  ↥((forget₂ BddLat SemilatSup).obj X) = ↥X := rfl
+
+@[simp] lemma coe_forget_to_SemilatInf (X : BddLat) :
+  ↥((forget₂ BddLat SemilatInf).obj X) = ↥X := rfl
+
+lemma forget_Lat_PartOrd_eq_forget_BddOrd_PartOrd :
+  forget₂ BddLat Lat ⋙ forget₂ Lat PartOrd =
+    forget₂ BddLat BddOrd ⋙ forget₂ BddOrd PartOrd := rfl
+
+lemma forget_SemilatSup_PartOrd_eq_forget_BddOrd_PartOrd :
+  forget₂ BddLat SemilatSup ⋙ forget₂ SemilatSup PartOrd =
+    forget₂ BddLat BddOrd ⋙ forget₂ BddOrd PartOrd := rfl
+
+lemma forget_SemilatInf_PartOrd_eq_forget_BddOrd_PartOrd :
+  forget₂ BddLat SemilatInf ⋙ forget₂ SemilatInf PartOrd =
+    forget₂ BddLat BddOrd ⋙ forget₂ BddOrd PartOrd := rfl
+
+/-- Constructs an equivalence between bounded lattices from an order isomorphism
+between them. -/
+@[simps] def iso.mk {α β : BddLat.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : BddLat ⥤ BddLat :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_lattice_hom.dual }
+
+/-- The equivalence between `BddLat` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : BddLat ≌ BddLat :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end BddLat
+
+lemma BddLat_dual_comp_forget_to_BddOrd :
+  BddLat.dual ⋙ forget₂ BddLat BddOrd =
+    forget₂ BddLat BddOrd ⋙ BddOrd.dual := rfl
+
+lemma BddLat_dual_comp_forget_to_Lat :
+  BddLat.dual ⋙ forget₂ BddLat Lat =
+    forget₂ BddLat Lat ⋙ Lat.dual := rfl
+
+lemma BddLat_dual_comp_forget_to_SemilatSup :
+  BddLat.dual ⋙ forget₂ BddLat SemilatSup =
+    forget₂ BddLat SemilatInf ⋙ SemilatInf.dual := rfl
+
+lemma BddLat_dual_comp_forget_to_SemilatInf :
+  BddLat.dual ⋙ forget₂ BddLat SemilatInf =
+    forget₂ BddLat SemilatSup ⋙ SemilatSup.dual := rfl
+
+/--  The functor that adds a bottom and a top element to a lattice. This is the free functor. -/
+def Lat_to_BddLat : Lat.{u} ⥤ BddLat :=
+{ obj := λ X, BddLat.of $ with_top $ with_bot X,
+  map := λ X Y, lattice_hom.with_top_with_bot,
+  map_id' := λ X, lattice_hom.with_top_with_bot_id,
+  map_comp' := λ X Y Z _ _, lattice_hom.with_top_with_bot_comp _ _ }
+
+/-- `Lat_to_BddLat` is left adjoint to the forgetful functor, meaning it is the free
+functor from `Lat` to `BddLat`. -/
+def Lat_to_BddLat_forget_adjunction :
+  Lat_to_BddLat.{u} ⊣ forget₂ BddLat Lat :=
+adjunction.mk_of_hom_equiv
+  { hom_equiv := λ X Y,
+    { to_fun := λ f,
+      { to_fun := f ∘ some ∘ some,
+        map_sup' := λ a b, (congr_arg f $ by refl).trans (f.map_sup' _ _),
+        map_inf' := λ a b, (congr_arg f $ by refl).trans (f.map_inf' _ _) },
+      inv_fun := lattice_hom.with_top_with_bot',
+      left_inv := λ f, bounded_lattice_hom.ext $ λ a, match a with
+          | none := f.map_top'.symm
+          | some none := f.map_bot'.symm
+          | some (some a) := rfl
+        end,
+      right_inv := λ f, lattice_hom.ext $ λ a, rfl },
+  hom_equiv_naturality_left_symm' := λ X Y Z f g, bounded_lattice_hom.ext $ λ a, match a with
+          | none := rfl
+          | some none := rfl
+          | some (some a) := rfl
+        end,
+  hom_equiv_naturality_right' := λ X Y Z f g, lattice_hom.ext $ λ a, rfl }
+
+/-- `Lat_to_BddLat` and `order_dual` commute. -/
+@[simps] def Lat_to_BddLat_comp_dual_iso_dual_comp_Lat_to_BddLat :
+ (Lat_to_BddLat.{u} ⋙ BddLat.dual) ≅ (Lat.dual ⋙ Lat_to_BddLat) :=
+adjunction.left_adjoint_uniq
+    (Lat_to_BddLat_forget_adjunction.comp BddLat.dual_equiv.to_adjunction)
+    (Lat.dual_equiv.to_adjunction.comp Lat_to_BddLat_forget_adjunction)
diff --git a/src/order/category/BddOrd.lean b/src/order/category/BddOrd.lean
new file mode 100644
index 0000000000000..b76686272a796
--- /dev/null
+++ b/src/order/category/BddOrd.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import category_theory.category.Bipointed
+import order.category.PartOrd
+import order.hom.bounded
+
+/-!
+# The category of bounded orders
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `BddOrd`, the category of bounded orders.
+-/
+
+universes u v
+
+open category_theory
+
+/-- The category of bounded orders with monotone functions. -/
+structure BddOrd :=
+(to_PartOrd : PartOrd)
+[is_bounded_order : bounded_order to_PartOrd]
+
+namespace BddOrd
+
+instance : has_coe_to_sort BddOrd Type* := induced_category.has_coe_to_sort to_PartOrd
+instance (X : BddOrd) : partial_order X := X.to_PartOrd.str
+
+attribute [instance]  BddOrd.is_bounded_order
+
+/-- Construct a bundled `BddOrd` from a `fintype` `partial_order`. -/
+def of (α : Type*) [partial_order α] [bounded_order α] : BddOrd := ⟨⟨α⟩⟩
+
+@[simp] lemma coe_of (α : Type*) [partial_order α] [bounded_order α] : ↥(of α) = α := rfl
+
+instance : inhabited BddOrd := ⟨of punit⟩
+
+instance large_category : large_category.{u} BddOrd :=
+{ hom := λ X Y, bounded_order_hom X Y,
+  id := λ X, bounded_order_hom.id X,
+  comp := λ X Y Z f g, g.comp f,
+  id_comp' := λ X Y, bounded_order_hom.comp_id,
+  comp_id' := λ X Y, bounded_order_hom.id_comp,
+  assoc' := λ W X Y Z _ _ _, bounded_order_hom.comp_assoc _ _ _ }
+
+instance concrete_category : concrete_category BddOrd :=
+{ forget := ⟨coe_sort, λ X Y, coe_fn, λ X, rfl, λ X Y Z f g, rfl⟩,
+  forget_faithful := ⟨λ X Y, by convert fun_like.coe_injective⟩ }
+
+instance has_forget_to_PartOrd : has_forget₂ BddOrd PartOrd :=
+{ forget₂ := { obj := λ X, X.to_PartOrd, map := λ X Y, bounded_order_hom.to_order_hom } }
+
+instance has_forget_to_Bipointed : has_forget₂ BddOrd Bipointed :=
+{ forget₂ := { obj := λ X, ⟨X, ⊥, ⊤⟩, map := λ X Y f, ⟨f, map_bot f, map_top f⟩ },
+  forget_comp := rfl }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : BddOrd ⥤ BddOrd :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_order_hom.dual }
+
+/-- Constructs an equivalence between bounded orders from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : BddOrd.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- The equivalence between `BddOrd` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : BddOrd ≌ BddOrd :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end BddOrd
+
+lemma BddOrd_dual_comp_forget_to_PartOrd :
+  BddOrd.dual ⋙ forget₂ BddOrd PartOrd =
+    forget₂ BddOrd PartOrd ⋙ PartOrd.dual := rfl
+
+lemma BddOrd_dual_comp_forget_to_Bipointed :
+  BddOrd.dual ⋙ forget₂ BddOrd Bipointed =
+    forget₂ BddOrd Bipointed ⋙ Bipointed.swap := rfl
diff --git a/src/order/category/BoolAlg.lean b/src/order/category/BoolAlg.lean
index 7301e685995a9..a84443001449e 100644
--- a/src/order/category/BoolAlg.lean
+++ b/src/order/category/BoolAlg.lean
@@ -3,11 +3,14 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import order.category.BoundedDistribLattice
+import order.category.HeytAlg
 
 /-!
 # The category of boolean algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This defines `BoolAlg`, the category of boolean algebras.
 -/
 
@@ -32,19 +35,27 @@ def of (α : Type*) [boolean_algebra α] : BoolAlg := bundled.of α
 
 instance : inhabited BoolAlg := ⟨of punit⟩
 
-/-- Turn a `BoolAlg` into a `BoundedDistribLattice` by forgetting its complement operation. -/
-def to_BoundedDistribLattice (X : BoolAlg) : BoundedDistribLattice := BoundedDistribLattice.of X
+/-- Turn a `BoolAlg` into a `BddDistLat` by forgetting its complement operation. -/
+def to_BddDistLat (X : BoolAlg) : BddDistLat := BddDistLat.of X
+
+@[simp] lemma coe_to_BddDistLat (X : BoolAlg) : ↥X.to_BddDistLat = ↥X := rfl
+
+instance : large_category.{u} BoolAlg := induced_category.category to_BddDistLat
+instance : concrete_category BoolAlg := induced_category.concrete_category to_BddDistLat
+
+instance has_forget_to_BddDistLat : has_forget₂ BoolAlg BddDistLat :=
+induced_category.has_forget₂ to_BddDistLat
+
+section
 
-@[simp] lemma coe_to_BoundedDistribLattice (X : BoolAlg) : ↥X.to_BoundedDistribLattice = ↥X := rfl
+local attribute [instance] bounded_lattice_hom_class.to_biheyting_hom_class
 
-instance : large_category.{u} BoolAlg := induced_category.category to_BoundedDistribLattice
-instance : concrete_category BoolAlg := induced_category.concrete_category to_BoundedDistribLattice
+@[simps] instance has_forget_to_HeytAlg : has_forget₂ BoolAlg HeytAlg :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, show bounded_lattice_hom X Y, from f } }
 
-instance has_forget_to_BoundedDistribLattice : has_forget₂ BoolAlg BoundedDistribLattice :=
-induced_category.has_forget₂ to_BoundedDistribLattice
+end
 
-/-- Constructs an equivalence between boolean algebras from an order isomorphism
-between them. -/
+/-- Constructs an equivalence between Boolean algebras from an order isomorphism between them. -/
 @[simps] def iso.mk {α β : BoolAlg.{u}} (e : α ≃o β) : α ≅ β :=
 { hom := (e : bounded_lattice_hom α β),
   inv := (e.symm : bounded_lattice_hom β α),
@@ -63,6 +74,6 @@ equivalence.mk dual dual
 
 end BoolAlg
 
-lemma BoolAlg_dual_comp_forget_to_BoundedDistribLattice :
-  BoolAlg.dual ⋙ forget₂ BoolAlg BoundedDistribLattice =
-    forget₂ BoolAlg BoundedDistribLattice ⋙ BoundedDistribLattice.dual := rfl
+lemma BoolAlg_dual_comp_forget_to_BddDistLat :
+  BoolAlg.dual ⋙ forget₂ BoolAlg BddDistLat =
+    forget₂ BoolAlg BddDistLat ⋙ BddDistLat.dual := rfl
diff --git a/src/order/category/BoundedDistribLattice.lean b/src/order/category/BoundedDistribLattice.lean
deleted file mode 100644
index ecac2f1ba4af5..0000000000000
--- a/src/order/category/BoundedDistribLattice.lean
+++ /dev/null
@@ -1,83 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.BoundedLattice
-import order.category.DistribLattice
-
-/-!
-# The category of bounded distributive lattices
-
-This defines `BoundedDistribLattice`, the category of bounded distributive lattices.
-
-Note that this category is sometimes called [`DistLat`](https://ncatlab.org/nlab/show/DistLat) when
-being a lattice is understood to entail having a bottom and a top element.
--/
-
-universes u
-
-open category_theory
-
-/-- The category of bounded distributive lattices with bounded lattice morphisms. -/
-structure BoundedDistribLattice :=
-(to_DistribLattice : DistribLattice)
-[is_bounded_order : bounded_order to_DistribLattice]
-
-namespace BoundedDistribLattice
-
-instance : has_coe_to_sort BoundedDistribLattice Type* := ⟨λ X, X.to_DistribLattice⟩
-instance (X : BoundedDistribLattice) : distrib_lattice X := X.to_DistribLattice.str
-
-attribute [instance] BoundedDistribLattice.is_bounded_order
-
-/-- Construct a bundled `BoundedDistribLattice` from a `bounded_order` `distrib_lattice`. -/
-def of (α : Type*) [distrib_lattice α] [bounded_order α] : BoundedDistribLattice := ⟨⟨α⟩⟩
-
-@[simp] lemma coe_of (α : Type*) [distrib_lattice α] [bounded_order α] : ↥(of α) = α := rfl
-
-instance : inhabited BoundedDistribLattice := ⟨of punit⟩
-
-/-- Turn a `BoundedDistribLattice` into a `BoundedLattice` by forgetting it is distributive. -/
-def to_BoundedLattice (X : BoundedDistribLattice) : BoundedLattice := BoundedLattice.of X
-
-@[simp] lemma coe_to_BoundedLattice (X : BoundedDistribLattice) : ↥X.to_BoundedLattice = ↥X := rfl
-
-instance : large_category.{u} BoundedDistribLattice := induced_category.category to_BoundedLattice
-
-instance : concrete_category BoundedDistribLattice :=
-induced_category.concrete_category to_BoundedLattice
-
-instance has_forget_to_DistribLattice : has_forget₂ BoundedDistribLattice DistribLattice :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_lattice_hom } }
-
-instance has_forget_to_BoundedLattice : has_forget₂ BoundedDistribLattice BoundedLattice :=
-induced_category.has_forget₂ to_BoundedLattice
-
-lemma forget_BoundedLattice_Lattice_eq_forget_DistribLattice_Lattice :
-  forget₂ BoundedDistribLattice BoundedLattice ⋙ forget₂ BoundedLattice Lattice =
-    forget₂ BoundedDistribLattice DistribLattice ⋙ forget₂ DistribLattice Lattice := rfl
-
-/-- Constructs an equivalence between bounded distributive lattices from an order isomorphism
-between them. -/
-@[simps] def iso.mk {α β : BoundedDistribLattice.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := (e : bounded_lattice_hom α β),
-  inv := (e.symm : bounded_lattice_hom β α),
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : BoundedDistribLattice ⥤ BoundedDistribLattice :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_lattice_hom.dual }
-
-/-- The equivalence between `BoundedDistribLattice` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : BoundedDistribLattice ≌ BoundedDistribLattice :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end BoundedDistribLattice
-
-lemma BoundedDistribLattice_dual_comp_forget_to_DistribLattice :
-  BoundedDistribLattice.dual ⋙ forget₂ BoundedDistribLattice DistribLattice =
-    forget₂ BoundedDistribLattice DistribLattice ⋙ DistribLattice.dual := rfl
diff --git a/src/order/category/BoundedLattice.lean b/src/order/category/BoundedLattice.lean
deleted file mode 100644
index 0201a28d1a191..0000000000000
--- a/src/order/category/BoundedLattice.lean
+++ /dev/null
@@ -1,125 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.BoundedOrder
-import order.category.Lattice
-import order.category.Semilattice
-
-/-!
-# The category of bounded lattices
-
-This file defines `BoundedLattice`, the category of bounded lattices.
-
-In literature, this is sometimes called `Lat`, the category of lattices, because being a lattice is
-understood to entail having a bottom and a top element.
--/
-
-universes u
-
-open category_theory
-
-/-- The category of bounded lattices with bounded lattice morphisms. -/
-structure BoundedLattice :=
-(to_Lattice : Lattice)
-[is_bounded_order : bounded_order to_Lattice]
-
-namespace BoundedLattice
-
-instance : has_coe_to_sort BoundedLattice Type* := ⟨λ X, X.to_Lattice⟩
-instance (X : BoundedLattice) : lattice X := X.to_Lattice.str
-
-attribute [instance] BoundedLattice.is_bounded_order
-
-/-- Construct a bundled `BoundedLattice` from `lattice` + `bounded_order`. -/
-def of (α : Type*) [lattice α] [bounded_order α] : BoundedLattice := ⟨⟨α⟩⟩
-
-@[simp] lemma coe_of (α : Type*) [lattice α] [bounded_order α] : ↥(of α) = α := rfl
-
-instance : inhabited BoundedLattice := ⟨of punit⟩
-
-instance : large_category.{u} BoundedLattice :=
-{ hom := λ X Y, bounded_lattice_hom X Y,
-  id := λ X, bounded_lattice_hom.id X,
-  comp := λ X Y Z f g, g.comp f,
-  id_comp' := λ X Y, bounded_lattice_hom.comp_id,
-  comp_id' := λ X Y, bounded_lattice_hom.id_comp,
-  assoc' := λ W X Y Z _ _ _, bounded_lattice_hom.comp_assoc _ _ _ }
-
-instance : concrete_category BoundedLattice :=
-{ forget := ⟨coe_sort, λ X Y, coe_fn, λ X, rfl, λ X Y Z f g, rfl⟩,
-  forget_faithful := ⟨λ X Y, by convert fun_like.coe_injective⟩ }
-
-instance has_forget_to_BoundedOrder : has_forget₂ BoundedLattice BoundedOrder :=
-{ forget₂ := { obj := λ X, BoundedOrder.of X,
-               map := λ X Y, bounded_lattice_hom.to_bounded_order_hom } }
-
-instance has_forget_to_Lattice : has_forget₂ BoundedLattice Lattice :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_lattice_hom } }
-
-instance has_forget_to_SemilatticeSup : has_forget₂ BoundedLattice SemilatticeSup :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_sup_bot_hom } }
-
-instance has_forget_to_SemilatticeInf : has_forget₂ BoundedLattice SemilatticeInf :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, bounded_lattice_hom.to_inf_top_hom } }
-
-@[simp] lemma coe_forget_to_BoundedOrder (X : BoundedLattice) :
-  ↥((forget₂ BoundedLattice BoundedOrder).obj X) = ↥X := rfl
-
-@[simp] lemma coe_forget_to_Lattice (X : BoundedLattice) :
-  ↥((forget₂ BoundedLattice Lattice).obj X) = ↥X := rfl
-
-@[simp] lemma coe_forget_to_SemilatticeSup (X : BoundedLattice) :
-  ↥((forget₂ BoundedLattice SemilatticeSup).obj X) = ↥X := rfl
-
-@[simp] lemma coe_forget_to_SemilatticeInf (X : BoundedLattice) :
-  ↥((forget₂ BoundedLattice SemilatticeInf).obj X) = ↥X := rfl
-
-lemma forget_Lattice_PartialOrder_eq_forget_BoundedOrder_PartialOrder :
-  forget₂ BoundedLattice Lattice ⋙ forget₂ Lattice PartialOrder =
-    forget₂ BoundedLattice BoundedOrder ⋙ forget₂ BoundedOrder PartialOrder := rfl
-
-lemma forget_SemilatticeSup_PartialOrder_eq_forget_BoundedOrder_PartialOrder :
-  forget₂ BoundedLattice SemilatticeSup ⋙ forget₂ SemilatticeSup PartialOrder =
-    forget₂ BoundedLattice BoundedOrder ⋙ forget₂ BoundedOrder PartialOrder := rfl
-
-lemma forget_SemilatticeInf_PartialOrder_eq_forget_BoundedOrder_PartialOrder :
-  forget₂ BoundedLattice SemilatticeInf ⋙ forget₂ SemilatticeInf PartialOrder =
-    forget₂ BoundedLattice BoundedOrder ⋙ forget₂ BoundedOrder PartialOrder := rfl
-
-/-- Constructs an equivalence between bounded lattices from an order isomorphism
-between them. -/
-@[simps] def iso.mk {α β : BoundedLattice.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : BoundedLattice ⥤ BoundedLattice :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_lattice_hom.dual }
-
-/-- The equivalence between `BoundedLattice` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : BoundedLattice ≌ BoundedLattice :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end BoundedLattice
-
-lemma BoundedLattice_dual_comp_forget_to_BoundedOrder :
-  BoundedLattice.dual ⋙ forget₂ BoundedLattice BoundedOrder =
-    forget₂ BoundedLattice BoundedOrder ⋙ BoundedOrder.dual := rfl
-
-lemma BoundedLattice_dual_comp_forget_to_Lattice :
-  BoundedLattice.dual ⋙ forget₂ BoundedLattice Lattice =
-    forget₂ BoundedLattice Lattice ⋙ Lattice.dual := rfl
-
-lemma BoundedLattice_dual_comp_forget_to_SemilatticeSup :
-  BoundedLattice.dual ⋙ forget₂ BoundedLattice SemilatticeSup =
-    forget₂ BoundedLattice SemilatticeInf ⋙ SemilatticeInf.dual := rfl
-
-lemma BoundedLattice_dual_comp_forget_to_SemilatticeInf :
-  BoundedLattice.dual ⋙ forget₂ BoundedLattice SemilatticeInf =
-    forget₂ BoundedLattice SemilatticeSup ⋙ SemilatticeSup.dual := rfl
diff --git a/src/order/category/BoundedOrder.lean b/src/order/category/BoundedOrder.lean
deleted file mode 100644
index 8c359e2282b31..0000000000000
--- a/src/order/category/BoundedOrder.lean
+++ /dev/null
@@ -1,83 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import category_theory.category.Bipointed
-import order.category.PartialOrder
-import order.hom.bounded
-
-/-!
-# The category of bounded orders
-
-This defines `BoundedOrder`, the category of bounded orders.
--/
-
-universes u v
-
-open category_theory
-
-/-- The category of bounded orders with monotone functions. -/
-structure BoundedOrder :=
-(to_PartialOrder : PartialOrder)
-[is_bounded_order : bounded_order to_PartialOrder]
-
-namespace BoundedOrder
-
-instance : has_coe_to_sort BoundedOrder Type* := induced_category.has_coe_to_sort to_PartialOrder
-instance (X : BoundedOrder) : partial_order X := X.to_PartialOrder.str
-
-attribute [instance]  BoundedOrder.is_bounded_order
-
-/-- Construct a bundled `BoundedOrder` from a `fintype` `partial_order`. -/
-def of (α : Type*) [partial_order α] [bounded_order α] : BoundedOrder := ⟨⟨α⟩⟩
-
-@[simp] lemma coe_of (α : Type*) [partial_order α] [bounded_order α] : ↥(of α) = α := rfl
-
-instance : inhabited BoundedOrder := ⟨of punit⟩
-
-instance large_category : large_category.{u} BoundedOrder :=
-{ hom := λ X Y, bounded_order_hom X Y,
-  id := λ X, bounded_order_hom.id X,
-  comp := λ X Y Z f g, g.comp f,
-  id_comp' := λ X Y, bounded_order_hom.comp_id,
-  comp_id' := λ X Y, bounded_order_hom.id_comp,
-  assoc' := λ W X Y Z _ _ _, bounded_order_hom.comp_assoc _ _ _ }
-
-instance concrete_category : concrete_category BoundedOrder :=
-{ forget := ⟨coe_sort, λ X Y, coe_fn, λ X, rfl, λ X Y Z f g, rfl⟩,
-  forget_faithful := ⟨λ X Y, by convert fun_like.coe_injective⟩ }
-
-instance has_forget_to_PartialOrder : has_forget₂ BoundedOrder PartialOrder :=
-{ forget₂ := { obj := λ X, X.to_PartialOrder, map := λ X Y, bounded_order_hom.to_order_hom } }
-
-instance has_forget_to_Bipointed : has_forget₂ BoundedOrder Bipointed :=
-{ forget₂ := { obj := λ X, ⟨X, ⊥, ⊤⟩, map := λ X Y f, ⟨f, map_bot f, map_top f⟩ },
-  forget_comp := rfl }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : BoundedOrder ⥤ BoundedOrder :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_order_hom.dual }
-
-/-- Constructs an equivalence between bounded orders from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : BoundedOrder.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- The equivalence between `BoundedOrder` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : BoundedOrder ≌ BoundedOrder :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end BoundedOrder
-
-lemma BoundedOrder_dual_comp_forget_to_PartialOrder :
-  BoundedOrder.dual ⋙ forget₂ BoundedOrder PartialOrder =
-    forget₂ BoundedOrder PartialOrder ⋙ PartialOrder.dual := rfl
-
-lemma BoundedOrder_dual_comp_forget_to_Bipointed :
-  BoundedOrder.dual ⋙ forget₂ BoundedOrder Bipointed =
-    forget₂ BoundedOrder Bipointed ⋙ Bipointed.swap := rfl
diff --git a/src/order/category/CompleteLat.lean b/src/order/category/CompleteLat.lean
new file mode 100644
index 0000000000000..1ff48a15c8536
--- /dev/null
+++ b/src/order/category/CompleteLat.lean
@@ -0,0 +1,71 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.BddLat
+import order.hom.complete_lattice
+
+/-!
+# The category of complete lattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `CompleteLat`, the category of complete lattices.
+-/
+
+universes u
+
+open category_theory
+
+/-- The category of complete lattices. -/
+def CompleteLat := bundled complete_lattice
+
+namespace CompleteLat
+
+instance : has_coe_to_sort CompleteLat Type* := bundled.has_coe_to_sort
+instance (X : CompleteLat) : complete_lattice X := X.str
+
+/-- Construct a bundled `CompleteLat` from a `complete_lattice`. -/
+def of (α : Type*) [complete_lattice α] : CompleteLat := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [complete_lattice α] : ↥(of α) = α := rfl
+
+instance : inhabited CompleteLat := ⟨of punit⟩
+
+instance : bundled_hom @complete_lattice_hom :=
+{ to_fun := λ _ _ _ _, coe_fn,
+  id := @complete_lattice_hom.id,
+  comp := @complete_lattice_hom.comp,
+  hom_ext := λ X Y _ _, by exactI fun_like.coe_injective }
+instance : large_category.{u} CompleteLat := bundled_hom.category complete_lattice_hom
+instance : concrete_category CompleteLat := bundled_hom.concrete_category complete_lattice_hom
+
+instance has_forget_to_BddLat : has_forget₂ CompleteLat BddLat :=
+{ forget₂ := { obj := λ X, BddLat.of X,
+               map := λ X Y, complete_lattice_hom.to_bounded_lattice_hom },
+  forget_comp := rfl }
+
+/-- Constructs an isomorphism of complete lattices from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : CompleteLat.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : CompleteLat ⥤ CompleteLat :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, complete_lattice_hom.dual }
+
+/-- The equivalence between `CompleteLat` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : CompleteLat ≌ CompleteLat :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end CompleteLat
+
+lemma CompleteLat_dual_comp_forget_to_BddLat :
+  CompleteLat.dual ⋙ forget₂ CompleteLat BddLat =
+    forget₂ CompleteLat BddLat ⋙ BddLat.dual := rfl
diff --git a/src/order/category/CompleteLattice.lean b/src/order/category/CompleteLattice.lean
deleted file mode 100644
index 03ce1f1839b3a..0000000000000
--- a/src/order/category/CompleteLattice.lean
+++ /dev/null
@@ -1,68 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.BoundedLattice
-import order.hom.complete_lattice
-
-/-!
-# The category of complete lattices
-
-This file defines `CompleteLattice`, the category of complete lattices.
--/
-
-universes u
-
-open category_theory
-
-/-- The category of complete lattices. -/
-def CompleteLattice := bundled complete_lattice
-
-namespace CompleteLattice
-
-instance : has_coe_to_sort CompleteLattice Type* := bundled.has_coe_to_sort
-instance (X : CompleteLattice) : complete_lattice X := X.str
-
-/-- Construct a bundled `CompleteLattice` from a `complete_lattice`. -/
-def of (α : Type*) [complete_lattice α] : CompleteLattice := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [complete_lattice α] : ↥(of α) = α := rfl
-
-instance : inhabited CompleteLattice := ⟨of punit⟩
-
-instance : bundled_hom @complete_lattice_hom :=
-{ to_fun := λ _ _ _ _, coe_fn,
-  id := @complete_lattice_hom.id,
-  comp := @complete_lattice_hom.comp,
-  hom_ext := λ X Y _ _, by exactI fun_like.coe_injective }
-instance : large_category.{u} CompleteLattice := bundled_hom.category complete_lattice_hom
-instance : concrete_category CompleteLattice := bundled_hom.concrete_category complete_lattice_hom
-
-instance has_forget_to_BoundedLattice : has_forget₂ CompleteLattice BoundedLattice :=
-{ forget₂ := { obj := λ X, BoundedLattice.of X,
-               map := λ X Y, complete_lattice_hom.to_bounded_lattice_hom },
-  forget_comp := rfl }
-
-/-- Constructs an isomorphism of complete lattices from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : CompleteLattice.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : CompleteLattice ⥤ CompleteLattice :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, complete_lattice_hom.dual }
-
-/-- The equivalence between `CompleteLattice` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : CompleteLattice ≌ CompleteLattice :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end CompleteLattice
-
-lemma CompleteLattice_dual_comp_forget_to_BoundedLattice :
-  CompleteLattice.dual ⋙ forget₂ CompleteLattice BoundedLattice =
-    forget₂ CompleteLattice BoundedLattice ⋙ BoundedLattice.dual := rfl
diff --git a/src/order/category/DistLat.lean b/src/order/category/DistLat.lean
new file mode 100644
index 0000000000000..c4633bbbe1434
--- /dev/null
+++ b/src/order/category/DistLat.lean
@@ -0,0 +1,68 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.Lat
+
+/-!
+# The category of distributive lattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `DistLat`, the category of distributive lattices.
+
+Note that [`DistLat`](https://ncatlab.org/nlab/show/DistLat) in the literature doesn't always
+correspond to `DistLat` as we don't require bottom or top elements. Instead, this `DistLat`
+corresponds to `BddDistLat`.
+-/
+
+universes u
+
+open category_theory
+
+/-- The category of distributive lattices. -/
+def DistLat := bundled distrib_lattice
+
+namespace DistLat
+
+instance : has_coe_to_sort DistLat Type* := bundled.has_coe_to_sort
+instance (X : DistLat) : distrib_lattice X := X.str
+
+/-- Construct a bundled `DistLat` from a `distrib_lattice` underlying type and typeclass. -/
+def of (α : Type*) [distrib_lattice α] : DistLat := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [distrib_lattice α] : ↥(of α) = α := rfl
+
+instance : inhabited DistLat := ⟨of punit⟩
+
+instance : bundled_hom.parent_projection @distrib_lattice.to_lattice := ⟨⟩
+
+attribute [derive [large_category, concrete_category]] DistLat
+
+instance has_forget_to_Lat : has_forget₂ DistLat Lat := bundled_hom.forget₂ _ _
+
+/-- Constructs an equivalence between distributive lattices from an order isomorphism between them.
+-/
+@[simps] def iso.mk {α β : DistLat.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : DistLat ⥤ DistLat :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, lattice_hom.dual }
+
+/-- The equivalence between `DistLat` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : DistLat ≌ DistLat :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end DistLat
+
+lemma DistLat_dual_comp_forget_to_Lat :
+  DistLat.dual ⋙ forget₂ DistLat Lat =
+    forget₂ DistLat Lat ⋙ Lat.dual := rfl
diff --git a/src/order/category/DistribLattice.lean b/src/order/category/DistribLattice.lean
deleted file mode 100644
index 7b7220477b2b9..0000000000000
--- a/src/order/category/DistribLattice.lean
+++ /dev/null
@@ -1,65 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.Lattice
-
-/-!
-# The category of distributive lattices
-
-This file defines `DistribLattice`, the category of distributive lattices.
-
-Note that [`DistLat`](https://ncatlab.org/nlab/show/DistLat) in the literature doesn't always
-correspond to `DistribLattice` as we don't require bottom or top elements. Instead, this `DistLat`
-corresponds to `BoundedDistribLattice`.
--/
-
-universes u
-
-open category_theory
-
-/-- The category of distributive lattices. -/
-def DistribLattice := bundled distrib_lattice
-
-namespace DistribLattice
-
-instance : has_coe_to_sort DistribLattice Type* := bundled.has_coe_to_sort
-instance (X : DistribLattice) : distrib_lattice X := X.str
-
-/-- Construct a bundled `DistribLattice` from a `distrib_lattice` underlying type and typeclass. -/
-def of (α : Type*) [distrib_lattice α] : DistribLattice := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [distrib_lattice α] : ↥(of α) = α := rfl
-
-instance : inhabited DistribLattice := ⟨of punit⟩
-
-instance : bundled_hom.parent_projection @distrib_lattice.to_lattice := ⟨⟩
-
-attribute [derive [large_category, concrete_category]] DistribLattice
-
-instance has_forget_to_Lattice : has_forget₂ DistribLattice Lattice := bundled_hom.forget₂ _ _
-
-/-- Constructs an equivalence between distributive lattices from an order isomorphism between them.
--/
-@[simps] def iso.mk {α β : DistribLattice.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : DistribLattice ⥤ DistribLattice :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, lattice_hom.dual }
-
-/-- The equivalence between `DistribLattice` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : DistribLattice ≌ DistribLattice :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end DistribLattice
-
-lemma DistribLattice_dual_comp_forget_to_Lattice :
-  DistribLattice.dual ⋙ forget₂ DistribLattice Lattice =
-    forget₂ DistribLattice Lattice ⋙ Lattice.dual := rfl
diff --git a/src/order/category/FinBddDistLat.lean b/src/order/category/FinBddDistLat.lean
new file mode 100644
index 0000000000000..02344d9e5de74
--- /dev/null
+++ b/src/order/category/FinBddDistLat.lean
@@ -0,0 +1,86 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import data.fintype.order
+import order.category.BddDistLat
+import order.category.FinPartOrd
+
+/-!
+# The category of finite bounded distributive lattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `FinBddDistLat`, the category of finite distributive lattices with
+bounded lattice homomorphisms.
+-/
+
+universes u
+
+open category_theory
+
+/-- The category of finite distributive lattices with bounded lattice morphisms. -/
+structure FinBddDistLat :=
+(to_BddDistLat : BddDistLat)
+[is_fintype : fintype to_BddDistLat]
+
+namespace FinBddDistLat
+
+instance : has_coe_to_sort FinBddDistLat Type* := ⟨λ X, X.to_BddDistLat⟩
+instance (X : FinBddDistLat) : distrib_lattice X :=
+X.to_BddDistLat.to_DistLat.str
+instance (X : FinBddDistLat) : bounded_order X := X.to_BddDistLat.is_bounded_order
+
+attribute [instance]  FinBddDistLat.is_fintype
+
+/-- Construct a bundled `FinBddDistLat` from a `nonempty` `bounded_order` `distrib_lattice`. -/
+def of (α : Type*) [distrib_lattice α] [bounded_order α] [fintype α] : FinBddDistLat :=
+⟨⟨⟨α⟩⟩⟩
+
+/-- Construct a bundled `FinBddDistLat` from a `nonempty` `bounded_order` `distrib_lattice`. -/
+def of' (α : Type*) [distrib_lattice α] [fintype α] [nonempty α] : FinBddDistLat :=
+by { haveI := fintype.to_bounded_order α, exact ⟨⟨⟨α⟩⟩⟩ }
+
+instance : inhabited FinBddDistLat := ⟨of punit⟩
+
+instance large_category : large_category FinBddDistLat :=
+induced_category.category to_BddDistLat
+
+instance concrete_category : concrete_category FinBddDistLat :=
+induced_category.concrete_category to_BddDistLat
+
+instance has_forget_to_BddDistLat :
+  has_forget₂ FinBddDistLat BddDistLat :=
+induced_category.has_forget₂ FinBddDistLat.to_BddDistLat
+
+instance has_forget_to_FinPartOrd : has_forget₂ FinBddDistLat FinPartOrd :=
+{ forget₂ := { obj := λ X, FinPartOrd.of X,
+               map := λ X Y f, (show bounded_lattice_hom X Y, from f : X →o Y) } }
+
+/-- Constructs an equivalence between finite distributive lattices from an order isomorphism
+between them. -/
+@[simps] def iso.mk {α β : FinBddDistLat.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := (e : bounded_lattice_hom α β),
+  inv := (e.symm : bounded_lattice_hom β α),
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+example {X Y : FinBddDistLat} : (X ⟶ Y) = bounded_lattice_hom X Y := rfl
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : FinBddDistLat ⥤ FinBddDistLat :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, bounded_lattice_hom.dual }
+
+/-- The equivalence between `FinBddDistLat` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : FinBddDistLat ≌ FinBddDistLat :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end FinBddDistLat
+
+lemma FinBddDistLat_dual_comp_forget_to_BddDistLat :
+  FinBddDistLat.dual ⋙ forget₂ FinBddDistLat BddDistLat =
+    forget₂ FinBddDistLat BddDistLat ⋙ BddDistLat.dual := rfl
diff --git a/src/order/category/FinBoolAlg.lean b/src/order/category/FinBoolAlg.lean
index a6a1960a6ed5d..ad889807c39f8 100644
--- a/src/order/category/FinBoolAlg.lean
+++ b/src/order/category/FinBoolAlg.lean
@@ -3,13 +3,17 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
+import data.fintype.powerset
 import order.category.BoolAlg
-import order.category.FinPartialOrder
+import order.category.FinBddDistLat
 import order.hom.complete_lattice
 
 /-!
 # The category of finite boolean algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `FinBoolAlg`, the category of finite boolean algebras.
 
 ## TODO
@@ -55,15 +59,19 @@ induced_category.concrete_category FinBoolAlg.to_BoolAlg
 instance has_forget_to_BoolAlg : has_forget₂ FinBoolAlg BoolAlg :=
 induced_category.has_forget₂ FinBoolAlg.to_BoolAlg
 
+instance has_forget_to_FinBddDistLat : has_forget₂ FinBoolAlg FinBddDistLat :=
+{ forget₂ := { obj := λ X, FinBddDistLat.of X, map := λ X Y f, f },
+  forget_comp := rfl }
+
 instance forget_to_BoolAlg_full : full (forget₂ FinBoolAlg BoolAlg) := induced_category.full _
 instance forget_to_BoolAlg_faithful : faithful (forget₂ FinBoolAlg BoolAlg) :=
 induced_category.faithful _
 
-@[simps] instance has_forget_to_FinPartialOrder : has_forget₂ FinBoolAlg FinPartialOrder :=
-{ forget₂ := { obj := λ X, FinPartialOrder.of X, map := λ X Y f,
+@[simps] instance has_forget_to_FinPartOrd : has_forget₂ FinBoolAlg FinPartOrd :=
+{ forget₂ := { obj := λ X, FinPartOrd.of X, map := λ X Y f,
     show order_hom X Y, from ↑(show bounded_lattice_hom X Y, from f) } }
 
-instance forget_to_FinPartialOrder_faithful : faithful (forget₂ FinBoolAlg FinPartialOrder) :=
+instance forget_to_FinPartOrd_faithful : faithful (forget₂ FinBoolAlg FinPartOrd) :=
 ⟨λ X Y f g h, by { have := congr_arg (coe_fn : _ → X → Y) h, exact fun_like.coe_injective this }⟩
 
 /-- Constructs an equivalence between finite Boolean algebras from an order isomorphism between
@@ -86,6 +94,10 @@ equivalence.mk dual dual
 
 end FinBoolAlg
 
+lemma FinBoolAlg_dual_comp_forget_to_FinBddDistLat :
+  FinBoolAlg.dual ⋙ forget₂ FinBoolAlg FinBddDistLat =
+    forget₂ FinBoolAlg FinBddDistLat ⋙ FinBddDistLat.dual := rfl
+
 /-- The powerset functor. `set` as a functor. -/
 @[simps] def Fintype_to_FinBoolAlg_op : Fintype ⥤ FinBoolAlgᵒᵖ :=
 { obj := λ X, op $ FinBoolAlg.of (set X),
diff --git a/src/order/category/FinPartOrd.lean b/src/order/category/FinPartOrd.lean
new file mode 100644
index 0000000000000..228a947fccd7a
--- /dev/null
+++ b/src/order/category/FinPartOrd.lean
@@ -0,0 +1,82 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import category_theory.Fintype
+import order.category.PartOrd
+
+/-!
+# The category of finite partial orders
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `FinPartOrd`, the category of finite partial orders.
+
+Note: `FinPartOrd` is *not* a subcategory of `BddOrd` because finite orders are not necessarily
+bounded.
+
+## TODO
+
+`FinPartOrd` is equivalent to a small category.
+-/
+
+universes u v
+
+open category_theory
+
+/-- The category of finite partial orders with monotone functions. -/
+structure FinPartOrd :=
+(to_PartOrd : PartOrd)
+[is_fintype : fintype to_PartOrd]
+
+namespace FinPartOrd
+
+instance : has_coe_to_sort FinPartOrd Type* := ⟨λ X, X.to_PartOrd⟩
+instance (X : FinPartOrd) : partial_order X := X.to_PartOrd.str
+attribute [instance]  FinPartOrd.is_fintype
+
+@[simp] lemma coe_to_PartOrd (X : FinPartOrd) : ↥X.to_PartOrd = ↥X := rfl
+
+/-- Construct a bundled `FinPartOrd` from `fintype` + `partial_order`. -/
+def of (α : Type*) [partial_order α] [fintype α] : FinPartOrd := ⟨⟨α⟩⟩
+
+@[simp] lemma coe_of (α : Type*) [partial_order α] [fintype α] : ↥(of α) = α := rfl
+
+instance : inhabited FinPartOrd := ⟨of punit⟩
+
+instance large_category : large_category FinPartOrd :=
+induced_category.category FinPartOrd.to_PartOrd
+
+instance concrete_category : concrete_category FinPartOrd :=
+induced_category.concrete_category FinPartOrd.to_PartOrd
+
+instance has_forget_to_PartOrd : has_forget₂ FinPartOrd PartOrd :=
+induced_category.has_forget₂ FinPartOrd.to_PartOrd
+
+instance has_forget_to_Fintype : has_forget₂ FinPartOrd Fintype :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, coe_fn } }
+
+/-- Constructs an isomorphism of finite partial orders from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : FinPartOrd.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : FinPartOrd ⥤ FinPartOrd :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
+
+/-- The equivalence between `FinPartOrd` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : FinPartOrd ≌ FinPartOrd :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end FinPartOrd
+
+lemma FinPartOrd_dual_comp_forget_to_PartOrd :
+  FinPartOrd.dual ⋙ forget₂ FinPartOrd PartOrd =
+    forget₂ FinPartOrd PartOrd ⋙ PartOrd.dual := rfl
diff --git a/src/order/category/FinPartialOrder.lean b/src/order/category/FinPartialOrder.lean
deleted file mode 100644
index 78b7eae8b2fd9..0000000000000
--- a/src/order/category/FinPartialOrder.lean
+++ /dev/null
@@ -1,79 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import category_theory.Fintype
-import order.category.PartialOrder
-
-/-!
-# The category of finite partial orders
-
-This defines `FinPartialOrder`, the category of finite partial orders.
-
-Note: `FinPartialOrder` is NOT a subcategory of `BoundedOrder` because its morphisms do not
-preserve `⊥` and `⊤`.
-
-## TODO
-
-`FinPartialOrder` is equivalent to a small category.
--/
-
-universes u v
-
-open category_theory
-
-/-- The category of finite partial orders with monotone functions. -/
-structure FinPartialOrder :=
-(to_PartialOrder : PartialOrder)
-[is_fintype : fintype to_PartialOrder]
-
-namespace FinPartialOrder
-
-instance : has_coe_to_sort FinPartialOrder Type* := ⟨λ X, X.to_PartialOrder⟩
-instance (X : FinPartialOrder) : partial_order X := X.to_PartialOrder.str
-attribute [instance]  FinPartialOrder.is_fintype
-
-@[simp] lemma coe_to_PartialOrder (X : FinPartialOrder) : ↥X.to_PartialOrder = ↥X := rfl
-
-/-- Construct a bundled `FinPartialOrder` from `fintype` + `partial_order`. -/
-def of (α : Type*) [partial_order α] [fintype α] : FinPartialOrder := ⟨⟨α⟩⟩
-
-@[simp] lemma coe_of (α : Type*) [partial_order α] [fintype α] : ↥(of α) = α := rfl
-
-instance : inhabited FinPartialOrder := ⟨of punit⟩
-
-instance large_category : large_category FinPartialOrder :=
-induced_category.category FinPartialOrder.to_PartialOrder
-
-instance concrete_category : concrete_category FinPartialOrder :=
-induced_category.concrete_category FinPartialOrder.to_PartialOrder
-
-instance has_forget_to_PartialOrder : has_forget₂ FinPartialOrder PartialOrder :=
-induced_category.has_forget₂ FinPartialOrder.to_PartialOrder
-
-instance has_forget_to_Fintype : has_forget₂ FinPartialOrder Fintype :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, coe_fn } }
-
-/-- Constructs an isomorphism of finite partial orders from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : FinPartialOrder.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : FinPartialOrder ⥤ FinPartialOrder :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
-
-/-- The equivalence between `FinPartialOrder` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : FinPartialOrder ≌ FinPartialOrder :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end FinPartialOrder
-
-lemma FinPartialOrder_dual_comp_forget_to_PartialOrder :
-  FinPartialOrder.dual ⋙ forget₂ FinPartialOrder PartialOrder =
-    forget₂ FinPartialOrder PartialOrder ⋙ PartialOrder.dual := rfl
diff --git a/src/order/category/Frame.lean b/src/order/category/Frame.lean
deleted file mode 100644
index eec23ec12ab06..0000000000000
--- a/src/order/category/Frame.lean
+++ /dev/null
@@ -1,72 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.Lattice
-import order.hom.complete_lattice
-import topology.category.CompHaus
-import topology.sets.opens
-
-/-!
-# The category of frames
-
-This file defines `Frame`, the category of frames.
-
-## References
-
-* [nLab, *Frm*](https://ncatlab.org/nlab/show/Frm)
--/
-
-universes u
-
-open category_theory opposite order topological_space
-
-/-- The category of frames. -/
-def Frame := bundled frame
-
-namespace Frame
-
-instance : has_coe_to_sort Frame Type* := bundled.has_coe_to_sort
-instance (X : Frame) : frame X := X.str
-
-/-- Construct a bundled `Frame` from a `frame`. -/
-def of (α : Type*) [frame α] : Frame := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [frame α] : ↥(of α) = α := rfl
-
-instance : inhabited Frame := ⟨of punit⟩
-
-/-- An abbreviation of `frame_hom` that assumes `frame` instead of the weaker `complete_lattice`.
-Necessary for the category theory machinery. -/
-abbreviation hom (α β : Type*) [frame α] [frame β] : Type* := frame_hom α β
-
-instance bundled_hom : bundled_hom hom :=
-⟨λ α β [frame α] [frame β], by exactI (coe_fn : frame_hom α β → α → β),
- λ α [frame α], by exactI frame_hom.id α,
- λ α β γ [frame α] [frame β] [frame γ], by exactI frame_hom.comp,
- λ α β [frame α] [frame β], by exactI fun_like.coe_injective⟩
-
-attribute [derive [large_category, concrete_category]] Frame
-
-instance has_forget_to_Lattice : has_forget₂ Frame Lattice :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, frame_hom.to_lattice_hom } }
-
-/-- Constructs an isomorphism of frames from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : Frame.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-end Frame
-
-/-- The forgetful functor from `Topᵒᵖ` to `Frame`. -/
-@[simps] def Top_op_to_Frame : Topᵒᵖ ⥤ Frame :=
-{ obj := λ X, Frame.of (opens (unop X : Top)),
-  map := λ X Y f, opens.comap $ quiver.hom.unop f,
-  map_id' := λ X, opens.comap_id }
-
--- Note, `CompHaus` is too strong. We only need `t0_space`.
-instance CompHaus_op_to_Frame.faithful : faithful (CompHaus_to_Top.op ⋙ Top_op_to_Frame.{u}) :=
-⟨λ X Y f g h, quiver.hom.unop_inj $ opens.comap_injective h⟩
diff --git a/src/order/category/Frm.lean b/src/order/category/Frm.lean
new file mode 100644
index 0000000000000..6052f12eb8b4f
--- /dev/null
+++ b/src/order/category/Frm.lean
@@ -0,0 +1,75 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.Lat
+import order.hom.complete_lattice
+import topology.category.CompHaus.basic
+import topology.sets.opens
+
+/-!
+# The category of frames
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `Frm`, the category of frames.
+
+## References
+
+* [nLab, *Frm*](https://ncatlab.org/nlab/show/Frm)
+-/
+
+universes u
+
+open category_theory opposite order topological_space
+
+/-- The category of frames. -/
+def Frm := bundled frame
+
+namespace Frm
+
+instance : has_coe_to_sort Frm Type* := bundled.has_coe_to_sort
+instance (X : Frm) : frame X := X.str
+
+/-- Construct a bundled `Frm` from a `frame`. -/
+def of (α : Type*) [frame α] : Frm := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [frame α] : ↥(of α) = α := rfl
+
+instance : inhabited Frm := ⟨of punit⟩
+
+/-- An abbreviation of `frame_hom` that assumes `frame` instead of the weaker `complete_lattice`.
+Necessary for the category theory machinery. -/
+abbreviation hom (α β : Type*) [frame α] [frame β] : Type* := frame_hom α β
+
+instance bundled_hom : bundled_hom hom :=
+⟨λ α β [frame α] [frame β], by exactI (coe_fn : frame_hom α β → α → β),
+ λ α [frame α], by exactI frame_hom.id α,
+ λ α β γ [frame α] [frame β] [frame γ], by exactI frame_hom.comp,
+ λ α β [frame α] [frame β], by exactI fun_like.coe_injective⟩
+
+attribute [derive [large_category, concrete_category]] Frm
+
+instance has_forget_to_Lat : has_forget₂ Frm Lat :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y, frame_hom.to_lattice_hom } }
+
+/-- Constructs an isomorphism of frames from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : Frm.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+end Frm
+
+/-- The forgetful functor from `Topᵒᵖ` to `Frm`. -/
+@[simps] def Top_op_to_Frame : Topᵒᵖ ⥤ Frm :=
+{ obj := λ X, Frm.of (opens (unop X : Top)),
+  map := λ X Y f, opens.comap $ quiver.hom.unop f,
+  map_id' := λ X, opens.comap_id }
+
+-- Note, `CompHaus` is too strong. We only need `t0_space`.
+instance CompHaus_op_to_Frame.faithful : faithful (CompHaus_to_Top.op ⋙ Top_op_to_Frame.{u}) :=
+⟨λ X Y f g h, quiver.hom.unop_inj $ opens.comap_injective h⟩
diff --git a/src/order/category/HeytAlg.lean b/src/order/category/HeytAlg.lean
new file mode 100644
index 0000000000000..bc4663ab9a5ea
--- /dev/null
+++ b/src/order/category/HeytAlg.lean
@@ -0,0 +1,58 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.BddDistLat
+import order.heyting.hom
+
+/-!
+# The category of Heyting algebras
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `HeytAlg`, the category of Heyting algebras.
+-/
+
+universes u
+
+open category_theory opposite order
+
+/-- The category of Heyting algebras. -/
+def HeytAlg := bundled heyting_algebra
+
+namespace HeytAlg
+
+instance : has_coe_to_sort HeytAlg Type* := bundled.has_coe_to_sort
+instance (X : HeytAlg) : heyting_algebra X := X.str
+
+/-- Construct a bundled `HeytAlg` from a `heyting_algebra`. -/
+def of (α : Type*) [heyting_algebra α] : HeytAlg := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [heyting_algebra α] : ↥(of α) = α := rfl
+
+instance : inhabited HeytAlg := ⟨of punit⟩
+
+instance bundled_hom : bundled_hom heyting_hom :=
+{ to_fun := λ α β [heyting_algebra α] [heyting_algebra β],
+    by exactI (coe_fn : heyting_hom α β → α → β),
+  id := heyting_hom.id,
+  comp := @heyting_hom.comp,
+  hom_ext := λ α β [heyting_algebra α] [heyting_algebra β], by exactI fun_like.coe_injective }
+
+attribute [derive [large_category, concrete_category]] HeytAlg
+
+@[simps]
+instance has_forget_to_Lat : has_forget₂ HeytAlg BddDistLat :=
+{ forget₂ := { obj := λ X, BddDistLat.of X,
+               map := λ X Y f, (f : bounded_lattice_hom X Y) } }
+
+/-- Constructs an isomorphism of Heyting algebras from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : HeytAlg.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+end HeytAlg
diff --git a/src/order/category/Lat.lean b/src/order/category/Lat.lean
new file mode 100644
index 0000000000000..5fe82c5f481fe
--- /dev/null
+++ b/src/order/category/Lat.lean
@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.PartOrd
+import order.hom.lattice
+
+/-!
+# The category of lattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `Lat`, the category of lattices.
+
+Note that `Lat` doesn't correspond to the literature definition of [`Lat`]
+(https://ncatlab.org/nlab/show/Lat) as we don't require bottom or top elements. Instead, `Lat`
+corresponds to `BddLat`.
+
+## TODO
+
+The free functor from `Lat` to `BddLat` is `X → with_top (with_bot X)`.
+-/
+
+universes u
+
+open category_theory
+
+/-- The category of lattices. -/
+def Lat := bundled lattice
+
+namespace Lat
+
+instance : has_coe_to_sort Lat Type* := bundled.has_coe_to_sort
+instance (X : Lat) : lattice X := X.str
+
+/-- Construct a bundled `Lat` from a `lattice`. -/
+def of (α : Type*) [lattice α] : Lat := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [lattice α] : ↥(of α) = α := rfl
+
+instance : inhabited Lat := ⟨of bool⟩
+
+instance : bundled_hom @lattice_hom :=
+{ to_fun := λ _ _ _ _, coe_fn,
+  id := @lattice_hom.id,
+  comp := @lattice_hom.comp,
+  hom_ext := λ X Y _ _, by exactI fun_like.coe_injective }
+
+instance : large_category.{u} Lat := bundled_hom.category lattice_hom
+instance : concrete_category Lat := bundled_hom.concrete_category lattice_hom
+
+instance has_forget_to_PartOrd : has_forget₂ Lat PartOrd :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f },
+  forget_comp := rfl }
+
+/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : Lat.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : Lat ⥤ Lat := { obj := λ X, of Xᵒᵈ, map := λ X Y, lattice_hom.dual }
+
+/-- The equivalence between `Lat` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : Lat ≌ Lat :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end Lat
+
+lemma Lat_dual_comp_forget_to_PartOrd :
+  Lat.dual ⋙ forget₂ Lat PartOrd =
+    forget₂ Lat PartOrd ⋙ PartOrd.dual := rfl
diff --git a/src/order/category/Lattice.lean b/src/order/category/Lattice.lean
deleted file mode 100644
index 3fa08568307f4..0000000000000
--- a/src/order/category/Lattice.lean
+++ /dev/null
@@ -1,75 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.PartialOrder
-import order.hom.lattice
-
-/-!
-# The category of lattices
-
-This defines `Lattice`, the category of lattices.
-
-Note that `Lattice` doesn't correspond to the literature definition of [`Lat`]
-(https://ncatlab.org/nlab/show/Lat) as we don't require bottom or top elements. Instead, `Lat`
-corresponds to `BoundedLattice` (not yet in mathlib).
-
-## TODO
-
-The free functor from `Lattice` to `BoundedLattice` is `X → with_top (with_bot X)`.
--/
-
-universes u
-
-open category_theory
-
-/-- The category of lattices. -/
-def Lattice := bundled lattice
-
-namespace Lattice
-
-instance : has_coe_to_sort Lattice Type* := bundled.has_coe_to_sort
-instance (X : Lattice) : lattice X := X.str
-
-/-- Construct a bundled `Lattice` from a `lattice`. -/
-def of (α : Type*) [lattice α] : Lattice := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [lattice α] : ↥(of α) = α := rfl
-
-instance : inhabited Lattice := ⟨of bool⟩
-
-instance : bundled_hom @lattice_hom :=
-{ to_fun := λ _ _ _ _, coe_fn,
-  id := @lattice_hom.id,
-  comp := @lattice_hom.comp,
-  hom_ext := λ X Y _ _, by exactI fun_like.coe_injective }
-
-instance : large_category.{u} Lattice := bundled_hom.category lattice_hom
-instance : concrete_category Lattice := bundled_hom.concrete_category lattice_hom
-
-instance has_forget_to_PartialOrder : has_forget₂ Lattice PartialOrder :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f },
-  forget_comp := rfl }
-
-/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : Lattice.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : Lattice ⥤ Lattice := { obj := λ X, of Xᵒᵈ, map := λ X Y, lattice_hom.dual }
-
-/-- The equivalence between `Lattice` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : Lattice ≌ Lattice :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end Lattice
-
-lemma Lattice_dual_comp_forget_to_PartialOrder :
-  Lattice.dual ⋙ forget₂ Lattice PartialOrder =
-    forget₂ Lattice PartialOrder ⋙ PartialOrder.dual := rfl
diff --git a/src/order/category/LinOrd.lean b/src/order/category/LinOrd.lean
new file mode 100644
index 0000000000000..1c9d29bf5d82a
--- /dev/null
+++ b/src/order/category/LinOrd.lean
@@ -0,0 +1,67 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+
+import order.category.Lat
+
+/-!
+# Category of linear orders
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `LinOrd`, the category of linear orders with monotone maps.
+-/
+
+open category_theory
+
+universe u
+
+/-- The category of linear orders. -/
+def LinOrd := bundled linear_order
+
+namespace LinOrd
+
+instance : bundled_hom.parent_projection @linear_order.to_partial_order := ⟨⟩
+
+attribute [derive [large_category, concrete_category]] LinOrd
+
+instance : has_coe_to_sort LinOrd Type* := bundled.has_coe_to_sort
+
+/-- Construct a bundled `LinOrd` from the underlying type and typeclass. -/
+def of (α : Type*) [linear_order α] : LinOrd := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [linear_order α] : ↥(of α) = α := rfl
+
+instance : inhabited LinOrd := ⟨of punit⟩
+
+instance (α : LinOrd) : linear_order α := α.str
+
+instance has_forget_to_Lat : has_forget₂ LinOrd Lat :=
+{ forget₂ := { obj := λ X, Lat.of X,
+               map := λ X Y f, (order_hom_class.to_lattice_hom X Y f : lattice_hom X Y) } }
+
+/-- Constructs an equivalence between linear orders from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : LinOrd.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : LinOrd ⥤ LinOrd :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
+
+/-- The equivalence between `LinOrd` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : LinOrd ≌ LinOrd :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end LinOrd
+
+lemma LinOrd_dual_comp_forget_to_Lat :
+  LinOrd.dual ⋙ forget₂ LinOrd Lat = forget₂ LinOrd Lat ⋙ Lat.dual :=
+rfl
diff --git a/src/order/category/LinearOrder.lean b/src/order/category/LinearOrder.lean
deleted file mode 100644
index e8d0bda96df25..0000000000000
--- a/src/order/category/LinearOrder.lean
+++ /dev/null
@@ -1,64 +0,0 @@
-/-
-Copyright (c) 2020 Johan Commelin. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin
--/
-
-import order.category.Lattice
-
-/-!
-# Category of linear orders
-
-This defines `LinearOrder`, the category of linear orders with monotone maps.
--/
-
-open category_theory
-
-universe u
-
-/-- The category of linear orders. -/
-def LinearOrder := bundled linear_order
-
-namespace LinearOrder
-
-instance : bundled_hom.parent_projection @linear_order.to_partial_order := ⟨⟩
-
-attribute [derive [large_category, concrete_category]] LinearOrder
-
-instance : has_coe_to_sort LinearOrder Type* := bundled.has_coe_to_sort
-
-/-- Construct a bundled `LinearOrder` from the underlying type and typeclass. -/
-def of (α : Type*) [linear_order α] : LinearOrder := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [linear_order α] : ↥(of α) = α := rfl
-
-instance : inhabited LinearOrder := ⟨of punit⟩
-
-instance (α : LinearOrder) : linear_order α := α.str
-
-instance has_forget_to_Lattice : has_forget₂ LinearOrder Lattice :=
-{ forget₂ := { obj := λ X, Lattice.of X,
-               map := λ X Y f, (order_hom_class.to_lattice_hom X Y f : lattice_hom X Y) } }
-
-/-- Constructs an equivalence between linear orders from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : LinearOrder.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : LinearOrder ⥤ LinearOrder :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
-
-/-- The equivalence between `LinearOrder` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : LinearOrder ≌ LinearOrder :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end LinearOrder
-
-lemma LinearOrder_dual_comp_forget_to_Lattice :
-  LinearOrder.dual ⋙ forget₂ LinearOrder Lattice = forget₂ LinearOrder Lattice ⋙ Lattice.dual :=
-rfl
diff --git a/src/order/category/NonemptyFinLinOrd.lean b/src/order/category/NonemptyFinLinOrd.lean
index d281dff7e3125..73bddd81f550e 100644
--- a/src/order/category/NonemptyFinLinOrd.lean
+++ b/src/order/category/NonemptyFinLinOrd.lean
@@ -4,18 +4,28 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 import data.fintype.order
-import order.category.LinearOrder
+import data.set.finite
+import order.category.FinPartOrd
+import order.category.LinOrd
+import category_theory.limits.shapes.images
+import category_theory.limits.shapes.regular_mono
 
 /-!
 # Nonempty finite linear orders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This defines `NonemptyFinLinOrd`, the category of nonempty finite linear orders with monotone maps.
 This is the index category for simplicial objects.
+
+Note: `NonemptyFinLinOrd` is *not* a subcategory of `FinBddDistLat` because its morphisms do not
+preserve `⊥` and `⊤`.
 -/
 
 universes u v
 
-open category_theory
+open category_theory category_theory.limits
 
 /-- A typeclass for nonempty finite linear orders. -/
 class nonempty_fin_lin_ord (α : Type*) extends fintype α, linear_order α :=
@@ -28,19 +38,13 @@ instance nonempty_fin_lin_ord.to_bounded_order (α : Type*) [nonempty_fin_lin_or
   bounded_order α :=
 fintype.to_bounded_order α
 
-instance punit.nonempty_fin_lin_ord : nonempty_fin_lin_ord punit :=
-{ .. punit.linear_ordered_cancel_add_comm_monoid,
-  .. punit.fintype }
+instance punit.nonempty_fin_lin_ord : nonempty_fin_lin_ord punit := { }
 
-instance fin.nonempty_fin_lin_ord (n : ℕ) : nonempty_fin_lin_ord (fin (n+1)) :=
-{ .. fin.fintype _,
-  .. fin.linear_order }
+instance fin.nonempty_fin_lin_ord (n : ℕ) : nonempty_fin_lin_ord (fin (n+1)) := { }
 
 instance ulift.nonempty_fin_lin_ord (α : Type u) [nonempty_fin_lin_ord α] :
   nonempty_fin_lin_ord (ulift.{v} α) :=
-{ nonempty := ⟨ulift.up ⊥⟩,
-  .. linear_order.lift equiv.ulift (equiv.injective _),
-  .. ulift.fintype _ }
+{ .. linear_order.lift' equiv.ulift (equiv.injective _) }
 
 instance (α : Type*) [nonempty_fin_lin_ord α] : nonempty_fin_lin_ord αᵒᵈ :=
 { ..order_dual.fintype α }
@@ -65,9 +69,12 @@ instance : inhabited NonemptyFinLinOrd := ⟨of punit⟩
 
 instance (α : NonemptyFinLinOrd) : nonempty_fin_lin_ord α := α.str
 
-instance has_forget_to_LinearOrder : has_forget₂ NonemptyFinLinOrd LinearOrder :=
+instance has_forget_to_LinOrd : has_forget₂ NonemptyFinLinOrd LinOrd :=
 bundled_hom.forget₂ _ _
 
+instance has_forget_to_FinPartOrd : has_forget₂ NonemptyFinLinOrd FinPartOrd :=
+{ forget₂ := { obj := λ X, FinPartOrd.of X, map := λ X Y, id } }
+
 /-- Constructs an equivalence between nonempty finite linear orders from an order isomorphism
 between them. -/
 @[simps] def iso.mk {α β : NonemptyFinLinOrd.{u}} (e : α ≃o β) : α ≅ β :=
@@ -80,14 +87,111 @@ between them. -/
 @[simps] def dual : NonemptyFinLinOrd ⥤ NonemptyFinLinOrd :=
 { obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
 
-/-- The equivalence between `FinPartialOrder` and itself induced by `order_dual` both ways. -/
+/-- The equivalence between `NonemptyFinLinOrd` and itself induced by `order_dual` both ways. -/
 @[simps functor inverse] def dual_equiv : NonemptyFinLinOrd ≌ NonemptyFinLinOrd :=
 equivalence.mk dual dual
   (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
   (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
 
+lemma mono_iff_injective {A B : NonemptyFinLinOrd.{u}} (f : A ⟶ B) :
+  mono f ↔ function.injective f :=
+begin
+  refine ⟨_, concrete_category.mono_of_injective f⟩,
+  introI,
+  intros a₁ a₂ h,
+  let X : NonemptyFinLinOrd.{u} := ⟨ulift (fin 1)⟩,
+  let g₁ : X ⟶ A := ⟨λ x, a₁, λ x₁ x₂ h, by refl⟩,
+  let g₂ : X ⟶ A := ⟨λ x, a₂, λ x₁ x₂ h, by refl⟩,
+  change g₁ (ulift.up (0 : fin 1)) = g₂ (ulift.up (0 : fin 1)),
+  have eq : g₁ ≫ f = g₂ ≫ f := by { ext x, exact h, },
+  rw cancel_mono at eq,
+  rw eq,
+end
+
+lemma epi_iff_surjective {A B : NonemptyFinLinOrd.{u}} (f : A ⟶ B) :
+  epi f ↔ function.surjective f :=
+begin
+  split,
+  { introI,
+    by_contra' hf',
+    rcases hf' with ⟨m, hm⟩,
+    let Y : NonemptyFinLinOrd.{u} := ⟨ulift (fin 2)⟩,
+    let p₁ : B ⟶ Y := ⟨λ b, if b < m then ulift.up 0 else ulift.up 1, λ x₁ x₂ h, begin
+      simp only,
+      split_ifs with h₁ h₂ h₂,
+      any_goals { apply fin.zero_le, },
+      { exfalso,
+        exact h₁ (lt_of_le_of_lt h h₂), },
+      { refl, },
+    end⟩,
+    let p₂ : B ⟶ Y := ⟨λ b, if b ≤ m then ulift.up 0 else ulift.up 1, λ x₁ x₂ h, begin
+      simp only,
+      split_ifs with h₁ h₂ h₂,
+      any_goals { apply fin.zero_le, },
+      { exfalso,
+        exact h₁ (h.trans h₂), },
+      { refl, },
+    end⟩,
+    have h : p₁ m = p₂ m,
+    { congr,
+      rw ← cancel_epi f,
+      ext a : 2,
+      simp only [comp_apply, order_hom.coe_fun_mk],
+      split_ifs with h₁ h₂ h₂,
+      any_goals { refl, },
+      { exfalso, exact h₂ (le_of_lt h₁), },
+      { exfalso, exact hm a (eq_of_le_of_not_lt h₂ h₁), }, },
+    simpa only [order_hom.coe_fun_mk, lt_self_iff_false, if_false, le_refl, if_true,
+      ulift.up_inj, fin.one_eq_zero_iff, nat.succ_succ_ne_one] using h, },
+  { intro h,
+    exact concrete_category.epi_of_surjective f h, },
+end
+
+instance : split_epi_category NonemptyFinLinOrd.{u} :=
+⟨λ X Y f hf, begin
+  have H : ∀ (y : Y), nonempty (f⁻¹' { y }),
+  { rw epi_iff_surjective at hf,
+    intro y,
+    exact nonempty.intro ⟨(hf y).some, (hf y).some_spec⟩, },
+  let φ : Y → X := λ y, (H y).some.1,
+  have hφ : ∀ (y : Y), f (φ y) = y := λ y, (H y).some.2,
+  refine is_split_epi.mk' ⟨⟨φ, _⟩, _⟩, swap,
+  { ext b,
+    apply hφ, },
+  { intros a b,
+    contrapose,
+    intro h,
+    simp only [not_le] at h ⊢,
+    suffices : b ≤ a,
+    { apply lt_of_le_of_ne this,
+      intro h',
+      exfalso,
+      simpa only [h', lt_self_iff_false] using h, },
+    simpa only [hφ] using f.monotone (le_of_lt h), },
+end⟩
+
+instance : has_strong_epi_mono_factorisations NonemptyFinLinOrd.{u} :=
+⟨λ X Y f, begin
+  let I : NonemptyFinLinOrd.{u} := ⟨set.image (coe_fn f) ⊤, ⟨⟩⟩,
+  let e : X ⟶ I := ⟨λ x, ⟨f x, ⟨x, by tidy⟩⟩, λ x₁ x₂ h, f.monotone h⟩,
+  let m : I ⟶ Y := ⟨λ y, y, by tidy⟩,
+  haveI : epi e := by { rw epi_iff_surjective, tidy, },
+  haveI : strong_epi e := strong_epi_of_epi e,
+  haveI : mono m := concrete_category.mono_of_injective _ (by tidy),
+  exact nonempty.intro
+  { I := I,
+    m := m,
+    e := e, },
+end⟩
+
 end NonemptyFinLinOrd
 
-lemma NonemptyFinLinOrd_dual_comp_forget_to_LinearOrder :
-  NonemptyFinLinOrd.dual ⋙ forget₂ NonemptyFinLinOrd LinearOrder =
-    forget₂ NonemptyFinLinOrd LinearOrder ⋙ LinearOrder.dual := rfl
+lemma NonemptyFinLinOrd_dual_comp_forget_to_LinOrd :
+  NonemptyFinLinOrd.dual ⋙ forget₂ NonemptyFinLinOrd LinOrd =
+    forget₂ NonemptyFinLinOrd LinOrd ⋙ LinOrd.dual := rfl
+
+/-- The forgetful functor `NonemptyFinLinOrd ⥤ FinPartOrd` and `order_dual` commute. -/
+def NonemptyFinLinOrd_dual_comp_forget_to_FinPartOrd :
+  NonemptyFinLinOrd.dual ⋙ forget₂ NonemptyFinLinOrd FinPartOrd ≅
+    forget₂ NonemptyFinLinOrd FinPartOrd ⋙ FinPartOrd.dual :=
+{ hom := { app := λ X, order_hom.id }, inv := { app := λ X, order_hom.id } }
diff --git a/src/order/category/PartOrd.lean b/src/order/category/PartOrd.lean
new file mode 100644
index 0000000000000..f4fdaa6bedf90
--- /dev/null
+++ b/src/order/category/PartOrd.lean
@@ -0,0 +1,96 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+import order.antisymmetrization
+import order.category.Preord
+
+/-!
+# Category of partial orders
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `PartOrd`, the category of partial orders with monotone maps.
+-/
+
+open category_theory
+
+universe u
+
+/-- The category of partially ordered types. -/
+def PartOrd := bundled partial_order
+
+namespace PartOrd
+
+instance : bundled_hom.parent_projection @partial_order.to_preorder := ⟨⟩
+
+attribute [derive [large_category, concrete_category]] PartOrd
+
+instance : has_coe_to_sort PartOrd Type* := bundled.has_coe_to_sort
+
+/-- Construct a bundled PartOrd from the underlying type and typeclass. -/
+def of (α : Type*) [partial_order α] : PartOrd := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [partial_order α] : ↥(of α) = α := rfl
+
+instance : inhabited PartOrd := ⟨of punit⟩
+
+instance (α : PartOrd) : partial_order α := α.str
+
+instance has_forget_to_Preord : has_forget₂ PartOrd Preord := bundled_hom.forget₂ _ _
+
+/-- Constructs an equivalence between partial orders from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : PartOrd.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : PartOrd ⥤ PartOrd :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
+
+/-- The equivalence between `PartOrd` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : PartOrd ≌ PartOrd :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end PartOrd
+
+lemma PartOrd_dual_comp_forget_to_Preord :
+  PartOrd.dual ⋙ forget₂ PartOrd Preord =
+    forget₂ PartOrd Preord ⋙ Preord.dual := rfl
+
+/-- `antisymmetrization` as a functor. It is the free functor. -/
+def Preord_to_PartOrd : Preord.{u} ⥤ PartOrd :=
+{ obj := λ X, PartOrd.of (antisymmetrization X (≤)),
+  map := λ X Y f, f.antisymmetrization,
+  map_id' := λ X,
+    by { ext, exact quotient.induction_on' x (λ x, quotient.map'_mk' _ (λ a b, id) _) },
+  map_comp' := λ X Y Z f g,
+    by { ext, exact quotient.induction_on' x (λ x, order_hom.antisymmetrization_apply_mk _ _) } }
+
+/-- `Preord_to_PartOrd` is left adjoint to the forgetful functor, meaning it is the free
+functor from `Preord` to `PartOrd`. -/
+def Preord_to_PartOrd_forget_adjunction :
+  Preord_to_PartOrd.{u} ⊣ forget₂ PartOrd Preord :=
+adjunction.mk_of_hom_equiv
+  { hom_equiv := λ X Y, { to_fun := λ f,
+      ⟨f ∘ to_antisymmetrization (≤), f.mono.comp to_antisymmetrization_mono⟩,
+    inv_fun := λ f, ⟨λ a, quotient.lift_on' a f $ λ a b h, (antisymm_rel.image h f.mono).eq, λ a b,
+      quotient.induction_on₂' a b $ λ a b h, f.mono h⟩,
+    left_inv := λ f, order_hom.ext _ _ $ funext $ λ x, quotient.induction_on' x $ λ x, rfl,
+    right_inv := λ f, order_hom.ext _ _ $ funext $ λ x, rfl },
+  hom_equiv_naturality_left_symm' := λ X Y Z f g,
+    order_hom.ext _ _ $ funext $ λ x, quotient.induction_on' x $ λ x, rfl,
+  hom_equiv_naturality_right' := λ X Y Z f g, order_hom.ext _ _ $ funext $ λ x, rfl }
+
+/-- `Preord_to_PartOrd` and `order_dual` commute. -/
+@[simps] def Preord_to_PartOrd_comp_to_dual_iso_to_dual_comp_Preord_to_PartOrd :
+ (Preord_to_PartOrd.{u} ⋙ PartOrd.dual) ≅
+    (Preord.dual ⋙ Preord_to_PartOrd) :=
+nat_iso.of_components (λ X, PartOrd.iso.mk $ order_iso.dual_antisymmetrization _) $
+  λ X Y f, order_hom.ext _ _ $ funext $ λ x, quotient.induction_on' x $ λ x, rfl
diff --git a/src/order/category/PartialOrder.lean b/src/order/category/PartialOrder.lean
deleted file mode 100644
index 793f355aa681f..0000000000000
--- a/src/order/category/PartialOrder.lean
+++ /dev/null
@@ -1,93 +0,0 @@
-/-
-Copyright (c) 2020 Johan Commelin. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin
--/
-import order.antisymmetrization
-import order.category.Preorder
-
-/-!
-# Category of partial orders
-
-This defines `PartialOrder`, the category of partial orders with monotone maps.
--/
-
-open category_theory
-
-universe u
-
-/-- The category of partially ordered types. -/
-def PartialOrder := bundled partial_order
-
-namespace PartialOrder
-
-instance : bundled_hom.parent_projection @partial_order.to_preorder := ⟨⟩
-
-attribute [derive [large_category, concrete_category]] PartialOrder
-
-instance : has_coe_to_sort PartialOrder Type* := bundled.has_coe_to_sort
-
-/-- Construct a bundled PartialOrder from the underlying type and typeclass. -/
-def of (α : Type*) [partial_order α] : PartialOrder := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [partial_order α] : ↥(of α) = α := rfl
-
-instance : inhabited PartialOrder := ⟨of punit⟩
-
-instance (α : PartialOrder) : partial_order α := α.str
-
-instance has_forget_to_Preorder : has_forget₂ PartialOrder Preorder := bundled_hom.forget₂ _ _
-
-/-- Constructs an equivalence between partial orders from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : PartialOrder.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : PartialOrder ⥤ PartialOrder :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
-
-/-- The equivalence between `PartialOrder` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : PartialOrder ≌ PartialOrder :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end PartialOrder
-
-lemma PartialOrder_dual_comp_forget_to_Preorder :
-  PartialOrder.dual ⋙ forget₂ PartialOrder Preorder =
-    forget₂ PartialOrder Preorder ⋙ Preorder.dual := rfl
-
-/-- `antisymmetrization` as a functor. It is the free functor. -/
-def Preorder_to_PartialOrder : Preorder.{u} ⥤ PartialOrder :=
-{ obj := λ X, PartialOrder.of (antisymmetrization X (≤)),
-  map := λ X Y f, f.antisymmetrization,
-  map_id' := λ X,
-    by { ext, exact quotient.induction_on' x (λ x, quotient.map'_mk' _ (λ a b, id) _) },
-  map_comp' := λ X Y Z f g,
-    by { ext, exact quotient.induction_on' x (λ x, order_hom.antisymmetrization_apply_mk _ _) } }
-
-/-- `Preorder_to_PartialOrder` is left adjoint to the forgetful functor, meaning it is the free
-functor from `Preorder` to `PartialOrder`. -/
-def Preorder_to_PartialOrder_forget_adjunction :
-  Preorder_to_PartialOrder.{u} ⊣ forget₂ PartialOrder Preorder :=
-adjunction.mk_of_hom_equiv
-  { hom_equiv := λ X Y, { to_fun := λ f,
-      ⟨f ∘ to_antisymmetrization (≤), f.mono.comp to_antisymmetrization_mono⟩,
-    inv_fun := λ f, ⟨λ a, quotient.lift_on' a f $ λ a b h, (antisymm_rel.image h f.mono).eq, λ a b,
-      quotient.induction_on₂' a b $ λ a b h, f.mono h⟩,
-    left_inv := λ f, order_hom.ext _ _ $ funext $ λ x, quotient.induction_on' x $ λ x, rfl,
-    right_inv := λ f, order_hom.ext _ _ $ funext $ λ x, rfl },
-  hom_equiv_naturality_left_symm' := λ X Y Z f g,
-    order_hom.ext _ _ $ funext $ λ x, quotient.induction_on' x $ λ x, rfl,
-  hom_equiv_naturality_right' := λ X Y Z f g, order_hom.ext _ _ $ funext $ λ x, rfl }
-
-/-- `Preorder_to_PartialOrder` and `order_dual` commute. -/
-@[simps] def Preorder_to_PartialOrder_comp_to_dual_iso_to_dual_comp_Preorder_to_PartialOrder :
- (Preorder_to_PartialOrder.{u} ⋙ PartialOrder.dual) ≅
-    (Preorder.dual ⋙ Preorder_to_PartialOrder) :=
-nat_iso.of_components (λ X, PartialOrder.iso.mk $ order_iso.dual_antisymmetrization _) $
-  λ X Y f, order_hom.ext _ _ $ funext $ λ x, quotient.induction_on' x $ λ x, rfl
diff --git a/src/order/category/Preord.lean b/src/order/category/Preord.lean
new file mode 100644
index 0000000000000..1ca4aea91d877
--- /dev/null
+++ b/src/order/category/Preord.lean
@@ -0,0 +1,82 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+import category_theory.category.Cat
+import category_theory.category.preorder
+import category_theory.concrete_category.bundled_hom
+import order.hom.basic
+
+/-!
+# Category of preorders
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `Preord`, the category of preorders with monotone maps.
+-/
+
+universe u
+
+open category_theory
+
+/-- The category of preorders. -/
+def Preord := bundled preorder
+
+namespace Preord
+
+instance : bundled_hom @order_hom :=
+{ to_fun := @order_hom.to_fun,
+  id := @order_hom.id,
+  comp := @order_hom.comp,
+  hom_ext := @order_hom.ext }
+
+attribute [derive [large_category, concrete_category]] Preord
+
+instance : has_coe_to_sort Preord Type* := bundled.has_coe_to_sort
+
+/-- Construct a bundled Preord from the underlying type and typeclass. -/
+def of (α : Type*) [preorder α] : Preord := bundled.of α
+
+@[simp] lemma coe_of (α : Type*) [preorder α] : ↥(of α) = α := rfl
+
+instance : inhabited Preord := ⟨of punit⟩
+
+instance (α : Preord) : preorder α := α.str
+
+/-- Constructs an equivalence between preorders from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : Preord.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : Preord ⥤ Preord :=
+{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
+
+/-- The equivalence between `Preord` and itself induced by `order_dual` both ways. -/
+@[simps functor inverse] def dual_equiv : Preord ≌ Preord :=
+equivalence.mk dual dual
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+end Preord
+
+/--
+The embedding of `Preord` into `Cat`.
+-/
+@[simps]
+def Preord_to_Cat : Preord.{u} ⥤ Cat :=
+{ obj := λ X, Cat.of X.1,
+  map := λ X Y f, f.monotone.functor,
+  map_id' := λ X, begin apply category_theory.functor.ext, tidy end,
+  map_comp' := λ X Y Z f g, begin apply category_theory.functor.ext, tidy end }
+
+instance : faithful Preord_to_Cat.{u} :=
+{ map_injective' := λ X Y f g h, begin ext x, exact functor.congr_obj h x end }
+
+instance : full Preord_to_Cat.{u} :=
+{ preimage := λ X Y f, ⟨f.obj, f.monotone⟩,
+  witness' := λ X Y f, begin apply category_theory.functor.ext, tidy end }
diff --git a/src/order/category/Preorder.lean b/src/order/category/Preorder.lean
deleted file mode 100644
index b28dd988e00b2..0000000000000
--- a/src/order/category/Preorder.lean
+++ /dev/null
@@ -1,80 +0,0 @@
-/-
-Copyright (c) 2020 Johan Commelin. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin
--/
-import category_theory.concrete_category.bundled_hom
-import algebra.punit_instances
-import order.hom.basic
-import category_theory.category.Cat
-import category_theory.category.preorder
-
-/-!
-# Category of preorders
-
-This defines `Preorder`, the category of preorders with monotone maps.
--/
-
-universe u
-
-open category_theory
-
-/-- The category of preorders. -/
-def Preorder := bundled preorder
-
-namespace Preorder
-
-instance : bundled_hom @order_hom :=
-{ to_fun := @order_hom.to_fun,
-  id := @order_hom.id,
-  comp := @order_hom.comp,
-  hom_ext := @order_hom.ext }
-
-attribute [derive [large_category, concrete_category]] Preorder
-
-instance : has_coe_to_sort Preorder Type* := bundled.has_coe_to_sort
-
-/-- Construct a bundled Preorder from the underlying type and typeclass. -/
-def of (α : Type*) [preorder α] : Preorder := bundled.of α
-
-@[simp] lemma coe_of (α : Type*) [preorder α] : ↥(of α) = α := rfl
-
-instance : inhabited Preorder := ⟨of punit⟩
-
-instance (α : Preorder) : preorder α := α.str
-
-/-- Constructs an equivalence between preorders from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : Preorder.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply x },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply x } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : Preorder ⥤ Preorder :=
-{ obj := λ X, of Xᵒᵈ, map := λ X Y, order_hom.dual }
-
-/-- The equivalence between `Preorder` and itself induced by `order_dual` both ways. -/
-@[simps functor inverse] def dual_equiv : Preorder ≌ Preorder :=
-equivalence.mk dual dual
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-end Preorder
-
-/--
-The embedding of `Preorder` into `Cat`.
--/
-@[simps]
-def Preorder_to_Cat : Preorder.{u} ⥤ Cat :=
-{ obj := λ X, Cat.of X.1,
-  map := λ X Y f, f.monotone.functor,
-  map_id' := λ X, begin apply category_theory.functor.ext, tidy end,
-  map_comp' := λ X Y Z f g, begin apply category_theory.functor.ext, tidy end }
-
-instance : faithful Preorder_to_Cat.{u} :=
-{ map_injective' := λ X Y f g h, begin ext x, exact functor.congr_obj h x end }
-
-instance : full Preorder_to_Cat.{u} :=
-{ preimage := λ X Y f, ⟨f.obj, f.monotone⟩,
-  witness' := λ X Y f, begin apply category_theory.functor.ext, tidy end }
diff --git a/src/order/category/Semilat.lean b/src/order/category/Semilat.lean
new file mode 100644
index 0000000000000..49a62906cbed4
--- /dev/null
+++ b/src/order/category/Semilat.lean
@@ -0,0 +1,151 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.category.PartOrd
+import order.hom.lattice
+
+/-!
+# The categories of semilattices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines `SemilatSup` and `SemilatInf`, the categories of sup-semilattices with a bottom
+element and inf-semilattices with a top element.
+
+## References
+
+* [nLab, *semilattice*](https://ncatlab.org/nlab/show/semilattice)
+-/
+
+universes u
+open category_theory
+
+/-- The category of sup-semilattices with a bottom element. -/
+structure SemilatSup : Type.{u+1} :=
+(X : Type.{u})
+[is_semilattice_sup : semilattice_sup X]
+[is_order_bot : order_bot X]
+
+/-- The category of inf-semilattices with a top element. -/
+structure SemilatInf : Type.{u+1} :=
+(X : Type.{u})
+[is_semilattice_inf : semilattice_inf X]
+[is_order_top : order_top X]
+
+attribute [protected] SemilatSup.X SemilatInf.X
+
+namespace SemilatSup
+
+instance : has_coe_to_sort SemilatSup Type* := ⟨SemilatSup.X⟩
+attribute [instance] is_semilattice_sup is_order_bot
+
+/-- Construct a bundled `SemilatSup` from a `semilattice_sup`. -/
+def of (α : Type*) [semilattice_sup α] [order_bot α] : SemilatSup := ⟨α⟩
+
+@[simp] lemma coe_of (α : Type*) [semilattice_sup α] [order_bot α] : ↥(of α) = α := rfl
+
+instance : inhabited SemilatSup := ⟨of punit⟩
+
+instance : large_category.{u} SemilatSup :=
+{ hom := λ X Y, sup_bot_hom X Y,
+  id := λ X, sup_bot_hom.id X,
+  comp := λ X Y Z f g, g.comp f,
+  id_comp' := λ X Y, sup_bot_hom.comp_id,
+  comp_id' := λ X Y, sup_bot_hom.id_comp,
+  assoc' := λ W X Y Z _ _ _, sup_bot_hom.comp_assoc _ _ _ }
+
+instance : concrete_category SemilatSup :=
+{ forget := { obj := SemilatSup.X, map := λ X Y, coe_fn },
+  forget_faithful := ⟨λ X Y, fun_like.coe_injective⟩ }
+
+instance has_forget_to_PartOrd : has_forget₂ SemilatSup PartOrd :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f } }
+
+@[simp] lemma coe_forget_to_PartOrd (X : SemilatSup) :
+  ↥((forget₂ SemilatSup PartOrd).obj X) = ↥X := rfl
+
+end SemilatSup
+
+namespace SemilatInf
+
+instance : has_coe_to_sort SemilatInf Type* := ⟨SemilatInf.X⟩
+
+attribute [instance] is_semilattice_inf is_order_top
+
+/-- Construct a bundled `SemilatInf` from a `semilattice_inf`. -/
+def of (α : Type*) [semilattice_inf α] [order_top α] : SemilatInf := ⟨α⟩
+
+@[simp] lemma coe_of (α : Type*) [semilattice_inf α] [order_top α] : ↥(of α) = α := rfl
+
+instance : inhabited SemilatInf := ⟨of punit⟩
+
+instance : large_category.{u} SemilatInf :=
+{ hom := λ X Y, inf_top_hom X Y,
+  id := λ X, inf_top_hom.id X,
+  comp := λ X Y Z f g, g.comp f,
+  id_comp' := λ X Y, inf_top_hom.comp_id,
+  comp_id' := λ X Y, inf_top_hom.id_comp,
+  assoc' := λ W X Y Z _ _ _, inf_top_hom.comp_assoc _ _ _ }
+
+instance : concrete_category SemilatInf :=
+{ forget := { obj := SemilatInf.X, map := λ X Y, coe_fn },
+  forget_faithful := ⟨λ X Y, fun_like.coe_injective⟩ }
+
+instance has_forget_to_PartOrd : has_forget₂ SemilatInf PartOrd :=
+{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f } }
+
+@[simp] lemma coe_forget_to_PartOrd (X : SemilatInf) :
+  ↥((forget₂ SemilatInf PartOrd).obj X) = ↥X := rfl
+
+end SemilatInf
+
+/-! ### Order dual -/
+
+namespace SemilatSup
+
+/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : SemilatSup.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : SemilatSup ⥤ SemilatInf :=
+{ obj := λ X, SemilatInf.of Xᵒᵈ, map := λ X Y, sup_bot_hom.dual }
+
+end SemilatSup
+
+namespace SemilatInf
+
+/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
+@[simps] def iso.mk {α β : SemilatInf.{u}} (e : α ≃o β) : α ≅ β :=
+{ hom := e,
+  inv := e.symm,
+  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
+  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
+
+/-- `order_dual` as a functor. -/
+@[simps] def dual : SemilatInf ⥤ SemilatSup :=
+{ obj := λ X, SemilatSup.of Xᵒᵈ, map := λ X Y, inf_top_hom.dual }
+
+end SemilatInf
+
+/-- The equivalence between `SemilatSup` and `SemilatInf` induced by `order_dual` both ways.
+-/
+@[simps functor inverse]
+def SemilatSup_equiv_SemilatInf : SemilatSup ≌ SemilatInf :=
+equivalence.mk SemilatSup.dual SemilatInf.dual
+  (nat_iso.of_components (λ X, SemilatSup.iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+  (nat_iso.of_components (λ X, SemilatInf.iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
+
+lemma SemilatSup_dual_comp_forget_to_PartOrd :
+  SemilatSup.dual ⋙ forget₂ SemilatInf PartOrd =
+    forget₂ SemilatSup PartOrd ⋙ PartOrd.dual := rfl
+
+lemma SemilatInf_dual_comp_forget_to_PartOrd :
+  SemilatInf.dual ⋙ forget₂ SemilatSup PartOrd =
+    forget₂ SemilatInf PartOrd ⋙ PartOrd.dual := rfl
diff --git a/src/order/category/Semilattice.lean b/src/order/category/Semilattice.lean
deleted file mode 100644
index 234a24b254b47..0000000000000
--- a/src/order/category/Semilattice.lean
+++ /dev/null
@@ -1,148 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies
--/
-import order.category.PartialOrder
-import order.hom.lattice
-
-/-!
-# The categories of semilattices
-
-This defines `SemilatticeSup` and `SemilatticeInf`, the categories of sup-semilattices with a bottom
-element and inf-semilattices with a top element.
-
-## References
-
-* [nLab, *semilattice*](https://ncatlab.org/nlab/show/semilattice)
--/
-
-universes u
-open category_theory
-
-/-- The category of sup-semilattices with a bottom element. -/
-structure SemilatticeSup : Type.{u+1} :=
-(X : Type.{u})
-[is_semilattice_sup : semilattice_sup X]
-[is_order_bot : order_bot X]
-
-/-- The category of inf-semilattices with a top element. -/
-structure SemilatticeInf : Type.{u+1} :=
-(X : Type.{u})
-[is_semilattice_inf : semilattice_inf X]
-[is_order_top : order_top X]
-
-attribute [protected] SemilatticeSup.X SemilatticeInf.X
-
-namespace SemilatticeSup
-
-instance : has_coe_to_sort SemilatticeSup Type* := ⟨SemilatticeSup.X⟩
-attribute [instance] is_semilattice_sup is_order_bot
-
-/-- Construct a bundled `SemilatticeSup` from a `semilattice_sup`. -/
-def of (α : Type*) [semilattice_sup α] [order_bot α] : SemilatticeSup := ⟨α⟩
-
-@[simp] lemma coe_of (α : Type*) [semilattice_sup α] [order_bot α] : ↥(of α) = α := rfl
-
-instance : inhabited SemilatticeSup := ⟨of punit⟩
-
-instance : large_category.{u} SemilatticeSup :=
-{ hom := λ X Y, sup_bot_hom X Y,
-  id := λ X, sup_bot_hom.id X,
-  comp := λ X Y Z f g, g.comp f,
-  id_comp' := λ X Y, sup_bot_hom.comp_id,
-  comp_id' := λ X Y, sup_bot_hom.id_comp,
-  assoc' := λ W X Y Z _ _ _, sup_bot_hom.comp_assoc _ _ _ }
-
-instance : concrete_category SemilatticeSup :=
-{ forget := { obj := SemilatticeSup.X, map := λ X Y, coe_fn },
-  forget_faithful := ⟨λ X Y, fun_like.coe_injective⟩ }
-
-instance has_forget_to_PartialOrder : has_forget₂ SemilatticeSup PartialOrder :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f } }
-
-@[simp] lemma coe_forget_to_PartialOrder (X : SemilatticeSup) :
-  ↥((forget₂ SemilatticeSup PartialOrder).obj X) = ↥X := rfl
-
-end SemilatticeSup
-
-namespace SemilatticeInf
-
-instance : has_coe_to_sort SemilatticeInf Type* := ⟨SemilatticeInf.X⟩
-
-attribute [instance] is_semilattice_inf is_order_top
-
-/-- Construct a bundled `SemilatticeInf` from a `semilattice_inf`. -/
-def of (α : Type*) [semilattice_inf α] [order_top α] : SemilatticeInf := ⟨α⟩
-
-@[simp] lemma coe_of (α : Type*) [semilattice_inf α] [order_top α] : ↥(of α) = α := rfl
-
-instance : inhabited SemilatticeInf := ⟨of punit⟩
-
-instance : large_category.{u} SemilatticeInf :=
-{ hom := λ X Y, inf_top_hom X Y,
-  id := λ X, inf_top_hom.id X,
-  comp := λ X Y Z f g, g.comp f,
-  id_comp' := λ X Y, inf_top_hom.comp_id,
-  comp_id' := λ X Y, inf_top_hom.id_comp,
-  assoc' := λ W X Y Z _ _ _, inf_top_hom.comp_assoc _ _ _ }
-
-instance : concrete_category SemilatticeInf :=
-{ forget := { obj := SemilatticeInf.X, map := λ X Y, coe_fn },
-  forget_faithful := ⟨λ X Y, fun_like.coe_injective⟩ }
-
-instance has_forget_to_PartialOrder : has_forget₂ SemilatticeInf PartialOrder :=
-{ forget₂ := { obj := λ X, ⟨X⟩, map := λ X Y f, f } }
-
-@[simp] lemma coe_forget_to_PartialOrder (X : SemilatticeInf) :
-  ↥((forget₂ SemilatticeInf PartialOrder).obj X) = ↥X := rfl
-
-end SemilatticeInf
-
-/-! ### Order dual -/
-
-namespace SemilatticeSup
-
-/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : SemilatticeSup.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : SemilatticeSup ⥤ SemilatticeInf :=
-{ obj := λ X, SemilatticeInf.of Xᵒᵈ, map := λ X Y, sup_bot_hom.dual }
-
-end SemilatticeSup
-
-namespace SemilatticeInf
-
-/-- Constructs an isomorphism of lattices from an order isomorphism between them. -/
-@[simps] def iso.mk {α β : SemilatticeInf.{u}} (e : α ≃o β) : α ≅ β :=
-{ hom := e,
-  inv := e.symm,
-  hom_inv_id' := by { ext, exact e.symm_apply_apply _ },
-  inv_hom_id' := by { ext, exact e.apply_symm_apply _ } }
-
-/-- `order_dual` as a functor. -/
-@[simps] def dual : SemilatticeInf ⥤ SemilatticeSup :=
-{ obj := λ X, SemilatticeSup.of Xᵒᵈ, map := λ X Y, inf_top_hom.dual }
-
-end SemilatticeInf
-
-/-- The equivalence between `SemilatticeSup` and `SemilatticeInf` induced by `order_dual` both ways.
--/
-@[simps functor inverse]
-def SemilatticeSup_equiv_SemilatticeInf : SemilatticeSup ≌ SemilatticeInf :=
-equivalence.mk SemilatticeSup.dual SemilatticeInf.dual
-  (nat_iso.of_components (λ X, SemilatticeSup.iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-  (nat_iso.of_components (λ X, SemilatticeInf.iso.mk $ order_iso.dual_dual X) $ λ X Y f, rfl)
-
-lemma SemilatticeSup_dual_comp_forget_to_PartialOrder :
-  SemilatticeSup.dual ⋙ forget₂ SemilatticeInf PartialOrder =
-    forget₂ SemilatticeSup PartialOrder ⋙ PartialOrder.dual := rfl
-
-lemma SemilatticeInf_dual_comp_forget_to_PartialOrder :
-  SemilatticeInf.dual ⋙ forget₂ SemilatticeSup PartialOrder =
-    forget₂ SemilatticeInf PartialOrder ⋙ PartialOrder.dual := rfl
diff --git a/src/order/category/omega_complete_partial_order.lean b/src/order/category/omega_complete_partial_order.lean
index 7e2df466c1d7c..15b627c09c367 100644
--- a/src/order/category/omega_complete_partial_order.lean
+++ b/src/order/category/omega_complete_partial_order.lean
@@ -5,14 +5,17 @@ Authors: Simon Hudon
 -/
 
 import order.omega_complete_partial_order
-import order.category.Preorder
 import category_theory.limits.shapes.products
 import category_theory.limits.shapes.equalizers
 import category_theory.limits.constructions.limits_of_products_and_equalizers
+import category_theory.concrete_category.bundled_hom
 
 /-!
 # Category of types with a omega complete partial order
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we bundle the class `omega_complete_partial_order` into a
 concrete category and prove that continuous functions also form
 a `omega_complete_partial_order`.
@@ -67,15 +70,16 @@ fan.mk (of (Π j, f j)) (λ j, continuous_hom.of_mono (pi.eval_order_hom j) (λ
 /-- The pi-type is a limit cone for the product. -/
 def is_product (J : Type v) (f : J → ωCPO) : is_limit (product f) :=
 { lift := λ s,
-    ⟨⟨λ t j, s.π.app j t, λ x y h j, (s.π.app j).monotone h⟩,
-     λ x, funext (λ j, (s.π.app j).continuous x)⟩,
+    ⟨⟨λ t j, s.π.app ⟨j⟩ t, λ x y h j, (s.π.app ⟨j⟩).monotone h⟩,
+     λ x, funext (λ j, (s.π.app ⟨j⟩).continuous x)⟩,
   uniq' := λ s m w,
   begin
     ext t j,
-    change m t j = s.π.app j t,
-    rw ← w j,
+    change m t j = s.π.app ⟨j⟩ t,
+    rw ← w ⟨j⟩,
     refl,
-  end }.
+  end,
+  fac' := λ s j, by { cases j, tidy, } }.
 
 instance (J : Type v) (f : J → ωCPO.{v}) : has_product f :=
 has_limit.mk ⟨_, is_product _ f⟩
@@ -122,7 +126,7 @@ fork.is_limit.mk' _ $ λ s,
 
 end has_equalizers
 
-instance : has_products ωCPO.{v} :=
+instance : has_products.{v} ωCPO.{v} :=
 λ J, { has_limit := λ F, has_limit_of_iso discrete.nat_iso_functor.symm }
 
 instance {X Y : ωCPO.{v}} (f g : X ⟶ Y) : has_limit (parallel_pair f g) :=
@@ -130,7 +134,7 @@ has_limit.mk ⟨_, has_equalizers.is_equalizer f g⟩
 
 instance : has_equalizers ωCPO.{v} := has_equalizers_of_has_limit_parallel_pair _
 
-instance : has_limits ωCPO.{v} := limits_from_equalizers_and_products
+instance : has_limits ωCPO.{v} := has_limits_of_has_equalizers_and_products
 
 end
 
diff --git a/src/order/chain.lean b/src/order/chain.lean
index 45a8e7f8e9fc3..34b01b9f53c5e 100644
--- a/src/order/chain.lean
+++ b/src/order/chain.lean
@@ -3,12 +3,16 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import data.set.pairwise
+import data.set.pairwise.basic
+import data.set.lattice
 import data.set_like.basic
 
 /-!
 # Chains and flags
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines chains for an arbitrary relation and flags for an order and proves Hausdorff's
 Maximality Principle.
 
@@ -96,6 +100,17 @@ protected lemma is_chain.directed {f : β → α} {c : set β} (h : is_chain (f
     exact ⟨b, hb, refl _⟩) $
   λ hab, (h ha hb hab).elim (λ h, ⟨⟨b, hb⟩, h, refl _⟩) $ λ h, ⟨⟨a, ha⟩, refl _, h⟩
 
+lemma is_chain.exists3 (hchain : is_chain r s) [is_trans α r] {a b c}
+  (mem1 : a ∈ s) (mem2 : b ∈ s) (mem3 : c ∈ s) :
+  ∃ (z) (mem4 : z ∈ s), r a z ∧ r b z ∧ r c z :=
+begin
+  rcases directed_on_iff_directed.mpr (is_chain.directed hchain) a mem1 b mem2 with
+    ⟨z, mem4, H1, H2⟩,
+  rcases directed_on_iff_directed.mpr (is_chain.directed hchain) z mem4 c mem3 with
+    ⟨z', mem5, H3, H4⟩,
+  exact ⟨z', mem5, trans H1 H3, trans H2 H3, H4⟩,
+end
+
 end total
 
 lemma is_max_chain.is_chain (h : is_max_chain r s) : is_chain r s := h.1
diff --git a/src/order/circular.lean b/src/order/circular.lean
index 5255e3f546214..cd448697ca364 100644
--- a/src/order/circular.lean
+++ b/src/order/circular.lean
@@ -8,6 +8,9 @@ import data.set.basic
 /-!
 # Circular order hierarchy
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines circular preorders, circular partial orders and circular orders.
 
 ## Hierarchy
@@ -67,7 +70,7 @@ What is the correct generality of "rolling the necklace" open? At least, this wo
 `β × α` where `α` is a circular order and `β` is a linear order.
 
 What's next is to define circular groups and provide instances for `zmod n`, the usual circle group
-`circle`, `real.angle`, and `roots_of_unity M`. What conditions do we need on `M` for this last one
+`circle`, and `roots_of_unity M`. What conditions do we need on `M` for this last one
 to work?
 
 We should have circular order homomorphisms. The typical example is
diff --git a/src/order/closure.lean b/src/order/closure.lean
index 2e4fdd04e2f56..02cbb145e3131 100644
--- a/src/order/closure.lean
+++ b/src/order/closure.lean
@@ -7,11 +7,13 @@ import data.set.lattice
 import data.set_like.basic
 import order.galois_connection
 import order.hom.basic
-import tactic.monotonicity
 
 /-!
 # Closure operators between preorders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define (bundled) closure operators on a preorder as monotone (increasing), extensive
 (inflationary) and idempotent functions.
 We define closed elements for the operator as elements which are fixed by it.
@@ -394,14 +396,14 @@ lemma closure_union_closure_subset (x y : α) :
 l.closure_sup_closure_le x y
 
 @[simp] lemma closure_union_closure_left (x y : α) :
-  (l ((l x) ∪ y) : set β) = l (x ∪ y) :=
-l.closure_sup_closure_left x y
+  l ((l x) ∪ y) = l (x ∪ y) :=
+set_like.coe_injective (l.closure_sup_closure_left x y)
 
 @[simp] lemma closure_union_closure_right (x y : α) :
   l (x ∪ (l y)) = l (x ∪ y) :=
 set_like.coe_injective (l.closure_sup_closure_right x y)
 
-@[simp] lemma closure_union_closure (x y : α) :
+lemma closure_union_closure (x y : α) :
   l ((l x) ∪ (l y)) = l (x ∪ y) :=
 set_like.coe_injective (l.closure_operator.closure_sup_closure x y)
 
diff --git a/src/order/compactly_generated.lean b/src/order/compactly_generated.lean
index 39d8ad5f48499..f08caf837ce5a 100644
--- a/src/order/compactly_generated.lean
+++ b/src/order/compactly_generated.lean
@@ -3,16 +3,22 @@ Copyright (c) 2021 Oliver Nash. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Oliver Nash
 -/
-import tactic.tfae
 import order.atoms
 import order.order_iso_nat
+import order.rel_iso.set
 import order.sup_indep
 import order.zorn
 import data.finset.order
+import data.set.intervals.order_iso
+import data.finite.set
+import tactic.tfae
 
 /-!
 # Compactness properties for complete lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For complete lattices, there are numerous equivalent ways to express the fact that the relation `>`
 is well-founded. In this file we define three especially-useful characterisations and provide
 proofs that they are indeed equivalent to well-foundedness.
@@ -47,7 +53,11 @@ This is demonstrated by means of the following four lemmas:
 complete lattice, well-founded, compact
 -/
 
-variables {α : Type*} [complete_lattice α]
+alias directed_on_range ↔ directed.directed_on_range _
+
+attribute [protected] directed.directed_on_range
+
+variables {ι : Sort*} {α : Type*} [complete_lattice α] {f : ι → α}
 
 namespace complete_lattice
 
@@ -69,6 +79,28 @@ above `k` has a finite subset with `Sup` above `k`.  Such an element is also cal
 def is_compact_element {α : Type*} [complete_lattice α] (k : α) :=
 ∀ s : set α, k ≤ Sup s → ∃ t : finset α, ↑t ⊆ s ∧ k ≤ t.sup id
 
+lemma {u} is_compact_element_iff {α : Type u} [complete_lattice α] (k : α) :
+  complete_lattice.is_compact_element k ↔
+    ∀ (ι : Type u) (s : ι → α), k ≤ supr s → ∃ t : finset ι, k ≤ t.sup s :=
+begin
+  classical,
+  split,
+  { intros H ι s hs,
+    obtain ⟨t, ht, ht'⟩ := H (set.range s) hs,
+    have : ∀ x : t, ∃ i, s i = x := λ x, ht x.prop,
+    choose f hf using this,
+    refine ⟨finset.univ.image f, ht'.trans _⟩,
+    { rw finset.sup_le_iff,
+      intros b hb,
+      rw ← (show s (f ⟨b, hb⟩) = id b, from hf _),
+      exact finset.le_sup (finset.mem_image_of_mem f $ finset.mem_univ ⟨b, hb⟩) } },
+  { intros H s hs,
+    obtain ⟨t, ht⟩ := H s coe (by { delta supr, rwa subtype.range_coe }),
+    refine ⟨t.image coe, by simp, ht.trans _⟩,
+    rw finset.sup_le_iff,
+    exact λ x hx, @finset.le_sup _ _ _ _ _ id _ (finset.mem_image_of_mem coe hx) }
+end
+
 /-- An element `k` is compact if and only if any directed set with `Sup` above
 `k` already got above `k` at some point in the set. -/
 theorem is_compact_element_iff_le_of_directed_Sup_le (k : α) :
@@ -112,6 +144,23 @@ begin
     use t, exact ⟨htS, by rwa ←htsup⟩, },
 end
 
+lemma is_compact_element.exists_finset_of_le_supr {k : α} (hk : is_compact_element k)
+  {ι : Type*} (f : ι → α) (h : k ≤ ⨆ i, f i) : ∃ s : finset ι, k ≤ ⨆ i ∈ s, f i :=
+begin
+  classical,
+  let g : finset ι → α := λ s, ⨆ i ∈ s, f i,
+  have h1 : directed_on (≤) (set.range g),
+  { rintros - ⟨s, rfl⟩ - ⟨t, rfl⟩,
+    exact ⟨g (s ∪ t), ⟨s ∪ t, rfl⟩, supr_le_supr_of_subset (finset.subset_union_left s t),
+      supr_le_supr_of_subset (finset.subset_union_right s t)⟩ },
+  have h2 : k ≤ Sup (set.range g),
+  { exact h.trans (supr_le (λ i, le_Sup_of_le ⟨{i}, rfl⟩ (le_supr_of_le i (le_supr_of_le
+      (finset.mem_singleton_self i) le_rfl)))) },
+  obtain ⟨-, ⟨s, rfl⟩, hs⟩ := (is_compact_element_iff_le_of_directed_Sup_le α k).mp hk
+    (set.range g) (set.range_nonempty g) h1 h2,
+  exact ⟨s, hs⟩,
+end
+
 /-- A compact element `k` has the property that any directed set lying strictly below `k` has
 its Sup strictly below `k`. -/
 lemma is_compact_element.directed_Sup_lt_of_lt {α : Type*} [complete_lattice α] {k : α}
@@ -133,7 +182,7 @@ begin
   classical,
   rw is_compact_element_iff_le_of_directed_Sup_le,
   intros d hemp hdir hsup,
-  change f with id ∘ f, rw ←finset.sup_finset_image,
+  change f with id ∘ f, rw ←finset.sup_image,
   apply finset.sup_le_of_le_directed d hemp hdir,
   rintros x hx,
   obtain ⟨p, ⟨hps, rfl⟩⟩ := finset.mem_image.mp hx,
@@ -145,18 +194,16 @@ end
 
 lemma well_founded.is_Sup_finite_compact (h : well_founded ((>) : α → α → Prop)) :
   is_Sup_finite_compact α :=
-begin
-  intros s,
-  let p : set α := { x | ∃ (t : finset α), ↑t ⊆ s ∧ t.sup id = x },
-  have hp : p.nonempty, { use [⊥, ∅], simp, },
-  obtain ⟨m, ⟨t, ⟨ht₁, ht₂⟩⟩, hm⟩ := well_founded.well_founded_iff_has_max'.mp h p hp,
-  use t, simp only [ht₁, ht₂, true_and], apply le_antisymm,
-  { apply Sup_le, intros y hy, classical,
-    have hy' : (insert y t).sup id ∈ p,
-    { use insert y t, simp, rw set.insert_subset, exact ⟨hy, ht₁⟩, },
-    have hm' : m ≤ (insert y t).sup id, { rw ← ht₂, exact finset.sup_mono (t.subset_insert y), },
-    rw ← hm _ hy' hm', simp, },
-  { rw [← ht₂, finset.sup_id_eq_Sup], exact Sup_le_Sup ht₁, },
+λ s, begin
+  obtain ⟨m, ⟨t, ⟨ht₁, rfl⟩⟩, hm⟩ := well_founded.well_founded_iff_has_min.mp h
+    {x | ∃ t : finset α, ↑t ⊆ s ∧ t.sup id = x} ⟨⊥, ∅, by simp⟩,
+  refine ⟨t, ht₁, (Sup_le (λ y hy, _)).antisymm _⟩,
+  { classical,
+    rw eq_of_le_of_not_lt (finset.sup_mono (t.subset_insert y))
+      (hm _ ⟨insert y t, by simp [set.insert_subset, hy, ht₁]⟩),
+    simp },
+  { rw finset.sup_id_eq_Sup,
+    exact Sup_le_Sup ht₁ },
 end
 
 lemma is_Sup_finite_compact.is_sup_closed_compact (h : is_Sup_finite_compact α) :
@@ -226,7 +273,35 @@ lemma is_sup_closed_compact_iff_well_founded :
 alias well_founded_iff_is_Sup_finite_compact ↔ _ is_Sup_finite_compact.well_founded
 alias is_Sup_finite_compact_iff_is_sup_closed_compact ↔
       _ is_sup_closed_compact.is_Sup_finite_compact
-alias is_sup_closed_compact_iff_well_founded ↔ _ well_founded.is_sup_closed_compact
+alias is_sup_closed_compact_iff_well_founded ↔ _ _root_.well_founded.is_sup_closed_compact
+
+variables {α}
+
+lemma well_founded.finite_of_set_independent (h : well_founded ((>) : α → α → Prop))
+  {s : set α} (hs : set_independent s) : s.finite :=
+begin
+  classical,
+  refine set.not_infinite.mp (λ contra, _),
+  obtain ⟨t, ht₁, ht₂⟩ := well_founded.is_Sup_finite_compact α h s,
+  replace contra : ∃ (x : α), x ∈ s ∧ x ≠ ⊥ ∧ x ∉ t,
+  { have : (s \ (insert ⊥ t : finset α)).infinite := contra.diff (finset.finite_to_set _),
+    obtain ⟨x, hx₁, hx₂⟩ := this.nonempty,
+    exact ⟨x, hx₁, by simpa [not_or_distrib] using hx₂⟩, },
+  obtain ⟨x, hx₀, hx₁, hx₂⟩ := contra,
+  replace hs : x ⊓ Sup s = ⊥,
+  { have := hs.mono (by simp [ht₁, hx₀, -set.union_singleton] : ↑t ∪ {x} ≤ s) (by simp : x ∈ _),
+    simpa [disjoint, hx₂, ← t.sup_id_eq_Sup, ← ht₂] using this.eq_bot, },
+  apply hx₁,
+  rw [← hs, eq_comm, inf_eq_left],
+  exact le_Sup hx₀,
+end
+
+lemma well_founded.finite_of_independent (hwf : well_founded ((>) : α → α → Prop))
+  {ι : Type*} {t : ι → α} (ht : independent t) (h_ne_bot : ∀ i, t i ≠ ⊥) : finite ι :=
+begin
+  haveI := (well_founded.finite_of_set_independent hwf ht.set_independent_range).to_subtype,
+  exact finite.of_injective_finite_range (ht.injective h_ne_bot),
+end
 
 end complete_lattice
 
@@ -262,8 +337,7 @@ theorem le_iff_compact_le_imp {a b : α} :
 end⟩
 
 /-- This property is sometimes referred to as `α` being upper continuous. -/
-theorem inf_Sup_eq_of_directed_on (h : directed_on (≤) s):
-  a ⊓ Sup s = ⨆ b ∈ s, a ⊓ b :=
+theorem directed_on.inf_Sup_eq (h : directed_on (≤) s) : a ⊓ Sup s = ⨆ b ∈ s, a ⊓ b :=
 le_antisymm (begin
   rw le_iff_compact_le_imp,
   by_cases hs : s.nonempty,
@@ -276,6 +350,32 @@ le_antisymm (begin
     simp [hs] }
 end) supr_inf_le_inf_Sup
 
+/-- This property is sometimes referred to as `α` being upper continuous. -/
+protected lemma directed_on.Sup_inf_eq (h : directed_on (≤) s) : Sup s ⊓ a = ⨆ b ∈ s, b ⊓ a :=
+by simp_rw [@inf_comm _ _ _ a, h.inf_Sup_eq]
+
+protected lemma directed.inf_supr_eq (h : directed (≤) f) : a ⊓ (⨆ i, f i) = ⨆ i, a ⊓ f i :=
+by rw [supr, h.directed_on_range.inf_Sup_eq, supr_range]
+
+protected lemma directed.supr_inf_eq (h : directed (≤) f) : (⨆ i, f i) ⊓ a = ⨆ i, f i ⊓ a :=
+by rw [supr, h.directed_on_range.Sup_inf_eq, supr_range]
+
+protected lemma directed_on.disjoint_Sup_right (h : directed_on (≤) s) :
+  disjoint a (Sup s) ↔ ∀ ⦃b⦄, b ∈ s → disjoint a b :=
+by simp_rw [disjoint_iff, h.inf_Sup_eq, supr_eq_bot]
+
+protected lemma directed_on.disjoint_Sup_left (h : directed_on (≤) s) :
+  disjoint (Sup s) a ↔ ∀ ⦃b⦄, b ∈ s → disjoint b a :=
+by simp_rw [disjoint_iff, h.Sup_inf_eq, supr_eq_bot]
+
+protected lemma directed.disjoint_supr_right (h : directed (≤) f) :
+  disjoint a (⨆ i, f i) ↔ ∀ i, disjoint a (f i) :=
+by simp_rw [disjoint_iff, h.inf_supr_eq, supr_eq_bot]
+
+protected lemma directed.disjoint_supr_left (h : directed (≤) f) :
+  disjoint (⨆ i, f i) a ↔ ∀ i, disjoint (f i) a :=
+by simp_rw [disjoint_iff, h.supr_inf_eq, supr_eq_bot]
+
 /-- This property is equivalent to `α` being upper continuous. -/
 theorem inf_Sup_eq_supr_inf_sup_finset :
   a ⊓ Sup s = ⨆ (t : finset α) (H : ↑t ⊆ s), a ⊓ (t.sup id) :=
@@ -357,7 +457,7 @@ theorem Iic_coatomic_of_compact_element {k : α} (h : is_compact_element k) :
     by_cases hS : S.nonempty,
     { exact ⟨Sup S, h.directed_Sup_lt_of_lt hS cC.directed_on SC, λ _, le_Sup⟩, },
     exact ⟨b, lt_of_le_of_ne hbk htriv, by simp only [set.not_nonempty_iff_eq_empty.mp hS,
-      set.mem_empty_eq, forall_const, forall_prop_of_false, not_false_iff]⟩, },
+      set.mem_empty_iff_false, forall_const, forall_prop_of_false, not_false_iff]⟩, },
 end⟩
 
 lemma coatomic_of_top_compact (h : is_compact_element (⊤ : α)) : is_coatomic α :=
@@ -369,7 +469,7 @@ section
 variables [is_modular_lattice α] [is_compactly_generated α]
 
 @[priority 100]
-instance is_atomic_of_is_complemented [is_complemented α] : is_atomic α :=
+instance is_atomic_of_complemented_lattice [complemented_lattice α] : is_atomic α :=
 ⟨λ b, begin
   by_cases h : {c : α | complete_lattice.is_compact_element c ∧ c ≤ b} ⊆ {⊥},
   { left,
@@ -389,9 +489,9 @@ instance is_atomic_of_is_complemented [is_complemented α] : is_atomic α :=
     exact ⟨a, ha.of_is_atom_coe_Iic, hac.trans hcb⟩ },
 end⟩
 
-/-- See Lemma 5.1, Călugăreanu -/
+/-- See [Lemma 5.1][calugareanu]. -/
 @[priority 100]
-instance is_atomistic_of_is_complemented [is_complemented α] : is_atomistic α :=
+instance is_atomistic_of_complemented_lattice [complemented_lattice α] : is_atomistic α :=
 ⟨λ b, ⟨{a | is_atom a ∧ a ≤ b}, begin
   symmetry,
   have hle : Sup {a : α | is_atom a ∧ a ≤ b} ≤ b := (Sup_le $ λ _, and.right),
@@ -401,72 +501,83 @@ instance is_atomistic_of_is_complemented [is_complemented α] : is_atomistic α
   { exact ne_of_lt con (subtype.ext_iff.1 (eq_top_of_is_compl_bot hc)) },
   { apply ha.1,
     rw eq_bot_iff,
-    apply le_trans (le_inf _ hac) hc.1,
+    apply le_trans (le_inf _ hac) hc.disjoint.le_bot,
     rw [← subtype.coe_le_coe, subtype.coe_mk],
     exact le_Sup ⟨ha.of_is_atom_coe_Iic, a.2⟩ }
 end, λ _, and.left⟩⟩
 
-/-- See Theorem 6.6, Călugăreanu -/
-theorem is_complemented_of_Sup_atoms_eq_top (h : Sup {a : α | is_atom a} = ⊤) : is_complemented α :=
-⟨λ b, begin
+/-!
+Now we will prove that a compactly generated modular atomistic lattice is a complemented lattice.
+Most explicitly, every element is the complement of a supremum of indepedendent atoms.
+-/
+
+/-- In an atomic lattice, every element `b` has a complement of the form `Sup s`, where each element
+of `s` is an atom. See also `complemented_lattice_of_Sup_atoms_eq_top`. -/
+lemma exists_set_independent_is_compl_Sup_atoms (h : Sup {a : α | is_atom a} = ⊤) (b : α) :
+  ∃ s : set α, complete_lattice.set_independent s ∧ is_compl b (Sup s) ∧ ∀ ⦃a⦄, a ∈ s → is_atom a :=
+begin
   obtain ⟨s, ⟨s_ind, b_inf_Sup_s, s_atoms⟩, s_max⟩ := zorn_subset
-    {s : set α | complete_lattice.set_independent s ∧ b ⊓ Sup s = ⊥ ∧ ∀ a ∈ s, is_atom a} _,
-  { refine ⟨Sup s, le_of_eq b_inf_Sup_s, _⟩,
-    rw [← h, Sup_le_iff],
-    intros a ha,
-    rw ← inf_eq_left,
-    refine (eq_bot_or_eq_of_le_atom ha inf_le_left).resolve_left (λ con, ha.1 _),
-    rw [eq_bot_iff, ← con],
-    refine le_inf (le_refl a) ((le_Sup _).trans le_sup_right),
-    rw ← disjoint_iff at *,
-    have a_dis_Sup_s : disjoint a (Sup s) := con.mono_right le_sup_right,
-    rw ← s_max (s ∪ {a}) ⟨λ x hx, _, ⟨_, λ x hx, _⟩⟩ (set.subset_union_left _ _),
-    { exact set.mem_union_right _ (set.mem_singleton _) },
-    { rw [set.mem_union, set.mem_singleton_iff] at hx,
-      by_cases xa : x = a,
-      { simp only [xa, set.mem_singleton, set.insert_diff_of_mem, set.union_singleton],
-        exact con.mono_right (le_trans (Sup_le_Sup (set.diff_subset s {a})) le_sup_right) },
-      { have h : (s ∪ {a}) \ {x} = (s \ {x}) ∪ {a},
-        { simp only [set.union_singleton],
-          rw set.insert_diff_of_not_mem,
-          rw set.mem_singleton_iff,
-          exact ne.symm xa },
-        rw [h, Sup_union, Sup_singleton],
-        apply (s_ind (hx.resolve_right xa)).disjoint_sup_right_of_disjoint_sup_left
-          (a_dis_Sup_s.mono_right _).symm,
-        rw [← Sup_insert, set.insert_diff_singleton,
-          set.insert_eq_of_mem (hx.resolve_right xa)] } },
-    { rw [Sup_union, Sup_singleton, ← disjoint_iff],
-      exact b_inf_Sup_s.disjoint_sup_right_of_disjoint_sup_left con.symm },
-    { rw [set.mem_union, set.mem_singleton_iff] at hx,
-      cases hx,
-      { exact s_atoms x hx },
-      { rw hx,
-        exact ha } } },
-  { intros c hc1 hc2,
-    refine ⟨⋃₀ c, ⟨complete_lattice.independent_sUnion_of_directed hc2.directed_on
-      (λ s hs, (hc1 hs).1), _, λ a ha, _⟩, λ _, set.subset_sUnion_of_mem⟩,
-    { rw [Sup_sUnion, ← Sup_image, inf_Sup_eq_of_directed_on, supr_eq_bot],
-      { intro i,
-        rw supr_eq_bot,
-        intro hi,
-        obtain ⟨x, xc, rfl⟩ := (set.mem_image _ _ _).1 hi,
-        exact (hc1 xc).2.1 },
-      { rw directed_on_image,
-        refine hc2.directed_on.mono (λ s t, Sup_le_Sup) } },
-    { rcases set.mem_sUnion.1 ha with ⟨s, sc, as⟩,
-      exact (hc1 sc).2.2 a as } }
-end⟩
+    {s : set α | complete_lattice.set_independent s ∧ disjoint b (Sup s) ∧ ∀ a ∈ s, is_atom a}
+    (λ c hc1 hc2, ⟨⋃₀ c, ⟨complete_lattice.independent_sUnion_of_directed hc2.directed_on
+      (λ s hs, (hc1 hs).1), _, λ a ⟨s, sc, as⟩, (hc1 sc).2.2 a as⟩, λ _, set.subset_sUnion_of_mem⟩),
+  swap,
+  { rw [Sup_sUnion, ← Sup_image, directed_on.disjoint_Sup_right],
+    { rintro _ ⟨s, hs, rfl⟩,
+      exact (hc1 hs).2.1 },
+    { rw directed_on_image,
+      exact hc2.directed_on.mono (λ s t, Sup_le_Sup) } },
+  refine ⟨s, s_ind, ⟨b_inf_Sup_s, _⟩, s_atoms⟩,
+  rw [codisjoint_iff_le_sup, ←h, Sup_le_iff],
+  intros a ha,
+  rw ← inf_eq_left,
+  refine (ha.le_iff.mp inf_le_left).resolve_left (λ con, ha.1 _),
+  rw [←con, eq_comm, inf_eq_left],
+  refine (le_Sup _).trans le_sup_right,
+  rw ← disjoint_iff at con,
+  have a_dis_Sup_s : disjoint a (Sup s) := con.mono_right le_sup_right,
+  rw ← s_max (s ∪ {a}) ⟨λ x hx, _, ⟨_, λ x hx, _⟩⟩ (set.subset_union_left _ _),
+  { exact set.mem_union_right _ (set.mem_singleton _) },
+  { rw [set.mem_union, set.mem_singleton_iff] at hx,
+    obtain rfl | xa := eq_or_ne x a,
+    { simp only [set.mem_singleton, set.insert_diff_of_mem, set.union_singleton],
+      exact con.mono_right ((Sup_le_Sup $ set.diff_subset _ _).trans le_sup_right) },
+    { have h : (s ∪ {a}) \ {x} = (s \ {x}) ∪ {a},
+      { simp only [set.union_singleton],
+        rw set.insert_diff_of_not_mem,
+        rw set.mem_singleton_iff,
+        exact ne.symm xa },
+      rw [h, Sup_union, Sup_singleton],
+      apply (s_ind (hx.resolve_right xa)).disjoint_sup_right_of_disjoint_sup_left
+        (a_dis_Sup_s.mono_right _).symm,
+      rw [← Sup_insert, set.insert_diff_singleton,
+        set.insert_eq_of_mem (hx.resolve_right xa)] } },
+  { rw [Sup_union, Sup_singleton],
+    exact b_inf_Sup_s.disjoint_sup_right_of_disjoint_sup_left con.symm },
+  { rw [set.mem_union, set.mem_singleton_iff] at hx,
+    obtain hx | rfl := hx,
+    { exact s_atoms x hx },
+    { exact ha } }
+end
+
+lemma exists_set_independent_of_Sup_atoms_eq_top (h : Sup {a : α | is_atom a} = ⊤) :
+  ∃ s : set α, complete_lattice.set_independent s ∧ Sup s = ⊤ ∧ ∀ ⦃a⦄, a ∈ s → is_atom a :=
+let ⟨s, s_ind, s_top, s_atoms⟩ := exists_set_independent_is_compl_Sup_atoms h ⊥ in
+  ⟨s, s_ind, eq_top_of_is_compl_bot s_top.symm, s_atoms⟩
+
+/-- See [Theorem 6.6][calugareanu]. -/
+theorem complemented_lattice_of_Sup_atoms_eq_top (h : Sup {a : α | is_atom a} = ⊤) :
+  complemented_lattice α :=
+⟨λ b, let ⟨s, _, s_top, s_atoms⟩ := exists_set_independent_is_compl_Sup_atoms h b in ⟨Sup s, s_top⟩⟩
 
-/-- See Theorem 6.6, Călugăreanu -/
-theorem is_complemented_of_is_atomistic [is_atomistic α] : is_complemented α :=
-is_complemented_of_Sup_atoms_eq_top Sup_atoms_eq_top
+/-- See [Theorem 6.6][calugareanu]. -/
+theorem complemented_lattice_of_is_atomistic [is_atomistic α] : complemented_lattice α :=
+complemented_lattice_of_Sup_atoms_eq_top Sup_atoms_eq_top
 
-theorem is_complemented_iff_is_atomistic : is_complemented α ↔ is_atomistic α :=
+theorem complemented_lattice_iff_is_atomistic : complemented_lattice α ↔ is_atomistic α :=
 begin
   split; introsI,
-  { exact is_atomistic_of_is_complemented },
-  { exact is_complemented_of_is_atomistic }
+  { exact is_atomistic_of_complemented_lattice },
+  { exact complemented_lattice_of_is_atomistic }
 end
 
 end
diff --git a/src/order/compare.lean b/src/order/compare.lean
index f8d35efda182f..92fb96f856652 100644
--- a/src/order/compare.lean
+++ b/src/order/compare.lean
@@ -3,11 +3,14 @@ Copyright (c) 2017 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
-import order.order_dual
+import order.synonym
 
 /-!
 # Comparison
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides basic results about orderings and comparison in linear orders.
 
 
@@ -56,25 +59,25 @@ lemma compares_swap [has_lt α] {a b : α} {o : ordering} :
   o.swap.compares a b ↔ o.compares b a :=
 by { cases o, exacts [iff.rfl, eq_comm, iff.rfl] }
 
-alias compares_swap ↔ ordering.compares.of_swap ordering.compares.swap
+alias compares_swap ↔ compares.of_swap compares.swap
+
+@[simp] theorem swap_inj (o₁ o₂ : ordering) : o₁.swap = o₂.swap ↔ o₁ = o₂ :=
+by cases o₁; cases o₂; dec_trivial
 
 lemma swap_eq_iff_eq_swap {o o' : ordering} : o.swap = o' ↔ o = o'.swap :=
-⟨λ h, by rw [← swap_swap o, h], λ h, by rw [← swap_swap o', h]⟩
+by rw [←swap_inj, swap_swap]
 
-lemma compares.eq_lt [preorder α] :
-  ∀ {o} {a b : α}, compares o a b → (o = lt ↔ a < b)
+lemma compares.eq_lt [preorder α] : ∀ {o} {a b : α}, compares o a b → (o = lt ↔ a < b)
 | lt a b h := ⟨λ _, h, λ _, rfl⟩
 | eq a b h := ⟨λ h, by injection h, λ h', (ne_of_lt h' h).elim⟩
 | gt a b h := ⟨λ h, by injection h, λ h', (lt_asymm h h').elim⟩
 
-lemma compares.ne_lt [preorder α] :
-  ∀ {o} {a b : α}, compares o a b → (o ≠ lt ↔ b ≤ a)
+lemma compares.ne_lt [preorder α] : ∀ {o} {a b : α}, compares o a b → (o ≠ lt ↔ b ≤ a)
 | lt a b h := ⟨absurd rfl, λ h', (not_le_of_lt h h').elim⟩
 | eq a b h := ⟨λ _, ge_of_eq h, λ _ h, by injection h⟩
 | gt a b h := ⟨λ _, le_of_lt h, λ _ h, by injection h⟩
 
-lemma compares.eq_eq [preorder α] :
-  ∀ {o} {a b : α}, compares o a b → (o = eq ↔ a = b)
+lemma compares.eq_eq [preorder α] : ∀ {o} {a b : α}, compares o a b → (o = eq ↔ a = b)
 | lt a b h := ⟨λ h, by injection h, λ h', (ne_of_lt h h').elim⟩
 | eq a b h := ⟨λ _, h, λ _, rfl⟩
 | gt a b h := ⟨λ h, by injection h, λ h', (ne_of_gt h h').elim⟩
@@ -85,20 +88,17 @@ swap_eq_iff_eq_swap.symm.trans h.swap.eq_lt
 lemma compares.ne_gt [preorder α] {o} {a b : α} (h : compares o a b) : (o ≠ gt ↔ a ≤ b) :=
 (not_congr swap_eq_iff_eq_swap.symm).trans h.swap.ne_lt
 
-lemma compares.le_total [preorder α] {a b : α} :
-  ∀ {o}, compares o a b → a ≤ b ∨ b ≤ a
+lemma compares.le_total [preorder α] {a b : α} : ∀ {o}, compares o a b → a ≤ b ∨ b ≤ a
 | lt h := or.inl (le_of_lt h)
 | eq h := or.inl (le_of_eq h)
 | gt h := or.inr (le_of_lt h)
 
-lemma compares.le_antisymm [preorder α] {a b : α} :
-  ∀ {o}, compares o a b → a ≤ b → b ≤ a → a = b
+lemma compares.le_antisymm [preorder α] {a b : α} : ∀ {o}, compares o a b → a ≤ b → b ≤ a → a = b
 | lt h _ hba := (not_le_of_lt h hba).elim
 | eq h _ _   := h
 | gt h hab _ := (not_le_of_lt h hab).elim
 
-lemma compares.inj [preorder α] {o₁} :
-  ∀ {o₂} {a b : α}, compares o₁ a b → compares o₂ a b → o₁ = o₂
+lemma compares.inj [preorder α] {o₁} : ∀ {o₂} {a b : α}, compares o₁ a b → compares o₂ a b → o₁ = o₂
 | lt a b h₁ h₂ := h₁.eq_lt.2 h₂
 | eq a b h₁ h₂ := h₁.eq_eq.2 h₂
 | gt a b h₁ h₂ := h₁.eq_gt.2 h₂
@@ -139,15 +139,28 @@ by { cases o, exacts [iff.rfl, eq_comm, iff.rfl] }
 lemma cmp_compares [linear_order α] (a b : α) : (cmp a b).compares a b :=
 by obtain h | h | h := lt_trichotomy a b; simp [cmp, cmp_using, h, h.not_lt]
 
-lemma cmp_swap [preorder α] [@decidable_rel α (<)] (a b : α) : (cmp a b).swap = cmp b a :=
+lemma ordering.compares.cmp_eq [linear_order α] {a b : α} {o : ordering} (h : o.compares a b) :
+  cmp a b = o :=
+(cmp_compares a b).inj h
+
+@[simp] lemma cmp_swap [preorder α] [@decidable_rel α (<)] (a b : α) : (cmp a b).swap = cmp b a :=
 begin
   unfold cmp cmp_using,
   by_cases a < b; by_cases h₂ : b < a; simp [h, h₂, ordering.swap],
   exact lt_asymm h h₂
 end
 
-lemma order_dual.cmp_le_flip {α} [has_le α] [@decidable_rel α (≤)] (x y : α) :
-  @cmp_le αᵒᵈ _ _ x y = cmp_le y x := rfl
+@[simp] lemma cmp_le_to_dual [has_le α] [@decidable_rel α (≤)] (x y : α) :
+  cmp_le (to_dual x) (to_dual y) = cmp_le y x := rfl
+
+@[simp] lemma cmp_le_of_dual [has_le α] [@decidable_rel α (≤)] (x y : αᵒᵈ) :
+  cmp_le (of_dual x) (of_dual y) = cmp_le y x := rfl
+
+@[simp] lemma cmp_to_dual [has_lt α] [@decidable_rel α (<)] (x y : α) :
+  cmp (to_dual x) (to_dual y) = cmp y x := rfl
+
+@[simp] lemma cmp_of_dual [has_lt α] [@decidable_rel α (<)] (x y : αᵒᵈ) :
+  cmp (of_dual x) (of_dual y) = cmp y x := rfl
 
 /-- Generate a linear order structure from a preorder and `cmp` function. -/
 def linear_order_of_compares [preorder α] (cmp : α → α → ordering)
@@ -177,8 +190,7 @@ by rw cmp_eq_eq_iff
 variables {x y} {β : Type*} [linear_order β] {x' y' : β}
 
 lemma cmp_eq_cmp_symm : cmp x y = cmp x' y' ↔ cmp y x = cmp y' x' :=
-by { split, rw [←cmp_swap _ y, ←cmp_swap _ y'], cc,
-  rw [←cmp_swap _ x, ←cmp_swap _ x'], cc, }
+by rw [←cmp_swap x', ←cmp_swap x, swap_inj]
 
 lemma lt_iff_lt_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x < y ↔ x' < y' :=
 by rw [←cmp_eq_lt_iff, ←cmp_eq_lt_iff, h]
@@ -187,6 +199,10 @@ lemma le_iff_le_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x ≤ y ↔ x' ≤ y'
 by { rw [←not_lt, ←not_lt], apply not_congr,
   apply lt_iff_lt_of_cmp_eq_cmp, rwa cmp_eq_cmp_symm }
 
+lemma eq_iff_eq_of_cmp_eq_cmp (h : cmp x y = cmp x' y') : x = y ↔ x' = y' :=
+by rw [le_antisymm_iff, le_antisymm_iff, le_iff_le_of_cmp_eq_cmp h,
+  le_iff_le_of_cmp_eq_cmp (cmp_eq_cmp_symm.1 h)]
+
 lemma has_lt.lt.cmp_eq_lt (h : x < y) : cmp x y = ordering.lt := (cmp_eq_lt_iff _ _).2 h
 lemma has_lt.lt.cmp_eq_gt (h : x < y) : cmp y x = ordering.gt := (cmp_eq_gt_iff _ _).2 h
 lemma eq.cmp_eq_eq (h : x = y) : cmp x y = ordering.eq := (cmp_eq_eq_iff _ _).2 h
diff --git a/src/order/complete_boolean_algebra.lean b/src/order/complete_boolean_algebra.lean
index d084d45c86a3a..dd590f754bc04 100644
--- a/src/order/complete_boolean_algebra.lean
+++ b/src/order/complete_boolean_algebra.lean
@@ -4,10 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Yaël Dillies
 -/
 import order.complete_lattice
+import order.directed
+import logic.equiv.set
 
 /-!
 # Frames, completely distributive lattices and Boolean algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define and provide API for frames, completely distributive lattices and completely
 distributive Boolean algebras.
 
@@ -105,18 +110,47 @@ by simp only [disjoint_iff, supr_inf_eq, supr_eq_bot]
 lemma disjoint_supr_iff {f : ι → α} : disjoint a (⨆ i, f i) ↔ ∀ i, disjoint a (f i) :=
 by simpa only [disjoint.comm] using supr_disjoint_iff
 
+lemma supr₂_disjoint_iff {f : Π i, κ i → α} :
+  disjoint (⨆ i j, f i j) a ↔ ∀ i j, disjoint (f i j) a :=
+by simp_rw supr_disjoint_iff
+
+lemma disjoint_supr₂_iff {f : Π i, κ i → α} :
+  disjoint a (⨆ i j, f i j) ↔ ∀ i j, disjoint a (f i j) :=
+by simp_rw disjoint_supr_iff
+
 lemma Sup_disjoint_iff {s : set α} : disjoint (Sup s) a ↔ ∀ b ∈ s, disjoint b a :=
 by simp only [disjoint_iff, Sup_inf_eq, supr_eq_bot]
 
 lemma disjoint_Sup_iff {s : set α} : disjoint a (Sup s) ↔ ∀ b ∈ s, disjoint a b :=
 by simpa only [disjoint.comm] using Sup_disjoint_iff
 
+lemma supr_inf_of_monotone {ι : Type*} [preorder ι] [is_directed ι (≤)] {f g : ι → α}
+  (hf : monotone f) (hg : monotone g) :
+  (⨆ i, f i ⊓ g i) = (⨆ i, f i) ⊓ (⨆ i, g i) :=
+begin
+  refine (le_supr_inf_supr f g).antisymm _,
+  rw [supr_inf_supr],
+  refine supr_mono' (λ i, _),
+  rcases directed_of (≤) i.1 i.2 with ⟨j, h₁, h₂⟩,
+  exact ⟨j, inf_le_inf (hf h₁) (hg h₂)⟩
+end
+
+lemma supr_inf_of_antitone {ι : Type*} [preorder ι] [is_directed ι (swap (≤))] {f g : ι → α}
+  (hf : antitone f) (hg : antitone g) :
+  (⨆ i, f i ⊓ g i) = (⨆ i, f i) ⊓ (⨆ i, g i) :=
+@supr_inf_of_monotone α _ ιᵒᵈ _ _ f g hf.dual_left hg.dual_left
+
 instance pi.frame {ι : Type*} {π : ι → Type*} [Π i, frame (π i)] : frame (Π i, π i) :=
 { inf_Sup_le_supr_inf := λ a s i,
     by simp only [complete_lattice.Sup, Sup_apply, supr_apply, pi.inf_apply, inf_supr_eq,
       ← supr_subtype''],
   ..pi.complete_lattice }
 
+@[priority 100] -- see Note [lower instance priority]
+instance frame.to_distrib_lattice : distrib_lattice α :=
+distrib_lattice.of_inf_sup_le $ λ a b c,
+  by rw [←Sup_pair, ←Sup_pair, inf_Sup_eq, ←Sup_image, image_pair]
+
 end frame
 
 section coframe
@@ -148,12 +182,27 @@ lemma binfi_sup_binfi {ι ι' : Type*} {f : ι → α} {g : ι' → α} {s : set
 theorem Inf_sup_Inf : Inf s ⊔ Inf t = (⨅ p ∈ s ×ˢ t, (p : α × α).1 ⊔ p.2) :=
 @Sup_inf_Sup αᵒᵈ _ _ _
 
+lemma infi_sup_of_monotone {ι : Type*} [preorder ι] [is_directed ι (swap (≤))] {f g : ι → α}
+  (hf : monotone f) (hg : monotone g) :
+  (⨅ i, f i ⊔ g i) = (⨅ i, f i) ⊔ (⨅ i, g i) :=
+supr_inf_of_antitone hf.dual_right hg.dual_right
+
+lemma infi_sup_of_antitone {ι : Type*} [preorder ι] [is_directed ι (≤)] {f g : ι → α}
+  (hf : antitone f) (hg : antitone g) :
+  (⨅ i, f i ⊔ g i) = (⨅ i, f i) ⊔ (⨅ i, g i) :=
+supr_inf_of_monotone hf.dual_right hg.dual_right
+
 instance pi.coframe {ι : Type*} {π : ι → Type*} [Π i, coframe (π i)] : coframe (Π i, π i) :=
 { Inf := Inf,
   infi_sup_le_sup_Inf := λ a s i,
     by simp only [←sup_infi_eq, Inf_apply, ←infi_subtype'', infi_apply, pi.sup_apply],
   ..pi.complete_lattice }
 
+@[priority 100] -- see Note [lower instance priority]
+instance coframe.to_distrib_lattice : distrib_lattice α :=
+{ le_sup_inf := λ a b c, by rw [←Inf_pair, ←Inf_pair, sup_Inf_eq, ←Inf_image, image_pair],
+  ..‹coframe α› }
+
 end coframe
 
 section complete_distrib_lattice
@@ -167,12 +216,6 @@ instance pi.complete_distrib_lattice {ι : Type*} {π : ι → Type*}
 
 end complete_distrib_lattice
 
-@[priority 100] -- see Note [lower instance priority]
-instance complete_distrib_lattice.to_distrib_lattice [d : complete_distrib_lattice α] :
-  distrib_lattice α :=
-{ le_sup_inf := λ x y z, by rw [← Inf_pair, ← Inf_pair, sup_Inf_eq, ← Inf_image, set.image_pair],
-  ..d }
-
 /-- A complete Boolean algebra is a completely distributive Boolean algebra. -/
 class complete_boolean_algebra α extends boolean_algebra α, complete_distrib_lattice α
 
@@ -261,3 +304,18 @@ protected def function.injective.complete_boolean_algebra [has_sup α] [has_inf
   ..hf.boolean_algebra f map_sup map_inf map_top map_bot map_compl map_sdiff }
 
 end lift
+
+namespace punit
+variables (s : set punit.{u+1}) (x y : punit.{u+1})
+
+instance : complete_boolean_algebra punit :=
+by refine_struct
+{ Sup := λ _, star,
+  Inf := λ _, star,
+  ..punit.boolean_algebra };
+    intros; trivial <|> simp only [eq_iff_true_of_subsingleton, not_true, and_false]
+
+@[simp] lemma Sup_eq : Sup s = star := rfl
+@[simp] lemma Inf_eq : Inf s = star := rfl
+
+end punit
diff --git a/src/order/complete_lattice.lean b/src/order/complete_lattice.lean
index e67a577f6f81f..32a017dad7375 100644
--- a/src/order/complete_lattice.lean
+++ b/src/order/complete_lattice.lean
@@ -4,12 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 import data.bool.set
-import data.nat.basic
-import order.bounds
+import data.nat.set
+import data.ulift
+import order.bounds.basic
+import order.hom.basic
 
 /-!
 # Theory of complete lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `Sup` and `Inf` are the supremum and the infimum of a set;
@@ -40,9 +45,9 @@ In lemma names,
 -/
 
 set_option old_structure_cmd true
-open set function
+open function order_dual set
 
-variables {α β β₂ : Type*} {ι ι' : Sort*} {κ : ι → Sort*} {κ' : ι' → Sort*}
+variables {α β β₂ γ : Type*} {ι ι' : Sort*} {κ : ι → Sort*} {κ' : ι' → Sort*}
 
 /-- class for the `Sup` operator -/
 class has_Sup (α : Type*) := (Sup : set α → α)
@@ -293,24 +298,32 @@ instance [complete_linear_order α] : complete_linear_order αᵒᵈ :=
 
 end order_dual
 
+open order_dual
+
 section
 variables [complete_lattice α] {s t : set α} {a b : α}
 
+@[simp] lemma to_dual_Sup (s : set α) : to_dual (Sup s) = Inf (of_dual ⁻¹' s) := rfl
+@[simp] lemma to_dual_Inf (s : set α) : to_dual (Inf s) = Sup (of_dual ⁻¹' s) := rfl
+@[simp] lemma of_dual_Sup (s : set αᵒᵈ) : of_dual (Sup s) = Inf (to_dual ⁻¹' s) := rfl
+@[simp] lemma of_dual_Inf (s : set αᵒᵈ) : of_dual (Inf s) = Sup (to_dual ⁻¹' s) := rfl
+@[simp] lemma to_dual_supr (f : ι → α) : to_dual (⨆ i, f i) = ⨅ i, to_dual (f i) := rfl
+@[simp] lemma to_dual_infi (f : ι → α) : to_dual (⨅ i, f i) = ⨆ i, to_dual (f i) := rfl
+@[simp] lemma of_dual_supr (f : ι → αᵒᵈ) : of_dual (⨆ i, f i) = ⨅ i, of_dual (f i) := rfl
+@[simp] lemma of_dual_infi (f : ι → αᵒᵈ) : of_dual (⨅ i, f i) = ⨆ i, of_dual (f i) := rfl
+
 theorem Inf_le_Sup (hs : s.nonempty) : Inf s ≤ Sup s :=
 is_glb_le_is_lub (is_glb_Inf s) (is_lub_Sup s) hs
 
 theorem Sup_union {s t : set α} : Sup (s ∪ t) = Sup s ⊔ Sup t :=
 ((is_lub_Sup s).union (is_lub_Sup t)).Sup_eq
 
-theorem Sup_inter_le {s t : set α} : Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
-Sup_le $ λ b hb, le_inf (le_Sup hb.1) (le_Sup hb.2)
-/-
-  Sup_le (λ a ⟨a_s, a_t⟩, le_inf (le_Sup a_s) (le_Sup a_t))
--/
-
 theorem Inf_union {s t : set α} : Inf (s ∪ t) = Inf s ⊓ Inf t :=
 ((is_glb_Inf s).union (is_glb_Inf t)).Inf_eq
 
+theorem Sup_inter_le {s t : set α} : Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
+Sup_le $ λ b hb, le_inf (le_Sup hb.1) (le_Sup hb.2)
+
 theorem le_Inf_inter {s t : set α} : Inf s ⊔ Inf t ≤ Inf (s ∩ t) := @Sup_inter_le αᵒᵈ _ _ _
 
 @[simp] theorem Sup_empty : Sup ∅ = (⊥ : α) :=
@@ -338,62 +351,59 @@ le_trans (Sup_le_Sup h) (le_of_eq (trans Sup_insert bot_sup_eq))
 theorem Inf_le_Inf_of_subset_insert_top (h : s ⊆ insert ⊤ t) : Inf t ≤ Inf s :=
 le_trans (le_of_eq (trans top_inf_eq.symm Inf_insert.symm)) (Inf_le_Inf h)
 
+@[simp] theorem Sup_diff_singleton_bot (s : set α) : Sup (s \ {⊥}) = Sup s :=
+(Sup_le_Sup (diff_subset _ _)).antisymm $ Sup_le_Sup_of_subset_insert_bot $
+  subset_insert_diff_singleton _ _
+
+@[simp] theorem Inf_diff_singleton_top (s : set α) : Inf (s \ {⊤}) = Inf s :=
+@Sup_diff_singleton_bot αᵒᵈ _ s
+
 theorem Sup_pair {a b : α} : Sup {a, b} = a ⊔ b :=
 (@is_lub_pair α _ a b).Sup_eq
 
 theorem Inf_pair {a b : α} : Inf {a, b} = a ⊓ b :=
 (@is_glb_pair α _ a b).Inf_eq
 
-@[simp] theorem Inf_eq_top : Inf s = ⊤ ↔ (∀ a ∈ s, a = ⊤) :=
-iff.intro
-  (λ h a ha, top_unique $ h ▸ Inf_le ha)
-  (λ h, top_unique $ le_Inf $ λ a ha, top_le_iff.2 $ h a ha)
-
-lemma eq_singleton_top_of_Inf_eq_top_of_nonempty {s : set α}
-  (h_inf : Inf s = ⊤) (hne : s.nonempty) : s = {⊤} :=
-by { rw set.eq_singleton_iff_nonempty_unique_mem, rw Inf_eq_top at h_inf, exact ⟨hne, h_inf⟩, }
+@[simp] lemma Sup_eq_bot : Sup s = ⊥ ↔ ∀ a ∈ s, a = ⊥ :=
+⟨λ h a ha, bot_unique $ h ▸ le_Sup ha,
+  λ h, bot_unique $ Sup_le $ λ a ha, le_bot_iff.2 $ h a ha⟩
 
-@[simp] lemma Sup_eq_bot : Sup s = ⊥ ↔ ∀ a ∈ s, a = ⊥ := @Inf_eq_top αᵒᵈ _ _
+@[simp] lemma Inf_eq_top : Inf s = ⊤ ↔ ∀ a ∈ s, a = ⊤ := @Sup_eq_bot αᵒᵈ _ _
 
 lemma eq_singleton_bot_of_Sup_eq_bot_of_nonempty {s : set α}
   (h_sup : Sup s = ⊥) (hne : s.nonempty) : s = {⊥} :=
 by { rw set.eq_singleton_iff_nonempty_unique_mem, rw Sup_eq_bot at h_sup, exact ⟨hne, h_sup⟩, }
 
+lemma eq_singleton_top_of_Inf_eq_top_of_nonempty : Inf s = ⊤ → s.nonempty → s = {⊤} :=
+@eq_singleton_bot_of_Sup_eq_bot_of_nonempty αᵒᵈ _ _
+
 /--Introduction rule to prove that `b` is the supremum of `s`: it suffices to check that `b`
 is larger than all elements of `s`, and that this is not the case of any `w < b`.
 See `cSup_eq_of_forall_le_of_forall_lt_exists_gt` for a version in conditionally complete
 lattices. -/
-theorem Sup_eq_of_forall_le_of_forall_lt_exists_gt (_ : ∀a∈s, a ≤ b)
-  (H : ∀w, w < b → (∃a∈s, w < a)) : Sup s = b :=
-have h : (Sup s < b) ∨ (Sup s = b) := lt_or_eq_of_le (Sup_le ‹∀a∈s, a ≤ b›),
-have ¬(Sup s < b) := λ hb,
-  let ⟨a, ha, ha'⟩ := H (Sup s) hb in  /- a ∈ s, Sup s < a-/
-  have Sup s < Sup s := lt_of_lt_of_le ha' (le_Sup ha),
-  show false, from lt_irrefl _ this,
-show Sup s = b, from or.resolve_left h this
+theorem Sup_eq_of_forall_le_of_forall_lt_exists_gt (h₁ : ∀ a ∈ s, a ≤ b)
+  (h₂ : ∀ w, w < b → ∃ a ∈ s, w < a) : Sup s = b :=
+(Sup_le h₁).eq_of_not_lt $ λ h, let ⟨a, ha, ha'⟩ := h₂ _ h in ((le_Sup ha).trans_lt ha').false
 
 /--Introduction rule to prove that `b` is the infimum of `s`: it suffices to check that `b`
 is smaller than all elements of `s`, and that this is not the case of any `w > b`.
 See `cInf_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in conditionally complete
 lattices. -/
-theorem Inf_eq_of_forall_ge_of_forall_gt_exists_lt : (∀ a ∈ s, b ≤ a) →
-  (∀ w, b < w → (∃ a ∈ s, a < w)) → Inf s = b :=
-@Sup_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ ‹_›
+theorem Inf_eq_of_forall_ge_of_forall_gt_exists_lt :
+  (∀ a ∈ s, b ≤ a) → (∀ w, b < w → ∃ a ∈ s, a < w) → Inf s = b :=
+@Sup_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _
 
 end
 
 section complete_linear_order
 variables [complete_linear_order α] {s t : set α} {a b : α}
 
-lemma Inf_lt_iff : Inf s < b ↔ ∃ a ∈ s, a < b := is_glb_lt_iff $ is_glb_Inf s
 lemma lt_Sup_iff : b < Sup s ↔ ∃ a ∈ s, b < a := lt_is_lub_iff $ is_lub_Sup s
+lemma Inf_lt_iff : Inf s < b ↔ ∃ a ∈ s, a < b := is_glb_lt_iff $ is_glb_Inf s
 
-lemma Sup_eq_top : Sup s = ⊤ ↔ (∀ b < ⊤, ∃ a ∈ s, b < a) :=
-iff.intro
-  (λ (h : Sup s = ⊤) b hb, by rwa [←h, lt_Sup_iff] at hb)
-  (λ h, top_unique $ le_of_not_gt $ λ h',
-    let ⟨a, ha, h⟩ := h _ h' in
-    lt_irrefl a $ lt_of_le_of_lt (le_Sup ha) h)
+lemma Sup_eq_top : Sup s = ⊤ ↔ ∀ b < ⊤, ∃ a ∈ s, b < a :=
+⟨λ h b hb, lt_Sup_iff.1 $ hb.trans_eq h.symm,
+  λ h, top_unique $ le_of_not_gt $ λ h', let ⟨a, ha, h⟩ := h _ h' in (h.trans_le $ le_Sup ha).false⟩
 
 lemma Inf_eq_bot : Inf s = ⊥ ↔ ∀ b > ⊥, ∃ a ∈ s, a < b := @Sup_eq_top αᵒᵈ _ _
 
@@ -418,17 +428,27 @@ lemma function.surjective.supr_comp {f : ι → ι'} (hf : surjective f) (g : ι
   (⨆ x, g (f x)) = ⨆ y, g y :=
 by simp only [supr, hf.range_comp]
 
+lemma equiv.supr_comp {g : ι' → α} (e : ι ≃ ι') :
+  (⨆ x, g (e x)) = ⨆ y, g y :=
+e.surjective.supr_comp _
+
 protected lemma function.surjective.supr_congr {g : ι' → α} (h : ι → ι') (h1 : surjective h)
   (h2 : ∀ x, g (h x) = f x) : (⨆ x, f x) = ⨆ y, g y :=
 by { convert h1.supr_comp g, exact (funext h2).symm }
 
+protected lemma equiv.supr_congr {g : ι' → α} (e : ι ≃ ι') (h : ∀ x, g (e x) = f x) :
+  (⨆ x, f x) = ⨆ y, g y :=
+e.surjective.supr_congr _ h
+
 @[congr] lemma supr_congr_Prop {p q : Prop} {f₁ : p → α} {f₂ : q → α} (pq : p ↔ q)
   (f : ∀ x, f₁ (pq.mpr x) = f₂ x) : supr f₁ = supr f₂ :=
-begin
-  obtain rfl := propext pq,
-  congr' with x,
-  apply f
-end
+by { obtain rfl := propext pq, congr' with x, apply f }
+
+lemma supr_plift_up (f : plift ι → α) : (⨆ i, f (plift.up i)) = ⨆ i, f i :=
+plift.up_surjective.supr_congr _ $ λ _, rfl
+
+lemma supr_plift_down (f : ι → α) : (⨆ i, f (plift.down i)) = ⨆ i, f i :=
+plift.down_surjective.supr_congr _ $ λ _, rfl
 
 lemma supr_range' (g : β → α) (f : ι → β) : (⨆ b : range f, g b) = ⨆ i, g (f i) :=
 by rw [supr, supr, ← image_eq_range, ← range_comp]
@@ -450,14 +470,28 @@ lemma function.surjective.infi_comp {f : ι → ι'} (hf : surjective f) (g : ι
   (⨅ x, g (f x)) = ⨅ y, g y :=
 @function.surjective.supr_comp αᵒᵈ _ _  _ f hf g
 
-lemma function.surjective.infi_congr {g : ι' → α} (h : ι → ι') (h1 : surjective h)
+lemma equiv.infi_comp {g : ι' → α} (e : ι ≃ ι') :
+  (⨅ x, g (e x)) = ⨅ y, g y :=
+@equiv.supr_comp αᵒᵈ _ _ _ _ e
+
+protected lemma function.surjective.infi_congr {g : ι' → α} (h : ι → ι') (h1 : surjective h)
   (h2 : ∀ x, g (h x) = f x) : (⨅ x, f x) = ⨅ y, g y :=
 @function.surjective.supr_congr αᵒᵈ _ _ _ _ _ h h1 h2
 
+protected lemma equiv.infi_congr {g : ι' → α} (e : ι ≃ ι') (h : ∀ x, g (e x) = f x) :
+  (⨅ x, f x) = ⨅ y, g y :=
+@equiv.supr_congr αᵒᵈ _ _ _ _ _ e h
+
 @[congr]lemma infi_congr_Prop {p q : Prop} {f₁ : p → α} {f₂ : q → α}
   (pq : p ↔ q) (f : ∀ x, f₁ (pq.mpr x) = f₂ x) : infi f₁ = infi f₂ :=
 @supr_congr_Prop αᵒᵈ _ p q f₁ f₂ pq f
 
+lemma infi_plift_up (f : plift ι → α) : (⨅ i, f (plift.up i)) = ⨅ i, f i :=
+plift.up_surjective.infi_congr _ $ λ _, rfl
+
+lemma infi_plift_down (f : ι → α) : (⨅ i, f (plift.down i)) = ⨅ i, f i :=
+plift.down_surjective.infi_congr _ $ λ _, rfl
+
 lemma infi_range' (g : β → α) (f : ι → β) : (⨅ b : range f, g b) = ⨅ i, g (f i) :=
 @supr_range' αᵒᵈ _ _ _ _ _
 
@@ -544,6 +578,9 @@ le_infi₂ $ λ i j, let ⟨i', j', h⟩ := h i j in infi₂_le_of_le i' j' h
 lemma supr_const_mono (h : ι → ι') : (⨆ i : ι, a) ≤ ⨆ j : ι', a := supr_le $ le_supr _ ∘ h
 lemma infi_const_mono (h : ι' → ι) : (⨅ i : ι, a) ≤ ⨅ j : ι', a := le_infi $ infi_le _ ∘ h
 
+lemma supr_infi_le_infi_supr (f : ι → ι' → α) : (⨆ i, ⨅ j, f i j) ≤ (⨅ j, ⨆ i, f i j) :=
+supr_le $ λ i, infi_mono $ λ j, le_supr _ i
+
 lemma bsupr_mono {p q : ι → Prop} (hpq : ∀ i, p i → q i) :
   (⨆ i (h : p i), f i) ≤ ⨆ i (h : q i), f i :=
 supr_mono $ λ i, supr_const_mono (hpq i)
@@ -575,41 +612,26 @@ le_antisymm (Sup_le le_supr₂) (supr₂_le $ λ b, le_Sup)
 
 lemma Inf_eq_infi {s : set α} : Inf s = ⨅ a ∈ s, a := @Sup_eq_supr αᵒᵈ _ _
 
-lemma Sup_sUnion (s : set (set α)) :  Sup (⋃₀ s) = ⨆ t ∈ s, Sup t :=
-begin
-  apply le_antisymm,
-  { apply Sup_le (λ b hb, _),
-    rcases hb with ⟨t, ts, bt⟩,
-    apply le_trans _ (le_supr _ t),
-    exact le_trans (le_Sup bt) (le_supr _ ts), },
-  { apply supr_le (λ t, _),
-    exact supr_le (λ ts, Sup_le_Sup (λ x xt, ⟨t, ts, xt⟩)) }
-end
-
-lemma Inf_sUnion (s : set (set α)) : Inf (⋃₀ s) = ⨅ t ∈ s, Inf t := @Sup_sUnion αᵒᵈ _ _
-
 lemma monotone.le_map_supr [complete_lattice β] {f : α → β} (hf : monotone f) :
   (⨆ i, f (s i)) ≤ f (supr s) :=
 supr_le $ λ i, hf $ le_supr _ _
 
-lemma monotone.le_map_supr₂ [complete_lattice β] {f : α → β} (hf : monotone f) (s : Π i, κ i → α) :
-  (⨆ i j, f (s i j)) ≤ f (⨆ i j, s i j) :=
-calc (⨆ i j, f (s i j)) ≤ (⨆ i, f (⨆ j, s i j)) :
-  supr_mono $ λ i, hf.le_map_supr
-... ≤ f (⨆ i j, s i j) : hf.le_map_supr
-
-lemma monotone.le_map_Sup [complete_lattice β] {s : set α} {f : α → β} (hf : monotone f) :
-  (⨆ a ∈ s, f a) ≤ f (Sup s) :=
-by rw [Sup_eq_supr]; exact hf.le_map_supr₂ _
-
 lemma antitone.le_map_infi [complete_lattice β] {f : α → β} (hf : antitone f) :
   (⨆ i, f (s i)) ≤ f (infi s) :=
 hf.dual_left.le_map_supr
 
+lemma monotone.le_map_supr₂ [complete_lattice β] {f : α → β} (hf : monotone f) (s : Π i, κ i → α) :
+  (⨆ i j, f (s i j)) ≤ f (⨆ i j, s i j) :=
+supr₂_le $ λ i j, hf $ le_supr₂ _ _
+
 lemma antitone.le_map_infi₂ [complete_lattice β] {f : α → β} (hf : antitone f) (s : Π i, κ i → α) :
   (⨆ i j, f (s i j)) ≤ f (⨅ i j, s i j) :=
 hf.dual_left.le_map_supr₂ _
 
+lemma monotone.le_map_Sup [complete_lattice β] {s : set α} {f : α → β} (hf : monotone f) :
+  (⨆ a ∈ s, f a) ≤ f (Sup s) :=
+by rw [Sup_eq_supr]; exact hf.le_map_supr₂ _
+
 lemma antitone.le_map_Inf [complete_lattice β] {s : set α} {f : α → β} (hf : antitone f) :
   (⨆ a ∈ s, f a) ≤ f (Inf s) :=
 hf.dual_left.le_map_Sup
@@ -619,71 +641,65 @@ lemma order_iso.map_supr [complete_lattice β] (f : α ≃o β) (x : ι → α)
 eq_of_forall_ge_iff $ f.surjective.forall.2 $ λ x,
   by simp only [f.le_iff_le, supr_le_iff]
 
+lemma order_iso.map_infi [complete_lattice β] (f : α ≃o β) (x : ι → α) :
+  f (⨅ i, x i) = ⨅ i, f (x i) :=
+order_iso.map_supr f.dual _
+
 lemma order_iso.map_Sup [complete_lattice β] (f : α ≃o β) (s : set α) :
   f (Sup s) = ⨆ a ∈ s, f a :=
 by simp only [Sup_eq_supr, order_iso.map_supr]
 
+lemma order_iso.map_Inf [complete_lattice β] (f : α ≃o β) (s : set α) :
+  f (Inf s) = ⨅ a ∈ s, f a :=
+order_iso.map_Sup f.dual _
+
 lemma supr_comp_le {ι' : Sort*} (f : ι' → α) (g : ι → ι') : (⨆ x, f (g x)) ≤ ⨆ y, f y :=
 supr_mono' $ λ x, ⟨_, le_rfl⟩
 
+lemma le_infi_comp {ι' : Sort*} (f : ι' → α) (g : ι → ι') : (⨅ y, f y) ≤ ⨅ x, f (g x) :=
+infi_mono' $ λ x, ⟨_, le_rfl⟩
+
 lemma monotone.supr_comp_eq [preorder β] {f : β → α} (hf : monotone f)
   {s : ι → β} (hs : ∀ x, ∃ i, x ≤ s i) : (⨆ x, f (s x)) = ⨆ y, f y :=
 le_antisymm (supr_comp_le _ _) (supr_mono' $ λ x, (hs x).imp $ λ i hi, hf hi)
 
-lemma monotone.map_infi_le [complete_lattice β] {f : α → β} (hf : monotone f) :
-  f (infi s) ≤ (⨅ i, f (s i)) :=
-le_infi $ λ i, hf $ infi_le _ _
-
-lemma monotone.map_infi₂_le [complete_lattice β] {f : α → β} (hf : monotone f) (s : Π i, κ i → α) :
-  f (⨅ i j, s i j) ≤ ⨅ i j, f (s i j) :=
-hf.dual.le_map_supr₂ _
-
-lemma monotone.map_Inf_le [complete_lattice β] {s : set α} {f : α → β} (hf : monotone f) :
-  f (Inf s) ≤ ⨅ a ∈ s, f a :=
-by rw [Inf_eq_infi]; exact hf.map_infi₂_le _
+lemma monotone.infi_comp_eq [preorder β] {f : β → α} (hf : monotone f)
+  {s : ι → β} (hs : ∀ x, ∃ i, s i ≤ x) : (⨅ x, f (s x)) = ⨅ y, f y :=
+le_antisymm (infi_mono' $ λ x, (hs x).imp $ λ i hi, hf hi) (le_infi_comp _ _)
 
 lemma antitone.map_supr_le [complete_lattice β] {f : α → β} (hf : antitone f) :
   f (supr s) ≤ ⨅ i, f (s i) :=
-hf.dual_left.map_infi_le
+le_infi $ λ i, hf $ le_supr _ _
+
+lemma monotone.map_infi_le [complete_lattice β] {f : α → β} (hf : monotone f) :
+  f (infi s) ≤ (⨅ i, f (s i)) :=
+hf.dual_left.map_supr_le
 
 lemma antitone.map_supr₂_le [complete_lattice β] {f : α → β} (hf : antitone f) (s : Π i, κ i → α) :
   f (⨆ i j, s i j) ≤ ⨅ i j, f (s i j) :=
-hf.dual_left.map_infi₂_le _
+hf.dual.le_map_infi₂ _
+
+lemma monotone.map_infi₂_le [complete_lattice β] {f : α → β} (hf : monotone f) (s : Π i, κ i → α) :
+  f (⨅ i j, s i j) ≤ ⨅ i j, f (s i j) :=
+hf.dual.le_map_supr₂ _
 
 lemma antitone.map_Sup_le [complete_lattice β] {s : set α} {f : α → β} (hf : antitone f) :
   f (Sup s) ≤ ⨅ a ∈ s, f a :=
-hf.dual_left.map_Inf_le
-
-lemma order_iso.map_infi [complete_lattice β] (f : α ≃o β) (x : ι → α) :
-  f (⨅ i, x i) = ⨅ i, f (x i) :=
-order_iso.map_supr f.dual _
-
-lemma order_iso.map_Inf [complete_lattice β] (f : α ≃o β) (s : set α) :
-  f (Inf s) = ⨅ a ∈ s, f a :=
-order_iso.map_Sup f.dual _
-
-lemma le_infi_comp {ι' : Sort*} (f : ι' → α) (g : ι → ι') : (⨅ y, f y) ≤ ⨅ x, f (g x) :=
-infi_mono' $ λ x, ⟨_, le_rfl⟩
+by { rw Sup_eq_supr, exact hf.map_supr₂_le _ }
 
-lemma monotone.infi_comp_eq [preorder β] {f : β → α} (hf : monotone f)
-  {s : ι → β} (hs : ∀ x, ∃ i, s i ≤ x) : (⨅ x, f (s x)) = ⨅ y, f y :=
-le_antisymm (infi_mono' $ λ x, (hs x).imp $ λ i hi, hf hi) (le_infi_comp _ _)
-
-lemma supr_const_le {x : α} : (⨆ (h : ι), x) ≤ x :=
-supr_le (λ _, le_rfl)
-
-lemma le_infi_const {x : α} : x ≤ (⨅ (h : ι), x) :=
-le_infi (λ _, le_rfl)
+lemma monotone.map_Inf_le [complete_lattice β] {s : set α} {f : α → β} (hf : monotone f) :
+  f (Inf s) ≤ ⨅ a ∈ s, f a :=
+hf.dual_left.map_Sup_le
 
--- We will generalize this to conditionally complete lattices in `cinfi_const`.
-theorem infi_const [nonempty ι] {a : α} : (⨅ b : ι, a) = a :=
-by rw [infi, range_const, Inf_singleton]
+lemma supr_const_le : (⨆ i : ι, a) ≤ a := supr_le $ λ _, le_rfl
+lemma le_infi_const : a ≤ ⨅ i : ι, a := le_infi $ λ _, le_rfl
 
--- We will generalize this to conditionally complete lattices in `csupr_const`.
-theorem supr_const [nonempty ι] {a : α} : (⨆ b : ι, a) = a := @infi_const αᵒᵈ _ _ _ _
+/- We generalize this to conditionally complete lattices in `csupr_const` and `cinfi_const`. -/
+theorem supr_const [nonempty ι] : (⨆ b : ι, a) = a := by rw [supr, range_const, Sup_singleton]
+theorem infi_const [nonempty ι] : (⨅ b : ι, a) = a := @supr_const αᵒᵈ _ _ a _
 
-@[simp] lemma infi_top : (⨅ i:ι, ⊤ : α) = ⊤ := top_unique $ le_infi $ λ i, le_rfl
-@[simp] lemma supr_bot : (⨆ i:ι, ⊥ : α) = ⊥ := @infi_top αᵒᵈ _ _
+@[simp] lemma supr_bot : (⨆ i : ι, ⊥ : α) = ⊥ := bot_unique supr_const_le
+@[simp] lemma infi_top : (⨅ i : ι, ⊤ : α) = ⊤ := top_unique le_infi_const
 
 @[simp] lemma supr_eq_bot : supr s = ⊥ ↔ ∀ i, s i = ⊥ := Sup_eq_bot.trans forall_range_iff
 @[simp] lemma infi_eq_top : infi s = ⊤ ↔ ∀ i, s i = ⊤ := Inf_eq_top.trans forall_range_iff
@@ -719,9 +735,9 @@ Sup_eq_of_forall_le_of_forall_lt_exists_gt (forall_range_iff.mpr h₁)
 is smaller than `f i` for all `i`, and that this is not the case of any `w>b`.
 See `cinfi_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in conditionally complete
 lattices. -/
-theorem infi_eq_of_forall_ge_of_forall_gt_exists_lt {f : ι → α} (h₁ : ∀ i, b ≤ f i)
-(h₂ : ∀ w, b < w → (∃ i, f i < w)) : (⨅ (i : ι), f i) = b :=
-@supr_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _ ‹_› ‹_› ‹_›
+theorem infi_eq_of_forall_ge_of_forall_gt_exists_lt :
+  (∀ i, b ≤ f i) → (∀ w, b < w → ∃ i, f i < w) → (⨅ i, f i) = b :=
+@supr_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _ _
 
 lemma supr_eq_dif {p : Prop} [decidable p] (a : p → α) :
   (⨆ h : p, a h) = if h : p then a h else ⊥ :=
@@ -739,15 +755,23 @@ lemma infi_eq_if {p : Prop} [decidable p] (a : α) :
   (⨅ h : p, a) = if p then a else ⊤ :=
 infi_eq_dif (λ _, a)
 
--- TODO: should this be @[simp]?
 lemma supr_comm {f : ι → ι' → α} : (⨆ i j, f i j) = ⨆ j i, f i j :=
 le_antisymm
   (supr_le $ λ i, supr_mono $ λ j, le_supr _ i)
   (supr_le $ λ j, supr_mono $ λ i, le_supr _ _)
 
--- TODO: should this be @[simp]?
 lemma infi_comm {f : ι → ι' → α} : (⨅ i j, f i j) = ⨅ j i, f i j := @supr_comm αᵒᵈ _ _ _ _
 
+lemma supr₂_comm {ι₁ ι₂ : Sort*} {κ₁ : ι₁ → Sort*} {κ₂ : ι₂ → Sort*}
+  (f : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → α) :
+  (⨆ i₁ j₁ i₂ j₂, f i₁ j₁ i₂ j₂) = ⨆ i₂ j₂ i₁ j₁, f i₁ j₁ i₂ j₂ :=
+by simp only [@supr_comm _ (κ₁ _), @supr_comm _ ι₁]
+
+lemma infi₂_comm {ι₁ ι₂ : Sort*} {κ₁ : ι₁ → Sort*} {κ₂ : ι₂ → Sort*}
+  (f : Π i₁, κ₁ i₁ → Π i₂, κ₂ i₂ → α) :
+  (⨅ i₁ j₁ i₂ j₂, f i₁ j₁ i₂ j₂) = ⨅ i₂ j₂ i₁ j₁, f i₁ j₁ i₂ j₂ :=
+by simp only [@infi_comm _ (κ₁ _), @infi_comm _ ι₁]
+
 /- TODO: this is strange. In the proof below, we get exactly the desired
    among the equalities, but close does not get it.
 begin
@@ -760,43 +784,59 @@ begin
 end
 -/
 
+@[simp] theorem supr_supr_eq_left {b : β} {f : Π x : β, x = b → α} :
+  (⨆ x, ⨆ h : x = b, f x h) = f b rfl :=
+(@le_supr₂ _ _ _ _ f b rfl).antisymm' (supr_le $ λ c, supr_le $ by { rintro rfl, refl })
+
 @[simp] theorem infi_infi_eq_left {b : β} {f : Π x : β, x = b → α} :
   (⨅ x, ⨅ h : x = b, f x h) = f b rfl :=
-le_antisymm
-  (infi₂_le _ rfl)
-  (le_infi $ λ b', le_infi $ λ eq, match b', eq with ._, rfl := le_rfl end)
+@supr_supr_eq_left αᵒᵈ _ _ _ _
+
+@[simp] theorem supr_supr_eq_right {b : β} {f : Π x : β, b = x → α} :
+  (⨆ x, ⨆ h : b = x, f x h) = f b rfl :=
+(le_supr₂ b rfl).antisymm' (supr₂_le $ λ c, by { rintro rfl, refl })
 
 @[simp] theorem infi_infi_eq_right {b : β} {f : Π x : β, b = x → α} :
   (⨅ x, ⨅ h : b = x, f x h) = f b rfl :=
-le_antisymm
-  (infi₂_le _ rfl)
-  (le_infi₂ $ λ b' eq, match b', eq with ._, rfl := le_rfl end)
+@supr_supr_eq_right αᵒᵈ _ _ _ _
 
-@[simp] theorem supr_supr_eq_left {b : β} {f : Π x : β, x = b → α} :
-  (⨆ x, ⨆ h : x = b, f x h) = f b rfl :=
-@infi_infi_eq_left αᵒᵈ _ _ _ _
+attribute [ematch] le_refl
 
-@[simp] theorem supr_supr_eq_right {b : β} {f : Π x : β, b = x → α} :
-  (⨆ x, ⨆ h : b = x, f x h) = f b rfl :=
-@infi_infi_eq_right αᵒᵈ _ _ _ _
+theorem supr_subtype {p : ι → Prop} {f : subtype p → α} : supr f = (⨆ i (h : p i), f ⟨i, h⟩) :=
+le_antisymm (supr_le $ λ ⟨i, h⟩, le_supr₂ i h) (supr₂_le $ λ i h, le_supr _ _)
 
-attribute [ematch] le_refl
+theorem infi_subtype : ∀ {p : ι → Prop} {f : subtype p → α}, infi f = (⨅ i (h : p i), f ⟨i, h⟩) :=
+@supr_subtype αᵒᵈ _ _
 
-theorem infi_subtype {p : ι → Prop} {f : subtype p → α} : (⨅ x, f x) = (⨅ i (h : p i), f ⟨i, h⟩) :=
-le_antisymm (le_infi₂ $ λ i h, infi_le _ _) (le_infi $ λ ⟨i, h⟩, infi₂_le _ _)
+lemma supr_subtype' {p : ι → Prop} {f : Π i, p i → α} :
+  (⨆ i h, f i h) = ⨆ x : subtype p, f x x.property :=
+(@supr_subtype _ _ _ p (λ x, f x.val x.property)).symm
 
 lemma infi_subtype' {p : ι → Prop} {f : ∀ i, p i → α} :
   (⨅ i (h : p i), f i h) = (⨅ x : subtype p, f x x.property) :=
 (@infi_subtype _ _ _ p (λ x, f x.val x.property)).symm
 
-lemma infi_subtype'' {ι} (s : set ι) (f : ι → α) :
-  (⨅ i : s, f i) = ⨅ (t : ι) (H : t ∈ s), f t :=
+lemma supr_subtype'' {ι} (s : set ι) (f : ι → α) : (⨆ i : s, f i) = ⨆ (t : ι) (H : t ∈ s), f t :=
+supr_subtype
+
+lemma infi_subtype'' {ι} (s : set ι) (f : ι → α) : (⨅ i : s, f i) = ⨅ (t : ι) (H : t ∈ s), f t :=
 infi_subtype
 
-theorem infi_inf_eq {f g : ι → α} : (⨅ x, f x ⊓ g x) = (⨅ x, f x) ⊓ (⨅ x, g x) :=
+lemma bsupr_const {ι : Sort*} {a : α} {s : set ι} (hs : s.nonempty) : (⨆ i ∈ s, a) = a :=
+begin
+  haveI : nonempty s := set.nonempty_coe_sort.mpr hs,
+  rw [← supr_subtype'', supr_const],
+end
+
+lemma binfi_const {ι : Sort*} {a : α} {s : set ι} (hs : s.nonempty) : (⨅ i ∈ s, a) = a :=
+@bsupr_const αᵒᵈ _ ι _ s hs
+
+theorem supr_sup_eq : (⨆ x, f x ⊔ g x) = (⨆ x, f x) ⊔ (⨆ x, g x) :=
 le_antisymm
-  (le_inf (infi_mono $ λ i, inf_le_left) $ infi_mono $ λ i, inf_le_right)
-  (le_infi $ λ i, inf_le_inf (infi_le _ _) $ infi_le _ _)
+  (supr_le $ λ i, sup_le_sup (le_supr _ _) $ le_supr _ _)
+  (sup_le (supr_mono $ λ i, le_sup_left) $ supr_mono $ λ i, le_sup_right)
+
+theorem infi_inf_eq : (⨅ x, f x ⊓ g x) = (⨅ x, f x) ⊓ (⨅ x, g x) := @supr_sup_eq αᵒᵈ _ _ _ _
 
 /- TODO: here is another example where more flexible pattern matching
    might help.
@@ -807,74 +847,79 @@ begin
 end
 -/
 
-lemma infi_inf [h : nonempty ι] {f : ι → α} {a : α} : (⨅ x, f x) ⊓ a = (⨅ x, f x ⊓ a) :=
+lemma supr_sup [nonempty ι] {f : ι → α} {a : α} : (⨆ x, f x) ⊔ a = ⨆ x, f x ⊔ a :=
+by rw [supr_sup_eq, supr_const]
+
+lemma infi_inf [nonempty ι] {f : ι → α} {a : α} : (⨅ x, f x) ⊓ a = ⨅ x, f x ⊓ a :=
 by rw [infi_inf_eq, infi_const]
 
-lemma inf_infi [nonempty ι] {f : ι → α} {a : α} : a ⊓ (⨅ x, f x) = (⨅ x, a ⊓ f x) :=
-by rw [inf_comm, infi_inf]; simp [inf_comm]
+lemma sup_supr [nonempty ι] {f : ι → α} {a : α} : a ⊔ (⨆ x, f x) = ⨆ x, a ⊔ f x :=
+by rw [supr_sup_eq, supr_const]
 
-lemma binfi_inf {p : ι → Prop} {f : Π i (hi : p i), α} {a : α} (h : ∃ i, p i) :
-  (⨅ i (h : p i), f i h) ⊓ a = ⨅ i (h : p i), f i h ⊓ a :=
-by haveI : nonempty {i // p i} := (let ⟨i, hi⟩ := h in ⟨⟨i, hi⟩⟩);
-  rw [infi_subtype', infi_subtype', infi_inf]
+lemma inf_infi [nonempty ι] {f : ι → α} {a : α} : a ⊓ (⨅ x, f x) = ⨅ x, a ⊓ f x :=
+by rw [infi_inf_eq, infi_const]
 
-lemma inf_binfi {p : ι → Prop} {f : Π i (hi : p i), α} {a : α} (h : ∃ i, p i) :
-  a ⊓ (⨅ i (h : p i), f i h) = ⨅ i (h : p i), a ⊓ f i h :=
-by simpa only [inf_comm] using binfi_inf h
+lemma bsupr_sup {p : ι → Prop} {f : Π i, p i → α} {a : α} (h : ∃ i, p i) :
+  (⨆ i (h : p i), f i h) ⊔ a = ⨆ i (h : p i), f i h ⊔ a :=
+by haveI : nonempty {i // p i} := (let ⟨i, hi⟩ := h in ⟨⟨i, hi⟩⟩);
+  rw [supr_subtype', supr_subtype', supr_sup]
 
-theorem supr_sup_eq {f g : ι → α} : (⨆ x, f x ⊔ g x) = (⨆ x, f x) ⊔ (⨆ x, g x) :=
-@infi_inf_eq αᵒᵈ ι _ _ _
+lemma sup_bsupr {p : ι → Prop} {f : Π i, p i → α} {a : α} (h : ∃ i, p i) :
+  a ⊔ (⨆ i (h : p i), f i h) = ⨆ i (h : p i), a ⊔ f i h :=
+by simpa only [sup_comm] using bsupr_sup h
 
-lemma supr_sup [h : nonempty ι] {f : ι → α} {a : α} : (⨆ x, f x) ⊔ a = (⨆ x, f x ⊔ a) :=
-@infi_inf αᵒᵈ _ _ _ _ _
+lemma binfi_inf {p : ι → Prop} {f : Π i, p i → α} {a : α} (h : ∃ i, p i) :
+  (⨅ i (h : p i), f i h) ⊓ a = ⨅ i (h : p i), f i h ⊓ a :=
+@bsupr_sup αᵒᵈ ι _ p f _ h
 
-lemma sup_supr [nonempty ι] {f : ι → α} {a : α} : a ⊔ (⨆ x, f x) = (⨆ x, a ⊔ f x) :=
-@inf_infi αᵒᵈ _ _ _ _ _
+lemma inf_binfi {p : ι → Prop} {f : Π i, p i → α} {a : α} (h : ∃ i, p i) :
+  a ⊓ (⨅ i (h : p i), f i h) = ⨅ i (h : p i), a ⊓ f i h :=
+@sup_bsupr αᵒᵈ ι _ p f _ h
 
 /-! ### `supr` and `infi` under `Prop` -/
 
-@[simp] theorem infi_false {s : false → α} : infi s = ⊤ :=
-le_antisymm le_top (le_infi $ λ i, false.elim i)
-
 @[simp] theorem supr_false {s : false → α} : supr s = ⊥ :=
 le_antisymm (supr_le $ λ i, false.elim i) bot_le
 
+@[simp] theorem infi_false {s : false → α} : infi s = ⊤ :=
+le_antisymm le_top (le_infi $ λ i, false.elim i)
+
 lemma supr_true {s : true → α} : supr s = s trivial := supr_pos trivial
 lemma infi_true {s : true → α} : infi s = s trivial := infi_pos trivial
 
-@[simp] lemma infi_exists {p : ι → Prop} {f : Exists p → α} : (⨅ x, f x) = ⨅ i h, f ⟨i, h⟩ :=
-le_antisymm (le_infi₂ $ λ i h, infi_le _ _) (le_infi $ λ ⟨i, h⟩, infi₂_le _ _)
+@[simp] lemma supr_exists {p : ι → Prop} {f : Exists p → α} : (⨆ x, f x)  = ⨆ i h, f ⟨i, h⟩ :=
+le_antisymm (supr_le $ λ ⟨i, h⟩, le_supr₂ i h) (supr₂_le $ λ i h, le_supr _ _)
 
-@[simp] lemma supr_exists {p : ι → Prop} {f : Exists p → α} : (⨆ x, f x) = ⨆ i h, f ⟨i, h⟩ :=
-@infi_exists αᵒᵈ _ _ _ _
+@[simp] lemma infi_exists {p : ι → Prop} {f : Exists p → α} : (⨅ x, f x)  = ⨅ i h, f ⟨i, h⟩ :=
+@supr_exists αᵒᵈ _ _ _ _
 
-lemma infi_and {p q : Prop} {s : p ∧ q → α} : infi s = ⨅ h₁ h₂, s ⟨h₁, h₂⟩ :=
-le_antisymm (le_infi₂ $ λ i j, infi_le _ _) (le_infi $ λ ⟨i, h⟩, infi₂_le _ _)
-
-/-- The symmetric case of `infi_and`, useful for rewriting into a infimum over a conjunction -/
-lemma infi_and' {p q : Prop} {s : p → q → α} :
-  (⨅ (h₁ : p) (h₂ : q), s h₁ h₂) = ⨅ (h : p ∧ q), s h.1 h.2 :=
-by { symmetry, exact infi_and }
+lemma supr_and {p q : Prop} {s : p ∧ q → α} : supr s = ⨆ h₁ h₂, s ⟨h₁, h₂⟩ :=
+le_antisymm (supr_le $ λ ⟨i, h⟩, le_supr₂ i h) (supr₂_le $ λ i h, le_supr _ _)
 
-lemma supr_and {p q : Prop} {s : p ∧ q → α} : supr s = ⨆ h₁ h₂, s ⟨h₁, h₂⟩ := @infi_and αᵒᵈ _ _ _ _
+lemma infi_and {p q : Prop} {s : p ∧ q → α} : infi s = ⨅ h₁ h₂, s ⟨h₁, h₂⟩ := @supr_and αᵒᵈ _ _ _ _
 
 /-- The symmetric case of `supr_and`, useful for rewriting into a supremum over a conjunction -/
 lemma supr_and' {p q : Prop} {s : p → q → α} :
   (⨆ (h₁ : p) (h₂ : q), s h₁ h₂) = ⨆ (h : p ∧ q), s h.1 h.2 :=
-by { symmetry, exact supr_and }
+eq.symm supr_and
 
-theorem infi_or {p q : Prop} {s : p ∨ q → α} :
-  infi s = (⨅ h : p, s (or.inl h)) ⊓ (⨅ h : q, s (or.inr h)) :=
-le_antisymm
-  (le_inf (le_infi_comp _ _) $ le_infi_comp _ _)
-  (le_infi $ λ i, match i with
-  | or.inl i := inf_le_of_left_le $ infi_le _ _
-  | or.inr j := inf_le_of_right_le $ infi_le _ _
-  end)
+/-- The symmetric case of `infi_and`, useful for rewriting into a infimum over a conjunction -/
+lemma infi_and' {p q : Prop} {s : p → q → α} :
+  (⨅ (h₁ : p) (h₂ : q), s h₁ h₂) = ⨅ (h : p ∧ q), s h.1 h.2 :=
+eq.symm infi_and
 
 theorem supr_or {p q : Prop} {s : p ∨ q → α} :
   (⨆ x, s x) = (⨆ i, s (or.inl i)) ⊔ (⨆ j, s (or.inr j)) :=
-@infi_or αᵒᵈ _ _ _ _
+le_antisymm
+  (supr_le $ λ i, match i with
+  | or.inl i := le_sup_of_le_left $ le_supr _ i
+  | or.inr j := le_sup_of_le_right $ le_supr _ j
+  end)
+  (sup_le (supr_comp_le _ _) (supr_comp_le _ _))
+
+theorem infi_or {p q : Prop} {s : p ∨ q → α} :
+  (⨅ x, s x) = (⨅ i, s (or.inl i)) ⊓ (⨅ j, s (or.inr j)) :=
+@supr_or αᵒᵈ _ _ _ _
 
 section
 
@@ -889,113 +934,107 @@ begin
   simp [h],
 end
 
-lemma supr_ite (f g : ι → α) :
-  (⨆ i, if p i then f i else g i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), g i) :=
-supr_dite _ _ _
-
 lemma infi_dite (f : Π i, p i → α) (g : Π i, ¬p i → α) :
   (⨅ i, if h : p i then f i h else g i h) = (⨅ i (h : p i), f i h) ⊓ (⨅ i (h : ¬ p i), g i h) :=
 supr_dite p (show Π i, p i → αᵒᵈ, from f) g
 
+lemma supr_ite (f g : ι → α) :
+  (⨆ i, if p i then f i else g i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), g i) :=
+supr_dite _ _ _
+
 lemma infi_ite (f g : ι → α) :
   (⨅ i, if p i then f i else g i) = (⨅ i (h : p i), f i) ⊓ (⨅ i (h : ¬ p i), g i) :=
 infi_dite _ _ _
 
 end
 
-lemma infi_range {g : β → α} {f : ι → β} : (⨅ b ∈ range f, g b) = ⨅ i, g (f i) :=
-by rw [← infi_subtype'', infi_range']
-
 lemma supr_range {g : β → α} {f : ι → β} : (⨆ b ∈ range f, g b) = ⨆ i, g (f i) :=
-@infi_range αᵒᵈ _ _ _ _ _
+by rw [← supr_subtype'', supr_range']
+
+lemma infi_range : ∀ {g : β → α} {f : ι → β}, (⨅ b ∈ range f, g b) = ⨅ i, g (f i) :=
+@supr_range αᵒᵈ _ _ _
 
-theorem Inf_image {s : set β} {f : β → α} : Inf (f '' s) = ⨅ a ∈ s, f a :=
-by rw [← infi_subtype'', Inf_image']
+theorem Sup_image {s : set β} {f : β → α} : Sup (f '' s) = ⨆ a ∈ s, f a :=
+by rw [← supr_subtype'', Sup_image']
 
-theorem Sup_image {s : set β} {f : β → α} : Sup (f '' s) = ⨆ a ∈ s, f a := @Inf_image αᵒᵈ _ _ _ _
+theorem Inf_image {s : set β} {f : β → α} : Inf (f '' s) = ⨅ a ∈ s, f a := @Sup_image αᵒᵈ _ _ _ _
 
 /-
 ### supr and infi under set constructions
 -/
 
-theorem infi_emptyset {f : β → α} : (⨅ x ∈ (∅ : set β), f x) = ⊤ :=
-by simp
+theorem supr_emptyset {f : β → α} : (⨆ x ∈ (∅ : set β), f x) = ⊥ := by simp
+theorem infi_emptyset {f : β → α} : (⨅ x ∈ (∅ : set β), f x) = ⊤ := by simp
 
-theorem supr_emptyset {f : β → α} : (⨆ x ∈ (∅ : set β), f x) = ⊥ :=
-by simp
+theorem supr_univ {f : β → α} : (⨆ x ∈ (univ : set β), f x) = ⨆ x, f x := by simp
+theorem infi_univ {f : β → α} : (⨅ x ∈ (univ : set β), f x) = ⨅ x, f x := by simp
 
-theorem infi_univ {f : β → α} : (⨅ x ∈ (univ : set β), f x) = (⨅ x, f x) :=
-by simp
+theorem supr_union {f : β → α} {s t : set β} :
+  (⨆ x ∈ s ∪ t, f x) = (⨆ x ∈ s, f x) ⊔ (⨆ x ∈ t, f x) :=
+by simp_rw [mem_union, supr_or, supr_sup_eq]
 
-theorem supr_univ {f : β → α} : (⨆ x ∈ (univ : set β), f x) = (⨆ x, f x) :=
-by simp
+theorem infi_union {f : β → α} {s t : set β} :
+  (⨅ x ∈ s ∪ t, f x) = (⨅ x ∈ s, f x) ⊓ (⨅ x ∈ t, f x) :=
+@supr_union αᵒᵈ _ _ _ _ _
 
-theorem infi_union {f : β → α} {s t : set β} : (⨅ x ∈ s ∪ t, f x) = (⨅x∈s, f x) ⊓ (⨅x∈t, f x) :=
-by simp only [← infi_inf_eq, infi_or]
+lemma supr_split (f : β → α) (p : β → Prop) :
+  (⨆ i, f i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), f i) :=
+by simpa [classical.em] using @supr_union _ _ _ f {i | p i} {i | ¬ p i}
 
-lemma infi_split (f : β → α) (p : β → Prop) :
+lemma infi_split : ∀ (f : β → α) (p : β → Prop),
   (⨅ i, f i) = (⨅ i (h : p i), f i) ⊓ (⨅ i (h : ¬ p i), f i) :=
-by simpa [classical.em] using @infi_union _ _ _ f {i | p i} {i | ¬ p i}
+@supr_split αᵒᵈ _ _
 
-lemma infi_split_single (f : β → α) (i₀ : β) :
-  (⨅ i, f i) = f i₀ ⊓ (⨅ i (h : i ≠ i₀), f i) :=
-by convert infi_split _ _; simp
+lemma supr_split_single (f : β → α) (i₀ : β) : (⨆ i, f i) = f i₀ ⊔ ⨆ i (h : i ≠ i₀), f i :=
+by { convert supr_split _ _, simp }
 
-theorem infi_le_infi_of_subset {f : β → α} {s t : set β} (h : s ⊆ t) :
-  (⨅ x ∈ t, f x) ≤ (⨅ x ∈ s, f x) :=
-by rw [(union_eq_self_of_subset_left h).symm, infi_union]; exact inf_le_left
-
-theorem supr_union {f : β → α} {s t : set β} :
-  (⨆ x ∈ s ∪ t, f x) = (⨆ x ∈ s, f x) ⊔ (⨆ x ∈ t, f x) :=
-@infi_union αᵒᵈ _ _ _ _ _
+lemma infi_split_single (f : β → α) (i₀ : β) : (⨅ i, f i) = f i₀ ⊓ ⨅ i (h : i ≠ i₀), f i :=
+@supr_split_single αᵒᵈ _ _ _ _
 
-lemma supr_split (f : β → α) (p : β → Prop) :
-  (⨆ i, f i) = (⨆ i (h : p i), f i) ⊔ (⨆ i (h : ¬ p i), f i) :=
-@infi_split αᵒᵈ _ _ _ _
+lemma supr_le_supr_of_subset {f : β → α} {s t : set β} : s ⊆ t → (⨆ x ∈ s, f x) ≤ ⨆ x ∈ t, f x :=
+bsupr_mono
 
-lemma supr_split_single (f : β → α) (i₀ : β) :
-  (⨆ i, f i) = f i₀ ⊔ (⨆ i (h : i ≠ i₀), f i) :=
-@infi_split_single αᵒᵈ _ _ _ _
+lemma infi_le_infi_of_subset {f : β → α} {s t : set β} : s ⊆ t → (⨅ x ∈ t, f x) ≤ ⨅ x ∈ s, f x :=
+binfi_mono
 
-theorem supr_le_supr_of_subset {f : β → α} {s t : set β} (h : s ⊆ t) :
-  (⨆ x ∈ s, f x) ≤ (⨆ x ∈ t, f x) :=
-@infi_le_infi_of_subset αᵒᵈ _ _ _ _ _ h
+theorem supr_insert {f : β → α} {s : set β} {b : β} :
+  (⨆ x ∈ insert b s, f x) = f b ⊔ (⨆ x ∈ s, f x) :=
+eq.trans supr_union $ congr_arg (λ x, x ⊔ (⨆ x ∈ s, f x)) supr_supr_eq_left
 
 theorem infi_insert {f : β → α} {s : set β} {b : β} :
   (⨅ x ∈ insert b s, f x) = f b ⊓ (⨅ x ∈ s, f x) :=
 eq.trans infi_union $ congr_arg (λ x, x ⊓ (⨅ x ∈ s, f x)) infi_infi_eq_left
 
-theorem supr_insert {f : β → α} {s : set β} {b : β} :
-  (⨆ x ∈ insert b s, f x) = f b ⊔ (⨆ x ∈ s, f x) :=
-eq.trans supr_union $ congr_arg (λ x, x ⊔ (⨆ x ∈ s, f x)) supr_supr_eq_left
+theorem supr_singleton {f : β → α} {b : β} : (⨆ x ∈ (singleton b : set β), f x) = f b :=
+by simp
 
 theorem infi_singleton {f : β → α} {b : β} : (⨅ x ∈ (singleton b : set β), f x) = f b :=
 by simp
 
-theorem infi_pair {f : β → α} {a b : β} : (⨅ x ∈ ({a, b} : set β), f x) = f a ⊓ f b :=
-by rw [infi_insert, infi_singleton]
-
-theorem supr_singleton {f : β → α} {b : β} : (⨆ x ∈ (singleton b : set β), f x) = f b :=
-@infi_singleton αᵒᵈ _ _ _ _
-
 theorem supr_pair {f : β → α} {a b : β} : (⨆ x ∈ ({a, b} : set β), f x) = f a ⊔ f b :=
 by rw [supr_insert, supr_singleton]
 
-lemma infi_image {γ} {f : β → γ} {g : γ → α} {t : set β} :
-  (⨅ c ∈ f '' t, g c) = (⨅ b ∈ t, g (f b)) :=
-by rw [← Inf_image, ← Inf_image, ← image_comp]
+theorem infi_pair {f : β → α} {a b : β} : (⨅ x ∈ ({a, b} : set β), f x) = f a ⊓ f b :=
+by rw [infi_insert, infi_singleton]
 
 lemma supr_image {γ} {f : β → γ} {g : γ → α} {t : set β} :
   (⨆ c ∈ f '' t, g c) = (⨆ b ∈ t, g (f b)) :=
-@infi_image αᵒᵈ _ _ _ _ _ _
+by rw [← Sup_image, ← Sup_image, ← image_comp]
+
+lemma infi_image : ∀ {γ} {f : β → γ} {g : γ → α} {t : set β},
+  (⨅ c ∈ f '' t, g c) = (⨅ b ∈ t, g (f b)) :=
+@supr_image αᵒᵈ _ _
 
 theorem supr_extend_bot {e : ι → β} (he : injective e) (f : ι → α) :
   (⨆ j, extend e f ⊥ j) = ⨆ i, f i :=
 begin
   rw supr_split _ (λ j, ∃ i, e i = j),
-  simp [extend_apply he, extend_apply', @supr_comm _ β ι] { contextual := tt }
+  simp [he.extend_apply, extend_apply', @supr_comm _ β ι] { contextual := tt }
 end
 
+lemma infi_extend_top {e : ι → β} (he : injective e) (f : ι → α) : (⨅ j, extend e f ⊤ j) = infi f :=
+@supr_extend_bot αᵒᵈ _ _ _ _ he _
+
 /-!
 ### `supr` and `infi` under `Type`
 -/
@@ -1004,13 +1043,13 @@ theorem supr_of_empty' {α ι} [has_Sup α] [is_empty ι] (f : ι → α) :
   supr f = Sup (∅ : set α) :=
 congr_arg Sup (range_eq_empty f)
 
-theorem supr_of_empty [is_empty ι] (f : ι → α) : supr f = ⊥ :=
-(supr_of_empty' f).trans Sup_empty
-
 theorem infi_of_empty' {α ι} [has_Inf α] [is_empty ι] (f : ι → α) :
   infi f = Inf (∅ : set α) :=
 congr_arg Inf (range_eq_empty f)
 
+theorem supr_of_empty [is_empty ι] (f : ι → α) : supr f = ⊥ :=
+(supr_of_empty' f).trans Sup_empty
+
 theorem infi_of_empty [is_empty ι] (f : ι → α) : infi f = ⊤ := @supr_of_empty αᵒᵈ _ _ _ f
 
 lemma supr_bool_eq {f : bool → α} : (⨆b:bool, f b) = f tt ⊔ f ff :=
@@ -1026,46 +1065,39 @@ lemma inf_eq_infi (x y : α) : x ⊓ y = ⨅ b : bool, cond b x y := @sup_eq_sup
 lemma is_glb_binfi {s : set β} {f : β → α} : is_glb (f '' s) (⨅ x ∈ s, f x) :=
 by simpa only [range_comp, subtype.range_coe, infi_subtype'] using @is_glb_infi α s _ (f ∘ coe)
 
-theorem supr_subtype {p : ι → Prop} {f : subtype p → α} : (⨆ x, f x) = (⨆ i (h:p i), f ⟨i, h⟩) :=
-@infi_subtype αᵒᵈ _ _ _ _
-
-lemma supr_subtype' {p : ι → Prop} {f : ∀ i, p i → α} :
-  (⨆ i (h : p i), f i h) = (⨆ x : subtype p, f x x.property) :=
-(@supr_subtype _ _ _ p (λ x, f x.val x.property)).symm
-
-lemma supr_subtype'' {ι} (s : set ι) (f : ι → α) :
-  (⨆ i : s, f i) = ⨆ (t : ι) (H : t ∈ s), f t :=
-supr_subtype
-
 lemma is_lub_bsupr {s : set β} {f : β → α} : is_lub (f '' s) (⨆ x ∈ s, f x) :=
 by simpa only [range_comp, subtype.range_coe, supr_subtype'] using @is_lub_supr α s _ (f ∘ coe)
 
-theorem infi_sigma {p : β → Type*} {f : sigma p → α} : (⨅ x, f x) = (⨅ i (h : p i), f ⟨i, h⟩) :=
-eq_of_forall_le_iff $ λ c, by simp only [le_infi_iff, sigma.forall]
+theorem supr_sigma {p : β → Type*} {f : sigma p → α} : (⨆ x, f x) = ⨆ i j, f ⟨i, j⟩ :=
+eq_of_forall_ge_iff $ λ c, by simp only [supr_le_iff, sigma.forall]
 
-theorem supr_sigma {p : β → Type*} {f : sigma p → α} : (⨆ x, f x) = (⨆ i (h : p i), f ⟨i, h⟩) :=
-@infi_sigma αᵒᵈ _ _ _ _
+theorem infi_sigma {p : β → Type*} {f : sigma p → α} : (⨅ x, f x) = ⨅ i j, f ⟨i, j⟩ :=
+@supr_sigma αᵒᵈ _ _ _ _
 
-theorem infi_prod {γ : Type*} {f : β × γ → α} : (⨅ x, f x) = (⨅ i j, f (i, j)) :=
-eq_of_forall_le_iff $ λ c, by simp only [le_infi_iff, prod.forall]
+theorem supr_prod {f : β × γ → α} : (⨆ x, f x) = ⨆ i j, f (i, j) :=
+eq_of_forall_ge_iff $ λ c, by simp only [supr_le_iff, prod.forall]
 
-theorem supr_prod {γ : Type*} {f : β × γ → α} : (⨆ x, f x) = (⨆ i j, f (i, j)) :=
-@infi_prod αᵒᵈ _ _ _ _
+theorem infi_prod {f : β × γ → α} : (⨅ x, f x)  = ⨅ i j, f (i, j) := @supr_prod αᵒᵈ _ _ _ _
 
-theorem infi_sum {γ : Type*} {f : β ⊕ γ → α} :
-  (⨅ x, f x) = (⨅ i, f (sum.inl i)) ⊓ (⨅ j, f (sum.inr j)) :=
-eq_of_forall_le_iff $ λ c, by simp only [le_inf_iff, le_infi_iff, sum.forall]
+lemma bsupr_prod {f : β × γ → α} {s : set β} {t : set γ} :
+  (⨆ x ∈ s ×ˢ t, f x) = ⨆ (a ∈ s) (b ∈ t), f (a, b) :=
+by { simp_rw [supr_prod, mem_prod, supr_and], exact supr_congr (λ _, supr_comm) }
 
-theorem supr_sum {γ : Type*} {f : β ⊕ γ → α} :
+lemma binfi_prod {f : β × γ → α} {s : set β} {t : set γ} :
+  (⨅ x ∈ s ×ˢ t, f x) = ⨅ (a ∈ s) (b ∈ t), f (a, b) :=
+@bsupr_prod αᵒᵈ _ _ _ _ _ _
+
+theorem supr_sum {f : β ⊕ γ → α} :
   (⨆ x, f x) = (⨆ i, f (sum.inl i)) ⊔ (⨆ j, f (sum.inr j)) :=
-@infi_sum αᵒᵈ _ _ _ _
+eq_of_forall_ge_iff $ λ c, by simp only [sup_le_iff, supr_le_iff, sum.forall]
+
+theorem infi_sum {f : β ⊕ γ → α} : (⨅ x, f x) = (⨅ i, f (sum.inl i)) ⊓ (⨅ j, f (sum.inr j)) :=
+@supr_sum αᵒᵈ _ _ _ _
 
-theorem supr_option (f : option β → α) :
-  (⨆ o, f o) = f none ⊔ ⨆ b, f (option.some b) :=
+theorem supr_option (f : option β → α) : (⨆ o, f o) = f none ⊔ ⨆ b, f (option.some b) :=
 eq_of_forall_ge_iff $ λ c, by simp only [supr_le_iff, sup_le_iff, option.forall]
 
-theorem infi_option (f : option β → α) :
-  (⨅ o, f o) = f none ⊓ ⨅ b, f (option.some b) :=
+theorem infi_option (f : option β → α) : (⨅ o, f o) = f none ⊓ ⨅ b, f (option.some b) :=
 @supr_option αᵒᵈ _ _ _
 
 /-- A version of `supr_option` useful for rewriting right-to-left. -/
@@ -1081,9 +1113,8 @@ dropped, without changing the result. -/
 lemma supr_ne_bot_subtype (f : ι → α) : (⨆ i : {i // f i ≠ ⊥}, f i) = ⨆ i, f i :=
 begin
   by_cases htriv : ∀ i, f i = ⊥,
-  { simp only [htriv, supr_bot] },
-  refine le_antisymm (supr_comp_le f _) (supr_mono' _),
-  intros i,
+  { simp only [supr_bot, (funext htriv : f = _)] },
+  refine (supr_comp_le f _).antisymm (supr_mono' $ λ i, _),
   by_cases hi : f i = ⊥,
   { rw hi,
     obtain ⟨i₀, hi₀⟩ := not_forall.mp htriv,
@@ -1096,25 +1127,37 @@ dropped, without changing the result. -/
 lemma infi_ne_top_subtype (f : ι → α) : (⨅ i : {i // f i ≠ ⊤}, f i) = ⨅ i, f i :=
 @supr_ne_bot_subtype αᵒᵈ ι _ f
 
+lemma Sup_image2 {f : β → γ → α} {s : set β} {t : set γ} :
+  Sup (image2 f s t) = ⨆ (a ∈ s) (b ∈ t), f a b :=
+by rw [←image_prod, Sup_image, bsupr_prod]
+
+lemma Inf_image2 {f : β → γ → α} {s : set β} {t : set γ} :
+  Inf (image2 f s t) = ⨅ (a ∈ s) (b ∈ t), f a b :=
+by rw [←image_prod, Inf_image, binfi_prod]
+
 /-!
 ### `supr` and `infi` under `ℕ`
 -/
 
-lemma supr_ge_eq_supr_nat_add {u : ℕ → α} (n : ℕ) : (⨆ i ≥ n, u i) = ⨆ i, u (i + n) :=
+lemma supr_ge_eq_supr_nat_add (u : ℕ → α) (n : ℕ) : (⨆ i ≥ n, u i) = ⨆ i, u (i + n) :=
 begin
   apply le_antisymm;
   simp only [supr_le_iff],
-  { exact λ i hi, le_Sup ⟨i - n, by { dsimp only, rw tsub_add_cancel_of_le hi }⟩ },
+  { exact λ i hi, le_Sup ⟨i - n, by { dsimp only, rw nat.sub_add_cancel hi }⟩ },
   { exact λ i, le_Sup ⟨i + n, supr_pos (nat.le_add_left _ _)⟩ }
 end
 
-lemma infi_ge_eq_infi_nat_add {u : ℕ → α} (n : ℕ) : (⨅ i ≥ n, u i) = ⨅ i, u (i + n) :=
+lemma infi_ge_eq_infi_nat_add (u : ℕ → α) (n : ℕ) : (⨅ i ≥ n, u i) = ⨅ i, u (i + n) :=
 @supr_ge_eq_supr_nat_add αᵒᵈ _ _ _
 
 lemma monotone.supr_nat_add {f : ℕ → α} (hf : monotone f) (k : ℕ) :
   (⨆ n, f (n + k)) = ⨆ n, f n :=
 le_antisymm (supr_le $ λ i, le_supr _ (i + k)) $ supr_mono $ λ i, hf $ nat.le_add_right i k
 
+lemma antitone.infi_nat_add {f : ℕ → α} (hf : antitone f) (k : ℕ) :
+  (⨅ n, f (n + k)) = ⨅ n, f n :=
+hf.dual_right.supr_nat_add k
+
 @[simp] lemma supr_infi_ge_nat_add (f : ℕ → α) (k : ℕ) :
   (⨆ n, ⨅ i ≥ n, f (i + k)) = ⨆ n, ⨅ i ≥ n, f i :=
 begin
@@ -1123,27 +1166,36 @@ begin
   { simp_rw [infi_ge_eq_infi_nat_add, ←nat.add_assoc], },
 end
 
+@[simp] lemma infi_supr_ge_nat_add : ∀ (f : ℕ → α) (k : ℕ),
+  (⨅ n, ⨆ i ≥ n, f (i + k)) = ⨅ n, ⨆ i ≥ n, f i :=
+@supr_infi_ge_nat_add αᵒᵈ _
+
 lemma sup_supr_nat_succ (u : ℕ → α) : u 0 ⊔ (⨆ i, u (i + 1)) = ⨆ i, u i :=
-begin
-  refine eq_of_forall_ge_iff (λ c, _),
-  simp only [sup_le_iff, supr_le_iff],
-  refine ⟨λ h, _, λ h, ⟨h _, λ i, h _⟩⟩,
-  rintro (_|i),
-  exacts [h.1, h.2 i]
-end
+calc u 0 ⊔ (⨆ i, u (i + 1)) = (⨆ (x ∈ {0} ∪ range nat.succ), u x)
+      : by rw [supr_union, supr_singleton, supr_range]
+... = ⨆ i, u i
+      : by rw [nat.zero_union_range_succ, supr_univ]
 
 lemma inf_infi_nat_succ (u : ℕ → α) : u 0 ⊓ (⨅ i, u (i + 1)) = ⨅ i, u i :=
 @sup_supr_nat_succ αᵒᵈ _ u
 
+lemma infi_nat_gt_zero_eq (f : ℕ → α) :
+  (⨅ (i > 0), f i) = ⨅ i, f (i + 1) :=
+by { rw [←infi_range, nat.range_succ], simp only [mem_set_of] }
+
+lemma supr_nat_gt_zero_eq (f : ℕ → α) :
+  (⨆ (i > 0), f i) = ⨆ i, f (i + 1) :=
+@infi_nat_gt_zero_eq αᵒᵈ _ f
+
 end
 
 section complete_linear_order
 variables [complete_linear_order α]
 
-lemma supr_eq_top (f : ι → α) : supr f = ⊤ ↔ (∀ b <⊤, ∃ i, b < f i) :=
+lemma supr_eq_top (f : ι → α) : supr f = ⊤ ↔ ∀ b < ⊤, ∃ i, b < f i :=
 by simp only [← Sup_range, Sup_eq_top, set.exists_range_iff]
 
-lemma infi_eq_bot (f : ι → α) : infi f = ⊥ ↔ (∀ b > ⊥, ∃ i, f i < b) :=
+lemma infi_eq_bot (f : ι → α) : infi f = ⊥ ↔ ∀ b > ⊥, ∃ i, f i < b :=
 by simp only [← Inf_range, Inf_eq_bot, set.exists_range_iff]
 
 end complete_linear_order
@@ -1168,12 +1220,12 @@ noncomputable instance Prop.complete_linear_order : complete_linear_order Prop :
 @[simp] lemma Sup_Prop_eq {s : set Prop} : Sup s = ∃ p ∈ s, p := rfl
 @[simp] lemma Inf_Prop_eq {s : set Prop} : Inf s = ∀ p ∈ s, p := rfl
 
-@[simp] lemma infi_Prop_eq {p : ι → Prop} : (⨅ i, p i) = ∀ i, p i :=
-le_antisymm (λ h i, h _ ⟨i, rfl⟩ ) (λ h p ⟨i, eq⟩, eq ▸ h i)
-
 @[simp] lemma supr_Prop_eq {p : ι → Prop} : (⨆ i, p i) = ∃ i, p i :=
 le_antisymm (λ ⟨q, ⟨i, (eq : p i = q)⟩, hq⟩, ⟨i, eq.symm ▸ hq⟩) (λ ⟨i, hi⟩, ⟨p i, ⟨i, rfl⟩, hi⟩)
 
+@[simp] lemma infi_Prop_eq {p : ι → Prop} : (⨅ i, p i) = ∀ i, p i :=
+le_antisymm (λ h i, h _ ⟨i, rfl⟩ ) (λ h p ⟨i, eq⟩, eq ▸ h i)
+
 instance pi.has_Sup {α : Type*} {β : α → Type*} [Π i, has_Sup (β i)] : has_Sup (Π i, β i) :=
 ⟨λ s i, ⨆ f : s, (f : Π i, β i) i⟩
 
@@ -1191,29 +1243,37 @@ instance pi.complete_lattice {α : Type*} {β : α → Type*} [∀ i, complete_l
   .. pi.bounded_order,
   .. pi.lattice }
 
+lemma Sup_apply {α : Type*} {β : α → Type*} [Π i, has_Sup (β i)] {s : set (Π a, β a)} {a : α} :
+  (Sup s) a = ⨆ f : s, (f : Π a, β a) a :=
+rfl
+
 lemma Inf_apply {α : Type*} {β : α → Type*} [Π i, has_Inf (β i)]
-  {s : set (Π a, β a)} {a : α} : (Inf s) a = (⨅ f : s, (f : Π a, β a) a) :=
+  {s : set (Π a, β a)} {a : α} : Inf s a = ⨅ f : s, (f : Π a, β a) a :=
 rfl
 
+@[simp] lemma supr_apply {α : Type*} {β : α → Type*} {ι : Sort*} [Π i, has_Sup (β i)]
+  {f : ι → Π a, β a} {a : α} : (⨆ i, f i) a = ⨆ i, f i a :=
+by rw [supr, Sup_apply, supr, supr, ← image_eq_range (λ f : Π i, β i, f a) (range f), ← range_comp]
+
 @[simp] lemma infi_apply {α : Type*} {β : α → Type*} {ι : Sort*} [Π i, has_Inf (β i)]
   {f : ι → Π a, β a} {a : α} : (⨅ i, f i) a = ⨅ i, f i a :=
-by rw [infi, Inf_apply, infi, infi, ← image_eq_range (λ f : Π i, β i, f a) (range f), ← range_comp]
-
-lemma Sup_apply {α : Type*} {β : α → Type*} [Π i, has_Sup (β i)] {s : set (Πa, β a)} {a : α} :
-  (Sup s) a = (⨆ f : s, (f : Π a, β a) a) :=
-rfl
+@supr_apply α (λ i, (β i)ᵒᵈ) _ _ _ _
 
 lemma unary_relation_Sup_iff {α : Type*} (s : set (α → Prop)) {a : α} :
-  Sup s a ↔ ∃ (r : α → Prop), r ∈ s ∧ r a :=
-by { change (∃ _, _) ↔ _, simp [-eq_iff_iff] }
+  Sup s a ↔ ∃ r : α → Prop, r ∈ s ∧ r a :=
+by { unfold Sup, simp [←eq_iff_iff] }
+
+lemma unary_relation_Inf_iff {α : Type*} (s : set (α → Prop)) {a : α} :
+  Inf s a ↔ ∀ r : α → Prop, r ∈ s → r a :=
+by { unfold Inf, simp [←eq_iff_iff] }
 
 lemma binary_relation_Sup_iff {α β : Type*} (s : set (α → β → Prop)) {a : α} {b : β} :
-  Sup s a b ↔ ∃ (r : α → β → Prop), r ∈ s ∧ r a b :=
-by { change (∃ _, _) ↔ _, simp [-eq_iff_iff] }
+  Sup s a b ↔ ∃ r : α → β → Prop, r ∈ s ∧ r a b :=
+by { unfold Sup, simp [←eq_iff_iff] }
 
-@[simp] lemma supr_apply {α : Type*} {β : α → Type*} {ι : Sort*} [Π i, has_Sup (β i)]
-  {f : ι → Π a, β a} {a : α} : (⨆ i, f i) a = (⨆ i, f i a) :=
-@infi_apply α (λ i, (β i)ᵒᵈ) _ _ f a
+lemma binary_relation_Inf_iff {α β : Type*} (s : set (α → β → Prop)) {a : α} {b : β} :
+  Inf s a b ↔ ∀ r : α → β → Prop, r ∈ s → r a b :=
+by { unfold Inf, simp [←eq_iff_iff] }
 
 section complete_lattice
 variables [preorder α] [complete_lattice β]
@@ -1229,11 +1289,59 @@ end complete_lattice
 namespace prod
 variables (α β)
 
+instance [has_Sup α] [has_Sup β] : has_Sup (α × β) :=
+⟨λ s, (Sup (prod.fst '' s), Sup (prod.snd '' s))⟩
+
 instance [has_Inf α] [has_Inf β] : has_Inf (α × β) :=
-⟨λs, (Inf (prod.fst '' s), Inf (prod.snd '' s))⟩
+⟨λ s, (Inf (prod.fst '' s), Inf (prod.snd '' s))⟩
 
-instance [has_Sup α] [has_Sup β] : has_Sup (α × β) :=
-⟨λs, (Sup (prod.fst '' s), Sup (prod.snd '' s))⟩
+variables {α β}
+
+lemma fst_Inf [has_Inf α] [has_Inf β] (s : set (α × β)) : (Inf s).fst = Inf (prod.fst '' s) := rfl
+
+lemma snd_Inf [has_Inf α] [has_Inf β] (s : set (α × β)) : (Inf s).snd = Inf (prod.snd '' s) := rfl
+
+lemma swap_Inf [has_Inf α] [has_Inf β] (s : set (α × β)) : (Inf s).swap = Inf (prod.swap '' s) :=
+ext
+  (congr_arg Inf $ image_comp prod.fst swap s : _)
+  (congr_arg Inf $ image_comp prod.snd swap s : _)
+
+lemma fst_Sup [has_Sup α] [has_Sup β] (s : set (α × β)) : (Sup s).fst = Sup (prod.fst '' s) := rfl
+
+lemma snd_Sup [has_Sup α] [has_Sup β] (s : set (α × β)) : (Sup s).snd = Sup (prod.snd '' s) := rfl
+
+lemma swap_Sup [has_Sup α] [has_Sup β] (s : set (α × β)) : (Sup s).swap = Sup (prod.swap '' s) :=
+ext
+  (congr_arg Sup $ image_comp prod.fst swap s : _)
+  (congr_arg Sup $ image_comp prod.snd swap s : _)
+
+lemma fst_infi [has_Inf α] [has_Inf β] (f : ι → α × β) : (infi f).fst = ⨅ i, (f i).fst :=
+congr_arg Inf (range_comp _ _).symm
+
+lemma snd_infi [has_Inf α] [has_Inf β] (f : ι → α × β) : (infi f).snd = ⨅ i, (f i).snd :=
+congr_arg Inf (range_comp _ _).symm
+
+lemma swap_infi [has_Inf α] [has_Inf β] (f : ι → α × β) : (infi f).swap = ⨅ i, (f i).swap :=
+by simp_rw [infi, swap_Inf, range_comp]
+
+lemma infi_mk [has_Inf α] [has_Inf β] (f : ι → α) (g : ι → β) :
+  (⨅ i, (f i, g i)) = (⨅ i, f i, ⨅ i, g i) :=
+congr_arg2 prod.mk (fst_infi _) (snd_infi _)
+
+lemma fst_supr [has_Sup α] [has_Sup β] (f : ι → α × β) : (supr f).fst = ⨆ i, (f i).fst :=
+congr_arg Sup (range_comp _ _).symm
+
+lemma snd_supr [has_Sup α] [has_Sup β] (f : ι → α × β) : (supr f).snd = ⨆ i, (f i).snd :=
+congr_arg Sup (range_comp _ _).symm
+
+lemma swap_supr [has_Sup α] [has_Sup β] (f : ι → α × β) : (supr f).swap = ⨆ i, (f i).swap :=
+by simp_rw [supr, swap_Sup, range_comp]
+
+lemma supr_mk [has_Sup α] [has_Sup β] (f : ι → α) (g : ι → β) :
+  (⨆ i, (f i, g i)) = (⨆ i, f i, ⨆ i, g i) :=
+congr_arg2 prod.mk (fst_supr _) (snd_supr _)
+
+variables (α β)
 
 instance [complete_lattice α] [complete_lattice β] : complete_lattice (α × β) :=
 { le_Sup := λ s p hab, ⟨le_Sup $ mem_image_of_mem _ hab, le_Sup $ mem_image_of_mem _ hab⟩,
@@ -1251,6 +1359,14 @@ instance [complete_lattice α] [complete_lattice β] : complete_lattice (α × 
 
 end prod
 
+lemma Inf_prod [has_Inf α] [has_Inf β] {s : set α} {t : set β} (hs : s.nonempty) (ht : t.nonempty) :
+  Inf (s ×ˢ t) = (Inf s, Inf t) :=
+congr_arg2 prod.mk (congr_arg Inf $ fst_image_prod _ ht) (congr_arg Inf $ snd_image_prod hs _)
+
+lemma Sup_prod [has_Sup α] [has_Sup β] {s : set α} {t : set β} (hs : s.nonempty) (ht : t.nonempty) :
+  Sup (s ×ˢ t) = (Sup s, Sup t) :=
+congr_arg2 prod.mk (congr_arg Sup $ fst_image_prod _ ht) (congr_arg Sup $ snd_image_prod hs _)
+
 section complete_lattice
 variables [complete_lattice α] {a : α} {s : set α}
 
@@ -1258,25 +1374,31 @@ variables [complete_lattice α] {a : α} {s : set α}
 lemma sup_Inf_le_infi_sup : a ⊔ Inf s ≤ ⨅ b ∈ s, a ⊔ b :=
 le_infi₂ $ λ i h, sup_le_sup_left (Inf_le h) _
 
+/-- This is a weaker version of `inf_Sup_eq` -/
+lemma supr_inf_le_inf_Sup : (⨆ b ∈ s, a ⊓ b) ≤ a ⊓ Sup s :=
+@sup_Inf_le_infi_sup αᵒᵈ _ _ _
+
 /-- This is a weaker version of `Inf_sup_eq` -/
 lemma Inf_sup_le_infi_sup : Inf s ⊔ a ≤ ⨅ b ∈ s, b ⊔ a :=
 le_infi₂ $ λ i h, sup_le_sup_right (Inf_le h) _
 
-/-- This is a weaker version of `inf_Sup_eq` -/
-lemma supr_inf_le_inf_Sup : (⨆ b ∈ s, a ⊓ b) ≤ a ⊓ Sup s :=
-supr₂_le $ λ i h, inf_le_inf_left _ (le_Sup h)
-
 /-- This is a weaker version of `Sup_inf_eq` -/
 lemma supr_inf_le_Sup_inf : (⨆ b ∈ s, b ⊓ a) ≤ Sup s ⊓ a :=
-supr₂_le $ λ i h, inf_le_inf_right _ (le_Sup h)
+@Inf_sup_le_infi_sup αᵒᵈ _ _ _
+
+lemma le_supr_inf_supr (f g : ι → α) : (⨆ i, f i ⊓ g i) ≤ (⨆ i, f i) ⊓ (⨆ i, g i) :=
+le_inf (supr_mono $ λ i, inf_le_left) (supr_mono $ λ i, inf_le_right)
+
+lemma infi_sup_infi_le (f g : ι → α) : (⨅ i, f i) ⊔ (⨅ i, g i) ≤ ⨅ i, f i ⊔ g i :=
+@le_supr_inf_supr αᵒᵈ ι _ f g
 
 lemma disjoint_Sup_left {a : set α} {b : α} (d : disjoint (Sup a) b) {i} (hi : i ∈ a) :
   disjoint i b :=
-(supr₂_le_iff.1 (supr_inf_le_Sup_inf.trans d) i hi : _)
+disjoint_iff_inf_le.mpr (supr₂_le_iff.1 (supr_inf_le_Sup_inf.trans d.le_bot) i hi : _)
 
 lemma disjoint_Sup_right {a : set α} {b : α} (d : disjoint b (Sup a)) {i} (hi : i ∈ a) :
   disjoint b i :=
-(supr₂_le_iff.mp (supr_inf_le_inf_Sup.trans d) i hi : _)
+disjoint_iff_inf_le.mpr (supr₂_le_iff.mp (supr_inf_le_inf_Sup.trans d.le_bot) i hi : _)
 
 end complete_lattice
 
diff --git a/src/order/complete_lattice_intervals.lean b/src/order/complete_lattice_intervals.lean
index 1c894dafe4afe..370a5b8330f7c 100644
--- a/src/order/complete_lattice_intervals.lean
+++ b/src/order/complete_lattice_intervals.lean
@@ -3,11 +3,14 @@ Copyright (c) 2022 Heather Macbeth. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Heather Macbeth
 -/
-import order.conditionally_complete_lattice
+import order.conditionally_complete_lattice.basic
 import data.set.intervals.ord_connected
 
 /-! # Subtypes of conditionally complete linear orders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we give conditions on a subset of a conditionally complete linear order, to ensure that
 the subtype is itself conditionally complete.
 
diff --git a/src/order/concept.lean b/src/order/concept.lean
index 0327b0d58dc01..feea7695528d4 100644
--- a/src/order/concept.lean
+++ b/src/order/concept.lean
@@ -8,6 +8,9 @@ import data.set.lattice
 /-!
 # Formal concept analysis
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines concept lattices. A concept of a relation `r : α → β → Prop` is a pair of sets
 `s : set α` and `t : set β` such that `s` is the set of all `a : α` that are related to all elements
 of `t`, and `t` is the set of all `b : β` that are related to all elements of `s`.
diff --git a/src/order/conditionally_complete_lattice.lean b/src/order/conditionally_complete_lattice.lean
deleted file mode 100644
index dc46cae9c8bf2..0000000000000
--- a/src/order/conditionally_complete_lattice.lean
+++ /dev/null
@@ -1,1103 +0,0 @@
-/-
-Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
--/
-import order.bounds
-import data.set.intervals.basic
-import data.set.finite
-import data.set.lattice
-
-/-!
-# Theory of conditionally complete lattices.
-
-A conditionally complete lattice is a lattice in which every non-empty bounded subset s
-has a least upper bound and a greatest lower bound, denoted below by Sup s and Inf s.
-Typical examples are real, nat, int with their usual orders.
-
-The theory is very comparable to the theory of complete lattices, except that suitable
-boundedness and nonemptiness assumptions have to be added to most statements.
-We introduce two predicates bdd_above and bdd_below to express this boundedness, prove
-their basic properties, and then go on to prove most useful properties of Sup and Inf
-in conditionally complete lattices.
-
-To differentiate the statements between complete lattices and conditionally complete
-lattices, we prefix Inf and Sup in the statements by c, giving cInf and cSup. For instance,
-Inf_le is a statement in complete lattices ensuring Inf s ≤ x, while cInf_le is the same
-statement in conditionally complete lattices with an additional assumption that s is
-bounded below.
--/
-
-set_option old_structure_cmd true
-
-open set
-
-variables {α β : Type*} {ι : Sort*}
-
-section
-
-/-!
-Extension of Sup and Inf from a preorder `α` to `with_top α` and `with_bot α`
--/
-
-open_locale classical
-
-noncomputable instance {α : Type*} [preorder α] [has_Sup α] : has_Sup (with_top α) :=
-⟨λ S, if ⊤ ∈ S then ⊤ else
-  if bdd_above (coe ⁻¹' S : set α) then ↑(Sup (coe ⁻¹' S : set α)) else ⊤⟩
-
-noncomputable instance {α : Type*} [has_Inf α] : has_Inf (with_top α) :=
-⟨λ S, if S ⊆ {⊤} then ⊤ else ↑(Inf (coe ⁻¹' S : set α))⟩
-
-noncomputable instance {α : Type*} [has_Sup α] : has_Sup (with_bot α) :=
-⟨(@with_top.has_Inf αᵒᵈ _).Inf⟩
-
-noncomputable instance {α : Type*} [preorder α] [has_Inf α] : has_Inf (with_bot α) :=
-⟨(@with_top.has_Sup αᵒᵈ _ _).Sup⟩
-
-@[simp]
-theorem with_top.cInf_empty {α : Type*} [has_Inf α] : Inf (∅ : set (with_top α)) = ⊤ :=
-if_pos $ set.empty_subset _
-
-@[simp]
-theorem with_bot.cSup_empty {α : Type*} [has_Sup α] : Sup (∅ : set (with_bot α)) = ⊥ :=
-if_pos $ set.empty_subset _
-
-end -- section
-
-/-- A conditionally complete lattice is a lattice in which
-every nonempty subset which is bounded above has a supremum, and
-every nonempty subset which is bounded below has an infimum.
-Typical examples are real numbers or natural numbers.
-
-To differentiate the statements from the corresponding statements in (unconditional)
-complete lattices, we prefix Inf and Sup by a c everywhere. The same statements should
-hold in both worlds, sometimes with additional assumptions of nonemptiness or
-boundedness.-/
-class conditionally_complete_lattice (α : Type*) extends lattice α, has_Sup α, has_Inf α :=
-(le_cSup : ∀s a, bdd_above s → a ∈ s → a ≤ Sup s)
-(cSup_le : ∀ s a, set.nonempty s → a ∈ upper_bounds s → Sup s ≤ a)
-(cInf_le : ∀s a, bdd_below s → a ∈ s → Inf s ≤ a)
-(le_cInf : ∀s a, set.nonempty s → a ∈ lower_bounds s → a ≤ Inf s)
-
-/-- A conditionally complete linear order is a linear order in which
-every nonempty subset which is bounded above has a supremum, and
-every nonempty subset which is bounded below has an infimum.
-Typical examples are real numbers or natural numbers.
-
-To differentiate the statements from the corresponding statements in (unconditional)
-complete linear orders, we prefix Inf and Sup by a c everywhere. The same statements should
-hold in both worlds, sometimes with additional assumptions of nonemptiness or
-boundedness.-/
-class conditionally_complete_linear_order (α : Type*)
-  extends conditionally_complete_lattice α, linear_order α renaming max → sup min → inf
-
-/-- A conditionally complete linear order with `bot` is a linear order with least element, in which
-every nonempty subset which is bounded above has a supremum, and every nonempty subset (necessarily
-bounded below) has an infimum.  A typical example is the natural numbers.
-
-To differentiate the statements from the corresponding statements in (unconditional)
-complete linear orders, we prefix Inf and Sup by a c everywhere. The same statements should
-hold in both worlds, sometimes with additional assumptions of nonemptiness or
-boundedness.-/
-@[ancestor conditionally_complete_linear_order has_bot]
-class conditionally_complete_linear_order_bot (α : Type*)
-  extends conditionally_complete_linear_order α, has_bot α :=
-(bot_le : ∀ x : α, ⊥ ≤ x)
-(cSup_empty : Sup ∅ = ⊥)
-
-@[priority 100]  -- see Note [lower instance priority]
-instance conditionally_complete_linear_order_bot.to_order_bot
-  [h : conditionally_complete_linear_order_bot α] : order_bot α :=
-{ ..h }
-
-/-- A complete lattice is a conditionally complete lattice, as there are no restrictions
-on the properties of Inf and Sup in a complete lattice.-/
-@[priority 100] -- see Note [lower instance priority]
-instance complete_lattice.to_conditionally_complete_lattice [complete_lattice α] :
-  conditionally_complete_lattice α :=
-{ le_cSup := by intros; apply le_Sup; assumption,
-  cSup_le := by intros; apply Sup_le; assumption,
-  cInf_le := by intros; apply Inf_le; assumption,
-  le_cInf := by intros; apply le_Inf; assumption,
-  ..‹complete_lattice α› }
-
-@[priority 100] -- see Note [lower instance priority]
-instance complete_linear_order.to_conditionally_complete_linear_order_bot {α : Type*}
-  [complete_linear_order α] :
-  conditionally_complete_linear_order_bot α :=
-{ cSup_empty := Sup_empty,
-  ..complete_lattice.to_conditionally_complete_lattice, .. ‹complete_linear_order α› }
-
-section
-open_locale classical
-
-/-- A well founded linear order is conditionally complete, with a bottom element. -/
-@[reducible] noncomputable def well_founded.conditionally_complete_linear_order_with_bot
-  {α : Type*} [i : linear_order α] (h : well_founded ((<) : α → α → Prop))
-  (c : α) (hc : c = h.min set.univ ⟨c, mem_univ c⟩) :
-  conditionally_complete_linear_order_bot α :=
-{ sup := max,
-  le_sup_left := le_max_left,
-  le_sup_right := le_max_right,
-  sup_le := λ a b c, max_le,
-  inf := min,
-  inf_le_left := min_le_left,
-  inf_le_right := min_le_right,
-  le_inf := λ a b c, le_min,
-  Inf := λ s, if hs : s.nonempty then h.min s hs else c,
-  cInf_le := begin
-    assume s a hs has,
-    have s_ne : s.nonempty := ⟨a, has⟩,
-    simpa [s_ne] using not_lt.1 (h.not_lt_min s s_ne has),
-  end,
-  le_cInf := begin
-    assume s a hs has,
-    simp only [hs, dif_pos],
-    exact has (h.min_mem s hs),
-  end,
-  Sup := λ s, if hs : (upper_bounds s).nonempty then h.min _ hs else c,
-  le_cSup := begin
-    assume s a hs has,
-    have h's : (upper_bounds s).nonempty := hs,
-    simp only [h's, dif_pos],
-    exact h.min_mem _ h's has,
-  end,
-  cSup_le := begin
-    assume s a hs has,
-    have h's : (upper_bounds s).nonempty := ⟨a, has⟩,
-    simp only [h's, dif_pos],
-    simpa using h.not_lt_min _ h's has,
-  end,
-  bot := c,
-  bot_le := λ x, by convert not_lt.1 (h.not_lt_min set.univ ⟨c, mem_univ c⟩ (mem_univ x)),
-  cSup_empty := begin
-    have : (set.univ : set α).nonempty := ⟨c, mem_univ c⟩,
-    simp only [this, dif_pos, upper_bounds_empty],
-    exact hc.symm
-  end,
-  .. i }
-
-end
-
-section order_dual
-
-instance (α : Type*) [conditionally_complete_lattice α] : conditionally_complete_lattice αᵒᵈ :=
-{ le_cSup := @conditionally_complete_lattice.cInf_le α _,
-  cSup_le := @conditionally_complete_lattice.le_cInf α _,
-  le_cInf := @conditionally_complete_lattice.cSup_le α _,
-  cInf_le := @conditionally_complete_lattice.le_cSup α _,
-  ..order_dual.has_Inf α,
-  ..order_dual.has_Sup α,
-  ..order_dual.lattice α }
-
-instance (α : Type*) [conditionally_complete_linear_order α] :
-  conditionally_complete_linear_order αᵒᵈ :=
-{ ..order_dual.conditionally_complete_lattice α,
-  ..order_dual.linear_order α }
-
-end order_dual
-
-section conditionally_complete_lattice
-variables [conditionally_complete_lattice α] {s t : set α} {a b : α}
-
-theorem le_cSup (h₁ : bdd_above s) (h₂ : a ∈ s) : a ≤ Sup s :=
-conditionally_complete_lattice.le_cSup s a h₁ h₂
-
-theorem cSup_le (h₁ : s.nonempty) (h₂ : ∀b∈s, b ≤ a) : Sup s ≤ a :=
-conditionally_complete_lattice.cSup_le s a h₁ h₂
-
-theorem cInf_le (h₁ : bdd_below s) (h₂ : a ∈ s) : Inf s ≤ a :=
-conditionally_complete_lattice.cInf_le s a h₁ h₂
-
-theorem le_cInf (h₁ : s.nonempty) (h₂ : ∀b∈s, a ≤ b) : a ≤ Inf s :=
-conditionally_complete_lattice.le_cInf s a h₁ h₂
-
-theorem le_cSup_of_le (_ : bdd_above s) (hb : b ∈ s) (h : a ≤ b) : a ≤ Sup s :=
-le_trans h (le_cSup ‹bdd_above s› hb)
-
-theorem cInf_le_of_le (_ : bdd_below s) (hb : b ∈ s) (h : b ≤ a) : Inf s ≤ a :=
-le_trans (cInf_le ‹bdd_below s› hb) h
-
-theorem cSup_le_cSup (_ : bdd_above t) (_ : s.nonempty) (h : s ⊆ t) : Sup s ≤ Sup t :=
-cSup_le ‹_› (assume (a) (ha : a ∈ s), le_cSup ‹bdd_above t› (h ha))
-
-theorem cInf_le_cInf (_ : bdd_below t) (_ : s.nonempty) (h : s ⊆ t) : Inf t ≤ Inf s :=
-le_cInf ‹_› (assume (a) (ha : a ∈ s), cInf_le ‹bdd_below t› (h ha))
-
-theorem le_cSup_iff (h : bdd_above s) (hs : s.nonempty) :
-  a ≤ Sup s ↔ ∀ b, b ∈ upper_bounds s → a ≤ b :=
-⟨λ h b hb, le_trans h (cSup_le hs hb), λ hb, hb _ (λ x, le_cSup h)⟩
-
-theorem cInf_le_iff (h : bdd_below s) (hs : s.nonempty) :
-  Inf s ≤ a ↔ ∀ b ∈ lower_bounds s, b ≤ a :=
-⟨λ h b hb, le_trans (le_cInf hs hb) h, λ hb, hb _ (λ x, cInf_le h)⟩
-
-lemma is_lub_cSup (ne : s.nonempty) (H : bdd_above s) : is_lub s (Sup s) :=
-⟨assume x, le_cSup H, assume x, cSup_le ne⟩
-
-lemma is_lub_csupr [nonempty ι] {f : ι → α} (H : bdd_above (range f)) :
-  is_lub (range f) (⨆ i, f i) :=
-is_lub_cSup (range_nonempty f) H
-
-lemma is_lub_csupr_set {f : β → α} {s : set β} (H : bdd_above (f '' s)) (Hne : s.nonempty) :
-  is_lub (f '' s) (⨆ i : s, f i) :=
-by { rw ← Sup_image', exact is_lub_cSup (Hne.image _) H }
-
-lemma is_glb_cInf (ne : s.nonempty) (H : bdd_below s) : is_glb s (Inf s) :=
-⟨assume x, cInf_le H, assume x, le_cInf ne⟩
-
-lemma is_glb_cinfi [nonempty ι] {f : ι → α} (H : bdd_below (range f)) :
-  is_glb (range f) (⨅ i, f i) :=
-is_glb_cInf (range_nonempty f) H
-
-lemma is_glb_cinfi_set {f : β → α} {s : set β} (H : bdd_below (f '' s)) (Hne : s.nonempty) :
-  is_glb (f '' s) (⨅ i : s, f i) :=
-@is_lub_csupr_set αᵒᵈ _ _ _ _ H Hne
-
-lemma is_lub.cSup_eq (H : is_lub s a) (ne : s.nonempty) : Sup s = a :=
-(is_lub_cSup ne ⟨a, H.1⟩).unique H
-
-lemma is_lub.csupr_eq [nonempty ι] {f : ι → α} (H : is_lub (range f) a) : (⨆ i, f i) = a :=
-H.cSup_eq (range_nonempty f)
-
-lemma is_lub.csupr_set_eq {s : set β} {f : β → α} (H : is_lub (f '' s) a) (Hne : s.nonempty) :
-  (⨆ i : s, f i) = a :=
-is_lub.cSup_eq (image_eq_range f s ▸ H) (image_eq_range f s ▸ Hne.image f)
-
-/-- A greatest element of a set is the supremum of this set. -/
-lemma is_greatest.cSup_eq (H : is_greatest s a) : Sup s = a :=
-H.is_lub.cSup_eq H.nonempty
-
-lemma is_greatest.Sup_mem (H : is_greatest s a) : Sup s ∈ s :=
-H.cSup_eq.symm ▸ H.1
-
-lemma is_glb.cInf_eq (H : is_glb s a) (ne : s.nonempty) : Inf s = a :=
-(is_glb_cInf ne ⟨a, H.1⟩).unique H
-
-lemma is_glb.cinfi_eq [nonempty ι] {f : ι → α} (H : is_glb (range f) a) : (⨅ i, f i) = a :=
-H.cInf_eq (range_nonempty f)
-
-lemma is_glb.cinfi_set_eq {s : set β} {f : β → α} (H : is_glb (f '' s) a) (Hne : s.nonempty) :
-  (⨅ i : s, f i) = a :=
-is_glb.cInf_eq (image_eq_range f s ▸ H) (image_eq_range f s ▸ Hne.image f)
-
-/-- A least element of a set is the infimum of this set. -/
-lemma is_least.cInf_eq (H : is_least s a) : Inf s = a :=
-H.is_glb.cInf_eq H.nonempty
-
-lemma is_least.Inf_mem (H : is_least s a) : Inf s ∈ s :=
-H.cInf_eq.symm ▸ H.1
-
-lemma subset_Icc_cInf_cSup (hb : bdd_below s) (ha : bdd_above s) :
-  s ⊆ Icc (Inf s) (Sup s) :=
-λ x hx, ⟨cInf_le hb hx, le_cSup ha hx⟩
-
-theorem cSup_le_iff (hb : bdd_above s) (ne : s.nonempty) : Sup s ≤ a ↔ (∀b ∈ s, b ≤ a) :=
-is_lub_le_iff (is_lub_cSup ne hb)
-
-theorem le_cInf_iff (hb : bdd_below s) (ne : s.nonempty) : a ≤ Inf s ↔ (∀b ∈ s, a ≤ b) :=
-le_is_glb_iff (is_glb_cInf ne hb)
-
-lemma cSup_lower_bounds_eq_cInf {s : set α} (h : bdd_below s) (hs : s.nonempty) :
-  Sup (lower_bounds s) = Inf s :=
-(is_lub_cSup h $ hs.mono $ λ x hx y hy, hy hx).unique (is_glb_cInf hs h).is_lub
-
-lemma cInf_upper_bounds_eq_cSup {s : set α} (h : bdd_above s) (hs : s.nonempty) :
-  Inf (upper_bounds s) = Sup s :=
-(is_glb_cInf h $ hs.mono $ λ x hx y hy, hy hx).unique (is_lub_cSup hs h).is_glb
-
-lemma not_mem_of_lt_cInf {x : α} {s : set α} (h : x < Inf s) (hs : bdd_below s) : x ∉ s :=
-λ hx, lt_irrefl _ (h.trans_le (cInf_le hs hx))
-
-lemma not_mem_of_cSup_lt {x : α} {s : set α} (h : Sup s < x) (hs : bdd_above s) : x ∉ s :=
-@not_mem_of_lt_cInf αᵒᵈ _ x s h hs
-
-/--Introduction rule to prove that `b` is the supremum of `s`: it suffices to check that `b`
-is larger than all elements of `s`, and that this is not the case of any `wb`.
-See `Inf_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in complete lattices. -/
-theorem cInf_eq_of_forall_ge_of_forall_gt_exists_lt (_ : s.nonempty) (_ : ∀a∈s, b ≤ a)
-  (H : ∀w, b < w → (∃a∈s, a < w)) : Inf s = b :=
-@cSup_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _ ‹_› ‹_› ‹_›
-
-/--b < Sup s when there is an element a in s with b < a, when s is bounded above.
-This is essentially an iff, except that the assumptions for the two implications are
-slightly different (one needs boundedness above for one direction, nonemptiness and linear
-order for the other one), so we formulate separately the two implications, contrary to
-the complete_lattice case.-/
-lemma lt_cSup_of_lt (_ : bdd_above s) (_ : a ∈ s) (_ : b < a) : b < Sup s :=
-lt_of_lt_of_le ‹b < a› (le_cSup ‹bdd_above s› ‹a ∈ s›)
-
-/--Inf s < b when there is an element a in s with a < b, when s is bounded below.
-This is essentially an iff, except that the assumptions for the two implications are
-slightly different (one needs boundedness below for one direction, nonemptiness and linear
-order for the other one), so we formulate separately the two implications, contrary to
-the complete_lattice case.-/
-lemma cInf_lt_of_lt (_ : bdd_below s) (_ : a ∈ s) (_ : a < b) : Inf s < b :=
-@lt_cSup_of_lt αᵒᵈ _ _ _ _ ‹_› ‹_› ‹_›
-
-/-- If all elements of a nonempty set `s` are less than or equal to all elements
-of a nonempty set `t`, then there exists an element between these sets. -/
-lemma exists_between_of_forall_le (sne : s.nonempty) (tne : t.nonempty)
-  (hst : ∀ (x ∈ s) (y ∈ t), x ≤ y) :
-  (upper_bounds s ∩ lower_bounds t).nonempty :=
-⟨Inf t, λ x hx, le_cInf tne $ hst x hx, λ y hy, cInf_le (sne.mono hst) hy⟩
-
-/--The supremum of a singleton is the element of the singleton-/
-@[simp] theorem cSup_singleton (a : α) : Sup {a} = a :=
-is_greatest_singleton.cSup_eq
-
-/--The infimum of a singleton is the element of the singleton-/
-@[simp] theorem cInf_singleton (a : α) : Inf {a} = a :=
-is_least_singleton.cInf_eq
-
-@[simp] theorem cSup_pair (a b : α) : Sup {a, b} = a ⊔ b :=
-(@is_lub_pair _ _ a b).cSup_eq (nonempty_insert _ _)
-
-@[simp] theorem cInf_pair (a b : α) : Inf {a, b} = a ⊓ b :=
-(@is_glb_pair _ _ a b).cInf_eq (nonempty_insert _ _)
-
-/--If a set is bounded below and above, and nonempty, its infimum is less than or equal to
-its supremum.-/
-theorem cInf_le_cSup (hb : bdd_below s) (ha : bdd_above s) (ne : s.nonempty) : Inf s ≤ Sup s :=
-is_glb_le_is_lub (is_glb_cInf ne hb) (is_lub_cSup ne ha) ne
-
-/--The sup of a union of two sets is the max of the suprema of each subset, under the assumptions
-that all sets are bounded above and nonempty.-/
-theorem cSup_union (hs : bdd_above s) (sne : s.nonempty) (ht : bdd_above t) (tne : t.nonempty) :
-  Sup (s ∪ t) = Sup s ⊔ Sup t :=
-((is_lub_cSup sne hs).union (is_lub_cSup tne ht)).cSup_eq sne.inl
-
-/--The inf of a union of two sets is the min of the infima of each subset, under the assumptions
-that all sets are bounded below and nonempty.-/
-theorem cInf_union (hs : bdd_below s) (sne : s.nonempty) (ht : bdd_below t) (tne : t.nonempty) :
-  Inf (s ∪ t) = Inf s ⊓ Inf t :=
-@cSup_union αᵒᵈ _ _ _ hs sne ht tne
-
-/--The supremum of an intersection of two sets is bounded by the minimum of the suprema of each
-set, if all sets are bounded above and nonempty.-/
-theorem cSup_inter_le (_ : bdd_above s) (_ : bdd_above t) (hst : (s ∩ t).nonempty) :
-  Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
-begin
-  apply cSup_le hst, simp only [le_inf_iff, and_imp, set.mem_inter_eq], intros b _ _, split,
-  apply le_cSup ‹bdd_above s› ‹b ∈ s›,
-  apply le_cSup ‹bdd_above t› ‹b ∈ t›
-end
-
-/--The infimum of an intersection of two sets is bounded below by the maximum of the
-infima of each set, if all sets are bounded below and nonempty.-/
-theorem le_cInf_inter (_ : bdd_below s) (_ : bdd_below t) (hst : (s ∩ t).nonempty) :
-  Inf s ⊔ Inf t ≤ Inf (s ∩ t) :=
-@cSup_inter_le αᵒᵈ _ _ _ ‹_› ‹_› hst
-
-/-- The supremum of insert a s is the maximum of a and the supremum of s, if s is
-nonempty and bounded above.-/
-theorem cSup_insert (hs : bdd_above s) (sne : s.nonempty) : Sup (insert a s) = a ⊔ Sup s :=
-((is_lub_cSup sne hs).insert a).cSup_eq (insert_nonempty a s)
-
-/-- The infimum of insert a s is the minimum of a and the infimum of s, if s is
-nonempty and bounded below.-/
-theorem cInf_insert (hs : bdd_below s) (sne : s.nonempty) : Inf (insert a s) = a ⊓ Inf s :=
-@cSup_insert αᵒᵈ _ _ _ hs sne
-
-@[simp] lemma cInf_Icc (h : a ≤ b) : Inf (Icc a b) = a :=
-(is_glb_Icc h).cInf_eq (nonempty_Icc.2 h)
-
-@[simp] lemma cInf_Ici : Inf (Ici a) = a := is_least_Ici.cInf_eq
-
-@[simp] lemma cInf_Ico (h : a < b) : Inf (Ico a b) = a :=
-(is_glb_Ico h).cInf_eq (nonempty_Ico.2 h)
-
-@[simp] lemma cInf_Ioc [densely_ordered α] (h : a < b) : Inf (Ioc a b) = a :=
-(is_glb_Ioc h).cInf_eq (nonempty_Ioc.2 h)
-
-@[simp] lemma cInf_Ioi [no_max_order α] [densely_ordered α] : Inf (Ioi a) = a :=
-cInf_eq_of_forall_ge_of_forall_gt_exists_lt nonempty_Ioi (λ _, le_of_lt)
-  (λ w hw, by simpa using exists_between hw)
-
-@[simp] lemma cInf_Ioo [densely_ordered α] (h : a < b) : Inf (Ioo a b) = a :=
-(is_glb_Ioo h).cInf_eq (nonempty_Ioo.2 h)
-
-@[simp] lemma cSup_Icc (h : a ≤ b) : Sup (Icc a b) = b :=
-(is_lub_Icc h).cSup_eq (nonempty_Icc.2 h)
-
-@[simp] lemma cSup_Ico [densely_ordered α] (h : a < b) : Sup (Ico a b) = b :=
-(is_lub_Ico h).cSup_eq (nonempty_Ico.2 h)
-
-@[simp] lemma cSup_Iic : Sup (Iic a) = a := is_greatest_Iic.cSup_eq
-
-@[simp] lemma cSup_Iio [no_min_order α] [densely_ordered α] : Sup (Iio a) = a :=
-cSup_eq_of_forall_le_of_forall_lt_exists_gt nonempty_Iio (λ _, le_of_lt)
-  (λ w hw, by simpa [and_comm] using exists_between hw)
-
-@[simp] lemma cSup_Ioc (h : a < b) : Sup (Ioc a b) = b :=
-(is_lub_Ioc h).cSup_eq (nonempty_Ioc.2 h)
-
-@[simp] lemma cSup_Ioo [densely_ordered α] (h : a < b) : Sup (Ioo a b) = b :=
-(is_lub_Ioo h).cSup_eq (nonempty_Ioo.2 h)
-
-/--The indexed supremum of a function is bounded above by a uniform bound-/
-lemma csupr_le [nonempty ι] {f : ι → α} {c : α} (H : ∀x, f x ≤ c) : supr f ≤ c :=
-cSup_le (range_nonempty f) (by rwa forall_range_iff)
-
-/--The indexed supremum of a function is bounded below by the value taken at one point-/
-lemma le_csupr {f : ι → α} (H : bdd_above (range f)) (c : ι) : f c ≤ supr f :=
-le_cSup H (mem_range_self _)
-
-lemma le_csupr_of_le {f : ι → α} (H : bdd_above (range f)) (c : ι) (h : a ≤ f c) : a ≤ supr f :=
-le_trans h (le_csupr H c)
-
-/--The indexed supremum of two functions are comparable if the functions are pointwise comparable-/
-lemma csupr_mono {f g : ι → α} (B : bdd_above (range g)) (H : ∀ x, f x ≤ g x) :
-  supr f ≤ supr g :=
-begin
-  casesI is_empty_or_nonempty ι,
-  { rw [supr_of_empty', supr_of_empty'] },
-  { exact csupr_le (λ x, le_csupr_of_le B x (H x)) },
-end
-
-lemma le_csupr_set {f : β → α} {s : set β}
-  (H : bdd_above (f '' s)) {c : β} (hc : c ∈ s) : f c ≤ ⨆ i : s, f i :=
-(le_cSup H $ mem_image_of_mem f hc).trans_eq Sup_image'
-
-/--The indexed infimum of two functions are comparable if the functions are pointwise comparable-/
-lemma cinfi_mono {f g : ι → α} (B : bdd_below (range f)) (H : ∀ x, f x ≤ g x) :
-  infi f ≤ infi g :=
-@csupr_mono αᵒᵈ _ _ _ _ B H
-
-/--The indexed minimum of a function is bounded below by a uniform lower bound-/
-lemma le_cinfi [nonempty ι] {f : ι → α} {c : α} (H : ∀x, c ≤ f x) : c ≤ infi f :=
-@csupr_le αᵒᵈ _ _ _ _ _ H
-
-/--The indexed infimum of a function is bounded above by the value taken at one point-/
-lemma cinfi_le {f : ι → α} (H : bdd_below (range f)) (c : ι) : infi f ≤ f c :=
-@le_csupr αᵒᵈ _ _ _ H c
-
-lemma cinfi_le_of_le {f : ι → α} (H : bdd_below (range f)) (c : ι) (h : f c ≤ a) : infi f ≤ a :=
-@le_csupr_of_le αᵒᵈ _ _ _ _ H c h
-
-lemma cinfi_set_le {f : β → α} {s : set β}
-  (H : bdd_below (f '' s)) {c : β} (hc : c ∈ s) : (⨅ i : s, f i) ≤ f c :=
-@le_csupr_set αᵒᵈ _ _ _ _ H _ hc
-
-@[simp] theorem csupr_const [hι : nonempty ι] {a : α} : (⨆ b:ι, a) = a :=
-by rw [supr, range_const, cSup_singleton]
-
-@[simp] theorem cinfi_const [hι : nonempty ι] {a : α} : (⨅ b:ι, a) = a := @csupr_const αᵒᵈ _ _ _ _
-
-@[simp] theorem supr_unique [unique ι] {s : ι → α} : (⨆ i, s i) = s default :=
-have ∀ i, s i = s default := λ i, congr_arg s (unique.eq_default i),
-by simp only [this, csupr_const]
-
-@[simp] theorem infi_unique [unique ι] {s : ι → α} : (⨅ i, s i) = s default :=
-@supr_unique αᵒᵈ _ _ _ _
-
-@[simp] lemma csupr_pos {p : Prop} {f : p → α} (hp : p) : (⨆ h : p, f h) = f hp :=
-by haveI := unique_prop hp; exact supr_unique
-
-@[simp] lemma cinfi_pos {p : Prop} {f : p → α} (hp : p) : (⨅ h : p, f h) = f hp :=
-@csupr_pos αᵒᵈ _ _ _ hp
-
-lemma csupr_set {s : set β} {f : β → α} : (⨆ x : s, f x) = Sup (f '' s) :=
-begin
-  rw supr,
-  congr,
-  ext,
-  rw [mem_image, mem_range, set_coe.exists],
-  simp_rw [subtype.coe_mk, exists_prop],
-end
-
-lemma cinfi_set {s : set β} {f : β → α} : (⨅ x : s, f x) = Inf (f '' s) := @csupr_set αᵒᵈ _ _ _ _
-
-/--Introduction rule to prove that `b` is the supremum of `f`: it suffices to check that `b`
-is larger than `f i` for all `i`, and that this is not the case of any `wb`.
-See `infi_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in complete lattices. -/
-theorem cinfi_eq_of_forall_ge_of_forall_gt_exists_lt [nonempty ι] {f : ι → α} (h₁ : ∀ i, b ≤ f i)
-  (h₂ : ∀ w, b < w → (∃ i, f i < w)) : (⨅ (i : ι), f i) = b :=
-@csupr_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _ _ ‹_› ‹_› ‹_›
-
-/-- Nested intervals lemma: if `f` is a monotone sequence, `g` is an antitone sequence, and
-`f n ≤ g n` for all `n`, then `⨆ n, f n` belongs to all the intervals `[f n, g n]`. -/
-lemma monotone.csupr_mem_Inter_Icc_of_antitone [semilattice_sup β]
-  {f g : β → α} (hf : monotone f) (hg : antitone g) (h : f ≤ g) :
-  (⨆ n, f n) ∈ ⋂ n, Icc (f n) (g n) :=
-begin
-  refine mem_Inter.2 (λ n, _),
-  haveI : nonempty β := ⟨n⟩,
-  have : ∀ m, f m ≤ g n := λ m, hf.forall_le_of_antitone hg h m n,
-  exact ⟨le_csupr ⟨g $ n, forall_range_iff.2 this⟩ _, csupr_le this⟩
-end
-
-/-- Nested intervals lemma: if `[f n, g n]` is an antitone sequence of nonempty
-closed intervals, then `⨆ n, f n` belongs to all the intervals `[f n, g n]`. -/
-lemma csupr_mem_Inter_Icc_of_antitone_Icc [semilattice_sup β]
-  {f g : β → α} (h : antitone (λ n, Icc (f n) (g n))) (h' : ∀ n, f n ≤ g n) :
-  (⨆ n, f n) ∈ ⋂ n, Icc (f n) (g n) :=
-monotone.csupr_mem_Inter_Icc_of_antitone (λ m n hmn, ((Icc_subset_Icc_iff (h' n)).1 (h hmn)).1)
-  (λ m n hmn, ((Icc_subset_Icc_iff (h' n)).1 (h hmn)).2) h'
-
-lemma finset.nonempty.sup'_eq_cSup_image {s : finset β} (hs : s.nonempty) (f : β → α) :
-  s.sup' hs f = Sup (f '' s) :=
-eq_of_forall_ge_iff $ λ a,
-  by simp [cSup_le_iff (s.finite_to_set.image f).bdd_above (hs.to_set.image f)]
-
-lemma finset.nonempty.sup'_id_eq_cSup {s : finset α} (hs : s.nonempty) :
-  s.sup' hs id = Sup s :=
-by rw [hs.sup'_eq_cSup_image, image_id]
-
-/--Introduction rule to prove that b is the supremum of s: it suffices to check that
-1) b is an upper bound
-2) every other upper bound b' satisfies b ≤ b'.-/
-theorem cSup_eq_of_is_forall_le_of_forall_le_imp_ge (_ : s.nonempty)
-  (h_is_ub : ∀ a ∈ s, a ≤ b) (h_b_le_ub : ∀ub, (∀ a ∈ s, a ≤ ub) → (b ≤ ub)) : Sup s = b :=
-le_antisymm
-  (show Sup s ≤ b, from cSup_le ‹s.nonempty› h_is_ub)
-  (show b ≤ Sup s, from h_b_le_ub _ $ assume a, le_cSup ⟨b, h_is_ub⟩)
-
-end conditionally_complete_lattice
-
-instance pi.conditionally_complete_lattice {ι : Type*} {α : Π i : ι, Type*}
-  [Π i, conditionally_complete_lattice (α i)] :
-  conditionally_complete_lattice (Π i, α i) :=
-{ le_cSup := λ s f ⟨g, hg⟩ hf i, le_cSup ⟨g i, set.forall_range_iff.2 $ λ ⟨f', hf'⟩, hg hf' i⟩
-    ⟨⟨f, hf⟩, rfl⟩,
-  cSup_le := λ s f hs hf i, cSup_le (by haveI := hs.to_subtype; apply range_nonempty) $
-    λ b ⟨⟨g, hg⟩, hb⟩, hb ▸ hf hg i,
-  cInf_le := λ s f ⟨g, hg⟩ hf i, cInf_le ⟨g i, set.forall_range_iff.2 $ λ ⟨f', hf'⟩, hg hf' i⟩
-    ⟨⟨f, hf⟩, rfl⟩,
-  le_cInf := λ s f hs hf i, le_cInf (by haveI := hs.to_subtype; apply range_nonempty) $
-    λ b ⟨⟨g, hg⟩, hb⟩, hb ▸ hf hg i,
-  .. pi.lattice, .. pi.has_Sup, .. pi.has_Inf }
-
-section conditionally_complete_linear_order
-variables [conditionally_complete_linear_order α] {s t : set α} {a b : α}
-
-lemma finset.nonempty.cSup_eq_max' {s : finset α} (h : s.nonempty) : Sup ↑s = s.max' h :=
-eq_of_forall_ge_iff $ λ a, (cSup_le_iff s.bdd_above h.to_set).trans (s.max'_le_iff h).symm
-
-lemma finset.nonempty.cInf_eq_min' {s : finset α} (h : s.nonempty) : Inf ↑s = s.min' h :=
-@finset.nonempty.cSup_eq_max' αᵒᵈ _ s h
-
-lemma finset.nonempty.cSup_mem {s : finset α} (h : s.nonempty) : Sup (s : set α) ∈ s :=
-by { rw h.cSup_eq_max', exact s.max'_mem _ }
-
-lemma finset.nonempty.cInf_mem {s : finset α} (h : s.nonempty) : Inf (s : set α) ∈ s :=
-@finset.nonempty.cSup_mem αᵒᵈ _ _ h
-
-lemma set.nonempty.cSup_mem (h : s.nonempty) (hs : finite s) : Sup s ∈ s :=
-by { lift s to finset α using hs, exact finset.nonempty.cSup_mem h }
-
-lemma set.nonempty.cInf_mem (h : s.nonempty) (hs : finite s) : Inf s ∈ s :=
-@set.nonempty.cSup_mem αᵒᵈ _ _ h hs
-
-lemma set.finite.cSup_lt_iff (hs : finite s) (h : s.nonempty) : Sup s < a ↔ ∀ x ∈ s, x < a :=
-⟨λ h x hx, (le_cSup hs.bdd_above hx).trans_lt h, λ H, H _ $ h.cSup_mem hs⟩
-
-lemma set.finite.lt_cInf_iff (hs : finite s) (h : s.nonempty) : a < Inf s ↔ ∀ x ∈ s, a < x :=
-@set.finite.cSup_lt_iff αᵒᵈ _ _ _ hs h
-
-/-- When b < Sup s, there is an element a in s with b < a, if s is nonempty and the order is
-a linear order. -/
-lemma exists_lt_of_lt_cSup (hs : s.nonempty) (hb : b < Sup s) : ∃a∈s, b < a :=
-begin
-  classical, contrapose! hb,
-  exact cSup_le hs hb
-end
-
-/--
-Indexed version of the above lemma `exists_lt_of_lt_cSup`.
-When `b < supr f`, there is an element `i` such that `b < f i`.
--/
-lemma exists_lt_of_lt_csupr [nonempty ι] {f : ι → α} (h : b < supr f) :
-  ∃i, b < f i :=
-let ⟨_, ⟨i, rfl⟩, h⟩ := exists_lt_of_lt_cSup (range_nonempty f) h in ⟨i, h⟩
-
-/--When Inf s < b, there is an element a in s with a < b, if s is nonempty and the order is
-a linear order.-/
-lemma exists_lt_of_cInf_lt (hs : s.nonempty) (hb : Inf s < b) : ∃a∈s, a < b :=
-@exists_lt_of_lt_cSup αᵒᵈ _ _ _ hs hb
-
-/--
-Indexed version of the above lemma `exists_lt_of_cInf_lt`
-When `infi f < a`, there is an element `i` such that `f i < a`.
--/
-lemma exists_lt_of_cinfi_lt [nonempty ι] {f : ι → α} (h : infi f < a) :
-  (∃i, f i < a) :=
-@exists_lt_of_lt_csupr αᵒᵈ _ _ _ _ _ h
-
-open function
-variables [is_well_order α (<)]
-
-lemma Inf_eq_argmin_on (hs : s.nonempty) : Inf s = argmin_on id (@is_well_order.wf α (<) _) s hs :=
-is_least.cInf_eq ⟨argmin_on_mem _ _ _ _, λ a ha, argmin_on_le id _ _ ha⟩
-
-lemma is_least_Inf (hs : s.nonempty) : is_least s (Inf s) :=
-by { rw Inf_eq_argmin_on hs, exact ⟨argmin_on_mem _ _ _ _, λ a ha, argmin_on_le id _ _ ha⟩ }
-
-lemma le_cInf_iff' (hs : s.nonempty) : b ≤ Inf s ↔ b ∈ lower_bounds s :=
-le_is_glb_iff (is_least_Inf hs).is_glb
-
-lemma Inf_mem (hs : s.nonempty) : Inf s ∈ s := (is_least_Inf hs).1
-
-end conditionally_complete_linear_order
-
-/-!
-### Lemmas about a conditionally complete linear order with bottom element
-
-In this case we have `Sup ∅ = ⊥`, so we can drop some `nonempty`/`set.nonempty` assumptions.
--/
-
-section conditionally_complete_linear_order_bot
-
-variables [conditionally_complete_linear_order_bot α]
-
-@[simp] lemma cSup_empty : (Sup ∅ : α) = ⊥ :=
-conditionally_complete_linear_order_bot.cSup_empty
-
-@[simp] lemma csupr_of_empty [is_empty ι] (f : ι → α) : (⨆ i, f i) = ⊥ :=
-by rw [supr_of_empty', cSup_empty]
-
-@[simp] lemma csupr_false (f : false → α) : (⨆ i, f i) = ⊥ := csupr_of_empty f
-
-lemma is_lub_cSup' {s : set α} (hs : bdd_above s) : is_lub s (Sup s) :=
-begin
-  rcases eq_empty_or_nonempty s with (rfl|hne),
-  { simp only [cSup_empty, is_lub_empty] },
-  { exact is_lub_cSup hne hs }
-end
-
-lemma cSup_le_iff' {s : set α} (hs : bdd_above s) {a : α} : Sup s ≤ a ↔ ∀ x ∈ s, x ≤ a :=
-is_lub_le_iff (is_lub_cSup' hs)
-
-lemma cSup_le' {s : set α} {a : α} (h : a ∈ upper_bounds s) : Sup s ≤ a :=
-(cSup_le_iff' ⟨a, h⟩).2 h
-
-theorem le_cSup_iff' {s : set α} {a : α} (h : bdd_above s) :
-  a ≤ Sup s ↔ ∀ b, b ∈ upper_bounds s → a ≤ b :=
-⟨λ h b hb, le_trans h (cSup_le' hb), λ hb, hb _ (λ x, le_cSup h)⟩
-
-theorem le_cInf_iff'' {s : set α} {a : α} (ne : s.nonempty) :
-  a ≤ Inf s ↔ ∀ (b : α), b ∈ s → a ≤ b :=
-le_cInf_iff ⟨⊥, λ a _, bot_le⟩ ne
-
-theorem cInf_le' {s : set α} {a : α} (h : a ∈ s) : Inf s ≤ a :=
-cInf_le ⟨⊥, λ a _, bot_le⟩ h
-
-lemma exists_lt_of_lt_cSup' {s : set α} {a : α} (h : a < Sup s) : ∃ b ∈ s, a < b :=
-by { contrapose! h, exact cSup_le' h }
-
-lemma csupr_le_iff' {f : ι → α} (h : bdd_above (range f)) {a : α} :
-  (⨆ i, f i) ≤ a ↔ ∀ i, f i ≤ a :=
-(cSup_le_iff' h).trans forall_range_iff
-
-lemma csupr_le' {f : ι → α} {a : α} (h : ∀ i, f i ≤ a) : (⨆ i, f i) ≤ a :=
-cSup_le' $ forall_range_iff.2 h
-
-lemma exists_lt_of_lt_csupr' {f : ι → α} {a : α} (h : a < ⨆ i, f i) : ∃ i, a < f i :=
-by { contrapose! h, exact csupr_le' h }
-
-end conditionally_complete_linear_order_bot
-
-namespace with_top
-open_locale classical
-
-variables [conditionally_complete_linear_order_bot α]
-
-/-- The Sup of a non-empty set is its least upper bound for a conditionally
-complete lattice with a top. -/
-lemma is_lub_Sup' {β : Type*} [conditionally_complete_lattice β]
-  {s : set (with_top β)} (hs : s.nonempty) : is_lub s (Sup s) :=
-begin
-  split,
-  { show ite _ _ _ ∈ _,
-    split_ifs,
-    { intros _ _, exact le_top },
-    { rintro (⟨⟩|a) ha,
-      { contradiction },
-      apply some_le_some.2,
-      exact le_cSup h_1 ha },
-    { intros _ _, exact le_top } },
-  { show ite _ _ _ ∈ _,
-    split_ifs,
-    { rintro (⟨⟩|a) ha,
-      { exact _root_.le_rfl },
-      { exact false.elim (not_top_le_coe a (ha h)) } },
-    { rintro (⟨⟩|b) hb,
-      { exact le_top },
-      refine some_le_some.2 (cSup_le _ _),
-      { rcases hs with ⟨⟨⟩|b, hb⟩,
-        { exact absurd hb h },
-        { exact ⟨b, hb⟩ } },
-      { intros a ha, exact some_le_some.1 (hb ha) } },
-    { rintro (⟨⟩|b) hb,
-      { exact _root_.le_rfl },
-      { exfalso, apply h_1, use b, intros a ha, exact some_le_some.1 (hb ha) } } }
-end
-
-lemma is_lub_Sup (s : set (with_top α)) : is_lub s (Sup s) :=
-begin
-  cases s.eq_empty_or_nonempty with hs hs,
-  { rw hs,
-    show is_lub ∅ (ite _ _ _),
-    split_ifs,
-    { cases h },
-    { rw [preimage_empty, cSup_empty], exact is_lub_empty },
-    { exfalso, apply h_1, use ⊥, rintro a ⟨⟩ } },
-  exact is_lub_Sup' hs,
-end
-
-/-- The Inf of a bounded-below set is its greatest lower bound for a conditionally
-complete lattice with a top. -/
-lemma is_glb_Inf' {β : Type*} [conditionally_complete_lattice β]
-  {s : set (with_top β)} (hs : bdd_below s) : is_glb s (Inf s) :=
-begin
-  split,
-  { show ite _ _ _ ∈ _,
-    split_ifs,
-    { intros a ha, exact top_le_iff.2 (set.mem_singleton_iff.1 (h ha)) },
-    { rintro (⟨⟩|a) ha,
-      { exact le_top },
-      refine some_le_some.2 (cInf_le _ ha),
-      rcases hs with ⟨⟨⟩|b, hb⟩,
-      { exfalso,
-        apply h,
-        intros c hc,
-        rw [mem_singleton_iff, ←top_le_iff],
-        exact hb hc },
-      use b,
-      intros c hc,
-      exact some_le_some.1 (hb hc) } },
-  { show ite _ _ _ ∈ _,
-    split_ifs,
-    { intros _ _, exact le_top },
-    { rintro (⟨⟩|a) ha,
-      { exfalso, apply h, intros b hb, exact set.mem_singleton_iff.2 (top_le_iff.1 (ha hb)) },
-      { refine some_le_some.2 (le_cInf _ _),
-        { classical, contrapose! h,
-          rintros (⟨⟩|a) ha,
-          { exact mem_singleton ⊤ },
-          { exact (h ⟨a, ha⟩).elim }},
-        { intros b hb,
-          rw ←some_le_some,
-          exact ha hb } } } }
-end
-
-lemma is_glb_Inf (s : set (with_top α)) : is_glb s (Inf s) :=
-begin
-  by_cases hs : bdd_below s,
-  { exact is_glb_Inf' hs },
-  { exfalso, apply hs, use ⊥, intros _ _, exact bot_le },
-end
-
-noncomputable instance : complete_linear_order (with_top α) :=
-{ Sup := Sup, le_Sup := assume s, (is_lub_Sup s).1, Sup_le := assume s, (is_lub_Sup s).2,
-  Inf := Inf, le_Inf := assume s, (is_glb_Inf s).2, Inf_le := assume s, (is_glb_Inf s).1,
-  .. with_top.linear_order, ..with_top.lattice, ..with_top.order_top, ..with_top.order_bot }
-
-lemma coe_Sup {s : set α} (hb : bdd_above s) : (↑(Sup s) : with_top α) = (⨆a∈s, ↑a) :=
-begin
-  cases s.eq_empty_or_nonempty with hs hs,
-  { rw [hs, cSup_empty], simp only [set.mem_empty_eq, supr_bot, supr_false], refl },
-  apply le_antisymm,
-  { refine (coe_le_iff.2 $ assume b hb, cSup_le hs $ assume a has, coe_le_coe.1 $ hb ▸ _),
-    exact (le_supr_of_le a $ le_supr_of_le has $ _root_.le_rfl) },
-  { exact (supr_le $ assume a, supr_le $ assume ha, coe_le_coe.2 $ le_cSup hb ha) }
-end
-
-lemma coe_Inf {s : set α} (hs : s.nonempty) : (↑(Inf s) : with_top α) = (⨅a∈s, ↑a) :=
-let ⟨x, hx⟩ := hs in
-have (⨅a∈s, ↑a : with_top α) ≤ x, from infi_le_of_le x $ infi_le_of_le hx $ _root_.le_rfl,
-let ⟨r, r_eq, hr⟩ := le_coe_iff.1 this in
-le_antisymm
-  (le_infi $ assume a, le_infi $ assume ha, coe_le_coe.2 $ cInf_le (order_bot.bdd_below s) ha)
-  begin
-    refine (r_eq.symm ▸ coe_le_coe.2 $ le_cInf hs $ assume a has, coe_le_coe.1 $ _),
-    refine (r_eq ▸ infi_le_of_le a _),
-    exact (infi_le_of_le has $ _root_.le_rfl),
-  end
-
-end with_top
-
-namespace monotone
-variables [preorder α] [conditionally_complete_lattice β] {f : α → β} (h_mono : monotone f)
-
-/-! A monotone function into a conditionally complete lattice preserves the ordering properties of
-`Sup` and `Inf`. -/
-
-lemma le_cSup_image {s : set α} {c : α} (hcs : c ∈ s) (h_bdd : bdd_above s) :
-  f c ≤ Sup (f '' s) :=
-le_cSup (map_bdd_above h_mono h_bdd) (mem_image_of_mem f hcs)
-
-lemma cSup_image_le {s : set α} (hs : s.nonempty) {B : α} (hB: B ∈ upper_bounds s) :
-  Sup (f '' s) ≤ f B :=
-cSup_le (nonempty.image f hs) (h_mono.mem_upper_bounds_image hB)
-
-lemma cInf_image_le {s : set α} {c : α} (hcs : c ∈ s) (h_bdd : bdd_below s) :
-  Inf (f '' s) ≤ f c :=
-@le_cSup_image αᵒᵈ βᵒᵈ _ _ _ (λ x y hxy, h_mono hxy) _ _ hcs h_bdd
-
-lemma le_cInf_image {s : set α} (hs : s.nonempty) {B : α} (hB: B ∈ lower_bounds s) :
-  f B ≤ Inf (f '' s) :=
-@cSup_image_le αᵒᵈ βᵒᵈ _ _ _ (λ x y hxy, h_mono hxy) _ hs _ hB
-
-end monotone
-
-namespace galois_connection
-
-variables {γ : Type*} [conditionally_complete_lattice α] [conditionally_complete_lattice β]
-  [nonempty ι] {l : α → β} {u : β → α}
-
-lemma l_cSup (gc : galois_connection l u) {s : set α} (hne : s.nonempty)
-  (hbdd : bdd_above s) :
-  l (Sup s) = ⨆ x : s, l x :=
-eq.symm $ is_lub.csupr_set_eq (gc.is_lub_l_image $ is_lub_cSup hne hbdd) hne
-
-lemma l_cSup' (gc : galois_connection l u) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
-  l (Sup s) = Sup (l '' s) :=
-by rw [gc.l_cSup hne hbdd, csupr_set]
-
-lemma l_csupr (gc : galois_connection l u) {f : ι → α}
-  (hf : bdd_above (range f)) :
-  l (⨆ i, f i) = ⨆ i, l (f i) :=
-by rw [supr, gc.l_cSup (range_nonempty _) hf, supr_range']
-
-lemma l_csupr_set (gc : galois_connection l u) {s : set γ} {f : γ → α}
-  (hf : bdd_above (f '' s)) (hne : s.nonempty) :
-  l (⨆ i : s, f i) = ⨆ i : s, l (f i) :=
-by { haveI := hne.to_subtype, rw image_eq_range at hf, exact gc.l_csupr hf }
-
-lemma u_cInf (gc : galois_connection l u) {s : set β} (hne : s.nonempty)
-  (hbdd : bdd_below s) :
-  u (Inf s) = ⨅ x : s, u x :=
-gc.dual.l_cSup hne hbdd
-
-lemma u_cInf' (gc : galois_connection l u) {s : set β} (hne : s.nonempty) (hbdd : bdd_below s) :
-  u (Inf s) = Inf (u '' s) :=
-gc.dual.l_cSup' hne hbdd
-
-lemma u_cinfi (gc : galois_connection l u) {f : ι → β}
-  (hf : bdd_below (range f)) :
-  u (⨅ i, f i) = ⨅ i, u (f i) :=
-gc.dual.l_csupr hf
-
-lemma u_cinfi_set (gc : galois_connection l u) {s : set γ} {f : γ → β}
-  (hf : bdd_below (f '' s)) (hne : s.nonempty) :
-  u (⨅ i : s, f i) = ⨅ i : s, u (f i) :=
-gc.dual.l_csupr_set hf hne
-
-end galois_connection
-
-namespace order_iso
-
-variables {γ : Type*} [conditionally_complete_lattice α] [conditionally_complete_lattice β]
-  [nonempty ι]
-
-lemma map_cSup (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
-  e (Sup s) = ⨆ x : s, e x :=
-e.to_galois_connection.l_cSup hne hbdd
-
-lemma map_cSup' (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
-  e (Sup s) = Sup (e '' s) :=
-e.to_galois_connection.l_cSup' hne hbdd
-
-lemma map_csupr (e : α ≃o β) {f : ι → α} (hf : bdd_above (range f)) :
-  e (⨆ i, f i) = ⨆ i, e (f i) :=
-e.to_galois_connection.l_csupr hf
-
-lemma map_csupr_set (e : α ≃o β) {s : set γ} {f : γ → α}
-  (hf : bdd_above (f '' s)) (hne : s.nonempty) :
-  e (⨆ i : s, f i) = ⨆ i : s, e (f i) :=
-e.to_galois_connection.l_csupr_set hf hne
-
-lemma map_cInf (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_below s) :
-  e (Inf s) = ⨅ x : s, e x :=
-e.dual.map_cSup hne hbdd
-
-lemma map_cInf' (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_below s) :
-  e (Inf s) = Inf (e '' s) :=
-e.dual.map_cSup' hne hbdd
-
-lemma map_cinfi (e : α ≃o β) {f : ι → α} (hf : bdd_below (range f)) :
-  e (⨅ i, f i) = ⨅ i, e (f i) :=
-e.dual.map_csupr hf
-
-lemma map_cinfi_set (e : α ≃o β) {s : set γ} {f : γ → α}
-  (hf : bdd_below (f '' s)) (hne : s.nonempty) :
-  e (⨅ i : s, f i) = ⨅ i : s, e (f i) :=
-e.dual.map_csupr_set hf hne
-
-end order_iso
-
-/-!
-### Relation between `Sup` / `Inf` and `finset.sup'` / `finset.inf'`
-
-Like the `Sup` of a `conditionally_complete_lattice`, `finset.sup'` also requires the set to be
-non-empty. As a result, we can translate between the two.
--/
-
-namespace finset
-
-lemma sup'_eq_cSup_image [conditionally_complete_lattice β] (s : finset α) (H) (f : α → β) :
-  s.sup' H f = Sup (f '' s) :=
-begin
-  apply le_antisymm,
-  { refine (finset.sup'_le _ _ $ λ a ha, _),
-    refine le_cSup ⟨s.sup' H f, _⟩ ⟨a, ha, rfl⟩,
-    rintros i ⟨j, hj, rfl⟩,
-    exact finset.le_sup' _ hj },
-  { apply cSup_le ((coe_nonempty.mpr H).image _),
-    rintros _ ⟨a, ha, rfl⟩,
-    exact finset.le_sup' _ ha, }
-end
-
-lemma inf'_eq_cInf_image [conditionally_complete_lattice β] (s : finset α) (H) (f : α → β) :
-  s.inf' H f = Inf (f '' s) :=
-@sup'_eq_cSup_image _ βᵒᵈ _ _ _ _
-
-lemma sup'_id_eq_cSup [conditionally_complete_lattice α] (s : finset α) (H) :
-  s.sup' H id = Sup s :=
-by rw [sup'_eq_cSup_image s H, set.image_id]
-
-lemma inf'_id_eq_cInf [conditionally_complete_lattice α] (s : finset α) (H) :
-  s.inf' H id = Inf s :=
-@sup'_id_eq_cSup αᵒᵈ _ _ _
-
-end finset
-
-section with_top_bot
-
-/-!
-### Complete lattice structure on `with_top (with_bot α)`
-
-If `α` is a `conditionally_complete_lattice`, then we show that `with_top α` and `with_bot α`
-also inherit the structure of conditionally complete lattices. Furthermore, we show
-that `with_top (with_bot α)` naturally inherits the structure of a complete lattice. Note that
-for α a conditionally complete lattice, `Sup` and `Inf` both return junk values
-for sets which are empty or unbounded. The extension of `Sup` to `with_top α` fixes
-the unboundedness problem and the extension to `with_bot α` fixes the problem with
-the empty set.
-
-This result can be used to show that the extended reals [-∞, ∞] are a complete lattice.
--/
-
-open_locale classical
-
-/-- Adding a top element to a conditionally complete lattice
-gives a conditionally complete lattice -/
-noncomputable instance with_top.conditionally_complete_lattice
-  {α : Type*} [conditionally_complete_lattice α] :
-  conditionally_complete_lattice (with_top α) :=
-{ le_cSup := λ S a hS haS, (with_top.is_lub_Sup' ⟨a, haS⟩).1 haS,
-  cSup_le := λ S a hS haS, (with_top.is_lub_Sup' hS).2 haS,
-  cInf_le := λ S a hS haS, (with_top.is_glb_Inf' hS).1 haS,
-  le_cInf := λ S a hS haS, (with_top.is_glb_Inf' ⟨a, haS⟩).2 haS,
-  ..with_top.lattice,
-  ..with_top.has_Sup,
-  ..with_top.has_Inf }
-
-/-- Adding a bottom element to a conditionally complete lattice
-gives a conditionally complete lattice -/
-noncomputable instance with_bot.conditionally_complete_lattice
-  {α : Type*} [conditionally_complete_lattice α] :
-  conditionally_complete_lattice (with_bot α) :=
-{ le_cSup := (@with_top.conditionally_complete_lattice αᵒᵈ _).cInf_le,
-  cSup_le := (@with_top.conditionally_complete_lattice αᵒᵈ _).le_cInf,
-  cInf_le := (@with_top.conditionally_complete_lattice αᵒᵈ _).le_cSup,
-  le_cInf := (@with_top.conditionally_complete_lattice αᵒᵈ _).cSup_le,
-  ..with_bot.lattice,
-  ..with_bot.has_Sup,
-  ..with_bot.has_Inf }
-
-noncomputable instance with_top.with_bot.complete_lattice {α : Type*}
-  [conditionally_complete_lattice α] : complete_lattice (with_top (with_bot α)) :=
-{ le_Sup := λ S a haS, (with_top.is_lub_Sup' ⟨a, haS⟩).1 haS,
-  Sup_le := λ S a ha,
-    begin
-      cases S.eq_empty_or_nonempty with h,
-      { show ite _ _ _ ≤ a,
-        split_ifs,
-        { rw h at h_1, cases h_1 },
-        { convert bot_le, convert with_bot.cSup_empty, rw h, refl },
-        { exfalso, apply h_2, use ⊥, rw h, rintro b ⟨⟩ } },
-      { refine (with_top.is_lub_Sup' h).2 ha }
-    end,
-  Inf_le := λ S a haS,
-    show ite _ _ _ ≤ a,
-    begin
-      split_ifs,
-      { cases a with a, exact _root_.le_rfl,
-        cases (h haS); tauto },
-      { cases a,
-        { exact le_top },
-        { apply with_top.some_le_some.2, refine cInf_le _ haS, use ⊥, intros b hb, exact bot_le } }
-    end,
-  le_Inf := λ S a haS, (with_top.is_glb_Inf' ⟨a, haS⟩).2 haS,
-  ..with_top.has_Inf,
-  ..with_top.has_Sup,
-  ..with_top.bounded_order,
-  ..with_top.lattice }
-
-noncomputable instance with_top.with_bot.complete_linear_order {α : Type*}
-  [conditionally_complete_linear_order α] : complete_linear_order (with_top (with_bot α)) :=
-{ .. with_top.with_bot.complete_lattice,
-  .. with_top.linear_order }
-
-end with_top_bot
-
-section group
-
-variables [nonempty ι] [conditionally_complete_lattice α] [group α]
-
-@[to_additive]
-lemma le_mul_cinfi [covariant_class α α (*) (≤)] {a : α} {g : α} {h : ι → α}
-  (H : ∀ j, a ≤ g * h j) : a ≤ g * infi h :=
-inv_mul_le_iff_le_mul.mp $ le_cinfi $ λ hi, inv_mul_le_iff_le_mul.mpr $ H _
-
-@[to_additive]
-lemma mul_csupr_le [covariant_class α α (*) (≤)] {a : α} {g : α} {h : ι → α}
-  (H : ∀ j, g * h j ≤ a) : g * supr h ≤ a :=
-@le_mul_cinfi αᵒᵈ _ _ _ _ _ _ _ _ H
-
-@[to_additive]
-lemma le_cinfi_mul [covariant_class α α (function.swap (*)) (≤)] {a : α} {g : ι → α} {h : α}
-  (H : ∀ i, a ≤ g i * h) : a ≤ infi g * h :=
-mul_inv_le_iff_le_mul.mp $ le_cinfi $ λ gi, mul_inv_le_iff_le_mul.mpr $ H _
-
-@[to_additive]
-lemma csupr_mul_le [covariant_class α α (function.swap (*)) (≤)] {a : α} {g : ι → α} {h : α}
-  (H : ∀ i, g i * h ≤ a) : supr g * h ≤ a :=
-@le_cinfi_mul αᵒᵈ _ _ _ _ _ _ _ _ H
-
-@[to_additive]
-lemma le_cinfi_mul_cinfi [covariant_class α α (*) (≤)] [covariant_class α α (function.swap (*)) (≤)]
-  {a : α} {g h : ι → α} (H : ∀ i j, a ≤ g i * h j) : a ≤ infi g * infi h :=
-le_cinfi_mul $ λ i, le_mul_cinfi $ H _
-
-@[to_additive]
-lemma csupr_mul_csupr_le [covariant_class α α (*) (≤)] [covariant_class α α (function.swap (*)) (≤)]
-  {a : α} {g h : ι → α} (H : ∀ i j, g i * h j ≤ a) : supr g * supr h ≤ a :=
-csupr_mul_le $ λ i, mul_csupr_le $ H _
-
-end group
diff --git a/src/order/conditionally_complete_lattice/basic.lean b/src/order/conditionally_complete_lattice/basic.lean
new file mode 100644
index 0000000000000..1f9cbdbbe8cda
--- /dev/null
+++ b/src/order/conditionally_complete_lattice/basic.lean
@@ -0,0 +1,1274 @@
+/-
+Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import order.bounds.basic
+import order.well_founded
+import data.set.intervals.basic
+import data.set.lattice
+
+/-!
+# Theory of conditionally complete lattices.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A conditionally complete lattice is a lattice in which every non-empty bounded subset `s`
+has a least upper bound and a greatest lower bound, denoted below by `Sup s` and `Inf s`.
+Typical examples are `ℝ`, `ℕ`, and `ℤ` with their usual orders.
+
+The theory is very comparable to the theory of complete lattices, except that suitable
+boundedness and nonemptiness assumptions have to be added to most statements.
+We introduce two predicates `bdd_above` and `bdd_below` to express this boundedness, prove
+their basic properties, and then go on to prove most useful properties of `Sup` and `Inf`
+in conditionally complete lattices.
+
+To differentiate the statements between complete lattices and conditionally complete
+lattices, we prefix `Inf` and `Sup` in the statements by `c`, giving `cInf` and `cSup`.
+For instance, `Inf_le` is a statement in complete lattices ensuring `Inf s ≤ x`,
+while `cInf_le` is the same statement in conditionally complete lattices
+with an additional assumption that `s` is bounded below.
+-/
+
+set_option old_structure_cmd true
+
+open function order_dual set
+
+variables {α β γ : Type*} {ι : Sort*}
+
+section
+
+/-!
+Extension of Sup and Inf from a preorder `α` to `with_top α` and `with_bot α`
+-/
+
+open_locale classical
+
+noncomputable instance {α : Type*} [preorder α] [has_Sup α] : has_Sup (with_top α) :=
+⟨λ S, if ⊤ ∈ S then ⊤ else
+  if bdd_above (coe ⁻¹' S : set α) then ↑(Sup (coe ⁻¹' S : set α)) else ⊤⟩
+
+noncomputable instance {α : Type*} [has_Inf α] : has_Inf (with_top α) :=
+⟨λ S, if S ⊆ {⊤} then ⊤ else ↑(Inf (coe ⁻¹' S : set α))⟩
+
+noncomputable instance {α : Type*} [has_Sup α] : has_Sup (with_bot α) :=
+⟨(@with_top.has_Inf αᵒᵈ _).Inf⟩
+
+noncomputable instance {α : Type*} [preorder α] [has_Inf α] : has_Inf (with_bot α) :=
+⟨(@with_top.has_Sup αᵒᵈ _ _).Sup⟩
+
+lemma with_top.Sup_eq [preorder α] [has_Sup α] {s : set (with_top α)} (hs : ⊤ ∉ s)
+  (hs' : bdd_above (coe ⁻¹' s : set α)) : Sup s = ↑(Sup (coe ⁻¹' s) : α) :=
+(if_neg hs).trans $ if_pos hs'
+
+lemma with_top.Inf_eq [has_Inf α] {s : set (with_top α)} (hs : ¬ s ⊆ {⊤}) :
+  Inf s = ↑(Inf (coe ⁻¹' s) : α) := if_neg hs
+
+lemma with_bot.Inf_eq [preorder α] [has_Inf α] {s : set (with_bot α)} (hs : ⊥ ∉ s)
+  (hs' : bdd_below (coe ⁻¹' s : set α)) : Inf s = ↑(Inf (coe ⁻¹' s) : α) :=
+(if_neg hs).trans $ if_pos hs'
+
+lemma with_bot.Sup_eq [has_Sup α] {s : set (with_bot α)} (hs : ¬ s ⊆ {⊥}) :
+  Sup s = ↑(Sup (coe ⁻¹' s) : α) := if_neg hs
+
+@[simp]
+theorem with_top.cInf_empty {α : Type*} [has_Inf α] : Inf (∅ : set (with_top α)) = ⊤ :=
+if_pos $ set.empty_subset _
+
+@[simp]
+theorem with_top.cinfi_empty {α : Type*} [is_empty ι] [has_Inf α] (f : ι → with_top α) :
+  (⨅ i, f i) = ⊤ :=
+by rw [infi, range_eq_empty, with_top.cInf_empty]
+
+lemma with_top.coe_Inf' [has_Inf α] {s : set α} (hs : s.nonempty) :
+  ↑(Inf s) = (Inf (coe '' s) : with_top α) :=
+begin
+  obtain ⟨x, hx⟩ := hs,
+  change _ = ite _ _ _,
+  split_ifs,
+  { cases h (mem_image_of_mem _ hx) },
+  { rw preimage_image_eq,
+    exact option.some_injective _ },
+end
+
+@[norm_cast] lemma with_top.coe_infi [nonempty ι] [has_Inf α] (f : ι → α) :
+  ↑(⨅ i, f i) = (⨅ i, f i : with_top α) :=
+by rw [infi, infi, with_top.coe_Inf' (range_nonempty f), range_comp]
+
+theorem with_top.coe_Sup' [preorder α] [has_Sup α] {s : set α} (hs : bdd_above s) :
+  ↑(Sup s) = (Sup (coe '' s) : with_top α) :=
+begin
+  change _ = ite _ _ _,
+  rw [if_neg, preimage_image_eq, if_pos hs],
+  { exact option.some_injective _ },
+  { rintro ⟨x, h, ⟨⟩⟩ },
+end
+
+@[norm_cast] lemma with_top.coe_supr [preorder α] [has_Sup α] (f : ι → α)
+  (h : bdd_above (set.range f)) :
+  ↑(⨆ i, f i) = (⨆ i, f i : with_top α) :=
+by rw [supr, supr, with_top.coe_Sup' h, range_comp]
+
+@[simp]
+theorem with_bot.cSup_empty {α : Type*} [has_Sup α] : Sup (∅ : set (with_bot α)) = ⊥ :=
+if_pos $ set.empty_subset _
+
+@[simp]
+theorem with_bot.csupr_empty {α : Type*} [is_empty ι] [has_Sup α] (f : ι → with_bot α) :
+  (⨆ i, f i) = ⊥ :=
+@with_top.cinfi_empty _ αᵒᵈ _ _ _
+
+@[norm_cast] lemma with_bot.coe_Sup' [has_Sup α] {s : set α} (hs : s.nonempty) :
+  ↑(Sup s) = (Sup (coe '' s) : with_bot α) :=
+@with_top.coe_Inf' αᵒᵈ _ _ hs
+
+@[norm_cast] lemma with_bot.coe_supr [nonempty ι] [has_Sup α] (f : ι → α) :
+  ↑(⨆ i, f i) = (⨆ i, f i : with_bot α) :=
+@with_top.coe_infi αᵒᵈ _ _ _ _
+
+@[norm_cast] theorem with_bot.coe_Inf' [preorder α] [has_Inf α] {s : set α} (hs : bdd_below s) :
+  ↑(Inf s) = (Inf (coe '' s) : with_bot α) :=
+@with_top.coe_Sup' αᵒᵈ _ _ _ hs
+
+@[norm_cast] lemma with_bot.coe_infi [preorder α] [has_Inf α] (f : ι → α)
+  (h : bdd_below (set.range f)) :
+  ↑(⨅ i, f i) = (⨅ i, f i : with_bot α) :=
+@with_top.coe_supr αᵒᵈ _ _ _ _ h
+
+end -- section
+
+/-- A conditionally complete lattice is a lattice in which
+every nonempty subset which is bounded above has a supremum, and
+every nonempty subset which is bounded below has an infimum.
+Typical examples are real numbers or natural numbers.
+
+To differentiate the statements from the corresponding statements in (unconditional)
+complete lattices, we prefix Inf and Sup by a c everywhere. The same statements should
+hold in both worlds, sometimes with additional assumptions of nonemptiness or
+boundedness.-/
+class conditionally_complete_lattice (α : Type*) extends lattice α, has_Sup α, has_Inf α :=
+(le_cSup : ∀ s a, bdd_above s → a ∈ s → a ≤ Sup s)
+(cSup_le : ∀ s a, set.nonempty s → a ∈ upper_bounds s → Sup s ≤ a)
+(cInf_le : ∀ s a, bdd_below s → a ∈ s → Inf s ≤ a)
+(le_cInf : ∀ s a, set.nonempty s → a ∈ lower_bounds s → a ≤ Inf s)
+
+/-- A conditionally complete linear order is a linear order in which
+every nonempty subset which is bounded above has a supremum, and
+every nonempty subset which is bounded below has an infimum.
+Typical examples are real numbers or natural numbers.
+
+To differentiate the statements from the corresponding statements in (unconditional)
+complete linear orders, we prefix Inf and Sup by a c everywhere. The same statements should
+hold in both worlds, sometimes with additional assumptions of nonemptiness or
+boundedness.-/
+class conditionally_complete_linear_order (α : Type*)
+  extends conditionally_complete_lattice α, linear_order α renaming max → sup min → inf
+
+/-- A conditionally complete linear order with `bot` is a linear order with least element, in which
+every nonempty subset which is bounded above has a supremum, and every nonempty subset (necessarily
+bounded below) has an infimum.  A typical example is the natural numbers.
+
+To differentiate the statements from the corresponding statements in (unconditional)
+complete linear orders, we prefix Inf and Sup by a c everywhere. The same statements should
+hold in both worlds, sometimes with additional assumptions of nonemptiness or
+boundedness.-/
+@[ancestor conditionally_complete_linear_order has_bot]
+class conditionally_complete_linear_order_bot (α : Type*)
+  extends conditionally_complete_linear_order α, has_bot α :=
+(bot_le : ∀ x : α, ⊥ ≤ x)
+(cSup_empty : Sup ∅ = ⊥)
+
+@[priority 100]  -- see Note [lower instance priority]
+instance conditionally_complete_linear_order_bot.to_order_bot
+  [h : conditionally_complete_linear_order_bot α] : order_bot α :=
+{ ..h }
+
+/-- A complete lattice is a conditionally complete lattice, as there are no restrictions
+on the properties of Inf and Sup in a complete lattice.-/
+@[priority 100] -- see Note [lower instance priority]
+instance complete_lattice.to_conditionally_complete_lattice [complete_lattice α] :
+  conditionally_complete_lattice α :=
+{ le_cSup := by intros; apply le_Sup; assumption,
+  cSup_le := by intros; apply Sup_le; assumption,
+  cInf_le := by intros; apply Inf_le; assumption,
+  le_cInf := by intros; apply le_Inf; assumption,
+  ..‹complete_lattice α› }
+
+@[priority 100] -- see Note [lower instance priority]
+instance complete_linear_order.to_conditionally_complete_linear_order_bot {α : Type*}
+  [complete_linear_order α] :
+  conditionally_complete_linear_order_bot α :=
+{ cSup_empty := Sup_empty,
+  ..complete_lattice.to_conditionally_complete_lattice, .. ‹complete_linear_order α› }
+
+section
+open_locale classical
+
+/-- A well founded linear order is conditionally complete, with a bottom element. -/
+@[reducible] noncomputable def is_well_order.conditionally_complete_linear_order_bot
+  (α : Type*) [i₁ : linear_order α] [i₂ : order_bot α] [h : is_well_order α (<)] :
+  conditionally_complete_linear_order_bot α :=
+{ Inf := λ s, if hs : s.nonempty then h.wf.min s hs else ⊥,
+  cInf_le := λ s a hs has, begin
+    have s_ne : s.nonempty := ⟨a, has⟩,
+    simpa [s_ne] using not_lt.1 (h.wf.not_lt_min s s_ne has),
+  end,
+  le_cInf := λ s a hs has, begin
+    simp only [hs, dif_pos],
+    exact has (h.wf.min_mem s hs),
+  end,
+  Sup := λ s, if hs : (upper_bounds s).nonempty then h.wf.min _ hs else ⊥,
+  le_cSup := λ s a hs has, begin
+    have h's : (upper_bounds s).nonempty := hs,
+    simp only [h's, dif_pos],
+    exact h.wf.min_mem _ h's has,
+  end,
+  cSup_le := λ s a hs has, begin
+    have h's : (upper_bounds s).nonempty := ⟨a, has⟩,
+    simp only [h's, dif_pos],
+    simpa using h.wf.not_lt_min _ h's has,
+  end,
+  cSup_empty := by simpa using eq_bot_iff.2 (not_lt.1 $ h.wf.not_lt_min _ _ $ mem_univ ⊥),
+  ..i₁, ..i₂, ..linear_order.to_lattice }
+
+end
+
+section order_dual
+
+instance (α : Type*) [conditionally_complete_lattice α] : conditionally_complete_lattice αᵒᵈ :=
+{ le_cSup := @conditionally_complete_lattice.cInf_le α _,
+  cSup_le := @conditionally_complete_lattice.le_cInf α _,
+  le_cInf := @conditionally_complete_lattice.cSup_le α _,
+  cInf_le := @conditionally_complete_lattice.le_cSup α _,
+  ..order_dual.has_Inf α,
+  ..order_dual.has_Sup α,
+  ..order_dual.lattice α }
+
+instance (α : Type*) [conditionally_complete_linear_order α] :
+  conditionally_complete_linear_order αᵒᵈ :=
+{ ..order_dual.conditionally_complete_lattice α,
+  ..order_dual.linear_order α }
+
+end order_dual
+
+/-- Create a `conditionally_complete_lattice` from a `partial_order` and `Sup` function
+that returns the least upper bound of a nonempty set which is bounded above. Usually this
+constructor provides poor definitional equalities.  If other fields are known explicitly, they
+should be provided; for example, if `inf` is known explicitly, construct the
+`conditionally_complete_lattice` instance as
+```
+instance : conditionally_complete_lattice my_T :=
+{ inf := better_inf,
+  le_inf := ...,
+  inf_le_right := ...,
+  inf_le_left := ...
+  -- don't care to fix sup, Inf
+  ..conditionally_complete_lattice_of_Sup my_T _ }
+```
+-/
+def conditionally_complete_lattice_of_Sup (α : Type*) [H1 : partial_order α]
+  [H2 : has_Sup α]
+  (bdd_above_pair : ∀ a b : α, bdd_above ({a, b} : set α))
+  (bdd_below_pair : ∀ a b : α, bdd_below ({a, b} : set α))
+  (is_lub_Sup : ∀ s : set α, bdd_above s → s.nonempty → is_lub s (Sup s)) :
+  conditionally_complete_lattice α :=
+{ sup := λ a b, Sup {a, b},
+  le_sup_left := λ a b, (is_lub_Sup {a, b} (bdd_above_pair a b)
+    (insert_nonempty _ _)).1 (mem_insert _ _),
+  le_sup_right := λ a b, (is_lub_Sup {a, b} (bdd_above_pair a b)
+    (insert_nonempty _ _)).1 (mem_insert_of_mem _ (mem_singleton _)),
+  sup_le := λ a b c hac hbc, (is_lub_Sup {a, b} (bdd_above_pair a b)
+    (insert_nonempty _ _)).2 (forall_insert_of_forall (forall_eq.mpr hbc) hac),
+  inf := λ a b, Sup (lower_bounds {a, b}),
+  inf_le_left := λ a b, (is_lub_Sup (lower_bounds {a, b})
+    (nonempty.bdd_above_lower_bounds ⟨a, mem_insert _ _⟩) (bdd_below_pair a b)).2
+    (λ c hc, hc $ mem_insert _ _),
+  inf_le_right := λ a b, (is_lub_Sup (lower_bounds {a, b})
+    (nonempty.bdd_above_lower_bounds ⟨a, mem_insert _ _⟩)
+    (bdd_below_pair a b)).2 (λ c hc, hc $ mem_insert_of_mem _ (mem_singleton _)),
+  le_inf := λ c a b hca hcb, (is_lub_Sup (lower_bounds {a, b})
+    (nonempty.bdd_above_lower_bounds ⟨a, mem_insert _ _⟩)
+    ⟨c, forall_insert_of_forall (forall_eq.mpr hcb) hca⟩).1
+    (forall_insert_of_forall (forall_eq.mpr hcb) hca),
+  Inf := λ s, Sup (lower_bounds s),
+  cSup_le := λ s a hs ha, (is_lub_Sup s ⟨a, ha⟩ hs).2 ha,
+  le_cSup := λ s a hs ha, (is_lub_Sup s hs ⟨a, ha⟩).1 ha,
+  cInf_le := λ s a hs ha, (is_lub_Sup (lower_bounds s)
+    (nonempty.bdd_above_lower_bounds ⟨a, ha⟩) hs).2 (λ b hb, hb ha),
+  le_cInf := λ s a hs ha, (is_lub_Sup (lower_bounds s) hs.bdd_above_lower_bounds ⟨a, ha⟩).1 ha,
+  .. H1, .. H2 }
+
+/-- Create a `conditionally_complete_lattice_of_Inf` from a `partial_order` and `Inf` function
+that returns the greatest lower bound of a nonempty set which is bounded below. Usually this
+constructor provides poor definitional equalities.  If other fields are known explicitly, they
+should be provided; for example, if `inf` is known explicitly, construct the
+`conditionally_complete_lattice` instance as
+```
+instance : conditionally_complete_lattice my_T :=
+{ inf := better_inf,
+  le_inf := ...,
+  inf_le_right := ...,
+  inf_le_left := ...
+  -- don't care to fix sup, Sup
+  ..conditionally_complete_lattice_of_Inf my_T _ }
+```
+-/
+def conditionally_complete_lattice_of_Inf (α : Type*) [H1 : partial_order α]
+  [H2 : has_Inf α]
+  (bdd_above_pair : ∀ a b : α, bdd_above ({a, b} : set α))
+  (bdd_below_pair : ∀ a b : α, bdd_below ({a, b} : set α))
+  (is_glb_Inf : ∀ s : set α, bdd_below s → s.nonempty → is_glb s (Inf s)) :
+  conditionally_complete_lattice α :=
+{ inf := λ a b, Inf {a, b},
+  inf_le_left := λ a b, (is_glb_Inf {a, b} (bdd_below_pair a b)
+    (insert_nonempty _ _)).1 (mem_insert _ _),
+  inf_le_right := λ a b, (is_glb_Inf {a, b} (bdd_below_pair a b)
+    (insert_nonempty _ _)).1 (mem_insert_of_mem _ (mem_singleton _)),
+  le_inf := λ c a b hca hcb, (is_glb_Inf {a, b} (bdd_below_pair a b)
+    (insert_nonempty _ _)).2 (forall_insert_of_forall (forall_eq.mpr hcb) hca),
+  sup := λ a b, Inf (upper_bounds {a, b}),
+  le_sup_left := λ a b, (is_glb_Inf (upper_bounds {a, b})
+    (nonempty.bdd_below_upper_bounds ⟨a, mem_insert _ _⟩) (bdd_above_pair a b)).2
+    (λ c hc, hc $ mem_insert _ _),
+  le_sup_right := λ a b, (is_glb_Inf (upper_bounds {a, b})
+    (nonempty.bdd_below_upper_bounds ⟨a, mem_insert _ _⟩)
+    (bdd_above_pair a b)).2 (λ c hc, hc $ mem_insert_of_mem _ (mem_singleton _)),
+  sup_le := λ a b c hac hbc, (is_glb_Inf (upper_bounds {a, b})
+    (nonempty.bdd_below_upper_bounds ⟨a, mem_insert _ _⟩)
+    ⟨c, forall_insert_of_forall (forall_eq.mpr hbc) hac⟩).1
+    (forall_insert_of_forall (forall_eq.mpr hbc) hac),
+  Sup := λ s, Inf (upper_bounds s),
+  le_cInf := λ s a hs ha, (is_glb_Inf s ⟨a, ha⟩ hs).2 ha,
+  cInf_le := λ s a hs ha, (is_glb_Inf s hs ⟨a, ha⟩).1 ha,
+  le_cSup := λ s a hs ha, (is_glb_Inf (upper_bounds s)
+    (nonempty.bdd_below_upper_bounds ⟨a, ha⟩) hs).2 (λ b hb, hb ha),
+  cSup_le := λ s a hs ha, (is_glb_Inf (upper_bounds s) hs.bdd_below_upper_bounds ⟨a, ha⟩).1 ha,
+  .. H1, .. H2 }
+
+/--
+A version of `conditionally_complete_lattice_of_Sup` when we already know that `α` is a lattice.
+
+This should only be used when it is both hard and unnecessary to provide `Inf` explicitly. -/
+def conditionally_complete_lattice_of_lattice_of_Sup (α : Type*) [H1 : lattice α]
+  [H2 : has_Sup α]
+  (is_lub_Sup : ∀ s : set α, bdd_above s → s.nonempty → is_lub s (Sup s)) :
+  conditionally_complete_lattice α :=
+{ ..H1, ..conditionally_complete_lattice_of_Sup α
+  (λ a b, ⟨a ⊔ b, forall_insert_of_forall (forall_eq.mpr le_sup_right) le_sup_left⟩)
+  (λ a b, ⟨a ⊓ b, forall_insert_of_forall (forall_eq.mpr inf_le_right) inf_le_left⟩)
+  is_lub_Sup }
+
+/--
+A version of `conditionally_complete_lattice_of_Inf` when we already know that `α` is a lattice.
+
+This should only be used when it is both hard and unnecessary to provide `Sup` explicitly. -/
+def conditionally_complete_lattice_of_lattice_of_Inf (α : Type*) [H1 : lattice α]
+  [H2 : has_Inf α]
+  (is_glb_Inf : ∀ s : set α, bdd_below s → s.nonempty → is_glb s (Inf s)) :
+  conditionally_complete_lattice α :=
+{ ..H1, ..conditionally_complete_lattice_of_Inf α
+  (λ a b, ⟨a ⊔ b, forall_insert_of_forall (forall_eq.mpr le_sup_right) le_sup_left⟩)
+  (λ a b, ⟨a ⊓ b, forall_insert_of_forall (forall_eq.mpr inf_le_right) inf_le_left⟩)
+  is_glb_Inf }
+
+section conditionally_complete_lattice
+variables [conditionally_complete_lattice α] {s t : set α} {a b : α}
+
+theorem le_cSup (h₁ : bdd_above s) (h₂ : a ∈ s) : a ≤ Sup s :=
+conditionally_complete_lattice.le_cSup s a h₁ h₂
+
+theorem cSup_le (h₁ : s.nonempty) (h₂ : ∀ b ∈ s, b ≤ a) : Sup s ≤ a :=
+conditionally_complete_lattice.cSup_le s a h₁ h₂
+
+theorem cInf_le (h₁ : bdd_below s) (h₂ : a ∈ s) : Inf s ≤ a :=
+conditionally_complete_lattice.cInf_le s a h₁ h₂
+
+theorem le_cInf (h₁ : s.nonempty) (h₂ : ∀ b ∈ s, a ≤ b) : a ≤ Inf s :=
+conditionally_complete_lattice.le_cInf s a h₁ h₂
+
+theorem le_cSup_of_le (hs : bdd_above s) (hb : b ∈ s) (h : a ≤ b) : a ≤ Sup s :=
+le_trans h (le_cSup hs hb)
+
+theorem cInf_le_of_le (hs : bdd_below s) (hb : b ∈ s) (h : b ≤ a) : Inf s ≤ a :=
+le_trans (cInf_le hs hb) h
+
+theorem cSup_le_cSup (ht : bdd_above t) (hs : s.nonempty) (h : s ⊆ t) : Sup s ≤ Sup t :=
+cSup_le hs (λ a ha, le_cSup ht (h ha))
+
+theorem cInf_le_cInf (ht : bdd_below t) (hs : s.nonempty) (h : s ⊆ t) : Inf t ≤ Inf s :=
+le_cInf hs (λ a ha, cInf_le ht (h ha))
+
+theorem le_cSup_iff (h : bdd_above s) (hs : s.nonempty) :
+  a ≤ Sup s ↔ ∀ b, b ∈ upper_bounds s → a ≤ b :=
+⟨λ h b hb, le_trans h (cSup_le hs hb), λ hb, hb _ (λ x, le_cSup h)⟩
+
+theorem cInf_le_iff (h : bdd_below s) (hs : s.nonempty) :
+  Inf s ≤ a ↔ ∀ b ∈ lower_bounds s, b ≤ a :=
+⟨λ h b hb, le_trans (le_cInf hs hb) h, λ hb, hb _ (λ x, cInf_le h)⟩
+
+lemma is_lub_cSup (ne : s.nonempty) (H : bdd_above s) : is_lub s (Sup s) :=
+⟨λ x, le_cSup H, λ x, cSup_le ne⟩
+
+lemma is_lub_csupr [nonempty ι] {f : ι → α} (H : bdd_above (range f)) :
+  is_lub (range f) (⨆ i, f i) :=
+is_lub_cSup (range_nonempty f) H
+
+lemma is_lub_csupr_set {f : β → α} {s : set β} (H : bdd_above (f '' s)) (Hne : s.nonempty) :
+  is_lub (f '' s) (⨆ i : s, f i) :=
+by { rw ← Sup_image', exact is_lub_cSup (Hne.image _) H }
+
+lemma is_glb_cInf (ne : s.nonempty) (H : bdd_below s) : is_glb s (Inf s) :=
+⟨λ x, cInf_le H, λ x, le_cInf ne⟩
+
+lemma is_glb_cinfi [nonempty ι] {f : ι → α} (H : bdd_below (range f)) :
+  is_glb (range f) (⨅ i, f i) :=
+is_glb_cInf (range_nonempty f) H
+
+lemma is_glb_cinfi_set {f : β → α} {s : set β} (H : bdd_below (f '' s)) (Hne : s.nonempty) :
+  is_glb (f '' s) (⨅ i : s, f i) :=
+@is_lub_csupr_set αᵒᵈ _ _ _ _ H Hne
+
+lemma csupr_le_iff [nonempty ι] {f : ι → α} {a : α} (hf : bdd_above (range f)) :
+  supr f ≤ a ↔ ∀ i, f i ≤ a :=
+(is_lub_le_iff $ is_lub_csupr hf).trans forall_range_iff
+
+lemma le_cinfi_iff [nonempty ι] {f : ι → α} {a : α} (hf : bdd_below (range f)) :
+  a ≤ infi f ↔ ∀ i, a ≤ f i :=
+(le_is_glb_iff $ is_glb_cinfi hf).trans forall_range_iff
+
+lemma csupr_set_le_iff {ι : Type*} {s : set ι} {f : ι → α} {a : α} (hs : s.nonempty)
+  (hf : bdd_above (f '' s)) :
+  (⨆ i : s, f i) ≤ a ↔ ∀ i ∈ s, f i ≤ a :=
+(is_lub_le_iff $ is_lub_csupr_set hf hs).trans ball_image_iff
+
+lemma le_cinfi_set_iff {ι : Type*} {s : set ι} {f : ι → α} {a : α} (hs : s.nonempty)
+  (hf : bdd_below (f '' s)) :
+  a ≤ (⨅ i : s, f i) ↔ ∀ i ∈ s, a ≤ f i :=
+(le_is_glb_iff $ is_glb_cinfi_set hf hs).trans ball_image_iff
+
+lemma is_lub.cSup_eq (H : is_lub s a) (ne : s.nonempty) : Sup s = a :=
+(is_lub_cSup ne ⟨a, H.1⟩).unique H
+
+lemma is_lub.csupr_eq [nonempty ι] {f : ι → α} (H : is_lub (range f) a) : (⨆ i, f i) = a :=
+H.cSup_eq (range_nonempty f)
+
+lemma is_lub.csupr_set_eq {s : set β} {f : β → α} (H : is_lub (f '' s) a) (Hne : s.nonempty) :
+  (⨆ i : s, f i) = a :=
+is_lub.cSup_eq (image_eq_range f s ▸ H) (image_eq_range f s ▸ Hne.image f)
+
+/-- A greatest element of a set is the supremum of this set. -/
+lemma is_greatest.cSup_eq (H : is_greatest s a) : Sup s = a :=
+H.is_lub.cSup_eq H.nonempty
+
+lemma is_greatest.Sup_mem (H : is_greatest s a) : Sup s ∈ s :=
+H.cSup_eq.symm ▸ H.1
+
+lemma is_glb.cInf_eq (H : is_glb s a) (ne : s.nonempty) : Inf s = a :=
+(is_glb_cInf ne ⟨a, H.1⟩).unique H
+
+lemma is_glb.cinfi_eq [nonempty ι] {f : ι → α} (H : is_glb (range f) a) : (⨅ i, f i) = a :=
+H.cInf_eq (range_nonempty f)
+
+lemma is_glb.cinfi_set_eq {s : set β} {f : β → α} (H : is_glb (f '' s) a) (Hne : s.nonempty) :
+  (⨅ i : s, f i) = a :=
+is_glb.cInf_eq (image_eq_range f s ▸ H) (image_eq_range f s ▸ Hne.image f)
+
+/-- A least element of a set is the infimum of this set. -/
+lemma is_least.cInf_eq (H : is_least s a) : Inf s = a :=
+H.is_glb.cInf_eq H.nonempty
+
+lemma is_least.Inf_mem (H : is_least s a) : Inf s ∈ s :=
+H.cInf_eq.symm ▸ H.1
+
+lemma subset_Icc_cInf_cSup (hb : bdd_below s) (ha : bdd_above s) :
+  s ⊆ Icc (Inf s) (Sup s) :=
+λ x hx, ⟨cInf_le hb hx, le_cSup ha hx⟩
+
+theorem cSup_le_iff (hb : bdd_above s) (hs : s.nonempty) : Sup s ≤ a ↔ ∀ b ∈ s, b ≤ a :=
+is_lub_le_iff (is_lub_cSup hs hb)
+
+theorem le_cInf_iff (hb : bdd_below s) (hs : s.nonempty) : a ≤ Inf s ↔ ∀ b ∈ s, a ≤ b :=
+le_is_glb_iff (is_glb_cInf hs hb)
+
+lemma cSup_lower_bounds_eq_cInf {s : set α} (h : bdd_below s) (hs : s.nonempty) :
+  Sup (lower_bounds s) = Inf s :=
+(is_lub_cSup h $ hs.mono $ λ x hx y hy, hy hx).unique (is_glb_cInf hs h).is_lub
+
+lemma cInf_upper_bounds_eq_cSup {s : set α} (h : bdd_above s) (hs : s.nonempty) :
+  Inf (upper_bounds s) = Sup s :=
+(is_glb_cInf h $ hs.mono $ λ x hx y hy, hy hx).unique (is_lub_cSup hs h).is_glb
+
+lemma not_mem_of_lt_cInf {x : α} {s : set α} (h : x < Inf s) (hs : bdd_below s) : x ∉ s :=
+λ hx, lt_irrefl _ (h.trans_le (cInf_le hs hx))
+
+lemma not_mem_of_cSup_lt {x : α} {s : set α} (h : Sup s < x) (hs : bdd_above s) : x ∉ s :=
+@not_mem_of_lt_cInf αᵒᵈ _ x s h hs
+
+/--Introduction rule to prove that `b` is the supremum of `s`: it suffices to check that `b`
+is larger than all elements of `s`, and that this is not the case of any `wb`.
+See `Inf_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in complete lattices. -/
+theorem cInf_eq_of_forall_ge_of_forall_gt_exists_lt : s.nonempty → (∀ a ∈ s, b ≤ a) →
+  (∀ w, b < w → ∃ a ∈ s, a < w) → Inf s = b :=
+@cSup_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _
+
+/--b < Sup s when there is an element a in s with b < a, when s is bounded above.
+This is essentially an iff, except that the assumptions for the two implications are
+slightly different (one needs boundedness above for one direction, nonemptiness and linear
+order for the other one), so we formulate separately the two implications, contrary to
+the complete_lattice case.-/
+lemma lt_cSup_of_lt (hs : bdd_above s) (ha : a ∈ s) (h : b < a) : b < Sup s :=
+lt_of_lt_of_le h (le_cSup hs ha)
+
+/--Inf s < b when there is an element a in s with a < b, when s is bounded below.
+This is essentially an iff, except that the assumptions for the two implications are
+slightly different (one needs boundedness below for one direction, nonemptiness and linear
+order for the other one), so we formulate separately the two implications, contrary to
+the complete_lattice case.-/
+lemma cInf_lt_of_lt : bdd_below s → a ∈ s → a < b → Inf s < b :=
+@lt_cSup_of_lt αᵒᵈ _ _ _ _
+
+/-- If all elements of a nonempty set `s` are less than or equal to all elements
+of a nonempty set `t`, then there exists an element between these sets. -/
+lemma exists_between_of_forall_le (sne : s.nonempty) (tne : t.nonempty)
+  (hst : ∀ (x ∈ s) (y ∈ t), x ≤ y) : (upper_bounds s ∩ lower_bounds t).nonempty :=
+⟨Inf t, λ x hx, le_cInf tne $ hst x hx, λ y hy, cInf_le (sne.mono hst) hy⟩
+
+/--The supremum of a singleton is the element of the singleton-/
+@[simp] theorem cSup_singleton (a : α) : Sup {a} = a :=
+is_greatest_singleton.cSup_eq
+
+/--The infimum of a singleton is the element of the singleton-/
+@[simp] theorem cInf_singleton (a : α) : Inf {a} = a :=
+is_least_singleton.cInf_eq
+
+@[simp] theorem cSup_pair (a b : α) : Sup {a, b} = a ⊔ b :=
+(@is_lub_pair _ _ a b).cSup_eq (insert_nonempty _ _)
+
+@[simp] theorem cInf_pair (a b : α) : Inf {a, b} = a ⊓ b :=
+(@is_glb_pair _ _ a b).cInf_eq (insert_nonempty _ _)
+
+/--If a set is bounded below and above, and nonempty, its infimum is less than or equal to
+its supremum.-/
+theorem cInf_le_cSup (hb : bdd_below s) (ha : bdd_above s) (ne : s.nonempty) : Inf s ≤ Sup s :=
+is_glb_le_is_lub (is_glb_cInf ne hb) (is_lub_cSup ne ha) ne
+
+/--The sup of a union of two sets is the max of the suprema of each subset, under the assumptions
+that all sets are bounded above and nonempty.-/
+theorem cSup_union (hs : bdd_above s) (sne : s.nonempty) (ht : bdd_above t) (tne : t.nonempty) :
+  Sup (s ∪ t) = Sup s ⊔ Sup t :=
+((is_lub_cSup sne hs).union (is_lub_cSup tne ht)).cSup_eq sne.inl
+
+/--The inf of a union of two sets is the min of the infima of each subset, under the assumptions
+that all sets are bounded below and nonempty.-/
+theorem cInf_union (hs : bdd_below s) (sne : s.nonempty) (ht : bdd_below t) (tne : t.nonempty) :
+  Inf (s ∪ t) = Inf s ⊓ Inf t :=
+@cSup_union αᵒᵈ _ _ _ hs sne ht tne
+
+/--The supremum of an intersection of two sets is bounded by the minimum of the suprema of each
+set, if all sets are bounded above and nonempty.-/
+theorem cSup_inter_le (hs : bdd_above s) (ht : bdd_above t) (hst : (s ∩ t).nonempty) :
+  Sup (s ∩ t) ≤ Sup s ⊓ Sup t :=
+cSup_le hst $ λ x hx, le_inf (le_cSup hs hx.1) (le_cSup ht hx.2)
+
+/--The infimum of an intersection of two sets is bounded below by the maximum of the
+infima of each set, if all sets are bounded below and nonempty.-/
+theorem le_cInf_inter : bdd_below s → bdd_below t → (s ∩ t).nonempty →
+  Inf s ⊔ Inf t ≤ Inf (s ∩ t) :=
+@cSup_inter_le αᵒᵈ _ _ _
+
+/-- The supremum of insert a s is the maximum of a and the supremum of s, if s is
+nonempty and bounded above.-/
+theorem cSup_insert (hs : bdd_above s) (sne : s.nonempty) : Sup (insert a s) = a ⊔ Sup s :=
+((is_lub_cSup sne hs).insert a).cSup_eq (insert_nonempty a s)
+
+/-- The infimum of insert a s is the minimum of a and the infimum of s, if s is
+nonempty and bounded below.-/
+theorem cInf_insert (hs : bdd_below s) (sne : s.nonempty) : Inf (insert a s) = a ⊓ Inf s :=
+@cSup_insert αᵒᵈ _ _ _ hs sne
+
+@[simp] lemma cInf_Icc (h : a ≤ b) : Inf (Icc a b) = a :=
+(is_glb_Icc h).cInf_eq (nonempty_Icc.2 h)
+
+@[simp] lemma cInf_Ici : Inf (Ici a) = a := is_least_Ici.cInf_eq
+
+@[simp] lemma cInf_Ico (h : a < b) : Inf (Ico a b) = a :=
+(is_glb_Ico h).cInf_eq (nonempty_Ico.2 h)
+
+@[simp] lemma cInf_Ioc [densely_ordered α] (h : a < b) : Inf (Ioc a b) = a :=
+(is_glb_Ioc h).cInf_eq (nonempty_Ioc.2 h)
+
+@[simp] lemma cInf_Ioi [no_max_order α] [densely_ordered α] : Inf (Ioi a) = a :=
+cInf_eq_of_forall_ge_of_forall_gt_exists_lt nonempty_Ioi (λ _, le_of_lt)
+  (λ w hw, by simpa using exists_between hw)
+
+@[simp] lemma cInf_Ioo [densely_ordered α] (h : a < b) : Inf (Ioo a b) = a :=
+(is_glb_Ioo h).cInf_eq (nonempty_Ioo.2 h)
+
+@[simp] lemma cSup_Icc (h : a ≤ b) : Sup (Icc a b) = b :=
+(is_lub_Icc h).cSup_eq (nonempty_Icc.2 h)
+
+@[simp] lemma cSup_Ico [densely_ordered α] (h : a < b) : Sup (Ico a b) = b :=
+(is_lub_Ico h).cSup_eq (nonempty_Ico.2 h)
+
+@[simp] lemma cSup_Iic : Sup (Iic a) = a := is_greatest_Iic.cSup_eq
+
+@[simp] lemma cSup_Iio [no_min_order α] [densely_ordered α] : Sup (Iio a) = a :=
+cSup_eq_of_forall_le_of_forall_lt_exists_gt nonempty_Iio (λ _, le_of_lt)
+  (λ w hw, by simpa [and_comm] using exists_between hw)
+
+@[simp] lemma cSup_Ioc (h : a < b) : Sup (Ioc a b) = b :=
+(is_lub_Ioc h).cSup_eq (nonempty_Ioc.2 h)
+
+@[simp] lemma cSup_Ioo [densely_ordered α] (h : a < b) : Sup (Ioo a b) = b :=
+(is_lub_Ioo h).cSup_eq (nonempty_Ioo.2 h)
+
+/--The indexed supremum of a function is bounded above by a uniform bound-/
+lemma csupr_le [nonempty ι] {f : ι → α} {c : α} (H : ∀ x, f x ≤ c) : supr f ≤ c :=
+cSup_le (range_nonempty f) (by rwa forall_range_iff)
+
+/--The indexed supremum of a function is bounded below by the value taken at one point-/
+lemma le_csupr {f : ι → α} (H : bdd_above (range f)) (c : ι) : f c ≤ supr f :=
+le_cSup H (mem_range_self _)
+
+lemma le_csupr_of_le {f : ι → α} (H : bdd_above (range f)) (c : ι) (h : a ≤ f c) : a ≤ supr f :=
+le_trans h (le_csupr H c)
+
+/--The indexed supremum of two functions are comparable if the functions are pointwise comparable-/
+lemma csupr_mono {f g : ι → α} (B : bdd_above (range g)) (H : ∀ x, f x ≤ g x) :
+  supr f ≤ supr g :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { rw [supr_of_empty', supr_of_empty'] },
+  { exact csupr_le (λ x, le_csupr_of_le B x (H x)) },
+end
+
+lemma le_csupr_set {f : β → α} {s : set β}
+  (H : bdd_above (f '' s)) {c : β} (hc : c ∈ s) : f c ≤ ⨆ i : s, f i :=
+(le_cSup H $ mem_image_of_mem f hc).trans_eq Sup_image'
+
+/--The indexed infimum of two functions are comparable if the functions are pointwise comparable-/
+lemma cinfi_mono {f g : ι → α} (B : bdd_below (range f)) (H : ∀ x, f x ≤ g x) :
+  infi f ≤ infi g :=
+@csupr_mono αᵒᵈ _ _ _ _ B H
+
+/--The indexed minimum of a function is bounded below by a uniform lower bound-/
+lemma le_cinfi [nonempty ι] {f : ι → α} {c : α} (H : ∀ x, c ≤ f x) : c ≤ infi f :=
+@csupr_le αᵒᵈ _ _ _ _ _ H
+
+/--The indexed infimum of a function is bounded above by the value taken at one point-/
+lemma cinfi_le {f : ι → α} (H : bdd_below (range f)) (c : ι) : infi f ≤ f c :=
+@le_csupr αᵒᵈ _ _ _ H c
+
+lemma cinfi_le_of_le {f : ι → α} (H : bdd_below (range f)) (c : ι) (h : f c ≤ a) : infi f ≤ a :=
+@le_csupr_of_le αᵒᵈ _ _ _ _ H c h
+
+lemma cinfi_set_le {f : β → α} {s : set β}
+  (H : bdd_below (f '' s)) {c : β} (hc : c ∈ s) : (⨅ i : s, f i) ≤ f c :=
+@le_csupr_set αᵒᵈ _ _ _ _ H _ hc
+
+@[simp] theorem csupr_const [hι : nonempty ι] {a : α} : (⨆ b : ι, a) = a :=
+by rw [supr, range_const, cSup_singleton]
+
+@[simp] theorem cinfi_const [hι : nonempty ι] {a : α} : (⨅ b:ι, a) = a := @csupr_const αᵒᵈ _ _ _ _
+
+@[simp] theorem supr_unique [unique ι] {s : ι → α} : (⨆ i, s i) = s default :=
+have ∀ i, s i = s default := λ i, congr_arg s (unique.eq_default i),
+by simp only [this, csupr_const]
+
+@[simp] theorem infi_unique [unique ι] {s : ι → α} : (⨅ i, s i) = s default :=
+@supr_unique αᵒᵈ _ _ _ _
+
+@[simp] lemma csupr_pos {p : Prop} {f : p → α} (hp : p) : (⨆ h : p, f h) = f hp :=
+by haveI := unique_prop hp; exact supr_unique
+
+@[simp] lemma cinfi_pos {p : Prop} {f : p → α} (hp : p) : (⨅ h : p, f h) = f hp :=
+@csupr_pos αᵒᵈ _ _ _ hp
+
+/--Introduction rule to prove that `b` is the supremum of `f`: it suffices to check that `b`
+is larger than `f i` for all `i`, and that this is not the case of any `wb`.
+See `infi_eq_of_forall_ge_of_forall_gt_exists_lt` for a version in complete lattices. -/
+theorem cinfi_eq_of_forall_ge_of_forall_gt_exists_lt [nonempty ι] {f : ι → α} (h₁ : ∀ i, b ≤ f i)
+  (h₂ : ∀ w, b < w → (∃ i, f i < w)) : (⨅ (i : ι), f i) = b :=
+@csupr_eq_of_forall_le_of_forall_lt_exists_gt αᵒᵈ _ _ _ _ ‹_› ‹_› ‹_›
+
+/-- Nested intervals lemma: if `f` is a monotone sequence, `g` is an antitone sequence, and
+`f n ≤ g n` for all `n`, then `⨆ n, f n` belongs to all the intervals `[f n, g n]`. -/
+lemma monotone.csupr_mem_Inter_Icc_of_antitone [semilattice_sup β]
+  {f g : β → α} (hf : monotone f) (hg : antitone g) (h : f ≤ g) :
+  (⨆ n, f n) ∈ ⋂ n, Icc (f n) (g n) :=
+begin
+  refine mem_Inter.2 (λ n, _),
+  haveI : nonempty β := ⟨n⟩,
+  have : ∀ m, f m ≤ g n := λ m, hf.forall_le_of_antitone hg h m n,
+  exact ⟨le_csupr ⟨g $ n, forall_range_iff.2 this⟩ _, csupr_le this⟩
+end
+
+/-- Nested intervals lemma: if `[f n, g n]` is an antitone sequence of nonempty
+closed intervals, then `⨆ n, f n` belongs to all the intervals `[f n, g n]`. -/
+lemma csupr_mem_Inter_Icc_of_antitone_Icc [semilattice_sup β]
+  {f g : β → α} (h : antitone (λ n, Icc (f n) (g n))) (h' : ∀ n, f n ≤ g n) :
+  (⨆ n, f n) ∈ ⋂ n, Icc (f n) (g n) :=
+monotone.csupr_mem_Inter_Icc_of_antitone (λ m n hmn, ((Icc_subset_Icc_iff (h' n)).1 (h hmn)).1)
+  (λ m n hmn, ((Icc_subset_Icc_iff (h' n)).1 (h hmn)).2) h'
+
+/--Introduction rule to prove that b is the supremum of s: it suffices to check that
+1) b is an upper bound
+2) every other upper bound b' satisfies b ≤ b'.-/
+theorem cSup_eq_of_is_forall_le_of_forall_le_imp_ge (hs : s.nonempty)
+  (h_is_ub : ∀ a ∈ s, a ≤ b) (h_b_le_ub : ∀ub, (∀ a ∈ s, a ≤ ub) → (b ≤ ub)) : Sup s = b :=
+(cSup_le hs h_is_ub).antisymm (h_b_le_ub _ $ λ a, le_cSup ⟨b, h_is_ub⟩)
+
+end conditionally_complete_lattice
+
+instance pi.conditionally_complete_lattice {ι : Type*} {α : Π i : ι, Type*}
+  [Π i, conditionally_complete_lattice (α i)] :
+  conditionally_complete_lattice (Π i, α i) :=
+{ le_cSup := λ s f ⟨g, hg⟩ hf i, le_cSup ⟨g i, set.forall_range_iff.2 $ λ ⟨f', hf'⟩, hg hf' i⟩
+    ⟨⟨f, hf⟩, rfl⟩,
+  cSup_le := λ s f hs hf i, cSup_le (by haveI := hs.to_subtype; apply range_nonempty) $
+    λ b ⟨⟨g, hg⟩, hb⟩, hb ▸ hf hg i,
+  cInf_le := λ s f ⟨g, hg⟩ hf i, cInf_le ⟨g i, set.forall_range_iff.2 $ λ ⟨f', hf'⟩, hg hf' i⟩
+    ⟨⟨f, hf⟩, rfl⟩,
+  le_cInf := λ s f hs hf i, le_cInf (by haveI := hs.to_subtype; apply range_nonempty) $
+    λ b ⟨⟨g, hg⟩, hb⟩, hb ▸ hf hg i,
+  .. pi.lattice, .. pi.has_Sup, .. pi.has_Inf }
+
+section conditionally_complete_linear_order
+variables [conditionally_complete_linear_order α] {s t : set α} {a b : α}
+
+/-- When b < Sup s, there is an element a in s with b < a, if s is nonempty and the order is
+a linear order. -/
+lemma exists_lt_of_lt_cSup (hs : s.nonempty) (hb : b < Sup s) : ∃ a ∈ s, b < a :=
+by { contrapose! hb, exact cSup_le hs hb }
+
+/--
+Indexed version of the above lemma `exists_lt_of_lt_cSup`.
+When `b < supr f`, there is an element `i` such that `b < f i`.
+-/
+lemma exists_lt_of_lt_csupr [nonempty ι] {f : ι → α} (h : b < supr f) : ∃ i, b < f i :=
+let ⟨_, ⟨i, rfl⟩, h⟩ := exists_lt_of_lt_cSup (range_nonempty f) h in ⟨i, h⟩
+
+/--When Inf s < b, there is an element a in s with a < b, if s is nonempty and the order is
+a linear order.-/
+lemma exists_lt_of_cInf_lt (hs : s.nonempty) (hb : Inf s < b) : ∃ a ∈ s, a < b :=
+@exists_lt_of_lt_cSup αᵒᵈ _ _ _ hs hb
+
+/--
+Indexed version of the above lemma `exists_lt_of_cInf_lt`
+When `infi f < a`, there is an element `i` such that `f i < a`.
+-/
+lemma exists_lt_of_cinfi_lt [nonempty ι] {f : ι → α} (h : infi f < a) : ∃ i, f i < a :=
+@exists_lt_of_lt_csupr αᵒᵈ _ _ _ _ _ h
+
+open function
+variables [is_well_order α (<)]
+
+lemma Inf_eq_argmin_on (hs : s.nonempty) :
+  Inf s = argmin_on id (@is_well_founded.wf α (<) _) s hs :=
+is_least.cInf_eq ⟨argmin_on_mem _ _ _ _, λ a ha, argmin_on_le id _ _ ha⟩
+
+lemma is_least_Inf (hs : s.nonempty) : is_least s (Inf s) :=
+by { rw Inf_eq_argmin_on hs, exact ⟨argmin_on_mem _ _ _ _, λ a ha, argmin_on_le id _ _ ha⟩ }
+
+lemma le_cInf_iff' (hs : s.nonempty) : b ≤ Inf s ↔ b ∈ lower_bounds s :=
+le_is_glb_iff (is_least_Inf hs).is_glb
+
+lemma Inf_mem (hs : s.nonempty) : Inf s ∈ s := (is_least_Inf hs).1
+
+lemma infi_mem [nonempty ι] (f : ι → α) : infi f ∈ range f := Inf_mem (range_nonempty f)
+
+lemma monotone_on.map_Inf {β : Type*} [conditionally_complete_lattice β] {f : α → β}
+  (hf : monotone_on f s) (hs : s.nonempty) : f (Inf s) = Inf (f '' s) :=
+(hf.map_is_least (is_least_Inf hs)).cInf_eq.symm
+
+lemma monotone.map_Inf {β : Type*} [conditionally_complete_lattice β] {f : α → β} (hf : monotone f)
+  (hs : s.nonempty) : f (Inf s) = Inf (f '' s) :=
+(hf.map_is_least (is_least_Inf hs)).cInf_eq.symm
+
+end conditionally_complete_linear_order
+
+/-!
+### Lemmas about a conditionally complete linear order with bottom element
+
+In this case we have `Sup ∅ = ⊥`, so we can drop some `nonempty`/`set.nonempty` assumptions.
+-/
+
+section conditionally_complete_linear_order_bot
+
+variables [conditionally_complete_linear_order_bot α]
+
+@[simp] lemma cSup_empty : (Sup ∅ : α) = ⊥ :=
+conditionally_complete_linear_order_bot.cSup_empty
+
+@[simp] lemma csupr_of_empty [is_empty ι] (f : ι → α) : (⨆ i, f i) = ⊥ :=
+by rw [supr_of_empty', cSup_empty]
+
+@[simp] lemma csupr_false (f : false → α) : (⨆ i, f i) = ⊥ := csupr_of_empty f
+
+@[simp] lemma cInf_univ : Inf (univ : set α) = ⊥ := is_least_univ.cInf_eq
+
+lemma is_lub_cSup' {s : set α} (hs : bdd_above s) : is_lub s (Sup s) :=
+begin
+  rcases eq_empty_or_nonempty s with (rfl|hne),
+  { simp only [cSup_empty, is_lub_empty] },
+  { exact is_lub_cSup hne hs }
+end
+
+lemma cSup_le_iff' {s : set α} (hs : bdd_above s) {a : α} : Sup s ≤ a ↔ ∀ x ∈ s, x ≤ a :=
+is_lub_le_iff (is_lub_cSup' hs)
+
+lemma cSup_le' {s : set α} {a : α} (h : a ∈ upper_bounds s) : Sup s ≤ a :=
+(cSup_le_iff' ⟨a, h⟩).2 h
+
+theorem le_cSup_iff' {s : set α} {a : α} (h : bdd_above s) :
+  a ≤ Sup s ↔ ∀ b, b ∈ upper_bounds s → a ≤ b :=
+⟨λ h b hb, le_trans h (cSup_le' hb), λ hb, hb _ (λ x, le_cSup h)⟩
+
+lemma le_csupr_iff' {s : ι → α} {a : α} (h : bdd_above (range s)) :
+  a ≤ supr s ↔ ∀ b, (∀ i, s i ≤ b) → a ≤ b :=
+by simp [supr, h, le_cSup_iff', upper_bounds]
+
+theorem le_cInf_iff'' {s : set α} {a : α} (ne : s.nonempty) :
+  a ≤ Inf s ↔ ∀ (b : α), b ∈ s → a ≤ b :=
+le_cInf_iff ⟨⊥, λ a _, bot_le⟩ ne
+
+theorem le_cinfi_iff' [nonempty ι] {f : ι → α} {a : α} :
+  a ≤ infi f ↔ ∀ i, a ≤ f i :=
+le_cinfi_iff ⟨⊥, λ a _, bot_le⟩
+
+theorem cInf_le' {s : set α} {a : α} (h : a ∈ s) : Inf s ≤ a :=
+cInf_le ⟨⊥, λ a _, bot_le⟩ h
+
+theorem cinfi_le' (f : ι → α) (i : ι) : infi f ≤ f i :=
+cinfi_le ⟨⊥, λ a _, bot_le⟩ _
+
+lemma exists_lt_of_lt_cSup' {s : set α} {a : α} (h : a < Sup s) : ∃ b ∈ s, a < b :=
+by { contrapose! h, exact cSup_le' h }
+
+lemma csupr_le_iff' {f : ι → α} (h : bdd_above (range f)) {a : α} :
+  (⨆ i, f i) ≤ a ↔ ∀ i, f i ≤ a :=
+(cSup_le_iff' h).trans forall_range_iff
+
+lemma csupr_le' {f : ι → α} {a : α} (h : ∀ i, f i ≤ a) : (⨆ i, f i) ≤ a :=
+cSup_le' $ forall_range_iff.2 h
+
+lemma exists_lt_of_lt_csupr' {f : ι → α} {a : α} (h : a < ⨆ i, f i) : ∃ i, a < f i :=
+by { contrapose! h, exact csupr_le' h }
+
+lemma csupr_mono' {ι'} {f : ι → α} {g : ι' → α} (hg : bdd_above (range g))
+  (h : ∀ i, ∃ i', f i ≤ g i') : supr f ≤ supr g :=
+csupr_le' $ λ i, exists.elim (h i) (le_csupr_of_le hg)
+
+lemma cInf_le_cInf' {s t : set α} (h₁ : t.nonempty) (h₂ : t ⊆ s) : Inf s ≤ Inf t :=
+cInf_le_cInf (order_bot.bdd_below s) h₁ h₂
+
+end conditionally_complete_linear_order_bot
+
+namespace with_top
+open_locale classical
+
+variables [conditionally_complete_linear_order_bot α]
+
+/-- The Sup of a non-empty set is its least upper bound for a conditionally
+complete lattice with a top. -/
+lemma is_lub_Sup' {β : Type*} [conditionally_complete_lattice β]
+  {s : set (with_top β)} (hs : s.nonempty) : is_lub s (Sup s) :=
+begin
+  split,
+  { show ite _ _ _ ∈ _,
+    split_ifs,
+    { intros _ _, exact le_top },
+    { rintro (⟨⟩|a) ha,
+      { contradiction },
+      apply some_le_some.2,
+      exact le_cSup h_1 ha },
+    { intros _ _, exact le_top } },
+  { show ite _ _ _ ∈ _,
+    split_ifs,
+    { rintro (⟨⟩|a) ha,
+      { exact le_rfl },
+      { exact false.elim (not_top_le_coe a (ha h)) } },
+    { rintro (⟨⟩|b) hb,
+      { exact le_top },
+      refine some_le_some.2 (cSup_le _ _),
+      { rcases hs with ⟨⟨⟩|b, hb⟩,
+        { exact absurd hb h },
+        { exact ⟨b, hb⟩ } },
+      { intros a ha, exact some_le_some.1 (hb ha) } },
+    { rintro (⟨⟩|b) hb,
+      { exact le_rfl },
+      { exfalso, apply h_1, use b, intros a ha, exact some_le_some.1 (hb ha) } } }
+end
+
+lemma is_lub_Sup (s : set (with_top α)) : is_lub s (Sup s) :=
+begin
+  cases s.eq_empty_or_nonempty with hs hs,
+  { rw hs,
+    show is_lub ∅ (ite _ _ _),
+    split_ifs,
+    { cases h },
+    { rw [preimage_empty, cSup_empty], exact is_lub_empty },
+    { exfalso, apply h_1, use ⊥, rintro a ⟨⟩ } },
+  exact is_lub_Sup' hs,
+end
+
+/-- The Inf of a bounded-below set is its greatest lower bound for a conditionally
+complete lattice with a top. -/
+lemma is_glb_Inf' {β : Type*} [conditionally_complete_lattice β]
+  {s : set (with_top β)} (hs : bdd_below s) : is_glb s (Inf s) :=
+begin
+  split,
+  { show ite _ _ _ ∈ _,
+    split_ifs,
+    { intros a ha, exact top_le_iff.2 (set.mem_singleton_iff.1 (h ha)) },
+    { rintro (⟨⟩|a) ha,
+      { exact le_top },
+      refine some_le_some.2 (cInf_le _ ha),
+      rcases hs with ⟨⟨⟩|b, hb⟩,
+      { exfalso,
+        apply h,
+        intros c hc,
+        rw [mem_singleton_iff, ←top_le_iff],
+        exact hb hc },
+      use b,
+      intros c hc,
+      exact some_le_some.1 (hb hc) } },
+  { show ite _ _ _ ∈ _,
+    split_ifs,
+    { intros _ _, exact le_top },
+    { rintro (⟨⟩|a) ha,
+      { exfalso, apply h, intros b hb, exact set.mem_singleton_iff.2 (top_le_iff.1 (ha hb)) },
+      { refine some_le_some.2 (le_cInf _ _),
+        { classical, contrapose! h,
+          rintros (⟨⟩|a) ha,
+          { exact mem_singleton ⊤ },
+          { exact (h ⟨a, ha⟩).elim }},
+        { intros b hb,
+          rw ←some_le_some,
+          exact ha hb } } } }
+end
+
+lemma is_glb_Inf (s : set (with_top α)) : is_glb s (Inf s) :=
+begin
+  by_cases hs : bdd_below s,
+  { exact is_glb_Inf' hs },
+  { exfalso, apply hs, use ⊥, intros _ _, exact bot_le },
+end
+
+noncomputable instance : complete_linear_order (with_top α) :=
+{ Sup := Sup, le_Sup := λ s, (is_lub_Sup s).1, Sup_le := λ s, (is_lub_Sup s).2,
+  Inf := Inf, le_Inf := λ s, (is_glb_Inf s).2, Inf_le := λ s, (is_glb_Inf s).1,
+  .. with_top.linear_order, ..with_top.lattice, ..with_top.order_top, ..with_top.order_bot }
+
+/-- A version of `with_top.coe_Sup'` with a more convenient but less general statement. -/
+@[norm_cast] lemma coe_Sup {s : set α} (hb : bdd_above s) :
+  ↑(Sup s) = (⨆ a ∈ s, ↑a : with_top α) :=
+by rw [coe_Sup' hb, Sup_image]
+
+/-- A version of `with_top.coe_Inf'` with a more convenient but less general statement. -/
+@[norm_cast] lemma coe_Inf {s : set α} (hs : s.nonempty) :
+  ↑(Inf s) = (⨅ a ∈ s, ↑a : with_top α) :=
+by rw [coe_Inf' hs, Inf_image]
+
+end with_top
+
+namespace monotone
+variables [preorder α] [conditionally_complete_lattice β] {f : α → β} (h_mono : monotone f)
+
+/-! A monotone function into a conditionally complete lattice preserves the ordering properties of
+`Sup` and `Inf`. -/
+
+lemma le_cSup_image {s : set α} {c : α} (hcs : c ∈ s) (h_bdd : bdd_above s) :
+  f c ≤ Sup (f '' s) :=
+le_cSup (map_bdd_above h_mono h_bdd) (mem_image_of_mem f hcs)
+
+lemma cSup_image_le {s : set α} (hs : s.nonempty) {B : α} (hB: B ∈ upper_bounds s) :
+  Sup (f '' s) ≤ f B :=
+cSup_le (nonempty.image f hs) (h_mono.mem_upper_bounds_image hB)
+
+lemma cInf_image_le {s : set α} {c : α} (hcs : c ∈ s) (h_bdd : bdd_below s) :
+  Inf (f '' s) ≤ f c :=
+@le_cSup_image αᵒᵈ βᵒᵈ _ _ _ (λ x y hxy, h_mono hxy) _ _ hcs h_bdd
+
+lemma le_cInf_image {s : set α} (hs : s.nonempty) {B : α} (hB: B ∈ lower_bounds s) :
+  f B ≤ Inf (f '' s) :=
+@cSup_image_le αᵒᵈ βᵒᵈ _ _ _ (λ x y hxy, h_mono hxy) _ hs _ hB
+
+end monotone
+
+namespace galois_connection
+variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
+  {l : α → β} {u : β → α}
+
+lemma l_cSup (gc : galois_connection l u) {s : set α} (hne : s.nonempty)
+  (hbdd : bdd_above s) :
+  l (Sup s) = ⨆ x : s, l x :=
+eq.symm $ is_lub.csupr_set_eq (gc.is_lub_l_image $ is_lub_cSup hne hbdd) hne
+
+lemma l_cSup' (gc : galois_connection l u) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
+  l (Sup s) = Sup (l '' s) :=
+by rw [gc.l_cSup hne hbdd, Sup_image']
+
+lemma l_csupr (gc : galois_connection l u) {f : ι → α}
+  (hf : bdd_above (range f)) :
+  l (⨆ i, f i) = ⨆ i, l (f i) :=
+by rw [supr, gc.l_cSup (range_nonempty _) hf, supr_range']
+
+lemma l_csupr_set (gc : galois_connection l u) {s : set γ} {f : γ → α}
+  (hf : bdd_above (f '' s)) (hne : s.nonempty) :
+  l (⨆ i : s, f i) = ⨆ i : s, l (f i) :=
+by { haveI := hne.to_subtype, rw image_eq_range at hf, exact gc.l_csupr hf }
+
+lemma u_cInf (gc : galois_connection l u) {s : set β} (hne : s.nonempty)
+  (hbdd : bdd_below s) :
+  u (Inf s) = ⨅ x : s, u x :=
+gc.dual.l_cSup hne hbdd
+
+lemma u_cInf' (gc : galois_connection l u) {s : set β} (hne : s.nonempty) (hbdd : bdd_below s) :
+  u (Inf s) = Inf (u '' s) :=
+gc.dual.l_cSup' hne hbdd
+
+lemma u_cinfi (gc : galois_connection l u) {f : ι → β}
+  (hf : bdd_below (range f)) :
+  u (⨅ i, f i) = ⨅ i, u (f i) :=
+gc.dual.l_csupr hf
+
+lemma u_cinfi_set (gc : galois_connection l u) {s : set γ} {f : γ → β}
+  (hf : bdd_below (f '' s)) (hne : s.nonempty) :
+  u (⨅ i : s, f i) = ⨅ i : s, u (f i) :=
+gc.dual.l_csupr_set hf hne
+
+end galois_connection
+
+namespace order_iso
+variables [conditionally_complete_lattice α] [conditionally_complete_lattice β] [nonempty ι]
+
+lemma map_cSup (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
+  e (Sup s) = ⨆ x : s, e x :=
+e.to_galois_connection.l_cSup hne hbdd
+
+lemma map_cSup' (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_above s) :
+  e (Sup s) = Sup (e '' s) :=
+e.to_galois_connection.l_cSup' hne hbdd
+
+lemma map_csupr (e : α ≃o β) {f : ι → α} (hf : bdd_above (range f)) :
+  e (⨆ i, f i) = ⨆ i, e (f i) :=
+e.to_galois_connection.l_csupr hf
+
+lemma map_csupr_set (e : α ≃o β) {s : set γ} {f : γ → α}
+  (hf : bdd_above (f '' s)) (hne : s.nonempty) :
+  e (⨆ i : s, f i) = ⨆ i : s, e (f i) :=
+e.to_galois_connection.l_csupr_set hf hne
+
+lemma map_cInf (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_below s) :
+  e (Inf s) = ⨅ x : s, e x :=
+e.dual.map_cSup hne hbdd
+
+lemma map_cInf' (e : α ≃o β) {s : set α} (hne : s.nonempty) (hbdd : bdd_below s) :
+  e (Inf s) = Inf (e '' s) :=
+e.dual.map_cSup' hne hbdd
+
+lemma map_cinfi (e : α ≃o β) {f : ι → α} (hf : bdd_below (range f)) :
+  e (⨅ i, f i) = ⨅ i, e (f i) :=
+e.dual.map_csupr hf
+
+lemma map_cinfi_set (e : α ≃o β) {s : set γ} {f : γ → α}
+  (hf : bdd_below (f '' s)) (hne : s.nonempty) :
+  e (⨅ i : s, f i) = ⨅ i : s, e (f i) :=
+e.dual.map_csupr_set hf hne
+
+end order_iso
+
+/-!
+### Supremum/infimum of `set.image2`
+
+A collection of lemmas showing what happens to the suprema/infima of `s` and `t` when mapped under
+a binary function whose partial evaluations are lower/upper adjoints of Galois connections.
+-/
+
+section
+variables [conditionally_complete_lattice α] [conditionally_complete_lattice β]
+  [conditionally_complete_lattice γ] {f : α → β → γ} {s : set α} {t : set β}
+
+variables {l u : α → β → γ} {l₁ u₁ : β → γ → α} {l₂ u₂ : α → γ → β}
+
+lemma cSup_image2_eq_cSup_cSup (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
+  (h₂ : ∀ a, galois_connection (l a) (u₂ a))
+  (hs₀ : s.nonempty) (hs₁ : bdd_above s) (ht₀ : t.nonempty) (ht₁ : bdd_above t) :
+  Sup (image2 l s t) = l (Sup s) (Sup t) :=
+begin
+  refine eq_of_forall_ge_iff (λ c, _),
+  rw [cSup_le_iff (hs₁.image2 (λ _, (h₁ _).monotone_l) (λ _, (h₂ _).monotone_l) ht₁)
+    (hs₀.image2 ht₀), forall_image2_iff, forall₂_swap, (h₂ _).le_iff_le, cSup_le_iff ht₁ ht₀],
+  simp_rw [←(h₂ _).le_iff_le, (h₁ _).le_iff_le, cSup_le_iff hs₁ hs₀],
+end
+
+lemma cSup_image2_eq_cSup_cInf (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
+  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
+  s.nonempty → bdd_above s → t.nonempty → bdd_below t → Sup (image2 l s t) = l (Sup s) (Inf t) :=
+@cSup_image2_eq_cSup_cSup _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma cSup_image2_eq_cInf_cSup (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
+  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
+  s.nonempty → bdd_below s → t.nonempty → bdd_above t → Sup (image2 l s t) = l (Inf s) (Sup t) :=
+@cSup_image2_eq_cSup_cSup αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma cSup_image2_eq_cInf_cInf (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
+  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
+  s.nonempty → bdd_below s → t.nonempty → bdd_below t → Sup (image2 l s t) = l (Inf s) (Inf t) :=
+@cSup_image2_eq_cSup_cSup αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma cInf_image2_eq_cInf_cInf (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
+  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
+  s.nonempty → bdd_below s → t.nonempty → bdd_below t →
+  Inf (image2 u s t) = u (Inf s) (Inf t) :=
+@cSup_image2_eq_cSup_cSup αᵒᵈ βᵒᵈ γᵒᵈ _ _ _ _ _ _ l₁ l₂ (λ _, (h₁ _).dual) (λ _, (h₂ _).dual)
+
+lemma cInf_image2_eq_cInf_cSup (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
+  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
+  s.nonempty → bdd_below s → t.nonempty → bdd_above t → Inf (image2 u s t) = u (Inf s) (Sup t) :=
+@cInf_image2_eq_cInf_cInf _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma cInf_image2_eq_cSup_cInf (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
+  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
+  s.nonempty → bdd_above s → t.nonempty → bdd_below t → Inf (image2 u s t) = u (Sup s) (Inf t) :=
+@cInf_image2_eq_cInf_cInf αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma cInf_image2_eq_cSup_cSup (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
+  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
+  s.nonempty →  bdd_above s → t.nonempty → bdd_above t → Inf (image2 u s t) = u (Sup s) (Sup t) :=
+@cInf_image2_eq_cInf_cInf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+end
+
+section with_top_bot
+
+/-!
+### Complete lattice structure on `with_top (with_bot α)`
+
+If `α` is a `conditionally_complete_lattice`, then we show that `with_top α` and `with_bot α`
+also inherit the structure of conditionally complete lattices. Furthermore, we show
+that `with_top (with_bot α)` and `with_bot (with_top α)` naturally inherit the structure of a
+complete lattice. Note that for `α` a conditionally complete lattice, `Sup` and `Inf` both return
+junk values for sets which are empty or unbounded. The extension of `Sup` to `with_top α` fixes
+the unboundedness problem and the extension to `with_bot α` fixes the problem with
+the empty set.
+
+This result can be used to show that the extended reals `[-∞, ∞]` are a complete linear order.
+-/
+
+open_locale classical
+
+/-- Adding a top element to a conditionally complete lattice
+gives a conditionally complete lattice -/
+noncomputable instance with_top.conditionally_complete_lattice
+  {α : Type*} [conditionally_complete_lattice α] :
+  conditionally_complete_lattice (with_top α) :=
+{ le_cSup := λ S a hS haS, (with_top.is_lub_Sup' ⟨a, haS⟩).1 haS,
+  cSup_le := λ S a hS haS, (with_top.is_lub_Sup' hS).2 haS,
+  cInf_le := λ S a hS haS, (with_top.is_glb_Inf' hS).1 haS,
+  le_cInf := λ S a hS haS, (with_top.is_glb_Inf' ⟨a, haS⟩).2 haS,
+  ..with_top.lattice,
+  ..with_top.has_Sup,
+  ..with_top.has_Inf }
+
+/-- Adding a bottom element to a conditionally complete lattice
+gives a conditionally complete lattice -/
+noncomputable instance with_bot.conditionally_complete_lattice
+  {α : Type*} [conditionally_complete_lattice α] :
+  conditionally_complete_lattice (with_bot α) :=
+{ le_cSup := (@with_top.conditionally_complete_lattice αᵒᵈ _).cInf_le,
+  cSup_le := (@with_top.conditionally_complete_lattice αᵒᵈ _).le_cInf,
+  cInf_le := (@with_top.conditionally_complete_lattice αᵒᵈ _).le_cSup,
+  le_cInf := (@with_top.conditionally_complete_lattice αᵒᵈ _).cSup_le,
+  ..with_bot.lattice,
+  ..with_bot.has_Sup,
+  ..with_bot.has_Inf }
+
+noncomputable instance with_top.with_bot.complete_lattice {α : Type*}
+  [conditionally_complete_lattice α] : complete_lattice (with_top (with_bot α)) :=
+{ le_Sup := λ S a haS, (with_top.is_lub_Sup' ⟨a, haS⟩).1 haS,
+  Sup_le := λ S a ha,
+    begin
+      cases S.eq_empty_or_nonempty with h,
+      { show ite _ _ _ ≤ a,
+        split_ifs,
+        { rw h at h_1, cases h_1 },
+        { convert bot_le, convert with_bot.cSup_empty, rw h, refl },
+        { exfalso, apply h_2, use ⊥, rw h, rintro b ⟨⟩ } },
+      { refine (with_top.is_lub_Sup' h).2 ha }
+    end,
+  Inf_le := λ S a haS,
+    show ite _ _ _ ≤ a,
+    begin
+      split_ifs,
+      { cases a with a, exact le_rfl,
+        cases (h haS); tauto },
+      { cases a,
+        { exact le_top },
+        { apply with_top.some_le_some.2, refine cInf_le _ haS, use ⊥, intros b hb, exact bot_le } }
+    end,
+  le_Inf := λ S a haS, (with_top.is_glb_Inf' ⟨a, haS⟩).2 haS,
+  ..with_top.has_Inf,
+  ..with_top.has_Sup,
+  ..with_top.bounded_order,
+  ..with_top.lattice }
+
+
+noncomputable instance with_top.with_bot.complete_linear_order {α : Type*}
+  [conditionally_complete_linear_order α] : complete_linear_order (with_top (with_bot α)) :=
+{ .. with_top.with_bot.complete_lattice,
+  .. with_top.linear_order }
+
+noncomputable instance with_bot.with_top.complete_lattice {α : Type*}
+  [conditionally_complete_lattice α] : complete_lattice (with_bot (with_top α)) :=
+{ le_Sup := (@with_top.with_bot.complete_lattice αᵒᵈ _).Inf_le,
+  Sup_le := (@with_top.with_bot.complete_lattice αᵒᵈ _).le_Inf,
+  Inf_le := (@with_top.with_bot.complete_lattice αᵒᵈ _).le_Sup,
+  le_Inf := (@with_top.with_bot.complete_lattice αᵒᵈ _).Sup_le,
+  ..with_bot.has_Inf,
+  ..with_bot.has_Sup,
+  ..with_bot.bounded_order,
+  ..with_bot.lattice }
+
+noncomputable instance with_bot.with_top.complete_linear_order {α : Type*}
+  [conditionally_complete_linear_order α] : complete_linear_order (with_bot (with_top α)) :=
+{ .. with_bot.with_top.complete_lattice,
+  .. with_bot.linear_order }
+
+lemma with_top.supr_coe_eq_top {ι : Sort*} {α : Type*} [conditionally_complete_linear_order_bot α]
+  (f : ι → α) : (⨆ x, (f x : with_top α)) = ⊤ ↔ ¬ bdd_above (set.range f) :=
+begin
+  rw [supr_eq_top, not_bdd_above_iff],
+  refine ⟨λ hf r, _, λ hf a ha, _⟩,
+  { rcases hf r (with_top.coe_lt_top r) with ⟨i, hi⟩,
+    exact ⟨f i, ⟨i, rfl⟩, with_top.coe_lt_coe.mp hi⟩ },
+  { rcases hf (a.untop ha.ne) with ⟨-, ⟨i, rfl⟩, hi⟩,
+    exact ⟨i, by simpa only [with_top.coe_untop _ ha.ne] using with_top.coe_lt_coe.mpr hi⟩ },
+end
+
+lemma with_top.supr_coe_lt_top {ι : Sort*} {α : Type*} [conditionally_complete_linear_order_bot α]
+  (f : ι → α) : (⨆ x, (f x : with_top α)) < ⊤ ↔ bdd_above (set.range f) :=
+lt_top_iff_ne_top.trans $ (with_top.supr_coe_eq_top f).not.trans not_not
+
+end with_top_bot
+
+-- Guard against import creep
+assert_not_exists multiset
diff --git a/src/order/conditionally_complete_lattice/finset.lean b/src/order/conditionally_complete_lattice/finset.lean
new file mode 100644
index 0000000000000..ad588569add27
--- /dev/null
+++ b/src/order/conditionally_complete_lattice/finset.lean
@@ -0,0 +1,98 @@
+/-
+Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import order.conditionally_complete_lattice.basic
+import data.set.finite
+
+/-!
+# Conditionally complete lattices and finite sets.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+open set
+
+variables {α β γ : Type*}
+
+section conditionally_complete_lattice
+variables [conditionally_complete_lattice α] {s t : set α} {a b : α}
+
+lemma finset.nonempty.sup'_eq_cSup_image {s : finset β} (hs : s.nonempty) (f : β → α) :
+  s.sup' hs f = Sup (f '' s) :=
+eq_of_forall_ge_iff $ λ a,
+  by simp [cSup_le_iff (s.finite_to_set.image f).bdd_above (hs.to_set.image f)]
+
+lemma finset.nonempty.sup'_id_eq_cSup {s : finset α} (hs : s.nonempty) :
+  s.sup' hs id = Sup s :=
+by rw [hs.sup'_eq_cSup_image, image_id]
+
+end conditionally_complete_lattice
+
+section conditionally_complete_linear_order
+variables [conditionally_complete_linear_order α] {s t : set α} {a b : α}
+
+lemma finset.nonempty.cSup_eq_max' {s : finset α} (h : s.nonempty) : Sup ↑s = s.max' h :=
+eq_of_forall_ge_iff $ λ a, (cSup_le_iff s.bdd_above h.to_set).trans (s.max'_le_iff h).symm
+
+lemma finset.nonempty.cInf_eq_min' {s : finset α} (h : s.nonempty) : Inf ↑s = s.min' h :=
+@finset.nonempty.cSup_eq_max' αᵒᵈ _ s h
+
+lemma finset.nonempty.cSup_mem {s : finset α} (h : s.nonempty) : Sup (s : set α) ∈ s :=
+by { rw h.cSup_eq_max', exact s.max'_mem _ }
+
+lemma finset.nonempty.cInf_mem {s : finset α} (h : s.nonempty) : Inf (s : set α) ∈ s :=
+@finset.nonempty.cSup_mem αᵒᵈ _ _ h
+
+lemma set.nonempty.cSup_mem (h : s.nonempty) (hs : s.finite) : Sup s ∈ s :=
+by { lift s to finset α using hs, exact finset.nonempty.cSup_mem h }
+
+lemma set.nonempty.cInf_mem (h : s.nonempty) (hs : s.finite) : Inf s ∈ s :=
+@set.nonempty.cSup_mem αᵒᵈ _ _ h hs
+
+lemma set.finite.cSup_lt_iff (hs : s.finite) (h : s.nonempty) : Sup s < a ↔ ∀ x ∈ s, x < a :=
+⟨λ h x hx, (le_cSup hs.bdd_above hx).trans_lt h, λ H, H _ $ h.cSup_mem hs⟩
+
+lemma set.finite.lt_cInf_iff (hs : s.finite) (h : s.nonempty) : a < Inf s ↔ ∀ x ∈ s, a < x :=
+@set.finite.cSup_lt_iff αᵒᵈ _ _ _ hs h
+
+end conditionally_complete_linear_order
+
+/-!
+### Relation between `Sup` / `Inf` and `finset.sup'` / `finset.inf'`
+
+Like the `Sup` of a `conditionally_complete_lattice`, `finset.sup'` also requires the set to be
+non-empty. As a result, we can translate between the two.
+-/
+
+namespace finset
+
+lemma sup'_eq_cSup_image [conditionally_complete_lattice β] (s : finset α) (H) (f : α → β) :
+  s.sup' H f = Sup (f '' s) :=
+begin
+  apply le_antisymm,
+  { refine (finset.sup'_le _ _ $ λ a ha, _),
+    refine le_cSup ⟨s.sup' H f, _⟩ ⟨a, ha, rfl⟩,
+    rintros i ⟨j, hj, rfl⟩,
+    exact finset.le_sup' _ hj },
+  { apply cSup_le ((coe_nonempty.mpr H).image _),
+    rintros _ ⟨a, ha, rfl⟩,
+    exact finset.le_sup' _ ha, }
+end
+
+lemma inf'_eq_cInf_image [conditionally_complete_lattice β] (s : finset α) (H) (f : α → β) :
+  s.inf' H f = Inf (f '' s) :=
+@sup'_eq_cSup_image _ βᵒᵈ _ _ H _
+
+lemma sup'_id_eq_cSup [conditionally_complete_lattice α] (s : finset α) (H) :
+  s.sup' H id = Sup s :=
+by rw [sup'_eq_cSup_image s H, set.image_id]
+
+lemma inf'_id_eq_cInf [conditionally_complete_lattice α] (s : finset α) (H) :
+  s.inf' H id = Inf s :=
+@sup'_id_eq_cSup αᵒᵈ _ _ H
+
+end finset
diff --git a/src/order/conditionally_complete_lattice/group.lean b/src/order/conditionally_complete_lattice/group.lean
new file mode 100644
index 0000000000000..b9c5bcef8ad2c
--- /dev/null
+++ b/src/order/conditionally_complete_lattice/group.lean
@@ -0,0 +1,53 @@
+/-
+Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import order.conditionally_complete_lattice.basic
+import algebra.order.group.type_tags
+
+/-!
+# Conditionally complete lattices and groups.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+
+section group
+
+variables {α : Type*} {ι : Sort*} {ι' : Sort*}
+  [nonempty ι] [nonempty ι'] [conditionally_complete_lattice α] [group α]
+
+@[to_additive]
+lemma le_mul_cinfi [covariant_class α α (*) (≤)] {a : α} {g : α} {h : ι → α}
+  (H : ∀ j, a ≤ g * h j) : a ≤ g * infi h :=
+inv_mul_le_iff_le_mul.mp $ le_cinfi $ λ hi, inv_mul_le_iff_le_mul.mpr $ H _
+
+@[to_additive]
+lemma mul_csupr_le [covariant_class α α (*) (≤)] {a : α} {g : α} {h : ι → α}
+  (H : ∀ j, g * h j ≤ a) : g * supr h ≤ a :=
+@le_mul_cinfi αᵒᵈ _ _ _ _ _ _ _ _ H
+
+@[to_additive]
+lemma le_cinfi_mul [covariant_class α α (function.swap (*)) (≤)] {a : α} {g : ι → α} {h : α}
+  (H : ∀ i, a ≤ g i * h) : a ≤ infi g * h :=
+mul_inv_le_iff_le_mul.mp $ le_cinfi $ λ gi, mul_inv_le_iff_le_mul.mpr $ H _
+
+@[to_additive]
+lemma csupr_mul_le [covariant_class α α (function.swap (*)) (≤)] {a : α} {g : ι → α} {h : α}
+  (H : ∀ i, g i * h ≤ a) : supr g * h ≤ a :=
+@le_cinfi_mul αᵒᵈ _ _ _ _ _ _ _ _ H
+
+@[to_additive]
+lemma le_cinfi_mul_cinfi [covariant_class α α (*) (≤)] [covariant_class α α (function.swap (*)) (≤)]
+  {a : α} {g : ι → α} {h : ι' → α} (H : ∀ i j, a ≤ g i * h j) : a ≤ infi g * infi h :=
+le_cinfi_mul $ λ i, le_mul_cinfi $ H _
+
+@[to_additive]
+lemma csupr_mul_csupr_le [covariant_class α α (*) (≤)] [covariant_class α α (function.swap (*)) (≤)]
+  {a : α} {g : ι → α} {h : ι' → α} (H : ∀ i j, g i * h j ≤ a) : supr g * supr h ≤ a :=
+csupr_mul_le $ λ i, mul_csupr_le $ H _
+
+end group
diff --git a/src/order/copy.lean b/src/order/copy.lean
index 2f55f0cb644e7..77da359129d7b 100644
--- a/src/order/copy.lean
+++ b/src/order/copy.lean
@@ -3,11 +3,14 @@ Copyright (c) 2020 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
-import order.conditionally_complete_lattice
+import order.conditionally_complete_lattice.basic
 
 /-!
 # Tooling to make copies of lattice structures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Sometimes it is useful to make a copy of a lattice structure
 where one replaces the data parts with provably equal definitions
 that have better definitional properties.
diff --git a/src/order/countable_dense_linear_order.lean b/src/order/countable_dense_linear_order.lean
index e2e803c076899..f5deec2b668fb 100644
--- a/src/order/countable_dense_linear_order.lean
+++ b/src/order/countable_dense_linear_order.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: David Wärn
 -/
 import order.ideal
+import data.finset.lattice
 
 /-!
 # The back and forth method and countable dense linear orders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Results
 
 Suppose `α β` are linear orders, with `α` countable and `β` dense, nontrivial. Then there is an
diff --git a/src/order/cover.lean b/src/order/cover.lean
index bcb6c46c22f2a..e654312d37f98 100644
--- a/src/order/cover.lean
+++ b/src/order/cover.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies, Violeta Hernández Palacios, Grayson Burton, Floris van Doorn
 -/
 import data.set.intervals.ord_connected
+import order.antisymmetrization
 
 /-!
 # The covering relation
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the covering relation in an order. `b` is said to cover `a` if `a < b` and there
 is no element in between. We say that `b` weakly covers `a` if `a ≤ b` and there is no element
 between `a` and `b`. In a partial order this is equivalent to `a ⋖ b ∨ a = b`, in a preorder this
@@ -26,7 +30,7 @@ variables {α β : Type*}
 section weakly_covers
 
 section preorder
-variables [preorder α] [preorder β] {a b c: α}
+variables [preorder α] [preorder β] {a b c : α}
 
 /-- `wcovby a b` means that `a = b` or `b` covers `a`.
 This means that `a ≤ b` and there is no element in between.
@@ -47,12 +51,26 @@ lemma wcovby_of_le_of_le (h1 : a ≤ b) (h2 : b ≤ a) : a ⩿ b :=
 
 alias wcovby_of_le_of_le ← has_le.le.wcovby_of_le
 
+lemma antisymm_rel.wcovby (h : antisymm_rel (≤) a b) : a ⩿ b := wcovby_of_le_of_le h.1 h.2
+
 lemma wcovby.wcovby_iff_le (hab : a ⩿ b) : b ⩿ a ↔ b ≤ a :=
 ⟨λ h, h.le, λ h, h.wcovby_of_le hab.le⟩
 
 lemma wcovby_of_eq_or_eq (hab : a ≤ b) (h : ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b) : a ⩿ b :=
 ⟨hab, λ c ha hb, (h c ha.le hb.le).elim ha.ne' hb.ne⟩
 
+lemma antisymm_rel.trans_wcovby (hab : antisymm_rel (≤) a b) (hbc : b ⩿ c) : a ⩿ c :=
+⟨hab.1.trans hbc.le, λ d had hdc, hbc.2 (hab.2.trans_lt had) hdc⟩
+
+lemma wcovby_congr_left (hab : antisymm_rel (≤) a b) : a ⩿ c ↔ b ⩿ c :=
+⟨hab.symm.trans_wcovby, hab.trans_wcovby⟩
+
+lemma wcovby.trans_antisymm_rel (hab : a ⩿ b) (hbc : antisymm_rel (≤) b c) : a ⩿ c :=
+⟨hab.le.trans hbc.1, λ d had hdc, hab.2 had $ hdc.trans_le hbc.2⟩
+
+lemma wcovby_congr_right (hab : antisymm_rel (≤) a b) : c ⩿ a ↔ c ⩿ b :=
+⟨λ h, h.trans_antisymm_rel hab, λ h, h.trans_antisymm_rel hab.symm⟩
+
 /-- If `a ≤ b`, then `b` does not cover `a` iff there's an element in between. -/
 lemma not_wcovby_iff (h : a ≤ b) : ¬ a ⩿ b ↔ ∃ c, a < c ∧ c < b :=
 by simp_rw [wcovby, h, true_and, not_forall, exists_prop, not_not]
@@ -62,6 +80,9 @@ instance wcovby.is_refl : is_refl α (⩿) := ⟨wcovby.refl⟩
 lemma wcovby.Ioo_eq (h : a ⩿ b) : Ioo a b = ∅ :=
 eq_empty_iff_forall_not_mem.2 $ λ x hx, h.2 hx.1 hx.2
 
+lemma wcovby_iff_Ioo_eq : a ⩿ b ↔ a ≤ b ∧ Ioo a b = ∅ :=
+and_congr_right' $ by simp [eq_empty_iff_forall_not_mem]
+
 lemma wcovby.of_image (f : α ↪o β) (h : f a ⩿ f b) : a ⩿ b :=
 ⟨f.le_iff_le.mp h.le, λ c hac hcb, h.2 (f.lt_iff_lt.mpr hac) (f.lt_iff_lt.mpr hcb)⟩
 
@@ -103,6 +124,10 @@ begin
   exact (h.2 h2 h3).elim
 end
 
+/-- An `iff` version of `wcovby.eq_or_eq` and `wcovby_of_eq_or_eq`. -/
+lemma wcovby_iff_le_and_eq_or_eq : a ⩿ b ↔ a ≤ b ∧ ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b :=
+⟨λ h, ⟨h.le, λ c, h.eq_or_eq⟩, and.rec wcovby_of_eq_or_eq⟩
+
 lemma wcovby.le_and_le_iff (h : a ⩿ b) : a ≤ c ∧ c ≤ b ↔ c = a ∨ c = b :=
 begin
   refine ⟨λ h2, h.eq_or_eq h2.1 h2.2, _⟩, rintro (rfl|rfl), exacts [⟨le_rfl, h.le⟩, ⟨h.le, le_rfl⟩]
@@ -119,6 +144,23 @@ by rw [← Icc_diff_left, h.Icc_eq, diff_singleton_subset_iff]
 
 end partial_order
 
+section semilattice_sup
+variables [semilattice_sup α] {a b c : α}
+
+lemma wcovby.sup_eq (hac : a ⩿ c) (hbc : b ⩿ c) (hab : a ≠ b) : a ⊔ b = c :=
+(sup_le hac.le hbc.le).eq_of_not_lt $ λ h,
+  hab.lt_sup_or_lt_sup.elim (λ h', hac.2 h' h) (λ h', hbc.2 h' h)
+
+end semilattice_sup
+
+section semilattice_inf
+variables [semilattice_inf α] {a b c : α}
+
+lemma wcovby.inf_eq (hca : c ⩿ a) (hcb : c ⩿ b) (hab : a ≠ b) : a ⊓ b = c :=
+(le_inf hca.le hcb.le).eq_of_not_gt $ λ h, hab.inf_lt_or_inf_lt.elim (hca.2 h) (hcb.2 h)
+
+end semilattice_inf
+
 end weakly_covers
 
 section has_lt
@@ -157,7 +199,7 @@ alias of_dual_covby_of_dual_iff ↔ _ covby.of_dual
 end has_lt
 
 section preorder
-variables [preorder α] [preorder β] {a b : α}
+variables [preorder α] [preorder β] {a b c : α}
 
 lemma covby.le (h : a ⋖ b) : a ≤ b := h.1.le
 protected lemma covby.ne (h : a ⋖ b) : a ≠ b := h.lt.ne
@@ -167,6 +209,9 @@ protected lemma covby.wcovby (h : a ⋖ b) : a ⩿ b := ⟨h.le, h.2⟩
 lemma wcovby.covby_of_not_le (h : a ⩿ b) (h2 : ¬ b ≤ a) : a ⋖ b := ⟨h.le.lt_of_not_le h2, h.2⟩
 lemma wcovby.covby_of_lt (h : a ⩿ b) (h2 : a < b) : a ⋖ b := ⟨h2, h.2⟩
 
+lemma not_covby_of_lt_of_lt (h₁ : a < b) (h₂ : b < c) : ¬ a ⋖ c :=
+(not_covby_iff (h₁.trans h₂)).2 ⟨b, h₁, h₂⟩
+
 lemma covby_iff_wcovby_and_lt : a ⋖ b ↔ a ⩿ b ∧ a < b :=
 ⟨λ h, ⟨h.wcovby, h.lt⟩, λ h, h.1.covby_of_lt h.2⟩
 
@@ -177,6 +222,18 @@ lemma wcovby_iff_covby_or_le_and_le : a ⩿ b ↔ a ⋖ b ∨ (a ≤ b ∧ b ≤
 ⟨λ h, or_iff_not_imp_right.mpr $ λ h', h.covby_of_not_le $ λ hba, h' ⟨h.le, hba⟩,
   λ h', h'.elim (λ h, h.wcovby) (λ h, h.1.wcovby_of_le h.2)⟩
 
+lemma antisymm_rel.trans_covby (hab : antisymm_rel (≤) a b) (hbc : b ⋖ c) : a ⋖ c :=
+⟨hab.1.trans_lt hbc.lt, λ d had hdc, hbc.2 (hab.2.trans_lt had) hdc⟩
+
+lemma covby_congr_left (hab : antisymm_rel (≤) a b) : a ⋖ c ↔ b ⋖ c :=
+⟨hab.symm.trans_covby, hab.trans_covby⟩
+
+lemma covby.trans_antisymm_rel (hab : a ⋖ b) (hbc : antisymm_rel (≤) b c) : a ⋖ c :=
+⟨hab.lt.trans_le hbc.1, λ d had hdb, hab.2 had $ hdb.trans_le hbc.2⟩
+
+lemma covby_congr_right (hab : antisymm_rel (≤) a b) : c ⋖ a ↔ c ⋖ b :=
+⟨λ h, h.trans_antisymm_rel hab, λ h, h.trans_antisymm_rel hab.symm⟩
+
 instance : is_nonstrict_strict_order α (⩿) (⋖) :=
 ⟨λ a b, covby_iff_wcovby_and_not_le.trans $ and_congr_right $ λ h, h.wcovby_iff_le.not.symm⟩
 
@@ -185,6 +242,9 @@ instance covby.is_irrefl : is_irrefl α (⋖) := ⟨λ a ha, ha.ne rfl⟩
 lemma covby.Ioo_eq (h : a ⋖ b) : Ioo a b = ∅ :=
 h.wcovby.Ioo_eq
 
+lemma covby_iff_Ioo_eq : a ⋖ b ↔ a < b ∧ Ioo a b = ∅ :=
+and_congr_right' $ by simp [eq_empty_iff_forall_not_mem]
+
 lemma covby.of_image (f : α ↪o β) (h : f a ⋖ f b) : a ⋖ b :=
 ⟨f.lt_iff_lt.mp h.lt, λ c hac hcb, h.2 (f.lt_iff_lt.mpr hac) (f.lt_iff_lt.mpr hcb)⟩
 
@@ -199,10 +259,13 @@ lemma set.ord_connected.apply_covby_apply_iff (f : α ↪o β) (h : (range f).or
   e a ⋖ e b ↔ a ⋖ b :=
 (ord_connected_range (e : α ≃o β)).apply_covby_apply_iff ((e : α ≃o β) : α ↪o β)
 
+lemma covby_of_eq_or_eq (hab : a < b) (h : ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b) : a ⋖ b :=
+⟨hab, λ c ha hb, (h c ha.le hb.le).elim ha.ne' hb.ne⟩
+
 end preorder
 
 section partial_order
-variables [partial_order α] {a b : α}
+variables [partial_order α] {a b c : α}
 
 lemma wcovby.covby_of_ne (h : a ⩿ b) (h2 : a ≠ b) : a ⋖ b := ⟨h.le.lt_of_ne h2, h.2⟩
 
@@ -212,6 +275,18 @@ lemma covby_iff_wcovby_and_ne : a ⋖ b ↔ a ⩿ b ∧ a ≠ b :=
 lemma wcovby_iff_covby_or_eq : a ⩿ b ↔ a ⋖ b ∨ a = b :=
 by rw [le_antisymm_iff, wcovby_iff_covby_or_le_and_le]
 
+lemma wcovby_iff_eq_or_covby : a ⩿ b ↔ a = b ∨ a ⋖ b := wcovby_iff_covby_or_eq.trans or.comm
+
+alias wcovby_iff_covby_or_eq ↔ wcovby.covby_or_eq _
+alias wcovby_iff_eq_or_covby ↔ wcovby.eq_or_covby _
+
+lemma covby.eq_or_eq (h : a ⋖ b) (h2 : a ≤ c) (h3 : c ≤ b) : c = a ∨ c = b :=
+h.wcovby.eq_or_eq h2 h3
+
+/-- An `iff` version of `covby.eq_or_eq` and `covby_of_eq_or_eq`. -/
+lemma covby_iff_lt_and_eq_or_eq : a ⋖ b ↔ a < b ∧ ∀ c, a ≤ c → c ≤ b → c = a ∨ c = b :=
+⟨λ h, ⟨h.lt, λ c, h.eq_or_eq⟩, and.rec covby_of_eq_or_eq⟩
+
 lemma covby.Ico_eq (h : a ⋖ b) : Ico a b = {a} :=
 by rw [←Ioo_union_left h.lt, h.Ioo_eq, empty_union]
 
@@ -224,8 +299,7 @@ h.wcovby.Icc_eq
 end partial_order
 
 section linear_order
-
-variables [linear_order α] {a b : α}
+variables [linear_order α] {a b c : α}
 
 lemma covby.Ioi_eq (h : a ⋖ b) : Ioi a = Ici b :=
 by rw [← Ioo_union_Ici_eq_Ioi h.lt, h.Ioo_eq, empty_union]
@@ -233,6 +307,22 @@ by rw [← Ioo_union_Ici_eq_Ioi h.lt, h.Ioo_eq, empty_union]
 lemma covby.Iio_eq (h : a ⋖ b) : Iio b = Iic a :=
 by rw [← Iic_union_Ioo_eq_Iio h.lt, h.Ioo_eq, union_empty]
 
+lemma wcovby.le_of_lt (hab : a ⩿ b) (hcb : c < b) : c ≤ a := not_lt.1 $ λ hac, hab.2 hac hcb
+lemma wcovby.ge_of_gt (hab : a ⩿ b) (hac : a < c) : b ≤ c := not_lt.1 $ hab.2 hac
+lemma covby.le_of_lt (hab : a ⋖ b) : c < b → c ≤ a := hab.wcovby.le_of_lt
+lemma covby.ge_of_gt (hab : a ⋖ b) : a < c → b ≤ c := hab.wcovby.ge_of_gt
+
+lemma covby.unique_left (ha : a ⋖ c) (hb : b ⋖ c) : a = b :=
+(hb.le_of_lt ha.lt).antisymm $ ha.le_of_lt hb.lt
+
+lemma covby.unique_right (hb : a ⋖ b) (hc : a ⋖ c) : b = c :=
+(hb.ge_of_gt hc.lt).antisymm $ hc.ge_of_gt hb.lt
+
+/-- If `a`, `b`, `c` are consecutive and `a < x < c` then `x = b`. -/
+lemma covby.eq_of_between {x : α} (hab : a ⋖ b) (hbc : b ⋖ c) (hax : a < x) (hxc : x < c) :
+  x = b :=
+le_antisymm (le_of_not_lt $ λ h, hbc.2 h hxc) (le_of_not_lt $ hab.2 hax)
+
 end linear_order
 
 namespace set
@@ -250,3 +340,73 @@ lemma covby_insert {x : α} {s : set α} (hx : x ∉ s) : s ⋖ insert x s :=
 (wcovby_insert x s).covby_of_lt $ ssubset_insert hx
 
 end set
+
+namespace prod
+variables [partial_order α] [partial_order β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}
+
+@[simp] lemma swap_wcovby_swap : x.swap ⩿ y.swap ↔ x ⩿ y :=
+apply_wcovby_apply_iff (order_iso.prod_comm : α × β ≃o β × α)
+
+@[simp] lemma swap_covby_swap : x.swap ⋖ y.swap ↔ x ⋖ y :=
+apply_covby_apply_iff (order_iso.prod_comm : α × β ≃o β × α)
+
+lemma fst_eq_or_snd_eq_of_wcovby : x ⩿ y → x.1 = y.1 ∨ x.2 = y.2 :=
+begin
+  refine λ h, of_not_not (λ hab, _),
+  push_neg at hab,
+  exact h.2 (mk_lt_mk.2 $ or.inl ⟨hab.1.lt_of_le h.1.1, le_rfl⟩)
+    (mk_lt_mk.2 $ or.inr ⟨le_rfl, hab.2.lt_of_le h.1.2⟩),
+end
+
+lemma _root_.wcovby.fst (h : x ⩿ y) : x.1 ⩿ y.1 :=
+⟨h.1.1, λ c h₁ h₂, h.2 (mk_lt_mk_iff_left.2 h₁) ⟨⟨h₂.le, h.1.2⟩, λ hc, h₂.not_le hc.1⟩⟩
+
+lemma _root_.wcovby.snd (h : x ⩿ y) : x.2 ⩿ y.2 :=
+⟨h.1.2, λ c h₁ h₂, h.2 (mk_lt_mk_iff_right.2 h₁) ⟨⟨h.1.1, h₂.le⟩, λ hc, h₂.not_le hc.2⟩⟩
+
+lemma mk_wcovby_mk_iff_left : (a₁, b) ⩿ (a₂, b) ↔ a₁ ⩿ a₂ :=
+begin
+  refine ⟨wcovby.fst, and.imp mk_le_mk_iff_left.2 $ λ h c h₁ h₂, _⟩,
+  have : c.2 = b:= h₂.le.2.antisymm h₁.le.2,
+  rw [←@prod.mk.eta _ _ c, this, mk_lt_mk_iff_left] at h₁ h₂,
+  exact h h₁ h₂,
+end
+
+lemma mk_wcovby_mk_iff_right : (a, b₁) ⩿ (a, b₂) ↔ b₁ ⩿ b₂ :=
+swap_wcovby_swap.trans mk_wcovby_mk_iff_left
+
+lemma mk_covby_mk_iff_left : (a₁, b) ⋖ (a₂, b) ↔ a₁ ⋖ a₂ :=
+by simp_rw [covby_iff_wcovby_and_lt, mk_wcovby_mk_iff_left, mk_lt_mk_iff_left]
+
+lemma mk_covby_mk_iff_right : (a, b₁) ⋖ (a, b₂) ↔ b₁ ⋖ b₂ :=
+by simp_rw [covby_iff_wcovby_and_lt, mk_wcovby_mk_iff_right, mk_lt_mk_iff_right]
+
+lemma mk_wcovby_mk_iff : (a₁, b₁) ⩿ (a₂, b₂) ↔ a₁ ⩿ a₂ ∧ b₁ = b₂ ∨ b₁ ⩿ b₂ ∧ a₁ = a₂ :=
+begin
+  refine ⟨λ h, _, _⟩,
+  { obtain rfl | rfl : a₁ = a₂ ∨ b₁ = b₂ := fst_eq_or_snd_eq_of_wcovby h,
+    { exact or.inr ⟨mk_wcovby_mk_iff_right.1 h, rfl⟩ },
+    { exact or.inl ⟨mk_wcovby_mk_iff_left.1 h, rfl⟩ } },
+  { rintro (⟨h, rfl⟩ | ⟨h, rfl⟩),
+    { exact mk_wcovby_mk_iff_left.2 h },
+    { exact mk_wcovby_mk_iff_right.2 h } }
+end
+
+lemma mk_covby_mk_iff : (a₁, b₁) ⋖ (a₂, b₂) ↔ a₁ ⋖ a₂ ∧ b₁ = b₂ ∨ b₁ ⋖ b₂ ∧ a₁ = a₂ :=
+begin
+  refine ⟨λ h, _, _⟩,
+  { obtain rfl | rfl : a₁ = a₂ ∨ b₁ = b₂ := fst_eq_or_snd_eq_of_wcovby h.wcovby,
+    { exact or.inr ⟨mk_covby_mk_iff_right.1 h, rfl⟩ },
+    { exact or.inl ⟨mk_covby_mk_iff_left.1 h, rfl⟩ } },
+  { rintro (⟨h, rfl⟩ | ⟨h, rfl⟩),
+    { exact mk_covby_mk_iff_left.2 h },
+    { exact mk_covby_mk_iff_right.2 h } }
+end
+
+lemma wcovby_iff : x ⩿ y ↔ x.1 ⩿ y.1 ∧ x.2 = y.2 ∨ x.2 ⩿ y.2 ∧ x.1 = y.1 :=
+by { cases x, cases y, exact mk_wcovby_mk_iff }
+
+lemma covby_iff : x ⋖ y ↔ x.1 ⋖ y.1 ∧ x.2 = y.2 ∨ x.2 ⋖ y.2 ∧ x.1 = y.1 :=
+by { cases x, cases y, exact mk_covby_mk_iff }
+
+end prod
diff --git a/src/order/default.lean b/src/order/default.lean
deleted file mode 100644
index b565d70b2b21c..0000000000000
--- a/src/order/default.lean
+++ /dev/null
@@ -1,2 +0,0 @@
-import order.boolean_algebra
-import order.complete_lattice
diff --git a/src/order/directed.lean b/src/order/directed.lean
index 11f44fa57d220..0456ab1e72b13 100644
--- a/src/order/directed.lean
+++ b/src/order/directed.lean
@@ -3,13 +3,16 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import data.set.basic
+import data.set.image
 import order.lattice
 import order.max
 
 /-!
 # Directed indexed families and sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines directed indexed families and directed sets. An indexed family/set is
 directed iff each pair of elements has a shared upper bound.
 
@@ -19,13 +22,18 @@ directed iff each pair of elements has a shared upper bound.
 * `directed_on r s`: Predicate stating that the set `s` is `r`-directed.
 * `is_directed α r`: Prop-valued mixin stating that `α` is `r`-directed. Follows the style of the
   unbundled relation classes such as `is_total`.
+* `scott_continuous`: Predicate stating that a function between preorders preserves
+  `is_lub` on directed sets.
+
+## References
+* [Gierz et al, *A Compendium of Continuous Lattices*][GierzEtAl1980]
 -/
 
 open function
 
 universes u v w
 
-variables {α : Type u} {β : Type v} {ι : Sort w} (r s : α → α → Prop)
+variables {α : Type u} {β : Type v} {ι : Sort w} (r r' s : α → α → Prop)
 local infix ` ≼ ` : 50 := r
 
 /-- A family of elements of α is directed (with respect to a relation `≼` on α)
@@ -36,21 +44,29 @@ def directed (f : ι → α) := ∀ x y, ∃ z, f x ≼ f z ∧ f y ≼ f z
   pair of elements in the set. -/
 def directed_on (s : set α) := ∀ (x ∈ s) (y ∈ s), ∃ z ∈ s, x ≼ z ∧ y ≼ z
 
-variables {r}
+variables {r r'}
 
 theorem directed_on_iff_directed {s} : @directed_on α r s ↔ directed r (coe : s → α) :=
 by simp [directed, directed_on]; refine ball_congr (λ x hx, by simp; refl)
 
 alias directed_on_iff_directed ↔ directed_on.directed_coe _
 
+theorem directed_on_range {f : ι → α} :
+  directed r f ↔ directed_on r (set.range f) :=
+by simp_rw [directed, directed_on, set.forall_range_iff, set.exists_range_iff]
+
 theorem directed_on_image {s} {f : β → α} :
   directed_on r (f '' s) ↔ directed_on (f ⁻¹'o r) s :=
 by simp only [directed_on, set.ball_image_iff, set.bex_image_iff, order.preimage]
 
-theorem directed_on.mono {s : set α} (h : directed_on r s)
-  {r' : α → α → Prop} (H : ∀ {a b}, r a b → r' a b) :
+lemma directed_on.mono' {s : set α} (hs : directed_on r s)
+  (h : ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → r a b → r' a b) :
+  directed_on r' s :=
+λ x hx y hy, let ⟨z, hz, hxz, hyz⟩ := hs _ hx _ hy in ⟨z, hz, h hx hz hxz, h hy hz hyz⟩
+
+lemma directed_on.mono {s : set α} (h : directed_on r s) (H : ∀ {a b}, r a b → r' a b) :
   directed_on r' s :=
-λ x hx y hy, let ⟨z, zs, xz, yz⟩ := h x hx y hy in ⟨z, zs, H xz, H yz⟩
+h.mono' $ λ _ _ _ _, H
 
 theorem directed_comp {ι} {f : ι → β} {g : β → α} :
   directed r (g ∘ f) ↔ directed (g ⁻¹'o r) f := iff.rfl
@@ -73,6 +89,15 @@ lemma monotone.directed_le [semilattice_sup α] [preorder β] {f : α → β} :
   monotone f → directed (≤) f :=
 directed_of_sup
 
+lemma antitone.directed_ge [semilattice_sup α] [preorder β] {f : α → β} (hf : antitone f) :
+  directed (≥) f :=
+directed_of_sup hf
+
+/-- A set stable by supremum is `≤`-directed. -/
+lemma directed_on_of_sup_mem [semilattice_sup α] {S : set α}
+  (H : ∀ ⦃i j⦄, i ∈ S → j ∈ S → i ⊔ j ∈ S) : directed_on (≤) S :=
+λ a ha b hb, ⟨a ⊔ b, H ha hb, le_sup_left, le_sup_right⟩
+
 lemma directed.extend_bot [preorder α] [order_bot α] {e : ι → β} {f : ι → α}
   (hf : directed (≤) f) (he : function.injective e) :
   directed (≤) (function.extend e f ⊥) :=
@@ -84,7 +109,7 @@ begin
   { use e i, simp [function.extend_apply' _ _ _ hb] },
   rcases hf i j with ⟨k, hi, hj⟩,
   use (e k),
-  simp only [function.extend_apply he, *, true_and]
+  simp only [he.extend_apply, *, true_and]
 end
 
 /-- An antitone function on an inf-semilattice is directed. -/
@@ -92,6 +117,23 @@ lemma directed_of_inf [semilattice_inf α] {r : β → β → Prop} {f : α →
   (hf : ∀ a₁ a₂, a₁ ≤ a₂ → r (f a₂) (f a₁)) : directed r f :=
 λ x y, ⟨x ⊓ y, hf _ _ inf_le_left, hf _ _ inf_le_right⟩
 
+lemma monotone.directed_ge [semilattice_inf α] [preorder β] {f : α → β} (hf : monotone f) :
+  directed (≥) f :=
+directed_of_inf hf
+
+lemma antitone.directed_le [semilattice_inf α] [preorder β] {f : α → β} (hf : antitone f) :
+  directed (≤) f :=
+directed_of_inf hf
+
+/-- A set stable by infimum is `≥`-directed. -/
+lemma directed_on_of_inf_mem [semilattice_inf α] {S : set α}
+  (H : ∀ ⦃i j⦄, i ∈ S → j ∈ S → i ⊓ j ∈ S) : directed_on (≥) S :=
+λ a ha b hb, ⟨a ⊓ b, H ha hb, inf_le_left, inf_le_right⟩
+
+lemma is_total.directed [is_total α r] (f : ι → α) :
+  directed r f :=
+λ i j, or.cases_on (total_of r (f i) (f j)) (λ h, ⟨j, h, refl _⟩) (λ h, ⟨i, refl _, h⟩)
+
 /-- `is_directed α r` states that for any elements `a`, `b` there exists an element `c` such that
 `r a c` and `r b c`. -/
 class is_directed (α : Type*) (r : α → α → Prop) : Prop :=
@@ -111,7 +153,7 @@ lemma directed_on_univ_iff : directed_on r set.univ ↔ is_directed α r :=
 
 @[priority 100]  -- see Note [lower instance priority]
 instance is_total.to_is_directed [is_total α r] : is_directed α r :=
-⟨λ a b, or.cases_on (total_of r a b) (λ h, ⟨b, h, refl _⟩) (λ h, ⟨a, refl _, h⟩)⟩
+by rw ← directed_id_iff; exact is_total.directed _
 
 lemma is_directed_mono [is_directed α r] (h : ∀ ⦃a b⦄, r a b → s a b) : is_directed α s :=
 ⟨λ a b, let ⟨c, ha, hb⟩ := is_directed.directed a b in ⟨c, h ha, h hb⟩⟩
@@ -119,29 +161,86 @@ lemma is_directed_mono [is_directed α r] (h : ∀ ⦃a b⦄, r a b → s a b) :
 lemma exists_ge_ge [has_le α] [is_directed α (≤)] (a b : α) : ∃ c, a ≤ c ∧ b ≤ c :=
 directed_of (≤) a b
 
-lemma exists_le_le [has_le α] [is_directed α (swap (≤))] (a b : α) : ∃ c, c ≤ a ∧ c ≤ b :=
-directed_of (swap (≤)) a b
+lemma exists_le_le [has_le α] [is_directed α (≥)] (a b : α) : ∃ c, c ≤ a ∧ c ≤ b :=
+directed_of (≥) a b
 
-instance order_dual.is_directed_ge [has_le α] [is_directed α (≤)] : is_directed αᵒᵈ (swap (≤)) :=
+instance order_dual.is_directed_ge [has_le α] [is_directed α (≤)] : is_directed αᵒᵈ (≥) :=
 by assumption
 
-instance order_dual.is_directed_le [has_le α] [is_directed α (swap (≤))] : is_directed αᵒᵈ (≤) :=
+instance order_dual.is_directed_le [has_le α] [is_directed α (≥)] : is_directed αᵒᵈ (≤) :=
 by assumption
 
+section reflexive
+
+lemma directed_on.insert (h : reflexive r) (a : α) {s : set α} (hd : directed_on r s)
+  (ha : ∀ b ∈ s, ∃ c ∈ s, a ≼ c ∧ b ≼ c) : directed_on r (insert a s) :=
+begin
+  rintros x (rfl | hx) y (rfl | hy),
+  { exact ⟨y, set.mem_insert _ _, h _, h _⟩ },
+  { obtain ⟨w, hws, hwr⟩ := ha y hy,
+    exact ⟨w, set.mem_insert_of_mem _ hws, hwr⟩ },
+  { obtain ⟨w, hws, hwr⟩ := ha x hx,
+    exact ⟨w, set.mem_insert_of_mem _ hws, hwr.symm⟩ },
+  { obtain ⟨w, hws, hwr⟩ := hd x hx y hy,
+    exact ⟨w, set.mem_insert_of_mem _ hws, hwr⟩ },
+end
+
+lemma directed_on_singleton (h : reflexive r) (a : α) : directed_on r ({a} : set α) :=
+λ x hx y hy, ⟨x, hx, h _, hx.symm ▸ hy.symm ▸ h _⟩
+
+lemma directed_on_pair (h : reflexive r) {a b : α} (hab : a ≼ b) :
+  directed_on r ({a, b} : set α) :=
+(directed_on_singleton h _).insert h _ $ λ c hc, ⟨c, hc, hc.symm ▸ hab, h _⟩
+
+lemma directed_on_pair' (h : reflexive r) {a b : α} (hab : a ≼ b) :
+  directed_on r ({b, a} : set α) :=
+begin
+  rw set.pair_comm,
+  apply directed_on_pair h hab,
+end
+
+end reflexive
+
 section preorder
 variables [preorder α] {a : α}
 
-protected lemma is_min.is_bot [is_directed α (swap (≤))] (h : is_min a) : is_bot a :=
+protected lemma is_min.is_bot [is_directed α (≥)] (h : is_min a) : is_bot a :=
 λ b, let ⟨c, hca, hcb⟩ := exists_le_le a b in (h hca).trans hcb
 
 protected lemma is_max.is_top [is_directed α (≤)] (h : is_max a) : is_top a :=
-λ b, let ⟨c, hac, hbc⟩ := exists_ge_ge a b in hbc.trans $ h hac
+h.to_dual.is_bot
+
+lemma directed_on.is_bot_of_is_min {s : set α} (hd : directed_on (≥) s)
+  {m} (hm : m ∈ s) (hmin : ∀ a ∈ s, a ≤ m → m ≤ a) : ∀ a ∈ s, m ≤ a :=
+λ a as, let ⟨x, xs, xm, xa⟩ := hd m hm a as in (hmin x xs xm).trans xa
+
+lemma directed_on.is_top_of_is_max {s : set α} (hd : directed_on (≤) s)
+  {m} (hm : m ∈ s) (hmax : ∀ a ∈ s, m ≤ a → a ≤ m) : ∀ a ∈ s, a ≤ m :=
+@directed_on.is_bot_of_is_min αᵒᵈ _ s hd m hm hmax
 
-lemma is_bot_iff_is_min [is_directed α (swap (≤))] : is_bot a ↔ is_min a :=
+lemma is_top_or_exists_gt [is_directed α (≤)] (a : α) : is_top a ∨ (∃ b, a < b) :=
+(em (is_max a)).imp is_max.is_top not_is_max_iff.mp
+
+lemma is_bot_or_exists_lt [is_directed α (≥)] (a : α) : is_bot a ∨ (∃ b, b < a) :=
+@is_top_or_exists_gt αᵒᵈ _ _ a
+
+lemma is_bot_iff_is_min [is_directed α (≥)] : is_bot a ↔ is_min a :=
 ⟨is_bot.is_min, is_min.is_bot⟩
 
 lemma is_top_iff_is_max [is_directed α (≤)] : is_top a ↔ is_max a := ⟨is_top.is_max, is_max.is_top⟩
 
+variables (β) [partial_order β]
+
+theorem exists_lt_of_directed_ge [is_directed β (≥)] [nontrivial β] : ∃ a b : β, a < b :=
+begin
+  rcases exists_pair_ne β with ⟨a, b, hne⟩,
+  rcases is_bot_or_exists_lt a with ha|⟨c, hc⟩,
+  exacts [⟨a, b, (ha b).lt_of_ne hne⟩, ⟨_, _, hc⟩]
+end
+
+theorem exists_lt_of_directed_le [is_directed β (≤)] [nontrivial β] : ∃ a b : β, a < b :=
+let ⟨a, b, h⟩ := exists_lt_of_directed_ge βᵒᵈ in ⟨b, a, h⟩
+
 end preorder
 
 @[priority 100]  -- see Note [lower instance priority]
@@ -149,7 +248,7 @@ instance semilattice_sup.to_is_directed_le [semilattice_sup α] : is_directed α
 ⟨λ a b, ⟨a ⊔ b, le_sup_left, le_sup_right⟩⟩
 
 @[priority 100]  -- see Note [lower instance priority]
-instance semilattice_inf.to_is_directed_ge [semilattice_inf α] : is_directed α (swap (≤)) :=
+instance semilattice_inf.to_is_directed_ge [semilattice_inf α] : is_directed α (≥) :=
 ⟨λ a b, ⟨a ⊓ b, inf_le_left, inf_le_right⟩⟩
 
 @[priority 100]  -- see Note [lower instance priority]
@@ -157,5 +256,5 @@ instance order_top.to_is_directed_le [has_le α] [order_top α] : is_directed α
 ⟨λ a b, ⟨⊤, le_top, le_top⟩⟩
 
 @[priority 100]  -- see Note [lower instance priority]
-instance order_bot.to_is_directed_ge [has_le α] [order_bot α] : is_directed α (swap (≤)) :=
+instance order_bot.to_is_directed_ge [has_le α] [order_bot α] : is_directed α (≥) :=
 ⟨λ a b, ⟨⊥, bot_le, bot_le⟩⟩
diff --git a/src/order/disjoint.lean b/src/order/disjoint.lean
new file mode 100644
index 0000000000000..85f97b552ba44
--- /dev/null
+++ b/src/order/disjoint.lean
@@ -0,0 +1,511 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import order.bounded_order
+
+/-!
+# Disjointness and complements
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `disjoint`, `codisjoint`, and the `is_compl` predicate.
+
+## Main declarations
+
+* `disjoint x y`: two elements of a lattice are disjoint if their `inf` is the bottom element.
+* `codisjoint x y`: two elements of a lattice are codisjoint if their `join` is the top element.
+* `is_compl x y`: In a bounded lattice, predicate for "`x` is a complement of `y`". Note that in a
+  non distributive lattice, an element can have several complements.
+* `complemented_lattice α`: Typeclass stating that any element of a lattice has a complement.
+
+-/
+
+open function
+
+variable {α : Type*}
+
+section disjoint
+section partial_order_bot
+variables [partial_order α] [order_bot α] {a b c d : α}
+
+/-- Two elements of a lattice are disjoint if their inf is the bottom element.
+  (This generalizes disjoint sets, viewed as members of the subset lattice.)
+
+Note that we define this without reference to `⊓`, as this allows us to talk about orders where
+the infimum is not unique, or where implementing `has_inf` would require additional `decidable`
+arguments. -/
+def disjoint (a b : α) : Prop := ∀ ⦃x⦄, x ≤ a → x ≤ b → x ≤ ⊥
+
+lemma disjoint.comm : disjoint a b ↔ disjoint b a := forall_congr $ λ _, forall_swap
+@[symm] lemma disjoint.symm ⦃a b : α⦄ : disjoint a b → disjoint b a := disjoint.comm.1
+lemma symmetric_disjoint : symmetric (disjoint : α → α → Prop) := disjoint.symm
+
+@[simp] lemma disjoint_bot_left : disjoint ⊥ a := λ x hbot ha, hbot
+@[simp] lemma disjoint_bot_right : disjoint a ⊥ := λ x ha hbot, hbot
+
+lemma disjoint.mono (h₁ : a ≤ b) (h₂ : c ≤ d) : disjoint b d → disjoint a c :=
+λ h x ha hc, h (ha.trans h₁) (hc.trans h₂)
+
+lemma disjoint.mono_left (h : a ≤ b) : disjoint b c → disjoint a c := disjoint.mono h le_rfl
+lemma disjoint.mono_right : b ≤ c → disjoint a c → disjoint a b := disjoint.mono le_rfl
+
+@[simp] lemma disjoint_self : disjoint a a ↔ a = ⊥ :=
+⟨λ hd, bot_unique $ hd le_rfl le_rfl, λ h x ha hb, ha.trans_eq h⟩
+
+/- TODO: Rename `disjoint.eq_bot` to `disjoint.inf_eq` and `disjoint.eq_bot_of_self` to
+`disjoint.eq_bot` -/
+alias disjoint_self ↔ disjoint.eq_bot_of_self _
+
+lemma disjoint.ne (ha : a ≠ ⊥) (hab : disjoint a b) : a ≠ b :=
+λ h, ha $ disjoint_self.1 $ by rwa ←h at hab
+
+lemma disjoint.eq_bot_of_le (hab : disjoint a b) (h : a ≤ b) : a = ⊥ :=
+eq_bot_iff.2 $ hab le_rfl h
+
+lemma disjoint.eq_bot_of_ge (hab : disjoint a b) : b ≤ a → b = ⊥ := hab.symm.eq_bot_of_le
+
+end partial_order_bot
+
+section partial_bounded_order
+variables [partial_order α] [bounded_order α] {a : α}
+
+@[simp] theorem disjoint_top : disjoint a ⊤ ↔ a = ⊥ :=
+⟨λ h, bot_unique $ h le_rfl le_top, λ h x ha htop, ha.trans_eq h⟩
+
+@[simp] theorem top_disjoint : disjoint ⊤ a ↔ a = ⊥ :=
+⟨λ h, bot_unique $ h le_top le_rfl, λ h x htop ha, ha.trans_eq h⟩
+
+end partial_bounded_order
+
+section semilattice_inf_bot
+variables [semilattice_inf α] [order_bot α] {a b c d : α}
+
+lemma disjoint_iff_inf_le : disjoint a b ↔ a ⊓ b ≤ ⊥ :=
+⟨λ hd, hd inf_le_left inf_le_right, λ h x ha hb, (le_inf ha hb).trans h⟩
+lemma disjoint_iff : disjoint a b ↔ a ⊓ b = ⊥ := disjoint_iff_inf_le.trans le_bot_iff
+lemma disjoint.le_bot : disjoint a b → a ⊓ b ≤ ⊥ := disjoint_iff_inf_le.mp
+lemma disjoint.eq_bot : disjoint a b → a ⊓ b = ⊥ := bot_unique ∘ disjoint.le_bot
+lemma disjoint_assoc : disjoint (a ⊓ b) c ↔ disjoint a (b ⊓ c) :=
+by rw [disjoint_iff_inf_le, disjoint_iff_inf_le, inf_assoc]
+lemma disjoint_left_comm : disjoint a (b ⊓ c) ↔ disjoint b (a ⊓ c) :=
+by simp_rw [disjoint_iff_inf_le, inf_left_comm]
+lemma disjoint_right_comm : disjoint (a ⊓ b) c ↔ disjoint (a ⊓ c) b :=
+by simp_rw [disjoint_iff_inf_le, inf_right_comm]
+
+variables (c)
+
+lemma disjoint.inf_left (h : disjoint a b) : disjoint (a ⊓ c) b := h.mono_left inf_le_left
+lemma disjoint.inf_left' (h : disjoint a b) : disjoint (c ⊓ a) b := h.mono_left inf_le_right
+lemma disjoint.inf_right (h : disjoint a b) : disjoint a (b ⊓ c) := h.mono_right inf_le_left
+lemma disjoint.inf_right' (h : disjoint a b) : disjoint a (c ⊓ b) := h.mono_right inf_le_right
+
+variables {c}
+
+lemma disjoint.of_disjoint_inf_of_le (h : disjoint (a ⊓ b) c) (hle : a ≤ c) : disjoint a b :=
+disjoint_iff.2 $ h.eq_bot_of_le $ inf_le_of_left_le hle
+
+lemma disjoint.of_disjoint_inf_of_le' (h : disjoint (a ⊓ b) c) (hle : b ≤ c) : disjoint a b :=
+disjoint_iff.2 $ h.eq_bot_of_le $ inf_le_of_right_le hle
+
+end semilattice_inf_bot
+
+section distrib_lattice_bot
+variables [distrib_lattice α] [order_bot α] {a b c : α}
+
+@[simp] lemma disjoint_sup_left : disjoint (a ⊔ b) c ↔ disjoint a c ∧ disjoint b c :=
+by simp only [disjoint_iff, inf_sup_right, sup_eq_bot_iff]
+
+@[simp] lemma disjoint_sup_right : disjoint a (b ⊔ c) ↔ disjoint a b ∧ disjoint a c :=
+by simp only [disjoint_iff, inf_sup_left, sup_eq_bot_iff]
+
+lemma disjoint.sup_left (ha : disjoint a c) (hb : disjoint b c) : disjoint (a ⊔ b) c :=
+disjoint_sup_left.2 ⟨ha, hb⟩
+
+lemma disjoint.sup_right (hb : disjoint a b) (hc : disjoint a c) : disjoint a (b ⊔ c) :=
+disjoint_sup_right.2 ⟨hb, hc⟩
+
+lemma disjoint.left_le_of_le_sup_right (h : a ≤ b ⊔ c) (hd : disjoint a c) : a ≤ b :=
+le_of_inf_le_sup_le (le_trans hd.le_bot bot_le) $ sup_le h le_sup_right
+
+lemma disjoint.left_le_of_le_sup_left (h : a ≤ c ⊔ b) (hd : disjoint a c) : a ≤ b :=
+hd.left_le_of_le_sup_right $ by rwa sup_comm
+
+end distrib_lattice_bot
+end disjoint
+
+section codisjoint
+section partial_order_top
+variables [partial_order α] [order_top α] {a b c d : α}
+
+/-- Two elements of a lattice are codisjoint if their sup is the top element.
+
+Note that we define this without reference to `⊔`, as this allows us to talk about orders where
+the supremum is not unique, or where implement `has_sup` would require additional `decidable`
+arguments. -/
+def codisjoint (a b : α) : Prop := ∀ ⦃x⦄, a ≤ x → b ≤ x → ⊤ ≤ x
+
+lemma codisjoint.comm : codisjoint a b ↔ codisjoint b a := forall_congr $ λ _, forall_swap
+@[symm] lemma codisjoint.symm ⦃a b : α⦄ : codisjoint a b → codisjoint b a := codisjoint.comm.1
+lemma symmetric_codisjoint : symmetric (codisjoint : α → α → Prop) := codisjoint.symm
+
+@[simp] lemma codisjoint_top_left : codisjoint ⊤ a := λ x htop ha, htop
+@[simp] lemma codisjoint_top_right : codisjoint a ⊤ := λ x ha htop, htop
+
+lemma codisjoint.mono (h₁ : a ≤ b) (h₂ : c ≤ d) : codisjoint a c → codisjoint b d :=
+λ h x ha hc, h (h₁.trans ha) (h₂.trans hc)
+
+lemma codisjoint.mono_left (h : a ≤ b) : codisjoint a c → codisjoint b c :=
+codisjoint.mono h le_rfl
+lemma codisjoint.mono_right : b ≤ c → codisjoint a b → codisjoint a c :=
+codisjoint.mono le_rfl
+
+@[simp] lemma codisjoint_self : codisjoint a a ↔ a = ⊤ :=
+⟨λ hd, top_unique $ hd le_rfl le_rfl, λ h x ha hb, h.symm.trans_le ha⟩
+
+/- TODO: Rename `codisjoint.eq_top` to `codisjoint.sup_eq` and `codisjoint.eq_top_of_self` to
+`codisjoint.eq_top` -/
+alias codisjoint_self ↔ codisjoint.eq_top_of_self _
+
+lemma codisjoint.ne (ha : a ≠ ⊤) (hab : codisjoint a b) : a ≠ b :=
+λ h, ha $ codisjoint_self.1 $ by rwa ←h at hab
+
+lemma codisjoint.eq_top_of_le (hab : codisjoint a b) (h : b ≤ a) : a = ⊤ :=
+eq_top_iff.2 $ hab le_rfl h
+
+lemma codisjoint.eq_top_of_ge (hab : codisjoint a b) : a ≤ b → b = ⊤ := hab.symm.eq_top_of_le
+
+end partial_order_top
+
+section partial_bounded_order
+variables [partial_order α] [bounded_order α] {a : α}
+
+@[simp] theorem codisjoint_bot : codisjoint a ⊥ ↔ a = ⊤ :=
+⟨λ h, top_unique $ h le_rfl bot_le, λ h x ha htop, h.symm.trans_le ha⟩
+
+@[simp] theorem bot_codisjoint : codisjoint ⊥ a ↔ a = ⊤ :=
+⟨λ h, top_unique $ h bot_le le_rfl, λ h x htop ha, h.symm.trans_le ha⟩
+
+end partial_bounded_order
+
+section semilattice_sup_top
+variables [semilattice_sup α] [order_top α] {a b c d : α}
+
+lemma codisjoint_iff_le_sup : codisjoint a b ↔ ⊤ ≤ a ⊔ b := @disjoint_iff_inf_le αᵒᵈ _ _ _ _
+lemma codisjoint_iff : codisjoint a b ↔ a ⊔ b = ⊤ := @disjoint_iff αᵒᵈ _ _ _ _
+lemma codisjoint.top_le : codisjoint a b → ⊤ ≤ a ⊔ b := @disjoint.le_bot αᵒᵈ _ _ _ _
+lemma codisjoint.eq_top : codisjoint a b → a ⊔ b = ⊤ := @disjoint.eq_bot αᵒᵈ _ _ _ _
+lemma codisjoint_assoc : codisjoint (a ⊔ b) c ↔ codisjoint a (b ⊔ c) :=
+@disjoint_assoc αᵒᵈ _ _ _ _ _
+lemma codisjoint_left_comm : codisjoint a (b ⊔ c) ↔ codisjoint b (a ⊔ c) :=
+@disjoint_left_comm αᵒᵈ _ _ _ _ _
+lemma codisjoint_right_comm : codisjoint (a ⊔ b) c ↔ codisjoint (a ⊔ c) b :=
+@disjoint_right_comm αᵒᵈ _ _ _ _ _
+
+variables (c)
+
+lemma codisjoint.sup_left (h : codisjoint a b) : codisjoint (a ⊔ c) b := h.mono_left le_sup_left
+lemma codisjoint.sup_left' (h : codisjoint a b) : codisjoint (c ⊔ a) b := h.mono_left le_sup_right
+lemma codisjoint.sup_right (h : codisjoint a b) : codisjoint a (b ⊔ c) := h.mono_right le_sup_left
+lemma codisjoint.sup_right' (h : codisjoint a b) : codisjoint a (c ⊔ b) := h.mono_right le_sup_right
+
+variables {c}
+
+lemma codisjoint.of_codisjoint_sup_of_le (h : codisjoint (a ⊔ b) c) (hle : c ≤ a) :
+  codisjoint a b :=
+@disjoint.of_disjoint_inf_of_le αᵒᵈ _ _ _ _ _ h hle
+
+lemma codisjoint.of_codisjoint_sup_of_le' (h : codisjoint (a ⊔ b) c) (hle : c ≤ b) :
+  codisjoint a b :=
+@disjoint.of_disjoint_inf_of_le' αᵒᵈ _ _ _ _ _ h hle
+
+end semilattice_sup_top
+
+section distrib_lattice_top
+variables [distrib_lattice α] [order_top α] {a b c : α}
+
+@[simp] lemma codisjoint_inf_left : codisjoint (a ⊓ b) c ↔ codisjoint a c ∧ codisjoint b c :=
+by simp only [codisjoint_iff, sup_inf_right, inf_eq_top_iff]
+
+@[simp] lemma codisjoint_inf_right : codisjoint a (b ⊓ c) ↔ codisjoint a b ∧ codisjoint a c :=
+by simp only [codisjoint_iff, sup_inf_left, inf_eq_top_iff]
+
+lemma codisjoint.inf_left (ha : codisjoint a c) (hb : codisjoint b c) : codisjoint (a ⊓ b) c :=
+codisjoint_inf_left.2 ⟨ha, hb⟩
+
+lemma codisjoint.inf_right (hb : codisjoint a b) (hc : codisjoint a c) : codisjoint a (b ⊓ c) :=
+codisjoint_inf_right.2 ⟨hb, hc⟩
+
+lemma codisjoint.left_le_of_le_inf_right (h : a ⊓ b ≤ c) (hd : codisjoint b c) : a ≤ c :=
+@disjoint.left_le_of_le_sup_right αᵒᵈ _ _ _ _ _ h hd.symm
+
+lemma codisjoint.left_le_of_le_inf_left (h : b ⊓ a ≤ c) (hd : codisjoint b c) : a ≤ c :=
+hd.left_le_of_le_inf_right $ by rwa inf_comm
+
+end distrib_lattice_top
+end codisjoint
+
+open order_dual
+
+lemma disjoint.dual [semilattice_inf α] [order_bot α] {a b : α} :
+  disjoint a b → codisjoint (to_dual a) (to_dual b) := id
+
+lemma codisjoint.dual [semilattice_sup α] [order_top α] {a b : α} :
+  codisjoint a b → disjoint (to_dual a) (to_dual b) := id
+
+@[simp] lemma disjoint_to_dual_iff [semilattice_sup α] [order_top α] {a b : α} :
+  disjoint (to_dual a) (to_dual b) ↔ codisjoint a b := iff.rfl
+@[simp] lemma disjoint_of_dual_iff [semilattice_inf α] [order_bot α] {a b : αᵒᵈ} :
+  disjoint (of_dual a) (of_dual b) ↔ codisjoint a b := iff.rfl
+@[simp] lemma codisjoint_to_dual_iff [semilattice_inf α] [order_bot α] {a b : α} :
+  codisjoint (to_dual a) (to_dual b) ↔ disjoint a b := iff.rfl
+@[simp] lemma codisjoint_of_dual_iff [semilattice_sup α] [order_top α] {a b : αᵒᵈ} :
+  codisjoint (of_dual a) (of_dual b) ↔ disjoint a b := iff.rfl
+
+section distrib_lattice
+variables [distrib_lattice α] [bounded_order α] {a b c : α}
+
+lemma disjoint.le_of_codisjoint (hab : disjoint a b) (hbc : codisjoint b c) : a ≤ c :=
+begin
+  rw [←@inf_top_eq _ _ _ a, ←@bot_sup_eq _ _ _ c, ←hab.eq_bot, ←hbc.eq_top, sup_inf_right],
+  exact inf_le_inf_right _ le_sup_left,
+end
+
+end distrib_lattice
+
+section is_compl
+
+/-- Two elements `x` and `y` are complements of each other if `x ⊔ y = ⊤` and `x ⊓ y = ⊥`. -/
+@[protect_proj] structure is_compl [partial_order α] [bounded_order α] (x y : α) : Prop :=
+(disjoint : disjoint x y)
+(codisjoint : codisjoint x y)
+
+lemma is_compl_iff [partial_order α] [bounded_order α] {a b : α} :
+  is_compl a b ↔ disjoint a b ∧ codisjoint a b := ⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩
+
+namespace is_compl
+
+section bounded_partial_order
+variables [partial_order α] [bounded_order α] {x y z : α}
+
+@[symm] protected lemma symm (h : is_compl x y) : is_compl y x := ⟨h.1.symm, h.2.symm⟩
+
+lemma dual (h : is_compl x y) : is_compl (to_dual x) (to_dual y) := ⟨h.2, h.1⟩
+lemma of_dual {a b : αᵒᵈ} (h : is_compl a b) : is_compl (of_dual a) (of_dual b) := ⟨h.2, h.1⟩
+
+end bounded_partial_order
+
+section bounded_lattice
+variables [lattice α] [bounded_order α] {x y z : α}
+
+lemma of_le (h₁ : x ⊓ y ≤ ⊥) (h₂ : ⊤ ≤ x ⊔ y) : is_compl x y :=
+⟨disjoint_iff_inf_le.mpr h₁, codisjoint_iff_le_sup.mpr h₂⟩
+
+lemma of_eq (h₁ : x ⊓ y = ⊥) (h₂ : x ⊔ y = ⊤) : is_compl x y :=
+⟨disjoint_iff.mpr h₁, codisjoint_iff.mpr h₂⟩
+
+lemma inf_eq_bot (h : is_compl x y) : x ⊓ y = ⊥ := h.disjoint.eq_bot
+lemma sup_eq_top (h : is_compl x y) : x ⊔ y = ⊤ := h.codisjoint.eq_top
+
+end bounded_lattice
+
+variables [distrib_lattice α] [bounded_order α] {a b x y z : α}
+
+lemma inf_left_le_of_le_sup_right (h : is_compl x y) (hle : a ≤ b ⊔ y) : a ⊓ x ≤ b :=
+calc a ⊓ x ≤ (b ⊔ y) ⊓ x : inf_le_inf hle le_rfl
+... = (b ⊓ x) ⊔ (y ⊓ x) : inf_sup_right
+... = b ⊓ x : by rw [h.symm.inf_eq_bot, sup_bot_eq]
+... ≤ b : inf_le_left
+
+lemma le_sup_right_iff_inf_left_le {a b} (h : is_compl x y) : a ≤ b ⊔ y ↔ a ⊓ x ≤ b :=
+⟨h.inf_left_le_of_le_sup_right, h.symm.dual.inf_left_le_of_le_sup_right⟩
+
+lemma inf_left_eq_bot_iff (h : is_compl y z) : x ⊓ y = ⊥ ↔ x ≤ z :=
+by rw [← le_bot_iff, ← h.le_sup_right_iff_inf_left_le, bot_sup_eq]
+
+lemma inf_right_eq_bot_iff (h : is_compl y z) : x ⊓ z = ⊥ ↔ x ≤ y :=
+h.symm.inf_left_eq_bot_iff
+
+lemma disjoint_left_iff (h : is_compl y z) : disjoint x y ↔ x ≤ z :=
+by { rw disjoint_iff, exact h.inf_left_eq_bot_iff }
+
+lemma disjoint_right_iff (h : is_compl y z) : disjoint x z ↔ x ≤ y :=
+h.symm.disjoint_left_iff
+
+lemma le_left_iff (h : is_compl x y) : z ≤ x ↔ disjoint z y :=
+h.disjoint_right_iff.symm
+
+lemma le_right_iff (h : is_compl x y) : z ≤ y ↔ disjoint z x :=
+h.symm.le_left_iff
+
+lemma left_le_iff (h : is_compl x y) : x ≤ z ↔ codisjoint z y := h.dual.le_left_iff
+
+lemma right_le_iff (h : is_compl x y) : y ≤ z ↔ codisjoint z x := h.symm.left_le_iff
+
+protected lemma antitone {x' y'} (h : is_compl x y) (h' : is_compl x' y') (hx : x ≤ x') :
+  y' ≤ y :=
+h'.right_le_iff.2 $ h.symm.codisjoint.mono_right hx
+
+lemma right_unique (hxy : is_compl x y) (hxz : is_compl x z) :
+  y = z :=
+le_antisymm (hxz.antitone hxy $ le_refl x) (hxy.antitone hxz $ le_refl x)
+
+lemma left_unique (hxz : is_compl x z) (hyz : is_compl y z) :
+  x = y :=
+hxz.symm.right_unique hyz.symm
+
+lemma sup_inf {x' y'} (h : is_compl x y) (h' : is_compl x' y') :
+  is_compl (x ⊔ x') (y ⊓ y') :=
+of_eq
+  (by rw [inf_sup_right, ← inf_assoc, h.inf_eq_bot, bot_inf_eq, bot_sup_eq, inf_left_comm,
+    h'.inf_eq_bot, inf_bot_eq])
+  (by rw [sup_inf_left, @sup_comm _ _ x, sup_assoc, h.sup_eq_top, sup_top_eq, top_inf_eq,
+    sup_assoc, sup_left_comm, h'.sup_eq_top, sup_top_eq])
+
+lemma inf_sup {x' y'} (h : is_compl x y) (h' : is_compl x' y') :
+  is_compl (x ⊓ x') (y ⊔ y') :=
+(h.symm.sup_inf h'.symm).symm
+
+end is_compl
+
+namespace prod
+variables {β : Type*} [partial_order α] [partial_order β]
+
+protected lemma disjoint_iff [order_bot α] [order_bot β] {x y : α × β} :
+  disjoint x y ↔ disjoint x.1 y.1 ∧ disjoint x.2 y.2 :=
+begin
+  split,
+  { intros h,
+    refine ⟨λ a hx hy, (@h (a, ⊥) ⟨hx, _⟩ ⟨hy, _⟩).1, λ b hx hy, (@h (⊥, b) ⟨_, hx⟩ ⟨_, hy⟩).2⟩,
+    all_goals { exact bot_le }, },
+  { rintros ⟨ha, hb⟩ z hza hzb,
+    refine ⟨ha hza.1 hzb.1, hb hza.2 hzb.2⟩ },
+end
+
+protected lemma codisjoint_iff [order_top α] [order_top β] {x y : α × β} :
+  codisjoint x y ↔ codisjoint x.1 y.1 ∧ codisjoint x.2 y.2 :=
+@prod.disjoint_iff αᵒᵈ βᵒᵈ _ _ _ _ _ _
+
+protected lemma is_compl_iff [bounded_order α] [bounded_order β]
+  {x y : α × β} :
+  is_compl x y ↔ is_compl x.1 y.1 ∧ is_compl x.2 y.2 :=
+by simp_rw [is_compl_iff, prod.disjoint_iff, prod.codisjoint_iff, and_and_and_comm]
+
+end prod
+
+section
+variables [lattice α] [bounded_order α] {a b x : α}
+
+@[simp] lemma is_compl_to_dual_iff : is_compl (to_dual a) (to_dual b) ↔ is_compl a b :=
+⟨is_compl.of_dual, is_compl.dual⟩
+
+@[simp] lemma is_compl_of_dual_iff {a b : αᵒᵈ} : is_compl (of_dual a) (of_dual b) ↔ is_compl a b :=
+⟨is_compl.dual, is_compl.of_dual⟩
+
+lemma is_compl_bot_top : is_compl (⊥ : α) ⊤ := is_compl.of_eq bot_inf_eq sup_top_eq
+lemma is_compl_top_bot : is_compl (⊤ : α) ⊥ := is_compl.of_eq inf_bot_eq top_sup_eq
+
+lemma eq_top_of_is_compl_bot (h : is_compl x ⊥) : x = ⊤ := sup_bot_eq.symm.trans h.sup_eq_top
+lemma eq_top_of_bot_is_compl (h : is_compl ⊥ x) : x = ⊤ := eq_top_of_is_compl_bot h.symm
+lemma eq_bot_of_is_compl_top (h : is_compl x ⊤) : x = ⊥ := eq_top_of_is_compl_bot h.dual
+lemma eq_bot_of_top_is_compl (h : is_compl ⊤ x) : x = ⊥ := eq_top_of_bot_is_compl h.dual
+
+end
+
+section is_complemented
+section lattice
+variables [lattice α] [bounded_order α]
+
+/-- An element is *complemented* if it has a complement. -/
+def is_complemented (a : α) : Prop := ∃ b, is_compl a b
+
+lemma is_complemented_bot : is_complemented (⊥ : α) := ⟨⊤, is_compl_bot_top⟩
+lemma is_complemented_top : is_complemented (⊤ : α) := ⟨⊥, is_compl_top_bot⟩
+
+end lattice
+
+variables [distrib_lattice α] [bounded_order α] {a b : α}
+
+lemma is_complemented.sup : is_complemented a → is_complemented b → is_complemented (a ⊔ b) :=
+λ ⟨a', ha⟩ ⟨b', hb⟩, ⟨a' ⊓ b', ha.sup_inf hb⟩
+
+lemma is_complemented.inf : is_complemented a → is_complemented b → is_complemented (a ⊓ b) :=
+λ ⟨a', ha⟩ ⟨b', hb⟩, ⟨a' ⊔ b', ha.inf_sup hb⟩
+
+end is_complemented
+
+/-- A complemented bounded lattice is one where every element has a (not necessarily unique)
+complement. -/
+class complemented_lattice (α) [lattice α] [bounded_order α] : Prop :=
+(exists_is_compl : ∀ a : α, is_complemented a)
+
+export complemented_lattice (exists_is_compl)
+
+namespace complemented_lattice
+variables [lattice α] [bounded_order α] [complemented_lattice α]
+
+instance : complemented_lattice αᵒᵈ :=
+⟨λ a, let ⟨b, hb⟩ := exists_is_compl (show α, from a) in ⟨b, hb.dual⟩⟩
+
+end complemented_lattice
+
+-- TODO: Define as a sublattice?
+/-- The sublattice of complemented elements. -/
+@[reducible, derive partial_order]
+def complementeds (α : Type*) [lattice α] [bounded_order α] : Type* := {a : α // is_complemented a}
+
+namespace complementeds
+section lattice
+variables [lattice α] [bounded_order α] {a b : complementeds α}
+
+instance has_coe_t : has_coe_t (complementeds α) α := ⟨subtype.val⟩
+
+lemma coe_injective : injective (coe : complementeds α → α) := subtype.coe_injective
+
+@[simp, norm_cast] lemma coe_inj : (a : α) = b ↔ a = b := subtype.coe_inj
+@[simp, norm_cast] lemma coe_le_coe : (a : α) ≤ b ↔ a ≤ b := by simp
+@[simp, norm_cast] lemma coe_lt_coe : (a : α) < b ↔ a < b := iff.rfl
+
+instance : bounded_order (complementeds α) :=
+subtype.bounded_order is_complemented_bot is_complemented_top
+
+@[simp, norm_cast] lemma coe_bot : ((⊥ : complementeds α) : α) = ⊥ := rfl
+@[simp, norm_cast] lemma coe_top : ((⊤ : complementeds α) : α) = ⊤ := rfl
+@[simp] lemma mk_bot : (⟨⊥, is_complemented_bot⟩ : complementeds α) = ⊥ := rfl
+@[simp] lemma mk_top : (⟨⊤, is_complemented_top⟩ : complementeds α) = ⊤ := rfl
+
+instance : inhabited (complementeds α) := ⟨⊥⟩
+
+end lattice
+
+variables [distrib_lattice α] [bounded_order α] {a b : complementeds α}
+
+instance : has_sup (complementeds α) := ⟨λ a b, ⟨a ⊔ b, a.2.sup b.2⟩⟩
+instance : has_inf (complementeds α) := ⟨λ a b, ⟨a ⊓ b, a.2.inf b.2⟩⟩
+
+@[simp, norm_cast] lemma coe_sup (a b : complementeds α) : (↑(a ⊔ b) : α) = a ⊔ b := rfl
+@[simp, norm_cast] lemma coe_inf (a b : complementeds α) : (↑(a ⊓ b) : α) = a ⊓ b := rfl
+@[simp] lemma mk_sup_mk {a b : α} (ha : is_complemented a) (hb : is_complemented b) :
+  (⟨a, ha⟩ ⊔ ⟨b, hb⟩ : complementeds α) = ⟨a ⊔ b, ha.sup hb⟩ := rfl
+@[simp] lemma mk_inf_mk {a b : α} (ha : is_complemented a) (hb : is_complemented b) :
+  (⟨a, ha⟩ ⊓ ⟨b, hb⟩ : complementeds α) = ⟨a ⊓ b, ha.inf hb⟩ := rfl
+
+instance : distrib_lattice (complementeds α) :=
+complementeds.coe_injective.distrib_lattice _ coe_sup coe_inf
+
+@[simp, norm_cast] lemma disjoint_coe : disjoint (a : α) b ↔ disjoint a b :=
+by rw [disjoint_iff, disjoint_iff, ←coe_inf, ←coe_bot, coe_inj]
+
+@[simp, norm_cast] lemma codisjoint_coe : codisjoint (a : α) b ↔ codisjoint a b :=
+by rw [codisjoint_iff, codisjoint_iff, ←coe_sup, ←coe_top, coe_inj]
+
+@[simp, norm_cast] lemma is_compl_coe : is_compl (a : α) b ↔ is_compl a b :=
+by simp_rw [is_compl_iff, disjoint_coe, codisjoint_coe]
+
+instance : complemented_lattice (complementeds α) :=
+⟨λ ⟨a, b, h⟩, ⟨⟨b, a, h.symm⟩, is_compl_coe.1 h⟩⟩
+
+end complementeds
+end is_compl
diff --git a/src/order/disjointed.lean b/src/order/disjointed.lean
index 3f3bb366d6799..ebb4a8605efd9 100644
--- a/src/order/disjointed.lean
+++ b/src/order/disjointed.lean
@@ -8,6 +8,9 @@ import order.partial_sups
 /-!
 # Consecutive differences of sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the way to make a sequence of elements into a sequence of disjoint elements with
 the same partial sups.
 
@@ -121,9 +124,9 @@ begin
   { exact h n le_rfl },
   rintro m hm,
   induction m with m ih,
-  { exact hdisj _ _ (nat.succ_ne_zero _).symm },
+  { exact hdisj (nat.succ_ne_zero _).symm },
   rw [partial_sups_succ, disjoint_iff, inf_sup_right, sup_eq_bot_iff, ←disjoint_iff, ←disjoint_iff],
-  exact ⟨ih (nat.le_of_succ_le hm), hdisj _ _ (nat.lt_succ_of_le hm).ne⟩,
+  exact ⟨ih (nat.le_of_succ_le hm), hdisj (nat.lt_succ_of_le hm).ne⟩,
 end
 
 end generalized_boolean_algebra
diff --git a/src/order/extension.lean b/src/order/extension.lean
deleted file mode 100644
index 9afe1bf697dff..0000000000000
--- a/src/order/extension.lean
+++ /dev/null
@@ -1,89 +0,0 @@
-/-
-Copyright (c) 2021 Bhavik Mehta. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Bhavik Mehta
--/
-import data.set.lattice
-import order.zorn
-import tactic.by_contra
-
-/-!
-# Extend a partial order to a linear order
-
-This file constructs a linear order which is an extension of the given partial order, using Zorn's
-lemma.
--/
-
-universes u
-open set classical
-open_locale classical
-
-/--
-Any partial order can be extended to a linear order.
--/
-theorem extend_partial_order {α : Type u} (r : α → α → Prop) [is_partial_order α r] :
-  ∃ (s : α → α → Prop) (_ : is_linear_order α s), r ≤ s :=
-begin
-  let S := {s | is_partial_order α s},
-  have hS : ∀ c, c ⊆ S → is_chain (≤) c → ∀ y ∈ c, (∃ ub ∈ S, ∀ z ∈ c, z ≤ ub),
-  { rintro c hc₁ hc₂ s hs,
-    haveI := (hc₁ hs).1,
-    refine ⟨Sup c, _, λ z hz, le_Sup hz⟩,
-    refine { refl := _, trans := _, antisymm := _ }; simp_rw binary_relation_Sup_iff,
-    { intro x,
-      exact ⟨s, hs, refl x⟩ },
-    { rintro x y z ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
-      haveI : is_partial_order _ _ := hc₁ h₁s₁,
-      haveI : is_partial_order _ _ := hc₁ h₁s₂,
-      cases hc₂.total h₁s₁ h₁s₂,
-      { exact ⟨s₂, h₁s₂, trans (h _ _ h₂s₁) h₂s₂⟩ },
-      { exact ⟨s₁, h₁s₁, trans h₂s₁ (h _ _ h₂s₂)⟩ } },
-    { rintro x y ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
-      haveI : is_partial_order _ _ := hc₁ h₁s₁,
-      haveI : is_partial_order _ _ := hc₁ h₁s₂,
-      cases hc₂.total h₁s₁ h₁s₂,
-      { exact antisymm (h _ _ h₂s₁) h₂s₂ },
-      { apply antisymm h₂s₁ (h _ _ h₂s₂) } } },
-  obtain ⟨s, hs₁ : is_partial_order _ _, rs, hs₂⟩ := zorn_nonempty_partial_order₀ S hS r ‹_›,
-  resetI,
-  refine ⟨s, { total := _ }, rs⟩,
-  intros x y,
-  by_contra' h,
-  let s' := λ x' y', s x' y' ∨ s x' x ∧ s y y',
-  rw ←hs₂ s' _ (λ _ _, or.inl) at h,
-  { apply h.1 (or.inr ⟨refl _, refl _⟩) },
-  { refine
-      { refl := λ x, or.inl (refl _),
-        trans := _,
-        antisymm := _ },
-    { rintro a b c (ab | ⟨ax : s a x, yb : s y b⟩) (bc | ⟨bx : s b x, yc : s y c⟩),
-      { exact or.inl (trans ab bc), },
-      { exact or.inr ⟨trans ab bx, yc⟩ },
-      { exact or.inr ⟨ax, trans yb bc⟩ },
-      { exact or.inr ⟨ax, yc⟩ } },
-    { rintro a b (ab | ⟨ax : s a x, yb : s y b⟩) (ba | ⟨bx : s b x, ya : s y a⟩),
-      { exact antisymm ab ba },
-      { exact (h.2 (trans ya (trans ab bx))).elim },
-      { exact (h.2 (trans yb (trans ba ax))).elim },
-      { exact (h.2 (trans yb bx)).elim } } },
-end
-
-/-- A type alias for `α`, intended to extend a partial order on `α` to a linear order. -/
-def linear_extension (α : Type u) : Type u := α
-
-noncomputable instance {α : Type u} [partial_order α] : linear_order (linear_extension α) :=
-{ le := (extend_partial_order ((≤) : α → α → Prop)).some,
-  le_refl := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.1.1,
-  le_trans := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.2.1,
-  le_antisymm := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.2.1,
-  le_total := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.2.1,
-  decidable_le := classical.dec_rel _ }
-
-/-- The embedding of `α` into `linear_extension α` as a relation homomorphism. -/
-def to_linear_extension {α : Type u} [partial_order α] :
-  ((≤) : α → α → Prop) →r ((≤) : linear_extension α → linear_extension α → Prop) :=
-{ to_fun := λ x, x,
-  map_rel' := λ a b, (extend_partial_order ((≤) : α → α → Prop)).some_spec.some_spec _ _ }
-
-instance {α : Type u} [inhabited α] : inhabited (linear_extension α) :=
-⟨(default : α)⟩
diff --git a/src/order/extension/linear.lean b/src/order/extension/linear.lean
new file mode 100644
index 0000000000000..cdfb97de16c56
--- /dev/null
+++ b/src/order/extension/linear.lean
@@ -0,0 +1,91 @@
+/-
+Copyright (c) 2021 Bhavik Mehta. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Bhavik Mehta
+-/
+import order.zorn
+import tactic.by_contra
+
+/-!
+# Extend a partial order to a linear order
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file constructs a linear order which is an extension of the given partial order, using Zorn's
+lemma.
+-/
+
+universes u
+open set classical
+open_locale classical
+
+/--
+Any partial order can be extended to a linear order.
+-/
+theorem extend_partial_order {α : Type u} (r : α → α → Prop) [is_partial_order α r] :
+  ∃ (s : α → α → Prop) (_ : is_linear_order α s), r ≤ s :=
+begin
+  let S := {s | is_partial_order α s},
+  have hS : ∀ c, c ⊆ S → is_chain (≤) c → ∀ y ∈ c, (∃ ub ∈ S, ∀ z ∈ c, z ≤ ub),
+  { rintro c hc₁ hc₂ s hs,
+    haveI := (hc₁ hs).1,
+    refine ⟨Sup c, _, λ z hz, le_Sup hz⟩,
+    refine { refl := _, trans := _, antisymm := _ }; simp_rw binary_relation_Sup_iff,
+    { intro x,
+      exact ⟨s, hs, refl x⟩ },
+    { rintro x y z ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
+      haveI : is_partial_order _ _ := hc₁ h₁s₁,
+      haveI : is_partial_order _ _ := hc₁ h₁s₂,
+      cases hc₂.total h₁s₁ h₁s₂,
+      { exact ⟨s₂, h₁s₂, trans (h _ _ h₂s₁) h₂s₂⟩ },
+      { exact ⟨s₁, h₁s₁, trans h₂s₁ (h _ _ h₂s₂)⟩ } },
+    { rintro x y ⟨s₁, h₁s₁, h₂s₁⟩ ⟨s₂, h₁s₂, h₂s₂⟩,
+      haveI : is_partial_order _ _ := hc₁ h₁s₁,
+      haveI : is_partial_order _ _ := hc₁ h₁s₂,
+      cases hc₂.total h₁s₁ h₁s₂,
+      { exact antisymm (h _ _ h₂s₁) h₂s₂ },
+      { apply antisymm h₂s₁ (h _ _ h₂s₂) } } },
+  obtain ⟨s, hs₁ : is_partial_order _ _, rs, hs₂⟩ := zorn_nonempty_partial_order₀ S hS r ‹_›,
+  resetI,
+  refine ⟨s, { total := _ }, rs⟩,
+  intros x y,
+  by_contra' h,
+  let s' := λ x' y', s x' y' ∨ s x' x ∧ s y y',
+  rw ←hs₂ s' _ (λ _ _, or.inl) at h,
+  { apply h.1 (or.inr ⟨refl _, refl _⟩) },
+  { refine
+      { refl := λ x, or.inl (refl _),
+        trans := _,
+        antisymm := _ },
+    { rintro a b c (ab | ⟨ax : s a x, yb : s y b⟩) (bc | ⟨bx : s b x, yc : s y c⟩),
+      { exact or.inl (trans ab bc), },
+      { exact or.inr ⟨trans ab bx, yc⟩ },
+      { exact or.inr ⟨ax, trans yb bc⟩ },
+      { exact or.inr ⟨ax, yc⟩ } },
+    { rintro a b (ab | ⟨ax : s a x, yb : s y b⟩) (ba | ⟨bx : s b x, ya : s y a⟩),
+      { exact antisymm ab ba },
+      { exact (h.2 (trans ya (trans ab bx))).elim },
+      { exact (h.2 (trans yb (trans ba ax))).elim },
+      { exact (h.2 (trans yb bx)).elim } } },
+end
+
+/-- A type alias for `α`, intended to extend a partial order on `α` to a linear order. -/
+def linear_extension (α : Type u) : Type u := α
+
+noncomputable instance {α : Type u} [partial_order α] : linear_order (linear_extension α) :=
+{ le := (extend_partial_order ((≤) : α → α → Prop)).some,
+  le_refl := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.1.1,
+  le_trans := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.1.2.1,
+  le_antisymm := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.1.2.1,
+  le_total := (extend_partial_order ((≤) : α → α → Prop)).some_spec.some.2.1,
+  decidable_le := classical.dec_rel _ }
+
+/-- The embedding of `α` into `linear_extension α` as a relation homomorphism. -/
+def to_linear_extension {α : Type u} [partial_order α] :
+  ((≤) : α → α → Prop) →r ((≤) : linear_extension α → linear_extension α → Prop) :=
+{ to_fun := λ x, x,
+  map_rel' := λ a b, (extend_partial_order ((≤) : α → α → Prop)).some_spec.some_spec _ _ }
+
+instance {α : Type u} [inhabited α] : inhabited (linear_extension α) :=
+⟨(default : α)⟩
diff --git a/src/order/extension/well.lean b/src/order/extension/well.lean
new file mode 100644
index 0000000000000..2aeeb6c1b5e94
--- /dev/null
+++ b/src/order/extension/well.lean
@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2022 Yaël Dillies, Junyan Xu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies, Junyan Xu
+-/
+import data.prod.lex
+import set_theory.ordinal.arithmetic
+
+/-!
+# Extend a well-founded order to a well-order
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file constructs a well-order (linear well-founded order) which is an extension of a given
+well-founded order.
+
+## Proof idea
+
+We can map our order into two well-orders:
+* the first map respects the order but isn't necessarily injective. Namely, this is the *rank*
+  function `rank : α → ordinal`.
+* the second map is injective but doesn't necessarily respect the order. This is an arbitrary
+  well-order on `α`.
+
+Then their lexicographic product is a well-founded linear order which our original order injects in.
+-/
+
+universe u
+
+variables {α : Type u} {r : α → α → Prop}
+
+namespace well_founded
+variable (hwf : well_founded r)
+include hwf
+
+/-- An arbitrary well order on `α` that extends `r`.
+
+The construction maps `r` into two well-orders: the first map is `well_founded.rank`, which is not
+necessarily injective but respects the order `r`; the other map is the identity (with an arbitrarily
+chosen well-order on `α`), which is injective but doesn't respect `r`.
+
+By taking the lexicographic product of the two, we get both properties, so we can pull it back and
+get an well-order that extend our original order `r`. Another way to view this is that we choose an
+arbitrary well-order to serve as a tiebreak between two elements of same rank.
+-/
+noncomputable def well_order_extension : linear_order α :=
+let l : linear_order α := is_well_order.linear_order well_ordering_rel in by exactI
+  @linear_order.lift' α (ordinal ×ₗ α) _
+    (λ a : α, (well_founded.rank.{u} hwf a, a)) (λ _ _, congr_arg prod.snd)
+
+instance well_order_extension.is_well_founded_lt : is_well_founded α hwf.well_order_extension.lt :=
+⟨inv_image.wf _ $ prod.lex_wf ordinal.well_founded_lt.wf well_ordering_rel.is_well_order.wf⟩
+
+/-- Any well-founded relation can be extended to a well-ordering on that type. -/
+lemma exists_well_order_ge : ∃ s, r ≤ s ∧ is_well_order α s :=
+⟨hwf.well_order_extension.lt, λ a b h, prod.lex.left _ _ (hwf.rank_lt_of_rel h), by split⟩
+
+end well_founded
+
+/-- A type alias for `α`, intended to extend a well-founded order on `α` to a well-order. -/
+def well_order_extension (α) : Type* := α
+
+instance [inhabited α] : inhabited (well_order_extension α) := ‹inhabited (well_order_extension α)›
+
+/-- "Identity" equivalence between a well-founded order and its well-order extension. -/
+def to_well_order_extension : α ≃ well_order_extension α := equiv.refl _
+
+noncomputable instance [has_lt α] [well_founded_lt α] : linear_order (well_order_extension α) :=
+(is_well_founded.wf : @well_founded α (<)).well_order_extension
+
+instance well_order_extension.well_founded_lt [has_lt α] [well_founded_lt α] :
+  well_founded_lt (well_order_extension α) :=
+well_founded.well_order_extension.is_well_founded_lt _
+
+lemma to_well_order_extension_strict_mono [preorder α] [well_founded_lt α] :
+  strict_mono (to_well_order_extension : α → well_order_extension α) :=
+λ a b h, prod.lex.left _ _ $ well_founded.rank_lt_of_rel _ h
diff --git a/src/order/filter/archimedean.lean b/src/order/filter/archimedean.lean
index 5019341af730c..81fa27e031c80 100644
--- a/src/order/filter/archimedean.lean
+++ b/src/order/filter/archimedean.lean
@@ -9,6 +9,9 @@ import order.filter.at_top_bot
 /-!
 # `at_top` filter and archimedean (semi)rings/fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that for a linear ordered archimedean semiring `R` and a function `f : α → ℕ`,
 the function `coe ∘ f : α → R` tends to `at_top` along a filter `l` if and only if so does `f`.
 We also prove that `coe : ℕ → R` tends to `at_top` along `at_top`, as well as version of these
@@ -19,42 +22,43 @@ variables {α R : Type*}
 
 open filter set
 
-@[simp] lemma nat.comap_coe_at_top [ordered_semiring R] [nontrivial R] [archimedean R] :
+@[simp] lemma nat.comap_coe_at_top [strict_ordered_semiring R] [archimedean R] :
   comap (coe : ℕ → R) at_top = at_top :=
 comap_embedding_at_top (λ _ _, nat.cast_le) exists_nat_ge
 
-lemma tendsto_coe_nat_at_top_iff [ordered_semiring R] [nontrivial R] [archimedean R]
+lemma tendsto_coe_nat_at_top_iff [strict_ordered_semiring R] [archimedean R]
   {f : α → ℕ} {l : filter α} :
   tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
 tendsto_at_top_embedding (assume a₁ a₂, nat.cast_le) exists_nat_ge
 
-lemma tendsto_coe_nat_at_top_at_top [ordered_semiring R] [archimedean R] :
+lemma tendsto_coe_nat_at_top_at_top [strict_ordered_semiring R] [archimedean R] :
   tendsto (coe : ℕ → R) at_top at_top :=
 nat.mono_cast.tendsto_at_top_at_top exists_nat_ge
 
-@[simp] lemma int.comap_coe_at_top [ordered_ring R] [nontrivial R] [archimedean R] :
+@[simp] lemma int.comap_coe_at_top [strict_ordered_ring R] [archimedean R] :
   comap (coe : ℤ → R) at_top = at_top :=
-comap_embedding_at_top (λ _ _, int.cast_le) $ λ r, let ⟨n, hn⟩ := exists_nat_ge r in ⟨n, hn⟩
+comap_embedding_at_top (λ _ _, int.cast_le) $ λ r,
+  let ⟨n, hn⟩ := exists_nat_ge r in ⟨n, by exact_mod_cast hn⟩
 
-@[simp] lemma int.comap_coe_at_bot [ordered_ring R] [nontrivial R] [archimedean R] :
+@[simp] lemma int.comap_coe_at_bot [strict_ordered_ring R] [archimedean R] :
   comap (coe : ℤ → R) at_bot = at_bot :=
 comap_embedding_at_bot (λ _ _, int.cast_le) $ λ r,
   let ⟨n, hn⟩ := exists_nat_ge (-r) in ⟨-n, by simpa [neg_le] using hn⟩
 
-lemma tendsto_coe_int_at_top_iff [ordered_ring R] [nontrivial R] [archimedean R]
+lemma tendsto_coe_int_at_top_iff [strict_ordered_ring R] [archimedean R]
   {f : α → ℤ} {l : filter α} :
   tendsto (λ n, (f n : R)) l at_top ↔ tendsto f l at_top :=
 by rw [← tendsto_comap_iff, int.comap_coe_at_top]
 
-lemma tendsto_coe_int_at_bot_iff [ordered_ring R] [nontrivial R] [archimedean R]
+lemma tendsto_coe_int_at_bot_iff [strict_ordered_ring R] [archimedean R]
   {f : α → ℤ} {l : filter α} :
   tendsto (λ n, (f n : R)) l at_bot ↔ tendsto f l at_bot :=
 by rw [← tendsto_comap_iff, int.comap_coe_at_bot]
 
-lemma tendsto_coe_int_at_top_at_top [ordered_ring R] [archimedean R] :
+lemma tendsto_coe_int_at_top_at_top [strict_ordered_ring R] [archimedean R] :
   tendsto (coe : ℤ → R) at_top at_top :=
 int.cast_mono.tendsto_at_top_at_top $ λ b,
-  let ⟨n, hn⟩ := exists_nat_ge b in ⟨n, hn⟩
+  let ⟨n, hn⟩ := exists_nat_ge b in ⟨n, by exact_mod_cast hn⟩
 
 @[simp] lemma rat.comap_coe_at_top [linear_ordered_field R] [archimedean R] :
   comap (coe : ℚ → R) at_top = at_top :=
@@ -77,14 +81,14 @@ by rw [← tendsto_comap_iff, rat.comap_coe_at_bot]
 
 lemma at_top_countable_basis_of_archimedean [linear_ordered_semiring R] [archimedean R] :
   (at_top : filter R).has_countable_basis (λ n : ℕ, true) (λ n, Ici n) :=
-{ countable := countable_encodable _,
+{ countable := to_countable _,
   to_has_basis := at_top_basis.to_has_basis
     (λ x hx, let ⟨n, hn⟩ := exists_nat_ge x in ⟨n, trivial, Ici_subset_Ici.2 hn⟩)
     (λ n hn, ⟨n, trivial, subset.rfl⟩) }
 
 lemma at_bot_countable_basis_of_archimedean [linear_ordered_ring R] [archimedean R] :
   (at_bot : filter R).has_countable_basis (λ m : ℤ, true) (λ m, Iic m) :=
-{ countable := countable_encodable _,
+{ countable := to_countable _,
   to_has_basis := at_bot_basis.to_has_basis
     (λ x hx, let ⟨m, hm⟩ := exists_int_lt x in ⟨m, trivial, Iic_subset_Iic.2 hm.le⟩)
     (λ m hm, ⟨m, trivial, subset.rfl⟩) }
@@ -151,32 +155,22 @@ variables [linear_ordered_ring R] [archimedean R]
 `linear_ordered_field`s which does not require the `archimedean` assumption. -/
 lemma tendsto.at_top_mul_neg_const' (hr : r < 0) (hf : tendsto f l at_top) :
   tendsto (λx, f x * r) l at_bot :=
-begin
-  have h : (λ x, f x * -r) = -λ x, f x * r, { ext, simp, },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top,
-  exact h ▸ tendsto.at_top_mul_const' (neg_pos.mpr hr) hf,
-end
+by simpa only [tendsto_neg_at_top_iff, mul_neg] using hf.at_top_mul_const' (neg_pos.mpr hr)
 
 /-- See also `filter.tendsto.at_bot_mul_const` for a version of this lemma for
 `linear_ordered_field`s which does not require the `archimedean` assumption. -/
 lemma tendsto.at_bot_mul_const' (hr : 0 < r) (hf : tendsto f l at_bot) :
   tendsto (λx, f x * r) l at_bot :=
 begin
-  have h : (λ x, (-f) x * r) = -λ x, f x * r, { ext, simp, },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top at hf ⊢,
-  exact h ▸  tendsto.at_top_mul_const' hr hf,
+  simp only [← tendsto_neg_at_top_iff, ← neg_mul] at hf ⊢,
+  exact hf.at_top_mul_const' hr
 end
 
 /-- See also `filter.tendsto.at_bot_mul_neg_const` for a version of this lemma for
 `linear_ordered_field`s which does not require the `archimedean` assumption. -/
 lemma tendsto.at_bot_mul_neg_const' (hr : r < 0) (hf : tendsto f l at_bot) :
   tendsto (λx, f x * r) l at_top :=
-begin
-  have h : (λ x, (-f) x * r) = -λ x, f x * r, { ext, simp, },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top at hf,
-  rw tendsto_at_top_iff_tends_to_neg_at_bot,
-  exact h ▸ tendsto.at_top_mul_neg_const' hr hf,
-end
+by simpa only [mul_neg, tendsto_neg_at_bot_iff] using hf.at_bot_mul_const' (neg_pos.2 hr)
 
 end linear_ordered_ring
 
@@ -200,11 +194,7 @@ variables [linear_ordered_add_comm_group R] [archimedean R]
 
 lemma tendsto.at_top_nsmul_neg_const {f : α → ℕ} (hr : r < 0) (hf : tendsto f l at_top) :
   tendsto (λ x, f x • r) l at_bot :=
-begin
-  have h : (λ x, f x • -r) = -λ x, f x • r, { ext, simp, },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top,
-  exact h ▸ tendsto.at_top_nsmul_const (neg_pos.mpr hr) hf,
-end
+by simpa using hf.at_top_nsmul_const (neg_pos.2 hr)
 
 lemma tendsto.at_top_zsmul_const {f : α → ℤ} (hr : 0 < r) (hf : tendsto f l at_top) :
   tendsto (λ x, f x • r) l at_top :=
@@ -217,28 +207,18 @@ end
 
 lemma tendsto.at_top_zsmul_neg_const {f : α → ℤ} (hr : r < 0) (hf : tendsto f l at_top) :
   tendsto (λ x, f x • r) l at_bot :=
-begin
-  have h : (λ x, f x • -r) = -λ x, f x • r, { ext, simp [zsmul_neg], },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top,
-  exact h ▸ tendsto.at_top_zsmul_const (neg_pos.mpr hr) hf,
-end
+by simpa using hf.at_top_zsmul_const (neg_pos.2 hr)
 
 lemma tendsto.at_bot_zsmul_const {f : α → ℤ} (hr : 0 < r) (hf : tendsto f l at_bot) :
   tendsto (λ x, f x • r) l at_bot :=
 begin
-  have h : (λ x, (-f) x • r) = -λ x, f x • r, { ext, simp, },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top at hf ⊢,
-  exact h ▸ tendsto.at_top_zsmul_const hr hf,
+  simp only [← tendsto_neg_at_top_iff, ← neg_zsmul] at hf ⊢,
+  exact hf.at_top_zsmul_const hr
 end
 
 lemma tendsto.at_bot_zsmul_neg_const {f : α → ℤ} (hr : r < 0) (hf : tendsto f l at_bot) :
   tendsto (λ x, f x • r) l at_top :=
-begin
-  have h : (λ x, (-f) x • r) = -λ x, f x • r, { ext, simp, },
-  rw tendsto_at_bot_iff_tends_to_neg_at_top at hf,
-  rw tendsto_at_top_iff_tends_to_neg_at_bot,
-  exact h ▸ tendsto.at_top_zsmul_neg_const hr hf,
-end
+by simpa using hf.at_bot_zsmul_const (neg_pos.2 hr)
 
 end linear_ordered_add_comm_group
 
diff --git a/src/order/filter/at_top_bot.lean b/src/order/filter/at_top_bot.lean
index 47bd815c63aa1..086cf2580565c 100644
--- a/src/order/filter/at_top_bot.lean
+++ b/src/order/filter/at_top_bot.lean
@@ -3,13 +3,19 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Jeremy Avigad, Yury Kudryashov, Patrick Massot
 -/
-import order.filter.bases
+import algebra.order.field.basic
 import data.finset.preimage
 import data.set.intervals.disjoint
+import data.set.intervals.order_iso
+import order.filter.bases
+import algebra.order.group.min_max
 
 /-!
 # `at_top` and `at_bot` filters on preorded sets, monoids and groups.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the filters
 
 * `at_top`: corresponds to `n → +∞`;
@@ -66,6 +72,20 @@ lemma disjoint_at_bot_principal_Ici [preorder α] [no_min_order α] (x : α) :
   disjoint at_bot (𝓟 (Ici x)) :=
 @disjoint_at_top_principal_Iic αᵒᵈ _ _ _
 
+lemma disjoint_pure_at_top [preorder α] [no_max_order α] (x : α) : disjoint (pure x) at_top :=
+disjoint.symm ((disjoint_at_top_principal_Iic x).mono_right $ le_principal_iff.2 le_rfl)
+
+lemma disjoint_pure_at_bot [preorder α] [no_min_order α] (x : α) : disjoint (pure x) at_bot :=
+@disjoint_pure_at_top αᵒᵈ _ _ _
+
+lemma not_tendsto_const_at_top [preorder α] [no_max_order α] (x : α) (l : filter β) [l.ne_bot] :
+  ¬tendsto (λ _, x) l at_top :=
+tendsto_const_pure.not_tendsto (disjoint_pure_at_top x)
+
+lemma not_tendsto_const_at_bot [preorder α] [no_min_order α] (x : α) (l : filter β) [l.ne_bot] :
+  ¬tendsto (λ _, x) l at_bot :=
+tendsto_const_pure.not_tendsto (disjoint_pure_at_bot x)
+
 lemma disjoint_at_bot_at_top [partial_order α] [nontrivial α] :
   disjoint (at_bot : filter α) at_top :=
 begin
@@ -135,34 +155,66 @@ Ioi_mem_at_top a
 
 lemma eventually_ne_at_top [preorder α] [no_max_order α] (a : α) :
   ∀ᶠ x in at_top, x ≠ a :=
-(eventually_gt_at_top a).mono (λ x hx, hx.ne.symm)
+(eventually_gt_at_top a).mono $ λ x, ne_of_gt
+
+lemma tendsto.eventually_gt_at_top [preorder β] [no_max_order β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_top) (c : β) : ∀ᶠ x in l, c < f x :=
+hf.eventually (eventually_gt_at_top c)
+
+lemma tendsto.eventually_ge_at_top [preorder β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_top) (c : β) : ∀ᶠ x in l, c ≤ f x :=
+hf.eventually (eventually_ge_at_top c)
+
+lemma tendsto.eventually_ne_at_top [preorder β] [no_max_order β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_top) (c : β) : ∀ᶠ x in l, f x ≠ c :=
+hf.eventually (eventually_ne_at_top c)
+
+lemma tendsto.eventually_ne_at_top' [preorder β] [no_max_order β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_top) (c : α) : ∀ᶠ x in l, x ≠ c :=
+(hf.eventually_ne_at_top (f c)).mono $ λ x, ne_of_apply_ne f
 
 lemma eventually_lt_at_bot [preorder α] [no_min_order α] (a : α) :
   ∀ᶠ x in at_bot, x < a :=
 Iio_mem_at_bot a
 
+lemma eventually_ne_at_bot [preorder α] [no_min_order α] (a : α) :
+  ∀ᶠ x in at_bot, x ≠ a :=
+(eventually_lt_at_bot a).mono $ λ x, ne_of_lt
+
+lemma tendsto.eventually_lt_at_bot [preorder β] [no_min_order β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_bot) (c : β) : ∀ᶠ x in l, f x < c :=
+hf.eventually (eventually_lt_at_bot c)
+
+lemma tendsto.eventually_le_at_bot [preorder β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_bot) (c : β) : ∀ᶠ x in l, f x ≤ c :=
+hf.eventually (eventually_le_at_bot c)
+
+lemma tendsto.eventually_ne_at_bot [preorder β] [no_min_order β] {f : α → β} {l : filter α}
+  (hf : tendsto f l at_bot) (c : β) :  ∀ᶠ x in l, f x ≠ c :=
+hf.eventually (eventually_ne_at_bot c)
+
 lemma at_top_basis_Ioi [nonempty α] [semilattice_sup α] [no_max_order α] :
   (@at_top α _).has_basis (λ _, true) Ioi :=
 at_top_basis.to_has_basis (λ a ha, ⟨a, ha, Ioi_subset_Ici_self⟩) $
   λ a ha, (exists_gt a).imp $ λ b hb, ⟨ha, Ici_subset_Ioi.2 hb⟩
 
-lemma at_top_countable_basis [nonempty α] [semilattice_sup α] [encodable α] :
+lemma at_top_countable_basis [nonempty α] [semilattice_sup α] [countable α] :
   has_countable_basis (at_top : filter α) (λ _, true) Ici :=
-{ countable := countable_encodable _,
+{ countable := to_countable _,
   .. at_top_basis }
 
-lemma at_bot_countable_basis [nonempty α] [semilattice_inf α] [encodable α] :
+lemma at_bot_countable_basis [nonempty α] [semilattice_inf α] [countable α] :
   has_countable_basis (at_bot : filter α) (λ _, true) Iic :=
-{ countable := countable_encodable _,
+{ countable := to_countable _,
   .. at_bot_basis }
 
 @[priority 200]
-instance at_top.is_countably_generated [preorder α] [encodable α] :
+instance at_top.is_countably_generated [preorder α] [countable α] :
   (at_top : filter $ α).is_countably_generated :=
 is_countably_generated_seq _
 
 @[priority 200]
-instance at_bot.is_countably_generated [preorder α] [encodable α] :
+instance at_bot.is_countably_generated [preorder α] [countable α] :
   (at_bot : filter $ α).is_countably_generated :=
 is_countably_generated_seq _
 
@@ -259,6 +311,43 @@ lemma tendsto_at_bot_mono [preorder β] {l : filter α} {f g : α → β} (h : 
   tendsto g l at_bot → tendsto f l at_bot :=
 @tendsto_at_top_mono _ βᵒᵈ _ _ _ _ h
 
+end filter
+
+namespace order_iso
+
+open filter
+variables [preorder α] [preorder β]
+
+@[simp] lemma comap_at_top (e : α ≃o β) : comap e at_top = at_top :=
+by simp [at_top, ← e.surjective.infi_comp]
+
+@[simp] lemma comap_at_bot (e : α ≃o β) : comap e at_bot = at_bot :=
+e.dual.comap_at_top
+
+@[simp] lemma map_at_top (e : α ≃o β) : map (e : α → β) at_top = at_top :=
+by rw [← e.comap_at_top, map_comap_of_surjective e.surjective]
+
+@[simp] lemma map_at_bot (e : α ≃o β) : map (e : α → β) at_bot = at_bot :=
+e.dual.map_at_top
+
+lemma tendsto_at_top (e : α ≃o β) : tendsto e at_top at_top :=
+e.map_at_top.le
+
+lemma tendsto_at_bot (e : α ≃o β) : tendsto e at_bot at_bot :=
+e.map_at_bot.le
+
+@[simp] lemma tendsto_at_top_iff {l : filter γ} {f : γ → α} (e : α ≃o β) :
+  tendsto (λ x, e (f x)) l at_top ↔ tendsto f l at_top :=
+by rw [← e.comap_at_top, tendsto_comap_iff]
+
+@[simp] lemma tendsto_at_bot_iff {l : filter γ} {f : γ → α} (e : α ≃o β) :
+  tendsto (λ x, e (f x)) l at_bot ↔ tendsto f l at_bot :=
+e.dual.tendsto_at_top_iff
+
+end order_iso
+
+namespace filter
+
 /-!
 ### Sequences
 -/
@@ -584,27 +673,37 @@ lemma tendsto_at_bot_add_const_right (C : β) (hf : tendsto f l at_bot) :
   tendsto (λ x, f x + C) l at_bot :=
 @tendsto_at_top_add_const_right _ βᵒᵈ _ _ _ C hf
 
+lemma map_neg_at_bot : map (has_neg.neg : β → β) at_bot = at_top :=
+(order_iso.neg β).map_at_bot
+
+lemma map_neg_at_top : map (has_neg.neg : β → β) at_top = at_bot :=
+(order_iso.neg β).map_at_top
+
+@[simp] lemma comap_neg_at_bot : comap (has_neg.neg : β → β) at_bot = at_top :=
+(order_iso.neg β).comap_at_top
+
+@[simp] lemma comap_neg_at_top : comap (has_neg.neg : β → β) at_top = at_bot :=
+(order_iso.neg β).comap_at_bot
+
 lemma tendsto_neg_at_top_at_bot : tendsto (has_neg.neg : β → β) at_top at_bot :=
-begin
-  simp only [tendsto_at_bot, neg_le],
-  exact λ b, eventually_ge_at_top _
-end
+(order_iso.neg β).tendsto_at_top
 
 lemma tendsto_neg_at_bot_at_top : tendsto (has_neg.neg : β → β) at_bot at_top :=
 @tendsto_neg_at_top_at_bot βᵒᵈ _
 
-lemma tendsto_at_top_iff_tends_to_neg_at_bot : tendsto f l at_top ↔ tendsto (-f) l at_bot :=
-have hf : f = has_neg.neg ∘ -f, { ext, simp, },
-⟨tendsto_neg_at_top_at_bot.comp, λ h, hf.symm ▸ tendsto_neg_at_bot_at_top.comp h⟩
+variable {l}
+
+@[simp] lemma tendsto_neg_at_top_iff : tendsto (λ x, -f x) l at_top ↔ tendsto f l at_bot :=
+(order_iso.neg β).tendsto_at_bot_iff
 
-lemma tendsto_at_bot_iff_tends_to_neg_at_top : tendsto f l at_bot ↔ tendsto (-f) l at_top :=
-@tendsto_at_top_iff_tends_to_neg_at_bot α βᵒᵈ _ l f
+@[simp] lemma tendsto_neg_at_bot_iff : tendsto (λ x, -f x) l at_bot ↔ tendsto f l at_top :=
+(order_iso.neg β).tendsto_at_top_iff
 
 end ordered_group
 
-section ordered_semiring
+section strict_ordered_semiring
 
-variables [ordered_semiring α] {l : filter β} {f g : β → α}
+variables [strict_ordered_semiring α] {l : filter β} {f g : β → α}
 
 lemma tendsto_bit1_at_top : tendsto bit1 (at_top : filter α) at_top :=
 tendsto_at_top_add_nonneg_right tendsto_bit0_at_top (λ _, zero_le_one)
@@ -622,30 +721,17 @@ tendsto_id.at_top_mul_at_top tendsto_id
 
 /-- The monomial function `x^n` tends to `+∞` at `+∞` for any positive natural `n`.
 A version for positive real powers exists as `tendsto_rpow_at_top`. -/
-lemma tendsto_pow_at_top {n : ℕ} (hn : 1 ≤ n) : tendsto (λ x : α, x ^ n) at_top at_top :=
-begin
-  refine tendsto_at_top_mono' _ ((eventually_ge_at_top 1).mono $ λ x hx, _) tendsto_id,
-  simpa only [pow_one] using pow_le_pow hx hn
-end
+lemma tendsto_pow_at_top {n : ℕ} (hn : n ≠ 0) : tendsto (λ x : α, x ^ n) at_top at_top :=
+tendsto_at_top_mono' _ ((eventually_ge_at_top 1).mono $ λ x hx, le_self_pow hx hn) tendsto_id
 
-lemma eventually_ne_of_tendsto_at_top [nontrivial α] (hf : tendsto f l at_top)
-  (c : α) :  ∀ᶠ x in l, f x ≠ c :=
-(tendsto_at_top.1 hf $ (c + 1)).mono (λ x hx, ne_of_gt (lt_of_lt_of_le (lt_add_one c) hx))
-
-end ordered_semiring
+end strict_ordered_semiring
 
 lemma zero_pow_eventually_eq [monoid_with_zero α] :
   (λ n : ℕ, (0 : α) ^ n) =ᶠ[at_top] (λ n, 0) :=
 eventually_at_top.2 ⟨1, λ n hn, zero_pow (zero_lt_one.trans_le hn)⟩
 
-section ordered_ring
-
-variables [ordered_ring α] {l : filter β} {f g : β → α}
-
-lemma eventually_ne_of_tendsto_at_bot [nontrivial α] (hf : tendsto f l at_bot)
-  (c : α) : ∀ᶠ x in l, f x ≠ c :=
-(tendsto_at_bot.1 hf $ (c - 1)).mono
-  (λ x hx, ne_of_lt (lt_of_le_of_lt hx ((sub_lt_self_iff c).2 zero_lt_one)))
+section strict_ordered_ring
+variables [strict_ordered_ring α] {l : filter β} {f g : β → α}
 
 lemma tendsto.at_top_mul_at_bot (hf : tendsto f l at_top) (hg : tendsto g l at_bot) :
   tendsto (λ x, f x * g x) l at_bot :=
@@ -664,7 +750,7 @@ have tendsto (λ x, (-f x) * (-g x)) l at_top :=
   (tendsto_neg_at_bot_at_top.comp hf).at_top_mul_at_top (tendsto_neg_at_bot_at_top.comp hg),
 by simpa only [neg_mul_neg] using this
 
-end ordered_ring
+end strict_ordered_ring
 
 section linear_ordered_add_comm_group
 
@@ -702,29 +788,70 @@ lemma tendsto.at_top_of_mul_const {c : α} (hc : 0 < c) (hf : tendsto (λ x, f x
   tendsto f l at_top :=
 tendsto_at_top.2 $ λ b, (tendsto_at_top.1 hf (b * c)).mono $ λ x hx, le_of_mul_le_mul_right hx hc
 
+@[simp] lemma tendsto_pow_at_top_iff {n : ℕ} : tendsto (λ x : α, x ^ n) at_top at_top ↔ n ≠ 0 :=
+⟨λ h hn, by simpa only [hn, pow_zero, not_tendsto_const_at_top] using h, tendsto_pow_at_top⟩
+
 end linear_ordered_semiring
 
 lemma nonneg_of_eventually_pow_nonneg [linear_ordered_ring α] {a : α}
   (h : ∀ᶠ n in at_top, 0 ≤ a ^ (n : ℕ)) : 0 ≤ a :=
 let ⟨n, hn⟩ := (tendsto_bit1_at_top.eventually h).exists in pow_bit1_nonneg_iff.1 hn
 
-section linear_ordered_field
+lemma not_tendsto_pow_at_top_at_bot [linear_ordered_ring α] :
+  ∀ {n : ℕ}, ¬tendsto (λ x : α, x ^ n) at_top at_bot
+| 0 := by simp [not_tendsto_const_at_bot]
+| (n + 1) := (tendsto_pow_at_top n.succ_ne_zero).not_tendsto disjoint_at_top_at_bot
 
-variables [linear_ordered_field α] {l : filter β} {f : β → α} {r : α}
+section linear_ordered_semifield
+
+variables [linear_ordered_semifield α] {l : filter β} {f : β → α} {r c : α} {n : ℕ}
+
+/-!
+### Multiplication by constant: iff lemmas
+-/
+
+/-- If `r` is a positive constant, then `λ x, r * f x` tends to infinity along a filter if and only
+if `f` tends to infinity along the same filter. -/
+lemma tendsto_const_mul_at_top_of_pos (hr : 0 < r) :
+  tendsto (λ x, r * f x) l at_top ↔ tendsto f l at_top :=
+⟨λ h, h.at_top_of_const_mul hr,
+  λ h, tendsto.at_top_of_const_mul (inv_pos.2 hr) $ by simpa only [inv_mul_cancel_left₀ hr.ne']⟩
+
+/-- If `r` is a positive constant, then `λ x, f x * r` tends to infinity along a filter if and only
+if `f` tends to infinity along the same filter. -/
+lemma tendsto_mul_const_at_top_of_pos (hr : 0 < r) :
+  tendsto (λ x, f x * r) l at_top ↔ tendsto f l at_top :=
+by simpa only [mul_comm] using tendsto_const_mul_at_top_of_pos hr
+
+/-- If `f` tends to infinity along a nontrivial filter `l`, then `λ x, r * f x` tends to infinity
+if and only if `0 < r. `-/
+lemma tendsto_const_mul_at_top_iff_pos [ne_bot l] (h : tendsto f l at_top) :
+  tendsto (λ x, r * f x) l at_top ↔ 0 < r :=
+begin
+  refine ⟨λ hrf, not_le.mp $ λ hr, _, λ hr, (tendsto_const_mul_at_top_of_pos hr).mpr h⟩,
+  rcases ((h.eventually_ge_at_top 0).and (hrf.eventually_gt_at_top 0)).exists with ⟨x, hx, hrx⟩,
+  exact (mul_nonpos_of_nonpos_of_nonneg hr hx).not_lt hrx
+end
+
+/-- If `f` tends to infinity along a nontrivial filter `l`, then `λ x, f x * r` tends to infinity
+if and only if `0 < r. `-/
+lemma tendsto_mul_const_at_top_iff_pos [ne_bot l] (h : tendsto f l at_top) :
+  tendsto (λ x, f x * r) l at_top ↔ 0 < r :=
+by simp only [mul_comm _ r, tendsto_const_mul_at_top_iff_pos h]
 
 /-- If a function tends to infinity along a filter, then this function multiplied by a positive
 constant (on the left) also tends to infinity. For a version working in `ℕ` or `ℤ`, use
 `filter.tendsto.const_mul_at_top'` instead. -/
 lemma tendsto.const_mul_at_top (hr : 0 < r) (hf : tendsto f l at_top) :
   tendsto (λx, r * f x) l at_top :=
-tendsto.at_top_of_const_mul (inv_pos.2 hr) $ by simpa only [inv_mul_cancel_left₀ hr.ne']
+(tendsto_const_mul_at_top_of_pos hr).2 hf
 
 /-- If a function tends to infinity along a filter, then this function multiplied by a positive
 constant (on the right) also tends to infinity. For a version working in `ℕ` or `ℤ`, use
 `filter.tendsto.at_top_mul_const'` instead. -/
 lemma tendsto.at_top_mul_const (hr : 0 < r) (hf : tendsto f l at_top) :
   tendsto (λx, f x * r) l at_top :=
-by simpa only [mul_comm] using hf.const_mul_at_top hr
+(tendsto_mul_const_at_top_of_pos hr).2 hf
 
 /-- If a function tends to infinity along a filter, then this function divided by a positive
 constant also tends to infinity. -/
@@ -732,31 +859,150 @@ lemma tendsto.at_top_div_const (hr : 0 < r) (hf : tendsto f l at_top) :
   tendsto (λx, f x / r) l at_top :=
 by simpa only [div_eq_mul_inv] using hf.at_top_mul_const (inv_pos.2 hr)
 
+lemma tendsto_const_mul_pow_at_top (hn : n ≠ 0) (hc : 0 < c) :
+  tendsto (λ x, c * x^n) at_top at_top :=
+tendsto.const_mul_at_top hc (tendsto_pow_at_top hn)
+
+lemma tendsto_const_mul_pow_at_top_iff  :
+  tendsto (λ x, c * x^n) at_top at_top ↔ n ≠ 0 ∧ 0 < c :=
+begin
+  refine ⟨λ h, ⟨_, _⟩, λ h, tendsto_const_mul_pow_at_top h.1 h.2⟩,
+  { rintro rfl,
+    simpa only [pow_zero, not_tendsto_const_at_top] using h },
+  { rcases ((h.eventually_gt_at_top 0).and (eventually_ge_at_top 0)).exists with ⟨k, hck, hk⟩,
+    exact pos_of_mul_pos_left hck (pow_nonneg hk _) },
+end
+
+end linear_ordered_semifield
+
+section linear_ordered_field
+variables [linear_ordered_field α] {l : filter β} {f : β → α} {r : α}
+
+
+/-- If `r` is a positive constant, then `λ x, r * f x` tends to negative infinity along a filter if
+and only if `f` tends to negative infinity along the same filter. -/
+lemma tendsto_const_mul_at_bot_of_pos (hr : 0 < r) :
+  tendsto (λ x, r * f x) l at_bot ↔ tendsto f l at_bot :=
+by simpa only [← mul_neg, ← tendsto_neg_at_top_iff] using tendsto_const_mul_at_top_of_pos hr
+
+/-- If `r` is a positive constant, then `λ x, f x * r` tends to negative infinity along a filter if
+and only if `f` tends to negative infinity along the same filter. -/
+lemma tendsto_mul_const_at_bot_of_pos (hr : 0 < r) :
+  tendsto (λ x, f x * r) l at_bot ↔ tendsto f l at_bot :=
+by simpa only [mul_comm] using tendsto_const_mul_at_bot_of_pos hr
+
+/-- If `r` is a negative constant, then `λ x, r * f x` tends to infinity along a filter if and only
+if `f` tends to negative infinity along the same filter. -/
+lemma tendsto_const_mul_at_top_of_neg (hr : r < 0) :
+  tendsto (λ x, r * f x) l at_top ↔ tendsto f l at_bot :=
+by simpa only [neg_mul, tendsto_neg_at_bot_iff] using tendsto_const_mul_at_bot_of_pos (neg_pos.2 hr)
+
+/-- If `r` is a negative constant, then `λ x, f x * r` tends to infinity along a filter if and only
+if `f` tends to negative infinity along the same filter. -/
+lemma tendsto_mul_const_at_top_of_neg (hr : r < 0) :
+  tendsto (λ x, f x * r) l at_top ↔ tendsto f l at_bot :=
+by simpa only [mul_comm] using tendsto_const_mul_at_top_of_neg hr
+
+/-- If `r` is a negative constant, then `λ x, r * f x` tends to negative infinity along a filter if
+and only if `f` tends to infinity along the same filter. -/
+lemma tendsto_const_mul_at_bot_of_neg (hr : r < 0) :
+  tendsto (λ x, r * f x) l at_bot ↔ tendsto f l at_top :=
+by simpa only [neg_mul, tendsto_neg_at_top_iff] using tendsto_const_mul_at_top_of_pos (neg_pos.2 hr)
+
+/-- If `r` is a negative constant, then `λ x, f x * r` tends to negative infinity along a filter if
+and only if `f` tends to infinity along the same filter. -/
+lemma tendsto_mul_const_at_bot_of_neg (hr : r < 0) :
+  tendsto (λ x, f x * r) l at_bot ↔ tendsto f l at_top :=
+by simpa only [mul_comm] using tendsto_const_mul_at_bot_of_neg hr
+
+/-- The function `λ x, r * f x` tends to infinity along a nontrivial filter if and only if `r > 0`
+and `f` tends to infinity or `r < 0` and `f` tends to negative infinity. -/
+lemma tendsto_const_mul_at_top_iff [ne_bot l] :
+  tendsto (λ x, r * f x) l at_top ↔ 0 < r ∧ tendsto f l at_top ∨ r < 0 ∧ tendsto f l at_bot :=
+begin
+  rcases lt_trichotomy r 0 with hr|rfl|hr,
+  { simp [hr, hr.not_lt, tendsto_const_mul_at_top_of_neg] },
+  { simp [not_tendsto_const_at_top] },
+  { simp [hr, hr.not_lt, tendsto_const_mul_at_top_of_pos] }
+end
+
+/-- The function `λ x, f x * r` tends to infinity along a nontrivial filter if and only if `r > 0`
+and `f` tends to infinity or `r < 0` and `f` tends to negative infinity. -/
+lemma tendsto_mul_const_at_top_iff [ne_bot l] :
+  tendsto (λ x, f x * r) l at_top ↔ 0 < r ∧ tendsto f l at_top ∨ r < 0 ∧ tendsto f l at_bot :=
+by simp only [mul_comm _ r, tendsto_const_mul_at_top_iff]
+
+/-- The function `λ x, r * f x` tends to negative infinity along a nontrivial filter if and only if
+`r > 0` and `f` tends to negative infinity or `r < 0` and `f` tends to infinity. -/
+lemma tendsto_const_mul_at_bot_iff [ne_bot l] :
+  tendsto (λ x, r * f x) l at_bot ↔ 0 < r ∧ tendsto f l at_bot ∨ r < 0 ∧ tendsto f l at_top :=
+by simp only [← tendsto_neg_at_top_iff, ← mul_neg, tendsto_const_mul_at_top_iff, neg_neg]
+
+/-- The function `λ x, f x * r` tends to negative infinity along a nontrivial filter if and only if
+`r > 0` and `f` tends to negative infinity or `r < 0` and `f` tends to infinity. -/
+lemma tendsto_mul_const_at_bot_iff [ne_bot l] :
+  tendsto (λ x, f x * r) l at_bot ↔ 0 < r ∧ tendsto f l at_bot ∨ r < 0 ∧ tendsto f l at_top :=
+by simp only [mul_comm _ r, tendsto_const_mul_at_bot_iff]
+
+/-- If `f` tends to negative infinity along a nontrivial filter `l`, then `λ x, r * f x` tends to
+infinity if and only if `r < 0. `-/
+lemma tendsto_const_mul_at_top_iff_neg [ne_bot l] (h : tendsto f l at_bot) :
+  tendsto (λ x, r * f x) l at_top ↔ r < 0 :=
+by simp [tendsto_const_mul_at_top_iff, h, h.not_tendsto disjoint_at_bot_at_top]
+
+/-- If `f` tends to negative infinity along a nontrivial filter `l`, then `λ x, f x * r` tends to
+infinity if and only if `r < 0. `-/
+lemma tendsto_mul_const_at_top_iff_neg [ne_bot l] (h : tendsto f l at_bot) :
+  tendsto (λ x, f x * r) l at_top ↔ r < 0 :=
+by simp only [mul_comm _ r, tendsto_const_mul_at_top_iff_neg h]
+
+/-- If `f` tends to negative infinity along a nontrivial filter `l`, then `λ x, r * f x` tends to
+negative infinity if and only if `0 < r. `-/
+lemma tendsto_const_mul_at_bot_iff_pos [ne_bot l] (h : tendsto f l at_bot) :
+  tendsto (λ x, r * f x) l at_bot ↔ 0 < r :=
+by simp [tendsto_const_mul_at_bot_iff, h, h.not_tendsto disjoint_at_bot_at_top]
+
+/-- If `f` tends to negative infinity along a nontrivial filter `l`, then `λ x, f x * r` tends to
+negative infinity if and only if `0 < r. `-/
+lemma tendsto_mul_const_at_bot_iff_pos [ne_bot l] (h : tendsto f l at_bot) :
+  tendsto (λ x, f x * r) l at_bot ↔ 0 < r :=
+by simp only [mul_comm _ r, tendsto_const_mul_at_bot_iff_pos h]
+
+/-- If `f` tends to infinity along a nontrivial filter `l`, then `λ x, r * f x` tends to negative
+infinity if and only if `r < 0. `-/
+lemma tendsto_const_mul_at_bot_iff_neg [ne_bot l] (h : tendsto f l at_top) :
+  tendsto (λ x, r * f x) l at_bot ↔ r < 0 :=
+by simp [tendsto_const_mul_at_bot_iff, h, h.not_tendsto disjoint_at_top_at_bot]
+
+/-- If `f` tends to infinity along a nontrivial filter `l`, then `λ x, f x * r` tends to negative
+infinity if and only if `r < 0. `-/
+lemma tendsto_mul_const_at_bot_iff_neg [ne_bot l] (h : tendsto f l at_top) :
+  tendsto (λ x, f x * r) l at_bot ↔ r < 0 :=
+by simp only [mul_comm _ r, tendsto_const_mul_at_bot_iff_neg h]
+
 /-- If a function tends to infinity along a filter, then this function multiplied by a negative
 constant (on the left) tends to negative infinity. -/
 lemma tendsto.neg_const_mul_at_top (hr : r < 0) (hf : tendsto f l at_top) :
   tendsto (λ x, r * f x) l at_bot :=
-by simpa only [(∘), neg_mul_eq_neg_mul, neg_neg]
-  using tendsto_neg_at_top_at_bot.comp (hf.const_mul_at_top (neg_pos.2 hr))
+(tendsto_const_mul_at_bot_of_neg hr).2 hf
 
 /-- If a function tends to infinity along a filter, then this function multiplied by a negative
 constant (on the right) tends to negative infinity. -/
 lemma tendsto.at_top_mul_neg_const (hr : r < 0) (hf : tendsto f l at_top) :
   tendsto (λ x, f x * r) l at_bot :=
-by simpa only [mul_comm] using hf.neg_const_mul_at_top hr
+(tendsto_mul_const_at_bot_of_neg hr).2 hf
 
 /-- If a function tends to negative infinity along a filter, then this function multiplied by
 a positive constant (on the left) also tends to negative infinity. -/
 lemma tendsto.const_mul_at_bot (hr : 0 < r) (hf : tendsto f l at_bot) :
   tendsto (λx, r * f x) l at_bot :=
-by simpa only [(∘), neg_mul_eq_mul_neg, neg_neg]
-  using tendsto_neg_at_top_at_bot.comp ((tendsto_neg_at_bot_at_top.comp hf).const_mul_at_top hr)
+(tendsto_const_mul_at_bot_of_pos hr).2 hf
 
 /-- If a function tends to negative infinity along a filter, then this function multiplied by
 a positive constant (on the right) also tends to negative infinity. -/
 lemma tendsto.at_bot_mul_const (hr : 0 < r) (hf : tendsto f l at_bot) :
   tendsto (λx, f x * r) l at_bot :=
-by simpa only [mul_comm] using hf.const_mul_at_bot hr
+(tendsto_mul_const_at_bot_of_pos hr).2 hf
 
 /-- If a function tends to negative infinity along a filter, then this function divided by
 a positive constant also tends to negative infinity. -/
@@ -768,52 +1014,21 @@ by simpa only [div_eq_mul_inv] using hf.at_bot_mul_const (inv_pos.2 hr)
 a negative constant (on the left) tends to positive infinity. -/
 lemma tendsto.neg_const_mul_at_bot (hr : r < 0) (hf : tendsto f l at_bot) :
   tendsto (λ x, r * f x) l at_top :=
-by simpa only [(∘), neg_mul_eq_neg_mul, neg_neg]
-  using tendsto_neg_at_bot_at_top.comp (hf.const_mul_at_bot (neg_pos.2 hr))
+(tendsto_const_mul_at_top_of_neg hr).2 hf
 
 /-- If a function tends to negative infinity along a filter, then this function multiplied by
 a negative constant (on the right) tends to positive infinity. -/
 lemma tendsto.at_bot_mul_neg_const (hr : r < 0) (hf : tendsto f l at_bot) :
   tendsto (λ x, f x * r) l at_top :=
-by simpa only [mul_comm] using hf.neg_const_mul_at_bot hr
-
-lemma tendsto_const_mul_pow_at_top {c : α} {n : ℕ}
-  (hn : 1 ≤ n) (hc : 0 < c) : tendsto (λ x, c * x^n) at_top at_top :=
-tendsto.const_mul_at_top hc (tendsto_pow_at_top hn)
-
-lemma tendsto_const_mul_pow_at_top_iff (c : α) (n : ℕ) :
-  tendsto (λ x, c * x^n) at_top at_top ↔ 1 ≤ n ∧ 0 < c :=
-begin
-  refine ⟨λ h, _, λ h, tendsto_const_mul_pow_at_top h.1 h.2⟩,
-  simp only [tendsto_at_top, eventually_at_top] at h,
-  have : 0 < c := let ⟨x, hx⟩ := h 1 in
-    pos_of_mul_pos_right (lt_of_lt_of_le zero_lt_one (hx (max x 1) (le_max_left x 1)))
-    (pow_nonneg (le_trans zero_le_one (le_max_right x 1)) n),
-  refine ⟨nat.succ_le_iff.mp (lt_of_le_of_ne (zero_le n) (ne.symm (λ hn, _))), this⟩,
-  obtain ⟨x, hx⟩ := h (c + 1),
-  specialize hx x le_rfl,
-  rw [hn, pow_zero, mul_one, add_le_iff_nonpos_right] at hx,
-  exact absurd hx (not_le.mpr zero_lt_one),
-end
+(tendsto_mul_const_at_top_of_neg hr).2 hf
 
 lemma tendsto_neg_const_mul_pow_at_top {c : α} {n : ℕ}
-  (hn : 1 ≤ n) (hc : c < 0) : tendsto (λ x, c * x^n) at_top at_bot :=
+  (hn : n ≠ 0) (hc : c < 0) : tendsto (λ x, c * x^n) at_top at_bot :=
 tendsto.neg_const_mul_at_top hc (tendsto_pow_at_top hn)
 
-lemma tendsto_neg_const_mul_pow_at_top_iff (c : α) (n : ℕ) :
-  tendsto (λ x, c * x^n) at_top at_bot ↔ 1 ≤ n ∧ c < 0 :=
-begin
-  refine ⟨λ h, _, λ h, tendsto_neg_const_mul_pow_at_top h.1 h.2⟩,
-  simp only [tendsto_at_bot, eventually_at_top] at h,
-  have : c < 0 := let ⟨x, hx⟩ := h (-1) in
-    neg_of_mul_neg_right (lt_of_le_of_lt (hx (max x 1) (le_max_left x 1)) (by simp [zero_lt_one]))
-    (pow_nonneg (le_trans zero_le_one (le_max_right x 1)) n),
-  refine ⟨nat.succ_le_iff.mp (lt_of_le_of_ne (zero_le n) (ne.symm (λ hn, _))), this⟩,
-  obtain ⟨x, hx⟩ := h (c - 1),
-  specialize hx x le_rfl,
-  rw [hn, pow_zero, mul_one, le_sub, sub_self] at hx,
-  exact absurd hx (not_le.mpr zero_lt_one),
-end
+lemma tendsto_const_mul_pow_at_bot_iff {c : α} {n : ℕ} :
+  tendsto (λ x, c * x^n) at_top at_bot ↔ n ≠ 0 ∧ c < 0 :=
+by simp only [← tendsto_neg_at_top_iff, ← neg_mul, tendsto_const_mul_pow_at_top_iff, neg_pos]
 
 end linear_ordered_field
 
@@ -876,10 +1091,10 @@ lemma tendsto_at_bot_at_bot_iff_of_monotone [nonempty α] [semilattice_inf α] [
 tendsto_at_bot_at_bot.trans $ forall_congr $ λ b, exists_congr $ λ a,
   ⟨λ h, h a (le_refl a), λ h a' ha', le_trans (hf ha') h⟩
 
-alias tendsto_at_top_at_top_of_monotone ← monotone.tendsto_at_top_at_top
-alias tendsto_at_bot_at_bot_of_monotone ← monotone.tendsto_at_bot_at_bot
-alias tendsto_at_top_at_top_iff_of_monotone ← monotone.tendsto_at_top_at_top_iff
-alias tendsto_at_bot_at_bot_iff_of_monotone ← monotone.tendsto_at_bot_at_bot_iff
+alias tendsto_at_top_at_top_of_monotone ← _root_.monotone.tendsto_at_top_at_top
+alias tendsto_at_bot_at_bot_of_monotone ← _root_.monotone.tendsto_at_bot_at_bot
+alias tendsto_at_top_at_top_iff_of_monotone ← _root_.monotone.tendsto_at_top_at_top_iff
+alias tendsto_at_bot_at_bot_iff_of_monotone ← _root_.monotone.tendsto_at_bot_at_bot_iff
 
 lemma comap_embedding_at_top [preorder β] [preorder γ] {e : β → γ}
   (hm : ∀b₁ b₂, e b₁ ≤ e b₂ ↔ b₁ ≤ b₂) (hu : ∀c, ∃b, c ≤ e b) :
@@ -932,7 +1147,7 @@ begin
     (λ b' hb', le_trans (finset.singleton_subset_iff.2 hb) (h hb')),
 end
 
-alias tendsto_at_top_finset_of_monotone ← monotone.tendsto_at_top_finset
+alias tendsto_at_top_finset_of_monotone ← _root_.monotone.tendsto_at_top_finset
 
 lemma tendsto_finset_image_at_top_at_top {i : β → γ} {j : γ → β} (h : function.left_inverse j i) :
   tendsto (finset.image j) at_top at_top :=
@@ -1192,7 +1407,7 @@ map_at_top_eq_of_gc (λb, b * k + (k - 1)) 1
   (assume a b h, nat.div_le_div_right h)
   (assume a b _,
     calc a / k ≤ b ↔ a / k < b + 1 : by rw [← nat.succ_eq_add_one, nat.lt_succ_iff]
-      ... ↔ a < (b + 1) * k : nat.div_lt_iff_lt_mul _ _ hk
+      ... ↔ a < (b + 1) * k : nat.div_lt_iff_lt_mul hk
       ... ↔ _ :
       begin
         cases k,
@@ -1280,7 +1495,10 @@ tendsto_at_bot_of_monotone_of_filter h (tendsto_map' H)
 condition for comparison of the filter `at_top.map (λ s, ∏ b in s, f b)` with
 `at_top.map (λ s, ∏ b in s, g b)`. This is useful to compare the set of limit points of
 `Π b in s, f b` as `s → at_top` with the similar set for `g`. -/
-@[to_additive]
+@[to_additive "Let `f` and `g` be two maps to the same commutative additive monoid. This lemma gives
+a sufficient condition for comparison of the filter `at_top.map (λ s, ∑ b in s, f b)` with
+`at_top.map (λ s, ∑ b in s, g b)`. This is useful to compare the set of limit points of
+`∑ b in s, f b` as `s → at_top` with the similar set for `g`."]
 lemma map_at_top_finset_prod_le_of_prod_eq [comm_monoid α] {f : β → α} {g : γ → α}
   (h_eq : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ ∏ x in u', g x = ∏ b in v', f b) :
   at_top.map (λs:finset β, ∏ b in s, f b) ≤ at_top.map (λs:finset γ, ∏ x in s, g x) :=
@@ -1299,13 +1517,42 @@ protected lemma has_antitone_basis.tendsto [preorder ι] {l : filter α}
   (h : ∀ i : ι, φ i ∈ s i) : tendsto φ at_top l  :=
 λ t ht, mem_map.2 $ (hl.eventually_subset ht).mono $ λ i hi, hi (h i)
 
+lemma has_antitone_basis.comp_mono [semilattice_sup ι] [nonempty ι] [preorder ι'] {l : filter α}
+  {s : ι' → set α} (hs : l.has_antitone_basis s)
+  {φ : ι → ι'} (φ_mono : monotone φ) (hφ : tendsto φ at_top at_top) :
+  l.has_antitone_basis (s ∘ φ) :=
+⟨hs.to_has_basis.to_has_basis
+  (λ n hn, (hφ.eventually (eventually_ge_at_top n)).exists.imp $ λ m hm, ⟨trivial, hs.antitone hm⟩)
+  (λ n hn, ⟨φ n, trivial, subset.rfl⟩), hs.antitone.comp_monotone φ_mono⟩
+
+lemma has_antitone_basis.comp_strict_mono {l : filter α} {s : ℕ → set α}
+  (hs : l.has_antitone_basis s) {φ : ℕ → ℕ} (hφ : strict_mono φ) :
+  l.has_antitone_basis (s ∘ φ) :=
+hs.comp_mono hφ.monotone hφ.tendsto_at_top
+
+/-- Given an antitone basis `s : ℕ → set α` of a filter, extract an antitone subbasis `s ∘ φ`,
+`φ : ℕ → ℕ`, such that `m < n` implies `r (φ m) (φ n)`. This lemma can be used to extract an
+antitone basis with basis sets decreasing "sufficiently fast". -/
+lemma has_antitone_basis.subbasis_with_rel {f : filter α} {s : ℕ → set α}
+  (hs : f.has_antitone_basis s) {r : ℕ → ℕ → Prop} (hr : ∀ m, ∀ᶠ n in at_top, r m n) :
+  ∃ φ : ℕ → ℕ, strict_mono φ ∧ (∀ ⦃m n⦄, m < n → r (φ m) (φ n)) ∧ f.has_antitone_basis (s ∘ φ) :=
+begin
+  rsuffices ⟨φ, hφ, hrφ⟩ : ∃ φ : ℕ → ℕ, strict_mono φ ∧ ∀ m n, m < n → r (φ m) (φ n),
+  { exact ⟨φ, hφ, hrφ, hs.comp_strict_mono hφ⟩ },
+  have : ∀ t : set ℕ, t.finite → ∀ᶠ n in at_top, ∀ m ∈ t, m < n ∧ r m n,
+    from λ t ht, (eventually_all_finite ht).2 (λ m hm, (eventually_gt_at_top m).and (hr _)),
+  rcases seq_of_forall_finite_exists (λ t ht, (this t ht).exists) with ⟨φ, hφ⟩,
+  simp only [ball_image_iff, forall_and_distrib, mem_Iio] at hφ,
+  exact ⟨φ, forall_swap.2 hφ.1, forall_swap.2 hφ.2⟩
+end
+
 /-- If `f` is a nontrivial countably generated filter, then there exists a sequence that converges
 to `f`. -/
 lemma exists_seq_tendsto (f : filter α) [is_countably_generated f] [ne_bot f] :
   ∃ x : ℕ → α, tendsto x at_top f :=
 begin
   obtain ⟨B, h⟩ := f.exists_antitone_basis,
-  have := λ n, nonempty_of_mem (h.to_has_basis.mem_of_mem trivial : B n ∈ f), choose x hx,
+  choose x hx using λ n, filter.nonempty_of_mem (h.mem n),
   exact ⟨x, h.tendsto hx⟩
 end
 
@@ -1411,7 +1658,7 @@ begin
   have hms_freq : ∀ (n : ℕ), x (y (ms n)) ∉ s, from λ n, hy_freq (ms n),
   have h_empty : (λ (n : ℕ), x (y (ms n))) ⁻¹' s = ∅,
   { ext1 n,
-    simp only [set.mem_preimage, set.mem_empty_eq, iff_false],
+    simp only [set.mem_preimage, set.mem_empty_iff_false, iff_false],
     exact hms_freq n, },
   rw h_empty at hms_tendsto,
   exact empty_not_mem at_top hms_tendsto,
@@ -1444,7 +1691,7 @@ section
 variables {R : Type*} [linear_ordered_semiring R]
 
 lemma exists_lt_mul_self (a : R) : ∃ x ≥ 0, a < x * x :=
-let ⟨x, hxa, hx0⟩ :=((tendsto_mul_self_at_top.eventually (eventually_gt_at_top a)).and
+let ⟨x, hxa, hx0⟩ := ((tendsto_mul_self_at_top.eventually (eventually_gt_at_top a)).and
   (eventually_ge_at_top 0)).exists
 in ⟨x, hx0, hxa⟩
 
@@ -1453,38 +1700,6 @@ let ⟨x, hx0, hxa⟩ := exists_lt_mul_self a in ⟨x, hx0, hxa.le⟩
 
 end
 
-namespace order_iso
-
-variables [preorder α] [preorder β]
-
-@[simp] lemma comap_at_top (e : α ≃o β) : comap e at_top = at_top :=
-by simp [at_top, ← e.surjective.infi_comp]
-
-@[simp] lemma comap_at_bot (e : α ≃o β) : comap e at_bot = at_bot :=
-e.dual.comap_at_top
-
-@[simp] lemma map_at_top (e : α ≃o β) : map (e : α → β) at_top = at_top :=
-by rw [← e.comap_at_top, map_comap_of_surjective e.surjective]
-
-@[simp] lemma map_at_bot (e : α ≃o β) : map (e : α → β) at_bot = at_bot :=
-e.dual.map_at_top
-
-lemma tendsto_at_top (e : α ≃o β) : tendsto e at_top at_top :=
-e.map_at_top.le
-
-lemma tendsto_at_bot (e : α ≃o β) : tendsto e at_bot at_bot :=
-e.map_at_bot.le
-
-@[simp] lemma tendsto_at_top_iff {l : filter γ} {f : γ → α} (e : α ≃o β) :
-  tendsto (λ x, e (f x)) l at_top ↔ tendsto f l at_top :=
-by rw [← e.comap_at_top, tendsto_comap_iff]
-
-@[simp] lemma tendsto_at_bot_iff {l : filter γ} {f : γ → α} (e : α ≃o β) :
-  tendsto (λ x, e (f x)) l at_bot ↔ tendsto f l at_bot :=
-e.dual.tendsto_at_top_iff
-
-end order_iso
-
 /-- Let `g : γ → β` be an injective function and `f : β → α` be a function from the codomain of `g`
 to a commutative monoid. Suppose that `f x = 1` outside of the range of `g`. Then the filters
 `at_top.map (λ s, ∏ i in s, f (g i))` and `at_top.map (λ s, ∏ i in s, f i)` coincide.
diff --git a/src/order/filter/bases.lean b/src/order/filter/bases.lean
index 486c8b7415f61..25eba813bef2b 100644
--- a/src/order/filter/bases.lean
+++ b/src/order/filter/bases.lean
@@ -3,13 +3,16 @@ Copyright (c) 2020 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov, Johannes Hölzl, Mario Carneiro, Patrick Massot
 -/
-import order.filter.basic
+import data.prod.pprod
 import data.set.countable
-import data.pprod
+import order.filter.prod
 
 /-!
 # Filter bases
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A filter basis `B : filter_basis α` on a type `α` is a nonempty collection of sets of `α`
 such that the intersection of two elements of this collection contains some element of
 the collection. Compared to filters, filter bases do not require that any set containing
@@ -104,6 +107,10 @@ instance : inhabited (filter_basis ℕ) :=
     exact le_of_max_le_right p_in,
   end }⟩
 
+/-- View a filter as a filter basis. -/
+def filter.as_basis (f : filter α) : filter_basis α :=
+⟨f.sets, ⟨univ, univ_mem⟩, λ x y hx hy, ⟨x ∩ y, inter_mem hx hy, subset_rfl⟩⟩
+
 /-- `is_basis p s` means the image of `s` bounded by `p` is a filter basis. -/
 protected structure filter.is_basis (p : ι → Prop) (s : ι → set α) : Prop :=
 (nonempty : ∃ i, p i)
@@ -200,17 +207,12 @@ variables {l l' : filter α} {p : ι → Prop} {s : ι → set α} {t : set α}
   {p' : ι' → Prop} {s' : ι' → set α} {i' : ι'}
 
 lemma has_basis_generate (s : set (set α)) :
-  (generate s).has_basis (λ t, finite t ∧ t ⊆ s) (λ t, ⋂₀ t) :=
-⟨begin
-  intro U,
-  rw mem_generate_iff,
-  apply exists_congr,
-  tauto
-end⟩
+  (generate s).has_basis (λ t, set.finite t ∧ t ⊆ s) (λ t, ⋂₀ t) :=
+⟨λ U, by simp only [mem_generate_iff, exists_prop, and.assoc, and.left_comm]⟩
 
 /-- The smallest filter basis containing a given collection of sets. -/
 def filter_basis.of_sets (s : set (set α)) : filter_basis α :=
-{ sets := sInter '' { t | finite t ∧ t ⊆ s},
+{ sets := sInter '' { t | set.finite t ∧ t ⊆ s},
   nonempty := ⟨univ, ∅, ⟨⟨finite_empty, empty_subset s⟩, sInter_empty⟩⟩,
   inter_sets := begin
     rintros _ _ ⟨a, ⟨fina, suba⟩, rfl⟩ ⟨b, ⟨finb, subb⟩, rfl⟩,
@@ -272,7 +274,7 @@ lemma has_basis.eq_generate (h : l.has_basis p s) : l = generate { U | ∃ i, p
 by rw [← h.is_basis.filter_eq_generate, h.filter_eq]
 
 lemma generate_eq_generate_inter (s : set (set α)) :
-  generate s = generate (sInter '' { t | finite t ∧ t ⊆ s}) :=
+  generate s = generate (sInter '' { t | set.finite t ∧ t ⊆ s}) :=
 by erw [(filter_basis.of_sets s).generate, ← (has_basis_generate s).filter_eq] ; refl
 
 lemma of_sets_filter_eq_generate (s : set (set α)) : (filter_basis.of_sets s).filter = generate s :=
@@ -326,11 +328,18 @@ forall_mem_nonempty_iff_ne_bot.symm.trans $ hl.forall_iff $ λ _ _, nonempty.mon
 lemma has_basis.eq_bot_iff (hl : l.has_basis p s) :
   l = ⊥ ↔ ∃ i, p i ∧ s i = ∅ :=
 not_iff_not.1 $ ne_bot_iff.symm.trans $ hl.ne_bot_iff.trans $
-by simp only [not_exists, not_and, ← ne_empty_iff_nonempty]
+by simp only [not_exists, not_and, nonempty_iff_ne_empty]
+
+lemma generate_ne_bot_iff {s : set (set α)} :
+  ne_bot (generate s) ↔ ∀ t ⊆ s, t.finite → (⋂₀ t).nonempty :=
+(has_basis_generate s).ne_bot_iff.trans $ by simp only [← and_imp, and_comm]
 
 lemma basis_sets (l : filter α) : l.has_basis (λ s : set α, s ∈ l) id :=
 ⟨λ t, exists_mem_subset_iff.symm⟩
 
+lemma as_basis_filter (f : filter α) : f.as_basis.filter = f :=
+by ext t; exact exists_mem_subset_iff
+
 lemma has_basis_self {l : filter α} {P : set α → Prop} :
   has_basis l (λ s, s ∈ l ∧ P s) id ↔ ∀ t ∈ l, ∃ r ∈ l, P r ∧ r ⊆ t :=
 begin
@@ -338,12 +347,12 @@ begin
   exact forall_congr (λ s, ⟨λ h, h.1, λ h, ⟨h, λ ⟨t, hl, hP, hts⟩, mem_of_superset hl hts⟩⟩)
 end
 
-lemma has_basis.comp_of_surjective (h : l.has_basis p s) {g : ι' → ι} (hg : function.surjective g) :
+lemma has_basis.comp_surjective (h : l.has_basis p s) {g : ι' → ι} (hg : function.surjective g) :
   l.has_basis (p ∘ g) (s ∘ g) :=
 ⟨λ t, h.mem_iff.trans hg.exists⟩
 
 lemma has_basis.comp_equiv (h : l.has_basis p s) (e : ι' ≃ ι) : l.has_basis (p ∘ e) (s ∘ e) :=
-h.comp_of_surjective e.surjective
+h.comp_surjective e.surjective
 
 /-- If `{s i | p i}` is a basis of a filter `l` and each `s i` includes `s j` such that
 `p j ∧ q j`, then `{s j | p j ∧ q j}` is a basis of `l`. -/
@@ -408,24 +417,93 @@ lemma has_basis.inf {ι ι' : Type*} {p : ι → Prop} {s : ι → set α} {p' :
 (hl.inf' hl').to_has_basis (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)
   (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)
 
-lemma has_basis_infi {ι : Sort*} {ι' : ι → Type*} {l : ι → filter α}
+lemma has_basis_infi' {ι : Type*} {ι' : ι → Type*} {l : ι → filter α}
   {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
-  (⨅ i, l i).has_basis (λ If : set ι × Π i, ι' i, finite If.1 ∧ ∀ i ∈ If.1, p i (If.2 i))
+  (⨅ i, l i).has_basis (λ If : set ι × Π i, ι' i, If.1.finite ∧ ∀ i ∈ If.1, p i (If.2 i))
     (λ If : set ι × Π i, ι' i, ⋂ i ∈ If.1, s i (If.2 i)) :=
 ⟨begin
   intro t,
   split,
   { simp only [mem_infi', (hl _).mem_iff],
-    rintros ⟨I, hI, V, hV, -, hVt, -⟩,
+    rintros ⟨I, hI, V, hV, -, rfl, -⟩,
     choose u hu using hV,
-    refine ⟨⟨I, u⟩, ⟨hI, λ i _, (hu i).1⟩, _⟩,
-    rw hVt,
-    exact Inter_mono (λ i, Inter_mono $ λ hi, (hu i).2) },
+    exact ⟨⟨I, u⟩, ⟨hI, λ i _, (hu i).1⟩, Inter_mono (λ i, Inter_mono $ λ hi, (hu i).2)⟩ },
   { rintros ⟨⟨I, f⟩, ⟨hI₁, hI₂⟩, hsub⟩,
     refine mem_of_superset _ hsub,
     exact (bInter_mem hI₁).mpr (λ i hi, mem_infi_of_mem i $ (hl i).mem_of_mem $ hI₂ _ hi) }
 end⟩
 
+lemma has_basis_infi {ι : Type*} {ι' : ι → Type*} {l : ι → filter α}
+  {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
+  (⨅ i, l i).has_basis (λ If : Σ I : set ι, Π i : I, ι' i, If.1.finite ∧ ∀ i : If.1, p i (If.2 i))
+    (λ If, ⋂ i : If.1, s i (If.2 i)) :=
+begin
+  refine ⟨λ t, ⟨λ ht, _, _⟩⟩,
+  { rcases (has_basis_infi' hl).mem_iff.mp ht with ⟨⟨I, f⟩, ⟨hI, hf⟩, hsub⟩,
+    exact ⟨⟨I, λ i, f i⟩, ⟨hI, subtype.forall.mpr hf⟩,
+      trans_rel_right _ (Inter_subtype _ _) hsub⟩ },
+  { rintro ⟨⟨I, f⟩, ⟨hI, hf⟩, hsub⟩,
+    refine mem_of_superset _ hsub,
+    casesI hI.nonempty_fintype,
+    exact Inter_mem.2 (λ i, mem_infi_of_mem i $ (hl i).mem_of_mem $ hf _) }
+end
+
+lemma has_basis_infi_of_directed' {ι : Type*} {ι' : ι → Sort*}
+  [nonempty ι]
+  {l : ι → filter α} (s : Π i, (ι' i) → set α) (p : Π i, (ι' i) → Prop)
+  (hl : ∀ i, (l i).has_basis (p i) (s i)) (h : directed (≥) l) :
+  (⨅ i, l i).has_basis (λ (ii' : Σ i, ι' i), p ii'.1 ii'.2) (λ ii', s ii'.1 ii'.2) :=
+begin
+  refine ⟨λ t, _⟩,
+  rw [mem_infi_of_directed h, sigma.exists],
+  exact exists_congr (λ i, (hl i).mem_iff)
+end
+
+lemma has_basis_infi_of_directed {ι : Type*} {ι' : Sort*}
+  [nonempty ι]
+  {l : ι → filter α} (s : ι → ι' → set α) (p : ι → ι' → Prop)
+  (hl : ∀ i, (l i).has_basis (p i) (s i)) (h : directed (≥) l) :
+  (⨅ i, l i).has_basis (λ (ii' : ι × ι'), p ii'.1 ii'.2) (λ ii', s ii'.1 ii'.2) :=
+begin
+  refine ⟨λ t, _⟩,
+  rw [mem_infi_of_directed h, prod.exists],
+  exact exists_congr (λ i, (hl i).mem_iff)
+end
+
+lemma has_basis_binfi_of_directed' {ι : Type*} {ι' : ι → Sort*}
+  {dom : set ι} (hdom : dom.nonempty)
+  {l : ι → filter α} (s : Π i, (ι' i) → set α) (p : Π i, (ι' i) → Prop)
+  (hl : ∀ i ∈ dom, (l i).has_basis (p i) (s i)) (h : directed_on (l ⁻¹'o ge) dom) :
+  (⨅ i ∈ dom, l i).has_basis (λ (ii' : Σ i, ι' i), ii'.1 ∈ dom ∧ p ii'.1 ii'.2)
+    (λ ii', s ii'.1 ii'.2) :=
+begin
+  refine ⟨λ t, _⟩,
+  rw [mem_binfi_of_directed h hdom, sigma.exists],
+  refine exists_congr (λ i, ⟨_, _⟩),
+  { rintros ⟨hi, hti⟩,
+    rcases (hl i hi).mem_iff.mp hti with ⟨b, hb, hbt⟩,
+    exact ⟨b, ⟨hi, hb⟩, hbt⟩ },
+  { rintros ⟨b, ⟨hi, hb⟩, hibt⟩,
+    exact ⟨hi, (hl i hi).mem_iff.mpr ⟨b, hb, hibt⟩⟩ }
+end
+
+lemma has_basis_binfi_of_directed {ι : Type*} {ι' : Sort*}
+  {dom : set ι} (hdom : dom.nonempty)
+  {l : ι → filter α} (s : ι → ι' → set α) (p : ι → ι' → Prop)
+  (hl : ∀ i ∈ dom, (l i).has_basis (p i) (s i)) (h : directed_on (l ⁻¹'o ge) dom) :
+  (⨅ i ∈ dom, l i).has_basis (λ (ii' : ι × ι'), ii'.1 ∈ dom ∧ p ii'.1 ii'.2)
+    (λ ii', s ii'.1 ii'.2) :=
+begin
+  refine ⟨λ t, _⟩,
+  rw [mem_binfi_of_directed h hdom, prod.exists],
+  refine exists_congr (λ i, ⟨_, _⟩),
+  { rintros ⟨hi, hti⟩,
+    rcases (hl i hi).mem_iff.mp hti with ⟨b, hb, hbt⟩,
+    exact ⟨b, ⟨hi, hb⟩, hbt⟩ },
+  { rintros ⟨b, ⟨hi, hb⟩, hibt⟩,
+    exact ⟨hi, (hl i hi).mem_iff.mpr ⟨b, hb, hibt⟩⟩ }
+end
+
 lemma has_basis_principal (t : set α) : (𝓟 t).has_basis (λ i : unit, true) (λ i, t) :=
 ⟨λ U, by simp⟩
 
@@ -467,6 +545,10 @@ lemma has_basis.inf_principal (hl : l.has_basis p s) (s' : set α) :
 ⟨λ t, by simp only [mem_inf_principal, hl.mem_iff, subset_def, mem_set_of_eq,
   mem_inter_iff, and_imp]⟩
 
+lemma has_basis.principal_inf (hl : l.has_basis p s) (s' : set α) :
+  (𝓟 s' ⊓ l).has_basis p (λ i, s' ∩ s i) :=
+by simpa only [inf_comm, inter_comm] using hl.inf_principal s'
+
 lemma has_basis.inf_basis_ne_bot_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
   ne_bot (l ⊓ l') ↔ ∀ ⦃i⦄ (hi : p i) ⦃i'⦄ (hi' : p' i'), (s i ∩ s' i').nonempty :=
 (hl.inf' hl').ne_bot_iff.trans $ by simp [@forall_swap _ ι']
@@ -479,10 +561,35 @@ lemma has_basis.inf_principal_ne_bot_iff (hl : l.has_basis p s) {t : set α} :
   ne_bot (l ⊓ 𝓟 t) ↔ ∀ ⦃i⦄ (hi : p i), (s i ∩ t).nonempty :=
 (hl.inf_principal t).ne_bot_iff
 
-lemma has_basis.disjoint_basis_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
+lemma has_basis.disjoint_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
   disjoint l l' ↔ ∃ i (hi : p i) i' (hi' : p' i'), disjoint (s i) (s' i') :=
 not_iff_not.mp $ by simp only [disjoint_iff, ← ne.def, ← ne_bot_iff, hl.inf_basis_ne_bot_iff hl',
-  not_exists, bot_eq_empty, ne_empty_iff_nonempty, inf_eq_inter]
+  not_exists, bot_eq_empty, ←nonempty_iff_ne_empty, inf_eq_inter]
+
+lemma _root_.disjoint.exists_mem_filter_basis (h : disjoint l l') (hl : l.has_basis p s)
+  (hl' : l'.has_basis p' s') :
+  ∃ i (hi : p i) i' (hi' : p' i'), disjoint (s i) (s' i') :=
+(hl.disjoint_iff hl').1 h
+
+lemma _root_.pairwise.exists_mem_filter_basis_of_disjoint {I : Type*} [finite I]
+  {l : I → filter α} {ι : I → Sort*} {p : Π i, ι i → Prop} {s : Π i, ι i → set α}
+  (hd : pairwise (disjoint on l)) (h : ∀ i, (l i).has_basis (p i) (s i)) :
+  ∃ ind : Π i, ι i, (∀ i, p i (ind i)) ∧ pairwise (disjoint on λ i, s i (ind i)) :=
+begin
+  rcases hd.exists_mem_filter_of_disjoint with ⟨t, htl, hd⟩,
+  choose ind hp ht using λ i, (h i).mem_iff.1 (htl i),
+  exact ⟨ind, hp, hd.mono $ λ i j hij, hij.mono (ht _) (ht _)⟩
+end
+
+lemma _root_.set.pairwise_disjoint.exists_mem_filter_basis {I : Type*} {l : I → filter α}
+  {ι : I → Sort*} {p : Π i, ι i → Prop} {s : Π i, ι i → set α} {S : set I}
+  (hd : S.pairwise_disjoint l) (hS : S.finite) (h : ∀ i, (l i).has_basis (p i) (s i)) :
+  ∃ ind : Π i, ι i, (∀ i, p i (ind i)) ∧ S.pairwise_disjoint (λ i, s i (ind i)) :=
+begin
+  rcases hd.exists_mem_filter hS with ⟨t, htl, hd⟩,
+  choose ind hp ht using λ i, (h i).mem_iff.1 (htl i),
+  exact ⟨ind, hp, hd.mono ht⟩
+end
 
 lemma inf_ne_bot_iff :
   ne_bot (l ⊓ l') ↔ ∀ ⦃s : set α⦄ (hs : s ∈ l) ⦃s'⦄ (hs' : s' ∈ l'), (s ∩ s').nonempty :=
@@ -496,7 +603,7 @@ lemma mem_iff_inf_principal_compl {f : filter α} {s : set α} :
   s ∈ f ↔ f ⊓ 𝓟 sᶜ = ⊥ :=
 begin
   refine not_iff_not.1 ((inf_principal_ne_bot_iff.trans _).symm.trans ne_bot_iff),
-  exact ⟨λ h hs, by simpa [empty_not_nonempty] using h s hs,
+  exact ⟨λ h hs, by simpa [not_nonempty_empty] using h s hs,
     λ hs t ht, inter_compl_nonempty_iff.2 $ λ hts, hs $ mem_of_superset ht hts⟩,
 end
 
@@ -514,14 +621,27 @@ by rw [disjoint.comm, disjoint_principal_right]
 
 @[simp] lemma disjoint_principal_principal {s t : set α} :
   disjoint (𝓟 s) (𝓟 t) ↔ disjoint s t :=
-by simp [disjoint_iff_subset_compl_left]
+by simp [←subset_compl_iff_disjoint_left]
 
-alias disjoint_principal_principal ↔ _ disjoint.filter_principal
+alias disjoint_principal_principal ↔ _ _root_.disjoint.filter_principal
 
 @[simp] lemma disjoint_pure_pure {x y : α} :
   disjoint (pure x : filter α) (pure y) ↔ x ≠ y :=
 by simp only [← principal_singleton, disjoint_principal_principal, disjoint_singleton]
 
+@[simp] lemma compl_diagonal_mem_prod {l₁ l₂ : filter α} :
+  (diagonal α)ᶜ ∈ l₁ ×ᶠ l₂ ↔ disjoint l₁ l₂ :=
+by simp only [mem_prod_iff, filter.disjoint_iff, prod_subset_compl_diagonal_iff_disjoint]
+
+lemma has_basis.disjoint_iff_left (h : l.has_basis p s) :
+  disjoint l l' ↔ ∃ i (hi : p i), (s i)ᶜ ∈ l' :=
+by simp only [h.disjoint_iff l'.basis_sets, exists_prop, id, ← disjoint_principal_left,
+  (has_basis_principal _).disjoint_iff l'.basis_sets, unique.exists_iff]
+
+lemma has_basis.disjoint_iff_right (h : l.has_basis p s) :
+  disjoint l' l ↔ ∃ i (hi : p i), (s i)ᶜ ∈ l' :=
+disjoint.comm.trans h.disjoint_iff_left
+
 lemma le_iff_forall_inf_principal_compl {f g : filter α} :
   f ≤ g ↔ ∀ V ∈ g, f ⊓ 𝓟 Vᶜ = ⊥ :=
 forall₂_congr $ λ _ _, mem_iff_inf_principal_compl
@@ -553,7 +673,7 @@ end⟩
 /-- If `s : ι → set α` is an indexed family of sets, then finite intersections of `s i` form a basis
 of `⨅ i, 𝓟 (s i)`.  -/
 lemma has_basis_infi_principal_finite {ι : Type*} (s : ι → set α) :
-  (⨅ i, 𝓟 (s i)).has_basis (λ t : set ι, finite t) (λ t, ⋂ i ∈ t, s i) :=
+  (⨅ i, 𝓟 (s i)).has_basis (λ t : set ι, t.finite) (λ t, ⋂ i ∈ t, s i) :=
 begin
   refine ⟨λ U, (mem_infi_finite _).trans _⟩,
   simp only [infi_principal_finset, mem_Union, mem_principal, exists_prop,
@@ -595,36 +715,26 @@ lemma comap_has_basis (f : α → β) (l : filter β) :
   has_basis (comap f l) (λ s : set β, s ∈ l) (λ s, f ⁻¹' s) :=
 ⟨λ t, mem_comap⟩
 
-lemma has_basis.prod_self (hl : l.has_basis p s) :
-  (l ×ᶠ l).has_basis p (λ i, s i ×ˢ s i) :=
-⟨begin
-  intro t,
-  apply mem_prod_iff.trans,
-  split,
-  { rintros ⟨t₁, ht₁, t₂, ht₂, H⟩,
-    rcases hl.mem_iff.1 (inter_mem ht₁ ht₂) with ⟨i, hi, ht⟩,
-    exact ⟨i, hi, λ p ⟨hp₁, hp₂⟩, H ⟨(ht hp₁).1, (ht hp₂).2⟩⟩ },
-  { rintros ⟨i, hi, H⟩,
-    exact ⟨s i, hl.mem_of_mem hi, s i, hl.mem_of_mem hi, H⟩ }
-end⟩
-
-lemma mem_prod_self_iff {s} : s ∈ l ×ᶠ l ↔ ∃ t ∈ l, t ×ˢ t ⊆ s :=
-l.basis_sets.prod_self.mem_iff
-
-lemma has_basis.sInter_sets (h : has_basis l p s) :
-  ⋂₀ l.sets = ⋂ i (hi : p i), s i :=
+lemma has_basis.forall_mem_mem (h : has_basis l p s) {x : α} :
+  (∀ t ∈ l, x ∈ t) ↔ ∀ i, p i → x ∈ s i :=
 begin
-  ext x,
-  suffices : (∀ t ∈ l, x ∈ t) ↔ ∀ i, p i → x ∈ s i,
-    by simpa only [mem_Inter, mem_set_of_eq, mem_sInter],
-  simp_rw h.mem_iff,
-  split,
-  { intros h i hi,
-    exact h (s i) ⟨i, hi, subset.refl _⟩ },
-  { rintros h _ ⟨i, hi, sub⟩,
-    exact sub (h i hi) },
+  simp only [h.mem_iff, exists_imp_distrib],
+  exact ⟨λ h i hi, h (s i) i hi subset.rfl, λ h t i hi ht, ht (h i hi)⟩
 end
 
+protected lemma has_basis.binfi_mem [complete_lattice β] {f : set α → β} (h : has_basis l p s)
+  (hf : monotone f) :
+  (⨅ t ∈ l, f t) = ⨅ i (hi : p i), f (s i) :=
+le_antisymm (le_infi₂ $ λ i hi, infi₂_le (s i) (h.mem_of_mem hi)) $
+  le_infi₂ $ λ t ht, let ⟨i, hpi, hi⟩ := h.mem_iff.1 ht in infi₂_le_of_le i hpi (hf hi)
+
+protected lemma has_basis.bInter_mem {f : set α → set β} (h : has_basis l p s) (hf : monotone f) :
+  (⋂ t ∈ l, f t) = ⋂ i (hi : p i), f (s i) :=
+h.binfi_mem hf
+
+lemma has_basis.sInter_sets (h : has_basis l p s) : ⋂₀ l.sets = ⋂ i (hi : p i), s i :=
+by { rw [sInter_eq_bInter], exact h.bInter_mem monotone_id }
+
 variables {ι'' : Type*} [preorder ι''] (l) (s'' : ι'' → set α)
 
 /-- `is_antitone_basis s` means the image of `s` is a filter basis such that `s` is decreasing. -/
@@ -637,6 +747,11 @@ includes `s i` for some `i`, and `s` is decreasing. -/
   extends has_basis l (λ _, true) s : Prop :=
 (antitone : antitone s)
 
+lemma has_antitone_basis.map {l : filter α} {s : ι'' → set α} {m : α → β}
+  (hf : has_antitone_basis l s) :
+  has_antitone_basis (map m l) (λ n, m '' s n) :=
+⟨has_basis.map _ hf.to_has_basis, λ i j hij, image_subset _ $ hf.2 hij⟩
+
 end same_type
 
 section two_types
@@ -669,7 +784,7 @@ lemma tendsto.basis_both (H : tendsto f la lb) (hla : la.has_basis pa sa)
   ∀ ib (hib : pb ib), ∃ ia (hia : pa ia), ∀ x ∈ sa ia, f x ∈ sb ib :=
 (hla.tendsto_iff hlb).1 H
 
-lemma has_basis.prod'' (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
+lemma has_basis.prod_pprod (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
   (la ×ᶠ lb).has_basis (λ i : pprod ι ι', pa i.1 ∧ pb i.2) (λ i, sa i.1 ×ˢ sb i.2) :=
 (hla.comap prod.fst).inf' (hlb.comap prod.snd)
 
@@ -678,13 +793,12 @@ lemma has_basis.prod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α} {p
   (la ×ᶠ lb).has_basis (λ i : ι × ι', pa i.1 ∧ pb i.2) (λ i, sa i.1 ×ˢ sb i.2) :=
 (hla.comap prod.fst).inf (hlb.comap prod.snd)
 
-lemma has_basis.prod' {la : filter α} {lb : filter β} {ι : Type*} {p : ι → Prop}
-  {sa : ι → set α} {sb : ι → set β}
+lemma has_basis.prod_same_index {p : ι → Prop} {sb : ι → set β}
   (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
   (h_dir : ∀ {i j}, p i → p j → ∃ k, p k ∧ sa k ⊆ sa i ∧ sb k ⊆ sb j) :
   (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
 begin
-  simp only [has_basis_iff, (hla.prod hlb).mem_iff],
+  simp only [has_basis_iff, (hla.prod_pprod hlb).mem_iff],
   refine λ t, ⟨_, _⟩,
   { rintros ⟨⟨i, j⟩, ⟨hi, hj⟩, hsub : sa i ×ˢ sb j ⊆ t⟩,
     rcases h_dir hi hj with ⟨k, hk, ki, kj⟩,
@@ -693,18 +807,34 @@ begin
     exact ⟨⟨i, i⟩, ⟨hi, hi⟩, h⟩ },
 end
 
-lemma has_antitone_basis.prod {f : filter α} {g : filter β}
-  {s : ℕ → set α} {t : ℕ → set β} (hf : has_antitone_basis f s) (hg : has_antitone_basis g t) :
+lemma has_basis.prod_same_index_mono {ι : Type*} [linear_order ι]
+  {p : ι → Prop} {sa : ι → set α} {sb : ι → set β}
+  (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
+  (hsa : monotone_on sa {i | p i}) (hsb : monotone_on sb {i | p i}) :
+  (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
+hla.prod_same_index hlb $ λ i j hi hj,
+  have p (min i j), from min_rec' _ hi hj,
+  ⟨min i j, this, hsa this hi $ min_le_left _ _, hsb this hj $ min_le_right _ _⟩
+
+lemma has_basis.prod_same_index_anti {ι : Type*} [linear_order ι]
+  {p : ι → Prop} {sa : ι → set α} {sb : ι → set β}
+  (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
+  (hsa : antitone_on sa {i | p i}) (hsb : antitone_on sb {i | p i}) :
+  (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
+@has_basis.prod_same_index_mono _ _ _ _ ιᵒᵈ _ _ _ _  hla hlb hsa.dual_left hsb.dual_left
+
+lemma has_basis.prod_self (hl : la.has_basis pa sa) :
+  (la ×ᶠ la).has_basis pa (λ i, sa i ×ˢ sa i) :=
+hl.prod_same_index hl $ λ i j hi hj, by simpa only [exists_prop, subset_inter_iff]
+  using hl.mem_iff.1 (inter_mem (hl.mem_of_mem hi) (hl.mem_of_mem hj))
+
+lemma mem_prod_self_iff {s} : s ∈ la ×ᶠ la ↔ ∃ t ∈ la, t ×ˢ t ⊆ s :=
+la.basis_sets.prod_self.mem_iff
+
+lemma has_antitone_basis.prod {ι : Type*} [linear_order ι] {f : filter α} {g : filter β}
+  {s : ι → set α} {t : ι → set β} (hf : has_antitone_basis f s) (hg : has_antitone_basis g t) :
   has_antitone_basis (f ×ᶠ g) (λ n, s n ×ˢ t n) :=
-begin
-  have h : has_basis (f ×ᶠ g) _ _ := has_basis.prod' hf.to_has_basis hg.to_has_basis _,
-  swap,
-  { intros i j,
-    simp only [true_and, forall_true_left],
-    exact ⟨max i j, hf.antitone (le_max_left _ _), hg.antitone (le_max_right _ _)⟩, },
-  refine ⟨h, λ n m hn_le_m, set.prod_mono _ _⟩,
-  exacts [hf.antitone hn_le_m, hg.antitone hn_le_m]
-end
+⟨hf.1.prod_same_index_anti hg.1 (hf.2.antitone_on _) (hg.2.antitone_on _), hf.2.set_prod hg.2⟩
 
 lemma has_basis.coprod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α} {pb : ι' → Prop}
   {sb : ι' → set β} (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
@@ -714,14 +844,14 @@ lemma has_basis.coprod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α}
 
 end two_types
 
-open equiv
-
-lemma prod_assoc (f : filter α) (g : filter β) (h : filter γ) :
-  map (prod_assoc α β γ) ((f ×ᶠ g) ×ᶠ h) = f ×ᶠ (g ×ᶠ h) :=
+lemma map_sigma_mk_comap {π : α → Type*} {π' : β → Type*} {f : α → β}
+  (hf : function.injective f) (g : Π a, π a → π' (f a)) (a : α) (l : filter (π' (f a))) :
+  map (sigma.mk a) (comap (g a) l) = comap (sigma.map f g) (map (sigma.mk (f a)) l) :=
 begin
-  apply ((((basis_sets f).prod $ basis_sets g).prod $ basis_sets h).map _).eq_of_same_basis,
-  simpa only [prod_assoc_image, function.comp, and_assoc] using
-    ((basis_sets f).prod $ (basis_sets g).prod $ basis_sets h).comp_equiv (prod_assoc _ _ _)
+  refine (((basis_sets _).comap _).map _).eq_of_same_basis _,
+  convert ((basis_sets _).map _).comap _,
+  ext1 s,
+  apply image_sigma_mk_preimage_sigma_map hf
 end
 
 end filter
@@ -730,28 +860,28 @@ end sort
 
 namespace filter
 
-variables {α β γ ι ι' : Type*}
+variables {α β γ ι : Type*} {ι' : Sort*}
 
 /-- `is_countably_generated f` means `f = generate s` for some countable `s`. -/
 class is_countably_generated (f : filter α) : Prop :=
-(out [] : ∃ s : set (set α), countable s ∧ f = generate s)
+(out [] : ∃ s : set (set α), s.countable ∧ f = generate s)
 
 /-- `is_countable_basis p s` means the image of `s` bounded by `p` is a countable filter basis. -/
 structure is_countable_basis (p : ι → Prop) (s : ι → set α) extends is_basis p s : Prop :=
-(countable : countable $ set_of p)
+(countable : (set_of p).countable)
 
 /-- We say that a filter `l` has a countable basis `s : ι → set α` bounded by `p : ι → Prop`,
 if `t ∈ l` if and only if `t` includes `s i` for some `i` such that `p i`, and the set
 defined by `p` is countable. -/
 structure has_countable_basis (l : filter α) (p : ι → Prop) (s : ι → set α)
   extends has_basis l p s : Prop :=
-(countable : countable $ set_of p)
+(countable : (set_of p).countable)
 
 /-- A countable filter basis `B` on a type `α` is a nonempty countable collection of sets of `α`
 such that the intersection of two elements of this collection contains some element
 of the collection. -/
 structure countable_filter_basis (α : Type*) extends filter_basis α :=
-(countable : countable sets)
+(countable : sets.countable)
 
 -- For illustration purposes, the countable filter basis defining (at_top : filter ℕ)
 instance nat.inhabited_countable_filter_basis : inhabited (countable_filter_basis ℕ) :=
@@ -774,19 +904,12 @@ begin
   { apply infi_le_of_le i _, rw principal_mono, intro a, simp, intro h, apply h, refl },
 end
 
-lemma countable_binfi_eq_infi_seq [complete_lattice α] {B : set ι} (Bcbl : countable B)
+lemma countable_binfi_eq_infi_seq [complete_lattice α] {B : set ι} (Bcbl : B.countable)
   (Bne : B.nonempty) (f : ι → α) :
   ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
-begin
-  rw countable_iff_exists_surjective_to_subtype Bne at Bcbl,
-  rcases Bcbl with ⟨g, gsurj⟩,
-  rw infi_subtype',
-  use (λ n, g n), apply le_antisymm; rw le_infi_iff,
-  { intro i, apply infi_le_of_le (g i) _, apply le_rfl },
-  { intros a, rcases gsurj a with ⟨i, rfl⟩, apply infi_le }
-end
+let ⟨g, hg⟩ := Bcbl.exists_eq_range Bne in ⟨g, hg.symm ▸ infi_range⟩
 
-lemma countable_binfi_eq_infi_seq' [complete_lattice α] {B : set ι} (Bcbl : countable B) (f : ι → α)
+lemma countable_binfi_eq_infi_seq' [complete_lattice α] {B : set ι} (Bcbl : B.countable) (f : ι → α)
   {i₀ : ι} (h : f i₀ = ⊤) :
   ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
 begin
@@ -797,31 +920,41 @@ begin
   { exact countable_binfi_eq_infi_seq Bcbl Bnonempty f }
 end
 
-lemma countable_binfi_principal_eq_seq_infi {B : set (set α)} (Bcbl : countable B) :
+lemma countable_binfi_principal_eq_seq_infi {B : set (set α)} (Bcbl : B.countable) :
   ∃ (x : ℕ → set α), (⨅ t ∈ B, 𝓟 t) = ⨅ i, 𝓟 (x i) :=
 countable_binfi_eq_infi_seq' Bcbl 𝓟 principal_univ
 
 section is_countably_generated
 
+protected lemma has_antitone_basis.mem_iff [preorder ι] {l : filter α} {s : ι → set α}
+  (hs : l.has_antitone_basis s) {t : set α} : t ∈ l ↔ ∃ i, s i ⊆ t :=
+hs.to_has_basis.mem_iff.trans $ by simp only [exists_prop, true_and]
+
 protected lemma has_antitone_basis.mem [preorder ι] {l : filter α} {s : ι → set α}
   (hs : l.has_antitone_basis s) (i : ι) : s i ∈ l :=
 hs.to_has_basis.mem_of_mem trivial
 
+lemma has_antitone_basis.has_basis_ge [preorder ι] [is_directed ι (≤)] {l : filter α}
+  {s : ι → set α} (hs : l.has_antitone_basis s) (i : ι) :
+  l.has_basis (λ j, i ≤ j) s :=
+hs.1.to_has_basis (λ j _, (exists_ge_ge i j).imp $ λ k hk, ⟨hk.1, hs.2 hk.2⟩)
+  (λ j hj, ⟨j, trivial, subset.rfl⟩)
+
 /-- If `f` is countably generated and `f.has_basis p s`, then `f` admits a decreasing basis
 enumerated by natural numbers such that all sets have the form `s i`. More precisely, there is a
 sequence `i n` such that `p (i n)` for all `n` and `s (i n)` is a decreasing sequence of sets which
 forms a basis of `f`-/
 lemma has_basis.exists_antitone_subbasis {f : filter α} [h : f.is_countably_generated]
-  {p : ι → Prop} {s : ι → set α} (hs : f.has_basis p s) :
-  ∃ x : ℕ → ι, (∀ i, p (x i)) ∧ f.has_antitone_basis (λ i, s (x i)) :=
+  {p : ι' → Prop} {s : ι' → set α} (hs : f.has_basis p s) :
+  ∃ x : ℕ → ι', (∀ i, p (x i)) ∧ f.has_antitone_basis (λ i, s (x i)) :=
 begin
   obtain ⟨x', hx'⟩ : ∃ x : ℕ → set α, f = ⨅ i, 𝓟 (x i),
   { unfreezingI { rcases h with ⟨s, hsc, rfl⟩ },
     rw generate_eq_binfi,
     exact countable_binfi_principal_eq_seq_infi hsc },
   have : ∀ i, x' i ∈ f := λ i, hx'.symm ▸ (infi_le (λ i, 𝓟 (x' i)) i) (mem_principal_self _),
-  let x : ℕ → {i : ι // p i} := λ n, nat.rec_on n (hs.index _ $ this 0)
-    (λ n xn, (hs.index _ $ inter_mem (this $ n + 1) (hs.mem_of_mem xn.coe_prop))),
+  let x : ℕ → {i : ι' // p i} := λ n, nat.rec_on n (hs.index _ $ this 0)
+    (λ n xn, (hs.index _ $ inter_mem (this $ n + 1) (hs.mem_of_mem xn.2))),
   have x_mono : antitone (λ i, s (x i)),
   { refine antitone_nat_of_succ_le (λ i, _),
     exact (hs.set_index_subset _).trans (inter_subset_right _ _) },
@@ -854,13 +987,18 @@ begin
   rcases f.exists_antitone_basis with ⟨s, hs⟩,
   rcases g.exists_antitone_basis with ⟨t, ht⟩,
   exact has_countable_basis.is_countably_generated
-    ⟨hs.to_has_basis.inf ht.to_has_basis, set.countable_encodable _⟩
+    ⟨hs.to_has_basis.inf ht.to_has_basis, set.to_countable _⟩
 end
 
+instance map.is_countably_generated (l : filter α) [l.is_countably_generated] (f : α → β) :
+  (map f l).is_countably_generated :=
+let ⟨x, hxl⟩ := l.exists_antitone_basis in
+has_countable_basis.is_countably_generated ⟨hxl.map.to_has_basis, to_countable _⟩
+
 instance comap.is_countably_generated (l : filter β) [l.is_countably_generated] (f : α → β) :
   (comap f l).is_countably_generated :=
 let ⟨x, hxl⟩ := l.exists_antitone_basis in
-has_countable_basis.is_countably_generated ⟨hxl.to_has_basis.comap _, countable_encodable _⟩
+has_countable_basis.is_countably_generated ⟨hxl.to_has_basis.comap _, to_countable _⟩
 
 instance sup.is_countably_generated (f g : filter α) [is_countably_generated f]
   [is_countably_generated g] :
@@ -869,12 +1007,20 @@ begin
   rcases f.exists_antitone_basis with ⟨s, hs⟩,
   rcases g.exists_antitone_basis with ⟨t, ht⟩,
   exact has_countable_basis.is_countably_generated
-    ⟨hs.to_has_basis.sup ht.to_has_basis, set.countable_encodable _⟩
+    ⟨hs.to_has_basis.sup ht.to_has_basis, set.to_countable _⟩
 end
 
+instance prod.is_countably_generated (la : filter α) (lb : filter β) [is_countably_generated la]
+  [is_countably_generated lb] : is_countably_generated (la ×ᶠ lb) :=
+filter.inf.is_countably_generated _ _
+
+instance coprod.is_countably_generated (la : filter α) (lb : filter β) [is_countably_generated la]
+  [is_countably_generated lb] : is_countably_generated (la.coprod lb) :=
+filter.sup.is_countably_generated _ _
+
 end is_countably_generated
 
-@[instance] lemma is_countably_generated_seq [encodable β] (x : β → set α) :
+lemma is_countably_generated_seq [countable β] (x : β → set α) :
   is_countably_generated (⨅ i, 𝓟 $ x i) :=
 begin
   use [range x, countable_range x],
@@ -885,7 +1031,7 @@ lemma is_countably_generated_of_seq {f : filter α} (h : ∃ x : ℕ → set α,
   f.is_countably_generated  :=
 let ⟨x, h⟩ := h in by rw h ; apply is_countably_generated_seq
 
-lemma is_countably_generated_binfi_principal {B : set $ set α} (h : countable B) :
+lemma is_countably_generated_binfi_principal {B : set $ set α} (h : B.countable) :
   is_countably_generated (⨅ (s ∈ B), 𝓟 s) :=
 is_countably_generated_of_seq (countable_binfi_principal_eq_seq_infi h)
 
@@ -911,14 +1057,17 @@ by { rw ← principal_singleton, exact is_countably_generated_principal _, }
 @[instance] lemma is_countably_generated_top : is_countably_generated (⊤ : filter α) :=
 @principal_univ α ▸ is_countably_generated_principal _
 
-instance is_countably_generated.prod {f : filter α} {g : filter β}
-  [hf : f.is_countably_generated] [hg : g.is_countably_generated] :
-  is_countably_generated (f ×ᶠ g) :=
+instance infi.is_countably_generated {ι : Sort*} [countable ι] (f : ι → filter α)
+  [∀ i, is_countably_generated (f i)] : is_countably_generated (⨅ i, f i) :=
 begin
-  simp_rw is_countably_generated_iff_exists_antitone_basis at hf hg ⊢,
-  rcases hf with ⟨s, hs⟩,
-  rcases hg with ⟨t, ht⟩,
-  refine ⟨_, hs.prod ht⟩,
+  choose s hs using λ i, exists_antitone_basis (f i),
+  rw [← plift.down_surjective.infi_comp],
+  refine has_countable_basis.is_countably_generated
+    ⟨has_basis_infi (λ n, (hs _).to_has_basis), _⟩,
+  refine (countable_range $ sigma.map (coe : finset (plift ι) → set (plift ι)) (λ _, id)).mono _,
+  rintro ⟨I, f⟩ ⟨hI, -⟩,
+  lift I to finset (plift ι) using hI,
+  exact ⟨⟨I, f⟩, rfl⟩
 end
 
 end filter
diff --git a/src/order/filter/basic.lean b/src/order/filter/basic.lean
index 748cf89a8400b..25f4b46a07e7b 100644
--- a/src/order/filter/basic.lean
+++ b/src/order/filter/basic.lean
@@ -11,11 +11,14 @@ import tactic.monotonicity
 /-!
 # Theory of filters on sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `filter` : filters on a set;
 * `at_top`, `at_bot`, `cofinite`, `principal` : specific filters;
-* `map`, `comap`, `prod` : operations on filters;
+* `map`, `comap` : operations on filters;
 * `tendsto` : limit with respect to filters;
 * `eventually` : `f.eventually p` means `{x | p x} ∈ f`;
 * `frequently` : `f.frequently p` means `{x | ¬p x} ∉ f`;
@@ -39,7 +42,6 @@ the smallest filter containing it in the other direction.
 We also prove `filter` is a monadic functor, with a push-forward operation
 `filter.map` and a pull-back operation `filter.comap` that form a Galois connections for the
 order on filters.
-Finally we describe a product operation `filter X → filter Y → filter (X × Y)`.
 
 The examples of filters appearing in the description of the two motivating ideas are:
 * `(at_top : filter ℕ)` : made of sets of `ℕ` containing `{n | n ≥ N}` for some `N`
@@ -66,7 +68,6 @@ which is a special case of `mem_closure_of_tendsto` from topology.basic.
 * `∃ᶠ x in f, p x` : `f.frequently p`;
 * `f =ᶠ[l] g` : `∀ᶠ x in l, f x = g x`;
 * `f ≤ᶠ[l] g` : `∀ᶠ x in l, f x ≤ g x`;
-* `f ×ᶠ g` : `filter.prod f g`, localized in `filter`;
 * `𝓟 s` : `principal s`, localized in `filter`.
 
 ## References
@@ -150,7 +151,7 @@ lemma congr_sets (h : {x | x ∈ s ↔ x ∈ t} ∈ f) : s ∈ f ↔ t ∈ f :=
 ⟨λ hs, mp_mem hs (mem_of_superset h (λ x, iff.mp)),
  λ hs, mp_mem hs (mem_of_superset h (λ x, iff.mpr))⟩
 
-@[simp] lemma bInter_mem {β : Type v} {s : β → set α} {is : set β} (hf : finite is) :
+@[simp] lemma bInter_mem {β : Type v} {s : β → set α} {is : set β} (hf : is.finite) :
   (⋂ i ∈ is, s i) ∈ f ↔ ∀ i ∈ is, s i ∈ f :=
 finite.induction_on hf (by simp) (λ i s hi _ hs, by simp [hs])
 
@@ -158,14 +159,14 @@ finite.induction_on hf (by simp) (λ i s hi _ hs, by simp [hs])
   (⋂ i ∈ is, s i) ∈ f ↔ ∀ i ∈ is, s i ∈ f :=
 bInter_mem is.finite_to_set
 
-alias bInter_finset_mem ← finset.Inter_mem_sets
+alias bInter_finset_mem ← _root_.finset.Inter_mem_sets
 attribute [protected] finset.Inter_mem_sets
 
-@[simp] lemma sInter_mem {s : set (set α)} (hfin : finite s) :
+@[simp] lemma sInter_mem {s : set (set α)} (hfin : s.finite) :
   ⋂₀ s ∈ f ↔ ∀ U ∈ s, U ∈ f :=
 by rw [sInter_eq_bInter, bInter_mem hfin]
 
-@[simp] lemma Inter_mem {β : Type v} {s : β → set α} [fintype β] :
+@[simp] lemma Inter_mem {β : Type v} {s : β → set α} [finite β] :
   (⋂ i, s i) ∈ f ↔ ∀ i, s i ∈ f :=
 by simpa using bInter_mem finite_univ
 
@@ -233,7 +234,7 @@ add_tactic_doc
 end tactic.interactive
 
 namespace filter
-variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}
+variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type*} {ι : Sort x}
 
 section principal
 
@@ -244,10 +245,7 @@ def principal (s : set α) : filter α :=
   sets_of_superset := λ x y hx, subset.trans hx,
   inter_sets       := λ x y, subset_inter }
 
-localized "notation `𝓟` := filter.principal" in filter
-
-instance : inhabited (filter α) :=
-⟨𝓟 ∅⟩
+localized "notation (name := filter.principal) `𝓟` := filter.principal" in filter
 
 @[simp] lemma mem_principal {s t : set α} : s ∈ 𝓟 t ↔ t ⊆ s := iff.rfl
 
@@ -274,6 +272,7 @@ def join (f : filter (filter α)) : filter α :=
 end join
 
 section lattice
+variables {f g : filter α} {s t : set α}
 
 instance : partial_order (filter α) :=
 { le            := λ f g, ∀ ⦃U : set α⦄, U ∈ g → U ∈ f,
@@ -281,7 +280,9 @@ instance : partial_order (filter α) :=
   le_refl       := λ a, subset.rfl,
   le_trans      := λ a b c h₁ h₂, subset.trans h₂ h₁ }
 
-theorem le_def {f g : filter α} : f ≤ g ↔ ∀ x ∈ g, x ∈ f := iff.rfl
+theorem le_def : f ≤ g ↔ ∀ x ∈ g, x ∈ f := iff.rfl
+
+protected lemma not_le : ¬ f ≤ g ↔ ∃ s ∈ g, s ∉ f := by simp_rw [le_def, not_forall]
 
 /-- `generate_sets g s`: `s` is in the filter closure of `g`. -/
 inductive generate_sets (g : set (set α)) : set α → Prop
@@ -305,34 +306,22 @@ iff.intro
     (λ x y _ _ hx hy, inter_mem hx hy))
 
 lemma mem_generate_iff {s : set $ set α} {U : set α} :
-  U ∈ generate s ↔ ∃ t ⊆ s, finite t ∧ ⋂₀ t ⊆ U :=
+  U ∈ generate s ↔ ∃ t ⊆ s, set.finite t ∧ ⋂₀ t ⊆ U :=
 begin
   split ; intro h,
-  { induction h with V V_in V W V_in hVW hV V W V_in W_in hV hW,
-    { use {V},
-      simp [V_in] },
-    { use ∅,
-      simp [subset.refl, univ] },
-    { rcases hV with ⟨t, hts, htfin, hinter⟩,
-      exact ⟨t, hts, htfin, hinter.trans hVW⟩ },
-    { rcases hV with ⟨t, hts, htfin, htinter⟩,
-      rcases hW with ⟨z, hzs, hzfin, hzinter⟩,
-      refine ⟨t ∪ z, union_subset hts hzs, htfin.union hzfin, _⟩,
-      rw sInter_union,
-      exact inter_subset_inter htinter hzinter } },
-  { rcases h with ⟨t, ts, tfin, h⟩,
-    apply generate_sets.superset _ h,
-    revert ts,
-    apply finite.induction_on tfin,
-    { intro h,
-      rw sInter_empty,
-      exact generate_sets.univ },
-    { intros V r hV rfin hinter h,
-      cases insert_subset.mp h with V_in r_sub,
-      rw [insert_eq V r, sInter_union],
-      apply generate_sets.inter _ (hinter r_sub),
-      rw sInter_singleton,
-      exact generate_sets.basic V_in } },
+  { induction h,
+    case basic : V V_in
+    { exact ⟨{V}, singleton_subset_iff.2 V_in, finite_singleton _, (sInter_singleton _).subset⟩ },
+    case univ { exact ⟨∅, empty_subset _, finite_empty, subset_univ _⟩ },
+    case superset : V W hV' hVW hV
+    { rcases hV with ⟨t, hts, ht, htV⟩,
+      exact ⟨t, hts, ht, htV.trans hVW⟩ },
+    case inter : V W hV' hW' hV hW
+    { rcases ⟨hV, hW⟩ with ⟨⟨t, hts, ht, htV⟩, u, hus, hu, huW⟩,
+      exact ⟨t ∪ u, union_subset hts hus, ht.union hu,
+        (sInter_union _ _).subset.trans $ inter_subset_inter htV huW⟩ } },
+  { rcases h with ⟨t, hts, tfin, h⟩,
+    exact mem_of_superset ((sInter_mem tfin).2 $ λ V hV, generate_sets.basic $ hts hV) h },
 end
 
 /-- `mk_of_closure s hs` constructs a filter on `α` whose elements set is exactly
@@ -440,6 +429,8 @@ instance : complete_lattice (filter α) := original_complete_lattice.copy
     (set.ext_iff.1 (sInter_image _ _) x).symm})
   /- Inf -/ _ rfl
 
+instance : inhabited (filter α) := ⟨⊥⟩
+
 end complete_lattice
 
 /-- A filter is `ne_bot` if it is not equal to `⊥`, or equivalently the empty set
@@ -464,6 +455,8 @@ hf.mono hg
 @[simp] lemma sup_ne_bot {f g : filter α} : ne_bot (f ⊔ g) ↔ ne_bot f ∨ ne_bot g :=
 by simp [ne_bot_iff, not_and_distrib]
 
+lemma not_disjoint_self_iff : ¬ disjoint f f ↔ f.ne_bot := by rw [disjoint_self, ne_bot_iff]
+
 lemma bot_sets_eq : (⊥ : filter α).sets = univ := rfl
 
 lemma sup_sets_eq {f g : filter α} : (f ⊔ g).sets = f.sets ∩ g.sets :=
@@ -517,7 +510,7 @@ show generate _ = generate _, from congr_arg _ $ congr_arg Sup $ (range_comp _ _
 lemma mem_infi_of_mem {f : ι → filter α} (i : ι) : ∀ {s}, s ∈ f i → s ∈ ⨅ i, f i :=
 show (⨅ i, f i) ≤ f i, from infi_le _ _
 
-lemma mem_infi_of_Inter {ι} {s : ι → filter α} {U : set α} {I : set ι} (I_fin : finite I)
+lemma mem_infi_of_Inter {ι} {s : ι → filter α} {U : set α} {I : set ι} (I_fin : I.finite)
   {V : I → set α} (hV : ∀ i, V i ∈ s i) (hU : (⋂ i, V i) ⊆ U) : U ∈ ⨅ i, s i :=
 begin
   haveI := I_fin.fintype,
@@ -526,7 +519,7 @@ begin
 end
 
 lemma mem_infi {ι} {s : ι → filter α} {U : set α} : (U ∈ ⨅ i, s i) ↔
-  ∃ I : set ι, finite I ∧ ∃ V : I → set α, (∀ i, V i ∈ s i) ∧ U = ⋂ i, V i :=
+  ∃ I : set ι, I.finite ∧ ∃ V : I → set α, (∀ i, V i ∈ s i) ∧ U = ⋂ i, V i :=
 begin
   split,
   { rw [infi_eq_generate, mem_generate_iff],
@@ -547,7 +540,7 @@ begin
 end
 
 lemma mem_infi' {ι} {s : ι → filter α} {U : set α} : (U ∈ ⨅ i, s i) ↔
-  ∃ I : set ι, finite I ∧ ∃ V : ι → set α, (∀ i, V i ∈ s i) ∧
+  ∃ I : set ι, I.finite ∧ ∃ V : ι → set α, (∀ i, V i ∈ s i) ∧
     (∀ i ∉ I, V i = univ) ∧ (U = ⋂ i ∈ I, V i) ∧ U = ⋂ i, V i :=
 begin
   simp only [mem_infi, set_coe.forall', bInter_eq_Inter],
@@ -564,7 +557,7 @@ lemma exists_Inter_of_mem_infi {ι : Type*} {α : Type*} {f : ι → filter α}
   (hs : s ∈ ⨅ i, f i) : ∃ t : ι → set α, (∀ i, t i ∈ f i) ∧ s = ⋂ i, t i :=
 let ⟨I, If, V, hVs, hV', hVU, hVU'⟩ := mem_infi'.1 hs in ⟨V, hVs, hVU'⟩
 
-lemma mem_infi_of_fintype {ι : Type*} [fintype ι] {α : Type*} {f : ι → filter α} (s) :
+lemma mem_infi_of_finite {ι : Type*} [finite ι] {α : Type*} {f : ι → filter α} (s) :
   s ∈ (⨅ i, f i) ↔ ∃ t : ι → set α, (∀ i, t i ∈ f i) ∧ s = ⋂ i, t i :=
 begin
   refine ⟨exists_Inter_of_mem_infi, _⟩,
@@ -576,6 +569,9 @@ end
 show (∀ {t}, s ⊆ t → t ∈ f) ↔ s ∈ f,
   from ⟨λ h, h (subset.refl s), λ hs t ht, mem_of_superset hs ht⟩
 
+lemma Iic_principal (s : set α) : Iic (𝓟 s) = {l | s ∈ l} :=
+set.ext $ λ x, le_principal_iff
+
 lemma principal_mono {s t : set α} : 𝓟 s ≤ 𝓟 t ↔ s ⊆ t :=
 by simp only [le_principal_iff, iff_self, mem_principal]
 
@@ -631,15 +627,42 @@ lemma disjoint_of_disjoint_of_mem {f g : filter α} {s t : set α} (h : disjoint
   (hs : s ∈ f) (ht : t ∈ g) : disjoint f g :=
 filter.disjoint_iff.mpr ⟨s, hs, t, ht, h⟩
 
+lemma ne_bot.not_disjoint (hf : f.ne_bot) (hs : s ∈ f) (ht : t ∈ f) :
+  ¬ disjoint s t :=
+λ h, not_disjoint_self_iff.2 hf $ filter.disjoint_iff.2 ⟨s, hs, t, ht, h⟩
+
 lemma inf_eq_bot_iff {f g : filter α} :
   f ⊓ g = ⊥ ↔ ∃ (U ∈ f) (V ∈ g), U ∩ V = ∅ :=
-by simpa only [disjoint_iff] using filter.disjoint_iff
+by simpa only [←disjoint_iff, set.disjoint_iff_inter_eq_empty] using filter.disjoint_iff
+
+lemma _root_.pairwise.exists_mem_filter_of_disjoint {ι : Type*} [finite ι]
+  {l : ι → filter α} (hd : pairwise (disjoint on l)) :
+  ∃ s : ι → set α, (∀ i, s i ∈ l i) ∧ pairwise (disjoint on s) :=
+begin
+  simp only [pairwise, function.on_fun, filter.disjoint_iff, subtype.exists'] at hd,
+  choose! s t hst using hd,
+  refine ⟨λ i, ⋂ j, @s i j ∩ @t j i, λ i, _, λ i j hij, _⟩,
+  exacts [Inter_mem.2 (λ j, inter_mem (@s i j).2 (@t j i).2),
+    (hst hij).mono ((Inter_subset _ j).trans (inter_subset_left _ _))
+      ((Inter_subset _ i).trans (inter_subset_right _ _))]
+end
 
-/-- There is exactly one filter on an empty type. --/
--- TODO[gh-6025]: make this globally an instance once safe to do so
-local attribute [instance]
-protected def unique [is_empty α] : unique (filter α) :=
-{ default := ⊥, uniq := filter_eq_bot_of_is_empty }
+lemma _root_.set.pairwise_disjoint.exists_mem_filter {ι : Type*} {l : ι → filter α} {t : set ι}
+  (hd : t.pairwise_disjoint l) (ht : t.finite) :
+  ∃ s : ι → set α, (∀ i, s i ∈ l i) ∧ t.pairwise_disjoint s :=
+begin
+  casesI ht,
+  obtain ⟨s, hd⟩ : ∃ s : Π i : t, {s : set α // s ∈ l i}, pairwise (disjoint on λ i, (s i : set α)),
+  { rcases (hd.subtype _ _).exists_mem_filter_of_disjoint with ⟨s, hsl, hsd⟩,
+    exact ⟨λ i, ⟨s i, hsl i⟩, hsd⟩ },
+  -- TODO: Lean fails to find `can_lift` instance and fails to use an instance supplied by `letI`
+  rcases @subtype.exists_pi_extension ι (λ i, {s // s ∈ l i}) _ _ s with ⟨s, rfl⟩,
+  exact ⟨λ i, s i, λ i, (s i).2, pairwise.set_of_subtype _ _ hd⟩
+end
+
+/-- There is exactly one filter on an empty type. -/
+instance unique [is_empty α] : unique (filter α) :=
+{ to_inhabited := filter.inhabited, uniq := filter_eq_bot_of_is_empty }
 
 /-- There are only two filters on a `subsingleton`: `⊥` and `⊤`. If the type is empty, then they are
 equal. -/
@@ -652,13 +675,16 @@ end
 
 lemma forall_mem_nonempty_iff_ne_bot {f : filter α} :
   (∀ (s : set α), s ∈ f → s.nonempty) ↔ ne_bot f :=
-⟨λ h, ⟨λ hf, empty_not_nonempty (h ∅ $ hf.symm ▸ mem_bot)⟩, @nonempty_of_mem _ _⟩
+⟨λ h, ⟨λ hf, not_nonempty_empty (h ∅ $ hf.symm ▸ mem_bot)⟩, @nonempty_of_mem _ _⟩
+
+instance [nonempty α] : nontrivial (filter α) :=
+⟨⟨⊤, ⊥, ne_bot.ne $ forall_mem_nonempty_iff_ne_bot.1 $ λ s hs,
+  by rwa [mem_top.1 hs, ← nonempty_iff_univ_nonempty]⟩⟩
 
 lemma nontrivial_iff_nonempty : nontrivial (filter α) ↔ nonempty α :=
-⟨λ ⟨⟨f, g, hfg⟩⟩, by_contra $
-  λ h, hfg $ by haveI : is_empty α := not_nonempty_iff.1 h; exact subsingleton.elim _ _,
-  λ ⟨x⟩, ⟨⟨⊤, ⊥, ne_bot.ne $ forall_mem_nonempty_iff_ne_bot.1 $ λ s hs,
-    by rwa [mem_top.1 hs, ← nonempty_iff_univ_nonempty]⟩⟩⟩
+⟨λ h, by_contra $ λ h',
+  by { haveI := not_nonempty_iff.1 h', exact not_subsingleton (filter α) infer_instance },
+  @filter.nontrivial α⟩
 
 lemma eq_Inf_of_mem_iff_exists_mem {S : set (filter α)} {l : filter α}
   (h : ∀ {s}, s ∈ l ↔ ∃ f ∈ S, s ∈ f) : l = Inf S :=
@@ -777,7 +803,7 @@ lemma mem_infi_finset {s : finset α} {f : α → filter β} {t : set β} :
 begin
   simp only [← finset.set_bInter_coe, bInter_eq_Inter, infi_subtype'],
   refine ⟨λ h, _, _⟩,
-  { rcases (mem_infi_of_fintype _).1 h with ⟨p, hp, rfl⟩,
+  { rcases (mem_infi_of_finite _).1 h with ⟨p, hp, rfl⟩,
     refine ⟨λ a, if h : a ∈ s then p ⟨a, h⟩ else univ, λ a ha, by simpa [ha] using hp ⟨a, ha⟩, _⟩,
     refine Inter_congr_of_surjective id surjective_id _,
     rintro ⟨a, ha⟩, simp [ha] },
@@ -801,14 +827,21 @@ end⟩
 See also `infi_ne_bot_of_directed'` for a version assuming `nonempty ι` instead of `nonempty α`. -/
 lemma infi_ne_bot_of_directed {f : ι → filter α}
   [hn : nonempty α] (hd : directed (≥) f) (hb : ∀ i, ne_bot (f i)) : ne_bot (infi f) :=
-if hι : nonempty ι then @infi_ne_bot_of_directed' _ _ _ hι hd hb else
-⟨λ h : infi f = ⊥,
-  have univ ⊆ (∅ : set α),
-  begin
-    rw [←principal_mono, principal_univ, principal_empty, ←h],
-    exact (le_infi $ λ i, false.elim $ hι ⟨i⟩)
-  end,
-  let ⟨x⟩ := hn in this (mem_univ x)⟩
+begin
+  casesI is_empty_or_nonempty ι,
+  { constructor, simp [infi_of_empty f, top_ne_bot] },
+  { exact infi_ne_bot_of_directed' hd hb }
+end
+
+lemma Inf_ne_bot_of_directed' {s : set (filter α)} (hne : s.nonempty) (hd : directed_on (≥) s)
+  (hbot : ⊥ ∉ s) : ne_bot (Inf s) :=
+(Inf_eq_infi' s).symm ▸ @infi_ne_bot_of_directed' _ _ _
+  hne.to_subtype hd.directed_coe (λ ⟨f, hf⟩, ⟨ne_of_mem_of_not_mem hf hbot⟩)
+
+lemma Inf_ne_bot_of_directed [nonempty α] {s : set (filter α)} (hd : directed_on (≥) s)
+  (hbot : ⊥ ∉ s) : ne_bot (Inf s) :=
+(Inf_eq_infi' s).symm ▸ infi_ne_bot_of_directed hd.directed_coe
+  (λ ⟨f, hf⟩, ⟨ne_of_mem_of_not_mem hf hbot⟩)
 
 lemma infi_ne_bot_iff_of_directed' {f : ι → filter α} [nonempty ι] (hd : directed (≥) f) :
   ne_bot (infi f) ↔ ∀ i, ne_bot (f i) :=
@@ -852,11 +885,13 @@ filter.ext $ λ x, by simp only [mem_supr, mem_principal, Union_subset_iff]
 empty_mem_iff_bot.symm.trans $ mem_principal.trans subset_empty_iff
 
 @[simp] lemma principal_ne_bot_iff {s : set α} : ne_bot (𝓟 s) ↔ s.nonempty :=
-ne_bot_iff.trans $ (not_congr principal_eq_bot_iff).trans ne_empty_iff_nonempty
+ne_bot_iff.trans $ (not_congr principal_eq_bot_iff).trans nonempty_iff_ne_empty.symm
+
+alias principal_ne_bot_iff ↔ _ _root_.set.nonempty.principal_ne_bot
 
 lemma is_compl_principal (s : set α) : is_compl (𝓟 s) (𝓟 sᶜ) :=
-⟨by simp only [inf_principal, inter_compl_self, principal_empty, le_refl],
-  by simp only [sup_principal, union_compl_self, principal_univ, le_refl]⟩
+is_compl.of_eq (by rw [inf_principal, inter_compl_self, principal_empty]) $
+  by rw [sup_principal, union_compl_self, principal_univ]
 
 theorem mem_inf_principal' {f : filter α} {s t : set α} :
   s ∈ f ⊓ 𝓟 t ↔ tᶜ ∪ s ∈ f :=
@@ -896,11 +931,11 @@ begin
   { rw [finset.infi_insert, finset.set_bInter_insert, hs, inf_principal] },
 end
 
-@[simp] lemma infi_principal_fintype {ι : Type w} [fintype ι] (f : ι → set α) :
+@[simp] lemma infi_principal {ι : Type w} [finite ι] (f : ι → set α) :
   (⨅ i, 𝓟 (f i)) = 𝓟 (⋂ i, f i) :=
-by simpa using infi_principal_finset finset.univ f
+by { casesI nonempty_fintype ι, simpa using infi_principal_finset finset.univ f }
 
-lemma infi_principal_finite {ι : Type w} {s : set ι} (hs : finite s) (f : ι → set α) :
+lemma infi_principal_finite {ι : Type w} {s : set ι} (hs : s.finite) (f : ι → set α) :
   (⨅ i ∈ s, 𝓟 (f i)) = 𝓟 (⋂ i ∈ s, f i) :=
 begin
   lift s to finset ι using hs,
@@ -951,6 +986,10 @@ lemma eventually_of_forall {p : α → Prop} {f : filter α} (hp : ∀ x, p x) :
   ∀ᶠ x in f, p x :=
 univ_mem' hp
 
+lemma forall_eventually_of_eventually_forall {f : filter α} {p : α → β → Prop}
+  (h : ∀ᶠ x in f, ∀ y, p x y) : ∀ y, ∀ᶠ x in f, p x y :=
+by { intros y, filter_upwards [h], tauto, }
+
 @[simp] lemma eventually_false_iff_eq_bot {f : filter α} :
   (∀ᶠ x in f, false) ↔ f = ⊥ :=
 empty_mem_iff_bot
@@ -989,22 +1028,22 @@ lemma eventually_congr {f : filter α} {p q : α → Prop} (h : ∀ᶠ x in f, p
   (∀ᶠ x in f, p x) ↔ (∀ᶠ x in f, q x) :=
 ⟨λ hp, hp.congr h, λ hq, hq.congr $ by simpa only [iff.comm] using h⟩
 
-@[simp] lemma eventually_all {ι} [fintype ι] {l} {p : ι → α → Prop} :
+@[simp] lemma eventually_all {ι : Type*} [finite ι] {l} {p : ι → α → Prop} :
   (∀ᶠ x in l, ∀ i, p i x) ↔ ∀ i, ∀ᶠ x in l, p i x :=
-by simpa only [filter.eventually, set_of_forall] using Inter_mem
+by { casesI nonempty_fintype ι, simpa only [filter.eventually, set_of_forall] using Inter_mem }
 
 @[simp] lemma eventually_all_finite {ι} {I : set ι} (hI : I.finite) {l} {p : ι → α → Prop} :
   (∀ᶠ x in l, ∀ i ∈ I, p i x) ↔ (∀ i ∈ I, ∀ᶠ x in l, p i x) :=
 by simpa only [filter.eventually, set_of_forall] using bInter_mem hI
 
-alias eventually_all_finite ← set.finite.eventually_all
+alias eventually_all_finite ← _root_.set.finite.eventually_all
 attribute [protected] set.finite.eventually_all
 
 @[simp] lemma eventually_all_finset {ι} (I : finset ι) {l} {p : ι → α → Prop} :
   (∀ᶠ x in l, ∀ i ∈ I, p i x) ↔ ∀ i ∈ I, ∀ᶠ x in l, p i x :=
 I.finite_to_set.eventually_all
 
-alias eventually_all_finset ← finset.eventually_all
+alias eventually_all_finset ← _root_.finset.eventually_all
 attribute [protected] finset.eventually_all
 
 @[simp] lemma eventually_or_distrib_left {f : filter α} {p : Prop} {q : α → Prop} :
@@ -1036,7 +1075,7 @@ lemma eventually_Sup {p : α → Prop} {fs : set (filter α)} :
 iff.rfl
 
 @[simp]
-lemma eventually_supr {p : α → Prop} {fs : β → filter α} :
+lemma eventually_supr {p : α → Prop} {fs : ι → filter α} :
   (∀ᶠ x in (⨆ b, fs b), p x) ↔ (∀ b, ∀ᶠ x in fs b, p x) :=
 mem_supr
 
@@ -1197,6 +1236,18 @@ lemma frequently_supr {p : α → Prop} {fs : β → filter α} :
   (∃ᶠ x in (⨆ b, fs b), p x) ↔ (∃ b, ∃ᶠ x in fs b, p x) :=
 by simp [filter.frequently, -not_eventually, not_forall]
 
+lemma eventually.choice {r : α → β → Prop} {l : filter α}
+  [l.ne_bot] (h : ∀ᶠ x in l, ∃ y, r x y) : ∃ f : α → β, ∀ᶠ x in l, r x (f x) :=
+begin
+  classical,
+  use (λ x, if hx : ∃ y, r x y then classical.some hx
+            else classical.some (classical.some_spec h.exists)),
+  filter_upwards [h],
+  intros x hx,
+  rw dif_pos hx,
+  exact classical.some_spec hx
+end
+
 /-!
 ### Relation “eventually equal”
 -/
@@ -1220,7 +1271,7 @@ lemma eventually_eq_set {s t : set α} {l : filter α} :
    s =ᶠ[l] t ↔ ∀ᶠ x in l, x ∈ s ↔ x ∈ t :=
 eventually_congr $ eventually_of_forall $ λ x, ⟨eq.to_iff, iff.to_eq⟩
 
-alias eventually_eq_set ↔ filter.eventually_eq.mem_iff filter.eventually.set_eq
+alias eventually_eq_set ↔ eventually_eq.mem_iff eventually.set_eq
 
 @[simp] lemma eventually_eq_univ {s : set α} {l : filter α} : s =ᶠ[l] univ ↔ s ∈ l :=
 by simp [eventually_eq_set]
@@ -1285,12 +1336,12 @@ lemma eventually_eq.div [has_div β] {f f' g g' : α → β} {l : filter α} (h
   ((λ x, f x / f' x) =ᶠ[l] (λ x, g x / g' x)) :=
 h.comp₂ (/) h'
 
-@[to_additive] lemma eventually_eq.const_smul {𝕜} [has_scalar 𝕜 β] {l : filter α} {f g : α → β}
+@[to_additive] lemma eventually_eq.const_smul {𝕜} [has_smul 𝕜 β] {l : filter α} {f g : α → β}
   (h : f =ᶠ[l] g) (c : 𝕜) :
   (λ x, c • f x) =ᶠ[l] (λ x, c • g x) :=
 h.fun_comp (λ x, c • x)
 
-@[to_additive] lemma eventually_eq.smul {𝕜} [has_scalar 𝕜 β] {l : filter α} {f f' : α → 𝕜}
+@[to_additive] lemma eventually_eq.smul {𝕜} [has_smul 𝕜 β] {l : filter α} {f f' : α → 𝕜}
   {g g' : α → β} (hf : f =ᶠ[l] f') (hg : g =ᶠ[l] g') :
   (λ x, f x • g x) =ᶠ[l] λ x, f' x • g' x :=
 hf.comp₂ (•) hg
@@ -1331,7 +1382,7 @@ eventually_eq_set.trans $ by simp
 
 lemma inter_eventually_eq_left {s t : set α} {l : filter α} :
   (s ∩ t : set α) =ᶠ[l] s ↔ ∀ᶠ x in l, x ∈ s → x ∈ t :=
-by simp only [eventually_eq_set, mem_inter_eq, and_iff_left_iff_imp]
+by simp only [eventually_eq_set, mem_inter_iff, and_iff_left_iff_imp]
 
 lemma inter_eventually_eq_right {s t : set α} {l : filter α} :
   (s ∩ t : set α) =ᶠ[l] t ↔ ∀ᶠ x in l, x ∈ t → x ∈ s :=
@@ -1443,6 +1494,62 @@ h.mono $ λ x, mt
   (s \ s' : set α) ≤ᶠ[l] (t \ t' : set α) :=
 h.inter h'.compl
 
+lemma set_eventually_le_iff_mem_inf_principal {s t : set α} {l : filter α} :
+  s ≤ᶠ[l] t ↔ t ∈ l ⊓ 𝓟 s :=
+mem_inf_principal.symm
+
+lemma set_eventually_le_iff_inf_principal_le {s t : set α} {l : filter α} :
+  s ≤ᶠ[l] t ↔ l ⊓ 𝓟 s ≤ l ⊓ 𝓟 t :=
+set_eventually_le_iff_mem_inf_principal.trans $
+  by simp only [le_inf_iff, inf_le_left, true_and, le_principal_iff]
+
+lemma set_eventually_eq_iff_inf_principal {s t : set α} {l : filter α} :
+  s =ᶠ[l] t ↔ l ⊓ 𝓟 s = l ⊓ 𝓟 t :=
+by simp only [eventually_le_antisymm_iff, le_antisymm_iff, set_eventually_le_iff_inf_principal_le]
+
+lemma eventually_le.mul_le_mul
+  [mul_zero_class β] [partial_order β] [pos_mul_mono β] [mul_pos_mono β]
+  {l : filter α} {f₁ f₂ g₁ g₂ : α → β}
+  (hf : f₁ ≤ᶠ[l] f₂) (hg : g₁ ≤ᶠ[l] g₂) (hg₀ : 0 ≤ᶠ[l] g₁) (hf₀ : 0 ≤ᶠ[l] f₂) :
+  f₁ * g₁ ≤ᶠ[l] f₂ * g₂ :=
+by filter_upwards [hf, hg, hg₀, hf₀] with x using mul_le_mul
+
+@[to_additive eventually_le.add_le_add]
+lemma eventually_le.mul_le_mul' [has_mul β] [preorder β]
+  [covariant_class β β (*) (≤)] [covariant_class β β (swap (*)) (≤)]
+  {l : filter α} {f₁ f₂ g₁ g₂ : α → β} (hf : f₁ ≤ᶠ[l] f₂) (hg : g₁ ≤ᶠ[l] g₂) :
+  f₁ * g₁ ≤ᶠ[l] f₂ * g₂ :=
+by filter_upwards [hf, hg] with x hfx hgx using mul_le_mul' hfx hgx
+
+lemma eventually_le.mul_nonneg [ordered_semiring β] {l : filter α} {f g : α → β}
+  (hf : 0 ≤ᶠ[l] f) (hg : 0 ≤ᶠ[l] g) :
+  0 ≤ᶠ[l] f * g :=
+by filter_upwards [hf, hg] with x using mul_nonneg
+
+lemma eventually_sub_nonneg [ordered_ring β] {l : filter α} {f g : α → β} :
+  0 ≤ᶠ[l] g - f ↔ f ≤ᶠ[l] g :=
+eventually_congr $ eventually_of_forall $ λ x, sub_nonneg
+
+lemma eventually_le.sup [semilattice_sup β] {l : filter α} {f₁ f₂ g₁ g₂ : α → β}
+  (hf : f₁ ≤ᶠ[l] f₂) (hg : g₁ ≤ᶠ[l] g₂) :
+  f₁ ⊔ g₁ ≤ᶠ[l] f₂ ⊔ g₂ :=
+by filter_upwards [hf, hg] with x hfx hgx using sup_le_sup hfx hgx
+
+lemma eventually_le.sup_le [semilattice_sup β] {l : filter α} {f g h : α → β}
+  (hf : f ≤ᶠ[l] h) (hg : g ≤ᶠ[l] h) :
+  f ⊔ g ≤ᶠ[l] h :=
+by filter_upwards [hf, hg] with x hfx hgx using sup_le hfx hgx
+
+lemma eventually_le.le_sup_of_le_left [semilattice_sup β] {l : filter α} {f g h : α → β}
+  (hf : h ≤ᶠ[l] f) :
+  h ≤ᶠ[l] f ⊔ g :=
+by filter_upwards [hf] with x hfx using le_sup_of_le_left hfx
+
+lemma eventually_le.le_sup_of_le_right [semilattice_sup β] {l : filter α} {f g h : α → β}
+  (hg : h ≤ᶠ[l] g) :
+  h ≤ᶠ[l] f ⊔ g :=
+by filter_upwards [hg] with x hgx using le_sup_of_le_right hgx
+
 lemma join_le {f : filter (filter α)} {l : filter α} (h : ∀ᶠ m in f, m ≤ l) : join f ≤ l :=
 λ s hs, h.mono $ λ m hm, hm hs
 
@@ -1510,12 +1617,12 @@ end map
 
 section comap
 
-/-- The inverse map of a filter. A set `s` belongs to `filter.comap f l` if either of the following
+/-- The inverse map of a filter. A set `s` belongs to `filter.comap m f` if either of the following
 equivalent conditions hold.
 
-1. There exists a set `t ∈ l` such that `f ⁻¹' t ⊆ s`. This is used as a definition.
-2. The set `{y | ∀ x, f x = y → x ∈ s}` belongs to `l`, see `filter.mem_comap'`.
-3. The set `(f '' sᶜ)ᶜ` belongs to `l`, see `filter.mem_comap_iff_compl` and
+1. There exists a set `t ∈ f` such that `m ⁻¹' t ⊆ s`. This is used as a definition.
+2. The set `{y | ∀ x, m x = y → x ∈ s}` belongs to `f`, see `filter.mem_comap'`.
+3. The set `(m '' sᶜ)ᶜ` belongs to `f`, see `filter.mem_comap_iff_compl` and
 `filter.compl_mem_comap`. -/
 def comap (m : α → β) (f : filter β) : filter α :=
 { sets             := { s | ∃ t ∈ f, m ⁻¹' t ⊆ s },
@@ -1530,6 +1637,11 @@ lemma mem_comap' : s ∈ comap f l ↔ {y | ∀ ⦃x⦄, f x = y → x ∈ s} 
 ⟨λ ⟨t, ht, hts⟩, mem_of_superset ht $ λ y hy x hx, hts $ mem_preimage.2 $ by rwa hx,
   λ h, ⟨_, h, λ x hx, hx rfl⟩⟩
 
+/-- RHS form is used, e.g., in the definition of `uniform_space`. -/
+lemma mem_comap_prod_mk {x : α} {s : set β} {F : filter (α × β)} :
+  s ∈ comap (prod.mk x) F ↔ {p : α × β | p.fst = x → p.snd ∈ s} ∈ F :=
+by simp_rw [mem_comap', prod.ext_iff, and_imp, @forall_swap β (_ = _), forall_eq, eq_comm]
+
 @[simp] lemma eventually_comap : (∀ᶠ a in comap f l, p a) ↔ ∀ᶠ b in l, ∀ a, f a = b → p a :=
 mem_comap'
 
@@ -1636,6 +1748,8 @@ preimage_mem_comap hf
 lemma comap_id : comap id f = f :=
 le_antisymm (λ s, preimage_mem_comap) (λ s ⟨t, ht, hst⟩, mem_of_superset ht hst)
 
+lemma comap_id' : comap (λ x, x) f = f := comap_id
+
 lemma comap_const_of_not_mem {x : β} (ht : t ∈ g) (hx : x ∉ t) :
   comap (λ y : α, x) g = ⊥ :=
 empty_mem_iff_bot.1 $ mem_comap'.2 $ mem_of_superset ht $ λ x' hx' y h, hx $ h.symm ▸ hx'
@@ -1650,7 +1764,6 @@ lemma comap_comap {m : γ → β} {n : β → α} : comap m (comap n f) = comap
 filter.coext $ λ s, by simp only [compl_mem_comap, image_image]
 
 section comm
-variables  {δ : Type*}
 
 /-!
 The variables in the following lemmas are used as in this diagram:
@@ -1672,6 +1785,22 @@ lemma comap_comm (G : filter δ) : comap φ (comap ψ G) = comap θ (comap ρ G)
 by rw [filter.comap_comap, H, ← filter.comap_comap]
 end comm
 
+lemma _root_.function.semiconj.filter_map {f : α → β} {ga : α → α} {gb : β → β}
+  (h : function.semiconj f ga gb) : function.semiconj (map f) (map ga) (map gb) :=
+map_comm h.comp_eq
+
+lemma _root_.function.commute.filter_map {f g : α → α} (h : function.commute f g) :
+  function.commute (map f) (map g) :=
+h.filter_map
+
+lemma _root_.function.semiconj.filter_comap {f : α → β} {ga : α → α} {gb : β → β}
+  (h : function.semiconj f ga gb) : function.semiconj (comap f) (comap gb) (comap ga) :=
+comap_comm h.comp_eq.symm
+
+lemma _root_.function.commute.filter_comap {f g : α → α} (h : function.commute f g) :
+  function.commute (comap f) (comap g) :=
+h.filter_comap
+
 @[simp] theorem comap_principal {t : set β} : comap m (𝓟 t) = 𝓟 (m ⁻¹' t) :=
 filter.ext $ λ s,
   ⟨λ ⟨u, (hu : t ⊆ u), (b : preimage m u ⊆ s)⟩, (preimage_mono hu).trans b,
@@ -1709,7 +1838,17 @@ lemma map_comap_le : map m (comap m g) ≤ g := (gc_map_comap m).l_u_le _
 lemma le_comap_map : f ≤ comap m (map m f) := (gc_map_comap m).le_u_l _
 
 @[simp] lemma comap_bot : comap m ⊥ = ⊥ :=
-bot_unique $ λ s _, ⟨∅, by simp only [mem_bot], by simp only [empty_subset, preimage_empty]⟩
+bot_unique $ λ s _, ⟨∅, mem_bot, by simp only [empty_subset, preimage_empty]⟩
+
+lemma ne_bot_of_comap (h : (comap m g).ne_bot) : g.ne_bot :=
+begin
+  rw ne_bot_iff at *,
+  contrapose! h,
+  rw h,
+  exact comap_bot
+end
+
+lemma comap_inf_principal_range : comap m (g ⊓ 𝓟 (range m)) = comap m g := by simp
 
 lemma disjoint_comap (h : disjoint g₁ g₂) : disjoint (comap m g₁) (comap m g₂) :=
 by simp only [disjoint_iff, ← comap_inf, h.eq_bot, comap_bot]
@@ -1746,10 +1885,9 @@ end
 lemma map_comap_of_mem {f : filter β} {m : α → β} (hf : range m ∈ f) : (f.comap m).map m = f :=
 by rw [map_comap, inf_eq_left.2 (le_principal_iff.2 hf)]
 
-instance [can_lift α β] : can_lift (filter α) (filter β) :=
-{ coe := map can_lift.coe,
-  cond := λ f, ∀ᶠ x : α in f, can_lift.cond β x,
-  prf := λ f hf, ⟨comap can_lift.coe f, map_comap_of_mem $ hf.mono can_lift.prf⟩ }
+instance can_lift (c) (p) [can_lift α β c p] :
+  can_lift (filter α) (filter β) (map c) (λ f, ∀ᶠ x : α in f, p x) :=
+{ prf := λ f hf, ⟨comap c f, map_comap_of_mem $ hf.mono can_lift.prf⟩ }
 
 lemma comap_le_comap_iff {f g : filter β} {m : α → β} (hf : range m ∈ f) :
   comap m f ≤ comap m g ↔ f ≤ g :=
@@ -1766,11 +1904,6 @@ lemma subtype_coe_map_comap (s : set α) (f : filter α) :
   map (coe : s → α) (comap (coe : s → α) f) = f ⊓ 𝓟 s :=
 by rw [map_comap, subtype.range_coe]
 
-lemma subtype_coe_map_comap_prod (s : set α) (f : filter (α × α)) :
-  map (coe : s × s → α × α) (comap (coe : s × s → α × α) f) = f ⊓ 𝓟 (s ×ˢ s) :=
-have (coe : s × s → α × α) = (λ x, (x.1, x.2)), by ext ⟨x, y⟩; refl,
-by simp [this, map_comap, ← prod_range_range_eq]
-
 lemma image_mem_of_mem_comap {f : filter α} {c : β → α} (h : range c ∈ f) {W : set β}
   (W_in : W ∈ comap c f) : c '' W ∈ f :=
 begin
@@ -1793,34 +1926,32 @@ lemma mem_comap_iff {f : filter β} {m : α → β} (inj : injective m)
   (large : set.range m ∈ f) {S : set α} : S ∈ comap m f ↔ m '' S ∈ f :=
 by rw [← image_mem_map_iff inj, map_comap_of_mem large]
 
-lemma le_of_map_le_map_inj' {f g : filter α} {m : α → β} {s : set α}
-  (hsf : s ∈ f) (hsg : s ∈ g) (hm : ∀ x ∈ s, ∀ y ∈ s, m x = m y → x = y)
-  (h : map m f ≤ map m g) : f ≤ g :=
-λ t ht, by filter_upwards [hsf, h $ image_mem_map (inter_mem hsg ht)]
-using λ _ has ⟨_, ⟨hbs, hb⟩, h⟩, hm _ hbs _ has h ▸ hb
+lemma map_le_map_iff_of_inj_on {l₁ l₂ : filter α} {f : α → β} {s : set α}
+  (h₁ : s ∈ l₁) (h₂ : s ∈ l₂) (hinj : inj_on f s) :
+  map f l₁ ≤ map f l₂ ↔ l₁ ≤ l₂ :=
+⟨λ h t ht, mp_mem h₁ $ mem_of_superset (h $ image_mem_map (inter_mem h₂ ht)) $
+  λ y ⟨x, ⟨hxs, hxt⟩, hxy⟩ hys, hinj hxs hys hxy ▸ hxt, λ h, map_mono h⟩
 
-lemma le_of_map_le_map_inj_iff {f g : filter α} {m : α → β} {s : set α}
-  (hsf : s ∈ f) (hsg : s ∈ g) (hm : ∀ x ∈ s, ∀ y ∈ s, m x = m y → x = y) :
-  map m f ≤ map m g ↔ f ≤ g :=
-iff.intro (le_of_map_le_map_inj' hsf hsg hm) (λ h, map_mono h)
+lemma map_le_map_iff {f g : filter α} {m : α → β} (hm : injective m) : map m f ≤ map m g ↔ f ≤ g :=
+by rw [map_le_iff_le_comap, comap_map hm]
 
-lemma eq_of_map_eq_map_inj' {f g : filter α} {m : α → β} {s : set α}
-  (hsf : s ∈ f) (hsg : s ∈ g) (hm : ∀ x ∈ s, ∀ y ∈ s, m x = m y → x = y)
-  (h : map m f = map m g) : f = g :=
-le_antisymm
-  (le_of_map_le_map_inj' hsf hsg hm $ le_of_eq h)
-  (le_of_map_le_map_inj' hsg hsf hm $ le_of_eq h.symm)
+lemma map_eq_map_iff_of_inj_on {f g : filter α} {m : α → β} {s : set α}
+  (hsf : s ∈ f) (hsg : s ∈ g) (hm : inj_on m s) :
+  map m f = map m g ↔ f = g :=
+by simp only [le_antisymm_iff, map_le_map_iff_of_inj_on hsf hsg hm,
+  map_le_map_iff_of_inj_on hsg hsf hm]
+
+lemma map_inj {f g : filter α} {m : α → β} (hm : injective m) :
+  map m f = map m g ↔ f = g :=
+map_eq_map_iff_of_inj_on univ_mem univ_mem (hm.inj_on _)
 
-lemma map_inj {f g : filter α} {m : α → β} (hm : injective m) (h : map m f = map m g) :
-  f = g :=
-have comap m (map m f) = comap m (map m g), by rw h,
-by rwa [comap_map hm, comap_map hm] at this
+lemma map_injective {m : α → β} (hm : injective m) : injective (map m) :=
+λ f g, (map_inj hm).1
 
 lemma comap_ne_bot_iff {f : filter β} {m : α → β} : ne_bot (comap m f) ↔ ∀ t ∈ f, ∃ a, m a ∈ t :=
 begin
-  rw ← forall_mem_nonempty_iff_ne_bot,
-  exact ⟨λ h t t_in, h (m ⁻¹' t) ⟨t, t_in, subset.rfl⟩,
-         λ h s ⟨u, u_in, hu⟩, let ⟨x, hx⟩ := h u u_in in ⟨x, hu hx⟩⟩,
+  simp only [← forall_mem_nonempty_iff_ne_bot, mem_comap, forall_exists_index],
+  exact ⟨λ h t t_in, h (m ⁻¹' t) t t_in subset.rfl, λ h s t ht hst, (h t ht).imp hst⟩,
 end
 
 lemma comap_ne_bot {f : filter β} {m : α → β} (hm : ∀ t ∈ f, ∃ a, m a ∈ t) : ne_bot (comap m f) :=
@@ -1834,6 +1965,17 @@ lemma comap_ne_bot_iff_compl_range {f : filter β} {m : α → β} :
   ne_bot (comap m f) ↔ (range m)ᶜ ∉ f :=
 comap_ne_bot_iff_frequently
 
+lemma comap_eq_bot_iff_compl_range {f : filter β} {m : α → β} :
+  comap m f = ⊥ ↔ (range m)ᶜ ∈ f :=
+not_iff_not.mp $ ne_bot_iff.symm.trans comap_ne_bot_iff_compl_range
+
+lemma comap_surjective_eq_bot {f : filter β} {m : α → β} (hm : surjective m) :
+  comap m f = ⊥ ↔ f = ⊥ :=
+by rw [comap_eq_bot_iff_compl_range, hm.range_eq, compl_univ, empty_mem_iff_bot]
+
+lemma disjoint_comap_iff (h : surjective m) : disjoint (comap m g₁) (comap m g₂) ↔ disjoint g₁ g₂ :=
+by rw [disjoint_iff, disjoint_iff, ← comap_inf, comap_surjective_eq_bot h]
+
 lemma ne_bot.comap_of_range_mem {f : filter β} {m : α → β}
   (hf : ne_bot f) (hm : range m ∈ f) : ne_bot (comap m f) :=
 comap_ne_bot_iff_frequently.2 $ eventually.frequently hm
@@ -1855,7 +1997,7 @@ comap_fst_ne_bot_iff.2 ⟨‹_›, ‹_›⟩
 begin
   casesI is_empty_or_nonempty α with hα hα,
   { rw [filter_eq_bot_of_is_empty (f.comap _), ← not_iff_not];
-      [simpa using hα.elim, apply_instance] },
+      [simp, apply_instance] },
   { simp [comap_ne_bot_iff_frequently, hα] }
 end
 
@@ -1868,7 +2010,7 @@ lemma comap_eval_ne_bot_iff' {ι : Type*} {α : ι → Type*} {i : ι} {f : filt
 begin
   casesI is_empty_or_nonempty (Π j, α j) with H H,
   { rw [filter_eq_bot_of_is_empty (f.comap _), ← not_iff_not]; [skip, assumption],
-    simpa [← classical.nonempty_pi] using H.elim },
+    simp [← classical.nonempty_pi] },
   { haveI : ∀ j, nonempty (α j), from classical.nonempty_pi.1 H,
     simp [comap_ne_bot_iff_frequently, *] }
 end
@@ -1917,6 +2059,8 @@ by simp only [ne_bot_iff, ne, map_eq_bot_iff]
 lemma ne_bot.map (hf : ne_bot f) (m : α → β) : ne_bot (map m f) :=
 (map_ne_bot_iff m).2 hf
 
+lemma ne_bot.of_map : ne_bot (f.map m) → ne_bot f := (map_ne_bot_iff m).1
+
 instance map_ne_bot [hf : ne_bot f] : ne_bot (f.map m) := hf.map m
 
 lemma sInter_comap_sets (f : α → β) (F : filter β) :
@@ -1967,7 +2111,7 @@ begin
   refine map_inf_le.antisymm _,
   rintro t ⟨s₁, hs₁, s₂, hs₂, ht : m ⁻¹' t = s₁ ∩ s₂⟩,
   refine mem_inf_of_inter (image_mem_map hs₁) (image_mem_map hs₂) _,
-  rw [image_inter h, image_subset_iff, ht]
+  rw [←image_inter h, image_subset_iff, ht]
 end
 
 lemma map_inf' {f g : filter α} {m : α → β} {t : set α} (htf : t ∈ f) (htg : t ∈ g)
@@ -1982,18 +2126,14 @@ lemma disjoint_map {m : α → β} (hm : injective m) {f₁ f₂ : filter α} :
   disjoint (map m f₁) (map m f₂) ↔ disjoint f₁ f₂ :=
 by simp only [disjoint_iff, ← map_inf hm, map_eq_bot_iff]
 
-lemma map_eq_comap_of_inverse {f : filter α} {m : α → β} {n : β → α}
-  (h₁ : m ∘ n = id) (h₂ : n ∘ m = id) : map m f = comap n f :=
-le_antisymm
-  (λ b ⟨a, ha, (h : preimage n a ⊆ b)⟩, f.sets_of_superset ha $
-    calc a = preimage (n ∘ m) a : by simp only [h₂, preimage_id, eq_self_iff_true]
-      ... ⊆ preimage m b : preimage_mono h)
-  (λ b (hb : preimage m b ∈ f),
-    ⟨preimage m b, hb, show preimage (m ∘ n) b ⊆ b, by simp only [h₁]; apply subset.refl⟩)
-
 lemma map_equiv_symm (e : α ≃ β) (f : filter β) :
   map e.symm f = comap e f :=
-map_eq_comap_of_inverse e.symm_comp_self e.self_comp_symm
+map_injective e.injective $ by rw [map_map, e.self_comp_symm, map_id,
+  map_comap_of_surjective e.surjective]
+
+lemma map_eq_comap_of_inverse {f : filter α} {m : α → β} {n : β → α}
+  (h₁ : m ∘ n = id) (h₂ : n ∘ m = id) : map m f = comap n f :=
+map_equiv_symm ⟨n, m, congr_fun h₁, congr_fun h₂⟩ f
 
 lemma comap_equiv_symm (e : α ≃ β) (f : filter α) :
   comap e.symm f = map e f :=
@@ -2002,10 +2142,19 @@ lemma comap_equiv_symm (e : α ≃ β) (f : filter α) :
 lemma map_swap_eq_comap_swap {f : filter (α × β)} : prod.swap <$> f = comap prod.swap f :=
 map_eq_comap_of_inverse prod.swap_swap_eq prod.swap_swap_eq
 
+/-- A useful lemma when dealing with uniformities. -/
+lemma map_swap4_eq_comap {f : filter ((α × β) × (γ × δ))} :
+  map (λ p : (α × β) × (γ × δ), ((p.1.1, p.2.1), (p.1.2, p.2.2))) f =
+  comap (λ p : (α × γ) × (β × δ), ((p.1.1, p.2.1), (p.1.2, p.2.2))) f :=
+map_eq_comap_of_inverse (funext $ λ ⟨⟨_, _⟩, ⟨_, _⟩⟩, rfl) (funext $ λ ⟨⟨_, _⟩, ⟨_, _⟩⟩, rfl)
+
 lemma le_map {f : filter α} {m : α → β} {g : filter β} (h : ∀ s ∈ f, m '' s ∈ g) :
   g ≤ f.map m :=
 λ s hs, mem_of_superset (h _ hs) $ image_preimage_subset _ _
 
+lemma le_map_iff {f : filter α} {m : α → β} {g : filter β} : g ≤ f.map m ↔ ∀ s ∈ f, m '' s ∈ g :=
+⟨λ h s hs, h (image_mem_map hs), le_map⟩
+
 protected lemma push_pull (f : α → β) (F : filter α) (G : filter β) :
   map f (F ⊓ comap f G) = map f F ⊓ G :=
 begin
@@ -2025,6 +2174,13 @@ protected lemma push_pull' (f : α → β) (F : filter α) (G : filter β) :
   map f (comap f G ⊓ F) = G ⊓ map f F :=
 by simp only [filter.push_pull, inf_comm]
 
+lemma principal_eq_map_coe_top (s : set α) : 𝓟 s = map (coe : s → α) ⊤ :=
+by simp
+
+lemma inf_principal_eq_bot_iff_comap {F : filter α} {s : set α} :
+  F ⊓ 𝓟 s = ⊥ ↔ comap (coe : s → α) F = ⊥ :=
+by rw [principal_eq_map_coe_top s, ← filter.push_pull',inf_top_eq, map_eq_bot_iff]
+
 section applicative
 
 lemma singleton_mem_pure {a : α} : {a} ∈ (pure a : filter α) :=
@@ -2037,8 +2193,7 @@ instance pure_ne_bot {α : Type u} {a : α} : ne_bot (pure a) :=
 ⟨mt empty_mem_iff_bot.2 $ not_mem_empty a⟩
 
 @[simp] lemma le_pure_iff {f : filter α} {a : α} : f ≤ pure a ↔ {a} ∈ f :=
-⟨λ h, h singleton_mem_pure,
-  λ h s hs, mem_of_superset h $ singleton_subset_iff.2 hs⟩
+by rw [← principal_singleton, le_principal_iff]
 
 lemma mem_seq_def {f : filter (α → β)} {g : filter α} {s : set β} :
   s ∈ f.seq g ↔ (∃ u ∈ f, ∃ t ∈ g, ∀ x ∈ u, ∀ y ∈ t, (x : α → β) y ∈ s) :=
@@ -2230,7 +2385,7 @@ end list_traverse
 /-- `tendsto` is the generic "limit of a function" predicate.
   `tendsto f l₁ l₂` asserts that for every `l₂` neighborhood `a`,
   the `f`-preimage of `a` is an `l₁` neighborhood. -/
-def tendsto (f : α → β) (l₁ : filter α) (l₂ : filter β) := l₁.map f ≤ l₂
+@[pp_nodot] def tendsto (f : α → β) (l₁ : filter α) (l₂ : filter β) := l₁.map f ≤ l₂
 
 lemma tendsto_def {f : α → β} {l₁ : filter α} {l₂ : filter β} :
   tendsto f l₁ l₂ ↔ ∀ s ∈ l₂, f ⁻¹' s ∈ l₁ := iff.rfl
@@ -2276,7 +2431,7 @@ lemma tendsto_iff_comap {f : α → β} {l₁ : filter α} {l₂ : filter β} :
   tendsto f l₁ l₂ ↔ l₁ ≤ l₂.comap f :=
 map_le_iff_le_comap
 
-alias tendsto_iff_comap ↔ filter.tendsto.le_comap _
+alias tendsto_iff_comap ↔ tendsto.le_comap _
 
 protected lemma tendsto.disjoint {f : α → β} {la₁ la₂ : filter α} {lb₁ lb₂ : filter β}
   (h₁ : tendsto f la₁ lb₁) (hd : disjoint lb₁ lb₂) (h₂ : tendsto f la₂ lb₂) :
@@ -2299,16 +2454,13 @@ theorem tendsto.congr {f₁ f₂ : α → β} {l₁ : filter α} {l₂ : filter
   (h : ∀ x, f₁ x = f₂ x) : tendsto f₁ l₁ l₂ → tendsto f₂ l₁ l₂ :=
 (tendsto_congr h).1
 
-lemma tendsto_id' {x y : filter α} : x ≤ y → tendsto id x y :=
-by simp only [tendsto, map_id, forall_true_iff] {contextual := tt}
+lemma tendsto_id' {x y : filter α} : tendsto id x y ↔ x ≤ y := iff.rfl
 
-lemma tendsto_id {x : filter α} : tendsto id x x := tendsto_id' $ le_refl x
+lemma tendsto_id {x : filter α} : tendsto id x x := le_refl x
 
 lemma tendsto.comp {f : α → β} {g : β → γ} {x : filter α} {y : filter β} {z : filter γ}
   (hg : tendsto g y z) (hf : tendsto f x y) : tendsto (g ∘ f) x z :=
-calc map (g ∘ f) x = map g (map f x) : by rw [map_map]
-  ... ≤ map g y : map_mono hf
-  ... ≤ z : hg
+λ s hs, hf (hg hs)
 
 lemma tendsto.mono_left {f : α → β} {x y : filter α} {z : filter β}
   (hx : tendsto f x z) (h : y ≤ x) : tendsto f y z :=
@@ -2392,6 +2544,10 @@ lemma tendsto_infi' {f : α → β} {x : ι → filter α} {y : filter β} (i :
   tendsto f (⨅ i, x i) y :=
 hi.mono_left $ infi_le _ _
 
+theorem tendsto_infi_infi {f : α → β} {x : ι → filter α} {y : ι → filter β}
+  (h : ∀ i, tendsto f (x i) (y i)) : tendsto f (infi x) (infi y) :=
+tendsto_infi.2 $ λ i, tendsto_infi' i (h i)
+
 @[simp] lemma tendsto_sup {f : α → β} {x₁ x₂ : filter α} {y : filter β} :
   tendsto f (x₁ ⊔ x₂) y ↔ tendsto f x₁ y ∧ tendsto f x₂ y :=
 by simp only [tendsto, map_sup, sup_le_iff]
@@ -2404,6 +2560,10 @@ lemma tendsto.sup {f : α → β} {x₁ x₂ : filter α} {y : filter β} :
   tendsto f (⨆ i, x i) y ↔ ∀ i, tendsto f (x i) y :=
 by simp only [tendsto, map_supr, supr_le_iff]
 
+theorem tendsto_supr_supr {f : α → β} {x : ι → filter α} {y : ι → filter β}
+  (h : ∀ i, tendsto f (x i) (y i)) : tendsto f (supr x) (supr y) :=
+tendsto_supr.2 $ λ i, (h i).mono_right $ le_supr _ _
+
 @[simp] lemma tendsto_principal {f : α → β} {l : filter α} {s : set β} :
   tendsto f l (𝓟 s) ↔ ∀ᶠ a in l, f a ∈ s :=
 by simp only [tendsto, le_principal_iff, mem_map', filter.eventually]
@@ -2441,8 +2601,9 @@ lemma tendsto.not_tendsto {f : α → β} {a : filter α} {b₁ b₂ : filter β
   ¬ tendsto f a b₂ :=
 λ hf', (tendsto_inf.2 ⟨hf, hf'⟩).ne_bot.ne hb.eq_bot
 
-lemma tendsto.if {l₁ : filter α} {l₂ : filter β} {f g : α → β} {p : α → Prop} [∀ x, decidable (p x)]
-  (h₀ : tendsto f (l₁ ⊓ 𝓟 {x | p x}) l₂) (h₁ : tendsto g (l₁ ⊓ 𝓟 { x | ¬ p x }) l₂) :
+protected lemma tendsto.if {l₁ : filter α} {l₂ : filter β} {f g : α → β} {p : α → Prop}
+  [∀ x, decidable (p x)] (h₀ : tendsto f (l₁ ⊓ 𝓟 {x | p x}) l₂)
+  (h₁ : tendsto g (l₁ ⊓ 𝓟 { x | ¬ p x }) l₂) :
   tendsto (λ x, if p x then f x else g x) l₁ l₂ :=
 begin
   simp only [tendsto_def, mem_inf_principal] at *,
@@ -2454,359 +2615,21 @@ begin
   exacts [hp₀ h, hp₁ h],
 end
 
-lemma tendsto.piecewise {l₁ : filter α} {l₂ : filter β} {f g : α → β}
+protected lemma tendsto.if' {α β : Type*} {l₁ : filter α} {l₂ : filter β} {f g : α → β}
+  {p : α → Prop} [decidable_pred p] (hf : tendsto f l₁ l₂) (hg : tendsto g l₁ l₂) :
+  tendsto (λ a, if p a then f a else g a) l₁ l₂ :=
+begin
+  replace hf : tendsto f (l₁ ⊓ 𝓟 {x | p x}) l₂ := tendsto_inf_left hf,
+  replace hg : tendsto g (l₁ ⊓ 𝓟 {x | ¬ p x}) l₂ := tendsto_inf_left hg,
+  exact hf.if hg,
+end
+
+protected lemma tendsto.piecewise {l₁ : filter α} {l₂ : filter β} {f g : α → β}
   {s : set α} [∀ x, decidable (x ∈ s)]
   (h₀ : tendsto f (l₁ ⊓ 𝓟 s) l₂) (h₁ : tendsto g (l₁ ⊓ 𝓟 sᶜ) l₂) :
   tendsto (piecewise s f g) l₁ l₂ :=
 h₀.if h₁
 
-/-! ### Products of filters -/
-
-section prod
-variables {s : set α} {t : set β} {f : filter α} {g : filter β}
-/- The product filter cannot be defined using the monad structure on filters. For example:
-
-  F := do {x ← seq, y ← top, return (x, y)}
-  hence:
-    s ∈ F  ↔  ∃ n, [n..∞] × univ ⊆ s
-
-  G := do {y ← top, x ← seq, return (x, y)}
-  hence:
-    s ∈ G  ↔  ∀ i:ℕ, ∃ n, [n..∞] × {i} ⊆ s
-
-  Now ⋃ i, [i..∞] × {i}  is in G but not in F.
-
-  As product filter we want to have F as result.
--/
-
-/-- Product of filters. This is the filter generated by cartesian products
-  of elements of the component filters. -/
-protected def prod (f : filter α) (g : filter β) : filter (α × β) :=
-f.comap prod.fst ⊓ g.comap prod.snd
-
-localized "infix ` ×ᶠ `:60 := filter.prod" in filter
-
-lemma prod_mem_prod {s : set α} {t : set β} {f : filter α} {g : filter β}
-  (hs : s ∈ f) (ht : t ∈ g) : s ×ˢ t ∈ f ×ᶠ g :=
-inter_mem_inf (preimage_mem_comap hs) (preimage_mem_comap ht)
-
-lemma mem_prod_iff {s : set (α×β)} {f : filter α} {g : filter β} :
-  s ∈ f ×ᶠ g ↔ (∃ t₁ ∈ f, ∃ t₂ ∈ g, t₁ ×ˢ t₂ ⊆ s) :=
-begin
-  simp only [filter.prod],
-  split,
-  { rintro ⟨t₁, ⟨s₁, hs₁, hts₁⟩, t₂, ⟨s₂, hs₂, hts₂⟩, rfl⟩,
-    exact  ⟨s₁, hs₁, s₂, hs₂, λ p ⟨h, h'⟩, ⟨hts₁ h, hts₂ h'⟩⟩ },
-  { rintro ⟨t₁, ht₁, t₂, ht₂, h⟩,
-    exact mem_inf_of_inter (preimage_mem_comap ht₁) (preimage_mem_comap ht₂) h }
-end
-
-@[simp] lemma prod_mem_prod_iff {s : set α} {t : set β} {f : filter α} {g : filter β}
-  [f.ne_bot] [g.ne_bot] :
-  s ×ˢ t ∈ f ×ᶠ g ↔ s ∈ f ∧ t ∈ g :=
-⟨λ h, let ⟨s', hs', t', ht', H⟩ := mem_prod_iff.1 h in (prod_subset_prod_iff.1 H).elim
-  (λ ⟨hs's, ht't⟩, ⟨mem_of_superset hs' hs's, mem_of_superset ht' ht't⟩)
-  (λ h, h.elim
-    (λ hs'e, absurd hs'e (nonempty_of_mem hs').ne_empty)
-    (λ ht'e, absurd ht'e (nonempty_of_mem ht').ne_empty)),
-  λ h, prod_mem_prod h.1 h.2⟩
-
-lemma mem_prod_principal {f : filter α} {s : set (α × β)} {t : set β}:
-  s ∈ f ×ᶠ 𝓟 t ↔ {a | ∀ b ∈ t, (a, b) ∈ s} ∈ f :=
-begin
-  rw [← @exists_mem_subset_iff _ f, mem_prod_iff],
-  refine exists₂_congr (λ u u_in, ⟨_, λ h, ⟨t, mem_principal_self t, _⟩⟩),
-  { rintros ⟨v, v_in, hv⟩ a a_in b b_in,
-    exact hv (mk_mem_prod a_in $ v_in b_in) },
-  { rintro ⟨x, y⟩ ⟨hx, hy⟩,
-    exact h hx y hy }
-end
-
-lemma mem_prod_top {f : filter α} {s : set (α × β)} :
-  s ∈ f ×ᶠ (⊤ : filter β) ↔ {a | ∀ b, (a, b) ∈ s} ∈ f :=
-begin
-  rw [← principal_univ, mem_prod_principal],
-  simp only [mem_univ, forall_true_left]
-end
-
-lemma comap_prod (f : α → β × γ) (b : filter β) (c : filter γ) :
-  comap f (b ×ᶠ c) = (comap (prod.fst ∘ f) b) ⊓ (comap (prod.snd ∘ f) c) :=
-by erw [comap_inf, filter.comap_comap, filter.comap_comap]
-
-lemma prod_top {f : filter α} : f ×ᶠ (⊤ : filter β) = f.comap prod.fst :=
-by rw [filter.prod, comap_top, inf_top_eq]
-
-lemma sup_prod (f₁ f₂ : filter α) (g : filter β) : (f₁ ⊔ f₂) ×ᶠ g = (f₁ ×ᶠ g) ⊔ (f₂ ×ᶠ g) :=
-by rw [filter.prod, comap_sup, inf_sup_right, ← filter.prod, ← filter.prod]
-
-lemma prod_sup (f : filter α) (g₁ g₂ : filter β) : f ×ᶠ (g₁ ⊔ g₂) = (f ×ᶠ g₁) ⊔ (f ×ᶠ g₂) :=
-by rw [filter.prod, comap_sup, inf_sup_left, ← filter.prod, ← filter.prod]
-
-lemma eventually_prod_iff {p : α × β → Prop} {f : filter α} {g : filter β} :
-  (∀ᶠ x in f ×ᶠ g, p x) ↔ ∃ (pa : α → Prop) (ha : ∀ᶠ x in f, pa x)
-    (pb : β → Prop) (hb : ∀ᶠ y in g, pb y), ∀ {x}, pa x → ∀ {y}, pb y → p (x, y) :=
-by simpa only [set.prod_subset_iff] using @mem_prod_iff α β p f g
-
-lemma tendsto_fst {f : filter α} {g : filter β} : tendsto prod.fst (f ×ᶠ g) f :=
-tendsto_inf_left tendsto_comap
-
-lemma tendsto_snd {f : filter α} {g : filter β} : tendsto prod.snd (f ×ᶠ g) g :=
-tendsto_inf_right tendsto_comap
-
-lemma tendsto.prod_mk {f : filter α} {g : filter β} {h : filter γ} {m₁ : α → β} {m₂ : α → γ}
-  (h₁ : tendsto m₁ f g) (h₂ : tendsto m₂ f h) : tendsto (λ x, (m₁ x, m₂ x)) f (g ×ᶠ h) :=
-tendsto_inf.2 ⟨tendsto_comap_iff.2 h₁, tendsto_comap_iff.2 h₂⟩
-
-lemma eventually.prod_inl {la : filter α} {p : α → Prop} (h : ∀ᶠ x in la, p x) (lb : filter β) :
-  ∀ᶠ x in la ×ᶠ lb, p (x : α × β).1 :=
-tendsto_fst.eventually h
-
-lemma eventually.prod_inr {lb : filter β} {p : β → Prop} (h : ∀ᶠ x in lb, p x) (la : filter α) :
-  ∀ᶠ x in la ×ᶠ lb, p (x : α × β).2 :=
-tendsto_snd.eventually h
-
-lemma eventually.prod_mk {la : filter α} {pa : α → Prop} (ha : ∀ᶠ x in la, pa x)
-  {lb : filter β} {pb : β → Prop} (hb : ∀ᶠ y in lb, pb y) :
-  ∀ᶠ p in la ×ᶠ lb, pa (p : α × β).1 ∧ pb p.2 :=
-(ha.prod_inl lb).and (hb.prod_inr la)
-
-lemma eventually_eq.prod_map {δ} {la : filter α} {fa ga : α → γ} (ha : fa =ᶠ[la] ga)
-  {lb : filter β} {fb gb : β → δ} (hb : fb =ᶠ[lb] gb) :
-  prod.map fa fb =ᶠ[la ×ᶠ lb] prod.map ga gb :=
-(eventually.prod_mk ha hb).mono $ λ x h, prod.ext h.1 h.2
-
-lemma eventually_le.prod_map {δ} [has_le γ] [has_le δ] {la : filter α} {fa ga : α → γ}
-  (ha : fa ≤ᶠ[la] ga) {lb : filter β} {fb gb : β → δ} (hb : fb ≤ᶠ[lb] gb) :
-  prod.map fa fb ≤ᶠ[la ×ᶠ lb] prod.map ga gb :=
-eventually.prod_mk ha hb
-
-lemma eventually.curry {la : filter α} {lb : filter β} {p : α × β → Prop}
-  (h : ∀ᶠ x in la ×ᶠ lb, p x) :
-  ∀ᶠ x in la, ∀ᶠ y in lb, p (x, y) :=
-begin
-  rcases eventually_prod_iff.1 h with ⟨pa, ha, pb, hb, h⟩,
-  exact ha.mono (λ a ha, hb.mono $ λ b hb, h ha hb)
-end
-
-lemma prod_infi_left [nonempty ι] {f : ι → filter α} {g : filter β}:
-  (⨅ i, f i) ×ᶠ g = (⨅ i, (f i) ×ᶠ g) :=
-by { rw [filter.prod, comap_infi, infi_inf], simp only [filter.prod, eq_self_iff_true] }
-
-lemma prod_infi_right [nonempty ι] {f : filter α} {g : ι → filter β} :
-  f ×ᶠ (⨅ i, g i) = (⨅ i, f ×ᶠ (g i)) :=
-by { rw [filter.prod, comap_infi, inf_infi], simp only [filter.prod, eq_self_iff_true] }
-
-@[mono] lemma prod_mono {f₁ f₂ : filter α} {g₁ g₂ : filter β} (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) :
-  f₁ ×ᶠ g₁ ≤ f₂ ×ᶠ g₂ :=
-inf_le_inf (comap_mono hf) (comap_mono hg)
-
-lemma prod_comap_comap_eq {α₁ : Type u} {α₂ : Type v} {β₁ : Type w} {β₂ : Type x}
-  {f₁ : filter α₁} {f₂ : filter α₂} {m₁ : β₁ → α₁} {m₂ : β₂ → α₂} :
-  (comap m₁ f₁) ×ᶠ (comap m₂ f₂) = comap (λ p : β₁×β₂, (m₁ p.1, m₂ p.2)) (f₁ ×ᶠ f₂) :=
-by simp only [filter.prod, comap_comap, eq_self_iff_true, comap_inf]
-
-lemma prod_comm' : f ×ᶠ g = comap (prod.swap) (g ×ᶠ f) :=
-by simp only [filter.prod, comap_comap, (∘), inf_comm, prod.fst_swap,
-  eq_self_iff_true, prod.snd_swap, comap_inf]
-
-lemma prod_comm : f ×ᶠ g = map (λ p : β×α, (p.2, p.1)) (g ×ᶠ f) :=
-by { rw [prod_comm', ← map_swap_eq_comap_swap], refl }
-
-lemma prod_map_map_eq {α₁ : Type u} {α₂ : Type v} {β₁ : Type w} {β₂ : Type x}
-  {f₁ : filter α₁} {f₂ : filter α₂} {m₁ : α₁ → β₁} {m₂ : α₂ → β₂} :
-  (map m₁ f₁) ×ᶠ (map m₂ f₂) = map (λ p : α₁×α₂, (m₁ p.1, m₂ p.2)) (f₁ ×ᶠ f₂) :=
-le_antisymm
-  (λ s hs,
-    let ⟨s₁, hs₁, s₂, hs₂, h⟩ := mem_prod_iff.mp hs in
-    filter.sets_of_superset _ (prod_mem_prod (image_mem_map hs₁) (image_mem_map hs₂)) $
-      calc (m₁ '' s₁) ×ˢ (m₂ '' s₂) = (λ p : α₁×α₂, (m₁ p.1, m₂ p.2)) '' s₁ ×ˢ s₂ :
-          set.prod_image_image_eq
-        ... ⊆ _ : by rwa [image_subset_iff])
-  ((tendsto.comp le_rfl tendsto_fst).prod_mk (tendsto.comp le_rfl tendsto_snd))
-
-lemma prod_map_map_eq' {α₁ : Type*} {α₂ : Type*} {β₁ : Type*} {β₂ : Type*}
-  (f : α₁ → α₂) (g : β₁ → β₂) (F : filter α₁) (G : filter β₁) :
-  (map f F) ×ᶠ (map g G) = map (prod.map f g) (F ×ᶠ G) :=
-prod_map_map_eq
-
-lemma le_prod_map_fst_snd {f : filter (α × β)} : f ≤ map prod.fst f ×ᶠ map prod.snd f :=
-le_inf le_comap_map le_comap_map
-
-lemma tendsto.prod_map {δ : Type*} {f : α → γ} {g : β → δ} {a : filter α} {b : filter β}
-  {c : filter γ} {d : filter δ} (hf : tendsto f a c) (hg : tendsto g b d) :
-  tendsto (prod.map f g) (a ×ᶠ b) (c ×ᶠ d) :=
-begin
-  erw [tendsto, ← prod_map_map_eq],
-  exact filter.prod_mono hf hg,
-end
-
-protected lemma map_prod (m : α × β → γ) (f : filter α) (g : filter β) :
-  map m (f ×ᶠ g) = (f.map (λ a b, m (a, b))).seq g :=
-begin
-  simp [filter.ext_iff, mem_prod_iff, mem_map_seq_iff],
-  intro s,
-  split,
-  exact λ ⟨t, ht, s, hs, h⟩, ⟨s, hs, t, ht, λ x hx y hy, @h ⟨x, y⟩ ⟨hx, hy⟩⟩,
-  exact λ ⟨s, hs, t, ht, h⟩, ⟨t, ht, s, hs, λ ⟨x, y⟩ ⟨hx, hy⟩, h x hx y hy⟩
-end
-
-lemma prod_eq {f : filter α} {g : filter β} : f ×ᶠ g = (f.map prod.mk).seq g  :=
-have h : _ := f.map_prod id g, by rwa [map_id] at h
-
-lemma prod_inf_prod {f₁ f₂ : filter α} {g₁ g₂ : filter β} :
-  (f₁ ×ᶠ g₁) ⊓ (f₂ ×ᶠ g₂) = (f₁ ⊓ f₂) ×ᶠ (g₁ ⊓ g₂) :=
-by simp only [filter.prod, comap_inf, inf_comm, inf_assoc, inf_left_comm]
-
-@[simp] lemma prod_bot {f : filter α} : f ×ᶠ (⊥ : filter β) = ⊥ := by simp [filter.prod]
-@[simp] lemma bot_prod {g : filter β} : (⊥ : filter α) ×ᶠ g = ⊥ := by simp [filter.prod]
-
-@[simp] lemma prod_principal_principal {s : set α} {t : set β} :
-  (𝓟 s) ×ᶠ (𝓟 t) = 𝓟 (s ×ˢ t) :=
-by simp only [filter.prod, comap_principal, principal_eq_iff_eq, comap_principal, inf_principal];
-  refl
-
-@[simp] lemma pure_prod {a : α} {f : filter β} : pure a ×ᶠ f = map (prod.mk a) f :=
-by rw [prod_eq, map_pure, pure_seq_eq_map]
-
-lemma map_pure_prod (f : α → β → γ) (a : α) (B : filter β) :
-  filter.map (function.uncurry f) (pure a ×ᶠ B) = filter.map (f a) B :=
-by { rw filter.pure_prod, refl }
-
-@[simp] lemma prod_pure {f : filter α} {b : β} : f ×ᶠ pure b = map (λ a, (a, b)) f :=
-by rw [prod_eq, seq_pure, map_map]
-
-lemma prod_pure_pure {a : α} {b : β} : (pure a) ×ᶠ (pure b) = pure (a, b) :=
-by simp
-
-lemma prod_eq_bot {f : filter α} {g : filter β} : f ×ᶠ g = ⊥ ↔ (f = ⊥ ∨ g = ⊥) :=
-begin
-  split,
-  { intro h,
-    rcases mem_prod_iff.1 (empty_mem_iff_bot.2 h) with ⟨s, hs, t, ht, hst⟩,
-    rw [subset_empty_iff, set.prod_eq_empty_iff] at hst,
-    cases hst with s_eq t_eq,
-    { left, exact empty_mem_iff_bot.1 (s_eq ▸ hs) },
-    { right, exact empty_mem_iff_bot.1 (t_eq ▸ ht) } },
-  { rintro (rfl | rfl),
-    exact bot_prod,
-    exact prod_bot }
-end
-
-lemma prod_ne_bot {f : filter α} {g : filter β} : ne_bot (f ×ᶠ g) ↔ (ne_bot f ∧ ne_bot g) :=
-by simp only [ne_bot_iff, ne, prod_eq_bot, not_or_distrib]
-
-lemma ne_bot.prod {f : filter α} {g : filter β} (hf : ne_bot f) (hg : ne_bot g) :
-  ne_bot (f ×ᶠ g) :=
-prod_ne_bot.2 ⟨hf, hg⟩
-
-instance prod_ne_bot' {f : filter α} {g : filter β} [hf : ne_bot f] [hg : ne_bot g] :
-  ne_bot (f ×ᶠ g) :=
-hf.prod hg
-
-lemma tendsto_prod_iff {f : α × β → γ} {x : filter α} {y : filter β} {z : filter γ} :
-  filter.tendsto f (x ×ᶠ y) z ↔
-  ∀ W ∈ z, ∃ U ∈ x,  ∃ V ∈ y, ∀ x y, x ∈ U → y ∈ V → f (x, y) ∈ W :=
-by simp only [tendsto_def, mem_prod_iff, prod_sub_preimage_iff, exists_prop, iff_self]
-
-lemma tendsto_prod_iff' {f : filter α} {g : filter β} {g' : filter γ}
-  {s : α → β × γ} :
-  tendsto s f (g ×ᶠ g') ↔ tendsto (λ n, (s n).1) f g ∧ tendsto (λ n, (s n).2) f g' :=
-by { unfold filter.prod, simp only [tendsto_inf, tendsto_comap_iff, iff_self] }
-
-end prod
-
-/-! ### Coproducts of filters -/
-
-section coprod
-variables {f : filter α} {g : filter β}
-
-/-- Coproduct of filters. -/
-protected def coprod (f : filter α) (g : filter β) : filter (α × β) :=
-f.comap prod.fst ⊔ g.comap prod.snd
-
-lemma mem_coprod_iff {s : set (α×β)} {f : filter α} {g : filter β} :
-  s ∈ f.coprod g ↔ ((∃ t₁ ∈ f, prod.fst ⁻¹' t₁ ⊆ s) ∧ (∃ t₂ ∈ g, prod.snd ⁻¹' t₂ ⊆ s)) :=
-by simp [filter.coprod]
-
-@[simp] lemma bot_coprod (l : filter β) : (⊥ : filter α).coprod l = comap prod.snd l :=
-by simp [filter.coprod]
-
-@[simp] lemma coprod_bot (l : filter α) : l.coprod (⊥ : filter β) = comap prod.fst l :=
-by simp [filter.coprod]
-
-lemma bot_coprod_bot : (⊥ : filter α).coprod (⊥ : filter β) = ⊥ := by simp
-
-lemma compl_mem_coprod {s : set (α × β)} {la : filter α} {lb : filter β} :
-  sᶜ ∈ la.coprod lb ↔ (prod.fst '' s)ᶜ ∈ la ∧ (prod.snd '' s)ᶜ ∈ lb :=
-by simp only [filter.coprod, mem_sup, compl_mem_comap]
-
-@[mono] lemma coprod_mono {f₁ f₂ : filter α} {g₁ g₂ : filter β} (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) :
-  f₁.coprod g₁ ≤ f₂.coprod g₂ :=
-sup_le_sup (comap_mono hf) (comap_mono hg)
-
-lemma coprod_ne_bot_iff : (f.coprod g).ne_bot ↔ f.ne_bot ∧ nonempty β ∨ nonempty α ∧ g.ne_bot :=
-by simp [filter.coprod]
-
-@[instance] lemma coprod_ne_bot_left [ne_bot f] [nonempty β] : (f.coprod g).ne_bot :=
-coprod_ne_bot_iff.2 (or.inl ⟨‹_›, ‹_›⟩)
-
-@[instance] lemma coprod_ne_bot_right [ne_bot g] [nonempty α] : (f.coprod g).ne_bot :=
-coprod_ne_bot_iff.2 (or.inr ⟨‹_›, ‹_›⟩)
-
-lemma principal_coprod_principal (s : set α) (t : set β) :
-  (𝓟 s).coprod (𝓟 t) = 𝓟 (sᶜ ×ˢ tᶜ)ᶜ :=
-by rw [filter.coprod, comap_principal, comap_principal, sup_principal, set.prod_eq, compl_inter,
-  preimage_compl, preimage_compl, compl_compl, compl_compl]
-
--- this inequality can be strict; see `map_const_principal_coprod_map_id_principal` and
--- `map_prod_map_const_id_principal_coprod_principal` below.
-lemma map_prod_map_coprod_le {α₁ : Type u} {α₂ : Type v} {β₁ : Type w} {β₂ : Type x}
-  {f₁ : filter α₁} {f₂ : filter α₂} {m₁ : α₁ → β₁} {m₂ : α₂ → β₂} :
-  map (prod.map m₁ m₂) (f₁.coprod f₂) ≤ (map m₁ f₁).coprod (map m₂ f₂) :=
-begin
-  intros s,
-  simp only [mem_map, mem_coprod_iff],
-  rintro ⟨⟨u₁, hu₁, h₁⟩, u₂, hu₂, h₂⟩,
-  refine ⟨⟨m₁ ⁻¹' u₁, hu₁, λ _ hx, h₁ _⟩, ⟨m₂ ⁻¹' u₂, hu₂, λ _ hx, h₂ _⟩⟩; convert hx
-end
-
-/-- Characterization of the coproduct of the `filter.map`s of two principal filters `𝓟 {a}` and
-`𝓟 {i}`, the first under the constant function `λ a, b` and the second under the identity function.
-Together with the next lemma, `map_prod_map_const_id_principal_coprod_principal`, this provides an
-example showing that the inequality in the lemma `map_prod_map_coprod_le` can be strict. -/
-lemma map_const_principal_coprod_map_id_principal {α β ι : Type*} (a : α) (b : β) (i : ι) :
-  (map (λ _ : α, b) (𝓟 {a})).coprod (map id (𝓟 {i}))
-  = 𝓟 (({b} : set β) ×ˢ (univ : set ι) ∪ (univ : set β) ×ˢ ({i} : set ι)) :=
-by simp only [map_principal, filter.coprod, comap_principal, sup_principal, image_singleton,
-  image_id, prod_univ, univ_prod]
-
-/-- Characterization of the `filter.map` of the coproduct of two principal filters `𝓟 {a}` and
-`𝓟 {i}`, under the `prod.map` of two functions, respectively the constant function `λ a, b` and the
-identity function.  Together with the previous lemma,
-`map_const_principal_coprod_map_id_principal`, this provides an example showing that the inequality
-in the lemma `map_prod_map_coprod_le` can be strict. -/
-lemma map_prod_map_const_id_principal_coprod_principal {α β ι : Type*} (a : α) (b : β) (i : ι) :
-  map (prod.map (λ _ : α, b) id) ((𝓟 {a}).coprod (𝓟 {i}))
-  = 𝓟 (({b} : set β) ×ˢ (univ : set ι)) :=
-begin
-  rw [principal_coprod_principal, map_principal],
-  congr,
-  ext ⟨b', i'⟩,
-  split,
-  { rintro ⟨⟨a'', i''⟩, h₁, h₂, h₃⟩,
-    simp },
-  { rintro ⟨h₁, h₂⟩,
-    use (a, i'),
-    simpa using h₁.symm }
-end
-
-lemma tendsto.prod_map_coprod {δ : Type*} {f : α → γ} {g : β → δ} {a : filter α} {b : filter β}
-  {c : filter γ} {d : filter δ} (hf : tendsto f a c) (hg : tendsto g b d) :
-  tendsto (prod.map f g) (a.coprod b) (c.coprod d) :=
-map_prod_map_coprod_le.trans (coprod_mono hf hg)
-
-end coprod
-
 end filter
 
 open_locale filter
@@ -2820,7 +2643,7 @@ lemma set.eq_on.eventually_eq_of_mem {α β} {s : set α} {l : filter α} {f g :
   f =ᶠ[l] g :=
 h.eventually_eq.filter_mono $ filter.le_principal_iff.2 hl
 
-lemma set.subset.eventually_le {α} {l : filter α} {s t : set α} (h : s ⊆ t) : s ≤ᶠ[l] t :=
+lemma has_subset.subset.eventually_le {α} {l : filter α} {s t : set α} (h : s ⊆ t) : s ≤ᶠ[l] t :=
 filter.eventually_of_forall h
 
 lemma set.maps_to.tendsto {α β} {s : set α} {t : set β} {f : α → β} (h : maps_to f s t) :
diff --git a/src/order/filter/cofinite.lean b/src/order/filter/cofinite.lean
index 38f8908f2dec6..a9257107c807b 100644
--- a/src/order/filter/cofinite.lean
+++ b/src/order/filter/cofinite.lean
@@ -9,6 +9,9 @@ import order.filter.pi
 /-!
 # The cofinite filter
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define
 
 `cofinite`: the filter of sets with finite complement
@@ -23,23 +26,23 @@ Define filters for other cardinalities of the complement.
 open set function
 open_locale classical
 
-variables {ι α β : Type*}
+variables {ι α β : Type*} {l : filter α}
 
 namespace filter
 
 /-- The cofinite filter is the filter of subsets whose complements are finite. -/
 def cofinite : filter α :=
-{ sets             := {s | finite sᶜ},
+{ sets             := {s | sᶜ.finite},
   univ_sets        := by simp only [compl_univ, finite_empty, mem_set_of_eq],
-  sets_of_superset := assume s t (hs : finite sᶜ) (st: s ⊆ t),
+  sets_of_superset := assume s t (hs : sᶜ.finite) (st: s ⊆ t),
     hs.subset $ compl_subset_compl.2 st,
-  inter_sets       := assume s t (hs : finite sᶜ) (ht : finite (tᶜ)),
+  inter_sets       := assume s t (hs : sᶜ.finite) (ht : tᶜ.finite),
     by simp only [compl_inter, finite.union, ht, hs, mem_set_of_eq] }
 
-@[simp] lemma mem_cofinite {s : set α} : s ∈ (@cofinite α) ↔ finite sᶜ := iff.rfl
+@[simp] lemma mem_cofinite {s : set α} : s ∈ (@cofinite α) ↔ sᶜ.finite := iff.rfl
 
 @[simp] lemma eventually_cofinite {p : α → Prop} :
-  (∀ᶠ x in cofinite, p x) ↔ finite {x | ¬p x} := iff.rfl
+  (∀ᶠ x in cofinite, p x) ↔ {x | ¬p x}.finite := iff.rfl
 
 lemma has_basis_cofinite : has_basis cofinite (λ s : set α, s.finite) compl :=
 ⟨λ s, ⟨λ h, ⟨sᶜ, h, (compl_compl s).subset⟩, λ ⟨t, htf, hts⟩, htf.subset $ compl_subset_comm.2 hts⟩⟩
@@ -69,16 +72,14 @@ frequently_cofinite_iff_infinite.symm
 lemma eventually_cofinite_ne (x : α) : ∀ᶠ a in cofinite, a ≠ x :=
 (set.finite_singleton x).eventually_cofinite_nmem
 
-lemma le_cofinite_iff_compl_singleton_mem {l : filter α} :
-  l ≤ cofinite ↔ ∀ x, {x}ᶜ ∈ l :=
+lemma le_cofinite_iff_compl_singleton_mem : l ≤ cofinite ↔ ∀ x, {x}ᶜ ∈ l :=
 begin
   refine ⟨λ h x, h (finite_singleton x).compl_mem_cofinite, λ h s (hs : sᶜ.finite), _⟩,
   rw [← compl_compl s, ← bUnion_of_singleton sᶜ, compl_Union₂,filter.bInter_mem hs],
   exact λ x _, h x
 end
 
-lemma le_cofinite_iff_eventually_ne {l : filter α} :
-  l ≤ cofinite ↔ ∀ x, ∀ᶠ y in l, y ≠ x :=
+lemma le_cofinite_iff_eventually_ne : l ≤ cofinite ↔ ∀ x, ∀ᶠ y in l, y ≠ x :=
 le_cofinite_iff_compl_singleton_mem
 
 /-- If `α` is a preorder with no maximal element, then `at_top ≤ cofinite`. -/
@@ -95,11 +96,20 @@ filter.coext $ λ s, by simp only [compl_mem_coprod, mem_cofinite, compl_compl,
   finite_image_fst_and_snd_iff]
 
 /-- Finite product of finite sets is finite -/
-lemma Coprod_cofinite {α : ι → Type*} [fintype ι] :
+lemma Coprod_cofinite {α : ι → Type*} [finite ι] :
   filter.Coprod (λ i, (cofinite : filter (α i))) = cofinite :=
 filter.coext $ λ s, by simp only [compl_mem_Coprod, mem_cofinite, compl_compl,
   forall_finite_image_eval_iff]
 
+@[simp] lemma disjoint_cofinite_left : disjoint cofinite l ↔ ∃ s ∈ l, set.finite s :=
+begin
+  simp only [has_basis_cofinite.disjoint_iff l.basis_sets, id, disjoint_compl_left_iff_subset],
+  exact ⟨λ ⟨s, hs, t, ht, hts⟩, ⟨t, ht, hs.subset hts⟩, λ ⟨s, hs, hsf⟩, ⟨s, hsf, s, hs, subset.rfl⟩⟩
+end
+
+@[simp] lemma disjoint_cofinite_right : disjoint l cofinite ↔ ∃ s ∈ l, set.finite s :=
+disjoint.comm.trans disjoint_cofinite_left
+
 end filter
 
 open filter
@@ -123,7 +133,7 @@ lemma filter.tendsto.exists_within_forall_le {α β : Type*} [linear_order β] {
 begin
   rcases em (∃ y ∈ s, ∃ x, f y < x) with ⟨y, hys, x, hx⟩|not_all_top,
   { -- the set of points `{y | f y < x}` is nonempty and finite, so we take `min` over this set
-    have : finite {y | ¬x ≤ f y} := (filter.eventually_cofinite.mp (tendsto_at_top.1 hf x)),
+    have : {y | ¬x ≤ f y}.finite := (filter.eventually_cofinite.mp (tendsto_at_top.1 hf x)),
     simp only [not_le] at this,
     obtain ⟨a₀, ⟨ha₀ : f a₀ < x, ha₀s⟩, others_bigger⟩ :=
       exists_min_image _ f (this.inter_of_left s) ⟨y, hx, hys⟩,
diff --git a/src/order/filter/countable_Inter.lean b/src/order/filter/countable_Inter.lean
index 48c7dc690b176..9dbcb17230763 100644
--- a/src/order/filter/countable_Inter.lean
+++ b/src/order/filter/countable_Inter.lean
@@ -9,10 +9,13 @@ import data.set.countable
 /-!
 # Filters with countable intersection property
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `countable_Inter_filter` to be the class of filters with the following
 property: for any countable collection of sets `s ∈ l` their intersection belongs to `l` as well.
 
-Two main examples are the `residual` filter defined in `topology.metric_space.baire` and
+Two main examples are the `residual` filter defined in `topology.G_delta` and
 the `measure.ae` filter defined in `measure_theory.measure_space`.
 
 We reformulate the definition in terms of indexed intersection and in terms of `filter.eventually`
@@ -27,26 +30,25 @@ filter, countable
 open set filter
 open_locale filter
 
-variables {ι α β : Type*}
+variables {ι : Sort*} {α β : Type*}
 
 /-- A filter `l` has the countable intersection property if for any countable collection
 of sets `s ∈ l` their intersection belongs to `l` as well. -/
 class countable_Inter_filter (l : filter α) : Prop :=
 (countable_sInter_mem' :
-  ∀ {S : set (set α)} (hSc : countable S) (hS : ∀ s ∈ S, s ∈ l), ⋂₀ S ∈ l)
+  ∀ {S : set (set α)} (hSc : S.countable) (hS : ∀ s ∈ S, s ∈ l), ⋂₀ S ∈ l)
 
 variables {l : filter α} [countable_Inter_filter l]
 
-lemma countable_sInter_mem {S : set (set α)} (hSc : countable S) :
+lemma countable_sInter_mem {S : set (set α)} (hSc : S.countable) :
   ⋂₀ S ∈ l ↔ ∀ s ∈ S, s ∈ l :=
 ⟨λ hS s hs, mem_of_superset hS (sInter_subset_of_mem hs),
   countable_Inter_filter.countable_sInter_mem' hSc⟩
 
-lemma countable_Inter_mem [encodable ι] {s : ι → set α} :
-  (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
+lemma countable_Inter_mem [countable ι] {s : ι → set α} : (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
 sInter_range s ▸ (countable_sInter_mem (countable_range _)).trans forall_range_iff
 
-lemma countable_bInter_mem {S : set ι} (hS : countable S) {s : Π i ∈ S, set α} :
+lemma countable_bInter_mem {ι : Type*} {S : set ι} (hS : S.countable) {s : Π i ∈ S, set α} :
   (⋂ i ∈ S, s i ‹_›) ∈ l ↔  ∀ i ∈ S, s i ‹_› ∈ l :=
 begin
   rw [bInter_eq_Inter],
@@ -54,65 +56,70 @@ begin
   exact countable_Inter_mem.trans subtype.forall
 end
 
-lemma eventually_countable_forall [encodable ι] {p : α → ι → Prop} :
+lemma eventually_countable_forall [countable ι] {p : α → ι → Prop} :
   (∀ᶠ x in l, ∀ i, p x i) ↔ ∀ i, ∀ᶠ x in l, p x i :=
 by simpa only [filter.eventually, set_of_forall]
   using @countable_Inter_mem _ _ l _ _ (λ i, {x | p x i})
 
-lemma eventually_countable_ball {S : set ι} (hS : countable S) {p : Π (x : α) (i ∈ S), Prop} :
+lemma eventually_countable_ball {ι : Type*} {S : set ι} (hS : S.countable)
+  {p : Π (x : α) (i ∈ S), Prop} :
   (∀ᶠ x in l, ∀ i ∈ S, p x i ‹_›) ↔ ∀ i ∈ S, ∀ᶠ x in l, p x i ‹_› :=
 by simpa only [filter.eventually, set_of_forall]
-  using @countable_bInter_mem _ _ l _ _ hS (λ i hi, {x | p x i hi})
+  using @countable_bInter_mem _ l _ _ _ hS (λ i hi, {x | p x i hi})
 
-lemma eventually_le.countable_Union [encodable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
+lemma eventually_le.countable_Union [countable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
   (⋃ i, s i) ≤ᶠ[l] ⋃ i, t i :=
 (eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Union.2 $
   (mem_Union.1 hs).imp hst
 
-lemma eventually_eq.countable_Union [encodable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
+lemma eventually_eq.countable_Union [countable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
   (⋃ i, s i) =ᶠ[l] ⋃ i, t i :=
 (eventually_le.countable_Union (λ i, (h i).le)).antisymm
   (eventually_le.countable_Union (λ i, (h i).symm.le))
 
-lemma eventually_le.countable_bUnion {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
-  (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) : (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
+lemma eventually_le.countable_bUnion {ι : Type*} {S : set ι} (hS : S.countable)
+  {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) :
+  (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
 begin
   simp only [bUnion_eq_Union],
   haveI := hS.to_encodable,
   exact eventually_le.countable_Union (λ i, h i i.2)
 end
 
-lemma eventually_eq.countable_bUnion {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
-  (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) : (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
+lemma eventually_eq.countable_bUnion {ι : Type*} {S : set ι} (hS : S.countable)
+  {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) :
+  (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
 (eventually_le.countable_bUnion hS (λ i hi, (h i hi).le)).antisymm
   (eventually_le.countable_bUnion hS (λ i hi, (h i hi).symm.le))
 
-lemma eventually_le.countable_Inter [encodable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
+lemma eventually_le.countable_Inter [countable ι] {s t : ι → set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
   (⋂ i, s i) ≤ᶠ[l] ⋂ i, t i :=
 (eventually_countable_forall.2 h).mono $ λ x hst hs, mem_Inter.2 $ λ i, hst _ (mem_Inter.1 hs i)
 
-lemma eventually_eq.countable_Inter [encodable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
+lemma eventually_eq.countable_Inter [countable ι] {s t : ι → set α} (h : ∀ i, s i =ᶠ[l] t i) :
   (⋂ i, s i) =ᶠ[l] ⋂ i, t i :=
 (eventually_le.countable_Inter (λ i, (h i).le)).antisymm
   (eventually_le.countable_Inter (λ i, (h i).symm.le))
 
-lemma eventually_le.countable_bInter {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
-  (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) : (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
+lemma eventually_le.countable_bInter {ι : Type*} {S : set ι} (hS : S.countable)
+  {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) :
+  (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
 begin
   simp only [bInter_eq_Inter],
   haveI := hS.to_encodable,
   exact eventually_le.countable_Inter (λ i, h i i.2)
 end
 
-lemma eventually_eq.countable_bInter {S : set ι} (hS : countable S) {s t : Π i ∈ S, set α}
-  (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) : (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
+lemma eventually_eq.countable_bInter {ι : Type*} {S : set ι} (hS : S.countable)
+ {s t : Π i ∈ S, set α} (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) :
+ (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
 (eventually_le.countable_bInter hS (λ i hi, (h i hi).le)).antisymm
   (eventually_le.countable_bInter hS (λ i hi, (h i hi).symm.le))
 
 /-- Construct a filter with countable intersection property. This constructor deduces
 `filter.univ_sets` and `filter.inter_sets` from the countable intersection property. -/
 def filter.of_countable_Inter (l : set (set α))
-  (hp : ∀ S : set (set α), countable S → S ⊆ l → (⋂₀ S) ∈ l)
+  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
   (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
   filter α :=
 { sets := l,
@@ -122,12 +129,12 @@ def filter.of_countable_Inter (l : set (set α))
     hp _ ((countable_singleton _).insert _) (insert_subset.2 ⟨hs, singleton_subset_iff.2 ht⟩) }
 
 instance filter.countable_Inter_of_countable_Inter (l : set (set α))
-  (hp : ∀ S : set (set α), countable S → S ⊆ l → (⋂₀ S) ∈ l)
+  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
   (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
   countable_Inter_filter (filter.of_countable_Inter l hp h_mono) := ⟨hp⟩
 
 @[simp] lemma filter.mem_of_countable_Inter {l : set (set α)}
-  (hp : ∀ S : set (set α), countable S → S ⊆ l → (⋂₀ S) ∈ l)
+  (hp : ∀ S : set (set α), S.countable → S ⊆ l → (⋂₀ S) ∈ l)
   (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) {s : set α} :
   s ∈ filter.of_countable_Inter l hp h_mono ↔ s ∈ l :=
 iff.rfl
@@ -182,3 +189,72 @@ begin
   refine ⟨λ S hSc hS, ⟨_, _⟩⟩; refine (countable_sInter_mem hSc).2 (λ s hs, _),
   exacts [(hS s hs).1, (hS s hs).2]
 end
+
+namespace filter
+
+variable (g : set (set α))
+
+/-- `filter.countable_generate_sets g` is the (sets of the)
+greatest `countable_Inter_filter` containing `g`.-/
+inductive countable_generate_sets : set α → Prop
+| basic {s : set α}      : s ∈ g → countable_generate_sets s
+| univ                   : countable_generate_sets univ
+| superset {s t : set α} : countable_generate_sets s → s ⊆ t → countable_generate_sets t
+| Inter {S : set (set α)}  : S.countable →
+    (∀ s ∈ S, countable_generate_sets s) → countable_generate_sets ⋂₀ S
+
+/-- `filter.countable_generate g` is the greatest `countable_Inter_filter` containing `g`.-/
+@[derive countable_Inter_filter]
+def countable_generate : filter α :=
+of_countable_Inter (countable_generate_sets g) (λ S, countable_generate_sets.Inter)
+  (λ s t, countable_generate_sets.superset)
+
+variable {g}
+
+/-- A set is in the `countable_Inter_filter` generated by `g` if and only if
+it contains a countable intersection of elements of `g`. -/
+lemma mem_countable_generate_iff {s : set α} : s ∈ countable_generate g ↔
+  ∃ (S : set (set α)), S ⊆ g ∧ S.countable ∧ ⋂₀ S ⊆ s :=
+begin
+  split; intro h,
+  { induction h with s hs s t hs st ih S Sct hS ih,
+    { exact ⟨{s}, by simp[hs]⟩ },
+    { exact ⟨∅, by simp⟩ },
+    { refine exists_imp_exists (λ S, _) ih,
+      tauto },
+    choose T Tg Tct hT using ih,
+    refine ⟨⋃ s (H : s ∈ S), T s H, by simpa, Sct.bUnion Tct, _⟩,
+    apply subset_sInter,
+    intros s H,
+    refine subset_trans (sInter_subset_sInter (subset_Union₂ s H)) (hT s H), },
+  rcases h with ⟨S, Sg, Sct, hS⟩,
+  refine mem_of_superset ((countable_sInter_mem Sct).mpr _) hS,
+  intros s H,
+  exact countable_generate_sets.basic (Sg H),
+end
+
+lemma le_countable_generate_iff_of_countable_Inter_filter {f : filter α}
+  [countable_Inter_filter f] : f ≤ countable_generate g ↔ g ⊆ f.sets :=
+begin
+  split; intro h,
+  { exact subset_trans (λ s, countable_generate_sets.basic) h },
+  intros s hs,
+  induction hs with s hs s t hs st ih S Sct hS ih,
+  { exact h hs },
+  { exact univ_mem },
+  { exact mem_of_superset ih st, },
+  exact (countable_sInter_mem Sct).mpr ih,
+end
+
+variable (g)
+
+/-- `countable_generate g` is the greatest `countable_Inter_filter` containing `g`.-/
+lemma countable_generate_is_greatest : is_greatest
+  {f : filter α | countable_Inter_filter f ∧ g ⊆ f.sets} (countable_generate g) :=
+begin
+  refine ⟨⟨infer_instance, λ s, countable_generate_sets.basic⟩, _⟩,
+  rintros f ⟨fct, hf⟩,
+  rwa @le_countable_generate_iff_of_countable_Inter_filter _ _ _ fct,
+end
+
+end filter
diff --git a/src/order/filter/curry.lean b/src/order/filter/curry.lean
new file mode 100644
index 0000000000000..49208acf1904c
--- /dev/null
+++ b/src/order/filter/curry.lean
@@ -0,0 +1,92 @@
+/-
+Copyright (c) 2022 Kevin H. Wilson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kevin H. Wilson
+-/
+import order.filter.prod
+
+/-!
+# Curried Filters
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides an operation (`filter.curry`) on filters which provides the equivalence
+`∀ᶠ a in l, ∀ᶠ b in l', p (a, b) ↔ ∀ᶠ c in (l.curry l'), p c` (see `filter.eventually_curry_iff`).
+
+To understand when this operation might arise, it is helpful to think of `∀ᶠ` as a combination of
+the quantifiers `∃ ∀`. For instance, `∀ᶠ n in at_top, p n ↔ ∃ N, ∀ n ≥ N, p n`. A curried filter
+yields the quantifier order `∃ ∀ ∃ ∀`. For instance,
+`∀ᶠ n in at_top.curry at_top, p n ↔ ∃ M, ∀ m ≥ M, ∃ N, ∀ n ≥ N, p (m, n)`.
+
+This is different from a product filter, which instead yields a quantifier order `∃ ∃ ∀ ∀`. For
+instance, `∀ᶠ n in at_top ×ᶠ at_top, p n ↔ ∃ M, ∃ N, ∀ m ≥ M, ∀ n ≥ N, p (m, n)`. This makes it
+clear that if something eventually occurs on the product filter, it eventually occurs on the curried
+filter (see `filter.curry_le_prod` and `filter.eventually.curry`), but the converse is not true.
+
+Another way to think about the curried versus the product filter is that tending to some limit on
+the product filter is a version of uniform convergence (see `tendsto_prod_filter_iff`) whereas
+tending to some limit on a curried filter is just iterated limits (see `tendsto.curry`).
+
+## Main definitions
+
+* `filter.curry`: A binary operation on filters which represents iterated limits
+
+## Main statements
+
+* `filter.eventually_curry_iff`: An alternative definition of a curried filter
+* `filter.curry_le_prod`: Something that is eventually true on the a product filter is eventually
+   true on the curried filter
+
+## Tags
+
+uniform convergence, curried filters, product filters
+-/
+
+namespace filter
+
+variables {α β γ : Type*}
+
+/-- This filter is characterized by `filter.eventually_curry_iff`:
+`(∀ᶠ (x : α × β) in f.curry g, p x) ↔ ∀ᶠ (x : α) in f, ∀ᶠ (y : β) in g, p (x, y)`. Useful
+in adding quantifiers to the middle of `tendsto`s. See
+`has_fderiv_at_of_tendsto_uniformly_on_filter`. -/
+def curry (f : filter α) (g : filter β) : filter (α × β) :=
+{ sets := { s | ∀ᶠ (a : α) in f, ∀ᶠ (b : β) in g, (a, b) ∈ s },
+  univ_sets := (by simp only [set.mem_set_of_eq, set.mem_univ, eventually_true]),
+  sets_of_superset := begin
+    intros x y hx hxy,
+    simp only [set.mem_set_of_eq] at hx ⊢,
+    exact hx.mono (λ a ha, ha.mono(λ b hb, set.mem_of_subset_of_mem hxy hb)),
+  end,
+  inter_sets := begin
+    intros x y hx hy,
+    simp only [set.mem_set_of_eq, set.mem_inter_iff] at hx hy ⊢,
+    exact (hx.and hy).mono (λ a ha, (ha.1.and ha.2).mono (λ b hb, hb)),
+  end, }
+
+lemma eventually_curry_iff {f : filter α} {g : filter β} {p : α × β → Prop} :
+  (∀ᶠ (x : α × β) in f.curry g, p x) ↔ ∀ᶠ (x : α) in f, ∀ᶠ (y : β) in g, p (x, y) :=
+iff.rfl
+
+lemma curry_le_prod {f : filter α} {g : filter β} :
+  f.curry g ≤ f.prod g :=
+begin
+  intros u hu,
+  rw ←eventually_mem_set at hu ⊢,
+  rw eventually_curry_iff,
+  exact hu.curry,
+end
+
+lemma tendsto.curry {f : α → β → γ} {la : filter α} {lb : filter β} {lc : filter γ} :
+  (∀ᶠ a in la, tendsto (λ b : β, f a b) lb lc) → tendsto ↿f (la.curry lb) lc :=
+begin
+  intros h,
+  rw tendsto_def,
+  simp only [curry, filter.mem_mk, set.mem_set_of_eq, set.mem_preimage],
+  simp_rw tendsto_def at h,
+  refine (λ s hs, h.mono (λ a ha, eventually_iff.mpr _)),
+  simpa [function.has_uncurry.uncurry, set.preimage] using ha s hs,
+end
+
+end filter
diff --git a/src/order/filter/default.lean b/src/order/filter/default.lean
deleted file mode 100644
index 20469ede615cc..0000000000000
--- a/src/order/filter/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import order.filter.partial
diff --git a/src/order/filter/ennreal.lean b/src/order/filter/ennreal.lean
index 2673f8643da8e..7a9f03cf5b166 100644
--- a/src/order/filter/ennreal.lean
+++ b/src/order/filter/ennreal.lean
@@ -3,14 +3,14 @@ Copyright (c) 2021 Rémy Degenne. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
-
-import data.real.ennreal
-import order.filter.countable_Inter
-import order.liminf_limsup
+import topology.instances.ennreal
 
 /-!
 # Order properties of extended non-negative reals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file compiles filter-related results about `ℝ≥0∞` (see data/real/ennreal.lean).
 -/
 
@@ -22,34 +22,11 @@ variables {α : Type*} {f : filter α}
 
 lemma eventually_le_limsup [countable_Inter_filter f] (u : α → ℝ≥0∞) :
   ∀ᶠ y in f, u y ≤ f.limsup u :=
-begin
-  by_cases hx_top : f.limsup u = ⊤,
-  { simp_rw hx_top,
-    exact eventually_of_forall (λ a, le_top), },
-  have h_forall_le : ∀ᶠ y in f, ∀ n : ℕ, u y < f.limsup u + (1:ℝ≥0∞)/n,
-  { rw eventually_countable_forall,
-    refine λ n, eventually_lt_of_limsup_lt _,
-    nth_rewrite 0 ←add_zero (f.limsup u),
-    exact (ennreal.add_lt_add_iff_left hx_top).mpr (by simp), },
-  refine h_forall_le.mono (λ y hy, le_of_forall_pos_le_add (λ r hr_pos hx_top, _)),
-  have hr_ne_zero : (r : ℝ≥0∞) ≠ 0,
-  { rw [ne.def, coe_eq_zero],
-    exact (ne_of_lt hr_pos).symm, },
-  cases (exists_inv_nat_lt hr_ne_zero) with i hi,
-  rw inv_eq_one_div at hi,
-  exact (hy i).le.trans (add_le_add_left hi.le (f.limsup u)),
-end
+eventually_le_limsup
 
 lemma limsup_eq_zero_iff [countable_Inter_filter f] {u : α → ℝ≥0∞} :
   f.limsup u = 0 ↔ u =ᶠ[f] 0 :=
-begin
-  split; intro h,
-  { have hu_zero := eventually_le.trans (eventually_le_limsup u)
-      (eventually_of_forall (λ _, le_of_eq h)),
-    exact hu_zero.mono (λ x hx, le_antisymm hx (zero_le _)), },
-  { rw limsup_congr h,
-    simp_rw [pi.zero_apply, ←ennreal.bot_eq_zero, limsup_const_bot] },
-end
+limsup_eq_bot
 
 lemma limsup_const_mul_of_ne_top {u : α → ℝ≥0∞} {a : ℝ≥0∞} (ha_top : a ≠ ⊤) :
   f.limsup (λ (x : α), a * (u x)) = a * f.limsup u :=
@@ -60,8 +37,8 @@ begin
   let g := λ x : ℝ≥0∞, a * x,
   have hg_bij : function.bijective g,
   from function.bijective_iff_has_inverse.mpr ⟨(λ x, a⁻¹ * x),
-    ⟨λ x, by simp [←mul_assoc, inv_mul_cancel ha_zero ha_top],
-    λ x, by simp [g, ←mul_assoc, mul_inv_cancel ha_zero ha_top]⟩⟩,
+    ⟨λ x, by simp [←mul_assoc, ennreal.inv_mul_cancel ha_zero ha_top],
+    λ x, by simp [g, ←mul_assoc, ennreal.mul_inv_cancel ha_zero ha_top]⟩⟩,
   have hg_mono : strict_mono g,
     from monotone.strict_mono_of_injective
       (λ _ _ _, by rwa mul_le_mul_left ha_zero ha_top) hg_bij.1,
@@ -95,12 +72,22 @@ begin
     simp only [h_top_le, hfu, if_false], },
 end
 
+lemma limsup_mul_le [countable_Inter_filter f] (u v : α → ℝ≥0∞) :
+  f.limsup (u * v) ≤ f.limsup u * f.limsup v :=
+calc f.limsup (u * v) ≤ f.limsup (λ x, (f.limsup u) * v x) :
+  begin
+    refine limsup_le_limsup _ _,
+    { filter_upwards [@eventually_le_limsup _ f _ u] with x hx using mul_le_mul_right' hx _ },
+    { is_bounded_default, },
+  end
+... = f.limsup u * f.limsup v : limsup_const_mul
+
 lemma limsup_add_le [countable_Inter_filter f] (u v : α → ℝ≥0∞) :
   f.limsup (u + v) ≤ f.limsup u + f.limsup v :=
 Inf_le ((eventually_le_limsup u).mp ((eventually_le_limsup v).mono
   (λ _ hxg hxf, add_le_add hxf hxg)))
 
-lemma limsup_liminf_le_liminf_limsup {β} [encodable β] {f : filter α} [countable_Inter_filter f]
+lemma limsup_liminf_le_liminf_limsup {β} [countable β] {f : filter α} [countable_Inter_filter f]
   {g : filter β} (u : α → β → ℝ≥0∞) :
   f.limsup (λ (a : α), g.liminf (λ (b : β), u a b)) ≤ g.liminf (λ b, f.limsup (λ a, u a b)) :=
 begin
diff --git a/src/order/filter/extr.lean b/src/order/filter/extr.lean
index 937e748bcbce8..b13ff1f893923 100644
--- a/src/order/filter/extr.lean
+++ b/src/order/filter/extr.lean
@@ -8,6 +8,9 @@ import order.filter.basic
 /-!
 # Minimum and maximum w.r.t. a filter and on a aet
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 
 This file defines six predicates of the form `is_A_B`, where `A` is `min`, `max`, or `extr`,
diff --git a/src/order/filter/filter_product.lean b/src/order/filter/filter_product.lean
index 523775e202746..1f7d0867a1d18 100644
--- a/src/order/filter/filter_product.lean
+++ b/src/order/filter/filter_product.lean
@@ -9,6 +9,9 @@ import order.filter.germ
 /-!
 # Ultraproducts
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `φ` is an ultrafilter, then the space of germs of functions `f : α → β` at `φ` is called
 the *ultraproduct*. In this file we prove properties of ultraproducts that rely on `φ` being an
 ultrafilter. Definitions and properties that work for any filter should go to `order.filter.germ`.
@@ -32,63 +35,136 @@ open ultrafilter
 
 local notation `β*` := germ (φ : filter α) β
 
-/-- If `φ` is an ultrafilter then the ultraproduct is a division ring. -/
-instance [division_ring β] : division_ring β* :=
+instance [division_semiring β] : division_semiring β* :=
 { mul_inv_cancel := λ f, induction_on f $ λ f hf, coe_eq.2 $ (φ.em (λ y, f y = 0)).elim
     (λ H, (hf $ coe_eq.2 H).elim) (λ H, H.mono $ λ x, mul_inv_cancel),
   inv_zero := coe_eq.2 $ by simp only [(∘), inv_zero],
-  .. germ.ring, .. germ.div_inv_monoid, .. germ.nontrivial }
-
-/-- If `φ` is an ultrafilter then the ultraproduct is a field. -/
-instance [field β] : field β* :=
-{ .. germ.comm_ring, .. germ.division_ring }
-
-/-- If `φ` is an ultrafilter then the ultraproduct is a linear order. -/
-noncomputable instance [linear_order β] : linear_order β* :=
-{ le_total := λ f g, induction_on₂ f g $ λ f g, eventually_or.1 $ eventually_of_forall $
-    λ x, le_total _ _,
-  decidable_le := by apply_instance,
-  .. germ.partial_order }
+  ..germ.semiring, ..germ.div_inv_monoid, ..germ.nontrivial }
 
-@[simp, norm_cast] lemma const_div [division_ring β] (x y : β) : (↑(x / y) : β*) = ↑x / ↑y := rfl
+instance [division_ring β] : division_ring β* := { ..germ.ring, ..germ.division_semiring }
+instance [semifield β] : semifield β* := { ..germ.comm_semiring, ..germ.division_semiring }
+instance [field β] : field β* := { ..germ.comm_ring, ..germ.division_ring }
 
 lemma coe_lt [preorder β] {f g : α → β} : (f : β*) < g ↔ ∀* x, f x < g x :=
 by simp only [lt_iff_le_not_le, eventually_and, coe_le, eventually_not, eventually_le]
 
-lemma coe_pos [preorder β] [has_zero β] {f : α → β} : 0 < (f : β*) ↔ ∀* x, 0 < f x :=
-coe_lt
+lemma coe_pos [preorder β] [has_zero β] {f : α → β} : 0 < (f : β*) ↔ ∀* x, 0 < f x := coe_lt
+
+lemma const_lt [preorder β] {x y : β} : x < y → (↑x : β*) < ↑y := coe_lt.mpr ∘ lift_rel_const
 
-lemma const_lt [preorder β] {x y : β} : (↑x : β*) < ↑y ↔ x < y :=
+@[simp, norm_cast]
+lemma const_lt_iff [preorder β] {x y : β} : (↑x : β*) < ↑y ↔ x < y :=
 coe_lt.trans lift_rel_const_iff
 
 lemma lt_def [preorder β] : ((<) : β* → β* → Prop) = lift_rel (<) :=
 by { ext ⟨f⟩ ⟨g⟩, exact coe_lt }
 
-/-- If `φ` is an ultrafilter then the ultraproduct is an ordered ring. -/
+instance [has_sup β] : has_sup β* := ⟨map₂ (⊔)⟩
+instance [has_inf β] : has_inf β* := ⟨map₂ (⊓)⟩
+
+@[simp, norm_cast] lemma const_sup [has_sup β] (a b : β) : ↑(a ⊔ b) = (↑a ⊔ ↑b : β*) := rfl
+@[simp, norm_cast] lemma const_inf [has_inf β] (a b : β) : ↑(a ⊓ b) = (↑a ⊓ ↑b : β*) := rfl
+
+instance [semilattice_sup β] : semilattice_sup β* :=
+{ sup := (⊔),
+  le_sup_left := λ f g, induction_on₂ f g $ λ f g,
+    eventually_of_forall $ λ x, le_sup_left,
+  le_sup_right := λ f g, induction_on₂ f g $ λ f g,
+    eventually_of_forall $ λ x, le_sup_right,
+  sup_le := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
+    h₂.mp $ h₁.mono $ λ x, sup_le,
+  .. germ.partial_order }
+
+instance [semilattice_inf β] : semilattice_inf β* :=
+{ inf := (⊓),
+  inf_le_left := λ f g, induction_on₂ f g $ λ f g,
+    eventually_of_forall $ λ x, inf_le_left,
+  inf_le_right := λ f g, induction_on₂ f g $ λ f g,
+    eventually_of_forall $ λ x, inf_le_right,
+  le_inf := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
+    h₂.mp $ h₁.mono $ λ x, le_inf,
+  .. germ.partial_order }
+
+instance [lattice β] : lattice β* :=
+{ .. germ.semilattice_sup, .. germ.semilattice_inf }
+
+instance [distrib_lattice β] : distrib_lattice β* :=
+{ le_sup_inf := λ f g h, induction_on₃ f g h $ λ f g h, eventually_of_forall $ λ _, le_sup_inf,
+  .. germ.semilattice_sup, .. germ.semilattice_inf }
+
+instance [has_le β] [is_total β (≤)] : is_total β* (≤) :=
+⟨λ f g, induction_on₂ f g $ λ f g, eventually_or.1 $ eventually_of_forall $ λ x, total_of _ _ _⟩
+
+/-- If `φ` is an ultrafilter then the ultraproduct is a linear order. -/
+noncomputable instance [linear_order β] : linear_order β* := lattice.to_linear_order _
+
+@[to_additive]
+instance [ordered_comm_monoid β] : ordered_comm_monoid β* :=
+{ mul_le_mul_left := λ f g, induction_on₂ f g $ λ f g H h, induction_on h $ λ h,
+    H.mono $ λ x H, mul_le_mul_left' H _,
+  .. germ.partial_order, .. germ.comm_monoid }
+
+@[to_additive]
+instance [ordered_cancel_comm_monoid β] : ordered_cancel_comm_monoid β* :=
+{ le_of_mul_le_mul_left := λ f g h, induction_on₃ f g h $ λ f g h H,
+    H.mono $ λ x, le_of_mul_le_mul_left',
+  .. germ.partial_order, .. germ.ordered_comm_monoid }
+
+@[to_additive]
+instance [ordered_comm_group β] : ordered_comm_group β* :=
+{ .. germ.ordered_cancel_comm_monoid, .. germ.comm_group }
+
+@[to_additive]
+noncomputable instance [linear_ordered_comm_group β] : linear_ordered_comm_group β* :=
+{ .. germ.ordered_comm_group, .. germ.linear_order }
+
+instance [ordered_semiring β] : ordered_semiring β* :=
+{ zero_le_one := const_le zero_le_one,
+  mul_le_mul_of_nonneg_left := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, hh.mp $
+    hfg.mono $ λ a, mul_le_mul_of_nonneg_left,
+  mul_le_mul_of_nonneg_right := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, hh.mp $
+    hfg.mono $ λ a, mul_le_mul_of_nonneg_right,
+  ..germ.semiring, ..germ.ordered_add_comm_monoid }
+
+instance [ordered_comm_semiring β] : ordered_comm_semiring β* :=
+{ ..germ.ordered_semiring, ..germ.comm_semiring }
+
 instance [ordered_ring β] : ordered_ring β* :=
+{ zero_le_one := const_le zero_le_one,
+  mul_nonneg := λ x y, induction_on₂ x y $ λ f g hf hg, hg.mp $ hf.mono $ λ a, mul_nonneg,
+  ..germ.ring, ..germ.ordered_add_comm_group }
+
+instance [ordered_comm_ring β] : ordered_comm_ring β* :=
+{ ..germ.ordered_ring, ..germ.ordered_comm_semiring }
+
+instance [strict_ordered_semiring β] : strict_ordered_semiring β* :=
+{ mul_lt_mul_of_pos_left := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, coe_lt.2 $
+   (coe_lt.1 hh).mp $ (coe_lt.1 hfg).mono $ λ a, mul_lt_mul_of_pos_left,
+  mul_lt_mul_of_pos_right := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, coe_lt.2 $
+   (coe_lt.1 hh).mp $ (coe_lt.1 hfg).mono $ λ a, mul_lt_mul_of_pos_right,
+  ..germ.ordered_semiring, ..germ.ordered_cancel_add_comm_monoid, ..germ.nontrivial }
+
+instance [strict_ordered_comm_semiring β] : strict_ordered_comm_semiring β* :=
+{ .. germ.strict_ordered_semiring, ..germ.ordered_comm_semiring }
+
+instance [strict_ordered_ring β] : strict_ordered_ring β* :=
 { zero_le_one := const_le zero_le_one,
   mul_pos := λ x y, induction_on₂ x y $ λ f g hf hg, coe_pos.2 $
     (coe_pos.1 hg).mp $ (coe_pos.1 hf).mono $ λ x, mul_pos,
-  .. germ.ring, .. germ.ordered_add_comm_group, .. germ.nontrivial }
+  ..germ.ring, ..germ.strict_ordered_semiring }
+
+instance [strict_ordered_comm_ring β] : strict_ordered_comm_ring β* :=
+{ .. germ.strict_ordered_ring, ..germ.ordered_comm_ring }
 
-/-- If `φ` is an ultrafilter then the ultraproduct is a linear ordered ring. -/
 noncomputable instance [linear_ordered_ring β] : linear_ordered_ring β* :=
-{ .. germ.ordered_ring, .. germ.linear_order, .. germ.nontrivial }
+{ ..germ.strict_ordered_ring, ..germ.linear_order }
 
-/-- If `φ` is an ultrafilter then the ultraproduct is a linear ordered field. -/
 noncomputable instance [linear_ordered_field β] : linear_ordered_field β* :=
 { .. germ.linear_ordered_ring, .. germ.field }
 
-/-- If `φ` is an ultrafilter then the ultraproduct is a linear ordered commutative ring. -/
-noncomputable instance [linear_ordered_comm_ring β] :
-  linear_ordered_comm_ring β* :=
+noncomputable instance [linear_ordered_comm_ring β] : linear_ordered_comm_ring β* :=
 { .. germ.linear_ordered_ring, .. germ.comm_monoid }
 
-/-- If `φ` is an ultrafilter then the ultraproduct is a decidable linear ordered commutative
-group. -/
-noncomputable instance [linear_ordered_add_comm_group β] : linear_ordered_add_comm_group β* :=
-{ .. germ.ordered_add_comm_group, .. germ.linear_order }
-
 lemma max_def [linear_order β] (x y : β*) : max x y = map₂ max x y :=
 induction_on₂ x y $ λ a b,
 begin
@@ -118,10 +194,6 @@ by rw [min_def, map₂_const]
   (↑(|x|) : β*) = |↑x| :=
 by rw [abs_def, map_const]
 
-lemma linear_order.to_lattice_eq_filter_germ_lattice [linear_order β] :
-  (@linear_order.to_lattice (filter.germ ↑φ β) filter.germ.linear_order) = filter.germ.lattice :=
-lattice.ext (λ x y, iff.rfl)
-
 end germ
 
 end filter
diff --git a/src/order/filter/germ.lean b/src/order/filter/germ.lean
index 74ca4709019a2..c6f8199fe2172 100644
--- a/src/order/filter/germ.lean
+++ b/src/order/filter/germ.lean
@@ -9,6 +9,9 @@ import algebra.module.pi
 /-!
 # Germ of a function at a filter
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The germ of a function `f : α → β` at a filter `l : filter α` is the equivalence class of `f`
 with respect to the equivalence relation `eventually_eq l`: `f ≈ g` means `∀ᶠ x in l, f x = g x`.
 
@@ -141,7 +144,7 @@ rfl
 
 @[simp, norm_cast] lemma coe_eq : (f : germ l β) = g ↔ (f =ᶠ[l] g) := quotient.eq'
 
-alias coe_eq ↔ _ filter.eventually_eq.germ_eq
+alias coe_eq ↔ _ _root_.filter.eventually_eq.germ_eq
 
 /-- Lift a function `β → γ` to a function `germ l β → germ l γ`. -/
 def map (op : β → γ) : germ l β → germ l γ :=
@@ -173,7 +176,7 @@ lift_on f (λ f, tendsto f l lb) $ λ f g H, propext (tendsto_congr' H)
   (f : germ l β).tendsto lb ↔ tendsto f l lb :=
 iff.rfl
 
-alias coe_tendsto ↔ _ filter.tendsto.germ_tendsto
+alias coe_tendsto ↔ _ _root_.filter.tendsto.germ_tendsto
 
 /-- Given two germs `f : germ l β`, and `g : germ lc α`, where `l : filter α`, if `g` tends to `l`,
 then the composition `f ∘ g` is well-defined as a germ at `lc`. -/
@@ -294,36 +297,30 @@ instance [right_cancel_semigroup M] : right_cancel_semigroup (germ l M) :=
     coe_eq.2 $ (coe_eq.1 H).mono $ λ x, mul_right_cancel,
   .. germ.semigroup }
 
-instance has_nat_pow [monoid G] : has_pow (germ l G) ℕ := ⟨λ f n, map (^ n) f⟩
-
-@[simp] lemma coe_pow [monoid G] (f : α → G) (n : ℕ) : ↑(f ^ n) = (f ^ n : germ l G) := rfl
-
-instance has_int_pow [div_inv_monoid G] : has_pow (germ l G) ℤ := ⟨λ f z, map (^ z) f⟩
+instance [has_vadd M G] : has_vadd M (germ l G) := ⟨λ n, map ((+ᵥ) n)⟩
+@[to_additive] instance [has_smul M G] : has_smul M (germ l G) := ⟨λ n, map ((•) n)⟩
+@[to_additive has_smul] instance [has_pow G M] : has_pow (germ l G) M := ⟨λ f n, map (^ n) f⟩
 
-@[simp] lemma coe_zpow [div_inv_monoid G] (f : α → G) (z : ℤ) : ↑(f ^ z) = (f ^ z : germ l G) :=
-rfl
+@[simp, norm_cast, to_additive]
+lemma coe_smul [has_smul M G] (n : M) (f : α → G) : ↑(n • f) = (n • f : germ l G) := rfl
 
-instance [has_scalar M β] : has_scalar M (germ l β) :=
-⟨λ c, map ((•) c)⟩
+@[simp, norm_cast, to_additive]
+lemma const_smul [has_smul M G] (n : M) (a : G) : (↑(n • a) : germ l G) = n • ↑a := rfl
 
-@[simp, norm_cast] lemma coe_smul [has_scalar M β] (c : M) (f : α → β) :
-  ↑(c • f) = (c • f : germ l β) :=
-rfl
+@[simp, norm_cast, to_additive coe_smul]
+lemma coe_pow [has_pow G M] (f : α → G) (n : M) : ↑(f ^ n) = (f ^ n : germ l G) := rfl
 
-instance [add_monoid M] : add_monoid (germ l M) :=
-function.surjective.add_monoid coe (surjective_quot_mk _) rfl (λ a b, coe_add a b) (λ _ _, rfl)
+@[simp, norm_cast, to_additive const_smul]
+lemma const_pow [has_pow G M] (a : G) (n : M) : (↑(a ^ n) : germ l G) = ↑a ^ n := rfl
 
 @[to_additive]
 instance [monoid M] : monoid (germ l M) :=
-function.surjective.monoid coe (surjective_quot_mk _) rfl (λ a b, coe_mul a b) coe_pow
+function.surjective.monoid coe (surjective_quot_mk _) rfl (λ _ _, rfl) (λ _ _, rfl)
 
-/-- coercion from functions to germs as a monoid homomorphism. -/
-@[to_additive]
+/-- Coercion from functions to germs as a monoid homomorphism. -/
+@[to_additive "Coercion from functions to germs as an additive monoid homomorphism."]
 def coe_mul_hom [monoid M] (l : filter α) : (α → M) →* germ l M := ⟨coe, rfl, λ f g, rfl⟩
 
-/-- coercion from functions to germs as an additive monoid homomorphism. -/
-add_decl_doc coe_add_hom
-
 @[simp, to_additive]
 lemma coe_coe_mul_hom [monoid M] : (coe_mul_hom l : (α → M) → germ l M) = coe := rfl
 
@@ -333,21 +330,29 @@ instance [comm_monoid M] : comm_monoid (germ l M) :=
   one := 1,
   .. germ.comm_semigroup, .. germ.monoid }
 
+instance [add_monoid_with_one M] : add_monoid_with_one (germ l M) :=
+{ nat_cast := λ n, ↑(n : M),
+  nat_cast_zero := congr_arg coe nat.cast_zero,
+  nat_cast_succ := λ n, congr_arg coe (nat.cast_succ _),
+  .. germ.has_one, .. germ.add_monoid }
+
 @[to_additive]
 instance [has_inv G] : has_inv (germ l G) := ⟨map has_inv.inv⟩
 
 @[simp, norm_cast, to_additive]
 lemma coe_inv [has_inv G] (f : α → G) : ↑f⁻¹ = (f⁻¹ : germ l G) := rfl
 
+@[simp, norm_cast, to_additive]
+lemma const_inv [has_inv G] (a : G) : (↑a⁻¹ : germ l G) = (↑a)⁻¹ := rfl
+
 @[to_additive]
 instance [has_div M] : has_div (germ l M) := ⟨map₂ (/)⟩
 
 @[simp, norm_cast, to_additive]
 lemma coe_div [has_div M] (f g : α → M) : ↑(f / g) = (f / g : germ l M) := rfl
 
-instance [sub_neg_monoid G] : sub_neg_monoid (germ l G) :=
-function.surjective.sub_neg_monoid coe (surjective_quot_mk _) rfl (λ _ _, rfl)
-  (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+@[simp, norm_cast, to_additive]
+lemma const_div [has_div M] (a b : M) : (↑(a / b) : germ l M) = ↑a / ↑b := rfl
 
 @[to_additive sub_neg_monoid]
 instance [div_inv_monoid G] : div_inv_monoid (germ l G) :=
@@ -390,7 +395,8 @@ instance [distrib R] : distrib (germ l R) :=
   right_distrib := λ f g h, induction_on₃ f g h $ λ f g h, by { norm_cast, rw [right_distrib] } }
 
 instance [semiring R] : semiring (germ l R) :=
-{ .. germ.add_comm_monoid, .. germ.monoid, .. germ.distrib, .. germ.mul_zero_class }
+{ .. germ.add_comm_monoid, .. germ.monoid, .. germ.distrib, .. germ.mul_zero_class,
+  .. germ.add_monoid_with_one }
 
 /-- Coercion `(α → R) → germ l R` as a `ring_hom`. -/
 def coe_ring_hom [semiring R] (l : filter α) : (α → R) →+* germ l R :=
@@ -399,7 +405,7 @@ def coe_ring_hom [semiring R] (l : filter α) : (α → R) →+* germ l R :=
 @[simp] lemma coe_coe_ring_hom [semiring R] : (coe_ring_hom l : (α → R) → germ l R) = coe := rfl
 
 instance [ring R] : ring (germ l R) :=
-{ .. germ.add_comm_group, .. germ.monoid, .. germ.distrib, .. germ.mul_zero_class }
+{ .. germ.add_comm_group, .. germ.semiring }
 
 instance [comm_semiring R] : comm_semiring (germ l R) :=
 { .. germ.semiring, .. germ.comm_monoid }
@@ -413,18 +419,20 @@ section module
 
 variables {M N R : Type*}
 
-instance has_scalar' [has_scalar M β] : has_scalar (germ l M) (germ l β) :=
-⟨map₂ (•)⟩
+@[to_additive]
+instance has_smul' [has_smul M β] : has_smul (germ l M) (germ l β) := ⟨map₂ (•)⟩
 
-@[simp, norm_cast] lemma coe_smul' [has_scalar M β] (c : α → M) (f : α → β) :
+@[simp, norm_cast, to_additive] lemma coe_smul' [has_smul M β] (c : α → M) (f : α → β) :
   ↑(c • f) = (c : germ l M) • (f : germ l β) :=
 rfl
 
-instance [monoid M] [mul_action M β]  : mul_action M (germ l β) :=
+@[to_additive]
+instance [monoid M] [mul_action M β] : mul_action M (germ l β) :=
 { one_smul := λ f, induction_on f $ λ f, by { norm_cast, simp only [one_smul] },
   mul_smul := λ c₁ c₂ f, induction_on f $ λ f, by { norm_cast, simp only [mul_smul] } }
 
-instance mul_action' [monoid M] [mul_action M β]  : mul_action (germ l M) (germ l β) :=
+@[to_additive]
+instance mul_action' [monoid M] [mul_action M β] : mul_action (germ l M) (germ l β) :=
 { one_smul := λ f, induction_on f $ λ f, by simp only [← coe_one, ← coe_smul', one_smul],
   mul_smul := λ c₁ c₂ f, induction_on₃ c₁ c₂ f $ λ c₁ c₂ f, by { norm_cast, simp only [mul_smul] } }
 
@@ -450,15 +458,16 @@ instance module' [semiring R] [add_comm_monoid M] [module R M] :
 
 end module
 
-instance [has_le β] : has_le (germ l β) :=
-⟨lift_rel (≤)⟩
-
-@[simp] lemma coe_le [has_le β] : (f : germ l β) ≤ g ↔ (f ≤ᶠ[l] g) := iff.rfl
+instance [has_le β] : has_le (germ l β) := ⟨lift_rel (≤)⟩
 
 lemma le_def [has_le β] : ((≤) : germ l β → germ l β → Prop) = lift_rel (≤) := rfl
 
-lemma const_le [has_le β] {x y : β} (h : x ≤ y) : (↑x : germ l β) ≤ ↑y :=
-lift_rel_const h
+@[simp] lemma coe_le [has_le β] : (f : germ l β) ≤ g ↔ f ≤ᶠ[l] g := iff.rfl
+
+lemma coe_nonneg [has_le β] [has_zero β] {f : α → β} : 0 ≤ (f : germ l β) ↔ ∀ᶠ x in l, 0 ≤ f x :=
+iff.rfl
+
+lemma const_le [has_le β] {x y : β} : x ≤ y → (↑x : germ l β) ≤ ↑y := lift_rel_const
 
 @[simp, norm_cast]
 lemma const_le_iff [has_le β] [ne_bot l] {x y : β} : (↑x : germ l β) ≤ ↑y ↔ x ≤ y :=
@@ -474,69 +483,22 @@ instance [partial_order β] : partial_order (germ l β) :=
   le_antisymm := λ f g, induction_on₂ f g $ λ f g h₁ h₂, (eventually_le.antisymm h₁ h₂).germ_eq,
   .. germ.preorder }
 
-instance [has_bot β] : has_bot (germ l β) := ⟨↑(⊥:β)⟩
+instance [has_bot β] : has_bot (germ l β) := ⟨↑(⊥ : β)⟩
+instance [has_top β] : has_top (germ l β) := ⟨↑(⊤ : β)⟩
 
-@[simp, norm_cast] lemma const_bot [has_bot β] : (↑(⊥:β) : germ l β) = ⊥ := rfl
+@[simp, norm_cast] lemma const_bot [has_bot β] : (↑(⊥ : β) : germ l β) = ⊥ := rfl
+@[simp, norm_cast] lemma const_top [has_top β] : (↑(⊤ : β) : germ l β) = ⊤ := rfl
 
 instance [has_le β] [order_bot β] : order_bot (germ l β) :=
 { bot := ⊥,
   bot_le := λ f, induction_on f $ λ f, eventually_of_forall $ λ x, bot_le }
 
-instance [has_top β] : has_top (germ l β) := ⟨↑(⊤:β)⟩
-
-@[simp, norm_cast] lemma const_top [has_top β] : (↑(⊤:β) : germ l β) = ⊤ := rfl
-
 instance [has_le β] [order_top β] : order_top (germ l β) :=
 { top := ⊤,
   le_top := λ f, induction_on f $ λ f, eventually_of_forall $ λ x, le_top }
 
-instance [has_sup β] : has_sup (germ l β) := ⟨map₂ (⊔)⟩
-
-@[simp, norm_cast] lemma const_sup [has_sup β] (a b : β) : ↑(a ⊔ b) = (↑a ⊔ ↑b : germ l β) := rfl
-
-instance [has_inf β] : has_inf (germ l β) := ⟨map₂ (⊓)⟩
-
-@[simp, norm_cast] lemma const_inf [has_inf β] (a b : β) : ↑(a ⊓ b) = (↑a ⊓ ↑b : germ l β) := rfl
-
-instance [semilattice_sup β] : semilattice_sup (germ l β) :=
-{ sup := (⊔),
-  le_sup_left := λ f g, induction_on₂ f g $ λ f g,
-    eventually_of_forall $ λ x, le_sup_left,
-  le_sup_right := λ f g, induction_on₂ f g $ λ f g,
-    eventually_of_forall $ λ x, le_sup_right,
-  sup_le := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
-    h₂.mp $ h₁.mono $ λ x, sup_le,
-  .. germ.partial_order }
-
-instance [semilattice_inf β] : semilattice_inf (germ l β) :=
-{ inf := (⊓),
-  inf_le_left := λ f g, induction_on₂ f g $ λ f g,
-    eventually_of_forall $ λ x, inf_le_left,
-  inf_le_right := λ f g, induction_on₂ f g $ λ f g,
-    eventually_of_forall $ λ x, inf_le_right,
-  le_inf := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
-    h₂.mp $ h₁.mono $ λ x, le_inf,
-  .. germ.partial_order }
-
-instance [lattice β] : lattice (germ l β) :=
-{ .. germ.semilattice_sup, .. germ.semilattice_inf }
-
 instance [has_le β] [bounded_order β] : bounded_order (germ l β) :=
-{ .. germ.order_bot, .. germ.order_top }
-
-@[to_additive]
-instance [ordered_cancel_comm_monoid β] : ordered_cancel_comm_monoid (germ l β) :=
-{ mul_le_mul_left := λ f g, induction_on₂ f g $ λ f g H h, induction_on h $ λ h,
-    H.mono $ λ x H, mul_le_mul_left' H _,
-  le_of_mul_le_mul_left := λ f g h, induction_on₃ f g h $ λ f g h H,
-    H.mono $ λ x, le_of_mul_le_mul_left',
-  .. germ.partial_order, .. germ.comm_monoid, .. germ.left_cancel_semigroup }
-
-@[to_additive]
-instance ordered_comm_group [ordered_comm_group β] : ordered_comm_group (germ l β) :=
-{ mul_le_mul_left := λ f g, induction_on₂ f g $ λ f g H h, induction_on h $ λ h,
-    H.mono $ λ x H, mul_le_mul_left' H _,
-  .. germ.partial_order, .. germ.comm_group }
+{ ..germ.order_bot, ..germ.order_top }
 
 end germ
 
diff --git a/src/order/filter/indicator_function.lean b/src/order/filter/indicator_function.lean
index 62c22c87cbeca..31787168fdfd0 100644
--- a/src/order/filter/indicator_function.lean
+++ b/src/order/filter/indicator_function.lean
@@ -9,6 +9,9 @@ import order.filter.at_top_bot
 /-!
 # Indicator function and filters
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Properties of indicator functions involving `=ᶠ` and `≤ᶠ`.
 
 ## Tags
diff --git a/src/order/filter/interval.lean b/src/order/filter/interval.lean
index 605bfcd00266e..680da810a9f77 100644
--- a/src/order/filter/interval.lean
+++ b/src/order/filter/interval.lean
@@ -10,6 +10,9 @@ import order.filter.at_top_bot
 /-!
 # Convergence of intervals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If both `a` and `b` tend to some filter `l₁`, sometimes this implies that `Ixx a b` tends to
 `l₂.small_sets`, i.e., for any `s ∈ l₂` eventually `Ixx a b` becomes a subset of `s`.  Here and
 below `Ixx` is one of `Icc`, `Ico`, `Ioc`, and `Ioo`. We define `filter.tendsto_Ixx_class Ixx l₁ l₂`
@@ -198,25 +201,25 @@ section linear_order
 
 variables [linear_order α]
 
-instance tendsto_Icc_interval_interval {a b : α} : tendsto_Ixx_class Icc (𝓟 [a, b]) (𝓟 [a, b]) :=
+instance tendsto_Icc_uIcc_uIcc {a b : α} : tendsto_Ixx_class Icc (𝓟 [a, b]) (𝓟 [a, b]) :=
 filter.tendsto_Icc_Icc_Icc
 
-instance tendsto_Ioc_interval_interval {a b : α} : tendsto_Ixx_class Ioc (𝓟 [a, b]) (𝓟 [a, b]) :=
+instance tendsto_Ioc_uIcc_uIcc {a b : α} : tendsto_Ixx_class Ioc (𝓟 [a, b]) (𝓟 [a, b]) :=
 filter.tendsto_Ioc_Icc_Icc
 
-instance tendsto_interval_of_Icc {l : filter α} [tendsto_Ixx_class Icc l l] :
-  tendsto_Ixx_class interval l l :=
+instance tendsto_uIcc_of_Icc {l : filter α} [tendsto_Ixx_class Icc l l] :
+  tendsto_Ixx_class uIcc l l :=
 begin
   refine ⟨λ s hs, mem_map.2 $ mem_prod_self_iff.2 _⟩,
   obtain ⟨t, htl, hts⟩ : ∃ t ∈ l, ∀ p ∈ (t : set α) ×ˢ t, Icc (p : α × α).1 p.2 ∈ s,
     from mem_prod_self_iff.1 (mem_map.1 (tendsto_fst.Icc tendsto_snd hs)),
   refine ⟨t, htl, λ p hp, _⟩,
   cases le_total p.1 p.2,
-  { rw [mem_preimage, interval_of_le h], exact hts p hp },
-  { rw [mem_preimage, interval_of_ge h], exact hts ⟨p.2, p.1⟩ ⟨hp.2, hp.1⟩ }
+  { rw [mem_preimage, uIcc_of_le h], exact hts p hp },
+  { rw [mem_preimage, uIcc_of_ge h], exact hts ⟨p.2, p.1⟩ ⟨hp.2, hp.1⟩ }
 end
 
-lemma tendsto.interval {l : filter α} [tendsto_Ixx_class Icc l l] {f g : β → α} {lb : filter β}
+lemma tendsto.uIcc {l : filter α} [tendsto_Ixx_class Icc l l] {f g : β → α} {lb : filter β}
   (hf : tendsto f lb l) (hg : tendsto g lb l) :
   tendsto (λ x, [f x, g x]) lb l.small_sets :=
 tendsto_Ixx_class.tendsto_Ixx.comp $ hf.prod_mk hg
diff --git a/src/order/filter/lift.lean b/src/order/filter/lift.lean
index 81c48e3e98b27..c8d7f8a1e8605 100644
--- a/src/order/filter/lift.lean
+++ b/src/order/filter/lift.lean
@@ -7,6 +7,9 @@ import order.filter.bases
 
 /-!
 # Lift filters along filter and set functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 open set
@@ -72,6 +75,11 @@ lemma mem_lift_sets (hg : monotone g) {s : set β} :
 (f.basis_sets.mem_lift_iff (λ s, (g s).basis_sets) hg).trans $
   by simp only [id, exists_mem_subset_iff]
 
+lemma sInter_lift_sets (hg : monotone g) :
+  ⋂₀ {s | s ∈ f.lift g} = ⋂ s ∈ f, ⋂₀ {t | t ∈ g s} :=
+by simp only [sInter_eq_bInter, mem_set_of_eq, filter.mem_sets, mem_lift_sets hg,
+  Inter_exists, @Inter_comm _ (set β)]
+
 lemma mem_lift {s : set β} {t : set α} (ht : t ∈ f) (hs : s ∈ g t) :
   s ∈ f.lift g :=
 le_principal_iff.mp $ show f.lift g ≤ 𝓟 s,
@@ -81,9 +89,9 @@ lemma lift_le {f : filter α} {g : set α → filter β} {h : filter β} {s : se
   (hs : s ∈ f) (hg : g s ≤ h) : f.lift g ≤ h :=
 infi₂_le_of_le s hs hg
 
-lemma le_lift {f : filter α} {g : set α → filter β} {h : filter β}
-  (hh : ∀s∈f, h ≤ g s) : h ≤ f.lift g :=
-le_infi₂ hh
+lemma le_lift {f : filter α} {g : set α → filter β} {h : filter β} :
+  h ≤ f.lift g ↔ ∀ s ∈ f, h ≤ g s :=
+le_infi₂_iff
 
 lemma lift_mono (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) : f₁.lift g₁ ≤ f₂.lift g₂ :=
 infi_mono $ λ s, infi_mono' $ λ hs, ⟨hf hs, hg s⟩
@@ -100,35 +108,22 @@ have monotone (map m ∘ g),
 filter.ext $ λ s,
   by simp only [mem_lift_sets hg, mem_lift_sets this, exists_prop, mem_map, function.comp_app]
 
-lemma comap_lift_eq {m : γ → β} (hg : monotone g) : comap m (f.lift g) = f.lift (comap m ∘ g) :=
-have monotone (comap m ∘ g),
-  from comap_mono.comp hg,
-begin
-  ext,
-  simp only [mem_lift_sets hg, mem_lift_sets this, mem_comap, exists_prop, mem_lift_sets],
-  exact ⟨λ ⟨b, ⟨a, ha, hb⟩, hs⟩, ⟨a, ha, b, hb, hs⟩, λ ⟨a, ha, b, hb, hs⟩, ⟨b, ⟨a, ha, hb⟩, hs⟩⟩
-end
+lemma comap_lift_eq {m : γ → β} : comap m (f.lift g) = f.lift (comap m ∘ g) :=
+by simp only [filter.lift, comap_infi]
 
 theorem comap_lift_eq2 {m : β → α} {g : set β → filter γ} (hg : monotone g) :
   (comap m f).lift g = f.lift (g ∘ preimage m) :=
 le_antisymm
-  (le_infi $ assume s, le_infi $ assume hs,
-    infi_le_of_le (preimage m s) $ infi_le _ ⟨s, hs, subset.refl _⟩)
-  (le_infi $ assume s, le_infi $ assume ⟨s', hs', (h_sub : preimage m s' ⊆ s)⟩,
-    infi_le_of_le s' $ infi_le_of_le hs' $ hg h_sub)
+  (le_infi₂ $ λ s hs, infi₂_le (m ⁻¹' s) ⟨s, hs, subset.rfl⟩)
+  (le_infi₂ $ λ s ⟨s', hs', (h_sub : m ⁻¹' s' ⊆ s)⟩, infi₂_le_of_le s' hs' $ hg h_sub)
+
+lemma lift_map_le {g : set β → filter γ} {m : α → β} :
+  (map m f).lift g ≤ f.lift (g ∘ image m) :=
+le_lift.2 $ λ s hs, lift_le (image_mem_map hs) le_rfl
 
 lemma map_lift_eq2 {g : set β → filter γ} {m : α → β} (hg : monotone g) :
   (map m f).lift g = f.lift (g ∘ image m) :=
-le_antisymm
-  (infi_mono' $ assume s, ⟨image m s,
-    infi_mono' $ assume hs, ⟨
-      f.sets_of_superset hs $ assume a h, mem_image_of_mem _ h,
-      le_rfl⟩⟩)
-  (infi_mono' $ assume t, ⟨preimage m t,
-    infi_mono' $ assume ht, ⟨ht,
-      hg $ assume x, assume h : x ∈ m '' preimage m t,
-        let ⟨y, hy, h_eq⟩ := h in
-        show x ∈ t, from h_eq ▸ hy⟩⟩)
+lift_map_le.antisymm $ le_lift.2 $ λ s hs, lift_le hs $ hg $ image_preimage_subset _ _
 
 lemma lift_comm {g : filter β} {h : set α → set β → filter γ} :
   f.lift (λs, g.lift (h s)) = g.lift (λt, f.lift (λs, h s t)) :=
@@ -149,65 +144,74 @@ le_antisymm
 
 lemma lift_lift_same_le_lift {g : set α → set α → filter β} :
   f.lift (λs, f.lift (g s)) ≤ f.lift (λs, g s s) :=
-le_infi $ assume s, le_infi $ assume hs, infi_le_of_le s $ infi_le_of_le hs $ infi_le_of_le s $
-  infi_le _ hs
+le_lift.2 $ λ s hs, lift_le hs $ lift_le hs le_rfl
 
 lemma lift_lift_same_eq_lift {g : set α → set α → filter β}
   (hg₁ : ∀s, monotone (λt, g s t)) (hg₂ : ∀t, monotone (λs, g s t)) :
   f.lift (λs, f.lift (g s)) = f.lift (λs, g s s) :=
-le_antisymm
-  lift_lift_same_le_lift
-  (le_infi $ assume s, le_infi $ assume hs, le_infi $ assume t, le_infi $ assume ht,
-    infi_le_of_le (s ∩ t) $
-    infi_le_of_le (inter_mem hs ht) $
+lift_lift_same_le_lift.antisymm $
+  le_lift.2 $ λ s hs, le_lift.2 $ λ t ht, lift_le (inter_mem hs ht) $
     calc g (s ∩ t) (s ∩ t) ≤ g s (s ∩ t) : hg₂ (s ∩ t) (inter_subset_left _ _)
-      ... ≤ g s t                        : hg₁ s (inter_subset_right _ _))
+                       ... ≤ g s t       : hg₁ s (inter_subset_right _ _)
 
 lemma lift_principal {s : set α} (hg : monotone g) :
   (𝓟 s).lift g = g s :=
-le_antisymm
-  (infi_le_of_le s $ infi_le _ $ subset.refl _)
-  (le_infi $ assume t, le_infi $ assume hi, hg hi)
+(lift_le (mem_principal_self _) le_rfl).antisymm (le_lift.2 $ λ t ht, hg ht)
 
 theorem monotone_lift [preorder γ] {f : γ → filter α} {g : γ → set α → filter β}
   (hf : monotone f) (hg : monotone g) : monotone (λc, (f c).lift (g c)) :=
 assume a b h, lift_mono (hf h) (hg h)
 
 lemma lift_ne_bot_iff (hm : monotone g) : (ne_bot $ f.lift g) ↔ (∀s∈f, ne_bot (g s)) :=
-begin
-  rw [filter.lift, infi_subtype', infi_ne_bot_iff_of_directed', subtype.forall'],
-  { rintros ⟨s, hs⟩ ⟨t, ht⟩,
-    exact ⟨⟨s ∩ t, inter_mem hs ht⟩, hm (inter_subset_left s t), hm (inter_subset_right s t)⟩ }
-end
+by simp only [ne_bot_iff, ne.def, ← empty_mem_iff_bot, mem_lift_sets hm, not_exists]
 
 @[simp] lemma lift_const {f : filter α} {g : filter β} : f.lift (λx, g) = g :=
-le_antisymm (lift_le univ_mem $ le_refl g) (le_lift $ assume s hs, le_refl g)
+infi_subtype'.trans infi_const
 
 @[simp] lemma lift_inf {f : filter α} {g h : set α → filter β} :
   f.lift (λx, g x ⊓ h x) = f.lift g ⊓ f.lift h :=
-by simp only [filter.lift, infi_inf_eq, eq_self_iff_true]
+by simp only [filter.lift, infi_inf_eq]
 
 @[simp] lemma lift_principal2 {f : filter α} : f.lift 𝓟 = f :=
 le_antisymm
   (assume s hs, mem_lift hs (mem_principal_self s))
   (le_infi $ assume s, le_infi $ assume hs, by simp only [hs, le_principal_iff])
 
-lemma lift_infi {f : ι → filter α} {g : set α → filter β}
-  [hι : nonempty ι] (hg : ∀{s t}, g s ⊓ g t = g (s ∩ t)) : (infi f).lift g = (⨅i, (f i).lift g) :=
-le_antisymm
-  (le_infi $ assume i, lift_mono (infi_le _ _) le_rfl)
-  (assume s,
-    have g_mono : monotone g,
-      from assume s t h, le_of_inf_eq $ eq.trans hg $ congr_arg g $ inter_eq_self_of_subset_left h,
-    have ∀t∈(infi f), (⨅ (i : ι), filter.lift (f i) g) ≤ g t,
-      from assume t ht, infi_sets_induct ht
-        (let ⟨i⟩ := hι in infi_le_of_le i $ infi_le_of_le univ $ infi_le _ univ_mem)
-        (assume i s₁ s₂ hs₁ hs₂,
-          @hg s₁ s₂ ▸ le_inf (infi_le_of_le i $ infi_le_of_le s₁ $ infi_le _ hs₁) hs₂),
-    begin
-      simp only [mem_lift_sets g_mono,  exists_imp_distrib],
-      exact assume t ht hs, this t ht hs
-    end)
+lemma lift_infi_le {f : ι → filter α} {g : set α → filter β} :
+  (infi f).lift g ≤ ⨅ i, (f i).lift g :=
+le_infi $ λ i, lift_mono (infi_le _ _) le_rfl
+
+lemma lift_infi [nonempty ι] {f : ι → filter α} {g : set α → filter β}
+  (hg : ∀ s t, g (s ∩ t) = g s ⊓ g t) : (infi f).lift g = (⨅i, (f i).lift g) :=
+begin
+  refine lift_infi_le.antisymm (λ s, _),
+  have H : ∀ t ∈ infi f, (⨅ i, (f i).lift g) ≤ g t,
+  { intros t ht,
+    refine infi_sets_induct ht _ (λ i s t hs ht, _),
+    { inhabit ι,
+      exact infi₂_le_of_le default univ (infi_le _ univ_mem) },
+    { rw hg,
+      exact le_inf (infi₂_le_of_le i s $ infi_le _ hs) ht } },
+  simp only [mem_lift_sets (monotone.of_map_inf hg), exists_imp_distrib],
+  exact λ t ht hs, H t ht hs
+end
+
+lemma lift_infi_of_directed [nonempty ι] {f : ι → filter α} {g : set α → filter β}
+  (hf : directed (≥) f) (hg : monotone g) : (infi f).lift g = (⨅i, (f i).lift g) :=
+lift_infi_le.antisymm $ λ s,
+  begin
+    simp only [mem_lift_sets hg, exists_imp_distrib, mem_infi_of_directed hf],
+    exact assume t i ht hs, mem_infi_of_mem i $ mem_lift ht hs
+  end
+
+lemma lift_infi_of_map_univ {f : ι → filter α} {g : set α → filter β}
+  (hg : ∀ s t, g (s ∩ t) = g s ⊓ g t) (hg' : g univ = ⊤) :
+  (infi f).lift g = (⨅i, (f i).lift g) :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { simp [infi_of_empty, hg'] },
+  { exact lift_infi hg }
+end
 
 end lift
 
@@ -239,13 +243,17 @@ begin
   simp only [exists_const]
 end
 
-lemma mem_lift'_sets (hh : monotone h) {s : set β} : s ∈ (f.lift' h) ↔ (∃t∈f, h t ⊆ s) :=
+lemma mem_lift'_sets (hh : monotone h) {s : set β} : s ∈ f.lift' h ↔ ∃ t ∈ f, h t ⊆ s :=
 mem_lift_sets $ monotone_principal.comp hh
 
 lemma eventually_lift'_iff (hh : monotone h) {p : β → Prop} :
   (∀ᶠ y in f.lift' h, p y) ↔ (∃ t ∈ f, ∀ y ∈ h t, p y) :=
 mem_lift'_sets hh
 
+lemma sInter_lift'_sets (hh : monotone h) :
+  ⋂₀ {s | s ∈ f.lift' h} = ⋂ s ∈ f, h s :=
+(sInter_lift_sets (monotone_principal.comp hh)).trans $ Inter₂_congr $ λ s hs, cInf_Ici
+
 lemma lift'_le {f : filter α} {g : set α → set β} {h : filter β} {s : set α}
   (hs : s ∈ f) (hg : 𝓟 (g s) ≤ h) : f.lift' g ≤ h :=
 lift_le hs hg
@@ -265,16 +273,15 @@ calc map m (f.lift' h) = f.lift (map m ∘ 𝓟 ∘ h) :
     map_lift_eq $ monotone_principal.comp hh
   ... = f.lift' (image m ∘ h) : by simp only [(∘), filter.lift', map_principal, eq_self_iff_true]
 
+lemma lift'_map_le {g : set β → set γ} {m : α → β} : (map m f).lift' g ≤ f.lift' (g ∘ image m) :=
+lift_map_le
+
 lemma map_lift'_eq2 {g : set β → set γ} {m : α → β} (hg : monotone g) :
   (map m f).lift' g = f.lift' (g ∘ image m) :=
 map_lift_eq2 $ monotone_principal.comp hg
 
-theorem comap_lift'_eq {m : γ → β} (hh : monotone h) :
-  comap m (f.lift' h) = f.lift' (preimage m ∘ h) :=
-calc comap m (f.lift' h) = f.lift (comap m ∘ 𝓟 ∘ h) :
-    comap_lift_eq $ monotone_principal.comp hh
-  ... = f.lift' (preimage m ∘ h) :
-    by simp only [(∘), filter.lift', comap_principal, eq_self_iff_true]
+theorem comap_lift'_eq {m : γ → β} : comap m (f.lift' h) = f.lift' (preimage m ∘ h) :=
+by simp only [filter.lift', comap_lift_eq, (∘), comap_principal]
 
 theorem comap_lift'_eq2 {m : β → α} {g : set β → set γ} (hg : monotone g) :
   (comap m f).lift' g = f.lift' (g ∘ preimage m) :=
@@ -291,9 +298,11 @@ by rw [← principal_singleton, lift'_principal hh]
 lemma lift'_bot (hh : monotone h) : (⊥ : filter α).lift' h = 𝓟 (h ∅) :=
 by rw [← principal_empty, lift'_principal hh]
 
-lemma principal_le_lift' {t : set β} (hh : ∀s∈f, t ⊆ h s) :
-  𝓟 t ≤ f.lift' h :=
-le_infi $ assume s, le_infi $ assume hs, principal_mono.mpr (hh s hs)
+lemma le_lift' {f : filter α} {h : set α → set β} {g : filter β} :
+  g ≤ f.lift' h ↔ ∀ s ∈ f, h s ∈ g :=
+le_lift.trans $ forall₂_congr $ λ s hs, le_principal_iff
+
+lemma principal_le_lift' {t : set β} : 𝓟 t ≤ f.lift' h ↔ ∀ s ∈ f, t ⊆ h s := le_lift'
 
 theorem monotone_lift' [preorder γ] {f : γ → filter α} {g : γ → set α → set β}
   (hf : monotone f) (hg : monotone g) : monotone (λc, (f c).lift' (g c)) :=
@@ -338,32 +347,26 @@ calc (ne_bot (f.lift' h)) ↔ (∀s∈f, ne_bot (𝓟 (h s))) :
 @[simp] lemma lift'_id {f : filter α} : f.lift' id = f :=
 lift_principal2
 
-lemma le_lift' {f : filter α} {h : set α → set β} {g : filter β}
-  (h_le : ∀s∈f, h s ∈ g) : g ≤ f.lift' h :=
-le_infi $ assume s, le_infi $ assume hs,
-  by simpa only [h_le, le_principal_iff, function.comp_app] using h_le s hs
+lemma lift'_infi [nonempty ι] {f : ι → filter α} {g : set α → set β}
+  (hg : ∀ s t, g (s ∩ t) = g s ∩ g t) : (infi f).lift' g = (⨅ i, (f i).lift' g) :=
+lift_infi $ λ s t, by rw [inf_principal, (∘), ← hg]
 
-lemma lift_infi' {f : ι → filter α} {g : set α → filter β}
-  [nonempty ι] (hf : directed (≥) f) (hg : monotone g) : (infi f).lift g = (⨅i, (f i).lift g) :=
-le_antisymm
-  (le_infi $ assume i, lift_mono (infi_le _ _) le_rfl)
-  (assume s,
-  begin
-    rw mem_lift_sets hg,
-    simp only [exists_imp_distrib, mem_infi_of_directed hf],
-    exact assume t i ht hs, mem_infi_of_mem i $ mem_lift ht hs
-  end)
-
-lemma lift'_infi {f : ι → filter α} {g : set α → set β}
-  [nonempty ι] (hg : ∀{s t}, g s ∩ g t = g (s ∩ t)) : (infi f).lift' g = (⨅i, (f i).lift' g) :=
-lift_infi $ λ s t, by simp only [principal_eq_iff_eq, inf_principal, (∘), hg]
+lemma lift'_infi_of_map_univ {f : ι → filter α} {g : set α → set β}
+  (hg : ∀{s t}, g (s ∩ t) = g s ∩ g t) (hg' : g univ = univ) :
+  (infi f).lift' g = (⨅ i, (f i).lift' g) :=
+lift_infi_of_map_univ (λ s t, by rw [inf_principal, (∘), ← hg])
+  (by rw [function.comp_app, hg', principal_univ])
 
-lemma lift'_inf (f g : filter α) {s : set α → set β} (hs : ∀ {t₁ t₂}, s t₁ ∩ s t₂ = s (t₁ ∩ t₂)) :
+lemma lift'_inf (f g : filter α) {s : set α → set β} (hs : ∀ t₁ t₂, s (t₁ ∩ t₂) = s t₁ ∩ s t₂) :
   (f ⊓ g).lift' s = f.lift' s ⊓ g.lift' s :=
 have (⨅ b : bool, cond b f g).lift' s = ⨅ b : bool, (cond b f g).lift' s :=
   lift'_infi @hs,
 by simpa only [infi_bool_eq]
 
+lemma lift'_inf_le (f g : filter α) (s : set α → set β) :
+  (f ⊓ g).lift' s ≤ f.lift' s ⊓ g.lift' s :=
+le_inf (lift'_mono inf_le_left le_rfl) (lift'_mono inf_le_right le_rfl)
+
 theorem comap_eq_lift' {f : filter β} {m : α → β} :
   comap m f = f.lift' (preimage m) :=
 filter.ext $ λ s, (mem_lift'_sets monotone_preimage).symm
@@ -379,19 +382,18 @@ have ∀(s:set α) (t : set β),
   by simp only [principal_eq_iff_eq, comap_principal, inf_principal]; intros; refl,
 begin
   simp only [filter.lift', function.comp, this, lift_inf, lift_const, lift_inf],
-  rw [← comap_lift_eq monotone_principal, ← comap_lift_eq monotone_principal],
-  simp only [filter.prod, lift_principal2, eq_self_iff_true]
+  rw [← comap_lift_eq, ← comap_lift_eq],
+  simp only [filter.prod, lift_principal2]
 end
 
 lemma prod_same_eq : f ×ᶠ f = f.lift' (λ t : set α, t ×ˢ t) :=
-by rw [prod_def];
-from lift_lift'_same_eq_lift'
-  (assume s, set.monotone_prod monotone_const monotone_id)
-  (assume t, set.monotone_prod monotone_id monotone_const)
+prod_def.trans $ lift_lift'_same_eq_lift'
+  (λ s, monotone_const.set_prod monotone_id)
+  (λ t, monotone_id.set_prod monotone_const)
 
 lemma mem_prod_same_iff {s : set (α×α)} :
   s ∈ f ×ᶠ f ↔ (∃t∈f, t ×ˢ t ⊆ s) :=
-by rw [prod_same_eq, mem_lift'_sets]; exact set.monotone_prod monotone_id monotone_id
+by { rw [prod_same_eq, mem_lift'_sets], exact monotone_id.set_prod monotone_id }
 
 lemma tendsto_prod_self_iff {f : α × α → β} {x : filter α} {y : filter β} :
   filter.tendsto f (x ×ᶠ x) y ↔
@@ -405,30 +407,21 @@ lemma prod_lift_lift
   (hg₁ : monotone g₁) (hg₂ : monotone g₂) :
   (f₁.lift g₁) ×ᶠ (f₂.lift g₂) = f₁.lift (λs, f₂.lift (λt, g₁ s ×ᶠ g₂ t)) :=
 begin
-  simp only [prod_def],
-  rw [lift_assoc],
+  simp only [prod_def, lift_assoc hg₁],
   apply congr_arg, funext x,
   rw [lift_comm],
   apply congr_arg, funext y,
-  rw [lift'_lift_assoc],
-  exact hg₂,
-  exact hg₁
+  apply lift'_lift_assoc hg₂
 end
 
 lemma prod_lift'_lift'
   {f₁ : filter α₁} {f₂ : filter α₂} {g₁ : set α₁ → set β₁} {g₂ : set α₂ → set β₂}
   (hg₁ : monotone g₁) (hg₂ : monotone g₂) :
-  f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift (λs, f₂.lift' (λt, g₁ s ×ˢ g₂ t)) :=
-begin
-  rw [prod_def, lift_lift'_assoc],
-  apply congr_arg, funext x,
-  rw [lift'_lift'_assoc],
-  exact hg₂,
-  exact set.monotone_prod monotone_const monotone_id,
-  exact hg₁,
-  exact (monotone_lift' monotone_const $ monotone_lam $
-    assume x, set.monotone_prod monotone_id monotone_const)
-end
+  f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift (λ s, f₂.lift' (λ t, g₁ s ×ˢ g₂ t)) :=
+calc f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift (λ s, f₂.lift (λ t, 𝓟 (g₁ s) ×ᶠ 𝓟 (g₂ t))) :
+  prod_lift_lift (monotone_principal.comp hg₁) (monotone_principal.comp hg₂)
+... = f₁.lift (λ s, f₂.lift (λ t, 𝓟 (g₁ s ×ˢ g₂ t))) :
+  by simp only [prod_principal_principal]
 
 end prod
 
diff --git a/src/order/filter/modeq.lean b/src/order/filter/modeq.lean
index 94fee945148c6..015caefbdf3fe 100644
--- a/src/order/filter/modeq.lean
+++ b/src/order/filter/modeq.lean
@@ -9,6 +9,9 @@ import order.filter.at_top_bot
 /-!
 # Numbers are frequently modeq to fixed numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that `m ≡ d [MOD n]` frequently as `m → ∞`.
 -/
 
diff --git a/src/order/filter/n_ary.lean b/src/order/filter/n_ary.lean
index 153dcbd3b092d..b4bca5c1a51e0 100644
--- a/src/order/filter/n_ary.lean
+++ b/src/order/filter/n_ary.lean
@@ -3,11 +3,14 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import order.filter.basic
+import order.filter.prod
 
 /-!
 # N-ary maps of filter
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the binary and ternary maps of filters. This is mostly useful to define pointwise
 operations on filters.
 
@@ -18,8 +21,8 @@ operations on filters.
 
 ## Notes
 
-This file is very similar to the n-ary section of `data.set.basic` and to `data.finset.n_ary`.
-Please keep them in sync.
+This file is very similar to `data.set.n_ary`, `data.finset.n_ary` and `data.option.n_ary`. Please
+keep them in sync.
 -/
 
 open function set
@@ -55,26 +58,15 @@ lemma map_prod_eq_map₂ (m : α → β → γ) (f : filter α) (g : filter β)
   filter.map (λ p : α × β, m p.1 p.2) (f ×ᶠ g) = map₂ m f g :=
 begin
   ext s,
-  split,
-  { intro hmem,
-    rw filter.mem_map_iff_exists_image at hmem,
-    obtain ⟨s', hs', hsub⟩ := hmem,
-    rw filter.mem_prod_iff at hs',
-    obtain ⟨t, ht, t', ht', hsub'⟩ := hs',
-    refine ⟨t, t', ht, ht', _⟩,
-    rw ← set.image_prod,
-    exact subset_trans (set.image_subset (λ (p : α × β), m p.fst p.snd) hsub') hsub },
-  { intro hmem,
-    rw mem_map₂_iff at hmem,
-    obtain ⟨t, t', ht, ht', hsub⟩ := hmem,
-    rw ← set.image_prod at hsub,
-    rw filter.mem_map_iff_exists_image,
-    exact ⟨t ×ˢ t', filter.prod_mem_prod ht ht', hsub⟩ },
+  simp [mem_prod_iff, prod_subset_iff]
 end
 
 lemma map_prod_eq_map₂' (m : α × β → γ) (f : filter α) (g : filter β) :
   filter.map m (f ×ᶠ g) = map₂ (λ a b, m (a, b)) f g :=
-by { refine eq.trans _ (map_prod_eq_map₂ (curry m) f g), ext, simp }
+(congr_arg2 _ (uncurry_curry m).symm rfl).trans (map_prod_eq_map₂ _ _ _)
+
+@[simp] lemma map₂_mk_eq_prod (f : filter α) (g : filter β) : map₂ prod.mk f g = f ×ᶠ g :=
+by simp only [← map_prod_eq_map₂, prod.mk.eta, map_id']
 
 -- lemma image2_mem_map₂_iff (hm : injective2 m) : image2 m s t ∈ map₂ m f g ↔ s ∈ f ∧ t ∈ g :=
 -- ⟨by { rintro ⟨u, v, hu, hv, h⟩, rw image2_subset_image2_iff hm at h,
@@ -224,25 +216,27 @@ begin
 end
 
 lemma map_map₂ (m : α → β → γ) (n : γ → δ) : (map₂ m f g).map n = map₂ (λ a b, n (m a b)) f g :=
-filter.ext $ λ u, exists₂_congr $ λ s t, by rw [←image_subset_iff, image_image2]
+by rw [← map_prod_eq_map₂, ← map_prod_eq_map₂, map_map]
 
 lemma map₂_map_left (m : γ → β → δ) (n : α → γ) :
   map₂ m (f.map n) g = map₂ (λ a b, m (n a) b) f g :=
 begin
-  ext u,
-  split,
-  { rintro ⟨s, t, hs, ht, hu⟩,
-    refine ⟨_, t, hs, ht, _⟩,
-    rw ←image2_image_left,
-    exact (image2_subset_right $ image_preimage_subset _ _).trans hu },
-  { rintro ⟨s, t, hs, ht, hu⟩,
-    exact ⟨_, t, image_mem_map hs, ht, by rwa image2_image_left⟩ }
+  rw [← map_prod_eq_map₂, ← map_prod_eq_map₂, ← @map_id _ g, prod_map_map_eq, map_map, map_id],
+  refl
 end
 
 lemma map₂_map_right (m : α → γ → δ) (n : β → γ) :
   map₂ m f (g.map n) = map₂ (λ a b, m a (n b)) f g :=
 by rw [map₂_swap, map₂_map_left, map₂_swap]
 
+@[simp] lemma map₂_curry (m : α × β → γ) (f : filter α) (g : filter β) :
+  map₂ (curry m) f g = (f ×ᶠ g).map m :=
+(map_prod_eq_map₂' _  _ _).symm
+
+@[simp] lemma map_uncurry_prod (m : α → β → γ) (f : filter α) (g : filter β) :
+  (f ×ᶠ g).map (uncurry m) = map₂ m f g :=
+by rw [←map₂_curry, curry_uncurry]
+
 /-!
 ### Algebraic replacement rules
 
@@ -276,57 +270,93 @@ lemma map_map₂_distrib {n : γ → δ} {m' : α' → β' → δ} {n₁ : α 
   (map₂ m f g).map n = map₂ m' (f.map n₁) (g.map n₂) :=
 by simp_rw [map_map₂, map₂_map_left, map₂_map_right, h_distrib]
 
-/-- Symmetric of `filter.map₂_map_left_comm`. -/
+/-- Symmetric statement to `filter.map₂_map_left_comm`. -/
 lemma map_map₂_distrib_left {n : γ → δ} {m' : α' → β → δ} {n' : α → α'}
   (h_distrib : ∀ a b, n (m a b) = m' (n' a) b) :
   (map₂ m f g).map n = map₂ m' (f.map n') g :=
 map_map₂_distrib h_distrib
 
-/-- Symmetric of `filter.map_map₂_right_comm`. -/
+/-- Symmetric statement to `filter.map_map₂_right_comm`. -/
 lemma map_map₂_distrib_right {n : γ → δ} {m' : α → β' → δ} {n' : β → β'}
   (h_distrib : ∀ a b, n (m a b) = m' a (n' b)) :
   (map₂ m f g).map n = map₂ m' f (g.map n') :=
 map_map₂_distrib h_distrib
 
-/-- Symmetric of `filter.map_map₂_distrib_left`. -/
+/-- Symmetric statement to `filter.map_map₂_distrib_left`. -/
 lemma map₂_map_left_comm {m : α' → β → γ} {n : α → α'} {m' : α → β → δ} {n' : δ → γ}
   (h_left_comm : ∀ a b, m (n a) b = n' (m' a b)) :
   map₂ m (f.map n) g = (map₂ m' f g).map n' :=
 (map_map₂_distrib_left $ λ a b, (h_left_comm a b).symm).symm
 
-/-- Symmetric of `filter.map_map₂_distrib_right`. -/
+/-- Symmetric statement to `filter.map_map₂_distrib_right`. -/
 lemma map_map₂_right_comm {m : α → β' → γ} {n : β → β'} {m' : α → β → δ} {n' : δ → γ}
   (h_right_comm : ∀ a b, m a (n b) = n' (m' a b)) :
   map₂ m f (g.map n) = (map₂ m' f g).map n' :=
 (map_map₂_distrib_right $ λ a b, (h_right_comm a b).symm).symm
 
+/-- The other direction does not hold because of the `f`-`f` cross terms on the RHS. -/
+lemma map₂_distrib_le_left {m : α → δ → ε} {n : β → γ → δ} {m₁ : α → β → β'} {m₂ : α → γ → γ'}
+  {n' : β' → γ' → ε} (h_distrib : ∀ a b c, m a (n b c) = n' (m₁ a b) (m₂ a c)) :
+  map₂ m f (map₂ n g h) ≤ map₂ n' (map₂ m₁ f g) (map₂ m₂ f h) :=
+begin
+  rintro s ⟨t₁, t₂, ⟨u₁, v, hu₁, hv, ht₁⟩, ⟨u₂, w, hu₂, hw, ht₂⟩, hs⟩,
+  refine ⟨u₁ ∩ u₂, _, inter_mem hu₁ hu₂, image2_mem_map₂ hv hw, _⟩,
+  refine (image2_distrib_subset_left h_distrib).trans ((image2_subset _ _).trans hs),
+  { exact (image2_subset_right $ inter_subset_left _ _).trans ht₁ },
+  { exact (image2_subset_right $ inter_subset_right _ _).trans ht₂ }
+end
+
+/-- The other direction does not hold because of the `h`-`h` cross terms on the RHS. -/
+lemma map₂_distrib_le_right {m : δ → γ → ε} {n : α → β → δ} {m₁ : α → γ → α'}
+  {m₂ : β → γ → β'} {n' : α' → β' → ε} (h_distrib : ∀ a b c, m (n a b) c = n' (m₁ a c) (m₂ b c)) :
+  map₂ m (map₂ n f g) h ≤ map₂ n' (map₂ m₁ f h) (map₂ m₂ g h) :=
+begin
+  rintro s ⟨t₁, t₂, ⟨u, w₁, hu, hw₁, ht₁⟩, ⟨v, w₂, hv, hw₂, ht₂⟩, hs⟩,
+  refine ⟨_, w₁ ∩ w₂, image2_mem_map₂ hu hv, inter_mem hw₁ hw₂, _⟩,
+  refine (image2_distrib_subset_right h_distrib).trans ((image2_subset _ _).trans hs),
+  { exact (image2_subset_left $ inter_subset_left _ _).trans ht₁ },
+  { exact (image2_subset_left $ inter_subset_right _ _).trans ht₂ }
+end
+
 lemma map_map₂_antidistrib {n : γ → δ} {m' : β' → α' → δ} {n₁ : β → β'} {n₂ : α → α'}
   (h_antidistrib : ∀ a b, n (m a b) = m' (n₁ b) (n₂ a)) :
   (map₂ m f g).map n = map₂ m' (g.map n₁) (f.map n₂) :=
 by { rw map₂_swap m, exact map_map₂_distrib (λ _ _, h_antidistrib _ _) }
 
-/-- Symmetric of `filter.map₂_map_left_anticomm`. -/
+/-- Symmetric statement to `filter.map₂_map_left_anticomm`. -/
 lemma map_map₂_antidistrib_left {n : γ → δ} {m' : β' → α → δ} {n' : β → β'}
   (h_antidistrib : ∀ a b, n (m a b) = m' (n' b) a) :
   (map₂ m f g).map n = map₂ m' (g.map n') f :=
 map_map₂_antidistrib h_antidistrib
 
-/-- Symmetric of `filter.map_map₂_right_anticomm`. -/
+/-- Symmetric statement to `filter.map_map₂_right_anticomm`. -/
 lemma map_map₂_antidistrib_right {n : γ → δ} {m' : β → α' → δ} {n' : α → α'}
   (h_antidistrib : ∀ a b, n (m a b) = m' b (n' a)) :
   (map₂ m f g).map n = map₂ m' g (f.map n') :=
 map_map₂_antidistrib h_antidistrib
 
-/-- Symmetric of `filter.map_map₂_antidistrib_left`. -/
+/-- Symmetric statement to `filter.map_map₂_antidistrib_left`. -/
 lemma map₂_map_left_anticomm {m : α' → β → γ} {n : α → α'} {m' : β → α → δ} {n' : δ → γ}
   (h_left_anticomm : ∀ a b, m (n a) b = n' (m' b a)) :
   map₂ m (f.map n) g = (map₂ m' g f).map n' :=
 (map_map₂_antidistrib_left $ λ a b, (h_left_anticomm b a).symm).symm
 
-/-- Symmetric of `filter.map_map₂_antidistrib_right`. -/
+/-- Symmetric statement to `filter.map_map₂_antidistrib_right`. -/
 lemma map_map₂_right_anticomm {m : α → β' → γ} {n : β → β'} {m' : β → α → δ} {n' : δ → γ}
   (h_right_anticomm : ∀ a b, m a (n b) = n' (m' b a)) :
   map₂ m f (g.map n) = (map₂ m' g f).map n' :=
 (map_map₂_antidistrib_right $ λ a b, (h_right_anticomm b a).symm).symm
 
+/-- If `a` is a left identity for `f : α → β → β`, then `pure a` is a left identity for
+`filter.map₂ f`. -/
+lemma map₂_left_identity {f : α → β → β} {a : α} (h : ∀ b, f a b = b) (l : filter β) :
+  map₂ f (pure a) l = l :=
+by rw [map₂_pure_left, show f a = id, from funext h, map_id]
+
+/-- If `b` is a right identity for `f : α → β → α`, then `pure b` is a right identity for
+`filter.map₂ f`. -/
+lemma map₂_right_identity {f : α → β → α} {b : β} (h : ∀ a, f a b = a) (l : filter α) :
+  map₂ f l (pure b) = l :=
+by rw [map₂_pure_right, funext h, map_id']
+
 end filter
diff --git a/src/order/filter/partial.lean b/src/order/filter/partial.lean
index fd96d8812e966..2abe4b83c2d33 100644
--- a/src/order/filter/partial.lean
+++ b/src/order/filter/partial.lean
@@ -9,6 +9,9 @@ import data.pfun
 /-!
 # `tendsto` for relations and partial functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file generalizes `filter` definitions from functions to partial functions and relations.
 
 ## Considering functions and partial functions as relations
diff --git a/src/order/filter/pi.lean b/src/order/filter/pi.lean
index 8ee93c4bcb42c..1d9167060ab6f 100644
--- a/src/order/filter/pi.lean
+++ b/src/order/filter/pi.lean
@@ -8,6 +8,9 @@ import order.filter.bases
 /-!
 # (Co)product of a family of filters
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define two filters on `Π i, α i` and prove some basic properties of these filters.
 
 * `filter.pi (f : Π i, filter (α i))` to be the maximal filter on `Π i, α i` such that
@@ -25,12 +28,17 @@ open_locale classical filter
 namespace filter
 
 variables {ι : Type*} {α : ι → Type*} {f f₁ f₂ : Π i, filter (α i)} {s : Π i, set (α i)}
+  {p : Π i, α i → Prop}
 
 section pi
 
 /-- The product of an indexed family of filters. -/
 def pi (f : Π i, filter (α i)) : filter (Π i, α i) := ⨅ i, comap (eval i) (f i)
 
+instance pi.is_countably_generated [countable ι] [∀ i, is_countably_generated (f i)] :
+  is_countably_generated (pi f) :=
+infi.is_countably_generated _
+
 lemma tendsto_eval_pi (f : Π i, filter (α i)) (i : ι) :
   tendsto (eval i) (pi f) (f i) :=
 tendsto_infi' i tendsto_comap
@@ -47,7 +55,7 @@ lemma mem_pi_of_mem (i : ι) {s : set (α i)} (hs : s ∈ f i) :
   eval i ⁻¹' s ∈ pi f :=
 mem_infi_of_mem i $ preimage_mem_comap hs
 
-lemma pi_mem_pi {I : set ι} (hI : finite I) (h : ∀ i ∈ I, s i ∈ f i) :
+lemma pi_mem_pi {I : set ι} (hI : I.finite) (h : ∀ i ∈ I, s i ∈ f i) :
   I.pi s ∈ pi f :=
 begin
   rw [pi_def, bInter_eq_Inter],
@@ -56,7 +64,7 @@ begin
 end
 
 lemma mem_pi {s : set (Π i, α i)} : s ∈ pi f ↔
-  ∃ (I : set ι), finite I ∧ ∃ t : Π i, set (α i), (∀ i, t i ∈ f i) ∧ I.pi t ⊆ s :=
+  ∃ (I : set ι), I.finite ∧ ∃ t : Π i, set (α i), (∀ i, t i ∈ f i) ∧ I.pi t ⊆ s :=
 begin
   split,
   { simp only [pi, mem_infi', mem_comap, pi_def],
@@ -82,16 +90,24 @@ begin
   simpa using hts this i hi
 end
 
-@[simp] lemma pi_mem_pi_iff [∀ i, ne_bot (f i)] {I : set ι} (hI : finite I) :
+@[simp] lemma pi_mem_pi_iff [∀ i, ne_bot (f i)] {I : set ι} (hI : I.finite) :
   I.pi s ∈ pi f ↔ ∀ i ∈ I, s i ∈ f i :=
 ⟨λ h i hi, mem_of_pi_mem_pi h hi, pi_mem_pi hI⟩
 
+lemma eventually.eval_pi {i : ι} (hf : ∀ᶠ (x : α i) in f i, p i x) :
+  ∀ᶠ (x : Π (i : ι), α i) in pi f, p i (x i) :=
+(tendsto_eval_pi _ _).eventually hf
+
+lemma eventually_pi [finite ι] (hf : ∀ i, ∀ᶠ x in f i, p i x) :
+  ∀ᶠ (x : Π i, α i) in pi f, ∀ i, p i (x i) :=
+eventually_all.2 $ λ i, (hf _).eval_pi
+
 lemma has_basis_pi {ι' : ι → Type} {s : Π i, ι' i → set (α i)} {p : Π i, ι' i → Prop}
   (h : ∀ i, (f i).has_basis (p i) (s i)) :
-  (pi f).has_basis (λ If : set ι × Π i, ι' i, finite If.1 ∧ ∀ i ∈ If.1, p i (If.2 i))
+  (pi f).has_basis (λ If : set ι × Π i, ι' i, If.1.finite ∧ ∀ i ∈ If.1, p i (If.2 i))
     (λ If : set ι × Π i, ι' i, If.1.pi (λ i, s i $ If.2 i)) :=
 begin
-  have : (pi f).has_basis _ _ := has_basis_infi (λ i, (h i).comap (eval i : (Π j, α j) → α i)),
+  have : (pi f).has_basis _ _ := has_basis_infi' (λ i, (h i).comap (eval i : (Π j, α j) → α i)),
   convert this,
   ext,
   simp
@@ -139,6 +155,27 @@ by simpa using @pi_inf_principal_univ_pi_eq_bot ι α f (λ _, univ)
 
 instance [∀ i, ne_bot (f i)] : ne_bot (pi f) := pi_ne_bot.2 ‹_›
 
+@[simp] lemma map_eval_pi (f : Π i, filter (α i)) [∀ i, ne_bot (f i)] (i : ι) :
+  map (eval i) (pi f) = f i :=
+begin
+  refine le_antisymm (tendsto_eval_pi f i) (λ s hs, _),
+  rcases mem_pi.1 (mem_map.1 hs) with ⟨I, hIf, t, htf, hI⟩,
+  rw [← image_subset_iff] at hI,
+  refine mem_of_superset (htf i) ((subset_eval_image_pi _ _).trans hI),
+  exact nonempty_of_mem (pi_mem_pi hIf (λ i hi, htf i))
+end
+
+@[simp] lemma pi_le_pi [∀ i, ne_bot (f₁ i)] : pi f₁ ≤ pi f₂ ↔ ∀ i, f₁ i ≤ f₂ i :=
+⟨λ h i, map_eval_pi f₁ i ▸ (tendsto_eval_pi _ _).mono_left h, pi_mono⟩
+
+@[simp] lemma pi_inj [∀ i, ne_bot (f₁ i)] : pi f₁ = pi f₂ ↔ f₁ = f₂ :=
+begin
+  refine ⟨λ h, _, congr_arg pi⟩,
+  have hle : f₁ ≤ f₂ := pi_le_pi.1 h.le,
+  haveI : ∀ i, ne_bot (f₂ i) := λ i, ne_bot_of_le (hle i),
+  exact hle.antisymm (pi_le_pi.1 h.ge)
+end
+
 end pi
 
 /-! ### `n`-ary coproducts of filters -/
diff --git a/src/order/filter/pointwise.lean b/src/order/filter/pointwise.lean
index 71da67d815b7e..f9355b3a67674 100644
--- a/src/order/filter/pointwise.lean
+++ b/src/order/filter/pointwise.lean
@@ -3,13 +3,16 @@ Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Zhouhang Zhou, Yaël Dillies
 -/
-import data.set.pointwise
+import data.set.pointwise.smul
 import order.filter.n_ary
 import order.filter.ultrafilter
 
 /-!
 # Pointwise operations on filters
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines pointwise operations on filters. This is useful because usual algebraic operations
 distribute over pointwise operations. For example,
 * `(f₁ * f₂).map m  = f₁.map m * f₂.map m`
@@ -23,18 +26,22 @@ distribute over pointwise operations. For example,
 * `f * g` (`filter.has_mul`): Multiplication, filter generated by all `s * t` where `s ∈ f` and
   `t ∈ g`.
 * `-f` (`filter.has_neg`): Negation, filter of all `-s` where `s ∈ f`.
-* `f⁻¹` (`filter.has_inv`): Inversion, filter of all `x⁻¹` where `s ∈ f`.
-* `f - g` (`filter.has_sub`): Subtraction, filter generated by all `x - y` where `s ∈ f` and
+* `f⁻¹` (`filter.has_inv`): Inversion, filter of all `s⁻¹` where `s ∈ f`.
+* `f - g` (`filter.has_sub`): Subtraction, filter generated by all `s - t` where `s ∈ f` and
   `t ∈ g`.
-* `f / g` (`filter.has_div`): Division, filter generated by all `x / y` where `s ∈ f` and `t ∈ g`.
-* `f +ᵥ g` (`filter.has_vadd`): Scalar addition, filter generated by all `x +ᵥ y` where `s ∈ f` and
+* `f / g` (`filter.has_div`): Division, filter generated by all `s / t` where `s ∈ f` and `t ∈ g`.
+* `f +ᵥ g` (`filter.has_vadd`): Scalar addition, filter generated by all `s +ᵥ t` where `s ∈ f` and
   `t ∈ g`.
-* `f -ᵥ g` (`filter.has_vsub`): Scalar subtraction, filter generated by all `x -ᵥ y` where `s ∈ f`
+* `f -ᵥ g` (`filter.has_vsub`): Scalar subtraction, filter generated by all `s -ᵥ t` where `s ∈ f`
   and `t ∈ g`.
-* `f • g` (`filter.has_scalar`): Scalar multiplication, filter generated by all `x • y` where
+* `f • g` (`filter.has_smul`): Scalar multiplication, filter generated by all `s • t` where
   `s ∈ f` and `t ∈ g`.
-* `a +ᵥ f` (`filter.has_vadd_filter`): Translation, filter of all `a +ᵥ x` where `s ∈ f`.
-* `a • f` (`filter.has_scalar_filter`): Scaling, filter of all `a • s` where `s ∈ f`.
+* `a +ᵥ f` (`filter.has_vadd_filter`): Translation, filter of all `a +ᵥ s` where `s ∈ f`.
+* `a • f` (`filter.has_smul_filter`): Scaling, filter of all `a • s` where `s ∈ f`.
+
+For `α` a semigroup/monoid, `filter α` is a semigroup/monoid.
+As an unfortunate side effect, this means that `n • f`, where `n : ℕ`, is ambiguous between
+pointwise scaling and repeated pointwise addition. See note [pointwise nat action].
 
 ## Implementation notes
 
@@ -57,7 +64,7 @@ namespace filter
 
 /-! ### `0`/`1` as filters -/
 
-section one
+section has_one
 variables [has_one α] {f : filter α} {s : set α}
 
 /-- `1 : filter α` is defined as the filter of sets containing `1 : α` in locale `pointwise`. -/
@@ -74,22 +81,76 @@ localized "attribute [instance] filter.has_one filter.has_zero" in pointwise
 @[to_additive] lemma one_ne_bot : (1 : filter α).ne_bot := filter.pure_ne_bot
 @[simp, to_additive] protected lemma map_one' (f : α → β) : (1 : filter α).map f = pure (f 1) := rfl
 @[simp, to_additive] lemma le_one_iff : f ≤ 1 ↔ (1 : set α) ∈ f := le_pure_iff
+@[to_additive] protected lemma ne_bot.le_one_iff (h : f.ne_bot) : f ≤ 1 ↔ f = 1 := h.le_pure_iff
 @[simp, to_additive] lemma eventually_one {p : α → Prop} : (∀ᶠ x in 1, p x) ↔ p 1 := eventually_pure
 @[simp, to_additive] lemma tendsto_one {a : filter β} {f : β → α} :
    tendsto f a 1 ↔ ∀ᶠ x in a, f x = 1 :=
 tendsto_pure
 
+@[simp, to_additive] lemma one_prod_one [has_one β] : (1 : filter α) ×ᶠ (1 : filter β) = 1 :=
+prod_pure_pure
+
+/-- `pure` as a `one_hom`. -/
+@[to_additive "`pure` as a `zero_hom`."]
+def pure_one_hom : one_hom α (filter α) := ⟨pure, pure_one⟩
+
+@[simp, to_additive] lemma coe_pure_one_hom : (pure_one_hom : α → filter α) = pure := rfl
+@[simp, to_additive] lemma pure_one_hom_apply (a : α) : pure_one_hom a = pure a := rfl
+
 variables [has_one β]
 
 @[simp, to_additive]
 protected lemma map_one [one_hom_class F α β] (φ : F) : map φ 1 = 1 :=
 by rw [filter.map_one', map_one, pure_one]
 
-end one
+end has_one
+
+/-! ### Filter negation/inversion -/
+
+section has_inv
+variables [has_inv α] {f g : filter α} {s : set α} {a : α}
+
+/-- The inverse of a filter is the pointwise preimage under `⁻¹` of its sets. -/
+@[to_additive "The negation of a filter is the pointwise preimage under `-` of its sets."]
+instance : has_inv (filter α) := ⟨map has_inv.inv⟩
+
+@[simp, to_additive] protected lemma map_inv : f.map has_inv.inv = f⁻¹ := rfl
+@[to_additive] lemma mem_inv : s ∈ f⁻¹ ↔ has_inv.inv ⁻¹' s ∈ f := iff.rfl
+@[to_additive] protected lemma inv_le_inv (hf : f ≤ g) : f⁻¹ ≤ g⁻¹ := map_mono hf
+@[simp, to_additive] lemma inv_pure : (pure a : filter α)⁻¹ = pure a⁻¹ := rfl
+@[simp, to_additive] lemma inv_eq_bot_iff : f⁻¹ = ⊥ ↔ f = ⊥  := map_eq_bot_iff
+@[simp, to_additive] lemma ne_bot_inv_iff : f⁻¹.ne_bot ↔ ne_bot f := map_ne_bot_iff _
+@[to_additive] lemma ne_bot.inv : f.ne_bot → f⁻¹.ne_bot := λ h, h.map _
+
+end has_inv
+
+section has_involutive_inv
+variables [has_involutive_inv α] {f g : filter α} {s : set α}
+
+@[to_additive] lemma inv_mem_inv (hs : s ∈ f) : s⁻¹ ∈ f⁻¹ := by rwa [mem_inv, inv_preimage, inv_inv]
+
+/-- Inversion is involutive on `filter α` if it is on `α`. -/
+@[to_additive "Negation is involutive on `filter α` if it is on `α`."]
+protected def has_involutive_inv : has_involutive_inv (filter α) :=
+{ inv_inv := λ f, map_map.trans $ by rw [inv_involutive.comp_self, map_id],
+  ..filter.has_inv }
+
+localized "attribute [instance] filter.has_involutive_inv filter.has_involutive_neg" in pointwise
+
+@[simp, to_additive] protected lemma inv_le_inv_iff : f⁻¹ ≤ g⁻¹ ↔ f ≤ g :=
+⟨λ h, inv_inv f ▸ inv_inv g ▸ filter.inv_le_inv h, filter.inv_le_inv⟩
+
+@[to_additive] lemma inv_le_iff_le_inv : f⁻¹ ≤ g ↔ f ≤ g⁻¹ :=
+by rw [← filter.inv_le_inv_iff, inv_inv]
+
+@[simp, to_additive] lemma inv_le_self : f⁻¹ ≤ f ↔ f⁻¹ = f :=
+⟨λ h, h.antisymm $ inv_le_iff_le_inv.1 h, eq.le⟩
+
+end has_involutive_inv
 
 /-! ### Filter addition/multiplication -/
 
-section mul
+section has_mul
 variables [has_mul α] [has_mul β] {f f₁ f₂ g g₁ g₂ h : filter α} {s t : set α} {a b : α}
 
 /-- The filter `f * g` is generated by `{s * t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
@@ -102,7 +163,7 @@ way to `set.image2 (*) t₁ t₂ ⊆ s`. -/
 localized "attribute [instance] filter.has_mul filter.has_add" in pointwise
 
 @[simp, to_additive] lemma map₂_mul : map₂ (*) f g = f * g := rfl
-@[to_additive] lemma mem_mul_iff : s ∈ f * g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ * t₂ ⊆ s := iff.rfl
+@[to_additive] lemma mem_mul : s ∈ f * g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ * t₂ ⊆ s := iff.rfl
 @[to_additive] lemma mul_mem_mul : s ∈ f → t ∈ g → s * t ∈ f * g := image2_mem_map₂
 @[simp, to_additive] lemma bot_mul : ⊥ * g = ⊥ := map₂_bot_left
 @[simp, to_additive] lemma mul_bot : f * ⊥ = ⊥ := map₂_bot_right
@@ -127,10 +188,81 @@ le_map₂_iff
 protected lemma map_mul [mul_hom_class F α β] (m : F) : (f₁ * f₂).map m = f₁.map m * f₂.map m :=
 map_map₂_distrib $ map_mul m
 
-end mul
+/-- `pure` operation as a `mul_hom`. -/
+@[to_additive "The singleton operation as an `add_hom`."]
+def pure_mul_hom : α →ₙ* filter α := ⟨pure, λ a b, pure_mul_pure.symm⟩
+
+@[simp, to_additive] lemma coe_pure_mul_hom : (pure_mul_hom : α → filter α) = pure := rfl
+@[simp, to_additive] lemma pure_mul_hom_apply (a : α) : pure_mul_hom a = pure a := rfl
+
+end has_mul
+
+/-! ### Filter subtraction/division -/
+
+section div
+variables [has_div α] {f f₁ f₂ g g₁ g₂ h : filter α} {s t : set α} {a b : α}
+
+/-- The filter `f / g` is generated by `{s / t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
+@[to_additive "The filter `f - g` is generated by `{s - t | s ∈ f, t ∈ g}` in locale `pointwise`."]
+protected def has_div : has_div (filter α) :=
+/- This is defeq to `map₂ (/) f g`, but the hypothesis unfolds to `t₁ / t₂ ⊆ s` rather than all the
+way to `set.image2 (/) t₁ t₂ ⊆ s`. -/
+⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ / t₂ ⊆ s}, ..map₂ (/) f g }⟩
+
+localized "attribute [instance] filter.has_div filter.has_sub" in pointwise
+
+@[simp, to_additive] lemma map₂_div : map₂ (/) f g = f / g := rfl
+@[to_additive] lemma mem_div : s ∈ f / g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ / t₂ ⊆ s := iff.rfl
+@[to_additive] lemma div_mem_div : s ∈ f → t ∈ g → s / t ∈ f / g := image2_mem_map₂
+@[simp, to_additive] lemma bot_div : ⊥ / g = ⊥ := map₂_bot_left
+@[simp, to_additive] lemma div_bot : f / ⊥ = ⊥ := map₂_bot_right
+@[simp, to_additive] lemma div_eq_bot_iff : f / g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := map₂_eq_bot_iff
+@[simp, to_additive] lemma div_ne_bot_iff : (f / g).ne_bot ↔ f.ne_bot ∧ g.ne_bot := map₂_ne_bot_iff
+@[to_additive] lemma ne_bot.div : ne_bot f → ne_bot g → ne_bot (f / g) := ne_bot.map₂
+@[to_additive] lemma ne_bot.of_div_left : (f / g).ne_bot → f.ne_bot := ne_bot.of_map₂_left
+@[to_additive] lemma ne_bot.of_div_right : (f / g).ne_bot → g.ne_bot := ne_bot.of_map₂_right
+@[simp, to_additive] lemma pure_div : pure a / g = g.map ((/) a)  := map₂_pure_left
+@[simp, to_additive] lemma div_pure : f / pure b = f.map (/ b)  := map₂_pure_right
+@[simp, to_additive] lemma pure_div_pure : (pure a : filter α) / pure b = pure (a / b) := map₂_pure
+@[to_additive] protected lemma div_le_div : f₁ ≤ f₂ → g₁ ≤ g₂ → f₁ / g₁ ≤ f₂ / g₂ := map₂_mono
+@[to_additive] protected lemma div_le_div_left : g₁ ≤ g₂ → f / g₁ ≤ f / g₂ := map₂_mono_left
+@[to_additive] protected lemma div_le_div_right : f₁ ≤ f₂ → f₁ / g ≤ f₂ / g := map₂_mono_right
+@[simp, to_additive] protected lemma le_div_iff :
+  h ≤ f / g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → s / t ∈ h :=
+le_map₂_iff
+
+@[to_additive] instance covariant_div : covariant_class (filter α) (filter α) (/) (≤) :=
+⟨λ f g h, map₂_mono_left⟩
+
+@[to_additive] instance covariant_swap_div : covariant_class (filter α) (filter α) (swap (/)) (≤) :=
+⟨λ f g h, map₂_mono_right⟩
+
+end div
 
 open_locale pointwise
 
+/-- Repeated pointwise addition (not the same as pointwise repeated addition!) of a `filter`. See
+Note [pointwise nat action].-/
+protected def has_nsmul [has_zero α] [has_add α] : has_smul ℕ (filter α) := ⟨nsmul_rec⟩
+
+/-- Repeated pointwise multiplication (not the same as pointwise repeated multiplication!) of a
+`filter`. See Note [pointwise nat action]. -/
+@[to_additive]
+protected def has_npow [has_one α] [has_mul α] : has_pow (filter α) ℕ := ⟨λ s n, npow_rec n s⟩
+
+/-- Repeated pointwise addition/subtraction (not the same as pointwise repeated
+addition/subtraction!) of a `filter`. See Note [pointwise nat action]. -/
+protected def has_zsmul [has_zero α] [has_add α] [has_neg α] : has_smul ℤ (filter α) :=
+⟨zsmul_rec⟩
+
+/-- Repeated pointwise multiplication/division (not the same as pointwise repeated
+multiplication/division!) of a `filter`. See Note [pointwise nat action]. -/
+@[to_additive] protected def has_zpow [has_one α] [has_mul α] [has_inv α] : has_pow (filter α) ℤ :=
+⟨λ s n, zpow_rec n s⟩
+
+localized "attribute [instance] filter.has_nsmul filter.has_npow filter.has_zsmul filter.has_zpow"
+  in pointwise
+
 /-- `filter α` is a `semigroup` under pointwise operations if `α` is.-/
 @[to_additive "`filter α` is an `add_semigroup` under pointwise operations if `α` is."]
 protected def semigroup [semigroup α] : semigroup (filter α) :=
@@ -143,31 +275,19 @@ protected def comm_semigroup [comm_semigroup α] : comm_semigroup (filter α) :=
 { mul_comm := λ f g, map₂_comm mul_comm,
   ..filter.semigroup }
 
+section mul_one_class
+variables [mul_one_class α] [mul_one_class β]
+
 /-- `filter α` is a `mul_one_class` under pointwise operations if `α` is. -/
 @[to_additive "`filter α` is an `add_zero_class` under pointwise operations if `α` is."]
-protected def mul_one_class [mul_one_class α] : mul_one_class (filter α) :=
+protected def mul_one_class : mul_one_class (filter α) :=
 { one := 1,
   mul := (*),
-  one_mul := λ f, by simp only [←pure_one, ←map₂_mul, map₂_pure_left, one_mul, map_id'],
-  mul_one := λ f, by simp only [←pure_one, ←map₂_mul, map₂_pure_right, mul_one, map_id'] }
-
-/-- `filter α` is a `monoid` under pointwise operations if `α` is. -/
-@[to_additive "`filter α` is an `add_monoid` under pointwise operations if `α` is."]
-protected def monoid [monoid α] : monoid (filter α) :=
-{ ..filter.mul_one_class, ..filter.semigroup }
-
-/-- `filter α` is a `comm_monoid` under pointwise operations if `α` is. -/
-@[to_additive "`filter α` is an `add_comm_monoid` under pointwise operations if `α` is."]
-protected def comm_monoid [comm_monoid α] : comm_monoid (filter α) :=
-{ ..filter.mul_one_class, ..filter.comm_semigroup }
-
-localized "attribute [instance] filter.mul_one_class filter.add_zero_class filter.semigroup
-  filter.add_semigroup filter.comm_semigroup filter.add_comm_semigroup filter.monoid
-  filter.add_monoid filter.comm_monoid filter.add_comm_monoid" in pointwise
+  one_mul := map₂_left_identity one_mul,
+  mul_one := map₂_right_identity mul_one }
 
-section map
-
-variables [mul_one_class α] [mul_one_class β]
+localized "attribute [instance] filter.semigroup filter.add_semigroup filter.comm_semigroup
+  filter.add_comm_semigroup filter.mul_one_class filter.add_zero_class" in pointwise
 
 /-- If `φ : α →* β` then `map_monoid_hom φ` is the monoid homomorphism
 `filter α →* filter β` induced by `map φ`. -/
@@ -178,10 +298,10 @@ def map_monoid_hom [monoid_hom_class F α β] (φ : F) : filter α →* filter 
   map_one' := filter.map_one φ,
   map_mul' := λ _ _, filter.map_mul φ }
 
--- The other direction does not hold in general.
+-- The other direction does not hold in general
 @[to_additive]
-lemma comap_mul_comap_le [mul_hom_class F α β] (m : F) {f₁ f₂ : filter β} :
-  f₁.comap m * f₂.comap m ≤ (f₁ * f₂).comap m  :=
+lemma comap_mul_comap_le [mul_hom_class F α β] (m : F) {f g : filter β} :
+  f.comap m * g.comap m ≤ (f * g).comap m  :=
 λ s ⟨t, ⟨t₁, t₂, ht₁, ht₂, t₁t₂⟩, mt⟩,
   ⟨m ⁻¹' t₁, m ⁻¹' t₂, ⟨t₁, ht₁, subset.rfl⟩, ⟨t₂, ht₂, subset.rfl⟩,
     (preimage_mul_preimage_subset _).trans $ (preimage_mono t₁t₂).trans mt⟩
@@ -191,141 +311,237 @@ lemma tendsto.mul_mul [mul_hom_class F α β] (m : F) {f₁ g₁ : filter α} {f
   tendsto m f₁ f₂ → tendsto m g₁ g₂ → tendsto m (f₁ * g₁) (f₂ * g₂) :=
 λ hf hg, (filter.map_mul m).trans_le $ mul_le_mul' hf hg
 
-end map
+/-- `pure` as a `monoid_hom`. -/
+@[to_additive "`pure` as an `add_monoid_hom`."]
+def pure_monoid_hom : α →* filter α := { ..pure_mul_hom, ..pure_one_hom }
 
-/-! ### Filter negation/inversion -/
+@[simp, to_additive] lemma coe_pure_monoid_hom : (pure_monoid_hom : α → filter α) = pure := rfl
+@[simp, to_additive] lemma pure_monoid_hom_apply (a : α) : pure_monoid_hom a = pure a := rfl
 
-section has_inv
-variables [has_inv α] {f g : filter α} {s : set α} {a : α}
+end mul_one_class
 
-/-- The inverse of a filter is the pointwise preimage under `⁻¹` of its sets. -/
-@[to_additive "The negation of a filter is the pointwise preimage under `-` of its sets."]
-instance : has_inv (filter α) := ⟨map has_inv.inv⟩
+section monoid
+variables [monoid α] {f g : filter α} {s : set α} {a : α} {m n : ℕ}
 
-@[simp, to_additive] protected lemma map_inv : f.map has_inv.inv = f⁻¹ := rfl
-@[to_additive] lemma mem_inv : s ∈ f⁻¹ ↔ has_inv.inv ⁻¹' s ∈ f := iff.rfl
-@[to_additive] protected lemma inv_le_inv (hf : f ≤ g) : f⁻¹ ≤ g⁻¹ := map_mono hf
-@[simp, to_additive] lemma inv_pure : (pure a : filter α)⁻¹ = pure a⁻¹ := rfl
-@[simp, to_additive] lemma inv_eq_bot_iff : f⁻¹ = ⊥ ↔ f = ⊥  := map_eq_bot_iff
-@[simp, to_additive] lemma ne_bot_inv_iff : f⁻¹.ne_bot ↔ ne_bot f := map_ne_bot_iff _
-@[to_additive] lemma ne_bot.inv : f.ne_bot → f⁻¹.ne_bot := λ h, h.map _
+/-- `filter α` is a `monoid` under pointwise operations if `α` is. -/
+@[to_additive "`filter α` is an `add_monoid` under pointwise operations if `α` is."]
+protected def monoid : monoid (filter α) :=
+{ ..filter.mul_one_class, ..filter.semigroup, ..filter.has_npow }
 
-end has_inv
+localized "attribute [instance] filter.monoid filter.add_monoid" in pointwise
 
-section has_involutive_inv
-variables [has_involutive_inv α] {f : filter α} {s : set α}
+@[to_additive] lemma pow_mem_pow (hs : s ∈ f) : ∀ n : ℕ, s ^ n ∈ f ^ n
+| 0 := by { rw pow_zero, exact one_mem_one }
+| (n + 1) := by { rw pow_succ, exact mul_mem_mul hs (pow_mem_pow _) }
 
-@[to_additive] lemma inv_mem_inv (hs : s ∈ f) : s⁻¹ ∈ f⁻¹ := by rwa [mem_inv, inv_preimage, inv_inv]
+@[simp, to_additive nsmul_bot] lemma bot_pow {n : ℕ} (hn : n ≠ 0) : (⊥  : filter α) ^ n = ⊥ :=
+by rw [←tsub_add_cancel_of_le (nat.succ_le_of_lt $ nat.pos_of_ne_zero hn), pow_succ, bot_mul]
 
-/-- Inversion is involutive on `filter α` if it is on `α`. -/
-@[to_additive "Negation is involutive on `filter α` if it is on `α`."]
-def has_involutive_inv : has_involutive_inv (filter α) :=
-{ inv_inv := λ f, map_map.trans $ by rw [inv_involutive.comp_self, map_id],
-  ..filter.has_inv }
+@[to_additive] lemma mul_top_of_one_le (hf : 1 ≤ f) : f * ⊤ = ⊤ :=
+begin
+  refine top_le_iff.1 (λ s, _),
+  simp only [mem_mul, mem_top, exists_and_distrib_left, exists_eq_left],
+  rintro ⟨t, ht, hs⟩,
+  rwa [mul_univ_of_one_mem (mem_one.1 $ hf ht), univ_subset_iff] at hs,
+end
 
-end has_involutive_inv
+@[to_additive] lemma top_mul_of_one_le (hf : 1 ≤ f) : ⊤ * f = ⊤ :=
+begin
+  refine top_le_iff.1 (λ s, _),
+  simp only [mem_mul, mem_top, exists_and_distrib_left, exists_eq_left],
+  rintro ⟨t, ht, hs⟩,
+  rwa [univ_mul_of_one_mem (mem_one.1 $ hf ht), univ_subset_iff] at hs,
+end
 
-section group
-variables [group α] [group β]
+@[simp, to_additive] lemma top_mul_top : (⊤ : filter α) * ⊤ = ⊤ := mul_top_of_one_le le_top
 
-@[to_additive]
-lemma map_inv' [monoid_hom_class F α β] (m : F) {f : filter α} : f⁻¹.map m = (f.map m)⁻¹ :=
-map_comm (funext $ map_inv m) _
+--TODO: `to_additive` trips up on the `1 : ℕ` used in the pattern-matching.
+lemma nsmul_top {α : Type*} [add_monoid α] : ∀ {n : ℕ}, n ≠ 0 → n • (⊤ : filter α) = ⊤
+| 0 := λ h, (h rfl).elim
+| 1 := λ _, one_nsmul _
+| (n + 2) := λ _, by { rw [succ_nsmul, nsmul_top n.succ_ne_zero, top_add_top] }
 
-@[to_additive]
-lemma tendsto.inv_inv [monoid_hom_class F α β] (m : F) {f₁  : filter α} {f₂ : filter β} :
-  tendsto m f₁ f₂ → tendsto m f₁⁻¹ f₂⁻¹ :=
-λ hf, (filter.map_inv' m).trans_le $ filter.inv_le_inv hf
+@[to_additive nsmul_top] lemma top_pow : ∀ {n : ℕ}, n ≠ 0 → (⊤ : filter α) ^ n = ⊤
+| 0 := λ h, (h rfl).elim
+| 1 := λ _, pow_one _
+| (n + 2) := λ _, by { rw [pow_succ, top_pow n.succ_ne_zero, top_mul_top] }
 
-end group
+@[to_additive] protected lemma _root_.is_unit.filter : is_unit a → is_unit (pure a : filter α) :=
+is_unit.map (pure_monoid_hom : α →* filter α)
 
-/-! ### Filter subtraction/division -/
+end monoid
 
-section div
-variables [has_div α] {f f₁ f₂ g g₁ g₂ h : filter α} {s t : set α} {a b : α}
+/-- `filter α` is a `comm_monoid` under pointwise operations if `α` is. -/
+@[to_additive "`filter α` is an `add_comm_monoid` under pointwise operations if `α` is."]
+protected def comm_monoid [comm_monoid α] : comm_monoid (filter α) :=
+{ ..filter.mul_one_class, ..filter.comm_semigroup }
 
-/-- The filter `f / g` is generated by `{s / t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
-@[to_additive "The filter `f - g` is generated by `{s - t | s ∈ f, t ∈ g}` in locale `pointwise`."]
-protected def has_div : has_div (filter α) :=
-/- This is defeq to `map₂ (/) f g`, but the hypothesis unfolds to `t₁ / t₂ ⊆ s` rather than all the
-way to `set.image2 (/) t₁ t₂ ⊆ s`. -/
-⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ / t₂ ⊆ s}, ..map₂ (/) f g }⟩
+open_locale pointwise
 
-localized "attribute [instance] filter.has_div filter.has_sub" in pointwise
+section division_monoid
+variables [division_monoid α] {f g : filter α}
 
-@[simp, to_additive] lemma map₂_div : map₂ (/) f g = f / g := rfl
-@[to_additive] lemma mem_div : s ∈ f / g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ / t₂ ⊆ s := iff.rfl
-@[to_additive] lemma div_mem_div : s ∈ f → t ∈ g → s / t ∈ f / g := image2_mem_map₂
-@[simp, to_additive] lemma bot_div : ⊥ / g = ⊥ := map₂_bot_left
-@[simp, to_additive] lemma div_bot : f / ⊥ = ⊥ := map₂_bot_right
-@[simp, to_additive] lemma div_eq_bot_iff : f / g = ⊥ ↔ f = ⊥ ∨ g = ⊥ := map₂_eq_bot_iff
-@[simp, to_additive] lemma div_ne_bot_iff : (f / g).ne_bot ↔ f.ne_bot ∧ g.ne_bot := map₂_ne_bot_iff
-@[to_additive] lemma ne_bot.div : ne_bot f → ne_bot g → ne_bot (f / g) := ne_bot.map₂
-@[to_additive] lemma ne_bot.of_div_left : (f / g).ne_bot → f.ne_bot := ne_bot.of_map₂_left
-@[to_additive] lemma ne_bot.of_div_right : (f / g).ne_bot → g.ne_bot := ne_bot.of_map₂_right
-@[simp, to_additive] lemma pure_div : pure a / g = g.map ((/) a)  := map₂_pure_left
-@[simp, to_additive] lemma div_pure : f / pure b = f.map (/ b)  := map₂_pure_right
-@[simp, to_additive] lemma pure_div_pure : (pure a : filter α) / pure b = pure (a / b) := map₂_pure
-@[to_additive] protected lemma div_le_div : f₁ ≤ f₂ → g₁ ≤ g₂ → f₁ / g₁ ≤ f₂ / g₂ := map₂_mono
-@[to_additive] protected lemma div_le_div_left : g₁ ≤ g₂ → f / g₁ ≤ f / g₂ := map₂_mono_left
-@[to_additive] protected lemma div_le_div_right : f₁ ≤ f₂ → f₁ / g ≤ f₂ / g := map₂_mono_right
-@[simp, to_additive] protected lemma le_div_iff :
-  h ≤ f / g ↔ ∀ ⦃s⦄, s ∈ f → ∀ ⦃t⦄, t ∈ g → s / t ∈ h :=
-le_map₂_iff
+@[to_additive]
+protected lemma mul_eq_one_iff : f * g = 1 ↔ ∃ a b, f = pure a ∧ g = pure b ∧ a * b = 1 :=
+begin
+  refine ⟨λ hfg, _, _⟩,
+  { obtain ⟨t₁, t₂, h₁, h₂, h⟩ : (1 : set α) ∈ f * g := hfg.symm.subst one_mem_one,
+    have hfg : (f * g).ne_bot := hfg.symm.subst one_ne_bot,
+    rw [(hfg.nonempty_of_mem $ mul_mem_mul h₁ h₂).subset_one_iff, set.mul_eq_one_iff] at h,
+    obtain ⟨a, b, rfl, rfl, h⟩ := h,
+    refine ⟨a, b, _, _, h⟩,
+    { rwa [←hfg.of_mul_left.le_pure_iff, le_pure_iff] },
+    { rwa [←hfg.of_mul_right.le_pure_iff, le_pure_iff] } },
+  { rintro ⟨a, b, rfl, rfl, h⟩,
+    rw [pure_mul_pure, h, pure_one] }
+end
+
+/-- `filter α` is a division monoid under pointwise operations if `α` is. -/
+@[to_additive "`filter α` is a subtraction monoid under pointwise
+operations if `α` is."]
+protected def division_monoid : division_monoid (filter α) :=
+{ mul_inv_rev := λ s t, map_map₂_antidistrib mul_inv_rev,
+  inv_eq_of_mul := λ s t h, begin
+    obtain ⟨a, b, rfl, rfl, hab⟩ := filter.mul_eq_one_iff.1 h,
+    rw [inv_pure, inv_eq_of_mul_eq_one_right hab],
+  end,
+  div_eq_mul_inv := λ f g, map_map₂_distrib_right div_eq_mul_inv,
+  ..filter.monoid, ..filter.has_involutive_inv, ..filter.has_div, ..filter.has_zpow }
+
+@[to_additive] lemma is_unit_iff : is_unit f ↔ ∃ a, f = pure a ∧ is_unit a :=
+begin
+  split,
+  { rintro ⟨u, rfl⟩,
+    obtain ⟨a, b, ha, hb, h⟩ := filter.mul_eq_one_iff.1 u.mul_inv,
+    refine ⟨a, ha, ⟨a, b, h, pure_injective _⟩, rfl⟩,
+    rw [←pure_mul_pure, ←ha, ←hb],
+    exact u.inv_mul },
+  { rintro ⟨a, rfl, ha⟩,
+    exact ha.filter }
+end
+
+end division_monoid
+
+/-- `filter α` is a commutative division monoid under pointwise operations if `α` is. -/
+@[to_additive subtraction_comm_monoid "`filter α` is a commutative subtraction monoid under
+pointwise operations if `α` is."]
+protected def division_comm_monoid [division_comm_monoid α] : division_comm_monoid (filter α) :=
+{ ..filter.division_monoid, ..filter.comm_semigroup }
+
+/-- `filter α` has distributive negation if `α` has. -/
+protected def has_distrib_neg [has_mul α] [has_distrib_neg α] : has_distrib_neg (filter α) :=
+{ neg_mul := λ _ _, map₂_map_left_comm neg_mul,
+  mul_neg := λ _ _, map_map₂_right_comm mul_neg,
+  ..filter.has_involutive_neg }
+
+localized "attribute [instance] filter.comm_monoid filter.add_comm_monoid filter.division_monoid
+  filter.subtraction_monoid filter.division_comm_monoid filter.subtraction_comm_monoid
+  filter.has_distrib_neg" in pointwise
+
+section distrib
+variables [distrib α] {f g h : filter α}
 
-@[to_additive] instance covariant_div : covariant_class (filter α) (filter α) (/) (≤) :=
-⟨λ f g h, map₂_mono_left⟩
+/-!
+Note that `filter α` is not a `distrib` because `f * g + f * h` has cross terms that `f * (g + h)`
+lacks.
+-/
 
-@[to_additive] instance covariant_swap_div : covariant_class (filter α) (filter α) (swap (/)) (≤) :=
-⟨λ f g h, map₂_mono_right⟩
+lemma mul_add_subset : f * (g + h) ≤ f * g + f * h := map₂_distrib_le_left mul_add
+lemma add_mul_subset : (f + g) * h ≤ f * h + g * h := map₂_distrib_le_right add_mul
 
-end div
+end distrib
 
-open_locale pointwise
+section mul_zero_class
+variables [mul_zero_class α] {f g : filter α}
+
+/-! Note that `filter` is not a `mul_zero_class` because `0 * ⊥ ≠ 0`. -/
+
+lemma ne_bot.mul_zero_nonneg (hf : f.ne_bot) : 0 ≤ f * 0 :=
+le_mul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨a, ha⟩ := hf.nonempty_of_mem h₁ in ⟨_, _, ha, h₂, mul_zero _⟩
+
+lemma ne_bot.zero_mul_nonneg (hg : g.ne_bot) : 0 ≤ 0 * g :=
+le_mul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨b, hb⟩ := hg.nonempty_of_mem h₂ in ⟨_, _, h₁, hb, zero_mul _⟩
+
+end mul_zero_class
 
 section group
-variables [group α] [group β] {f g  : filter α} {f₂ : filter β}
+variables [group α] [division_monoid β] [monoid_hom_class F α β] (m : F) {f g f₁ g₁ : filter α}
+  {f₂ g₂ : filter β}
 
-@[to_additive]
-protected lemma map_div [monoid_hom_class F α β] (m : F) : (f / g).map m = f.map m / g.map m :=
+/-! Note that `filter α` is not a group because `f / f ≠ 1` in general -/
+
+@[simp, to_additive] protected lemma one_le_div_iff : 1 ≤ f / g ↔ ¬ disjoint f g :=
+begin
+  refine ⟨λ h hfg, _, _⟩,
+  { obtain ⟨s, hs, t, ht, hst⟩ := hfg.le_bot (mem_bot : ∅ ∈ ⊥),
+    exact set.one_mem_div_iff.1 (h $ div_mem_div hs ht) (disjoint_iff.2 hst.symm) },
+  { rintro h s ⟨t₁, t₂, h₁, h₂, hs⟩,
+    exact hs (set.one_mem_div_iff.2 $ λ ht, h $ disjoint_of_disjoint_of_mem ht h₁ h₂) }
+end
+
+@[to_additive] lemma not_one_le_div_iff : ¬ 1 ≤ f / g ↔ disjoint f g :=
+filter.one_le_div_iff.not_left
+
+@[to_additive] lemma ne_bot.one_le_div (h : f.ne_bot) : 1 ≤ f / f :=
+begin
+  rintro s ⟨t₁, t₂, h₁, h₂, hs⟩,
+  obtain ⟨a, ha₁, ha₂⟩ := set.not_disjoint_iff.1 (h.not_disjoint h₁ h₂),
+  rw [mem_one, ←div_self' a],
+  exact hs (set.div_mem_div ha₁ ha₂),
+end
+
+@[to_additive] lemma is_unit_pure (a : α) : is_unit (pure a : filter α) := (group.is_unit a).filter
+
+@[simp] lemma is_unit_iff_singleton : is_unit f ↔ ∃ a, f = pure a :=
+by simp only [is_unit_iff, group.is_unit, and_true]
+
+include β
+
+@[to_additive] lemma map_inv' : f⁻¹.map m = (f.map m)⁻¹ := semiconj.filter_map (map_inv m) f
+
+@[to_additive] lemma tendsto.inv_inv : tendsto m f₁ f₂ → tendsto m f₁⁻¹ f₂⁻¹ :=
+λ hf, (filter.map_inv' m).trans_le $ filter.inv_le_inv hf
+
+@[to_additive] protected lemma map_div : (f / g).map m = f.map m / g.map m :=
 map_map₂_distrib $ map_div m
 
 @[to_additive]
-lemma tendsto.div_div [monoid_hom_class F α β] (m : F) {f₁ g₁ : filter α} {f₂ g₂ : filter β} :
-  tendsto m f₁ f₂ → tendsto m g₁ g₂ → tendsto m (f₁ / g₁) (f₂ / g₂) :=
+lemma tendsto.div_div : tendsto m f₁ f₂ → tendsto m g₁ g₂ → tendsto m (f₁ / g₁) (f₂ / g₂) :=
 λ hf hg, (filter.map_div m).trans_le $ filter.div_le_div hf hg
 
 end group
 
-/-TODO: The below instances are duplicate because there is no typeclass greater than
-`div_inv_monoid` and `has_involutive_inv` but smaller than `group` and `group_with_zero`. -/
+open_locale pointwise
 
-/-- `f / g = f * g⁻¹` for all `f g : filter α` if `a / b = a * b⁻¹` for all `a b : α`. -/
-@[to_additive filter.sub_neg_monoid "`f - g = f + -g` for all `f g : filter α` if `a - b = a + -b`
-for all `a b : α`."]
-protected def div_inv_monoid [group α] : div_inv_monoid (filter α) :=
-{ div_eq_mul_inv := λ f g, map_map₂_distrib_right div_eq_mul_inv,
-  ..filter.monoid, ..filter.has_inv, ..filter.has_div }
+section group_with_zero
+variables [group_with_zero α] {f g : filter α}
 
-/-- `f / g = f * g⁻¹` for all `f g : filter α` if `a / b = a * b⁻¹` for all `a b : α`. -/
-protected def div_inv_monoid' [group_with_zero α] : div_inv_monoid (filter α) :=
-{ div_eq_mul_inv := λ f g, map_map₂_distrib_right div_eq_mul_inv,
-  ..filter.monoid, ..filter.has_inv, ..filter.has_div }
+lemma ne_bot.div_zero_nonneg (hf : f.ne_bot) : 0 ≤ f / 0 :=
+filter.le_div_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨a, ha⟩ := hf.nonempty_of_mem h₁ in
+  ⟨_, _, ha, h₂, div_zero _⟩
 
-localized "attribute [instance] filter.div_inv_monoid filter.sub_neg_monoid filter.div_inv_monoid'"
-  in pointwise
+lemma ne_bot.zero_div_nonneg (hg : g.ne_bot) : 0 ≤ 0 / g :=
+filter.le_div_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨b, hb⟩ := hg.nonempty_of_mem h₂ in
+  ⟨_, _, h₁, hb, zero_div _⟩
+
+end group_with_zero
 
 /-! ### Scalar addition/multiplication of filters -/
 
 section smul
-variables [has_scalar α β] {f f₁ f₂ : filter α} {g g₁ g₂ h : filter β} {s : set α} {t : set β}
+variables [has_smul α β] {f f₁ f₂ : filter α} {g g₁ g₂ h : filter β} {s : set α} {t : set β}
   {a : α} {b : β}
 
-@[to_additive filter.has_vadd] instance : has_scalar (filter α) (filter β) :=
+/-- The filter `f • g` is generated by `{s • t | s ∈ f, t ∈ g}` in locale `pointwise`. -/
+@[to_additive filter.has_vadd
+"The filter `f +ᵥ g` is generated by `{s +ᵥ t | s ∈ f, t ∈ g}` in locale `pointwise`."]
+protected def has_smul : has_smul (filter α) (filter β) :=
 /- This is defeq to `map₂ (•) f g`, but the hypothesis unfolds to `t₁ • t₂ ⊆ s` rather than all the
 way to `set.image2 (•) t₁ t₂ ⊆ s`. -/
 ⟨λ f g, { sets := {s | ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ • t₂ ⊆ s}, ..map₂ (•) f g }⟩
 
+localized "attribute [instance] filter.has_smul filter.has_vadd" in pointwise
+
 @[simp, to_additive] lemma map₂_smul : map₂ (•) f g = f • g := rfl
 @[to_additive] lemma mem_smul : t ∈ f • g ↔ ∃ t₁ t₂, t₁ ∈ f ∧ t₂ ∈ g ∧ t₁ • t₂ ⊆ t := iff.rfl
 @[to_additive] lemma smul_mem_smul : s ∈ f → t ∈ g → s • t ∈ f • g :=  image2_mem_map₂
@@ -351,11 +567,6 @@ le_map₂_iff
 
 end smul
 
-@[to_additive]
-instance [monoid α] [mul_action α β] : mul_action (filter α) (filter β) :=
-{ one_smul := λ f, by simp only [←pure_one, ←map₂_smul, map₂_pure_left, one_smul, map_id'],
-  mul_smul := λ f g h, map₂_assoc mul_smul }
-
 /-! ### Scalar subtraction of filters -/
 
 section vsub
@@ -394,14 +605,14 @@ end vsub
 /-! ### Translation/scaling of filters -/
 
 section smul
-variables [has_scalar α β] {f f₁ f₂ : filter β} {s : set β} {a : α}
+variables [has_smul α β] {f f₁ f₂ : filter β} {s : set β} {a : α}
 
 /-- `a • f` is the map of `f` under `a •` in locale `pointwise`. -/
 @[to_additive filter.has_vadd_filter
 "`a +ᵥ f` is the map of `f` under `a +ᵥ` in locale `pointwise`."]
-protected def has_scalar_filter : has_scalar α (filter β) := ⟨λ a, map ((•) a)⟩
+protected def has_smul_filter : has_smul α (filter β) := ⟨λ a, map ((•) a)⟩
 
-localized "attribute [instance] filter.has_scalar_filter filter.has_vadd_filter" in pointwise
+localized "attribute [instance] filter.has_smul_filter filter.has_vadd_filter" in pointwise
 
 @[simp, to_additive] lemma map_smul : map (λ b, a • b) f = a • f := rfl
 @[to_additive] lemma mem_smul_filter : s ∈ a • f ↔ (•) a ⁻¹' s ∈ f := iff.rfl
@@ -411,6 +622,7 @@ localized "attribute [instance] filter.has_scalar_filter filter.has_vadd_filter"
 @[simp, to_additive] lemma smul_filter_eq_bot_iff : a • f = ⊥ ↔ f = ⊥ := map_eq_bot_iff
 @[simp, to_additive] lemma smul_filter_ne_bot_iff : (a • f).ne_bot ↔ f.ne_bot := map_ne_bot_iff _
 @[to_additive] lemma ne_bot.smul_filter : f.ne_bot → (a • f).ne_bot := λ h, h.map _
+@[to_additive] lemma ne_bot.of_smul_filter : (a • f).ne_bot → f.ne_bot := ne_bot.of_map
 @[to_additive] lemma smul_filter_le_smul_filter (hf : f₁ ≤ f₂) : a • f₁ ≤ a • f₂ :=
 map_mono hf
 
@@ -422,37 +634,108 @@ end smul
 open_locale pointwise
 
 @[to_additive]
-instance smul_comm_class_filter [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
+instance smul_comm_class_filter [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
+  smul_comm_class α β (filter γ) :=
+⟨λ _ _ _,  map_comm (funext $ smul_comm _ _) _⟩
+
+@[to_additive]
+instance smul_comm_class_filter' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
   smul_comm_class α (filter β) (filter γ) :=
 ⟨λ a f g, map_map₂_distrib_right $ smul_comm a⟩
 
 @[to_additive]
-instance smul_comm_class_filter' [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
+instance smul_comm_class_filter'' [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
   smul_comm_class (filter α) β (filter γ) :=
 by haveI := smul_comm_class.symm α β γ; exact smul_comm_class.symm _ _ _
 
 @[to_additive]
-instance smul_comm_class [has_scalar α γ] [has_scalar β γ] [smul_comm_class α β γ] :
+instance smul_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
   smul_comm_class (filter α) (filter β) (filter γ) :=
 ⟨λ f g h, map₂_left_comm smul_comm⟩
 
-instance is_scalar_tower [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
-  [is_scalar_tower α β γ] :
+@[to_additive]
+instance is_scalar_tower [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
   is_scalar_tower α β (filter γ) :=
 ⟨λ a b f, by simp only [←map_smul, map_map, smul_assoc]⟩
 
-instance is_scalar_tower' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
-  [is_scalar_tower α β γ] :
+@[to_additive]
+instance is_scalar_tower' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
   is_scalar_tower α (filter β) (filter γ) :=
 ⟨λ a f g, by { refine (map_map₂_distrib_left $ λ _ _, _).symm, exact (smul_assoc a _ _).symm }⟩
 
-instance is_scalar_tower'' [has_scalar α β] [has_scalar α γ] [has_scalar β γ]
-  [is_scalar_tower α β γ] :
+@[to_additive]
+instance is_scalar_tower'' [has_smul α β] [has_smul α γ] [has_smul β γ] [is_scalar_tower α β γ] :
   is_scalar_tower (filter α) (filter β) (filter γ) :=
 ⟨λ f g h, map₂_assoc smul_assoc⟩
 
-instance is_central_scalar [has_scalar α β] [has_scalar αᵐᵒᵖ β] [is_central_scalar α β] :
+@[to_additive] instance is_central_scalar [has_smul α β] [has_smul αᵐᵒᵖ β] [is_central_scalar α β] :
   is_central_scalar α (filter β) :=
 ⟨λ a f, congr_arg (λ m, map m f) $ by exact funext (λ _, op_smul_eq_smul _ _)⟩
 
+/-- A multiplicative action of a monoid `α` on a type `β` gives a multiplicative action of
+`filter α` on `filter β`. -/
+@[to_additive "An additive action of an additive monoid `α` on a type `β` gives an additive action
+of `filter α` on `filter β`"]
+protected def mul_action [monoid α] [mul_action α β] : mul_action (filter α) (filter β) :=
+{ one_smul := λ f, map₂_pure_left.trans $ by simp_rw [one_smul, map_id'],
+  mul_smul := λ f g h, map₂_assoc mul_smul }
+
+/-- A multiplicative action of a monoid on a type `β` gives a multiplicative action on `filter β`.
+-/
+@[to_additive "An additive action of an additive monoid on a type `β` gives an additive action on
+`filter β`."]
+protected def mul_action_filter [monoid α] [mul_action α β] : mul_action α (filter β) :=
+{ mul_smul := λ a b f, by simp only [←map_smul, map_map, function.comp, ←mul_smul],
+  one_smul := λ f, by simp only [←map_smul, one_smul, map_id'] }
+
+localized "attribute [instance] filter.mul_action filter.add_action filter.mul_action_filter
+  filter.add_action_filter" in pointwise
+
+/-- A distributive multiplicative action of a monoid on an additive monoid `β` gives a distributive
+multiplicative action on `filter β`. -/
+protected def distrib_mul_action_filter [monoid α] [add_monoid β] [distrib_mul_action α β] :
+  distrib_mul_action α (filter β) :=
+{ smul_add := λ _ _ _, map_map₂_distrib $ smul_add _,
+  smul_zero := λ _, (map_pure _ _).trans $ by rw [smul_zero, pure_zero] }
+
+/-- A multiplicative action of a monoid on a monoid `β` gives a multiplicative action on `set β`. -/
+protected def mul_distrib_mul_action_filter [monoid α] [monoid β] [mul_distrib_mul_action α β] :
+  mul_distrib_mul_action α (set β) :=
+{ smul_mul := λ _ _ _, image_image2_distrib $ smul_mul' _,
+  smul_one := λ _, image_singleton.trans $ by rw [smul_one, singleton_one] }
+
+localized "attribute [instance] filter.distrib_mul_action_filter
+  filter.mul_distrib_mul_action_filter" in pointwise
+
+section smul_with_zero
+variables [has_zero α] [has_zero β] [smul_with_zero α β] {f : filter α} {g : filter β}
+
+/-!
+Note that we have neither `smul_with_zero α (filter β)` nor `smul_with_zero (filter α) (filter β)`
+because `0 * ⊥ ≠ 0`.
+-/
+
+lemma ne_bot.smul_zero_nonneg (hf : f.ne_bot) : 0 ≤ f • (0 : filter β) :=
+le_smul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨a, ha⟩ := hf.nonempty_of_mem h₁ in
+  ⟨_, _, ha, h₂, smul_zero _⟩
+
+lemma ne_bot.zero_smul_nonneg (hg : g.ne_bot) : 0 ≤ (0 : filter α) • g :=
+le_smul_iff.2 $ λ t₁ h₁ t₂ h₂, let ⟨b, hb⟩ := hg.nonempty_of_mem h₂ in ⟨_, _, h₁, hb, zero_smul _ _⟩
+
+lemma zero_smul_filter_nonpos : (0 : α) • g ≤ 0 :=
+begin
+  refine λ s hs, mem_smul_filter.2 _,
+  convert univ_mem,
+  refine eq_univ_iff_forall.2 (λ a, _),
+  rwa [mem_preimage, zero_smul],
+end
+
+lemma zero_smul_filter (hg : g.ne_bot) : (0 : α) • g = 0 :=
+zero_smul_filter_nonpos.antisymm $ le_map_iff.2 $ λ s hs, begin
+  simp_rw [set.image_eta, zero_smul, (hg.nonempty_of_mem hs).image_const],
+  exact zero_mem_zero,
+end
+
+end smul_with_zero
+
 end filter
diff --git a/src/order/filter/prod.lean b/src/order/filter/prod.lean
new file mode 100644
index 0000000000000..b6dc75e02a0d8
--- /dev/null
+++ b/src/order/filter/prod.lean
@@ -0,0 +1,485 @@
+/-
+Copyright (c) 2022 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johanes Hölzl, Patrick Massot, Yury Kudryashov, Kevin Wilson, Heather Macbeth
+-/
+import order.filter.basic
+
+/-!
+# Product and coproduct filters
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define `filter.prod f g` (notation: `f ×ᶠ g`) and `filter.coprod f g`. The product
+of two filters is the largest filter `l` such that `filter.tendsto prod.fst l f` and
+`filter.tendsto prod.snd l g`.
+
+## Implementation details
+
+The product filter cannot be defined using the monad structure on filters. For example:
+
+```lean
+F := do {x ← seq, y ← top, return (x, y)}
+G := do {y ← top, x ← seq, return (x, y)}
+```
+hence:
+```lean
+s ∈ F  ↔  ∃ n, [n..∞] × univ ⊆ s
+s ∈ G  ↔  ∀ i:ℕ, ∃ n, [n..∞] × {i} ⊆ s
+```
+Now `⋃ i, [i..∞] × {i}` is in `G` but not in `F`.
+As product filter we want to have `F` as result.
+
+## Notations
+
+* `f ×ᶠ g` : `filter.prod f g`, localized in `filter`.
+
+-/
+
+open set
+open_locale filter
+
+namespace filter
+
+variables {α β γ δ : Type*} {ι : Sort*}
+
+section prod
+variables {s : set α} {t : set β} {f : filter α} {g : filter β}
+
+/-- Product of filters. This is the filter generated by cartesian products
+of elements of the component filters. -/
+protected def prod (f : filter α) (g : filter β) : filter (α × β) :=
+f.comap prod.fst ⊓ g.comap prod.snd
+
+localized "infix (name := filter.prod) ` ×ᶠ `:60 := filter.prod" in filter
+
+lemma prod_mem_prod {s : set α} {t : set β} {f : filter α} {g : filter β}
+  (hs : s ∈ f) (ht : t ∈ g) : s ×ˢ t ∈ f ×ᶠ g :=
+inter_mem_inf (preimage_mem_comap hs) (preimage_mem_comap ht)
+
+lemma mem_prod_iff {s : set (α×β)} {f : filter α} {g : filter β} :
+  s ∈ f ×ᶠ g ↔ (∃ t₁ ∈ f, ∃ t₂ ∈ g, t₁ ×ˢ t₂ ⊆ s) :=
+begin
+  simp only [filter.prod],
+  split,
+  { rintro ⟨t₁, ⟨s₁, hs₁, hts₁⟩, t₂, ⟨s₂, hs₂, hts₂⟩, rfl⟩,
+    exact  ⟨s₁, hs₁, s₂, hs₂, λ p ⟨h, h'⟩, ⟨hts₁ h, hts₂ h'⟩⟩ },
+  { rintro ⟨t₁, ht₁, t₂, ht₂, h⟩,
+    exact mem_inf_of_inter (preimage_mem_comap ht₁) (preimage_mem_comap ht₂) h }
+end
+
+@[simp] lemma prod_mem_prod_iff {s : set α} {t : set β} {f : filter α} {g : filter β}
+  [f.ne_bot] [g.ne_bot] :
+  s ×ˢ t ∈ f ×ᶠ g ↔ s ∈ f ∧ t ∈ g :=
+⟨λ h, let ⟨s', hs', t', ht', H⟩ := mem_prod_iff.1 h in (prod_subset_prod_iff.1 H).elim
+  (λ ⟨hs's, ht't⟩, ⟨mem_of_superset hs' hs's, mem_of_superset ht' ht't⟩)
+  (λ h, h.elim
+    (λ hs'e, absurd hs'e (nonempty_of_mem hs').ne_empty)
+    (λ ht'e, absurd ht'e (nonempty_of_mem ht').ne_empty)),
+  λ h, prod_mem_prod h.1 h.2⟩
+
+lemma mem_prod_principal {f : filter α} {s : set (α × β)} {t : set β}:
+  s ∈ f ×ᶠ 𝓟 t ↔ {a | ∀ b ∈ t, (a, b) ∈ s} ∈ f :=
+begin
+  rw [← @exists_mem_subset_iff _ f, mem_prod_iff],
+  refine exists₂_congr (λ u u_in, ⟨_, λ h, ⟨t, mem_principal_self t, _⟩⟩),
+  { rintros ⟨v, v_in, hv⟩ a a_in b b_in,
+    exact hv (mk_mem_prod a_in $ v_in b_in) },
+  { rintro ⟨x, y⟩ ⟨hx, hy⟩,
+    exact h hx y hy }
+end
+
+lemma mem_prod_top {f : filter α} {s : set (α × β)} :
+  s ∈ f ×ᶠ (⊤ : filter β) ↔ {a | ∀ b, (a, b) ∈ s} ∈ f :=
+begin
+  rw [← principal_univ, mem_prod_principal],
+  simp only [mem_univ, forall_true_left]
+end
+
+lemma eventually_prod_principal_iff {p : α × β → Prop} {s : set β} :
+  (∀ᶠ (x : α × β) in (f ×ᶠ (𝓟 s)), p x) ↔ ∀ᶠ (x : α) in f, ∀ (y : β), y ∈ s → p (x, y) :=
+by { rw [eventually_iff, eventually_iff, mem_prod_principal], simp only [mem_set_of_eq], }
+
+lemma comap_prod (f : α → β × γ) (b : filter β) (c : filter γ) :
+  comap f (b ×ᶠ c) = (comap (prod.fst ∘ f) b) ⊓ (comap (prod.snd ∘ f) c) :=
+by erw [comap_inf, filter.comap_comap, filter.comap_comap]
+
+lemma prod_top {f : filter α} : f ×ᶠ (⊤ : filter β) = f.comap prod.fst :=
+by rw [filter.prod, comap_top, inf_top_eq]
+
+lemma sup_prod (f₁ f₂ : filter α) (g : filter β) : (f₁ ⊔ f₂) ×ᶠ g = (f₁ ×ᶠ g) ⊔ (f₂ ×ᶠ g) :=
+by rw [filter.prod, comap_sup, inf_sup_right, ← filter.prod, ← filter.prod]
+
+lemma prod_sup (f : filter α) (g₁ g₂ : filter β) : f ×ᶠ (g₁ ⊔ g₂) = (f ×ᶠ g₁) ⊔ (f ×ᶠ g₂) :=
+by rw [filter.prod, comap_sup, inf_sup_left, ← filter.prod, ← filter.prod]
+
+lemma eventually_prod_iff {p : α × β → Prop} {f : filter α} {g : filter β} :
+  (∀ᶠ x in f ×ᶠ g, p x) ↔ ∃ (pa : α → Prop) (ha : ∀ᶠ x in f, pa x)
+    (pb : β → Prop) (hb : ∀ᶠ y in g, pb y), ∀ {x}, pa x → ∀ {y}, pb y → p (x, y) :=
+by simpa only [set.prod_subset_iff] using @mem_prod_iff α β p f g
+
+lemma tendsto_fst {f : filter α} {g : filter β} : tendsto prod.fst (f ×ᶠ g) f :=
+tendsto_inf_left tendsto_comap
+
+lemma tendsto_snd {f : filter α} {g : filter β} : tendsto prod.snd (f ×ᶠ g) g :=
+tendsto_inf_right tendsto_comap
+
+lemma tendsto.prod_mk {f : filter α} {g : filter β} {h : filter γ} {m₁ : α → β} {m₂ : α → γ}
+  (h₁ : tendsto m₁ f g) (h₂ : tendsto m₂ f h) : tendsto (λ x, (m₁ x, m₂ x)) f (g ×ᶠ h) :=
+tendsto_inf.2 ⟨tendsto_comap_iff.2 h₁, tendsto_comap_iff.2 h₂⟩
+
+lemma tendsto_prod_swap {α1 α2 : Type*} {a1 : filter α1} {a2 : filter α2} :
+  tendsto (prod.swap : α1 × α2 → α2 × α1) (a1 ×ᶠ a2) (a2 ×ᶠ a1) :=
+tendsto_snd.prod_mk tendsto_fst
+
+lemma eventually.prod_inl {la : filter α} {p : α → Prop} (h : ∀ᶠ x in la, p x) (lb : filter β) :
+  ∀ᶠ x in la ×ᶠ lb, p (x : α × β).1 :=
+tendsto_fst.eventually h
+
+lemma eventually.prod_inr {lb : filter β} {p : β → Prop} (h : ∀ᶠ x in lb, p x) (la : filter α) :
+  ∀ᶠ x in la ×ᶠ lb, p (x : α × β).2 :=
+tendsto_snd.eventually h
+
+lemma eventually.prod_mk {la : filter α} {pa : α → Prop} (ha : ∀ᶠ x in la, pa x)
+  {lb : filter β} {pb : β → Prop} (hb : ∀ᶠ y in lb, pb y) :
+  ∀ᶠ p in la ×ᶠ lb, pa (p : α × β).1 ∧ pb p.2 :=
+(ha.prod_inl lb).and (hb.prod_inr la)
+
+lemma eventually_eq.prod_map {δ} {la : filter α} {fa ga : α → γ} (ha : fa =ᶠ[la] ga)
+  {lb : filter β} {fb gb : β → δ} (hb : fb =ᶠ[lb] gb) :
+  prod.map fa fb =ᶠ[la ×ᶠ lb] prod.map ga gb :=
+(eventually.prod_mk ha hb).mono $ λ x h, prod.ext h.1 h.2
+
+lemma eventually_le.prod_map {δ} [has_le γ] [has_le δ] {la : filter α} {fa ga : α → γ}
+  (ha : fa ≤ᶠ[la] ga) {lb : filter β} {fb gb : β → δ} (hb : fb ≤ᶠ[lb] gb) :
+  prod.map fa fb ≤ᶠ[la ×ᶠ lb] prod.map ga gb :=
+eventually.prod_mk ha hb
+
+lemma eventually.curry {la : filter α} {lb : filter β} {p : α × β → Prop}
+  (h : ∀ᶠ x in la ×ᶠ lb, p x) :
+  ∀ᶠ x in la, ∀ᶠ y in lb, p (x, y) :=
+begin
+  rcases eventually_prod_iff.1 h with ⟨pa, ha, pb, hb, h⟩,
+  exact ha.mono (λ a ha, hb.mono $ λ b hb, h ha hb)
+end
+
+/-- A fact that is eventually true about all pairs `l ×ᶠ l` is eventually true about
+all diagonal pairs `(i, i)` -/
+lemma eventually.diag_of_prod {f : filter α} {p : α × α → Prop}
+  (h : ∀ᶠ i in f ×ᶠ f, p i) : (∀ᶠ i in f, p (i, i)) :=
+begin
+  obtain ⟨t, ht, s, hs, hst⟩ := eventually_prod_iff.1 h,
+  apply (ht.and hs).mono (λ x hx, hst hx.1 hx.2),
+end
+
+lemma eventually.diag_of_prod_left {f : filter α} {g : filter γ}
+  {p : (α × α) × γ → Prop} :
+  (∀ᶠ x in (f ×ᶠ f ×ᶠ g), p x) →
+  (∀ᶠ (x : α × γ) in (f ×ᶠ g), p ((x.1, x.1), x.2)) :=
+begin
+  intros h,
+  obtain ⟨t, ht, s, hs, hst⟩ := eventually_prod_iff.1 h,
+  refine (ht.diag_of_prod.prod_mk hs).mono (λ x hx, by simp only [hst hx.1 hx.2, prod.mk.eta]),
+end
+
+lemma eventually.diag_of_prod_right {f : filter α} {g : filter γ}
+  {p : α × γ × γ → Prop} :
+  (∀ᶠ x in (f ×ᶠ (g ×ᶠ g)), p x) →
+  (∀ᶠ (x : α × γ) in (f ×ᶠ g), p (x.1, x.2, x.2)) :=
+begin
+  intros h,
+  obtain ⟨t, ht, s, hs, hst⟩ := eventually_prod_iff.1 h,
+  refine (ht.prod_mk hs.diag_of_prod).mono (λ x hx, by simp only [hst hx.1 hx.2, prod.mk.eta]),
+end
+
+lemma tendsto_diag : tendsto (λ i, (i, i)) f (f ×ᶠ f) :=
+tendsto_iff_eventually.mpr (λ _ hpr, hpr.diag_of_prod)
+
+lemma prod_infi_left [nonempty ι] {f : ι → filter α} {g : filter β}:
+  (⨅ i, f i) ×ᶠ g = (⨅ i, (f i) ×ᶠ g) :=
+by { rw [filter.prod, comap_infi, infi_inf], simp only [filter.prod, eq_self_iff_true] }
+
+lemma prod_infi_right [nonempty ι] {f : filter α} {g : ι → filter β} :
+  f ×ᶠ (⨅ i, g i) = (⨅ i, f ×ᶠ (g i)) :=
+by { rw [filter.prod, comap_infi, inf_infi], simp only [filter.prod, eq_self_iff_true] }
+
+@[mono] lemma prod_mono {f₁ f₂ : filter α} {g₁ g₂ : filter β} (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) :
+  f₁ ×ᶠ g₁ ≤ f₂ ×ᶠ g₂ :=
+inf_le_inf (comap_mono hf) (comap_mono hg)
+
+lemma prod_mono_left (g : filter β) {f₁ f₂ : filter α} (hf : f₁ ≤ f₂) :
+  f₁ ×ᶠ g ≤ f₂ ×ᶠ g :=
+filter.prod_mono hf rfl.le
+
+lemma prod_mono_right (f : filter α) {g₁ g₂ : filter β} (hf : g₁ ≤ g₂) :
+  f ×ᶠ g₁ ≤ f ×ᶠ g₂ :=
+filter.prod_mono rfl.le hf
+
+lemma {u v w x} prod_comap_comap_eq {α₁ : Type u} {α₂ : Type v} {β₁ : Type w} {β₂ : Type x}
+  {f₁ : filter α₁} {f₂ : filter α₂} {m₁ : β₁ → α₁} {m₂ : β₂ → α₂} :
+  (comap m₁ f₁) ×ᶠ (comap m₂ f₂) = comap (λ p : β₁×β₂, (m₁ p.1, m₂ p.2)) (f₁ ×ᶠ f₂) :=
+by simp only [filter.prod, comap_comap, eq_self_iff_true, comap_inf]
+
+lemma prod_comm' : f ×ᶠ g = comap (prod.swap) (g ×ᶠ f) :=
+by simp only [filter.prod, comap_comap, (∘), inf_comm, prod.fst_swap,
+  eq_self_iff_true, prod.snd_swap, comap_inf]
+
+lemma prod_comm : f ×ᶠ g = map (λ p : β×α, (p.2, p.1)) (g ×ᶠ f) :=
+by { rw [prod_comm', ← map_swap_eq_comap_swap], refl }
+
+@[simp] lemma map_fst_prod (f : filter α) (g : filter β) [ne_bot g] : map prod.fst (f ×ᶠ g) = f :=
+begin
+  refine le_antisymm tendsto_fst (λ s hs, _),
+  rw [mem_map, mem_prod_iff] at hs,
+  rcases hs with ⟨t₁, h₁, t₂, h₂, hs⟩,
+  rw [← image_subset_iff, fst_image_prod] at hs,
+  exacts [mem_of_superset h₁ hs, nonempty_of_mem h₂]
+end
+
+@[simp] lemma map_snd_prod (f : filter α) (g : filter β) [ne_bot f] : map prod.snd (f ×ᶠ g) = g :=
+by rw [prod_comm, map_map, (∘), map_fst_prod]
+
+@[simp] lemma prod_le_prod {f₁ f₂ : filter α} {g₁ g₂ : filter β} [ne_bot f₁] [ne_bot g₁] :
+  f₁ ×ᶠ g₁ ≤ f₂ ×ᶠ g₂ ↔ f₁ ≤ f₂ ∧ g₁ ≤ g₂ :=
+⟨λ h, ⟨map_fst_prod f₁ g₁ ▸ tendsto_fst.mono_left h, map_snd_prod f₁ g₁ ▸ tendsto_snd.mono_left h⟩,
+  λ h, prod_mono h.1 h.2⟩
+
+@[simp] lemma prod_inj {f₁ f₂ : filter α} {g₁ g₂ : filter β} [ne_bot f₁] [ne_bot g₁] :
+  f₁ ×ᶠ g₁ = f₂ ×ᶠ g₂ ↔ f₁ = f₂ ∧ g₁ = g₂ :=
+begin
+  refine ⟨λ h, _, λ h, h.1 ▸ h.2 ▸ rfl⟩,
+  have hle : f₁ ≤ f₂ ∧ g₁ ≤ g₂ := prod_le_prod.1 h.le,
+  haveI := ne_bot_of_le hle.1, haveI := ne_bot_of_le hle.2,
+  exact ⟨hle.1.antisymm $ (prod_le_prod.1 h.ge).1, hle.2.antisymm $ (prod_le_prod.1 h.ge).2⟩
+end
+
+lemma eventually_swap_iff {p : (α × β) → Prop} : (∀ᶠ (x : α × β) in (f ×ᶠ g), p x) ↔
+  ∀ᶠ (y : β × α) in (g ×ᶠ f), p y.swap :=
+by { rw [prod_comm, eventually_map], simpa, }
+
+lemma prod_assoc (f : filter α) (g : filter β) (h : filter γ) :
+  map (equiv.prod_assoc α β γ) ((f ×ᶠ g) ×ᶠ h) = f ×ᶠ (g ×ᶠ h) :=
+by simp_rw [← comap_equiv_symm, filter.prod, comap_inf, comap_comap, inf_assoc, function.comp,
+  equiv.prod_assoc_symm_apply]
+
+theorem prod_assoc_symm (f : filter α) (g : filter β) (h : filter γ) :
+map (equiv.prod_assoc α β γ).symm (f ×ᶠ (g ×ᶠ h)) = (f ×ᶠ g) ×ᶠ h :=
+by simp_rw [map_equiv_symm, filter.prod, comap_inf, comap_comap, inf_assoc, function.comp,
+  equiv.prod_assoc_apply]
+
+lemma tendsto_prod_assoc {f : filter α} {g : filter β} {h : filter γ} :
+  tendsto (equiv.prod_assoc α β γ) (f ×ᶠ g ×ᶠ h) (f ×ᶠ (g ×ᶠ h)) :=
+(prod_assoc f g h).le
+
+lemma tendsto_prod_assoc_symm {f : filter α} {g : filter β} {h : filter γ} :
+  tendsto (equiv.prod_assoc α β γ).symm (f ×ᶠ (g ×ᶠ h)) (f ×ᶠ g ×ᶠ h) :=
+(prod_assoc_symm f g h).le
+
+/-- A useful lemma when dealing with uniformities. -/
+lemma map_swap4_prod {f : filter α} {g : filter β} {h : filter γ} {k : filter δ} :
+  map (λ p : (α × β) × (γ × δ), ((p.1.1, p.2.1), (p.1.2, p.2.2))) ((f ×ᶠ g) ×ᶠ (h ×ᶠ k)) =
+  (f ×ᶠ h) ×ᶠ (g ×ᶠ k) :=
+by simp_rw [map_swap4_eq_comap, filter.prod, comap_inf, comap_comap, inf_assoc, inf_left_comm]
+
+lemma tendsto_swap4_prod {f : filter α} {g : filter β} {h : filter γ} {k : filter δ} :
+  tendsto (λ p : (α × β) × (γ × δ), ((p.1.1, p.2.1), (p.1.2, p.2.2)))
+    ((f ×ᶠ g) ×ᶠ (h ×ᶠ k)) ((f ×ᶠ h) ×ᶠ (g ×ᶠ k)) :=
+map_swap4_prod.le
+
+lemma {u v w x} prod_map_map_eq {α₁ : Type u} {α₂ : Type v} {β₁ : Type w} {β₂ : Type x}
+  {f₁ : filter α₁} {f₂ : filter α₂} {m₁ : α₁ → β₁} {m₂ : α₂ → β₂} :
+  (map m₁ f₁) ×ᶠ (map m₂ f₂) = map (λ p : α₁×α₂, (m₁ p.1, m₂ p.2)) (f₁ ×ᶠ f₂) :=
+le_antisymm
+  (λ s hs,
+    let ⟨s₁, hs₁, s₂, hs₂, h⟩ := mem_prod_iff.mp hs in
+    filter.sets_of_superset _ (prod_mem_prod (image_mem_map hs₁) (image_mem_map hs₂)) $
+      calc (m₁ '' s₁) ×ˢ (m₂ '' s₂) = (λ p : α₁×α₂, (m₁ p.1, m₂ p.2)) '' s₁ ×ˢ s₂ :
+          set.prod_image_image_eq
+        ... ⊆ _ : by rwa [image_subset_iff])
+  ((tendsto.comp le_rfl tendsto_fst).prod_mk (tendsto.comp le_rfl tendsto_snd))
+
+lemma prod_map_map_eq' {α₁ : Type*} {α₂ : Type*} {β₁ : Type*} {β₂ : Type*}
+  (f : α₁ → α₂) (g : β₁ → β₂) (F : filter α₁) (G : filter β₁) :
+  (map f F) ×ᶠ (map g G) = map (prod.map f g) (F ×ᶠ G) :=
+prod_map_map_eq
+
+lemma le_prod_map_fst_snd {f : filter (α × β)} : f ≤ map prod.fst f ×ᶠ map prod.snd f :=
+le_inf le_comap_map le_comap_map
+
+lemma tendsto.prod_map {δ : Type*} {f : α → γ} {g : β → δ} {a : filter α} {b : filter β}
+  {c : filter γ} {d : filter δ} (hf : tendsto f a c) (hg : tendsto g b d) :
+  tendsto (prod.map f g) (a ×ᶠ b) (c ×ᶠ d) :=
+begin
+  erw [tendsto, ← prod_map_map_eq],
+  exact filter.prod_mono hf hg,
+end
+
+protected lemma map_prod (m : α × β → γ) (f : filter α) (g : filter β) :
+  map m (f ×ᶠ g) = (f.map (λ a b, m (a, b))).seq g :=
+begin
+  simp [filter.ext_iff, mem_prod_iff, mem_map_seq_iff],
+  intro s,
+  split,
+  exact λ ⟨t, ht, s, hs, h⟩, ⟨s, hs, t, ht, λ x hx y hy, @h ⟨x, y⟩ ⟨hx, hy⟩⟩,
+  exact λ ⟨s, hs, t, ht, h⟩, ⟨t, ht, s, hs, λ ⟨x, y⟩ ⟨hx, hy⟩, h x hx y hy⟩
+end
+
+lemma prod_eq {f : filter α} {g : filter β} : f ×ᶠ g = (f.map prod.mk).seq g  :=
+have h : _ := f.map_prod id g, by rwa [map_id] at h
+
+lemma prod_inf_prod {f₁ f₂ : filter α} {g₁ g₂ : filter β} :
+  (f₁ ×ᶠ g₁) ⊓ (f₂ ×ᶠ g₂) = (f₁ ⊓ f₂) ×ᶠ (g₁ ⊓ g₂) :=
+by simp only [filter.prod, comap_inf, inf_comm, inf_assoc, inf_left_comm]
+
+@[simp] lemma prod_bot {f : filter α} : f ×ᶠ (⊥ : filter β) = ⊥ := by simp [filter.prod]
+@[simp] lemma bot_prod {g : filter β} : (⊥ : filter α) ×ᶠ g = ⊥ := by simp [filter.prod]
+
+@[simp] lemma prod_principal_principal {s : set α} {t : set β} :
+  (𝓟 s) ×ᶠ (𝓟 t) = 𝓟 (s ×ˢ t) :=
+by simp only [filter.prod, comap_principal, principal_eq_iff_eq, comap_principal, inf_principal];
+  refl
+
+@[simp] lemma pure_prod {a : α} {f : filter β} : pure a ×ᶠ f = map (prod.mk a) f :=
+by rw [prod_eq, map_pure, pure_seq_eq_map]
+
+lemma map_pure_prod (f : α → β → γ) (a : α) (B : filter β) :
+  filter.map (function.uncurry f) (pure a ×ᶠ B) = filter.map (f a) B :=
+by { rw filter.pure_prod, refl }
+
+@[simp] lemma prod_pure {f : filter α} {b : β} : f ×ᶠ pure b = map (λ a, (a, b)) f :=
+by rw [prod_eq, seq_pure, map_map]
+
+lemma prod_pure_pure {a : α} {b : β} : (pure a) ×ᶠ (pure b) = pure (a, b) :=
+by simp
+
+lemma prod_eq_bot {f : filter α} {g : filter β} : f ×ᶠ g = ⊥ ↔ (f = ⊥ ∨ g = ⊥) :=
+begin
+  split,
+  { intro h,
+    rcases mem_prod_iff.1 (empty_mem_iff_bot.2 h) with ⟨s, hs, t, ht, hst⟩,
+    rw [subset_empty_iff, set.prod_eq_empty_iff] at hst,
+    cases hst with s_eq t_eq,
+    { left, exact empty_mem_iff_bot.1 (s_eq ▸ hs) },
+    { right, exact empty_mem_iff_bot.1 (t_eq ▸ ht) } },
+  { rintro (rfl | rfl),
+    exact bot_prod,
+    exact prod_bot }
+end
+
+lemma prod_ne_bot {f : filter α} {g : filter β} : ne_bot (f ×ᶠ g) ↔ (ne_bot f ∧ ne_bot g) :=
+by simp only [ne_bot_iff, ne, prod_eq_bot, not_or_distrib]
+
+lemma ne_bot.prod {f : filter α} {g : filter β} (hf : ne_bot f) (hg : ne_bot g) :
+  ne_bot (f ×ᶠ g) :=
+prod_ne_bot.2 ⟨hf, hg⟩
+
+instance prod_ne_bot' {f : filter α} {g : filter β} [hf : ne_bot f] [hg : ne_bot g] :
+  ne_bot (f ×ᶠ g) :=
+hf.prod hg
+
+lemma tendsto_prod_iff {f : α × β → γ} {x : filter α} {y : filter β} {z : filter γ} :
+  filter.tendsto f (x ×ᶠ y) z ↔
+  ∀ W ∈ z, ∃ U ∈ x,  ∃ V ∈ y, ∀ x y, x ∈ U → y ∈ V → f (x, y) ∈ W :=
+by simp only [tendsto_def, mem_prod_iff, prod_sub_preimage_iff, exists_prop, iff_self]
+
+lemma tendsto_prod_iff' {f : filter α} {g : filter β} {g' : filter γ}
+  {s : α → β × γ} :
+  tendsto s f (g ×ᶠ g') ↔ tendsto (λ n, (s n).1) f g ∧ tendsto (λ n, (s n).2) f g' :=
+by { unfold filter.prod, simp only [tendsto_inf, tendsto_comap_iff, iff_self] }
+
+end prod
+
+/-! ### Coproducts of filters -/
+
+section coprod
+variables {f : filter α} {g : filter β}
+
+/-- Coproduct of filters. -/
+protected def coprod (f : filter α) (g : filter β) : filter (α × β) :=
+f.comap prod.fst ⊔ g.comap prod.snd
+
+lemma mem_coprod_iff {s : set (α×β)} {f : filter α} {g : filter β} :
+  s ∈ f.coprod g ↔ ((∃ t₁ ∈ f, prod.fst ⁻¹' t₁ ⊆ s) ∧ (∃ t₂ ∈ g, prod.snd ⁻¹' t₂ ⊆ s)) :=
+by simp [filter.coprod]
+
+@[simp] lemma bot_coprod (l : filter β) : (⊥ : filter α).coprod l = comap prod.snd l :=
+by simp [filter.coprod]
+
+@[simp] lemma coprod_bot (l : filter α) : l.coprod (⊥ : filter β) = comap prod.fst l :=
+by simp [filter.coprod]
+
+lemma bot_coprod_bot : (⊥ : filter α).coprod (⊥ : filter β) = ⊥ := by simp
+
+lemma compl_mem_coprod {s : set (α × β)} {la : filter α} {lb : filter β} :
+  sᶜ ∈ la.coprod lb ↔ (prod.fst '' s)ᶜ ∈ la ∧ (prod.snd '' s)ᶜ ∈ lb :=
+by simp only [filter.coprod, mem_sup, compl_mem_comap]
+
+@[mono] lemma coprod_mono {f₁ f₂ : filter α} {g₁ g₂ : filter β} (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) :
+  f₁.coprod g₁ ≤ f₂.coprod g₂ :=
+sup_le_sup (comap_mono hf) (comap_mono hg)
+
+lemma coprod_ne_bot_iff : (f.coprod g).ne_bot ↔ f.ne_bot ∧ nonempty β ∨ nonempty α ∧ g.ne_bot :=
+by simp [filter.coprod]
+
+@[instance] lemma coprod_ne_bot_left [ne_bot f] [nonempty β] : (f.coprod g).ne_bot :=
+coprod_ne_bot_iff.2 (or.inl ⟨‹_›, ‹_›⟩)
+
+@[instance] lemma coprod_ne_bot_right [ne_bot g] [nonempty α] : (f.coprod g).ne_bot :=
+coprod_ne_bot_iff.2 (or.inr ⟨‹_›, ‹_›⟩)
+
+lemma principal_coprod_principal (s : set α) (t : set β) :
+  (𝓟 s).coprod (𝓟 t) = 𝓟 (sᶜ ×ˢ tᶜ)ᶜ :=
+by rw [filter.coprod, comap_principal, comap_principal, sup_principal, set.prod_eq, compl_inter,
+  preimage_compl, preimage_compl, compl_compl, compl_compl]
+
+-- this inequality can be strict; see `map_const_principal_coprod_map_id_principal` and
+-- `map_prod_map_const_id_principal_coprod_principal` below.
+lemma {u v w x} map_prod_map_coprod_le {α₁ : Type u} {α₂ : Type v} {β₁ : Type w} {β₂ : Type x}
+  {f₁ : filter α₁} {f₂ : filter α₂} {m₁ : α₁ → β₁} {m₂ : α₂ → β₂} :
+  map (prod.map m₁ m₂) (f₁.coprod f₂) ≤ (map m₁ f₁).coprod (map m₂ f₂) :=
+begin
+  intros s,
+  simp only [mem_map, mem_coprod_iff],
+  rintro ⟨⟨u₁, hu₁, h₁⟩, u₂, hu₂, h₂⟩,
+  refine ⟨⟨m₁ ⁻¹' u₁, hu₁, λ _ hx, h₁ _⟩, ⟨m₂ ⁻¹' u₂, hu₂, λ _ hx, h₂ _⟩⟩; convert hx
+end
+
+/-- Characterization of the coproduct of the `filter.map`s of two principal filters `𝓟 {a}` and
+`𝓟 {i}`, the first under the constant function `λ a, b` and the second under the identity function.
+Together with the next lemma, `map_prod_map_const_id_principal_coprod_principal`, this provides an
+example showing that the inequality in the lemma `map_prod_map_coprod_le` can be strict. -/
+lemma map_const_principal_coprod_map_id_principal {α β ι : Type*} (a : α) (b : β) (i : ι) :
+  (map (λ _ : α, b) (𝓟 {a})).coprod (map id (𝓟 {i}))
+  = 𝓟 (({b} : set β) ×ˢ univ ∪ univ ×ˢ ({i} : set ι)) :=
+by simp only [map_principal, filter.coprod, comap_principal, sup_principal, image_singleton,
+  image_id, prod_univ, univ_prod]
+
+/-- Characterization of the `filter.map` of the coproduct of two principal filters `𝓟 {a}` and
+`𝓟 {i}`, under the `prod.map` of two functions, respectively the constant function `λ a, b` and the
+identity function.  Together with the previous lemma,
+`map_const_principal_coprod_map_id_principal`, this provides an example showing that the inequality
+in the lemma `map_prod_map_coprod_le` can be strict. -/
+lemma map_prod_map_const_id_principal_coprod_principal {α β ι : Type*} (a : α) (b : β) (i : ι) :
+  map (prod.map (λ _ : α, b) id) ((𝓟 {a}).coprod (𝓟 {i}))
+  = 𝓟 (({b} : set β) ×ˢ (univ : set ι)) :=
+begin
+  rw [principal_coprod_principal, map_principal],
+  congr,
+  ext ⟨b', i'⟩,
+  split,
+  { rintro ⟨⟨a'', i''⟩, h₁, h₂, h₃⟩,
+    simp },
+  { rintro ⟨h₁, h₂⟩,
+    use (a, i'),
+    simpa using h₁.symm }
+end
+
+lemma tendsto.prod_map_coprod {δ : Type*} {f : α → γ} {g : β → δ} {a : filter α} {b : filter β}
+  {c : filter γ} {d : filter δ} (hf : tendsto f a c) (hg : tendsto g b d) :
+  tendsto (prod.map f g) (a.coprod b) (c.coprod d) :=
+map_prod_map_coprod_le.trans (coprod_mono hf hg)
+
+end coprod
+
+end filter
diff --git a/src/order/filter/small_sets.lean b/src/order/filter/small_sets.lean
index e47f8f397b6b1..2abc032ef6e0d 100644
--- a/src/order/filter/small_sets.lean
+++ b/src/order/filter/small_sets.lean
@@ -9,13 +9,16 @@ import order.filter.at_top_bot
 /-!
 # The filter of small sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the filter of small sets w.r.t. a filter `f`, which is the largest filter
 containing all powersets of members of `f`.
 
 `g` converges to `f.small_sets` if for all `s ∈ f`, eventually we have `g x ⊆ s`.
 
 An example usage is that if `f : ι → E → ℝ` is a family of nonnegative functions with integral 1,
-then saying that `λ i, support (f i)` tendsto `(𝓝 0).small_sets` is a way of saying that 
+then saying that `λ i, support (f i)` tendsto `(𝓝 0).small_sets` is a way of saying that
 `f` tends to the Dirac delta distribution.
 -/
 
@@ -48,13 +51,20 @@ lemma tendsto_small_sets_iff {f : α → set β} :
 (has_basis_small_sets lb).tendsto_right_iff
 
 lemma eventually_small_sets {p : set α → Prop} :
-  (∀ᶠ s in l.lift' powerset, p s) ↔ ∃ s ∈ l, ∀ t ⊆ s, p t :=
+  (∀ᶠ s in l.small_sets, p s) ↔ ∃ s ∈ l, ∀ t ⊆ s, p t :=
 eventually_lift'_iff monotone_powerset
 
 lemma eventually_small_sets' {p : set α → Prop} (hp : ∀ ⦃s t⦄, s ⊆ t → p t → p s) :
-  (∀ᶠ s in l.lift' powerset, p s) ↔ ∃ s ∈ l, p s :=
+  (∀ᶠ s in l.small_sets, p s) ↔ ∃ s ∈ l, p s :=
 eventually_small_sets.trans $ exists₂_congr $ λ s hsf,
-  ⟨λ H, H s (subset.refl s), λ hs t ht, hp ht hs⟩
+  ⟨λ H, H s subset.rfl, λ hs t ht, hp ht hs⟩
+
+lemma frequently_small_sets {p : set α → Prop} :
+  (∃ᶠ s in l.small_sets, p s) ↔ ∀ t ∈ l, ∃ s ⊆ t, p s :=
+l.has_basis_small_sets.frequently_iff
+
+lemma frequently_small_sets_mem (l : filter α) : ∃ᶠ s in l.small_sets, s ∈ l :=
+frequently_small_sets.2 $ λ t ht, ⟨t, subset.rfl, ht⟩
 
 lemma has_antitone_basis.tendsto_small_sets {ι} [preorder ι] {s : ι → set α}
   (hl : l.has_antitone_basis s) : tendsto s at_top l.small_sets :=
@@ -78,19 +88,15 @@ comap_lift'_eq2 monotone_powerset
 
 lemma comap_small_sets (l : filter β) (f : α → set β) :
   comap f l.small_sets = l.lift' (preimage f ∘ powerset) :=
-comap_lift'_eq monotone_powerset
+comap_lift'_eq
 
 lemma small_sets_infi {f : ι → filter α} :
   (infi f).small_sets = (⨅ i, (f i).small_sets) :=
-begin
-  casesI is_empty_or_nonempty ι,
-  { rw [infi_of_empty f, infi_of_empty, small_sets_top] },
-  { exact (lift'_infi $ λ _ _, (powerset_inter _ _).symm) },
-end
+lift'_infi_of_map_univ powerset_inter powerset_univ
 
 lemma small_sets_inf (l₁ l₂ : filter α) :
   (l₁ ⊓ l₂).small_sets = l₁.small_sets ⊓ l₂.small_sets :=
-lift'_inf _ _ $ λ _ _, (powerset_inter _ _).symm
+lift'_inf _ _ powerset_inter
 
 instance small_sets_ne_bot (l : filter α) : ne_bot l.small_sets :=
 (lift'_ne_bot_iff monotone_powerset).2 $ λ _ _, powerset_nonempty
@@ -103,6 +109,17 @@ begin
   exact λ u hu, (ht u hu).mp (hst.mono $ λ a hst ht, subset.trans hst ht)
 end
 
+/-- Generalized **squeeze theorem** (also known as **sandwich theorem**). If `s : α → set β` is a
+family of sets that tends to `filter.small_sets lb` along `la` and `f : α → β` is a function such
+that `f x ∈ s x` eventually along `la`, then `f` tends to `lb` along `la`.
+
+If `s x` is the closed interval `[g x, h x]` for some functions `g`, `h` that tend to the same limit
+`𝓝 y`, then we obtain the standard squeeze theorem, see
+`tendsto_of_tendsto_of_tendsto_of_le_of_le'`. -/
+lemma tendsto.of_small_sets {s : α → set β} {f : α → β} (hs : tendsto s la lb.small_sets)
+  (hf : ∀ᶠ x in la, f x ∈ s x) : tendsto f la lb :=
+λ t ht, hf.mp $ (tendsto_small_sets_iff.mp hs t ht).mono $ λ x h₁ h₂, h₁ h₂
+
 @[simp] lemma eventually_small_sets_eventually {p : α → Prop} :
   (∀ᶠ s in l.small_sets, ∀ᶠ x in l', x ∈ s → p x) ↔ ∀ᶠ x in l ⊓ l', p x :=
 calc _ ↔ ∃ s ∈ l, ∀ᶠ x in l', x ∈ s → p x :
@@ -115,6 +132,10 @@ calc _ ↔ ∃ s ∈ l, ∀ᶠ x in l', x ∈ s → p x :
   (∀ᶠ s in l.small_sets, ∀ x ∈ s, p x) ↔ ∀ᶠ x in l, p x :=
 by simpa only [inf_top_eq, eventually_top] using @eventually_small_sets_eventually α l ⊤ p
 
-alias eventually_small_sets_forall ↔ filter.eventually.of_small_sets filter.eventually.small_sets
+alias eventually_small_sets_forall ↔ eventually.of_small_sets eventually.small_sets
+
+@[simp] lemma eventually_small_sets_subset {s : set α} :
+  (∀ᶠ t in l.small_sets, t ⊆ s) ↔ s ∈ l :=
+eventually_small_sets_forall
 
 end filter
diff --git a/src/order/filter/ultrafilter.lean b/src/order/filter/ultrafilter.lean
index f57ad6d34510d..0d528f34e26f7 100644
--- a/src/order/filter/ultrafilter.lean
+++ b/src/order/filter/ultrafilter.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Jeremy Avigad, Yury Kudryashov
 -/
 import order.filter.cofinite
-import order.zorn
+import order.zorn_atoms
 
 /-!
 # Ultrafilters
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 An ultrafilter is a minimal (maximal in the set order) proper filter.
 In this file we define
 
@@ -20,11 +23,18 @@ In this file we define
 -/
 
 universes u v
-variables {α : Type u} {β : Type v}
+variables {α : Type u} {β : Type v} {γ : Type*}
 
 open set filter function
 open_locale classical filter
 
+/-- `filter α` is an atomic type: for every filter there exists an ultrafilter that is less than or
+equal to this filter. -/
+instance : is_atomic (filter α) :=
+is_atomic.of_is_chain_bounded $ λ c hc hne hb,
+  ⟨Inf c, (Inf_ne_bot_of_directed' hne (show is_chain (≥) c, from hc.symm).directed_on hb).ne,
+    λ x hx, Inf_le hx⟩
+
 /-- An ultrafilter is a minimal (maximal in the set order) proper filter. -/
 @[protect_proj]
 structure ultrafilter (α : Type*) extends filter α :=
@@ -45,6 +55,9 @@ le_antisymm h $ f.le_of_le g hne h
 
 instance ne_bot (f : ultrafilter α) : ne_bot (f : filter α) := f.ne_bot'
 
+protected lemma is_atom (f : ultrafilter α) : is_atom (f : filter α) :=
+⟨f.ne_bot.ne, λ g hgf, by_contra $ λ hg, hgf.ne $ f.unique hgf.le ⟨hg⟩⟩
+
 @[simp, norm_cast] lemma mem_coe : s ∈ (f : filter α) ↔ s ∈ f := iff.rfl
 
 lemma coe_injective : injective (coe : ultrafilter α → filter α)
@@ -67,6 +80,12 @@ le_of_inf_eq (f.unique inf_le_left hg)
 lemma le_of_inf_ne_bot' (f : ultrafilter α) {g : filter α} (hg : ne_bot (g ⊓ f)) : ↑f ≤ g :=
 f.le_of_inf_ne_bot $ by rwa inf_comm
 
+lemma inf_ne_bot_iff {f : ultrafilter α} {g : filter α} : ne_bot (↑f ⊓ g) ↔ ↑f ≤ g :=
+⟨le_of_inf_ne_bot f, λ h, (inf_of_le_left h).symm ▸ f.ne_bot⟩
+
+lemma disjoint_iff_not_le {f : ultrafilter α} {g : filter α} : disjoint ↑f g ↔ ¬↑f ≤ g :=
+by rw [← inf_ne_bot_iff, ne_bot_iff, ne.def, not_not, disjoint_iff]
+
 @[simp] lemma compl_not_mem_iff : sᶜ ∉ f ↔ s ∈ f :=
 ⟨λ hsc, le_principal_iff.1 $ f.le_of_inf_ne_bot
   ⟨λ h, hsc $ mem_of_eq_bot$ by rwa compl_compl⟩, compl_not_mem⟩
@@ -74,7 +93,7 @@ f.le_of_inf_ne_bot $ by rwa inf_comm
 @[simp] lemma frequently_iff_eventually : (∃ᶠ x in f, p x) ↔ ∀ᶠ x in f, p x :=
 compl_not_mem_iff
 
-alias frequently_iff_eventually ↔ filter.frequently.eventually _
+alias frequently_iff_eventually ↔ _root_.filter.frequently.eventually _
 
 lemma compl_mem_iff_not_mem : sᶜ ∈ f ↔ s ∉ f := by rw [← compl_not_mem_iff, compl_compl]
 
@@ -88,10 +107,22 @@ def of_compl_not_mem_iff (f : filter α) (h : ∀ s, sᶜ ∉ f ↔ s ∈ f) : u
   ne_bot' := ⟨λ hf, by simpa [hf] using h⟩,
   le_of_le := λ g hg hgf s hs, (h s).1 $ λ hsc, by exactI compl_not_mem hs (hgf hsc) }
 
+/-- If `f : filter α` is an atom, then it is an ultrafilter. -/
+def of_atom (f : filter α) (hf : is_atom f) : ultrafilter α :=
+{ to_filter := f,
+  ne_bot' := ⟨hf.1⟩,
+  le_of_le := λ g hg, (_root_.is_atom_iff.1 hf).2 g hg.ne }
+
 lemma nonempty_of_mem (hs : s ∈ f) : s.nonempty := nonempty_of_mem hs
 lemma ne_empty_of_mem (hs : s ∈ f) : s ≠ ∅ := (nonempty_of_mem hs).ne_empty
 @[simp] lemma empty_not_mem : ∅ ∉ f := empty_not_mem f
 
+@[simp] lemma le_sup_iff {u : ultrafilter α} {f g : filter α} : ↑u ≤ f ⊔ g ↔ ↑u ≤ f ∨ ↑u ≤ g :=
+not_iff_not.1 $ by simp only [← disjoint_iff_not_le, not_or_distrib, disjoint_sup_right]
+
+@[simp] lemma union_mem_iff : s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f :=
+by simp only [← mem_coe, ← le_principal_iff, ← sup_principal, le_sup_iff]
+
 lemma mem_or_compl_mem (f : ultrafilter α) (s : set α) : s ∈ f ∨ sᶜ ∈ f :=
 or_iff_not_imp_left.2 compl_mem_iff_not_mem.2
 
@@ -100,21 +131,18 @@ protected lemma em (f : ultrafilter α) (p : α → Prop) :
 f.mem_or_compl_mem {x | p x}
 
 lemma eventually_or : (∀ᶠ x in f, p x ∨ q x) ↔ (∀ᶠ x in f, p x) ∨ ∀ᶠ x in f, q x :=
-⟨λ H, (f.em p).imp_right $ λ hp, (H.and hp).mono $ λ x ⟨hx, hnx⟩, hx.resolve_left hnx,
-  λ H, H.elim (λ hp, hp.mono $ λ x, or.inl) (λ hp, hp.mono $ λ x, or.inr)⟩
-
-lemma union_mem_iff : s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f := eventually_or
+union_mem_iff
 
 lemma eventually_not : (∀ᶠ x in f, ¬p x) ↔ ¬∀ᶠ x in f, p x := compl_mem_iff_not_mem
 
 lemma eventually_imp : (∀ᶠ x in f, p x → q x) ↔ (∀ᶠ x in f, p x) → ∀ᶠ x in f, q x :=
 by simp only [imp_iff_not_or, eventually_or, eventually_not]
 
-lemma finite_sUnion_mem_iff {s : set (set α)} (hs : finite s) : ⋃₀ s ∈ f ↔ ∃t∈s, t ∈ f :=
+lemma finite_sUnion_mem_iff {s : set (set α)} (hs : s.finite) : ⋃₀ s ∈ f ↔ ∃t∈s, t ∈ f :=
 finite.induction_on hs (by simp) $ λ a s ha hs his,
   by simp [union_mem_iff, his, or_and_distrib_right, exists_or_distrib]
 
-lemma finite_bUnion_mem_iff {is : set β} {s : β → set α} (his : finite is) :
+lemma finite_bUnion_mem_iff {is : set β} {s : β → set α} (his : is.finite) :
   (⋃i∈is, s i) ∈ f ↔ ∃i∈is, s i ∈ f :=
 by simp only [← sUnion_image, finite_sUnion_mem_iff (his.image s), bex_image_iff]
 
@@ -128,6 +156,13 @@ of_compl_not_mem_iff (map m f) $ λ s, @compl_not_mem_iff _ f (m ⁻¹' s)
 @[simp] lemma mem_map {m : α → β} {f : ultrafilter α} {s : set β} :
   s ∈ map m f ↔ m ⁻¹' s ∈ f := iff.rfl
 
+@[simp] lemma map_id (f : ultrafilter α) : f.map id = f := coe_injective map_id
+@[simp] lemma map_id' (f : ultrafilter α) : f.map (λ x, x) = f := map_id _
+
+@[simp] lemma map_map (f : ultrafilter α) (m : α → β) (n : β → γ) :
+  (f.map m).map n = f.map (n ∘ m) :=
+coe_injective map_map
+
 /-- The pullback of an ultrafilter along an injection whose range is large with respect to the given
 ultrafilter. -/
 def comap {m : α → β} (u : ultrafilter β) (inj : injective m)
@@ -142,30 +177,55 @@ def comap {m : α → β} (u : ultrafilter β) (inj : injective m)
   s ∈ u.comap inj large ↔ m '' s ∈ u :=
 mem_comap_iff inj large
 
-@[simp] lemma coe_comap {m : α → β} (u : ultrafilter β) (inj : injective m)
+@[simp, norm_cast] lemma coe_comap {m : α → β} (u : ultrafilter β) (inj : injective m)
   (large : set.range m ∈ u) : (u.comap inj large : filter α) = filter.comap m u := rfl
 
+@[simp] lemma comap_id (f : ultrafilter α) (h₀ : injective (id : α → α) := injective_id)
+  (h₁ : range id ∈ f := by { rw range_id, exact univ_mem}) :
+  f.comap h₀ h₁ = f :=
+coe_injective comap_id
+
+@[simp] lemma comap_comap (f : ultrafilter γ) {m : α → β} {n : β → γ} (inj₀ : injective n)
+  (large₀ : range n ∈ f) (inj₁ : injective m) (large₁ : range m ∈ f.comap inj₀ large₀)
+  (inj₂ : injective (n ∘ m) := inj₀.comp inj₁)
+  (large₂ : range (n ∘ m) ∈ f := by { rw range_comp, exact image_mem_of_mem_comap large₀ large₁ }) :
+  (f.comap inj₀ large₀).comap inj₁ large₁ = f.comap inj₂ large₂ :=
+coe_injective comap_comap
+
 /-- The principal ultrafilter associated to a point `x`. -/
 instance : has_pure ultrafilter :=
 ⟨λ α a, of_compl_not_mem_iff (pure a) $ λ s, by simp⟩
 
 @[simp] lemma mem_pure {a : α} {s : set α} : s ∈ (pure a : ultrafilter α) ↔ a ∈ s := iff.rfl
+@[simp] lemma coe_pure (a : α) : ↑(pure a : ultrafilter α) = (pure a : filter α) := rfl
+@[simp] lemma map_pure (m : α → β) (a : α) : map m (pure a) = pure (m a) := rfl
+@[simp] lemma comap_pure {m : α → β} (a : α) (inj : injective m) (large) :
+  comap (pure $ m a) inj large = pure a :=
+coe_injective $ comap_pure.trans $
+  by rw [coe_pure, ←principal_singleton, ←image_singleton, preimage_image_eq _ inj]
+
+lemma pure_injective : injective (pure : α → ultrafilter α) :=
+λ a b h, filter.pure_injective (congr_arg ultrafilter.to_filter h : _)
 
 instance [inhabited α] : inhabited (ultrafilter α) := ⟨pure default⟩
 instance [nonempty α] : nonempty (ultrafilter α) := nonempty.map pure infer_instance
 
-lemma eq_principal_of_finite_mem {f : ultrafilter α} {s : set α} (h : s.finite) (h' : s ∈ f) :
-  ∃ x ∈ s, (f : filter α) = pure x :=
+lemma eq_pure_of_finite_mem (h : s.finite) (h' : s ∈ f) : ∃ x ∈ s, f = pure x :=
 begin
   rw ← bUnion_of_singleton s at h',
   rcases (ultrafilter.finite_bUnion_mem_iff h).mp h' with ⟨a, has, haf⟩,
-  use [a, has],
-  change (f : filter α) = (pure a : ultrafilter α),
-  rw [ultrafilter.coe_inj, ← ultrafilter.coe_le_coe],
-  change (f : filter α) ≤ pure a,
-  rwa [← principal_singleton, le_principal_iff]
+  exact ⟨a, has, eq_of_le (filter.le_pure_iff.2 haf)⟩
 end
 
+lemma eq_pure_of_finite [finite α] (f : ultrafilter α) : ∃ a, f = pure a :=
+(eq_pure_of_finite_mem finite_univ univ_mem).imp $ λ a ⟨_, ha⟩, ha
+
+lemma le_cofinite_or_eq_pure (f : ultrafilter α) : (f : filter α) ≤ cofinite ∨ ∃ a, f = pure a :=
+or_iff_not_imp_left.2 $ λ h,
+  let ⟨s, hs, hfin⟩ := filter.disjoint_cofinite_right.1 (disjoint_iff_not_le.2 h),
+      ⟨a, has, hf⟩ := eq_pure_of_finite_mem hfin hs
+  in ⟨a, hf⟩
+
 /-- Monadic bind for ultrafilters, coming from the one on filters
 defined in terms of map and join.-/
 def bind (f : ultrafilter α) (m : α → ultrafilter β) : ultrafilter β :=
@@ -189,29 +249,10 @@ instance is_lawful_monad : is_lawful_monad ultrafilter :=
 end
 
 /-- The ultrafilter lemma: Any proper filter is contained in an ultrafilter. -/
-lemma exists_le (f : filter α) [h : ne_bot f] : ∃u : ultrafilter α, ↑u ≤ f :=
-begin
-  let τ                := {f' // ne_bot f' ∧ f' ≤ f},
-  let r : τ → τ → Prop := λt₁ t₂, t₂.val ≤ t₁.val,
-  haveI                := nonempty_of_ne_bot f,
-  let top : τ          := ⟨f, h, le_refl f⟩,
-  let sup : Π(c:set τ), is_chain r c → τ :=
-    λc hc, ⟨⨅a:{a:τ // a ∈ insert top c}, a.1,
-      infi_ne_bot_of_directed
-        (is_chain.directed $ hc.insert $ λ ⟨b, _, hb⟩ _ _, or.inl hb)
-        (assume ⟨⟨a, ha, _⟩, _⟩, ha),
-      infi_le_of_le ⟨top, mem_insert _ _⟩ le_rfl⟩,
-  have : ∀ c (hc : is_chain r c) a (ha : a ∈ c), r a (sup c hc),
-    from assume c hc a ha, infi_le_of_le ⟨a, mem_insert_of_mem _ ha⟩ le_rfl,
-  have : (∃ (u : τ), ∀ (a : τ), r u a → r a u),
-    from exists_maximal_of_chains_bounded (assume c hc, ⟨sup c hc, this c hc⟩)
-      (assume f₁ f₂ f₃ h₁ h₂, le_trans h₂ h₁),
-  cases this with uτ hmin,
-  exact ⟨⟨uτ.val, uτ.property.left, assume g hg₁ hg₂,
-    hmin ⟨g, hg₁, le_trans hg₂ uτ.property.right⟩ hg₂⟩, uτ.property.right⟩
-end
+lemma exists_le (f : filter α) [h : ne_bot f] : ∃ u : ultrafilter α, ↑u ≤ f :=
+let ⟨u, hu, huf⟩ := (eq_bot_or_exists_atom_le f).resolve_left h.ne in ⟨of_atom u hu, huf⟩
 
-alias exists_le ← filter.exists_ultrafilter_le
+alias exists_le ← _root_.filter.exists_ultrafilter_le
 
 /-- Construct an ultrafilter extending a given filter.
   The ultrafilter lemma is the assertion that such a filter exists;
@@ -228,30 +269,30 @@ lemma exists_ultrafilter_of_finite_inter_nonempty (S : set (set α))
   (cond : ∀ T : finset (set α), (↑T : set (set α)) ⊆ S → (⋂₀ (↑T : set (set α))).nonempty) :
   ∃ F : ultrafilter α, S ⊆ F.sets :=
 begin
-  suffices : ∃ F : filter α, ne_bot F ∧ S ⊆ F.sets,
-  { rcases this with ⟨F, cond, hF⟩,
-    resetI,
-    obtain ⟨G : ultrafilter α, h1 : ↑G ≤ F⟩ := exists_le F,
-    exact ⟨G, λ T hT, h1 (hF hT)⟩ },
-  use filter.generate S,
-  refine ⟨_, λ T hT, filter.generate_sets.basic hT⟩,
-  rw ← forall_mem_nonempty_iff_ne_bot,
-  intros T hT,
-  rcases mem_generate_iff.mp hT with ⟨A, h1, h2, h3⟩,
-  let B := set.finite.to_finset h2,
-  rw (show A = ↑B, by simp) at *,
-  rcases cond B h1 with ⟨x, hx⟩,
-  exact ⟨x, h3 hx⟩,
+  haveI : ne_bot (generate S) := generate_ne_bot_iff.2
+    (λ t hts ht, ht.coe_to_finset ▸ cond ht.to_finset (ht.coe_to_finset.symm ▸ hts)),
+  exact ⟨of (generate S), λ t ht, (of_le $ generate S) $ generate_sets.basic ht⟩
 end
 
 end ultrafilter
 
 namespace filter
+variables {f : filter α} {s : set α} {a : α}
 
 open ultrafilter
 
-lemma mem_iff_ultrafilter {s : set α} {f : filter α} :
-  s ∈ f ↔ ∀ g : ultrafilter α, ↑g ≤ f → s ∈ g :=
+lemma is_atom_pure : is_atom (pure a : filter α) := (pure a : ultrafilter α).is_atom
+
+protected lemma ne_bot.le_pure_iff (hf : f.ne_bot) : f ≤ pure a ↔ f = pure a :=
+⟨ultrafilter.unique (pure a), le_of_eq⟩
+
+@[simp] lemma lt_pure_iff : f < pure a ↔ f = ⊥ := is_atom_pure.lt_iff
+
+lemma le_pure_iff' : f ≤ pure a ↔ f = ⊥ ∨ f = pure a := is_atom_pure.le_iff
+
+@[simp] lemma Iic_pure (a : α) : Iic (pure a : filter α) = {⊥, pure a} := is_atom_pure.Iic_eq
+
+lemma mem_iff_ultrafilter : s ∈ f ↔ ∀ g : ultrafilter α, ↑g ≤ f → s ∈ g :=
 begin
   refine ⟨λ hf g hg, hg hf, λ H, by_contra $ λ hf, _⟩,
   set g : filter ↥sᶜ := comap coe f,
@@ -301,13 +342,13 @@ ultrafilter.of_le cofinite
 theorem nmem_hyperfilter_of_finite {s : set α} (hf : s.finite) : s ∉ hyperfilter α :=
 λ hy, compl_not_mem hy $ hyperfilter_le_cofinite hf.compl_mem_cofinite
 
-alias nmem_hyperfilter_of_finite ← set.finite.nmem_hyperfilter
+alias nmem_hyperfilter_of_finite ← _root_.set.finite.nmem_hyperfilter
 
 theorem compl_mem_hyperfilter_of_finite {s : set α} (hf : set.finite s) :
   sᶜ ∈ hyperfilter α :=
 compl_mem_iff_not_mem.2 hf.nmem_hyperfilter
 
-alias compl_mem_hyperfilter_of_finite ← set.finite.compl_mem_hyperfilter
+alias compl_mem_hyperfilter_of_finite ← _root_.set.finite.compl_mem_hyperfilter
 
 theorem mem_hyperfilter_of_finite_compl {s : set α} (hf : set.finite sᶜ) :
   s ∈ hyperfilter α :=
diff --git a/src/order/filter/zero_and_bounded_at_filter.lean b/src/order/filter/zero_and_bounded_at_filter.lean
new file mode 100644
index 0000000000000..5cc4433ee6424
--- /dev/null
+++ b/src/order/filter/zero_and_bounded_at_filter.lean
@@ -0,0 +1,129 @@
+/-
+Copyright (c) 2022 Chris Birkbeck. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Birkbeck, David Loeffler
+-/
+import algebra.module.submodule.basic
+import topology.algebra.monoid
+import analysis.asymptotics.asymptotics
+
+/-!
+# Zero and Bounded at filter
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a filter `l` we define the notion of a function being `zero_at_filter` as well as being
+`bounded_at_filter`. Alongside this we construct the `submodule`, `add_submonoid` of functions
+that are `zero_at_filter`. Similarly, we construct the `submodule` and `subalgebra` of functions
+that are `bounded_at_filter`.
+
+-/
+
+namespace filter
+
+variables {α β : Type*}
+
+open_locale topology
+
+/-- If `l` is a filter on `α`, then a function `f : α → β` is `zero_at_filter l`
+  if it tends to zero along `l`. -/
+def zero_at_filter [has_zero β] [topological_space β] (l : filter α) (f : α → β) : Prop :=
+filter.tendsto f l (𝓝 0)
+
+lemma zero_zero_at_filter [has_zero β] [topological_space β] (l : filter α) :
+  zero_at_filter l (0 : α → β) :=
+tendsto_const_nhds
+
+lemma zero_at_filter.add [topological_space β] [add_zero_class β] [has_continuous_add β]
+  {l : filter α} {f g : α → β} (hf : zero_at_filter l f) (hg : zero_at_filter l g) :
+  zero_at_filter l (f + g) :=
+by simpa using hf.add hg
+
+lemma zero_at_filter.neg [topological_space β] [add_group β] [has_continuous_neg β] {l : filter α}
+  {f : α → β} (hf : zero_at_filter l f) :
+  zero_at_filter l (-f) :=
+by simpa using hf.neg
+
+lemma zero_at_filter.smul {𝕜 : Type*} [topological_space 𝕜] [topological_space β] [has_zero 𝕜]
+  [has_zero β] [smul_with_zero 𝕜 β] [has_continuous_smul 𝕜 β]
+   {l : filter α} {f : α → β} (c : 𝕜) (hf : zero_at_filter l f) :
+  zero_at_filter l (c • f) :=
+by simpa using hf.const_smul c
+
+/-- `zero_at_filter_submodule l` is the submodule of `f : α → β` which
+tend to zero along `l`. -/
+def zero_at_filter_submodule [topological_space β] [semiring β]
+  [has_continuous_add β] [has_continuous_mul β] (l : filter α) : submodule β (α → β) :=
+{ carrier := zero_at_filter l,
+  zero_mem' := zero_zero_at_filter l,
+  add_mem' := λ a b ha hb, ha.add hb,
+  smul_mem' := λ c f hf, hf.smul c }
+
+/-- `zero_at_filter_add_submonoid l` is the additive submonoid of `f : α → β`
+which tend to zero along `l`. -/
+def zero_at_filter_add_submonoid [topological_space β]
+  [add_zero_class β] [has_continuous_add β] (l : filter α) : add_submonoid (α → β) :=
+{ carrier := zero_at_filter l,
+  add_mem' := λ a b ha hb, ha.add hb,
+  zero_mem' := zero_zero_at_filter l, }
+
+/-- If `l` is a filter on `α`, then a function `f: α → β` is `bounded_at_filter l`
+if `f =O[l] 1`. -/
+def bounded_at_filter [has_norm β] (l : filter α) (f : α → β) : Prop :=
+asymptotics.is_O l f (1 : α → ℝ)
+
+lemma zero_at_filter.bounded_at_filter [normed_add_comm_group β] {l : filter α} {f : α → β}
+  (hf : zero_at_filter l f) : bounded_at_filter l f :=
+begin
+  rw [zero_at_filter, ← asymptotics.is_o_const_iff (one_ne_zero' ℝ)] at hf,
+  exact hf.is_O,
+end
+
+lemma const_bounded_at_filter [normed_field β] (l : filter α) (c : β) :
+  bounded_at_filter l (function.const α c : α → β) :=
+asymptotics.is_O_const_const c one_ne_zero l
+
+lemma bounded_at_filter.add [normed_add_comm_group β] {l : filter α} {f g : α → β}
+  (hf : bounded_at_filter l f) (hg : bounded_at_filter l g) :
+  bounded_at_filter l (f + g) :=
+by simpa using hf.add hg
+
+lemma bounded_at_filter.neg [normed_add_comm_group β] {l : filter α} {f : α → β}
+  (hf : bounded_at_filter l f) :
+  bounded_at_filter l (-f) :=
+hf.neg_left
+
+lemma bounded_at_filter.smul {𝕜 : Type*} [normed_field 𝕜] [normed_add_comm_group β]
+  [normed_space 𝕜 β] {l : filter α} {f : α → β} (c : 𝕜) (hf : bounded_at_filter l f) :
+  bounded_at_filter l (c • f) :=
+hf.const_smul_left c
+
+lemma bounded_at_filter.mul [normed_field β] {l : filter α} {f g : α → β}
+  (hf : bounded_at_filter l f) (hg : bounded_at_filter l g) :
+  bounded_at_filter l (f * g) :=
+begin
+  refine (hf.mul hg).trans _,
+  convert asymptotics.is_O_refl _ l,
+  ext x,
+  simp,
+end
+
+/-- The submodule of functions that are bounded along a filter `l`. -/
+def bounded_filter_submodule [normed_field β] (l : filter α) : submodule β (α → β) :=
+{ carrier := bounded_at_filter l,
+  zero_mem' := const_bounded_at_filter l 0,
+  add_mem' := λ f g hf hg, hf.add hg,
+  smul_mem' := λ c f hf, hf.smul c }
+
+/-- The subalgebra of functions that are bounded along a filter `l`. -/
+def bounded_filter_subalgebra [normed_field β] (l : filter α) :
+  subalgebra β (α → β) :=
+begin
+  refine submodule.to_subalgebra (bounded_filter_submodule l) _ (λ f g hf hg, _),
+  { exact const_bounded_at_filter l (1:β) },
+  { simpa only [pi.one_apply, mul_one, norm_mul] using hf.mul hg, },
+
+end
+
+end filter
diff --git a/src/order/fixed_points.lean b/src/order/fixed_points.lean
index 5ce5fa03dd506..99ae88801f222 100644
--- a/src/order/fixed_points.lean
+++ b/src/order/fixed_points.lean
@@ -9,6 +9,9 @@ import order.hom.order
 /-!
 # Fixed point construction on complete lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file sets up the basic theory of fixed points of a monotone function in a complete lattice.
 
 ## Main definitions
diff --git a/src/order/galois_connection.lean b/src/order/galois_connection.lean
index 94180f9623d94..31d946268a364 100644
--- a/src/order/galois_connection.lean
+++ b/src/order/galois_connection.lean
@@ -4,10 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 import order.complete_lattice
-import order.order_dual
+import order.synonym
+import order.hom.set
+
 /-!
 # Galois connections, insertions and coinsertions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Galois connections are order theoretic adjoints, i.e. a pair of functions `u` and `l`,
 such that `∀ a b, l a ≤ b ↔ a ≤ u b`.
 
@@ -199,20 +204,24 @@ end
 end partial_order
 
 section order_top
-variables [partial_order α] [preorder β] [order_top α] [order_top β] {l : α → β} {u : β → α}
-  (gc : galois_connection l u)
-include gc
+variables [partial_order α] [preorder β] [order_top α]
 
-lemma u_top : u ⊤ = ⊤ := top_unique $ gc.le_u le_top
+lemma u_eq_top {l : α → β} {u : β → α} (gc : galois_connection l u) {x} : u x = ⊤ ↔ l ⊤ ≤ x :=
+top_le_iff.symm.trans gc.le_iff_le.symm
+
+lemma u_top [order_top β] {l : α → β} {u : β → α} (gc : galois_connection l u) : u ⊤ = ⊤ :=
+gc.u_eq_top.2 le_top
 
 end order_top
 
 section order_bot
-variables [preorder α] [partial_order β] [order_bot α] [order_bot β] {l : α → β} {u : β → α}
-  (gc : galois_connection l u)
-include gc
+variables [preorder α] [partial_order β] [order_bot β]
 
-lemma l_bot : l ⊥ = ⊥ := gc.dual.u_top
+lemma l_eq_bot {l : α → β} {u : β → α} (gc : galois_connection l u) {x} : l x = ⊥ ↔ x ≤ u ⊥ :=
+gc.dual.u_eq_top
+
+lemma l_bot [order_bot α] {l : α → β} {u : β → α} (gc : galois_connection l u) : l ⊥ = ⊥ :=
+gc.dual.u_top
 
 end order_bot
 
@@ -314,6 +323,52 @@ lemma l_comm_iff_u_comm
 
 end galois_connection
 
+section
+variables [complete_lattice α] [complete_lattice β] [complete_lattice γ] {f : α → β → γ} {s : set α}
+  {t : set β} {l u : α → β → γ} {l₁ u₁ : β → γ → α} {l₂ u₂ : α → γ → β}
+
+lemma Sup_image2_eq_Sup_Sup (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
+  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
+  Sup (image2 l s t) = l (Sup s) (Sup t) :=
+by simp_rw [Sup_image2, ←(h₂ _).l_Sup, ←(h₁ _).l_Sup]
+
+lemma Sup_image2_eq_Sup_Inf (h₁ : ∀ b, galois_connection (swap l b) (u₁ b))
+  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
+  Sup (image2 l s t) = l (Sup s) (Inf t) :=
+@Sup_image2_eq_Sup_Sup _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma Sup_image2_eq_Inf_Sup (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
+  (h₂ : ∀ a, galois_connection (l a) (u₂ a)) :
+  Sup (image2 l s t) = l (Inf s) (Sup t) :=
+@Sup_image2_eq_Sup_Sup αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma Sup_image2_eq_Inf_Inf (h₁ : ∀ b, galois_connection (swap l b ∘ of_dual) (to_dual ∘ u₁ b))
+  (h₂ : ∀ a, galois_connection (l a ∘ of_dual) (to_dual ∘ u₂ a)) :
+  Sup (image2 l s t) = l (Inf s) (Inf t) :=
+@Sup_image2_eq_Sup_Sup αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma Inf_image2_eq_Inf_Inf (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
+  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
+  Inf (image2 u s t) = u (Inf s) (Inf t) :=
+by simp_rw [Inf_image2, ←(h₂ _).u_Inf, ←(h₁ _).u_Inf]
+
+lemma Inf_image2_eq_Inf_Sup (h₁ : ∀ b, galois_connection (l₁ b) (swap u b))
+  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
+  Inf (image2 u s t) = u (Inf s) (Sup t) :=
+@Inf_image2_eq_Inf_Inf _ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma Inf_image2_eq_Sup_Inf (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
+  (h₂ : ∀ a, galois_connection (l₂ a) (u a)) :
+  Inf (image2 u s t) = u (Sup s) (Inf t) :=
+@Inf_image2_eq_Inf_Inf αᵒᵈ _ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+lemma Inf_image2_eq_Sup_Sup (h₁ : ∀ b, galois_connection (to_dual ∘ l₁ b) (swap u b ∘ of_dual))
+  (h₂ : ∀ a, galois_connection (to_dual ∘ l₂ a) (u a ∘ of_dual)) :
+  Inf (image2 u s t) = u (Sup s) (Sup t) :=
+@Inf_image2_eq_Inf_Inf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ h₁ h₂
+
+end
+
 namespace order_iso
 
 variables [preorder α] [preorder β]
@@ -335,14 +390,14 @@ end order_iso
 namespace nat
 
 lemma galois_connection_mul_div {k : ℕ} (h : 0 < k) : galois_connection (λ n, n * k) (λ n, n / k) :=
-λ x y, (le_div_iff_mul_le x y h).symm
+λ x y, (le_div_iff_mul_le h).symm
 
 end nat
 
 /-- A Galois insertion is a Galois connection where `l ∘ u = id`. It also contains a constructive
 choice function, to give better definitional equalities when lifting order structures. Dual
 to `galois_coinsertion` -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure galois_insertion {α β : Type*} [preorder α] [preorder β] (l : α → β) (u : β → α) :=
 (choice : Πx : α, u (l x) ≤ x → β)
 (gc : galois_connection l u)
@@ -521,8 +576,8 @@ def lift_complete_lattice [complete_lattice α] (gi : galois_insertion l u) : co
 { Sup := λ s, l (Sup (u '' s)),
   Sup_le := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).2,
   le_Sup := λ s, (gi.is_lub_of_u_image (is_lub_Sup _)).1,
-  Inf := λ s, gi.choice (Inf (u '' s)) $ gi.gc.monotone_u.le_is_glb_image
-    (gi.is_glb_of_u_image $ is_glb_Inf _) (is_glb_Inf _),
+  Inf := λ s, gi.choice (Inf (u '' s)) $ (is_glb_Inf _).2 $ gi.gc.monotone_u.mem_lower_bounds_image
+    (gi.is_glb_of_u_image $ is_glb_Inf _).1,
   Inf_le := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).1 },
   le_Inf := λ s, by { rw gi.choice_eq, exact (gi.is_glb_of_u_image (is_glb_Inf _)).2 },
   .. gi.lift_bounded_order,
@@ -535,7 +590,7 @@ end galois_insertion
 /-- A Galois coinsertion is a Galois connection where `u ∘ l = id`. It also contains a constructive
 choice function, to give better definitional equalities when lifting order structures. Dual to
 `galois_insertion` -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure galois_coinsertion [preorder α] [preorder β] (l : α → β) (u : β → α) :=
 (choice : Πx : β, x ≤ l (u x) → α)
 (gc : galois_connection l u)
@@ -673,7 +728,6 @@ lemma is_lub_of_l_image [preorder α] [preorder β] (gi : galois_coinsertion l u
   (hs : is_lub (l '' s) a) : is_lub s (u a) :=
 gi.dual.is_glb_of_u_image hs
 
-
 section lift
 
 variables [partial_order α]
@@ -720,11 +774,11 @@ end lift
 
 end galois_coinsertion
 
-/-- If `α` is a partial order with bottom element (e.g., `ℕ`, `ℝ≥0`), then
-`λ o : with_bot α, o.get_or_else ⊥` and coercion form a Galois insertion. -/
-def with_bot.gi_get_or_else_bot [preorder α] [order_bot α] :
-  galois_insertion (λ o : with_bot α, o.get_or_else ⊥) coe :=
-{ gc := λ a b, with_bot.get_or_else_bot_le_iff,
+/-- If `α` is a partial order with bottom element (e.g., `ℕ`, `ℝ≥0`), then `with_bot.unbot' ⊥` and
+coercion form a Galois insertion. -/
+def with_bot.gi_unbot'_bot [preorder α] [order_bot α] :
+  galois_insertion (with_bot.unbot' ⊥) (coe : α → with_bot α) :=
+{ gc := λ a b, with_bot.unbot'_bot_le_iff,
   le_l_u := λ a, le_rfl,
-  choice := λ o ho, _,
+  choice := λ o ho, o.unbot' ⊥,
   choice_eq := λ _ _, rfl }
diff --git a/src/order/game_add.lean b/src/order/game_add.lean
new file mode 100644
index 0000000000000..443a2df46ee45
--- /dev/null
+++ b/src/order/game_add.lean
@@ -0,0 +1,216 @@
+/-
+Copyright (c) 2022 Junyan Xu. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Junyan Xu
+-/
+import data.sym.sym2
+import logic.relation
+
+/-!
+# Game addition relation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines, given relations `rα : α → α → Prop` and `rβ : β → β → Prop`, a relation
+`prod.game_add` on pairs, such that `game_add rα rβ x y` iff `x` can be reached from `y` by
+decreasing either entry (with respect to `rα` and `rβ`). It is so called since it models the
+subsequency relation on the addition of combinatorial games.
+
+We also define `sym2.game_add`, which is the unordered pair analog of `prod.game_add`.
+
+## Main definitions and results
+
+- `prod.game_add`: the game addition relation on ordered pairs.
+- `well_founded.prod_game_add`: formalizes induction on ordered pairs, where exactly one entry
+  decreases at a time.
+
+- `sym2.game_add`: the game addition relation on unordered pairs.
+- `well_founded.sym2_game_add`: formalizes induction on unordered pairs, where exactly one entry
+  decreases at a time.
+-/
+
+variables {α β : Type*} {rα : α → α → Prop} {rβ : β → β → Prop}
+
+/-! ### `prod.game_add` -/
+
+namespace prod
+
+variables (rα rβ)
+
+/-- `prod.game_add rα rβ x y` means that `x` can be reached from `y` by decreasing either entry with
+  respect to the relations `rα` and `rβ`.
+
+  It is so called, as it models game addition within combinatorial game theory. If `rα a₁ a₂` means
+  that `a₂ ⟶ a₁` is a valid move in game `α`, and `rβ b₁ b₂` means that `b₂ ⟶ b₁` is a valid move
+  in game `β`, then `game_add rα rβ` specifies the valid moves in the juxtaposition of `α` and `β`:
+  the player is free to choose one of the games and make a move in it, while leaving the other game
+  unchanged.
+
+  See `sym2.game_add` for the unordered pair analog. -/
+inductive game_add : α × β → α × β → Prop
+| fst {a₁ a₂ b} : rα a₁ a₂ → game_add (a₁, b) (a₂, b)
+| snd {a b₁ b₂} : rβ b₁ b₂ → game_add (a, b₁) (a, b₂)
+
+lemma game_add_iff {rα rβ} {x y : α × β} :
+  game_add rα rβ x y ↔ rα x.1 y.1 ∧ x.2 = y.2 ∨ rβ x.2 y.2 ∧ x.1 = y.1 :=
+begin
+  split,
+  { rintro (@⟨a₁, a₂, b, h⟩ | @⟨a, b₁, b₂, h⟩),
+    exacts [or.inl ⟨h, rfl⟩, or.inr ⟨h, rfl⟩] },
+  { revert x y,
+    rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ (⟨h, rfl : b₁ = b₂⟩ | ⟨h, rfl : a₁ = a₂⟩),
+    exacts [game_add.fst h, game_add.snd h] }
+end
+
+lemma game_add_mk_iff {rα rβ} {a₁ a₂ : α} {b₁ b₂ : β} :
+  game_add rα rβ (a₁, b₁) (a₂, b₂) ↔ rα a₁ a₂ ∧ b₁ = b₂ ∨ rβ b₁ b₂ ∧ a₁ = a₂ :=
+game_add_iff
+
+@[simp] lemma game_add_swap_swap : ∀ a b : α × β,
+  game_add rβ rα a.swap b.swap ↔ game_add rα rβ a b :=
+λ ⟨a₁, b₁⟩ ⟨a₂, b₂⟩, by rw [prod.swap, game_add_mk_iff, game_add_mk_iff, or_comm]
+
+lemma game_add_swap_swap_mk (a₁ a₂ : α) (b₁ b₂ : β) :
+  game_add rα rβ (a₁, b₁) (a₂, b₂) ↔ game_add rβ rα (b₁, a₁) (b₂, a₂) :=
+game_add_swap_swap rβ rα (b₁, a₁) (b₂, a₂)
+
+/-- `prod.game_add` is a `subrelation` of `prod.lex`. -/
+lemma game_add_le_lex : game_add rα rβ ≤ prod.lex rα rβ :=
+λ _ _ h, h.rec (λ _ _ b, prod.lex.left b b) (λ a _ _, prod.lex.right a)
+
+/-- `prod.rprod` is a subrelation of the transitive closure of `prod.game_add`. -/
+lemma rprod_le_trans_gen_game_add : rprod rα rβ ≤ relation.trans_gen (game_add rα rβ) :=
+λ _ _ h, h.rec begin
+  intros _ _ _ _ hα hβ,
+  exact relation.trans_gen.tail (relation.trans_gen.single $ game_add.fst hα) (game_add.snd hβ),
+end
+
+end prod
+
+/-- If `a` is accessible under `rα` and `b` is accessible under `rβ`, then `(a, b)` is
+  accessible under `prod.game_add rα rβ`. Notice that `prod.lex_accessible` requires the
+  stronger condition `∀ b, acc rβ b`. -/
+lemma acc.prod_game_add {a b} (ha : acc rα a) (hb : acc rβ b) : acc (prod.game_add rα rβ) (a, b) :=
+begin
+  induction ha with a ha iha generalizing b,
+  induction hb with b hb ihb,
+  refine acc.intro _ (λ h, _),
+  rintro (⟨ra⟩ | ⟨rb⟩),
+  exacts [iha _ ra (acc.intro b hb), ihb _ rb],
+end
+
+/-- The `prod.game_add` relation on well-founded inputs is well-founded.
+
+  In particular, the sum of two well-founded games is well-founded. -/
+lemma well_founded.prod_game_add (hα : well_founded rα) (hβ : well_founded rβ) :
+  well_founded (prod.game_add rα rβ) := ⟨λ ⟨a, b⟩, (hα.apply a).prod_game_add (hβ.apply b)⟩
+
+namespace prod
+
+/-- Recursion on the well-founded `prod.game_add` relation.
+
+  Note that it's strictly more general to recurse on the lexicographic order instead. -/
+def game_add.fix {C : α → β → Sort*} (hα : well_founded rα) (hβ : well_founded rβ)
+  (IH : Π a₁ b₁, (Π a₂ b₂, game_add rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
+  C a b :=
+@well_founded.fix (α × β) (λ x, C x.1 x.2) _ (hα.prod_game_add hβ)
+  (λ ⟨x₁, x₂⟩ IH', IH x₁ x₂ $ λ a' b', IH' ⟨a', b'⟩) ⟨a, b⟩
+
+lemma game_add.fix_eq {C : α → β → Sort*} (hα : well_founded rα) (hβ : well_founded rβ)
+  (IH : Π a₁ b₁, (Π a₂ b₂, game_add rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) (a : α) (b : β) :
+  game_add.fix hα hβ IH a b = IH a b (λ a' b' h, game_add.fix hα hβ IH a' b') :=
+well_founded.fix_eq _ _ _
+
+/-- Induction on the well-founded `prod.game_add` relation.
+
+  Note that it's strictly more general to induct on the lexicographic order instead. -/
+lemma game_add.induction {C : α → β → Prop} : well_founded rα → well_founded rβ →
+  (∀ a₁ b₁, (∀ a₂ b₂, game_add rα rβ (a₂, b₂) (a₁, b₁) → C a₂ b₂) → C a₁ b₁) → ∀ a b, C a b :=
+game_add.fix
+
+end prod
+
+/-! ### `sym2.game_add` -/
+
+namespace sym2
+
+/-- `sym2.game_add rα x y` means that `x` can be reached from `y` by decreasing either entry with
+  respect to the relation `rα`.
+
+  See `prod.game_add` for the ordered pair analog. -/
+def game_add (rα : α → α → Prop): sym2 α → sym2 α → Prop :=
+sym2.lift₂
+⟨λ a₁ b₁ a₂ b₂, prod.game_add rα rα (a₁, b₁) (a₂, b₂) ∨ prod.game_add rα rα (b₁, a₁) (a₂, b₂),
+  λ a₁ b₁ a₂ b₂, begin
+    rw [prod.game_add_swap_swap_mk _ _ b₁ b₂ a₁ a₂, prod.game_add_swap_swap_mk _ _ a₁ b₂ b₁ a₂],
+    simp [or_comm]
+  end⟩
+
+variable {rα}
+
+lemma game_add_iff : ∀ {x y : α × α}, game_add rα ⟦x⟧ ⟦y⟧ ↔
+  prod.game_add rα rα x y ∨ prod.game_add rα rα x.swap y :=
+by { rintros ⟨_, _⟩ ⟨_, _⟩, refl }
+
+lemma game_add_mk_iff {a₁ a₂ b₁ b₂ : α} : game_add rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ ↔
+  prod.game_add rα rα (a₁, b₁) (a₂, b₂) ∨ prod.game_add rα rα (b₁, a₁) (a₂, b₂) :=
+iff.rfl
+
+lemma _root_.prod.game_add.to_sym2 {a₁ a₂ b₁ b₂ : α}
+  (h : prod.game_add rα rα (a₁, b₁) (a₂, b₂)) : sym2.game_add rα ⟦(a₁, b₁)⟧ ⟦(a₂, b₂)⟧ :=
+game_add_mk_iff.2 $ or.inl $ h
+
+lemma game_add.fst {a₁ a₂ b : α} (h : rα a₁ a₂) : game_add rα ⟦(a₁, b)⟧ ⟦(a₂, b)⟧ :=
+(prod.game_add.fst h).to_sym2
+
+lemma game_add.snd {a b₁ b₂ : α} (h : rα b₁ b₂) : game_add rα ⟦(a, b₁)⟧ ⟦(a, b₂)⟧ :=
+(prod.game_add.snd h).to_sym2
+
+lemma game_add.fst_snd {a₁ a₂ b : α} (h : rα a₁ a₂) : game_add rα ⟦(a₁, b)⟧ ⟦(b, a₂)⟧ :=
+by { rw sym2.eq_swap, exact game_add.snd h }
+
+lemma game_add.snd_fst {a₁ a₂ b : α} (h : rα a₁ a₂) : game_add rα ⟦(b, a₁)⟧ ⟦(a₂, b)⟧ :=
+by { rw sym2.eq_swap, exact game_add.fst h }
+
+end sym2
+
+lemma acc.sym2_game_add {a b} (ha : acc rα a) (hb : acc rα b) : acc (sym2.game_add rα) ⟦(a, b)⟧ :=
+begin
+  induction ha with a ha iha generalizing b,
+  induction hb with b hb ihb,
+  refine acc.intro _ (λ s, _),
+  induction s using sym2.induction_on with c d,
+  rintros ((rc | rd) | (rd | rc)),
+  { exact iha c rc ⟨b, hb⟩ },
+  { exact ihb d rd },
+  { rw sym2.eq_swap,
+    exact iha d rd ⟨b, hb⟩ },
+  { rw sym2.eq_swap,
+    exact ihb c rc }
+end
+
+/-- The `sym2.game_add` relation on well-founded inputs is well-founded. -/
+lemma well_founded.sym2_game_add (h : well_founded rα) : well_founded (sym2.game_add rα) :=
+⟨λ i, sym2.induction_on i $ λ x y, (h.apply x).sym2_game_add (h.apply y)⟩
+
+namespace sym2
+
+/-- Recursion on the well-founded `sym2.game_add` relation. -/
+def game_add.fix {C : α → α → Sort*} (hr : well_founded rα)
+  (IH : Π a₁ b₁, (Π a₂ b₂, sym2.game_add rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
+  C a b :=
+@well_founded.fix (α × α) (λ x, C x.1 x.2) _ hr.sym2_game_add.of_quotient_lift₂
+  (λ ⟨x₁, x₂⟩ IH', IH x₁ x₂ $ λ a' b', IH' ⟨a', b'⟩) (a, b)
+
+lemma game_add.fix_eq {C : α → α → Sort*} (hr : well_founded rα)
+  (IH : Π a₁ b₁, (Π a₂ b₂, sym2.game_add rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) (a b : α) :
+  game_add.fix hr IH a b = IH a b (λ a' b' h, game_add.fix hr IH a' b') :=
+well_founded.fix_eq _ _ _
+
+/-- Induction on the well-founded `sym2.game_add` relation. -/
+lemma game_add.induction {C : α → α → Prop} : well_founded rα →
+  (∀ a₁ b₁, (∀ a₂ b₂, sym2.game_add rα ⟦(a₂, b₂)⟧ ⟦(a₁, b₁)⟧ → C a₂ b₂) → C a₁ b₁) → ∀ a b, C a b :=
+game_add.fix
+
+end sym2
diff --git a/src/order/grade.lean b/src/order/grade.lean
index 9a8f467c7cb7f..1f0c44cac0b23 100644
--- a/src/order/grade.lean
+++ b/src/order/grade.lean
@@ -3,13 +3,15 @@ Copyright (c) 2022 Yaël Dillies, Violeta Hernández Palacios. All rights reserv
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies, Violeta Hernández Palacios, Grayson Burton, Vladimir Ivanov
 -/
-import data.nat.interval
+import data.finset.basic
 import data.int.succ_pred
-import order.atoms
 
 /-!
 # Graded orders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines graded orders, also known as ranked orders.
 
 A `𝕆`-graded order is an order `α` equipped with a distinguished "grade" function `α → 𝕆` which
diff --git a/src/order/height.lean b/src/order/height.lean
new file mode 100644
index 0000000000000..5e0a398afedd6
--- /dev/null
+++ b/src/order/height.lean
@@ -0,0 +1,336 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import data.enat.lattice
+import order.order_iso_nat
+import tactic.tfae
+
+/-!
+
+# Maximal length of chains
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains lemmas to work with the maximal length of strictly descending finite
+sequences (chains) in a partial order.
+
+## Main definition
+
+- `set.subchain`: The set of strictly ascending lists of `α` contained in a `set α`.
+- `set.chain_height`: The maximal length of a strictly ascending sequence in a partial order.
+This is defined as the maximum of the lengths of `set.subchain`s, valued in `ℕ∞`.
+
+## Main results
+
+- `set.exists_chain_of_le_chain_height`: For each `n : ℕ` such that `n ≤ s.chain_height`, there
+  exists `s.subchain` of length `n`.
+- `set.chain_height_mono`: If `s ⊆ t` then `s.chain_height ≤ t.chain_height`.
+- `set.chain_height_image`: If `f` is an order embedding, then
+  `(f '' s).chain_height = s.chain_height`.
+- `set.chain_height_insert_of_forall_lt`: If `∀ y ∈ s, y < x`, then
+  `(insert x s).chain_height = s.chain_height + 1`.
+- `set.chain_height_insert_of_lt_forall`: If `∀ y ∈ s, x < y`, then
+  `(insert x s).chain_height = s.chain_height + 1`.
+- `set.chain_height_union_eq`: If `∀ x ∈ s, ∀ y ∈ t, s ≤ t`, then
+  `(s ∪ t).chain_height = s.chain_height + t.chain_height`.
+- `set.well_founded_gt_of_chain_height_ne_top`:
+  If `s` has finite height, then `>` is well-founded on `s`.
+- `set.well_founded_lt_of_chain_height_ne_top`:
+  If `s` has finite height, then `<` is well-founded on `s`.
+
+-/
+
+open list order_dual
+
+universes u v
+variables {α β : Type*}
+
+namespace set
+section has_lt
+variables [has_lt α] [has_lt β] (s t : set α)
+
+/-- The set of strictly ascending lists of `α` contained in a `set α`. -/
+def subchain : set (list α) := {l | l.chain' (<) ∧ ∀ i ∈ l, i ∈ s}
+
+lemma nil_mem_subchain : [] ∈ s.subchain := ⟨trivial, λ x hx, hx.elim⟩
+
+variables {s} {l : list α} {a : α}
+
+lemma cons_mem_subchain_iff :
+  a :: l ∈ s.subchain ↔ a ∈ s ∧ l ∈ s.subchain ∧ ∀ b ∈ l.head', a < b :=
+begin
+  refine ⟨λ h, ⟨h.2 _ (or.inl rfl), ⟨(chain'_cons'.mp h.1).2, λ i hi, h.2 _ (or.inr hi)⟩,
+      (chain'_cons'.mp h.1).1⟩, _⟩,
+  rintro ⟨h₁, h₂, h₃⟩,
+  split,
+  { rw chain'_cons',
+    exact ⟨h₃, h₂.1⟩ },
+  { rintro i (rfl|hi),
+    exacts [h₁, h₂.2 _ hi] }
+end
+
+instance : nonempty s.subchain := ⟨⟨[], s.nil_mem_subchain⟩⟩
+
+variables (s)
+
+/-- The maximal length of a strictly ascending sequence in a partial order. -/
+noncomputable def chain_height : ℕ∞ := ⨆ l ∈ s.subchain, length l
+
+lemma chain_height_eq_supr_subtype : s.chain_height = ⨆ l : s.subchain, l.1.length := supr_subtype'
+
+lemma exists_chain_of_le_chain_height {n : ℕ} (hn : ↑n ≤ s.chain_height) :
+  ∃ l ∈ s.subchain, length l = n :=
+begin
+  cases (le_top : s.chain_height ≤ ⊤).eq_or_lt with ha ha; rw chain_height_eq_supr_subtype at ha,
+  { obtain ⟨_, ⟨⟨l, h₁, h₂⟩, rfl⟩, h₃⟩ :=
+      not_bdd_above_iff'.mp ((with_top.supr_coe_eq_top _).mp ha) n,
+    exact ⟨l.take n, ⟨h₁.take _, λ x h, h₂ _ $ take_subset _ _ h⟩,
+      (l.length_take n).trans $ min_eq_left $ le_of_not_ge h₃⟩ },
+  { rw with_top.supr_coe_lt_top at ha,
+    obtain ⟨⟨l, h₁, h₂⟩, e : l.length = _⟩ := nat.Sup_mem (set.range_nonempty _) ha,
+    refine ⟨l.take n, ⟨h₁.take _, λ x h, h₂ _ $ take_subset _ _ h⟩,
+      (l.length_take n).trans $ min_eq_left $ _⟩,
+    rwa [e, ←with_top.coe_le_coe, Sup_range, with_top.coe_supr _ ha,
+      ←chain_height_eq_supr_subtype] }
+end
+
+lemma le_chain_height_tfae (n : ℕ) :
+  tfae [↑n ≤ s.chain_height,
+    ∃ l ∈ s.subchain, length l = n,
+    ∃ l ∈ s.subchain, n ≤ length l] :=
+begin
+  tfae_have : 1 → 2, { exact s.exists_chain_of_le_chain_height },
+  tfae_have : 2 → 3, { rintro ⟨l, hls, he⟩, exact ⟨l, hls, he.ge⟩ },
+  tfae_have : 3 → 1, { rintro ⟨l, hs, hn⟩, exact le_supr₂_of_le l hs (with_top.coe_le_coe.2 hn) },
+  tfae_finish,
+end
+
+variables {s t}
+
+lemma le_chain_height_iff {n : ℕ} :
+  ↑n ≤ s.chain_height ↔ ∃ l ∈ s.subchain, length l = n :=
+(le_chain_height_tfae s n).out 0 1
+
+lemma length_le_chain_height_of_mem_subchain (hl : l ∈ s.subchain) : ↑l.length ≤ s.chain_height :=
+le_chain_height_iff.mpr ⟨l, hl, rfl⟩
+
+lemma chain_height_eq_top_iff : s.chain_height = ⊤ ↔ ∀ n, ∃ l ∈ s.subchain, length l = n :=
+begin
+  refine ⟨λ h n, le_chain_height_iff.1 (le_top.trans_eq h.symm), λ h, _⟩,
+  contrapose! h, obtain ⟨n, hn⟩ := with_top.ne_top_iff_exists.1 h,
+  exact ⟨n + 1, λ l hs, (nat.lt_succ_iff.2 $ with_top.coe_le_coe.1 $
+    (length_le_chain_height_of_mem_subchain hs).trans_eq hn.symm).ne⟩,
+end
+
+@[simp]
+lemma one_le_chain_height_iff : 1 ≤ s.chain_height ↔ s.nonempty :=
+begin
+  change ((1 : ℕ) : enat) ≤ _ ↔ _,
+  rw set.le_chain_height_iff,
+  split,
+  { rintro ⟨_|⟨x, xs⟩, ⟨h₁, h₂⟩, h₃⟩,
+    { cases h₃ },
+    { exact ⟨x, h₂ _ (or.inl rfl)⟩ } },
+  { rintro ⟨x, hx⟩,
+    exact ⟨[x], ⟨chain.nil, λ y h, (list.mem_singleton.mp h).symm ▸ hx⟩, rfl⟩ }
+end
+
+@[simp] lemma chain_height_eq_zero_iff : s.chain_height = 0 ↔ s = ∅ :=
+by rw [←not_iff_not, ←ne.def, ←bot_eq_zero, ←bot_lt_iff_ne_bot, bot_eq_zero, ←enat.one_le_iff_pos,
+  one_le_chain_height_iff, nonempty_iff_ne_empty]
+
+@[simp] lemma chain_height_empty : (∅ : set α).chain_height = 0 := chain_height_eq_zero_iff.2 rfl
+
+@[simp] lemma chain_height_of_is_empty [is_empty α] : s.chain_height = 0 :=
+chain_height_eq_zero_iff.mpr (subsingleton.elim _ _)
+
+lemma le_chain_height_add_nat_iff {n m : ℕ} :
+  ↑n ≤ s.chain_height + m ↔ ∃ l ∈ s.subchain, n ≤ length l + m :=
+by simp_rw [← tsub_le_iff_right, ← with_top.coe_sub, (le_chain_height_tfae s (n - m)).out 0 2]
+
+lemma chain_height_add_le_chain_height_add (s : set α) (t : set β) (n m : ℕ) :
+  s.chain_height + n ≤ t.chain_height + m ↔
+    ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l + n ≤ length l' + m :=
+begin
+  refine ⟨λ e l h, le_chain_height_add_nat_iff.1
+    ((add_le_add_right (length_le_chain_height_of_mem_subchain h) _).trans e), λ H, _⟩,
+  by_cases s.chain_height = ⊤,
+  { suffices : t.chain_height = ⊤, { rw [this, top_add], exact le_top },
+    rw chain_height_eq_top_iff at h ⊢,
+    intro k, rw (le_chain_height_tfae t k).out 1 2,
+    obtain ⟨l, hs, hl⟩ := h (k + m),
+    obtain ⟨l', ht, hl'⟩ := H l hs,
+    exact ⟨l', ht, (add_le_add_iff_right m).1 $ trans (hl.symm.trans_le le_self_add) hl'⟩ },
+  { obtain ⟨k, hk⟩ := with_top.ne_top_iff_exists.1 h,
+    obtain ⟨l, hs, hl⟩ := le_chain_height_iff.1 hk.le,
+    rw [← hk, ← hl],
+    exact le_chain_height_add_nat_iff.2 (H l hs) },
+end
+
+lemma chain_height_le_chain_height_tfae (s : set α) (t : set β) :
+  tfae [s.chain_height ≤ t.chain_height,
+    ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l = length l',
+    ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l ≤ length l'] :=
+begin
+  tfae_have : 1 ↔ 3, { convert ← chain_height_add_le_chain_height_add s t 0 0; apply add_zero },
+  tfae_have : 2 ↔ 3, { refine forall₂_congr (λ l hl, _),
+    simp_rw [← (le_chain_height_tfae t l.length).out 1 2, eq_comm] },
+  tfae_finish
+end
+
+lemma chain_height_le_chain_height_iff {t : set β} :
+  s.chain_height ≤ t.chain_height ↔
+    ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l = length l' :=
+(chain_height_le_chain_height_tfae s t).out 0 1
+
+lemma chain_height_le_chain_height_iff_le {t : set β} :
+  s.chain_height ≤ t.chain_height ↔
+    ∀ l ∈ s.subchain, ∃ l' ∈ t.subchain, length l ≤ length l' :=
+(chain_height_le_chain_height_tfae s t).out 0 2
+
+lemma chain_height_mono (h : s ⊆ t) : s.chain_height ≤ t.chain_height :=
+chain_height_le_chain_height_iff.2 $ λ l hl, ⟨l, ⟨hl.1, λ i hi, h $ hl.2 i hi⟩, rfl⟩
+
+lemma chain_height_image
+  (f : α → β) (hf : ∀ {x y}, x < y ↔ f x < f y) (s : set α) :
+  (f '' s).chain_height = s.chain_height :=
+begin
+  apply le_antisymm; rw chain_height_le_chain_height_iff,
+  { suffices : ∀ l ∈ (f '' s).subchain, ∃ l' ∈ s.subchain, map f l' = l,
+    { intros l hl, obtain ⟨l', h₁, rfl⟩ := this l hl, exact ⟨l', h₁, length_map _ _⟩ },
+    intro l,
+    induction l with x xs hx,
+    { exact λ _, ⟨nil, ⟨trivial, λ _ h, h.elim⟩, rfl⟩ },
+    { intros h,
+      rw cons_mem_subchain_iff at h,
+      obtain ⟨⟨x, hx', rfl⟩, h₁, h₂⟩ := h,
+      obtain ⟨l', h₃, rfl⟩ := hx h₁,
+      refine ⟨x :: l', set.cons_mem_subchain_iff.mpr ⟨hx', h₃, _⟩, rfl⟩,
+      cases l', { simp }, { simpa [← hf] using h₂ } } },
+  { intros l hl,
+    refine ⟨l.map f, ⟨_, _⟩, _⟩,
+    { simp_rw [chain'_map, ← hf], exact hl.1 },
+    { intros _ e, obtain ⟨a, ha, rfl⟩ := mem_map.mp e, exact set.mem_image_of_mem _ (hl.2 _ ha) },
+    { rw length_map } },
+end
+
+variables (s)
+
+@[simp] lemma chain_height_dual : (of_dual ⁻¹' s).chain_height = s.chain_height :=
+begin
+  apply le_antisymm;
+  { rw chain_height_le_chain_height_iff,
+    rintro l ⟨h₁, h₂⟩,
+    exact ⟨l.reverse, ⟨chain'_reverse.mpr h₁,
+      λ i h, h₂ i (mem_reverse.mp h)⟩, (length_reverse _).symm⟩ }
+end
+
+end has_lt
+
+section preorder
+variables (s t : set α) [preorder α]
+
+lemma chain_height_eq_supr_Ici : s.chain_height = ⨆ i ∈ s, (s ∩ set.Ici i).chain_height :=
+begin
+  apply le_antisymm,
+  { refine supr₂_le _,
+    rintro (_ | ⟨x, xs⟩) h,
+    { exact zero_le _ },
+    { apply le_trans _ (le_supr₂ x (cons_mem_subchain_iff.mp h).1),
+      apply length_le_chain_height_of_mem_subchain,
+      refine ⟨h.1, λ i hi, ⟨h.2 i hi, _⟩⟩,
+      cases hi, { exact hi.symm.le },
+      cases chain'_iff_pairwise.mp h.1 with _ _ h',
+      exact (h' _ hi).le } },
+  { exact supr₂_le (λ i hi, chain_height_mono $ set.inter_subset_left _ _) }
+end
+
+lemma chain_height_eq_supr_Iic : s.chain_height = ⨆ i ∈ s, (s ∩ set.Iic i).chain_height :=
+by { simp_rw ←chain_height_dual (_ ∩ _), rw [←chain_height_dual, chain_height_eq_supr_Ici], refl }
+
+variables {s t}
+
+lemma chain_height_insert_of_forall_gt (a : α) (hx : ∀ b ∈ s, a < b) :
+  (insert a s).chain_height = s.chain_height + 1 :=
+begin
+  rw ← add_zero (insert a s).chain_height,
+  change (insert a s).chain_height + (0 : ℕ) = s.chain_height + (1 : ℕ),
+  apply le_antisymm; rw chain_height_add_le_chain_height_add,
+  { rintro (_|⟨y, ys⟩) h,
+    { exact ⟨[], nil_mem_subchain _, zero_le _⟩ },
+    { have h' := cons_mem_subchain_iff.mp h,
+      refine ⟨ys, ⟨h'.2.1.1, λ i hi, _⟩, by simp⟩,
+      apply (h'.2.1.2 i hi).resolve_left,
+      rintro rfl,
+      cases chain'_iff_pairwise.mp h.1 with _ _ hy,
+      cases h'.1 with h' h',
+      exacts [(hy _ hi).ne h', not_le_of_gt (hy _ hi) (hx _ h').le] } },
+  { intros l hl,
+    refine ⟨a :: l, ⟨_, _⟩, by simp⟩,
+    { rw chain'_cons', exact ⟨λ y hy, hx _ (hl.2 _ (mem_of_mem_head' hy)), hl.1⟩ },
+    { rintro x (rfl|hx), exacts [or.inl (set.mem_singleton x), or.inr (hl.2 x hx)] } }
+end
+
+lemma chain_height_insert_of_forall_lt (a : α) (ha : ∀ b ∈ s, b < a) :
+  (insert a s).chain_height = s.chain_height + 1 :=
+by { rw [←chain_height_dual, ←chain_height_dual s], exact chain_height_insert_of_forall_gt _ ha }
+
+lemma chain_height_union_le : (s ∪ t).chain_height ≤ s.chain_height + t.chain_height :=
+begin
+  classical,
+  refine supr₂_le (λ l hl, _),
+  let l₁ := l.filter (∈ s), let l₂ := l.filter (∈ t),
+  have hl₁ : ↑l₁.length ≤ s.chain_height,
+  { apply set.length_le_chain_height_of_mem_subchain,
+    exact ⟨hl.1.sublist (filter_sublist _), λ i h, (of_mem_filter h : _)⟩ },
+  have hl₂ : ↑l₂.length ≤ t.chain_height,
+  { apply set.length_le_chain_height_of_mem_subchain,
+    exact ⟨hl.1.sublist (filter_sublist _), λ i h, (of_mem_filter h : _)⟩ },
+  refine le_trans _ (add_le_add hl₁ hl₂),
+  simp_rw [← with_top.coe_add, with_top.coe_le_coe, ← multiset.coe_card,
+    ← multiset.card_add, ← multiset.coe_filter],
+  rw [multiset.filter_add_filter, multiset.filter_eq_self.mpr, multiset.card_add],
+  exacts [le_add_right rfl.le, hl.2]
+end
+
+lemma chain_height_union_eq (s t : set α) (H : ∀ (a ∈ s) (b ∈ t), a < b) :
+  (s ∪ t).chain_height = s.chain_height + t.chain_height :=
+begin
+  cases h : t.chain_height,
+  { rw [with_top.none_eq_top, add_top, eq_top_iff, ← with_top.none_eq_top, ← h],
+    exact set.chain_height_mono (set.subset_union_right _ _) },
+  apply le_antisymm,
+  { rw ← h,
+    exact chain_height_union_le },
+  rw [with_top.some_eq_coe, ← add_zero (s ∪ t).chain_height, ← with_top.coe_zero,
+    chain_height_add_le_chain_height_add],
+  intros l hl,
+  obtain ⟨l', hl', rfl⟩ := exists_chain_of_le_chain_height t h.symm.le,
+  refine ⟨l ++ l', ⟨chain'.append hl.1 hl'.1 $ λ x hx y hy, _, λ i hi, _⟩, by simp⟩,
+  { exact H x (hl.2 _ $ mem_of_mem_last' hx) y (hl'.2 _ $ mem_of_mem_head' hy) },
+  { rw mem_append at hi, cases hi, exacts [or.inl (hl.2 _ hi), or.inr (hl'.2 _ hi)] }
+end
+
+lemma well_founded_gt_of_chain_height_ne_top (s : set α) (hs : s.chain_height ≠ ⊤) :
+  well_founded_gt s :=
+begin
+  obtain ⟨n, hn⟩ := with_top.ne_top_iff_exists.1 hs,
+  refine ⟨rel_embedding.well_founded_iff_no_descending_seq.2 ⟨λ f, _⟩⟩,
+  refine n.lt_succ_self.not_le (with_top.coe_le_coe.1 $ hn.symm ▸ _),
+  refine le_supr₂_of_le _ ⟨chain'_map_of_chain' coe (λ _ _, id)
+    (chain'_iff_pairwise.2 $ pairwise_of_fn.2 $ λ i j, f.map_rel_iff.2), λ i h, _⟩ _,
+  { exact n.succ },
+  { obtain ⟨a, ha, rfl⟩ := mem_map.1 h, exact a.prop },
+  { rw [length_map, length_of_fn], exact le_rfl },
+end
+
+lemma well_founded_lt_of_chain_height_ne_top (s : set α) (hs : s.chain_height ≠ ⊤) :
+  well_founded_lt s :=
+well_founded_gt_of_chain_height_ne_top (of_dual ⁻¹' s) $ by rwa chain_height_dual
+
+end preorder
+
+end set
diff --git a/src/order/heyting/basic.lean b/src/order/heyting/basic.lean
new file mode 100644
index 0000000000000..70dd95d2b7175
--- /dev/null
+++ b/src/order/heyting/basic.lean
@@ -0,0 +1,857 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.prop_instances
+
+/-!
+# Heyting algebras
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines Heyting, co-Heyting and bi-Heyting algebras.
+
+An Heyting algebra is a bounded distributive lattice with an implication operation `⇨` such that
+`a ≤ b ⇨ c ↔ a ⊓ b ≤ c`. It also comes with a pseudo-complement `ᶜ`, such that `aᶜ = a ⇨ ⊥`.
+
+Co-Heyting algebras are dual to Heyting algebras. They have a difference `\` and a negation `￢`
+such that `a \ b ≤ c ↔ a ≤ b ⊔ c` and `￢a = ⊤ \ a`.
+
+Bi-Heyting algebras are Heyting algebras that are also co-Heyting algebras.
+
+From a logic standpoint, Heyting algebras precisely model intuitionistic logic, whereas boolean
+algebras model classical logic.
+
+Heyting algebras are the order theoretic equivalent of cartesian-closed categories.
+
+## Main declarations
+
+* `generalized_heyting_algebra`: Heyting algebra without a top element (nor negation).
+* `generalized_coheyting_algebra`: Co-Heyting algebra without a bottom element (nor complement).
+* `heyting_algebra`: Heyting algebra.
+* `coheyting_algebra`: Co-Heyting algebra.
+* `biheyting_algebra`: bi-Heyting algebra.
+
+## Notation
+
+* `⇨`: Heyting implication
+* `\`: Difference
+* `￢`: Heyting negation
+* `ᶜ`: (Pseudo-)complement
+
+## References
+
+* [Francis Borceux, *Handbook of Categorical Algebra III*][borceux-vol3]
+
+## Tags
+
+Heyting, Brouwer, algebra, implication, negation, intuitionistic
+-/
+
+set_option old_structure_cmd true
+
+open function order_dual
+
+universes u
+variables {ι α β : Type*}
+
+/-! ### Notation -/
+
+/-- Syntax typeclass for Heyting implication `⇨`. -/
+@[notation_class] class has_himp (α : Type*) := (himp : α → α → α)
+
+/-- Syntax typeclass for Heyting negation `￢`.
+
+The difference between `has_compl` and `has_hnot` is that the former belongs to Heyting algebras,
+while the latter belongs to co-Heyting algebras. They are both pseudo-complements, but `compl`
+underestimates while `hnot` overestimates. In boolean algebras, they are equal. See `hnot_eq_compl`.
+-/
+@[notation_class] class has_hnot (α : Type*) := (hnot : α → α)
+
+export has_himp (himp) has_sdiff (sdiff) has_hnot (hnot)
+
+infixr ` ⇨ `:60 := himp
+prefix `￢`:72 := hnot
+
+instance [has_himp α] [has_himp β] : has_himp (α × β) := ⟨λ a b, (a.1 ⇨ b.1, a.2 ⇨ b.2)⟩
+instance [has_hnot α] [has_hnot β] : has_hnot (α × β) := ⟨λ a, (￢a.1, ￢a.2)⟩
+instance [has_sdiff α] [has_sdiff β] : has_sdiff (α × β) := ⟨λ a b, (a.1 \ b.1, a.2 \ b.2)⟩
+instance [has_compl α] [has_compl β] : has_compl (α × β) := ⟨λ a, (a.1ᶜ, a.2ᶜ)⟩
+
+@[simp] lemma fst_himp [has_himp α] [has_himp β] (a b : α × β) : (a ⇨ b).1 = a.1 ⇨ b.1 := rfl
+@[simp] lemma snd_himp [has_himp α] [has_himp β] (a b : α × β) : (a ⇨ b).2 = a.2 ⇨ b.2 := rfl
+@[simp] lemma fst_hnot [has_hnot α] [has_hnot β] (a : α × β) : (￢a).1 = ￢a.1 := rfl
+@[simp] lemma snd_hnot [has_hnot α] [has_hnot β] (a : α × β) : (￢a).2 = ￢a.2 := rfl
+@[simp] lemma fst_sdiff [has_sdiff α] [has_sdiff β] (a b : α × β) : (a \ b).1 = a.1 \ b.1 := rfl
+@[simp] lemma snd_sdiff [has_sdiff α] [has_sdiff β] (a b : α × β) : (a \ b).2 = a.2 \ b.2 := rfl
+@[simp] lemma fst_compl [has_compl α] [has_compl β] (a : α × β) : aᶜ.1 = a.1ᶜ := rfl
+@[simp] lemma snd_compl [has_compl α] [has_compl β] (a : α × β) : aᶜ.2 = a.2ᶜ := rfl
+
+namespace pi
+variables {π : ι → Type*}
+
+instance [Π i, has_himp (π i)] : has_himp (Π i, π i) := ⟨λ a b i, a i ⇨ b i⟩
+instance [Π i, has_hnot (π i)] : has_hnot (Π i, π i) := ⟨λ a i, ￢a i⟩
+
+lemma himp_def [Π i, has_himp (π i)] (a b : Π i, π i) : (a ⇨ b) = λ i, a i ⇨ b i := rfl
+lemma hnot_def [Π i, has_hnot (π i)] (a : Π i, π i) : ￢a = λ i, ￢a i := rfl
+
+@[simp] lemma himp_apply [Π i, has_himp (π i)] (a b : Π i, π i) (i : ι) : (a ⇨ b) i = a i ⇨ b i :=
+rfl
+@[simp] lemma hnot_apply [Π i, has_hnot (π i)] (a : Π i, π i) (i : ι) : (￢a) i = ￢a i := rfl
+
+end pi
+
+/-- A generalized Heyting algebra is a lattice with an additional binary operation `⇨` called
+Heyting implication such that `a ⇨` is right adjoint to `a ⊓`.
+
+ This generalizes `heyting_algebra` by not requiring a bottom element. -/
+class generalized_heyting_algebra (α : Type*) extends lattice α, has_top α, has_himp α :=
+(le_top : ∀ a : α, a ≤ ⊤)
+(le_himp_iff (a b c : α) : a ≤ b ⇨ c ↔ a ⊓ b ≤ c)
+
+/-- A generalized co-Heyting algebra is a lattice with an additional binary difference operation `\`
+such that `\ a` is right adjoint to `⊔ a`.
+
+This generalizes `coheyting_algebra` by not requiring a top element. -/
+class generalized_coheyting_algebra (α : Type*) extends lattice α, has_bot α, has_sdiff α :=
+(bot_le : ∀ a : α, ⊥ ≤ a)
+(sdiff_le_iff (a b c : α) : a \ b ≤ c ↔ a ≤ b ⊔ c)
+
+/-- A Heyting algebra is a bounded lattice with an additional binary operation `⇨` called Heyting
+implication such that `a ⇨` is right adjoint to `a ⊓`. -/
+class heyting_algebra (α : Type*) extends generalized_heyting_algebra α, has_bot α, has_compl α :=
+(bot_le : ∀ a : α, ⊥ ≤ a)
+(himp_bot (a : α) : a ⇨ ⊥ = aᶜ)
+
+/-- A co-Heyting algebra is a bounded  lattice with an additional binary difference operation `\`
+such that `\ a` is right adjoint to `⊔ a`. -/
+class coheyting_algebra (α : Type*)
+  extends generalized_coheyting_algebra α, has_top α, has_hnot α :=
+(le_top : ∀ a : α, a ≤ ⊤)
+(top_sdiff (a : α) : ⊤ \ a = ￢a)
+
+/-- A bi-Heyting algebra is a Heyting algebra that is also a co-Heyting algebra. -/
+class biheyting_algebra (α : Type*) extends heyting_algebra α, has_sdiff α, has_hnot α :=
+(sdiff_le_iff (a b c : α) : a \ b ≤ c ↔ a ≤ b ⊔ c)
+(top_sdiff (a : α) : ⊤ \ a = ￢a)
+
+@[priority 100] -- See note [lower instance priority]
+instance generalized_heyting_algebra.to_order_top [generalized_heyting_algebra α] : order_top α :=
+{ ..‹generalized_heyting_algebra α› }
+
+@[priority 100] -- See note [lower instance priority]
+instance generalized_coheyting_algebra.to_order_bot [generalized_coheyting_algebra α] :
+  order_bot α :=
+{ ..‹generalized_coheyting_algebra α› }
+
+@[priority 100] -- See note [lower instance priority]
+instance heyting_algebra.to_bounded_order [heyting_algebra α] : bounded_order α :=
+{ ..‹heyting_algebra α› }
+
+@[priority 100] -- See note [lower instance priority]
+instance coheyting_algebra.to_bounded_order [coheyting_algebra α] : bounded_order α :=
+{ ..‹coheyting_algebra α› }
+
+@[priority 100] -- See note [lower instance priority]
+instance biheyting_algebra.to_coheyting_algebra [biheyting_algebra α] : coheyting_algebra α :=
+{ ..‹biheyting_algebra α› }
+
+/-- Construct a Heyting algebra from the lattice structure and Heyting implication alone. -/
+@[reducible] -- See note [reducible non-instances]
+def heyting_algebra.of_himp [distrib_lattice α] [bounded_order α] (himp : α → α → α)
+  (le_himp_iff : ∀ a b c, a ≤ himp b c ↔ a ⊓ b ≤ c) : heyting_algebra α :=
+{ himp := himp,
+  compl := λ a, himp a ⊥,
+  le_himp_iff := le_himp_iff,
+  himp_bot := λ a, rfl,
+  ..‹distrib_lattice α›, ..‹bounded_order α› }
+
+/-- Construct a Heyting algebra from the lattice structure and complement operator alone. -/
+@[reducible] -- See note [reducible non-instances]
+def heyting_algebra.of_compl [distrib_lattice α] [bounded_order α] (compl : α → α)
+  (le_himp_iff : ∀ a b c, a ≤ compl b ⊔ c ↔ a ⊓ b ≤ c) : heyting_algebra α :=
+{ himp := λ a, (⊔) (compl a),
+  compl := compl,
+  le_himp_iff := le_himp_iff,
+  himp_bot := λ a, sup_bot_eq,
+  ..‹distrib_lattice α›, ..‹bounded_order α› }
+
+/-- Construct a co-Heyting algebra from the lattice structure and the difference alone. -/
+@[reducible] -- See note [reducible non-instances]
+def coheyting_algebra.of_sdiff [distrib_lattice α] [bounded_order α] (sdiff : α → α → α)
+  (sdiff_le_iff : ∀ a b c, sdiff a b ≤ c ↔ a ≤ b ⊔ c) : coheyting_algebra α :=
+{ sdiff := sdiff,
+  hnot := λ a, sdiff ⊤ a,
+  sdiff_le_iff := sdiff_le_iff,
+  top_sdiff := λ a, rfl,
+  ..‹distrib_lattice α›, ..‹bounded_order α› }
+
+/-- Construct a co-Heyting algebra from the difference and Heyting negation alone. -/
+@[reducible] -- See note [reducible non-instances]
+def coheyting_algebra.of_hnot [distrib_lattice α] [bounded_order α] (hnot : α → α)
+  (sdiff_le_iff : ∀ a b c, a ⊓ hnot b ≤ c ↔ a ≤ b ⊔ c) : coheyting_algebra α :=
+{ sdiff := λ a b, (a ⊓ hnot b),
+  hnot := hnot,
+  sdiff_le_iff := sdiff_le_iff,
+  top_sdiff := λ a, top_inf_eq,
+  ..‹distrib_lattice α›, ..‹bounded_order α› }
+
+section generalized_heyting_algebra
+variables [generalized_heyting_algebra α] {a b c d : α}
+
+/- In this section, we'll give interpretations of these results in the Heyting algebra model of
+intuitionistic logic,- where `≤` can be interpreted as "validates", `⇨` as "implies", `⊓` as "and",
+`⊔` as "or", `⊥` as "false" and `⊤` as "true". Note that we confuse `→` and `⊢` because those are
+the same in this logic.
+
+See also `Prop.heyting_algebra`. -/
+
+-- `p → q → r ↔ p ∧ q → r`
+@[simp] lemma le_himp_iff : a ≤ b ⇨ c ↔ a ⊓ b ≤ c := generalized_heyting_algebra.le_himp_iff _ _ _
+
+-- `p → q → r ↔ q ∧ p → r`
+lemma le_himp_iff' : a ≤ b ⇨ c ↔ b ⊓ a ≤ c := by rw [le_himp_iff, inf_comm]
+
+-- `p → q → r ↔ q → p → r`
+lemma le_himp_comm : a ≤ b ⇨ c ↔ b ≤ a ⇨ c := by rw [le_himp_iff, le_himp_iff']
+
+-- `p → q → p`
+lemma le_himp : a ≤ b ⇨ a := le_himp_iff.2 inf_le_left
+
+-- `p → p → q ↔ p → q`
+@[simp] lemma le_himp_iff_left : a ≤ a ⇨ b ↔ a ≤ b := by rw [le_himp_iff, inf_idem]
+
+-- `p → p`
+@[simp] lemma himp_self : a ⇨ a = ⊤ := top_le_iff.1 $ le_himp_iff.2 inf_le_right
+
+-- `(p → q) ∧ p → q`
+lemma himp_inf_le : (a ⇨ b) ⊓ a ≤ b := le_himp_iff.1 le_rfl
+
+-- `p ∧ (p → q) → q`
+lemma inf_himp_le : a ⊓ (a ⇨ b) ≤ b := by rw [inf_comm, ←le_himp_iff]
+
+-- `p ∧ (p → q) ↔ p ∧ q`
+@[simp] lemma inf_himp (a b : α) : a ⊓ (a ⇨ b) = a ⊓ b :=
+le_antisymm (le_inf inf_le_left $ by rw [inf_comm, ←le_himp_iff]) $ inf_le_inf_left _ le_himp
+
+-- `(p → q) ∧ p ↔ q ∧ p`
+@[simp] lemma himp_inf_self (a b : α) : (a ⇨ b) ⊓ a = b ⊓ a := by rw [inf_comm, inf_himp, inf_comm]
+
+/-- The **deduction theorem** in the Heyting algebra model of intuitionistic logic:
+an implication holds iff the conclusion follows from the hypothesis. -/
+@[simp] lemma himp_eq_top_iff : a ⇨ b = ⊤ ↔ a ≤ b := by rw [←top_le_iff, le_himp_iff, top_inf_eq]
+
+-- `p → true`, `true → p ↔ p`
+@[simp] lemma himp_top : a ⇨ ⊤ = ⊤ := himp_eq_top_iff.2 le_top
+@[simp] lemma top_himp : ⊤ ⇨ a = a := eq_of_forall_le_iff $ λ b, by rw [le_himp_iff, inf_top_eq]
+
+-- `p → q → r ↔ p ∧ q → r`
+lemma himp_himp (a b c : α) : a ⇨ b ⇨ c = a ⊓ b ⇨ c :=
+eq_of_forall_le_iff $ λ d, by simp_rw [le_himp_iff, inf_assoc]
+
+-- `(q → r) → (p → q) → q → r`
+@[simp] lemma himp_le_himp_himp_himp : b ⇨ c ≤ (a ⇨ b) ⇨ a ⇨ c :=
+begin
+  rw [le_himp_iff, le_himp_iff, inf_assoc, himp_inf_self, ←inf_assoc, himp_inf_self, inf_assoc],
+  exact inf_le_left,
+end
+
+-- `p → q → r ↔ q → p → r`
+lemma himp_left_comm (a b c : α) : a ⇨ b ⇨ c = b ⇨ a ⇨ c := by simp_rw [himp_himp, inf_comm]
+
+@[simp] lemma himp_idem : b ⇨ b ⇨ a = b ⇨ a := by rw [himp_himp, inf_idem]
+
+lemma himp_inf_distrib (a b c : α) : a ⇨ b ⊓ c = (a ⇨ b) ⊓ (a ⇨ c) :=
+eq_of_forall_le_iff $ λ d, by simp_rw [le_himp_iff, le_inf_iff, le_himp_iff]
+
+lemma sup_himp_distrib (a b c : α) : a ⊔ b ⇨ c = (a ⇨ c) ⊓ (b ⇨ c) :=
+eq_of_forall_le_iff $ λ d, by { rw [le_inf_iff, le_himp_comm, sup_le_iff], simp_rw le_himp_comm }
+
+lemma himp_le_himp_left (h : a ≤ b) : c ⇨ a ≤ c ⇨ b := le_himp_iff.2 $ himp_inf_le.trans h
+
+lemma himp_le_himp_right (h : a ≤ b) : b ⇨ c ≤ a ⇨ c :=
+le_himp_iff.2 $ (inf_le_inf_left _ h).trans himp_inf_le
+
+lemma himp_le_himp (hab : a ≤ b) (hcd : c ≤ d) : b ⇨ c ≤ a ⇨ d :=
+(himp_le_himp_right hab).trans $ himp_le_himp_left hcd
+
+@[simp] lemma sup_himp_self_left (a b : α) : (a ⊔ b) ⇨ a = b ⇨ a :=
+by rw [sup_himp_distrib, himp_self, top_inf_eq]
+
+@[simp] lemma sup_himp_self_right (a b : α) : (a ⊔ b) ⇨ b = a ⇨ b :=
+by rw [sup_himp_distrib, himp_self, inf_top_eq]
+
+lemma codisjoint.himp_eq_right (h : codisjoint a b) : b ⇨ a = a :=
+by { conv_rhs { rw ←@top_himp _ _ a }, rw [←h.eq_top, sup_himp_self_left] }
+
+lemma codisjoint.himp_eq_left (h : codisjoint a b) : a ⇨ b = b := h.symm.himp_eq_right
+
+lemma codisjoint.himp_inf_cancel_right (h : codisjoint a b) : a ⇨ (a ⊓ b) = b :=
+by rw [himp_inf_distrib, himp_self, top_inf_eq, h.himp_eq_left]
+
+lemma codisjoint.himp_inf_cancel_left (h : codisjoint a b) : b ⇨ (a ⊓ b) = a :=
+by rw [himp_inf_distrib, himp_self, inf_top_eq, h.himp_eq_right]
+
+/-- See `himp_le` for a stronger version in Boolean algebras. -/
+lemma codisjoint.himp_le_of_right_le (hac : codisjoint a c) (hba : b ≤ a) : c ⇨ b ≤ a :=
+(himp_le_himp_left hba).trans_eq hac.himp_eq_right
+
+lemma le_himp_himp : a ≤ (a ⇨ b) ⇨ b := le_himp_iff.2 inf_himp_le
+
+lemma himp_triangle (a b c : α) : (a ⇨ b) ⊓ (b ⇨ c) ≤ a ⇨ c :=
+by { rw [le_himp_iff, inf_right_comm, ←le_himp_iff], exact himp_inf_le.trans le_himp_himp }
+
+lemma himp_inf_himp_cancel (hba : b ≤ a) (hcb : c ≤ b) : (a ⇨ b) ⊓ (b ⇨ c) = a ⇨ c :=
+(himp_triangle  _ _ _).antisymm $ le_inf (himp_le_himp_left hcb) (himp_le_himp_right hba)
+
+@[priority 100] -- See note [lower instance priority]
+instance generalized_heyting_algebra.to_distrib_lattice : distrib_lattice α :=
+distrib_lattice.of_inf_sup_le $ λ a b c,
+  by simp_rw [@inf_comm _ _ a, ←le_himp_iff, sup_le_iff, le_himp_iff, ←sup_le_iff]
+
+instance : generalized_coheyting_algebra αᵒᵈ :=
+{ sdiff := λ a b, to_dual (of_dual b ⇨ of_dual a),
+  sdiff_le_iff := λ a b c, by { rw sup_comm, exact le_himp_iff },
+  ..order_dual.lattice α, ..order_dual.order_bot α }
+
+instance prod.generalized_heyting_algebra [generalized_heyting_algebra β] :
+  generalized_heyting_algebra (α × β) :=
+{ le_himp_iff := λ a b c, and_congr le_himp_iff le_himp_iff,
+  ..prod.lattice α β, ..prod.order_top α β, ..prod.has_himp, ..prod.has_compl }
+
+instance pi.generalized_heyting_algebra {α : ι → Type*} [Π i, generalized_heyting_algebra (α i)] :
+  generalized_heyting_algebra (Π i, α i) :=
+by { pi_instance, exact λ a b c, forall_congr (λ i, le_himp_iff) }
+
+end generalized_heyting_algebra
+
+section generalized_coheyting_algebra
+variables [generalized_coheyting_algebra α] {a b c d : α}
+
+@[simp] lemma sdiff_le_iff : a \ b ≤ c ↔ a ≤ b ⊔ c :=
+generalized_coheyting_algebra.sdiff_le_iff _ _ _
+
+lemma sdiff_le_iff' : a \ b ≤ c ↔ a ≤ c ⊔ b := by rw [sdiff_le_iff, sup_comm]
+
+lemma sdiff_le_comm : a \ b ≤ c ↔ a \ c ≤ b := by rw [sdiff_le_iff, sdiff_le_iff']
+
+lemma sdiff_le : a \ b ≤ a := sdiff_le_iff.2 le_sup_right
+
+lemma disjoint.disjoint_sdiff_left (h : disjoint a b) : disjoint (a \ c) b := h.mono_left sdiff_le
+lemma disjoint.disjoint_sdiff_right (h : disjoint a b) : disjoint a (b \ c) := h.mono_right sdiff_le
+
+@[simp] lemma sdiff_le_iff_left : a \ b ≤ b ↔ a ≤ b := by rw [sdiff_le_iff, sup_idem]
+
+@[simp] lemma sdiff_self : a \ a = ⊥ := le_bot_iff.1 $ sdiff_le_iff.2 le_sup_left
+
+lemma le_sup_sdiff : a ≤ b ⊔ a \ b := sdiff_le_iff.1 le_rfl
+lemma le_sdiff_sup : a ≤ a \ b ⊔ b := by rw [sup_comm, ←sdiff_le_iff]
+
+@[simp] lemma sup_sdiff_left : a ⊔ a \ b = a := sup_of_le_left sdiff_le
+@[simp] lemma sup_sdiff_right : a \ b ⊔ a = a := sup_of_le_right sdiff_le
+@[simp] lemma inf_sdiff_left : a \ b ⊓ a = a \ b := inf_of_le_left sdiff_le
+@[simp] lemma inf_sdiff_right : a ⊓ a \ b = a \ b := inf_of_le_right sdiff_le
+
+@[simp] lemma sup_sdiff_self (a b : α) : a ⊔ b \ a = a ⊔ b :=
+le_antisymm (sup_le_sup_left sdiff_le _) (sup_le le_sup_left le_sup_sdiff)
+
+@[simp] lemma sdiff_sup_self (a b : α) : b \ a ⊔ a = b ⊔ a :=
+by rw [sup_comm, sup_sdiff_self, sup_comm]
+
+alias sdiff_sup_self ← sup_sdiff_self_left
+alias sup_sdiff_self ← sup_sdiff_self_right
+
+lemma sup_sdiff_eq_sup (h : c ≤ a) : a ⊔ b \ c = a ⊔ b :=
+sup_congr_left (sdiff_le.trans le_sup_right) $ le_sup_sdiff.trans $ sup_le_sup_right h _
+
+-- cf. `set.union_diff_cancel'`
+lemma sup_sdiff_cancel' (hab : a ≤ b) (hbc : b ≤ c) : b ⊔ c \ a = c :=
+by rw [sup_sdiff_eq_sup hab, sup_of_le_right hbc]
+
+lemma sup_sdiff_cancel_right (h : a ≤ b) : a ⊔ b \ a = b := sup_sdiff_cancel' le_rfl h
+
+lemma sdiff_sup_cancel (h : b ≤ a) : a \ b ⊔ b = a := by rw [sup_comm, sup_sdiff_cancel_right h]
+
+lemma sup_le_of_le_sdiff_left (h : b ≤ c \ a) (hac : a ≤ c) : a ⊔ b ≤ c :=
+sup_le hac $ h.trans sdiff_le
+
+lemma sup_le_of_le_sdiff_right (h : a ≤ c \ b) (hbc : b ≤ c) : a ⊔ b ≤ c :=
+sup_le (h.trans sdiff_le) hbc
+
+@[simp] lemma sdiff_eq_bot_iff : a \ b = ⊥ ↔ a ≤ b := by rw [←le_bot_iff, sdiff_le_iff, sup_bot_eq]
+
+@[simp] lemma sdiff_bot : a \ ⊥ = a := eq_of_forall_ge_iff $ λ b, by rw [sdiff_le_iff, bot_sup_eq]
+@[simp] lemma bot_sdiff : ⊥ \ a = ⊥ := sdiff_eq_bot_iff.2 bot_le
+
+@[simp] lemma sdiff_sdiff_sdiff_le_sdiff : a \ b \ (a \ c) ≤ c \ b :=
+begin
+  rw [sdiff_le_iff, sdiff_le_iff, sup_left_comm, sup_sdiff_self, sup_left_comm, sdiff_sup_self,
+    sup_left_comm],
+  exact le_sup_left,
+end
+
+lemma sdiff_sdiff (a b c : α) : a \ b \ c = a \ (b ⊔ c) :=
+eq_of_forall_ge_iff $ λ d, by simp_rw [sdiff_le_iff, sup_assoc]
+
+lemma sdiff_sdiff_left : a \ b \ c = a \ (b ⊔ c) := sdiff_sdiff _ _ _
+
+lemma sdiff_right_comm (a b c : α) : a \ b \ c = a \ c \ b := by simp_rw [sdiff_sdiff, sup_comm]
+
+lemma sdiff_sdiff_comm : a \ b \ c = a \ c \ b := sdiff_right_comm _ _ _
+
+@[simp] lemma sdiff_idem : a \ b \ b = a \ b := by rw [sdiff_sdiff_left, sup_idem]
+@[simp] lemma sdiff_sdiff_self : a \ b \ a = ⊥ := by rw [sdiff_sdiff_comm, sdiff_self, bot_sdiff]
+
+lemma sup_sdiff_distrib (a b c : α) : (a ⊔ b) \ c = a \ c ⊔ b \ c :=
+eq_of_forall_ge_iff $ λ d, by simp_rw [sdiff_le_iff, sup_le_iff, sdiff_le_iff]
+
+lemma sdiff_inf_distrib (a b c : α) : a \ (b ⊓ c) = a \ b ⊔ a \ c :=
+eq_of_forall_ge_iff $ λ d, by { rw [sup_le_iff, sdiff_le_comm, le_inf_iff], simp_rw sdiff_le_comm }
+
+lemma sup_sdiff : (a ⊔ b) \ c = a \ c ⊔ b \ c := sup_sdiff_distrib _ _ _
+
+@[simp] lemma sup_sdiff_right_self : (a ⊔ b) \ b = a \ b :=
+by rw [sup_sdiff, sdiff_self, sup_bot_eq]
+
+@[simp] lemma sup_sdiff_left_self : (a ⊔ b) \ a = b \ a := by rw [sup_comm, sup_sdiff_right_self]
+
+lemma sdiff_le_sdiff_right (h : a ≤ b) : a \ c ≤ b \ c := sdiff_le_iff.2 $ h.trans $ le_sup_sdiff
+
+lemma sdiff_le_sdiff_left (h : a ≤ b) : c \ b ≤ c \ a :=
+sdiff_le_iff.2 $ le_sup_sdiff.trans $ sup_le_sup_right h _
+
+lemma sdiff_le_sdiff (hab : a ≤ b) (hcd : c ≤ d) : a \ d ≤ b \ c :=
+(sdiff_le_sdiff_right hab).trans $ sdiff_le_sdiff_left hcd
+
+-- cf. `is_compl.inf_sup`
+lemma sdiff_inf : a \ (b ⊓ c) = a \ b ⊔ a \ c := sdiff_inf_distrib _ _ _
+
+@[simp] lemma sdiff_inf_self_left (a b : α) : a \ (a ⊓ b) = a \ b :=
+by rw [sdiff_inf, sdiff_self, bot_sup_eq]
+
+@[simp] lemma sdiff_inf_self_right (a b : α) : b \ (a ⊓ b) = b \ a :=
+by rw [sdiff_inf, sdiff_self, sup_bot_eq]
+
+lemma disjoint.sdiff_eq_left (h : disjoint a b) : a \ b = a :=
+by { conv_rhs { rw ←@sdiff_bot _ _ a }, rw [←h.eq_bot, sdiff_inf_self_left] }
+
+lemma disjoint.sdiff_eq_right (h : disjoint a b) : b \ a = b := h.symm.sdiff_eq_left
+
+lemma disjoint.sup_sdiff_cancel_left (h : disjoint a b) : (a ⊔ b) \ a = b :=
+by rw [sup_sdiff, sdiff_self, bot_sup_eq, h.sdiff_eq_right]
+
+lemma disjoint.sup_sdiff_cancel_right (h : disjoint a b) : (a ⊔ b) \ b = a :=
+by rw [sup_sdiff, sdiff_self, sup_bot_eq, h.sdiff_eq_left]
+
+/-- See `le_sdiff` for a stronger version in generalised Boolean algebras. -/
+lemma disjoint.le_sdiff_of_le_left (hac : disjoint a c) (hab : a ≤ b) : a ≤ b \ c :=
+hac.sdiff_eq_left.ge.trans $ sdiff_le_sdiff_right hab
+
+lemma sdiff_sdiff_le : a \ (a \ b) ≤ b := sdiff_le_iff.2 le_sdiff_sup
+
+lemma sdiff_triangle (a b c : α) : a \ c ≤ a \ b ⊔ b \ c :=
+by { rw [sdiff_le_iff, sup_left_comm, ←sdiff_le_iff], exact sdiff_sdiff_le.trans le_sup_sdiff }
+
+lemma sdiff_sup_sdiff_cancel (hba : b ≤ a) (hcb : c ≤ b) : a \ b ⊔ b \ c = a \ c :=
+(sdiff_triangle  _ _ _).antisymm' $ sup_le (sdiff_le_sdiff_left hcb) (sdiff_le_sdiff_right hba)
+
+lemma sdiff_le_sdiff_of_sup_le_sup_left (h : c ⊔ a ≤ c ⊔ b) : a \ c ≤ b \ c :=
+by { rw [←sup_sdiff_left_self, ←@sup_sdiff_left_self _ _ _ b], exact sdiff_le_sdiff_right h }
+
+lemma sdiff_le_sdiff_of_sup_le_sup_right (h : a ⊔ c ≤ b ⊔ c) : a \ c ≤ b \ c :=
+by { rw [←sup_sdiff_right_self, ←@sup_sdiff_right_self _ _ b], exact sdiff_le_sdiff_right h }
+
+@[simp] lemma inf_sdiff_sup_left : a \ c ⊓ (a ⊔ b) = a \ c :=
+inf_of_le_left $ sdiff_le.trans le_sup_left
+@[simp] lemma inf_sdiff_sup_right : a \ c ⊓ (b ⊔ a) = a \ c :=
+inf_of_le_left $ sdiff_le.trans le_sup_right
+
+@[priority 100] -- See note [lower instance priority]
+instance generalized_coheyting_algebra.to_distrib_lattice : distrib_lattice α :=
+{ le_sup_inf := λ a b c, by simp_rw [←sdiff_le_iff, le_inf_iff, sdiff_le_iff, ←le_inf_iff],
+  ..‹generalized_coheyting_algebra α› }
+
+instance : generalized_heyting_algebra αᵒᵈ :=
+{ himp := λ a b, to_dual (of_dual b \ of_dual a),
+  le_himp_iff := λ a b c, by { rw inf_comm, exact sdiff_le_iff },
+  ..order_dual.lattice α, ..order_dual.order_top α }
+
+instance prod.generalized_coheyting_algebra [generalized_coheyting_algebra β] :
+  generalized_coheyting_algebra (α × β) :=
+{ sdiff_le_iff := λ a b c, and_congr sdiff_le_iff sdiff_le_iff,
+  ..prod.lattice α β, ..prod.order_bot α β, ..prod.has_sdiff, ..prod.has_hnot }
+
+instance pi.generalized_coheyting_algebra {α : ι → Type*}
+  [Π i, generalized_coheyting_algebra (α i)] : generalized_coheyting_algebra (Π i, α i) :=
+by { pi_instance, exact λ a b c, forall_congr (λ i, sdiff_le_iff) }
+
+end generalized_coheyting_algebra
+
+section heyting_algebra
+variables [heyting_algebra α] {a b c : α}
+
+@[simp] lemma himp_bot (a : α) : a ⇨ ⊥ = aᶜ := heyting_algebra.himp_bot _
+@[simp] lemma bot_himp (a : α) : ⊥ ⇨ a = ⊤ := himp_eq_top_iff.2 bot_le
+
+lemma compl_sup_distrib (a b : α) : (a ⊔ b)ᶜ = aᶜ ⊓ bᶜ := by simp_rw [←himp_bot, sup_himp_distrib]
+@[simp] lemma compl_sup : (a ⊔ b)ᶜ = aᶜ ⊓ bᶜ := compl_sup_distrib _ _
+
+lemma compl_le_himp : aᶜ ≤ a ⇨ b := (himp_bot _).ge.trans $ himp_le_himp_left bot_le
+
+lemma compl_sup_le_himp : aᶜ ⊔ b ≤ a ⇨ b := sup_le compl_le_himp le_himp
+lemma sup_compl_le_himp : b ⊔ aᶜ ≤ a ⇨ b := sup_le le_himp compl_le_himp
+
+-- `p → ¬ p ↔ ¬ p`
+@[simp] lemma himp_compl (a : α) : a ⇨ aᶜ = aᶜ := by rw [←himp_bot, himp_himp, inf_idem]
+
+-- `p → ¬ q ↔ q → ¬ p`
+lemma himp_compl_comm (a b : α) : a ⇨ bᶜ = b ⇨ aᶜ := by simp_rw [←himp_bot, himp_left_comm]
+
+lemma le_compl_iff_disjoint_right : a ≤ bᶜ ↔ disjoint a b :=
+by rw [←himp_bot, le_himp_iff, disjoint_iff_inf_le]
+
+lemma le_compl_iff_disjoint_left : a ≤ bᶜ ↔ disjoint b a :=
+le_compl_iff_disjoint_right.trans disjoint.comm
+
+lemma le_compl_comm : a ≤ bᶜ ↔ b ≤ aᶜ :=
+by rw [le_compl_iff_disjoint_right, le_compl_iff_disjoint_left]
+
+alias le_compl_iff_disjoint_right ↔ _ disjoint.le_compl_right
+alias le_compl_iff_disjoint_left ↔ _ disjoint.le_compl_left
+alias le_compl_comm ← le_compl_iff_le_compl
+alias le_compl_comm ↔ le_compl_of_le_compl _
+
+lemma disjoint_compl_left : disjoint aᶜ a := disjoint_iff_inf_le.mpr $ le_himp_iff.1 (himp_bot _).ge
+lemma disjoint_compl_right : disjoint a aᶜ := disjoint_compl_left.symm
+
+lemma has_le.le.disjoint_compl_left (h : b ≤ a) : disjoint aᶜ b := disjoint_compl_left.mono_right h
+lemma has_le.le.disjoint_compl_right (h : a ≤ b) : disjoint a bᶜ := disjoint_compl_right.mono_left h
+
+lemma is_compl.compl_eq (h : is_compl a b) : aᶜ = b :=
+h.1.le_compl_left.antisymm' $ disjoint.le_of_codisjoint disjoint_compl_left h.2
+
+lemma is_compl.eq_compl (h : is_compl a b) : a = bᶜ :=
+h.1.le_compl_right.antisymm $ disjoint.le_of_codisjoint disjoint_compl_left h.2.symm
+
+lemma compl_unique (h₀ : a ⊓ b = ⊥) (h₁ : a ⊔ b = ⊤) : aᶜ = b := (is_compl.of_eq h₀ h₁).compl_eq
+
+@[simp] lemma inf_compl_self (a : α) : a ⊓ aᶜ = ⊥ := disjoint_compl_right.eq_bot
+@[simp] lemma compl_inf_self (a : α) : aᶜ ⊓ a = ⊥ := disjoint_compl_left.eq_bot
+lemma inf_compl_eq_bot : a ⊓ aᶜ = ⊥ := inf_compl_self _
+lemma compl_inf_eq_bot : aᶜ ⊓ a = ⊥ := compl_inf_self _
+
+@[simp] lemma compl_top : (⊤ : α)ᶜ = ⊥ :=
+eq_of_forall_le_iff $ λ a, by rw [le_compl_iff_disjoint_right, disjoint_top, le_bot_iff]
+
+@[simp] lemma compl_bot : (⊥ : α)ᶜ = ⊤ := by rw [←himp_bot, himp_self]
+
+lemma le_compl_compl : a ≤ aᶜᶜ := disjoint_compl_right.le_compl_right
+
+lemma compl_anti : antitone (compl : α → α) := λ a b h, le_compl_comm.1 $ h.trans le_compl_compl
+
+lemma compl_le_compl (h : a ≤ b) : bᶜ ≤ aᶜ := compl_anti h
+
+@[simp] lemma compl_compl_compl (a : α) : aᶜᶜᶜ = aᶜ :=
+(compl_anti le_compl_compl).antisymm le_compl_compl
+
+@[simp] lemma disjoint_compl_compl_left_iff : disjoint aᶜᶜ b ↔ disjoint a b :=
+by simp_rw [←le_compl_iff_disjoint_left, compl_compl_compl]
+
+@[simp] lemma disjoint_compl_compl_right_iff : disjoint a bᶜᶜ ↔ disjoint a b :=
+by simp_rw [←le_compl_iff_disjoint_right, compl_compl_compl]
+
+lemma compl_sup_compl_le :  aᶜ ⊔ bᶜ ≤ (a ⊓ b)ᶜ :=
+sup_le (compl_anti inf_le_left) $ compl_anti inf_le_right
+
+lemma compl_compl_inf_distrib (a b : α) : (a ⊓ b)ᶜᶜ = aᶜᶜ ⊓ bᶜᶜ :=
+begin
+  refine ((compl_anti compl_sup_compl_le).trans (compl_sup_distrib _ _).le).antisymm _,
+  rw [le_compl_iff_disjoint_right, disjoint_assoc, disjoint_compl_compl_left_iff,
+    disjoint_left_comm, disjoint_compl_compl_left_iff, ←disjoint_assoc, inf_comm],
+  exact disjoint_compl_right,
+end
+
+lemma compl_compl_himp_distrib (a b : α) : (a ⇨ b)ᶜᶜ = aᶜᶜ ⇨ bᶜᶜ :=
+begin
+  refine le_antisymm _ _,
+  { rw [le_himp_iff, ←compl_compl_inf_distrib],
+    exact compl_anti (compl_anti himp_inf_le) },
+  { refine le_compl_comm.1 ((compl_anti compl_sup_le_himp).trans _),
+    rw [compl_sup_distrib, le_compl_iff_disjoint_right, disjoint_right_comm,
+      ←le_compl_iff_disjoint_right],
+    exact inf_himp_le }
+end
+
+instance : coheyting_algebra αᵒᵈ :=
+{ hnot := to_dual ∘ compl ∘ of_dual,
+  sdiff := λ a b, to_dual (of_dual b ⇨ of_dual a),
+  sdiff_le_iff := λ a b c, by { rw sup_comm, exact le_himp_iff },
+  top_sdiff := himp_bot,
+  ..order_dual.lattice α, ..order_dual.bounded_order α }
+
+@[simp] lemma of_dual_hnot (a : αᵒᵈ) : of_dual ￢a = (of_dual a)ᶜ := rfl
+@[simp] lemma to_dual_compl (a : α) : to_dual aᶜ = ￢to_dual a := rfl
+
+instance prod.heyting_algebra [heyting_algebra β] : heyting_algebra (α × β) :=
+{ himp_bot := λ a, prod.ext (himp_bot a.1) (himp_bot a.2),
+  ..prod.generalized_heyting_algebra, ..prod.bounded_order α β, ..prod.has_compl }
+
+instance pi.heyting_algebra {α : ι → Type*} [Π i, heyting_algebra (α i)] :
+  heyting_algebra (Π i, α i) :=
+by { pi_instance, exact λ a b c, forall_congr (λ i, le_himp_iff) }
+
+end heyting_algebra
+
+section coheyting_algebra
+variables [coheyting_algebra α] {a b c : α}
+
+@[simp] lemma top_sdiff' (a : α) : ⊤ \ a = ￢a := coheyting_algebra.top_sdiff _
+@[simp] lemma sdiff_top (a : α) : a \ ⊤ = ⊥ := sdiff_eq_bot_iff.2 le_top
+
+lemma hnot_inf_distrib (a b : α) : ￢ (a ⊓ b) = ￢a ⊔ ￢b :=
+by simp_rw [←top_sdiff', sdiff_inf_distrib]
+
+lemma sdiff_le_hnot : a \ b ≤ ￢b := (sdiff_le_sdiff_right le_top).trans_eq $ top_sdiff' _
+
+lemma sdiff_le_inf_hnot : a \ b ≤ a ⊓ ￢b := le_inf sdiff_le sdiff_le_hnot
+
+@[priority 100] -- See note [lower instance priority]
+instance coheyting_algebra.to_distrib_lattice : distrib_lattice α :=
+{ le_sup_inf := λ a b c, by simp_rw [←sdiff_le_iff, le_inf_iff, sdiff_le_iff, ←le_inf_iff],
+  ..‹coheyting_algebra α› }
+
+@[simp] lemma hnot_sdiff (a : α) : ￢a \ a = ￢a := by rw [←top_sdiff', sdiff_sdiff, sup_idem]
+
+lemma hnot_sdiff_comm (a b : α) : ￢a \ b = ￢b \ a := by simp_rw [←top_sdiff', sdiff_right_comm]
+
+lemma hnot_le_iff_codisjoint_right : ￢a ≤ b ↔ codisjoint a b :=
+by rw [←top_sdiff', sdiff_le_iff, codisjoint_iff_le_sup]
+
+lemma hnot_le_iff_codisjoint_left : ￢a ≤ b ↔ codisjoint b a :=
+hnot_le_iff_codisjoint_right.trans codisjoint.comm
+
+lemma hnot_le_comm : ￢a ≤ b ↔ ￢b ≤ a :=
+by rw [hnot_le_iff_codisjoint_right, hnot_le_iff_codisjoint_left]
+
+alias hnot_le_iff_codisjoint_right ↔ _ codisjoint.hnot_le_right
+alias hnot_le_iff_codisjoint_left ↔ _ codisjoint.hnot_le_left
+
+lemma codisjoint_hnot_right : codisjoint a (￢a) :=
+codisjoint_iff_le_sup.2 $ sdiff_le_iff.1 (top_sdiff' _).le
+lemma codisjoint_hnot_left : codisjoint (￢a) a := codisjoint_hnot_right.symm
+
+lemma has_le.le.codisjoint_hnot_left (h : a ≤ b) : codisjoint (￢a) b :=
+codisjoint_hnot_left.mono_right h
+
+lemma has_le.le.codisjoint_hnot_right (h : b ≤ a) : codisjoint a (￢b) :=
+codisjoint_hnot_right.mono_left h
+
+lemma is_compl.hnot_eq (h : is_compl a b) : ￢a = b :=
+h.2.hnot_le_right.antisymm $ disjoint.le_of_codisjoint h.1.symm codisjoint_hnot_right
+
+lemma is_compl.eq_hnot (h : is_compl a b) : a = ￢b :=
+h.2.hnot_le_left.antisymm' $ disjoint.le_of_codisjoint h.1 codisjoint_hnot_right
+
+@[simp] lemma sup_hnot_self (a : α) : a ⊔ ￢a = ⊤ := codisjoint.eq_top codisjoint_hnot_right
+@[simp] lemma hnot_sup_self (a : α) : ￢a ⊔ a = ⊤ := codisjoint.eq_top codisjoint_hnot_left
+
+@[simp] lemma hnot_bot : ￢(⊥ : α) = ⊤ :=
+eq_of_forall_ge_iff $ λ a, by rw [hnot_le_iff_codisjoint_left, codisjoint_bot, top_le_iff]
+
+@[simp] lemma hnot_top : ￢(⊤ : α) = ⊥ := by rw [←top_sdiff', sdiff_self]
+
+lemma hnot_hnot_le : ￢￢a ≤ a := codisjoint_hnot_right.hnot_le_left
+
+lemma hnot_anti : antitone (hnot : α → α) := λ a b h, hnot_le_comm.1 $ hnot_hnot_le.trans h
+
+lemma hnot_le_hnot (h : a ≤ b) : ￢b ≤ ￢a := hnot_anti h
+
+@[simp] lemma hnot_hnot_hnot (a : α) : ￢￢￢a = ￢a := hnot_hnot_le.antisymm $ hnot_anti hnot_hnot_le
+
+@[simp] lemma codisjoint_hnot_hnot_left_iff : codisjoint (￢￢a) b ↔ codisjoint a b :=
+by simp_rw [←hnot_le_iff_codisjoint_right, hnot_hnot_hnot]
+
+@[simp] lemma codisjoint_hnot_hnot_right_iff : codisjoint a (￢￢b) ↔ codisjoint a b :=
+by simp_rw [←hnot_le_iff_codisjoint_left, hnot_hnot_hnot]
+
+lemma le_hnot_inf_hnot : ￢ (a ⊔ b) ≤ ￢a ⊓ ￢b :=
+le_inf (hnot_anti le_sup_left) $ hnot_anti le_sup_right
+
+lemma hnot_hnot_sup_distrib (a b : α) : ￢￢(a ⊔ b) = ￢￢a ⊔ ￢￢b :=
+begin
+  refine ((hnot_inf_distrib _ _).ge.trans $ hnot_anti le_hnot_inf_hnot).antisymm' _,
+  rw [hnot_le_iff_codisjoint_left, codisjoint_assoc, codisjoint_hnot_hnot_left_iff,
+    codisjoint_left_comm, codisjoint_hnot_hnot_left_iff, ←codisjoint_assoc, sup_comm],
+  exact codisjoint_hnot_right,
+end
+
+lemma hnot_hnot_sdiff_distrib (a b : α) : ￢￢(a \ b) = ￢￢a \ ￢￢b :=
+begin
+  refine le_antisymm _ _,
+  { refine hnot_le_comm.1 ((hnot_anti sdiff_le_inf_hnot).trans' _),
+    rw [hnot_inf_distrib, hnot_le_iff_codisjoint_right, codisjoint_left_comm,
+      ←hnot_le_iff_codisjoint_right],
+    exact le_sdiff_sup },
+  { rw [sdiff_le_iff, ←hnot_hnot_sup_distrib],
+    exact hnot_anti (hnot_anti le_sup_sdiff) }
+end
+
+instance : heyting_algebra αᵒᵈ :=
+{ compl := to_dual ∘ hnot ∘ of_dual,
+  himp := λ a b, to_dual (of_dual b \ of_dual a),
+  le_himp_iff := λ a b c, by { rw inf_comm, exact sdiff_le_iff },
+  himp_bot := top_sdiff',
+  ..order_dual.lattice α, ..order_dual.bounded_order α }
+
+@[simp] lemma of_dual_compl (a : αᵒᵈ) : of_dual aᶜ = ￢of_dual a := rfl
+@[simp] lemma of_dual_himp (a b : αᵒᵈ) : of_dual (a ⇨ b) = of_dual b \ of_dual a := rfl
+@[simp] lemma to_dual_hnot (a : α) : to_dual ￢a = (to_dual a)ᶜ := rfl
+@[simp] lemma to_dual_sdiff (a b : α) : to_dual (a \ b) = to_dual b ⇨ to_dual a := rfl
+
+instance prod.coheyting_algebra [coheyting_algebra β] : coheyting_algebra (α × β) :=
+{ sdiff_le_iff := λ a b c, and_congr sdiff_le_iff sdiff_le_iff,
+  top_sdiff := λ a, prod.ext (top_sdiff' a.1) (top_sdiff' a.2),
+  ..prod.lattice α β, ..prod.bounded_order α β, ..prod.has_sdiff, ..prod.has_hnot }
+
+instance pi.coheyting_algebra {α : ι → Type*} [Π i, coheyting_algebra (α i)] :
+  coheyting_algebra (Π i, α i) :=
+by { pi_instance, exact λ a b c, forall_congr (λ i, sdiff_le_iff) }
+
+end coheyting_algebra
+
+section biheyting_algebra
+variables [biheyting_algebra α] {a : α}
+
+lemma compl_le_hnot : aᶜ ≤ ￢a :=
+(disjoint_compl_left : disjoint _ a).le_of_codisjoint codisjoint_hnot_right
+
+end biheyting_algebra
+
+/-- Propositions form a Heyting algebra with implication as Heyting implication and negation as
+complement. -/
+instance Prop.heyting_algebra : heyting_algebra Prop :=
+{ himp := (→),
+  le_himp_iff := λ p q r, and_imp.symm,
+  himp_bot := λ p, rfl,
+  ..Prop.has_compl, ..Prop.distrib_lattice, ..Prop.bounded_order }
+
+@[simp] lemma himp_iff_imp (p q : Prop) : p ⇨ q ↔ p → q := iff.rfl
+@[simp] lemma compl_iff_not (p : Prop) : pᶜ ↔ ¬ p := iff.rfl
+
+/-- A bounded linear order is a bi-Heyting algebra by setting
+* `a ⇨ b = ⊤` if `a ≤ b` and `a ⇨ b = b` otherwise.
+* `a \ b = ⊥` if `a ≤ b` and `a \ b = a` otherwise. -/
+@[reducible] -- See note [reducible non-instances]
+def linear_order.to_biheyting_algebra [linear_order α] [bounded_order α] : biheyting_algebra α :=
+{ himp := λ a b, if a ≤ b then ⊤ else b,
+  compl := λ a, if a = ⊥ then ⊤ else ⊥,
+  le_himp_iff := λ a b c, begin
+    change _ ≤ ite _ _ _ ↔ _,
+    split_ifs,
+    { exact iff_of_true le_top (inf_le_of_right_le h) },
+    { rw [inf_le_iff, or_iff_left h] }
+  end,
+  himp_bot := λ a, if_congr le_bot_iff rfl rfl,
+  sdiff := λ a b, if a ≤ b then ⊥ else a,
+  hnot := λ a, if a = ⊤ then ⊥ else ⊤,
+  sdiff_le_iff := λ a b c, begin
+    change ite _ _ _ ≤ _ ↔ _,
+    split_ifs,
+    { exact iff_of_true bot_le (le_sup_of_le_left h) },
+    { rw [le_sup_iff, or_iff_right h] }
+  end,
+  top_sdiff := λ a, if_congr top_le_iff rfl rfl,
+  ..linear_order.to_lattice, ..‹bounded_order α› }
+
+section lift
+
+/-- Pullback a `generalized_heyting_algebra` along an injection. -/
+@[reducible] -- See note [reducible non-instances]
+protected def function.injective.generalized_heyting_algebra [has_sup α] [has_inf α] [has_top α]
+  [has_himp α] [generalized_heyting_algebra β] (f : α → β) (hf : injective f)
+  (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b)
+  (map_top : f ⊤ = ⊤) (map_himp : ∀ a b, f (a ⇨ b) = f a ⇨ f b) :
+  generalized_heyting_algebra α :=
+{ le_top := λ a, by { change f _ ≤ _, rw map_top, exact le_top },
+  le_himp_iff := λ a b c, by { change f _ ≤ _ ↔ f _ ≤ _, erw [map_himp, map_inf, le_himp_iff] },
+  ..hf.lattice f map_sup map_inf, ..‹has_top α›, ..‹has_himp α› }
+
+/-- Pullback a `generalized_coheyting_algebra` along an injection. -/
+@[reducible] -- See note [reducible non-instances]
+protected def function.injective.generalized_coheyting_algebra [has_sup α] [has_inf α] [has_bot α]
+  [has_sdiff α] [generalized_coheyting_algebra β] (f : α → β) (hf : injective f)
+  (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b)
+  (map_bot : f ⊥ = ⊥) (map_sdiff : ∀ a b, f (a \ b) = f a \ f b) :
+  generalized_coheyting_algebra α :=
+{ bot_le := λ a, by { change f _ ≤ _, rw map_bot, exact bot_le },
+  sdiff_le_iff := λ a b c, by { change f _ ≤ _ ↔ f _ ≤ _, erw [map_sdiff, map_sup, sdiff_le_iff] },
+  ..hf.lattice f map_sup map_inf, ..‹has_bot α›, ..‹has_sdiff α› }
+
+/-- Pullback a `heyting_algebra` along an injection. -/
+@[reducible] -- See note [reducible non-instances]
+protected def function.injective.heyting_algebra [has_sup α] [has_inf α] [has_top α] [has_bot α]
+  [has_compl α] [has_himp α] [heyting_algebra β] (f : α → β) (hf : injective f)
+  (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b)
+  (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥) (map_compl : ∀ a, f aᶜ = (f a)ᶜ)
+  (map_himp : ∀ a b, f (a ⇨ b) = f a ⇨ f b) :
+  heyting_algebra α :=
+{ bot_le := λ a, by { change f _ ≤ _, rw map_bot, exact bot_le },
+  himp_bot := λ a, hf $ by erw [map_himp, map_compl, map_bot, himp_bot],
+  ..hf.generalized_heyting_algebra f map_sup map_inf map_top map_himp,
+  ..‹has_bot α›, ..‹has_compl α› }
+
+/-- Pullback a `coheyting_algebra` along an injection. -/
+@[reducible] -- See note [reducible non-instances]
+protected def function.injective.coheyting_algebra [has_sup α] [has_inf α] [has_top α] [has_bot α]
+  [has_hnot α] [has_sdiff α] [coheyting_algebra β] (f : α → β) (hf : injective f)
+  (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b) (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b)
+  (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥) (map_hnot : ∀ a, f ￢a = ￢f a)
+  (map_sdiff : ∀ a b, f (a \ b) = f a \ f b) :
+  coheyting_algebra α :=
+{ le_top := λ a, by { change f _ ≤ _, rw map_top, exact le_top },
+  top_sdiff := λ a, hf $ by erw [map_sdiff, map_hnot, map_top, top_sdiff'],
+  ..hf.generalized_coheyting_algebra f map_sup map_inf map_bot map_sdiff,
+  ..‹has_top α›, ..‹has_hnot α› }
+
+/-- Pullback a `biheyting_algebra` along an injection. -/
+@[reducible] -- See note [reducible non-instances]
+protected def function.injective.biheyting_algebra [has_sup α] [has_inf α] [has_top α] [has_bot α]
+  [has_compl α] [has_hnot α] [has_himp α] [has_sdiff α] [biheyting_algebra β] (f : α → β)
+  (hf : injective f) (map_sup : ∀ a b, f (a ⊔ b) = f a ⊔ f b)
+  (map_inf : ∀ a b, f (a ⊓ b) = f a ⊓ f b) (map_top : f ⊤ = ⊤) (map_bot : f ⊥ = ⊥)
+  (map_compl : ∀ a, f aᶜ = (f a)ᶜ) (map_hnot : ∀ a, f ￢a = ￢f a)
+  (map_himp : ∀ a b, f (a ⇨ b) = f a ⇨ f b) (map_sdiff : ∀ a b, f (a \ b) = f a \ f b) :
+  biheyting_algebra α :=
+{ ..hf.heyting_algebra f map_sup map_inf map_top map_bot map_compl map_himp,
+  ..hf.coheyting_algebra f map_sup map_inf map_top map_bot map_hnot map_sdiff }
+
+end lift
+
+namespace punit
+variables (a b : punit.{u+1})
+
+instance : biheyting_algebra punit :=
+by refine_struct
+{ top := star,
+  bot := star,
+  sup := λ _ _, star,
+  inf := λ _ _, star,
+  compl := λ _, star,
+  sdiff := λ _ _, star,
+  hnot := λ _, star,
+  himp := λ _ _, star, ..punit.linear_order };
+    intros; trivial <|> exact subsingleton.elim _ _
+
+@[simp] lemma top_eq : (⊤ : punit) = star := rfl
+@[simp] lemma bot_eq : (⊥ : punit) = star := rfl
+@[simp] lemma sup_eq : a ⊔ b = star := rfl
+@[simp] lemma inf_eq : a ⊓ b = star := rfl
+@[simp] lemma compl_eq : aᶜ = star := rfl
+@[simp] lemma sdiff_eq : a \ b = star := rfl
+@[simp, nolint simp_nf] lemma hnot_eq : ￢a = star := rfl -- eligible for `dsimp`
+@[simp] lemma himp_eq : a ⇨ b = star := rfl
+
+end punit
diff --git a/src/order/heyting/boundary.lean b/src/order/heyting/boundary.lean
new file mode 100644
index 0000000000000..e267bffe81795
--- /dev/null
+++ b/src/order/heyting/boundary.lean
@@ -0,0 +1,117 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.boolean_algebra
+
+/-!
+# Co-Heyting boundary
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation with
+itself. The boundary in the co-Heyting algebra of closed sets coincides with the topological
+boundary.
+
+## Main declarations
+
+* `coheyting.boundary`: Co-Heyting boundary. `coheyting.boundary a = a ⊓ ￢a`
+
+## Notation
+
+`∂ a` is notation for `coheyting.boundary a` in locale `heyting`.
+-/
+
+variables {α : Type*}
+
+namespace coheyting
+variables [coheyting_algebra α] {a b : α}
+
+/-- The boundary of an element of a co-Heyting algebra is the intersection of its Heyting negation
+with itself. Note that this is always `⊥` for a boolean algebra. -/
+def boundary (a : α) : α := a ⊓ ￢a
+
+localized "prefix `∂ `:120 := coheyting.boundary" in heyting
+
+lemma inf_hnot_self (a : α) : a ⊓ ￢a = ∂ a := rfl
+
+lemma boundary_le : ∂ a ≤ a := inf_le_left
+lemma boundary_le_hnot : ∂ a ≤ ￢a := inf_le_right
+
+@[simp] lemma boundary_bot : ∂ (⊥ : α) = ⊥ := bot_inf_eq
+@[simp] lemma boundary_top : ∂ (⊤ : α) = ⊥ := by rw [boundary, hnot_top, inf_bot_eq]
+
+lemma boundary_hnot_le (a : α) : ∂ ￢a ≤ ∂ a := inf_comm.trans_le $ inf_le_inf_right _ hnot_hnot_le
+
+@[simp] lemma boundary_hnot_hnot (a : α) : ∂ ￢￢a = ∂ ￢a :=
+by simp_rw [boundary, hnot_hnot_hnot, inf_comm]
+
+@[simp] lemma hnot_boundary (a : α) : ￢ ∂ a = ⊤ := by rw [boundary, hnot_inf_distrib, sup_hnot_self]
+
+/-- **Leibniz rule** for the co-Heyting boundary. -/
+lemma boundary_inf (a b : α) : ∂ (a ⊓ b) = ∂ a ⊓ b ⊔ a ⊓ ∂ b :=
+by { unfold boundary, rw [hnot_inf_distrib, inf_sup_left, inf_right_comm, ←inf_assoc] }
+
+lemma boundary_inf_le : ∂ (a ⊓ b) ≤ ∂ a ⊔ ∂ b :=
+(boundary_inf _ _).trans_le $ sup_le_sup inf_le_left inf_le_right
+
+lemma boundary_sup_le : ∂ (a ⊔ b) ≤ ∂ a ⊔ ∂ b :=
+begin
+  rw [boundary, inf_sup_right],
+  exact sup_le_sup (inf_le_inf_left _ $ hnot_anti le_sup_left)
+    (inf_le_inf_left _ $ hnot_anti le_sup_right),
+end
+
+/- The intuitionistic version of `coheyting.boundary_le_boundary_sup_sup_boundary_inf_left`. Either
+proof can be obtained from the other using the equivalence of Heyting algebras and intuitionistic
+logic and duality between Heyting and co-Heyting algebras. It is crucial that the following proof be
+intuitionistic. -/
+example (a b : Prop) : ((a ∧ b) ∨ ¬(a ∧ b)) ∧ ((a ∨ b) ∨ ¬ (a ∨ b)) → a ∨ ¬ a :=
+begin
+  rintro ⟨⟨ha, hb⟩ | hnab, (ha | hb) | hnab⟩;
+    try { exact or.inl ha },
+  { exact or.inr (λ ha, hnab ⟨ha, hb⟩) },
+  { exact or.inr (λ ha, hnab $ or.inl ha) }
+end
+
+lemma boundary_le_boundary_sup_sup_boundary_inf_left : ∂ a ≤ ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) :=
+begin
+  simp only [boundary, sup_inf_left, sup_inf_right, sup_right_idem, le_inf_iff, sup_assoc,
+    @sup_comm _ _ _ a],
+  refine ⟨⟨⟨_, _⟩, _⟩, ⟨_, _⟩, _⟩;
+    try { exact le_sup_of_le_left inf_le_left };
+    refine inf_le_of_right_le _,
+  { rw [hnot_le_iff_codisjoint_right, codisjoint_left_comm],
+    exact codisjoint_hnot_left },
+  { refine le_sup_of_le_right _,
+    rw hnot_le_iff_codisjoint_right,
+    exact codisjoint_hnot_right.mono_right (hnot_anti inf_le_left) }
+end
+
+lemma boundary_le_boundary_sup_sup_boundary_inf_right : ∂ b ≤ ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) :=
+by { rw [@sup_comm _ _ a, inf_comm], exact boundary_le_boundary_sup_sup_boundary_inf_left }
+
+lemma boundary_sup_sup_boundary_inf (a b : α) : ∂ (a ⊔ b) ⊔ ∂ (a ⊓ b) = ∂ a ⊔ ∂ b :=
+le_antisymm (sup_le boundary_sup_le boundary_inf_le) $ sup_le
+  boundary_le_boundary_sup_sup_boundary_inf_left boundary_le_boundary_sup_sup_boundary_inf_right
+
+@[simp] lemma boundary_idem (a : α) : ∂ ∂ a = ∂ a := by rw [boundary, hnot_boundary, inf_top_eq]
+
+lemma hnot_hnot_sup_boundary (a : α) : ￢￢a ⊔ ∂ a = a :=
+by { rw [boundary, sup_inf_left, hnot_sup_self, inf_top_eq, sup_eq_right], exact hnot_hnot_le }
+
+lemma hnot_eq_top_iff_exists_boundary : ￢a = ⊤ ↔ ∃ b, ∂ b = a :=
+⟨λ h, ⟨a, by rw [boundary, h, inf_top_eq]⟩, by { rintro ⟨b, rfl⟩, exact hnot_boundary _ }⟩
+
+end coheyting
+
+open_locale heyting
+
+section boolean_algebra
+variables [boolean_algebra α]
+
+@[simp] lemma coheyting.boundary_eq_bot (a : α) : ∂ a = ⊥ := inf_compl_eq_bot
+
+end boolean_algebra
diff --git a/src/order/heyting/hom.lean b/src/order/heyting/hom.lean
new file mode 100644
index 0000000000000..a947d251b340a
--- /dev/null
+++ b/src/order/heyting/hom.lean
@@ -0,0 +1,425 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.hom.lattice
+
+/-!
+# Heyting algebra morphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A Heyting homomorphism between two Heyting algebras is a bounded lattice homomorphism that preserves
+Heyting implication.
+
+We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
+be satisfied by itself and all stricter types.
+
+## Types of morphisms
+
+* `heyting_hom`: Heyting homomorphisms.
+* `coheyting_hom`: Co-Heyting homomorphisms.
+* `biheyting_hom`: Bi-Heyting homomorphisms.
+
+## Typeclasses
+
+* `heyting_hom_class`
+* `coheyting_hom_class`
+* `biheyting_hom_class`
+-/
+
+open function
+
+variables {F α β γ δ : Type*}
+
+/-- The type of Heyting homomorphisms from `α` to `β`. Bounded lattice homomorphisms that preserve
+Heyting implication. -/
+@[protect_proj]
+structure heyting_hom (α β : Type*) [heyting_algebra α] [heyting_algebra β]
+  extends lattice_hom α β :=
+(map_bot' : to_fun ⊥ = ⊥)
+(map_himp' : ∀ a b, to_fun (a ⇨ b) = to_fun a ⇨ to_fun b)
+
+/-- The type of co-Heyting homomorphisms from `α` to `β`. Bounded lattice homomorphisms that
+preserve difference. -/
+@[protect_proj]
+structure coheyting_hom (α β : Type*) [coheyting_algebra α] [coheyting_algebra β]
+  extends lattice_hom α β :=
+(map_top' : to_fun ⊤ = ⊤)
+(map_sdiff' : ∀ a b, to_fun (a \ b) = to_fun a \ to_fun b)
+
+/-- The type of bi-Heyting homomorphisms from `α` to `β`. Bounded lattice homomorphisms that
+preserve Heyting implication and difference. -/
+@[protect_proj]
+structure biheyting_hom (α β : Type*) [biheyting_algebra α] [biheyting_algebra β]
+  extends lattice_hom α β :=
+(map_himp' : ∀ a b, to_fun (a ⇨ b) = to_fun a ⇨ to_fun b)
+(map_sdiff' : ∀ a b, to_fun (a \ b) = to_fun a \ to_fun b)
+
+/-- `heyting_hom_class F α β` states that `F` is a type of Heyting homomorphisms.
+
+You should extend this class when you extend `heyting_hom`. -/
+class heyting_hom_class (F : Type*) (α β : out_param $ Type*) [heyting_algebra α]
+  [heyting_algebra β] extends lattice_hom_class F α β :=
+(map_bot (f : F) : f ⊥ = ⊥)
+(map_himp (f : F) : ∀ a b, f (a ⇨ b) = f a ⇨ f b)
+
+/-- `coheyting_hom_class F α β` states that `F` is a type of co-Heyting homomorphisms.
+
+You should extend this class when you extend `coheyting_hom`. -/
+class coheyting_hom_class (F : Type*) (α β : out_param $ Type*) [coheyting_algebra α]
+  [coheyting_algebra β] extends lattice_hom_class F α β :=
+(map_top (f : F) : f ⊤ = ⊤)
+(map_sdiff (f : F) : ∀ a b, f (a \ b) = f a \ f b)
+
+/-- `biheyting_hom_class F α β` states that `F` is a type of bi-Heyting homomorphisms.
+
+You should extend this class when you extend `biheyting_hom`. -/
+class biheyting_hom_class (F : Type*) (α β : out_param $ Type*) [biheyting_algebra α]
+  [biheyting_algebra β] extends lattice_hom_class F α β :=
+(map_himp (f : F) : ∀ a b, f (a ⇨ b) = f a ⇨ f b)
+(map_sdiff (f : F) : ∀ a b, f (a \ b) = f a \ f b)
+
+export heyting_hom_class (map_himp)
+export coheyting_hom_class (map_sdiff)
+
+attribute [simp] map_himp map_sdiff
+
+@[priority 100] -- See note [lower instance priority]
+instance heyting_hom_class.to_bounded_lattice_hom_class [heyting_algebra α] [heyting_algebra β]
+  [heyting_hom_class F α β] : bounded_lattice_hom_class F α β :=
+{ map_top := λ f, by rw [←@himp_self α _ ⊥, ←himp_self, map_himp],
+  ..‹heyting_hom_class F α β› }
+
+@[priority 100] -- See note [lower instance priority]
+instance coheyting_hom_class.to_bounded_lattice_hom_class [coheyting_algebra α]
+  [coheyting_algebra β] [coheyting_hom_class F α β] : bounded_lattice_hom_class F α β :=
+{ map_bot := λ f, by rw [←@sdiff_self α _ ⊤, ←sdiff_self, map_sdiff],
+  ..‹coheyting_hom_class F α β› }
+
+@[priority 100] -- See note [lower instance priority]
+instance biheyting_hom_class.to_heyting_hom_class [biheyting_algebra α] [biheyting_algebra β]
+  [biheyting_hom_class F α β] :
+  heyting_hom_class F α β :=
+{ map_bot := λ f, by rw [←@sdiff_self α _ ⊤, ←sdiff_self, biheyting_hom_class.map_sdiff],
+  ..‹biheyting_hom_class F α β› }
+
+@[priority 100] -- See note [lower instance priority]
+instance biheyting_hom_class.to_coheyting_hom_class [biheyting_algebra α] [biheyting_algebra β]
+  [biheyting_hom_class F α β] :
+  coheyting_hom_class F α β :=
+{ map_top := λ f, by rw [←@himp_self α _ ⊥, ←himp_self, map_himp],
+  ..‹biheyting_hom_class F α β› }
+
+@[priority 100] -- See note [lower instance priority]
+instance order_iso_class.to_heyting_hom_class [heyting_algebra α] [heyting_algebra β]
+  [order_iso_class F α β] :
+  heyting_hom_class F α β :=
+{ map_himp := λ f a b, eq_of_forall_le_iff $ λ c,
+    by { simp only [←map_inv_le_iff, le_himp_iff], rw ←order_iso_class.map_le_map_iff f, simp },
+  ..order_iso_class.to_bounded_lattice_hom_class }
+
+@[priority 100] -- See note [lower instance priority]
+instance order_iso_class.to_coheyting_hom_class [coheyting_algebra α] [coheyting_algebra β]
+  [order_iso_class F α β] :
+  coheyting_hom_class F α β :=
+{ map_sdiff := λ f a b, eq_of_forall_ge_iff $ λ c,
+    by { simp only [←le_map_inv_iff, sdiff_le_iff], rw ←order_iso_class.map_le_map_iff f, simp },
+  ..order_iso_class.to_bounded_lattice_hom_class }
+
+@[priority 100] -- See note [lower instance priority]
+instance order_iso_class.to_biheyting_hom_class [biheyting_algebra α] [biheyting_algebra β]
+  [order_iso_class F α β] :
+  biheyting_hom_class F α β :=
+{ map_himp := λ f a b, eq_of_forall_le_iff $ λ c,
+    by { simp only [←map_inv_le_iff, le_himp_iff], rw ←order_iso_class.map_le_map_iff f, simp },
+  map_sdiff := λ f a b, eq_of_forall_ge_iff $ λ c,
+    by { simp only [←le_map_inv_iff, sdiff_le_iff], rw ←order_iso_class.map_le_map_iff f, simp },
+  ..order_iso_class.to_lattice_hom_class }
+
+/-- This can't be an instance because of typeclass loops. -/
+@[reducible] -- See note [reducible non instances]
+def bounded_lattice_hom_class.to_biheyting_hom_class [boolean_algebra α] [boolean_algebra β]
+  [bounded_lattice_hom_class F α β] :
+  biheyting_hom_class F α β :=
+{ map_himp := λ f a b, by rw [himp_eq, himp_eq, map_sup, (is_compl_compl.map _).compl_eq],
+  map_sdiff := λ f a b, by rw [sdiff_eq, sdiff_eq, map_inf, (is_compl_compl.map _).compl_eq],
+   ..‹bounded_lattice_hom_class F α β› }
+
+section heyting_algebra
+variables [heyting_algebra α] [heyting_algebra β] [heyting_hom_class F α β] (f : F)
+include β
+
+@[simp] lemma map_compl (a : α) : f aᶜ = (f a)ᶜ := by rw [←himp_bot, ←himp_bot, map_himp, map_bot]
+
+@[simp] lemma map_bihimp (a b : α) : f (a ⇔ b) = f a ⇔ f b :=
+by simp_rw [bihimp, map_inf, map_himp]
+
+-- TODO: `map_bihimp`
+
+end heyting_algebra
+
+section coheyting_algebra
+variables [coheyting_algebra α] [coheyting_algebra β] [coheyting_hom_class F α β] (f : F)
+include β
+
+@[simp] lemma map_hnot (a : α) : f ￢a = ￢f a :=
+by rw [←top_sdiff', ←top_sdiff', map_sdiff, map_top]
+
+@[simp] lemma map_symm_diff (a b : α) : f (a ∆ b) = f a ∆ f b :=
+by simp_rw [symm_diff, map_sup, map_sdiff]
+
+end coheyting_algebra
+
+instance [heyting_algebra α] [heyting_algebra β] [heyting_hom_class F α β] :
+  has_coe_t F (heyting_hom α β) :=
+⟨λ f, { to_fun := f,
+        map_sup' := map_sup f,
+        map_inf' := map_inf f,
+        map_bot' := map_bot f,
+        map_himp' := map_himp f }⟩
+
+instance [coheyting_algebra α] [coheyting_algebra β] [coheyting_hom_class F α β] :
+  has_coe_t F (coheyting_hom α β) :=
+⟨λ f, { to_fun := f,
+        map_sup' := map_sup f,
+        map_inf' := map_inf f,
+        map_top' := map_top f,
+        map_sdiff' := map_sdiff f }⟩
+
+instance [biheyting_algebra α] [biheyting_algebra β] [biheyting_hom_class F α β] :
+  has_coe_t F (biheyting_hom α β) :=
+⟨λ f, { to_fun := f,
+        map_sup' := map_sup f,
+        map_inf' := map_inf f,
+        map_himp' := map_himp f,
+        map_sdiff' := map_sdiff f }⟩
+
+namespace heyting_hom
+variables [heyting_algebra α] [heyting_algebra β] [heyting_algebra γ] [heyting_algebra δ]
+
+instance : heyting_hom_class (heyting_hom α β) α β :=
+{ coe := λ f, f.to_fun,
+  coe_injective' := λ f g h, by obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := f; obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := g; congr',
+  map_sup := λ f, f.map_sup',
+  map_inf := λ f, f.map_inf',
+  map_bot := λ f, f.map_bot',
+  map_himp := heyting_hom.map_himp' }
+
+/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
+directly. -/
+instance : has_coe_to_fun (heyting_hom α β) (λ _, α → β) := fun_like.has_coe_to_fun
+
+@[simp] lemma to_fun_eq_coe {f : heyting_hom α β} : f.to_fun = (f : α → β) := rfl
+
+@[ext] lemma ext {f g : heyting_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
+
+/-- Copy of a `heyting_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
+equalities. -/
+protected def copy (f : heyting_hom α β) (f' : α → β) (h : f' = f) : heyting_hom α β :=
+{ to_fun := f',
+  map_sup' := by simpa only [h] using map_sup f,
+  map_inf' := by simpa only [h] using map_inf f,
+  map_bot' := by simpa only [h] using map_bot f,
+  map_himp' := by simpa only [h] using map_himp f }
+
+@[simp] lemma coe_copy (f : heyting_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : heyting_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
+variables (α)
+
+/-- `id` as a `heyting_hom`. -/
+protected def id : heyting_hom α α :=
+{ to_lattice_hom := lattice_hom.id _,
+  map_himp' := λ a b, rfl,
+  ..bot_hom.id _ }
+
+@[simp] lemma coe_id : ⇑(heyting_hom.id α) = id := rfl
+
+variables {α}
+
+@[simp] lemma id_apply (a : α) : heyting_hom.id α a = a := rfl
+
+instance : inhabited (heyting_hom α α) := ⟨heyting_hom.id _⟩
+
+instance : partial_order (heyting_hom α β) := partial_order.lift _ fun_like.coe_injective
+
+/-- Composition of `heyting_hom`s as a `heyting_hom`. -/
+def comp (f : heyting_hom β γ) (g : heyting_hom α β) : heyting_hom α γ :=
+{ to_fun := f ∘ g,
+  map_bot' := by simp,
+  map_himp' := λ a b, by simp,
+  ..f.to_lattice_hom.comp g.to_lattice_hom }
+
+variables {f f₁ f₂ : heyting_hom α β} {g g₁ g₂ : heyting_hom β γ}
+
+@[simp] lemma coe_comp (f : heyting_hom β γ) (g : heyting_hom α β) : ⇑(f.comp g) = f ∘ g := rfl
+@[simp] lemma comp_apply (f : heyting_hom β γ) (g : heyting_hom α β) (a : α) :
+ f.comp g a = f (g a) := rfl
+@[simp] lemma comp_assoc (f : heyting_hom γ δ) (g : heyting_hom β γ) (h : heyting_hom α β) :
+  (f.comp g).comp h = f.comp (g.comp h) := rfl
+@[simp] lemma comp_id (f : heyting_hom α β) : f.comp (heyting_hom.id α) = f := ext $ λ a, rfl
+@[simp] lemma id_comp (f : heyting_hom α β) : (heyting_hom.id β).comp f = f := ext $ λ a, rfl
+
+lemma cancel_right (hf : surjective f) : g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
+⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩
+
+lemma cancel_left (hg : injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
+⟨λ h, heyting_hom.ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩
+
+end heyting_hom
+
+namespace coheyting_hom
+variables [coheyting_algebra α] [coheyting_algebra β] [coheyting_algebra γ] [coheyting_algebra δ]
+
+instance : coheyting_hom_class (coheyting_hom α β) α β :=
+{ coe := λ f, f.to_fun,
+  coe_injective' := λ f g h, by obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := f; obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := g; congr',
+  map_sup := λ f, f.map_sup',
+  map_inf := λ f, f.map_inf',
+  map_top := λ f, f.map_top',
+  map_sdiff := coheyting_hom.map_sdiff' }
+
+/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
+directly. -/
+instance : has_coe_to_fun (coheyting_hom α β) (λ _, α → β) := fun_like.has_coe_to_fun
+
+@[simp] lemma to_fun_eq_coe {f : coheyting_hom α β} : f.to_fun = (f : α → β) := rfl
+
+@[ext] lemma ext {f g : coheyting_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
+
+/-- Copy of a `coheyting_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
+equalities. -/
+protected def copy (f : coheyting_hom α β) (f' : α → β) (h : f' = f) : coheyting_hom α β :=
+{ to_fun := f',
+  map_sup' := by simpa only [h] using map_sup f,
+  map_inf' := by simpa only [h] using map_inf f,
+  map_top' := by simpa only [h] using map_top f,
+  map_sdiff' := by simpa only [h] using map_sdiff f }
+
+@[simp]
+lemma coe_copy (f : coheyting_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+
+lemma copy_eq (f : coheyting_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
+variables (α)
+
+/-- `id` as a `coheyting_hom`. -/
+protected def id : coheyting_hom α α :=
+{ to_lattice_hom := lattice_hom.id _,
+  map_sdiff' := λ a b, rfl,
+  ..top_hom.id _ }
+
+@[simp] lemma coe_id : ⇑(coheyting_hom.id α) = id := rfl
+
+variables {α}
+
+@[simp] lemma id_apply (a : α) : coheyting_hom.id α a = a := rfl
+
+instance : inhabited (coheyting_hom α α) := ⟨coheyting_hom.id _⟩
+
+instance : partial_order (coheyting_hom α β) := partial_order.lift _ fun_like.coe_injective
+
+/-- Composition of `coheyting_hom`s as a `coheyting_hom`. -/
+def comp (f : coheyting_hom β γ) (g : coheyting_hom α β) : coheyting_hom α γ :=
+{ to_fun := f ∘ g,
+  map_top' := by simp,
+  map_sdiff' := λ a b, by simp,
+  ..f.to_lattice_hom.comp g.to_lattice_hom }
+
+variables {f f₁ f₂ : coheyting_hom α β} {g g₁ g₂ : coheyting_hom β γ}
+
+@[simp] lemma coe_comp (f : coheyting_hom β γ) (g : coheyting_hom α β) : ⇑(f.comp g) = f ∘ g := rfl
+@[simp] lemma comp_apply (f : coheyting_hom β γ) (g : coheyting_hom α β) (a : α) :
+ f.comp g a = f (g a) := rfl
+@[simp] lemma comp_assoc (f : coheyting_hom γ δ) (g : coheyting_hom β γ) (h : coheyting_hom α β) :
+  (f.comp g).comp h = f.comp (g.comp h) := rfl
+@[simp] lemma comp_id (f : coheyting_hom α β) : f.comp (coheyting_hom.id α) = f := ext $ λ a, rfl
+@[simp] lemma id_comp (f : coheyting_hom α β) : (coheyting_hom.id β).comp f = f := ext $ λ a, rfl
+
+lemma cancel_right (hf : surjective f) : g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
+⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩
+
+lemma cancel_left (hg : injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
+⟨λ h, coheyting_hom.ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩
+
+end coheyting_hom
+
+
+namespace biheyting_hom
+variables [biheyting_algebra α] [biheyting_algebra β] [biheyting_algebra γ] [biheyting_algebra δ]
+
+instance : biheyting_hom_class (biheyting_hom α β) α β :=
+{ coe := λ f, f.to_fun,
+  coe_injective' := λ f g h, by obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := f; obtain ⟨⟨⟨_, _⟩, _⟩, _⟩ := g; congr',
+  map_sup := λ f, f.map_sup',
+  map_inf := λ f, f.map_inf',
+  map_himp := λ f, f.map_himp',
+  map_sdiff := λ f, f.map_sdiff' }
+
+/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
+directly. -/
+instance : has_coe_to_fun (biheyting_hom α β) (λ _, α → β) := fun_like.has_coe_to_fun
+
+@[simp] lemma to_fun_eq_coe {f : biheyting_hom α β} : f.to_fun = (f : α → β) := rfl
+
+@[ext] lemma ext {f g : biheyting_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
+
+/-- Copy of a `biheyting_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
+equalities. -/
+protected def copy (f : biheyting_hom α β) (f' : α → β) (h : f' = f) : biheyting_hom α β :=
+{ to_fun := f',
+  map_sup' := by simpa only [h] using map_sup f,
+  map_inf' := by simpa only [h] using map_inf f,
+  map_himp' := by simpa only [h] using map_himp f,
+  map_sdiff' := by simpa only [h] using map_sdiff f }
+
+@[simp] lemma coe_copy (f : biheyting_hom α β) (f' : α → β) (h : f' = f) :
+  ⇑(f.copy f' h) = f' :=
+rfl
+
+lemma copy_eq (f : biheyting_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
+variables (α)
+
+/-- `id` as a `biheyting_hom`. -/
+protected def id : biheyting_hom α α :=
+{ to_lattice_hom := lattice_hom.id _,
+  ..heyting_hom.id _, ..coheyting_hom.id _ }
+
+@[simp] lemma coe_id : ⇑(biheyting_hom.id α) = id := rfl
+
+variables {α}
+
+@[simp] lemma id_apply (a : α) : biheyting_hom.id α a = a := rfl
+
+instance : inhabited (biheyting_hom α α) := ⟨biheyting_hom.id _⟩
+
+instance : partial_order (biheyting_hom α β) := partial_order.lift _ fun_like.coe_injective
+
+/-- Composition of `biheyting_hom`s as a `biheyting_hom`. -/
+def comp (f : biheyting_hom β γ) (g : biheyting_hom α β) : biheyting_hom α γ :=
+{ to_fun := f ∘ g,
+  map_himp' := λ a b, by simp,
+  map_sdiff' := λ a b, by simp,
+  ..f.to_lattice_hom.comp g.to_lattice_hom }
+
+variables {f f₁ f₂ : biheyting_hom α β} {g g₁ g₂ : biheyting_hom β γ}
+
+@[simp] lemma coe_comp (f : biheyting_hom β γ) (g : biheyting_hom α β) : ⇑(f.comp g) = f ∘ g := rfl
+@[simp] lemma comp_apply (f : biheyting_hom β γ) (g : biheyting_hom α β) (a : α) :
+ f.comp g a = f (g a) := rfl
+@[simp] lemma comp_assoc (f : biheyting_hom γ δ) (g : biheyting_hom β γ) (h : biheyting_hom α β) :
+  (f.comp g).comp h = f.comp (g.comp h) := rfl
+@[simp] lemma comp_id (f : biheyting_hom α β) : f.comp (biheyting_hom.id α) = f := ext $ λ a, rfl
+@[simp] lemma id_comp (f : biheyting_hom α β) : (biheyting_hom.id β).comp f = f := ext $ λ a, rfl
+
+lemma cancel_right (hf : surjective f) : g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
+⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩
+
+lemma cancel_left (hg : injective g) : g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
+⟨λ h, biheyting_hom.ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩
+
+end biheyting_hom
diff --git a/src/order/heyting/regular.lean b/src/order/heyting/regular.lean
new file mode 100644
index 0000000000000..321537b802e76
--- /dev/null
+++ b/src/order/heyting/regular.lean
@@ -0,0 +1,160 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.galois_connection
+
+/-!
+# Heyting regular elements
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines Heyting regular elements, elements of an Heyting algebra that are their own double
+complement, and proves that they form a boolean algebra.
+
+From a logic standpoint, this means that we can perform classical logic within intuitionistic logic
+by simply double-negating all propositions. This is practical for synthetic computability theory.
+
+## Main declarations
+
+* `is_regular`: `a` is Heyting-regular if `aᶜᶜ = a`.
+* `regular`: The subtype of Heyting-regular elements.
+* `regular.boolean_algebra`: Heyting-regular elements form a boolean algebra.
+
+## References
+
+* [Francis Borceux, *Handbook of Categorical Algebra III*][borceux-vol3]
+-/
+
+open function
+
+variables {α : Type*}
+
+namespace heyting
+section has_compl
+variables [has_compl α] {a : α}
+
+/-- An element of an Heyting algebra is regular if its double complement is itself. -/
+def is_regular (a : α) : Prop := aᶜᶜ = a
+
+protected lemma is_regular.eq : is_regular a → aᶜᶜ = a := id
+
+instance is_regular.decidable_pred [decidable_eq α] : @decidable_pred α is_regular :=
+λ _, ‹decidable_eq α› _ _
+
+end has_compl
+
+section heyting_algebra
+variables [heyting_algebra α] {a b : α}
+
+lemma is_regular_bot : is_regular (⊥ : α) := by rw [is_regular, compl_bot, compl_top]
+lemma is_regular_top : is_regular (⊤ : α) := by rw [is_regular, compl_top, compl_bot]
+
+lemma is_regular.inf (ha : is_regular a) (hb : is_regular b) : is_regular (a ⊓ b) :=
+by rw [is_regular, compl_compl_inf_distrib, ha.eq, hb.eq]
+
+lemma is_regular.himp (ha : is_regular a) (hb : is_regular b) : is_regular (a ⇨ b) :=
+by rw [is_regular, compl_compl_himp_distrib, ha.eq, hb.eq]
+
+lemma is_regular_compl (a : α) : is_regular aᶜ := compl_compl_compl _
+
+protected lemma is_regular.disjoint_compl_left_iff (ha : is_regular a) : disjoint aᶜ b ↔ b ≤ a :=
+by rw [←le_compl_iff_disjoint_left, ha.eq]
+
+protected lemma is_regular.disjoint_compl_right_iff (hb : is_regular b) : disjoint a bᶜ ↔ a ≤ b :=
+by rw [←le_compl_iff_disjoint_right, hb.eq]
+
+/-- A Heyting algebra with regular excluded middle is a boolean algebra. -/
+@[reducible] -- See note [reducible non-instances]
+def _root_.boolean_algebra.of_regular (h : ∀ a : α, is_regular (a ⊔ aᶜ)) : boolean_algebra α :=
+have ∀ a : α, is_compl a aᶜ := λ a, ⟨disjoint_compl_right, codisjoint_iff.2 $
+  by erw [←(h a).eq, compl_sup, inf_compl_eq_bot, compl_bot]⟩,
+{ himp_eq := λ a b, eq_of_forall_le_iff $ λ c,
+    le_himp_iff.trans ((this _).le_sup_right_iff_inf_left_le).symm,
+  inf_compl_le_bot := λ a, (this _).1.le_bot,
+  top_le_sup_compl := λ a, (this _).2.top_le,
+  ..‹heyting_algebra α›, ..generalized_heyting_algebra.to_distrib_lattice }
+
+variables (α)
+
+/-- The boolean algebra of Heyting regular elements. -/
+def regular : Type* := {a : α // is_regular a}
+
+variables {α}
+
+namespace regular
+
+instance : has_coe (regular α) α := coe_subtype
+
+lemma coe_injective : injective (coe : regular α → α) := subtype.coe_injective
+@[simp] lemma coe_inj {a b : regular α} : (a : α) = b ↔ a = b := subtype.coe_inj
+
+instance : has_top (regular α) := ⟨⟨⊤, is_regular_top⟩⟩
+instance : has_bot (regular α) := ⟨⟨⊥, is_regular_bot⟩⟩
+instance : has_inf (regular α) := ⟨λ a b, ⟨a ⊓ b, a.2.inf b.2⟩⟩
+instance : has_himp (regular α) := ⟨λ a b, ⟨a ⇨ b, a.2.himp b.2⟩⟩
+instance : has_compl (regular α) := ⟨λ a, ⟨aᶜ, is_regular_compl _⟩⟩
+
+@[simp, norm_cast] lemma coe_top : ((⊤ : regular α) : α) = ⊤ := rfl
+@[simp, norm_cast] lemma coe_bot : ((⊥ : regular α) : α) = ⊥ := rfl
+@[simp, norm_cast] lemma coe_inf (a b : regular α) : (↑(a ⊓ b) : α) = a ⊓ b := rfl
+@[simp, norm_cast] lemma coe_himp (a b : regular α) : (↑(a ⇨ b) : α) = a ⇨ b := rfl
+@[simp, norm_cast] lemma coe_compl (a : regular α) : (↑(aᶜ) : α) = aᶜ := rfl
+
+instance : inhabited (regular α) := ⟨⊥⟩
+instance : semilattice_inf (regular α) := coe_injective.semilattice_inf _ coe_inf
+instance : bounded_order (regular α) := bounded_order.lift coe (λ _ _, id) coe_top coe_bot
+
+@[simp, norm_cast] lemma coe_le_coe {a b : regular α} : (a : α) ≤ b ↔ a ≤ b := iff.rfl
+@[simp, norm_cast] lemma coe_lt_coe {a b : regular α} : (a : α) < b ↔ a < b := iff.rfl
+
+/-- **Regularization** of `a`. The smallest regular element greater than `a`. -/
+def to_regular : α →o regular α :=
+⟨λ a, ⟨aᶜᶜ, is_regular_compl _⟩, λ a b h, coe_le_coe.1 $ compl_le_compl $ compl_le_compl h⟩
+
+@[simp, norm_cast] lemma coe_to_regular (a : α) : (to_regular a : α) = aᶜᶜ := rfl
+@[simp] lemma to_regular_coe (a : regular α) : to_regular (a : α) = a := coe_injective a.2
+
+/-- The Galois insertion between `regular.to_regular` and `coe`. -/
+def gi : galois_insertion to_regular (coe : regular α → α) :=
+{ choice := λ a ha, ⟨a, ha.antisymm le_compl_compl⟩,
+  gc := λ a b, coe_le_coe.symm.trans $
+    ⟨le_compl_compl.trans, λ h, (compl_anti $ compl_anti h).trans_eq b.2⟩,
+  le_l_u := λ _, le_compl_compl,
+  choice_eq := λ a ha, coe_injective $ le_compl_compl.antisymm ha }
+
+instance : lattice (regular α) := gi.lift_lattice
+
+@[simp, norm_cast] lemma coe_sup (a b : regular α) : (↑(a ⊔ b) : α) = (a ⊔ b)ᶜᶜ := rfl
+
+instance : boolean_algebra (regular α) :=
+{ le_sup_inf := λ a b c, coe_le_coe.1 $ by { dsimp, rw [sup_inf_left, compl_compl_inf_distrib] },
+  inf_compl_le_bot := λ a, coe_le_coe.1 $ disjoint_iff_inf_le.1 disjoint_compl_right,
+  top_le_sup_compl := λ a, coe_le_coe.1 $
+    by { dsimp, rw [compl_sup, inf_compl_eq_bot, compl_bot], refl },
+  himp_eq := λ a b, coe_injective begin
+    dsimp,
+    rw [compl_sup, a.prop.eq],
+    refine eq_of_forall_le_iff (λ c, le_himp_iff.trans _),
+    rw [le_compl_iff_disjoint_right, disjoint_left_comm, b.prop.disjoint_compl_left_iff],
+  end,
+  ..regular.lattice, ..regular.bounded_order, ..regular.has_himp,
+  ..regular.has_compl }
+
+@[simp, norm_cast] lemma coe_sdiff (a b : regular α) : (↑(a \ b) : α) = a ⊓ bᶜ := rfl
+
+end regular
+end heyting_algebra
+
+variables [boolean_algebra α]
+
+lemma is_regular_of_boolean : ∀ a : α, is_regular a := compl_compl
+
+/-- A decidable proposition is intuitionistically Heyting-regular. -/
+@[nolint decidable_classical]
+lemma is_regular_of_decidable (p : Prop) [decidable p] : is_regular p :=
+propext $ decidable.not_not_iff _
+
+end heyting
diff --git a/src/order/hom/basic.lean b/src/order/hom/basic.lean
index 5db3beb839b61..ee8351a2f7e71 100644
--- a/src/order/hom/basic.lean
+++ b/src/order/hom/basic.lean
@@ -4,12 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 import logic.equiv.option
-import order.rel_iso
+import order.rel_iso.basic
 import tactic.monotonicity.basic
+import tactic.assert_exists
+import order.disjoint
 
 /-!
 # Order homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines order homomorphisms, which are bundled monotone functions. A preorder
 homomorphism `f : α →o β` is a function `α → β` along with a proof that `∀ x y, x ≤ y → f x ≤ f y`.
 
@@ -90,6 +95,9 @@ abbreviation order_iso (α β : Type*) [has_le α] [has_le β] := @rel_iso α β
 
 infix ` ≃o `:25 := order_iso
 
+section
+set_option old_structure_cmd true
+
 /-- `order_hom_class F α b` asserts that `F` is a type of `≤`-preserving morphisms. -/
 abbreviation order_hom_class (F : Type*) (α β : out_param Type*) [has_le α] [has_le β] :=
 rel_hom_class F ((≤) : α → α → Prop) ((≤) : β → β → Prop)
@@ -101,6 +109,8 @@ class order_iso_class (F : Type*) (α β : out_param Type*) [has_le α] [has_le
   extends equiv_like F α β :=
 (map_le_map_iff (f : F) {a b : α} : f a ≤ f b ↔ a ≤ b)
 
+end
+
 export order_iso_class (map_le_map_iff)
 
 attribute [simp] map_le_map_iff
@@ -172,16 +182,19 @@ instance : order_hom_class (α →o β) α β :=
 @[ext] -- See library note [partially-applied ext lemmas]
 lemma ext (f g : α →o β) (h : (f : α → β) = g) : f = g := fun_like.coe_injective h
 
+lemma coe_eq (f : α →o β) : coe f = f := by ext ; refl
+
 /-- One can lift an unbundled monotone function to a bundled one. -/
-instance : can_lift (α → β) (α →o β) :=
-{ coe := coe_fn,
-  cond := monotone,
-  prf := λ f h, ⟨⟨f, h⟩, rfl⟩ }
+instance : can_lift (α → β) (α →o β) coe_fn monotone :=
+{ prf := λ f h, ⟨⟨f, h⟩, rfl⟩ }
 
 /-- Copy of an `order_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
 equalities. -/
 protected def copy (f : α →o β) (f' : α → β) (h : f' = f) : α →o β := ⟨f', h.symm.subst f.monotone'⟩
 
+@[simp] lemma coe_copy (f : α →o β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : α →o β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 /-- The identity function as bundled monotone function. -/
 @[simps {fully_applied := ff}]
 def id : α →o α := ⟨id, monotone_id⟩
@@ -335,10 +348,8 @@ maps `Π i, α →o π i`. -/
 def subtype.val (p : α → Prop) : subtype p →o α :=
 ⟨subtype.val, λ x y h, h⟩
 
--- TODO[gh-6025]: make this a global instance once safe to do so
 /-- There is a unique monotone map from a subsingleton to itself. -/
-local attribute [instance]
-def unique [subsingleton α] : unique (α →o α) :=
+instance unique [subsingleton α] : unique (α →o α) :=
 { default := order_hom.id, uniq := λ a, ext _ _ (subsingleton.elim _ _) }
 
 lemma order_hom_eq_id [subsingleton α] (g : α →o α) : g = order_hom.id :=
@@ -363,6 +374,16 @@ def dual_iso (α β : Type*) [preorder α] [preorder β] : (α →o β) ≃o (α
 { to_equiv := order_hom.dual.trans order_dual.to_dual,
   map_rel_iff' := λ f g, iff.rfl }
 
+/-- Lift an order homomorphism `f : α →o β` to an order homomorphism `with_bot α →o with_bot β`. -/
+@[simps { fully_applied := ff }]
+protected def with_bot_map (f : α →o β) : with_bot α →o with_bot β :=
+⟨with_bot.map f, f.mono.with_bot_map⟩
+
+/-- Lift an order homomorphism `f : α →o β` to an order homomorphism `with_top α →o with_top β`. -/
+@[simps { fully_applied := ff }]
+protected def with_top_map (f : α →o β) : with_top α →o with_top β :=
+⟨with_top.map f, f.mono.with_top_map⟩
+
 end order_hom
 
 /-- Embeddings of partial orders that preserve `<` also preserve `≤`. -/
@@ -411,6 +432,19 @@ f.lt_embedding.is_well_order
 protected def dual : αᵒᵈ ↪o βᵒᵈ :=
 ⟨f.to_embedding, λ a b, f.map_rel_iff⟩
 
+/-- A version of `with_bot.map` for order embeddings. -/
+@[simps { fully_applied := ff }]
+protected def with_bot_map (f : α ↪o β) : with_bot α ↪o with_bot β :=
+{ to_fun := with_bot.map f,
+  map_rel_iff' := with_bot.map_le_iff f (λ a b, f.map_rel_iff),
+  .. f.to_embedding.option_map }
+
+/-- A version of `with_top.map` for order embeddings. -/
+@[simps { fully_applied := ff }]
+protected def with_top_map (f : α ↪o β) : with_top α ↪o with_top β :=
+{ to_fun := with_top.map f,
+  .. f.dual.with_bot_map.dual }
+
 /--
 To define an order embedding from a partial order to a preorder it suffices to give a function
 together with a proof that it satisfies `f a ≤ f b ↔ a ≤ b`.
@@ -422,7 +456,7 @@ rel_embedding.of_map_rel_iff f hf
 @[simp] lemma coe_of_map_le_iff {α β} [partial_order α] [preorder β] {f : α → β} (h) :
   ⇑(of_map_le_iff f h) = f := rfl
 
-/-- A strictly monotone map from a linear order is an order embedding. --/
+/-- A strictly monotone map from a linear order is an order embedding. -/
 def of_strict_mono {α β} [linear_order α] [preorder β] (f : α → β)
   (h : strict_mono f) : α ↪o β :=
 of_map_le_iff f (λ _ _, h.le_iff_le)
@@ -476,7 +510,7 @@ instance : order_iso_class (α ≃o β) α β :=
   left_inv := λ f, f.left_inv,
   right_inv := λ f, f.right_inv,
   coe_injective' := λ f g h₁ h₂, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
-  map_le_map_iff := λ f, f.map_rel_iff' }
+  map_le_map_iff := λ f _ _, f.map_rel_iff' }
 
 @[simp] lemma to_fun_eq_coe {f : α ≃o β} : f.to_fun = f := rfl
 
@@ -494,8 +528,6 @@ protected lemma bijective (e : α ≃o β) : function.bijective e := e.to_equiv.
 protected lemma injective (e : α ≃o β) : function.injective e := e.to_equiv.injective
 protected lemma surjective (e : α ≃o β) : function.surjective e := e.to_equiv.surjective
 
-@[simp] lemma range_eq (e : α ≃o β) : set.range e = set.univ := e.surjective.range_eq
-
 @[simp] lemma apply_eq_iff_eq (e : α ≃o β) {x y : α} : e x = e y ↔ x = y :=
 e.to_equiv.apply_eq_iff_eq
 
@@ -532,27 +564,6 @@ lemma symm_injective : function.injective (symm : (α ≃o β) → (β ≃o α))
 
 @[simp] lemma to_equiv_symm (e : α ≃o β) : e.to_equiv.symm = e.symm.to_equiv := rfl
 
-@[simp] lemma symm_image_image (e : α ≃o β) (s : set α) : e.symm '' (e '' s) = s :=
-e.to_equiv.symm_image_image s
-
-@[simp] lemma image_symm_image (e : α ≃o β) (s : set β) : e '' (e.symm '' s) = s :=
-e.to_equiv.image_symm_image s
-
-lemma image_eq_preimage (e : α ≃o β) (s : set α) : e '' s = e.symm ⁻¹' s :=
-e.to_equiv.image_eq_preimage s
-
-@[simp] lemma preimage_symm_preimage (e : α ≃o β) (s : set α) : e ⁻¹' (e.symm ⁻¹' s) = s :=
-e.to_equiv.preimage_symm_preimage s
-
-@[simp] lemma symm_preimage_preimage (e : α ≃o β) (s : set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
-e.to_equiv.symm_preimage_preimage s
-
-@[simp] lemma image_preimage (e : α ≃o β) (s : set β) : e '' (e ⁻¹' s) = s :=
-e.to_equiv.image_preimage s
-
-@[simp] lemma preimage_image (e : α ≃o β) (s : set α) : e ⁻¹' (e '' s) = s :=
-e.to_equiv.preimage_image s
-
 /-- Composition of two order isomorphisms is an order isomorphism. -/
 @[trans] def trans (e : α ≃o β) (e' : β ≃o γ) : α ≃o γ := e.trans e'
 
@@ -564,6 +575,11 @@ e.to_equiv.preimage_image s
 
 @[simp] lemma trans_refl (e : α ≃o β) : e.trans (refl β) = e := by { ext x, refl }
 
+@[simp] lemma symm_trans_apply (e₁ : α ≃o β) (e₂ : β ≃o γ) (c : γ) :
+  (e₁.trans e₂).symm c = e₁.symm (e₂.symm c) := rfl
+
+lemma symm_trans (e₁ : α ≃o β) (e₂ : β ≃o γ) : (e₁.trans e₂).symm = e₂.symm.trans e₁.symm := rfl
+
 /-- `prod.swap` as an `order_iso`. -/
 def prod_comm : (α × β) ≃o (β × α) :=
 { to_equiv := equiv.prod_comm α β,
@@ -612,8 +628,36 @@ protected lemma strict_mono (e : α ≃o β) : strict_mono e := e.to_order_embed
 @[simp] lemma lt_iff_lt (e : α ≃o β) {x y : α} : e x < e y ↔ x < y :=
 e.to_order_embedding.lt_iff_lt
 
+/-- Converts an `order_iso` into a `rel_iso (<) (<)`. -/
+def to_rel_iso_lt (e : α ≃o β) : ((<) : α → α → Prop) ≃r ((<) : β → β → Prop) :=
+⟨e.to_equiv, λ x y, lt_iff_lt e⟩
+
+@[simp] lemma to_rel_iso_lt_apply (e : α ≃o β) (x : α) : e.to_rel_iso_lt x = e x := rfl
+
+@[simp] lemma to_rel_iso_lt_symm (e : α ≃o β) : e.to_rel_iso_lt.symm = e.symm.to_rel_iso_lt := rfl
+
+/-- Converts a `rel_iso (<) (<)` into an `order_iso`. -/
+def of_rel_iso_lt {α β} [partial_order α] [partial_order β]
+  (e : ((<) : α → α → Prop) ≃r ((<) : β → β → Prop)) : α ≃o β :=
+⟨e.to_equiv, λ x y, by simp [le_iff_eq_or_lt, e.map_rel_iff]⟩
+
+@[simp] lemma of_rel_iso_lt_apply {α β} [partial_order α] [partial_order β]
+  (e : ((<) : α → α → Prop) ≃r ((<) : β → β → Prop)) (x : α) : of_rel_iso_lt e x = e x := rfl
+
+@[simp] lemma of_rel_iso_lt_symm {α β} [partial_order α] [partial_order β]
+  (e : ((<) : α → α → Prop) ≃r ((<) : β → β → Prop)) :
+  (of_rel_iso_lt e).symm = of_rel_iso_lt e.symm := rfl
+
+@[simp] lemma of_rel_iso_lt_to_rel_iso_lt {α β} [partial_order α] [partial_order β] (e : α ≃o β) :
+  of_rel_iso_lt (to_rel_iso_lt e) = e :=
+by { ext, simp }
+
+@[simp] lemma to_rel_iso_lt_of_rel_iso_lt {α β} [partial_order α] [partial_order β]
+  (e : ((<) : α → α → Prop) ≃r ((<) : β → β → Prop)) : to_rel_iso_lt (of_rel_iso_lt e) = e :=
+by { ext, simp }
+
 /-- To show that `f : α → β`, `g : β → α` make up an order isomorphism of linear orders,
-    it suffices to prove `cmp a (g b) = cmp (f a) b`. --/
+    it suffices to prove `cmp a (g b) = cmp (f a) b`. -/
 def of_cmp_eq_cmp {α β} [linear_order α] [linear_order β] (f : α → β) (g : β → α)
   (h : ∀ (a : α) (b : β), cmp a (g b) = cmp (f a) b) : α ≃o β :=
 have gf : ∀ (a : α), a = g (f a) := by { intro, rw [←cmp_eq_eq_iff, h, cmp_self_eq_eq] },
@@ -623,15 +667,19 @@ have gf : ∀ (a : α), a = g (f a) := by { intro, rw [←cmp_eq_eq_iff, h, cmp_
   right_inv := by { intro, rw [←cmp_eq_eq_iff, ←h, cmp_self_eq_eq] },
   map_rel_iff' := by { intros, apply le_iff_le_of_cmp_eq_cmp, convert (h _ _).symm, apply gf } }
 
-/-- Order isomorphism between two equal sets. -/
-def set_congr (s t : set α) (h : s = t) : s ≃o t :=
-{ to_equiv := equiv.set_congr h,
-  map_rel_iff' := λ x y, iff.rfl }
-
-/-- Order isomorphism between `univ : set α` and `α`. -/
-def set.univ : (set.univ : set α) ≃o α :=
-{ to_equiv := equiv.set.univ α,
-  map_rel_iff' := λ x y, iff.rfl }
+/-- To show that `f : α →o β` and `g : β →o α` make up an order isomorphism it is enough to show
+    that `g` is the inverse of `f`-/
+def of_hom_inv {F G : Type*} [order_hom_class F α β] [order_hom_class G β α]
+  (f : F) (g : G) (h₁ : (f : α →o β).comp (g : β →o α) = order_hom.id)
+    (h₂ : (g : β →o α).comp (f : α →o β) = order_hom.id) : α ≃o β :=
+{ to_fun := f,
+  inv_fun := g,
+  left_inv := fun_like.congr_fun h₂,
+  right_inv := fun_like.congr_fun h₁,
+  map_rel_iff' := λ a b, ⟨λ h, by { replace h := map_rel g h, rwa [equiv.coe_fn_mk,
+    (show g (f a) = (g : β →o α).comp (f : α →o β) a, from rfl),
+    (show g (f b) = (g : β →o α).comp (f : α →o β) b, from rfl), h₂] at h },
+    λ h, (f : α →o β).monotone h⟩ }
 
 /-- Order isomorphism between `α → β` and `β`, where `α` has a unique element. -/
 @[simps to_equiv apply] def fun_unique (α β : Type*) [unique α] [preorder β] :
@@ -662,41 +710,11 @@ def to_order_iso (e : α ≃ β) (h₁ : monotone e) (h₂ : monotone e.symm) :
 
 end equiv
 
-/-- If a function `f` is strictly monotone on a set `s`, then it defines an order isomorphism
-between `s` and its image. -/
-protected noncomputable def strict_mono_on.order_iso {α β} [linear_order α] [preorder β]
-  (f : α → β) (s : set α) (hf : strict_mono_on f s) :
-  s ≃o f '' s :=
-{ to_equiv := hf.inj_on.bij_on_image.equiv _,
-  map_rel_iff' := λ x y, hf.le_iff_le x.2 y.2 }
-
 namespace strict_mono
 
 variables {α β} [linear_order α] [preorder β]
 variables (f : α → β) (h_mono : strict_mono f) (h_surj : function.surjective f)
 
-/-- A strictly monotone function from a linear order is an order isomorphism between its domain and
-its range. -/
-@[simps apply] protected noncomputable def order_iso : α ≃o set.range f :=
-{ to_equiv := equiv.of_injective f h_mono.injective,
-  map_rel_iff' := λ a b, h_mono.le_iff_le }
-
-/-- A strictly monotone surjective function from a linear order is an order isomorphism. -/
-noncomputable def order_iso_of_surjective : α ≃o β :=
-(h_mono.order_iso f).trans $ (order_iso.set_congr _ _ h_surj.range_eq).trans order_iso.set.univ
-
-@[simp] lemma coe_order_iso_of_surjective :
-  (order_iso_of_surjective f h_mono h_surj : α → β) = f :=
-rfl
-
-@[simp] lemma order_iso_of_surjective_symm_apply_self (a : α) :
-  (order_iso_of_surjective f h_mono h_surj).symm (f a) = a :=
-(order_iso_of_surjective f h_mono h_surj).symm_apply_apply _
-
-lemma order_iso_of_surjective_self_symm_apply (b : β) :
-  f ((order_iso_of_surjective f h_mono h_surj).symm b) = b :=
-(order_iso_of_surjective f h_mono h_surj).apply_symm_apply _
-
 /-- A strictly monotone function with a right inverse is an order isomorphism. -/
 @[simps {fully_applied := false}] def order_iso_of_right_inverse
   (g : β → α) (hg : function.right_inverse g f) : α ≃o β :=
@@ -730,62 +748,84 @@ lemma order_iso.map_top [has_le α] [partial_order β] [order_top α] [order_top
   f ⊤ = ⊤ :=
 f.dual.map_bot
 
-lemma order_embedding.map_inf_le [semilattice_inf α] [semilattice_inf β]
-  (f : α ↪o β) (x y : α) :
+lemma order_embedding.map_inf_le [semilattice_inf α] [semilattice_inf β] (f : α ↪o β) (x y : α) :
   f (x ⊓ y) ≤ f x ⊓ f y :=
 f.monotone.map_inf_le x y
 
-lemma order_iso.map_inf [semilattice_inf α] [semilattice_inf β]
-  (f : α ≃o β) (x y : α) :
+lemma order_embedding.le_map_sup [semilattice_sup α] [semilattice_sup β] (f : α ↪o β) (x y : α) :
+  f x ⊔ f y ≤ f (x ⊔ y) :=
+f.monotone.le_map_sup x y
+
+lemma order_iso.map_inf [semilattice_inf α] [semilattice_inf β] (f : α ≃o β) (x y : α) :
   f (x ⊓ y) = f x ⊓ f y :=
 begin
   refine (f.to_order_embedding.map_inf_le x y).antisymm _,
-  simpa [← f.symm.le_iff_le] using f.symm.to_order_embedding.map_inf_le (f x) (f y)
+  apply f.symm.le_iff_le.1,
+  simpa using f.symm.to_order_embedding.map_inf_le (f x) (f y),
 end
 
+lemma order_iso.map_sup [semilattice_sup α] [semilattice_sup β] (f : α ≃o β) (x y : α) :
+  f (x ⊔ y) = f x ⊔ f y :=
+f.dual.map_inf x y
+
 /-- Note that this goal could also be stated `(disjoint on f) a b` -/
 lemma disjoint.map_order_iso [semilattice_inf α] [order_bot α] [semilattice_inf β] [order_bot β]
   {a b : α} (f : α ≃o β) (ha : disjoint a b) : disjoint (f a) (f b) :=
-begin
-  rw [disjoint, ←f.map_inf, ←f.map_bot],
-  exact f.monotone ha,
-end
+by { rw [disjoint_iff_inf_le, ←f.map_inf, ←f.map_bot], exact f.monotone ha.le_bot }
+
+/-- Note that this goal could also be stated `(codisjoint on f) a b` -/
+lemma codisjoint.map_order_iso [semilattice_sup α] [order_top α] [semilattice_sup β] [order_top β]
+  {a b : α} (f : α ≃o β) (ha : codisjoint a b) : codisjoint (f a) (f b) :=
+by { rw [codisjoint_iff_le_sup, ←f.map_sup, ←f.map_top], exact f.monotone ha.top_le }
 
 @[simp] lemma disjoint_map_order_iso_iff [semilattice_inf α] [order_bot α] [semilattice_inf β]
   [order_bot β] {a b : α} (f : α ≃o β) : disjoint (f a) (f b) ↔ disjoint a b :=
 ⟨λ h, f.symm_apply_apply a ▸ f.symm_apply_apply b ▸ h.map_order_iso f.symm, λ h, h.map_order_iso f⟩
 
-lemma order_embedding.le_map_sup [semilattice_sup α] [semilattice_sup β]
-  (f : α ↪o β) (x y : α) :
-  f x ⊔ f y ≤ f (x ⊔ y) :=
-f.monotone.le_map_sup x y
-
-lemma order_iso.map_sup [semilattice_sup α] [semilattice_sup β]
-  (f : α ≃o β) (x y : α) :
-  f (x ⊔ y) = f x ⊔ f y :=
-f.dual.map_inf x y
+@[simp] lemma codisjoint_map_order_iso_iff [semilattice_sup α] [order_top α] [semilattice_sup β]
+  [order_top β] {a b : α} (f : α ≃o β) : codisjoint (f a) (f b) ↔ codisjoint a b :=
+⟨λ h, f.symm_apply_apply a ▸ f.symm_apply_apply b ▸ h.map_order_iso f.symm, λ h, h.map_order_iso f⟩
 
 namespace with_bot
 
-/-- Taking the dual then adding `⊥` is the same as adding `⊤` then taking the dual. -/
-protected def to_dual_top [has_le α] : with_bot αᵒᵈ ≃o (with_top α)ᵒᵈ := order_iso.refl _
+/-- Taking the dual then adding `⊥` is the same as adding `⊤` then taking the dual.
+This is the order iso form of `with_bot.of_dual`, as proven by `coe_to_dual_top_equiv_eq`.
+-/
+protected def to_dual_top_equiv [has_le α] : with_bot αᵒᵈ ≃o (with_top α)ᵒᵈ := order_iso.refl _
 
-@[simp] lemma to_dual_top_coe [has_le α] (a : α) :
-  with_bot.to_dual_top ↑(to_dual a) = to_dual (a : with_top α) := rfl
-@[simp] lemma to_dual_top_symm_coe [has_le α] (a : α) :
-  with_bot.to_dual_top.symm (to_dual (a : with_top α)) = ↑(to_dual a) := rfl
+@[simp] lemma to_dual_top_equiv_coe [has_le α] (a : α) :
+  with_bot.to_dual_top_equiv ↑(to_dual a) = to_dual (a : with_top α) := rfl
+@[simp] lemma to_dual_top_equiv_symm_coe [has_le α] (a : α) :
+  with_bot.to_dual_top_equiv.symm (to_dual (a : with_top α)) = ↑(to_dual a) := rfl
+@[simp] lemma to_dual_top_equiv_bot [has_le α]  :
+  with_bot.to_dual_top_equiv (⊥ : with_bot αᵒᵈ) = ⊥ := rfl
+@[simp] lemma to_dual_top_equiv_symm_bot [has_le α] :
+  with_bot.to_dual_top_equiv.symm (⊥ : (with_top α)ᵒᵈ) = ⊥ := rfl
+
+lemma coe_to_dual_top_equiv_eq [has_le α] :
+  (with_bot.to_dual_top_equiv : with_bot αᵒᵈ → (with_top α)ᵒᵈ) = to_dual ∘ with_bot.of_dual :=
+funext $ λ _, rfl
 
 end with_bot
 
 namespace with_top
 
-/-- Taking the dual then adding `⊤` is the same as adding `⊥` then taking the dual. -/
-protected def to_dual_bot [has_le α] : with_top αᵒᵈ ≃o (with_bot α)ᵒᵈ := order_iso.refl _
+/-- Taking the dual then adding `⊤` is the same as adding `⊥` then taking the dual.
+This is the order iso form of `with_top.of_dual`, as proven by `coe_to_dual_bot_equiv_eq`. -/
+protected def to_dual_bot_equiv [has_le α] : with_top αᵒᵈ ≃o (with_bot α)ᵒᵈ := order_iso.refl _
+
+@[simp] lemma to_dual_bot_equiv_coe [has_le α] (a : α) :
+  with_top.to_dual_bot_equiv ↑(to_dual a) = to_dual (a : with_bot α) := rfl
+@[simp] lemma to_dual_bot_equiv_symm_coe [has_le α] (a : α) :
+  with_top.to_dual_bot_equiv.symm (to_dual (a : with_bot α)) = ↑(to_dual a) := rfl
+@[simp] lemma to_dual_bot_equiv_top [has_le α] :
+  with_top.to_dual_bot_equiv (⊤ : with_top αᵒᵈ) = ⊤ := rfl
+@[simp] lemma to_dual_bot_equiv_symm_top [has_le α] :
+  with_top.to_dual_bot_equiv.symm (⊤ : (with_bot α)ᵒᵈ) = ⊤ := rfl
 
-@[simp] lemma to_dual_bot_coe [has_le α] (a : α) :
-  with_top.to_dual_bot ↑(to_dual a) = to_dual (a : with_bot α) := rfl
-@[simp] lemma to_dual_bot_symm_coe [has_le α] (a : α) :
-  with_top.to_dual_bot.symm (to_dual (a : with_bot α)) = ↑(to_dual a) := rfl
+lemma coe_to_dual_bot_equiv_eq [has_le α] :
+  (with_top.to_dual_bot_equiv : with_top αᵒᵈ → (with_bot α)ᵒᵈ) = to_dual ∘ with_top.of_dual :=
+funext $ λ _, rfl
 
 end with_top
 
@@ -796,8 +836,7 @@ variables [partial_order α] [partial_order β] [partial_order γ]
 @[simps apply]
 def with_top_congr (e : α ≃o β) : with_top α ≃o with_top β :=
 { to_equiv := e.to_equiv.option_congr,
-  map_rel_iff' := λ x y,
-    by induction x using with_top.rec_top_coe; induction y using with_top.rec_top_coe; simp }
+  .. e.to_order_embedding.with_top_map }
 
 @[simp] lemma with_top_congr_refl : (order_iso.refl α).with_top_congr = order_iso.refl _ :=
 rel_iso.to_equiv_injective equiv.option_congr_refl
@@ -814,8 +853,7 @@ rel_iso.to_equiv_injective $ e₁.to_equiv.option_congr_trans e₂.to_equiv
 def with_bot_congr (e : α ≃o β) :
   with_bot α ≃o with_bot β :=
 { to_equiv := e.to_equiv.option_congr,
-  map_rel_iff' := λ x y,
-    by induction x using with_bot.rec_bot_coe; induction y using with_bot.rec_bot_coe; simp }
+  .. e.to_order_embedding.with_bot_map }
 
 @[simp] lemma with_bot_congr_refl : (order_iso.refl α).with_bot_congr = order_iso.refl _ :=
 rel_iso.to_equiv_injective equiv.option_congr_refl
@@ -835,47 +873,26 @@ variables [lattice α] [lattice β] [bounded_order α] [bounded_order β] (f : 
 include f
 
 lemma order_iso.is_compl {x y : α} (h : is_compl x y) : is_compl (f x) (f y) :=
-⟨by { rw [← f.map_bot, ← f.map_inf, f.map_rel_iff], exact h.1 },
-  by { rw [← f.map_top, ← f.map_sup, f.map_rel_iff], exact h.2 }⟩
+⟨h.1.map_order_iso _, h.2.map_order_iso _⟩
 
 theorem order_iso.is_compl_iff {x y : α} :
   is_compl x y ↔ is_compl (f x) (f y) :=
-⟨f.is_compl, λ h, begin
-  rw [← f.symm_apply_apply x, ← f.symm_apply_apply y],
-  exact f.symm.is_compl h,
-end⟩
+⟨f.is_compl, λ h, f.symm_apply_apply x ▸ f.symm_apply_apply y ▸ f.symm.is_compl h⟩
 
-lemma order_iso.is_complemented
-  [is_complemented α] : is_complemented β :=
+lemma order_iso.complemented_lattice
+  [complemented_lattice α] : complemented_lattice β :=
 ⟨λ x, begin
   obtain ⟨y, hy⟩ := exists_is_compl (f.symm x),
   rw ← f.symm_apply_apply y at hy,
   refine ⟨f y, f.symm.is_compl_iff.2 hy⟩,
 end⟩
 
-theorem order_iso.is_complemented_iff :
-  is_complemented α ↔ is_complemented β :=
-⟨by { introI, exact f.is_complemented }, by { introI, exact f.symm.is_complemented }⟩
+theorem order_iso.complemented_lattice_iff :
+  complemented_lattice α ↔ complemented_lattice β :=
+⟨by { introI, exact f.complemented_lattice }, by { introI, exact f.symm.complemented_lattice }⟩
 
 end bounded_order
 end lattice_isos
 
-section boolean_algebra
-variables (α) [boolean_algebra α]
-
-/-- Taking complements as an order isomorphism to the order dual. -/
-@[simps]
-def order_iso.compl : α ≃o αᵒᵈ :=
-{ to_fun := order_dual.to_dual ∘ compl,
-  inv_fun := compl ∘ order_dual.of_dual,
-  left_inv := compl_compl,
-  right_inv := compl_compl,
-  map_rel_iff' := λ x y, compl_le_compl_iff_le }
-
-theorem compl_strict_anti : strict_anti (compl : α → α) :=
-(order_iso.compl α).strict_mono
-
-theorem compl_antitone : antitone (compl : α → α) :=
-(order_iso.compl α).monotone
-
-end boolean_algebra
+-- Developments relating order homs and sets belong in `order.hom.set` or later.
+assert_not_exists set.range
diff --git a/src/order/hom/bounded.lean b/src/order/hom/bounded.lean
index e35a40a93b5e4..cb58486e39e07 100644
--- a/src/order/hom/bounded.lean
+++ b/src/order/hom/bounded.lean
@@ -9,6 +9,9 @@ import order.bounded_order
 /-!
 # Bounded order homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines (bounded) order homomorphisms.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -48,6 +51,9 @@ structure bounded_order_hom (α β : Type*) [preorder α] [preorder β] [bounded
 (map_top' : to_fun ⊤ = ⊤)
 (map_bot' : to_fun ⊥ = ⊥)
 
+section
+set_option old_structure_cmd true
+
 /-- `top_hom_class F α β` states that `F` is a type of `⊤`-preserving morphisms.
 
 You should extend this class when you extend `top_hom`. -/
@@ -71,6 +77,8 @@ class bounded_order_hom_class (F : Type*) (α β : out_param $ Type*) [has_le α
 (map_top (f : F) : f ⊤ = ⊤)
 (map_bot (f : F) : f ⊥ = ⊥)
 
+end
+
 export top_hom_class (map_top) bot_hom_class (map_bot)
 
 attribute [simp] map_top map_bot
@@ -91,19 +99,24 @@ instance bounded_order_hom_class.to_bot_hom_class [has_le α] [has_le β]
 instance order_iso_class.to_top_hom_class [has_le α] [order_top α] [partial_order β] [order_top β]
   [order_iso_class F α β] :
   top_hom_class F α β :=
-⟨λ f, top_le_iff.1 $ (map_inv_le_iff f).1 le_top⟩
+{ map_top := λ f, top_le_iff.1 $ (map_inv_le_iff f).1 le_top,
+  .. show order_hom_class F α β, from infer_instance }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_bot_hom_class [has_le α] [order_bot α] [partial_order β] [order_bot β]
   [order_iso_class F α β] :
   bot_hom_class F α β :=
-⟨λ f, le_bot_iff.1 $ (le_map_inv_iff f).1 bot_le⟩
+--⟨λ f, le_bot_iff.1 $ (le_map_inv_iff f).1 bot_le⟩
+{ map_bot := λ f, le_bot_iff.1 $ (le_map_inv_iff f).1 bot_le,
+  .. show order_hom_class F α β, from infer_instance }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_bounded_order_hom_class [has_le α] [bounded_order α] [partial_order β]
   [bounded_order β] [order_iso_class F α β] :
   bounded_order_hom_class F α β :=
-{ ..order_iso_class.to_top_hom_class, ..order_iso_class.to_bot_hom_class }
+{ ..show order_hom_class F α β, from infer_instance,
+  ..order_iso_class.to_top_hom_class,
+  ..order_iso_class.to_bot_hom_class }
 
 @[simp] lemma map_eq_top_iff [has_le α] [order_top α] [partial_order β] [order_top β]
   [order_iso_class F α β] (f : F) {a : α} : f a = ⊤ ↔ a = ⊤ :=
@@ -142,6 +155,9 @@ instance : has_coe_to_fun (top_hom α β) (λ _, α → β) := fun_like.has_coe_
 
 @[simp] lemma to_fun_eq_coe {f : top_hom α β} : f.to_fun = (f : α → β) := rfl
 
+-- this must come after the coe_to_fun definition
+initialize_simps_projections top_hom (to_fun → apply)
+
 @[ext] lemma ext {f g : top_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
 
 /-- Copy of a `top_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
@@ -150,6 +166,9 @@ protected def copy (f : top_hom α β) (f' : α → β) (h : f' = f) : top_hom 
 { to_fun := f',
   map_top' := h.symm ▸ f.map_top' }
 
+@[simp] lemma coe_copy (f : top_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : top_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 instance : inhabited (top_hom α β) := ⟨⟨λ _, ⊤, rfl⟩⟩
 
 variables (α)
@@ -256,6 +275,9 @@ instance : has_coe_to_fun (bot_hom α β) (λ _, α → β) := fun_like.has_coe_
 
 @[simp] lemma to_fun_eq_coe {f : bot_hom α β} : f.to_fun = (f : α → β) := rfl
 
+-- this must come after the coe_to_fun definition
+initialize_simps_projections bot_hom (to_fun → apply)
+
 @[ext] lemma ext {f g : bot_hom α β} (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
 
 /-- Copy of a `bot_hom` with a new `to_fun` equal to the old one. Useful to fix definitional
@@ -264,6 +286,9 @@ protected def copy (f : bot_hom α β) (f' : α → β) (h : f' = f) : bot_hom 
 { to_fun := f',
   map_bot' := h.symm ▸ f.map_bot' }
 
+@[simp] lemma coe_copy (f : bot_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : bot_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 instance : inhabited (bot_hom α β) := ⟨⟨λ _, ⊥, rfl⟩⟩
 
 variables (α)
@@ -383,6 +408,13 @@ definitional equalities. -/
 protected def copy (f : bounded_order_hom α β) (f' : α → β) (h : f' = f) : bounded_order_hom α β :=
 { .. f.to_order_hom.copy f' h, .. f.to_top_hom.copy f' h, .. f.to_bot_hom.copy f' h }
 
+@[simp] lemma coe_copy (f : bounded_order_hom α β) (f' : α → β) (h : f' = f) :
+  ⇑(f.copy f' h) = f' :=
+rfl
+
+lemma copy_eq (f : bounded_order_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
+fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `bounded_order_hom`. -/
diff --git a/src/order/hom/complete_lattice.lean b/src/order/hom/complete_lattice.lean
index 596d043ba064f..fb0163c8fe28f 100644
--- a/src/order/hom/complete_lattice.lean
+++ b/src/order/hom/complete_lattice.lean
@@ -3,12 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import order.complete_lattice
+import data.set.lattice
 import order.hom.lattice
 
 /-!
 # Complete lattice homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines frame homorphisms and complete lattice homomorphisms.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -31,6 +34,10 @@ be satisfied by itself and all stricter types.
 ## Concrete homs
 
 * `complete_lattice.set_preimage`: `set.preimage` as a complete lattice homomorphism.
+
+## TODO
+
+Frame homs are Heyting homs.
 -/
 
 open function order_dual set
@@ -58,6 +65,9 @@ structure complete_lattice_hom (α β : Type*) [complete_lattice α] [complete_l
   extends Inf_hom α β :=
 (map_Sup' (s : set α) : to_fun (Sup s) = Sup (to_fun '' s))
 
+section
+set_option old_structure_cmd true
+
 /-- `Sup_hom_class F α β` states that `F` is a type of `⨆`-preserving morphisms.
 
 You should extend this class when you extend `Sup_hom`. -/
@@ -86,6 +96,8 @@ class complete_lattice_hom_class (F : Type*) (α β : out_param $ Type*) [comple
   [complete_lattice β] extends Inf_hom_class F α β :=
 (map_Sup (f : F) (s : set α) : f (Sup s) = Sup (f '' s))
 
+end
+
 export Sup_hom_class (map_Sup)
 export Inf_hom_class (map_Inf)
 
@@ -112,14 +124,16 @@ instance Sup_hom_class.to_sup_bot_hom_class [complete_lattice α] [complete_latt
   [Sup_hom_class F α β] :
   sup_bot_hom_class F α β :=
 { map_sup := λ f a b, by rw [←Sup_pair, map_Sup, set.image_pair, Sup_pair],
-  map_bot := λ f, by rw [←Sup_empty, map_Sup, set.image_empty, Sup_empty] }
+  map_bot := λ f, by rw [←Sup_empty, map_Sup, set.image_empty, Sup_empty],
+  ..‹Sup_hom_class F α β› }
 
 @[priority 100] -- See note [lower instance priority]
 instance Inf_hom_class.to_inf_top_hom_class [complete_lattice α] [complete_lattice β]
   [Inf_hom_class F α β] :
   inf_top_hom_class F α β :=
 { map_inf := λ f a b, by rw [←Inf_pair, map_Inf, set.image_pair, Inf_pair],
-  map_top := λ f, by rw [←Inf_empty, map_Inf, set.image_empty, Inf_empty] }
+  map_top := λ f, by rw [←Inf_empty, map_Inf, set.image_empty, Inf_empty],
+  ..‹Inf_hom_class F α β› }
 
 @[priority 100] -- See note [lower instance priority]
 instance frame_hom_class.to_Sup_hom_class [complete_lattice α] [complete_lattice β]
@@ -149,19 +163,25 @@ instance complete_lattice_hom_class.to_bounded_lattice_hom_class [complete_latti
 instance order_iso_class.to_Sup_hom_class [complete_lattice α] [complete_lattice β]
   [order_iso_class F α β] :
   Sup_hom_class F α β :=
-⟨λ f s, eq_of_forall_ge_iff $ λ c, by simp only [←le_map_inv_iff, Sup_le_iff, set.ball_image_iff]⟩
+{ map_Sup := λ f s, eq_of_forall_ge_iff $
+                λ c, by simp only [←le_map_inv_iff, Sup_le_iff, set.ball_image_iff],
+  .. show order_hom_class F α β, from infer_instance }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_Inf_hom_class [complete_lattice α] [complete_lattice β]
   [order_iso_class F α β] :
   Inf_hom_class F α β :=
-⟨λ f s, eq_of_forall_le_iff $ λ c, by simp only [←map_inv_le_iff, le_Inf_iff, set.ball_image_iff]⟩
+{ map_Inf := λ f s, eq_of_forall_le_iff $
+                λ c, by simp only [←map_inv_le_iff, le_Inf_iff, set.ball_image_iff],
+  .. show order_hom_class F α β, from infer_instance }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_complete_lattice_hom_class [complete_lattice α] [complete_lattice β]
   [order_iso_class F α β] :
   complete_lattice_hom_class F α β :=
-{ ..order_iso_class.to_Sup_hom_class, ..order_iso_class.to_lattice_hom_class }
+{ ..order_iso_class.to_Sup_hom_class,
+  ..order_iso_class.to_lattice_hom_class,
+  .. show Inf_hom_class F α β, from infer_instance }
 
 instance [has_Sup α] [has_Sup β] [Sup_hom_class F α β] : has_coe_t F (Sup_hom α β) :=
 ⟨λ f, ⟨f, map_Sup f⟩⟩
@@ -204,6 +224,9 @@ protected def copy (f : Sup_hom α β) (f' : α → β) (h : f' = f) : Sup_hom 
 { to_fun := f',
   map_Sup' := h.symm ▸ f.map_Sup' }
 
+@[simp] lemma coe_copy (f : Sup_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : Sup_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `Sup_hom`. -/
@@ -285,6 +308,9 @@ protected def copy (f : Inf_hom α β) (f' : α → β) (h : f' = f) : Inf_hom 
 { to_fun := f',
   map_Inf' := h.symm ▸ f.map_Inf' }
 
+@[simp] lemma coe_copy (f : Inf_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : Inf_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as an `Inf_hom`. -/
@@ -368,6 +394,9 @@ equalities. -/
 protected def copy (f : frame_hom α β) (f' : α → β) (h : f' = f) : frame_hom α β :=
 { to_inf_top_hom := f.to_inf_top_hom.copy f' h, ..(f : Sup_hom α β).copy f' h }
 
+@[simp] lemma coe_copy (f : frame_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : frame_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `frame_hom`. -/
@@ -437,6 +466,14 @@ protected def copy (f : complete_lattice_hom α β) (f' : α → β) (h : f' = f
   complete_lattice_hom α β :=
 { to_Inf_hom := f.to_Inf_hom.copy f' h, .. f.to_Sup_hom.copy f' h }
 
+@[simp] lemma coe_copy (f : complete_lattice_hom α β) (f' : α → β) (h : f' = f) :
+  ⇑(f.copy f' h) = f' :=
+rfl
+
+lemma copy_eq (f : complete_lattice_hom α β) (f' : α → β) (h : f' = f) :
+  f.copy f' h = f :=
+fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `complete_lattice_hom`. -/
@@ -549,7 +586,9 @@ end complete_lattice_hom
 
 namespace complete_lattice_hom
 
-/-- `set.preimage` as a complete lattice homomorphism. -/
+/-- `set.preimage` as a complete lattice homomorphism.
+
+See also `Sup_hom.set_image`. -/
 def set_preimage (f : α → β) : complete_lattice_hom (set β) (set α) :=
 { to_fun := preimage f,
   map_Sup' := λ s, preimage_sUnion.trans $ by simp only [set.Sup_eq_sUnion, set.sUnion_image],
@@ -563,3 +602,45 @@ lemma set_preimage_comp (g : β → γ) (f : α → β) :
   set_preimage (g ∘ f) = (set_preimage f).comp (set_preimage g) := rfl
 
 end complete_lattice_hom
+
+lemma set.image_Sup {f : α → β} (s : set (set α)) :
+  f '' Sup s = Sup (image f '' s) :=
+begin
+  ext b,
+  simp only [Sup_eq_sUnion, mem_image, mem_sUnion, exists_prop, sUnion_image, mem_Union],
+  split,
+  { rintros ⟨a, ⟨t, ht₁, ht₂⟩, rfl⟩, exact ⟨t, ht₁, a, ht₂, rfl⟩, },
+  { rintros ⟨t, ht₁, a, ht₂, rfl⟩, exact ⟨a, ⟨t, ht₁, ht₂⟩, rfl⟩, },
+end
+
+/-- Using `set.image`, a function between types yields a `Sup_hom` between their lattices of
+subsets.
+
+See also `complete_lattice_hom.set_preimage`. -/
+@[simps] def Sup_hom.set_image (f : α → β) : Sup_hom (set α) (set β) :=
+{ to_fun := image f,
+  map_Sup' := set.image_Sup }
+
+/-- An equivalence of types yields an order isomorphism between their lattices of subsets. -/
+@[simps] def equiv.to_order_iso_set (e : α ≃ β) : set α ≃o set β :=
+{ to_fun  := image e,
+  inv_fun := image e.symm,
+  left_inv  := λ s, by simp only [← image_comp, equiv.symm_comp_self, id.def, image_id'],
+  right_inv := λ s, by simp only [← image_comp, equiv.self_comp_symm, id.def, image_id'],
+  map_rel_iff' :=
+    λ s t, ⟨λ h, by simpa using @monotone_image _ _ e.symm _ _ h, λ h, monotone_image h⟩ }
+
+variables [complete_lattice α] (x : α × α)
+
+/-- The map `(a, b) ↦ a ⊔ b` as a `Sup_hom`. -/
+def sup_Sup_hom : Sup_hom (α × α) α :=
+{ to_fun := λ x, x.1 ⊔ x.2,
+  map_Sup' := λ s, by simp_rw [prod.fst_Sup, prod.snd_Sup, Sup_image, supr_sup_eq] }
+
+/-- The map `(a, b) ↦ a ⊓ b` as an `Inf_hom`. -/
+def inf_Inf_hom : Inf_hom (α × α) α :=
+{ to_fun := λ x, x.1 ⊓ x.2,
+  map_Inf' := λ s, by simp_rw [prod.fst_Inf, prod.snd_Inf, Inf_image, infi_inf_eq] }
+
+@[simp, norm_cast] lemma sup_Sup_hom_apply : sup_Sup_hom x = x.1 ⊔ x.2 := rfl
+@[simp, norm_cast] lemma inf_Inf_hom_apply : inf_Inf_hom x = x.1 ⊓ x.2 := rfl
diff --git a/src/order/hom/lattice.lean b/src/order/hom/lattice.lean
index 214fb509677d1..771552ff68c30 100644
--- a/src/order/hom/lattice.lean
+++ b/src/order/hom/lattice.lean
@@ -3,13 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import data.finset.lattice
 import order.hom.bounded
 import order.symm_diff
 
 /-!
 # Lattice homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines (bounded) lattice homomorphisms.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -73,6 +75,9 @@ structure bounded_lattice_hom (α β : Type*) [lattice α] [lattice β] [bounded
 (map_top' : to_fun ⊤ = ⊤)
 (map_bot' : to_fun ⊥ = ⊥)
 
+section
+set_option old_structure_cmd true
+
 /-- `sup_hom_class F α β` states that `F` is a type of `⊔`-preserving morphisms.
 
 You should extend this class when you extend `sup_hom`. -/
@@ -117,6 +122,8 @@ class bounded_lattice_hom_class (F : Type*) (α β : out_param $ Type*) [lattice
 (map_top (f : F) : f ⊤ = ⊤)
 (map_bot (f : F) : f ⊥ = ⊥)
 
+end
+
 export sup_hom_class (map_sup)
 export inf_hom_class (map_inf)
 
@@ -126,12 +133,14 @@ attribute [simp] map_top map_bot map_sup map_inf
 instance sup_hom_class.to_order_hom_class [semilattice_sup α] [semilattice_sup β]
   [sup_hom_class F α β] :
   order_hom_class F α β :=
-⟨λ f a b h, by rw [←sup_eq_right, ←map_sup, sup_eq_right.2 h]⟩
+{ map_rel := λ f a b h, by rw [←sup_eq_right, ←map_sup, sup_eq_right.2 h],
+  ..‹sup_hom_class F α β› }
 
 @[priority 100] -- See note [lower instance priority]
 instance inf_hom_class.to_order_hom_class [semilattice_inf α] [semilattice_inf β]
   [inf_hom_class F α β] : order_hom_class F α β :=
-⟨λ f a b h, by rw [←inf_eq_left, ←map_inf, inf_eq_left.2 h]⟩
+{ map_rel := λ f a b h, by rw [←inf_eq_left, ←map_inf, inf_eq_left.2 h]
+  ..‹inf_hom_class F α β› }
 
 @[priority 100] -- See note [lower instance priority]
 instance sup_bot_hom_class.to_bot_hom_class [has_sup α] [has_sup β] [has_bot α] [has_bot β]
@@ -166,19 +175,22 @@ instance bounded_lattice_hom_class.to_inf_top_hom_class [lattice α] [lattice β
 instance bounded_lattice_hom_class.to_bounded_order_hom_class [lattice α] [lattice β]
   [bounded_order α] [bounded_order β] [bounded_lattice_hom_class F α β] :
   bounded_order_hom_class F α β :=
-{ .. ‹bounded_lattice_hom_class F α β› }
+{ .. show order_hom_class F α β, from infer_instance,
+  .. ‹bounded_lattice_hom_class F α β› }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_sup_hom_class [semilattice_sup α] [semilattice_sup β]
   [order_iso_class F α β] :
   sup_hom_class F α β :=
-⟨λ f a b, eq_of_forall_ge_iff $ λ c, by simp only [←le_map_inv_iff, sup_le_iff]⟩
+{ map_sup := λ f a b, eq_of_forall_ge_iff $ λ c, by simp only [←le_map_inv_iff, sup_le_iff],
+  .. show order_hom_class F α β, from infer_instance }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_inf_hom_class [semilattice_inf α] [semilattice_inf β]
   [order_iso_class F α β] :
   inf_hom_class F α β :=
-⟨λ f a b, eq_of_forall_le_iff $ λ c, by simp only [←map_inv_le_iff, le_inf_iff]⟩
+{ map_inf := λ f a b, eq_of_forall_le_iff $ λ c, by simp only [←map_inv_le_iff, le_inf_iff],
+  .. show order_hom_class F α β, from infer_instance }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_sup_bot_hom_class [semilattice_sup α] [order_bot α] [semilattice_sup β]
@@ -203,18 +215,6 @@ instance order_iso_class.to_bounded_lattice_hom_class [lattice α] [lattice β]
   bounded_lattice_hom_class F α β :=
 { ..order_iso_class.to_lattice_hom_class, ..order_iso_class.to_bounded_order_hom_class }
 
-@[simp] lemma map_finset_sup [semilattice_sup α] [order_bot α] [semilattice_sup β] [order_bot β]
-  [sup_bot_hom_class F α β] (f : F) (s : finset ι) (g : ι → α) :
-  f (s.sup g) = s.sup (f ∘ g) :=
-finset.cons_induction_on s (map_bot f) $ λ i s _ h,
-  by rw [finset.sup_cons, finset.sup_cons, map_sup, h]
-
-@[simp] lemma map_finset_inf [semilattice_inf α] [order_top α] [semilattice_inf β] [order_top β]
-  [inf_top_hom_class F α β] (f : F) (s : finset ι) (g : ι → α) :
-  f (s.inf g) = s.inf (f ∘ g) :=
-finset.cons_induction_on s (map_top f) $ λ i s _ h,
-  by rw [finset.inf_cons, finset.inf_cons, map_inf, h]
-
 section bounded_lattice
 variables [lattice α] [bounded_order α] [lattice β] [bounded_order β]
   [bounded_lattice_hom_class F α β] (f : F) {a b : α}
@@ -223,9 +223,10 @@ include β
 lemma disjoint.map (h : disjoint a b) : disjoint (f a) (f b) :=
 by rw [disjoint_iff, ←map_inf, h.eq_bot, map_bot]
 
-lemma is_compl.map (h : is_compl a b) : is_compl (f a) (f b) :=
-{ inf_le_bot := h.disjoint.map _,
-  top_le_sup := by rw [←map_sup, h.sup_eq_top, map_top] }
+lemma codisjoint.map (h : codisjoint a b) : codisjoint (f a) (f b) :=
+by rw [codisjoint_iff, ←map_sup, h.eq_top, map_top]
+
+lemma is_compl.map (h : is_compl a b) : is_compl (f a) (f b) := ⟨h.1.map _, h.2.map _⟩
 
 end bounded_lattice
 
@@ -233,12 +234,16 @@ section boolean_algebra
 variables [boolean_algebra α] [boolean_algebra β] [bounded_lattice_hom_class F α β] (f : F)
 include β
 
-lemma map_compl (a : α) : f aᶜ = (f a)ᶜ := (is_compl_compl.map _).compl_eq.symm
+/-- Special case of `map_compl` for boolean algebras. -/
+lemma map_compl' (a : α) : f aᶜ = (f a)ᶜ := (is_compl_compl.map _).compl_eq.symm
 
-lemma map_sdiff (a b : α) : f (a \ b) = f a \ f b := by rw [sdiff_eq, sdiff_eq, map_inf, map_compl]
+/-- Special case of `map_sdiff` for boolean algebras. -/
+lemma map_sdiff' (a b : α) : f (a \ b) = f a \ f b :=
+by rw [sdiff_eq, sdiff_eq, map_inf, map_compl']
 
-lemma map_symm_diff (a b : α) : f (a ∆ b) = f a ∆ f b :=
-by rw [symm_diff, symm_diff, map_sup, map_sdiff, map_sdiff]
+/-- Special case of `map_symm_diff` for boolean algebras. -/
+lemma map_symm_diff' (a b : α) : f (a ∆ b) = f a ∆ f b :=
+by rw [symm_diff, symm_diff, map_sup, map_sdiff', map_sdiff']
 
 end boolean_algebra
 
@@ -290,6 +295,9 @@ protected def copy (f : sup_hom α β) (f' : α → β) (h : f' = f) : sup_hom 
 { to_fun := f',
   map_sup' := h.symm ▸ f.map_sup' }
 
+@[simp] lemma coe_copy (f : sup_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : sup_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `sup_hom`. -/
@@ -390,6 +398,9 @@ protected def copy (f : inf_hom α β) (f' : α → β) (h : f' = f) : inf_hom 
 { to_fun := f',
   map_inf' := h.symm ▸ f.map_inf' }
 
+@[simp] lemma coe_copy (f : inf_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : inf_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as an `inf_hom`. -/
@@ -493,6 +504,9 @@ equalities. -/
 protected def copy (f : sup_bot_hom α β) (f' : α → β) (h : f' = f) : sup_bot_hom α β :=
 { to_sup_hom := f.to_sup_hom.copy f' h, ..f.to_bot_hom.copy f' h }
 
+@[simp] lemma coe_copy (f : sup_bot_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : sup_bot_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `sup_bot_hom`. -/
@@ -577,6 +591,9 @@ equalities. -/
 protected def copy (f : inf_top_hom α β) (f' : α → β) (h : f' = f) : inf_top_hom α β :=
 { to_inf_hom := f.to_inf_hom.copy f' h, ..f.to_top_hom.copy f' h }
 
+@[simp] lemma coe_copy (f : inf_top_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : inf_top_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as an `inf_top_hom`. -/
@@ -658,6 +675,9 @@ equalities. -/
 protected def copy (f : lattice_hom α β) (f' : α → β) (h : f' = f) : lattice_hom α β :=
 { .. f.to_sup_hom.copy f' h, .. f.to_inf_hom.copy f' h }
 
+@[simp] lemma coe_copy (f : lattice_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : lattice_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `lattice_hom`. -/
@@ -768,6 +788,13 @@ protected def copy (f : bounded_lattice_hom α β) (f' : α → β) (h : f' = f)
   bounded_lattice_hom α β :=
 { .. f.to_lattice_hom.copy f' h, .. f.to_bounded_order_hom.copy f' h }
 
+@[simp] lemma coe_copy (f : bounded_lattice_hom α β) (f' : α → β) (h : f' = f) :
+  ⇑(f.copy f' h) = f' :=
+rfl
+
+lemma copy_eq (f : bounded_lattice_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
+fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `bounded_lattice_hom`. -/
@@ -941,3 +968,185 @@ bounded lattices. -/
     (bounded_lattice_hom.dual.symm g).comp (bounded_lattice_hom.dual.symm f) := rfl
 
 end bounded_lattice_hom
+
+/-! ### `with_top`, `with_bot` -/
+
+namespace sup_hom
+variables [semilattice_sup α] [semilattice_sup β] [semilattice_sup γ]
+
+/-- Adjoins a `⊤` to the domain and codomain of a `sup_hom`. -/
+@[simps] protected def with_top (f : sup_hom α β) : sup_hom (with_top α) (with_top β) :=
+{ to_fun := option.map f,
+  map_sup' := λ a b, match a, b with
+    | ⊤, ⊤ := rfl
+    | ⊤, (b : α) := rfl
+    | (a : α), ⊤ := rfl
+    | (a : α), (b : α) := congr_arg _ (f.map_sup' _ _)
+  end }
+
+@[simp] lemma with_top_id : (sup_hom.id α).with_top = sup_hom.id _ :=
+fun_like.coe_injective option.map_id
+
+@[simp] lemma with_top_comp (f : sup_hom β γ) (g : sup_hom α β) :
+  (f.comp g).with_top = f.with_top.comp g.with_top :=
+fun_like.coe_injective (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊥` to the domain and codomain of a `sup_hom`. -/
+@[simps] protected def with_bot (f : sup_hom α β) : sup_bot_hom (with_bot α) (with_bot β) :=
+{ to_fun := option.map f,
+  map_sup' := λ a b, match a, b with
+    | ⊥, ⊥ := rfl
+    | ⊥, (b : α) := rfl
+    | (a : α), ⊥ := rfl
+    | (a : α), (b : α) := congr_arg _ (f.map_sup' _ _)
+  end,
+  map_bot' := rfl }
+
+@[simp] lemma with_bot_id : (sup_hom.id α).with_bot = sup_bot_hom.id _ :=
+fun_like.coe_injective option.map_id
+
+@[simp] lemma with_bot_comp (f : sup_hom β γ) (g : sup_hom α β) :
+  (f.comp g).with_bot = f.with_bot.comp g.with_bot :=
+fun_like.coe_injective (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊤` to the codomain of a `sup_hom`. -/
+@[simps] def with_top' [order_top β] (f : sup_hom α β) : sup_hom (with_top α) β :=
+{ to_fun := λ a, a.elim ⊤ f,
+  map_sup' := λ a b, match a, b with
+    | ⊤, ⊤ := top_sup_eq.symm
+    | ⊤, (b : α) := top_sup_eq.symm
+    | (a : α), ⊤ := sup_top_eq.symm
+    | (a : α), (b : α) := f.map_sup' _ _
+  end }
+
+/-- Adjoins a `⊥` to the domain of a `sup_hom`. -/
+@[simps] def with_bot' [order_bot β] (f : sup_hom α β) : sup_bot_hom (with_bot α) β :=
+{ to_fun := λ a, a.elim ⊥ f,
+  map_sup' := λ a b, match a, b with
+    | ⊥, ⊥ := bot_sup_eq.symm
+    | ⊥, (b : α) := bot_sup_eq.symm
+    | (a : α), ⊥ := sup_bot_eq.symm
+    | (a : α), (b : α) := f.map_sup' _ _
+  end,
+  map_bot' := rfl }
+
+end sup_hom
+
+namespace inf_hom
+variables [semilattice_inf α] [semilattice_inf β] [semilattice_inf γ]
+
+/-- Adjoins a `⊤` to the domain and codomain of an `inf_hom`. -/
+@[simps] protected def with_top (f : inf_hom α β) : inf_top_hom (with_top α) (with_top β) :=
+{ to_fun := option.map f,
+  map_inf' := λ a b, match a, b with
+    | ⊤, ⊤ := rfl
+    | ⊤, (b : α) := rfl
+    | (a : α), ⊤ := rfl
+    | (a : α), (b : α) := congr_arg _ (f.map_inf' _ _)
+  end,
+  map_top' := rfl }
+
+@[simp] lemma with_top_id : (inf_hom.id α).with_top = inf_top_hom.id _ :=
+fun_like.coe_injective option.map_id
+
+@[simp] lemma with_top_comp (f : inf_hom β γ) (g : inf_hom α β) :
+  (f.comp g).with_top = f.with_top.comp g.with_top :=
+fun_like.coe_injective (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊥ to the domain and codomain of an `inf_hom`. -/
+@[simps] protected def with_bot (f : inf_hom α β) : inf_hom (with_bot α) (with_bot β) :=
+{ to_fun := option.map f,
+  map_inf' := λ a b, match a, b with
+    | ⊥, ⊥ := rfl
+    | ⊥, (b : α) := rfl
+    | (a : α), ⊥ := rfl
+    | (a : α), (b : α) := congr_arg _ (f.map_inf' _ _)
+  end }
+
+@[simp] lemma with_bot_id : (inf_hom.id α).with_bot = inf_hom.id _ :=
+fun_like.coe_injective option.map_id
+
+@[simp] lemma with_bot_comp (f : inf_hom β γ) (g : inf_hom α β) :
+  (f.comp g).with_bot = f.with_bot.comp g.with_bot :=
+fun_like.coe_injective (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊤` to the codomain of an `inf_hom`. -/
+@[simps] def with_top' [order_top β] (f : inf_hom α β) : inf_top_hom (with_top α) β :=
+{ to_fun := λ a, a.elim ⊤ f,
+  map_inf' := λ a b, match a, b with
+    | ⊤, ⊤ := top_inf_eq.symm
+    | ⊤, (b : α)  := top_inf_eq.symm
+    | (a : α), ⊤ := inf_top_eq.symm
+    | (a : α), (b : α) := f.map_inf' _ _
+  end,
+  map_top' := rfl }
+
+/-- Adjoins a `⊥` to the codomain of an `inf_hom`. -/
+@[simps] def with_bot' [order_bot β] (f : inf_hom α β) : inf_hom (with_bot α) β :=
+{ to_fun := λ a, a.elim ⊥ f,
+  map_inf' := λ a b, match a, b with
+    | ⊥, ⊥ := bot_inf_eq.symm
+    | ⊥, (b : α) := bot_inf_eq.symm
+    | (a : α), ⊥ := inf_bot_eq.symm
+    | (a : α), (b : α) := f.map_inf' _ _
+  end }
+
+end inf_hom
+
+namespace lattice_hom
+variables [lattice α] [lattice β] [lattice γ]
+
+/-- Adjoins a `⊤` to the domain and codomain of a `lattice_hom`. -/
+@[simps] protected def with_top (f : lattice_hom α β) : lattice_hom (with_top α) (with_top β) :=
+{ to_sup_hom := f.to_sup_hom.with_top, ..f.to_inf_hom.with_top }
+
+@[simp] lemma with_top_id : (lattice_hom.id α).with_top = lattice_hom.id _ :=
+fun_like.coe_injective option.map_id
+
+@[simp] lemma with_top_comp (f : lattice_hom β γ) (g : lattice_hom α β) :
+  (f.comp g).with_top = f.with_top.comp g.with_top :=
+fun_like.coe_injective (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊥` to the domain and codomain of a `lattice_hom`. -/
+@[simps] protected def with_bot (f : lattice_hom α β) : lattice_hom (with_bot α) (with_bot β) :=
+{ to_sup_hom := f.to_sup_hom.with_bot, ..f.to_inf_hom.with_bot }
+
+@[simp] lemma with_bot_id : (lattice_hom.id α).with_bot = lattice_hom.id _ :=
+fun_like.coe_injective option.map_id
+
+@[simp] lemma with_bot_comp (f : lattice_hom β γ) (g : lattice_hom α β) :
+  (f.comp g).with_bot = f.with_bot.comp g.with_bot :=
+fun_like.coe_injective (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊤` and `⊥` to the domain and codomain of a `lattice_hom`. -/
+@[simps] def with_top_with_bot (f : lattice_hom α β) :
+  bounded_lattice_hom (with_top $ with_bot α) (with_top $ with_bot β) :=
+⟨f.with_bot.with_top, rfl, rfl⟩
+
+@[simp] lemma with_top_with_bot_id :
+  (lattice_hom.id α).with_top_with_bot = bounded_lattice_hom.id _ :=
+fun_like.coe_injective $ begin
+  refine (congr_arg option.map _).trans option.map_id,
+  rw with_bot_id,
+  refl,
+end
+
+@[simp] lemma with_top_with_bot_comp (f : lattice_hom β γ) (g : lattice_hom α β) :
+  (f.comp g).with_top_with_bot = f.with_top_with_bot.comp g.with_top_with_bot :=
+fun_like.coe_injective $ (congr_arg option.map $ (option.map_comp_map _ _).symm).trans
+  (option.map_comp_map _ _).symm
+
+/-- Adjoins a `⊥` to the codomain of a `lattice_hom`. -/
+@[simps] def with_top' [order_top β] (f : lattice_hom α β) : lattice_hom (with_top α) β :=
+{ ..f.to_sup_hom.with_top', ..f.to_inf_hom.with_top' }
+
+/-- Adjoins a `⊥` to the domain and codomain of a `lattice_hom`. -/
+@[simps] def with_bot' [order_bot β] (f : lattice_hom α β) : lattice_hom (with_bot α) β :=
+{ ..f.to_sup_hom.with_bot', ..f.to_inf_hom.with_bot' }
+
+/-- Adjoins a `⊤` and `⊥` to the codomain of a `lattice_hom`. -/
+@[simps] def with_top_with_bot' [bounded_order β] (f : lattice_hom α β) :
+  bounded_lattice_hom (with_top $ with_bot α) β :=
+{ to_lattice_hom := f.with_bot'.with_top', map_top' := rfl, map_bot' := rfl }
+
+end lattice_hom
diff --git a/src/order/hom/order.lean b/src/order/hom/order.lean
index dd5786296ba29..29105fa08b152 100644
--- a/src/order/hom/order.lean
+++ b/src/order/hom/order.lean
@@ -10,6 +10,9 @@ import order.hom.basic
 /-!
 # Lattice structure on order homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the lattice structure on order homomorphisms, which are bundled
 monotone functions.
 
diff --git a/src/order/hom/set.lean b/src/order/hom/set.lean
new file mode 100644
index 0000000000000..e2a7308b2f386
--- /dev/null
+++ b/src/order/hom/set.lean
@@ -0,0 +1,123 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+import order.hom.basic
+import logic.equiv.set
+import data.set.image
+
+/-!
+# Order homomorphisms and sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open order_dual
+
+variables {F α β γ δ : Type*}
+
+namespace order_iso
+
+section has_le
+
+variables [has_le α] [has_le β] [has_le γ]
+
+lemma range_eq (e : α ≃o β) : set.range e = set.univ := e.surjective.range_eq
+
+@[simp] lemma symm_image_image (e : α ≃o β) (s : set α) : e.symm '' (e '' s) = s :=
+e.to_equiv.symm_image_image s
+
+@[simp] lemma image_symm_image (e : α ≃o β) (s : set β) : e '' (e.symm '' s) = s :=
+e.to_equiv.image_symm_image s
+
+lemma image_eq_preimage (e : α ≃o β) (s : set α) : e '' s = e.symm ⁻¹' s :=
+e.to_equiv.image_eq_preimage s
+
+@[simp] lemma preimage_symm_preimage (e : α ≃o β) (s : set α) : e ⁻¹' (e.symm ⁻¹' s) = s :=
+e.to_equiv.preimage_symm_preimage s
+
+@[simp] lemma symm_preimage_preimage (e : α ≃o β) (s : set β) : e.symm ⁻¹' (e ⁻¹' s) = s :=
+e.to_equiv.symm_preimage_preimage s
+
+@[simp] lemma image_preimage (e : α ≃o β) (s : set β) : e '' (e ⁻¹' s) = s :=
+e.to_equiv.image_preimage s
+
+@[simp] lemma preimage_image (e : α ≃o β) (s : set α) : e ⁻¹' (e '' s) = s :=
+e.to_equiv.preimage_image s
+
+end has_le
+
+open set
+
+variables [preorder α] [preorder β] [preorder γ]
+
+/-- Order isomorphism between two equal sets. -/
+def set_congr (s t : set α) (h : s = t) : s ≃o t :=
+{ to_equiv := equiv.set_congr h,
+  map_rel_iff' := λ x y, iff.rfl }
+
+/-- Order isomorphism between `univ : set α` and `α`. -/
+def set.univ : (set.univ : set α) ≃o α :=
+{ to_equiv := equiv.set.univ α,
+  map_rel_iff' := λ x y, iff.rfl }
+
+end order_iso
+
+/-- If a function `f` is strictly monotone on a set `s`, then it defines an order isomorphism
+between `s` and its image. -/
+protected noncomputable def strict_mono_on.order_iso {α β} [linear_order α] [preorder β]
+  (f : α → β) (s : set α) (hf : strict_mono_on f s) :
+  s ≃o f '' s :=
+{ to_equiv := hf.inj_on.bij_on_image.equiv _,
+  map_rel_iff' := λ x y, hf.le_iff_le x.2 y.2 }
+
+namespace strict_mono
+
+variables {α β} [linear_order α] [preorder β]
+variables (f : α → β) (h_mono : strict_mono f) (h_surj : function.surjective f)
+
+/-- A strictly monotone function from a linear order is an order isomorphism between its domain and
+its range. -/
+@[simps apply] protected noncomputable def order_iso : α ≃o set.range f :=
+{ to_equiv := equiv.of_injective f h_mono.injective,
+  map_rel_iff' := λ a b, h_mono.le_iff_le }
+
+/-- A strictly monotone surjective function from a linear order is an order isomorphism. -/
+noncomputable def order_iso_of_surjective : α ≃o β :=
+(h_mono.order_iso f).trans $ (order_iso.set_congr _ _ h_surj.range_eq).trans order_iso.set.univ
+
+@[simp] lemma coe_order_iso_of_surjective :
+  (order_iso_of_surjective f h_mono h_surj : α → β) = f :=
+rfl
+
+@[simp] lemma order_iso_of_surjective_symm_apply_self (a : α) :
+  (order_iso_of_surjective f h_mono h_surj).symm (f a) = a :=
+(order_iso_of_surjective f h_mono h_surj).symm_apply_apply _
+
+lemma order_iso_of_surjective_self_symm_apply (b : β) :
+  f ((order_iso_of_surjective f h_mono h_surj).symm b) = b :=
+(order_iso_of_surjective f h_mono h_surj).apply_symm_apply _
+
+end strict_mono
+
+section boolean_algebra
+variables (α) [boolean_algebra α]
+
+/-- Taking complements as an order isomorphism to the order dual. -/
+@[simps]
+def order_iso.compl : α ≃o αᵒᵈ :=
+{ to_fun := order_dual.to_dual ∘ compl,
+  inv_fun := compl ∘ order_dual.of_dual,
+  left_inv := compl_compl,
+  right_inv := compl_compl,
+  map_rel_iff' := λ x y, compl_le_compl_iff_le }
+
+theorem compl_strict_anti : strict_anti (compl : α → α) :=
+(order_iso.compl α).strict_mono
+
+theorem compl_antitone : antitone (compl : α → α) :=
+(order_iso.compl α).monotone
+
+end boolean_algebra
diff --git a/src/order/ideal.lean b/src/order/ideal.lean
index de3958a8d8b57..f5a9afc2dca0a 100644
--- a/src/order/ideal.lean
+++ b/src/order/ideal.lean
@@ -5,11 +5,14 @@ Authors: David Wärn
 -/
 import logic.encodable.basic
 import order.atoms
-import order.upper_lower
+import order.upper_lower.basic
 
 /-!
 # Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 Throughout this file, `P` is at least a preorder, but some sections require more
@@ -124,11 +127,11 @@ and nonempty. -/
 @[mk_iff] class is_maximal (I : ideal P) extends is_proper I : Prop :=
 (maximal_proper : ∀ ⦃J : ideal P⦄, I < J → (J : set P) = univ)
 
-lemma inter_nonempty [is_directed P (swap (≤))] (I J : ideal P) : (I ∩ J : set P).nonempty :=
+lemma inter_nonempty [is_directed P (≥)] (I J : ideal P) : (I ∩ J : set P).nonempty :=
 begin
   obtain ⟨a, ha⟩ := I.nonempty,
   obtain ⟨b, hb⟩ := J.nonempty,
-  obtain ⟨c, hac, hbc⟩ := directed_of (swap (≤)) a b,
+  obtain ⟨c, hac, hbc⟩ := exists_le_le a b,
   exact ⟨c, I.lower hac ha, J.lower hbc hb⟩,
 end
 
@@ -237,7 +240,7 @@ let ⟨z, hz, hx, hy⟩ := s.directed x hx y hy in s.lower (sup_le hx hy) hz
 end semilattice_sup
 
 section semilattice_sup_directed
-variables [semilattice_sup P] [is_directed P (swap (≤))] {x : P} {I J K s t : ideal P}
+variables [semilattice_sup P] [is_directed P (≥)] {x : P} {I J K s t : ideal P}
 
 /-- The infimum of two ideals of a co-directed order is their intersection. -/
 instance : has_inf (ideal P) :=
diff --git a/src/order/imp.lean b/src/order/imp.lean
deleted file mode 100644
index 30e3b3cc2fc3a..0000000000000
--- a/src/order/imp.lean
+++ /dev/null
@@ -1,94 +0,0 @@
-/-
-Copyright (c) 2021 Floris van Doorn. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Floris van Doorn, Yury Kudryashov
--/
-import order.symm_diff
-import tactic.monotonicity.basic
-
-/-!
-# Implication and equivalence as operations on a boolean algebra
-
-In this file we define `lattice.imp` (notation: `a ⇒ₒ b`) and `lattice.biimp` (notation: `a ⇔ₒ b`)
-to be the implication and equivalence as operations on a boolean algebra. More precisely, we put
-`a ⇒ₒ b = aᶜ ⊔ b` and `a ⇔ₒ b = (a ⇒ₒ b) ⊓ (b ⇒ₒ a)`. Equivalently, `a ⇒ₒ b = (a \ b)ᶜ` and
-`a ⇔ₒ b = (a ∆ b)ᶜ`. For propositions these operations are equal to the usual implication and `iff`.
--/
-
-variables {α β : Type*}
-
-namespace lattice
-
-/-- Implication as a binary operation on a boolean algebra. -/
-def imp [has_compl α] [has_sup α] (a b : α) : α := aᶜ ⊔ b
-
-infix ` ⇒ₒ `:65 := lattice.imp
-
-/-- Equivalence as a binary operation on a boolean algebra. -/
-def biimp [has_compl α] [has_sup α] [has_inf α] (a b : α) : α := (a ⇒ₒ b) ⊓ (b ⇒ₒ a)
-
-infix ` ⇔ₒ `:60 := lattice.biimp
-
-@[simp] lemma imp_eq_arrow (p q : Prop) : p ⇒ₒ q = (p → q) := propext imp_iff_not_or.symm
-
-@[simp] lemma biimp_eq_iff (p q : Prop) : p ⇔ₒ q = (p ↔ q) := by simp [biimp, ← iff_def]
-
-variables [boolean_algebra α] {a b c d : α}
-
-@[simp] lemma compl_imp (a b : α) : (a ⇒ₒ b)ᶜ = a \ b := by simp [imp, sdiff_eq]
-
-lemma compl_sdiff (a b : α) : (a \ b)ᶜ = a ⇒ₒ b := by rw [← compl_imp, compl_compl]
-
-@[mono] lemma imp_mono (h₁ : a ≤ b) (h₂ : c ≤ d) : b ⇒ₒ c ≤ a ⇒ₒ d :=
-sup_le_sup (compl_le_compl h₁) h₂
-
-lemma inf_imp_eq (a b c : α) : a ⊓ (b ⇒ₒ c) = (a ⇒ₒ b) ⇒ₒ (a ⊓ c) :=
-by unfold imp; simp [inf_sup_left]
-
-@[simp] lemma imp_eq_top_iff : (a ⇒ₒ b = ⊤) ↔ a ≤ b :=
-by rw [← compl_sdiff, compl_eq_top, sdiff_eq_bot_iff]
-
-@[simp] lemma imp_eq_bot_iff : (a ⇒ₒ b = ⊥) ↔ (a = ⊤ ∧ b = ⊥) := by simp [imp]
-
-@[simp] lemma imp_bot (a : α) : a ⇒ₒ ⊥ = aᶜ := sup_bot_eq
-
-@[simp] lemma top_imp (a : α) : ⊤ ⇒ₒ a = a := by simp [imp]
-
-@[simp] lemma bot_imp (a : α) : ⊥ ⇒ₒ a = ⊤ := imp_eq_top_iff.2 bot_le
-
-@[simp] lemma imp_top (a : α) : a ⇒ₒ ⊤ = ⊤ := imp_eq_top_iff.2 le_top
-
-@[simp] lemma imp_self (a : α) : a ⇒ₒ a = ⊤ := compl_sup_eq_top
-
-@[simp] lemma compl_imp_compl (a b : α) : aᶜ ⇒ₒ bᶜ = b ⇒ₒ a := by simp [imp, sup_comm]
-
-lemma imp_inf_le {α : Type*} [boolean_algebra α] (a b : α) : (a ⇒ₒ b) ⊓ a ≤ b :=
-by { unfold imp, rw [inf_sup_right], simp }
-
-lemma inf_imp_eq_imp_imp (a b c : α) : ((a ⊓ b) ⇒ₒ c) = (a ⇒ₒ (b ⇒ₒ c)) := by simp [imp, sup_assoc]
-
-lemma le_imp_iff : a ≤ (b ⇒ₒ c) ↔ a ⊓ b ≤ c :=
-by rw [imp, sup_comm, is_compl_compl.le_sup_right_iff_inf_left_le]
-
-lemma biimp_mp (a b : α) : (a ⇔ₒ b) ≤ (a ⇒ₒ b) := inf_le_left
-
-lemma biimp_mpr (a b : α) : (a ⇔ₒ b) ≤ (b ⇒ₒ a) := inf_le_right
-
-lemma biimp_comm (a b : α) : (a ⇔ₒ b) = (b ⇔ₒ a) :=
-by {unfold lattice.biimp, rw inf_comm}
-
-@[simp] lemma biimp_eq_top_iff : a ⇔ₒ b = ⊤ ↔ a = b :=
-by simp [biimp, ← le_antisymm_iff]
-
-@[simp] lemma biimp_self (a : α) : a ⇔ₒ a = ⊤ := biimp_eq_top_iff.2 rfl
-
-lemma biimp_symm : a ≤ (b ⇔ₒ c) ↔ a ≤ (c ⇔ₒ b) := by rw biimp_comm
-
-lemma compl_symm_diff (a b : α) : (a ∆ b)ᶜ = a ⇔ₒ b :=
-by simp only [biimp, imp, symm_diff, sdiff_eq, compl_sup, compl_inf, compl_compl]
-
-lemma compl_biimp (a b : α) : (a ⇔ₒ b)ᶜ = a ∆ b := by rw [← compl_symm_diff, compl_compl]
-
-@[simp] lemma compl_biimp_compl : aᶜ ⇔ₒ bᶜ = a ⇔ₒ b := by simp [biimp, inf_comm]
-
-end lattice
diff --git a/src/order/initial_seg.lean b/src/order/initial_seg.lean
new file mode 100644
index 0000000000000..e0365f4bc7537
--- /dev/null
+++ b/src/order/initial_seg.lean
@@ -0,0 +1,470 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro, Floris van Doorn
+-/
+
+import logic.equiv.set
+import order.rel_iso.set
+import order.well_founded
+
+/-!
+# Initial and principal segments
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines initial and principal segments.
+
+## Main definitions
+
+* `initial_seg r s`: type of order embeddings of `r` into `s` for which the range is an initial
+  segment (i.e., if `b` belongs to the range, then any `b' < b` also belongs to the range).
+  It is denoted by `r ≼i s`.
+* `principal_seg r s`: Type of order embeddings of `r` into `s` for which the range is a principal
+  segment, i.e., an interval of the form `(-∞, top)` for some element `top`. It is denoted by
+  `r ≺i s`.
+
+## Notations
+
+These notations belong to the `initial_seg` locale.
+
+* `r ≼i s`: the type of initial segment embeddings of `r` into `s`.
+* `r ≺i s`: the type of principal segment embeddings of `r` into `s`.
+-/
+
+/-!
+### Initial segments
+
+Order embeddings whose range is an initial segment of `s` (i.e., if `b` belongs to the range, then
+any `b' < b` also belongs to the range). The type of these embeddings from `r` to `s` is called
+`initial_seg r s`, and denoted by `r ≼i s`.
+-/
+
+variables {α : Type*} {β : Type*} {γ : Type*}
+  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
+
+open function
+
+/-- If `r` is a relation on `α` and `s` in a relation on `β`, then `f : r ≼i s` is an order
+embedding whose range is an initial segment. That is, whenever `b < f a` in `β` then `b` is in the
+range of `f`. -/
+structure initial_seg {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends r ↪r s :=
+(init' : ∀ a b, s b (to_rel_embedding a) → ∃ a', to_rel_embedding a' = b)
+
+localized "infix (name := initial_seg) ` ≼i `:25 := initial_seg" in initial_seg
+
+namespace initial_seg
+
+instance : has_coe (r ≼i s) (r ↪r s) := ⟨initial_seg.to_rel_embedding⟩
+
+instance : embedding_like (r ≼i s) α β :=
+{ coe := λ f, f.to_fun,
+  coe_injective' :=
+    begin
+      rintro ⟨f, hf⟩ ⟨g, hg⟩ h,
+      congr' with x,
+      exact congr_fun h x
+    end,
+  injective' := λ f, f.inj' }
+
+@[ext] lemma ext {f g : r ≼i s} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h
+
+@[simp] theorem coe_fn_mk (f : r ↪r s) (o) :
+  (@initial_seg.mk _ _ r s f o : α → β) = f := rfl
+
+@[simp] theorem coe_fn_to_rel_embedding (f : r ≼i s) : (f.to_rel_embedding : α → β) = f := rfl
+
+@[simp] theorem coe_coe_fn (f : r ≼i s) : ((f : r ↪r s) : α → β) = f := rfl
+
+theorem init (f : r ≼i s) {a : α} {b : β} : s b (f a) → ∃ a', f a' = b :=
+f.init' _ _
+
+theorem map_rel_iff (f : r ≼i s) {a b : α} : s (f a) (f b) ↔ r a b := f.1.map_rel_iff
+
+theorem init_iff (f : r ≼i s) {a : α} {b : β} : s b (f a) ↔ ∃ a', f a' = b ∧ r a' a :=
+⟨λ h, let ⟨a', e⟩ := f.init h in ⟨a', e, f.map_rel_iff.1 (e.symm ▸ h)⟩,
+ λ ⟨a', e, h⟩, e ▸ f.map_rel_iff.2 h⟩
+
+/-- An order isomorphism is an initial segment -/
+def of_iso (f : r ≃r s) : r ≼i s :=
+⟨f, λ a b h, ⟨f.symm b, rel_iso.apply_symm_apply f _⟩⟩
+
+/-- The identity function shows that `≼i` is reflexive -/
+@[refl] protected def refl (r : α → α → Prop) : r ≼i r :=
+⟨rel_embedding.refl _, λ a b h, ⟨_, rfl⟩⟩
+
+instance (r : α → α → Prop) : inhabited (r ≼i r) := ⟨initial_seg.refl r⟩
+
+/-- Composition of functions shows that `≼i` is transitive -/
+@[trans] protected def trans (f : r ≼i s) (g : s ≼i t) : r ≼i t :=
+⟨f.1.trans g.1, λ a c h, begin
+  simp at h ⊢,
+  rcases g.2 _ _ h with ⟨b, rfl⟩, have h := g.map_rel_iff.1 h,
+  rcases f.2 _ _ h with ⟨a', rfl⟩, exact ⟨a', rfl⟩
+end⟩
+
+@[simp] theorem refl_apply (x : α) : initial_seg.refl r x = x := rfl
+
+@[simp] theorem trans_apply (f : r ≼i s) (g : s ≼i t) (a : α) : (f.trans g) a = g (f a) := rfl
+
+instance subsingleton_of_trichotomous_of_irrefl [is_trichotomous β s] [is_irrefl β s]
+  [is_well_founded α r] : subsingleton (r ≼i s) :=
+⟨λ f g, begin
+  ext a,
+  apply is_well_founded.induction r a (λ b IH, _),
+  refine extensional_of_trichotomous_of_irrefl s (λ x, _),
+  rw [f.init_iff, g.init_iff],
+  exact exists_congr (λ x, and_congr_left $ λ hx, IH _ hx ▸ iff.rfl)
+end⟩
+
+instance [is_well_order β s] : subsingleton (r ≼i s) :=
+⟨λ a, by { letI := a.is_well_founded, apply subsingleton.elim }⟩
+
+protected theorem eq [is_well_order β s] (f g : r ≼i s) (a) : f a = g a :=
+by rw subsingleton.elim f g
+
+theorem antisymm.aux [is_well_order α r] (f : r ≼i s) (g : s ≼i r) : left_inverse g f :=
+initial_seg.eq (f.trans g) (initial_seg.refl _)
+
+/-- If we have order embeddings between `α` and `β` whose images are initial segments, and `β`
+is a well-order then `α` and `β` are order-isomorphic. -/
+def antisymm [is_well_order β s] (f : r ≼i s) (g : s ≼i r) : r ≃r s :=
+by haveI := f.to_rel_embedding.is_well_order; exact
+⟨⟨f, g, antisymm.aux f g, antisymm.aux g f⟩, λ _ _, f.map_rel_iff'⟩
+
+@[simp] theorem antisymm_to_fun [is_well_order β s]
+  (f : r ≼i s) (g : s ≼i r) : (antisymm f g : α → β) = f := rfl
+
+@[simp] theorem antisymm_symm [is_well_order α r] [is_well_order β s]
+  (f : r ≼i s) (g : s ≼i r) : (antisymm f g).symm = antisymm g f :=
+rel_iso.coe_fn_injective rfl
+
+theorem eq_or_principal [is_well_order β s] (f : r ≼i s) :
+  surjective f ∨ ∃ b, ∀ x, s x b ↔ ∃ y, f y = x :=
+or_iff_not_imp_right.2 $ λ h b,
+acc.rec_on (is_well_founded.wf.apply b : acc s b) $ λ x H IH,
+not_forall_not.1 $ λ hn,
+h ⟨x, λ y, ⟨(IH _), λ ⟨a, e⟩, by rw ← e; exact
+  (trichotomous _ _).resolve_right
+  (not_or (hn a) (λ hl, not_exists.2 hn (f.init hl)))⟩⟩
+
+/-- Restrict the codomain of an initial segment -/
+def cod_restrict (p : set β) (f : r ≼i s) (H : ∀ a, f a ∈ p) : r ≼i subrel s p :=
+⟨rel_embedding.cod_restrict p f H, λ a ⟨b, m⟩ (h : s b (f a)),
+  let ⟨a', e⟩ := f.init h in ⟨a', by clear _let_match; subst e; refl⟩⟩
+
+@[simp] theorem cod_restrict_apply (p) (f : r ≼i s) (H a) : cod_restrict p f H a = ⟨f a, H a⟩ := rfl
+
+/-- Initial segment from an empty type. -/
+def of_is_empty (r : α → α → Prop) (s : β → β → Prop) [is_empty α] : r ≼i s :=
+⟨rel_embedding.of_is_empty r s, is_empty_elim⟩
+
+/-- Initial segment embedding of an order `r` into the disjoint union of `r` and `s`. -/
+def le_add (r : α → α → Prop) (s : β → β → Prop) : r ≼i sum.lex r s :=
+⟨⟨⟨sum.inl, λ _ _, sum.inl.inj⟩, λ a b, sum.lex_inl_inl⟩,
+  λ a b, by cases b; [exact λ _, ⟨_, rfl⟩, exact false.elim ∘ sum.lex_inr_inl]⟩
+
+@[simp] theorem le_add_apply (r : α → α → Prop) (s : β → β → Prop)
+  (a) : le_add r s a = sum.inl a := rfl
+
+protected theorem acc (f : r ≼i s) (a : α) : acc r a ↔ acc s (f a) :=
+⟨begin
+    refine λ h, acc.rec_on h (λ a _ ha, acc.intro _ (λ b hb, _)),
+    obtain ⟨a', rfl⟩ := f.init hb,
+    exact ha _ (f.map_rel_iff.mp hb),
+  end, f.to_rel_embedding.acc a⟩
+
+end initial_seg
+
+/-!
+### Principal segments
+
+Order embeddings whose range is a principal segment of `s` (i.e., an interval of the form
+`(-∞, top)` for some element `top` of `β`). The type of these embeddings from `r` to `s` is called
+`principal_seg r s`, and denoted by `r ≺i s`. Principal segments are in particular initial
+segments.
+-/
+
+/-- If `r` is a relation on `α` and `s` in a relation on `β`, then `f : r ≺i s` is an order
+embedding whose range is an open interval `(-∞, top)` for some element `top` of `β`. Such order
+embeddings are called principal segments -/
+@[nolint has_nonempty_instance]
+structure principal_seg {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends r ↪r s :=
+(top : β)
+(down' : ∀ b, s b top ↔ ∃ a, to_rel_embedding a = b)
+
+localized "infix (name := principal_seg) ` ≺i `:25 := principal_seg" in initial_seg
+
+namespace principal_seg
+
+instance : has_coe (r ≺i s) (r ↪r s) := ⟨principal_seg.to_rel_embedding⟩
+instance : has_coe_to_fun (r ≺i s) (λ _, α → β) := ⟨λ f, f⟩
+
+@[simp] theorem coe_fn_mk (f : r ↪r s) (t o) :
+  (@principal_seg.mk _ _ r s f t o : α → β) = f := rfl
+
+@[simp] theorem coe_fn_to_rel_embedding (f : r ≺i s) : (f.to_rel_embedding : α → β) = f := rfl
+
+@[simp] theorem coe_coe_fn (f : r ≺i s) : ((f : r ↪r s) : α → β) = f := rfl
+
+theorem down (f : r ≺i s) : ∀ {b : β}, s b f.top ↔ ∃ a, f a = b := f.down'
+
+theorem lt_top (f : r ≺i s) (a : α) : s (f a) f.top := f.down.2 ⟨_, rfl⟩
+
+theorem init [is_trans β s] (f : r ≺i s) {a : α} {b : β} (h : s b (f a)) : ∃ a', f a' = b :=
+f.down.1 $ trans h $ f.lt_top _
+
+/-- A principal segment is in particular an initial segment. -/
+instance has_coe_initial_seg [is_trans β s] : has_coe (r ≺i s) (r ≼i s) :=
+⟨λ f, ⟨f.to_rel_embedding, λ a b, f.init⟩⟩
+
+theorem coe_coe_fn' [is_trans β s] (f : r ≺i s) : ((f : r ≼i s) : α → β) = f := rfl
+
+theorem init_iff [is_trans β s] (f : r ≺i s) {a : α} {b : β} :
+  s b (f a) ↔ ∃ a', f a' = b ∧ r a' a :=
+@initial_seg.init_iff α β r s f a b
+
+theorem irrefl {r : α → α → Prop} [is_well_order α r] (f : r ≺i r) : false :=
+begin
+  have := f.lt_top f.top,
+  rw [show f f.top = f.top, from
+      initial_seg.eq ↑f (initial_seg.refl r) f.top] at this,
+  exact irrefl _ this
+end
+
+instance (r : α → α → Prop) [is_well_order α r] : is_empty (r ≺i r) := ⟨λ f, f.irrefl⟩
+
+/-- Composition of a principal segment with an initial segment, as a principal segment -/
+def lt_le (f : r ≺i s) (g : s ≼i t) : r ≺i t :=
+⟨@rel_embedding.trans _ _ _ r s t f g, g f.top, λ a,
+ by simp only [g.init_iff, f.down', exists_and_distrib_left.symm,
+   exists_swap, rel_embedding.trans_apply, exists_eq_right']; refl⟩
+
+@[simp] theorem lt_le_apply (f : r ≺i s) (g : s ≼i t) (a : α) : (f.lt_le g) a = g (f a) :=
+rel_embedding.trans_apply _ _ _
+
+@[simp] theorem lt_le_top (f : r ≺i s) (g : s ≼i t) : (f.lt_le g).top = g f.top := rfl
+
+/-- Composition of two principal segments as a principal segment -/
+@[trans] protected def trans [is_trans γ t] (f : r ≺i s) (g : s ≺i t) : r ≺i t :=
+lt_le f g
+
+@[simp] theorem trans_apply [is_trans γ t] (f : r ≺i s) (g : s ≺i t) (a : α) :
+  (f.trans g) a = g (f a) :=
+lt_le_apply _ _ _
+
+@[simp] theorem trans_top [is_trans γ t] (f : r ≺i s) (g : s ≺i t) :
+  (f.trans g).top = g f.top := rfl
+
+/-- Composition of an order isomorphism with a principal segment, as a principal segment -/
+def equiv_lt (f : r ≃r s) (g : s ≺i t) : r ≺i t :=
+⟨@rel_embedding.trans _ _ _ r s t f g, g.top, λ c,
+ suffices (∃ (a : β), g a = c) ↔ ∃ (a : α), g (f a) = c, by simpa [g.down],
+ ⟨λ ⟨b, h⟩, ⟨f.symm b, by simp only [h, rel_iso.apply_symm_apply, rel_iso.coe_coe_fn]⟩,
+  λ ⟨a, h⟩, ⟨f a, h⟩⟩⟩
+
+/-- Composition of a principal segment with an order isomorphism, as a principal segment -/
+def lt_equiv {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
+  (f : principal_seg r s) (g : s ≃r t) : principal_seg r t :=
+⟨@rel_embedding.trans _ _ _ r s t f g, g f.top,
+  begin
+    intro x,
+    rw [← g.apply_symm_apply x, g.map_rel_iff, f.down', exists_congr],
+    intro y, exact ⟨congr_arg g, λ h, g.to_equiv.bijective.1 h⟩
+  end⟩
+
+@[simp] theorem equiv_lt_apply (f : r ≃r s) (g : s ≺i t) (a : α) : (equiv_lt f g) a = g (f a) :=
+rel_embedding.trans_apply _ _ _
+
+@[simp] theorem equiv_lt_top (f : r ≃r s) (g : s ≺i t) : (equiv_lt f g).top = g.top := rfl
+
+/-- Given a well order `s`, there is a most one principal segment embedding of `r` into `s`. -/
+instance [is_well_order β s] : subsingleton (r ≺i s) :=
+⟨λ f g, begin
+  have ef : (f : α → β) = g,
+  { show ((f : r ≼i s) : α → β) = g,
+    rw @subsingleton.elim _ _ (f : r ≼i s) g, refl },
+  have et : f.top = g.top,
+  { refine extensional_of_trichotomous_of_irrefl s (λ x, _),
+    simp only [f.down, g.down, ef, coe_fn_to_rel_embedding] },
+  cases f, cases g,
+  have := rel_embedding.coe_fn_injective ef; congr'
+end⟩
+
+theorem top_eq [is_well_order γ t]
+  (e : r ≃r s) (f : r ≺i t) (g : s ≺i t) : f.top = g.top :=
+by rw subsingleton.elim f (principal_seg.equiv_lt e g); refl
+
+lemma top_lt_top {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
+  [is_well_order γ t]
+  (f : principal_seg r s) (g : principal_seg s t) (h : principal_seg r t) : t h.top g.top :=
+by { rw [subsingleton.elim h (f.trans g)], apply principal_seg.lt_top }
+
+/-- Any element of a well order yields a principal segment -/
+def of_element {α : Type*} (r : α → α → Prop) (a : α) : subrel r {b | r b a} ≺i r :=
+⟨subrel.rel_embedding _ _, a, λ b,
+  ⟨λ h, ⟨⟨_, h⟩, rfl⟩, λ ⟨⟨_, h⟩, rfl⟩, h⟩⟩
+
+@[simp] theorem of_element_apply {α : Type*} (r : α → α → Prop) (a : α) (b) :
+  of_element r a b = b.1 := rfl
+
+@[simp] theorem of_element_top {α : Type*} (r : α → α → Prop) (a : α) :
+  (of_element r a).top = a := rfl
+
+/-- For any principal segment `r ≺i s`, there is a `subrel` of `s` order isomorphic to `r`. -/
+@[simps symm_apply]
+noncomputable def subrel_iso (f : r ≺i s) : subrel s {b | s b f.top} ≃r r :=
+rel_iso.symm
+{ to_equiv := ((equiv.of_injective f f.injective).trans (equiv.set_congr
+    (funext (λ x, propext f.down.symm)))),
+  map_rel_iff' := λ a₁ a₂, f.map_rel_iff }
+
+@[simp] theorem apply_subrel_iso (f : r ≺i s) (b : {b | s b f.top}) :
+  f (f.subrel_iso b) = b :=
+equiv.apply_of_injective_symm f.injective _
+
+@[simp] theorem subrel_iso_apply (f : r ≺i s) (a : α) :
+  f.subrel_iso ⟨f a, f.down.mpr ⟨a, rfl⟩⟩ = a :=
+equiv.of_injective_symm_apply f.injective _
+
+/-- Restrict the codomain of a principal segment -/
+def cod_restrict (p : set β) (f : r ≺i s)
+  (H : ∀ a, f a ∈ p) (H₂ : f.top ∈ p) : r ≺i subrel s p :=
+⟨rel_embedding.cod_restrict p f H, ⟨f.top, H₂⟩, λ ⟨b, h⟩,
+  f.down.trans $ exists_congr $ λ a,
+  show (⟨f a, H a⟩ : p).1 = _ ↔ _, from ⟨subtype.eq, congr_arg _⟩⟩
+
+@[simp]
+theorem cod_restrict_apply (p) (f : r ≺i s) (H H₂ a) : cod_restrict p f H H₂ a = ⟨f a, H a⟩ := rfl
+
+@[simp]
+theorem cod_restrict_top (p) (f : r ≺i s) (H H₂) : (cod_restrict p f H H₂).top = ⟨f.top, H₂⟩ := rfl
+
+/-- Principal segment from an empty type into a type with a minimal element. -/
+def of_is_empty (r : α → α → Prop) [is_empty α] {b : β} (H : ∀ b', ¬ s b' b) : r ≺i s :=
+{ top := b,
+  down' := by simp [H],
+  ..rel_embedding.of_is_empty r s }
+
+@[simp] theorem of_is_empty_top (r : α → α → Prop) [is_empty α] {b : β} (H : ∀ b', ¬ s b' b) :
+  (of_is_empty r H).top = b := rfl
+
+/-- Principal segment from the empty relation on `pempty` to the empty relation on `punit`. -/
+@[reducible] def pempty_to_punit : @empty_relation pempty ≺i @empty_relation punit :=
+@of_is_empty _ _ empty_relation _ _ punit.star $ λ x, not_false
+
+protected theorem acc [is_trans β s] (f : r ≺i s) (a : α) : acc r a ↔ acc s (f a) :=
+(f : r ≼i s).acc a
+
+end principal_seg
+
+/--
+A relation is well-founded iff every principal segment of it is well-founded.
+
+In this lemma we use `subrel` to indicate its principal segments because it's usually more
+convenient to use.
+-/
+theorem well_founded_iff_well_founded_subrel {β : Type*} {s : β → β → Prop} [is_trans β s] :
+  well_founded s ↔ (∀ b, well_founded (subrel s {b' | s b' b})) :=
+begin
+  refine ⟨λ wf b, ⟨λ b', ((principal_seg.of_element _ b).acc b').mpr (wf.apply b')⟩,
+    λ wf, ⟨λ b, acc.intro _ (λ b' hb', _)⟩⟩,
+  let f := principal_seg.of_element s b,
+  obtain ⟨b', rfl⟩ := f.down.mp ((principal_seg.of_element_top s b).symm ▸ hb' : s b' f.top),
+  exact (f.acc b').mp ((wf b).apply b'),
+end
+
+theorem {u} well_founded_iff_principal_seg {β : Type u} {s : β → β → Prop} [is_trans β s] :
+  well_founded s ↔ (∀ (α : Type u) (r : α → α → Prop) (f : r ≺i s), well_founded r) :=
+⟨λ wf α r f, rel_hom_class.well_founded f.to_rel_embedding wf,
+  λ h, well_founded_iff_well_founded_subrel.mpr (λ b, h _ _ (principal_seg.of_element s b))⟩
+
+/-! ### Properties of initial and principal segments -/
+
+/-- To an initial segment taking values in a well order, one can associate either a principal
+segment (if the range is not everything, hence one can take as top the minimum of the complement
+of the range) or an order isomorphism (if the range is everything). -/
+noncomputable def initial_seg.lt_or_eq [is_well_order β s] (f : r ≼i s) : (r ≺i s) ⊕ (r ≃r s) :=
+begin
+  by_cases h : surjective f,
+  { exact sum.inr (rel_iso.of_surjective f h) },
+  { have h' : _, from (initial_seg.eq_or_principal f).resolve_left h,
+    exact sum.inl ⟨f, classical.some h', classical.some_spec h'⟩ }
+end
+
+theorem initial_seg.lt_or_eq_apply_left [is_well_order β s]
+  (f : r ≼i s) (g : r ≺i s) (a : α) : g a = f a :=
+@initial_seg.eq α β r s _ g f a
+
+theorem initial_seg.lt_or_eq_apply_right [is_well_order β s]
+  (f : r ≼i s) (g : r ≃r s) (a : α) : g a = f a :=
+initial_seg.eq (initial_seg.of_iso g) f a
+
+/-- Composition of an initial segment taking values in a well order and a principal segment. -/
+noncomputable def initial_seg.le_lt [is_well_order β s] [is_trans γ t] (f : r ≼i s) (g : s ≺i t) :
+  r ≺i t :=
+match f.lt_or_eq with
+| sum.inl f' := f'.trans g
+| sum.inr f' := principal_seg.equiv_lt f' g
+end
+
+@[simp] theorem initial_seg.le_lt_apply [is_well_order β s] [is_trans γ t]
+  (f : r ≼i s) (g : s ≺i t) (a : α) : (f.le_lt g) a = g (f a) :=
+begin
+  delta initial_seg.le_lt, cases h : f.lt_or_eq with f' f',
+  { simp only [principal_seg.trans_apply, f.lt_or_eq_apply_left] },
+  { simp only [principal_seg.equiv_lt_apply, f.lt_or_eq_apply_right] }
+end
+
+namespace rel_embedding
+
+/-- Given an order embedding into a well order, collapse the order embedding by filling the
+gaps, to obtain an initial segment. Here, we construct the collapsed order embedding pointwise,
+but the proof of the fact that it is an initial segment will be given in `collapse`. -/
+noncomputable def collapse_F [is_well_order β s] (f : r ↪r s) : Π a, {b // ¬ s (f a) b} :=
+(rel_embedding.well_founded f $ is_well_founded.wf).fix $ λ a IH, begin
+  let S := {b | ∀ a h, s (IH a h).1 b},
+  have : f a ∈ S, from λ a' h, ((trichotomous _ _)
+    .resolve_left $ λ h', (IH a' h).2 $ trans (f.map_rel_iff.2 h) h')
+    .resolve_left $ λ h', (IH a' h).2 $ h' ▸ f.map_rel_iff.2 h,
+  exact ⟨is_well_founded.wf.min S ⟨_, this⟩,
+   is_well_founded.wf.not_lt_min _ _ this⟩
+end
+
+theorem collapse_F.lt [is_well_order β s] (f : r ↪r s) {a : α}
+   : ∀ {a'}, r a' a → s (collapse_F f a').1 (collapse_F f a).1 :=
+show (collapse_F f a).1 ∈ {b | ∀ a' (h : r a' a), s (collapse_F f a').1 b}, begin
+  unfold collapse_F, rw well_founded.fix_eq,
+  apply well_founded.min_mem _ _
+end
+
+theorem collapse_F.not_lt [is_well_order β s] (f : r ↪r s) (a : α)
+   {b} (h : ∀ a' (h : r a' a), s (collapse_F f a').1 b) : ¬ s b (collapse_F f a).1 :=
+begin
+  unfold collapse_F, rw well_founded.fix_eq,
+  exact well_founded.not_lt_min _ _ _
+    (show b ∈ {b | ∀ a' (h : r a' a), s (collapse_F f a').1 b}, from h)
+end
+
+/-- Construct an initial segment from an order embedding into a well order, by collapsing it
+to fill the gaps. -/
+noncomputable def collapse [is_well_order β s] (f : r ↪r s) : r ≼i s :=
+by haveI := rel_embedding.is_well_order f; exact
+⟨rel_embedding.of_monotone
+  (λ a, (collapse_F f a).1) (λ a b, collapse_F.lt f),
+λ a b, acc.rec_on (is_well_founded.wf.apply b : acc s b) (λ b H IH a h, begin
+  let S := {a | ¬ s (collapse_F f a).1 b},
+  have : S.nonempty := ⟨_, asymm h⟩,
+  existsi (is_well_founded.wf : well_founded r).min S this,
+  refine ((@trichotomous _ s _ _ _).resolve_left _).resolve_right _,
+  { exact (is_well_founded.wf : well_founded r).min_mem S this },
+  { refine collapse_F.not_lt f _ (λ a' h', _),
+    by_contradiction hn,
+    exact is_well_founded.wf.not_lt_min S this hn h' }
+end) a⟩
+
+theorem collapse_apply [is_well_order β s] (f : r ↪r s)
+  (a) : collapse f a = (collapse_F f a).1 := rfl
+
+end rel_embedding
diff --git a/src/order/interval.lean b/src/order/interval.lean
new file mode 100644
index 0000000000000..bdaa1250c6a6d
--- /dev/null
+++ b/src/order/interval.lean
@@ -0,0 +1,479 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import data.set.intervals.basic
+import data.set.lattice
+import data.set_like.basic
+
+/-!
+# Order intervals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines (nonempty) closed intervals in an order (see `set.Icc`). This is a prototype for
+interval arithmetic.
+
+## Main declarations
+
+* `nonempty_interval`: Nonempty intervals. Pairs where the second element is greater than the first.
+* `interval`: Intervals. Either `∅` or a nonempty interval.
+-/
+
+open function order_dual set
+
+variables {α β γ δ : Type*} {ι : Sort*} {κ : ι → Sort*}
+
+/-- The nonempty closed intervals in an order.
+
+We define intervals by the pair of endpoints `fst`, `snd`. To convert intervals to the set of
+elements between these endpoints, use the coercion `nonempty_interval α → set α`. -/
+@[ext] structure nonempty_interval (α : Type*) [has_le α] extends α × α :=
+(fst_le_snd : fst ≤ snd)
+
+namespace nonempty_interval
+section has_le
+variables [has_le α] {s t : nonempty_interval α}
+
+lemma to_prod_injective : injective (to_prod : nonempty_interval α → α × α) :=
+λ s t, (ext_iff _ _).2
+
+/-- The injection that induces the order on intervals. -/
+def to_dual_prod : nonempty_interval α → αᵒᵈ × α := to_prod
+
+@[simp] lemma to_dual_prod_apply (s : nonempty_interval α) :
+  s.to_dual_prod = (to_dual s.fst, s.snd) := prod.mk.eta.symm
+
+lemma to_dual_prod_injective : injective (to_dual_prod : nonempty_interval α → αᵒᵈ × α) :=
+to_prod_injective
+
+instance [is_empty α] : is_empty (nonempty_interval α) := ⟨λ s, is_empty_elim s.fst⟩
+instance [subsingleton α] : subsingleton (nonempty_interval α) :=
+to_dual_prod_injective.subsingleton
+
+instance : has_le (nonempty_interval α) := ⟨λ s t, t.fst ≤ s.fst ∧ s.snd ≤ t.snd⟩
+
+lemma le_def : s ≤ t ↔ t.fst ≤ s.fst ∧ s.snd ≤ t.snd := iff.rfl
+
+/-- `to_dual_prod` as an order embedding. -/
+@[simps] def to_dual_prod_hom : nonempty_interval α ↪o αᵒᵈ × α :=
+{ to_fun := to_dual_prod,
+  inj' := to_dual_prod_injective,
+  map_rel_iff' := λ _ _, iff.rfl }
+
+/-- Turn an interval into an interval in the dual order. -/
+def dual : nonempty_interval α ≃ nonempty_interval αᵒᵈ :=
+{ to_fun := λ s, ⟨s.to_prod.swap, s.fst_le_snd⟩,
+  inv_fun := λ s, ⟨s.to_prod.swap, s.fst_le_snd⟩,
+  left_inv := λ s, ext _ _ $ prod.swap_swap _,
+  right_inv := λ s, ext _ _ $ prod.swap_swap _ }
+
+@[simp] lemma fst_dual (s : nonempty_interval α) : s.dual.fst = to_dual s.snd := rfl
+@[simp] lemma snd_dual (s : nonempty_interval α) : s.dual.snd = to_dual s.fst := rfl
+
+end has_le
+
+section preorder
+variables [preorder α] [preorder β] [preorder γ] [preorder δ] {s : nonempty_interval α} {x : α × α}
+  {a : α}
+
+instance : preorder (nonempty_interval α) := preorder.lift to_dual_prod
+
+instance : has_coe_t (nonempty_interval α) (set α) := ⟨λ s, Icc s.fst s.snd⟩
+@[priority 100] instance : has_mem α (nonempty_interval α) := ⟨λ a s, a ∈ (s : set α)⟩
+
+@[simp] lemma mem_mk {hx : x.1 ≤ x.2} : a ∈ mk x hx ↔ x.1 ≤ a ∧ a ≤ x.2 := iff.rfl
+lemma mem_def : a ∈ s ↔ s.fst ≤ a ∧ a ≤ s.snd := iff.rfl
+
+@[simp] lemma coe_nonempty (s : nonempty_interval α) : (s : set α).nonempty :=
+nonempty_Icc.2 s.fst_le_snd
+
+/-- `{a}` as an interval. -/
+@[simps] def pure (a : α) : nonempty_interval α := ⟨⟨a, a⟩, le_rfl⟩
+
+lemma mem_pure_self (a : α) : a ∈ pure a := ⟨le_rfl, le_rfl⟩
+
+lemma pure_injective : injective (pure : α → nonempty_interval α) :=
+λ s t, congr_arg $ prod.fst ∘ to_prod
+
+@[simp] lemma dual_pure (a : α) : (pure a).dual = pure (to_dual a) := rfl
+
+instance [inhabited α] : inhabited (nonempty_interval α) := ⟨pure default⟩
+instance : ∀ [nonempty α], nonempty (nonempty_interval α) := nonempty.map pure
+instance [nontrivial α] : nontrivial (nonempty_interval α) := pure_injective.nontrivial
+
+/-- Pushforward of nonempty intervals. -/
+@[simps] def map (f : α →o β) (a : nonempty_interval α) : nonempty_interval β :=
+⟨a.to_prod.map f f, f.mono a.fst_le_snd⟩
+
+@[simp] lemma map_pure (f : α →o β) (a : α) : (pure a).map f = pure (f a) := rfl
+@[simp] lemma map_map (g : β →o γ) (f : α →o β) (a : nonempty_interval α) :
+  (a.map f).map g = a.map (g.comp f) := rfl
+
+@[simp] lemma dual_map (f : α →o β) (a : nonempty_interval α) :
+  (a.map f).dual = a.dual.map f.dual := rfl
+
+/-- Binary pushforward of nonempty intervals. -/
+@[simps]
+def map₂ (f : α → β → γ) (h₀ : ∀ b, monotone (λ a, f a b)) (h₁ : ∀ a, monotone (f a)) :
+  nonempty_interval α → nonempty_interval β → nonempty_interval γ :=
+λ s t, ⟨(f s.fst t.fst, f s.snd t.snd), (h₀ _ s.fst_le_snd).trans $ h₁ _ t.fst_le_snd⟩
+
+@[simp] lemma map₂_pure (f : α → β → γ) (h₀ h₁) (a : α) (b : β) :
+  map₂ f h₀ h₁ (pure a) (pure b) = pure (f a b) := rfl
+
+@[simp] lemma dual_map₂ (f : α → β → γ) (h₀ h₁ s t) :
+  (map₂ f h₀ h₁ s t).dual = map₂ (λ a b, to_dual $ f (of_dual a) $ of_dual b)
+    (λ _, (h₀ _).dual) (λ _, (h₁ _).dual) s.dual t.dual := rfl
+
+variables [bounded_order α]
+
+instance : order_top (nonempty_interval α) :=
+{ top := ⟨⟨⊥, ⊤⟩, bot_le⟩,
+  le_top := λ a, ⟨bot_le, le_top⟩ }
+
+@[simp] lemma dual_top : (⊤ : nonempty_interval α).dual = ⊤ := rfl
+
+end preorder
+
+section partial_order
+variables [partial_order α] [partial_order β] {s t : nonempty_interval α} {x : α × α} {a b : α}
+
+instance : partial_order (nonempty_interval α) := partial_order.lift _ to_dual_prod_injective
+
+/-- Consider a nonempty interval `[a, b]` as the set `[a, b]`. -/
+def coe_hom : nonempty_interval α ↪o set α :=
+order_embedding.of_map_le_iff (λ s, Icc s.fst s.snd) (λ s t, Icc_subset_Icc_iff s.fst_le_snd)
+
+instance : set_like (nonempty_interval α) α :=
+{ coe := λ s, Icc s.fst s.snd,
+  coe_injective' := coe_hom.injective }
+
+@[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ s ≤ t := (@coe_hom α _).le_iff_le
+@[simp, norm_cast] lemma coe_ssubset_coe : (s : set α) ⊂ t ↔ s < t := (@coe_hom α _).lt_iff_lt
+
+@[simp] lemma coe_coe_hom : (coe_hom : nonempty_interval α → set α) = coe := rfl
+
+@[simp, norm_cast] lemma coe_pure (a : α) : (pure a : set α) = {a} := Icc_self _
+
+@[simp] lemma mem_pure : b ∈ pure a ↔ b = a :=
+by rw [←set_like.mem_coe, coe_pure, mem_singleton_iff]
+
+@[simp, norm_cast]
+lemma coe_top [bounded_order α] : ((⊤ : nonempty_interval α) : set α) = univ := Icc_bot_top
+
+@[simp, norm_cast]
+lemma coe_dual (s : nonempty_interval α) : (s.dual : set αᵒᵈ) = of_dual ⁻¹' s := dual_Icc
+
+lemma subset_coe_map (f : α →o β) (s : nonempty_interval α) : f '' s ⊆ s.map f :=
+image_subset_iff.2 $ λ a ha, ⟨f.mono ha.1, f.mono ha.2⟩
+
+end partial_order
+
+section lattice
+variables [lattice α]
+
+instance : has_sup (nonempty_interval α) :=
+⟨λ s t, ⟨⟨s.fst ⊓ t.fst, s.snd ⊔ t.snd⟩, inf_le_left.trans $ s.fst_le_snd.trans le_sup_left⟩⟩
+
+instance : semilattice_sup (nonempty_interval α) :=
+to_dual_prod_injective.semilattice_sup _ $ λ _ _, rfl
+
+@[simp] lemma fst_sup (s t : nonempty_interval α) : (s ⊔ t).fst = s.fst ⊓ t.fst := rfl
+@[simp] lemma snd_sup (s t : nonempty_interval α) : (s ⊔ t).snd = s.snd ⊔ t.snd := rfl
+
+end lattice
+end nonempty_interval
+
+/-- The closed intervals in an order.
+
+We represent intervals either as `⊥` or a nonempty interval given by its endpoints `fst`, `snd`.
+To convert intervals to the set of elements between these endpoints, use the coercion
+`interval α → set α`. -/
+@[derive [inhabited, has_le, order_bot]]
+def interval (α : Type*) [has_le α] := with_bot (nonempty_interval α)
+
+namespace interval
+section has_le
+variables [has_le α] {s t : interval α}
+
+instance : has_coe_t (nonempty_interval α) (interval α) := with_bot.has_coe_t
+instance can_lift : can_lift (interval α) (nonempty_interval α) coe (λ r, r ≠ ⊥) :=
+with_bot.can_lift
+
+lemma coe_injective : injective (coe : nonempty_interval α → interval α) := with_bot.coe_injective
+@[simp, norm_cast] lemma coe_inj {s t : nonempty_interval α} : (s : interval α) = t ↔ s = t :=
+with_bot.coe_inj
+
+@[protected] lemma «forall» {p : interval α → Prop} :
+  (∀ s, p s) ↔ p ⊥ ∧ ∀ s : nonempty_interval α, p s := option.forall
+@[protected] lemma «exists» {p : interval α → Prop} :
+  (∃ s, p s) ↔ p ⊥ ∨ ∃ s : nonempty_interval α, p s := option.exists
+
+instance [is_empty α] : unique (interval α) := option.unique
+
+/-- Turn an interval into an interval in the dual order. -/
+def dual : interval α ≃ interval αᵒᵈ := nonempty_interval.dual.option_congr
+
+end has_le
+
+section preorder
+variables [preorder α] [preorder β] [preorder γ]
+
+instance : preorder (interval α) := with_bot.preorder
+
+/-- `{a}` as an interval. -/
+def pure (a : α) : interval α := nonempty_interval.pure a
+
+lemma pure_injective : injective (pure : α → interval α) :=
+coe_injective.comp nonempty_interval.pure_injective
+
+@[simp] lemma dual_pure (a : α) : (pure a).dual = pure (to_dual a) := rfl
+@[simp] lemma dual_bot : (⊥ : interval α).dual = ⊥ := rfl
+@[simp] lemma pure_ne_bot {a : α} : pure a ≠ ⊥ := with_bot.coe_ne_bot
+@[simp] lemma bot_ne_pure {a : α} : ⊥ ≠ pure a := with_bot.bot_ne_coe
+
+instance [nonempty α] : nontrivial (interval α) := option.nontrivial
+
+/-- Pushforward of intervals. -/
+def map (f : α →o β) : interval α → interval β := with_bot.map (nonempty_interval.map f)
+
+@[simp] lemma map_pure (f : α →o β) (a : α) : (pure a).map f = pure (f a) := rfl
+@[simp] lemma map_map (g : β →o γ) (f : α →o β) (s : interval α) :
+  (s.map f).map g = s.map (g.comp f) := option.map_map _ _ _
+
+@[simp] lemma dual_map (f : α →o β) (s : interval α) : (s.map f).dual = s.dual.map f.dual :=
+by { cases s, { refl }, { exact with_bot.map_comm rfl _ } }
+
+variables [bounded_order α]
+
+instance : bounded_order (interval α) := with_bot.bounded_order
+
+@[simp] lemma dual_top : (⊤ : interval α).dual = ⊤ := rfl
+
+end preorder
+
+section partial_order
+variables [partial_order α] [partial_order β] {s t : interval α} {a b : α}
+
+instance : partial_order (interval α) := with_bot.partial_order
+
+/-- Consider a interval `[a, b]` as the set `[a, b]`. -/
+def coe_hom : interval α ↪o set α :=
+order_embedding.of_map_le_iff (λ s, match s with
+    | ⊥ := ∅
+    | some s := s
+  end) (λ s t, match s, t with
+  | ⊥, t := iff_of_true bot_le bot_le
+  | some s, ⊥ := iff_of_false (λ h, s.coe_nonempty.ne_empty $ le_bot_iff.1 h)
+                   (with_bot.not_coe_le_bot _)
+  | some s, some t := (@nonempty_interval.coe_hom α _).le_iff_le.trans with_bot.some_le_some.symm
+  end)
+
+instance : set_like (interval α) α :=
+{ coe := coe_hom,
+  coe_injective' := coe_hom.injective }
+
+@[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ s ≤ t := (@coe_hom α _).le_iff_le
+@[simp, norm_cast] lemma coe_ssubset_coe : (s : set α) ⊂ t ↔ s < t := (@coe_hom α _).lt_iff_lt
+@[simp, norm_cast] lemma coe_pure (a : α) : (pure a : set α) = {a} := Icc_self _
+@[simp, norm_cast] lemma coe_coe (s : nonempty_interval α) : ((s : interval α) : set α) = s := rfl
+@[simp, norm_cast] lemma coe_bot : ((⊥  : interval α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_top [bounded_order α] : ((⊤ : interval α) : set α) = univ :=
+Icc_bot_top
+@[simp, norm_cast] lemma coe_dual (s : interval α) : (s.dual : set αᵒᵈ) = of_dual ⁻¹' s :=
+by { cases s, { refl }, exact s.coe_dual }
+
+lemma subset_coe_map (f : α →o β) : ∀ s : interval α, f '' s ⊆ s.map f
+| ⊥ := by simp
+| (s : nonempty_interval α) := s.subset_coe_map _
+
+@[simp] lemma mem_pure : b ∈ pure a ↔ b = a :=
+by rw [←set_like.mem_coe, coe_pure, mem_singleton_iff]
+lemma mem_pure_self (a : α) : a ∈ pure a := mem_pure.2 rfl
+
+end partial_order
+
+section lattice
+variables [lattice α]
+
+instance : semilattice_sup (interval α) := with_bot.semilattice_sup
+
+section decidable
+variables [@decidable_rel α (≤)]
+
+instance : lattice (interval α) :=
+{ inf := λ s t, match s, t with
+    | ⊥, t := ⊥
+    | s, ⊥ := ⊥
+    | some s, some t := if h : s.fst ≤ t.snd ∧ t.fst ≤ s.snd then some
+      ⟨⟨s.fst ⊔ t.fst, s.snd ⊓ t.snd⟩, sup_le (le_inf s.fst_le_snd h.1) $ le_inf h.2 t.fst_le_snd⟩
+      else ⊥
+  end,
+  inf_le_left := λ s t, match s, t with
+    | ⊥, ⊥ := bot_le
+    | ⊥, some t := bot_le
+    | some s, ⊥ := bot_le
+    | some s, some t := begin
+      change dite _ _ _ ≤ _,
+      split_ifs,
+      { exact with_bot.some_le_some.2 ⟨le_sup_left, inf_le_left⟩ },
+      { exact bot_le }
+    end
+  end,
+  inf_le_right := λ s t, match s, t with
+    | ⊥, ⊥ := bot_le
+    | ⊥, some t := bot_le
+    | some s, ⊥ := bot_le
+    | some s, some t := begin
+      change dite _ _ _ ≤ _,
+      split_ifs,
+      { exact with_bot.some_le_some.2 ⟨le_sup_right, inf_le_right⟩ },
+      { exact bot_le }
+    end
+  end,
+  le_inf := λ s t c, match s, t, c with
+    | ⊥, t, c := λ _ _, bot_le
+    | some s, t, c := λ hb hc, begin
+      lift t to nonempty_interval α using ne_bot_of_le_ne_bot with_bot.coe_ne_bot hb,
+      lift c to nonempty_interval α using ne_bot_of_le_ne_bot with_bot.coe_ne_bot hc,
+      change _ ≤ dite _ _ _,
+      simp only [with_bot.some_eq_coe, with_bot.coe_le_coe] at ⊢ hb hc,
+      rw [dif_pos, with_bot.coe_le_coe],
+      exact ⟨sup_le hb.1 hc.1, le_inf hb.2 hc.2⟩,
+      exact ⟨hb.1.trans $ s.fst_le_snd.trans hc.2, hc.1.trans $ s.fst_le_snd.trans hb.2⟩,
+    end
+  end,
+  ..interval.semilattice_sup }
+
+@[simp, norm_cast] lemma coe_inf (s t : interval α) : (↑(s ⊓ t) : set α) = s ∩ t :=
+begin
+  cases s,
+  { rw [with_bot.none_eq_bot, bot_inf_eq],
+    exact (empty_inter _).symm },
+  cases t,
+  { rw [with_bot.none_eq_bot, inf_bot_eq],
+    exact (inter_empty _).symm },
+  refine (_ : coe (dite _ _ _) = _).trans Icc_inter_Icc.symm,
+  split_ifs,
+  { refl },
+  { exact (Icc_eq_empty $ λ H,
+      h ⟨le_sup_left.trans $ H.trans inf_le_right, le_sup_right.trans $ H.trans inf_le_left⟩).symm }
+end
+
+end decidable
+
+@[simp, norm_cast]
+lemma disjoint_coe (s t : interval α) : disjoint (s : set α) t ↔ disjoint s t :=
+begin
+  classical,
+  rw [disjoint_iff_inf_le, disjoint_iff_inf_le, le_eq_subset, ←coe_subset_coe, coe_inf], refl
+end
+
+end lattice
+end interval
+
+namespace nonempty_interval
+section preorder
+variables [preorder α] {s : nonempty_interval α} {a : α}
+
+@[simp, norm_cast] lemma coe_pure_interval (a : α) : (pure a : interval α) = interval.pure a := rfl
+@[simp, norm_cast] lemma coe_eq_pure : (s : interval α) = interval.pure a ↔ s = pure a :=
+by rw [←interval.coe_inj, coe_pure_interval]
+
+@[simp, norm_cast]
+lemma coe_top_interval [bounded_order α] : ((⊤ : nonempty_interval α) : interval α) = ⊤ := rfl
+
+end preorder
+
+@[simp, norm_cast]
+lemma mem_coe_interval [partial_order α] {s : nonempty_interval α} {x : α} :
+  x ∈ (s : interval α) ↔ x ∈ s := iff.rfl
+
+@[simp, norm_cast] lemma coe_sup_interval [lattice α] (s t : nonempty_interval α) :
+  (↑(s ⊔ t) : interval α) = s ⊔ t := rfl
+
+end nonempty_interval
+
+namespace interval
+section complete_lattice
+variables [complete_lattice α]
+
+noncomputable instance [@decidable_rel α (≤)] : complete_lattice (interval α) :=
+by classical; exact { Sup := λ S, if h : S ⊆ {⊥} then ⊥ else some
+    ⟨⟨⨅ (s : nonempty_interval α) (h : ↑s ∈ S), s.fst,
+      ⨆ (s : nonempty_interval α) (h : ↑s ∈ S), s.snd⟩, begin
+        obtain ⟨s, hs, ha⟩ := not_subset.1 h,
+        lift s to nonempty_interval α using ha,
+        exact infi₂_le_of_le s hs (le_supr₂_of_le s hs s.fst_le_snd)
+      end⟩,
+  le_Sup := λ s s ha, begin
+    split_ifs,
+    { exact (h ha).le },
+    cases s,
+    { exact bot_le },
+    { exact with_bot.some_le_some.2 ⟨infi₂_le _ ha, le_supr₂_of_le _ ha le_rfl⟩ }
+  end,
+  Sup_le := λ s s ha, begin
+    split_ifs,
+    { exact bot_le },
+    obtain ⟨b, hs, hb⟩ := not_subset.1 h,
+    lift s to nonempty_interval α using ne_bot_of_le_ne_bot hb (ha _ hs),
+    exact with_bot.coe_le_coe.2 ⟨le_infi₂ $ λ c hc, (with_bot.coe_le_coe.1 $ ha _ hc).1,
+      supr₂_le $ λ c hc, (with_bot.coe_le_coe.1 $ ha _ hc).2⟩,
+  end,
+  Inf := λ S, if h : ⊥ ∉ S ∧ ∀ ⦃s : nonempty_interval α⦄, ↑s ∈ S → ∀ ⦃t : nonempty_interval α⦄,
+    ↑t ∈ S → s.fst ≤ t.snd then some
+      ⟨⟨⨆ (s : nonempty_interval α) (h : ↑s ∈ S), s.fst,
+        ⨅ (s : nonempty_interval α) (h : ↑s ∈ S), s.snd⟩,
+          supr₂_le $ λ s hs, le_infi₂ $ h.2 hs⟩ else ⊥,
+  Inf_le := λ s s ha, begin
+    split_ifs,
+    { lift s to nonempty_interval α using ne_of_mem_of_not_mem ha h.1,
+      exact with_bot.coe_le_coe.2 ⟨le_supr₂ s ha, infi₂_le s ha⟩ },
+    { exact bot_le }
+  end,
+  le_Inf := λ S s ha, begin
+    cases s,
+    { exact bot_le },
+    split_ifs,
+    { exact with_bot.some_le_some.2 ⟨supr₂_le $ λ t hb, (with_bot.coe_le_coe.1 $ ha _ hb).1,
+        le_infi₂ $ λ t hb, (with_bot.coe_le_coe.1 $ ha _ hb).2⟩ },
+    rw [not_and_distrib, not_not] at h,
+    cases h,
+    { exact ha _ h },
+    cases h (λ t hb c hc, (with_bot.coe_le_coe.1 $ ha _ hb).1.trans $ s.fst_le_snd.trans
+      (with_bot.coe_le_coe.1 $ ha _ hc).2),
+  end,
+  ..interval.lattice, ..interval.bounded_order }
+
+@[simp, norm_cast] lemma coe_Inf [@decidable_rel α (≤)] (S : set (interval α)) :
+  ↑(Inf S) = ⋂ s ∈ S, (s : set α) :=
+begin
+  change coe (dite _ _ _) = _,
+  split_ifs,
+  { ext,
+    simp [with_bot.some_eq_coe, interval.forall, h.1, ←forall_and_distrib,
+      ←nonempty_interval.mem_def] },
+  simp_rw [not_and_distrib, not_not] at h,
+  cases h,
+  { refine (eq_empty_of_subset_empty _).symm,
+    exact Inter₂_subset_of_subset _ h subset.rfl },
+  { refine (not_nonempty_iff_eq_empty.1 _).symm,
+    rintro ⟨x, hx⟩,
+    rw mem_Inter₂ at hx,
+    exact h (λ s ha t hb, (hx _ ha).1.trans (hx _ hb).2) }
+end
+
+@[simp, norm_cast] lemma coe_infi [@decidable_rel α (≤)] (f : ι → interval α) :
+  ↑(⨅ i, f i) = ⋂ i, (f i : set α) :=
+by simp [infi]
+
+@[simp, norm_cast] lemma coe_infi₂ [@decidable_rel α (≤)] (f : Π i, κ i → interval α) :
+  ↑(⨅ i j, f i j) = ⋂ i j, (f i j : set α) :=
+by simp_rw [coe_infi]
+
+end complete_lattice
+end interval
diff --git a/src/order/irreducible.lean b/src/order/irreducible.lean
new file mode 100644
index 0000000000000..0862574732a13
--- /dev/null
+++ b/src/order/irreducible.lean
@@ -0,0 +1,232 @@
+/-
+Copyright (c) 2023 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import data.finset.lattice
+import data.fintype.card
+
+/-!
+# Irreducible and prime elements in an order
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines irreducible and prime elements in an order and shows that in a well-founded
+lattice every element decomposes as a supremum of irreducible elements.
+
+An element is sup-irreducible (resp. inf-irreducible) if it isn't `⊥` and can't be written as the
+supremum of any strictly smaller elements. An element is sup-prime (resp. inf-prime) if it isn't `⊥`
+and is greater than the supremum of any two elements less than it.
+
+Primality implies irreducibility in general. The converse only holds in distributive lattices.
+Both hold for all (non-minimal) elements in a linear order.
+
+## Main declarations
+
+* `sup_irred a`: Sup-irreducibility, `a` isn't minimal and `a = b ⊔ c → a = b ∨ a = c`
+* `inf_irred a`: Inf-irreducibility, `a` isn't maximal and `a = b ⊓ c → a = b ∨ a = c`
+* `sup_prime a`: Sup-primality, `a` isn't minimal and `a ≤ b ⊔ c → a ≤ b ∨ a ≤ c`
+* `inf_irred a`: Inf-primality, `a` isn't maximal and `a ≥ b ⊓ c → a ≥ b ∨ a ≥ c`
+* `exists_sup_irred_decomposition`/`exists_inf_irred_decomposition`: Decomposition into irreducibles
+  in a well-founded semilattice.
+-/
+
+open finset order_dual
+
+variables {ι α : Type*}
+
+/-! ### Irreducible and prime elements -/
+
+section semilattice_sup
+variables [semilattice_sup α] {a b c : α}
+
+/-- A sup-irreducible element is a non-bottom element which isn't the supremum of anything smaller.
+-/
+def sup_irred (a : α) : Prop := ¬ is_min a ∧ ∀ ⦃b c⦄, b ⊔ c = a → b = a ∨ c = a
+
+/-- A sup-prime element is a non-bottom element which isn't less than the supremum of anything
+smaller. -/
+def sup_prime (a : α) : Prop := ¬ is_min a ∧ ∀ ⦃b c⦄, a ≤ b ⊔ c → a ≤ b ∨ a ≤ c
+
+lemma sup_irred.not_is_min (ha : sup_irred a) : ¬ is_min a := ha.1
+lemma sup_prime.not_is_min (ha : sup_prime a) : ¬ is_min a := ha.1
+lemma is_min.not_sup_irred (ha : is_min a) : ¬ sup_irred a := λ h, h.1 ha
+lemma is_min.not_sup_prime (ha : is_min a) : ¬ sup_prime a := λ h, h.1 ha
+
+@[simp] lemma not_sup_irred : ¬ sup_irred a ↔ is_min a ∨ ∃ b c, b ⊔ c = a ∧ b < a ∧ c < a :=
+begin
+  rw [sup_irred, not_and_distrib],
+  push_neg,
+  rw exists₂_congr,
+  simp [@eq_comm _ _ a] { contextual := tt },
+end
+
+@[simp] lemma not_sup_prime : ¬ sup_prime a ↔ is_min a ∨ ∃ b c, a ≤ b ⊔ c ∧ ¬ a ≤ b ∧ ¬ a ≤ c :=
+by { rw [sup_prime, not_and_distrib], push_neg, refl }
+
+protected lemma sup_prime.sup_irred : sup_prime a → sup_irred a :=
+and.imp_right $ λ h b c ha, by simpa [←ha] using h ha.ge
+
+lemma sup_prime.le_sup (ha : sup_prime a) : a ≤ b ⊔ c ↔ a ≤ b ∨ a ≤ c :=
+⟨λ h, ha.2 h, λ h, h.elim le_sup_of_le_left le_sup_of_le_right⟩
+
+variables [order_bot α] {s : finset ι} {f : ι → α}
+
+@[simp] lemma not_sup_irred_bot : ¬ sup_irred (⊥ : α) := is_min_bot.not_sup_irred
+@[simp] lemma not_sup_prime_bot : ¬ sup_prime (⊥ : α) := is_min_bot.not_sup_prime
+
+lemma sup_irred.ne_bot (ha : sup_irred a) : a ≠ ⊥ := by { rintro rfl, exact not_sup_irred_bot ha }
+lemma sup_prime.ne_bot (ha : sup_prime a) : a ≠ ⊥ := by { rintro rfl, exact not_sup_prime_bot ha }
+
+lemma sup_irred.finset_sup_eq (ha : sup_irred a) (h : s.sup f = a) : ∃ i ∈ s, f i = a :=
+begin
+  classical,
+  induction s using finset.induction with i s hi ih,
+  { simpa [ha.ne_bot] using h.symm },
+  simp only [exists_prop, exists_mem_insert] at ⊢ ih,
+  rw sup_insert at h,
+  exact (ha.2 h).imp_right ih,
+end
+
+lemma sup_prime.le_finset_sup (ha : sup_prime a) : a ≤ s.sup f ↔ ∃ i ∈ s, a ≤ f i :=
+begin
+  classical,
+  induction s using finset.induction with i s hi ih,
+  { simp [ha.ne_bot] },
+  { simp only [exists_prop, exists_mem_insert, sup_insert, ha.le_sup, ih] }
+end
+
+variables [well_founded_lt α]
+
+/-- In a well-founded lattice, any element is the supremum of finitely many sup-irreducible
+elements. This is the order-theoretic analogue of prime factorisation. -/
+lemma exists_sup_irred_decomposition (a : α) :
+  ∃ s : finset α, s.sup id = a ∧ ∀ ⦃b⦄, b ∈ s → sup_irred b :=
+begin
+  classical,
+  apply well_founded_lt.induction a _,
+  clear a,
+  rintro a ih,
+  by_cases ha : sup_irred a,
+  { exact ⟨{a}, by simp [ha]⟩ },
+  rw not_sup_irred at ha,
+  obtain ha | ⟨b, c, rfl, hb, hc⟩ := ha,
+  { exact ⟨∅, by simp [ha.eq_bot]⟩ },
+  obtain ⟨s, rfl, hs⟩ := ih _ hb,
+  obtain ⟨t, rfl, ht⟩ := ih _ hc,
+  exact ⟨s ∪ t, sup_union, forall_mem_union.2 ⟨hs, ht⟩⟩,
+end
+
+end semilattice_sup
+
+section semilattice_inf
+variables [semilattice_inf α] {a b c : α}
+
+/-- An inf-irreducible element is a non-top element which isn't the infimum of anything bigger. -/
+def inf_irred (a : α) : Prop := ¬ is_max a ∧ ∀ ⦃b c⦄, b ⊓ c = a → b = a ∨ c = a
+
+/-- An inf-prime element is a non-top element which isn't bigger than the infimum of anything
+bigger. -/
+def inf_prime (a : α) : Prop := ¬ is_max a ∧ ∀ ⦃b c⦄, b ⊓ c ≤ a → b ≤ a ∨ c ≤ a
+
+@[simp] lemma is_max.not_inf_irred (ha : is_max a) : ¬ inf_irred a := λ h, h.1 ha
+@[simp] lemma is_max.not_inf_prime (ha : is_max a) : ¬ inf_prime a := λ h, h.1 ha
+
+@[simp] lemma not_inf_irred : ¬ inf_irred a ↔ is_max a ∨ ∃ b c, b ⊓ c = a ∧ a < b ∧ a < c :=
+@not_sup_irred αᵒᵈ _ _
+
+@[simp] lemma not_inf_prime : ¬ inf_prime a ↔ is_max a ∨ ∃ b c, b ⊓ c ≤ a ∧ ¬ b ≤ a ∧ ¬ c ≤ a :=
+@not_sup_prime αᵒᵈ _ _
+
+protected lemma inf_prime.inf_irred : inf_prime a → inf_irred a :=
+and.imp_right $ λ h b c ha, by simpa [←ha] using h ha.le
+
+lemma inf_prime.inf_le (ha : inf_prime a) : b ⊓ c ≤ a ↔ b ≤ a ∨ c ≤ a :=
+⟨λ h, ha.2 h, λ h, h.elim inf_le_of_left_le inf_le_of_right_le⟩
+
+variables [order_top α] {s : finset ι} {f : ι → α}
+
+@[simp] lemma not_inf_irred_top : ¬ inf_irred (⊤ : α) := is_max_top.not_inf_irred
+@[simp] lemma not_inf_prime_top : ¬ inf_prime (⊤ : α) := is_max_top.not_inf_prime
+
+lemma inf_irred.ne_top (ha : inf_irred a) : a ≠ ⊤ := by { rintro rfl, exact not_inf_irred_top ha }
+lemma inf_prime.ne_top (ha : inf_prime a) : a ≠ ⊤ := by { rintro rfl, exact not_inf_prime_top ha }
+
+lemma inf_irred.finset_inf_eq : inf_irred a → s.inf f = a → ∃ i ∈ s, f i = a :=
+@sup_irred.finset_sup_eq _ αᵒᵈ _ _ _ _ _
+
+lemma inf_prime.finset_inf_le (ha : inf_prime a) : s.inf f ≤ a ↔ ∃ i ∈ s, f i ≤ a :=
+@sup_prime.le_finset_sup _ αᵒᵈ _ _ _ _ _ ha
+
+variables [well_founded_gt α]
+
+/-- In a cowell-founded lattice, any element is the infimum of finitely many inf-irreducible
+elements. This is the order-theoretic analogue of prime factorisation. -/
+lemma exists_inf_irred_decomposition (a : α) :
+  ∃ s : finset α, s.inf id = a ∧ ∀ ⦃b⦄, b ∈ s → inf_irred b :=
+@exists_sup_irred_decomposition αᵒᵈ _ _ _ _
+
+end semilattice_inf
+
+section semilattice_sup
+variables [semilattice_sup α]
+
+@[simp] lemma inf_irred_to_dual {a : α} : inf_irred (to_dual a) ↔ sup_irred a := iff.rfl
+@[simp] lemma inf_prime_to_dual {a : α} : inf_prime (to_dual a) ↔ sup_prime a := iff.rfl
+@[simp] lemma sup_irred_of_dual {a : αᵒᵈ} : sup_irred (of_dual a) ↔ inf_irred a := iff.rfl
+@[simp] lemma sup_prime_of_dual {a : αᵒᵈ} : sup_prime (of_dual a) ↔ inf_prime a := iff.rfl
+
+alias inf_irred_to_dual ↔ _ sup_irred.dual
+alias inf_prime_to_dual ↔ _ sup_prime.dual
+alias sup_irred_of_dual ↔ _ inf_irred.of_dual
+alias sup_prime_of_dual ↔ _ inf_prime.of_dual
+
+end semilattice_sup
+
+section semilattice_inf
+variables [semilattice_inf α]
+
+@[simp] lemma sup_irred_to_dual {a : α} : sup_irred (to_dual a) ↔ inf_irred a := iff.rfl
+@[simp] lemma sup_prime_to_dual {a : α} : sup_prime (to_dual a) ↔ inf_prime a := iff.rfl
+@[simp] lemma inf_irred_of_dual {a : αᵒᵈ} : inf_irred (of_dual a) ↔ sup_irred a := iff.rfl
+@[simp] lemma inf_prime_of_dual {a : αᵒᵈ} : inf_prime (of_dual a) ↔ sup_prime a := iff.rfl
+
+alias sup_irred_to_dual ↔ _ inf_irred.dual
+alias sup_prime_to_dual ↔ _ inf_prime.dual
+alias inf_irred_of_dual ↔ _ sup_irred.of_dual
+alias inf_prime_of_dual ↔ _ sup_prime.of_dual
+
+end semilattice_inf
+
+section distrib_lattice
+variables [distrib_lattice α] {a b c : α}
+
+@[simp] lemma sup_prime_iff_sup_irred : sup_prime a ↔ sup_irred a :=
+⟨sup_prime.sup_irred, and.imp_right $ λ h b c,
+  by { simp_rw [←inf_eq_left, inf_sup_left], exact @h _ _ }⟩
+
+@[simp] lemma inf_prime_iff_inf_irred : inf_prime a ↔ inf_irred a :=
+⟨inf_prime.inf_irred, and.imp_right $ λ h b c,
+  by { simp_rw [←sup_eq_left, sup_inf_left], exact @h _ _ }⟩
+
+alias sup_prime_iff_sup_irred ↔ _ sup_irred.sup_prime
+alias inf_prime_iff_inf_irred ↔ _ inf_irred.inf_prime
+
+attribute [protected] sup_irred.sup_prime inf_irred.inf_prime
+
+end distrib_lattice
+
+section linear_order
+variables [linear_order α] {a : α}
+
+@[simp] lemma sup_prime_iff_not_is_min : sup_prime a ↔ ¬ is_min a := and_iff_left $ by simp
+@[simp] lemma inf_prime_iff_not_is_max : inf_prime a ↔ ¬ is_max a := and_iff_left $ by simp
+
+@[simp] lemma sup_irred_iff_not_is_min : sup_irred a ↔ ¬ is_min a :=
+and_iff_left $ λ _ _, by simpa only [sup_eq_max, max_eq_iff] using or.imp and.left and.left
+
+@[simp] lemma inf_irred_iff_not_is_max : inf_irred a ↔ ¬ is_max a :=
+and_iff_left $ λ _ _, by simpa only [inf_eq_min, min_eq_iff] using or.imp and.left and.left
+
+end linear_order
diff --git a/src/order/iterate.lean b/src/order/iterate.lean
index 2b0b78c82ce61..1dfdb3b58f77d 100644
--- a/src/order/iterate.lean
+++ b/src/order/iterate.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import logic.function.iterate
-import data.nat.basic
+import order.monotone.basic
 
 /-!
 # Inequalities on iterates
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove some inequalities comparing `f^[n] x` and `g^[n] x` where `f` and `g` are
 two self-maps that commute with each other.
 
diff --git a/src/order/jordan_holder.lean b/src/order/jordan_holder.lean
index 69d1ef44e76ac..81b4c25040e92 100644
--- a/src/order/jordan_holder.lean
+++ b/src/order/jordan_holder.lean
@@ -7,9 +7,13 @@ import order.lattice
 import data.list.sort
 import logic.equiv.fin
 import logic.equiv.functor
+import data.fintype.card
 /-!
 # Jordan-Hölder Theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the Jordan Hölder theorem for a `jordan_holder_lattice`, a class also defined in
 this file. Examples of `jordan_holder_lattice` include `subgroup G` if `G` is a group, and
 `submodule R M` if `M` is an `R`-module. Using this approach the theorem need not be proved
@@ -147,7 +151,7 @@ instance : has_coe_to_fun (composition_series X) (λ x, fin (x.length + 1) → X
 
 instance [inhabited X] : inhabited (composition_series X) :=
 ⟨{ length := 0,
-   series := λ _, default,
+   series := default,
    step' := λ x, x.elim0 }⟩
 
 variables {X}
@@ -163,7 +167,7 @@ theorem lt_succ (s : composition_series X) (i : fin s.length) :
 lt_of_is_maximal (s.step _)
 
 protected theorem strict_mono (s : composition_series X) : strict_mono s :=
-fin.strict_mono_iff_lt_succ.2 (λ i h, s.lt_succ ⟨i, nat.lt_of_succ_lt_succ h⟩)
+fin.strict_mono_iff_lt_succ.2 s.lt_succ
 
 protected theorem injective (s : composition_series X) : function.injective s :=
 s.strict_mono.injective
@@ -248,14 +252,7 @@ list.pairwise_iff_nth_le.2 (λ i j hi hij,
   end)
 
 lemma to_list_nodup (s : composition_series X) : s.to_list.nodup :=
-list.nodup_iff_nth_le_inj.2
-  (λ i j hi hj,
-    begin
-      delta to_list,
-      rw [list.nth_le_of_fn', list.nth_le_of_fn', s.injective.eq_iff, fin.ext_iff,
-        fin.coe_mk, fin.coe_mk],
-      exact id
-    end)
+s.to_list_sorted.nodup
 
 @[simp] lemma mem_to_list {s : composition_series X} {x : X} : x ∈ s.to_list ↔ x ∈ s :=
 by rw [to_list, list.mem_of_fn, mem_def]
@@ -417,89 +414,91 @@ begin
   ext; simp [this]
 end
 
-lemma append_cast_add_aux
-  {s₁ s₂ : composition_series X}
-  (i : fin s₁.length) :
-  fin.append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂
-  (fin.cast_add s₂.length i).cast_succ = s₁ i.cast_succ :=
-by { cases i, simp [fin.append, *] }
+section fin_lemmas
+-- TODO: move these to `vec_notation` and rename them to better describe their statement
 
-lemma append_succ_cast_add_aux
-  {s₁ s₂ : composition_series X}
-  (i : fin s₁.length)
-  (h : s₁ (fin.last _) = s₂ 0) :
-  fin.append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂
-  (fin.cast_add s₂.length i).succ = s₁ i.succ :=
+variables {α : Type*} {m n : ℕ} (a : fin m.succ → α) (b : fin n.succ → α)
+
+lemma append_cast_add_aux (i : fin m) :
+  matrix.vec_append (nat.add_succ _ _).symm (a ∘ fin.cast_succ) b
+    (fin.cast_add n i).cast_succ = a i.cast_succ :=
+by { cases i, simp [matrix.vec_append_eq_ite, *] }
+
+lemma append_succ_cast_add_aux (i : fin m) (h : a (fin.last _) = b 0) :
+  matrix.vec_append (nat.add_succ _ _).symm (a ∘ fin.cast_succ) b
+  (fin.cast_add n i).succ = a i.succ :=
 begin
   cases i with i hi,
-  simp only [fin.append, hi, fin.succ_mk, function.comp_app, fin.cast_succ_mk,
+  simp only [matrix.vec_append_eq_ite, hi, fin.succ_mk, function.comp_app, fin.cast_succ_mk,
     fin.coe_mk, fin.cast_add_mk],
   split_ifs,
   { refl },
-  { have : i + 1 = s₁.length, from le_antisymm hi (le_of_not_gt h_1),
-    calc s₂ ⟨i + 1 - s₁.length, by simp [this]⟩
-        = s₂ 0 : congr_arg s₂ (by simp [fin.ext_iff, this])
-    ... = s₁ (fin.last _) : h.symm
-    ... = _ : congr_arg s₁ (by simp [fin.ext_iff, this]) }
+  { have : i + 1 = m, from le_antisymm hi (le_of_not_gt h_1),
+    calc b ⟨i + 1 - m, by simp [this]⟩
+        = b 0 : congr_arg b (by simp [fin.ext_iff, this])
+    ... = a (fin.last _) : h.symm
+    ... = _ : congr_arg a (by simp [fin.ext_iff, this]) }
 end
 
-lemma append_nat_add_aux
-  {s₁ s₂ : composition_series X}
-  (i : fin s₂.length) :
-  fin.append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂
-  (fin.nat_add s₁.length i).cast_succ = s₂ i.cast_succ :=
+lemma append_nat_add_aux (i : fin n) :
+  matrix.vec_append (nat.add_succ _ _).symm (a ∘ fin.cast_succ) b
+  (fin.nat_add m i).cast_succ = b i.cast_succ :=
 begin
   cases i,
-  simp only [fin.append, nat.not_lt_zero, fin.nat_add_mk, add_lt_iff_neg_left,
+  simp only [matrix.vec_append_eq_ite, nat.not_lt_zero, fin.nat_add_mk, add_lt_iff_neg_left,
     add_tsub_cancel_left, dif_neg, fin.cast_succ_mk, not_false_iff, fin.coe_mk]
 end
 
-lemma append_succ_nat_add_aux
-  {s₁ s₂ : composition_series X}
-  (i : fin s₂.length) :
-  fin.append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂
-  (fin.nat_add s₁.length i).succ = s₂ i.succ :=
+lemma append_succ_nat_add_aux (i : fin n) :
+  matrix.vec_append (nat.add_succ _ _).symm (a ∘ fin.cast_succ) b
+  (fin.nat_add m i).succ = b i.succ :=
 begin
   cases i with i hi,
-  simp only [fin.append, add_assoc, nat.not_lt_zero, fin.nat_add_mk, add_lt_iff_neg_left,
-    add_tsub_cancel_left, fin.succ_mk, dif_neg, not_false_iff, fin.coe_mk]
+  simp only [matrix.vec_append_eq_ite, add_assoc, nat.not_lt_zero, fin.nat_add_mk,
+    add_lt_iff_neg_left, add_tsub_cancel_left, fin.succ_mk, dif_neg, not_false_iff, fin.coe_mk]
 end
 
+end fin_lemmas
+
 /-- Append two composition series `s₁` and `s₂` such that
 the least element of `s₁` is the maximum element of `s₂`. -/
 @[simps length] def append (s₁ s₂ : composition_series X)
   (h : s₁.top = s₂.bot) : composition_series X :=
 { length := s₁.length + s₂.length,
-  series := fin.append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂,
+  series := matrix.vec_append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂,
   step' := λ i, begin
     refine fin.add_cases  _ _ i,
     { intro i,
-      rw [append_succ_cast_add_aux _ h, append_cast_add_aux],
+      rw [append_succ_cast_add_aux _ _ _ h, append_cast_add_aux],
       exact s₁.step i },
     { intro i,
       rw [append_nat_add_aux, append_succ_nat_add_aux],
       exact s₂.step i }
   end }
 
+lemma coe_append (s₁ s₂ : composition_series X) (h) :
+  ⇑(s₁.append s₂ h) = matrix.vec_append (nat.add_succ _ _).symm (s₁ ∘ fin.cast_succ) s₂ :=
+rfl
+
 @[simp] lemma append_cast_add {s₁ s₂ : composition_series X}
   (h : s₁.top = s₂.bot) (i : fin s₁.length) :
   append s₁ s₂ h (fin.cast_add s₂.length i).cast_succ = s₁ i.cast_succ :=
-append_cast_add_aux i
+by rw [coe_append, append_cast_add_aux _ _ i]
 
 @[simp] lemma append_succ_cast_add {s₁ s₂ : composition_series X}
   (h : s₁.top = s₂.bot) (i : fin s₁.length) :
   append s₁ s₂ h (fin.cast_add s₂.length i).succ = s₁ i.succ :=
-append_succ_cast_add_aux i h
+by rw [coe_append, append_succ_cast_add_aux _ _ _ h]
 
 @[simp] lemma append_nat_add {s₁ s₂ : composition_series X}
   (h : s₁.top = s₂.bot) (i : fin s₂.length) :
   append s₁ s₂ h (fin.nat_add s₁.length i).cast_succ = s₂ i.cast_succ :=
-append_nat_add_aux i
+by rw [coe_append, append_nat_add_aux _ _ i]
 
 @[simp] lemma append_succ_nat_add {s₁ s₂ : composition_series X}
   (h : s₁.top = s₂.bot) (i : fin s₂.length) :
   append s₁ s₂ h (fin.nat_add s₁.length i).succ = s₂ i.succ :=
-append_succ_nat_add_aux i
+by rw [coe_append, append_succ_nat_add_aux _ _ i]
 
 /-- Add an element to the top of a `composition_series` -/
 @[simps length] def snoc (s : composition_series X) (x : X)
@@ -528,7 +527,7 @@ fin.snoc_cast_succ _ _ _
 
 @[simp] lemma bot_snoc (s : composition_series X) (x : X) (hsat : is_maximal s.top x) :
   (snoc s x hsat).bot = s.bot :=
-by rw [bot, bot, ← fin.cast_succ_zero, snoc_cast_succ]
+by rw [bot, bot, ← snoc_cast_succ s _ _ 0, fin.cast_succ_zero]
 
 lemma mem_snoc {s : composition_series X} {x y: X}
   {hsat : is_maximal s.top x} : y ∈ snoc s x hsat ↔ y ∈ s ∨ y = x :=
diff --git a/src/order/lattice.lean b/src/order/lattice.lean
index c59a20e18ac9a..14128e9768f95 100644
--- a/src/order/lattice.lean
+++ b/src/order/lattice.lean
@@ -3,14 +3,16 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
-import order.monotone
-import order.rel_classes
+import order.monotone.basic
 import tactic.simps
 import tactic.pi_instances
 
 /-!
 # (Semi-)lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Semilattices are partially ordered sets with join (greatest lower bound, or `sup`) or
 meet (least upper bound, or `inf`) operations. Lattices are posets that are both
 join-semilattices and meet-semilattices.
@@ -20,9 +22,6 @@ of `sup` over `inf`, on the left or on the right.
 
 ## Main declarations
 
-* `has_sup`: type class for the `⊔` notation
-* `has_inf`: type class for the `⊓` notation
-
 * `semilattice_sup`: a type class for join semilattices
 * `semilattice_sup.mk'`: an alternative constructor for `semilattice_sup` via proofs that `⊔` is
   commutative, associative and idempotent.
@@ -68,14 +67,6 @@ end
 
 /- TODO: automatic construction of dual definitions / theorems -/
 
-/-- Typeclass for the `⊔` (`\lub`) notation -/
-@[notation_class] class has_sup (α : Type u) := (sup : α → α → α)
-/-- Typeclass for the `⊓` (`\glb`) notation -/
-@[notation_class] class has_inf (α : Type u) := (inf : α → α → α)
-
-infix ⊔ := has_sup.sup
-infix ⊓ := has_inf.inf
-
 /-!
 ### Join-semilattices
 -/
@@ -83,6 +74,7 @@ infix ⊓ := has_inf.inf
 /-- A `semilattice_sup` is a join-semilattice, that is, a partial order
   with a join (a.k.a. lub / least upper bound, sup / supremum) operation
   `⊔` which is the least element larger than both factors. -/
+@[protect_proj, ancestor has_sup partial_order]
 class semilattice_sup (α : Type u) extends has_sup α, partial_order α :=
 (le_sup_left : ∀ a b : α, a ≤ a ⊔ b)
 (le_sup_right : ∀ a b : α, b ≤ a ⊔ b)
@@ -156,23 +148,32 @@ semilattice_sup.sup_le a b c
 ⟨assume h : a ⊔ b ≤ c, ⟨le_trans le_sup_left h, le_trans le_sup_right h⟩,
   assume ⟨h₁, h₂⟩, sup_le h₁ h₂⟩
 
-@[simp] theorem sup_eq_left : a ⊔ b = a ↔ b ≤ a :=
-le_antisymm_iff.trans $ by simp [le_refl]
+@[simp] lemma sup_eq_left : a ⊔ b = a ↔ b ≤ a := le_antisymm_iff.trans $ by simp [le_rfl]
+@[simp] lemma sup_eq_right : a ⊔ b = b ↔ a ≤ b := le_antisymm_iff.trans $ by simp [le_rfl]
+@[simp] lemma left_eq_sup : a = a ⊔ b ↔ b ≤ a := eq_comm.trans sup_eq_left
+@[simp] lemma right_eq_sup : b = a ⊔ b ↔ a ≤ b := eq_comm.trans sup_eq_right
+
+alias sup_eq_left ↔ _ sup_of_le_left
+alias sup_eq_right ↔ le_of_sup_eq sup_of_le_right
 
-theorem sup_of_le_left (h : b ≤ a) : a ⊔ b = a :=
-sup_eq_left.2 h
+attribute [simp] sup_of_le_left sup_of_le_right
 
-@[simp] theorem left_eq_sup : a = a ⊔ b ↔ b ≤ a :=
-eq_comm.trans sup_eq_left
+@[simp] theorem left_lt_sup : a < a ⊔ b ↔ ¬b ≤ a :=
+le_sup_left.lt_iff_ne.trans $ not_congr left_eq_sup
 
-@[simp] theorem sup_eq_right : a ⊔ b = b ↔ a ≤ b :=
-le_antisymm_iff.trans $ by simp [le_refl]
+@[simp] theorem right_lt_sup : b < a ⊔ b ↔ ¬a ≤ b :=
+le_sup_right.lt_iff_ne.trans $ not_congr right_eq_sup
 
-theorem sup_of_le_right (h : a ≤ b) : a ⊔ b = b :=
-sup_eq_right.2 h
+lemma left_or_right_lt_sup (h : a ≠ b) : (a < a ⊔ b ∨ b < a ⊔ b) :=
+h.not_le_or_not_le.symm.imp left_lt_sup.2 right_lt_sup.2
 
-@[simp] theorem right_eq_sup : b = a ⊔ b ↔ a ≤ b :=
-eq_comm.trans sup_eq_right
+theorem le_iff_exists_sup : a ≤ b ↔ ∃ c, b = a ⊔ c :=
+begin
+  split,
+  { intro h, exact ⟨b, (sup_eq_right.mpr h).symm⟩ },
+  { rintro ⟨c, (rfl : _ = _ ⊔ _)⟩,
+    exact le_sup_left }
+end
 
 theorem sup_le_sup (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊔ c ≤ b ⊔ d :=
 sup_le (le_sup_of_le_left h₁) (le_sup_of_le_right h₂)
@@ -183,9 +184,6 @@ sup_le_sup le_rfl h₁
 theorem sup_le_sup_right (h₁ : a ≤ b) (c) : a ⊔ c ≤ b ⊔ c :=
 sup_le_sup h₁ le_rfl
 
-theorem le_of_sup_eq (h : a ⊔ b = b) : a ≤ b :=
-by { rw ← h, simp }
-
 @[simp] theorem sup_idem : a ⊔ a = a :=
 by apply le_antisymm; simp
 
@@ -197,13 +195,7 @@ by apply le_antisymm; simp
 instance sup_is_commutative : is_commutative α (⊔) := ⟨@sup_comm _ _⟩
 
 theorem sup_assoc : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) :=
-le_antisymm
-  (sup_le
-    (sup_le le_sup_left (le_sup_of_le_right le_sup_left))
-    (le_sup_of_le_right le_sup_right))
-  (sup_le
-    (le_sup_of_le_left le_sup_left)
-    (sup_le (le_sup_of_le_left le_sup_right) le_sup_right))
+eq_of_forall_ge_iff $ λ x, by simp only [sup_le_iff, and_assoc]
 
 instance sup_is_associative : is_associative α (⊔) := ⟨@sup_assoc _ _⟩
 
@@ -231,11 +223,20 @@ by rw [sup_sup_sup_comm, sup_idem]
 lemma sup_sup_distrib_right (a b c : α) : (a ⊔ b) ⊔ c = (a ⊔ c) ⊔ (b ⊔ c) :=
 by rw [sup_sup_sup_comm, sup_idem]
 
-lemma forall_le_or_exists_lt_sup (a : α) : (∀b, b ≤ a) ∨ (∃b, a < b) :=
-suffices (∃b, ¬b ≤ a) → (∃b, a < b),
-  by rwa [or_iff_not_imp_left, not_forall],
-assume ⟨b, hb⟩,
-⟨a ⊔ b, lt_of_le_of_ne le_sup_left $ mt left_eq_sup.1 hb⟩
+lemma sup_congr_left (hb : b ≤ a ⊔ c) (hc : c ≤ a ⊔ b) : a ⊔ b = a ⊔ c :=
+(sup_le le_sup_left hb).antisymm $ sup_le le_sup_left hc
+
+lemma sup_congr_right (ha : a ≤ b ⊔ c) (hb : b ≤ a ⊔ c) : a ⊔ c = b ⊔ c :=
+(sup_le ha le_sup_right).antisymm $ sup_le hb le_sup_right
+
+lemma sup_eq_sup_iff_left : a ⊔ b = a ⊔ c ↔ b ≤ a ⊔ c ∧ c ≤ a ⊔ b :=
+⟨λ h, ⟨h ▸ le_sup_right, h.symm ▸ le_sup_right⟩, λ h, sup_congr_left h.1 h.2⟩
+
+lemma sup_eq_sup_iff_right : a ⊔ c = b ⊔ c ↔ a ≤ b ⊔ c ∧ b ≤ a ⊔ c :=
+⟨λ h, ⟨h ▸ le_sup_left, h.symm ▸ le_sup_left⟩, λ h, sup_congr_right h.1 h.2⟩
+
+lemma ne.lt_sup_or_lt_sup (hab : a ≠ b) : a < a ⊔ b ∨ b < a ⊔ b :=
+hab.symm.not_le_or_not_le.imp left_lt_sup.2 right_lt_sup.2
 
 /-- If `f` is monotone, `g` is antitone, and `f ≤ g`, then for all `a`, `b` we have `f a ≤ g b`. -/
 theorem monotone.forall_le_of_antitone {β : Type*} [preorder β] {f g : α → β}
@@ -260,13 +261,6 @@ begin
   injection this; congr'
 end
 
-theorem exists_lt_of_sup (α : Type*) [semilattice_sup α] [nontrivial α] : ∃ a b : α, a < b :=
-begin
-  rcases exists_pair_ne α with ⟨a, b, hne⟩,
-  rcases forall_le_or_exists_lt_sup b with (hb|H),
-  exacts [⟨a, b, (hb a).lt_of_ne hne⟩, ⟨b, H⟩]
-end
-
 lemma ite_le_sup (s s' : α) (P : Prop) [decidable P] : ite P s s' ≤ s ⊔ s' :=
 if h : P then (if_pos h).trans_le le_sup_left else (if_neg h).trans_le le_sup_right
 
@@ -279,6 +273,7 @@ end semilattice_sup
 /-- A `semilattice_inf` is a meet-semilattice, that is, a partial order
   with a meet (a.k.a. glb / greatest lower bound, inf / infimum) operation
   `⊓` which is the greatest element smaller than both factors. -/
+@[protect_proj, ancestor has_inf partial_order]
 class semilattice_inf (α : Type u) extends has_inf α, partial_order α :=
 (inf_le_left : ∀ a b : α, a ⊓ b ≤ a)
 (inf_le_right : ∀ a b : α, a ⊓ b ≤ b)
@@ -332,35 +327,28 @@ lt_of_le_of_lt inf_le_right h
 
 @[simp] theorem le_inf_iff : a ≤ b ⊓ c ↔ a ≤ b ∧ a ≤ c := @sup_le_iff αᵒᵈ _ _ _ _
 
-@[simp] theorem inf_eq_left : a ⊓ b = a ↔ a ≤ b :=
-le_antisymm_iff.trans $ by simp [le_refl]
-
-theorem inf_of_le_left (h : a ≤ b) : a ⊓ b = a :=
-inf_eq_left.2 h
+@[simp] lemma inf_eq_left : a ⊓ b = a ↔ a ≤ b := le_antisymm_iff.trans $ by simp [le_rfl]
+@[simp] lemma inf_eq_right : a ⊓ b = b ↔ b ≤ a := le_antisymm_iff.trans $ by simp [le_rfl]
+@[simp] lemma left_eq_inf : a = a ⊓ b ↔ a ≤ b := eq_comm.trans inf_eq_left
+@[simp] lemma right_eq_inf : b = a ⊓ b ↔ b ≤ a := eq_comm.trans inf_eq_right
 
-@[simp] theorem left_eq_inf : a = a ⊓ b ↔ a ≤ b :=
-eq_comm.trans inf_eq_left
+alias inf_eq_left ↔ le_of_inf_eq inf_of_le_left
+alias inf_eq_right ↔ _ inf_of_le_right
 
-@[simp] theorem inf_eq_right : a ⊓ b = b ↔ b ≤ a :=
-le_antisymm_iff.trans $ by simp [le_refl]
+attribute [simp] inf_of_le_left inf_of_le_right
 
-theorem inf_of_le_right (h : b ≤ a) : a ⊓ b = b :=
-inf_eq_right.2 h
+@[simp] theorem inf_lt_left : a ⊓ b < a ↔ ¬a ≤ b := @left_lt_sup αᵒᵈ _ _ _
+@[simp] theorem inf_lt_right : a ⊓ b < b ↔ ¬b ≤ a := @right_lt_sup αᵒᵈ _ _ _
 
-@[simp] theorem right_eq_inf : b = a ⊓ b ↔ b ≤ a :=
-eq_comm.trans inf_eq_right
+theorem inf_lt_left_or_right (h : a ≠ b) : a ⊓ b < a ∨ a ⊓ b < b :=
+@left_or_right_lt_sup αᵒᵈ _ _ _ h
 
 theorem inf_le_inf (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊓ c ≤ b ⊓ d :=
-le_inf (inf_le_of_left_le h₁) (inf_le_of_right_le h₂)
+@sup_le_sup αᵒᵈ _ _ _ _ _ h₁ h₂
 
-lemma inf_le_inf_right (a : α) {b c : α} (h : b ≤ c) : b ⊓ a ≤ c ⊓ a :=
-inf_le_inf h le_rfl
+lemma inf_le_inf_right (a : α) {b c : α} (h : b ≤ c) : b ⊓ a ≤ c ⊓ a := inf_le_inf h le_rfl
 
-lemma inf_le_inf_left (a : α) {b c : α} (h : b ≤ c) : a ⊓ b ≤ a ⊓ c :=
-inf_le_inf le_rfl h
-
-theorem le_of_inf_eq (h : a ⊓ b = a) : a ≤ b :=
-by { rw ← h, simp }
+lemma inf_le_inf_left (a : α) {b c : α} (h : b ≤ c) : a ⊓ b ≤ a ⊓ c := inf_le_inf le_rfl h
 
 @[simp] lemma inf_idem : a ⊓ a = a := @sup_idem αᵒᵈ _ _
 
@@ -374,20 +362,15 @@ lemma inf_assoc : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := @sup_assoc αᵒᵈ _ a b c
 
 instance inf_is_associative : is_associative α (⊓) := ⟨@inf_assoc _ _⟩
 
-lemma inf_left_right_swap (a b c : α) : a ⊓ b ⊓ c = c ⊓ b ⊓ a :=
-by rw [inf_comm, @inf_comm _ _ a, inf_assoc]
+lemma inf_left_right_swap (a b c : α) : a ⊓ b ⊓ c = c ⊓ b ⊓ a := @sup_left_right_swap αᵒᵈ _ _ _ _
 
-@[simp] lemma inf_left_idem : a ⊓ (a ⊓ b) = a ⊓ b :=
-@sup_left_idem αᵒᵈ _ a b
+@[simp] lemma inf_left_idem : a ⊓ (a ⊓ b) = a ⊓ b := @sup_left_idem αᵒᵈ _ a b
 
-@[simp] lemma inf_right_idem : (a ⊓ b) ⊓ b = a ⊓ b :=
-@sup_right_idem αᵒᵈ _ a b
+@[simp] lemma inf_right_idem : (a ⊓ b) ⊓ b = a ⊓ b := @sup_right_idem αᵒᵈ _ a b
 
-lemma inf_left_comm (a b c : α) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) :=
-@sup_left_comm αᵒᵈ _ a b c
+lemma inf_left_comm (a b c : α) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) := @sup_left_comm αᵒᵈ _ a b c
 
-lemma inf_right_comm (a b c : α) : a ⊓ b ⊓ c = a ⊓ c ⊓ b :=
-@sup_right_comm αᵒᵈ _ a b c
+lemma inf_right_comm (a b c : α) : a ⊓ b ⊓ c = a ⊓ c ⊓ b := @sup_right_comm αᵒᵈ _ a b c
 
 lemma inf_inf_inf_comm (a b c d : α) : a ⊓ b ⊓ (c ⊓ d) = a ⊓ c ⊓ (b ⊓ d) :=
 @sup_sup_sup_comm αᵒᵈ _ _ _ _ _
@@ -398,8 +381,19 @@ lemma inf_inf_distrib_left (a b c : α) : a ⊓ (b ⊓ c) = (a ⊓ b) ⊓ (a ⊓
 lemma inf_inf_distrib_right (a b c : α) : (a ⊓ b) ⊓ c = (a ⊓ c) ⊓ (b ⊓ c) :=
 @sup_sup_distrib_right αᵒᵈ _ _ _ _
 
-lemma forall_le_or_exists_lt_inf (a : α) : (∀b, a ≤ b) ∨ (∃b, b < a) :=
-@forall_le_or_exists_lt_sup αᵒᵈ _ a
+lemma inf_congr_left (hb : a ⊓ c ≤ b) (hc : a ⊓ b ≤ c) : a ⊓ b = a ⊓ c :=
+@sup_congr_left αᵒᵈ _ _ _ _ hb hc
+
+lemma inf_congr_right (h1 : b ⊓ c ≤ a) (h2 : a ⊓ c ≤ b) : a ⊓ c = b ⊓ c :=
+@sup_congr_right αᵒᵈ _ _ _ _ h1 h2
+
+lemma inf_eq_inf_iff_left : a ⊓ b = a ⊓ c ↔ a ⊓ c ≤ b ∧ a ⊓ b ≤ c :=
+@sup_eq_sup_iff_left αᵒᵈ _ _ _ _
+
+lemma inf_eq_inf_iff_right : a ⊓ c = b ⊓ c ↔ b ⊓ c ≤ a ∧ a ⊓ c ≤ b :=
+@sup_eq_sup_iff_right αᵒᵈ _ _ _ _
+
+lemma ne.inf_lt_or_inf_lt : a ≠ b → a ⊓ b < a ∨ a ⊓ b < b := @ne.lt_sup_or_lt_sup αᵒᵈ _ _ _
 
 theorem semilattice_inf.ext_inf {α} {A B : semilattice_inf α}
   (H : ∀ x y : α, (by haveI := A; exact x ≤ y) ↔ x ≤ y)
@@ -420,12 +414,8 @@ theorem semilattice_inf.dual_dual (α : Type*) [H : semilattice_inf α] :
   order_dual.semilattice_inf αᵒᵈ = H :=
 semilattice_inf.ext $ λ _ _, iff.rfl
 
-theorem exists_lt_of_inf (α : Type*) [semilattice_inf α] [nontrivial α] :
-  ∃ a b : α, a < b :=
-let ⟨a, b, h⟩ := exists_lt_of_sup αᵒᵈ in ⟨b, a, h⟩
-
 lemma inf_le_ite (s s' : α) (P : Prop) [decidable P] : s ⊓ s' ≤ ite P s s' :=
-if h : P then inf_le_left.trans_eq (if_pos h).symm else inf_le_right.trans_eq (if_neg h).symm
+@ite_le_sup αᵒᵈ _ _ _ _ _
 
 end semilattice_inf
 
@@ -450,7 +440,8 @@ end
 -/
 
 /-- A lattice is a join-semilattice which is also a meet-semilattice. -/
-@[protect_proj] class lattice (α : Type u) extends semilattice_sup α, semilattice_inf α
+@[protect_proj, ancestor semilattice_sup semilattice_inf]
+class lattice (α : Type u) extends semilattice_sup α, semilattice_inf α
 
 instance (α) [lattice α] : lattice αᵒᵈ :=
 { .. order_dual.semilattice_sup α, .. order_dual.semilattice_inf α }
@@ -513,14 +504,21 @@ variables [lattice α] {a b c d : α}
 
 lemma inf_le_sup : a ⊓ b ≤ a ⊔ b := inf_le_left.trans le_sup_left
 
-@[simp] lemma inf_lt_sup : a ⊓ b < a ⊔ b ↔ a ≠ b :=
+@[simp] lemma sup_le_inf : a ⊔ b ≤ a ⊓ b ↔ a = b :=
+⟨λ h, le_antisymm (le_sup_left.trans $ h.trans inf_le_right)
+  (le_sup_right.trans $ h.trans inf_le_left), by { rintro rfl, simp }⟩
+
+@[simp] lemma inf_eq_sup : a ⊓ b = a ⊔ b ↔ a = b := by rw [←inf_le_sup.ge_iff_eq, sup_le_inf]
+@[simp] lemma sup_eq_inf : a ⊔ b = a ⊓ b ↔ a = b := eq_comm.trans inf_eq_sup
+@[simp] lemma inf_lt_sup : a ⊓ b < a ⊔ b ↔ a ≠ b := by rw [inf_le_sup.lt_iff_ne, ne.def, inf_eq_sup]
+
+lemma inf_eq_and_sup_eq_iff : a ⊓ b = c ∧ a ⊔ b = c ↔ a = c ∧ b = c :=
 begin
-  split,
-  { rintro H rfl, simpa using H },
-  { refine λ Hne, lt_iff_le_and_ne.2 ⟨inf_le_sup, λ Heq, Hne _⟩,
-    refine le_antisymm _ _,
-    exacts [le_sup_left.trans (Heq.symm.trans_le inf_le_right),
-      le_sup_right.trans (Heq.symm.trans_le inf_le_left)] }
+  refine ⟨λ h, _, _⟩,
+  { obtain rfl := sup_eq_inf.1 (h.2.trans h.1.symm),
+    simpa using h },
+  { rintro ⟨rfl, rfl⟩,
+    exact ⟨inf_idem, sup_idem⟩ }
 end
 
 /-!
@@ -562,18 +560,17 @@ end lattice
 equivalent distributive properties (of `sup` over `inf` or `inf` over `sup`,
 on the left or right).
 
-The definition here chooses `le_sup_inf`: `(x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z)`.
+The definition here chooses `le_sup_inf`: `(x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z)`. To prove distributivity
+from the dual law, use `distrib_lattice.of_inf_sup_le`.
 
 A classic example of a distributive lattice
 is the lattice of subsets of a set, and in fact this example is
 generic in the sense that every distributive lattice is realizable
 as a sublattice of a powerset lattice. -/
+@[protect_proj, ancestor lattice]
 class distrib_lattice α extends lattice α :=
 (le_sup_inf : ∀x y z : α, (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ (y ⊓ z))
 
-/- TODO: alternative constructors from the other distributive properties,
-and perhaps a `tfae` statement -/
-
 section distrib_lattice
 variables [distrib_lattice α] {x y z : α}
 
@@ -617,6 +614,13 @@ le_antisymm
 
 end distrib_lattice
 
+/-- Prove distributivity of an existing lattice from the dual distributive law. -/
+@[reducible] -- See note [reducible non-instances]
+def distrib_lattice.of_inf_sup_le [lattice α]
+  (inf_sup_le : ∀ a b c : α, a ⊓ (b ⊔ c) ≤ (a ⊓ b) ⊔ (a ⊓ c)) : distrib_lattice α :=
+{ ..‹lattice α›,
+  ..@order_dual.distrib_lattice αᵒᵈ { le_sup_inf := inf_sup_le, ..order_dual.lattice _ } }
+
 /-!
 ### Lattices derived from linear orders
 -/
@@ -636,7 +640,7 @@ instance linear_order.to_lattice {α : Type u} [o : linear_order α] :
   ..o }
 
 section linear_order
-variables [linear_order α] {a b c : α}
+variables [linear_order α] {a b c d : α}
 
 lemma sup_eq_max : a ⊔ b = max a b := rfl
 lemma inf_eq_min : a ⊓ b = min a b := rfl
@@ -665,6 +669,14 @@ lemma inf_ind (a b : α) {p : α → Prop} : p a → p b → p (a ⊓ b) := @sup
 @[simp] lemma inf_lt_iff : b ⊓ c < a ↔ b < a ∨ c < a := @lt_sup_iff αᵒᵈ _ _ _ _
 @[simp] lemma lt_inf_iff : a < b ⊓ c ↔ a < b ∧ a < c := @sup_lt_iff αᵒᵈ _ _ _ _
 
+variables (a b c d)
+
+lemma max_max_max_comm : max (max a b) (max c d) = max (max a c) (max b d) :=
+sup_sup_sup_comm _ _ _ _
+
+lemma min_min_min_comm : min (min a b) (min c d) = min (min a c) (min b d) :=
+inf_inf_inf_comm _ _ _ _
+
 end linear_order
 
 lemma sup_eq_max_default [semilattice_sup α] [decidable_rel ((≤) : α → α → Prop)]
@@ -673,12 +685,17 @@ begin
   ext x y,
   dunfold max_default,
   split_ifs with h',
-  exacts [sup_of_le_left h', sup_of_le_right $ (total_of (≤) x y).resolve_right h']
+  exacts [sup_of_le_right h', sup_of_le_left $ (total_of (≤) x y).resolve_left h']
 end
 
 lemma inf_eq_min_default [semilattice_inf α] [decidable_rel ((≤) : α → α → Prop)]
   [is_total α (≤)] : (⊓) = (min_default : α → α → α) :=
-@sup_eq_max_default αᵒᵈ _ _ _
+begin
+  ext x y,
+  dunfold min_default,
+  split_ifs with h',
+  exacts [inf_of_le_left h', inf_of_le_right $ (total_of (≤) x y).resolve_left h']
+end
 
 /-- A lattice with total order is a linear order.
 
@@ -708,6 +725,25 @@ instance linear_order.to_distrib_lattice {α : Type u} [o : linear_order α] :
 instance nat.distrib_lattice : distrib_lattice ℕ :=
 by apply_instance
 
+/-! ### Dual order -/
+
+open order_dual
+
+@[simp] lemma of_dual_inf [has_sup α] (a b:  αᵒᵈ) : of_dual (a ⊓ b) = of_dual a ⊔ of_dual b := rfl
+@[simp] lemma of_dual_sup [has_inf α] (a b : αᵒᵈ) : of_dual (a ⊔ b) = of_dual a ⊓ of_dual b := rfl
+@[simp] lemma to_dual_inf [has_inf α] (a b : α) : to_dual (a ⊓ b) = to_dual a ⊔ to_dual b := rfl
+@[simp] lemma to_dual_sup [has_sup α] (a b : α) : to_dual (a ⊔ b) = to_dual a ⊓ to_dual b := rfl
+
+section linear_order
+variables [linear_order α]
+
+@[simp] lemma of_dual_min (a b : αᵒᵈ) : of_dual (min a b) = max (of_dual a) (of_dual b) := rfl
+@[simp] lemma of_dual_max (a b : αᵒᵈ) : of_dual (max a b) = min (of_dual a) (of_dual b) := rfl
+@[simp] lemma to_dual_min (a b : α) : to_dual (min a b) = max (to_dual a) (to_dual b) := rfl
+@[simp] lemma to_dual_max (a b : α) : to_dual (max a b) = min (to_dual a) (to_dual b) := rfl
+
+end linear_order
+
 /-! ### Function lattices -/
 
 namespace pi
@@ -741,6 +777,19 @@ by refine_struct { .. pi.lattice }; tactic.pi_instance_derive_field
 
 end pi
 
+namespace function
+variables {ι : Type*} {π : ι → Type*} [decidable_eq ι]
+
+lemma update_sup [Π i, semilattice_sup (π i)] (f : Π i, π i) (i : ι) (a b : π i) :
+  f.update i (a ⊔ b) = f.update i a ⊔ f.update i b :=
+funext $ λ j, by obtain rfl | hji := eq_or_ne j i; simp [update_noteq, *]
+
+lemma update_inf [Π i, semilattice_inf (π i)] (f : Π i, π i) (i : ι) (a b : π i) :
+  f.update i (a ⊓ b) = f.update i a ⊓ f.update i b :=
+funext $ λ j, by obtain rfl | hji := eq_or_ne j i; simp [update_noteq, *]
+
+end function
+
 /-!
 ### Monotone functions and lattices
 -/
@@ -776,6 +825,14 @@ lemma map_inf_le [semilattice_inf α] [semilattice_inf β]
   f (x ⊓ y) ≤ f x ⊓ f y :=
 le_inf (h inf_le_left) (h inf_le_right)
 
+lemma of_map_inf [semilattice_inf α] [semilattice_inf β] {f : α → β}
+  (h : ∀ x y, f (x ⊓ y) = f x ⊓ f y) : monotone f :=
+λ x y hxy, inf_eq_left.1 $ by rw [← h, inf_eq_left.2 hxy]
+
+lemma of_map_sup [semilattice_sup α] [semilattice_sup β] {f : α → β}
+  (h : ∀ x y, f (x ⊔ y) = f x ⊔ f y) : monotone f :=
+(@of_map_inf (order_dual α) (order_dual β) _ _ _ h).dual
+
 variables [linear_order α]
 
 lemma map_sup [semilattice_sup β] {f : α → β} (hf : monotone f) (x y : α) : f (x ⊔ y) = f x ⊔ f y :=
@@ -788,6 +845,50 @@ hf.dual.map_sup _ _
 
 end monotone
 
+namespace monotone_on
+variables {f : α → β} {s : set α} {x y : α}
+
+/-- Pointwise supremum of two monotone functions is a monotone function. -/
+protected lemma sup [preorder α] [semilattice_sup β] {f g : α → β} {s : set α}
+  (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (f ⊔ g) s :=
+λ x hx y hy h, sup_le_sup (hf hx hy h) (hg hx hy h)
+
+/-- Pointwise infimum of two monotone functions is a monotone function. -/
+protected lemma inf [preorder α] [semilattice_inf β] {f g : α → β} {s : set α}
+  (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (f ⊓ g) s :=
+(hf.dual.sup hg.dual).dual
+
+/-- Pointwise maximum of two monotone functions is a monotone function. -/
+protected lemma max [preorder α] [linear_order β] {f g : α → β} {s : set α}
+  (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (λ x, max (f x) (g x)) s :=
+hf.sup hg
+
+/-- Pointwise minimum of two monotone functions is a monotone function. -/
+protected lemma min [preorder α] [linear_order β] {f g : α → β} {s : set α}
+  (hf : monotone_on f s) (hg : monotone_on g s) : monotone_on (λ x, min (f x) (g x)) s :=
+hf.inf hg
+
+lemma of_map_inf [semilattice_inf α] [semilattice_inf β]
+  (h : ∀ (x ∈ s) (y ∈ s), f (x ⊓ y) = f x ⊓ f y) : monotone_on f s :=
+λ x hx y hy hxy, inf_eq_left.1 $ by rw [←h _ hx _ hy, inf_eq_left.2 hxy]
+
+lemma of_map_sup [semilattice_sup α] [semilattice_sup β]
+  (h : ∀ (x ∈ s) (y ∈ s), f (x ⊔ y) = f x ⊔ f y) : monotone_on f s :=
+(@of_map_inf αᵒᵈ βᵒᵈ _ _ _ _ h).dual
+
+variables [linear_order α]
+
+lemma map_sup [semilattice_sup β] (hf : monotone_on f s) (hx : x ∈ s) (hy : y ∈ s) :
+  f (x ⊔ y) = f x ⊔ f y :=
+by cases le_total x y; have := hf _ _ h;
+  assumption <|> simp only [h, this, sup_of_le_left, sup_of_le_right]
+
+lemma map_inf [semilattice_inf β] (hf : monotone_on f s) (hx : x ∈ s) (hy : y ∈ s) :
+  f (x ⊓ y) = f x ⊓ f y :=
+hf.dual.map_sup hx hy
+
+end monotone_on
+
 namespace antitone
 
 /-- Pointwise supremum of two monotone functions is a monotone function. -/
@@ -830,6 +931,50 @@ hf.dual_right.map_inf x y
 
 end antitone
 
+namespace antitone_on
+variables {f : α → β} {s : set α} {x y : α}
+
+/-- Pointwise supremum of two antitone functions is a antitone function. -/
+protected lemma sup [preorder α] [semilattice_sup β] {f g : α → β} {s : set α}
+  (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (f ⊔ g) s :=
+λ x hx y hy h, sup_le_sup (hf hx hy h) (hg hx hy h)
+
+/-- Pointwise infimum of two antitone functions is a antitone function. -/
+protected lemma inf [preorder α] [semilattice_inf β] {f g : α → β} {s : set α}
+  (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (f ⊓ g) s :=
+(hf.dual.sup hg.dual).dual
+
+/-- Pointwise maximum of two antitone functions is a antitone function. -/
+protected lemma max [preorder α] [linear_order β] {f g : α → β} {s : set α}
+  (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (λ x, max (f x) (g x)) s :=
+hf.sup hg
+
+/-- Pointwise minimum of two antitone functions is a antitone function. -/
+protected lemma min [preorder α] [linear_order β] {f g : α → β} {s : set α}
+  (hf : antitone_on f s) (hg : antitone_on g s) : antitone_on (λ x, min (f x) (g x)) s :=
+hf.inf hg
+
+lemma of_map_inf [semilattice_inf α] [semilattice_sup β]
+  (h : ∀ (x ∈ s) (y ∈ s), f (x ⊓ y) = f x ⊔ f y) : antitone_on f s :=
+λ x hx y hy hxy, sup_eq_left.1 $ by rw [←h _ hx _ hy, inf_eq_left.2 hxy]
+
+lemma of_map_sup [semilattice_sup α] [semilattice_inf β]
+  (h : ∀ (x ∈ s) (y ∈ s), f (x ⊔ y) = f x ⊓ f y) : antitone_on f s :=
+(@of_map_inf αᵒᵈ βᵒᵈ _ _ _ _ h).dual
+
+variables [linear_order α]
+
+lemma map_sup [semilattice_inf β] (hf : antitone_on f s) (hx : x ∈ s) (hy : y ∈ s) :
+  f (x ⊔ y) = f x ⊓ f y :=
+by cases le_total x y; have := hf _ _ h; assumption <|>
+  simp only [h, this, sup_of_le_left, sup_of_le_right, inf_of_le_left, inf_of_le_right]
+
+lemma map_inf [semilattice_sup β] (hf : antitone_on f s) (hx : x ∈ s) (hy : y ∈ s) :
+  f (x ⊓ y) = f x ⊔ f y :=
+hf.dual.map_sup hx hy
+
+end antitone_on
+
 /-!
 ### Products of (semi-)lattices
 -/
@@ -840,6 +985,24 @@ variables (α β)
 instance [has_sup α] [has_sup β] : has_sup (α × β) := ⟨λp q, ⟨p.1 ⊔ q.1, p.2 ⊔ q.2⟩⟩
 instance [has_inf α] [has_inf β] : has_inf (α × β) := ⟨λp q, ⟨p.1 ⊓ q.1, p.2 ⊓ q.2⟩⟩
 
+@[simp] lemma mk_sup_mk [has_sup α] [has_sup β] (a₁ a₂ : α) (b₁ b₂ : β) :
+  (a₁, b₁) ⊔ (a₂, b₂) = (a₁ ⊔ a₂, b₁ ⊔ b₂) := rfl
+
+@[simp] lemma mk_inf_mk [has_inf α] [has_inf β] (a₁ a₂ : α) (b₁ b₂ : β) :
+  (a₁, b₁) ⊓ (a₂, b₂) = (a₁ ⊓ a₂, b₁ ⊓ b₂) := rfl
+
+@[simp] lemma fst_sup [has_sup α] [has_sup β] (p q : α × β) : (p ⊔ q).fst = p.fst ⊔ q.fst := rfl
+@[simp] lemma fst_inf [has_inf α] [has_inf β] (p q : α × β) : (p ⊓ q).fst = p.fst ⊓ q.fst := rfl
+
+@[simp] lemma snd_sup [has_sup α] [has_sup β] (p q : α × β) : (p ⊔ q).snd = p.snd ⊔ q.snd := rfl
+@[simp] lemma snd_inf [has_inf α] [has_inf β] (p q : α × β) : (p ⊓ q).snd = p.snd ⊓ q.snd := rfl
+
+@[simp] lemma swap_sup [has_sup α] [has_sup β] (p q : α × β) : (p ⊔ q).swap = p.swap ⊔ q.swap := rfl
+@[simp] lemma swap_inf [has_inf α] [has_inf β] (p q : α × β) : (p ⊓ q).swap = p.swap ⊓ q.swap := rfl
+
+lemma sup_def [has_sup α] [has_sup β] (p q : α × β) : p ⊔ q = (p.fst ⊔ q.fst, p.snd ⊔ q.snd) := rfl
+lemma inf_def [has_inf α] [has_inf β] (p q : α × β) : p ⊓ q = (p.fst ⊓ q.fst, p.snd ⊓ q.snd) := rfl
+
 instance [semilattice_sup α] [semilattice_sup β] : semilattice_sup (α × β) :=
 { sup_le := assume a b c h₁ h₂, ⟨sup_le h₁.1 h₂.1, sup_le h₁.2 h₂.2⟩,
   le_sup_left  := assume a b, ⟨le_sup_left, le_sup_left⟩,
@@ -897,6 +1060,24 @@ protected def lattice [lattice α] {P : α → Prop}
   lattice {x : α // P x} :=
 { ..subtype.semilattice_inf Pinf, ..subtype.semilattice_sup Psup }
 
+@[simp, norm_cast] lemma coe_sup [semilattice_sup α] {P : α → Prop}
+  (Psup : ∀⦃x y⦄, P x → P y → P (x ⊔ y)) (x y : subtype P) :
+  (by {haveI := subtype.semilattice_sup Psup, exact (x ⊔ y : subtype P)} : α) = x ⊔ y := rfl
+
+@[simp, norm_cast] lemma coe_inf [semilattice_inf α] {P : α → Prop}
+  (Pinf : ∀⦃x y⦄, P x → P y → P (x ⊓ y)) (x y : subtype P) :
+  (by {haveI := subtype.semilattice_inf Pinf, exact (x ⊓ y : subtype P)} : α) = x ⊓ y := rfl
+
+@[simp] lemma mk_sup_mk [semilattice_sup α] {P : α → Prop} (Psup : ∀⦃x y⦄, P x → P y → P (x ⊔ y))
+  {x y : α} (hx : P x) (hy : P y) :
+  (by {haveI := subtype.semilattice_sup Psup, exact (⟨x, hx⟩ ⊔ ⟨y, hy⟩ : subtype P)}) =
+    ⟨x ⊔ y, Psup hx hy⟩ := rfl
+
+@[simp] lemma mk_inf_mk [semilattice_inf α] {P : α → Prop} (Pinf : ∀⦃x y⦄, P x → P y → P (x ⊓ y))
+  {x y : α} (hx : P x) (hy : P y) :
+  (by {haveI := subtype.semilattice_inf Pinf, exact (⟨x, hx⟩ ⊓ ⟨y, hy⟩ : subtype P)}) =
+    ⟨x ⊓ y, Pinf hx hy⟩ := rfl
+
 end subtype
 
 section lift
diff --git a/src/order/lattice_intervals.lean b/src/order/lattice_intervals.lean
index ba6cce6b5c813..5897c15e515d8 100644
--- a/src/order/lattice_intervals.lean
+++ b/src/order/lattice_intervals.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
 
-import order.bounds
+import order.bounds.basic
 
 /-!
 # Intervals in Lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we provide instances of lattice structures on intervals within lattices.
 Some of them depend on the order of the endpoints of the interval, and thus are not made
 global instances. These are probably not all of the lattice instances that could be placed on these
@@ -32,13 +35,12 @@ namespace set
 
 namespace Ico
 
-variables {a b : α}
-
-instance [semilattice_inf α] : semilattice_inf (Ico a b) :=
+instance [semilattice_inf α] {a b : α} : semilattice_inf (Ico a b) :=
 subtype.semilattice_inf (λ x y hx hy, ⟨le_inf hx.1 hy.1, lt_of_le_of_lt inf_le_left hx.2⟩)
 
 /-- `Ico a b` has a bottom element whenever `a < b`. -/
-@[reducible] protected def order_bot [partial_order α] (h : a < b) : order_bot (Ico a b) :=
+@[reducible] protected def order_bot [partial_order α] {a b : α} (h : a < b) :
+  order_bot (Ico a b) :=
 (is_least_Ico h).order_bot
 
 end Ico
@@ -52,54 +54,48 @@ end Iio
 
 namespace Ioc
 
-variables {a b : α}
-
-instance [semilattice_sup α] : semilattice_sup (Ioc a b) :=
+instance [semilattice_sup α] {a b : α} : semilattice_sup (Ioc a b) :=
 subtype.semilattice_sup (λ x y hx hy, ⟨lt_of_lt_of_le hx.1 le_sup_left, sup_le hx.2 hy.2⟩)
 
 /-- `Ioc a b` has a top element whenever `a < b`. -/
-@[reducible] protected def order_top [partial_order α] (h : a < b) : order_top (Ioc a b) :=
+@[reducible] protected def order_top [partial_order α] {a b : α} (h : a < b) :
+  order_top (Ioc a b) :=
 (is_greatest_Ioc h).order_top
 
 end Ioc
 
-namespace Iio
+namespace Ioi
 
 instance [semilattice_sup α] {a : α} : semilattice_sup (Ioi a) :=
 subtype.semilattice_sup (λ x y hx hy, lt_of_lt_of_le hx le_sup_left)
 
-end Iio
+end Ioi
 
 namespace Iic
 
-variables {a : α}
-
-instance [semilattice_inf α] : semilattice_inf (Iic a) :=
+instance [semilattice_inf α] {a : α} : semilattice_inf (Iic a) :=
 subtype.semilattice_inf (λ x y hx hy, le_trans inf_le_left hx)
 
-instance [semilattice_sup α] : semilattice_sup (Iic a) :=
+instance [semilattice_sup α] {a : α} : semilattice_sup (Iic a) :=
 subtype.semilattice_sup (λ x y hx hy, sup_le hx hy)
 
-instance [lattice α] : lattice (Iic a) :=
+instance [lattice α] {a : α} : lattice (Iic a) :=
 { .. Iic.semilattice_inf,
   .. Iic.semilattice_sup }
 
-instance [preorder α] : order_top (Iic a) :=
+instance [preorder α] {a : α} : order_top (Iic a) :=
 { top := ⟨a, le_refl a⟩,
   le_top := λ x, x.prop }
 
 @[simp] lemma coe_top [preorder α] {a : α} : ↑(⊤ : Iic a) = a := rfl
 
-instance [preorder α] [order_bot α] : order_bot (Iic a) :=
+instance [preorder α] [order_bot α] {a : α} : order_bot (Iic a) :=
 { bot := ⟨⊥, bot_le⟩,
   bot_le := λ ⟨_,_⟩, subtype.mk_le_mk.2 bot_le }
 
 @[simp] lemma coe_bot [preorder α] [order_bot α] {a : α} : ↑(⊥ : Iic a) = (⊥ : α) := rfl
 
-instance [partial_order α] [no_min_order α] {a : α} : no_min_order (Iic a) :=
-⟨λ x, let ⟨y, hy⟩ := exists_lt x.1 in ⟨⟨y, le_trans hy.le x.2⟩, hy⟩ ⟩
-
-instance [preorder α] [order_bot α] : bounded_order (Iic a) :=
+instance [preorder α] [order_bot α] {a : α} : bounded_order (Iic a) :=
 { .. Iic.order_top,
   .. Iic.order_bot }
 
@@ -107,34 +103,33 @@ end Iic
 
 namespace Ici
 
-variables {a : α}
-
-instance [semilattice_inf α] : semilattice_inf (Ici a) :=
+instance [semilattice_inf α] {a : α}: semilattice_inf (Ici a) :=
 subtype.semilattice_inf (λ x y hx hy, le_inf hx hy)
 
-instance [semilattice_sup α] : semilattice_sup (Ici a) :=
+instance [semilattice_sup α] {a : α} : semilattice_sup (Ici a) :=
 subtype.semilattice_sup (λ x y hx hy, le_trans hx le_sup_left)
 
-instance [lattice α] : lattice (Ici a) :=
+instance [lattice α] {a : α} : lattice (Ici a) :=
 { .. Ici.semilattice_inf,
   .. Ici.semilattice_sup }
 
-instance [preorder α] : order_bot (Ici a) :=
+instance [distrib_lattice α] {a : α} : distrib_lattice (Ici a) :=
+{ le_sup_inf := λ a b c, le_sup_inf,
+  .. Ici.lattice }
+
+instance [preorder α] {a : α} : order_bot (Ici a) :=
 { bot := ⟨a, le_refl a⟩,
   bot_le := λ x, x.prop }
 
 @[simp] lemma coe_bot [preorder α] {a : α} : ↑(⊥ : Ici a) = a := rfl
 
-instance [preorder α] [order_top α] : order_top (Ici a) :=
+instance [preorder α] [order_top α] {a : α}: order_top (Ici a) :=
 { top := ⟨⊤, le_top⟩,
   le_top := λ ⟨_,_⟩, subtype.mk_le_mk.2 le_top }
 
 @[simp] lemma coe_top [preorder α] [order_top α] {a : α} : ↑(⊤ : Ici a) = (⊤ : α) := rfl
 
-instance [partial_order α] [no_max_order α] {a : α} : no_max_order (Ici a) :=
-⟨λ x, let ⟨y, hy⟩ := exists_gt x.1 in ⟨⟨y, le_trans x.2 hy.le⟩, hy⟩ ⟩
-
-instance [preorder α] [order_top α] : bounded_order (Ici a) :=
+instance [preorder α] [order_top α] {a : α}: bounded_order (Ici a) :=
 { .. Ici.order_top,
   .. Ici.order_bot }
 
diff --git a/src/order/lexicographic.lean b/src/order/lexicographic.lean
deleted file mode 100644
index 88dee252ffcdd..0000000000000
--- a/src/order/lexicographic.lean
+++ /dev/null
@@ -1,132 +0,0 @@
-/-
-Copyright (c) 2019 Scott Morrison. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Scott Morrison, Minchao Wu
--/
-import data.prod
-import logic.equiv.basic
-import tactic.basic
-
-/-!
-# Lexicographic order
-
-This file defines the lexicographic relation for pairs and dependent pairs of orders, partial orders
-and linear orders.
-
-## Main declarations
-
-* `lex α`: A type synonym of `α` to equip it with its lexicographic order.
-* `prod.lex.
order`: Instances lifting the orders on `α` and `β` to `α ×ₗ β`.
-
-## Notation
-
-* `α ×ₗ β`: `α × β` equipped with the lexicographic order
-
-## See also
-
-Related files are:
-* `data.finset.colex`: Colexicographic order on finite sets.
-* `data.list.lex`: Lexicographic order on lists.
-* `data.psigma.order`: Lexicographic order on `Σ' i, α i`.
-* `data.sigma.order`: Lexicographic order on `Σ i, α i`.
--/
-
-universes u v
-
-/-- A type synonym to equip a type with its lexicographic order. -/
-def lex (α : Type u) := α
-
-variables {α : Type u} {β : Type v} {γ : Type*}
-
-/-- `to_lex` is the identity function to the `lex` of a type.  -/
-@[pattern] def to_lex : α ≃ lex α := ⟨id, id, λ h, rfl, λ h, rfl⟩
-
-/-- `of_lex` is the identity function from the `lex` of a type.  -/
-@[pattern] def of_lex : lex α ≃ α := to_lex.symm
-
-@[simp] lemma to_lex_symm_eq : (@to_lex α).symm = of_lex := rfl
-@[simp] lemma of_lex_symm_eq : (@of_lex α).symm = to_lex := rfl
-@[simp] lemma to_lex_of_lex (a : lex α) : to_lex (of_lex a) = a := rfl
-@[simp] lemma of_lex_to_lex (a : α) : of_lex (to_lex a) = a := rfl
-@[simp] lemma to_lex_inj {a b : α} : to_lex a = to_lex b ↔ a = b := iff.rfl
-@[simp] lemma of_lex_inj {a b : lex α} :  of_lex a = of_lex b ↔ a = b := iff.rfl
-
-/-- A recursor for `lex`. Use as `induction x using lex.rec`. -/
-protected def lex.rec {β : lex α → Sort*} (h : Π a, β (to_lex a)) : Π a, β a := λ a, h (of_lex a)
-
-namespace prod.lex
-
-notation α ` ×ₗ `:35 β:34 := lex (prod α β)
-
-meta instance [has_to_format α] [has_to_format β] : has_to_format (α ×ₗ β) :=
-prod.has_to_format
-
-instance decidable_eq (α β : Type*) [decidable_eq α] [decidable_eq β] : decidable_eq (α ×ₗ β) :=
-prod.decidable_eq
-
-instance inhabited (α β : Type*) [inhabited α] [inhabited β] : inhabited (α ×ₗ β) :=
-prod.inhabited
-
-/-- Dictionary / lexicographic ordering on pairs.  -/
-instance has_le (α β : Type*) [has_lt α] [has_le β] : has_le (α ×ₗ β) :=
-{ le := prod.lex (<) (≤) }
-
-instance has_lt (α β : Type*) [has_lt α] [has_lt β] : has_lt (α ×ₗ β) :=
-{ lt := prod.lex (<) (<) }
-
-lemma le_iff [has_lt α] [has_le β] (a b : α × β) :
-  to_lex a ≤ to_lex b ↔ a.1 < b.1 ∨ a.1 = b.1 ∧ a.2 ≤ b.2 := prod.lex_def (<) (≤)
-
-lemma lt_iff [has_lt α] [has_lt β] (a b : α × β) :
-  to_lex a < to_lex b ↔ a.1 < b.1 ∨ a.1 = b.1 ∧ a.2 < b.2 := prod.lex_def (<) (<)
-
-/-- Dictionary / lexicographic preorder for pairs. -/
-instance preorder (α β : Type*) [preorder α] [preorder β] : preorder (α ×ₗ β) :=
-{ le_refl := by
-  { haveI : is_refl β (≤) := ⟨le_refl⟩,
-    exact refl_of (prod.lex _ _), },
-  le_trans := λ _ _ _, by
-  { haveI : is_trans α (<) := ⟨λ _ _ _, lt_trans⟩,
-    haveI : is_trans β (≤) := ⟨λ _ _ _, le_trans⟩,
-    exact trans_of (prod.lex _ _) },
-  lt_iff_le_not_le := λ x₁ x₂, match x₁, x₂ with
-  | to_lex (a₁, b₁), to_lex (a₂, b₂) := begin
-      split,
-      { rintros (⟨_, _, _, _, hlt⟩ | ⟨_, _, _, hlt⟩),
-        { split,
-          { left, assumption },
-          { rintro ⟨l,r⟩,
-            { apply lt_asymm hlt, assumption },
-            { apply lt_irrefl _ hlt } } },
-        { split,
-          { right, rw lt_iff_le_not_le at hlt, exact hlt.1 },
-          { rintro ⟨l,r⟩,
-            { apply lt_irrefl a₁, assumption },
-            { rw lt_iff_le_not_le at hlt, apply hlt.2, assumption } } } },
-      { rintros ⟨⟨h₁ll, h₁lr⟩, h₂r⟩,
-        { left, assumption },
-        { right, rw lt_iff_le_not_le, split,
-          { assumption },
-          { intro h, apply h₂r, right, exact h } } }
-    end
-  end,
-  .. prod.lex.has_le α β,
-  .. prod.lex.has_lt α β }
-
-/-- Dictionary / lexicographic partial_order for pairs. -/
-instance partial_order (α β : Type*) [partial_order α] [partial_order β] : partial_order (α ×ₗ β) :=
-{ le_antisymm := by
-  { haveI : is_strict_order α (<) := { irrefl := lt_irrefl, trans := λ _ _ _, lt_trans },
-    haveI : is_antisymm β (≤) := ⟨λ _ _, le_antisymm⟩,
-    exact @antisymm _ (prod.lex _ _) _, },
-  .. prod.lex.preorder α β }
-
-/-- Dictionary / lexicographic linear_order for pairs. -/
-instance linear_order (α β : Type*) [linear_order α] [linear_order β] : linear_order (α ×ₗ β) :=
-{ le_total := total_of (prod.lex _ _),
-  decidable_le := prod.lex.decidable _ _,
-  decidable_lt := prod.lex.decidable _ _,
-  decidable_eq := lex.decidable_eq _ _,
-  .. prod.lex.partial_order α β }
-
-end prod.lex
diff --git a/src/order/liminf_limsup.lean b/src/order/liminf_limsup.lean
index f80f61d5317e2..ececbb65f3515 100644
--- a/src/order/liminf_limsup.lean
+++ b/src/order/liminf_limsup.lean
@@ -4,16 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel, Johannes Hölzl, Rémy Degenne
 -/
 import order.filter.cofinite
+import order.hom.complete_lattice
 
 /-!
 # liminfs and limsups of functions and filters
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Defines the Liminf/Limsup of a function taking values in a conditionally complete lattice, with
 respect to an arbitrary filter.
 
-We define `f.Limsup` (`f.Liminf`) where `f` is a filter taking values in a conditionally complete
-lattice. `f.Limsup` is the smallest element `a` such that, eventually, `u ≤ a` (and vice versa for
-`f.Liminf`). To work with the Limsup along a function `u` use `(f.map u).Limsup`.
+We define `Limsup f` (`Liminf f`) where `f` is a filter taking values in a conditionally complete
+lattice. `Limsup f` is the smallest element `a` such that, eventually, `u ≤ a` (and vice versa for
+`Liminf f`). To work with the Limsup along a function `u` use `Limsup (map u f)`.
 
 Usually, one defines the Limsup as `Inf (Sup s)` where the Inf is taken over all sets in the filter.
 For instance, in ℕ along a function `u`, this is `Inf_n (Sup_{k ≥ n} u k)` (and the latter quantity
@@ -36,7 +40,7 @@ In complete lattices, however, it coincides with the `Inf Sup` definition.
 open filter set
 open_locale filter
 
-variables {α β ι : Type*}
+variables {α β γ ι : Type*}
 namespace filter
 
 section relation
@@ -48,7 +52,7 @@ def is_bounded (r : α → α → Prop) (f : filter α) := ∃ b, ∀ᶠ x in f,
 
 /-- `f.is_bounded_under (≺) u`: the image of the filter `f` under `u` is eventually bounded w.r.t.
 the relation `≺`, i.e. eventually, it is bounded by some uniform bound. -/
-def is_bounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (f.map u).is_bounded r
+def is_bounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (map u f).is_bounded r
 
 variables {r : α → α → Prop} {f g : filter α}
 
@@ -85,6 +89,17 @@ lemma is_bounded_under.mono {f g : filter β} {u : β → α} (h : f ≤ g) :
   g.is_bounded_under r u → f.is_bounded_under r u :=
 λ hg, hg.mono (map_mono h)
 
+lemma is_bounded_under.mono_le [preorder β] {l : filter α} {u v : α → β}
+  (hu : is_bounded_under (≤) l u) (hv : v ≤ᶠ[l] u) : is_bounded_under (≤) l v :=
+hu.imp $ λ b hb, (eventually_map.1 hb).mp $ hv.mono $ λ x, le_trans
+
+lemma is_bounded_under.mono_ge [preorder β] {l : filter α} {u v : α → β}
+  (hu : is_bounded_under (≥) l u) (hv : u ≤ᶠ[l] v) : is_bounded_under (≥) l v :=
+@is_bounded_under.mono_le α βᵒᵈ _ _ _ _ hu hv
+
+lemma is_bounded_under_const [is_refl α r] {l : filter β} {a : α} : is_bounded_under r l (λ _, a) :=
+⟨a, eventually_map.2 $ eventually_of_forall $ λ _, refl _⟩
+
 lemma is_bounded.is_bounded_under {q : β → β → Prop} {u : α → β}
   (hf : ∀a₀ a₁, r a₀ a₁ → q (u a₀) (u a₁)) : f.is_bounded r → f.is_bounded_under q u
 | ⟨b, h⟩ := ⟨u b, show ∀ᶠ x in f, q (u x) (u b), from h.mono (λ x, hf x b)⟩
@@ -107,7 +122,7 @@ lemma not_is_bounded_under_of_tendsto_at_bot [preorder β] [no_min_order β] {f
   ¬ is_bounded_under (≥) l f :=
 @not_is_bounded_under_of_tendsto_at_top α βᵒᵈ _ _ _ _ _ hf
 
-lemma is_bounded_under.bdd_above_range_of_cofinite [semilattice_sup β] {f : α → β}
+lemma is_bounded_under.bdd_above_range_of_cofinite [preorder β] [is_directed β (≤)] {f : α → β}
   (hf : is_bounded_under (≤) cofinite f) : bdd_above (range f) :=
 begin
   rcases hf with ⟨b, hb⟩,
@@ -116,17 +131,17 @@ begin
   exact ⟨⟨b, ball_image_iff.2 $ λ x, id⟩, (hb.image f).bdd_above⟩
 end
 
-lemma is_bounded_under.bdd_below_range_of_cofinite [semilattice_inf β] {f : α → β}
+lemma is_bounded_under.bdd_below_range_of_cofinite [preorder β] [is_directed β (≥)] {f : α → β}
   (hf : is_bounded_under (≥) cofinite f) : bdd_below (range f) :=
-@is_bounded_under.bdd_above_range_of_cofinite α βᵒᵈ _ _ hf
+@is_bounded_under.bdd_above_range_of_cofinite α βᵒᵈ _ _ _ hf
 
-lemma is_bounded_under.bdd_above_range [semilattice_sup β] {f : ℕ → β}
+lemma is_bounded_under.bdd_above_range [preorder β] [is_directed β (≤)] {f : ℕ → β}
   (hf : is_bounded_under (≤) at_top f) : bdd_above (range f) :=
 by { rw ← nat.cofinite_eq_at_top at hf, exact hf.bdd_above_range_of_cofinite }
 
-lemma is_bounded_under.bdd_below_range [semilattice_inf β] {f : ℕ → β}
+lemma is_bounded_under.bdd_below_range [preorder β] [is_directed β (≥)] {f : ℕ → β}
   (hf : is_bounded_under (≥) at_top f) : bdd_below (range f) :=
-@is_bounded_under.bdd_above_range βᵒᵈ _ _ hf
+@is_bounded_under.bdd_above_range βᵒᵈ _ _ _ hf
 
 /-- `is_cobounded (≺) f` states that the filter `f` does not tend to infinity w.r.t. `≺`. This is
 also called frequently bounded. Will be usually instantiated with `≤` or `≥`.
@@ -143,7 +158,7 @@ def is_cobounded (r : α → α → Prop) (f : filter α) := ∃b, ∀a, (∀ᶠ
 /-- `is_cobounded_under (≺) f u` states that the image of the filter `f` under the map `u` does not
 tend to infinity w.r.t. `≺`. This is also called frequently bounded. Will be usually instantiated
 with `≤` or `≥`. -/
-def is_cobounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (f.map u).is_cobounded r
+def is_cobounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (map u f).is_cobounded r
 
 /-- To check that a filter is frequently bounded, it suffices to have a witness
 which bounds `f` at some point for every admissible set.
@@ -183,6 +198,31 @@ lemma is_cobounded.mono (h : f ≤ g) : f.is_cobounded r → g.is_cobounded r
 
 end relation
 
+section nonempty
+variables [preorder α] [nonempty α] {f : filter β} {u : β → α}
+
+lemma is_bounded_le_at_bot : (at_bot : filter α).is_bounded (≤) :=
+‹nonempty α›.elim $ λ a, ⟨a, eventually_le_at_bot _⟩
+
+lemma is_bounded_ge_at_top : (at_top : filter α).is_bounded (≥) :=
+‹nonempty α›.elim $ λ a, ⟨a, eventually_ge_at_top _⟩
+
+lemma tendsto.is_bounded_under_le_at_bot (h : tendsto u f at_bot) : f.is_bounded_under (≤) u :=
+is_bounded_le_at_bot.mono h
+
+lemma tendsto.is_bounded_under_ge_at_top (h : tendsto u f at_top) : f.is_bounded_under (≥) u :=
+is_bounded_ge_at_top.mono h
+
+lemma bdd_above_range_of_tendsto_at_top_at_bot [is_directed α (≤)] {u : ℕ → α}
+  (hx : tendsto u at_top at_bot) : bdd_above (set.range u) :=
+hx.is_bounded_under_le_at_bot.bdd_above_range
+
+lemma bdd_below_range_of_tendsto_at_top_at_top [is_directed α (≥)] {u : ℕ → α}
+  (hx : tendsto u at_top at_top) : bdd_below (set.range u) :=
+hx.is_bounded_under_ge_at_top.bdd_below_range
+
+end nonempty
+
 lemma is_cobounded_le_of_bot [preorder α] [order_bot α] {f : filter α} : f.is_cobounded (≤) :=
 ⟨⊥, assume a h, bot_le⟩
 
@@ -195,17 +235,48 @@ lemma is_bounded_le_of_top [preorder α] [order_top α] {f : filter α} : f.is_b
 lemma is_bounded_ge_of_bot [preorder α] [order_bot α] {f : filter α} : f.is_bounded (≥) :=
 ⟨⊥, eventually_of_forall $ λ _, bot_le⟩
 
-lemma is_bounded_under_sup [semilattice_sup α] {f : filter β} {u v : β → α} :
+@[simp] lemma _root_.order_iso.is_bounded_under_le_comp [preorder α] [preorder β] (e : α ≃o β)
+  {l : filter γ} {u : γ → α} :
+  is_bounded_under (≤) l (λ x, e (u x)) ↔ is_bounded_under (≤) l u :=
+e.surjective.exists.trans $ exists_congr $ λ a, by simp only [eventually_map, e.le_iff_le]
+
+@[simp] lemma _root_.order_iso.is_bounded_under_ge_comp [preorder α] [preorder β] (e : α ≃o β)
+  {l : filter γ} {u : γ → α} :
+  is_bounded_under (≥) l (λ x, e (u x)) ↔ is_bounded_under (≥) l u :=
+e.dual.is_bounded_under_le_comp
+
+@[simp, to_additive]
+lemma is_bounded_under_le_inv [ordered_comm_group α] {l : filter β} {u : β → α} :
+  is_bounded_under (≤) l (λ x, (u x)⁻¹) ↔ is_bounded_under (≥) l u :=
+(order_iso.inv α).is_bounded_under_ge_comp
+
+@[simp, to_additive]
+lemma is_bounded_under_ge_inv [ordered_comm_group α] {l : filter β} {u : β → α} :
+  is_bounded_under (≥) l (λ x, (u x)⁻¹) ↔ is_bounded_under (≤) l u :=
+(order_iso.inv α).is_bounded_under_le_comp
+
+lemma is_bounded_under.sup [semilattice_sup α] {f : filter β} {u v : β → α} :
   f.is_bounded_under (≤) u → f.is_bounded_under (≤) v → f.is_bounded_under (≤) (λa, u a ⊔ v a)
 | ⟨bu, (hu : ∀ᶠ x in f, u x ≤ bu)⟩ ⟨bv, (hv : ∀ᶠ x in f, v x ≤ bv)⟩ :=
   ⟨bu ⊔ bv, show ∀ᶠ x in f, u x ⊔ v x ≤ bu ⊔ bv,
     by filter_upwards [hu, hv] with _ using sup_le_sup⟩
 
-lemma is_bounded_under_inf [semilattice_inf α] {f : filter β} {u v : β → α} :
-  f.is_bounded_under (≥) u → f.is_bounded_under (≥) v → f.is_bounded_under (≥) (λa, u a ⊓ v a)
-| ⟨bu, (hu : ∀ᶠ x in f, u x ≥ bu)⟩ ⟨bv, (hv : ∀ᶠ x in f, v x ≥ bv)⟩ :=
-  ⟨bu ⊓ bv, show ∀ᶠ x in f, u x ⊓ v x ≥ bu ⊓ bv,
-    by filter_upwards [hu, hv] with _ using inf_le_inf⟩
+@[simp] lemma is_bounded_under_le_sup [semilattice_sup α] {f : filter β} {u v : β → α} :
+  f.is_bounded_under (≤) (λ a, u a ⊔ v a) ↔ f.is_bounded_under (≤) u ∧ f.is_bounded_under (≤) v :=
+⟨λ h, ⟨h.mono_le $ eventually_of_forall $ λ _, le_sup_left,
+  h.mono_le $ eventually_of_forall $ λ _, le_sup_right⟩, λ h, h.1.sup h.2⟩
+
+lemma is_bounded_under.inf [semilattice_inf α] {f : filter β} {u v : β → α} :
+  f.is_bounded_under (≥) u → f.is_bounded_under (≥) v → f.is_bounded_under (≥) (λa, u a ⊓ v a) :=
+@is_bounded_under.sup αᵒᵈ β _ _ _ _
+
+@[simp] lemma is_bounded_under_ge_inf [semilattice_inf α] {f : filter β} {u v : β → α} :
+  f.is_bounded_under (≥) (λ a, u a ⊓ v a) ↔ f.is_bounded_under (≥) u ∧ f.is_bounded_under (≥) v :=
+@is_bounded_under_le_sup αᵒᵈ _ _ _ _ _
+
+lemma is_bounded_under_le_abs [linear_ordered_add_comm_group α] {f : filter β} {u : β → α} :
+  f.is_bounded_under (≤) (λ a, |u a|) ↔ f.is_bounded_under (≤) u ∧ f.is_bounded_under (≥) u :=
+is_bounded_under_le_sup.trans $ and_congr iff.rfl is_bounded_under_le_neg
 
 /-- Filters are automatically bounded or cobounded in complete lattices. To use the same statements
 in complete and conditionally complete lattices but let automation fill automatically the
@@ -231,212 +302,366 @@ def Liminf (f : filter α) : α := Sup { a | ∀ᶠ n in f, a ≤ n }
 
 /-- The `limsup` of a function `u` along a filter `f` is the infimum of the `a` such that,
 eventually for `f`, holds `u x ≤ a`. -/
-def limsup (f : filter β) (u : β → α) : α := (f.map u).Limsup
+def limsup (u : β → α) (f : filter β) : α := Limsup (map u f)
 
 /-- The `liminf` of a function `u` along a filter `f` is the supremum of the `a` such that,
 eventually for `f`, holds `u x ≥ a`. -/
-def liminf (f : filter β) (u : β → α) : α := (f.map u).Liminf
+def liminf (u : β → α) (f : filter β) : α := Liminf (map u f)
+
+/-- The `blimsup` of a function `u` along a filter `f`, bounded by a predicate `p`, is the infimum
+of the `a` such that, eventually for `f`, `u x ≤ a` whenever `p x` holds. -/
+def blimsup (u : β → α) (f : filter β) (p : β → Prop) :=
+Inf { a | ∀ᶠ x in f, p x → u x ≤ a }
+
+/-- The `bliminf` of a function `u` along a filter `f`, bounded by a predicate `p`, is the supremum
+of the `a` such that, eventually for `f`, `a ≤ u x` whenever `p x` holds. -/
+def bliminf (u : β → α) (f : filter β) (p : β → Prop) :=
+Sup { a | ∀ᶠ x in f, p x → a ≤ u x }
 
 section
-variables {f : filter β} {u : β → α}
-theorem limsup_eq : f.limsup u = Inf { a | ∀ᶠ n in f, u n ≤ a } := rfl
-theorem liminf_eq : f.liminf u = Sup { a | ∀ᶠ n in f, a ≤ u n } := rfl
+
+variables {f : filter β} {u : β → α} {p : β → Prop}
+
+theorem limsup_eq : limsup u f = Inf { a | ∀ᶠ n in f, u n ≤ a } := rfl
+
+theorem liminf_eq : liminf u f = Sup { a | ∀ᶠ n in f, a ≤ u n } := rfl
+
+theorem blimsup_eq : blimsup u f p = Inf { a | ∀ᶠ x in f, p x → u x ≤ a } := rfl
+
+theorem bliminf_eq : bliminf u f p = Sup { a | ∀ᶠ x in f, p x → a ≤ u x } := rfl
+
+end
+
+@[simp] lemma blimsup_true (f : filter β) (u : β → α) :
+  blimsup u f (λ x, true) = limsup u f :=
+by simp [blimsup_eq, limsup_eq]
+
+@[simp] lemma bliminf_true (f : filter β) (u : β → α) :
+  bliminf u f (λ x, true) = liminf u f :=
+by simp [bliminf_eq, liminf_eq]
+
+lemma blimsup_eq_limsup_subtype {f : filter β} {u : β → α} {p : β → Prop} :
+  blimsup u f p = limsup (u ∘ (coe : {x | p x} → β)) (comap coe f) :=
+begin
+  simp only [blimsup_eq, limsup_eq, function.comp_app, eventually_comap, set_coe.forall,
+    subtype.coe_mk, mem_set_of_eq],
+  congr,
+  ext a,
+  exact eventually_congr (eventually_of_forall
+    (λ x, ⟨λ hx y hy hxy, hxy.symm ▸ (hx (hxy ▸ hy)), λ hx hx', hx x hx' rfl⟩)),
 end
 
+lemma bliminf_eq_liminf_subtype {f : filter β} {u : β → α} {p : β → Prop} :
+  bliminf u f p = liminf (u ∘ (coe : {x | p x} → β)) (comap coe f) :=
+@blimsup_eq_limsup_subtype αᵒᵈ β _ f u p
+
 theorem Limsup_le_of_le {f : filter α} {a}
-  (hf : f.is_cobounded (≤) . is_bounded_default) (h : ∀ᶠ n in f, n ≤ a) : f.Limsup ≤ a :=
+  (hf : f.is_cobounded (≤) . is_bounded_default) (h : ∀ᶠ n in f, n ≤ a) : Limsup f ≤ a :=
 cInf_le hf h
 
 theorem le_Liminf_of_le {f : filter α} {a}
-  (hf : f.is_cobounded (≥) . is_bounded_default) (h : ∀ᶠ n in f, a ≤ n) : a ≤ f.Liminf :=
+  (hf : f.is_cobounded (≥) . is_bounded_default) (h : ∀ᶠ n in f, a ≤ n) : a ≤ Liminf f :=
+le_cSup hf h
+
+theorem limsup_le_of_le {f : filter β} {u : β → α} {a}
+  (hf : f.is_cobounded_under (≤) u . is_bounded_default) (h : ∀ᶠ n in f, u n ≤ a) :
+  limsup u f ≤ a :=
+cInf_le hf h
+
+theorem le_liminf_of_le {f : filter β} {u : β → α} {a}
+  (hf : f.is_cobounded_under (≥) u . is_bounded_default) (h : ∀ᶠ n in f, a ≤ u n) :
+    a ≤ liminf u f :=
 le_cSup hf h
 
 theorem le_Limsup_of_le {f : filter α} {a}
   (hf : f.is_bounded (≤) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, n ≤ b) → a ≤ b) :
-  a ≤ f.Limsup :=
+  a ≤ Limsup f :=
 le_cInf hf h
 
 theorem Liminf_le_of_le {f : filter α} {a}
   (hf : f.is_bounded (≥) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, b ≤ n) → b ≤ a) :
-  f.Liminf ≤ a :=
+  Liminf f ≤ a :=
+cSup_le hf h
+
+theorem le_limsup_of_le {f : filter β} {u : β → α} {a}
+  (hf : f.is_bounded_under (≤) u . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, u n ≤ b) → a ≤ b) :
+  a ≤ limsup u f :=
+le_cInf hf h
+
+theorem liminf_le_of_le {f : filter β} {u : β → α} {a}
+  (hf : f.is_bounded_under (≥) u . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, b ≤ u n) → b ≤ a) :
+  liminf u f ≤ a :=
 cSup_le hf h
 
 theorem Liminf_le_Limsup {f : filter α} [ne_bot f]
   (h₁ : f.is_bounded (≤) . is_bounded_default) (h₂ : f.is_bounded (≥) . is_bounded_default) :
-  f.Liminf ≤ f.Limsup :=
+  Liminf f ≤ Limsup f :=
 Liminf_le_of_le h₂ $ assume a₀ ha₀, le_Limsup_of_le h₁ $ assume a₁ ha₁,
   show a₀ ≤ a₁, from let ⟨b, hb₀, hb₁⟩ := (ha₀.and ha₁).exists in le_trans hb₀ hb₁
 
-lemma Liminf_le_Liminf {f g : filter α}
-  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default)
-  (h : ∀ a, (∀ᶠ n in f, a ≤ n) → ∀ᶠ n in g, a ≤ n) : f.Liminf ≤ g.Liminf :=
-cSup_le_cSup hg hf h
+lemma liminf_le_limsup {f : filter β} [ne_bot f] {u : β → α}
+  (h : f.is_bounded_under (≤) u . is_bounded_default)
+  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
+  liminf u f ≤ limsup u f :=
+Liminf_le_Limsup h h'
 
 lemma Limsup_le_Limsup {f g : filter α}
   (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default)
-  (h : ∀ a, (∀ᶠ n in g, n ≤ a) → ∀ᶠ n in f, n ≤ a) : f.Limsup ≤ g.Limsup :=
+  (h : ∀ a, (∀ᶠ n in g, n ≤ a) → ∀ᶠ n in f, n ≤ a) : Limsup f ≤ Limsup g :=
 cInf_le_cInf hf hg h
 
-lemma Limsup_le_Limsup_of_le {f g : filter α} (h : f ≤ g)
-  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default) :
-  f.Limsup ≤ g.Limsup :=
-Limsup_le_Limsup hf hg (assume a ha, h ha)
-
-lemma Liminf_le_Liminf_of_le {f g : filter α} (h : g ≤ f)
-  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default) :
-  f.Liminf ≤ g.Liminf :=
-Liminf_le_Liminf hf hg (assume a ha, h ha)
+lemma Liminf_le_Liminf {f g : filter α}
+  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default)
+  (h : ∀ a, (∀ᶠ n in f, a ≤ n) → ∀ᶠ n in g, a ≤ n) : Liminf f ≤ Liminf g :=
+cSup_le_cSup hg hf h
 
 lemma limsup_le_limsup {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
   (h : u ≤ᶠ[f] v)
   (hu : f.is_cobounded_under (≤) u . is_bounded_default)
   (hv : f.is_bounded_under (≤) v . is_bounded_default) :
-  f.limsup u ≤ f.limsup v :=
+  limsup u f ≤ limsup v f :=
 Limsup_le_Limsup hu hv $ assume b, h.trans
 
 lemma liminf_le_liminf {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
   (h : ∀ᶠ a in f, u a ≤ v a)
   (hu : f.is_bounded_under (≥) u . is_bounded_default)
   (hv : f.is_cobounded_under (≥) v . is_bounded_default) :
-  f.liminf u ≤ f.liminf v :=
+  liminf u f ≤ liminf v f :=
 @limsup_le_limsup βᵒᵈ α _ _ _ _ h hv hu
 
+lemma Limsup_le_Limsup_of_le {f g : filter α} (h : f ≤ g)
+  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default) :
+  Limsup f ≤ Limsup g :=
+Limsup_le_Limsup hf hg (assume a ha, h ha)
+
+lemma Liminf_le_Liminf_of_le {f g : filter α} (h : g ≤ f)
+  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default) :
+  Liminf f ≤ Liminf g :=
+Liminf_le_Liminf hf hg (assume a ha, h ha)
+
 lemma limsup_le_limsup_of_le {α β} [conditionally_complete_lattice β] {f g : filter α} (h : f ≤ g)
   {u : α → β} (hf : f.is_cobounded_under (≤) u . is_bounded_default)
   (hg : g.is_bounded_under (≤) u . is_bounded_default) :
-  f.limsup u ≤ g.limsup u :=
+  limsup u f ≤ limsup u g :=
 Limsup_le_Limsup_of_le (map_mono h) hf hg
 
 lemma liminf_le_liminf_of_le {α β} [conditionally_complete_lattice β] {f g : filter α} (h : g ≤ f)
   {u : α → β} (hf : f.is_bounded_under (≥) u . is_bounded_default)
   (hg : g.is_cobounded_under (≥) u . is_bounded_default) :
-  f.liminf u ≤ g.liminf u :=
+  liminf u f ≤ liminf u g :=
 Liminf_le_Liminf_of_le (map_mono h) hf hg
 
 theorem Limsup_principal {s : set α} (h : bdd_above s) (hs : s.nonempty) :
-  (𝓟 s).Limsup = Sup s :=
+  Limsup (𝓟 s) = Sup s :=
 by simp [Limsup]; exact cInf_upper_bounds_eq_cSup h hs
 
 theorem Liminf_principal {s : set α} (h : bdd_below s) (hs : s.nonempty) :
-  (𝓟 s).Liminf = Inf s :=
+  Liminf (𝓟 s) = Inf s :=
 @Limsup_principal αᵒᵈ _ s h hs
 
 lemma limsup_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
-  (h : ∀ᶠ a in f, u a = v a) : limsup f u = limsup f v :=
+  (h : ∀ᶠ a in f, u a = v a) : limsup u f = limsup v f :=
 begin
   rw limsup_eq,
   congr' with b,
   exact eventually_congr (h.mono $ λ x hx, by simp [hx])
 end
 
+lemma blimsup_congr {f : filter β} {u v : β → α} {p : β → Prop} (h : ∀ᶠ a in f, p a → u a = v a) :
+  blimsup u f p = blimsup v f p :=
+begin
+  rw blimsup_eq,
+  congr' with b,
+  refine eventually_congr (h.mono $ λ x hx, ⟨λ h₁ h₂, _, λ h₁ h₂, _⟩),
+  { rw ← hx h₂, exact h₁ h₂, },
+  { rw hx h₂, exact h₁ h₂, },
+end
+
+lemma bliminf_congr {f : filter β} {u v : β → α} {p : β → Prop} (h : ∀ᶠ a in f, p a → u a = v a) :
+  bliminf u f p = bliminf v f p :=
+@blimsup_congr αᵒᵈ _ _ _ _ _ _ h
+
 lemma liminf_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
-  (h : ∀ᶠ a in f, u a = v a) : liminf f u = liminf f v :=
+  (h : ∀ᶠ a in f, u a = v a) : liminf u f = liminf v f :=
 @limsup_congr βᵒᵈ _ _ _ _ _ h
 
 lemma limsup_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
-  (b : β) : limsup f (λ x, b) = b :=
+  (b : β) : limsup (λ x, b) f = b :=
 by simpa only [limsup_eq, eventually_const] using cInf_Ici
 
 lemma liminf_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
-  (b : β) : liminf f (λ x, b) = b :=
+  (b : β) : liminf (λ x, b) f = b :=
 @limsup_const βᵒᵈ α _ f _ b
 
-lemma liminf_le_limsup {f : filter β} [ne_bot f] {u : β → α}
-  (h : f.is_bounded_under (≤) u . is_bounded_default)
-  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
-  liminf f u ≤ limsup f u :=
-Liminf_le_Limsup h h'
 
 end conditionally_complete_lattice
 
 section complete_lattice
 variables [complete_lattice α]
 
-@[simp] theorem Limsup_bot : (⊥ : filter α).Limsup = ⊥ :=
+@[simp] theorem Limsup_bot : Limsup (⊥ : filter α) = ⊥ :=
 bot_unique $ Inf_le $ by simp
 
-@[simp] theorem Liminf_bot : (⊥ : filter α).Liminf = ⊤ :=
+@[simp] theorem Liminf_bot : Liminf (⊥ : filter α) = ⊤ :=
 top_unique $ le_Sup $ by simp
 
-@[simp] theorem Limsup_top : (⊤ : filter α).Limsup = ⊤ :=
+@[simp] theorem Limsup_top : Limsup (⊤ : filter α) = ⊤ :=
 top_unique $ le_Inf $
   by simp [eq_univ_iff_forall]; exact assume b hb, (top_unique $ hb _)
 
-@[simp] theorem Liminf_top : (⊤ : filter α).Liminf = ⊥ :=
+@[simp] theorem Liminf_top : Liminf (⊤ : filter α) = ⊥ :=
 bot_unique $ Sup_le $
   by simp [eq_univ_iff_forall]; exact assume b hb, (bot_unique $ hb _)
 
+@[simp] lemma blimsup_false {f : filter β} {u : β → α} :
+  blimsup u f (λ x, false) = ⊥ :=
+by simp [blimsup_eq]
+
+@[simp] lemma bliminf_false {f : filter β} {u : β → α} :
+  bliminf u f (λ x, false) = ⊤ :=
+by simp [bliminf_eq]
+
 /-- Same as limsup_const applied to `⊥` but without the `ne_bot f` assumption -/
-lemma limsup_const_bot {f : filter β} : limsup f (λ x : β, (⊥ : α)) = (⊥ : α) :=
+lemma limsup_const_bot {f : filter β} : limsup (λ x : β, (⊥ : α)) f = (⊥ : α) :=
 begin
   rw [limsup_eq, eq_bot_iff],
   exact Inf_le (eventually_of_forall (λ x, le_rfl)),
 end
 
 /-- Same as limsup_const applied to `⊤` but without the `ne_bot f` assumption -/
-lemma liminf_const_top {f : filter β} : liminf f (λ x : β, (⊤ : α)) = (⊤ : α) :=
+lemma liminf_const_top {f : filter β} : liminf (λ x : β, (⊤ : α)) f = (⊤ : α) :=
 @limsup_const_bot αᵒᵈ β _ _
 
 theorem has_basis.Limsup_eq_infi_Sup {ι} {p : ι → Prop} {s} {f : filter α} (h : f.has_basis p s) :
-  f.Limsup = ⨅ i (hi : p i), Sup (s i) :=
+  Limsup f = ⨅ i (hi : p i), Sup (s i) :=
 le_antisymm
   (le_infi₂ $ λ i hi, Inf_le $ h.eventually_iff.2 ⟨i, hi, λ x, le_Sup⟩)
   (le_Inf $ assume a ha, let ⟨i, hi, ha⟩ := h.eventually_iff.1 ha in
     infi₂_le_of_le _ hi $ Sup_le ha)
 
 theorem has_basis.Liminf_eq_supr_Inf {p : ι → Prop} {s : ι → set α} {f : filter α}
-  (h : f.has_basis p s) : f.Liminf = ⨆ i (hi : p i), Inf (s i) :=
+  (h : f.has_basis p s) : Liminf f = ⨆ i (hi : p i), Inf (s i) :=
 @has_basis.Limsup_eq_infi_Sup αᵒᵈ _ _ _ _ _ h
 
-theorem Limsup_eq_infi_Sup {f : filter α} : f.Limsup = ⨅ s ∈ f, Sup s :=
+theorem Limsup_eq_infi_Sup {f : filter α} : Limsup f = ⨅ s ∈ f, Sup s :=
 f.basis_sets.Limsup_eq_infi_Sup
 
-theorem Liminf_eq_supr_Inf {f : filter α} : f.Liminf = ⨆ s ∈ f, Inf s :=
+theorem Liminf_eq_supr_Inf {f : filter α} : Liminf f = ⨆ s ∈ f, Inf s :=
 @Limsup_eq_infi_Sup αᵒᵈ _ _
 
+theorem limsup_le_supr {f : filter β} {u : β → α} : limsup u f ≤ ⨆ n, u n :=
+limsup_le_of_le (by is_bounded_default) (eventually_of_forall (le_supr u))
+
+theorem infi_le_liminf {f : filter β} {u : β → α} : (⨅ n, u n) ≤ liminf u f :=
+le_liminf_of_le (by is_bounded_default) (eventually_of_forall (infi_le u))
+
 /-- In a complete lattice, the limsup of a function is the infimum over sets `s` in the filter
 of the supremum of the function over `s` -/
-theorem limsup_eq_infi_supr {f : filter β} {u : β → α} : f.limsup u = ⨅ s ∈ f, ⨆ a ∈ s, u a :=
+theorem limsup_eq_infi_supr {f : filter β} {u : β → α} : limsup u f = ⨅ s ∈ f, ⨆ a ∈ s, u a :=
 (f.basis_sets.map u).Limsup_eq_infi_Sup.trans $
   by simp only [Sup_image, id]
 
-lemma limsup_eq_infi_supr_of_nat {u : ℕ → α} : limsup at_top u = ⨅ n : ℕ, ⨆ i ≥ n, u i :=
+lemma limsup_eq_infi_supr_of_nat {u : ℕ → α} : limsup u at_top = ⨅ n : ℕ, ⨆ i ≥ n, u i :=
 (at_top_basis.map u).Limsup_eq_infi_Sup.trans $
   by simp only [Sup_image, infi_const]; refl
 
-lemma limsup_eq_infi_supr_of_nat' {u : ℕ → α} : limsup at_top u = ⨅ n : ℕ, ⨆ i : ℕ, u (i + n) :=
+lemma limsup_eq_infi_supr_of_nat' {u : ℕ → α} : limsup u at_top = ⨅ n : ℕ, ⨆ i : ℕ, u (i + n) :=
 by simp only [limsup_eq_infi_supr_of_nat, supr_ge_eq_supr_nat_add]
 
 theorem has_basis.limsup_eq_infi_supr {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
-  (h : f.has_basis p s) : f.limsup u = ⨅ i (hi : p i), ⨆ a ∈ s i, u a :=
+  (h : f.has_basis p s) : limsup u f = ⨅ i (hi : p i), ⨆ a ∈ s i, u a :=
 (h.map u).Limsup_eq_infi_Sup.trans $ by simp only [Sup_image, id]
 
+lemma blimsup_congr' {f : filter β} {p q : β → Prop} {u : β → α}
+  (h : ∀ᶠ x in f, u x ≠ ⊥ → (p x ↔ q x)) :
+  blimsup u f p = blimsup u f q :=
+begin
+  simp only [blimsup_eq],
+  congr,
+  ext a,
+  refine eventually_congr (h.mono $ λ b hb, _),
+  cases eq_or_ne (u b) ⊥ with hu hu, { simp [hu], },
+  rw hb hu,
+end
+
+lemma bliminf_congr' {f : filter β} {p q : β → Prop} {u : β → α}
+  (h : ∀ᶠ x in f, u x ≠ ⊤ → (p x ↔ q x)) :
+  bliminf u f p = bliminf u f q :=
+@blimsup_congr' αᵒᵈ β _ _ _ _ _ h
+
+lemma blimsup_eq_infi_bsupr {f : filter β} {p : β → Prop} {u : β → α} :
+  blimsup u f p = ⨅ s ∈ f, ⨆ b (hb : p b ∧ b ∈ s), u b :=
+begin
+  refine le_antisymm (Inf_le_Inf _) (infi_le_iff.mpr $ λ a ha, le_Inf_iff.mpr $ λ a' ha', _),
+  { rintros - ⟨s, rfl⟩,
+    simp only [mem_set_of_eq, le_infi_iff],
+    conv { congr, funext, rw imp.swap, },
+    refine eventually_imp_distrib_left.mpr (λ h, eventually_iff_exists_mem.2 ⟨s, h, λ x h₁ h₂, _⟩),
+    exact @le_supr₂ α β (λ b, p b ∧ b ∈ s) _ (λ b hb, u b) x ⟨h₂, h₁⟩, },
+  { obtain ⟨s, hs, hs'⟩ := eventually_iff_exists_mem.mp ha',
+    simp_rw imp.swap at hs',
+    exact (le_infi_iff.mp (ha s) hs).trans (by simpa only [supr₂_le_iff, and_imp]), },
+end
+
+lemma blimsup_eq_infi_bsupr_of_nat {p : ℕ → Prop} {u : ℕ → α} :
+  blimsup u at_top p = ⨅ i, ⨆ j (hj : p j ∧ i ≤ j), u j :=
+by simp only [blimsup_eq_limsup_subtype, mem_preimage, mem_Ici, function.comp_app, cinfi_pos,
+  supr_subtype, (at_top_basis.comap (coe : {x | p x} → ℕ)).limsup_eq_infi_supr, mem_set_of_eq,
+  subtype.coe_mk, supr_and]
+
 /-- In a complete lattice, the liminf of a function is the infimum over sets `s` in the filter
 of the supremum of the function over `s` -/
-theorem liminf_eq_supr_infi {f : filter β} {u : β → α} : f.liminf u = ⨆ s ∈ f, ⨅ a ∈ s, u a :=
+theorem liminf_eq_supr_infi {f : filter β} {u : β → α} : liminf u f = ⨆ s ∈ f, ⨅ a ∈ s, u a :=
 @limsup_eq_infi_supr αᵒᵈ β _ _ _
 
-lemma liminf_eq_supr_infi_of_nat {u : ℕ → α} : liminf at_top u = ⨆ n : ℕ, ⨅ i ≥ n, u i :=
+lemma liminf_eq_supr_infi_of_nat {u : ℕ → α} : liminf u at_top = ⨆ n : ℕ, ⨅ i ≥ n, u i :=
 @limsup_eq_infi_supr_of_nat αᵒᵈ _ u
 
-lemma liminf_eq_supr_infi_of_nat' {u : ℕ → α} : liminf at_top u = ⨆ n : ℕ, ⨅ i : ℕ, u (i + n) :=
+lemma liminf_eq_supr_infi_of_nat' {u : ℕ → α} : liminf u at_top = ⨆ n : ℕ, ⨅ i : ℕ, u (i + n) :=
 @limsup_eq_infi_supr_of_nat' αᵒᵈ _ _
 
 theorem has_basis.liminf_eq_supr_infi {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
-  (h : f.has_basis p s) : f.liminf u = ⨆ i (hi : p i), ⨅ a ∈ s i, u a :=
+  (h : f.has_basis p s) : liminf u f = ⨆ i (hi : p i), ⨅ a ∈ s i, u a :=
 @has_basis.limsup_eq_infi_supr αᵒᵈ _ _ _ _ _ _ _ h
 
+lemma bliminf_eq_supr_binfi {f : filter β} {p : β → Prop} {u : β → α} :
+  bliminf u f p = ⨆ s ∈ f, ⨅ b (hb : p b ∧ b ∈ s), u b :=
+@blimsup_eq_infi_bsupr αᵒᵈ β _ f p u
+
+lemma bliminf_eq_supr_binfi_of_nat {p : ℕ → Prop} {u : ℕ → α} :
+  bliminf u at_top p = ⨆ i, ⨅ j (hj : p j ∧ i ≤ j), u j :=
+@blimsup_eq_infi_bsupr_of_nat αᵒᵈ _ p u
+
+lemma limsup_eq_Inf_Sup {ι R : Type*} (F : filter ι) [complete_lattice R] (a : ι → R) :
+  limsup a F = Inf ((λ I, Sup (a '' I)) '' F.sets) :=
+begin
+  refine le_antisymm _ _,
+  { rw limsup_eq,
+    refine Inf_le_Inf (λ x hx, _),
+    rcases (mem_image _ F.sets x).mp hx with ⟨I, ⟨I_mem_F, hI⟩⟩,
+    filter_upwards [I_mem_F] with i hi,
+    exact hI ▸ le_Sup (mem_image_of_mem _ hi), },
+  { refine le_Inf_iff.mpr (λ b hb, Inf_le_of_le (mem_image_of_mem _ $ filter.mem_sets.mpr hb)
+      $ Sup_le _),
+    rintros _ ⟨_, h, rfl⟩,
+    exact h, },
+end
+
+lemma liminf_eq_Sup_Inf {ι R : Type*} (F : filter ι) [complete_lattice R] (a : ι → R) :
+  liminf a F = Sup ((λ I, Inf (a '' I)) '' F.sets) :=
+@filter.limsup_eq_Inf_Sup ι (order_dual R) _ _ a
+
 @[simp] lemma liminf_nat_add (f : ℕ → α) (k : ℕ) :
-  at_top.liminf (λ i, f (i + k)) = at_top.liminf f :=
+  liminf (λ i, f (i + k)) at_top = liminf f at_top :=
 by { simp_rw liminf_eq_supr_infi_of_nat, exact supr_infi_ge_nat_add f k }
 
 @[simp] lemma limsup_nat_add (f : ℕ → α) (k : ℕ) :
-  at_top.limsup (λ i, f (i + k)) = at_top.limsup f :=
+  limsup (λ i, f (i + k)) at_top = limsup f at_top :=
 @liminf_nat_add αᵒᵈ _ f k
 
 lemma liminf_le_of_frequently_le' {α β} [complete_lattice β]
   {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, u a ≤ x) :
-  f.liminf u ≤ x :=
+  liminf u f ≤ x :=
 begin
   rw liminf_eq,
   refine Sup_le (λ b hb, _),
@@ -449,15 +674,267 @@ end
 
 lemma le_limsup_of_frequently_le' {α β} [complete_lattice β]
   {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, x ≤ u a) :
-  x ≤ f.limsup u :=
+  x ≤ limsup u f :=
 @liminf_le_of_frequently_le' _ βᵒᵈ _ _ _ _ h
 
+/-- If `f : α → α` is a morphism of complete lattices, then the limsup of its iterates of any
+`a : α` is a fixed point. -/
+@[simp] lemma complete_lattice_hom.apply_limsup_iterate (f : complete_lattice_hom α α) (a : α) :
+  f (limsup (λ n, f^[n] a) at_top) = limsup (λ n, f^[n] a) at_top :=
+begin
+  rw [limsup_eq_infi_supr_of_nat', map_infi],
+  simp_rw [_root_.map_supr, ← function.comp_apply f, ← function.iterate_succ' f, ← nat.add_succ],
+  conv_rhs { rw infi_split _ ((<) (0 : ℕ)), },
+  simp only [not_lt, le_zero_iff, infi_infi_eq_left, add_zero, infi_nat_gt_zero_eq, left_eq_inf],
+  refine (infi_le (λ i, ⨆ j, (f^[j + (i + 1)]) a) 0).trans _,
+  simp only [zero_add, function.comp_app, supr_le_iff],
+  exact λ i, le_supr (λ i, (f^[i] a)) (i + 1),
+end
+
+/-- If `f : α → α` is a morphism of complete lattices, then the liminf of its iterates of any
+`a : α` is a fixed point. -/
+lemma complete_lattice_hom.apply_liminf_iterate (f : complete_lattice_hom α α) (a : α) :
+  f (liminf (λ n, f^[n] a) at_top) = liminf (λ n, f^[n] a) at_top :=
+(complete_lattice_hom.dual f).apply_limsup_iterate _
+variables {f g : filter β} {p q : β → Prop} {u v : β → α}
+
+lemma blimsup_mono (h : ∀ x, p x → q x) :
+  blimsup u f p ≤ blimsup u f q :=
+Inf_le_Inf $ λ a ha, ha.mono $ by tauto
+
+lemma bliminf_antitone (h : ∀ x, p x → q x) :
+  bliminf u f q ≤ bliminf u f p :=
+Sup_le_Sup $ λ a ha, ha.mono $ by tauto
+
+lemma mono_blimsup' (h : ∀ᶠ x in f, p x → u x ≤ v x) :
+  blimsup u f p ≤ blimsup v f p :=
+Inf_le_Inf $ λ a ha, (ha.and h).mono $ λ x hx hx', (hx.2 hx').trans (hx.1 hx')
+
+lemma mono_blimsup (h : ∀ x, p x → u x ≤ v x) :
+  blimsup u f p ≤ blimsup v f p :=
+mono_blimsup' $ eventually_of_forall h
+
+lemma mono_bliminf' (h : ∀ᶠ x in f, p x → u x ≤ v x) :
+  bliminf u f p ≤ bliminf v f p :=
+Sup_le_Sup $ λ a ha, (ha.and h).mono $ λ x hx hx', (hx.1 hx').trans (hx.2 hx')
+
+lemma mono_bliminf (h : ∀ x, p x → u x ≤ v x) :
+  bliminf u f p ≤ bliminf v f p :=
+mono_bliminf' $ eventually_of_forall h
+
+lemma bliminf_antitone_filter (h : f ≤ g) :
+  bliminf u g p ≤ bliminf u f p :=
+Sup_le_Sup $ λ a ha, ha.filter_mono h
+
+lemma blimsup_monotone_filter (h : f ≤ g) :
+  blimsup u f p ≤ blimsup u g p :=
+Inf_le_Inf $ λ a ha, ha.filter_mono h
+
+@[simp] lemma blimsup_and_le_inf :
+  blimsup u f (λ x, p x ∧ q x) ≤ blimsup u f p ⊓ blimsup u f q :=
+le_inf (blimsup_mono $ by tauto) (blimsup_mono $ by tauto)
+
+@[simp] lemma bliminf_sup_le_and :
+  bliminf u f p ⊔ bliminf u f q ≤ bliminf u f (λ x, p x ∧ q x) :=
+@blimsup_and_le_inf αᵒᵈ β _ f p q u
+
+/-- See also `filter.blimsup_or_eq_sup`. -/
+@[simp] lemma blimsup_sup_le_or :
+  blimsup u f p ⊔ blimsup u f q ≤ blimsup u f (λ x, p x ∨ q x) :=
+sup_le (blimsup_mono $ by tauto) (blimsup_mono $ by tauto)
+
+/-- See also `filter.bliminf_or_eq_inf`. -/
+@[simp] lemma bliminf_or_le_inf :
+  bliminf u f (λ x, p x ∨ q x) ≤ bliminf u f p ⊓ bliminf u f q :=
+@blimsup_sup_le_or αᵒᵈ β _ f p q u
+
+lemma order_iso.apply_blimsup [complete_lattice γ] (e : α ≃o γ) :
+  e (blimsup u f p) = blimsup (e ∘ u) f p :=
+begin
+  simp only [blimsup_eq, map_Inf, function.comp_app],
+  congr,
+  ext c,
+  obtain ⟨a, rfl⟩ := e.surjective c,
+  simp,
+end
+
+lemma order_iso.apply_bliminf [complete_lattice γ] (e : α ≃o γ) :
+  e (bliminf u f p) = bliminf (e ∘ u) f p :=
+@order_iso.apply_blimsup αᵒᵈ β γᵒᵈ _ f p u _ e.dual
+
+lemma Sup_hom.apply_blimsup_le [complete_lattice γ] (g : Sup_hom α γ) :
+  g (blimsup u f p) ≤ blimsup (g ∘ u) f p :=
+begin
+  simp only [blimsup_eq_infi_bsupr],
+  refine ((order_hom_class.mono g).map_infi₂_le _).trans _,
+  simp only [_root_.map_supr],
+end
+
+lemma Inf_hom.le_apply_bliminf [complete_lattice γ] (g : Inf_hom α γ) :
+  bliminf (g ∘ u) f p ≤ g (bliminf u f p) :=
+@Sup_hom.apply_blimsup_le αᵒᵈ β γᵒᵈ _ f p u _ g.dual
+
 end complete_lattice
 
+section complete_distrib_lattice
+
+variables [complete_distrib_lattice α] {f : filter β} {p q : β → Prop} {u : β → α}
+
+@[simp] lemma blimsup_or_eq_sup :
+  blimsup u f (λ x, p x ∨ q x) = blimsup u f p ⊔ blimsup u f q :=
+begin
+  refine le_antisymm _ blimsup_sup_le_or,
+  simp only [blimsup_eq, Inf_sup_eq, sup_Inf_eq, le_infi₂_iff, mem_set_of_eq],
+  refine λ a' ha' a ha, Inf_le ((ha.and ha').mono $ λ b h hb, _),
+  exact or.elim hb (λ hb, le_sup_of_le_left $ h.1 hb) (λ hb, le_sup_of_le_right $ h.2 hb),
+end
+
+@[simp] lemma bliminf_or_eq_inf :
+  bliminf u f (λ x, p x ∨ q x) = bliminf u f p ⊓ bliminf u f q :=
+@blimsup_or_eq_sup αᵒᵈ β _ f p q u
+
+lemma sup_limsup [ne_bot f] (a : α) :
+  a ⊔ limsup u f = limsup (λ x, a ⊔ u x) f :=
+begin
+  simp only [limsup_eq_infi_supr, supr_sup_eq, sup_binfi_eq],
+  congr, ext s, congr, ext hs, congr,
+  exact (bsupr_const (nonempty_of_mem hs)).symm,
+end
+
+lemma inf_liminf [ne_bot f] (a : α) :
+  a ⊓ liminf u f = liminf (λ x, a ⊓ u x) f :=
+@sup_limsup αᵒᵈ β _ f _ _ _
+
+lemma sup_liminf (a : α) :
+  a ⊔ liminf u f = liminf (λ x, a ⊔ u x) f :=
+begin
+  simp only [liminf_eq_supr_infi],
+  rw [sup_comm, bsupr_sup (⟨univ, univ_mem⟩ : ∃ (i : set β), i ∈ f)],
+  simp_rw [binfi_sup_eq, @sup_comm _ _ a],
+end
+
+lemma inf_limsup (a : α) :
+  a ⊓ limsup u f = limsup (λ x, a ⊓ u x) f :=
+@sup_liminf αᵒᵈ β _ f _ _
+
+end complete_distrib_lattice
+
+section complete_boolean_algebra
+
+variables [complete_boolean_algebra α] (f : filter β) (u : β → α)
+
+lemma limsup_compl :
+  (limsup u f)ᶜ = liminf (compl ∘ u) f :=
+by simp only [limsup_eq_infi_supr, liminf_eq_supr_infi, compl_infi, compl_supr]
+
+lemma liminf_compl :
+  (liminf u f)ᶜ = limsup (compl ∘ u) f :=
+by simp only [limsup_eq_infi_supr, liminf_eq_supr_infi, compl_infi, compl_supr]
+
+lemma limsup_sdiff (a : α) :
+  (limsup u f) \ a = limsup (λ b, (u b) \ a) f :=
+begin
+  simp only [limsup_eq_infi_supr, sdiff_eq],
+  rw binfi_inf (⟨univ, univ_mem⟩ : ∃ (i : set β), i ∈ f),
+  simp_rw [inf_comm, inf_bsupr_eq, inf_comm],
+end
+
+lemma liminf_sdiff [ne_bot f] (a : α) :
+  (liminf u f) \ a = liminf (λ b, (u b) \ a) f :=
+by simp only [sdiff_eq, @inf_comm _ _ _ aᶜ, inf_liminf]
+
+lemma sdiff_limsup [ne_bot f] (a : α) :
+  a \ limsup u f = liminf (λ b, a \ u b) f :=
+begin
+  rw ← compl_inj_iff,
+  simp only [sdiff_eq, liminf_compl, (∘), compl_inf, compl_compl, sup_limsup],
+end
+
+lemma sdiff_liminf (a : α) :
+  a \ liminf u f = limsup (λ b, a \ u b) f :=
+begin
+  rw ← compl_inj_iff,
+  simp only [sdiff_eq, limsup_compl, (∘), compl_inf, compl_compl, sup_liminf],
+end
+
+end complete_boolean_algebra
+
+section set_lattice
+
+variables {p : ι → Prop} {s : ι → set α}
+
+lemma cofinite.blimsup_set_eq :
+  blimsup s cofinite p = { x | { n | p n ∧ x ∈ s n }.infinite } :=
+begin
+  simp only [blimsup_eq, le_eq_subset, eventually_cofinite, not_forall, Inf_eq_sInter, exists_prop],
+  ext x,
+  refine ⟨λ h, _, λ hx t h, _⟩;
+  contrapose! h,
+  { simp only [mem_sInter, mem_set_of_eq, not_forall, exists_prop],
+    exact ⟨{x}ᶜ, by simpa using h, by simp⟩, },
+  { exact hx.mono (λ i hi, ⟨hi.1, λ hit, h (hit hi.2)⟩), },
+end
+
+lemma cofinite.bliminf_set_eq :
+  bliminf s cofinite p = { x | { n | p n ∧ x ∉ s n }.finite } :=
+begin
+  rw ← compl_inj_iff,
+  simpa only [bliminf_eq_supr_binfi, compl_infi, compl_supr, ← blimsup_eq_infi_bsupr,
+    cofinite.blimsup_set_eq],
+end
+
+/-- In other words, `limsup cofinite s` is the set of elements lying inside the family `s`
+infinitely often. -/
+lemma cofinite.limsup_set_eq :
+  limsup s cofinite = { x | { n | x ∈ s n }.infinite } :=
+by simp only [← cofinite.blimsup_true s, cofinite.blimsup_set_eq, true_and]
+
+/-- In other words, `liminf cofinite s` is the set of elements lying outside the family `s`
+finitely often. -/
+lemma cofinite.liminf_set_eq :
+  liminf s cofinite = { x | { n | x ∉ s n }.finite } :=
+by simp only [← cofinite.bliminf_true s, cofinite.bliminf_set_eq, true_and]
+
+lemma exists_forall_mem_of_has_basis_mem_blimsup
+  {l : filter β} {b : ι → set β} {q : ι → Prop} (hl : l.has_basis q b)
+  {u : β → set α} {p : β → Prop} {x : α} (hx : x ∈ blimsup u l p) :
+  ∃ f : {i | q i} → β, ∀ i, x ∈ u (f i) ∧ p (f i) ∧ f i ∈ b i :=
+begin
+  rw blimsup_eq_infi_bsupr at hx,
+  simp only [supr_eq_Union, infi_eq_Inter, mem_Inter, mem_Union, exists_prop] at hx,
+  choose g hg hg' using hx,
+  refine ⟨λ (i : {i | q i}), g (b i) (hl.mem_of_mem i.2), λ i, ⟨_, _⟩⟩,
+  { exact hg' (b i) (hl.mem_of_mem i.2), },
+  { exact hg (b i) (hl.mem_of_mem i.2), },
+end
+
+lemma exists_forall_mem_of_has_basis_mem_blimsup'
+  {l : filter β} {b : ι → set β} (hl : l.has_basis (λ _, true) b)
+  {u : β → set α} {p : β → Prop} {x : α} (hx : x ∈ blimsup u l p) :
+  ∃ f : ι → β, ∀ i, x ∈ u (f i) ∧ p (f i) ∧ f i ∈ b i :=
+begin
+  obtain ⟨f, hf⟩ := exists_forall_mem_of_has_basis_mem_blimsup hl hx,
+  exact ⟨λ i, f ⟨i, trivial⟩, λ i, hf ⟨i, trivial⟩⟩,
+end
+
+end set_lattice
+
 section conditionally_complete_linear_order
 
+lemma frequently_lt_of_lt_Limsup {f : filter α} [conditionally_complete_linear_order α] {a : α}
+  (hf : f.is_cobounded (≤) . is_bounded_default) (h : a < Limsup f) : ∃ᶠ n in f, a < n :=
+begin
+  contrapose! h,
+  simp only [not_frequently, not_lt] at h,
+  exact Limsup_le_of_le hf h,
+end
+
+lemma frequently_lt_of_Liminf_lt {f : filter α} [conditionally_complete_linear_order α] {a : α}
+  (hf : f.is_cobounded (≥) . is_bounded_default) (h : Liminf f < a) : ∃ᶠ n in f, n < a :=
+@frequently_lt_of_lt_Limsup (order_dual α) f _ a hf h
+
 lemma eventually_lt_of_lt_liminf {f : filter α} [conditionally_complete_linear_order β]
-  {u : α → β} {b : β} (h : b < liminf f u) (hu : f.is_bounded_under (≥) u . is_bounded_default) :
+  {u : α → β} {b : β} (h : b < liminf u f) (hu : f.is_bounded_under (≥) u . is_bounded_default) :
   ∀ᶠ a in f, b < u a :=
 begin
   obtain ⟨c, hc, hbc⟩ : ∃ (c : β) (hc : c ∈ {c : β | ∀ᶠ (n : α) in f, c ≤ u n}), b < c :=
@@ -466,14 +943,14 @@ begin
 end
 
 lemma eventually_lt_of_limsup_lt {f : filter α} [conditionally_complete_linear_order β]
-  {u : α → β} {b : β} (h : limsup f u < b) (hu : f.is_bounded_under (≤) u . is_bounded_default) :
+  {u : α → β} {b : β} (h : limsup u f < b) (hu : f.is_bounded_under (≤) u . is_bounded_default) :
   ∀ᶠ a in f, u a < b :=
 @eventually_lt_of_lt_liminf _ βᵒᵈ _ _ _ _ h hu
 
 lemma le_limsup_of_frequently_le {α β} [conditionally_complete_linear_order β] {f : filter α}
   {u : α → β}  {b : β} (hu_le : ∃ᶠ x in f, b ≤ u x)
   (hu : f.is_bounded_under (≤) u . is_bounded_default) :
-  b ≤ f.limsup u :=
+  b ≤ limsup u f :=
 begin
   revert hu_le,
   rw [←not_imp_not, not_frequently],
@@ -484,12 +961,12 @@ end
 lemma liminf_le_of_frequently_le  {α β} [conditionally_complete_linear_order β] {f : filter α}
   {u : α → β}  {b : β} (hu_le : ∃ᶠ x in f, u x ≤ b)
   (hu : f.is_bounded_under (≥) u . is_bounded_default) :
-  f.liminf u ≤ b :=
+  liminf u f ≤ b :=
 @le_limsup_of_frequently_le _ βᵒᵈ _ f u b hu_le hu
 
 lemma frequently_lt_of_lt_limsup {α β} [conditionally_complete_linear_order β] {f : filter α}
   {u : α → β}  {b : β}
-  (hu : f.is_cobounded_under (≤) u . is_bounded_default) (h : b < f.limsup u) :
+  (hu : f.is_cobounded_under (≤) u . is_bounded_default) (h : b < limsup u f) :
   ∃ᶠ x in f, b < u x :=
 begin
   contrapose! h,
@@ -499,10 +976,19 @@ end
 
 lemma frequently_lt_of_liminf_lt {α β} [conditionally_complete_linear_order β] {f : filter α}
   {u : α → β}  {b : β}
-  (hu : f.is_cobounded_under (≥) u . is_bounded_default) (h : f.liminf u < b) :
+  (hu : f.is_cobounded_under (≥) u . is_bounded_default) (h : liminf u f < b) :
   ∃ᶠ x in f, u x < b :=
 @frequently_lt_of_lt_limsup _ βᵒᵈ _ f u b hu h
 
+variables [conditionally_complete_linear_order α] {f : filter α} {b : α}
+
+lemma lt_mem_sets_of_Limsup_lt (h : f.is_bounded (≤)) (l : f.Limsup < b) : ∀ᶠ a in f, a < b :=
+let ⟨c, (h : ∀ᶠ a in f, a ≤ c), hcb⟩ := exists_lt_of_cInf_lt h l in
+mem_of_superset h $ λ a, hcb.trans_le'
+
+lemma gt_mem_sets_of_Liminf_gt : f.is_bounded (≥) → b < f.Liminf → ∀ᶠ a in f, b < a :=
+@lt_mem_sets_of_Limsup_lt αᵒᵈ _ _ _
+
 end conditionally_complete_linear_order
 
 end filter
@@ -510,12 +996,41 @@ end filter
 section order
 open filter
 
-lemma galois_connection.l_limsup_le {α β γ} [conditionally_complete_lattice β]
+lemma monotone.is_bounded_under_le_comp [nonempty β] [linear_order β] [preorder γ]
+  [no_max_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : monotone g)
+  (hg' : tendsto g at_top at_top) :
+  is_bounded_under (≤) l (g ∘ f) ↔ is_bounded_under (≤) l f :=
+begin
+  refine ⟨_, λ h, h.is_bounded_under hg⟩,
+  rintro ⟨c, hc⟩, rw eventually_map at hc,
+  obtain ⟨b, hb⟩ : ∃ b, ∀ a ≥ b, c < g a := eventually_at_top.1 (hg'.eventually_gt_at_top c),
+  exact ⟨b, hc.mono $ λ x hx, not_lt.1 (λ h, (hb _ h.le).not_le hx)⟩
+end
+
+lemma monotone.is_bounded_under_ge_comp [nonempty β] [linear_order β] [preorder γ]
+  [no_min_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : monotone g)
+  (hg' : tendsto g at_bot at_bot) :
+  is_bounded_under (≥) l (g ∘ f) ↔ is_bounded_under (≥) l f :=
+hg.dual.is_bounded_under_le_comp hg'
+
+lemma antitone.is_bounded_under_le_comp [nonempty β] [linear_order β] [preorder γ]
+  [no_max_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : antitone g)
+  (hg' : tendsto g at_bot at_top) :
+  is_bounded_under (≤) l (g ∘ f) ↔ is_bounded_under (≥) l f :=
+hg.dual_right.is_bounded_under_ge_comp hg'
+
+lemma antitone.is_bounded_under_ge_comp [nonempty β] [linear_order β] [preorder γ]
+  [no_min_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : antitone g)
+  (hg' : tendsto g at_top at_bot) :
+  is_bounded_under (≥) l (g ∘ f) ↔ is_bounded_under (≤) l f :=
+hg.dual_right.is_bounded_under_le_comp hg'
+
+lemma galois_connection.l_limsup_le [conditionally_complete_lattice β]
   [conditionally_complete_lattice γ] {f : filter α} {v : α → β}
   {l : β → γ} {u : γ → β} (gc : galois_connection l u)
   (hlv : f.is_bounded_under (≤) (λ x, l (v x)) . is_bounded_default)
   (hv_co : f.is_cobounded_under (≤) v . is_bounded_default) :
-  l (f.limsup v) ≤ f.limsup (λ x, l (v x)) :=
+  l (limsup v f) ≤ limsup (λ x, l (v x)) f :=
 begin
   refine le_Limsup_of_le hlv (λ c hc, _),
   rw filter.eventually_map at hc,
@@ -529,10 +1044,10 @@ lemma order_iso.limsup_apply {γ} [conditionally_complete_lattice β]
   (hu_co : f.is_cobounded_under (≤) u . is_bounded_default)
   (hgu : f.is_bounded_under (≤) (λ x, g (u x)) . is_bounded_default)
   (hgu_co : f.is_cobounded_under (≤) (λ x, g (u x)) . is_bounded_default) :
-  g (f.limsup u) = f.limsup (λ x, g (u x)) :=
+  g (limsup u f) = limsup (λ x, g (u x)) f :=
 begin
   refine le_antisymm (g.to_galois_connection.l_limsup_le hgu hu_co) _,
-  rw [←(g.symm.symm_apply_apply (f.limsup (λ (x : α), g (u x)))), g.symm_symm],
+  rw [←(g.symm.symm_apply_apply $ limsup (λ x, g (u x)) f), g.symm_symm],
   refine g.monotone _,
   have hf : u = λ i, g.symm (g (u i)), from funext (λ i, (g.symm_apply_apply (u i)).symm),
   nth_rewrite 0 hf,
@@ -547,7 +1062,7 @@ lemma order_iso.liminf_apply {γ} [conditionally_complete_lattice β]
   (hu_co : f.is_cobounded_under (≥) u . is_bounded_default)
   (hgu : f.is_bounded_under (≥) (λ x, g (u x)) . is_bounded_default)
   (hgu_co : f.is_cobounded_under (≥) (λ x, g (u x)) . is_bounded_default) :
-  g (f.liminf u) = f.liminf (λ x, g (u x)) :=
+  g (liminf u f) = liminf (λ x, g (u x)) f :=
 @order_iso.limsup_apply α βᵒᵈ γᵒᵈ _ _ f u g.dual hu hu_co hgu hgu_co
 
 end order
diff --git a/src/order/locally_finite.lean b/src/order/locally_finite.lean
index 54634155c3da1..f6194e68b8b81 100644
--- a/src/order/locally_finite.lean
+++ b/src/order/locally_finite.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import data.finset.preimage
+import data.set.intervals.unordered_interval
 
 /-!
 # Locally finite orders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines locally finite orders.
 
 A locally finite order is an order for which all bounded intervals are finite. This allows to make
@@ -29,18 +33,19 @@ In a `locally_finite_order`,
 * `finset.Ico`: Closed-open interval as a finset.
 * `finset.Ioc`: Open-closed interval as a finset.
 * `finset.Ioo`: Open-open interval as a finset.
+* `finset.uIcc`: Unordered closed interval as a finset.
 * `multiset.Icc`: Closed-closed interval as a multiset.
 * `multiset.Ico`: Closed-open interval as a multiset.
 * `multiset.Ioc`: Open-closed interval as a multiset.
 * `multiset.Ioo`: Open-open interval as a multiset.
 
-When it's also an `order_top`,
+In a `locally_finite_order_top`,
 * `finset.Ici`: Closed-infinite interval as a finset.
 * `finset.Ioi`: Open-infinite interval as a finset.
 * `multiset.Ici`: Closed-infinite interval as a multiset.
 * `multiset.Ioi`: Open-infinite interval as a multiset.
 
-When it's also an `order_bot`,
+In a `locally_finite_order_bot`,
 * `finset.Iic`: Infinite-open interval as a finset.
 * `finset.Iio`: Infinite-closed interval as a finset.
 * `multiset.Iic`: Infinite-open interval as a multiset.
@@ -51,7 +56,7 @@ When it's also an `order_bot`,
 A `locally_finite_order` instance can be built
 * for a subtype of a locally finite order. See `subtype.locally_finite_order`.
 * for the product of two locally finite orders. See `prod.locally_finite_order`.
-* for any fintype (but it is noncomputable). See `fintype.to_locally_finite_order`.
+* for any fintype (but not as an instance). See `fintype.to_locally_finite_order`.
 * from a definition of `finset.Icc` alone. See `locally_finite_order.of_Icc`.
 * by pulling back `locally_finite_order β` through an order embedding `f : α →o β`. See
   `order_embedding.locally_finite_order`.
@@ -115,6 +120,22 @@ class locally_finite_order (α : Type*) [preorder α] :=
 (finset_mem_Ioc : ∀ a b x : α, x ∈ finset_Ioc a b ↔ a < x ∧ x ≤ b)
 (finset_mem_Ioo : ∀ a b x : α, x ∈ finset_Ioo a b ↔ a < x ∧ x < b)
 
+/-- A locally finite order top is an order where all intervals bounded above are finite. This is
+slightly weaker than `locally_finite_order` + `order_top` as it allows empty types. -/
+class locally_finite_order_top (α : Type*) [preorder α] :=
+(finset_Ioi : α → finset α)
+(finset_Ici : α → finset α)
+(finset_mem_Ici : ∀ a x : α, x ∈ finset_Ici a ↔ a ≤ x)
+(finset_mem_Ioi : ∀ a x : α, x ∈ finset_Ioi a ↔ a < x)
+
+/-- A locally finite order bot is an order where all intervals bounded below are finite. This is
+slightly weaker than `locally_finite_order` + `order_bot` as it allows empty types. -/
+class locally_finite_order_bot (α : Type*) [preorder α] :=
+(finset_Iio : α → finset α)
+(finset_Iic : α → finset α)
+(finset_mem_Iic : ∀ a x : α, x ∈ finset_Iic a ↔ x ≤ a)
+(finset_mem_Iio : ∀ a x : α, x ∈ finset_Iio a ↔ x < a)
+
 /-- A constructor from a definition of `finset.Icc` alone, the other ones being derived by removing
 the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
 only `preorder`. -/
@@ -147,13 +168,97 @@ def locally_finite_order.of_Icc (α : Type*) [partial_order α] [decidable_eq α
   finset_mem_Ioo := λ a b x, by rw [finset.mem_filter, mem_Icc, and_and_and_comm, lt_iff_le_and_ne,
     lt_iff_le_and_ne] }
 
+/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
+the ends. As opposed to `locally_finite_order_top.of_Ici`, this one requires `decidable_rel (≤)` but
+only `preorder`. -/
+def locally_finite_order_top.of_Ici' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
+  (finset_Ici : α → finset α) (mem_Ici : ∀ a x, x ∈ finset_Ici a ↔ a ≤ x) :
+  locally_finite_order_top α :=
+{ finset_Ici := finset_Ici,
+  finset_Ioi := λ a, (finset_Ici a).filter (λ x, ¬x ≤ a),
+  finset_mem_Ici := mem_Ici,
+  finset_mem_Ioi := λ a x, by rw [mem_filter, mem_Ici, lt_iff_le_not_le] }
+
+/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
+the ends. As opposed to `locally_finite_order_top.of_Ici'`, this one requires `partial_order` but
+only `decidable_eq`. -/
+def locally_finite_order_top.of_Ici (α : Type*) [partial_order α] [decidable_eq α]
+  (finset_Ici : α → finset α) (mem_Ici : ∀ a x, x ∈ finset_Ici a ↔ a ≤ x) :
+  locally_finite_order_top α :=
+{ finset_Ici := finset_Ici,
+  finset_Ioi := λ a, (finset_Ici a).filter (λ x, a ≠ x),
+  finset_mem_Ici := mem_Ici,
+  finset_mem_Ioi := λ a x, by rw [mem_filter, mem_Ici, lt_iff_le_and_ne] }
+
+/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
+the ends. As opposed to `locally_finite_order.of_Icc`, this one requires `decidable_rel (≤)` but
+only `preorder`. -/
+def locally_finite_order_bot.of_Iic' (α : Type*) [preorder α] [decidable_rel ((≤) : α → α → Prop)]
+  (finset_Iic : α → finset α) (mem_Iic : ∀ a x, x ∈ finset_Iic a ↔ x ≤ a) :
+  locally_finite_order_bot α :=
+{ finset_Iic := finset_Iic,
+  finset_Iio := λ a, (finset_Iic a).filter (λ x, ¬a ≤ x),
+  finset_mem_Iic := mem_Iic,
+  finset_mem_Iio := λ a x, by rw [mem_filter, mem_Iic, lt_iff_le_not_le] }
+
+/-- A constructor from a definition of `finset.Iic` alone, the other ones being derived by removing
+the ends. As opposed to `locally_finite_order_top.of_Ici'`, this one requires `partial_order` but
+only `decidable_eq`. -/
+def locally_finite_order_top.of_Iic (α : Type*) [partial_order α] [decidable_eq α]
+  (finset_Iic : α → finset α) (mem_Iic : ∀ a x, x ∈ finset_Iic a ↔ x ≤ a) :
+  locally_finite_order_bot α :=
+{ finset_Iic := finset_Iic,
+  finset_Iio := λ a, (finset_Iic a).filter (λ x, x ≠ a),
+  finset_mem_Iic := mem_Iic,
+  finset_mem_Iio := λ a x, by rw [mem_filter, mem_Iic, lt_iff_le_and_ne] }
+
 variables {α β : Type*}
 
+/-- An empty type is locally finite.
+
+This is not an instance as it would not be defeq to more specific instances. -/
+@[reducible] -- See note [reducible non-instances]
+protected def _root_.is_empty.to_locally_finite_order [preorder α] [is_empty α] :
+  locally_finite_order α :=
+{ finset_Icc := is_empty_elim,
+  finset_Ico := is_empty_elim,
+  finset_Ioc := is_empty_elim,
+  finset_Ioo := is_empty_elim,
+  finset_mem_Icc := is_empty_elim,
+  finset_mem_Ico := is_empty_elim,
+  finset_mem_Ioc := is_empty_elim,
+  finset_mem_Ioo := is_empty_elim }
+
+/-- An empty type is locally finite.
+
+This is not an instance as it would not be defeq to more specific instances. -/
+@[reducible] -- See note [reducible non-instances]
+protected def _root_.is_empty.to_locally_finite_order_top [preorder α] [is_empty α] :
+  locally_finite_order_top α :=
+{ finset_Ici := is_empty_elim,
+  finset_Ioi := is_empty_elim,
+  finset_mem_Ici := is_empty_elim,
+  finset_mem_Ioi := is_empty_elim }
+
+/-- An empty type is locally finite.
+
+This is not an instance as it would not be defeq to more specific instances. -/
+@[reducible] -- See note [reducible non-instances]
+protected def _root_.is_empty.to_locally_finite_order_bot [preorder α] [is_empty α] :
+  locally_finite_order_bot α :=
+{ finset_Iic := is_empty_elim,
+  finset_Iio := is_empty_elim,
+  finset_mem_Iic := is_empty_elim,
+  finset_mem_Iio := is_empty_elim }
+
 /-! ### Intervals as finsets -/
 
 namespace finset
 section preorder
-variables [preorder α] [locally_finite_order α] {a b x : α}
+variables [preorder α]
+
+section locally_finite_order
+variables [locally_finite_order α] {a b x : α}
 
 /-- The finset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a finset.
 -/
@@ -195,60 +300,98 @@ lemma coe_Ioc (a b : α) : (Ioc a b : set α) = set.Ioc a b := set.ext $ λ _, m
 @[simp, norm_cast]
 lemma coe_Ioo (a b : α) : (Ioo a b : set α) = set.Ioo a b := set.ext $ λ _, mem_Ioo
 
-end preorder
+end locally_finite_order
 
-section order_top
-variables [preorder α] [order_top α] [locally_finite_order α] {a x : α}
+section locally_finite_order_top
+variables [locally_finite_order_top α] {a x : α}
 
 /-- The finset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a finset. -/
-def Ici (a : α) : finset α := Icc a ⊤
+def Ici (a : α) : finset α := locally_finite_order_top.finset_Ici a
 
 /-- The finset of elements `x` such that `a < x`. Basically `set.Ioi a` as a finset. -/
-def Ioi (a : α) : finset α := Ioc a ⊤
+def Ioi (a : α) : finset α := locally_finite_order_top.finset_Ioi a
 
-lemma Ici_eq_Icc (a : α) : Ici a = Icc a ⊤ := rfl
-lemma Ioi_eq_Ioc (a : α) : Ioi a = Ioc a ⊤ := rfl
+@[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := locally_finite_order_top.finset_mem_Ici _ _
+@[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := locally_finite_order_top.finset_mem_Ioi _ _
 
-@[simp, norm_cast] lemma coe_Ici (a : α) : (Ici a : set α) = set.Ici a :=
-by rw [Ici, coe_Icc, set.Icc_top]
+@[simp, norm_cast] lemma coe_Ici (a : α) : (Ici a : set α) = set.Ici a := set.ext $ λ _, mem_Ici
+@[simp, norm_cast] lemma coe_Ioi (a : α) : (Ioi a : set α) = set.Ioi a := set.ext $ λ _, mem_Ioi
 
-@[simp, norm_cast] lemma coe_Ioi (a : α) : (Ioi a : set α) = set.Ioi a :=
-by rw [Ioi, coe_Ioc, set.Ioc_top]
+end locally_finite_order_top
 
-@[simp] lemma mem_Ici : x ∈ Ici a ↔ a ≤ x := by rw [←set.mem_Ici, ←coe_Ici, mem_coe]
-@[simp] lemma mem_Ioi : x ∈ Ioi a ↔ a < x := by rw [←set.mem_Ioi, ←coe_Ioi, mem_coe]
+section locally_finite_order_bot
+variables [locally_finite_order_bot α] {a x : α}
+
+/-- The finset of elements `x` such that `a ≤ x`. Basically `set.Iic a` as a finset. -/
+def Iic (a : α) : finset α := locally_finite_order_bot.finset_Iic a
+
+/-- The finset of elements `x` such that `a < x`. Basically `set.Iio a` as a finset. -/
+def Iio (a : α) : finset α := locally_finite_order_bot.finset_Iio a
+
+@[simp] lemma mem_Iic : x ∈ Iic a ↔ x ≤ a := locally_finite_order_bot.finset_mem_Iic _ _
+@[simp] lemma mem_Iio : x ∈ Iio a ↔ x < a := locally_finite_order_bot.finset_mem_Iio _ _
+
+@[simp, norm_cast] lemma coe_Iic (a : α) : (Iic a : set α) = set.Iic a := set.ext $ λ _, mem_Iic
+@[simp, norm_cast] lemma coe_Iio (a : α) : (Iio a : set α) = set.Iio a := set.ext $ λ _, mem_Iio
+
+end locally_finite_order_bot
+
+section order_top
+variables [locally_finite_order α] [order_top α] {a x : α}
+
+@[priority 100] -- See note [lower priority instance]
+instance _root_.locally_finite_order.to_locally_finite_order_top : locally_finite_order_top α :=
+{ finset_Ici := λ b, Icc b ⊤,
+  finset_Ioi := λ b, Ioc b ⊤,
+  finset_mem_Ici := λ a x, by rw [mem_Icc, and_iff_left le_top],
+  finset_mem_Ioi := λ a x, by rw [mem_Ioc, and_iff_left le_top] }
+
+lemma Ici_eq_Icc (a : α) : Ici a = Icc a ⊤ := rfl
+lemma Ioi_eq_Ioc (a : α) : Ioi a = Ioc a ⊤ := rfl
 
 end order_top
 
 section order_bot
-variables [preorder α] [order_bot α] [locally_finite_order α] {b x : α}
+variables [order_bot α] [locally_finite_order α] {b x : α}
 
-/-- The finset of elements `x` such that `x ≤ b`. Basically `set.Iic b` as a finset. -/
-def Iic (b : α) : finset α := Icc ⊥ b
-
-/-- The finset of elements `x` such that `x < b`. Basically `set.Iio b` as a finset. -/
-def Iio (b : α) : finset α := Ico ⊥ b
+@[priority 100] -- See note [lower priority instance]
+instance locally_finite_order.to_locally_finite_order_bot : locally_finite_order_bot α :=
+{ finset_Iic := Icc ⊥,
+  finset_Iio := Ico ⊥,
+  finset_mem_Iic := λ a x, by rw [mem_Icc, and_iff_right bot_le],
+  finset_mem_Iio := λ a x, by rw [mem_Ico, and_iff_right bot_le] }
 
 lemma Iic_eq_Icc : Iic = Icc (⊥ : α) := rfl
 lemma Iio_eq_Ico : Iio = Ico (⊥ : α) := rfl
 
-@[simp, norm_cast] lemma coe_Iic (b : α) : (Iic b : set α) = set.Iic b :=
-by rw [Iic, coe_Icc, set.Icc_bot]
+end order_bot
+end preorder
+
+section lattice
+variables [lattice α] [locally_finite_order α] {a b x : α}
 
-@[simp, norm_cast] lemma coe_Iio (b : α) : (Iio b : set α) = set.Iio b :=
-by rw [Iio, coe_Ico, set.Ico_bot]
+/-- `finset.uIcc a b` is the set of elements lying between `a` and `b`, with `a` and `b` included.
+Note that we define it more generally in a lattice as `finset.Icc (a ⊓ b) (a ⊔ b)`. In a
+product type, `finset.uIcc` corresponds to the bounding box of the two elements. -/
+def uIcc (a b : α) : finset α := Icc (a ⊓ b) (a ⊔ b)
 
-@[simp] lemma mem_Iic : x ∈ Iic b ↔ x ≤ b := by rw [←set.mem_Iic, ←coe_Iic, mem_coe]
-@[simp] lemma mem_Iio : x ∈ Iio b ↔ x < b := by rw [←set.mem_Iio, ←coe_Iio, mem_coe]
+localized "notation (name := finset.uIcc) `[`a `, ` b `]` := finset.uIcc a b"
+  in finset_interval
 
-end order_bot
+@[simp] lemma mem_uIcc : x ∈ uIcc a b ↔ a ⊓ b ≤ x ∧ x ≤ a ⊔ b := mem_Icc
+
+@[simp, norm_cast] lemma coe_uIcc (a b : α) : ([a, b] : set α) = set.uIcc a b := coe_Icc _ _
+
+end lattice
 end finset
 
 /-! ### Intervals as multisets -/
 
 namespace multiset
-section preorder
-variables [preorder α] [locally_finite_order α]
+variables [preorder α]
+
+section locally_finite_order
+variables [locally_finite_order α]
 
 /-- The multiset of elements `x` such that `a ≤ x` and `x ≤ b`. Basically `set.Icc a b` as a
 multiset. -/
@@ -278,10 +421,10 @@ by rw [Ioc, ←finset.mem_def, finset.mem_Ioc]
 @[simp] lemma mem_Ioo {a b x : α} : x ∈ Ioo a b ↔ a < x ∧ x < b :=
 by rw [Ioo, ←finset.mem_def, finset.mem_Ioo]
 
-end preorder
+end locally_finite_order
 
-section order_top
-variables [preorder α] [order_top α] [locally_finite_order α]
+section locally_finite_order_top
+variables [locally_finite_order_top α]
 
 /-- The multiset of elements `x` such that `a ≤ x`. Basically `set.Ici a` as a multiset. -/
 def Ici (a : α) : multiset α := (finset.Ici a).val
@@ -292,10 +435,10 @@ def Ioi (a : α) : multiset α := (finset.Ioi a).val
 @[simp] lemma mem_Ici {a x : α} : x ∈ Ici a ↔ a ≤ x := by rw [Ici, ←finset.mem_def, finset.mem_Ici]
 @[simp] lemma mem_Ioi {a x : α} : x ∈ Ioi a ↔ a < x := by rw [Ioi, ←finset.mem_def, finset.mem_Ioi]
 
-end order_top
+end locally_finite_order_top
 
-section order_bot
-variables [preorder α] [order_bot α] [locally_finite_order α]
+section locally_finite_order_bot
+variables [locally_finite_order_bot α]
 
 /-- The multiset of elements `x` such that `x ≤ b`. Basically `set.Iic b` as a multiset. -/
 def Iic (b : α) : multiset α := (finset.Iic b).val
@@ -306,7 +449,7 @@ def Iio (b : α) : multiset α := (finset.Iio b).val
 @[simp] lemma mem_Iic {b x : α} : x ∈ Iic b ↔ x ≤ b := by rw [Iic, ←finset.mem_def, finset.mem_Iic]
 @[simp] lemma mem_Iio {b x : α} : x ∈ Iio b ↔ x < b := by rw [Iio, ←finset.mem_def, finset.mem_Iio]
 
-end order_bot
+end locally_finite_order_bot
 end multiset
 
 /-! ### Finiteness of `set` intervals -/
@@ -315,53 +458,49 @@ namespace set
 section preorder
 variables [preorder α] [locally_finite_order α] (a b : α)
 
-instance fintype_Icc : fintype (Icc a b) :=
-fintype.of_finset (finset.Icc a b) (λ x, by rw [finset.mem_Icc, mem_Icc])
-
-instance fintype_Ico : fintype (Ico a b) :=
-fintype.of_finset (finset.Ico a b) (λ x, by rw [finset.mem_Ico, mem_Ico])
-
-instance fintype_Ioc : fintype (Ioc a b) :=
-fintype.of_finset (finset.Ioc a b) (λ x, by rw [finset.mem_Ioc, mem_Ioc])
-
-instance fintype_Ioo : fintype (Ioo a b) :=
-fintype.of_finset (finset.Ioo a b) (λ x, by rw [finset.mem_Ioo, mem_Ioo])
+instance fintype_Icc : fintype (Icc a b) := fintype.of_finset (finset.Icc a b) $ λ x, finset.mem_Icc
+instance fintype_Ico : fintype (Ico a b) := fintype.of_finset (finset.Ico a b) $ λ x, finset.mem_Ico
+instance fintype_Ioc : fintype (Ioc a b) := fintype.of_finset (finset.Ioc a b) $ λ x, finset.mem_Ioc
+instance fintype_Ioo : fintype (Ioo a b) := fintype.of_finset (finset.Ioo a b) $ λ x, finset.mem_Ioo
 
-lemma finite_Icc : (Icc a b).finite := ⟨set.fintype_Icc a b⟩
-lemma finite_Ico : (Ico a b).finite := ⟨set.fintype_Ico a b⟩
-lemma finite_Ioc : (Ioc a b).finite := ⟨set.fintype_Ioc a b⟩
-lemma finite_Ioo : (Ioo a b).finite := ⟨set.fintype_Ioo a b⟩
+lemma finite_Icc : (Icc a b).finite := (Icc a b).to_finite
+lemma finite_Ico : (Ico a b).finite := (Ico a b).to_finite
+lemma finite_Ioc : (Ioc a b).finite := (Ioc a b).to_finite
+lemma finite_Ioo : (Ioo a b).finite := (Ioo a b).to_finite
 
 end preorder
 
 section order_top
-variables [preorder α] [order_top α] [locally_finite_order α] (a : α)
+variables [preorder α] [locally_finite_order_top α] (a : α)
 
-instance fintype_Ici : fintype (Ici a) :=
-fintype.of_finset (finset.Ici a) (λ x, by rw [finset.mem_Ici, mem_Ici])
+instance fintype_Ici : fintype (Ici a) := fintype.of_finset (finset.Ici a) $ λ x, finset.mem_Ici
+instance fintype_Ioi : fintype (Ioi a) := fintype.of_finset (finset.Ioi a) $ λ x, finset.mem_Ioi
 
-instance fintype_Ioi : fintype (Ioi a) :=
-fintype.of_finset (finset.Ioi a) (λ x, by rw [finset.mem_Ioi, mem_Ioi])
-
-lemma finite_Ici : (Ici a).finite := ⟨set.fintype_Ici a⟩
-lemma finite_Ioi : (Ioi a).finite := ⟨set.fintype_Ioi a⟩
+lemma finite_Ici : (Ici a).finite := (Ici a).to_finite
+lemma finite_Ioi : (Ioi a).finite := (Ioi a).to_finite
 
 end order_top
 
 section order_bot
-variables [preorder α] [order_bot α] [locally_finite_order α] (b : α)
-
-instance fintype_Iic : fintype (Iic b) :=
-fintype.of_finset (finset.Iic b) (λ x, by rw [finset.mem_Iic, mem_Iic])
+variables [preorder α] [locally_finite_order_bot α] (b : α)
 
-instance fintype_Iio : fintype (Iio b) :=
-fintype.of_finset (finset.Iio b) (λ x, by rw [finset.mem_Iio, mem_Iio])
+instance fintype_Iic : fintype (Iic b) := fintype.of_finset (finset.Iic b) $ λ x, finset.mem_Iic
+instance fintype_Iio : fintype (Iio b) := fintype.of_finset (finset.Iio b) $ λ x, finset.mem_Iio
 
-lemma finite_Iic : (Iic b).finite := ⟨set.fintype_Iic b⟩
-lemma finite_Iio : (Iio b).finite := ⟨set.fintype_Iio b⟩
+lemma finite_Iic : (Iic b).finite := (Iic b).to_finite
+lemma finite_Iio : (Iio b).finite := (Iio b).to_finite
 
 end order_bot
 
+section lattice
+variables [lattice α] [locally_finite_order α] (a b : α)
+
+instance fintype_uIcc : fintype (uIcc a b) :=
+fintype.of_finset (finset.uIcc a b) $ λ x, finset.mem_uIcc
+
+@[simp] lemma finite_interval : (uIcc a b).finite := (uIcc _ _).to_finite
+
+end lattice
 end set
 
 /-! ### Instances -/
@@ -369,7 +508,7 @@ end set
 open finset
 
 section preorder
-variables [preorder α]
+variables [preorder α] [preorder β]
 
 /-- A noncomputable constructor from the finiteness of all closed intervals. -/
 noncomputable def locally_finite_order.of_finite_Icc (h : ∀ a b : α, (set.Icc a b).finite) :
@@ -378,16 +517,22 @@ noncomputable def locally_finite_order.of_finite_Icc (h : ∀ a b : α, (set.Icc
   (λ a b, (h a b).to_finset)
   (λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc])
 
-/-- A fintype is noncomputably a locally finite order. -/
-noncomputable def fintype.to_locally_finite_order [fintype α] : locally_finite_order α :=
-{ finset_Icc := λ a b, (set.finite.of_fintype (set.Icc a b)).to_finset,
-  finset_Ico := λ a b, (set.finite.of_fintype (set.Ico a b)).to_finset,
-  finset_Ioc := λ a b, (set.finite.of_fintype (set.Ioc a b)).to_finset,
-  finset_Ioo := λ a b, (set.finite.of_fintype (set.Ioo a b)).to_finset,
-  finset_mem_Icc := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Icc],
-  finset_mem_Ico := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ico],
-  finset_mem_Ioc := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ioc],
-  finset_mem_Ioo := λ a b x, by rw [set.finite.mem_to_finset, set.mem_Ioo] }
+/-- A fintype is a locally finite order.
+
+This is not an instance as it would not be defeq to better instances such as
+`fin.locally_finite_order`.
+-/
+@[reducible]
+def fintype.to_locally_finite_order [fintype α] [@decidable_rel α (<)] [@decidable_rel α (≤)] :
+  locally_finite_order α :=
+{ finset_Icc := λ a b, (set.Icc a b).to_finset,
+  finset_Ico := λ a b, (set.Ico a b).to_finset,
+  finset_Ioc := λ a b, (set.Ioc a b).to_finset,
+  finset_Ioo := λ a b, (set.Ioo a b).to_finset,
+  finset_mem_Icc := λ a b x, by simp only [set.mem_to_finset, set.mem_Icc],
+  finset_mem_Ico := λ a b x, by simp only [set.mem_to_finset, set.mem_Ico],
+  finset_mem_Ioc := λ a b x, by simp only [set.mem_to_finset, set.mem_Ioc],
+  finset_mem_Ioo := λ a b x, by simp only [set.mem_to_finset, set.mem_Ioo] }
 
 instance : subsingleton (locally_finite_order α) :=
 subsingleton.intro (λ h₀ h₁, begin
@@ -404,11 +549,32 @@ subsingleton.intro (λ h₀ h₁, begin
   simp_rw [hIcc, hIco, hIoc, hIoo],
 end)
 
-variables [preorder β] [locally_finite_order β]
+instance : subsingleton (locally_finite_order_top α) :=
+subsingleton.intro $ λ h₀ h₁, begin
+  cases h₀,
+  cases h₁,
+  have hIci : h₀_finset_Ici = h₁_finset_Ici,
+  { ext a b x, rw [h₀_finset_mem_Ici, h₁_finset_mem_Ici] },
+  have hIoi : h₀_finset_Ioi = h₁_finset_Ioi,
+  { ext a b x, rw [h₀_finset_mem_Ioi, h₁_finset_mem_Ioi] },
+  simp_rw [hIci, hIoi],
+end
+
+instance : subsingleton (locally_finite_order_bot α) :=
+subsingleton.intro $ λ h₀ h₁, begin
+  cases h₀,
+  cases h₁,
+  have hIic : h₀_finset_Iic = h₁_finset_Iic,
+  { ext a b x, rw [h₀_finset_mem_Iic, h₁_finset_mem_Iic] },
+  have hIio : h₀_finset_Iio = h₁_finset_Iio,
+  { ext a b x, rw [h₀_finset_mem_Iio, h₁_finset_mem_Iio] },
+  simp_rw [hIic, hIio],
+end
 
 -- Should this be called `locally_finite_order.lift`?
 /-- Given an order embedding `α ↪o β`, pulls back the `locally_finite_order` on `β` to `α`. -/
-noncomputable def order_embedding.locally_finite_order (f : α ↪o β) : locally_finite_order α :=
+protected noncomputable def order_embedding.locally_finite_order [locally_finite_order β]
+  (f : α ↪o β) : locally_finite_order α :=
 { finset_Icc := λ a b, (Icc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
   finset_Ico := λ a b, (Ico (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
   finset_Ioc := λ a b, (Ioc (f a) (f b)).preimage f (f.to_embedding.injective.inj_on _),
@@ -420,6 +586,7 @@ noncomputable def order_embedding.locally_finite_order (f : α ↪o β) : locall
 
 open order_dual
 
+section locally_finite_order
 variables [locally_finite_order α] (a b : α)
 
 /-- Note we define `Icc (to_dual a) (to_dual b)` as `Icc α _ _ b a` (which has type `finset α` not
@@ -440,44 +607,131 @@ instance : locally_finite_order αᵒᵈ :=
   finset_mem_Ioo := λ a b x, mem_Ioo.trans (and_comm _ _) }
 
 lemma Icc_to_dual : Icc (to_dual a) (to_dual b) = (Icc b a).map to_dual.to_embedding :=
-begin
-  refine eq.trans _ map_refl.symm,
-  ext c,
-  rw [mem_Icc, mem_Icc],
-  exact and_comm _ _,
-end
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Icc, mem_Icc], exact and_comm _ _ }
 
 lemma Ico_to_dual : Ico (to_dual a) (to_dual b) = (Ioc b a).map to_dual.to_embedding :=
-begin
-  refine eq.trans _ map_refl.symm,
-  ext c,
-  rw [mem_Ico, mem_Ioc],
-  exact and_comm _ _,
-end
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ico, mem_Ioc], exact and_comm _ _ }
 
 lemma Ioc_to_dual : Ioc (to_dual a) (to_dual b) = (Ico b a).map to_dual.to_embedding :=
-begin
-  refine eq.trans _ map_refl.symm,
-  ext c,
-  rw [mem_Ioc, mem_Ico],
-  exact and_comm _ _,
-end
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioc, mem_Ico], exact and_comm _ _ }
 
 lemma Ioo_to_dual : Ioo (to_dual a) (to_dual b) = (Ioo b a).map to_dual.to_embedding :=
-begin
-  refine eq.trans _ map_refl.symm,
-  ext c,
-  rw [mem_Ioo, mem_Ioo],
-  exact and_comm _ _,
-end
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioo, mem_Ioo], exact and_comm _ _ }
+
+lemma Icc_of_dual (a b : αᵒᵈ) : Icc (of_dual a) (of_dual b) = (Icc b a).map of_dual.to_embedding :=
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Icc, mem_Icc], exact and_comm _ _ }
+
+lemma Ico_of_dual (a b : αᵒᵈ) : Ico (of_dual a) (of_dual b) = (Ioc b a).map of_dual.to_embedding :=
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ico, mem_Ioc], exact and_comm _ _ }
+
+lemma Ioc_of_dual (a b : αᵒᵈ) : Ioc (of_dual a) (of_dual b) = (Ico b a).map of_dual.to_embedding :=
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioc, mem_Ico], exact and_comm _ _ }
+
+lemma Ioo_of_dual (a b : αᵒᵈ) : Ioo (of_dual a) (of_dual b) = (Ioo b a).map of_dual.to_embedding :=
+by { refine eq.trans _ map_refl.symm, ext c, rw [mem_Ioo, mem_Ioo], exact and_comm _ _ }
+
+end locally_finite_order
+
+section locally_finite_order_top
+variables [locally_finite_order_top α]
+
+/-- Note we define `Iic (to_dual a)` as `Ici a` (which has type `finset α` not `finset αᵒᵈ`!)
+instead of `(Ici a).map to_dual.to_embedding` as this means the following is defeq:
+```
+lemma this : (Iic (to_dual (to_dual a)) : _) = (Iic a : _) := rfl
+```
+-/
+instance : locally_finite_order_bot αᵒᵈ :=
+{ finset_Iic := λ a, @Ici α _ _ (of_dual a),
+  finset_Iio := λ a, @Ioi α _ _ (of_dual a),
+  finset_mem_Iic := λ a x, mem_Ici,
+  finset_mem_Iio := λ a x, mem_Ioi }
+
+lemma Iic_to_dual (a : α) : Iic (to_dual a) = (Ici a).map to_dual.to_embedding := map_refl.symm
+lemma Iio_to_dual (a : α) : Iio (to_dual a) = (Ioi a).map to_dual.to_embedding := map_refl.symm
+lemma Ici_of_dual (a : αᵒᵈ) : Ici (of_dual a) = (Iic a).map of_dual.to_embedding := map_refl.symm
+lemma Ioi_of_dual (a : αᵒᵈ) : Ioi (of_dual a) = (Iio a).map of_dual.to_embedding := map_refl.symm
+
+end locally_finite_order_top
+
+section locally_finite_order_top
+variables [locally_finite_order_bot α]
+
+/-- Note we define `Ici (to_dual a)` as `Iic a` (which has type `finset α` not `finset αᵒᵈ`!)
+instead of `(Iic a).map to_dual.to_embedding` as this means the following is defeq:
+```
+lemma this : (Ici (to_dual (to_dual a)) : _) = (Ici a : _) := rfl
+```
+-/
+instance : locally_finite_order_top αᵒᵈ :=
+{ finset_Ici := λ a, @Iic α _ _ (of_dual a),
+  finset_Ioi := λ a, @Iio α _ _ (of_dual a),
+  finset_mem_Ici := λ a x, mem_Iic,
+  finset_mem_Ioi := λ a x, mem_Iio }
+
+lemma Ici_to_dual (a : α) : Ici (to_dual a) = (Iic a).map to_dual.to_embedding := map_refl.symm
+lemma Ioi_to_dual (a : α) : Ioi (to_dual a) = (Iio a).map to_dual.to_embedding := map_refl.symm
+lemma Iic_of_dual (a : αᵒᵈ) : Iic (of_dual a) = (Ici a).map of_dual.to_embedding := map_refl.symm
+lemma Iio_of_dual (a : αᵒᵈ) : Iio (of_dual a) = (Ioi a).map of_dual.to_embedding := map_refl.symm
+
+end locally_finite_order_top
 
-instance [decidable_rel ((≤) : α × β → α × β → Prop)] : locally_finite_order (α × β) :=
+namespace prod
+
+instance [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] :
+  locally_finite_order (α × β) :=
 locally_finite_order.of_Icc' (α × β)
-  (λ a b, (Icc a.fst b.fst).product (Icc a.snd b.snd))
+  (λ a b, Icc a.fst b.fst ×ˢ Icc a.snd b.snd)
   (λ a b x, by { rw [mem_product, mem_Icc, mem_Icc, and_and_and_comm], refl })
 
+instance [locally_finite_order_top α] [locally_finite_order_top β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] :
+  locally_finite_order_top (α × β) :=
+locally_finite_order_top.of_Ici' (α × β)
+  (λ a, Ici a.fst ×ˢ Ici a.snd) (λ a x, by { rw [mem_product, mem_Ici, mem_Ici], refl })
+
+instance [locally_finite_order_bot α] [locally_finite_order_bot β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] :
+  locally_finite_order_bot (α × β) :=
+locally_finite_order_bot.of_Iic' (α × β)
+  (λ a, Iic a.fst ×ˢ Iic a.snd) (λ a x, by { rw [mem_product, mem_Iic, mem_Iic], refl })
+
+lemma Icc_eq [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
+  finset.Icc p q = finset.Icc p.1 q.1 ×ˢ finset.Icc p.2 q.2 := rfl
+
+@[simp] lemma Icc_mk_mk [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] (a₁ a₂ : α) (b₁ b₂ : β) :
+  finset.Icc (a₁, b₁) (a₂, b₂) = finset.Icc a₁ a₂ ×ˢ finset.Icc b₁ b₂ := rfl
+
+lemma card_Icc [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
+  (finset.Icc p q).card = (finset.Icc p.1 q.1).card * (finset.Icc p.2 q.2).card :=
+finset.card_product _ _
+
+end prod
+
 end preorder
 
+namespace prod
+variables [lattice α] [lattice β]
+
+lemma uIcc_eq [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
+  finset.uIcc p q = finset.uIcc p.1 q.1 ×ˢ finset.uIcc p.2 q.2 := rfl
+
+@[simp] lemma uIcc_mk_mk [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] (a₁ a₂ : α) (b₁ b₂ : β) :
+  finset.uIcc (a₁, b₁) (a₂, b₂) = finset.uIcc a₁ a₂ ×ˢ finset.uIcc b₁ b₂ := rfl
+
+lemma card_uIcc [locally_finite_order α] [locally_finite_order β]
+  [decidable_rel ((≤) : α × β → α × β → Prop)] (p q : α × β) :
+  (finset.uIcc p q).card = (finset.uIcc p.1 q.1).card * (finset.uIcc p.2 q.2).card :=
+prod.card_Icc _ _
+
+end prod
+
 /-!
 #### `with_top`, `with_bot`
 
@@ -585,11 +839,48 @@ lemma Ioo_coe_coe : Ioo (a : with_bot α) b = (Ioo a b).map embedding.coe_option
 
 end with_bot
 
+namespace order_iso
+variables [preorder α] [preorder β]
+
+/-! #### Transfer locally finite orders across order isomorphisms -/
+
+/-- Transfer `locally_finite_order` across an `order_iso`. -/
+@[reducible] -- See note [reducible non-instances]
+def locally_finite_order [locally_finite_order β] (f : α ≃o β) : locally_finite_order α :=
+{ finset_Icc := λ a b, (Icc (f a) (f b)).map f.symm.to_equiv.to_embedding,
+  finset_Ico := λ a b, (Ico (f a) (f b)).map f.symm.to_equiv.to_embedding,
+  finset_Ioc := λ a b, (Ioc (f a) (f b)).map f.symm.to_equiv.to_embedding,
+  finset_Ioo := λ a b, (Ioo (f a) (f b)).map f.symm.to_equiv.to_embedding,
+  finset_mem_Icc := by simp,
+  finset_mem_Ico := by simp,
+  finset_mem_Ioc := by simp,
+  finset_mem_Ioo := by simp }
+
+/-- Transfer `locally_finite_order_top` across an `order_iso`. -/
+@[reducible] -- See note [reducible non-instances]
+def locally_finite_order_top [locally_finite_order_top β]
+  (f : α ≃o β) : locally_finite_order_top α :=
+{ finset_Ici := λ a, (Ici (f a)).map f.symm.to_equiv.to_embedding,
+  finset_Ioi := λ a, (Ioi (f a)).map f.symm.to_equiv.to_embedding,
+  finset_mem_Ici := by simp,
+  finset_mem_Ioi := by simp }
+
+/-- Transfer `locally_finite_order_bot` across an `order_iso`. -/
+@[reducible] -- See note [reducible non-instances]
+def locally_finite_order_bot [locally_finite_order_bot β]
+  (f : α ≃o β) : locally_finite_order_bot α :=
+{ finset_Iic := λ a, (Iic (f a)).map f.symm.to_equiv.to_embedding,
+  finset_Iio := λ a, (Iio (f a)).map f.symm.to_equiv.to_embedding,
+  finset_mem_Iic := by simp,
+  finset_mem_Iio := by simp }
+
+end order_iso
+
 /-! #### Subtype of a locally finite order -/
 
-variables [preorder α] [locally_finite_order α] (p : α → Prop) [decidable_pred p]
+variables [preorder α] (p : α → Prop) [decidable_pred p]
 
-instance : locally_finite_order (subtype p) :=
+instance [locally_finite_order α] : locally_finite_order (subtype p) :=
 { finset_Icc := λ a b, (Icc (a : α) b).subtype p,
   finset_Ico := λ a b, (Ico (a : α) b).subtype p,
   finset_Ioc := λ a b, (Ioc (a : α) b).subtype p,
@@ -601,9 +892,21 @@ instance : locally_finite_order (subtype p) :=
     subtype.coe_lt_coe],
   finset_mem_Ioo := λ a b x, by simp_rw [finset.mem_subtype, mem_Ioo, subtype.coe_lt_coe] }
 
-variables (a b : subtype p)
+instance [locally_finite_order_top α] : locally_finite_order_top (subtype p) :=
+{ finset_Ici := λ a, (Ici (a : α)).subtype p,
+  finset_Ioi := λ a, (Ioi (a : α)).subtype p,
+  finset_mem_Ici := λ a x, by simp_rw [finset.mem_subtype, mem_Ici, subtype.coe_le_coe],
+  finset_mem_Ioi := λ a x, by simp_rw [finset.mem_subtype, mem_Ioi, subtype.coe_lt_coe] }
+
+instance [locally_finite_order_bot α] : locally_finite_order_bot (subtype p) :=
+{ finset_Iic := λ a, (Iic (a : α)).subtype p,
+  finset_Iio := λ a, (Iio (a : α)).subtype p,
+  finset_mem_Iic := λ a x, by simp_rw [finset.mem_subtype, mem_Iic, subtype.coe_le_coe],
+  finset_mem_Iio := λ a x, by simp_rw [finset.mem_subtype, mem_Iio, subtype.coe_lt_coe] }
 
 namespace finset
+section locally_finite_order
+variables [locally_finite_order α] (a b : subtype p)
 
 lemma subtype_Icc_eq : Icc a b = (Icc (a : α) b).subtype p := rfl
 lemma subtype_Ico_eq : Ico a b = (Ico (a : α) b).subtype p := rfl
@@ -613,7 +916,7 @@ lemma subtype_Ioo_eq : Ioo a b = (Ioo (a : α) b).subtype p := rfl
 variables (hp : ∀ ⦃a b x⦄, a ≤ x → x ≤ b → p a → p b → p x)
 include hp
 
-lemma map_subtype_embedding_Icc : (Icc a b).map (function.embedding.subtype p) = Icc (a : α) b :=
+lemma map_subtype_embedding_Icc : (Icc a b).map (embedding.subtype p) = Icc a b :=
 begin
   rw subtype_Icc_eq,
   refine finset.subtype_map_of_mem (λ x hx, _),
@@ -621,7 +924,7 @@ begin
   exact hp hx.1 hx.2 a.prop b.prop,
 end
 
-lemma map_subtype_embedding_Ico : (Ico a b).map (function.embedding.subtype p) = Ico (a : α) b :=
+lemma map_subtype_embedding_Ico : (Ico a b).map (embedding.subtype p) = Ico a b :=
 begin
   rw subtype_Ico_eq,
   refine finset.subtype_map_of_mem (λ x hx, _),
@@ -629,7 +932,7 @@ begin
   exact hp hx.1 hx.2.le a.prop b.prop,
 end
 
-lemma map_subtype_embedding_Ioc : (Ioc a b).map (function.embedding.subtype p) = Ioc (a : α) b :=
+lemma map_subtype_embedding_Ioc : (Ioc a b).map (embedding.subtype p) = Ioc a b :=
 begin
   rw subtype_Ioc_eq,
   refine finset.subtype_map_of_mem (λ x hx, _),
@@ -637,7 +940,7 @@ begin
   exact hp hx.1.le hx.2 a.prop b.prop,
 end
 
-lemma map_subtype_embedding_Ioo : (Ioo a b).map (function.embedding.subtype p) = Ioo (a : α) b :=
+lemma map_subtype_embedding_Ioo : (Ioo a b).map (embedding.subtype p) = Ioo a b :=
 begin
   rw subtype_Ioo_eq,
   refine finset.subtype_map_of_mem (λ x hx, _),
@@ -645,4 +948,39 @@ begin
   exact hp hx.1.le hx.2.le a.prop b.prop,
 end
 
+end locally_finite_order
+
+section locally_finite_order_top
+variables [locally_finite_order_top α] (a : subtype p)
+
+lemma subtype_Ici_eq : Ici a = (Ici (a : α)).subtype p := rfl
+lemma subtype_Ioi_eq : Ioi a = (Ioi (a : α)).subtype p := rfl
+
+variables (hp : ∀ ⦃a x⦄, a ≤ x → p a → p x)
+include hp
+
+lemma map_subtype_embedding_Ici : (Ici a).map (embedding.subtype p) = Ici a :=
+by { rw subtype_Ici_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Ici.1 hx) a.prop) }
+
+lemma map_subtype_embedding_Ioi : (Ioi a).map (embedding.subtype p) = Ioi a :=
+by { rw subtype_Ioi_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Ioi.1 hx).le a.prop) }
+
+end locally_finite_order_top
+
+section locally_finite_order_bot
+variables [locally_finite_order_bot α] (a : subtype p)
+
+lemma subtype_Iic_eq : Iic a = (Iic (a : α)).subtype p := rfl
+lemma subtype_Iio_eq : Iio a = (Iio (a : α)).subtype p := rfl
+
+variables (hp : ∀ ⦃a x⦄, x ≤ a → p a → p x)
+include hp
+
+lemma map_subtype_embedding_Iic : (Iic a).map (embedding.subtype p) = Iic a :=
+by { rw subtype_Iic_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Iic.1 hx) a.prop) }
+
+lemma map_subtype_embedding_Iio : (Iio a).map (embedding.subtype p) = Iio a :=
+by { rw subtype_Iio_eq, exact finset.subtype_map_of_mem (λ x hx, hp (mem_Iio.1 hx).le a.prop) }
+
+end locally_finite_order_bot
 end finset
diff --git a/src/order/max.lean b/src/order/max.lean
index 38f2de28e046f..01aa6e0e063d5 100644
--- a/src/order/max.lean
+++ b/src/order/max.lean
@@ -3,11 +3,14 @@ Copyright (c) 2014 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Yury Kudryashov, Yaël Dillies
 -/
-import order.order_dual
+import order.synonym
 
 /-!
 # Minimal/maximal and bottom/top elements
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines predicates for elements to be minimal/maximal or bottom/top and typeclasses
 saying that there are no such elements.
 
@@ -30,7 +33,7 @@ See also `is_bot_iff_is_min` and `is_top_iff_is_max` for the equivalences in a (
 
 open order_dual
 
-variables {α : Type*}
+variables {ι α β : Type*} {π : ι → Type*}
 
 /-- Order without bottom elements. -/
 class no_bot_order (α : Type*) [has_le α] : Prop :=
@@ -71,6 +74,32 @@ instance order_dual.no_min_order (α : Type*) [has_lt α] [no_max_order α] : no
 instance order_dual.no_max_order (α : Type*) [has_lt α] [no_min_order α] : no_max_order αᵒᵈ :=
 ⟨λ a, @exists_lt α _ _ a⟩
 
+instance no_max_order_of_left [preorder α] [preorder β] [no_max_order α] : no_max_order (α × β) :=
+⟨λ ⟨a, b⟩, by { obtain ⟨c, h⟩ := exists_gt a, exact ⟨(c, b), prod.mk_lt_mk_iff_left.2 h⟩ }⟩
+
+instance no_max_order_of_right [preorder α] [preorder β] [no_max_order β] : no_max_order (α × β) :=
+⟨λ ⟨a, b⟩, by { obtain ⟨c, h⟩ := exists_gt b, exact ⟨(a, c), prod.mk_lt_mk_iff_right.2 h⟩ }⟩
+
+instance no_min_order_of_left [preorder α] [preorder β] [no_min_order α] : no_min_order (α × β) :=
+⟨λ ⟨a, b⟩, by { obtain ⟨c, h⟩ := exists_lt a, exact ⟨(c, b), prod.mk_lt_mk_iff_left.2 h⟩ }⟩
+
+instance no_min_order_of_right [preorder α] [preorder β] [no_min_order β] : no_min_order (α × β) :=
+⟨λ ⟨a, b⟩, by { obtain ⟨c, h⟩ := exists_lt b, exact ⟨(a, c), prod.mk_lt_mk_iff_right.2 h⟩ }⟩
+
+instance [nonempty ι] [Π i, preorder (π i)] [Π i, no_max_order (π i)] : no_max_order (Π i, π i) :=
+⟨λ a, begin
+  classical,
+  obtain ⟨b, hb⟩ := exists_gt (a $ classical.arbitrary _),
+  exact ⟨_, lt_update_self_iff.2 hb⟩,
+end⟩
+
+instance [nonempty ι] [Π i, preorder (π i)] [Π i, no_min_order (π i)] : no_min_order (Π i, π i) :=
+⟨λ a, begin
+  classical,
+  obtain ⟨b, hb⟩ := exists_lt (a $ classical.arbitrary _),
+  exact ⟨_, update_lt_self_iff.2 hb⟩,
+end⟩
+
 @[priority 100] -- See note [lower instance priority]
 instance no_min_order.to_no_bot_order (α : Type*) [preorder α] [no_min_order α] : no_bot_order α :=
 ⟨λ a, (exists_lt a).imp $ λ _, not_le_of_lt⟩
@@ -79,6 +108,28 @@ instance no_min_order.to_no_bot_order (α : Type*) [preorder α] [no_min_order 
 instance no_max_order.to_no_top_order (α : Type*) [preorder α] [no_max_order α] : no_top_order α :=
 ⟨λ a, (exists_gt a).imp $ λ _, not_le_of_lt⟩
 
+lemma no_bot_order.to_no_min_order (α : Type*) [linear_order α] [no_bot_order α] : no_min_order α :=
+{ exists_lt := by { convert λ a : α, exists_not_ge a, simp_rw not_le, } }
+
+lemma no_top_order.to_no_max_order (α : Type*) [linear_order α] [no_top_order α] : no_max_order α :=
+{ exists_gt := by { convert λ a : α, exists_not_le a, simp_rw not_le, } }
+
+lemma no_bot_order_iff_no_min_order (α : Type*) [linear_order α] :
+  no_bot_order α ↔ no_min_order α :=
+⟨λ h, by { haveI := h, exact no_bot_order.to_no_min_order α },
+  λ h, by { haveI := h, exact no_min_order.to_no_bot_order α }⟩
+
+lemma no_top_order_iff_no_max_order (α : Type*) [linear_order α] :
+  no_top_order α ↔ no_max_order α :=
+⟨λ h, by { haveI := h, exact no_top_order.to_no_max_order α },
+  λ h, by { haveI := h, exact no_max_order.to_no_top_order α }⟩
+
+theorem no_min_order.not_acc [has_lt α] [no_min_order α] (a : α) : ¬ acc (<) a :=
+λ h, acc.rec_on h $ λ x _, (exists_lt x).rec_on
+
+theorem no_max_order.not_acc [has_lt α] [no_max_order α] (a : α) : ¬ acc (>) a :=
+λ h, acc.rec_on h $ λ x _, (exists_gt x).rec_on
+
 section has_le
 variables [has_le α] {a b : α}
 
@@ -185,13 +236,41 @@ protected lemma is_max.eq_of_ge (ha : is_max a) (h : a ≤ b) : b = a := h.antis
 
 end partial_order
 
-section linear_order
-variables [linear_order α]
+section prod
+variables [preorder α] [preorder β] {a a₁ a₂ : α} {b b₁ b₂ : β} {x y : α × β}
+
+lemma is_bot.prod_mk (ha : is_bot a) (hb : is_bot b) : is_bot (a, b) := λ c, ⟨ha _, hb _⟩
+lemma is_top.prod_mk (ha : is_top a) (hb : is_top b) : is_top (a, b) := λ c, ⟨ha _, hb _⟩
+lemma is_min.prod_mk (ha : is_min a) (hb : is_min b) : is_min (a, b) := λ c hc, ⟨ha hc.1, hb hc.2⟩
+lemma is_max.prod_mk (ha : is_max a) (hb : is_max b) : is_max (a, b) := λ c hc, ⟨ha hc.1, hb hc.2⟩
+
+lemma is_bot.fst (hx : is_bot x) : is_bot x.1 := λ c, (hx (c, x.2)).1
+lemma is_bot.snd (hx : is_bot x) : is_bot x.2 := λ c, (hx (x.1, c)).2
+lemma is_top.fst (hx : is_top x) : is_top x.1 := λ c, (hx (c, x.2)).1
+lemma is_top.snd (hx : is_top x) : is_top x.2 := λ c, (hx (x.1, c)).2
+
+lemma is_min.fst (hx : is_min x) : is_min x.1 :=
+λ c hc, (hx $ show (c, x.2) ≤ x, from (and_iff_left le_rfl).2 hc).1
+
+lemma is_min.snd (hx : is_min x) : is_min x.2 :=
+λ c hc, (hx $ show (x.1, c) ≤ x, from (and_iff_right le_rfl).2 hc).2
+
+lemma is_max.fst (hx : is_max x) : is_max x.1 :=
+λ c hc, (hx $ show x ≤ (c, x.2), from (and_iff_left le_rfl).2 hc).1
+
+lemma is_max.snd (hx : is_max x) : is_max x.2 :=
+λ c hc, (hx $ show x ≤ (x.1, c), from (and_iff_right le_rfl).2 hc).2
+
+lemma prod.is_bot_iff : is_bot x ↔ is_bot x.1 ∧ is_bot x.2 :=
+⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩
+
+lemma prod.is_top_iff : is_top x ↔ is_top x.1 ∧ is_top x.2 :=
+⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩
 
---TODO: Delete in favor of the directed version
-lemma is_top_or_exists_gt (a : α) : is_top a ∨ ∃ b, a < b :=
-by simpa only [or_iff_not_imp_left, is_top, not_forall, not_le] using id
+lemma prod.is_min_iff : is_min x ↔ is_min x.1 ∧ is_min x.2 :=
+⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩
 
-lemma is_bot_or_exists_lt (a : α) : is_bot a ∨ ∃ b, b < a := @is_top_or_exists_gt αᵒᵈ _ a
+lemma prod.is_max_iff : is_max x ↔ is_max x.1 ∧ is_max x.2 :=
+⟨λ hx, ⟨hx.fst, hx.snd⟩, λ h, h.1.prod_mk h.2⟩
 
-end linear_order
+end prod
diff --git a/src/order/min_max.lean b/src/order/min_max.lean
index 46d96d9a40b4d..6703101a03467 100644
--- a/src/order/min_max.lean
+++ b/src/order/min_max.lean
@@ -8,6 +8,9 @@ import order.lattice
 /-!
 # `max` and `min`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves basic properties about maxima and minima on a `linear_order`.
 
 ## Tags
@@ -142,19 +145,6 @@ by cases le_total a b; simp [h, hf h]
 lemma antitone.map_min (hf : antitone f) : f (min a b) = max (f a) (f b) :=
 hf.dual.map_max
 
-lemma min_rec {p : α → Prop} {x y : α} (hx : x ≤ y → p x) (hy : y ≤ x → p y) : p (min x y) :=
-(le_total x y).rec (λ h, (min_eq_left h).symm.subst (hx h))
-  (λ h, (min_eq_right h).symm.subst (hy h))
-
-lemma max_rec {p : α → Prop} {x y : α} (hx : y ≤ x → p x) (hy : x ≤ y → p y) : p (max x y) :=
-@min_rec αᵒᵈ _ _ _ _ hx hy
-
-lemma min_rec' (p : α → Prop) {x y : α} (hx : p x) (hy : p y) : p (min x y) :=
-min_rec (λ _, hx) (λ _, hy)
-
-lemma max_rec' (p : α → Prop) {x y : α} (hx : p x) (hy : p y) : p (max x y) :=
-max_rec (λ _, hx) (λ _, hy)
-
 theorem min_choice (a b : α) : min a b = a ∨ min a b = b :=
 by cases le_total a b; simp *
 
diff --git a/src/order/minimal.lean b/src/order/minimal.lean
index 0143de2bf6318..0010e217b008a 100644
--- a/src/order/minimal.lean
+++ b/src/order/minimal.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import order.antichain
+import order.upper_lower.basic
 
 /-!
 # Minimal/maximal elements of a set
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines minimal and maximal of a set with respect to an arbitrary relation.
 
 ## Main declarations
@@ -22,13 +26,13 @@ Do we need a `finset` version?
 
 open function set
 
-variables {α : Type*} (r r₁ r₂ : α → α → Prop) (s t : set α) (a : α)
+variables {α : Type*} (r r₁ r₂ : α → α → Prop) (s t : set α) (a b : α)
 
 /-- Turns a set into an antichain by keeping only the "maximal" elements. -/
-def maximals : set α := {a ∈ s | ∀ ⦃b⦄, b ∈ s → r a b → a = b}
+def maximals : set α := {a ∈ s | ∀ ⦃b⦄, b ∈ s → r a b → r b a}
 
 /-- Turns a set into an antichain by keeping only the "minimal" elements. -/
-def minimals : set α := {a ∈ s | ∀ ⦃b⦄, b ∈ s → r b a → a = b}
+def minimals : set α := {a ∈ s | ∀ ⦃b⦄, b ∈ s → r b a → r a b}
 
 lemma maximals_subset : maximals r s ⊆ s := sep_subset _ _
 lemma minimals_subset : minimals r s ⊆ s := sep_subset _ _
@@ -37,15 +41,32 @@ lemma minimals_subset : minimals r s ⊆ s := sep_subset _ _
 @[simp] lemma minimals_empty : minimals r ∅ = ∅ := sep_empty _
 
 @[simp] lemma maximals_singleton : maximals r {a} = {a} :=
-(maximals_subset _ _).antisymm $ singleton_subset_iff.2 $ ⟨rfl, λ b hb _, hb.symm⟩
+(maximals_subset _ _).antisymm $ singleton_subset_iff.2 $
+  ⟨rfl, by { rintro b (rfl : b = a), exact id }⟩
 
 @[simp] lemma minimals_singleton : minimals r {a} = {a} := maximals_singleton _ _
 
 lemma maximals_swap : maximals (swap r) s = minimals r s := rfl
 lemma minimals_swap : minimals (swap r) s = maximals r s := rfl
 
-lemma maximals_antichain : is_antichain r (maximals r s) := λ a ha b hb hab h, hab $ ha.2 hb.1 h
-lemma minimals_antichain : is_antichain r (minimals r s) := (maximals_antichain _ _).swap
+section is_antisymm
+variables {r s t a b} [is_antisymm α r]
+
+lemma eq_of_mem_maximals (ha : a ∈ maximals r s) (hb : b ∈ s) (h : r a b) : a = b :=
+antisymm h $ ha.2 hb h
+
+lemma eq_of_mem_minimals (ha : a ∈ minimals r s) (hb : b ∈ s) (h : r b a) : a = b :=
+antisymm (ha.2 hb h) h
+
+variables (r s)
+
+lemma maximals_antichain : is_antichain r (maximals r s) :=
+λ a ha b hb hab h, hab $ eq_of_mem_maximals ha hb.1 h
+
+lemma minimals_antichain : is_antichain r (minimals r s) :=
+by { haveI := is_antisymm.swap r, exact (maximals_antichain _ _).swap }
+
+end is_antisymm
 
 lemma maximals_eq_minimals [is_symm α r] : maximals r s = minimals r s :=
 by { congr, ext a b, exact comm }
@@ -57,11 +78,15 @@ h.induction_on (minimals_empty _) (maximals_singleton _)
 
 lemma set.subsingleton.minimals_eq (h : s.subsingleton) : minimals r s = s := h.maximals_eq
 
-lemma maximals_mono (h : ∀ a b, r₁ a b → r₂ a b) : maximals r₂ s ⊆ maximals r₁ s :=
-λ a ha, ⟨ha.1, λ b hb, ha.2 hb ∘ h _ _⟩
+lemma maximals_mono [is_antisymm α r₂] (h : ∀ a b, r₁ a b → r₂ a b) :
+  maximals r₂ s ⊆ maximals r₁ s :=
+λ a ha, ⟨ha.1, λ b hb hab,
+  by { have := eq_of_mem_maximals ha hb (h _ _ hab), subst this, exact hab }⟩
 
-lemma minimals_mono (h : ∀ a b, r₁ a b → r₂ a b) : minimals r₂ s ⊆ minimals r₁ s :=
-λ a ha, ⟨ha.1, λ b hb, ha.2 hb ∘ h _ _⟩
+lemma minimals_mono [is_antisymm α r₂] (h : ∀ a b, r₁ a b → r₂ a b) :
+  minimals r₂ s ⊆ minimals r₁ s :=
+λ a ha, ⟨ha.1, λ b hb hab,
+  by { have := eq_of_mem_minimals ha hb (h _ _ hab), subst this, exact hab }⟩
 
 lemma maximals_union : maximals r (s ∪ t) ⊆ maximals r s ∪ maximals r t :=
 begin
@@ -84,13 +109,15 @@ lemma inter_maximals_subset : s ∩ maximals r t ⊆ maximals r (s ∩ t) :=
 lemma inter_minimals_subset : s ∩ minimals r t ⊆ minimals r (s ∩ t) := inter_maximals_subset
 
 lemma _root_.is_antichain.maximals_eq (h : is_antichain r s) : maximals r s = s :=
-(maximals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b, h.eq ha⟩
+(maximals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b hb hab,
+  by { have := h.eq ha hb hab, subst this, exact hab }⟩
 
 lemma _root_.is_antichain.minimals_eq (h : is_antichain r s) : minimals r s = s :=
-(minimals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b, h.eq' ha⟩
+(minimals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b hb hab,
+  by { have := h.eq hb ha hab, subst this, exact hab }⟩
 
 @[simp] lemma maximals_idem : maximals r (maximals r s) = maximals r s :=
-(maximals_antichain _ _).maximals_eq
+(maximals_subset _ _).antisymm $ λ a ha, ⟨ha, λ b hb, ha.2 hb.1⟩
 
 @[simp] lemma minimals_idem : minimals r (minimals r s) = minimals r s := maximals_idem
 
@@ -118,14 +145,21 @@ end
 
 variables [partial_order α]
 
-lemma is_least.mem_minimals (h : is_least s a) : a ∈ minimals (≤) s :=
-⟨h.1, λ b hb, (h.2 hb).antisymm⟩
-
-lemma is_greatest.mem_maximals (h : is_greatest s a) : a ∈ maximals (≤) s :=
-⟨h.1, λ b hb, (h.2 hb).antisymm'⟩
+lemma is_least.mem_minimals (h : is_least s a) : a ∈ minimals (≤) s := ⟨h.1, λ b hb _, h.2 hb⟩
+lemma is_greatest.mem_maximals (h : is_greatest s a) : a ∈ maximals (≤) s := ⟨h.1, λ b hb _, h.2 hb⟩
 
 lemma is_least.minimals_eq (h : is_least s a) : minimals (≤) s = {a} :=
-eq_singleton_iff_unique_mem.2 ⟨h.mem_minimals, λ b hb, hb.2 h.1 $ h.2 hb.1⟩
+eq_singleton_iff_unique_mem.2 ⟨h.mem_minimals, λ b hb, eq_of_mem_minimals hb h.1 $ h.2 hb.1⟩
 
 lemma is_greatest.maximals_eq (h : is_greatest s a) : maximals (≤) s = {a} :=
-eq_singleton_iff_unique_mem.2 ⟨h.mem_maximals, λ b hb, hb.2 h.1 $ h.2 hb.1⟩
+eq_singleton_iff_unique_mem.2 ⟨h.mem_maximals, λ b hb, eq_of_mem_maximals hb h.1 $ h.2 hb.1⟩
+
+lemma is_antichain.minimals_upper_closure (hs : is_antichain (≤) s) :
+  minimals (≤) (upper_closure s : set α) = s :=
+hs.max_minimals (λ a ⟨⟨b, hb, hba⟩, h⟩, by rwa eq_of_mem_minimals ‹a ∈ _› (subset_upper_closure hb)
+  hba) $ λ a ha, ⟨a, ⟨subset_upper_closure ha, λ b ⟨c, hc, hcb⟩ hba,
+    by rwa hs.eq' ha hc (hcb.trans hba)⟩, le_rfl⟩
+
+lemma is_antichain.maximals_lower_closure (hs : is_antichain (≤) s) :
+  maximals (≤) (lower_closure s : set α) = s :=
+hs.to_dual.minimals_upper_closure
diff --git a/src/order/modular_lattice.lean b/src/order/modular_lattice.lean
index ce193145da41c..96b99249a51e9 100644
--- a/src/order/modular_lattice.lean
+++ b/src/order/modular_lattice.lean
@@ -1,41 +1,162 @@
 /-
 Copyright (c) 2020 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Aaron Anderson
+Authors: Aaron Anderson, Yaël Dillies
 -/
-import order.rel_iso
+import order.cover
 import order.lattice_intervals
-import order.galois_connection
 
 /-!
 # Modular Lattices
-This file defines Modular Lattices, a kind of lattice useful in algebra.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines (semi)modular lattices, a kind of lattice useful in algebra.
 For examples, look to the subobject lattices of abelian groups, submodules, and ideals, or consider
 any distributive lattice.
 
+## Typeclasses
+
+We define (semi)modularity typeclasses as Prop-valued mixins.
+
+* `is_weak_upper_modular_lattice`: Weakly upper modular lattices. Lattice where `a ⊔ b` covers `a`
+  and `b` if `a` and `b` both cover `a ⊓ b`.
+* `is_weak_lower_modular_lattice`: Weakly lower modular lattices. Lattice where `a` and `b` cover
+  `a ⊓ b` if `a ⊔ b` covers both `a` and `b`
+* `is_upper_modular_lattice`: Upper modular lattices. Lattices where `a ⊔ b` covers `a` if `b`
+  covers `a ⊓ b`.
+* `is_lower_modular_lattice`: Lower modular lattices. Lattices where `a` covers `a ⊓ b` if `a ⊔ b`
+  covers `b`.
+- `is_modular_lattice`: Modular lattices. Lattices where `a ≤ c → (a ⊔ b) ⊓ c = a ⊔ (b ⊓ c)`. We
+  only require an inequality because the other direction holds in all lattices.
+
 ## Main Definitions
-- `is_modular_lattice` defines a modular lattice to be one such that
-  `x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z)`
+
 - `inf_Icc_order_iso_Icc_sup` gives an order isomorphism between the intervals
   `[a ⊓ b, a]` and `[b, a ⊔ b]`.
   This corresponds to the diamond (or second) isomorphism theorems of algebra.
 
 ## Main Results
+
 - `is_modular_lattice_iff_inf_sup_inf_assoc`:
   Modularity is equivalent to the `inf_sup_inf_assoc`: `(x ⊓ z) ⊔ (y ⊓ z) = ((x ⊓ z) ⊔ y) ⊓ z`
 - `distrib_lattice.is_modular_lattice`: Distributive lattices are modular.
 
-## To do
-- Relate atoms and coatoms in modular lattices
+## References
+
+* [Manfred Stern, *Semimodular lattices. {Theory} and applications*][stern2009]
+* [Wikipedia, *Modular Lattice*][https://en.wikipedia.org/wiki/Modular_lattice]
 
+## TODO
+
+- Relate atoms and coatoms in modular lattices
 -/
 
+open set
+
 variable {α : Type*}
 
+/-- A weakly upper modular lattice is a lattice where `a ⊔ b` covers `a` and `b` if `a` and `b` both
+cover `a ⊓ b`. -/
+class is_weak_upper_modular_lattice (α : Type*) [lattice α] : Prop :=
+(covby_sup_of_inf_covby_covby {a b : α} : a ⊓ b ⋖ a → a ⊓ b ⋖ b → a ⋖ a ⊔ b)
+
+/-- A weakly lower modular lattice is a lattice where `a` and `b` cover `a ⊓ b` if `a ⊔ b` covers
+both `a` and `b`. -/
+class is_weak_lower_modular_lattice (α : Type*) [lattice α] : Prop :=
+(inf_covby_of_covby_covby_sup {a b : α} : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ a)
+
+/-- An upper modular lattice, aka semimodular lattice, is a lattice where `a ⊔ b` covers `a` and `b`
+if either `a` or `b` covers `a ⊓ b`. -/
+class is_upper_modular_lattice (α : Type*) [lattice α] : Prop :=
+(covby_sup_of_inf_covby {a b : α} : a ⊓ b ⋖ a → b ⋖ a ⊔ b)
+
+/-- A lower modular lattice is a lattice where `a` and `b` both cover `a ⊓ b` if `a ⊔ b` covers
+either `a` or `b`. -/
+class is_lower_modular_lattice (α : Type*) [lattice α] : Prop :=
+(inf_covby_of_covby_sup {a b : α} : a ⋖ a ⊔ b → a ⊓ b ⋖ b)
+
 /-- A modular lattice is one with a limited associativity between `⊓` and `⊔`. -/
-class is_modular_lattice α [lattice α] : Prop :=
+class is_modular_lattice (α : Type*) [lattice α] : Prop :=
 (sup_inf_le_assoc_of_le : ∀ {x : α} (y : α) {z : α}, x ≤ z → (x ⊔ y) ⊓ z ≤ x ⊔ (y ⊓ z))
 
+section weak_upper_modular
+variables [lattice α] [is_weak_upper_modular_lattice α] {a b : α}
+
+lemma covby_sup_of_inf_covby_of_inf_covby_left : a ⊓ b ⋖ a → a ⊓ b ⋖ b → a ⋖ a ⊔ b :=
+is_weak_upper_modular_lattice.covby_sup_of_inf_covby_covby
+
+lemma covby_sup_of_inf_covby_of_inf_covby_right : a ⊓ b ⋖ a → a ⊓ b ⋖ b → b ⋖ a ⊔ b :=
+by { rw [inf_comm, sup_comm], exact λ ha hb, covby_sup_of_inf_covby_of_inf_covby_left hb ha }
+
+alias covby_sup_of_inf_covby_of_inf_covby_left ← covby.sup_of_inf_of_inf_left
+alias covby_sup_of_inf_covby_of_inf_covby_right ← covby.sup_of_inf_of_inf_right
+
+instance : is_weak_lower_modular_lattice (order_dual α) :=
+⟨λ a b ha hb, (ha.of_dual.sup_of_inf_of_inf_left hb.of_dual).to_dual⟩
+
+end weak_upper_modular
+
+section weak_lower_modular
+variables [lattice α] [is_weak_lower_modular_lattice α] {a b : α}
+
+lemma inf_covby_of_covby_sup_of_covby_sup_left : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ a :=
+is_weak_lower_modular_lattice.inf_covby_of_covby_covby_sup
+
+lemma inf_covby_of_covby_sup_of_covby_sup_right : a ⋖ a ⊔ b → b ⋖ a ⊔ b → a ⊓ b ⋖ b :=
+by { rw [sup_comm, inf_comm], exact λ ha hb, inf_covby_of_covby_sup_of_covby_sup_left hb ha }
+
+alias inf_covby_of_covby_sup_of_covby_sup_left ← covby.inf_of_sup_of_sup_left
+alias inf_covby_of_covby_sup_of_covby_sup_right ← covby.inf_of_sup_of_sup_right
+
+instance : is_weak_upper_modular_lattice (order_dual α) :=
+⟨λ a b ha hb, (ha.of_dual.inf_of_sup_of_sup_left hb.of_dual).to_dual⟩
+
+end weak_lower_modular
+
+section upper_modular
+variables [lattice α] [is_upper_modular_lattice α] {a b : α}
+
+lemma covby_sup_of_inf_covby_left : a ⊓ b ⋖ a → b ⋖ a ⊔ b :=
+is_upper_modular_lattice.covby_sup_of_inf_covby
+
+lemma covby_sup_of_inf_covby_right : a ⊓ b ⋖ b → a ⋖ a ⊔ b :=
+by { rw [sup_comm, inf_comm], exact covby_sup_of_inf_covby_left }
+
+alias covby_sup_of_inf_covby_left ← covby.sup_of_inf_left
+alias covby_sup_of_inf_covby_right ← covby.sup_of_inf_right
+
+@[priority 100] -- See note [lower instance priority]
+instance is_upper_modular_lattice.to_is_weak_upper_modular_lattice :
+  is_weak_upper_modular_lattice α :=
+⟨λ a b _, covby.sup_of_inf_right⟩
+
+instance : is_lower_modular_lattice (order_dual α) := ⟨λ a b h, h.of_dual.sup_of_inf_left.to_dual⟩
+
+end upper_modular
+
+section lower_modular
+variables [lattice α] [is_lower_modular_lattice α] {a b : α}
+
+lemma inf_covby_of_covby_sup_left : a ⋖ a ⊔ b → a ⊓ b ⋖ b :=
+is_lower_modular_lattice.inf_covby_of_covby_sup
+
+lemma inf_covby_of_covby_sup_right : b ⋖ a ⊔ b → a ⊓ b ⋖ a :=
+by { rw [inf_comm, sup_comm], exact inf_covby_of_covby_sup_left }
+
+alias inf_covby_of_covby_sup_left ← covby.inf_of_sup_left
+alias inf_covby_of_covby_sup_right ← covby.inf_of_sup_right
+
+@[priority 100] -- See note [lower instance priority]
+instance is_lower_modular_lattice.to_is_weak_lower_modular_lattice :
+  is_weak_lower_modular_lattice α :=
+⟨λ a b _, covby.inf_of_sup_right⟩
+
+instance : is_upper_modular_lattice (order_dual α) := ⟨λ a b h, h.of_dual.inf_of_sup_left.to_dual⟩
+
+end lower_modular
+
 section is_modular_lattice
 variables [lattice α] [is_modular_lattice α]
 
@@ -54,7 +175,7 @@ by rw [inf_comm, sup_comm, ← sup_inf_assoc_of_le y h, inf_comm, sup_comm]
 
 instance : is_modular_lattice αᵒᵈ :=
 ⟨λ x y z xz, le_of_eq (by { rw [inf_comm, sup_comm, eq_comm, inf_comm, sup_comm],
-  convert sup_inf_assoc_of_le (order_dual.of_dual y) (order_dual.dual_le.2 xz) })⟩
+  exact @sup_inf_assoc_of_le α _ _ _ y _ xz })⟩
 
 variables {x y z : α}
 
@@ -122,6 +243,7 @@ theorem well_founded_gt_exact_sequence
 @well_founded_lt_exact_sequence αᵒᵈ _ _ γᵒᵈ βᵒᵈ _ _ h₂ h₁ K g₁ g₂ f₁ f₂ gi.dual gci.dual hg hf
 
 /-- The diamond isomorphism between the intervals `[a ⊓ b, a]` and `[b, a ⊔ b]` -/
+@[simps]
 def inf_Icc_order_iso_Icc_sup (a b : α) : set.Icc (a ⊓ b) a ≃o set.Icc b (a ⊔ b) :=
 { to_fun := λ x, ⟨x ⊔ b, ⟨le_sup_right, sup_le_sup_right x.prop.2 b⟩⟩,
   inv_fun := λ x, ⟨a ⊓ x, ⟨inf_le_inf_left a x.prop.1, inf_le_left⟩⟩,
@@ -137,6 +259,42 @@ def inf_Icc_order_iso_Icc_sup (a b : α) : set.Icc (a ⊓ b) a ≃o set.Icc b (a
       ← sup_eq_right.2 y.prop.1, inf_sup_assoc_of_le _ y.prop.2, @sup_comm _ _ b],
     exact inf_le_inf_left _ h
   end }
+
+lemma inf_strict_mono_on_Icc_sup {a b : α} : strict_mono_on (λ c, a ⊓ c) (Icc b (a ⊔ b)) :=
+strict_mono.of_restrict (inf_Icc_order_iso_Icc_sup a b).symm.strict_mono
+
+lemma sup_strict_mono_on_Icc_inf {a b : α} : strict_mono_on (λ c, c ⊔ b) (Icc (a ⊓ b) a) :=
+strict_mono.of_restrict (inf_Icc_order_iso_Icc_sup a b).strict_mono
+
+/-- The diamond isomorphism between the intervals `]a ⊓ b, a[` and `}b, a ⊔ b[`. -/
+@[simps]
+def inf_Ioo_order_iso_Ioo_sup (a b : α) : Ioo (a ⊓ b) a ≃o Ioo b (a ⊔ b) :=
+{ to_fun := λ c, ⟨c ⊔ b,
+    le_sup_right.trans_lt $ sup_strict_mono_on_Icc_inf (left_mem_Icc.2 inf_le_left)
+      (Ioo_subset_Icc_self c.2) c.2.1,
+    sup_strict_mono_on_Icc_inf (Ioo_subset_Icc_self c.2) (right_mem_Icc.2 inf_le_left) c.2.2⟩,
+  inv_fun := λ c, ⟨a ⊓ c,
+    inf_strict_mono_on_Icc_sup (left_mem_Icc.2 le_sup_right) (Ioo_subset_Icc_self c.2) c.2.1,
+    inf_le_left.trans_lt' $ inf_strict_mono_on_Icc_sup (Ioo_subset_Icc_self c.2)
+      (right_mem_Icc.2 le_sup_right) c.2.2⟩,
+  left_inv := λ c, subtype.ext $
+    by { dsimp, rw [sup_comm, ←inf_sup_assoc_of_le _ c.prop.2.le, sup_eq_right.2 c.prop.1.le] },
+  right_inv := λ c, subtype.ext $
+    by { dsimp, rw [inf_comm, inf_sup_assoc_of_le _ c.prop.1.le, inf_eq_left.2 c.prop.2.le] },
+  map_rel_iff' := λ c d, @order_iso.le_iff_le _ _ _ _ (inf_Icc_order_iso_Icc_sup _ _)
+    ⟨c.1, Ioo_subset_Icc_self c.2⟩ ⟨d.1, Ioo_subset_Icc_self d.2⟩ }
+
+@[priority 100] -- See note [lower instance priority]
+instance is_modular_lattice.to_is_lower_modular_lattice : is_lower_modular_lattice α :=
+⟨λ a b, by { simp_rw [covby_iff_Ioo_eq, @sup_comm _ _ a, @inf_comm _ _ a, ←is_empty_coe_sort,
+  right_lt_sup, inf_lt_left, (inf_Ioo_order_iso_Ioo_sup _ _).symm.to_equiv.is_empty_congr],
+    exact id }⟩
+
+@[priority 100] -- See note [lower instance priority]
+instance is_modular_lattice.to_is_upper_modular_lattice : is_upper_modular_lattice α :=
+⟨λ a b, by { simp_rw [covby_iff_Ioo_eq, ←is_empty_coe_sort,
+  right_lt_sup, inf_lt_left, (inf_Ioo_order_iso_Ioo_sup _ _).to_equiv.is_empty_congr], exact id }⟩
+
 end is_modular_lattice
 
 namespace is_compl
@@ -167,7 +325,7 @@ theorem disjoint.disjoint_sup_right_of_disjoint_sup_left
   (h : disjoint a b) (hsup : disjoint (a ⊔ b) c) :
   disjoint a (b ⊔ c) :=
 begin
-  rw [disjoint, ← h.eq_bot, sup_comm],
+  rw [disjoint_iff_inf_le, ← h.eq_bot, sup_comm],
   apply le_inf inf_le_left,
   apply (inf_le_inf_right (c ⊔ b) le_sup_right).trans,
   rw [sup_comm, is_modular_lattice.sup_inf_sup_assoc, hsup.eq_bot, bot_sup_eq]
@@ -193,31 +351,35 @@ instance is_modular_lattice_Iic : is_modular_lattice (set.Iic a) :=
 instance is_modular_lattice_Ici : is_modular_lattice (set.Ici a) :=
 ⟨λ x y z xz, (sup_inf_le_assoc_of_le (y : α) xz : (↑x ⊔ ↑y) ⊓ ↑z ≤ ↑x ⊔ ↑y ⊓ ↑z)⟩
 
-section is_complemented
-variables [bounded_order α] [is_complemented α]
+section complemented_lattice
+variables [bounded_order α] [complemented_lattice α]
 
-instance is_complemented_Iic : is_complemented (set.Iic a) :=
+instance complemented_lattice_Iic : complemented_lattice (set.Iic a) :=
 ⟨λ ⟨x, hx⟩, let ⟨y, hy⟩ := exists_is_compl x in
   ⟨⟨y ⊓ a, set.mem_Iic.2 inf_le_right⟩, begin
     split,
-    { change x ⊓ (y ⊓ a) ≤ ⊥, -- improve lattice subtype API
+    { rw disjoint_iff_inf_le,
+      change x ⊓ (y ⊓ a) ≤ ⊥, -- improve lattice subtype API
       rw ← inf_assoc,
-      exact le_trans inf_le_left hy.1 },
-    { change a ≤ x ⊔ (y ⊓ a), -- improve lattice subtype API
-      rw [← sup_inf_assoc_of_le _ (set.mem_Iic.1 hx), top_le_iff.1 hy.2, top_inf_eq] }
+      exact le_trans inf_le_left hy.1.le_bot },
+    { rw codisjoint_iff_le_sup,
+      change a ≤ x ⊔ (y ⊓ a), -- improve lattice subtype API
+      rw [← sup_inf_assoc_of_le _ (set.mem_Iic.1 hx), hy.2.eq_top, top_inf_eq] }
   end⟩⟩
 
-instance is_complemented_Ici : is_complemented (set.Ici a) :=
+instance complemented_lattice_Ici : complemented_lattice (set.Ici a) :=
 ⟨λ ⟨x, hx⟩, let ⟨y, hy⟩ := exists_is_compl x in
   ⟨⟨y ⊔ a, set.mem_Ici.2 le_sup_right⟩, begin
     split,
-    { change x ⊓ (y ⊔ a) ≤ a, -- improve lattice subtype API
-      rw [← inf_sup_assoc_of_le _ (set.mem_Ici.1 hx),  le_bot_iff.1 hy.1, bot_sup_eq] },
-    { change ⊤ ≤ x ⊔ (y ⊔ a), -- improve lattice subtype API
+    { rw disjoint_iff_inf_le,
+      change x ⊓ (y ⊔ a) ≤ a, -- improve lattice subtype API
+      rw [← inf_sup_assoc_of_le _ (set.mem_Ici.1 hx), hy.1.eq_bot, bot_sup_eq] },
+    { rw codisjoint_iff_le_sup,
+      change ⊤ ≤ x ⊔ (y ⊔ a), -- improve lattice subtype API
       rw ← sup_assoc,
-      exact le_trans hy.2 le_sup_left }
+      exact le_trans hy.2.top_le le_sup_left }
   end⟩⟩
 
-end is_complemented
+end complemented_lattice
 
 end is_modular_lattice
diff --git a/src/order/monotone.lean b/src/order/monotone.lean
deleted file mode 100644
index e28880513f4b7..0000000000000
--- a/src/order/monotone.lean
+++ /dev/null
@@ -1,718 +0,0 @@
-/-
-Copyright (c) 2014 Jeremy Avigad. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Jeremy Avigad, Mario Carneiro, Yaël Dillies
--/
-import order.compare
-import order.max
-import order.rel_classes
-
-/-!
-# Monotonicity
-
-This file defines (strictly) monotone/antitone functions. Contrary to standard mathematical usage,
-"monotone"/"mono" here means "increasing", not "increasing or decreasing". We use "antitone"/"anti"
-to mean "decreasing".
-
-## Definitions
-
-* `monotone f`: A function `f` between two preorders is monotone if `a ≤ b` implies `f a ≤ f b`.
-* `antitone f`: A function `f` between two preorders is antitone if `a ≤ b` implies `f b ≤ f a`.
-* `monotone_on f s`: Same as `monotone f`, but for all `a, b ∈ s`.
-* `antitone_on f s`: Same as `antitone f`, but for all `a, b ∈ s`.
-* `strict_mono f` : A function `f` between two preorders is strictly monotone if `a < b` implies
-  `f a < f b`.
-* `strict_anti f` : A function `f` between two preorders is strictly antitone if `a < b` implies
-  `f b < f a`.
-* `strict_mono_on f s`: Same as `strict_mono f`, but for all `a, b ∈ s`.
-* `strict_anti_on f s`: Same as `strict_anti f`, but for all `a, b ∈ s`.
-
-## Main theorems
-
-* `monotone_nat_of_le_succ`, `monotone_int_of_le_succ`: If `f : ℕ → α` or `f : ℤ → α` and
-  `f n ≤ f (n + 1)` for all `n`, then `f` is monotone.
-* `antitone_nat_of_succ_le`, `antitone_int_of_succ_le`: If `f : ℕ → α` or `f : ℤ → α` and
-  `f (n + 1) ≤ f n` for all `n`, then `f` is antitone.
-* `strict_mono_nat_of_lt_succ`, `strict_mono_int_of_lt_succ`: If `f : ℕ → α` or `f : ℤ → α` and
-  `f n < f (n + 1)` for all `n`, then `f` is strictly monotone.
-* `strict_anti_nat_of_succ_lt`, `strict_anti_int_of_succ_lt`: If `f : ℕ → α` or `f : ℤ → α` and
-  `f (n + 1) < f n` for all `n`, then `f` is strictly antitone.
-
-## Implementation notes
-
-Some of these definitions used to only require `has_le α` or `has_lt α`. The advantage of this is
-unclear and it led to slight elaboration issues. Now, everything requires `preorder α` and seems to
-work fine. Related Zulip discussion:
-https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Order.20diamond/near/254353352.
-
-## TODO
-
-The above theorems are also true in `ℕ+`, `fin n`... To make that work, we need `succ_order α`
-and `succ_archimedean α`.
-
-## Tags
-
-monotone, strictly monotone, antitone, strictly antitone, increasing, strictly increasing,
-decreasing, strictly decreasing
--/
-
-open function
-
-universes u v w
-variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}
-
-section monotone_def
-variables [preorder α] [preorder β]
-
-/-- A function `f` is monotone if `a ≤ b` implies `f a ≤ f b`. -/
-def monotone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f a ≤ f b
-
-/-- A function `f` is antitone if `a ≤ b` implies `f b ≤ f a`. -/
-def antitone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f b ≤ f a
-
-/-- A function `f` is monotone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f a ≤ f b`. -/
-def monotone_on (f : α → β) (s : set α) : Prop :=
-∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f a ≤ f b
-
-/-- A function `f` is antitone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f b ≤ f a`. -/
-def antitone_on (f : α → β) (s : set α) : Prop :=
-∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f b ≤ f a
-
-/-- A function `f` is strictly monotone if `a < b` implies `f a < f b`. -/
-def strict_mono (f : α → β) : Prop :=
-∀ ⦃a b⦄, a < b → f a < f b
-
-/-- A function `f` is strictly antitone if `a < b` implies `f b < f a`. -/
-def strict_anti (f : α → β) : Prop :=
-∀ ⦃a b⦄, a < b → f b < f a
-
-/-- A function `f` is strictly monotone on `s` if, for all `a, b ∈ s`, `a < b` implies
-`f a < f b`. -/
-def strict_mono_on (f : α → β) (s : set α) : Prop :=
-∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a < f b
-
-/-- A function `f` is strictly antitone on `s` if, for all `a, b ∈ s`, `a < b` implies
-`f b < f a`. -/
-def strict_anti_on (f : α → β) (s : set α) : Prop :=
-∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b < f a
-
-end monotone_def
-
-/-! ### Monotonicity on the dual order
-
-Strictly, many of the `*_on.dual` lemmas in this section should use `of_dual ⁻¹' s` instead of `s`,
-but right now this is not possible as `set.preimage` is not defined yet, and importing it creates
-an import cycle.
-
-Often, you should not need the rewriting lemmas. Instead, you probably want to add `.dual`,
-`.dual_left` or `.dual_right` to your `monotone`/`antitone` hypothesis.
--/
-
-section order_dual
-open order_dual
-variables [preorder α] [preorder β] {f : α → β} {s : set α}
-
-@[simp] lemma monotone_comp_of_dual_iff : monotone (f ∘ of_dual) ↔ antitone f := forall_swap
-@[simp] lemma antitone_comp_of_dual_iff : antitone (f ∘ of_dual) ↔ monotone f := forall_swap
-@[simp] lemma monotone_to_dual_comp_iff : monotone (to_dual ∘ f) ↔ antitone f := iff.rfl
-@[simp] lemma antitone_to_dual_comp_iff : antitone (to_dual ∘ f) ↔ monotone f := iff.rfl
-
-@[simp] lemma monotone_on_comp_of_dual_iff : monotone_on (f ∘ of_dual) s ↔ antitone_on f s :=
-forall₂_swap
-@[simp] lemma antitone_on_comp_of_dual_iff : antitone_on (f ∘ of_dual) s ↔ monotone_on f s :=
-forall₂_swap
-@[simp] lemma monotone_on_to_dual_comp_iff : monotone_on (to_dual ∘ f) s ↔ antitone_on f s :=
-iff.rfl
-@[simp] lemma antitone_on_to_dual_comp_iff : antitone_on (to_dual ∘ f) s ↔ monotone_on f s :=
-iff.rfl
-
-@[simp] lemma strict_mono_comp_of_dual_iff : strict_mono (f ∘ of_dual) ↔ strict_anti f :=
-forall_swap
-@[simp] lemma strict_anti_comp_of_dual_iff : strict_anti (f ∘ of_dual) ↔ strict_mono f :=
-forall_swap
-@[simp] lemma strict_mono_to_dual_comp_iff : strict_mono (to_dual ∘ f) ↔ strict_anti f := iff.rfl
-@[simp] lemma strict_anti_to_dual_comp_iff : strict_anti (to_dual ∘ f) ↔ strict_mono f := iff.rfl
-
-@[simp] lemma strict_mono_on_comp_of_dual_iff :
-  strict_mono_on (f ∘ of_dual) s ↔ strict_anti_on f s := forall₂_swap
-@[simp] lemma strict_anti_on_comp_of_dual_iff :
-  strict_anti_on (f ∘ of_dual) s ↔ strict_mono_on f s := forall₂_swap
-@[simp] lemma strict_mono_on_to_dual_comp_iff :
-  strict_mono_on (to_dual ∘ f) s ↔ strict_anti_on f s := iff.rfl
-@[simp] lemma strict_anti_on_to_dual_comp_iff :
-  strict_anti_on (to_dual ∘ f) s ↔ strict_mono_on f s := iff.rfl
-
-protected lemma monotone.dual (hf : monotone f) : monotone (to_dual ∘ f ∘ of_dual) := swap hf
-protected lemma antitone.dual (hf : antitone f) : antitone (to_dual ∘ f ∘ of_dual) := swap hf
-protected lemma monotone_on.dual (hf : monotone_on f s) : monotone_on (to_dual ∘ f ∘ of_dual) s :=
-swap₂ hf
-protected lemma antitone_on.dual (hf : antitone_on f s) : antitone_on (to_dual ∘ f ∘ of_dual) s :=
-swap₂ hf
-protected lemma strict_mono.dual (hf : strict_mono f) : strict_mono (to_dual ∘ f ∘ of_dual) :=
-swap hf
-protected lemma strict_anti.dual (hf : strict_anti f) : strict_anti (to_dual ∘ f ∘ of_dual) :=
-swap hf
-protected lemma strict_mono_on.dual (hf : strict_mono_on f s) :
-  strict_mono_on (to_dual ∘ f ∘ of_dual) s := swap₂ hf
-protected lemma strict_anti_on.dual (hf : strict_anti_on f s) :
-  strict_anti_on (to_dual ∘ f ∘ of_dual) s := swap₂ hf
-
-alias antitone_comp_of_dual_iff ↔ _ monotone.dual_left
-alias monotone_comp_of_dual_iff ↔ _ antitone.dual_left
-alias antitone_to_dual_comp_iff ↔ _ monotone.dual_right
-alias monotone_to_dual_comp_iff ↔ _ antitone.dual_right
-alias antitone_on_comp_of_dual_iff ↔ _ monotone_on.dual_left
-alias monotone_on_comp_of_dual_iff ↔ _ antitone_on.dual_left
-alias antitone_on_to_dual_comp_iff ↔ _ monotone_on.dual_right
-alias monotone_on_to_dual_comp_iff ↔ _ antitone_on.dual_right
-alias strict_anti_comp_of_dual_iff ↔ _ strict_mono.dual_left
-alias strict_mono_comp_of_dual_iff ↔ _ strict_anti.dual_left
-alias strict_anti_to_dual_comp_iff ↔ _ strict_mono.dual_right
-alias strict_mono_to_dual_comp_iff ↔ _ strict_anti.dual_right
-alias strict_anti_on_comp_of_dual_iff ↔ _ strict_mono_on.dual_left
-alias strict_mono_on_comp_of_dual_iff ↔ _ strict_anti_on.dual_left
-alias strict_anti_on_to_dual_comp_iff ↔ _ strict_mono_on.dual_right
-alias strict_mono_on_to_dual_comp_iff ↔ _ strict_anti_on.dual_right
-
-end order_dual
-
-/-! ### Monotonicity in function spaces -/
-
-section preorder
-variables [preorder α]
-
-theorem monotone.comp_le_comp_left [preorder β]
-  {f : β → α} {g h : γ → β} (hf : monotone f) (le_gh : g ≤ h) :
-  has_le.le.{max w u} (f ∘ g) (f ∘ h) :=
-λ x, hf (le_gh x)
-
-variables [preorder γ]
-
-theorem monotone_lam {f : α → β → γ} (hf : ∀ b, monotone (λ a, f a b)) : monotone f :=
-λ a a' h b, hf b h
-
-theorem monotone_app (f : β → α → γ) (b : β) (hf : monotone (λ a b, f b a)) : monotone (f b) :=
-λ a a' h, hf h b
-
-theorem antitone_lam {f : α → β → γ} (hf : ∀ b, antitone (λ a, f a b)) : antitone f :=
-λ a a' h b, hf b h
-
-theorem antitone_app (f : β → α → γ) (b : β) (hf : antitone (λ a b, f b a)) : antitone (f b) :=
-λ a a' h, hf h b
-
-end preorder
-
-lemma function.monotone_eval {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] (i : ι) :
-  monotone (function.eval i : (Π i, α i) → α i) :=
-λ f g H, H i
-
-/-! ### Monotonicity hierarchy -/
-
-section preorder
-variables [preorder α]
-
-section preorder
-variables [preorder β] {f : α → β}
-
-protected lemma monotone.monotone_on (hf : monotone f) (s : set α) : monotone_on f s :=
-λ a _ b _ h, hf h
-
-protected lemma antitone.antitone_on (hf : antitone f) (s : set α) : antitone_on f s :=
-λ a _ b _ h, hf h
-
-lemma monotone_on_univ : monotone_on f set.univ ↔ monotone f :=
-⟨λ h a b, h trivial trivial, λ h, h.monotone_on _⟩
-
-lemma antitone_on_univ : antitone_on f set.univ ↔ antitone f :=
-⟨λ h a b, h trivial trivial, λ h, h.antitone_on _⟩
-
-protected lemma strict_mono.strict_mono_on (hf : strict_mono f) (s : set α) : strict_mono_on f s :=
-λ a _ b _ h, hf h
-
-protected lemma strict_anti.strict_anti_on (hf : strict_anti f) (s : set α) : strict_anti_on f s :=
-λ a _ b _ h, hf h
-
-lemma strict_mono_on_univ : strict_mono_on f set.univ ↔ strict_mono f :=
-⟨λ h a b, h trivial trivial, λ h, h.strict_mono_on _⟩
-
-lemma strict_anti_on_univ : strict_anti_on f set.univ ↔ strict_anti f :=
-⟨λ h a b, h trivial trivial, λ h, h.strict_anti_on _⟩
-
-end preorder
-
-section partial_order
-variables [partial_order β] {f : α → β}
-
-lemma monotone.strict_mono_of_injective (h₁ : monotone f) (h₂ : injective f) : strict_mono f :=
-λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H)
-
-lemma antitone.strict_anti_of_injective (h₁ : antitone f) (h₂ : injective f) : strict_anti f :=
-λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H.symm)
-
-end partial_order
-end preorder
-
-section partial_order
-variables [partial_order α] [preorder β] {f : α → β} {s : set α}
-
-lemma monotone_iff_forall_lt : monotone f ↔ ∀ ⦃a b⦄, a < b → f a ≤ f b :=
-forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) hf⟩
-
-lemma antitone_iff_forall_lt : antitone f ↔ ∀ ⦃a b⦄, a < b → f b ≤ f a :=
-forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) hf⟩
-
-lemma monotone_on_iff_forall_lt :
-  monotone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a ≤ f b :=
-⟨λ hf a ha b hb h, hf ha hb h.le,
-  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) (hf ha hb)⟩
-
-lemma antitone_on_iff_forall_lt :
-  antitone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b ≤ f a :=
-⟨λ hf a ha b hb h, hf ha hb h.le,
-  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) (hf ha hb)⟩
-
--- `preorder α` isn't strong enough: if the preorder on `α` is an equivalence relation,
--- then `strict_mono f` is vacuously true.
-protected lemma strict_mono_on.monotone_on (hf : strict_mono_on f s) : monotone_on f s :=
-monotone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le
-
-protected lemma strict_anti_on.antitone_on (hf : strict_anti_on f s) : antitone_on f s :=
-antitone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le
-
-protected lemma strict_mono.monotone (hf : strict_mono f) : monotone f :=
-monotone_iff_forall_lt.2 $ λ a b h, (hf h).le
-
-protected lemma strict_anti.antitone (hf : strict_anti f) : antitone f :=
-antitone_iff_forall_lt.2 $ λ a b h, (hf h).le
-
-end partial_order
-
-/-! ### Monotonicity from and to subsingletons -/
-
-namespace subsingleton
-variables [preorder α] [preorder β]
-
-protected lemma monotone [subsingleton α] (f : α → β) : monotone f :=
-λ a b _, (congr_arg _ $ subsingleton.elim _ _).le
-
-protected lemma antitone [subsingleton α] (f : α → β) : antitone f :=
-λ a b _, (congr_arg _ $ subsingleton.elim _ _).le
-
-lemma monotone' [subsingleton β] (f : α → β) : monotone f := λ a b _, (subsingleton.elim _ _).le
-lemma antitone' [subsingleton β] (f : α → β) : antitone f := λ a b _, (subsingleton.elim _ _).le
-
-protected lemma strict_mono [subsingleton α] (f : α → β) : strict_mono f :=
-λ a b h, (h.ne $ subsingleton.elim _ _).elim
-
-protected lemma strict_anti [subsingleton α] (f : α → β) : strict_anti f :=
-λ a b h, (h.ne $ subsingleton.elim _ _).elim
-
-end subsingleton
-
-/-! ### Miscellaneous monotonicity results -/
-
-lemma monotone_id [preorder α] : monotone (id : α → α) := λ a b, id
-
-lemma strict_mono_id [preorder α] : strict_mono (id : α → α) := λ a b, id
-
-theorem monotone_const [preorder α] [preorder β] {c : β} : monotone (λ (a : α), c) :=
-λ a b _, le_refl c
-
-theorem antitone_const [preorder α] [preorder β] {c : β} : antitone (λ (a : α), c) :=
-λ a b _, le_refl c
-
-lemma strict_mono_of_le_iff_le [preorder α] [preorder β] {f : α → β}
-  (h : ∀ x y, x ≤ y ↔ f x ≤ f y) : strict_mono f :=
-λ a b, (lt_iff_lt_of_le_iff_le' (h _ _) (h _ _)).1
-
-lemma injective_of_lt_imp_ne [linear_order α] {f : α → β} (h : ∀ x y, x < y → f x ≠ f y) :
-  injective f :=
-begin
-  intros x y hxy,
-  contrapose hxy,
-  cases ne.lt_or_lt hxy with hxy hxy,
-  exacts [h _ _ hxy, (h _ _ hxy).symm]
-end
-
-lemma injective_of_le_imp_le [partial_order α] [preorder β] (f : α → β)
-  (h : ∀ {x y}, f x ≤ f y → x ≤ y) : injective f :=
-λ x y hxy, (h hxy.le).antisymm (h hxy.ge)
-
-section preorder
-variables [preorder α] [preorder β] {f g : α → β} {a : α}
-
-lemma strict_mono.is_max_of_apply (hf : strict_mono f) (ha : is_max (f a)) : is_max a :=
-of_not_not $ λ h, let ⟨b, hb⟩ := not_is_max_iff.1 h in (hf hb).not_is_max ha
-
-lemma strict_mono.is_min_of_apply (hf : strict_mono f) (ha : is_min (f a)) : is_min a :=
-of_not_not $ λ h, let ⟨b, hb⟩ := not_is_min_iff.1 h in (hf hb).not_is_min ha
-
-lemma strict_anti.is_max_of_apply (hf : strict_anti f) (ha : is_min (f a)) : is_max a :=
-of_not_not $ λ h, let ⟨b, hb⟩ := not_is_max_iff.1 h in (hf hb).not_is_min ha
-
-lemma strict_anti.is_min_of_apply (hf : strict_anti f) (ha : is_max (f a)) : is_min a :=
-of_not_not $ λ h, let ⟨b, hb⟩ := not_is_min_iff.1 h in (hf hb).not_is_max ha
-
-protected lemma strict_mono.ite' (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
-  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
-  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → f x < g y) :
-  strict_mono (λ x, if p x then f x else g x) :=
-begin
-  intros x y h,
-  by_cases hy : p y,
-  { have hx : p x := hp h hy,
-    simpa [hx, hy] using hf h },
-  by_cases hx : p x,
-  { simpa [hx, hy] using hfg hx hy h },
-  { simpa [hx, hy] using hg h}
-end
-
-protected lemma strict_mono.ite (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
-  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, f x ≤ g x) :
-  strict_mono (λ x, if p x then f x else g x) :=
-hf.ite' hg hp $ λ x y hx hy h, (hf h).trans_le (hfg y)
-
-protected lemma strict_anti.ite' (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
-  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
-  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → g y < f x) :
-  strict_anti (λ x, if p x then f x else g x) :=
-(strict_mono.ite' hf.dual_right hg.dual_right hp hfg).dual_right
-
-protected lemma strict_anti.ite (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
-  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, g x ≤ f x) :
-  strict_anti (λ x, if p x then f x else g x) :=
-hf.ite' hg hp $ λ x y hx hy h, (hfg y).trans_lt (hf h)
-
-end preorder
-
-/-! ### Monotonicity under composition -/
-
-section composition
-variables [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β} {s : set α}
-
-protected lemma monotone.comp (hg : monotone g) (hf : monotone f) :
-  monotone (g ∘ f) :=
-λ a b h, hg (hf h)
-
-lemma monotone.comp_antitone (hg : monotone g) (hf : antitone f) :
-  antitone (g ∘ f) :=
-λ a b h, hg (hf h)
-
-protected lemma antitone.comp (hg : antitone g) (hf : antitone f) :
-  monotone (g ∘ f) :=
-λ a b h, hg (hf h)
-
-lemma antitone.comp_monotone (hg : antitone g) (hf : monotone f) :
-  antitone (g ∘ f) :=
-λ a b h, hg (hf h)
-
-protected lemma monotone.iterate {f : α → α} (hf : monotone f) (n : ℕ) : monotone (f^[n]) :=
-nat.rec_on n monotone_id (λ n h, h.comp hf)
-
-protected lemma monotone.comp_monotone_on (hg : monotone g) (hf : monotone_on f s) :
-  monotone_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-lemma monotone.comp_antitone_on (hg : monotone g) (hf : antitone_on f s) :
-  antitone_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-protected lemma antitone.comp_antitone_on (hg : antitone g) (hf : antitone_on f s) :
-  monotone_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-lemma antitone.comp_monotone_on (hg : antitone g) (hf : monotone_on f s) :
-  antitone_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-protected lemma strict_mono.comp (hg : strict_mono g) (hf : strict_mono f) :
-  strict_mono (g ∘ f) :=
-λ a b h, hg (hf h)
-
-lemma strict_mono.comp_strict_anti (hg : strict_mono g) (hf : strict_anti f) :
-  strict_anti (g ∘ f) :=
-λ a b h, hg (hf h)
-
-protected lemma strict_anti.comp (hg : strict_anti g) (hf : strict_anti f) :
-  strict_mono (g ∘ f) :=
-λ a b h, hg (hf h)
-
-lemma strict_anti.comp_strict_mono (hg : strict_anti g) (hf : strict_mono f) :
-  strict_anti (g ∘ f) :=
-λ a b h, hg (hf h)
-
-protected lemma strict_mono.iterate {f : α → α} (hf : strict_mono f) (n : ℕ) :
-  strict_mono (f^[n]) :=
-nat.rec_on n strict_mono_id (λ n h, h.comp hf)
-
-protected lemma strict_mono.comp_strict_mono_on (hg : strict_mono g) (hf : strict_mono_on f s) :
-  strict_mono_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-lemma strict_mono.comp_strict_anti_on (hg : strict_mono g) (hf : strict_anti_on f s) :
-  strict_anti_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-protected lemma strict_anti.comp_strict_anti_on (hg : strict_anti g) (hf : strict_anti_on f s) :
-  strict_mono_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-lemma strict_anti.comp_strict_mono_on (hg : strict_anti g) (hf : strict_mono_on f s) :
-  strict_anti_on (g ∘ f) s :=
-λ a ha b hb h, hg (hf ha hb h)
-
-end composition
-
-namespace list
-
-section fold
-
-theorem foldl_monotone [preorder α] {f : α → β → α} (H : ∀ b, monotone (λ a, f a b)) (l : list β) :
-  monotone (λ a, l.foldl f a) :=
-list.rec_on l (λ _ _, id) (λ i l hl _ _ h, hl (H _ h))
-
-theorem foldr_monotone [preorder β] {f : α → β → β} (H : ∀ a, monotone (f a)) (l : list α) :
-  monotone (λ b, l.foldr f b) :=
-λ _ _ h, list.rec_on l h (λ i l hl, H i hl)
-
-theorem foldl_strict_mono [preorder α] {f : α → β → α} (H : ∀ b, strict_mono (λ a, f a b))
-  (l : list β) : strict_mono (λ a, l.foldl f a) :=
-list.rec_on l (λ _ _, id) (λ i l hl _ _ h, hl (H _ h))
-
-theorem foldr_strict_mono [preorder β] {f : α → β → β} (H : ∀ a, strict_mono (f a)) (l : list α) :
-  strict_mono (λ b, l.foldr f b) :=
-λ _ _ h, list.rec_on l h (λ i l hl, H i hl)
-
-end fold
-
-end list
-
-/-! ### Monotonicity in linear orders  -/
-
-section linear_order
-variables [linear_order α]
-
-section preorder
-variables [preorder β] {f : α → β} {s : set α}
-
-open ordering
-
-lemma monotone.reflect_lt (hf : monotone f) {a b : α} (h : f a < f b) : a < b :=
-lt_of_not_ge (λ h', h.not_le (hf h'))
-
-lemma antitone.reflect_lt (hf : antitone f) {a b : α} (h : f a < f b) : b < a :=
-lt_of_not_ge (λ h', h.not_le (hf h'))
-
-lemma monotone_on.reflect_lt (hf : monotone_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s)
-  (h : f a < f b) :
-  a < b :=
-lt_of_not_ge $ λ h', h.not_le $ hf hb ha h'
-
-lemma antitone_on.reflect_lt (hf : antitone_on f s) {a b : α}  (ha : a ∈ s) (hb : b ∈ s)
-  (h : f a < f b) :
-  b < a :=
-lt_of_not_ge $ λ h', h.not_le $ hf ha hb h'
-
-lemma strict_mono_on.le_iff_le (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
-  f a ≤ f b ↔ a ≤ b :=
-⟨λ h, le_of_not_gt $ λ h', (hf hb ha h').not_le h,
- λ h, h.lt_or_eq_dec.elim (λ h', (hf ha hb h').le) (λ h', h' ▸ le_rfl)⟩
-
-lemma strict_anti_on.le_iff_le (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
-  f a ≤ f b ↔ b ≤ a :=
-hf.dual_right.le_iff_le hb ha
-
-lemma strict_mono_on.lt_iff_lt (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
-  f a < f b ↔ a < b :=
-by rw [lt_iff_le_not_le, lt_iff_le_not_le, hf.le_iff_le ha hb, hf.le_iff_le hb ha]
-
-lemma strict_anti_on.lt_iff_lt (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
-  f a < f b ↔ b < a :=
-hf.dual_right.lt_iff_lt hb ha
-
-lemma strict_mono.le_iff_le (hf : strict_mono f) {a b : α} :
-  f a ≤ f b ↔ a ≤ b :=
-(hf.strict_mono_on set.univ).le_iff_le trivial trivial
-
-lemma strict_anti.le_iff_le (hf : strict_anti f) {a b : α} :
-  f a ≤ f b ↔ b ≤ a :=
-(hf.strict_anti_on set.univ).le_iff_le trivial trivial
-
-lemma strict_mono.lt_iff_lt (hf : strict_mono f) {a b : α} :
-  f a < f b ↔ a < b :=
-(hf.strict_mono_on set.univ).lt_iff_lt trivial trivial
-
-lemma strict_anti.lt_iff_lt (hf : strict_anti f) {a b : α} :
-  f a < f b ↔ b < a :=
-(hf.strict_anti_on set.univ).lt_iff_lt trivial trivial
-
-protected theorem strict_mono_on.compares (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s)
-  (hb : b ∈ s) :
-  ∀ {o : ordering}, o.compares (f a) (f b) ↔ o.compares a b
-| ordering.lt := hf.lt_iff_lt ha hb
-| ordering.eq := ⟨λ h, ((hf.le_iff_le ha hb).1 h.le).antisymm ((hf.le_iff_le hb ha).1 h.symm.le),
-                   congr_arg _⟩
-| ordering.gt := hf.lt_iff_lt hb ha
-
-protected theorem strict_anti_on.compares (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s)
-  (hb : b ∈ s) {o : ordering} :
-  o.compares (f a) (f b) ↔ o.compares b a :=
-to_dual_compares_to_dual.trans $ hf.dual_right.compares hb ha
-
-protected theorem strict_mono.compares (hf : strict_mono f) {a b : α} {o : ordering} :
-  o.compares (f a) (f b) ↔ o.compares a b :=
-(hf.strict_mono_on set.univ).compares trivial trivial
-
-protected theorem strict_anti.compares (hf : strict_anti f) {a b : α} {o : ordering} :
-  o.compares (f a) (f b) ↔ o.compares b a :=
-(hf.strict_anti_on set.univ).compares trivial trivial
-
-lemma strict_mono.injective (hf : strict_mono f) : injective f :=
-λ x y h, show compares eq x y, from hf.compares.1 h
-
-lemma strict_anti.injective (hf : strict_anti f) : injective f :=
-λ x y h, show compares eq x y, from hf.compares.1 h.symm
-
-lemma strict_mono.maximal_of_maximal_image (hf : strict_mono f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
-  x ≤ a :=
-hf.le_iff_le.mp (hmax (f x))
-
-lemma strict_mono.minimal_of_minimal_image (hf : strict_mono f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
-  a ≤ x :=
-hf.le_iff_le.mp (hmin (f x))
-
-lemma strict_anti.minimal_of_maximal_image (hf : strict_anti f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
-  a ≤ x :=
-hf.le_iff_le.mp (hmax (f x))
-
-lemma strict_anti.maximal_of_minimal_image (hf : strict_anti f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
-  x ≤ a :=
-hf.le_iff_le.mp (hmin (f x))
-
-end preorder
-
-section partial_order
-variables [partial_order β] {f : α → β}
-
-lemma monotone.strict_mono_iff_injective (hf : monotone f) :
-  strict_mono f ↔ injective f :=
-⟨λ h, h.injective, hf.strict_mono_of_injective⟩
-
-lemma antitone.strict_anti_iff_injective (hf : antitone f) :
-  strict_anti f ↔ injective f :=
-⟨λ h, h.injective, hf.strict_anti_of_injective⟩
-
-end partial_order
-end linear_order
-
-/-! ### Monotonicity in `ℕ` and `ℤ` -/
-
-section preorder
-variables [preorder α]
-
-lemma nat.rel_of_forall_rel_succ_of_le_of_lt (r : β → β → Prop) [is_trans β r]
-  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
-  (hab : a ≤ b) (hbc : b < c) :
-  r (f b) (f c) :=
-begin
-  induction hbc with k b_lt_k r_b_k,
-  exacts [h _ hab, trans r_b_k (h _ (hab.trans_lt b_lt_k).le)]
-end
-
-lemma nat.rel_of_forall_rel_succ_of_le_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
-  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
-  (hab : a ≤ b) (hbc : b ≤ c) :
-  r (f b) (f c) :=
-hbc.eq_or_lt.elim (λ h, h ▸ refl _) (nat.rel_of_forall_rel_succ_of_le_of_lt r h hab)
-
-lemma nat.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
-  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a < b) : r (f a) (f b) :=
-nat.rel_of_forall_rel_succ_of_le_of_lt r (λ n _, h n) le_rfl hab
-
-lemma nat.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
-  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a ≤ b) : r (f a) (f b) :=
-nat.rel_of_forall_rel_succ_of_le_of_le r (λ n _, h n) le_rfl hab
-
-lemma monotone_nat_of_le_succ {f : ℕ → α} (hf : ∀ n, f n ≤ f (n + 1)) :
-  monotone f :=
-nat.rel_of_forall_rel_succ_of_le (≤) hf
-
-lemma antitone_nat_of_succ_le {f : ℕ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
-@monotone_nat_of_le_succ αᵒᵈ _ _ hf
-
-lemma strict_mono_nat_of_lt_succ {f : ℕ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
-nat.rel_of_forall_rel_succ_of_lt (<) hf
-
-lemma strict_anti_nat_of_succ_lt {f : ℕ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
-@strict_mono_nat_of_lt_succ αᵒᵈ _ f hf
-
-lemma int.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
-  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a < b) : r (f a) (f b) :=
-begin
-  rcases hab.dest with ⟨n, rfl⟩, clear hab,
-  induction n with n ihn,
-  { rw int.coe_nat_one, apply h },
-  { rw [int.coe_nat_succ, ← int.add_assoc],
-    exact trans ihn (h _) }
-end
-
-lemma int.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
-  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a ≤ b) : r (f a) (f b) :=
-hab.eq_or_lt.elim (λ h, h ▸ refl _) (λ h', int.rel_of_forall_rel_succ_of_lt r h h')
-
-lemma monotone_int_of_le_succ {f : ℤ → α} (hf : ∀ n, f n ≤ f (n + 1)) : monotone f :=
-int.rel_of_forall_rel_succ_of_le (≤) hf
-
-lemma antitone_int_of_succ_le {f : ℤ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
-int.rel_of_forall_rel_succ_of_le (≥) hf
-
-lemma strict_mono_int_of_lt_succ {f : ℤ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
-int.rel_of_forall_rel_succ_of_lt (<) hf
-
-lemma strict_anti_int_of_succ_lt {f : ℤ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
-int.rel_of_forall_rel_succ_of_lt (>) hf
-
--- TODO@Yael: Generalize the following four to succ orders
-/-- If `f` is a monotone function from `ℕ` to a preorder such that `x` lies between `f n` and
-  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
-lemma monotone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : monotone f) (n : ℕ) {x : α}
-  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℕ) :
-  f a ≠ x :=
-by { rintro rfl, exact (hf.reflect_lt h1).not_le (nat.le_of_lt_succ $ hf.reflect_lt h2) }
-
-/-- If `f` is an antitone function from `ℕ` to a preorder such that `x` lies between `f (n + 1)` and
-`f n`, then `x` doesn't lie in the range of `f`. -/
-lemma antitone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : antitone f)
-  (n : ℕ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℕ) : f a ≠ x :=
-by { rintro rfl, exact (hf.reflect_lt h2).not_le (nat.le_of_lt_succ $ hf.reflect_lt h1) }
-
-/-- If `f` is a monotone function from `ℤ` to a preorder and `x` lies between `f n` and
-  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
-lemma monotone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : monotone f) (n : ℤ) {x : α}
-  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℤ) :
-  f a ≠ x :=
-by { rintro rfl, exact (hf.reflect_lt h1).not_le (int.le_of_lt_add_one $ hf.reflect_lt h2) }
-
-/-- If `f` is an antitone function from `ℤ` to a preorder and `x` lies between `f (n + 1)` and
-`f n`, then `x` doesn't lie in the range of `f`. -/
-lemma antitone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : antitone f)
-  (n : ℤ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℤ) : f a ≠ x :=
-by { rintro rfl, exact (hf.reflect_lt h2).not_le (int.le_of_lt_add_one $ hf.reflect_lt h1) }
-
-lemma strict_mono.id_le {φ : ℕ → ℕ} (h : strict_mono φ) : ∀ n, n ≤ φ n :=
-λ n, nat.rec_on n (nat.zero_le _)
-  (λ n hn, nat.succ_le_of_lt (hn.trans_lt $ h $ nat.lt_succ_self n))
-
-end preorder
-
-lemma subtype.mono_coe [preorder α] (t : set α) : monotone (coe : (subtype t) → α) :=
-λ x y, id
-
-lemma subtype.strict_mono_coe [preorder α] (t : set α) : strict_mono (coe : (subtype t) → α) :=
-λ x y, id
-
-lemma monotone_fst {α β : Type*} [preorder α] [preorder β] : monotone (@prod.fst α β) :=
-λ x y h, h.1
-
-lemma monotone_snd {α β : Type*} [preorder α] [preorder β] : monotone (@prod.snd α β) :=
-λ x y h, h.2
diff --git a/src/order/monotone/basic.lean b/src/order/monotone/basic.lean
new file mode 100644
index 0000000000000..9ca070071a7ca
--- /dev/null
+++ b/src/order/monotone/basic.lean
@@ -0,0 +1,929 @@
+/-
+Copyright (c) 2014 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad, Mario Carneiro, Yaël Dillies
+-/
+import order.compare
+import order.max
+import order.rel_classes
+
+/-!
+# Monotonicity
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines (strictly) monotone/antitone functions. Contrary to standard mathematical usage,
+"monotone"/"mono" here means "increasing", not "increasing or decreasing". We use "antitone"/"anti"
+to mean "decreasing".
+
+## Definitions
+
+* `monotone f`: A function `f` between two preorders is monotone if `a ≤ b` implies `f a ≤ f b`.
+* `antitone f`: A function `f` between two preorders is antitone if `a ≤ b` implies `f b ≤ f a`.
+* `monotone_on f s`: Same as `monotone f`, but for all `a, b ∈ s`.
+* `antitone_on f s`: Same as `antitone f`, but for all `a, b ∈ s`.
+* `strict_mono f` : A function `f` between two preorders is strictly monotone if `a < b` implies
+  `f a < f b`.
+* `strict_anti f` : A function `f` between two preorders is strictly antitone if `a < b` implies
+  `f b < f a`.
+* `strict_mono_on f s`: Same as `strict_mono f`, but for all `a, b ∈ s`.
+* `strict_anti_on f s`: Same as `strict_anti f`, but for all `a, b ∈ s`.
+
+## Main theorems
+
+* `monotone_nat_of_le_succ`, `monotone_int_of_le_succ`: If `f : ℕ → α` or `f : ℤ → α` and
+  `f n ≤ f (n + 1)` for all `n`, then `f` is monotone.
+* `antitone_nat_of_succ_le`, `antitone_int_of_succ_le`: If `f : ℕ → α` or `f : ℤ → α` and
+  `f (n + 1) ≤ f n` for all `n`, then `f` is antitone.
+* `strict_mono_nat_of_lt_succ`, `strict_mono_int_of_lt_succ`: If `f : ℕ → α` or `f : ℤ → α` and
+  `f n < f (n + 1)` for all `n`, then `f` is strictly monotone.
+* `strict_anti_nat_of_succ_lt`, `strict_anti_int_of_succ_lt`: If `f : ℕ → α` or `f : ℤ → α` and
+  `f (n + 1) < f n` for all `n`, then `f` is strictly antitone.
+
+## Implementation notes
+
+Some of these definitions used to only require `has_le α` or `has_lt α`. The advantage of this is
+unclear and it led to slight elaboration issues. Now, everything requires `preorder α` and seems to
+work fine. Related Zulip discussion:
+https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Order.20diamond/near/254353352.
+
+## TODO
+
+The above theorems are also true in `ℕ+`, `fin n`... To make that work, we need `succ_order α`
+and `succ_archimedean α`.
+
+## Tags
+
+monotone, strictly monotone, antitone, strictly antitone, increasing, strictly increasing,
+decreasing, strictly decreasing
+-/
+
+open function order_dual
+
+universes u v w
+variables {ι : Type*} {α : Type u} {β : Type v} {γ : Type w} {δ : Type*} {π : ι → Type*}
+  {r : α → α → Prop}
+
+section monotone_def
+variables [preorder α] [preorder β]
+
+/-- A function `f` is monotone if `a ≤ b` implies `f a ≤ f b`. -/
+def monotone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f a ≤ f b
+
+/-- A function `f` is antitone if `a ≤ b` implies `f b ≤ f a`. -/
+def antitone (f : α → β) : Prop := ∀ ⦃a b⦄, a ≤ b → f b ≤ f a
+
+/-- A function `f` is monotone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f a ≤ f b`. -/
+def monotone_on (f : α → β) (s : set α) : Prop :=
+∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f a ≤ f b
+
+/-- A function `f` is antitone on `s` if, for all `a, b ∈ s`, `a ≤ b` implies `f b ≤ f a`. -/
+def antitone_on (f : α → β) (s : set α) : Prop :=
+∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a ≤ b → f b ≤ f a
+
+/-- A function `f` is strictly monotone if `a < b` implies `f a < f b`. -/
+def strict_mono (f : α → β) : Prop :=
+∀ ⦃a b⦄, a < b → f a < f b
+
+/-- A function `f` is strictly antitone if `a < b` implies `f b < f a`. -/
+def strict_anti (f : α → β) : Prop :=
+∀ ⦃a b⦄, a < b → f b < f a
+
+/-- A function `f` is strictly monotone on `s` if, for all `a, b ∈ s`, `a < b` implies
+`f a < f b`. -/
+def strict_mono_on (f : α → β) (s : set α) : Prop :=
+∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a < f b
+
+/-- A function `f` is strictly antitone on `s` if, for all `a, b ∈ s`, `a < b` implies
+`f b < f a`. -/
+def strict_anti_on (f : α → β) (s : set α) : Prop :=
+∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b < f a
+
+end monotone_def
+
+section decidable
+
+variables [preorder α] [preorder β] {f : α → β} {s : set α}
+
+instance [i : decidable (∀ a b, a ≤ b → f a ≤ f b)] : decidable (monotone f) := i
+instance [i : decidable (∀ a b, a ≤ b → f b ≤ f a)] : decidable (antitone f) := i
+instance [i : decidable (∀ a b ∈ s, a ≤ b → f a ≤ f b)] : decidable (monotone_on f s) := i
+instance [i : decidable (∀ a b ∈ s, a ≤ b → f b ≤ f a)] : decidable (antitone_on f s) := i
+instance [i : decidable (∀ a b, a < b → f a < f b)] : decidable (strict_mono f) := i
+instance [i : decidable (∀ a b, a < b → f b < f a)] : decidable (strict_anti f) := i
+instance [i : decidable (∀ a b ∈ s, a < b → f a < f b)] : decidable (strict_mono_on f s) := i
+instance [i : decidable (∀ a b ∈ s, a < b → f b < f a)] : decidable (strict_anti_on f s) := i
+
+end decidable
+
+/-! ### Monotonicity on the dual order
+
+Strictly, many of the `*_on.dual` lemmas in this section should use `of_dual ⁻¹' s` instead of `s`,
+but right now this is not possible as `set.preimage` is not defined yet, and importing it creates
+an import cycle.
+
+Often, you should not need the rewriting lemmas. Instead, you probably want to add `.dual`,
+`.dual_left` or `.dual_right` to your `monotone`/`antitone` hypothesis.
+-/
+
+section order_dual
+
+variables [preorder α] [preorder β] {f : α → β} {s : set α}
+
+@[simp] lemma monotone_comp_of_dual_iff : monotone (f ∘ of_dual) ↔ antitone f := forall_swap
+@[simp] lemma antitone_comp_of_dual_iff : antitone (f ∘ of_dual) ↔ monotone f := forall_swap
+@[simp] lemma monotone_to_dual_comp_iff : monotone (to_dual ∘ f) ↔ antitone f := iff.rfl
+@[simp] lemma antitone_to_dual_comp_iff : antitone (to_dual ∘ f) ↔ monotone f := iff.rfl
+
+@[simp] lemma monotone_on_comp_of_dual_iff : monotone_on (f ∘ of_dual) s ↔ antitone_on f s :=
+forall₂_swap
+@[simp] lemma antitone_on_comp_of_dual_iff : antitone_on (f ∘ of_dual) s ↔ monotone_on f s :=
+forall₂_swap
+@[simp] lemma monotone_on_to_dual_comp_iff : monotone_on (to_dual ∘ f) s ↔ antitone_on f s :=
+iff.rfl
+@[simp] lemma antitone_on_to_dual_comp_iff : antitone_on (to_dual ∘ f) s ↔ monotone_on f s :=
+iff.rfl
+
+@[simp] lemma strict_mono_comp_of_dual_iff : strict_mono (f ∘ of_dual) ↔ strict_anti f :=
+forall_swap
+@[simp] lemma strict_anti_comp_of_dual_iff : strict_anti (f ∘ of_dual) ↔ strict_mono f :=
+forall_swap
+@[simp] lemma strict_mono_to_dual_comp_iff : strict_mono (to_dual ∘ f) ↔ strict_anti f := iff.rfl
+@[simp] lemma strict_anti_to_dual_comp_iff : strict_anti (to_dual ∘ f) ↔ strict_mono f := iff.rfl
+
+@[simp] lemma strict_mono_on_comp_of_dual_iff :
+  strict_mono_on (f ∘ of_dual) s ↔ strict_anti_on f s := forall₂_swap
+@[simp] lemma strict_anti_on_comp_of_dual_iff :
+  strict_anti_on (f ∘ of_dual) s ↔ strict_mono_on f s := forall₂_swap
+@[simp] lemma strict_mono_on_to_dual_comp_iff :
+  strict_mono_on (to_dual ∘ f) s ↔ strict_anti_on f s := iff.rfl
+@[simp] lemma strict_anti_on_to_dual_comp_iff :
+  strict_anti_on (to_dual ∘ f) s ↔ strict_mono_on f s := iff.rfl
+
+protected lemma monotone.dual (hf : monotone f) : monotone (to_dual ∘ f ∘ of_dual) := swap hf
+protected lemma antitone.dual (hf : antitone f) : antitone (to_dual ∘ f ∘ of_dual) := swap hf
+protected lemma monotone_on.dual (hf : monotone_on f s) : monotone_on (to_dual ∘ f ∘ of_dual) s :=
+swap₂ hf
+protected lemma antitone_on.dual (hf : antitone_on f s) : antitone_on (to_dual ∘ f ∘ of_dual) s :=
+swap₂ hf
+protected lemma strict_mono.dual (hf : strict_mono f) : strict_mono (to_dual ∘ f ∘ of_dual) :=
+swap hf
+protected lemma strict_anti.dual (hf : strict_anti f) : strict_anti (to_dual ∘ f ∘ of_dual) :=
+swap hf
+protected lemma strict_mono_on.dual (hf : strict_mono_on f s) :
+  strict_mono_on (to_dual ∘ f ∘ of_dual) s := swap₂ hf
+protected lemma strict_anti_on.dual (hf : strict_anti_on f s) :
+  strict_anti_on (to_dual ∘ f ∘ of_dual) s := swap₂ hf
+
+alias antitone_comp_of_dual_iff ↔ _ monotone.dual_left
+alias monotone_comp_of_dual_iff ↔ _ antitone.dual_left
+alias antitone_to_dual_comp_iff ↔ _ monotone.dual_right
+alias monotone_to_dual_comp_iff ↔ _ antitone.dual_right
+alias antitone_on_comp_of_dual_iff ↔ _ monotone_on.dual_left
+alias monotone_on_comp_of_dual_iff ↔ _ antitone_on.dual_left
+alias antitone_on_to_dual_comp_iff ↔ _ monotone_on.dual_right
+alias monotone_on_to_dual_comp_iff ↔ _ antitone_on.dual_right
+alias strict_anti_comp_of_dual_iff ↔ _ strict_mono.dual_left
+alias strict_mono_comp_of_dual_iff ↔ _ strict_anti.dual_left
+alias strict_anti_to_dual_comp_iff ↔ _ strict_mono.dual_right
+alias strict_mono_to_dual_comp_iff ↔ _ strict_anti.dual_right
+alias strict_anti_on_comp_of_dual_iff ↔ _ strict_mono_on.dual_left
+alias strict_mono_on_comp_of_dual_iff ↔ _ strict_anti_on.dual_left
+alias strict_anti_on_to_dual_comp_iff ↔ _ strict_mono_on.dual_right
+alias strict_mono_on_to_dual_comp_iff ↔ _ strict_anti_on.dual_right
+
+end order_dual
+
+/-! ### Monotonicity in function spaces -/
+
+section preorder
+variables [preorder α]
+
+theorem monotone.comp_le_comp_left [preorder β]
+  {f : β → α} {g h : γ → β} (hf : monotone f) (le_gh : g ≤ h) :
+  has_le.le.{max w u} (f ∘ g) (f ∘ h) :=
+λ x, hf (le_gh x)
+
+variables [preorder γ]
+
+theorem monotone_lam {f : α → β → γ} (hf : ∀ b, monotone (λ a, f a b)) : monotone f :=
+λ a a' h b, hf b h
+
+theorem monotone_app (f : β → α → γ) (b : β) (hf : monotone (λ a b, f b a)) : monotone (f b) :=
+λ a a' h, hf h b
+
+theorem antitone_lam {f : α → β → γ} (hf : ∀ b, antitone (λ a, f a b)) : antitone f :=
+λ a a' h b, hf b h
+
+theorem antitone_app (f : β → α → γ) (b : β) (hf : antitone (λ a b, f b a)) : antitone (f b) :=
+λ a a' h, hf h b
+
+end preorder
+
+lemma function.monotone_eval {ι : Type u} {α : ι → Type v} [∀ i, preorder (α i)] (i : ι) :
+  monotone (function.eval i : (Π i, α i) → α i) :=
+λ f g H, H i
+
+/-! ### Monotonicity hierarchy -/
+
+section preorder
+variables [preorder α]
+
+section preorder
+variables [preorder β] {f : α → β} {s : set α} {a b : α}
+
+/-!
+These four lemmas are there to strip off the semi-implicit arguments `⦃a b : α⦄`. This is useful
+when you do not want to apply a `monotone` assumption (i.e. your goal is `a ≤ b → f a ≤ f b`).
+However if you find yourself writing `hf.imp h`, then you should have written `hf h` instead.
+-/
+
+lemma monotone.imp (hf : monotone f) (h : a ≤ b) : f a ≤ f b := hf h
+lemma antitone.imp (hf : antitone f) (h : a ≤ b) : f b ≤ f a := hf h
+lemma strict_mono.imp (hf : strict_mono f) (h : a < b) : f a < f b := hf h
+lemma strict_anti.imp (hf : strict_anti f) (h : a < b) : f b < f a := hf h
+
+protected lemma monotone.monotone_on (hf : monotone f) (s : set α) : monotone_on f s :=
+λ a _ b _, hf.imp
+
+protected lemma antitone.antitone_on (hf : antitone f) (s : set α) : antitone_on f s :=
+λ a _ b _, hf.imp
+
+@[simp] lemma monotone_on_univ : monotone_on f set.univ ↔ monotone f :=
+⟨λ h a b, h trivial trivial, λ h, h.monotone_on _⟩
+
+@[simp] lemma antitone_on_univ : antitone_on f set.univ ↔ antitone f :=
+⟨λ h a b, h trivial trivial, λ h, h.antitone_on _⟩
+
+protected lemma strict_mono.strict_mono_on (hf : strict_mono f) (s : set α) : strict_mono_on f s :=
+λ a _ b _, hf.imp
+
+protected lemma strict_anti.strict_anti_on (hf : strict_anti f) (s : set α) : strict_anti_on f s :=
+λ a _ b _, hf.imp
+
+@[simp] lemma strict_mono_on_univ : strict_mono_on f set.univ ↔ strict_mono f :=
+⟨λ h a b, h trivial trivial, λ h, h.strict_mono_on _⟩
+
+@[simp] lemma strict_anti_on_univ : strict_anti_on f set.univ ↔ strict_anti f :=
+⟨λ h a b, h trivial trivial, λ h, h.strict_anti_on _⟩
+
+end preorder
+
+section partial_order
+variables [partial_order β] {f : α → β}
+
+lemma monotone.strict_mono_of_injective (h₁ : monotone f) (h₂ : injective f) : strict_mono f :=
+λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H)
+
+lemma antitone.strict_anti_of_injective (h₁ : antitone f) (h₂ : injective f) : strict_anti f :=
+λ a b h, (h₁ h.le).lt_of_ne (λ H, h.ne $ h₂ H.symm)
+
+end partial_order
+end preorder
+
+section partial_order
+variables [partial_order α] [preorder β] {f : α → β} {s : set α}
+
+lemma monotone_iff_forall_lt : monotone f ↔ ∀ ⦃a b⦄, a < b → f a ≤ f b :=
+forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) hf⟩
+
+lemma antitone_iff_forall_lt : antitone f ↔ ∀ ⦃a b⦄, a < b → f b ≤ f a :=
+forall₂_congr $ λ a b, ⟨λ hf h, hf h.le, λ hf h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) hf⟩
+
+lemma monotone_on_iff_forall_lt :
+  monotone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f a ≤ f b :=
+⟨λ hf a ha b hb h, hf ha hb h.le,
+  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).le) (hf ha hb)⟩
+
+lemma antitone_on_iff_forall_lt :
+  antitone_on f s ↔ ∀ ⦃a⦄ (ha : a ∈ s) ⦃b⦄ (hb : b ∈ s), a < b → f b ≤ f a :=
+⟨λ hf a ha b hb h, hf ha hb h.le,
+  λ hf a ha b hb h, h.eq_or_lt.elim (λ H, (congr_arg _ H).ge) (hf ha hb)⟩
+
+-- `preorder α` isn't strong enough: if the preorder on `α` is an equivalence relation,
+-- then `strict_mono f` is vacuously true.
+protected lemma strict_mono_on.monotone_on (hf : strict_mono_on f s) : monotone_on f s :=
+monotone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le
+
+protected lemma strict_anti_on.antitone_on (hf : strict_anti_on f s) : antitone_on f s :=
+antitone_on_iff_forall_lt.2 $ λ a ha b hb h, (hf ha hb h).le
+
+protected lemma strict_mono.monotone (hf : strict_mono f) : monotone f :=
+monotone_iff_forall_lt.2 $ λ a b h, (hf h).le
+
+protected lemma strict_anti.antitone (hf : strict_anti f) : antitone f :=
+antitone_iff_forall_lt.2 $ λ a b h, (hf h).le
+
+end partial_order
+
+/-! ### Monotonicity from and to subsingletons -/
+
+namespace subsingleton
+variables [preorder α] [preorder β]
+
+protected lemma monotone [subsingleton α] (f : α → β) : monotone f :=
+λ a b _, (congr_arg _ $ subsingleton.elim _ _).le
+
+protected lemma antitone [subsingleton α] (f : α → β) : antitone f :=
+λ a b _, (congr_arg _ $ subsingleton.elim _ _).le
+
+lemma monotone' [subsingleton β] (f : α → β) : monotone f := λ a b _, (subsingleton.elim _ _).le
+lemma antitone' [subsingleton β] (f : α → β) : antitone f := λ a b _, (subsingleton.elim _ _).le
+
+protected lemma strict_mono [subsingleton α] (f : α → β) : strict_mono f :=
+λ a b h, (h.ne $ subsingleton.elim _ _).elim
+
+protected lemma strict_anti [subsingleton α] (f : α → β) : strict_anti f :=
+λ a b h, (h.ne $ subsingleton.elim _ _).elim
+
+end subsingleton
+
+/-! ### Miscellaneous monotonicity results -/
+
+lemma monotone_id [preorder α] : monotone (id : α → α) := λ a b, id
+
+lemma monotone_on_id [preorder α] {s : set α} : monotone_on id s := λ a ha b hb, id
+
+lemma strict_mono_id [preorder α] : strict_mono (id : α → α) := λ a b, id
+
+lemma strict_mono_on_id [preorder α] {s : set α} : strict_mono_on id s := λ a ha b hb, id
+
+theorem monotone_const [preorder α] [preorder β] {c : β} : monotone (λ (a : α), c) :=
+λ a b _, le_rfl
+
+theorem monotone_on_const [preorder α] [preorder β] {c : β} {s : set α} :
+  monotone_on (λ (a : α), c) s :=
+λ a _ b _ _, le_rfl
+
+theorem antitone_const [preorder α] [preorder β] {c : β} : antitone (λ (a : α), c) :=
+λ a b _, le_refl c
+
+theorem antitone_on_const [preorder α] [preorder β] {c : β} {s : set α} :
+  antitone_on (λ (a : α), c) s :=
+λ a _ b _ _, le_rfl
+
+lemma strict_mono_of_le_iff_le [preorder α] [preorder β] {f : α → β}
+  (h : ∀ x y, x ≤ y ↔ f x ≤ f y) : strict_mono f :=
+λ a b, (lt_iff_lt_of_le_iff_le' (h _ _) (h _ _)).1
+
+lemma strict_anti_of_le_iff_le [preorder α] [preorder β] {f : α → β}
+  (h : ∀ x y, x ≤ y ↔ f y ≤ f x) : strict_anti f :=
+λ a b, (lt_iff_lt_of_le_iff_le' (h _ _) (h _ _)).1
+
+lemma injective_of_lt_imp_ne [linear_order α] {f : α → β} (h : ∀ x y, x < y → f x ≠ f y) :
+  injective f :=
+begin
+  intros x y hxy,
+  contrapose hxy,
+  cases ne.lt_or_lt hxy with hxy hxy,
+  exacts [h _ _ hxy, (h _ _ hxy).symm]
+end
+
+lemma injective_of_le_imp_le [partial_order α] [preorder β] (f : α → β)
+  (h : ∀ {x y}, f x ≤ f y → x ≤ y) : injective f :=
+λ x y hxy, (h hxy.le).antisymm (h hxy.ge)
+
+section preorder
+variables [preorder α] [preorder β] {f g : α → β} {a : α}
+
+lemma strict_mono.is_max_of_apply (hf : strict_mono f) (ha : is_max (f a)) : is_max a :=
+of_not_not $ λ h, let ⟨b, hb⟩ := not_is_max_iff.1 h in (hf hb).not_is_max ha
+
+lemma strict_mono.is_min_of_apply (hf : strict_mono f) (ha : is_min (f a)) : is_min a :=
+of_not_not $ λ h, let ⟨b, hb⟩ := not_is_min_iff.1 h in (hf hb).not_is_min ha
+
+lemma strict_anti.is_max_of_apply (hf : strict_anti f) (ha : is_min (f a)) : is_max a :=
+of_not_not $ λ h, let ⟨b, hb⟩ := not_is_max_iff.1 h in (hf hb).not_is_min ha
+
+lemma strict_anti.is_min_of_apply (hf : strict_anti f) (ha : is_max (f a)) : is_min a :=
+of_not_not $ λ h, let ⟨b, hb⟩ := not_is_min_iff.1 h in (hf hb).not_is_max ha
+
+protected lemma strict_mono.ite' (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
+  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
+  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → f x < g y) :
+  strict_mono (λ x, if p x then f x else g x) :=
+begin
+  intros x y h,
+  by_cases hy : p y,
+  { have hx : p x := hp h hy,
+    simpa [hx, hy] using hf h },
+  by_cases hx : p x,
+  { simpa [hx, hy] using hfg hx hy h },
+  { simpa [hx, hy] using hg h}
+end
+
+protected lemma strict_mono.ite (hf : strict_mono f) (hg : strict_mono g) {p : α → Prop}
+  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, f x ≤ g x) :
+  strict_mono (λ x, if p x then f x else g x) :=
+hf.ite' hg hp $ λ x y hx hy h, (hf h).trans_le (hfg y)
+
+protected lemma strict_anti.ite' (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
+  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x)
+  (hfg : ∀ ⦃x y⦄, p x → ¬p y → x < y → g y < f x) :
+  strict_anti (λ x, if p x then f x else g x) :=
+(strict_mono.ite' hf.dual_right hg.dual_right hp hfg).dual_right
+
+protected lemma strict_anti.ite (hf : strict_anti f) (hg : strict_anti g) {p : α → Prop}
+  [decidable_pred p] (hp : ∀ ⦃x y⦄, x < y → p y → p x) (hfg : ∀ x, g x ≤ f x) :
+  strict_anti (λ x, if p x then f x else g x) :=
+hf.ite' hg hp $ λ x y hx hy h, (hfg y).trans_lt (hf h)
+
+end preorder
+
+/-! ### Monotonicity under composition -/
+
+section composition
+variables [preorder α] [preorder β] [preorder γ] {g : β → γ} {f : α → β} {s : set α}
+
+protected lemma monotone.comp (hg : monotone g) (hf : monotone f) :
+  monotone (g ∘ f) :=
+λ a b h, hg (hf h)
+
+lemma monotone.comp_antitone (hg : monotone g) (hf : antitone f) :
+  antitone (g ∘ f) :=
+λ a b h, hg (hf h)
+
+protected lemma antitone.comp (hg : antitone g) (hf : antitone f) :
+  monotone (g ∘ f) :=
+λ a b h, hg (hf h)
+
+lemma antitone.comp_monotone (hg : antitone g) (hf : monotone f) :
+  antitone (g ∘ f) :=
+λ a b h, hg (hf h)
+
+protected lemma monotone.iterate {f : α → α} (hf : monotone f) (n : ℕ) : monotone (f^[n]) :=
+nat.rec_on n monotone_id (λ n h, h.comp hf)
+
+protected lemma monotone.comp_monotone_on (hg : monotone g) (hf : monotone_on f s) :
+  monotone_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+lemma monotone.comp_antitone_on (hg : monotone g) (hf : antitone_on f s) :
+  antitone_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+protected lemma antitone.comp_antitone_on (hg : antitone g) (hf : antitone_on f s) :
+  monotone_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+lemma antitone.comp_monotone_on (hg : antitone g) (hf : monotone_on f s) :
+  antitone_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+protected lemma strict_mono.comp (hg : strict_mono g) (hf : strict_mono f) :
+  strict_mono (g ∘ f) :=
+λ a b h, hg (hf h)
+
+lemma strict_mono.comp_strict_anti (hg : strict_mono g) (hf : strict_anti f) :
+  strict_anti (g ∘ f) :=
+λ a b h, hg (hf h)
+
+protected lemma strict_anti.comp (hg : strict_anti g) (hf : strict_anti f) :
+  strict_mono (g ∘ f) :=
+λ a b h, hg (hf h)
+
+lemma strict_anti.comp_strict_mono (hg : strict_anti g) (hf : strict_mono f) :
+  strict_anti (g ∘ f) :=
+λ a b h, hg (hf h)
+
+protected lemma strict_mono.iterate {f : α → α} (hf : strict_mono f) (n : ℕ) :
+  strict_mono (f^[n]) :=
+nat.rec_on n strict_mono_id (λ n h, h.comp hf)
+
+protected lemma strict_mono.comp_strict_mono_on (hg : strict_mono g) (hf : strict_mono_on f s) :
+  strict_mono_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+lemma strict_mono.comp_strict_anti_on (hg : strict_mono g) (hf : strict_anti_on f s) :
+  strict_anti_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+protected lemma strict_anti.comp_strict_anti_on (hg : strict_anti g) (hf : strict_anti_on f s) :
+  strict_mono_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+lemma strict_anti.comp_strict_mono_on (hg : strict_anti g) (hf : strict_mono_on f s) :
+  strict_anti_on (g ∘ f) s :=
+λ a ha b hb h, hg (hf ha hb h)
+
+end composition
+
+namespace list
+
+section fold
+
+theorem foldl_monotone [preorder α] {f : α → β → α} (H : ∀ b, monotone (λ a, f a b)) (l : list β) :
+  monotone (λ a, l.foldl f a) :=
+list.rec_on l (λ _ _, id) (λ i l hl _ _ h, hl (H _ h))
+
+theorem foldr_monotone [preorder β] {f : α → β → β} (H : ∀ a, monotone (f a)) (l : list α) :
+  monotone (λ b, l.foldr f b) :=
+λ _ _ h, list.rec_on l h (λ i l hl, H i hl)
+
+theorem foldl_strict_mono [preorder α] {f : α → β → α} (H : ∀ b, strict_mono (λ a, f a b))
+  (l : list β) : strict_mono (λ a, l.foldl f a) :=
+list.rec_on l (λ _ _, id) (λ i l hl _ _ h, hl (H _ h))
+
+theorem foldr_strict_mono [preorder β] {f : α → β → β} (H : ∀ a, strict_mono (f a)) (l : list α) :
+  strict_mono (λ b, l.foldr f b) :=
+λ _ _ h, list.rec_on l h (λ i l hl, H i hl)
+
+end fold
+
+end list
+
+/-! ### Monotonicity in linear orders  -/
+
+section linear_order
+variables [linear_order α]
+
+section preorder
+variables [preorder β] {f : α → β} {s : set α}
+
+open ordering
+
+lemma monotone.reflect_lt (hf : monotone f) {a b : α} (h : f a < f b) : a < b :=
+lt_of_not_ge (λ h', h.not_le (hf h'))
+
+lemma antitone.reflect_lt (hf : antitone f) {a b : α} (h : f a < f b) : b < a :=
+lt_of_not_ge (λ h', h.not_le (hf h'))
+
+lemma monotone_on.reflect_lt (hf : monotone_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s)
+  (h : f a < f b) :
+  a < b :=
+lt_of_not_ge $ λ h', h.not_le $ hf hb ha h'
+
+lemma antitone_on.reflect_lt (hf : antitone_on f s) {a b : α}  (ha : a ∈ s) (hb : b ∈ s)
+  (h : f a < f b) :
+  b < a :=
+lt_of_not_ge $ λ h', h.not_le $ hf ha hb h'
+
+lemma strict_mono_on.le_iff_le (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
+  f a ≤ f b ↔ a ≤ b :=
+⟨λ h, le_of_not_gt $ λ h', (hf hb ha h').not_le h,
+ λ h, h.lt_or_eq_dec.elim (λ h', (hf ha hb h').le) (λ h', h' ▸ le_rfl)⟩
+
+lemma strict_anti_on.le_iff_le (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
+  f a ≤ f b ↔ b ≤ a :=
+hf.dual_right.le_iff_le hb ha
+
+lemma strict_mono_on.eq_iff_eq (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
+  f a = f b ↔ a = b :=
+⟨λ h, le_antisymm ((hf.le_iff_le ha hb).mp h.le) ((hf.le_iff_le hb ha).mp h.ge),
+ by { rintro rfl, refl, }⟩
+
+lemma strict_anti_on.eq_iff_eq (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
+  f a = f b ↔ b = a :=
+(hf.dual_right.eq_iff_eq ha hb).trans eq_comm
+
+lemma strict_mono_on.lt_iff_lt (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
+  f a < f b ↔ a < b :=
+by rw [lt_iff_le_not_le, lt_iff_le_not_le, hf.le_iff_le ha hb, hf.le_iff_le hb ha]
+
+lemma strict_anti_on.lt_iff_lt (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
+  f a < f b ↔ b < a :=
+hf.dual_right.lt_iff_lt hb ha
+
+lemma strict_mono.le_iff_le (hf : strict_mono f) {a b : α} :
+  f a ≤ f b ↔ a ≤ b :=
+(hf.strict_mono_on set.univ).le_iff_le trivial trivial
+
+lemma strict_anti.le_iff_le (hf : strict_anti f) {a b : α} :
+  f a ≤ f b ↔ b ≤ a :=
+(hf.strict_anti_on set.univ).le_iff_le trivial trivial
+
+lemma strict_mono.lt_iff_lt (hf : strict_mono f) {a b : α} :
+  f a < f b ↔ a < b :=
+(hf.strict_mono_on set.univ).lt_iff_lt trivial trivial
+
+lemma strict_anti.lt_iff_lt (hf : strict_anti f) {a b : α} :
+  f a < f b ↔ b < a :=
+(hf.strict_anti_on set.univ).lt_iff_lt trivial trivial
+
+protected theorem strict_mono_on.compares (hf : strict_mono_on f s) {a b : α} (ha : a ∈ s)
+  (hb : b ∈ s) :
+  ∀ {o : ordering}, o.compares (f a) (f b) ↔ o.compares a b
+| ordering.lt := hf.lt_iff_lt ha hb
+| ordering.eq := ⟨λ h, ((hf.le_iff_le ha hb).1 h.le).antisymm ((hf.le_iff_le hb ha).1 h.symm.le),
+                   congr_arg _⟩
+| ordering.gt := hf.lt_iff_lt hb ha
+
+protected theorem strict_anti_on.compares (hf : strict_anti_on f s) {a b : α} (ha : a ∈ s)
+  (hb : b ∈ s) {o : ordering} :
+  o.compares (f a) (f b) ↔ o.compares b a :=
+to_dual_compares_to_dual.trans $ hf.dual_right.compares hb ha
+
+protected theorem strict_mono.compares (hf : strict_mono f) {a b : α} {o : ordering} :
+  o.compares (f a) (f b) ↔ o.compares a b :=
+(hf.strict_mono_on set.univ).compares trivial trivial
+
+protected theorem strict_anti.compares (hf : strict_anti f) {a b : α} {o : ordering} :
+  o.compares (f a) (f b) ↔ o.compares b a :=
+(hf.strict_anti_on set.univ).compares trivial trivial
+
+lemma strict_mono.injective (hf : strict_mono f) : injective f :=
+λ x y h, show compares eq x y, from hf.compares.1 h
+
+lemma strict_anti.injective (hf : strict_anti f) : injective f :=
+λ x y h, show compares eq x y, from hf.compares.1 h.symm
+
+lemma strict_mono.maximal_of_maximal_image (hf : strict_mono f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
+  x ≤ a :=
+hf.le_iff_le.mp (hmax (f x))
+
+lemma strict_mono.minimal_of_minimal_image (hf : strict_mono f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
+  a ≤ x :=
+hf.le_iff_le.mp (hmin (f x))
+
+lemma strict_anti.minimal_of_maximal_image (hf : strict_anti f) {a} (hmax : ∀ p, p ≤ f a) (x : α) :
+  a ≤ x :=
+hf.le_iff_le.mp (hmax (f x))
+
+lemma strict_anti.maximal_of_minimal_image (hf : strict_anti f) {a} (hmin : ∀ p, f a ≤ p) (x : α) :
+  x ≤ a :=
+hf.le_iff_le.mp (hmin (f x))
+
+end preorder
+
+section partial_order
+variables [partial_order β] {f : α → β}
+
+lemma monotone.strict_mono_iff_injective (hf : monotone f) :
+  strict_mono f ↔ injective f :=
+⟨λ h, h.injective, hf.strict_mono_of_injective⟩
+
+lemma antitone.strict_anti_iff_injective (hf : antitone f) :
+  strict_anti f ↔ injective f :=
+⟨λ h, h.injective, hf.strict_anti_of_injective⟩
+
+end partial_order
+
+variables [linear_order β] {f : α → β} {s : set α} {x y : α}
+
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_not_antitone_iff_exists_le_le :
+  ¬ monotone f ∧ ¬ antitone f ↔ ∃ a b c, a ≤ b ∧ b ≤ c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+begin
+  simp_rw [monotone, antitone, not_forall, not_le],
+  refine iff.symm ⟨_, _⟩,
+  { rintro ⟨a, b, c, hab, hbc, ⟨hfab, hfcb⟩ | ⟨hfba, hfbc⟩⟩,
+    exacts [⟨⟨_, _, hbc, hfcb⟩, _, _, hab, hfab⟩, ⟨⟨_, _, hab, hfba⟩, _, _, hbc, hfbc⟩] },
+  rintro ⟨⟨a, b, hab, hfba⟩, c, d, hcd, hfcd⟩,
+  obtain hda | had := le_total d a,
+  { obtain hfad | hfda := le_total (f a) (f d),
+    { exact ⟨c, d, b, hcd, hda.trans hab, or.inl ⟨hfcd, hfba.trans_le hfad⟩⟩ },
+    { exact ⟨c, a, b, hcd.trans hda, hab, or.inl ⟨hfcd.trans_le hfda, hfba⟩⟩ } },
+  obtain hac | hca := le_total a c,
+  { obtain hfdb | hfbd := le_or_lt (f d) (f b),
+    { exact ⟨a, c, d, hac, hcd, or.inr ⟨hfcd.trans $ hfdb.trans_lt hfba, hfcd⟩⟩ },
+    obtain hfca | hfac := lt_or_le (f c) (f a),
+    { exact ⟨a, c, d, hac, hcd, or.inr ⟨hfca, hfcd⟩⟩ },
+    obtain hbd | hdb := le_total b d,
+    { exact ⟨a, b, d, hab, hbd, or.inr ⟨hfba, hfbd⟩⟩ },
+    { exact ⟨a, d, b, had, hdb, or.inl ⟨hfac.trans_lt hfcd, hfbd⟩⟩ } },
+  { obtain hfdb | hfbd := le_or_lt (f d) (f b),
+    { exact ⟨c, a, b, hca, hab, or.inl ⟨hfcd.trans $ hfdb.trans_lt hfba, hfba⟩⟩ },
+    obtain hfca | hfac := lt_or_le (f c) (f a),
+    { exact ⟨c, a, b, hca, hab, or.inl ⟨hfca, hfba⟩⟩ },
+    obtain hbd | hdb := le_total b d,
+    { exact ⟨a, b, d, hab, hbd, or.inr ⟨hfba, hfbd⟩⟩ },
+    { exact ⟨a, d, b, had, hdb, or.inl ⟨hfac.trans_lt hfcd, hfbd⟩⟩ } }
+end
+
+/-- A function between linear orders which is neither monotone nor antitone makes a dent upright or
+downright. -/
+lemma not_monotone_not_antitone_iff_exists_lt_lt :
+  ¬ monotone f ∧ ¬ antitone f ↔ ∃ a b c, a < b ∧ b < c ∧
+    (f a < f b ∧ f c < f b ∨ f b < f a ∧ f b < f c) :=
+begin
+  simp_rw [not_monotone_not_antitone_iff_exists_le_le, ←and_assoc],
+  refine exists₃_congr (λ a b c, and_congr_left $ λ h, (ne.le_iff_lt _).and $ ne.le_iff_lt _);
+    rintro rfl; simpa using h,
+end
+
+/-!
+### Strictly monotone functions and `cmp`
+-/
+
+lemma strict_mono_on.cmp_map_eq (hf : strict_mono_on f s) (hx : x ∈ s) (hy : y ∈ s) :
+  cmp (f x) (f y) = cmp x y :=
+((hf.compares hx hy).2 (cmp_compares x y)).cmp_eq
+
+lemma strict_mono.cmp_map_eq (hf : strict_mono f) (x y : α) : cmp (f x) (f y) = cmp x y :=
+(hf.strict_mono_on set.univ).cmp_map_eq trivial trivial
+
+lemma strict_anti_on.cmp_map_eq (hf : strict_anti_on f s) (hx : x ∈ s) (hy : y ∈ s) :
+  cmp (f x) (f y) = cmp y x :=
+hf.dual_right.cmp_map_eq hy hx
+
+lemma strict_anti.cmp_map_eq (hf : strict_anti f) (x y : α) : cmp (f x) (f y) = cmp y x :=
+(hf.strict_anti_on set.univ).cmp_map_eq trivial trivial
+
+end linear_order
+
+/-! ### Monotonicity in `ℕ` and `ℤ` -/
+
+section preorder
+variables [preorder α]
+
+lemma nat.rel_of_forall_rel_succ_of_le_of_lt (r : β → β → Prop) [is_trans β r]
+  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
+  (hab : a ≤ b) (hbc : b < c) :
+  r (f b) (f c) :=
+begin
+  induction hbc with k b_lt_k r_b_k,
+  exacts [h _ hab, trans r_b_k (h _ (hab.trans_lt b_lt_k).le)]
+end
+
+lemma nat.rel_of_forall_rel_succ_of_le_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
+  {f : ℕ → β} {a : ℕ} (h : ∀ n, a ≤ n → r (f n) (f (n + 1))) ⦃b c : ℕ⦄
+  (hab : a ≤ b) (hbc : b ≤ c) :
+  r (f b) (f c) :=
+hbc.eq_or_lt.elim (λ h, h ▸ refl _) (nat.rel_of_forall_rel_succ_of_le_of_lt r h hab)
+
+lemma nat.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
+  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a < b) : r (f a) (f b) :=
+nat.rel_of_forall_rel_succ_of_le_of_lt r (λ n _, h n) le_rfl hab
+
+lemma nat.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
+  {f : ℕ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℕ⦄ (hab : a ≤ b) : r (f a) (f b) :=
+nat.rel_of_forall_rel_succ_of_le_of_le r (λ n _, h n) le_rfl hab
+
+lemma monotone_nat_of_le_succ {f : ℕ → α} (hf : ∀ n, f n ≤ f (n + 1)) :
+  monotone f :=
+nat.rel_of_forall_rel_succ_of_le (≤) hf
+
+lemma antitone_nat_of_succ_le {f : ℕ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
+@monotone_nat_of_le_succ αᵒᵈ _ _ hf
+
+lemma strict_mono_nat_of_lt_succ {f : ℕ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
+nat.rel_of_forall_rel_succ_of_lt (<) hf
+
+lemma strict_anti_nat_of_succ_lt {f : ℕ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
+@strict_mono_nat_of_lt_succ αᵒᵈ _ f hf
+
+namespace nat
+
+/-- If `α` is a preorder with no maximal elements, then there exists a strictly monotone function
+`ℕ → α` with any prescribed value of `f 0`. -/
+lemma exists_strict_mono' [no_max_order α] (a : α) : ∃ f : ℕ → α, strict_mono f ∧ f 0 = a :=
+begin
+  have := (λ x : α, exists_gt x),
+  choose g hg,
+  exact ⟨λ n, nat.rec_on n a (λ _, g), strict_mono_nat_of_lt_succ $ λ n, hg _, rfl⟩
+end
+
+/-- If `α` is a preorder with no maximal elements, then there exists a strictly antitone function
+`ℕ → α` with any prescribed value of `f 0`. -/
+lemma exists_strict_anti' [no_min_order α] (a : α) : ∃ f : ℕ → α, strict_anti f ∧ f 0 = a :=
+exists_strict_mono' (order_dual.to_dual a)
+
+variable (α)
+
+/-- If `α` is a nonempty preorder with no maximal elements, then there exists a strictly monotone
+function `ℕ → α`. -/
+lemma exists_strict_mono [nonempty α] [no_max_order α] : ∃ f : ℕ → α, strict_mono f :=
+let ⟨a⟩ := ‹nonempty α›, ⟨f, hf, hfa⟩ := exists_strict_mono' a in ⟨f, hf⟩
+
+/-- If `α` is a nonempty preorder with no minimal elements, then there exists a strictly antitone
+function `ℕ → α`. -/
+lemma exists_strict_anti [nonempty α] [no_min_order α] : ∃ f : ℕ → α, strict_anti f :=
+exists_strict_mono αᵒᵈ
+
+end nat
+
+lemma int.rel_of_forall_rel_succ_of_lt (r : β → β → Prop) [is_trans β r]
+  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a < b) : r (f a) (f b) :=
+begin
+  rcases hab.dest with ⟨n, rfl⟩, clear hab,
+  induction n with n ihn,
+  { rw int.coe_nat_one, apply h },
+  { rw [int.coe_nat_succ, ← int.add_assoc],
+    exact trans ihn (h _) }
+end
+
+lemma int.rel_of_forall_rel_succ_of_le (r : β → β → Prop) [is_refl β r] [is_trans β r]
+  {f : ℤ → β} (h : ∀ n, r (f n) (f (n + 1))) ⦃a b : ℤ⦄ (hab : a ≤ b) : r (f a) (f b) :=
+hab.eq_or_lt.elim (λ h, h ▸ refl _) (λ h', int.rel_of_forall_rel_succ_of_lt r h h')
+
+lemma monotone_int_of_le_succ {f : ℤ → α} (hf : ∀ n, f n ≤ f (n + 1)) : monotone f :=
+int.rel_of_forall_rel_succ_of_le (≤) hf
+
+lemma antitone_int_of_succ_le {f : ℤ → α} (hf : ∀ n, f (n + 1) ≤ f n) : antitone f :=
+int.rel_of_forall_rel_succ_of_le (≥) hf
+
+lemma strict_mono_int_of_lt_succ {f : ℤ → α} (hf : ∀ n, f n < f (n + 1)) : strict_mono f :=
+int.rel_of_forall_rel_succ_of_lt (<) hf
+
+lemma strict_anti_int_of_succ_lt {f : ℤ → α} (hf : ∀ n, f (n + 1) < f n) : strict_anti f :=
+int.rel_of_forall_rel_succ_of_lt (>) hf
+
+namespace int
+
+variables (α) [nonempty α] [no_min_order α] [no_max_order α]
+
+/-- If `α` is a nonempty preorder with no minimal or maximal elements, then there exists a strictly
+monotone function `f : ℤ → α`. -/
+lemma exists_strict_mono : ∃ f : ℤ → α, strict_mono f :=
+begin
+  inhabit α,
+  rcases nat.exists_strict_mono' (default : α) with ⟨f, hf, hf₀⟩,
+  rcases nat.exists_strict_anti' (default : α) with ⟨g, hg, hg₀⟩,
+  refine ⟨λ n, int.cases_on n f (λ n, g (n + 1)), strict_mono_int_of_lt_succ _⟩,
+  rintro (n|_|n),
+  { exact hf n.lt_succ_self },
+  { show g 1 < f 0,
+    rw [hf₀, ← hg₀],
+    exact hg nat.zero_lt_one },
+  { exact hg (nat.lt_succ_self _) }
+end
+
+/-- If `α` is a nonempty preorder with no minimal or maximal elements, then there exists a strictly
+antitone function `f : ℤ → α`. -/
+lemma exists_strict_anti : ∃ f : ℤ → α, strict_anti f := exists_strict_mono αᵒᵈ
+
+end int
+
+-- TODO@Yael: Generalize the following four to succ orders
+/-- If `f` is a monotone function from `ℕ` to a preorder such that `x` lies between `f n` and
+  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
+lemma monotone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : monotone f) (n : ℕ) {x : α}
+  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℕ) :
+  f a ≠ x :=
+by { rintro rfl, exact (hf.reflect_lt h1).not_le (nat.le_of_lt_succ $ hf.reflect_lt h2) }
+
+/-- If `f` is an antitone function from `ℕ` to a preorder such that `x` lies between `f (n + 1)` and
+`f n`, then `x` doesn't lie in the range of `f`. -/
+lemma antitone.ne_of_lt_of_lt_nat {f : ℕ → α} (hf : antitone f)
+  (n : ℕ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℕ) : f a ≠ x :=
+by { rintro rfl, exact (hf.reflect_lt h2).not_le (nat.le_of_lt_succ $ hf.reflect_lt h1) }
+
+/-- If `f` is a monotone function from `ℤ` to a preorder and `x` lies between `f n` and
+  `f (n + 1)`, then `x` doesn't lie in the range of `f`. -/
+lemma monotone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : monotone f) (n : ℤ) {x : α}
+  (h1 : f n < x) (h2 : x < f (n + 1)) (a : ℤ) :
+  f a ≠ x :=
+by { rintro rfl, exact (hf.reflect_lt h1).not_le (int.le_of_lt_add_one $ hf.reflect_lt h2) }
+
+/-- If `f` is an antitone function from `ℤ` to a preorder and `x` lies between `f (n + 1)` and
+`f n`, then `x` doesn't lie in the range of `f`. -/
+lemma antitone.ne_of_lt_of_lt_int {f : ℤ → α} (hf : antitone f)
+  (n : ℤ) {x : α} (h1 : f (n + 1) < x) (h2 : x < f n) (a : ℤ) : f a ≠ x :=
+by { rintro rfl, exact (hf.reflect_lt h2).not_le (int.le_of_lt_add_one $ hf.reflect_lt h1) }
+
+lemma strict_mono.id_le {φ : ℕ → ℕ} (h : strict_mono φ) : ∀ n, n ≤ φ n :=
+λ n, nat.rec_on n (nat.zero_le _)
+  (λ n hn, nat.succ_le_of_lt (hn.trans_lt $ h $ nat.lt_succ_self n))
+
+end preorder
+
+lemma subtype.mono_coe [preorder α] (t : set α) : monotone (coe : (subtype t) → α) :=
+λ x y, id
+
+lemma subtype.strict_mono_coe [preorder α] (t : set α) : strict_mono (coe : (subtype t) → α) :=
+λ x y, id
+
+
+section preorder
+variables [preorder α] [preorder β] [preorder γ] [preorder δ] {f : α → γ} {g : β → δ} {a b : α}
+
+lemma monotone_fst : monotone (@prod.fst α β) := λ a b, and.left
+lemma monotone_snd : monotone (@prod.snd α β) := λ a b, and.right
+
+lemma monotone.prod_map (hf : monotone f) (hg : monotone g) : monotone (prod.map f g) :=
+λ a b h, ⟨hf h.1, hg h.2⟩
+
+lemma antitone.prod_map (hf : antitone f) (hg : antitone g) : antitone (prod.map f g) :=
+λ a b h, ⟨hf h.1, hg h.2⟩
+
+end preorder
+
+section partial_order
+variables [partial_order α] [partial_order β] [preorder γ] [preorder δ]
+  {f : α → γ} {g : β → δ}
+
+lemma strict_mono.prod_map (hf : strict_mono f) (hg : strict_mono g) : strict_mono (prod.map f g) :=
+λ a b, by { simp_rw prod.lt_iff,
+  exact or.imp (and.imp hf.imp hg.monotone.imp) (and.imp hf.monotone.imp hg.imp) }
+
+lemma strict_anti.prod_map (hf : strict_anti f) (hg : strict_anti g) : strict_anti (prod.map f g) :=
+λ a b, by { simp_rw prod.lt_iff,
+  exact or.imp (and.imp hf.imp hg.antitone.imp) (and.imp hf.antitone.imp hg.imp) }
+
+end partial_order
+
+/-! ### Pi types -/
+
+namespace function
+variables [preorder α] [decidable_eq ι] [Π i, preorder (π i)] {f : Π i, π i} {i : ι}
+
+lemma update_mono : monotone (f.update i) := λ a b, update_le_update_iff'.2
+lemma update_strict_mono : strict_mono (f.update i) := λ a b, update_lt_update_iff.2
+
+lemma const_mono : monotone (const β : α → β → α) := λ a b h i, h
+lemma const_strict_mono [nonempty β] : strict_mono (const β : α → β → α) := λ a b, const_lt_const.2
+
+end function
diff --git a/src/order/monotone/extension.lean b/src/order/monotone/extension.lean
new file mode 100644
index 0000000000000..4336bfbe6b939
--- /dev/null
+++ b/src/order/monotone/extension.lean
@@ -0,0 +1,58 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel, Yury Kudryashov
+-/
+import order.conditionally_complete_lattice.basic
+
+/-!
+# Extension of a monotone function from a set to the whole space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that if a function is monotone and is bounded on a set `s`, then it admits a
+monotone extension to the whole space.
+-/
+
+open set
+
+variables {α β : Type*} [linear_order α] [conditionally_complete_linear_order β]
+  {f : α → β} {s : set α} {a b : α}
+
+/-- If a function is monotone and is bounded on a set `s`, then it admits a monotone extension to
+the whole space. -/
+lemma monotone_on.exists_monotone_extension (h : monotone_on f s) (hl : bdd_below (f '' s))
+  (hu : bdd_above (f '' s)) :
+  ∃ g : α → β, monotone g ∧ eq_on f g s :=
+begin
+  /- The extension is defined by `f x = f a` for `x ≤ a`, and `f x` is the supremum of the values
+  of `f`  to the left of `x` for `x ≥ a`. -/
+  classical,
+  rcases hl with ⟨a, ha⟩,
+  have hu' : ∀ x, bdd_above (f '' (Iic x ∩ s)),
+    from λ x, hu.mono (image_subset _ (inter_subset_right _ _)),
+  set g : α → β := λ x, if disjoint (Iic x) s then a else Sup (f '' (Iic x ∩ s)),
+  have hgs : eq_on f g s,
+  { intros x hx,
+    simp only [g],
+    have : is_greatest (Iic x ∩ s) x, from ⟨⟨right_mem_Iic, hx⟩, λ y hy, hy.1⟩,
+    rw [if_neg this.nonempty.not_disjoint,
+      ((h.mono $ inter_subset_right _ _).map_is_greatest this).cSup_eq] },
+  refine ⟨g, λ x y hxy, _, hgs⟩,
+  by_cases hx : disjoint (Iic x) s; by_cases hy : disjoint (Iic y) s;
+    simp only [g, if_pos, if_neg, not_false_iff, *],
+  { rcases not_disjoint_iff_nonempty_inter.1 hy with ⟨z, hz⟩,
+    exact le_cSup_of_le (hu' _) (mem_image_of_mem _ hz) (ha $ mem_image_of_mem _ hz.2) },
+  { exact (hx $ hy.mono_left $ Iic_subset_Iic.2 hxy).elim },
+  { rw [not_disjoint_iff_nonempty_inter] at hx hy,
+    refine cSup_le_cSup (hu' _) (hx.image _) (image_subset _ _),
+    exact inter_subset_inter_left _ (Iic_subset_Iic.2 hxy) },
+end
+
+/-- If a function is antitone and is bounded on a set `s`, then it admits an antitone extension to
+the whole space. -/
+lemma antitone_on.exists_antitone_extension (h : antitone_on f s) (hl : bdd_below (f '' s))
+  (hu : bdd_above (f '' s)) :
+  ∃ g : α → β, antitone g ∧ eq_on f g s :=
+h.dual_right.exists_monotone_extension hu hl
diff --git a/src/order/monovary.lean b/src/order/monotone/monovary.lean
similarity index 92%
rename from src/order/monovary.lean
rename to src/order/monotone/monovary.lean
index e9f9d840555e4..d050976376e41 100644
--- a/src/order/monovary.lean
+++ b/src/order/monotone/monovary.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import data.set.basic
+import data.set.image
 
 /-!
 # Monovariance of functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Two functions *vary together* if a strict change in the first implies a change in the second.
 
 This is in some sense a way to say that two functions `f : ι → α`, `g : ι → β` are "monotone
@@ -159,6 +162,20 @@ lemma antivary_on.dual_left : antivary_on f g s → monovary_on (to_dual ∘ f)
 lemma monovary_on.dual_right : monovary_on f g s → antivary_on f (to_dual ∘ g) s := swap₂
 lemma antivary_on.dual_right : antivary_on f g s → monovary_on f (to_dual ∘ g) s := swap₂
 
+@[simp] lemma monovary_to_dual_left : monovary (to_dual ∘ f) g ↔ antivary f g := iff.rfl
+@[simp] lemma monovary_to_dual_right : monovary f (to_dual ∘ g) ↔ antivary f g := forall_swap
+@[simp] lemma antivary_to_dual_left : antivary (to_dual ∘ f) g ↔ monovary f g := iff.rfl
+@[simp] lemma antivary_to_dual_right : antivary f (to_dual ∘ g) ↔ monovary f g := forall_swap
+
+@[simp] lemma monovary_on_to_dual_left : monovary_on (to_dual ∘ f) g s ↔ antivary_on f g s :=
+iff.rfl
+@[simp] lemma monovary_on_to_dual_right : monovary_on f (to_dual ∘ g) s ↔ antivary_on f g s :=
+forall₂_swap
+@[simp] lemma antivary_on_to_dual_left : antivary_on (to_dual ∘ f) g s ↔ monovary_on f g s :=
+iff.rfl
+@[simp] lemma antivary_on_to_dual_right : antivary_on f (to_dual ∘ g) s ↔ monovary_on f g s :=
+forall₂_swap
+
 end order_dual
 
 section partial_order
diff --git a/src/order/monotone/odd.lean b/src/order/monotone/odd.lean
new file mode 100644
index 0000000000000..54fa7633b1132
--- /dev/null
+++ b/src/order/monotone/odd.lean
@@ -0,0 +1,55 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import order.monotone.union
+import algebra.order.group.instances
+
+/-!
+# Monotonicity of odd functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+An odd function on a linear ordered additive commutative group `G` is monotone on the whole group
+provided that is is monotone on `set.Ici 0`, see `monotone_of_odd_of_monotone_on_nonneg`. We also
+prove versions of this lemma for `antitone`, `strict_mono`, and `strict_anti`.
+-/
+
+open set
+variables {G H : Type*} [linear_ordered_add_comm_group G] [ordered_add_comm_group H]
+
+/-- An odd function on a linear ordered additive commutative group is strictly monotone on the whole
+group provided that it is strictly monotone on `set.Ici 0`. -/
+lemma strict_mono_of_odd_strict_mono_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
+  (h₂ : strict_mono_on f (Ici 0)) :
+  strict_mono f :=
+begin
+  refine strict_mono_on.Iic_union_Ici (λ x hx y hy hxy, neg_lt_neg_iff.1 _) h₂,
+  rw [← h₁, ← h₁],
+  exact h₂ (neg_nonneg.2 hy) (neg_nonneg.2 hx) (neg_lt_neg hxy)
+end
+
+/-- An odd function on a linear ordered additive commutative group is strictly antitone on the whole
+group provided that it is strictly antitone on `set.Ici 0`. -/
+lemma strict_anti_of_odd_strict_anti_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
+  (h₂ : strict_anti_on f (Ici 0)) :
+  strict_anti f :=
+@strict_mono_of_odd_strict_mono_on_nonneg G Hᵒᵈ _ _ _ h₁ h₂
+
+/-- An odd function on a linear ordered additive commutative group is monotone on the whole group
+provided that it is monotone on `set.Ici 0`. -/
+lemma monotone_of_odd_of_monotone_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
+  (h₂ : monotone_on f (Ici 0)) : monotone f :=
+begin
+  refine monotone_on.Iic_union_Ici (λ x hx y hy hxy, neg_le_neg_iff.1 _) h₂,
+  rw [← h₁, ← h₁],
+  exact h₂ (neg_nonneg.2 hy) (neg_nonneg.2 hx) (neg_le_neg hxy)
+end
+
+/-- An odd function on a linear ordered additive commutative group is antitone on the whole group
+provided that it is monotone on `set.Ici 0`. -/
+lemma antitone_of_odd_of_monotone_on_nonneg {f : G → H} (h₁ : ∀ x, f (-x) = -f x)
+  (h₂ : antitone_on f (Ici 0)) : antitone f :=
+@monotone_of_odd_of_monotone_on_nonneg G Hᵒᵈ _ _ _ h₁ h₂
diff --git a/src/order/monotone/union.lean b/src/order/monotone/union.lean
new file mode 100644
index 0000000000000..f1fe9ac9d7aae
--- /dev/null
+++ b/src/order/monotone/union.lean
@@ -0,0 +1,117 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov, Sébastien Gouëzel
+-/
+import order.bounds.basic
+
+/-!
+# Monotonicity on intervals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that a function is (strictly) monotone (or antitone) on a linear order `α`
+provided that it is (strictly) monotone on `(-∞, a]` and on `[a, +∞)`. This is a special case
+of a more general statement where one deduces monotonicity on a union from monotonicity on each
+set.
+-/
+
+open set
+variables {α β : Type*} [linear_order α] [preorder β] {a : α} {f : α → β}
+
+/-- If `f` is strictly monotone both on `s` and `t`, with `s` to the left of `t` and the center
+point belonging to both `s` and `t`, then `f` is strictly monotone on `s ∪ t` -/
+protected lemma strict_mono_on.union {s t : set α} {c : α} (h₁ : strict_mono_on f s)
+  (h₂ : strict_mono_on f t) (hs : is_greatest s c) (ht : is_least t c) :
+  strict_mono_on f (s ∪ t) :=
+begin
+  have A : ∀ x, x ∈ s ∪ t → x ≤ c → x ∈ s,
+  { assume x hx hxc,
+    cases hx, { exact hx },
+    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact hs.1 },
+    exact (lt_irrefl _ (h'x.trans_le (ht.2 hx))).elim },
+  have B : ∀ x, x ∈ s ∪ t → c ≤ x → x ∈ t,
+  { assume x hx hxc,
+    cases hx, swap, { exact hx },
+    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact ht.1 },
+    exact (lt_irrefl _ (h'x.trans_le (hs.2 hx))).elim },
+  assume x hx y hy hxy,
+  rcases lt_or_le x c with hxc|hcx,
+  { have xs : x ∈ s, from A _ hx hxc.le,
+    rcases lt_or_le y c with hyc|hcy,
+    { exact h₁ xs (A _ hy hyc.le) hxy },
+    { exact (h₁ xs hs.1 hxc).trans_le (h₂.monotone_on ht.1 (B _ hy hcy) hcy) } },
+  { have xt : x ∈ t, from B _ hx hcx,
+    have yt : y ∈ t, from B _ hy (hcx.trans hxy.le),
+    exact h₂ xt yt hxy }
+end
+
+/-- If `f` is strictly monotone both on `(-∞, a]` and `[a, ∞)`, then it is strictly monotone on the
+whole line. -/
+protected lemma strict_mono_on.Iic_union_Ici (h₁ : strict_mono_on f (Iic a))
+  (h₂ : strict_mono_on f (Ici a)) : strict_mono f :=
+begin
+  rw [← strict_mono_on_univ, ← @Iic_union_Ici _ _ a],
+  exact strict_mono_on.union h₁ h₂ is_greatest_Iic is_least_Ici,
+end
+
+/-- If `f` is strictly antitone both on `s` and `t`, with `s` to the left of `t` and the center
+point belonging to both `s` and `t`, then `f` is strictly antitone on `s ∪ t` -/
+protected lemma strict_anti_on.union {s t : set α} {c : α} (h₁ : strict_anti_on f s)
+  (h₂ : strict_anti_on f t) (hs : is_greatest s c) (ht : is_least t c) :
+  strict_anti_on f (s ∪ t) :=
+(h₁.dual_right.union h₂.dual_right hs ht).dual_right
+
+/-- If `f` is strictly antitone both on `(-∞, a]` and `[a, ∞)`, then it is strictly antitone on the
+whole line. -/
+protected lemma strict_anti_on.Iic_union_Ici (h₁ : strict_anti_on f (Iic a))
+  (h₂ : strict_anti_on f (Ici a)) : strict_anti f :=
+(h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right
+
+/-- If `f` is monotone both on `s` and `t`, with `s` to the left of `t` and the center
+point belonging to both `s` and `t`, then `f` is monotone on `s ∪ t` -/
+protected lemma monotone_on.union_right {s t : set α} {c : α} (h₁ : monotone_on f s)
+  (h₂ : monotone_on f t) (hs : is_greatest s c) (ht : is_least t c) :
+  monotone_on f (s ∪ t) :=
+begin
+  have A : ∀ x, x ∈ s ∪ t → x ≤ c → x ∈ s,
+  { assume x hx hxc,
+    cases hx, { exact hx },
+    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact hs.1 },
+    exact (lt_irrefl _ (h'x.trans_le (ht.2 hx))).elim },
+  have B : ∀ x, x ∈ s ∪ t → c ≤ x → x ∈ t,
+  { assume x hx hxc,
+    cases hx, swap, { exact hx },
+    rcases eq_or_lt_of_le hxc with rfl|h'x, { exact ht.1 },
+    exact (lt_irrefl _ (h'x.trans_le (hs.2 hx))).elim },
+  assume x hx y hy hxy,
+  rcases lt_or_le x c with hxc|hcx,
+  { have xs : x ∈ s, from A _ hx hxc.le,
+    rcases lt_or_le y c with hyc|hcy,
+    { exact h₁ xs (A _ hy hyc.le) hxy },
+    { exact (h₁ xs hs.1 hxc.le).trans (h₂ ht.1 (B _ hy hcy) hcy) } },
+  { have xt : x ∈ t, from B _ hx hcx,
+    have yt : y ∈ t, from B _ hy (hcx.trans hxy),
+    exact h₂ xt yt hxy }
+end
+
+/-- If `f` is monotone both on `(-∞, a]` and `[a, ∞)`, then it is monotone on the whole line. -/
+protected lemma monotone_on.Iic_union_Ici (h₁ : monotone_on f (Iic a))
+  (h₂ : monotone_on f (Ici a)) : monotone f :=
+begin
+  rw [← monotone_on_univ, ← @Iic_union_Ici _ _ a],
+  exact monotone_on.union_right h₁ h₂ is_greatest_Iic is_least_Ici
+end
+
+/-- If `f` is antitone both on `s` and `t`, with `s` to the left of `t` and the center
+point belonging to both `s` and `t`, then `f` is antitone on `s ∪ t` -/
+protected lemma antitone_on.union_right {s t : set α} {c : α} (h₁ : antitone_on f s)
+  (h₂ : antitone_on f t) (hs : is_greatest s c) (ht : is_least t c) :
+  antitone_on f (s ∪ t) :=
+(h₁.dual_right.union_right h₂.dual_right hs ht).dual_right
+
+/-- If `f` is antitone both on `(-∞, a]` and `[a, ∞)`, then it is antitone on the whole line. -/
+protected lemma antitone_on.Iic_union_Ici (h₁ : antitone_on f (Iic a))
+  (h₂ : antitone_on f (Ici a)) : antitone f :=
+(h₁.dual_right.Iic_union_Ici h₂.dual_right).dual_right
diff --git a/src/order/omega_complete_partial_order.lean b/src/order/omega_complete_partial_order.lean
index cbd3fb890ebb2..38b71e8c1dc8e 100644
--- a/src/order/omega_complete_partial_order.lean
+++ b/src/order/omega_complete_partial_order.lean
@@ -6,12 +6,15 @@ Authors: Simon Hudon
 import control.monad.basic
 import data.part
 import order.hom.order
-import tactic.monotonicity
+import data.nat.order.basic
 import tactic.wlog
 
 /-!
 # Omega Complete Partial Orders
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 An omega-complete partial order is a partial order with a supremum
 operation on increasing sequences indexed by natural numbers (which we
 call `ωSup`). In this sense, it is strictly weaker than join complete
@@ -97,10 +100,10 @@ variables [preorder α] [preorder β] [preorder γ]
 instance : has_coe_to_fun (chain α) (λ _, ℕ → α) := order_hom.has_coe_to_fun
 
 instance [inhabited α] : inhabited (chain α) :=
-⟨ ⟨ λ _, default, λ _ _ _, le_rfl ⟩ ⟩
+⟨⟨default, λ _ _ _, le_rfl⟩⟩
 
 instance : has_mem α (chain α) :=
-⟨λa (c : ℕ →o α), ∃ i, a = c i⟩
+⟨λ a (c : ℕ →o α), ∃ i, a = c i⟩
 
 variables (c c' : chain α)
 variables (f : α →o β)
@@ -281,7 +284,7 @@ lemma eq_of_chain {c : chain (part α)} {a b : α} (ha : some a ∈ c) (hb : som
 begin
   cases ha with i ha, replace ha := ha.symm,
   cases hb with j hb, replace hb := hb.symm,
-  wlog h : i ≤ j := le_total i j using [a b i j, b a j i],
+  wlog h : i ≤ j, { exact (this j hb i ha (le_of_not_le h)).symm },
   rw [eq_some_iff] at ha hb,
   have := c.monotone h _ ha, apply mem_unique this hb
 end
diff --git a/src/order/ord_continuous.lean b/src/order/ord_continuous.lean
index f89d5c73a0fc7..d4a4f24ce34f7 100644
--- a/src/order/ord_continuous.lean
+++ b/src/order/ord_continuous.lean
@@ -3,13 +3,15 @@ Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Johannes Hölzl
 -/
-import order.conditionally_complete_lattice
-import logic.function.iterate
-import order.rel_iso
+import order.conditionally_complete_lattice.basic
+import order.rel_iso.basic
 
 /-!
 # Order continuity
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that a function is *left order continuous* if it sends all least upper bounds
 to least upper bounds. The order dual notion is called *right order continuity*.
 
diff --git a/src/order/order_dual.lean b/src/order/order_dual.lean
deleted file mode 100644
index b11185399d059..0000000000000
--- a/src/order/order_dual.lean
+++ /dev/null
@@ -1,66 +0,0 @@
-/-
-Copyright (c) 2020 Johan Commelin, Damiano Testa. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin, Damiano Testa
--/
-import logic.equiv.basic
-import logic.nontrivial
-import order.basic
-
-/-!
-# Initial lemmas to work with the `order_dual`
-
-## Definitions
-`to_dual` and `of_dual` the order reversing identity maps, bundled as equivalences.
-
-## Basic Lemmas to convert between an order and its dual
-
-This file is similar to algebra/group/type_tags.lean
--/
-
-open function
-
-universes u v w
-variables {α : Type u} {β : Type v} {γ : Type w} {r : α → α → Prop}
-
-namespace order_dual
-
-instance [nontrivial α] : nontrivial αᵒᵈ := by delta order_dual; assumption
-
-/-- `to_dual` is the identity function to the `order_dual` of a linear order.  -/
-def to_dual : α ≃ αᵒᵈ := ⟨id, id, λ h, rfl, λ h, rfl⟩
-
-/-- `of_dual` is the identity function from the `order_dual` of a linear order.  -/
-def of_dual : αᵒᵈ ≃ α := to_dual.symm
-
-@[simp] lemma to_dual_symm_eq : (@to_dual α).symm = of_dual := rfl
-@[simp] lemma of_dual_symm_eq : (@of_dual α).symm = to_dual := rfl
-@[simp] lemma to_dual_of_dual (a : αᵒᵈ) : to_dual (of_dual a) = a := rfl
-@[simp] lemma of_dual_to_dual (a : α) : of_dual (to_dual a) = a := rfl
-
-@[simp] lemma to_dual_inj {a b : α} : to_dual a = to_dual b ↔ a = b := iff.rfl
-@[simp] lemma of_dual_inj {a b : αᵒᵈ} : of_dual a = of_dual b ↔ a = b := iff.rfl
-
-@[simp] lemma to_dual_le_to_dual [has_le α] {a b : α} : to_dual a ≤ to_dual b ↔ b ≤ a := iff.rfl
-@[simp] lemma to_dual_lt_to_dual [has_lt α] {a b : α} : to_dual a < to_dual b ↔ b < a := iff.rfl
-@[simp] lemma of_dual_le_of_dual [has_le α] {a b : αᵒᵈ} : of_dual a ≤ of_dual b ↔ b ≤ a := iff.rfl
-@[simp] lemma of_dual_lt_of_dual [has_lt α] {a b : αᵒᵈ} : of_dual a < of_dual b ↔ b < a := iff.rfl
-
-lemma le_to_dual [has_le α] {a : αᵒᵈ} {b : α} : a ≤ to_dual b ↔ b ≤ of_dual a := iff.rfl
-lemma lt_to_dual [has_lt α] {a : αᵒᵈ} {b : α} : a < to_dual b ↔ b < of_dual a := iff.rfl
-lemma to_dual_le [has_le α] {a : α} {b : αᵒᵈ} : to_dual a ≤ b ↔ of_dual b ≤ a := iff.rfl
-lemma to_dual_lt [has_lt α] {a : α} {b : αᵒᵈ} : to_dual a < b ↔ of_dual b < a := iff.rfl
-
-/-- Recursor for `αᵒᵈ`. -/
-@[elab_as_eliminator]
-protected def rec {C : αᵒᵈ → Sort*} (h₂ : Π (a : α), C (to_dual a)) : Π (a : αᵒᵈ), C a := h₂
-
-@[simp] protected lemma «forall» {p : αᵒᵈ → Prop} : (∀ a, p a) ↔ ∀ a, p (to_dual a) := iff.rfl
-@[simp] protected lemma «exists» {p : αᵒᵈ → Prop} : (∃ a, p a) ↔ ∃ a, p (to_dual a) := iff.rfl
-
-end order_dual
-
-alias order_dual.to_dual_le_to_dual ↔ _ has_le.le.dual
-alias order_dual.to_dual_lt_to_dual ↔ _ has_lt.lt.dual
-alias order_dual.of_dual_le_of_dual ↔ _ has_le.le.of_dual
-alias order_dual.of_dual_lt_of_dual ↔ _ has_lt.lt.of_dual
diff --git a/src/order/order_iso_nat.lean b/src/order/order_iso_nat.lean
index 2fd69aadeb8e7..b1221a36b6acf 100644
--- a/src/order/order_iso_nat.lean
+++ b/src/order/order_iso_nat.lean
@@ -7,10 +7,14 @@ import data.nat.lattice
 import logic.denumerable
 import logic.function.iterate
 import order.hom.basic
+import tactic.congrm
 
 /-!
 # Relation embeddings from the naturals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file allows translation from monotone functions `ℕ → α` to order embeddings `ℕ ↪ α` and
 defines the limit value of an eventually-constant sequence.
 
@@ -21,80 +25,109 @@ defines the limit value of an eventually-constant sequence.
 * `monotonic_sequence_limit_index`: The index of the first occurence of `monotonic_sequence_limit`
   in the sequence.
 -/
+
+variable {α : Type*}
+
 namespace rel_embedding
 
-variables {α : Type*} {r : α → α → Prop} [is_strict_order α r]
+variables {r : α → α → Prop} [is_strict_order α r]
 
 /-- If `f` is a strictly `r`-increasing sequence, then this returns `f` as an order embedding. -/
-def nat_lt (f : ℕ → α) (H : ∀ n : ℕ, r (f n) (f (n + 1))) :
-  ((<) : ℕ → ℕ → Prop) ↪r r :=
+def nat_lt (f : ℕ → α) (H : ∀ n : ℕ, r (f n) (f (n + 1))) : ((<) : ℕ → ℕ → Prop) ↪r r :=
 of_monotone f $ nat.rel_of_forall_rel_succ_of_lt r H
 
-@[simp]
-lemma nat_lt_apply {f : ℕ → α} {H : ∀ n : ℕ, r (f n) (f (n + 1))} {n : ℕ} :
-  nat_lt f H n = f n :=
-rfl
+@[simp] lemma coe_nat_lt {f : ℕ → α} {H : ∀ n : ℕ, r (f n) (f (n + 1))} : ⇑(nat_lt f H) = f := rfl
 
 /-- If `f` is a strictly `r`-decreasing sequence, then this returns `f` as an order embedding. -/
-def nat_gt (f : ℕ → α) (H : ∀ n : ℕ, r (f (n + 1)) (f n)) :
-  ((>) : ℕ → ℕ → Prop) ↪r r :=
-by haveI := is_strict_order.swap r; exact rel_embedding.swap (nat_lt f H)
+def nat_gt (f : ℕ → α) (H : ∀ n : ℕ, r (f (n + 1)) (f n)) : ((>) : ℕ → ℕ → Prop) ↪r r :=
+by { haveI := is_strict_order.swap r, exact rel_embedding.swap (nat_lt f H) }
+
+@[simp] lemma coe_nat_gt {f : ℕ → α} {H : ∀ n : ℕ, r (f (n + 1)) (f n)} : ⇑(nat_gt f H) = f := rfl
+
+theorem exists_not_acc_lt_of_not_acc {a : α} {r} (h : ¬ acc r a) : ∃ b, ¬ acc r b ∧ r b a :=
+begin
+  contrapose! h,
+  refine ⟨_, λ b hr, _⟩,
+  by_contra hb,
+  exact h b hb hr
+end
+
+/-- A value is accessible iff it isn't contained in any infinite decreasing sequence. -/
+theorem acc_iff_no_decreasing_seq {x} :
+  acc r x ↔ is_empty {f : ((>) : ℕ → ℕ → Prop) ↪r r // x ∈ set.range f} :=
+begin
+  split,
+  { refine λ h, h.rec_on (λ x h IH, _),
+    split,
+    rintro ⟨f, k, hf⟩,
+    exact is_empty.elim' (IH (f (k + 1)) (hf ▸ f.map_rel_iff.2 (lt_add_one k))) ⟨f, _, rfl⟩ },
+  { have : ∀ x : {a // ¬ acc r a}, ∃ y : {a // ¬ acc r a}, r y.1 x.1,
+    { rintro ⟨x, hx⟩,
+      cases exists_not_acc_lt_of_not_acc hx,
+      exact ⟨⟨w, h.1⟩, h.2⟩ },
+    obtain ⟨f, h⟩ := classical.axiom_of_choice this,
+    refine λ E, classical.by_contradiction (λ hx, E.elim'
+      ⟨(nat_gt (λ n, (f^[n] ⟨x, hx⟩).1) (λ n, _)), 0, rfl⟩),
+    rw function.iterate_succ',
+    apply h }
+end
 
+theorem not_acc_of_decreasing_seq (f : ((>) : ℕ → ℕ → Prop) ↪r r) (k : ℕ) : ¬ acc r (f k) :=
+by { rw [acc_iff_no_decreasing_seq, not_is_empty_iff], exact ⟨⟨f, k, rfl⟩⟩ }
+
+/-- A relation is well-founded iff it doesn't have any infinite decreasing sequence. -/
 theorem well_founded_iff_no_descending_seq :
   well_founded r ↔ is_empty (((>) : ℕ → ℕ → Prop) ↪r r) :=
-⟨λ ⟨h⟩, ⟨λ ⟨f, o⟩,
-  suffices ∀ a, acc r a → ∀ n, a ≠ f n, from this (f 0) (h _) 0 rfl,
-  λ a ac, begin
-    induction ac with a _ IH,
-    rintro n rfl,
-    exact IH (f (n+1)) (o.2 (nat.lt_succ_self _)) _ rfl
-  end⟩,
-λ E, ⟨λ a, classical.by_contradiction $ λ na,
-  let ⟨f, h⟩ := classical.axiom_of_choice $
-    show ∀ x : {a // ¬ acc r a}, ∃ y : {a // ¬ acc r a}, r y.1 x.1,
-    from λ ⟨x, h⟩, classical.by_contradiction $ λ hn, h $
-      ⟨_, λ y h, classical.by_contradiction $ λ na, hn ⟨⟨y, na⟩, h⟩⟩ in
-  E.elim' (nat_gt (λ n, (f^[n] ⟨a, na⟩).1) $ λ n,
-    by { rw [function.iterate_succ'], apply h })⟩⟩
+begin
+  split,
+  { rintro ⟨h⟩,
+    exact ⟨λ f, not_acc_of_decreasing_seq f 0 (h _)⟩ },
+  { introI h,
+    exact ⟨λ x, acc_iff_no_decreasing_seq.2 infer_instance⟩ }
+end
+
+theorem not_well_founded_of_decreasing_seq (f : ((>) : ℕ → ℕ → Prop) ↪r r) : ¬ well_founded r :=
+by { rw [well_founded_iff_no_descending_seq, not_is_empty_iff], exact ⟨f⟩ }
 
 end rel_embedding
 
 namespace nat
-variables (s : set ℕ) [decidable_pred (∈ s)] [infinite s]
+variables (s : set ℕ) [infinite s]
 
 /-- An order embedding from `ℕ` to itself with a specified range -/
-def order_embedding_of_set : ℕ ↪o ℕ :=
+def order_embedding_of_set [decidable_pred (∈ s)] : ℕ ↪o ℕ :=
 (rel_embedding.order_embedding_of_lt_embedding
   (rel_embedding.nat_lt (nat.subtype.of_nat s) (λ n, nat.subtype.lt_succ_self _))).trans
   (order_embedding.subtype s)
 
-/-- `nat.subtype.of_nat` as an order isomorphism between `ℕ` and an infinite decidable subset.
-See also `nat.nth` for a version where the subset may be finite. -/
-noncomputable def subtype.order_iso_of_nat  :
-  ℕ ≃o s :=
-rel_iso.of_surjective (rel_embedding.order_embedding_of_lt_embedding
+/-- `nat.subtype.of_nat` as an order isomorphism between `ℕ` and an infinite subset. See also
+`nat.nth` for a version where the subset may be finite. -/
+noncomputable def subtype.order_iso_of_nat : ℕ ≃o s :=
+by { classical, exact rel_iso.of_surjective (rel_embedding.order_embedding_of_lt_embedding
   (rel_embedding.nat_lt (nat.subtype.of_nat s) (λ n, nat.subtype.lt_succ_self _)))
-  nat.subtype.of_nat_surjective
+  nat.subtype.of_nat_surjective }
 
 variable {s}
 
 @[simp]
-lemma coe_order_embedding_of_set : ⇑(order_embedding_of_set s) = coe ∘ subtype.of_nat s := rfl
+lemma coe_order_embedding_of_set [decidable_pred (∈ s)] :
+  ⇑(order_embedding_of_set s) = coe ∘ subtype.of_nat s := rfl
 
-lemma order_embedding_of_set_apply {n : ℕ} : order_embedding_of_set s n = subtype.of_nat s n := rfl
+lemma order_embedding_of_set_apply [decidable_pred (∈ s)] {n : ℕ} :
+  order_embedding_of_set s n = subtype.of_nat s n := rfl
 
 @[simp]
-lemma subtype.order_iso_of_nat_apply {n : ℕ} :
+lemma subtype.order_iso_of_nat_apply [decidable_pred (∈ s)] {n : ℕ} :
   subtype.order_iso_of_nat s n = subtype.of_nat s n :=
-by { simp [subtype.order_iso_of_nat] }
+by { simp [subtype.order_iso_of_nat], congr }
 
 variable (s)
 
-lemma order_embedding_of_set_range : set.range (nat.order_embedding_of_set s) = s :=
+lemma order_embedding_of_set_range [decidable_pred (∈ s)] :
+  set.range (nat.order_embedding_of_set s) = s :=
 subtype.coe_comp_of_nat_range
 
-theorem exists_subseq_of_forall_mem_union {α : Type*} {s t : set α} (e : ℕ → α)
-  (he : ∀ n, e n ∈ s ∪ t) :
+theorem exists_subseq_of_forall_mem_union {s t : set α} (e : ℕ → α) (he : ∀ n, e n ∈ s ∪ t) :
   ∃ g : ℕ ↪o ℕ, (∀ n, e (g n) ∈ s) ∨ (∀ n, e (g n) ∈ t) :=
 begin
   classical,
@@ -108,7 +141,7 @@ end
 
 end nat
 
-theorem exists_increasing_or_nonincreasing_subseq' {α : Type*} (r : α → α → Prop) (f : ℕ → α) :
+theorem exists_increasing_or_nonincreasing_subseq' (r : α → α → Prop) (f : ℕ → α) :
   ∃ (g : ℕ ↪o ℕ), (∀ n : ℕ, r (f (g n)) (f (g (n + 1)))) ∨
     (∀ m n : ℕ, m < n → ¬ r (f (g m)) (f (g n))) :=
 begin
@@ -143,14 +176,13 @@ end
 
 /-- This is the infinitary Erdős–Szekeres theorem, and an important lemma in the usual proof of
     Bolzano-Weierstrass for `ℝ`. -/
-theorem exists_increasing_or_nonincreasing_subseq
-  {α : Type*} (r : α → α → Prop) [is_trans α r] (f : ℕ → α) :
+theorem exists_increasing_or_nonincreasing_subseq (r : α → α → Prop) [is_trans α r] (f : ℕ → α) :
   ∃ (g : ℕ ↪o ℕ), (∀ m n : ℕ, m < n → r (f (g m)) (f (g n))) ∨
     (∀ m n : ℕ, m < n → ¬ r (f (g m)) (f (g n))) :=
 begin
   obtain ⟨g, hr | hnr⟩ := exists_increasing_or_nonincreasing_subseq' r f,
   { refine ⟨g, or.intro_left _ (λ m n mn, _)⟩,
-    obtain ⟨x, rfl⟩ := le_iff_exists_add.1 (nat.succ_le_iff.2 mn),
+    obtain ⟨x, rfl⟩ := exists_add_of_le (nat.succ_le_iff.2 mn),
     induction x with x ih,
     { apply hr },
     { apply is_trans.trans _ _ _ _ (hr _),
@@ -158,48 +190,45 @@ begin
   { exact ⟨g, or.intro_right _ hnr⟩ }
 end
 
-/-- The "monotone chain condition" below is sometimes a convenient form of well foundedness. -/
-lemma well_founded.monotone_chain_condition (α : Type*) [partial_order α] :
-  well_founded ((>) : α → α → Prop) ↔ ∀ (a : ℕ →o α), ∃ n, ∀ m, n ≤ m → a n = a m :=
+lemma well_founded.monotone_chain_condition' [preorder α] :
+  well_founded ((>) : α → α → Prop) ↔ ∀ (a : ℕ →o α), ∃ n, ∀ m, n ≤ m → ¬ a n < a m :=
 begin
-  split; intros h,
-  { rw well_founded.well_founded_iff_has_max' at h,
-    intros a, have hne : (set.range a).nonempty, { use a 0, simp, },
-    obtain ⟨x, ⟨n, hn⟩, range_bounded⟩ := h _ hne,
-    use n, intros m hm, rw ← hn at range_bounded, symmetry,
-    apply range_bounded (a m) (set.mem_range_self _) (a.monotone hm), },
-  { rw rel_embedding.well_founded_iff_no_descending_seq, refine ⟨λ a, _⟩,
+  refine ⟨λ h a, _, λ h, _⟩,
+  { have hne : (set.range a).nonempty := ⟨a 0, by simp⟩,
+    obtain ⟨x, ⟨n, rfl⟩, H⟩ := h.has_min _ hne,
+    exact ⟨n, λ m hm, H _ (set.mem_range_self _)⟩ },
+  { refine rel_embedding.well_founded_iff_no_descending_seq.2 ⟨λ a, _⟩,
     obtain ⟨n, hn⟩ := h (a.swap : ((<) : ℕ → ℕ → Prop) →r ((<) : α → α → Prop)).to_order_hom,
-    exact n.succ_ne_self.symm (rel_embedding.to_order_hom_injective _ (hn _ n.le_succ)), },
+    exact hn n.succ n.lt_succ_self.le ((rel_embedding.map_rel_iff _).2 n.lt_succ_self) },
+end
+
+/-- The "monotone chain condition" below is sometimes a convenient form of well foundedness. -/
+lemma well_founded.monotone_chain_condition [partial_order α] :
+  well_founded ((>) : α → α → Prop) ↔ ∀ (a : ℕ →o α), ∃ n, ∀ m, n ≤ m → a n = a m :=
+well_founded.monotone_chain_condition'.trans $ begin
+  congrm ∀ a, ∃ n, ∀ m (h : n ≤ m), (_ : Prop),
+  rw lt_iff_le_and_ne,
+  simp [a.mono h]
 end
 
 /-- Given an eventually-constant monotone sequence `a₀ ≤ a₁ ≤ a₂ ≤ ...` in a partially-ordered
 type, `monotonic_sequence_limit_index a` is the least natural number `n` for which `aₙ` reaches the
 constant value. For sequences that are not eventually constant, `monotonic_sequence_limit_index a`
 is defined, but is a junk value. -/
-noncomputable def monotonic_sequence_limit_index {α : Type*} [preorder α] (a : ℕ →o α) : ℕ :=
-Inf { n | ∀ m, n ≤ m → a n = a m }
+noncomputable def monotonic_sequence_limit_index [preorder α] (a : ℕ →o α) : ℕ :=
+Inf {n | ∀ m, n ≤ m → a n = a m}
 
 /-- The constant value of an eventually-constant monotone sequence `a₀ ≤ a₁ ≤ a₂ ≤ ...` in a
 partially-ordered type. -/
-noncomputable def monotonic_sequence_limit {α : Type*} [preorder α] (a : ℕ →o α) :=
+noncomputable def monotonic_sequence_limit [preorder α] (a : ℕ →o α) :=
 a (monotonic_sequence_limit_index a)
 
-lemma well_founded.supr_eq_monotonic_sequence_limit {α : Type*} [complete_lattice α]
-  (h : well_founded ((>) : α → α → Prop)) (a : ℕ →o α) :
-  (⨆ m, a m) = monotonic_sequence_limit a :=
+lemma well_founded.supr_eq_monotonic_sequence_limit [complete_lattice α]
+  (h : well_founded ((>) : α → α → Prop)) (a : ℕ →o α) : supr a = monotonic_sequence_limit a :=
 begin
-  suffices : (⨆ (m : ℕ), a m) ≤ monotonic_sequence_limit a,
-  { exact le_antisymm this (le_supr a _), },
-  apply supr_le,
-  intros m,
-  by_cases hm : m ≤ monotonic_sequence_limit_index a,
-  { exact a.monotone hm, },
-  { replace hm := le_of_not_le hm,
-    let S := { n | ∀ m, n ≤ m → a n = a m },
-    have hInf : Inf S ∈ S,
-    { refine nat.Inf_mem _, rw well_founded.monotone_chain_condition at h, exact h a, },
-    change Inf S ≤ m at hm,
-    change a m ≤ a (Inf S),
-    rw hInf m hm, },
+  apply (supr_le (λ m, _)).antisymm (le_supr a _),
+  cases le_or_lt m (monotonic_sequence_limit_index a) with hm hm,
+  { exact a.monotone hm },
+  { cases well_founded.monotone_chain_condition'.1 h a with n hn,
+    exact (nat.Inf_mem ⟨n, λ k hk, (a.mono hk).eq_of_not_lt (hn k hk)⟩ m hm.le).ge }
 end
diff --git a/src/order/partial_sups.lean b/src/order/partial_sups.lean
index f059d1997d6d5..d8b326407c8d4 100644
--- a/src/order/partial_sups.lean
+++ b/src/order/partial_sups.lean
@@ -4,15 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 import data.finset.lattice
-import data.set.pairwise
 import order.hom.basic
+import order.conditionally_complete_lattice.finset
 
 /-!
 # The monotone sequence of partial supremums of a sequence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `partial_sups : (ℕ → α) → ℕ →o α` inductively. For `f : ℕ → α`, `partial_sups f` is
 the sequence `f 0 `, `f 0 ⊔ f 1`, `f 0 ⊔ f 1 ⊔ f 2`, ... The point of this definition is that
-* it doesn't need a `⨆`, as opposed to `⨆ (i ≤ n), f i`.
+* it doesn't need a `⨆`, as opposed to `⨆ (i ≤ n), f i` (which also means the wrong thing on
+  `conditionally_complete_lattice`s).
 * it doesn't need a `⊥`, as opposed to `(finset.range (n + 1)).sup f`.
 * it avoids needing to prove that `finset.range (n + 1)` is nonempty to use `finset.sup'`.
 
@@ -68,6 +72,17 @@ begin
   { exact sup_le (ih (λ m p, w m (nat.le_succ_of_le p))) (w (n + 1) le_rfl) }
 end
 
+@[simp] lemma bdd_above_range_partial_sups {f : ℕ → α} :
+  bdd_above (set.range (partial_sups f)) ↔ bdd_above (set.range f) :=
+begin
+  apply exists_congr (λ a, _),
+  split,
+  { rintros h b ⟨i, rfl⟩,
+    exact (le_partial_sups _ _).trans (h (set.mem_range_self i)) },
+  { rintros h b ⟨i, rfl⟩,
+    exact (partial_sups_le _ _ _ $ λ _ _, h (set.mem_range_self _)), },
+end
+
 lemma monotone.partial_sups_eq {f : ℕ → α} (hf : monotone f) :
   (partial_sups f : ℕ → α) = f :=
 begin
@@ -128,30 +143,42 @@ lemma partial_sups_disjoint_of_disjoint [distrib_lattice α] [order_bot α]
   disjoint (partial_sups f m) (f n) :=
 begin
   induction m with m ih,
-  { exact h 0 n hmn.ne, },
+  { exact h hmn.ne, },
   { rw [partial_sups_succ, disjoint_sup_left],
-    exact ⟨ih (nat.lt_of_succ_lt hmn), h (m + 1) n hmn.ne⟩ }
+    exact ⟨ih (nat.lt_of_succ_lt hmn), h hmn.ne⟩ }
 end
 
+section conditionally_complete_lattice
+variables [conditionally_complete_lattice α]
+
+lemma partial_sups_eq_csupr_Iic (f : ℕ → α) (n : ℕ) : partial_sups f n = ⨆ i : set.Iic n, f i :=
+begin
+  have : set.Iio (n + 1) = set.Iic n := set.ext (λ _, nat.lt_succ_iff),
+  rw [partial_sups_eq_sup'_range, finset.sup'_eq_cSup_image, finset.coe_range,
+    supr, set.range_comp, subtype.range_coe, this],
+end
+
+@[simp] lemma csupr_partial_sups_eq {f : ℕ → α} (h : bdd_above (set.range f)) :
+  (⨆ n, partial_sups f n) = ⨆ n, f n :=
+begin
+  refine (csupr_le $ λ n, _).antisymm (csupr_mono _ $ le_partial_sups f),
+  { rw partial_sups_eq_csupr_Iic,
+    exact csupr_le (λ i, le_csupr h _), },
+  { rwa bdd_above_range_partial_sups },
+end
+
+end conditionally_complete_lattice
+
 section complete_lattice
 variables [complete_lattice α]
 
 lemma partial_sups_eq_bsupr (f : ℕ → α) (n : ℕ) :
   partial_sups f n = ⨆ (i ≤ n), f i :=
-begin
-  rw [partial_sups_eq_sup_range, finset.sup_eq_supr],
-  congr,
-  ext a,
-  exact supr_congr_Prop (by rw [finset.mem_range, nat.lt_succ_iff]) (λ _, rfl),
-end
+by simpa only [supr_subtype] using partial_sups_eq_csupr_Iic f n
 
 @[simp] lemma supr_partial_sups_eq (f : ℕ → α) :
   (⨆ n, partial_sups f n) = ⨆ n, f n :=
-begin
-  refine (supr_le $ λ n, _).antisymm (supr_mono $ le_partial_sups f),
-  rw partial_sups_eq_bsupr,
-  exact supr₂_le_supr _ _,
-end
+csupr_partial_sups_eq $ order_top.bdd_above _
 
 lemma supr_le_supr_of_partial_sups_le_partial_sups {f g : ℕ → α}
   (h : partial_sups f ≤ partial_sups g) :
diff --git a/src/order/partition/equipartition.lean b/src/order/partition/equipartition.lean
index 3a3d8b1f6eddb..1a733509f0335 100644
--- a/src/order/partition/equipartition.lean
+++ b/src/order/partition/equipartition.lean
@@ -9,6 +9,9 @@ import order.partition.finpartition
 /-!
 # Finite equipartitions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines finite equipartitions, the partitions whose parts all are the same size up to a
 difference of `1`.
 
diff --git a/src/order/partition/finpartition.lean b/src/order/partition/finpartition.lean
index 820ff9b7ed432..77687a71a5f46 100644
--- a/src/order/partition/finpartition.lean
+++ b/src/order/partition/finpartition.lean
@@ -4,13 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies, Bhavik Mehta
 -/
 import algebra.big_operators.basic
-import order.atoms
-import order.locally_finite
+import order.atoms.finite
 import order.sup_indep
 
 /-!
 # Finite partitions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define finite partitions. A finpartition of `a : α` is a finite set of pairwise
 disjoint parts `parts : finset α` which does not contain `⊥` and whose supremum is `a`.
 
@@ -153,7 +155,7 @@ def _root_.is_atom.unique_finpartition (ha : is_atom a) : unique (finpartition a
 { default := indiscrete ha.1,
   uniq := λ P, begin
     have h : ∀ b ∈ P.parts, b = a,
-    { exact λ b hb, (eq_bot_or_eq_of_le_atom ha $ P.le hb).resolve_left (P.ne_bot hb) },
+    { exact λ b hb, (ha.le_iff.mp $ P.le hb).resolve_left (P.ne_bot hb) },
     ext b,
     refine iff.trans ⟨h b, _⟩ mem_singleton.symm,
     rintro rfl,
@@ -229,7 +231,7 @@ section inf
 variables [decidable_eq α] {a b c : α}
 
 instance : has_inf (finpartition a) :=
-⟨λ P Q, of_erase ((P.parts.product Q.parts).image $ λ bc, bc.1 ⊓ bc.2)
+⟨λ P Q, of_erase ((P.parts ×ˢ Q.parts).image $ λ bc, bc.1 ⊓ bc.2)
   begin
     rw sup_indep_iff_disjoint_erase,
     simp only [mem_image, and_imp, exists_prop, forall_exists_index, id.def, prod.exists,
@@ -250,7 +252,7 @@ instance : has_inf (finpartition a) :=
   end⟩
 
 @[simp] lemma parts_inf (P Q : finpartition a) :
-  (P ⊓ Q).parts = ((P.parts.product Q.parts).image $ λ bc : α × α, bc.1 ⊓ bc.2).erase ⊥ := rfl
+  (P ⊓ Q).parts = ((P.parts ×ˢ Q.parts).image $ λ bc : α × α, bc.1 ⊓ bc.2).erase ⊥ := rfl
 
 instance : semilattice_inf (finpartition a) :=
 { inf_le_left := λ P Q b hb, begin
@@ -342,12 +344,12 @@ lemma card_bind (Q : Π i ∈ P.parts, finpartition i) :
   (P.bind Q).parts.card = ∑ A in P.parts.attach, (Q _ A.2).parts.card :=
 begin
   apply card_bUnion,
-  rintro ⟨b, hb⟩ - ⟨c, hc⟩ - hbc d,
-  rw [inf_eq_inter, mem_inter],
-  rintro ⟨hdb, hdc⟩,
+  rintro ⟨b, hb⟩ - ⟨c, hc⟩ - hbc,
+  rw finset.disjoint_left,
+  rintro d hdb hdc,
   rw [ne.def, subtype.mk_eq_mk] at hbc,
   exact (Q b hb).ne_bot hdb (eq_bot_iff.2 $
-    (le_inf ((Q b hb).le hdb) $ (Q c hc).le hdc).trans $ P.disjoint hb hc hbc),
+    (le_inf ((Q b hb).le hdb) $ (Q c hc).le hdc).trans $ (P.disjoint hb hc hbc).le_bot),
 end
 
 end bind
@@ -372,18 +374,23 @@ card_insert_of_not_mem $ λ h, hb $ hab.symm.eq_bot_of_le $ P.le h
 end distrib_lattice
 
 section generalized_boolean_algebra
-variables [generalized_boolean_algebra α] [decidable_eq α] {a : α} (P : finpartition a)
+variables [generalized_boolean_algebra α] [decidable_eq α] {a b c : α} (P : finpartition a)
 
 /-- Restricts a finpartition to avoid a given element. -/
 @[simps] def avoid (b : α) : finpartition (a \ b) :=
 of_erase
   (P.parts.image (\ b))
   (P.disjoint.image_finset_of_le $ λ a, sdiff_le).sup_indep
-  (begin
-    rw [sup_image, comp.left_id, finset.sup_sdiff_right],
-    congr,
-    exact P.sup_parts,
-  end)
+  (by rw [sup_image, comp.left_id, finset.sup_sdiff_right, ←id_def, P.sup_parts])
+
+@[simp] lemma mem_avoid : c ∈ (P.avoid b).parts ↔ ∃ d ∈ P.parts, ¬ d ≤ b ∧ d \ b = c :=
+begin
+  simp only [avoid, of_erase_parts, mem_erase, ne.def, mem_image, exists_prop,
+    ←exists_and_distrib_left, @and.left_comm (c ≠ ⊥)],
+  refine exists_congr (λ d, and_congr_right' $ and_congr_left _),
+  rintro rfl,
+  rw sdiff_eq_bot_iff,
+end
 
 end generalized_boolean_algebra
 end finpartition
@@ -443,18 +450,18 @@ in the same finsets of `F`. -/
 def atomise (s : finset α) (F : finset (finset α)) : finpartition s :=
 of_erase
   (F.powerset.image $ λ Q, s.filter (λ i, ∀ t ∈ F, t ∈ Q ↔ i ∈ t))
-  (set.pairwise_disjoint.sup_indep $ λ x hx y hy h z hz, h begin
+  (set.pairwise_disjoint.sup_indep $ λ x hx y hy h, disjoint_left.mpr $ λ z hz1 hz2, h begin
     rw [mem_coe, mem_image] at hx hy,
     obtain ⟨Q, hQ, rfl⟩ := hx,
     obtain ⟨R, hR, rfl⟩ := hy,
     suffices h : Q = R,
     { subst h },
-    rw [id, id, inf_eq_inter, mem_inter, mem_filter, mem_filter] at hz,
+    rw [id, mem_filter] at hz1 hz2,
     rw mem_powerset at hQ hR,
     ext i,
     refine ⟨λ hi, _, λ hi, _⟩,
-    { rwa [hz.2.2 _ (hQ hi), ←hz.1.2 _ (hQ hi)] },
-    { rwa [hz.1.2 _ (hR hi), ←hz.2.2 _ (hR hi)] }
+    { rwa [hz2.2 _ (hQ hi), ←hz1.2 _ (hQ hi)] },
+    { rwa [hz1.2 _ (hR hi), ←hz2.2 _ (hR hi)] }
   end)
   (begin
     refine (finset.sup_le $ λ t ht, _).antisymm (λ a ha, _),
@@ -470,14 +477,14 @@ of_erase
 
 variables {F : finset (finset α)}
 
-lemma mem_atomise {t : finset α} :
+lemma mem_atomise :
   t ∈ (atomise s F).parts ↔ t.nonempty ∧ ∃ (Q ⊆ F), s.filter (λ i, ∀ u ∈ F, u ∈ Q ↔ i ∈ u) = t :=
 by simp only [atomise, of_erase, bot_eq_empty, mem_erase, mem_image, nonempty_iff_ne_empty,
   mem_singleton, and_comm, mem_powerset, exists_prop]
 
 lemma atomise_empty (hs : s.nonempty) : (atomise s ∅).parts = {s} :=
 begin
-  simp only [atomise, powerset_empty, image_singleton, not_mem_empty, forall_false_left,
+  simp only [atomise, powerset_empty, image_singleton, not_mem_empty, is_empty.forall_iff,
     implies_true_iff, filter_true],
   exact erase_eq_of_not_mem (not_mem_singleton.2 hs.ne_empty.symm),
 end
@@ -485,17 +492,31 @@ end
 lemma card_atomise_le : (atomise s F).parts.card ≤ 2^F.card :=
 (card_le_of_subset $ erase_subset _ _).trans $ finset.card_image_le.trans (card_powerset _).le
 
-lemma bUnion_filter_atomise (t : finset α) (ht : t ∈ F) (hts : t ⊆ s) :
-  ((atomise s F).parts.filter $ λ u, u ⊆ t).bUnion id = t :=
+lemma bUnion_filter_atomise (ht : t ∈ F) (hts : t ⊆ s) :
+  ((atomise s F).parts.filter $ λ u, u ⊆ t ∧ u.nonempty).bUnion id = t :=
 begin
   ext a,
-  rw mem_bUnion,
-  refine ⟨λ ⟨u, hu, ha⟩, (mem_filter.1 hu).2 ha, λ ha, _⟩,
+  refine mem_bUnion.trans ⟨λ ⟨u, hu, ha⟩, (mem_filter.1 hu).2.1 ha, λ ha, _⟩,
   obtain ⟨u, hu, hau⟩ := (atomise s F).exists_mem (hts ha),
-  refine ⟨u, mem_filter.2 ⟨hu, λ b hb, _⟩, hau⟩,
+  refine ⟨u, mem_filter.2 ⟨hu, λ b hb, _, _, hau⟩, hau⟩,
   obtain ⟨Q, hQ, rfl⟩ := (mem_atomise.1 hu).2,
   rw mem_filter at hau hb,
-  rwa [←hb.2 _ ht, hau.2 _ ht]
+  rwa [←hb.2 _ ht, hau.2 _ ht],
+end
+
+lemma card_filter_atomise_le_two_pow (ht : t ∈ F) :
+  ((atomise s F).parts.filter $ λ u, u ⊆ t ∧ u.nonempty).card ≤ 2 ^ (F.card - 1) :=
+begin
+  suffices h : (atomise s F).parts.filter (λ u, u ⊆ t ∧ u.nonempty)
+    ⊆ (F.erase t).powerset.image (λ P, s.filter $ λ i, ∀ x ∈ F, x ∈ insert t P ↔ i ∈ x),
+  { refine (card_le_of_subset h).trans (card_image_le.trans _),
+    rw [card_powerset, card_erase_of_mem ht] },
+  rw subset_iff,
+  simp only [mem_erase, mem_sdiff, mem_powerset, mem_image, exists_prop, mem_filter, and_assoc,
+    finset.nonempty, exists_imp_distrib, and_imp, mem_atomise, forall_apply_eq_imp_iff₂],
+  rintro P' i hi P PQ rfl hy₂ j hj,
+  refine ⟨P.erase t, erase_subset_erase _ PQ, _⟩,
+  simp only [insert_erase (((mem_filter.1 hi).2 _ ht).2 $ hy₂ hi), filter_congr_decidable],
 end
 
 end atomise
diff --git a/src/order/pfilter.lean b/src/order/pfilter.lean
index e421064d01b2a..e9ddf29995b33 100644
--- a/src/order/pfilter.lean
+++ b/src/order/pfilter.lean
@@ -8,6 +8,9 @@ import order.ideal
 /-!
 # Order filters
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 Throughout this file, `P` is at least a preorder, but some sections
@@ -63,6 +66,8 @@ namespace pfilter
 section preorder
 variables [preorder P] {x y : P} (F s t : pfilter P)
 
+instance [inhabited P] : inhabited (pfilter P) := ⟨⟨default⟩⟩
+
 /-- A filter on `P` is a subset of `P`. -/
 instance : has_coe (pfilter P) (set P) := ⟨λ F, F.dual.carrier⟩
 
@@ -80,11 +85,6 @@ lemma directed : directed_on (≥) (F : set P) := F.dual.directed
 
 lemma mem_of_le {F : pfilter P} : x ≤ y → x ∈ F → y ∈ F := λ h, F.dual.lower h
 
-/-- The smallest filter containing a given element. -/
-def principal (p : P) : pfilter P := ⟨ideal.principal p⟩
-
-instance [inhabited P] : inhabited (pfilter P) := ⟨⟨default⟩⟩
-
 /-- Two filters are equal when their underlying sets are equal. -/
 @[ext] lemma ext (h : (s : set P) = t) : s = t :=
 by { cases s, cases t, exact congr_arg _ (ideal.ext h) }
@@ -95,9 +95,24 @@ instance : partial_order (pfilter P) := partial_order.lift coe ext
 @[trans] lemma mem_of_mem_of_le {F G : pfilter P} : x ∈ F → F ≤ G → x ∈ G :=
 ideal.mem_of_mem_of_le
 
+/-- The smallest filter containing a given element. -/
+def principal (p : P) : pfilter P := ⟨ideal.principal p⟩
+
+@[simp] lemma mem_def (x : P) (I : ideal Pᵒᵈ) :
+  x ∈ (⟨I⟩ : pfilter P) ↔ order_dual.to_dual x ∈ I :=
+iff.rfl
+
 @[simp] lemma principal_le_iff {F : pfilter P} : principal x ≤ F ↔ x ∈ F :=
 ideal.principal_le_iff
 
+@[simp] lemma mem_principal : x ∈ principal y ↔ y ≤ x :=
+ideal.mem_principal -- defeq abuse
+
+lemma antitone_principal : antitone (principal : P → pfilter P) := by delta antitone; simp
+
+lemma principal_le_principal_iff {p q : P} : principal q ≤ principal p ↔ p ≤ q :=
+by simp
+
 end preorder
 
 section order_top
@@ -129,6 +144,24 @@ ideal.sup_mem_iff
 
 end semilattice_inf
 
+section complete_semilattice_Inf
+
+variables [complete_semilattice_Inf P] {F : pfilter P}
+
+lemma Inf_gc : galois_connection (λ x, order_dual.to_dual (principal x))
+  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
+λ x F, by { simp, refl }
+
+/-- If a poset `P` admits arbitrary `Inf`s, then `principal` and `Inf` form a Galois coinsertion. -/
+def Inf_gi : galois_coinsertion (λ x, order_dual.to_dual (principal x))
+  (λ F, Inf (order_dual.of_dual F : pfilter P)) :=
+{ choice := λ F _, Inf (id F : pfilter P),
+  gc := Inf_gc,
+  u_l_le := λ s, Inf_le $ mem_principal.2 $ le_refl s,
+  choice_eq := λ _ _, rfl }
+
+end complete_semilattice_Inf
+
 end pfilter
 
 end order
diff --git a/src/order/prime_ideal.lean b/src/order/prime_ideal.lean
index 09e5457b2ea80..1ca320f66c408 100644
--- a/src/order/prime_ideal.lean
+++ b/src/order/prime_ideal.lean
@@ -9,6 +9,9 @@ import order.pfilter
 /-!
 # Prime ideals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 Throughout this file, `P` is at least a preorder, but some sections require more
@@ -40,7 +43,7 @@ namespace ideal
 
 /-- A pair of an `ideal` and a `pfilter` which form a partition of `P`.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure prime_pair (P : Type*) [preorder P] :=
 (I            : ideal P)
 (F            : pfilter P)
diff --git a/src/order/prop_instances.lean b/src/order/prop_instances.lean
new file mode 100644
index 0000000000000..bce4033a2e8e6
--- /dev/null
+++ b/src/order/prop_instances.lean
@@ -0,0 +1,91 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import order.disjoint
+import order.with_bot
+
+/-!
+
+# The order on `Prop`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Instances on `Prop` such as `distrib_lattice`, `bounded_order`, `linear_order`.
+
+-/
+/-- Propositions form a distributive lattice. -/
+instance Prop.distrib_lattice : distrib_lattice Prop :=
+{ sup          := or,
+  le_sup_left  := @or.inl,
+  le_sup_right := @or.inr,
+  sup_le       := λ a b c, or.rec,
+
+  inf          := and,
+  inf_le_left  := @and.left,
+  inf_le_right := @and.right,
+  le_inf       := λ a b c Hab Hac Ha, and.intro (Hab Ha) (Hac Ha),
+  le_sup_inf   := λ a b c, or_and_distrib_left.2,
+  ..Prop.partial_order }
+
+/-- Propositions form a bounded order. -/
+instance Prop.bounded_order : bounded_order Prop :=
+{ top          := true,
+  le_top       := λ a Ha, true.intro,
+  bot          := false,
+  bot_le       := @false.elim }
+
+lemma Prop.bot_eq_false : (⊥ : Prop) = false := rfl
+
+lemma Prop.top_eq_true : (⊤ : Prop) = true := rfl
+
+instance Prop.le_is_total : is_total Prop (≤) :=
+⟨λ p q, by { change (p → q) ∨ (q → p), tauto! }⟩
+
+noncomputable instance Prop.linear_order : linear_order Prop :=
+by classical; exact lattice.to_linear_order Prop
+
+@[simp] lemma sup_Prop_eq : (⊔) = (∨) := rfl
+@[simp] lemma inf_Prop_eq : (⊓) = (∧) := rfl
+
+namespace pi
+
+variables {ι : Type*} {α' : ι → Type*} [Π i, partial_order (α' i)]
+
+lemma disjoint_iff [Π i, order_bot (α' i)] {f g : Π i, α' i} :
+  disjoint f g ↔ ∀ i, disjoint (f i) (g i) :=
+begin
+  split,
+  { intros h i x hf hg,
+    classical,
+    refine (update_le_iff.mp $
+    -- this line doesn't work
+      h (update_le_iff.mpr ⟨hf, λ _ _, _⟩) (update_le_iff.mpr ⟨hg, λ _ _, _⟩)).1,
+    { exact ⊥},
+    { exact bot_le },
+    { exact bot_le }, },
+  { intros h x hf hg i,
+    apply h i (hf i) (hg i) },
+end
+
+lemma codisjoint_iff [Π i, order_top (α' i)] {f g : Π i, α' i} :
+  codisjoint f g ↔ ∀ i, codisjoint (f i) (g i) :=
+@disjoint_iff _ (λ i, (α' i)ᵒᵈ) _ _ _ _
+
+lemma is_compl_iff [Π i, bounded_order (α' i)] {f g : Π i, α' i} :
+  is_compl f g ↔ ∀ i, is_compl (f i) (g i) :=
+by simp_rw [is_compl_iff, disjoint_iff, codisjoint_iff, forall_and_distrib]
+
+end pi
+
+@[simp] lemma Prop.disjoint_iff {P Q : Prop} : disjoint P Q ↔ ¬(P ∧ Q) := disjoint_iff_inf_le
+@[simp] lemma Prop.codisjoint_iff {P Q : Prop} : codisjoint P Q ↔ P ∨ Q :=
+codisjoint_iff_le_sup.trans $ forall_const _
+@[simp] lemma Prop.is_compl_iff {P Q : Prop} : is_compl P Q ↔ ¬(P ↔ Q) :=
+begin
+  rw [is_compl_iff, Prop.disjoint_iff, Prop.codisjoint_iff, not_iff],
+  classical,
+  tauto,
+end
diff --git a/src/order/rel_classes.lean b/src/order/rel_classes.lean
index d2f5c9a52f45c..263bf5e1487cf 100644
--- a/src/order/rel_classes.lean
+++ b/src/order/rel_classes.lean
@@ -3,11 +3,16 @@ Copyright (c) 2020 Jeremy Avigad. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Mario Carneiro, Yury G. Kudryashov
 -/
+import logic.is_empty
+import logic.relation
 import order.basic
 
 /-!
 # Unbundled relation classes
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove some properties of `is_*` classes defined in `init.algebra.classes`. The main
 difference between these classes and the usual order classes (`preorder` etc) is that usual classes
 extend `has_le` and/or `has_lt` while these classes take a relation as an explicit argument.
@@ -83,6 +88,19 @@ instance is_total.to_is_refl (r) [is_total α r] : is_refl α r :=
 lemma ne_of_irrefl {r} [is_irrefl α r] : ∀ {x y : α}, r x y → x ≠ y | _ _ h rfl := irrefl _ h
 lemma ne_of_irrefl' {r} [is_irrefl α r] : ∀ {x y : α}, r x y → y ≠ x | _ _ h rfl := irrefl _ h
 
+lemma not_rel_of_subsingleton (r) [is_irrefl α r] [subsingleton α] (x y) : ¬ r x y :=
+subsingleton.elim x y ▸ irrefl x
+
+lemma rel_of_subsingleton (r) [is_refl α r] [subsingleton α] (x y) : r x y :=
+subsingleton.elim x y ▸ refl x
+
+@[simp] lemma empty_relation_apply (a b : α) : empty_relation a b ↔ false := iff.rfl
+
+lemma eq_empty_relation (r) [is_irrefl α r] [subsingleton α] : r = empty_relation :=
+funext₂ $ by simpa using not_rel_of_subsingleton r
+
+instance : is_irrefl α empty_relation := ⟨λ a, id⟩
+
 lemma trans_trichotomous_left [is_trans α r] [is_trichotomous α r] {a b c : α} :
   ¬r b a → r b c → r a c :=
 begin
@@ -99,6 +117,13 @@ end
 
 lemma transitive_of_trans (r : α → α → Prop) [is_trans α r] : transitive r := λ _ _ _, trans
 
+/-- In a trichotomous irreflexive order, every element is determined by the set of predecessors. -/
+lemma extensional_of_trichotomous_of_irrefl (r : α → α → Prop) [is_trichotomous α r] [is_irrefl α r]
+  {a b : α} (H : ∀ x, r x a ↔ r x b) : a = b :=
+((@trichotomous _ r _ a b)
+  .resolve_left $ mt (H _).2 $ irrefl a)
+  .resolve_right $ mt (H _).1 $ irrefl b
+
 /-- Construct a partial order from a `is_strict_order` relation.
 
 See note [reducible non-instances]. -/
@@ -124,16 +149,11 @@ See note [reducible non-instances]. -/
       (asymm h)⟩,
     λ ⟨h₁, h₂⟩, h₁.resolve_left (λ e, h₂ $ e ▸ or.inl rfl)⟩ }
 
-/-- This is basically the same as `is_strict_total_order`, but that definition has a redundant
-assumption `is_incomp_trans α lt`. -/
-@[algebra] class is_strict_total_order' (α : Type u) (lt : α → α → Prop)
-  extends is_trichotomous α lt, is_strict_order α lt : Prop.
-
-/-- Construct a linear order from an `is_strict_total_order'` relation.
+/-- Construct a linear order from an `is_strict_total_order` relation.
 
 See note [reducible non-instances]. -/
 @[reducible]
-def linear_order_of_STO' (r) [is_strict_total_order' α r] [Π x y, decidable (¬ r x y)] :
+def linear_order_of_STO (r) [is_strict_total_order α r] [Π x y, decidable (¬ r x y)] :
   linear_order α :=
 { le_total := λ x y,
     match y, trichotomous_of r x y with
@@ -146,8 +166,8 @@ def linear_order_of_STO' (r) [is_strict_total_order' α r] [Π x y, decidable (
       λ h, h.elim (λ h, h ▸ irrefl_of _ _) (asymm_of r)⟩,
   ..partial_order_of_SO r }
 
-theorem is_strict_total_order'.swap (r) [is_strict_total_order' α r] :
-  is_strict_total_order' α (swap r) :=
+theorem is_strict_total_order.swap (r) [is_strict_total_order α r] :
+  is_strict_total_order α (swap r) :=
 {..is_trichotomous.swap r, ..is_strict_order.swap r}
 
 /-! ### Order connection -/
@@ -171,44 +191,89 @@ theorem is_strict_weak_order_of_is_order_connected [is_asymm α r]
   ..@is_asymm.is_irrefl α r _ }
 
 @[priority 100] -- see Note [lower instance priority]
-instance is_order_connected_of_is_strict_total_order'
-  [is_strict_total_order' α r] : is_order_connected α r :=
+instance is_order_connected_of_is_strict_total_order
+  [is_strict_total_order α r] : is_order_connected α r :=
 ⟨λ a b c h, (trichotomous _ _).imp_right (λ o,
   o.elim (λ e, e ▸ h) (λ h', trans h' h))⟩
 
 @[priority 100] -- see Note [lower instance priority]
-instance is_strict_total_order_of_is_strict_total_order'
-  [is_strict_total_order' α r] : is_strict_total_order α r :=
-{..is_strict_weak_order_of_is_order_connected}
+instance is_strict_weak_order_of_is_strict_total_order
+  [is_strict_total_order α r] : is_strict_weak_order α r :=
+{ ..is_strict_weak_order_of_is_order_connected }
+
+/-! ### Well-order -/
+
+/-- A well-founded relation. Not to be confused with `is_well_order`. -/
+@[algebra, mk_iff] class is_well_founded (α : Type u) (r : α → α → Prop) : Prop :=
+(wf : well_founded r)
+
+instance has_well_founded.is_well_founded [h : has_well_founded α] :
+  is_well_founded α has_well_founded.r := { ..h }
 
-/-! ### Extensional relation -/
+namespace is_well_founded
+variables (r) [is_well_founded α r]
 
-/-- An extensional relation is one in which an element is determined by its set
-  of predecessors. It is named for the `x ∈ y` relation in set theory, whose
-  extensionality is one of the first axioms of ZFC. -/
-@[algebra] class is_extensional (α : Type u) (r : α → α → Prop) : Prop :=
-(ext : ∀ a b, (∀ x, r x a ↔ r x b) → a = b)
+/-- Induction on a well-founded relation. -/
+theorem induction {C : α → Prop} : ∀ a, (∀ x, (∀ y, r y x → C y) → C x) → C a :=
+wf.induction
+
+/-- All values are accessible under the well-founded relation. -/
+theorem apply : ∀ a, acc r a := wf.apply
+
+/-- Creates data, given a way to generate a value from all that compare as less under a well-founded
+relation. See also `is_well_founded.fix_eq`. -/
+def fix {C : α → Sort*} : (Π (x : α), (Π (y : α), r y x → C y) → C x) → Π (x : α), C x := wf.fix
+
+/-- The value from `is_well_founded.fix` is built from the previous ones as specified. -/
+theorem fix_eq {C : α → Sort*} (F : Π (x : α), (Π (y : α), r y x → C y) → C x) :
+  ∀ x, fix r F x = F x (λ y h, fix r F y) :=
+wf.fix_eq F
+
+/-- Derive a `has_well_founded` instance from an `is_well_founded` instance. -/
+def to_has_well_founded : has_well_founded α := ⟨r, is_well_founded.wf⟩
+
+end is_well_founded
+
+theorem well_founded.asymmetric {α : Sort*} {r : α → α → Prop} (h : well_founded r) :
+  ∀ ⦃a b⦄, r a b → ¬ r b a
+| a := λ b hab hba, well_founded.asymmetric hba hab
+using_well_founded { rel_tac := λ _ _, `[exact ⟨_, h⟩],
+                     dec_tac := tactic.assumption }
 
 @[priority 100] -- see Note [lower instance priority]
-instance is_extensional_of_is_strict_total_order'
-  [is_strict_total_order' α r] : is_extensional α r :=
-⟨λ a b H, ((@trichotomous _ r _ a b)
-  .resolve_left $ mt (H _).2 (irrefl a))
-  .resolve_right $ mt (H _).1 (irrefl b)⟩
+instance is_well_founded.is_asymm (r : α → α → Prop) [is_well_founded α r] : is_asymm α r :=
+⟨is_well_founded.wf.asymmetric⟩
 
-/-! ### Well-order -/
+@[priority 100] -- see Note [lower instance priority]
+instance is_well_founded.is_irrefl (r : α → α → Prop) [is_well_founded α r] : is_irrefl α r :=
+is_asymm.is_irrefl
+
+instance (r : α → α → Prop) [i : is_well_founded α r] : is_well_founded α (relation.trans_gen r) :=
+⟨i.wf.trans_gen⟩
+
+/-- A class for a well founded relation `<`. -/
+@[reducible] def well_founded_lt (α : Type*) [has_lt α] : Prop := is_well_founded α (<)
+
+/-- A class for a well founded relation `>`. -/
+@[reducible] def well_founded_gt (α : Type*) [has_lt α] : Prop := is_well_founded α (>)
+
+@[priority 100] -- See note [lower instance priority]
+instance (α : Type*) [has_lt α] [h : well_founded_lt α] : well_founded_gt αᵒᵈ := h
+@[priority 100] -- See note [lower instance priority]
+instance (α : Type*) [has_lt α] [h : well_founded_gt α] : well_founded_lt αᵒᵈ := h
+
+theorem well_founded_gt_dual_iff (α : Type*) [has_lt α] : well_founded_gt αᵒᵈ ↔ well_founded_lt α :=
+⟨λ h, ⟨h.wf⟩, λ h, ⟨h.wf⟩⟩
+theorem well_founded_lt_dual_iff (α : Type*) [has_lt α] : well_founded_lt αᵒᵈ ↔ well_founded_gt α :=
+⟨λ h, ⟨h.wf⟩, λ h, ⟨h.wf⟩⟩
 
 /-- A well order is a well-founded linear order. -/
 @[algebra] class is_well_order (α : Type u) (r : α → α → Prop)
-  extends is_strict_total_order' α r : Prop :=
-(wf : well_founded r)
+  extends is_trichotomous α r, is_trans α r, is_well_founded α r : Prop
 
 @[priority 100] -- see Note [lower instance priority]
 instance is_well_order.is_strict_total_order {α} (r : α → α → Prop) [is_well_order α r] :
-  is_strict_total_order α r := by apply_instance
-@[priority 100] -- see Note [lower instance priority]
-instance is_well_order.is_extensional {α} (r : α → α → Prop) [is_well_order α r] :
-  is_extensional α r := by apply_instance
+  is_strict_total_order α r := { }
 @[priority 100] -- see Note [lower instance priority]
 instance is_well_order.is_trichotomous {α} (r : α → α → Prop) [is_well_order α r] :
   is_trichotomous α r := by apply_instance
@@ -222,16 +287,85 @@ instance is_well_order.is_irrefl {α} (r : α → α → Prop) [is_well_order α
 instance is_well_order.is_asymm {α} (r : α → α → Prop) [is_well_order α r] :
   is_asymm α r := by apply_instance
 
+namespace well_founded_lt
+variables [has_lt α] [well_founded_lt α]
+
+/-- Inducts on a well-founded `<` relation. -/
+theorem induction {C : α → Prop} : ∀ a, (∀ x, (∀ y, y < x → C y) → C x) → C a :=
+is_well_founded.induction _
+
+/-- All values are accessible under the well-founded `<`. -/
+theorem apply : ∀ a : α, acc (<) a := is_well_founded.apply _
+
+/-- Creates data, given a way to generate a value from all that compare as lesser. See also
+`well_founded_lt.fix_eq`. -/
+def fix {C : α → Sort*} : (Π (x : α), (Π (y : α), y < x → C y) → C x) → Π (x : α), C x :=
+is_well_founded.fix (<)
+
+/-- The value from `well_founded_lt.fix` is built from the previous ones as specified. -/
+theorem fix_eq {C : α → Sort*} (F : Π (x : α), (Π (y : α), y < x → C y) → C x) :
+  ∀ x, fix F x = F x (λ y h, fix F y) :=
+is_well_founded.fix_eq _ F
+
+/-- Derive a `has_well_founded` instance from a `well_founded_lt` instance. -/
+def to_has_well_founded : has_well_founded α := is_well_founded.to_has_well_founded (<)
+
+end well_founded_lt
+
+namespace well_founded_gt
+variables [has_lt α] [well_founded_gt α]
+
+/-- Inducts on a well-founded `>` relation. -/
+theorem induction {C : α → Prop} : ∀ a, (∀ x, (∀ y, x < y → C y) → C x) → C a :=
+is_well_founded.induction _
+
+/-- All values are accessible under the well-founded `>`. -/
+theorem apply : ∀ a : α, acc (>) a := is_well_founded.apply _
+
+/-- Creates data, given a way to generate a value from all that compare as greater. See also
+`well_founded_gt.fix_eq`. -/
+def fix {C : α → Sort*} : (Π (x : α), (Π (y : α), x < y → C y) → C x) → Π (x : α), C x :=
+is_well_founded.fix (>)
+
+/-- The value from `well_founded_gt.fix` is built from the successive ones as specified. -/
+theorem fix_eq {C : α → Sort*} (F : Π (x : α), (Π (y : α), x < y → C y) → C x) :
+  ∀ x, fix F x = F x (λ y h, fix F y) :=
+is_well_founded.fix_eq _ F
+
+/-- Derive a `has_well_founded` instance from a `well_founded_gt` instance. -/
+def to_has_well_founded : has_well_founded α := is_well_founded.to_has_well_founded (>)
+
+end well_founded_gt
+
 /-- Construct a decidable linear order from a well-founded linear order. -/
 noncomputable def is_well_order.linear_order (r : α → α → Prop) [is_well_order α r] :
   linear_order α :=
-by { letI := λ x y, classical.dec (¬r x y), exact linear_order_of_STO' r }
+by { letI := λ x y, classical.dec (¬r x y), exact linear_order_of_STO r }
+
+/-- Derive a `has_well_founded` instance from a `is_well_order` instance. -/
+def is_well_order.to_has_well_founded [has_lt α] [hwo : is_well_order α (<)] :
+  has_well_founded α := { r := (<), wf := hwo.wf }
+
+-- This isn't made into an instance as it loops with `is_irrefl α r`.
+theorem subsingleton.is_well_order [subsingleton α] (r : α → α → Prop) [hr : is_irrefl α r] :
+  is_well_order α r :=
+{ trichotomous := λ a b, or.inr $ or.inl $ subsingleton.elim a b,
+  trans        := λ a b c h, (not_rel_of_subsingleton r a b h).elim,
+  wf           := ⟨λ a, ⟨_, λ y h, (not_rel_of_subsingleton r y a h).elim⟩⟩,
+  ..hr }
 
 instance empty_relation.is_well_order [subsingleton α] : is_well_order α empty_relation :=
-{ trichotomous := λ a b, or.inr $ or.inl $ subsingleton.elim _ _,
-  irrefl       := λ a, id,
-  trans        := λ a b c, false.elim,
-  wf           := ⟨λ a, ⟨_, λ y, false.elim⟩⟩ }
+subsingleton.is_well_order _
+
+@[priority 100]
+instance is_empty.is_well_order [is_empty α] (r : α → α → Prop) : is_well_order α r :=
+{ trichotomous := is_empty_elim,
+  trans        := is_empty_elim,
+  wf           := well_founded_of_empty r }
+
+instance prod.lex.is_well_founded [is_well_founded α r] [is_well_founded β s] :
+  is_well_founded (α × β) (prod.lex r s) :=
+⟨prod.lex_wf is_well_founded.wf is_well_founded.wf⟩
 
 instance prod.lex.is_well_order [is_well_order α r] [is_well_order β s] :
   is_well_order (α × β) (prod.lex r s) :=
@@ -245,8 +379,6 @@ instance prod.lex.is_well_order [is_well_order α r] [is_well_order β s] :
       | or.inr (or.inl e) := e ▸ or.inr $ or.inl rfl
       end
     end,
-  irrefl := λ ⟨a₁, a₂⟩ h, by cases h with _ _ _ _ h _ _ _ h;
-     [exact irrefl _ h, exact irrefl _ h],
   trans := λ a b c h₁ h₂, begin
     cases h₁ with a₁ a₂ b₁ b₂ ab a₁ b₁ b₂ ab;
     cases h₂ with _ _ c₁ c₂ bc _ _ c₂ bc,
@@ -255,7 +387,17 @@ instance prod.lex.is_well_order [is_well_order α r] [is_well_order β s] :
     { exact prod.lex.left _ _ bc },
     { exact prod.lex.right _ (trans ab bc) }
   end,
-  wf := prod.lex_wf is_well_order.wf is_well_order.wf }
+  wf := prod.lex_wf is_well_founded.wf is_well_founded.wf }
+
+instance inv_image.is_well_founded (r : α → α → Prop) [is_well_founded α r] (f : β → α) :
+  is_well_founded _ (inv_image r f) :=
+⟨inv_image.wf f is_well_founded.wf⟩
+
+instance measure.is_well_founded (f : α → ℕ) : is_well_founded _ (measure f) := ⟨measure_wf f⟩
+
+theorem subrelation.is_well_founded (r : α → α → Prop) [is_well_founded α r] {s : α → α → Prop}
+  (h : subrelation s r) : is_well_founded α s :=
+⟨h.wf is_well_founded.wf⟩
 
 namespace set
 
@@ -270,6 +412,9 @@ by simp only [bounded, unbounded, not_forall, not_exists, exists_prop, not_and,
 @[simp] lemma not_unbounded_iff {r : α → α → Prop} (s : set α) : ¬unbounded r s ↔ bounded r s :=
 by rw [not_iff_comm, not_bounded_iff]
 
+lemma unbounded_of_is_empty [is_empty α] {r : α → α → Prop} (s : set α) : unbounded r s :=
+is_empty_elim
+
 end set
 
 namespace prod
@@ -318,6 +463,8 @@ instance is_nonstrict_strict_order.to_is_irrefl {r : α → α → Prop} {s : α
 section subset
 variables [has_subset α] {a b c : α}
 
+lemma subset_of_eq_of_subset (hab : a = b) (hbc : b ⊆ c) : a ⊆ c := by rwa hab
+lemma subset_of_subset_of_eq (hab : a ⊆ b) (hbc : b = c) : a ⊆ c := by rwa ←hbc
 @[refl] lemma subset_refl [is_refl α (⊆)] (a : α) : a ⊆ a := refl _
 lemma subset_rfl [is_refl α (⊆)] : a ⊆ a := refl _
 lemma subset_of_eq [is_refl α (⊆)] : a = b → a ⊆ b := λ h, h ▸ subset_rfl
@@ -332,6 +479,8 @@ antisymm h h'
 lemma superset_antisymm [is_antisymm α (⊆)] (h : a ⊆ b) (h' : b ⊆ a) : b = a :=
 antisymm' h h'
 
+alias subset_of_eq_of_subset ← eq.trans_subset
+alias subset_of_subset_of_eq ← has_subset.subset.trans_eq
 alias subset_of_eq ← eq.subset' --TODO: Fix it and kill `eq.subset`
 alias superset_of_eq ← eq.superset
 alias subset_trans      ← has_subset.subset.trans
@@ -347,8 +496,10 @@ lemma superset_antisymm_iff [is_refl α (⊆)] [is_antisymm α (⊆)] : a = b 
 end subset
 
 section ssubset
-variables [has_ssubset α]
+variables [has_ssubset α] {a b c : α}
 
+lemma ssubset_of_eq_of_ssubset (hab : a = b) (hbc : b ⊂ c) : a ⊂ c := by rwa hab
+lemma ssubset_of_ssubset_of_eq (hab : a ⊂ b) (hbc : b = c) : a ⊂ c := by rwa ←hbc
 lemma ssubset_irrefl [is_irrefl α (⊂)] (a : α) : ¬ a ⊂ a := irrefl _
 lemma ssubset_irrfl [is_irrefl α (⊂)] {a : α} : ¬ a ⊂ a := irrefl _
 lemma ne_of_ssubset [is_irrefl α (⊂)] {a b : α} : a ⊂ b → a ≠ b := ne_of_irrefl
@@ -356,6 +507,8 @@ lemma ne_of_ssuperset [is_irrefl α (⊂)] {a b : α} : a ⊂ b → b ≠ a := n
 @[trans] lemma ssubset_trans [is_trans α (⊂)] {a b c : α} : a ⊂ b → b ⊂ c → a ⊂ c := trans
 lemma ssubset_asymm [is_asymm α (⊂)] {a b : α} (h : a ⊂ b) : ¬ b ⊂ a := asymm h
 
+alias ssubset_of_eq_of_ssubset ← eq.trans_ssubset
+alias ssubset_of_ssubset_of_eq ← has_ssubset.ssubset.trans_eq
 alias ssubset_irrfl   ← has_ssubset.ssubset.false
 alias ne_of_ssubset   ← has_ssubset.ssubset.ne
 alias ne_of_ssuperset ← has_ssubset.ssubset.ne'
@@ -447,8 +600,7 @@ instance [linear_order α] : is_trichotomous α (<) := ⟨lt_trichotomy⟩
 instance [linear_order α] : is_trichotomous α (>) := is_trichotomous.swap _
 instance [linear_order α] : is_trichotomous α (≤) := is_total.is_trichotomous _
 instance [linear_order α] : is_trichotomous α (≥) := is_total.is_trichotomous _
-instance [linear_order α] : is_strict_total_order α (<) := by apply_instance
-instance [linear_order α] : is_strict_total_order' α (<) := {}
+instance [linear_order α] : is_strict_total_order α (<) := {}
 instance [linear_order α] : is_order_connected α (<) := by apply_instance
 instance [linear_order α] : is_incomp_trans α (<) := by apply_instance
 instance [linear_order α] : is_strict_weak_order α (<) := by apply_instance
@@ -461,7 +613,8 @@ lemma transitive_gt [preorder α] : transitive (@gt α _) := transitive_of_trans
 instance order_dual.is_total_le [has_le α] [is_total α (≤)] : is_total αᵒᵈ (≤) :=
 @is_total.swap α _ _
 
-instance nat.lt.is_well_order : is_well_order ℕ (<) := ⟨nat.lt_wf⟩
+instance : well_founded_lt ℕ := ⟨nat.lt_wf⟩
+instance nat.lt.is_well_order : is_well_order ℕ (<) := { }
 
 instance [linear_order α] [h : is_well_order α (<)] : is_well_order αᵒᵈ (>) := h
 instance [linear_order α] [h : is_well_order α (>)] : is_well_order αᵒᵈ (<) := h
diff --git a/src/order/rel_iso.lean b/src/order/rel_iso.lean
deleted file mode 100644
index bbb073b837f78..0000000000000
--- a/src/order/rel_iso.lean
+++ /dev/null
@@ -1,529 +0,0 @@
-/-
-Copyright (c) 2017 Mario Carneiro. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Mario Carneiro
--/
-import algebra.group.defs
-import data.fun_like.basic
-import logic.embedding
-import logic.equiv.set
-import order.rel_classes
-
-/-!
-# Relation homomorphisms, embeddings, isomorphisms
-
-This file defines relation homomorphisms, embeddings, isomorphisms and order embeddings and
-isomorphisms.
-
-## Main declarations
-
-* `rel_hom`: Relation homomorphism. A `rel_hom r s` is a function `f : α → β` such that
-  `r a b → s (f a) (f b)`.
-* `rel_embedding`: Relation embedding. A `rel_embedding r s` is an embedding `f : α ↪ β` such that
-  `r a b ↔ s (f a) (f b)`.
-* `rel_iso`: Relation isomorphism. A `rel_iso r s` is an equivalence `f : α ≃ β` such that
-  `r a b ↔ s (f a) (f b)`.
-* `sum_lex_congr`, `prod_lex_congr`: Creates a relation homomorphism between two `sum_lex` or two
-  `prod_lex` from relation homomorphisms between their arguments.
-
-## Notation
-
-* `→r`: `rel_hom`
-* `↪r`: `rel_embedding`
-* `≃r`: `rel_iso`
--/
-
-open function
-
-universes u v w
-variables {α β γ : Type*} {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
-
-/-- A relation homomorphism with respect to a given pair of relations `r` and `s`
-is a function `f : α → β` such that `r a b → s (f a) (f b)`. -/
-@[nolint has_inhabited_instance]
-structure rel_hom {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) :=
-(to_fun : α → β)
-(map_rel' : ∀ {a b}, r a b → s (to_fun a) (to_fun b))
-
-infix ` →r `:25 := rel_hom
-
-/-- `rel_hom_class F r s` asserts that `F` is a type of functions such that all `f : F`
-satisfy `r a b → s (f a) (f b)`.
-
-The relations `r` and `s` are `out_param`s since figuring them out from a goal is a higher-order
-matching problem that Lean usually can't do unaided.
--/
-class rel_hom_class (F : Type*) {α β : out_param $ Type*}
-  (r : out_param $ α → α → Prop) (s : out_param $ β → β → Prop)
-  extends fun_like F α (λ _, β) :=
-(map_rel : ∀ (f : F) {a b}, r a b → s (f a) (f b))
-export rel_hom_class (map_rel)
-
--- The free parameters `r` and `s` are `out_param`s so this is not dangerous.
-attribute [nolint dangerous_instance] rel_hom_class.to_fun_like
-
-namespace rel_hom_class
-
-variables {F : Type*}
-
-lemma map_inf [semilattice_inf α] [linear_order β]
-  [rel_hom_class F ((<) : β → β → Prop) ((<) : α → α → Prop)]
-  (a : F) (m n : β) : a (m ⊓ n) = a m ⊓ a n :=
-(strict_mono.monotone $ λ x y, map_rel a).map_inf m n
-
-lemma map_sup [semilattice_sup α] [linear_order β]
-  [rel_hom_class F ((>) : β → β → Prop) ((>) : α → α → Prop)]
-  (a : F) (m n : β) : a (m ⊔ n) = a m ⊔ a n :=
-@map_inf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _
-
-protected theorem is_irrefl [rel_hom_class F r s] (f : F) : ∀ [is_irrefl β s], is_irrefl α r
-| ⟨H⟩ := ⟨λ a h, H _ (map_rel f h)⟩
-
-protected theorem is_asymm [rel_hom_class F r s] (f : F) : ∀ [is_asymm β s], is_asymm α r
-| ⟨H⟩ := ⟨λ a b h₁ h₂, H _ _ (map_rel f h₁) (map_rel f h₂)⟩
-
-protected theorem acc [rel_hom_class F r s] (f : F) (a : α) : acc s (f a) → acc r a :=
-begin
-  generalize h : f a = b, intro ac,
-  induction ac with _ H IH generalizing a, subst h,
-  exact ⟨_, λ a' h, IH (f a') (map_rel f h) _ rfl⟩
-end
-
-protected theorem well_founded [rel_hom_class F r s] (f : F) :
-  ∀ (h : well_founded s), well_founded r
-| ⟨H⟩ := ⟨λ a, rel_hom_class.acc f _ (H _)⟩
-
-end rel_hom_class
-
-namespace rel_hom
-
-instance : rel_hom_class (r →r s) r s :=
-{ coe := λ o, o.to_fun,
-  coe_injective' := λ f g h, by { cases f, cases g, congr' },
-  map_rel := map_rel' }
-
-/-- Auxiliary instance if `rel_hom_class.to_fun_like.to_has_coe_to_fun` isn't found -/
-instance : has_coe_to_fun (r →r s) (λ _, α → β) := ⟨λ o, o.to_fun⟩
-
-initialize_simps_projections rel_hom (to_fun → apply)
-
-protected theorem map_rel (f : r →r s) : ∀ {a b}, r a b → s (f a) (f b) := f.map_rel'
-
-@[simp] theorem coe_fn_mk (f : α → β) (o) :
-  (@rel_hom.mk _ _ r s f o : α → β) = f := rfl
-
-@[simp] theorem coe_fn_to_fun (f : r →r s) : (f.to_fun : α → β) = f := rfl
-
-/-- The map `coe_fn : (r →r s) → (α → β)` is injective. -/
-theorem coe_fn_injective : @function.injective (r →r s) (α → β) coe_fn :=
-fun_like.coe_injective
-
-@[ext] theorem ext ⦃f g : r →r s⦄ (h : ∀ x, f x = g x) : f = g :=
-fun_like.ext f g h
-
-theorem ext_iff {f g : r →r s} : f = g ↔ ∀ x, f x = g x :=
-fun_like.ext_iff
-
-/-- Identity map is a relation homomorphism. -/
-@[refl, simps] protected def id (r : α → α → Prop) : r →r r :=
-⟨λ x, x, λ a b x, x⟩
-
-/-- Composition of two relation homomorphisms is a relation homomorphism. -/
-@[trans, simps] protected def comp (g : s →r t) (f : r →r s) : r →r t :=
-⟨λ x, g (f x), λ a b h, g.2 (f.2 h)⟩
-
-/-- A relation homomorphism is also a relation homomorphism between dual relations. -/
-protected def swap (f : r →r s) : swap r →r swap s :=
-⟨f, λ a b, f.map_rel⟩
-
-/-- A function is a relation homomorphism from the preimage relation of `s` to `s`. -/
-def preimage (f : α → β) (s : β → β → Prop) : f ⁻¹'o s →r s := ⟨f, λ a b, id⟩
-
-end rel_hom
-
-/-- An increasing function is injective -/
-lemma injective_of_increasing (r : α → α → Prop) (s : β → β → Prop) [is_trichotomous α r]
-  [is_irrefl β s] (f : α → β) (hf : ∀ {x y}, r x y → s (f x) (f y)) : injective f :=
-begin
-  intros x y hxy,
-  rcases trichotomous_of r x y with h | h | h,
-  have := hf h, rw hxy at this, exfalso, exact irrefl_of s (f y) this,
-  exact h,
-  have := hf h, rw hxy at this, exfalso, exact irrefl_of s (f y) this
-end
-
-/-- An increasing function is injective -/
-lemma rel_hom.injective_of_increasing [is_trichotomous α r]
-  [is_irrefl β s] (f : r →r s) : injective f :=
-injective_of_increasing r s f (λ x y, f.map_rel)
-
--- TODO: define a `rel_iff_class` so we don't have to do all the `convert` trickery?
-theorem surjective.well_founded_iff {f : α → β} (hf : surjective f)
-  (o : ∀ {a b}, r a b ↔ s (f a) (f b)) : well_founded r ↔ well_founded s :=
-iff.intro (begin
-  refine rel_hom_class.well_founded (rel_hom.mk _ _ : s →r r),
-  { exact classical.some hf.has_right_inverse },
-  intros a b h, apply o.2, convert h,
-  iterate 2 { apply classical.some_spec hf.has_right_inverse },
-end) (rel_hom_class.well_founded (⟨f, λ _ _, o.1⟩ : r →r s))
-
-/-- A relation embedding with respect to a given pair of relations `r` and `s`
-is an embedding `f : α ↪ β` such that `r a b ↔ s (f a) (f b)`. -/
-structure rel_embedding {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ↪ β :=
-(map_rel_iff' : ∀ {a b}, s (to_embedding a) (to_embedding b) ↔ r a b)
-
-infix ` ↪r `:25 := rel_embedding
-
-/-- The induced relation on a subtype is an embedding under the natural inclusion. -/
-definition subtype.rel_embedding {X : Type*} (r : X → X → Prop) (p : X → Prop) :
-  ((subtype.val : subtype p → X) ⁻¹'o r) ↪r r :=
-⟨embedding.subtype p, λ x y, iff.rfl⟩
-
-theorem preimage_equivalence {α β} (f : α → β) {s : β → β → Prop}
-  (hs : equivalence s) : equivalence (f ⁻¹'o s) :=
-⟨λ a, hs.1 _, λ a b h, hs.2.1 h, λ a b c h₁ h₂, hs.2.2 h₁ h₂⟩
-
-namespace rel_embedding
-
-/-- A relation embedding is also a relation homomorphism -/
-def to_rel_hom (f : r ↪r s) : (r →r s) :=
-{ to_fun := f.to_embedding.to_fun,
-  map_rel' := λ x y, (map_rel_iff' f).mpr }
-
-instance : has_coe (r ↪r s) (r →r s) := ⟨to_rel_hom⟩
--- see Note [function coercion]
-instance : has_coe_to_fun (r ↪r s) (λ _, α → β) := ⟨λ o, o.to_embedding⟩
-
--- TODO: define and instantiate a `rel_embedding_class` when `embedding_like` is defined
-instance : rel_hom_class (r ↪r s) r s :=
-{ coe := coe_fn,
-  coe_injective' := λ f g h, by { rcases f with ⟨⟨⟩⟩, rcases g with ⟨⟨⟩⟩, congr' },
-  map_rel := λ f a b, iff.mpr (map_rel_iff' f) }
-
-/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
-because it is a composition of multiple projections. -/
-def simps.apply (h : r ↪r s) : α → β := h
-
-initialize_simps_projections rel_embedding (to_embedding_to_fun → apply, -to_embedding)
-
-@[simp] lemma to_rel_hom_eq_coe (f : r ↪r s) : f.to_rel_hom = f := rfl
-
-@[simp] lemma coe_coe_fn (f : r ↪r s) : ((f : r →r s) : α → β) = f := rfl
-
-theorem injective (f : r ↪r s) : injective f := f.inj'
-
-theorem map_rel_iff (f : r ↪r s) : ∀ {a b}, s (f a) (f b) ↔ r a b := f.map_rel_iff'
-
-@[simp] theorem coe_fn_mk (f : α ↪ β) (o) :
-  (@rel_embedding.mk _ _ r s f o : α → β) = f := rfl
-
-@[simp] theorem coe_fn_to_embedding (f : r ↪r s) : (f.to_embedding : α → β) = f := rfl
-
-/-- The map `coe_fn : (r ↪r s) → (α → β)` is injective. -/
-theorem coe_fn_injective : @function.injective (r ↪r s) (α → β) coe_fn := fun_like.coe_injective
-
-@[ext] theorem ext ⦃f g : r ↪r s⦄ (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h
-
-theorem ext_iff {f g : r ↪r s} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
-
-/-- Identity map is a relation embedding. -/
-@[refl, simps] protected def refl (r : α → α → Prop) : r ↪r r :=
-⟨embedding.refl _, λ a b, iff.rfl⟩
-
-/-- Composition of two relation embeddings is a relation embedding. -/
-@[trans] protected def trans (f : r ↪r s) (g : s ↪r t) : r ↪r t :=
-⟨f.1.trans g.1, λ a b, by simp [f.map_rel_iff, g.map_rel_iff]⟩
-
-instance (r : α → α → Prop) : inhabited (r ↪r r) := ⟨rel_embedding.refl _⟩
-
-theorem trans_apply (f : r ↪r s) (g : s ↪r t) (a : α) : (f.trans g) a = g (f a) := rfl
-
-@[simp] theorem coe_trans (f : r ↪r s) (g : s ↪r t) : ⇑(f.trans g) = g ∘ f := rfl
-
-/-- A relation embedding is also a relation embedding between dual relations. -/
-protected def swap (f : r ↪r s) : swap r ↪r swap s :=
-⟨f.to_embedding, λ a b, f.map_rel_iff⟩
-
-/-- If `f` is injective, then it is a relation embedding from the
-  preimage relation of `s` to `s`. -/
-def preimage (f : α ↪ β) (s : β → β → Prop) : f ⁻¹'o s ↪r s := ⟨f, λ a b, iff.rfl⟩
-
-theorem eq_preimage (f : r ↪r s) : r = f ⁻¹'o s :=
-by { ext a b, exact f.map_rel_iff.symm }
-
-protected theorem is_irrefl (f : r ↪r s) [is_irrefl β s] : is_irrefl α r :=
-⟨λ a, mt f.map_rel_iff.2 (irrefl (f a))⟩
-
-protected theorem is_refl (f : r ↪r s) [is_refl β s] : is_refl α r :=
-⟨λ a, f.map_rel_iff.1 $ refl _⟩
-
-protected theorem is_symm (f : r ↪r s) [is_symm β s] : is_symm α r :=
-⟨λ a b, imp_imp_imp f.map_rel_iff.2 f.map_rel_iff.1 symm⟩
-
-protected theorem is_asymm (f : r ↪r s) [is_asymm β s] : is_asymm α r :=
-⟨λ a b h₁ h₂, asymm (f.map_rel_iff.2 h₁) (f.map_rel_iff.2 h₂)⟩
-
-protected theorem is_antisymm : ∀ (f : r ↪r s) [is_antisymm β s], is_antisymm α r
-| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h₁ h₂, f.inj' (H _ _ (o.2 h₁) (o.2 h₂))⟩
-
-protected theorem is_trans : ∀ (f : r ↪r s) [is_trans β s], is_trans α r
-| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b c h₁ h₂, o.1 (H _ _ _ (o.2 h₁) (o.2 h₂))⟩
-
-protected theorem is_total : ∀ (f : r ↪r s) [is_total β s], is_total α r
-| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o o).1 (H _ _)⟩
-
-protected theorem is_preorder : ∀ (f : r ↪r s) [is_preorder β s], is_preorder α r
-| f H := by exactI {..f.is_refl, ..f.is_trans}
-
-protected theorem is_partial_order : ∀ (f : r ↪r s) [is_partial_order β s], is_partial_order α r
-| f H := by exactI {..f.is_preorder, ..f.is_antisymm}
-
-protected theorem is_linear_order : ∀ (f : r ↪r s) [is_linear_order β s], is_linear_order α r
-| f H := by exactI {..f.is_partial_order, ..f.is_total}
-
-protected theorem is_strict_order : ∀ (f : r ↪r s) [is_strict_order β s], is_strict_order α r
-| f H := by exactI {..f.is_irrefl, ..f.is_trans}
-
-protected theorem is_trichotomous : ∀ (f : r ↪r s) [is_trichotomous β s], is_trichotomous α r
-| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o (or_congr f.inj'.eq_iff o)).1 (H _ _)⟩
-
-protected theorem is_strict_total_order' :
-  ∀ (f : r ↪r s) [is_strict_total_order' β s], is_strict_total_order' α r
-| f H := by exactI {..f.is_trichotomous, ..f.is_strict_order}
-
-protected theorem acc (f : r ↪r s) (a : α) : acc s (f a) → acc r a :=
-begin
-  generalize h : f a = b, intro ac,
-  induction ac with _ H IH generalizing a, subst h,
-  exact ⟨_, λ a' h, IH (f a') (f.map_rel_iff.2 h) _ rfl⟩
-end
-
-protected theorem well_founded : ∀ (f : r ↪r s) (h : well_founded s), well_founded r
-| f ⟨H⟩ := ⟨λ a, f.acc _ (H _)⟩
-
-protected theorem is_well_order : ∀ (f : r ↪r s) [is_well_order β s], is_well_order α r
-| f H := by exactI {wf := f.well_founded H.wf, ..f.is_strict_total_order'}
-
-/--
-To define an relation embedding from an antisymmetric relation `r` to a reflexive relation `s` it
-suffices to give a function together with a proof that it satisfies `s (f a) (f b) ↔ r a b`.
--/
-def of_map_rel_iff (f : α → β) [is_antisymm α r] [is_refl β s]
-  (hf : ∀ a b, s (f a) (f b) ↔ r a b) : r ↪r s :=
-{ to_fun := f,
-  inj' := λ x y h, antisymm ((hf _ _).1 (h ▸ refl _)) ((hf _ _).1 (h ▸ refl _)),
-  map_rel_iff' := hf }
-
-@[simp]
-lemma of_map_rel_iff_coe (f : α → β) [is_antisymm α r] [is_refl β s]
-  (hf : ∀ a b, s (f a) (f b) ↔ r a b) :
-  ⇑(of_map_rel_iff f hf : r ↪r s) = f :=
-rfl
-
-/-- It suffices to prove `f` is monotone between strict relations
-  to show it is a relation embedding. -/
-def of_monotone [is_trichotomous α r] [is_asymm β s] (f : α → β)
-  (H : ∀ a b, r a b → s (f a) (f b)) : r ↪r s :=
-begin
-  haveI := @is_asymm.is_irrefl β s _,
-  refine ⟨⟨f, λ a b e, _⟩, λ a b, ⟨λ h, _, H _ _⟩⟩,
-  { refine ((@trichotomous _ r _ a b).resolve_left _).resolve_right _;
-    exact λ h, @irrefl _ s _ _ (by simpa [e] using H _ _ h) },
-  { refine (@trichotomous _ r _ a b).resolve_right (or.rec (λ e, _) (λ h', _)),
-    { subst e, exact irrefl _ h },
-    { exact asymm (H _ _ h') h } }
-end
-
-@[simp] theorem of_monotone_coe [is_trichotomous α r] [is_asymm β s] (f : α → β) (H) :
-  (@of_monotone _ _ r s _ _ f H : α → β) = f := rfl
-
-end rel_embedding
-
-/-- A relation isomorphism is an equivalence that is also a relation embedding. -/
-structure rel_iso {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ≃ β :=
-(map_rel_iff' : ∀ {a b}, s (to_equiv a) (to_equiv b) ↔ r a b)
-
-infix ` ≃r `:25 := rel_iso
-
-namespace rel_iso
-
-/-- Convert an `rel_iso` to an `rel_embedding`. This function is also available as a coercion
-but often it is easier to write `f.to_rel_embedding` than to write explicitly `r` and `s`
-in the target type. -/
-def to_rel_embedding (f : r ≃r s) : r ↪r s :=
-⟨f.to_equiv.to_embedding, f.map_rel_iff'⟩
-
-theorem to_equiv_injective : injective (to_equiv : (r ≃r s) → α ≃ β)
-| ⟨e₁, o₁⟩ ⟨e₂, o₂⟩ h := by { congr, exact h }
-
-instance : has_coe (r ≃r s) (r ↪r s) := ⟨to_rel_embedding⟩
--- see Note [function coercion]
-instance : has_coe_to_fun (r ≃r s) (λ _, α → β) := ⟨λ f, f⟩
-
--- TODO: define and instantiate a `rel_iso_class` when `equiv_like` is defined
-instance : rel_hom_class (r ≃r s) r s :=
-{ coe := coe_fn,
-  coe_injective' := equiv.coe_fn_injective.comp to_equiv_injective,
-  map_rel := λ f a b, iff.mpr (map_rel_iff' f) }
-
-@[simp] lemma to_rel_embedding_eq_coe (f : r ≃r s) : f.to_rel_embedding = f := rfl
-
-@[simp] lemma coe_coe_fn (f : r ≃r s) : ((f : r ↪r s) : α → β) = f := rfl
-
-theorem map_rel_iff (f : r ≃r s) : ∀ {a b}, s (f a) (f b) ↔ r a b := f.map_rel_iff'
-
-@[simp] theorem coe_fn_mk (f : α ≃ β) (o : ∀ ⦃a b⦄, s (f a) (f b) ↔ r a b) :
-  (rel_iso.mk f o : α → β) = f := rfl
-
-@[simp] theorem coe_fn_to_equiv (f : r ≃r s) : (f.to_equiv : α → β) = f := rfl
-
-/-- The map `coe_fn : (r ≃r s) → (α → β)` is injective. Lean fails to parse
-`function.injective (λ e : r ≃r s, (e : α → β))`, so we use a trick to say the same. -/
-theorem coe_fn_injective : @function.injective (r ≃r s) (α → β) coe_fn := fun_like.coe_injective
-
-@[ext] theorem ext ⦃f g : r ≃r s⦄ (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h
-
-theorem ext_iff {f g : r ≃r s} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
-
-/-- Inverse map of a relation isomorphism is a relation isomorphism. -/
-@[symm] protected def symm (f : r ≃r s) : s ≃r r :=
-⟨f.to_equiv.symm, λ a b, by erw [← f.map_rel_iff, f.1.apply_symm_apply, f.1.apply_symm_apply]⟩
-
-/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
-  because it is a composition of multiple projections. -/
-def simps.apply (h : r ≃r s) : α → β := h
-/-- See Note [custom simps projection]. -/
-def simps.symm_apply (h : r ≃r s) : β → α := h.symm
-
-initialize_simps_projections rel_iso
-  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)
-
-/-- Identity map is a relation isomorphism. -/
-@[refl, simps apply] protected def refl (r : α → α → Prop) : r ≃r r :=
-⟨equiv.refl _, λ a b, iff.rfl⟩
-
-/-- Composition of two relation isomorphisms is a relation isomorphism. -/
-@[trans, simps apply] protected def trans (f₁ : r ≃r s) (f₂ : s ≃r t) : r ≃r t :=
-⟨f₁.to_equiv.trans f₂.to_equiv, λ a b, f₂.map_rel_iff.trans f₁.map_rel_iff⟩
-
-instance (r : α → α → Prop) : inhabited (r ≃r r) := ⟨rel_iso.refl _⟩
-
-@[simp] lemma default_def (r : α → α → Prop) : default = rel_iso.refl r := rfl
-
-/-- a relation isomorphism is also a relation isomorphism between dual relations. -/
-protected def swap (f : r ≃r s) : (swap r) ≃r (swap s) :=
-⟨f.to_equiv, λ _ _, f.map_rel_iff⟩
-
-@[simp] theorem coe_fn_symm_mk (f o) : ((@rel_iso.mk _ _ r s f o).symm : β → α) = f.symm :=
-rfl
-
-@[simp] theorem apply_symm_apply (e : r ≃r s) (x : β) : e (e.symm x) = x :=
-e.to_equiv.apply_symm_apply x
-
-@[simp] theorem symm_apply_apply (e : r ≃r s) (x : α) : e.symm (e x) = x :=
-e.to_equiv.symm_apply_apply x
-
-theorem rel_symm_apply (e : r ≃r s) {x y} : r x (e.symm y) ↔ s (e x) y :=
-by rw [← e.map_rel_iff, e.apply_symm_apply]
-
-theorem symm_apply_rel (e : r ≃r s) {x y} : r (e.symm x) y ↔ s x (e y) :=
-by rw [← e.map_rel_iff, e.apply_symm_apply]
-
-protected lemma bijective (e : r ≃r s) : bijective e := e.to_equiv.bijective
-protected lemma injective (e : r ≃r s) : injective e := e.to_equiv.injective
-protected lemma surjective (e : r ≃r s) : surjective e := e.to_equiv.surjective
-
-@[simp] lemma range_eq (e : r ≃r s) : set.range e = set.univ := e.surjective.range_eq
-
-@[simp] lemma eq_iff_eq (f : r ≃r s) {a b} : f a = f b ↔ a = b :=
-f.injective.eq_iff
-
-/-- Any equivalence lifts to a relation isomorphism between `s` and its preimage. -/
-protected def preimage (f : α ≃ β) (s : β → β → Prop) : f ⁻¹'o s ≃r s := ⟨f, λ a b, iff.rfl⟩
-
-/-- A surjective relation embedding is a relation isomorphism. -/
-@[simps apply]
-noncomputable def of_surjective (f : r ↪r s) (H : surjective f) : r ≃r s :=
-⟨equiv.of_bijective f ⟨f.injective, H⟩, λ a b, f.map_rel_iff⟩
-
-/--
-Given relation isomorphisms `r₁ ≃r s₁` and `r₂ ≃r s₂`, construct a relation isomorphism for the
-lexicographic orders on the sum.
--/
-def sum_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
-  (e₁ : @rel_iso α₁ β₁ r₁ s₁) (e₂ : @rel_iso α₂ β₂ r₂ s₂) :
-  sum.lex r₁ r₂ ≃r sum.lex s₁ s₂ :=
-⟨equiv.sum_congr e₁.to_equiv e₂.to_equiv, λ a b,
- by cases e₁ with f hf; cases e₂ with g hg;
-    cases a; cases b; simp [hf, hg]⟩
-
-/--
-Given relation isomorphisms `r₁ ≃r s₁` and `r₂ ≃r s₂`, construct a relation isomorphism for the
-lexicographic orders on the product.
--/
-def prod_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
-  (e₁ : @rel_iso α₁ β₁ r₁ s₁) (e₂ : @rel_iso α₂ β₂ r₂ s₂) :
-  prod.lex r₁ r₂ ≃r prod.lex s₁ s₂ :=
-⟨equiv.prod_congr e₁.to_equiv e₂.to_equiv,
-  λ a b, by simp [prod.lex_def, e₁.map_rel_iff, e₂.map_rel_iff]⟩
-
-instance : group (r ≃r r) :=
-{ one := rel_iso.refl r,
-  mul := λ f₁ f₂, f₂.trans f₁,
-  inv := rel_iso.symm,
-  mul_assoc := λ f₁ f₂ f₃, rfl,
-  one_mul := λ f, ext $ λ _, rfl,
-  mul_one := λ f, ext $ λ _, rfl,
-  mul_left_inv := λ f, ext f.symm_apply_apply }
-
-@[simp] lemma coe_one : ⇑(1 : r ≃r r) = id := rfl
-
-@[simp] lemma coe_mul (e₁ e₂ : r ≃r r) : ⇑(e₁ * e₂) = e₁ ∘ e₂ := rfl
-
-lemma mul_apply (e₁ e₂ : r ≃r r) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) := rfl
-
-@[simp] lemma inv_apply_self (e : r ≃r r) (x) : e⁻¹ (e x) = x := e.symm_apply_apply x
-
-@[simp] lemma apply_inv_self (e : r ≃r r) (x) : e (e⁻¹ x) = x := e.apply_symm_apply x
-
-end rel_iso
-
-/-- `subrel r p` is the inherited relation on a subset. -/
-def subrel (r : α → α → Prop) (p : set α) : p → p → Prop :=
-(coe : p → α) ⁻¹'o r
-
-@[simp] theorem subrel_val (r : α → α → Prop) (p : set α)
-  {a b} : subrel r p a b ↔ r a.1 b.1 := iff.rfl
-
-namespace subrel
-
-/-- The relation embedding from the inherited relation on a subset. -/
-protected def rel_embedding (r : α → α → Prop) (p : set α) :
-  subrel r p ↪r r := ⟨embedding.subtype _, λ a b, iff.rfl⟩
-
-@[simp] theorem rel_embedding_apply (r : α → α → Prop) (p a) :
-  subrel.rel_embedding r p a = a.1 := rfl
-
-instance (r : α → α → Prop) [is_well_order α r] (p : set α) : is_well_order p (subrel r p) :=
-rel_embedding.is_well_order (subrel.rel_embedding r p)
-
-instance (r : α → α → Prop) [is_refl α r] (p : set α) : is_refl p (subrel r p) :=
-⟨λ x, @is_refl.refl α r _ x⟩
-
-instance (r : α → α → Prop) [is_symm α r] (p : set α) : is_symm p (subrel r p) :=
-⟨λ x y, @is_symm.symm α r _ x y⟩
-
-instance (r : α → α → Prop) [is_trans α r] (p : set α) : is_trans p (subrel r p) :=
-⟨λ x y z, @is_trans.trans α r _ x y z⟩
-
-instance (r : α → α → Prop) [is_irrefl α r] (p : set α) : is_irrefl p (subrel r p) :=
-⟨λ x, @is_irrefl.irrefl α r _ x⟩
-
-end subrel
-
-/-- Restrict the codomain of a relation embedding. -/
-def rel_embedding.cod_restrict (p : set β) (f : r ↪r s) (H : ∀ a, f a ∈ p) : r ↪r subrel s p :=
-⟨f.to_embedding.cod_restrict p H, f.map_rel_iff'⟩
-
-@[simp] theorem rel_embedding.cod_restrict_apply (p) (f : r ↪r s) (H a) :
-  rel_embedding.cod_restrict p f H a = ⟨f a, H a⟩ := rfl
diff --git a/src/order/rel_iso/basic.lean b/src/order/rel_iso/basic.lean
new file mode 100644
index 0000000000000..2c78215fa6407
--- /dev/null
+++ b/src/order/rel_iso/basic.lean
@@ -0,0 +1,637 @@
+/-
+Copyright (c) 2017 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+import data.fun_like.basic
+import logic.embedding.basic
+import order.rel_classes
+
+/-!
+# Relation homomorphisms, embeddings, isomorphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines relation homomorphisms, embeddings, isomorphisms and order embeddings and
+isomorphisms.
+
+## Main declarations
+
+* `rel_hom`: Relation homomorphism. A `rel_hom r s` is a function `f : α → β` such that
+  `r a b → s (f a) (f b)`.
+* `rel_embedding`: Relation embedding. A `rel_embedding r s` is an embedding `f : α ↪ β` such that
+  `r a b ↔ s (f a) (f b)`.
+* `rel_iso`: Relation isomorphism. A `rel_iso r s` is an equivalence `f : α ≃ β` such that
+  `r a b ↔ s (f a) (f b)`.
+* `sum_lex_congr`, `prod_lex_congr`: Creates a relation homomorphism between two `sum_lex` or two
+  `prod_lex` from relation homomorphisms between their arguments.
+
+## Notation
+
+* `→r`: `rel_hom`
+* `↪r`: `rel_embedding`
+* `≃r`: `rel_iso`
+-/
+
+open function
+
+universes u v w
+variables {α β γ δ : Type*}
+  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop} {u : δ → δ → Prop}
+
+/-- A relation homomorphism with respect to a given pair of relations `r` and `s`
+is a function `f : α → β` such that `r a b → s (f a) (f b)`. -/
+@[nolint has_nonempty_instance]
+structure rel_hom {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) :=
+(to_fun : α → β)
+(map_rel' : ∀ {a b}, r a b → s (to_fun a) (to_fun b))
+
+infix ` →r `:25 := rel_hom
+
+section
+set_option old_structure_cmd true
+
+/-- `rel_hom_class F r s` asserts that `F` is a type of functions such that all `f : F`
+satisfy `r a b → s (f a) (f b)`.
+
+The relations `r` and `s` are `out_param`s since figuring them out from a goal is a higher-order
+matching problem that Lean usually can't do unaided.
+-/
+class rel_hom_class (F : Type*) {α β : out_param $ Type*}
+  (r : out_param $ α → α → Prop) (s : out_param $ β → β → Prop)
+  extends fun_like F α (λ _, β) :=
+(map_rel : ∀ (f : F) {a b}, r a b → s (f a) (f b))
+export rel_hom_class (map_rel)
+
+-- The free parameters `r` and `s` are `out_param`s so this is not dangerous.
+attribute [nolint dangerous_instance] rel_hom_class.to_fun_like
+
+end
+
+namespace rel_hom_class
+
+variables {F : Type*}
+
+protected theorem is_irrefl [rel_hom_class F r s] (f : F) : ∀ [is_irrefl β s], is_irrefl α r
+| ⟨H⟩ := ⟨λ a h, H _ (map_rel f h)⟩
+
+protected theorem is_asymm [rel_hom_class F r s] (f : F) : ∀ [is_asymm β s], is_asymm α r
+| ⟨H⟩ := ⟨λ a b h₁ h₂, H _ _ (map_rel f h₁) (map_rel f h₂)⟩
+
+protected theorem acc [rel_hom_class F r s] (f : F) (a : α) : acc s (f a) → acc r a :=
+begin
+  generalize h : f a = b, intro ac,
+  induction ac with _ H IH generalizing a, subst h,
+  exact ⟨_, λ a' h, IH (f a') (map_rel f h) _ rfl⟩
+end
+
+protected theorem well_founded [rel_hom_class F r s] (f : F) :
+  ∀ (h : well_founded s), well_founded r
+| ⟨H⟩ := ⟨λ a, rel_hom_class.acc f _ (H _)⟩
+
+end rel_hom_class
+
+namespace rel_hom
+
+instance : rel_hom_class (r →r s) r s :=
+{ coe := λ o, o.to_fun,
+  coe_injective' := λ f g h, by { cases f, cases g, congr' },
+  map_rel := map_rel' }
+
+/-- Auxiliary instance if `rel_hom_class.to_fun_like.to_has_coe_to_fun` isn't found -/
+instance : has_coe_to_fun (r →r s) (λ _, α → β) := ⟨λ o, o.to_fun⟩
+
+initialize_simps_projections rel_hom (to_fun → apply)
+
+protected theorem map_rel (f : r →r s) {a b} : r a b → s (f a) (f b) := f.map_rel'
+
+@[simp] theorem coe_fn_mk (f : α → β) (o) :
+  (@rel_hom.mk _ _ r s f o : α → β) = f := rfl
+
+@[simp] theorem coe_fn_to_fun (f : r →r s) : (f.to_fun : α → β) = f := rfl
+
+/-- The map `coe_fn : (r →r s) → (α → β)` is injective. -/
+theorem coe_fn_injective : @function.injective (r →r s) (α → β) coe_fn :=
+fun_like.coe_injective
+
+@[ext] theorem ext ⦃f g : r →r s⦄ (h : ∀ x, f x = g x) : f = g :=
+fun_like.ext f g h
+
+theorem ext_iff {f g : r →r s} : f = g ↔ ∀ x, f x = g x :=
+fun_like.ext_iff
+
+/-- Identity map is a relation homomorphism. -/
+@[refl, simps] protected def id (r : α → α → Prop) : r →r r :=
+⟨λ x, x, λ a b x, x⟩
+
+/-- Composition of two relation homomorphisms is a relation homomorphism. -/
+@[trans, simps] protected def comp (g : s →r t) (f : r →r s) : r →r t :=
+⟨λ x, g (f x), λ a b h, g.2 (f.2 h)⟩
+
+/-- A relation homomorphism is also a relation homomorphism between dual relations. -/
+protected def swap (f : r →r s) : swap r →r swap s :=
+⟨f, λ a b, f.map_rel⟩
+
+/-- A function is a relation homomorphism from the preimage relation of `s` to `s`. -/
+def preimage (f : α → β) (s : β → β → Prop) : f ⁻¹'o s →r s := ⟨f, λ a b, id⟩
+
+end rel_hom
+
+/-- An increasing function is injective -/
+lemma injective_of_increasing (r : α → α → Prop) (s : β → β → Prop) [is_trichotomous α r]
+  [is_irrefl β s] (f : α → β) (hf : ∀ {x y}, r x y → s (f x) (f y)) : injective f :=
+begin
+  intros x y hxy,
+  rcases trichotomous_of r x y with h | h | h,
+  have := hf h, rw hxy at this, exfalso, exact irrefl_of s (f y) this,
+  exact h,
+  have := hf h, rw hxy at this, exfalso, exact irrefl_of s (f y) this
+end
+
+/-- An increasing function is injective -/
+lemma rel_hom.injective_of_increasing [is_trichotomous α r]
+  [is_irrefl β s] (f : r →r s) : injective f :=
+injective_of_increasing r s f (λ x y, f.map_rel)
+
+-- TODO: define a `rel_iff_class` so we don't have to do all the `convert` trickery?
+theorem surjective.well_founded_iff {f : α → β} (hf : surjective f)
+  (o : ∀ {a b}, r a b ↔ s (f a) (f b)) : well_founded r ↔ well_founded s :=
+iff.intro (begin
+  refine rel_hom_class.well_founded (rel_hom.mk _ _ : s →r r),
+  { exact classical.some hf.has_right_inverse },
+  intros a b h, apply o.2, convert h,
+  iterate 2 { apply classical.some_spec hf.has_right_inverse },
+end) (rel_hom_class.well_founded (⟨f, λ _ _, o.1⟩ : r →r s))
+
+/-- A relation embedding with respect to a given pair of relations `r` and `s`
+is an embedding `f : α ↪ β` such that `r a b ↔ s (f a) (f b)`. -/
+structure rel_embedding {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ↪ β :=
+(map_rel_iff' : ∀ {a b}, s (to_embedding a) (to_embedding b) ↔ r a b)
+
+infix ` ↪r `:25 := rel_embedding
+
+/-- The induced relation on a subtype is an embedding under the natural inclusion. -/
+definition subtype.rel_embedding {X : Type*} (r : X → X → Prop) (p : X → Prop) :
+  ((subtype.val : subtype p → X) ⁻¹'o r) ↪r r :=
+⟨embedding.subtype p, λ x y, iff.rfl⟩
+
+theorem preimage_equivalence {α β} (f : α → β) {s : β → β → Prop}
+  (hs : equivalence s) : equivalence (f ⁻¹'o s) :=
+⟨λ a, hs.1 _, λ a b h, hs.2.1 h, λ a b c h₁ h₂, hs.2.2 h₁ h₂⟩
+
+namespace rel_embedding
+
+/-- A relation embedding is also a relation homomorphism -/
+def to_rel_hom (f : r ↪r s) : (r →r s) :=
+{ to_fun := f.to_embedding.to_fun,
+  map_rel' := λ x y, (map_rel_iff' f).mpr }
+
+instance : has_coe (r ↪r s) (r →r s) := ⟨to_rel_hom⟩
+-- see Note [function coercion]
+instance : has_coe_to_fun (r ↪r s) (λ _, α → β) := ⟨λ o, o.to_embedding⟩
+
+-- TODO: define and instantiate a `rel_embedding_class` when `embedding_like` is defined
+instance : rel_hom_class (r ↪r s) r s :=
+{ coe := coe_fn,
+  coe_injective' := λ f g h, by { rcases f with ⟨⟨⟩⟩, rcases g with ⟨⟨⟩⟩, congr' },
+  map_rel := λ f a b, iff.mpr (map_rel_iff' f) }
+
+/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
+because it is a composition of multiple projections. -/
+def simps.apply (h : r ↪r s) : α → β := h
+
+initialize_simps_projections rel_embedding (to_embedding_to_fun → apply, -to_embedding)
+
+@[simp] lemma to_rel_hom_eq_coe (f : r ↪r s) : f.to_rel_hom = f := rfl
+
+@[simp] lemma coe_coe_fn (f : r ↪r s) : ((f : r →r s) : α → β) = f := rfl
+
+theorem injective (f : r ↪r s) : injective f := f.inj'
+
+@[simp] theorem inj (f : r ↪r s) {a b} : f a = f b ↔ a = b := f.injective.eq_iff
+
+theorem map_rel_iff (f : r ↪r s) {a b} : s (f a) (f b) ↔ r a b := f.map_rel_iff'
+
+@[simp] theorem coe_fn_mk (f : α ↪ β) (o) :
+  (@rel_embedding.mk _ _ r s f o : α → β) = f := rfl
+
+@[simp] theorem coe_fn_to_embedding (f : r ↪r s) : (f.to_embedding : α → β) = f := rfl
+
+/-- The map `coe_fn : (r ↪r s) → (α → β)` is injective. -/
+theorem coe_fn_injective : @function.injective (r ↪r s) (α → β) coe_fn := fun_like.coe_injective
+
+@[ext] theorem ext ⦃f g : r ↪r s⦄ (h : ∀ x, f x = g x) : f = g := fun_like.ext _ _ h
+
+theorem ext_iff {f g : r ↪r s} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
+
+/-- Identity map is a relation embedding. -/
+@[refl, simps] protected def refl (r : α → α → Prop) : r ↪r r :=
+⟨embedding.refl _, λ a b, iff.rfl⟩
+
+/-- Composition of two relation embeddings is a relation embedding. -/
+@[trans] protected def trans (f : r ↪r s) (g : s ↪r t) : r ↪r t :=
+⟨f.1.trans g.1, λ a b, by simp [f.map_rel_iff, g.map_rel_iff]⟩
+
+instance (r : α → α → Prop) : inhabited (r ↪r r) := ⟨rel_embedding.refl _⟩
+
+theorem trans_apply (f : r ↪r s) (g : s ↪r t) (a : α) : (f.trans g) a = g (f a) := rfl
+
+@[simp] theorem coe_trans (f : r ↪r s) (g : s ↪r t) : ⇑(f.trans g) = g ∘ f := rfl
+
+/-- A relation embedding is also a relation embedding between dual relations. -/
+protected def swap (f : r ↪r s) : swap r ↪r swap s :=
+⟨f.to_embedding, λ a b, f.map_rel_iff⟩
+
+/-- If `f` is injective, then it is a relation embedding from the
+  preimage relation of `s` to `s`. -/
+def preimage (f : α ↪ β) (s : β → β → Prop) : f ⁻¹'o s ↪r s := ⟨f, λ a b, iff.rfl⟩
+
+theorem eq_preimage (f : r ↪r s) : r = f ⁻¹'o s :=
+by { ext a b, exact f.map_rel_iff.symm }
+
+protected theorem is_irrefl (f : r ↪r s) [is_irrefl β s] : is_irrefl α r :=
+⟨λ a, mt f.map_rel_iff.2 (irrefl (f a))⟩
+
+protected theorem is_refl (f : r ↪r s) [is_refl β s] : is_refl α r :=
+⟨λ a, f.map_rel_iff.1 $ refl _⟩
+
+protected theorem is_symm (f : r ↪r s) [is_symm β s] : is_symm α r :=
+⟨λ a b, imp_imp_imp f.map_rel_iff.2 f.map_rel_iff.1 symm⟩
+
+protected theorem is_asymm (f : r ↪r s) [is_asymm β s] : is_asymm α r :=
+⟨λ a b h₁ h₂, asymm (f.map_rel_iff.2 h₁) (f.map_rel_iff.2 h₂)⟩
+
+protected theorem is_antisymm : ∀ (f : r ↪r s) [is_antisymm β s], is_antisymm α r
+| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b h₁ h₂, f.inj' (H _ _ (o.2 h₁) (o.2 h₂))⟩
+
+protected theorem is_trans : ∀ (f : r ↪r s) [is_trans β s], is_trans α r
+| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b c h₁ h₂, o.1 (H _ _ _ (o.2 h₁) (o.2 h₂))⟩
+
+protected theorem is_total : ∀ (f : r ↪r s) [is_total β s], is_total α r
+| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o o).1 (H _ _)⟩
+
+protected theorem is_preorder : ∀ (f : r ↪r s) [is_preorder β s], is_preorder α r
+| f H := by exactI {..f.is_refl, ..f.is_trans}
+
+protected theorem is_partial_order : ∀ (f : r ↪r s) [is_partial_order β s], is_partial_order α r
+| f H := by exactI {..f.is_preorder, ..f.is_antisymm}
+
+protected theorem is_linear_order : ∀ (f : r ↪r s) [is_linear_order β s], is_linear_order α r
+| f H := by exactI {..f.is_partial_order, ..f.is_total}
+
+protected theorem is_strict_order : ∀ (f : r ↪r s) [is_strict_order β s], is_strict_order α r
+| f H := by exactI {..f.is_irrefl, ..f.is_trans}
+
+protected theorem is_trichotomous : ∀ (f : r ↪r s) [is_trichotomous β s], is_trichotomous α r
+| ⟨f, o⟩ ⟨H⟩ := ⟨λ a b, (or_congr o (or_congr f.inj'.eq_iff o)).1 (H _ _)⟩
+
+protected theorem is_strict_total_order :
+  ∀ (f : r ↪r s) [is_strict_total_order β s], is_strict_total_order α r
+| f H := by exactI {..f.is_trichotomous, ..f.is_strict_order}
+
+protected theorem acc (f : r ↪r s) (a : α) : acc s (f a) → acc r a :=
+begin
+  generalize h : f a = b, intro ac,
+  induction ac with _ H IH generalizing a, subst h,
+  exact ⟨_, λ a' h, IH (f a') (f.map_rel_iff.2 h) _ rfl⟩
+end
+
+protected theorem well_founded : ∀ (f : r ↪r s) (h : well_founded s), well_founded r
+| f ⟨H⟩ := ⟨λ a, f.acc _ (H _)⟩
+
+protected theorem is_well_founded (f : r ↪r s) [is_well_founded β s] : is_well_founded α r :=
+⟨f.well_founded is_well_founded.wf⟩
+
+protected theorem is_well_order : ∀ (f : r ↪r s) [is_well_order β s], is_well_order α r
+| f H := by exactI {wf := f.well_founded H.wf, ..f.is_strict_total_order}
+
+end rel_embedding
+
+instance subtype.well_founded_lt [has_lt α] [well_founded_lt α] (p : α → Prop) :
+  well_founded_lt (subtype p) := (subtype.rel_embedding (<) p).is_well_founded
+
+instance subtype.well_founded_gt [has_lt α] [well_founded_gt α] (p : α → Prop) :
+  well_founded_gt (subtype p) := (subtype.rel_embedding (>) p).is_well_founded
+
+/-- `quotient.mk` as a relation homomorphism between the relation and the lift of a relation. -/
+@[simps] def quotient.mk_rel_hom [setoid α] {r : α → α → Prop} (H) :
+  r →r quotient.lift₂ r H :=
+⟨@quotient.mk α _, λ _ _, id⟩
+
+/-- `quotient.out` as a relation embedding between the lift of a relation and the relation. -/
+@[simps]
+noncomputable def quotient.out_rel_embedding [setoid α] {r : α → α → Prop} (H) :
+  quotient.lift₂ r H ↪r r :=
+⟨embedding.quotient_out α, begin
+  refine λ x y, quotient.induction_on₂ x y (λ a b, _),
+  apply iff_iff_eq.2 (H _ _ _ _ _ _);
+  apply quotient.mk_out
+end⟩
+
+/-- `quotient.out'` as a relation embedding between the lift of a relation and the relation. -/
+@[simps]
+noncomputable def quotient.out'_rel_embedding {s : setoid α} {r : α → α → Prop} (H) :
+  (λ a b, quotient.lift_on₂' a b r H) ↪r r :=
+{ to_fun := quotient.out',
+  ..quotient.out_rel_embedding _ }
+
+@[simp] theorem acc_lift₂_iff [setoid α] {r : α → α → Prop} {H} {a} :
+  acc (quotient.lift₂ r H) ⟦a⟧ ↔ acc r a :=
+begin
+  split,
+  { exact rel_hom_class.acc (quotient.mk_rel_hom H) a, },
+  { intro ac,
+    induction ac with _ H IH, dsimp at IH,
+    refine ⟨_, λ q h, _⟩,
+    obtain ⟨a', rfl⟩ := q.exists_rep,
+    exact IH a' h, },
+end
+
+@[simp] theorem acc_lift_on₂'_iff {s : setoid α} {r : α → α → Prop} {H} {a} :
+  acc (λ x y, quotient.lift_on₂' x y r H) (quotient.mk' a : quotient s) ↔ acc r a :=
+acc_lift₂_iff
+
+/-- A relation is well founded iff its lift to a quotient is. -/
+theorem well_founded_lift₂_iff [setoid α] {r : α → α → Prop} {H} :
+  well_founded (quotient.lift₂ r H) ↔ well_founded r :=
+begin
+  split,
+  { exact rel_hom_class.well_founded (quotient.mk_rel_hom H), },
+  { refine λ wf, ⟨λ q, _⟩,
+    obtain ⟨a, rfl⟩ := q.exists_rep,
+    exact acc_lift₂_iff.2 (wf.apply a), },
+end
+
+alias well_founded_lift₂_iff ↔ well_founded.of_quotient_lift₂ well_founded.quotient_lift₂
+
+@[simp] theorem well_founded_lift_on₂'_iff {s : setoid α} {r : α → α → Prop} {H} :
+  well_founded (λ x y : quotient s, quotient.lift_on₂' x y r H) ↔ well_founded r :=
+well_founded_lift₂_iff
+
+alias well_founded_lift_on₂'_iff ↔
+  well_founded.of_quotient_lift_on₂' well_founded.quotient_lift_on₂'
+
+namespace rel_embedding
+
+/--
+To define an relation embedding from an antisymmetric relation `r` to a reflexive relation `s` it
+suffices to give a function together with a proof that it satisfies `s (f a) (f b) ↔ r a b`.
+-/
+def of_map_rel_iff (f : α → β) [is_antisymm α r] [is_refl β s]
+  (hf : ∀ a b, s (f a) (f b) ↔ r a b) : r ↪r s :=
+{ to_fun := f,
+  inj' := λ x y h, antisymm ((hf _ _).1 (h ▸ refl _)) ((hf _ _).1 (h ▸ refl _)),
+  map_rel_iff' := hf }
+
+@[simp]
+lemma of_map_rel_iff_coe (f : α → β) [is_antisymm α r] [is_refl β s]
+  (hf : ∀ a b, s (f a) (f b) ↔ r a b) :
+  ⇑(of_map_rel_iff f hf : r ↪r s) = f :=
+rfl
+
+/-- It suffices to prove `f` is monotone between strict relations
+  to show it is a relation embedding. -/
+def of_monotone [is_trichotomous α r] [is_asymm β s] (f : α → β)
+  (H : ∀ a b, r a b → s (f a) (f b)) : r ↪r s :=
+begin
+  haveI := @is_asymm.is_irrefl β s _,
+  refine ⟨⟨f, λ a b e, _⟩, λ a b, ⟨λ h, _, H _ _⟩⟩,
+  { refine ((@trichotomous _ r _ a b).resolve_left _).resolve_right _;
+    exact λ h, @irrefl _ s _ _ (by simpa [e] using H _ _ h) },
+  { refine (@trichotomous _ r _ a b).resolve_right (or.rec (λ e, _) (λ h', _)),
+    { subst e, exact irrefl _ h },
+    { exact asymm (H _ _ h') h } }
+end
+
+@[simp] theorem of_monotone_coe [is_trichotomous α r] [is_asymm β s] (f : α → β) (H) :
+  (@of_monotone _ _ r s _ _ f H : α → β) = f := rfl
+
+/-- A relation embedding from an empty type. -/
+def of_is_empty (r : α → α → Prop) (s : β → β → Prop) [is_empty α] : r ↪r s :=
+⟨embedding.of_is_empty, is_empty_elim⟩
+
+/-- `sum.inl` as a relation embedding into `sum.lift_rel r s`. -/
+@[simps] def sum_lift_rel_inl (r : α → α → Prop) (s : β → β → Prop) : r ↪r sum.lift_rel r s :=
+{ to_fun := sum.inl,
+  inj' := sum.inl_injective,
+  map_rel_iff' := λ a b, sum.lift_rel_inl_inl }
+
+/-- `sum.inr` as a relation embedding into `sum.lift_rel r s`. -/
+@[simps] def sum_lift_rel_inr (r : α → α → Prop) (s : β → β → Prop) : s ↪r sum.lift_rel r s :=
+{ to_fun := sum.inr,
+  inj' := sum.inr_injective,
+  map_rel_iff' := λ a b, sum.lift_rel_inr_inr }
+
+/-- `sum.map` as a relation embedding between `sum.lift_rel` relations. -/
+@[simps] def sum_lift_rel_map (f : r ↪r s) (g : t ↪r u) : sum.lift_rel r t ↪r sum.lift_rel s u :=
+{ to_fun := sum.map f g,
+  inj' := f.injective.sum_map g.injective,
+  map_rel_iff' := by { rintro (a | b) (c | d); simp [f.map_rel_iff, g.map_rel_iff] } }
+
+/-- `sum.inl` as a relation embedding into `sum.lex r s`. -/
+@[simps] def sum_lex_inl (r : α → α → Prop) (s : β → β → Prop) : r ↪r sum.lex r s :=
+{ to_fun := sum.inl,
+  inj' := sum.inl_injective,
+  map_rel_iff' := λ a b, sum.lex_inl_inl }
+
+/-- `sum.inr` as a relation embedding into `sum.lex r s`. -/
+@[simps] def sum_lex_inr (r : α → α → Prop) (s : β → β → Prop) : s ↪r sum.lex r s :=
+{ to_fun := sum.inr,
+  inj' := sum.inr_injective,
+  map_rel_iff' := λ a b, sum.lex_inr_inr }
+
+/-- `sum.map` as a relation embedding between `sum.lex` relations. -/
+@[simps] def sum_lex_map (f : r ↪r s) (g : t ↪r u) : sum.lex r t ↪r sum.lex s u :=
+{ to_fun := sum.map f g,
+  inj' := f.injective.sum_map g.injective,
+  map_rel_iff' := by { rintro (a | b) (c | d); simp [f.map_rel_iff, g.map_rel_iff] } }
+
+/-- `λ b, prod.mk a b` as a relation embedding. -/
+@[simps] def prod_lex_mk_left (s : β → β → Prop) {a : α} (h : ¬ r a a) : s ↪r prod.lex r s :=
+{ to_fun := prod.mk a,
+  inj' := prod.mk.inj_left a,
+  map_rel_iff' := λ b₁ b₂, by simp [prod.lex_def, h] }
+
+/-- `λ a, prod.mk a b` as a relation embedding. -/
+@[simps] def prod_lex_mk_right (r : α → α → Prop) {b : β} (h : ¬ s b b) : r ↪r prod.lex r s :=
+{ to_fun := λ a, (a, b),
+  inj' := prod.mk.inj_right b,
+  map_rel_iff' := λ a₁ a₂, by simp [prod.lex_def, h] }
+
+/-- `prod.map` as a relation embedding. -/
+@[simps] def prod_lex_map (f : r ↪r s) (g : t ↪r u) : prod.lex r t ↪r prod.lex s u :=
+{ to_fun := prod.map f g,
+  inj' := f.injective.prod_map g.injective,
+  map_rel_iff' := λ a b, by simp [prod.lex_def, f.map_rel_iff, g.map_rel_iff] }
+
+end rel_embedding
+
+/-- A relation isomorphism is an equivalence that is also a relation embedding. -/
+structure rel_iso {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends α ≃ β :=
+(map_rel_iff' : ∀ {a b}, s (to_equiv a) (to_equiv b) ↔ r a b)
+
+infix ` ≃r `:25 := rel_iso
+
+namespace rel_iso
+
+/-- Convert an `rel_iso` to an `rel_embedding`. This function is also available as a coercion
+but often it is easier to write `f.to_rel_embedding` than to write explicitly `r` and `s`
+in the target type. -/
+def to_rel_embedding (f : r ≃r s) : r ↪r s :=
+⟨f.to_equiv.to_embedding, λ _ _, f.map_rel_iff'⟩
+
+theorem to_equiv_injective : injective (to_equiv : (r ≃r s) → α ≃ β)
+| ⟨e₁, o₁⟩ ⟨e₂, o₂⟩ h := by { congr, exact h }
+
+instance : has_coe (r ≃r s) (r ↪r s) := ⟨to_rel_embedding⟩
+-- see Note [function coercion]
+instance : has_coe_to_fun (r ≃r s) (λ _, α → β) := ⟨λ f, f⟩
+
+-- TODO: define and instantiate a `rel_iso_class` when `equiv_like` is defined
+instance : rel_hom_class (r ≃r s) r s :=
+{ coe := coe_fn,
+  coe_injective' := equiv.coe_fn_injective.comp to_equiv_injective,
+  map_rel := λ f a b, iff.mpr (map_rel_iff' f) }
+
+@[simp] lemma to_rel_embedding_eq_coe (f : r ≃r s) : f.to_rel_embedding = f := rfl
+
+@[simp] lemma coe_coe_fn (f : r ≃r s) : ((f : r ↪r s) : α → β) = f := rfl
+
+theorem map_rel_iff (f : r ≃r s) {a b} : s (f a) (f b) ↔ r a b := f.map_rel_iff'
+
+@[simp] theorem coe_fn_mk (f : α ≃ β) (o : ∀ ⦃a b⦄, s (f a) (f b) ↔ r a b) :
+  (rel_iso.mk f o : α → β) = f := rfl
+
+@[simp] theorem coe_fn_to_equiv (f : r ≃r s) : (f.to_equiv : α → β) = f := rfl
+
+/-- The map `coe_fn : (r ≃r s) → (α → β)` is injective. Lean fails to parse
+`function.injective (λ e : r ≃r s, (e : α → β))`, so we use a trick to say the same. -/
+theorem coe_fn_injective : @function.injective (r ≃r s) (α → β) coe_fn := fun_like.coe_injective
+
+@[ext] theorem ext ⦃f g : r ≃r s⦄ (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h
+
+theorem ext_iff {f g : r ≃r s} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
+
+/-- Inverse map of a relation isomorphism is a relation isomorphism. -/
+@[symm] protected def symm (f : r ≃r s) : s ≃r r :=
+⟨f.to_equiv.symm, λ a b, by erw [← f.map_rel_iff, f.1.apply_symm_apply, f.1.apply_symm_apply]⟩
+
+/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
+  because it is a composition of multiple projections. -/
+def simps.apply (h : r ≃r s) : α → β := h
+/-- See Note [custom simps projection]. -/
+def simps.symm_apply (h : r ≃r s) : β → α := h.symm
+
+initialize_simps_projections rel_iso
+  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)
+
+/-- Identity map is a relation isomorphism. -/
+@[refl, simps apply] protected def refl (r : α → α → Prop) : r ≃r r :=
+⟨equiv.refl _, λ a b, iff.rfl⟩
+
+/-- Composition of two relation isomorphisms is a relation isomorphism. -/
+@[trans, simps apply] protected def trans (f₁ : r ≃r s) (f₂ : s ≃r t) : r ≃r t :=
+⟨f₁.to_equiv.trans f₂.to_equiv, λ a b, f₂.map_rel_iff.trans f₁.map_rel_iff⟩
+
+instance (r : α → α → Prop) : inhabited (r ≃r r) := ⟨rel_iso.refl _⟩
+
+@[simp] lemma default_def (r : α → α → Prop) : default = rel_iso.refl r := rfl
+
+/-- A relation isomorphism between equal relations on equal types. -/
+@[simps to_equiv apply] protected def cast {α β : Type u} {r : α → α → Prop} {s : β → β → Prop}
+  (h₁ : α = β) (h₂ : r == s) : r ≃r s :=
+⟨equiv.cast h₁, λ a b, by { subst h₁, rw eq_of_heq h₂, refl }⟩
+
+@[simp] protected theorem cast_symm {α β : Type u} {r : α → α → Prop} {s : β → β → Prop}
+  (h₁ : α = β) (h₂ : r == s) : (rel_iso.cast h₁ h₂).symm = rel_iso.cast h₁.symm h₂.symm := rfl
+
+@[simp] protected theorem cast_refl {α : Type u} {r : α → α → Prop}
+  (h₁ : α = α := rfl) (h₂ : r == r := heq.rfl) : rel_iso.cast h₁ h₂ = rel_iso.refl r := rfl
+
+@[simp] protected theorem cast_trans {α β γ : Type u}
+  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop} (h₁ : α = β) (h₁' : β = γ)
+  (h₂ : r == s) (h₂' : s == t): (rel_iso.cast h₁ h₂).trans (rel_iso.cast h₁' h₂') =
+  rel_iso.cast (h₁.trans h₁') (h₂.trans h₂') :=
+ext $ λ x, by { subst h₁, refl }
+
+/-- a relation isomorphism is also a relation isomorphism between dual relations. -/
+protected def swap (f : r ≃r s) : (swap r) ≃r (swap s) :=
+⟨f.to_equiv, λ _ _, f.map_rel_iff⟩
+
+@[simp] theorem coe_fn_symm_mk (f o) : ((@rel_iso.mk _ _ r s f o).symm : β → α) = f.symm :=
+rfl
+
+@[simp] theorem apply_symm_apply (e : r ≃r s) (x : β) : e (e.symm x) = x :=
+e.to_equiv.apply_symm_apply x
+
+@[simp] theorem symm_apply_apply (e : r ≃r s) (x : α) : e.symm (e x) = x :=
+e.to_equiv.symm_apply_apply x
+
+theorem rel_symm_apply (e : r ≃r s) {x y} : r x (e.symm y) ↔ s (e x) y :=
+by rw [← e.map_rel_iff, e.apply_symm_apply]
+
+theorem symm_apply_rel (e : r ≃r s) {x y} : r (e.symm x) y ↔ s x (e y) :=
+by rw [← e.map_rel_iff, e.apply_symm_apply]
+
+protected lemma bijective (e : r ≃r s) : bijective e := e.to_equiv.bijective
+protected lemma injective (e : r ≃r s) : injective e := e.to_equiv.injective
+protected lemma surjective (e : r ≃r s) : surjective e := e.to_equiv.surjective
+
+@[simp] lemma eq_iff_eq (f : r ≃r s) {a b} : f a = f b ↔ a = b :=
+f.injective.eq_iff
+
+/-- Any equivalence lifts to a relation isomorphism between `s` and its preimage. -/
+protected def preimage (f : α ≃ β) (s : β → β → Prop) : f ⁻¹'o s ≃r s := ⟨f, λ a b, iff.rfl⟩
+
+instance is_well_order.preimage {α : Type u} (r : α → α → Prop) [is_well_order α r] (f : β ≃ α) :
+  is_well_order β (f ⁻¹'o r) :=
+@rel_embedding.is_well_order _ _ (f ⁻¹'o r) r (rel_iso.preimage f r) _
+
+instance is_well_order.ulift {α : Type u} (r : α → α → Prop) [is_well_order α r] :
+  is_well_order (ulift α) (ulift.down ⁻¹'o r) :=
+is_well_order.preimage r equiv.ulift
+
+/-- A surjective relation embedding is a relation isomorphism. -/
+@[simps apply]
+noncomputable def of_surjective (f : r ↪r s) (H : surjective f) : r ≃r s :=
+⟨equiv.of_bijective f ⟨f.injective, H⟩, λ a b, f.map_rel_iff⟩
+
+/--
+Given relation isomorphisms `r₁ ≃r s₁` and `r₂ ≃r s₂`, construct a relation isomorphism for the
+lexicographic orders on the sum.
+-/
+def sum_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
+  (e₁ : @rel_iso α₁ β₁ r₁ s₁) (e₂ : @rel_iso α₂ β₂ r₂ s₂) :
+  sum.lex r₁ r₂ ≃r sum.lex s₁ s₂ :=
+⟨equiv.sum_congr e₁.to_equiv e₂.to_equiv, λ a b,
+ by cases e₁ with f hf; cases e₂ with g hg;
+    cases a; cases b; simp [hf, hg]⟩
+
+/--
+Given relation isomorphisms `r₁ ≃r s₁` and `r₂ ≃r s₂`, construct a relation isomorphism for the
+lexicographic orders on the product.
+-/
+def prod_lex_congr {α₁ α₂ β₁ β₂ r₁ r₂ s₁ s₂}
+  (e₁ : @rel_iso α₁ β₁ r₁ s₁) (e₂ : @rel_iso α₂ β₂ r₂ s₂) :
+  prod.lex r₁ r₂ ≃r prod.lex s₁ s₂ :=
+⟨equiv.prod_congr e₁.to_equiv e₂.to_equiv,
+  λ a b, by simp [prod.lex_def, e₁.map_rel_iff, e₂.map_rel_iff]⟩
+
+/-- Two relations on empty types are isomorphic. -/
+def rel_iso_of_is_empty (r : α → α → Prop) (s : β → β → Prop) [is_empty α] [is_empty β] : r ≃r s :=
+⟨equiv.equiv_of_is_empty α β, is_empty_elim⟩
+
+/-- Two irreflexive relations on a unique type are isomorphic. -/
+def rel_iso_of_unique_of_irrefl (r : α → α → Prop) (s : β → β → Prop)
+  [is_irrefl α r] [is_irrefl β s] [unique α] [unique β] : r ≃r s :=
+⟨equiv.equiv_of_unique α β,
+  λ x y, by simp [not_rel_of_subsingleton r, not_rel_of_subsingleton s]⟩
+
+/-- Two reflexive relations on a unique type are isomorphic. -/
+def rel_iso_of_unique_of_refl (r : α → α → Prop) (s : β → β → Prop)
+  [is_refl α r] [is_refl β s] [unique α] [unique β] : r ≃r s :=
+⟨equiv.equiv_of_unique α β,
+  λ x y, by simp [rel_of_subsingleton r, rel_of_subsingleton s]⟩
+
+end rel_iso
diff --git a/src/order/rel_iso/group.lean b/src/order/rel_iso/group.lean
new file mode 100644
index 0000000000000..0cc4b0c71b194
--- /dev/null
+++ b/src/order/rel_iso/group.lean
@@ -0,0 +1,40 @@
+/-
+Copyright (c) 2017 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+import algebra.group.defs
+import order.rel_iso.basic
+
+/-!
+# Relation isomorphisms form a group
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+variables {α: Type*}
+  {r : α → α → Prop}
+
+namespace rel_iso
+
+instance : group (r ≃r r) :=
+{ one := rel_iso.refl r,
+  mul := λ f₁ f₂, f₂.trans f₁,
+  inv := rel_iso.symm,
+  mul_assoc := λ f₁ f₂ f₃, rfl,
+  one_mul := λ f, ext $ λ _, rfl,
+  mul_one := λ f, ext $ λ _, rfl,
+  mul_left_inv := λ f, ext f.symm_apply_apply }
+
+@[simp] lemma coe_one : ⇑(1 : r ≃r r) = id := rfl
+
+@[simp] lemma coe_mul (e₁ e₂ : r ≃r r) : ⇑(e₁ * e₂) = e₁ ∘ e₂ := rfl
+
+lemma mul_apply (e₁ e₂ : r ≃r r) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) := rfl
+
+@[simp] lemma inv_apply_self (e : r ≃r r) (x) : e⁻¹ (e x) = x := e.symm_apply_apply x
+
+@[simp] lemma apply_inv_self (e : r ≃r r) (x) : e (e⁻¹ x) = x := e.apply_symm_apply x
+
+end rel_iso
diff --git a/src/order/rel_iso/set.lean b/src/order/rel_iso/set.lean
new file mode 100644
index 0000000000000..86649ec7ef5a0
--- /dev/null
+++ b/src/order/rel_iso/set.lean
@@ -0,0 +1,84 @@
+/-
+Copyright (c) 2017 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+import order.rel_iso.basic
+import logic.embedding.set
+
+/-!
+# Interactions between relation homomorphisms and sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+It is likely that there are better homes for many of these statement,
+in files further down the import graph.
+-/
+
+open function
+
+universes u v w
+variables {α β γ δ : Type*}
+  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop} {u : δ → δ → Prop}
+
+namespace rel_hom_class
+
+variables {F : Type*}
+
+lemma map_inf [semilattice_inf α] [linear_order β]
+  [rel_hom_class F ((<) : β → β → Prop) ((<) : α → α → Prop)]
+  (a : F) (m n : β) : a (m ⊓ n) = a m ⊓ a n :=
+(strict_mono.monotone $ λ x y, map_rel a).map_inf m n
+
+lemma map_sup [semilattice_sup α] [linear_order β]
+  [rel_hom_class F ((>) : β → β → Prop) ((>) : α → α → Prop)]
+  (a : F) (m n : β) : a (m ⊔ n) = a m ⊔ a n :=
+@map_inf αᵒᵈ βᵒᵈ _ _ _ _ _ _ _
+end rel_hom_class
+
+namespace rel_iso
+
+@[simp] lemma range_eq (e : r ≃r s) : set.range e = set.univ := e.surjective.range_eq
+
+end rel_iso
+
+/-- `subrel r p` is the inherited relation on a subset. -/
+def subrel (r : α → α → Prop) (p : set α) : p → p → Prop :=
+(coe : p → α) ⁻¹'o r
+
+@[simp] theorem subrel_val (r : α → α → Prop) (p : set α)
+  {a b} : subrel r p a b ↔ r a.1 b.1 := iff.rfl
+
+namespace subrel
+
+/-- The relation embedding from the inherited relation on a subset. -/
+protected def rel_embedding (r : α → α → Prop) (p : set α) :
+  subrel r p ↪r r := ⟨embedding.subtype _, λ a b, iff.rfl⟩
+
+@[simp] theorem rel_embedding_apply (r : α → α → Prop) (p a) :
+  subrel.rel_embedding r p a = a.1 := rfl
+
+instance (r : α → α → Prop) [is_well_order α r] (p : set α) : is_well_order p (subrel r p) :=
+rel_embedding.is_well_order (subrel.rel_embedding r p)
+
+instance (r : α → α → Prop) [is_refl α r] (p : set α) : is_refl p (subrel r p) :=
+⟨λ x, @is_refl.refl α r _ x⟩
+
+instance (r : α → α → Prop) [is_symm α r] (p : set α) : is_symm p (subrel r p) :=
+⟨λ x y, @is_symm.symm α r _ x y⟩
+
+instance (r : α → α → Prop) [is_trans α r] (p : set α) : is_trans p (subrel r p) :=
+⟨λ x y z, @is_trans.trans α r _ x y z⟩
+
+instance (r : α → α → Prop) [is_irrefl α r] (p : set α) : is_irrefl p (subrel r p) :=
+⟨λ x, @is_irrefl.irrefl α r _ x⟩
+
+end subrel
+
+/-- Restrict the codomain of a relation embedding. -/
+def rel_embedding.cod_restrict (p : set β) (f : r ↪r s) (H : ∀ a, f a ∈ p) : r ↪r subrel s p :=
+⟨f.to_embedding.cod_restrict p H, λ _ _, f.map_rel_iff'⟩
+
+@[simp] theorem rel_embedding.cod_restrict_apply (p) (f : r ↪r s) (H a) :
+  rel_embedding.cod_restrict p f H a = ⟨f a, H a⟩ := rfl
diff --git a/src/order/semiconj_Sup.lean b/src/order/semiconj_Sup.lean
index 12f70d69ab22b..d81a361900c44 100644
--- a/src/order/semiconj_Sup.lean
+++ b/src/order/semiconj_Sup.lean
@@ -3,14 +3,19 @@ Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import algebra.hom.equiv
 import logic.function.conjugate
-import order.conditionally_complete_lattice
+import order.bounds.order_iso
+import order.conditionally_complete_lattice.basic
+import order.rel_iso.group
 import order.ord_continuous
+import algebra.hom.equiv.units.basic
 
 /-!
 # Semiconjugate by `Sup`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove two facts about semiconjugate (families of) functions.
 
 First, if an order isomorphism `fa : α → α` is semiconjugate to an order embedding `fb : β → β` by
@@ -132,3 +137,6 @@ lemma cSup_div_semiconj [conditionally_complete_lattice α] [group G]
 semiconj_of_is_lub f₁ f₂ (λ x, is_lub_cSup (range_nonempty _) (hbdd x)) _
 
 end function
+
+-- Guard against import creep
+assert_not_exists finset
diff --git a/src/order/succ_pred/basic.lean b/src/order/succ_pred/basic.lean
index a657e33acc0b5..6f0151b672335 100644
--- a/src/order/succ_pred/basic.lean
+++ b/src/order/succ_pred/basic.lean
@@ -6,11 +6,13 @@ Authors: Yaël Dillies
 import order.complete_lattice
 import order.cover
 import order.iterate
-import tactic.monotonicity
 
 /-!
 # Successor and predecessor
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines successor and predecessor orders. `succ a`, the successor of an element `a : α` is
 the least element greater than `a`. `pred a` is the greatest element less than `a`. Typical examples
 include `ℕ`, `ℤ`, `ℕ+`, `fin n`, but also `enat`, the lexicographic order of a successor/predecessor
@@ -177,7 +179,7 @@ lemma le_of_lt_succ {a b : α} : a < succ b → a ≤ b := succ_order.le_of_lt_s
 @[simp] lemma lt_succ_iff_not_is_max : a < succ a ↔ ¬ is_max a :=
 ⟨not_is_max_of_lt, λ ha, (le_succ a).lt_of_not_le $ λ h, ha $ max_of_succ_le h⟩
 
-alias lt_succ_iff_not_is_max ↔ _ order.lt_succ_of_not_is_max
+alias lt_succ_iff_not_is_max ↔ _ lt_succ_of_not_is_max
 
 lemma wcovby_succ (a : α) : a ⩿ succ a :=
 ⟨le_succ a, λ b hb, (succ_le_of_lt hb).not_lt⟩
@@ -191,6 +193,14 @@ lemma lt_succ_iff_of_not_is_max (ha : ¬ is_max a) : b < succ a ↔ b ≤ a :=
 lemma succ_le_iff_of_not_is_max (ha : ¬ is_max a) : succ a ≤ b ↔ a < b :=
 ⟨(lt_succ_of_not_is_max ha).trans_le, succ_le_of_lt⟩
 
+lemma succ_lt_succ_iff_of_not_is_max (ha : ¬ is_max a) (hb : ¬ is_max b) :
+  succ a < succ b ↔ a < b :=
+by rw [lt_succ_iff_of_not_is_max hb, succ_le_iff_of_not_is_max ha]
+
+lemma succ_le_succ_iff_of_not_is_max (ha : ¬ is_max a) (hb : ¬ is_max b) :
+  succ a ≤ succ b ↔ a ≤ b :=
+by rw [succ_le_iff_of_not_is_max ha, lt_succ_iff_of_not_is_max hb]
+
 @[simp, mono] lemma succ_le_succ (h : a ≤ b) : succ a ≤ succ b :=
 begin
   by_cases hb : is_max b,
@@ -202,6 +212,33 @@ end
 
 lemma succ_mono : monotone (succ : α → α) := λ a b, succ_le_succ
 
+lemma le_succ_iterate (k : ℕ) (x : α) : x ≤ (succ^[k] x) :=
+begin
+  conv_lhs { rw (by simp only [function.iterate_id, id.def] : x = (id^[k] x)) },
+  exact monotone.le_iterate_of_le succ_mono le_succ k x,
+end
+
+lemma is_max_iterate_succ_of_eq_of_lt {n m : ℕ}
+  (h_eq : (succ^[n] a) = (succ^[m] a)) (h_lt : n < m) :
+  is_max (succ^[n] a) :=
+begin
+  refine max_of_succ_le (le_trans _ h_eq.symm.le),
+  have : succ (succ^[n] a) = (succ^[n + 1] a), by rw function.iterate_succ',
+  rw this,
+  have h_le : n + 1 ≤ m := nat.succ_le_of_lt h_lt,
+  exact monotone.monotone_iterate_of_le_map succ_mono (le_succ a) h_le,
+end
+
+lemma is_max_iterate_succ_of_eq_of_ne {n m : ℕ}
+  (h_eq : (succ^[n] a) = (succ^[m] a)) (h_ne : n ≠ m) :
+  is_max (succ^[n] a) :=
+begin
+  cases le_total n m,
+  { exact is_max_iterate_succ_of_eq_of_lt h_eq (lt_of_le_of_ne h h_ne), },
+  { rw h_eq,
+    exact is_max_iterate_succ_of_eq_of_lt h_eq.symm (lt_of_le_of_ne h h_ne.symm), },
+end
+
 lemma Iio_succ_of_not_is_max (ha : ¬ is_max a) : Iio (succ a) = Iic a :=
 set.ext $ λ x, lt_succ_iff_of_not_is_max ha
 
@@ -224,17 +261,14 @@ section no_max_order
 variables [no_max_order α]
 
 lemma lt_succ (a : α) : a < succ a := lt_succ_of_not_is_max $ not_is_max a
-lemma lt_succ_iff : a < succ b ↔ a ≤ b := lt_succ_iff_of_not_is_max $ not_is_max b
-lemma succ_le_iff : succ a ≤ b ↔ a < b := succ_le_iff_of_not_is_max $ not_is_max a
-
-@[simp] lemma succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b :=
-⟨λ h, le_of_lt_succ $ (lt_succ a).trans_le h, λ h, succ_le_of_lt $ h.trans_lt $ lt_succ b⟩
+@[simp] lemma lt_succ_iff : a < succ b ↔ a ≤ b := lt_succ_iff_of_not_is_max $ not_is_max b
+@[simp] lemma succ_le_iff : succ a ≤ b ↔ a < b := succ_le_iff_of_not_is_max $ not_is_max a
 
-lemma succ_lt_succ_iff : succ a < succ b ↔ a < b :=
-lt_iff_lt_of_le_iff_le' succ_le_succ_iff succ_le_succ_iff
+lemma succ_le_succ_iff : succ a ≤ succ b ↔ a ≤ b := by simp
+lemma succ_lt_succ_iff : succ a < succ b ↔ a < b := by simp
 
-alias succ_le_succ_iff ↔ order.le_of_succ_le_succ _
-alias succ_lt_succ_iff ↔ order.lt_of_succ_lt_succ order.succ_lt_succ
+alias succ_le_succ_iff ↔ le_of_succ_le_succ _
+alias succ_lt_succ_iff ↔ lt_of_succ_lt_succ succ_lt_succ
 
 lemma succ_strict_mono : strict_mono (succ : α → α) := λ a b, succ_lt_succ
 
@@ -243,16 +277,16 @@ lemma covby_succ (a : α) : a ⋖ succ a := covby_succ_of_not_is_max $ not_is_ma
 @[simp] lemma Iio_succ (a : α) : Iio (succ a) = Iic a := Iio_succ_of_not_is_max $ not_is_max _
 @[simp] lemma Ici_succ (a : α) : Ici (succ a) = Ioi a := Ici_succ_of_not_is_max $ not_is_max _
 
-lemma Ico_succ_right (a b : α) : Ico a (succ b) = Icc a b :=
+@[simp] lemma Ico_succ_right (a b : α) : Ico a (succ b) = Icc a b :=
 Ico_succ_right_of_not_is_max $ not_is_max _
 
-lemma Ioo_succ_right (a b : α) : Ioo a (succ b) = Ioc a b :=
+@[simp] lemma Ioo_succ_right (a b : α) : Ioo a (succ b) = Ioc a b :=
 Ioo_succ_right_of_not_is_max $ not_is_max _
 
-lemma Icc_succ_left (a b : α) : Icc (succ a) b = Ioc a b :=
+@[simp] lemma Icc_succ_left (a b : α) : Icc (succ a) b = Ioc a b :=
 Icc_succ_left_of_not_is_max $ not_is_max _
 
-lemma Ico_succ_left (a b : α) : Ico (succ a) b = Ioo a b :=
+@[simp] lemma Ico_succ_left (a b : α) : Ico (succ a) b = Ioo a b :=
 Ico_succ_left_of_not_is_max $ not_is_max _
 
 end no_max_order
@@ -264,7 +298,12 @@ variables [partial_order α] [succ_order α] {a b : α}
 @[simp] lemma succ_eq_iff_is_max : succ a = a ↔ is_max a :=
 ⟨λ h, max_of_succ_le h.le, λ h, h.eq_of_ge $ le_succ _⟩
 
-alias succ_eq_iff_is_max ↔ _ is_max.succ_eq
+alias succ_eq_iff_is_max ↔ _ _root_.is_max.succ_eq
+
+lemma succ_eq_succ_iff_of_not_is_max (ha : ¬ is_max a) (hb : ¬ is_max b) :
+  succ a = succ b ↔ a = b :=
+by rw [eq_iff_le_not_lt, eq_iff_le_not_lt,
+  succ_le_succ_iff_of_not_is_max ha hb, succ_lt_succ_iff_of_not_is_max ha hb]
 
 lemma le_le_succ_iff : a ≤ b ∧ b ≤ succ a ↔ b = a ∨ b = succ a :=
 begin
@@ -278,6 +317,13 @@ end
 lemma _root_.covby.succ_eq (h : a ⋖ b) : succ a = b :=
 (succ_le_of_lt h.lt).eq_of_not_lt $ λ h', h.2 (lt_succ_of_not_is_max h.lt.not_is_max) h'
 
+lemma _root_.wcovby.le_succ (h : a ⩿ b) : b ≤ succ a :=
+begin
+  obtain h | rfl := h.covby_or_eq,
+  { exact h.succ_eq.ge },
+  { exact le_succ _ }
+end
+
 lemma le_succ_iff_eq_or_le : a ≤ succ b ↔ a = succ b ∨ a ≤ b :=
 begin
   by_cases hb : is_max b,
@@ -296,16 +342,27 @@ by simp_rw [←Ici_inter_Iic, Iic_succ, inter_insert_of_mem (mem_Ici.2 h)]
 lemma Ioc_succ_right (h : a < succ b) : Ioc a (succ b) = insert (succ b) (Ioc a b) :=
 by simp_rw [←Ioi_inter_Iic, Iic_succ, inter_insert_of_mem (mem_Ioi.2 h)]
 
+lemma Iio_succ_eq_insert_of_not_is_max (h : ¬is_max a) : Iio (succ a) = insert a (Iio a) :=
+ext $ λ _, lt_succ_iff_eq_or_lt_of_not_is_max h
+
+lemma Ico_succ_right_eq_insert_of_not_is_max (h₁ : a ≤ b) (h₂ : ¬is_max b) :
+  Ico a (succ b) = insert b (Ico a b) :=
+by simp_rw [←Iio_inter_Ici, Iio_succ_eq_insert_of_not_is_max h₂, insert_inter_of_mem (mem_Ici.2 h₁)]
+
+lemma Ioo_succ_right_eq_insert_of_not_is_max (h₁ : a < b) (h₂ : ¬is_max b) :
+  Ioo a (succ b) = insert b (Ioo a b) :=
+by simp_rw [←Iio_inter_Ioi, Iio_succ_eq_insert_of_not_is_max h₂, insert_inter_of_mem (mem_Ioi.2 h₁)]
+
 section no_max_order
 variables [no_max_order α]
 
 @[simp] lemma succ_eq_succ_iff : succ a = succ b ↔ a = b :=
-by simp_rw [eq_iff_le_not_lt, succ_le_succ_iff, succ_lt_succ_iff]
+succ_eq_succ_iff_of_not_is_max (not_is_max a) (not_is_max b)
 
 lemma succ_injective : injective (succ : α → α) := λ a b, succ_eq_succ_iff.1
 lemma succ_ne_succ_iff : succ a ≠ succ b ↔ a ≠ b := succ_injective.ne_iff
 
-alias succ_ne_succ_iff ↔ _ order.succ_ne_succ
+alias succ_ne_succ_iff ↔ _ succ_ne_succ
 
 lemma lt_succ_iff_eq_or_lt : a < succ b ↔ a = b ∨ a < b := lt_succ_iff.trans le_iff_eq_or_lt
 
@@ -313,13 +370,13 @@ lemma succ_eq_iff_covby : succ a = b ↔ a ⋖ b :=
 ⟨by { rintro rfl, exact covby_succ _ }, covby.succ_eq⟩
 
 lemma Iio_succ_eq_insert (a : α) : Iio (succ a) = insert a (Iio a) :=
-ext $ λ _, lt_succ_iff_eq_or_lt
+Iio_succ_eq_insert_of_not_is_max $ not_is_max a
 
 lemma Ico_succ_right_eq_insert (h : a ≤ b) : Ico a (succ b) = insert b (Ico a b) :=
-by simp_rw [←Iio_inter_Ici, Iio_succ_eq_insert, insert_inter_of_mem (mem_Ici.2 h)]
+Ico_succ_right_eq_insert_of_not_is_max h $ not_is_max b
 
 lemma Ioo_succ_right_eq_insert (h : a < b) : Ioo a (succ b) = insert b (Ioo a b) :=
-by simp_rw [←Iio_inter_Ioi, Iio_succ_eq_insert, insert_inter_of_mem (mem_Ioi.2 h)]
+Ioo_succ_right_eq_insert_of_not_is_max h $ not_is_max b
 
 end no_max_order
 
@@ -335,7 +392,15 @@ lt_succ_iff_not_is_max.trans not_is_max_iff_ne_top
 end order_top
 
 section order_bot
-variables [order_bot α] [nontrivial α]
+variable [order_bot α]
+
+@[simp] lemma lt_succ_bot_iff [no_max_order α] : a < succ ⊥ ↔ a = ⊥ :=
+by rw [lt_succ_iff, le_bot_iff]
+
+lemma le_succ_bot_iff : a ≤ succ ⊥ ↔ a = ⊥ ∨ a = succ ⊥ :=
+by rw [le_succ_iff_eq_or_le, le_bot_iff, or_comm]
+
+variable [nontrivial α]
 
 lemma bot_lt_succ (a : α) : ⊥ < succ a :=
 (lt_succ_of_not_is_max not_is_max_bot).trans_le $ succ_mono bot_le
@@ -388,7 +453,7 @@ lemma le_of_pred_lt {a b : α} : pred a < b → a ≤ b := pred_order.le_of_pred
 @[simp] lemma pred_lt_iff_not_is_min : pred a < a ↔ ¬ is_min a :=
 ⟨not_is_min_of_lt, λ ha, (pred_le a).lt_of_not_le $ λ h, ha $ min_of_le_pred h⟩
 
-alias pred_lt_iff_not_is_min ↔ _ order.pred_lt_of_not_is_min
+alias pred_lt_iff_not_is_min ↔ _ pred_lt_of_not_is_min
 
 lemma pred_wcovby (a : α) : pred a ⩿ a :=
 ⟨pred_le a, λ b hb, (le_of_pred_lt hb).not_lt⟩
@@ -406,6 +471,22 @@ lemma le_pred_iff_of_not_is_min (ha : ¬ is_min a) : b ≤ pred a ↔ b < a :=
 
 lemma pred_mono : monotone (pred : α → α) := λ a b, pred_le_pred
 
+lemma pred_iterate_le (k : ℕ) (x : α) : (pred^[k] x) ≤ x :=
+begin
+  conv_rhs { rw (by simp only [function.iterate_id, id.def] : x = (id^[k] x)) },
+  exact monotone.iterate_le_of_le pred_mono pred_le k x,
+end
+
+lemma is_min_iterate_pred_of_eq_of_lt {n m : ℕ}
+  (h_eq : (pred^[n] a) = (pred^[m] a)) (h_lt : n < m) :
+  is_min (pred^[n] a) :=
+@is_max_iterate_succ_of_eq_of_lt αᵒᵈ _ _ _ _ _ h_eq h_lt
+
+lemma is_min_iterate_pred_of_eq_of_ne {n m : ℕ}
+  (h_eq : (pred^[n] a) = (pred^[m] a)) (h_ne : n ≠ m) :
+  is_min (pred^[n] a) :=
+@is_max_iterate_succ_of_eq_of_ne αᵒᵈ _ _ _ _ _ h_eq h_ne
+
 lemma Ioi_pred_of_not_is_min (ha : ¬ is_min a) : Ioi (pred a) = Ici a :=
 set.ext $ λ x, pred_lt_iff_of_not_is_min ha
 
@@ -428,17 +509,14 @@ section no_min_order
 variables [no_min_order α]
 
 lemma pred_lt (a : α) : pred a < a := pred_lt_of_not_is_min $ not_is_min a
-lemma pred_lt_iff : pred a < b ↔ a ≤ b := pred_lt_iff_of_not_is_min $ not_is_min a
-lemma le_pred_iff : a ≤ pred b ↔ a < b := le_pred_iff_of_not_is_min $ not_is_min b
+@[simp] lemma pred_lt_iff : pred a < b ↔ a ≤ b := pred_lt_iff_of_not_is_min $ not_is_min a
+@[simp] lemma le_pred_iff : a ≤ pred b ↔ a < b := le_pred_iff_of_not_is_min $ not_is_min b
 
-@[simp] lemma pred_le_pred_iff : pred a ≤ pred b ↔ a ≤ b :=
-⟨λ h, le_of_pred_lt $ h.trans_lt (pred_lt b), λ h, le_pred_of_lt $ (pred_lt a).trans_le h⟩
+lemma pred_le_pred_iff : pred a ≤ pred b ↔ a ≤ b := by simp
+lemma pred_lt_pred_iff : pred a < pred b ↔ a < b := by simp
 
-@[simp] lemma pred_lt_pred_iff : pred a < pred b ↔ a < b :=
-by simp_rw [lt_iff_le_not_le, pred_le_pred_iff]
-
-alias pred_le_pred_iff ↔ order.le_of_pred_le_pred _
-alias pred_lt_pred_iff ↔ order.lt_of_pred_lt_pred pred_lt_pred
+alias pred_le_pred_iff ↔ le_of_pred_le_pred _
+alias pred_lt_pred_iff ↔ lt_of_pred_lt_pred pred_lt_pred
 
 lemma pred_strict_mono : strict_mono (pred : α → α) := λ a b, pred_lt_pred
 
@@ -447,16 +525,16 @@ lemma pred_covby (a : α) : pred a ⋖ a := pred_covby_of_not_is_min $ not_is_mi
 @[simp] lemma Ioi_pred (a : α) : Ioi (pred a) = Ici a := Ioi_pred_of_not_is_min $ not_is_min a
 @[simp] lemma Iic_pred (a : α) : Iic (pred a) = Iio a := Iic_pred_of_not_is_min $ not_is_min a
 
-lemma Ioc_pred_left (a b : α) : Ioc (pred a) b = Icc a b :=
+@[simp] lemma Ioc_pred_left (a b : α) : Ioc (pred a) b = Icc a b :=
 Ioc_pred_left_of_not_is_min $ not_is_min _
 
-lemma Ioo_pred_left (a b : α) : Ioo (pred a) b = Ico a b :=
+@[simp] lemma Ioo_pred_left (a b : α) : Ioo (pred a) b = Ico a b :=
 Ioo_pred_left_of_not_is_min $ not_is_min _
 
-lemma Icc_pred_right (a b : α) : Icc a (pred b) = Ico a b :=
+@[simp] lemma Icc_pred_right (a b : α) : Icc a (pred b) = Ico a b :=
 Icc_pred_right_of_not_is_min $ not_is_min _
 
-lemma Ioc_pred_right (a b : α) : Ioc a (pred b) = Ioo a b :=
+@[simp] lemma Ioc_pred_right (a b : α) : Ioc a (pred b) = Ioo a b :=
 Ioc_pred_right_of_not_is_min $ not_is_min _
 
 end no_min_order
@@ -468,7 +546,7 @@ variables [partial_order α] [pred_order α] {a b : α}
 @[simp] lemma pred_eq_iff_is_min : pred a = a ↔ is_min a :=
 ⟨λ h, min_of_le_pred h.ge, λ h, h.eq_of_le $ pred_le _⟩
 
-alias pred_eq_iff_is_min ↔ _ is_min.pred_eq
+alias pred_eq_iff_is_min ↔ _ _root_.is_min.pred_eq
 
 lemma pred_le_le_iff {a b : α} : pred a ≤ b ∧ b ≤ a ↔ b = a ∨ b = pred a :=
 begin
@@ -482,6 +560,13 @@ end
 lemma _root_.covby.pred_eq {a b : α} (h : a ⋖ b) : pred b = a :=
 (le_pred_of_lt h.lt).eq_of_not_gt $ λ h', h.2 h' $ pred_lt_of_not_is_min h.lt.not_is_min
 
+lemma _root_.wcovby.pred_le (h : a ⩿ b) : pred b ≤ a :=
+begin
+  obtain h | rfl := h.covby_or_eq,
+  { exact h.pred_eq.le },
+  { exact pred_le _ }
+end
+
 lemma pred_le_iff_eq_or_le : pred a ≤ b ↔ b = pred a ∨ a ≤ b :=
 begin
   by_cases ha : is_min a,
@@ -494,6 +579,13 @@ lemma pred_lt_iff_eq_or_lt_of_not_is_min (ha : ¬ is_min a) : pred a < b ↔ a =
 
 lemma Ici_pred (a : α) : Ici (pred a) = insert (pred a) (Ici a) := ext $ λ _, pred_le_iff_eq_or_le
 
+lemma Ioi_pred_eq_insert_of_not_is_min (ha : ¬ is_min a) :
+  Ioi (pred a) = insert a (Ioi a) :=
+begin
+  ext x, simp only [insert, mem_set_of, @eq_comm _ x a],
+  exact pred_lt_iff_eq_or_lt_of_not_is_min ha
+end
+
 lemma Icc_pred_left (h : pred a ≤ b) : Icc (pred a) b = insert (pred a) (Icc a b) :=
 by simp_rw [←Ici_inter_Iic, Ici_pred, insert_inter_of_mem (mem_Iic.2 h)]
 
@@ -509,7 +601,7 @@ by simp_rw [eq_iff_le_not_lt, pred_le_pred_iff, pred_lt_pred_iff]
 lemma pred_injective : injective (pred : α → α) := λ a b, pred_eq_pred_iff.1
 lemma pred_ne_pred_iff : pred a ≠ pred b ↔ a ≠ b := pred_injective.ne_iff
 
-alias pred_ne_pred_iff ↔ _ order.pred_ne_pred
+alias pred_ne_pred_iff ↔ _ pred_ne_pred
 
 lemma pred_lt_iff_eq_or_lt : pred a < b ↔ a = b ∨ a < b := pred_lt_iff.trans le_iff_eq_or_lt
 
@@ -538,7 +630,15 @@ variables [order_bot α]
 end order_bot
 
 section order_top
-variables [order_top α] [nontrivial α]
+
+variable [order_top α]
+
+@[simp] lemma pred_top_lt_iff [no_min_order α] : pred ⊤ < a ↔ a = ⊤ :=
+@lt_succ_bot_iff αᵒᵈ _ _ _ _ _
+
+lemma pred_top_le_iff : pred ⊤ ≤ a ↔ a = ⊤ ∨ a = pred ⊤ := @le_succ_bot_iff αᵒᵈ _ _ _ _
+
+variable [nontrivial α]
 
 lemma pred_lt_top (a : α) : pred a < ⊤ :=
 (pred_mono le_top).trans_lt $ pred_lt_of_not_is_min not_is_min_top
@@ -585,8 +685,38 @@ variables [partial_order α] [succ_order α] [pred_order α] {a b : α}
 @[simp] lemma succ_pred [no_min_order α] (a : α) : succ (pred a) = a := (pred_covby _).succ_eq
 @[simp] lemma pred_succ [no_max_order α] (a : α) : pred (succ a) = a := (covby_succ _).pred_eq
 
+lemma pred_succ_iterate_of_not_is_max (i : α) (n : ℕ) (hin : ¬ is_max (succ^[n-1] i)) :
+  pred^[n] (succ^[n] i) = i :=
+begin
+  induction n with n hn,
+  { simp only [function.iterate_zero, id.def], },
+  rw [nat.succ_sub_succ_eq_sub, nat.sub_zero] at hin,
+  have h_not_max : ¬ is_max (succ^[n - 1] i),
+  { cases n,
+    { simpa using hin, },
+    rw [nat.succ_sub_succ_eq_sub, nat.sub_zero] at hn ⊢,
+    have h_sub_le : (succ^[n] i) ≤ (succ^[n.succ] i),
+    { rw function.iterate_succ',
+      exact le_succ _, },
+    refine λ h_max, hin (λ j hj, _),
+    have hj_le : j ≤ (succ^[n] i) := h_max (h_sub_le.trans hj),
+    exact hj_le.trans h_sub_le, },
+  rw [function.iterate_succ, function.iterate_succ'],
+  simp only [function.comp_app],
+  rw pred_succ_of_not_is_max hin,
+  exact hn h_not_max,
+end
+
+lemma succ_pred_iterate_of_not_is_min (i : α) (n : ℕ) (hin : ¬ is_min (pred^[n-1] i)) :
+  succ^[n] (pred^[n] i) = i :=
+@pred_succ_iterate_of_not_is_max αᵒᵈ _ _ _ i n hin
+
 end succ_pred_order
 
+end order
+
+open order
+
 /-! ### `with_bot`, `with_top`
 Adding a greatest/least element to a `succ_order` or to a `pred_order`.
 
@@ -600,13 +730,14 @@ where "preserves `(succ/pred)`" means
 `(succ/pred)_order α → (succ/pred)_order ((with_top/with_bot) α)`.
 -/
 
-section with_top
-open with_top
+namespace with_top
 
 /-! #### Adding a `⊤` to an `order_top` -/
 
-instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
-  succ_order (with_top α) :=
+section succ
+variables [decidable_eq α] [partial_order α] [order_top α] [succ_order α]
+
+instance : succ_order (with_top α) :=
 { succ := λ a, match a with
     | ⊤        := ⊤
     | (some a) := ite (a = ⊤) ⊤ (some (succ a))
@@ -614,7 +745,7 @@ instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
   le_succ := λ a, begin
     cases a,
     { exact le_top },
-    change ((≤) : with_top α → with_top α → Prop) _ (ite _ _ _),
+    change _ ≤ ite _ _ _,
     split_ifs,
     { exact le_top },
     { exact some_le_some.2 (le_succ a) }
@@ -622,7 +753,7 @@ instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
   max_of_succ_le := λ a ha, begin
     cases a,
     { exact is_max_top },
-    change ((≤) : with_top α → with_top α → Prop) (ite _ _ _) _ at ha,
+    change ite _ _ _ ≤ _ at ha,
     split_ifs at ha with ha',
     { exact (not_top_le_coe _ ha).elim },
     { rw [some_le_some, succ_le_iff_eq_top] at ha,
@@ -634,7 +765,7 @@ instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
     cases a,
     { exact (not_top_lt h).elim },
     rw some_lt_some at h,
-    change ((≤) : with_top α → with_top α → Prop) (ite _ _ _) _,
+    change ite _ _ _ ≤ _,
     split_ifs with ha,
     { rw ha at h,
       exact (not_top_lt h).elim },
@@ -645,7 +776,7 @@ instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
     { exact (not_top_lt h).elim },
     cases b,
     { exact le_top },
-    change ((<) : with_top α → with_top α → Prop) _ (ite _ _ _) at h,
+    change _ < ite _ _ _ at h,
     rw some_le_some,
     split_ifs at h with hb,
     { rw hb,
@@ -653,7 +784,16 @@ instance [decidable_eq α] [partial_order α] [order_top α] [succ_order α] :
     { exact le_of_lt_succ (some_lt_some.1 h) }
   end }
 
-instance [preorder α] [order_top α] [pred_order α] : pred_order (with_top α) :=
+@[simp] lemma succ_coe_top : succ ↑(⊤ : α) = (⊤ : with_top α) := dif_pos rfl
+lemma succ_coe_of_ne_top {a : α} (h : a ≠ ⊤) : succ (↑a : with_top α) = ↑(succ a) :=
+dif_neg h
+
+end succ
+
+section pred
+variables [preorder α] [order_top α] [pred_order α]
+
+instance : pred_order (with_top α) :=
 { pred := λ a, match a with
     | ⊤        := some ⊤
     | (some a) := some (pred a)
@@ -682,10 +822,22 @@ instance [preorder α] [order_top α] [pred_order α] : pred_order (with_top α)
     { exact some_le_some.2 (le_of_pred_lt $ some_lt_some.1 h) }
   end }
 
+@[simp] lemma pred_top : pred (⊤ : with_top α) = ↑(⊤ : α) := rfl
+@[simp] lemma pred_coe (a : α) : pred (↑a : with_top α) = ↑(pred a) := rfl
+
+@[simp] lemma pred_untop : ∀ (a : with_top α) (ha : a ≠ ⊤),
+  pred (a.untop ha) = (pred a).untop (by induction a using with_top.rec_top_coe; simp)
+| ⊤ ha := (ha rfl).elim
+| (a : α) ha := rfl
+
+end pred
+
 /-! #### Adding a `⊤` to a `no_max_order` -/
 
-instance with_top.succ_order_of_no_max_order [preorder α] [no_max_order α] [succ_order α] :
-  succ_order (with_top α) :=
+section succ
+variables [preorder α] [no_max_order α] [succ_order α]
+
+instance succ_order_of_no_max_order : succ_order (with_top α) :=
 { succ := λ a, match a with
     | ⊤        := ⊤
     | (some a) := some (succ a)
@@ -715,25 +867,35 @@ instance with_top.succ_order_of_no_max_order [preorder α] [no_max_order α] [su
     { exact some_le_some.2 (le_of_lt_succ $ some_lt_some.1 h) }
   end }
 
-instance [preorder α] [no_max_order α] [hα : nonempty α] : is_empty (pred_order (with_top α)) :=
+@[simp] lemma succ_coe (a : α) : succ (↑a : with_top α) = ↑(succ a) := rfl
+
+end succ
+
+section pred
+variables [preorder α] [no_max_order α]
+
+instance [hα : nonempty α] : is_empty (pred_order (with_top α)) :=
 ⟨begin
   introI,
-  set b := pred (⊤ : with_top α) with h,
-  cases pred (⊤ : with_top α) with a ha; change b with pred ⊤ at h,
+  cases h : pred (⊤ : with_top α) with a ha,
   { exact hα.elim (λ a, (min_of_le_pred h.ge).not_lt $ coe_lt_top a) },
   { obtain ⟨c, hc⟩ := exists_gt a,
     rw [←some_lt_some, ←h] at hc,
     exact (le_of_pred_lt hc).not_lt (some_lt_none _) }
 end⟩
 
+end pred
+
 end with_top
 
-section with_bot
-open with_bot
+namespace with_bot
 
 /-! #### Adding a `⊥` to an `order_bot` -/
 
-instance [preorder α] [order_bot α] [succ_order α] : succ_order (with_bot α) :=
+section succ
+variables [preorder α] [order_bot α] [succ_order α]
+
+instance : succ_order (with_bot α) :=
 { succ := λ a, match a with
     | ⊥        := some ⊥
     | (some a) := some (succ a)
@@ -745,7 +907,7 @@ instance [preorder α] [order_bot α] [succ_order α] : succ_order (with_bot α)
   max_of_succ_le := λ a ha, begin
     cases a,
     { exact ((none_lt_some (⊥ : α)).not_le ha).elim },
-    { exact is_max.with_bot (max_of_succ_le $ some_le_some.1 ha) }
+    { exact (max_of_succ_le $ some_le_some.1 ha).with_bot }
   end,
   succ_le_of_lt := λ a b h, begin
     cases b,
@@ -762,8 +924,20 @@ instance [preorder α] [order_bot α] [succ_order α] : succ_order (with_bot α)
     { exact some_le_some.2 (le_of_lt_succ $ some_lt_some.1 h) }
   end }
 
-instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
-  pred_order (with_bot α) :=
+@[simp] lemma succ_bot : succ (⊥ : with_bot α) = ↑(⊥ : α) := rfl
+@[simp] lemma succ_coe (a : α) : succ (↑a : with_bot α) = ↑(succ a) := rfl
+
+@[simp] lemma succ_unbot : ∀ (a : with_bot α) (ha : a ≠ ⊥),
+  succ (a.unbot ha) = (succ a).unbot (by induction a using with_bot.rec_bot_coe; simp)
+| ⊥ ha := (ha rfl).elim
+| (a : α) ha := rfl
+
+end succ
+
+section pred
+variables [decidable_eq α] [partial_order α] [order_bot α] [pred_order α]
+
+instance : pred_order (with_bot α) :=
 { pred := λ a, match a with
     | ⊥        := ⊥
     | (some a) := ite (a = ⊥) ⊥ (some (pred a))
@@ -771,7 +945,7 @@ instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
   pred_le := λ a, begin
     cases a,
     { exact bot_le },
-    change (ite _ _ _ : with_bot α) ≤ some a,
+    change ite _ _ _ ≤ _,
     split_ifs,
     { exact bot_le },
     { exact some_le_some.2 (pred_le a) }
@@ -779,7 +953,7 @@ instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
   min_of_le_pred := λ a ha, begin
     cases a,
     { exact is_min_bot },
-    change ((≤) : with_bot α → with_bot α → Prop) _ (ite _ _ _) at ha,
+    change _ ≤ ite _ _ _ at ha,
     split_ifs at ha with ha',
     { exact (not_coe_le_bot _ ha).elim },
     { rw [some_le_some, le_pred_iff_eq_bot] at ha,
@@ -791,7 +965,7 @@ instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
     cases b,
     { exact (not_lt_bot h).elim },
     rw some_lt_some at h,
-    change ((≤) : with_bot α → with_bot α → Prop) _ (ite _ _ _),
+    change _ ≤ ite _ _ _,
     split_ifs with hb,
     { rw hb at h,
       exact (not_lt_bot h).elim },
@@ -802,7 +976,7 @@ instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
     { exact (not_lt_bot h).elim },
     cases a,
     { exact bot_le },
-    change ((<) : with_bot α → with_bot α → Prop) (ite _ _ _) _ at h,
+    change ite _ _ _ < _ at h,
     rw some_le_some,
     split_ifs at h with ha,
     { rw ha,
@@ -810,21 +984,33 @@ instance [decidable_eq α] [partial_order α] [order_bot α] [pred_order α] :
     { exact le_of_pred_lt (some_lt_some.1 h) }
   end }
 
+@[simp] lemma pred_coe_bot : pred ↑(⊥ : α) = (⊥ : with_bot α) := dif_pos rfl
+lemma pred_coe_of_ne_bot {a : α} (h : a ≠ ⊥) : pred (↑a : with_bot α) = ↑(pred a) :=
+dif_neg h
+
+end pred
+
 /-! #### Adding a `⊥` to a `no_min_order` -/
 
-instance [preorder α] [no_min_order α] [hα : nonempty α] : is_empty (succ_order (with_bot α)) :=
+section succ
+variables [preorder α] [no_min_order α]
+
+instance [hα : nonempty α] : is_empty (succ_order (with_bot α)) :=
 ⟨begin
   introI,
-  set b : with_bot α := succ ⊥ with h,
-  cases succ (⊥ : with_bot α) with a ha; change b with succ ⊥ at h,
+  cases h : succ (⊥ : with_bot α) with a ha,
   { exact hα.elim (λ a, (max_of_succ_le h.le).not_lt $ bot_lt_coe a) },
   { obtain ⟨c, hc⟩ := exists_lt a,
     rw [←some_lt_some, ←h] at hc,
     exact (le_of_lt_succ hc).not_lt (none_lt_some _) }
 end⟩
 
-instance with_bot.pred_order_of_no_min_order [preorder α] [no_min_order α] [pred_order α] :
-  pred_order (with_bot α) :=
+end succ
+
+section pred
+variables [preorder α] [no_min_order α] [pred_order α]
+
+instance pred_order_of_no_min_order : pred_order (with_bot α) :=
 { pred := λ a, match a with
     | ⊥        := ⊥
     | (some a) := some (pred a)
@@ -854,10 +1040,10 @@ instance with_bot.pred_order_of_no_min_order [preorder α] [no_min_order α] [pr
     { exact some_le_some.2 (le_of_pred_lt $ some_lt_some.1 h) }
   end }
 
-end with_bot
-end order
+@[simp] lemma pred_coe (a : α) : pred (↑a : with_bot α) = ↑(pred a) := rfl
 
-open order
+end pred
+end with_bot
 
 /-! ### Archimedeanness -/
 
diff --git a/src/order/succ_pred/interval_succ.lean b/src/order/succ_pred/interval_succ.lean
new file mode 100644
index 0000000000000..b2a00b4e2f070
--- /dev/null
+++ b/src/order/succ_pred/interval_succ.lean
@@ -0,0 +1,130 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import data.set.pairwise.basic
+import order.succ_pred.basic
+
+/-!
+# Intervals `Ixx (f x) (f (order.succ x))`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove
+
+* `monotone.bUnion_Ico_Ioc_map_succ`: if `α` is a linear archimedean succ order and `β` is a linear
+  order, then for any monotone function `f` and `m n : α`, the union of intervals
+  `set.Ioc (f i) (f (order.succ i))`, `m ≤ i < n`, is equal to `set.Ioc (f m) (f n)`;
+
+* `monotone.pairwise_disjoint_on_Ioc_succ`: if `α` is a linear succ order, `β` is a preorder, and
+  `f : α → β` is a monotone function, then the intervals `set.Ioc (f n) (f (order.succ n))` are
+  pairwise disjoint.
+
+For the latter lemma, we also prove various order dual versions.
+-/
+
+open set order
+
+variables {α β : Type*} [linear_order α]
+
+namespace monotone
+
+/-- If `α` is a linear archimedean succ order and `β` is a linear order, then for any monotone
+function `f` and `m n : α`, the union of intervals `set.Ioc (f i) (f (order.succ i))`, `m ≤ i < n`,
+is equal to `set.Ioc (f m) (f n)` -/
+lemma bUnion_Ico_Ioc_map_succ [succ_order α] [is_succ_archimedean α]
+  [linear_order β] {f : α → β} (hf : monotone f) (m n : α) :
+  (⋃ i ∈ Ico m n, Ioc (f i) (f (succ i))) = Ioc (f m) (f n) :=
+begin
+  cases le_total n m with hnm hmn,
+  { rw [Ico_eq_empty_of_le hnm, Ioc_eq_empty_of_le (hf hnm), bUnion_empty] },
+  { refine succ.rec _ _ hmn,
+    { simp only [Ioc_self, Ico_self, bUnion_empty] },
+    { intros k hmk ihk,
+      rw [← Ioc_union_Ioc_eq_Ioc (hf hmk) (hf $ le_succ _), union_comm, ← ihk],
+      by_cases hk : is_max k,
+      { rw [hk.succ_eq, Ioc_self, empty_union] },
+      { rw [Ico_succ_right_eq_insert_of_not_is_max hmk hk, bUnion_insert] } } }
+end
+
+/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
+the intervals `set.Ioc (f n) (f (order.succ n))` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioc_succ [succ_order α] [preorder β] {f : α → β} (hf : monotone f) :
+  pairwise (disjoint on (λ n, Ioc (f n) (f (succ n)))) :=
+(pairwise_disjoint_on _).2 $ λ m n hmn,
+  disjoint_iff_inf_le.mpr $ λ x ⟨⟨_, h₁⟩, ⟨h₂, _⟩⟩, h₂.not_le $ h₁.trans $ hf $ succ_le_of_lt hmn
+
+/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
+the intervals `set.Ico (f n) (f (order.succ n))` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ico_succ [succ_order α] [preorder β] {f : α → β} (hf : monotone f) :
+  pairwise (disjoint on (λ n, Ico (f n) (f (succ n)))) :=
+(pairwise_disjoint_on _).2 $ λ m n hmn,
+  disjoint_iff_inf_le.mpr $ λ x ⟨⟨_, h₁⟩, ⟨h₂, _⟩⟩, h₁.not_le $ (hf $ succ_le_of_lt hmn).trans h₂
+
+/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
+the intervals `set.Ioo (f n) (f (order.succ n))` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioo_succ [succ_order α] [preorder β] {f : α → β} (hf : monotone f) :
+  pairwise (disjoint on (λ n, Ioo (f n) (f (succ n)))) :=
+hf.pairwise_disjoint_on_Ico_succ.mono $ λ i j h, h.mono Ioo_subset_Ico_self Ioo_subset_Ico_self
+
+/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
+the intervals `set.Ioc (f order.pred n) (f n)` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioc_pred [pred_order α] [preorder β] {f : α → β} (hf : monotone f) :
+  pairwise (disjoint on (λ n, Ioc (f (pred n)) (f n))) :=
+by simpa only [(∘), dual_Ico] using hf.dual.pairwise_disjoint_on_Ico_succ
+
+/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
+the intervals `set.Ico (f order.pred n) (f n)` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ico_pred [pred_order α] [preorder β] {f : α → β} (hf : monotone f) :
+  pairwise (disjoint on (λ n, Ico (f (pred n)) (f n))) :=
+by simpa only [(∘), dual_Ioc] using hf.dual.pairwise_disjoint_on_Ioc_succ
+
+/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
+the intervals `set.Ioo (f order.pred n) (f n)` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioo_pred [pred_order α] [preorder β] {f : α → β} (hf : monotone f) :
+  pairwise (disjoint on (λ n, Ioo (f (pred n)) (f n))) :=
+by simpa only [(∘), dual_Ioo] using hf.dual.pairwise_disjoint_on_Ioo_succ
+
+end monotone
+
+namespace antitone
+
+/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
+the intervals `set.Ioc (f (order.succ n)) (f n)` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioc_succ [succ_order α] [preorder β] {f : α → β} (hf : antitone f) :
+  pairwise (disjoint on (λ n, Ioc (f (succ n)) (f n))) :=
+hf.dual_left.pairwise_disjoint_on_Ioc_pred
+
+/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
+the intervals `set.Ico (f (order.succ n)) (f n)` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ico_succ [succ_order α] [preorder β] {f : α → β} (hf : antitone f) :
+  pairwise (disjoint on (λ n, Ico (f (succ n)) (f n))) :=
+hf.dual_left.pairwise_disjoint_on_Ico_pred
+
+/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
+the intervals `set.Ioo (f (order.succ n)) (f n)` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioo_succ [succ_order α] [preorder β] {f : α → β} (hf : antitone f) :
+  pairwise (disjoint on (λ n, Ioo (f (succ n)) (f n))) :=
+hf.dual_left.pairwise_disjoint_on_Ioo_pred
+
+/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
+the intervals `set.Ioc (f n) (f (order.pred n))` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioc_pred [pred_order α] [preorder β] {f : α → β} (hf : antitone f) :
+  pairwise (disjoint on (λ n, Ioc (f n) (f (pred n)))) :=
+hf.dual_left.pairwise_disjoint_on_Ioc_succ
+
+/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
+the intervals `set.Ico (f n) (f (order.pred n))` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ico_pred [pred_order α] [preorder β] {f : α → β} (hf : antitone f) :
+  pairwise (disjoint on (λ n, Ico (f n) (f (pred n)))) :=
+hf.dual_left.pairwise_disjoint_on_Ico_succ
+
+/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
+the intervals `set.Ioo (f n) (f (order.pred n))` are pairwise disjoint. -/
+lemma pairwise_disjoint_on_Ioo_pred [pred_order α] [preorder β] {f : α → β} (hf : antitone f) :
+  pairwise (disjoint on (λ n, Ioo (f n) (f (pred n)))) :=
+hf.dual_left.pairwise_disjoint_on_Ioo_succ
+
+end antitone
diff --git a/src/order/succ_pred/limit.lean b/src/order/succ_pred/limit.lean
new file mode 100644
index 0000000000000..295cf5ed677a1
--- /dev/null
+++ b/src/order/succ_pred/limit.lean
@@ -0,0 +1,322 @@
+/-
+Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Violeta Hernández Palacios
+-/
+
+import order.succ_pred.basic
+
+/-!
+# Successor and predecessor limits
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the predicate `order.is_succ_limit` for "successor limits", values that don't cover any
+others. They are so named since they can't be the successors of anything smaller. We define
+`order.is_pred_limit` analogously, and prove basic results.
+
+## Todo
+
+The plan is to eventually replace `ordinal.is_limit` and `cardinal.is_limit` with the common
+predicate `order.is_succ_limit`.
+-/
+
+variables {α : Type*}
+
+namespace order
+open function set order_dual
+
+/-! ### Successor limits -/
+
+section has_lt
+variables [has_lt α]
+
+/-- A successor limit is a value that doesn't cover any other.
+
+It's so named because in a successor order, a successor limit can't be the successor of anything
+smaller. -/
+def is_succ_limit (a : α) : Prop := ∀ b, ¬ b ⋖ a
+
+lemma not_is_succ_limit_iff_exists_covby (a : α) : ¬ is_succ_limit a ↔ ∃ b, b ⋖ a :=
+by simp [is_succ_limit]
+
+@[simp] lemma is_succ_limit_of_dense [densely_ordered α] (a : α) : is_succ_limit a := λ b, not_covby
+
+end has_lt
+
+section preorder
+variables [preorder α] {a : α}
+
+protected lemma _root_.is_min.is_succ_limit : is_min a → is_succ_limit a :=
+λ h b hab, not_is_min_of_lt hab.lt h
+
+lemma is_succ_limit_bot [order_bot α] : is_succ_limit (⊥ : α) := is_min_bot.is_succ_limit
+
+variables [succ_order α]
+
+protected lemma is_succ_limit.is_max (h : is_succ_limit (succ a)) : is_max a :=
+by { by_contra H, exact h a (covby_succ_of_not_is_max H) }
+
+lemma not_is_succ_limit_succ_of_not_is_max (ha : ¬ is_max a) : ¬ is_succ_limit (succ a) :=
+by { contrapose! ha, exact ha.is_max }
+
+section no_max_order
+variables [no_max_order α]
+
+lemma is_succ_limit.succ_ne (h : is_succ_limit a) (b : α) : succ b ≠ a :=
+by { rintro rfl, exact not_is_max _ h.is_max }
+
+@[simp] lemma not_is_succ_limit_succ (a : α) : ¬ is_succ_limit (succ a) := λ h, h.succ_ne _ rfl
+
+end no_max_order
+
+section is_succ_archimedean
+variable [is_succ_archimedean α]
+
+lemma is_succ_limit.is_min_of_no_max [no_max_order α] (h : is_succ_limit a) : is_min a :=
+λ b hb, begin
+  rcases hb.exists_succ_iterate with ⟨_ | n, rfl⟩,
+  { exact le_rfl },
+  { rw iterate_succ_apply' at h,
+    exact (not_is_succ_limit_succ _ h).elim }
+end
+
+@[simp] lemma is_succ_limit_iff_of_no_max [no_max_order α] : is_succ_limit a ↔ is_min a :=
+⟨is_succ_limit.is_min_of_no_max, is_min.is_succ_limit⟩
+
+lemma not_is_succ_limit_of_no_max [no_min_order α] [no_max_order α] : ¬ is_succ_limit a := by simp
+
+end is_succ_archimedean
+end preorder
+
+section partial_order
+variables [partial_order α] [succ_order α] {a b : α} {C : α → Sort*}
+
+lemma is_succ_limit_of_succ_ne (h : ∀ b, succ b ≠ a) : is_succ_limit a := λ b hba, h b hba.succ_eq
+
+lemma not_is_succ_limit_iff : ¬ is_succ_limit a ↔ ∃ b, ¬ is_max b ∧ succ b = a :=
+begin
+  rw not_is_succ_limit_iff_exists_covby,
+  refine exists_congr (λ b, ⟨λ hba, ⟨hba.lt.not_is_max, hba.succ_eq⟩, _⟩),
+  rintro ⟨h, rfl⟩,
+  exact covby_succ_of_not_is_max h
+end
+
+/-- See `not_is_succ_limit_iff` for a version that states that `a` is a successor of a value other
+than itself. -/
+lemma mem_range_succ_of_not_is_succ_limit (h : ¬ is_succ_limit a) : a ∈ range (@succ α _ _) :=
+by { cases not_is_succ_limit_iff.1 h with b hb, exact ⟨b, hb.2⟩ }
+
+lemma is_succ_limit_of_succ_lt (H : ∀ a < b, succ a < b) : is_succ_limit b :=
+λ a hab, (H a hab.lt).ne hab.succ_eq
+
+lemma is_succ_limit.succ_lt (hb : is_succ_limit b) (ha : a < b) : succ a < b :=
+begin
+  by_cases h : is_max a,
+  { rwa h.succ_eq },
+  { rw [lt_iff_le_and_ne, succ_le_iff_of_not_is_max h],
+    refine ⟨ha, λ hab, _⟩,
+    subst hab,
+    exact (h hb.is_max).elim }
+end
+
+lemma is_succ_limit.succ_lt_iff (hb : is_succ_limit b) : succ a < b ↔ a < b :=
+⟨λ h, (le_succ a).trans_lt h, hb.succ_lt⟩
+
+lemma is_succ_limit_iff_succ_lt : is_succ_limit b ↔ ∀ a < b, succ a < b :=
+⟨λ hb a, hb.succ_lt, is_succ_limit_of_succ_lt⟩
+
+/-- A value can be built by building it on successors and successor limits. -/
+@[elab_as_eliminator] noncomputable def is_succ_limit_rec_on (b : α)
+  (hs : Π a, ¬ is_max a → C (succ a)) (hl : Π a, is_succ_limit a → C a) : C b :=
+begin
+  by_cases hb : is_succ_limit b,
+  { exact hl b hb },
+  { have H := classical.some_spec (not_is_succ_limit_iff.1 hb),
+    rw ←H.2,
+    exact hs _ H.1 }
+end
+
+lemma is_succ_limit_rec_on_limit (hs : Π a, ¬ is_max a → C (succ a))
+  (hl : Π a, is_succ_limit a → C a) (hb : is_succ_limit b) :
+  @is_succ_limit_rec_on α _ _ C b hs hl = hl b hb :=
+by { classical, exact dif_pos hb }
+
+lemma is_succ_limit_rec_on_succ' (hs : Π a, ¬ is_max a → C (succ a))
+  (hl : Π a, is_succ_limit a → C a) {b : α} (hb : ¬ is_max b) :
+  @is_succ_limit_rec_on α _ _ C (succ b) hs hl = hs b hb :=
+begin
+  have hb' := not_is_succ_limit_succ_of_not_is_max hb,
+  have H := classical.some_spec (not_is_succ_limit_iff.1 hb'),
+  rw is_succ_limit_rec_on,
+  simp only [cast_eq_iff_heq, hb', not_false_iff, eq_mpr_eq_cast, dif_neg],
+  congr,
+  { exact (succ_eq_succ_iff_of_not_is_max H.1 hb).1 H.2 },
+  { apply proof_irrel_heq }
+end
+
+section no_max_order
+variables [no_max_order α]
+
+@[simp] lemma is_succ_limit_rec_on_succ (hs : Π a, ¬ is_max a → C (succ a))
+  (hl : Π a, is_succ_limit a → C a) (b : α) :
+  @is_succ_limit_rec_on α _ _ C (succ b) hs hl = hs b (not_is_max b) :=
+is_succ_limit_rec_on_succ' _ _ _
+
+lemma is_succ_limit_iff_succ_ne : is_succ_limit a ↔ ∀ b, succ b ≠ a :=
+⟨is_succ_limit.succ_ne, is_succ_limit_of_succ_ne⟩
+
+lemma not_is_succ_limit_iff' : ¬ is_succ_limit a ↔ a ∈ range (@succ α _ _) :=
+by { simp_rw [is_succ_limit_iff_succ_ne, not_forall, not_ne_iff], refl }
+
+end no_max_order
+
+section is_succ_archimedean
+variable [is_succ_archimedean α]
+
+protected lemma is_succ_limit.is_min (h : is_succ_limit a) : is_min a :=
+λ b hb, begin
+  revert h,
+  refine succ.rec (λ _, le_rfl) (λ c hbc H hc, _) hb,
+  have := hc.is_max.succ_eq,
+  rw this at hc ⊢,
+  exact H hc
+end
+
+@[simp] lemma is_succ_limit_iff : is_succ_limit a ↔ is_min a :=
+⟨is_succ_limit.is_min, is_min.is_succ_limit⟩
+
+lemma not_is_succ_limit [no_min_order α] : ¬ is_succ_limit a := by simp
+
+end is_succ_archimedean
+end partial_order
+
+/-! ### Predecessor limits -/
+
+section has_lt
+variables [has_lt α] {a : α}
+
+/-- A predecessor limit is a value that isn't covered by any other.
+
+It's so named because in a predecessor order, a predecessor limit can't be the predecessor of
+anything greater. -/
+def is_pred_limit (a : α) : Prop := ∀ b, ¬ a ⋖ b
+
+lemma not_is_pred_limit_iff_exists_covby (a : α) : ¬ is_pred_limit a ↔ ∃ b, a ⋖ b :=
+by simp [is_pred_limit]
+
+lemma is_pred_limit_of_dense [densely_ordered α] (a : α) : is_pred_limit a := λ b, not_covby
+
+@[simp] lemma is_succ_limit_to_dual_iff : is_succ_limit (to_dual a) ↔ is_pred_limit a :=
+by simp [is_succ_limit, is_pred_limit]
+
+@[simp] lemma is_pred_limit_to_dual_iff : is_pred_limit (to_dual a) ↔ is_succ_limit a :=
+by simp [is_succ_limit, is_pred_limit]
+
+alias is_succ_limit_to_dual_iff ↔ _ is_pred_limit.dual
+alias is_pred_limit_to_dual_iff ↔ _ is_succ_limit.dual
+
+end has_lt
+
+section preorder
+variables [preorder α] {a : α}
+
+protected lemma _root_.is_max.is_pred_limit : is_max a → is_pred_limit a :=
+λ h b hab, not_is_max_of_lt hab.lt h
+
+lemma is_pred_limit_top [order_top α] : is_pred_limit (⊤ : α) := is_max_top.is_pred_limit
+
+variables [pred_order α]
+
+protected lemma is_pred_limit.is_min (h : is_pred_limit (pred a)) : is_min a :=
+by { by_contra H, exact h a (pred_covby_of_not_is_min H) }
+
+lemma not_is_pred_limit_pred_of_not_is_min (ha : ¬ is_min a) : ¬ is_pred_limit (pred a) :=
+by { contrapose! ha, exact ha.is_min }
+
+section no_min_order
+variables [no_min_order α]
+
+lemma is_pred_limit.pred_ne (h : is_pred_limit a) (b : α) : pred b ≠ a :=
+by { rintro rfl, exact not_is_min _ h.is_min }
+
+@[simp] lemma not_is_pred_limit_pred (a : α) : ¬ is_pred_limit (pred a) := λ h, h.pred_ne _ rfl
+
+end no_min_order
+
+section is_pred_archimedean
+variables [is_pred_archimedean α]
+
+protected lemma is_pred_limit.is_max_of_no_min [no_min_order α] (h : is_pred_limit a) : is_max a :=
+h.dual.is_min_of_no_max
+
+@[simp] lemma is_pred_limit_iff_of_no_min [no_min_order α] : is_pred_limit a ↔ is_max a :=
+is_succ_limit_to_dual_iff.symm.trans is_succ_limit_iff_of_no_max
+
+lemma not_is_pred_limit_of_no_min [no_min_order α] [no_max_order α] : ¬ is_pred_limit a :=
+by simp
+
+end is_pred_archimedean
+end preorder
+
+section partial_order
+variables [partial_order α] [pred_order α] {a b : α} {C : α → Sort*}
+
+lemma is_pred_limit_of_pred_ne (h : ∀ b, pred b ≠ a) : is_pred_limit a := λ b hba, h b hba.pred_eq
+
+lemma not_is_pred_limit_iff : ¬ is_pred_limit a ↔ ∃ b, ¬ is_min b ∧ pred b = a :=
+by { rw ←is_succ_limit_to_dual_iff, exact not_is_succ_limit_iff }
+
+/-- See `not_is_pred_limit_iff` for a version that states that `a` is a successor of a value other
+than itself. -/
+lemma mem_range_pred_of_not_is_pred_limit (h : ¬ is_pred_limit a) : a ∈ range (@pred α _ _) :=
+by { cases not_is_pred_limit_iff.1 h with b hb, exact ⟨b, hb.2⟩ }
+
+lemma is_pred_limit_of_pred_lt (H : ∀ a > b, pred a < b) : is_pred_limit b :=
+λ a hab, (H a hab.lt).ne hab.pred_eq
+
+lemma is_pred_limit.lt_pred (h : is_pred_limit a) : a < b → a < pred b := h.dual.succ_lt
+lemma is_pred_limit.lt_pred_iff (h : is_pred_limit a) : a < pred b ↔ a < b := h.dual.succ_lt_iff
+
+lemma is_pred_limit_iff_lt_pred : is_pred_limit a ↔ ∀ ⦃b⦄, a < b → a < pred b :=
+is_succ_limit_to_dual_iff.symm.trans is_succ_limit_iff_succ_lt
+
+/-- A value can be built by building it on predecessors and predecessor limits. -/
+@[elab_as_eliminator] noncomputable def is_pred_limit_rec_on (b : α)
+  (hs : Π a, ¬ is_min a → C (pred a)) (hl : Π a, is_pred_limit a → C a) : C b :=
+@is_succ_limit_rec_on αᵒᵈ _ _ _ _ hs (λ a ha, hl _ ha.dual)
+
+lemma is_pred_limit_rec_on_limit (hs : Π a, ¬ is_min a → C (pred a))
+  (hl : Π a, is_pred_limit a → C a) (hb : is_pred_limit b) :
+  @is_pred_limit_rec_on α _ _ C b hs hl = hl b hb :=
+is_succ_limit_rec_on_limit _ _ hb.dual
+
+lemma is_pred_limit_rec_on_pred' (hs : Π a, ¬ is_min a → C (pred a))
+  (hl : Π a, is_pred_limit a → C a) {b : α} (hb : ¬ is_min b) :
+  @is_pred_limit_rec_on α _ _ C (pred b) hs hl = hs b hb :=
+is_succ_limit_rec_on_succ' _ _ _
+
+section no_min_order
+variables [no_min_order α]
+
+@[simp] theorem is_pred_limit_rec_on_pred (hs : Π a, ¬ is_min a → C (pred a))
+  (hl : Π a, is_pred_limit a → C a) (b : α) :
+  @is_pred_limit_rec_on α _ _ C (pred b) hs hl = hs b (not_is_min b) :=
+is_succ_limit_rec_on_succ _ _ _
+
+end no_min_order
+
+section is_pred_archimedean
+variable [is_pred_archimedean α]
+
+protected lemma is_pred_limit.is_max (h : is_pred_limit a) : is_max a := h.dual.is_min
+
+@[simp] lemma is_pred_limit_iff : is_pred_limit a ↔ is_max a :=
+is_succ_limit_to_dual_iff.symm.trans is_succ_limit_iff
+
+lemma not_is_pred_limit [no_max_order α] : ¬ is_pred_limit a := by simp
+
+end is_pred_archimedean
+end partial_order
+end order
diff --git a/src/order/succ_pred/linear_locally_finite.lean b/src/order/succ_pred/linear_locally_finite.lean
new file mode 100644
index 0000000000000..2f0c15a1e5ba9
--- /dev/null
+++ b/src/order/succ_pred/linear_locally_finite.lean
@@ -0,0 +1,453 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import order.locally_finite
+import order.succ_pred.basic
+import order.hom.basic
+import data.countable.basic
+import logic.encodable.basic
+
+/-!
+# Linear locally finite orders
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We prove that a `linear_order` which is a `locally_finite_order` also verifies
+* `succ_order`
+* `pred_order`
+* `is_succ_archimedean`
+* `is_pred_archimedean`
+* `countable`
+
+Furthermore, we show that there is an `order_iso` between such an order and a subset of `ℤ`.
+
+## Main definitions
+
+* `to_Z i0 i`: in a linear order on which we can define predecessors and successors and which is
+  succ-archimedean, we can assign a unique integer `to_Z i0 i` to each element `i : ι` while
+  respecting the order, starting from `to_Z i0 i0 = 0`.
+
+## Main results
+
+Instances about linear locally finite orders:
+* `linear_locally_finite_order.succ_order`: a linear locally finite order has a successor function.
+* `linear_locally_finite_order.pred_order`: a linear locally finite order has a predecessor
+  function.
+* `linear_locally_finite_order.is_succ_archimedean`: a linear locally finite order is
+  succ-archimedean.
+* `linear_order.pred_archimedean_of_succ_archimedean`: a succ-archimedean linear order is also
+  pred-archimedean.
+* `countable_of_linear_succ_pred_arch` : a succ-archimedean linear order is countable.
+
+About `to_Z`:
+* `order_iso_range_to_Z_of_linear_succ_pred_arch`: `to_Z` defines an `order_iso` between `ι` and its
+  range.
+* `order_iso_nat_of_linear_succ_pred_arch`: if the order has a bot but no top, `to_Z` defines an
+  `order_iso` between `ι` and `ℕ`.
+* `order_iso_int_of_linear_succ_pred_arch`: if the order has neither bot nor top, `to_Z` defines an
+  `order_iso` between `ι` and `ℤ`.
+* `order_iso_range_of_linear_succ_pred_arch`: if the order has both a bot and a top, `to_Z` gives an
+  `order_iso` between `ι` and `finset.range ((to_Z ⊥ ⊤).to_nat + 1)`.
+
+-/
+
+open order
+
+variables {ι : Type*} [linear_order ι]
+
+namespace linear_locally_finite_order
+
+/-- Successor in a linear order. This defines a true successor only when `i` is isolated from above,
+i.e. when `i` is not the greatest lower bound of `(i, ∞)`. -/
+noncomputable def succ_fn (i : ι) : ι := (exists_glb_Ioi i).some
+
+lemma succ_fn_spec (i : ι) : is_glb (set.Ioi i) (succ_fn i) := (exists_glb_Ioi i).some_spec
+
+lemma le_succ_fn (i : ι) : i ≤ succ_fn i :=
+by { rw [le_is_glb_iff (succ_fn_spec i), mem_lower_bounds], exact λ x hx, (le_of_lt hx), }
+
+lemma is_glb_Ioc_of_is_glb_Ioi {i j k : ι} (hij_lt : i < j) (h : is_glb (set.Ioi i) k) :
+  is_glb (set.Ioc i j) k :=
+begin
+  simp_rw [is_glb, is_greatest, mem_upper_bounds, mem_lower_bounds] at h ⊢,
+  refine ⟨λ x hx, h.1 x hx.1, λ x hx, h.2 x _⟩,
+  intros y hy,
+  cases le_or_lt y j with h_le h_lt,
+  { exact hx y ⟨hy, h_le⟩, },
+  { exact le_trans (hx j ⟨hij_lt, le_rfl⟩) h_lt.le, },
+end
+
+lemma is_max_of_succ_fn_le [locally_finite_order ι] (i : ι) (hi : succ_fn i ≤ i) : is_max i :=
+begin
+  refine λ j hij, not_lt.mp (λ hij_lt, _),
+  have h_succ_fn_eq : succ_fn i = i := le_antisymm hi (le_succ_fn i),
+  have h_glb : is_glb (finset.Ioc i j : set ι) i,
+  { rw finset.coe_Ioc,
+    have h := succ_fn_spec i,
+    rw h_succ_fn_eq at h,
+    exact is_glb_Ioc_of_is_glb_Ioi hij_lt h, },
+  have hi_mem : i ∈ finset.Ioc i j,
+  { refine finset.is_glb_mem _ h_glb _,
+    exact ⟨_, finset.mem_Ioc.mpr ⟨hij_lt, le_rfl⟩⟩, },
+  rw finset.mem_Ioc at hi_mem,
+  exact lt_irrefl i hi_mem.1,
+end
+
+lemma succ_fn_le_of_lt (i j : ι) (hij : i < j) : succ_fn i ≤ j :=
+by { have h := succ_fn_spec i, rw [is_glb, is_greatest, mem_lower_bounds] at h, exact h.1 j hij, }
+
+lemma le_of_lt_succ_fn (j i : ι) (hij : j < succ_fn i) : j ≤ i :=
+begin
+  rw lt_is_glb_iff (succ_fn_spec i) at hij,
+  obtain ⟨k, hk_lb, hk⟩ := hij,
+  rw mem_lower_bounds at hk_lb,
+  exact not_lt.mp (λ hi_lt_j, not_le.mpr hk (hk_lb j hi_lt_j)),
+end
+
+@[priority 100]
+noncomputable instance [locally_finite_order ι] : succ_order ι :=
+{ succ := succ_fn,
+  le_succ := le_succ_fn,
+  max_of_succ_le := is_max_of_succ_fn_le,
+  succ_le_of_lt := succ_fn_le_of_lt,
+  le_of_lt_succ := le_of_lt_succ_fn, }
+
+@[priority 100]
+noncomputable instance [locally_finite_order ι] : pred_order ι :=
+@order_dual.pred_order ιᵒᵈ _ _
+
+end linear_locally_finite_order
+
+@[priority 100]
+instance linear_locally_finite_order.is_succ_archimedean [locally_finite_order ι] :
+  is_succ_archimedean ι :=
+{ exists_succ_iterate_of_le := λ i j hij,
+  begin
+    rw le_iff_lt_or_eq at hij,
+    cases hij,
+    swap, { refine ⟨0, _⟩, simpa only [function.iterate_zero, id.def] using hij, },
+    by_contra h,
+    push_neg at h,
+    have h_lt : ∀ n, succ^[n] i < j,
+    { intro n,
+      induction n with n hn,
+      { simpa only [function.iterate_zero, id.def] using hij, },
+      { refine lt_of_le_of_ne _ (h _),
+        rw [function.iterate_succ', function.comp_app],
+        exact succ_le_of_lt hn, }, },
+    have h_mem : ∀ n, succ^[n] i ∈ finset.Icc i j,
+      from λ n, finset.mem_Icc.mpr ⟨le_succ_iterate n i, (h_lt n).le⟩,
+    obtain ⟨n, m, hnm, h_eq⟩ : ∃ n m, n < m ∧ (succ^[n] i = (succ^[m] i)),
+    { let f : ℕ → finset.Icc i j := λ n, ⟨succ^[n] i, h_mem n⟩,
+      obtain ⟨n, m, hnm_ne, hfnm⟩ : ∃ n m, n ≠ m ∧ f n = f m,
+        from finite.exists_ne_map_eq_of_infinite f,
+      have hnm_eq : (succ^[n] i) = (succ^[m] i),
+      { simpa only [subtype.mk_eq_mk] using hfnm, },
+      cases le_total n m with h_le h_le,
+      { exact ⟨n, m, lt_of_le_of_ne h_le hnm_ne, hnm_eq⟩, },
+      { exact ⟨m, n, lt_of_le_of_ne h_le hnm_ne.symm, hnm_eq.symm ⟩, }, },
+    have h_max : is_max (succ^[n] i) := is_max_iterate_succ_of_eq_of_ne h_eq hnm.ne,
+    exact not_le.mpr (h_lt n) (h_max (h_lt n).le),
+  end }
+
+@[priority 100]
+instance linear_order.pred_archimedean_of_succ_archimedean [succ_order ι] [pred_order ι]
+  [is_succ_archimedean ι] :
+  is_pred_archimedean ι :=
+{ exists_pred_iterate_of_le := λ i j hij,
+  begin
+    have h_exists := exists_succ_iterate_of_le hij,
+    obtain ⟨n, hn_eq, hn_lt_ne⟩ : ∃ n, (succ^[n] i = j) ∧ (∀ m < n, succ^[m] i ≠ j),
+      from ⟨nat.find h_exists, nat.find_spec h_exists, λ m hmn, nat.find_min h_exists hmn⟩,
+    refine ⟨n, _⟩,
+    rw ← hn_eq,
+    induction n with n hn,
+    { simp only [function.iterate_zero, id.def], },
+    { rw pred_succ_iterate_of_not_is_max,
+      rw [nat.succ_sub_succ_eq_sub, tsub_zero],
+      suffices : (succ^[n] i) < (succ^[n.succ] i), from not_is_max_of_lt this,
+      refine lt_of_le_of_ne _ _,
+      { rw function.iterate_succ',
+        exact le_succ _, },
+      { rw hn_eq,
+        exact hn_lt_ne _ (nat.lt_succ_self n), }, },
+  end }
+
+
+section to_Z
+
+variables [succ_order ι] [is_succ_archimedean ι] [pred_order ι] {i0 i : ι}
+
+/-- `to_Z` numbers elements of `ι` according to their order, starting from `i0`. We prove in
+`order_iso_range_to_Z_of_linear_succ_pred_arch` that this defines an `order_iso` between `ι` and
+the range of `to_Z`. -/
+def to_Z (i0 i : ι) : ℤ :=
+dite (i0 ≤ i) (λ hi, nat.find (exists_succ_iterate_of_le hi))
+  (λ hi, - nat.find (exists_pred_iterate_of_le (not_le.mp hi).le))
+
+lemma to_Z_of_ge (hi : i0 ≤ i) : to_Z i0 i = nat.find (exists_succ_iterate_of_le hi) := dif_pos hi
+
+lemma to_Z_of_lt (hi : i < i0) : to_Z i0 i = - nat.find (exists_pred_iterate_of_le hi.le) :=
+dif_neg (not_le.mpr hi)
+
+@[simp] lemma to_Z_of_eq : to_Z i0 i0 = 0 :=
+begin
+  rw to_Z_of_ge le_rfl,
+  norm_cast,
+  refine le_antisymm (nat.find_le _) (zero_le _),
+  rw [function.iterate_zero, id.def],
+end
+
+lemma iterate_succ_to_Z (i : ι) (hi : i0 ≤ i) : succ^[(to_Z i0 i).to_nat] i0 = i :=
+by { rw [to_Z_of_ge hi, int.to_nat_coe_nat], exact nat.find_spec (exists_succ_iterate_of_le hi), }
+
+lemma iterate_pred_to_Z (i : ι) (hi : i < i0) : pred^[(- to_Z i0 i).to_nat] i0 = i :=
+begin
+  rw [to_Z_of_lt hi, neg_neg, int.to_nat_coe_nat],
+  exact nat.find_spec (exists_pred_iterate_of_le hi.le),
+end
+
+lemma to_Z_nonneg (hi : i0 ≤ i) : 0 ≤ to_Z i0 i :=
+by { rw to_Z_of_ge hi, exact nat.cast_nonneg _, }
+
+lemma to_Z_neg (hi : i < i0) : to_Z i0 i < 0 :=
+begin
+  refine lt_of_le_of_ne _ _,
+  { rw [to_Z_of_lt hi, neg_nonpos], exact nat.cast_nonneg _, },
+  { by_contra,
+    have h_eq := iterate_pred_to_Z i hi,
+    rw [← h_eq, h] at hi,
+    simpa only [neg_zero, int.to_nat_zero, function.iterate_zero, id.def, lt_self_iff_false]
+      using hi, },
+end
+
+lemma to_Z_iterate_succ_le (n : ℕ) : to_Z i0 (succ^[n] i0) ≤ n :=
+begin
+  rw to_Z_of_ge (le_succ_iterate _ _),
+  norm_cast,
+  exact nat.find_min' (exists_succ_iterate_of_le _) rfl,
+end
+
+lemma to_Z_iterate_pred_ge (n : ℕ) : -(n : ℤ) ≤ to_Z i0 (pred^[n] i0) :=
+begin
+  cases le_or_lt i0 (pred^[n] i0) with h h,
+  { have h_eq : (pred^[n] i0) = i0 := le_antisymm (pred_iterate_le _ _) h,
+    rw [h_eq, to_Z_of_eq],
+    simp only [right.neg_nonpos_iff, nat.cast_nonneg],},
+  { rw [to_Z_of_lt h, neg_le_neg_iff],
+    norm_cast,
+    exact nat.find_min' (exists_pred_iterate_of_le _) rfl, },
+end
+
+lemma to_Z_iterate_succ_of_not_is_max (n : ℕ) (hn : ¬ is_max (succ^[n] i0)) :
+  to_Z i0 (succ^[n] i0) = n :=
+begin
+  let m := (to_Z i0 (succ^[n] i0)).to_nat,
+  have h_eq : (succ^[m] i0) = (succ^[n] i0) := iterate_succ_to_Z _ (le_succ_iterate _ _),
+  by_cases hmn : m = n,
+  { nth_rewrite 1 ← hmn,
+    simp_rw [m],
+    rw [int.to_nat_eq_max, to_Z_of_ge (le_succ_iterate _ _), max_eq_left],
+    exact nat.cast_nonneg _, },
+  suffices : is_max (succ^[n] i0), from absurd this hn,
+  exact is_max_iterate_succ_of_eq_of_ne h_eq.symm (ne.symm hmn),
+end
+
+lemma to_Z_iterate_pred_of_not_is_min (n : ℕ) (hn : ¬ is_min (pred^[n] i0)) :
+  to_Z i0 (pred^[n] i0) = -n :=
+begin
+  cases n,
+  { simp only [function.iterate_zero, id.def, to_Z_of_eq, nat.cast_zero, neg_zero], },
+  have : (pred^[n.succ] i0) < i0,
+  { refine lt_of_le_of_ne (pred_iterate_le _ _) (λ h_pred_iterate_eq, hn _),
+    have h_pred_eq_pred : (pred^[n.succ] i0) = (pred^[0] i0),
+    { rwa [function.iterate_zero, id.def], },
+    exact is_min_iterate_pred_of_eq_of_ne h_pred_eq_pred (nat.succ_ne_zero n), },
+  let m := (- to_Z i0 (pred^[n.succ] i0)).to_nat,
+  have h_eq : (pred^[m] i0) = (pred^[n.succ] i0) := iterate_pred_to_Z _ this,
+  by_cases hmn : m = n.succ,
+  { nth_rewrite 1 ← hmn,
+    simp_rw [m],
+    rw [int.to_nat_eq_max, to_Z_of_lt this, max_eq_left, neg_neg],
+    rw neg_neg,
+    exact nat.cast_nonneg _, },
+  { suffices : is_min (pred^[n.succ] i0), from absurd this hn,
+    exact is_min_iterate_pred_of_eq_of_ne h_eq.symm (ne.symm hmn), },
+end
+
+lemma le_of_to_Z_le {j : ι} (h_le : to_Z i0 i ≤ to_Z i0 j) : i ≤ j :=
+begin
+  cases le_or_lt i0 i with hi hi; cases le_or_lt i0 j with hj hj,
+  { rw [← iterate_succ_to_Z i hi, ← iterate_succ_to_Z j hj],
+    exact monotone.monotone_iterate_of_le_map succ_mono (le_succ _) (int.to_nat_le_to_nat h_le), },
+  { exact absurd ((to_Z_neg hj).trans_le (to_Z_nonneg hi)) (not_lt.mpr h_le), },
+  { exact hi.le.trans hj, },
+  { rw [← iterate_pred_to_Z i hi, ← iterate_pred_to_Z j hj],
+    refine monotone.antitone_iterate_of_map_le pred_mono (pred_le _) (int.to_nat_le_to_nat _),
+    exact neg_le_neg h_le, },
+end
+
+lemma to_Z_mono {i j : ι} (h_le : i ≤ j) : to_Z i0 i ≤ to_Z i0 j :=
+begin
+  by_cases hi_max : is_max i,
+  { rw le_antisymm h_le (hi_max h_le), },
+  by_cases hj_min : is_min j,
+  { rw le_antisymm h_le (hj_min h_le), },
+  cases le_or_lt i0 i with hi hi; cases le_or_lt i0 j with hj hj,
+  { let m := nat.find (exists_succ_iterate_of_le h_le),
+    have hm : (succ^[m] i = j) := nat.find_spec (exists_succ_iterate_of_le h_le),
+    have hj_eq : j = (succ^[(to_Z i0 i).to_nat + m] i0),
+    { rw [← hm, add_comm],
+      nth_rewrite 0 ← iterate_succ_to_Z i hi,
+      rw function.iterate_add, },
+    by_contra h,
+    push_neg at h,
+    by_cases hm0 : m = 0,
+    { rw [hm0, function.iterate_zero, id.def] at hm,
+      rw hm at h,
+      exact lt_irrefl _ h, },
+    refine hi_max (max_of_succ_le (le_trans _ (@le_of_to_Z_le _ _ _ _ _ i0 _ _ _))),
+    { exact j, },
+    { have h_succ_le : (succ^[(to_Z i0 i).to_nat + 1] i0) ≤ j,
+      { rw hj_eq,
+        refine monotone.monotone_iterate_of_le_map succ_mono (le_succ i0) (add_le_add_left _ _),
+        exact nat.one_le_iff_ne_zero.mpr hm0, },
+      rwa [function.iterate_succ', function.comp_app, iterate_succ_to_Z i hi] at h_succ_le, },
+    { exact h.le, }, },
+  { exact absurd h_le (not_le.mpr (hj.trans_le hi)), },
+  { exact (to_Z_neg hi).le.trans (to_Z_nonneg hj), },
+  { let m := nat.find (exists_pred_iterate_of_le h_le),
+    have hm : (pred^[m] j = i) := nat.find_spec (exists_pred_iterate_of_le h_le),
+    have hj_eq : i = (pred^[(-to_Z i0 j).to_nat + m] i0),
+    { rw [← hm, add_comm],
+      nth_rewrite 0 ← iterate_pred_to_Z j hj,
+      rw function.iterate_add, },
+    by_contra h,
+    push_neg at h,
+    by_cases hm0 : m = 0,
+    { rw [hm0, function.iterate_zero, id.def] at hm,
+      rw hm at h,
+      exact lt_irrefl _ h, },
+    refine hj_min (min_of_le_pred _),
+    refine (@le_of_to_Z_le _ _ _ _ _ i0 _ _ _).trans _,
+    { exact i, },
+    { exact h.le, },
+    { have h_le_pred : i ≤ (pred^[(-to_Z i0 j).to_nat + 1] i0),
+      { rw hj_eq,
+        refine monotone.antitone_iterate_of_map_le pred_mono (pred_le i0) (add_le_add_left _ _),
+        exact nat.one_le_iff_ne_zero.mpr hm0, },
+      rwa [function.iterate_succ', function.comp_app, iterate_pred_to_Z j hj]
+        at h_le_pred, }, },
+end
+
+lemma to_Z_le_iff (i j : ι) : to_Z i0 i ≤ to_Z i0 j ↔ i ≤ j :=
+⟨le_of_to_Z_le, to_Z_mono⟩
+
+lemma to_Z_iterate_succ [no_max_order ι] (n : ℕ) : to_Z i0 (succ^[n] i0) = n :=
+to_Z_iterate_succ_of_not_is_max n (not_is_max _)
+
+lemma to_Z_iterate_pred [no_min_order ι] (n : ℕ) : to_Z i0 (pred^[n] i0) = -n :=
+to_Z_iterate_pred_of_not_is_min n (not_is_min _)
+
+lemma injective_to_Z : function.injective (to_Z i0) :=
+λ i j hij, le_antisymm (le_of_to_Z_le hij.le) (le_of_to_Z_le hij.symm.le)
+
+end to_Z
+
+section order_iso
+
+variables [succ_order ι] [pred_order ι] [is_succ_archimedean ι]
+
+/-- `to_Z` defines an `order_iso` between `ι` and its range. -/
+noncomputable
+def order_iso_range_to_Z_of_linear_succ_pred_arch [hι : nonempty ι] :
+  ι ≃o set.range (to_Z hι.some) :=
+{ to_equiv := equiv.of_injective _ injective_to_Z,
+  map_rel_iff' := to_Z_le_iff, }
+
+@[priority 100]
+instance countable_of_linear_succ_pred_arch : countable ι :=
+begin
+  casesI is_empty_or_nonempty ι with _ hι,
+  { apply_instance, },
+  { exact countable.of_equiv _ (order_iso_range_to_Z_of_linear_succ_pred_arch).symm.to_equiv, },
+end
+
+/-- If the order has neither bot nor top, `to_Z` defines an `order_iso` between `ι` and `ℤ`. -/
+noncomputable
+def order_iso_int_of_linear_succ_pred_arch [no_max_order ι] [no_min_order ι] [hι : nonempty ι] :
+  ι ≃o ℤ :=
+{ to_fun := to_Z hι.some,
+  inv_fun := λ n, if 0 ≤ n then (succ^[n.to_nat] hι.some) else (pred^[(-n).to_nat] hι.some),
+  left_inv := λ i,
+  begin
+    cases le_or_lt hι.some i with hi hi,
+    { have h_nonneg : 0 ≤ to_Z hι.some i := to_Z_nonneg hi,
+      simp_rw if_pos h_nonneg,
+      exact iterate_succ_to_Z i hi, },
+    { have h_neg : to_Z hι.some i < 0 := to_Z_neg hi,
+      simp_rw if_neg (not_le.mpr h_neg),
+      exact iterate_pred_to_Z i hi, },
+  end,
+  right_inv := λ n,
+  begin
+    cases le_or_lt 0 n with hn hn,
+    { simp_rw if_pos hn,
+      rw to_Z_iterate_succ,
+      exact int.to_nat_of_nonneg hn, },
+    { simp_rw if_neg (not_le.mpr hn),
+      rw to_Z_iterate_pred,
+      simp only [hn.le, int.to_nat_of_nonneg, right.nonneg_neg_iff, neg_neg], },
+  end,
+  map_rel_iff' := to_Z_le_iff, }
+
+/-- If the order has a bot but no top, `to_Z` defines an `order_iso` between `ι` and `ℕ`. -/
+def order_iso_nat_of_linear_succ_pred_arch [no_max_order ι] [order_bot ι] :
+  ι ≃o ℕ :=
+{ to_fun := λ i, (to_Z ⊥ i).to_nat,
+  inv_fun := λ n, succ^[n] ⊥,
+  left_inv := λ i, by { simp_rw if_pos (to_Z_nonneg bot_le), exact iterate_succ_to_Z i bot_le, },
+  right_inv := λ n,
+  begin
+    simp_rw if_pos bot_le,
+    rw to_Z_iterate_succ,
+    exact int.to_nat_coe_nat n,
+  end,
+  map_rel_iff' := λ i j,
+  begin
+    simp only [equiv.coe_fn_mk, int.to_nat_le],
+    rw [← @to_Z_le_iff ι _ _ _ _ ⊥, int.to_nat_of_nonneg (to_Z_nonneg bot_le)],
+  end, }
+
+/-- If the order has both a bot and a top, `to_Z` gives an `order_iso` between `ι` and
+`finset.range n` for some `n`. -/
+def order_iso_range_of_linear_succ_pred_arch [order_bot ι] [order_top ι] :
+  ι ≃o finset.range ((to_Z ⊥ (⊤ : ι)).to_nat + 1) :=
+{ to_fun := λ i, ⟨(to_Z ⊥ i).to_nat,
+    finset.mem_range_succ_iff.mpr (int.to_nat_le_to_nat ((to_Z_le_iff _ _).mpr le_top))⟩,
+  inv_fun := λ n, succ^[n] ⊥,
+  left_inv := λ i, iterate_succ_to_Z i bot_le,
+  right_inv := λ n, begin
+    ext1,
+    simp only [subtype.coe_mk],
+    refine le_antisymm _ _,
+    { rw int.to_nat_le,
+      exact (to_Z_iterate_succ_le _), },
+    by_cases hn_max : is_max (succ^[↑n] (⊥ : ι)),
+    { rw [← is_top_iff_is_max, is_top_iff_eq_top] at hn_max,
+      rw hn_max,
+      exact nat.lt_succ_iff.mp (finset.mem_range.mp n.prop), },
+    { rw to_Z_iterate_succ_of_not_is_max _ hn_max,
+      simp only [int.to_nat_coe_nat], },
+  end,
+  map_rel_iff' := λ i j,
+  begin
+    simp only [equiv.coe_fn_mk, subtype.mk_le_mk, int.to_nat_le],
+    rw [← @to_Z_le_iff ι _ _ _ _ ⊥, int.to_nat_of_nonneg (to_Z_nonneg bot_le)],
+  end, }
+
+end order_iso
diff --git a/src/order/succ_pred/relation.lean b/src/order/succ_pred/relation.lean
index 15a145eeb1af0..31eacfbe6c891 100644
--- a/src/order/succ_pred/relation.lean
+++ b/src/order/succ_pred/relation.lean
@@ -7,6 +7,9 @@ import order.succ_pred.basic
 /-!
 # Relations on types with a `succ_order`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains properties about relations on types with a `succ_order`
 and their closure operations (like the transitive closure).
 -/
diff --git a/src/order/sup_indep.lean b/src/order/sup_indep.lean
index e8c0829f3ea72..572799ddcd38e 100644
--- a/src/order/sup_indep.lean
+++ b/src/order/sup_indep.lean
@@ -3,12 +3,17 @@ Copyright (c) 2021 Aaron Anderson, Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson, Kevin Buzzard, Yaël Dillies, Eric Wieser
 -/
+import data.finset.sigma
 import data.finset.pairwise
-import data.set.finite
+import data.finset.powerset
+import data.fintype.basic
 
 /-!
 # Supremum independence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define supremum independence of indexed sets. An indexed family `f : ι → α` is
 sup-independent if, for all `a`, `f a` and the supremum of the rest are disjoint.
 
@@ -73,12 +78,45 @@ end
 lemma sup_indep.pairwise_disjoint (hs : s.sup_indep f) : (s : set ι).pairwise_disjoint f :=
 λ a ha b hb hab, sup_singleton.subst $ hs (singleton_subset_iff.2 hb) ha $ not_mem_singleton.2 hab
 
+lemma sup_indep.le_sup_iff (hs : s.sup_indep f) (hts : t ⊆ s) (hi : i ∈ s) (hf : ∀ i, f i ≠ ⊥) :
+  f i ≤ t.sup f ↔ i ∈ t :=
+begin
+  refine ⟨λ h, _, le_sup⟩,
+  by_contra hit,
+  exact hf i (disjoint_self.1 $ (hs hts hi hit).mono_right h),
+end
+
 /-- The RHS looks like the definition of `complete_lattice.independent`. -/
 lemma sup_indep_iff_disjoint_erase [decidable_eq ι] :
   s.sup_indep f ↔ ∀ i ∈ s, disjoint (f i) ((s.erase i).sup f) :=
 ⟨λ hs i hi, hs (erase_subset _ _) hi (not_mem_erase _ _), λ hs t ht i hi hit,
   (hs i hi).mono_right (sup_mono $ λ j hj, mem_erase.2 ⟨ne_of_mem_of_not_mem hj hit, ht hj⟩)⟩
 
+lemma sup_indep.image [decidable_eq ι] {s : finset ι'} {g : ι' → ι} (hs : s.sup_indep (f ∘ g)) :
+  (s.image g).sup_indep f :=
+begin
+  intros t ht i hi hit,
+  rw mem_image at hi,
+  obtain ⟨i, hi, rfl⟩ := hi,
+  haveI : decidable_eq ι' := classical.dec_eq _,
+  suffices hts : t ⊆ (s.erase i).image g,
+  { refine (sup_indep_iff_disjoint_erase.1 hs i hi).mono_right ((sup_mono hts).trans _),
+    rw sup_image },
+  rintro j hjt,
+  obtain ⟨j, hj, rfl⟩ := mem_image.1 (ht hjt),
+  exact mem_image_of_mem _ (mem_erase.2 ⟨ne_of_apply_ne g (ne_of_mem_of_not_mem hjt hit), hj⟩),
+end
+
+lemma sup_indep_map {s : finset ι'} {g : ι' ↪ ι} : (s.map g).sup_indep f ↔ s.sup_indep (f ∘ g) :=
+begin
+  refine ⟨λ hs t ht i hi hit, _, λ hs, _⟩,
+  { rw ←sup_map,
+    exact hs (map_subset_map.2 ht) ((mem_map' _).2 hi) (by rwa mem_map') },
+  { classical,
+    rw map_eq_image,
+    exact hs.image }
+end
+
 @[simp] lemma sup_indep_pair [decidable_eq ι] {i j : ι} (hij : i ≠ j) :
   ({i, j} : finset ι).sup_indep f ↔ disjoint (f i) (f j) :=
 ⟨λ h, h.pairwise_disjoint (by simp) (by simp) hij, λ h, begin
@@ -113,7 +151,7 @@ begin
   exact sup_indep_pair this,
 end
 
-lemma sup_indep.attach (hs : s.sup_indep f) : s.attach.sup_indep (f ∘ subtype.val) :=
+lemma sup_indep.attach (hs : s.sup_indep f) : s.attach.sup_indep (λ a, f a) :=
 begin
   intros t ht i _ hi,
   classical,
@@ -124,6 +162,18 @@ begin
   rwa subtype.ext hji at hj,
 end
 
+@[simp] lemma sup_indep_attach : s.attach.sup_indep (λ a, f a) ↔ s.sup_indep f :=
+begin
+  refine ⟨λ h t ht i his hit, _, sup_indep.attach⟩,
+  classical,
+  convert h (filter_subset (λ i, (i : ι) ∈ t) _) (mem_attach _ ⟨i, ‹_›⟩)
+    (λ hi, hit $ by simpa using hi) using 1,
+  refine eq_of_forall_ge_iff _,
+  simp only [finset.sup_le_iff, mem_filter, mem_attach, true_and, function.comp_app, subtype.forall,
+    subtype.coe_mk],
+  exact λ a, forall_congr (λ j, ⟨λ h _, h, λ h hj, h (ht hj) hj⟩),
+end
+
 end lattice
 
 section distrib_lattice
@@ -131,10 +181,10 @@ variables [distrib_lattice α] [order_bot α] {s : finset ι} {f : ι → α}
 
 lemma sup_indep_iff_pairwise_disjoint : s.sup_indep f ↔ (s : set ι).pairwise_disjoint f :=
 ⟨sup_indep.pairwise_disjoint, λ hs t ht i hi hit,
-  disjoint_sup_right.2 $ λ j hj, hs hi (ht hj) (ne_of_mem_of_not_mem hj hit).symm⟩
+  finset.disjoint_sup_right.2 $ λ j hj, hs hi (ht hj) (ne_of_mem_of_not_mem hj hit).symm⟩
 
-alias sup_indep_iff_pairwise_disjoint ↔ finset.sup_indep.pairwise_disjoint
-  set.pairwise_disjoint.sup_indep
+alias sup_indep_iff_pairwise_disjoint ↔ sup_indep.pairwise_disjoint
+  _root_.set.pairwise_disjoint.sup_indep
 
 /-- Bind operation for `sup_indep`. -/
 lemma sup_indep.sup [decidable_eq ι] {s : finset ι'} {g : ι' → finset ι} {f : ι → α}
@@ -152,6 +202,58 @@ lemma sup_indep.bUnion [decidable_eq ι] {s : finset ι'} {g : ι' → finset ι
   (s.bUnion g).sup_indep f :=
 by { rw ←sup_eq_bUnion, exact hs.sup hg }
 
+/-- Bind operation for `sup_indep`. -/
+lemma sup_indep.sigma {β : ι → Type*} {s : finset ι} {g : Π i, finset (β i)} {f : sigma β → α}
+  (hs : s.sup_indep $ λ i, (g i).sup $ λ b, f ⟨i, b⟩)
+  (hg : ∀ i ∈ s, (g i).sup_indep $ λ b, f ⟨i, b⟩) :
+  (s.sigma g).sup_indep f :=
+begin
+  rintro t ht ⟨i, b⟩ hi hit,
+  rw finset.disjoint_sup_right,
+  rintro ⟨j, c⟩ hj,
+  have hbc := (ne_of_mem_of_not_mem hj hit).symm,
+  replace hj := ht hj,
+  rw mem_sigma at hi hj,
+  obtain rfl | hij := eq_or_ne i j,
+  { exact (hg _ hj.1).pairwise_disjoint hi.2 hj.2 (sigma_mk_injective.ne_iff.1 hbc) },
+  { refine (hs.pairwise_disjoint hi.1 hj.1 hij).mono _ _,
+    { convert le_sup hi.2 },
+    { convert le_sup hj.2 } }
+end
+
+lemma sup_indep.product {s : finset ι} {t : finset ι'} {f : ι × ι' → α}
+  (hs : s.sup_indep $ λ i, t.sup $ λ i', f (i, i'))
+  (ht : t.sup_indep $ λ i', s.sup $ λ i, f (i, i')) :
+  (s.product t).sup_indep f :=
+begin
+  rintro u hu ⟨i, i'⟩ hi hiu,
+  rw finset.disjoint_sup_right,
+  rintro ⟨j, j'⟩ hj,
+  have hij := (ne_of_mem_of_not_mem hj hiu).symm,
+  replace hj := hu hj,
+  rw mem_product at hi hj,
+  obtain rfl | hij := eq_or_ne i j,
+  { refine (ht.pairwise_disjoint hi.2 hj.2 $ (prod.mk.inj_left _).ne_iff.1 hij).mono _ _,
+    { convert le_sup hi.1 },
+    { convert le_sup hj.1 } },
+  { refine (hs.pairwise_disjoint hi.1 hj.1 hij).mono _ _,
+    { convert le_sup hi.2 },
+    { convert le_sup hj.2 } }
+end
+
+lemma sup_indep_product_iff {s : finset ι} {t : finset ι'} {f : ι × ι' → α} :
+  (s.product t).sup_indep f ↔
+    s.sup_indep (λ i, t.sup $ λ i', f (i, i')) ∧ t.sup_indep (λ i', s.sup $ λ i, f (i, i')) :=
+begin
+  refine ⟨_, λ h, h.1.product h.2⟩,
+  simp_rw sup_indep_iff_pairwise_disjoint,
+  refine (λ h, ⟨λ i hi j hj hij, _, λ i hi j hj hij, _⟩);
+    simp_rw [function.on_fun, finset.disjoint_sup_left, finset.disjoint_sup_right];
+      intros i' hi' j' hj',
+  { exact h (mk_mem_product hi hi') (mk_mem_product hj hj') (ne_of_apply_ne prod.fst hij) },
+  { exact h (mk_mem_product hi' hi) (mk_mem_product hj' hj) (ne_of_apply_ne prod.snd hij) }
+end
+
 end distrib_lattice
 end finset
 
@@ -161,7 +263,7 @@ end finset
 namespace complete_lattice
 variables [complete_lattice α]
 
-open set
+open set function
 
 /-- An independent set of elements in a complete lattice is one in which every element is disjoint
   from the `Sup` of the rest. -/
@@ -235,11 +337,11 @@ variables {t : ι → α} (ht : independent t)
 theorem independent_def : independent t ↔ ∀ i : ι, disjoint (t i) (⨆ (j ≠ i), t j) :=
 iff.rfl
 
-theorem independent_def' {ι : Type*} {t : ι → α} :
+theorem independent_def' :
   independent t ↔ ∀ i, disjoint (t i) (Sup (t '' {j | j ≠ i})) :=
 by {simp_rw Sup_image, refl}
 
-theorem independent_def'' {ι : Type*} {t : ι → α} :
+theorem independent_def'' :
   independent t ↔ ∀ i, disjoint (t i) (Sup {a | ∃ j ≠ i, t j = a}) :=
 by {rw independent_def', tidy}
 
@@ -253,27 +355,56 @@ lemma independent_pempty (t : pempty → α) : independent t.
 lemma independent.pairwise_disjoint : pairwise (disjoint on t) :=
 λ x y h, disjoint_Sup_right (ht x) ⟨y, supr_pos h.symm⟩
 
-lemma independent.mono {ι : Type*} {α : Type*} [complete_lattice α]
+lemma independent.mono
   {s t : ι → α} (hs : independent s) (hst : t ≤ s) :
   independent t :=
 λ i, (hs i).mono (hst i) $ supr₂_mono $ λ j _, hst j
 
 /-- Composing an independent indexed family with an injective function on the index results in
 another indepedendent indexed family. -/
-lemma independent.comp {ι ι' : Sort*} {α : Type*} [complete_lattice α]
-  {s : ι → α} (hs : independent s) (f : ι' → ι) (hf : function.injective f) :
-  independent (s ∘ f) :=
-λ i, (hs (f i)).mono_right $ begin
+lemma independent.comp {ι ι' : Sort*}
+  {t : ι → α} {f : ι' → ι} (ht : independent t) (hf : injective f) :
+  independent (t ∘ f) :=
+λ i, (ht (f i)).mono_right $ begin
   refine (supr_mono $ λ i, _).trans (supr_comp_le _ f),
   exact supr_const_mono hf.ne,
 end
 
+lemma independent.comp' {ι ι' : Sort*}
+  {t : ι → α} {f : ι' → ι} (ht : independent $ t ∘ f) (hf : surjective f) :
+  independent t :=
+begin
+  intros i,
+  obtain ⟨i', rfl⟩ := hf i,
+  rw ← hf.supr_comp,
+  exact (ht i').mono_right (bsupr_mono $ λ j' hij, mt (congr_arg f) hij),
+end
+
+lemma independent.set_independent_range (ht : independent t) :
+  set_independent $ range t :=
+begin
+  rw set_independent_iff,
+  rw ← coe_comp_range_factorization t at ht,
+  exact ht.comp' surjective_onto_range,
+end
+
+lemma independent.injective (ht : independent t) (h_ne_bot : ∀ i, t i ≠ ⊥) : injective t :=
+begin
+  intros i j h,
+  by_contra' contra,
+  apply h_ne_bot j,
+  suffices : t j ≤ ⨆ k (hk : k ≠ i), t k,
+  { replace ht := (ht i).mono_right this,
+    rwa [h, disjoint_self] at ht, },
+  replace contra : j ≠ i, { exact ne.symm contra, },
+  exact le_supr₂ j contra,
+end
+
 lemma independent_pair {i j : ι} (hij : i ≠ j) (huniv : ∀ k, k = i ∨ k = j):
   independent t ↔ disjoint (t i) (t j) :=
 begin
   split,
-  { intro h,
-    exact h.pairwise_disjoint _ _ hij, },
+  { exact λ h, h.pairwise_disjoint hij },
   { rintros h k,
     obtain rfl | rfl := huniv k,
     { refine h.mono_right (supr_le $ λ i, supr_le $ λ hi, eq.le _),
@@ -342,11 +473,11 @@ lemma set_independent_iff_pairwise_disjoint {s : set α} :
 ⟨set_independent.pairwise_disjoint, λ hs i hi, disjoint_Sup_iff.2 $ λ j hj,
   hs hi hj.1 $ ne.symm hj.2⟩
 
-alias set_independent_iff_pairwise_disjoint ↔ _ set.pairwise_disjoint.set_independent
+alias set_independent_iff_pairwise_disjoint ↔ _ _root_.set.pairwise_disjoint.set_independent
 
 lemma independent_iff_pairwise_disjoint {f : ι → α} : independent f ↔ pairwise (disjoint on f) :=
 ⟨independent.pairwise_disjoint, λ hs i, disjoint_supr_iff.2 $ λ j, disjoint_supr_iff.2 $ λ hij,
-  hs _ _ hij.symm⟩
+  hs hij.symm⟩
 
 end complete_lattice
 
diff --git a/src/order/symm_diff.lean b/src/order/symm_diff.lean
index 8ff6d2324906e..03b12b22de22a 100644
--- a/src/order/symm_diff.lean
+++ b/src/order/symm_diff.lean
@@ -1,26 +1,34 @@
 /-
 Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Adam Topaz, Bryan Gin-ge Chen
+Authors: Adam Topaz, Bryan Gin-ge Chen, Yaël Dillies
 -/
 
 import order.boolean_algebra
+import logic.equiv.basic
 
 /-!
-# Symmetric difference
+# Symmetric difference and bi-implication
 
-The symmetric difference or disjunctive union of sets `A` and `B` is the set of elements that are
-in either `A` or `B` but not both. Translated into propositions, the symmetric difference is `xor`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-The symmetric difference operator (`symm_diff`) is defined in this file for any type with `⊔` and
-`\` via the formula `(A \ B) ⊔ (B \ A)`, however the theorems proved about it only hold for
-`generalized_boolean_algebra`s and `boolean_algebra`s.
+This file defines the symmetric difference and bi-implication operators in (co-)Heyting algebras.
 
-The symmetric difference is the addition operator in the Boolean ring structure on Boolean algebras.
+## Examples
+
+Some examples are
+* The symmetric difference of two sets is the set of elements that are in either but not both.
+* The symmetric difference on propositions is `xor`.
+* The symmetric difference on `bool` is `bxor`.
+* The equivalence of propositions. Two propositions are equivalent if they imply each other.
+* The symmetric difference translates to addition when considering a Boolean algebra as a Boolean
+  ring.
 
 ## Main declarations
 
-* `symm_diff`: the symmetric difference operator, defined as `(A \ B) ⊔ (B \ A)`
+* `symm_diff`: The symmetric difference operator, defined as `(a \ b) ⊔ (b \ a)`
+* `bihimp`: The bi-implication operator, defined as `(b ⇨ a) ⊓ (a ⇨ b)`
 
 In generalized Boolean algebras, the symmetric difference operator is:
 
@@ -30,6 +38,7 @@ In generalized Boolean algebras, the symmetric difference operator is:
 ## Notations
 
 * `a ∆ b`: `symm_diff a b`
+* `a ⇔ b`: `bihimp a b`
 
 ## References
 
@@ -39,24 +48,41 @@ Proof from the Book" by John McCuan:
 * 
 
 ## Tags
-boolean ring, generalized boolean algebra, boolean algebra, symmetric differences
+
+boolean ring, generalized boolean algebra, boolean algebra, symmetric difference, bi-implication,
+Heyting
 -/
 
+open function order_dual
+
+variables {ι α β : Type*} {π : ι → Type*}
+
 /-- The symmetric difference operator on a type with `⊔` and `\` is `(A \ B) ⊔ (B \ A)`. -/
-def symm_diff {α : Type*} [has_sup α] [has_sdiff α] (A B : α) : α := (A \ B) ⊔ (B \ A)
+def symm_diff [has_sup α] [has_sdiff α] (a b : α) : α := a \ b ⊔ b \ a
+
+/-- The Heyting bi-implication is `(b ⇨ a) ⊓ (a ⇨ b)`. This generalizes equivalence of
+propositions. -/
+def bihimp [has_inf α] [has_himp α] (a b : α) : α := (b ⇨ a) ⊓ (a ⇨ b)
 
 /- This notation might conflict with the Laplacian once we have it. Feel free to put it in locale
 `order` or `symm_diff` if that happens. -/
 infix ` ∆ `:100 := symm_diff
+infix ` ⇔ `:100 := bihimp
 
-lemma symm_diff_def {α : Type*} [has_sup α] [has_sdiff α] (A B : α) :
-  A ∆ B = (A \ B) ⊔ (B \ A) :=
-rfl
+lemma symm_diff_def [has_sup α] [has_sdiff α] (a b : α) : a ∆ b = (a \ b) ⊔ (b \ a) := rfl
+lemma bihimp_def [has_inf α] [has_himp α] (a b : α) : a ⇔ b = (b ⇨ a) ⊓ (a ⇨ b):= rfl
 
 lemma symm_diff_eq_xor (p q : Prop) : p ∆ q = xor p q := rfl
+@[simp] lemma bihimp_iff_iff {p q : Prop} : p ⇔ q ↔ (p ↔ q) :=
+(iff_iff_implies_and_implies _ _).symm.trans iff.comm
 
-section generalized_boolean_algebra
-variables {α : Type*} [generalized_boolean_algebra α] (a b c d : α)
+@[simp] lemma bool.symm_diff_eq_bxor : ∀ p q : bool, p ∆ q = bxor p q := dec_trivial
+
+section generalized_coheyting_algebra
+variables [generalized_coheyting_algebra α] (a b c d : α)
+
+@[simp] lemma to_dual_symm_diff : to_dual (a ∆ b) = to_dual a ⇔ to_dual b := rfl
+@[simp] lemma of_dual_bihimp (a b : αᵒᵈ) : of_dual (a ⇔ b) = of_dual a ∆ of_dual b := rfl
 
 lemma symm_diff_comm : a ∆ b = b ∆ a := by simp only [(∆), sup_comm]
 
@@ -66,8 +92,160 @@ instance symm_diff_is_comm : is_commutative α (∆) := ⟨symm_diff_comm⟩
 @[simp] lemma symm_diff_bot : a ∆ ⊥ = a := by rw [(∆), sdiff_bot, bot_sdiff, sup_bot_eq]
 @[simp] lemma bot_symm_diff : ⊥ ∆ a = a := by rw [symm_diff_comm, symm_diff_bot]
 
-lemma symm_diff_eq_sup_sdiff_inf : a ∆ b = (a ⊔ b) \ (a ⊓ b) :=
-by simp [sup_sdiff, sdiff_inf, sup_comm, (∆)]
+@[simp] lemma symm_diff_eq_bot {a b : α} : a ∆ b = ⊥ ↔ a = b :=
+by simp_rw [symm_diff, sup_eq_bot_iff, sdiff_eq_bot_iff, le_antisymm_iff]
+
+lemma symm_diff_of_le {a b : α} (h : a ≤ b) : a ∆ b = b \ a :=
+by rw [symm_diff, sdiff_eq_bot_iff.2 h, bot_sup_eq]
+
+lemma symm_diff_of_ge {a b : α} (h : b ≤ a) : a ∆ b = a \ b :=
+by rw [symm_diff, sdiff_eq_bot_iff.2 h, sup_bot_eq]
+
+lemma symm_diff_le {a b c : α} (ha : a ≤ b ⊔ c) (hb : b ≤ a ⊔ c) : a ∆ b ≤ c :=
+sup_le (sdiff_le_iff.2 ha) $ sdiff_le_iff.2 hb
+
+lemma symm_diff_le_iff {a b c : α} : a ∆ b ≤ c ↔ a ≤ b ⊔ c ∧ b ≤ a ⊔ c :=
+by simp_rw [symm_diff, sup_le_iff, sdiff_le_iff]
+
+@[simp] lemma symm_diff_le_sup {a b : α} : a ∆ b ≤ a ⊔ b := sup_le_sup sdiff_le sdiff_le
+
+lemma symm_diff_eq_sup_sdiff_inf : a ∆ b = (a ⊔ b) \ (a ⊓ b) := by simp [sup_sdiff, symm_diff]
+
+lemma disjoint.symm_diff_eq_sup {a b : α} (h : disjoint a b) : a ∆ b = a ⊔ b :=
+by rw [(∆), h.sdiff_eq_left, h.sdiff_eq_right]
+
+lemma symm_diff_sdiff : (a ∆ b) \ c = a \ (b ⊔ c) ⊔ b \ (a ⊔ c) :=
+by rw [symm_diff, sup_sdiff_distrib, sdiff_sdiff_left, sdiff_sdiff_left]
+
+@[simp] lemma symm_diff_sdiff_inf : a ∆ b \ (a ⊓ b) = a ∆ b :=
+by { rw symm_diff_sdiff, simp [symm_diff] }
+
+@[simp] lemma symm_diff_sdiff_eq_sup : a ∆ (b \ a) = a ⊔ b :=
+begin
+  rw [symm_diff, sdiff_idem],
+  exact le_antisymm (sup_le_sup sdiff_le sdiff_le)
+    (sup_le le_sdiff_sup $ le_sdiff_sup.trans $ sup_le le_sup_right le_sdiff_sup),
+end
+
+@[simp] lemma sdiff_symm_diff_eq_sup : (a \ b) ∆ b = a ⊔ b :=
+by rw [symm_diff_comm, symm_diff_sdiff_eq_sup, sup_comm]
+
+@[simp] lemma symm_diff_sup_inf : a ∆ b ⊔ a ⊓ b = a ⊔ b :=
+begin
+  refine le_antisymm (sup_le symm_diff_le_sup inf_le_sup) _,
+  rw [sup_inf_left, symm_diff],
+  refine sup_le (le_inf le_sup_right _) (le_inf _ le_sup_right),
+  { rw sup_right_comm,
+    exact le_sup_of_le_left le_sdiff_sup },
+  { rw sup_assoc,
+    exact le_sup_of_le_right le_sdiff_sup }
+end
+
+@[simp] lemma inf_sup_symm_diff : a ⊓ b ⊔ a ∆ b = a ⊔ b := by rw [sup_comm, symm_diff_sup_inf]
+
+@[simp] lemma symm_diff_symm_diff_inf : a ∆ b ∆ (a ⊓ b) = a ⊔ b :=
+by rw [←symm_diff_sdiff_inf a, sdiff_symm_diff_eq_sup, symm_diff_sup_inf]
+
+@[simp] lemma inf_symm_diff_symm_diff : (a ⊓ b) ∆ (a ∆ b) = a ⊔ b :=
+by rw [symm_diff_comm, symm_diff_symm_diff_inf]
+
+lemma symm_diff_triangle : a ∆ c ≤ a ∆ b ⊔ b ∆ c :=
+begin
+  refine (sup_le_sup (sdiff_triangle a b c) $ sdiff_triangle _ b _).trans_eq _,
+  rw [@sup_comm _ _ (c \ b), sup_sup_sup_comm, symm_diff, symm_diff],
+end
+
+end generalized_coheyting_algebra
+
+section generalized_heyting_algebra
+variables [generalized_heyting_algebra α] (a b c d : α)
+
+@[simp] lemma to_dual_bihimp : to_dual (a ⇔ b) = to_dual a ∆ to_dual b := rfl
+@[simp] lemma of_dual_symm_diff (a b : αᵒᵈ) : of_dual (a ∆ b) = of_dual a ⇔ of_dual b := rfl
+
+lemma bihimp_comm : a ⇔ b = b ⇔ a := by simp only [(⇔), inf_comm]
+
+instance bihimp_is_comm : is_commutative α (⇔) := ⟨bihimp_comm⟩
+
+@[simp] lemma bihimp_self : a ⇔ a = ⊤ := by rw [(⇔), inf_idem, himp_self]
+@[simp] lemma bihimp_top : a ⇔ ⊤ = a := by rw [(⇔), himp_top, top_himp, inf_top_eq]
+@[simp] lemma top_bihimp : ⊤ ⇔ a = a := by rw [bihimp_comm, bihimp_top]
+
+@[simp] lemma bihimp_eq_top {a b : α} : a ⇔ b = ⊤ ↔ a = b := @symm_diff_eq_bot αᵒᵈ _ _ _
+
+lemma bihimp_of_le {a b : α} (h : a ≤ b) : a ⇔ b = b ⇨ a :=
+by rw [bihimp, himp_eq_top_iff.2 h, inf_top_eq]
+
+lemma bihimp_of_ge {a b : α} (h : b ≤ a) : a ⇔ b = a ⇨ b :=
+by rw [bihimp, himp_eq_top_iff.2 h, top_inf_eq]
+
+lemma le_bihimp {a b c : α} (hb : a ⊓ b ≤ c) (hc : a ⊓ c ≤ b) : a ≤ b ⇔ c :=
+le_inf (le_himp_iff.2 hc) $ le_himp_iff.2 hb
+
+lemma le_bihimp_iff {a b c : α} : a ≤ b ⇔ c ↔ a ⊓ b ≤ c ∧ a ⊓ c ≤ b :=
+by simp_rw [bihimp, le_inf_iff, le_himp_iff, and.comm]
+
+@[simp] lemma inf_le_bihimp {a b : α} : a ⊓ b ≤ a ⇔ b := inf_le_inf le_himp le_himp
+
+lemma bihimp_eq_inf_himp_inf : a ⇔ b = (a ⊔ b) ⇨ (a ⊓ b) := by simp [himp_inf_distrib, bihimp]
+
+lemma codisjoint.bihimp_eq_inf {a b : α} (h : codisjoint a b) : a ⇔ b = a ⊓ b :=
+by rw [(⇔), h.himp_eq_left, h.himp_eq_right]
+
+lemma himp_bihimp : a ⇨ (b ⇔ c) = ((a ⊓ c) ⇨ b) ⊓ ((a ⊓ b) ⇨ c) :=
+by rw [bihimp, himp_inf_distrib, himp_himp, himp_himp]
+
+@[simp] lemma sup_himp_bihimp : (a ⊔ b) ⇨ (a ⇔ b) = a ⇔ b :=
+by { rw himp_bihimp, simp [bihimp] }
+
+@[simp] lemma bihimp_himp_eq_inf : a ⇔ (a ⇨ b) = a ⊓ b := @symm_diff_sdiff_eq_sup αᵒᵈ _ _ _
+@[simp] lemma himp_bihimp_eq_inf : (b ⇨ a) ⇔ b = a ⊓ b := @sdiff_symm_diff_eq_sup αᵒᵈ _ _ _
+
+@[simp] lemma bihimp_inf_sup : a ⇔ b ⊓ (a ⊔ b) = a ⊓ b := @symm_diff_sup_inf αᵒᵈ _ _ _
+@[simp] lemma sup_inf_bihimp : (a ⊔ b) ⊓ a ⇔ b = a ⊓ b := @inf_sup_symm_diff αᵒᵈ _ _ _
+
+@[simp] lemma bihimp_bihimp_sup : a ⇔ b ⇔ (a ⊔ b) = a ⊓ b := @symm_diff_symm_diff_inf αᵒᵈ _ _ _
+@[simp] lemma sup_bihimp_bihimp : (a ⊔ b) ⇔ (a ⇔ b) = a ⊓ b := @inf_symm_diff_symm_diff αᵒᵈ _ _ _
+
+lemma bihimp_triangle : a ⇔ b ⊓ b ⇔ c ≤ a ⇔ c := @symm_diff_triangle αᵒᵈ _ _ _ _
+
+end generalized_heyting_algebra
+
+section coheyting_algebra
+variables [coheyting_algebra α] (a : α)
+
+@[simp] lemma symm_diff_top' : a ∆ ⊤ = ￢a := by simp [symm_diff]
+@[simp] lemma top_symm_diff' : ⊤ ∆ a = ￢a := by simp [symm_diff]
+
+@[simp] lemma hnot_symm_diff_self : (￢a) ∆ a = ⊤ :=
+begin
+  rw [eq_top_iff, symm_diff, hnot_sdiff, sup_sdiff_self],
+  exact codisjoint.top_le codisjoint_hnot_left
+end
+
+@[simp] lemma symm_diff_hnot_self : a ∆ ￢a = ⊤ := by rw [symm_diff_comm, hnot_symm_diff_self]
+
+lemma is_compl.symm_diff_eq_top {a b : α} (h : is_compl a b) : a ∆ b = ⊤ :=
+by rw [h.eq_hnot, hnot_symm_diff_self]
+
+end coheyting_algebra
+
+section heyting_algebra
+variables [heyting_algebra α] (a : α)
+
+@[simp] lemma bihimp_bot : a ⇔ ⊥ = aᶜ := by simp [bihimp]
+@[simp] lemma bot_bihimp : ⊥ ⇔ a = aᶜ := by simp [bihimp]
+
+@[simp] lemma compl_bihimp_self : aᶜ ⇔ a = ⊥ := @hnot_symm_diff_self αᵒᵈ _ _
+@[simp] lemma bihimp_hnot_self : a ⇔ aᶜ = ⊥ := @symm_diff_hnot_self αᵒᵈ _ _
+
+lemma is_compl.bihimp_eq_bot {a b : α} (h : is_compl a b) : a ⇔ b = ⊥ :=
+by rw [h.eq_compl, compl_bihimp_self]
+
+end heyting_algebra
+
+section generalized_boolean_algebra
+variables [generalized_boolean_algebra α] (a b c d : α)
 
 @[simp] lemma sup_sdiff_symm_diff : (a ⊔ b) \ (a ∆ b) = a ⊓ b :=
 sdiff_eq_symm inf_le_sup (by rw symm_diff_eq_sup_sdiff_inf)
@@ -78,8 +256,6 @@ begin
   exact disjoint_sdiff_self_left,
 end
 
-lemma symm_diff_le_sup : a ∆ b ≤ a ⊔ b := by { rw symm_diff_eq_sup_sdiff_inf, exact sdiff_le }
-
 lemma inf_symm_diff_distrib_left : a ⊓ (b ∆ c) = (a ⊓ b) ∆ (a ⊓ c) :=
 by rw [symm_diff_eq_sup_sdiff_inf, inf_sdiff_distrib_left, inf_sup_left, inf_inf_distrib_left,
   symm_diff_eq_sup_sdiff_inf]
@@ -93,44 +269,33 @@ by simp only [(∆), sdiff_sdiff_sup_sdiff']
 lemma sdiff_symm_diff' : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ (c \ (a ⊔ b)) :=
 by rw [sdiff_symm_diff, sdiff_sup, sup_comm]
 
-lemma symm_diff_sdiff : (a ∆ b) \ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) :=
-by rw [symm_diff_def, sup_sdiff, sdiff_sdiff_left, sdiff_sdiff_left]
-
 @[simp] lemma symm_diff_sdiff_left : (a ∆ b) \ a = b \ a :=
 by rw [symm_diff_def, sup_sdiff, sdiff_idem, sdiff_sdiff_self, bot_sup_eq]
 
 @[simp] lemma symm_diff_sdiff_right : (a ∆ b) \ b = a \ b :=
 by rw [symm_diff_comm, symm_diff_sdiff_left]
 
-@[simp] lemma sdiff_symm_diff_self : a \ (a ∆ b) = a ⊓ b := by simp [sdiff_symm_diff]
+@[simp] lemma sdiff_symm_diff_left : a \ (a ∆ b) = a ⊓ b := by simp [sdiff_symm_diff]
+@[simp] lemma sdiff_symm_diff_right : b \ (a ∆ b) = a ⊓ b :=
+by rw [symm_diff_comm, inf_comm, sdiff_symm_diff_left]
 
-lemma symm_diff_eq_iff_sdiff_eq {a b c : α} (ha : a ≤ c) :
-  a ∆ b = c ↔ c \ a = b :=
+lemma symm_diff_eq_sup : a ∆ b = a ⊔ b ↔ disjoint a b :=
 begin
-  split; intro h,
-  { have hba : disjoint (a ⊓ b) c := begin
-      rw [←h, disjoint.comm],
-      exact disjoint_symm_diff_inf _ _,
-    end,
-    have hca : _ := congr_arg (\ a) h,
-    rw [symm_diff_sdiff_left] at hca,
-    rw [←hca, sdiff_eq_self_iff_disjoint],
-    exact hba.of_disjoint_inf_of_le ha },
-  { have hd : disjoint a b := by { rw ←h, exact disjoint_sdiff_self_right },
-    rw [symm_diff_def, hd.sdiff_eq_left, hd.sdiff_eq_right, ←h, sup_sdiff_cancel_right ha] }
+  refine ⟨λ h, _, disjoint.symm_diff_eq_sup⟩,
+  rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq_self_iff_disjoint] at h,
+  exact h.of_disjoint_inf_of_le le_sup_left,
 end
 
-lemma disjoint.symm_diff_eq_sup {a b : α} (h : disjoint a b) : a ∆ b = a ⊔ b :=
-by rw [(∆), h.sdiff_eq_left, h.sdiff_eq_right]
-
-lemma symm_diff_eq_sup : a ∆ b = a ⊔ b ↔ disjoint a b :=
+@[simp] lemma le_symm_diff_iff_left : a ≤ a ∆ b ↔ disjoint a b :=
 begin
-  split; intro h,
-  { rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq_self_iff_disjoint] at h,
-    exact h.of_disjoint_inf_of_le le_sup_left, },
-  { exact h.symm_diff_eq_sup, },
+  refine ⟨λ h, _, λ h, h.symm_diff_eq_sup.symm ▸ le_sup_left⟩,
+  rw symm_diff_eq_sup_sdiff_inf at h,
+  exact disjoint_iff_inf_le.mpr (le_sdiff_iff.1 $ inf_le_of_left_le h).le,
 end
 
+@[simp] lemma le_symm_diff_iff_right : b ≤ a ∆ b ↔ disjoint a b :=
+by rw [symm_diff_comm, le_symm_diff_iff_left, disjoint.comm]
+
 lemma symm_diff_symm_diff_left :
   a ∆ b ∆ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
 calc a ∆ b ∆ c = ((a ∆ b) \ c) ⊔ (c \ (a ∆ b))   : symm_diff_def _ _
@@ -162,21 +327,26 @@ lemma symm_diff_right_comm : a ∆ b ∆ c = a ∆ c ∆ b := by simp_rw [symm_d
 lemma symm_diff_symm_diff_symm_diff_comm : (a ∆ b) ∆ (c ∆ d) = (a ∆ c) ∆ (b ∆ d) :=
 by simp_rw [symm_diff_assoc, symm_diff_left_comm]
 
-@[simp] lemma symm_diff_symm_diff_self : a ∆ (a ∆ b) = b := by simp [←symm_diff_assoc]
+@[simp] lemma symm_diff_symm_diff_cancel_left : a ∆ (a ∆ b) = b := by simp [←symm_diff_assoc]
+@[simp] lemma symm_diff_symm_diff_cancel_right : b ∆ a ∆ a = b := by simp [symm_diff_assoc]
 
 @[simp] lemma symm_diff_symm_diff_self' : a ∆ b ∆ a = b :=
-by rw [symm_diff_comm, ←symm_diff_assoc, symm_diff_self, bot_symm_diff]
+by rw [symm_diff_comm,symm_diff_symm_diff_cancel_left]
+
+lemma symm_diff_left_involutive (a : α) : involutive (∆ a) := symm_diff_symm_diff_cancel_right _
+lemma symm_diff_right_involutive (a : α) : involutive ((∆) a) := symm_diff_symm_diff_cancel_left _
+lemma symm_diff_left_injective (a : α) : injective (∆ a) := (symm_diff_left_involutive _).injective
+lemma symm_diff_right_injective (a : α) : injective ((∆) a) :=
+(symm_diff_right_involutive _).injective
+lemma symm_diff_left_surjective (a : α) : surjective (∆ a) :=
+(symm_diff_left_involutive _).surjective
+lemma symm_diff_right_surjective (a : α) : surjective ((∆) a) :=
+(symm_diff_right_involutive _).surjective
 
-@[simp] lemma symm_diff_right_inj : a ∆ b = a ∆ c ↔ b = c :=
-begin
-  split; intro h,
-  { have H1 := congr_arg ((∆) a) h,
-    rwa [symm_diff_symm_diff_self, symm_diff_symm_diff_self] at H1, },
-  { rw h, },
-end
+variables {a b c}
 
-@[simp] lemma symm_diff_left_inj : a ∆ b = c ∆ b ↔ a = c :=
-by rw [symm_diff_comm a b, symm_diff_comm c b, symm_diff_right_inj]
+@[simp] lemma symm_diff_left_inj : a ∆ b = c ∆ b ↔ a = c := (symm_diff_left_injective _).eq_iff
+@[simp] lemma symm_diff_right_inj : a ∆ b = a ∆ c ↔ b = c := (symm_diff_right_injective _).eq_iff
 
 @[simp] lemma symm_diff_eq_left : a ∆ b = a ↔ b = ⊥ :=
 calc a ∆ b = a ↔ a ∆ b = a ∆ ⊥ : by rw symm_diff_bot
@@ -184,18 +354,6 @@ calc a ∆ b = a ↔ a ∆ b = a ∆ ⊥ : by rw symm_diff_bot
 
 @[simp] lemma symm_diff_eq_right : a ∆ b = b ↔ a = ⊥ := by rw [symm_diff_comm, symm_diff_eq_left]
 
-@[simp] lemma symm_diff_eq_bot : a ∆ b = ⊥ ↔ a = b :=
-calc a ∆ b = ⊥ ↔ a ∆ b = a ∆ a : by rw symm_diff_self
-           ... ↔     a = b     : by rw [symm_diff_right_inj, eq_comm]
-
-@[simp] lemma symm_diff_symm_diff_inf : a ∆ b ∆ (a ⊓ b) = a ⊔ b :=
-by rw [symm_diff_eq_iff_sdiff_eq (symm_diff_le_sup _ _), sup_sdiff_symm_diff]
-
-@[simp] lemma inf_symm_diff_symm_diff : (a ⊓ b) ∆ (a ∆ b) = a ⊔ b :=
-by rw [symm_diff_comm, symm_diff_symm_diff_inf]
-
-variables {a b c}
-
 protected lemma disjoint.symm_diff_left (ha : disjoint a c) (hb : disjoint b c) :
   disjoint (a ∆ b) c :=
 by { rw symm_diff_eq_sup_sdiff_inf, exact (ha.sup_left hb).disjoint_sdiff_left }
@@ -204,34 +362,113 @@ protected lemma disjoint.symm_diff_right (ha : disjoint a b) (hb : disjoint a c)
   disjoint a (b ∆ c) :=
 (ha.symm.symm_diff_left hb.symm).symm
 
+lemma symm_diff_eq_iff_sdiff_eq (ha : a ≤ c) : a ∆ b = c ↔ c \ a = b :=
+begin
+  rw ←symm_diff_of_le ha,
+  exact ((symm_diff_right_involutive a).to_perm _).apply_eq_iff_eq_symm_apply.trans eq_comm,
+end
+
 end generalized_boolean_algebra
 
 section boolean_algebra
-variables {α : Type*} [boolean_algebra α] (a b c : α)
+variables [boolean_algebra α] (a b c d : α)
+
+/- `cogeneralized_boolean_algebra` isn't actually a typeclass, but the lemmas in here are dual to
+the `generalized_boolean_algebra` ones -/
+section cogeneralized_boolean_algebra
+
+@[simp] lemma inf_himp_bihimp : (a ⇔ b) ⇨ (a ⊓ b) = a ⊔ b := @sup_sdiff_symm_diff αᵒᵈ _ _ _
+
+lemma codisjoint_bihimp_sup : codisjoint (a ⇔ b) (a ⊔ b) := @disjoint_symm_diff_inf αᵒᵈ _ _ _
+
+@[simp] lemma himp_bihimp_left : a ⇨ (a ⇔ b) = a ⇨ b := @symm_diff_sdiff_left αᵒᵈ _ _ _
+@[simp] lemma himp_bihimp_right : b ⇨ (a ⇔ b) = b ⇨ a := @symm_diff_sdiff_right αᵒᵈ _ _ _
+
+@[simp] lemma bihimp_himp_left : (a ⇔ b) ⇨ a = a ⊔ b := @sdiff_symm_diff_left αᵒᵈ _ _ _
+@[simp] lemma bihimp_himp_right : (a ⇔ b) ⇨ b = a ⊔ b := @sdiff_symm_diff_right αᵒᵈ _ _ _
+
+@[simp] lemma bihimp_eq_inf : a ⇔ b = a ⊓ b ↔ codisjoint a b := @symm_diff_eq_sup αᵒᵈ _ _ _
+
+@[simp] lemma bihimp_le_iff_left : a ⇔ b ≤ a ↔ codisjoint a b := @le_symm_diff_iff_left αᵒᵈ _ _ _
+@[simp] lemma bihimp_le_iff_right : a ⇔ b ≤ b ↔ codisjoint a b := @le_symm_diff_iff_right αᵒᵈ _ _ _
+
+lemma bihimp_assoc : a ⇔ b ⇔ c = a ⇔ (b ⇔ c) := @symm_diff_assoc αᵒᵈ _ _ _ _
+
+instance bihimp_is_assoc : is_associative α (⇔) := ⟨bihimp_assoc⟩
+
+lemma bihimp_left_comm : a ⇔ (b ⇔ c) = b ⇔ (a ⇔ c) := by simp_rw [←bihimp_assoc, bihimp_comm]
+lemma bihimp_right_comm : a ⇔ b ⇔ c = a ⇔ c ⇔ b := by simp_rw [bihimp_assoc, bihimp_comm]
+
+lemma bihimp_bihimp_bihimp_comm : (a ⇔ b) ⇔ (c ⇔ d) = (a ⇔ c) ⇔ (b ⇔ d) :=
+by simp_rw [bihimp_assoc, bihimp_left_comm]
+
+@[simp] lemma bihimp_bihimp_cancel_left : a ⇔ (a ⇔ b) = b := by simp [←bihimp_assoc]
+@[simp] lemma bihimp_bihimp_cancel_right : b ⇔ a ⇔ a = b := by simp [bihimp_assoc]
+
+@[simp] lemma bihimp_bihimp_self : a ⇔ b ⇔ a = b := by rw [bihimp_comm, bihimp_bihimp_cancel_left]
+
+lemma bihimp_left_involutive (a : α) : involutive (⇔ a) := bihimp_bihimp_cancel_right _
+lemma bihimp_right_involutive (a : α) : involutive ((⇔) a) := bihimp_bihimp_cancel_left _
+lemma bihimp_left_injective (a : α) : injective (⇔ a) := @symm_diff_left_injective αᵒᵈ  _ _
+lemma bihimp_right_injective (a : α) : injective ((⇔) a) := @symm_diff_right_injective αᵒᵈ  _ _
+lemma bihimp_left_surjective (a : α) : surjective (⇔ a) := @symm_diff_left_surjective αᵒᵈ  _ _
+lemma bihimp_right_surjective (a : α) : surjective ((⇔) a) := @symm_diff_right_surjective αᵒᵈ  _ _
+
+variables {a b c}
+
+@[simp] lemma bihimp_left_inj : a ⇔ b = c ⇔ b ↔ a = c := (bihimp_left_injective _).eq_iff
+@[simp] lemma bihimp_right_inj : a ⇔ b = a ⇔ c ↔ b = c := (bihimp_right_injective _).eq_iff
+
+@[simp] lemma bihimp_eq_left : a ⇔ b = a ↔ b = ⊤ := @symm_diff_eq_left αᵒᵈ _ _ _
+@[simp] lemma bihimp_eq_right : a ⇔ b = b ↔ a = ⊤ := @symm_diff_eq_right αᵒᵈ _ _ _
+
+protected lemma codisjoint.bihimp_left (ha : codisjoint a c) (hb : codisjoint b c) :
+  codisjoint (a ⇔ b) c :=
+(ha.inf_left hb).mono_left inf_le_bihimp
+
+protected lemma codisjoint.bihimp_right (ha : codisjoint a b) (hb : codisjoint a c) :
+  codisjoint a (b ⇔ c) :=
+(ha.inf_right hb).mono_right inf_le_bihimp
+
+end cogeneralized_boolean_algebra
 
 lemma symm_diff_eq : a ∆ b = (a ⊓ bᶜ) ⊔ (b ⊓ aᶜ) := by simp only [(∆), sdiff_eq]
+lemma bihimp_eq : a ⇔ b = (a ⊔ bᶜ) ⊓ (b ⊔ aᶜ) := by simp only [(⇔), himp_eq]
+
+lemma symm_diff_eq' : a ∆ b = (a ⊔ b) ⊓ (aᶜ ⊔ bᶜ) :=
+by rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq, compl_inf]
+
+lemma bihimp_eq' : a ⇔ b = (a ⊓ b) ⊔ (aᶜ ⊓ bᶜ) := @symm_diff_eq' αᵒᵈ _ _ _
+
+lemma symm_diff_top : a ∆ ⊤ = aᶜ := symm_diff_top' _
+lemma top_symm_diff : ⊤ ∆ a = aᶜ := top_symm_diff' _
 
-@[simp] lemma symm_diff_top : a ∆ ⊤ = aᶜ := by simp [symm_diff_eq]
-@[simp] lemma top_symm_diff : ⊤ ∆ a = aᶜ := by rw [symm_diff_comm, symm_diff_top]
+@[simp] lemma compl_symm_diff : (a ∆ b)ᶜ = a ⇔ b :=
+by simp_rw [symm_diff, compl_sup_distrib, compl_sdiff, bihimp, inf_comm]
 
-lemma compl_symm_diff : (a ∆ b)ᶜ = (a ⊓ b) ⊔ (aᶜ ⊓ bᶜ) :=
-by simp only [←top_sdiff, sdiff_symm_diff, top_inf_eq]
+@[simp] lemma compl_bihimp : (a ⇔ b)ᶜ = a ∆ b := @compl_symm_diff αᵒᵈ _ _ _
 
-lemma symm_diff_eq_top_iff : a ∆ b = ⊤ ↔ is_compl a b :=
-by rw [symm_diff_eq_iff_sdiff_eq le_top, top_sdiff, compl_eq_iff_is_compl]
+@[simp] lemma compl_symm_diff_compl : aᶜ ∆ bᶜ = a ∆ b :=
+sup_comm.trans $ by simp_rw [compl_sdiff_compl, sdiff_eq, symm_diff_eq]
 
-lemma is_compl.symm_diff_eq_top (h : is_compl a b) : a ∆ b = ⊤ := (symm_diff_eq_top_iff a b).2 h
+@[simp] lemma compl_bihimp_compl : aᶜ ⇔ bᶜ = a ⇔ b := @compl_symm_diff_compl αᵒᵈ _ _ _
 
-@[simp] lemma compl_symm_diff_self : aᶜ ∆ a = ⊤ :=
-by simp only [symm_diff_eq, compl_compl, inf_idem, compl_sup_eq_top]
+@[simp] lemma symm_diff_eq_top : a ∆ b = ⊤ ↔ is_compl a b :=
+by rw [symm_diff_eq', ←compl_inf, inf_eq_top_iff, compl_eq_top, is_compl_iff, disjoint_iff,
+ codisjoint_iff, and.comm]
 
-@[simp] lemma symm_diff_compl_self : a ∆ aᶜ = ⊤ := by rw [symm_diff_comm, compl_symm_diff_self]
+@[simp] lemma bihimp_eq_bot : a ⇔ b = ⊥ ↔ is_compl a b :=
+by rw [bihimp_eq', ←compl_sup, sup_eq_bot_iff, compl_eq_bot, is_compl_iff, disjoint_iff,
+ codisjoint_iff]
+
+@[simp] lemma compl_symm_diff_self : aᶜ ∆ a = ⊤ := hnot_symm_diff_self _
+@[simp] lemma symm_diff_compl_self : a ∆ aᶜ = ⊤ := symm_diff_hnot_self _
 
 lemma symm_diff_symm_diff_right' :
   a ∆ (b ∆ c) = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔ (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) :=
 calc a ∆ (b ∆ c) = (a ⊓ ((b ⊓ c) ⊔ (bᶜ ⊓ cᶜ))) ⊔
                      (((b ⊓ cᶜ) ⊔ (c ⊓ bᶜ)) ⊓ aᶜ)  : by rw [symm_diff_eq, compl_symm_diff,
-                                                            symm_diff_eq]
+                                                           bihimp_eq', symm_diff_eq]
              ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                      (b ⊓ cᶜ ⊓ aᶜ) ⊔ (c ⊓ bᶜ ⊓ aᶜ) : by rw [inf_sup_left, inf_sup_right,
                                                             ←sup_assoc, ←inf_assoc, ←inf_assoc]
@@ -243,4 +480,61 @@ calc a ∆ (b ∆ c) = (a ⊓ ((b ⊓ c) ⊔ (bᶜ ⊓ cᶜ))) ⊔
                                                        { apply inf_left_right_swap }
                                                      end
 
+variables {a b c}
+
+lemma disjoint.le_symm_diff_sup_symm_diff_left (h : disjoint a b) : c ≤ a ∆ c ⊔ b ∆ c :=
+begin
+  transitivity c \ (a ⊓ b),
+  { rw [h.eq_bot, sdiff_bot] },
+  { rw sdiff_inf,
+    exact sup_le_sup le_sup_right le_sup_right }
+end
+
+lemma disjoint.le_symm_diff_sup_symm_diff_right (h : disjoint b c) : a ≤ a ∆ b ⊔ a ∆ c :=
+by { simp_rw symm_diff_comm a, exact h.le_symm_diff_sup_symm_diff_left }
+
+lemma codisjoint.bihimp_inf_bihimp_le_left (h : codisjoint a b) : a ⇔ c ⊓ b ⇔ c ≤ c :=
+h.dual.le_symm_diff_sup_symm_diff_left
+
+lemma codisjoint.bihimp_inf_bihimp_le_right (h : codisjoint b c) : a ⇔ b ⊓ a ⇔ c ≤ a :=
+h.dual.le_symm_diff_sup_symm_diff_right
+
 end boolean_algebra
+
+/-! ### Prod -/
+
+section prod
+
+@[simp] lemma symm_diff_fst [generalized_coheyting_algebra α] [generalized_coheyting_algebra β]
+  (a b : α × β) :
+  (a ∆ b).1 = a.1 ∆ b.1 := rfl
+@[simp] lemma symm_diff_snd [generalized_coheyting_algebra α] [generalized_coheyting_algebra β]
+  (a b : α × β) :
+  (a ∆ b).2 = a.2 ∆ b.2 := rfl
+
+@[simp] lemma bihimp_fst [generalized_heyting_algebra α] [generalized_heyting_algebra β]
+  (a b : α × β) :
+  (a ⇔ b).1 = a.1 ⇔ b.1 := rfl
+@[simp] lemma bihimp_snd [generalized_heyting_algebra α] [generalized_heyting_algebra β]
+  (a b : α × β) :
+  (a ⇔ b).2 = a.2 ⇔ b.2 := rfl
+
+end prod
+
+/-! ### Pi -/
+
+namespace pi
+
+lemma symm_diff_def [Π i, generalized_coheyting_algebra (π i)] (a b : Π i, π i) :
+  a ∆ b = λ i, a i ∆ b i := rfl
+
+lemma bihimp_def [Π i, generalized_heyting_algebra (π i)] (a b : Π i, π i) :
+  a ⇔ b = λ i, a i ⇔ b i := rfl
+
+@[simp] lemma symm_diff_apply [Π i, generalized_coheyting_algebra (π i)] (a b : Π i, π i) (i : ι) :
+  (a ∆ b) i = a i ∆ b i := rfl
+
+@[simp] lemma bihimp_apply [Π i, generalized_heyting_algebra (π i)] (a b : Π i, π i) (i : ι) :
+  (a ⇔ b) i = a i ⇔ b i := rfl
+
+end pi
diff --git a/src/order/synonym.lean b/src/order/synonym.lean
new file mode 100644
index 0000000000000..f04b5957db6d0
--- /dev/null
+++ b/src/order/synonym.lean
@@ -0,0 +1,106 @@
+/-
+Copyright (c) 2020 Johan Commelin, Damiano Testa. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin, Damiano Testa, Yaël Dillies
+-/
+import logic.equiv.defs
+import logic.nontrivial
+import order.basic
+
+/-!
+# Type synonyms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides two type synonyms for order theory:
+* `order_dual α`: Type synonym of `α` to equip it with the dual order (`a ≤ b` becomes `b ≤ a`).
+* `lex α`: Type synonym of `α` to equip it with its lexicographic order. The precise meaning depends
+  on the type we take the lex of. Examples include `prod`, `sigma`, `list`, `finset`.
+
+## Notation
+
+`αᵒᵈ` is notation for `order_dual α`.
+
+The general rule for notation of `lex` types is to append `ₗ` to the usual notation.
+
+## Implementation notes
+
+One should not abuse definitional equality between `α` and `αᵒᵈ`/`lex α`. Instead, explicit
+coercions should be inserted:
+* `order_dual`: `order_dual.to_dual : α → αᵒᵈ` and `order_dual.of_dual : αᵒᵈ → α`
+* `lex`: `to_lex : α → lex α` and `of_lex : lex α → α`.
+
+In fact, those are bundled as `equiv`s to put goals in the right syntactic form for rewriting with
+the `equiv` API (`⇑to_lex a` where `⇑` is `coe_fn : (α ≃ lex α) → α → lex α`, instead of a bare
+`to_lex a`).
+
+## See also
+
+This file is similar to `algebra.group.type_tags`.
+-/
+
+variables {α β γ : Type*}
+
+/-! ### Order dual -/
+
+namespace order_dual
+
+instance [h : nontrivial α] : nontrivial (αᵒᵈ) := h
+
+/-- `to_dual` is the identity function to the `order_dual` of a linear order.  -/
+def to_dual : α ≃ αᵒᵈ := equiv.refl _
+
+/-- `of_dual` is the identity function from the `order_dual` of a linear order.  -/
+def of_dual : αᵒᵈ ≃ α := equiv.refl _
+
+@[simp] lemma to_dual_symm_eq : (@to_dual α).symm = of_dual := rfl
+@[simp] lemma of_dual_symm_eq : (@of_dual α).symm = to_dual := rfl
+@[simp] lemma to_dual_of_dual (a : αᵒᵈ) : to_dual (of_dual a) = a := rfl
+@[simp] lemma of_dual_to_dual (a : α) : of_dual (to_dual a) = a := rfl
+@[simp] lemma to_dual_inj {a b : α} : to_dual a = to_dual b ↔ a = b := iff.rfl
+@[simp] lemma of_dual_inj {a b : αᵒᵈ} : of_dual a = of_dual b ↔ a = b := iff.rfl
+
+@[simp] lemma to_dual_le_to_dual [has_le α] {a b : α} : to_dual a ≤ to_dual b ↔ b ≤ a := iff.rfl
+@[simp] lemma to_dual_lt_to_dual [has_lt α] {a b : α} : to_dual a < to_dual b ↔ b < a := iff.rfl
+@[simp] lemma of_dual_le_of_dual [has_le α] {a b : αᵒᵈ} : of_dual a ≤ of_dual b ↔ b ≤ a := iff.rfl
+@[simp] lemma of_dual_lt_of_dual [has_lt α] {a b : αᵒᵈ} : of_dual a < of_dual b ↔ b < a := iff.rfl
+lemma le_to_dual [has_le α] {a : αᵒᵈ} {b : α} : a ≤ to_dual b ↔ b ≤ of_dual a := iff.rfl
+lemma lt_to_dual [has_lt α] {a : αᵒᵈ} {b : α} : a < to_dual b ↔ b < of_dual a := iff.rfl
+lemma to_dual_le [has_le α] {a : α} {b : αᵒᵈ} : to_dual a ≤ b ↔ of_dual b ≤ a := iff.rfl
+lemma to_dual_lt [has_lt α] {a : α} {b : αᵒᵈ} : to_dual a < b ↔ of_dual b < a := iff.rfl
+
+/-- Recursor for `αᵒᵈ`. -/
+@[elab_as_eliminator]
+protected def rec {C : αᵒᵈ → Sort*} (h₂ : Π a : α, C (to_dual a)) : Π a : αᵒᵈ, C a := h₂
+
+@[simp] protected lemma «forall» {p : αᵒᵈ → Prop} : (∀ a, p a) ↔ ∀ a, p (to_dual a) := iff.rfl
+@[simp] protected lemma «exists» {p : αᵒᵈ → Prop} : (∃ a, p a) ↔ ∃ a, p (to_dual a) := iff.rfl
+
+alias to_dual_le_to_dual ↔ _ _root_.has_le.le.dual
+alias to_dual_lt_to_dual ↔ _ _root_.has_lt.lt.dual
+alias of_dual_le_of_dual ↔ _ _root_.has_le.le.of_dual
+alias of_dual_lt_of_dual ↔ _ _root_.has_lt.lt.of_dual
+
+end order_dual
+
+/-! ### Lexicographic order -/
+
+/-- A type synonym to equip a type with its lexicographic order. -/
+def lex (α : Type*) := α
+
+/-- `to_lex` is the identity function to the `lex` of a type.  -/
+@[pattern] def to_lex : α ≃ lex α := equiv.refl _
+
+/-- `of_lex` is the identity function from the `lex` of a type.  -/
+@[pattern] def of_lex : lex α ≃ α := equiv.refl _
+
+@[simp] lemma to_lex_symm_eq : (@to_lex α).symm = of_lex := rfl
+@[simp] lemma of_lex_symm_eq : (@of_lex α).symm = to_lex := rfl
+@[simp] lemma to_lex_of_lex (a : lex α) : to_lex (of_lex a) = a := rfl
+@[simp] lemma of_lex_to_lex (a : α) : of_lex (to_lex a) = a := rfl
+@[simp] lemma to_lex_inj {a b : α} : to_lex a = to_lex b ↔ a = b := iff.rfl
+@[simp] lemma of_lex_inj {a b : lex α} :  of_lex a = of_lex b ↔ a = b := iff.rfl
+
+/-- A recursor for `lex`. Use as `induction x using lex.rec`. -/
+protected def lex.rec {β : lex α → Sort*} (h : Π a, β (to_lex a)) : Π a, β a := λ a, h (of_lex a)
diff --git a/src/order/upper_lower.lean b/src/order/upper_lower.lean
deleted file mode 100644
index 9ece02f8ee12f..0000000000000
--- a/src/order/upper_lower.lean
+++ /dev/null
@@ -1,469 +0,0 @@
-/-
-Copyright (c) 2022 Yaël Dillies, Sara Rousta. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Yaël Dillies, Sara Rousta
--/
-import data.set_like.basic
-import order.hom.complete_lattice
-
-/-!
-# Up-sets and down-sets
-
-This file defines upper and lower sets in an order.
-
-## Main declarations
-
-* `is_upper_set`: Predicate for a set to be an upper set. This means every element greater than a
-  member of the set is in the set itself.
-* `is_lower_set`: Predicate for a set to be a lower set. This means every element less than a member
-  of the set is in the set itself.
-* `upper_set`: The type of upper sets.
-* `lower_set`: The type of lower sets.
-* `upper_set.Ici`: Principal upper set. `set.Ici` as an upper set.
-* `upper_set.Ioi`: Strict principal upper set. `set.Ioi` as an upper set.
-* `lower_set.Iic`: Principal lower set. `set.Iic` as an lower set.
-* `lower_set.Iio`: Strict principal lower set. `set.Iio` as an lower set.
-
-## TODO
-
-Lattice structure on antichains. Order equivalence between upper/lower sets and antichains.
--/
-
-open order_dual set
-
-variables {α : Type*} {ι : Sort*} {κ : ι → Sort*}
-
-/-! ### Unbundled upper/lower sets -/
-
-section has_le
-variables [has_le α] {s t : set α}
-
-/-- An upper set in an order `α` is a set such that any element greater than one of its members is
-also a member. Also called up-set, upward-closed set. -/
-def is_upper_set (s : set α) : Prop := ∀ ⦃a b : α⦄, a ≤ b → a ∈ s → b ∈ s
-
-/-- A lower set in an order `α` is a set such that any element less than one of its members is also
-a member. Also called down-set, downward-closed set. -/
-def is_lower_set (s : set α) : Prop := ∀ ⦃a b : α⦄, b ≤ a → a ∈ s → b ∈ s
-
-lemma is_upper_set_empty : is_upper_set (∅ : set α) := λ _ _ _, id
-lemma is_lower_set_empty : is_lower_set (∅ : set α) := λ _ _ _, id
-lemma is_upper_set_univ : is_upper_set (univ : set α) := λ _ _ _, id
-lemma is_lower_set_univ : is_lower_set (univ : set α) := λ _ _ _, id
-lemma is_upper_set.compl (hs : is_upper_set s) : is_lower_set sᶜ := λ a b h hb ha, hb $ hs h ha
-lemma is_lower_set.compl (hs : is_lower_set s) : is_upper_set sᶜ := λ a b h hb ha, hb $ hs h ha
-
-lemma is_upper_set.union (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∪ t) :=
-λ a b h, or.imp (hs h) (ht h)
-
-lemma is_lower_set.union (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∪ t) :=
-λ a b h, or.imp (hs h) (ht h)
-
-lemma is_upper_set.inter (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∩ t) :=
-λ a b h, and.imp (hs h) (ht h)
-
-lemma is_lower_set.inter (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∩ t) :=
-λ a b h, and.imp (hs h) (ht h)
-
-lemma is_upper_set_Union {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋃ i, f i) :=
-λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h
-
-lemma is_lower_set_Union {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋃ i, f i) :=
-λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h
-
-lemma is_upper_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
-  is_upper_set (⋃ i j, f i j) :=
-is_upper_set_Union $ λ i, is_upper_set_Union $ hf i
-
-lemma is_lower_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
-  is_lower_set (⋃ i j, f i j) :=
-is_lower_set_Union $ λ i, is_lower_set_Union $ hf i
-
-lemma is_upper_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋃₀ S) :=
-λ a b h, Exists₂.imp $ λ s hs, hf s hs h
-
-lemma is_lower_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋃₀ S) :=
-λ a b h, Exists₂.imp $ λ s hs, hf s hs h
-
-lemma is_upper_set_Inter {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋂ i, f i) :=
-λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h
-
-lemma is_lower_set_Inter {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋂ i, f i) :=
-λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h
-
-lemma is_upper_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
-  is_upper_set (⋂ i j, f i j) :=
-is_upper_set_Inter $ λ i, is_upper_set_Inter $ hf i
-
-lemma is_lower_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
-  is_lower_set (⋂ i j, f i j) :=
-is_lower_set_Inter $ λ i, is_lower_set_Inter $ hf i
-
-lemma is_upper_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋂₀ S) :=
-λ a b h, forall₂_imp $ λ s hs, hf s hs h
-
-lemma is_lower_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋂₀ S) :=
-λ a b h, forall₂_imp $ λ s hs, hf s hs h
-
-@[simp] lemma is_lower_set_preimage_of_dual_iff : is_lower_set (of_dual ⁻¹' s) ↔ is_upper_set s :=
-iff.rfl
-@[simp] lemma is_upper_set_preimage_of_dual_iff : is_upper_set (of_dual ⁻¹' s) ↔ is_lower_set s :=
-iff.rfl
-@[simp] lemma is_lower_set_preimage_to_dual_iff {s : set αᵒᵈ} :
-  is_lower_set (to_dual ⁻¹' s) ↔ is_upper_set s := iff.rfl
-@[simp] lemma is_upper_set_preimage_to_dual_iff {s : set αᵒᵈ} :
-  is_upper_set (to_dual ⁻¹' s) ↔ is_lower_set s := iff.rfl
-
-alias is_lower_set_preimage_of_dual_iff ↔ _ is_upper_set.of_dual
-alias is_upper_set_preimage_of_dual_iff ↔ _ is_lower_set.of_dual
-alias is_lower_set_preimage_to_dual_iff ↔ _ is_upper_set.to_dual
-alias is_upper_set_preimage_to_dual_iff ↔ _ is_lower_set.to_dual
-
-end has_le
-
-section preorder
-variables [preorder α] (a : α)
-
-lemma is_upper_set_Ici : is_upper_set (Ici a) := λ _ _, ge_trans
-lemma is_lower_set_Iic : is_lower_set (Iic a) := λ _ _, le_trans
-lemma is_upper_set_Ioi : is_upper_set (Ioi a) := λ _ _, flip lt_of_lt_of_le
-lemma is_lower_set_Iio : is_lower_set (Iio a) := λ _ _, lt_of_le_of_lt
-
-end preorder
-
-/-! ### Bundled upper/lower sets -/
-
-section has_le
-variables [has_le α]
-
-/-- The type of upper sets of an order. -/
-structure upper_set (α : Type*) [has_le α] :=
-(carrier : set α)
-(upper' : is_upper_set carrier)
-
-/-- The type of lower sets of an order. -/
-structure lower_set (α : Type*) [has_le α] :=
-(carrier : set α)
-(lower' : is_lower_set carrier)
-
-namespace upper_set
-
-instance : set_like (upper_set α) α :=
-{ coe := upper_set.carrier,
-  coe_injective' := λ s t h, by { cases s, cases t, congr' } }
-
-@[ext] lemma ext {s t : upper_set α} : (s : set α) = t → s = t := set_like.ext'
-
-@[simp] lemma carrier_eq_coe (s : upper_set α) : s.carrier = s := rfl
-
-protected lemma upper (s : upper_set α) : is_upper_set (s : set α) := s.upper'
-
-end upper_set
-
-namespace lower_set
-
-instance : set_like (lower_set α) α :=
-{ coe := lower_set.carrier,
-  coe_injective' := λ s t h, by { cases s, cases t, congr' } }
-
-@[ext] lemma ext {s t : lower_set α} : (s : set α) = t → s = t := set_like.ext'
-
-@[simp] lemma carrier_eq_coe (s : lower_set α) : s.carrier = s := rfl
-
-protected lemma lower (s : lower_set α) : is_lower_set (s : set α) := s.lower'
-
-end lower_set
-
-/-! #### Order -/
-
-namespace upper_set
-variables {S : set (upper_set α)} {s t : upper_set α} {a : α}
-
-instance : has_sup (upper_set α) := ⟨λ s t, ⟨s ∪ t, s.upper.union t.upper⟩⟩
-instance : has_inf (upper_set α) := ⟨λ s t, ⟨s ∩ t, s.upper.inter t.upper⟩⟩
-instance : has_top (upper_set α) := ⟨⟨univ, is_upper_set_univ⟩⟩
-instance : has_bot (upper_set α) := ⟨⟨∅, is_upper_set_empty⟩⟩
-instance : has_Sup (upper_set α) :=
-⟨λ S, ⟨⋃ s ∈ S, ↑s, is_upper_set_Union₂ $ λ s _, s.upper⟩⟩
-instance : has_Inf (upper_set α) :=
-⟨λ S, ⟨⋂ s ∈ S, ↑s, is_upper_set_Inter₂ $ λ s _, s.upper⟩⟩
-
-instance : complete_distrib_lattice (upper_set α) :=
-set_like.coe_injective.complete_distrib_lattice _
-  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl
-
-instance : inhabited (upper_set α) := ⟨⊥⟩
-
-@[simp] lemma coe_top : ((⊤ : upper_set α) : set α) = univ := rfl
-@[simp] lemma coe_bot : ((⊥ : upper_set α) : set α) = ∅ := rfl
-@[simp] lemma coe_sup (s t : upper_set α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
-@[simp] lemma coe_inf (s t : upper_set α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
-@[simp] lemma coe_Sup (S : set (upper_set α)) : (↑(Sup S) : set α) = ⋃ s ∈ S, ↑s := rfl
-@[simp] lemma coe_Inf (S : set (upper_set α)) : (↑(Inf S) : set α) = ⋂ s ∈ S, ↑s := rfl
-@[simp] lemma coe_supr (f : ι → upper_set α) : (↑(⨆ i, f i) : set α) = ⋃ i, f i := by simp [supr]
-@[simp] lemma coe_infi (f : ι → upper_set α) : (↑(⨅ i, f i) : set α) = ⋂ i, f i := by simp [infi]
-@[simp] lemma coe_supr₂ (f : Π i, κ i → upper_set α) : (↑(⨆ i j, f i j) : set α) = ⋃ i j, f i j :=
-by simp_rw coe_supr
-@[simp] lemma coe_infi₂ (f : Π i, κ i → upper_set α) : (↑(⨅ i j, f i j) : set α) = ⋂ i j, f i j :=
-by simp_rw coe_infi
-
-@[simp] lemma mem_top : a ∈ (⊤ : upper_set α) := trivial
-@[simp] lemma not_mem_bot : a ∉ (⊥ : upper_set α) := id
-@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
-@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
-@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
-@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
-@[simp] lemma mem_supr_iff {f : ι → upper_set α} : a ∈ (⨆ i, f i) ↔ ∃ i, a ∈ f i :=
-by { rw [←set_like.mem_coe, coe_supr], exact mem_Union }
-@[simp] lemma mem_infi_iff {f : ι → upper_set α} : a ∈ (⨅ i, f i) ↔ ∀ i, a ∈ f i :=
-by { rw [←set_like.mem_coe, coe_infi], exact mem_Inter }
-@[simp] lemma mem_supr₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨆ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
-by simp_rw mem_supr_iff
-@[simp] lemma mem_infi₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨅ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
-by simp_rw mem_infi_iff
-
-end upper_set
-
-namespace lower_set
-variables {S : set (lower_set α)} {s t : lower_set α} {a : α}
-
-instance : has_sup (lower_set α) := ⟨λ s t, ⟨s ∪ t, λ a b h, or.imp (s.lower h) (t.lower h)⟩⟩
-instance : has_inf (lower_set α) := ⟨λ s t, ⟨s ∩ t, λ a b h, and.imp (s.lower h) (t.lower h)⟩⟩
-instance : has_top (lower_set α) := ⟨⟨univ, λ a b h, id⟩⟩
-instance : has_bot (lower_set α) := ⟨⟨∅, λ a b h, id⟩⟩
-instance : has_Sup (lower_set α) := ⟨λ S, ⟨⋃ s ∈ S, ↑s, is_lower_set_Union₂ $ λ s _, s.lower⟩⟩
-instance : has_Inf (lower_set α) := ⟨λ S, ⟨⋂ s ∈ S, ↑s, is_lower_set_Inter₂ $ λ s _, s.lower⟩⟩
-
-instance : complete_distrib_lattice (lower_set α) :=
-set_like.coe_injective.complete_distrib_lattice _
-  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl
-
-instance : inhabited (lower_set α) := ⟨⊥⟩
-
-@[simp] lemma coe_top : ((⊤ : lower_set α) : set α) = univ := rfl
-@[simp] lemma coe_bot : ((⊥ : lower_set α) : set α) = ∅ := rfl
-@[simp] lemma coe_sup (s t : lower_set α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
-@[simp] lemma coe_inf (s t : lower_set α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
-@[simp] lemma coe_Sup (S : set (lower_set α)) : (↑(Sup S) : set α) = ⋃ s ∈ S, ↑s := rfl
-@[simp] lemma coe_Inf (S : set (lower_set α)) : (↑(Inf S) : set α) = ⋂ s ∈ S, ↑s := rfl
-@[simp] lemma coe_supr (f : ι → lower_set α) : (↑(⨆ i, f i) : set α) = ⋃ i, f i :=
-by simp_rw [supr, coe_Sup, mem_range, Union_exists, Union_Union_eq']
-@[simp] lemma coe_infi (f : ι → lower_set α) : (↑(⨅ i, f i) : set α) = ⋂ i, f i :=
-by simp_rw [infi, coe_Inf, mem_range, Inter_exists, Inter_Inter_eq']
-@[simp] lemma coe_supr₂ (f : Π i, κ i → lower_set α) : (↑(⨆ i j, f i j) : set α) = ⋃ i j, f i j :=
-by simp_rw coe_supr
-@[simp] lemma coe_infi₂ (f : Π i, κ i → lower_set α) : (↑(⨅ i j, f i j) : set α) = ⋂ i j, f i j :=
-by simp_rw coe_infi
-
-@[simp] lemma mem_top : a ∈ (⊤ : lower_set α) := trivial
-@[simp] lemma not_mem_bot : a ∉ (⊥ : lower_set α) := id
-@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
-@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
-@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
-@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
-@[simp] lemma mem_supr_iff {f : ι → lower_set α} : a ∈ (⨆ i, f i) ↔ ∃ i, a ∈ f i :=
-by { rw [←set_like.mem_coe, coe_supr], exact mem_Union }
-@[simp] lemma mem_infi_iff {f : ι → lower_set α} : a ∈ (⨅ i, f i) ↔ ∀ i, a ∈ f i :=
-by { rw [←set_like.mem_coe, coe_infi], exact mem_Inter }
-@[simp] lemma mem_supr₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨆ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
-by simp_rw mem_supr_iff
-@[simp] lemma mem_infi₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨅ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
-by simp_rw mem_infi_iff
-
-end lower_set
-
-/-! #### Complement -/
-
-/-- The complement of a lower set as an upper set. -/
-def upper_set.compl (s : upper_set α) : lower_set α := ⟨sᶜ, s.upper.compl⟩
-
-/-- The complement of a lower set as an upper set. -/
-def lower_set.compl (s : lower_set α) : upper_set α := ⟨sᶜ, s.lower.compl⟩
-
-namespace upper_set
-variables {s : upper_set α} {a : α}
-
-@[simp] lemma coe_compl (s : upper_set α) : (s.compl : set α) = sᶜ := rfl
-@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
-@[simp] lemma compl_compl (s : upper_set α) : s.compl.compl = s := upper_set.ext $ compl_compl _
-
-@[simp] protected lemma compl_sup (s t : upper_set α) : (s ⊔ t).compl = s.compl ⊓ t.compl :=
-lower_set.ext compl_sup
-@[simp] protected lemma compl_inf (s t : upper_set α) : (s ⊓ t).compl = s.compl ⊔ t.compl :=
-lower_set.ext compl_inf
-@[simp] protected lemma compl_top : (⊤ : upper_set α).compl = ⊥ := lower_set.ext compl_univ
-@[simp] protected lemma compl_bot : (⊥ : upper_set α).compl = ⊤ := lower_set.ext compl_empty
-@[simp] protected lemma compl_Sup (S : set (upper_set α)) :
-  (Sup S).compl = ⨅ s ∈ S, upper_set.compl s :=
-lower_set.ext $ by simp only [coe_compl, coe_Sup, compl_Union₂, lower_set.coe_infi₂]
-
-@[simp] protected lemma compl_Inf (S : set (upper_set α)) :
-  (Inf S).compl = ⨆ s ∈ S, upper_set.compl s :=
-lower_set.ext $ by simp only [coe_compl, coe_Inf, compl_Inter₂, lower_set.coe_supr₂]
-
-@[simp] protected lemma compl_supr (f : ι → upper_set α) : (⨆ i, f i).compl = ⨅ i, (f i).compl :=
-lower_set.ext $ by simp only [coe_compl, coe_supr, compl_Union, lower_set.coe_infi]
-
-@[simp] protected lemma compl_infi (f : ι → upper_set α) : (⨅ i, f i).compl = ⨆ i, (f i).compl :=
-lower_set.ext $ by simp only [coe_compl, coe_infi, compl_Inter, lower_set.coe_supr]
-
-@[simp] lemma compl_supr₂ (f : Π i, κ i → upper_set α) :
-  (⨆ i j, f i j).compl = ⨅ i j, (f i j).compl :=
-by simp_rw upper_set.compl_supr
-
-@[simp] lemma compl_infi₂ (f : Π i, κ i → upper_set α) :
-  (⨅ i j, f i j).compl =  ⨆ i j, (f i j).compl :=
-by simp_rw upper_set.compl_infi
-
-end upper_set
-
-namespace lower_set
-variables {s : lower_set α} {a : α}
-
-@[simp] lemma coe_compl (s : lower_set α) : (s.compl : set α) = sᶜ := rfl
-@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
-@[simp] lemma compl_compl (s : lower_set α) : s.compl.compl = s := lower_set.ext $ compl_compl _
-
-protected lemma compl_sup (s t : lower_set α) : (s ⊔ t).compl = s.compl ⊓ t.compl :=
-upper_set.ext compl_sup
-protected lemma compl_inf (s t : lower_set α) : (s ⊓ t).compl = s.compl ⊔ t.compl :=
-upper_set.ext compl_inf
-protected lemma compl_top : (⊤ : lower_set α).compl = ⊥ := upper_set.ext compl_univ
-protected lemma compl_bot : (⊥ : lower_set α).compl = ⊤ := upper_set.ext compl_empty
-protected lemma compl_Sup (S : set (lower_set α)) : (Sup S).compl = ⨅ s ∈ S, lower_set.compl s :=
-upper_set.ext $ by simp only [coe_compl, coe_Sup, compl_Union₂, upper_set.coe_infi₂]
-
-protected lemma compl_Inf (S : set (lower_set α)) : (Inf S).compl = ⨆ s ∈ S, lower_set.compl s :=
-upper_set.ext $ by simp only [coe_compl, coe_Inf, compl_Inter₂, upper_set.coe_supr₂]
-
-protected lemma compl_supr (f : ι → lower_set α) : (⨆ i, f i).compl = ⨅ i, (f i).compl :=
-upper_set.ext $ by simp only [coe_compl, coe_supr, compl_Union, upper_set.coe_infi]
-
-protected lemma compl_infi (f : ι → lower_set α) : (⨅ i, f i).compl = ⨆ i, (f i).compl :=
-upper_set.ext $ by simp only [coe_compl, coe_infi, compl_Inter, upper_set.coe_supr]
-
-@[simp] lemma compl_supr₂ (f : Π i, κ i → lower_set α) :
-  (⨆ i j, f i j).compl = ⨅ i j, (f i j).compl :=
-by simp_rw lower_set.compl_supr
-
-@[simp] lemma compl_infi₂ (f : Π i, κ i → lower_set α) :
-  (⨅ i j, f i j).compl =  ⨆ i j, (f i j).compl :=
-by simp_rw lower_set.compl_infi
-
-end lower_set
-end has_le
-
-/-! #### Principal sets -/
-
-namespace upper_set
-section preorder
-variables [preorder α] {a b : α}
-
-/-- The smallest upper set containing a given element. -/
-def Ici (a : α) : upper_set α := ⟨Ici a, is_upper_set_Ici a⟩
-
-/-- The smallest upper set containing a given element. -/
-def Ioi (a : α) : upper_set α := ⟨Ioi a, is_upper_set_Ioi a⟩
-
-@[simp] lemma coe_Ici (a : α) : ↑(Ici a) = set.Ici a := rfl
-@[simp] lemma coe_Ioi (a : α) : ↑(Ioi a) = set.Ioi a := rfl
-@[simp] lemma mem_Ici_iff : b ∈ Ici a ↔ a ≤ b := iff.rfl
-@[simp] lemma mem_Ioi_iff : b ∈ Ioi a ↔ a < b := iff.rfl
-
-lemma Ioi_le_Ici (a : α) : Ioi a ≤ Ici a := Ioi_subset_Ici_self
-
-@[simp] lemma Ici_top [order_bot α] : Ici (⊥ : α) = ⊤ := set_like.coe_injective Ici_bot
-@[simp] lemma Ioi_bot [order_top α] : Ioi (⊤ : α) = ⊥ := set_like.coe_injective Ioi_top
-
-end preorder
-
-section semilattice_sup
-variables [semilattice_sup α]
-
-@[simp] lemma Ici_sup (a b : α) : Ici (a ⊔ b) = Ici a ⊓ Ici b := ext Ici_inter_Ici.symm
-
-/-- `upper_set.Ici` as a `sup_hom`. -/
-def Ici_sup_hom : sup_hom α (upper_set α)ᵒᵈ := ⟨Ici, Ici_sup⟩
-
-@[simp] lemma Ici_sup_hom_apply (a : α) : Ici_sup_hom a = to_dual (Ici a) := rfl
-
-end semilattice_sup
-
-section complete_lattice
-variables [complete_lattice α]
-
-@[simp] lemma Ici_Sup (S : set α) : Ici (Sup S) = ⨅ a ∈ S, Ici a :=
-set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_infi_iff, Sup_le_iff]
-
-@[simp] lemma Ici_supr (f : ι → α) : Ici (⨆ i, f i) = ⨅ i, Ici (f i) :=
-set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_infi_iff, supr_le_iff]
-
-@[simp] lemma Ici_supr₂ (f : Π i, κ i → α) : Ici (⨆ i j, f i j) = ⨅ i j, Ici (f i j) :=
-by simp_rw Ici_supr
-
-/-- `upper_set.Ici` as a `Sup_hom`. -/
-def Ici_Sup_hom : Sup_hom α (upper_set α)ᵒᵈ :=
-⟨Ici, λ s, (Ici_Sup s).trans Inf_image.symm⟩
-
-@[simp] lemma Ici_Sup_hom_apply (a : α) : Ici_Sup_hom a = to_dual (Ici a) := rfl
-
-end complete_lattice
-end upper_set
-
-namespace lower_set
-section preorder
-variables [preorder α] {a b : α}
-
-/-- Principal lower set. `set.Iic` as a lower set. The smallest lower set containing a given
-element. -/
-def Iic (a : α) : lower_set α := ⟨Iic a, is_lower_set_Iic a⟩
-
-/-- Strict principal lower set. `set.Iio` as a lower set. -/
-def Iio (a : α) : lower_set α := ⟨Iio a, is_lower_set_Iio a⟩
-
-@[simp] lemma coe_Iic (a : α) : ↑(Iic a) = set.Iic a := rfl
-@[simp] lemma coe_Iio (a : α) : ↑(Iio a) = set.Iio a := rfl
-@[simp] lemma mem_Iic_iff : b ∈ Iic a ↔ b ≤ a := iff.rfl
-@[simp] lemma mem_Iio_iff : b ∈ Iio a ↔ b < a := iff.rfl
-
-lemma Ioi_le_Ici (a : α) : Ioi a ≤ Ici a := Ioi_subset_Ici_self
-
-@[simp] lemma Iic_top [order_top α] : Iic (⊤ : α) = ⊤ := set_like.coe_injective Iic_top
-@[simp] lemma Iio_bot [order_bot α] : Iio (⊥ : α) = ⊥ := set_like.coe_injective Iio_bot
-
-end preorder
-
-section semilattice_inf
-variables [semilattice_inf α]
-
-@[simp] lemma Iic_inf (a b : α) : Iic (a ⊓ b) = Iic a ⊓ Iic b :=
-set_like.coe_injective Iic_inter_Iic.symm
-
-/-- `lower_set.Iic` as an `inf_hom`. -/
-def Iic_inf_hom : inf_hom α (lower_set α) := ⟨Iic, Iic_inf⟩
-
-@[simp] lemma coe_Iic_inf_hom : (Iic_inf_hom : α → lower_set α) = Iic := rfl
-@[simp] lemma Iic_inf_hom_apply (a : α) : Iic_inf_hom a = Iic a := rfl
-
-end semilattice_inf
-
-section complete_lattice
-variables [complete_lattice α]
-
-@[simp] lemma Iic_Inf (S : set α) : Iic (Inf S) = ⨅ a ∈ S, Iic a :=
-set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi₂_iff, le_Inf_iff]
-
-@[simp] lemma Iic_infi (f : ι → α) : Iic (⨅ i, f i) = ⨅ i, Iic (f i) :=
-set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi_iff, le_infi_iff]
-
-@[simp] lemma Iic_infi₂ (f : Π i, κ i → α) : Iic (⨅ i j, f i j) = ⨅ i j, Iic (f i j) :=
-by simp_rw Iic_infi
-
-/-- `lower_set.Iic` as an `Inf_hom`. -/
-def Iic_Inf_hom : Inf_hom α (lower_set α) := ⟨Iic, λ s, (Iic_Inf s).trans Inf_image.symm⟩
-
-@[simp] lemma coe_Iic_Inf_hom : (Iic_Inf_hom : α → lower_set α) = Iic := rfl
-@[simp] lemma Iic_Inf_hom_apply (a : α) : Iic_Inf_hom a = Iic a := rfl
-
-end complete_lattice
-end lower_set
diff --git a/src/order/upper_lower/basic.lean b/src/order/upper_lower/basic.lean
new file mode 100644
index 0000000000000..db5b4c91df203
--- /dev/null
+++ b/src/order/upper_lower/basic.lean
@@ -0,0 +1,1023 @@
+/-
+Copyright (c) 2022 Yaël Dillies, Sara Rousta. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies, Sara Rousta
+-/
+import data.set_like.basic
+import data.set.intervals.ord_connected
+import data.set.intervals.order_iso
+import tactic.by_contra
+
+/-!
+# Up-sets and down-sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines upper and lower sets in an order.
+
+## Main declarations
+
+* `is_upper_set`: Predicate for a set to be an upper set. This means every element greater than a
+  member of the set is in the set itself.
+* `is_lower_set`: Predicate for a set to be a lower set. This means every element less than a member
+  of the set is in the set itself.
+* `upper_set`: The type of upper sets.
+* `lower_set`: The type of lower sets.
+* `upper_closure`: The greatest upper set containing a set.
+* `lower_closure`: The least lower set containing a set.
+* `upper_set.Ici`: Principal upper set. `set.Ici` as an upper set.
+* `upper_set.Ioi`: Strict principal upper set. `set.Ioi` as an upper set.
+* `lower_set.Iic`: Principal lower set. `set.Iic` as an lower set.
+* `lower_set.Iio`: Strict principal lower set. `set.Iio` as an lower set.
+
+## Notation
+
+`×ˢ` is notation for `upper_set.prod`/`lower_set.prod`.
+
+## Notes
+
+Upper sets are ordered by **reverse** inclusion. This convention is motivated by the fact that this
+makes them order-isomorphic to lower sets and antichains, and matches the convention on `filter`.
+
+## TODO
+
+Lattice structure on antichains. Order equivalence between upper/lower sets and antichains.
+-/
+
+open order_dual set
+
+variables {α β γ : Type*} {ι : Sort*} {κ : ι → Sort*}
+
+/-! ### Unbundled upper/lower sets -/
+
+section has_le
+variables [has_le α] [has_le β] {s t : set α}
+
+/-- An upper set in an order `α` is a set such that any element greater than one of its members is
+also a member. Also called up-set, upward-closed set. -/
+def is_upper_set (s : set α) : Prop := ∀ ⦃a b : α⦄, a ≤ b → a ∈ s → b ∈ s
+
+/-- A lower set in an order `α` is a set such that any element less than one of its members is also
+a member. Also called down-set, downward-closed set. -/
+def is_lower_set (s : set α) : Prop := ∀ ⦃a b : α⦄, b ≤ a → a ∈ s → b ∈ s
+
+lemma is_upper_set_empty : is_upper_set (∅ : set α) := λ _ _ _, id
+lemma is_lower_set_empty : is_lower_set (∅ : set α) := λ _ _ _, id
+lemma is_upper_set_univ : is_upper_set (univ : set α) := λ _ _ _, id
+lemma is_lower_set_univ : is_lower_set (univ : set α) := λ _ _ _, id
+lemma is_upper_set.compl (hs : is_upper_set s) : is_lower_set sᶜ := λ a b h hb ha, hb $ hs h ha
+lemma is_lower_set.compl (hs : is_lower_set s) : is_upper_set sᶜ := λ a b h hb ha, hb $ hs h ha
+
+@[simp] lemma is_upper_set_compl : is_upper_set sᶜ ↔ is_lower_set s :=
+⟨λ h, by { convert h.compl, rw compl_compl }, is_lower_set.compl⟩
+
+@[simp] lemma is_lower_set_compl : is_lower_set sᶜ ↔ is_upper_set s :=
+⟨λ h, by { convert h.compl, rw compl_compl }, is_upper_set.compl⟩
+
+lemma is_upper_set.union (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∪ t) :=
+λ a b h, or.imp (hs h) (ht h)
+
+lemma is_lower_set.union (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∪ t) :=
+λ a b h, or.imp (hs h) (ht h)
+
+lemma is_upper_set.inter (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ∩ t) :=
+λ a b h, and.imp (hs h) (ht h)
+
+lemma is_lower_set.inter (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ∩ t) :=
+λ a b h, and.imp (hs h) (ht h)
+
+lemma is_upper_set_Union {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋃ i, f i) :=
+λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h
+
+lemma is_lower_set_Union {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋃ i, f i) :=
+λ a b h, Exists₂.imp $ forall_range_iff.2 $ λ i, hf i h
+
+lemma is_upper_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
+  is_upper_set (⋃ i j, f i j) :=
+is_upper_set_Union $ λ i, is_upper_set_Union $ hf i
+
+lemma is_lower_set_Union₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
+  is_lower_set (⋃ i j, f i j) :=
+is_lower_set_Union $ λ i, is_lower_set_Union $ hf i
+
+lemma is_upper_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋃₀ S) :=
+λ a b h, Exists₂.imp $ λ s hs, hf s hs h
+
+lemma is_lower_set_sUnion {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋃₀ S) :=
+λ a b h, Exists₂.imp $ λ s hs, hf s hs h
+
+lemma is_upper_set_Inter {f : ι → set α} (hf : ∀ i, is_upper_set (f i)) : is_upper_set (⋂ i, f i) :=
+λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h
+
+lemma is_lower_set_Inter {f : ι → set α} (hf : ∀ i, is_lower_set (f i)) : is_lower_set (⋂ i, f i) :=
+λ a b h, forall₂_imp $ forall_range_iff.2 $ λ i, hf i h
+
+lemma is_upper_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_upper_set (f i j)) :
+  is_upper_set (⋂ i j, f i j) :=
+is_upper_set_Inter $ λ i, is_upper_set_Inter $ hf i
+
+lemma is_lower_set_Inter₂ {f : Π i, κ i → set α} (hf : ∀ i j, is_lower_set (f i j)) :
+  is_lower_set (⋂ i j, f i j) :=
+is_lower_set_Inter $ λ i, is_lower_set_Inter $ hf i
+
+lemma is_upper_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_upper_set s) : is_upper_set (⋂₀ S) :=
+λ a b h, forall₂_imp $ λ s hs, hf s hs h
+
+lemma is_lower_set_sInter {S : set (set α)} (hf : ∀ s ∈ S, is_lower_set s) : is_lower_set (⋂₀ S) :=
+λ a b h, forall₂_imp $ λ s hs, hf s hs h
+
+@[simp] lemma is_lower_set_preimage_of_dual_iff : is_lower_set (of_dual ⁻¹' s) ↔ is_upper_set s :=
+iff.rfl
+@[simp] lemma is_upper_set_preimage_of_dual_iff : is_upper_set (of_dual ⁻¹' s) ↔ is_lower_set s :=
+iff.rfl
+@[simp] lemma is_lower_set_preimage_to_dual_iff {s : set αᵒᵈ} :
+  is_lower_set (to_dual ⁻¹' s) ↔ is_upper_set s := iff.rfl
+@[simp] lemma is_upper_set_preimage_to_dual_iff {s : set αᵒᵈ} :
+  is_upper_set (to_dual ⁻¹' s) ↔ is_lower_set s := iff.rfl
+
+alias is_lower_set_preimage_of_dual_iff ↔ _ is_upper_set.to_dual
+alias is_upper_set_preimage_of_dual_iff ↔ _ is_lower_set.to_dual
+alias is_lower_set_preimage_to_dual_iff ↔ _ is_upper_set.of_dual
+alias is_upper_set_preimage_to_dual_iff ↔ _ is_lower_set.of_dual
+
+end has_le
+
+section preorder
+variables [preorder α] [preorder β] {s : set α} {p : α → Prop} (a : α)
+
+lemma is_upper_set_Ici : is_upper_set (Ici a) := λ _ _, ge_trans
+lemma is_lower_set_Iic : is_lower_set (Iic a) := λ _ _, le_trans
+lemma is_upper_set_Ioi : is_upper_set (Ioi a) := λ _ _, flip lt_of_lt_of_le
+lemma is_lower_set_Iio : is_lower_set (Iio a) := λ _ _, lt_of_le_of_lt
+
+lemma is_upper_set_iff_Ici_subset : is_upper_set s ↔ ∀ ⦃a⦄, a ∈ s → Ici a ⊆ s :=
+by simp [is_upper_set, subset_def, @forall_swap (_ ∈ s)]
+
+lemma is_lower_set_iff_Iic_subset : is_lower_set s ↔ ∀ ⦃a⦄, a ∈ s → Iic a ⊆ s :=
+by simp [is_lower_set, subset_def, @forall_swap (_ ∈ s)]
+
+alias is_upper_set_iff_Ici_subset ↔ is_upper_set.Ici_subset _
+alias is_lower_set_iff_Iic_subset ↔ is_lower_set.Iic_subset _
+
+lemma is_upper_set.ord_connected (h : is_upper_set s) : s.ord_connected :=
+⟨λ a ha b _, Icc_subset_Ici_self.trans $ h.Ici_subset ha⟩
+
+lemma is_lower_set.ord_connected (h : is_lower_set s) : s.ord_connected :=
+⟨λ a _ b hb, Icc_subset_Iic_self.trans $ h.Iic_subset hb⟩
+
+lemma is_upper_set.preimage (hs : is_upper_set s) {f : β → α} (hf : monotone f) :
+  is_upper_set (f ⁻¹' s : set β) :=
+λ x y hxy, hs $ hf hxy
+
+lemma is_lower_set.preimage (hs : is_lower_set s) {f : β → α} (hf : monotone f) :
+  is_lower_set (f ⁻¹' s : set β) :=
+λ x y hxy, hs $ hf hxy
+
+lemma is_upper_set.image (hs : is_upper_set s) (f : α ≃o β) : is_upper_set (f '' s : set β) :=
+by { change is_upper_set ((f : α ≃ β) '' s), rw set.image_equiv_eq_preimage_symm,
+  exact hs.preimage f.symm.monotone }
+
+lemma is_lower_set.image (hs : is_lower_set s) (f : α ≃o β) : is_lower_set (f '' s : set β) :=
+by { change is_lower_set ((f : α ≃ β) '' s), rw set.image_equiv_eq_preimage_symm,
+  exact hs.preimage f.symm.monotone }
+
+@[simp] lemma set.monotone_mem : monotone (∈ s) ↔ is_upper_set s := iff.rfl
+@[simp] lemma set.antitone_mem : antitone (∈ s) ↔ is_lower_set s := forall_swap
+
+@[simp] lemma is_upper_set_set_of : is_upper_set {a | p a} ↔ monotone p := iff.rfl
+@[simp] lemma is_lower_set_set_of : is_lower_set {a | p a} ↔ antitone p := forall_swap
+
+section order_top
+variables [order_top α]
+
+lemma is_lower_set.top_mem (hs : is_lower_set s) : ⊤ ∈ s ↔ s = univ :=
+⟨λ h, eq_univ_of_forall $ λ a, hs le_top h, λ h, h.symm ▸ mem_univ _⟩
+
+lemma is_upper_set.top_mem (hs : is_upper_set s) : ⊤ ∈ s ↔ s.nonempty :=
+⟨λ h, ⟨_, h⟩, λ ⟨a, ha⟩, hs le_top ha⟩
+
+lemma is_upper_set.not_top_mem (hs : is_upper_set s) : ⊤ ∉ s ↔ s = ∅ :=
+hs.top_mem.not.trans not_nonempty_iff_eq_empty
+
+end order_top
+
+section order_bot
+variables [order_bot α]
+
+lemma is_upper_set.bot_mem (hs : is_upper_set s) : ⊥ ∈ s ↔ s = univ :=
+⟨λ h, eq_univ_of_forall $ λ a, hs bot_le h, λ h, h.symm ▸ mem_univ _⟩
+
+lemma is_lower_set.bot_mem (hs : is_lower_set s) : ⊥ ∈ s ↔ s.nonempty :=
+⟨λ h, ⟨_, h⟩, λ ⟨a, ha⟩, hs bot_le ha⟩
+
+lemma is_lower_set.not_bot_mem (hs : is_lower_set s) : ⊥ ∉ s ↔ s = ∅ :=
+hs.bot_mem.not.trans not_nonempty_iff_eq_empty
+
+end order_bot
+
+section no_max_order
+variables [no_max_order α] (a)
+
+lemma is_upper_set.not_bdd_above (hs : is_upper_set s) : s.nonempty → ¬ bdd_above s :=
+begin
+  rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  obtain ⟨c, hc⟩ := exists_gt b,
+  exact hc.not_le (hb $ hs ((hb ha).trans hc.le) ha),
+end
+
+lemma not_bdd_above_Ici : ¬ bdd_above (Ici a) := (is_upper_set_Ici _).not_bdd_above nonempty_Ici
+lemma not_bdd_above_Ioi : ¬ bdd_above (Ioi a) := (is_upper_set_Ioi _).not_bdd_above nonempty_Ioi
+
+end no_max_order
+
+section no_min_order
+variables [no_min_order α] (a)
+
+lemma is_lower_set.not_bdd_below (hs : is_lower_set s) : s.nonempty → ¬ bdd_below s :=
+begin
+  rintro ⟨a, ha⟩ ⟨b, hb⟩,
+  obtain ⟨c, hc⟩ := exists_lt b,
+  exact hc.not_le (hb $ hs (hc.le.trans $ hb ha) ha),
+end
+
+lemma not_bdd_below_Iic : ¬ bdd_below (Iic a) := (is_lower_set_Iic _).not_bdd_below nonempty_Iic
+lemma not_bdd_below_Iio : ¬ bdd_below (Iio a) := (is_lower_set_Iio _).not_bdd_below nonempty_Iio
+
+end no_min_order
+end preorder
+
+section partial_order
+variables [partial_order α] {s : set α}
+
+lemma is_upper_set_iff_forall_lt : is_upper_set s ↔ ∀ ⦃a b : α⦄, a < b → a ∈ s → b ∈ s :=
+forall_congr $ λ a, by simp [le_iff_eq_or_lt, or_imp_distrib, forall_and_distrib]
+
+lemma is_lower_set_iff_forall_lt : is_lower_set s ↔ ∀ ⦃a b : α⦄, b < a → a ∈ s → b ∈ s :=
+forall_congr $ λ a, by simp [le_iff_eq_or_lt, or_imp_distrib, forall_and_distrib]
+
+lemma is_upper_set_iff_Ioi_subset : is_upper_set s ↔ ∀ ⦃a⦄, a ∈ s → Ioi a ⊆ s :=
+by simp [is_upper_set_iff_forall_lt, subset_def, @forall_swap (_ ∈ s)]
+
+lemma is_lower_set_iff_Iio_subset : is_lower_set s ↔ ∀ ⦃a⦄, a ∈ s → Iio a ⊆ s :=
+by simp [is_lower_set_iff_forall_lt, subset_def, @forall_swap (_ ∈ s)]
+
+alias is_upper_set_iff_Ioi_subset ↔ is_upper_set.Ioi_subset _
+alias is_lower_set_iff_Iio_subset ↔ is_lower_set.Iio_subset _
+
+end partial_order
+
+section linear_order
+variables [linear_order α] {s t : set α}
+
+lemma is_upper_set.total (hs : is_upper_set s) (ht : is_upper_set t) : s ⊆ t ∨ t ⊆ s :=
+begin
+  by_contra' h,
+  simp_rw set.not_subset at h,
+  obtain ⟨⟨a, has, hat⟩, b, hbt, hbs⟩ := h,
+  obtain hab | hba := le_total a b,
+  { exact hbs (hs hab has) },
+  { exact hat (ht hba hbt) }
+end
+
+lemma is_lower_set.total (hs : is_lower_set s) (ht : is_lower_set t) : s ⊆ t ∨ t ⊆ s :=
+hs.to_dual.total ht.to_dual
+
+end linear_order
+
+/-! ### Bundled upper/lower sets -/
+
+section has_le
+variables [has_le α]
+
+/-- The type of upper sets of an order. -/
+structure upper_set (α : Type*) [has_le α] :=
+(carrier : set α)
+(upper' : is_upper_set carrier)
+
+/-- The type of lower sets of an order. -/
+structure lower_set (α : Type*) [has_le α] :=
+(carrier : set α)
+(lower' : is_lower_set carrier)
+
+namespace upper_set
+
+instance : set_like (upper_set α) α :=
+{ coe := upper_set.carrier,
+  coe_injective' := λ s t h, by { cases s, cases t, congr' } }
+
+@[ext] lemma ext {s t : upper_set α} : (s : set α) = t → s = t := set_like.ext'
+
+@[simp] lemma carrier_eq_coe (s : upper_set α) : s.carrier = s := rfl
+
+protected lemma upper (s : upper_set α) : is_upper_set (s : set α) := s.upper'
+
+@[simp] lemma mem_mk (carrier : set α) (upper') {a : α} : a ∈ mk carrier upper' ↔ a ∈ carrier :=
+iff.rfl
+
+end upper_set
+
+namespace lower_set
+
+instance : set_like (lower_set α) α :=
+{ coe := lower_set.carrier,
+  coe_injective' := λ s t h, by { cases s, cases t, congr' } }
+
+@[ext] lemma ext {s t : lower_set α} : (s : set α) = t → s = t := set_like.ext'
+
+@[simp] lemma carrier_eq_coe (s : lower_set α) : s.carrier = s := rfl
+
+protected lemma lower (s : lower_set α) : is_lower_set (s : set α) := s.lower'
+
+@[simp] lemma mem_mk (carrier : set α) (lower') {a : α} : a ∈ mk carrier lower' ↔ a ∈ carrier :=
+iff.rfl
+
+end lower_set
+
+/-! #### Order -/
+
+namespace upper_set
+variables {S : set (upper_set α)} {s t : upper_set α} {a : α}
+
+instance : has_sup (upper_set α) := ⟨λ s t, ⟨s ∩ t, s.upper.inter t.upper⟩⟩
+instance : has_inf (upper_set α) := ⟨λ s t, ⟨s ∪ t, s.upper.union t.upper⟩⟩
+instance : has_top (upper_set α) := ⟨⟨∅, is_upper_set_empty⟩⟩
+instance : has_bot (upper_set α) := ⟨⟨univ, is_upper_set_univ⟩⟩
+instance : has_Sup (upper_set α) :=
+⟨λ S, ⟨⋂ s ∈ S, ↑s, is_upper_set_Inter₂ $ λ s _, s.upper⟩⟩
+instance : has_Inf (upper_set α) :=
+⟨λ S, ⟨⋃ s ∈ S, ↑s, is_upper_set_Union₂ $ λ s _, s.upper⟩⟩
+
+instance : complete_distrib_lattice (upper_set α) :=
+(to_dual.injective.comp $ set_like.coe_injective).complete_distrib_lattice _
+  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl
+
+instance : inhabited (upper_set α) := ⟨⊥⟩
+
+@[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ t ≤ s := iff.rfl
+@[simp, norm_cast] lemma coe_top : ((⊤ : upper_set α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_bot : ((⊥ : upper_set α) : set α) = univ := rfl
+@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = univ ↔ s = ⊥ := by simp [set_like.ext'_iff]
+@[simp, norm_cast] lemma coe_eq_empty : (s : set α) = ∅ ↔ s = ⊤ := by simp [set_like.ext'_iff]
+@[simp, norm_cast] lemma coe_sup (s t : upper_set α) : (↑(s ⊔ t) : set α) = s ∩ t := rfl
+@[simp, norm_cast] lemma coe_inf (s t : upper_set α) : (↑(s ⊓ t) : set α) = s ∪ t := rfl
+@[simp, norm_cast] lemma coe_Sup (S : set (upper_set α)) : (↑(Sup S) : set α) = ⋂ s ∈ S, ↑s := rfl
+@[simp, norm_cast] lemma coe_Inf (S : set (upper_set α)) : (↑(Inf S) : set α) = ⋃ s ∈ S, ↑s := rfl
+@[simp, norm_cast] lemma coe_supr (f : ι → upper_set α) : (↑(⨆ i, f i) : set α) = ⋂ i, f i :=
+by simp [supr]
+@[simp, norm_cast] lemma coe_infi (f : ι → upper_set α) : (↑(⨅ i, f i) : set α) = ⋃ i, f i :=
+by simp [infi]
+@[simp, norm_cast] lemma coe_supr₂ (f : Π i, κ i → upper_set α) :
+  (↑(⨆ i j, f i j) : set α) = ⋂ i j, f i j := by simp_rw coe_supr
+@[simp, norm_cast] lemma coe_infi₂ (f : Π i, κ i → upper_set α) :
+  (↑(⨅ i j, f i j) : set α) = ⋃ i j, f i j := by simp_rw coe_infi
+
+@[simp] lemma not_mem_top : a ∉ (⊤ : upper_set α) := id
+@[simp] lemma mem_bot : a ∈ (⊥ : upper_set α) := trivial
+@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
+@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
+@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
+@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
+@[simp] lemma mem_supr_iff {f : ι → upper_set α} : a ∈ (⨆ i, f i) ↔ ∀ i, a ∈ f i :=
+by { rw [←set_like.mem_coe, coe_supr], exact mem_Inter }
+@[simp] lemma mem_infi_iff {f : ι → upper_set α} : a ∈ (⨅ i, f i) ↔ ∃ i, a ∈ f i :=
+by { rw [←set_like.mem_coe, coe_infi], exact mem_Union }
+@[simp] lemma mem_supr₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨆ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
+by simp_rw mem_supr_iff
+@[simp] lemma mem_infi₂_iff {f : Π i, κ i → upper_set α} : a ∈ (⨅ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
+by simp_rw mem_infi_iff
+
+@[simp, norm_cast] lemma codisjoint_coe : codisjoint (s : set α) t ↔ disjoint s t :=
+by simp [disjoint_iff, codisjoint_iff, set_like.ext'_iff]
+
+end upper_set
+
+namespace lower_set
+variables {S : set (lower_set α)} {s t : lower_set α} {a : α}
+
+instance : has_sup (lower_set α) := ⟨λ s t, ⟨s ∪ t, λ a b h, or.imp (s.lower h) (t.lower h)⟩⟩
+instance : has_inf (lower_set α) := ⟨λ s t, ⟨s ∩ t, λ a b h, and.imp (s.lower h) (t.lower h)⟩⟩
+instance : has_top (lower_set α) := ⟨⟨univ, λ a b h, id⟩⟩
+instance : has_bot (lower_set α) := ⟨⟨∅, λ a b h, id⟩⟩
+instance : has_Sup (lower_set α) := ⟨λ S, ⟨⋃ s ∈ S, ↑s, is_lower_set_Union₂ $ λ s _, s.lower⟩⟩
+instance : has_Inf (lower_set α) := ⟨λ S, ⟨⋂ s ∈ S, ↑s, is_lower_set_Inter₂ $ λ s _, s.lower⟩⟩
+
+instance : complete_distrib_lattice (lower_set α) :=
+set_like.coe_injective.complete_distrib_lattice _
+  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) rfl rfl
+
+instance : inhabited (lower_set α) := ⟨⊥⟩
+
+@[simp, norm_cast] lemma coe_subset_coe : (s : set α) ⊆ t ↔ s ≤ t := iff.rfl
+@[simp, norm_cast] lemma coe_top : ((⊤ : lower_set α) : set α) = univ := rfl
+@[simp, norm_cast] lemma coe_bot : ((⊥ : lower_set α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_eq_univ : (s : set α) = univ ↔ s = ⊤ := by simp [set_like.ext'_iff]
+@[simp, norm_cast] lemma coe_eq_empty : (s : set α) = ∅ ↔ s = ⊥ := by simp [set_like.ext'_iff]
+@[simp, norm_cast] lemma coe_sup (s t : lower_set α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
+@[simp, norm_cast] lemma coe_inf (s t : lower_set α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
+@[simp, norm_cast] lemma coe_Sup (S : set (lower_set α)) : (↑(Sup S) : set α) = ⋃ s ∈ S, ↑s := rfl
+@[simp, norm_cast] lemma coe_Inf (S : set (lower_set α)) : (↑(Inf S) : set α) = ⋂ s ∈ S, ↑s := rfl
+@[simp, norm_cast] lemma coe_supr (f : ι → lower_set α) : (↑(⨆ i, f i) : set α) = ⋃ i, f i :=
+by simp_rw [supr, coe_Sup, mem_range, Union_exists, Union_Union_eq']
+@[simp, norm_cast] lemma coe_infi (f : ι → lower_set α) : (↑(⨅ i, f i) : set α) = ⋂ i, f i :=
+by simp_rw [infi, coe_Inf, mem_range, Inter_exists, Inter_Inter_eq']
+@[simp, norm_cast] lemma coe_supr₂ (f : Π i, κ i → lower_set α) :
+  (↑(⨆ i j, f i j) : set α) = ⋃ i j, f i j := by simp_rw coe_supr
+@[simp, norm_cast] lemma coe_infi₂ (f : Π i, κ i → lower_set α) :
+  (↑(⨅ i j, f i j) : set α) = ⋂ i j, f i j := by simp_rw coe_infi
+
+@[simp] lemma mem_top : a ∈ (⊤ : lower_set α) := trivial
+@[simp] lemma not_mem_bot : a ∉ (⊥ : lower_set α) := id
+@[simp] lemma mem_sup_iff : a ∈ s ⊔ t ↔ a ∈ s ∨ a ∈ t := iff.rfl
+@[simp] lemma mem_inf_iff : a ∈ s ⊓ t ↔ a ∈ s ∧ a ∈ t := iff.rfl
+@[simp] lemma mem_Sup_iff : a ∈ Sup S ↔ ∃ s ∈ S, a ∈ s := mem_Union₂
+@[simp] lemma mem_Inf_iff  : a ∈ Inf S ↔ ∀ s ∈ S, a ∈ s := mem_Inter₂
+@[simp] lemma mem_supr_iff {f : ι → lower_set α} : a ∈ (⨆ i, f i) ↔ ∃ i, a ∈ f i :=
+by { rw [←set_like.mem_coe, coe_supr], exact mem_Union }
+@[simp] lemma mem_infi_iff {f : ι → lower_set α} : a ∈ (⨅ i, f i) ↔ ∀ i, a ∈ f i :=
+by { rw [←set_like.mem_coe, coe_infi], exact mem_Inter }
+@[simp] lemma mem_supr₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨆ i j, f i j) ↔ ∃ i j, a ∈ f i j :=
+by simp_rw mem_supr_iff
+@[simp] lemma mem_infi₂_iff {f : Π i, κ i → lower_set α} : a ∈ (⨅ i j, f i j) ↔ ∀ i j, a ∈ f i j :=
+by simp_rw mem_infi_iff
+
+@[simp, norm_cast] lemma disjoint_coe : disjoint (s : set α) t ↔ disjoint s t :=
+by simp [disjoint_iff, set_like.ext'_iff]
+
+end lower_set
+
+/-! #### Complement -/
+
+/-- The complement of a lower set as an upper set. -/
+def upper_set.compl (s : upper_set α) : lower_set α := ⟨sᶜ, s.upper.compl⟩
+
+/-- The complement of a lower set as an upper set. -/
+def lower_set.compl (s : lower_set α) : upper_set α := ⟨sᶜ, s.lower.compl⟩
+
+namespace upper_set
+variables {s t : upper_set α} {a : α}
+
+@[simp] lemma coe_compl (s : upper_set α) : (s.compl : set α) = sᶜ := rfl
+@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
+@[simp] lemma compl_compl (s : upper_set α) : s.compl.compl = s := upper_set.ext $ compl_compl _
+@[simp] lemma compl_le_compl : s.compl ≤ t.compl ↔ s ≤ t := compl_subset_compl
+
+@[simp] protected lemma compl_sup (s t : upper_set α) : (s ⊔ t).compl = s.compl ⊔ t.compl :=
+lower_set.ext compl_inf
+@[simp] protected lemma compl_inf (s t : upper_set α) : (s ⊓ t).compl = s.compl ⊓ t.compl :=
+lower_set.ext compl_sup
+@[simp] protected lemma compl_top : (⊤ : upper_set α).compl = ⊤ := lower_set.ext compl_empty
+@[simp] protected lemma compl_bot : (⊥ : upper_set α).compl = ⊥  := lower_set.ext compl_univ
+@[simp] protected lemma compl_Sup (S : set (upper_set α)) :
+  (Sup S).compl = ⨆ s ∈ S, upper_set.compl s :=
+lower_set.ext $ by simp only [coe_compl, coe_Sup, compl_Inter₂, lower_set.coe_supr₂]
+
+@[simp] protected lemma compl_Inf (S : set (upper_set α)) :
+  (Inf S).compl = ⨅ s ∈ S, upper_set.compl s :=
+lower_set.ext $ by simp only [coe_compl, coe_Inf, compl_Union₂, lower_set.coe_infi₂]
+
+@[simp] protected lemma compl_supr (f : ι → upper_set α) : (⨆ i, f i).compl = ⨆ i, (f i).compl :=
+lower_set.ext $ by simp only [coe_compl, coe_supr, compl_Inter, lower_set.coe_supr]
+
+@[simp] protected lemma compl_infi (f : ι → upper_set α) : (⨅ i, f i).compl = ⨅ i, (f i).compl :=
+lower_set.ext $ by simp only [coe_compl, coe_infi, compl_Union, lower_set.coe_infi]
+
+@[simp] lemma compl_supr₂ (f : Π i, κ i → upper_set α) :
+  (⨆ i j, f i j).compl = ⨆ i j, (f i j).compl :=
+by simp_rw upper_set.compl_supr
+
+@[simp] lemma compl_infi₂ (f : Π i, κ i → upper_set α) :
+  (⨅ i j, f i j).compl = ⨅ i j, (f i j).compl :=
+by simp_rw upper_set.compl_infi
+
+end upper_set
+
+namespace lower_set
+variables {s t : lower_set α} {a : α}
+
+@[simp] lemma coe_compl (s : lower_set α) : (s.compl : set α) = sᶜ := rfl
+@[simp] lemma mem_compl_iff : a ∈ s.compl ↔ a ∉ s := iff.rfl
+@[simp] lemma compl_compl (s : lower_set α) : s.compl.compl = s := lower_set.ext $ compl_compl _
+@[simp] lemma compl_le_compl : s.compl ≤ t.compl ↔ s ≤ t := compl_subset_compl
+
+protected lemma compl_sup (s t : lower_set α) : (s ⊔ t).compl = s.compl ⊔ t.compl :=
+upper_set.ext compl_sup
+protected lemma compl_inf (s t : lower_set α) : (s ⊓ t).compl = s.compl ⊓ t.compl :=
+upper_set.ext compl_inf
+protected lemma compl_top : (⊤ : lower_set α).compl = ⊤ := upper_set.ext compl_univ
+protected lemma compl_bot : (⊥ : lower_set α).compl = ⊥ := upper_set.ext compl_empty
+protected lemma compl_Sup (S : set (lower_set α)) : (Sup S).compl = ⨆ s ∈ S, lower_set.compl s :=
+upper_set.ext $ by simp only [coe_compl, coe_Sup, compl_Union₂, upper_set.coe_supr₂]
+
+protected lemma compl_Inf (S : set (lower_set α)) : (Inf S).compl = ⨅ s ∈ S, lower_set.compl s :=
+upper_set.ext $ by simp only [coe_compl, coe_Inf, compl_Inter₂, upper_set.coe_infi₂]
+
+protected lemma compl_supr (f : ι → lower_set α) : (⨆ i, f i).compl = ⨆ i, (f i).compl :=
+upper_set.ext $ by simp only [coe_compl, coe_supr, compl_Union, upper_set.coe_supr]
+
+protected lemma compl_infi (f : ι → lower_set α) : (⨅ i, f i).compl = ⨅ i, (f i).compl :=
+upper_set.ext $ by simp only [coe_compl, coe_infi, compl_Inter, upper_set.coe_infi]
+
+@[simp] lemma compl_supr₂ (f : Π i, κ i → lower_set α) :
+  (⨆ i j, f i j).compl = ⨆ i j, (f i j).compl :=
+by simp_rw lower_set.compl_supr
+
+@[simp] lemma compl_infi₂ (f : Π i, κ i → lower_set α) :
+  (⨅ i j, f i j).compl = ⨅ i j, (f i j).compl :=
+by simp_rw lower_set.compl_infi
+
+end lower_set
+
+/-- Upper sets are order-isomorphic to lower sets under complementation. -/
+@[simps] def upper_set_iso_lower_set : upper_set α ≃o lower_set α :=
+{ to_fun := upper_set.compl,
+  inv_fun := lower_set.compl,
+  left_inv := upper_set.compl_compl,
+  right_inv := lower_set.compl_compl,
+  map_rel_iff' := λ _ _, upper_set.compl_le_compl }
+
+end has_le
+
+section linear_order
+variables [linear_order α]
+
+instance upper_set.is_total_le : is_total (upper_set α) (≤) := ⟨λ s t, t.upper.total s.upper⟩
+instance lower_set.is_total_le : is_total (lower_set α) (≤) := ⟨λ s t, s.lower.total t.lower⟩
+
+noncomputable instance : complete_linear_order (upper_set α) :=
+{ le_total := is_total.total,
+  decidable_le := classical.dec_rel _,
+  decidable_eq := classical.dec_rel _,
+  decidable_lt := classical.dec_rel _,
+  max_def := by classical; exact sup_eq_max_default,
+  min_def := by classical; exact inf_eq_min_default,
+  ..upper_set.complete_distrib_lattice }
+
+noncomputable instance : complete_linear_order (lower_set α) :=
+{ le_total := is_total.total,
+  decidable_le := classical.dec_rel _,
+  decidable_eq := classical.dec_rel _,
+  decidable_lt := classical.dec_rel _,
+  max_def := by classical; exact sup_eq_max_default,
+  min_def := by classical; exact inf_eq_min_default,
+  ..lower_set.complete_distrib_lattice }
+
+end linear_order
+
+/-! #### Map -/
+
+section
+variables [preorder α] [preorder β] [preorder γ]
+
+namespace upper_set
+variables {f : α ≃o β} {s t : upper_set α} {a : α} {b : β}
+
+/-- An order isomorphism of preorders induces an order isomorphism of their upper sets. -/
+def map (f : α ≃o β) : upper_set α ≃o upper_set β :=
+{ to_fun := λ s, ⟨f '' s, s.upper.image f⟩,
+  inv_fun := λ t, ⟨f ⁻¹' t, t.upper.preimage f.monotone⟩,
+  left_inv := λ _, ext $ f.preimage_image _,
+  right_inv := λ _, ext $ f.image_preimage _,
+  map_rel_iff' := λ s t, image_subset_image_iff f.injective }
+
+@[simp] lemma symm_map (f : α ≃o β) : (map f).symm = map f.symm :=
+fun_like.ext _ _ $ λ s, ext $ set.preimage_equiv_eq_image_symm _ _
+
+@[simp] lemma mem_map : b ∈ map f s ↔ f.symm b ∈ s :=
+by { rw [←f.symm_symm, ←symm_map, f.symm_symm], refl }
+
+@[simp] lemma map_refl : map (order_iso.refl α) = order_iso.refl _ := by { ext, simp }
+
+@[simp] lemma map_map (g : β ≃o γ) (f : α ≃o β) : map g (map f s) = map (f.trans g) s :=
+by { ext, simp }
+
+variables (f s t)
+
+@[simp, norm_cast] lemma coe_map : (map f s : set β) = f '' s := rfl
+
+end upper_set
+
+namespace lower_set
+variables {f : α ≃o β} {s t : lower_set α} {a : α} {b : β}
+
+/-- An order isomorphism of preorders induces an order isomorphism of their lower sets. -/
+def map (f : α ≃o β) : lower_set α ≃o lower_set β :=
+{ to_fun := λ s, ⟨f '' s, s.lower.image f⟩,
+  inv_fun := λ t, ⟨f ⁻¹' t, t.lower.preimage f.monotone⟩,
+  left_inv := λ _, set_like.coe_injective $ f.preimage_image _,
+  right_inv := λ _, set_like.coe_injective $ f.image_preimage _,
+  map_rel_iff' := λ s t, image_subset_image_iff f.injective }
+
+@[simp] lemma symm_map (f : α ≃o β) : (map f).symm = map f.symm :=
+fun_like.ext _ _ $ λ s, set_like.coe_injective $ set.preimage_equiv_eq_image_symm _ _
+
+@[simp] lemma mem_map {f : α ≃o β} {b : β} : b ∈ map f s ↔ f.symm b ∈ s :=
+by { rw [←f.symm_symm, ←symm_map, f.symm_symm], refl }
+
+@[simp] lemma map_refl : map (order_iso.refl α) = order_iso.refl _ := by { ext, simp }
+
+@[simp] lemma map_map (g : β ≃o γ) (f : α ≃o β) : map g (map f s) = map (f.trans g) s :=
+by { ext, simp }
+
+variables (f s t)
+
+@[simp, norm_cast] lemma coe_map : (map f s : set β) = f '' s := rfl
+
+end lower_set
+
+namespace upper_set
+
+@[simp] lemma compl_map (f : α ≃o β) (s : upper_set α) :
+  (map f s).compl = lower_set.map f s.compl :=
+set_like.coe_injective (set.image_compl_eq f.bijective).symm
+
+end upper_set
+
+namespace lower_set
+
+@[simp] lemma compl_map (f : α ≃o β) (s : lower_set α) :
+  (map f s).compl = upper_set.map f s.compl :=
+set_like.coe_injective (set.image_compl_eq f.bijective).symm
+
+end lower_set
+
+end
+
+/-! #### Principal sets -/
+
+namespace upper_set
+section preorder
+variables [preorder α] [preorder β] {s : upper_set α} {a b : α}
+
+/-- The smallest upper set containing a given element. -/
+def Ici (a : α) : upper_set α := ⟨Ici a, is_upper_set_Ici a⟩
+
+/-- The smallest upper set containing a given element. -/
+def Ioi (a : α) : upper_set α := ⟨Ioi a, is_upper_set_Ioi a⟩
+
+@[simp] lemma coe_Ici (a : α) : ↑(Ici a) = set.Ici a := rfl
+@[simp] lemma coe_Ioi (a : α) : ↑(Ioi a) = set.Ioi a := rfl
+@[simp] lemma mem_Ici_iff : b ∈ Ici a ↔ a ≤ b := iff.rfl
+@[simp] lemma mem_Ioi_iff : b ∈ Ioi a ↔ a < b := iff.rfl
+@[simp] lemma map_Ici (f : α ≃o β) (a : α) : map f (Ici a) = Ici (f a) := by { ext, simp }
+@[simp] lemma map_Ioi (f : α ≃o β) (a : α) : map f (Ioi a) = Ioi (f a) := by { ext, simp }
+
+lemma Ici_le_Ioi (a : α) : Ici a ≤ Ioi a := Ioi_subset_Ici_self
+
+@[simp] lemma Ioi_top [order_top α] : Ioi (⊤ : α) = ⊤ := set_like.coe_injective Ioi_top
+@[simp] lemma Ici_bot [order_bot α] : Ici (⊥ : α) = ⊥ := set_like.coe_injective Ici_bot
+
+end preorder
+
+@[simp] lemma Ici_sup [semilattice_sup α] (a b : α) : Ici (a ⊔ b) = Ici a ⊔ Ici b :=
+ext Ici_inter_Ici.symm
+
+section complete_lattice
+variables [complete_lattice α]
+
+@[simp] lemma Ici_Sup (S : set α) : Ici (Sup S) = ⨆ a ∈ S, Ici a :=
+set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_supr_iff, Sup_le_iff]
+
+@[simp] lemma Ici_supr (f : ι → α) : Ici (⨆ i, f i) = ⨆ i, Ici (f i) :=
+set_like.ext $ λ c, by simp only [mem_Ici_iff, mem_supr_iff, supr_le_iff]
+
+@[simp] lemma Ici_supr₂ (f : Π i, κ i → α) : Ici (⨆ i j, f i j) = ⨆ i j, Ici (f i j) :=
+by simp_rw Ici_supr
+
+end complete_lattice
+end upper_set
+
+namespace lower_set
+section preorder
+variables [preorder α] [preorder β] {s : lower_set α} {a b : α}
+
+/-- Principal lower set. `set.Iic` as a lower set. The smallest lower set containing a given
+element. -/
+def Iic (a : α) : lower_set α := ⟨Iic a, is_lower_set_Iic a⟩
+
+/-- Strict principal lower set. `set.Iio` as a lower set. -/
+def Iio (a : α) : lower_set α := ⟨Iio a, is_lower_set_Iio a⟩
+
+@[simp] lemma coe_Iic (a : α) : ↑(Iic a) = set.Iic a := rfl
+@[simp] lemma coe_Iio (a : α) : ↑(Iio a) = set.Iio a := rfl
+@[simp] lemma mem_Iic_iff : b ∈ Iic a ↔ b ≤ a := iff.rfl
+@[simp] lemma mem_Iio_iff : b ∈ Iio a ↔ b < a := iff.rfl
+@[simp] lemma map_Iic (f : α ≃o β) (a : α) : map f (Iic a) = Iic (f a) := by { ext, simp }
+@[simp] lemma map_Iio (f : α ≃o β) (a : α) : map f (Iio a) = Iio (f a) := by { ext, simp }
+
+lemma Ioi_le_Ici (a : α) : Ioi a ≤ Ici a := Ioi_subset_Ici_self
+
+@[simp] lemma Iic_top [order_top α] : Iic (⊤ : α) = ⊤ := set_like.coe_injective Iic_top
+@[simp] lemma Iio_bot [order_bot α] : Iio (⊥ : α) = ⊥ := set_like.coe_injective Iio_bot
+
+end preorder
+
+@[simp] lemma Iic_inf [semilattice_inf α] (a b : α) : Iic (a ⊓ b) = Iic a ⊓ Iic b :=
+set_like.coe_injective Iic_inter_Iic.symm
+
+section complete_lattice
+variables [complete_lattice α]
+
+@[simp] lemma Iic_Inf (S : set α) : Iic (Inf S) = ⨅ a ∈ S, Iic a :=
+set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi₂_iff, le_Inf_iff]
+
+@[simp] lemma Iic_infi (f : ι → α) : Iic (⨅ i, f i) = ⨅ i, Iic (f i) :=
+set_like.ext $ λ c, by simp only [mem_Iic_iff, mem_infi_iff, le_infi_iff]
+
+@[simp] lemma Iic_infi₂ (f : Π i, κ i → α) : Iic (⨅ i j, f i j) = ⨅ i j, Iic (f i j) :=
+by simp_rw Iic_infi
+
+end complete_lattice
+end lower_set
+
+section closure
+variables [preorder α] [preorder β] {s t : set α} {x : α}
+
+/-- The greatest upper set containing a given set. -/
+def upper_closure (s : set α) : upper_set α :=
+⟨{x | ∃ a ∈ s, a ≤ x}, λ x y h, Exists₂.imp $ λ a _, h.trans'⟩
+
+/-- The least lower set containing a given set. -/
+def lower_closure (s : set α) : lower_set α :=
+⟨{x | ∃ a ∈ s, x ≤ a}, λ x y h, Exists₂.imp $ λ a _, h.trans⟩
+
+@[simp] lemma mem_upper_closure : x ∈ upper_closure s ↔ ∃ a ∈ s, a ≤ x := iff.rfl
+@[simp] lemma mem_lower_closure : x ∈ lower_closure s ↔ ∃ a ∈ s, x ≤ a := iff.rfl
+
+-- We do not tag those two as `simp` to respect the abstraction.
+@[norm_cast] lemma coe_upper_closure (s : set α) : ↑(upper_closure s) = ⋃ a ∈ s, Ici a :=
+by { ext, simp }
+@[norm_cast] lemma coe_lower_closure (s : set α) : ↑(lower_closure s) = ⋃ a ∈ s, Iic a :=
+by { ext, simp }
+
+lemma subset_upper_closure : s ⊆ upper_closure s := λ x hx, ⟨x, hx, le_rfl⟩
+lemma subset_lower_closure : s ⊆ lower_closure s := λ x hx, ⟨x, hx, le_rfl⟩
+
+lemma upper_closure_min (h : s ⊆ t) (ht : is_upper_set t) : ↑(upper_closure s) ⊆ t :=
+λ a ⟨b, hb, hba⟩, ht hba $ h hb
+
+lemma lower_closure_min (h : s ⊆ t) (ht : is_lower_set t) : ↑(lower_closure s) ⊆ t :=
+λ a ⟨b, hb, hab⟩, ht hab $ h hb
+
+protected lemma is_upper_set.upper_closure (hs : is_upper_set s) : ↑(upper_closure s) = s :=
+(upper_closure_min subset.rfl hs).antisymm subset_upper_closure
+
+protected lemma is_lower_set.lower_closure (hs : is_lower_set s) : ↑(lower_closure s) = s :=
+(lower_closure_min subset.rfl hs).antisymm subset_lower_closure
+
+@[simp] protected lemma upper_set.upper_closure (s : upper_set α) : upper_closure (s : set α) = s :=
+set_like.coe_injective s.2.upper_closure
+
+@[simp] protected lemma lower_set.lower_closure (s : lower_set α) : lower_closure (s : set α) = s :=
+set_like.coe_injective s.2.lower_closure
+
+@[simp] lemma upper_closure_image (f : α ≃o β) :
+  upper_closure (f '' s) = upper_set.map f (upper_closure s) :=
+begin
+  rw [←f.symm_symm, ←upper_set.symm_map, f.symm_symm],
+  ext,
+  simp [-upper_set.symm_map, upper_set.map, order_iso.symm, ←f.le_symm_apply],
+end
+
+@[simp] lemma lower_closure_image (f : α ≃o β) :
+  lower_closure (f '' s) = lower_set.map f (lower_closure s) :=
+begin
+  rw [←f.symm_symm, ←lower_set.symm_map, f.symm_symm],
+  ext,
+  simp [-lower_set.symm_map, lower_set.map, order_iso.symm, ←f.symm_apply_le],
+end
+
+@[simp] lemma upper_set.infi_Ici (s : set α) : (⨅ a ∈ s, upper_set.Ici a) = upper_closure s :=
+by { ext, simp }
+
+@[simp] lemma lower_set.supr_Iic (s : set α) : (⨆ a ∈ s, lower_set.Iic a) = lower_closure s :=
+by { ext, simp }
+
+lemma gc_upper_closure_coe :
+  galois_connection (to_dual ∘ upper_closure : set α → (upper_set α)ᵒᵈ) (coe ∘ of_dual) :=
+λ s t, ⟨λ h, subset_upper_closure.trans $ upper_set.coe_subset_coe.2 h,
+  λ h, upper_closure_min h t.upper⟩
+
+lemma gc_lower_closure_coe : galois_connection (lower_closure : set α → lower_set α) coe :=
+λ s t, ⟨λ h, subset_lower_closure.trans $ lower_set.coe_subset_coe.2 h,
+  λ h, lower_closure_min h t.lower⟩
+
+/-- `upper_closure` forms a reversed Galois insertion with the coercion from upper sets to sets. -/
+def gi_upper_closure_coe :
+  galois_insertion (to_dual ∘ upper_closure : set α → (upper_set α)ᵒᵈ) (coe ∘ of_dual) :=
+{ choice := λ s hs, to_dual (⟨s, λ a b hab ha, hs ⟨a, ha, hab⟩⟩ : upper_set α),
+  gc := gc_upper_closure_coe,
+  le_l_u := λ _, subset_upper_closure,
+  choice_eq := λ s hs,
+    of_dual.injective $ set_like.coe_injective $ subset_upper_closure.antisymm hs }
+
+/-- `lower_closure` forms a Galois insertion with the coercion from lower sets to sets. -/
+def gi_lower_closure_coe : galois_insertion (lower_closure : set α → lower_set α) coe :=
+{ choice := λ s hs, ⟨s, λ a b hba ha, hs ⟨a, ha, hba⟩⟩,
+  gc := gc_lower_closure_coe,
+  le_l_u := λ _, subset_lower_closure,
+  choice_eq := λ s hs, set_like.coe_injective $ subset_lower_closure.antisymm hs }
+
+lemma upper_closure_anti : antitone (upper_closure : set α → upper_set α) :=
+gc_upper_closure_coe.monotone_l
+
+lemma lower_closure_mono : monotone (lower_closure : set α → lower_set α) :=
+gc_lower_closure_coe.monotone_l
+
+@[simp] lemma upper_closure_empty : upper_closure (∅ : set α) = ⊤ := by { ext, simp }
+@[simp] lemma lower_closure_empty : lower_closure (∅ : set α) = ⊥ := by { ext, simp }
+
+@[simp] lemma upper_closure_singleton (a : α) : upper_closure ({a} : set α) = upper_set.Ici a :=
+by { ext, simp }
+
+@[simp] lemma lower_closure_singleton (a : α) : lower_closure ({a} : set α) = lower_set.Iic a :=
+by { ext, simp }
+
+@[simp] lemma upper_closure_univ : upper_closure (univ : set α) = ⊥ :=
+le_bot_iff.1 subset_upper_closure
+
+@[simp] lemma lower_closure_univ : lower_closure (univ : set α) = ⊤ :=
+top_le_iff.1 subset_lower_closure
+
+@[simp] lemma upper_closure_eq_top_iff : upper_closure s = ⊤ ↔ s = ∅ :=
+⟨λ h, subset_empty_iff.1 $ subset_upper_closure.trans (congr_arg coe h).subset,
+  by { rintro rfl, exact upper_closure_empty }⟩
+
+@[simp] lemma lower_closure_eq_bot_iff : lower_closure s = ⊥ ↔ s = ∅ :=
+⟨λ h, subset_empty_iff.1 $ subset_lower_closure.trans (congr_arg coe h).subset,
+  by { rintro rfl, exact lower_closure_empty }⟩
+
+@[simp] lemma upper_closure_union (s t : set α) :
+  upper_closure (s ∪ t) = upper_closure s ⊓ upper_closure t :=
+by { ext, simp [or_and_distrib_right, exists_or_distrib] }
+
+@[simp] lemma lower_closure_union (s t : set α) :
+  lower_closure (s ∪ t) = lower_closure s ⊔ lower_closure t :=
+by { ext, simp [or_and_distrib_right, exists_or_distrib] }
+
+@[simp] lemma upper_closure_Union (f : ι → set α) :
+  upper_closure (⋃ i, f i) = ⨅ i, upper_closure (f i) :=
+by { ext, simp [←exists_and_distrib_right, @exists_comm α] }
+
+@[simp] lemma lower_closure_Union (f : ι → set α) :
+  lower_closure (⋃ i, f i) = ⨆ i, lower_closure (f i) :=
+by { ext, simp [←exists_and_distrib_right, @exists_comm α] }
+
+@[simp] lemma upper_closure_sUnion (S : set (set α)) :
+  upper_closure (⋃₀ S) = ⨅ s ∈ S, upper_closure s :=
+by simp_rw [sUnion_eq_bUnion, upper_closure_Union]
+
+@[simp] lemma lower_closure_sUnion (S : set (set α)) :
+  lower_closure (⋃₀ S) = ⨆ s ∈ S, lower_closure s :=
+by simp_rw [sUnion_eq_bUnion, lower_closure_Union]
+
+lemma set.ord_connected.upper_closure_inter_lower_closure (h : s.ord_connected) :
+  ↑(upper_closure s) ∩ ↑(lower_closure s) = s :=
+(subset_inter subset_upper_closure subset_lower_closure).antisymm' $ λ a ⟨⟨b, hb, hba⟩, c, hc, hac⟩,
+  h.out hb hc ⟨hba, hac⟩
+
+lemma ord_connected_iff_upper_closure_inter_lower_closure :
+  s.ord_connected ↔ ↑(upper_closure s) ∩ ↑(lower_closure s) = s :=
+begin
+  refine ⟨set.ord_connected.upper_closure_inter_lower_closure, λ h, _⟩,
+  rw ←h,
+  exact (upper_set.upper _).ord_connected.inter (lower_set.lower _).ord_connected,
+end
+
+@[simp] lemma upper_bounds_lower_closure :
+  upper_bounds (lower_closure s : set α) = upper_bounds s :=
+(upper_bounds_mono_set subset_lower_closure).antisymm $ λ a ha b ⟨c, hc, hcb⟩, hcb.trans $ ha hc
+
+@[simp] lemma lower_bounds_upper_closure :
+  lower_bounds (upper_closure s : set α) = lower_bounds s :=
+(lower_bounds_mono_set subset_upper_closure).antisymm $ λ a ha b ⟨c, hc, hcb⟩, (ha hc).trans hcb
+
+@[simp] lemma bdd_above_lower_closure : bdd_above (lower_closure s : set α) ↔ bdd_above s :=
+by simp_rw [bdd_above, upper_bounds_lower_closure]
+
+@[simp] lemma bdd_below_upper_closure : bdd_below (upper_closure s : set α) ↔ bdd_below s :=
+by simp_rw [bdd_below, lower_bounds_upper_closure]
+
+alias bdd_above_lower_closure ↔ bdd_above.of_lower_closure bdd_above.lower_closure
+alias bdd_below_upper_closure ↔ bdd_below.of_upper_closure bdd_below.upper_closure
+
+attribute [protected] bdd_above.lower_closure bdd_below.upper_closure
+
+end closure
+
+/-! ### Product -/
+
+section preorder
+variables [preorder α] [preorder β]
+
+section
+variables {s : set α} {t : set β} {x : α × β}
+
+lemma is_upper_set.prod (hs : is_upper_set s) (ht : is_upper_set t) : is_upper_set (s ×ˢ t) :=
+λ a b h ha, ⟨hs h.1 ha.1, ht h.2 ha.2⟩
+
+lemma is_lower_set.prod (hs : is_lower_set s) (ht : is_lower_set t) : is_lower_set (s ×ˢ t) :=
+λ a b h ha, ⟨hs h.1 ha.1, ht h.2 ha.2⟩
+
+end
+
+namespace upper_set
+variables (s s₁ s₂ : upper_set α) (t t₁ t₂ : upper_set β) {x : α × β}
+
+/-- The product of two upper sets as an upper set. -/
+def prod : upper_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩
+
+infixr (name := upper_set.prod) ` ×ˢ `:82 := prod
+
+@[simp, norm_cast] lemma coe_prod : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := rfl
+
+@[simp] lemma mem_prod {s : upper_set α} {t : upper_set β} : x ∈ s ×ˢ t ↔ x.1 ∈ s ∧ x.2 ∈ t :=
+iff.rfl
+
+lemma Ici_prod (x : α × β) : Ici x = Ici x.1 ×ˢ Ici x.2 := rfl
+@[simp] lemma Ici_prod_Ici (a : α) (b : β) : Ici a ×ˢ Ici b = Ici (a, b) := rfl
+
+@[simp] lemma prod_top : s ×ˢ (⊤ : upper_set β) = ⊤ := ext prod_empty
+@[simp] lemma top_prod : (⊤ : upper_set α) ×ˢ t = ⊤ := ext empty_prod
+@[simp] lemma bot_prod_bot : (⊥ : upper_set α) ×ˢ (⊥ : upper_set β) = ⊥ := ext univ_prod_univ
+@[simp] lemma sup_prod : (s₁ ⊔ s₂) ×ˢ t = s₁ ×ˢ t ⊔ s₂ ×ˢ t := ext inter_prod
+@[simp] lemma prod_sup : s ×ˢ (t₁ ⊔ t₂) = s ×ˢ t₁ ⊔ s ×ˢ t₂ := ext prod_inter
+@[simp] lemma inf_prod : (s₁ ⊓ s₂) ×ˢ t = s₁ ×ˢ t ⊓ s₂ ×ˢ t := ext union_prod
+@[simp] lemma prod_inf : s ×ˢ (t₁ ⊓ t₂) = s ×ˢ t₁ ⊓ s ×ˢ t₂ := ext prod_union
+lemma prod_sup_prod : s₁ ×ˢ t₁ ⊔ s₂ ×ˢ t₂ = (s₁ ⊔ s₂) ×ˢ (t₁ ⊔ t₂) := ext prod_inter_prod
+
+variables {s s₁ s₂ t t₁ t₂}
+
+lemma prod_mono : s₁ ≤ s₂ → t₁ ≤ t₂ → s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ := prod_mono
+lemma prod_mono_left : s₁ ≤ s₂ → s₁ ×ˢ t ≤ s₂ ×ˢ t := prod_mono_left
+lemma prod_mono_right : t₁ ≤ t₂ → s ×ˢ t₁ ≤ s ×ˢ t₂ := prod_mono_right
+
+@[simp] lemma prod_self_le_prod_self : s₁ ×ˢ s₁ ≤ s₂ ×ˢ s₂ ↔ s₁ ≤ s₂ := prod_self_subset_prod_self
+@[simp] lemma prod_self_lt_prod_self : s₁ ×ˢ s₁ < s₂ ×ˢ s₂ ↔ s₁ < s₂ := prod_self_ssubset_prod_self
+
+lemma prod_le_prod_iff : s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ ↔ s₁ ≤ s₂ ∧ t₁ ≤ t₂ ∨ s₂ = ⊤ ∨ t₂ = ⊤ :=
+prod_subset_prod_iff.trans $ by simp
+
+@[simp] lemma prod_eq_top : s ×ˢ t = ⊤ ↔ s = ⊤ ∨ t = ⊤ :=
+by { simp_rw set_like.ext'_iff, exact prod_eq_empty_iff }
+
+@[simp] lemma codisjoint_prod :
+  codisjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ codisjoint s₁ s₂ ∨ codisjoint t₁ t₂ :=
+by simp_rw [codisjoint_iff, prod_sup_prod, prod_eq_top]
+
+end upper_set
+
+namespace lower_set
+variables (s s₁ s₂ : lower_set α) (t t₁ t₂ : lower_set β) {x : α × β}
+
+/-- The product of two lower sets as a lower set. -/
+def prod : lower_set (α × β) := ⟨s ×ˢ t, s.2.prod t.2⟩
+
+infixr (name := lower_set.prod) ` ×ˢ `:82 := lower_set.prod
+
+@[simp, norm_cast] lemma coe_prod : (↑(s ×ˢ t) : set (α × β)) = s ×ˢ t := rfl
+
+@[simp] lemma mem_prod {s : lower_set α} {t : lower_set β} : x ∈ s ×ˢ t ↔ x.1 ∈ s ∧ x.2 ∈ t :=
+iff.rfl
+
+lemma Iic_prod (x : α × β) : Iic x = Iic x.1 ×ˢ Iic x.2 := rfl
+@[simp] lemma Ici_prod_Ici (a : α) (b : β) : Iic a ×ˢ Iic b = Iic (a, b) := rfl
+
+@[simp] lemma prod_bot : s ×ˢ (⊥ : lower_set β) = ⊥ := ext prod_empty
+@[simp] lemma bot_prod : (⊥ : lower_set α) ×ˢ t = ⊥ := ext empty_prod
+@[simp] lemma top_prod_top : (⊤ : lower_set α) ×ˢ (⊤ : lower_set β) = ⊤ := ext univ_prod_univ
+@[simp] lemma inf_prod : (s₁ ⊓ s₂) ×ˢ t = s₁ ×ˢ t ⊓ s₂ ×ˢ t := ext inter_prod
+@[simp] lemma prod_inf : s ×ˢ (t₁ ⊓ t₂) = s ×ˢ t₁ ⊓ s ×ˢ t₂ := ext prod_inter
+@[simp] lemma sup_prod : (s₁ ⊔ s₂) ×ˢ t = s₁ ×ˢ t ⊔ s₂ ×ˢ t := ext union_prod
+@[simp] lemma prod_sup : s ×ˢ (t₁ ⊔ t₂) = s ×ˢ t₁ ⊔ s ×ˢ t₂ := ext prod_union
+lemma prod_inf_prod : s₁ ×ˢ t₁ ⊓ s₂ ×ˢ t₂ = (s₁ ⊓ s₂) ×ˢ (t₁ ⊓ t₂) := ext prod_inter_prod
+
+variables {s s₁ s₂ t t₁ t₂}
+
+lemma prod_mono : s₁ ≤ s₂ → t₁ ≤ t₂ → s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ := prod_mono
+lemma prod_mono_left : s₁ ≤ s₂ → s₁ ×ˢ t ≤ s₂ ×ˢ t := prod_mono_left
+lemma prod_mono_right : t₁ ≤ t₂ → s ×ˢ t₁ ≤ s ×ˢ t₂ := prod_mono_right
+
+@[simp] lemma prod_self_le_prod_self : s₁ ×ˢ s₁ ≤ s₂ ×ˢ s₂ ↔ s₁ ≤ s₂ := prod_self_subset_prod_self
+@[simp] lemma prod_self_lt_prod_self : s₁ ×ˢ s₁ < s₂ ×ˢ s₂ ↔ s₁ < s₂ := prod_self_ssubset_prod_self
+
+lemma prod_le_prod_iff : s₁ ×ˢ t₁ ≤ s₂ ×ˢ t₂ ↔ s₁ ≤ s₂ ∧ t₁ ≤ t₂ ∨ s₁ = ⊥ ∨ t₁ = ⊥ :=
+prod_subset_prod_iff.trans $ by simp
+
+@[simp] lemma prod_eq_bot : s ×ˢ t = ⊥ ↔ s = ⊥ ∨ t = ⊥ :=
+by { simp_rw set_like.ext'_iff, exact prod_eq_empty_iff }
+
+@[simp] lemma disjoint_prod : disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ disjoint s₁ s₂ ∨ disjoint t₁ t₂ :=
+by simp_rw [disjoint_iff, prod_inf_prod, prod_eq_bot]
+
+end lower_set
+
+@[simp] lemma upper_closure_prod (s : set α) (t : set β) :
+  upper_closure (s ×ˢ t) = upper_closure s ×ˢ upper_closure t :=
+by { ext, simp [prod.le_def, and_and_and_comm _ (_ ∈ t)] }
+
+@[simp] lemma lower_closure_prod (s : set α) (t : set β) :
+  lower_closure (s ×ˢ t) = lower_closure s ×ˢ lower_closure t :=
+by { ext, simp [prod.le_def, and_and_and_comm _ (_ ∈ t)] }
+
+end preorder
diff --git a/src/order/upper_lower/hom.lean b/src/order/upper_lower/hom.lean
new file mode 100644
index 0000000000000..99096745ac062
--- /dev/null
+++ b/src/order/upper_lower/hom.lean
@@ -0,0 +1,68 @@
+/-
+Copyright (c) 2022 Yaël Dillies, Sara Rousta. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.upper_lower.basic
+import order.hom.complete_lattice
+
+/-!
+# `upper_set.Ici` etc as `sup`/`Sup`/`inf`/`Inf`-homomorphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define `upper_set.Ici_sup_hom` etc. These functions are `upper_set.Ici` and
+`lower_set.Iic` bundled as `sup_hom`s, `inf_hom`s, `Sup_hom`s, or `Inf_hom`s.
+-/
+
+variable {α : Type*}
+open order_dual
+
+namespace upper_set
+
+section semilattice_sup
+
+variable [semilattice_sup α]
+
+/-- `upper_set.Ici` as a `sup_hom`. -/
+def Ici_sup_hom : sup_hom α (upper_set α) := ⟨Ici, Ici_sup⟩
+
+@[simp] lemma coe_Ici_sup_hom : (Ici_sup_hom : α → upper_set α) = Ici := rfl
+@[simp] lemma Ici_sup_hom_apply (a : α) : Ici_sup_hom a = (Ici a) := rfl
+
+end semilattice_sup
+
+variable [complete_lattice α]
+
+/-- `upper_set.Ici` as a `Sup_hom`. -/
+def Ici_Sup_hom : Sup_hom α (upper_set α) := ⟨Ici, λ s, (Ici_Sup s).trans Sup_image.symm⟩
+
+@[simp] lemma coe_Ici_Sup_hom : (Ici_Sup_hom : α → upper_set α) = Ici := rfl
+@[simp] lemma Ici_Sup_hom_apply (a : α) : Ici_Sup_hom a = Ici a := rfl
+
+end upper_set
+
+namespace lower_set
+
+section semilattice_inf
+
+variable [semilattice_inf α]
+
+/-- `lower_set.Iic` as an `inf_hom`. -/
+def Iic_inf_hom : inf_hom α (lower_set α) := ⟨Iic, Iic_inf⟩
+
+@[simp] lemma coe_Iic_inf_hom : (Iic_inf_hom : α → lower_set α) = Iic := rfl
+@[simp] lemma Iic_inf_hom_apply (a : α) : Iic_inf_hom a = Iic a := rfl
+
+end semilattice_inf
+
+variable [complete_lattice α]
+
+/-- `lower_set.Iic` as an `Inf_hom`. -/
+def Iic_Inf_hom : Inf_hom α (lower_set α) := ⟨Iic, λ s, (Iic_Inf s).trans Inf_image.symm⟩
+
+@[simp] lemma coe_Iic_Inf_hom : (Iic_Inf_hom : α → lower_set α) = Iic := rfl
+@[simp] lemma Iic_Inf_hom_apply (a : α) : Iic_Inf_hom a = Iic a := rfl
+
+end lower_set
diff --git a/src/order/upper_lower/locally_finite.lean b/src/order/upper_lower/locally_finite.lean
new file mode 100644
index 0000000000000..87855c6b90aa0
--- /dev/null
+++ b/src/order/upper_lower/locally_finite.lean
@@ -0,0 +1,29 @@
+/-
+Copyright (c) 2023 Yaël Dillies, Sara Rousta. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import order.locally_finite
+import order.upper_lower.basic
+
+/-!
+# Upper and lower sets in a locally finite order
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we characterise the interaction of `upper_set`/`lower_set` and `locally_finite_order`.
+-/
+
+namespace set
+variables {α : Type*} [preorder α] {s : set α}
+
+protected lemma finite.upper_closure [locally_finite_order_top α] (hs : s.finite) :
+  (upper_closure s : set α).finite :=
+by { rw coe_upper_closure, exact hs.bUnion (λ _ _, finite_Ici _) }
+
+protected lemma finite.lower_closure [locally_finite_order_bot α] (hs : s.finite) :
+  (lower_closure s : set α).finite :=
+by { rw coe_lower_closure, exact hs.bUnion (λ _ _, finite_Iic _) }
+
+end set
diff --git a/src/order/well_founded.lean b/src/order/well_founded.lean
index 2323747cf163d..40aaca54853a1 100644
--- a/src/order/well_founded.lean
+++ b/src/order/well_founded.lean
@@ -4,40 +4,41 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Mario Carneiro
 -/
 import tactic.by_contra
-import data.set.basic
+import data.set.image
 
 /-!
 # Well-founded relations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A relation is well-founded if it can be used for induction: for each `x`, `(∀ y, r y x → P y) → P x`
 implies `P x`. Well-founded relations can be used for induction and recursion, including
 construction of fixed points in the space of dependent functions `Π x : α , β x`.
 
 The predicate `well_founded` is defined in the core library. In this file we prove some extra lemmas
-and provide a few new definitions: `well_founded.min`, `well_founded.sup`, and `well_founded.succ`.
+and provide a few new definitions: `well_founded.min`, `well_founded.sup`, and `well_founded.succ`,
+and an induction principle `well_founded.induction_bot`.
 -/
 
-variables {α : Type*}
+variables {α β γ : Type*}
 
 namespace well_founded
+variables {r r' : α → α → Prop}
 
-theorem not_gt_of_lt {α : Sort*} {r : α → α → Prop} (h : well_founded r) :
-  ∀ ⦃a b⦄, r a b → ¬ r b a
-| a := λ b hab hba, not_gt_of_lt hba hab
-using_well_founded { rel_tac := λ _ _, `[exact ⟨_, h⟩],
-                     dec_tac := tactic.assumption }
+protected theorem is_asymm (h : well_founded r) : is_asymm α r := ⟨h.asymmetric⟩
 
-protected theorem is_asymm {α : Sort*} {r : α → α → Prop} (h : well_founded r) : is_asymm α r :=
-⟨h.not_gt_of_lt⟩
+protected theorem is_irrefl (h : well_founded r) : is_irrefl α r :=
+(@is_asymm.is_irrefl α r h.is_asymm)
 
-instance {α : Sort*} [has_well_founded α] : is_asymm α has_well_founded.r :=
-has_well_founded.wf.is_asymm
+instance [has_well_founded α] : is_asymm α has_well_founded.r := has_well_founded.wf.is_asymm
+instance [has_well_founded α] : is_irrefl α has_well_founded.r := is_asymm.is_irrefl
 
-protected theorem is_irrefl {α : Sort*} {r : α → α → Prop} (h : well_founded r) : is_irrefl α r :=
-(@is_asymm.is_irrefl α r h.is_asymm)
+lemma mono (hr : well_founded r) (h : ∀ a b, r' a b → r a b) : well_founded r' :=
+subrelation.wf h hr
 
-instance {α : Sort*} [has_well_founded α] : is_irrefl α has_well_founded.r :=
-is_asymm.is_irrefl
+lemma on_fun {α β : Sort*} {r : β → β → Prop} {f : α → β} :
+  well_founded r → well_founded (r on f) := inv_image.wf _
 
 /-- If `r` is a well-founded relation, then any nonempty set has a minimal element
 with respect to `r`. -/
@@ -46,56 +47,34 @@ theorem has_min {α} {r : α → α → Prop} (H : well_founded r)
 | ⟨a, ha⟩ := (acc.rec_on (H.apply a) $ λ x _ IH, not_imp_not.1 $ λ hne hx, hne $
   ⟨x, hx, λ y hy hyx, hne $ IH y hyx hy⟩) ha
 
-/-- A minimal element of a nonempty set in a well-founded order -/
+/-- A minimal element of a nonempty set in a well-founded order.
+
+If you're working with a nonempty linear order, consider defining a
+`conditionally_complete_linear_order_bot` instance via
+`well_founded.conditionally_complete_linear_order_with_bot` and using `Inf` instead. -/
 noncomputable def min {r : α → α → Prop} (H : well_founded r)
-  (p : set α) (h : p.nonempty) : α :=
-classical.some (H.has_min p h)
+  (s : set α) (h : s.nonempty) : α :=
+classical.some (H.has_min s h)
 
 theorem min_mem {r : α → α → Prop} (H : well_founded r)
-  (p : set α) (h : p.nonempty) : H.min p h ∈ p :=
-let ⟨h, _⟩ := classical.some_spec (H.has_min p h) in h
+  (s : set α) (h : s.nonempty) : H.min s h ∈ s :=
+let ⟨h, _⟩ := classical.some_spec (H.has_min s h) in h
 
 theorem not_lt_min {r : α → α → Prop} (H : well_founded r)
-  (p : set α) (h : p.nonempty) {x} (xp : x ∈ p) : ¬ r x (H.min p h) :=
-let ⟨_, h'⟩ := classical.some_spec (H.has_min p h) in h' _ xp
+  (s : set α) (h : s.nonempty) {x} (hx : x ∈ s) : ¬ r x (H.min s h) :=
+let ⟨_, h'⟩ := classical.some_spec (H.has_min s h) in h' _ hx
 
 theorem well_founded_iff_has_min {r : α → α → Prop} : (well_founded r) ↔
-  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, ¬ r x m :=
-begin
-  classical,
-  split,
-  { exact has_min, },
-  { set counterexamples := { x : α | ¬ acc r x},
-    intro exists_max,
-    fconstructor,
-    intro x,
-    by_contra hx,
-    obtain ⟨m, m_mem, hm⟩ := exists_max counterexamples ⟨x, hx⟩,
-    refine m_mem (acc.intro _ ( λ y y_gt_m, _)),
-    by_contra hy,
-    exact hm y hy y_gt_m, },
-end
-
-lemma eq_iff_not_lt_of_le {α} [partial_order α] {x y : α} : x ≤ y → y = x ↔ ¬ x < y :=
+  ∀ (s : set α), s.nonempty → ∃ m ∈ s, ∀ x ∈ s, ¬ r x m :=
 begin
-  split,
-  { intros xle nge,
-    cases le_not_le_of_lt nge,
-    rw xle left at nge,
-    exact lt_irrefl x nge },
-  { intros ngt xle,
-    contrapose! ngt,
-    exact lt_of_le_of_ne xle (ne.symm ngt) }
+  refine ⟨λ h, h.has_min, λ h, ⟨λ x, _⟩⟩,
+  by_contra hx,
+  obtain ⟨m, hm, hm'⟩ := h _ ⟨x, hx⟩,
+  refine hm ⟨_, λ y hy, _⟩,
+  by_contra hy',
+  exact hm' y hy' hy
 end
 
-theorem well_founded_iff_has_max' [partial_order α] : (well_founded ((>) : α → α → Prop) ↔
-  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, m ≤ x → x = m) :=
-by simp only [eq_iff_not_lt_of_le, well_founded_iff_has_min]
-
-theorem well_founded_iff_has_min' [partial_order α] : (well_founded (has_lt.lt : α → α → Prop)) ↔
-  ∀ (p : set α), p.nonempty → ∃ m ∈ p, ∀ x ∈ p, x ≤ m → x = m :=
-@well_founded_iff_has_max' αᵒᵈ _
-
 open set
 /-- The supremum of a bounded, well-founded order -/
 protected noncomputable def sup {r : α → α → Prop} (wf : well_founded r) (s : set α)
@@ -134,8 +113,11 @@ end
 
 section linear_order
 
-variables {β : Type*} [linear_order β] (h : well_founded ((<) : β → β → Prop))
-  {γ : Type*} [partial_order γ]
+variables [linear_order β] (h : well_founded ((<) : β → β → Prop)) [partial_order γ]
+
+theorem min_le {x : β} {s : set β} (hx : x ∈ s) (hne : s.nonempty := ⟨x, hx⟩) :
+  h.min s hne ≤ x :=
+not_lt.1 $ h.not_lt_min _ _ hx
 
 private theorem eq_strict_mono_iff_eq_range_aux {f g : β → γ} (hf : strict_mono f)
   (hg : strict_mono g) (hfg : set.range f = set.range g) {b : β} (H : ∀ a < b, f a = g a) :
@@ -161,16 +143,15 @@ theorem eq_strict_mono_iff_eq_range {f g : β → γ} (hf : strict_mono f)
     (eq_strict_mono_iff_eq_range_aux hg hf hfg.symm (λ a hab, (H a hab).symm))
 end, congr_arg _⟩
 
-theorem self_le_of_strict_mono {φ : β → β} (hφ : strict_mono φ) : ∀ n, n ≤ φ n :=
-by { by_contra' h₁, have h₂ := h.min_mem _ h₁, exact h.not_lt_min _ h₁ (hφ h₂) h₂ }
+theorem self_le_of_strict_mono {f : β → β} (hf : strict_mono f) : ∀ n, n ≤ f n :=
+by { by_contra' h₁, have h₂ := h.min_mem _ h₁, exact h.not_lt_min _ h₁ (hf h₂) h₂ }
 
 end linear_order
 
 end well_founded
 
 namespace function
-
-variables {β : Type*} (f : α → β)
+variables (f : α → β)
 
 section has_lt
 
@@ -215,3 +196,48 @@ not_lt.mp $ not_lt_argmin_on f h s ha hs
 end linear_order
 
 end function
+
+section induction
+
+/-- Let `r` be a relation on `α`, let `f : α → β` be a function, let `C : β → Prop`, and
+let `bot : α`. This induction principle shows that `C (f bot)` holds, given that
+* some `a` that is accessible by `r` satisfies `C (f a)`, and
+* for each `b` such that `f b ≠ f bot` and `C (f b)` holds, there is `c`
+  satisfying `r c b` and `C (f c)`. -/
+lemma acc.induction_bot' {α β} {r : α → α → Prop} {a bot : α} (ha : acc r a) {C : β → Prop}
+  {f : α → β} (ih : ∀ b, f b ≠ f bot → C (f b) → ∃ c, r c b ∧ C (f c)) : C (f a) → C (f bot) :=
+@acc.rec_on _ _ (λ x, C (f x) → C (f bot)) _ ha $ λ x ac ih' hC,
+  (eq_or_ne (f x) (f bot)).elim (λ h, h ▸ hC)
+    (λ h, let ⟨y, hy₁, hy₂⟩ := ih x h hC in ih' y hy₁ hy₂)
+
+/-- Let `r` be a relation on `α`, let `C : α → Prop` and let `bot : α`.
+This induction principle shows that `C bot` holds, given that
+* some `a` that is accessible by `r` satisfies `C a`, and
+* for each `b ≠ bot` such that `C b` holds, there is `c` satisfying `r c b` and `C c`. -/
+lemma acc.induction_bot {α} {r : α → α → Prop} {a bot : α} (ha : acc r a)
+  {C : α → Prop} (ih : ∀ b, b ≠ bot → C b → ∃ c, r c b ∧ C c) : C a → C bot :=
+ha.induction_bot' ih
+
+/-- Let `r` be a well-founded relation on `α`, let `f : α → β` be a function,
+let `C : β → Prop`, and  let `bot : α`.
+This induction principle shows that `C (f bot)` holds, given that
+* some `a` satisfies `C (f a)`, and
+* for each `b` such that `f b ≠ f bot` and `C (f b)` holds, there is `c`
+  satisfying `r c b` and `C (f c)`. -/
+lemma well_founded.induction_bot' {α β} {r : α → α → Prop} (hwf : well_founded r) {a bot : α}
+  {C : β → Prop} {f : α → β} (ih : ∀ b, f b ≠ f bot → C (f b) → ∃ c, r c b ∧ C (f c)) :
+  C (f a) → C (f bot) :=
+(hwf.apply a).induction_bot' ih
+
+/-- Let `r` be a well-founded relation on `α`, let `C : α → Prop`, and let `bot : α`.
+This induction principle shows that `C bot` holds, given that
+* some `a` satisfies `C a`, and
+* for each `b` that satisfies `C b`, there is `c` satisfying `r c b` and `C c`.
+
+The naming is inspired by the fact that when `r` is transitive, it follows that `bot` is
+the smallest element w.r.t. `r` that satisfies `C`. -/
+lemma well_founded.induction_bot {α} {r : α → α → Prop} (hwf : well_founded r) {a bot : α}
+  {C : α → Prop} (ih : ∀ b, b ≠ bot → C b → ∃ c, r c b ∧ C c) : C a → C bot :=
+hwf.induction_bot' ih
+
+end induction
diff --git a/src/order/well_founded_set.lean b/src/order/well_founded_set.lean
index 93e24066cdf74..d3c122a549c21 100644
--- a/src/order/well_founded_set.lean
+++ b/src/order/well_founded_set.lean
@@ -3,14 +3,18 @@ Copyright (c) 2021 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
-import data.set.pointwise
+import data.sigma.lex
 import order.antichain
 import order.order_iso_nat
 import order.well_founded
+import tactic.tfae
 
 /-!
 # Well-founded sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A well-founded subset of an ordered type is one on which the relation `<` is well-founded.
 
 ## Main Definitions
@@ -19,14 +23,8 @@ A well-founded subset of an ordered type is one on which the relation `<` is wel
  * `set.is_wf s` indicates that `<` is well-founded when restricted to `s`.
  * `set.partially_well_ordered_on s r` indicates that the relation `r` is
   partially well-ordered (also known as well quasi-ordered) when restricted to the set `s`.
- * `set.is_pwo s` indicates that any infinite sequence of elements in `s`
-  contains an infinite monotone subsequence. Note that
-
-### Definitions for Hahn Series
- * `set.add_antidiagonal s t a` and `set.mul_antidiagonal s t a` are the sets of pairs of elements
-  from `s` and `t` that add/multiply to `a`.
- * `finset.add_antidiagonal` and `finset.mul_antidiagonal` are finite versions of
-  `set.add_antidiagonal` and `set.mul_antidiagonal` defined when `s` and `t` are well-founded.
+ * `set.is_pwo s` indicates that any infinite sequence of elements in `s` contains an infinite
+  monotone subsequence. Note that this is equivalent to containing only two comparable elements.
 
 ## Main Results
  * Higman's Lemma, `set.partially_well_ordered_on.partially_well_ordered_on_sublist_forall₂`,
@@ -48,17 +46,25 @@ Prove that `s` is partial well ordered iff it has no infinite descending chain o
  * [Nash-Williams, *On Well-Quasi-Ordering Finite Trees*][Nash-Williams63]
 -/
 
-open_locale pointwise
-
-variables {α : Type*}
+variables {ι α β γ : Type*} {π : ι → Type*}
 
 namespace set
 
+/-! ### Relations well-founded on sets -/
+
 /-- `s.well_founded_on r` indicates that the relation `r` is well-founded when restricted to `s`. -/
-def well_founded_on (s : set α) (r : α → α → Prop) : Prop :=
-well_founded (λ (a : s) (b : s), r a b)
+def well_founded_on (s : set α) (r : α → α → Prop) : Prop := well_founded $ λ a b : s, r a b
+
+@[simp] lemma well_founded_on_empty (r : α → α → Prop) : well_founded_on ∅ r :=
+well_founded_of_empty _
+
+section well_founded_on
+variables {r r' : α → α → Prop}
 
-lemma well_founded_on_iff {s : set α} {r : α → α → Prop} :
+section any_rel
+variables {f : β → α} {s t : set α} {x y : α}
+
+lemma well_founded_on_iff :
   s.well_founded_on r ↔ well_founded (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
 begin
   have f : rel_embedding (λ (a : s) (b : s), r a b) (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
@@ -68,181 +74,249 @@ begin
   intros t ht,
   by_cases hst : (s ∩ t).nonempty,
   { rw ← subtype.preimage_coe_nonempty at hst,
-    rcases well_founded.well_founded_iff_has_min.1 h (coe ⁻¹' t) hst with ⟨⟨m, ms⟩, mt, hm⟩,
+    rcases h.has_min (coe ⁻¹' t) hst with ⟨⟨m, ms⟩, mt, hm⟩,
     exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hm ⟨x, xs⟩ xt xm⟩ },
   { rcases ht with ⟨m, mt⟩,
     exact ⟨m, mt, λ x xt ⟨xm, xs, ms⟩, hst ⟨m, ⟨ms, mt⟩⟩⟩ }
 end
 
-lemma well_founded_on.induction {s : set α} {r : α → α → Prop} (hs : s.well_founded_on r) {x : α}
-  (hx : x ∈ s) {P : α → Prop} (hP : ∀ (y ∈ s), (∀ (z ∈ s), r z y → P z) → P y) :
-  P x :=
+@[simp] lemma well_founded_on_univ : (univ : set α).well_founded_on r ↔ well_founded r :=
+by simp [well_founded_on_iff]
+
+lemma _root_.well_founded.well_founded_on  : well_founded r → s.well_founded_on r := inv_image.wf _
+
+@[simp] lemma well_founded_on_range : (range f).well_founded_on r ↔ well_founded (r on f) :=
+begin
+  let f' : β → range f := λ c, ⟨f c, c, rfl⟩,
+  refine ⟨λ h, (inv_image.wf f' h).mono $ λ c c', id, λ h, ⟨_⟩⟩,
+  rintro ⟨_, c, rfl⟩,
+  refine acc.of_downward_closed f' _ _ (_),
+  { rintro _ ⟨_, c', rfl⟩ -,
+    exact ⟨c', rfl⟩ },
+  { exact h.apply _ }
+end
+
+@[simp] lemma well_founded_on_image {s : set β} :
+  (f '' s).well_founded_on r ↔ s.well_founded_on (r on f) :=
+by { rw image_eq_range, exact well_founded_on_range }
+
+namespace well_founded_on
+
+protected lemma induction (hs : s.well_founded_on r) (hx : x ∈ s) {P : α → Prop}
+  (hP : ∀ y ∈ s, (∀ z ∈ s, r z y → P z) → P y) : P x :=
 begin
   let Q : s → Prop := λ y, P y,
   change Q ⟨x, hx⟩,
   refine well_founded.induction hs ⟨x, hx⟩ _,
-  rintros ⟨y, ys⟩ ih,
-  exact hP _ ys (λ z zs zy, ih ⟨z, zs⟩ zy),
+  simpa only [subtype.forall]
 end
 
-instance is_strict_order.subset {s : set α} {r : α → α → Prop} [is_strict_order α r] :
-  is_strict_order α (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
+protected lemma mono (h : t.well_founded_on r') (hle : r ≤ r') (hst : s ⊆ t) :
+  s.well_founded_on r :=
+begin
+  rw well_founded_on_iff at *,
+  refine subrelation.wf (λ x y xy, _) h,
+  exact ⟨hle _ _ xy.1, hst xy.2.1, hst xy.2.2⟩
+end
+
+lemma mono' (h : ∀ a b ∈ s, r' a b → r a b) : s.well_founded_on r → s.well_founded_on r' :=
+subrelation.wf $ λ a b, h _ a.2 _ b.2
+
+lemma subset (h : t.well_founded_on r) (hst : s ⊆ t) : s.well_founded_on r := h.mono le_rfl hst
+
+open relation
+
+/-- `a` is accessible under the relation `r` iff `r` is well-founded on the downward transitive
+  closure of `a` under `r` (including `a` or not). -/
+lemma acc_iff_well_founded_on {α} {r : α → α → Prop} {a : α} :
+  [ acc r a,
+    {b | refl_trans_gen r b a}.well_founded_on r,
+    {b | trans_gen r b a}.well_founded_on r ].tfae :=
+begin
+  tfae_have : 1 → 2,
+  { refine λ h, ⟨λ b, _⟩, apply inv_image.accessible,
+    rw ← acc_trans_gen_iff at h ⊢,
+    obtain h'|h' := refl_trans_gen_iff_eq_or_trans_gen.1 b.2,
+    { rwa h' at h }, { exact h.inv h' } },
+  tfae_have : 2 → 3,
+  { exact λ h, h.subset (λ _, trans_gen.to_refl) },
+  tfae_have : 3 → 1,
+  { refine λ h, acc.intro _ (λ b hb, (h.apply ⟨b, trans_gen.single hb⟩).of_fibration subtype.val _),
+    exact λ ⟨c, hc⟩ d h, ⟨⟨d, trans_gen.head h hc⟩, h, rfl⟩ },
+  tfae_finish,
+end
+
+end well_founded_on
+end any_rel
+
+section is_strict_order
+variables [is_strict_order α r] {s t : set α}
+
+instance is_strict_order.subset : is_strict_order α (λ (a b : α), r a b ∧ a ∈ s ∧ b ∈ s) :=
 { to_is_irrefl := ⟨λ a con, irrefl_of r a con.1 ⟩,
   to_is_trans := ⟨λ a b c ab bc, ⟨trans_of r ab.1 bc.1, ab.2.1, bc.2.2⟩ ⟩ }
 
-theorem well_founded_on_iff_no_descending_seq {s : set α} {r : α → α → Prop} [is_strict_order α r] :
-  s.well_founded_on r ↔ ∀ (f : ((>) : ℕ → ℕ → Prop) ↪r r), ¬ (range f) ⊆ s :=
+lemma well_founded_on_iff_no_descending_seq :
+  s.well_founded_on r ↔ ∀ (f : ((>) : ℕ → ℕ → Prop) ↪r r), ¬∀ n, f n ∈ s :=
 begin
-  rw [well_founded_on_iff, rel_embedding.well_founded_iff_no_descending_seq],
-  refine ⟨λ h f con, begin
-      refine h.elim' ⟨⟨f, f.injective⟩, λ a b, _⟩,
-       simp only [con (mem_range_self a), con (mem_range_self b), and_true, gt_iff_lt,
-        function.embedding.coe_fn_mk, f.map_rel_iff]
-    end, λ h, ⟨λ con, _⟩⟩,
-  rcases con with ⟨f, hf⟩,
-  have hfs' : ∀ n : ℕ, f n ∈ s := λ n, (hf.2 n.lt_succ_self).2.2,
-  refine h ⟨f, λ a b, _⟩ (λ n hn, _),
-  { rw ← hf,
-    exact ⟨λ h, ⟨h, hfs' _, hfs' _⟩, λ h, h.1⟩ },
-  { rcases set.mem_range.1 hn with ⟨m, hm⟩,
-    rw ← hm,
-    apply hfs' }
+  simp only [well_founded_on_iff, rel_embedding.well_founded_iff_no_descending_seq, ← not_exists,
+    ← not_nonempty_iff, not_iff_not],
+  split,
+  { rintro ⟨⟨f, hf⟩⟩,
+    have H : ∀ n, f n ∈ s, from λ n, (hf.2 n.lt_succ_self).2.2,
+    refine ⟨⟨f, _⟩, H⟩,
+    simpa only [H, and_true] using @hf },
+  { rintro ⟨⟨f, hf⟩, hfs : ∀ n, f n ∈ s⟩,
+    refine ⟨⟨f, _⟩⟩,
+    simpa only [hfs, and_true] using @hf }
+end
+
+lemma well_founded_on.union (hs : s.well_founded_on r) (ht : t.well_founded_on r) :
+  (s ∪ t).well_founded_on r :=
+begin
+  rw well_founded_on_iff_no_descending_seq at *,
+  rintro f hf,
+  rcases nat.exists_subseq_of_forall_mem_union f hf with ⟨g, hg|hg⟩,
+  exacts [hs (g.dual.lt_embedding.trans f) hg, ht (g.dual.lt_embedding.trans f) hg]
 end
 
+@[simp] lemma well_founded_on_union :
+  (s ∪ t).well_founded_on r ↔ s.well_founded_on r ∧ t.well_founded_on r :=
+⟨λ h, ⟨h.subset $ subset_union_left _ _, h.subset $ subset_union_right _ _⟩, λ h, h.1.union h.2⟩
+
+end is_strict_order
+end well_founded_on
+
+/-! ### Sets well-founded w.r.t. the strict inequality -/
+
 section has_lt
-variables [has_lt α]
+variables [has_lt α] {s t : set α}
 
 /-- `s.is_wf` indicates that `<` is well-founded when restricted to `s`. -/
 def is_wf (s : set α) : Prop := well_founded_on s (<)
 
+@[simp] lemma is_wf_empty : is_wf (∅ : set α) := well_founded_of_empty _
+
 lemma is_wf_univ_iff : is_wf (univ : set α) ↔ well_founded ((<) : α → α → Prop) :=
 by simp [is_wf, well_founded_on_iff]
 
-variables {s t : set α}
+theorem is_wf.mono (h : is_wf t) (st : s ⊆ t) : is_wf s := h.subset st
 
-theorem is_wf.mono (h : is_wf t) (st : s ⊆ t) : is_wf s :=
-begin
-  rw [is_wf, well_founded_on_iff] at *,
-  refine subrelation.wf (λ x y xy, _) h,
-  exact ⟨xy.1, st xy.2.1, st xy.2.2⟩,
-end
 end has_lt
 
-section partial_order
-variables [partial_order α] {s t : set α} {a : α}
+section preorder
+variables [preorder α] {s t : set α} {a : α}
 
-theorem is_wf_iff_no_descending_seq : is_wf s ↔ ∀ f : ℕᵒᵈ ↪o α, ¬ (range f) ⊆ s :=
-begin
-  haveI : is_strict_order α (λ (a b : α), a < b ∧ a ∈ s ∧ b ∈ s) :=
-  { to_is_irrefl := ⟨λ x con, lt_irrefl x con.1⟩,
-    to_is_trans := ⟨λ a b c ab bc, ⟨lt_trans ab.1 bc.1, ab.2.1, bc.2.2⟩⟩, },
-  rw [is_wf, well_founded_on_iff_no_descending_seq],
-  exact ⟨λ h f, h f.lt_embedding, λ h f, h (order_embedding.of_strict_mono
-    f (λ _ _, f.map_rel_iff.2))⟩,
-end
+protected lemma is_wf.union (hs : is_wf s) (ht : is_wf t) : is_wf (s ∪ t) := hs.union ht
 
-theorem is_wf.union (hs : is_wf s) (ht : is_wf t) : is_wf (s ∪ t) :=
-begin
-  classical,
-  rw [is_wf_iff_no_descending_seq] at *,
-  rintros f fst,
-  have h : infinite (f ⁻¹' s) ∨ infinite (f ⁻¹' t),
-  { have h : infinite (univ : set ℕ) := infinite_univ,
-    have hpre : f ⁻¹' (s ∪ t) = set.univ,
-    { rw [← image_univ, image_subset_iff, univ_subset_iff] at fst,
-      exact fst },
-    rw preimage_union at hpre,
-    rw ← hpre at h,
-    rw [infinite, infinite],
-    rw infinite at h,
-    contrapose! h,
-    exact finite.union h.1 h.2, },
-  rw [← infinite_coe_iff, ← infinite_coe_iff] at h,
-  cases h with inf inf; haveI := inf,
-  { apply hs ((nat.order_embedding_of_set (f ⁻¹' s)).dual.trans f),
-    change range (function.comp f (nat.order_embedding_of_set (f ⁻¹' s))) ⊆ s,
-    rw [range_comp, image_subset_iff],
-      simp },
-  { apply ht ((nat.order_embedding_of_set (f ⁻¹' t)).dual.trans f),
-    change range (function.comp f (nat.order_embedding_of_set (f ⁻¹' t))) ⊆ t,
-    rw [range_comp, image_subset_iff],
-      simp }
-end
-end partial_order
+@[simp] lemma is_wf_union : is_wf (s ∪ t) ↔ is_wf s ∧ is_wf t := well_founded_on_union
 
-end set
+end preorder
 
-namespace set
+section preorder
+variables [preorder α] {s t : set α} {a : α}
+
+theorem is_wf_iff_no_descending_seq :
+  is_wf s ↔ ∀ f : ℕ → α, strict_anti f → ¬(∀ n, f (order_dual.to_dual n) ∈ s) :=
+well_founded_on_iff_no_descending_seq.trans
+  ⟨λ H f hf, H ⟨⟨f, hf.injective⟩, λ a b, hf.lt_iff_lt⟩, λ H f, H f (λ _ _, f.map_rel_iff.2)⟩
+
+end preorder
+
+/-!
+### Partially well-ordered sets
+
+A set is partially well-ordered by a relation `r` when any infinite sequence contains two elements
+where the first is related to the second by `r`. Equivalently, any antichain (see `is_antichain`) is
+finite, see `set.partially_well_ordered_on_iff_finite_antichains`.
+-/
 
 /-- A subset is partially well-ordered by a relation `r` when any infinite sequence contains
   two elements where the first is related to the second by `r`. -/
-def partially_well_ordered_on (s) (r : α → α → Prop) : Prop :=
-  ∀ (f : ℕ → α), range f ⊆ s → ∃ (m n : ℕ), m < n ∧ r (f m) (f n)
+def partially_well_ordered_on (s : set α) (r : α → α → Prop) : Prop :=
+∀ f : ℕ → α, (∀ n, f n ∈ s) → ∃ m n : ℕ, m < n ∧ r (f m) (f n)
 
-/-- A subset of a preorder is partially well-ordered when any infinite sequence contains
-  a monotone subsequence of length 2 (or equivalently, an infinite monotone subsequence). -/
-def is_pwo [preorder α] (s) : Prop :=
-partially_well_ordered_on s ((≤) : α → α → Prop)
+section partially_well_ordered_on
+variables {r : α → α → Prop} {r' : β → β → Prop} {f : α → β} {s : set α} {t : set α} {a : α}
 
-theorem partially_well_ordered_on.mono {s t : set α} {r : α → α → Prop}
-  (ht : t.partially_well_ordered_on r) (hsub : s ⊆ t) :
+lemma partially_well_ordered_on.mono (ht : t.partially_well_ordered_on r) (h : s ⊆ t) :
   s.partially_well_ordered_on r :=
-λ f hf, ht f (set.subset.trans hf hsub)
+λ f hf, ht f $ λ n, h $ hf n
 
-theorem is_pwo.mono [preorder α] {s t : set α}
-  (ht : t.is_pwo) (hsub : s ⊆ t) :
-  s.is_pwo :=
-partially_well_ordered_on.mono ht hsub
+@[simp] lemma partially_well_ordered_on_empty (r : α → α → Prop) : partially_well_ordered_on ∅ r :=
+λ f hf, (hf 0).elim
 
-theorem partially_well_ordered_on.image_of_monotone_on {s : set α}
-  {r : α → α → Prop} {β : Type*} {r' : β → β → Prop}
-  (hs : s.partially_well_ordered_on r) {f : α → β}
-  (hf : ∀ a1 a2 : α, a1 ∈ s → a2 ∈ s → r a1 a2 → r' (f a1) (f a2)) :
+lemma partially_well_ordered_on.union (hs : s.partially_well_ordered_on r)
+  (ht : t.partially_well_ordered_on r) :
+  (s ∪ t).partially_well_ordered_on r :=
+begin
+  rintro f hf,
+  rcases nat.exists_subseq_of_forall_mem_union f hf with ⟨g, hgs|hgt⟩,
+  { rcases hs _ hgs with ⟨m, n, hlt, hr⟩,
+    exact ⟨g m, g n, g.strict_mono hlt, hr⟩ },
+  { rcases ht _ hgt with ⟨m, n, hlt, hr⟩,
+    exact ⟨g m, g n, g.strict_mono hlt, hr⟩ }
+end
+
+@[simp] lemma partially_well_ordered_on_union :
+  (s ∪ t).partially_well_ordered_on r ↔
+    s.partially_well_ordered_on r ∧ t.partially_well_ordered_on r :=
+⟨λ h, ⟨h.mono $ subset_union_left _ _, h.mono $ subset_union_right _ _⟩, λ h, h.1.union h.2⟩
+
+lemma partially_well_ordered_on.image_of_monotone_on (hs : s.partially_well_ordered_on r)
+  (hf : ∀ (a₁ ∈ s) (a₂ ∈ s), r a₁ a₂ → r' (f a₁) (f a₂)) :
   (f '' s).partially_well_ordered_on r' :=
-λ g hg, begin
-  have h := λ (n : ℕ), ((mem_image _ _ _).1 (hg (mem_range_self n))),
-  obtain ⟨m, n, hlt, hmn⟩ := hs (λ n, classical.some (h n)) _,
-  { refine ⟨m, n, hlt, _⟩,
-    rw [← (classical.some_spec (h m)).2,
-      ← (classical.some_spec (h n)).2],
-    exact hf _ _ (classical.some_spec (h m)).1 (classical.some_spec (h n)).1 hmn },
-  { rintros _ ⟨n, rfl⟩,
-    exact (classical.some_spec (h n)).1 }
+begin
+  intros g' hg',
+  choose g hgs heq using hg',
+  obtain rfl : f ∘ g = g', from funext heq,
+  obtain ⟨m, n, hlt, hmn⟩ := hs g hgs,
+  exact ⟨m, n, hlt, hf _ (hgs m) _ (hgs n) hmn⟩
 end
 
-lemma _root_.is_antichain.finite_of_partially_well_ordered_on {s : set α} {r : α → α → Prop}
-  (ha : is_antichain r s) (hp : s.partially_well_ordered_on r) :
+lemma _root_.is_antichain.finite_of_partially_well_ordered_on (ha : is_antichain r s)
+  (hp : s.partially_well_ordered_on r) :
   s.finite :=
 begin
-  refine finite_or_infinite.resolve_right (λ hi, _),
-  obtain ⟨m, n, hmn, h⟩ := hp (λ n, hi.nat_embedding _ n) (range_subset_iff.2 $
-    λ n, (hi.nat_embedding _ n).2),
+  refine not_infinite.1 (λ hi, _),
+  obtain ⟨m, n, hmn, h⟩ := hp (λ n, hi.nat_embedding _ n) (λ n, (hi.nat_embedding _ n).2),
   exact hmn.ne ((hi.nat_embedding _).injective $ subtype.val_injective $
     ha.eq (hi.nat_embedding _ m).2 (hi.nat_embedding _ n).2 h),
 end
 
-lemma finite.partially_well_ordered_on {s : set α} {r : α → α → Prop} [is_refl α r]
-  (hs : s.finite) :
-  s.partially_well_ordered_on r :=
+section is_refl
+variables [is_refl α r]
+
+protected lemma finite.partially_well_ordered_on (hs : s.finite) : s.partially_well_ordered_on r :=
 begin
   intros f hf,
-  obtain ⟨m, n, hmn, h⟩ := hs.exists_lt_map_eq_of_range_subset hf,
+  obtain ⟨m, n, hmn, h⟩ := hs.exists_lt_map_eq_of_forall_mem hf,
   exact ⟨m, n, hmn, h.subst $ refl (f m)⟩,
 end
 
-lemma _root_.is_antichain.partially_well_ordered_on_iff {s : set α} {r : α → α → Prop} [is_refl α r]
-  (hs : is_antichain r s) :
+lemma _root_.is_antichain.partially_well_ordered_on_iff (hs : is_antichain r s) :
   s.partially_well_ordered_on r ↔ s.finite :=
 ⟨hs.finite_of_partially_well_ordered_on, finite.partially_well_ordered_on⟩
 
-lemma partially_well_ordered_on_iff_finite_antichains {s : set α} {r : α → α → Prop} [is_refl α r]
-  [is_symm α r] :
+@[simp] lemma partially_well_ordered_on_singleton (a : α) : partially_well_ordered_on {a} r :=
+(finite_singleton a).partially_well_ordered_on
+
+@[simp] lemma partially_well_ordered_on_insert :
+  partially_well_ordered_on (insert a s) r ↔ partially_well_ordered_on s r :=
+by simp only [← singleton_union, partially_well_ordered_on_union,
+  partially_well_ordered_on_singleton, true_and]
+
+protected lemma partially_well_ordered_on.insert (h : partially_well_ordered_on s r) (a : α) :
+  partially_well_ordered_on (insert a s) r :=
+partially_well_ordered_on_insert.2 h
+
+lemma partially_well_ordered_on_iff_finite_antichains [is_symm α r] :
   s.partially_well_ordered_on r ↔ ∀ t ⊆ s, is_antichain r t → t.finite :=
 begin
   refine ⟨λ h t ht hrt, hrt.finite_of_partially_well_ordered_on (h.mono ht), _⟩,
   rintro hs f hf,
   by_contra' H,
-  refine set.infinite_range_of_injective (λ m n hmn, _) (hs _ hf _),
+  refine infinite_range_of_injective (λ m n hmn, _) (hs _ (range_subset_iff.2 hf) _),
   { obtain h | h | h := lt_trichotomy m n,
     { refine (H _ _ h _).elim,
       rw hmn,
@@ -257,201 +331,209 @@ begin
   { exact mt symm (H _ _ h) }
 end
 
-section partial_order
-variables {s : set α} {t : set α} {r : α → α → Prop}
+variables [is_trans α r]
 
-theorem partially_well_ordered_on.exists_monotone_subseq [is_refl α r] [is_trans α r]
-  (h : s.partially_well_ordered_on r) (f : ℕ → α) (hf : range f ⊆ s) :
-  ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
+lemma partially_well_ordered_on.exists_monotone_subseq (h : s.partially_well_ordered_on r)
+  (f : ℕ → α) (hf : ∀ n, f n ∈ s) :
+  ∃ g : ℕ ↪o ℕ, ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
 begin
   obtain ⟨g, h1 | h2⟩ := exists_increasing_or_nonincreasing_subseq r f,
   { refine ⟨g, λ m n hle, _⟩,
-    obtain hlt | heq := lt_or_eq_of_le hle,
-    { exact h1 m n hlt, },
-    { rw [heq],
-      apply refl_of r } },
+    obtain hlt | rfl := hle.lt_or_eq,
+    exacts [h1 m n hlt, refl_of r _] },
   { exfalso,
-    obtain ⟨m, n, hlt, hle⟩ := h (f ∘ g) (subset.trans (range_comp_subset_range _ _) hf),
+    obtain ⟨m, n, hlt, hle⟩ := h (f ∘ g) (λ n, hf _),
     exact h2 m n hlt hle }
 end
 
-theorem partially_well_ordered_on_iff_exists_monotone_subseq [is_refl α r] [is_trans α r] :
+lemma partially_well_ordered_on_iff_exists_monotone_subseq :
   s.partially_well_ordered_on r ↔
-    ∀ f : ℕ → α, range f ⊆ s → ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
+    ∀ f : ℕ → α, (∀ n, f n ∈ s) → ∃ (g : ℕ ↪o ℕ), ∀ m n : ℕ, m ≤ n → r (f (g m)) (f (g n)) :=
 begin
   classical,
   split; intros h f hf,
   { exact h.exists_monotone_subseq f hf },
   { obtain ⟨g, gmon⟩ := h f hf,
-    refine ⟨g 0, g 1, g.lt_iff_lt.2 zero_lt_one, gmon _ _ zero_le_one⟩, }
+    exact ⟨g 0, g 1, g.lt_iff_lt.2 zero_lt_one, gmon _ _ zero_le_one⟩ }
 end
 
-lemma partially_well_ordered_on.well_founded_on [is_partial_order α r]
-  (h : s.partially_well_ordered_on r) :
-  s.well_founded_on (λ a b, r a b ∧ a ≠ b) :=
+protected lemma partially_well_ordered_on.prod {t : set β} (hs : partially_well_ordered_on s r)
+  (ht : partially_well_ordered_on t r') :
+  partially_well_ordered_on (s ×ˢ t) (λ x y : α × β, r x.1 y.1 ∧ r' x.2 y.2) :=
 begin
-  haveI : is_strict_order α (λ a b, r a b ∧ a ≠ b) :=
-  { to_is_irrefl := ⟨λ a con, con.2 rfl⟩,
-    to_is_trans := ⟨λ a b c ab bc, ⟨trans ab.1 bc.1,
-      λ ac, ab.2 (antisymm ab.1 (ac.symm ▸ bc.1))⟩⟩ },
-  rw well_founded_on_iff_no_descending_seq,
-  intros f con,
-  obtain ⟨m, n, hlt, hle⟩ := h f con,
-  exact (f.map_rel_iff.2 hlt).2 (antisymm hle (f.map_rel_iff.2 hlt).1).symm,
+  intros f hf,
+  obtain ⟨g₁, h₁⟩ := hs.exists_monotone_subseq (prod.fst ∘ f) (λ n, (hf n).1),
+  obtain ⟨m, n, hlt, hle⟩ := ht (prod.snd ∘ f ∘ g₁) (λ n, (hf _).2),
+  exact ⟨g₁ m, g₁ n, g₁.strict_mono hlt, h₁ _ _ hlt.le, hle⟩
 end
 
-variables [partial_order α]
+end is_refl
 
-lemma is_pwo.is_wf (h : s.is_pwo) :
-  s.is_wf :=
+lemma partially_well_ordered_on.well_founded_on [is_preorder α r]
+ (h : s.partially_well_ordered_on r) :
+  s.well_founded_on (λ a b, r a b ∧ ¬r b a) :=
 begin
-  rw [is_wf],
-  convert h.well_founded_on,
-  ext x y,
-  rw lt_iff_le_and_ne,
+  letI : preorder α := { le := r, le_refl := refl_of r, le_trans := λ _ _ _, trans_of r },
+  change s.well_founded_on (<), change s.partially_well_ordered_on (≤) at h,
+  rw well_founded_on_iff_no_descending_seq,
+  intros f hf,
+  obtain ⟨m, n, hlt, hle⟩ := h f hf,
+  exact (f.map_rel_iff.2 hlt).not_le hle,
 end
 
-theorem is_pwo.exists_monotone_subseq
-  (h : s.is_pwo) (f : ℕ → α) (hf : range f ⊆ s) :
+end partially_well_ordered_on
+
+section is_pwo
+variables [preorder α] [preorder β] {s t : set α}
+
+/-- A subset of a preorder is partially well-ordered when any infinite sequence contains
+  a monotone subsequence of length 2 (or equivalently, an infinite monotone subsequence). -/
+def is_pwo (s : set α) : Prop := partially_well_ordered_on s (≤)
+
+lemma is_pwo.mono (ht : t.is_pwo) : s ⊆ t → s.is_pwo := ht.mono
+
+theorem is_pwo.exists_monotone_subseq (h : s.is_pwo) (f : ℕ → α) (hf : ∀ n, f n ∈ s) :
   ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
 h.exists_monotone_subseq f hf
 
 theorem is_pwo_iff_exists_monotone_subseq :
-  s.is_pwo ↔
-    ∀ f : ℕ → α, range f ⊆ s → ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
+  s.is_pwo ↔ ∀ f : ℕ → α, (∀ n, f n ∈ s) → ∃ (g : ℕ ↪o ℕ), monotone (f ∘ g) :=
 partially_well_ordered_on_iff_exists_monotone_subseq
 
-lemma is_pwo.prod (hs : s.is_pwo)
-  (ht : t.is_pwo) :
-  (s ×ˢ t : set _).is_pwo :=
-begin
-  classical,
-  rw is_pwo_iff_exists_monotone_subseq at *,
-  intros f hf,
-  obtain ⟨g1, h1⟩ := hs (prod.fst ∘ f) _,
-  swap,
-  { rw [range_comp, image_subset_iff],
-    refine subset.trans hf _,
-    rintros ⟨x1, x2⟩ hx,
-    simp only [mem_preimage, hx.1] },
-  obtain ⟨g2, h2⟩ := ht (prod.snd ∘ f ∘ g1) _,
-  refine ⟨g2.trans g1, λ m n mn, _⟩,
-  swap,
-  { rw [range_comp, image_subset_iff],
-    refine subset.trans (range_comp_subset_range _ _) (subset.trans hf _),
-    rintros ⟨x1, x2⟩ hx,
-    simp only [mem_preimage, hx.2] },
-  simp only [rel_embedding.coe_trans, function.comp_app],
-  exact ⟨h1 (g2.le_iff_le.2 mn), h2 mn⟩,
-end
+protected lemma is_pwo.is_wf (h : s.is_pwo) : s.is_wf :=
+by simpa only [← lt_iff_le_not_le] using h.well_founded_on
 
-theorem is_pwo.image_of_monotone {β : Type*} [partial_order β]
-  (hs : s.is_pwo) {f : α → β} (hf : monotone f) :
-  is_pwo (f '' s) :=
-hs.image_of_monotone_on (λ _ _ _ _ ab, hf ab)
+lemma is_pwo.prod {t : set β} (hs : s.is_pwo) (ht : t.is_pwo) : is_pwo (s ×ˢ t) := hs.prod ht
 
-theorem is_pwo.union (hs : is_pwo s) (ht : is_pwo t) : is_pwo (s ∪ t) :=
-begin
-  classical,
-  rw [is_pwo_iff_exists_monotone_subseq] at *,
-  rintros f fst,
-  have h : infinite (f ⁻¹' s) ∨ infinite (f ⁻¹' t),
-  { have h : infinite (univ : set ℕ) := infinite_univ,
-    have hpre : f ⁻¹' (s ∪ t) = set.univ,
-    { rw [← image_univ, image_subset_iff, univ_subset_iff] at fst,
-      exact fst },
-    rw preimage_union at hpre,
-    rw ← hpre at h,
-    rw [infinite, infinite],
-    rw infinite at h,
-    contrapose! h,
-    exact finite.union h.1 h.2, },
-  rw [← infinite_coe_iff, ← infinite_coe_iff] at h,
-  cases h with inf inf; haveI := inf,
-  { obtain ⟨g, hg⟩ := hs (f ∘ (nat.order_embedding_of_set (f ⁻¹' s))) _,
-    { rw [function.comp.assoc, ← rel_embedding.coe_trans] at hg,
-      exact ⟨_, hg⟩ },
-    rw [range_comp, image_subset_iff],
-    simp },
-  { obtain ⟨g, hg⟩ := ht (f ∘ (nat.order_embedding_of_set (f ⁻¹' t))) _,
-    { rw [function.comp.assoc, ← rel_embedding.coe_trans] at hg,
-      exact ⟨_, hg⟩ },
-    rw [range_comp, image_subset_iff],
-    simp }
-end
+lemma is_pwo.image_of_monotone_on (hs : s.is_pwo) {f : α → β} (hf : monotone_on f s) :
+ is_pwo (f '' s) :=
+hs.image_of_monotone_on hf
+
+lemma is_pwo.image_of_monotone (hs : s.is_pwo) {f : α → β} (hf : monotone f) : is_pwo (f '' s) :=
+hs.image_of_monotone_on (hf.monotone_on _)
+
+protected lemma is_pwo.union (hs : is_pwo s) (ht : is_pwo t) : is_pwo (s ∪ t) := hs.union ht
+
+@[simp] lemma is_pwo_union : is_pwo (s ∪ t) ↔ is_pwo s ∧ is_pwo t := partially_well_ordered_on_union
+
+protected lemma finite.is_pwo (hs : s.finite) : is_pwo s := hs.partially_well_ordered_on
+@[simp] lemma is_pwo_of_finite [finite α] : s.is_pwo := s.to_finite.is_pwo
+
+@[simp] lemma is_pwo_singleton (a : α) : is_pwo ({a} : set α) := (finite_singleton a).is_pwo
+
+@[simp] lemma is_pwo_empty : is_pwo (∅ : set α) := finite_empty.is_pwo
+
+protected lemma subsingleton.is_pwo (hs : s.subsingleton) : is_pwo s := hs.finite.is_pwo
 
-end partial_order
-
-theorem is_wf.is_pwo [linear_order α] {s : set α}
-  (hs : s.is_wf) : s.is_pwo :=
-λ f hf, begin
-  rw [is_wf, well_founded_on_iff] at hs,
-  have hrange : (range f).nonempty := ⟨f 0, mem_range_self 0⟩,
-  let a := hs.min (range f) hrange,
-  obtain ⟨m, hm⟩ := hs.min_mem (range f) hrange,
-  refine ⟨m, m.succ, m.lt_succ_self, le_of_not_lt (λ con, _)⟩,
-  rw hm at con,
-  apply hs.not_lt_min (range f) hrange (mem_range_self m.succ)
-    ⟨con, hf (mem_range_self m.succ), hf _⟩,
-  rw ← hm,
-  apply mem_range_self,
+@[simp] lemma is_pwo_insert {a} : is_pwo (insert a s) ↔ is_pwo s :=
+by simp only [←singleton_union, is_pwo_union, is_pwo_singleton, true_and]
+
+protected lemma is_pwo.insert (h : is_pwo s) (a : α) : is_pwo (insert a s) := is_pwo_insert.2 h
+
+protected lemma finite.is_wf (hs : s.finite) : is_wf s := hs.is_pwo.is_wf
+@[simp] lemma is_wf_singleton {a : α} : is_wf ({a} : set α) := (finite_singleton a).is_wf
+protected lemma subsingleton.is_wf (hs : s.subsingleton) : is_wf s := hs.is_pwo.is_wf
+
+@[simp] lemma is_wf_insert {a} : is_wf (insert a s) ↔ is_wf s :=
+by simp only [←singleton_union, is_wf_union, is_wf_singleton, true_and]
+
+lemma is_wf.insert (h : is_wf s) (a : α) : is_wf (insert a s) := is_wf_insert.2 h
+
+end is_pwo
+
+section well_founded_on
+variables {r : α → α → Prop} [is_strict_order α r] {s : set α} {a : α}
+
+protected lemma finite.well_founded_on (hs : s.finite) : s.well_founded_on r :=
+by { letI := partial_order_of_SO r, exact hs.is_wf }
+
+@[simp] lemma well_founded_on_singleton : well_founded_on ({a} : set α) r :=
+(finite_singleton a).well_founded_on
+
+protected lemma subsingleton.well_founded_on (hs : s.subsingleton) : s.well_founded_on r :=
+hs.finite.well_founded_on
+
+@[simp] lemma well_founded_on_insert : well_founded_on (insert a s) r ↔ well_founded_on s r :=
+by simp only [←singleton_union, well_founded_on_union, well_founded_on_singleton, true_and]
+
+lemma well_founded_on.insert (h : well_founded_on s r) (a : α) : well_founded_on (insert a s) r :=
+well_founded_on_insert.2 h
+
+end well_founded_on
+
+section linear_order
+variables [linear_order α] {s : set α}
+
+protected lemma is_wf.is_pwo (hs : s.is_wf) : s.is_pwo :=
+begin
+  intros f hf,
+  lift f to ℕ → s using hf,
+  have hrange : (range f).nonempty := range_nonempty _,
+  rcases hs.has_min (range f) (range_nonempty _) with ⟨_, ⟨m, rfl⟩, hm⟩,
+  simp only [forall_range_iff, not_lt] at hm,
+  exact ⟨m, m + 1, lt_add_one m, hm _⟩,
 end
 
-theorem is_wf_iff_is_pwo [linear_order α] {s : set α} :
-  s.is_wf ↔ s.is_pwo :=
-⟨is_wf.is_pwo, is_pwo.is_wf⟩
+/-- In a linear order, the predicates `set.is_wf` and `set.is_pwo` are equivalent. -/
+lemma is_wf_iff_is_pwo : s.is_wf ↔ s.is_pwo := ⟨is_wf.is_pwo, is_pwo.is_wf⟩
 
+end linear_order
 end set
 
 namespace finset
+variables {r : α → α → Prop}
 
-@[simp] lemma partially_well_ordered_on {r : α → α → Prop} [is_refl α r] (s : finset α) :
+@[simp] protected lemma partially_well_ordered_on [is_refl α r] (s : finset α) :
   (s : set α).partially_well_ordered_on r :=
 s.finite_to_set.partially_well_ordered_on
 
-@[simp]
-theorem is_pwo [partial_order α] (f : finset α) :
-  set.is_pwo (↑f : set α) :=
-f.partially_well_ordered_on
+@[simp] protected lemma is_pwo [preorder α] (s : finset α) : set.is_pwo (↑s : set α) :=
+s.partially_well_ordered_on
 
-@[simp]
-theorem well_founded_on {r : α → α → Prop} [is_strict_order α r] (f : finset α) :
-  set.well_founded_on (↑f : set α) r :=
-begin
-  rw [set.well_founded_on_iff_no_descending_seq],
-  intros g con,
-  apply set.infinite_of_injective_forall_mem g.injective (set.range_subset_iff.1 con),
-  exact f.finite_to_set,
-end
+@[simp] protected lemma is_wf [preorder α] (s : finset α) : set.is_wf (↑s : set α) :=
+s.finite_to_set.is_wf
 
-@[simp]
-theorem is_wf [partial_order α] (f : finset α) : set.is_wf (↑f : set α) :=
-f.is_pwo.is_wf
+@[simp] protected lemma well_founded_on [is_strict_order α r] (s : finset α) :
+  set.well_founded_on (↑s : set α) r :=
+by { letI := partial_order_of_SO r, exact s.is_wf }
 
-end finset
+lemma well_founded_on_sup [is_strict_order α r] (s : finset ι) {f : ι → set α} :
+  (s.sup f).well_founded_on r ↔ ∀ i ∈ s, (f i).well_founded_on r :=
+finset.cons_induction_on s (by simp) $ λ a s ha hs, by simp [-sup_set_eq_bUnion, hs]
 
-namespace set
-variables [partial_order α] {s : set α} {a : α}
+lemma partially_well_ordered_on_sup (s : finset ι) {f : ι → set α} :
+  (s.sup f).partially_well_ordered_on r ↔ ∀ i ∈ s, (f i).partially_well_ordered_on r :=
+finset.cons_induction_on s (by simp) $ λ a s ha hs, by simp [-sup_set_eq_bUnion, hs]
 
-theorem finite.is_pwo (h : s.finite) : s.is_pwo :=
-begin
-  rw ← h.coe_to_finset,
-  exact h.to_finset.is_pwo,
-end
+lemma is_wf_sup [preorder α] (s : finset ι) {f : ι → set α} :
+  (s.sup f).is_wf ↔ ∀ i ∈ s, (f i).is_wf :=
+s.well_founded_on_sup
 
-@[simp]
-theorem fintype.is_pwo [fintype α] : s.is_pwo := (finite.of_fintype s).is_pwo
+lemma is_pwo_sup [preorder α] (s : finset ι) {f : ι → set α} :
+  (s.sup f).is_pwo ↔ ∀ i ∈ s, (f i).is_pwo :=
+s.partially_well_ordered_on_sup
 
-@[simp]
-theorem is_pwo_empty : is_pwo (∅ : set α) :=
-finite_empty.is_pwo
+@[simp] lemma well_founded_on_bUnion [is_strict_order α r] (s : finset ι) {f : ι → set α} :
+  (⋃ i ∈ s, f i).well_founded_on r ↔ ∀ i ∈ s, (f i).well_founded_on r :=
+by simpa only [finset.sup_eq_supr] using s.well_founded_on_sup
 
-@[simp]
-theorem is_pwo_singleton (a) : is_pwo ({a} : set α) :=
-(finite_singleton a).is_pwo
+@[simp] lemma partially_well_ordered_on_bUnion (s : finset ι) {f : ι → set α} :
+  (⋃ i ∈ s, f i).partially_well_ordered_on r ↔ ∀ i ∈ s, (f i).partially_well_ordered_on r :=
+by simpa only [finset.sup_eq_supr] using s.partially_well_ordered_on_sup
+
+@[simp] lemma is_wf_bUnion [preorder α] (s : finset ι) {f : ι → set α} :
+  (⋃ i ∈ s, f i).is_wf ↔ ∀ i ∈ s, (f i).is_wf :=
+s.well_founded_on_bUnion
 
-theorem is_pwo.insert (a) (hs : is_pwo s) : is_pwo (insert a s) :=
-by { rw ← union_singleton, exact hs.union (is_pwo_singleton a) }
+@[simp] lemma is_pwo_bUnion [preorder α] (s : finset ι) {f : ι → set α} :
+  (⋃ i ∈ s, f i).is_pwo ↔ ∀ i ∈ s, (f i).is_pwo :=
+s.partially_well_ordered_on_bUnion
+
+end finset
+
+namespace set
+section preorder
+variables [preorder α] {s : set α} {a : α}
 
 /-- `is_wf.min` returns a minimal element of a nonempty well-founded set. -/
 noncomputable def is_wf.min (hs : is_wf s) (hn : s.nonempty) : α :=
@@ -468,26 +550,15 @@ lemma is_wf_min_singleton (a) {hs : is_wf ({a} : set α)} {hn : ({a} : set α).n
   hs.min hn = a :=
 eq_of_mem_singleton (is_wf.min_mem hs hn)
 
-end set
-
-theorem finset.is_wf_sup {ι : Type*} [partial_order α] (f : finset ι) (g : ι → set α)
-  (hf : ∀ i : ι, i ∈ f → (g i).is_wf) : (f.sup g).is_wf :=
-finset.sup_induction set.is_pwo_empty.is_wf (λ a ha b hb, ha.union hb) hf
+end preorder
 
-theorem finset.is_pwo_sup {ι : Type*} [partial_order α] (f : finset ι) (g : ι → set α)
-  (hf : ∀ i : ι, i ∈ f → (g i).is_pwo) : (f.sup g).is_pwo :=
-finset.sup_induction set.is_pwo_empty (λ a ha b hb, ha.union hb) hf
-
-namespace set
+section linear_order
 variables [linear_order α] {s t : set α} {a : α}
 
-lemma is_wf.min_le
-  (hs : s.is_wf) (hn : s.nonempty) (ha : a ∈ s) : hs.min hn ≤ a :=
+lemma is_wf.min_le (hs : s.is_wf) (hn : s.nonempty) (ha : a ∈ s) : hs.min hn ≤ a :=
 le_of_not_lt (hs.not_lt_min hn ha)
 
-lemma is_wf.le_min_iff
-  (hs : s.is_wf) (hn : s.nonempty) :
-  a ≤ hs.min hn ↔ ∀ b, b ∈ s → a ≤ b :=
+lemma is_wf.le_min_iff (hs : s.is_wf) (hn : s.nonempty) : a ≤ hs.min hn ↔ ∀ b, b ∈ s → a ≤ b :=
 ⟨λ ha b hb, le_trans ha (hs.min_le hn hb), λ h, h _ (hs.min_mem _)⟩
 
 lemma is_wf.min_le_min_of_subset
@@ -505,60 +576,28 @@ begin
     (union_nonempty.2 (or.intro_left _ hsn)))).imp (hs.min_le _) (ht.min_le _),
 end
 
+end linear_order
 end set
 
-namespace set
-
-variables {s : set α} {t : set α}
-
-@[to_additive]
-theorem is_pwo.mul [ordered_cancel_comm_monoid α] (hs : s.is_pwo) (ht : t.is_pwo) :
-  is_pwo (s * t) :=
-begin
-  rw ← image_mul_prod,
-  exact (is_pwo.prod hs ht).image_of_monotone (λ _ _ h, mul_le_mul' h.1 h.2),
-end
+open set
 
-variable [linear_ordered_cancel_comm_monoid α]
-
-@[to_additive]
-theorem is_wf.mul (hs : s.is_wf) (ht : t.is_wf) : is_wf (s * t) :=
-(hs.is_pwo.mul ht.is_pwo).is_wf
-
-@[to_additive]
-theorem is_wf.min_mul (hs : s.is_wf) (ht : t.is_wf) (hsn : s.nonempty) (htn : t.nonempty) :
-  (hs.mul ht).min (hsn.mul htn) = hs.min hsn * ht.min htn :=
-begin
-  refine le_antisymm (is_wf.min_le _ _ (mem_mul.2 ⟨_, _, hs.min_mem _, ht.min_mem _, rfl⟩)) _,
-  rw is_wf.le_min_iff,
-  rintros _ ⟨x, y, hx, hy, rfl⟩,
-  exact mul_le_mul' (hs.min_le _ hx) (ht.min_le _ hy),
-end
-
-end set
-
-namespace set
-namespace partially_well_ordered_on
+namespace set.partially_well_ordered_on
+variables {r : α → α → Prop}
 
 /-- In the context of partial well-orderings, a bad sequence is a nonincreasing sequence
   whose range is contained in a particular set `s`. One exists if and only if `s` is not
   partially well-ordered. -/
 def is_bad_seq (r : α → α → Prop) (s : set α) (f : ℕ → α) : Prop :=
-set.range f ⊆ s ∧ ∀ (m n : ℕ), m < n → ¬ r (f m) (f n)
+(∀ n, f n ∈ s) ∧ ∀ m n : ℕ, m < n → ¬ r (f m) (f n)
 
 lemma iff_forall_not_is_bad_seq (r : α → α → Prop) (s : set α) :
-  s.partially_well_ordered_on r ↔
-    ∀ f, ¬ is_bad_seq r s f :=
-begin
-  rw [set.partially_well_ordered_on],
-  apply forall_congr (λ f, _),
-  simp [is_bad_seq]
-end
+  s.partially_well_ordered_on r ↔ ∀ f, ¬ is_bad_seq r s f :=
+forall_congr $ λ f, by simp [is_bad_seq]
 
 /-- This indicates that every bad sequence `g` that agrees with `f` on the first `n`
   terms has `rk (f n) ≤ rk (g n)`. -/
 def is_min_bad_seq (r : α → α → Prop) (rk : α → ℕ) (s : set α) (n : ℕ) (f : ℕ → α) : Prop :=
-  ∀ g : ℕ → α, (∀ (m : ℕ), m < n → f m = g m) → rk (g n) < rk (f n) → ¬ is_bad_seq r s g
+∀ g : ℕ → α, (∀ (m : ℕ), m < n → f m = g m) → rk (g n) < rk (f n) → ¬ is_bad_seq r s g
 
 /-- Given a bad sequence `f`, this constructs a bad sequence that agrees with `f` on the first `n`
   terms and is minimal at `n`.
@@ -596,8 +635,7 @@ begin
     rw [ih, ((min_bad_seq_of_bad_seq r rk s (m + k).succ (fs (m + k)).1 (fs (m + k)).2.1).2.1 m
         (nat.lt_succ_iff.2 (nat.add_le_add_left k.zero_le m)))],
     refl },
-  refine ⟨λ n, (fs n).1 n, ⟨set.range_subset_iff.2 (λ n, ((fs n).2).1.1 (mem_range_self n)),
-    λ m n mn, _⟩, λ n g hg1 hg2, _⟩,
+  refine ⟨λ n, (fs n).1 n, ⟨(λ n, ((fs n).2).1.1 n), λ m n mn, _⟩, λ n g hg1 hg2, _⟩,
   { dsimp,
     rw [← subtype.val_eq_coe, h m n (le_of_lt mn)],
     convert (fs n).2.1.2 m n mn },
@@ -605,7 +643,7 @@ begin
     rw ← h m n (le_of_lt mn) },
 end
 
-lemma iff_not_exists_is_min_bad_seq {r : α → α → Prop} (rk : α → ℕ) {s : set α} :
+lemma iff_not_exists_is_min_bad_seq (rk : α → ℕ) {s : set α} :
   s.partially_well_ordered_on r ↔ ¬ ∃ f, is_bad_seq r s f ∧ ∀ n, is_min_bad_seq r rk s n f :=
 begin
   rw [iff_forall_not_is_bad_seq, ← not_exists, not_congr],
@@ -636,7 +674,7 @@ begin
     λ n con, (hf1).2 n n.succ n.lt_succ_self (con.symm ▸ list.sublist_forall₂.nil),
   obtain ⟨g, hg⟩ := h.exists_monotone_subseq (list.head ∘ f) _,
   swap, { simp only [set.range_subset_iff, function.comp_apply],
-    exact λ n, hf1.1 (set.mem_range_self n) _ (list.head_mem_self (hnil n)) },
+    exact λ n, hf1.1 n _ (list.head_mem_self (hnil n)) },
   have hf' := hf2 (g 0) (λ n, if n < g 0 then f n else list.tail (f (g (n - g 0))))
     (λ m hm, (if_pos hm).symm) _,
   swap, { simp only [if_neg (lt_irrefl (g 0)), tsub_self],
@@ -645,15 +683,15 @@ begin
   rw [is_bad_seq] at hf',
   push_neg at hf',
   obtain ⟨m, n, mn, hmn⟩ := hf' _,
-  swap, { rw set.range_subset_iff,
-    rintro n x hx,
+  swap,
+  { rintro n x hx,
     split_ifs at hx with hn hn,
-    { exact hf1.1 (set.mem_range_self _) _ hx },
-    { refine hf1.1 (set.mem_range_self _) _ (list.tail_subset _ hx), } },
+    { exact hf1.1 _ _ hx },
+    { refine hf1.1 _ _ (list.tail_subset _ hx), } },
   by_cases hn : n < g 0,
   { apply hf1.2 m n mn,
     rwa [if_pos hn, if_pos (mn.trans hn)] at hmn },
-  { obtain ⟨n', rfl⟩ := le_iff_exists_add.1 (not_lt.1 hn),
+  { obtain ⟨n', rfl⟩ := exists_add_of_le (not_lt.1 hn),
     rw [if_neg hn, add_comm (g 0) n', add_tsub_cancel_right] at hmn,
     split_ifs at hmn with hm hm,
     { apply hf1.2 m (g n') (lt_of_lt_of_le hm (g.monotone n'.zero_le)),
@@ -664,231 +702,100 @@ begin
       exact list.sublist_forall₂.cons (hg _ _ (le_of_lt mn)) hmn, } }
 end
 
-end partially_well_ordered_on
+end set.partially_well_ordered_on
 
-namespace is_pwo
+lemma well_founded.is_wf [has_lt α] (h : well_founded ((<) : α → α → Prop)) (s : set α) : s.is_wf :=
+(set.is_wf_univ_iff.2 h).mono s.subset_univ
 
-@[to_additive]
-lemma submonoid_closure [ordered_cancel_comm_monoid α] {s : set α} (hpos : ∀ x : α, x ∈ s → 1 ≤ x)
-  (h : s.is_pwo) : is_pwo ((submonoid.closure s) : set α) :=
+/-- A version of **Dickson's lemma** any subset of functions `Π s : σ, α s` is partially well
+ordered, when `σ` is a `fintype` and each `α s` is a linear well order.
+This includes the classical case of Dickson's lemma that `ℕ ^ n` is a well partial order.
+Some generalizations would be possible based on this proof, to include cases where the target is
+partially well ordered, and also to consider the case of `set.partially_well_ordered_on` instead of
+`set.is_pwo`. -/
+lemma pi.is_pwo {α : ι → Type*} [Π i, linear_order (α i)] [∀ i, is_well_order (α i) (<)] [finite ι]
+  (s : set (Π i, α i)) : s.is_pwo :=
 begin
-  have hl : ((submonoid.closure s) : set α) ⊆ list.prod '' { l : list α | ∀ x, x ∈ l → x ∈ s },
-  { intros x hx,
-    rw set_like.mem_coe at hx,
-    refine submonoid.closure_induction hx (λ x hx, ⟨_, λ y hy, _, list.prod_singleton⟩)
-      ⟨_, λ y hy, (list.not_mem_nil _ hy).elim, list.prod_nil⟩ _,
-    { rwa list.mem_singleton.1 hy },
-    rintros _ _ ⟨l, hl, rfl⟩ ⟨l', hl', rfl⟩,
-    refine ⟨_, λ y hy, _, list.prod_append⟩,
-    cases list.mem_append.1 hy with hy hy,
-    { exact hl _ hy },
-    { exact hl' _ hy } },
-  apply ((h.partially_well_ordered_on_sublist_forall₂ (≤)).image_of_monotone_on _).mono hl,
-  exact λ l1 l2 hl1 hl2 h12, h12.prod_le_prod' (λ x hx, hpos x $ hl2 x hx)
-end
-
-end is_pwo
-
-/-- `set.mul_antidiagonal s t a` is the set of all pairs of an element in `s` and an element in `t`
-  that multiply to `a`. -/
-@[to_additive "`set.add_antidiagonal s t a` is the set of all pairs of an element in `s`
-  and an element in `t` that add to `a`."]
-def mul_antidiagonal [monoid α] (s t : set α) (a : α) : set (α × α) :=
-{ x | x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t }
-
-namespace mul_antidiagonal
-
-@[simp, to_additive]
-lemma mem_mul_antidiagonal [monoid α] {s t : set α} {a : α} {x : α × α} :
-  x ∈ mul_antidiagonal s t a ↔ x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t := iff.refl _
-
-section cancel_comm_monoid
-variables [cancel_comm_monoid α] {s t : set α} {a : α}
-
-@[to_additive]
-lemma fst_eq_fst_iff_snd_eq_snd {x y : (mul_antidiagonal s t a)} :
-  (x : α × α).fst = (y : α × α).fst ↔ (x : α × α).snd = (y : α × α).snd :=
-⟨λ h, begin
-  have hx := x.2.1,
-  rw [subtype.val_eq_coe, h] at hx,
-  apply mul_left_cancel (hx.trans y.2.1.symm),
-end, λ h, begin
-  have hx := x.2.1,
-  rw [subtype.val_eq_coe, h] at hx,
-  apply mul_right_cancel (hx.trans y.2.1.symm),
-end⟩
-
-@[to_additive]
-lemma eq_of_fst_eq_fst {x y : (mul_antidiagonal s t a)}
-  (h : (x : α × α).fst = (y : α × α).fst) : x = y :=
-subtype.ext (prod.ext h (mul_antidiagonal.fst_eq_fst_iff_snd_eq_snd.1 h))
-
-@[to_additive]
-lemma eq_of_snd_eq_snd {x y : (mul_antidiagonal s t a)}
-  (h : (x : α × α).snd = (y : α × α).snd) : x = y :=
-subtype.ext (prod.ext (mul_antidiagonal.fst_eq_fst_iff_snd_eq_snd.2 h) h)
-
-end cancel_comm_monoid
-
-section ordered_cancel_comm_monoid
-variables [ordered_cancel_comm_monoid α] (s t : set α) (a : α)
-
-@[to_additive]
-lemma eq_of_fst_le_fst_of_snd_le_snd {x y : (mul_antidiagonal s t a)}
-  (h1 : (x : α × α).fst ≤ (y : α × α).fst) (h2 : (x : α × α).snd ≤ (y : α × α).snd ) :
-  x = y :=
+  casesI nonempty_fintype ι,
+  suffices : ∀ s : finset ι, ∀ (f : ℕ → Π s, α s), ∃ g : ℕ ↪o ℕ,
+    ∀ ⦃a b : ℕ⦄, a ≤ b → ∀ (x : ι) (hs : x ∈ s), (f ∘ g) a x ≤ (f ∘ g) b x,
+  { refine is_pwo_iff_exists_monotone_subseq.2 (λ f hf, _),
+    simpa only [finset.mem_univ, true_implies_iff] using this finset.univ f },
+  refine finset.cons_induction _ _,
+  { intros f, existsi rel_embedding.refl (≤),
+    simp only [is_empty.forall_iff, implies_true_iff, forall_const, finset.not_mem_empty], },
+  { intros x s hx ih f,
+    obtain ⟨g, hg⟩ := (is_well_founded.wf.is_wf univ).is_pwo.exists_monotone_subseq (λ n, f n x)
+      mem_univ,
+    obtain ⟨g', hg'⟩ := ih (f ∘ g),
+    refine ⟨g'.trans g, λ a b hab, (finset.forall_mem_cons _ _).2 _⟩,
+    exact ⟨hg (order_hom_class.mono g' hab), hg' hab⟩ }
+end
+
+section prod_lex
+variables {rα : α → α → Prop} {rβ : β → β → Prop} {f : γ → α} {g : γ → β} {s : set γ}
+
+/-- Stronger version of `prod.lex_wf`. Instead of requiring `rβ on g` to be well-founded, we only
+require it to be well-founded on fibers of `f`.-/
+lemma well_founded.prod_lex_of_well_founded_on_fiber (hα : well_founded (rα on f))
+  (hβ : ∀ a, (f ⁻¹' {a}).well_founded_on (rβ on g)) :
+  well_founded (prod.lex rα rβ on λ c, (f c, g c)) :=
 begin
-  apply eq_of_fst_eq_fst,
-  cases eq_or_lt_of_le h1 with heq hlt,
-  { exact heq },
-  exfalso,
-  exact ne_of_lt (mul_lt_mul_of_lt_of_le hlt h2)
-    ((mem_mul_antidiagonal.1 x.2).1.trans (mem_mul_antidiagonal.1 y.2).1.symm)
-end
-
-variables {s} {t}
-
-@[to_additive]
-theorem finite_of_is_pwo (hs : s.is_pwo) (ht : t.is_pwo) (a) :
-  (mul_antidiagonal s t a).finite :=
+  refine ((psigma.lex_wf (well_founded_on_range.2 hα) $ λ a, hβ a).on_fun).mono (λ c c' h, _),
+  exact λ c, ⟨⟨_, c, rfl⟩, c, rfl⟩,
+  obtain h' | h' := prod.lex_iff.1 h,
+  { exact psigma.lex.left _ _ h' },
+  { dsimp only [inv_image, (on)] at h' ⊢,
+    convert psigma.lex.right (⟨_, c', rfl⟩ : range f) _ using 1, swap,
+    exacts [⟨c, h'.1⟩, psigma.subtype_ext (subtype.ext h'.1) rfl, h'.2] }
+end
+
+lemma set.well_founded_on.prod_lex_of_well_founded_on_fiber (hα : s.well_founded_on (rα on f))
+  (hβ : ∀ a, (s ∩ f ⁻¹' {a}).well_founded_on (rβ on g)) :
+  s.well_founded_on (prod.lex rα rβ on λ c, (f c, g c)) :=
 begin
-  by_contra h,
-  rw [← set.infinite] at h,
-  have h1 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.fst ⁻¹'o (≤)),
-  { intros f hf,
-    refine hs (prod.fst ∘ f) _,
-    rw range_comp,
-    rintros _ ⟨⟨x, y⟩, hxy, rfl⟩,
-    exact (mem_mul_antidiagonal.1 (hf hxy)).2.1 },
-  have h2 : (mul_antidiagonal s t a).partially_well_ordered_on (prod.snd ⁻¹'o (≤)),
-  { intros f hf,
-    refine ht (prod.snd ∘ f) _,
-    rw range_comp,
-    rintros _ ⟨⟨x, y⟩, hxy, rfl⟩,
-    exact (mem_mul_antidiagonal.1 (hf hxy)).2.2 },
-  obtain ⟨g, hg⟩ := h1.exists_monotone_subseq (λ x, h.nat_embedding _ x) _,
-  swap, { rintro _ ⟨k, rfl⟩,
-    exact ((infinite.nat_embedding (s.mul_antidiagonal t a) h) _).2 },
-  obtain ⟨m, n, mn, h2'⟩ := h2 (λ x, (h.nat_embedding _) (g x)) _,
-  swap, { rintro _ ⟨k, rfl⟩,
-    exact ((infinite.nat_embedding (s.mul_antidiagonal t a) h) _).2, },
-  apply ne_of_lt mn (g.injective ((h.nat_embedding _).injective _)),
-  exact eq_of_fst_le_fst_of_snd_le_snd _ _ _ (hg _ _ (le_of_lt mn)) h2',
+  refine well_founded.prod_lex_of_well_founded_on_fiber hα
+    (λ a, subrelation.wf (λ b c h, _) (hβ a).on_fun),
+  exact λ x, ⟨x, x.1.2, x.2⟩,
+  assumption,
 end
 
-end ordered_cancel_comm_monoid
-
-@[to_additive]
-theorem finite_of_is_wf [linear_ordered_cancel_comm_monoid α] {s t : set α}
-  (hs : s.is_wf) (ht : t.is_wf) (a) :
-  (mul_antidiagonal s t a).finite :=
-finite_of_is_pwo hs.is_pwo ht.is_pwo a
+end prod_lex
 
-end mul_antidiagonal
-end set
-
-namespace finset
+section sigma_lex
+variables {rι : ι → ι → Prop} {rπ : Π i, π i → π i → Prop} {f : γ → ι} {g : Π i, γ → π i}
+  {s : set γ}
 
-variables [ordered_cancel_comm_monoid α]
-variables {s t : set α} (hs : s.is_pwo) (ht : t.is_pwo) (a : α)
-
-/-- `finset.mul_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in
-  `s` and an element in `t` that multiply to `a`, but its construction requires proofs
-  `hs` and `ht` that `s` and `t` are well-ordered. -/
-@[to_additive "`finset.add_antidiagonal_of_is_wf hs ht a` is the set of all pairs of an element in
-  `s` and an element in `t` that add to `a`, but its construction requires proofs
-  `hs` and `ht` that `s` and `t` are well-ordered."]
-noncomputable def mul_antidiagonal : finset (α × α) :=
-(set.mul_antidiagonal.finite_of_is_pwo hs ht a).to_finset
-
-variables {hs} {ht} {u : set α} {hu : u.is_pwo} {a} {x : α × α}
-
-@[simp, to_additive]
-lemma mem_mul_antidiagonal :
-  x ∈ mul_antidiagonal hs ht a ↔ x.1 * x.2 = a ∧ x.1 ∈ s ∧ x.2 ∈ t :=
-by simp [mul_antidiagonal]
-
-@[to_additive]
-lemma mul_antidiagonal_mono_left (hus : u ⊆ s) :
-  (finset.mul_antidiagonal hu ht a) ⊆ (finset.mul_antidiagonal hs ht a) :=
-λ x hx, begin
-  rw mem_mul_antidiagonal at *,
-  exact ⟨hx.1, hus hx.2.1, hx.2.2⟩,
-end
-
-@[to_additive]
-lemma mul_antidiagonal_mono_right (hut : u ⊆ t) :
-  (finset.mul_antidiagonal hs hu a) ⊆ (finset.mul_antidiagonal hs ht a) :=
-λ x hx, begin
-  rw mem_mul_antidiagonal at *,
-  exact ⟨hx.1, hx.2.1, hut hx.2.2⟩,
-end
-
-@[to_additive]
-lemma support_mul_antidiagonal_subset_mul :
-  { a : α | (mul_antidiagonal hs ht a).nonempty } ⊆ s * t :=
-(λ x ⟨⟨a1, a2⟩, ha⟩, begin
-  obtain ⟨hmul, h1, h2⟩ := mem_mul_antidiagonal.1 ha,
-  exact ⟨a1, a2, h1, h2, hmul⟩,
-end)
-
-@[to_additive]
-theorem is_pwo_support_mul_antidiagonal :
-  { a : α | (mul_antidiagonal hs ht a).nonempty }.is_pwo :=
-(hs.mul ht).mono support_mul_antidiagonal_subset_mul
-
-@[to_additive]
-theorem mul_antidiagonal_min_mul_min {α} [linear_ordered_cancel_comm_monoid α] {s t : set α}
-  (hs : s.is_wf) (ht : t.is_wf)
-  (hns : s.nonempty) (hnt : t.nonempty) :
-  mul_antidiagonal hs.is_pwo ht.is_pwo ((hs.min hns) * (ht.min hnt)) =
-    {(hs.min hns, ht.min hnt)} :=
+/-- Stronger version of `psigma.lex_wf`. Instead of requiring `rπ on g` to be well-founded, we only
+require it to be well-founded on fibers of `f`.-/
+lemma well_founded.sigma_lex_of_well_founded_on_fiber (hι : well_founded (rι on f))
+  (hπ : ∀ i, (f ⁻¹' {i}).well_founded_on (rπ i on g i)) :
+  well_founded (sigma.lex rι rπ on λ c, ⟨f c, g (f c) c⟩) :=
 begin
-  ext ⟨a1, a2⟩,
-  rw [mem_mul_antidiagonal, finset.mem_singleton, prod.ext_iff],
-  split,
-  { rintro ⟨hast, has, hat⟩,
-    cases eq_or_lt_of_le (hs.min_le hns has) with heq hlt,
-    { refine ⟨heq.symm, _⟩,
-      rw heq at hast,
-      exact mul_left_cancel hast },
-    { contrapose hast,
-      exact ne_of_gt (mul_lt_mul_of_lt_of_le hlt (ht.min_le hnt hat)) } },
-  { rintro ⟨ha1, ha2⟩,
-    rw [ha1, ha2],
-    exact ⟨rfl, hs.min_mem _, ht.min_mem _⟩ }
-end
-
-end finset
-
-lemma well_founded.is_wf [has_lt α] (h : well_founded ((<) : α → α → Prop)) (s : set α) :
-  s.is_wf :=
-(set.is_wf_univ_iff.2 h).mono (set.subset_univ s)
-
-/-- A version of **Dickson's lemma** any subset of functions `Π s : σ, α s` is partially well
-ordered, when `σ` is a `fintype` and each `α s` is a linear well order.
-This includes the classical case of Dickson's lemma that `ℕ ^ n` is a well partial order.
-Some generalizations would be possible based on this proof, to include cases where the target
-is partially well ordered, and also to consider the case of `partially_well_ordered_on` instead of
-`is_pwo`. -/
-lemma pi.is_pwo {σ : Type*} {α : σ → Type*} [∀ s, linear_order (α s)] [∀ s, is_well_order (α s) (<)]
-  [fintype σ] (S : set (Π s : σ, α s)) : S.is_pwo :=
+  refine ((psigma.lex_wf (well_founded_on_range.2 hι) $ λ a, hπ a).on_fun).mono (λ c c' h, _),
+  exact λ c, ⟨⟨_, c, rfl⟩, c, rfl⟩,
+  obtain h' | ⟨h', h''⟩ := sigma.lex_iff.1 h,
+  { exact psigma.lex.left _ _ h' },
+  { dsimp only [inv_image, (on)] at h' ⊢,
+    convert psigma.lex.right (⟨_, c', rfl⟩ : range f) _ using 1, swap,
+    { exact ⟨c, h'⟩ },
+    { exact psigma.subtype_ext (subtype.ext h') rfl },
+    { dsimp only [subtype.coe_mk] at *,
+      revert h',
+      generalize : f c = d,
+      rintro rfl _,
+      exact h'' } }
+end
+
+lemma set.well_founded_on.sigma_lex_of_well_founded_on_fiber (hι : s.well_founded_on (rι on f))
+  (hπ : ∀ i, (s ∩ f ⁻¹' {i}).well_founded_on (rπ i on g i)) :
+  s.well_founded_on (sigma.lex rι rπ on λ c, ⟨f c, g (f c) c⟩) :=
 begin
-  classical,
-  refine set.is_pwo.mono _ (set.subset_univ _),
-  rw set.is_pwo_iff_exists_monotone_subseq,
-  simp_rw [monotone, pi.le_def],
-  suffices : ∀ s : finset σ, ∀ (f : ℕ → (Π s, α s)), set.range f ⊆ set.univ → ∃ (g : ℕ ↪o ℕ),
-    ∀ ⦃a b : ℕ⦄, a ≤ b → ∀ (x : σ) (hs : x ∈ s), (f ∘ g) a x ≤ (f ∘ g) b x,
-  { simpa only [forall_true_left, finset.mem_univ] using this finset.univ, },
-  apply' finset.induction,
-  { intros f hf, existsi rel_embedding.refl (≤),
-    simp only [forall_false_left, implies_true_iff, forall_const, finset.not_mem_empty], },
-  { intros x s hx ih f hf,
-    obtain ⟨g, hg⟩ := (is_well_order.wf.is_wf (set.univ : set _)).is_pwo.exists_monotone_subseq
-      ((λ mo : Π s : σ, α s, mo x) ∘ f) (set.subset_univ _),
-    obtain ⟨g', hg'⟩ := ih (f ∘ g) (set.subset_univ _),
-    refine ⟨g'.trans g, λ a b hab, _⟩,
-    simp only [finset.mem_insert, rel_embedding.coe_trans, function.comp_app, forall_eq_or_imp],
-    exact ⟨hg (order_hom_class.mono g' hab), hg' hab⟩, },
+  show well_founded (sigma.lex rι rπ on λ (c : s), ⟨f c, g (f c) c⟩),
+  refine @well_founded.sigma_lex_of_well_founded_on_fiber _ s _ _ rπ (λ c, f c) (λ i c, g _ c) hι
+    (λ i, subrelation.wf (λ b c h, _) (hπ i).on_fun),
+  exact λ x, ⟨x, x.1.2, x.2⟩,
+  assumption,
 end
+
+end sigma_lex
diff --git a/src/order/with_bot.lean b/src/order/with_bot.lean
new file mode 100644
index 0000000000000..4ad53041d78d9
--- /dev/null
+++ b/src/order/with_bot.lean
@@ -0,0 +1,919 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import order.bounded_order
+import data.option.n_ary
+
+/-!
+# `with_bot`, `with_top`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Adding a `bot` or a `top` to an order.
+
+## Main declarations
+
+* `with_ α`: Equips `option α` with the order on `α` plus `none` as the top/bottom element.
+
+ -/
+
+variables {α β γ δ : Type*}
+
+/-- Attach `⊥` to a type. -/
+def with_bot (α : Type*) := option α
+
+namespace with_bot
+
+variables {a b : α}
+
+meta instance [has_to_format α] : has_to_format (with_bot α) :=
+{ to_format := λ x,
+  match x with
+  | none := "⊥"
+  | (some x) := to_fmt x
+  end }
+
+instance [has_repr α] : has_repr (with_bot α) :=
+⟨λ o, match o with | none := "⊥" | (some a) := "↑" ++ repr a end⟩
+
+instance : has_coe_t α (with_bot α) := ⟨some⟩
+instance : has_bot (with_bot α) := ⟨none⟩
+
+meta instance {α : Type} [reflected _ α] [has_reflect α] : has_reflect (with_bot α)
+| ⊥ := `(⊥)
+| (a : α) := `(coe : α → with_bot α).subst `(a)
+
+instance : inhabited (with_bot α) := ⟨⊥⟩
+
+instance [nonempty α] : nontrivial (with_bot α) := option.nontrivial
+
+open function
+
+lemma coe_injective : injective (coe : α → with_bot α) := option.some_injective _
+@[norm_cast] lemma coe_inj : (a : with_bot α) = b ↔ a = b := option.some_inj
+
+protected lemma «forall» {p : with_bot α → Prop} : (∀ x, p x) ↔ p ⊥ ∧ ∀ x : α, p x := option.forall
+protected lemma «exists» {p : with_bot α → Prop} : (∃ x, p x) ↔ p ⊥ ∨ ∃ x : α, p x := option.exists
+
+lemma none_eq_bot : (none : with_bot α) = (⊥ : with_bot α) := rfl
+lemma some_eq_coe (a : α) : (some a : with_bot α) = (↑a : with_bot α) := rfl
+
+@[simp] lemma bot_ne_coe : ⊥ ≠ (a : with_bot α) .
+@[simp] lemma coe_ne_bot : (a : with_bot α) ≠ ⊥ .
+
+/-- Recursor for `with_bot` using the preferred forms `⊥` and `↑a`. -/
+@[elab_as_eliminator]
+def rec_bot_coe {C : with_bot α → Sort*} (h₁ : C ⊥) (h₂ : Π (a : α), C a) :
+  Π (n : with_bot α), C n :=
+option.rec h₁ h₂
+
+@[simp] lemma rec_bot_coe_bot {C : with_bot α → Sort*} (d : C ⊥) (f : Π (a : α), C a) :
+  @rec_bot_coe _ C d f ⊥ = d := rfl
+@[simp] lemma rec_bot_coe_coe {C : with_bot α → Sort*} (d : C ⊥) (f : Π (a : α), C a)
+  (x : α) : @rec_bot_coe _ C d f ↑x = f x := rfl
+
+/-- Specialization of `option.get_or_else` to values in `with_bot α` that respects API boundaries.
+-/
+def unbot' (d : α) (x : with_bot α) : α := rec_bot_coe d id x
+
+@[simp] lemma unbot'_bot {α} (d : α) : unbot' d ⊥ = d := rfl
+@[simp] lemma unbot'_coe {α} (d x : α) : unbot' d x = x := rfl
+
+@[norm_cast] lemma coe_eq_coe : (a : with_bot α) = b ↔ a = b := option.some_inj
+
+lemma unbot'_eq_iff {d y : α} {x : with_bot α} : unbot' d x = y ↔ x = y ∨ x = ⊥ ∧ y = d :=
+by induction x using with_bot.rec_bot_coe; simp [@eq_comm _ d, coe_eq_coe]
+
+@[simp]
+theorem unbot'_eq_self_iff {d : α} {x : with_bot α} : unbot' d x = d ↔ x = d ∨ x = ⊥ :=
+by simp [unbot'_eq_iff]
+
+theorem unbot'_eq_unbot'_iff {d : α} {x y : with_bot α} :
+  unbot' d x = unbot' d y ↔ x = y ∨ x = d ∧ y = ⊥ ∨ x = ⊥ ∧ y = d :=
+by induction y using with_bot.rec_bot_coe; simp [unbot'_eq_iff, or_comm, coe_eq_coe]
+
+/-- Lift a map `f : α → β` to `with_bot α → with_bot β`. Implemented using `option.map`. -/
+def map (f : α → β) : with_bot α → with_bot β := option.map f
+
+@[simp] lemma map_bot (f : α → β) : map f ⊥ = ⊥ := rfl
+@[simp] lemma map_coe (f : α → β) (a : α) : map f a = f a := rfl
+
+lemma map_comm {f₁ : α → β} {f₂ : α → γ} {g₁ : β → δ} {g₂ : γ → δ} (h : g₁ ∘ f₁ = g₂ ∘ f₂) (a : α) :
+  map g₁ (map f₁ a) = map g₂ (map f₂ a) :=
+option.map_comm h _
+
+lemma ne_bot_iff_exists {x : with_bot α} : x ≠ ⊥ ↔ ∃ (a : α), ↑a = x := option.ne_none_iff_exists
+
+/-- Deconstruct a `x : with_bot α` to the underlying value in `α`, given a proof that `x ≠ ⊥`. -/
+def unbot : Π (x : with_bot α), x ≠ ⊥ → α
+| ⊥        h := absurd rfl h
+| (some x) h := x
+
+@[simp] lemma coe_unbot (x : with_bot α) (h : x ≠ ⊥) : (x.unbot h : with_bot α) = x :=
+by { cases x, simpa using h, refl, }
+
+@[simp] lemma unbot_coe (x : α) (h : (x : with_bot α) ≠ ⊥ := coe_ne_bot) :
+  (x : with_bot α).unbot h = x := rfl
+
+instance can_lift : can_lift (with_bot α) α coe (λ r, r ≠ ⊥) :=
+{ prf := λ x h, ⟨x.unbot h, coe_unbot _ _⟩ }
+
+section has_le
+variables [has_le α]
+
+@[priority 10]
+instance : has_le (with_bot α) := ⟨λ o₁ o₂ : option α, ∀ a ∈ o₁, ∃ b ∈ o₂, a ≤ b⟩
+
+@[simp] lemma some_le_some : @has_le.le (with_bot α) _ (some a) (some b) ↔ a ≤ b := by simp [(≤)]
+@[simp, norm_cast] lemma coe_le_coe : (a : with_bot α) ≤ b ↔ a ≤ b := some_le_some
+
+@[simp] lemma none_le {a : with_bot α} : @has_le.le (with_bot α) _ none a :=
+λ b h, option.no_confusion h
+
+instance : order_bot (with_bot α) := { bot_le := λ a, none_le, ..with_bot.has_bot }
+
+instance [order_top α] : order_top (with_bot α) :=
+{ top := some ⊤,
+  le_top := λ o a ha, by cases ha; exact ⟨_, rfl, le_top⟩ }
+
+instance [order_top α] : bounded_order (with_bot α) :=
+{ ..with_bot.order_top, ..with_bot.order_bot }
+
+lemma not_coe_le_bot (a : α) : ¬ (a : with_bot α) ≤ ⊥ :=
+λ h, let ⟨b, hb, _⟩ := h _ rfl in option.not_mem_none _ hb
+
+lemma coe_le : ∀ {o : option α}, b ∈ o → ((a : with_bot α) ≤ o ↔ a ≤ b) | _ rfl := coe_le_coe
+
+lemma coe_le_iff : ∀ {x : with_bot α}, ↑a ≤ x ↔ ∃ b : α, x = b ∧ a ≤ b
+| (some a) := by simp [some_eq_coe, coe_eq_coe]
+| none     := iff_of_false (not_coe_le_bot _) $ by simp [none_eq_bot]
+
+lemma le_coe_iff : ∀ {x : with_bot α}, x ≤ b ↔ ∀ a, x = ↑a → a ≤ b
+| (some b) := by simp [some_eq_coe, coe_eq_coe]
+| none     := by simp [none_eq_bot]
+
+protected lemma _root_.is_max.with_bot (h : is_max a) : is_max (a : with_bot α)
+| none _ := bot_le
+| (some b) hb := some_le_some.2 $ h $ some_le_some.1 hb
+
+end has_le
+
+section has_lt
+variables [has_lt α]
+
+@[priority 10]
+instance : has_lt (with_bot α) := ⟨λ o₁ o₂ : option α, ∃ b ∈ o₂, ∀ a ∈ o₁, a < b⟩
+
+@[simp] lemma some_lt_some : @has_lt.lt (with_bot α) _ (some a) (some b) ↔ a < b := by simp [(<)]
+@[simp, norm_cast] lemma coe_lt_coe : (a : with_bot α) < b ↔ a < b := some_lt_some
+
+@[simp] lemma none_lt_some (a : α) : @has_lt.lt (with_bot α) _ none (some a) :=
+⟨a, rfl, λ b hb, (option.not_mem_none _ hb).elim⟩
+lemma bot_lt_coe (a : α) : (⊥ : with_bot α) < a := none_lt_some a
+
+@[simp] lemma not_lt_none (a : with_bot α) : ¬ @has_lt.lt (with_bot α) _ a none :=
+λ ⟨_, h, _⟩, option.not_mem_none _ h
+
+lemma lt_iff_exists_coe : ∀ {a b : with_bot α}, a < b ↔ ∃ p : α, b = p ∧ a < p
+| a (some b) := by simp [some_eq_coe, coe_eq_coe]
+| a none     := iff_of_false (not_lt_none _) $ by simp [none_eq_bot]
+
+lemma lt_coe_iff : ∀ {x : with_bot α}, x < b ↔ ∀ a, x = ↑a → a < b
+| (some b) := by simp [some_eq_coe, coe_eq_coe, coe_lt_coe]
+| none     := by simp [none_eq_bot, bot_lt_coe]
+
+/-- A version of `bot_lt_iff_ne_bot` for `with_bot` that only requires `has_lt α`, not
+`partial_order α`. -/
+protected theorem bot_lt_iff_ne_bot : ∀ {x : with_bot α}, ⊥ < x ↔ x ≠ ⊥
+| ⊥ := iff_of_false (with_bot.not_lt_none _) (λ h, h rfl)
+| (x : α) := by simp [bot_lt_coe]
+
+end has_lt
+
+instance [preorder α] : preorder (with_bot α) :=
+{ le          := (≤),
+  lt          := (<),
+  lt_iff_le_not_le := by { intros, cases a; cases b; simp [lt_iff_le_not_le]; simp [(<), (≤)] },
+  le_refl     := λ o a ha, ⟨a, ha, le_rfl⟩,
+  le_trans    := λ o₁ o₂ o₃ h₁ h₂ a ha,
+    let ⟨b, hb, ab⟩ := h₁ a ha, ⟨c, hc, bc⟩ := h₂ b hb in
+    ⟨c, hc, le_trans ab bc⟩ }
+
+instance [partial_order α] : partial_order (with_bot α) :=
+{ le_antisymm := λ o₁ o₂ h₁ h₂, begin
+    cases o₁ with a,
+    { cases o₂ with b, {refl},
+      rcases h₂ b rfl with ⟨_, ⟨⟩, _⟩ },
+    { rcases h₁ a rfl with ⟨b, ⟨⟩, h₁'⟩,
+      rcases h₂ b rfl with ⟨_, ⟨⟩, h₂'⟩,
+      rw le_antisymm h₁' h₂' }
+  end,
+  .. with_bot.preorder }
+
+lemma coe_strict_mono [preorder α] : strict_mono (coe : α → with_bot α) := λ a b, some_lt_some.2
+lemma coe_mono [preorder α] : monotone (coe : α → with_bot α) := λ a b, coe_le_coe.2
+
+lemma monotone_iff [preorder α] [preorder β] {f : with_bot α → β} :
+  monotone f ↔ monotone (f ∘ coe : α → β) ∧ ∀ x : α, f ⊥ ≤ f x :=
+⟨λ h, ⟨h.comp with_bot.coe_mono, λ x, h bot_le⟩,
+  λ h, with_bot.forall.2 ⟨with_bot.forall.2 ⟨λ _, le_rfl, λ x _, h.2 x⟩,
+  λ x, with_bot.forall.2 ⟨λ h, (not_coe_le_bot _ h).elim, λ y hle, h.1 (coe_le_coe.1 hle)⟩⟩⟩
+
+@[simp] lemma monotone_map_iff [preorder α] [preorder β] {f : α → β} :
+  monotone (with_bot.map f) ↔ monotone f :=
+monotone_iff.trans $ by simp [monotone]
+
+alias monotone_map_iff ↔ _ _root_.monotone.with_bot_map
+
+lemma strict_mono_iff [preorder α] [preorder β] {f : with_bot α → β} :
+  strict_mono f ↔ strict_mono (f ∘ coe : α → β) ∧ ∀ x : α, f ⊥ < f x :=
+⟨λ h, ⟨h.comp with_bot.coe_strict_mono, λ x, h (bot_lt_coe _)⟩,
+  λ h, with_bot.forall.2 ⟨with_bot.forall.2 ⟨flip absurd (lt_irrefl _), λ x _, h.2 x⟩,
+  λ x, with_bot.forall.2 ⟨λ h, (not_lt_bot h).elim, λ y hle, h.1 (coe_lt_coe.1 hle)⟩⟩⟩
+
+@[simp] lemma strict_mono_map_iff [preorder α] [preorder β] {f : α → β} :
+  strict_mono (with_bot.map f) ↔ strict_mono f :=
+strict_mono_iff.trans $ by simp [strict_mono, bot_lt_coe]
+
+alias strict_mono_map_iff ↔ _ _root_.strict_mono.with_bot_map
+
+lemma map_le_iff [preorder α] [preorder β] (f : α → β) (mono_iff : ∀ {a b}, f a ≤ f b ↔ a ≤ b) :
+  ∀ (a b : with_bot α), a.map f ≤ b.map f ↔ a ≤ b
+| ⊥       _       := by simp only [map_bot, bot_le]
+| (a : α) ⊥       := by simp only [map_coe, map_bot, coe_ne_bot, not_coe_le_bot _]
+| (a : α) (b : α) := by simpa only [map_coe, coe_le_coe] using mono_iff
+
+lemma le_coe_unbot' [preorder α] : ∀ (a : with_bot α) (b : α), a ≤ a.unbot' b
+| (a : α) b := le_rfl
+| ⊥       b := bot_le
+
+lemma unbot'_bot_le_iff [has_le α] [order_bot α] {a : with_bot α} {b : α} :
+  a.unbot' ⊥ ≤ b ↔ a ≤ b :=
+by cases a; simp [none_eq_bot, some_eq_coe]
+
+lemma unbot'_lt_iff [has_lt α] {a : with_bot α} {b c : α} (ha : a ≠ ⊥) :
+  a.unbot' b < c ↔ a < c :=
+begin
+  lift a to α using ha,
+  rw [unbot'_coe, coe_lt_coe]
+end
+
+instance [semilattice_sup α] : semilattice_sup (with_bot α) :=
+{ sup          := option.lift_or_get (⊔),
+  le_sup_left  := λ o₁ o₂ a ha,
+    by cases ha; cases o₂; simp [option.lift_or_get],
+  le_sup_right := λ o₁ o₂ a ha,
+    by cases ha; cases o₁; simp [option.lift_or_get],
+  sup_le       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
+    cases o₁ with b; cases o₂ with c; cases ha,
+    { exact h₂ a rfl },
+    { exact h₁ a rfl },
+    { rcases h₁ b rfl with ⟨d, ⟨⟩, h₁'⟩,
+      simp at h₂,
+      exact ⟨d, rfl, sup_le h₁' h₂⟩ }
+  end,
+  ..with_bot.order_bot,
+  ..with_bot.partial_order }
+
+lemma coe_sup [semilattice_sup α] (a b : α) : ((a ⊔ b : α) : with_bot α) = a ⊔ b := rfl
+
+instance [semilattice_inf α] : semilattice_inf (with_bot α) :=
+{ inf          := option.map₂ (⊓),
+  inf_le_left  := λ o₁ o₂ a ha, begin
+    rcases option.mem_map₂_iff.1 ha with ⟨a, b, (rfl : _ = _), (rfl : _ = _), rfl⟩,
+    exact ⟨_, rfl, inf_le_left⟩
+  end,
+  inf_le_right := λ o₁ o₂ a ha, begin
+    rcases option.mem_map₂_iff.1 ha with ⟨a, b, (rfl : _ = _), (rfl : _ = _), rfl⟩,
+    exact ⟨_, rfl, inf_le_right⟩
+  end,
+  le_inf       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
+    cases ha,
+    rcases h₁ a rfl with ⟨b, ⟨⟩, ab⟩,
+    rcases h₂ a rfl with ⟨c, ⟨⟩, ac⟩,
+    exact ⟨_, rfl, le_inf ab ac⟩
+  end,
+  ..with_bot.order_bot,
+  ..with_bot.partial_order }
+
+lemma coe_inf [semilattice_inf α] (a b : α) : ((a ⊓ b : α) : with_bot α) = a ⊓ b := rfl
+
+instance [lattice α] : lattice (with_bot α) :=
+{ ..with_bot.semilattice_sup, ..with_bot.semilattice_inf }
+
+instance [distrib_lattice α] : distrib_lattice (with_bot α) :=
+{ le_sup_inf := λ o₁ o₂ o₃,
+  match o₁, o₂, o₃ with
+  | ⊥, ⊥, ⊥ := le_rfl
+  | ⊥, ⊥, (a₁ : α) := le_rfl
+  | ⊥, (a₁ : α), ⊥ := le_rfl
+  | ⊥, (a₁ : α), (a₃ : α) := le_rfl
+  | (a₁ : α), ⊥, ⊥ := inf_le_left
+  | (a₁ : α), ⊥, (a₃ : α) := inf_le_left
+  | (a₁ : α), (a₂ : α), ⊥ := inf_le_right
+  | (a₁ : α), (a₂ : α), (a₃ : α) := coe_le_coe.mpr le_sup_inf
+  end,
+  ..with_bot.lattice }
+
+instance decidable_le [has_le α] [@decidable_rel α (≤)] : @decidable_rel (with_bot α) (≤)
+| none x := is_true $ λ a h, option.no_confusion h
+| (some x) (some y) :=
+  if h : x ≤ y
+  then is_true (some_le_some.2 h)
+  else is_false $ by simp *
+| (some x) none := is_false $ λ h, by rcases h x rfl with ⟨y, ⟨_⟩, _⟩
+
+instance decidable_lt [has_lt α] [@decidable_rel α (<)] : @decidable_rel (with_bot α) (<)
+| none (some x) := is_true $ by existsi [x,rfl]; rintros _ ⟨⟩
+| (some x) (some y) :=
+  if h : x < y
+  then is_true $ by simp *
+  else is_false $ by simp *
+| x none := is_false $ by rintro ⟨a,⟨⟨⟩⟩⟩
+
+instance is_total_le [has_le α] [is_total α (≤)] : is_total (with_bot α) (≤) :=
+⟨λ a b, match a, b with
+  | none  , _      := or.inl bot_le
+  | _     , none   := or.inr bot_le
+  | some x, some y := (total_of (≤) x y).imp some_le_some.2 some_le_some.2
+  end⟩
+
+instance [linear_order α] : linear_order (with_bot α) := lattice.to_linear_order _
+
+@[norm_cast] -- this is not marked simp because the corresponding with_top lemmas are used
+lemma coe_min [linear_order α] (x y : α) : ((min x y : α) : with_bot α) = min x y := rfl
+
+@[norm_cast] -- this is not marked simp because the corresponding with_top lemmas are used
+lemma coe_max [linear_order α] (x y : α) : ((max x y : α) : with_bot α) = max x y := rfl
+
+lemma well_founded_lt [preorder α] (h : @well_founded α (<)) : @well_founded (with_bot α) (<) :=
+have acc_bot : acc ((<) : with_bot α → with_bot α → Prop) ⊥ :=
+  acc.intro _ (λ a ha, (not_le_of_gt ha bot_le).elim),
+⟨λ a, option.rec_on a acc_bot (λ a, acc.intro _ (λ b, option.rec_on b (λ _, acc_bot)
+(λ b, well_founded.induction h b
+  (show ∀ b : α, (∀ c, c < b → (c : with_bot α) < a →
+      acc ((<) : with_bot α → with_bot α → Prop) c) → (b : with_bot α) < a →
+        acc ((<) : with_bot α → with_bot α → Prop) b,
+  from λ b ih hba, acc.intro _ (λ c, option.rec_on c (λ _, acc_bot)
+    (λ c hc, ih _ (some_lt_some.1 hc) (lt_trans hc hba)))))))⟩
+
+instance [has_lt α] [densely_ordered α] [no_min_order α] : densely_ordered (with_bot α) :=
+⟨ λ a b,
+  match a, b with
+  | a,      none   := λ h : a < ⊥, (not_lt_none _ h).elim
+  | none,   some b := λ h, let ⟨a, ha⟩ := exists_lt b in ⟨a, bot_lt_coe a, coe_lt_coe.2 ha⟩
+  | some a, some b := λ h, let ⟨a, ha₁, ha₂⟩ := exists_between (coe_lt_coe.1 h) in
+    ⟨a, coe_lt_coe.2 ha₁, coe_lt_coe.2 ha₂⟩
+  end⟩
+
+lemma lt_iff_exists_coe_btwn [preorder α] [densely_ordered α] [no_min_order α] {a b : with_bot α} :
+  a < b ↔ ∃ x : α, a < ↑x ∧ ↑x < b :=
+⟨λ h, let ⟨y, hy⟩ := exists_between h, ⟨x, hx⟩ := lt_iff_exists_coe.1 hy.1 in ⟨x, hx.1 ▸ hy⟩,
+ λ ⟨x, hx⟩, lt_trans hx.1 hx.2⟩
+
+instance [has_le α] [no_top_order α] [nonempty α] : no_top_order (with_bot α) :=
+⟨begin
+  apply rec_bot_coe,
+  { exact ‹nonempty α›.elim (λ a, ⟨a, not_coe_le_bot a⟩) },
+  { intro a,
+    obtain ⟨b, h⟩ := exists_not_le a,
+    exact ⟨b, by rwa coe_le_coe⟩ }
+end⟩
+
+instance [has_lt α] [no_max_order α] [nonempty α] : no_max_order (with_bot α) :=
+⟨begin
+  apply with_bot.rec_bot_coe,
+  { apply ‹nonempty α›.elim,
+    exact λ a, ⟨a, with_bot.bot_lt_coe a⟩, },
+  { intro a,
+    obtain ⟨b, ha⟩ := exists_gt a,
+    exact ⟨b, with_bot.coe_lt_coe.mpr ha⟩, }
+end⟩
+
+end with_bot
+
+--TODO(Mario): Construct using order dual on with_bot
+/-- Attach `⊤` to a type. -/
+def with_top (α : Type*) := option α
+
+namespace with_top
+
+variables {a b : α}
+
+meta instance [has_to_format α] : has_to_format (with_top α) :=
+{ to_format := λ x,
+  match x with
+  | none := "⊤"
+  | (some x) := to_fmt x
+  end }
+
+instance [has_repr α] : has_repr (with_top α) :=
+⟨λ o, match o with | none := "⊤" | (some a) := "↑" ++ repr a end⟩
+
+instance : has_coe_t α (with_top α) := ⟨some⟩
+instance : has_top (with_top α) := ⟨none⟩
+
+meta instance {α : Type} [reflected _ α] [has_reflect α] : has_reflect (with_top α)
+| ⊤ := `(⊤)
+| (a : α) := `(coe : α → with_top α).subst `(a)
+
+instance : inhabited (with_top α) := ⟨⊤⟩
+
+instance [nonempty α] : nontrivial (with_top α) := option.nontrivial
+
+protected lemma «forall» {p : with_top α → Prop} : (∀ x, p x) ↔ p ⊤ ∧ ∀ x : α, p x := option.forall
+protected lemma «exists» {p : with_top α → Prop} : (∃ x, p x) ↔ p ⊤ ∨ ∃ x : α, p x := option.exists
+
+lemma none_eq_top : (none : with_top α) = (⊤ : with_top α) := rfl
+lemma some_eq_coe (a : α) : (some a : with_top α) = (↑a : with_top α) := rfl
+
+@[simp] lemma top_ne_coe : ⊤ ≠ (a : with_top α) .
+@[simp] lemma coe_ne_top : (a : with_top α) ≠ ⊤ .
+
+/-- Recursor for `with_top` using the preferred forms `⊤` and `↑a`. -/
+@[elab_as_eliminator]
+def rec_top_coe {C : with_top α → Sort*} (h₁ : C ⊤) (h₂ : Π (a : α), C a) :
+  Π (n : with_top α), C n :=
+option.rec h₁ h₂
+
+@[simp] lemma rec_top_coe_top {C : with_top α → Sort*} (d : C ⊤) (f : Π (a : α), C a) :
+  @rec_top_coe _ C d f ⊤ = d := rfl
+@[simp] lemma rec_top_coe_coe {C : with_top α → Sort*} (d : C ⊤) (f : Π (a : α), C a)
+  (x : α) : @rec_top_coe _ C d f ↑x = f x := rfl
+
+/-- `with_top.to_dual` is the equivalence sending `⊤` to `⊥` and any `a : α` to `to_dual a : αᵒᵈ`.
+See `with_top.to_dual_bot_equiv` for the related order-iso.
+-/
+protected def to_dual : with_top α ≃ with_bot αᵒᵈ := equiv.refl _
+/-- `with_top.of_dual` is the equivalence sending `⊤` to `⊥` and any `a : αᵒᵈ` to `of_dual a : α`.
+See `with_top.to_dual_bot_equiv` for the related order-iso.
+-/
+protected def of_dual : with_top αᵒᵈ ≃ with_bot α := equiv.refl _
+/-- `with_bot.to_dual` is the equivalence sending `⊥` to `⊤` and any `a : α` to `to_dual a : αᵒᵈ`.
+See `with_bot.to_dual_top_equiv` for the related order-iso.
+-/
+protected def _root_.with_bot.to_dual : with_bot α ≃ with_top αᵒᵈ := equiv.refl _
+/-- `with_bot.of_dual` is the equivalence sending `⊥` to `⊤` and any `a : αᵒᵈ` to `of_dual a : α`.
+See `with_bot.to_dual_top_equiv` for the related order-iso.
+-/
+protected def _root_.with_bot.of_dual : with_bot αᵒᵈ ≃ with_top α := equiv.refl _
+
+@[simp] lemma to_dual_symm_apply (a : with_bot αᵒᵈ) :
+  with_top.to_dual.symm a = a.of_dual := rfl
+@[simp] lemma of_dual_symm_apply (a : with_bot α) :
+  with_top.of_dual.symm a = a.to_dual := rfl
+
+@[simp] lemma to_dual_apply_top : with_top.to_dual (⊤ : with_top α) = ⊥ := rfl
+@[simp] lemma of_dual_apply_top : with_top.of_dual (⊤ : with_top α) = ⊥ := rfl
+
+open order_dual
+
+@[simp] lemma to_dual_apply_coe (a : α) : with_top.to_dual (a : with_top α) = to_dual a := rfl
+@[simp] lemma of_dual_apply_coe (a : αᵒᵈ) : with_top.of_dual (a : with_top αᵒᵈ) = of_dual a := rfl
+
+/-- Specialization of `option.get_or_else` to values in `with_top α` that respects API boundaries.
+-/
+def untop' (d : α) (x : with_top α) : α := rec_top_coe d id x
+
+@[simp] lemma untop'_top {α} (d : α) : untop' d ⊤ = d := rfl
+@[simp] lemma untop'_coe {α} (d x : α) : untop' d x = x := rfl
+
+@[norm_cast] lemma coe_eq_coe : (a : with_top α) = b ↔ a = b := option.some_inj
+
+lemma untop'_eq_iff {d y : α} {x : with_top α} : untop' d x = y ↔ x = y ∨ x = ⊤ ∧ y = d :=
+with_bot.unbot'_eq_iff
+
+@[simp] theorem untop'_eq_self_iff {d : α} {x : with_top α} : untop' d x = d ↔ x = d ∨ x = ⊤ :=
+with_bot.unbot'_eq_self_iff
+
+theorem untop'_eq_untop'_iff {d : α} {x y : with_top α} :
+  untop' d x = untop' d y ↔ x = y ∨ x = d ∧ y = ⊤ ∨ x = ⊤ ∧ y = d :=
+with_bot.unbot'_eq_unbot'_iff
+
+/-- Lift a map `f : α → β` to `with_top α → with_top β`. Implemented using `option.map`. -/
+def map (f : α → β) : with_top α → with_top β := option.map f
+
+@[simp] lemma map_top (f : α → β) : map f ⊤ = ⊤ := rfl
+@[simp] lemma map_coe (f : α → β) (a : α) : map f a = f a := rfl
+
+lemma map_comm {f₁ : α → β} {f₂ : α → γ} {g₁ : β → δ} {g₂ : γ → δ} (h : g₁ ∘ f₁ = g₂ ∘ f₂) (a : α) :
+  map g₁ (map f₁ a) = map g₂ (map f₂ a) :=
+option.map_comm h _
+
+lemma map_to_dual (f : αᵒᵈ → βᵒᵈ) (a : with_bot α) :
+  map f (with_bot.to_dual a) = a.map (to_dual ∘ f) := rfl
+lemma map_of_dual (f : α → β) (a : with_bot αᵒᵈ) :
+  map f (with_bot.of_dual a) = a.map (of_dual ∘ f) := rfl
+
+lemma to_dual_map (f : α → β) (a : with_top α) :
+  with_top.to_dual (map f a) = with_bot.map (to_dual ∘ f ∘ of_dual) a.to_dual := rfl
+lemma of_dual_map (f : αᵒᵈ → βᵒᵈ) (a : with_top αᵒᵈ) :
+  with_top.of_dual (map f a) = with_bot.map (of_dual ∘ f ∘ to_dual) a.of_dual := rfl
+
+lemma ne_top_iff_exists {x : with_top α} : x ≠ ⊤ ↔ ∃ (a : α), ↑a = x := option.ne_none_iff_exists
+
+/-- Deconstruct a `x : with_top α` to the underlying value in `α`, given a proof that `x ≠ ⊤`. -/
+def untop : Π (x : with_top α), x ≠ ⊤ → α :=
+with_bot.unbot
+
+@[simp] lemma coe_untop (x : with_top α) (h : x ≠ ⊤) : (x.untop h : with_top α) = x :=
+with_bot.coe_unbot x h
+
+@[simp] lemma untop_coe (x : α) (h : (x : with_top α) ≠ ⊤ := coe_ne_top) :
+  (x : with_top α).untop h = x := rfl
+
+instance can_lift : can_lift (with_top α) α coe (λ r, r ≠ ⊤) :=
+{ prf := λ x h, ⟨x.untop h, coe_untop _ _⟩ }
+
+section has_le
+variables [has_le α]
+
+@[priority 10]
+instance : has_le (with_top α) := ⟨λ o₁ o₂ : option α, ∀ a ∈ o₂, ∃ b ∈ o₁, b ≤ a⟩
+
+lemma to_dual_le_iff {a : with_top α} {b : with_bot αᵒᵈ} :
+  with_top.to_dual a ≤ b ↔ with_bot.of_dual b ≤ a := iff.rfl
+lemma le_to_dual_iff {a : with_bot αᵒᵈ} {b : with_top α} :
+  a ≤ with_top.to_dual b ↔ b ≤ with_bot.of_dual a := iff.rfl
+@[simp] lemma to_dual_le_to_dual_iff {a b : with_top α} :
+  with_top.to_dual a ≤ with_top.to_dual b ↔ b ≤ a := iff.rfl
+
+lemma of_dual_le_iff {a : with_top αᵒᵈ} {b : with_bot α} :
+  with_top.of_dual a ≤ b ↔ with_bot.to_dual b ≤ a := iff.rfl
+lemma le_of_dual_iff {a : with_bot α} {b : with_top αᵒᵈ} :
+  a ≤ with_top.of_dual b ↔ b ≤ with_bot.to_dual a := iff.rfl
+@[simp] lemma of_dual_le_of_dual_iff {a b : with_top αᵒᵈ} :
+  with_top.of_dual a ≤ with_top.of_dual b ↔ b ≤ a := iff.rfl
+
+@[simp, norm_cast] lemma coe_le_coe : (a : with_top α) ≤ b ↔ a ≤ b :=
+by simp only [←to_dual_le_to_dual_iff, to_dual_apply_coe, with_bot.coe_le_coe, to_dual_le_to_dual]
+
+@[simp] lemma some_le_some : @has_le.le (with_top α) _ (some a) (some b) ↔ a ≤ b := coe_le_coe
+@[simp] lemma le_none {a : with_top α} : @has_le.le (with_top α) _ a none :=
+to_dual_le_to_dual_iff.mp with_bot.none_le
+
+instance : order_top (with_top α) := { le_top := λ a, le_none, .. with_top.has_top }
+
+instance [order_bot α] : order_bot (with_top α) :=
+{ bot := some ⊥,
+  bot_le := λ o a ha, by cases ha; exact ⟨_, rfl, bot_le⟩ }
+
+instance [order_bot α] : bounded_order (with_top α) :=
+{ ..with_top.order_top, ..with_top.order_bot }
+
+lemma not_top_le_coe (a : α) : ¬ (⊤ : with_top α) ≤ ↑a := with_bot.not_coe_le_bot (to_dual a)
+
+lemma le_coe : ∀ {o : option α}, a ∈ o → (@has_le.le (with_top α) _ o b ↔ a ≤ b) | _ rfl :=
+coe_le_coe
+
+lemma le_coe_iff {x : with_top α} : x ≤ b ↔ ∃ a : α, x = a ∧ a ≤ b :=
+by simpa [←to_dual_le_to_dual_iff, with_bot.coe_le_iff]
+
+lemma coe_le_iff {x : with_top α} : ↑a ≤ x ↔ ∀ b, x = ↑b → a ≤ b :=
+begin
+  simp only [←to_dual_le_to_dual_iff, to_dual_apply_coe, with_bot.le_coe_iff, order_dual.forall,
+             to_dual_le_to_dual],
+  exact forall₂_congr (λ _ _, iff.rfl)
+end
+
+protected lemma _root_.is_min.with_top (h : is_min a) : is_min (a : with_top α) :=
+begin
+  -- defeq to is_max_to_dual_iff.mp (is_max.with_bot _), but that breaks API boundary
+  intros _ hb,
+  rw ←to_dual_le_to_dual_iff at hb,
+  simpa [to_dual_le_iff] using (is_max.with_bot h : is_max (to_dual a : with_bot αᵒᵈ)) hb
+end
+
+end has_le
+
+section has_lt
+variables [has_lt α]
+
+@[priority 10]
+instance : has_lt (with_top α) := ⟨λ o₁ o₂ : option α, ∃ b ∈ o₁, ∀ a ∈ o₂, b < a⟩
+
+lemma to_dual_lt_iff {a : with_top α} {b : with_bot αᵒᵈ} :
+  with_top.to_dual a < b ↔ with_bot.of_dual b < a := iff.rfl
+lemma lt_to_dual_iff {a : with_bot αᵒᵈ} {b : with_top α} :
+  a < with_top.to_dual b ↔ b < with_bot.of_dual a := iff.rfl
+@[simp] lemma to_dual_lt_to_dual_iff {a b : with_top α} :
+  with_top.to_dual a < with_top.to_dual b ↔ b < a := iff.rfl
+
+lemma of_dual_lt_iff {a : with_top αᵒᵈ} {b : with_bot α} :
+  with_top.of_dual a < b ↔ with_bot.to_dual b < a := iff.rfl
+lemma lt_of_dual_iff {a : with_bot α} {b : with_top αᵒᵈ} :
+  a < with_top.of_dual b ↔ b < with_bot.to_dual a := iff.rfl
+@[simp] lemma of_dual_lt_of_dual_iff {a b : with_top αᵒᵈ} :
+  with_top.of_dual a < with_top.of_dual b ↔ b < a := iff.rfl
+
+end has_lt
+
+end with_top
+
+namespace with_bot
+
+open order_dual
+
+@[simp] lemma to_dual_symm_apply (a : with_top αᵒᵈ) : with_bot.to_dual.symm a = a.of_dual := rfl
+@[simp] lemma of_dual_symm_apply (a : with_top α) : with_bot.of_dual.symm a = a.to_dual := rfl
+
+@[simp] lemma to_dual_apply_bot : with_bot.to_dual (⊥ : with_bot α) = ⊤ := rfl
+@[simp] lemma of_dual_apply_bot : with_bot.of_dual (⊥ : with_bot α) = ⊤ := rfl
+@[simp] lemma to_dual_apply_coe (a : α) : with_bot.to_dual (a : with_bot α) = to_dual a := rfl
+@[simp] lemma of_dual_apply_coe (a : αᵒᵈ) : with_bot.of_dual (a : with_bot αᵒᵈ) = of_dual a := rfl
+
+lemma map_to_dual (f : αᵒᵈ → βᵒᵈ) (a : with_top α) :
+  with_bot.map f (with_top.to_dual a) = a.map (to_dual ∘ f) := rfl
+lemma map_of_dual (f : α → β) (a : with_top αᵒᵈ) :
+  with_bot.map f (with_top.of_dual a) = a.map (of_dual ∘ f) := rfl
+lemma to_dual_map (f : α → β) (a : with_bot α) :
+  with_bot.to_dual (with_bot.map f a) = map (to_dual ∘ f ∘ of_dual) a.to_dual := rfl
+lemma of_dual_map (f : αᵒᵈ → βᵒᵈ) (a : with_bot αᵒᵈ) :
+  with_bot.of_dual (with_bot.map f a) = map (of_dual ∘ f ∘ to_dual) a.of_dual := rfl
+
+section has_le
+
+variables [has_le α] {a b : α}
+
+lemma to_dual_le_iff {a : with_bot α} {b : with_top αᵒᵈ} :
+  with_bot.to_dual a ≤ b ↔ with_top.of_dual b ≤ a := iff.rfl
+lemma le_to_dual_iff {a : with_top αᵒᵈ} {b : with_bot α} :
+  a ≤ with_bot.to_dual b ↔ b ≤ with_top.of_dual a := iff.rfl
+@[simp] lemma to_dual_le_to_dual_iff {a b : with_bot α} :
+  with_bot.to_dual a ≤ with_bot.to_dual b ↔ b ≤ a := iff.rfl
+
+lemma of_dual_le_iff {a : with_bot αᵒᵈ} {b : with_top α} :
+  with_bot.of_dual a ≤ b ↔ with_top.to_dual b ≤ a := iff.rfl
+lemma le_of_dual_iff {a : with_top α} {b : with_bot αᵒᵈ} :
+  a ≤ with_bot.of_dual b ↔ b ≤ with_top.to_dual a := iff.rfl
+@[simp] lemma of_dual_le_of_dual_iff {a b : with_bot αᵒᵈ} :
+  with_bot.of_dual a ≤ with_bot.of_dual b ↔ b ≤ a := iff.rfl
+
+end has_le
+
+section has_lt
+
+variables [has_lt α] {a b : α}
+
+lemma to_dual_lt_iff {a : with_bot α} {b : with_top αᵒᵈ} :
+  with_bot.to_dual a < b ↔ with_top.of_dual b < a := iff.rfl
+lemma lt_to_dual_iff {a : with_top αᵒᵈ} {b : with_bot α} :
+  a < with_bot.to_dual b ↔ b < with_top.of_dual a := iff.rfl
+@[simp] lemma to_dual_lt_to_dual_iff {a b : with_bot α} :
+  with_bot.to_dual a < with_bot.to_dual b ↔ b < a := iff.rfl
+
+lemma of_dual_lt_iff {a : with_bot αᵒᵈ} {b : with_top α} :
+  with_bot.of_dual a < b ↔ with_top.to_dual b < a := iff.rfl
+lemma lt_of_dual_iff {a : with_top α} {b : with_bot αᵒᵈ} :
+  a < with_bot.of_dual b ↔ b < with_top.to_dual a := iff.rfl
+@[simp] lemma of_dual_lt_of_dual_iff {a b : with_bot αᵒᵈ} :
+  with_bot.of_dual a < with_bot.of_dual b ↔ b < a := iff.rfl
+
+end has_lt
+
+end with_bot
+
+namespace with_top
+
+section has_lt
+variables [has_lt α] {a b : α}
+
+open order_dual
+
+@[simp, norm_cast] lemma coe_lt_coe : (a : with_top α) < b ↔ a < b :=
+by simp only [←to_dual_lt_to_dual_iff, to_dual_apply_coe, with_bot.coe_lt_coe, to_dual_lt_to_dual]
+@[simp] lemma some_lt_some : @has_lt.lt (with_top α) _ (some a) (some b) ↔ a < b := coe_lt_coe
+
+lemma coe_lt_top (a : α) : (a : with_top α) < ⊤ :=
+by simpa [←to_dual_lt_to_dual_iff] using with_bot.bot_lt_coe _
+@[simp] lemma some_lt_none (a : α) : @has_lt.lt (with_top α) _ (some a) none := coe_lt_top a
+
+@[simp] lemma not_none_lt (a : with_top α) : ¬ @has_lt.lt (with_top α) _ none a :=
+begin
+  rw [←to_dual_lt_to_dual_iff],
+  exact with_bot.not_lt_none _
+end
+
+lemma lt_iff_exists_coe {a b : with_top α} : a < b ↔ ∃ p : α, a = p ∧ ↑p < b :=
+begin
+  rw [←to_dual_lt_to_dual_iff, with_bot.lt_iff_exists_coe, order_dual.exists],
+  exact exists_congr (λ _, and_congr_left' iff.rfl)
+end
+
+lemma coe_lt_iff {x : with_top α} : ↑a < x ↔ ∀ b, x = ↑b → a < b :=
+begin
+  simp only [←to_dual_lt_to_dual_iff, with_bot.lt_coe_iff, to_dual_apply_coe, order_dual.forall,
+              to_dual_lt_to_dual],
+  exact forall₂_congr (λ _ _, iff.rfl)
+end
+
+/-- A version of `lt_top_iff_ne_top` for `with_top` that only requires `has_lt α`, not
+`partial_order α`. -/
+protected theorem lt_top_iff_ne_top {x : with_top α} : x < ⊤ ↔ x ≠ ⊤ :=
+@with_bot.bot_lt_iff_ne_bot αᵒᵈ _ x
+
+end has_lt
+
+instance [preorder α] : preorder (with_top α) :=
+{ le          := (≤),
+  lt          := (<),
+  lt_iff_le_not_le := by simp [←to_dual_lt_to_dual_iff, lt_iff_le_not_le],
+  le_refl     := λ _, to_dual_le_to_dual_iff.mp le_rfl,
+  le_trans    := λ _ _ _, by { simp_rw [←to_dual_le_to_dual_iff], exact function.swap le_trans } }
+
+instance [partial_order α] : partial_order (with_top α) :=
+{ le_antisymm := λ _ _, by { simp_rw [←to_dual_le_to_dual_iff], exact function.swap le_antisymm },
+  .. with_top.preorder }
+
+lemma coe_strict_mono [preorder α] : strict_mono (coe : α → with_top α) := λ a b, some_lt_some.2
+lemma coe_mono [preorder α] : monotone (coe : α → with_top α) := λ a b, coe_le_coe.2
+
+lemma monotone_iff [preorder α] [preorder β] {f : with_top α → β} :
+  monotone f ↔ monotone (f ∘ coe : α → β) ∧ ∀ x : α, f x ≤ f ⊤ :=
+⟨λ h, ⟨h.comp with_top.coe_mono, λ x, h le_top⟩,
+  λ h, with_top.forall.2 ⟨with_top.forall.2 ⟨λ _, le_rfl, λ x h, (not_top_le_coe _ h).elim⟩,
+  λ x, with_top.forall.2 ⟨λ _, h.2 x, λ y hle, h.1 (coe_le_coe.1 hle)⟩⟩⟩
+
+@[simp] lemma monotone_map_iff [preorder α] [preorder β] {f : α → β} :
+  monotone (with_top.map f) ↔ monotone f :=
+monotone_iff.trans $ by simp [monotone]
+
+alias monotone_map_iff ↔ _ _root_.monotone.with_top_map
+
+lemma strict_mono_iff [preorder α] [preorder β] {f : with_top α → β} :
+  strict_mono f ↔ strict_mono (f ∘ coe : α → β) ∧ ∀ x : α, f x < f ⊤ :=
+⟨λ h, ⟨h.comp with_top.coe_strict_mono, λ x, h (coe_lt_top _)⟩,
+  λ h, with_top.forall.2 ⟨with_top.forall.2 ⟨flip absurd (lt_irrefl _), λ x h, (not_top_lt h).elim⟩,
+  λ x, with_top.forall.2 ⟨λ _, h.2 x, λ y hle, h.1 (coe_lt_coe.1 hle)⟩⟩⟩
+
+@[simp] lemma strict_mono_map_iff [preorder α] [preorder β] {f : α → β} :
+  strict_mono (with_top.map f) ↔ strict_mono f :=
+strict_mono_iff.trans $ by simp [strict_mono, coe_lt_top]
+
+alias strict_mono_map_iff ↔ _ _root_.strict_mono.with_top_map
+
+lemma map_le_iff [preorder α] [preorder β] (f : α → β)
+  (a b : with_top α) (mono_iff : ∀ {a b}, f a ≤ f b ↔ a ≤ b) :
+  a.map f ≤ b.map f ↔ a ≤ b :=
+begin
+  rw [←to_dual_le_to_dual_iff, to_dual_map, to_dual_map, with_bot.map_le_iff,
+      to_dual_le_to_dual_iff],
+  simp [mono_iff]
+end
+
+instance [semilattice_inf α] : semilattice_inf (with_top α) :=
+{ inf          := option.lift_or_get (⊓),
+  inf_le_left  := λ o₁ o₂ a ha,
+    by cases ha; cases o₂; simp [option.lift_or_get],
+  inf_le_right := λ o₁ o₂ a ha,
+    by cases ha; cases o₁; simp [option.lift_or_get],
+  le_inf       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
+    cases o₂ with b; cases o₃ with c; cases ha,
+    { exact h₂ a rfl },
+    { exact h₁ a rfl },
+    { rcases h₁ b rfl with ⟨d, ⟨⟩, h₁'⟩,
+      simp at h₂,
+      exact ⟨d, rfl, le_inf h₁' h₂⟩ }
+  end,
+  ..with_top.partial_order }
+
+lemma coe_inf [semilattice_inf α] (a b : α) : ((a ⊓ b : α) : with_top α) = a ⊓ b := rfl
+
+instance [semilattice_sup α] : semilattice_sup (with_top α) :=
+{ sup          := option.map₂ (⊔),
+  le_sup_left  := λ o₁ o₂ a ha, begin
+    rcases option.mem_map₂_iff.1 ha with ⟨a, b, (rfl : _ = _), (rfl : _ = _), rfl⟩,
+    exact ⟨_, rfl, le_sup_left⟩
+  end,
+  le_sup_right := λ o₁ o₂ a ha, begin
+    rcases option.mem_map₂_iff.1 ha with ⟨a, b, (rfl : _ = _), (rfl : _ = _), rfl⟩,
+    exact ⟨_, rfl, le_sup_right⟩
+  end,
+  sup_le       := λ o₁ o₂ o₃ h₁ h₂ a ha, begin
+    cases ha,
+    rcases h₁ a rfl with ⟨b, ⟨⟩, ab⟩,
+    rcases h₂ a rfl with ⟨c, ⟨⟩, ac⟩,
+    exact ⟨_, rfl, sup_le ab ac⟩
+  end,
+  ..with_top.partial_order }
+
+lemma coe_sup [semilattice_sup α] (a b : α) : ((a ⊔ b : α) : with_top α) = a ⊔ b := rfl
+
+instance [lattice α] : lattice (with_top α) :=
+{ ..with_top.semilattice_sup, ..with_top.semilattice_inf }
+
+instance [distrib_lattice α] : distrib_lattice (with_top α) :=
+{ le_sup_inf := λ o₁ o₂ o₃,
+  match o₁, o₂, o₃ with
+  | ⊤, o₂, o₃ := le_rfl
+  | (a₁ : α), ⊤, ⊤ := le_rfl
+  | (a₁ : α), ⊤, (a₃ : α) := le_rfl
+  | (a₁ : α), (a₂ : α), ⊤ := le_rfl
+  | (a₁ : α), (a₂ : α), (a₃ : α) := coe_le_coe.mpr le_sup_inf
+  end,
+  ..with_top.lattice }
+
+instance decidable_le [has_le α] [@decidable_rel α (≤)] : @decidable_rel (with_top α) (≤) :=
+λ _ _, decidable_of_decidable_of_iff (with_bot.decidable_le _ _) (to_dual_le_to_dual_iff)
+
+instance decidable_lt [has_lt α] [@decidable_rel α (<)] : @decidable_rel (with_top α) (<) :=
+λ _ _, decidable_of_decidable_of_iff (with_bot.decidable_lt _ _) (to_dual_lt_to_dual_iff)
+
+instance is_total_le [has_le α] [is_total α (≤)] : is_total (with_top α) (≤) :=
+⟨λ _ _, by { simp_rw ←to_dual_le_to_dual_iff, exact total_of _ _ _ }⟩
+
+instance [linear_order α] : linear_order (with_top α) := lattice.to_linear_order _
+
+@[simp, norm_cast]
+lemma coe_min [linear_order α] (x y : α) : (↑(min x y) : with_top α) = min x y := rfl
+
+@[simp, norm_cast]
+lemma coe_max [linear_order α] (x y : α) : (↑(max x y) : with_top α) = max x y := rfl
+
+lemma well_founded_lt [preorder α] (h : @well_founded α (<)) : @well_founded (with_top α) (<) :=
+have acc_some : ∀ a : α, acc ((<) : with_top α → with_top α → Prop) (some a) :=
+λ a, acc.intro _ (well_founded.induction h a
+  (show ∀ b, (∀ c, c < b → ∀ d : with_top α, d < some c → acc (<) d) →
+    ∀ y : with_top α, y < some b → acc (<) y,
+  from λ b ih c, option.rec_on c (λ hc, (not_lt_of_ge le_top hc).elim)
+    (λ c hc, acc.intro _ (ih _ (some_lt_some.1 hc))))),
+⟨λ a, option.rec_on a (acc.intro _ (λ y, option.rec_on y (λ h, (lt_irrefl _ h).elim)
+  (λ _ _, acc_some _))) acc_some⟩
+
+open order_dual
+
+lemma well_founded_gt [preorder α] (h : @well_founded α (>)) : @well_founded (with_top α) (>) :=
+⟨λ a, begin
+  -- ideally, use rel_hom_class.acc, but that is defined later
+  have : acc (<) a.to_dual := well_founded.apply (with_bot.well_founded_lt h) _,
+  revert this,
+  generalize ha : a.to_dual = b, intro ac,
+  induction ac with _ H IH generalizing a, subst ha,
+  exact ⟨_, λ a' h, IH (a'.to_dual) (to_dual_lt_to_dual.mpr h) _ rfl⟩
+end⟩
+
+lemma _root_.with_bot.well_founded_gt [preorder α] (h : @well_founded α (>)) :
+  @well_founded (with_bot α) (>) :=
+⟨λ a, begin
+  -- ideally, use rel_hom_class.acc, but that is defined later
+  have : acc (<) a.to_dual := well_founded.apply (with_top.well_founded_lt h) _,
+  revert this,
+  generalize ha : a.to_dual = b, intro ac,
+  induction ac with _ H IH generalizing a, subst ha,
+  exact ⟨_, λ a' h, IH (a'.to_dual) (to_dual_lt_to_dual.mpr h) _ rfl⟩
+end⟩
+
+instance trichotomous.lt [preorder α] [is_trichotomous α (<)] : is_trichotomous (with_top α) (<) :=
+⟨begin
+  rintro (a | _) (b | _),
+  iterate 3 { simp },
+  simpa [option.some_inj] using @trichotomous _ (<) _ a b
+end⟩
+
+instance is_well_order.lt [preorder α] [h : is_well_order α (<)] : is_well_order (with_top α) (<) :=
+{ wf := well_founded_lt h.wf }
+
+instance trichotomous.gt [preorder α] [is_trichotomous α (>)] : is_trichotomous (with_top α) (>) :=
+⟨begin
+  rintro (a | _) (b | _),
+  iterate 3 { simp },
+  simpa [option.some_inj] using @trichotomous _ (>) _ a b
+end⟩
+
+instance is_well_order.gt [preorder α] [h : is_well_order α (>)] : is_well_order (with_top α) (>) :=
+{ wf := well_founded_gt h.wf }
+
+instance _root_.with_bot.trichotomous.lt [preorder α] [h : is_trichotomous α (<)] :
+  is_trichotomous (with_bot α) (<) :=
+@with_top.trichotomous.gt αᵒᵈ _ h
+
+instance _root_.with_bot.is_well_order.lt [preorder α] [h : is_well_order α (<)] :
+  is_well_order (with_bot α) (<) :=
+@with_top.is_well_order.gt αᵒᵈ _ h
+
+instance _root_.with_bot.trichotomous.gt [preorder α] [h : is_trichotomous α (>)] :
+  is_trichotomous (with_bot α) (>) :=
+@with_top.trichotomous.lt αᵒᵈ _ h
+
+instance _root_.with_bot.is_well_order.gt [preorder α] [h : is_well_order α (>)] :
+  is_well_order (with_bot α) (>) :=
+@with_top.is_well_order.lt αᵒᵈ _ h
+
+instance [has_lt α] [densely_ordered α] [no_max_order α] : densely_ordered (with_top α) :=
+order_dual.densely_ordered (with_bot αᵒᵈ)
+
+lemma lt_iff_exists_coe_btwn [preorder α] [densely_ordered α] [no_max_order α] {a b : with_top α} :
+  a < b ↔ ∃ x : α, a < ↑x ∧ ↑x < b :=
+⟨λ h, let ⟨y, hy⟩ := exists_between h, ⟨x, hx⟩ := lt_iff_exists_coe.1 hy.2 in ⟨x, hx.1 ▸ hy⟩,
+ λ ⟨x, hx⟩, lt_trans hx.1 hx.2⟩
+
+instance [has_le α] [no_bot_order α] [nonempty α] : no_bot_order (with_top α) :=
+order_dual.no_bot_order (with_bot αᵒᵈ)
+
+instance [has_lt α] [no_min_order α] [nonempty α] : no_min_order (with_top α) :=
+order_dual.no_min_order (with_bot αᵒᵈ)
+
+end with_top
diff --git a/src/order/zorn.lean b/src/order/zorn.lean
index 2804ab41623b0..7d1e922a3b667 100644
--- a/src/order/zorn.lean
+++ b/src/order/zorn.lean
@@ -8,6 +8,9 @@ import order.chain
 /-!
 # Zorn's lemmas
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves several formulations of Zorn's Lemma.
 
 ## Variants
@@ -129,6 +132,13 @@ begin
       exact ⟨z, ⟨hzs, (hcs hy).2.trans $ hz _ hy⟩, hz⟩ } }
 end
 
+lemma zorn_nonempty_Ici₀ (a : α)
+  (ih : ∀ c ⊆ Ici a, is_chain (≤) c → ∀ y ∈ c, ∃ ub, a ≤ ub ∧ ∀ z ∈ c, z ≤ ub) (x : α)
+  (hax : a ≤ x) :
+  ∃ m, x ≤ m ∧ ∀ z, m ≤ z → z ≤ m :=
+let ⟨m, hma, hxm, hm⟩ := zorn_nonempty_preorder₀ (Ici a) (by simpa using ih) x hax in
+  ⟨m, hxm, λ z hmz, hm _ (hax.trans $ hxm.trans hmz) hmz⟩
+
 end preorder
 
 section partial_order
diff --git a/src/order/zorn_atoms.lean b/src/order/zorn_atoms.lean
new file mode 100644
index 0000000000000..e8f47f21475b7
--- /dev/null
+++ b/src/order/zorn_atoms.lean
@@ -0,0 +1,42 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import order.zorn
+import order.atoms
+
+/-!
+# Zorn lemma for (co)atoms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we use Zorn's lemma to prove that a partial order is atomic if every nonempty chain
+`c`, `⊥ ∉ c`, has a lower bound not equal to `⊥`. We also prove the order dual version of this
+statement.
+-/
+
+open set
+
+/-- **Zorn's lemma**: A partial order is coatomic if every nonempty chain `c`, `⊤ ∉ c`, has an upper
+bound not equal to `⊤`. -/
+lemma is_coatomic.of_is_chain_bounded {α : Type*} [partial_order α] [order_top α]
+  (h : ∀ c : set α, is_chain (≤) c → c.nonempty → ⊤ ∉ c → ∃ x ≠ ⊤, x ∈ upper_bounds c) :
+  is_coatomic α :=
+begin
+  refine ⟨λ x, le_top.eq_or_lt.imp_right $ λ hx, _⟩,
+  rcases zorn_nonempty_partial_order₀ (Ico x ⊤) (λ c hxc hc y hy, _) x (left_mem_Ico.2 hx)
+    with ⟨y, ⟨hxy, hy⟩, -, hy'⟩,
+  { refine ⟨y, ⟨hy.ne, λ z hyz, le_top.eq_or_lt.resolve_right $ λ hz, _⟩, hxy⟩,
+    exact hyz.ne' (hy' z ⟨hxy.trans hyz.le, hz⟩ hyz.le) },
+  { rcases h c hc ⟨y, hy⟩ (λ h, (hxc h).2.ne rfl) with ⟨z, hz, hcz⟩,
+    exact ⟨z, ⟨le_trans (hxc hy).1 (hcz hy), hz.lt_top⟩, hcz⟩ }
+end
+
+/-- **Zorn's lemma**: A partial order is atomic if every nonempty chain `c`, `⊥ ∉ c`, has an lower
+bound not equal to `⊥`. -/
+lemma is_atomic.of_is_chain_bounded {α : Type*} [partial_order α] [order_bot α]
+  (h : ∀ c : set α, is_chain (≤) c → c.nonempty → ⊥ ∉ c → ∃ x ≠ ⊥, x ∈ lower_bounds c) :
+  is_atomic α :=
+is_coatomic_dual_iff_is_atomic.mp $ is_coatomic.of_is_chain_bounded $ λ c hc, h c hc.symm
diff --git a/src/probability/borel_cantelli.lean b/src/probability/borel_cantelli.lean
new file mode 100644
index 0000000000000..47b794c3ddc16
--- /dev/null
+++ b/src/probability/borel_cantelli.lean
@@ -0,0 +1,112 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import probability.martingale.borel_cantelli
+import probability.conditional_expectation
+import probability.independence.basic
+
+/-!
+
+# The second Borel-Cantelli lemma
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains the second Borel-Cantelli lemma which states that, given a sequence of
+independent sets `(sₙ)` in a probability space, if `∑ n, μ sₙ = ∞`, then the limsup of `sₙ` has
+measure 1. We employ a proof using Lévy's generalized Borel-Cantelli by choosing an appropriate
+filtration.
+
+## Main result
+
+- `probability_theory.measure_limsup_eq_one`: the second Borel-Cantelli lemma.
+
+-/
+
+open_locale measure_theory probability_theory ennreal big_operators topology
+
+open measure_theory probability_theory measurable_space topological_space
+
+namespace probability_theory
+
+variables {Ω : Type*} {m0 : measurable_space Ω} {μ : measure Ω}
+  [is_probability_measure μ]
+
+section borel_cantelli
+
+variables {ι β : Type*} [linear_order ι] [mβ : measurable_space β] [normed_add_comm_group β]
+  [borel_space β] {f : ι → Ω → β} {i j : ι} {s : ι → set Ω}
+
+lemma Indep_fun.indep_comap_natural_of_lt (hf : ∀ i, strongly_measurable (f i))
+  (hfi : Indep_fun (λ i, mβ) f μ) (hij : i < j) :
+  indep (measurable_space.comap (f j) mβ) (filtration.natural f hf i) μ :=
+begin
+  suffices : indep (⨆ k ∈ {j}, measurable_space.comap (f k) mβ)
+    (⨆ k ∈ {k | k ≤ i}, measurable_space.comap (f k) mβ) μ,
+  { rwa supr_singleton at this },
+  exact indep_supr_of_disjoint (λ k, (hf k).measurable.comap_le) hfi (by simpa),
+end
+
+lemma Indep_fun.condexp_natural_ae_eq_of_lt
+  [second_countable_topology β] [complete_space β] [normed_space ℝ β]
+  (hf : ∀ i, strongly_measurable (f i)) (hfi : Indep_fun (λ i, mβ) f μ) (hij : i < j) :
+  μ[f j | filtration.natural f hf i] =ᵐ[μ] λ ω, μ[f j] :=
+condexp_indep_eq (hf j).measurable.comap_le (filtration.le _ _)
+  (comap_measurable $ f j).strongly_measurable
+  (hfi.indep_comap_natural_of_lt hf hij)
+
+lemma Indep_set.condexp_indicator_filtration_of_set_ae_eq
+  (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (hij : i < j) :
+  μ[(s j).indicator (λ ω, 1 : Ω → ℝ) | filtration_of_set hsm i] =ᵐ[μ] λ ω, (μ (s j)).to_real :=
+begin
+  rw filtration.filtration_of_set_eq_natural hsm,
+  refine (Indep_fun.condexp_natural_ae_eq_of_lt _ hs.Indep_fun_indicator hij).trans _,
+  { simp only [integral_indicator_const _ (hsm _), algebra.id.smul_eq_mul, mul_one] },
+  { apply_instance }
+end
+
+open filter
+
+/-- **The second Borel-Cantelli lemma**: Given a sequence of independent sets `(sₙ)` such that
+`∑ n, μ sₙ = ∞`, `limsup sₙ` has measure 1. -/
+lemma measure_limsup_eq_one {s : ℕ → set Ω}
+  (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (hs' : ∑' n, μ (s n) = ∞) :
+  μ (limsup s at_top) = 1 :=
+begin
+  rw measure_congr (eventually_eq_set.2 (ae_mem_limsup_at_top_iff μ $
+    measurable_set_filtration_of_set' hsm) :
+      (limsup s at_top : set Ω) =ᵐ[μ] {ω | tendsto (λ n, ∑ k in finset.range n,
+        μ[(s (k + 1)).indicator (1 : Ω → ℝ) | filtration_of_set hsm k] ω) at_top at_top}),
+  suffices : {ω | tendsto (λ n, ∑ k in finset.range n,
+    μ[(s (k + 1)).indicator (1 : Ω → ℝ) | filtration_of_set hsm k] ω) at_top at_top} =ᵐ[μ] set.univ,
+  { rw [measure_congr this, measure_univ] },
+  have : ∀ᵐ ω ∂μ, ∀ n, μ[(s (n + 1)).indicator (1 : Ω → ℝ) | filtration_of_set hsm n] ω = _ :=
+    ae_all_iff.2 (λ n, hs.condexp_indicator_filtration_of_set_ae_eq hsm n.lt_succ_self),
+  filter_upwards [this] with ω hω,
+  refine eq_true_intro (_ : tendsto _ _ _),
+  simp_rw hω,
+  have htends : tendsto (λ n, ∑ k in finset.range n, μ (s (k + 1))) at_top (𝓝 ∞),
+  { rw ← ennreal.tsum_add_one_eq_top hs' (measure_ne_top _ _),
+    exact ennreal.tendsto_nat_tsum _ },
+  rw ennreal.tendsto_nhds_top_iff_nnreal at htends,
+  refine tendsto_at_top_at_top_of_monotone' _ _,
+  { refine monotone_nat_of_le_succ (λ n, _),
+    rw [← sub_nonneg, finset.sum_range_succ_sub_sum],
+    exact ennreal.to_real_nonneg },
+  { rintro ⟨B, hB⟩,
+    refine not_eventually.2 (frequently_of_forall $ λ n, _) (htends B.to_nnreal),
+    rw mem_upper_bounds at hB,
+    specialize hB (∑ (k : ℕ) in finset.range n, μ (s (k + 1))).to_real _,
+    { refine ⟨n, _⟩,
+      rw ennreal.to_real_sum,
+      exact λ _ _, measure_ne_top _ _ },
+    { rw [not_lt, ← ennreal.to_real_le_to_real (ennreal.sum_lt_top _).ne ennreal.coe_ne_top],
+      { exact hB.trans (by simp) },
+      { exact λ _ _, measure_ne_top _ _ } } }
+end
+
+end borel_cantelli
+
+end probability_theory
diff --git a/src/probability/cond_count.lean b/src/probability/cond_count.lean
new file mode 100644
index 0000000000000..3145180686d02
--- /dev/null
+++ b/src/probability/cond_count.lean
@@ -0,0 +1,215 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying, Bhavik Mehta
+-/
+import probability.conditional_probability
+
+/-!
+# Classical probability
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The classical formulation of probability states that the probability of an event occurring in a
+finite probability space is the ratio of that event to all possible events.
+This notion can be expressed with measure theory using
+the counting measure. In particular, given the sets `s` and `t`, we define the probability of `t`
+occuring in `s` to be `|s|⁻¹ * |s ∩ t|`. With this definition, we recover the the probability over
+the entire sample space when `s = set.univ`.
+
+Classical probability is often used in combinatorics and we prove some useful lemmas in this file
+for that purpose.
+
+## Main definition
+
+* `probability_theory.cond_count`: given a set `s`, `cond_count s` is the counting measure
+  conditioned on `s`. This is a probability measure when `s` is finite and nonempty.
+
+## Notes
+
+The original aim of this file is to provide a measure theoretic method of describing the
+probability an element of a set `s` satisfies some predicate `P`. Our current formulation still
+allow us to describe this by abusing the definitional equality of sets and predicates by simply
+writing `cond_count s P`. We should avoid this however as none of the lemmas are written for
+predicates.
+-/
+
+noncomputable theory
+
+open_locale probability_theory
+
+open measure_theory measurable_space
+
+namespace probability_theory
+
+variables {Ω : Type*} [measurable_space Ω]
+
+/-- Given a set `s`, `cond_count s` is the counting measure conditioned on `s`. In particular,
+`cond_count s t` is the proportion of `s` that is contained in `t`.
+
+This is a probability measure when `s` is finite and nonempty and is given by
+`probability_theory.cond_count_is_probability_measure`. -/
+def cond_count (s : set Ω) : measure Ω := measure.count[|s]
+
+@[simp] lemma cond_count_empty_meas : (cond_count ∅ : measure Ω) = 0 :=
+by simp [cond_count]
+
+lemma cond_count_empty {s : set Ω} : cond_count s ∅ = 0 :=
+by simp
+
+lemma finite_of_cond_count_ne_zero {s t : set Ω} (h : cond_count s t ≠ 0) :
+  s.finite :=
+begin
+  by_contra hs',
+  simpa [cond_count, cond, measure.count_apply_infinite hs'] using h,
+end
+
+lemma cond_count_univ [fintype Ω] {s : set Ω} :
+  cond_count set.univ s = measure.count s / fintype.card Ω :=
+begin
+  rw [cond_count, cond_apply _ measurable_set.univ, ←ennreal.div_eq_inv_mul, set.univ_inter],
+  congr',
+  rw [←finset.coe_univ, measure.count_apply, finset.univ.tsum_subtype' (λ _, (1 : ennreal))],
+  { simp [finset.card_univ] },
+  { exact (@finset.coe_univ Ω _).symm ▸ measurable_set.univ }
+end
+
+variables [measurable_singleton_class Ω]
+
+lemma cond_count_is_probability_measure {s : set Ω} (hs : s.finite) (hs' : s.nonempty) :
+  is_probability_measure (cond_count s) :=
+{ measure_univ :=
+  begin
+    rw [cond_count, cond_apply _ hs.measurable_set, set.inter_univ, ennreal.inv_mul_cancel],
+    { exact λ h, hs'.ne_empty $ measure.empty_of_count_eq_zero h },
+    { exact (measure.count_apply_lt_top.2 hs).ne }
+  end }
+
+lemma cond_count_singleton (ω : Ω) (t : set Ω) [decidable (ω ∈ t)] :
+  cond_count {ω} t = if ω ∈ t then 1 else 0 :=
+begin
+  rw [cond_count, cond_apply _ (measurable_set_singleton ω), measure.count_singleton,
+    inv_one, one_mul],
+  split_ifs,
+  { rw [(by simpa : ({ω} : set Ω) ∩ t = {ω}), measure.count_singleton] },
+  { rw [(by simpa : ({ω} : set Ω) ∩ t = ∅), measure.count_empty] },
+end
+
+variables {s t u : set Ω}
+
+lemma cond_count_inter_self (hs : s.finite):
+  cond_count s (s ∩ t) = cond_count s t :=
+by rw [cond_count, cond_inter_self _ hs.measurable_set]
+
+lemma cond_count_self (hs : s.finite) (hs' : s.nonempty) :
+  cond_count s s = 1 :=
+begin
+  rw [cond_count, cond_apply _ hs.measurable_set, set.inter_self, ennreal.inv_mul_cancel],
+  { exact λ h, hs'.ne_empty $ measure.empty_of_count_eq_zero h },
+  { exact (measure.count_apply_lt_top.2 hs).ne }
+end
+
+lemma cond_count_eq_one_of (hs : s.finite) (hs' : s.nonempty) (ht : s ⊆ t) :
+  cond_count s t = 1 :=
+begin
+  haveI := cond_count_is_probability_measure hs hs',
+  refine eq_of_le_of_not_lt prob_le_one _,
+  rw [not_lt, ← cond_count_self hs hs'],
+  exact measure_mono ht,
+end
+
+lemma pred_true_of_cond_count_eq_one (h : cond_count s t = 1) :
+  s ⊆ t :=
+begin
+  have hsf := finite_of_cond_count_ne_zero (by { rw h, exact one_ne_zero }),
+  rw [cond_count, cond_apply _ hsf.measurable_set, mul_comm] at h,
+  replace h := ennreal.eq_inv_of_mul_eq_one_left h,
+  rw [inv_inv, measure.count_apply_finite _ hsf,
+    measure.count_apply_finite _ (hsf.inter_of_left _), nat.cast_inj] at h,
+  suffices : s ∩ t = s,
+  { exact this ▸ λ x hx, hx.2 },
+  rw ← @set.finite.to_finset_inj _ _ _ (hsf.inter_of_left _) hsf,
+  exact finset.eq_of_subset_of_card_le (set.finite.to_finset_mono $ s.inter_subset_left t) h.ge,
+end
+
+lemma cond_count_eq_zero_iff (hs : s.finite) :
+  cond_count s t = 0 ↔ s ∩ t = ∅ :=
+by simp [cond_count, cond_apply _ hs.measurable_set, measure.count_apply_eq_top,
+    set.not_infinite.2 hs, measure.count_apply_finite _ (hs.inter_of_left _)]
+
+lemma cond_count_of_univ (hs : s.finite) (hs' : s.nonempty) :
+  cond_count s set.univ = 1 :=
+cond_count_eq_one_of hs hs' s.subset_univ
+
+lemma cond_count_inter (hs : s.finite) :
+  cond_count s (t ∩ u) = cond_count (s ∩ t) u * cond_count s t :=
+begin
+  by_cases hst : s ∩ t = ∅,
+  { rw [hst, cond_count_empty_meas, measure.coe_zero, pi.zero_apply, zero_mul,
+      cond_count_eq_zero_iff hs, ← set.inter_assoc, hst, set.empty_inter] },
+  rw [cond_count, cond_count, cond_apply _ hs.measurable_set, cond_apply _ hs.measurable_set,
+    cond_apply _ (hs.inter_of_left _).measurable_set,
+    mul_comm _ (measure.count (s ∩ t)), ← mul_assoc, mul_comm _ (measure.count (s ∩ t)),
+    ← mul_assoc, ennreal.mul_inv_cancel, one_mul, mul_comm, set.inter_assoc],
+  { rwa ← measure.count_eq_zero_iff at hst },
+  { exact (measure.count_apply_lt_top.2 $ hs.inter_of_left _).ne }
+end
+
+lemma cond_count_inter' (hs : s.finite) :
+  cond_count s (t ∩ u) = cond_count (s ∩ u) t * cond_count s u :=
+begin
+  rw ← set.inter_comm,
+  exact cond_count_inter hs,
+end
+
+lemma cond_count_union (hs : s.finite) (htu : disjoint t u) :
+  cond_count s (t ∪ u) = cond_count s t + cond_count s u :=
+begin
+  rw [cond_count, cond_apply _ hs.measurable_set, cond_apply _ hs.measurable_set,
+    cond_apply _ hs.measurable_set, set.inter_union_distrib_left, measure_union, mul_add],
+  exacts [htu.mono inf_le_right inf_le_right, (hs.inter_of_left _).measurable_set],
+end
+
+lemma cond_count_compl (t : set Ω) (hs : s.finite) (hs' : s.nonempty) :
+  cond_count s t + cond_count s tᶜ = 1 :=
+begin
+  rw [← cond_count_union hs disjoint_compl_right, set.union_compl_self,
+    (cond_count_is_probability_measure hs hs').measure_univ],
+end
+
+lemma cond_count_disjoint_union (hs : s.finite) (ht : t.finite) (hst : disjoint s t) :
+  cond_count s u * cond_count (s ∪ t) s + cond_count t u * cond_count (s ∪ t) t =
+  cond_count (s ∪ t) u :=
+begin
+  rcases s.eq_empty_or_nonempty with (rfl | hs');
+  rcases t.eq_empty_or_nonempty with (rfl | ht'),
+  { simp },
+  { simp [cond_count_self ht ht'] },
+  { simp [cond_count_self hs hs'] },
+  rw [cond_count, cond_count, cond_count, cond_apply _ hs.measurable_set,
+    cond_apply _ ht.measurable_set, cond_apply _ (hs.union ht).measurable_set,
+    cond_apply _ (hs.union ht).measurable_set, cond_apply _ (hs.union ht).measurable_set],
+  conv_lhs { rw [set.union_inter_cancel_left, set.union_inter_cancel_right,
+      mul_comm (measure.count (s ∪ t))⁻¹, mul_comm (measure.count (s ∪ t))⁻¹,
+      ← mul_assoc, ← mul_assoc, mul_comm _ (measure.count s), mul_comm _ (measure.count t),
+      ← mul_assoc, ← mul_assoc] },
+  rw [ennreal.mul_inv_cancel, ennreal.mul_inv_cancel, one_mul, one_mul, ← add_mul,
+    ← measure_union, set.union_inter_distrib_right, mul_comm],
+  exacts [hst.mono inf_le_left inf_le_left, (ht.inter_of_left _).measurable_set,
+    measure.count_ne_zero ht', (measure.count_apply_lt_top.2 ht).ne,
+    measure.count_ne_zero hs', (measure.count_apply_lt_top.2 hs).ne],
+end
+
+/-- A version of the law of total probability for counting probabilites. -/
+lemma cond_count_add_compl_eq (u t : set Ω) (hs : s.finite) :
+  cond_count (s ∩ u) t * cond_count s u + cond_count (s ∩ uᶜ) t * cond_count s uᶜ =
+  cond_count s t :=
+begin
+  conv_rhs { rw [(by simp : s = s ∩ u ∪ s ∩ uᶜ),
+    ← cond_count_disjoint_union (hs.inter_of_left _) (hs.inter_of_left _)
+    (disjoint_compl_right.mono inf_le_right inf_le_right)] },
+  simp [cond_count_inter_self hs],
+end
+
+end probability_theory
diff --git a/src/probability/conditional.lean b/src/probability/conditional.lean
deleted file mode 100644
index 95bb22aaa4c1f..0000000000000
--- a/src/probability/conditional.lean
+++ /dev/null
@@ -1,141 +0,0 @@
-/-
-Copyright (c) 2022 Rishikesh Vaishnav. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Rishikesh Vaishnav
--/
-import probability.independence
-
-/-!
-# Conditional Probability
-
-This file defines conditional probability and includes basic results relating to it.
-
-Given some measure `μ` defined on a measure space on some type `α` and some `s : set α`,
-we define the measure of `μ` conditioned on `s` as the restricted measure scaled by
-the inverse of the measure of `s`: `cond μ s = (μ s)⁻¹ • μ.restrict s`. The scaling
-ensures that this is a probability measure (when `μ` is a finite measure).
-
-From this definition, we derive the "axiomatic" definition of conditional probability
-based on application: for any `s t : set α`, we have `μ[t|s] = (μ s)⁻¹ * μ (s ∩ t)`.
-
-## Main Statements
-
-* `cond_cond_eq_cond_inter`: conditioning on one set and then another is equivalent
-  to conditioning on their intersection.
-* `cond_eq_inv_mul_cond_mul`: Bayes' Theorem, `μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t)`.
-
-## Notations
-
-This file uses the local notation `μ[|s]` the measure of `μ` conditioned on `s`,
-and `μ[t|s]` for the probability of `t` given `s` under `μ` (equivalent to the
-application `μ[|s] t`).
-
-## Implementation notes
-
-Because we have the alternative measure restriction application principles
-`measure.restrict_apply` and `measure.restrict_apply'`, which require 
-measurability of the restricted and restricting sets, respectively,
-many of the theorems here will have corresponding alternatives as well.
-For the sake of brevity, we've chosen to only go with `measure.restrict_apply'`
-for now, but the alternative theorems can be added if needed.
-
-Use of `@[simp]` generally follows the rule of removing conditions on a measure
-when possible.
-
-Hypotheses that are used to "define" a conditional distribution by requiring that
-the conditioning set has non-zero measure should be named using the abbreviation
-"c" (which stands for "conditionable") rather than "nz". For example `(hci : μ (s ∩ t) ≠ 0)`
-(rather than `hnzi`) should be used for a hypothesis ensuring that `μ[|s ∩ t]` is defined.
-
-## Tags
-conditional, conditioned, bayes
--/
-
-noncomputable theory
-
-open measure_theory measurable_space
-
-variables {α : Type*} {m : measurable_space α} (μ : measure α) {s t : set α}
-
-namespace probability_theory
-
-section definitions
-
-/-- The conditional probability measure of measure `μ` on set `s` is `μ` restricted to `s` 
-and scaled by the inverse of `μ s` (to make it a probability measure):
-`(μ s)⁻¹ • μ.restrict s`. -/
-def cond (s : set α) : measure α :=
-  (μ s)⁻¹ • μ.restrict s
-
-end definitions
-
-local notation  μ `[` s `|` t `]` := cond μ t s
-local notation  μ `[|`:60 t`]` := cond μ t
-
-/-- The conditional probability measure of any finite measure on any set of positive measure
-is a probability measure. -/
-lemma cond_is_probability_measure [is_finite_measure μ] (hcs : μ s ≠ 0) :
-  is_probability_measure $ μ[|s] :=
-⟨by { rw [cond, measure.smul_apply, measure.restrict_apply measurable_set.univ,
-  set.univ_inter], exact ennreal.inv_mul_cancel hcs (measure_ne_top _ s) }⟩
-
-section bayes
-
-@[simp] lemma cond_univ [is_probability_measure μ] :
-  μ[|set.univ] = μ :=
-by simp [cond, measure_univ, measure.restrict_univ]
-
-/-- The axiomatic definition of conditional probability derived from a measure-theoretic one. -/
-@[simp] lemma cond_apply (hms : measurable_set s) (t : set α) :
-  μ[t|s] = (μ s)⁻¹ * μ (s ∩ t) :=
-by { rw [cond, measure.smul_apply, measure.restrict_apply' hms, set.inter_comm], refl }
-
-lemma inter_pos_of_cond_ne_zero (hms : measurable_set s) (hcst : μ[t|s] ≠ 0) :
-  0 < μ (s ∩ t) :=
-begin
-  refine pos_iff_ne_zero.mpr (right_ne_zero_of_mul _),
-  { exact (μ s)⁻¹ },
-  convert hcst,
-  simp [hms, set.inter_comm]
-end
-
-variable [is_finite_measure μ]
-
-lemma cond_pos_of_inter_ne_zero (hms : measurable_set s) (hci : μ (s ∩ t) ≠ 0) :
-  0 < μ[|s] t :=
-begin
-  rw cond_apply _ hms,
-  refine ennreal.mul_pos _ hci,
-  exact ennreal.inv_ne_zero.mpr (measure_ne_top _ _),
-end
-
-/-- Conditioning first on `s` and then on `t` results in the same measure as conditioning
-on `s ∩ t`. -/
-@[simp] lemma cond_cond_eq_cond_inter
-  (hms : measurable_set s) (hmt : measurable_set t) (hci : μ (s ∩ t) ≠ 0) :
-  μ[|s][|t] = μ[|s ∩ t] :=
-begin
-  have := hms.inter hmt,
-  have := measure_ne_top μ s,
-  have hcs : μ s ≠ 0 := (μ.to_outer_measure.pos_of_subset_ne_zero
-    (set.inter_subset_left _ _) hci).ne',
-  ext1,
-  haveI := cond_is_probability_measure μ hcs,
-  simp only [*, cond_apply, ←mul_assoc, ←set.inter_assoc],
-  congr,
-  simp [*, ennreal.mul_inv, mul_comm, ←mul_assoc, ennreal.inv_mul_cancel]
-end
-
-@[simp] lemma cond_mul_eq_inter (hms : measurable_set s) (hcs : μ s ≠ 0) (t : set α) :
-  μ[t|s] * μ s = μ (s ∩ t) :=
-by rw [cond_apply μ hms t, mul_comm, ←mul_assoc,
-  ennreal.mul_inv_cancel hcs (measure_ne_top _ s), one_mul]
-
-/-- **Bayes' Theorem** -/
-theorem cond_eq_inv_mul_cond_mul (hms : measurable_set s) (hmt : measurable_set t) (ht : μ t ≠ 0) :
-  μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t) :=
-by rw [mul_assoc, cond_mul_eq_inter μ hmt ht s, set.inter_comm, cond_apply _ hms]
-
-end bayes
-
-end probability_theory
diff --git a/src/probability/conditional_expectation.lean b/src/probability/conditional_expectation.lean
new file mode 100644
index 0000000000000..beedf14825e8f
--- /dev/null
+++ b/src/probability/conditional_expectation.lean
@@ -0,0 +1,82 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import probability.notation
+import probability.independence.basic
+import measure_theory.function.conditional_expectation.basic
+
+/-!
+
+# Probabilistic properties of the conditional expectation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains some properties about the conditional expectation which does not belong in
+the main conditional expectation file.
+
+## Main result
+
+* `measure_theory.condexp_indep_eq`: If `m₁, m₂` are independent σ-algebras and `f` is a
+  `m₁`-measurable function, then `𝔼[f | m₂] = 𝔼[f]` almost everywhere.
+
+-/
+
+open topological_space filter
+open_locale nnreal ennreal measure_theory probability_theory big_operators
+
+namespace measure_theory
+
+open probability_theory
+
+variables {Ω E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  {m₁ m₂ m : measurable_space Ω} {μ : measure Ω} {f : Ω → E}
+
+/-- If `m₁, m₂` are independent σ-algebras and `f` is `m₁`-measurable, then `𝔼[f | m₂] = 𝔼[f]`
+almost everywhere. -/
+lemma condexp_indep_eq
+  (hle₁ : m₁ ≤ m) (hle₂ : m₂ ≤ m) [sigma_finite (μ.trim hle₂)]
+  (hf : strongly_measurable[m₁] f) (hindp : indep m₁ m₂ μ) :
+  μ[f | m₂] =ᵐ[μ] λ x, μ[f] :=
+begin
+  by_cases hfint : integrable f μ,
+  swap, { rw [condexp_undef hfint, integral_undef hfint], refl, },
+  have hfint₁ := hfint.trim hle₁ hf,
+  refine (ae_eq_condexp_of_forall_set_integral_eq hle₂ hfint
+    (λ s _ hs, integrable_on_const.2 (or.inr hs)) (λ s hms hs, _)
+    strongly_measurable_const.ae_strongly_measurable').symm,
+  rw set_integral_const,
+  rw ← mem_ℒp_one_iff_integrable at hfint,
+  refine hfint.induction_strongly_measurable hle₁ ennreal.one_ne_top _ _ _ _ _ _,
+  { intros c t hmt ht,
+    rw [integral_indicator (hle₁ _ hmt), set_integral_const, smul_smul,
+      ← ennreal.to_real_mul, mul_comm, ← hindp _ _ hmt hms, set_integral_indicator (hle₁ _ hmt),
+      set_integral_const, set.inter_comm] },
+  { intros u v hdisj huint hvint hu hv hu_eq hv_eq,
+    rw mem_ℒp_one_iff_integrable at huint hvint,
+    rw [integral_add' huint hvint, smul_add, hu_eq, hv_eq,
+      integral_add' huint.integrable_on hvint.integrable_on], },
+  { have heq₁ : (λ f : Lp_meas E ℝ m₁ 1 μ, ∫ x, f x ∂μ) =
+      (λ f : Lp E 1 μ, ∫ x, f x ∂μ) ∘ (submodule.subtypeL _),
+    { refine funext (λ f, integral_congr_ae _),
+      simp_rw [submodule.coe_subtypeL', submodule.coe_subtype, ← coe_fn_coe_base], },
+    have heq₂ : (λ f : Lp_meas E ℝ m₁ 1 μ, ∫ x in s, f x ∂μ) =
+      (λ f : Lp E 1 μ, ∫ x in s, f x ∂μ) ∘ (submodule.subtypeL _),
+    { refine funext (λ f, integral_congr_ae (ae_restrict_of_ae _)),
+      simp_rw [submodule.coe_subtypeL', submodule.coe_subtype, ← coe_fn_coe_base],
+      exact eventually_of_forall (λ _, rfl), },
+    refine is_closed_eq (continuous.const_smul _ _) _,
+    { rw heq₁,
+      exact continuous_integral.comp (continuous_linear_map.continuous _), },
+    { rw heq₂,
+      exact (continuous_set_integral _).comp (continuous_linear_map.continuous _), }, },
+  { intros u v huv huint hueq,
+    rwa [← integral_congr_ae huv,
+      ← (set_integral_congr_ae (hle₂ _ hms) _ : ∫ x in s, u x ∂μ = ∫ x in s, v x ∂μ)],
+    filter_upwards [huv] with x hx _ using hx, },
+  { exact ⟨f, hf, eventually_eq.rfl⟩, },
+end
+
+end measure_theory
diff --git a/src/probability/conditional_probability.lean b/src/probability/conditional_probability.lean
new file mode 100644
index 0000000000000..6fc49d2152536
--- /dev/null
+++ b/src/probability/conditional_probability.lean
@@ -0,0 +1,178 @@
+/-
+Copyright (c) 2022 Rishikesh Vaishnav. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rishikesh Vaishnav
+-/
+import measure_theory.measure.measure_space
+
+/-!
+# Conditional Probability
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines conditional probability and includes basic results relating to it.
+
+Given some measure `μ` defined on a measure space on some type `Ω` and some `s : set Ω`,
+we define the measure of `μ` conditioned on `s` as the restricted measure scaled by
+the inverse of the measure of `s`: `cond μ s = (μ s)⁻¹ • μ.restrict s`. The scaling
+ensures that this is a probability measure (when `μ` is a finite measure).
+
+From this definition, we derive the "axiomatic" definition of conditional probability
+based on application: for any `s t : set Ω`, we have `μ[t|s] = (μ s)⁻¹ * μ (s ∩ t)`.
+
+## Main Statements
+
+* `cond_cond_eq_cond_inter`: conditioning on one set and then another is equivalent
+  to conditioning on their intersection.
+* `cond_eq_inv_mul_cond_mul`: Bayes' Theorem, `μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t)`.
+
+## Notations
+
+This file uses the notation `μ[|s]` the measure of `μ` conditioned on `s`,
+and `μ[t|s]` for the probability of `t` given `s` under `μ` (equivalent to the
+application `μ[|s] t`).
+
+These notations are contained in the locale `probability_theory`.
+
+## Implementation notes
+
+Because we have the alternative measure restriction application principles
+`measure.restrict_apply` and `measure.restrict_apply'`, which require
+measurability of the restricted and restricting sets, respectively,
+many of the theorems here will have corresponding alternatives as well.
+For the sake of brevity, we've chosen to only go with `measure.restrict_apply'`
+for now, but the alternative theorems can be added if needed.
+
+Use of `@[simp]` generally follows the rule of removing conditions on a measure
+when possible.
+
+Hypotheses that are used to "define" a conditional distribution by requiring that
+the conditioning set has non-zero measure should be named using the abbreviation
+"c" (which stands for "conditionable") rather than "nz". For example `(hci : μ (s ∩ t) ≠ 0)`
+(rather than `hnzi`) should be used for a hypothesis ensuring that `μ[|s ∩ t]` is defined.
+
+## Tags
+conditional, conditioned, bayes
+-/
+
+noncomputable theory
+
+open_locale ennreal
+
+open measure_theory measurable_space
+
+variables {Ω : Type*} {m : measurable_space Ω} (μ : measure Ω) {s t : set Ω}
+
+namespace probability_theory
+
+section definitions
+
+/-- The conditional probability measure of measure `μ` on set `s` is `μ` restricted to `s`
+and scaled by the inverse of `μ s` (to make it a probability measure):
+`(μ s)⁻¹ • μ.restrict s`. -/
+def cond (s : set Ω) : measure Ω :=
+  (μ s)⁻¹ • μ.restrict s
+
+end definitions
+
+localized "notation (name := probability_theory.cond)
+  μ `[` s `|` t `]` := probability_theory.cond μ t s" in probability_theory
+localized "notation (name := probability_theory.cond_fn)
+  μ `[|`:60 t`]` := probability_theory.cond μ t" in probability_theory
+
+/-- The conditional probability measure of any finite measure on any set of positive measure
+is a probability measure. -/
+lemma cond_is_probability_measure [is_finite_measure μ] (hcs : μ s ≠ 0) :
+  is_probability_measure $ μ[|s] :=
+⟨by { rw [cond, measure.smul_apply, measure.restrict_apply measurable_set.univ,
+  set.univ_inter], exact ennreal.inv_mul_cancel hcs (measure_ne_top _ s) }⟩
+
+section bayes
+
+@[simp] lemma cond_empty : μ[|∅] = 0 :=
+by simp [cond]
+
+@[simp] lemma cond_univ [is_probability_measure μ] :
+  μ[|set.univ] = μ :=
+by simp [cond, measure_univ, measure.restrict_univ]
+
+/-- The axiomatic definition of conditional probability derived from a measure-theoretic one. -/
+lemma cond_apply (hms : measurable_set s) (t : set Ω) :
+  μ[t|s] = (μ s)⁻¹ * μ (s ∩ t) :=
+by { rw [cond, measure.smul_apply, measure.restrict_apply' hms, set.inter_comm], refl }
+
+lemma cond_inter_self (hms : measurable_set s) (t : set Ω) :
+  μ[s ∩ t|s] = μ[t|s] :=
+by rw [cond_apply _ hms, ← set.inter_assoc, set.inter_self, ← cond_apply _ hms]
+
+lemma inter_pos_of_cond_ne_zero (hms : measurable_set s) (hcst : μ[t|s] ≠ 0) :
+  0 < μ (s ∩ t) :=
+begin
+  refine pos_iff_ne_zero.mpr (right_ne_zero_of_mul _),
+  { exact (μ s)⁻¹ },
+  convert hcst,
+  simp [hms, set.inter_comm]
+end
+
+lemma cond_pos_of_inter_ne_zero [is_finite_measure μ]
+  (hms : measurable_set s) (hci : μ (s ∩ t) ≠ 0) :
+  0 < μ[|s] t :=
+begin
+  rw cond_apply _ hms,
+  refine ennreal.mul_pos _ hci,
+  exact ennreal.inv_ne_zero.mpr (measure_ne_top _ _),
+end
+
+lemma cond_cond_eq_cond_inter'
+  (hms : measurable_set s) (hmt : measurable_set t) (hcs : μ s ≠ ∞) (hci : μ (s ∩ t) ≠ 0) :
+  μ[|s][|t] = μ[|s ∩ t] :=
+begin
+  have hcs : μ s ≠ 0 := (μ.to_outer_measure.pos_of_subset_ne_zero
+    (set.inter_subset_left _ _) hci).ne',
+  ext u,
+  simp [*, hms.inter hmt, cond_apply, ← mul_assoc, ← set.inter_assoc,
+    ennreal.mul_inv, mul_comm, ← mul_assoc, ennreal.inv_mul_cancel],
+end
+
+/-- Conditioning first on `s` and then on `t` results in the same measure as conditioning
+on `s ∩ t`. -/
+lemma cond_cond_eq_cond_inter [is_finite_measure μ]
+  (hms : measurable_set s) (hmt : measurable_set t) (hci : μ (s ∩ t) ≠ 0) :
+  μ[|s][|t] = μ[|s ∩ t] :=
+cond_cond_eq_cond_inter' μ hms hmt (measure_ne_top μ s) hci
+
+lemma cond_mul_eq_inter'
+  (hms : measurable_set s) (hcs : μ s ≠ 0) (hcs' : μ s ≠ ∞) (t : set Ω) :
+  μ[t|s] * μ s = μ (s ∩ t) :=
+by rw [cond_apply μ hms t, mul_comm, ←mul_assoc,
+  ennreal.mul_inv_cancel hcs hcs', one_mul]
+
+lemma cond_mul_eq_inter [is_finite_measure μ]
+  (hms : measurable_set s) (hcs : μ s ≠ 0) (t : set Ω) :
+  μ[t|s] * μ s = μ (s ∩ t) :=
+cond_mul_eq_inter' μ hms hcs (measure_ne_top _ s) t
+
+/-- A version of the law of total probability. -/
+lemma cond_add_cond_compl_eq [is_finite_measure μ]
+  (hms : measurable_set s) (hcs : μ s ≠ 0) (hcs' : μ sᶜ ≠ 0) :
+  μ[t|s] * μ s + μ[t|sᶜ] * μ sᶜ = μ t :=
+begin
+  rw [cond_mul_eq_inter μ hms hcs, cond_mul_eq_inter μ hms.compl hcs', set.inter_comm _ t,
+    set.inter_comm _ t],
+  exact measure_inter_add_diff t hms,
+end
+
+/-- **Bayes' Theorem** -/
+theorem cond_eq_inv_mul_cond_mul [is_finite_measure μ]
+  (hms : measurable_set s) (hmt : measurable_set t) :
+  μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t) :=
+begin
+  by_cases ht : μ t = 0,
+  { simp [cond, ht, measure.restrict_apply hmt, or.inr (measure_inter_null_of_null_left s ht)] },
+  { rw [mul_assoc, cond_mul_eq_inter μ hmt ht s, set.inter_comm, cond_apply _ hms] }
+end
+
+end bayes
+
+end probability_theory
diff --git a/src/probability/density.lean b/src/probability/density.lean
index 1ffefadfb1bad..c2bf0bcb2b140 100644
--- a/src/probability/density.lean
+++ b/src/probability/density.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kexing Ying
 -/
 import measure_theory.decomposition.radon_nikodym
-import measure_theory.measure.lebesgue
+import measure_theory.measure.haar.of_basis
 
 /-!
 # Probability density function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the probability density function of random variables, by which we mean
 measurable functions taking values in a Borel space. In particular, a measurable function `f`
 is said to the probability density function of a random variable `X` if for all measurable
@@ -21,8 +24,8 @@ random variables with this distribution.
 
 ## Main definitions
 
-* `measure_theory.has_pdf` : A random variable `X : α → E` is said to `has_pdf` with
-  respect to the measure `ℙ` on `α` and `μ` on `E` if there exists a measurable function `f`
+* `measure_theory.has_pdf` : A random variable `X : Ω → E` is said to `has_pdf` with
+  respect to the measure `ℙ` on `Ω` and `μ` on `E` if there exists a measurable function `f`
   such that the push-forward measure of `ℙ` along `X` equals `μ.with_density f`.
 * `measure_theory.pdf` : If `X` is a random variable that `has_pdf X ℙ μ`, then `pdf X`
   is the measurable function `f` such that the push-forward measure of `ℙ` along `X` equals
@@ -33,7 +36,7 @@ random variables with this distribution.
 ## Main results
 
 * `measure_theory.pdf.integral_fun_mul_eq_integral` : Law of the unconscious statistician,
-  i.e. if a random variable `X : α → E` has pdf `f`, then `𝔼(g(X)) = ∫ x, g x * f x dx` for
+  i.e. if a random variable `X : Ω → E` has pdf `f`, then `𝔼(g(X)) = ∫ x, g x * f x dx` for
   all measurable `g : E → ℝ`.
 * `measure_theory.pdf.integral_mul_eq_integral` : A real-valued random variable `X` with
   pdf `f` has expectation `∫ x, x * f x dx`.
@@ -55,32 +58,32 @@ namespace measure_theory
 
 open topological_space measure_theory.measure
 
-variables {α E : Type*} [measurable_space E]
+variables {Ω E : Type*} [measurable_space E]
 
-/-- A random variable `X : α → E` is said to `has_pdf` with respect to the measure `ℙ` on `α` and
+/-- A random variable `X : Ω → E` is said to `has_pdf` with respect to the measure `ℙ` on `Ω` and
 `μ` on `E` if there exists a measurable function `f` such that the push-forward measure of `ℙ`
 along `X` equals `μ.with_density f`. -/
-class has_pdf {m : measurable_space α} (X : α → E)
-  (ℙ : measure α) (μ : measure E . volume_tac) : Prop :=
+class has_pdf {m : measurable_space Ω} (X : Ω → E)
+  (ℙ : measure Ω) (μ : measure E . volume_tac) : Prop :=
 (pdf' : measurable X ∧ ∃ (f : E → ℝ≥0∞), measurable f ∧ map X ℙ = μ.with_density f)
 
 @[measurability]
-lemma has_pdf.measurable {m : measurable_space α}
-  (X : α → E) (ℙ : measure α) (μ : measure E . volume_tac) [hX : has_pdf X ℙ μ] :
+lemma has_pdf.measurable {m : measurable_space Ω}
+  (X : Ω → E) (ℙ : measure Ω) (μ : measure E . volume_tac) [hX : has_pdf X ℙ μ] :
   measurable X :=
 hX.pdf'.1
 
 /-- If `X` is a random variable that `has_pdf X ℙ μ`, then `pdf X` is the measurable function `f`
 such that the push-forward measure of `ℙ` along `X` equals `μ.with_density f`. -/
-def pdf {m : measurable_space α} (X : α → E) (ℙ : measure α) (μ : measure E . volume_tac) :=
+def pdf {m : measurable_space Ω} (X : Ω → E) (ℙ : measure Ω) (μ : measure E . volume_tac) :=
 if hX : has_pdf X ℙ μ then classical.some hX.pdf'.2 else 0
 
-lemma pdf_undef {m : measurable_space α} {ℙ : measure α} {μ : measure E} {X : α → E}
+lemma pdf_undef {m : measurable_space Ω} {ℙ : measure Ω} {μ : measure E} {X : Ω → E}
   (h : ¬ has_pdf X ℙ μ) :
   pdf X ℙ μ = 0 :=
 by simp only [pdf, dif_neg h]
 
-lemma has_pdf_of_pdf_ne_zero {m : measurable_space α} {ℙ : measure α} {μ : measure E} {X : α → E}
+lemma has_pdf_of_pdf_ne_zero {m : measurable_space Ω} {ℙ : measure Ω} {μ : measure E} {X : Ω → E}
   (h : pdf X ℙ μ ≠ 0) : has_pdf X ℙ μ :=
 begin
   by_contra hpdf,
@@ -88,19 +91,19 @@ begin
   exact hpdf (false.rec (has_pdf X ℙ μ) (h rfl))
 end
 
-lemma pdf_eq_zero_of_not_measurable {m : measurable_space α}
-  {ℙ : measure α} {μ : measure E} {X : α → E} (hX : ¬ measurable X) :
+lemma pdf_eq_zero_of_not_measurable {m : measurable_space Ω}
+  {ℙ : measure Ω} {μ : measure E} {X : Ω → E} (hX : ¬ measurable X) :
   pdf X ℙ μ = 0 :=
 pdf_undef (λ hpdf, hX hpdf.pdf'.1)
 
-lemma measurable_of_pdf_ne_zero {m : measurable_space α}
-  {ℙ : measure α} {μ : measure E} (X : α → E) (h : pdf X ℙ μ ≠ 0) :
+lemma measurable_of_pdf_ne_zero {m : measurable_space Ω}
+  {ℙ : measure Ω} {μ : measure E} (X : Ω → E) (h : pdf X ℙ μ ≠ 0) :
   measurable X :=
 by { by_contra hX, exact h (pdf_eq_zero_of_not_measurable hX) }
 
 @[measurability]
-lemma measurable_pdf {m : measurable_space α}
-  (X : α → E) (ℙ : measure α) (μ : measure E . volume_tac) :
+lemma measurable_pdf {m : measurable_space Ω}
+  (X : Ω → E) (ℙ : measure Ω) (μ : measure E . volume_tac) :
   measurable (pdf X ℙ μ) :=
 begin
   by_cases hX : has_pdf X ℙ μ,
@@ -110,32 +113,32 @@ begin
     exact measurable_zero }
 end
 
-lemma map_eq_with_density_pdf {m : measurable_space α}
-  (X : α → E) (ℙ : measure α) (μ : measure E . volume_tac) [hX : has_pdf X ℙ μ] :
+lemma map_eq_with_density_pdf {m : measurable_space Ω}
+  (X : Ω → E) (ℙ : measure Ω) (μ : measure E . volume_tac) [hX : has_pdf X ℙ μ] :
   measure.map X ℙ = μ.with_density (pdf X ℙ μ) :=
 begin
   rw [pdf, dif_pos hX],
   exact (classical.some_spec hX.pdf'.2).2
 end
 
-lemma map_eq_set_lintegral_pdf {m : measurable_space α}
-  (X : α → E) (ℙ : measure α) (μ : measure E . volume_tac) [hX : has_pdf X ℙ μ]
+lemma map_eq_set_lintegral_pdf {m : measurable_space Ω}
+  (X : Ω → E) (ℙ : measure Ω) (μ : measure E . volume_tac) [hX : has_pdf X ℙ μ]
   {s : set E} (hs : measurable_set s) :
   measure.map X ℙ s = ∫⁻ x in s, pdf X ℙ μ x ∂μ :=
 by rw [← with_density_apply _ hs, map_eq_with_density_pdf X ℙ μ]
 
 namespace pdf
 
-variables {m : measurable_space α} {ℙ : measure α} {μ : measure E}
+variables {m : measurable_space Ω} {ℙ : measure Ω} {μ : measure E}
 
-lemma lintegral_eq_measure_univ {X : α → E} [has_pdf X ℙ μ] :
+lemma lintegral_eq_measure_univ {X : Ω → E} [has_pdf X ℙ μ] :
   ∫⁻ x, pdf X ℙ μ x ∂μ = ℙ set.univ :=
 begin
   rw [← set_lintegral_univ, ← map_eq_set_lintegral_pdf X ℙ μ measurable_set.univ,
       measure.map_apply (has_pdf.measurable X ℙ μ) measurable_set.univ, set.preimage_univ],
 end
 
-lemma ae_lt_top [is_finite_measure ℙ] {μ : measure E} {X : α → E} :
+lemma ae_lt_top [is_finite_measure ℙ] {μ : measure E} {X : Ω → E} :
   ∀ᵐ x ∂μ, pdf X ℙ μ x < ∞ :=
 begin
   by_cases hpdf : has_pdf X ℙ μ,
@@ -147,11 +150,11 @@ begin
     exact filter.eventually_of_forall (λ x, with_top.zero_lt_top) }
 end
 
-lemma of_real_to_real_ae_eq [is_finite_measure ℙ] {X : α → E} :
+lemma of_real_to_real_ae_eq [is_finite_measure ℙ] {X : Ω → E} :
   (λ x, ennreal.of_real (pdf X ℙ μ x).to_real) =ᵐ[μ] pdf X ℙ μ :=
 of_real_to_real_ae_eq ae_lt_top
 
-lemma integrable_iff_integrable_mul_pdf [is_finite_measure ℙ] {X : α → E} [has_pdf X ℙ μ]
+lemma integrable_iff_integrable_mul_pdf [is_finite_measure ℙ] {X : Ω → E} [has_pdf X ℙ μ]
   {f : E → ℝ} (hf : measurable f) :
   integrable (λ x, f (X x)) ℙ ↔ integrable (λ x, f x * (pdf X ℙ μ x).to_real) μ :=
 begin
@@ -165,7 +168,7 @@ end
 function `f`, `f ∘ X` is a random variable with expectation `∫ x, f x * pdf X ∂μ`
 where `μ` is a measure on the codomain of `X`. -/
 lemma integral_fun_mul_eq_integral [is_finite_measure ℙ]
-  {X : α → E} [has_pdf X ℙ μ] {f : E → ℝ} (hf : measurable f) :
+  {X : Ω → E} [has_pdf X ℙ μ] {f : E → ℝ} (hf : measurable f) :
   ∫ x, f x * (pdf X ℙ μ x).to_real ∂μ = ∫ x, f (X x) ∂ℙ :=
 begin
   by_cases hpdf : integrable (λ x, f x * (pdf X ℙ μ x).to_real) μ,
@@ -192,7 +195,7 @@ begin
     { refine ⟨hf.ae_strongly_measurable, _⟩,
       rw [has_finite_integral, lintegral_with_density_eq_lintegral_mul _
             (measurable_pdf _ _ _) hf.nnnorm.coe_nnreal_ennreal],
-      have : (λ x, (pdf X ℙ μ * λ x, ↑∥f x∥₊) x) =ᵐ[μ] (λ x, ∥f x * (pdf X ℙ μ x).to_real∥₊),
+      have : (λ x, (pdf X ℙ μ * λ x, ↑‖f x‖₊) x) =ᵐ[μ] (λ x, ‖f x * (pdf X ℙ μ x).to_real‖₊),
       { simp_rw [← smul_eq_mul, nnnorm_smul, ennreal.coe_mul],
         rw [smul_eq_mul, mul_comm],
         refine filter.eventually_eq.mul (ae_eq_refl _) (ae_eq_trans of_real_to_real_ae_eq.symm _),
@@ -206,21 +209,21 @@ begin
     all_goals { apply_instance } }
 end
 
-lemma map_absolutely_continuous {X : α → E} [has_pdf X ℙ μ] : map X ℙ ≪ μ :=
+lemma map_absolutely_continuous {X : Ω → E} [has_pdf X ℙ μ] : map X ℙ ≪ μ :=
 by { rw map_eq_with_density_pdf X ℙ μ, exact with_density_absolutely_continuous _ _, }
 
 /-- A random variable that `has_pdf` is quasi-measure preserving. -/
-lemma to_quasi_measure_preserving {X : α → E} [has_pdf X ℙ μ] : quasi_measure_preserving X ℙ μ :=
+lemma to_quasi_measure_preserving {X : Ω → E} [has_pdf X ℙ μ] : quasi_measure_preserving X ℙ μ :=
 { measurable := has_pdf.measurable X ℙ μ,
   absolutely_continuous := map_absolutely_continuous, }
 
-lemma have_lebesgue_decomposition_of_has_pdf {X : α → E} [hX' : has_pdf X ℙ μ] :
+lemma have_lebesgue_decomposition_of_has_pdf {X : Ω → E} [hX' : has_pdf X ℙ μ] :
   (map X ℙ).have_lebesgue_decomposition μ :=
 ⟨⟨⟨0, pdf X ℙ μ⟩,
   by simp only [zero_add, measurable_pdf X ℙ μ, true_and, mutually_singular.zero_left,
     map_eq_with_density_pdf X ℙ μ] ⟩⟩
 
-lemma has_pdf_iff {X : α → E} :
+lemma has_pdf_iff {X : Ω → E} :
   has_pdf X ℙ μ ↔ measurable X ∧ (map X ℙ).have_lebesgue_decomposition μ ∧ map X ℙ ≪ μ :=
 begin
   split,
@@ -232,7 +235,7 @@ begin
     rwa with_density_rn_deriv_eq }
 end
 
-lemma has_pdf_iff_of_measurable {X : α → E} (hX : measurable X) :
+lemma has_pdf_iff_of_measurable {X : Ω → E} (hX : measurable X) :
   has_pdf X ℙ μ ↔ (map X ℙ).have_lebesgue_decomposition μ ∧ map X ℙ ≪ μ :=
 by { rw has_pdf_iff, simp only [hX, true_and], }
 
@@ -245,7 +248,7 @@ map also `has_pdf` if `(map g (map X ℙ)).have_lebesgue_decomposition μ`.
 
 `quasi_measure_preserving_has_pdf'` is more useful in the case we are working with a
 probability measure and a real-valued random variable. -/
-lemma quasi_measure_preserving_has_pdf {X : α → E} [has_pdf X ℙ μ]
+lemma quasi_measure_preserving_has_pdf {X : Ω → E} [has_pdf X ℙ μ]
   {g : E → F} (hg : quasi_measure_preserving g μ ν)
   (hmap : (map g (map X ℙ)).have_lebesgue_decomposition ν) :
   has_pdf (g ∘ X) ℙ ν :=
@@ -261,7 +264,7 @@ begin
 end
 
 lemma quasi_measure_preserving_has_pdf' [is_finite_measure ℙ] [sigma_finite ν]
-  {X : α → E} [has_pdf X ℙ μ] {g : E → F} (hg : quasi_measure_preserving g μ ν) :
+  {X : Ω → E} [has_pdf X ℙ μ] {g : E → F} (hg : quasi_measure_preserving g μ ν) :
   has_pdf (g ∘ X) ℙ ν :=
 quasi_measure_preserving_has_pdf hg infer_instance
 
@@ -269,7 +272,7 @@ end
 
 section real
 
-variables [is_finite_measure ℙ] {X : α → ℝ}
+variables [is_finite_measure ℙ] {X : Ω → ℝ}
 
 /-- A real-valued random variable `X` `has_pdf X ℙ λ` (where `λ` is the Lebesgue measure) if and
 only if the push-forward measure of `ℙ` along `X` is absolutely continuous with respect to `λ`. -/
@@ -295,12 +298,12 @@ lemma integral_mul_eq_integral [has_pdf X ℙ] :
 integral_fun_mul_eq_integral measurable_id
 
 lemma has_finite_integral_mul {f : ℝ → ℝ} {g : ℝ → ℝ≥0∞}
-  (hg : pdf X ℙ =ᵐ[volume] g) (hgi : ∫⁻ x, ∥f x∥₊ * g x ≠ ∞) :
+  (hg : pdf X ℙ =ᵐ[volume] g) (hgi : ∫⁻ x, ‖f x‖₊ * g x ≠ ∞) :
   has_finite_integral (λ x, f x * (pdf X ℙ volume x).to_real) :=
 begin
   rw has_finite_integral,
-  have : (λ x, ↑∥f x∥₊ * g x) =ᵐ[volume] (λ x, ∥f x * (pdf X ℙ volume x).to_real∥₊),
-  { refine ae_eq_trans (filter.eventually_eq.mul (ae_eq_refl (λ x, ∥f x∥₊))
+  have : (λ x, ↑‖f x‖₊ * g x) =ᵐ[volume] (λ x, ‖f x * (pdf X ℙ volume x).to_real‖₊),
+  { refine ae_eq_trans (filter.eventually_eq.mul (ae_eq_refl (λ x, ‖f x‖₊))
       (ae_eq_trans hg.symm of_real_to_real_ae_eq.symm)) _,
     simp_rw [← smul_eq_mul, nnnorm_smul, ennreal.coe_mul, smul_eq_mul],
     refine filter.eventually_eq.mul (ae_eq_refl _) _,
@@ -318,41 +321,64 @@ section
 
 /-- A random variable `X` has uniform distribution if it has a probability density function `f`
 with support `s` such that `f = (μ s)⁻¹ 1ₛ` a.e. where `1ₛ` is the indicator function for `s`. -/
-def is_uniform {m : measurable_space α} (X : α → E) (support : set E)
-  (ℙ : measure α) (μ : measure E . volume_tac) :=
+def is_uniform {m : measurable_space Ω} (X : Ω → E) (support : set E)
+  (ℙ : measure Ω) (μ : measure E . volume_tac) :=
 pdf X ℙ μ =ᵐ[μ] support.indicator ((μ support)⁻¹ • 1)
 
 namespace is_uniform
 
-lemma has_pdf {m : measurable_space α} {X : α → E} {ℙ : measure α} {μ : measure E}
-  {support : set E} (hns : μ support ≠ 0) (hnt : μ support ≠ ⊤) (hu : is_uniform X support ℙ μ) :
+lemma has_pdf {m : measurable_space Ω} {X : Ω → E} {ℙ : measure Ω} {μ : measure E}
+  {s : set E} (hns : μ s ≠ 0) (hnt : μ s ≠ ∞) (hu : is_uniform X s ℙ μ) :
   has_pdf X ℙ μ :=
 has_pdf_of_pdf_ne_zero
 begin
   intro hpdf,
   rw [is_uniform, hpdf] at hu,
-  suffices : μ (support ∩ function.support ((μ support)⁻¹ • 1)) = 0,
-  { have heq : function.support ((μ support)⁻¹ • (1 : E → ℝ≥0∞)) = set.univ,
+  suffices : μ (s ∩ function.support ((μ s)⁻¹ • 1)) = 0,
+  { have heq : function.support ((μ s)⁻¹ • (1 : E → ℝ≥0∞)) = set.univ,
     { ext x,
       rw [function.mem_support],
       simp [hnt] },
     rw [heq, set.inter_univ] at this,
     exact hns this },
-  exact set.indicator_ae_eq_zero hu.symm,
+  exact set.indicator_ae_eq_zero.1 hu.symm,
 end
 
-lemma pdf_to_real_ae_eq {m : measurable_space α}
-  {X : α → E} {ℙ : measure α} {μ : measure E} {s : set E} (hX : is_uniform X s ℙ μ) :
+lemma pdf_to_real_ae_eq {m : measurable_space Ω}
+  {X : Ω → E} {ℙ : measure Ω} {μ : measure E} {s : set E} (hX : is_uniform X s ℙ μ) :
   (λ x, (pdf X ℙ μ x).to_real) =ᵐ[μ]
   (λ x, (s.indicator ((μ s)⁻¹ • (1 : E → ℝ≥0∞)) x).to_real) :=
 filter.eventually_eq.fun_comp hX ennreal.to_real
 
-variables [is_finite_measure ℙ] {X : α → ℝ}
-variables {s : set ℝ} (hms : measurable_set s) (hns : volume s ≠ 0)
+lemma measure_preimage {m : measurable_space Ω} {X : Ω → E} {ℙ : measure Ω} {μ : measure E}
+  {s : set E} (hns : μ s ≠ 0) (hnt : μ s ≠ ∞) (hms : measurable_set s)
+  (hu : is_uniform X s ℙ μ)
+  {A : set E} (hA : measurable_set A) :
+  ℙ (X ⁻¹' A) = μ (s ∩ A) / μ s :=
+begin
+  haveI := hu.has_pdf hns hnt,
+  rw [←measure.map_apply (has_pdf.measurable X ℙ μ) hA, map_eq_set_lintegral_pdf X ℙ μ hA,
+    lintegral_congr_ae hu.restrict],
+  simp only [hms, hA, lintegral_indicator, pi.smul_apply, pi.one_apply, algebra.id.smul_eq_mul,
+    mul_one, lintegral_const, restrict_apply', set.univ_inter],
+  rw ennreal.div_eq_inv_mul,
+end
+
+lemma is_probability_measure {m : measurable_space Ω} {X : Ω → E} {ℙ : measure Ω} {μ : measure E}
+  {s : set E} (hns : μ s ≠ 0) (hnt : μ s ≠ ∞) (hms : measurable_set s)
+  (hu : is_uniform X s ℙ μ) :
+  is_probability_measure ℙ :=
+⟨begin
+  have : X ⁻¹' set.univ = set.univ, { simp only [set.preimage_univ] },
+  rw [←this, hu.measure_preimage hns hnt hms measurable_set.univ, set.inter_univ,
+    ennreal.div_self hns hnt],
+end⟩
+
+variables {X : Ω → ℝ} {s : set ℝ} (hms : measurable_set s) (hns : volume s ≠ 0)
 
 include hms hns
 
-lemma mul_pdf_integrable (hcs : is_compact s) (huX : is_uniform X s ℙ) :
+lemma mul_pdf_integrable [is_finite_measure ℙ] (hcs : is_compact s) (huX : is_uniform X s ℙ) :
   integrable (λ x : ℝ, x * (pdf X ℙ volume x).to_real) :=
 begin
   by_cases hsupp : volume s = ∞,
@@ -367,8 +393,8 @@ begin
     (measurable_pdf X ℙ).ae_measurable.ennreal_to_real.ae_strongly_measurable, _⟩,
   refine has_finite_integral_mul huX _,
   set ind := (volume s)⁻¹ • (1 : ℝ → ℝ≥0∞) with hind,
-  have : ∀ x, ↑∥x∥₊ * s.indicator ind x = s.indicator (λ x, ∥x∥₊ * ind x) x :=
-      λ x, (s.indicator_mul_right (λ x, ↑∥x∥₊) ind).symm,
+  have : ∀ x, ↑‖x‖₊ * s.indicator ind x = s.indicator (λ x, ‖x‖₊ * ind x) x :=
+      λ x, (s.indicator_mul_right (λ x, ↑‖x‖₊) ind).symm,
   simp only [this, lintegral_indicator _ hms, hind, mul_one,
              algebra.id.smul_eq_mul, pi.one_apply, pi.smul_apply],
   rw lintegral_mul_const _ measurable_nnnorm.coe_nnreal_ennreal,
@@ -379,12 +405,12 @@ end
 
 /-- A real uniform random variable `X` with support `s` has expectation
 `(λ s)⁻¹ * ∫ x in s, x ∂λ` where `λ` is the Lebesgue measure. -/
-lemma integral_eq (hnt : volume s ≠ ⊤) (huX : is_uniform X s ℙ) :
+lemma integral_eq (hnt : volume s ≠ ∞) (huX : is_uniform X s ℙ) :
   ∫ x, X x ∂ℙ = (volume s)⁻¹.to_real * ∫ x in s, x :=
 begin
   haveI := has_pdf hns hnt huX,
+  haveI := huX.is_probability_measure hns hnt hms,
   rw ← integral_mul_eq_integral,
-  all_goals { try { apply_instance } },
   rw integral_congr_ae (filter.eventually_eq.mul (ae_eq_refl _) (pdf_to_real_ae_eq huX)),
   have : ∀ x, x * (s.indicator ((volume s)⁻¹ • (1 : ℝ → ℝ≥0∞)) x).to_real =
     x * (s.indicator ((volume s)⁻¹.to_real • (1 : ℝ → ℝ)) x),
diff --git a/src/probability/ident_distrib.lean b/src/probability/ident_distrib.lean
index 2424ce81a4e8b..022eafdb4b26b 100644
--- a/src/probability/ident_distrib.lean
+++ b/src/probability/ident_distrib.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import probability.variance
+import measure_theory.function.uniform_integrable
 
 /-!
 # Identically distributed random variables
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Two random variables defined on two (possibly different) probability spaces but taking value in
 the same space are *identically distributed* if their distributions (i.e., the image probability
 measures on the target space) coincide. We define this concept and establish its basic properties
@@ -43,7 +47,7 @@ instance:
 
 We also register several dot notation shortcuts for convenience.
 For instance, if `h : ident_distrib f g μ ν`, then `h.sq` states that `f^2` and `g^2` are
-identically distributed, and `h.norm` states that `∥f∥` and `∥g∥` are identically distributed, and
+identically distributed, and `h.norm` states that `‖f‖` and `‖g‖` are identically distributed, and
 so on.
 -/
 
@@ -51,7 +55,7 @@ open measure_theory filter finset
 
 noncomputable theory
 
-open_locale topological_space big_operators measure_theory ennreal nnreal
+open_locale topology big_operators measure_theory ennreal nnreal
 
 variables {α β γ δ : Type*} [measurable_space α] [measurable_space β]
   [measurable_space γ] [measurable_space δ]
@@ -107,12 +111,18 @@ protected lemma comp {u : γ → δ} (h : ident_distrib f g μ ν) (hu : measura
   ident_distrib (u ∘ f) (u ∘ g) μ ν :=
 h.comp_of_ae_measurable hu.ae_measurable
 
+protected lemma of_ae_eq {g : α → γ} (hf : ae_measurable f μ) (heq : f =ᵐ[μ] g) :
+  ident_distrib f g μ μ :=
+{ ae_measurable_fst := hf,
+  ae_measurable_snd := hf.congr heq,
+  map_eq := measure.map_congr heq }
+
 lemma measure_mem_eq (h : ident_distrib f g μ ν) {s : set γ} (hs : measurable_set s) :
   μ (f ⁻¹' s) = ν (g ⁻¹' s) :=
 by rw [← measure.map_apply_of_ae_measurable h.ae_measurable_fst hs,
   ← measure.map_apply_of_ae_measurable h.ae_measurable_snd hs, h.map_eq]
 
-alias measure_mem_eq ← probability_theory.ident_distrib.measure_preimage_eq
+alias measure_mem_eq ← measure_preimage_eq
 
 lemma ae_snd (h : ident_distrib f g μ ν) {p : γ → Prop}
   (pmeas : measurable_set {x | p x}) (hp : ∀ᵐ x ∂μ, p (f x)) :
@@ -171,7 +181,7 @@ begin
       ← lintegral_map' ae_measurable_id h.ae_measurable_snd, h.map_eq],
 end
 
-lemma integral_eq [normed_group γ] [normed_space ℝ γ] [complete_space γ] [borel_space γ]
+lemma integral_eq [normed_add_comm_group γ] [normed_space ℝ γ] [complete_space γ] [borel_space γ]
   (h : ident_distrib f g μ ν) : ∫ x, f x ∂μ = ∫ x, g x ∂ν :=
 begin
   by_cases hf : ae_strongly_measurable f μ,
@@ -191,7 +201,8 @@ begin
     rw integral_non_ae_strongly_measurable hf }
 end
 
-lemma snorm_eq [normed_group γ] [opens_measurable_space γ] (h : ident_distrib f g μ ν) (p : ℝ≥0∞) :
+lemma snorm_eq [normed_add_comm_group γ] [opens_measurable_space γ] (h : ident_distrib f g μ ν)
+  (p : ℝ≥0∞) :
   snorm f p μ = snorm g p ν :=
 begin
   by_cases h0 : p = 0,
@@ -208,7 +219,7 @@ begin
     (measurable.pow_const (measurable_coe_nnreal_ennreal.comp measurable_nnnorm) p.to_real),
 end
 
-lemma mem_ℒp_snd [normed_group γ] [borel_space γ]
+lemma mem_ℒp_snd [normed_add_comm_group γ] [borel_space γ]
   {p : ℝ≥0∞} (h : ident_distrib f g μ ν) (hf : mem_ℒp f p μ) :
   mem_ℒp g p ν :=
 begin
@@ -217,27 +228,27 @@ begin
   exact hf.2
 end
 
-lemma mem_ℒp_iff [normed_group γ] [borel_space γ] {p : ℝ≥0∞} (h : ident_distrib f g μ ν) :
+lemma mem_ℒp_iff [normed_add_comm_group γ] [borel_space γ] {p : ℝ≥0∞} (h : ident_distrib f g μ ν) :
   mem_ℒp f p μ ↔ mem_ℒp g p ν :=
 ⟨λ hf, h.mem_ℒp_snd hf, λ hg, h.symm.mem_ℒp_snd hg⟩
 
-lemma integrable_snd [normed_group γ] [borel_space γ] (h : ident_distrib f g μ ν)
+lemma integrable_snd [normed_add_comm_group γ] [borel_space γ] (h : ident_distrib f g μ ν)
   (hf : integrable f μ) : integrable g ν :=
 begin
   rw ← mem_ℒp_one_iff_integrable at hf ⊢,
   exact h.mem_ℒp_snd hf
 end
 
-lemma integrable_iff [normed_group γ] [borel_space γ] (h : ident_distrib f g μ ν) :
+lemma integrable_iff [normed_add_comm_group γ] [borel_space γ] (h : ident_distrib f g μ ν) :
   integrable f μ ↔ integrable g ν :=
 ⟨λ hf, h.integrable_snd hf, λ hg, h.symm.integrable_snd hg⟩
 
-protected lemma norm [normed_group γ] [borel_space γ] (h : ident_distrib f g μ ν) :
-  ident_distrib (λ x, ∥f x∥) (λ x, ∥g x∥) μ ν :=
+protected lemma norm [normed_add_comm_group γ] [borel_space γ] (h : ident_distrib f g μ ν) :
+  ident_distrib (λ x, ‖f x‖) (λ x, ‖g x‖) μ ν :=
 h.comp measurable_norm
 
-protected lemma nnnorm [normed_group γ] [borel_space γ] (h : ident_distrib f g μ ν) :
-  ident_distrib (λ x, ∥f x∥₊) (λ x, ∥g x∥₊) μ ν :=
+protected lemma nnnorm [normed_add_comm_group γ] [borel_space γ] (h : ident_distrib f g μ ν) :
+  ident_distrib (λ x, ‖f x‖₊) (λ x, ‖g x‖₊) μ ν :=
 h.comp measurable_nnnorm
 
 protected lemma pow [has_pow γ ℕ] [has_measurable_pow γ ℕ] (h : ident_distrib f g μ ν) {n : ℕ} :
@@ -272,14 +283,72 @@ lemma const_div [has_div γ] [has_measurable_div γ] (h : ident_distrib f g μ 
   ident_distrib (λ x, c / f x) (λ x, c / g x) μ ν :=
 h.comp (has_measurable_div.measurable_const_div c)
 
-lemma variance_eq {f : α → ℝ} {g : β → ℝ} (h : ident_distrib f g μ ν) :
-  variance f μ = variance g ν :=
+lemma evariance_eq {f : α → ℝ} {g : β → ℝ} (h : ident_distrib f g μ ν) :
+  evariance f μ = evariance g ν :=
 begin
-  convert (h.sub_const (∫ x, f x ∂μ)).sq.integral_eq,
+  convert (h.sub_const (∫ x, f x ∂μ)).nnnorm.coe_nnreal_ennreal.sq.lintegral_eq,
   rw h.integral_eq,
   refl
 end
 
+lemma variance_eq {f : α → ℝ} {g : β → ℝ} (h : ident_distrib f g μ ν) :
+  variance f μ = variance g ν :=
+by { rw [variance, h.evariance_eq], refl, }
+
 end ident_distrib
 
+section uniform_integrable
+
+open topological_space
+
+variables {E : Type*} [measurable_space E] [normed_add_comm_group E] [borel_space E]
+  [second_countable_topology E] {μ : measure α} [is_finite_measure μ]
+
+/-- This lemma is superceded by `mem_ℒp.uniform_integrable_of_ident_distrib` which only require
+`ae_strongly_measurable`. -/
+lemma mem_ℒp.uniform_integrable_of_ident_distrib_aux {ι : Type*} {f : ι → α → E}
+  {j : ι} {p : ℝ≥0∞} (hp : 1 ≤ p) (hp' : p ≠ ∞)
+  (hℒp : mem_ℒp (f j) p μ) (hfmeas : ∀ i, strongly_measurable (f i))
+  (hf : ∀ i, ident_distrib (f i) (f j) μ μ) :
+  uniform_integrable f p μ :=
+begin
+  refine uniform_integrable_of' hp hp' hfmeas (λ ε hε, _),
+  by_cases hι : nonempty ι,
+  swap, { exact ⟨0, λ i, false.elim (hι $ nonempty.intro i)⟩ },
+  obtain ⟨C, hC₁, hC₂⟩ := hℒp.snorm_indicator_norm_ge_pos_le μ (hfmeas _) hε,
+  have hmeas : ∀ i, measurable_set {x | (⟨C, hC₁.le⟩ : ℝ≥0) ≤ ‖f i x‖₊} :=
+    λ i, measurable_set_le measurable_const (hfmeas _).measurable.nnnorm,
+  refine ⟨⟨C, hC₁.le⟩, λ i, le_trans (le_of_eq _) hC₂⟩,
+  have : {x : α | (⟨C, hC₁.le⟩ : ℝ≥0) ≤ ‖f i x‖₊}.indicator (f i) =
+    (λ x : E, if (⟨C, hC₁.le⟩ : ℝ≥0) ≤ ‖x‖₊ then x else 0) ∘ (f i),
+  { ext x,
+    simp only [set.indicator, set.mem_set_of_eq] },
+  simp_rw [coe_nnnorm, this],
+  rw [← snorm_map_measure _ (hf i).ae_measurable_fst, (hf i).map_eq,
+    snorm_map_measure _ (hf j).ae_measurable_fst],
+  { refl },
+  all_goals { exact ae_strongly_measurable_id.indicator
+      (measurable_set_le measurable_const measurable_nnnorm) },
+end
+
+/-- A sequence of identically distributed Lᵖ functions is p-uniformly integrable. -/
+lemma mem_ℒp.uniform_integrable_of_ident_distrib {ι : Type*} {f : ι → α → E}
+  {j : ι} {p : ℝ≥0∞} (hp : 1 ≤ p) (hp' : p ≠ ∞)
+  (hℒp : mem_ℒp (f j) p μ) (hf : ∀ i, ident_distrib (f i) (f j) μ μ) :
+  uniform_integrable f p μ :=
+begin
+  have hfmeas : ∀ i, ae_strongly_measurable (f i) μ :=
+    λ i, (hf i).ae_strongly_measurable_iff.2 hℒp.1,
+  set g : ι → α → E := λ i, (hfmeas i).some,
+  have hgmeas : ∀ i, strongly_measurable (g i) := λ i, (Exists.some_spec $ hfmeas i).1,
+  have hgeq : ∀ i, g i =ᵐ[μ] f i := λ i, (Exists.some_spec $ hfmeas i).2.symm,
+  have hgℒp : mem_ℒp (g j) p μ := hℒp.ae_eq (hgeq j).symm,
+  exact uniform_integrable.ae_eq (mem_ℒp.uniform_integrable_of_ident_distrib_aux hp hp'
+    hgℒp hgmeas $
+    λ i, (ident_distrib.of_ae_eq (hgmeas i).ae_measurable (hgeq i)).trans ((hf i).trans
+      $ ident_distrib.of_ae_eq (hfmeas j).ae_measurable (hgeq j).symm)) hgeq,
+end
+
+end uniform_integrable
+
 end probability_theory
diff --git a/src/probability/independence.lean b/src/probability/independence.lean
deleted file mode 100644
index 4adcf7ed67e63..0000000000000
--- a/src/probability/independence.lean
+++ /dev/null
@@ -1,374 +0,0 @@
-/-
-Copyright (c) 2021 Rémy Degenne. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Rémy Degenne
--/
-import algebra.big_operators.intervals
-import measure_theory.measure.measure_space
-import measure_theory.pi_system
-
-/-!
-# Independence of sets of sets and measure spaces (σ-algebras)
-
-* A family of sets of sets `π : ι → set (set α)` is independent with respect to a measure `μ` if for
-  any finite set of indices `s = {i_1, ..., i_n}`, for any sets `f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`,
-  `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. It will be used for families of π-systems.
-* A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
-  measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
-  define is independent. I.e., `m : ι → measurable_space α` is independent with respect to a
-  measure `μ` if for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
-  `f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i)`.
-* Independence of sets (or events in probabilistic parlance) is defined as independence of the
-  measurable space structures they generate: a set `s` generates the measurable space structure with
-  measurable sets `∅, s, sᶜ, univ`.
-* Independence of functions (or random variables) is also defined as independence of the measurable
-  space structures they generate: a function `f` for which we have a measurable space `m` on the
-  codomain generates `measurable_space.comap f m`.
-
-## Main statements
-
-* TODO: `Indep_of_Indep_sets`: if π-systems are independent as sets of sets, then the
-measurable space structures they generate are independent.
-* `indep_of_indep_sets`: variant with two π-systems.
-
-## Implementation notes
-
-We provide one main definition of independence:
-* `Indep_sets`: independence of a family of sets of sets `pi : ι → set (set α)`.
-Three other independence notions are defined using `Indep_sets`:
-* `Indep`: independence of a family of measurable space structures `m : ι → measurable_space α`,
-* `Indep_set`: independence of a family of sets `s : ι → set α`,
-* `Indep_fun`: independence of a family of functions. For measurable spaces
-  `m : Π (i : ι), measurable_space (β i)`, we consider functions `f : Π (i : ι), α → β i`.
-
-Additionally, we provide four corresponding statements for two measurable space structures (resp.
-sets of sets, sets, functions) instead of a family. These properties are denoted by the same names
-as for a family, but without a capital letter, for example `indep_fun` is the version of `Indep_fun`
-for two functions.
-
-The definition of independence for `Indep_sets` uses finite sets (`finset`). An alternative and
-equivalent way of defining independence would have been to use countable sets.
-TODO: prove that equivalence.
-
-Most of the definitions and lemma in this file list all variables instead of using the `variables`
-keyword at the beginning of a section, for example
-`lemma indep.symm {α} {m₁ m₂ : measurable_space α} [measurable_space α] {μ : measure α} ...` .
-This is intentional, to be able to control the order of the `measurable_space` variables. Indeed
-when defining `μ` in the example above, the measurable space used is the last one defined, here
-`[measurable_space α]`, and not `m₁` or `m₂`.
-
-## References
-
-* Williams, David. Probability with martingales. Cambridge university press, 1991.
-Part A, Chapter 4.
--/
-
-open measure_theory measurable_space
-open_locale big_operators classical measure_theory
-
-namespace probability_theory
-
-section definitions
-
-/-- A family of sets of sets `π : ι → set (set α)` is independent with respect to a measure `μ` if
-for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
-`f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `.
-It will be used for families of pi_systems. -/
-def Indep_sets {α ι} [measurable_space α] (π : ι → set (set α)) (μ : measure α . volume_tac) :
-  Prop :=
-∀ (s : finset ι) {f : ι → set α} (H : ∀ i, i ∈ s → f i ∈ π i), μ (⋂ i ∈ s, f i) = ∏ i in s, μ (f i)
-
-/-- Two sets of sets `s₁, s₂` are independent with respect to a measure `μ` if for any sets
-`t₁ ∈ p₁, t₂ ∈ s₂`, then `μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
-def indep_sets {α} [measurable_space α] (s1 s2 : set (set α)) (μ : measure α . volume_tac) : Prop :=
-∀ t1 t2 : set α, t1 ∈ s1 → t2 ∈ s2 → μ (t1 ∩ t2) = μ t1 * μ t2
-
-/-- A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
-measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
-define is independent. `m : ι → measurable_space α` is independent with respect to measure `μ` if
-for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
-`f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. -/
-def Indep {α ι} (m : ι → measurable_space α) [measurable_space α] (μ : measure α . volume_tac) :
-  Prop :=
-Indep_sets (λ x, {s | measurable_set[m x] s}) μ
-
-/-- Two measurable space structures (or σ-algebras) `m₁, m₂` are independent with respect to a
-measure `μ` (defined on a third σ-algebra) if for any sets `t₁ ∈ m₁, t₂ ∈ m₂`,
-`μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
-def indep {α} (m₁ m₂ : measurable_space α) [measurable_space α] (μ : measure α . volume_tac) :
-  Prop :=
-indep_sets ({s | measurable_set[m₁] s}) ({s | measurable_set[m₂] s}) μ
-
-/-- A family of sets is independent if the family of measurable space structures they generate is
-independent. For a set `s`, the generated measurable space has measurable sets `∅, s, sᶜ, univ`. -/
-def Indep_set {α ι} [measurable_space α] (s : ι → set α) (μ : measure α . volume_tac) : Prop :=
-Indep (λ i, generate_from {s i}) μ
-
-/-- Two sets are independent if the two measurable space structures they generate are independent.
-For a set `s`, the generated measurable space structure has measurable sets `∅, s, sᶜ, univ`. -/
-def indep_set {α} [measurable_space α] (s t : set α) (μ : measure α . volume_tac) : Prop :=
-indep (generate_from {s}) (generate_from {t}) μ
-
-/-- A family of functions defined on the same space `α` and taking values in possibly different
-spaces, each with a measurable space structure, is independent if the family of measurable space
-structures they generate on `α` is independent. For a function `g` with codomain having measurable
-space structure `m`, the generated measurable space structure is `measurable_space.comap g m`. -/
-def Indep_fun {α ι} [measurable_space α] {β : ι → Type*} (m : Π (x : ι), measurable_space (β x))
-  (f : Π (x : ι), α → β x) (μ : measure α . volume_tac) : Prop :=
-Indep (λ x, measurable_space.comap (f x) (m x)) μ
-
-/-- Two functions are independent if the two measurable space structures they generate are
-independent. For a function `f` with codomain having measurable space structure `m`, the generated
-measurable space structure is `measurable_space.comap f m`. -/
-def indep_fun {α β γ} [measurable_space α] [mβ : measurable_space β] [mγ : measurable_space γ]
-  (f : α → β) (g : α → γ) (μ : measure α . volume_tac) : Prop :=
-indep (measurable_space.comap f mβ) (measurable_space.comap g mγ) μ
-
-end definitions
-
-section indep
-
-lemma indep_sets.symm {α} {s₁ s₂ : set (set α)} [measurable_space α] {μ : measure α}
-  (h : indep_sets s₁ s₂ μ) :
-  indep_sets s₂ s₁ μ :=
-by { intros t1 t2 ht1 ht2, rw [set.inter_comm, mul_comm], exact h t2 t1 ht2 ht1, }
-
-lemma indep.symm {α} {m₁ m₂ : measurable_space α} [measurable_space α] {μ : measure α}
-  (h : indep m₁ m₂ μ) :
-  indep m₂ m₁ μ :=
-indep_sets.symm h
-
-lemma indep_sets_of_indep_sets_of_le_left {α} {s₁ s₂ s₃: set (set α)} [measurable_space α]
-  {μ : measure α} (h_indep : indep_sets s₁ s₂ μ) (h31 : s₃ ⊆ s₁) :
-  indep_sets s₃ s₂ μ :=
-λ t1 t2 ht1 ht2, h_indep t1 t2 (set.mem_of_subset_of_mem h31 ht1) ht2
-
-lemma indep_sets_of_indep_sets_of_le_right {α} {s₁ s₂ s₃: set (set α)} [measurable_space α]
-  {μ : measure α} (h_indep : indep_sets s₁ s₂ μ) (h32 : s₃ ⊆ s₂) :
-  indep_sets s₁ s₃ μ :=
-λ t1 t2 ht1 ht2, h_indep t1 t2 ht1 (set.mem_of_subset_of_mem h32 ht2)
-
-lemma indep_of_indep_of_le_left {α} {m₁ m₂ m₃: measurable_space α} [measurable_space α]
-  {μ : measure α} (h_indep : indep m₁ m₂ μ) (h31 : m₃ ≤ m₁) :
-  indep m₃ m₂ μ :=
-λ t1 t2 ht1 ht2, h_indep t1 t2 (h31 _ ht1) ht2
-
-lemma indep_of_indep_of_le_right {α} {m₁ m₂ m₃: measurable_space α} [measurable_space α]
-  {μ : measure α} (h_indep : indep m₁ m₂ μ) (h32 : m₃ ≤ m₂) :
-  indep m₁ m₃ μ :=
-λ t1 t2 ht1 ht2, h_indep t1 t2 ht1 (h32 _ ht2)
-
-lemma indep_sets.union {α} [measurable_space α] {s₁ s₂ s' : set (set α)} {μ : measure α}
-  (h₁ : indep_sets s₁ s' μ) (h₂ : indep_sets s₂ s' μ) :
-  indep_sets (s₁ ∪ s₂) s' μ :=
-begin
-  intros t1 t2 ht1 ht2,
-  cases (set.mem_union _ _ _).mp ht1 with ht1₁ ht1₂,
-  { exact h₁ t1 t2 ht1₁ ht2, },
-  { exact h₂ t1 t2 ht1₂ ht2, },
-end
-
-@[simp] lemma indep_sets.union_iff {α} [measurable_space α] {s₁ s₂ s' : set (set α)}
-  {μ : measure α} :
-  indep_sets (s₁ ∪ s₂) s' μ ↔ indep_sets s₁ s' μ ∧ indep_sets s₂ s' μ :=
-⟨λ h, ⟨indep_sets_of_indep_sets_of_le_left h (set.subset_union_left s₁ s₂),
-    indep_sets_of_indep_sets_of_le_left h (set.subset_union_right s₁ s₂)⟩,
-  λ h, indep_sets.union h.left h.right⟩
-
-lemma indep_sets.Union {α ι} [measurable_space α] {s : ι → set (set α)} {s' : set (set α)}
-  {μ : measure α} (hyp : ∀ n, indep_sets (s n) s' μ) :
-  indep_sets (⋃ n, s n) s' μ :=
-begin
-  intros t1 t2 ht1 ht2,
-  rw set.mem_Union at ht1,
-  cases ht1 with n ht1,
-  exact hyp n t1 t2 ht1 ht2,
-end
-
-lemma indep_sets.inter {α} [measurable_space α] {s₁ s' : set (set α)} (s₂ : set (set α))
-  {μ : measure α} (h₁ : indep_sets s₁ s' μ) :
-  indep_sets (s₁ ∩ s₂) s' μ :=
-λ t1 t2 ht1 ht2, h₁ t1 t2 ((set.mem_inter_iff _ _ _).mp ht1).left ht2
-
-lemma indep_sets.Inter {α ι} [measurable_space α] {s : ι → set (set α)} {s' : set (set α)}
-  {μ : measure α} (h : ∃ n, indep_sets (s n) s' μ) :
-  indep_sets (⋂ n, s n) s' μ :=
-by {intros t1 t2 ht1 ht2, cases h with n h, exact h t1 t2 (set.mem_Inter.mp ht1 n) ht2 }
-
-lemma indep_sets_singleton_iff {α} [measurable_space α] {s t : set α} {μ : measure α} :
-  indep_sets {s} {t} μ ↔ μ (s ∩ t) = μ s * μ t :=
-⟨λ h, h s t rfl rfl,
-  λ h s1 t1 hs1 ht1, by rwa [set.mem_singleton_iff.mp hs1, set.mem_singleton_iff.mp ht1]⟩
-
-end indep
-
-/-! ### Deducing `indep` from `Indep` -/
-section from_Indep_to_indep
-
-lemma Indep_sets.indep_sets {α ι} {s : ι → set (set α)} [measurable_space α] {μ : measure α}
-  (h_indep : Indep_sets s μ) {i j : ι} (hij : i ≠ j) :
-  indep_sets (s i) (s j) μ :=
-begin
-  intros t₁ t₂ ht₁ ht₂,
-  have hf_m : ∀ (x : ι), x ∈ {i, j} → (ite (x=i) t₁ t₂) ∈ s x,
-  { intros x hx,
-    cases finset.mem_insert.mp hx with hx hx,
-    { simp [hx, ht₁], },
-    { simp [finset.mem_singleton.mp hx, hij.symm, ht₂], }, },
-  have h1 : t₁ = ite (i = i) t₁ t₂, by simp only [if_true, eq_self_iff_true],
-  have h2 : t₂ = ite (j = i) t₁ t₂, by simp only [hij.symm, if_false],
-  have h_inter : (⋂ (t : ι) (H : t ∈ ({i, j} : finset ι)), ite (t = i) t₁ t₂)
-      = (ite (i = i) t₁ t₂) ∩ (ite (j = i) t₁ t₂),
-    by simp only [finset.set_bInter_singleton, finset.set_bInter_insert],
-  have h_prod : (∏ (t : ι) in ({i, j} : finset ι), μ (ite (t = i) t₁ t₂))
-      = μ (ite (i = i) t₁ t₂) * μ (ite (j = i) t₁ t₂),
-    by simp only [hij, finset.prod_singleton, finset.prod_insert, not_false_iff,
-      finset.mem_singleton],
-  rw h1,
-  nth_rewrite 1 h2,
-  nth_rewrite 3 h2,
-  rw [←h_inter, ←h_prod, h_indep {i, j} hf_m],
-end
-
-lemma Indep.indep {α ι} {m : ι → measurable_space α} [measurable_space α] {μ : measure α}
-  (h_indep : Indep m μ) {i j : ι} (hij : i ≠ j) :
-  indep (m i) (m j) μ :=
-begin
-  change indep_sets ((λ x, (m x).measurable_set') i) ((λ x, (m x).measurable_set') j) μ,
-  exact Indep_sets.indep_sets h_indep hij,
-end
-
-end from_Indep_to_indep
-
-/-!
-## π-system lemma
-
-Independence of measurable spaces is equivalent to independence of generating π-systems.
--/
-
-section from_measurable_spaces_to_sets_of_sets
-/-! ### Independence of measurable space structures implies independence of generating π-systems -/
-
-lemma Indep.Indep_sets {α ι} [measurable_space α] {μ : measure α} {m : ι → measurable_space α}
-  {s : ι → set (set α)} (hms : ∀ n, m n = generate_from (s n))
-  (h_indep : Indep m μ) :
-  Indep_sets s μ :=
-λ S f hfs, h_indep S $ λ x hxS,
-  ((hms x).symm ▸ measurable_set_generate_from (hfs x hxS) : measurable_set[m x] (f x))
-
-lemma indep.indep_sets {α} [measurable_space α] {μ : measure α} {s1 s2 : set (set α)}
-  (h_indep : indep (generate_from s1) (generate_from s2) μ) :
-  indep_sets s1 s2 μ :=
-λ t1 t2 ht1 ht2, h_indep t1 t2 (measurable_set_generate_from ht1) (measurable_set_generate_from ht2)
-
-end from_measurable_spaces_to_sets_of_sets
-
-section from_pi_systems_to_measurable_spaces
-/-! ### Independence of generating π-systems implies independence of measurable space structures -/
-
-private lemma indep_sets.indep_aux {α} {m2 : measurable_space α}
-  {m : measurable_space α} {μ : measure α} [is_probability_measure μ] {p1 p2 : set (set α)}
-  (h2 : m2 ≤ m) (hp2 : is_pi_system p2) (hpm2 : m2 = generate_from p2)
-  (hyp : indep_sets p1 p2 μ) {t1 t2 : set α} (ht1 : t1 ∈ p1) (ht2m : m2.measurable_set' t2) :
-  μ (t1 ∩ t2) = μ t1 * μ t2 :=
-begin
-  let μ_inter := μ.restrict t1,
-  let ν := (μ t1) • μ,
-  have h_univ : μ_inter set.univ = ν set.univ,
-  by rw [measure.restrict_apply_univ, measure.smul_apply, smul_eq_mul, measure_univ, mul_one],
-  haveI : is_finite_measure μ_inter := @restrict.is_finite_measure α _ t1 μ ⟨measure_lt_top μ t1⟩,
-  rw [set.inter_comm, ←@measure.restrict_apply α _ μ t1 t2 (h2 t2 ht2m)],
-  refine ext_on_measurable_space_of_generate_finite m p2 (λ t ht, _) h2 hpm2 hp2 h_univ ht2m,
-  have ht2 : m.measurable_set' t,
-  { refine h2 _ _,
-    rw hpm2,
-    exact measurable_set_generate_from ht, },
-  rw [measure.restrict_apply ht2, measure.smul_apply, set.inter_comm],
-  exact hyp t1 t ht1 ht,
-end
-
-lemma indep_sets.indep {α} {m1 m2 : measurable_space α} {m : measurable_space α}
-  {μ : measure α} [is_probability_measure μ] {p1 p2 : set (set α)} (h1 : m1 ≤ m) (h2 : m2 ≤ m)
-  (hp1 : is_pi_system p1) (hp2 : is_pi_system p2) (hpm1 : m1 = generate_from p1)
-  (hpm2 : m2 = generate_from p2) (hyp : indep_sets p1 p2 μ) :
-  indep m1 m2 μ :=
-begin
-  intros t1 t2 ht1 ht2,
-  let μ_inter := μ.restrict t2,
-  let ν := (μ t2) • μ,
-  have h_univ : μ_inter set.univ = ν set.univ,
-  by rw [measure.restrict_apply_univ, measure.smul_apply, smul_eq_mul, measure_univ, mul_one],
-  haveI : is_finite_measure μ_inter := @restrict.is_finite_measure α _ t2 μ ⟨measure_lt_top μ t2⟩,
-  rw [mul_comm, ←@measure.restrict_apply α _ μ t2 t1 (h1 t1 ht1)],
-  refine ext_on_measurable_space_of_generate_finite m p1 (λ t ht, _) h1 hpm1 hp1 h_univ ht1,
-  have ht1 : m.measurable_set' t,
-  { refine h1 _ _,
-    rw hpm1,
-    exact measurable_set_generate_from ht, },
-  rw [measure.restrict_apply ht1, measure.smul_apply, smul_eq_mul, mul_comm],
-  exact indep_sets.indep_aux h2 hp2 hpm2 hyp ht ht2,
-end
-
-end from_pi_systems_to_measurable_spaces
-
-section indep_set
-/-! ### Independence of measurable sets
-
-We prove the following equivalences on `indep_set`, for measurable sets `s, t`.
-* `indep_set s t μ ↔ μ (s ∩ t) = μ s * μ t`,
-* `indep_set s t μ ↔ indep_sets {s} {t} μ`.
--/
-
-variables {α : Type*} [measurable_space α] {s t : set α} (S T : set (set α))
-
-lemma indep_set_iff_indep_sets_singleton (hs_meas : measurable_set s) (ht_meas : measurable_set t)
-  (μ : measure α . volume_tac) [is_probability_measure μ] :
-  indep_set s t μ ↔ indep_sets {s} {t} μ :=
-⟨indep.indep_sets,  λ h, indep_sets.indep
-  (generate_from_le (λ u hu, by rwa set.mem_singleton_iff.mp hu))
-  (generate_from_le (λ u hu, by rwa set.mem_singleton_iff.mp hu)) (is_pi_system.singleton s)
-  (is_pi_system.singleton t) rfl rfl h⟩
-
-lemma indep_set_iff_measure_inter_eq_mul (hs_meas : measurable_set s) (ht_meas : measurable_set t)
-  (μ : measure α . volume_tac) [is_probability_measure μ] :
-  indep_set s t μ ↔ μ (s ∩ t) = μ s * μ t :=
-(indep_set_iff_indep_sets_singleton hs_meas ht_meas μ).trans indep_sets_singleton_iff
-
-lemma indep_sets.indep_set_of_mem (hs : s ∈ S) (ht : t ∈ T) (hs_meas : measurable_set s)
-  (ht_meas : measurable_set t) (μ : measure α . volume_tac) [is_probability_measure μ]
-  (h_indep : indep_sets S T μ) :
-  indep_set s t μ :=
-(indep_set_iff_measure_inter_eq_mul hs_meas ht_meas μ).mpr (h_indep s t hs ht)
-
-end indep_set
-
-section indep_fun
-
-variables {α β β' γ γ' : Type*} {mα : measurable_space α} {μ : measure α}
-
-lemma indep_fun.ae_eq {mβ : measurable_space β} {f g f' g' : α → β}
-  (hfg : indep_fun f g μ) (hf : f =ᵐ[μ] f') (hg : g =ᵐ[μ] g') :
-  indep_fun f' g' μ :=
-begin
-  rintro _ _ ⟨A, hA, rfl⟩ ⟨B, hB, rfl⟩,
-  have h1 : f ⁻¹' A =ᵐ[μ] f' ⁻¹' A := hf.fun_comp A,
-  have h2 : g ⁻¹' B =ᵐ[μ] g' ⁻¹' B := hg.fun_comp B,
-  rw [←measure_congr h1, ←measure_congr h2, ←measure_congr (h1.inter h2)],
-  exact hfg _ _ ⟨_, hA, rfl⟩ ⟨_, hB, rfl⟩
-end
-
-lemma indep_fun.comp {mβ : measurable_space β} {mβ' : measurable_space β'}
-  {mγ : measurable_space γ} {mγ' : measurable_space γ'}
-  {f : α → β} {g : α → β'} {φ : β → γ} {ψ : β' → γ'}
-  (hfg : indep_fun f g μ) (hφ : measurable φ) (hψ : measurable ψ) :
-  indep_fun (φ ∘ f) (ψ ∘ g) μ :=
-begin
-  rintro _ _ ⟨A, hA, rfl⟩ ⟨B, hB, rfl⟩,
-  apply hfg,
-  { exact ⟨φ ⁻¹' A, hφ hA, set.preimage_comp.symm⟩ },
-  { exact ⟨ψ ⁻¹' B, hψ hB, set.preimage_comp.symm⟩ }
-end
-
-end indep_fun
-
-end probability_theory
diff --git a/src/probability/independence/basic.lean b/src/probability/independence/basic.lean
new file mode 100644
index 0000000000000..03218d5783112
--- /dev/null
+++ b/src/probability/independence/basic.lean
@@ -0,0 +1,935 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.constructions.pi
+
+/-!
+# Independence of sets of sets and measure spaces (σ-algebras)
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+* A family of sets of sets `π : ι → set (set Ω)` is independent with respect to a measure `μ` if for
+  any finite set of indices `s = {i_1, ..., i_n}`, for any sets `f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`,
+  `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. It will be used for families of π-systems.
+* A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
+  measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
+  define is independent. I.e., `m : ι → measurable_space Ω` is independent with respect to a
+  measure `μ` if for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
+  `f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i)`.
+* Independence of sets (or events in probabilistic parlance) is defined as independence of the
+  measurable space structures they generate: a set `s` generates the measurable space structure with
+  measurable sets `∅, s, sᶜ, univ`.
+* Independence of functions (or random variables) is also defined as independence of the measurable
+  space structures they generate: a function `f` for which we have a measurable space `m` on the
+  codomain generates `measurable_space.comap f m`.
+
+## Main statements
+
+* `Indep_sets.Indep`: if π-systems are independent as sets of sets, then the
+  measurable space structures they generate are independent.
+* `indep_sets.indep`: variant with two π-systems.
+
+## Implementation notes
+
+We provide one main definition of independence:
+* `Indep_sets`: independence of a family of sets of sets `pi : ι → set (set Ω)`.
+Three other independence notions are defined using `Indep_sets`:
+* `Indep`: independence of a family of measurable space structures `m : ι → measurable_space Ω`,
+* `Indep_set`: independence of a family of sets `s : ι → set Ω`,
+* `Indep_fun`: independence of a family of functions. For measurable spaces
+  `m : Π (i : ι), measurable_space (β i)`, we consider functions `f : Π (i : ι), Ω → β i`.
+
+Additionally, we provide four corresponding statements for two measurable space structures (resp.
+sets of sets, sets, functions) instead of a family. These properties are denoted by the same names
+as for a family, but without a capital letter, for example `indep_fun` is the version of `Indep_fun`
+for two functions.
+
+The definition of independence for `Indep_sets` uses finite sets (`finset`). An alternative and
+equivalent way of defining independence would have been to use countable sets.
+TODO: prove that equivalence.
+
+Most of the definitions and lemma in this file list all variables instead of using the `variables`
+keyword at the beginning of a section, for example
+`lemma indep.symm {Ω} {m₁ m₂ : measurable_space Ω} [measurable_space Ω] {μ : measure Ω} ...` .
+This is intentional, to be able to control the order of the `measurable_space` variables. Indeed
+when defining `μ` in the example above, the measurable space used is the last one defined, here
+`[measurable_space Ω]`, and not `m₁` or `m₂`.
+
+## References
+
+* Williams, David. Probability with martingales. Cambridge university press, 1991.
+Part A, Chapter 4.
+-/
+
+open measure_theory measurable_space set
+open_locale big_operators measure_theory ennreal
+
+namespace probability_theory
+
+variables {Ω ι : Type*}
+
+section definitions
+
+/-- A family of sets of sets `π : ι → set (set Ω)` is independent with respect to a measure `μ` if
+for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
+`f i_1 ∈ π i_1, ..., f i_n ∈ π i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `.
+It will be used for families of pi_systems. -/
+def Indep_sets [measurable_space Ω] (π : ι → set (set Ω)) (μ : measure Ω . volume_tac) :
+  Prop :=
+∀ (s : finset ι) {f : ι → set Ω} (H : ∀ i, i ∈ s → f i ∈ π i), μ (⋂ i ∈ s, f i) = ∏ i in s, μ (f i)
+
+/-- Two sets of sets `s₁, s₂` are independent with respect to a measure `μ` if for any sets
+`t₁ ∈ p₁, t₂ ∈ s₂`, then `μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
+def indep_sets [measurable_space Ω] (s1 s2 : set (set Ω)) (μ : measure Ω . volume_tac) : Prop :=
+∀ t1 t2 : set Ω, t1 ∈ s1 → t2 ∈ s2 → μ (t1 ∩ t2) = μ t1 * μ t2
+
+/-- A family of measurable space structures (i.e. of σ-algebras) is independent with respect to a
+measure `μ` (typically defined on a finer σ-algebra) if the family of sets of measurable sets they
+define is independent. `m : ι → measurable_space Ω` is independent with respect to measure `μ` if
+for any finite set of indices `s = {i_1, ..., i_n}`, for any sets
+`f i_1 ∈ m i_1, ..., f i_n ∈ m i_n`, then `μ (⋂ i in s, f i) = ∏ i in s, μ (f i) `. -/
+def Indep (m : ι → measurable_space Ω) [measurable_space Ω] (μ : measure Ω . volume_tac) :
+  Prop :=
+Indep_sets (λ x, {s | measurable_set[m x] s}) μ
+
+/-- Two measurable space structures (or σ-algebras) `m₁, m₂` are independent with respect to a
+measure `μ` (defined on a third σ-algebra) if for any sets `t₁ ∈ m₁, t₂ ∈ m₂`,
+`μ (t₁ ∩ t₂) = μ (t₁) * μ (t₂)` -/
+def indep (m₁ m₂ : measurable_space Ω) [measurable_space Ω] (μ : measure Ω . volume_tac) :
+  Prop :=
+indep_sets {s | measurable_set[m₁] s} {s | measurable_set[m₂] s} μ
+
+/-- A family of sets is independent if the family of measurable space structures they generate is
+independent. For a set `s`, the generated measurable space has measurable sets `∅, s, sᶜ, univ`. -/
+def Indep_set [measurable_space Ω] (s : ι → set Ω) (μ : measure Ω . volume_tac) : Prop :=
+Indep (λ i, generate_from {s i}) μ
+
+/-- Two sets are independent if the two measurable space structures they generate are independent.
+For a set `s`, the generated measurable space structure has measurable sets `∅, s, sᶜ, univ`. -/
+def indep_set [measurable_space Ω] (s t : set Ω) (μ : measure Ω . volume_tac) : Prop :=
+indep (generate_from {s}) (generate_from {t}) μ
+
+/-- A family of functions defined on the same space `Ω` and taking values in possibly different
+spaces, each with a measurable space structure, is independent if the family of measurable space
+structures they generate on `Ω` is independent. For a function `g` with codomain having measurable
+space structure `m`, the generated measurable space structure is `measurable_space.comap g m`. -/
+def Indep_fun [measurable_space Ω] {β : ι → Type*} (m : Π (x : ι), measurable_space (β x))
+  (f : Π (x : ι), Ω → β x) (μ : measure Ω . volume_tac) : Prop :=
+Indep (λ x, measurable_space.comap (f x) (m x)) μ
+
+/-- Two functions are independent if the two measurable space structures they generate are
+independent. For a function `f` with codomain having measurable space structure `m`, the generated
+measurable space structure is `measurable_space.comap f m`. -/
+def indep_fun {β γ} [measurable_space Ω] [mβ : measurable_space β] [mγ : measurable_space γ]
+  (f : Ω → β) (g : Ω → γ) (μ : measure Ω . volume_tac) : Prop :=
+indep (measurable_space.comap f mβ) (measurable_space.comap g mγ) μ
+
+end definitions
+
+section indep
+
+@[symm] lemma indep_sets.symm {s₁ s₂ : set (set Ω)} [measurable_space Ω] {μ : measure Ω}
+  (h : indep_sets s₁ s₂ μ) :
+  indep_sets s₂ s₁ μ :=
+by { intros t1 t2 ht1 ht2, rw [set.inter_comm, mul_comm], exact h t2 t1 ht2 ht1, }
+
+@[symm] lemma indep.symm {m₁ m₂ : measurable_space Ω} [measurable_space Ω] {μ : measure Ω}
+  (h : indep m₁ m₂ μ) :
+  indep m₂ m₁ μ :=
+indep_sets.symm h
+
+lemma indep_bot_right (m' : measurable_space Ω) {m : measurable_space Ω}
+  {μ : measure Ω} [is_probability_measure μ] :
+  indep m' ⊥ μ :=
+begin
+  intros s t hs ht,
+  rw [set.mem_set_of_eq, measurable_space.measurable_set_bot_iff] at ht,
+  cases ht,
+  { rw [ht, set.inter_empty, measure_empty, mul_zero], },
+  { rw [ht, set.inter_univ, measure_univ, mul_one], },
+end
+
+lemma indep_bot_left (m' : measurable_space Ω) {m : measurable_space Ω}
+  {μ : measure Ω} [is_probability_measure μ] :
+  indep ⊥ m' μ :=
+(indep_bot_right m').symm
+
+lemma indep_set_empty_right {m : measurable_space Ω} {μ : measure Ω} [is_probability_measure μ]
+  (s : set Ω) :
+  indep_set s ∅ μ :=
+by { simp only [indep_set, generate_from_singleton_empty], exact indep_bot_right _, }
+
+lemma indep_set_empty_left {m : measurable_space Ω} {μ : measure Ω} [is_probability_measure μ]
+  (s : set Ω) :
+  indep_set ∅ s μ :=
+(indep_set_empty_right s).symm
+
+lemma indep_sets_of_indep_sets_of_le_left {s₁ s₂ s₃: set (set Ω)} [measurable_space Ω]
+  {μ : measure Ω} (h_indep : indep_sets s₁ s₂ μ) (h31 : s₃ ⊆ s₁) :
+  indep_sets s₃ s₂ μ :=
+λ t1 t2 ht1 ht2, h_indep t1 t2 (set.mem_of_subset_of_mem h31 ht1) ht2
+
+lemma indep_sets_of_indep_sets_of_le_right {s₁ s₂ s₃: set (set Ω)} [measurable_space Ω]
+  {μ : measure Ω} (h_indep : indep_sets s₁ s₂ μ) (h32 : s₃ ⊆ s₂) :
+  indep_sets s₁ s₃ μ :=
+λ t1 t2 ht1 ht2, h_indep t1 t2 ht1 (set.mem_of_subset_of_mem h32 ht2)
+
+lemma indep_of_indep_of_le_left {m₁ m₂ m₃: measurable_space Ω} [measurable_space Ω]
+  {μ : measure Ω} (h_indep : indep m₁ m₂ μ) (h31 : m₃ ≤ m₁) :
+  indep m₃ m₂ μ :=
+λ t1 t2 ht1 ht2, h_indep t1 t2 (h31 _ ht1) ht2
+
+lemma indep_of_indep_of_le_right {m₁ m₂ m₃: measurable_space Ω} [measurable_space Ω]
+  {μ : measure Ω} (h_indep : indep m₁ m₂ μ) (h32 : m₃ ≤ m₂) :
+  indep m₁ m₃ μ :=
+λ t1 t2 ht1 ht2, h_indep t1 t2 ht1 (h32 _ ht2)
+
+lemma indep_sets.union [measurable_space Ω] {s₁ s₂ s' : set (set Ω)} {μ : measure Ω}
+  (h₁ : indep_sets s₁ s' μ) (h₂ : indep_sets s₂ s' μ) :
+  indep_sets (s₁ ∪ s₂) s' μ :=
+begin
+  intros t1 t2 ht1 ht2,
+  cases (set.mem_union _ _ _).mp ht1 with ht1₁ ht1₂,
+  { exact h₁ t1 t2 ht1₁ ht2, },
+  { exact h₂ t1 t2 ht1₂ ht2, },
+end
+
+@[simp] lemma indep_sets.union_iff [measurable_space Ω] {s₁ s₂ s' : set (set Ω)}
+  {μ : measure Ω} :
+  indep_sets (s₁ ∪ s₂) s' μ ↔ indep_sets s₁ s' μ ∧ indep_sets s₂ s' μ :=
+⟨λ h, ⟨indep_sets_of_indep_sets_of_le_left h (set.subset_union_left s₁ s₂),
+    indep_sets_of_indep_sets_of_le_left h (set.subset_union_right s₁ s₂)⟩,
+  λ h, indep_sets.union h.left h.right⟩
+
+lemma indep_sets.Union [measurable_space Ω] {s : ι → set (set Ω)} {s' : set (set Ω)}
+  {μ : measure Ω} (hyp : ∀ n, indep_sets (s n) s' μ) :
+  indep_sets (⋃ n, s n) s' μ :=
+begin
+  intros t1 t2 ht1 ht2,
+  rw set.mem_Union at ht1,
+  cases ht1 with n ht1,
+  exact hyp n t1 t2 ht1 ht2,
+end
+
+lemma indep_sets.bUnion [measurable_space Ω] {s : ι → set (set Ω)} {s' : set (set Ω)}
+  {μ : measure Ω} {u : set ι} (hyp : ∀ n ∈ u, indep_sets (s n) s' μ) :
+  indep_sets (⋃ n ∈ u, s n) s' μ :=
+begin
+  intros t1 t2 ht1 ht2,
+  simp_rw set.mem_Union at ht1,
+  rcases ht1 with ⟨n, hpn, ht1⟩,
+  exact hyp n hpn t1 t2 ht1 ht2,
+end
+
+lemma indep_sets.inter [measurable_space Ω] {s₁ s' : set (set Ω)} (s₂ : set (set Ω))
+  {μ : measure Ω} (h₁ : indep_sets s₁ s' μ) :
+  indep_sets (s₁ ∩ s₂) s' μ :=
+λ t1 t2 ht1 ht2, h₁ t1 t2 ((set.mem_inter_iff _ _ _).mp ht1).left ht2
+
+lemma indep_sets.Inter [measurable_space Ω] {s : ι → set (set Ω)} {s' : set (set Ω)}
+  {μ : measure Ω} (h : ∃ n, indep_sets (s n) s' μ) :
+  indep_sets (⋂ n, s n) s' μ :=
+by {intros t1 t2 ht1 ht2, cases h with n h, exact h t1 t2 (set.mem_Inter.mp ht1 n) ht2 }
+
+lemma indep_sets.bInter [measurable_space Ω] {s : ι → set (set Ω)} {s' : set (set Ω)}
+  {μ : measure Ω} {u : set ι} (h : ∃ n ∈ u, indep_sets (s n) s' μ) :
+  indep_sets (⋂ n ∈ u, s n) s' μ :=
+begin
+  intros t1 t2 ht1 ht2,
+  rcases h with ⟨n, hn, h⟩,
+  exact h t1 t2 (set.bInter_subset_of_mem hn ht1) ht2,
+end
+
+lemma indep_sets_singleton_iff [measurable_space Ω] {s t : set Ω} {μ : measure Ω} :
+  indep_sets {s} {t} μ ↔ μ (s ∩ t) = μ s * μ t :=
+⟨λ h, h s t rfl rfl,
+  λ h s1 t1 hs1 ht1, by rwa [set.mem_singleton_iff.mp hs1, set.mem_singleton_iff.mp ht1]⟩
+
+end indep
+
+/-! ### Deducing `indep` from `Indep` -/
+section from_Indep_to_indep
+
+lemma Indep_sets.indep_sets {s : ι → set (set Ω)} [measurable_space Ω] {μ : measure Ω}
+  (h_indep : Indep_sets s μ) {i j : ι} (hij : i ≠ j) :
+  indep_sets (s i) (s j) μ :=
+begin
+  classical,
+  intros t₁ t₂ ht₁ ht₂,
+  have hf_m : ∀ (x : ι), x ∈ {i, j} → (ite (x=i) t₁ t₂) ∈ s x,
+  { intros x hx,
+    cases finset.mem_insert.mp hx with hx hx,
+    { simp [hx, ht₁], },
+    { simp [finset.mem_singleton.mp hx, hij.symm, ht₂], }, },
+  have h1 : t₁ = ite (i = i) t₁ t₂, by simp only [if_true, eq_self_iff_true],
+  have h2 : t₂ = ite (j = i) t₁ t₂, by simp only [hij.symm, if_false],
+  have h_inter : (⋂ (t : ι) (H : t ∈ ({i, j} : finset ι)), ite (t = i) t₁ t₂)
+      = (ite (i = i) t₁ t₂) ∩ (ite (j = i) t₁ t₂),
+    by simp only [finset.set_bInter_singleton, finset.set_bInter_insert],
+  have h_prod : (∏ (t : ι) in ({i, j} : finset ι), μ (ite (t = i) t₁ t₂))
+      = μ (ite (i = i) t₁ t₂) * μ (ite (j = i) t₁ t₂),
+    by simp only [hij, finset.prod_singleton, finset.prod_insert, not_false_iff,
+      finset.mem_singleton],
+  rw h1,
+  nth_rewrite 1 h2,
+  nth_rewrite 3 h2,
+  rw [← h_inter, ← h_prod, h_indep {i, j} hf_m],
+end
+
+lemma Indep.indep {m : ι → measurable_space Ω} [measurable_space Ω] {μ : measure Ω}
+  (h_indep : Indep m μ) {i j : ι} (hij : i ≠ j) :
+  indep (m i) (m j) μ :=
+begin
+  change indep_sets ((λ x, measurable_set[m x]) i) ((λ x, measurable_set[m x]) j) μ,
+  exact Indep_sets.indep_sets h_indep hij,
+end
+
+lemma Indep_fun.indep_fun {m₀ : measurable_space Ω} {μ : measure Ω} {β : ι → Type*}
+  {m : Π x, measurable_space (β x)} {f : Π i, Ω → β i} (hf_Indep : Indep_fun m f μ)
+  {i j : ι} (hij : i ≠ j) :
+  indep_fun (f i) (f j) μ :=
+hf_Indep.indep hij
+
+end from_Indep_to_indep
+
+/-!
+## π-system lemma
+
+Independence of measurable spaces is equivalent to independence of generating π-systems.
+-/
+
+section from_measurable_spaces_to_sets_of_sets
+/-! ### Independence of measurable space structures implies independence of generating π-systems -/
+
+lemma Indep.Indep_sets [measurable_space Ω] {μ : measure Ω} {m : ι → measurable_space Ω}
+  {s : ι → set (set Ω)} (hms : ∀ n, m n = generate_from (s n))
+  (h_indep : Indep m μ) :
+  Indep_sets s μ :=
+λ S f hfs, h_indep S $ λ x hxS,
+  ((hms x).symm ▸ measurable_set_generate_from (hfs x hxS) : measurable_set[m x] (f x))
+
+lemma indep.indep_sets [measurable_space Ω] {μ : measure Ω} {s1 s2 : set (set Ω)}
+  (h_indep : indep (generate_from s1) (generate_from s2) μ) :
+  indep_sets s1 s2 μ :=
+λ t1 t2 ht1 ht2, h_indep t1 t2 (measurable_set_generate_from ht1) (measurable_set_generate_from ht2)
+
+end from_measurable_spaces_to_sets_of_sets
+
+section from_pi_systems_to_measurable_spaces
+/-! ### Independence of generating π-systems implies independence of measurable space structures -/
+
+private lemma indep_sets.indep_aux {m2 : measurable_space Ω}
+  {m : measurable_space Ω} {μ : measure Ω} [is_probability_measure μ] {p1 p2 : set (set Ω)}
+  (h2 : m2 ≤ m) (hp2 : is_pi_system p2) (hpm2 : m2 = generate_from p2)
+  (hyp : indep_sets p1 p2 μ) {t1 t2 : set Ω} (ht1 : t1 ∈ p1) (ht2m : measurable_set[m2] t2) :
+  μ (t1 ∩ t2) = μ t1 * μ t2 :=
+begin
+  let μ_inter := μ.restrict t1,
+  let ν := (μ t1) • μ,
+  have h_univ : μ_inter set.univ = ν set.univ,
+  by rw [measure.restrict_apply_univ, measure.smul_apply, smul_eq_mul, measure_univ, mul_one],
+  haveI : is_finite_measure μ_inter := @restrict.is_finite_measure Ω _ t1 μ ⟨measure_lt_top μ t1⟩,
+  rw [set.inter_comm, ← measure.restrict_apply (h2 t2 ht2m)],
+  refine ext_on_measurable_space_of_generate_finite m p2 (λ t ht, _) h2 hpm2 hp2 h_univ ht2m,
+  have ht2 : measurable_set[m] t,
+  { refine h2 _ _,
+    rw hpm2,
+    exact measurable_set_generate_from ht, },
+  rw [measure.restrict_apply ht2, measure.smul_apply, set.inter_comm],
+  exact hyp t1 t ht1 ht,
+end
+
+lemma indep_sets.indep {m1 m2 : measurable_space Ω} {m : measurable_space Ω}
+  {μ : measure Ω} [is_probability_measure μ] {p1 p2 : set (set Ω)} (h1 : m1 ≤ m) (h2 : m2 ≤ m)
+  (hp1 : is_pi_system p1) (hp2 : is_pi_system p2) (hpm1 : m1 = generate_from p1)
+  (hpm2 : m2 = generate_from p2) (hyp : indep_sets p1 p2 μ) :
+  indep m1 m2 μ :=
+begin
+  intros t1 t2 ht1 ht2,
+  let μ_inter := μ.restrict t2,
+  let ν := (μ t2) • μ,
+  have h_univ : μ_inter set.univ = ν set.univ,
+  by rw [measure.restrict_apply_univ, measure.smul_apply, smul_eq_mul, measure_univ, mul_one],
+  haveI : is_finite_measure μ_inter := @restrict.is_finite_measure Ω _ t2 μ ⟨measure_lt_top μ t2⟩,
+  rw [mul_comm, ← measure.restrict_apply (h1 t1 ht1)],
+  refine ext_on_measurable_space_of_generate_finite m p1 (λ t ht, _) h1 hpm1 hp1 h_univ ht1,
+  have ht1 : measurable_set[m] t,
+  { refine h1 _ _,
+    rw hpm1,
+    exact measurable_set_generate_from ht, },
+  rw [measure.restrict_apply ht1, measure.smul_apply, smul_eq_mul, mul_comm],
+  exact indep_sets.indep_aux h2 hp2 hpm2 hyp ht ht2,
+end
+
+lemma indep_sets.indep' {m : measurable_space Ω}
+  {μ : measure Ω} [is_probability_measure μ] {p1 p2 : set (set Ω)}
+  (hp1m : ∀ s ∈ p1, measurable_set s) (hp2m : ∀ s ∈ p2, measurable_set s)
+  (hp1 : is_pi_system p1) (hp2 : is_pi_system p2) (hyp : indep_sets p1 p2 μ) :
+  indep (generate_from p1) (generate_from p2) μ :=
+hyp.indep (generate_from_le hp1m) (generate_from_le hp2m) hp1 hp2 rfl rfl
+
+variables {m0 : measurable_space Ω} {μ : measure Ω}
+
+lemma indep_sets_pi_Union_Inter_of_disjoint [is_probability_measure μ]
+  {s : ι → set (set Ω)} {S T : set ι}
+  (h_indep : Indep_sets s μ) (hST : disjoint S T) :
+  indep_sets (pi_Union_Inter s S) (pi_Union_Inter s T) μ :=
+begin
+  rintros t1 t2 ⟨p1, hp1, f1, ht1_m, ht1_eq⟩ ⟨p2, hp2, f2, ht2_m, ht2_eq⟩,
+  classical,
+  let g := λ i, ite (i ∈ p1) (f1 i) set.univ ∩ ite (i ∈ p2) (f2 i) set.univ,
+  have h_P_inter : μ (t1 ∩ t2) = ∏ n in p1 ∪ p2, μ (g n),
+  { have hgm : ∀ i ∈ p1 ∪ p2, g i ∈ s i,
+    { intros i hi_mem_union,
+      rw finset.mem_union at hi_mem_union,
+      cases hi_mem_union with hi1 hi2,
+      { have hi2 : i ∉ p2 := λ hip2, set.disjoint_left.mp hST (hp1 hi1) (hp2 hip2),
+        simp_rw [g, if_pos hi1, if_neg hi2, set.inter_univ],
+        exact ht1_m i hi1, },
+      { have hi1 : i ∉ p1 := λ hip1, set.disjoint_right.mp hST (hp2 hi2) (hp1 hip1),
+        simp_rw [g, if_neg hi1, if_pos hi2, set.univ_inter],
+        exact ht2_m i hi2, }, },
+    have h_p1_inter_p2 : ((⋂ x ∈ p1, f1 x) ∩ ⋂ x ∈ p2, f2 x)
+      = ⋂ i ∈ p1 ∪ p2, (ite (i ∈ p1) (f1 i) set.univ ∩ ite (i ∈ p2) (f2 i) set.univ),
+    { ext1 x,
+      simp only [set.mem_ite_univ_right, set.mem_inter_iff, set.mem_Inter, finset.mem_union],
+      exact ⟨λ h i _, ⟨h.1 i, h.2 i⟩,
+        λ h, ⟨λ i hi, (h i (or.inl hi)).1 hi, λ i hi, (h i (or.inr hi)).2 hi⟩⟩, },
+    rw [ht1_eq, ht2_eq, h_p1_inter_p2, ← h_indep _ hgm], },
+  have h_μg : ∀ n, μ (g n) = (ite (n ∈ p1) (μ (f1 n)) 1) * (ite (n ∈ p2) (μ (f2 n)) 1),
+  { intro n,
+    simp_rw g,
+    split_ifs,
+    { exact absurd rfl (set.disjoint_iff_forall_ne.mp hST _ (hp1 h) _ (hp2 h_1)), },
+    all_goals { simp only [measure_univ, one_mul, mul_one, set.inter_univ, set.univ_inter], }, },
+  simp_rw [h_P_inter, h_μg, finset.prod_mul_distrib,
+    finset.prod_ite_mem (p1 ∪ p2) p1 (λ x, μ (f1 x)),
+    finset.union_inter_cancel_left, finset.prod_ite_mem (p1 ∪ p2) p2 (λ x, μ (f2 x)),
+    finset.union_inter_cancel_right, ht1_eq, ← h_indep p1 ht1_m, ht2_eq, ← h_indep p2 ht2_m],
+end
+
+lemma Indep_set.indep_generate_from_of_disjoint [is_probability_measure μ] {s : ι → set Ω}
+  (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (S T : set ι) (hST : disjoint S T) :
+  indep (generate_from {t | ∃ n ∈ S, s n = t}) (generate_from {t | ∃ k ∈ T, s k = t}) μ :=
+begin
+  rw [← generate_from_pi_Union_Inter_singleton_left,
+    ← generate_from_pi_Union_Inter_singleton_left],
+  refine indep_sets.indep'
+    (λ t ht, generate_from_pi_Union_Inter_le _ _ _ _ (measurable_set_generate_from ht))
+    (λ t ht, generate_from_pi_Union_Inter_le _ _ _ _ (measurable_set_generate_from ht))
+    _ _ _,
+  { exact λ k, generate_from_le $ λ t ht, (set.mem_singleton_iff.1 ht).symm ▸ hsm k, },
+  { exact λ k, generate_from_le $ λ t ht, (set.mem_singleton_iff.1 ht).symm ▸ hsm k, },
+  { exact is_pi_system_pi_Union_Inter _ (λ k, is_pi_system.singleton _) _, },
+  { exact is_pi_system_pi_Union_Inter _ (λ k, is_pi_system.singleton _) _, },
+  { classical,
+    exact indep_sets_pi_Union_Inter_of_disjoint (Indep.Indep_sets (λ n, rfl) hs) hST, },
+end
+
+lemma indep_supr_of_disjoint [is_probability_measure μ] {m : ι → measurable_space Ω}
+  (h_le : ∀ i, m i ≤ m0) (h_indep : Indep m μ) {S T : set ι} (hST : disjoint S T) :
+  indep (⨆ i ∈ S, m i) (⨆ i ∈ T, m i) μ :=
+begin
+  refine indep_sets.indep (supr₂_le (λ i _, h_le i)) (supr₂_le (λ i _, h_le i)) _ _
+    (generate_from_pi_Union_Inter_measurable_set m S).symm
+    (generate_from_pi_Union_Inter_measurable_set m T).symm _,
+  { exact is_pi_system_pi_Union_Inter _ (λ n, @is_pi_system_measurable_set Ω (m n)) _, },
+  { exact is_pi_system_pi_Union_Inter _ (λ n, @is_pi_system_measurable_set Ω (m n)) _ , },
+  { classical,
+    exact indep_sets_pi_Union_Inter_of_disjoint h_indep hST, },
+end
+
+lemma indep_supr_of_directed_le {Ω} {m : ι → measurable_space Ω}
+  {m' m0 : measurable_space Ω} {μ : measure Ω} [is_probability_measure μ]
+  (h_indep : ∀ i, indep (m i) m' μ) (h_le : ∀ i, m i ≤ m0) (h_le' : m' ≤ m0)
+  (hm : directed (≤) m) :
+  indep (⨆ i, m i) m' μ :=
+begin
+  let p : ι → set (set Ω) := λ n, {t | measurable_set[m n] t},
+  have hp : ∀ n, is_pi_system (p n) := λ n, @is_pi_system_measurable_set Ω (m n),
+  have h_gen_n : ∀ n, m n = generate_from (p n),
+    from λ n, (@generate_from_measurable_set Ω (m n)).symm,
+  have hp_supr_pi : is_pi_system (⋃ n, p n) := is_pi_system_Union_of_directed_le p hp hm,
+  let p' := {t : set Ω | measurable_set[m'] t},
+  have hp'_pi : is_pi_system p' := @is_pi_system_measurable_set Ω m',
+  have h_gen' : m' = generate_from p' := (@generate_from_measurable_set Ω m').symm,
+  -- the π-systems defined are independent
+  have h_pi_system_indep : indep_sets (⋃ n, p n) p' μ,
+  { refine indep_sets.Union _,
+    simp_rw [h_gen_n, h_gen'] at h_indep,
+    exact λ n, (h_indep n).indep_sets, },
+  -- now go from π-systems to σ-algebras
+  refine indep_sets.indep (supr_le h_le) h_le' hp_supr_pi hp'_pi _ h_gen' h_pi_system_indep,
+  exact (generate_from_Union_measurable_set _).symm,
+end
+
+lemma Indep_set.indep_generate_from_lt [preorder ι] [is_probability_measure μ]
+  {s : ι → set Ω} (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (i : ι) :
+  indep (generate_from {s i}) (generate_from {t | ∃ j < i, s j = t}) μ :=
+begin
+  convert hs.indep_generate_from_of_disjoint hsm {i} {j | j < i}
+    (set.disjoint_singleton_left.mpr (lt_irrefl _)),
+  simp only [set.mem_singleton_iff, exists_prop, exists_eq_left, set.set_of_eq_eq_singleton'],
+end
+
+lemma Indep_set.indep_generate_from_le [linear_order ι] [is_probability_measure μ]
+  {s : ι → set Ω} (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ)
+  (i : ι) {k : ι} (hk : i < k) :
+  indep (generate_from {s k}) (generate_from {t | ∃ j ≤ i, s j = t}) μ :=
+begin
+  convert hs.indep_generate_from_of_disjoint hsm {k} {j | j ≤ i}
+    (set.disjoint_singleton_left.mpr hk.not_le),
+  simp only [set.mem_singleton_iff, exists_prop, exists_eq_left, set.set_of_eq_eq_singleton'],
+end
+
+lemma Indep_set.indep_generate_from_le_nat [is_probability_measure μ]
+  {s : ℕ → set Ω} (hsm : ∀ n, measurable_set (s n)) (hs : Indep_set s μ) (n : ℕ):
+  indep (generate_from {s (n + 1)}) (generate_from {t | ∃ k ≤ n, s k = t}) μ :=
+hs.indep_generate_from_le hsm _ n.lt_succ_self
+
+lemma indep_supr_of_monotone [semilattice_sup ι] {Ω} {m : ι → measurable_space Ω}
+  {m' m0 : measurable_space Ω} {μ : measure Ω} [is_probability_measure μ]
+  (h_indep : ∀ i, indep (m i) m' μ) (h_le : ∀ i, m i ≤ m0) (h_le' : m' ≤ m0) (hm : monotone m) :
+  indep (⨆ i, m i) m' μ :=
+indep_supr_of_directed_le h_indep h_le h_le' (monotone.directed_le hm)
+
+lemma indep_supr_of_antitone [semilattice_inf ι] {Ω} {m : ι → measurable_space Ω}
+  {m' m0 : measurable_space Ω} {μ : measure Ω} [is_probability_measure μ]
+  (h_indep : ∀ i, indep (m i) m' μ) (h_le : ∀ i, m i ≤ m0) (h_le' : m' ≤ m0) (hm : antitone m) :
+  indep (⨆ i, m i) m' μ :=
+indep_supr_of_directed_le h_indep h_le h_le' (directed_of_inf hm)
+
+lemma Indep_sets.pi_Union_Inter_of_not_mem {π : ι → set (set Ω)} {a : ι} {S : finset ι}
+  (hp_ind : Indep_sets π μ) (haS : a ∉ S) :
+  indep_sets (pi_Union_Inter π S) (π a) μ :=
+begin
+  rintros t1 t2 ⟨s, hs_mem, ft1, hft1_mem, ht1_eq⟩ ht2_mem_pia,
+  rw [finset.coe_subset] at hs_mem,
+  classical,
+  let f := λ n, ite (n = a) t2 (ite (n ∈ s) (ft1 n) set.univ),
+  have h_f_mem : ∀ n ∈ insert a s, f n ∈ π n,
+  { intros n hn_mem_insert,
+    simp_rw f,
+    cases (finset.mem_insert.mp hn_mem_insert) with hn_mem hn_mem,
+    { simp [hn_mem, ht2_mem_pia], },
+    { have hn_ne_a : n ≠ a, by { rintro rfl, exact haS (hs_mem hn_mem), },
+      simp [hn_ne_a, hn_mem, hft1_mem n hn_mem], }, },
+  have h_f_mem_pi : ∀ n ∈ s, f n ∈ π n, from λ x hxS, h_f_mem x (by simp [hxS]),
+  have h_t1 : t1 = ⋂ n ∈ s, f n,
+  { suffices h_forall : ∀ n ∈ s, f n = ft1 n,
+    { rw ht1_eq,
+      congr' with n x,
+      congr' with hns y,
+      simp only [(h_forall n hns).symm], },
+    intros n hnS,
+    have hn_ne_a : n ≠ a, by { rintro rfl, exact haS (hs_mem hnS), },
+    simp_rw [f, if_pos hnS, if_neg hn_ne_a], },
+  have h_μ_t1 : μ t1 = ∏ n in s, μ (f n), by rw [h_t1, ← hp_ind s h_f_mem_pi],
+  have h_t2 : t2 = f a, by { simp_rw [f], simp, },
+  have h_μ_inter : μ (t1 ∩ t2) = ∏ n in insert a s, μ (f n),
+  { have h_t1_inter_t2 : t1 ∩ t2 = ⋂ n ∈ insert a s, f n,
+      by rw [h_t1, h_t2, finset.set_bInter_insert, set.inter_comm],
+    rw [h_t1_inter_t2, ← hp_ind (insert a s) h_f_mem], },
+  have has : a ∉ s := λ has_mem, haS (hs_mem has_mem),
+  rw [h_μ_inter, finset.prod_insert has, h_t2, mul_comm, h_μ_t1],
+end
+
+/-- The measurable space structures generated by independent pi-systems are independent. -/
+theorem Indep_sets.Indep [is_probability_measure μ] (m : ι → measurable_space Ω)
+  (h_le : ∀ i, m i ≤ m0) (π : ι → set (set Ω)) (h_pi : ∀ n, is_pi_system (π n))
+  (h_generate : ∀ i, m i = generate_from (π i)) (h_ind : Indep_sets π μ) :
+  Indep m μ :=
+begin
+  classical,
+  refine finset.induction _ _,
+  { simp only [measure_univ, implies_true_iff, set.Inter_false, set.Inter_univ, finset.prod_empty,
+      eq_self_iff_true], },
+  intros a S ha_notin_S h_rec f hf_m,
+  have hf_m_S : ∀ x ∈ S, measurable_set[m x] (f x) := λ x hx, hf_m x (by simp [hx]),
+  rw [finset.set_bInter_insert, finset.prod_insert ha_notin_S, ← h_rec hf_m_S],
+  let p := pi_Union_Inter π S,
+  set m_p := generate_from p with hS_eq_generate,
+  have h_indep : indep m_p (m a) μ,
+  { have hp : is_pi_system p := is_pi_system_pi_Union_Inter π h_pi S,
+    have h_le' : ∀ i, generate_from (π i) ≤ m0 := λ i, (h_generate i).symm.trans_le (h_le i),
+    have hm_p : m_p ≤ m0 := generate_from_pi_Union_Inter_le π h_le' S,
+    exact indep_sets.indep hm_p (h_le a) hp (h_pi a) hS_eq_generate (h_generate a)
+      (h_ind.pi_Union_Inter_of_not_mem ha_notin_S), },
+  refine h_indep.symm (f a) (⋂ n ∈ S, f n) (hf_m a (finset.mem_insert_self a S)) _,
+  have h_le_p : ∀ i ∈ S, m i ≤ m_p,
+  { intros n hn,
+    rw [hS_eq_generate, h_generate n],
+    exact le_generate_from_pi_Union_Inter S hn, },
+  have h_S_f : ∀ i ∈ S, measurable_set[m_p] (f i) := λ i hi, (h_le_p i hi) (f i) (hf_m_S i hi),
+  exact S.measurable_set_bInter h_S_f,
+end
+
+end from_pi_systems_to_measurable_spaces
+
+section indep_set
+/-! ### Independence of measurable sets
+
+We prove the following equivalences on `indep_set`, for measurable sets `s, t`.
+* `indep_set s t μ ↔ μ (s ∩ t) = μ s * μ t`,
+* `indep_set s t μ ↔ indep_sets {s} {t} μ`.
+-/
+
+variables {s t : set Ω} (S T : set (set Ω)) {π : ι → set (set Ω)} {f : ι → set Ω}
+  {m0 : measurable_space Ω} {μ : measure Ω}
+
+lemma indep_set_iff_indep_sets_singleton {m0 : measurable_space Ω}
+  (hs_meas : measurable_set s) (ht_meas : measurable_set t)
+  (μ : measure Ω . volume_tac) [is_probability_measure μ] :
+  indep_set s t μ ↔ indep_sets {s} {t} μ :=
+⟨indep.indep_sets, λ h, indep_sets.indep
+  (generate_from_le (λ u hu, by rwa set.mem_singleton_iff.mp hu))
+  (generate_from_le (λ u hu, by rwa set.mem_singleton_iff.mp hu)) (is_pi_system.singleton s)
+  (is_pi_system.singleton t) rfl rfl h⟩
+
+lemma indep_set_iff_measure_inter_eq_mul {m0 : measurable_space Ω}
+  (hs_meas : measurable_set s) (ht_meas : measurable_set t)
+  (μ : measure Ω . volume_tac) [is_probability_measure μ] :
+  indep_set s t μ ↔ μ (s ∩ t) = μ s * μ t :=
+(indep_set_iff_indep_sets_singleton hs_meas ht_meas μ).trans indep_sets_singleton_iff
+
+lemma indep_sets.indep_set_of_mem {m0 : measurable_space Ω} (hs : s ∈ S) (ht : t ∈ T)
+  (hs_meas : measurable_set s) (ht_meas : measurable_set t) (μ : measure Ω . volume_tac)
+  [is_probability_measure μ] (h_indep : indep_sets S T μ) :
+  indep_set s t μ :=
+(indep_set_iff_measure_inter_eq_mul hs_meas ht_meas μ).mpr (h_indep s t hs ht)
+
+lemma indep.indep_set_of_measurable_set {m₁ m₂ m0 : measurable_space Ω} {μ : measure Ω}
+  (h_indep : indep m₁ m₂ μ) {s t : set Ω} (hs : measurable_set[m₁] s) (ht : measurable_set[m₂] t) :
+  indep_set s t μ :=
+begin
+  refine λ s' t' hs' ht', h_indep s' t' _ _,
+  { refine generate_from_induction (λ u, measurable_set[m₁] u) {s} _ _ _ _ hs',
+    { simp only [hs, set.mem_singleton_iff, set.mem_set_of_eq, forall_eq], },
+    { exact @measurable_set.empty _ m₁, },
+    { exact λ u hu, hu.compl, },
+    { exact λ f hf, measurable_set.Union hf, }, },
+  { refine generate_from_induction (λ u, measurable_set[m₂] u) {t} _ _ _ _ ht',
+    { simp only [ht, set.mem_singleton_iff, set.mem_set_of_eq, forall_eq], },
+    { exact @measurable_set.empty _ m₂, },
+    { exact λ u hu, hu.compl, },
+    { exact λ f hf, measurable_set.Union hf, },},
+end
+
+lemma indep_iff_forall_indep_set (m₁ m₂ : measurable_space Ω) {m0 : measurable_space Ω}
+  (μ : measure Ω) :
+  indep m₁ m₂ μ ↔ ∀ s t, measurable_set[m₁] s → measurable_set[m₂] t → indep_set s t μ :=
+⟨λ h, λ s t hs ht, h.indep_set_of_measurable_set hs ht,
+  λ h s t hs ht, h s t hs ht s t (measurable_set_generate_from (set.mem_singleton s))
+    (measurable_set_generate_from (set.mem_singleton t))⟩
+
+lemma Indep_sets.meas_Inter [fintype ι] (h : Indep_sets π μ) (hf : ∀ i, f i ∈ π i) :
+  μ (⋂ i, f i) = ∏ i, μ (f i) :=
+by simp [← h _ (λ i _, hf _)]
+
+lemma Indep_comap_mem_iff : Indep (λ i, measurable_space.comap (∈ f i) ⊤) μ ↔ Indep_set f μ :=
+by { simp_rw ←generate_from_singleton, refl }
+
+alias Indep_comap_mem_iff ↔ _ Indep_set.Indep_comap_mem
+
+lemma Indep_sets_singleton_iff :
+  Indep_sets (λ i, {f i}) μ ↔ ∀ t, μ (⋂ i ∈ t, f i) = ∏ i in t, μ (f i) :=
+forall_congr $ λ t,
+  ⟨λ h, h $ λ _ _, mem_singleton _,
+  λ h f hf, begin
+    refine eq.trans _ (h.trans $ finset.prod_congr rfl $ λ i hi, congr_arg _ $ (hf i hi).symm),
+    rw Inter₂_congr hf,
+  end⟩
+
+variables [is_probability_measure μ]
+
+lemma Indep_set_iff_Indep_sets_singleton (hf : ∀ i, measurable_set (f i)) :
+  Indep_set f μ ↔ Indep_sets (λ i, {f i}) μ :=
+⟨Indep.Indep_sets $ λ _, rfl, Indep_sets.Indep _
+  (λ i, generate_from_le $ by { rintro t (rfl : t = _), exact hf _}) _
+    (λ _, is_pi_system.singleton _) $ λ _, rfl⟩
+
+lemma Indep_set_iff_measure_Inter_eq_prod (hf : ∀ i, measurable_set (f i)) :
+  Indep_set f μ ↔ ∀ s, μ (⋂ i ∈ s, f i) = ∏ i in s, μ (f i) :=
+(Indep_set_iff_Indep_sets_singleton hf).trans Indep_sets_singleton_iff
+
+lemma Indep_sets.Indep_set_of_mem (hfπ : ∀ i, f i ∈ π i) (hf : ∀ i, measurable_set (f i))
+  (hπ : Indep_sets π μ) : Indep_set f μ :=
+(Indep_set_iff_measure_Inter_eq_prod hf).2 $ λ t, hπ _ $ λ i _, hfπ _
+
+end indep_set
+
+section indep_fun
+
+/-! ### Independence of random variables
+
+-/
+
+variables {β β' γ γ' : Type*} {mΩ : measurable_space Ω} {μ : measure Ω} {f : Ω → β} {g : Ω → β'}
+
+lemma indep_fun_iff_measure_inter_preimage_eq_mul
+  {mβ : measurable_space β} {mβ' : measurable_space β'} :
+  indep_fun f g μ
+    ↔ ∀ s t, measurable_set s → measurable_set t
+      → μ (f ⁻¹' s ∩ g ⁻¹' t) = μ (f ⁻¹' s) * μ (g ⁻¹' t) :=
+begin
+  split; intro h,
+  { refine λ s t hs ht, h (f ⁻¹' s) (g ⁻¹' t) ⟨s, hs, rfl⟩ ⟨t, ht, rfl⟩, },
+  { rintros _ _ ⟨s, hs, rfl⟩ ⟨t, ht, rfl⟩, exact h s t hs ht, },
+end
+
+lemma Indep_fun_iff_measure_inter_preimage_eq_mul {ι : Type*} {β : ι → Type*}
+  (m : Π x, measurable_space (β x)) (f : Π i, Ω → β i) :
+  Indep_fun m f μ
+    ↔ ∀ (S : finset ι) {sets : Π i : ι, set (β i)} (H : ∀ i, i ∈ S → measurable_set[m i] (sets i)),
+      μ (⋂ i ∈ S, (f i) ⁻¹' (sets i)) = ∏ i in S, μ ((f i) ⁻¹' (sets i)) :=
+begin
+  refine ⟨λ h S sets h_meas, h _ (λ i hi_mem, ⟨sets i, h_meas i hi_mem, rfl⟩), _⟩,
+  intros h S setsΩ h_meas,
+  classical,
+  let setsβ : (Π i : ι, set (β i)) := λ i,
+    dite (i ∈ S) (λ hi_mem, (h_meas i hi_mem).some) (λ _, set.univ),
+  have h_measβ : ∀ i ∈ S, measurable_set[m i] (setsβ i),
+  { intros i hi_mem,
+    simp_rw [setsβ, dif_pos hi_mem],
+    exact (h_meas i hi_mem).some_spec.1, },
+  have h_preim : ∀ i ∈ S, setsΩ i = (f i) ⁻¹' (setsβ i),
+  { intros i hi_mem,
+    simp_rw [setsβ, dif_pos hi_mem],
+    exact (h_meas i hi_mem).some_spec.2.symm, },
+  have h_left_eq : μ (⋂ i ∈ S, setsΩ i) = μ (⋂ i ∈ S, (f i) ⁻¹' (setsβ i)),
+  { congr' with i x,
+    simp only [set.mem_Inter],
+    split; intros h hi_mem; specialize h hi_mem,
+    { rwa h_preim i hi_mem at h, },
+    { rwa h_preim i hi_mem, }, },
+  have h_right_eq : (∏ i in S, μ (setsΩ i)) = ∏ i in S, μ ((f i) ⁻¹' (setsβ i)),
+  { refine finset.prod_congr rfl (λ i hi_mem, _),
+    rw h_preim i hi_mem, },
+  rw [h_left_eq, h_right_eq],
+  exact h S h_measβ,
+end
+
+lemma indep_fun_iff_indep_set_preimage {mβ : measurable_space β} {mβ' : measurable_space β'}
+  [is_probability_measure μ] (hf : measurable f) (hg : measurable g) :
+  indep_fun f g μ ↔ ∀ s t, measurable_set s → measurable_set t → indep_set (f ⁻¹' s) (g ⁻¹' t) μ :=
+begin
+  refine indep_fun_iff_measure_inter_preimage_eq_mul.trans _,
+  split; intros h s t hs ht; specialize h s t hs ht,
+  { rwa indep_set_iff_measure_inter_eq_mul (hf hs) (hg ht) μ, },
+  { rwa ← indep_set_iff_measure_inter_eq_mul (hf hs) (hg ht) μ, },
+end
+
+@[symm] lemma indep_fun.symm {mβ : measurable_space β} {f g : Ω → β} (hfg : indep_fun f g μ) :
+  indep_fun g f μ :=
+hfg.symm
+
+lemma indep_fun.ae_eq {mβ : measurable_space β} {f g f' g' : Ω → β}
+  (hfg : indep_fun f g μ) (hf : f =ᵐ[μ] f') (hg : g =ᵐ[μ] g') :
+  indep_fun f' g' μ :=
+begin
+  rintro _ _ ⟨A, hA, rfl⟩ ⟨B, hB, rfl⟩,
+  have h1 : f ⁻¹' A =ᵐ[μ] f' ⁻¹' A := hf.fun_comp A,
+  have h2 : g ⁻¹' B =ᵐ[μ] g' ⁻¹' B := hg.fun_comp B,
+  rw [← measure_congr h1, ← measure_congr h2, ← measure_congr (h1.inter h2)],
+  exact hfg _ _ ⟨_, hA, rfl⟩ ⟨_, hB, rfl⟩
+end
+
+lemma indep_fun.comp {mβ : measurable_space β} {mβ' : measurable_space β'}
+  {mγ : measurable_space γ} {mγ' : measurable_space γ'} {φ : β → γ} {ψ : β' → γ'}
+  (hfg : indep_fun f g μ) (hφ : measurable φ) (hψ : measurable ψ) :
+  indep_fun (φ ∘ f) (ψ ∘ g) μ :=
+begin
+  rintro _ _ ⟨A, hA, rfl⟩ ⟨B, hB, rfl⟩,
+  apply hfg,
+  { exact ⟨φ ⁻¹' A, hφ hA, set.preimage_comp.symm⟩ },
+  { exact ⟨ψ ⁻¹' B, hψ hB, set.preimage_comp.symm⟩ }
+end
+
+/-- If `f` is a family of mutually independent random variables (`Indep_fun m f μ`) and `S, T` are
+two disjoint finite index sets, then the tuple formed by `f i` for `i ∈ S` is independent of the
+tuple `(f i)_i` for `i ∈ T`. -/
+lemma Indep_fun.indep_fun_finset [is_probability_measure μ]
+  {ι : Type*} {β : ι → Type*} {m : Π i, measurable_space (β i)}
+  {f : Π i, Ω → β i} (S T : finset ι) (hST : disjoint S T) (hf_Indep : Indep_fun m f μ)
+  (hf_meas : ∀ i, measurable (f i)) :
+  indep_fun (λ a (i : S), f i a) (λ a (i : T), f i a) μ :=
+begin
+  -- We introduce π-systems, build from the π-system of boxes which generates `measurable_space.pi`.
+  let πSβ := (set.pi (set.univ : set S) ''
+    (set.pi (set.univ : set S) (λ i, {s : set (β i) | measurable_set[m i] s}))),
+  let πS := {s : set Ω | ∃ t ∈ πSβ, (λ a (i : S), f i a) ⁻¹' t = s},
+  have hπS_pi : is_pi_system πS := is_pi_system_pi.comap (λ a i, f i a),
+  have hπS_gen : measurable_space.pi.comap (λ a (i : S), f i a) = generate_from πS,
+  { rw [generate_from_pi.symm, comap_generate_from],
+    { congr' with s,
+      simp only [set.mem_image, set.mem_set_of_eq, exists_prop], },
+    { apply_instance } },
+  let πTβ := (set.pi (set.univ : set T) ''
+    (set.pi (set.univ : set T) (λ i, {s : set (β i) | measurable_set[m i] s}))),
+  let πT := {s : set Ω | ∃ t ∈ πTβ, (λ a (i : T), f i a) ⁻¹' t = s},
+  have hπT_pi : is_pi_system πT := is_pi_system_pi.comap (λ a i, f i a),
+  have hπT_gen : measurable_space.pi.comap (λ a (i : T), f i a) = generate_from πT,
+  { rw [generate_from_pi.symm, comap_generate_from],
+    { congr' with s,
+      simp only [set.mem_image, set.mem_set_of_eq, exists_prop], },
+    { apply_instance } },
+
+  -- To prove independence, we prove independence of the generating π-systems.
+  refine indep_sets.indep (measurable.comap_le (measurable_pi_iff.mpr (λ i, hf_meas i)))
+    (measurable.comap_le (measurable_pi_iff.mpr (λ i, hf_meas i))) hπS_pi hπT_pi hπS_gen hπT_gen _,
+
+  rintros _ _ ⟨s, ⟨sets_s, hs1, hs2⟩, rfl⟩ ⟨t, ⟨sets_t, ht1, ht2⟩, rfl⟩,
+  simp only [set.mem_univ_pi, set.mem_set_of_eq] at hs1 ht1,
+  rw [← hs2, ← ht2],
+  classical,
+  let sets_s' : (Π i : ι, set (β i)) := λ i, dite (i ∈ S) (λ hi, sets_s ⟨i, hi⟩) (λ _, set.univ),
+  have h_sets_s'_eq : ∀ {i} (hi : i ∈ S), sets_s' i = sets_s ⟨i, hi⟩,
+  { intros i hi, simp_rw [sets_s', dif_pos hi], },
+  have h_sets_s'_univ : ∀ {i} (hi : i ∈ T), sets_s' i = set.univ,
+  { intros i hi, simp_rw [sets_s', dif_neg (finset.disjoint_right.mp hST hi)], },
+  let sets_t' : (Π i : ι, set (β i)) := λ i, dite (i ∈ T) (λ hi, sets_t ⟨i, hi⟩) (λ _, set.univ),
+  have h_sets_t'_univ : ∀ {i} (hi : i ∈ S), sets_t' i = set.univ,
+  { intros i hi, simp_rw [sets_t', dif_neg (finset.disjoint_left.mp hST hi)], },
+  have h_meas_s' : ∀ i ∈ S, measurable_set (sets_s' i),
+  { intros i hi, rw h_sets_s'_eq hi, exact hs1 _, },
+  have h_meas_t' : ∀ i ∈ T, measurable_set (sets_t' i),
+  { intros i hi, simp_rw [sets_t', dif_pos hi], exact ht1 _, },
+  have h_eq_inter_S : (λ (ω : Ω) (i : ↥S), f ↑i ω) ⁻¹' set.pi set.univ sets_s
+    = ⋂ i ∈ S, (f i) ⁻¹' (sets_s' i),
+  { ext1 x,
+    simp only [set.mem_preimage, set.mem_univ_pi, set.mem_Inter],
+    split; intro h,
+    { intros i hi, rw [h_sets_s'_eq hi], exact h ⟨i, hi⟩, },
+    { rintros ⟨i, hi⟩, specialize h i hi, rw [h_sets_s'_eq hi] at h, exact h, }, },
+  have h_eq_inter_T : (λ (ω : Ω) (i : ↥T), f ↑i ω) ⁻¹' set.pi set.univ sets_t
+    = ⋂ i ∈ T, (f i) ⁻¹' (sets_t' i),
+  { ext1 x,
+    simp only [set.mem_preimage, set.mem_univ_pi, set.mem_Inter],
+    split; intro h,
+    { intros i hi, simp_rw [sets_t', dif_pos hi], exact h ⟨i, hi⟩, },
+    { rintros ⟨i, hi⟩, specialize h i hi, simp_rw [sets_t', dif_pos hi] at h, exact h, }, },
+  rw Indep_fun_iff_measure_inter_preimage_eq_mul at hf_Indep,
+  rw [h_eq_inter_S, h_eq_inter_T, hf_Indep S h_meas_s', hf_Indep T h_meas_t'],
+  have h_Inter_inter : (⋂ i ∈ S, (f i) ⁻¹' (sets_s' i)) ∩ (⋂ i ∈ T, (f i) ⁻¹' (sets_t' i))
+    = ⋂ i ∈ (S ∪ T), (f i) ⁻¹' (sets_s' i ∩ sets_t' i),
+  { ext1 x,
+    simp only [set.mem_inter_iff, set.mem_Inter, set.mem_preimage, finset.mem_union],
+    split; intro h,
+    { intros i hi,
+      cases hi,
+      { rw h_sets_t'_univ hi, exact ⟨h.1 i hi, set.mem_univ _⟩, },
+      { rw h_sets_s'_univ hi, exact ⟨set.mem_univ _, h.2 i hi⟩, }, },
+    { exact ⟨λ i hi, (h i (or.inl hi)).1, λ i hi, (h i (or.inr hi)).2⟩, }, },
+  rw [h_Inter_inter, hf_Indep (S ∪ T)],
+  swap, { intros i hi_mem,
+    rw finset.mem_union at hi_mem,
+    cases hi_mem,
+    { rw [h_sets_t'_univ hi_mem, set.inter_univ], exact h_meas_s' i hi_mem, },
+    { rw [h_sets_s'_univ hi_mem, set.univ_inter], exact h_meas_t' i hi_mem, }, },
+  rw finset.prod_union hST,
+  congr' 1,
+  { refine finset.prod_congr rfl (λ i hi, _),
+    rw [h_sets_t'_univ hi, set.inter_univ], },
+  { refine finset.prod_congr rfl (λ i hi, _),
+    rw [h_sets_s'_univ hi, set.univ_inter], },
+end
+
+lemma Indep_fun.indep_fun_prod [is_probability_measure μ]
+  {ι : Type*} {β : ι → Type*} {m : Π i, measurable_space (β i)}
+  {f : Π i, Ω → β i} (hf_Indep : Indep_fun m f μ) (hf_meas : ∀ i, measurable (f i))
+  (i j k : ι) (hik : i ≠ k) (hjk : j ≠ k) :
+  indep_fun (λ a, (f i a, f j a)) (f k) μ :=
+begin
+  classical,
+  have h_right : f k = (λ p : (Π j : ({k} : finset ι), β j), p ⟨k, finset.mem_singleton_self k⟩)
+    ∘ (λ a (j : ({k} : finset ι)), f j a) := rfl,
+  have h_meas_right : measurable
+      (λ p : (Π j : ({k} : finset ι), β j), p ⟨k, finset.mem_singleton_self k⟩),
+    from measurable_pi_apply ⟨k, finset.mem_singleton_self k⟩,
+  let s : finset ι := {i, j},
+  have h_left : (λ ω, (f i ω, f j ω))
+    = (λ p : (Π l : s, β l), (p ⟨i, finset.mem_insert_self i _⟩,
+        p ⟨j, finset.mem_insert_of_mem (finset.mem_singleton_self _)⟩))
+      ∘ (λ a (j : s), f j a),
+  { ext1 a,
+    simp only [prod.mk.inj_iff],
+    split; refl, },
+  have h_meas_left : measurable (λ p : (Π l : s, β l), (p ⟨i, finset.mem_insert_self i _⟩,
+      p ⟨j, finset.mem_insert_of_mem (finset.mem_singleton_self _)⟩)),
+    from measurable.prod (measurable_pi_apply ⟨i, finset.mem_insert_self i {j}⟩)
+      (measurable_pi_apply ⟨j, finset.mem_insert_of_mem (finset.mem_singleton_self j)⟩),
+  rw [h_left, h_right],
+  refine (hf_Indep.indep_fun_finset s {k} _ hf_meas).comp h_meas_left h_meas_right,
+  rw finset.disjoint_singleton_right,
+  simp only [finset.mem_insert, finset.mem_singleton, not_or_distrib],
+  exact ⟨hik.symm, hjk.symm⟩,
+end
+
+@[to_additive]
+lemma Indep_fun.mul [is_probability_measure μ]
+  {ι : Type*} {β : Type*} {m : measurable_space β} [has_mul β] [has_measurable_mul₂ β]
+  {f : ι → Ω → β} (hf_Indep : Indep_fun (λ _, m) f μ) (hf_meas : ∀ i, measurable (f i))
+  (i j k : ι) (hik : i ≠ k) (hjk : j ≠ k) :
+  indep_fun (f i * f j) (f k) μ :=
+begin
+  have : indep_fun (λ ω, (f i ω, f j ω)) (f k) μ := hf_Indep.indep_fun_prod hf_meas i j k hik hjk,
+  change indep_fun ((λ p : β × β, p.fst * p.snd) ∘ (λ ω, (f i ω, f j ω))) (id ∘ (f k)) μ,
+  exact indep_fun.comp this (measurable_fst.mul measurable_snd) measurable_id,
+end
+
+@[to_additive]
+lemma Indep_fun.indep_fun_finset_prod_of_not_mem [is_probability_measure μ]
+  {ι : Type*} {β : Type*} {m : measurable_space β} [comm_monoid β] [has_measurable_mul₂ β]
+  {f : ι → Ω → β} (hf_Indep : Indep_fun (λ _, m) f μ) (hf_meas : ∀ i, measurable (f i))
+  {s : finset ι} {i : ι} (hi : i ∉ s) :
+  indep_fun (∏ j in s, f j) (f i) μ :=
+begin
+  classical,
+  have h_right : f i = (λ p : (Π j : ({i} : finset ι), β), p ⟨i, finset.mem_singleton_self i⟩)
+    ∘ (λ a (j : ({i} : finset ι)), f j a) := rfl,
+  have h_meas_right : measurable
+      (λ p : (Π j : ({i} : finset ι), β), p ⟨i, finset.mem_singleton_self i⟩),
+    from measurable_pi_apply ⟨i, finset.mem_singleton_self i⟩,
+  have h_left : (∏ j in s, f j) = (λ p : (Π j : s, β), ∏ j, p j) ∘ (λ a (j : s), f j a),
+  { ext1 a,
+    simp only [function.comp_app],
+    have : (∏ (j : ↥s), f ↑j a) = (∏ (j : ↥s), f ↑j) a, by rw finset.prod_apply,
+    rw [this, finset.prod_coe_sort], },
+  have h_meas_left : measurable (λ p : (Π j : s, β), ∏ j, p j),
+    from finset.univ.measurable_prod (λ (j : ↥s) (H : j ∈ finset.univ), measurable_pi_apply j),
+  rw [h_left, h_right],
+  exact (hf_Indep.indep_fun_finset s {i} (finset.disjoint_singleton_left.mpr hi).symm hf_meas).comp
+    h_meas_left h_meas_right,
+end
+
+@[to_additive]
+lemma Indep_fun.indep_fun_prod_range_succ [is_probability_measure μ]
+  {β : Type*} {m : measurable_space β} [comm_monoid β] [has_measurable_mul₂ β]
+  {f : ℕ → Ω → β} (hf_Indep : Indep_fun (λ _, m) f μ) (hf_meas : ∀ i, measurable (f i))
+  (n : ℕ) :
+  indep_fun (∏ j in finset.range n, f j) (f n) μ :=
+hf_Indep.indep_fun_finset_prod_of_not_mem hf_meas finset.not_mem_range_self
+
+lemma Indep_set.Indep_fun_indicator [has_zero β] [has_one β] {m : measurable_space β}
+  {s : ι → set Ω} (hs : Indep_set s μ) :
+  Indep_fun (λ n, m) (λ n, (s n).indicator (λ ω, 1)) μ :=
+begin
+  classical,
+  rw Indep_fun_iff_measure_inter_preimage_eq_mul,
+  rintro S π hπ,
+  simp_rw set.indicator_const_preimage_eq_union,
+  refine @hs S (λ i, ite (1 ∈ π i) (s i) ∅ ∪ ite ((0 : β) ∈ π i) (s i)ᶜ ∅) (λ i hi, _),
+  have hsi : measurable_set[generate_from {s i}] (s i),
+    from measurable_set_generate_from (set.mem_singleton _),
+  refine measurable_set.union (measurable_set.ite' (λ _, hsi) (λ _, _))
+    (measurable_set.ite' (λ _, hsi.compl) (λ _, _)),
+  { exact @measurable_set.empty _ (generate_from {s i}), },
+  { exact @measurable_set.empty _ (generate_from {s i}), },
+end
+
+end indep_fun
+
+end probability_theory
diff --git a/src/probability/independence/zero_one.lean b/src/probability/independence/zero_one.lean
new file mode 100644
index 0000000000000..10fe4002eda6d
--- /dev/null
+++ b/src/probability/independence/zero_one.lean
@@ -0,0 +1,187 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.independence.basic
+
+/-!
+# Kolmogorov's 0-1 law
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `s : ι → measurable_space Ω` be an independent sequence of sub-σ-algebras. Then any set which
+is measurable with respect to the tail σ-algebra `limsup s at_top` has probability 0 or 1.
+
+## Main statements
+
+* `measure_zero_or_one_of_measurable_set_limsup_at_top`: Kolmogorov's 0-1 law. Any set which is
+  measurable with respect to the tail σ-algebra `limsup s at_top` of an independent sequence of
+  σ-algebras `s` has probability 0 or 1.
+-/
+
+open measure_theory measurable_space
+open_locale measure_theory ennreal
+
+namespace probability_theory
+
+variables {Ω ι : Type*} {m m0 : measurable_space Ω} {μ : measure Ω}
+
+lemma measure_eq_zero_or_one_or_top_of_indep_set_self {t : set Ω} (h_indep : indep_set t t μ) :
+  μ t = 0 ∨ μ t = 1 ∨ μ t = ∞ :=
+begin
+  specialize h_indep t t (measurable_set_generate_from (set.mem_singleton t))
+    (measurable_set_generate_from (set.mem_singleton t)),
+  by_cases h0 : μ t = 0,
+  { exact or.inl h0, },
+  by_cases h_top : μ t = ∞,
+  { exact or.inr (or.inr h_top), },
+  rw [← one_mul (μ (t ∩ t)), set.inter_self, ennreal.mul_eq_mul_right h0 h_top] at h_indep,
+  exact or.inr (or.inl h_indep.symm),
+end
+
+lemma measure_eq_zero_or_one_of_indep_set_self [is_finite_measure μ] {t : set Ω}
+  (h_indep : indep_set t t μ) :
+  μ t = 0 ∨ μ t = 1 :=
+begin
+  have h_0_1_top := measure_eq_zero_or_one_or_top_of_indep_set_self h_indep,
+  simpa [measure_ne_top μ] using h_0_1_top,
+end
+
+variables [is_probability_measure μ] {s : ι → measurable_space Ω}
+
+open filter
+
+lemma indep_bsupr_compl (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ) (t : set ι) :
+  indep (⨆ n ∈ t, s n) (⨆ n ∈ tᶜ, s n) μ :=
+indep_supr_of_disjoint h_le h_indep disjoint_compl_right
+
+section abstract
+variables {α : Type*} {p : set ι → Prop} {f : filter ι} {ns : α → set ι}
+
+/-! We prove a version of Kolmogorov's 0-1 law for the σ-algebra `limsup s f` where `f` is a filter
+for which we can define the following two functions:
+* `p : set ι → Prop` such that for a set `t`, `p t → tᶜ ∈ f`,
+* `ns : α → set ι` a directed sequence of sets which all verify `p` and such that
+  `⋃ a, ns a = set.univ`.
+
+For the example of `f = at_top`, we can take `p = bdd_above` and `ns : ι → set ι := λ i, set.Iic i`.
+-/
+
+lemma indep_bsupr_limsup (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ)
+  (hf : ∀ t, p t → tᶜ ∈ f) {t : set ι} (ht : p t) :
+  indep (⨆ n ∈ t, s n) (limsup s f) μ :=
+begin
+  refine indep_of_indep_of_le_right (indep_bsupr_compl h_le h_indep t) _,
+  refine Limsup_le_of_le (by is_bounded_default) _,
+  simp only [set.mem_compl_iff, eventually_map],
+  exact eventually_of_mem (hf t ht) le_supr₂,
+end
+
+lemma indep_supr_directed_limsup (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ)
+  (hf : ∀ t, p t → tᶜ ∈ f) (hns : directed (≤) ns) (hnsp : ∀ a, p (ns a)) :
+  indep (⨆ a, ⨆ n ∈ (ns a), s n) (limsup s f) μ :=
+begin
+  refine indep_supr_of_directed_le _ _ _ _,
+  { exact λ a, indep_bsupr_limsup h_le h_indep hf (hnsp a), },
+  { exact λ a, supr₂_le (λ n hn, h_le n), },
+  { exact limsup_le_supr.trans (supr_le h_le), },
+  { intros a b,
+    obtain ⟨c, hc⟩ := hns a b,
+    refine ⟨c, _, _⟩; refine supr_mono (λ n, supr_mono' (λ hn, ⟨_, le_rfl⟩)),
+    { exact hc.1 hn, },
+    { exact hc.2 hn, }, },
+end
+
+lemma indep_supr_limsup (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ) (hf : ∀ t, p t → tᶜ ∈ f)
+  (hns : directed (≤) ns) (hnsp : ∀ a, p (ns a)) (hns_univ : ∀ n, ∃ a, n ∈ ns a) :
+  indep (⨆ n, s n) (limsup s f) μ :=
+begin
+  suffices : (⨆ a, ⨆ n ∈ (ns a), s n) = ⨆ n, s n,
+  { rw ← this,
+    exact indep_supr_directed_limsup h_le h_indep hf hns hnsp, },
+  rw supr_comm,
+  refine supr_congr (λ n, _),
+  have : (⨆ (i : α) (H : n ∈ ns i), s n) = (⨆ (h : ∃ i, n ∈ ns i), s n), by rw supr_exists,
+  haveI : nonempty (∃ (i : α), n ∈ ns i) := ⟨hns_univ n⟩,
+  rw [this, supr_const],
+end
+
+lemma indep_limsup_self (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ) (hf : ∀ t, p t → tᶜ ∈ f)
+  (hns : directed (≤) ns) (hnsp : ∀ a, p (ns a)) (hns_univ : ∀ n, ∃ a, n ∈ ns a) :
+  indep (limsup s f) (limsup s f) μ :=
+indep_of_indep_of_le_left (indep_supr_limsup h_le h_indep hf hns hnsp hns_univ) limsup_le_supr
+
+theorem measure_zero_or_one_of_measurable_set_limsup (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ)
+  (hf : ∀ t, p t → tᶜ ∈ f) (hns : directed (≤) ns) (hnsp : ∀ a, p (ns a))
+  (hns_univ : ∀ n, ∃ a, n ∈ ns a) {t : set Ω} (ht_tail : measurable_set[limsup s f] t) :
+  μ t = 0 ∨ μ t = 1 :=
+measure_eq_zero_or_one_of_indep_set_self
+  ((indep_limsup_self h_le h_indep hf hns hnsp hns_univ).indep_set_of_measurable_set
+    ht_tail ht_tail)
+
+end abstract
+
+section at_top
+variables [semilattice_sup ι] [no_max_order ι] [nonempty ι]
+
+lemma indep_limsup_at_top_self (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ) :
+  indep (limsup s at_top) (limsup s at_top) μ :=
+begin
+  let ns : ι → set ι := set.Iic,
+  have hnsp : ∀ i, bdd_above (ns i) := λ i, bdd_above_Iic,
+  refine indep_limsup_self h_le h_indep _ _ hnsp _,
+  { simp only [mem_at_top_sets, ge_iff_le, set.mem_compl_iff, bdd_above, upper_bounds,
+      set.nonempty],
+    rintros t ⟨a, ha⟩,
+    obtain ⟨b, hb⟩ : ∃ b, a < b := exists_gt a,
+    refine ⟨b, λ c hc hct, _⟩,
+    suffices : ∀ i ∈ t, i < c, from lt_irrefl c (this c hct),
+    exact λ i hi, (ha hi).trans_lt (hb.trans_le hc), },
+  { exact monotone.directed_le (λ i j hij k hki, le_trans hki hij), },
+  { exact λ n, ⟨n, le_rfl⟩, },
+end
+
+/-- **Kolmogorov's 0-1 law** : any event in the tail σ-algebra of an independent sequence of
+sub-σ-algebras has probability 0 or 1.
+The tail σ-algebra `limsup s at_top` is the same as `⋂ n, ⋃ i ≥ n, s i`. -/
+theorem measure_zero_or_one_of_measurable_set_limsup_at_top (h_le : ∀ n, s n ≤ m0)
+  (h_indep : Indep s μ) {t : set Ω} (ht_tail : measurable_set[limsup s at_top] t) :
+  μ t = 0 ∨ μ t = 1 :=
+measure_eq_zero_or_one_of_indep_set_self
+  ((indep_limsup_at_top_self h_le h_indep).indep_set_of_measurable_set ht_tail ht_tail)
+
+end at_top
+
+section at_bot
+variables [semilattice_inf ι] [no_min_order ι] [nonempty ι]
+
+lemma indep_limsup_at_bot_self (h_le : ∀ n, s n ≤ m0) (h_indep : Indep s μ) :
+  indep (limsup s at_bot) (limsup s at_bot) μ :=
+begin
+  let ns : ι → set ι := set.Ici,
+  have hnsp : ∀ i, bdd_below (ns i) := λ i, bdd_below_Ici,
+  refine indep_limsup_self h_le h_indep _ _ hnsp _,
+  { simp only [mem_at_bot_sets, ge_iff_le, set.mem_compl_iff, bdd_below, lower_bounds,
+      set.nonempty],
+    rintros t ⟨a, ha⟩,
+    obtain ⟨b, hb⟩ : ∃ b, b < a := exists_lt a,
+    refine ⟨b, λ c hc hct, _⟩,
+    suffices : ∀ i ∈ t, c < i, from lt_irrefl c (this c hct),
+    exact λ i hi, hc.trans_lt (hb.trans_le (ha hi)), },
+  { exact directed_of_inf (λ i j hij k hki, hij.trans hki), },
+  { exact λ n, ⟨n, le_rfl⟩, },
+end
+
+/-- **Kolmogorov's 0-1 law** : any event in the tail σ-algebra of an independent sequence of
+sub-σ-algebras has probability 0 or 1. -/
+theorem measure_zero_or_one_of_measurable_set_limsup_at_bot (h_le : ∀ n, s n ≤ m0)
+  (h_indep : Indep s μ) {t : set Ω} (ht_tail : measurable_set[limsup s at_bot] t) :
+  μ t = 0 ∨ μ t = 1 :=
+measure_eq_zero_or_one_of_indep_set_self
+  ((indep_limsup_at_bot_self h_le h_indep).indep_set_of_measurable_set ht_tail ht_tail)
+
+end at_bot
+
+end probability_theory
diff --git a/src/probability/integration.lean b/src/probability/integration.lean
index 25f55ffae3231..104779460cd3e 100644
--- a/src/probability/integration.lean
+++ b/src/probability/integration.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Martin Zinkevich, Vincent Beffara
 -/
 import measure_theory.integral.set_integral
-import probability.independence
+import probability.independence.basic
 
 /-!
 # Integration in Probability Theory
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Integration results for independent random variables. Specifically, for two
 independent random variables X and Y over the extended non-negative
 reals, `E[X * Y] = E[X] * E[Y]`, and similar results.
@@ -20,27 +23,27 @@ will always pick the later typeclass in this situation, and does not care whethe
 `[]`, `{}`, or `()`. All of these use the `measurable_space` `M2` to define `μ`:
 
 ```lean
-example {M1 : measurable_space α} [M2 : measurable_space α] {μ : measure α} : sorry := sorry
-example [M1 : measurable_space α] {M2 : measurable_space α} {μ : measure α} : sorry := sorry
+example {M1 : measurable_space Ω} [M2 : measurable_space Ω] {μ : measure Ω} : sorry := sorry
+example [M1 : measurable_space Ω] {M2 : measurable_space Ω} {μ : measure Ω} : sorry := sorry
 ```
 
 -/
 
 noncomputable theory
 open set measure_theory
-open_locale ennreal
+open_locale ennreal measure_theory
 
-variables {α : Type*} {mα : measurable_space α} {μ : measure α} {f g : α → ℝ≥0∞} {X Y : α → ℝ}
+variables {Ω : Type*} {mΩ : measurable_space Ω} {μ : measure Ω} {f g : Ω → ℝ≥0∞} {X Y : Ω → ℝ}
 
 namespace probability_theory
 
 /-- If a random variable `f` in `ℝ≥0∞` is independent of an event `T`, then if you restrict the
   random variable to `T`, then `E[f * indicator T c 0]=E[f] * E[indicator T c 0]`. It is useful for
   `lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space`. -/
-lemma lintegral_mul_indicator_eq_lintegral_mul_lintegral_indicator {Mf mα : measurable_space α}
-  {μ : measure α} (hMf : Mf ≤ mα) (c : ℝ≥0∞) {T : set α} (h_meas_T : measurable_set T)
-  (h_ind : indep_sets Mf.measurable_set' {T} μ) (h_meas_f : @measurable α ℝ≥0∞ Mf _ f) :
-  ∫⁻ a, f a * T.indicator (λ _, c) a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, T.indicator (λ _, c) a ∂μ :=
+lemma lintegral_mul_indicator_eq_lintegral_mul_lintegral_indicator {Mf mΩ : measurable_space Ω}
+  {μ : measure Ω} (hMf : Mf ≤ mΩ) (c : ℝ≥0∞) {T : set Ω} (h_meas_T : measurable_set T)
+  (h_ind : indep_sets {s | measurable_set[Mf] s} {T} μ) (h_meas_f : measurable[Mf] f) :
+  ∫⁻ ω, f ω * T.indicator (λ _, c) ω ∂μ = ∫⁻ ω, f ω ∂μ * ∫⁻ ω, T.indicator (λ _, c) ω ∂μ :=
 begin
   revert f,
   have h_mul_indicator : ∀ g, measurable g → measurable (λ a, g a * T.indicator (λ x, c) a),
@@ -59,15 +62,15 @@ begin
     have h_measM_f' : measurable f', from h_meas_f'.mono hMf le_rfl,
     have h_measM_g : measurable g, from h_meas_g.mono hMf le_rfl,
     simp_rw [pi.add_apply, right_distrib],
-    rw [lintegral_add (h_mul_indicator _ h_measM_f') (h_mul_indicator _ h_measM_g),
-      lintegral_add h_measM_f' h_measM_g, right_distrib, h_ind_f', h_ind_g] },
+    rw [lintegral_add_left (h_mul_indicator _ h_measM_f'),
+      lintegral_add_left h_measM_f', right_distrib, h_ind_f', h_ind_g] },
   { intros f h_meas_f h_mono_f h_ind_f,
     have h_measM_f : ∀ n, measurable (f n), from λ n, (h_meas_f n).mono hMf le_rfl,
     simp_rw [ennreal.supr_mul],
     rw [lintegral_supr h_measM_f h_mono_f, lintegral_supr, ennreal.supr_mul],
     { simp_rw [← h_ind_f] },
     { exact λ n, h_mul_indicator _ (h_measM_f n) },
-    { exact λ m n h_le a, ennreal.mul_le_mul (h_mono_f h_le a) le_rfl, }, },
+    { exact λ m n h_le a, mul_le_mul_right' (h_mono_f h_le a) _, }, },
 end
 
 /-- If `f` and `g` are independent random variables with values in `ℝ≥0∞`,
@@ -77,10 +80,10 @@ end
    independence. See `lintegral_mul_eq_lintegral_mul_lintegral_of_independent_fn` for
    a more common variant of the product of independent variables. -/
 lemma lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space
-  {Mf Mg mα : measurable_space α} {μ : measure α}
-  (hMf : Mf ≤ mα) (hMg : Mg ≤ mα) (h_ind : indep Mf Mg μ)
-  (h_meas_f : @measurable α ℝ≥0∞ Mf _ f) (h_meas_g : @measurable α ℝ≥0∞ Mg _ g) :
-  ∫⁻ a, f a * g a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, g a ∂μ :=
+  {Mf Mg mΩ : measurable_space Ω} {μ : measure Ω}
+  (hMf : Mf ≤ mΩ) (hMg : Mg ≤ mΩ) (h_ind : indep Mf Mg μ)
+  (h_meas_f : measurable[Mf] f) (h_meas_g : measurable[Mg] g) :
+  ∫⁻ ω, f ω * g ω ∂μ = ∫⁻ ω, f ω ∂μ * ∫⁻ ω, g ω ∂μ :=
 begin
   revert g,
   have h_measM_f : measurable f, from h_meas_f.mono hMf le_rfl,
@@ -93,8 +96,7 @@ begin
     have h_measM_f' : measurable f', from h_measMg_f'.mono hMg le_rfl,
     have h_measM_g : measurable g, from h_measMg_g.mono hMg le_rfl,
     simp_rw [pi.add_apply, left_distrib],
-    rw [lintegral_add h_measM_f' h_measM_g,
-      lintegral_add (h_measM_f.mul h_measM_f') (h_measM_f.mul h_measM_g),
+    rw [lintegral_add_left h_measM_f', lintegral_add_left (h_measM_f.mul h_measM_f'),
       left_distrib, h_ind_f', h_ind_g'] },
   { intros f' h_meas_f' h_mono_f' h_ind_f',
     have h_measM_f' : ∀ n, measurable (f' n), from λ n, (h_meas_f' n).mono hMg le_rfl,
@@ -102,14 +104,14 @@ begin
     rw [lintegral_supr, lintegral_supr h_measM_f' h_mono_f', ennreal.mul_supr],
     { simp_rw [← h_ind_f'], },
     { exact λ n, h_measM_f.mul (h_measM_f' n), },
-    { exact λ n m (h_le : n ≤ m) a, ennreal.mul_le_mul le_rfl (h_mono_f' h_le a), }, }
+    { exact λ n m (h_le : n ≤ m) a, mul_le_mul_left' (h_mono_f' h_le a) _, }, }
 end
 
 /-- If `f` and `g` are independent random variables with values in `ℝ≥0∞`,
    then `E[f * g] = E[f] * E[g]`. -/
 lemma lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun
   (h_meas_f : measurable f) (h_meas_g : measurable g) (h_indep_fun : indep_fun f g μ) :
-  ∫⁻ a, (f * g) a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, g a ∂μ :=
+  ∫⁻ ω, (f * g) ω ∂μ = ∫⁻ ω, f ω ∂μ * ∫⁻ ω, g ω ∂μ :=
 lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space
   (measurable_iff_comap_le.1 h_meas_f) (measurable_iff_comap_le.1 h_meas_g) h_indep_fun
   (measurable.of_comap_le le_rfl) (measurable.of_comap_le le_rfl)
@@ -119,7 +121,7 @@ lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space
    `lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun`). -/
 lemma lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun'
   (h_meas_f : ae_measurable f μ) (h_meas_g : ae_measurable g μ) (h_indep_fun : indep_fun f g μ) :
-  ∫⁻ a, (f * g) a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, g a ∂μ :=
+  ∫⁻ ω, (f * g) ω ∂μ = ∫⁻ ω, f ω ∂μ * ∫⁻ ω, g ω ∂μ :=
 begin
   have fg_ae : f * g =ᵐ[μ] (h_meas_f.mk _) * (h_meas_g.mk _),
     from h_meas_f.ae_eq_mk.mul h_meas_g.ae_eq_mk,
@@ -130,16 +132,21 @@ begin
   exact h_indep_fun.ae_eq h_meas_f.ae_eq_mk h_meas_g.ae_eq_mk
 end
 
+lemma lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun''
+  (h_meas_f : ae_measurable f μ) (h_meas_g : ae_measurable g μ) (h_indep_fun : indep_fun f g μ) :
+  ∫⁻ ω, f ω * g ω ∂μ = ∫⁻ ω, f ω ∂μ * ∫⁻ ω, g ω ∂μ :=
+lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun' h_meas_f h_meas_g h_indep_fun
+
 /-- The product of two independent, integrable, real_valued random variables is integrable. -/
-lemma indep_fun.integrable_mul {β : Type*} [measurable_space β] {X Y : α → β}
+lemma indep_fun.integrable_mul {β : Type*} [measurable_space β] {X Y : Ω → β}
   [normed_division_ring β] [borel_space β]
   (hXY : indep_fun X Y μ) (hX : integrable X μ) (hY : integrable Y μ) :
   integrable (X * Y) μ :=
 begin
-  let nX : α → ennreal := λ a, ∥X a∥₊,
-  let nY : α → ennreal := λ a, ∥Y a∥₊,
+  let nX : Ω → ennreal := λ a, ‖X a‖₊,
+  let nY : Ω → ennreal := λ a, ‖Y a‖₊,
 
-  have hXY' : indep_fun (λ a, ∥X a∥₊) (λ a, ∥Y a∥₊) μ :=
+  have hXY' : indep_fun (λ a, ‖X a‖₊) (λ a, ‖Y a‖₊) μ :=
     hXY.comp measurable_nnnorm measurable_nnnorm,
   have hXY'' : indep_fun nX nY μ :=
     hXY'.comp measurable_coe_nnreal_ennreal measurable_coe_nnreal_ennreal,
@@ -155,6 +162,56 @@ begin
   exact ennreal.mul_lt_top_iff.mpr (or.inl ⟨hX.2, hY.2⟩)
 end
 
+/-- If the product of two independent real_valued random variables is integrable and
+the second one is not almost everywhere zero, then the first one is integrable. -/
+lemma indep_fun.integrable_left_of_integrable_mul {β : Type*} [measurable_space β] {X Y : Ω → β}
+  [normed_division_ring β] [borel_space β]
+  (hXY : indep_fun X Y μ) (h'XY : integrable (X * Y) μ)
+  (hX : ae_strongly_measurable X μ) (hY : ae_strongly_measurable Y μ) (h'Y : ¬(Y =ᵐ[μ] 0)) :
+  integrable X μ :=
+begin
+  refine ⟨hX, _⟩,
+  have I : ∫⁻ ω, ‖Y ω‖₊ ∂μ ≠ 0,
+  { assume H,
+    have I : (λ ω, ↑‖Y ω‖₊) =ᵐ[μ] 0 := (lintegral_eq_zero_iff' hY.ennnorm).1 H,
+    apply h'Y,
+    filter_upwards [I] with ω hω,
+    simpa using hω },
+  apply lt_top_iff_ne_top.2 (λ H, _),
+  have J : indep_fun (λ ω, ↑‖X ω‖₊) (λ ω, ↑‖Y ω‖₊) μ,
+  { have M : measurable (λ (x : β), (‖x‖₊ : ℝ≥0∞)) := measurable_nnnorm.coe_nnreal_ennreal,
+    apply indep_fun.comp hXY M M },
+  have A : ∫⁻ ω, ‖X ω * Y ω‖₊ ∂μ < ∞ := h'XY.2,
+  simp only [nnnorm_mul, ennreal.coe_mul] at A,
+  rw [lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun'' hX.ennnorm hY.ennnorm J, H] at A,
+  simpa [ennreal.top_mul, I] using A,
+end
+
+/-- If the product of two independent real_valued random variables is integrable and the
+first one is not almost everywhere zero, then the second one is integrable. -/
+lemma indep_fun.integrable_right_of_integrable_mul {β : Type*} [measurable_space β] {X Y : Ω → β}
+  [normed_division_ring β] [borel_space β]
+  (hXY : indep_fun X Y μ) (h'XY : integrable (X * Y) μ)
+  (hX : ae_strongly_measurable X μ) (hY : ae_strongly_measurable Y μ) (h'X : ¬(X =ᵐ[μ] 0)) :
+  integrable Y μ :=
+begin
+  refine ⟨hY, _⟩,
+  have I : ∫⁻ ω, ‖X ω‖₊ ∂μ ≠ 0,
+  { assume H,
+    have I : (λ ω, ↑‖X ω‖₊) =ᵐ[μ] 0 := (lintegral_eq_zero_iff' hX.ennnorm).1 H,
+    apply h'X,
+    filter_upwards [I] with ω hω,
+    simpa using hω },
+  apply lt_top_iff_ne_top.2 (λ H, _),
+  have J : indep_fun (λ ω, ↑‖X ω‖₊) (λ ω, ↑‖Y ω‖₊) μ,
+  { have M : measurable (λ (x : β), (‖x‖₊ : ℝ≥0∞)) := measurable_nnnorm.coe_nnreal_ennreal,
+    apply indep_fun.comp hXY M M },
+  have A : ∫⁻ ω, ‖X ω * Y ω‖₊ ∂μ < ∞ := h'XY.2,
+  simp only [nnnorm_mul, ennreal.coe_mul] at A,
+  rw [lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun'' hX.ennnorm hY.ennnorm J, H] at A,
+  simpa [ennreal.top_mul, I] using A,
+end
+
 /-- The (Bochner) integral of the product of two independent, nonnegative random
   variables is the product of their integrals. The proof is just plumbing around
   `lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun'`. -/
@@ -235,17 +292,47 @@ begin
   ring
 end
 
-theorem indep_fun.integral_mul_of_integrable' (hXY : indep_fun X Y μ)
-  (hX : integrable X μ) (hY : integrable Y μ) :
-  integral μ (λ x, X x * Y x) = integral μ X * integral μ Y :=
-hXY.integral_mul_of_integrable hX hY
+/-- The (Bochner) integral of the product of two independent random
+  variables is the product of their integrals. -/
+theorem indep_fun.integral_mul (hXY : indep_fun X Y μ)
+  (hX : ae_strongly_measurable X μ) (hY : ae_strongly_measurable Y μ) :
+  integral μ (X * Y) = integral μ X * integral μ Y :=
+begin
+  by_cases h'X : X =ᵐ[μ] 0,
+  { have h' : X * Y =ᵐ[μ] 0,
+    { filter_upwards [h'X] with ω hω,
+      simp [hω] },
+    simp only [integral_congr_ae h'X, integral_congr_ae h', pi.zero_apply, integral_const,
+      algebra.id.smul_eq_mul, mul_zero, zero_mul] },
+  by_cases h'Y : Y =ᵐ[μ] 0,
+  { have h' : X * Y =ᵐ[μ] 0,
+    { filter_upwards [h'Y] with ω hω,
+      simp [hω] },
+    simp only [integral_congr_ae h'Y, integral_congr_ae h', pi.zero_apply, integral_const,
+      algebra.id.smul_eq_mul, mul_zero, zero_mul] },
+  by_cases h : integrable (X * Y) μ,
+  { have HX : integrable X μ := hXY.integrable_left_of_integrable_mul h hX hY h'Y,
+    have HY : integrable Y μ := hXY.integrable_right_of_integrable_mul h hX hY h'X,
+    exact hXY.integral_mul_of_integrable HX HY },
+  { have I : ¬(integrable X μ ∧ integrable Y μ),
+    { rintros ⟨HX, HY⟩,
+      exact h (hXY.integrable_mul HX HY) },
+    rw not_and_distrib at I,
+    cases I;
+    simp [integral_undef, I, h] }
+end
+
+theorem indep_fun.integral_mul' (hXY : indep_fun X Y μ)
+  (hX : ae_strongly_measurable X μ) (hY : ae_strongly_measurable Y μ) :
+  integral μ (λ ω, X ω * Y ω) = integral μ X * integral μ Y :=
+hXY.integral_mul hX hY
 
 /-- Independence of functions `f` and `g` into arbitrary types is characterized by the relation
   `E[(φ ∘ f) * (ψ ∘ g)] = E[φ ∘ f] * E[ψ ∘ g]` for all measurable `φ` and `ψ` with values in `ℝ`
   satisfying appropriate integrability conditions. -/
 theorem indep_fun_iff_integral_comp_mul [is_finite_measure μ]
   {β β' : Type*} {mβ : measurable_space β} {mβ' : measurable_space β'}
-  {f : α → β} {g : α → β'} {hfm : measurable f} {hgm : measurable g} :
+  {f : Ω → β} {g : Ω → β'} {hfm : measurable f} {hgm : measurable g} :
   indep_fun f g μ ↔
   ∀ {φ : β → ℝ} {ψ : β' → ℝ},
     measurable φ → measurable ψ → integrable (φ ∘ f) μ → integrable (ψ ∘ g) μ →
diff --git a/src/probability/kernel/basic.lean b/src/probability/kernel/basic.lean
new file mode 100644
index 0000000000000..26f606148e1c5
--- /dev/null
+++ b/src/probability/kernel/basic.lean
@@ -0,0 +1,661 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.integral.bochner
+import measure_theory.constructions.prod.basic
+
+/-!
+# Markov Kernels
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A kernel from a measurable space `α` to another measurable space `β` is a measurable map
+`α → measure β`, where the measurable space instance on `measure β` is the one defined in
+`measure_theory.measure.measurable_space`. That is, a kernel `κ` verifies that for all measurable
+sets `s` of `β`, `a ↦ κ a s` is measurable.
+
+## Main definitions
+
+Classes of kernels:
+* `probability_theory.kernel α β`: kernels from `α` to `β`, defined as the `add_submonoid` of the
+  measurable functions in `α → measure β`.
+* `probability_theory.is_markov_kernel κ`: a kernel from `α` to `β` is said to be a Markov kernel
+  if for all `a : α`, `k a` is a probability measure.
+* `probability_theory.is_finite_kernel κ`: a kernel from `α` to `β` is said to be finite if there
+  exists `C : ℝ≥0∞` such that `C < ∞` and for all `a : α`, `κ a univ ≤ C`. This implies in
+  particular that all measures in the image of `κ` are finite, but is stronger since it requires an
+  uniform bound. This stronger condition is necessary to ensure that the composition of two finite
+  kernels is finite.
+* `probability_theory.is_s_finite_kernel κ`: a kernel is called s-finite if it is a countable
+  sum of finite kernels.
+
+Particular kernels:
+* `probability_theory.kernel.deterministic (f : α → β) (hf : measurable f)`:
+  kernel `a ↦ measure.dirac (f a)`.
+* `probability_theory.kernel.const α (μβ : measure β)`: constant kernel `a ↦ μβ`.
+* `probability_theory.kernel.restrict κ (hs : measurable_set s)`: kernel for which the image of
+  `a : α` is `(κ a).restrict s`.
+  Integral: `∫⁻ b, f b ∂(kernel.restrict κ hs a) = ∫⁻ b in s, f b ∂(κ a)`
+
+## Main statements
+
+* `probability_theory.kernel.ext_fun`: if `∫⁻ b, f b ∂(κ a) = ∫⁻ b, f b ∂(η a)` for all measurable
+  functions `f` and all `a`, then the two kernels `κ` and `η` are equal.
+
+-/
+
+open measure_theory
+
+open_locale measure_theory ennreal nnreal big_operators
+
+namespace probability_theory
+
+/-- A kernel from a measurable space `α` to another measurable space `β` is a measurable function
+`κ : α → measure β`. The measurable space structure on `measure β` is given by
+`measure_theory.measure.measurable_space`. A map `κ : α → measure β` is measurable iff
+`∀ s : set β, measurable_set s → measurable (λ a, κ a s)`. -/
+def kernel (α β : Type*) [measurable_space α] [measurable_space β] :
+  add_submonoid (α → measure β) :=
+{ carrier := measurable,
+  zero_mem' := measurable_zero,
+  add_mem' := λ f g hf hg, measurable.add hf hg, }
+
+instance {α β : Type*} [measurable_space α] [measurable_space β] :
+  has_coe_to_fun (kernel α β) (λ _, α → measure β) := ⟨λ κ, κ.val⟩
+
+variables {α β ι : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+
+include mα mβ
+
+namespace kernel
+
+@[simp] lemma coe_fn_zero : ⇑(0 : kernel α β) = 0 := rfl
+@[simp] lemma coe_fn_add (κ η : kernel α β) : ⇑(κ + η) = κ + η := rfl
+
+omit mα mβ
+
+/-- Coercion to a function as an additive monoid homomorphism. -/
+def coe_add_hom (α β : Type*) [measurable_space α] [measurable_space β] :
+  kernel α β →+ (α → measure β) :=
+⟨coe_fn, coe_fn_zero, coe_fn_add⟩
+
+include mα mβ
+
+@[simp] lemma zero_apply (a : α) : (0 : kernel α β) a = 0 := rfl
+
+@[simp] lemma coe_finset_sum (I : finset ι) (κ : ι → kernel α β) :
+  ⇑(∑ i in I, κ i) = ∑ i in I, κ i :=
+(coe_add_hom α β).map_sum _ _
+
+lemma finset_sum_apply (I : finset ι) (κ : ι → kernel α β) (a : α) :
+  (∑ i in I, κ i) a = ∑ i in I, κ i a :=
+by rw [coe_finset_sum, finset.sum_apply]
+
+lemma finset_sum_apply' (I : finset ι) (κ : ι → kernel α β) (a : α) (s : set β) :
+  (∑ i in I, κ i) a s = ∑ i in I, κ i a s :=
+by rw [finset_sum_apply, measure.finset_sum_apply]
+
+end kernel
+
+/-- A kernel is a Markov kernel if every measure in its image is a probability measure. -/
+class is_markov_kernel (κ : kernel α β) : Prop :=
+(is_probability_measure : ∀ a, is_probability_measure (κ a))
+
+/-- A kernel is finite if every measure in its image is finite, with a uniform bound. -/
+class is_finite_kernel (κ : kernel α β) : Prop :=
+(exists_univ_le : ∃ C : ℝ≥0∞, C < ∞ ∧ ∀ a, κ a set.univ ≤ C)
+
+/-- A constant `C : ℝ≥0∞` such that `C < ∞` (`is_finite_kernel.bound_lt_top κ`) and for all
+`a : α` and `s : set β`, `κ a s ≤ C` (`measure_le_bound κ a s`). -/
+noncomputable
+def is_finite_kernel.bound (κ : kernel α β) [h : is_finite_kernel κ] : ℝ≥0∞ :=
+h.exists_univ_le.some
+
+lemma is_finite_kernel.bound_lt_top (κ : kernel α β) [h : is_finite_kernel κ] :
+  is_finite_kernel.bound κ < ∞ :=
+h.exists_univ_le.some_spec.1
+
+lemma is_finite_kernel.bound_ne_top (κ : kernel α β) [h : is_finite_kernel κ] :
+  is_finite_kernel.bound κ ≠ ∞ :=
+(is_finite_kernel.bound_lt_top κ).ne
+
+lemma kernel.measure_le_bound (κ : kernel α β) [h : is_finite_kernel κ] (a : α) (s : set β) :
+  κ a s ≤ is_finite_kernel.bound κ :=
+(measure_mono (set.subset_univ s)).trans (h.exists_univ_le.some_spec.2 a)
+
+instance is_finite_kernel_zero (α β : Type*) {mα : measurable_space α} {mβ : measurable_space β} :
+  is_finite_kernel (0 : kernel α β) :=
+⟨⟨0, ennreal.coe_lt_top,
+  λ a, by simp only [kernel.zero_apply, measure.coe_zero, pi.zero_apply, le_zero_iff]⟩⟩
+
+instance is_finite_kernel.add (κ η : kernel α β) [is_finite_kernel κ] [is_finite_kernel η] :
+  is_finite_kernel (κ + η) :=
+begin
+  refine ⟨⟨is_finite_kernel.bound κ + is_finite_kernel.bound η,
+    ennreal.add_lt_top.mpr ⟨is_finite_kernel.bound_lt_top κ, is_finite_kernel.bound_lt_top η⟩,
+    λ a, _⟩⟩,
+  simp_rw [kernel.coe_fn_add, pi.add_apply, measure.coe_add, pi.add_apply],
+  exact add_le_add (kernel.measure_le_bound _ _ _) (kernel.measure_le_bound _ _ _),
+end
+
+variables {κ : kernel α β}
+
+instance is_markov_kernel.is_probability_measure' [h : is_markov_kernel κ] (a : α) :
+  is_probability_measure (κ a) :=
+is_markov_kernel.is_probability_measure a
+
+instance is_finite_kernel.is_finite_measure [h : is_finite_kernel κ] (a : α) :
+  is_finite_measure (κ a) :=
+⟨(kernel.measure_le_bound κ a set.univ).trans_lt (is_finite_kernel.bound_lt_top κ)⟩
+
+@[priority 100]
+instance is_markov_kernel.is_finite_kernel [h : is_markov_kernel κ] : is_finite_kernel κ :=
+⟨⟨1, ennreal.one_lt_top, λ a, prob_le_one⟩⟩
+
+namespace kernel
+
+@[ext] lemma ext {η : kernel α β} (h : ∀ a, κ a = η a) : κ = η :=
+by { ext1, ext1 a, exact h a, }
+
+lemma ext_iff {η : kernel α β} : κ = η ↔ ∀ a, κ a = η a :=
+⟨λ h a, by rw h, ext⟩
+
+lemma ext_iff' {η : kernel α β} : κ = η ↔ ∀ a (s : set β) (hs : measurable_set s), κ a s = η a s :=
+by simp_rw [ext_iff, measure.ext_iff]
+
+lemma ext_fun {η : kernel α β} (h : ∀ a f, measurable f → ∫⁻ b, f b ∂(κ a) = ∫⁻ b, f b ∂(η a)) :
+  κ = η :=
+begin
+  ext a s hs,
+  specialize h a (s.indicator (λ _, 1)) (measurable.indicator measurable_const hs),
+  simp_rw [lintegral_indicator_const hs, one_mul] at h,
+  rw h,
+end
+
+lemma ext_fun_iff {η : kernel α β} :
+  κ = η ↔ ∀ a f, measurable f → ∫⁻ b, f b ∂(κ a) = ∫⁻ b, f b ∂(η a) :=
+⟨λ h a f hf, by rw h, ext_fun⟩
+
+protected lemma measurable (κ : kernel α β) : measurable κ := κ.prop
+
+protected lemma measurable_coe (κ : kernel α β) {s : set β} (hs : measurable_set s) :
+  measurable (λ a, κ a s) :=
+(measure.measurable_coe hs).comp (kernel.measurable κ)
+
+section sum
+
+/-- Sum of an indexed family of kernels. -/
+protected noncomputable
+def sum [countable ι] (κ : ι → kernel α β) : kernel α β :=
+{ val := λ a, measure.sum (λ n, κ n a),
+  property :=
+  begin
+    refine measure.measurable_of_measurable_coe _ (λ s hs, _),
+    simp_rw measure.sum_apply _ hs,
+    exact measurable.ennreal_tsum (λ n, kernel.measurable_coe (κ n) hs),
+  end, }
+
+lemma sum_apply [countable ι] (κ : ι → kernel α β) (a : α) :
+  kernel.sum κ a = measure.sum (λ n, κ n a) := rfl
+
+lemma sum_apply' [countable ι] (κ : ι → kernel α β) (a : α) {s : set β} (hs : measurable_set s) :
+  kernel.sum κ a s = ∑' n, κ n a s :=
+by rw [sum_apply κ a, measure.sum_apply _ hs]
+
+@[simp]
+lemma sum_zero [countable ι] : kernel.sum (λ (i : ι), (0 : kernel α β)) = 0 :=
+begin
+  ext a s hs : 2,
+  rw [sum_apply' _ a hs],
+  simp only [zero_apply, measure.coe_zero, pi.zero_apply, tsum_zero],
+end
+
+lemma sum_comm [countable ι] (κ : ι → ι → kernel α β) :
+  kernel.sum (λ n, kernel.sum (κ n)) = kernel.sum (λ m, kernel.sum (λ n, κ n m)) :=
+by { ext a s hs, simp_rw [sum_apply], rw measure.sum_comm, }
+
+@[simp] lemma sum_fintype [fintype ι] (κ : ι → kernel α β) : kernel.sum κ = ∑ i, κ i :=
+by { ext a s hs, simp only [sum_apply' κ a hs, finset_sum_apply' _ κ a s, tsum_fintype], }
+
+lemma sum_add [countable ι] (κ η : ι → kernel α β) :
+  kernel.sum (λ n, κ n + η n) = kernel.sum κ + kernel.sum η :=
+begin
+  ext a s hs,
+  simp only [coe_fn_add, pi.add_apply, sum_apply, measure.sum_apply _ hs, pi.add_apply,
+    measure.coe_add, tsum_add ennreal.summable ennreal.summable],
+end
+
+end sum
+
+section s_finite
+
+/-- A kernel is s-finite if it can be written as the sum of countably many finite kernels. -/
+class _root_.probability_theory.is_s_finite_kernel (κ : kernel α β) : Prop :=
+(tsum_finite : ∃ κs : ℕ → kernel α β, (∀ n, is_finite_kernel (κs n)) ∧ κ = kernel.sum κs)
+
+@[priority 100]
+instance is_finite_kernel.is_s_finite_kernel [h : is_finite_kernel κ] : is_s_finite_kernel κ :=
+⟨⟨λ n, if n = 0 then κ else 0,
+  λ n, by { split_ifs, exact h, apply_instance, },
+  begin
+    ext a s hs,
+    rw kernel.sum_apply' _ _ hs,
+    have : (λ i, ((ite (i = 0) κ 0) a) s) = λ i, ite (i = 0) (κ a s) 0,
+    { ext1 i, split_ifs; refl, },
+    rw [this, tsum_ite_eq],
+  end⟩⟩
+
+/-- A sequence of finite kernels such that `κ = kernel.sum (seq κ)`. See `is_finite_kernel_seq`
+and `kernel_sum_seq`. -/
+noncomputable
+def seq (κ : kernel α β) [h : is_s_finite_kernel κ] :
+  ℕ → kernel α β :=
+h.tsum_finite.some
+
+lemma kernel_sum_seq (κ : kernel α β) [h : is_s_finite_kernel κ] :
+  kernel.sum (seq κ) = κ :=
+h.tsum_finite.some_spec.2.symm
+
+lemma measure_sum_seq (κ : kernel α β) [h : is_s_finite_kernel κ] (a : α) :
+  measure.sum (λ n, seq κ n a) = κ a :=
+by rw [← kernel.sum_apply, kernel_sum_seq κ]
+
+instance is_finite_kernel_seq (κ : kernel α β) [h : is_s_finite_kernel κ] (n : ℕ) :
+  is_finite_kernel (kernel.seq κ n) :=
+h.tsum_finite.some_spec.1 n
+
+instance is_s_finite_kernel.add (κ η : kernel α β) [is_s_finite_kernel κ] [is_s_finite_kernel η] :
+  is_s_finite_kernel (κ + η) :=
+begin
+  refine ⟨⟨λ n, seq κ n + seq η n, λ n, infer_instance, _⟩⟩,
+  rw [sum_add, kernel_sum_seq κ, kernel_sum_seq η],
+end
+
+lemma is_s_finite_kernel.finset_sum {κs : ι → kernel α β} (I : finset ι)
+  (h : ∀ i ∈ I, is_s_finite_kernel (κs i)) :
+  is_s_finite_kernel (∑ i in I, κs i) :=
+begin
+  classical,
+  unfreezingI
+  { induction I using finset.induction with i I hi_nmem_I h_ind h,
+    { rw [finset.sum_empty], apply_instance, },
+    { rw finset.sum_insert hi_nmem_I,
+      haveI : is_s_finite_kernel (κs i) := h i (finset.mem_insert_self _ _),
+      haveI : is_s_finite_kernel (∑ (x : ι) in I, κs x),
+        from h_ind (λ i hiI, h i (finset.mem_insert_of_mem hiI)),
+      exact is_s_finite_kernel.add _ _, }, },
+end
+
+lemma is_s_finite_kernel_sum_of_denumerable [denumerable ι] {κs : ι → kernel α β}
+  (hκs : ∀ n, is_s_finite_kernel (κs n)) :
+  is_s_finite_kernel (kernel.sum κs) :=
+begin
+  let e : ℕ ≃ (ι × ℕ) := denumerable.equiv₂ ℕ (ι × ℕ),
+  refine ⟨⟨λ n, seq (κs (e n).1) (e n).2, infer_instance, _⟩⟩,
+  have hκ_eq : kernel.sum κs = kernel.sum (λ n, kernel.sum (seq (κs n))),
+  { simp_rw kernel_sum_seq, },
+  ext a s hs : 2,
+  rw hκ_eq,
+  simp_rw kernel.sum_apply' _ _ hs,
+  change ∑' i m, seq (κs i) m a s = ∑' n, (λ im : ι × ℕ, seq (κs im.fst) im.snd a s) (e n),
+  rw e.tsum_eq,
+  { rw tsum_prod' ennreal.summable (λ _, ennreal.summable), },
+  { apply_instance, },
+end
+
+lemma is_s_finite_kernel_sum [countable ι] {κs : ι → kernel α β}
+  (hκs : ∀ n, is_s_finite_kernel (κs n)) :
+  is_s_finite_kernel (kernel.sum κs) :=
+begin
+  casesI fintype_or_infinite ι,
+  { rw sum_fintype,
+    exact is_s_finite_kernel.finset_sum finset.univ (λ i _, hκs i), },
+  haveI : encodable ι := encodable.of_countable ι,
+  haveI : denumerable ι := denumerable.of_encodable_of_infinite ι,
+  exact is_s_finite_kernel_sum_of_denumerable hκs,
+end
+
+end s_finite
+
+section deterministic
+
+/-- Kernel which to `a` associates the dirac measure at `f a`. This is a Markov kernel. -/
+noncomputable
+def deterministic (f : α → β) (hf : measurable f) :
+  kernel α β :=
+{ val := λ a, measure.dirac (f a),
+  property :=
+    begin
+      refine measure.measurable_of_measurable_coe _ (λ s hs, _),
+      simp_rw measure.dirac_apply' _ hs,
+      exact measurable_one.indicator (hf hs),
+    end, }
+
+lemma deterministic_apply {f : α → β} (hf : measurable f) (a : α) :
+  deterministic f hf a = measure.dirac (f a) := rfl
+
+lemma deterministic_apply' {f : α → β} (hf : measurable f) (a : α) {s : set β}
+  (hs : measurable_set s) :
+  deterministic f hf a s = s.indicator (λ _, 1) (f a) :=
+begin
+  rw [deterministic],
+  change measure.dirac (f a) s = s.indicator 1 (f a),
+  simp_rw measure.dirac_apply' _ hs,
+end
+
+instance is_markov_kernel_deterministic {f : α → β} (hf : measurable f) :
+  is_markov_kernel (deterministic f hf) :=
+⟨λ a, by { rw deterministic_apply hf, apply_instance, }⟩
+
+lemma lintegral_deterministic' {f : β → ℝ≥0∞} {g : α → β} {a : α}
+  (hg : measurable g) (hf : measurable f) :
+  ∫⁻ x, f x ∂(kernel.deterministic g hg a) = f (g a) :=
+by rw [kernel.deterministic_apply, lintegral_dirac' _ hf]
+
+@[simp]
+lemma lintegral_deterministic {f : β → ℝ≥0∞} {g : α → β} {a : α}
+  (hg : measurable g) [measurable_singleton_class β] :
+  ∫⁻ x, f x ∂(kernel.deterministic g hg a) = f (g a) :=
+by rw [kernel.deterministic_apply, lintegral_dirac (g a) f]
+
+lemma set_lintegral_deterministic' {f : β → ℝ≥0∞} {g : α → β} {a : α}
+  (hg : measurable g) (hf : measurable f) {s : set β} (hs : measurable_set s)
+  [decidable (g a ∈ s)] :
+  ∫⁻ x in s, f x ∂(kernel.deterministic g hg a) = if g a ∈ s then f (g a) else 0 :=
+by rw [kernel.deterministic_apply, set_lintegral_dirac' hf hs]
+
+@[simp]
+lemma set_lintegral_deterministic {f : β → ℝ≥0∞} {g : α → β} {a : α}
+  (hg : measurable g) [measurable_singleton_class β] (s : set β) [decidable (g a ∈ s)] :
+  ∫⁻ x in s, f x ∂(kernel.deterministic g hg a) = if g a ∈ s then f (g a) else 0 :=
+by rw [kernel.deterministic_apply, set_lintegral_dirac f s]
+
+lemma integral_deterministic' {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] {f : β → E} {g : α → β} {a : α}
+  (hg : measurable g) (hf : strongly_measurable f) :
+  ∫ x, f x ∂(kernel.deterministic g hg a) = f (g a) :=
+by rw [kernel.deterministic_apply, integral_dirac' _ _ hf]
+
+@[simp]
+lemma integral_deterministic {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] {f : β → E} {g : α → β} {a : α}
+  (hg : measurable g) [measurable_singleton_class β] :
+  ∫ x, f x ∂(kernel.deterministic g hg a) = f (g a) :=
+by rw [kernel.deterministic_apply, integral_dirac _ (g a)]
+
+lemma set_integral_deterministic' {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] {f : β → E} {g : α → β} {a : α}
+  (hg : measurable g) (hf : strongly_measurable f) {s : set β} (hs : measurable_set s)
+  [decidable (g a ∈ s)] :
+  ∫ x in s, f x ∂(kernel.deterministic g hg a) = if g a ∈ s then f (g a) else 0 :=
+by rw [kernel.deterministic_apply, set_integral_dirac' hf _ hs]
+
+@[simp]
+lemma set_integral_deterministic {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] {f : β → E} {g : α → β} {a : α}
+  (hg : measurable g) [measurable_singleton_class β] (s : set β) [decidable (g a ∈ s)] :
+  ∫ x in s, f x ∂(kernel.deterministic g hg a) = if g a ∈ s then f (g a) else 0 :=
+by rw [kernel.deterministic_apply, set_integral_dirac f _ s]
+
+end deterministic
+
+section const
+
+omit mα mβ
+
+/-- Constant kernel, which always returns the same measure. -/
+def const (α : Type*) {β : Type*} [measurable_space α] {mβ : measurable_space β} (μβ : measure β) :
+  kernel α β :=
+{ val := λ _, μβ,
+  property := measure.measurable_of_measurable_coe _ (λ s hs, measurable_const), }
+
+include mα mβ
+
+lemma const_apply (μβ : measure β) (a : α) :
+  const α μβ a = μβ :=
+rfl
+
+instance is_finite_kernel_const {μβ : measure β} [hμβ : is_finite_measure μβ] :
+  is_finite_kernel (const α μβ) :=
+⟨⟨μβ set.univ, measure_lt_top _ _, λ a, le_rfl⟩⟩
+
+instance is_markov_kernel_const {μβ : measure β} [hμβ : is_probability_measure μβ] :
+  is_markov_kernel (const α μβ) :=
+⟨λ a, hμβ⟩
+
+@[simp]
+lemma lintegral_const {f : β → ℝ≥0∞} {μ : measure β} {a : α} :
+  ∫⁻ x, f x ∂(kernel.const α μ a) = ∫⁻ x, f x ∂μ :=
+by rw kernel.const_apply
+
+@[simp]
+lemma set_lintegral_const {f : β → ℝ≥0∞} {μ : measure β} {a : α} {s : set β} :
+  ∫⁻ x in s, f x ∂(kernel.const α μ a) = ∫⁻ x in s, f x ∂μ :=
+by rw kernel.const_apply
+
+@[simp]
+lemma integral_const {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  {f : β → E} {μ : measure β} {a : α} :
+  ∫ x, f x ∂(kernel.const α μ a) = ∫ x, f x ∂μ :=
+by rw kernel.const_apply
+
+@[simp]
+lemma set_integral_const {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  {f : β → E} {μ : measure β} {a : α} {s : set β} :
+  ∫ x in s, f x ∂(kernel.const α μ a) = ∫ x in s, f x ∂μ :=
+by rw kernel.const_apply
+
+end const
+
+omit mα
+
+/-- In a countable space with measurable singletons, every function `α → measure β` defines a
+kernel. -/
+def of_fun_of_countable [measurable_space α] {mβ : measurable_space β}
+  [countable α] [measurable_singleton_class α] (f : α → measure β) :
+  kernel α β :=
+{ val := f,
+  property := measurable_of_countable f }
+
+include mα
+
+section restrict
+variables {s t : set β}
+
+/-- Kernel given by the restriction of the measures in the image of a kernel to a set. -/
+protected noncomputable
+def restrict (κ : kernel α β) (hs : measurable_set s) : kernel α β :=
+{ val := λ a, (κ a).restrict s,
+  property :=
+  begin
+    refine measure.measurable_of_measurable_coe _ (λ t ht, _),
+    simp_rw measure.restrict_apply ht,
+    exact kernel.measurable_coe κ (ht.inter hs),
+  end, }
+
+lemma restrict_apply (κ : kernel α β) (hs : measurable_set s) (a : α) :
+  kernel.restrict κ hs a = (κ a).restrict s := rfl
+
+lemma restrict_apply' (κ : kernel α β) (hs : measurable_set s) (a : α) (ht : measurable_set t) :
+  kernel.restrict κ hs a t = (κ a) (t ∩ s) :=
+by rw [restrict_apply κ hs a, measure.restrict_apply ht]
+
+@[simp]
+lemma restrict_univ : kernel.restrict κ measurable_set.univ = κ :=
+by { ext1 a, rw [kernel.restrict_apply, measure.restrict_univ], }
+
+@[simp]
+lemma lintegral_restrict (κ : kernel α β) (hs : measurable_set s) (a : α) (f : β → ℝ≥0∞) :
+  ∫⁻ b, f b ∂(kernel.restrict κ hs a) = ∫⁻ b in s, f b ∂(κ a) :=
+by rw restrict_apply
+
+@[simp]
+lemma set_lintegral_restrict (κ : kernel α β) (hs : measurable_set s) (a : α) (f : β → ℝ≥0∞)
+  (t : set β) :
+  ∫⁻ b in t, f b ∂(kernel.restrict κ hs a) = ∫⁻ b in (t ∩ s), f b ∂(κ a) :=
+by rw [restrict_apply, measure.restrict_restrict' hs]
+
+@[simp]
+lemma set_integral_restrict {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] {f : β → E} {a : α} (hs : measurable_set s) (t : set β) :
+  ∫ x in t, f x ∂(kernel.restrict κ hs a) = ∫ x in (t ∩ s), f x ∂(κ a) :=
+by rw [restrict_apply, measure.restrict_restrict' hs]
+
+instance is_finite_kernel.restrict (κ : kernel α β) [is_finite_kernel κ] (hs : measurable_set s) :
+  is_finite_kernel (kernel.restrict κ hs) :=
+begin
+  refine ⟨⟨is_finite_kernel.bound κ, is_finite_kernel.bound_lt_top κ, λ a, _⟩⟩,
+  rw restrict_apply' κ hs a measurable_set.univ,
+  exact measure_le_bound κ a _,
+end
+
+instance is_s_finite_kernel.restrict (κ : kernel α β) [is_s_finite_kernel κ]
+  (hs : measurable_set s) :
+  is_s_finite_kernel (kernel.restrict κ hs) :=
+begin
+  refine ⟨⟨λ n, kernel.restrict (seq κ n) hs, infer_instance, _⟩⟩,
+  ext1 a,
+  simp_rw [sum_apply, restrict_apply, ← measure.restrict_sum _ hs, ← sum_apply, kernel_sum_seq],
+end
+
+end restrict
+
+section comap_right
+
+variables {γ : Type*} {mγ : measurable_space γ} {f : γ → β}
+
+include mγ
+
+/-- Kernel with value `(κ a).comap f`, for a measurable embedding `f`. That is, for a measurable set
+`t : set β`, `comap_right κ hf a t = κ a (f '' t)`. -/
+noncomputable
+def comap_right (κ : kernel α β) (hf : measurable_embedding f) :
+  kernel α γ :=
+{ val := λ a, (κ a).comap f,
+  property :=
+  begin
+    refine measure.measurable_measure.mpr (λ t ht, _),
+    have : (λ a, measure.comap f (κ a) t) = λ a, κ a (f '' t),
+    { ext1 a,
+      rw measure.comap_apply _ hf.injective (λ s' hs', _) _ ht,
+      exact hf.measurable_set_image.mpr hs', },
+    rw this,
+    exact kernel.measurable_coe _ (hf.measurable_set_image.mpr ht),
+  end }
+
+lemma comap_right_apply (κ : kernel α β) (hf : measurable_embedding f) (a : α) :
+  comap_right κ hf a = measure.comap f (κ a) := rfl
+
+lemma comap_right_apply' (κ : kernel α β) (hf : measurable_embedding f)
+  (a : α) {t : set γ} (ht : measurable_set t) :
+  comap_right κ hf a t = κ a (f '' t) :=
+by rw [comap_right_apply,
+    measure.comap_apply _ hf.injective (λ s, hf.measurable_set_image.mpr) _ ht]
+
+lemma is_markov_kernel.comap_right (κ : kernel α β) (hf : measurable_embedding f)
+  (hκ : ∀ a, κ a (set.range f) = 1) :
+  is_markov_kernel (comap_right κ hf) :=
+begin
+  refine ⟨λ a, ⟨_⟩⟩,
+  rw comap_right_apply' κ hf a measurable_set.univ,
+  simp only [set.image_univ, subtype.range_coe_subtype, set.set_of_mem_eq],
+  exact hκ a,
+end
+
+instance is_finite_kernel.comap_right (κ : kernel α β) [is_finite_kernel κ]
+  (hf : measurable_embedding f) :
+  is_finite_kernel (comap_right κ hf) :=
+begin
+  refine ⟨⟨is_finite_kernel.bound κ, is_finite_kernel.bound_lt_top κ, λ a, _⟩⟩,
+  rw comap_right_apply' κ hf a measurable_set.univ,
+  exact measure_le_bound κ a _,
+end
+
+instance is_s_finite_kernel.comap_right (κ : kernel α β) [is_s_finite_kernel κ]
+  (hf : measurable_embedding f) :
+  is_s_finite_kernel (comap_right κ hf) :=
+begin
+  refine ⟨⟨λ n, comap_right (seq κ n) hf, infer_instance, _⟩⟩,
+  ext1 a,
+  rw sum_apply,
+  simp_rw comap_right_apply _ hf,
+  have : measure.sum (λ n, measure.comap f (seq κ n a))
+    = measure.comap f (measure.sum (λ n, seq κ n a)),
+  { ext1 t ht,
+    rw [measure.comap_apply _ hf.injective (λ s', hf.measurable_set_image.mpr) _ ht,
+      measure.sum_apply _ ht, measure.sum_apply _ (hf.measurable_set_image.mpr ht)],
+    congr' with n : 1,
+    rw measure.comap_apply _ hf.injective (λ s', hf.measurable_set_image.mpr) _ ht, },
+  rw [this, measure_sum_seq],
+end
+
+end comap_right
+
+section piecewise
+
+variables {η : kernel α β} {s : set α} {hs : measurable_set s} [decidable_pred (∈ s)]
+
+/-- `piecewise hs κ η` is the kernel equal to `κ` on the measurable set `s` and to `η` on its
+complement. -/
+def piecewise (hs : measurable_set s) (κ η : kernel α β) :
+  kernel α β :=
+{ val := λ a, if a ∈ s then κ a else η a,
+  property := measurable.piecewise hs (kernel.measurable _) (kernel.measurable _) }
+
+lemma piecewise_apply (a : α) :
+  piecewise hs κ η a = if a ∈ s then κ a else η a := rfl
+
+lemma piecewise_apply' (a : α) (t : set β) :
+  piecewise hs κ η a t = if a ∈ s then κ a t else η a t :=
+by { rw piecewise_apply, split_ifs; refl, }
+
+instance is_markov_kernel.piecewise [is_markov_kernel κ] [is_markov_kernel η] :
+  is_markov_kernel (piecewise hs κ η) :=
+by { refine ⟨λ a, ⟨_⟩⟩, rw [piecewise_apply', measure_univ, measure_univ, if_t_t], }
+
+instance is_finite_kernel.piecewise [is_finite_kernel κ] [is_finite_kernel η] :
+  is_finite_kernel (piecewise hs κ η) :=
+begin
+  refine ⟨⟨max (is_finite_kernel.bound κ) (is_finite_kernel.bound η), _, λ a, _⟩⟩,
+  { exact max_lt (is_finite_kernel.bound_lt_top κ) (is_finite_kernel.bound_lt_top η), },
+  rw [piecewise_apply'],
+  exact (ite_le_sup _ _ _).trans (sup_le_sup (measure_le_bound _ _ _) (measure_le_bound _ _ _)),
+end
+
+instance is_s_finite_kernel.piecewise [is_s_finite_kernel κ] [is_s_finite_kernel η] :
+  is_s_finite_kernel (piecewise hs κ η) :=
+begin
+  refine ⟨⟨λ n, piecewise hs (seq κ n) (seq η n), infer_instance, _⟩⟩,
+  ext1 a,
+  simp_rw [sum_apply, kernel.piecewise_apply],
+  split_ifs; exact (measure_sum_seq _ a).symm,
+end
+
+lemma lintegral_piecewise (a : α) (g : β → ℝ≥0∞) :
+  ∫⁻ b, g b ∂(piecewise hs κ η a) = if a ∈ s then ∫⁻ b, g b ∂(κ a) else ∫⁻ b, g b ∂(η a) :=
+by { simp_rw piecewise_apply, split_ifs; refl, }
+
+lemma set_lintegral_piecewise (a : α) (g : β → ℝ≥0∞) (t : set β) :
+  ∫⁻ b in t, g b ∂(piecewise hs κ η a)
+    = if a ∈ s then ∫⁻ b in t, g b ∂(κ a) else ∫⁻ b in t, g b ∂(η a) :=
+by { simp_rw piecewise_apply, split_ifs; refl, }
+
+lemma integral_piecewise {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  (a : α) (g : β → E) :
+  ∫ b, g b ∂(piecewise hs κ η a) = if a ∈ s then ∫ b, g b ∂(κ a) else ∫ b, g b ∂(η a) :=
+by { simp_rw piecewise_apply, split_ifs; refl, }
+
+lemma set_integral_piecewise {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] (a : α) (g : β → E) (t : set β) :
+  ∫ b in t, g b ∂(piecewise hs κ η a)
+    = if a ∈ s then ∫ b in t, g b ∂(κ a) else ∫ b in t, g b ∂(η a) :=
+by { simp_rw piecewise_apply, split_ifs; refl, }
+
+end piecewise
+
+end kernel
+
+end probability_theory
diff --git a/src/probability/kernel/composition.lean b/src/probability/kernel/composition.lean
new file mode 100644
index 0000000000000..4142e94a07ce4
--- /dev/null
+++ b/src/probability/kernel/composition.lean
@@ -0,0 +1,866 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import probability.kernel.measurable_integral
+
+/-!
+# Product and composition of kernels
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define
+* the composition-product `κ ⊗ₖ η` of two s-finite kernels `κ : kernel α β` and
+  `η : kernel (α × β) γ`, a kernel from `α` to `β × γ`.
+* the map and comap of a kernel along a measurable function.
+* the composition `η ∘ₖ κ` of kernels `κ : kernel α β` and `η : kernel β γ`,  kernel from `α` to
+  `γ`.
+* the product `κ ×ₖ η` of s-finite kernels `κ : kernel α β` and `η : kernel α γ`,
+  a kernel from `α` to `β × γ`.
+
+A note on names:
+The composition-product `kernel α β → kernel (α × β) γ → kernel α (β × γ)` is named composition in
+[kallenberg2021] and product on the wikipedia article on transition kernels.
+Most papers studying categories of kernels call composition the map we call composition. We adopt
+that convention because it fits better with the use of the name `comp` elsewhere in mathlib.
+
+## Main definitions
+
+Kernels built from other kernels:
+* `comp_prod (κ : kernel α β) (η : kernel (α × β) γ) : kernel α (β × γ)`: composition-product of 2
+  s-finite kernels. We define a notation `κ ⊗ₖ η = comp_prod κ η`.
+  `∫⁻ bc, f bc ∂((κ ⊗ₖ η) a) = ∫⁻ b, ∫⁻ c, f (b, c) ∂(η (a, b)) ∂(κ a)`
+* `map (κ : kernel α β) (f : β → γ) (hf : measurable f) : kernel α γ`
+  `∫⁻ c, g c ∂(map κ f hf a) = ∫⁻ b, g (f b) ∂(κ a)`
+* `comap (κ : kernel α β) (f : γ → α) (hf : measurable f) : kernel γ β`
+  `∫⁻ b, g b ∂(comap κ f hf c) = ∫⁻ b, g b ∂(κ (f c))`
+* `comp (η : kernel β γ) (κ : kernel α β) : kernel α γ`: composition of 2 kernels.
+  We define a notation `η ∘ₖ κ = comp η κ`.
+  `∫⁻ c, g c ∂((η ∘ₖ κ) a) = ∫⁻ b, ∫⁻ c, g c ∂(η b) ∂(κ a)`
+* `prod (κ : kernel α β) (η : kernel α γ) : kernel α (β × γ)`: product of 2 s-finite kernels.
+  `∫⁻ bc, f bc ∂((κ ×ₖ η) a) = ∫⁻ b, ∫⁻ c, f (b, c) ∂(η a) ∂(κ a)`
+
+## Main statements
+
+* `lintegral_comp_prod`, `lintegral_map`, `lintegral_comap`, `lintegral_comp`, `lintegral_prod`:
+  Lebesgue integral of a function against a composition-product/map/comap/composition/product of
+  kernels.
+* Instances of the form `.` where class is one of `is_markov_kernel`,
+  `is_finite_kernel`, `is_s_finite_kernel` and operation is one of `comp_prod`, `map`, `comap`,
+  `comp`, `prod`. These instances state that the three classes are stable by the various operations.
+
+## Notations
+
+* `κ ⊗ₖ η = probability_theory.kernel.comp_prod κ η`
+* `η ∘ₖ κ = probability_theory.kernel.comp η κ`
+* `κ ×ₖ η = probability_theory.kernel.prod κ η`
+
+-/
+
+open measure_theory
+
+open_locale ennreal
+
+namespace probability_theory
+
+namespace kernel
+
+variables {α β ι : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+
+include mα mβ
+
+section composition_product
+
+/-!
+### Composition-Product of kernels
+
+We define a kernel composition-product
+`comp_prod : kernel α β → kernel (α × β) γ → kernel α (β × γ)`.
+-/
+
+variables {γ : Type*} {mγ : measurable_space γ} {s : set (β × γ)}
+
+include mγ
+
+/-- Auxiliary function for the definition of the composition-product of two kernels.
+For all `a : α`, `comp_prod_fun κ η a` is a countably additive function with value zero on the empty
+set, and the composition-product of kernels is defined in `kernel.comp_prod` through
+`measure.of_measurable`. -/
+noncomputable
+def comp_prod_fun (κ : kernel α β) (η : kernel (α × β) γ) (a : α) (s : set (β × γ)) : ℝ≥0∞ :=
+∫⁻ b, η (a, b) {c | (b, c) ∈ s} ∂(κ a)
+
+lemma comp_prod_fun_empty (κ : kernel α β) (η : kernel (α × β) γ) (a : α) :
+  comp_prod_fun κ η a ∅ = 0 :=
+by simp only [comp_prod_fun, set.mem_empty_iff_false, set.set_of_false, measure_empty,
+  measure_theory.lintegral_const, zero_mul]
+
+lemma comp_prod_fun_Union (κ : kernel α β) (η : kernel (α × β) γ) [is_s_finite_kernel η] (a : α)
+  (f : ℕ → set (β × γ)) (hf_meas : ∀ i, measurable_set (f i)) (hf_disj : pairwise (disjoint on f)) :
+  comp_prod_fun κ η a (⋃ i, f i) = ∑' i, comp_prod_fun κ η a (f i) :=
+begin
+  have h_Union : (λ b, η (a, b) {c : γ | (b, c) ∈ ⋃ i, f i})
+    = λ b, η (a,b) (⋃ i, {c : γ | (b, c) ∈ f i}),
+  { ext1 b,
+    congr' with c,
+    simp only [set.mem_Union, set.supr_eq_Union, set.mem_set_of_eq],
+    refl, },
+  rw [comp_prod_fun, h_Union],
+  have h_tsum : (λ b, η (a, b) (⋃ i, {c : γ | (b, c) ∈ f i}))
+    = λ b, ∑' i, η (a, b) {c : γ | (b, c) ∈ f i},
+  { ext1 b,
+    rw measure_Union,
+    { intros i j hij s hsi hsj c hcs,
+      have hbci : {(b, c)} ⊆ f i, by { rw set.singleton_subset_iff, exact hsi hcs, },
+      have hbcj : {(b, c)} ⊆ f j, by { rw set.singleton_subset_iff, exact hsj hcs, },
+      simpa only [set.bot_eq_empty, set.le_eq_subset, set.singleton_subset_iff,
+        set.mem_empty_iff_false] using hf_disj hij hbci hbcj, },
+    { exact λ i, (@measurable_prod_mk_left β γ _ _ b) _ (hf_meas i), }, },
+  rw [h_tsum, lintegral_tsum],
+  { refl, },
+  { intros i,
+    have hm : measurable_set {p : (α × β) × γ | (p.1.2, p.2) ∈ f i},
+      from measurable_fst.snd.prod_mk measurable_snd (hf_meas i),
+    exact ((measurable_kernel_prod_mk_left hm).comp measurable_prod_mk_left).ae_measurable, },
+end
+
+lemma comp_prod_fun_tsum_right (κ : kernel α β) (η : kernel (α × β) γ) [is_s_finite_kernel η]
+  (a : α) (hs : measurable_set s) :
+  comp_prod_fun κ η a s = ∑' n, comp_prod_fun κ (seq η n) a s :=
+begin
+  simp_rw [comp_prod_fun, (measure_sum_seq η _).symm],
+  have : ∫⁻ b, measure.sum (λ n, seq η n (a, b)) {c : γ | (b, c) ∈ s} ∂(κ a)
+    = ∫⁻ b, ∑' n, seq η n (a, b) {c : γ | (b, c) ∈ s} ∂(κ a),
+  { congr',
+    ext1 b,
+    rw measure.sum_apply,
+    exact measurable_prod_mk_left hs, },
+  rw [this, lintegral_tsum (λ n : ℕ, _)],
+  exact ((measurable_kernel_prod_mk_left ((measurable_fst.snd.prod_mk measurable_snd) hs)).comp
+    measurable_prod_mk_left).ae_measurable,
+end
+
+lemma comp_prod_fun_tsum_left (κ : kernel α β) (η : kernel (α × β) γ) [is_s_finite_kernel κ]
+  (a : α) (s : set (β × γ)) :
+  comp_prod_fun κ η a s = ∑' n, comp_prod_fun (seq κ n) η a s :=
+by simp_rw [comp_prod_fun, (measure_sum_seq κ _).symm, lintegral_sum_measure]
+
+lemma comp_prod_fun_eq_tsum (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] (a : α) (hs : measurable_set s) :
+  comp_prod_fun κ η a s = ∑' n m, comp_prod_fun (seq κ n) (seq η m) a s :=
+by simp_rw [comp_prod_fun_tsum_left κ η a s, comp_prod_fun_tsum_right _ η a hs]
+
+/-- Auxiliary lemma for `measurable_comp_prod_fun`. -/
+lemma measurable_comp_prod_fun_of_finite (κ : kernel α β) [is_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_finite_kernel η] (hs : measurable_set s) :
+  measurable (λ a, comp_prod_fun κ η a s) :=
+begin
+  simp only [comp_prod_fun],
+  have h_meas : measurable (function.uncurry (λ a b, η (a, b) {c : γ | (b, c) ∈ s})),
+  { have : function.uncurry (λ a b, η (a, b) {c : γ | (b, c) ∈ s})
+      = λ p, η p {c : γ | (p.2, c) ∈ s},
+    { ext1 p,
+      have hp_eq_mk : p = (p.fst, p.snd) := prod.mk.eta.symm,
+      rw [hp_eq_mk, function.uncurry_apply_pair], },
+    rw this,
+    exact measurable_kernel_prod_mk_left (measurable_fst.snd.prod_mk measurable_snd hs), },
+  exact h_meas.lintegral_kernel_prod_right,
+end
+
+lemma measurable_comp_prod_fun (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] (hs : measurable_set s) :
+  measurable (λ a, comp_prod_fun κ η a s) :=
+begin
+  simp_rw comp_prod_fun_tsum_right κ η _ hs,
+  refine measurable.ennreal_tsum (λ n, _),
+  simp only [comp_prod_fun],
+  have h_meas : measurable (function.uncurry (λ a b, seq η n (a, b) {c : γ | (b, c) ∈ s})),
+  { have : function.uncurry (λ a b, seq η n (a, b) {c : γ | (b, c) ∈ s})
+      = λ p, seq η n p {c : γ | (p.2, c) ∈ s},
+    { ext1 p,
+      have hp_eq_mk : p = (p.fst, p.snd) := prod.mk.eta.symm,
+      rw [hp_eq_mk, function.uncurry_apply_pair], },
+    rw this,
+    exact measurable_kernel_prod_mk_left (measurable_fst.snd.prod_mk measurable_snd hs), },
+  exact h_meas.lintegral_kernel_prod_right,
+end
+
+/-- Composition-Product of kernels. It verifies
+`∫⁻ bc, f bc ∂(comp_prod κ η a) = ∫⁻ b, ∫⁻ c, f (b, c) ∂(η (a, b)) ∂(κ a)`
+(see `lintegral_comp_prod`). -/
+noncomputable
+def comp_prod (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] :
+  kernel α (β × γ) :=
+{ val := λ a, measure.of_measurable (λ s hs, comp_prod_fun κ η a s) (comp_prod_fun_empty κ η a)
+    (comp_prod_fun_Union κ η a),
+  property :=
+  begin
+    refine measure.measurable_of_measurable_coe _ (λ s hs, _),
+    have : (λ a, measure.of_measurable (λ s hs, comp_prod_fun κ η a s) (comp_prod_fun_empty κ η a)
+        (comp_prod_fun_Union κ η a) s) = λ a, comp_prod_fun κ η a s,
+    { ext1 a, rwa measure.of_measurable_apply, },
+    rw this,
+    exact measurable_comp_prod_fun κ η hs,
+  end, }
+
+localized "infix (name := kernel.comp_prod) ` ⊗ₖ `:100 := probability_theory.kernel.comp_prod" in
+  probability_theory
+
+lemma comp_prod_apply_eq_comp_prod_fun (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] (a : α) (hs : measurable_set s) :
+  (κ ⊗ₖ η) a s = comp_prod_fun κ η a s :=
+begin
+  rw [comp_prod],
+  change measure.of_measurable (λ s hs, comp_prod_fun κ η a s) (comp_prod_fun_empty κ η a)
+    (comp_prod_fun_Union κ η a) s = ∫⁻ b, η (a, b) {c | (b, c) ∈ s} ∂(κ a),
+  rw measure.of_measurable_apply _ hs,
+  refl,
+end
+
+lemma comp_prod_apply (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) (hs : measurable_set s) :
+  (κ ⊗ₖ η) a s = ∫⁻ b, η (a, b) {c | (b, c) ∈ s} ∂(κ a) :=
+comp_prod_apply_eq_comp_prod_fun κ η a hs
+
+lemma le_comp_prod_apply (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) (s : set (β × γ)) :
+  ∫⁻ b, η (a, b) {c | (b, c) ∈ s} ∂(κ a) ≤ (κ ⊗ₖ η) a s :=
+calc ∫⁻ b, η (a, b) {c | (b, c) ∈ s} ∂(κ a)
+    ≤ ∫⁻ b, η (a, b) {c | (b, c) ∈ (to_measurable ((κ ⊗ₖ η) a) s)} ∂(κ a) :
+      lintegral_mono (λ b, measure_mono (λ _ h_mem, subset_to_measurable _ _ h_mem))
+... = (κ ⊗ₖ η) a (to_measurable ((κ ⊗ₖ η) a) s) :
+      (kernel.comp_prod_apply_eq_comp_prod_fun κ η a (measurable_set_to_measurable _ _)).symm
+... = (κ ⊗ₖ η) a s : measure_to_measurable s
+
+section ae
+/-! ### `ae` filter of the composition-product -/
+
+variables {κ : kernel α β} [is_s_finite_kernel κ] {η : kernel (α × β) γ} [is_s_finite_kernel η]
+  {a : α}
+
+lemma ae_kernel_lt_top (a : α) (h2s : (κ ⊗ₖ η) a s ≠ ∞) :
+  ∀ᵐ b ∂(κ a), η (a, b) (prod.mk b ⁻¹' s) < ∞ :=
+begin
+  let t := to_measurable ((κ ⊗ₖ η) a) s,
+  have : ∀ (b : β), η (a, b) (prod.mk b ⁻¹' s) ≤ η (a, b) (prod.mk b ⁻¹' t),
+  { exact λ b, measure_mono (set.preimage_mono (subset_to_measurable _ _)), },
+  have ht : measurable_set t := measurable_set_to_measurable _ _,
+  have h2t : (κ ⊗ₖ η) a t ≠ ∞, by rwa measure_to_measurable,
+  have ht_lt_top : ∀ᵐ b ∂(κ a), η (a, b) (prod.mk b ⁻¹' t) < ∞,
+  { rw kernel.comp_prod_apply _ _ _ ht at h2t,
+    exact ae_lt_top (kernel.measurable_kernel_prod_mk_left' ht a) h2t, },
+  filter_upwards [ht_lt_top] with b hb,
+  exact (this b).trans_lt hb,
+end
+
+lemma comp_prod_null (a : α) (hs : measurable_set s) :
+  (κ ⊗ₖ η) a s = 0 ↔ (λ b, η (a, b) (prod.mk b ⁻¹' s)) =ᵐ[κ a] 0 :=
+begin
+  rw [kernel.comp_prod_apply _ _ _ hs, lintegral_eq_zero_iff],
+  { refl, },
+  { exact kernel.measurable_kernel_prod_mk_left' hs a, },
+end
+
+lemma ae_null_of_comp_prod_null (h : (κ ⊗ₖ η) a s = 0) :
+  (λ b, η (a, b) (prod.mk b ⁻¹' s)) =ᵐ[κ a] 0 :=
+begin
+  obtain ⟨t, hst, mt, ht⟩ := exists_measurable_superset_of_null h,
+  simp_rw [comp_prod_null a mt] at ht,
+  rw [filter.eventually_le_antisymm_iff],
+  exact ⟨filter.eventually_le.trans_eq
+    (filter.eventually_of_forall $ λ x, (measure_mono (set.preimage_mono hst) : _)) ht,
+    filter.eventually_of_forall $ λ x, zero_le _⟩
+end
+
+lemma ae_ae_of_ae_comp_prod {p : β × γ → Prop} (h : ∀ᵐ bc ∂((κ ⊗ₖ η) a), p bc) :
+  ∀ᵐ b ∂(κ a), ∀ᵐ c ∂(η (a, b)), p (b, c) :=
+ae_null_of_comp_prod_null h
+
+end ae
+
+section restrict
+
+variables {κ : kernel α β} [is_s_finite_kernel κ] {η : kernel (α × β) γ} [is_s_finite_kernel η]
+  {a : α}
+
+lemma comp_prod_restrict {s : set β} {t : set γ} (hs : measurable_set s) (ht : measurable_set t) :
+  (kernel.restrict κ hs) ⊗ₖ (kernel.restrict η ht) = kernel.restrict (κ ⊗ₖ η) (hs.prod ht) :=
+begin
+  ext a u hu : 2,
+  rw [comp_prod_apply _ _ _ hu, restrict_apply' _ _ _ hu,
+    comp_prod_apply _ _ _ (hu.inter (hs.prod ht))],
+  simp only [kernel.restrict_apply, measure.restrict_apply' ht, set.mem_inter_iff,
+    set.prod_mk_mem_set_prod_eq],
+  have : ∀ b, η (a, b) {c : γ | (b, c) ∈ u ∧ b ∈ s ∧ c ∈ t}
+    = s.indicator (λ b, η (a, b) ({c : γ | (b, c) ∈ u} ∩ t)) b,
+  { intro b,
+    classical,
+    rw set.indicator_apply,
+    split_ifs with h,
+    { simp only [h, true_and],
+      refl, },
+    { simp only [h, false_and, and_false, set.set_of_false, measure_empty], }, },
+  simp_rw this,
+  rw lintegral_indicator _ hs,
+end
+
+lemma comp_prod_restrict_left {s : set β} (hs : measurable_set s) :
+  (kernel.restrict κ hs) ⊗ₖ η = kernel.restrict (κ ⊗ₖ η) (hs.prod measurable_set.univ) :=
+by { rw ← comp_prod_restrict, congr, exact kernel.restrict_univ.symm, }
+
+lemma comp_prod_restrict_right {t : set γ} (ht : measurable_set t) :
+  κ ⊗ₖ (kernel.restrict η ht) = kernel.restrict (κ ⊗ₖ η) (measurable_set.univ.prod ht) :=
+by { rw ← comp_prod_restrict, congr, exact kernel.restrict_univ.symm, }
+
+end restrict
+
+section lintegral
+/-! ### Lebesgue integral -/
+
+/-- Lebesgue integral against the composition-product of two kernels. -/
+theorem lintegral_comp_prod' (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) {f : β → γ → ℝ≥0∞} (hf : measurable (function.uncurry f)) :
+  ∫⁻ bc, f bc.1 bc.2 ∂((κ ⊗ₖ η) a) = ∫⁻ b, ∫⁻ c, f b c ∂(η (a, b)) ∂(κ a) :=
+begin
+  let F : ℕ → simple_func (β × γ) ℝ≥0∞ := simple_func.eapprox (function.uncurry f),
+  have h : ∀ a, (⨆ n, F n a) = function.uncurry f a,
+    from simple_func.supr_eapprox_apply (function.uncurry f) hf,
+  simp only [prod.forall, function.uncurry_apply_pair] at h,
+  simp_rw [← h, prod.mk.eta],
+  have h_mono : monotone F := λ i j hij b, simple_func.monotone_eapprox (function.uncurry f) hij _,
+  rw lintegral_supr (λ n, (F n).measurable) h_mono,
+  have : ∀ b, ∫⁻ c, (⨆ n, F n (b, c)) ∂(η (a, b)) = ⨆ n, ∫⁻ c, F n (b, c) ∂(η (a, b)),
+  { intro a,
+    rw lintegral_supr,
+    { exact λ n, (F n).measurable.comp measurable_prod_mk_left, },
+    { exact λ i j hij b, h_mono hij _, }, },
+  simp_rw this,
+  have h_some_meas_integral : ∀ f' : simple_func (β × γ) ℝ≥0∞,
+    measurable (λ b, ∫⁻ c, f' (b, c) ∂(η (a, b))),
+  { intros f',
+    have : (λ b, ∫⁻ c, f' (b, c) ∂(η (a, b)))
+        = (λ ab, ∫⁻ c, f' (ab.2, c) ∂(η (ab))) ∘ (λ b, (a, b)),
+      { ext1 ab, refl, },
+      rw this,
+      refine measurable.comp _ measurable_prod_mk_left,
+      exact (measurable.lintegral_kernel_prod_right
+        ((simple_func.measurable _).comp (measurable_fst.snd.prod_mk measurable_snd))), },
+  rw lintegral_supr,
+  rotate,
+  { exact λ n, h_some_meas_integral (F n), },
+  { exact λ i j hij b, lintegral_mono (λ c, h_mono hij _), },
+  congr,
+  ext1 n,
+  refine simple_func.induction _ _ (F n),
+  { intros c s hs,
+    simp only [simple_func.const_zero, simple_func.coe_piecewise, simple_func.coe_const,
+      simple_func.coe_zero, set.piecewise_eq_indicator, lintegral_indicator_const hs],
+    rw [comp_prod_apply κ η _ hs, ← lintegral_const_mul c _],
+    swap, { exact (measurable_kernel_prod_mk_left
+      ((measurable_fst.snd.prod_mk measurable_snd) hs)).comp measurable_prod_mk_left, },
+    congr,
+    ext1 b,
+    rw lintegral_indicator_const_comp measurable_prod_mk_left hs,
+    refl, },
+  { intros f f' h_disj hf_eq hf'_eq,
+    simp_rw [simple_func.coe_add, pi.add_apply],
+    change ∫⁻ x, ((f : (β × γ) → ℝ≥0∞) x + f' x) ∂((κ ⊗ₖ η) a)
+      = ∫⁻ b, ∫⁻ (c : γ), f (b, c) + f' (b, c) ∂(η (a, b)) ∂(κ a),
+    rw [lintegral_add_left (simple_func.measurable _), hf_eq, hf'_eq, ← lintegral_add_left],
+    swap, { exact h_some_meas_integral f, },
+    congr' with b,
+    rw ← lintegral_add_left ((simple_func.measurable _).comp measurable_prod_mk_left), },
+end
+
+/-- Lebesgue integral against the composition-product of two kernels. -/
+theorem lintegral_comp_prod (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) {f : β × γ → ℝ≥0∞} (hf : measurable f) :
+  ∫⁻ bc, f bc ∂((κ ⊗ₖ η) a) = ∫⁻ b, ∫⁻ c, f (b, c) ∂(η (a, b)) ∂(κ a) :=
+begin
+  let g := function.curry f,
+  change ∫⁻ bc, f bc ∂((κ ⊗ₖ η) a) = ∫⁻ b, ∫⁻ c, g b c ∂(η (a, b)) ∂(κ a),
+  rw ← lintegral_comp_prod',
+  { simp_rw [g, function.curry_apply, prod.mk.eta], },
+  { simp_rw [g, function.uncurry_curry], exact hf, },
+end
+
+/-- Lebesgue integral against the composition-product of two kernels. -/
+lemma lintegral_comp_prod₀ (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) {f : β × γ → ℝ≥0∞} (hf : ae_measurable f ((κ ⊗ₖ η) a)) :
+  ∫⁻ z, f z ∂((κ ⊗ₖ η) a) = ∫⁻ x, ∫⁻ y, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+begin
+  have A : ∫⁻ z, f z ∂((κ ⊗ₖ η) a) = ∫⁻ z, hf.mk f z ∂((κ ⊗ₖ η) a) :=
+    lintegral_congr_ae hf.ae_eq_mk,
+  have B : ∫⁻ x, ∫⁻ y, f (x, y) ∂(η (a, x)) ∂(κ a) = ∫⁻ x, ∫⁻ y, hf.mk f (x, y) ∂(η (a, x)) ∂(κ a),
+  { apply lintegral_congr_ae,
+    filter_upwards [ae_ae_of_ae_comp_prod hf.ae_eq_mk] with _ ha using lintegral_congr_ae ha, },
+  rw [A, B, lintegral_comp_prod],
+  exact hf.measurable_mk,
+end
+
+lemma set_lintegral_comp_prod (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) {f : β × γ → ℝ≥0∞} (hf : measurable f)
+  {s : set β} {t : set γ} (hs : measurable_set s) (ht : measurable_set t) :
+  ∫⁻ z in s ×ˢ t, f z ∂((κ ⊗ₖ η) a) = ∫⁻ x in s, ∫⁻ y in t, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+by simp_rw [← kernel.restrict_apply (κ ⊗ₖ η) (hs.prod ht), ← comp_prod_restrict,
+    lintegral_comp_prod _ _ _ hf, kernel.restrict_apply]
+
+lemma set_lintegral_comp_prod_univ_right (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] (a : α) {f : β × γ → ℝ≥0∞} (hf : measurable f)
+  {s : set β} (hs : measurable_set s) :
+  ∫⁻ z in s ×ˢ set.univ, f z ∂((κ ⊗ₖ η) a) = ∫⁻ x in s, ∫⁻ y, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+by simp_rw [set_lintegral_comp_prod κ η a hf hs measurable_set.univ, measure.restrict_univ]
+
+lemma set_lintegral_comp_prod_univ_left (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] (a : α) {f : β × γ → ℝ≥0∞} (hf : measurable f)
+  {t : set γ} (ht : measurable_set t) :
+  ∫⁻ z in set.univ ×ˢ t, f z ∂((κ ⊗ₖ η) a) = ∫⁻ x, ∫⁻ y in t, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+by simp_rw [set_lintegral_comp_prod κ η a hf measurable_set.univ ht, measure.restrict_univ]
+
+end lintegral
+
+lemma comp_prod_eq_tsum_comp_prod (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel (α × β) γ)
+  [is_s_finite_kernel η] (a : α) (hs : measurable_set s) :
+  (κ ⊗ₖ η) a s = ∑' (n m : ℕ), (seq κ n ⊗ₖ seq η m) a s :=
+by { simp_rw comp_prod_apply_eq_comp_prod_fun _ _ _ hs, exact comp_prod_fun_eq_tsum κ η a hs, }
+
+lemma comp_prod_eq_sum_comp_prod (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] :
+  κ ⊗ₖ η = kernel.sum (λ n, kernel.sum (λ m, seq κ n ⊗ₖ seq η m)) :=
+by { ext a s hs : 2, simp_rw [kernel.sum_apply' _ a hs], rw comp_prod_eq_tsum_comp_prod κ η a hs, }
+
+lemma comp_prod_eq_sum_comp_prod_left (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] :
+  κ ⊗ₖ η = kernel.sum (λ n, seq κ n ⊗ₖ η) :=
+begin
+  rw comp_prod_eq_sum_comp_prod,
+  congr' with n a s hs,
+  simp_rw [kernel.sum_apply' _ _ hs, comp_prod_apply_eq_comp_prod_fun _ _ _ hs,
+    comp_prod_fun_tsum_right _ η a hs],
+end
+
+lemma comp_prod_eq_sum_comp_prod_right (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] :
+  κ ⊗ₖ η = kernel.sum (λ n, κ ⊗ₖ seq η n) :=
+begin
+  rw comp_prod_eq_sum_comp_prod,
+  simp_rw comp_prod_eq_sum_comp_prod_left κ _,
+  rw kernel.sum_comm,
+end
+
+instance is_markov_kernel.comp_prod (κ : kernel α β) [is_markov_kernel κ]
+  (η : kernel (α × β) γ) [is_markov_kernel η] :
+  is_markov_kernel (κ ⊗ₖ η) :=
+⟨λ a, ⟨begin
+  rw comp_prod_apply κ η a measurable_set.univ,
+  simp only [set.mem_univ, set.set_of_true, measure_univ, lintegral_one],
+end⟩⟩
+
+lemma comp_prod_apply_univ_le (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_finite_kernel η] (a : α) :
+  (κ ⊗ₖ η) a set.univ ≤ (κ a set.univ) * (is_finite_kernel.bound η) :=
+begin
+  rw comp_prod_apply κ η a measurable_set.univ,
+  simp only [set.mem_univ, set.set_of_true],
+  let Cη := is_finite_kernel.bound η,
+  calc ∫⁻ b, η (a, b) set.univ ∂(κ a)
+      ≤ ∫⁻ b, Cη ∂(κ a) : lintegral_mono (λ b, measure_le_bound η (a, b) set.univ)
+  ... = Cη * κ a set.univ : measure_theory.lintegral_const Cη
+  ... = κ a set.univ * Cη : mul_comm _ _,
+end
+
+instance is_finite_kernel.comp_prod (κ : kernel α β) [is_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_finite_kernel η] :
+  is_finite_kernel (κ ⊗ₖ η) :=
+⟨⟨is_finite_kernel.bound κ * is_finite_kernel.bound η,
+  ennreal.mul_lt_top (is_finite_kernel.bound_ne_top κ) (is_finite_kernel.bound_ne_top η),
+  λ a, calc (κ ⊗ₖ η) a set.univ
+    ≤ (κ a set.univ) * is_finite_kernel.bound η : comp_prod_apply_univ_le κ η a
+... ≤ is_finite_kernel.bound κ * is_finite_kernel.bound η :
+        mul_le_mul (measure_le_bound κ a set.univ) le_rfl (zero_le _) (zero_le _), ⟩⟩
+
+instance is_s_finite_kernel.comp_prod (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel (α × β) γ) [is_s_finite_kernel η] :
+  is_s_finite_kernel (κ ⊗ₖ η) :=
+begin
+  rw comp_prod_eq_sum_comp_prod,
+  exact kernel.is_s_finite_kernel_sum (λ n, kernel.is_s_finite_kernel_sum infer_instance),
+end
+
+end composition_product
+
+section map_comap
+/-! ### map, comap -/
+
+variables {γ : Type*} {mγ : measurable_space γ} {f : β → γ} {g : γ → α}
+
+include mγ
+
+/-- The pushforward of a kernel along a measurable function.
+We include measurability in the assumptions instead of using junk values
+to make sure that typeclass inference can infer that the `map` of a Markov kernel
+is again a Markov kernel. -/
+noncomputable
+def map (κ : kernel α β) (f : β → γ) (hf : measurable f) : kernel α γ :=
+{ val := λ a, (κ a).map f,
+  property := (measure.measurable_map _ hf).comp (kernel.measurable κ) }
+
+lemma map_apply (κ : kernel α β) (hf : measurable f) (a : α) :
+  map κ f hf a = (κ a).map f := rfl
+
+lemma map_apply' (κ : kernel α β) (hf : measurable f) (a : α) {s : set γ} (hs : measurable_set s) :
+  map κ f hf a s = κ a (f ⁻¹' s) :=
+by rw [map_apply, measure.map_apply hf hs]
+
+lemma lintegral_map (κ : kernel α β) (hf : measurable f) (a : α)
+  {g' : γ → ℝ≥0∞} (hg : measurable g') :
+  ∫⁻ b, g' b ∂(map κ f hf a) = ∫⁻ a, g' (f a) ∂(κ a) :=
+by rw [map_apply _ hf, lintegral_map hg hf]
+
+lemma sum_map_seq (κ : kernel α β) [is_s_finite_kernel κ] (hf : measurable f) :
+  kernel.sum (λ n, map (seq κ n) f hf) = map κ f hf :=
+begin
+  ext a s hs : 2,
+  rw [kernel.sum_apply, map_apply' κ hf a hs, measure.sum_apply _ hs, ← measure_sum_seq κ,
+    measure.sum_apply _ (hf hs)],
+  simp_rw map_apply' _ hf _ hs,
+end
+
+instance is_markov_kernel.map (κ : kernel α β) [is_markov_kernel κ] (hf : measurable f) :
+  is_markov_kernel (map κ f hf) :=
+ ⟨λ a, ⟨by rw [map_apply' κ hf a measurable_set.univ, set.preimage_univ, measure_univ]⟩⟩
+
+instance is_finite_kernel.map (κ : kernel α β) [is_finite_kernel κ] (hf : measurable f) :
+  is_finite_kernel (map κ f hf) :=
+begin
+  refine ⟨⟨is_finite_kernel.bound κ, is_finite_kernel.bound_lt_top κ, λ a, _⟩⟩,
+  rw map_apply' κ hf a measurable_set.univ,
+  exact measure_le_bound κ a _,
+end
+
+instance is_s_finite_kernel.map (κ : kernel α β) [is_s_finite_kernel κ] (hf : measurable f) :
+  is_s_finite_kernel (map κ f hf) :=
+⟨⟨λ n, map (seq κ n) f hf, infer_instance, (sum_map_seq κ hf).symm⟩⟩
+
+/-- Pullback of a kernel, such that for each set s `comap κ g hg c s = κ (g c) s`.
+We include measurability in the assumptions instead of using junk values
+to make sure that typeclass inference can infer that the `comap` of a Markov kernel
+is again a Markov kernel. -/
+def comap (κ : kernel α β) (g : γ → α) (hg : measurable g) : kernel γ β :=
+{ val := λ a, κ (g a),
+  property := (kernel.measurable κ).comp hg }
+
+lemma comap_apply (κ : kernel α β) (hg : measurable g) (c : γ) :
+  comap κ g hg c = κ (g c) := rfl
+
+lemma comap_apply' (κ : kernel α β) (hg : measurable g) (c : γ) (s : set β) :
+  comap κ g hg c s = κ (g c) s := rfl
+
+lemma lintegral_comap (κ : kernel α β) (hg : measurable g) (c : γ) (g' : β → ℝ≥0∞) :
+  ∫⁻ b, g' b ∂(comap κ g hg c) = ∫⁻ b, g' b ∂(κ (g c)) := rfl
+
+lemma sum_comap_seq (κ : kernel α β) [is_s_finite_kernel κ] (hg : measurable g) :
+  kernel.sum (λ n, comap (seq κ n) g hg) = comap κ g hg :=
+begin
+  ext a s hs : 2,
+  rw [kernel.sum_apply, comap_apply' κ hg a s, measure.sum_apply _ hs, ← measure_sum_seq κ,
+    measure.sum_apply _ hs],
+  simp_rw comap_apply' _ hg _ s,
+end
+
+instance is_markov_kernel.comap (κ : kernel α β) [is_markov_kernel κ] (hg : measurable g) :
+  is_markov_kernel (comap κ g hg) :=
+⟨λ a, ⟨by rw [comap_apply' κ hg a set.univ, measure_univ]⟩⟩
+
+instance is_finite_kernel.comap (κ : kernel α β) [is_finite_kernel κ] (hg : measurable g) :
+  is_finite_kernel (comap κ g hg) :=
+begin
+  refine ⟨⟨is_finite_kernel.bound κ, is_finite_kernel.bound_lt_top κ, λ a, _⟩⟩,
+  rw comap_apply' κ hg a set.univ,
+  exact measure_le_bound κ _ _,
+end
+
+instance is_s_finite_kernel.comap (κ : kernel α β) [is_s_finite_kernel κ] (hg : measurable g) :
+  is_s_finite_kernel (comap κ g hg) :=
+⟨⟨λ n, comap (seq κ n) g hg, infer_instance, (sum_comap_seq κ hg).symm⟩⟩
+
+end map_comap
+
+open_locale probability_theory
+
+section fst_snd
+
+/-- Define a `kernel (γ × α) β` from a `kernel α β` by taking the comap of the projection. -/
+def prod_mk_left (γ : Type*) [measurable_space γ] (κ : kernel α β) : kernel (γ × α) β :=
+comap κ prod.snd measurable_snd
+
+variables {γ : Type*} {mγ : measurable_space γ} {f : β → γ} {g : γ → α}
+
+include mγ
+
+lemma prod_mk_left_apply (κ : kernel α β) (ca : γ × α) :
+  prod_mk_left γ κ ca = κ ca.snd := rfl
+
+lemma prod_mk_left_apply' (κ : kernel α β) (ca : γ × α) (s : set β) :
+  prod_mk_left γ κ ca s = κ ca.snd s := rfl
+
+lemma lintegral_prod_mk_left (κ : kernel α β) (ca : γ × α) (g : β → ℝ≥0∞) :
+  ∫⁻ b, g b ∂(prod_mk_left γ κ ca) = ∫⁻ b, g b ∂(κ ca.snd) := rfl
+
+instance is_markov_kernel.prod_mk_left (κ : kernel α β) [is_markov_kernel κ] :
+  is_markov_kernel (prod_mk_left γ κ) :=
+by { rw prod_mk_left, apply_instance, }
+
+instance is_finite_kernel.prod_mk_left (κ : kernel α β) [is_finite_kernel κ] :
+  is_finite_kernel (prod_mk_left γ κ) :=
+by { rw prod_mk_left, apply_instance, }
+
+instance is_s_finite_kernel.prod_mk_left (κ : kernel α β) [is_s_finite_kernel κ] :
+  is_s_finite_kernel (prod_mk_left γ κ) :=
+by { rw prod_mk_left, apply_instance, }
+
+/-- Define a `kernel (β × α) γ` from a `kernel (α × β) γ` by taking the comap of `prod.swap`. -/
+def swap_left (κ : kernel (α × β) γ) : kernel (β × α) γ :=
+comap κ prod.swap measurable_swap
+
+lemma swap_left_apply (κ : kernel (α × β) γ) (a : β × α) :
+  swap_left κ a = (κ a.swap) := rfl
+
+lemma swap_left_apply' (κ : kernel (α × β) γ) (a : β × α) (s : set γ) :
+  swap_left κ a s = κ a.swap s := rfl
+
+lemma lintegral_swap_left (κ : kernel (α × β) γ) (a : β × α) (g : γ → ℝ≥0∞) :
+  ∫⁻ c, g c ∂(swap_left κ a) = ∫⁻ c, g c ∂(κ a.swap) :=
+by { rw [swap_left, lintegral_comap _ measurable_swap a], }
+
+instance is_markov_kernel.swap_left (κ : kernel (α × β) γ) [is_markov_kernel κ] :
+  is_markov_kernel (swap_left κ) :=
+by { rw swap_left, apply_instance, }
+
+instance is_finite_kernel.swap_left (κ : kernel (α × β) γ) [is_finite_kernel κ] :
+  is_finite_kernel (swap_left κ) :=
+by { rw swap_left, apply_instance, }
+
+instance is_s_finite_kernel.swap_left (κ : kernel (α × β) γ) [is_s_finite_kernel κ] :
+  is_s_finite_kernel (swap_left κ) :=
+by { rw swap_left, apply_instance, }
+
+/-- Define a `kernel α (γ × β)` from a `kernel α (β × γ)` by taking the map of `prod.swap`. -/
+noncomputable
+def swap_right (κ : kernel α (β × γ)) : kernel α (γ × β) :=
+map κ prod.swap measurable_swap
+
+lemma swap_right_apply (κ : kernel α (β × γ)) (a : α) :
+  swap_right κ a = (κ a).map prod.swap := rfl
+
+lemma swap_right_apply' (κ : kernel α (β × γ)) (a : α) {s : set (γ × β)} (hs : measurable_set s) :
+  swap_right κ a s = κ a {p | p.swap ∈ s} :=
+by { rw [swap_right_apply, measure.map_apply measurable_swap hs], refl, }
+
+lemma lintegral_swap_right (κ : kernel α (β × γ)) (a : α) {g : γ × β → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ c, g c ∂(swap_right κ a) = ∫⁻ (bc : β × γ), g bc.swap ∂(κ a) :=
+by rw [swap_right, lintegral_map _ measurable_swap a hg]
+
+instance is_markov_kernel.swap_right (κ : kernel α (β × γ)) [is_markov_kernel κ] :
+  is_markov_kernel (swap_right κ) :=
+by { rw swap_right, apply_instance, }
+
+instance is_finite_kernel.swap_right (κ : kernel α (β × γ)) [is_finite_kernel κ] :
+  is_finite_kernel (swap_right κ) :=
+by { rw swap_right, apply_instance, }
+
+instance is_s_finite_kernel.swap_right (κ : kernel α (β × γ)) [is_s_finite_kernel κ] :
+  is_s_finite_kernel (swap_right κ) :=
+by { rw swap_right, apply_instance, }
+
+/-- Define a `kernel α β` from a `kernel α (β × γ)` by taking the map of the first projection. -/
+noncomputable
+def fst (κ : kernel α (β × γ)) : kernel α β :=
+map κ prod.fst measurable_fst
+
+lemma fst_apply (κ : kernel α (β × γ)) (a : α) :
+  fst κ a = (κ a).map prod.fst := rfl
+
+lemma fst_apply' (κ : kernel α (β × γ)) (a : α) {s : set β} (hs : measurable_set s) :
+  fst κ a s = κ a {p | p.1 ∈ s} :=
+by { rw [fst_apply, measure.map_apply measurable_fst hs], refl, }
+
+lemma lintegral_fst (κ : kernel α (β × γ)) (a : α) {g : β → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ c, g c ∂(fst κ a) = ∫⁻ (bc : β × γ), g bc.fst ∂(κ a) :=
+by rw [fst, lintegral_map _ measurable_fst a hg]
+
+instance is_markov_kernel.fst (κ : kernel α (β × γ)) [is_markov_kernel κ] :
+  is_markov_kernel (fst κ) :=
+by { rw fst, apply_instance, }
+
+instance is_finite_kernel.fst (κ : kernel α (β × γ)) [is_finite_kernel κ] :
+  is_finite_kernel (fst κ) :=
+by { rw fst, apply_instance, }
+
+instance is_s_finite_kernel.fst (κ : kernel α (β × γ)) [is_s_finite_kernel κ] :
+  is_s_finite_kernel (fst κ) :=
+by { rw fst, apply_instance, }
+
+/-- Define a `kernel α γ` from a `kernel α (β × γ)` by taking the map of the second projection. -/
+noncomputable
+def snd (κ : kernel α (β × γ)) : kernel α γ :=
+map κ prod.snd measurable_snd
+
+lemma snd_apply (κ : kernel α (β × γ)) (a : α) :
+  snd κ a = (κ a).map prod.snd := rfl
+
+lemma snd_apply' (κ : kernel α (β × γ)) (a : α) {s : set γ} (hs : measurable_set s) :
+  snd κ a s = κ a {p | p.2 ∈ s} :=
+by { rw [snd_apply, measure.map_apply measurable_snd hs], refl, }
+
+lemma lintegral_snd (κ : kernel α (β × γ)) (a : α) {g : γ → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ c, g c ∂(snd κ a) = ∫⁻ (bc : β × γ), g bc.snd ∂(κ a) :=
+by rw [snd, lintegral_map _ measurable_snd a hg]
+
+instance is_markov_kernel.snd (κ : kernel α (β × γ)) [is_markov_kernel κ] :
+  is_markov_kernel (snd κ) :=
+by { rw snd, apply_instance, }
+
+instance is_finite_kernel.snd (κ : kernel α (β × γ)) [is_finite_kernel κ] :
+  is_finite_kernel (snd κ) :=
+by { rw snd, apply_instance, }
+
+instance is_s_finite_kernel.snd (κ : kernel α (β × γ)) [is_s_finite_kernel κ] :
+  is_s_finite_kernel (snd κ) :=
+by { rw snd, apply_instance, }
+
+end fst_snd
+
+section comp
+/-! ### Composition of two kernels -/
+
+variables {γ : Type*} {mγ : measurable_space γ} {f : β → γ} {g : γ → α}
+
+include mγ
+
+/-- Composition of two s-finite kernels. -/
+noncomputable
+def comp (η : kernel β γ) (κ : kernel α β) : kernel α γ :=
+{ val := λ a, (κ a).bind η,
+  property := (measure.measurable_bind' (kernel.measurable _)).comp (kernel.measurable _) }
+
+localized "infix (name := kernel.comp) ` ∘ₖ `:100 := probability_theory.kernel.comp" in
+  probability_theory
+
+lemma comp_apply (η : kernel β γ) (κ : kernel α β) (a : α) :
+  (η ∘ₖ κ) a = (κ a).bind η := rfl
+
+lemma comp_apply' (η : kernel β γ) (κ : kernel α β) (a : α) {s : set γ} (hs : measurable_set s) :
+  (η ∘ₖ κ) a s = ∫⁻ b, η b s ∂(κ a) :=
+by rw [comp_apply, measure.bind_apply hs (kernel.measurable _)]
+
+lemma comp_eq_snd_comp_prod (η : kernel β γ) [is_s_finite_kernel η]
+  (κ : kernel α β) [is_s_finite_kernel κ] :
+  η ∘ₖ κ = snd (κ ⊗ₖ prod_mk_left α η) :=
+begin
+  ext a s hs : 2,
+  rw [comp_apply' _ _ _ hs, snd_apply' _ _ hs, comp_prod_apply],
+  swap, { exact measurable_snd hs, },
+  simp only [set.mem_set_of_eq, set.set_of_mem_eq, prod_mk_left_apply' _ _ s],
+end
+
+lemma lintegral_comp (η : kernel β γ) (κ : kernel α β)
+  (a : α) {g : γ → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ c, g c ∂((η ∘ₖ κ) a) = ∫⁻ b, ∫⁻ c, g c ∂(η b) ∂(κ a) :=
+by rw [comp_apply, measure.lintegral_bind (kernel.measurable _) hg]
+
+instance is_markov_kernel.comp (η : kernel β γ) [is_markov_kernel η]
+  (κ : kernel α β) [is_markov_kernel κ] :
+  is_markov_kernel (η ∘ₖ κ) :=
+by { rw comp_eq_snd_comp_prod, apply_instance, }
+
+instance is_finite_kernel.comp (η : kernel β γ) [is_finite_kernel η]
+  (κ : kernel α β) [is_finite_kernel κ] :
+  is_finite_kernel (η ∘ₖ κ) :=
+by { rw comp_eq_snd_comp_prod, apply_instance, }
+
+instance is_s_finite_kernel.comp (η : kernel β γ) [is_s_finite_kernel η]
+  (κ : kernel α β) [is_s_finite_kernel κ] :
+  is_s_finite_kernel (η ∘ₖ κ) :=
+by { rw comp_eq_snd_comp_prod, apply_instance, }
+
+/-- Composition of kernels is associative. -/
+lemma comp_assoc {δ : Type*} {mδ : measurable_space δ} (ξ : kernel γ δ) [is_s_finite_kernel ξ]
+  (η : kernel β γ) (κ : kernel α β) :
+  (ξ ∘ₖ η ∘ₖ κ) = ξ ∘ₖ (η ∘ₖ κ) :=
+begin
+  refine ext_fun (λ a f hf, _),
+  simp_rw [lintegral_comp _ _ _ hf, lintegral_comp _ _ _ hf.lintegral_kernel],
+end
+
+lemma deterministic_comp_eq_map (hf : measurable f) (κ : kernel α β) :
+  (deterministic f hf ∘ₖ κ) = map κ f hf :=
+begin
+  ext a s hs : 2,
+  simp_rw [map_apply' _ _ _ hs, comp_apply' _ _ _ hs, deterministic_apply' hf _ hs,
+    lintegral_indicator_const_comp hf hs, one_mul],
+end
+
+lemma comp_deterministic_eq_comap (κ : kernel α β) (hg : measurable g) :
+  (κ ∘ₖ deterministic g hg) = comap κ g hg :=
+begin
+  ext a s hs : 2,
+  simp_rw [comap_apply' _ _ _ s, comp_apply' _ _ _ hs, deterministic_apply hg a,
+    lintegral_dirac' _ (kernel.measurable_coe κ hs)],
+end
+
+end comp
+
+section prod
+
+/-! ### Product of two kernels -/
+
+variables {γ : Type*} {mγ : measurable_space γ}
+
+include mγ
+
+/-- Product of two s-finite kernels. -/
+noncomputable
+def prod (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel α γ) [is_s_finite_kernel η] :
+  kernel α (β × γ) :=
+κ ⊗ₖ (swap_left (prod_mk_left β η))
+
+localized "infix (name := kernel.prod) ` ×ₖ `:100 := probability_theory.kernel.prod" in
+  probability_theory
+
+lemma prod_apply (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel α γ) [is_s_finite_kernel η]
+  (a : α) {s : set (β × γ)} (hs : measurable_set s) :
+  (κ ×ₖ η) a s = ∫⁻ (b : β), (η a) {c : γ | (b, c) ∈ s} ∂(κ a) :=
+by simp_rw [prod, comp_prod_apply _ _ _ hs, swap_left_apply _ _, prod_mk_left_apply,
+  prod.swap_prod_mk]
+
+lemma lintegral_prod (κ : kernel α β) [is_s_finite_kernel κ] (η : kernel α γ) [is_s_finite_kernel η]
+  (a : α) {g : (β × γ) → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ c, g c ∂((κ ×ₖ η) a) = ∫⁻ b, ∫⁻ c, g (b, c) ∂(η a) ∂(κ a) :=
+by simp_rw [prod, lintegral_comp_prod _ _ _ hg, swap_left_apply, prod_mk_left_apply,
+  prod.swap_prod_mk]
+
+instance is_markov_kernel.prod (κ : kernel α β) [is_markov_kernel κ]
+  (η : kernel α γ) [is_markov_kernel η] :
+  is_markov_kernel (κ ×ₖ η) :=
+by { rw prod, apply_instance, }
+
+instance is_finite_kernel.prod (κ : kernel α β) [is_finite_kernel κ]
+  (η : kernel α γ) [is_finite_kernel η] :
+  is_finite_kernel (κ ×ₖ η) :=
+by { rw prod, apply_instance, }
+
+instance is_s_finite_kernel.prod (κ : kernel α β) [is_s_finite_kernel κ]
+  (η : kernel α γ) [is_s_finite_kernel η] :
+  is_s_finite_kernel (κ ×ₖ η) :=
+by { rw prod, apply_instance, }
+
+end prod
+
+end kernel
+
+end probability_theory
diff --git a/src/probability/kernel/cond_cdf.lean b/src/probability/kernel/cond_cdf.lean
new file mode 100644
index 0000000000000..6a8170f2918d8
--- /dev/null
+++ b/src/probability/kernel/cond_cdf.lean
@@ -0,0 +1,1017 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import measure_theory.measure.stieltjes
+import probability.kernel.composition
+import measure_theory.decomposition.radon_nikodym
+
+/-!
+# Conditional cumulative distribution function
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given `ρ : measure (α × ℝ)`, we define the conditional cumulative distribution function
+(conditional cdf) of `ρ`. It is a function `cond_cdf ρ : α → ℝ → ℝ` such that if `ρ` is a finite
+measure, then for all `a : α` `cond_cdf ρ a` is monotone and right-continuous with limit 0 at -∞
+and limit 1 at +∞, and such that for all `x : ℝ`, `a ↦ cond_cdf ρ a x` is measurable. For all
+`x : ℝ` and measurable set `s`, that function satisfies
+`∫⁻ a in s, ennreal.of_real (cond_cdf ρ a x) ∂ρ.fst = ρ (s ×ˢ Iic x)`.
+
+## Main definitions
+
+* `probability_theory.cond_cdf ρ : α → stieltjes_function`: the conditional cdf of
+  `ρ : measure (α × ℝ)`. A `stieltjes_function` is a function `ℝ → ℝ` which is monotone and
+  right-continuous.
+
+## Main statements
+
+* `probability_theory.set_lintegral_cond_cdf`: for all `a : α` and `x : ℝ`, all measurable set `s`,
+  `∫⁻ a in s, ennreal.of_real (cond_cdf ρ a x) ∂ρ.fst = ρ (s ×ˢ Iic x)`.
+
+## References
+
+The construction of the conditional cdf in this file follows the proof of Theorem 3.4 in
+[O. Kallenberg, Foundations of modern probability][kallenberg2021].
+
+## TODO
+
+* The conditional cdf can be used to define the cdf of a real measure by using the
+  conditional cdf of `(measure.dirac unit.star).prod μ : measure (unit × ℝ)`.
+
+-/
+
+open measure_theory set filter topological_space
+
+open_locale nnreal ennreal measure_theory topology probability_theory
+
+section aux_lemmas_to_be_moved
+
+variables {α β ι : Type*}
+
+namespace directed
+-- todo after the port: move this to logic.encodable.basic near sequence_mono
+variables [encodable α] [inhabited α] [preorder β] {f : α → β} (hf : directed (≥) f)
+
+lemma sequence_anti : antitone (f ∘ (hf.sequence f)) :=
+antitone_nat_of_succ_le $ hf.sequence_mono_nat
+
+lemma sequence_le (a : α) : f (hf.sequence f (encodable.encode a + 1)) ≤ f a :=
+hf.rel_sequence a
+
+end directed
+
+-- todo: move to data/set/lattice next to prod_Union or prod_sInter
+lemma prod_Inter {s : set α} {t : ι → set β} [hι : nonempty ι] :
+  s ×ˢ (⋂ i, t i) = ⋂ i, s ×ˢ (t i) :=
+begin
+  ext x,
+  simp only [mem_prod, mem_Inter],
+  exact ⟨λ h i, ⟨h.1, h.2 i⟩, λ h, ⟨(h hι.some).1, λ i, (h i).2⟩⟩,
+end
+
+lemma real.Union_Iic_rat : (⋃ r : ℚ, Iic (r : ℝ)) = univ :=
+begin
+  ext1,
+  simp only [mem_Union, mem_Iic, mem_univ, iff_true],
+  obtain ⟨r, hr⟩ := exists_rat_gt x,
+  exact ⟨r, hr.le⟩,
+end
+
+lemma real.Inter_Iic_rat : (⋂ r : ℚ, Iic (r : ℝ)) = ∅ :=
+begin
+  ext1,
+  simp only [mem_Inter, mem_Iic, mem_empty_iff_false, iff_false, not_forall, not_le],
+  exact exists_rat_lt x,
+end
+
+-- todo after the port: move to order/filter/at_top_bot
+lemma at_bot_le_nhds_bot {α : Type*} [topological_space α] [linear_order α] [order_bot α]
+  [order_topology α] :
+  (at_bot : filter α) ≤ 𝓝 ⊥ :=
+begin
+  casesI subsingleton_or_nontrivial α,
+  { simp only [nhds_discrete, le_pure_iff, mem_at_bot_sets, mem_singleton_iff,
+      eq_iff_true_of_subsingleton, implies_true_iff, exists_const], },
+  have h : at_bot.has_basis (λ _ : α, true) Iic := @at_bot_basis α _ _,
+  have h_nhds : (𝓝 ⊥).has_basis (λ a : α, ⊥ < a) (λ a, Iio a) := @nhds_bot_basis α _ _ _ _ _,
+  intro s,
+  rw [h.mem_iff, h_nhds.mem_iff],
+  rintros ⟨a, ha_bot_lt, h_Iio_a_subset_s⟩,
+  refine ⟨⊥, trivial, subset_trans _ h_Iio_a_subset_s⟩,
+  simpa only [Iic_bot, singleton_subset_iff, mem_Iio],
+end
+
+-- todo after the port: move to order/filter/at_top_bot
+lemma at_top_le_nhds_top {α : Type*} [topological_space α] [linear_order α] [order_top α]
+  [order_topology α] :
+  (at_top : filter α) ≤ 𝓝 ⊤ :=
+@at_bot_le_nhds_bot αᵒᵈ _ _ _ _
+
+-- todo: move to topology/algebra/order/monotone_convergence
+lemma tendsto_of_antitone {ι α : Type*} [preorder ι] [topological_space α]
+  [conditionally_complete_linear_order α] [order_topology α] {f : ι → α} (h_mono : antitone f) :
+  tendsto f at_top at_bot ∨ (∃ l, tendsto f at_top (𝓝 l)) :=
+@tendsto_of_monotone ι αᵒᵈ _ _ _ _ _ h_mono
+
+-- todo: move to data/real/ennreal
+lemma ennreal.of_real_cinfi (f : α → ℝ) [nonempty α] :
+  ennreal.of_real (⨅ i, f i) = ⨅ i, ennreal.of_real (f i) :=
+begin
+  by_cases hf : bdd_below (range f),
+  { exact monotone.map_cinfi_of_continuous_at ennreal.continuous_of_real.continuous_at
+      (λ i j hij, ennreal.of_real_le_of_real hij) hf, },
+  { symmetry,
+    rw [real.infi_of_not_bdd_below hf, ennreal.of_real_zero, ← ennreal.bot_eq_zero, infi_eq_bot],
+    obtain ⟨y, hy_mem, hy_neg⟩ := not_bdd_below_iff.mp hf 0,
+    obtain ⟨i, rfl⟩ := mem_range.mpr hy_mem,
+    refine λ x hx, ⟨i, _⟩,
+    rwa ennreal.of_real_of_nonpos hy_neg.le, },
+end
+
+-- todo: move to measure_theory/measurable_space
+/-- Monotone convergence for an infimum over a directed family and indexed by a countable type -/
+theorem lintegral_infi_directed_of_measurable {mα : measurable_space α} [countable β]
+  {f : β → α → ℝ≥0∞} {μ : measure α} (hμ : μ ≠ 0)
+  (hf : ∀ b, measurable (f b)) (hf_int : ∀ b, ∫⁻ a, f b a ∂μ ≠ ∞) (h_directed : directed (≥) f) :
+  ∫⁻ a, ⨅ b, f b a ∂μ = ⨅ b, ∫⁻ a, f b a ∂μ :=
+begin
+  casesI nonempty_encodable β,
+  casesI is_empty_or_nonempty β,
+  { simp only [with_top.cinfi_empty, lintegral_const],
+    rw [ennreal.top_mul, if_neg],
+    simp only [measure.measure_univ_eq_zero, hμ, not_false_iff], },
+  inhabit β,
+  have : ∀ a, (⨅ b, f b a) = (⨅ n, f (h_directed.sequence f n) a),
+  { refine λ a, le_antisymm (le_infi (λ n, infi_le _ _))
+      (le_infi (λ b, infi_le_of_le (encodable.encode b + 1) _)),
+    exact (h_directed.sequence_le b a), },
+  calc ∫⁻ a, ⨅ b, f b a ∂μ
+        = ∫⁻ a, ⨅ n, f (h_directed.sequence f n) a ∂μ : by simp only [this]
+    ... = ⨅ n, ∫⁻ a, f (h_directed.sequence f n) a ∂μ :
+      by { rw lintegral_infi (λ n, _) h_directed.sequence_anti,
+        { exact hf_int _, },
+        { exact hf _, }, }
+    ... = ⨅ b, ∫⁻ a, f b a ∂μ :
+    begin
+      refine le_antisymm (le_infi (λ b, _)) (le_infi (λ n, _)),
+      { exact infi_le_of_le (encodable.encode b + 1) (lintegral_mono $ h_directed.sequence_le b) },
+      { exact infi_le (λb, ∫⁻ a, f b a ∂μ) _ },
+    end
+end
+
+-- todo: move to measure_theory/pi_system
+lemma is_pi_system_Iic [semilattice_inf α] : @is_pi_system α (range Iic) :=
+by { rintros s ⟨us, rfl⟩ t ⟨ut, rfl⟩ _, rw [Iic_inter_Iic], exact ⟨us ⊓ ut, rfl⟩, }
+
+-- todo: move to measure_theory/pi_system
+lemma is_pi_system_Ici [semilattice_sup α] : @is_pi_system α (range Ici) :=
+by { rintros s ⟨us, rfl⟩ t ⟨ut, rfl⟩ _, rw [Ici_inter_Ici], exact ⟨us ⊔ ut, rfl⟩, }
+
+
+end aux_lemmas_to_be_moved
+
+namespace measure_theory.measure
+
+variables {α β : Type*} {mα : measurable_space α} (ρ : measure (α × ℝ))
+
+include mα
+
+/-- Measure on `α` such that for a measurable set `s`, `ρ.Iic_snd r s = ρ (s ×ˢ Iic r)`. -/
+noncomputable
+def Iic_snd (r : ℝ) : measure α := (ρ.restrict (univ ×ˢ Iic r)).fst
+
+lemma Iic_snd_apply (r : ℝ) {s : set α} (hs : measurable_set s) :
+  ρ.Iic_snd r s = ρ (s ×ˢ Iic r) :=
+by rw [Iic_snd, fst_apply hs,
+  restrict_apply' (measurable_set.univ.prod (measurable_set_Iic : measurable_set (Iic r))),
+  ← prod_univ, prod_inter_prod, inter_univ, univ_inter]
+
+lemma Iic_snd_univ (r : ℝ) : ρ.Iic_snd r univ = ρ (univ ×ˢ Iic r) :=
+Iic_snd_apply ρ r measurable_set.univ
+
+lemma Iic_snd_mono {r r' : ℝ} (h_le : r ≤ r') : ρ.Iic_snd r ≤ ρ.Iic_snd r' :=
+begin
+  intros s hs,
+  simp_rw Iic_snd_apply ρ _ hs,
+  refine measure_mono (prod_subset_prod_iff.mpr (or.inl ⟨subset_rfl, Iic_subset_Iic.mpr _⟩)),
+  exact_mod_cast h_le,
+end
+
+lemma Iic_snd_le_fst (r : ℝ) : ρ.Iic_snd r ≤ ρ.fst :=
+begin
+  intros s hs,
+  simp_rw [fst_apply hs, Iic_snd_apply ρ r hs],
+  exact measure_mono (prod_subset_preimage_fst _ _),
+end
+
+lemma Iic_snd_ac_fst (r : ℝ) : ρ.Iic_snd r ≪ ρ.fst :=
+measure.absolutely_continuous_of_le (Iic_snd_le_fst ρ r)
+
+lemma is_finite_measure.Iic_snd {ρ : measure (α × ℝ)} [is_finite_measure ρ] (r : ℝ) :
+  is_finite_measure (ρ.Iic_snd r) :=
+is_finite_measure_of_le _ (Iic_snd_le_fst ρ _)
+
+lemma infi_Iic_snd_gt (t : ℚ) {s : set α} (hs : measurable_set s) [is_finite_measure ρ] :
+  (⨅ r : {r' : ℚ // t < r'}, ρ.Iic_snd r s) = ρ.Iic_snd t s :=
+begin
+  simp_rw [ρ.Iic_snd_apply _ hs],
+  rw ← measure_Inter_eq_infi,
+  { rw ← prod_Inter,
+    congr' with x : 1,
+    simp only [mem_Inter, mem_Iic, subtype.forall, subtype.coe_mk],
+    refine ⟨λ h, _, λ h a hta, h.trans _⟩,
+    { refine le_of_forall_lt_rat_imp_le (λ q htq, h q _),
+      exact_mod_cast htq, },
+    { exact_mod_cast hta.le, }, },
+  { exact λ _, hs.prod measurable_set_Iic, },
+  { refine monotone.directed_ge (λ r r' hrr', prod_subset_prod_iff.mpr (or.inl ⟨subset_rfl, _⟩)),
+    refine Iic_subset_Iic.mpr _,
+    simp_rw coe_coe,
+    exact_mod_cast hrr', },
+  { exact ⟨⟨t+1, lt_add_one _⟩, measure_ne_top ρ _⟩, },
+end
+
+lemma tendsto_Iic_snd_at_top {s : set α} (hs : measurable_set s) :
+  tendsto (λ r : ℚ, ρ.Iic_snd r s) at_top (𝓝 (ρ.fst s)) :=
+begin
+  simp_rw [ρ.Iic_snd_apply _ hs, fst_apply hs, ← prod_univ],
+  rw [← real.Union_Iic_rat, prod_Union],
+  refine tendsto_measure_Union (λ r q hr_le_q x, _),
+  simp only [mem_prod, mem_Iic, and_imp],
+  refine λ hxs hxr, ⟨hxs, hxr.trans _⟩,
+  exact_mod_cast hr_le_q,
+end
+
+lemma tendsto_Iic_snd_at_bot [is_finite_measure ρ] {s : set α} (hs : measurable_set s) :
+  tendsto (λ r : ℚ, ρ.Iic_snd r s) at_bot (𝓝 0) :=
+begin
+  simp_rw [ρ.Iic_snd_apply _ hs],
+  have h_empty : ρ (s ×ˢ ∅) = 0, by simp only [prod_empty, measure_empty],
+  rw [← h_empty, ← real.Inter_Iic_rat, prod_Inter],
+  suffices h_neg : tendsto (λ r : ℚ, ρ (s ×ˢ Iic (↑-r))) at_top (𝓝 (ρ (⋂ r : ℚ, s ×ˢ Iic (↑-r)))),
+  { have h_inter_eq : (⋂ r : ℚ, s ×ˢ Iic (↑-r)) = (⋂ r : ℚ, s ×ˢ Iic (r : ℝ)),
+    { ext1 x,
+      simp only [rat.cast_eq_id, id.def, mem_Inter, mem_prod, mem_Iic],
+      refine ⟨λ h i, ⟨(h i).1, _⟩, λ h i, ⟨(h i).1, _⟩⟩; have h' := h (-i),
+      { rw neg_neg at h', exact h'.2, },
+      { exact h'.2, }, },
+    rw h_inter_eq at h_neg,
+    have h_fun_eq : (λ (r : ℚ), ρ (s ×ˢ Iic (r : ℝ))) = (λ r, ρ (s ×ˢ Iic ↑(- -r))),
+    { simp_rw neg_neg, },
+    rw h_fun_eq,
+    exact h_neg.comp tendsto_neg_at_bot_at_top, },
+  refine tendsto_measure_Inter (λ q, hs.prod measurable_set_Iic) _ ⟨0, measure_ne_top ρ _⟩,
+  refine λ q r hqr, prod_subset_prod_iff.mpr (or.inl ⟨subset_rfl, λ x hx, _⟩),
+  simp only [rat.cast_neg, mem_Iic] at hx ⊢,
+  refine hx.trans (neg_le_neg _),
+  exact_mod_cast hqr,
+end
+
+end measure_theory.measure
+
+open measure_theory
+
+namespace probability_theory
+
+variables {α β ι : Type*} {mα : measurable_space α}
+
+include mα
+
+local attribute [instance] measure_theory.measure.is_finite_measure.Iic_snd
+
+/-! ### Auxiliary definitions
+
+We build towards the definition of `probability_theory.cond_cdf`. We first define
+`probability_theory.pre_cdf`, a function defined on `α × ℚ` with the properties of a cdf almost
+everywhere. We then introduce `probability_theory.cond_cdf_rat`, a function on `α × ℚ` which has
+the properties of a cdf for all `a : α`. We finally extend to `ℝ`. -/
+
+/-- `pre_cdf` is the Radon-Nikodym derivative of `ρ.Iic_snd` with respect to `ρ.fst` at each
+`r : ℚ`. This function `ℚ → α → ℝ≥0∞` is such that for almost all `a : α`, the function `ℚ → ℝ≥0∞`
+satisfies the properties of a cdf (monotone with limit 0 at -∞ and 1 at +∞, right-continuous).
+
+We define this function on `ℚ` and not `ℝ` because `ℚ` is countable, which allows us to prove
+properties of the form `∀ᵐ a ∂ρ.fst, ∀ q, P (pre_cdf q a)`, instead of the weaker
+`∀ q, ∀ᵐ a ∂ρ.fst, P (pre_cdf q a)`. -/
+noncomputable
+def pre_cdf (ρ : measure (α × ℝ)) (r : ℚ) : α → ℝ≥0∞ := measure.rn_deriv (ρ.Iic_snd r) ρ.fst
+
+lemma measurable_pre_cdf {ρ : measure (α × ℝ)} {r : ℚ} : measurable (pre_cdf ρ r) :=
+measure.measurable_rn_deriv _ _
+
+lemma with_density_pre_cdf (ρ : measure (α × ℝ)) (r : ℚ) [is_finite_measure ρ] :
+  ρ.fst.with_density (pre_cdf ρ r) = ρ.Iic_snd r :=
+measure.absolutely_continuous_iff_with_density_rn_deriv_eq.mp (measure.Iic_snd_ac_fst ρ r)
+
+lemma set_lintegral_pre_cdf_fst (ρ : measure (α × ℝ)) (r : ℚ) {s : set α}
+  (hs : measurable_set s) [is_finite_measure ρ] :
+  ∫⁻ x in s, pre_cdf ρ r x ∂ρ.fst = ρ.Iic_snd r s :=
+begin
+  have : ∀ r, ∫⁻ x in s, pre_cdf ρ r x ∂ρ.fst = ∫⁻ x in s, (pre_cdf ρ r * 1) x ∂ρ.fst,
+  { simp only [mul_one, eq_self_iff_true, forall_const], },
+  rw [this, ← set_lintegral_with_density_eq_set_lintegral_mul _ measurable_pre_cdf _ hs],
+  { simp only [with_density_pre_cdf ρ r, pi.one_apply, lintegral_one, measure.restrict_apply,
+      measurable_set.univ, univ_inter], },
+  { rw (_ : (1 : α → ℝ≥0∞) = (λ _, 1)),
+    exacts [measurable_const, rfl], },
+end
+
+lemma monotone_pre_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, monotone (λ r, pre_cdf ρ r a) :=
+begin
+  simp_rw [monotone, ae_all_iff],
+  refine λ r r' hrr', ae_le_of_forall_set_lintegral_le_of_sigma_finite
+    measurable_pre_cdf measurable_pre_cdf (λ s hs hs_fin, _),
+  rw [set_lintegral_pre_cdf_fst ρ r hs, set_lintegral_pre_cdf_fst ρ r' hs],
+  refine measure.Iic_snd_mono ρ _ s hs,
+  exact_mod_cast hrr',
+end
+
+lemma set_lintegral_infi_gt_pre_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] (t : ℚ)
+  {s : set α} (hs : measurable_set s) :
+  ∫⁻ x in s, ⨅ r : Ioi t, pre_cdf ρ r x ∂ρ.fst = ρ.Iic_snd t s :=
+begin
+  refine le_antisymm _ _,
+  { have h : ∀ q : Ioi t, ∫⁻ x in s, ⨅ r : Ioi t, pre_cdf ρ r x ∂ρ.fst ≤ ρ.Iic_snd q s,
+    { intros q,
+      rw [coe_coe, ← set_lintegral_pre_cdf_fst ρ _ hs],
+      refine set_lintegral_mono_ae _ measurable_pre_cdf _,
+      { exact measurable_infi (λ _, measurable_pre_cdf), },
+      { filter_upwards [monotone_pre_cdf] with a ha_mono,
+        exact λ _, infi_le _ q, }, },
+    calc ∫⁻ x in s, (⨅ (r : Ioi t), pre_cdf ρ r x) ∂ρ.fst
+        ≤ ⨅ q : Ioi t, ρ.Iic_snd q s : le_infi h
+    ... = ρ.Iic_snd t s : measure.infi_Iic_snd_gt ρ t hs, },
+  { rw (set_lintegral_pre_cdf_fst ρ t hs).symm,
+    refine set_lintegral_mono_ae measurable_pre_cdf _ _,
+    { exact measurable_infi (λ _, measurable_pre_cdf), },
+    { filter_upwards [monotone_pre_cdf] with a ha_mono,
+      exact λ _, le_infi (λ r, ha_mono (le_of_lt r.prop)), }, },
+end
+
+lemma pre_cdf_le_one (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, ∀ r, pre_cdf ρ r a ≤ 1 :=
+begin
+  rw ae_all_iff,
+  refine λ r, ae_le_of_forall_set_lintegral_le_of_sigma_finite measurable_pre_cdf
+    measurable_const (λ s hs hs_fin, _),
+  rw set_lintegral_pre_cdf_fst ρ r hs,
+  simp only [pi.one_apply, lintegral_one, measure.restrict_apply, measurable_set.univ, univ_inter],
+  exact measure.Iic_snd_le_fst ρ r s hs,
+end
+
+lemma tendsto_lintegral_pre_cdf_at_top (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  tendsto (λ r, ∫⁻ a, pre_cdf ρ r a ∂ρ.fst) at_top (𝓝 (ρ univ)) :=
+begin
+  convert ρ.tendsto_Iic_snd_at_top measurable_set.univ,
+  { ext1 r,
+    rw [← set_lintegral_univ, set_lintegral_pre_cdf_fst ρ _ measurable_set.univ], },
+  { exact measure.fst_univ.symm, },
+end
+
+lemma tendsto_lintegral_pre_cdf_at_bot (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  tendsto (λ r, ∫⁻ a, pre_cdf ρ r a ∂ρ.fst) at_bot (𝓝 0) :=
+begin
+  convert ρ.tendsto_Iic_snd_at_bot measurable_set.univ,
+  ext1 r,
+  rw [← set_lintegral_univ, set_lintegral_pre_cdf_fst ρ _ measurable_set.univ],
+end
+
+lemma tendsto_pre_cdf_at_top_one (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, tendsto (λ r, pre_cdf ρ r a) at_top (𝓝 1) :=
+begin
+  -- We show first that `pre_cdf` has a limit almost everywhere. That limit has to be at most 1.
+  -- We then show that the integral of `pre_cdf` tends to the integral of 1, and that it also tends
+  -- to the integral of the limit. Since the limit is at most 1 and has same integral as 1, it is
+  -- equal to 1 a.e.
+  have h_mono := monotone_pre_cdf ρ,
+  have h_le_one := pre_cdf_le_one ρ,
+  -- `pre_cdf` has a limit a.e.
+  have h_exists : ∀ᵐ a ∂ρ.fst, ∃ l, tendsto (λ r, pre_cdf ρ r a) at_top (𝓝 l),
+  { filter_upwards [h_mono, h_le_one] with a ha_mono ha_le_one,
+    have h_tendsto : tendsto (λ r, pre_cdf ρ r a) at_top at_top
+      ∨ ∃ l, tendsto (λ r, pre_cdf ρ r a) at_top (𝓝 l) := tendsto_of_monotone ha_mono,
+    cases h_tendsto with h_absurd h_tendsto,
+    { rw monotone.tendsto_at_top_at_top_iff ha_mono at h_absurd,
+      obtain ⟨r, hr⟩ := h_absurd 2,
+      exact absurd (hr.trans (ha_le_one r)) ennreal.one_lt_two.not_le, },
+    { exact h_tendsto, }, },
+  classical,
+  -- let `F` be the pointwise limit of `pre_cdf` where it exists, and 0 elsewhere.
+  let F : α → ℝ≥0∞ := λ a,
+    if h : ∃ l, tendsto (λ r, pre_cdf ρ r a) at_top (𝓝 l) then h.some else 0,
+  have h_tendsto_ℚ : ∀ᵐ a ∂ρ.fst, tendsto (λ r, pre_cdf ρ r a) at_top (𝓝 (F a)),
+  { filter_upwards [h_exists] with a ha,
+    simp_rw [F, dif_pos ha],
+    exact ha.some_spec },
+  have h_tendsto_ℕ : ∀ᵐ a ∂ρ.fst, tendsto (λ n : ℕ, pre_cdf ρ n a) at_top (𝓝 (F a)),
+  { filter_upwards [h_tendsto_ℚ] with a ha using ha.comp tendsto_coe_nat_at_top_at_top, },
+  have hF_ae_meas : ae_measurable F ρ.fst,
+  { refine ae_measurable_of_tendsto_metrizable_ae _ (λ n, _) h_tendsto_ℚ,
+    exact measurable_pre_cdf.ae_measurable, },
+  have hF_le_one : ∀ᵐ a ∂ρ.fst, F a ≤ 1,
+  { filter_upwards [h_tendsto_ℚ, h_le_one] with a ha ha_le using le_of_tendsto' ha ha_le, },
+  -- it suffices to show that the limit `F` is 1 a.e.
+  suffices : ∀ᵐ a ∂ρ.fst, F a = 1,
+  { filter_upwards [h_tendsto_ℚ, this] with a ha_tendsto ha_eq,
+    rwa ha_eq at ha_tendsto, },
+  -- since `F` is at most 1, proving that its integral is the same as the integral of 1 will tell
+  -- us that `F` is 1 a.e.
+  have h_lintegral_eq : ∫⁻ a, F a ∂ρ.fst = ∫⁻ a, 1 ∂ρ.fst,
+  { have h_lintegral : tendsto (λ r : ℕ, ∫⁻ a, pre_cdf ρ r a ∂ρ.fst) at_top
+      (𝓝 (∫⁻ a, F a ∂ρ.fst)),
+    { refine lintegral_tendsto_of_tendsto_of_monotone  -- does this exist only for ℕ?
+        (λ _, measurable_pre_cdf.ae_measurable) _ h_tendsto_ℕ,
+      filter_upwards [h_mono] with a ha,
+      refine λ n m hnm, ha _,
+      exact_mod_cast hnm, },
+    have h_lintegral' : tendsto (λ r : ℕ, ∫⁻ a, pre_cdf ρ r a ∂ρ.fst) at_top
+      (𝓝 (∫⁻ a, 1 ∂ρ.fst)),
+    { rw [lintegral_one, measure.fst_univ],
+      exact (tendsto_lintegral_pre_cdf_at_top ρ).comp tendsto_coe_nat_at_top_at_top, },
+    exact tendsto_nhds_unique h_lintegral h_lintegral', },
+  have : ∫⁻ a, (1 - F a) ∂ρ.fst = 0,
+  { rw [lintegral_sub' hF_ae_meas _ hF_le_one, h_lintegral_eq, tsub_self],
+    calc ∫⁻ a, F a ∂ρ.fst = ∫⁻ a, 1 ∂ρ.fst : h_lintegral_eq
+    ... = ρ.fst univ : lintegral_one
+    ... = ρ univ : measure.fst_univ
+    ... ≠ ∞ : measure_ne_top ρ _, },
+  rw lintegral_eq_zero_iff' (ae_measurable_const.sub hF_ae_meas) at this,
+  filter_upwards [this, hF_le_one] with ha h_one_sub_eq_zero h_le_one,
+  rw [pi.zero_apply, tsub_eq_zero_iff_le] at h_one_sub_eq_zero,
+  exact le_antisymm h_le_one h_one_sub_eq_zero,
+end
+
+lemma tendsto_pre_cdf_at_bot_zero (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, tendsto (λ r, pre_cdf ρ r a) at_bot (𝓝 0) :=
+begin
+  -- We show first that `pre_cdf` has a limit in ℝ≥0∞ almost everywhere.
+  -- We then show that the integral of `pre_cdf` tends to 0, and that it also tends
+  -- to the integral of the limit. Since the limit is has integral 0, it is equal to 0 a.e.
+  suffices : ∀ᵐ a ∂ρ.fst, tendsto (λ r, pre_cdf ρ (-r) a) at_top (𝓝 0),
+  { filter_upwards [this] with a ha,
+    have h_eq_neg : (λ (r : ℚ), pre_cdf ρ r a) = (λ (r : ℚ), pre_cdf ρ (- -r) a),
+    { simp_rw neg_neg, },
+    rw h_eq_neg,
+    exact ha.comp tendsto_neg_at_bot_at_top, },
+  have h_exists : ∀ᵐ a ∂ρ.fst, ∃ l, tendsto (λ r, pre_cdf ρ (-r) a) at_top (𝓝 l),
+  { filter_upwards [monotone_pre_cdf ρ] with a ha,
+    have h_anti : antitone (λ r, pre_cdf ρ (-r) a) := λ p q hpq, ha (neg_le_neg hpq),
+    have h_tendsto : tendsto (λ r, pre_cdf ρ (-r) a) at_top at_bot
+      ∨ ∃ l, tendsto (λ r, pre_cdf ρ (-r) a) at_top (𝓝 l) := tendsto_of_antitone h_anti,
+    cases h_tendsto with h_bot h_tendsto,
+    { exact ⟨0, tendsto.mono_right h_bot at_bot_le_nhds_bot⟩, },
+    { exact h_tendsto, }, },
+  classical,
+  let F : α → ℝ≥0∞ := λ a,
+    if h : ∃ l, tendsto (λ r, pre_cdf ρ (-r) a) at_top (𝓝 l) then h.some else 0,
+  have h_tendsto : ∀ᵐ a ∂ρ.fst, tendsto (λ r, pre_cdf ρ (-r) a) at_top (𝓝 (F a)),
+  { filter_upwards [h_exists] with a ha,
+    simp_rw [F, dif_pos ha],
+    exact ha.some_spec, },
+  suffices h_lintegral_eq : ∫⁻ a, F a ∂ρ.fst = 0,
+  { have hF_ae_meas : ae_measurable F ρ.fst,
+    { refine ae_measurable_of_tendsto_metrizable_ae _ (λ n, _) h_tendsto,
+      exact measurable_pre_cdf.ae_measurable, },
+    rw [lintegral_eq_zero_iff' hF_ae_meas] at h_lintegral_eq,
+    filter_upwards [h_tendsto, h_lintegral_eq] with a ha_tendsto ha_eq,
+    rwa ha_eq at ha_tendsto, },
+  have h_lintegral : tendsto (λ r, ∫⁻ a, pre_cdf ρ (-r) a ∂ρ.fst) at_top (𝓝 (∫⁻ a, F a ∂ρ.fst)),
+  { refine tendsto_lintegral_filter_of_dominated_convergence (λ _, 1)
+      (eventually_of_forall (λ _, measurable_pre_cdf)) (eventually_of_forall (λ _, _))
+      _ h_tendsto,
+    { filter_upwards [pre_cdf_le_one ρ] with a ha using ha _, },
+    { rw lintegral_one,
+      exact measure_ne_top _ _, }, },
+  have h_lintegral' : tendsto (λ r, ∫⁻ a, pre_cdf ρ (-r) a ∂ρ.fst) at_top (𝓝 0),
+  { have h_lintegral_eq : (λ r, ∫⁻ a, pre_cdf ρ (-r) a ∂ρ.fst) = λ r, ρ (univ ×ˢ Iic (-r)),
+    { ext1 n,
+      rw [← set_lintegral_univ, set_lintegral_pre_cdf_fst ρ _ measurable_set.univ,
+        measure.Iic_snd_univ],
+      norm_cast, },
+    rw h_lintegral_eq,
+    have h_zero_eq_measure_Inter : (0 : ℝ≥0∞) = ρ (⋂ r : ℚ, univ ×ˢ Iic (-r)),
+    { suffices : (⋂ r : ℚ, Iic (-(r : ℝ))) = ∅,
+      { rwa [← prod_Inter, this, prod_empty, measure_empty], },
+      ext1 x,
+      simp only [mem_Inter, mem_Iic, mem_empty_iff_false, iff_false, not_forall, not_le],
+      simp_rw neg_lt,
+      exact exists_rat_gt _, },
+    rw h_zero_eq_measure_Inter,
+    refine tendsto_measure_Inter (λ n, measurable_set.univ.prod measurable_set_Iic)
+      (λ i j hij x, _) ⟨0, measure_ne_top ρ _⟩,
+    simp only [mem_prod, mem_univ, mem_Iic, true_and],
+    refine λ hxj, hxj.trans (neg_le_neg _),
+    exact_mod_cast hij, },
+  exact tendsto_nhds_unique h_lintegral h_lintegral',
+end
+
+lemma inf_gt_pre_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, ∀ t : ℚ, (⨅ r : Ioi t, pre_cdf ρ r a) = pre_cdf ρ t a :=
+begin
+  rw ae_all_iff,
+  refine λ t, ae_eq_of_forall_set_lintegral_eq_of_sigma_finite _ measurable_pre_cdf _,
+  { exact measurable_infi (λ i, measurable_pre_cdf), },
+  intros s hs hs_fin,
+  rw [set_lintegral_infi_gt_pre_cdf ρ t hs, set_lintegral_pre_cdf_fst ρ t hs],
+end
+
+
+section has_cond_cdf
+
+/-- A product measure on `α × ℝ` is said to have a conditional cdf at `a : α` if `pre_cdf` is
+monotone with limit 0 at -∞ and 1 at +∞, and is right continuous.
+This property holds almost everywhere (see `has_cond_cdf_ae`). -/
+structure has_cond_cdf (ρ : measure (α × ℝ)) (a : α) : Prop :=
+(mono : monotone (λ r, pre_cdf ρ r a))
+(le_one : ∀ r, pre_cdf ρ r a ≤ 1)
+(tendsto_at_top_one : tendsto (λ r, pre_cdf ρ r a) at_top (𝓝 1))
+(tendsto_at_bot_zero : tendsto (λ r, pre_cdf ρ r a) at_bot (𝓝 0))
+(infi_rat_gt_eq : ∀ t : ℚ, (⨅ r : Ioi t, pre_cdf ρ r a) = pre_cdf ρ t a)
+
+lemma has_cond_cdf_ae (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, has_cond_cdf ρ a :=
+begin
+  filter_upwards [monotone_pre_cdf ρ, pre_cdf_le_one ρ, tendsto_pre_cdf_at_top_one ρ,
+    tendsto_pre_cdf_at_bot_zero ρ, inf_gt_pre_cdf ρ] with a h1 h2 h3 h4 h5,
+  exact ⟨h1, h2, h3, h4, h5⟩,
+end
+
+/-- A measurable set of elements of `α` such that `ρ` has a conditional cdf at all
+`a ∈ cond_cdf_set`. -/
+def cond_cdf_set (ρ : measure (α × ℝ)) : set α := (to_measurable ρ.fst {b | ¬ has_cond_cdf ρ b})ᶜ
+
+lemma measurable_set_cond_cdf_set (ρ : measure (α × ℝ)) : measurable_set (cond_cdf_set ρ) :=
+(measurable_set_to_measurable _ _).compl
+
+lemma has_cond_cdf_of_mem_cond_cdf_set {ρ : measure (α × ℝ)} {a : α} (h : a ∈ cond_cdf_set ρ) :
+  has_cond_cdf ρ a :=
+begin
+  rw [cond_cdf_set, mem_compl_iff] at h,
+  have h_ss := subset_to_measurable ρ.fst {b | ¬ has_cond_cdf ρ b},
+  by_contra ha,
+  exact h (h_ss ha),
+end
+
+lemma mem_cond_cdf_set_ae (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  ∀ᵐ a ∂ρ.fst, a ∈ cond_cdf_set ρ :=
+begin
+  simp_rw [ae_iff, cond_cdf_set, not_mem_compl_iff, set_of_mem_eq, measure_to_measurable],
+  exact has_cond_cdf_ae ρ,
+end
+
+end has_cond_cdf
+
+
+open_locale classical
+
+/-- Conditional cdf of the measure given the value on `α`, restricted to the rationals.
+It is defined to be `pre_cdf` if `a ∈ cond_cdf_set`, and a default cdf-like function
+otherwise. This is an auxiliary definition used to define `cond_cdf`. -/
+noncomputable
+def cond_cdf_rat (ρ : measure (α × ℝ)) : α → ℚ → ℝ :=
+λ a, if a ∈ cond_cdf_set ρ then (λ r, (pre_cdf ρ r a).to_real) else (λ r, if r < 0 then 0 else 1)
+
+lemma cond_cdf_rat_of_not_mem (ρ : measure (α × ℝ)) (a : α) (h : a ∉ cond_cdf_set ρ) {r : ℚ} :
+  cond_cdf_rat ρ a r = if r < 0 then 0 else 1 :=
+by simp only [cond_cdf_rat, h, if_false]
+
+lemma cond_cdf_rat_of_mem (ρ : measure (α × ℝ)) (a : α) (h : a ∈ cond_cdf_set ρ) (r : ℚ) :
+  cond_cdf_rat ρ a r = (pre_cdf ρ r a).to_real :=
+by simp only [cond_cdf_rat, h, if_true]
+
+lemma monotone_cond_cdf_rat (ρ : measure (α × ℝ)) (a : α) :
+  monotone (cond_cdf_rat ρ a) :=
+begin
+  by_cases h : a ∈ cond_cdf_set ρ,
+  { simp only [cond_cdf_rat, h, if_true, forall_const, and_self],
+    intros r r' hrr',
+    have h' := has_cond_cdf_of_mem_cond_cdf_set h,
+    have h_ne_top : ∀ r, pre_cdf ρ r a ≠ ∞ := λ r, ((h'.le_one r).trans_lt ennreal.one_lt_top).ne,
+    rw ennreal.to_real_le_to_real (h_ne_top _) (h_ne_top _),
+    exact h'.1 hrr', },
+  { simp only [cond_cdf_rat, h, if_false],
+    intros x y hxy,
+    dsimp only,
+    split_ifs,
+    exacts [le_rfl, zero_le_one, absurd (hxy.trans_lt h_2) h_1, le_rfl], },
+end
+
+lemma measurable_cond_cdf_rat (ρ : measure (α × ℝ)) (q : ℚ) :
+  measurable (λ a, cond_cdf_rat ρ a q) :=
+begin
+  simp_rw [cond_cdf_rat, ite_apply],
+  exact measurable.ite (measurable_set_cond_cdf_set ρ) measurable_pre_cdf.ennreal_to_real
+    measurable_const,
+end
+
+lemma cond_cdf_rat_nonneg (ρ : measure (α × ℝ)) (a : α) (r : ℚ) :
+  0 ≤ cond_cdf_rat ρ a r :=
+by { unfold cond_cdf_rat, split_ifs, exacts [ennreal.to_real_nonneg, le_rfl, zero_le_one], }
+
+lemma cond_cdf_rat_le_one (ρ : measure (α × ℝ)) (a : α) (r : ℚ) :
+  cond_cdf_rat ρ a r ≤ 1 :=
+begin
+  unfold cond_cdf_rat,
+  split_ifs with h,
+  { refine ennreal.to_real_le_of_le_of_real zero_le_one _,
+    rw ennreal.of_real_one,
+    exact (has_cond_cdf_of_mem_cond_cdf_set h).le_one r, },
+  exacts [zero_le_one, le_rfl],
+end
+
+lemma tendsto_cond_cdf_rat_at_bot (ρ : measure (α × ℝ)) (a : α) :
+  tendsto (cond_cdf_rat ρ a) at_bot (𝓝 0) :=
+begin
+  unfold cond_cdf_rat,
+  split_ifs with h,
+  { rw [← ennreal.zero_to_real, ennreal.tendsto_to_real_iff],
+    { exact (has_cond_cdf_of_mem_cond_cdf_set h).tendsto_at_bot_zero, },
+    { have h' := has_cond_cdf_of_mem_cond_cdf_set h,
+      exact λ r, ((h'.le_one r).trans_lt ennreal.one_lt_top).ne, },
+    { exact ennreal.zero_ne_top, }, },
+  { refine (tendsto_congr' _).mp tendsto_const_nhds,
+    rw [eventually_eq, eventually_at_bot],
+    refine ⟨-1, λ q hq, (if_pos (hq.trans_lt _)).symm⟩,
+    linarith, },
+end
+
+lemma tendsto_cond_cdf_rat_at_top (ρ : measure (α × ℝ)) (a : α) :
+  tendsto (cond_cdf_rat ρ a) at_top (𝓝 1) :=
+begin
+  unfold cond_cdf_rat,
+  split_ifs with h,
+  { have h' := has_cond_cdf_of_mem_cond_cdf_set h,
+    rw [← ennreal.one_to_real, ennreal.tendsto_to_real_iff],
+    { exact h'.tendsto_at_top_one, },
+    { exact λ r, ((h'.le_one r).trans_lt ennreal.one_lt_top).ne, },
+    { exact ennreal.one_ne_top, }, },
+  { refine (tendsto_congr' _).mp tendsto_const_nhds,
+    rw [eventually_eq, eventually_at_top],
+    exact ⟨0, λ q hq, (if_neg (not_lt.mpr hq)).symm⟩, },
+end
+
+lemma cond_cdf_rat_ae_eq (ρ : measure (α × ℝ)) [is_finite_measure ρ] (r : ℚ) :
+  (λ a, cond_cdf_rat ρ a r) =ᵐ[ρ.fst] λ a, (pre_cdf ρ r a).to_real :=
+by filter_upwards [mem_cond_cdf_set_ae ρ] with a ha using cond_cdf_rat_of_mem ρ a ha r
+
+lemma of_real_cond_cdf_rat_ae_eq (ρ : measure (α × ℝ)) [is_finite_measure ρ] (r : ℚ) :
+  (λ a, ennreal.of_real (cond_cdf_rat ρ a r)) =ᵐ[ρ.fst] pre_cdf ρ r :=
+begin
+  filter_upwards [cond_cdf_rat_ae_eq ρ r, pre_cdf_le_one ρ] with a ha ha_le_one,
+  rw [ha, ennreal.of_real_to_real],
+  exact ((ha_le_one r).trans_lt ennreal.one_lt_top).ne,
+end
+
+lemma inf_gt_cond_cdf_rat (ρ : measure (α × ℝ)) (a : α) (t : ℚ) :
+  (⨅ r : Ioi t, cond_cdf_rat ρ a r) = cond_cdf_rat ρ a t :=
+begin
+  by_cases ha : a ∈ cond_cdf_set ρ,
+  { simp_rw cond_cdf_rat_of_mem ρ a ha,
+    have ha' := has_cond_cdf_of_mem_cond_cdf_set ha,
+    rw ← ennreal.to_real_infi,
+    { suffices : (⨅ (i : ↥(Ioi t)), pre_cdf ρ ↑i a) = pre_cdf ρ t a, by rw this,
+      rw ← ha'.infi_rat_gt_eq, },
+    { exact λ r, ((ha'.le_one r).trans_lt ennreal.one_lt_top).ne, }, },
+  { simp_rw cond_cdf_rat_of_not_mem ρ a ha,
+    have h_bdd : bdd_below (range (λ (r : ↥(Ioi t)), ite ((r : ℚ) < 0) (0 : ℝ) 1)),
+    { refine ⟨0, λ x hx, _⟩,
+      obtain ⟨y, rfl⟩ := mem_range.mpr hx,
+      dsimp only,
+      split_ifs,
+      exacts [le_rfl, zero_le_one], },
+    split_ifs with h h,
+    { refine le_antisymm _ (le_cinfi (λ x, _)),
+      { obtain ⟨q, htq, hq_neg⟩ : ∃ q, t < q ∧ q < 0,
+        { refine ⟨t/2, _, _⟩,
+          { linarith, },
+          { linarith, }, },
+        refine (cinfi_le h_bdd ⟨q, htq⟩).trans _,
+        rw if_pos,
+        rwa subtype.coe_mk, },
+      { split_ifs,
+        exacts [le_rfl, zero_le_one], }, },
+    { refine le_antisymm _ _,
+      { refine (cinfi_le h_bdd ⟨t+1, lt_add_one t⟩).trans _,
+        split_ifs,
+        exacts [zero_le_one, le_rfl], },
+      { refine le_cinfi (λ x, _),
+        rw if_neg,
+        rw not_lt at h ⊢,
+        exact h.trans (mem_Ioi.mp x.prop).le, }, }, },
+end
+
+/-- Conditional cdf of the measure given the value on `α`, as a plain function. This is an auxiliary
+definition used to define `cond_cdf`. -/
+@[irreducible] noncomputable
+def cond_cdf' (ρ : measure (α × ℝ)) : α → ℝ → ℝ :=
+λ a t, ⨅ r : {r' : ℚ // t < r'}, cond_cdf_rat ρ a r
+
+lemma cond_cdf'_def {ρ : measure (α × ℝ)} {a : α} {x : ℝ} :
+  cond_cdf' ρ a x = ⨅ r : {r : ℚ // x < r}, cond_cdf_rat ρ a r :=
+by rw cond_cdf'
+
+lemma cond_cdf'_eq_cond_cdf_rat (ρ : measure (α × ℝ)) (a : α) (r : ℚ) :
+  cond_cdf' ρ a r = cond_cdf_rat ρ a r :=
+begin
+  rw [← inf_gt_cond_cdf_rat ρ a r, cond_cdf'],
+  refine equiv.infi_congr _ _,
+  { exact
+    { to_fun := λ t, ⟨t.1, by exact_mod_cast t.2⟩,
+      inv_fun := λ t, ⟨t.1, by exact_mod_cast t.2⟩,
+      left_inv := λ t, by simp only [subtype.val_eq_coe, subtype.coe_eta],
+      right_inv := λ t, by simp only [subtype.val_eq_coe, subtype.coe_eta], }, },
+  { intro t,
+    simp only [subtype.val_eq_coe, equiv.coe_fn_mk, subtype.coe_mk], },
+end
+
+lemma cond_cdf'_nonneg (ρ : measure (α × ℝ)) (a : α) (r : ℝ) :
+  0 ≤ cond_cdf' ρ a r :=
+begin
+  haveI : nonempty {r' : ℚ // r < ↑r'},
+  { obtain ⟨r, hrx⟩ := exists_rat_gt r,
+    exact ⟨⟨r, hrx⟩⟩, },
+  rw cond_cdf'_def,
+  exact le_cinfi (λ r', cond_cdf_rat_nonneg ρ a _),
+end
+
+lemma bdd_below_range_cond_cdf_rat_gt (ρ : measure (α × ℝ)) (a : α) (x : ℝ) :
+  bdd_below (range (λ (r : {r' : ℚ // x < ↑r'}), cond_cdf_rat ρ a r)) :=
+by { refine ⟨0, λ z, _⟩, rintros ⟨u, rfl⟩, exact cond_cdf_rat_nonneg ρ a _, }
+
+lemma monotone_cond_cdf' (ρ : measure (α × ℝ)) (a : α) : monotone (cond_cdf' ρ a) :=
+begin
+  intros x y hxy,
+  haveI : nonempty {r' : ℚ // y < ↑r'},
+  { obtain ⟨r, hrx⟩ := exists_rat_gt y,
+    exact ⟨⟨r, hrx⟩⟩, },
+  simp_rw cond_cdf'_def,
+  refine le_cinfi (λ r, (cinfi_le _ _).trans_eq _),
+  { exact ⟨r.1, hxy.trans_lt r.prop⟩, },
+  { exact bdd_below_range_cond_cdf_rat_gt ρ a x, },
+  { refl, },
+end
+
+lemma continuous_within_at_cond_cdf'_Ici (ρ : measure (α × ℝ)) (a : α) (x : ℝ) :
+  continuous_within_at (cond_cdf' ρ a) (Ici x) x :=
+begin
+  rw ← continuous_within_at_Ioi_iff_Ici,
+  convert monotone.tendsto_nhds_within_Ioi (monotone_cond_cdf' ρ a) x,
+  rw Inf_image',
+  have h' : (⨅ r : Ioi x, cond_cdf' ρ a r) = ⨅ r : {r' : ℚ // x < r'}, cond_cdf' ρ a r,
+  { refine infi_Ioi_eq_infi_rat_gt x _ (monotone_cond_cdf' ρ a),
+    refine ⟨0, λ z, _⟩,
+    rintros ⟨u, hux, rfl⟩,
+    exact cond_cdf'_nonneg ρ a u, },
+  have h'' : (⨅ r : {r' : ℚ // x < r'}, cond_cdf' ρ a r)
+    = ⨅ r : {r' : ℚ // x < r'}, cond_cdf_rat ρ a r,
+  { congr' with r,
+    exact cond_cdf'_eq_cond_cdf_rat ρ a r, },
+  rw [h', h'', continuous_within_at],
+  congr,
+  exact cond_cdf'_def,
+end
+
+/-! ### Conditional cdf -/
+
+/-- Conditional cdf of the measure given the value on `α`, as a Stieltjes function. -/
+noncomputable
+def cond_cdf (ρ : measure (α × ℝ)) (a : α) : stieltjes_function :=
+{ to_fun := cond_cdf' ρ a,
+  mono' := monotone_cond_cdf' ρ a,
+  right_continuous' := λ x, continuous_within_at_cond_cdf'_Ici ρ a x, }
+
+lemma cond_cdf_eq_cond_cdf_rat (ρ : measure (α × ℝ)) (a : α) (r : ℚ) :
+  cond_cdf ρ a r = cond_cdf_rat ρ a r :=
+cond_cdf'_eq_cond_cdf_rat ρ a r
+
+/-- The conditional cdf is non-negative for all `a : α`. -/
+lemma cond_cdf_nonneg (ρ : measure (α × ℝ)) (a : α) (r : ℝ) :
+  0 ≤ cond_cdf ρ a r :=
+cond_cdf'_nonneg ρ a r
+
+/-- The conditional cdf is lower or equal to 1 for all `a : α`. -/
+lemma cond_cdf_le_one (ρ : measure (α × ℝ)) (a : α) (x : ℝ) :
+  cond_cdf ρ a x ≤ 1 :=
+begin
+  obtain ⟨r, hrx⟩ := exists_rat_gt x,
+  rw ← stieltjes_function.infi_rat_gt_eq,
+  simp_rw [coe_coe, cond_cdf_eq_cond_cdf_rat],
+  refine cinfi_le_of_le (bdd_below_range_cond_cdf_rat_gt ρ a x) _ (cond_cdf_rat_le_one _ _ _),
+  exact ⟨r, hrx⟩,
+end
+
+/-- The conditional cdf tends to 0 at -∞ for all `a : α`. -/
+lemma tendsto_cond_cdf_at_bot (ρ : measure (α × ℝ)) (a : α) :
+  tendsto (cond_cdf ρ a) at_bot (𝓝 0) :=
+begin
+  have h_exists : ∀ x : ℝ, ∃ q : ℚ, x < q ∧ ↑q < x + 1 := λ x, exists_rat_btwn (lt_add_one x),
+  let qs : ℝ → ℚ := λ x, (h_exists x).some,
+  have hqs_tendsto : tendsto qs at_bot at_bot,
+  { rw tendsto_at_bot_at_bot,
+    refine λ q, ⟨q - 1, λ y hy, _⟩,
+    have h_le : ↑(qs y) ≤ (q : ℝ) - 1 + 1 :=
+      ((h_exists y).some_spec.2.le).trans (add_le_add hy le_rfl),
+    rw sub_add_cancel at h_le,
+    exact_mod_cast h_le, },
+  refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds
+    ((tendsto_cond_cdf_rat_at_bot ρ a).comp hqs_tendsto) (cond_cdf_nonneg ρ a) (λ x, _),
+  rw [function.comp_apply, ← cond_cdf_eq_cond_cdf_rat],
+  exact (cond_cdf ρ a).mono (h_exists x).some_spec.1.le,
+end
+
+/-- The conditional cdf tends to 1 at +∞ for all `a : α`. -/
+lemma tendsto_cond_cdf_at_top (ρ : measure (α × ℝ)) (a : α) :
+  tendsto (cond_cdf ρ a) at_top (𝓝 1) :=
+begin
+  have h_exists : ∀ x : ℝ, ∃ q : ℚ, x-1 < q ∧ ↑q < x := λ x, exists_rat_btwn (sub_one_lt x),
+  let qs : ℝ → ℚ := λ x, (h_exists x).some,
+  have hqs_tendsto : tendsto qs at_top at_top,
+  { rw tendsto_at_top_at_top,
+    refine λ q, ⟨q + 1, λ y hy, _⟩,
+    have h_le : y - 1 ≤ qs y := (h_exists y).some_spec.1.le,
+    rw sub_le_iff_le_add at h_le,
+    exact_mod_cast le_of_add_le_add_right (hy.trans h_le),},
+  refine tendsto_of_tendsto_of_tendsto_of_le_of_le
+    ((tendsto_cond_cdf_rat_at_top ρ a).comp hqs_tendsto) tendsto_const_nhds _ (cond_cdf_le_one ρ a),
+  intro x,
+  rw [function.comp_apply, ← cond_cdf_eq_cond_cdf_rat],
+  exact (cond_cdf ρ a).mono (le_of_lt (h_exists x).some_spec.2),
+end
+
+lemma cond_cdf_ae_eq (ρ : measure (α × ℝ)) [is_finite_measure ρ] (r : ℚ) :
+  (λ a, cond_cdf ρ a r) =ᵐ[ρ.fst] λ a, (pre_cdf ρ r a).to_real :=
+by filter_upwards [mem_cond_cdf_set_ae ρ] with a ha
+  using (cond_cdf_eq_cond_cdf_rat ρ a r).trans (cond_cdf_rat_of_mem ρ a ha r)
+
+lemma of_real_cond_cdf_ae_eq (ρ : measure (α × ℝ)) [is_finite_measure ρ] (r : ℚ) :
+  (λ a, ennreal.of_real (cond_cdf ρ a r)) =ᵐ[ρ.fst] pre_cdf ρ r :=
+begin
+  filter_upwards [cond_cdf_ae_eq ρ r, pre_cdf_le_one ρ] with a ha ha_le_one,
+  rw [ha, ennreal.of_real_to_real],
+  exact ((ha_le_one r).trans_lt ennreal.one_lt_top).ne,
+end
+
+/-- The conditional cdf is a measurable function of `a : α` for all `x : ℝ`. -/
+lemma measurable_cond_cdf (ρ : measure (α × ℝ)) (x : ℝ) :
+  measurable (λ a, cond_cdf ρ a x) :=
+begin
+  have : (λ a, cond_cdf ρ a x) = λ a, (⨅ (r : {r' // x < ↑r'}), cond_cdf_rat ρ a ↑r),
+  { ext1 a,
+    rw ← stieltjes_function.infi_rat_gt_eq,
+    congr' with q,
+    rw [coe_coe, cond_cdf_eq_cond_cdf_rat], },
+  rw this,
+  exact measurable_cinfi (λ q, measurable_cond_cdf_rat ρ q)
+    (λ a, bdd_below_range_cond_cdf_rat_gt ρ a _),
+end
+
+/-- Auxiliary lemma for `set_lintegral_cond_cdf`. -/
+lemma set_lintegral_cond_cdf_rat (ρ : measure (α × ℝ)) [is_finite_measure ρ] (r : ℚ)
+  {s : set α} (hs : measurable_set s) :
+  ∫⁻ a in s, ennreal.of_real (cond_cdf ρ a r) ∂ρ.fst = ρ (s ×ˢ Iic r) :=
+begin
+  have : ∀ᵐ a ∂ρ.fst, a ∈ s → ennreal.of_real (cond_cdf ρ a r) = pre_cdf ρ r a,
+  { filter_upwards [of_real_cond_cdf_ae_eq ρ r] with a ha using λ _, ha, },
+  rw [set_lintegral_congr_fun hs this, set_lintegral_pre_cdf_fst ρ r hs],
+  exact ρ.Iic_snd_apply r hs,
+end
+
+lemma set_lintegral_cond_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] (x : ℝ)
+  {s : set α} (hs : measurable_set s) :
+  ∫⁻ a in s, ennreal.of_real (cond_cdf ρ a x) ∂ρ.fst = ρ (s ×ˢ Iic x) :=
+begin
+  -- We have the result for `x : ℚ` thanks to `set_lintegral_cond_cdf_rat`. We use the equality
+  -- `cond_cdf ρ a x = ⨅ r : {r' : ℚ // x < r'}, cond_cdf ρ a r` and a monotone convergence
+  -- argument to extend it to the reals.
+  by_cases hρ_zero : ρ.fst.restrict s = 0,
+  { rw [hρ_zero, lintegral_zero_measure],
+    refine le_antisymm (zero_le _) _,
+    calc ρ (s ×ˢ Iic x)
+        ≤ ρ (prod.fst ⁻¹' s) : measure_mono (prod_subset_preimage_fst s (Iic x))
+    ... = ρ.fst s : by rw [measure.fst_apply hs]
+    ... = ρ.fst.restrict s univ : by rw measure.restrict_apply_univ
+    ... = 0 : by simp only [hρ_zero, measure.coe_zero, pi.zero_apply], },
+  have h : ∫⁻ a in s, ennreal.of_real (cond_cdf ρ a x) ∂ρ.fst
+    = ∫⁻ a in s, ennreal.of_real (⨅ r : {r' : ℚ // x < r'}, cond_cdf ρ a r) ∂ρ.fst,
+  { congr' with a : 1,
+    rw ← (cond_cdf ρ a).infi_rat_gt_eq x, },
+  haveI h_nonempty : nonempty {r' : ℚ // x < ↑r'},
+  { obtain ⟨r, hrx⟩ := exists_rat_gt x,
+    exact ⟨⟨r, hrx⟩⟩, },
+  rw h,
+  simp_rw ennreal.of_real_cinfi,
+  have h_coe : ∀ b : {r' : ℚ // x < ↑r'}, (b : ℝ) = ((b : ℚ) : ℝ) := λ _, by congr,
+  rw lintegral_infi_directed_of_measurable hρ_zero
+    (λ q : {r' : ℚ // x < ↑r'}, (measurable_cond_cdf ρ q).ennreal_of_real),
+  rotate,
+  { intro b,
+    simp_rw h_coe,
+    rw [set_lintegral_cond_cdf_rat ρ _ hs],
+    exact measure_ne_top ρ _, },
+  { refine monotone.directed_ge (λ i j hij a, ennreal.of_real_le_of_real ((cond_cdf ρ a).mono _)),
+    rw [h_coe, h_coe],
+    exact_mod_cast hij, },
+  simp_rw [h_coe, set_lintegral_cond_cdf_rat ρ _ hs],
+  rw ← measure_Inter_eq_infi,
+  { rw ← prod_Inter,
+    congr' with y,
+    simp only [mem_Inter, mem_Iic, subtype.forall, subtype.coe_mk],
+    exact ⟨le_of_forall_lt_rat_imp_le, λ hyx q hq, hyx.trans hq.le⟩, },
+  { exact λ i, hs.prod measurable_set_Iic, },
+  { refine monotone.directed_ge (λ i j hij, _),
+    refine prod_subset_prod_iff.mpr (or.inl ⟨subset_rfl, Iic_subset_Iic.mpr _⟩),
+    exact_mod_cast hij, },
+  { exact ⟨h_nonempty.some, measure_ne_top _ _⟩, },
+end
+
+lemma lintegral_cond_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] (x : ℝ) :
+  ∫⁻ a, ennreal.of_real (cond_cdf ρ a x) ∂ρ.fst = ρ (univ ×ˢ Iic x) :=
+by rw [← set_lintegral_univ, set_lintegral_cond_cdf ρ _ measurable_set.univ]
+
+/-- The conditional cdf is a strongly measurable function of `a : α` for all `x : ℝ`. -/
+lemma strongly_measurable_cond_cdf (ρ : measure (α × ℝ)) (x : ℝ) :
+  strongly_measurable (λ a, cond_cdf ρ a x) :=
+(measurable_cond_cdf ρ x).strongly_measurable
+
+lemma integrable_cond_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] (x : ℝ) :
+  integrable (λ a, cond_cdf ρ a x) ρ.fst :=
+begin
+  refine integrable_of_forall_fin_meas_le _ (measure_lt_top ρ.fst univ) _ (λ t ht hρt, _),
+  { exact (strongly_measurable_cond_cdf ρ _).ae_strongly_measurable, },
+  { have : ∀ y, (‖cond_cdf ρ y x‖₊ : ℝ≥0∞) ≤ 1,
+    { intro y,
+      rw real.nnnorm_of_nonneg (cond_cdf_nonneg _ _ _),
+      exact_mod_cast cond_cdf_le_one _ _ _, },
+    refine (set_lintegral_mono (measurable_cond_cdf _ _).ennnorm
+      measurable_one (λ y _, this y)).trans _,
+    simp only [pi.one_apply, lintegral_one, measure.restrict_apply, measurable_set.univ,
+      univ_inter],
+    exact measure_mono (subset_univ _), },
+end
+
+lemma set_integral_cond_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] (x : ℝ)
+  {s : set α} (hs : measurable_set s) :
+  ∫ a in s, cond_cdf ρ a x ∂ρ.fst = (ρ (s ×ˢ Iic x)).to_real :=
+begin
+  have h := set_lintegral_cond_cdf ρ x hs,
+  rw ← of_real_integral_eq_lintegral_of_real at h,
+  { rw [← h, ennreal.to_real_of_real],
+    exact integral_nonneg (λ _, cond_cdf_nonneg _ _ _), },
+  { exact (integrable_cond_cdf _ _).integrable_on, },
+  { exact eventually_of_forall (λ _, cond_cdf_nonneg _ _ _), },
+end
+
+lemma integral_cond_cdf (ρ : measure (α × ℝ)) [is_finite_measure ρ] (x : ℝ) :
+  ∫ a, cond_cdf ρ a x ∂ρ.fst = (ρ (univ ×ˢ Iic x)).to_real :=
+by rw [← set_integral_cond_cdf ρ _ measurable_set.univ, measure.restrict_univ]
+
+section measure
+
+lemma measure_cond_cdf_Iic (ρ : measure (α × ℝ)) (a : α) (x : ℝ) :
+  (cond_cdf ρ a).measure (Iic x) = ennreal.of_real (cond_cdf ρ a x) :=
+begin
+  rw [← sub_zero (cond_cdf ρ a x)],
+  exact (cond_cdf ρ a).measure_Iic (tendsto_cond_cdf_at_bot ρ a) _,
+end
+
+lemma measure_cond_cdf_univ (ρ : measure (α × ℝ)) (a : α) :
+  (cond_cdf ρ a).measure univ = 1 :=
+begin
+  rw [← ennreal.of_real_one, ← sub_zero (1 : ℝ)],
+  exact stieltjes_function.measure_univ _ (tendsto_cond_cdf_at_bot ρ a)
+    (tendsto_cond_cdf_at_top ρ a),
+end
+
+instance (ρ : measure (α × ℝ)) (a : α) : is_probability_measure ((cond_cdf ρ a).measure) :=
+⟨measure_cond_cdf_univ ρ a⟩
+
+/-- The function `a ↦ (cond_cdf ρ a).measure` is measurable. -/
+lemma measurable_measure_cond_cdf (ρ : measure (α × ℝ)) :
+  measurable (λ a, (cond_cdf ρ a).measure) :=
+begin
+  rw measure.measurable_measure,
+  refine λ s hs, measurable_space.induction_on_inter
+    (borel_eq_generate_from_Iic ℝ) is_pi_system_Iic _ _ _ _ hs,
+  { simp only [measure_empty, measurable_const], },
+  { rintros S ⟨u, rfl⟩,
+    simp_rw measure_cond_cdf_Iic ρ _ u,
+    exact (measurable_cond_cdf ρ u).ennreal_of_real, },
+  { intros t ht ht_cd_meas,
+    have : (λ a, (cond_cdf ρ a).measure tᶜ)
+      = (λ a, (cond_cdf ρ a).measure univ) - (λ a, (cond_cdf ρ a).measure t),
+    { ext1 a,
+      rw [measure_compl ht (measure_ne_top (cond_cdf ρ a).measure _), pi.sub_apply], },
+    simp_rw [this, measure_cond_cdf_univ ρ],
+    exact measurable.sub measurable_const ht_cd_meas, },
+  { intros f hf_disj hf_meas hf_cd_meas,
+    simp_rw measure_Union hf_disj hf_meas,
+    exact measurable.ennreal_tsum hf_cd_meas, },
+end
+
+end measure
+
+end probability_theory
diff --git a/src/probability/kernel/cond_distrib.lean b/src/probability/kernel/cond_distrib.lean
new file mode 100644
index 0000000000000..d1a141b01b8e4
--- /dev/null
+++ b/src/probability/kernel/cond_distrib.lean
@@ -0,0 +1,318 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.kernel.disintegration
+import probability.notation
+
+/-!
+# Regular conditional probability distribution
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the regular conditional probability distribution of `Y : α → Ω` given `X : α → β`, where
+`Ω` is a standard Borel space. This is a `kernel β Ω` such that for almost all `a`, `cond_distrib`
+evaluated at `X a` and a measurable set `s` is equal to the conditional expectation
+`μ⟦Y ⁻¹' s | mβ.comap X⟧` evaluated at `a`.
+
+`μ⟦Y ⁻¹' s | mβ.comap X⟧` maps a measurable set `s` to a function `α → ℝ≥0∞`, and for all `s` that
+map is unique up to a `μ`-null set. For all `a`, the map from sets to `ℝ≥0∞` that we obtain that way
+verifies some of the properties of a measure, but in general the fact that the `μ`-null set depends
+on `s` can prevent us from finding versions of the conditional expectation that combine into a true
+measure. The standard Borel space assumption on `Ω` allows us to do so.
+
+The case `Y = X = id` is developed in more detail in `probability/kernel/condexp.lean`: here `X` is
+understood as a map from `Ω` with a sub-σ-algebra to `Ω` with its default σ-algebra and the
+conditional distribution defines a kernel associated with the conditional expectation with respect
+to `m`.
+
+## Main definitions
+
+* `cond_distrib Y X μ`: regular conditional probability distribution of `Y : α → Ω` given
+  `X : α → β`, where `Ω` is a standard Borel space.
+
+## Main statements
+
+* `cond_distrib_ae_eq_condexp`: for almost all `a`, `cond_distrib` evaluated at `X a` and a
+  measurable set `s` is equal to the conditional expectation `μ⟦Y ⁻¹' s | mβ.comap X⟧ a`.
+* `condexp_prod_ae_eq_integral_cond_distrib`: the conditional expectation
+  `μ[(λ a, f (X a, Y a)) | X ; mβ]` is almost everywhere equal to the integral
+  `∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a))`.
+
+-/
+
+open measure_theory set filter topological_space
+
+open_locale ennreal measure_theory probability_theory
+
+namespace probability_theory
+
+variables {α β Ω F : Type*}
+  [topological_space Ω] [measurable_space Ω] [polish_space Ω] [borel_space Ω] [nonempty Ω]
+  [normed_add_comm_group F]
+  {mα : measurable_space α} {μ : measure α} [is_finite_measure μ] {X : α → β} {Y : α → Ω}
+
+/-- **Regular conditional probability distribution**: kernel associated with the conditional
+expectation of `Y` given `X`.
+For almost all `a`, `cond_distrib Y X μ` evaluated at `X a` and a measurable set `s` is equal to
+the conditional expectation `μ⟦Y ⁻¹' s | mβ.comap X⟧ a`. It also satisfies the equality
+`μ[(λ a, f (X a, Y a)) | mβ.comap X] =ᵐ[μ] λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a))` for
+all integrable functions `f`. -/
+@[irreducible] noncomputable
+def cond_distrib {mα : measurable_space α} [measurable_space β]
+  (Y : α → Ω) (X : α → β) (μ : measure α) [is_finite_measure μ] :
+  kernel β Ω :=
+(μ.map (λ a, (X a, Y a))).cond_kernel
+
+instance [measurable_space β] : is_markov_kernel (cond_distrib Y X μ) :=
+by { rw cond_distrib, apply_instance, }
+
+variables {mβ : measurable_space β} {s : set Ω} {t : set β} {f : β × Ω → F}
+include mβ
+
+section measurability
+
+lemma measurable_cond_distrib (hs : measurable_set s) :
+  measurable[mβ.comap X] (λ a, cond_distrib Y X μ (X a) s) :=
+(kernel.measurable_coe _ hs).comp (measurable.of_comap_le le_rfl)
+
+lemma _root_.measure_theory.ae_strongly_measurable.ae_integrable_cond_distrib_map_iff
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf : ae_strongly_measurable f (μ.map (λ a, (X a, Y a)))) :
+  (∀ᵐ a ∂(μ.map X), integrable (λ ω, f (a, ω)) (cond_distrib Y X μ a))
+    ∧ integrable (λ a, ∫ ω, ‖f (a, ω)‖ ∂(cond_distrib Y X μ a)) (μ.map X)
+  ↔ integrable f (μ.map (λ a, (X a, Y a))) :=
+by rw [cond_distrib, ← hf.ae_integrable_cond_kernel_iff, measure.fst_map_prod_mk₀ hX hY]
+
+variables [normed_space ℝ F] [complete_space F]
+
+lemma _root_.measure_theory.ae_strongly_measurable.integral_cond_distrib_map
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf : ae_strongly_measurable f (μ.map (λ a, (X a, Y a)))) :
+  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂(cond_distrib Y X μ x)) (μ.map X) :=
+by { rw [← measure.fst_map_prod_mk₀ hX hY, cond_distrib], exact hf.integral_cond_kernel, }
+
+lemma _root_.measure_theory.ae_strongly_measurable.integral_cond_distrib
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf : ae_strongly_measurable f (μ.map (λ a, (X a, Y a)))) :
+  ae_strongly_measurable (λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a))) μ :=
+(hf.integral_cond_distrib_map hX hY).comp_ae_measurable hX
+
+lemma ae_strongly_measurable'_integral_cond_distrib
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf : ae_strongly_measurable f (μ.map (λ a, (X a, Y a)))) :
+  ae_strongly_measurable' (mβ.comap X) (λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a))) μ :=
+(hf.integral_cond_distrib_map hX hY).comp_ae_measurable' hX
+
+end measurability
+
+section integrability
+
+lemma integrable_to_real_cond_distrib (hX : ae_measurable X μ) (hs : measurable_set s) :
+  integrable (λ a, (cond_distrib Y X μ (X a) s).to_real) μ :=
+begin
+  refine integrable_to_real_of_lintegral_ne_top _ _,
+  { exact measurable.comp_ae_measurable (kernel.measurable_coe _ hs) hX, },
+  { refine ne_of_lt _,
+    calc ∫⁻ a, cond_distrib Y X μ (X a) s ∂μ
+        ≤ ∫⁻ a, 1 ∂μ : lintegral_mono (λ a, prob_le_one)
+    ... = μ univ : lintegral_one
+    ... < ∞ : measure_lt_top _ _, },
+end
+
+lemma _root_.measure_theory.integrable.cond_distrib_ae_map
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  ∀ᵐ b ∂(μ.map X), integrable (λ ω, f (b, ω)) (cond_distrib Y X μ b) :=
+by { rw [cond_distrib, ← measure.fst_map_prod_mk₀ hX hY], exact hf_int.cond_kernel_ae, }
+
+lemma _root_.measure_theory.integrable.cond_distrib_ae
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  ∀ᵐ a ∂μ, integrable (λ ω, f (X a, ω)) (cond_distrib Y X μ (X a)) :=
+ae_of_ae_map hX (hf_int.cond_distrib_ae_map hX hY)
+
+lemma _root_.measure_theory.integrable.integral_norm_cond_distrib_map
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  integrable (λ x, ∫ y, ‖f (x, y)‖ ∂(cond_distrib Y X μ x)) (μ.map X) :=
+by { rw [cond_distrib, ← measure.fst_map_prod_mk₀ hX hY], exact hf_int.integral_norm_cond_kernel, }
+
+lemma _root_.measure_theory.integrable.integral_norm_cond_distrib
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  integrable (λ a, ∫ y, ‖f (X a, y)‖ ∂(cond_distrib Y X μ (X a))) μ :=
+(hf_int.integral_norm_cond_distrib_map hX hY).comp_ae_measurable hX
+
+variables [normed_space ℝ F] [complete_space F]
+
+lemma _root_.measure_theory.integrable.norm_integral_cond_distrib_map
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  integrable (λ x, ‖∫ y, f (x, y) ∂(cond_distrib Y X μ x)‖) (μ.map X) :=
+by { rw [cond_distrib, ← measure.fst_map_prod_mk₀ hX hY], exact hf_int.norm_integral_cond_kernel, }
+
+lemma _root_.measure_theory.integrable.norm_integral_cond_distrib
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  integrable (λ a, ‖∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a))‖) μ :=
+(hf_int.norm_integral_cond_distrib_map hX hY).comp_ae_measurable hX
+
+lemma _root_.measure_theory.integrable.integral_cond_distrib_map
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  integrable (λ x, ∫ y, f (x, y) ∂(cond_distrib Y X μ x)) (μ.map X) :=
+(integrable_norm_iff (hf_int.1.integral_cond_distrib_map hX hY)).mp
+  (hf_int.norm_integral_cond_distrib_map hX hY)
+
+lemma _root_.measure_theory.integrable.integral_cond_distrib
+  (hX : ae_measurable X μ) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  integrable (λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a))) μ :=
+(hf_int.integral_cond_distrib_map hX hY).comp_ae_measurable hX
+
+end integrability
+
+lemma set_lintegral_preimage_cond_distrib (hX : measurable X) (hY : ae_measurable Y μ)
+  (hs : measurable_set s) (ht : measurable_set t) :
+  ∫⁻ a in X ⁻¹' t, cond_distrib Y X μ (X a) s ∂μ = μ (X ⁻¹' t ∩ Y ⁻¹' s) :=
+by rw [lintegral_comp (kernel.measurable_coe _ hs) hX, cond_distrib,
+  ← measure.restrict_map hX ht, ← measure.fst_map_prod_mk₀ hX.ae_measurable hY,
+  set_lintegral_cond_kernel_eq_measure_prod _ ht hs,
+  measure.map_apply_of_ae_measurable (hX.ae_measurable.prod_mk hY) (ht.prod hs),
+  mk_preimage_prod]
+
+lemma set_lintegral_cond_distrib_of_measurable_set (hX : measurable X) (hY : ae_measurable Y μ)
+  (hs : measurable_set s) {t : set α} (ht : measurable_set[mβ.comap X] t) :
+  ∫⁻ a in t, cond_distrib Y X μ (X a) s ∂μ = μ (t ∩ Y ⁻¹' s) :=
+by { obtain ⟨t', ht', rfl⟩ := ht, rw set_lintegral_preimage_cond_distrib hX hY hs ht', }
+
+/-- For almost every `a : α`, the `cond_distrib Y X μ` kernel applied to `X a` and a measurable set
+`s` is equal to the conditional expectation of the indicator of `Y ⁻¹' s`. -/
+lemma cond_distrib_ae_eq_condexp (hX : measurable X) (hY : measurable Y) (hs : measurable_set s) :
+  (λ a, (cond_distrib Y X μ (X a) s).to_real) =ᵐ[μ] μ⟦Y ⁻¹' s | mβ.comap X⟧ :=
+begin
+  refine ae_eq_condexp_of_forall_set_integral_eq hX.comap_le _ _ _ _,
+  { exact (integrable_const _).indicator (hY hs),  },
+  { exact λ t ht _, (integrable_to_real_cond_distrib hX.ae_measurable hs).integrable_on, },
+  { intros t ht _,
+    rw [integral_to_real ((measurable_cond_distrib hs).mono hX.comap_le le_rfl).ae_measurable
+        (eventually_of_forall (λ ω, measure_lt_top (cond_distrib Y X μ (X ω)) _)),
+      integral_indicator_const _ (hY hs), measure.restrict_apply (hY hs), smul_eq_mul, mul_one,
+      inter_comm, set_lintegral_cond_distrib_of_measurable_set hX hY.ae_measurable hs ht], },
+  { refine (measurable.strongly_measurable _).ae_strongly_measurable',
+    exact @measurable.ennreal_to_real _ (mβ.comap X) _ (measurable_cond_distrib hs), },
+end
+
+/-- The conditional expectation of a function `f` of the product `(X, Y)` is almost everywhere equal
+to the integral of `y ↦ f(X, y)` against the `cond_distrib` kernel. -/
+lemma condexp_prod_ae_eq_integral_cond_distrib' [normed_space ℝ F] [complete_space F]
+  (hX : measurable X) (hY : ae_measurable Y μ)
+  (hf_int : integrable f (μ.map (λ a, (X a, Y a)))) :
+  μ[(λ a, f (X a, Y a)) | mβ.comap X] =ᵐ[μ] λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a)) :=
+begin
+  have hf_int' : integrable (λ a, f (X a, Y a)) μ,
+  { exact (integrable_map_measure hf_int.1 (hX.ae_measurable.prod_mk hY)).mp hf_int, },
+  refine (ae_eq_condexp_of_forall_set_integral_eq hX.comap_le hf_int' (λ s hs hμs, _) _ _).symm,
+  { exact (hf_int.integral_cond_distrib hX.ae_measurable hY).integrable_on, },
+  { rintros s ⟨t, ht, rfl⟩ _,
+    change ∫ a in X ⁻¹' t, ((λ x', ∫ y, f (x', y) ∂(cond_distrib Y X μ) x') ∘ X) a ∂μ
+      = ∫ a in X ⁻¹' t, f (X a, Y a) ∂μ,
+    rw ← integral_map hX.ae_measurable,
+    swap,
+    { rw ← measure.restrict_map hX ht,
+      exact (hf_int.1.integral_cond_distrib_map hX.ae_measurable hY).restrict, },
+    rw [← measure.restrict_map hX ht, ← measure.fst_map_prod_mk₀ hX.ae_measurable hY, cond_distrib,
+      set_integral_cond_kernel_univ_right ht hf_int.integrable_on,
+      set_integral_map (ht.prod measurable_set.univ) hf_int.1 (hX.ae_measurable.prod_mk hY),
+      mk_preimage_prod, preimage_univ, inter_univ], },
+  { exact ae_strongly_measurable'_integral_cond_distrib hX.ae_measurable hY hf_int.1, },
+end
+
+/-- The conditional expectation of a function `f` of the product `(X, Y)` is almost everywhere equal
+to the integral of `y ↦ f(X, y)` against the `cond_distrib` kernel. -/
+lemma condexp_prod_ae_eq_integral_cond_distrib₀ [normed_space ℝ F] [complete_space F]
+  (hX : measurable X) (hY : ae_measurable Y μ)
+  (hf : ae_strongly_measurable f (μ.map (λ a, (X a, Y a))))
+  (hf_int : integrable (λ a, f (X a, Y a)) μ) :
+  μ[(λ a, f (X a, Y a)) | mβ.comap X] =ᵐ[μ] λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a)) :=
+begin
+  have hf_int' : integrable f (μ.map (λ a, (X a, Y a))),
+  { rwa integrable_map_measure hf (hX.ae_measurable.prod_mk hY), },
+  exact condexp_prod_ae_eq_integral_cond_distrib' hX hY hf_int',
+end
+
+/-- The conditional expectation of a function `f` of the product `(X, Y)` is almost everywhere equal
+to the integral of `y ↦ f(X, y)` against the `cond_distrib` kernel. -/
+lemma condexp_prod_ae_eq_integral_cond_distrib [normed_space ℝ F] [complete_space F]
+  (hX : measurable X) (hY : ae_measurable Y μ)
+  (hf : strongly_measurable f) (hf_int : integrable (λ a, f (X a, Y a)) μ) :
+  μ[(λ a, f (X a, Y a)) | mβ.comap X] =ᵐ[μ] λ a, ∫ y, f (X a, y) ∂(cond_distrib Y X μ (X a)) :=
+begin
+  have hf_int' : integrable f (μ.map (λ a, (X a, Y a))),
+  { rwa integrable_map_measure hf.ae_strongly_measurable (hX.ae_measurable.prod_mk hY), },
+  exact condexp_prod_ae_eq_integral_cond_distrib' hX hY hf_int',
+end
+
+lemma condexp_ae_eq_integral_cond_distrib [normed_space ℝ F] [complete_space F]
+  (hX : measurable X) (hY : ae_measurable Y μ)
+  {f : Ω → F} (hf : strongly_measurable f) (hf_int : integrable (λ a, f (Y a)) μ) :
+  μ[(λ a, f (Y a)) | mβ.comap X] =ᵐ[μ] λ a, ∫ y, f y ∂(cond_distrib Y X μ (X a)) :=
+condexp_prod_ae_eq_integral_cond_distrib hX hY (hf.comp_measurable measurable_snd) hf_int
+
+/-- The conditional expectation of `Y` given `X` is almost everywhere equal to the integral
+`∫ y, y ∂(cond_distrib Y X μ (X a))`. -/
+lemma condexp_ae_eq_integral_cond_distrib' {Ω} [normed_add_comm_group Ω] [normed_space ℝ Ω]
+  [complete_space Ω] [measurable_space Ω] [borel_space Ω] [second_countable_topology Ω] {Y : α → Ω}
+  (hX : measurable X) (hY_int : integrable Y μ) :
+  μ[Y | mβ.comap X] =ᵐ[μ] λ a, ∫ y, y ∂(cond_distrib Y X μ (X a)) :=
+condexp_ae_eq_integral_cond_distrib hX hY_int.1.ae_measurable strongly_measurable_id hY_int
+
+lemma _root_.measure_theory.ae_strongly_measurable.comp_snd_map_prod_mk
+  {Ω F} {mΩ : measurable_space Ω} {X : Ω → β} {μ : measure Ω}
+  [topological_space F] (hX : measurable X) {f : Ω → F} (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x : β × Ω, f x.2) (μ.map (λ ω, (X ω, ω))) :=
+begin
+  refine ⟨λ x, hf.mk f x.2, hf.strongly_measurable_mk.comp_measurable measurable_snd, _⟩,
+  suffices h : measure.quasi_measure_preserving prod.snd (μ.map (λ ω, (X ω, ω))) μ,
+  { exact measure.quasi_measure_preserving.ae_eq h hf.ae_eq_mk, },
+  refine ⟨measurable_snd, measure.absolutely_continuous.mk (λ s hs hμs, _)⟩,
+  rw measure.map_apply _ hs,
+  swap, { exact measurable_snd, },
+  rw measure.map_apply,
+  { rw [← univ_prod, mk_preimage_prod, preimage_univ, univ_inter, preimage_id'],
+    exact hμs, },
+  { exact hX.prod_mk measurable_id, },
+  { exact measurable_snd hs, },
+end
+
+lemma _root_.measure_theory.integrable.comp_snd_map_prod_mk {Ω} {mΩ : measurable_space Ω}
+  {X : Ω → β} {μ : measure Ω} (hX : measurable X) {f : Ω → F} (hf_int : integrable f μ) :
+  integrable (λ x : β × Ω, f x.2) (μ.map (λ ω, (X ω, ω))) :=
+begin
+  have hf := hf_int.1.comp_snd_map_prod_mk hX,
+  refine ⟨hf, _⟩,
+  rw [has_finite_integral, lintegral_map' hf.ennnorm (hX.prod_mk measurable_id).ae_measurable],
+  exact hf_int.2,
+end
+
+lemma ae_strongly_measurable_comp_snd_map_prod_mk_iff {Ω F} {mΩ : measurable_space Ω}
+  [topological_space F] {X : Ω → β} {μ : measure Ω} (hX : measurable X) {f : Ω → F} :
+  ae_strongly_measurable (λ x : β × Ω, f x.2) (μ.map (λ ω, (X ω, ω)))
+    ↔ ae_strongly_measurable f μ :=
+⟨λ h, h.comp_measurable (hX.prod_mk measurable_id), λ h, h.comp_snd_map_prod_mk hX⟩
+
+lemma integrable_comp_snd_map_prod_mk_iff {Ω} {mΩ : measurable_space Ω} {X : Ω → β} {μ : measure Ω}
+  (hX : measurable X) {f : Ω → F} :
+  integrable (λ x : β × Ω, f x.2) (μ.map (λ ω, (X ω, ω))) ↔ integrable f μ :=
+⟨λ h, h.comp_measurable (hX.prod_mk measurable_id), λ h, h.comp_snd_map_prod_mk hX⟩
+
+lemma condexp_ae_eq_integral_cond_distrib_id [normed_space ℝ F] [complete_space F]
+  {X : Ω → β} {μ : measure Ω} [is_finite_measure μ]
+  (hX : measurable X) {f : Ω → F} (hf_int : integrable f μ) :
+  μ[f | mβ.comap X] =ᵐ[μ] λ a, ∫ y, f y ∂(cond_distrib id X μ (X a)) :=
+condexp_prod_ae_eq_integral_cond_distrib' hX ae_measurable_id (hf_int.comp_snd_map_prod_mk hX)
+
+end probability_theory
diff --git a/src/probability/kernel/condexp.lean b/src/probability/kernel/condexp.lean
new file mode 100644
index 0000000000000..d63c7bb03b265
--- /dev/null
+++ b/src/probability/kernel/condexp.lean
@@ -0,0 +1,178 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.kernel.cond_distrib
+
+/-!
+# Kernel associated with a conditional expectation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define `condexp_kernel μ m`, a kernel from `Ω` to `Ω` such that for all integrable functions `f`,
+`μ[f | m] =ᵐ[μ] λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)`.
+
+This kernel is defined if `Ω` is a standard Borel space. In general, `μ⟦s | m⟧` maps a measurable
+set `s` to a function `Ω → ℝ≥0∞`, and for all `s` that map is unique up to a `μ`-null set. For all
+`a`, the map from sets to `ℝ≥0∞` that we obtain that way verifies some of the properties of a
+measure, but the fact that the `μ`-null set depends on `s` can prevent us from finding versions of
+the conditional expectation that combine into a true measure. The standard Borel space assumption
+on `Ω` allows us to do so.
+
+## Main definitions
+
+* `condexp_kernel μ m`: kernel such that `μ[f | m] =ᵐ[μ] λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)`.
+
+## Main statements
+
+* `condexp_ae_eq_integral_condexp_kernel`: `μ[f | m] =ᵐ[μ] λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)`.
+
+-/
+
+open measure_theory set filter topological_space
+
+open_locale ennreal measure_theory probability_theory
+
+namespace probability_theory
+
+section aux_lemmas
+
+variables {Ω F : Type*} {m mΩ : measurable_space Ω} {μ : measure Ω} {f : Ω → F}
+
+-- todo after the port: move to measure_theory/measurable_space, after measurable.mono
+lemma measurable_id'' (hm : m ≤ mΩ) :
+  @measurable Ω Ω mΩ m id :=
+measurable_id.mono le_rfl hm
+
+-- todo after the port: move to measure_theory/measurable_space, after measurable.mono
+lemma ae_measurable_id'' (μ : measure Ω) (hm : m ≤ mΩ) :
+  @ae_measurable Ω Ω m mΩ id μ :=
+@measurable.ae_measurable Ω Ω mΩ m id μ (measurable_id'' hm)
+
+lemma _root_.measure_theory.ae_strongly_measurable.comp_snd_map_prod_id [topological_space F]
+  (hm : m ≤ mΩ) (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ x : Ω × Ω, f x.2)
+    (@measure.map Ω (Ω × Ω) (m.prod mΩ) mΩ (λ ω, (id ω, id ω)) μ) :=
+begin
+  rw ← ae_strongly_measurable_comp_snd_map_prod_mk_iff (measurable_id'' hm) at hf,
+  simp_rw [id.def] at hf ⊢,
+  exact hf,
+end
+
+lemma _root_.measure_theory.integrable.comp_snd_map_prod_id [normed_add_comm_group F]
+  (hm : m ≤ mΩ) (hf : integrable f μ) :
+  integrable (λ x : Ω × Ω, f x.2)
+    (@measure.map Ω (Ω × Ω) (m.prod mΩ) mΩ (λ ω, (id ω, id ω)) μ) :=
+begin
+  rw ← integrable_comp_snd_map_prod_mk_iff (measurable_id'' hm) at hf,
+  simp_rw [id.def] at hf ⊢,
+  exact hf,
+end
+
+end aux_lemmas
+
+variables {Ω F : Type*} [topological_space Ω] {m : measurable_space Ω} [mΩ : measurable_space Ω]
+  [polish_space Ω] [borel_space Ω] [nonempty Ω]
+  {μ : measure Ω} [is_finite_measure μ]
+  [normed_add_comm_group F] {f : Ω → F}
+
+/-- Kernel associated with the conditional expectation with respect to a σ-algebra. It satisfies
+`μ[f | m] =ᵐ[μ] λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)`.
+It is defined as the conditional distribution of the identity given the identity, where the second
+identity is understood as a map from `Ω` with the σ-algebra `mΩ` to `Ω` with σ-algebra `m`. -/
+@[irreducible] noncomputable
+def condexp_kernel (μ : measure Ω) [is_finite_measure μ] (m : measurable_space Ω) :
+  @kernel Ω Ω m mΩ :=
+@cond_distrib Ω Ω Ω _ mΩ _ _ _ mΩ m id id μ _
+
+section measurability
+
+lemma measurable_condexp_kernel {s : set Ω} (hs : measurable_set s) :
+  measurable[m] (λ ω, condexp_kernel μ m ω s) :=
+by { rw condexp_kernel, convert measurable_cond_distrib hs, rw measurable_space.comap_id, }
+
+lemma _root_.measure_theory.ae_strongly_measurable.integral_condexp_kernel
+  [normed_space ℝ F] [complete_space F]
+  (hm : m ≤ mΩ) (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable (λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)) μ :=
+begin
+  rw condexp_kernel,
+  exact ae_strongly_measurable.integral_cond_distrib
+    (ae_measurable_id'' μ hm) ae_measurable_id (hf.comp_snd_map_prod_id hm),
+end
+
+lemma ae_strongly_measurable'_integral_condexp_kernel [normed_space ℝ F] [complete_space F]
+  (hm : m ≤ mΩ) (hf : ae_strongly_measurable f μ) :
+  ae_strongly_measurable' m (λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)) μ :=
+begin
+  rw condexp_kernel,
+  have h := ae_strongly_measurable'_integral_cond_distrib
+    (ae_measurable_id'' μ hm) ae_measurable_id (hf.comp_snd_map_prod_id hm),
+  rwa measurable_space.comap_id at h,
+end
+
+end measurability
+
+section integrability
+
+lemma _root_.measure_theory.integrable.condexp_kernel_ae
+  (hm : m ≤ mΩ) (hf_int : integrable f μ) :
+  ∀ᵐ ω ∂μ, integrable f (condexp_kernel μ m ω) :=
+begin
+  rw condexp_kernel,
+  exact integrable.cond_distrib_ae (ae_measurable_id'' μ hm)
+    ae_measurable_id (hf_int.comp_snd_map_prod_id hm),
+end
+
+lemma _root_.measure_theory.integrable.integral_norm_condexp_kernel
+  (hm : m ≤ mΩ) (hf_int : integrable f μ) :
+  integrable (λ ω, ∫ y, ‖f y‖ ∂(condexp_kernel μ m ω)) μ :=
+begin
+  rw condexp_kernel,
+  exact integrable.integral_norm_cond_distrib (ae_measurable_id'' μ hm)
+    ae_measurable_id (hf_int.comp_snd_map_prod_id hm),
+end
+
+lemma _root_.measure_theory.integrable.norm_integral_condexp_kernel
+  [normed_space ℝ F] [complete_space F]
+  (hm : m ≤ mΩ) (hf_int : integrable f μ) :
+  integrable (λ ω, ‖∫ y, f y ∂(condexp_kernel μ m ω)‖) μ :=
+begin
+  rw condexp_kernel,
+  exact integrable.norm_integral_cond_distrib (ae_measurable_id'' μ hm)
+    ae_measurable_id (hf_int.comp_snd_map_prod_id hm),
+end
+
+lemma _root_.measure_theory.integrable.integral_condexp_kernel [normed_space ℝ F] [complete_space F]
+  (hm : m ≤ mΩ) (hf_int : integrable f μ) :
+  integrable (λ ω, ∫ y, f y ∂(condexp_kernel μ m ω)) μ :=
+begin
+  rw condexp_kernel,
+  exact integrable.integral_cond_distrib (ae_measurable_id'' μ hm)
+    ae_measurable_id (hf_int.comp_snd_map_prod_id hm),
+end
+
+lemma integrable_to_real_condexp_kernel (hm : m ≤ mΩ) {s : set Ω} (hs : measurable_set s) :
+  integrable (λ ω, (condexp_kernel μ m ω s).to_real) μ :=
+begin
+  rw condexp_kernel,
+  exact integrable_to_real_cond_distrib (ae_measurable_id'' μ hm) hs,
+end
+
+end integrability
+
+/-- The conditional expectation of `f` with respect to a σ-algebra `m` is almost everywhere equal to
+the integral `∫ y, f y ∂(condexp_kernel μ m ω)`. -/
+lemma condexp_ae_eq_integral_condexp_kernel [normed_space ℝ F] [complete_space F]
+  (hm : m ≤ mΩ) (hf_int : integrable f μ) :
+  μ[f | m] =ᵐ[μ] λ ω, ∫ y, f y ∂(condexp_kernel μ m ω) :=
+begin
+  have hX : @measurable Ω Ω mΩ m id := measurable_id.mono le_rfl hm,
+  rw condexp_kernel,
+  refine eventually_eq.trans _ (condexp_ae_eq_integral_cond_distrib_id hX hf_int),
+  simp only [measurable_space.comap_id, id.def],
+end
+
+end probability_theory
diff --git a/src/probability/kernel/disintegration.lean b/src/probability/kernel/disintegration.lean
new file mode 100644
index 0000000000000..3636f104864f4
--- /dev/null
+++ b/src/probability/kernel/disintegration.lean
@@ -0,0 +1,561 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.kernel.cond_cdf
+import measure_theory.constructions.polish
+import probability.kernel.integral_comp_prod
+
+/-!
+# Disintegration of measures on product spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `ρ` be a finite measure on `α × Ω`, where `Ω` is a standard Borel space. In mathlib terms, `Ω`
+verifies `[nonempty Ω] [topological_space Ω] [polish_space Ω] [measurable_space Ω] [borel_space Ω]`.
+Then there exists a kernel `ρ.cond_kernel : kernel α Ω` such that for any measurable set
+`s : set (α × Ω)`, `ρ s = ∫⁻ a, ρ.cond_kernel a {x | (a, x) ∈ s} ∂ρ.fst`.
+
+In terms of kernels, `ρ.cond_kernel` is such that for any measurable space `γ`, we
+have a disintegration of the constant kernel from `γ` with value `ρ`:
+`kernel.const γ ρ = (kernel.const γ ρ.fst) ⊗ₖ (kernel.prod_mk_left γ (cond_kernel ρ))`,
+where `ρ.fst` is the marginal measure of `ρ` on `α`. In particular,
+`ρ = ((kernel.const unit ρ.fst) ⊗ₖ (kernel.prod_mk_left unit (cond_kernel ρ))) ()`.
+
+In order to obtain a disintegration for any standard Borel space, we use that these spaces embed
+measurably into `ℝ`: it then suffices to define a suitable kernel for `Ω = ℝ`. In the real case,
+we define a conditional kernel by taking for each `a : α` the measure associated to the Stieltjes
+function `cond_cdf ρ a` (the conditional cumulative distribution function).
+
+## Main definitions
+
+* `measure_theory.measure.cond_kernel ρ : kernel α Ω`: conditional kernel described above.
+
+## Main statements
+
+* `probability_theory.lintegral_cond_kernel`:
+  `∫⁻ a, ∫⁻ ω, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫⁻ x, f x ∂ρ`
+* `probability_theory.lintegral_cond_kernel_mem`:
+  `∫⁻ a, ρ.cond_kernel a {x | (a, x) ∈ s} ∂ρ.fst = ρ s`
+* `probability_theory.kernel.const_eq_comp_prod`:
+  `kernel.const γ ρ = (kernel.const γ ρ.fst) ⊗ₖ (kernel.prod_mk_left γ ρ.cond_kernel)`
+* `probability_theory.measure_eq_comp_prod`:
+  `ρ = ((kernel.const unit ρ.fst) ⊗ₖ (kernel.prod_mk_left unit ρ.cond_kernel)) ()`
+
+-/
+
+open measure_theory set filter
+
+open_locale ennreal measure_theory topology probability_theory
+
+namespace probability_theory
+
+variables {α : Type*} {mα : measurable_space α}
+
+include mα
+
+section real
+
+/-! ### Disintegration of measures on `α × ℝ` -/
+
+/-- Conditional measure on the second space of the product given the value on the first, as a
+kernel. Use the more general `cond_kernel`. -/
+noncomputable
+def cond_kernel_real (ρ : measure (α × ℝ)) : kernel α ℝ :=
+{ val := λ a, (cond_cdf ρ a).measure,
+  property := measurable_measure_cond_cdf ρ }
+
+instance (ρ : measure (α × ℝ)) : is_markov_kernel (cond_kernel_real ρ) :=
+⟨λ a, by { rw cond_kernel_real, apply_instance, } ⟩
+
+lemma cond_kernel_real_Iic (ρ : measure (α × ℝ)) (a : α) (x : ℝ) :
+  cond_kernel_real ρ a (Iic x) = ennreal.of_real (cond_cdf ρ a x) :=
+measure_cond_cdf_Iic ρ a x
+
+lemma set_lintegral_cond_kernel_real_Iic (ρ : measure (α × ℝ)) [is_finite_measure ρ] (x : ℝ)
+  {s : set α} (hs : measurable_set s) :
+  ∫⁻ a in s, cond_kernel_real ρ a (Iic x) ∂ρ.fst = ρ (s ×ˢ Iic x) :=
+by { simp_rw [cond_kernel_real_Iic], exact set_lintegral_cond_cdf ρ x hs, }
+
+lemma set_lintegral_cond_kernel_real_univ (ρ : measure (α × ℝ))
+  {s : set α} (hs : measurable_set s) :
+  ∫⁻ a in s, cond_kernel_real ρ a univ ∂ρ.fst = ρ (s ×ˢ univ) :=
+by simp only [measure_univ, lintegral_const, measure.restrict_apply, measurable_set.univ,
+  univ_inter, one_mul, measure.fst_apply hs, ← prod_univ]
+
+lemma lintegral_cond_kernel_real_univ (ρ : measure (α × ℝ)) :
+  ∫⁻ a, cond_kernel_real ρ a univ ∂ρ.fst = ρ univ :=
+by rw [← set_lintegral_univ, set_lintegral_cond_kernel_real_univ ρ measurable_set.univ,
+  univ_prod_univ]
+
+variables (ρ : measure (α × ℝ)) [is_finite_measure ρ]
+
+lemma set_lintegral_cond_kernel_real_prod
+  {s : set α} (hs : measurable_set s) {t : set ℝ} (ht : measurable_set t) :
+  ∫⁻ a in s, cond_kernel_real ρ a t ∂ρ.fst = ρ (s ×ˢ t) :=
+begin
+  -- `set_lintegral_cond_kernel_real_Iic` gives the result for `t = Iic x`. These sets form a
+  -- π-system that generate the borel σ-algebra, hence we can get the same equality for any
+  -- measurable set `t`.
+  refine measurable_space.induction_on_inter (borel_eq_generate_from_Iic ℝ)
+    is_pi_system_Iic _ _ _ _ ht,
+  { simp only [measure_empty, lintegral_const, zero_mul, prod_empty], },
+  { rintros t ⟨q, rfl⟩,
+    exact set_lintegral_cond_kernel_real_Iic ρ q hs, },
+  { intros t ht ht_lintegral,
+    calc ∫⁻ a in s, cond_kernel_real ρ a tᶜ ∂ρ.fst
+        = ∫⁻ a in s, (cond_kernel_real ρ a univ) - cond_kernel_real ρ a t ∂ρ.fst :
+      by { congr' with a, rw measure_compl ht (measure_ne_top (cond_kernel_real ρ a) _), }
+    ... = ∫⁻ a in s, (cond_kernel_real ρ a univ) ∂ρ.fst - ∫⁻ a in s, cond_kernel_real ρ a t ∂ρ.fst :
+      begin
+        rw lintegral_sub (kernel.measurable_coe (cond_kernel_real ρ) ht),
+        { rw ht_lintegral,
+          exact measure_ne_top ρ _, },
+        { exact eventually_of_forall (λ a, measure_mono (subset_univ _)), },
+      end
+    ... = ρ (s ×ˢ univ) - ρ (s ×ˢ t) :
+      by rw [set_lintegral_cond_kernel_real_univ ρ hs, ht_lintegral]
+    ... = ρ (s ×ˢ tᶜ) :
+      begin
+        rw ← measure_diff _ (hs.prod ht) (measure_ne_top ρ _),
+        { rw [prod_diff_prod, compl_eq_univ_diff],
+          simp only [diff_self, empty_prod, union_empty], },
+        { rw prod_subset_prod_iff,
+          exact or.inl ⟨subset_rfl, subset_univ t⟩, },
+      end, },
+  { intros f hf_disj hf_meas hf_eq,
+    simp_rw measure_Union hf_disj hf_meas,
+    rw [lintegral_tsum (λ i, (kernel.measurable_coe _ (hf_meas i)).ae_measurable.restrict),
+      prod_Union, measure_Union],
+    { simp_rw hf_eq, },
+    { intros i j hij,
+      rw [function.on_fun, disjoint_prod],
+      exact or.inr (hf_disj hij), },
+    { exact λ i, measurable_set.prod hs (hf_meas i), }, },
+end
+
+lemma lintegral_cond_kernel_real_mem {s : set (α × ℝ)} (hs : measurable_set s) :
+  ∫⁻ a, cond_kernel_real ρ a {x | (a, x) ∈ s} ∂ρ.fst = ρ s :=
+begin
+  -- `set_lintegral_cond_kernel_real_prod` gives the result for sets of the form `t₁ × t₂`. These
+  -- sets form a π-system that generate the product σ-algebra, hence we can get the same equality
+  -- for any measurable set `s`.
+  refine measurable_space.induction_on_inter generate_from_prod.symm is_pi_system_prod _ _ _ _ hs,
+  { simp only [mem_empty_iff_false, set_of_false, measure_empty, lintegral_const, zero_mul], },
+  { intros t ht,
+    rw mem_image2 at ht,
+    obtain ⟨t₁, t₂, ht₁, ht₂, rfl⟩ := ht,
+    have h_prod_eq_snd : ∀ a ∈ t₁, {x : ℝ | (a, x) ∈ t₁ ×ˢ t₂} = t₂,
+    { intros a ha,
+      simp only [ha, prod_mk_mem_set_prod_eq, true_and, set_of_mem_eq], },
+    cases eq_empty_or_nonempty t₂ with h h,
+    { simp only [h, prod_empty, mem_empty_iff_false, set_of_false, measure_empty, lintegral_const,
+        zero_mul], },
+    rw ← lintegral_add_compl _ ht₁,
+    have h_eq1 : ∫⁻ a in t₁, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t₁ ×ˢ t₂} ∂ρ.fst
+      = ∫⁻ a in t₁, cond_kernel_real ρ a t₂ ∂ρ.fst,
+    { refine set_lintegral_congr_fun ht₁ (eventually_of_forall (λ a ha, _)),
+      rw h_prod_eq_snd a ha, },
+    have h_eq2 : ∫⁻ a in t₁ᶜ, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t₁ ×ˢ t₂} ∂ρ.fst = 0,
+    { suffices h_eq_zero : ∀ a ∈ t₁ᶜ, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t₁ ×ˢ t₂} = 0,
+      { rw set_lintegral_congr_fun ht₁.compl (eventually_of_forall h_eq_zero),
+        simp only [lintegral_const, zero_mul], },
+      intros a hat₁,
+      rw mem_compl_iff at hat₁,
+      simp only [hat₁, prod_mk_mem_set_prod_eq, false_and, set_of_false, measure_empty], },
+    rw [h_eq1, h_eq2, add_zero],
+    exact set_lintegral_cond_kernel_real_prod ρ ht₁ ht₂, },
+  { intros t ht ht_eq,
+    calc ∫⁻ a, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ tᶜ} ∂ρ.fst
+        = ∫⁻ a, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t}ᶜ ∂ρ.fst : rfl
+    ... = ∫⁻ a, cond_kernel_real ρ a univ - cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t} ∂ρ.fst :
+      begin
+        congr' with a : 1,
+        exact measure_compl (measurable_prod_mk_left ht) (measure_ne_top (cond_kernel_real ρ a) _),
+      end
+    ... = ∫⁻ a, cond_kernel_real ρ a univ ∂ρ.fst
+          - ∫⁻ a, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t} ∂ρ.fst :
+      begin
+        have h_le : (λ a, cond_kernel_real ρ a {x : ℝ | (a, x) ∈ t})
+          ≤ᵐ[ρ.fst] λ a, cond_kernel_real ρ a univ,
+        { exact eventually_of_forall (λ a, measure_mono (subset_univ _)), },
+        rw lintegral_sub _ _ h_le,
+        { exact kernel.measurable_kernel_prod_mk_left ht, },
+        refine ((lintegral_mono_ae h_le).trans_lt _).ne,
+        rw lintegral_cond_kernel_real_univ,
+        exact measure_lt_top ρ univ,
+      end
+    ... = ρ univ - ρ t : by rw [ht_eq, lintegral_cond_kernel_real_univ]
+    ... = ρ tᶜ : (measure_compl ht (measure_ne_top _ _)).symm, },
+  { intros f hf_disj hf_meas hf_eq,
+    have h_eq : ∀ a, {x | (a, x) ∈ ⋃ i, f i} = ⋃ i, {x | (a, x) ∈ f i},
+    { intros a,
+      ext1 x,
+      simp only [mem_Union, mem_set_of_eq], },
+    simp_rw h_eq,
+    have h_disj : ∀ a, pairwise (disjoint on (λ i, {x | (a, x) ∈ f i})),
+    { intros a i j hij,
+      have h_disj := hf_disj hij,
+      rw [function.on_fun, disjoint_iff_inter_eq_empty] at h_disj ⊢,
+      ext1 x,
+      simp only [mem_inter_iff, mem_set_of_eq, mem_empty_iff_false, iff_false],
+      intros h_mem_both,
+      suffices : (a, x) ∈ ∅, by rwa mem_empty_iff_false at this,
+      rwa [← h_disj, mem_inter_iff], },
+    calc ∫⁻ a, cond_kernel_real ρ a (⋃ i, {x | (a, x) ∈ f i}) ∂ρ.fst
+        = ∫⁻ a, ∑' i, cond_kernel_real ρ a {x | (a, x) ∈ f i} ∂ρ.fst :
+          by { congr' with a : 1,
+            rw measure_Union (h_disj a) (λ i, measurable_prod_mk_left (hf_meas i)), }
+    ... = ∑' i, ∫⁻ a, cond_kernel_real ρ a {x | (a, x) ∈ f i} ∂ρ.fst : lintegral_tsum
+          (λ i, (kernel.measurable_kernel_prod_mk_left (hf_meas i)).ae_measurable)
+    ... = ∑' i, ρ (f i) : by simp_rw hf_eq
+    ... = ρ (Union f) : (measure_Union hf_disj hf_meas).symm, },
+end
+
+theorem kernel.const_eq_comp_prod_real (γ : Type*) [measurable_space γ]
+  (ρ : measure (α × ℝ)) [is_finite_measure ρ] :
+  kernel.const γ ρ = (kernel.const γ ρ.fst) ⊗ₖ (kernel.prod_mk_left γ (cond_kernel_real ρ)) :=
+begin
+  ext a s hs : 2,
+  rw [kernel.comp_prod_apply _ _ _ hs, kernel.const_apply, kernel.const_apply],
+  simp_rw kernel.prod_mk_left_apply,
+  rw lintegral_cond_kernel_real_mem ρ hs,
+end
+
+theorem measure_eq_comp_prod_real :
+  ρ = ((kernel.const unit ρ.fst) ⊗ₖ (kernel.prod_mk_left unit (cond_kernel_real ρ))) () :=
+by rw [← kernel.const_eq_comp_prod_real unit ρ, kernel.const_apply]
+
+lemma lintegral_cond_kernel_real {f : α × ℝ → ℝ≥0∞} (hf : measurable f) :
+  ∫⁻ a, ∫⁻ y, f (a, y) ∂(cond_kernel_real ρ a) ∂ρ.fst = ∫⁻ x, f x ∂ρ :=
+begin
+  nth_rewrite 1 measure_eq_comp_prod_real ρ,
+  rw [kernel.lintegral_comp_prod _ _ _ hf, kernel.const_apply],
+  simp_rw kernel.prod_mk_left_apply,
+end
+
+lemma ae_cond_kernel_real_eq_one {s : set ℝ} (hs : measurable_set s) (hρ : ρ {x | x.snd ∈ sᶜ} = 0) :
+  ∀ᵐ a ∂ρ.fst, cond_kernel_real ρ a s = 1 :=
+begin
+  have h : ρ {x | x.snd ∈ sᶜ}
+    = (kernel.const unit ρ.fst ⊗ₖ kernel.prod_mk_left unit (cond_kernel_real ρ)) ()
+      {x | x.snd ∈ sᶜ},
+  { rw ← measure_eq_comp_prod_real, },
+  rw [hρ, kernel.comp_prod_apply] at h,
+  swap, { exact measurable_snd hs.compl, },
+  rw [eq_comm, lintegral_eq_zero_iff] at h,
+  swap,
+  { simp_rw kernel.prod_mk_left_apply',
+    simp only [mem_compl_iff, mem_set_of_eq],
+    exact kernel.measurable_coe _ hs.compl, },
+  rw kernel.const_apply at h,
+  simp only [mem_compl_iff, mem_set_of_eq, kernel.prod_mk_left_apply'] at h,
+  filter_upwards [h] with a ha,
+  change cond_kernel_real ρ a sᶜ = 0 at ha,
+  rwa [prob_compl_eq_zero_iff hs] at ha,
+  apply_instance,
+end
+
+end real
+
+section polish
+
+/-! ### Disintegration of measures on Polish Borel spaces
+
+Since every standard Borel space embeds measurably into `ℝ`, we can generalize the disintegration
+property on `ℝ` to all these spaces. -/
+
+variables {Ω : Type*} [topological_space Ω] [polish_space Ω] [measurable_space Ω] [borel_space Ω]
+  [nonempty Ω]
+  (ρ : measure (α × Ω)) [is_finite_measure ρ]
+
+/-- Existence of a conditional kernel. Use the definition `cond_kernel` to get that kernel. -/
+lemma exists_cond_kernel (γ : Type*) [measurable_space γ] :
+  ∃ (η : kernel α Ω) (h : is_markov_kernel η),
+  kernel.const γ ρ
+    = @kernel.comp_prod γ α _ _ Ω _ (kernel.const γ ρ.fst) _ (kernel.prod_mk_left γ η)
+      (by { haveI := h, apply_instance, }) :=
+begin
+  obtain ⟨f, hf⟩ := exists_measurable_embedding_real Ω,
+  let ρ' : measure (α × ℝ) := ρ.map (prod.map id f),
+  -- The general idea is to define `η = kernel.comap_right (cond_kernel_real ρ') hf`. There is
+  -- however an issue: that `η` may not be a Markov kernel since its value is only a
+  -- probability distribution almost everywhere with respect to `ρ.fst`, not everywhere.
+  -- We modify it to obtain a Markov kernel which is almost everywhere equal.
+  let ρ_set := (to_measurable ρ.fst {a | cond_kernel_real ρ' a (range f) = 1}ᶜ)ᶜ,
+  have hm : measurable_set ρ_set := (measurable_set_to_measurable _ _).compl,
+  have h_eq_one_of_mem : ∀ a ∈ ρ_set, cond_kernel_real ρ' a (range f) = 1,
+  { intros a ha,
+    rw [mem_compl_iff] at ha,
+    have h_ss := subset_to_measurable ρ.fst {a : α | cond_kernel_real ρ' a (range f) = 1}ᶜ,
+    suffices ha' : a ∉ {a : α | cond_kernel_real ρ' a (range f) = 1}ᶜ,
+    { rwa not_mem_compl_iff at ha', },
+    exact not_mem_subset h_ss ha, },
+  have h_prod_embed : measurable_embedding (prod.map (id : α → α) f) :=
+    (measurable_embedding.id).prod_mk hf,
+  have h_fst : ρ'.fst = ρ.fst,
+  { ext1 u hu,
+    rw [measure.fst_apply hu, measure.fst_apply hu,
+      measure.map_apply h_prod_embed.measurable (measurable_fst hu)],
+    refl, },
+  have h_ae : ∀ᵐ a ∂ρ.fst, a ∈ ρ_set,
+  { rw ae_iff,
+    simp only [not_mem_compl_iff, set_of_mem_eq, measure_to_measurable],
+    change (ρ.fst) {a : α | a ∉ {a' : α | cond_kernel_real ρ' a' (range f) = 1}} = 0,
+    rw [← ae_iff, ← h_fst],
+    refine ae_cond_kernel_real_eq_one ρ' hf.measurable_set_range _,
+    rw measure.map_apply h_prod_embed.measurable,
+    swap, { exact measurable_snd hf.measurable_set_range.compl, },
+    convert measure_empty,
+    ext1 x,
+    simp only [mem_compl_iff, mem_range, preimage_set_of_eq, prod_map, mem_set_of_eq,
+      mem_empty_iff_false, iff_false, not_not, exists_apply_eq_apply], },
+  classical,
+  obtain ⟨x₀, hx₀⟩ : ∃ x, x ∈ range f := range_nonempty _,
+  let η' := kernel.piecewise hm (cond_kernel_real ρ')
+    (kernel.deterministic (λ _, x₀) measurable_const),
+  -- We show that `kernel.comap_right η' hf` is a suitable Markov kernel.
+  refine ⟨kernel.comap_right η' hf, _, _⟩,
+  { refine kernel.is_markov_kernel.comap_right _ _ (λ a, _),
+    rw kernel.piecewise_apply',
+    split_ifs with h_mem h_not_mem,
+    { exact h_eq_one_of_mem _ h_mem, },
+    { rw [kernel.deterministic_apply' _ _ hf.measurable_set_range, set.indicator_apply,
+        if_pos hx₀], }, },
+  have : kernel.const γ ρ = kernel.comap_right (kernel.const γ ρ') h_prod_embed,
+  { ext c t ht : 2,
+    rw [kernel.const_apply, kernel.comap_right_apply' _ _ _ ht, kernel.const_apply,
+      measure.map_apply h_prod_embed.measurable (h_prod_embed.measurable_set_image.mpr ht)],
+    congr' with x : 1,
+    rw ← @prod.mk.eta _ _ x,
+    simp only [id.def, mem_preimage, prod.map_mk, mem_image, prod.mk.inj_iff, prod.exists],
+    refine ⟨λ h, ⟨x.1, x.2, h, rfl, rfl⟩, _⟩,
+    rintros ⟨a, b, h_mem, rfl, hf_eq⟩,
+    rwa hf.injective hf_eq at h_mem, },
+  rw [this, kernel.const_eq_comp_prod_real _ ρ'],
+  ext c t ht : 2,
+  rw [kernel.comap_right_apply' _ _ _ ht,
+    kernel.comp_prod_apply _ _ _ (h_prod_embed.measurable_set_image.mpr ht), kernel.const_apply,
+    h_fst, kernel.comp_prod_apply _ _ _ ht, kernel.const_apply],
+  refine lintegral_congr_ae _,
+  filter_upwards [h_ae] with a ha,
+  rw [kernel.prod_mk_left_apply', kernel.prod_mk_left_apply', kernel.comap_right_apply'],
+  swap, { exact measurable_prod_mk_left ht, },
+  have h1 : {c : ℝ | (a, c) ∈ prod.map id f '' t} = f '' {c : Ω | (a, c) ∈ t},
+  { ext1 x,
+    simp only [prod_map, id.def, mem_image, prod.mk.inj_iff, prod.exists, mem_set_of_eq],
+    split,
+    { rintros ⟨a', b, h_mem, rfl, hf_eq⟩,
+      exact ⟨b, h_mem, hf_eq⟩, },
+    { rintros ⟨b, h_mem, hf_eq⟩,
+      exact ⟨a, b, h_mem, rfl, hf_eq⟩, }, },
+  have h2 : cond_kernel_real ρ' (c, a).snd = η' (c, a).snd,
+  { rw [kernel.piecewise_apply, if_pos ha], },
+  rw [h1, h2],
+end
+
+/-- Conditional kernel of a measure on a product space: a Markov kernel such that
+`ρ = ((kernel.const unit ρ.fst) ⊗ₖ (kernel.prod_mk_left unit ρ.cond_kernel)) ()`
+(see `probability_theory.measure_eq_comp_prod`). -/
+@[irreducible] noncomputable
+def _root_.measure_theory.measure.cond_kernel : kernel α Ω :=
+(exists_cond_kernel ρ unit).some
+
+lemma cond_kernel_def : ρ.cond_kernel = (exists_cond_kernel ρ unit).some :=
+by rw measure_theory.measure.cond_kernel
+
+instance : is_markov_kernel ρ.cond_kernel :=
+by { rw cond_kernel_def, exact (exists_cond_kernel ρ unit).some_spec.some, }
+
+lemma kernel.const_unit_eq_comp_prod :
+  kernel.const unit ρ
+    = (kernel.const unit ρ.fst) ⊗ₖ (kernel.prod_mk_left unit ρ.cond_kernel) :=
+by { simp_rw cond_kernel_def, exact (exists_cond_kernel ρ unit).some_spec.some_spec, }
+
+/-- **Disintegration** of finite product measures on `α × Ω`, where `Ω` is Polish Borel. Such a
+measure can be written as the composition-product of the constant kernel with value `ρ.fst`
+(marginal measure over `α`) and a Markov kernel from `α` to `Ω`. We call that Markov kernel
+`probability_theory.cond_kernel ρ`. -/
+theorem measure_eq_comp_prod :
+  ρ = ((kernel.const unit ρ.fst) ⊗ₖ (kernel.prod_mk_left unit ρ.cond_kernel)) () :=
+by rw [← kernel.const_unit_eq_comp_prod, kernel.const_apply]
+
+/-- **Disintegration** of constant kernels. A constant kernel on a product space `α × Ω`, where `Ω`
+is Polish Borel, can be written as the composition-product of the constant kernel with value `ρ.fst`
+(marginal measure over `α`) and a Markov kernel from `α` to `Ω`. We call that Markov kernel
+`probability_theory.cond_kernel ρ`. -/
+theorem kernel.const_eq_comp_prod (γ : Type*) [measurable_space γ]
+  (ρ : measure (α × Ω)) [is_finite_measure ρ] :
+  kernel.const γ ρ = (kernel.const γ ρ.fst) ⊗ₖ (kernel.prod_mk_left γ ρ.cond_kernel) :=
+begin
+  ext a s hs : 2,
+  simpa only [kernel.const_apply, kernel.comp_prod_apply _ _ _ hs, kernel.prod_mk_left_apply']
+    using kernel.ext_iff'.mp (kernel.const_unit_eq_comp_prod ρ) () s hs,
+end
+
+lemma lintegral_cond_kernel_mem {s : set (α × Ω)} (hs : measurable_set s) :
+  ∫⁻ a, ρ.cond_kernel a {x | (a, x) ∈ s} ∂ρ.fst = ρ s :=
+begin
+  conv_rhs { rw measure_eq_comp_prod ρ, },
+  simp_rw [kernel.comp_prod_apply _ _ _ hs, kernel.const_apply, kernel.prod_mk_left_apply],
+end
+
+lemma set_lintegral_cond_kernel_eq_measure_prod {s : set α} (hs : measurable_set s)
+  {t : set Ω} (ht : measurable_set t) :
+  ∫⁻ a in s, ρ.cond_kernel a t ∂ρ.fst = ρ (s ×ˢ t) :=
+begin
+  have : ρ (s ×ˢ t) = ((kernel.const unit ρ.fst ⊗ₖ kernel.prod_mk_left unit ρ.cond_kernel) ())
+    (s ×ˢ t),
+  { congr, exact measure_eq_comp_prod ρ, },
+  rw [this, kernel.comp_prod_apply _ _ _ (hs.prod ht)],
+  simp only [prod_mk_mem_set_prod_eq, kernel.lintegral_const, kernel.prod_mk_left_apply],
+  rw ← lintegral_indicator _ hs,
+  congr,
+  ext1 x,
+  classical,
+  rw indicator_apply,
+  split_ifs with hx,
+  { simp only [hx, if_true, true_and, set_of_mem_eq], },
+  { simp only [hx, if_false, false_and, set_of_false, measure_empty], },
+end
+
+lemma lintegral_cond_kernel {f : α × Ω → ℝ≥0∞} (hf : measurable f) :
+  ∫⁻ a, ∫⁻ ω, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫⁻ x, f x ∂ρ :=
+begin
+  conv_rhs { rw measure_eq_comp_prod ρ, },
+  rw [kernel.lintegral_comp_prod _ _ _ hf, kernel.const_apply],
+  simp_rw kernel.prod_mk_left_apply,
+end
+
+lemma set_lintegral_cond_kernel {f : α × Ω → ℝ≥0∞} (hf : measurable f)
+  {s : set α} (hs : measurable_set s) {t : set Ω} (ht : measurable_set t) :
+  ∫⁻ a in s, ∫⁻ ω in t, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫⁻ x in s ×ˢ t, f x ∂ρ :=
+begin
+  conv_rhs { rw measure_eq_comp_prod ρ, },
+  simp_rw [← kernel.restrict_apply _ (hs.prod ht), ← kernel.comp_prod_restrict,
+    kernel.lintegral_comp_prod _ _ _ hf, kernel.restrict_apply, kernel.const_apply,
+    kernel.prod_mk_left_apply],
+end
+
+lemma set_lintegral_cond_kernel_univ_right {f : α × Ω → ℝ≥0∞} (hf : measurable f)
+  {s : set α} (hs : measurable_set s) :
+  ∫⁻ a in s, ∫⁻ ω, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫⁻ x in s ×ˢ univ, f x ∂ρ :=
+by { rw ← set_lintegral_cond_kernel ρ hf hs measurable_set.univ, simp_rw measure.restrict_univ, }
+
+lemma set_lintegral_cond_kernel_univ_left {f : α × Ω → ℝ≥0∞} (hf : measurable f)
+  {t : set Ω} (ht : measurable_set t) :
+  ∫⁻ a, ∫⁻ ω in t, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫⁻ x in univ ×ˢ t, f x ∂ρ :=
+by { rw ← set_lintegral_cond_kernel ρ hf measurable_set.univ ht, simp_rw measure.restrict_univ, }
+
+section integral_cond_kernel
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+lemma _root_.measure_theory.ae_strongly_measurable.integral_cond_kernel
+  {ρ : measure (α × Ω)} [is_finite_measure ρ] {f : α × Ω → E} (hf : ae_strongly_measurable f ρ) :
+  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂(ρ.cond_kernel x)) ρ.fst :=
+begin
+  rw measure_eq_comp_prod ρ at hf,
+  exact ae_strongly_measurable.integral_kernel_comp_prod hf,
+end
+
+lemma integral_cond_kernel {ρ : measure (α × Ω)} [is_finite_measure ρ]
+  {f : α × Ω → E} (hf : integrable f ρ) :
+  ∫ a, ∫ x, f (a, x) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫ ω, f ω ∂ρ :=
+begin
+  conv_rhs { rw measure_eq_comp_prod ρ, },
+  have hf' : integrable f ((kernel.const unit ρ.fst ⊗ₖ kernel.prod_mk_left unit ρ.cond_kernel) ()),
+  { rwa measure_eq_comp_prod ρ at hf, },
+  rw [integral_comp_prod hf', kernel.const_apply],
+  simp_rw kernel.prod_mk_left_apply,
+end
+
+lemma set_integral_cond_kernel {ρ : measure (α × Ω)} [is_finite_measure ρ]
+  {f : α × Ω → E} {s : set α} (hs : measurable_set s)
+  {t : set Ω} (ht : measurable_set t) (hf : integrable_on f (s ×ˢ t) ρ) :
+  ∫ a in s, ∫ ω in t, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫ x in s ×ˢ t, f x ∂ρ :=
+begin
+  conv_rhs { rw measure_eq_comp_prod ρ, },
+  rw set_integral_comp_prod hs ht,
+  { simp_rw [kernel.prod_mk_left_apply, kernel.const_apply], },
+  { rwa measure_eq_comp_prod ρ at hf, },
+end
+
+lemma set_integral_cond_kernel_univ_right {ρ : measure (α × Ω)} [is_finite_measure ρ]
+  {f : α × Ω → E} {s : set α} (hs : measurable_set s)
+  (hf : integrable_on f (s ×ˢ univ) ρ) :
+  ∫ a in s, ∫ ω, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫ x in s ×ˢ univ, f x ∂ρ :=
+by { rw ← set_integral_cond_kernel hs measurable_set.univ hf, simp_rw measure.restrict_univ, }
+
+lemma set_integral_cond_kernel_univ_left {ρ : measure (α × Ω)} [is_finite_measure ρ]
+  {f : α × Ω → E} {t : set Ω} (ht : measurable_set t)
+  (hf : integrable_on f (univ ×ˢ t) ρ) :
+  ∫ a, ∫ ω in t, f (a, ω) ∂(ρ.cond_kernel a) ∂ρ.fst = ∫ x in univ ×ˢ t, f x ∂ρ :=
+by { rw ← set_integral_cond_kernel measurable_set.univ ht hf, simp_rw measure.restrict_univ, }
+
+end integral_cond_kernel
+
+end polish
+
+end probability_theory
+
+namespace measure_theory
+/-! ### Integrability
+
+We place these lemmas in the `measure_theory` namespace to enable dot notation. -/
+
+open probability_theory
+
+variables {α Ω E F : Type*} {mα : measurable_space α} [measurable_space Ω] [topological_space Ω]
+  [borel_space Ω] [polish_space Ω] [nonempty Ω]
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  [normed_add_comm_group F]
+  {ρ : measure (α × Ω)} [is_finite_measure ρ]
+
+include mα
+
+lemma ae_strongly_measurable.ae_integrable_cond_kernel_iff
+  {f : α × Ω → F} (hf : ae_strongly_measurable f ρ) :
+  (∀ᵐ a ∂ρ.fst, integrable (λ ω, f (a, ω)) (ρ.cond_kernel a))
+    ∧ integrable (λ a, ∫ ω, ‖f (a, ω)‖ ∂(ρ.cond_kernel a)) ρ.fst
+  ↔ integrable f ρ :=
+begin
+  rw measure_eq_comp_prod ρ at hf,
+  conv_rhs { rw measure_eq_comp_prod ρ, },
+  rw integrable_comp_prod_iff hf,
+  simp_rw [kernel.prod_mk_left_apply, kernel.const_apply],
+end
+
+lemma integrable.cond_kernel_ae {f : α × Ω → F} (hf_int : integrable f ρ) :
+  ∀ᵐ a ∂ρ.fst, integrable (λ ω, f (a, ω)) (ρ.cond_kernel a) :=
+begin
+  have hf_ae : ae_strongly_measurable f ρ := hf_int.1,
+  rw ← hf_ae.ae_integrable_cond_kernel_iff at hf_int,
+  exact hf_int.1,
+end
+
+lemma integrable.integral_norm_cond_kernel {f : α × Ω → F} (hf_int : integrable f ρ) :
+  integrable (λ x, ∫ y, ‖f (x, y)‖ ∂(ρ.cond_kernel x)) ρ.fst :=
+begin
+  have hf_ae : ae_strongly_measurable f ρ := hf_int.1,
+  rw ← hf_ae.ae_integrable_cond_kernel_iff at hf_int,
+  exact hf_int.2,
+end
+
+lemma integrable.norm_integral_cond_kernel {f : α × Ω → E} (hf_int : integrable f ρ) :
+  integrable (λ x, ‖∫ y, f (x, y) ∂(ρ.cond_kernel x)‖) ρ.fst :=
+begin
+  refine hf_int.integral_norm_cond_kernel.mono hf_int.1.integral_cond_kernel.norm _,
+  refine eventually_of_forall (λ x, _),
+  rw norm_norm,
+  refine (norm_integral_le_integral_norm _).trans_eq (real.norm_of_nonneg _).symm,
+  exact integral_nonneg_of_ae (eventually_of_forall (λ y, norm_nonneg _)),
+end
+
+lemma integrable.integral_cond_kernel {f : α × Ω → E} (hf_int : integrable f ρ) :
+  integrable (λ x, ∫ y, f (x, y) ∂(ρ.cond_kernel x)) ρ.fst :=
+(integrable_norm_iff hf_int.1.integral_cond_kernel).mp hf_int.norm_integral_cond_kernel
+
+end measure_theory
diff --git a/src/probability/kernel/integral_comp_prod.lean b/src/probability/kernel/integral_comp_prod.lean
new file mode 100644
index 0000000000000..53b9df2f7c6e8
--- /dev/null
+++ b/src/probability/kernel/integral_comp_prod.lean
@@ -0,0 +1,283 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.kernel.composition
+import measure_theory.integral.set_integral
+
+/-!
+# Bochner integral of a function against the composition-product of two kernels
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We prove properties of the composition-product of two kernels. If `κ` is an s-finite kernel from
+`α` to `β` and `η` is an s-finite kernel from `α × β` to `γ`, we can form their composition-product
+`κ ⊗ₖ η : kernel α (β × γ)`. We proved in `probability.kernel.lintegral_comp_prod` that it verifies
+`∫⁻ bc, f bc ∂((κ ⊗ₖ η) a) = ∫⁻ b, ∫⁻ c, f (b, c) ∂(η (a, b)) ∂(κ a)`. In this file, we prove the
+same equality for the Bochner integral.
+
+## Main statements
+
+* `probability_theory.integral_comp_prod`: the integral against the composition-product is
+  `∫ z, f z ∂((κ ⊗ₖ η) a) = ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a)`
+
+## Implementation details
+
+This file is to a large extent a copy of part of `measure_theory.constructions.prod`. The product of
+two measures is a particular case of composition-product of kernels and it turns out that once the
+measurablity of the Lebesgue integral of a kernel is proved, almost all proofs about integrals
+against products of measures extend with minimal modifications to the composition-product of two
+kernels.
+-/
+
+noncomputable theory
+open_locale topology ennreal measure_theory probability_theory
+open set function real ennreal measure_theory filter probability_theory probability_theory.kernel
+
+variables {α β γ E : Type*}
+  {mα : measurable_space α} {mβ : measurable_space β} {mγ : measurable_space γ}
+  [normed_add_comm_group E]
+  {κ : kernel α β} [is_s_finite_kernel κ]
+  {η : kernel (α × β) γ} [is_s_finite_kernel η]
+  {a : α}
+
+namespace probability_theory
+
+lemma has_finite_integral_prod_mk_left (a : α) {s : set (β × γ)} (h2s : (κ ⊗ₖ η) a s ≠ ∞) :
+  has_finite_integral (λ b, (η (a, b) (prod.mk b ⁻¹' s)).to_real) (κ a) :=
+begin
+  let t := to_measurable ((κ ⊗ₖ η) a) s,
+  simp_rw [has_finite_integral, ennnorm_eq_of_real to_real_nonneg],
+  calc ∫⁻ b, ennreal.of_real (η (a, b) (prod.mk b ⁻¹' s)).to_real ∂(κ a)
+      ≤ ∫⁻ b, η (a, b) (prod.mk b ⁻¹' t) ∂(κ a) :
+      begin
+        refine lintegral_mono_ae _,
+        filter_upwards [ae_kernel_lt_top a h2s] with b hb,
+        rw of_real_to_real hb.ne,
+        exact measure_mono (preimage_mono (subset_to_measurable _ _)),
+      end
+  ... ≤ (κ ⊗ₖ η) a t : le_comp_prod_apply _ _ _ _
+  ... = (κ ⊗ₖ η) a s : measure_to_measurable s
+  ... < ⊤ : h2s.lt_top,
+end
+
+lemma integrable_kernel_prod_mk_left (a : α)
+  {s : set (β × γ)} (hs : measurable_set s) (h2s : (κ ⊗ₖ η) a s ≠ ∞) :
+  integrable (λ b, (η (a, b) (prod.mk b ⁻¹' s)).to_real) (κ a) :=
+begin
+  split,
+  { exact (measurable_kernel_prod_mk_left' hs a).ennreal_to_real.ae_strongly_measurable },
+  { exact has_finite_integral_prod_mk_left a h2s, },
+end
+
+lemma _root_.measure_theory.ae_strongly_measurable.integral_kernel_comp_prod
+  [normed_space ℝ E] [complete_space E]
+  ⦃f : β × γ → E⦄ (hf : ae_strongly_measurable f ((κ ⊗ₖ η) a)) :
+  ae_strongly_measurable (λ x, ∫ y, f (x, y) ∂(η (a, x))) (κ a) :=
+⟨λ x, ∫ y, hf.mk f (x, y) ∂(η (a, x)), hf.strongly_measurable_mk.integral_kernel_prod_right'',
+  by { filter_upwards [ae_ae_of_ae_comp_prod hf.ae_eq_mk] with _ hx using integral_congr_ae hx }⟩
+
+lemma _root_.measure_theory.ae_strongly_measurable.comp_prod_mk_left
+  {δ : Type*} [topological_space δ] {f : β × γ → δ}
+  (hf : ae_strongly_measurable f ((κ ⊗ₖ η) a)) :
+  ∀ᵐ x ∂(κ a), ae_strongly_measurable (λ y, f (x, y)) (η (a, x)) :=
+by filter_upwards [ae_ae_of_ae_comp_prod hf.ae_eq_mk] with x hx using
+  ⟨λ y, hf.mk f (x, y), hf.strongly_measurable_mk.comp_measurable measurable_prod_mk_left, hx⟩
+
+/-! ### Integrability -/
+
+lemma has_finite_integral_comp_prod_iff ⦃f : β × γ → E⦄ (h1f : strongly_measurable f) :
+  has_finite_integral f ((κ ⊗ₖ η) a)
+    ↔ (∀ᵐ x ∂(κ a), has_finite_integral (λ y, f (x, y)) (η (a, x))) ∧
+      has_finite_integral (λ x, ∫ y, ‖f (x, y)‖ ∂(η (a, x))) (κ a) :=
+begin
+  simp only [has_finite_integral],
+  rw kernel.lintegral_comp_prod _ _ _ h1f.ennnorm,
+  have : ∀ x, ∀ᵐ y ∂(η (a, x)), 0 ≤ ‖f (x, y)‖ := λ x, eventually_of_forall (λ y, norm_nonneg _),
+  simp_rw [integral_eq_lintegral_of_nonneg_ae (this _)
+    (h1f.norm.comp_measurable measurable_prod_mk_left).ae_strongly_measurable,
+    ennnorm_eq_of_real to_real_nonneg, of_real_norm_eq_coe_nnnorm],
+  have : ∀ {p q r : Prop} (h1 : r → p), (r ↔ p ∧ q) ↔ (p → (r ↔ q)) :=
+  λ p q r h1, by rw [← and.congr_right_iff, and_iff_right_of_imp h1],
+  rw [this],
+  { intro h2f, rw lintegral_congr_ae,
+    refine h2f.mp _, apply eventually_of_forall, intros x hx, dsimp only,
+    rw [of_real_to_real], rw [← lt_top_iff_ne_top], exact hx },
+  { intro h2f, refine ae_lt_top _ h2f.ne, exact h1f.ennnorm.lintegral_kernel_prod_right'' },
+end
+
+lemma has_finite_integral_comp_prod_iff' ⦃f : β × γ → E⦄
+  (h1f : ae_strongly_measurable f ((κ ⊗ₖ η) a)) :
+  has_finite_integral f ((κ ⊗ₖ η) a)
+    ↔ (∀ᵐ x ∂(κ a), has_finite_integral (λ y, f (x, y)) (η (a, x))) ∧
+      has_finite_integral (λ x, ∫ y, ‖f (x, y)‖ ∂(η (a, x))) (κ a) :=
+begin
+  rw [has_finite_integral_congr h1f.ae_eq_mk,
+    has_finite_integral_comp_prod_iff h1f.strongly_measurable_mk],
+  apply and_congr,
+  { apply eventually_congr,
+    filter_upwards [ae_ae_of_ae_comp_prod h1f.ae_eq_mk.symm],
+    assume x hx,
+    exact has_finite_integral_congr hx },
+  { apply has_finite_integral_congr,
+    filter_upwards [ae_ae_of_ae_comp_prod h1f.ae_eq_mk.symm] with _ hx
+      using integral_congr_ae (eventually_eq.fun_comp hx _), },
+end
+
+lemma integrable_comp_prod_iff ⦃f : β × γ → E⦄ (hf : ae_strongly_measurable f ((κ ⊗ₖ η) a)) :
+  integrable f ((κ ⊗ₖ η) a) ↔
+    (∀ᵐ x ∂(κ a), integrable (λ y, f (x, y)) (η (a, x)))
+    ∧ integrable (λ x, ∫ y, ‖f (x, y)‖ ∂(η (a, x))) (κ a) :=
+by simp only [integrable, has_finite_integral_comp_prod_iff' hf,
+  hf.norm.integral_kernel_comp_prod, hf, hf.comp_prod_mk_left, eventually_and, true_and]
+
+lemma _root_.measure_theory.integrable.comp_prod_mk_left_ae
+  ⦃f : β × γ → E⦄ (hf : integrable f ((κ ⊗ₖ η) a)) :
+  ∀ᵐ x ∂(κ a), integrable (λ y, f (x, y)) (η (a, x)) :=
+((integrable_comp_prod_iff hf.ae_strongly_measurable).mp hf).1
+
+lemma _root_.measure_theory.integrable.integral_norm_comp_prod
+  ⦃f : β × γ → E⦄ (hf : integrable f ((κ ⊗ₖ η) a)) :
+  integrable (λ x, ∫ y, ‖f (x, y)‖ ∂(η (a, x))) (κ a) :=
+((integrable_comp_prod_iff hf.ae_strongly_measurable).mp hf).2
+
+lemma _root_.measure_theory.integrable.integral_comp_prod [normed_space ℝ E] [complete_space E]
+  ⦃f : β × γ → E⦄ (hf : integrable f ((κ ⊗ₖ η) a)) :
+  integrable (λ x, ∫ y, f (x, y) ∂(η (a, x))) (κ a) :=
+integrable.mono hf.integral_norm_comp_prod
+  hf.ae_strongly_measurable.integral_kernel_comp_prod $
+  eventually_of_forall $ λ x, (norm_integral_le_integral_norm _).trans_eq $
+  (norm_of_nonneg $ integral_nonneg_of_ae $ eventually_of_forall $
+  λ y, (norm_nonneg (f (x, y)) : _)).symm
+
+/-! ### Bochner integral -/
+
+variables [normed_space ℝ E] [complete_space E]
+  {E' : Type*} [normed_add_comm_group E'] [complete_space E'] [normed_space ℝ E']
+
+lemma kernel.integral_fn_integral_add ⦃f g : β × γ → E⦄ (F : E → E')
+  (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫ x, F (∫ y, f (x, y) + g (x, y) ∂(η (a, x))) ∂(κ a)
+    = ∫ x, F (∫ y, f (x, y) ∂(η (a, x)) + ∫ y, g (x, y) ∂(η (a, x))) ∂(κ a) :=
+begin
+  refine integral_congr_ae _,
+  filter_upwards [hf.comp_prod_mk_left_ae, hg.comp_prod_mk_left_ae] with _ h2f h2g,
+  simp [integral_add h2f h2g],
+end
+
+lemma kernel.integral_fn_integral_sub ⦃f g : β × γ → E⦄ (F : E → E')
+  (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫ x, F (∫ y, f (x, y) - g (x, y) ∂(η (a, x))) ∂(κ a)
+    = ∫ x, F (∫ y, f (x, y) ∂(η (a, x)) - ∫ y, g (x, y) ∂(η (a, x))) ∂(κ a) :=
+begin
+  refine integral_congr_ae _,
+  filter_upwards [hf.comp_prod_mk_left_ae, hg.comp_prod_mk_left_ae] with _ h2f h2g,
+  simp [integral_sub h2f h2g],
+end
+
+lemma kernel.lintegral_fn_integral_sub ⦃f g : β × γ → E⦄
+  (F : E → ℝ≥0∞) (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫⁻ x, F (∫ y, f (x, y) - g (x, y) ∂(η (a, x))) ∂(κ a)
+    = ∫⁻ x, F (∫ y, f (x, y) ∂(η (a, x)) - ∫ y, g (x, y) ∂(η (a, x))) ∂(κ a) :=
+begin
+  refine lintegral_congr_ae _,
+  filter_upwards [hf.comp_prod_mk_left_ae, hg.comp_prod_mk_left_ae] with _ h2f h2g,
+  simp [integral_sub h2f h2g],
+end
+
+lemma kernel.integral_integral_add ⦃f g : β × γ → E⦄
+  (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫ x, ∫ y, f (x, y) + g (x, y) ∂(η (a, x)) ∂(κ a)
+    = ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a) + ∫ x, ∫ y, g (x, y) ∂(η (a, x)) ∂(κ a) :=
+(kernel.integral_fn_integral_add id hf hg).trans $
+  integral_add hf.integral_comp_prod hg.integral_comp_prod
+
+lemma kernel.integral_integral_add' ⦃f g : β × γ → E⦄
+  (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫ x, ∫ y, (f + g) (x, y) ∂(η (a, x)) ∂(κ a)
+    = ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a) + ∫ x, ∫ y, g (x, y) ∂(η (a, x)) ∂(κ a) :=
+kernel.integral_integral_add hf hg
+
+lemma kernel.integral_integral_sub ⦃f g : β × γ → E⦄
+  (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫ x, ∫ y, f (x, y) - g (x, y) ∂(η (a, x)) ∂(κ a)
+    = ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a) - ∫ x, ∫ y, g (x, y) ∂(η (a, x)) ∂(κ a) :=
+(kernel.integral_fn_integral_sub id hf hg).trans $
+  integral_sub hf.integral_comp_prod hg.integral_comp_prod
+
+lemma kernel.integral_integral_sub' ⦃f g : β × γ → E⦄
+  (hf : integrable f ((κ ⊗ₖ η) a)) (hg : integrable g ((κ ⊗ₖ η) a)) :
+  ∫ x, ∫ y, (f - g) (x, y) ∂(η (a, x)) ∂(κ a)
+    = ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a) - ∫ x, ∫ y, g (x, y) ∂(η (a, x)) ∂(κ a) :=
+kernel.integral_integral_sub hf hg
+
+lemma kernel.continuous_integral_integral :
+  continuous (λ (f : α × β →₁[(κ ⊗ₖ η) a] E), ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a)) :=
+begin
+  rw [continuous_iff_continuous_at], intro g,
+  refine tendsto_integral_of_L1 _ (L1.integrable_coe_fn g).integral_comp_prod
+    (eventually_of_forall $ λ h, (L1.integrable_coe_fn h).integral_comp_prod) _,
+  simp_rw [← kernel.lintegral_fn_integral_sub (λ x, (‖x‖₊ : ℝ≥0∞)) (L1.integrable_coe_fn _)
+    (L1.integrable_coe_fn g)],
+  refine tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds _ (λ i, zero_le _) _,
+  { exact λ i, ∫⁻ x, ∫⁻ y, ‖i (x, y) - g (x, y)‖₊ ∂(η (a, x)) ∂(κ a) },
+  swap, { exact λ i, lintegral_mono (λ x, ennnorm_integral_le_lintegral_ennnorm _) },
+  show tendsto (λ (i : β × γ →₁[(κ ⊗ₖ η) a] E),
+    ∫⁻ x, ∫⁻ (y : γ), ‖i (x, y) - g (x, y)‖₊ ∂(η (a, x)) ∂(κ a)) (𝓝 g) (𝓝 0),
+  have : ∀ (i : α × β →₁[(κ ⊗ₖ η) a] E), measurable (λ z, (‖i z - g z‖₊ : ℝ≥0∞)) :=
+    λ i, ((Lp.strongly_measurable i).sub (Lp.strongly_measurable g)).ennnorm,
+  simp_rw [← kernel.lintegral_comp_prod _ _ _ (this _), ← L1.of_real_norm_sub_eq_lintegral,
+    ← of_real_zero],
+  refine (continuous_of_real.tendsto 0).comp _,
+  rw [← tendsto_iff_norm_tendsto_zero],
+  exact tendsto_id
+end
+
+lemma integral_comp_prod : ∀ {f : β × γ → E} (hf : integrable f ((κ ⊗ₖ η) a)),
+  ∫ z, f z ∂((κ ⊗ₖ η) a) = ∫ x, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+begin
+  apply integrable.induction,
+  { intros c s hs h2s,
+    simp_rw [integral_indicator hs, ← indicator_comp_right,
+      function.comp, integral_indicator (measurable_prod_mk_left hs),
+      measure_theory.set_integral_const, integral_smul_const],
+    congr' 1,
+    rw integral_to_real,
+    rotate,
+    { exact (kernel.measurable_kernel_prod_mk_left' hs _).ae_measurable, },
+    { exact (ae_kernel_lt_top a h2s.ne), },
+    rw kernel.comp_prod_apply _ _ _ hs,
+    refl, },
+  { intros f g hfg i_f i_g hf hg,
+    simp_rw [integral_add' i_f i_g, kernel.integral_integral_add' i_f i_g, hf, hg] },
+  { exact is_closed_eq continuous_integral kernel.continuous_integral_integral },
+  { intros f g hfg i_f hf,
+    convert hf using 1,
+    { exact integral_congr_ae hfg.symm },
+    { refine integral_congr_ae _,
+      refine (ae_ae_of_ae_comp_prod hfg).mp (eventually_of_forall _),
+      exact λ x hfgx, integral_congr_ae (ae_eq_symm hfgx) } }
+end
+
+lemma set_integral_comp_prod {f : β × γ → E} {s : set β} {t : set γ}
+  (hs : measurable_set s) (ht : measurable_set t) (hf : integrable_on f (s ×ˢ t) ((κ ⊗ₖ η) a)) :
+  ∫ z in s ×ˢ t, f z ∂((κ ⊗ₖ η) a) = ∫ x in s, ∫ y in t, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+begin
+  rw [← kernel.restrict_apply (κ ⊗ₖ η) (hs.prod ht), ← comp_prod_restrict, integral_comp_prod],
+  { simp_rw kernel.restrict_apply, },
+  { rw [comp_prod_restrict, kernel.restrict_apply], exact hf, },
+end
+
+lemma set_integral_comp_prod_univ_right (f : β × γ → E) {s : set β}
+  (hs : measurable_set s) (hf : integrable_on f (s ×ˢ univ) ((κ ⊗ₖ η) a)) :
+  ∫ z in s ×ˢ univ, f z ∂((κ ⊗ₖ η) a) = ∫ x in s, ∫ y, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+by simp_rw [set_integral_comp_prod hs measurable_set.univ hf, measure.restrict_univ]
+
+lemma set_integral_comp_prod_univ_left (f : β × γ → E) {t : set γ}
+  (ht : measurable_set t) (hf : integrable_on f (univ ×ˢ t) ((κ ⊗ₖ η) a)) :
+  ∫ z in univ ×ˢ t, f z ∂((κ ⊗ₖ η) a) = ∫ x, ∫ y in t, f (x, y) ∂(η (a, x)) ∂(κ a) :=
+by simp_rw [set_integral_comp_prod measurable_set.univ ht hf, measure.restrict_univ]
+
+end probability_theory
diff --git a/src/probability/kernel/invariance.lean b/src/probability/kernel/invariance.lean
new file mode 100644
index 0000000000000..478deaee8768a
--- /dev/null
+++ b/src/probability/kernel/invariance.lean
@@ -0,0 +1,101 @@
+/-
+Copyright (c) 2023 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import probability.kernel.composition
+
+/-!
+# Invariance of measures along a kernel
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We say that a measure `μ` is invariant with respect to a kernel `κ` if its push-forward along the
+kernel `μ.bind κ` is the same measure.
+
+## Main definitions
+
+* `probability_theory.kernel.invariant`: invariance of a given measure with respect to a kernel.
+
+## Useful lemmas
+
+* `probability_theory.kernel.const_bind_eq_comp_const`, and
+  `probability_theory.kernel.comp_const_apply_eq_bind` established the relationship between
+  the push-forward measure and the composition of kernels.
+
+-/
+
+open measure_theory
+
+open_locale measure_theory ennreal probability_theory
+
+namespace probability_theory
+
+variables {α β γ : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+  {mγ : measurable_space γ}
+
+include mα mβ
+
+namespace kernel
+
+/-! ### Push-forward of measures along a kernel -/
+
+@[simp]
+lemma bind_add (μ ν : measure α) (κ : kernel α β) :
+  (μ + ν).bind κ = μ.bind κ + ν.bind κ :=
+begin
+  ext1 s hs,
+  rw [measure.bind_apply hs (kernel.measurable _), lintegral_add_measure, measure.coe_add,
+    pi.add_apply, measure.bind_apply hs (kernel.measurable _),
+    measure.bind_apply hs (kernel.measurable _)],
+end
+
+@[simp]
+lemma bind_smul (κ : kernel α β) (μ : measure α) (r : ℝ≥0∞) :
+  (r • μ).bind κ = r • μ.bind κ :=
+begin
+  ext1 s hs,
+  rw [measure.bind_apply hs (kernel.measurable _), lintegral_smul_measure, measure.coe_smul,
+    pi.smul_apply, measure.bind_apply hs (kernel.measurable _), smul_eq_mul],
+end
+
+lemma const_bind_eq_comp_const (κ : kernel α β) (μ : measure α) :
+  const α (μ.bind κ) = κ ∘ₖ const α μ :=
+begin
+  ext a s hs : 2,
+  simp_rw [comp_apply' _ _ _ hs, const_apply, measure.bind_apply hs (kernel.measurable _)],
+end
+
+lemma comp_const_apply_eq_bind (κ : kernel α β) (μ : measure α) (a : α) :
+  (κ ∘ₖ const α μ) a = μ.bind κ :=
+by rw [← const_apply (μ.bind κ) a, const_bind_eq_comp_const κ μ]
+
+omit mβ
+
+/-! ### Invariant measures of kernels -/
+
+/-- A measure `μ` is invariant with respect to the kernel `κ` if the push-forward measure of `μ`
+along `κ` equals `μ`. -/
+def invariant (κ : kernel α α) (μ : measure α) : Prop :=
+μ.bind κ = μ
+
+variables {κ η : kernel α α} {μ : measure α}
+
+lemma invariant.def (hκ : invariant κ μ) : μ.bind κ = μ := hκ
+
+lemma invariant.comp_const (hκ : invariant κ μ) : κ ∘ₖ const α μ = const α μ :=
+by rw [← const_bind_eq_comp_const κ μ, hκ.def]
+
+lemma invariant.comp [is_s_finite_kernel κ] (hκ : invariant κ μ) (hη : invariant η μ) :
+  invariant (κ ∘ₖ η) μ :=
+begin
+  casesI is_empty_or_nonempty α with _ hα,
+  { exact subsingleton.elim _ _ },
+  { simp_rw [invariant, ← comp_const_apply_eq_bind (κ ∘ₖ η) μ hα.some, comp_assoc,
+      hη.comp_const, hκ.comp_const, const_apply] },
+end
+
+end kernel
+
+end probability_theory
diff --git a/src/probability/kernel/measurable_integral.lean b/src/probability/kernel/measurable_integral.lean
new file mode 100644
index 0000000000000..540b0aa13055e
--- /dev/null
+++ b/src/probability/kernel/measurable_integral.lean
@@ -0,0 +1,320 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.kernel.basic
+
+/-!
+# Measurability of the integral against a kernel
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The Lebesgue integral of a measurable function against a kernel is measurable. The Bochner integral
+is strongly measurable.
+
+## Main statements
+
+* `measurable.lintegral_kernel_prod_right`: the function `a ↦ ∫⁻ b, f a b ∂(κ a)` is measurable,
+  for an s-finite kernel `κ : kernel α β` and a function `f : α → β → ℝ≥0∞` such that `uncurry f`
+  is measurable.
+* `measure_theory.strongly_measurable.integral_kernel_prod_right`: the function
+  `a ↦ ∫ b, f a b ∂(κ a)` is measurable, for an s-finite kernel `κ : kernel α β` and a function
+  `f : α → β → E` such that `uncurry f` is measurable.
+
+-/
+
+open measure_theory probability_theory function set filter
+
+open_locale measure_theory ennreal topology
+
+variables {α β γ : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+  {mγ : measurable_space γ}
+  {κ : kernel α β} {η : kernel (α × β) γ} {a : α}
+
+namespace probability_theory
+namespace kernel
+
+/-- This is an auxiliary lemma for `measurable_kernel_prod_mk_left`. -/
+lemma measurable_kernel_prod_mk_left_of_finite {t : set (α × β)} (ht : measurable_set t)
+  (hκs : ∀ a, is_finite_measure (κ a)) :
+  measurable (λ a, κ a (prod.mk a ⁻¹' t)) :=
+begin
+  -- `t` is a measurable set in the product `α × β`: we use that the product σ-algebra is generated
+  -- by boxes to prove the result by induction.
+  refine measurable_space.induction_on_inter generate_from_prod.symm is_pi_system_prod _ _ _ _ ht,
+  { -- case `t = ∅`
+    simp only [preimage_empty, measure_empty, measurable_const], },
+  { -- case of a box: `t = t₁ ×ˢ t₂` for measurable sets `t₁` and `t₂`
+    intros t' ht',
+    simp only [set.mem_image2, set.mem_set_of_eq, exists_and_distrib_left] at ht',
+    obtain ⟨t₁, ht₁, t₂, ht₂, rfl⟩ := ht',
+    classical,
+    simp_rw mk_preimage_prod_right_eq_if,
+    have h_eq_ite : (λ a, κ a (ite (a ∈ t₁) t₂ ∅)) = λ a, ite (a ∈ t₁) (κ a t₂) 0,
+    { ext1 a,
+      split_ifs,
+      exacts [rfl, measure_empty], },
+    rw h_eq_ite,
+    exact measurable.ite ht₁ (kernel.measurable_coe κ ht₂) measurable_const },
+  { -- we assume that the result is true for `t` and we prove it for `tᶜ`
+    intros t' ht' h_meas,
+    have h_eq_sdiff : ∀ a, (prod.mk a ⁻¹' t'ᶜ) = set.univ \ (prod.mk a ⁻¹' t'),
+    { intro a,
+      ext1 b,
+      simp only [mem_compl_iff, mem_preimage, mem_diff, mem_univ, true_and], },
+    simp_rw h_eq_sdiff,
+    have : (λ a, κ a (set.univ \ (prod.mk a ⁻¹' t')))
+      = (λ a, (κ a set.univ - κ a (prod.mk a ⁻¹' t'))),
+    { ext1 a,
+      rw [← set.diff_inter_self_eq_diff, set.inter_univ, measure_diff (set.subset_univ _)],
+      { exact (@measurable_prod_mk_left α β _ _ a) t' ht', },
+      { exact measure_ne_top _ _, }, },
+    rw this,
+    exact measurable.sub (kernel.measurable_coe κ measurable_set.univ) h_meas, },
+  { -- we assume that the result is true for a family of disjoint sets and prove it for their union
+    intros f h_disj hf_meas hf,
+    have h_Union : (λ a, κ a (prod.mk a ⁻¹' ⋃ i, f i)) = λ a, κ a (⋃ i, prod.mk a ⁻¹' f i),
+    { ext1 a,
+      congr' with b,
+      simp only [mem_Union, mem_preimage], },
+    rw h_Union,
+    have h_tsum : (λ a, κ a (⋃ i, prod.mk a ⁻¹' f i)) = λ a, ∑' i, κ a (prod.mk a ⁻¹' f i),
+    { ext1 a,
+      rw measure_Union,
+      { intros i j hij s hsi hsj b hbs,
+        have habi : {(a, b)} ⊆ f i, by { rw set.singleton_subset_iff, exact hsi hbs, },
+        have habj : {(a, b)} ⊆ f j, by { rw set.singleton_subset_iff, exact hsj hbs, },
+        simpa only [set.bot_eq_empty, set.le_eq_subset, set.singleton_subset_iff,
+          set.mem_empty_iff_false] using h_disj hij habi habj, },
+      { exact λ i, (@measurable_prod_mk_left α β _ _ a) _ (hf_meas i), }, },
+    rw h_tsum,
+    exact measurable.ennreal_tsum hf, },
+end
+
+lemma measurable_kernel_prod_mk_left [is_s_finite_kernel κ]
+  {t : set (α × β)} (ht : measurable_set t) :
+  measurable (λ a, κ a (prod.mk a ⁻¹' t)) :=
+begin
+  rw ← kernel_sum_seq κ,
+  have : ∀ a, kernel.sum (seq κ) a (prod.mk a ⁻¹' t) = ∑' n, seq κ n a (prod.mk a ⁻¹' t),
+    from λ a, kernel.sum_apply' _ _ (measurable_prod_mk_left ht),
+  simp_rw this,
+  refine measurable.ennreal_tsum (λ n, _),
+  exact measurable_kernel_prod_mk_left_of_finite ht infer_instance,
+end
+
+lemma measurable_kernel_prod_mk_left' [is_s_finite_kernel η]
+  {s : set (β × γ)} (hs : measurable_set s) (a : α) :
+  measurable (λ b, η (a, b) (prod.mk b ⁻¹' s)) :=
+begin
+  have : ∀ b, prod.mk b ⁻¹' s = {c | ((a, b), c) ∈ {p : (α × β) × γ | (p.1.2, p.2) ∈ s}},
+  { intro b, refl, },
+  simp_rw this,
+  refine (measurable_kernel_prod_mk_left _).comp measurable_prod_mk_left,
+  exact (measurable_fst.snd.prod_mk measurable_snd) hs,
+end
+
+lemma measurable_kernel_prod_mk_right [is_s_finite_kernel κ]
+  {s : set (β × α)} (hs : measurable_set s) :
+  measurable (λ y, κ y ((λ x, (x, y)) ⁻¹' s)) :=
+measurable_kernel_prod_mk_left (measurable_set_swap_iff.mpr hs)
+
+end kernel
+
+open probability_theory.kernel
+
+section lintegral
+
+variables [is_s_finite_kernel κ] [is_s_finite_kernel η]
+
+/-- Auxiliary lemma for `measurable.lintegral_kernel_prod_right`. -/
+lemma kernel.measurable_lintegral_indicator_const {t : set (α × β)} (ht : measurable_set t)
+  (c : ℝ≥0∞) :
+  measurable (λ a, ∫⁻ b, t.indicator (function.const (α × β) c) (a, b) ∂(κ a)) :=
+begin
+  simp_rw lintegral_indicator_const_comp measurable_prod_mk_left ht _,
+  exact measurable.const_mul (measurable_kernel_prod_mk_left ht) c,
+end
+
+/-- For an s-finite kernel `κ` and a function `f : α → β → ℝ≥0∞` which is measurable when seen as a
+map from `α × β` (hypothesis `measurable (uncurry f)`), the integral `a ↦ ∫⁻ b, f a b ∂(κ a)` is
+measurable. -/
+lemma _root_.measurable.lintegral_kernel_prod_right {f : α → β → ℝ≥0∞}
+  (hf : measurable (uncurry f)) :
+  measurable (λ a, ∫⁻ b, f a b ∂(κ a)) :=
+begin
+  let F : ℕ → simple_func (α × β) ℝ≥0∞ := simple_func.eapprox (uncurry f),
+  have h : ∀ a, (⨆ n, F n a) = uncurry f a,
+    from simple_func.supr_eapprox_apply (uncurry f) hf,
+  simp only [prod.forall, uncurry_apply_pair] at h,
+  simp_rw ← h,
+  have : ∀ a, ∫⁻ b, (⨆ n, F n (a, b)) ∂(κ a) = ⨆ n, ∫⁻ b, F n (a, b) ∂(κ a),
+  { intro a,
+    rw lintegral_supr,
+    { exact λ n, (F n).measurable.comp measurable_prod_mk_left, },
+    { exact λ i j hij b, simple_func.monotone_eapprox (uncurry f) hij _, }, },
+  simp_rw this,
+  refine measurable_supr (λ n, simple_func.induction _ _ (F n)),
+  { intros c t ht,
+    simp only [simple_func.const_zero, simple_func.coe_piecewise, simple_func.coe_const,
+      simple_func.coe_zero, set.piecewise_eq_indicator],
+    exact kernel.measurable_lintegral_indicator_const ht c, },
+  { intros g₁ g₂ h_disj hm₁ hm₂,
+    simp only [simple_func.coe_add, pi.add_apply],
+    have h_add : (λ a, ∫⁻ b, g₁ (a, b) + g₂ (a, b) ∂(κ a))
+      = (λ a, ∫⁻ b, g₁ (a, b) ∂(κ a)) + (λ a, ∫⁻ b, g₂ (a, b) ∂(κ a)),
+    { ext1 a,
+      rw [pi.add_apply, lintegral_add_left (g₁.measurable.comp measurable_prod_mk_left)], },
+    rw h_add,
+    exact measurable.add hm₁ hm₂, },
+end
+
+lemma _root_.measurable.lintegral_kernel_prod_right' {f : (α × β) → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ a, ∫⁻ b, f (a, b) ∂(κ a)) :=
+begin
+  refine measurable.lintegral_kernel_prod_right _,
+  have : uncurry (λ (a : α) (b : β), f (a, b)) = f,
+  { ext x, rw [← @prod.mk.eta _ _ x, uncurry_apply_pair], },
+  rwa this,
+end
+
+lemma _root_.measurable.lintegral_kernel_prod_right'' {f : β × γ → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ x, ∫⁻ y, f (x, y) ∂(η (a, x))) :=
+begin
+  change measurable ((λ x, ∫⁻ y, (λ u : (α × β) × γ, f (u.1.2, u.2)) (x, y) ∂(η x))
+    ∘ (λ x, (a, x))),
+  refine (measurable.lintegral_kernel_prod_right' _).comp measurable_prod_mk_left,
+  exact hf.comp (measurable_fst.snd.prod_mk measurable_snd),
+end
+
+lemma _root_.measurable.set_lintegral_kernel_prod_right
+  {f : α → β → ℝ≥0∞} (hf : measurable (uncurry f)) {s : set β} (hs : measurable_set s) :
+  measurable (λ a, ∫⁻ b in s, f a b ∂(κ a)) :=
+by { simp_rw ← lintegral_restrict κ hs, exact hf.lintegral_kernel_prod_right }
+
+lemma _root_.measurable.lintegral_kernel_prod_left' {f : β × α → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ y, ∫⁻ x, f (x, y) ∂(κ y)) :=
+(measurable_swap_iff.mpr hf).lintegral_kernel_prod_right'
+
+lemma _root_.measurable.lintegral_kernel_prod_left
+  {f : β → α → ℝ≥0∞} (hf : measurable (uncurry f)) :
+  measurable (λ y, ∫⁻ x, f x y ∂(κ y)) :=
+hf.lintegral_kernel_prod_left'
+
+lemma _root_.measurable.set_lintegral_kernel_prod_left
+  {f : β → α → ℝ≥0∞} (hf : measurable (uncurry f)) {s : set β} (hs : measurable_set s) :
+  measurable (λ b, ∫⁻ a in s, f a b ∂(κ b)) :=
+by { simp_rw ← lintegral_restrict κ hs, exact hf.lintegral_kernel_prod_left }
+
+lemma _root_.measurable.lintegral_kernel {f : β → ℝ≥0∞} (hf : measurable f) :
+  measurable (λ a, ∫⁻ b, f b ∂(κ a)) :=
+measurable.lintegral_kernel_prod_right (hf.comp measurable_snd)
+
+lemma _root_.measurable.set_lintegral_kernel
+  {f : β → ℝ≥0∞} (hf : measurable f) {s : set β} (hs : measurable_set s) :
+  measurable (λ a, ∫⁻ b in s, f b ∂(κ a)) :=
+measurable.set_lintegral_kernel_prod_right (hf.comp measurable_snd) hs
+
+end lintegral
+
+variables {E : Type*} [normed_add_comm_group E] [is_s_finite_kernel κ] [is_s_finite_kernel η]
+
+lemma measurable_set_kernel_integrable ⦃f : α → β → E⦄ (hf : strongly_measurable (uncurry f)) :
+  measurable_set {x | integrable (f x) (κ x)} :=
+begin
+  simp_rw [integrable, hf.of_uncurry_left.ae_strongly_measurable, true_and],
+  exact measurable_set_lt (measurable.lintegral_kernel_prod_right hf.ennnorm) measurable_const
+end
+
+end probability_theory
+
+open probability_theory probability_theory.kernel
+
+namespace measure_theory
+
+variables {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  [is_s_finite_kernel κ] [is_s_finite_kernel η]
+
+lemma strongly_measurable.integral_kernel_prod_right
+  ⦃f : α → β → E⦄ (hf : strongly_measurable (uncurry f)) :
+  strongly_measurable (λ x, ∫ y, f x y ∂(κ x)) :=
+begin
+  classical,
+  borelize E,
+  haveI : topological_space.separable_space (range (uncurry f) ∪ {0} : set E) :=
+    hf.separable_space_range_union_singleton,
+  let s : ℕ → simple_func (α × β) E := simple_func.approx_on _ hf.measurable
+    (range (uncurry f) ∪ {0}) 0 (by simp),
+  let s' : ℕ → α → simple_func β E := λ n x, (s n).comp (prod.mk x) measurable_prod_mk_left,
+  let f' : ℕ → α → E := λ n, {x | integrable (f x) (κ x)}.indicator
+    (λ x, (s' n x).integral (κ x)),
+  have hf' : ∀ n, strongly_measurable (f' n),
+  { intro n, refine strongly_measurable.indicator _ (measurable_set_kernel_integrable hf),
+    have : ∀ x, (s' n x).range.filter (λ x, x ≠ 0) ⊆ (s n).range,
+    { intros x, refine finset.subset.trans (finset.filter_subset _ _) _, intro y,
+      simp_rw [simple_func.mem_range], rintro ⟨z, rfl⟩, exact ⟨(x, z), rfl⟩ },
+    simp only [simple_func.integral_eq_sum_of_subset (this _)],
+    refine finset.strongly_measurable_sum _ (λ x _, _),
+    refine (measurable.ennreal_to_real _).strongly_measurable.smul_const _,
+    simp only [simple_func.coe_comp, preimage_comp] {single_pass := tt},
+    apply measurable_kernel_prod_mk_left,
+    exact (s n).measurable_set_fiber x },
+  have h2f' : tendsto f' at_top (𝓝 (λ (x : α), ∫ (y : β), f x y ∂(κ x))),
+  { rw [tendsto_pi_nhds], intro x,
+    by_cases hfx : integrable (f x) (κ x),
+    { have : ∀ n, integrable (s' n x) (κ x),
+      { intro n, apply (hfx.norm.add hfx.norm).mono' (s' n x).ae_strongly_measurable,
+        apply eventually_of_forall, intro y,
+        simp_rw [s', simple_func.coe_comp], exact simple_func.norm_approx_on_zero_le _ _ (x, y) n },
+      simp only [f', hfx, simple_func.integral_eq_integral _ (this _), indicator_of_mem,
+        mem_set_of_eq],
+      refine tendsto_integral_of_dominated_convergence (λ y, ‖f x y‖ + ‖f x y‖)
+        (λ n, (s' n x).ae_strongly_measurable) (hfx.norm.add hfx.norm) _ _,
+      { exact λ n, eventually_of_forall (λ y, simple_func.norm_approx_on_zero_le _ _ (x, y) n) },
+      { refine eventually_of_forall (λ y, simple_func.tendsto_approx_on _ _ _),
+        apply subset_closure,
+        simp [-uncurry_apply_pair], } },
+    { simp [f', hfx, integral_undef], } },
+  exact strongly_measurable_of_tendsto _ hf' h2f',
+end
+
+lemma strongly_measurable.integral_kernel_prod_right'
+  ⦃f : α × β → E⦄ (hf : strongly_measurable f) :
+  strongly_measurable (λ x, ∫ y, f (x, y) ∂(κ x)) :=
+by { rw [← uncurry_curry f] at hf, exact hf.integral_kernel_prod_right }
+
+lemma strongly_measurable.integral_kernel_prod_right''
+  {f : β × γ → E} (hf : strongly_measurable f) :
+  strongly_measurable (λ x, ∫ y, f (x, y) ∂(η (a, x))) :=
+begin
+  change strongly_measurable ((λ x, ∫ y, (λ u : (α × β) × γ, f (u.1.2, u.2)) (x, y) ∂(η x))
+    ∘ (λ x, (a, x))),
+  refine strongly_measurable.comp_measurable _ measurable_prod_mk_left,
+  refine measure_theory.strongly_measurable.integral_kernel_prod_right' _,
+  exact hf.comp_measurable (measurable_fst.snd.prod_mk measurable_snd),
+end
+
+lemma strongly_measurable.integral_kernel_prod_left
+  ⦃f : β → α → E⦄ (hf : strongly_measurable (uncurry f)) :
+  strongly_measurable (λ y, ∫ x, f x y ∂(κ y)) :=
+(hf.comp_measurable measurable_swap).integral_kernel_prod_right'
+
+lemma strongly_measurable.integral_kernel_prod_left'
+  ⦃f : β × α → E⦄ (hf : strongly_measurable f) :
+  strongly_measurable (λ y, ∫ x, f (x, y) ∂(κ y)) :=
+(hf.comp_measurable measurable_swap).integral_kernel_prod_right'
+
+lemma strongly_measurable.integral_kernel_prod_left''
+  {f : γ × β → E} (hf : strongly_measurable f) :
+  strongly_measurable (λ y, ∫ x, f (x, y) ∂(η (a, y))) :=
+begin
+  change strongly_measurable ((λ y, ∫ x, (λ u : γ × (α × β), f (u.1, u.2.2)) (x, y) ∂(η y))
+    ∘ (λ x, (a, x))),
+  refine strongly_measurable.comp_measurable _ measurable_prod_mk_left,
+  refine measure_theory.strongly_measurable.integral_kernel_prod_left' _,
+  exact hf.comp_measurable (measurable_fst.prod_mk measurable_snd.snd),
+end
+
+end measure_theory
diff --git a/src/probability/kernel/with_density.lean b/src/probability/kernel/with_density.lean
new file mode 100644
index 0000000000000..8a50da8a2afca
--- /dev/null
+++ b/src/probability/kernel/with_density.lean
@@ -0,0 +1,253 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+import probability.kernel.measurable_integral
+import measure_theory.integral.set_integral
+
+/-!
+# With Density
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+For an s-finite kernel `κ : kernel α β` and a function `f : α → β → ℝ≥0∞` which is finite
+everywhere, we define `with_density κ f` as the kernel `a ↦ (κ a).with_density (f a)`. This is
+an s-finite kernel.
+
+## Main definitions
+
+* `probability_theory.kernel.with_density κ (f : α → β → ℝ≥0∞)`:
+  kernel `a ↦ (κ a).with_density (f a)`. It is defined if `κ` is s-finite. If `f` is finite
+  everywhere, then this is also an s-finite kernel. The class of s-finite kernels is the smallest
+  class of kernels that contains finite kernels and which is stable by `with_density`.
+  Integral: `∫⁻ b, g b ∂(with_density κ f a) = ∫⁻ b, f a b * g b ∂(κ a)`
+
+## Main statements
+
+* `probability_theory.kernel.lintegral_with_density`:
+  `∫⁻ b, g b ∂(with_density κ f a) = ∫⁻ b, f a b * g b ∂(κ a)`
+
+-/
+
+open measure_theory probability_theory
+
+open_locale measure_theory ennreal nnreal big_operators
+
+namespace probability_theory.kernel
+
+variables {α β ι : Type*} {mα : measurable_space α} {mβ : measurable_space β}
+
+include mα mβ
+
+variables {κ : kernel α β} {f : α → β → ℝ≥0∞}
+
+/-- Kernel with image `(κ a).with_density (f a)` if `function.uncurry f` is measurable, and
+with image 0 otherwise. If `function.uncurry f` is measurable, it satisfies
+`∫⁻ b, g b ∂(with_density κ f hf a) = ∫⁻ b, f a b * g b ∂(κ a)`. -/
+noncomputable
+def with_density (κ : kernel α β) [is_s_finite_kernel κ] (f : α → β → ℝ≥0∞) :
+  kernel α β :=
+@dite _ (measurable (function.uncurry f)) (classical.dec _)
+  (λ hf, ({ val := λ a, (κ a).with_density (f a),
+    property :=
+    begin
+      refine measure.measurable_of_measurable_coe _ (λ s hs, _),
+      simp_rw with_density_apply _ hs,
+      exact hf.set_lintegral_kernel_prod_right hs,
+    end, } : kernel α β))
+  (λ hf, 0)
+
+lemma with_density_of_not_measurable (κ : kernel α β) [is_s_finite_kernel κ]
+  (hf : ¬ measurable (function.uncurry f)) :
+  with_density κ f = 0 :=
+by { classical, exact dif_neg hf, }
+
+protected lemma with_density_apply (κ : kernel α β) [is_s_finite_kernel κ]
+  (hf : measurable (function.uncurry f)) (a : α) :
+  with_density κ f a = (κ a).with_density (f a) :=
+by { classical, rw [with_density, dif_pos hf], refl, }
+
+lemma with_density_apply' (κ : kernel α β) [is_s_finite_kernel κ]
+  (hf : measurable (function.uncurry f)) (a : α) {s : set β} (hs : measurable_set s) :
+  with_density κ f a s = ∫⁻ b in s, f a b ∂(κ a) :=
+by rw [kernel.with_density_apply κ hf, with_density_apply _ hs]
+
+lemma lintegral_with_density (κ : kernel α β) [is_s_finite_kernel κ]
+  (hf : measurable (function.uncurry f)) (a : α) {g : β → ℝ≥0∞} (hg : measurable g) :
+  ∫⁻ b, g b ∂(with_density κ f a) = ∫⁻ b, f a b * g b ∂(κ a) :=
+begin
+  rw [kernel.with_density_apply _ hf,
+    lintegral_with_density_eq_lintegral_mul _ (measurable.of_uncurry_left hf) hg],
+  simp_rw pi.mul_apply,
+end
+
+lemma integral_with_density {E : Type*} [normed_add_comm_group E] [normed_space ℝ E]
+  [complete_space E] {f : β → E} [is_s_finite_kernel κ] {a : α}
+  {g : α → β → ℝ≥0} (hg : measurable (function.uncurry g)) :
+  ∫ b, f b ∂(with_density κ (λ a b, g a b) a) = ∫ b, (g a b) • f b ∂(κ a) :=
+begin
+  rw [kernel.with_density_apply, integral_with_density_eq_integral_smul],
+  { exact measurable.of_uncurry_left hg, },
+  { exact measurable_coe_nnreal_ennreal.comp hg, },
+end
+
+lemma with_density_add_left (κ η : kernel α β) [is_s_finite_kernel κ] [is_s_finite_kernel η]
+  (f : α → β → ℝ≥0∞) :
+  with_density (κ + η) f = with_density κ f + with_density η f :=
+begin
+  by_cases hf : measurable (function.uncurry f),
+  { ext a s hs : 2,
+    simp only [kernel.with_density_apply _ hf, coe_fn_add, pi.add_apply, with_density_add_measure,
+      measure.add_apply], },
+  { simp_rw [with_density_of_not_measurable _ hf],
+    rw zero_add, },
+end
+
+lemma with_density_kernel_sum [countable ι] (κ : ι → kernel α β)
+  (hκ : ∀ i, is_s_finite_kernel (κ i)) (f : α → β → ℝ≥0∞) :
+  @with_density _ _ _ _ (kernel.sum κ) (is_s_finite_kernel_sum hκ) f
+    = kernel.sum (λ i, with_density (κ i) f) :=
+begin
+  by_cases hf : measurable (function.uncurry f),
+  { ext1 a,
+    simp_rw [sum_apply, kernel.with_density_apply _ hf, sum_apply,
+      with_density_sum (λ n, κ n a) (f a)], },
+  { simp_rw [with_density_of_not_measurable _ hf],
+    exact sum_zero.symm, },
+end
+
+lemma with_density_tsum [countable ι] (κ : kernel α β) [is_s_finite_kernel κ]
+  {f : ι → α → β → ℝ≥0∞} (hf : ∀ i, measurable (function.uncurry (f i))) :
+  with_density κ (∑' n, f n) = kernel.sum (λ n, with_density κ (f n)) :=
+begin
+  have h_sum_a : ∀ a, summable (λ n, f n a) := λ a, pi.summable.mpr (λ b, ennreal.summable),
+  have h_sum : summable (λ n, f n) := pi.summable.mpr h_sum_a,
+  ext a s hs : 2,
+  rw [sum_apply' _ a hs, with_density_apply' κ _ a hs],
+  swap,
+  { have : function.uncurry (∑' n, f n) = ∑' n, function.uncurry (f n),
+    { ext1 p,
+      simp only [function.uncurry_def],
+      rw [tsum_apply h_sum, tsum_apply (h_sum_a _), tsum_apply],
+      exact pi.summable.mpr (λ p, ennreal.summable), },
+    rw this,
+    exact measurable.ennreal_tsum' hf, },
+  have : ∫⁻ b in s, (∑' n, f n) a b ∂(κ a) = ∫⁻ b in s, (∑' n, (λ b, f n a b) b) ∂(κ a),
+  { congr' with b,
+    rw [tsum_apply h_sum, tsum_apply (h_sum_a a)], },
+  rw [this, lintegral_tsum (λ n, (measurable.of_uncurry_left (hf n)).ae_measurable)],
+  congr' with n,
+  rw with_density_apply' _ (hf n) a hs,
+end
+
+/-- If a kernel `κ` is finite and a function `f : α → β → ℝ≥0∞` is bounded, then `with_density κ f`
+is finite. -/
+lemma is_finite_kernel_with_density_of_bounded (κ : kernel α β) [is_finite_kernel κ]
+  {B : ℝ≥0∞} (hB_top : B ≠ ∞) (hf_B : ∀ a b, f a b ≤ B) :
+  is_finite_kernel (with_density κ f) :=
+begin
+  by_cases hf : measurable (function.uncurry f),
+  { exact
+      ⟨⟨B * is_finite_kernel.bound κ, ennreal.mul_lt_top hB_top (is_finite_kernel.bound_ne_top κ),
+        λ a,
+        begin
+          rw with_density_apply' κ hf a measurable_set.univ,
+          calc ∫⁻ b in set.univ, f a b ∂(κ a)
+              ≤ ∫⁻ b in set.univ, B ∂(κ a) : lintegral_mono (hf_B a)
+          ... = B * κ a set.univ :
+            by simp only [measure.restrict_univ, measure_theory.lintegral_const]
+          ... ≤ B * is_finite_kernel.bound κ :
+            mul_le_mul_left' (measure_le_bound κ a set.univ) _,
+        end⟩⟩, },
+  { rw with_density_of_not_measurable _ hf,
+    apply_instance, },
+end
+
+/-- Auxiliary lemma for `is_s_finite_kernel_with_density`.
+If a kernel `κ` is finite, then `with_density κ f` is s-finite. -/
+lemma is_s_finite_kernel_with_density_of_is_finite_kernel (κ : kernel α β) [is_finite_kernel κ]
+  (hf_ne_top : ∀ a b, f a b ≠ ∞) :
+  is_s_finite_kernel (with_density κ f) :=
+begin
+  -- We already have that for `f` bounded from above and a `κ` a finite kernel,
+  -- `with_density κ f` is finite. We write any function as a countable sum of bounded
+  -- functions, and decompose an s-finite kernel as a sum of finite kernels. We then use that
+  -- `with_density` commutes with sums for both arguments and get a sum of finite kernels.
+  by_cases hf : measurable (function.uncurry f),
+  swap, { rw with_density_of_not_measurable _ hf, apply_instance, },
+  let fs : ℕ → α → β → ℝ≥0∞ := λ n a b, min (f a b) (n + 1) - min (f a b) n,
+  have h_le : ∀ a b n, ⌈(f a b).to_real⌉₊ ≤ n → f a b ≤ n,
+  { intros a b n hn,
+    have : (f a b).to_real ≤ n := nat.le_of_ceil_le hn,
+    rw ← ennreal.le_of_real_iff_to_real_le (hf_ne_top a b) _ at this,
+    { refine this.trans (le_of_eq _),
+      rw ennreal.of_real_coe_nat, },
+    { norm_cast,
+      exact zero_le _, }, },
+  have h_zero : ∀ a b n, ⌈(f a b).to_real⌉₊ ≤ n → fs n a b = 0,
+  { intros a b n hn,
+    suffices : min (f a b) (n + 1) = f a b ∧ min (f a b) n = f a b,
+    { simp_rw [fs, this.1, this.2, tsub_self (f a b)], },
+    exact ⟨min_eq_left ((h_le a b n hn).trans (le_add_of_nonneg_right zero_le_one)),
+      min_eq_left (h_le a b n hn)⟩, },
+  have hf_eq_tsum : f = ∑' n, fs n,
+  { have h_sum_a : ∀ a, summable (λ n, fs n a),
+    { refine λ a, pi.summable.mpr (λ b, _),
+      suffices : ∀ n, n ∉ finset.range ⌈(f a b).to_real⌉₊ → fs n a b = 0,
+        from summable_of_ne_finset_zero this,
+      intros n hn_not_mem,
+      rw [finset.mem_range, not_lt] at hn_not_mem,
+      exact h_zero a b n hn_not_mem, },
+    ext a b : 2,
+    rw [tsum_apply (pi.summable.mpr h_sum_a), tsum_apply (h_sum_a a),
+      ennreal.tsum_eq_liminf_sum_nat],
+    have h_finset_sum : ∀ n, ∑ i in finset.range n, fs i a b = min (f a b) n,
+    { intros n,
+      induction n with n hn,
+      { simp only [finset.range_zero, finset.sum_empty, algebra_map.coe_zero, min_zero], },
+      rw [finset.sum_range_succ, hn],
+      simp_rw [fs],
+      norm_cast,
+      rw add_tsub_cancel_iff_le,
+      refine min_le_min le_rfl _,
+      norm_cast,
+      exact nat.le_succ n, },
+    simp_rw h_finset_sum,
+    refine (filter.tendsto.liminf_eq _).symm,
+    refine filter.tendsto.congr' _ tendsto_const_nhds,
+    rw [filter.eventually_eq, filter.eventually_at_top],
+    exact ⟨⌈(f a b).to_real⌉₊, λ n hn, (min_eq_left (h_le a b n hn)).symm⟩, },
+  rw [hf_eq_tsum, with_density_tsum _ (λ (n : ℕ), _)],
+  swap, { exact (hf.min measurable_const).sub (hf.min measurable_const), },
+  refine is_s_finite_kernel_sum (λ n, _),
+  suffices : is_finite_kernel (with_density κ (fs n)), by { haveI := this, apply_instance, },
+  refine is_finite_kernel_with_density_of_bounded _ (ennreal.coe_ne_top : (↑n + 1) ≠ ∞) (λ a b, _),
+  norm_cast,
+  calc fs n a b ≤ min (f a b) (n + 1) : tsub_le_self
+            ... ≤ (n + 1) : min_le_right _ _
+            ... = ↑(n + 1) : by norm_cast,
+end
+
+/-- For a s-finite kernel `κ` and a function `f : α → β → ℝ≥0∞` which is everywhere finite,
+`with_density κ f` is s-finite. -/
+theorem is_s_finite_kernel.with_density (κ : kernel α β) [is_s_finite_kernel κ]
+  (hf_ne_top : ∀ a b, f a b ≠ ∞) :
+  is_s_finite_kernel (with_density κ f) :=
+begin
+  have h_eq_sum : with_density κ f = kernel.sum (λ i, with_density (seq κ i) f),
+  { rw ← with_density_kernel_sum _ _,
+    congr,
+    exact (kernel_sum_seq κ).symm, },
+  rw h_eq_sum,
+  exact is_s_finite_kernel_sum
+    (λ n, is_s_finite_kernel_with_density_of_is_finite_kernel (seq κ n) hf_ne_top),
+end
+
+/-- For a s-finite kernel `κ` and a function `f : α → β → ℝ≥0`, `with_density κ f` is s-finite. -/
+instance (κ : kernel α β) [is_s_finite_kernel κ] (f : α → β → ℝ≥0) :
+  is_s_finite_kernel (with_density κ (λ a b, f a b)) :=
+is_s_finite_kernel.with_density κ (λ _ _, ennreal.coe_ne_top)
+
+end probability_theory.kernel
diff --git a/src/probability/martingale.lean b/src/probability/martingale.lean
deleted file mode 100644
index 660fd65d7b7ee..0000000000000
--- a/src/probability/martingale.lean
+++ /dev/null
@@ -1,415 +0,0 @@
-/-
-Copyright (c) 2021 Rémy Degenne. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Rémy Degenne, Kexing Ying
--/
-import probability.notation
-import probability.stopping
-
-/-!
-# Martingales
-
-A family of functions `f : ι → α → E` is a martingale with respect to a filtration `ℱ` if every
-`f i` is integrable, `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
-`μ[f j | ℱ.le i] =ᵐ[μ] f i`. On the other hand, `f : ι → α → E` is said to be a supermartingale
-with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with resepct to `ℱ`
-and for all `i ≤ j`, `μ[f j | ℱ.le i] ≤ᵐ[μ] f i`. Finally, `f : ι → α → E` is said to be a
-submartingale with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with
-resepct to `ℱ` and for all `i ≤ j`, `f i ≤ᵐ[μ] μ[f j | ℱ.le i]`.
-
-The definitions of filtration and adapted can be found in `probability.stopping`.
-
-### Definitions
-
-* `measure_theory.martingale f ℱ μ`: `f` is a martingale with respect to filtration `ℱ` and
-  measure `μ`.
-* `measure_theory.supermartingale f ℱ μ`: `f` is a supermartingale with respect to
-  filtration `ℱ` and measure `μ`.
-* `measure_theory.submartingale f ℱ μ`: `f` is a submartingale with respect to filtration `ℱ` and
-  measure `μ`.
-
-### Results
-
-* `measure_theory.martingale_condexp f ℱ μ`: the sequence `λ i, μ[f | ℱ i, ℱ.le i])` is a
-  martingale with respect to `ℱ` and `μ`.
-
--/
-
-open topological_space filter
-open_locale nnreal ennreal measure_theory probability_theory big_operators
-
-namespace measure_theory
-
-variables {α E ι : Type*} [preorder ι]
-  {m0 : measurable_space α} {μ : measure α}
-  [normed_group E] [normed_space ℝ E] [complete_space E]
-  {f g : ι → α → E} {ℱ : filtration ι m0} [sigma_finite_filtration μ ℱ]
-
-/-- A family of functions `f : ι → α → E` is a martingale with respect to a filtration `ℱ` if `f`
-is adapted with respect to `ℱ` and for all `i ≤ j`, `μ[f j | ℱ.le i] =ᵐ[μ] f i`. -/
-def martingale (f : ι → α → E) (ℱ : filtration ι m0) (μ : measure α)
-  [sigma_finite_filtration μ ℱ] : Prop :=
-adapted ℱ f ∧ ∀ i j, i ≤ j → μ[f j | ℱ i, ℱ.le i] =ᵐ[μ] f i
-
-/-- A family of integrable functions `f : ι → α → E` is a supermartingale with respect to a
-filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
-`μ[f j | ℱ.le i] ≤ᵐ[μ] f i`. -/
-def supermartingale [has_le E] (f : ι → α → E) (ℱ : filtration ι m0) (μ : measure α)
-  [sigma_finite_filtration μ ℱ] : Prop :=
-adapted ℱ f ∧ (∀ i j, i ≤ j → μ[f j | ℱ i, ℱ.le i] ≤ᵐ[μ] f i) ∧ ∀ i, integrable (f i) μ
-
-/-- A family of integrable functions `f : ι → α → E` is a submartingale with respect to a
-filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
-`f i ≤ᵐ[μ] μ[f j | ℱ.le i]`. -/
-def submartingale [has_le E] (f : ι → α → E) (ℱ : filtration ι m0) (μ : measure α)
-  [sigma_finite_filtration μ ℱ] : Prop :=
-adapted ℱ f ∧ (∀ i j, i ≤ j → f i ≤ᵐ[μ] μ[f j | ℱ i, ℱ.le i]) ∧ ∀ i, integrable (f i) μ
-
-variables (E)
-lemma martingale_zero (ℱ : filtration ι m0) (μ : measure α) [sigma_finite_filtration μ ℱ] :
-  martingale (0 : ι → α → E) ℱ μ :=
-⟨adapted_zero E ℱ, λ i j hij, by { rw [pi.zero_apply, condexp_zero], simp, }⟩
-variables {E}
-
-namespace martingale
-
-@[protected]
-lemma adapted (hf : martingale f ℱ μ) : adapted ℱ f := hf.1
-
-@[protected]
-lemma strongly_measurable (hf : martingale f ℱ μ) (i : ι) : strongly_measurable[ℱ i] (f i) :=
-hf.adapted i
-
-lemma condexp_ae_eq (hf : martingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
-  μ[f j | ℱ i, ℱ.le i] =ᵐ[μ] f i :=
-hf.2 i j hij
-
-@[protected]
-lemma integrable (hf : martingale f ℱ μ) (i : ι) : integrable (f i) μ :=
-integrable_condexp.congr (hf.condexp_ae_eq (le_refl i))
-
-lemma set_integral_eq (hf : martingale f ℱ μ) {i j : ι} (hij : i ≤ j) {s : set α}
-  (hs : measurable_set[ℱ i] s) :
-  ∫ x in s, f i x ∂μ = ∫ x in s, f j x ∂μ :=
-begin
-  rw ← @set_integral_condexp _ _ _ _ _ (ℱ i) m0 _ (ℱ.le i) _ _ _ (hf.integrable j) hs,
-  refine set_integral_congr_ae (ℱ.le i s hs) _,
-  filter_upwards [hf.2 i j hij] with _ heq _ using heq.symm,
-end
-
-lemma add (hf : martingale f ℱ μ) (hg : martingale g ℱ μ) : martingale (f + g) ℱ μ :=
-begin
-  refine ⟨hf.adapted.add hg.adapted, λ i j hij, _⟩,
-  exact (condexp_add (hf.integrable j) (hg.integrable j)).trans
-    ((hf.2 i j hij).add (hg.2 i j hij)),
-end
-
-lemma neg (hf : martingale f ℱ μ) : martingale (-f) ℱ μ :=
-⟨hf.adapted.neg, λ i j hij, (condexp_neg (f j)).trans ((hf.2 i j hij).neg)⟩
-
-lemma sub (hf : martingale f ℱ μ) (hg : martingale g ℱ μ) : martingale (f - g) ℱ μ :=
-by { rw sub_eq_add_neg, exact hf.add hg.neg, }
-
-lemma smul (c : ℝ) (hf : martingale f ℱ μ) : martingale (c • f) ℱ μ :=
-begin
-  refine ⟨hf.adapted.smul c, λ i j hij, _⟩,
-  refine (condexp_smul c (f j)).trans ((hf.2 i j hij).mono (λ x hx, _)),
-  rw [pi.smul_apply, hx, pi.smul_apply, pi.smul_apply],
-end
-
-lemma supermartingale [preorder E] (hf : martingale f ℱ μ) : supermartingale f ℱ μ :=
-⟨hf.1, λ i j hij, (hf.2 i j hij).le, λ i, hf.integrable i⟩
-
-lemma submartingale [preorder E] (hf : martingale f ℱ μ) : submartingale f ℱ μ :=
-⟨hf.1, λ i j hij, (hf.2 i j hij).symm.le, λ i, hf.integrable i⟩
-
-end martingale
-
-lemma martingale_iff [partial_order E] : martingale f ℱ μ ↔
-  supermartingale f ℱ μ ∧ submartingale f ℱ μ :=
-⟨λ hf, ⟨hf.supermartingale, hf.submartingale⟩,
- λ ⟨hf₁, hf₂⟩, ⟨hf₁.1, λ i j hij, (hf₁.2.1 i j hij).antisymm (hf₂.2.1 i j hij)⟩⟩
-
-lemma martingale_condexp (f : α → E) (ℱ : filtration ι m0) (μ : measure α)
-  [sigma_finite_filtration μ ℱ] :
-  martingale (λ i, μ[f | ℱ i, ℱ.le i]) ℱ μ :=
-⟨λ i, strongly_measurable_condexp, λ i j hij, condexp_condexp_of_le (ℱ.mono hij) _⟩
-
-namespace supermartingale
-
-@[protected]
-lemma adapted [has_le E] (hf : supermartingale f ℱ μ) : adapted ℱ f := hf.1
-
-@[protected]
-lemma strongly_measurable [has_le E] (hf : supermartingale f ℱ μ) (i : ι) :
-  strongly_measurable[ℱ i] (f i) :=
-hf.adapted i
-
-@[protected]
-lemma integrable [has_le E] (hf : supermartingale f ℱ μ) (i : ι) : integrable (f i) μ := hf.2.2 i
-
-lemma condexp_ae_le [has_le E] (hf : supermartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
-  μ[f j | ℱ i, ℱ.le i] ≤ᵐ[μ] f i :=
-hf.2.1 i j hij
-
-lemma set_integral_le {f : ι → α → ℝ} (hf : supermartingale f ℱ μ)
-  {i j : ι} (hij : i ≤ j) {s : set α} (hs : measurable_set[ℱ i] s) :
-  ∫ x in s, f j x ∂μ ≤ ∫ x in s, f i x ∂μ :=
-begin
-  rw ← set_integral_condexp (ℱ.le i) (hf.integrable j) hs,
-  refine set_integral_mono_ae integrable_condexp.integrable_on (hf.integrable i).integrable_on _,
-  filter_upwards [hf.2.1 i j hij] with _ heq using heq,
-end
-
-lemma add [preorder E] [covariant_class E E (+) (≤)]
-  (hf : supermartingale f ℱ μ) (hg : supermartingale g ℱ μ) : supermartingale (f + g) ℱ μ :=
-begin
-  refine ⟨hf.1.add hg.1, λ i j hij, _, λ i, (hf.2.2 i).add (hg.2.2 i)⟩,
-  refine (condexp_add (hf.integrable j) (hg.integrable j)).le.trans _,
-  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij],
-  intros,
-  refine add_le_add _ _; assumption,
-end
-
-lemma add_martingale [preorder E] [covariant_class E E (+) (≤)]
-  (hf : supermartingale f ℱ μ) (hg : martingale g ℱ μ) : supermartingale (f + g) ℱ μ :=
-hf.add hg.supermartingale
-
-lemma neg [preorder E] [covariant_class E E (+) (≤)]
-  (hf : supermartingale f ℱ μ) : submartingale (-f) ℱ μ :=
-begin
-  refine ⟨hf.1.neg, λ i j hij, _, λ i, (hf.2.2 i).neg⟩,
-  refine eventually_le.trans _ (condexp_neg (f j)).symm.le,
-  filter_upwards [hf.2.1 i j hij] with _ _,
-  simpa,
-end
-
-end supermartingale
-
-namespace submartingale
-
-@[protected]
-lemma adapted [has_le E] (hf : submartingale f ℱ μ) : adapted ℱ f := hf.1
-
-@[protected]
-lemma strongly_measurable [has_le E] (hf : submartingale f ℱ μ) (i : ι) :
-  strongly_measurable[ℱ i] (f i) :=
-hf.adapted i
-
-@[protected]
-lemma integrable [has_le E] (hf : submartingale f ℱ μ) (i : ι) : integrable (f i) μ := hf.2.2 i
-
-lemma ae_le_condexp [has_le E] (hf : submartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
-  f i ≤ᵐ[μ] μ[f j | ℱ i, ℱ.le i] :=
-hf.2.1 i j hij
-
-lemma add [preorder E] [covariant_class E E (+) (≤)]
-  (hf : submartingale f ℱ μ) (hg : submartingale g ℱ μ) : submartingale (f + g) ℱ μ :=
-begin
-  refine ⟨hf.1.add hg.1, λ i j hij, _, λ i, (hf.2.2 i).add (hg.2.2 i)⟩,
-  refine eventually_le.trans _ (condexp_add (hf.integrable j) (hg.integrable j)).symm.le,
-  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij],
-  intros,
-  refine add_le_add _ _; assumption,
-end
-
-lemma add_martingale [preorder E] [covariant_class E E (+) (≤)]
-  (hf : submartingale f ℱ μ) (hg : martingale g ℱ μ) : submartingale (f + g) ℱ μ :=
-hf.add hg.submartingale
-
-lemma neg [preorder E] [covariant_class E E (+) (≤)]
-  (hf : submartingale f ℱ μ) : supermartingale (-f) ℱ μ :=
-begin
-  refine ⟨hf.1.neg, λ i j hij, (condexp_neg (f j)).le.trans _, λ i, (hf.2.2 i).neg⟩,
-  filter_upwards [hf.2.1 i j hij] with _ _,
-  simpa,
-end
-
-/-- The converse of this lemma is `measure_theory.submartingale_of_set_integral_le`. -/
-lemma set_integral_le {f : ι → α → ℝ} (hf : submartingale f ℱ μ)
-  {i j : ι} (hij : i ≤ j) {s : set α} (hs : measurable_set[ℱ i] s) :
-  ∫ x in s, f i x ∂μ ≤ ∫ x in s, f j x ∂μ :=
-begin
-  rw [← neg_le_neg_iff, ← integral_neg, ← integral_neg],
-  exact supermartingale.set_integral_le hf.neg hij hs,
-end
-
-lemma sub_supermartingale [preorder E] [covariant_class E E (+) (≤)]
-  (hf : submartingale f ℱ μ) (hg : supermartingale g ℱ μ) : submartingale (f - g) ℱ μ :=
-by { rw sub_eq_add_neg, exact hf.add hg.neg }
-
-lemma sub_martingale [preorder E] [covariant_class E E (+) (≤)]
-  (hf : submartingale f ℱ μ) (hg : martingale g ℱ μ) : submartingale (f - g) ℱ μ :=
-hf.sub_supermartingale hg.supermartingale
-
-end submartingale
-
-section
-
-lemma submartingale_of_set_integral_le [is_finite_measure μ]
-  {f : ι → α → ℝ} (hadp : adapted ℱ f) (hint : ∀ i, integrable (f i) μ)
-  (hf : ∀ i j : ι, i ≤ j → ∀ s : set α, measurable_set[ℱ i] s →
-    ∫ x in s, f i x ∂μ ≤ ∫ x in s, f j x ∂μ) :
-  submartingale f ℱ μ :=
-begin
-  refine ⟨hadp, λ i j hij, _, hint⟩,
-  suffices : f i ≤ᵐ[μ.trim (ℱ.le i)] μ[f j| ℱ.le i],
-  { exact ae_le_of_ae_le_trim this },
-  suffices : 0 ≤ᵐ[μ.trim (ℱ.le i)] μ[f j| ℱ.le i] - f i,
-  { filter_upwards [this] with x hx,
-    rwa ← sub_nonneg },
-  refine ae_nonneg_of_forall_set_integral_nonneg_of_finite_measure
-    ((integrable_condexp.sub (hint i)).trim _ (strongly_measurable_condexp.sub $ hadp i))
-    (λ s hs, _),
-  specialize hf i j hij s hs,
-  rwa [← set_integral_trim _ (strongly_measurable_condexp.sub $ hadp i) hs,
-    integral_sub' integrable_condexp.integrable_on (hint i).integrable_on, sub_nonneg,
-    set_integral_condexp _ (hint j) hs],
-end
-
-end
-
-namespace supermartingale
-
-lemma sub_submartingale [preorder E] [covariant_class E E (+) (≤)]
-  (hf : supermartingale f ℱ μ) (hg : submartingale g ℱ μ) : supermartingale (f - g) ℱ μ :=
-by { rw sub_eq_add_neg, exact hf.add hg.neg }
-
-lemma sub_martingale [preorder E] [covariant_class E E (+) (≤)]
-  (hf : supermartingale f ℱ μ) (hg : martingale g ℱ μ) : supermartingale (f - g) ℱ μ :=
-hf.sub_submartingale hg.submartingale
-
-section
-
-variables {F : Type*} [normed_lattice_add_comm_group F]
-  [normed_space ℝ F] [complete_space F] [ordered_smul ℝ F]
-
-lemma smul_nonneg {f : ι → α → F}
-  {c : ℝ} (hc : 0 ≤ c) (hf : supermartingale f ℱ μ) :
-  supermartingale (c • f) ℱ μ :=
-begin
-  refine ⟨hf.1.smul c, λ i j hij, _, λ i, (hf.2.2 i).smul c⟩,
-  refine (condexp_smul c (f j)).le.trans _,
-  filter_upwards [hf.2.1 i j hij] with _ hle,
-  simp,
-  exact smul_le_smul_of_nonneg hle hc,
-end
-
-lemma smul_nonpos {f : ι → α → F}
-  {c : ℝ} (hc : c ≤ 0) (hf : supermartingale f ℱ μ) :
-  submartingale (c • f) ℱ μ :=
-begin
-  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(-c • f))],
-  exact (hf.smul_nonneg $ neg_nonneg.2 hc).neg,
-end
-
-end
-
-end supermartingale
-
-namespace submartingale
-
-section
-
-variables {F : Type*} [normed_lattice_add_comm_group F]
-  [normed_space ℝ F] [complete_space F] [ordered_smul ℝ F]
-
-lemma smul_nonneg {f : ι → α → F}
-  {c : ℝ} (hc : 0 ≤ c) (hf : submartingale f ℱ μ) :
-  submartingale (c • f) ℱ μ :=
-begin
-  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(c • -f))],
-  exact supermartingale.neg (hf.neg.smul_nonneg hc),
-end
-
-lemma smul_nonpos {f : ι → α → F}
-  {c : ℝ} (hc : c ≤ 0) (hf : submartingale f ℱ μ) :
-  supermartingale (c • f) ℱ μ :=
-begin
-  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(-c • f))],
-  exact (hf.smul_nonneg $ neg_nonneg.2 hc).neg,
-end
-
-end
-
-end submartingale
-
-section nat
-
-variables {𝒢 : filtration ℕ m0} [sigma_finite_filtration μ 𝒢]
-
-namespace submartingale
-
-lemma integrable_stopped_value [has_le E] {f : ℕ → α → E} (hf : submartingale f 𝒢 μ) {τ : α → ℕ}
-  (hτ : is_stopping_time 𝒢 τ) {N : ℕ} (hbdd : ∀ x, τ x ≤ N) :
-  integrable (stopped_value f τ) μ :=
-integrable_stopped_value hτ hf.integrable hbdd
-
--- We may generalize the below lemma to functions taking value in a `normed_lattice_add_comm_group`.
--- Similarly, generalize `(super/)submartingale.set_integral_le`.
-
-/-- Given a submartingale `f` and bounded stopping times `τ` and `π` such that `τ ≤ π`, the
-expectation of `stopped_value f τ` is less than or equal to the expectation of `stopped_value f π`.
-This is the forward direction of the optional stopping theorem. -/
-lemma expected_stopped_value_mono {f : ℕ → α → ℝ} (hf : submartingale f 𝒢 μ) {τ π : α → ℕ}
-  (hτ : is_stopping_time 𝒢 τ) (hπ : is_stopping_time 𝒢 π) (hle : τ ≤ π)
-  {N : ℕ} (hbdd : ∀ x, π x ≤ N) :
-  μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
-begin
-  rw [← sub_nonneg, ← integral_sub', stopped_value_sub_eq_sum' hle hbdd],
-  { simp only [finset.sum_apply],
-    have : ∀ i, measurable_set[𝒢 i] {x : α | τ x ≤ i ∧ i < π x},
-    { intro i,
-      refine (hτ i).inter _,
-      convert (hπ i).compl,
-      ext x,
-      simpa },
-    rw integral_finset_sum,
-    { refine finset.sum_nonneg (λ i hi, _),
-      rw [integral_indicator (𝒢.le _ _ (this _)), integral_sub', sub_nonneg],
-      { exact hf.set_integral_le (nat.le_succ i) (this _) },
-      { exact (hf.integrable _).integrable_on },
-      { exact (hf.integrable _).integrable_on } },
-    intros i hi,
-    exact integrable.indicator (integrable.sub (hf.integrable _) (hf.integrable _))
-      (𝒢.le _ _ (this _)) },
-  { exact hf.integrable_stopped_value hπ hbdd },
-  { exact hf.integrable_stopped_value hτ (λ x, le_trans (hle x) (hbdd x)) }
-end
-
-end submartingale
-
-/-- The converse direction of the optional stopping theorem, i.e. an adapted integrable process `f`
-is a submartingale if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
-stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
-lemma submartingale_of_expected_stopped_value_mono [is_finite_measure μ]
-  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
-  (hf : ∀ τ π : α → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ x, π x ≤ N) →
-    μ[stopped_value f τ] ≤ μ[stopped_value f π]) :
-  submartingale f 𝒢 μ :=
-begin
-  refine submartingale_of_set_integral_le hadp hint (λ i j hij s hs, _),
-  classical,
-  specialize hf (s.piecewise (λ _, i) (λ _, j)) _
-    (is_stopping_time_piecewise_const hij hs)
-    (is_stopping_time_const 𝒢 j) (λ x, (ite_le_sup _ _ _).trans (max_eq_right hij).le)
-    ⟨j, λ x, le_rfl⟩,
-  rwa [stopped_value_const, stopped_value_piecewise_const,
-    integral_piecewise (𝒢.le _ _ hs) (hint _).integrable_on (hint _).integrable_on,
-    ← integral_add_compl (𝒢.le _ _ hs) (hint j), add_le_add_iff_right] at hf,
-end
-
-/-- **The optional stopping theorem** (fair game theorem): an adapted integrable process `f`
-is a submartingale if and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
-stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
-lemma submartingale_iff_expected_stopped_value_mono [is_finite_measure μ]
-  {f : ℕ → α → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ) :
-  submartingale f 𝒢 μ ↔
-  ∀ τ π : α → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ x, π x ≤ N) →
-    μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
-⟨λ hf _ _ hτ hπ hle ⟨N, hN⟩, hf.expected_stopped_value_mono hτ hπ hle hN,
- submartingale_of_expected_stopped_value_mono hadp hint⟩
-
-end nat
-
-end measure_theory
diff --git a/src/probability/martingale/basic.lean b/src/probability/martingale/basic.lean
new file mode 100644
index 0000000000000..e4cb7613f4d6f
--- /dev/null
+++ b/src/probability/martingale/basic.lean
@@ -0,0 +1,582 @@
+/-
+Copyright (c) 2021 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne, Kexing Ying
+-/
+import probability.notation
+import probability.process.stopping
+
+/-!
+# Martingales
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A family of functions `f : ι → Ω → E` is a martingale with respect to a filtration `ℱ` if every
+`f i` is integrable, `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
+`μ[f j | ℱ i] =ᵐ[μ] f i`. On the other hand, `f : ι → Ω → E` is said to be a supermartingale
+with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with resepct to `ℱ`
+and for all `i ≤ j`, `μ[f j | ℱ i] ≤ᵐ[μ] f i`. Finally, `f : ι → Ω → E` is said to be a
+submartingale with respect to the filtration `ℱ` if `f i` is integrable, `f` is adapted with
+resepct to `ℱ` and for all `i ≤ j`, `f i ≤ᵐ[μ] μ[f j | ℱ i]`.
+
+The definitions of filtration and adapted can be found in `probability.stopping`.
+
+### Definitions
+
+* `measure_theory.martingale f ℱ μ`: `f` is a martingale with respect to filtration `ℱ` and
+  measure `μ`.
+* `measure_theory.supermartingale f ℱ μ`: `f` is a supermartingale with respect to
+  filtration `ℱ` and measure `μ`.
+* `measure_theory.submartingale f ℱ μ`: `f` is a submartingale with respect to filtration `ℱ` and
+  measure `μ`.
+
+### Results
+
+* `measure_theory.martingale_condexp f ℱ μ`: the sequence `λ i, μ[f | ℱ i, ℱ.le i])` is a
+  martingale with respect to `ℱ` and `μ`.
+
+-/
+
+open topological_space filter
+open_locale nnreal ennreal measure_theory probability_theory big_operators
+
+namespace measure_theory
+
+variables {Ω E ι : Type*} [preorder ι]
+  {m0 : measurable_space Ω} {μ : measure Ω}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  {f g : ι → Ω → E} {ℱ : filtration ι m0}
+
+/-- A family of functions `f : ι → Ω → E` is a martingale with respect to a filtration `ℱ` if `f`
+is adapted with respect to `ℱ` and for all `i ≤ j`, `μ[f j | ℱ i] =ᵐ[μ] f i`. -/
+def martingale (f : ι → Ω → E) (ℱ : filtration ι m0) (μ : measure Ω . volume_tac) : Prop :=
+adapted ℱ f ∧ ∀ i j, i ≤ j → μ[f j | ℱ i] =ᵐ[μ] f i
+
+/-- A family of integrable functions `f : ι → Ω → E` is a supermartingale with respect to a
+filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
+`μ[f j | ℱ.le i] ≤ᵐ[μ] f i`. -/
+def supermartingale [has_le E] (f : ι → Ω → E) (ℱ : filtration ι m0) (μ : measure Ω . volume_tac) :
+  Prop :=
+adapted ℱ f ∧ (∀ i j, i ≤ j → μ[f j | ℱ i] ≤ᵐ[μ] f i) ∧ ∀ i, integrable (f i) μ
+
+/-- A family of integrable functions `f : ι → Ω → E` is a submartingale with respect to a
+filtration `ℱ` if `f` is adapted with respect to `ℱ` and for all `i ≤ j`,
+`f i ≤ᵐ[μ] μ[f j | ℱ.le i]`. -/
+def submartingale [has_le E] (f : ι → Ω → E) (ℱ : filtration ι m0) (μ : measure Ω . volume_tac) :
+  Prop :=
+adapted ℱ f ∧ (∀ i j, i ≤ j → f i ≤ᵐ[μ] μ[f j | ℱ i]) ∧ ∀ i, integrable (f i) μ
+
+lemma martingale_const (ℱ : filtration ι m0) (μ : measure Ω) [is_finite_measure μ] (x : E) :
+  martingale (λ _ _, x) ℱ μ :=
+⟨adapted_const ℱ _, λ i j hij, by rw condexp_const (ℱ.le _)⟩
+
+lemma martingale_const_fun [order_bot ι]
+  (ℱ : filtration ι m0) (μ : measure Ω) [is_finite_measure μ]
+  {f : Ω → E} (hf : strongly_measurable[ℱ ⊥] f) (hfint : integrable f μ) :
+  martingale (λ _, f) ℱ μ :=
+begin
+  refine ⟨λ i, hf.mono $ ℱ.mono bot_le, λ i j hij, _⟩,
+  rw condexp_of_strongly_measurable (ℱ.le _) (hf.mono $ ℱ.mono bot_le) hfint,
+  apply_instance,
+end
+
+variables (E)
+lemma martingale_zero (ℱ : filtration ι m0) (μ : measure Ω) :
+  martingale (0 : ι → Ω → E) ℱ μ :=
+⟨adapted_zero E ℱ, λ i j hij, by { rw [pi.zero_apply, condexp_zero], simp, }⟩
+variables {E}
+
+namespace martingale
+
+@[protected]
+lemma adapted (hf : martingale f ℱ μ) : adapted ℱ f := hf.1
+
+@[protected]
+lemma strongly_measurable (hf : martingale f ℱ μ) (i : ι) : strongly_measurable[ℱ i] (f i) :=
+hf.adapted i
+
+lemma condexp_ae_eq (hf : martingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
+  μ[f j | ℱ i] =ᵐ[μ] f i :=
+hf.2 i j hij
+
+@[protected]
+lemma integrable (hf : martingale f ℱ μ) (i : ι) : integrable (f i) μ :=
+integrable_condexp.congr (hf.condexp_ae_eq (le_refl i))
+
+lemma set_integral_eq [sigma_finite_filtration μ ℱ] (hf : martingale f ℱ μ) {i j : ι} (hij : i ≤ j)
+  {s : set Ω} (hs : measurable_set[ℱ i] s) :
+  ∫ ω in s, f i ω ∂μ = ∫ ω in s, f j ω ∂μ :=
+begin
+  rw ← @set_integral_condexp _ _ _ _ _ (ℱ i) m0 _ _ _ (ℱ.le i) _ (hf.integrable j) hs,
+  refine set_integral_congr_ae (ℱ.le i s hs) _,
+  filter_upwards [hf.2 i j hij] with _ heq _ using heq.symm,
+end
+
+lemma add (hf : martingale f ℱ μ) (hg : martingale g ℱ μ) : martingale (f + g) ℱ μ :=
+begin
+  refine ⟨hf.adapted.add hg.adapted, λ i j hij, _⟩,
+  exact (condexp_add (hf.integrable j) (hg.integrable j)).trans
+    ((hf.2 i j hij).add (hg.2 i j hij)),
+end
+
+lemma neg (hf : martingale f ℱ μ) : martingale (-f) ℱ μ :=
+⟨hf.adapted.neg, λ i j hij, (condexp_neg (f j)).trans ((hf.2 i j hij).neg)⟩
+
+lemma sub (hf : martingale f ℱ μ) (hg : martingale g ℱ μ) : martingale (f - g) ℱ μ :=
+by { rw sub_eq_add_neg, exact hf.add hg.neg, }
+
+lemma smul (c : ℝ) (hf : martingale f ℱ μ) : martingale (c • f) ℱ μ :=
+begin
+  refine ⟨hf.adapted.smul c, λ i j hij, _⟩,
+  refine (condexp_smul c (f j)).trans ((hf.2 i j hij).mono (λ x hx, _)),
+  rw [pi.smul_apply, hx, pi.smul_apply, pi.smul_apply],
+end
+
+lemma supermartingale [preorder E] (hf : martingale f ℱ μ) : supermartingale f ℱ μ :=
+⟨hf.1, λ i j hij, (hf.2 i j hij).le, λ i, hf.integrable i⟩
+
+lemma submartingale [preorder E] (hf : martingale f ℱ μ) : submartingale f ℱ μ :=
+⟨hf.1, λ i j hij, (hf.2 i j hij).symm.le, λ i, hf.integrable i⟩
+
+end martingale
+
+lemma martingale_iff [partial_order E] : martingale f ℱ μ ↔
+  supermartingale f ℱ μ ∧ submartingale f ℱ μ :=
+⟨λ hf, ⟨hf.supermartingale, hf.submartingale⟩,
+ λ ⟨hf₁, hf₂⟩, ⟨hf₁.1, λ i j hij, (hf₁.2.1 i j hij).antisymm (hf₂.2.1 i j hij)⟩⟩
+
+lemma martingale_condexp (f : Ω → E) (ℱ : filtration ι m0) (μ : measure Ω)
+  [sigma_finite_filtration μ ℱ] :
+  martingale (λ i, μ[f | ℱ i]) ℱ μ :=
+⟨λ i, strongly_measurable_condexp, λ i j hij, condexp_condexp_of_le (ℱ.mono hij) (ℱ.le j)⟩
+
+namespace supermartingale
+
+@[protected]
+lemma adapted [has_le E] (hf : supermartingale f ℱ μ) : adapted ℱ f := hf.1
+
+@[protected]
+lemma strongly_measurable [has_le E] (hf : supermartingale f ℱ μ) (i : ι) :
+  strongly_measurable[ℱ i] (f i) :=
+hf.adapted i
+
+@[protected]
+lemma integrable [has_le E] (hf : supermartingale f ℱ μ) (i : ι) : integrable (f i) μ := hf.2.2 i
+
+lemma condexp_ae_le [has_le E] (hf : supermartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
+  μ[f j | ℱ i] ≤ᵐ[μ] f i :=
+hf.2.1 i j hij
+
+lemma set_integral_le [sigma_finite_filtration μ ℱ] {f : ι → Ω → ℝ} (hf : supermartingale f ℱ μ)
+  {i j : ι} (hij : i ≤ j) {s : set Ω} (hs : measurable_set[ℱ i] s) :
+  ∫ ω in s, f j ω ∂μ ≤ ∫ ω in s, f i ω ∂μ :=
+begin
+  rw ← set_integral_condexp (ℱ.le i) (hf.integrable j) hs,
+  refine set_integral_mono_ae integrable_condexp.integrable_on (hf.integrable i).integrable_on _,
+  filter_upwards [hf.2.1 i j hij] with _ heq using heq,
+end
+
+lemma add [preorder E] [covariant_class E E (+) (≤)]
+  (hf : supermartingale f ℱ μ) (hg : supermartingale g ℱ μ) : supermartingale (f + g) ℱ μ :=
+begin
+  refine ⟨hf.1.add hg.1, λ i j hij, _, λ i, (hf.2.2 i).add (hg.2.2 i)⟩,
+  refine (condexp_add (hf.integrable j) (hg.integrable j)).le.trans _,
+  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij],
+  intros,
+  refine add_le_add _ _; assumption,
+end
+
+lemma add_martingale [preorder E] [covariant_class E E (+) (≤)]
+  (hf : supermartingale f ℱ μ) (hg : martingale g ℱ μ) : supermartingale (f + g) ℱ μ :=
+hf.add hg.supermartingale
+
+lemma neg [preorder E] [covariant_class E E (+) (≤)]
+  (hf : supermartingale f ℱ μ) : submartingale (-f) ℱ μ :=
+begin
+  refine ⟨hf.1.neg, λ i j hij, _, λ i, (hf.2.2 i).neg⟩,
+  refine eventually_le.trans _ (condexp_neg (f j)).symm.le,
+  filter_upwards [hf.2.1 i j hij] with _ _,
+  simpa,
+end
+
+end supermartingale
+
+namespace submartingale
+
+@[protected]
+lemma adapted [has_le E] (hf : submartingale f ℱ μ) : adapted ℱ f := hf.1
+
+@[protected]
+lemma strongly_measurable [has_le E] (hf : submartingale f ℱ μ) (i : ι) :
+  strongly_measurable[ℱ i] (f i) :=
+hf.adapted i
+
+@[protected]
+lemma integrable [has_le E] (hf : submartingale f ℱ μ) (i : ι) : integrable (f i) μ := hf.2.2 i
+
+lemma ae_le_condexp [has_le E] (hf : submartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
+  f i ≤ᵐ[μ] μ[f j | ℱ i] :=
+hf.2.1 i j hij
+
+lemma add [preorder E] [covariant_class E E (+) (≤)]
+  (hf : submartingale f ℱ μ) (hg : submartingale g ℱ μ) : submartingale (f + g) ℱ μ :=
+begin
+  refine ⟨hf.1.add hg.1, λ i j hij, _, λ i, (hf.2.2 i).add (hg.2.2 i)⟩,
+  refine eventually_le.trans _ (condexp_add (hf.integrable j) (hg.integrable j)).symm.le,
+  filter_upwards [hf.2.1 i j hij, hg.2.1 i j hij],
+  intros,
+  refine add_le_add _ _; assumption,
+end
+
+lemma add_martingale [preorder E] [covariant_class E E (+) (≤)]
+  (hf : submartingale f ℱ μ) (hg : martingale g ℱ μ) : submartingale (f + g) ℱ μ :=
+hf.add hg.submartingale
+
+lemma neg [preorder E] [covariant_class E E (+) (≤)]
+  (hf : submartingale f ℱ μ) : supermartingale (-f) ℱ μ :=
+begin
+  refine ⟨hf.1.neg, λ i j hij, (condexp_neg (f j)).le.trans _, λ i, (hf.2.2 i).neg⟩,
+  filter_upwards [hf.2.1 i j hij] with _ _,
+  simpa,
+end
+
+/-- The converse of this lemma is `measure_theory.submartingale_of_set_integral_le`. -/
+lemma set_integral_le [sigma_finite_filtration μ ℱ] {f : ι → Ω → ℝ} (hf : submartingale f ℱ μ)
+  {i j : ι} (hij : i ≤ j) {s : set Ω} (hs : measurable_set[ℱ i] s) :
+  ∫ ω in s, f i ω ∂μ ≤ ∫ ω in s, f j ω ∂μ :=
+begin
+  rw [← neg_le_neg_iff, ← integral_neg, ← integral_neg],
+  exact supermartingale.set_integral_le hf.neg hij hs,
+end
+
+lemma sub_supermartingale [preorder E] [covariant_class E E (+) (≤)]
+  (hf : submartingale f ℱ μ) (hg : supermartingale g ℱ μ) : submartingale (f - g) ℱ μ :=
+by { rw sub_eq_add_neg, exact hf.add hg.neg }
+
+lemma sub_martingale [preorder E] [covariant_class E E (+) (≤)]
+  (hf : submartingale f ℱ μ) (hg : martingale g ℱ μ) : submartingale (f - g) ℱ μ :=
+hf.sub_supermartingale hg.supermartingale
+
+protected lemma sup {f g : ι → Ω → ℝ} (hf : submartingale f ℱ μ) (hg : submartingale g ℱ μ) :
+  submartingale (f ⊔ g) ℱ μ :=
+begin
+  refine ⟨λ i, @strongly_measurable.sup _ _ _ _ (ℱ i) _ _ _ (hf.adapted i) (hg.adapted i),
+    λ i j hij, _, λ i, integrable.sup (hf.integrable _) (hg.integrable _)⟩,
+  refine eventually_le.sup_le _ _,
+  { exact eventually_le.trans (hf.2.1 i j hij)
+      (condexp_mono (hf.integrable _) (integrable.sup (hf.integrable j) (hg.integrable j))
+      (eventually_of_forall (λ x, le_max_left _ _))) },
+  { exact eventually_le.trans (hg.2.1 i j hij)
+      (condexp_mono (hg.integrable _) (integrable.sup (hf.integrable j) (hg.integrable j))
+      (eventually_of_forall (λ x, le_max_right _ _))) }
+end
+
+protected lemma pos {f : ι → Ω → ℝ} (hf : submartingale f ℱ μ) :
+  submartingale (f⁺) ℱ μ :=
+hf.sup (martingale_zero _ _ _).submartingale
+
+end submartingale
+
+section submartingale
+
+lemma submartingale_of_set_integral_le [is_finite_measure μ]
+  {f : ι → Ω → ℝ} (hadp : adapted ℱ f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i j : ι, i ≤ j → ∀ s : set Ω, measurable_set[ℱ i] s →
+    ∫ ω in s, f i ω ∂μ ≤ ∫ ω in s, f j ω ∂μ) :
+  submartingale f ℱ μ :=
+begin
+  refine ⟨hadp, λ i j hij, _, hint⟩,
+  suffices : f i ≤ᵐ[μ.trim (ℱ.le i)] μ[f j| ℱ i],
+  { exact ae_le_of_ae_le_trim this },
+  suffices : 0 ≤ᵐ[μ.trim (ℱ.le i)] μ[f j| ℱ i] - f i,
+  { filter_upwards [this] with x hx,
+    rwa ← sub_nonneg },
+  refine ae_nonneg_of_forall_set_integral_nonneg
+    ((integrable_condexp.sub (hint i)).trim _ (strongly_measurable_condexp.sub $ hadp i))
+    (λ s hs h's, _),
+  specialize hf i j hij s hs,
+  rwa [← set_integral_trim _ (strongly_measurable_condexp.sub $ hadp i) hs,
+    integral_sub' integrable_condexp.integrable_on (hint i).integrable_on, sub_nonneg,
+    set_integral_condexp (ℱ.le i) (hint j) hs],
+end
+
+lemma submartingale_of_condexp_sub_nonneg [is_finite_measure μ]
+  {f : ι → Ω → ℝ} (hadp : adapted ℱ f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i j, i ≤ j → 0 ≤ᵐ[μ] μ[f j - f i | ℱ i]) :
+  submartingale f ℱ μ :=
+begin
+  refine ⟨hadp, λ i j hij, _, hint⟩,
+  rw [← condexp_of_strongly_measurable (ℱ.le _) (hadp _) (hint _), ← eventually_sub_nonneg],
+  exact eventually_le.trans (hf i j hij) (condexp_sub (hint _) (hint _)).le,
+  apply_instance
+end
+
+lemma submartingale.condexp_sub_nonneg
+  {f : ι → Ω → ℝ} (hf : submartingale f ℱ μ) {i j : ι} (hij : i ≤ j) :
+  0 ≤ᵐ[μ] μ[f j - f i | ℱ i] :=
+begin
+  by_cases h : sigma_finite (μ.trim (ℱ.le i)),
+  swap, { rw condexp_of_not_sigma_finite (ℱ.le i) h },
+  refine eventually_le.trans _ (condexp_sub (hf.integrable _) (hf.integrable _)).symm.le,
+  rw [eventually_sub_nonneg,
+    condexp_of_strongly_measurable (ℱ.le _) (hf.adapted _) (hf.integrable _)],
+  { exact hf.2.1 i j hij },
+  { exact h }
+end
+
+lemma submartingale_iff_condexp_sub_nonneg [is_finite_measure μ] {f : ι → Ω → ℝ} :
+  submartingale f ℱ μ ↔ adapted ℱ f ∧ (∀ i, integrable (f i) μ) ∧ ∀ i j, i ≤ j →
+  0 ≤ᵐ[μ] μ[f j - f i | ℱ i] :=
+⟨λ h, ⟨h.adapted, h.integrable, λ i j, h.condexp_sub_nonneg⟩,
+ λ ⟨hadp, hint, h⟩, submartingale_of_condexp_sub_nonneg hadp hint h⟩
+
+end submartingale
+
+namespace supermartingale
+
+lemma sub_submartingale [preorder E] [covariant_class E E (+) (≤)]
+  (hf : supermartingale f ℱ μ) (hg : submartingale g ℱ μ) : supermartingale (f - g) ℱ μ :=
+by { rw sub_eq_add_neg, exact hf.add hg.neg }
+
+lemma sub_martingale [preorder E] [covariant_class E E (+) (≤)]
+  (hf : supermartingale f ℱ μ) (hg : martingale g ℱ μ) : supermartingale (f - g) ℱ μ :=
+hf.sub_submartingale hg.submartingale
+
+section
+
+variables {F : Type*} [normed_lattice_add_comm_group F]
+  [normed_space ℝ F] [complete_space F] [ordered_smul ℝ F]
+
+lemma smul_nonneg {f : ι → Ω → F}
+  {c : ℝ} (hc : 0 ≤ c) (hf : supermartingale f ℱ μ) :
+  supermartingale (c • f) ℱ μ :=
+begin
+  refine ⟨hf.1.smul c, λ i j hij, _, λ i, (hf.2.2 i).smul c⟩,
+  refine (condexp_smul c (f j)).le.trans _,
+  filter_upwards [hf.2.1 i j hij] with _ hle,
+  simp_rw [pi.smul_apply],
+  exact smul_le_smul_of_nonneg hle hc,
+end
+
+lemma smul_nonpos {f : ι → Ω → F}
+  {c : ℝ} (hc : c ≤ 0) (hf : supermartingale f ℱ μ) :
+  submartingale (c • f) ℱ μ :=
+begin
+  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(-c • f))],
+  exact (hf.smul_nonneg $ neg_nonneg.2 hc).neg,
+end
+
+end
+
+end supermartingale
+
+namespace submartingale
+
+section
+
+variables {F : Type*} [normed_lattice_add_comm_group F]
+  [normed_space ℝ F] [complete_space F] [ordered_smul ℝ F]
+
+lemma smul_nonneg {f : ι → Ω → F}
+  {c : ℝ} (hc : 0 ≤ c) (hf : submartingale f ℱ μ) :
+  submartingale (c • f) ℱ μ :=
+begin
+  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(c • -f))],
+  exact supermartingale.neg (hf.neg.smul_nonneg hc),
+end
+
+lemma smul_nonpos {f : ι → Ω → F}
+  {c : ℝ} (hc : c ≤ 0) (hf : submartingale f ℱ μ) :
+  supermartingale (c • f) ℱ μ :=
+begin
+  rw [← neg_neg c, (by { ext i x, simp } : - -c • f = -(-c • f))],
+  exact (hf.smul_nonneg $ neg_nonneg.2 hc).neg,
+end
+
+end
+
+end submartingale
+
+section nat
+
+variables {𝒢 : filtration ℕ m0}
+
+lemma submartingale_of_set_integral_le_succ [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, ∀ s : set Ω, measurable_set[𝒢 i] s → ∫ ω in s, f i ω ∂μ ≤ ∫ ω in s, f (i + 1) ω ∂μ) :
+  submartingale f 𝒢 μ :=
+begin
+  refine submartingale_of_set_integral_le hadp hint (λ i j hij s hs, _),
+  induction hij with k hk₁ hk₂,
+  { exact le_rfl },
+  { exact le_trans hk₂ (hf k s (𝒢.mono hk₁ _ hs)) }
+end
+
+lemma supermartingale_of_set_integral_succ_le [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, ∀ s : set Ω, measurable_set[𝒢 i] s → ∫ ω in s, f (i + 1) ω ∂μ ≤ ∫ ω in s, f i ω ∂μ) :
+  supermartingale f 𝒢 μ :=
+begin
+  rw ← neg_neg f,
+  refine (submartingale_of_set_integral_le_succ hadp.neg (λ i, (hint i).neg) _).neg,
+  simpa only [integral_neg, pi.neg_apply, neg_le_neg_iff],
+end
+
+lemma martingale_of_set_integral_eq_succ [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, ∀ s : set Ω, measurable_set[𝒢 i] s → ∫ ω in s, f i ω ∂μ = ∫ ω in s, f (i + 1) ω ∂μ) :
+  martingale f 𝒢 μ :=
+martingale_iff.2
+  ⟨supermartingale_of_set_integral_succ_le hadp hint $ λ i s hs, (hf i s hs).ge,
+   submartingale_of_set_integral_le_succ hadp hint $ λ i s hs, (hf i s hs).le⟩
+
+lemma submartingale_nat [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, f i ≤ᵐ[μ] μ[f (i + 1) | 𝒢 i]) :
+  submartingale f 𝒢 μ :=
+begin
+  refine submartingale_of_set_integral_le_succ hadp hint (λ i s hs, _),
+  have : ∫ ω in s, f (i + 1) ω ∂μ = ∫ ω in s, μ[f (i + 1)|𝒢 i] ω ∂μ :=
+    (set_integral_condexp (𝒢.le i) (hint _) hs).symm,
+  rw this,
+  exact set_integral_mono_ae (hint i).integrable_on integrable_condexp.integrable_on (hf i),
+end
+
+lemma supermartingale_nat [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, μ[f (i + 1) | 𝒢 i] ≤ᵐ[μ] f i) :
+  supermartingale f 𝒢 μ :=
+begin
+  rw ← neg_neg f,
+  refine (submartingale_nat hadp.neg (λ i, (hint i).neg) $ λ i,
+    eventually_le.trans _ (condexp_neg _).symm.le).neg,
+  filter_upwards [hf i] with x hx using neg_le_neg hx,
+end
+
+lemma martingale_nat [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, f i =ᵐ[μ] μ[f (i + 1) | 𝒢 i]) :
+  martingale f 𝒢 μ :=
+martingale_iff.2 ⟨supermartingale_nat hadp hint $ λ i, (hf i).symm.le,
+  submartingale_nat hadp hint $ λ i, (hf i).le⟩
+
+lemma submartingale_of_condexp_sub_nonneg_nat [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, 0 ≤ᵐ[μ] μ[f (i + 1) - f i | 𝒢 i]) :
+  submartingale f 𝒢 μ :=
+begin
+  refine submartingale_nat hadp hint (λ i, _),
+  rw [← condexp_of_strongly_measurable (𝒢.le _) (hadp _) (hint _), ← eventually_sub_nonneg],
+  exact eventually_le.trans (hf i) (condexp_sub (hint _) (hint _)).le,
+  apply_instance
+end
+
+lemma supermartingale_of_condexp_sub_nonneg_nat [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, 0 ≤ᵐ[μ] μ[f i - f (i + 1) | 𝒢 i]) :
+  supermartingale f 𝒢 μ :=
+begin
+  rw ← neg_neg f,
+  refine (submartingale_of_condexp_sub_nonneg_nat hadp.neg (λ i, (hint i).neg) _).neg,
+  simpa only [pi.zero_apply, pi.neg_apply, neg_sub_neg]
+end
+
+lemma martingale_of_condexp_sub_eq_zero_nat [is_finite_measure μ]
+  {f : ℕ → Ω → ℝ} (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ i, μ[f (i + 1) - f i | 𝒢 i] =ᵐ[μ] 0) :
+  martingale f 𝒢 μ :=
+begin
+  refine martingale_iff.2 ⟨supermartingale_of_condexp_sub_nonneg_nat hadp hint $ λ i, _,
+    submartingale_of_condexp_sub_nonneg_nat hadp hint $ λ i, (hf i).symm.le⟩,
+  rw ← neg_sub,
+  refine (eventually_eq.trans _ (condexp_neg _).symm).le,
+  filter_upwards [hf i] with x hx,
+  simpa only [pi.zero_apply, pi.neg_apply, zero_eq_neg],
+end
+
+-- Note that one cannot use `submartingale.zero_le_of_predictable` to prove the other two
+-- corresponding lemmas without imposing more restrictions to the ordering of `E`
+/-- A predictable submartingale is a.e. greater equal than its initial state. -/
+lemma submartingale.zero_le_of_predictable [preorder E] [sigma_finite_filtration μ 𝒢]
+  {f : ℕ → Ω → E} (hfmgle : submartingale f 𝒢 μ) (hfadp : adapted 𝒢 (λ n, f (n + 1))) (n : ℕ) :
+  f 0 ≤ᵐ[μ] f n :=
+begin
+  induction n with k ih,
+  { refl },
+  { exact ih.trans ((hfmgle.2.1 k (k + 1) k.le_succ).trans_eq $ germ.coe_eq.mp $ congr_arg coe $
+      condexp_of_strongly_measurable (𝒢.le _) (hfadp _) $ hfmgle.integrable _) }
+end
+
+/-- A predictable supermartingale is a.e. less equal than its initial state. -/
+lemma supermartingale.le_zero_of_predictable [preorder E] [sigma_finite_filtration μ 𝒢]
+  {f : ℕ → Ω → E} (hfmgle : supermartingale f 𝒢 μ) (hfadp : adapted 𝒢 (λ n, f (n + 1))) (n : ℕ) :
+  f n ≤ᵐ[μ] f 0 :=
+begin
+  induction n with k ih,
+  { refl },
+  { exact ((germ.coe_eq.mp $ congr_arg coe $ condexp_of_strongly_measurable (𝒢.le _) (hfadp _) $
+      hfmgle.integrable _).symm.trans_le (hfmgle.2.1 k (k + 1) k.le_succ)).trans ih }
+end
+
+/-- A predictable martingale is a.e. equal to its initial state. -/
+lemma martingale.eq_zero_of_predictable [sigma_finite_filtration μ 𝒢]
+  {f : ℕ → Ω → E} (hfmgle : martingale f 𝒢 μ) (hfadp : adapted 𝒢 (λ n, f (n + 1))) (n : ℕ) :
+  f n =ᵐ[μ] f 0 :=
+begin
+  induction n with k ih,
+  { refl },
+  { exact ((germ.coe_eq.mp (congr_arg coe $ condexp_of_strongly_measurable (𝒢.le _) (hfadp _)
+      (hfmgle.integrable _))).symm.trans (hfmgle.2 k (k + 1) k.le_succ)).trans ih }
+end
+
+namespace submartingale
+
+@[protected]
+lemma integrable_stopped_value [has_le E] {f : ℕ → Ω → E} (hf : submartingale f 𝒢 μ) {τ : Ω → ℕ}
+  (hτ : is_stopping_time 𝒢 τ) {N : ℕ} (hbdd : ∀ ω, τ ω ≤ N) :
+  integrable (stopped_value f τ) μ :=
+integrable_stopped_value ℕ hτ hf.integrable hbdd
+
+end submartingale
+
+lemma submartingale.sum_mul_sub [is_finite_measure μ] {R : ℝ} {ξ f : ℕ → Ω → ℝ}
+  (hf : submartingale f 𝒢 μ) (hξ : adapted 𝒢 ξ)
+  (hbdd : ∀ n ω, ξ n ω ≤ R) (hnonneg : ∀ n ω, 0 ≤ ξ n ω) :
+  submartingale (λ n, ∑ k in finset.range n, ξ k * (f (k + 1) - f k)) 𝒢 μ :=
+begin
+  have hξbdd : ∀ i, ∃ C, ∀ ω, |ξ i ω| ≤ C :=
+    λ i, ⟨R, λ ω, (abs_of_nonneg (hnonneg i ω)).trans_le (hbdd i ω)⟩,
+  have hint : ∀ m, integrable (∑ k in finset.range m, ξ k * (f (k + 1) - f k)) μ :=
+    λ m, integrable_finset_sum' _
+      (λ i hi, integrable.bdd_mul ((hf.integrable _).sub (hf.integrable _))
+      hξ.strongly_measurable.ae_strongly_measurable (hξbdd _)),
+  have hadp : adapted 𝒢 (λ n, ∑ k in finset.range n, ξ k * (f (k + 1) - f k)),
+  { intro m,
+    refine finset.strongly_measurable_sum' _ (λ i hi, _),
+    rw finset.mem_range at hi,
+    exact (hξ.strongly_measurable_le hi.le).mul
+      ((hf.adapted.strongly_measurable_le (nat.succ_le_of_lt hi)).sub
+      (hf.adapted.strongly_measurable_le hi.le)) },
+  refine submartingale_of_condexp_sub_nonneg_nat hadp hint (λ i, _),
+  simp only [← finset.sum_Ico_eq_sub _ (nat.le_succ _), finset.sum_apply, pi.mul_apply,
+    pi.sub_apply, nat.Ico_succ_singleton, finset.sum_singleton],
+  exact eventually_le.trans (eventually_le.mul_nonneg (eventually_of_forall (hnonneg _))
+    (hf.condexp_sub_nonneg (nat.le_succ _))) (condexp_strongly_measurable_mul (hξ _)
+    (((hf.integrable _).sub (hf.integrable _)).bdd_mul
+      hξ.strongly_measurable.ae_strongly_measurable (hξbdd _))
+    ((hf.integrable _).sub (hf.integrable _))).symm.le,
+end
+
+/-- Given a discrete submartingale `f` and a predictable process `ξ` (i.e. `ξ (n + 1)` is adapted)
+the process defined by `λ n, ∑ k in finset.range n, ξ (k + 1) * (f (k + 1) - f k)` is also a
+submartingale. -/
+lemma submartingale.sum_mul_sub' [is_finite_measure μ] {R : ℝ} {ξ f : ℕ → Ω → ℝ}
+  (hf : submartingale f 𝒢 μ) (hξ : adapted 𝒢 (λ n, ξ (n + 1)))
+  (hbdd : ∀ n ω, ξ n ω ≤ R) (hnonneg : ∀ n ω, 0 ≤ ξ n ω) :
+  submartingale (λ n, ∑ k in finset.range n, ξ (k + 1) * (f (k + 1) - f k)) 𝒢 μ :=
+hf.sum_mul_sub hξ (λ n, hbdd _) (λ n, hnonneg _)
+
+end nat
+
+end measure_theory
diff --git a/src/probability/martingale/borel_cantelli.lean b/src/probability/martingale/borel_cantelli.lean
new file mode 100644
index 0000000000000..4a97b49a346b9
--- /dev/null
+++ b/src/probability/martingale/borel_cantelli.lean
@@ -0,0 +1,396 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import probability.martingale.convergence
+import probability.martingale.optional_stopping
+import probability.martingale.centering
+
+/-!
+
+# Generalized Borel-Cantelli lemma
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves Lévy's generalized Borel-Cantelli lemma which is a generalization of the
+Borel-Cantelli lemmas. With this generalization, one can easily deduce the Borel-Cantelli lemmas
+by choosing appropriate filtrations. This file also contains the one sided martingale bound which
+is required to prove the generalized Borel-Cantelli.
+
+## Main results
+
+- `measure_theory.submartingale.bdd_above_iff_exists_tendsto`: the one sided martingale bound: given
+  a submartingale `f` with uniformly bounded differences, the set for which `f` converges is almost
+  everywhere equal to the set for which it is bounded.
+- `measure_theory.ae_mem_limsup_at_top_iff`: Lévy's generalized Borel-Cantelli:
+  given a filtration `ℱ` and a sequence of sets `s` such that `s n ∈ ℱ n` for all `n`,
+  `limsup at_top s` is almost everywhere equal to the set for which `∑ ℙ[s (n + 1)∣ℱ n] = ∞`.
+
+-/
+
+open filter
+open_locale nnreal ennreal measure_theory probability_theory big_operators topology
+
+namespace measure_theory
+
+variables {Ω : Type*} {m0 : measurable_space Ω} {μ : measure Ω}
+  {ℱ : filtration ℕ m0} {f : ℕ → Ω → ℝ} {ω : Ω}
+
+/-!
+### One sided martingale bound
+-/
+
+-- TODO: `least_ge` should be defined taking values in `with_top ℕ` once the `stopped_process`
+-- refactor is complete
+/-- `least_ge f r n` is the stopping time corresponding to the first time `f ≥ r`. -/
+noncomputable
+def least_ge (f : ℕ → Ω → ℝ) (r : ℝ) (n : ℕ) := hitting f (set.Ici r) 0 n
+
+lemma adapted.is_stopping_time_least_ge (r : ℝ) (n : ℕ) (hf : adapted ℱ f) :
+  is_stopping_time ℱ (least_ge f r n) :=
+hitting_is_stopping_time hf measurable_set_Ici
+
+lemma least_ge_le {i : ℕ} {r : ℝ} (ω : Ω) : least_ge f r i ω ≤ i :=
+hitting_le ω
+
+-- The following four lemmas shows `least_ge` behaves like a stopped process. Ideally we should
+-- define `least_ge` as a stopping time and take its stopped process. However, we can't do that
+-- with our current definition since a stopping time takes only finite indicies. An upcomming
+-- refactor should hopefully make it possible to have stopping times taking infinity as a value
+lemma least_ge_mono {n m : ℕ} (hnm : n ≤ m) (r : ℝ) (ω : Ω) :
+  least_ge f r n ω ≤ least_ge f r m ω :=
+hitting_mono hnm
+
+lemma least_ge_eq_min (π : Ω → ℕ) (r : ℝ) (ω : Ω)
+  {n : ℕ} (hπn : ∀ ω, π ω ≤ n) :
+  least_ge f r (π ω) ω = min (π ω) (least_ge f r n ω) :=
+begin
+  classical,
+  refine le_antisymm (le_min (least_ge_le _) (least_ge_mono (hπn ω) r ω)) _,
+  by_cases hle : π ω ≤ least_ge f r n ω,
+  { rw [min_eq_left hle, least_ge],
+    by_cases h : ∃ j ∈ set.Icc 0 (π ω), f j ω ∈ set.Ici r,
+    { refine hle.trans (eq.le _),
+      rw [least_ge, ← hitting_eq_hitting_of_exists (hπn ω) h] },
+    { simp only [hitting, if_neg h] } },
+  { rw [min_eq_right (not_le.1 hle).le, least_ge, least_ge,
+      ← hitting_eq_hitting_of_exists (hπn ω) _],
+    rw [not_le, least_ge, hitting_lt_iff _ (hπn ω)] at hle,
+    exact let ⟨j, hj₁, hj₂⟩ := hle in ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩ }
+end
+
+lemma stopped_value_stopped_value_least_ge (f : ℕ → Ω → ℝ) (π : Ω → ℕ) (r : ℝ)
+  {n : ℕ} (hπn : ∀ ω, π ω ≤ n) :
+  stopped_value (λ i, stopped_value f (least_ge f r i)) π
+    = stopped_value (stopped_process f (least_ge f r n)) π :=
+by { ext1 ω, simp_rw [stopped_process, stopped_value], rw least_ge_eq_min _ _ _ hπn, }
+
+lemma submartingale.stopped_value_least_ge [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (r : ℝ) :
+  submartingale (λ i, stopped_value f (least_ge f r i)) ℱ μ :=
+begin
+  rw submartingale_iff_expected_stopped_value_mono,
+  { intros σ π hσ hπ hσ_le_π hπ_bdd,
+    obtain ⟨n, hπ_le_n⟩ := hπ_bdd,
+    simp_rw stopped_value_stopped_value_least_ge f σ r (λ i, (hσ_le_π i).trans (hπ_le_n i)),
+    simp_rw stopped_value_stopped_value_least_ge f π r hπ_le_n,
+    refine hf.expected_stopped_value_mono _ _ _ (λ ω, (min_le_left _ _).trans (hπ_le_n ω)),
+    { exact hσ.min (hf.adapted.is_stopping_time_least_ge _ _), },
+    { exact hπ.min (hf.adapted.is_stopping_time_least_ge _ _), },
+    { exact λ ω, min_le_min (hσ_le_π ω) le_rfl, }, },
+  { exact λ i, strongly_measurable_stopped_value_of_le hf.adapted.prog_measurable_of_discrete
+      (hf.adapted.is_stopping_time_least_ge _ _) least_ge_le, },
+  { exact λ i, integrable_stopped_value _ ((hf.adapted.is_stopping_time_least_ge _ _))
+      (hf.integrable) least_ge_le, },
+end
+
+variables {r : ℝ} {R : ℝ≥0}
+
+lemma norm_stopped_value_least_ge_le (hr : 0 ≤ r) (hf0 : f 0 = 0)
+  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) (i : ℕ) :
+  ∀ᵐ ω ∂μ, stopped_value f (least_ge f r i) ω ≤ r + R :=
+begin
+  filter_upwards [hbdd] with ω hbddω,
+  change f (least_ge f r i ω) ω ≤ r + R,
+  by_cases heq : least_ge f r i ω = 0,
+  { rw [heq, hf0, pi.zero_apply],
+    exact add_nonneg hr R.coe_nonneg },
+  { obtain ⟨k, hk⟩ := nat.exists_eq_succ_of_ne_zero heq,
+    rw [hk, add_comm, ← sub_le_iff_le_add],
+    have := not_mem_of_lt_hitting (hk.symm ▸ k.lt_succ_self : k < least_ge f r i ω) (zero_le _),
+    simp only [set.mem_union, set.mem_Iic, set.mem_Ici, not_or_distrib, not_le] at this,
+    exact (sub_lt_sub_left this _).le.trans ((le_abs_self _).trans (hbddω _)) }
+end
+
+lemma submartingale.stopped_value_least_ge_snorm_le [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hr : 0 ≤ r) (hf0 : f 0 = 0)
+  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) (i : ℕ) :
+  snorm (stopped_value f (least_ge f r i)) 1 μ ≤ 2 * μ set.univ * ennreal.of_real (r + R) :=
+begin
+  refine snorm_one_le_of_le' ((hf.stopped_value_least_ge r).integrable _) _
+    (norm_stopped_value_least_ge_le hr hf0 hbdd i),
+  rw ← integral_univ,
+  refine le_trans _ ((hf.stopped_value_least_ge r).set_integral_le (zero_le _)
+    measurable_set.univ),
+  simp_rw [stopped_value, least_ge, hitting_of_le le_rfl, hf0, integral_zero']
+end
+
+lemma submartingale.stopped_value_least_ge_snorm_le' [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hr : 0 ≤ r) (hf0 : f 0 = 0)
+  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) (i : ℕ) :
+  snorm (stopped_value f (least_ge f r i)) 1 μ ≤
+    ennreal.to_nnreal (2 * μ set.univ * ennreal.of_real (r + R)) :=
+begin
+  refine (hf.stopped_value_least_ge_snorm_le hr hf0 hbdd i).trans _,
+  simp [ennreal.coe_to_nnreal (measure_ne_top μ _), ennreal.coe_to_nnreal],
+end
+
+/-- This lemma is superceded by `submartingale.bdd_above_iff_exists_tendsto`. -/
+lemma submartingale.exists_tendsto_of_abs_bdd_above_aux [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hf0 : f 0 = 0)
+  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, bdd_above (set.range $ λ n, f n ω) → ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
+begin
+  have ht : ∀ᵐ ω ∂μ, ∀ i : ℕ, ∃ c, tendsto (λ n, stopped_value f (least_ge f i n) ω) at_top (𝓝 c),
+  { rw ae_all_iff,
+    exact λ i, submartingale.exists_ae_tendsto_of_bdd (hf.stopped_value_least_ge i)
+      (hf.stopped_value_least_ge_snorm_le' i.cast_nonneg hf0 hbdd) },
+  filter_upwards [ht] with ω hω hωb,
+  rw bdd_above at hωb,
+  obtain ⟨i, hi⟩ := exists_nat_gt hωb.some,
+  have hib : ∀ n, f n ω < i,
+  { intro n,
+    exact lt_of_le_of_lt ((mem_upper_bounds.1 hωb.some_mem) _ ⟨n, rfl⟩) hi },
+  have heq : ∀ n, stopped_value f (least_ge f i n) ω = f n ω,
+  { intro n,
+    rw [least_ge, hitting, stopped_value],
+    simp only,
+    rw if_neg,
+    simp only [set.mem_Icc, set.mem_union, set.mem_Ici],
+    push_neg,
+    exact λ j _, hib j },
+  simp only [← heq, hω i],
+end
+
+lemma submartingale.bdd_above_iff_exists_tendsto_aux [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hf0 : f 0 = 0)
+  (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, bdd_above (set.range $ λ n, f n ω) ↔ ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
+by filter_upwards [hf.exists_tendsto_of_abs_bdd_above_aux hf0 hbdd] with ω hω using
+  ⟨hω, λ ⟨c, hc⟩, hc.bdd_above_range⟩
+
+/-- One sided martingale bound: If `f` is a submartingale which has uniformly bounded differences,
+then for almost every `ω`, `f n ω` is bounded above (in `n`) if and only if it converges. -/
+lemma submartingale.bdd_above_iff_exists_tendsto [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, bdd_above (set.range $ λ n, f n ω) ↔ ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
+begin
+  set g : ℕ → Ω → ℝ := λ n ω, f n ω - f 0 ω with hgdef,
+  have hg : submartingale g ℱ μ :=
+    hf.sub_martingale (martingale_const_fun _ _ (hf.adapted 0) (hf.integrable 0)),
+  have hg0 : g 0 = 0,
+  { ext ω,
+    simp only [hgdef, sub_self, pi.zero_apply] },
+  have hgbdd : ∀ᵐ ω ∂μ, ∀ (i : ℕ), |g (i + 1) ω - g i ω| ≤ ↑R,
+  { simpa only [sub_sub_sub_cancel_right] },
+  filter_upwards [hg.bdd_above_iff_exists_tendsto_aux hg0 hgbdd] with ω hω,
+  convert hω using 1; rw eq_iff_iff,
+  { simp only [hgdef],
+    refine ⟨λ h, _, λ h, _⟩;
+    obtain ⟨b, hb⟩ := h;
+    refine ⟨b + |f 0 ω|, λ y hy, _⟩;
+    obtain ⟨n, rfl⟩ := hy,
+    { simp_rw [sub_eq_add_neg],
+      exact add_le_add (hb ⟨n, rfl⟩) (neg_le_abs_self _) },
+    { exact sub_le_iff_le_add.1 (le_trans (sub_le_sub_left (le_abs_self _) _) (hb ⟨n, rfl⟩)) } },
+  { simp only [hgdef],
+    refine ⟨λ h, _, λ h, _⟩;
+    obtain ⟨c, hc⟩ := h,
+    { exact ⟨c - f 0 ω, hc.sub_const _⟩ },
+    { refine ⟨c + f 0 ω, _⟩,
+      have := hc.add_const (f 0 ω),
+      simpa only [sub_add_cancel] } }
+end
+
+/-!
+### Lévy's generalization of the Borel-Cantelli lemma
+
+Lévy's generalization of the Borel-Cantelli lemma states that: given a natural number indexed
+filtration $(\mathcal{F}_n)$, and a sequence of sets $(s_n)$ such that for all
+$n$, $s_n \in \mathcal{F}_n$, $limsup_n s_n$ is almost everywhere equal to the set for which
+$\sum_n \mathbb{P}[s_n \mid \mathcal{F}_n] = \infty$.
+
+The proof strategy follows by constructing a martingale satisfying the one sided martingale bound.
+In particular, we define
+$$
+  f_n := \sum_{k < n} \mathbf{1}_{s_{n + 1}} - \mathbb{P}[s_{n + 1} \mid \mathcal{F}_n].
+$$
+Then, as a martingale is both a sub and a super-martingale, the set for which it is unbounded from
+above must agree with the set for which it is unbounded from below almost everywhere. Thus, it
+can only converge to $\pm \infty$ with probability 0. Thus, by considering
+$$
+  \limsup_n s_n = \{\sum_n \mathbf{1}_{s_n} = \infty\}
+$$
+almost everywhere, the result follows.
+-/
+
+lemma martingale.bdd_above_range_iff_bdd_below_range [is_finite_measure μ]
+  (hf : martingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, bdd_above (set.range (λ n, f n ω)) ↔ bdd_below (set.range (λ n, f n ω)) :=
+begin
+  have hbdd' : ∀ᵐ ω ∂μ, ∀ i, |(-f) (i + 1) ω - (-f) i ω| ≤ R,
+  { filter_upwards [hbdd] with ω hω i,
+    erw [← abs_neg, neg_sub, sub_neg_eq_add, neg_add_eq_sub],
+    exact hω i },
+  have hup := hf.submartingale.bdd_above_iff_exists_tendsto hbdd,
+  have hdown := hf.neg.submartingale.bdd_above_iff_exists_tendsto hbdd',
+  filter_upwards [hup, hdown] with ω hω₁ hω₂,
+  have : (∃ c, tendsto (λ n, f n ω) at_top (𝓝 c)) ↔ ∃ c, tendsto (λ n, (-f) n ω) at_top (𝓝 c),
+  { split; rintro ⟨c, hc⟩,
+    { exact ⟨-c, hc.neg⟩ },
+    { refine ⟨-c, _⟩,
+      convert hc.neg,
+      simp only [neg_neg, pi.neg_apply] } },
+  rw [hω₁, this, ← hω₂],
+  split; rintro ⟨c, hc⟩; refine ⟨-c, λ ω hω, _⟩,
+  { rw mem_upper_bounds at hc,
+    refine neg_le.2 (hc _ _),
+    simpa only [pi.neg_apply, set.mem_range, neg_inj] },
+  { rw mem_lower_bounds at hc,
+    simp_rw [set.mem_range, pi.neg_apply, neg_eq_iff_eq_neg] at hω,
+    refine le_neg.1 (hc _ _),
+    simpa only [set.mem_range] }
+end
+
+lemma martingale.ae_not_tendsto_at_top_at_top [is_finite_measure μ]
+  (hf : martingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, ¬ tendsto (λ n, f n ω) at_top at_top :=
+by filter_upwards [hf.bdd_above_range_iff_bdd_below_range hbdd] with ω hω htop using
+    unbounded_of_tendsto_at_top htop (hω.2 $ bdd_below_range_of_tendsto_at_top_at_top htop)
+
+lemma martingale.ae_not_tendsto_at_top_at_bot [is_finite_measure μ]
+  (hf : martingale f ℱ μ) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, ¬ tendsto (λ n, f n ω) at_top at_bot :=
+by filter_upwards [hf.bdd_above_range_iff_bdd_below_range hbdd] with ω hω htop using
+    unbounded_of_tendsto_at_bot htop (hω.1 $ bdd_above_range_of_tendsto_at_top_at_bot htop)
+
+namespace borel_cantelli
+
+/-- Auxiliary definition required to prove Lévy's generalization of the Borel-Cantelli lemmas for
+which we will take the martingale part. -/
+noncomputable
+def process (s : ℕ → set Ω) (n : ℕ) : Ω → ℝ :=
+∑ k in finset.range n, (s (k + 1)).indicator 1
+
+variables {s : ℕ → set Ω}
+
+lemma process_zero : process s 0 = 0 :=
+by rw [process, finset.range_zero, finset.sum_empty]
+
+lemma adapted_process (hs : ∀ n, measurable_set[ℱ n] (s n)) :
+  adapted ℱ (process s) :=
+λ n, finset.strongly_measurable_sum' _ $ λ k hk, strongly_measurable_one.indicator $
+  ℱ.mono (finset.mem_range.1 hk) _ $ hs _
+
+lemma martingale_part_process_ae_eq (ℱ : filtration ℕ m0) (μ : measure Ω) (s : ℕ → set Ω) (n : ℕ) :
+  martingale_part (process s) ℱ μ n =
+  ∑ k in finset.range n, ((s (k + 1)).indicator 1 - μ[(s (k + 1)).indicator 1 | ℱ k]) :=
+begin
+  simp only [martingale_part_eq_sum, process_zero, zero_add],
+  refine finset.sum_congr rfl (λ k hk, _),
+  simp only [process, finset.sum_range_succ_sub_sum],
+end
+
+lemma predictable_part_process_ae_eq (ℱ : filtration ℕ m0) (μ : measure Ω) (s : ℕ → set Ω) (n : ℕ) :
+  predictable_part (process s) ℱ μ n =
+  ∑ k in finset.range n, μ[(s (k + 1)).indicator (1 : Ω → ℝ) | ℱ k] :=
+begin
+  have := martingale_part_process_ae_eq ℱ μ s n,
+  simp_rw [martingale_part, process, finset.sum_sub_distrib] at this,
+  exact sub_right_injective this,
+end
+
+lemma process_difference_le (s : ℕ → set Ω) (ω : Ω) (n : ℕ) :
+  |process s (n + 1) ω - process s n ω| ≤ (1 : ℝ≥0) :=
+begin
+  rw [nonneg.coe_one, process, process, finset.sum_apply, finset.sum_apply,
+    finset.sum_range_succ_sub_sum, ← real.norm_eq_abs, norm_indicator_eq_indicator_norm],
+  refine set.indicator_le' (λ _ _, _) (λ _ _, zero_le_one) _,
+  rw [pi.one_apply, norm_one]
+end
+
+lemma integrable_process (μ : measure Ω) [is_finite_measure μ]
+  (hs : ∀ n, measurable_set[ℱ n] (s n)) (n : ℕ) :
+  integrable (process s n) μ :=
+integrable_finset_sum' _ $ λ k hk,
+  integrable_on.integrable_indicator (integrable_const 1) $ ℱ.le _ _ $ hs _
+
+end borel_cantelli
+
+open borel_cantelli
+
+/-- An a.e. monotone adapted process `f` with uniformly bounded differences converges to `+∞` if
+and only if its predictable part also converges to `+∞`. -/
+lemma tendsto_sum_indicator_at_top_iff [is_finite_measure μ]
+  (hfmono : ∀ᵐ ω ∂μ, ∀ n, f n ω ≤ f (n + 1) ω)
+  (hf : adapted ℱ f) (hint : ∀ n, integrable (f n) μ)
+  (hbdd : ∀ᵐ ω ∂μ, ∀ n, |f (n + 1) ω - f n ω| ≤ R) :
+  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top at_top ↔
+    tendsto (λ n, predictable_part f ℱ μ n ω) at_top at_top :=
+begin
+  have h₁ := (martingale_martingale_part hf hint).ae_not_tendsto_at_top_at_top
+    (martingale_part_bdd_difference ℱ hbdd),
+  have h₂ := (martingale_martingale_part hf hint).ae_not_tendsto_at_top_at_bot
+    (martingale_part_bdd_difference ℱ hbdd),
+  have h₃ : ∀ᵐ ω ∂μ, ∀ n, 0 ≤ μ[f (n + 1) - f n | ℱ n] ω,
+  { refine ae_all_iff.2 (λ n, condexp_nonneg _),
+    filter_upwards [ae_all_iff.1 hfmono n] with ω hω using sub_nonneg.2 hω },
+  filter_upwards [h₁, h₂, h₃, hfmono] with ω hω₁ hω₂ hω₃ hω₄,
+  split; intro ht,
+  { refine tendsto_at_top_at_top_of_monotone' _ _,
+    { intros n m hnm,
+      simp only [predictable_part, finset.sum_apply],
+      refine finset.sum_mono_set_of_nonneg hω₃ (finset.range_mono hnm) },
+    rintro ⟨b, hbdd⟩,
+    rw ← tendsto_neg_at_bot_iff at ht,
+    simp only [martingale_part, sub_eq_add_neg] at hω₁,
+    exact hω₁ (tendsto_at_top_add_right_of_le _ (-b)
+      (tendsto_neg_at_bot_iff.1 ht) $ λ n, neg_le_neg (hbdd ⟨n, rfl⟩)) },
+  { refine tendsto_at_top_at_top_of_monotone' (monotone_nat_of_le_succ hω₄) _,
+    rintro ⟨b, hbdd⟩,
+    exact hω₂ (tendsto_at_bot_add_left_of_ge _ b (λ n, hbdd ⟨n, rfl⟩) $
+      tendsto_neg_at_bot_iff.2 ht) },
+end
+
+open borel_cantelli
+
+lemma tendsto_sum_indicator_at_top_iff' [is_finite_measure μ]
+  {s : ℕ → set Ω} (hs : ∀ n, measurable_set[ℱ n] (s n)) :
+  ∀ᵐ ω ∂μ,
+    tendsto (λ n, ∑ k in finset.range n, (s (k + 1)).indicator (1 : Ω → ℝ) ω) at_top at_top ↔
+    tendsto (λ n, ∑ k in finset.range n, μ[(s (k + 1)).indicator (1 : Ω → ℝ) | ℱ k] ω)
+      at_top at_top :=
+begin
+  have := tendsto_sum_indicator_at_top_iff (eventually_of_forall $ λ ω n, _) (adapted_process hs)
+    (integrable_process μ hs) (eventually_of_forall $ process_difference_le s),
+  swap,
+  { rw [process, process, ← sub_nonneg, finset.sum_apply, finset.sum_apply,
+      finset.sum_range_succ_sub_sum],
+    exact set.indicator_nonneg (λ _ _, zero_le_one) _ },
+  simp_rw [process, predictable_part_process_ae_eq] at this,
+  simpa using this,
+end
+
+/-- **Lévy's generalization of the Borel-Cantelli lemma**: given a sequence of sets `s` and a
+filtration `ℱ` such that for all `n`, `s n` is `ℱ n`-measurable, `at_top.limsup s` is almost
+everywhere equal to the set for which `∑ k, ℙ(s (k + 1) | ℱ k) = ∞`. -/
+theorem ae_mem_limsup_at_top_iff (μ : measure Ω) [is_finite_measure μ]
+  {s : ℕ → set Ω} (hs : ∀ n, measurable_set[ℱ n] (s n)) :
+  ∀ᵐ ω ∂μ, ω ∈ limsup s at_top ↔
+    tendsto (λ n, ∑ k in finset.range n, μ[(s (k + 1)).indicator (1 : Ω → ℝ) | ℱ k] ω)
+      at_top at_top :=
+(limsup_eq_tendsto_sum_indicator_at_top ℝ s).symm ▸ tendsto_sum_indicator_at_top_iff' hs
+
+end measure_theory
diff --git a/src/probability/martingale/centering.lean b/src/probability/martingale/centering.lean
new file mode 100644
index 0000000000000..06bbc68ec6a4a
--- /dev/null
+++ b/src/probability/martingale/centering.lean
@@ -0,0 +1,202 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import probability.martingale.basic
+
+/-!
+# Centering lemma for stochastic processes
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Any `ℕ`-indexed stochastic process which is adapted and integrable can be written as the sum of a
+martingale and a predictable process. This result is also known as **Doob's decomposition theorem**.
+From a process `f`, a filtration `ℱ` and a measure `μ`, we define two processes
+`martingale_part f ℱ μ` and `predictable_part f ℱ μ`.
+
+## Main definitions
+
+* `measure_theory.predictable_part f ℱ μ`: a predictable process such that
+  `f = predictable_part f ℱ μ + martingale_part f ℱ μ`
+* `measure_theory.martingale_part f ℱ μ`: a martingale such that
+  `f = predictable_part f ℱ μ + martingale_part f ℱ μ`
+
+## Main statements
+
+* `measure_theory.adapted_predictable_part`: `(λ n, predictable_part f ℱ μ (n+1))` is adapted. That
+  is, `predictable_part` is predictable.
+* `measure_theory.martingale_martingale_part`: `martingale_part f ℱ μ` is a martingale.
+
+-/
+
+
+open topological_space filter
+open_locale nnreal ennreal measure_theory probability_theory big_operators
+
+namespace measure_theory
+
+variables {Ω E : Type*} {m0 : measurable_space Ω} {μ : measure Ω}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+  {f : ℕ → Ω → E} {ℱ : filtration ℕ m0} {n : ℕ}
+
+/-- Any `ℕ`-indexed stochastic process can be written as the sum of a martingale and a predictable
+process. This is the predictable process. See `martingale_part` for the martingale. -/
+noncomputable
+def predictable_part {m0 : measurable_space Ω}
+  (f : ℕ → Ω → E) (ℱ : filtration ℕ m0) (μ : measure Ω . volume_tac) : ℕ → Ω → E :=
+λ n, ∑ i in finset.range n, μ[f (i+1) - f i | ℱ i]
+
+@[simp] lemma predictable_part_zero : predictable_part f ℱ μ 0 = 0 :=
+by simp_rw [predictable_part, finset.range_zero, finset.sum_empty]
+
+lemma adapted_predictable_part : adapted ℱ (λ n, predictable_part f ℱ μ (n+1)) :=
+λ n, finset.strongly_measurable_sum' _
+  (λ i hin, strongly_measurable_condexp.mono (ℱ.mono (finset.mem_range_succ_iff.mp hin)))
+
+lemma adapted_predictable_part' : adapted ℱ (λ n, predictable_part f ℱ μ n) :=
+λ n, finset.strongly_measurable_sum' _
+  (λ i hin, strongly_measurable_condexp.mono (ℱ.mono (finset.mem_range_le hin)))
+
+/-- Any `ℕ`-indexed stochastic process can be written as the sum of a martingale and a predictable
+process. This is the martingale. See `predictable_part` for the predictable process. -/
+noncomputable
+def martingale_part {m0 : measurable_space Ω}
+  (f : ℕ → Ω → E) (ℱ : filtration ℕ m0) (μ : measure Ω . volume_tac) : ℕ → Ω → E :=
+λ n, f n - predictable_part f ℱ μ n
+
+lemma martingale_part_add_predictable_part (ℱ : filtration ℕ m0) (μ : measure Ω) (f : ℕ → Ω → E) :
+  martingale_part f ℱ μ + predictable_part f ℱ μ = f :=
+sub_add_cancel _ _
+
+lemma martingale_part_eq_sum :
+  martingale_part f ℱ μ =
+    λ n, f 0 + ∑ i in finset.range n, (f (i+1) - f i - μ[f (i+1) - f i | ℱ i]) :=
+begin
+  rw [martingale_part, predictable_part],
+  ext1 n,
+  rw [finset.eq_sum_range_sub f n, ← add_sub, ← finset.sum_sub_distrib],
+end
+
+lemma adapted_martingale_part (hf : adapted ℱ f) :
+  adapted ℱ (martingale_part f ℱ μ) :=
+adapted.sub hf adapted_predictable_part'
+
+lemma integrable_martingale_part (hf_int : ∀ n, integrable (f n) μ) (n : ℕ) :
+  integrable (martingale_part f ℱ μ n) μ :=
+begin
+  rw martingale_part_eq_sum,
+  exact (hf_int 0).add
+    (integrable_finset_sum' _ (λ i hi, ((hf_int _).sub (hf_int _)).sub integrable_condexp)),
+end
+
+lemma martingale_martingale_part (hf : adapted ℱ f) (hf_int : ∀ n, integrable (f n) μ)
+  [sigma_finite_filtration μ ℱ] :
+  martingale (martingale_part f ℱ μ) ℱ μ :=
+begin
+  refine ⟨adapted_martingale_part hf, λ i j hij, _⟩,
+  -- ⊢ μ[martingale_part f ℱ μ j | ℱ i] =ᵐ[μ] martingale_part f ℱ μ i
+  have h_eq_sum : μ[martingale_part f ℱ μ j | ℱ i]
+    =ᵐ[μ] f 0 + ∑ k in finset.range j, (μ[f (k+1) - f k | ℱ i] - μ[μ[f (k+1) - f k | ℱ k] | ℱ i]),
+  { rw martingale_part_eq_sum,
+    refine (condexp_add (hf_int 0) _).trans _,
+    { exact integrable_finset_sum' _
+        (λ i hij, ((hf_int _).sub (hf_int _)).sub integrable_condexp), },
+    refine (eventually_eq.add eventually_eq.rfl (condexp_finset_sum (λ i hij, _))).trans _,
+    { exact ((hf_int _).sub (hf_int _)).sub integrable_condexp, },
+    refine eventually_eq.add _ _,
+    { rw condexp_of_strongly_measurable (ℱ.le _) _ (hf_int 0),
+      { apply_instance, },
+      { exact (hf 0).mono (ℱ.mono (zero_le i)), }, },
+    { exact eventually_eq_sum (λ k hkj, condexp_sub ((hf_int _).sub (hf_int _))
+        integrable_condexp), }, },
+  refine h_eq_sum.trans _,
+  have h_ge : ∀ k, i ≤ k → μ[f (k + 1) - f k|ℱ i] - μ[μ[f (k + 1) - f k|ℱ k]|ℱ i] =ᵐ[μ] 0,
+  { intros k hk,
+    have : μ[μ[f (k + 1) - f k|ℱ k]|ℱ i] =ᵐ[μ] μ[f (k + 1) - f k|ℱ i],
+    { exact condexp_condexp_of_le (ℱ.mono hk) (ℱ.le k), },
+    filter_upwards [this] with x hx,
+    rw [pi.sub_apply, pi.zero_apply, hx, sub_self], },
+  have h_lt : ∀ k, k < i → μ[f (k + 1) - f k|ℱ i] - μ[μ[f (k + 1) - f k|ℱ k]|ℱ i]
+    =ᵐ[μ] f (k + 1) - f k - μ[f (k + 1) - f k|ℱ k],
+  { refine λ k hk, eventually_eq.sub _ _,
+    { rw condexp_of_strongly_measurable,
+      { exact ((hf (k+1)).mono (ℱ.mono (nat.succ_le_of_lt hk))).sub
+          ((hf k).mono (ℱ.mono hk.le)), },
+      { exact (hf_int _).sub (hf_int _), }, },
+    { rw condexp_of_strongly_measurable,
+      { exact strongly_measurable_condexp.mono (ℱ.mono hk.le), },
+      { exact integrable_condexp, }, }, },
+  rw martingale_part_eq_sum,
+  refine eventually_eq.add eventually_eq.rfl _,
+  rw [← finset.sum_range_add_sum_Ico _ hij,
+    ← add_zero (∑ i in finset.range i, (f (i + 1) - f i - μ[f (i + 1) - f i | ℱ i]))],
+  refine (eventually_eq_sum (λ k hk, h_lt k (finset.mem_range.mp hk))).add _,
+  refine (eventually_eq_sum (λ k hk, h_ge k (finset.mem_Ico.mp hk).1)).trans _,
+  simp only [finset.sum_const_zero, pi.zero_apply],
+  refl,
+end
+
+-- The following two lemmas demonstrate the essential uniqueness of the decomposition
+lemma martingale_part_add_ae_eq [sigma_finite_filtration μ ℱ] {f g : ℕ → Ω → E}
+  (hf : martingale f ℱ μ) (hg : adapted ℱ (λ n, g (n + 1))) (hg0 : g 0 = 0)
+  (hgint : ∀ n, integrable (g n) μ) (n : ℕ) :
+  martingale_part (f + g) ℱ μ n =ᵐ[μ] f n :=
+begin
+  set h := f - martingale_part (f + g) ℱ μ with hhdef,
+  have hh : h = predictable_part (f + g) ℱ μ - g,
+  { rw [hhdef, sub_eq_sub_iff_add_eq_add, add_comm (predictable_part (f + g) ℱ μ),
+      martingale_part_add_predictable_part] },
+  have hhpred : adapted ℱ (λ n, h (n + 1)),
+  { rw hh,
+    exact adapted_predictable_part.sub hg },
+  have hhmgle : martingale h ℱ μ := hf.sub (martingale_martingale_part
+    (hf.adapted.add $ predictable.adapted hg $ hg0.symm ▸ strongly_measurable_zero) $
+    λ n, (hf.integrable n).add $ hgint n),
+  refine (eventually_eq_iff_sub.2 _).symm,
+  filter_upwards [hhmgle.eq_zero_of_predictable hhpred n] with ω hω,
+  rw [hhdef, pi.sub_apply] at hω,
+  rw [hω, pi.sub_apply, martingale_part],
+  simp [hg0],
+end
+
+lemma predictable_part_add_ae_eq [sigma_finite_filtration μ ℱ] {f g : ℕ → Ω → E}
+  (hf : martingale f ℱ μ) (hg : adapted ℱ (λ n, g (n + 1))) (hg0 : g 0 = 0)
+  (hgint : ∀ n, integrable (g n) μ) (n : ℕ) :
+  predictable_part (f + g) ℱ μ n =ᵐ[μ] g n :=
+begin
+  filter_upwards [martingale_part_add_ae_eq hf hg hg0 hgint n] with ω hω,
+  rw ← add_right_inj (f n ω),
+  conv_rhs { rw [← pi.add_apply, ← pi.add_apply,
+    ← martingale_part_add_predictable_part ℱ μ (f + g)] },
+  rw [pi.add_apply, pi.add_apply, hω],
+end
+
+section difference
+
+lemma predictable_part_bdd_difference {R : ℝ≥0} {f : ℕ → Ω → ℝ}
+  (ℱ : filtration ℕ m0) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, ∀ i, |predictable_part f ℱ μ (i + 1) ω - predictable_part f ℱ μ i ω| ≤ R :=
+begin
+  simp_rw [predictable_part, finset.sum_apply, finset.sum_range_succ_sub_sum],
+  exact ae_all_iff.2 (λ i, ae_bdd_condexp_of_ae_bdd $ ae_all_iff.1 hbdd i),
+end
+
+lemma martingale_part_bdd_difference {R : ℝ≥0} {f : ℕ → Ω → ℝ}
+  (ℱ : filtration ℕ m0) (hbdd : ∀ᵐ ω ∂μ, ∀ i, |f (i + 1) ω - f i ω| ≤ R) :
+  ∀ᵐ ω ∂μ, ∀ i, |martingale_part f ℱ μ (i + 1) ω - martingale_part f ℱ μ i ω| ≤ ↑(2 * R) :=
+begin
+  filter_upwards [hbdd, predictable_part_bdd_difference ℱ hbdd] with ω hω₁ hω₂ i,
+  simp only [two_mul, martingale_part, pi.sub_apply],
+  have : |f (i + 1) ω - predictable_part f ℱ μ (i + 1) ω - (f i ω - predictable_part f ℱ μ i ω)| =
+    |(f (i + 1) ω - f i ω) - (predictable_part f ℱ μ (i + 1) ω - predictable_part f ℱ μ i ω)|,
+  { ring_nf }, -- `ring` suggests `ring_nf` despite proving the goal
+  rw this,
+  exact (abs_sub _ _).trans (add_le_add (hω₁ i) (hω₂ i)),
+end
+
+end difference
+
+end measure_theory
diff --git a/src/probability/martingale/convergence.lean b/src/probability/martingale/convergence.lean
new file mode 100644
index 0000000000000..340f3fba23564
--- /dev/null
+++ b/src/probability/martingale/convergence.lean
@@ -0,0 +1,477 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import probability.martingale.upcrossing
+import measure_theory.function.uniform_integrable
+import measure_theory.constructions.polish
+
+/-!
+
+# Martingale convergence theorems
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The martingale convergence theorems are a collection of theorems characterizing the convergence
+of a martingale provided it satisfies some boundedness conditions. This file contains the
+almost everywhere martingale convergence theorem which provides an almost everywhere limit to
+an L¹ bounded submartingale. It also contains the L¹ martingale convergence theorem which provides
+an L¹ limit to a uniformly integrable submartingale. Finally, it also contains the Lévy upwards
+theorems.
+
+## Main results
+
+* `measure_theory.submartingale.ae_tendsto_limit_process`: the almost everywhere martingale
+  convergence theorem: an L¹-bounded submartingale adapted to the filtration `ℱ` converges almost
+  everywhere to its limit process.
+* `measure_theory.submartingale.mem_ℒp_limit_process`: the limit process of an Lᵖ-bounded
+  submartingale is Lᵖ.
+* `measure_theory.submartingale.tendsto_snorm_one_limit_process`: part a of the L¹ martingale
+  convergence theorem: a uniformly integrable submartingale adapted to the filtration `ℱ` converges
+  almost everywhere and in L¹ to an integrable function which is measurable with respect to
+  the σ-algebra `⨆ n, ℱ n`.
+* `measure_theory.martingale.ae_eq_condexp_limit_process`: part b the L¹ martingale convergence
+  theorem: if `f` is a uniformly integrable martingale adapted to the filtration `ℱ`, then
+  `f n` equals `𝔼[g | ℱ n]` almost everywhere where `g` is the limiting process of `f`.
+* `measure_theory.integrable.tendsto_ae_condexp`: part c the L¹ martingale convergence theorem:
+  given a `⨆ n, ℱ n`-measurable function `g` where `ℱ` is a filtration, `𝔼[g | ℱ n]` converges
+  almost everywhere to `g`.
+* `measure_theory.integrable.tendsto_snorm_condexp`: part c the L¹ martingale convergence theorem:
+  given a `⨆ n, ℱ n`-measurable function `g` where `ℱ` is a filtration, `𝔼[g | ℱ n]` converges in
+  L¹ to `g`.
+
+-/
+
+open topological_space filter measure_theory.filtration
+open_locale nnreal ennreal measure_theory probability_theory big_operators topology
+
+namespace measure_theory
+
+variables {Ω ι : Type*} {m0 : measurable_space Ω} {μ : measure Ω} {ℱ : filtration ℕ m0}
+variables {a b : ℝ} {f : ℕ → Ω → ℝ} {ω : Ω} {R : ℝ≥0}
+
+section ae_convergence
+
+/-!
+
+### Almost everywhere martingale convergence theorem
+
+We will now prove the almost everywhere martingale convergence theorem.
+
+The a.e. martingale convergence theorem states: if `f` is an L¹-bounded `ℱ`-submartingale, then
+it converges almost everywhere to an integrable function which is measurable with respect to
+the σ-algebra `ℱ∞ := ⨆ n, ℱ n`.
+
+Mathematically, we proceed by first noting that a real sequence $(x_n)$ converges if
+(a) $\limsup_{n \to \infty} |x_n| < \infty$, (b) for all $a < b \in \mathbb{Q}$ we have the
+number of upcrossings of $(x_n)$ from below $a$ to above $b$ is finite.
+Thus, for all $\omega$ satisfying $\limsup_{n \to \infty} |f_n(\omega)| < \infty$ and the number of
+upcrossings of $(f_n(\omega))$ from below $a$ to above $b$ is finite for all $a < b \in \mathbb{Q}$,
+we have $(f_n(\omega))$ is convergent.
+
+Hence, assuming $(f_n)$ is L¹-bounded, using Fatou's lemma, we have
+$$
+  \mathbb{E} \limsup_{n \to \infty} |f_n| \le \limsup_{n \to \infty} \mathbb{E}|f_n| < \infty
+$$
+implying $\limsup_{n \to \infty} |f_n| < \infty$ a.e. Furthermore, by the upcrossing estimate,
+the number of upcrossings is finite almost everywhere implying $f$ converges pointwise almost
+everywhere.
+
+Thus, denoting $g$ the a.e. limit of $(f_n)$, $g$ is $\mathcal{F}_\infty$-measurable as for all
+$n$, $f_n$ is $\mathcal{F}_n$-measurable and $\mathcal{F}_n \le \mathcal{F}_\infty$. Finally, $g$
+is integrable as $|g| \le \liminf_{n \to \infty} |f_n|$ so
+$$
+  \mathbb{E}|g| \le \mathbb{E} \limsup_{n \to \infty} |f_n| \le
+    \limsup_{n \to \infty} \mathbb{E}|f_n| < \infty
+$$
+as required.
+
+Implementation wise, we have `tendsto_of_no_upcrossings` which showed that
+a bounded sequence converges if it does not visit below $a$ and above $b$ infinitely often
+for all $a, b ∈ s$ for some dense set $s$. So, we may skip the first step provided we can prove
+that the realizations are bounded almost everywhere. Indeed, suppose $(|f_n(\omega)|)$ is not
+bounded, then either $f_n(\omega) \to \pm \infty$ or one of $\limsup f_n(\omega)$ or
+$\liminf f_n(\omega)$ equals $\pm \infty$ while the other is finite. But the first case
+contradicts $\liminf |f_n(\omega)| < \infty$ while the second case contradicts finite upcrossings.
+
+Furthermore, we introduced `filtration.limit_process` which chooses the limiting random variable
+of a stochastic process if it exists, otherwise it returns 0. Hence, instead of showing an
+existence statement, we phrased the a.e. martingale convergence theorem by showed that a
+submartingale converges to its `limit_process` almost everywhere.
+
+-/
+
+/-- If a stochastic process has bounded upcrossing from below `a` to above `b`,
+then it does not frequently visit both below `a` and above `b`. -/
+lemma not_frequently_of_upcrossings_lt_top (hab : a < b) (hω : upcrossings a b f ω ≠ ∞) :
+  ¬((∃ᶠ n in at_top, f n ω < a) ∧ (∃ᶠ n in at_top, b < f n ω)) :=
+begin
+  rw [← lt_top_iff_ne_top, upcrossings_lt_top_iff] at hω,
+  replace hω : ∃ k, ∀ N, upcrossings_before a b f N ω < k,
+  { obtain ⟨k, hk⟩ := hω,
+    exact ⟨k + 1, λ N, lt_of_le_of_lt (hk N) k.lt_succ_self⟩ },
+  rintro ⟨h₁, h₂⟩,
+  rw frequently_at_top at h₁ h₂,
+  refine not_not.2 hω _,
+  push_neg,
+  intro k,
+  induction k with k ih,
+  { simp only [zero_le', exists_const] },
+  { obtain ⟨N, hN⟩ := ih,
+    obtain ⟨N₁, hN₁, hN₁'⟩ := h₁ N,
+    obtain ⟨N₂, hN₂, hN₂'⟩ := h₂ N₁,
+    exact ⟨(N₂ + 1), nat.succ_le_of_lt $ lt_of_le_of_lt hN
+      (upcrossings_before_lt_of_exists_upcrossing hab hN₁ hN₁' hN₂ hN₂')⟩ }
+end
+
+/-- A stochastic process that frequently visits below `a` and above `b` have infinite
+upcrossings. -/
+lemma upcrossings_eq_top_of_frequently_lt (hab : a < b)
+  (h₁ : ∃ᶠ n in at_top, f n ω < a) (h₂ : ∃ᶠ n in at_top, b < f n ω) :
+  upcrossings a b f ω = ∞ :=
+classical.by_contradiction (λ h, not_frequently_of_upcrossings_lt_top hab h ⟨h₁, h₂⟩)
+
+/-- A realization of a stochastic process with bounded upcrossings and bounded liminfs is
+convergent.
+
+We use the spelling `< ∞` instead of the standard `≠ ∞` in the assumptions since it is not as easy
+to change `<` to `≠` under binders. -/
+lemma tendsto_of_uncrossing_lt_top
+  (hf₁ : liminf (λ n, (‖f n ω‖₊ : ℝ≥0∞)) at_top < ∞)
+  (hf₂ : ∀ a b : ℚ, a < b → upcrossings a b f ω < ∞) :
+  ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
+begin
+  by_cases h : is_bounded_under (≤) at_top (λ n, |f n ω|),
+  { rw is_bounded_under_le_abs at h,
+    refine tendsto_of_no_upcrossings rat.dense_range_cast _ h.1 h.2,
+    { intros a ha b hb hab,
+      obtain ⟨⟨a, rfl⟩, ⟨b, rfl⟩⟩ := ⟨ha, hb⟩,
+      exact not_frequently_of_upcrossings_lt_top hab (hf₂ a b (rat.cast_lt.1 hab)).ne } },
+  { obtain ⟨a, b, hab, h₁, h₂⟩ := ennreal.exists_upcrossings_of_not_bounded_under hf₁.ne h,
+    exact false.elim ((hf₂ a b hab).ne
+      (upcrossings_eq_top_of_frequently_lt (rat.cast_lt.2 hab) h₁ h₂)) }
+end
+
+/-- An L¹-bounded submartingale has bounded upcrossings almost everywhere. -/
+lemma submartingale.upcrossings_ae_lt_top' [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) (hab : a < b) :
+  ∀ᵐ ω ∂μ, upcrossings a b f ω < ∞ :=
+begin
+  refine ae_lt_top (hf.adapted.measurable_upcrossings hab) _,
+  have := hf.mul_lintegral_upcrossings_le_lintegral_pos_part a b,
+  rw [mul_comm, ← ennreal.le_div_iff_mul_le] at this,
+  { refine (lt_of_le_of_lt this (ennreal.div_lt_top _ _)).ne,
+    { have hR' : ∀ n, ∫⁻ ω, ‖f n ω - a‖₊ ∂μ ≤ R + ‖a‖₊ * μ set.univ,
+      { simp_rw snorm_one_eq_lintegral_nnnorm at hbdd,
+        intro n,
+        refine (lintegral_mono _ : ∫⁻ ω, ‖f n ω - a‖₊ ∂μ ≤ ∫⁻ ω, ‖f n ω‖₊ + ‖a‖₊ ∂μ).trans _,
+        { intro ω,
+          simp_rw [sub_eq_add_neg, ← nnnorm_neg a, ← ennreal.coe_add, ennreal.coe_le_coe],
+          exact nnnorm_add_le _ _ },
+        { simp_rw [ lintegral_add_right _ measurable_const, lintegral_const],
+          exact add_le_add (hbdd _) le_rfl } },
+      refine ne_of_lt (supr_lt_iff.2 ⟨R + ‖a‖₊ * μ set.univ, ennreal.add_lt_top.2
+          ⟨ennreal.coe_lt_top, ennreal.mul_lt_top ennreal.coe_lt_top.ne (measure_ne_top _ _)⟩,
+          λ n, le_trans _ (hR' n)⟩),
+      refine lintegral_mono (λ ω, _),
+      rw [ennreal.of_real_le_iff_le_to_real, ennreal.coe_to_real, coe_nnnorm],
+      by_cases hnonneg : 0 ≤ f n ω - a,
+      { rw [lattice_ordered_comm_group.pos_of_nonneg _ hnonneg,
+          real.norm_eq_abs, abs_of_nonneg hnonneg] },
+      { rw lattice_ordered_comm_group.pos_of_nonpos _ (not_le.1 hnonneg).le,
+        exact norm_nonneg _ },
+      { simp only [ne.def, ennreal.coe_ne_top, not_false_iff] } },
+    { simp only [hab, ne.def, ennreal.of_real_eq_zero, sub_nonpos, not_le] } },
+  { simp only [hab, ne.def, ennreal.of_real_eq_zero, sub_nonpos, not_le, true_or]},
+  { simp only [ne.def, ennreal.of_real_ne_top, not_false_iff, true_or] }
+end
+
+lemma submartingale.upcrossings_ae_lt_top [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) :
+  ∀ᵐ ω ∂μ, ∀ a b : ℚ, a < b → upcrossings a b f ω < ∞ :=
+begin
+  simp only [ae_all_iff, eventually_imp_distrib_left],
+  rintro a b hab,
+  exact hf.upcrossings_ae_lt_top' hbdd (rat.cast_lt.2 hab),
+end
+
+/-- An L¹-bounded submartingale converges almost everywhere. -/
+lemma submartingale.exists_ae_tendsto_of_bdd [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) :
+  ∀ᵐ ω ∂μ, ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
+begin
+  filter_upwards [hf.upcrossings_ae_lt_top hbdd, ae_bdd_liminf_at_top_of_snorm_bdd one_ne_zero
+    (λ n, (hf.strongly_measurable n).measurable.mono (ℱ.le n) le_rfl) hbdd] with ω h₁ h₂,
+  exact tendsto_of_uncrossing_lt_top h₂ h₁,
+end
+
+lemma submartingale.exists_ae_trim_tendsto_of_bdd [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) :
+  ∀ᵐ ω ∂(μ.trim (Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _) : (⨆ n, ℱ n) ≤ m0)),
+    ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) :=
+begin
+  rw [ae_iff, trim_measurable_set_eq],
+  { exact hf.exists_ae_tendsto_of_bdd hbdd },
+  { exact measurable_set.compl (@measurable_set_exists_tendsto _ _ _ _ _ _ (⨆ n, ℱ n) _ _ _ _ _
+    (λ n, ((hf.strongly_measurable n).measurable.mono (le_Sup ⟨n, rfl⟩) le_rfl))) }
+end
+
+/-- **Almost everywhere martingale convergence theorem**: An L¹-bounded submartingale converges
+almost everywhere to a `⨆ n, ℱ n`-measurable function. -/
+lemma submartingale.ae_tendsto_limit_process [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hbdd : ∀ n, snorm (f n) 1 μ ≤ R) :
+  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top (𝓝 (ℱ.limit_process f μ ω)) :=
+begin
+  classical,
+  suffices : ∃ g, strongly_measurable[⨆ n, ℱ n] g ∧ ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top (𝓝 (g ω)),
+  { rw [limit_process, dif_pos this],
+    exact (classical.some_spec this).2 },
+  set g' : Ω → ℝ := λ ω, if h : ∃ c, tendsto (λ n, f n ω) at_top (𝓝 c) then h.some else 0,
+  have hle : (⨆ n, ℱ n) ≤ m0 := Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _),
+  have hg' : ∀ᵐ ω ∂(μ.trim hle), tendsto (λ n, f n ω) at_top (𝓝 (g' ω)),
+  { filter_upwards [hf.exists_ae_trim_tendsto_of_bdd hbdd] with ω hω,
+    simp_rw [g', dif_pos hω],
+    exact hω.some_spec },
+  have hg'm : @ae_strongly_measurable _ _ _ (⨆ n, ℱ n) g' (μ.trim hle) :=
+    (@ae_measurable_of_tendsto_metrizable_ae' _ _ (⨆ n, ℱ n) _ _ _ _ _ _ _
+      (λ n, ((hf.strongly_measurable n).measurable.mono
+      (le_Sup ⟨n, rfl⟩ : ℱ n ≤ ⨆ n, ℱ n) le_rfl).ae_measurable) hg').ae_strongly_measurable,
+  obtain ⟨g, hgm, hae⟩ := hg'm,
+  have hg : ∀ᵐ ω ∂μ.trim hle, tendsto (λ n, f n ω) at_top (𝓝 (g ω)),
+  { filter_upwards [hae, hg'] with ω hω hg'ω,
+    exact hω ▸ hg'ω },
+  exact ⟨g, hgm, measure_eq_zero_of_trim_eq_zero hle hg⟩,
+end
+
+/-- The limiting process of an Lᵖ-bounded submartingale is Lᵖ. -/
+lemma submartingale.mem_ℒp_limit_process {p : ℝ≥0∞}
+  (hf : submartingale f ℱ μ) (hbdd : ∀ n, snorm (f n) p μ ≤ R) :
+  mem_ℒp (ℱ.limit_process f μ) p μ :=
+mem_ℒp_limit_process_of_snorm_bdd
+  (λ n, ((hf.strongly_measurable n).mono (ℱ.le n)).ae_strongly_measurable) hbdd
+
+end ae_convergence
+
+section L1_convergence
+
+variables [is_finite_measure μ] {g : Ω → ℝ}
+
+/-!
+
+### L¹ martingale convergence theorem
+
+We will now prove the L¹ martingale convergence theorems.
+
+The L¹ martingale convergence theorem states that:
+(a) if `f` is a uniformly integrable (in the probability sense) submartingale adapted to the
+  filtration `ℱ`, it converges in L¹ to an integrable function `g` which is measurable with
+  respect to `ℱ∞ := ⨆ n, ℱ n` and
+(b) if `f` is actually a martingale, `f n = 𝔼[g | ℱ n]` almost everywhere.
+(c) Finally, if `h` is integrable and measurable with respect to `ℱ∞`, `(𝔼[h | ℱ n])ₙ` is a
+  uniformly integrable martingale which converges to `h` almost everywhere and in L¹.
+
+The proof is quite simple. (a) follows directly from the a.e. martingale convergence theorem
+and the Vitali convergence theorem as our definition of uniform integrability (in the probability
+sense) directly implies L¹-uniform boundedness. We note that our definition of uniform
+integrability is slightly non-standard but is equivalent to the usual literary definition. This
+equivalence is provided by `measure_theory.uniform_integrable_iff`.
+
+(b) follows since given $n$, we have for all $m \ge n$,
+$$
+  \|f_n - \mathbb{E}[g \mid \mathcal{F}_n]\|_1 =
+    \|\mathbb{E}[f_m - g \mid \mathcal{F}_n]\|_1 \le \|\|f_m - g\|_1.
+$$
+Thus, taking $m \to \infty$ provides the almost everywhere equality.
+
+Finally, to prove (c), we define $f_n := \mathbb{E}[h \mid \mathcal{F}_n]$. It is clear that
+$(f_n)_n$ is a martingale by the tower property for conditional expectations. Furthermore,
+$(f_n)_n$ is uniformly integrable in the probability sense. Indeed, as a single function is
+uniformly integrable in the measure theory sense, for all $\epsilon > 0$, there exists some
+$\delta > 0$ such that for all measurable set $A$ with $\mu(A) < δ$, we have
+$\mathbb{E}|h|\mathbf{1}_A < \epsilon$. So, since for sufficently large $\lambda$, by the Markov
+inequality, we have for all $n$,
+$$
+  \mu(|f_n| \ge \lambda) \le \lambda^{-1}\mathbb{E}|f_n| \le \lambda^{-1}\mathbb|g| < \delta,
+$$
+we have for sufficently large $\lambda$, for all $n$,
+$$
+  \mathbb{E}|f_n|\mathbf{1}_{|f_n| \ge \lambda} \le
+    \mathbb|g|\mathbf{1}_{|f_n| \ge \lambda} < \epsilon,
+$$
+implying $(f_n)_n$ is uniformly integrable. Now, to prove $f_n \to h$ almost everywhere and in
+L¹, it suffices to show that $h = g$ almost everywhere where $g$ is the almost everywhere and L¹
+limit of $(f_n)_n$ from part (b) of the theorem. By noting that, for all $s \in \mathcal{F}_n$,
+we have
+$$
+  \mathbb{E}g\mathbf{1}_s = \mathbb{E}[\mathbb{E}[g \mid \mathcal{F}_n]\mathbf{1}_s] =
+    \mathbb{E}[\mathbb{E}[h \mid \mathcal{F}_n]\mathbf{1}_s] = \mathbb{E}h\mathbf{1}_s
+$$
+where $\mathbb{E}[g \mid \mathcal{F}_n = \mathbb{E}[h \mid \mathcal{F}_n]$ almost everywhere
+by part (b); the equality also holds for all $s \in \mathcal{F}_\infty$ by Dynkin's theorem.
+Thus, as both $h$ and $g$ are $\mathcal{F}_\infty$-measurable, $h = g$ almost everywhere as
+required.
+
+Similar to the a.e. martingale convergence theorem, rather than showing the existence of the
+limiting process, we phrased the L¹-martingale convergence theorem by proving that a submartingale
+does converge in L¹ to its `limit_process`. However, in contrast to the a.e. martingale convergence
+theorem, we do not need to introduce a L¹ version of `filtration.limit_process` as the L¹ limit
+and the a.e. limit of a submartingale coincide.
+
+-/
+
+/-- Part a of the **L¹ martingale convergence theorem**: a uniformly integrable submartingale
+adapted to the filtration `ℱ` converges a.e. and in L¹ to an integrable function which is
+measurable with respect to the σ-algebra `⨆ n, ℱ n`. -/
+lemma submartingale.tendsto_snorm_one_limit_process
+  (hf : submartingale f ℱ μ) (hunif : uniform_integrable f 1 μ) :
+  tendsto (λ n, snorm (f n - ℱ.limit_process f μ) 1 μ) at_top (𝓝 0) :=
+begin
+  obtain ⟨R, hR⟩ := hunif.2.2,
+  have hmeas : ∀ n, ae_strongly_measurable (f n) μ :=
+    λ n, ((hf.strongly_measurable n).mono (ℱ.le _)).ae_strongly_measurable,
+  exact tendsto_Lp_of_tendsto_in_measure _ le_rfl ennreal.one_ne_top hmeas
+    (mem_ℒp_limit_process_of_snorm_bdd hmeas hR) hunif.2.1
+    (tendsto_in_measure_of_tendsto_ae hmeas $ hf.ae_tendsto_limit_process hR),
+end
+
+lemma submartingale.ae_tendsto_limit_process_of_uniform_integrable
+  (hf : submartingale f ℱ μ) (hunif : uniform_integrable f 1 μ) :
+  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top (𝓝 (ℱ.limit_process f μ ω)) :=
+let ⟨R, hR⟩ := hunif.2.2 in hf.ae_tendsto_limit_process hR
+
+/-- If a martingale `f` adapted to `ℱ` converges in L¹ to `g`, then for all `n`, `f n` is almost
+everywhere equal to `𝔼[g | ℱ n]`. -/
+lemma martingale.eq_condexp_of_tendsto_snorm {μ : measure Ω}
+  (hf : martingale f ℱ μ) (hg : integrable g μ)
+  (hgtends : tendsto (λ n, snorm (f n - g) 1 μ) at_top (𝓝 0)) (n : ℕ) :
+  f n =ᵐ[μ] μ[g | ℱ n] :=
+begin
+  rw [← sub_ae_eq_zero, ← snorm_eq_zero_iff ((((hf.strongly_measurable n).mono (ℱ.le _)).sub
+    (strongly_measurable_condexp.mono (ℱ.le _))).ae_strongly_measurable) one_ne_zero],
+  have ht : tendsto (λ m, snorm (μ[f m - g | ℱ n]) 1 μ) at_top (𝓝 0),
+  { have hint : ∀ m, integrable (f m - g) μ := λ m, (hf.integrable m).sub hg,
+    exact tendsto_of_tendsto_of_tendsto_of_le_of_le tendsto_const_nhds hgtends (λ m, zero_le _)
+      (λ m, snorm_one_condexp_le_snorm _) },
+  have hev : ∀ m ≥ n, snorm (μ[f m - g | ℱ n]) 1 μ = snorm (f n - μ[g | ℱ n]) 1 μ,
+  { refine λ m hm, snorm_congr_ae
+      ((condexp_sub (hf.integrable m) hg).trans _),
+    filter_upwards [hf.2 n m hm] with x hx,
+    simp only [hx, pi.sub_apply] },
+  exact tendsto_nhds_unique (tendsto_at_top_of_eventually_const hev) ht,
+end
+
+/-- Part b of the **L¹ martingale convergence theorem**: if `f` is a uniformly integrable martingale
+adapted to the filtration `ℱ`, then for all `n`, `f n` is almost everywhere equal to the conditional
+expectation of its limiting process wrt. `ℱ n`. -/
+lemma martingale.ae_eq_condexp_limit_process
+  (hf : martingale f ℱ μ) (hbdd : uniform_integrable f 1 μ) (n : ℕ) :
+  f n =ᵐ[μ] μ[ℱ.limit_process f μ | ℱ n] :=
+let ⟨R, hR⟩ := hbdd.2.2 in hf.eq_condexp_of_tendsto_snorm
+  ((mem_ℒp_limit_process_of_snorm_bdd hbdd.1 hR).integrable le_rfl)
+  (hf.submartingale.tendsto_snorm_one_limit_process hbdd) n
+
+/-- Part c of the **L¹ martingale convergnce theorem**: Given a integrable function `g` which
+is measurable with respect to `⨆ n, ℱ n` where `ℱ` is a filtration, the martingale defined by
+`𝔼[g | ℱ n]` converges almost everywhere to `g`.
+
+This martingale also converges to `g` in L¹ and this result is provided by
+`measure_theory.integrable.tendsto_snorm_condexp` -/
+lemma integrable.tendsto_ae_condexp
+  (hg : integrable g μ) (hgmeas : strongly_measurable[⨆ n, ℱ n] g) :
+  ∀ᵐ x ∂μ, tendsto (λ n, μ[g | ℱ n] x) at_top (𝓝 (g x)) :=
+begin
+  have hle : (⨆ n, ℱ n) ≤ m0 := Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _),
+  have hunif : uniform_integrable (λ n, μ[g | ℱ n]) 1 μ := hg.uniform_integrable_condexp_filtration,
+  obtain ⟨R, hR⟩ := hunif.2.2,
+  have hlimint : integrable (ℱ.limit_process (λ n, μ[g | ℱ n]) μ) μ :=
+    (mem_ℒp_limit_process_of_snorm_bdd hunif.1 hR).integrable le_rfl,
+  suffices : g =ᵐ[μ] ℱ.limit_process (λ n x, μ[g | ℱ n] x) μ,
+  { filter_upwards [this, (martingale_condexp g ℱ μ).submartingale.ae_tendsto_limit_process hR]
+      with x heq ht,
+    rwa heq },
+  have : ∀ n s, measurable_set[ℱ n] s → ∫ x in s, g x ∂μ =
+    ∫ x in s, ℱ.limit_process (λ n x, μ[g | ℱ n] x) μ x ∂μ,
+  { intros n s hs,
+    rw [← set_integral_condexp (ℱ.le n) hg hs, ← set_integral_condexp (ℱ.le n) hlimint hs],
+    refine set_integral_congr_ae (ℱ.le _ _ hs) _,
+    filter_upwards [(martingale_condexp g ℱ μ).ae_eq_condexp_limit_process hunif n] with x hx _,
+    rwa hx },
+  refine ae_eq_of_forall_set_integral_eq_of_sigma_finite' hle
+    (λ s _ _, hg.integrable_on) (λ s _ _, hlimint.integrable_on) (λ s hs, _)
+    hgmeas.ae_strongly_measurable' strongly_measurable_limit_process.ae_strongly_measurable',
+  refine @measurable_space.induction_on_inter _ _ _ (⨆ n, ℱ n)
+    (measurable_space.measurable_space_supr_eq ℱ) _ _ _ _ _ _ hs,
+  { rintro s ⟨n, hs⟩ t ⟨m, ht⟩ -,
+    by_cases hnm : n ≤ m,
+    { exact ⟨m, (ℱ.mono hnm _ hs).inter ht⟩ },
+    { exact ⟨n, hs.inter (ℱ.mono (not_le.1 hnm).le _ ht)⟩ } },
+  { simp only [measure_empty, with_top.zero_lt_top, measure.restrict_empty,
+      integral_zero_measure, forall_true_left] },
+  { rintro t ⟨n, ht⟩ -,
+    exact this n _ ht },
+  { rintro t htmeas ht -,
+    have hgeq := @integral_add_compl _ _ (⨆ n, ℱ n) _ _ _ _ _ _ htmeas (hg.trim hle hgmeas),
+    have hheq := @integral_add_compl _ _ (⨆ n, ℱ n) _ _ _ _ _ _ htmeas
+      (hlimint.trim hle strongly_measurable_limit_process),
+    rw [add_comm, ← eq_sub_iff_add_eq] at hgeq hheq,
+    rw [set_integral_trim hle hgmeas htmeas.compl,
+      set_integral_trim hle strongly_measurable_limit_process htmeas.compl,
+      hgeq, hheq, ← set_integral_trim hle hgmeas htmeas,
+      ← set_integral_trim hle strongly_measurable_limit_process htmeas,
+      ← integral_trim hle hgmeas, ← integral_trim hle strongly_measurable_limit_process,
+      ← integral_univ, this 0 _ measurable_set.univ, integral_univ, ht (measure_lt_top _ _)] },
+  { rintro f hf hfmeas heq -,
+    rw [integral_Union (λ n, hle _ (hfmeas n)) hf hg.integrable_on,
+      integral_Union (λ n, hle _ (hfmeas n)) hf hlimint.integrable_on],
+    exact tsum_congr (λ n, heq _ (measure_lt_top _ _)) }
+end
+
+/-- Part c of the **L¹ martingale convergnce theorem**: Given a integrable function `g` which
+is measurable with respect to `⨆ n, ℱ n` where `ℱ` is a filtration, the martingale defined by
+`𝔼[g | ℱ n]` converges in L¹ to `g`.
+
+This martingale also converges to `g` almost everywhere and this result is provided by
+`measure_theory.integrable.tendsto_ae_condexp` -/
+lemma integrable.tendsto_snorm_condexp
+  (hg : integrable g μ) (hgmeas : strongly_measurable[⨆ n, ℱ n] g) :
+  tendsto (λ n, snorm (μ[g | ℱ n] - g) 1 μ) at_top (𝓝 0) :=
+tendsto_Lp_of_tendsto_in_measure _ le_rfl ennreal.one_ne_top
+  (λ n, (strongly_measurable_condexp.mono (ℱ.le n)).ae_strongly_measurable)
+  (mem_ℒp_one_iff_integrable.2 hg) (hg.uniform_integrable_condexp_filtration).2.1
+    (tendsto_in_measure_of_tendsto_ae
+    (λ n,(strongly_measurable_condexp.mono (ℱ.le n)).ae_strongly_measurable)
+      (hg.tendsto_ae_condexp hgmeas))
+
+/-- **Lévy's upward theorem**, almost everywhere version: given a function `g` and a filtration
+`ℱ`, the sequence defined by `𝔼[g | ℱ n]` converges almost everywhere to `𝔼[g | ⨆ n, ℱ n]`. -/
+lemma tendsto_ae_condexp (g : Ω → ℝ) :
+  ∀ᵐ x ∂μ, tendsto (λ n, μ[g | ℱ n] x) at_top (𝓝 (μ[g | ⨆ n, ℱ n] x)) :=
+begin
+  have ht : ∀ᵐ x ∂μ, tendsto (λ n, μ[μ[g | ⨆ n, ℱ n] | ℱ n] x) at_top (𝓝 (μ[g | ⨆ n, ℱ n] x)) :=
+    integrable_condexp.tendsto_ae_condexp strongly_measurable_condexp,
+  have heq : ∀ n, ∀ᵐ x ∂μ, μ[μ[g | ⨆ n, ℱ n] | ℱ n] x = μ[g | ℱ n] x :=
+    λ n, condexp_condexp_of_le (le_supr _ n) (supr_le (λ n, ℱ.le n)),
+  rw ← ae_all_iff at heq,
+  filter_upwards [heq, ht] with x hxeq hxt,
+  exact hxt.congr hxeq,
+end
+
+/-- **Lévy's upward theorem**, L¹ version: given a function `g` and a filtration `ℱ`, the
+sequence defined by `𝔼[g | ℱ n]` converges in L¹ to `𝔼[g | ⨆ n, ℱ n]`. -/
+lemma tendsto_snorm_condexp (g : Ω → ℝ) :
+  tendsto (λ n, snorm (μ[g | ℱ n] - μ[g | ⨆ n, ℱ n]) 1 μ) at_top (𝓝 0) :=
+begin
+  have ht : tendsto (λ n, snorm (μ[μ[g | ⨆ n, ℱ n] | ℱ n] - μ[g | ⨆ n, ℱ n]) 1 μ) at_top (𝓝 0) :=
+    integrable_condexp.tendsto_snorm_condexp strongly_measurable_condexp,
+  have heq : ∀ n, ∀ᵐ x ∂μ, μ[μ[g | ⨆ n, ℱ n] | ℱ n] x = μ[g | ℱ n] x :=
+    λ n, condexp_condexp_of_le (le_supr _ n) (supr_le (λ n, ℱ.le n)),
+  refine ht.congr (λ n, snorm_congr_ae _),
+  filter_upwards [heq n] with x hxeq,
+  simp only [hxeq, pi.sub_apply],
+end
+
+end L1_convergence
+
+end measure_theory
diff --git a/src/probability/martingale/optional_sampling.lean b/src/probability/martingale/optional_sampling.lean
new file mode 100644
index 0000000000000..ac1c91b34c817
--- /dev/null
+++ b/src/probability/martingale/optional_sampling.lean
@@ -0,0 +1,239 @@
+/-
+Copyright (c) 2023 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import order.succ_pred.linear_locally_finite
+import probability.martingale.basic
+
+/-!
+# Optional sampling theorem
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+If `τ` is a bounded stopping time and `σ` is another stopping time, then the value of a martingale
+`f` at the stopping time `min τ σ` is almost everywhere equal to
+`μ[stopped_value f τ | hσ.measurable_space]`.
+
+## Main results
+
+* `stopped_value_ae_eq_condexp_of_le_const`: the value of a martingale `f` at a stopping time `τ`
+  bounded by `n` is the conditional expectation of `f n` with respect to the σ-algebra generated by
+  `τ`.
+* `stopped_value_ae_eq_condexp_of_le`: if `τ` and `σ` are two stopping times with `σ ≤ τ` and `τ` is
+  bounded, then the value of a martingale `f` at `σ` is the conditional expectation of its value at
+  `τ` with respect to the σ-algebra generated by `σ`.
+* `stopped_value_min_ae_eq_condexp`: the optional sampling theorem. If `τ` is a bounded stopping
+  time and `σ` is another stopping time, then the value of a martingale `f` at the stopping time
+  `min τ σ` is almost everywhere equal to the conditional expectation of `f` stopped at `τ`
+  with respect to the σ-algebra generated by `σ`.
+
+-/
+
+open_locale measure_theory big_operators ennreal
+open topological_space
+
+-- TODO after the port: move to topology/instances/discrete
+@[priority 100]
+instance discrete_topology.second_countable_topology_of_countable {α : Type*} [topological_space α]
+  [discrete_topology α] [countable α] :
+  second_countable_topology α :=
+@discrete_topology.second_countable_topology_of_encodable _ _ _ (encodable.of_countable _)
+
+namespace measure_theory
+
+namespace martingale
+
+variables {Ω E : Type*} {m : measurable_space Ω} {μ : measure Ω}
+  [normed_add_comm_group E] [normed_space ℝ E] [complete_space E]
+
+section first_countable_topology
+
+variables {ι : Type*} [linear_order ι] [topological_space ι] [order_topology ι]
+  [first_countable_topology ι]
+  {ℱ : filtration ι m} [sigma_finite_filtration μ ℱ] {τ σ : Ω → ι} {f : ι → Ω → E}  {i n : ι}
+
+lemma condexp_stopping_time_ae_eq_restrict_eq_const
+  [(filter.at_top : filter ι).is_countably_generated]
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) [sigma_finite (μ.trim hτ.measurable_space_le)]
+  (hin : i ≤ n) :
+  μ[f n | hτ.measurable_space] =ᵐ[μ.restrict {x | τ x = i}] f i :=
+begin
+  refine filter.eventually_eq.trans _ (ae_restrict_of_ae (h.condexp_ae_eq hin)),
+  refine condexp_ae_eq_restrict_of_measurable_space_eq_on hτ.measurable_space_le (ℱ.le i)
+    (hτ.measurable_set_eq' i) (λ t, _),
+  rw [set.inter_comm _ t, is_stopping_time.measurable_set_inter_eq_iff],
+end
+
+lemma condexp_stopping_time_ae_eq_restrict_eq_const_of_le_const
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hτ_le : ∀ x, τ x ≤ n)
+  [sigma_finite (μ.trim (hτ.measurable_space_le_of_le hτ_le))] (i : ι) :
+  μ[f n | hτ.measurable_space] =ᵐ[μ.restrict {x | τ x = i}] f i :=
+begin
+  by_cases hin : i ≤ n,
+  { refine filter.eventually_eq.trans _ (ae_restrict_of_ae (h.condexp_ae_eq hin)),
+    refine condexp_ae_eq_restrict_of_measurable_space_eq_on (hτ.measurable_space_le_of_le hτ_le)
+      (ℱ.le i) (hτ.measurable_set_eq' i) (λ t, _),
+    rw [set.inter_comm _ t, is_stopping_time.measurable_set_inter_eq_iff], },
+  { suffices : {x : Ω | τ x = i} = ∅, by simp [this],
+    ext1 x,
+    simp only [set.mem_set_of_eq, set.mem_empty_iff_false, iff_false],
+    rintro rfl,
+    exact hin (hτ_le x), },
+end
+
+lemma stopped_value_ae_eq_restrict_eq
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hτ_le : ∀ x, τ x ≤ n)
+  [sigma_finite (μ.trim ((hτ.measurable_space_le_of_le hτ_le)))] (i : ι) :
+  stopped_value f τ =ᵐ[μ.restrict {x | τ x = i}] μ[f n | hτ.measurable_space] :=
+begin
+  refine filter.eventually_eq.trans _
+    (condexp_stopping_time_ae_eq_restrict_eq_const_of_le_const h hτ hτ_le i).symm,
+  rw [filter.eventually_eq, ae_restrict_iff' (ℱ.le _ _ (hτ.measurable_set_eq i))],
+  refine filter.eventually_of_forall (λ x hx, _),
+  rw set.mem_set_of_eq at hx,
+  simp_rw [stopped_value, hx],
+end
+
+/-- The value of a martingale `f` at a stopping time `τ` bounded by `n` is the conditional
+expectation of `f n` with respect to the σ-algebra generated by `τ`. -/
+lemma stopped_value_ae_eq_condexp_of_le_const_of_countable_range
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ)
+  (hτ_le : ∀ x, τ x ≤ n) (h_countable_range : (set.range τ).countable)
+  [sigma_finite (μ.trim (hτ.measurable_space_le_of_le hτ_le))] :
+  stopped_value f τ =ᵐ[μ] μ[f n | hτ.measurable_space] :=
+begin
+  have : set.univ = ⋃ i ∈ (set.range τ), {x | τ x = i},
+  { ext1 x,
+    simp only [set.mem_univ, set.mem_range, true_and, set.Union_exists, set.Union_Union_eq',
+      set.mem_Union, set.mem_set_of_eq, exists_apply_eq_apply'], },
+  nth_rewrite 0 ← @measure.restrict_univ Ω _ μ,
+  rw [this, ae_eq_restrict_bUnion_iff _ h_countable_range],
+  exact λ i hi, stopped_value_ae_eq_restrict_eq h _ hτ_le i,
+end
+
+/-- The value of a martingale `f` at a stopping time `τ` bounded by `n` is the conditional
+expectation of `f n` with respect to the σ-algebra generated by `τ`. -/
+lemma stopped_value_ae_eq_condexp_of_le_const [countable ι]
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hτ_le : ∀ x, τ x ≤ n)
+  [sigma_finite (μ.trim (hτ.measurable_space_le_of_le hτ_le))] :
+  stopped_value f τ =ᵐ[μ] μ[f n | hτ.measurable_space] :=
+h.stopped_value_ae_eq_condexp_of_le_const_of_countable_range hτ hτ_le (set.to_countable _)
+
+/-- If `τ` and `σ` are two stopping times with `σ ≤ τ` and `τ` is bounded, then the value of a
+martingale `f` at `σ` is the conditional expectation of its value at `τ` with respect to the
+σ-algebra generated by `σ`. -/
+lemma stopped_value_ae_eq_condexp_of_le_of_countable_range
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hσ : is_stopping_time ℱ σ)
+  (hσ_le_τ : σ ≤ τ) (hτ_le : ∀ x, τ x ≤ n)
+  (hτ_countable_range : (set.range τ).countable) (hσ_countable_range : (set.range σ).countable)
+  [sigma_finite (μ.trim (hσ.measurable_space_le_of_le (λ x, (hσ_le_τ x).trans (hτ_le x))))] :
+  stopped_value f σ =ᵐ[μ] μ[stopped_value f τ | hσ.measurable_space] :=
+begin
+  haveI : sigma_finite (μ.trim (hτ.measurable_space_le_of_le hτ_le)),
+  { exact sigma_finite_trim_mono _ (is_stopping_time.measurable_space_mono hσ hτ hσ_le_τ), },
+  have : μ[stopped_value f τ|hσ.measurable_space]
+      =ᵐ[μ] μ[μ[f n|hτ.measurable_space] | hσ.measurable_space],
+    from condexp_congr_ae (h.stopped_value_ae_eq_condexp_of_le_const_of_countable_range hτ hτ_le
+      hτ_countable_range),
+  refine (filter.eventually_eq.trans _
+    (condexp_condexp_of_le _ (hτ.measurable_space_le_of_le hτ_le)).symm).trans this.symm,
+  { exact h.stopped_value_ae_eq_condexp_of_le_const_of_countable_range hσ
+      (λ x, (hσ_le_τ x).trans (hτ_le x)) hσ_countable_range, },
+  { exact hσ.measurable_space_mono hτ hσ_le_τ, },
+end
+
+/-- If `τ` and `σ` are two stopping times with `σ ≤ τ` and `τ` is bounded, then the value of a
+martingale `f` at `σ` is the conditional expectation of its value at `τ` with respect to the
+σ-algebra generated by `σ`. -/
+lemma stopped_value_ae_eq_condexp_of_le [countable ι]
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hσ : is_stopping_time ℱ σ)
+  (hσ_le_τ : σ ≤ τ) (hτ_le : ∀ x, τ x ≤ n) [sigma_finite (μ.trim hσ.measurable_space_le)] :
+  stopped_value f σ =ᵐ[μ] μ[stopped_value f τ | hσ.measurable_space] :=
+h.stopped_value_ae_eq_condexp_of_le_of_countable_range hτ hσ hσ_le_τ hτ_le
+  (set.to_countable _) (set.to_countable _)
+
+end first_countable_topology
+
+section subset_of_nat
+
+/-! In the following results the index set verifies `[linear_order ι] [locally_finite_order ι]` and
+`[order_bot ι]`, which means that it is order-isomorphic to a subset of `ℕ`. `ι` is equipped with
+the discrete topology, which is also the order topology, and is a measurable space with the Borel
+σ-algebra. -/
+
+variables {ι : Type*} [linear_order ι] [locally_finite_order ι] [order_bot ι]
+  [topological_space ι] [discrete_topology ι] [measurable_space ι] [borel_space ι]
+  [measurable_space E] [borel_space E] [second_countable_topology E]
+  {ℱ : filtration ι m} {τ σ : Ω → ι} {f : ι → Ω → E} {i n : ι}
+
+lemma condexp_stopped_value_stopping_time_ae_eq_restrict_le
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hσ : is_stopping_time ℱ σ)
+  [sigma_finite (μ.trim hσ.measurable_space_le)] (hτ_le : ∀ x, τ x ≤ n) :
+  μ[stopped_value f τ | hσ.measurable_space] =ᵐ[μ.restrict {x : Ω | τ x ≤ σ x}] stopped_value f τ :=
+begin
+  rw ae_eq_restrict_iff_indicator_ae_eq
+    (hτ.measurable_space_le _ (hτ.measurable_set_le_stopping_time hσ)),
+  swap, apply_instance,
+  refine (condexp_indicator (integrable_stopped_value ι hτ h.integrable hτ_le)
+    (hτ.measurable_set_stopping_time_le hσ)).symm.trans _,
+  have h_int : integrable ({ω : Ω | τ ω ≤ σ ω}.indicator (stopped_value (λ (n : ι), f n) τ)) μ,
+  { refine (integrable_stopped_value ι hτ h.integrable hτ_le).indicator _,
+    exact hτ.measurable_space_le _ (hτ.measurable_set_le_stopping_time hσ), },
+  have h_meas : ae_strongly_measurable' hσ.measurable_space
+    ({ω : Ω | τ ω ≤ σ ω}.indicator (stopped_value (λ (n : ι), f n) τ)) μ,
+  { refine strongly_measurable.ae_strongly_measurable' _,
+    refine strongly_measurable.strongly_measurable_of_measurable_space_le_on
+      (hτ.measurable_set_le_stopping_time hσ) _ _ _,
+    { intros t ht,
+      rw set.inter_comm _ t at ht ⊢,
+      rw [hτ.measurable_set_inter_le_iff, is_stopping_time.measurable_set_min_iff hτ hσ] at ht,
+      exact ht.2, },
+    { refine strongly_measurable.indicator _ (hτ.measurable_set_le_stopping_time hσ),
+      refine measurable.strongly_measurable _,
+      exact measurable_stopped_value h.adapted.prog_measurable_of_discrete hτ, },
+    { intros x hx,
+      simp only [hx, set.indicator_of_not_mem, not_false_iff], }, },
+  exact condexp_of_ae_strongly_measurable' hσ.measurable_space_le h_meas h_int,
+end
+
+/-- **Optional Sampling theorem**. If `τ` is a bounded stopping time and `σ` is another stopping
+time, then the value of a martingale `f` at the stopping time `min τ σ` is almost everywhere equal
+to the conditional expectation of `f` stopped at `τ` with respect to the σ-algebra generated
+by `σ`. -/
+lemma stopped_value_min_ae_eq_condexp [sigma_finite_filtration μ ℱ]
+  (h : martingale f ℱ μ) (hτ : is_stopping_time ℱ τ) (hσ : is_stopping_time ℱ σ) {n : ι}
+  (hτ_le : ∀ x, τ x ≤ n) [h_sf_min : sigma_finite (μ.trim (hτ.min hσ).measurable_space_le)] :
+  stopped_value f (λ x, min (σ x) (τ x)) =ᵐ[μ] μ[stopped_value f τ | hσ.measurable_space] :=
+begin
+  refine (h.stopped_value_ae_eq_condexp_of_le hτ (hσ.min hτ) (λ x, min_le_right _ _) hτ_le).trans _,
+  refine ae_of_ae_restrict_of_ae_restrict_compl {x | σ x ≤ τ x} _ _,
+  { exact condexp_min_stopping_time_ae_eq_restrict_le hσ hτ, },
+  { suffices : μ[stopped_value f τ|(hσ.min hτ).measurable_space]
+      =ᵐ[μ.restrict {x | τ x ≤ σ x}] μ[stopped_value f τ|hσ.measurable_space],
+    { rw ae_restrict_iff' (hσ.measurable_space_le _ (hσ.measurable_set_le_stopping_time hτ).compl),
+      rw [filter.eventually_eq, ae_restrict_iff'] at this,
+      swap, { exact hτ.measurable_space_le _ (hτ.measurable_set_le_stopping_time hσ), },
+      filter_upwards [this] with x hx hx_mem,
+      simp only [set.mem_compl_iff, set.mem_set_of_eq, not_le] at hx_mem,
+      exact hx hx_mem.le, },
+    refine filter.eventually_eq.trans _
+      ((condexp_min_stopping_time_ae_eq_restrict_le hτ hσ).trans _),
+    { exact stopped_value f τ, },
+    { rw [is_stopping_time.measurable_space_min, is_stopping_time.measurable_space_min, inf_comm] },
+    { have h1 : μ[stopped_value f τ|hτ.measurable_space] = stopped_value f τ,
+      { refine condexp_of_strongly_measurable hτ.measurable_space_le _ _,
+        { refine measurable.strongly_measurable _,
+          exact measurable_stopped_value h.adapted.prog_measurable_of_discrete hτ, },
+        { exact integrable_stopped_value ι hτ h.integrable hτ_le, }, },
+      rw h1,
+      exact (condexp_stopped_value_stopping_time_ae_eq_restrict_le h hτ hσ hτ_le).symm, }, },
+end
+
+end subset_of_nat
+
+end martingale
+
+end measure_theory
diff --git a/src/probability/martingale/optional_stopping.lean b/src/probability/martingale/optional_stopping.lean
new file mode 100644
index 0000000000000..3645319aa2ac2
--- /dev/null
+++ b/src/probability/martingale/optional_stopping.lean
@@ -0,0 +1,235 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import probability.process.hitting_time
+import probability.martingale.basic
+
+/-! # Optional stopping theorem (fair game theorem)
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The optional stopping theorem states that an adapted integrable process `f` is a submartingale if
+and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
+stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`.
+
+This file also contains Doob's maximal inequality: given a non-negative submartingale `f`, for all
+`ε : ℝ≥0`, we have `ε • μ {ε ≤ f* n} ≤ ∫ ω in {ε ≤ f* n}, f n` where `f* n ω = max_{k ≤ n}, f k ω`.
+
+### Main results
+
+* `measure_theory.submartingale_iff_expected_stopped_value_mono`: the optional stopping theorem.
+* `measure_theory.submartingale.stopped_process`: the stopped process of a submartingale with
+  respect to a stopping time is a submartingale.
+* `measure_theory.maximal_ineq`: Doob's maximal inequality.
+
+ -/
+
+open_locale nnreal ennreal measure_theory probability_theory
+
+namespace measure_theory
+
+variables {Ω : Type*} {m0 : measurable_space Ω} {μ : measure Ω} {𝒢 : filtration ℕ m0}
+  {f : ℕ → Ω → ℝ} {τ π : Ω → ℕ}
+
+-- We may generalize the below lemma to functions taking value in a `normed_lattice_add_comm_group`.
+-- Similarly, generalize `(super/)submartingale.set_integral_le`.
+
+/-- Given a submartingale `f` and bounded stopping times `τ` and `π` such that `τ ≤ π`, the
+expectation of `stopped_value f τ` is less than or equal to the expectation of `stopped_value f π`.
+This is the forward direction of the optional stopping theorem. -/
+lemma submartingale.expected_stopped_value_mono [sigma_finite_filtration μ 𝒢]
+  (hf : submartingale f 𝒢 μ) (hτ : is_stopping_time 𝒢 τ) (hπ : is_stopping_time 𝒢 π) (hle : τ ≤ π)
+  {N : ℕ} (hbdd : ∀ ω, π ω ≤ N) :
+  μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
+begin
+  rw [← sub_nonneg, ← integral_sub', stopped_value_sub_eq_sum' hle hbdd],
+  { simp only [finset.sum_apply],
+    have : ∀ i, measurable_set[𝒢 i] {ω : Ω | τ ω ≤ i ∧ i < π ω},
+    { intro i,
+      refine (hτ i).inter _,
+      convert (hπ i).compl,
+      ext x,
+      simpa },
+    rw integral_finset_sum,
+    { refine finset.sum_nonneg (λ i hi, _),
+      rw [integral_indicator (𝒢.le _ _ (this _)), integral_sub', sub_nonneg],
+      { exact hf.set_integral_le (nat.le_succ i) (this _) },
+      { exact (hf.integrable _).integrable_on },
+      { exact (hf.integrable _).integrable_on } },
+    intros i hi,
+    exact integrable.indicator (integrable.sub (hf.integrable _) (hf.integrable _))
+      (𝒢.le _ _ (this _)) },
+  { exact hf.integrable_stopped_value hπ hbdd },
+  { exact hf.integrable_stopped_value hτ (λ ω, le_trans (hle ω) (hbdd ω)) }
+end
+
+/-- The converse direction of the optional stopping theorem, i.e. an adapted integrable process `f`
+is a submartingale if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
+stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
+lemma submartingale_of_expected_stopped_value_mono [is_finite_measure μ]
+  (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ)
+  (hf : ∀ τ π : Ω → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ ω, π ω ≤ N) →
+    μ[stopped_value f τ] ≤ μ[stopped_value f π]) :
+  submartingale f 𝒢 μ :=
+begin
+  refine submartingale_of_set_integral_le hadp hint (λ i j hij s hs, _),
+  classical,
+  specialize hf (s.piecewise (λ _, i) (λ _, j)) _
+    (is_stopping_time_piecewise_const hij hs)
+    (is_stopping_time_const 𝒢 j) (λ x, (ite_le_sup _ _ _).trans (max_eq_right hij).le)
+    ⟨j, λ x, le_rfl⟩,
+  rwa [stopped_value_const, stopped_value_piecewise_const,
+    integral_piecewise (𝒢.le _ _ hs) (hint _).integrable_on (hint _).integrable_on,
+    ← integral_add_compl (𝒢.le _ _ hs) (hint j), add_le_add_iff_right] at hf,
+end
+
+/-- **The optional stopping theorem** (fair game theorem): an adapted integrable process `f`
+is a submartingale if and only if for all bounded stopping times `τ` and `π` such that `τ ≤ π`, the
+stopped value of `f` at `τ` has expectation smaller than its stopped value at `π`. -/
+lemma submartingale_iff_expected_stopped_value_mono [is_finite_measure μ]
+  (hadp : adapted 𝒢 f) (hint : ∀ i, integrable (f i) μ) :
+  submartingale f 𝒢 μ ↔
+  ∀ τ π : Ω → ℕ, is_stopping_time 𝒢 τ → is_stopping_time 𝒢 π → τ ≤ π → (∃ N, ∀ x, π x ≤ N) →
+    μ[stopped_value f τ] ≤ μ[stopped_value f π] :=
+⟨λ hf _ _ hτ hπ hle ⟨N, hN⟩, hf.expected_stopped_value_mono hτ hπ hle hN,
+ submartingale_of_expected_stopped_value_mono hadp hint⟩
+
+/-- The stopped process of a submartingale with respect to a stopping time is a submartingale. -/
+@[protected]
+lemma submartingale.stopped_process [is_finite_measure μ]
+  (h : submartingale f 𝒢 μ) (hτ : is_stopping_time 𝒢 τ) :
+  submartingale (stopped_process f τ) 𝒢 μ :=
+begin
+  rw submartingale_iff_expected_stopped_value_mono,
+  { intros σ π hσ hπ hσ_le_π hπ_bdd,
+    simp_rw stopped_value_stopped_process,
+    obtain ⟨n, hπ_le_n⟩ := hπ_bdd,
+    exact h.expected_stopped_value_mono (hσ.min hτ) (hπ.min hτ)
+      (λ ω, min_le_min (hσ_le_π ω) le_rfl) (λ ω, (min_le_left _ _).trans (hπ_le_n ω)), },
+  { exact adapted.stopped_process_of_discrete h.adapted hτ, },
+  { exact λ i, h.integrable_stopped_value ((is_stopping_time_const _ i).min hτ)
+    (λ ω, min_le_left _ _), },
+end
+
+section maximal
+
+open finset
+
+lemma smul_le_stopped_value_hitting [is_finite_measure μ]
+  (hsub : submartingale f 𝒢 μ) {ε : ℝ≥0} (n : ℕ) :
+  ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)} ≤
+  ennreal.of_real (∫ ω in {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)},
+    stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ) :=
+begin
+  have hn : set.Icc 0 n = {k | k ≤ n},
+  { ext x, simp },
+  have : ∀ ω, ((ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) →
+    (ε : ℝ) ≤ stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω,
+  { intros x hx,
+    simp_rw [le_sup'_iff, mem_range, nat.lt_succ_iff] at hx,
+    refine stopped_value_hitting_mem _,
+    simp only [set.mem_set_of_eq, exists_prop, hn],
+    exact let ⟨j, hj₁, hj₂⟩ := hx in ⟨j, hj₁, hj₂⟩ },
+  have h := set_integral_ge_of_const_le (measurable_set_le measurable_const
+    (finset.measurable_range_sup'' (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))))
+    (measure_ne_top _ _) this
+    (integrable.integrable_on (hsub.integrable_stopped_value
+      (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le)),
+  rw [ennreal.le_of_real_iff_to_real_le, ennreal.to_real_smul],
+  { exact h },
+  { exact ennreal.mul_ne_top (by simp) (measure_ne_top _ _) },
+  { exact le_trans (mul_nonneg ε.coe_nonneg ennreal.to_real_nonneg) h }
+end
+
+/-- **Doob's maximal inequality**: Given a non-negative submartingale `f`, for all `ε : ℝ≥0`,
+we have `ε • μ {ε ≤ f* n} ≤ ∫ ω in {ε ≤ f* n}, f n` where `f* n ω = max_{k ≤ n}, f k ω`.
+
+In some literature, the Doob's maximal inequality refers to what we call Doob's Lp inequality
+(which is a corollary of this lemma and will be proved in an upcomming PR). -/
+lemma maximal_ineq [is_finite_measure μ]
+  (hsub : submartingale f 𝒢 μ) (hnonneg : 0 ≤ f) {ε : ℝ≥0} (n : ℕ) :
+  ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)} ≤
+  ennreal.of_real (∫ ω in {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)},
+    f n ω ∂μ) :=
+begin
+  suffices : ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)} +
+    ennreal.of_real (∫ ω in {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ε},
+      f n ω ∂μ) ≤ ennreal.of_real (μ[f n]),
+  { have hadd : ennreal.of_real (∫ ω, f n ω ∂μ) =
+      ennreal.of_real (∫ ω in
+        {ω | ↑ε ≤ ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω))}, f n ω ∂μ) +
+      ennreal.of_real (∫ ω in
+        {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ↑ε}, f n ω ∂μ),
+    { rw [← ennreal.of_real_add, ← integral_union],
+      { conv_lhs { rw ← integral_univ },
+        convert rfl,
+        ext ω,
+        change (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ) ↔ _,
+        simp only [le_or_lt, true_iff] },
+      { rw disjoint_iff_inf_le,
+        rintro ω ⟨hω₁ : _ ≤ _, hω₂ : _ < _⟩,
+        exact (not_le.2 hω₂) hω₁ },
+      { exact (measurable_set_lt (finset.measurable_range_sup''
+          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) },
+      exacts [(hsub.integrable _).integrable_on, (hsub.integrable _).integrable_on,
+        integral_nonneg (hnonneg _), integral_nonneg (hnonneg _)] },
+    rwa [hadd, ennreal.add_le_add_iff_right ennreal.of_real_ne_top] at this },
+  calc ε • μ {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)}
+    + ennreal.of_real (∫ ω in {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ε},
+        f n ω ∂μ)
+    ≤ ennreal.of_real (∫ ω in {ω | (ε : ℝ) ≤ (range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)},
+        stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ)
+    + ennreal.of_real (∫ ω in {ω | ((range (n + 1)).sup' nonempty_range_succ (λ k, f k ω)) < ε},
+        stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ) :
+    begin
+      refine add_le_add (smul_le_stopped_value_hitting hsub _)
+        (ennreal.of_real_le_of_real (set_integral_mono_on (hsub.integrable n).integrable_on
+        (integrable.integrable_on (hsub.integrable_stopped_value
+          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le))
+        (measurable_set_lt (finset.measurable_range_sup''
+          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) _)),
+      intros ω hω,
+      rw set.mem_set_of_eq at hω,
+      have : hitting f {y : ℝ | ↑ε ≤ y} 0 n ω = n,
+      { simp only [hitting, set.mem_set_of_eq, exists_prop, pi.coe_nat, nat.cast_id,
+          ite_eq_right_iff, forall_exists_index, and_imp],
+        intros m hm hεm,
+        exact false.elim ((not_le.2 hω)
+          ((le_sup'_iff _).2 ⟨m, mem_range.2 (nat.lt_succ_of_le hm.2), hεm⟩)) },
+      simp_rw [stopped_value, this],
+    end
+    ... = ennreal.of_real (∫ ω, stopped_value f (hitting f {y : ℝ | ↑ε ≤ y} 0 n) ω ∂μ) :
+    begin
+      rw [← ennreal.of_real_add, ← integral_union],
+      { conv_rhs { rw ← integral_univ },
+        convert rfl,
+        ext ω,
+        change _ ↔ (ε : ℝ) ≤ _ ∨ _ < (ε : ℝ),
+        simp only [le_or_lt, iff_true] },
+      { rw disjoint_iff_inf_le,
+        rintro ω ⟨hω₁ : _ ≤ _, hω₂ : _ < _⟩,
+        exact (not_le.2 hω₂) hω₁ },
+      { exact (measurable_set_lt (finset.measurable_range_sup''
+          (λ n _, (hsub.strongly_measurable n).measurable.le (𝒢.le n))) measurable_const) },
+      { exact (integrable.integrable_on (hsub.integrable_stopped_value
+          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le)) },
+      { exact (integrable.integrable_on (hsub.integrable_stopped_value
+          (hitting_is_stopping_time hsub.adapted measurable_set_Ici) hitting_le)) },
+      exacts [integral_nonneg (λ x, hnonneg _ _), integral_nonneg (λ x, hnonneg _ _)],
+    end
+    ... ≤ ennreal.of_real (μ[f n]) :
+    begin
+      refine ennreal.of_real_le_of_real _,
+      rw ← stopped_value_const f n,
+      exact hsub.expected_stopped_value_mono
+        (hitting_is_stopping_time hsub.adapted measurable_set_Ici)
+        (is_stopping_time_const _ _) (λ ω, hitting_le ω) (λ ω, le_rfl : ∀ ω, n ≤ n),
+    end
+end
+
+end maximal
+
+end measure_theory
diff --git a/src/probability/martingale/upcrossing.lean b/src/probability/martingale/upcrossing.lean
new file mode 100644
index 0000000000000..8f0acc6e431a7
--- /dev/null
+++ b/src/probability/martingale/upcrossing.lean
@@ -0,0 +1,919 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying
+-/
+import data.set.intervals.monotone
+import probability.process.hitting_time
+import probability.martingale.basic
+
+/-!
+
+# Doob's upcrossing estimate
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a discrete real-valued submartingale $(f_n)_{n \in \mathbb{N}}$, denoting $U_N(a, b)$ the
+number of times $f_n$ crossed from below $a$ to above $b$ before time $N$, Doob's upcrossing
+estimate (also known as Doob's inequality) states that
+$$(b - a) \mathbb{E}[U_N(a, b)] \le \mathbb{E}[(f_N - a)^+].$$
+Doob's upcrossing estimate is an important inequality and is central in proving the martingale
+convergence theorems.
+
+## Main definitions
+
+* `measure_theory.upper_crossing_time a b f N n`: is the stopping time corresponding to `f`
+  crossing above `b` the `n`-th time before time `N` (if this does not occur then the value is
+  taken to be `N`).
+* `measure_theory.lower_crossing_time a b f N n`: is the stopping time corresponding to `f`
+  crossing below `a` the `n`-th time before time `N` (if this does not occur then the value is
+  taken to be `N`).
+* `measure_theory.upcrossing_strat a b f N`: is the predictable process which is 1 if `n` is
+  between a consecutive pair of lower and upper crossing and is 0 otherwise. Intuitively
+  one might think of the `upcrossing_strat` as the strategy of buying 1 share whenever the process
+  crosses below `a` for the first time after selling and selling 1 share whenever the process
+  crosses above `b` for the first time after buying.
+* `measure_theory.upcrossings_before a b f N`: is the number of times `f` crosses from below `a` to
+  above `b` before time `N`.
+* `measure_theory.upcrossings a b f`: is the number of times `f` crosses from below `a` to above
+  `b`. This takes value in `ℝ≥0∞` and so is allowed to be `∞`.
+
+## Main results
+
+* `measure_theory.adapted.is_stopping_time_upper_crossing_time`: `upper_crossing_time` is a
+  stopping time whenever the process it is associated to is adapted.
+* `measure_theory.adapted.is_stopping_time_lower_crossing_time`: `lower_crossing_time` is a
+  stopping time whenever the process it is associated to is adapted.
+* `measure_theory.submartingale.mul_integral_upcrossings_before_le_integral_pos_part`: Doob's
+  upcrossing estimate.
+* `measure_theory.submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part`: the inequality
+  obtained by taking the supremum on both sides of Doob's upcrossing estimate.
+
+### References
+
+We mostly follow the proof from [Kallenberg, *Foundations of modern probability*][kallenberg2021]
+
+-/
+
+open topological_space filter
+open_locale nnreal ennreal measure_theory probability_theory big_operators topology
+
+namespace measure_theory
+
+variables {Ω ι : Type*} {m0 : measurable_space Ω} {μ : measure Ω}
+
+/-!
+
+## Proof outline
+
+In this section, we will denote $U_N(a, b)$ the number of upcrossings of $(f_n)$ from below $a$ to
+above $b$ before time $N$.
+
+To define $U_N(a, b)$, we will construct two stopping times corresponding to when $(f_n)$ crosses
+below $a$ and above $b$. Namely, we define
+$$
+  \sigma_n := \inf \{n \ge \tau_n \mid f_n \le a\} \wedge N;
+$$
+$$
+  \tau_{n + 1} := \inf \{n \ge \sigma_n \mid f_n \ge b\} \wedge N.
+$$
+These are `lower_crossing_time` and `upper_crossing_time` in our formalization which are defined
+using `measure_theory.hitting` allowing us to specify a starting and ending time.
+Then, we may simply define $U_N(a, b) := \sup \{n \mid \tau_n < N\}$.
+
+Fixing $a < b \in \mathbb{R}$, we will first prove the theorem in the special case that
+$0 \le f_0$ and $a \le f_N$. In particular, we will show
+$$
+  (b - a) \mathbb{E}[U_N(a, b)] \le \mathbb{E}[f_N].
+$$
+This is `measure_theory.integral_mul_upcrossings_before_le_integral` in our formalization.
+
+To prove this, we use the fact that given a non-negative, bounded, predictable process $(C_n)$
+(i.e. $(C_{n + 1})$ is adapted), $(C \bullet f)_n := \sum_{k \le n} C_{k + 1}(f_{k + 1} - f_k)$ is
+a submartingale if $(f_n)$ is.
+
+Define $C_n := \sum_{k \le n} \mathbf{1}_{[\sigma_k, \tau_{k + 1})}(n)$. It is easy to see that
+$(1 - C_n)$ is non-negative, bounded and predictable, and hence, given a submartingale $(f_n)$,
+$(1 - C) \bullet f$ is also a submartingale. Thus, by the submartingale property,
+$0 \le \mathbb{E}[((1 - C) \bullet f)_0] \le \mathbb{E}[((1 - C) \bullet f)_N]$ implying
+$$
+  \mathbb{E}[(C \bullet f)_N] \le \mathbb{E}[(1 \bullet f)_N] = \mathbb{E}[f_N] - \mathbb{E}[f_0].
+$$
+
+Furthermore,
+\begin{align}
+    (C \bullet f)_N & =
+      \sum_{n \le N} \sum_{k \le N} \mathbf{1}_{[\sigma_k, \tau_{k + 1})}(n)(f_{n + 1} - f_n)\\
+    & = \sum_{k \le N} \sum_{n \le N} \mathbf{1}_{[\sigma_k, \tau_{k + 1})}(n)(f_{n + 1} - f_n)\\
+    & = \sum_{k \le N} (f_{\sigma_k + 1} - f_{\sigma_k} + f_{\sigma_k + 2} - f_{\sigma_k + 1}
+      + \cdots + f_{\tau_{k + 1}} - f_{\tau_{k + 1} - 1})\\
+    & = \sum_{k \le N} (f_{\tau_{k + 1}} - f_{\sigma_k})
+      \ge \sum_{k < U_N(a, b)} (b - a) = (b - a) U_N(a, b)
+\end{align}
+where the inequality follows since for all $k < U_N(a, b)$,
+$f_{\tau_{k + 1}} - f_{\sigma_k} \ge b - a$ while for all $k > U_N(a, b)$,
+$f_{\tau_{k + 1}} = f_{\sigma_k} = f_N$ and
+$f_{\tau_{U_N(a, b) + 1}} - f_{\sigma_{U_N(a, b)}} = f_N - a \ge 0$. Hence, we have
+$$
+  (b - a) \mathbb{E}[U_N(a, b)] \le \mathbb{E}[(C \bullet f)_N]
+  \le \mathbb{E}[f_N] - \mathbb{E}[f_0] \le \mathbb{E}[f_N],
+$$
+as required.
+
+To obtain the general case, we simply apply the above to $((f_n - a)^+)_n$.
+
+-/
+
+/-- `lower_crossing_time_aux a f c N` is the first time `f` reached below `a` after time `c` before
+time `N`. -/
+noncomputable
+def lower_crossing_time_aux [preorder ι] [has_Inf ι] (a : ℝ) (f : ι → Ω → ℝ) (c N : ι) : Ω → ι :=
+hitting f (set.Iic a) c N
+
+/-- `upper_crossing_time a b f N n` is the first time before time `N`, `f` reaches
+above `b` after `f` reached below `a` for the `n - 1`-th time. -/
+noncomputable
+def upper_crossing_time [preorder ι] [order_bot ι] [has_Inf ι]
+  (a b : ℝ) (f : ι → Ω → ℝ) (N : ι) : ℕ → Ω → ι
+| 0 := ⊥
+| (n + 1) := λ ω, hitting f (set.Ici b)
+    (lower_crossing_time_aux a f (upper_crossing_time n ω) N ω) N ω
+
+/-- `lower_crossing_time a b f N n` is the first time before time `N`, `f` reaches
+below `a` after `f` reached above `b` for the `n`-th time. -/
+noncomputable
+def lower_crossing_time [preorder ι] [order_bot ι] [has_Inf ι]
+  (a b : ℝ) (f : ι → Ω → ℝ) (N : ι) (n : ℕ) : Ω → ι :=
+λ ω, hitting f (set.Iic a) (upper_crossing_time a b f N n ω) N ω
+
+section
+
+variables [preorder ι] [order_bot ι] [has_Inf ι]
+variables {a b : ℝ} {f : ι → Ω → ℝ} {N : ι} {n m : ℕ} {ω : Ω}
+
+@[simp]
+lemma upper_crossing_time_zero : upper_crossing_time a b f N 0 = ⊥ := rfl
+
+@[simp]
+lemma lower_crossing_time_zero : lower_crossing_time a b f N 0 = hitting f (set.Iic a) ⊥ N := rfl
+
+lemma upper_crossing_time_succ :
+  upper_crossing_time a b f N (n + 1) ω =
+  hitting f (set.Ici b) (lower_crossing_time_aux a f (upper_crossing_time a b f N n ω) N ω) N ω :=
+by rw upper_crossing_time
+
+lemma upper_crossing_time_succ_eq (ω : Ω) :
+  upper_crossing_time a b f N (n + 1) ω =
+  hitting f (set.Ici b) (lower_crossing_time a b f N n ω) N ω :=
+begin
+  simp only [upper_crossing_time_succ],
+  refl,
+end
+
+end
+
+section conditionally_complete_linear_order_bot
+
+variables [conditionally_complete_linear_order_bot ι]
+variables {a b : ℝ} {f : ι → Ω → ℝ} {N : ι} {n m : ℕ} {ω : Ω}
+
+lemma upper_crossing_time_le : upper_crossing_time a b f N n ω ≤ N :=
+begin
+  cases n,
+  { simp only [upper_crossing_time_zero, pi.bot_apply, bot_le] },
+  { simp only [upper_crossing_time_succ, hitting_le] },
+end
+
+@[simp]
+lemma upper_crossing_time_zero' : upper_crossing_time a b f ⊥ n ω = ⊥ :=
+eq_bot_iff.2 upper_crossing_time_le
+
+lemma lower_crossing_time_le : lower_crossing_time a b f N n ω ≤ N :=
+by simp only [lower_crossing_time, hitting_le ω]
+
+lemma upper_crossing_time_le_lower_crossing_time :
+  upper_crossing_time a b f N n ω ≤ lower_crossing_time a b f N n ω :=
+by simp only [lower_crossing_time, le_hitting upper_crossing_time_le ω]
+
+lemma lower_crossing_time_le_upper_crossing_time_succ :
+  lower_crossing_time a b f N n ω ≤ upper_crossing_time a b f N (n + 1) ω :=
+begin
+  rw upper_crossing_time_succ,
+  exact le_hitting lower_crossing_time_le ω,
+end
+
+lemma lower_crossing_time_mono (hnm : n ≤ m) :
+  lower_crossing_time a b f N n ω ≤ lower_crossing_time a b f N m ω :=
+begin
+  suffices : monotone (λ n, lower_crossing_time a b f N n ω),
+  { exact this hnm },
+  exact monotone_nat_of_le_succ
+    (λ n, le_trans lower_crossing_time_le_upper_crossing_time_succ
+    upper_crossing_time_le_lower_crossing_time)
+end
+
+lemma upper_crossing_time_mono (hnm : n ≤ m) :
+  upper_crossing_time a b f N n ω ≤ upper_crossing_time a b f N m ω :=
+begin
+  suffices : monotone (λ n, upper_crossing_time a b f N n ω),
+  { exact this hnm },
+  exact monotone_nat_of_le_succ
+    (λ n, le_trans upper_crossing_time_le_lower_crossing_time
+    lower_crossing_time_le_upper_crossing_time_succ),
+end
+
+end conditionally_complete_linear_order_bot
+
+variables {a b : ℝ} {f : ℕ → Ω → ℝ} {N : ℕ} {n m : ℕ} {ω : Ω}
+
+lemma stopped_value_lower_crossing_time (h : lower_crossing_time a b f N n ω ≠ N) :
+  stopped_value f (lower_crossing_time a b f N n) ω ≤ a :=
+begin
+  obtain ⟨j, hj₁, hj₂⟩ :=
+    (hitting_le_iff_of_lt _ (lt_of_le_of_ne lower_crossing_time_le h)).1 le_rfl,
+  exact stopped_value_hitting_mem ⟨j, ⟨hj₁.1, le_trans hj₁.2 lower_crossing_time_le⟩, hj₂⟩,
+end
+
+lemma stopped_value_upper_crossing_time (h : upper_crossing_time a b f N (n + 1) ω ≠ N) :
+  b ≤ stopped_value f (upper_crossing_time a b f N (n + 1)) ω :=
+begin
+  obtain ⟨j, hj₁, hj₂⟩ :=
+    (hitting_le_iff_of_lt _ (lt_of_le_of_ne upper_crossing_time_le h)).1 le_rfl,
+  exact stopped_value_hitting_mem ⟨j, ⟨hj₁.1, le_trans hj₁.2 (hitting_le _)⟩, hj₂⟩,
+end
+
+lemma upper_crossing_time_lt_lower_crossing_time
+  (hab : a < b) (hn : lower_crossing_time a b f N (n + 1) ω ≠ N) :
+  upper_crossing_time a b f N (n + 1) ω < lower_crossing_time a b f N (n + 1) ω :=
+begin
+  refine lt_of_le_of_ne upper_crossing_time_le_lower_crossing_time
+    (λ h, not_le.2 hab $ le_trans _ (stopped_value_lower_crossing_time hn)),
+  simp only [stopped_value],
+  rw ← h,
+  exact stopped_value_upper_crossing_time (h.symm ▸ hn),
+end
+
+lemma lower_crossing_time_lt_upper_crossing_time
+  (hab : a < b) (hn : upper_crossing_time a b f N (n + 1) ω ≠ N) :
+  lower_crossing_time a b f N n ω < upper_crossing_time a b f N (n + 1) ω :=
+begin
+  refine lt_of_le_of_ne lower_crossing_time_le_upper_crossing_time_succ
+    (λ h, not_le.2 hab $ le_trans (stopped_value_upper_crossing_time hn) _),
+  simp only [stopped_value],
+  rw ← h,
+  exact stopped_value_lower_crossing_time (h.symm ▸ hn),
+end
+
+lemma upper_crossing_time_lt_succ (hab : a < b) (hn : upper_crossing_time a b f N (n + 1) ω ≠ N) :
+  upper_crossing_time a b f N n ω < upper_crossing_time a b f N (n + 1) ω :=
+lt_of_le_of_lt upper_crossing_time_le_lower_crossing_time
+  (lower_crossing_time_lt_upper_crossing_time hab hn)
+
+lemma lower_crossing_time_stabilize (hnm : n ≤ m) (hn : lower_crossing_time a b f N n ω = N) :
+  lower_crossing_time a b f N m ω = N :=
+le_antisymm lower_crossing_time_le (le_trans (le_of_eq hn.symm) (lower_crossing_time_mono hnm))
+
+lemma upper_crossing_time_stabilize (hnm : n ≤ m) (hn : upper_crossing_time a b f N n ω = N) :
+  upper_crossing_time a b f N m ω = N :=
+le_antisymm upper_crossing_time_le (le_trans (le_of_eq hn.symm) (upper_crossing_time_mono hnm))
+
+lemma lower_crossing_time_stabilize' (hnm : n ≤ m) (hn : N ≤ lower_crossing_time a b f N n ω) :
+  lower_crossing_time a b f N m ω = N :=
+lower_crossing_time_stabilize hnm (le_antisymm lower_crossing_time_le hn)
+
+lemma upper_crossing_time_stabilize' (hnm : n ≤ m) (hn : N ≤ upper_crossing_time a b f N n ω) :
+  upper_crossing_time a b f N m ω = N :=
+upper_crossing_time_stabilize hnm (le_antisymm upper_crossing_time_le hn)
+
+-- `upper_crossing_time_bound_eq` provides an explicit bound
+lemma exists_upper_crossing_time_eq (f : ℕ → Ω → ℝ) (N : ℕ) (ω : Ω) (hab : a < b) :
+  ∃ n, upper_crossing_time a b f N n ω = N :=
+begin
+  by_contra h, push_neg at h,
+  have : strict_mono (λ n, upper_crossing_time a b f N n ω) :=
+    strict_mono_nat_of_lt_succ (λ n, upper_crossing_time_lt_succ hab (h _)),
+  obtain ⟨_, ⟨k, rfl⟩, hk⟩ :
+    ∃ m (hm : m ∈ set.range (λ n, upper_crossing_time a b f N n ω)), N < m :=
+    ⟨upper_crossing_time a b f N (N + 1) ω, ⟨N + 1, rfl⟩,
+      lt_of_lt_of_le (N.lt_succ_self) (strict_mono.id_le this (N + 1))⟩,
+  exact not_le.2 hk upper_crossing_time_le
+end
+
+lemma upper_crossing_time_lt_bdd_above (hab : a < b) :
+  bdd_above {n | upper_crossing_time a b f N n ω < N} :=
+begin
+  obtain ⟨k, hk⟩ := exists_upper_crossing_time_eq f N ω hab,
+  refine ⟨k, λ n (hn : upper_crossing_time a b f N n ω < N), _⟩,
+  by_contra hn',
+  exact hn.ne (upper_crossing_time_stabilize (not_le.1 hn').le hk)
+end
+
+lemma upper_crossing_time_lt_nonempty (hN : 0 < N) :
+  {n | upper_crossing_time a b f N n ω < N}.nonempty :=
+⟨0, hN⟩
+
+lemma upper_crossing_time_bound_eq (f : ℕ → Ω → ℝ) (N : ℕ) (ω : Ω) (hab : a < b) :
+  upper_crossing_time a b f N N ω = N :=
+begin
+  by_cases hN' : N < nat.find (exists_upper_crossing_time_eq f N ω hab),
+  { refine le_antisymm upper_crossing_time_le _,
+    have hmono : strict_mono_on (λ n, upper_crossing_time a b f N n ω)
+      (set.Iic (nat.find (exists_upper_crossing_time_eq f N ω hab)).pred),
+    { refine strict_mono_on_Iic_of_lt_succ (λ m hm, upper_crossing_time_lt_succ hab _),
+      rw nat.lt_pred_iff at hm,
+      convert nat.find_min _ hm },
+    convert strict_mono_on.Iic_id_le hmono N (nat.le_pred_of_lt hN') },
+  { rw not_lt at hN',
+    exact upper_crossing_time_stabilize hN'
+      (nat.find_spec (exists_upper_crossing_time_eq f N ω hab)) }
+end
+
+lemma upper_crossing_time_eq_of_bound_le (hab : a < b) (hn : N ≤ n) :
+  upper_crossing_time a b f N n ω = N :=
+le_antisymm upper_crossing_time_le
+  ((le_trans (upper_crossing_time_bound_eq f N ω hab).symm.le (upper_crossing_time_mono hn)))
+
+variables {ℱ : filtration ℕ m0}
+
+lemma adapted.is_stopping_time_crossing (hf : adapted ℱ f) :
+  is_stopping_time ℱ (upper_crossing_time a b f N n) ∧
+  is_stopping_time ℱ (lower_crossing_time a b f N n) :=
+begin
+  induction n with k ih,
+  { refine ⟨is_stopping_time_const _ 0, _⟩,
+    simp [hitting_is_stopping_time hf measurable_set_Iic] },
+  { obtain ⟨ih₁, ih₂⟩ := ih,
+    have : is_stopping_time ℱ (upper_crossing_time a b f N (k + 1)),
+    { intro n,
+      simp_rw upper_crossing_time_succ_eq,
+      exact is_stopping_time_hitting_is_stopping_time ih₂ (λ _, lower_crossing_time_le)
+        measurable_set_Ici hf _ },
+    refine ⟨this, _⟩,
+    { intro n,
+      exact is_stopping_time_hitting_is_stopping_time this (λ _, upper_crossing_time_le)
+        measurable_set_Iic hf _ } }
+end
+
+lemma adapted.is_stopping_time_upper_crossing_time (hf : adapted ℱ f) :
+  is_stopping_time ℱ (upper_crossing_time a b f N n) :=
+hf.is_stopping_time_crossing.1
+
+lemma adapted.is_stopping_time_lower_crossing_time (hf : adapted ℱ f) :
+  is_stopping_time ℱ (lower_crossing_time a b f N n) :=
+hf.is_stopping_time_crossing.2
+
+/-- `upcrossing_strat a b f N n` is 1 if `n` is between a consecutive pair of lower and upper
+crossings and is 0 otherwise. `upcrossing_strat` is shifted by one index so that it is adapted
+rather than predictable. -/
+noncomputable
+def upcrossing_strat (a b : ℝ) (f : ℕ → Ω → ℝ) (N n : ℕ) (ω : Ω) : ℝ :=
+∑ k in finset.range N,
+  (set.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω)).indicator 1 n
+
+lemma upcrossing_strat_nonneg : 0 ≤ upcrossing_strat a b f N n ω :=
+finset.sum_nonneg (λ i hi, set.indicator_nonneg (λ ω hω, zero_le_one) _)
+
+lemma upcrossing_strat_le_one : upcrossing_strat a b f N n ω ≤ 1 :=
+begin
+  rw [upcrossing_strat, ← set.indicator_finset_bUnion_apply],
+  { exact set.indicator_le_self' (λ _ _, zero_le_one) _ },
+  { intros i hi j hj hij,
+    rw set.Ico_disjoint_Ico,
+    obtain (hij' | hij') := lt_or_gt_of_ne hij,
+    { rw [min_eq_left ((upper_crossing_time_mono (nat.succ_le_succ hij'.le)) :
+          upper_crossing_time a b f N _ ω ≤ upper_crossing_time a b f N _ ω),
+          max_eq_right (lower_crossing_time_mono hij'.le :
+          lower_crossing_time a b f N _ _ ≤ lower_crossing_time _ _ _ _ _ _)],
+      refine le_trans upper_crossing_time_le_lower_crossing_time (lower_crossing_time_mono
+        (nat.succ_le_of_lt hij')) },
+    { rw gt_iff_lt at hij',
+      rw [min_eq_right ((upper_crossing_time_mono (nat.succ_le_succ hij'.le)) :
+          upper_crossing_time a b f N _ ω ≤ upper_crossing_time a b f N _ ω),
+          max_eq_left (lower_crossing_time_mono hij'.le :
+          lower_crossing_time a b f N _ _ ≤ lower_crossing_time _ _ _ _ _ _)],
+      refine le_trans upper_crossing_time_le_lower_crossing_time
+        (lower_crossing_time_mono (nat.succ_le_of_lt hij')) } }
+end
+
+lemma adapted.upcrossing_strat_adapted (hf : adapted ℱ f) :
+  adapted ℱ (upcrossing_strat a b f N) :=
+begin
+  intro n,
+  change strongly_measurable[ℱ n] (λ ω, ∑ k in finset.range N,
+    ({n | lower_crossing_time a b f N k ω ≤ n} ∩
+     {n | n < upper_crossing_time a b f N (k + 1) ω}).indicator 1 n),
+  refine finset.strongly_measurable_sum _ (λ i hi,
+    strongly_measurable_const.indicator ((hf.is_stopping_time_lower_crossing_time n).inter _)),
+  simp_rw ← not_le,
+  exact (hf.is_stopping_time_upper_crossing_time n).compl,
+end
+
+lemma submartingale.sum_upcrossing_strat_mul [is_finite_measure μ] (hf : submartingale f ℱ μ)
+  (a b : ℝ) (N : ℕ) :
+  submartingale
+    (λ n : ℕ, ∑ k in finset.range n, upcrossing_strat a b f N k * (f (k + 1) - f k)) ℱ μ :=
+hf.sum_mul_sub hf.adapted.upcrossing_strat_adapted
+  (λ _ _, upcrossing_strat_le_one) (λ _ _, upcrossing_strat_nonneg)
+
+lemma submartingale.sum_sub_upcrossing_strat_mul [is_finite_measure μ] (hf : submartingale f ℱ μ)
+  (a b : ℝ) (N : ℕ) :
+  submartingale
+    (λ n : ℕ, ∑ k in finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)) ℱ μ :=
+begin
+  refine hf.sum_mul_sub (λ n, (adapted_const ℱ 1 n).sub (hf.adapted.upcrossing_strat_adapted n))
+    (_ : ∀ n ω, (1 - upcrossing_strat a b f N n) ω ≤ 1) _,
+  { exact λ n ω, sub_le_self _ upcrossing_strat_nonneg },
+  { intros n ω,
+    simp [upcrossing_strat_le_one] }
+end
+
+lemma submartingale.sum_mul_upcrossing_strat_le [is_finite_measure μ] (hf : submartingale f ℱ μ) :
+  μ[∑ k in finset.range n, upcrossing_strat a b f N k * (f (k + 1) - f k)] ≤
+  μ[f n] - μ[f 0] :=
+begin
+  have h₁ : (0 : ℝ) ≤
+    μ[∑ k in finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)],
+  { have := (hf.sum_sub_upcrossing_strat_mul a b N).set_integral_le (zero_le n) measurable_set.univ,
+    rw [integral_univ, integral_univ] at this,
+    refine le_trans _ this,
+    simp only [finset.range_zero, finset.sum_empty, integral_zero'] },
+  have h₂ : μ[∑ k in finset.range n, (1 - upcrossing_strat a b f N k) * (f (k + 1) - f k)] =
+    μ[∑ k in finset.range n, (f (k + 1) - f k)] -
+    μ[∑ k in finset.range n, upcrossing_strat a b f N k * (f (k + 1) - f k)],
+  { simp only [sub_mul, one_mul, finset.sum_sub_distrib, pi.sub_apply,
+      finset.sum_apply, pi.mul_apply],
+    refine integral_sub (integrable.sub (integrable_finset_sum _ (λ i hi, hf.integrable _))
+      (integrable_finset_sum _ (λ i hi, hf.integrable _))) _,
+    convert (hf.sum_upcrossing_strat_mul a b N).integrable n,
+    ext, simp },
+  rw [h₂, sub_nonneg] at h₁,
+  refine le_trans h₁ _,
+  simp_rw [finset.sum_range_sub, integral_sub' (hf.integrable _) (hf.integrable _)],
+end
+
+/-- The number of upcrossings (strictly) before time `N`. -/
+noncomputable
+def upcrossings_before [preorder ι] [order_bot ι] [has_Inf ι]
+  (a b : ℝ) (f : ι → Ω → ℝ) (N : ι) (ω : Ω) : ℕ :=
+Sup {n | upper_crossing_time a b f N n ω < N}
+
+@[simp]
+lemma upcrossings_before_bot [preorder ι] [order_bot ι] [has_Inf ι]
+  {a b : ℝ} {f : ι → Ω → ℝ} {ω : Ω} :
+  upcrossings_before a b f ⊥ ω = ⊥ :=
+by simp [upcrossings_before]
+
+lemma upcrossings_before_zero :
+  upcrossings_before a b f 0 ω = 0 :=
+by simp [upcrossings_before]
+
+@[simp] lemma upcrossings_before_zero' :
+  upcrossings_before a b f 0 = 0 :=
+by { ext ω, exact upcrossings_before_zero }
+
+lemma upper_crossing_time_lt_of_le_upcrossings_before
+  (hN : 0 < N) (hab : a < b) (hn : n ≤ upcrossings_before a b f N ω) :
+  upper_crossing_time a b f N n ω < N :=
+begin
+  have : upper_crossing_time a b f N (upcrossings_before a b f N ω) ω < N :=
+    (upper_crossing_time_lt_nonempty hN).cSup_mem
+    ((order_bot.bdd_below _).finite_of_bdd_above (upper_crossing_time_lt_bdd_above hab)),
+  exact lt_of_le_of_lt (upper_crossing_time_mono hn) this,
+end
+
+lemma upper_crossing_time_eq_of_upcrossings_before_lt
+  (hab : a < b) (hn : upcrossings_before a b f N ω < n) :
+  upper_crossing_time a b f N n ω = N :=
+begin
+  refine le_antisymm upper_crossing_time_le (not_lt.1 _),
+  convert not_mem_of_cSup_lt hn (upper_crossing_time_lt_bdd_above hab),
+end
+
+lemma upcrossings_before_le (f : ℕ → Ω → ℝ) (ω : Ω) (hab : a < b) :
+  upcrossings_before a b f N ω ≤ N :=
+begin
+  by_cases hN : N = 0,
+  { subst hN,
+    rw upcrossings_before_zero },
+  { refine cSup_le ⟨0, zero_lt_iff.2 hN⟩ (λ n (hn : _ < _), _),
+    by_contra hnN,
+    exact hn.ne (upper_crossing_time_eq_of_bound_le hab (not_le.1 hnN).le) },
+end
+
+lemma crossing_eq_crossing_of_lower_crossing_time_lt {M : ℕ} (hNM : N ≤ M)
+  (h : lower_crossing_time a b f N n ω < N) :
+  upper_crossing_time a b f M n ω = upper_crossing_time a b f N n ω ∧
+  lower_crossing_time a b f M n ω = lower_crossing_time a b f N n ω :=
+begin
+  have h' : upper_crossing_time a b f N n ω < N :=
+    lt_of_le_of_lt upper_crossing_time_le_lower_crossing_time h,
+  induction n with k ih,
+  { simp only [nat.nat_zero_eq_zero, upper_crossing_time_zero, bot_eq_zero', eq_self_iff_true,
+      lower_crossing_time_zero, true_and, eq_comm],
+    refine hitting_eq_hitting_of_exists hNM _,
+    simp only [lower_crossing_time, hitting_lt_iff] at h,
+    obtain ⟨j, hj₁, hj₂⟩ := h,
+    exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩ },
+  { specialize ih (lt_of_le_of_lt (lower_crossing_time_mono (nat.le_succ _)) h)
+      (lt_of_le_of_lt (upper_crossing_time_mono (nat.le_succ _)) h'),
+    have : upper_crossing_time a b f M k.succ ω = upper_crossing_time a b f N k.succ ω,
+    { simp only [upper_crossing_time_succ_eq, hitting_lt_iff] at h' ⊢,
+      obtain ⟨j, hj₁, hj₂⟩ := h',
+      rw [eq_comm, ih.2],
+      exact hitting_eq_hitting_of_exists hNM ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩ },
+    refine ⟨this, _⟩,
+    simp only [lower_crossing_time, eq_comm, this],
+    refine hitting_eq_hitting_of_exists hNM _,
+    rw [lower_crossing_time, hitting_lt_iff _ le_rfl] at h,
+    swap, { apply_instance },
+    obtain ⟨j, hj₁, hj₂⟩ := h,
+    exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩ }
+end
+
+lemma crossing_eq_crossing_of_upper_crossing_time_lt {M : ℕ} (hNM : N ≤ M)
+  (h : upper_crossing_time a b f N (n + 1) ω < N) :
+  upper_crossing_time a b f M (n + 1) ω = upper_crossing_time a b f N (n + 1) ω ∧
+  lower_crossing_time a b f M n ω = lower_crossing_time a b f N n ω :=
+begin
+  have := (crossing_eq_crossing_of_lower_crossing_time_lt hNM
+    (lt_of_le_of_lt lower_crossing_time_le_upper_crossing_time_succ h)).2,
+  refine ⟨_, this⟩,
+  rw [upper_crossing_time_succ_eq, upper_crossing_time_succ_eq, eq_comm, this],
+  refine hitting_eq_hitting_of_exists hNM _,
+  simp only [upper_crossing_time_succ_eq, hitting_lt_iff] at h,
+  obtain ⟨j, hj₁, hj₂⟩ := h,
+  exact ⟨j, ⟨hj₁.1, hj₁.2.le⟩, hj₂⟩
+end
+
+lemma upper_crossing_time_eq_upper_crossing_time_of_lt {M : ℕ} (hNM : N ≤ M)
+  (h : upper_crossing_time a b f N n ω < N) :
+  upper_crossing_time a b f M n ω = upper_crossing_time a b f N n ω :=
+begin
+  cases n,
+  { simp },
+  { exact (crossing_eq_crossing_of_upper_crossing_time_lt hNM h).1 }
+end
+
+lemma upcrossings_before_mono (hab : a < b) :
+  monotone (λ N ω, upcrossings_before a b f N ω) :=
+begin
+  intros N M hNM ω,
+  simp only [upcrossings_before],
+  by_cases hemp : {n : ℕ | upper_crossing_time a b f N n ω < N}.nonempty,
+  { refine cSup_le_cSup (upper_crossing_time_lt_bdd_above hab) hemp (λ n hn, _),
+    rw [set.mem_set_of_eq, upper_crossing_time_eq_upper_crossing_time_of_lt hNM hn],
+    exact lt_of_lt_of_le hn hNM },
+  { rw set.not_nonempty_iff_eq_empty at hemp,
+    simp [hemp, cSup_empty, bot_eq_zero', zero_le'] }
+end
+
+lemma upcrossings_before_lt_of_exists_upcrossing (hab : a < b) {N₁ N₂ : ℕ}
+  (hN₁: N ≤ N₁) (hN₁': f N₁ ω < a) (hN₂: N₁ ≤ N₂) (hN₂': b < f N₂ ω) :
+  upcrossings_before a b f N ω < upcrossings_before a b f (N₂ + 1) ω :=
+begin
+  refine lt_of_lt_of_le (nat.lt_succ_self _) (le_cSup (upper_crossing_time_lt_bdd_above hab) _),
+  rw [set.mem_set_of_eq, upper_crossing_time_succ_eq, hitting_lt_iff _ le_rfl],
+  swap,
+  { apply_instance },
+  { refine ⟨N₂, ⟨_, nat.lt_succ_self _⟩, hN₂'.le⟩,
+    rw [lower_crossing_time, hitting_le_iff_of_lt _ (nat.lt_succ_self _)],
+    refine ⟨N₁, ⟨le_trans _ hN₁, hN₂⟩, hN₁'.le⟩,
+    by_cases hN : 0 < N,
+    { have : upper_crossing_time a b f N (upcrossings_before a b f N ω) ω < N :=
+        nat.Sup_mem (upper_crossing_time_lt_nonempty hN) (upper_crossing_time_lt_bdd_above hab),
+      rw upper_crossing_time_eq_upper_crossing_time_of_lt
+        (hN₁.trans (hN₂.trans $ nat.le_succ _)) this,
+      exact this.le },
+    { rw [not_lt, le_zero_iff] at hN,
+      rw [hN, upcrossings_before_zero, upper_crossing_time_zero],
+      refl } },
+end
+
+lemma lower_crossing_time_lt_of_lt_upcrossings_before
+  (hN : 0 < N) (hab : a < b) (hn : n < upcrossings_before a b f N ω) :
+  lower_crossing_time a b f N n ω < N :=
+lt_of_le_of_lt lower_crossing_time_le_upper_crossing_time_succ
+  (upper_crossing_time_lt_of_le_upcrossings_before hN hab hn)
+
+lemma le_sub_of_le_upcrossings_before
+  (hN : 0 < N) (hab : a < b) (hn : n < upcrossings_before a b f N ω) :
+  b - a ≤
+  stopped_value f (upper_crossing_time a b f N (n + 1)) ω -
+  stopped_value f (lower_crossing_time a b f N n) ω :=
+sub_le_sub (stopped_value_upper_crossing_time
+  (upper_crossing_time_lt_of_le_upcrossings_before hN hab hn).ne)
+  (stopped_value_lower_crossing_time (lower_crossing_time_lt_of_lt_upcrossings_before hN hab hn).ne)
+
+lemma sub_eq_zero_of_upcrossings_before_lt (hab : a < b) (hn : upcrossings_before a b f N ω < n) :
+  stopped_value f (upper_crossing_time a b f N (n + 1)) ω -
+  stopped_value f (lower_crossing_time a b f N n) ω = 0 :=
+begin
+  have : N ≤ upper_crossing_time a b f N n ω,
+  { rw upcrossings_before at hn,
+    rw ← not_lt,
+    exact λ h, not_le.2 hn (le_cSup (upper_crossing_time_lt_bdd_above hab) h) },
+  simp [stopped_value, upper_crossing_time_stabilize' (nat.le_succ n) this,
+    lower_crossing_time_stabilize' le_rfl
+      (le_trans this upper_crossing_time_le_lower_crossing_time)]
+end
+
+lemma mul_upcrossings_before_le (hf : a ≤ f N ω) (hab : a < b) :
+  (b - a) * upcrossings_before a b f N ω ≤
+  ∑ k in finset.range N, upcrossing_strat a b f N k ω * (f (k + 1) - f k) ω :=
+begin
+  classical,
+  by_cases hN : N = 0,
+  { simp [hN] },
+  simp_rw [upcrossing_strat, finset.sum_mul, ← set.indicator_mul_left, pi.one_apply,
+    pi.sub_apply, one_mul],
+  rw finset.sum_comm,
+  have h₁ : ∀ k, ∑ n in finset.range N,
+    (set.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω)).indicator
+    (λ m, f (m + 1) ω - f m ω) n =
+    stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
+    stopped_value f (lower_crossing_time a b f N k) ω,
+  { intro k,
+    rw [finset.sum_indicator_eq_sum_filter, (_ : (finset.filter
+      (λ i, i ∈ set.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω))
+      (finset.range N)) =
+      finset.Ico (lower_crossing_time a b f N k ω) (upper_crossing_time a b f N (k + 1) ω)),
+      finset.sum_Ico_eq_add_neg _ lower_crossing_time_le_upper_crossing_time_succ,
+      finset.sum_range_sub (λ n, f n ω), finset.sum_range_sub (λ n, f n ω), neg_sub,
+      sub_add_sub_cancel],
+    { refl },
+    { ext i,
+      simp only [set.mem_Ico, finset.mem_filter, finset.mem_range, finset.mem_Ico,
+        and_iff_right_iff_imp, and_imp],
+      exact λ _ h, lt_of_lt_of_le h upper_crossing_time_le } },
+  simp_rw [h₁],
+  have h₂ : ∑ k in finset.range (upcrossings_before a b f N ω), (b - a) ≤
+    ∑ k in finset.range N,
+    (stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
+    stopped_value f (lower_crossing_time a b f N k) ω),
+  { calc ∑ k in finset.range (upcrossings_before a b f N ω), (b - a)
+       ≤ ∑ k in finset.range (upcrossings_before a b f N ω),
+          (stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
+           stopped_value f (lower_crossing_time a b f N k) ω) :
+    begin
+      refine finset.sum_le_sum (λ i hi, le_sub_of_le_upcrossings_before (zero_lt_iff.2 hN) hab _),
+      rwa finset.mem_range at hi,
+    end
+    ...≤ ∑ k in finset.range N,
+          (stopped_value f (upper_crossing_time a b f N (k + 1)) ω -
+           stopped_value f (lower_crossing_time a b f N k) ω) :
+    begin
+      refine finset.sum_le_sum_of_subset_of_nonneg
+        (finset.range_subset.2 (upcrossings_before_le f ω hab)) (λ i _ hi, _),
+      by_cases hi' : i = upcrossings_before a b f N ω,
+      { subst hi',
+        simp only [stopped_value],
+        rw upper_crossing_time_eq_of_upcrossings_before_lt hab (nat.lt_succ_self _),
+        by_cases heq : lower_crossing_time a b f N (upcrossings_before a b f N ω) ω = N,
+        { rw [heq, sub_self] },
+        { rw sub_nonneg,
+          exact le_trans (stopped_value_lower_crossing_time heq) hf } },
+      { rw sub_eq_zero_of_upcrossings_before_lt hab,
+        rw [finset.mem_range, not_lt] at hi,
+        exact lt_of_le_of_ne hi (ne.symm hi') },
+    end },
+  refine le_trans _ h₂,
+  rw [finset.sum_const, finset.card_range, nsmul_eq_mul, mul_comm],
+end
+
+lemma integral_mul_upcrossings_before_le_integral [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hfN : ∀ ω, a ≤ f N ω) (hfzero : 0 ≤ f 0)  (hab : a < b) :
+  (b - a) * μ[upcrossings_before a b f N] ≤ μ[f N] :=
+calc (b - a) * μ[upcrossings_before a b f N]
+    ≤ μ[∑ k in finset.range N, upcrossing_strat a b f N k * (f (k + 1) - f k)] :
+begin
+  rw ← integral_mul_left,
+  refine integral_mono_of_nonneg _ ((hf.sum_upcrossing_strat_mul a b N).integrable N) _,
+  { exact eventually_of_forall (λ ω, mul_nonneg (sub_nonneg.2 hab.le) (nat.cast_nonneg _)) },
+  { refine eventually_of_forall (λ ω, _),
+    simpa using mul_upcrossings_before_le (hfN ω) hab },
+end
+  ...≤ μ[f N] - μ[f 0] : hf.sum_mul_upcrossing_strat_le
+  ...≤ μ[f N] : (sub_le_self_iff _).2 (integral_nonneg hfzero)
+
+lemma crossing_pos_eq (hab : a < b) :
+  upper_crossing_time 0 (b - a) (λ n ω, (f n ω - a)⁺) N n = upper_crossing_time a b f N n ∧
+  lower_crossing_time 0 (b - a) (λ n ω, (f n ω - a)⁺) N n = lower_crossing_time a b f N n :=
+begin
+  have hab' : 0 < b - a := sub_pos.2 hab,
+  have hf : ∀ ω i, b - a ≤ (f i ω - a)⁺ ↔ b ≤ f i ω,
+  { intros i ω,
+    refine ⟨λ h, _, λ h, _⟩,
+    { rwa [← sub_le_sub_iff_right a,
+        ← lattice_ordered_comm_group.pos_eq_self_of_pos_pos (lt_of_lt_of_le hab' h)] },
+    { rw ← sub_le_sub_iff_right a at h,
+      rwa lattice_ordered_comm_group.pos_of_nonneg _ (le_trans hab'.le h) } },
+  have hf' : ∀ ω i, (f i ω - a)⁺ ≤ 0 ↔ f i ω ≤ a,
+  { intros ω i,
+    rw [lattice_ordered_comm_group.pos_nonpos_iff, sub_nonpos] },
+  induction n with k ih,
+  { refine ⟨rfl, _⟩,
+    simp only [lower_crossing_time_zero, hitting, set.mem_Icc, set.mem_Iic],
+    ext ω,
+    split_ifs with h₁ h₂ h₂,
+    { simp_rw [hf'] },
+    { simp_rw [set.mem_Iic, ← hf' _ _] at h₂,
+      exact false.elim (h₂ h₁) },
+    { simp_rw [set.mem_Iic, hf' _ _] at h₁,
+      exact false.elim (h₁ h₂) },
+    { refl } },
+  { have : upper_crossing_time 0 (b - a) (λ n ω, (f n ω - a)⁺) N (k + 1) =
+      upper_crossing_time a b f N (k + 1),
+    { ext ω,
+      simp only [upper_crossing_time_succ_eq, ← ih.2, hitting, set.mem_Ici, tsub_le_iff_right],
+      split_ifs with h₁ h₂ h₂,
+      { simp_rw [← sub_le_iff_le_add, hf ω] },
+      { simp_rw [set.mem_Ici, ← hf _ _] at h₂,
+        exact false.elim (h₂ h₁) },
+      { simp_rw [set.mem_Ici, hf _ _] at h₁,
+        exact false.elim (h₁ h₂) },
+      { refl } },
+    refine ⟨this, _⟩,
+    ext ω,
+    simp only [lower_crossing_time, this, hitting, set.mem_Iic],
+    split_ifs with h₁ h₂ h₂,
+    { simp_rw [hf' ω] },
+    { simp_rw [set.mem_Iic, ← hf' _ _] at h₂,
+      exact false.elim (h₂ h₁) },
+    { simp_rw [set.mem_Iic, hf' _ _] at h₁,
+      exact false.elim (h₁ h₂) },
+    { refl } }
+end
+
+lemma upcrossings_before_pos_eq (hab : a < b) :
+  upcrossings_before 0 (b - a) (λ n ω, (f n ω - a)⁺) N ω = upcrossings_before a b f N ω :=
+by simp_rw [upcrossings_before, (crossing_pos_eq hab).1]
+
+lemma mul_integral_upcrossings_before_le_integral_pos_part_aux [is_finite_measure μ]
+  (hf : submartingale f ℱ μ) (hab : a < b) :
+  (b - a) * μ[upcrossings_before a b f N] ≤ μ[λ ω, (f N ω - a)⁺] :=
+begin
+  refine le_trans (le_of_eq _) (integral_mul_upcrossings_before_le_integral
+    (hf.sub_martingale (martingale_const _ _ _)).pos
+    (λ ω, lattice_ordered_comm_group.pos_nonneg _)
+    (λ ω, lattice_ordered_comm_group.pos_nonneg _) (sub_pos.2 hab)),
+  simp_rw [sub_zero, ← upcrossings_before_pos_eq hab],
+  refl,
+end
+
+/-- **Doob's upcrossing estimate**: given a real valued discrete submartingale `f` and real
+values `a` and `b`, we have `(b - a) * 𝔼[upcrossings_before a b f N] ≤ 𝔼[(f N - a)⁺]` where
+`upcrossings_before a b f N` is the number of times the process `f` crossed from below `a` to above
+`b` before the time `N`. -/
+theorem submartingale.mul_integral_upcrossings_before_le_integral_pos_part [is_finite_measure μ]
+  (a b : ℝ) (hf : submartingale f ℱ μ) (N : ℕ) :
+  (b - a) * μ[upcrossings_before a b f N] ≤ μ[λ ω, (f N ω - a)⁺] :=
+begin
+  by_cases hab : a < b,
+  { exact mul_integral_upcrossings_before_le_integral_pos_part_aux hf hab },
+  { rw [not_lt, ← sub_nonpos] at hab,
+    exact le_trans (mul_nonpos_of_nonpos_of_nonneg hab (integral_nonneg (λ ω, nat.cast_nonneg _)))
+      (integral_nonneg (λ ω, lattice_ordered_comm_group.pos_nonneg _)) }
+end
+
+/-!
+
+### Variant of the upcrossing estimate
+
+Now, we would like to prove a variant of the upcrossing estimate obtained by taking the supremum
+over $N$ of the original upcrossing estimate. Namely, we want the inequality
+$$
+  (b - a) \sup_N \mathbb{E}[U_N(a, b)] \le \sup_N \mathbb{E}[f_N].
+$$
+This inequality is central for the martingale convergence theorem as it provides a uniform bound
+for the upcrossings.
+
+We note that on top of taking the supremum on both sides of the inequality, we had also used
+the monotone convergence theorem on the left hand side to take the supremum outside of the
+integral. To do this, we need to make sure $U_N(a, b)$ is measurable and integrable. Integrability
+is easy to check as $U_N(a, b) ≤ N$ and so it suffices to show measurability. Indeed, by
+noting that
+$$
+  U_N(a, b) = \sum_{i = 1}^N \mathbf{1}_{\{U_N(a, b) < N\}}
+$$
+$U_N(a, b)$ is measurable as $\{U_N(a, b) < N\}$ is a measurable set since $U_N(a, b)$ is a
+stopping time.
+
+-/
+
+lemma upcrossings_before_eq_sum (hab : a < b) :
+  upcrossings_before a b f N ω =
+  ∑ i in finset.Ico 1 (N + 1), {n | upper_crossing_time a b f N n ω < N}.indicator 1 i :=
+begin
+  by_cases hN : N = 0,
+  { simp [hN] },
+  rw ← finset.sum_Ico_consecutive _ (nat.succ_le_succ zero_le')
+    (nat.succ_le_succ (upcrossings_before_le f ω hab)),
+  have h₁ : ∀ k ∈ finset.Ico 1 (upcrossings_before a b f N ω + 1),
+    {n : ℕ | upper_crossing_time a b f N n ω < N}.indicator 1 k = 1,
+  { rintro k hk,
+    rw finset.mem_Ico at hk,
+    rw set.indicator_of_mem,
+    { refl },
+    { exact upper_crossing_time_lt_of_le_upcrossings_before (zero_lt_iff.2 hN) hab
+        (nat.lt_succ_iff.1 hk.2) } },
+  have h₂ : ∀ k ∈ finset.Ico (upcrossings_before a b f N ω + 1) (N + 1),
+    {n : ℕ | upper_crossing_time a b f N n ω < N}.indicator 1 k = 0,
+  { rintro k hk,
+    rw [finset.mem_Ico, nat.succ_le_iff] at hk,
+    rw set.indicator_of_not_mem,
+    simp only [set.mem_set_of_eq, not_lt],
+    exact (upper_crossing_time_eq_of_upcrossings_before_lt hab hk.1).symm.le },
+  rw [finset.sum_congr rfl h₁, finset.sum_congr rfl h₂, finset.sum_const, finset.sum_const,
+    smul_eq_mul, mul_one, smul_eq_mul, mul_zero, nat.card_Ico, nat.add_succ_sub_one,
+    add_zero, add_zero],
+end
+
+lemma adapted.measurable_upcrossings_before (hf : adapted ℱ f) (hab : a < b) :
+  measurable (upcrossings_before a b f N) :=
+begin
+  have : upcrossings_before a b f N =
+    λ ω, ∑ i in finset.Ico 1 (N + 1), {n | upper_crossing_time a b f N n ω < N}.indicator 1 i,
+  { ext ω,
+    exact upcrossings_before_eq_sum hab },
+  rw this,
+  exact finset.measurable_sum _ (λ i hi, measurable.indicator measurable_const $
+    ℱ.le N _ (hf.is_stopping_time_upper_crossing_time.measurable_set_lt_of_pred N))
+end
+
+lemma adapted.integrable_upcrossings_before [is_finite_measure μ]
+  (hf : adapted ℱ f) (hab : a < b) :
+  integrable (λ ω, (upcrossings_before a b f N ω : ℝ)) μ :=
+begin
+  have : ∀ᵐ ω ∂μ, ‖(upcrossings_before a b f N ω : ℝ)‖ ≤ N,
+  { refine eventually_of_forall (λ ω, _),
+    rw [real.norm_eq_abs, nat.abs_cast, nat.cast_le],
+    refine upcrossings_before_le _ _ hab },
+  exact ⟨measurable.ae_strongly_measurable
+    (measurable_from_top.comp (hf.measurable_upcrossings_before hab)),
+    has_finite_integral_of_bounded this⟩
+end
+
+/-- The number of upcrossings of a realization of a stochastic process (`upcrossing` takes value
+in `ℝ≥0∞` and so is allowed to be `∞`). -/
+noncomputable def upcrossings [preorder ι] [order_bot ι] [has_Inf ι]
+  (a b : ℝ) (f : ι → Ω → ℝ) (ω : Ω) : ℝ≥0∞ :=
+⨆ N, (upcrossings_before a b f N ω : ℝ≥0∞)
+
+lemma adapted.measurable_upcrossings (hf : adapted ℱ f) (hab : a < b) :
+  measurable (upcrossings a b f) :=
+measurable_supr (λ N, measurable_from_top.comp (hf.measurable_upcrossings_before hab))
+
+lemma upcrossings_lt_top_iff :
+  upcrossings a b f ω < ∞ ↔ ∃ k, ∀ N, upcrossings_before a b f N ω ≤ k :=
+begin
+  have : upcrossings a b f ω < ∞ ↔ ∃ k : ℝ≥0, upcrossings a b f ω ≤ k,
+  { split,
+    { intro h,
+      lift upcrossings a b f ω to ℝ≥0 using h.ne with r hr,
+      exact ⟨r, le_rfl⟩ },
+    { rintro ⟨k, hk⟩,
+      exact lt_of_le_of_lt hk ennreal.coe_lt_top } },
+  simp_rw [this, upcrossings, supr_le_iff],
+  split; rintro ⟨k, hk⟩,
+  { obtain ⟨m, hm⟩ := exists_nat_ge k,
+    refine ⟨m, λ N, nat.cast_le.1 ((hk N).trans _)⟩,
+    rwa [← ennreal.coe_nat, ennreal.coe_le_coe] },
+  { refine ⟨k, λ N, _⟩,
+    simp only [ennreal.coe_nat, nat.cast_le, hk N] }
+end
+
+/-- A variant of Doob's upcrossing estimate obtained by taking the supremum on both sides. -/
+lemma submartingale.mul_lintegral_upcrossings_le_lintegral_pos_part [is_finite_measure μ]
+  (a b : ℝ) (hf : submartingale f ℱ μ) :
+  ennreal.of_real (b - a) * ∫⁻ ω, upcrossings a b f ω ∂μ ≤
+  ⨆ N, ∫⁻ ω, ennreal.of_real ((f N ω - a)⁺) ∂μ :=
+begin
+  by_cases hab : a < b,
+  { simp_rw [upcrossings],
+    have : ∀ N, ∫⁻ ω, ennreal.of_real ((f N ω - a)⁺) ∂μ = ennreal.of_real (∫ ω, (f N ω - a)⁺ ∂μ),
+    { intro N,
+      rw of_real_integral_eq_lintegral_of_real,
+      { exact (hf.sub_martingale (martingale_const _ _ _)).pos.integrable _ },
+      { exact eventually_of_forall (λ ω, lattice_ordered_comm_group.pos_nonneg _) } },
+    rw lintegral_supr',
+    { simp_rw [this, ennreal.mul_supr, supr_le_iff],
+      intro N,
+      rw [(by simp : ∫⁻ ω, upcrossings_before a b f N ω ∂μ =
+        ∫⁻ ω, ↑(upcrossings_before a b f N ω : ℝ≥0) ∂μ), lintegral_coe_eq_integral,
+        ← ennreal.of_real_mul (sub_pos.2 hab).le],
+      { simp_rw [nnreal.coe_nat_cast],
+        exact (ennreal.of_real_le_of_real
+          (hf.mul_integral_upcrossings_before_le_integral_pos_part a b N)).trans (le_supr _ N) },
+      { simp only [nnreal.coe_nat_cast, hf.adapted.integrable_upcrossings_before hab] } },
+    { exact λ n, measurable_from_top.comp_ae_measurable
+        (hf.adapted.measurable_upcrossings_before  hab).ae_measurable },
+    { refine eventually_of_forall (λ ω N M hNM, _),
+      rw nat.cast_le,
+      exact upcrossings_before_mono hab hNM ω } },
+  { rw [not_lt, ← sub_nonpos] at hab,
+    rw [ennreal.of_real_of_nonpos hab, zero_mul],
+    exact zero_le _ }
+end
+
+end measure_theory
diff --git a/src/probability/moments.lean b/src/probability/moments.lean
new file mode 100644
index 0000000000000..64126645bbb0a
--- /dev/null
+++ b/src/probability/moments.lean
@@ -0,0 +1,370 @@
+/-
+Copyright (c) 2022 Rémy Degenne. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rémy Degenne
+-/
+
+import probability.variance
+
+/-!
+# Moments and moment generating function
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+* `probability_theory.moment X p μ`: `p`th moment of a real random variable `X` with respect to
+  measure `μ`, `μ[X^p]`
+* `probability_theory.central_moment X p μ`:`p`th central moment of `X` with respect to measure `μ`,
+  `μ[(X - μ[X])^p]`
+* `probability_theory.mgf X μ t`: moment generating function of `X` with respect to measure `μ`,
+  `μ[exp(t*X)]`
+* `probability_theory.cgf X μ t`: cumulant generating function, logarithm of the moment generating
+  function
+
+## Main results
+
+* `probability_theory.indep_fun.mgf_add`: if two real random variables `X` and `Y` are independent
+  and their mgf are defined at `t`, then `mgf (X + Y) μ t = mgf X μ t * mgf Y μ t`
+* `probability_theory.indep_fun.cgf_add`: if two real random variables `X` and `Y` are independent
+  and their mgf are defined at `t`, then `cgf (X + Y) μ t = cgf X μ t + cgf Y μ t`
+* `probability_theory.measure_ge_le_exp_cgf` and `probability_theory.measure_le_le_exp_cgf`:
+  Chernoff bound on the upper (resp. lower) tail of a random variable. For `t` nonnegative such that
+  the cgf exists, `ℙ(ε ≤ X) ≤ exp(- t*ε + cgf X ℙ t)`. See also
+  `probability_theory.measure_ge_le_exp_mul_mgf` and
+  `probability_theory.measure_le_le_exp_mul_mgf` for versions of these results using `mgf` instead
+  of `cgf`.
+
+-/
+
+open measure_theory filter finset real
+
+noncomputable theory
+
+open_locale big_operators measure_theory probability_theory ennreal nnreal
+
+namespace probability_theory
+
+variables {Ω ι : Type*} {m : measurable_space Ω} {X : Ω → ℝ} {p : ℕ} {μ : measure Ω}
+
+include m
+
+/-- Moment of a real random variable, `μ[X ^ p]`. -/
+def moment (X : Ω → ℝ) (p : ℕ) (μ : measure Ω) : ℝ := μ[X ^ p]
+
+/-- Central moment of a real random variable, `μ[(X - μ[X]) ^ p]`. -/
+def central_moment (X : Ω → ℝ) (p : ℕ) (μ : measure Ω) : ℝ := μ[(X - (λ x, μ[X])) ^ p]
+
+@[simp] lemma moment_zero (hp : p ≠ 0) : moment 0 p μ = 0 :=
+by simp only [moment, hp, zero_pow', ne.def, not_false_iff, pi.zero_apply, integral_const,
+  algebra.id.smul_eq_mul, mul_zero]
+
+@[simp] lemma central_moment_zero (hp : p ≠ 0) : central_moment 0 p μ = 0 :=
+by simp only [central_moment, hp, pi.zero_apply, integral_const, algebra.id.smul_eq_mul,
+  mul_zero, zero_sub, pi.pow_apply, pi.neg_apply, neg_zero, zero_pow', ne.def, not_false_iff]
+
+lemma central_moment_one' [is_finite_measure μ] (h_int : integrable X μ) :
+  central_moment X 1 μ = (1 - (μ set.univ).to_real) * μ[X] :=
+begin
+  simp only [central_moment, pi.sub_apply, pow_one],
+  rw integral_sub h_int (integrable_const _),
+  simp only [sub_mul, integral_const, algebra.id.smul_eq_mul, one_mul],
+end
+
+@[simp] lemma central_moment_one [is_probability_measure μ] : central_moment X 1 μ = 0 :=
+begin
+  by_cases h_int : integrable X μ,
+  { rw central_moment_one' h_int,
+    simp only [measure_univ, ennreal.one_to_real, sub_self, zero_mul], },
+  { simp only [central_moment, pi.sub_apply, pow_one],
+    have : ¬ integrable (λ x, X x - integral μ X) μ,
+    { refine λ h_sub, h_int _,
+      have h_add : X = (λ x, X x - integral μ X) + (λ x, integral μ X),
+      { ext1 x, simp, },
+      rw h_add,
+      exact h_sub.add (integrable_const _), },
+    rw integral_undef this, },
+end
+
+lemma central_moment_two_eq_variance [is_finite_measure μ] (hX : mem_ℒp X 2 μ) :
+  central_moment X 2 μ = variance X μ :=
+by { rw hX.variance_eq, refl, }
+
+section moment_generating_function
+
+variables {t : ℝ}
+
+/-- Moment generating function of a real random variable `X`: `λ t, μ[exp(t*X)]`. -/
+def mgf (X : Ω → ℝ) (μ : measure Ω) (t : ℝ) : ℝ := μ[λ ω, exp (t * X ω)]
+
+/-- Cumulant generating function of a real random variable `X`: `λ t, log μ[exp(t*X)]`. -/
+def cgf (X : Ω → ℝ) (μ : measure Ω) (t : ℝ) : ℝ := log (mgf X μ t)
+
+@[simp] lemma mgf_zero_fun : mgf 0 μ t = (μ set.univ).to_real :=
+by simp only [mgf, pi.zero_apply, mul_zero, exp_zero, integral_const, algebra.id.smul_eq_mul,
+  mul_one]
+
+@[simp] lemma cgf_zero_fun : cgf 0 μ t = log (μ set.univ).to_real :=
+by simp only [cgf, mgf_zero_fun]
+
+@[simp] lemma mgf_zero_measure : mgf X (0 : measure Ω) t = 0 :=
+by simp only [mgf, integral_zero_measure]
+
+@[simp] lemma cgf_zero_measure : cgf X (0 : measure Ω) t = 0 :=
+by simp only [cgf, log_zero, mgf_zero_measure]
+
+@[simp] lemma mgf_const' (c : ℝ) : mgf (λ _, c) μ t = (μ set.univ).to_real * exp (t * c) :=
+by simp only [mgf, integral_const, algebra.id.smul_eq_mul]
+
+@[simp] lemma mgf_const (c : ℝ) [is_probability_measure μ] : mgf (λ _, c) μ t = exp (t * c) :=
+by simp only [mgf_const', measure_univ, ennreal.one_to_real, one_mul]
+
+@[simp] lemma cgf_const' [is_finite_measure μ] (hμ : μ ≠ 0) (c : ℝ) :
+  cgf (λ _, c) μ t = log (μ set.univ).to_real + t * c :=
+begin
+  simp only [cgf, mgf_const'],
+  rw log_mul _ (exp_pos _).ne',
+  { rw log_exp _, },
+  { rw [ne.def, ennreal.to_real_eq_zero_iff, measure.measure_univ_eq_zero],
+    simp only [hμ, measure_ne_top μ set.univ, or_self, not_false_iff], },
+end
+
+@[simp] lemma cgf_const [is_probability_measure μ] (c : ℝ) : cgf (λ _, c) μ t = t * c :=
+by simp only [cgf, mgf_const, log_exp]
+
+@[simp] lemma mgf_zero' : mgf X μ 0 = (μ set.univ).to_real :=
+by simp only [mgf, zero_mul, exp_zero, integral_const, algebra.id.smul_eq_mul, mul_one]
+
+@[simp] lemma mgf_zero [is_probability_measure μ] : mgf X μ 0 = 1 :=
+by simp only [mgf_zero', measure_univ, ennreal.one_to_real]
+
+@[simp] lemma cgf_zero' : cgf X μ 0 = log (μ set.univ).to_real :=
+by simp only [cgf, mgf_zero']
+
+@[simp] lemma cgf_zero [is_probability_measure μ] : cgf X μ 0 = 0 :=
+by simp only [cgf_zero', measure_univ, ennreal.one_to_real, log_one]
+
+lemma mgf_undef (hX : ¬ integrable (λ ω, exp (t * X ω)) μ) : mgf X μ t = 0 :=
+by simp only [mgf, integral_undef hX]
+
+lemma cgf_undef (hX : ¬ integrable (λ ω, exp (t * X ω)) μ) : cgf X μ t = 0 :=
+by simp only [cgf, mgf_undef hX, log_zero]
+
+lemma mgf_nonneg : 0 ≤ mgf X μ t :=
+begin
+  refine integral_nonneg _,
+  intro ω,
+  simp only [pi.zero_apply],
+  exact (exp_pos _).le,
+end
+
+lemma mgf_pos' (hμ : μ ≠ 0) (h_int_X : integrable (λ ω, exp (t * X ω)) μ) : 0 < mgf X μ t :=
+begin
+  simp_rw mgf,
+  have : ∫ (x : Ω), exp (t * X x) ∂μ = ∫ (x : Ω) in set.univ, exp (t * X x) ∂μ,
+  { simp only [measure.restrict_univ], },
+  rw [this, set_integral_pos_iff_support_of_nonneg_ae _ _],
+  { have h_eq_univ : function.support (λ (x : Ω), exp (t * X x)) = set.univ,
+    { ext1 x,
+      simp only [function.mem_support, set.mem_univ, iff_true],
+      exact (exp_pos _).ne', },
+    rw [h_eq_univ, set.inter_univ _],
+    refine ne.bot_lt _,
+    simp only [hμ, ennreal.bot_eq_zero, ne.def, measure.measure_univ_eq_zero, not_false_iff], },
+  { refine eventually_of_forall (λ x, _),
+    rw pi.zero_apply,
+    exact (exp_pos _).le, },
+  { rwa integrable_on_univ, },
+end
+
+lemma mgf_pos [is_probability_measure μ] (h_int_X : integrable (λ ω, exp (t * X ω)) μ) :
+  0 < mgf X μ t :=
+mgf_pos' (is_probability_measure.ne_zero μ) h_int_X
+
+lemma mgf_neg : mgf (-X) μ t = mgf X μ (-t) :=
+by simp_rw [mgf, pi.neg_apply, mul_neg, neg_mul]
+
+lemma cgf_neg : cgf (-X) μ t = cgf X μ (-t) := by simp_rw [cgf, mgf_neg]
+
+/-- This is a trivial application of `indep_fun.comp` but it will come up frequently. -/
+lemma indep_fun.exp_mul {X Y : Ω → ℝ} (h_indep : indep_fun X Y μ) (s t : ℝ) :
+  indep_fun (λ ω, exp (s * X ω)) (λ ω, exp (t * Y ω)) μ :=
+begin
+  have h_meas : ∀ t, measurable (λ x, exp (t * x)) := λ t, (measurable_id'.const_mul t).exp,
+  change indep_fun ((λ x, exp (s * x)) ∘ X) ((λ x, exp (t * x)) ∘ Y) μ,
+  exact indep_fun.comp h_indep (h_meas s) (h_meas t),
+end
+
+lemma indep_fun.mgf_add {X Y : Ω → ℝ} (h_indep : indep_fun X Y μ)
+  (hX : ae_strongly_measurable (λ ω, exp (t * X ω)) μ)
+  (hY : ae_strongly_measurable (λ ω, exp (t * Y ω)) μ) :
+  mgf (X + Y) μ t = mgf X μ t * mgf Y μ t :=
+begin
+  simp_rw [mgf, pi.add_apply, mul_add, exp_add],
+  exact (h_indep.exp_mul t t).integral_mul hX hY,
+end
+
+lemma indep_fun.mgf_add' {X Y : Ω → ℝ} (h_indep : indep_fun X Y μ)
+  (hX : ae_strongly_measurable X μ) (hY : ae_strongly_measurable Y μ) :
+  mgf (X + Y) μ t = mgf X μ t * mgf Y μ t :=
+begin
+  have A : continuous (λ (x : ℝ), exp (t * x)), by continuity,
+  have h'X : ae_strongly_measurable (λ ω, exp (t * X ω)) μ :=
+    A.ae_strongly_measurable.comp_ae_measurable hX.ae_measurable,
+  have h'Y : ae_strongly_measurable (λ ω, exp (t * Y ω)) μ :=
+    A.ae_strongly_measurable.comp_ae_measurable hY.ae_measurable,
+  exact h_indep.mgf_add h'X h'Y
+end
+
+lemma indep_fun.cgf_add {X Y : Ω → ℝ} (h_indep : indep_fun X Y μ)
+  (h_int_X : integrable (λ ω, exp (t * X ω)) μ)
+  (h_int_Y : integrable (λ ω, exp (t * Y ω)) μ) :
+  cgf (X + Y) μ t = cgf X μ t + cgf Y μ t :=
+begin
+  by_cases hμ : μ = 0,
+  { simp [hμ], },
+  simp only [cgf, h_indep.mgf_add h_int_X.ae_strongly_measurable h_int_Y.ae_strongly_measurable],
+  exact log_mul (mgf_pos' hμ h_int_X).ne' (mgf_pos' hμ h_int_Y).ne',
+end
+
+lemma ae_strongly_measurable_exp_mul_add {X Y : Ω → ℝ}
+  (h_int_X : ae_strongly_measurable (λ ω, exp (t * X ω)) μ)
+  (h_int_Y : ae_strongly_measurable (λ ω, exp (t * Y ω)) μ) :
+  ae_strongly_measurable (λ ω, exp (t * (X + Y) ω)) μ :=
+begin
+  simp_rw [pi.add_apply, mul_add, exp_add],
+  exact ae_strongly_measurable.mul h_int_X h_int_Y,
+end
+
+lemma ae_strongly_measurable_exp_mul_sum {X : ι → Ω → ℝ} {s : finset ι}
+  (h_int : ∀ i ∈ s, ae_strongly_measurable (λ ω, exp (t * X i ω)) μ) :
+  ae_strongly_measurable (λ ω, exp (t * (∑ i in s, X i) ω)) μ :=
+begin
+  classical,
+  induction s using finset.induction_on with i s hi_notin_s h_rec h_int,
+  { simp only [pi.zero_apply, sum_apply, sum_empty, mul_zero, exp_zero],
+    exact ae_strongly_measurable_const, },
+  { have : ∀ (i : ι), i ∈ s → ae_strongly_measurable (λ (ω : Ω), exp (t * X i ω)) μ,
+      from λ i hi, h_int i (mem_insert_of_mem hi),
+    specialize h_rec this,
+    rw sum_insert hi_notin_s,
+    apply ae_strongly_measurable_exp_mul_add (h_int i (mem_insert_self _ _)) h_rec }
+end
+
+lemma indep_fun.integrable_exp_mul_add {X Y : Ω → ℝ} (h_indep : indep_fun X Y μ)
+  (h_int_X : integrable (λ ω, exp (t * X ω)) μ)
+  (h_int_Y : integrable (λ ω, exp (t * Y ω)) μ) :
+  integrable (λ ω, exp (t * (X + Y) ω)) μ :=
+begin
+  simp_rw [pi.add_apply, mul_add, exp_add],
+  exact (h_indep.exp_mul t t).integrable_mul h_int_X h_int_Y,
+end
+
+lemma Indep_fun.integrable_exp_mul_sum [is_probability_measure μ]
+  {X : ι → Ω → ℝ} (h_indep : Indep_fun (λ i, infer_instance) X μ) (h_meas : ∀ i, measurable (X i))
+  {s : finset ι} (h_int : ∀ i ∈ s, integrable (λ ω, exp (t * X i ω)) μ) :
+  integrable (λ ω, exp (t * (∑ i in s, X i) ω)) μ :=
+begin
+  classical,
+  induction s using finset.induction_on with i s hi_notin_s h_rec h_int,
+  { simp only [pi.zero_apply, sum_apply, sum_empty, mul_zero, exp_zero],
+    exact integrable_const _, },
+  { have : ∀ (i : ι), i ∈ s → integrable (λ (ω : Ω), exp (t * X i ω)) μ,
+      from λ i hi, h_int i (mem_insert_of_mem hi),
+    specialize h_rec this,
+    rw sum_insert hi_notin_s,
+    refine indep_fun.integrable_exp_mul_add _ (h_int i (mem_insert_self _ _)) h_rec,
+    exact (h_indep.indep_fun_finset_sum_of_not_mem h_meas hi_notin_s).symm, },
+end
+
+lemma Indep_fun.mgf_sum [is_probability_measure μ]
+  {X : ι → Ω → ℝ} (h_indep : Indep_fun (λ i, infer_instance) X μ) (h_meas : ∀ i, measurable (X i))
+  (s : finset ι) :
+  mgf (∑ i in s, X i) μ t = ∏ i in s, mgf (X i) μ t :=
+begin
+  classical,
+  induction s using finset.induction_on with i s hi_notin_s h_rec h_int,
+  { simp only [sum_empty, mgf_zero_fun, measure_univ, ennreal.one_to_real, prod_empty], },
+  { have h_int' : ∀ (i : ι), ae_strongly_measurable (λ (ω : Ω), exp (t * X i ω)) μ,
+      from λ i, ((h_meas i).const_mul t).exp.ae_strongly_measurable,
+    rw [sum_insert hi_notin_s, indep_fun.mgf_add
+          (h_indep.indep_fun_finset_sum_of_not_mem h_meas hi_notin_s).symm (h_int' i)
+          (ae_strongly_measurable_exp_mul_sum (λ i hi, h_int' i)),
+        h_rec, prod_insert hi_notin_s] }
+end
+
+lemma Indep_fun.cgf_sum [is_probability_measure μ]
+  {X : ι → Ω → ℝ} (h_indep : Indep_fun (λ i, infer_instance) X μ) (h_meas : ∀ i, measurable (X i))
+  {s : finset ι} (h_int : ∀ i ∈ s, integrable (λ ω, exp (t * X i ω)) μ) :
+  cgf (∑ i in s, X i) μ t = ∑ i in s, cgf (X i) μ t :=
+begin
+  simp_rw cgf,
+  rw ← log_prod _ _ (λ j hj, _),
+  { rw h_indep.mgf_sum h_meas },
+  { exact (mgf_pos (h_int j hj)).ne', },
+end
+
+/-- **Chernoff bound** on the upper tail of a real random variable. -/
+lemma measure_ge_le_exp_mul_mgf [is_finite_measure μ] (ε : ℝ) (ht : 0 ≤ t)
+  (h_int : integrable (λ ω, exp (t * X ω)) μ) :
+  (μ {ω | ε ≤ X ω}).to_real ≤ exp (- t * ε) * mgf X μ t :=
+begin
+  cases ht.eq_or_lt with ht_zero_eq ht_pos,
+  { rw ht_zero_eq.symm,
+    simp only [neg_zero, zero_mul, exp_zero, mgf_zero', one_mul],
+    rw ennreal.to_real_le_to_real (measure_ne_top μ _) (measure_ne_top μ _),
+    exact measure_mono (set.subset_univ _), },
+  calc (μ {ω | ε ≤ X ω}).to_real
+      = (μ {ω | exp (t * ε) ≤ exp (t * X ω)}).to_real :
+    begin
+      congr' with ω,
+      simp only [exp_le_exp, eq_iff_iff],
+      exact ⟨λ h, mul_le_mul_of_nonneg_left h ht_pos.le, λ h, le_of_mul_le_mul_left h ht_pos⟩,
+    end
+  ... ≤ (exp (t * ε))⁻¹ * μ[λ ω, exp (t * X ω)] :
+    begin
+      have : exp (t * ε) * (μ {ω | exp (t * ε) ≤ exp (t * X ω)}).to_real
+          ≤ μ[λ ω, exp (t * X ω)],
+        from mul_meas_ge_le_integral_of_nonneg (λ x, (exp_pos _).le) h_int _,
+      rwa [mul_comm (exp (t * ε))⁻¹, ← div_eq_mul_inv, le_div_iff' (exp_pos _)],
+    end
+  ... = exp (- t * ε) * mgf X μ t : by { rw [neg_mul, exp_neg], refl, },
+end
+
+/-- **Chernoff bound** on the lower tail of a real random variable. -/
+lemma measure_le_le_exp_mul_mgf [is_finite_measure μ] (ε : ℝ) (ht : t ≤ 0)
+  (h_int : integrable (λ ω, exp (t * X ω)) μ) :
+  (μ {ω | X ω ≤ ε}).to_real ≤ exp (- t * ε) * mgf X μ t :=
+begin
+  rw [← neg_neg t, ← mgf_neg, neg_neg, ← neg_mul_neg (-t)],
+  refine eq.trans_le _ (measure_ge_le_exp_mul_mgf (-ε) (neg_nonneg.mpr ht) _),
+  { congr' with ω,
+    simp only [pi.neg_apply, neg_le_neg_iff], },
+  { simp_rw [pi.neg_apply, neg_mul_neg],
+    exact h_int, },
+end
+
+/-- **Chernoff bound** on the upper tail of a real random variable. -/
+lemma measure_ge_le_exp_cgf [is_finite_measure μ] (ε : ℝ) (ht : 0 ≤ t)
+  (h_int : integrable (λ ω, exp (t * X ω)) μ) :
+  (μ {ω | ε ≤ X ω}).to_real ≤ exp (- t * ε + cgf X μ t) :=
+begin
+  refine (measure_ge_le_exp_mul_mgf ε ht h_int).trans _,
+  rw exp_add,
+  exact mul_le_mul le_rfl (le_exp_log _) mgf_nonneg (exp_pos _).le,
+end
+
+/-- **Chernoff bound** on the lower tail of a real random variable. -/
+lemma measure_le_le_exp_cgf [is_finite_measure μ] (ε : ℝ) (ht : t ≤ 0)
+  (h_int : integrable (λ ω, exp (t * X ω)) μ) :
+  (μ {ω | X ω ≤ ε}).to_real ≤ exp (- t * ε + cgf X μ t) :=
+begin
+  refine (measure_le_le_exp_mul_mgf ε ht h_int).trans _,
+  rw exp_add,
+  exact mul_le_mul le_rfl (le_exp_log _) mgf_nonneg (exp_pos _).le,
+end
+
+end moment_generating_function
+
+end probability_theory
diff --git a/src/probability/notation.lean b/src/probability/notation.lean
index 1be9c52af33d5..5b6d45c1d4f42 100644
--- a/src/probability/notation.lean
+++ b/src/probability/notation.lean
@@ -3,17 +3,22 @@ Copyright (c) 2021 Rémy Degenne. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
-import measure_theory.function.conditional_expectation
+import probability.probability_mass_function.basic
+import measure_theory.function.conditional_expectation.basic
 
 /-! # Notations for probability theory
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the following notations, for functions `X,Y`, measures `P, Q` defined on a
 measurable space `m0`, and another measurable space structure `m` with `hm : m ≤ m0`,
 - `P[X] = ∫ a, X a ∂P`
 - `𝔼[X] = ∫ a, X a`
-- `𝔼[X|m,hm]`: conditional expectation of `X` with respect to the measure `volume` and the
-  measurable space `m`. The similar `P[X|m,hm]` for a measure `P` is defined in
+- `𝔼[X|m]`: conditional expectation of `X` with respect to the measure `volume` and the
+  measurable space `m`. The similar `P[X|m]` for a measure `P` is defined in
   measure_theory.function.conditional_expectation.
+- `P⟦s|m⟧ = P[s.indicator (λ ω, (1 : ℝ)) | m]`, conditional probability of a set.
 - `X =ₐₛ Y`: `X =ᵐ[volume] Y`
 - `X ≤ₐₛ Y`: `X ≤ᵐ[volume] Y`
 - `∂P/∂Q = P.rn_deriv Q`
@@ -25,27 +30,28 @@ We note that the notation `∂P/∂Q` applies to three different cases, namely,
 -/
 
 open measure_theory
+open_locale measure_theory
 
--- We define notations `𝔼[f|hm]` and `𝔼[f|m,hm]` for the conditional expectation of `f` with
--- respect to `m`. Both can be used in code but only the second one will be used by the goal view.
--- The first notation avoids the repetition of `m`, which is already present in `hm`. The second
--- one ensures that `m` stays visible in the goal view: when `hm` is complicated, it gets rendered
--- as `_` and the measurable space would not be visible in `𝔼[f|_]`, but is clear in `𝔼[f|m,_]`.
-localized "notation `𝔼[` X `|` hm `]` :=
-  measure_theory.condexp _ hm measure_theory.measure_space.volume X" in probability_theory
-localized "notation `𝔼[` X `|` m `,` hm `]` :=
-  measure_theory.condexp m hm measure_theory.measure_space.volume X" in probability_theory
+-- We define notations `𝔼[f|m]` for the conditional expectation of `f` with respect to `m`.
+localized "notation (name := condexp.volume) `𝔼[` X `|` m `]` :=
+  measure_theory.condexp m measure_theory.measure_space.volume X" in probability_theory
 
-localized "notation P `[` X `]` := ∫ x, X x ∂P" in probability_theory
+localized "notation (name := condexp.probability)
+  P `[` X `]` := ∫ x, X x ∂P" in probability_theory
 
-localized "notation `𝔼[` X `]` := ∫ a, X a" in probability_theory
+localized "notation (name := expected_value) `𝔼[` X `]` := ∫ a, X a" in probability_theory
 
-localized "notation X `=ₐₛ`:50 Y:50 := X =ᵐ[measure_theory.measure_space.volume] Y"
+localized "notation (name := condexp_indicator)
+  P `⟦` s `|` m `⟧` := measure_theory.condexp m P (s.indicator (λ ω, (1 : ℝ)))"
   in probability_theory
 
-localized "notation X `≤ₐₛ`:50 Y:50 := X ≤ᵐ[measure_theory.measure_space.volume] Y"
-  in probability_theory
+localized "notation (name := eq_ae_volume)
+  X ` =ₐₛ `:50 Y:50 := X =ᵐ[measure_theory.measure_space.volume] Y" in probability_theory
+
+localized "notation (name := le_ae_volume)
+  X ` ≤ₐₛ `:50 Y:50 := X ≤ᵐ[measure_theory.measure_space.volume] Y" in probability_theory
 
-localized "notation `∂` P `/∂`:50 Q:50 := P.rn_deriv Q" in probability_theory
+localized "notation (name := rn_deriv) `∂` P `/∂`:50 Q:50 := P.rn_deriv Q" in probability_theory
 
-localized "notation `ℙ` := measure_theory.measure_space.volume" in probability_theory
+localized "notation (name := measure_space.volume)
+  `ℙ` := measure_theory.measure_space.volume" in probability_theory
diff --git a/src/probability/probability_mass_function/basic.lean b/src/probability/probability_mass_function/basic.lean
new file mode 100644
index 0000000000000..b849e214b150b
--- /dev/null
+++ b/src/probability/probability_mass_function/basic.lean
@@ -0,0 +1,326 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Devon Tuma
+-/
+import topology.instances.ennreal
+import measure_theory.measure.measure_space
+
+/-!
+# Probability mass functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file is about probability mass functions or discrete probability measures:
+a function `α → ℝ≥0∞` such that the values have (infinite) sum `1`.
+
+Construction of monadic `pure` and `bind` is found in `probability_mass_function/monad.lean`,
+other constructions of `pmf`s are found in `probability_mass_function/constructions.lean`.
+
+Given `p : pmf α`, `pmf.to_outer_measure` constructs an `outer_measure` on `α`,
+by assigning each set the sum of the probabilities of each of its elements.
+Under this outer measure, every set is Carathéodory-measurable,
+so we can further extend this to a `measure` on `α`, see `pmf.to_measure`.
+`pmf.to_measure.is_probability_measure` shows this associated measure is a probability measure.
+Conversely, given a probability measure `μ` on a measurable space `α` with all singleton sets
+measurable, `μ.to_pmf` constructs a `pmf` on `α`, setting the probability mass of a point `x`
+to be the measure of the singleton set `{x}`.
+
+## Tags
+
+probability mass function, discrete probability measure
+-/
+noncomputable theory
+variables {α β γ : Type*}
+open_locale classical big_operators nnreal ennreal measure_theory
+
+/-- A probability mass function, or discrete probability measures is a function `α → ℝ≥0∞` such
+  that the values have (infinite) sum `1`. -/
+def {u} pmf (α : Type u) : Type u := { f : α → ℝ≥0∞ // has_sum f 1 }
+
+namespace pmf
+
+instance fun_like : fun_like (pmf α) α (λ p, ℝ≥0∞) :=
+{ coe := λ p a, p.1 a,
+  coe_injective' := λ p q h, subtype.eq h }
+
+@[ext] protected lemma ext {p q : pmf α} (h : ∀ x, p x = q x) : p = q := fun_like.ext p q h
+
+lemma ext_iff {p q : pmf α} : p = q ↔ ∀ x, p x = q x := fun_like.ext_iff
+
+lemma has_sum_coe_one (p : pmf α) : has_sum p 1 := p.2
+
+@[simp] lemma tsum_coe (p : pmf α) : ∑' a, p a = 1 := p.has_sum_coe_one.tsum_eq
+
+lemma tsum_coe_ne_top (p : pmf α) : ∑' a, p a ≠ ∞ := p.tsum_coe.symm ▸ ennreal.one_ne_top
+
+lemma tsum_coe_indicator_ne_top (p : pmf α) (s : set α) : ∑' a, s.indicator p a ≠ ∞ :=
+ne_of_lt (lt_of_le_of_lt (tsum_le_tsum (λ a, set.indicator_apply_le (λ _, le_rfl))
+  ennreal.summable ennreal.summable) (lt_of_le_of_ne le_top p.tsum_coe_ne_top))
+
+@[simp] lemma coe_ne_zero (p : pmf α) : ⇑p ≠ 0 :=
+λ hp, zero_ne_one ((tsum_zero.symm.trans (tsum_congr $
+  λ x, symm (congr_fun hp x))).trans p.tsum_coe)
+
+/-- The support of a `pmf` is the set where it is nonzero. -/
+def support (p : pmf α) : set α := function.support p
+
+@[simp] lemma mem_support_iff (p : pmf α) (a : α) : a ∈ p.support ↔ p a ≠ 0 := iff.rfl
+
+@[simp] lemma support_nonempty (p : pmf α) : p.support.nonempty :=
+function.support_nonempty_iff.2 p.coe_ne_zero
+
+lemma apply_eq_zero_iff (p : pmf α) (a : α) : p a = 0 ↔ a ∉ p.support :=
+by rw [mem_support_iff, not_not]
+
+lemma apply_pos_iff (p : pmf α) (a : α) : 0 < p a ↔ a ∈ p.support :=
+pos_iff_ne_zero.trans (p.mem_support_iff a).symm
+
+lemma apply_eq_one_iff (p : pmf α) (a : α) : p a = 1 ↔ p.support = {a} :=
+begin
+  refine ⟨λ h, set.subset.antisymm (λ a' ha', by_contra $ λ ha, _) (λ a' ha',
+    ha'.symm ▸ (p.mem_support_iff a).2 (λ ha, zero_ne_one $ ha.symm.trans h)), λ h, trans
+      (symm $ tsum_eq_single a (λ a' ha', (p.apply_eq_zero_iff a').2 (h.symm ▸ ha'))) p.tsum_coe⟩,
+  suffices : 1 < ∑' a, p a,
+  from ne_of_lt this p.tsum_coe.symm,
+  have : 0 < ∑' b, ite (b = a) 0 (p b),
+  from lt_of_le_of_ne' zero_le' ((tsum_ne_zero_iff ennreal.summable).2
+    ⟨a', ite_ne_left_iff.2 ⟨ha, ne.symm $ (p.mem_support_iff a').2 ha'⟩⟩),
+  calc 1 = 1 + 0 : (add_zero 1).symm ... < p a + ∑' b, ite (b = a) 0 (p b) :
+      ennreal.add_lt_add_of_le_of_lt ennreal.one_ne_top (le_of_eq h.symm) this
+    ... = ite (a = a) (p a) 0 + ∑' b, ite (b = a) 0 (p b) : by rw [eq_self_iff_true, if_true]
+    ... = ∑' b, ite (b = a) (p b) 0 + ∑' b, ite (b = a) 0 (p b) :
+      by { congr, exact symm (tsum_eq_single a $ λ b hb, if_neg hb) }
+    ... = ∑' b, (ite (b = a) (p b) 0 + ite (b = a) 0 (p b)) : ennreal.tsum_add.symm
+    ... = ∑' b, p b : tsum_congr (λ b, by split_ifs; simp only [zero_add, add_zero, le_rfl])
+end
+
+lemma coe_le_one (p : pmf α) (a : α) : p a ≤ 1 :=
+has_sum_le (by { intro b, split_ifs; simp only [h, zero_le', le_rfl] })
+  (has_sum_ite_eq a (p a)) (has_sum_coe_one p)
+
+lemma apply_ne_top (p : pmf α) (a : α) : p a ≠ ∞ :=
+ne_of_lt (lt_of_le_of_lt (p.coe_le_one a) ennreal.one_lt_top)
+
+lemma apply_lt_top (p : pmf α) (a : α) : p a < ∞ := lt_of_le_of_ne le_top (p.apply_ne_top a)
+
+section outer_measure
+
+open measure_theory measure_theory.outer_measure
+
+/-- Construct an `outer_measure` from a `pmf`, by assigning measure to each set `s : set α` equal
+  to the sum of `p x` for for each `x ∈ α` -/
+def to_outer_measure (p : pmf α) : outer_measure α :=
+outer_measure.sum (λ (x : α), p x • dirac x)
+
+variables (p : pmf α) (s t : set α)
+
+lemma to_outer_measure_apply : p.to_outer_measure s = ∑' x, s.indicator p x :=
+tsum_congr (λ x, smul_dirac_apply (p x) x s)
+
+@[simp] lemma to_outer_measure_caratheodory : p.to_outer_measure.caratheodory = ⊤ :=
+begin
+  refine (eq_top_iff.2 $ le_trans (le_Inf $ λ x hx, _) (le_sum_caratheodory _)),
+  exact let ⟨y, hy⟩ := hx in ((le_of_eq (dirac_caratheodory y).symm).trans
+    (le_smul_caratheodory _ _)).trans (le_of_eq hy),
+end
+
+@[simp]
+lemma to_outer_measure_apply_finset (s : finset α) : p.to_outer_measure s = ∑ x in s, p x :=
+begin
+  refine (to_outer_measure_apply p s).trans ((@tsum_eq_sum _ _ _ _ _ _ s _).trans _),
+  { exact λ x hx, set.indicator_of_not_mem hx _ },
+  { exact finset.sum_congr rfl (λ x hx, set.indicator_of_mem hx _) }
+end
+
+lemma to_outer_measure_apply_singleton (a : α) : p.to_outer_measure {a} = p a :=
+begin
+  refine (p.to_outer_measure_apply {a}).trans ((tsum_eq_single a $ λ b hb, _).trans _),
+  { exact ite_eq_right_iff.2 (λ hb', false.elim $ hb hb') },
+  { exact ite_eq_left_iff.2 (λ ha', false.elim $ ha' rfl) }
+end
+
+lemma to_outer_measure_injective : (to_outer_measure : pmf α → outer_measure α).injective :=
+λ p q h, pmf.ext (λ x, (p.to_outer_measure_apply_singleton x).symm.trans
+  ((congr_fun (congr_arg _ h) _).trans $ q.to_outer_measure_apply_singleton x))
+
+@[simp] lemma to_outer_measure_inj {p q : pmf α} :
+  p.to_outer_measure = q.to_outer_measure ↔ p = q := to_outer_measure_injective.eq_iff
+
+lemma to_outer_measure_apply_eq_zero_iff : p.to_outer_measure s = 0 ↔ disjoint p.support s :=
+begin
+  rw [to_outer_measure_apply, ennreal.tsum_eq_zero],
+  exact function.funext_iff.symm.trans set.indicator_eq_zero',
+end
+
+lemma to_outer_measure_apply_eq_one_iff : p.to_outer_measure s = 1 ↔ p.support ⊆ s :=
+begin
+  refine (p.to_outer_measure_apply s).symm ▸ ⟨λ h a hap, _, λ h, _⟩,
+  { refine by_contra (λ hs, ne_of_lt _ (h.trans p.tsum_coe.symm)),
+    have hs' : s.indicator p a = 0 := set.indicator_apply_eq_zero.2 (λ hs', false.elim $ hs hs'),
+    have hsa : s.indicator p a < p a := hs'.symm ▸ (p.apply_pos_iff a).2 hap,
+    exact ennreal.tsum_lt_tsum (p.tsum_coe_indicator_ne_top s)
+      (λ x, set.indicator_apply_le $ λ _, le_rfl) hsa },
+  { suffices : ∀ x ∉ s, p x = 0,
+    from trans (tsum_congr $ λ a, (set.indicator_apply s p a).trans
+      (ite_eq_left_iff.2 $ symm ∘ (this a))) p.tsum_coe,
+    exact λ a ha, (p.apply_eq_zero_iff a).2 $ set.not_mem_subset h ha }
+end
+
+@[simp] lemma to_outer_measure_apply_inter_support :
+  p.to_outer_measure (s ∩ p.support) = p.to_outer_measure s :=
+by simp only [to_outer_measure_apply, pmf.support, set.indicator_inter_support]
+
+/-- Slightly stronger than `outer_measure.mono` having an intersection with `p.support` -/
+lemma to_outer_measure_mono {s t : set α} (h : s ∩ p.support ⊆ t) :
+  p.to_outer_measure s ≤ p.to_outer_measure t :=
+le_trans (le_of_eq (to_outer_measure_apply_inter_support p s).symm) (p.to_outer_measure.mono h)
+
+lemma to_outer_measure_apply_eq_of_inter_support_eq {s t : set α}
+  (h : s ∩ p.support = t ∩ p.support) : p.to_outer_measure s = p.to_outer_measure t :=
+le_antisymm (p.to_outer_measure_mono (h.symm ▸ (set.inter_subset_left t p.support)))
+  (p.to_outer_measure_mono (h ▸ (set.inter_subset_left s p.support)))
+
+@[simp]
+lemma to_outer_measure_apply_fintype [fintype α] : p.to_outer_measure s = ∑ x, s.indicator p x :=
+(p.to_outer_measure_apply s).trans (tsum_eq_sum (λ x h, absurd (finset.mem_univ x) h))
+
+end outer_measure
+
+section measure
+
+open measure_theory
+
+/-- Since every set is Carathéodory-measurable under `pmf.to_outer_measure`,
+  we can further extend this `outer_measure` to a `measure` on `α` -/
+def to_measure [measurable_space α] (p : pmf α) : measure α :=
+p.to_outer_measure.to_measure ((to_outer_measure_caratheodory p).symm ▸ le_top)
+
+variables [measurable_space α] (p : pmf α) (s t : set α)
+
+lemma to_outer_measure_apply_le_to_measure_apply : p.to_outer_measure s ≤ p.to_measure s :=
+le_to_measure_apply p.to_outer_measure _ s
+
+lemma to_measure_apply_eq_to_outer_measure_apply (hs : measurable_set s) :
+  p.to_measure s = p.to_outer_measure s :=
+to_measure_apply p.to_outer_measure _ hs
+
+lemma to_measure_apply (hs : measurable_set s) : p.to_measure s = ∑' x, s.indicator p x :=
+(p.to_measure_apply_eq_to_outer_measure_apply s hs).trans (p.to_outer_measure_apply s)
+
+lemma to_measure_apply_singleton (a : α) (h : measurable_set ({a} : set α)) :
+  p.to_measure {a} = p a :=
+by simp [to_measure_apply_eq_to_outer_measure_apply _ _ h, to_outer_measure_apply_singleton]
+
+lemma to_measure_apply_eq_zero_iff (hs : measurable_set s) :
+  p.to_measure s = 0 ↔ disjoint p.support s :=
+by rw [to_measure_apply_eq_to_outer_measure_apply p s hs,
+  to_outer_measure_apply_eq_zero_iff]
+
+lemma to_measure_apply_eq_one_iff (hs : measurable_set s) : p.to_measure s = 1 ↔ p.support ⊆ s :=
+(p.to_measure_apply_eq_to_outer_measure_apply s hs : p.to_measure s = p.to_outer_measure s).symm
+  ▸ (p.to_outer_measure_apply_eq_one_iff s)
+
+@[simp]
+lemma to_measure_apply_inter_support (hs : measurable_set s) (hp : measurable_set p.support) :
+  p.to_measure (s ∩ p.support) = p.to_measure s :=
+by simp [p.to_measure_apply_eq_to_outer_measure_apply s hs,
+  p.to_measure_apply_eq_to_outer_measure_apply _ (hs.inter hp)]
+
+lemma to_measure_mono {s t : set α} (hs : measurable_set s) (ht : measurable_set t)
+  (h : s ∩ p.support ⊆ t) : p.to_measure s ≤ p.to_measure t :=
+by simpa only [p.to_measure_apply_eq_to_outer_measure_apply, hs, ht]
+  using to_outer_measure_mono p h
+
+lemma to_measure_apply_eq_of_inter_support_eq {s t : set α} (hs : measurable_set s)
+  (ht : measurable_set t) (h : s ∩ p.support = t ∩ p.support) : p.to_measure s = p.to_measure t :=
+by simpa only [p.to_measure_apply_eq_to_outer_measure_apply, hs, ht]
+  using to_outer_measure_apply_eq_of_inter_support_eq p h
+
+section measurable_singleton_class
+
+variables [measurable_singleton_class α]
+
+lemma to_measure_injective : (to_measure : pmf α → measure α).injective :=
+λ p q h, pmf.ext (λ x, (p.to_measure_apply_singleton x $ measurable_set_singleton x).symm.trans
+  ((congr_fun (congr_arg _ h) _).trans $ q.to_measure_apply_singleton x $
+    measurable_set_singleton x))
+
+@[simp] lemma to_measure_inj {p q : pmf α} : p.to_measure = q.to_measure ↔ p = q :=
+to_measure_injective.eq_iff
+
+@[simp]
+lemma to_measure_apply_finset (s : finset α) : p.to_measure s = ∑ x in s, p x :=
+(p.to_measure_apply_eq_to_outer_measure_apply s s.measurable_set).trans
+  (p.to_outer_measure_apply_finset s)
+
+lemma to_measure_apply_of_finite (hs : s.finite) : p.to_measure s = ∑' x, s.indicator p x :=
+(p.to_measure_apply_eq_to_outer_measure_apply s hs.measurable_set).trans
+  (p.to_outer_measure_apply s)
+
+@[simp]
+lemma to_measure_apply_fintype [fintype α] : p.to_measure s = ∑ x, s.indicator p x :=
+(p.to_measure_apply_eq_to_outer_measure_apply s s.to_finite.measurable_set).trans
+  (p.to_outer_measure_apply_fintype s)
+
+end measurable_singleton_class
+
+end measure
+
+end pmf
+
+namespace measure_theory
+
+open pmf
+
+namespace measure
+
+/-- Given that `α` is a countable, measurable space with all singleton sets measurable,
+we can convert any probability measure into a `pmf`, where the mass of a point
+is the measure of the singleton set under the original measure. -/
+def to_pmf [countable α] [measurable_space α] [measurable_singleton_class α]
+  (μ : measure α) [h : is_probability_measure μ] : pmf α :=
+⟨λ x, μ ({x} : set α), ennreal.summable.has_sum_iff.2 (trans (symm $
+(tsum_indicator_apply_singleton μ set.univ measurable_set.univ).symm.trans
+  (tsum_congr (λ x, congr_fun (set.indicator_univ _) x))) (h.measure_univ))⟩
+
+variables [countable α] [measurable_space α] [measurable_singleton_class α]
+  (μ : measure α) [is_probability_measure μ]
+
+lemma to_pmf_apply (x : α) : μ.to_pmf x = μ {x} := rfl
+
+@[simp] lemma to_pmf_to_measure : μ.to_pmf.to_measure = μ :=
+measure.ext (λ s hs, by simpa only [μ.to_pmf.to_measure_apply s hs,
+  ← μ.tsum_indicator_apply_singleton s hs])
+
+end measure
+
+end measure_theory
+
+namespace pmf
+
+open measure_theory
+
+/-- The measure associated to a `pmf` by `to_measure` is a probability measure -/
+instance to_measure.is_probability_measure [measurable_space α] (p : pmf α) :
+  is_probability_measure (p.to_measure) :=
+⟨by simpa only [measurable_set.univ, to_measure_apply_eq_to_outer_measure_apply,
+  set.indicator_univ, to_outer_measure_apply, ennreal.coe_eq_one] using tsum_coe p⟩
+
+variables [countable α] [measurable_space α] [measurable_singleton_class α]
+  (p : pmf α) (μ : measure α) [is_probability_measure μ]
+
+@[simp] lemma to_measure_to_pmf : p.to_measure.to_pmf = p :=
+pmf.ext (λ x, by rw [← p.to_measure_apply_singleton x (measurable_set_singleton x),
+  p.to_measure.to_pmf_apply])
+
+lemma to_measure_eq_iff_eq_to_pmf (μ : measure α) [is_probability_measure μ] :
+  p.to_measure = μ ↔ p = μ.to_pmf :=
+by rw [← to_measure_inj, measure.to_pmf_to_measure]
+
+lemma to_pmf_eq_iff_to_measure_eq (μ : measure α) [is_probability_measure μ] :
+  μ.to_pmf = p ↔ μ = p.to_measure :=
+by rw [← to_measure_inj, measure.to_pmf_to_measure]
+
+end pmf
diff --git a/src/probability/probability_mass_function/constructions.lean b/src/probability/probability_mass_function/constructions.lean
new file mode 100644
index 0000000000000..4d3a42989695d
--- /dev/null
+++ b/src/probability/probability_mass_function/constructions.lean
@@ -0,0 +1,263 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Devon Tuma
+-/
+import probability.probability_mass_function.monad
+
+/-!
+# Specific Constructions of Probability Mass Functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file gives a number of different `pmf` constructions for common probability distributions.
+
+`map` and `seq` allow pushing a `pmf α` along a function `f : α → β` (or distribution of
+functions `f : pmf (α → β)`) to get a `pmf β`
+
+`of_finset` and `of_fintype` simplify the construction of a `pmf α` from a function `f : α → ℝ≥0∞`,
+by allowing the "sum equals 1" constraint to be in terms of `finset.sum` instead of `tsum`.
+
+`normalize` constructs a `pmf α` by normalizing a function `f : α → ℝ≥0∞` by its sum,
+and `filter` uses this to filter the support of a `pmf` and re-normalize the new distribution.
+
+`bernoulli` represents the bernoulli distribution on `bool`
+
+-/
+
+namespace pmf
+
+noncomputable theory
+variables {α β γ : Type*}
+open_locale classical big_operators nnreal ennreal
+
+section map
+
+/-- The functorial action of a function on a `pmf`. -/
+def map (f : α → β) (p : pmf α) : pmf β := bind p (pure ∘ f)
+
+variables (f : α → β) (p : pmf α) (b : β)
+
+lemma monad_map_eq_map {α β : Type*} (f : α → β) (p : pmf α) : f <$> p = p.map f := rfl
+
+@[simp] lemma map_apply : (map f p) b = ∑' a, if b = f a then p a else 0 := by simp [map]
+
+@[simp] lemma support_map : (map f p).support = f '' p.support :=
+set.ext (λ b, by simp [map, @eq_comm β b])
+
+lemma mem_support_map_iff : b ∈ (map f p).support ↔ ∃ a ∈ p.support, f a = b := by simp
+
+lemma bind_pure_comp : bind p (pure ∘ f) = map f p := rfl
+
+lemma map_id : map id p = p := bind_pure _
+
+lemma map_comp (g : β → γ) : (p.map f).map g = p.map (g ∘ f) := by simp [map]
+
+lemma pure_map (a : α) : (pure a).map f = pure (f a) := pure_bind _ _
+
+lemma map_bind (q : α → pmf β) (f : β → γ) :
+  (p.bind q).map f = p.bind (λ a, (q a).map f) := bind_bind _ _ _
+
+@[simp] lemma bind_map (p : pmf α) (f : α → β) (q : β → pmf γ) :
+  (p.map f).bind q = p.bind (q ∘ f) :=
+(bind_bind _ _ _).trans (congr_arg _ (funext (λ a, pure_bind _ _)))
+
+@[simp] lemma map_const : p.map (function.const α b) = pure b :=
+by simp only [map, bind_const, function.comp_const]
+
+section measure
+
+variable (s : set β)
+
+@[simp] lemma to_outer_measure_map_apply :
+  (p.map f).to_outer_measure s = p.to_outer_measure (f ⁻¹' s) :=
+by simp [map, set.indicator, to_outer_measure_apply p (f ⁻¹' s)]
+
+@[simp] lemma to_measure_map_apply [measurable_space α] [measurable_space β] (hf : measurable f)
+  (hs : measurable_set s) : (p.map f).to_measure s = p.to_measure (f ⁻¹' s) :=
+begin
+  rw [to_measure_apply_eq_to_outer_measure_apply _ s hs,
+    to_measure_apply_eq_to_outer_measure_apply _ (f ⁻¹' s) (measurable_set_preimage hf hs)],
+  exact to_outer_measure_map_apply f p s,
+end
+
+end measure
+
+end map
+
+section seq
+
+/-- The monadic sequencing operation for `pmf`. -/
+def seq (q : pmf (α → β)) (p : pmf α) : pmf β := q.bind (λ m, p.bind $ λ a, pure (m a))
+
+variables (q : pmf (α → β)) (p : pmf α) (b : β)
+
+lemma monad_seq_eq_seq {α β : Type*} (q : pmf (α → β)) (p : pmf α) : q <*> p = q.seq p := rfl
+
+@[simp] lemma seq_apply : (seq q p) b = ∑' (f : α → β) (a : α), if b = f a then q f * p a else 0 :=
+begin
+  simp only [seq, mul_boole, bind_apply, pure_apply],
+  refine tsum_congr (λ f, (ennreal.tsum_mul_left).symm.trans (tsum_congr (λ a, _))),
+  simpa only [mul_zero] using mul_ite (b = f a) (q f) (p a) 0
+end
+
+@[simp] lemma support_seq : (seq q p).support = ⋃ f ∈ q.support, f '' p.support :=
+set.ext (λ b, by simp [-mem_support_iff, seq, @eq_comm β b])
+
+lemma mem_support_seq_iff : b ∈ (seq q p).support ↔ ∃ (f ∈ q.support), b ∈ f '' p.support :=
+by simp
+
+end seq
+
+instance : is_lawful_functor pmf :=
+{ map_const_eq := λ α β, rfl,
+  id_map := λ α, bind_pure,
+  comp_map := λ α β γ g h x, (map_comp _ _ _).symm }
+
+instance : is_lawful_monad pmf :=
+{ bind_pure_comp_eq_map := λ α β f x, rfl,
+  bind_map_eq_seq := λ α β f x, rfl,
+  pure_bind := λ α β, pure_bind,
+  bind_assoc := λ α β γ, bind_bind }
+
+section of_finset
+
+/-- Given a finset `s` and a function `f : α → ℝ≥0∞` with sum `1` on `s`,
+  such that `f a = 0` for `a ∉ s`, we get a `pmf` -/
+def of_finset (f : α → ℝ≥0∞) (s : finset α) (h : ∑ a in s, f a = 1)
+  (h' : ∀ a ∉ s, f a = 0) : pmf α :=
+⟨f, h ▸ has_sum_sum_of_ne_finset_zero h'⟩
+
+variables {f : α → ℝ≥0∞} {s : finset α} (h : ∑ a in s, f a = 1) (h' : ∀ a ∉ s, f a = 0)
+
+@[simp] lemma of_finset_apply (a : α) : of_finset f s h h' a = f a := rfl
+
+@[simp] lemma support_of_finset : (of_finset f s h h').support = s ∩ (function.support f) :=
+set.ext (λ a, by simpa [mem_support_iff] using mt (h' a))
+
+lemma mem_support_of_finset_iff (a : α) : a ∈ (of_finset f s h h').support ↔ a ∈ s ∧ f a ≠ 0 :=
+by simp
+
+lemma of_finset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_finset f s h h' a = 0 :=
+h' a ha
+
+section measure
+
+variable (t : set α)
+
+@[simp] lemma to_outer_measure_of_finset_apply :
+  (of_finset f s h h').to_outer_measure t = ∑' x, t.indicator f x :=
+to_outer_measure_apply (of_finset f s h h') t
+
+@[simp] lemma to_measure_of_finset_apply [measurable_space α] (ht : measurable_set t) :
+  (of_finset f s h h').to_measure t = ∑' x, t.indicator f x :=
+(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
+  (to_outer_measure_of_finset_apply h h' t)
+
+end measure
+
+end of_finset
+
+section of_fintype
+
+/-- Given a finite type `α` and a function `f : α → ℝ≥0∞` with sum 1, we get a `pmf`. -/
+def of_fintype [fintype α] (f : α → ℝ≥0∞) (h : ∑ a, f a = 1) : pmf α :=
+of_finset f finset.univ h (λ a ha, absurd (finset.mem_univ a) ha)
+
+variables [fintype α] {f : α → ℝ≥0∞} (h : ∑ a, f a = 1)
+
+@[simp] lemma of_fintype_apply (a : α) : of_fintype f h a = f a := rfl
+
+@[simp] lemma support_of_fintype : (of_fintype f h).support = function.support f := rfl
+
+lemma mem_support_of_fintype_iff (a : α) : a ∈ (of_fintype f h).support ↔ f a ≠ 0 := iff.rfl
+
+section measure
+
+variable (s : set α)
+
+@[simp] lemma to_outer_measure_of_fintype_apply :
+  (of_fintype f h).to_outer_measure s = ∑' x, s.indicator f x :=
+to_outer_measure_apply (of_fintype f h) s
+
+@[simp] lemma to_measure_of_fintype_apply [measurable_space α] (hs : measurable_set s) :
+  (of_fintype f h).to_measure s = ∑' x, s.indicator f x :=
+(to_measure_apply_eq_to_outer_measure_apply _ s hs).trans
+  (to_outer_measure_of_fintype_apply h s)
+
+end measure
+
+end of_fintype
+
+section normalize
+
+/-- Given a `f` with non-zero and non-infinite sum, get a `pmf` by normalizing `f` by its `tsum` -/
+def normalize (f : α → ℝ≥0∞) (hf0 : tsum f ≠ 0) (hf : tsum f ≠ ∞) : pmf α :=
+⟨λ a, f a * (∑' x, f x)⁻¹, ennreal.summable.has_sum_iff.2
+  (ennreal.tsum_mul_right.trans (ennreal.mul_inv_cancel hf0 hf))⟩
+
+variables {f : α → ℝ≥0∞} (hf0 : tsum f ≠ 0) (hf : tsum f ≠ ∞)
+
+@[simp] lemma normalize_apply (a : α) : (normalize f hf0 hf) a = f a * (∑' x, f x)⁻¹ := rfl
+
+@[simp] lemma support_normalize : (normalize f hf0 hf).support = function.support f :=
+set.ext (λ a, by simp [hf, mem_support_iff])
+
+lemma mem_support_normalize_iff (a : α) : a ∈ (normalize f hf0 hf).support ↔ f a ≠ 0 := by simp
+
+end normalize
+
+section filter
+
+/-- Create new `pmf` by filtering on a set with non-zero measure and normalizing -/
+def filter (p : pmf α) (s : set α) (h : ∃ a ∈ s, a ∈ p.support) : pmf α :=
+pmf.normalize (s.indicator p) (by simpa using h) (p.tsum_coe_indicator_ne_top s)
+
+variables {p : pmf α} {s : set α} (h : ∃ a ∈ s, a ∈ p.support)
+
+@[simp]
+lemma filter_apply (a : α) : (p.filter s h) a = (s.indicator p a) * (∑' a', (s.indicator p) a')⁻¹ :=
+by rw [filter, normalize_apply]
+
+lemma filter_apply_eq_zero_of_not_mem {a : α} (ha : a ∉ s) : (p.filter s h) a = 0 :=
+by rw [filter_apply, set.indicator_apply_eq_zero.mpr (λ ha', absurd ha' ha), zero_mul]
+
+lemma mem_support_filter_iff {a : α} : a ∈ (p.filter s h).support ↔ a ∈ s ∧ a ∈ p.support :=
+(mem_support_normalize_iff _ _ _).trans set.indicator_apply_ne_zero
+
+@[simp] lemma support_filter : (p.filter s h).support = s ∩ p.support:=
+set.ext $ λ x, (mem_support_filter_iff _)
+
+lemma filter_apply_eq_zero_iff (a : α) : (p.filter s h) a = 0 ↔ a ∉ s ∨ a ∉ p.support :=
+by erw [apply_eq_zero_iff, support_filter, set.mem_inter_iff, not_and_distrib]
+
+lemma filter_apply_ne_zero_iff (a : α) : (p.filter s h) a ≠ 0 ↔ a ∈ s ∧ a ∈ p.support :=
+by rw [ne.def, filter_apply_eq_zero_iff, not_or_distrib, not_not, not_not]
+
+end filter
+
+section bernoulli
+
+/-- A `pmf` which assigns probability `p` to `tt` and `1 - p` to `ff`. -/
+def bernoulli (p : ℝ≥0∞) (h : p ≤ 1) : pmf bool :=
+of_fintype (λ b, cond b p (1 - p)) (by simp [h])
+
+variables {p : ℝ≥0∞} (h : p ≤ 1) (b : bool)
+
+@[simp] lemma bernoulli_apply : bernoulli p h b = cond b p (1 - p) := rfl
+
+@[simp] lemma support_bernoulli : (bernoulli p h).support = {b | cond b (p ≠ 0) (p ≠ 1)} :=
+begin
+  refine set.ext (λ b, _),
+  induction b,
+  { simp_rw [mem_support_iff, bernoulli_apply, bool.cond_ff, ne.def, tsub_eq_zero_iff_le, not_le],
+    exact ⟨ne_of_lt, lt_of_le_of_ne h⟩ },
+  { simp only [mem_support_iff, bernoulli_apply, bool.cond_tt, set.mem_set_of_eq], }
+end
+
+lemma mem_support_bernoulli_iff : b ∈ (bernoulli p h).support ↔ cond b (p ≠ 0) (p ≠ 1) := by simp
+
+end bernoulli
+
+end pmf
diff --git a/src/probability/probability_mass_function/monad.lean b/src/probability/probability_mass_function/monad.lean
new file mode 100644
index 0000000000000..2110791e1bd61
--- /dev/null
+++ b/src/probability/probability_mass_function/monad.lean
@@ -0,0 +1,283 @@
+/-
+Copyright (c) 2020 Devon Tuma. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Devon Tuma
+-/
+import probability.probability_mass_function.basic
+
+/-!
+# Monad Operations for Probability Mass Functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file constructs two operations on `pmf` that give it a monad structure.
+`pure a` is the distribution where a single value `a` has probability `1`.
+`bind pa pb : pmf β` is the distribution given by sampling `a : α` from `pa : pmf α`,
+and then sampling from `pb a : pmf β` to get a final result `b : β`.
+
+`bind_on_support` generalizes `bind` to allow binding to a partial function,
+so that the second argument only needs to be defined on the support of the first argument.
+
+-/
+
+noncomputable theory
+variables {α β γ : Type*}
+open_locale classical big_operators nnreal ennreal
+open measure_theory
+
+namespace pmf
+
+section pure
+
+/-- The pure `pmf` is the `pmf` where all the mass lies in one point.
+  The value of `pure a` is `1` at `a` and `0` elsewhere. -/
+def pure (a : α) : pmf α := ⟨λ a', if a' = a then 1 else 0, has_sum_ite_eq _ _⟩
+
+variables (a a' : α)
+
+@[simp] lemma pure_apply : pure a a' = (if a' = a then 1 else 0) := rfl
+
+@[simp] lemma support_pure : (pure a).support = {a} := set.ext (λ a', by simp [mem_support_iff])
+
+lemma mem_support_pure_iff: a' ∈ (pure a).support ↔ a' = a := by simp
+
+@[simp] lemma pure_apply_self : pure a a = 1 := if_pos rfl
+
+lemma pure_apply_of_ne (h : a' ≠ a) : pure a a' = 0 := if_neg h
+
+instance [inhabited α] : inhabited (pmf α) := ⟨pure default⟩
+
+section measure
+
+variable (s : set α)
+
+@[simp] lemma to_outer_measure_pure_apply : (pure a).to_outer_measure s = if a ∈ s then 1 else 0 :=
+begin
+  refine (to_outer_measure_apply (pure a) s).trans _,
+  split_ifs with ha ha,
+  { refine ((tsum_congr (λ b, _)).trans (tsum_ite_eq a 1)),
+    exact ite_eq_left_iff.2 (λ hb, symm (ite_eq_right_iff.2 (λ h, (hb $ h.symm ▸ ha).elim))) },
+  { refine ((tsum_congr (λ b, _)).trans (tsum_zero)),
+    exact ite_eq_right_iff.2 (λ hb, ite_eq_right_iff.2 (λ h, (ha $ h ▸ hb).elim)) }
+end
+
+variable [measurable_space α]
+
+/-- The measure of a set under `pure a` is `1` for sets containing `a` and `0` otherwise -/
+@[simp] lemma to_measure_pure_apply (hs : measurable_set s) :
+  (pure a).to_measure s = if a ∈ s then 1 else 0 :=
+(to_measure_apply_eq_to_outer_measure_apply (pure a) s hs).trans (to_outer_measure_pure_apply a s)
+
+lemma to_measure_pure : (pure a).to_measure = measure.dirac a :=
+measure.ext (λ s hs, by simpa only [to_measure_pure_apply a s hs, measure.dirac_apply' a hs])
+
+@[simp] lemma to_pmf_dirac [countable α] [h : measurable_singleton_class α] :
+  (measure.dirac a).to_pmf = pure a :=
+by rw [to_pmf_eq_iff_to_measure_eq, to_measure_pure]
+
+end measure
+
+end pure
+
+section bind
+
+/-- The monadic bind operation for `pmf`. -/
+def bind (p : pmf α) (f : α → pmf β) : pmf β :=
+⟨λ b, ∑' a, p a * f a b, ennreal.summable.has_sum_iff.2 (ennreal.tsum_comm.trans $
+  by simp only [ennreal.tsum_mul_left, tsum_coe, mul_one])⟩
+
+variables (p : pmf α) (f : α → pmf β) (g : β → pmf γ)
+
+@[simp] lemma bind_apply (b : β) : p.bind f b = ∑'a, p a * f a b := rfl
+
+@[simp] lemma support_bind : (p.bind f).support = ⋃ a ∈ p.support, (f a).support :=
+set.ext (λ b, by simp [mem_support_iff, ennreal.tsum_eq_zero, not_or_distrib])
+
+lemma mem_support_bind_iff (b : β) : b ∈ (p.bind f).support ↔ ∃ a ∈ p.support, b ∈ (f a).support :=
+by simp only [support_bind, set.mem_Union, set.mem_set_of_eq]
+
+@[simp] lemma pure_bind (a : α) (f : α → pmf β) : (pure a).bind f = f a :=
+have ∀ b a', ite (a' = a) 1 0 * f a' b = ite (a' = a) (f a b) 0, from
+  assume b a', by split_ifs; simp; subst h; simp,
+by ext b; simp [this]
+
+@[simp] lemma bind_pure : p.bind pure = p :=
+pmf.ext (λ x, (bind_apply _ _ _).trans (trans (tsum_eq_single x $
+  (λ y hy, by rw [pure_apply_of_ne _ _ hy.symm, mul_zero])) $ by rw [pure_apply_self, mul_one]))
+
+@[simp] lemma bind_const (p : pmf α) (q : pmf β) : p.bind (λ _, q) = q :=
+pmf.ext (λ x, by rw [bind_apply, ennreal.tsum_mul_right, tsum_coe, one_mul])
+
+@[simp] lemma bind_bind : (p.bind f).bind g = p.bind (λ a, (f a).bind g) :=
+pmf.ext (λ b, by simpa only [ennreal.coe_eq_coe.symm, bind_apply, ennreal.tsum_mul_left.symm,
+    ennreal.tsum_mul_right.symm, mul_assoc, mul_left_comm, mul_comm] using ennreal.tsum_comm)
+
+lemma bind_comm (p : pmf α) (q : pmf β) (f : α → β → pmf γ) :
+  p.bind (λ a, q.bind (f a)) = q.bind (λ b, p.bind (λ a, f a b)) :=
+pmf.ext (λ b, by simpa only [ennreal.coe_eq_coe.symm, bind_apply, ennreal.tsum_mul_left.symm,
+  ennreal.tsum_mul_right.symm, mul_assoc, mul_left_comm, mul_comm] using ennreal.tsum_comm)
+
+section measure
+
+variable (s : set β)
+
+@[simp] lemma to_outer_measure_bind_apply :
+  (p.bind f).to_outer_measure s = ∑' a, p a * (f a).to_outer_measure s :=
+calc (p.bind f).to_outer_measure s
+  = ∑' b, if b ∈ s then ∑' a, p a * f a b else 0 :
+    by simp [to_outer_measure_apply, set.indicator_apply]
+  ... = ∑' b a, p a * (if b ∈ s then f a b else 0) :
+    tsum_congr (λ b, by split_ifs; simp)
+  ... = ∑' a b, p a * (if b ∈ s then f a b else 0) :
+    tsum_comm' ennreal.summable (λ _, ennreal.summable) (λ _, ennreal.summable)
+  ... = ∑' a, p a * ∑' b, (if b ∈ s then f a b else 0) :
+    tsum_congr (λ a, ennreal.tsum_mul_left)
+  ... = ∑' a, p a * ∑' b, if b ∈ s then f a b else 0 :
+    tsum_congr (λ a, congr_arg (λ x, (p a) * x) $ tsum_congr (λ b, by split_ifs; refl))
+  ... = ∑' a, p a * (f a).to_outer_measure s :
+    tsum_congr (λ a, by simp only [to_outer_measure_apply, set.indicator_apply])
+
+/-- The measure of a set under `p.bind f` is the sum over `a : α`
+  of the probability of `a` under `p` times the measure of the set under `f a` -/
+@[simp] lemma to_measure_bind_apply [measurable_space β] (hs : measurable_set s) :
+  (p.bind f).to_measure s = ∑' a, p a * (f a).to_measure s :=
+(to_measure_apply_eq_to_outer_measure_apply (p.bind f) s hs).trans
+  ((to_outer_measure_bind_apply p f s).trans (tsum_congr (λ a, congr_arg (λ x, p a * x)
+  (to_measure_apply_eq_to_outer_measure_apply (f a) s hs).symm)))
+
+end measure
+
+end bind
+
+instance : monad pmf :=
+{ pure := λ A a, pure a,
+  bind := λ A B pa pb, pa.bind pb }
+
+section bind_on_support
+
+/-- Generalized version of `bind` allowing `f` to only be defined on the support of `p`.
+  `p.bind f` is equivalent to `p.bind_on_support (λ a _, f a)`, see `bind_on_support_eq_bind` -/
+def bind_on_support (p : pmf α) (f : Π a ∈ p.support, pmf β) : pmf β :=
+⟨λ b, ∑' a, p a * if h : p a = 0 then 0 else f a h b,
+ennreal.summable.has_sum_iff.2 begin
+  refine (ennreal.tsum_comm.trans (trans (tsum_congr $ λ a, _) p.tsum_coe)),
+  simp_rw [ennreal.tsum_mul_left],
+  split_ifs with h,
+  { simp only [h, zero_mul] },
+  { rw [(f a h).tsum_coe, mul_one] }
+end⟩
+
+variables {p : pmf α} (f : Π a ∈ p.support, pmf β)
+
+@[simp] lemma bind_on_support_apply (b : β) :
+  p.bind_on_support f b = ∑' a, p a * if h : p a = 0 then 0 else f a h b := rfl
+
+@[simp] lemma support_bind_on_support :
+  (p.bind_on_support f).support = ⋃ (a : α) (h : a ∈ p.support), (f a h).support :=
+begin
+  refine set.ext (λ b, _),
+  simp only [ennreal.tsum_eq_zero, not_or_distrib, mem_support_iff,
+    bind_on_support_apply, ne.def, not_forall, mul_eq_zero, set.mem_Union],
+  exact ⟨λ hb, let ⟨a, ⟨ha, ha'⟩⟩ := hb in ⟨a, ha, by simpa [ha] using ha'⟩,
+    λ hb, let ⟨a, ha, ha'⟩ := hb in ⟨a, ⟨ha, by simpa [(mem_support_iff _ a).1 ha] using ha'⟩⟩⟩
+end
+
+lemma mem_support_bind_on_support_iff (b : β) :
+  b ∈ (p.bind_on_support f).support ↔ ∃ (a : α) (h : a ∈ p.support), b ∈ (f a h).support :=
+by simp only [support_bind_on_support, set.mem_set_of_eq, set.mem_Union]
+
+/-- `bind_on_support` reduces to `bind` if `f` doesn't depend on the additional hypothesis -/
+@[simp] lemma bind_on_support_eq_bind (p : pmf α) (f : α → pmf β) :
+  p.bind_on_support (λ a _, f a) = p.bind f :=
+begin
+  ext b x,
+  have : ∀ a, ite (p a = 0) 0 (p a * f a b) = p a * f a b,
+  from λ a, ite_eq_right_iff.2 (λ h, h.symm ▸ symm (zero_mul $ f a b)),
+  simp only [bind_on_support_apply (λ a _, f a), p.bind_apply f,
+    dite_eq_ite, mul_ite, mul_zero, this],
+end
+
+lemma bind_on_support_eq_zero_iff (b : β) :
+  p.bind_on_support f b = 0 ↔ ∀ a (ha : p a ≠ 0), f a ha b = 0 :=
+begin
+  simp only [bind_on_support_apply, ennreal.tsum_eq_zero, mul_eq_zero, or_iff_not_imp_left],
+  exact ⟨λ h a ha, trans (dif_neg ha).symm (h a ha), λ h a ha, trans (dif_neg ha) (h a ha)⟩,
+end
+
+@[simp] lemma pure_bind_on_support (a : α) (f : Π (a' : α) (ha : a' ∈ (pure a).support), pmf β) :
+  (pure a).bind_on_support f = f a ((mem_support_pure_iff a a).mpr rfl) :=
+begin
+  refine pmf.ext (λ b, _),
+  simp only [bind_on_support_apply, pure_apply],
+  refine trans (tsum_congr (λ a', _)) (tsum_ite_eq a _),
+  by_cases h : (a' = a); simp [h],
+end
+
+lemma bind_on_support_pure (p : pmf α) :
+  p.bind_on_support (λ a _, pure a) = p :=
+by simp only [pmf.bind_pure, pmf.bind_on_support_eq_bind]
+
+@[simp] lemma bind_on_support_bind_on_support (p : pmf α)
+  (f : ∀ a ∈ p.support, pmf β)
+  (g : ∀ (b ∈ (p.bind_on_support f).support), pmf γ) :
+  (p.bind_on_support f).bind_on_support g =
+    p.bind_on_support (λ a ha, (f a ha).bind_on_support
+      (λ b hb, g b ((mem_support_bind_on_support_iff f b).mpr ⟨a, ha, hb⟩))) :=
+begin
+  refine pmf.ext (λ a, _),
+  simp only [ennreal.coe_eq_coe.symm, bind_on_support_apply, ← tsum_dite_right,
+    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
+  simp only [ennreal.tsum_eq_zero, ennreal.coe_eq_coe, ennreal.coe_eq_zero, ennreal.coe_zero,
+    dite_eq_left_iff, mul_eq_zero],
+  refine ennreal.tsum_comm.trans (tsum_congr (λ a', tsum_congr (λ b, _))),
+  split_ifs,
+  any_goals { ring1 },
+  { have := h_1 a', simp [h] at this, contradiction },
+  { simp [h_2], },
+end
+
+lemma bind_on_support_comm (p : pmf α) (q : pmf β)
+  (f : ∀ (a ∈ p.support) (b ∈ q.support), pmf γ) :
+  p.bind_on_support (λ a ha, q.bind_on_support (f a ha)) =
+    q.bind_on_support (λ b hb, p.bind_on_support (λ a ha, f a ha b hb)) :=
+begin
+  apply pmf.ext, rintro c,
+  simp only [ennreal.coe_eq_coe.symm, bind_on_support_apply, ← tsum_dite_right,
+    ennreal.tsum_mul_left.symm, ennreal.tsum_mul_right.symm],
+  refine trans (ennreal.tsum_comm) (tsum_congr (λ b, tsum_congr (λ a, _))),
+  split_ifs with h1 h2 h2; ring,
+end
+
+section measure
+
+variable (s : set β)
+
+@[simp] lemma to_outer_measure_bind_on_support_apply : (p.bind_on_support f).to_outer_measure s
+  = ∑' a, p a * if h : p a = 0 then 0 else (f a h).to_outer_measure s :=
+begin
+  simp only [to_outer_measure_apply, set.indicator_apply, bind_on_support_apply],
+  calc ∑' b, ite (b ∈ s) (∑' a, p a * dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0
+    = ∑' b a, ite (b ∈ s) (p a * dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0 :
+      tsum_congr (λ b, by split_ifs with hbs; simp only [eq_self_iff_true, tsum_zero])
+    ... = ∑' a b, ite (b ∈ s) (p a * dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0 : ennreal.tsum_comm
+    ... = ∑' a, p a * ∑' b, ite (b ∈ s) (dite (p a = 0) (λ h, 0) (λ h, f a h b)) 0 :
+      tsum_congr (λ a, by simp only [← ennreal.tsum_mul_left, mul_ite, mul_zero])
+    ... = ∑' a, p a * dite (p a = 0) (λ h, 0) (λ h, ∑' b, ite (b ∈ s) (f a h b) 0) :
+      tsum_congr (λ a, by split_ifs with ha; simp only [if_t_t, tsum_zero, eq_self_iff_true])
+end
+
+/-- The measure of a set under `p.bind_on_support f` is the sum over `a : α`
+  of the probability of `a` under `p` times the measure of the set under `f a _`.
+  The additional if statement is needed since `f` is only a partial function -/
+@[simp] lemma to_measure_bind_on_support_apply [measurable_space β] (hs : measurable_set s) :
+  (p.bind_on_support f).to_measure s
+    = ∑' a, p a * if h : p a = 0 then 0 else (f a h).to_measure s :=
+by simp only [to_measure_apply_eq_to_outer_measure_apply _ _ hs,
+  to_outer_measure_bind_on_support_apply]
+
+end measure
+
+end bind_on_support
+
+end pmf
diff --git a/src/probability/probability_mass_function/uniform.lean b/src/probability/probability_mass_function/uniform.lean
new file mode 100644
index 0000000000000..42fbd7618dc16
--- /dev/null
+++ b/src/probability/probability_mass_function/uniform.lean
@@ -0,0 +1,176 @@
+/-
+Copyright (c) 2022 Devon Tuma. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Devon Tuma
+-/
+import probability.probability_mass_function.constructions
+
+/-!
+# Uniform Probability Mass Functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines a number of uniform `pmf` distributions from various inputs,
+  uniformly drawing from the corresponding object.
+
+`pmf.uniform_of_finset` gives each element in the set equal probability,
+  with `0` probability for elements not in the set.
+
+`pmf.uniform_of_fintype` gives all elements equal probability,
+  equal to the inverse of the size of the `fintype`.
+
+`pmf.of_multiset` draws randomly from the given `multiset`, treating duplicate values as distinct.
+  Each probability is given by the count of the element divided by the size of the `multiset`
+
+-/
+
+namespace pmf
+
+noncomputable theory
+variables {α β γ : Type*}
+open_locale classical big_operators nnreal ennreal
+
+section uniform_of_finset
+
+/-- Uniform distribution taking the same non-zero probability on the nonempty finset `s` -/
+def uniform_of_finset (s : finset α) (hs : s.nonempty) : pmf α :=
+of_finset (λ a, if a ∈ s then s.card⁻¹ else 0) s (Exists.rec_on hs (λ x hx,
+  calc ∑ (a : α) in s, ite (a ∈ s) (s.card : ℝ≥0∞)⁻¹ 0
+    = ∑ (a : α) in s, (s.card : ℝ≥0∞)⁻¹ : finset.sum_congr rfl (λ x hx, by simp [hx])
+    ... = (s.card : ℝ≥0∞) * (s.card : ℝ≥0∞)⁻¹ : by rw [finset.sum_const, nsmul_eq_mul]
+    ... = 1 : ennreal.mul_inv_cancel (by simpa only [ne.def, nat.cast_eq_zero, finset.card_eq_zero]
+      using (finset.nonempty_iff_ne_empty.1 hs)) (ennreal.nat_ne_top s.card)))
+        (λ x hx, by simp only [hx, if_false])
+
+variables {s : finset α} (hs : s.nonempty) {a : α}
+
+@[simp] lemma uniform_of_finset_apply (a : α) :
+  uniform_of_finset s hs a = if a ∈ s then s.card⁻¹ else 0 := rfl
+
+lemma uniform_of_finset_apply_of_mem (ha : a ∈ s) : uniform_of_finset s hs a = (s.card)⁻¹ :=
+by simp [ha]
+
+lemma uniform_of_finset_apply_of_not_mem (ha : a ∉ s) : uniform_of_finset s hs a = 0 :=
+by simp [ha]
+
+@[simp] lemma support_uniform_of_finset : (uniform_of_finset s hs).support = s :=
+set.ext (let ⟨a, ha⟩ := hs in by simp [mem_support_iff, finset.ne_empty_of_mem ha])
+
+lemma mem_support_uniform_of_finset_iff (a : α) : a ∈ (uniform_of_finset s hs).support ↔ a ∈ s :=
+by simp
+
+section measure
+
+variable (t : set α)
+
+@[simp] lemma to_outer_measure_uniform_of_finset_apply :
+  (uniform_of_finset s hs).to_outer_measure t = (s.filter (∈ t)).card / s.card :=
+calc (uniform_of_finset s hs).to_outer_measure t
+  = ∑' x, if x ∈ t then (uniform_of_finset s hs x) else 0 :
+    to_outer_measure_apply (uniform_of_finset s hs) t
+  ... = ∑' x, if x ∈ s ∧ x ∈ t then (s.card : ℝ≥0∞)⁻¹ else 0 :
+    (tsum_congr (λ x, by simp only [uniform_of_finset_apply,
+      and_comm (x ∈ s), ite_and, ennreal.coe_nat]))
+  ... = (∑ x in (s.filter (∈ t)), if x ∈ s ∧ x ∈ t then (s.card : ℝ≥0∞)⁻¹ else 0) :
+    (tsum_eq_sum (λ x hx, if_neg (λ h, hx (finset.mem_filter.2 h))))
+  ... = (∑ x in (s.filter (∈ t)), (s.card : ℝ≥0∞)⁻¹) :
+    (finset.sum_congr rfl $ λ x hx, let this : x ∈ s ∧ x ∈ t := by simpa using hx in
+      by simp only [this, and_self, if_true])
+  ... = (s.filter (∈ t)).card / s.card :
+    have (s.card : ℝ≥0∞) ≠ 0 := nat.cast_ne_zero.2 (hs.rec_on $ λ _, finset.card_ne_zero_of_mem),
+    by simp only [div_eq_mul_inv, finset.sum_const, nsmul_eq_mul]
+
+@[simp] lemma to_measure_uniform_of_finset_apply [measurable_space α] (ht : measurable_set t) :
+  (uniform_of_finset s hs).to_measure t = (s.filter (∈ t)).card / s.card :=
+(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
+  (to_outer_measure_uniform_of_finset_apply hs t)
+
+end measure
+
+end uniform_of_finset
+
+section uniform_of_fintype
+
+/-- The uniform pmf taking the same uniform value on all of the fintype `α` -/
+def uniform_of_fintype (α : Type*) [fintype α] [nonempty α] : pmf α :=
+  uniform_of_finset (finset.univ) (finset.univ_nonempty)
+
+variables [fintype α] [nonempty α]
+
+@[simp] lemma uniform_of_fintype_apply (a : α) : uniform_of_fintype α a = (fintype.card α)⁻¹ :=
+by simpa only [uniform_of_fintype, finset.mem_univ, if_true, uniform_of_finset_apply]
+
+@[simp] lemma support_uniform_of_fintype (α : Type*) [fintype α] [nonempty α] :
+  (uniform_of_fintype α).support = ⊤ :=
+set.ext (λ x, by simp [mem_support_iff])
+
+lemma mem_support_uniform_of_fintype (a : α) : a ∈ (uniform_of_fintype α).support := by simp
+
+section measure
+
+variable (s : set α)
+
+lemma to_outer_measure_uniform_of_fintype_apply :
+  (uniform_of_fintype α).to_outer_measure s = fintype.card s / fintype.card α :=
+by simpa [uniform_of_fintype]
+
+lemma to_measure_uniform_of_fintype_apply [measurable_space α] (hs : measurable_set s) :
+  (uniform_of_fintype α).to_measure s = fintype.card s / fintype.card α :=
+by simpa [uniform_of_fintype, hs]
+
+end measure
+
+end uniform_of_fintype
+
+section of_multiset
+
+/-- Given a non-empty multiset `s` we construct the `pmf` which sends `a` to the fraction of
+  elements in `s` that are `a`. -/
+def of_multiset (s : multiset α) (hs : s ≠ 0) : pmf α :=
+⟨λ a, s.count a / s.card, ennreal.summable.has_sum_iff.2
+  (calc ∑' (b : α), (s.count b : ℝ≥0∞) / s.card = s.card⁻¹ * ∑' b, s.count b :
+      by simp_rw [ennreal.div_eq_inv_mul, ennreal.tsum_mul_left]
+    ... = s.card⁻¹ * ∑ b in s.to_finset, (s.count b : ℝ≥0∞) :
+      congr_arg (λ x, s.card⁻¹ * x) (tsum_eq_sum $ λ a ha, (nat.cast_eq_zero.2 $
+        by rwa [multiset.count_eq_zero, ← multiset.mem_to_finset]))
+    ... = 1 : by rw [← nat.cast_sum, multiset.to_finset_sum_count_eq s, ennreal.inv_mul_cancel
+      (nat.cast_ne_zero.2 (hs ∘ multiset.card_eq_zero.1)) (ennreal.nat_ne_top _)] ) ⟩
+
+variables {s : multiset α} (hs : s ≠ 0)
+
+@[simp] lemma of_multiset_apply (a : α) : of_multiset s hs a = s.count a / s.card := rfl
+
+@[simp] lemma support_of_multiset : (of_multiset s hs).support = s.to_finset :=
+set.ext (by simp [mem_support_iff, hs])
+
+lemma mem_support_of_multiset_iff (a : α) : a ∈ (of_multiset s hs).support ↔ a ∈ s.to_finset :=
+by simp
+
+lemma of_multiset_apply_of_not_mem {a : α} (ha : a ∉ s) : of_multiset s hs a = 0 :=
+by simpa only [of_multiset_apply, ennreal.div_zero_iff, nat.cast_eq_zero,
+  multiset.count_eq_zero, ennreal.nat_ne_top, or_false] using ha
+
+section measure
+
+variable (t : set α)
+
+@[simp] lemma to_outer_measure_of_multiset_apply :
+  (of_multiset s hs).to_outer_measure t = (∑' x, (s.filter (∈ t)).count x) / s.card :=
+begin
+  rw [div_eq_mul_inv, ← ennreal.tsum_mul_right, to_outer_measure_apply],
+  refine tsum_congr (λ x, _),
+  by_cases hx : x ∈ t;
+  simp [set.indicator, hx, div_eq_mul_inv],
+end
+
+@[simp] lemma to_measure_of_multiset_apply [measurable_space α] (ht : measurable_set t) :
+  (of_multiset s hs).to_measure t = (∑' x, (s.filter (∈ t)).count x) / s.card :=
+(to_measure_apply_eq_to_outer_measure_apply _ t ht).trans
+  (to_outer_measure_of_multiset_apply hs t)
+
+end measure
+
+end of_multiset
+
+end pmf
diff --git a/src/probability/process/adapted.lean b/src/probability/process/adapted.lean
new file mode 100644
index 0000000000000..a483a31db3c44
--- /dev/null
+++ b/src/probability/process/adapted.lean
@@ -0,0 +1,218 @@
+/-
+Copyright (c) 2021 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying, Rémy Degenne
+-/
+import probability.process.filtration
+import topology.instances.discrete
+
+/-!
+# Adapted and progressively measurable processes
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines some standard definition from the theory of stochastic processes including
+filtrations and stopping times. These definitions are used to model the amount of information
+at a specific time and are the first step in formalizing stochastic processes.
+
+## Main definitions
+
+* `measure_theory.adapted`: a sequence of functions `u` is said to be adapted to a
+  filtration `f` if at each point in time `i`, `u i` is `f i`-strongly measurable
+* `measure_theory.prog_measurable`: a sequence of functions `u` is said to be progressively
+  measurable with respect to a filtration `f` if at each point in time `i`, `u` restricted to
+  `set.Iic i × Ω` is strongly measurable with respect to the product `measurable_space` structure
+  where the σ-algebra used for `Ω` is `f i`.
+
+## Main results
+
+* `adapted.prog_measurable_of_continuous`: a continuous adapted process is progressively measurable.
+
+## Tags
+
+adapted, progressively measurable
+
+-/
+
+open filter order topological_space
+open_locale classical measure_theory nnreal ennreal topology big_operators
+
+namespace measure_theory
+
+variables {Ω β ι : Type*} {m : measurable_space Ω} [topological_space β] [preorder ι]
+  {u v : ι → Ω → β} {f : filtration ι m}
+
+/-- A sequence of functions `u` is adapted to a filtration `f` if for all `i`,
+`u i` is `f i`-measurable. -/
+def adapted (f : filtration ι m) (u : ι → Ω → β) : Prop :=
+∀ i : ι, strongly_measurable[f i] (u i)
+
+namespace adapted
+
+@[protected, to_additive] lemma mul [has_mul β] [has_continuous_mul β]
+  (hu : adapted f u) (hv : adapted f v) :
+  adapted f (u * v) :=
+λ i, (hu i).mul (hv i)
+
+@[protected, to_additive] lemma div [has_div β] [has_continuous_div β]
+  (hu : adapted f u) (hv : adapted f v) :
+  adapted f (u / v) :=
+λ i, (hu i).div (hv i)
+
+@[protected, to_additive] lemma inv [group β] [topological_group β] (hu : adapted f u) :
+  adapted f u⁻¹ :=
+λ i, (hu i).inv
+
+@[protected] lemma smul [has_smul ℝ β] [has_continuous_smul ℝ β] (c : ℝ) (hu : adapted f u) :
+  adapted f (c • u) :=
+λ i, (hu i).const_smul c
+
+@[protected] lemma strongly_measurable {i : ι} (hf : adapted f u) :
+  strongly_measurable[m] (u i) :=
+(hf i).mono (f.le i)
+
+lemma strongly_measurable_le {i j : ι} (hf : adapted f u) (hij : i ≤ j) :
+  strongly_measurable[f j] (u i) :=
+(hf i).mono (f.mono hij)
+
+end adapted
+
+lemma adapted_const (f : filtration ι m) (x : β) : adapted f (λ _ _, x) :=
+λ i, strongly_measurable_const
+
+variable (β)
+lemma adapted_zero [has_zero β] (f : filtration ι m) : adapted f (0 : ι → Ω → β) :=
+λ i, @strongly_measurable_zero Ω β (f i) _ _
+variable {β}
+
+lemma filtration.adapted_natural [metrizable_space β] [mβ : measurable_space β] [borel_space β]
+  {u : ι → Ω → β} (hum : ∀ i, strongly_measurable[m] (u i)) :
+  adapted (filtration.natural u hum) u :=
+begin
+  assume i,
+  refine strongly_measurable.mono _ (le_supr₂_of_le i (le_refl i) le_rfl),
+  rw strongly_measurable_iff_measurable_separable,
+  exact ⟨measurable_iff_comap_le.2 le_rfl, (hum i).is_separable_range⟩
+end
+
+/-- Progressively measurable process. A sequence of functions `u` is said to be progressively
+measurable with respect to a filtration `f` if at each point in time `i`, `u` restricted to
+`set.Iic i × Ω` is measurable with respect to the product `measurable_space` structure where the
+σ-algebra used for `Ω` is `f i`.
+The usual definition uses the interval `[0,i]`, which we replace by `set.Iic i`. We recover the
+usual definition for index types `ℝ≥0` or `ℕ`. -/
+def prog_measurable [measurable_space ι] (f : filtration ι m) (u : ι → Ω → β) : Prop :=
+∀ i, strongly_measurable[subtype.measurable_space.prod (f i)] (λ p : set.Iic i × Ω, u p.1 p.2)
+
+lemma prog_measurable_const [measurable_space ι] (f : filtration ι m) (b : β) :
+  prog_measurable f ((λ _ _, b) : ι → Ω → β) :=
+λ i, @strongly_measurable_const _ _ (subtype.measurable_space.prod (f i)) _ _
+
+namespace prog_measurable
+
+variables [measurable_space ι]
+
+protected lemma adapted (h : prog_measurable f u) : adapted f u :=
+begin
+  intro i,
+  have : u i = (λ p : set.Iic i × Ω, u p.1 p.2) ∘ (λ x, (⟨i, set.mem_Iic.mpr le_rfl⟩, x)) := rfl,
+  rw this,
+  exact (h i).comp_measurable measurable_prod_mk_left,
+end
+
+protected lemma comp {t : ι → Ω → ι} [topological_space ι] [borel_space ι] [metrizable_space ι]
+  (h : prog_measurable f u) (ht : prog_measurable f t)
+  (ht_le : ∀ i ω, t i ω ≤ i) :
+  prog_measurable f (λ i ω, u (t i ω) ω) :=
+begin
+  intro i,
+  have : (λ p : ↥(set.Iic i) × Ω, u (t (p.fst : ι) p.snd) p.snd)
+    = (λ p : ↥(set.Iic i) × Ω, u (p.fst : ι) p.snd) ∘ (λ p : ↥(set.Iic i) × Ω,
+      (⟨t (p.fst : ι) p.snd, set.mem_Iic.mpr ((ht_le _ _).trans p.fst.prop)⟩, p.snd)) := rfl,
+  rw this,
+  exact (h i).comp_measurable ((ht i).measurable.subtype_mk.prod_mk measurable_snd),
+end
+
+section arithmetic
+
+@[to_additive] protected lemma mul [has_mul β] [has_continuous_mul β]
+  (hu : prog_measurable f u) (hv : prog_measurable f v) :
+  prog_measurable f (λ i ω, u i ω * v i ω) :=
+λ i, (hu i).mul (hv i)
+
+@[to_additive] protected lemma finset_prod' {γ} [comm_monoid β] [has_continuous_mul β]
+  {U : γ → ι → Ω → β} {s : finset γ} (h : ∀ c ∈ s, prog_measurable f (U c)) :
+  prog_measurable f (∏ c in s, U c) :=
+finset.prod_induction U (prog_measurable f) (λ _ _, prog_measurable.mul)
+  (prog_measurable_const _ 1) h
+
+@[to_additive] protected lemma finset_prod {γ} [comm_monoid β] [has_continuous_mul β]
+  {U : γ → ι → Ω → β} {s : finset γ} (h : ∀ c ∈ s, prog_measurable f (U c)) :
+  prog_measurable f (λ i a, ∏ c in s, U c i a) :=
+by { convert prog_measurable.finset_prod' h, ext i a, simp only [finset.prod_apply], }
+
+@[to_additive] protected lemma inv [group β] [topological_group β] (hu : prog_measurable f u) :
+  prog_measurable f (λ i ω, (u i ω)⁻¹) :=
+λ i, (hu i).inv
+
+@[to_additive] protected lemma div [group β] [topological_group β]
+  (hu : prog_measurable f u) (hv : prog_measurable f v) :
+  prog_measurable f (λ i ω, u i ω / v i ω) :=
+λ i, (hu i).div (hv i)
+
+end arithmetic
+
+end prog_measurable
+
+lemma prog_measurable_of_tendsto' {γ} [measurable_space ι] [pseudo_metrizable_space β]
+  (fltr : filter γ) [fltr.ne_bot] [fltr.is_countably_generated] {U : γ → ι → Ω → β}
+  (h : ∀ l, prog_measurable f (U l)) (h_tendsto : tendsto U fltr (𝓝 u)) :
+  prog_measurable f u :=
+begin
+  assume i,
+  apply @strongly_measurable_of_tendsto (set.Iic i × Ω) β γ (measurable_space.prod _ (f i))
+   _ _ fltr _ _ _ _ (λ l, h l i),
+  rw tendsto_pi_nhds at h_tendsto ⊢,
+  intro x,
+  specialize h_tendsto x.fst,
+  rw tendsto_nhds at h_tendsto ⊢,
+  exact λ s hs h_mem, h_tendsto {g | g x.snd ∈ s} (hs.preimage (continuous_apply x.snd)) h_mem,
+end
+
+lemma prog_measurable_of_tendsto [measurable_space ι] [pseudo_metrizable_space β]
+  {U : ℕ → ι → Ω → β}
+  (h : ∀ l, prog_measurable f (U l)) (h_tendsto : tendsto U at_top (𝓝 u)) :
+  prog_measurable f u :=
+prog_measurable_of_tendsto' at_top h h_tendsto
+
+/-- A continuous and adapted process is progressively measurable. -/
+theorem adapted.prog_measurable_of_continuous
+  [topological_space ι] [metrizable_space ι] [second_countable_topology ι]
+  [measurable_space ι] [opens_measurable_space ι]
+  [pseudo_metrizable_space β]
+  (h : adapted f u) (hu_cont : ∀ ω, continuous (λ i, u i ω)) :
+  prog_measurable f u :=
+λ i, @strongly_measurable_uncurry_of_continuous_of_strongly_measurable _ _ (set.Iic i) _ _ _ _ _ _ _
+  (f i) _ (λ ω, (hu_cont ω).comp continuous_induced_dom) (λ j, (h j).mono (f.mono j.prop))
+
+/-- For filtrations indexed by a discrete order, `adapted` and `prog_measurable` are equivalent.
+This lemma provides `adapted f u → prog_measurable f u`.
+See `prog_measurable.adapted` for the reverse direction, which is true more generally. -/
+lemma adapted.prog_measurable_of_discrete [topological_space ι] [discrete_topology ι]
+  [second_countable_topology ι] [measurable_space ι] [opens_measurable_space ι]
+  [pseudo_metrizable_space β]
+  (h : adapted f u) :
+  prog_measurable f u :=
+h.prog_measurable_of_continuous (λ _, continuous_of_discrete_topology)
+
+-- this dot notation will make more sense once we have a more general definition for predictable
+lemma predictable.adapted {f : filtration ℕ m} {u : ℕ → Ω → β}
+  (hu : adapted f (λ n, u (n + 1))) (hu0 : strongly_measurable[f 0] (u 0)) :
+  adapted f u :=
+λ n, match n with
+  | 0 := hu0
+  | n + 1 := (hu n).mono (f.mono n.le_succ)
+end
+
+end measure_theory
diff --git a/src/probability/process/filtration.lean b/src/probability/process/filtration.lean
new file mode 100644
index 0000000000000..9bcf5a38d2a62
--- /dev/null
+++ b/src/probability/process/filtration.lean
@@ -0,0 +1,345 @@
+/-
+Copyright (c) 2021 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying, Rémy Degenne
+-/
+import measure_theory.function.conditional_expectation.real
+
+/-!
+# Filtrations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines filtrations of a measurable space and σ-finite filtrations.
+
+## Main definitions
+
+* `measure_theory.filtration`: a filtration on a measurable space. That is, a monotone sequence of
+  sub-σ-algebras.
+* `measure_theory.sigma_finite_filtration`: a filtration `f` is σ-finite with respect to a measure
+  `μ` if for all `i`, `μ.trim (f.le i)` is σ-finite.
+* `measure_theory.filtration.natural`: the smallest filtration that makes a process adapted. That
+  notion `adapted` is not defined yet in this file. See `measure_theory.adapted`.
+
+## Main results
+
+* `measure_theory.filtration.complete_lattice`: filtrations are a complete lattice.
+
+## Tags
+
+filtration, stochastic process
+
+-/
+
+open filter order topological_space
+open_locale classical measure_theory nnreal ennreal topology big_operators
+
+namespace measure_theory
+
+
+/-- A `filtration` on a measurable space `Ω` with σ-algebra `m` is a monotone
+sequence of sub-σ-algebras of `m`. -/
+structure filtration {Ω : Type*} (ι : Type*) [preorder ι] (m : measurable_space Ω) :=
+(seq   : ι → measurable_space Ω)
+(mono' : monotone seq)
+(le'   : ∀ i : ι, seq i ≤ m)
+
+variables {Ω β ι : Type*} {m : measurable_space Ω}
+
+instance [preorder ι] : has_coe_to_fun (filtration ι m) (λ _, ι → measurable_space Ω) :=
+⟨λ f, f.seq⟩
+
+namespace filtration
+variables [preorder ι]
+
+protected lemma mono {i j : ι} (f : filtration ι m) (hij : i ≤ j) : f i ≤ f j := f.mono' hij
+
+protected lemma le (f : filtration ι m) (i : ι) : f i ≤ m := f.le' i
+
+@[ext] protected lemma ext {f g : filtration ι m} (h : (f : ι → measurable_space Ω) = g) : f = g :=
+by { cases f, cases g, simp only, exact h, }
+
+variable (ι)
+/-- The constant filtration which is equal to `m` for all `i : ι`. -/
+def const (m' : measurable_space Ω) (hm' : m' ≤ m) : filtration ι m :=
+⟨λ _, m', monotone_const, λ _, hm'⟩
+variable {ι}
+
+@[simp]
+lemma const_apply {m' : measurable_space Ω} {hm' : m' ≤ m} (i : ι) : const ι m' hm' i = m' := rfl
+
+instance : inhabited (filtration ι m) := ⟨const ι m le_rfl⟩
+
+instance : has_le (filtration ι m) := ⟨λ f g, ∀ i, f i ≤ g i⟩
+
+instance : has_bot (filtration ι m) := ⟨const ι ⊥ bot_le⟩
+
+instance : has_top (filtration ι m) := ⟨const ι m le_rfl⟩
+
+instance : has_sup (filtration ι m) := ⟨λ f g,
+{ seq   := λ i, f i ⊔ g i,
+  mono' := λ i j hij, sup_le ((f.mono hij).trans le_sup_left) ((g.mono hij).trans le_sup_right),
+  le'   := λ i, sup_le (f.le i) (g.le i) }⟩
+
+@[norm_cast] lemma coe_fn_sup {f g : filtration ι m} : ⇑(f ⊔ g) = f ⊔ g := rfl
+
+instance : has_inf (filtration ι m) := ⟨λ f g,
+{ seq   := λ i, f i ⊓ g i,
+  mono' := λ i j hij, le_inf (inf_le_left.trans (f.mono hij)) (inf_le_right.trans (g.mono hij)),
+  le'   := λ i, inf_le_left.trans (f.le i) }⟩
+
+@[norm_cast] lemma coe_fn_inf {f g : filtration ι m} : ⇑(f ⊓ g) = f ⊓ g := rfl
+
+instance : has_Sup (filtration ι m) := ⟨λ s,
+{ seq   := λ i, Sup ((λ f : filtration ι m, f i) '' s),
+  mono' := λ i j hij,
+  begin
+    refine Sup_le (λ m' hm', _),
+    rw [set.mem_image] at hm',
+    obtain ⟨f, hf_mem, hfm'⟩ := hm',
+    rw ← hfm',
+    refine (f.mono hij).trans _,
+    have hfj_mem : f j ∈ ((λ g : filtration ι m, g j) '' s), from ⟨f, hf_mem, rfl⟩,
+    exact le_Sup hfj_mem,
+  end,
+  le'   := λ i,
+  begin
+    refine Sup_le (λ m' hm', _),
+    rw [set.mem_image] at hm',
+    obtain ⟨f, hf_mem, hfm'⟩ := hm',
+    rw ← hfm',
+    exact f.le i,
+  end, }⟩
+
+lemma Sup_def (s : set (filtration ι m)) (i : ι) :
+  Sup s i = Sup ((λ f : filtration ι m, f i) '' s) :=
+rfl
+
+noncomputable
+instance : has_Inf (filtration ι m) := ⟨λ s,
+{ seq   := λ i, if set.nonempty s then Inf ((λ f : filtration ι m, f i) '' s) else m,
+  mono' := λ i j hij,
+  begin
+    by_cases h_nonempty : set.nonempty s,
+    swap, { simp only [h_nonempty, set.nonempty_image_iff, if_false, le_refl], },
+    simp only [h_nonempty, if_true, le_Inf_iff, set.mem_image, forall_exists_index, and_imp,
+      forall_apply_eq_imp_iff₂],
+    refine λ f hf_mem, le_trans _ (f.mono hij),
+    have hfi_mem : f i ∈ ((λ g : filtration ι m, g i) '' s), from ⟨f, hf_mem, rfl⟩,
+    exact Inf_le hfi_mem,
+  end,
+  le'   := λ i,
+  begin
+    by_cases h_nonempty : set.nonempty s,
+    swap, { simp only [h_nonempty, if_false, le_refl], },
+    simp only [h_nonempty, if_true],
+    obtain ⟨f, hf_mem⟩ := h_nonempty,
+    exact le_trans (Inf_le ⟨f, hf_mem, rfl⟩) (f.le i),
+  end, }⟩
+
+lemma Inf_def (s : set (filtration ι m)) (i : ι) :
+  Inf s i = if set.nonempty s then Inf ((λ f : filtration ι m, f i) '' s) else m :=
+rfl
+
+noncomputable
+instance : complete_lattice (filtration ι m) :=
+{ le           := (≤),
+  le_refl      := λ f i, le_rfl,
+  le_trans     := λ f g h h_fg h_gh i, (h_fg i).trans (h_gh i),
+  le_antisymm  := λ f g h_fg h_gf, filtration.ext $ funext $ λ i, (h_fg i).antisymm (h_gf i),
+  sup          := (⊔),
+  le_sup_left  := λ f g i, le_sup_left,
+  le_sup_right := λ f g i, le_sup_right,
+  sup_le       := λ f g h h_fh h_gh i, sup_le (h_fh i) (h_gh _),
+  inf          := (⊓),
+  inf_le_left  := λ f g i, inf_le_left,
+  inf_le_right := λ f g i, inf_le_right,
+  le_inf       := λ f g h h_fg h_fh i, le_inf (h_fg i) (h_fh i),
+  Sup          := Sup,
+  le_Sup       := λ s f hf_mem i, le_Sup ⟨f, hf_mem, rfl⟩,
+  Sup_le       := λ s f h_forall i, Sup_le $ λ m' hm',
+  begin
+    obtain ⟨g, hg_mem, hfm'⟩ := hm',
+    rw ← hfm',
+    exact h_forall g hg_mem i,
+  end,
+  Inf          := Inf,
+  Inf_le       := λ s f hf_mem i,
+  begin
+    have hs : s.nonempty := ⟨f, hf_mem⟩,
+    simp only [Inf_def, hs, if_true],
+    exact Inf_le ⟨f, hf_mem, rfl⟩,
+  end,
+  le_Inf       := λ s f h_forall i,
+  begin
+    by_cases hs : s.nonempty,
+    swap, { simp only [Inf_def, hs, if_false], exact f.le i, },
+    simp only [Inf_def, hs, if_true, le_Inf_iff, set.mem_image, forall_exists_index, and_imp,
+      forall_apply_eq_imp_iff₂],
+    exact λ g hg_mem, h_forall g hg_mem i,
+  end,
+  top          := ⊤,
+  bot          := ⊥,
+  le_top       := λ f i, f.le' i,
+  bot_le       := λ f i, bot_le, }
+
+end filtration
+
+lemma measurable_set_of_filtration [preorder ι] {f : filtration ι m} {s : set Ω} {i : ι}
+  (hs : measurable_set[f i] s) : measurable_set[m] s :=
+f.le i s hs
+
+/-- A measure is σ-finite with respect to filtration if it is σ-finite with respect
+to all the sub-σ-algebra of the filtration. -/
+class sigma_finite_filtration [preorder ι] (μ : measure Ω) (f : filtration ι m) : Prop :=
+(sigma_finite : ∀ i : ι, sigma_finite (μ.trim (f.le i)))
+
+instance sigma_finite_of_sigma_finite_filtration [preorder ι] (μ : measure Ω) (f : filtration ι m)
+  [hf : sigma_finite_filtration μ f] (i : ι) :
+  sigma_finite (μ.trim (f.le i)) :=
+by apply hf.sigma_finite -- can't exact here
+
+@[priority 100]
+instance is_finite_measure.sigma_finite_filtration [preorder ι] (μ : measure Ω) (f : filtration ι m)
+  [is_finite_measure μ] :
+  sigma_finite_filtration μ f :=
+⟨λ n, by apply_instance⟩
+
+/-- Given a integrable function `g`, the conditional expectations of `g` with respect to a
+filtration is uniformly integrable. -/
+lemma integrable.uniform_integrable_condexp_filtration
+  [preorder ι] {μ : measure Ω} [is_finite_measure μ] {f : filtration ι m}
+  {g : Ω → ℝ} (hg : integrable g μ) :
+  uniform_integrable (λ i, μ[g | f i]) 1 μ :=
+hg.uniform_integrable_condexp f.le
+
+section of_set
+
+variables [preorder ι]
+
+/-- Given a sequence of measurable sets `(sₙ)`, `filtration_of_set` is the smallest filtration
+such that `sₙ` is measurable with respect to the `n`-the sub-σ-algebra in `filtration_of_set`. -/
+def filtration_of_set {s : ι → set Ω} (hsm : ∀ i, measurable_set (s i)) : filtration ι m :=
+{ seq := λ i, measurable_space.generate_from {t | ∃ j ≤ i, s j = t},
+  mono' := λ n m hnm, measurable_space.generate_from_mono
+    (λ t ⟨k, hk₁, hk₂⟩, ⟨k, hk₁.trans hnm, hk₂⟩),
+  le' := λ n, measurable_space.generate_from_le (λ t ⟨k, hk₁, hk₂⟩, hk₂ ▸ hsm k) }
+
+lemma measurable_set_filtration_of_set {s : ι → set Ω}
+  (hsm : ∀ i, measurable_set[m] (s i)) (i : ι) {j : ι} (hj : j ≤ i) :
+  measurable_set[filtration_of_set hsm i] (s j) :=
+measurable_space.measurable_set_generate_from ⟨j, hj, rfl⟩
+
+lemma measurable_set_filtration_of_set' {s : ι → set Ω}
+  (hsm : ∀ n, measurable_set[m] (s n)) (i : ι) :
+  measurable_set[filtration_of_set hsm i] (s i) :=
+measurable_set_filtration_of_set hsm i le_rfl
+
+end of_set
+
+namespace filtration
+variables [topological_space β] [metrizable_space β] [mβ : measurable_space β] [borel_space β]
+  [preorder ι]
+
+include mβ
+
+/-- Given a sequence of functions, the natural filtration is the smallest sequence
+of σ-algebras such that that sequence of functions is measurable with respect to
+the filtration. -/
+def natural (u : ι → Ω → β) (hum : ∀ i, strongly_measurable (u i)) : filtration ι m :=
+{ seq   := λ i, ⨆ j ≤ i, measurable_space.comap (u j) mβ,
+  mono' := λ i j hij, bsupr_mono $ λ k, ge_trans hij,
+  le'   := λ i,
+  begin
+    refine supr₂_le _,
+    rintros j hj s ⟨t, ht, rfl⟩,
+    exact (hum j).measurable ht,
+  end }
+
+section
+
+open measurable_space
+
+lemma filtration_of_set_eq_natural [mul_zero_one_class β] [nontrivial β]
+  {s : ι → set Ω} (hsm : ∀ i, measurable_set[m] (s i)) :
+  filtration_of_set hsm = natural (λ i, (s i).indicator (λ ω, 1 : Ω → β))
+    (λ i, strongly_measurable_one.indicator (hsm i)) :=
+begin
+  simp only [natural, filtration_of_set, measurable_space_supr_eq],
+  ext1 i,
+  refine le_antisymm (generate_from_le _) (generate_from_le _),
+  { rintro _ ⟨j, hij, rfl⟩,
+    refine measurable_set_generate_from ⟨j, measurable_set_generate_from ⟨hij, _⟩⟩,
+    rw comap_eq_generate_from,
+    refine measurable_set_generate_from ⟨{1}, measurable_set_singleton 1, _⟩,
+    ext x,
+    simp [set.indicator_const_preimage_eq_union] },
+  { rintro t ⟨n, ht⟩,
+    suffices : measurable_space.generate_from
+      {t | ∃ (H : n ≤ i), measurable_set[(measurable_space.comap
+        ((s n).indicator (λ ω, 1 : Ω → β)) mβ)] t}
+      ≤ generate_from {t | ∃ (j : ι) (H : j ≤ i), s j = t},
+    { exact this _ ht },
+    refine generate_from_le _,
+    rintro t ⟨hn, u, hu, hu'⟩,
+    obtain heq | heq | heq | heq := set.indicator_const_preimage (s n) u (1 : β),
+    swap 4, rw set.mem_singleton_iff at heq,
+    all_goals { rw heq at hu', rw ← hu' },
+    exacts [measurable_set_empty _, measurable_set.univ, measurable_set_generate_from ⟨n, hn, rfl⟩,
+      measurable_set.compl (measurable_set_generate_from ⟨n, hn, rfl⟩)] }
+end
+
+end
+
+section limit
+
+omit mβ
+
+variables {E : Type*} [has_zero E] [topological_space E]
+  {ℱ : filtration ι m} {f : ι → Ω → E} {μ : measure Ω}
+
+/-- Given a process `f` and a filtration `ℱ`, if `f` converges to some `g` almost everywhere and
+`g` is `⨆ n, ℱ n`-measurable, then `limit_process f ℱ μ` chooses said `g`, else it returns 0.
+
+This definition is used to phrase the a.e. martingale convergence theorem
+`submartingale.ae_tendsto_limit_process` where an L¹-bounded submartingale `f` adapted to `ℱ`
+converges to `limit_process f ℱ μ` `μ`-almost everywhere. -/
+noncomputable
+def limit_process (f : ι → Ω → E) (ℱ : filtration ι m) (μ : measure Ω . volume_tac) :=
+if h : ∃ g : Ω → E, strongly_measurable[⨆ n, ℱ n] g ∧
+  ∀ᵐ ω ∂μ, tendsto (λ n, f n ω) at_top (𝓝 (g ω)) then classical.some h else 0
+
+lemma strongly_measurable_limit_process :
+  strongly_measurable[⨆ n, ℱ n] (limit_process f ℱ μ) :=
+begin
+  rw limit_process,
+  split_ifs with h h,
+  exacts [(classical.some_spec h).1, strongly_measurable_zero]
+end
+
+lemma strongly_measurable_limit_process' :
+  strongly_measurable[m] (limit_process f ℱ μ) :=
+strongly_measurable_limit_process.mono (Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _))
+
+lemma mem_ℒp_limit_process_of_snorm_bdd {R : ℝ≥0} {p : ℝ≥0∞}
+  {F : Type*} [normed_add_comm_group F] {ℱ : filtration ℕ m} {f : ℕ → Ω → F}
+  (hfm : ∀ n, ae_strongly_measurable (f n) μ) (hbdd : ∀ n, snorm (f n) p μ ≤ R) :
+  mem_ℒp (limit_process f ℱ μ) p μ :=
+begin
+  rw limit_process,
+  split_ifs with h,
+  { refine ⟨strongly_measurable.ae_strongly_measurable
+      ((classical.some_spec h).1.mono (Sup_le (λ m ⟨n, hn⟩, hn ▸ ℱ.le _))),
+      lt_of_le_of_lt (Lp.snorm_lim_le_liminf_snorm hfm _ (classical.some_spec h).2)
+        (lt_of_le_of_lt _ (ennreal.coe_lt_top : ↑R < ∞))⟩,
+    simp_rw [liminf_eq, eventually_at_top],
+    exact Sup_le (λ b ⟨a, ha⟩, (ha a le_rfl).trans (hbdd _)) },
+  { exact zero_mem_ℒp }
+end
+
+end limit
+
+end filtration
+
+end measure_theory
diff --git a/src/probability/process/hitting_time.lean b/src/probability/process/hitting_time.lean
new file mode 100644
index 0000000000000..f8260177b6912
--- /dev/null
+++ b/src/probability/process/hitting_time.lean
@@ -0,0 +1,332 @@
+/-
+Copyright (c) 2022 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying, Rémy Degenne
+-/
+import probability.process.stopping
+
+/-!
+# Hitting time
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a stochastic process, the hitting time provides the first time the process ``hits'' some
+subset of the state space. The hitting time is a stopping time in the case that the time index is
+discrete and the process is adapted (this is true in a far more general setting however we have
+only proved it for the discrete case so far).
+
+## Main definition
+
+* `measure_theory.hitting`: the hitting time of a stochastic process
+
+## Main results
+
+* `measure_theory.hitting_is_stopping_time`: a discrete hitting time of an adapted process is a
+  stopping time
+
+## Implementation notes
+
+In the definition of the hitting time, we bound the hitting time by an upper and lower bound.
+This is to ensure that our result is meaningful in the case we are taking the infimum of an
+empty set or the infimum of a set which is unbounded from below. With this, we can talk about
+hitting times indexed by the natural numbers or the reals. By taking the bounds to be
+`⊤` and `⊥`, we obtain the standard definition in the case that the index is `ℕ∞` or `ℝ≥0∞`.
+
+-/
+
+open filter order topological_space
+open_locale classical measure_theory nnreal ennreal topology big_operators
+
+namespace measure_theory
+
+variables {Ω β ι : Type*} {m : measurable_space Ω}
+
+/-- Hitting time: given a stochastic process `u` and a set `s`, `hitting u s n m` is the first time
+`u` is in `s` after time `n` and before time `m` (if `u` does not hit `s` after time `n` and
+before `m` then the hitting time is simply `m`).
+
+The hitting time is a stopping time if the process is adapted and discrete. -/
+noncomputable def hitting [preorder ι] [has_Inf ι] (u : ι → Ω → β) (s : set β) (n m : ι) : Ω → ι :=
+λ x, if ∃ j ∈ set.Icc n m, u j x ∈ s then Inf (set.Icc n m ∩ {i : ι | u i x ∈ s}) else m
+
+section inequalities
+
+variables [conditionally_complete_linear_order ι] {u : ι → Ω → β} {s : set β} {n i : ι} {ω : Ω}
+
+/-- This lemma is strictly weaker than `hitting_of_le`. -/
+lemma hitting_of_lt {m : ι} (h : m < n) : hitting u s n m ω = m :=
+begin
+  simp_rw [hitting],
+  have h_not : ¬ ∃ (j : ι) (H : j ∈ set.Icc n m), u j ω ∈ s,
+  { push_neg,
+    intro j,
+    rw set.Icc_eq_empty_of_lt h,
+    simp only [set.mem_empty_iff_false, is_empty.forall_iff], },
+  simp only [h_not, if_false],
+end
+
+lemma hitting_le {m : ι} (ω : Ω) : hitting u s n m ω ≤ m :=
+begin
+  cases le_or_lt n m with h_le h_lt,
+  { simp only [hitting],
+    split_ifs,
+    { obtain ⟨j, hj₁, hj₂⟩ := h,
+      exact (cInf_le (bdd_below.inter_of_left bdd_below_Icc) (set.mem_inter hj₁ hj₂)).trans hj₁.2 },
+    { exact le_rfl }, },
+  { rw hitting_of_lt h_lt, },
+end
+
+lemma not_mem_of_lt_hitting {m k : ι}
+  (hk₁ : k < hitting u s n m ω) (hk₂ : n ≤ k) :
+  u k ω ∉ s :=
+begin
+  classical,
+  intro h,
+  have hexists : ∃ j ∈ set.Icc n m, u j ω ∈ s,
+  refine ⟨k, ⟨hk₂, le_trans hk₁.le $ hitting_le _⟩, h⟩,
+  refine not_le.2 hk₁ _,
+  simp_rw [hitting, if_pos hexists],
+  exact cInf_le bdd_below_Icc.inter_of_left ⟨⟨hk₂, le_trans hk₁.le $ hitting_le _⟩, h⟩,
+end
+
+lemma hitting_eq_end_iff {m : ι} :
+  hitting u s n m ω = m ↔ (∃ j ∈ set.Icc n m, u j ω ∈ s) →
+    Inf (set.Icc n m ∩ {i : ι | u i ω ∈ s}) = m :=
+by rw [hitting, ite_eq_right_iff]
+
+lemma hitting_of_le {m : ι} (hmn : m ≤ n) :
+  hitting u s n m ω = m :=
+begin
+  obtain (rfl | h) := le_iff_eq_or_lt.1 hmn,
+  { simp only [hitting, set.Icc_self, ite_eq_right_iff, set.mem_Icc, exists_prop,
+      forall_exists_index, and_imp],
+    intros i hi₁ hi₂ hi,
+    rw [set.inter_eq_left_iff_subset.2, cInf_singleton],
+    exact set.singleton_subset_iff.2 (le_antisymm hi₂ hi₁ ▸ hi) },
+  { exact hitting_of_lt h }
+end
+
+lemma le_hitting {m : ι} (hnm : n ≤ m) (ω : Ω) : n ≤ hitting u s n m ω :=
+begin
+  simp only [hitting],
+  split_ifs,
+  { refine le_cInf _ (λ b hb, _),
+    { obtain ⟨k, hk_Icc, hk_s⟩ := h,
+      exact ⟨k, hk_Icc, hk_s⟩, },
+    { rw set.mem_inter_iff at hb,
+      exact hb.1.1, }, },
+  { exact hnm },
+end
+
+lemma le_hitting_of_exists {m : ι} (h_exists : ∃ j ∈ set.Icc n m, u j ω ∈ s) :
+  n ≤ hitting u s n m ω :=
+begin
+  refine le_hitting _ ω,
+  by_contra,
+  rw set.Icc_eq_empty_of_lt (not_le.mp h) at h_exists,
+  simpa using h_exists,
+end
+
+lemma hitting_mem_Icc {m : ι} (hnm : n ≤ m) (ω : Ω) : hitting u s n m ω ∈ set.Icc n m :=
+⟨le_hitting hnm ω, hitting_le ω⟩
+
+lemma hitting_mem_set [is_well_order ι (<)] {m : ι} (h_exists : ∃ j ∈ set.Icc n m, u j ω ∈ s) :
+  u (hitting u s n m ω) ω ∈ s :=
+begin
+  simp_rw [hitting, if_pos h_exists],
+  have h_nonempty : (set.Icc n m ∩ {i : ι | u i ω ∈ s}).nonempty,
+  { obtain ⟨k, hk₁, hk₂⟩ := h_exists,
+    exact ⟨k, set.mem_inter hk₁ hk₂⟩, },
+  have h_mem := Inf_mem h_nonempty,
+  rw [set.mem_inter_iff] at h_mem,
+  exact h_mem.2,
+end
+
+lemma hitting_mem_set_of_hitting_lt [is_well_order ι (<)] {m : ι}
+  (hl : hitting u s n m ω < m) :
+  u (hitting u s n m ω) ω ∈ s :=
+begin
+  by_cases h : ∃ j ∈ set.Icc n m, u j ω ∈ s,
+  { exact hitting_mem_set h },
+  { simp_rw [hitting, if_neg h] at hl,
+    exact false.elim (hl.ne rfl) }
+end
+
+lemma hitting_le_of_mem {m : ι} (hin : n ≤ i) (him : i ≤ m) (his : u i ω ∈ s) :
+  hitting u s n m ω ≤ i :=
+begin
+  have h_exists : ∃ k ∈ set.Icc n m, u k ω ∈ s := ⟨i, ⟨hin, him⟩, his⟩,
+  simp_rw [hitting, if_pos h_exists],
+  exact cInf_le (bdd_below.inter_of_left bdd_below_Icc) (set.mem_inter ⟨hin, him⟩ his),
+end
+
+lemma hitting_le_iff_of_exists [is_well_order ι (<)] {m : ι}
+  (h_exists : ∃ j ∈ set.Icc n m, u j ω ∈ s) :
+  hitting u s n m ω ≤ i ↔ ∃ j ∈ set.Icc n i, u j ω ∈ s :=
+begin
+  split; intro h',
+  { exact ⟨hitting u s n m ω, ⟨le_hitting_of_exists h_exists, h'⟩, hitting_mem_set h_exists⟩, },
+  { have h'' : ∃ k ∈ set.Icc n (min m i), u k ω ∈ s,
+    { obtain ⟨k₁, hk₁_mem, hk₁_s⟩ := h_exists,
+      obtain ⟨k₂, hk₂_mem, hk₂_s⟩ := h',
+      refine ⟨min k₁ k₂, ⟨le_min hk₁_mem.1 hk₂_mem.1, min_le_min hk₁_mem.2 hk₂_mem.2⟩, _⟩,
+      exact min_rec' (λ j, u j ω ∈ s) hk₁_s hk₂_s, },
+    obtain ⟨k, hk₁, hk₂⟩ := h'',
+    refine le_trans _ (hk₁.2.trans (min_le_right _ _)),
+    exact hitting_le_of_mem hk₁.1 (hk₁.2.trans (min_le_left _ _)) hk₂, },
+end
+
+lemma hitting_le_iff_of_lt [is_well_order ι (<)] {m : ι} (i : ι) (hi : i < m) :
+  hitting u s n m ω ≤ i ↔ ∃ j ∈ set.Icc n i, u j ω ∈ s :=
+begin
+  by_cases h_exists : ∃ j ∈ set.Icc n m, u j ω ∈ s,
+  { rw hitting_le_iff_of_exists h_exists, },
+  { simp_rw [hitting, if_neg h_exists],
+    push_neg at h_exists,
+    simp only [not_le.mpr hi, set.mem_Icc, false_iff, not_exists, and_imp],
+    exact λ k hkn hki, h_exists k ⟨hkn, hki.trans hi.le⟩, },
+end
+
+lemma hitting_lt_iff [is_well_order ι (<)] {m : ι} (i : ι) (hi : i ≤ m) :
+  hitting u s n m ω < i ↔ ∃ j ∈ set.Ico n i, u j ω ∈ s :=
+begin
+  split; intro h',
+  { have h : ∃ j ∈ set.Icc n m, u j ω ∈ s,
+    { by_contra,
+      simp_rw [hitting, if_neg h, ← not_le] at h',
+      exact h' hi, },
+    exact ⟨hitting u s n m ω, ⟨le_hitting_of_exists h, h'⟩, hitting_mem_set h⟩, },
+  { obtain ⟨k, hk₁, hk₂⟩ := h',
+    refine lt_of_le_of_lt _ hk₁.2,
+    exact hitting_le_of_mem hk₁.1 (hk₁.2.le.trans hi) hk₂, },
+end
+
+lemma hitting_eq_hitting_of_exists
+  {m₁ m₂ : ι} (h : m₁ ≤ m₂) (h' : ∃ j ∈ set.Icc n m₁, u j ω ∈ s) :
+  hitting u s n m₁ ω = hitting u s n m₂ ω :=
+begin
+  simp only [hitting, if_pos h'],
+  obtain ⟨j, hj₁, hj₂⟩ := h',
+  rw if_pos,
+  { refine le_antisymm _ (cInf_le_cInf bdd_below_Icc.inter_of_left ⟨j, hj₁, hj₂⟩
+      (set.inter_subset_inter_left _ (set.Icc_subset_Icc_right h))),
+    refine le_cInf ⟨j, set.Icc_subset_Icc_right h hj₁, hj₂⟩ (λ i hi, _),
+    by_cases hi' : i ≤ m₁,
+    { exact cInf_le bdd_below_Icc.inter_of_left ⟨⟨hi.1.1, hi'⟩, hi.2⟩ },
+    { exact ((cInf_le bdd_below_Icc.inter_of_left ⟨hj₁, hj₂⟩).trans (hj₁.2.trans le_rfl)).trans
+        (le_of_lt (not_le.1 hi')) } },
+  exact ⟨j, ⟨hj₁.1, hj₁.2.trans h⟩, hj₂⟩,
+end
+
+lemma hitting_mono {m₁ m₂ : ι} (hm : m₁ ≤ m₂) :
+  hitting u s n m₁ ω ≤ hitting u s n m₂ ω :=
+begin
+  by_cases h : ∃ j ∈ set.Icc n m₁, u j ω ∈ s,
+  { exact (hitting_eq_hitting_of_exists hm h).le },
+  { simp_rw [hitting, if_neg h],
+    split_ifs with h',
+    { obtain ⟨j, hj₁, hj₂⟩ := h',
+      refine le_cInf ⟨j, hj₁, hj₂⟩ _,
+      by_contra hneg, push_neg at hneg,
+      obtain ⟨i, hi₁, hi₂⟩ := hneg,
+      exact h ⟨i, ⟨hi₁.1.1, hi₂.le⟩, hi₁.2⟩ },
+    { exact hm } }
+end
+
+end inequalities
+
+/-- A discrete hitting time is a stopping time. -/
+lemma hitting_is_stopping_time
+  [conditionally_complete_linear_order ι] [is_well_order ι (<)] [countable ι]
+  [topological_space β] [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
+  {f : filtration ι m} {u : ι → Ω → β} {s : set β} {n n' : ι}
+  (hu : adapted f u) (hs : measurable_set s) :
+  is_stopping_time f (hitting u s n n') :=
+begin
+  intro i,
+  cases le_or_lt n' i with hi hi,
+  { have h_le : ∀ ω, hitting u s n n' ω ≤ i := λ x, (hitting_le x).trans hi,
+    simp [h_le], },
+  { have h_set_eq_Union : {ω | hitting u s n n' ω ≤ i} = ⋃ j ∈ set.Icc n i, u j ⁻¹' s,
+    { ext x,
+      rw [set.mem_set_of_eq, hitting_le_iff_of_lt _ hi],
+      simp only [set.mem_Icc, exists_prop, set.mem_Union, set.mem_preimage], },
+    rw h_set_eq_Union,
+    exact measurable_set.Union (λ j, measurable_set.Union $
+      λ hj, f.mono hj.2 _ ((hu j).measurable hs)) }
+end
+
+lemma stopped_value_hitting_mem [conditionally_complete_linear_order ι] [is_well_order ι (<)]
+  {u : ι → Ω → β} {s : set β} {n m : ι} {ω : Ω} (h : ∃ j ∈ set.Icc n m, u j ω ∈ s) :
+  stopped_value u (hitting u s n m) ω ∈ s :=
+begin
+  simp only [stopped_value, hitting, if_pos h],
+  obtain ⟨j, hj₁, hj₂⟩ := h,
+  have : Inf (set.Icc n m ∩ {i | u i ω ∈ s}) ∈ set.Icc n m ∩ {i | u i ω ∈ s} :=
+    Inf_mem (set.nonempty_of_mem ⟨hj₁, hj₂⟩),
+  exact this.2,
+end
+
+/-- The hitting time of a discrete process with the starting time indexed by a stopping time
+is a stopping time. -/
+lemma is_stopping_time_hitting_is_stopping_time
+  [conditionally_complete_linear_order ι] [is_well_order ι (<)] [countable ι]
+  [topological_space ι] [order_topology ι] [first_countable_topology ι]
+  [topological_space β] [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
+  {f : filtration ι m} {u : ι → Ω → β} {τ : Ω → ι} (hτ : is_stopping_time f τ)
+  {N : ι} (hτbdd : ∀ x, τ x ≤ N) {s : set β} (hs : measurable_set s) (hf : adapted f u) :
+  is_stopping_time f (λ x, hitting u s (τ x) N x) :=
+begin
+  intro n,
+  have h₁ : {x | hitting u s (τ x) N x ≤ n} =
+    (⋃ i ≤ n, {x | τ x = i} ∩ {x | hitting u s i N x ≤ n}) ∪
+    (⋃ i > n, {x | τ x = i} ∩ {x | hitting u s i N x ≤ n}),
+  { ext x,
+    simp [← exists_or_distrib, ← or_and_distrib_right, le_or_lt] },
+  have h₂ : (⋃ i > n, {x | τ x = i} ∩ {x | hitting u s i N x ≤ n}) = ∅,
+  { ext x,
+    simp only [gt_iff_lt, set.mem_Union, set.mem_inter_iff, set.mem_set_of_eq,
+      exists_prop, set.mem_empty_iff_false, iff_false, not_exists, not_and, not_le],
+    rintro m hm rfl,
+    exact lt_of_lt_of_le hm (le_hitting (hτbdd _) _) },
+  rw [h₁, h₂, set.union_empty],
+  exact measurable_set.Union (λ i, measurable_set.Union
+    (λ hi, (f.mono hi _ (hτ.measurable_set_eq i)).inter (hitting_is_stopping_time hf hs n))),
+end
+
+section complete_lattice
+
+variables [complete_lattice ι] {u : ι → Ω → β} {s : set β} {f : filtration ι m}
+
+lemma hitting_eq_Inf (ω : Ω) : hitting u s ⊥ ⊤ ω = Inf {i : ι | u i ω ∈ s} :=
+begin
+  simp only [hitting, set.mem_Icc, bot_le, le_top, and_self, exists_true_left, set.Icc_bot,
+    set.Iic_top, set.univ_inter, ite_eq_left_iff, not_exists],
+  intro h_nmem_s,
+  symmetry,
+  rw Inf_eq_top,
+  exact λ i hi_mem_s, absurd hi_mem_s (h_nmem_s i),
+end
+
+end complete_lattice
+
+section conditionally_complete_linear_order_bot
+
+variables [conditionally_complete_linear_order_bot ι] [is_well_order ι (<)]
+variables {u : ι → Ω → β} {s : set β} {f : filtration ℕ m}
+
+lemma hitting_bot_le_iff {i n : ι} {ω : Ω} (hx : ∃ j, j ≤ n ∧ u j ω ∈ s) :
+  hitting u s ⊥ n ω ≤ i ↔ ∃ j ≤ i, u j ω ∈ s :=
+begin
+  cases lt_or_le i n with hi hi,
+  { rw hitting_le_iff_of_lt _ hi,
+    simp, },
+  { simp only [(hitting_le ω).trans hi, true_iff],
+    obtain ⟨j, hj₁, hj₂⟩ := hx,
+    exact ⟨j, hj₁.trans hi, hj₂⟩, },
+end
+
+end conditionally_complete_linear_order_bot
+
+end measure_theory
diff --git a/src/probability/process/stopping.lean b/src/probability/process/stopping.lean
new file mode 100644
index 0000000000000..cec8a181ef003
--- /dev/null
+++ b/src/probability/process/stopping.lean
@@ -0,0 +1,1292 @@
+/-
+Copyright (c) 2021 Kexing Ying. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kexing Ying, Rémy Degenne
+-/
+
+import probability.process.adapted
+
+/-!
+# Stopping times, stopped processes and stopped values
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Definition and properties of stopping times.
+
+## Main definitions
+
+* `measure_theory.is_stopping_time`: a stopping time with respect to some filtration `f` is a
+  function `τ` such that for all `i`, the preimage of `{j | j ≤ i}` along `τ` is
+  `f i`-measurable
+* `measure_theory.is_stopping_time.measurable_space`: the σ-algebra associated with a stopping time
+
+## Main results
+
+* `prog_measurable.stopped_process`: the stopped process of a progressively measurable process is
+  progressively measurable.
+* `mem_ℒp_stopped_process`: if a process belongs to `ℒp` at every time in `ℕ`, then its stopped
+  process belongs to `ℒp` as well.
+
+## Tags
+
+stopping time, stochastic process
+
+-/
+
+open filter order topological_space
+open_locale classical measure_theory nnreal ennreal topology big_operators
+
+namespace measure_theory
+
+variables {Ω β ι : Type*} {m : measurable_space Ω}
+
+
+/-! ### Stopping times -/
+
+/-- A stopping time with respect to some filtration `f` is a function
+`τ` such that for all `i`, the preimage of `{j | j ≤ i}` along `τ` is measurable
+with respect to `f i`.
+
+Intuitively, the stopping time `τ` describes some stopping rule such that at time
+`i`, we may determine it with the information we have at time `i`. -/
+def is_stopping_time [preorder ι] (f : filtration ι m) (τ : Ω → ι) :=
+∀ i : ι, measurable_set[f i] $ {ω | τ ω ≤ i}
+
+lemma is_stopping_time_const [preorder ι] (f : filtration ι m) (i : ι) :
+  is_stopping_time f (λ ω, i) :=
+λ j, by simp only [measurable_set.const]
+
+section measurable_set
+
+section preorder
+variables [preorder ι] {f : filtration ι m} {τ : Ω → ι}
+
+protected lemma is_stopping_time.measurable_set_le (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | τ ω ≤ i} :=
+hτ i
+
+lemma is_stopping_time.measurable_set_lt_of_pred [pred_order ι]
+  (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | τ ω < i} :=
+begin
+  by_cases hi_min : is_min i,
+  { suffices : {ω : Ω | τ ω < i} = ∅, by { rw this, exact @measurable_set.empty _ (f i), },
+    ext1 ω,
+    simp only [set.mem_set_of_eq, set.mem_empty_iff_false, iff_false],
+    rw is_min_iff_forall_not_lt at hi_min,
+    exact hi_min (τ ω), },
+  have : {ω : Ω | τ ω < i} = τ ⁻¹' (set.Iio i) := rfl,
+  rw [this, ←Iic_pred_of_not_is_min hi_min],
+  exact f.mono (pred_le i) _ (hτ.measurable_set_le $ pred i),
+end
+
+end preorder
+
+section countable_stopping_time
+
+namespace is_stopping_time
+
+variables [partial_order ι] {τ : Ω → ι} {f : filtration ι m}
+
+protected lemma measurable_set_eq_of_countable_range
+  (hτ : is_stopping_time f τ) (h_countable : (set.range τ).countable) (i : ι) :
+  measurable_set[f i] {ω | τ ω = i} :=
+begin
+  have : {ω | τ ω = i} = {ω | τ ω ≤ i} \ (⋃ (j ∈ set.range τ) (hj : j < i), {ω | τ ω ≤ j}),
+  { ext1 a,
+    simp only [set.mem_set_of_eq, set.mem_range, set.Union_exists, set.Union_Union_eq',
+      set.mem_diff, set.mem_Union, exists_prop, not_exists, not_and, not_le],
+    split; intro h,
+    { simp only [h, lt_iff_le_not_le, le_refl, and_imp, imp_self, implies_true_iff, and_self], },
+    { have h_lt_or_eq : τ a < i ∨ τ a = i := lt_or_eq_of_le h.1,
+      rcases h_lt_or_eq with h_lt | rfl,
+      { exfalso,
+        exact h.2 a h_lt (le_refl (τ a)), },
+      { refl, }, }, },
+  rw this,
+  refine (hτ.measurable_set_le i).diff _,
+  refine measurable_set.bUnion h_countable (λ j hj, _),
+  by_cases hji : j < i,
+  { simp only [hji, set.Union_true],
+    exact f.mono hji.le _ (hτ.measurable_set_le j), },
+  { simp only [hji, set.Union_false],
+    exact @measurable_set.empty _ (f i), },
+end
+
+protected lemma measurable_set_eq_of_countable [countable ι] (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | τ ω = i} :=
+hτ.measurable_set_eq_of_countable_range (set.to_countable _) i
+
+protected lemma measurable_set_lt_of_countable_range
+  (hτ : is_stopping_time f τ) (h_countable : (set.range τ).countable) (i : ι) :
+  measurable_set[f i] {ω | τ ω < i} :=
+begin
+  have : {ω | τ ω < i} = {ω | τ ω ≤ i} \ {ω | τ ω = i},
+  { ext1 ω, simp [lt_iff_le_and_ne], },
+  rw this,
+  exact (hτ.measurable_set_le i).diff (hτ.measurable_set_eq_of_countable_range h_countable i),
+end
+
+protected lemma measurable_set_lt_of_countable [countable ι] (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | τ ω < i} :=
+hτ.measurable_set_lt_of_countable_range (set.to_countable _) i
+
+protected lemma measurable_set_ge_of_countable_range {ι} [linear_order ι] {τ : Ω → ι}
+  {f : filtration ι m}
+  (hτ : is_stopping_time f τ) (h_countable : (set.range τ).countable) (i : ι) :
+  measurable_set[f i] {ω | i ≤ τ ω} :=
+begin
+  have : {ω | i ≤ τ ω} = {ω | τ ω < i}ᶜ,
+  { ext1 ω, simp only [set.mem_set_of_eq, set.mem_compl_iff, not_lt], },
+  rw this,
+  exact (hτ.measurable_set_lt_of_countable_range h_countable i).compl,
+end
+
+protected lemma measurable_set_ge_of_countable {ι} [linear_order ι] {τ : Ω → ι} {f : filtration ι m}
+  [countable ι] (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | i ≤ τ ω} :=
+hτ.measurable_set_ge_of_countable_range (set.to_countable _) i
+
+end is_stopping_time
+
+end countable_stopping_time
+
+section linear_order
+variables [linear_order ι] {f : filtration ι m} {τ : Ω → ι}
+
+lemma is_stopping_time.measurable_set_gt (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | i < τ ω} :=
+begin
+  have : {ω | i < τ ω} = {ω | τ ω ≤ i}ᶜ,
+  { ext1 ω, simp only [set.mem_set_of_eq, set.mem_compl_iff, not_le], },
+  rw this,
+  exact (hτ.measurable_set_le i).compl,
+end
+
+section topological_space
+
+variables [topological_space ι] [order_topology ι] [first_countable_topology ι]
+
+/-- Auxiliary lemma for `is_stopping_time.measurable_set_lt`. -/
+lemma is_stopping_time.measurable_set_lt_of_is_lub
+  (hτ : is_stopping_time f τ) (i : ι) (h_lub : is_lub (set.Iio i) i) :
+  measurable_set[f i] {ω | τ ω < i} :=
+begin
+  by_cases hi_min : is_min i,
+  { suffices : {ω | τ ω < i} = ∅, by { rw this, exact @measurable_set.empty _ (f i), },
+    ext1 ω,
+    simp only [set.mem_set_of_eq, set.mem_empty_iff_false, iff_false],
+    exact is_min_iff_forall_not_lt.mp hi_min (τ ω), },
+  obtain ⟨seq, -, -, h_tendsto, h_bound⟩ : ∃ seq : ℕ → ι,
+      monotone seq ∧ (∀ j, seq j ≤ i) ∧ tendsto seq at_top (𝓝 i) ∧ (∀ j, seq j < i),
+    from h_lub.exists_seq_monotone_tendsto (not_is_min_iff.mp hi_min),
+  have h_Ioi_eq_Union : set.Iio i = ⋃ j, {k | k ≤ seq j},
+  { ext1 k,
+    simp only [set.mem_Iio, set.mem_Union, set.mem_set_of_eq],
+    refine ⟨λ hk_lt_i, _, λ h_exists_k_le_seq, _⟩,
+    { rw tendsto_at_top' at h_tendsto,
+      have h_nhds : set.Ici k ∈ 𝓝 i,
+        from mem_nhds_iff.mpr ⟨set.Ioi k, set.Ioi_subset_Ici le_rfl, is_open_Ioi, hk_lt_i⟩,
+      obtain ⟨a, ha⟩ : ∃ (a : ℕ), ∀ (b : ℕ), b ≥ a → k ≤ seq b := h_tendsto (set.Ici k) h_nhds,
+      exact ⟨a, ha a le_rfl⟩, },
+    { obtain ⟨j, hk_seq_j⟩ := h_exists_k_le_seq,
+      exact hk_seq_j.trans_lt (h_bound j), }, },
+  have h_lt_eq_preimage : {ω | τ ω < i} = τ ⁻¹' (set.Iio i),
+  { ext1 ω, simp only [set.mem_set_of_eq, set.mem_preimage, set.mem_Iio], },
+  rw [h_lt_eq_preimage, h_Ioi_eq_Union],
+  simp only [set.preimage_Union, set.preimage_set_of_eq],
+  exact measurable_set.Union
+    (λ n, f.mono (h_bound n).le _ (hτ.measurable_set_le (seq n))),
+end
+
+lemma is_stopping_time.measurable_set_lt (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | τ ω < i} :=
+begin
+  obtain ⟨i', hi'_lub⟩ : ∃ i', is_lub (set.Iio i) i', from exists_lub_Iio i,
+  cases lub_Iio_eq_self_or_Iio_eq_Iic i hi'_lub with hi'_eq_i h_Iio_eq_Iic,
+  { rw ← hi'_eq_i at hi'_lub ⊢,
+    exact hτ.measurable_set_lt_of_is_lub i' hi'_lub, },
+  { have h_lt_eq_preimage : {ω : Ω | τ ω < i} = τ ⁻¹' (set.Iio i) := rfl,
+    rw [h_lt_eq_preimage, h_Iio_eq_Iic],
+    exact f.mono (lub_Iio_le i hi'_lub) _ (hτ.measurable_set_le i'), },
+end
+
+lemma is_stopping_time.measurable_set_ge (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | i ≤ τ ω} :=
+begin
+  have : {ω | i ≤ τ ω} = {ω | τ ω < i}ᶜ,
+  { ext1 ω, simp only [set.mem_set_of_eq, set.mem_compl_iff, not_lt], },
+  rw this,
+  exact (hτ.measurable_set_lt i).compl,
+end
+
+lemma is_stopping_time.measurable_set_eq (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[f i] {ω | τ ω = i} :=
+begin
+  have : {ω | τ ω = i} = {ω | τ ω ≤ i} ∩ {ω | τ ω ≥ i},
+  { ext1 ω, simp only [set.mem_set_of_eq, ge_iff_le, set.mem_inter_iff, le_antisymm_iff], },
+  rw this,
+  exact (hτ.measurable_set_le i).inter (hτ.measurable_set_ge i),
+end
+
+lemma is_stopping_time.measurable_set_eq_le (hτ : is_stopping_time f τ) {i j : ι} (hle : i ≤ j) :
+  measurable_set[f j] {ω | τ ω = i} :=
+f.mono hle _ $ hτ.measurable_set_eq i
+
+lemma is_stopping_time.measurable_set_lt_le (hτ : is_stopping_time f τ) {i j : ι} (hle : i ≤ j) :
+  measurable_set[f j] {ω | τ ω < i} :=
+f.mono hle _ $ hτ.measurable_set_lt i
+
+end topological_space
+
+end linear_order
+
+section countable
+
+lemma is_stopping_time_of_measurable_set_eq [preorder ι] [countable ι]
+  {f : filtration ι m} {τ : Ω → ι} (hτ : ∀ i, measurable_set[f i] {ω | τ ω = i}) :
+  is_stopping_time f τ :=
+begin
+  intro i,
+  rw show {ω | τ ω ≤ i} = ⋃ k ≤ i, {ω | τ ω = k}, by { ext, simp },
+  refine measurable_set.bUnion (set.to_countable _) (λ k hk, _),
+  exact f.mono hk _ (hτ k),
+end
+
+end countable
+
+end measurable_set
+
+namespace is_stopping_time
+
+protected lemma max [linear_order ι] {f : filtration ι m} {τ π : Ω → ι}
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  is_stopping_time f (λ ω, max (τ ω) (π ω)) :=
+begin
+  intro i,
+  simp_rw [max_le_iff, set.set_of_and],
+  exact (hτ i).inter (hπ i),
+end
+
+protected lemma max_const [linear_order ι] {f : filtration ι m} {τ : Ω → ι}
+  (hτ : is_stopping_time f τ) (i : ι) :
+  is_stopping_time f (λ ω, max (τ ω) i) :=
+hτ.max (is_stopping_time_const f i)
+
+protected lemma min [linear_order ι] {f : filtration ι m} {τ π : Ω → ι}
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  is_stopping_time f (λ ω, min (τ ω) (π ω)) :=
+begin
+  intro i,
+  simp_rw [min_le_iff, set.set_of_or],
+  exact (hτ i).union (hπ i),
+end
+
+protected lemma min_const [linear_order ι] {f : filtration ι m} {τ : Ω → ι}
+  (hτ : is_stopping_time f τ) (i : ι) :
+  is_stopping_time f (λ ω, min (τ ω) i) :=
+hτ.min (is_stopping_time_const f i)
+
+lemma add_const [add_group ι] [preorder ι] [covariant_class ι ι (function.swap (+)) (≤)]
+  [covariant_class ι ι (+) (≤)]
+  {f : filtration ι m} {τ : Ω → ι} (hτ : is_stopping_time f τ) {i : ι} (hi : 0 ≤ i) :
+  is_stopping_time f (λ ω, τ ω + i) :=
+begin
+  intro j,
+  simp_rw [← le_sub_iff_add_le],
+  exact f.mono (sub_le_self j hi) _ (hτ (j - i)),
+end
+
+lemma add_const_nat
+  {f : filtration ℕ m} {τ : Ω → ℕ} (hτ : is_stopping_time f τ) {i : ℕ} :
+  is_stopping_time f (λ ω, τ ω + i) :=
+begin
+  refine is_stopping_time_of_measurable_set_eq (λ j, _),
+  by_cases hij : i ≤ j,
+  { simp_rw [eq_comm, ← nat.sub_eq_iff_eq_add hij, eq_comm],
+    exact f.mono (j.sub_le i) _ (hτ.measurable_set_eq (j - i)) },
+  { rw not_le at hij,
+    convert measurable_set.empty,
+    ext ω,
+    simp only [set.mem_empty_iff_false, iff_false],
+    rintro (hx : τ ω + i = j),
+    linarith },
+end
+
+-- generalize to certain countable type?
+lemma add
+  {f : filtration ℕ m} {τ π : Ω → ℕ} (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  is_stopping_time f (τ + π) :=
+begin
+  intro i,
+  rw (_ : {ω | (τ + π) ω ≤ i} = ⋃ k ≤ i, {ω | π ω = k} ∩ {ω | τ ω + k ≤ i}),
+  { exact measurable_set.Union (λ k, measurable_set.Union
+      (λ hk, (hπ.measurable_set_eq_le hk).inter (hτ.add_const_nat i))) },
+  ext ω,
+  simp only [pi.add_apply, set.mem_set_of_eq, set.mem_Union, set.mem_inter_iff, exists_prop],
+  refine ⟨λ h, ⟨π ω, by linarith, rfl, h⟩, _⟩,
+  rintro ⟨j, hj, rfl, h⟩,
+  assumption
+end
+
+section preorder
+
+variables [preorder ι] {f : filtration ι m} {τ π : Ω → ι}
+
+/-- The associated σ-algebra with a stopping time. -/
+protected def measurable_space (hτ : is_stopping_time f τ) : measurable_space Ω :=
+{ measurable_set' := λ s, ∀ i : ι, measurable_set[f i] (s ∩ {ω | τ ω ≤ i}),
+  measurable_set_empty :=
+    λ i, (set.empty_inter {ω | τ ω ≤ i}).symm ▸ @measurable_set.empty _ (f i),
+  measurable_set_compl := λ s hs i,
+    begin
+      rw (_ : sᶜ ∩ {ω | τ ω ≤ i} = (sᶜ ∪ {ω | τ ω ≤ i}ᶜ) ∩ {ω | τ ω ≤ i}),
+      { refine measurable_set.inter _ _,
+        { rw ← set.compl_inter,
+          exact (hs i).compl },
+        { exact hτ i} },
+      { rw set.union_inter_distrib_right,
+        simp only [set.compl_inter_self, set.union_empty] }
+    end,
+  measurable_set_Union := λ s hs i,
+    begin
+      rw forall_swap at hs,
+      rw set.Union_inter,
+      exact measurable_set.Union (hs i),
+    end }
+
+protected lemma measurable_set (hτ : is_stopping_time f τ) (s : set Ω) :
+  measurable_set[hτ.measurable_space] s ↔
+  ∀ i : ι, measurable_set[f i] (s ∩ {ω | τ ω ≤ i}) :=
+iff.rfl
+
+lemma measurable_space_mono
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (hle : τ ≤ π) :
+  hτ.measurable_space ≤ hπ.measurable_space :=
+begin
+  intros s hs i,
+  rw (_ : s ∩ {ω | π ω ≤ i} = s ∩ {ω | τ ω ≤ i} ∩ {ω | π ω ≤ i}),
+  { exact (hs i).inter (hπ i) },
+  { ext,
+    simp only [set.mem_inter_iff, iff_self_and, and.congr_left_iff, set.mem_set_of_eq],
+    intros hle' _,
+    exact le_trans (hle _) hle' },
+end
+
+lemma measurable_space_le_of_countable [countable ι] (hτ : is_stopping_time f τ) :
+  hτ.measurable_space ≤ m :=
+begin
+  intros s hs,
+  change ∀ i, measurable_set[f i] (s ∩ {ω | τ ω ≤ i}) at hs,
+  rw (_ : s = ⋃ i, s ∩ {ω | τ ω ≤ i}),
+  { exact measurable_set.Union (λ i, f.le i _ (hs i)) },
+  { ext ω, split; rw set.mem_Union,
+    { exact λ hx, ⟨τ ω, hx, le_rfl⟩ },
+    { rintro ⟨_, hx, _⟩,
+      exact hx } }
+end
+
+lemma measurable_space_le' [is_countably_generated (at_top : filter ι)] [(at_top : filter ι).ne_bot]
+  (hτ : is_stopping_time f τ) :
+  hτ.measurable_space ≤ m :=
+begin
+  intros s hs,
+  change ∀ i, measurable_set[f i] (s ∩ {ω | τ ω ≤ i}) at hs,
+  obtain ⟨seq : ℕ → ι, h_seq_tendsto⟩ := at_top.exists_seq_tendsto,
+  rw (_ : s = ⋃ n, s ∩ {ω | τ ω ≤ seq n}),
+  { exact measurable_set.Union (λ i, f.le (seq i) _ (hs (seq i))), },
+  { ext ω, split; rw set.mem_Union,
+    { intros hx,
+      suffices : ∃ i, τ ω ≤ seq i, from ⟨this.some, hx, this.some_spec⟩,
+      rw tendsto_at_top at h_seq_tendsto,
+      exact (h_seq_tendsto (τ ω)).exists, },
+    { rintro ⟨_, hx, _⟩,
+      exact hx }, },
+  all_goals { apply_instance, },
+end
+
+lemma measurable_space_le {ι} [semilattice_sup ι] {f : filtration ι m} {τ : Ω → ι}
+  [is_countably_generated (at_top : filter ι)] (hτ : is_stopping_time f τ) :
+  hτ.measurable_space ≤ m :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { haveI : is_empty Ω := ⟨λ ω, is_empty.false (τ ω)⟩,
+    intros s hsτ,
+    suffices hs : s = ∅, by { rw hs, exact measurable_set.empty, },
+    haveI : unique (set Ω) := set.unique_empty,
+    rw [unique.eq_default s, unique.eq_default ∅], },
+  exact measurable_space_le' hτ,
+end
+
+example {f : filtration ℕ m} {τ : Ω → ℕ} (hτ : is_stopping_time f τ) : hτ.measurable_space ≤ m :=
+hτ.measurable_space_le
+
+example {f : filtration ℝ m} {τ : Ω → ℝ} (hτ : is_stopping_time f τ) : hτ.measurable_space ≤ m :=
+hτ.measurable_space_le
+
+@[simp] lemma measurable_space_const (f : filtration ι m) (i : ι) :
+  (is_stopping_time_const f i).measurable_space = f i :=
+begin
+  ext1 s,
+  change measurable_set[(is_stopping_time_const f i).measurable_space] s ↔ measurable_set[f i] s,
+  rw is_stopping_time.measurable_set,
+  split; intro h,
+  { specialize h i,
+    simpa only [le_refl, set.set_of_true, set.inter_univ] using h, },
+  { intro j,
+    by_cases hij : i ≤ j,
+    { simp only [hij, set.set_of_true, set.inter_univ],
+      exact f.mono hij _ h, },
+    { simp only [hij, set.set_of_false, set.inter_empty, measurable_set.empty], }, },
+end
+
+lemma measurable_set_inter_eq_iff (hτ : is_stopping_time f τ) (s : set Ω) (i : ι) :
+  measurable_set[hτ.measurable_space] (s ∩ {ω | τ ω = i})
+    ↔ measurable_set[f i] (s ∩ {ω | τ ω = i}) :=
+begin
+  have : ∀ j, ({ω : Ω | τ ω = i} ∩ {ω : Ω | τ ω ≤ j}) = {ω : Ω | τ ω = i} ∩ {ω | i ≤ j},
+  { intro j,
+    ext1 ω,
+    simp only [set.mem_inter_iff, set.mem_set_of_eq, and.congr_right_iff],
+    intro hxi,
+    rw hxi, },
+  split; intro h,
+  { specialize h i,
+    simpa only [set.inter_assoc, this, le_refl, set.set_of_true, set.inter_univ] using h, },
+  { intro j,
+    rw [set.inter_assoc, this],
+    by_cases hij : i ≤ j,
+    { simp only [hij, set.set_of_true, set.inter_univ],
+      exact f.mono hij _ h, },
+    { simp [hij], }, },
+end
+
+lemma measurable_space_le_of_le_const (hτ : is_stopping_time f τ) {i : ι} (hτ_le : ∀ ω, τ ω ≤ i) :
+  hτ.measurable_space ≤ f i :=
+(measurable_space_mono hτ _ hτ_le).trans (measurable_space_const _ _).le
+
+lemma measurable_space_le_of_le (hτ : is_stopping_time f τ) {n : ι} (hτ_le : ∀ ω, τ ω ≤ n) :
+  hτ.measurable_space ≤ m :=
+(hτ.measurable_space_le_of_le_const hτ_le).trans (f.le n)
+
+lemma le_measurable_space_of_const_le (hτ : is_stopping_time f τ) {i : ι} (hτ_le : ∀ ω, i ≤ τ ω) :
+  f i ≤ hτ.measurable_space :=
+(measurable_space_const _ _).symm.le.trans (measurable_space_mono _ hτ hτ_le)
+
+end preorder
+
+instance sigma_finite_stopping_time {ι} [semilattice_sup ι] [order_bot ι]
+  [(filter.at_top : filter ι).is_countably_generated]
+  {μ : measure Ω} {f : filtration ι m} {τ : Ω → ι}
+  [sigma_finite_filtration μ f] (hτ : is_stopping_time f τ) :
+  sigma_finite (μ.trim hτ.measurable_space_le) :=
+begin
+  refine sigma_finite_trim_mono hτ.measurable_space_le _,
+  { exact f ⊥, },
+  { exact hτ.le_measurable_space_of_const_le (λ _, bot_le), },
+  { apply_instance, },
+end
+
+instance sigma_finite_stopping_time_of_le {ι} [semilattice_sup ι] [order_bot ι]
+  {μ : measure Ω} {f : filtration ι m} {τ : Ω → ι}
+  [sigma_finite_filtration μ f] (hτ : is_stopping_time f τ) {n : ι} (hτ_le : ∀ ω, τ ω ≤ n) :
+  sigma_finite (μ.trim (hτ.measurable_space_le_of_le hτ_le)) :=
+begin
+  refine sigma_finite_trim_mono (hτ.measurable_space_le_of_le hτ_le) _,
+  { exact f ⊥, },
+  { exact hτ.le_measurable_space_of_const_le (λ _, bot_le), },
+  { apply_instance, },
+end
+
+section linear_order
+
+variables [linear_order ι] {f : filtration ι m} {τ π : Ω → ι}
+
+protected lemma measurable_set_le' (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω ≤ i} :=
+begin
+  intro j,
+  have : {ω : Ω | τ ω ≤ i} ∩ {ω : Ω | τ ω ≤ j} = {ω : Ω | τ ω ≤ min i j},
+  { ext1 ω, simp only [set.mem_inter_iff, set.mem_set_of_eq, le_min_iff], },
+  rw this,
+  exact f.mono (min_le_right i j) _ (hτ _),
+end
+
+protected lemma measurable_set_gt' (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | i < τ ω} :=
+begin
+  have : {ω : Ω | i < τ ω} = {ω : Ω | τ ω ≤ i}ᶜ, by { ext1 ω, simp, },
+  rw this,
+  exact (hτ.measurable_set_le' i).compl,
+end
+
+protected lemma measurable_set_eq' [topological_space ι] [order_topology ι]
+  [first_countable_topology ι]
+  (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω = i} :=
+begin
+  rw [← set.univ_inter {ω | τ ω = i}, measurable_set_inter_eq_iff, set.univ_inter],
+  exact hτ.measurable_set_eq i,
+end
+
+protected lemma measurable_set_ge' [topological_space ι] [order_topology ι]
+  [first_countable_topology ι]
+  (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | i ≤ τ ω} :=
+begin
+  have : {ω | i ≤ τ ω} = {ω | τ ω = i} ∪ {ω | i < τ ω},
+  { ext1 ω,
+    simp only [le_iff_lt_or_eq, set.mem_set_of_eq, set.mem_union],
+    rw [@eq_comm _ i, or_comm], },
+  rw this,
+  exact (hτ.measurable_set_eq' i).union (hτ.measurable_set_gt' i),
+end
+
+protected lemma measurable_set_lt' [topological_space ι] [order_topology ι]
+  [first_countable_topology ι]
+  (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω < i} :=
+begin
+  have : {ω | τ ω < i} = {ω | τ ω ≤ i} \ {ω | τ ω = i},
+  { ext1 ω,
+    simp only [lt_iff_le_and_ne, set.mem_set_of_eq, set.mem_diff], },
+  rw this,
+  exact (hτ.measurable_set_le' i).diff (hτ.measurable_set_eq' i),
+end
+
+section countable
+
+protected lemma measurable_set_eq_of_countable_range'
+  (hτ : is_stopping_time f τ) (h_countable : (set.range τ).countable) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω = i} :=
+begin
+  rw [← set.univ_inter {ω | τ ω = i}, measurable_set_inter_eq_iff, set.univ_inter],
+  exact hτ.measurable_set_eq_of_countable_range h_countable i,
+end
+
+protected lemma measurable_set_eq_of_countable' [countable ι] (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω = i} :=
+hτ.measurable_set_eq_of_countable_range' (set.to_countable _) i
+
+protected lemma measurable_set_ge_of_countable_range'
+  (hτ : is_stopping_time f τ) (h_countable : (set.range τ).countable) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | i ≤ τ ω} :=
+begin
+  have : {ω | i ≤ τ ω} = {ω | τ ω = i} ∪ {ω | i < τ ω},
+  { ext1 ω,
+    simp only [le_iff_lt_or_eq, set.mem_set_of_eq, set.mem_union],
+    rw [@eq_comm _ i, or_comm], },
+  rw this,
+  exact (hτ.measurable_set_eq_of_countable_range' h_countable i).union (hτ.measurable_set_gt' i),
+end
+
+protected lemma measurable_set_ge_of_countable' [countable ι] (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | i ≤ τ ω} :=
+hτ.measurable_set_ge_of_countable_range' (set.to_countable _) i
+
+protected lemma measurable_set_lt_of_countable_range'
+  (hτ : is_stopping_time f τ) (h_countable : (set.range τ).countable) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω < i} :=
+begin
+  have : {ω | τ ω < i} = {ω | τ ω ≤ i} \ {ω | τ ω = i},
+  { ext1 ω,
+    simp only [lt_iff_le_and_ne, set.mem_set_of_eq, set.mem_diff], },
+  rw this,
+  exact (hτ.measurable_set_le' i).diff (hτ.measurable_set_eq_of_countable_range' h_countable i),
+end
+
+protected lemma measurable_set_lt_of_countable' [countable ι] (hτ : is_stopping_time f τ) (i : ι) :
+  measurable_set[hτ.measurable_space] {ω | τ ω < i} :=
+hτ.measurable_set_lt_of_countable_range' (set.to_countable _) i
+
+protected lemma measurable_space_le_of_countable_range (hτ : is_stopping_time f τ)
+  (h_countable : (set.range τ).countable) :
+  hτ.measurable_space ≤ m :=
+begin
+  intros s hs,
+  change ∀ i, measurable_set[f i] (s ∩ {ω | τ ω ≤ i}) at hs,
+  rw (_ : s = ⋃ (i ∈ set.range τ), s ∩ {ω | τ ω ≤ i}),
+  { exact measurable_set.bUnion h_countable (λ i _, f.le i _ (hs i)), },
+  { ext ω,
+    split; rw set.mem_Union,
+    { exact λ hx, ⟨τ ω, by simpa using hx⟩,},
+    { rintro ⟨i, hx⟩,
+      simp only [set.mem_range, set.Union_exists, set.mem_Union, set.mem_inter_iff,
+        set.mem_set_of_eq, exists_prop, exists_and_distrib_right] at hx,
+      exact hx.1.2, } }
+end
+
+end countable
+
+protected lemma measurable [topological_space ι] [measurable_space ι]
+  [borel_space ι] [order_topology ι] [second_countable_topology ι]
+  (hτ : is_stopping_time f τ) :
+  measurable[hτ.measurable_space] τ :=
+@measurable_of_Iic ι Ω _ _ _ hτ.measurable_space _ _ _ _ (λ i, hτ.measurable_set_le' i)
+
+protected lemma measurable_of_le [topological_space ι] [measurable_space ι]
+  [borel_space ι] [order_topology ι] [second_countable_topology ι]
+  (hτ : is_stopping_time f τ) {i : ι} (hτ_le : ∀ ω, τ ω ≤ i) :
+  measurable[f i] τ :=
+hτ.measurable.mono (measurable_space_le_of_le_const _ hτ_le) le_rfl
+
+lemma measurable_space_min (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  (hτ.min hπ).measurable_space = hτ.measurable_space ⊓ hπ.measurable_space :=
+begin
+  refine le_antisymm _ _,
+  { exact le_inf (measurable_space_mono _ hτ (λ _, min_le_left _ _))
+      (measurable_space_mono _ hπ (λ _, min_le_right _ _)), },
+  { intro s,
+    change measurable_set[hτ.measurable_space] s ∧ measurable_set[hπ.measurable_space] s
+      → measurable_set[(hτ.min hπ).measurable_space] s,
+    simp_rw is_stopping_time.measurable_set,
+    have : ∀ i, {ω | min (τ ω) (π ω) ≤ i} = {ω | τ ω ≤ i} ∪ {ω | π ω ≤ i},
+    { intro i, ext1 ω, simp, },
+    simp_rw [this, set.inter_union_distrib_left],
+    exact λ h i, (h.left i).union (h.right i), },
+end
+
+lemma measurable_set_min_iff (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (s : set Ω) :
+  measurable_set[(hτ.min hπ).measurable_space] s
+    ↔ measurable_set[hτ.measurable_space] s ∧ measurable_set[hπ.measurable_space] s :=
+by { rw measurable_space_min, refl, }
+
+lemma measurable_space_min_const (hτ : is_stopping_time f τ) {i : ι} :
+  (hτ.min_const i).measurable_space = hτ.measurable_space ⊓ f i :=
+by rw [hτ.measurable_space_min (is_stopping_time_const _ i), measurable_space_const]
+
+lemma measurable_set_min_const_iff (hτ : is_stopping_time f τ) (s : set Ω)
+  {i : ι} :
+  measurable_set[(hτ.min_const i).measurable_space] s
+    ↔ measurable_set[hτ.measurable_space] s ∧ measurable_set[f i] s :=
+by rw [measurable_space_min_const, measurable_space.measurable_set_inf]
+
+lemma measurable_set_inter_le [topological_space ι] [second_countable_topology ι] [order_topology ι]
+  [measurable_space ι] [borel_space ι]
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (s : set Ω)
+  (hs : measurable_set[hτ.measurable_space] s) :
+  measurable_set[(hτ.min hπ).measurable_space] (s ∩ {ω | τ ω ≤ π ω}) :=
+begin
+  simp_rw is_stopping_time.measurable_set at ⊢ hs,
+  intro i,
+  have : (s ∩ {ω | τ ω ≤ π ω} ∩ {ω | min (τ ω) (π ω) ≤ i})
+    = (s ∩ {ω | τ ω ≤ i}) ∩ {ω | min (τ ω) (π ω) ≤ i} ∩ {ω | min (τ ω) i ≤ min (min (τ ω) (π ω)) i},
+  { ext1 ω,
+    simp only [min_le_iff, set.mem_inter_iff, set.mem_set_of_eq, le_min_iff, le_refl, true_and,
+      and_true, true_or, or_true],
+    by_cases hτi : τ ω ≤ i,
+    { simp only [hτi, true_or, and_true, and.congr_right_iff],
+      intro hx,
+      split; intro h,
+      { exact or.inl h, },
+      { cases h,
+        { exact h, },
+        { exact hτi.trans h, }, }, },
+    simp only [hτi, false_or, and_false, false_and, iff_false, not_and, not_le, and_imp],
+    refine λ hx hτ_le_π, lt_of_lt_of_le _ hτ_le_π,
+    rw ← not_le,
+    exact hτi, },
+  rw this,
+  refine ((hs i).inter ((hτ.min hπ) i)).inter _,
+  apply measurable_set_le,
+  { exact (hτ.min_const i).measurable_of_le (λ _, min_le_right _ _), },
+  { exact ((hτ.min hπ).min_const i).measurable_of_le (λ _, min_le_right _ _),  },
+end
+
+lemma measurable_set_inter_le_iff [topological_space ι]
+  [second_countable_topology ι] [order_topology ι] [measurable_space ι] [borel_space ι]
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π)
+  (s : set Ω) :
+  measurable_set[hτ.measurable_space] (s ∩ {ω | τ ω ≤ π ω})
+    ↔ measurable_set[(hτ.min hπ).measurable_space] (s ∩ {ω | τ ω ≤ π ω}) :=
+begin
+  split; intro h,
+  { have : s ∩ {ω | τ ω ≤ π ω} = s ∩ {ω | τ ω ≤ π ω} ∩ {ω | τ ω ≤ π ω},
+      by rw [set.inter_assoc, set.inter_self],
+    rw this,
+    exact measurable_set_inter_le _ _ _ h, },
+  { rw measurable_set_min_iff at h,
+    exact h.1, },
+end
+
+lemma measurable_set_inter_le_const_iff (hτ : is_stopping_time f τ) (s : set Ω) (i : ι) :
+  measurable_set[hτ.measurable_space] (s ∩ {ω | τ ω ≤ i})
+    ↔ measurable_set[(hτ.min_const i).measurable_space] (s ∩ {ω | τ ω ≤ i}) :=
+begin
+  rw [is_stopping_time.measurable_set_min_iff hτ (is_stopping_time_const _ i),
+    is_stopping_time.measurable_space_const, is_stopping_time.measurable_set],
+  refine ⟨λ h, ⟨h, _⟩, λ h j, h.1 j⟩,
+  specialize h i,
+  rwa [set.inter_assoc, set.inter_self] at h,
+end
+
+lemma measurable_set_le_stopping_time [topological_space ι]
+  [second_countable_topology ι] [order_topology ι] [measurable_space ι] [borel_space ι]
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  measurable_set[hτ.measurable_space] {ω | τ ω ≤ π ω} :=
+begin
+  rw hτ.measurable_set,
+  intro j,
+  have : {ω | τ ω ≤ π ω} ∩ {ω | τ ω ≤ j} = {ω | min (τ ω) j ≤ min (π ω) j} ∩ {ω | τ ω ≤ j},
+  { ext1 ω,
+    simp only [set.mem_inter_iff, set.mem_set_of_eq, min_le_iff, le_min_iff, le_refl, and_true,
+      and.congr_left_iff],
+    intro h,
+    simp only [h, or_self, and_true],
+    by_cases hj : j ≤ π ω,
+    { simp only [hj, h.trans hj, or_self], },
+    { simp only [hj, or_false], }, },
+  rw this,
+  refine measurable_set.inter _ (hτ.measurable_set_le j),
+  apply measurable_set_le,
+  { exact (hτ.min_const j).measurable_of_le (λ _, min_le_right _ _), },
+  { exact (hπ.min_const j).measurable_of_le (λ _, min_le_right _ _), },
+end
+
+lemma measurable_set_stopping_time_le [topological_space ι]
+  [second_countable_topology ι] [order_topology ι] [measurable_space ι] [borel_space ι]
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  measurable_set[hπ.measurable_space] {ω | τ ω ≤ π ω} :=
+begin
+  suffices : measurable_set[(hτ.min hπ).measurable_space] {ω : Ω | τ ω ≤ π ω},
+    by { rw measurable_set_min_iff hτ hπ at this, exact this.2, },
+  rw [← set.univ_inter {ω : Ω | τ ω ≤ π ω}, ← hτ.measurable_set_inter_le_iff hπ, set.univ_inter],
+  exact measurable_set_le_stopping_time hτ hπ,
+end
+
+lemma measurable_set_eq_stopping_time [add_group ι]
+  [topological_space ι] [measurable_space ι] [borel_space ι] [order_topology ι]
+  [measurable_singleton_class ι] [second_countable_topology ι] [has_measurable_sub₂ ι]
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  measurable_set[hτ.measurable_space] {ω | τ ω = π ω} :=
+begin
+  rw hτ.measurable_set,
+  intro j,
+  have : {ω | τ ω = π ω} ∩ {ω | τ ω ≤ j}
+    = {ω | min (τ ω) j = min (π ω) j} ∩ {ω | τ ω ≤ j} ∩ {ω | π ω ≤ j},
+  { ext1 ω,
+    simp only [set.mem_inter_iff, set.mem_set_of_eq],
+    refine ⟨λ h, ⟨⟨_, h.2⟩, _⟩, λ h, ⟨_, h.1.2⟩⟩,
+    { rw h.1, },
+    { rw ← h.1, exact h.2, },
+    { cases h with h' hσ_le,
+      cases h' with h_eq hτ_le,
+      rwa [min_eq_left hτ_le, min_eq_left hσ_le] at h_eq, }, },
+  rw this,
+  refine measurable_set.inter (measurable_set.inter _ (hτ.measurable_set_le j))
+    (hπ.measurable_set_le j),
+  apply measurable_set_eq_fun,
+  { exact (hτ.min_const j).measurable_of_le (λ _, min_le_right _ _), },
+  { exact (hπ.min_const j).measurable_of_le (λ _, min_le_right _ _), },
+end
+
+lemma measurable_set_eq_stopping_time_of_countable [countable ι]
+  [topological_space ι] [measurable_space ι] [borel_space ι] [order_topology ι]
+  [measurable_singleton_class ι] [second_countable_topology ι]
+  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
+  measurable_set[hτ.measurable_space] {ω | τ ω = π ω} :=
+begin
+  rw hτ.measurable_set,
+  intro j,
+  have : {ω | τ ω = π ω} ∩ {ω | τ ω ≤ j}
+    = {ω | min (τ ω) j = min (π ω) j} ∩ {ω | τ ω ≤ j} ∩ {ω | π ω ≤ j},
+  { ext1 ω,
+    simp only [set.mem_inter_iff, set.mem_set_of_eq],
+    refine ⟨λ h, ⟨⟨_, h.2⟩, _⟩, λ h, ⟨_, h.1.2⟩⟩,
+    { rw h.1, },
+    { rw ← h.1, exact h.2, },
+    { cases h with h' hπ_le,
+      cases h' with h_eq hτ_le,
+      rwa [min_eq_left hτ_le, min_eq_left hπ_le] at h_eq, }, },
+  rw this,
+  refine measurable_set.inter (measurable_set.inter _ (hτ.measurable_set_le j))
+    (hπ.measurable_set_le j),
+  apply measurable_set_eq_fun_of_countable,
+  { exact (hτ.min_const j).measurable_of_le (λ _, min_le_right _ _), },
+  { exact (hπ.min_const j).measurable_of_le (λ _, min_le_right _ _), },
+end
+
+end linear_order
+
+end is_stopping_time
+
+section linear_order
+
+/-! ## Stopped value and stopped process -/
+
+/-- Given a map `u : ι → Ω → E`, its stopped value with respect to the stopping
+time `τ` is the map `x ↦ u (τ ω) ω`. -/
+def stopped_value (u : ι → Ω → β) (τ : Ω → ι) : Ω → β :=
+λ ω, u (τ ω) ω
+
+lemma stopped_value_const (u : ι → Ω → β) (i : ι) : stopped_value u (λ ω, i) = u i :=
+rfl
+
+variable [linear_order ι]
+
+/-- Given a map `u : ι → Ω → E`, the stopped process with respect to `τ` is `u i ω` if
+`i ≤ τ ω`, and `u (τ ω) ω` otherwise.
+
+Intuitively, the stopped process stops evolving once the stopping time has occured. -/
+def stopped_process (u : ι → Ω → β) (τ : Ω → ι) : ι → Ω → β :=
+λ i ω, u (min i (τ ω)) ω
+
+lemma stopped_process_eq_stopped_value {u : ι → Ω → β} {τ : Ω → ι} :
+  stopped_process u τ = λ i, stopped_value u (λ ω, min i (τ ω)) := rfl
+
+lemma stopped_value_stopped_process {u : ι → Ω → β} {τ σ : Ω → ι} :
+  stopped_value (stopped_process u τ) σ = stopped_value u (λ ω, min (σ ω) (τ ω)) := rfl
+
+lemma stopped_process_eq_of_le {u : ι → Ω → β} {τ : Ω → ι}
+  {i : ι} {ω : Ω} (h : i ≤ τ ω) : stopped_process u τ i ω = u i ω :=
+by simp [stopped_process, min_eq_left h]
+
+lemma stopped_process_eq_of_ge {u : ι → Ω → β} {τ : Ω → ι}
+  {i : ι} {ω : Ω} (h : τ ω ≤ i) : stopped_process u τ i ω = u (τ ω) ω :=
+by simp [stopped_process, min_eq_right h]
+
+section prog_measurable
+
+variables [measurable_space ι] [topological_space ι] [order_topology ι]
+  [second_countable_topology ι] [borel_space ι]
+  [topological_space β]
+  {u : ι → Ω → β} {τ : Ω → ι} {f : filtration ι m}
+
+lemma prog_measurable_min_stopping_time [metrizable_space ι] (hτ : is_stopping_time f τ) :
+  prog_measurable f (λ i ω, min i (τ ω)) :=
+begin
+  intro i,
+  let m_prod : measurable_space (set.Iic i × Ω) := measurable_space.prod _ (f i),
+  let m_set : ∀ t : set (set.Iic i × Ω), measurable_space t :=
+    λ _, @subtype.measurable_space (set.Iic i × Ω) _ m_prod,
+  let s := {p : set.Iic i × Ω | τ p.2 ≤ i},
+  have hs : measurable_set[m_prod] s, from @measurable_snd (set.Iic i) Ω _ (f i) _ (hτ i),
+  have h_meas_fst : ∀ t : set (set.Iic i × Ω),
+      measurable[m_set t] (λ x : t, ((x : set.Iic i × Ω).fst : ι)),
+    from λ t, (@measurable_subtype_coe (set.Iic i × Ω) m_prod _).fst.subtype_coe,
+  apply measurable.strongly_measurable,
+  refine measurable_of_restrict_of_restrict_compl hs _ _,
+  { refine @measurable.min _ _ _ _ _ (m_set s) _ _ _ _ _ (h_meas_fst s) _,
+    refine @measurable_of_Iic ι s _ _ _ (m_set s) _ _ _ _ (λ j, _),
+    have h_set_eq : (λ x : s, τ (x : set.Iic i × Ω).snd) ⁻¹' set.Iic j
+      = (λ x : s, (x : set.Iic i × Ω).snd) ⁻¹' {ω | τ ω ≤ min i j},
+    { ext1 ω,
+      simp only [set.mem_preimage, set.mem_Iic, iff_and_self, le_min_iff, set.mem_set_of_eq],
+      exact λ _, ω.prop, },
+    rw h_set_eq,
+    suffices h_meas : @measurable _ _ (m_set s) (f i) (λ x : s, (x : set.Iic i × Ω).snd),
+      from h_meas (f.mono (min_le_left _ _) _ (hτ.measurable_set_le (min i j))),
+    exact measurable_snd.comp (@measurable_subtype_coe _ m_prod _), },
+  { suffices h_min_eq_left : (λ x : sᶜ, min ↑((x : set.Iic i × Ω).fst) (τ (x : set.Iic i × Ω).snd))
+      = λ x : sᶜ, ↑((x : set.Iic i × Ω).fst),
+    { rw [set.restrict, h_min_eq_left],
+      exact h_meas_fst _, },
+    ext1 ω,
+    rw min_eq_left,
+    have hx_fst_le : ↑(ω : set.Iic i × Ω).fst ≤ i, from (ω : set.Iic i × Ω).fst.prop,
+    refine hx_fst_le.trans (le_of_lt _),
+    convert ω.prop,
+    simp only [not_le, set.mem_compl_iff, set.mem_set_of_eq], },
+end
+
+lemma prog_measurable.stopped_process [metrizable_space ι]
+  (h : prog_measurable f u) (hτ : is_stopping_time f τ) :
+  prog_measurable f (stopped_process u τ) :=
+h.comp (prog_measurable_min_stopping_time hτ) (λ i x, min_le_left _ _)
+
+lemma prog_measurable.adapted_stopped_process [metrizable_space ι]
+  (h : prog_measurable f u) (hτ : is_stopping_time f τ) :
+  adapted f (stopped_process u τ) :=
+(h.stopped_process hτ).adapted
+
+lemma prog_measurable.strongly_measurable_stopped_process [metrizable_space ι]
+  (hu : prog_measurable f u) (hτ : is_stopping_time f τ) (i : ι) :
+  strongly_measurable (stopped_process u τ i) :=
+(hu.adapted_stopped_process hτ i).mono (f.le _)
+
+lemma strongly_measurable_stopped_value_of_le
+  (h : prog_measurable f u) (hτ : is_stopping_time f τ) {n : ι} (hτ_le : ∀ ω, τ ω ≤ n) :
+  strongly_measurable[f n] (stopped_value u τ) :=
+begin
+  have : stopped_value u τ = (λ (p : set.Iic n × Ω), u ↑(p.fst) p.snd) ∘ (λ ω, (⟨τ ω, hτ_le ω⟩, ω)),
+  { ext1 ω, simp only [stopped_value, function.comp_app, subtype.coe_mk], },
+  rw this,
+  refine strongly_measurable.comp_measurable (h n) _,
+  exact (hτ.measurable_of_le hτ_le).subtype_mk.prod_mk measurable_id,
+end
+
+lemma measurable_stopped_value [metrizable_space β] [measurable_space β] [borel_space β]
+  (hf_prog : prog_measurable f u) (hτ : is_stopping_time f τ) :
+  measurable[hτ.measurable_space] (stopped_value u τ) :=
+begin
+  have h_str_meas : ∀ i, strongly_measurable[f i] (stopped_value u (λ ω, min (τ ω) i)),
+    from λ i, strongly_measurable_stopped_value_of_le hf_prog (hτ.min_const i)
+      (λ _, min_le_right _ _),
+  intros t ht i,
+  suffices : stopped_value u τ ⁻¹' t ∩ {ω : Ω | τ ω ≤ i}
+      = stopped_value u (λ ω, min (τ ω) i) ⁻¹' t ∩ {ω : Ω | τ ω ≤ i},
+    by { rw this, exact ((h_str_meas i).measurable ht).inter (hτ.measurable_set_le i), },
+  ext1 ω,
+  simp only [stopped_value, set.mem_inter_iff, set.mem_preimage, set.mem_set_of_eq,
+    and.congr_left_iff],
+  intro h,
+  rw min_eq_left h,
+end
+
+end prog_measurable
+
+end linear_order
+
+section stopped_value_of_mem_finset
+
+variables {μ : measure Ω} {τ σ : Ω → ι} {E : Type*} {p : ℝ≥0∞} {u : ι → Ω → E}
+
+lemma stopped_value_eq_of_mem_finset [add_comm_monoid E] {s : finset ι} (hbdd : ∀ ω, τ ω ∈ s) :
+  stopped_value u τ = ∑ i in s, set.indicator {ω | τ ω = i} (u i) :=
+begin
+  ext y,
+  rw [stopped_value, finset.sum_apply, finset.sum_indicator_eq_sum_filter],
+  suffices : finset.filter (λ i, y ∈ {ω : Ω | τ ω = i}) s = ({τ y} : finset ι),
+    by rw [this, finset.sum_singleton],
+  ext1 ω,
+  simp only [set.mem_set_of_eq, finset.mem_filter, finset.mem_singleton],
+  split; intro h,
+  { exact h.2.symm, },
+  { refine ⟨_, h.symm⟩, rw h, exact hbdd y, },
+end
+
+lemma stopped_value_eq' [preorder ι] [locally_finite_order_bot ι] [add_comm_monoid E]
+  {N : ι} (hbdd : ∀ ω, τ ω ≤ N) :
+  stopped_value u τ = ∑ i in finset.Iic N, set.indicator {ω | τ ω = i} (u i) :=
+stopped_value_eq_of_mem_finset (λ ω, finset.mem_Iic.mpr (hbdd ω))
+
+lemma stopped_process_eq_of_mem_finset [linear_order ι] [add_comm_monoid E]
+  {s : finset ι} (n : ι) (hbdd : ∀ ω, τ ω < n → τ ω ∈ s) :
+  stopped_process u τ n =
+  set.indicator {a | n ≤ τ a} (u n) + ∑ i in s.filter (< n), set.indicator {ω | τ ω = i} (u i) :=
+begin
+  ext ω,
+  rw [pi.add_apply, finset.sum_apply],
+  cases le_or_lt n (τ ω),
+  { rw [stopped_process_eq_of_le h, set.indicator_of_mem, finset.sum_eq_zero, add_zero],
+    { intros m hm,
+      refine set.indicator_of_not_mem _ _,
+      rw [finset.mem_filter] at hm,
+      exact (hm.2.trans_le h).ne', },
+    { exact h, } },
+  { rw [stopped_process_eq_of_ge (le_of_lt h), finset.sum_eq_single_of_mem (τ ω)],
+    { rw [set.indicator_of_not_mem, zero_add, set.indicator_of_mem],
+      { exact rfl }, -- refl does not work
+      { exact not_le.2 h } },
+    { rw [finset.mem_filter],
+      exact ⟨hbdd ω h, h⟩, },
+    { intros b hb hneq,
+      rw set.indicator_of_not_mem,
+      exact hneq.symm } },
+end
+
+lemma stopped_process_eq'' [linear_order ι] [locally_finite_order_bot ι] [add_comm_monoid E]
+  (n : ι) :
+  stopped_process u τ n =
+    set.indicator {a | n ≤ τ a} (u n) + ∑ i in finset.Iio n, set.indicator {ω | τ ω = i} (u i) :=
+begin
+  have h_mem : ∀ ω, τ ω < n → τ ω ∈ finset.Iio n := λ ω h, finset.mem_Iio.mpr h,
+  rw stopped_process_eq_of_mem_finset n h_mem,
+  swap, { apply_instance, },
+  congr' with i,
+  simp only [finset.Iio_filter_lt, min_eq_right],
+end
+
+section stopped_value
+variables [partial_order ι] {ℱ : filtration ι m} [normed_add_comm_group E]
+
+lemma mem_ℒp_stopped_value_of_mem_finset (hτ : is_stopping_time ℱ τ) (hu : ∀ n, mem_ℒp (u n) p μ)
+  {s : finset ι} (hbdd : ∀ ω, τ ω ∈ s) :
+  mem_ℒp (stopped_value u τ) p μ :=
+begin
+  rw stopped_value_eq_of_mem_finset hbdd,
+  swap, apply_instance,
+  refine mem_ℒp_finset_sum' _ (λ i hi, mem_ℒp.indicator _ (hu i)),
+  refine ℱ.le i {a : Ω | τ a = i} (hτ.measurable_set_eq_of_countable_range _ i),
+  refine ((finset.finite_to_set s).subset (λ ω hω, _)).countable,
+  obtain ⟨y, rfl⟩ := hω,
+  exact hbdd y,
+end
+
+lemma mem_ℒp_stopped_value [locally_finite_order_bot ι]
+  (hτ : is_stopping_time ℱ τ) (hu : ∀ n, mem_ℒp (u n) p μ) {N : ι} (hbdd : ∀ ω, τ ω ≤ N) :
+  mem_ℒp (stopped_value u τ) p μ :=
+mem_ℒp_stopped_value_of_mem_finset hτ hu (λ ω, finset.mem_Iic.mpr (hbdd ω))
+
+lemma integrable_stopped_value_of_mem_finset (hτ : is_stopping_time ℱ τ)
+  (hu : ∀ n, integrable (u n) μ) {s : finset ι} (hbdd : ∀ ω, τ ω ∈ s) :
+  integrable (stopped_value u τ) μ :=
+begin
+  simp_rw ← mem_ℒp_one_iff_integrable at hu ⊢,
+  exact mem_ℒp_stopped_value_of_mem_finset hτ hu hbdd,
+end
+
+variables (ι)
+
+lemma integrable_stopped_value [locally_finite_order_bot ι]
+  (hτ : is_stopping_time ℱ τ) (hu : ∀ n, integrable (u n) μ) {N : ι} (hbdd : ∀ ω, τ ω ≤ N) :
+  integrable (stopped_value u τ) μ :=
+integrable_stopped_value_of_mem_finset hτ hu (λ ω, finset.mem_Iic.mpr (hbdd ω))
+
+end stopped_value
+
+section stopped_process
+variables [linear_order ι] [topological_space ι] [order_topology ι] [first_countable_topology ι]
+  {ℱ : filtration ι m} [normed_add_comm_group E]
+
+lemma mem_ℒp_stopped_process_of_mem_finset (hτ : is_stopping_time ℱ τ)
+  (hu : ∀ n, mem_ℒp (u n) p μ) (n : ι) {s : finset ι} (hbdd : ∀ ω, τ ω < n → τ ω ∈ s) :
+  mem_ℒp (stopped_process u τ n) p μ :=
+begin
+  rw stopped_process_eq_of_mem_finset n hbdd,
+  swap, { apply_instance, },
+  refine mem_ℒp.add _ _,
+  { exact mem_ℒp.indicator (ℱ.le n {a : Ω | n ≤ τ a} (hτ.measurable_set_ge n)) (hu n) },
+  { suffices : mem_ℒp (λ ω, ∑ i in s.filter (< n), {a : Ω | τ a = i}.indicator (u i) ω) p μ,
+    { convert this, ext1 ω, simp only [finset.sum_apply] },
+    refine mem_ℒp_finset_sum _ (λ i hi, mem_ℒp.indicator _ (hu i)),
+    exact ℱ.le i {a : Ω | τ a = i} (hτ.measurable_set_eq i) },
+end
+
+lemma mem_ℒp_stopped_process [locally_finite_order_bot ι] (hτ : is_stopping_time ℱ τ)
+  (hu : ∀ n, mem_ℒp (u n) p μ) (n : ι) :
+  mem_ℒp (stopped_process u τ n) p μ :=
+mem_ℒp_stopped_process_of_mem_finset hτ hu n (λ ω h, finset.mem_Iio.mpr h)
+
+lemma integrable_stopped_process_of_mem_finset (hτ : is_stopping_time ℱ τ)
+  (hu : ∀ n, integrable (u n) μ) (n : ι) {s : finset ι} (hbdd : ∀ ω, τ ω < n → τ ω ∈ s) :
+  integrable (stopped_process u τ n) μ :=
+begin
+  simp_rw ← mem_ℒp_one_iff_integrable at hu ⊢,
+  exact mem_ℒp_stopped_process_of_mem_finset hτ hu n hbdd,
+end
+
+lemma integrable_stopped_process [locally_finite_order_bot ι] (hτ : is_stopping_time ℱ τ)
+  (hu : ∀ n, integrable (u n) μ) (n : ι) :
+  integrable (stopped_process u τ n) μ :=
+integrable_stopped_process_of_mem_finset hτ hu n (λ ω h, finset.mem_Iio.mpr h)
+
+end stopped_process
+
+end stopped_value_of_mem_finset
+
+section adapted_stopped_process
+
+variables [topological_space β] [pseudo_metrizable_space β]
+  [linear_order ι]
+  [topological_space ι] [second_countable_topology ι] [order_topology ι]
+  [measurable_space ι] [borel_space ι]
+  {f : filtration ι m} {u : ι → Ω → β} {τ : Ω → ι}
+
+/-- The stopped process of an adapted process with continuous paths is adapted. -/
+lemma adapted.stopped_process [metrizable_space ι]
+  (hu : adapted f u) (hu_cont : ∀ ω, continuous (λ i, u i ω)) (hτ : is_stopping_time f τ) :
+  adapted f (stopped_process u τ) :=
+((hu.prog_measurable_of_continuous hu_cont).stopped_process hτ).adapted
+
+/-- If the indexing order has the discrete topology, then the stopped process of an adapted process
+is adapted. -/
+lemma adapted.stopped_process_of_discrete [discrete_topology ι]
+  (hu : adapted f u) (hτ : is_stopping_time f τ) :
+  adapted f (stopped_process u τ) :=
+(hu.prog_measurable_of_discrete.stopped_process hτ).adapted
+
+lemma adapted.strongly_measurable_stopped_process [metrizable_space ι]
+  (hu : adapted f u) (hu_cont : ∀ ω, continuous (λ i, u i ω)) (hτ : is_stopping_time f τ)
+  (n : ι) :
+  strongly_measurable (stopped_process u τ n) :=
+(hu.prog_measurable_of_continuous hu_cont).strongly_measurable_stopped_process hτ n
+
+lemma adapted.strongly_measurable_stopped_process_of_discrete [discrete_topology ι]
+  (hu : adapted f u) (hτ : is_stopping_time f τ) (n : ι) :
+  strongly_measurable (stopped_process u τ n) :=
+hu.prog_measurable_of_discrete.strongly_measurable_stopped_process hτ n
+
+end adapted_stopped_process
+
+section nat
+/-! ### Filtrations indexed by `ℕ` -/
+
+open filtration
+
+variables {f : filtration ℕ m} {u : ℕ → Ω → β} {τ π : Ω → ℕ}
+
+lemma stopped_value_sub_eq_sum [add_comm_group β] (hle : τ ≤ π) :
+  stopped_value u π - stopped_value u τ =
+  λ ω, (∑ i in finset.Ico (τ ω) (π ω), (u (i + 1) - u i)) ω :=
+begin
+  ext ω,
+  rw [finset.sum_Ico_eq_sub _ (hle ω), finset.sum_range_sub, finset.sum_range_sub],
+  simp [stopped_value],
+end
+
+lemma stopped_value_sub_eq_sum' [add_comm_group β] (hle : τ ≤ π) {N : ℕ} (hbdd : ∀ ω, π ω ≤ N) :
+  stopped_value u π - stopped_value u τ =
+  λ ω, (∑ i in finset.range (N + 1),
+    set.indicator {ω | τ ω ≤ i ∧ i < π ω} (u (i + 1) - u i)) ω :=
+begin
+  rw stopped_value_sub_eq_sum hle,
+  ext ω,
+  simp only [finset.sum_apply, finset.sum_indicator_eq_sum_filter],
+  refine finset.sum_congr _ (λ _ _, rfl),
+  ext i,
+  simp only [finset.mem_filter, set.mem_set_of_eq, finset.mem_range, finset.mem_Ico],
+  exact ⟨λ h, ⟨lt_trans h.2 (nat.lt_succ_iff.2 $ hbdd _), h⟩, λ h, h.2⟩
+end
+
+section add_comm_monoid
+variables [add_comm_monoid β]
+
+lemma stopped_value_eq {N : ℕ} (hbdd : ∀ ω, τ ω ≤ N) :
+  stopped_value u τ =
+  λ x, (∑ i in finset.range (N + 1), set.indicator {ω | τ ω = i} (u i)) x :=
+stopped_value_eq_of_mem_finset (λ ω, finset.mem_range_succ_iff.mpr (hbdd ω))
+
+lemma stopped_process_eq (n : ℕ) :
+  stopped_process u τ n =
+  set.indicator {a | n ≤ τ a} (u n) + ∑ i in finset.range n, set.indicator {ω | τ ω = i} (u i) :=
+begin
+  rw stopped_process_eq'' n,
+  swap, { apply_instance, },
+  congr' with i,
+  rw [finset.mem_Iio, finset.mem_range],
+end
+
+lemma stopped_process_eq' (n : ℕ) :
+  stopped_process u τ n =
+  set.indicator {a | n + 1 ≤ τ a} (u n) +
+    ∑ i in finset.range (n + 1), set.indicator {a | τ a = i} (u i) :=
+begin
+  have : {a | n ≤ τ a}.indicator (u n) =
+    {a | n + 1 ≤ τ a}.indicator (u n) + {a | τ a = n}.indicator (u n),
+  { ext x,
+    rw [add_comm, pi.add_apply, ← set.indicator_union_of_not_mem_inter],
+    { simp_rw [@eq_comm _ _ n, @le_iff_eq_or_lt _ _ n, nat.succ_le_iff],
+      refl },
+    { rintro ⟨h₁, h₂⟩,
+      exact (nat.succ_le_iff.1 h₂).ne h₁.symm } },
+  rw [stopped_process_eq, this, finset.sum_range_succ_comm, ← add_assoc],
+end
+
+end add_comm_monoid
+
+end nat
+
+section piecewise_const
+
+variables [preorder ι] {𝒢 : filtration ι m} {τ η : Ω → ι} {i j : ι} {s : set Ω}
+  [decidable_pred (∈ s)]
+
+/-- Given stopping times `τ` and `η` which are bounded below, `set.piecewise s τ η` is also
+a stopping time with respect to the same filtration. -/
+lemma is_stopping_time.piecewise_of_le (hτ_st : is_stopping_time 𝒢 τ)
+  (hη_st : is_stopping_time 𝒢 η) (hτ : ∀ ω, i ≤ τ ω) (hη : ∀ ω, i ≤ η ω)
+  (hs : measurable_set[𝒢 i] s) :
+  is_stopping_time 𝒢 (s.piecewise τ η) :=
+begin
+  intro n,
+  have : {ω | s.piecewise τ η ω ≤ n} = (s ∩ {ω | τ ω ≤ n}) ∪ (sᶜ ∩ {ω | η ω ≤ n}),
+  { ext1 ω,
+    simp only [set.piecewise, set.mem_inter_iff, set.mem_set_of_eq, and.congr_right_iff],
+    by_cases hx : ω ∈ s; simp [hx], },
+  rw this,
+  by_cases hin : i ≤ n,
+  { have hs_n : measurable_set[𝒢 n] s, from 𝒢.mono hin _ hs,
+    exact (hs_n.inter (hτ_st n)).union (hs_n.compl.inter (hη_st n)), },
+  { have hτn : ∀ ω, ¬ τ ω ≤ n := λ ω hτn, hin ((hτ ω).trans hτn),
+    have hηn : ∀ ω, ¬ η ω ≤ n := λ ω hηn, hin ((hη ω).trans hηn),
+    simp [hτn, hηn], },
+end
+
+lemma is_stopping_time_piecewise_const (hij : i ≤ j) (hs : measurable_set[𝒢 i] s) :
+  is_stopping_time 𝒢 (s.piecewise (λ _, i) (λ _, j)) :=
+(is_stopping_time_const 𝒢 i).piecewise_of_le (is_stopping_time_const 𝒢 j)
+  (λ x, le_rfl) (λ _, hij) hs
+
+lemma stopped_value_piecewise_const {ι' : Type*} {i j : ι'} {f : ι' → Ω → ℝ} :
+  stopped_value f (s.piecewise (λ _, i) (λ _, j)) = s.piecewise (f i) (f j) :=
+by { ext ω, rw stopped_value, by_cases hx : ω ∈ s; simp [hx] }
+
+lemma stopped_value_piecewise_const' {ι' : Type*} {i j : ι'} {f : ι' → Ω → ℝ} :
+  stopped_value f (s.piecewise (λ _, i) (λ _, j)) = s.indicator (f i) + sᶜ.indicator (f j) :=
+by { ext ω, rw stopped_value, by_cases hx : ω ∈ s; simp [hx] }
+
+end piecewise_const
+
+section condexp
+/-! ### Conditional expectation with respect to the σ-algebra generated by a stopping time -/
+
+variables [linear_order ι] {μ : measure Ω} {ℱ : filtration ι m} {τ σ : Ω → ι}
+  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] {f : Ω → E}
+
+lemma condexp_stopping_time_ae_eq_restrict_eq_of_countable_range [sigma_finite_filtration μ ℱ]
+  (hτ : is_stopping_time ℱ τ) (h_countable : (set.range τ).countable)
+  [sigma_finite (μ.trim (hτ.measurable_space_le_of_countable_range h_countable))] (i : ι) :
+  μ[f | hτ.measurable_space] =ᵐ[μ.restrict {x | τ x = i}] μ[f | ℱ i] :=
+begin
+  refine condexp_ae_eq_restrict_of_measurable_space_eq_on
+    (hτ.measurable_space_le_of_countable_range h_countable) (ℱ.le i)
+    (hτ.measurable_set_eq_of_countable_range' h_countable i) (λ t, _),
+  rw [set.inter_comm _ t, is_stopping_time.measurable_set_inter_eq_iff],
+end
+
+lemma condexp_stopping_time_ae_eq_restrict_eq_of_countable [countable ι]
+  [sigma_finite_filtration μ ℱ]
+  (hτ : is_stopping_time ℱ τ) [sigma_finite (μ.trim hτ.measurable_space_le_of_countable)] (i : ι) :
+  μ[f | hτ.measurable_space] =ᵐ[μ.restrict {x | τ x = i}] μ[f | ℱ i] :=
+condexp_stopping_time_ae_eq_restrict_eq_of_countable_range hτ (set.to_countable _) i
+
+variables [(filter.at_top : filter ι).is_countably_generated]
+
+lemma condexp_min_stopping_time_ae_eq_restrict_le_const (hτ : is_stopping_time ℱ τ)
+  (i : ι) [sigma_finite (μ.trim (hτ.min_const i).measurable_space_le)] :
+  μ[f | (hτ.min_const i).measurable_space]
+    =ᵐ[μ.restrict {x | τ x ≤ i}] μ[f | hτ.measurable_space] :=
+begin
+  haveI : sigma_finite (μ.trim hτ.measurable_space_le),
+  { have h_le : (hτ.min_const i).measurable_space ≤ hτ.measurable_space,
+    { rw is_stopping_time.measurable_space_min_const,
+      exact inf_le_left, },
+    exact sigma_finite_trim_mono _ h_le, },
+  refine (condexp_ae_eq_restrict_of_measurable_space_eq_on hτ.measurable_space_le
+    (hτ.min_const i).measurable_space_le (hτ.measurable_set_le' i) (λ t, _)).symm,
+  rw [set.inter_comm _ t, hτ.measurable_set_inter_le_const_iff],
+end
+
+variables [topological_space ι] [order_topology ι]
+
+lemma condexp_stopping_time_ae_eq_restrict_eq
+  [first_countable_topology ι] [sigma_finite_filtration μ ℱ]
+  (hτ : is_stopping_time ℱ τ) [sigma_finite (μ.trim hτ.measurable_space_le)] (i : ι) :
+  μ[f | hτ.measurable_space] =ᵐ[μ.restrict {x | τ x = i}] μ[f | ℱ i] :=
+begin
+  refine condexp_ae_eq_restrict_of_measurable_space_eq_on
+    hτ.measurable_space_le (ℱ.le i) (hτ.measurable_set_eq' i) (λ t, _),
+  rw [set.inter_comm _ t, is_stopping_time.measurable_set_inter_eq_iff],
+end
+
+lemma condexp_min_stopping_time_ae_eq_restrict_le [measurable_space ι]
+  [second_countable_topology ι] [borel_space ι]
+  (hτ : is_stopping_time ℱ τ) (hσ : is_stopping_time ℱ σ)
+  [sigma_finite (μ.trim (hτ.min hσ).measurable_space_le)] :
+  μ[f | (hτ.min hσ).measurable_space] =ᵐ[μ.restrict {x | τ x ≤ σ x}] μ[f | hτ.measurable_space] :=
+begin
+  haveI : sigma_finite (μ.trim hτ.measurable_space_le),
+  { have h_le : (hτ.min hσ).measurable_space ≤ hτ.measurable_space,
+    { rw is_stopping_time.measurable_space_min,
+      exact inf_le_left, },
+    exact sigma_finite_trim_mono _ h_le, },
+  refine (condexp_ae_eq_restrict_of_measurable_space_eq_on hτ.measurable_space_le
+    (hτ.min hσ).measurable_space_le (hτ.measurable_set_le_stopping_time hσ) (λ t, _)).symm,
+  rw [set.inter_comm _ t, is_stopping_time.measurable_set_inter_le_iff],
+end
+
+end condexp
+
+end measure_theory
diff --git a/src/probability/stopping.lean b/src/probability/stopping.lean
deleted file mode 100644
index 65962981ecf2f..0000000000000
--- a/src/probability/stopping.lean
+++ /dev/null
@@ -1,1109 +0,0 @@
-/-
-Copyright (c) 2021 Kexing Ying. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kexing Ying
--/
-import measure_theory.constructions.borel_space
-import measure_theory.function.l1_space
-import measure_theory.function.strongly_measurable
-import topology.instances.discrete
-
-/-!
-# Filtration and stopping time
-
-This file defines some standard definition from the theory of stochastic processes including
-filtrations and stopping times. These definitions are used to model the amount of information
-at a specific time and is the first step in formalizing stochastic processes.
-
-## Main definitions
-
-* `measure_theory.filtration`: a filtration on a measurable space
-* `measure_theory.adapted`: a sequence of functions `u` is said to be adapted to a
-  filtration `f` if at each point in time `i`, `u i` is `f i`-strongly measurable
-* `measure_theory.prog_measurable`: a sequence of functions `u` is said to be progressively
-  measurable with respect to a filtration `f` if at each point in time `i`, `u` restricted to
-  `set.Iic i × α` is strongly measurable with respect to the product `measurable_space` structure
-  where the σ-algebra used for `α` is `f i`.
-* `measure_theory.filtration.natural`: the natural filtration with respect to a sequence of
-  measurable functions is the smallest filtration to which it is adapted to
-* `measure_theory.is_stopping_time`: a stopping time with respect to some filtration `f` is a
-  function `τ` such that for all `i`, the preimage of `{j | j ≤ i}` along `τ` is
-  `f i`-measurable
-* `measure_theory.is_stopping_time.measurable_space`: the σ-algebra associated with a stopping time
-
-## Main results
-
-* `adapted.prog_measurable_of_continuous`: a continuous adapted process is progressively measurable.
-* `prog_measurable.stopped_process`: the stopped process of a progressively measurable process is
-  progressively measurable.
-* `mem_ℒp_stopped_process`: if a process belongs to `ℒp` at every time in `ℕ`, then its stopped
-  process belongs to `ℒp` as well.
-
-## Tags
-
-filtration, stopping time, stochastic process
-
--/
-
-open filter order topological_space
-open_locale classical measure_theory nnreal ennreal topological_space big_operators
-
-namespace measure_theory
-
-/-! ### Filtrations -/
-
-/-- A `filtration` on measurable space `α` with σ-algebra `m` is a monotone
-sequence of sub-σ-algebras of `m`. -/
-structure filtration {α : Type*} (ι : Type*) [preorder ι] (m : measurable_space α) :=
-(seq   : ι → measurable_space α)
-(mono' : monotone seq)
-(le'   : ∀ i : ι, seq i ≤ m)
-
-variables {α β ι : Type*} {m : measurable_space α}
-
-instance [preorder ι] : has_coe_to_fun (filtration ι m) (λ _, ι → measurable_space α) :=
-⟨λ f, f.seq⟩
-
-namespace filtration
-variables [preorder ι]
-
-protected lemma mono {i j : ι} (f : filtration ι m) (hij : i ≤ j) : f i ≤ f j := f.mono' hij
-
-protected lemma le (f : filtration ι m) (i : ι) : f i ≤ m := f.le' i
-
-@[ext] protected lemma ext {f g : filtration ι m} (h : (f : ι → measurable_space α) = g) : f = g :=
-by { cases f, cases g, simp only, exact h, }
-
-variable (ι)
-/-- The constant filtration which is equal to `m` for all `i : ι`. -/
-def const (m' : measurable_space α) (hm' : m' ≤ m) : filtration ι m :=
-⟨λ _, m', monotone_const, λ _, hm'⟩
-variable {ι}
-
-@[simp]
-lemma const_apply {m' : measurable_space α} {hm' : m' ≤ m} (i : ι) : const ι m' hm' i = m' := rfl
-
-instance : inhabited (filtration ι m) := ⟨const ι m le_rfl⟩
-
-instance : has_le (filtration ι m) := ⟨λ f g, ∀ i, f i ≤ g i⟩
-
-instance : has_bot (filtration ι m) := ⟨const ι ⊥ bot_le⟩
-
-instance : has_top (filtration ι m) := ⟨const ι m le_rfl⟩
-
-instance : has_sup (filtration ι m) := ⟨λ f g,
-{ seq   := λ i, f i ⊔ g i,
-  mono' := λ i j hij, sup_le ((f.mono hij).trans le_sup_left) ((g.mono hij).trans le_sup_right),
-  le'   := λ i, sup_le (f.le i) (g.le i) }⟩
-
-@[norm_cast] lemma coe_fn_sup {f g : filtration ι m} : ⇑(f ⊔ g) = f ⊔ g := rfl
-
-instance : has_inf (filtration ι m) := ⟨λ f g,
-{ seq   := λ i, f i ⊓ g i,
-  mono' := λ i j hij, le_inf (inf_le_left.trans (f.mono hij)) (inf_le_right.trans (g.mono hij)),
-  le'   := λ i, inf_le_left.trans (f.le i) }⟩
-
-@[norm_cast] lemma coe_fn_inf {f g : filtration ι m} : ⇑(f ⊓ g) = f ⊓ g := rfl
-
-instance : has_Sup (filtration ι m) := ⟨λ s,
-{ seq   := λ i, Sup ((λ f : filtration ι m, f i) '' s),
-  mono' := λ i j hij,
-  begin
-    refine Sup_le (λ m' hm', _),
-    rw [set.mem_image] at hm',
-    obtain ⟨f, hf_mem, hfm'⟩ := hm',
-    rw ← hfm',
-    refine (f.mono hij).trans _,
-    have hfj_mem : f j ∈ ((λ g : filtration ι m, g j) '' s), from ⟨f, hf_mem, rfl⟩,
-    exact le_Sup hfj_mem,
-  end,
-  le'   := λ i,
-  begin
-    refine Sup_le (λ m' hm', _),
-    rw [set.mem_image] at hm',
-    obtain ⟨f, hf_mem, hfm'⟩ := hm',
-    rw ← hfm',
-    exact f.le i,
-  end, }⟩
-
-lemma Sup_def (s : set (filtration ι m)) (i : ι) :
-  Sup s i = Sup ((λ f : filtration ι m, f i) '' s) :=
-rfl
-
-noncomputable
-instance : has_Inf (filtration ι m) := ⟨λ s,
-{ seq   := λ i, if set.nonempty s then Inf ((λ f : filtration ι m, f i) '' s) else m,
-  mono' := λ i j hij,
-  begin
-    by_cases h_nonempty : set.nonempty s,
-    swap, { simp only [h_nonempty, set.nonempty_image_iff, if_false, le_refl], },
-    simp only [h_nonempty, if_true, le_Inf_iff, set.mem_image, forall_exists_index, and_imp,
-      forall_apply_eq_imp_iff₂],
-    refine λ f hf_mem, le_trans _ (f.mono hij),
-    have hfi_mem : f i ∈ ((λ g : filtration ι m, g i) '' s), from ⟨f, hf_mem, rfl⟩,
-    exact Inf_le hfi_mem,
-  end,
-  le'   := λ i,
-  begin
-    by_cases h_nonempty : set.nonempty s,
-    swap, { simp only [h_nonempty, if_false, le_refl], },
-    simp only [h_nonempty, if_true],
-    obtain ⟨f, hf_mem⟩ := h_nonempty,
-    exact le_trans (Inf_le ⟨f, hf_mem, rfl⟩) (f.le i),
-  end, }⟩
-
-lemma Inf_def (s : set (filtration ι m)) (i : ι) :
-  Inf s i = if set.nonempty s then Inf ((λ f : filtration ι m, f i) '' s) else m :=
-rfl
-
-noncomputable
-instance : complete_lattice (filtration ι m) :=
-{ le           := (≤),
-  le_refl      := λ f i, le_rfl,
-  le_trans     := λ f g h h_fg h_gh i, (h_fg i).trans (h_gh i),
-  le_antisymm  := λ f g h_fg h_gf, filtration.ext $ funext $ λ i, (h_fg i).antisymm (h_gf i),
-  sup          := (⊔),
-  le_sup_left  := λ f g i, le_sup_left,
-  le_sup_right := λ f g i, le_sup_right,
-  sup_le       := λ f g h h_fh h_gh i, sup_le (h_fh i) (h_gh _),
-  inf          := (⊓),
-  inf_le_left  := λ f g i, inf_le_left,
-  inf_le_right := λ f g i, inf_le_right,
-  le_inf       := λ f g h h_fg h_fh i, le_inf (h_fg i) (h_fh i),
-  Sup          := Sup,
-  le_Sup       := λ s f hf_mem i, le_Sup ⟨f, hf_mem, rfl⟩,
-  Sup_le       := λ s f h_forall i, Sup_le $ λ m' hm',
-  begin
-    obtain ⟨g, hg_mem, hfm'⟩ := hm',
-    rw ← hfm',
-    exact h_forall g hg_mem i,
-  end,
-  Inf          := Inf,
-  Inf_le       := λ s f hf_mem i,
-  begin
-    have hs : s.nonempty := ⟨f, hf_mem⟩,
-    simp only [Inf_def, hs, if_true],
-    exact Inf_le ⟨f, hf_mem, rfl⟩,
-  end,
-  le_Inf       := λ s f h_forall i,
-  begin
-    by_cases hs : s.nonempty,
-    swap, { simp only [Inf_def, hs, if_false], exact f.le i, },
-    simp only [Inf_def, hs, if_true, le_Inf_iff, set.mem_image, forall_exists_index, and_imp,
-      forall_apply_eq_imp_iff₂],
-    exact λ g hg_mem, h_forall g hg_mem i,
-  end,
-  top          := ⊤,
-  bot          := ⊥,
-  le_top       := λ f i, f.le' i,
-  bot_le       := λ f i, bot_le, }
-
-end filtration
-
-lemma measurable_set_of_filtration [preorder ι] {f : filtration ι m} {s : set α} {i : ι}
-  (hs : measurable_set[f i] s) : measurable_set[m] s :=
-f.le i s hs
-
-/-- A measure is σ-finite with respect to filtration if it is σ-finite with respect
-to all the sub-σ-algebra of the filtration. -/
-class sigma_finite_filtration [preorder ι] (μ : measure α) (f : filtration ι m) : Prop :=
-(sigma_finite : ∀ i : ι, sigma_finite (μ.trim (f.le i)))
-
-instance sigma_finite_of_sigma_finite_filtration [preorder ι] (μ : measure α) (f : filtration ι m)
-  [hf : sigma_finite_filtration μ f] (i : ι) :
-  sigma_finite (μ.trim (f.le i)) :=
-by apply hf.sigma_finite -- can't exact here
-
-
-section adapted_process
-
-variables [topological_space β] [preorder ι]
-  {u v : ι → α → β} {f : filtration ι m}
-
-/-- A sequence of functions `u` is adapted to a filtration `f` if for all `i`,
-`u i` is `f i`-measurable. -/
-def adapted (f : filtration ι m) (u : ι → α → β) : Prop :=
-∀ i : ι, strongly_measurable[f i] (u i)
-
-namespace adapted
-
-lemma add [has_add β] [has_continuous_add β] (hu : adapted f u) (hv : adapted f v) :
-  adapted f (u + v) :=
-λ i, (hu i).add (hv i)
-
-lemma neg [add_group β] [topological_add_group β] (hu : adapted f u) : adapted f (-u) :=
-λ i, (hu i).neg
-
-lemma smul [has_scalar ℝ β] [has_continuous_smul ℝ β] (c : ℝ) (hu : adapted f u) :
-  adapted f (c • u) :=
-λ i, (hu i).const_smul c
-
-end adapted
-
-variable (β)
-lemma adapted_zero [has_zero β] (f : filtration ι m) : adapted f (0 : ι → α → β) :=
-λ i, @strongly_measurable_zero α β (f i) _ _
-variable {β}
-
-/-- Progressively measurable process. A sequence of functions `u` is said to be progressively
-measurable with respect to a filtration `f` if at each point in time `i`, `u` restricted to
-`set.Iic i × α` is measurable with respect to the product `measurable_space` structure where the
-σ-algebra used for `α` is `f i`.
-The usual definition uses the interval `[0,i]`, which we replace by `set.Iic i`. We recover the
-usual definition for index types `ℝ≥0` or `ℕ`. -/
-def prog_measurable [measurable_space ι] (f : filtration ι m) (u : ι → α → β) : Prop :=
-∀ i, strongly_measurable[subtype.measurable_space.prod (f i)] (λ p : set.Iic i × α, u p.1 p.2)
-
-lemma prog_measurable_const [measurable_space ι] (f : filtration ι m) (b : β) :
-  prog_measurable f ((λ _ _, b) : ι → α → β) :=
-λ i, @strongly_measurable_const _ _ (subtype.measurable_space.prod (f i)) _ _
-
-namespace prog_measurable
-
-variables [measurable_space ι]
-
-protected lemma adapted (h : prog_measurable f u) : adapted f u :=
-begin
-  intro i,
-  have : u i = (λ p : set.Iic i × α, u p.1 p.2) ∘ (λ x, (⟨i, set.mem_Iic.mpr le_rfl⟩, x)) := rfl,
-  rw this,
-  exact (h i).comp_measurable measurable_prod_mk_left,
-end
-
-protected lemma comp {t : ι → α → ι} [topological_space ι] [borel_space ι] [metrizable_space ι]
-  (h : prog_measurable f u) (ht : prog_measurable f t)
-  (ht_le : ∀ i x, t i x ≤ i) :
-  prog_measurable f (λ i x, u (t i x) x) :=
-begin
-  intro i,
-  have : (λ p : ↥(set.Iic i) × α, u (t (p.fst : ι) p.snd) p.snd)
-    = (λ p : ↥(set.Iic i) × α, u (p.fst : ι) p.snd) ∘ (λ p : ↥(set.Iic i) × α,
-      (⟨t (p.fst : ι) p.snd, set.mem_Iic.mpr ((ht_le _ _).trans p.fst.prop)⟩, p.snd)) := rfl,
-  rw this,
-  exact (h i).comp_measurable ((ht i).measurable.subtype_mk.prod_mk measurable_snd),
-end
-
-section arithmetic
-
-@[to_additive] protected lemma mul [has_mul β] [has_continuous_mul β]
-  (hu : prog_measurable f u) (hv : prog_measurable f v) :
-  prog_measurable f (λ i x, u i x * v i x) :=
-λ i, (hu i).mul (hv i)
-
-@[to_additive] protected lemma finset_prod' {γ} [comm_monoid β] [has_continuous_mul β]
-  {U : γ → ι → α → β} {s : finset γ} (h : ∀ c ∈ s, prog_measurable f (U c)) :
-  prog_measurable f (∏ c in s, U c) :=
-finset.prod_induction U (prog_measurable f) (λ _ _, prog_measurable.mul)
-  (prog_measurable_const _ 1) h
-
-@[to_additive] protected lemma finset_prod {γ} [comm_monoid β] [has_continuous_mul β]
-  {U : γ → ι → α → β} {s : finset γ} (h : ∀ c ∈ s, prog_measurable f (U c)) :
-  prog_measurable f (λ i a, ∏ c in s, U c i a) :=
-by { convert prog_measurable.finset_prod' h, ext i a, simp only [finset.prod_apply], }
-
-@[to_additive] protected lemma inv [group β] [topological_group β] (hu : prog_measurable f u) :
-  prog_measurable f (λ i x, (u i x)⁻¹) :=
-λ i, (hu i).inv
-
-@[to_additive] protected lemma div [group β] [topological_group β]
-  (hu : prog_measurable f u) (hv : prog_measurable f v) :
-  prog_measurable f (λ i x, u i x / v i x) :=
-λ i, (hu i).div (hv i)
-
-end arithmetic
-
-end prog_measurable
-
-lemma prog_measurable_of_tendsto' {γ} [measurable_space ι] [metrizable_space β]
-  (fltr : filter γ) [fltr.ne_bot] [fltr.is_countably_generated] {U : γ → ι → α → β}
-  (h : ∀ l, prog_measurable f (U l)) (h_tendsto : tendsto U fltr (𝓝 u)) :
-  prog_measurable f u :=
-begin
-  assume i,
-  apply @strongly_measurable_of_tendsto (set.Iic i × α) β γ (measurable_space.prod _ (f i))
-   _ _ fltr _ _ _ _ (λ l, h l i),
-  rw tendsto_pi_nhds at h_tendsto ⊢,
-  intro x,
-  specialize h_tendsto x.fst,
-  rw tendsto_nhds at h_tendsto ⊢,
-  exact λ s hs h_mem, h_tendsto {g | g x.snd ∈ s} (hs.preimage (continuous_apply x.snd)) h_mem,
-end
-
-lemma prog_measurable_of_tendsto [measurable_space ι] [metrizable_space β]
-  {U : ℕ → ι → α → β}
-  (h : ∀ l, prog_measurable f (U l)) (h_tendsto : tendsto U at_top (𝓝 u)) :
-  prog_measurable f u :=
-prog_measurable_of_tendsto' at_top h h_tendsto
-
-
-/-- A continuous and adapted process is progressively measurable. -/
-theorem adapted.prog_measurable_of_continuous
-  [topological_space ι] [metrizable_space ι] [measurable_space ι]
-  [second_countable_topology ι] [opens_measurable_space ι] [metrizable_space β]
-  (h : adapted f u) (hu_cont : ∀ x, continuous (λ i, u i x)) :
-  prog_measurable f u :=
-λ i, @strongly_measurable_uncurry_of_continuous_of_strongly_measurable _ _ (set.Iic i) _ _ _ _ _ _ _
-  (f i) _ (λ x, (hu_cont x).comp continuous_induced_dom) (λ j, (h j).mono (f.mono j.prop))
-
-end adapted_process
-
-namespace filtration
-variables [topological_space β] [metrizable_space β] [mβ : measurable_space β] [borel_space β]
-  [preorder ι]
-
-include mβ
-
-/-- Given a sequence of functions, the natural filtration is the smallest sequence
-of σ-algebras such that that sequence of functions is measurable with respect to
-the filtration. -/
-def natural (u : ι → α → β) (hum : ∀ i, strongly_measurable (u i)) : filtration ι m :=
-{ seq   := λ i, ⨆ j ≤ i, measurable_space.comap (u j) mβ,
-  mono' := λ i j hij, bsupr_mono $ λ k, ge_trans hij,
-  le'   := λ i,
-  begin
-    refine supr₂_le _,
-    rintros j hj s ⟨t, ht, rfl⟩,
-    exact (hum j).measurable ht,
-  end }
-
-lemma adapted_natural {u : ι → α → β} (hum : ∀ i, strongly_measurable[m] (u i)) :
-  adapted (natural u hum) u :=
-begin
-  assume i,
-  refine strongly_measurable.mono _ (le_supr₂_of_le i (le_refl i) le_rfl),
-  rw strongly_measurable_iff_measurable_separable,
-  exact ⟨measurable_iff_comap_le.2 le_rfl, (hum i).is_separable_range⟩
-end
-
-end filtration
-
-/-! ### Stopping times -/
-
-/-- A stopping time with respect to some filtration `f` is a function
-`τ` such that for all `i`, the preimage of `{j | j ≤ i}` along `τ` is measurable
-with respect to `f i`.
-
-Intuitively, the stopping time `τ` describes some stopping rule such that at time
-`i`, we may determine it with the information we have at time `i`. -/
-def is_stopping_time [preorder ι] (f : filtration ι m) (τ : α → ι) :=
-∀ i : ι, measurable_set[f i] $ {x | τ x ≤ i}
-
-lemma is_stopping_time_const [preorder ι] (f : filtration ι m) (i : ι) :
-  is_stopping_time f (λ x, i) :=
-λ j, by simp only [measurable_set.const]
-
-section measurable_set
-
-section preorder
-variables [preorder ι] {f : filtration ι m} {τ : α → ι}
-
-protected lemma is_stopping_time.measurable_set_le (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[f i] {x | τ x ≤ i} :=
-hτ i
-
-lemma is_stopping_time.measurable_set_lt_of_pred [pred_order ι]
-  (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[f i] {x | τ x < i} :=
-begin
-  by_cases hi_min : is_min i,
-  { suffices : {x : α | τ x < i} = ∅, by { rw this, exact @measurable_set.empty _ (f i), },
-    ext1 x,
-    simp only [set.mem_set_of_eq, set.mem_empty_eq, iff_false],
-    rw is_min_iff_forall_not_lt at hi_min,
-    exact hi_min (τ x), },
-  have : {x : α | τ x < i} = τ ⁻¹' (set.Iio i) := rfl,
-  rw [this, ←Iic_pred_of_not_is_min hi_min],
-  exact f.mono (pred_le i) _ (hτ.measurable_set_le $ pred i),
-end
-
-end preorder
-
-section linear_order
-variables [linear_order ι] {f : filtration ι m} {τ : α → ι}
-
-lemma is_stopping_time.measurable_set_gt (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[f i] {x | i < τ x} :=
-begin
-  have : {x | i < τ x} = {x | τ x ≤ i}ᶜ,
-  { ext1 x, simp only [set.mem_set_of_eq, set.mem_compl_eq, not_le], },
-  rw this,
-  exact (hτ.measurable_set_le i).compl,
-end
-
-variables [topological_space ι] [order_topology ι] [first_countable_topology ι]
-
-/-- Auxiliary lemma for `is_stopping_time.measurable_set_lt`. -/
-lemma is_stopping_time.measurable_set_lt_of_is_lub
-  (hτ : is_stopping_time f τ) (i : ι) (h_lub : is_lub (set.Iio i) i) :
-  measurable_set[f i] {x | τ x < i} :=
-begin
-  by_cases hi_min : is_min i,
-  { suffices : {x : α | τ x < i} = ∅, by { rw this, exact @measurable_set.empty _ (f i), },
-    ext1 x,
-    simp only [set.mem_set_of_eq, set.mem_empty_eq, iff_false],
-    exact is_min_iff_forall_not_lt.mp hi_min (τ x), },
-  obtain ⟨seq, -, -, h_tendsto, h_bound⟩ : ∃ seq : ℕ → ι,
-      monotone seq ∧ (∀ j, seq j ≤ i) ∧ tendsto seq at_top (𝓝 i) ∧ (∀ j, seq j < i),
-    from h_lub.exists_seq_monotone_tendsto (not_is_min_iff.mp hi_min),
-  have h_Ioi_eq_Union : set.Iio i = ⋃ j, { k | k ≤ seq j},
-  { ext1 k,
-    simp only [set.mem_Iio, set.mem_Union, set.mem_set_of_eq],
-    refine ⟨λ hk_lt_i, _, λ h_exists_k_le_seq, _⟩,
-    { rw tendsto_at_top' at h_tendsto,
-      have h_nhds : set.Ici k ∈ 𝓝 i,
-        from mem_nhds_iff.mpr ⟨set.Ioi k, set.Ioi_subset_Ici le_rfl, is_open_Ioi, hk_lt_i⟩,
-      obtain ⟨a, ha⟩ : ∃ (a : ℕ), ∀ (b : ℕ), b ≥ a → k ≤ seq b := h_tendsto (set.Ici k) h_nhds,
-      exact ⟨a, ha a le_rfl⟩, },
-    { obtain ⟨j, hk_seq_j⟩ := h_exists_k_le_seq,
-      exact hk_seq_j.trans_lt (h_bound j), }, },
-  have h_lt_eq_preimage : {x : α | τ x < i} = τ ⁻¹' (set.Iio i),
-  { ext1 x, simp only [set.mem_set_of_eq, set.mem_preimage, set.mem_Iio], },
-  rw [h_lt_eq_preimage, h_Ioi_eq_Union],
-  simp only [set.preimage_Union, set.preimage_set_of_eq],
-  exact measurable_set.Union
-    (λ n, f.mono (h_bound n).le _ (hτ.measurable_set_le (seq n))),
-end
-
-lemma is_stopping_time.measurable_set_lt (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[f i] {x | τ x < i} :=
-begin
-  obtain ⟨i', hi'_lub⟩ : ∃ i', is_lub (set.Iio i) i', from exists_lub_Iio i,
-  cases lub_Iio_eq_self_or_Iio_eq_Iic i hi'_lub with hi'_eq_i h_Iio_eq_Iic,
-  { rw ← hi'_eq_i at hi'_lub ⊢,
-    exact hτ.measurable_set_lt_of_is_lub i' hi'_lub, },
-  { have h_lt_eq_preimage : {x : α | τ x < i} = τ ⁻¹' (set.Iio i) := rfl,
-    rw [h_lt_eq_preimage, h_Iio_eq_Iic],
-    exact f.mono (lub_Iio_le i hi'_lub) _ (hτ.measurable_set_le i'), },
-end
-
-lemma is_stopping_time.measurable_set_ge (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[f i] {x | i ≤ τ x} :=
-begin
-  have : {x | i ≤ τ x} = {x | τ x < i}ᶜ,
-  { ext1 x, simp only [set.mem_set_of_eq, set.mem_compl_eq, not_lt], },
-  rw this,
-  exact (hτ.measurable_set_lt i).compl,
-end
-
-lemma is_stopping_time.measurable_set_eq (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[f i] {x | τ x = i} :=
-begin
-  have : {x | τ x = i} = {x | τ x ≤ i} ∩ {x | τ x ≥ i},
-  { ext1 x, simp only [set.mem_set_of_eq, ge_iff_le, set.mem_inter_eq, le_antisymm_iff], },
-  rw this,
-  exact (hτ.measurable_set_le i).inter (hτ.measurable_set_ge i),
-end
-
-lemma is_stopping_time.measurable_set_eq_le (hτ : is_stopping_time f τ) {i j : ι} (hle : i ≤ j) :
-  measurable_set[f j] {x | τ x = i} :=
-f.mono hle _ $ hτ.measurable_set_eq i
-
-lemma is_stopping_time.measurable_set_lt_le (hτ : is_stopping_time f τ) {i j : ι} (hle : i ≤ j) :
-  measurable_set[f j] {x | τ x < i} :=
-f.mono hle _ $ hτ.measurable_set_lt i
-
-end linear_order
-
-section encodable
-
-lemma is_stopping_time_of_measurable_set_eq [preorder ι] [encodable ι]
-  {f : filtration ι m} {τ : α → ι} (hτ : ∀ i, measurable_set[f i] {x | τ x = i}) :
-  is_stopping_time f τ :=
-begin
-  intro i,
-  rw show {x | τ x ≤ i} = ⋃ k ≤ i, {x | τ x = k}, by { ext, simp },
-  refine measurable_set.bUnion (set.countable_encodable _) (λ k hk, _),
-  exact f.mono hk _ (hτ k),
-end
-
-end encodable
-
-end measurable_set
-
-namespace is_stopping_time
-
-protected lemma max [linear_order ι] {f : filtration ι m} {τ π : α → ι}
-  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
-  is_stopping_time f (λ x, max (τ x) (π x)) :=
-begin
-  intro i,
-  simp_rw [max_le_iff, set.set_of_and],
-  exact (hτ i).inter (hπ i),
-end
-
-protected lemma max_const [linear_order ι] {f : filtration ι m} {τ : α → ι}
-  (hτ : is_stopping_time f τ) (i : ι) :
-  is_stopping_time f (λ x, max (τ x) i) :=
-hτ.max (is_stopping_time_const f i)
-
-protected lemma min [linear_order ι] {f : filtration ι m} {τ π : α → ι}
-  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
-  is_stopping_time f (λ x, min (τ x) (π x)) :=
-begin
-  intro i,
-  simp_rw [min_le_iff, set.set_of_or],
-  exact (hτ i).union (hπ i),
-end
-
-protected lemma min_const [linear_order ι] {f : filtration ι m} {τ : α → ι}
-  (hτ : is_stopping_time f τ) (i : ι) :
-  is_stopping_time f (λ x, min (τ x) i) :=
-hτ.min (is_stopping_time_const f i)
-
-lemma add_const [add_group ι] [preorder ι] [covariant_class ι ι (function.swap (+)) (≤)]
-  [covariant_class ι ι (+) (≤)]
-  {f : filtration ι m} {τ : α → ι} (hτ : is_stopping_time f τ) {i : ι} (hi : 0 ≤ i) :
-  is_stopping_time f (λ x, τ x + i) :=
-begin
-  intro j,
-  simp_rw [← le_sub_iff_add_le],
-  exact f.mono (sub_le_self j hi) _ (hτ (j - i)),
-end
-
-lemma add_const_nat
-  {f : filtration ℕ m} {τ : α → ℕ} (hτ : is_stopping_time f τ) {i : ℕ} :
-  is_stopping_time f (λ x, τ x + i) :=
-begin
-  refine is_stopping_time_of_measurable_set_eq (λ j, _),
-  by_cases hij : i ≤ j,
-  { simp_rw [eq_comm, ← nat.sub_eq_iff_eq_add hij, eq_comm],
-    exact f.mono (j.sub_le i) _ (hτ.measurable_set_eq (j - i)) },
-  { rw not_le at hij,
-    convert measurable_set.empty,
-    ext x,
-    simp only [set.mem_empty_eq, iff_false],
-    rintro (hx : τ x + i = j),
-    linarith },
-end
-
--- generalize to certain encodable type?
-lemma add
-  {f : filtration ℕ m} {τ π : α → ℕ} (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
-  is_stopping_time f (τ + π) :=
-begin
-  intro i,
-  rw (_ : {x | (τ + π) x ≤ i} = ⋃ k ≤ i, {x | π x = k} ∩ {x | τ x + k ≤ i}),
-  { exact measurable_set.Union (λ k, measurable_set.Union_Prop
-      (λ hk, (hπ.measurable_set_eq_le hk).inter (hτ.add_const_nat i))) },
-  ext,
-  simp only [pi.add_apply, set.mem_set_of_eq, set.mem_Union, set.mem_inter_eq, exists_prop],
-  refine ⟨λ h, ⟨π x, by linarith, rfl, h⟩, _⟩,
-  rintro ⟨j, hj, rfl, h⟩,
-  assumption
-end
-
-section preorder
-
-variables [preorder ι] {f : filtration ι m} {τ π : α → ι}
-
-/-- The associated σ-algebra with a stopping time. -/
-protected def measurable_space (hτ : is_stopping_time f τ) : measurable_space α :=
-{ measurable_set' := λ s, ∀ i : ι, measurable_set[f i] (s ∩ {x | τ x ≤ i}),
-  measurable_set_empty :=
-    λ i, (set.empty_inter {x | τ x ≤ i}).symm ▸ @measurable_set.empty _ (f i),
-  measurable_set_compl := λ s hs i,
-    begin
-      rw (_ : sᶜ ∩ {x | τ x ≤ i} = (sᶜ ∪ {x | τ x ≤ i}ᶜ) ∩ {x | τ x ≤ i}),
-      { refine measurable_set.inter _ _,
-        { rw ← set.compl_inter,
-          exact (hs i).compl },
-        { exact hτ i} },
-      { rw set.union_inter_distrib_right,
-        simp only [set.compl_inter_self, set.union_empty] }
-    end,
-  measurable_set_Union := λ s hs i,
-    begin
-      rw forall_swap at hs,
-      rw set.Union_inter,
-      exact measurable_set.Union (hs i),
-    end }
-
-protected lemma measurable_set (hτ : is_stopping_time f τ) (s : set α) :
-  measurable_set[hτ.measurable_space] s ↔
-  ∀ i : ι, measurable_set[f i] (s ∩ {x | τ x ≤ i}) :=
-iff.rfl
-
-lemma measurable_space_mono
-  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (hle : τ ≤ π) :
-  hτ.measurable_space ≤ hπ.measurable_space :=
-begin
-  intros s hs i,
-  rw (_ : s ∩ {x | π x ≤ i} = s ∩ {x | τ x ≤ i} ∩ {x | π x ≤ i}),
-  { exact (hs i).inter (hπ i) },
-  { ext,
-    simp only [set.mem_inter_eq, iff_self_and, and.congr_left_iff, set.mem_set_of_eq],
-    intros hle' _,
-    exact le_trans (hle _) hle' },
-end
-
-lemma measurable_space_le [encodable ι] (hτ : is_stopping_time f τ) :
-  hτ.measurable_space ≤ m :=
-begin
-  intros s hs,
-  change ∀ i, measurable_set[f i] (s ∩ {x | τ x ≤ i}) at hs,
-  rw (_ : s = ⋃ i, s ∩ {x | τ x ≤ i}),
-  { exact measurable_set.Union (λ i, f.le i _ (hs i)) },
-  { ext x, split; rw set.mem_Union,
-    { exact λ hx, ⟨τ x, hx, le_rfl⟩ },
-    { rintro ⟨_, hx, _⟩,
-      exact hx } }
-end
-
-@[simp] lemma measurable_space_const (f : filtration ι m) (i : ι) :
-  (is_stopping_time_const f i).measurable_space = f i :=
-begin
-  ext1 s,
-  change measurable_set[(is_stopping_time_const f i).measurable_space] s ↔ measurable_set[f i] s,
-  rw is_stopping_time.measurable_set,
-  split; intro h,
-  { specialize h i,
-    simpa only [le_refl, set.set_of_true, set.inter_univ] using h, },
-  { intro j,
-    by_cases hij : i ≤ j,
-    { simp only [hij, set.set_of_true, set.inter_univ],
-      exact f.mono hij _ h, },
-    { simp only [hij, set.set_of_false, set.inter_empty, measurable_set.empty], }, },
-end
-
-lemma measurable_set_inter_eq_iff (hτ : is_stopping_time f τ) (s : set α) (i : ι) :
-  measurable_set[hτ.measurable_space] (s ∩ {x | τ x = i})
-    ↔ measurable_set[f i] (s ∩ {x | τ x = i}) :=
-begin
-  have : ∀ j, ({x : α | τ x = i} ∩ {x : α | τ x ≤ j}) = {x : α | τ x = i} ∩ {x | i ≤ j},
-  { intro j,
-    ext1 x,
-    simp only [set.mem_inter_eq, set.mem_set_of_eq, and.congr_right_iff],
-    intro hxi,
-    rw hxi, },
-  split; intro h,
-  { specialize h i,
-    simpa only [set.inter_assoc, this, le_refl, set.set_of_true, set.inter_univ] using h, },
-  { intro j,
-    rw [set.inter_assoc, this],
-    by_cases hij : i ≤ j,
-    { simp only [hij, set.set_of_true, set.inter_univ],
-      exact f.mono hij _ h, },
-    { simp [hij], }, },
-end
-
-lemma measurable_space_le_of_le_const (hτ : is_stopping_time f τ) {i : ι} (hτ_le : ∀ x, τ x ≤ i) :
-  hτ.measurable_space ≤ f i :=
-(measurable_space_mono hτ _ hτ_le).trans (is_stopping_time.measurable_space_const _ _).le
-
-lemma le_measurable_space_of_const_le (hτ : is_stopping_time f τ) {i : ι} (hτ_le : ∀ x, i ≤ τ x) :
-  f i ≤ hτ.measurable_space :=
-(is_stopping_time.measurable_space_const _ _).symm.le.trans (measurable_space_mono _ hτ hτ_le)
-
-end preorder
-
-section linear_order
-
-variables [linear_order ι] {f : filtration ι m} {τ π : α → ι}
-
-protected lemma measurable_set_le' (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[hτ.measurable_space] {x | τ x ≤ i} :=
-begin
-  intro j,
-  have : {x : α | τ x ≤ i} ∩ {x : α | τ x ≤ j} = {x : α | τ x ≤ min i j},
-  { ext1 x, simp only [set.mem_inter_eq, set.mem_set_of_eq, le_min_iff], },
-  rw this,
-  exact f.mono (min_le_right i j) _ (hτ _),
-end
-
-protected lemma measurable_set_gt' (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[hτ.measurable_space] {x | i < τ x} :=
-begin
-  have : {x : α | i < τ x} = {x : α | τ x ≤ i}ᶜ, by { ext1 x, simp, },
-  rw this,
-  exact (hτ.measurable_set_le' i).compl,
-end
-
-protected lemma measurable_set_eq' [topological_space ι] [order_topology ι]
-  [first_countable_topology ι]
-  (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[hτ.measurable_space] {x | τ x = i} :=
-begin
-  rw [← set.univ_inter {x | τ x = i}, measurable_set_inter_eq_iff, set.univ_inter],
-  exact hτ.measurable_set_eq i,
-end
-
-protected lemma measurable_set_ge' [topological_space ι] [order_topology ι]
-  [first_countable_topology ι]
-  (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[hτ.measurable_space] {x | i ≤ τ x} :=
-begin
-  have : {x | i ≤ τ x} = {x | τ x = i} ∪ {x | i < τ x},
-  { ext1 x,
-    simp only [le_iff_lt_or_eq, set.mem_set_of_eq, set.mem_union_eq],
-    rw [@eq_comm _ i, or_comm], },
-  rw this,
-  exact (hτ.measurable_set_eq' i).union (hτ.measurable_set_gt' i),
-end
-
-protected lemma measurable_set_lt' [topological_space ι] [order_topology ι]
-  [first_countable_topology ι]
-  (hτ : is_stopping_time f τ) (i : ι) :
-  measurable_set[hτ.measurable_space] {x | τ x < i} :=
-begin
-  have : {x | τ x < i} = {x | τ x ≤ i} \ {x | τ x = i},
-  { ext1 x,
-    simp only [lt_iff_le_and_ne, set.mem_set_of_eq, set.mem_diff], },
-  rw this,
-  exact (hτ.measurable_set_le' i).diff (hτ.measurable_set_eq' i),
-end
-
-protected lemma measurable [topological_space ι] [measurable_space ι]
-  [borel_space ι] [order_topology ι] [second_countable_topology ι]
-  (hτ : is_stopping_time f τ) :
-  measurable[hτ.measurable_space] τ :=
-@measurable_of_Iic ι α _ _ _ hτ.measurable_space _ _ _ _ (λ i, hτ.measurable_set_le' i)
-
-protected lemma measurable_of_le [topological_space ι] [measurable_space ι]
-  [borel_space ι] [order_topology ι] [second_countable_topology ι]
-  (hτ : is_stopping_time f τ) {i : ι} (hτ_le : ∀ x, τ x ≤ i) :
-  measurable[f i] τ :=
-hτ.measurable.mono (measurable_space_le_of_le_const _ hτ_le) le_rfl
-
-lemma measurable_space_min (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) :
-  (hτ.min hπ).measurable_space = hτ.measurable_space ⊓ hπ.measurable_space :=
-begin
-  refine le_antisymm _ _,
-  { exact le_inf (is_stopping_time.measurable_space_mono _ hτ (λ _, min_le_left _ _))
-      (is_stopping_time.measurable_space_mono _ hπ (λ _, min_le_right _ _)), },
-  { intro s,
-    change measurable_set[hτ.measurable_space] s ∧ measurable_set[hπ.measurable_space] s
-      → measurable_set[(hτ.min hπ).measurable_space] s,
-    simp_rw is_stopping_time.measurable_set,
-    have : ∀ i, {x | min (τ x) (π x) ≤ i} = {x | τ x ≤ i} ∪ {x | π x ≤ i},
-    { intro i, ext1 x, simp, },
-    simp_rw [this, set.inter_union_distrib_left],
-    exact λ h i, (h.left i).union (h.right i), },
-end
-
-lemma measurable_set_min_iff (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (s : set α) :
-  measurable_set[(hτ.min hπ).measurable_space] s
-    ↔ measurable_set[hτ.measurable_space] s ∧ measurable_set[hπ.measurable_space] s :=
-by { rw measurable_space_min, refl, }
-
-lemma measurable_set_inter_le [topological_space ι] [second_countable_topology ι] [order_topology ι]
-  [measurable_space ι] [borel_space ι]
-  (hτ : is_stopping_time f τ) (hπ : is_stopping_time f π) (s : set α)
-  (hs : measurable_set[hτ.measurable_space] s) :
-  measurable_set[(hτ.min hπ).measurable_space] (s ∩ {x | τ x ≤ π x}) :=
-begin
-  simp_rw is_stopping_time.measurable_set at ⊢ hs,
-  intro i,
-  have : (s ∩ {x | τ x ≤ π x} ∩ {x | min (τ x) (π x) ≤ i})
-    = (s ∩ {x | τ x ≤ i}) ∩ {x | min (τ x) (π x) ≤ i} ∩ {x | min (τ x) i ≤ min (min (τ x) (π x)) i},
-  { ext1 x,
-    simp only [min_le_iff, set.mem_inter_eq, set.mem_set_of_eq, le_min_iff, le_refl, true_and,
-      and_true, true_or, or_true],
-    by_cases hτi : τ x ≤ i,
-    { simp only [hτi, true_or, and_true, and.congr_right_iff],
-      intro hx,
-      split; intro h,
-      { exact or.inl h, },
-      { cases h,
-        { exact h, },
-        { exact hτi.trans h, }, }, },
-    simp only [hτi, false_or, and_false, false_and, iff_false, not_and, not_le, and_imp],
-    refine λ hx hτ_le_π, lt_of_lt_of_le _ hτ_le_π,
-    rw ← not_le,
-    exact hτi, },
-  rw this,
-  refine ((hs i).inter ((hτ.min hπ) i)).inter _,
-  apply measurable_set_le,
-  { exact (hτ.min_const i).measurable_of_le (λ _, min_le_right _ _), },
-  { exact ((hτ.min hπ).min_const i).measurable_of_le (λ _, min_le_right _ _),  },
-end
-
-end linear_order
-
-end is_stopping_time
-
-section linear_order
-
-/-! ## Stopped value and stopped process -/
-
-/-- Given a map `u : ι → α → E`, its stopped value with respect to the stopping
-time `τ` is the map `x ↦ u (τ x) x`. -/
-def stopped_value (u : ι → α → β) (τ : α → ι) : α → β :=
-λ x, u (τ x) x
-
-lemma stopped_value_const (u : ι → α → β) (i : ι) : stopped_value u (λ x, i) = u i :=
-rfl
-
-variable [linear_order ι]
-
-/-- Given a map `u : ι → α → E`, the stopped process with respect to `τ` is `u i x` if
-`i ≤ τ x`, and `u (τ x) x` otherwise.
-
-Intuitively, the stopped process stops evolving once the stopping time has occured. -/
-def stopped_process (u : ι → α → β) (τ : α → ι) : ι → α → β :=
-λ i x, u (min i (τ x)) x
-
-lemma stopped_process_eq_of_le {u : ι → α → β} {τ : α → ι}
-  {i : ι} {x : α} (h : i ≤ τ x) : stopped_process u τ i x = u i x :=
-by simp [stopped_process, min_eq_left h]
-
-lemma stopped_process_eq_of_ge {u : ι → α → β} {τ : α → ι}
-  {i : ι} {x : α} (h : τ x ≤ i) : stopped_process u τ i x = u (τ x) x :=
-by simp [stopped_process, min_eq_right h]
-
-section prog_measurable
-
-variables [measurable_space ι] [topological_space ι] [order_topology ι]
-  [second_countable_topology ι] [borel_space ι] [metrizable_space ι]
-  [topological_space β]
-  {u : ι → α → β} {τ : α → ι} {f : filtration ι m}
-
-lemma prog_measurable_min_stopping_time (hτ : is_stopping_time f τ) :
-  prog_measurable f (λ i x, min i (τ x)) :=
-begin
-  intro i,
-  let m_prod : measurable_space (set.Iic i × α) := measurable_space.prod _ (f i),
-  let m_set : ∀ t : set (set.Iic i × α), measurable_space t :=
-    λ _, @subtype.measurable_space (set.Iic i × α) _ m_prod,
-  let s := {p : set.Iic i × α | τ p.2 ≤ i},
-  have hs : measurable_set[m_prod] s, from @measurable_snd (set.Iic i) α _ (f i) _ (hτ i),
-  have h_meas_fst : ∀ t : set (set.Iic i × α),
-      measurable[m_set t] (λ x : t, ((x : set.Iic i × α).fst : ι)),
-    from λ t, (@measurable_subtype_coe (set.Iic i × α) m_prod _).fst.subtype_coe,
-  apply measurable.strongly_measurable,
-  refine measurable_of_restrict_of_restrict_compl hs _ _,
-  { refine @measurable.min _ _ _ _ _ (m_set s) _ _ _ _ _ (h_meas_fst s) _,
-    refine @measurable_of_Iic ι s _ _ _ (m_set s) _ _ _ _ (λ j, _),
-    have h_set_eq : (λ x : s, τ (x : set.Iic i × α).snd) ⁻¹' set.Iic j
-      = (λ x : s, (x : set.Iic i × α).snd) ⁻¹' {x | τ x ≤ min i j},
-    { ext1 x,
-      simp only [set.mem_preimage, set.mem_Iic, iff_and_self, le_min_iff, set.mem_set_of_eq],
-      exact λ _, x.prop, },
-    rw h_set_eq,
-    suffices h_meas : @measurable _ _ (m_set s) (f i) (λ x : s, (x : set.Iic i × α).snd),
-      from h_meas (f.mono (min_le_left _ _) _ (hτ.measurable_set_le (min i j))),
-    exact measurable_snd.comp (@measurable_subtype_coe _ m_prod _), },
-  { suffices h_min_eq_left : (λ x : sᶜ, min ↑((x : set.Iic i × α).fst) (τ (x : set.Iic i × α).snd))
-      = λ x : sᶜ, ↑((x : set.Iic i × α).fst),
-    { rw [set.restrict, h_min_eq_left],
-      exact h_meas_fst _, },
-    ext1 x,
-    rw min_eq_left,
-    have hx_fst_le : ↑(x : set.Iic i × α).fst ≤ i, from (x : set.Iic i × α).fst.prop,
-    refine hx_fst_le.trans (le_of_lt _),
-    convert x.prop,
-    simp only [not_le, set.mem_compl_eq, set.mem_set_of_eq], },
-end
-
-lemma prog_measurable.stopped_process (h : prog_measurable f u) (hτ : is_stopping_time f τ) :
-  prog_measurable f (stopped_process u τ) :=
-h.comp (prog_measurable_min_stopping_time hτ) (λ i x, min_le_left _ _)
-
-lemma prog_measurable.adapted_stopped_process
-  (h : prog_measurable f u) (hτ : is_stopping_time f τ) :
-  adapted f (stopped_process u τ) :=
-(h.stopped_process hτ).adapted
-
-lemma prog_measurable.strongly_measurable_stopped_process
-  (hu : prog_measurable f u) (hτ : is_stopping_time f τ) (i : ι) :
-  strongly_measurable (stopped_process u τ i) :=
-(hu.adapted_stopped_process hτ i).mono (f.le _)
-
-end prog_measurable
-
-end linear_order
-
-section nat
-/-! ### Filtrations indexed by `ℕ` -/
-
-open filtration
-
-variables {f : filtration ℕ m} {u : ℕ → α → β} {τ π : α → ℕ}
-
-lemma stopped_value_sub_eq_sum [add_comm_group β] (hle : τ ≤ π) :
-  stopped_value u π - stopped_value u τ =
-  λ x, (∑ i in finset.Ico (τ x) (π x), (u (i + 1) - u i)) x :=
-begin
-  ext x,
-  rw [finset.sum_Ico_eq_sub _ (hle x), finset.sum_range_sub, finset.sum_range_sub],
-  simp [stopped_value],
-end
-
-lemma stopped_value_sub_eq_sum' [add_comm_group β] (hle : τ ≤ π) {N : ℕ} (hbdd : ∀ x, π x ≤ N) :
-  stopped_value u π - stopped_value u τ =
-  λ x, (∑ i in finset.range (N + 1),
-    set.indicator {x | τ x ≤ i ∧ i < π x} (u (i + 1) - u i)) x :=
-begin
-  rw stopped_value_sub_eq_sum hle,
-  ext x,
-  simp only [finset.sum_apply, finset.sum_indicator_eq_sum_filter],
-  refine finset.sum_congr _ (λ _ _, rfl),
-  ext i,
-  simp only [finset.mem_filter, set.mem_set_of_eq, finset.mem_range, finset.mem_Ico],
-  exact ⟨λ h, ⟨lt_trans h.2 (nat.lt_succ_iff.2 $ hbdd _), h⟩, λ h, h.2⟩
-end
-
-section add_comm_monoid
-
-variables [add_comm_monoid β]
-
-/-- For filtrations indexed by `ℕ`, `adapted` and `prog_measurable` are equivalent. This lemma
-provides `adapted f u → prog_measurable f u`. See `prog_measurable.adapted` for the reverse
-direction, which is true more generally. -/
-lemma adapted.prog_measurable_of_nat [topological_space β] [has_continuous_add β]
-  (h : adapted f u) : prog_measurable f u :=
-begin
-  intro i,
-  have : (λ p : ↥(set.Iic i) × α, u ↑(p.fst) p.snd)
-    = λ p : ↥(set.Iic i) × α, ∑ j in finset.range (i + 1), if ↑p.fst = j then u j p.snd else 0,
-  { ext1 p,
-    rw finset.sum_ite_eq,
-    have hp_mem : (p.fst : ℕ) ∈ finset.range (i + 1) := finset.mem_range_succ_iff.mpr p.fst.prop,
-    simp only [hp_mem, if_true], },
-  rw this,
-  refine finset.strongly_measurable_sum _ (λ j hj, strongly_measurable.ite _ _ _),
-  { suffices h_meas : measurable[measurable_space.prod _ (f i)]
-        (λ a : ↥(set.Iic i) × α, (a.fst : ℕ)),
-      from h_meas (measurable_set_singleton j),
-    exact measurable_fst.subtype_coe, },
-  { have h_le : j ≤ i, from finset.mem_range_succ_iff.mp hj,
-    exact (strongly_measurable.mono (h j) (f.mono h_le)).comp_measurable measurable_snd, },
-  { exact strongly_measurable_const, },
-end
-
-/-- For filtrations indexed by `ℕ`, the stopped process obtained from an adapted process is
-adapted. -/
-lemma adapted.stopped_process_of_nat [topological_space β] [has_continuous_add β]
-  (hu : adapted f u) (hτ : is_stopping_time f τ) :
-  adapted f (stopped_process u τ) :=
-(hu.prog_measurable_of_nat.stopped_process hτ).adapted
-
-lemma adapted.strongly_measurable_stopped_process_of_nat [topological_space β]
-  [has_continuous_add β]
-  (hτ : is_stopping_time f τ) (hu : adapted f u) (n : ℕ) :
-  strongly_measurable (stopped_process u τ n) :=
-hu.prog_measurable_of_nat.strongly_measurable_stopped_process hτ n
-
-lemma stopped_value_eq {N : ℕ} (hbdd : ∀ x, τ x ≤ N) :
-  stopped_value u τ =
-  λ x, (∑ i in finset.range (N + 1), set.indicator {x | τ x = i} (u i)) x :=
-begin
-  ext y,
-  rw [stopped_value, finset.sum_apply, finset.sum_eq_single (τ y)],
-  { rw set.indicator_of_mem,
-    exact rfl },
-  { exact λ i hi hneq, set.indicator_of_not_mem hneq.symm _ },
-  { intro hy,
-    rw set.indicator_of_not_mem,
-    exact λ _, hy (finset.mem_range.2 $ lt_of_le_of_lt (hbdd _) (nat.lt_succ_self _)) }
-end
-
-lemma stopped_process_eq (n : ℕ) :
-  stopped_process u τ n =
-  set.indicator {a | n ≤ τ a} (u n) +
-    ∑ i in finset.range n, set.indicator {a | τ a = i} (u i) :=
-begin
-  ext x,
-  rw [pi.add_apply, finset.sum_apply],
-  cases le_or_lt n (τ x),
-  { rw [stopped_process_eq_of_le h, set.indicator_of_mem, finset.sum_eq_zero, add_zero],
-    { intros m hm,
-      rw finset.mem_range at hm,
-      exact set.indicator_of_not_mem ((lt_of_lt_of_le hm h).ne.symm) _ },
-    { exact h } },
-  { rw [stopped_process_eq_of_ge (le_of_lt h), finset.sum_eq_single_of_mem (τ x)],
-    { rw [set.indicator_of_not_mem, zero_add, set.indicator_of_mem],
-      { exact rfl }, -- refl does not work
-      { exact not_le.2 h } },
-    { rwa [finset.mem_range] },
-    { intros b hb hneq,
-      rw set.indicator_of_not_mem,
-      exact hneq.symm } },
-end
-
-end add_comm_monoid
-
-section normed_group
-
-variables [normed_group β] {p : ℝ≥0∞} {μ : measure α}
-
-lemma mem_ℒp_stopped_process (hτ : is_stopping_time f τ) (hu : ∀ n, mem_ℒp (u n) p μ) (n : ℕ) :
-  mem_ℒp (stopped_process u τ n) p μ :=
-begin
-  rw stopped_process_eq,
-  refine mem_ℒp.add _ _,
-  { exact mem_ℒp.indicator (f.le n {a : α | n ≤ τ a} (hτ.measurable_set_ge n)) (hu n) },
-  { suffices : mem_ℒp (λ x, ∑ (i : ℕ) in finset.range n, {a : α | τ a = i}.indicator (u i) x) p μ,
-    { convert this, ext1 x, simp only [finset.sum_apply] },
-    refine mem_ℒp_finset_sum _ (λ i hi, mem_ℒp.indicator _ (hu i)),
-    exact f.le i {a : α | τ a = i} (hτ.measurable_set_eq i) },
-end
-
-lemma integrable_stopped_process (hτ : is_stopping_time f τ)
-  (hu : ∀ n, integrable (u n) μ) (n : ℕ) :
-  integrable (stopped_process u τ n) μ :=
-by { simp_rw ← mem_ℒp_one_iff_integrable at hu ⊢, exact mem_ℒp_stopped_process hτ hu n, }
-
-lemma mem_ℒp_stopped_value (hτ : is_stopping_time f τ)
-  (hu : ∀ n, mem_ℒp (u n) p μ) {N : ℕ} (hbdd : ∀ x, τ x ≤ N) :
-  mem_ℒp (stopped_value u τ) p μ :=
-begin
-  rw stopped_value_eq hbdd,
-  suffices : mem_ℒp (λ x, ∑ (i : ℕ) in finset.range (N + 1),
-    {a : α | τ a = i}.indicator (u i) x) p μ,
-  { convert this, ext1 x, simp only [finset.sum_apply] },
-  refine mem_ℒp_finset_sum _ (λ i hi, mem_ℒp.indicator _ (hu i)),
-  exact f.le i {a : α | τ a = i} (hτ.measurable_set_eq i)
-end
-
-lemma integrable_stopped_value (hτ : is_stopping_time f τ)
-  (hu : ∀ n, integrable (u n) μ) {N : ℕ} (hbdd : ∀ x, τ x ≤ N) :
-  integrable (stopped_value u τ) μ :=
-by { simp_rw ← mem_ℒp_one_iff_integrable at hu ⊢, exact mem_ℒp_stopped_value hτ hu hbdd, }
-
-end normed_group
-
-end nat
-
-section piecewise_const
-
-variables [preorder ι] {𝒢 : filtration ι m} {τ η : α → ι} {i j : ι} {s : set α}
-  [decidable_pred (∈ s)]
-
-/-- Given stopping times `τ` and `η` which are bounded below, `set.piecewise s τ η` is also
-a stopping time with respect to the same filtration. -/
-lemma is_stopping_time.piecewise_of_le (hτ_st : is_stopping_time 𝒢 τ)
-  (hη_st : is_stopping_time 𝒢 η) (hτ : ∀ x, i ≤ τ x) (hη : ∀ x, i ≤ η x)
-  (hs : measurable_set[𝒢 i] s) :
-  is_stopping_time 𝒢 (s.piecewise τ η) :=
-begin
-  intro n,
-  have : {x | s.piecewise τ η x ≤ n}
-    = (s ∩ {x | τ x ≤ n}) ∪ (sᶜ ∩ {x | η x ≤ n}),
-  { ext1 x,
-    simp only [set.piecewise, set.mem_inter_eq, set.mem_set_of_eq, and.congr_right_iff],
-    by_cases hx : x ∈ s; simp [hx], },
-  rw this,
-  by_cases hin : i ≤ n,
-  { have hs_n : measurable_set[𝒢 n] s, from 𝒢.mono hin _ hs,
-    exact (hs_n.inter (hτ_st n)).union (hs_n.compl.inter (hη_st n)), },
-  { have hτn : ∀ x, ¬ τ x ≤ n := λ x hτn, hin ((hτ x).trans hτn),
-    have hηn : ∀ x, ¬ η x ≤ n := λ x hηn, hin ((hη x).trans hηn),
-    simp [hτn, hηn], },
-end
-
-lemma is_stopping_time_piecewise_const (hij : i ≤ j) (hs : measurable_set[𝒢 i] s) :
-  is_stopping_time 𝒢 (s.piecewise (λ _, i) (λ _, j)) :=
-(is_stopping_time_const 𝒢 i).piecewise_of_le (is_stopping_time_const 𝒢 j)
-  (λ x, le_rfl) (λ _, hij) hs
-
-lemma stopped_value_piecewise_const {ι' : Type*} {i j : ι'} {f : ι' → α → ℝ} :
-  stopped_value f (s.piecewise (λ _, i) (λ _, j)) = s.piecewise (f i) (f j) :=
-by { ext x, rw stopped_value, by_cases hx : x ∈ s; simp [hx] }
-
-lemma stopped_value_piecewise_const' {ι' : Type*} {i j : ι'} {f : ι' → α → ℝ} :
-  stopped_value f (s.piecewise (λ _, i) (λ _, j)) = s.indicator (f i) + sᶜ.indicator (f j) :=
-by { ext x, rw stopped_value, by_cases hx : x ∈ s; simp [hx] }
-
-end piecewise_const
-
-end measure_theory
diff --git a/src/probability/strong_law.lean b/src/probability/strong_law.lean
new file mode 100644
index 0000000000000..53020a09142fa
--- /dev/null
+++ b/src/probability/strong_law.lean
@@ -0,0 +1,769 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+
+import probability.ident_distrib
+import measure_theory.integral.interval_integral
+import analysis.specific_limits.floor_pow
+import analysis.p_series
+import analysis.asymptotics.specific_asymptotics
+
+/-!
+# The strong law of large numbers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We prove the strong law of large numbers, in `probability_theory.strong_law_ae`:
+If `X n` is a sequence of independent identically distributed integrable real-valued random
+variables, then `∑ i in range n, X i / n` converges almost surely to `𝔼[X 0]`.
+We give here the strong version, due to Etemadi, that only requires pairwise independence.
+
+This file also contains the Lᵖ version of the strong law of large numbers provided by
+`probability_theory.strong_law_Lp` which shows `∑ i in range n, X i / n` converges in Lᵖ to
+`𝔼[X 0]` provided `X n` is independent identically distributed and is Lᵖ.
+
+## Implementation
+
+We follow the proof by Etemadi
+[Etemadi, *An elementary proof of the strong law of large numbers*][etemadi_strong_law],
+which goes as follows.
+
+It suffices to prove the result for nonnegative `X`, as one can prove the general result by
+splitting a general `X` into its positive part and negative part.
+Consider `Xₙ` a sequence of nonnegative integrable identically distributed pairwise independent
+random variables. Let `Yₙ` be the truncation of `Xₙ` up to `n`. We claim that
+* Almost surely, `Xₙ = Yₙ` for all but finitely many indices. Indeed, `∑ ℙ (Xₙ ≠ Yₙ)` is bounded by
+  `1 + 𝔼[X]` (see `sum_prob_mem_Ioc_le` and `tsum_prob_mem_Ioi_lt_top`).
+* Let `c > 1`. Along the sequence `n = c ^ k`, then `(∑_{i=0}^{n-1} Yᵢ - 𝔼[Yᵢ])/n` converges almost
+  surely to `0`. This follows from a variance control, as
+```
+  ∑_k ℙ (|∑_{i=0}^{c^k - 1} Yᵢ - 𝔼[Yᵢ]| > c^k ε)
+    ≤ ∑_k (c^k ε)^{-2} ∑_{i=0}^{c^k - 1} Var[Yᵢ]    (by Markov inequality)
+    ≤ ∑_i (C/i^2) Var[Yᵢ]                           (as ∑_{c^k > i} 1/(c^k)^2 ≤ C/i^2)
+    ≤ ∑_i (C/i^2) 𝔼[Yᵢ^2]
+    ≤ 2C 𝔼[X^2]                                     (see `sum_variance_truncation_le`)
+```
+* As `𝔼[Yᵢ]` converges to `𝔼[X]`, it follows from the two previous items and Cesaro that, along
+  the sequence `n = c^k`, one has `(∑_{i=0}^{n-1} Xᵢ) / n → 𝔼[X]` almost surely.
+* To generalize it to all indices, we use the fact that `∑_{i=0}^{n-1} Xᵢ` is nondecreasing and
+  that, if `c` is close enough to `1`, the gap between `c^k` and `c^(k+1)` is small.
+-/
+
+noncomputable theory
+
+open measure_theory filter finset asymptotics
+open set (indicator)
+
+open_locale topology big_operators measure_theory probability_theory ennreal nnreal
+
+namespace probability_theory
+
+/-! ### Prerequisites on truncations -/
+
+section truncation
+
+variables {α : Type*}
+
+/-- Truncating a real-valued function to the interval `(-A, A]`. -/
+def truncation (f : α → ℝ) (A : ℝ) :=
+(indicator (set.Ioc (-A) A) id) ∘ f
+
+variables {m : measurable_space α} {μ : measure α} {f : α → ℝ}
+
+lemma _root_.measure_theory.ae_strongly_measurable.truncation
+  (hf : ae_strongly_measurable f μ) {A : ℝ} :
+  ae_strongly_measurable (truncation f A) μ :=
+begin
+  apply ae_strongly_measurable.comp_ae_measurable _ hf.ae_measurable,
+  exact (strongly_measurable_id.indicator measurable_set_Ioc).ae_strongly_measurable,
+end
+
+lemma abs_truncation_le_bound (f : α → ℝ) (A : ℝ) (x : α) :
+  |truncation f A x| ≤ |A| :=
+begin
+  simp only [truncation, set.indicator, set.mem_Icc, id.def, function.comp_app],
+  split_ifs,
+  { exact abs_le_abs h.2 (neg_le.2 h.1.le) },
+  { simp [abs_nonneg] }
+end
+
+@[simp] lemma truncation_zero (f : α → ℝ) :
+  truncation f 0 = 0 :=
+by simp [truncation]
+
+lemma abs_truncation_le_abs_self (f : α → ℝ) (A : ℝ) (x : α) :
+  |truncation f A x| ≤ |f x| :=
+begin
+  simp only [truncation, indicator, set.mem_Icc, id.def, function.comp_app],
+  split_ifs,
+  { exact le_rfl },
+  { simp [abs_nonneg] },
+end
+
+lemma truncation_eq_self {f : α → ℝ} {A : ℝ} {x : α} (h : |f x| < A) :
+  truncation f A x = f x :=
+begin
+  simp only [truncation, indicator, set.mem_Icc, id.def, function.comp_app, ite_eq_left_iff],
+  assume H,
+  apply H.elim,
+  simp [(abs_lt.1 h).1, (abs_lt.1 h).2.le],
+end
+
+lemma truncation_eq_of_nonneg {f : α → ℝ} {A : ℝ} (h : ∀ x, 0 ≤ f x) :
+  truncation f A = (indicator (set.Ioc 0 A) id) ∘ f :=
+begin
+  ext x,
+  rcases (h x).lt_or_eq with hx|hx,
+  { simp only [truncation, indicator, hx, set.mem_Ioc, id.def, function.comp_app, true_and],
+    by_cases h'x : f x ≤ A,
+    { have : - A < f x, by linarith [h x],
+      simp only [this, true_and] },
+    { simp only [h'x, and_false] } },
+  { simp only [truncation, indicator, hx, id.def, function.comp_app, if_t_t]},
+end
+
+lemma truncation_nonneg {f : α → ℝ} (A : ℝ) {x : α} (h : 0 ≤ f x) : 0 ≤ truncation f A x :=
+set.indicator_apply_nonneg $ λ _, h
+
+lemma _root_.measure_theory.ae_strongly_measurable.mem_ℒp_truncation [is_finite_measure μ]
+  (hf : ae_strongly_measurable f μ) {A : ℝ} {p : ℝ≥0∞} :
+  mem_ℒp (truncation f A) p μ :=
+mem_ℒp.of_bound hf.truncation (|A|) (eventually_of_forall (λ x, abs_truncation_le_bound _ _ _))
+
+lemma _root_.measure_theory.ae_strongly_measurable.integrable_truncation [is_finite_measure μ]
+  (hf : ae_strongly_measurable f μ) {A : ℝ} :
+  integrable (truncation f A) μ :=
+by { rw ← mem_ℒp_one_iff_integrable, exact hf.mem_ℒp_truncation }
+
+lemma moment_truncation_eq_interval_integral (hf : ae_strongly_measurable f μ) {A : ℝ}
+  (hA : 0 ≤ A) {n : ℕ} (hn : n ≠ 0) :
+  ∫ x, (truncation f A x) ^ n ∂μ = ∫ y in (-A)..A, y ^ n ∂(measure.map f μ) :=
+begin
+  have M : measurable_set (set.Ioc (-A) A) := measurable_set_Ioc,
+  change ∫ x, (λ z, (indicator (set.Ioc (-A) A) id z) ^ n) (f x) ∂μ = _,
+  rw [← integral_map hf.ae_measurable, interval_integral.integral_of_le, ← integral_indicator M],
+  { simp only [indicator, zero_pow' _ hn, id.def, ite_pow] },
+  { linarith },
+  { exact ((measurable_id.indicator M).pow_const n).ae_strongly_measurable }
+end
+
+lemma moment_truncation_eq_interval_integral_of_nonneg (hf : ae_strongly_measurable f μ) {A : ℝ}
+  {n : ℕ} (hn : n ≠ 0) (h'f : 0 ≤ f) :
+  ∫ x, (truncation f A x) ^ n ∂μ = ∫ y in 0..A, y ^ n ∂(measure.map f μ) :=
+begin
+  have M : measurable_set (set.Ioc 0 A) := measurable_set_Ioc,
+  have M' : measurable_set (set.Ioc A 0) := measurable_set_Ioc,
+  rw truncation_eq_of_nonneg h'f,
+  change ∫ x, (λ z, (indicator (set.Ioc 0 A) id z) ^ n) (f x) ∂μ = _,
+  rcases le_or_lt 0 A with hA | hA,
+  { rw [← integral_map hf.ae_measurable, interval_integral.integral_of_le hA,
+        ← integral_indicator M],
+    { simp only [indicator, zero_pow' _ hn, id.def, ite_pow] },
+    { exact ((measurable_id.indicator M).pow_const n).ae_strongly_measurable } },
+  { rw [← integral_map hf.ae_measurable, interval_integral.integral_of_ge hA.le,
+        ← integral_indicator M'],
+    { simp only [set.Ioc_eq_empty_of_le hA.le, zero_pow' _ hn, set.indicator_empty, integral_zero,
+        zero_eq_neg],
+      apply integral_eq_zero_of_ae,
+      have : ∀ᵐ x ∂(measure.map f μ), (0 : ℝ) ≤ x :=
+        (ae_map_iff hf.ae_measurable measurable_set_Ici).2 (eventually_of_forall h'f),
+      filter_upwards [this] with x hx,
+      simp only [indicator, set.mem_Ioc, pi.zero_apply, ite_eq_right_iff, and_imp],
+      assume h'x h''x,
+      have : x = 0, by linarith,
+      simp [this, zero_pow' _ hn] },
+    { exact ((measurable_id.indicator M).pow_const n).ae_strongly_measurable } }
+end
+
+lemma integral_truncation_eq_interval_integral (hf : ae_strongly_measurable f μ) {A : ℝ}
+  (hA : 0 ≤ A) :
+  ∫ x, truncation f A x ∂μ = ∫ y in (-A)..A, y ∂(measure.map f μ) :=
+by simpa using moment_truncation_eq_interval_integral hf hA one_ne_zero
+
+lemma integral_truncation_eq_interval_integral_of_nonneg (hf : ae_strongly_measurable f μ) {A : ℝ}
+  (h'f : 0 ≤ f) :
+  ∫ x, truncation f A x ∂μ = ∫ y in 0..A, y ∂(measure.map f μ) :=
+by simpa using moment_truncation_eq_interval_integral_of_nonneg hf one_ne_zero h'f
+
+lemma integral_truncation_le_integral_of_nonneg
+  (hf : integrable f μ) (h'f : 0 ≤ f) {A : ℝ} :
+  ∫ x, truncation f A x ∂μ ≤ ∫ x, f x ∂μ :=
+begin
+  apply integral_mono_of_nonneg (eventually_of_forall (λ x, _)) hf (eventually_of_forall (λ x, _)),
+  { exact truncation_nonneg _ (h'f x) },
+  { calc truncation f A x ≤ |truncation f A x| : le_abs_self _
+                      ... ≤ |f x|              : abs_truncation_le_abs_self _ _ _
+                      ... = f x                : abs_of_nonneg (h'f x) }
+end
+
+/-- If a function is integrable, then the integral of its truncated versions converges to the
+integral of the whole function. -/
+lemma tendsto_integral_truncation {f : α → ℝ} (hf : integrable f μ) :
+  tendsto (λ A, ∫ x, truncation f A x ∂μ) at_top (𝓝 (∫ x, f x ∂μ)) :=
+begin
+  refine tendsto_integral_filter_of_dominated_convergence (λ x, abs (f x)) _ _ _ _,
+  { exact eventually_of_forall (λ A, hf.ae_strongly_measurable.truncation) },
+  { apply eventually_of_forall (λ A, _),
+    apply eventually_of_forall (λ x, _),
+    rw real.norm_eq_abs,
+    exact abs_truncation_le_abs_self _ _ _ },
+  { apply hf.abs },
+  { apply eventually_of_forall (λ x, _),
+    apply tendsto_const_nhds.congr' _,
+    filter_upwards [Ioi_mem_at_top (abs (f x))] with A hA,
+    exact (truncation_eq_self hA).symm },
+end
+
+lemma ident_distrib.truncation {β : Type*} [measurable_space β] {ν : measure β}
+  {f : α → ℝ} {g : β → ℝ} (h : ident_distrib f g μ ν) {A : ℝ} :
+  ident_distrib (truncation f A) (truncation g A) μ ν :=
+h.comp (measurable_id.indicator measurable_set_Ioc)
+
+end truncation
+
+section strong_law_ae
+
+variables {Ω : Type*} [measure_space Ω] [is_probability_measure (ℙ : measure Ω)]
+
+section moment_estimates
+
+lemma sum_prob_mem_Ioc_le
+  {X : Ω → ℝ} (hint : integrable X) (hnonneg : 0 ≤ X) {K : ℕ} {N : ℕ} (hKN : K ≤ N) :
+  ∑ j in range K, ℙ {ω | X ω ∈ set.Ioc (j : ℝ) N} ≤ ennreal.of_real (𝔼[X] + 1) :=
+begin
+  let ρ : measure ℝ := measure.map X ℙ,
+  haveI : is_probability_measure ρ := is_probability_measure_map hint.ae_measurable,
+  have A : ∑ j in range K, ∫ x in j..N, (1 : ℝ) ∂ρ ≤ 𝔼[X] + 1, from calc
+  ∑ j in range K, ∫ x in j..N, (1 : ℝ) ∂ρ
+      = ∑ j in range K, ∑ i in Ico j N, ∫ x in i..(i+1 : ℕ), (1 : ℝ) ∂ρ :
+    begin
+      apply sum_congr rfl (λ j hj, _),
+      rw interval_integral.sum_integral_adjacent_intervals_Ico ((mem_range.1 hj).le.trans hKN),
+      assume k hk,
+      exact continuous_const.interval_integrable _ _,
+    end
+  ... = ∑ i in range N, ∑ j in range (min (i+1) K), ∫ x in i..(i+1 : ℕ), (1 : ℝ) ∂ρ :
+    begin
+      simp_rw [sum_sigma'],
+      refine sum_bij' (λ (p : (Σ (i : ℕ), ℕ)) hp, (⟨p.2, p.1⟩ : (Σ (i : ℕ), ℕ))) _ (λ a ha, rfl)
+        (λ (p : (Σ (i : ℕ), ℕ)) hp, (⟨p.2, p.1⟩ : (Σ (i : ℕ), ℕ))) _ _ _,
+      { rintros ⟨i, j⟩ hij,
+        simp only [mem_sigma, mem_range, mem_Ico] at hij,
+        simp only [hij, nat.lt_succ_iff.2 hij.2.1, mem_sigma, mem_range, lt_min_iff, and_self] },
+      { rintros ⟨i, j⟩ hij,
+        simp only [mem_sigma, mem_range, lt_min_iff] at hij,
+        simp only [hij, nat.lt_succ_iff.1 hij.2.1, mem_sigma, mem_range, mem_Ico, and_self] },
+      { rintros ⟨i, j⟩ hij, refl },
+      { rintros ⟨i, j⟩ hij, refl },
+    end
+  ... ≤ ∑ i in range N, (i + 1) * ∫ x in i..(i+1 : ℕ), (1 : ℝ) ∂ρ :
+    begin
+      apply sum_le_sum (λ i hi, _),
+      simp only [nat.cast_add, nat.cast_one, sum_const, card_range, nsmul_eq_mul, nat.cast_min],
+      refine mul_le_mul_of_nonneg_right (min_le_left _ _) _,
+      apply interval_integral.integral_nonneg,
+      { simp only [le_add_iff_nonneg_right, zero_le_one] },
+      { simp only [zero_le_one, implies_true_iff], }
+    end
+  ... ≤ ∑ i in range N, ∫ x in i..(i+1 : ℕ), (x + 1) ∂ρ :
+    begin
+      apply sum_le_sum (λ i hi, _),
+      have I : (i : ℝ) ≤ (i + 1 : ℕ),
+        by simp only [nat.cast_add, nat.cast_one, le_add_iff_nonneg_right, zero_le_one],
+      simp_rw [interval_integral.integral_of_le I, ← integral_mul_left],
+      apply set_integral_mono_on,
+      { exact continuous_const.integrable_on_Ioc },
+      { exact (continuous_id.add continuous_const).integrable_on_Ioc },
+      { exact measurable_set_Ioc },
+      { assume x hx,
+        simp only [nat.cast_add, nat.cast_one, set.mem_Ioc] at hx,
+        simp [hx.1.le] }
+    end
+  ... = ∫ x in 0..N, x + 1 ∂ρ :
+    begin
+      rw interval_integral.sum_integral_adjacent_intervals (λ k hk, _),
+      { norm_cast },
+      { exact (continuous_id.add continuous_const).interval_integrable _ _ }
+    end
+  ... = ∫ x in 0..N, x ∂ρ + ∫ x in 0..N, 1 ∂ρ :
+    begin
+      rw interval_integral.integral_add,
+      { exact continuous_id.interval_integrable _ _ },
+      { exact continuous_const.interval_integrable _ _ },
+    end
+  ... = 𝔼[truncation X N] + ∫ x in 0..N, 1 ∂ρ :
+    by rw integral_truncation_eq_interval_integral_of_nonneg hint.1 hnonneg
+  ... ≤ 𝔼[X] + ∫ x in 0..N, 1 ∂ρ :
+    add_le_add_right (integral_truncation_le_integral_of_nonneg hint hnonneg) _
+  ... ≤ 𝔼[X] + 1 :
+    begin
+      refine add_le_add le_rfl _,
+      rw interval_integral.integral_of_le (nat.cast_nonneg _),
+      simp only [integral_const, measure.restrict_apply', measurable_set_Ioc, set.univ_inter,
+        algebra.id.smul_eq_mul, mul_one],
+      rw ← ennreal.one_to_real,
+      exact ennreal.to_real_mono ennreal.one_ne_top prob_le_one,
+    end,
+  have B : ∀ a b, ℙ {ω | X ω ∈ set.Ioc a b} = ennreal.of_real (∫ x in set.Ioc a b, (1 : ℝ) ∂ρ),
+  { assume a b,
+    rw [of_real_set_integral_one ρ _,
+        measure.map_apply_of_ae_measurable hint.ae_measurable measurable_set_Ioc],
+    refl },
+  calc ∑ j in range K, ℙ {ω | X ω ∈ set.Ioc (j : ℝ) N}
+      = ∑ j in range K, ennreal.of_real (∫ x in set.Ioc (j : ℝ) N, (1 : ℝ) ∂ρ) :
+    by simp_rw B
+  ... = ennreal.of_real (∑ j in range K, ∫ x in set.Ioc (j : ℝ) N, (1 : ℝ) ∂ρ) :
+    begin
+      rw ennreal.of_real_sum_of_nonneg,
+      simp only [integral_const, algebra.id.smul_eq_mul, mul_one, ennreal.to_real_nonneg,
+        implies_true_iff],
+    end
+  ... = ennreal.of_real (∑ j in range K, ∫ x in (j : ℝ)..N, (1 : ℝ) ∂ρ) :
+    begin
+      congr' 1,
+      refine sum_congr rfl (λ j hj, _),
+      rw interval_integral.integral_of_le (nat.cast_le.2 ((mem_range.1 hj).le.trans hKN)),
+    end
+  ... ≤ ennreal.of_real (𝔼[X] + 1) : ennreal.of_real_le_of_real A
+end
+
+lemma tsum_prob_mem_Ioi_lt_top
+  {X : Ω → ℝ} (hint : integrable X) (hnonneg : 0 ≤ X) :
+  ∑' (j : ℕ), ℙ {ω | X ω ∈ set.Ioi (j : ℝ)} < ∞ :=
+begin
+  suffices : ∀ (K : ℕ), ∑ j in range K, ℙ {ω | X ω ∈ set.Ioi (j : ℝ)} ≤ ennreal.of_real (𝔼[X] + 1),
+    from (le_of_tendsto_of_tendsto (ennreal.tendsto_nat_tsum _) tendsto_const_nhds
+      (eventually_of_forall this)).trans_lt ennreal.of_real_lt_top,
+  assume K,
+  have A : tendsto (λ (N : ℕ), ∑ j in range K, ℙ {ω | X ω ∈ set.Ioc (j : ℝ) N})
+    at_top (𝓝 (∑ j in range K, ℙ {ω | X ω ∈ set.Ioi (j : ℝ)})),
+  { refine tendsto_finset_sum _ (λ i hi, _),
+    have : {ω | X ω ∈ set.Ioi (i : ℝ)} = ⋃ (N : ℕ), {ω | X ω ∈ set.Ioc (i : ℝ) N},
+    { apply set.subset.antisymm _ _,
+      { assume ω hω,
+        obtain ⟨N, hN⟩ : ∃ (N : ℕ), X ω ≤ N := exists_nat_ge (X ω),
+        exact set.mem_Union.2 ⟨N, hω, hN⟩ },
+      { simp only [set.mem_Ioc, set.mem_Ioi, set.Union_subset_iff, set.set_of_subset_set_of,
+          implies_true_iff] {contextual := tt} } },
+    rw this,
+    apply tendsto_measure_Union,
+    assume m n hmn x hx,
+    exact ⟨hx.1, hx.2.trans (nat.cast_le.2 hmn)⟩ },
+  apply le_of_tendsto_of_tendsto A tendsto_const_nhds,
+  filter_upwards [Ici_mem_at_top K] with N hN,
+  exact sum_prob_mem_Ioc_le hint hnonneg hN
+end
+
+lemma sum_variance_truncation_le
+  {X : Ω → ℝ} (hint : integrable X) (hnonneg : 0 ≤ X) (K : ℕ) :
+  ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * 𝔼[(truncation X j) ^ 2] ≤ 2 * 𝔼[X] :=
+begin
+  set Y := λ (n : ℕ), truncation X n,
+  let ρ : measure ℝ := measure.map X ℙ,
+  have Y2 : ∀ n, 𝔼[Y n ^ 2] = ∫ x in 0..n, x ^ 2 ∂ρ,
+  { assume n,
+    change 𝔼[λ x, (Y n x)^2] = _,
+    rw [moment_truncation_eq_interval_integral_of_nonneg hint.1 two_ne_zero hnonneg] },
+  calc ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * 𝔼[Y j ^ 2]
+      = ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * ∫ x in 0..j, x ^ 2 ∂ρ :
+    by simp_rw [Y2]
+  ... = ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * ∑ k in range j, ∫ x in k..(k+1 : ℕ), x ^ 2 ∂ρ :
+    begin
+      congr' 1 with j,
+      congr' 1,
+      rw interval_integral.sum_integral_adjacent_intervals,
+      { norm_cast },
+      assume k hk,
+      exact (continuous_id.pow _).interval_integrable _ _,
+    end
+  ... = ∑ k in range K, (∑ j in Ioo k K, ((j : ℝ) ^ 2) ⁻¹) * ∫ x in k..(k+1 : ℕ), x ^ 2 ∂ρ :
+    begin
+      simp_rw [mul_sum, sum_mul, sum_sigma'],
+      refine sum_bij' (λ (p : (Σ (i : ℕ), ℕ)) hp, (⟨p.2, p.1⟩ : (Σ (i : ℕ), ℕ))) _ (λ a ha, rfl)
+        (λ (p : (Σ (i : ℕ), ℕ)) hp, (⟨p.2, p.1⟩ : (Σ (i : ℕ), ℕ))) _ _ _,
+      { rintros ⟨i, j⟩ hij,
+        simp only [mem_sigma, mem_range, mem_filter] at hij,
+        simp [hij, mem_sigma, mem_range, and_self, hij.2.trans hij.1], },
+      { rintros ⟨i, j⟩ hij,
+        simp only [mem_sigma, mem_range, mem_Ioo] at hij,
+        simp only [hij, mem_sigma, mem_range, and_self], },
+      { rintros ⟨i, j⟩ hij, refl },
+      { rintros ⟨i, j⟩ hij, refl },
+    end
+  ... ≤ ∑ k in range K, (2/ (k+1)) * ∫ x in k..(k+1 : ℕ), x ^ 2 ∂ρ :
+    begin
+      apply sum_le_sum (λ k hk, _),
+      refine mul_le_mul_of_nonneg_right (sum_Ioo_inv_sq_le _ _) _,
+      refine interval_integral.integral_nonneg_of_forall _ (λ u, sq_nonneg _),
+      simp only [nat.cast_add, nat.cast_one, le_add_iff_nonneg_right, zero_le_one],
+    end
+  ... ≤ ∑ k in range K, ∫ x in k..(k+1 : ℕ), 2 * x ∂ρ :
+    begin
+      apply sum_le_sum (λ k hk, _),
+      have Ik : (k : ℝ) ≤ (k + 1 : ℕ), by simp,
+      rw [← interval_integral.integral_const_mul, interval_integral.integral_of_le Ik,
+        interval_integral.integral_of_le Ik],
+      refine set_integral_mono_on _ _ measurable_set_Ioc (λ x hx, _),
+      { apply continuous.integrable_on_Ioc,
+        exact continuous_const.mul (continuous_pow 2) },
+      { apply continuous.integrable_on_Ioc,
+        exact continuous_const.mul continuous_id' },
+      { calc 2 / (↑k + 1) * x ^ 2 = (x / (k+1)) * (2 * x) : by ring_exp
+        ... ≤ 1 * (2 * x) :
+          mul_le_mul_of_nonneg_right begin
+            apply_mod_cast (div_le_one _).2 hx.2,
+            simp only [nat.cast_add, nat.cast_one],
+            linarith only [show (0 : ℝ) ≤ k, from  nat.cast_nonneg k],
+          end (mul_nonneg zero_le_two ((nat.cast_nonneg k).trans hx.1.le))
+        ... = 2 * x : by rw one_mul }
+    end
+  ... = 2 * ∫ x in (0 : ℝ)..K, x ∂ρ :
+    begin
+      rw interval_integral.sum_integral_adjacent_intervals (λ k hk, _),
+      swap, { exact (continuous_const.mul continuous_id').interval_integrable _ _ },
+      rw interval_integral.integral_const_mul,
+      norm_cast
+    end
+  ... ≤ 2 * 𝔼[X] :
+    mul_le_mul_of_nonneg_left begin
+      rw ← integral_truncation_eq_interval_integral_of_nonneg hint.1 hnonneg,
+      exact integral_truncation_le_integral_of_nonneg hint hnonneg,
+    end zero_le_two
+end
+
+end moment_estimates
+
+section strong_law_nonneg
+
+/- This paragraph proves the strong law of large numbers (almost sure version, assuming only
+pairwise independence) for nonnegative random variables, following Etemadi's proof. -/
+
+variables (X : ℕ → Ω → ℝ) (hint : integrable (X 0))
+  (hindep : pairwise (λ i j, indep_fun (X i) (X j)))
+  (hident : ∀ i, ident_distrib (X i) (X 0))
+  (hnonneg : ∀ i ω, 0 ≤ X i ω)
+
+include X hint hindep hident hnonneg
+
+/- The truncation of `Xᵢ` up to `i` satisfies the strong law of large numbers (with respect to
+the truncated expectation) along the sequence `c^n`, for any `c > 1`, up to a given `ε > 0`.
+This follows from a variance control. -/
+lemma strong_law_aux1 {c : ℝ} (c_one : 1 < c) {ε : ℝ} (εpos : 0 < ε) :
+  ∀ᵐ ω, ∀ᶠ (n : ℕ) in at_top,
+    |∑ i in range ⌊c^n⌋₊, truncation (X i) i ω - 𝔼[∑ i in range ⌊c^n⌋₊, truncation (X i) i]|
+      < ε * ⌊c^n⌋₊ :=
+begin
+  /- Let `S n = ∑ i in range n, Y i` where `Y i = truncation (X i) i`. We should show that
+  `|S k - 𝔼[S k]| / k ≤ ε` along the sequence of powers of `c`. For this, we apply Borel-Cantelli:
+  it suffices to show that the converse probabilites are summable. From Chebyshev inequality, this
+  will follow from a variance control `∑' Var[S (c^i)] / (c^i)^2 < ∞`. This is checked in `I2` using
+  pairwise independence to expand the variance of the sum as the sum of the variances, and then
+  a straightforward but tedious computation (essentially boiling down to the fact that the sum of
+  `1/(c ^ i)^2` beyong a threshold `j` is comparable to `1/j^2`).
+  Note that we have written `c^i` in the above proof sketch, but rigorously one should put integer
+  parts everywhere, making things more painful. We write `u i = ⌊c^i⌋₊` for brevity. -/
+  have c_pos : 0 < c := zero_lt_one.trans c_one,
+  let ρ : measure ℝ := measure.map (X 0) ℙ,
+  have hX : ∀ i, ae_strongly_measurable (X i) ℙ :=
+    λ i, (hident i).symm.ae_strongly_measurable_snd hint.1,
+  have A : ∀ i, strongly_measurable (indicator (set.Ioc (-i : ℝ) i) id) :=
+    λ i, strongly_measurable_id.indicator measurable_set_Ioc,
+  set Y := λ (n : ℕ), truncation (X n) n with hY,
+  set S := λ n, ∑ i in range n, Y i with hS,
+  let u : ℕ → ℕ := λ n, ⌊c ^ n⌋₊,
+  have u_mono : monotone u := λ i j hij, nat.floor_mono (pow_le_pow c_one.le hij),
+  have I1 : ∀ K, ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * Var[Y j] ≤ 2 * 𝔼[X 0],
+  { assume K,
+    calc ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * Var[Y j] ≤
+      ∑ j in range K, ((j : ℝ) ^ 2) ⁻¹ * 𝔼[(truncation (X 0) j)^2] :
+      begin
+        apply sum_le_sum (λ j hj, _),
+        refine mul_le_mul_of_nonneg_left _ (inv_nonneg.2 (sq_nonneg _)),
+        rw (hident j).truncation.variance_eq,
+        exact variance_le_expectation_sq (hX 0).truncation,
+      end
+      ... ≤ 2 * 𝔼[X 0] : sum_variance_truncation_le hint (hnonneg 0) K },
+  let C := (c ^ 5 * (c - 1) ⁻¹ ^ 3) * (2 * 𝔼[X 0]),
+  have I2 : ∀ N, ∑ i in range N, ((u i : ℝ) ^ 2) ⁻¹ * Var[S (u i)] ≤ C,
+  { assume N,
+    calc
+    ∑ i in range N, ((u i : ℝ) ^ 2) ⁻¹ * Var[S (u i)]
+        = ∑ i in range N, ((u i : ℝ) ^ 2) ⁻¹ * (∑ j in range (u i), Var[Y j]) :
+      begin
+        congr' 1 with i,
+        congr' 1,
+        rw [hS, indep_fun.variance_sum],
+        { assume j hj,
+          exact (hident j).ae_strongly_measurable_fst.mem_ℒp_truncation },
+        { assume k hk l hl hkl,
+          exact (hindep hkl).comp (A k).measurable (A l).measurable }
+      end
+    ... = ∑ j in range (u (N - 1)),
+            (∑ i in (range N).filter (λ i, j < u i), ((u i : ℝ) ^ 2) ⁻¹) * Var[Y j] :
+      begin
+        simp_rw [mul_sum, sum_mul, sum_sigma'],
+        refine sum_bij' (λ (p : (Σ (i : ℕ), ℕ)) hp, (⟨p.2, p.1⟩ : (Σ (i : ℕ), ℕ))) _ (λ a ha, rfl)
+          (λ (p : (Σ (i : ℕ), ℕ)) hp, (⟨p.2, p.1⟩ : (Σ (i : ℕ), ℕ))) _ _ _,
+        { rintros ⟨i, j⟩ hij,
+          simp only [mem_sigma, mem_range] at hij,
+          simp only [hij.1, hij.2, mem_sigma, mem_range, mem_filter, and_true],
+          exact hij.2.trans_le (u_mono (nat.le_pred_of_lt hij.1)) },
+        { rintros ⟨i, j⟩ hij,
+          simp only [mem_sigma, mem_range, mem_filter] at hij,
+          simp only [hij.2.1, hij.2.2, mem_sigma, mem_range, and_self] },
+        { rintros ⟨i, j⟩ hij, refl },
+        { rintros ⟨i, j⟩ hij, refl },
+      end
+    ... ≤ ∑ j in range (u (N - 1)), (c ^ 5 * (c - 1) ⁻¹ ^ 3 / j ^ 2) * Var[Y j] :
+      begin
+        apply sum_le_sum (λ j hj, _),
+        rcases @eq_zero_or_pos _ _ j with rfl|hj,
+        { simp only [Y, nat.cast_zero, zero_pow', ne.def, bit0_eq_zero, nat.one_ne_zero,
+            not_false_iff, div_zero, zero_mul],
+          simp only [nat.cast_zero, truncation_zero, variance_zero, mul_zero] },
+        apply mul_le_mul_of_nonneg_right _ (variance_nonneg _ _),
+        convert sum_div_nat_floor_pow_sq_le_div_sq N (nat.cast_pos.2 hj) c_one,
+        { simp only [nat.cast_lt] },
+        { simp only [one_div] }
+      end
+    ... = (c ^ 5 * (c - 1) ⁻¹ ^ 3) * ∑ j in range (u (N - 1)), ((j : ℝ) ^ 2) ⁻¹ * Var[Y j] :
+      by { simp_rw [mul_sum, div_eq_mul_inv], ring_nf }
+    ... ≤ (c ^ 5 * (c - 1) ⁻¹ ^ 3) * (2 * 𝔼[X 0]) :
+      begin
+        apply mul_le_mul_of_nonneg_left (I1 _),
+        apply mul_nonneg (pow_nonneg c_pos.le _),
+        exact pow_nonneg (inv_nonneg.2 (sub_nonneg.2 c_one.le)) _
+      end },
+  have I3 : ∀ N, ∑ i in range N,
+    ℙ {ω | (u i * ε : ℝ) ≤ |S (u i) ω - 𝔼[S (u i)]|} ≤ ennreal.of_real (ε ⁻¹ ^ 2 * C),
+  { assume N,
+    calc ∑ i in range N, ℙ {ω | (u i * ε : ℝ) ≤ |S (u i) ω - 𝔼[S (u i)]|}
+        ≤ ∑ i in range N, ennreal.of_real (Var[S (u i)] / (u i * ε) ^ 2) :
+      begin
+        refine sum_le_sum (λ i hi, _),
+        apply meas_ge_le_variance_div_sq,
+        { exact mem_ℒp_finset_sum' _
+            (λ j hj, (hident j).ae_strongly_measurable_fst.mem_ℒp_truncation) },
+        { apply mul_pos (nat.cast_pos.2 _) εpos,
+          refine zero_lt_one.trans_le _,
+          apply nat.le_floor,
+          rw nat.cast_one,
+          apply one_le_pow_of_one_le c_one.le }
+      end
+    ... = ennreal.of_real (∑ i in range N, Var[S (u i)] / (u i * ε) ^ 2) :
+      begin
+        rw ennreal.of_real_sum_of_nonneg (λ i hi, _),
+        exact div_nonneg (variance_nonneg _ _) (sq_nonneg _),
+      end
+    ... ≤ ennreal.of_real (ε ⁻¹ ^ 2 * C) :
+      begin
+        apply ennreal.of_real_le_of_real,
+        simp_rw [div_eq_inv_mul, ← inv_pow, mul_inv, mul_comm _ (ε⁻¹), mul_pow, mul_assoc,
+          ← mul_sum],
+        refine mul_le_mul_of_nonneg_left _ (sq_nonneg _),
+        simp_rw [inv_pow],
+        exact I2 N
+      end },
+  have I4 : ∑' i, ℙ {ω | (u i * ε : ℝ) ≤ |S (u i) ω - 𝔼[S (u i)]|} < ∞ :=
+    (le_of_tendsto_of_tendsto' (ennreal.tendsto_nat_tsum _) tendsto_const_nhds I3).trans_lt
+      ennreal.of_real_lt_top,
+  filter_upwards [ae_eventually_not_mem I4.ne] with ω hω,
+  simp_rw [not_le, mul_comm, S, sum_apply] at hω,
+  exact hω,
+end
+
+/- The truncation of `Xᵢ` up to `i` satisfies the strong law of large numbers
+(with respect to the truncated expectation) along the sequence
+`c^n`, for any `c > 1`. This follows from `strong_law_aux1` by varying `ε`. -/
+lemma strong_law_aux2 {c : ℝ} (c_one : 1 < c) :
+  ∀ᵐ ω, (λ (n : ℕ), ∑ i in range ⌊c^n⌋₊, truncation (X i) i ω
+    - 𝔼[∑ i in range ⌊c^n⌋₊, truncation (X i) i]) =o[at_top] (λ (n : ℕ), (⌊c^n⌋₊ : ℝ)) :=
+begin
+  obtain ⟨v, -, v_pos, v_lim⟩ :
+    ∃ (v : ℕ → ℝ), strict_anti v ∧ (∀ (n : ℕ), 0 < v n) ∧ tendsto v at_top (𝓝 0) :=
+      exists_seq_strict_anti_tendsto (0 : ℝ),
+  have := λ i, strong_law_aux1 X hint hindep hident hnonneg c_one (v_pos i),
+  filter_upwards [ae_all_iff.2 this] with ω hω,
+  apply asymptotics.is_o_iff.2 (λ ε εpos, _),
+  obtain ⟨i, hi⟩ : ∃ i, v i < ε := ((tendsto_order.1 v_lim).2 ε εpos).exists,
+  filter_upwards [hω i] with n hn,
+  simp only [real.norm_eq_abs, lattice_ordered_comm_group.abs_abs, nat.abs_cast],
+  exact hn.le.trans (mul_le_mul_of_nonneg_right hi.le (nat.cast_nonneg _)),
+end
+
+omit hindep hnonneg
+/-- The expectation of the truncated version of `Xᵢ` behaves asymptotically like the whole
+expectation. This follows from convergence and Cesaro averaging. -/
+lemma strong_law_aux3 :
+  (λ n, 𝔼[∑ i in range n, truncation (X i) i] - n * 𝔼[X 0]) =o[at_top] (coe : ℕ → ℝ) :=
+begin
+  have A : tendsto (λ i, 𝔼[truncation (X i) i]) at_top (𝓝 (𝔼[X 0])),
+  { convert (tendsto_integral_truncation hint).comp tendsto_coe_nat_at_top_at_top,
+    ext i,
+    exact (hident i).truncation.integral_eq },
+  convert asymptotics.is_o_sum_range_of_tendsto_zero (tendsto_sub_nhds_zero_iff.2 A),
+  ext1 n,
+  simp only [sum_sub_distrib, sum_const, card_range, nsmul_eq_mul, sum_apply, sub_left_inj],
+  rw integral_finset_sum _ (λ i hi, _),
+  exact ((hident i).symm.integrable_snd hint).1.integrable_truncation,
+end
+include hindep hnonneg
+
+/- The truncation of `Xᵢ` up to `i` satisfies the strong law of large numbers
+(with respect to the original expectation) along the sequence
+`c^n`, for any `c > 1`. This follows from the version from the truncated expectation, and the
+fact that the truncated and the original expectations have the same asymptotic behavior. -/
+lemma strong_law_aux4 {c : ℝ} (c_one : 1 < c) :
+  ∀ᵐ ω, (λ (n : ℕ), ∑ i in range ⌊c^n⌋₊, truncation (X i) i ω - ⌊c^n⌋₊ * 𝔼[X 0]) =o[at_top]
+    (λ (n : ℕ), (⌊c^n⌋₊ : ℝ)) :=
+begin
+  filter_upwards [strong_law_aux2 X hint hindep hident hnonneg c_one] with ω hω,
+  have A : tendsto (λ (n : ℕ), ⌊c ^ n⌋₊) at_top at_top :=
+    tendsto_nat_floor_at_top.comp (tendsto_pow_at_top_at_top_of_one_lt c_one),
+  convert hω.add ((strong_law_aux3 X hint hident).comp_tendsto A),
+  ext1 n,
+  simp,
+end
+
+omit hindep
+/-- The truncated and non-truncated versions of `Xᵢ` have the same asymptotic behavior, as they
+almost surely coincide at all but finitely many steps. This follows from a probability computation
+and Borel-Cantelli. -/
+lemma strong_law_aux5 :
+  ∀ᵐ ω, (λ (n : ℕ), ∑ i in range n, truncation (X i) i ω - ∑ i in range n, X i ω) =o[at_top]
+    (λ (n : ℕ), (n : ℝ)) :=
+begin
+  have A : ∑' (j : ℕ), ℙ {ω | X j ω ∈ set.Ioi (j : ℝ)} < ∞,
+  { convert tsum_prob_mem_Ioi_lt_top hint (hnonneg 0),
+    ext1 j,
+    exact (hident j).measure_mem_eq measurable_set_Ioi },
+  have B : ∀ᵐ ω, tendsto (λ (n : ℕ), truncation (X n) n ω - X n ω) at_top (𝓝 0),
+  { filter_upwards [ae_eventually_not_mem A.ne] with ω hω,
+    apply tendsto_const_nhds.congr' _,
+    filter_upwards [hω, Ioi_mem_at_top 0] with n hn npos,
+    simp only [truncation, indicator, set.mem_Ioc, id.def, function.comp_app],
+    split_ifs,
+    { exact (sub_self _).symm },
+    { have : - (n : ℝ) < X n ω,
+      { apply lt_of_lt_of_le _ (hnonneg n ω),
+        simpa only [right.neg_neg_iff, nat.cast_pos] using npos },
+      simp only [this, true_and, not_le] at h,
+      exact (hn h).elim } },
+  filter_upwards [B] with ω hω,
+  convert is_o_sum_range_of_tendsto_zero hω,
+  ext n,
+  rw sum_sub_distrib,
+end
+include hindep
+
+/- `Xᵢ` satisfies the strong law of large numbers along the sequence
+`c^n`, for any `c > 1`. This follows from the version for the truncated `Xᵢ`, and the fact that
+`Xᵢ` and its truncated version have the same asymptotic behavior. -/
+lemma strong_law_aux6 {c : ℝ} (c_one : 1 < c) :
+  ∀ᵐ ω, tendsto (λ (n : ℕ), (∑ i in range ⌊c^n⌋₊, X i ω) / ⌊c^n⌋₊) at_top (𝓝 (𝔼[X 0])) :=
+begin
+   have H : ∀ (n : ℕ), (0 : ℝ) < ⌊c ^ n⌋₊,
+  { assume n,
+    refine zero_lt_one.trans_le _,
+    simp only [nat.one_le_cast, nat.one_le_floor_iff, one_le_pow_of_one_le c_one.le n] },
+  filter_upwards [strong_law_aux4 X hint hindep hident hnonneg c_one,
+    strong_law_aux5 X hint hident hnonneg] with ω hω h'ω,
+  rw [← tendsto_sub_nhds_zero_iff, ← asymptotics.is_o_one_iff ℝ],
+  have L : (λ n : ℕ, ∑ i in range ⌊c^n⌋₊, X i ω - ⌊c^n⌋₊ * 𝔼[X 0]) =o[at_top] (λ n, (⌊c^n⌋₊ : ℝ)),
+  { have A : tendsto (λ (n : ℕ), ⌊c ^ n⌋₊) at_top at_top :=
+      tendsto_nat_floor_at_top.comp (tendsto_pow_at_top_at_top_of_one_lt c_one),
+    convert hω.sub (h'ω.comp_tendsto A),
+    ext1 n,
+    simp only [sub_sub_sub_cancel_left] },
+  convert L.mul_is_O (is_O_refl (λ (n : ℕ), (⌊c ^ n⌋₊ : ℝ) ⁻¹) at_top);
+  { ext1 n,
+    field_simp [(H n).ne'] },
+end
+
+/-- `Xᵢ` satisfies the strong law of large numbers along all integers. This follows from the
+corresponding fact along the sequences `c^n`, and the fact that any integer can be sandwiched
+between `c^n` and `c^(n+1)` with comparably small error if `c` is close enough to `1`
+(which is formalized in `tendsto_div_of_monotone_of_tendsto_div_floor_pow`). -/
+lemma strong_law_aux7 :
+  ∀ᵐ ω, tendsto (λ (n : ℕ), (∑ i in range n, X i ω) / n) at_top (𝓝 (𝔼[X 0])) :=
+begin
+  obtain ⟨c, -, cone, clim⟩ :
+    ∃ (c : ℕ → ℝ), strict_anti c ∧ (∀ (n : ℕ), 1 < c n) ∧ tendsto c at_top (𝓝 1) :=
+      exists_seq_strict_anti_tendsto (1 : ℝ),
+  have : ∀ k, ∀ᵐ ω, tendsto (λ (n : ℕ), (∑ i in range ⌊c k ^ n⌋₊, X i ω) / ⌊c k ^ n⌋₊)
+    at_top (𝓝 (𝔼[X 0])) := λ k, strong_law_aux6 X hint hindep hident hnonneg (cone k),
+  filter_upwards [ae_all_iff.2 this] with ω hω,
+  apply tendsto_div_of_monotone_of_tendsto_div_floor_pow _ _ _ c cone clim _,
+  { assume m n hmn,
+    exact sum_le_sum_of_subset_of_nonneg (range_mono hmn) (λ i hi h'i, hnonneg i ω) },
+  { exact hω }
+end
+
+end strong_law_nonneg
+
+/-- *Strong law of large numbers*, almost sure version: if `X n` is a sequence of independent
+identically distributed integrable real-valued random variables, then `∑ i in range n, X i / n`
+converges almost surely to `𝔼[X 0]`. We give here the strong version, due to Etemadi, that only
+requires pairwise independence. -/
+theorem strong_law_ae
+  (X : ℕ → Ω → ℝ) (hint : integrable (X 0))
+  (hindep : pairwise (λ i j, indep_fun (X i) (X j)))
+  (hident : ∀ i, ident_distrib (X i) (X 0)) :
+  ∀ᵐ ω, tendsto (λ (n : ℕ), (∑ i in range n, X i ω) / n) at_top (𝓝 (𝔼[X 0])) :=
+begin
+  let pos : ℝ → ℝ := (λ x, max x 0),
+  let neg : ℝ → ℝ := (λ x, max (-x) 0),
+  have posm : measurable pos := measurable_id'.max measurable_const,
+  have negm : measurable neg := measurable_id'.neg.max measurable_const,
+  have A : ∀ᵐ ω, tendsto (λ (n : ℕ), (∑ i in range n, (pos ∘ (X i)) ω) / n)
+    at_top (𝓝 (𝔼[pos ∘ (X 0)])) :=
+      strong_law_aux7 _ hint.pos_part (λ i j hij, (hindep hij).comp posm posm)
+        (λ i, (hident i).comp posm) (λ i ω, le_max_right _ _),
+  have B : ∀ᵐ ω, tendsto (λ (n : ℕ), (∑ i in range n, (neg ∘ (X i)) ω) / n)
+    at_top (𝓝 (𝔼[neg ∘ (X 0)])) :=
+      strong_law_aux7 _ hint.neg_part (λ i j hij, (hindep hij).comp negm negm)
+        (λ i, (hident i).comp negm) (λ i ω, le_max_right _ _),
+  filter_upwards [A, B] with ω hωpos hωneg,
+  convert hωpos.sub hωneg,
+  { simp only [← sub_div, ← sum_sub_distrib, max_zero_sub_max_neg_zero_eq_self] },
+  { simp only [←integral_sub hint.pos_part hint.neg_part, max_zero_sub_max_neg_zero_eq_self] }
+end
+
+end strong_law_ae
+
+section strong_law_Lp
+
+variables {Ω : Type*} [measure_space Ω] [is_probability_measure (ℙ : measure Ω)]
+
+/-- *Strong law of large numbers*, Lᵖ version: if `X n` is a sequence of independent
+identically distributed real-valued random variables in Lᵖ, then `∑ i in range n, X i / n`
+converges in Lᵖ to `𝔼[X 0]`. -/
+theorem strong_law_Lp
+  {p : ℝ≥0∞} (hp : 1 ≤ p) (hp' : p ≠ ∞)
+  (X : ℕ → Ω → ℝ) (hℒp : mem_ℒp (X 0) p)
+  (hindep : pairwise (λ i j, indep_fun (X i) (X j)))
+  (hident : ∀ i, ident_distrib (X i) (X 0)) :
+  tendsto (λ n, snorm (λ ω, (∑ i in range n, X i ω) / n - 𝔼[X 0]) p ℙ) at_top (𝓝 0) :=
+begin
+  have hmeas : ∀ i, ae_strongly_measurable (X i) ℙ :=
+    λ i, (hident i).ae_strongly_measurable_iff.2 hℒp.1,
+  have hint : integrable (X 0) ℙ := hℒp.integrable hp,
+  have havg : ∀ n, ae_strongly_measurable (λ ω, (∑ i in range n, X i ω) / n) ℙ,
+  { intro n,
+    simp_rw div_eq_mul_inv,
+    exact ae_strongly_measurable.mul_const (ae_strongly_measurable_sum _  (λ i _, hmeas i)) _ },
+  refine tendsto_Lp_of_tendsto_in_measure _ hp hp' havg (mem_ℒp_const _) _
+    (tendsto_in_measure_of_tendsto_ae havg (strong_law_ae _ hint hindep hident)),
+  rw (_ : (λ n ω, (∑ i in range n, X i ω) / ↑n) = λ n, (∑ i in range n, X i) / ↑n),
+  { exact (uniform_integrable_average hp $
+      mem_ℒp.uniform_integrable_of_ident_distrib hp hp' hℒp hident).2.1 },
+  { ext n ω,
+    simp only [pi.coe_nat, pi.div_apply, sum_apply] }
+end
+
+end strong_law_Lp
+
+end probability_theory
diff --git a/src/probability/variance.lean b/src/probability/variance.lean
index 804e9afef5a6a..bf41ae83ad847 100644
--- a/src/probability/variance.lean
+++ b/src/probability/variance.lean
@@ -1,25 +1,38 @@
 /-
 Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
+Authors: Sébastien Gouëzel, Kexing Ying
 -/
 import probability.notation
 import probability.integration
+import measure_theory.function.l2_space
 
 /-!
 # Variance of random variables
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the variance of a real-valued random variable as `Var[X] = 𝔼[(X - 𝔼[X])^2]` (in the
 `probability_theory` locale).
 
-We prove the basic properties of the variance:
-* `variance_le_expectation_sq`: the inequality `Var[X] ≤ 𝔼[X^2]`.
-* `meas_ge_le_variance_div_sq`: Chebyshev's inequality, i.e.,
+## Main definitions
+
+* `probability_theory.evariance`: the variance of a real-valued random variable as a extended
+  non-negative real.
+* `probability_theory.variance`: the variance of a real-valued random variable as a real number.
+
+## Main results
+
+* `probability_theory.variance_le_expectation_sq`: the inequality `Var[X] ≤ 𝔼[X^2]`.
+* `probability_theory.meas_ge_le_variance_div_sq`: Chebyshev's inequality, i.e.,
       `ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2)`.
-* `indep_fun.variance_add`: the variance of the sum of two independent random variables is the sum
-  of the variances.
-* `indep_fun.variance_sum`: the variance of a finite sum of pairwise independent random variables is
-  the sum of the variances.
+* `probability_theory.meas_ge_le_evariance_div_sq`: Chebyshev's inequality formulated with
+  `evariance` without requiring the random variables to be L².
+* `probability_theory.indep_fun.variance_add`: the variance of the sum of two independent
+  random variables is the sum of the variances.
+* `probability_theory.indep_fun.variance_sum`: the variance of a finite sum of pairwise
+  independent random variables is the sum of the variances.
 -/
 
 open measure_theory filter finset
@@ -30,117 +43,276 @@ open_locale big_operators measure_theory probability_theory ennreal nnreal
 
 namespace probability_theory
 
-/-- The variance of a random variable is `𝔼[X^2] - 𝔼[X]^2` or, equivalently, `𝔼[(X - 𝔼[X])^2]`. We
-use the latter as the definition, to ensure better behavior even in garbage situations. -/
-def variance {Ω : Type*} {m : measurable_space Ω} (f : Ω → ℝ) (μ : measure Ω) : ℝ :=
-μ[(f - (λ x, μ[f])) ^ 2]
+/-- The `ℝ≥0∞`-valued variance of a real-valued random variable defined as the Lebesgue integral of
+`(X - 𝔼[X])^2`. -/
+def evariance {Ω : Type*} {m : measurable_space Ω} (X : Ω → ℝ) (μ : measure Ω) : ℝ≥0∞ :=
+∫⁻ ω, ‖X ω - μ[X]‖₊^2 ∂μ
 
-@[simp] lemma variance_zero {Ω : Type*} {m : measurable_space Ω} (μ : measure Ω) :
-  variance 0 μ = 0 :=
-by simp [variance]
+/-- The `ℝ`-valued variance of a real-valued random variable defined by applying `ennreal.to_real`
+to `evariance`. -/
+def variance {Ω : Type*} {m : measurable_space Ω} (X : Ω → ℝ) (μ : measure Ω) : ℝ :=
+(evariance X μ).to_real
 
-lemma variance_nonneg {Ω : Type*} {m : measurable_space Ω} (f : Ω → ℝ) (μ : measure Ω) :
-  0 ≤ variance f μ :=
-integral_nonneg (λ x, sq_nonneg _)
+variables {Ω : Type*} {m : measurable_space Ω} {X : Ω → ℝ} {μ : measure Ω}
 
-lemma variance_mul {Ω : Type*} {m : measurable_space Ω} (c : ℝ) (f : Ω → ℝ) (μ : measure Ω) :
-  variance (λ x, c * f x) μ = c^2 * variance f μ :=
-calc
-variance (λ x, c * f x) μ
-    = ∫ x, (c * f x - ∫ y, c * f y ∂μ) ^ 2 ∂μ : rfl
-... = ∫ x, (c * (f x - ∫ y, f y ∂μ)) ^ 2 ∂μ :
-  by { congr' 1 with x, simp_rw [integral_mul_left, mul_sub] }
-... = c^2 * variance f μ :
-  by { simp_rw [mul_pow, integral_mul_left], refl }
+lemma _root_.measure_theory.mem_ℒp.evariance_lt_top [is_finite_measure μ] (hX : mem_ℒp X 2 μ) :
+  evariance X μ < ∞ :=
+begin
+  have := ennreal.pow_lt_top (hX.sub $ mem_ℒp_const $ μ[X]).2 2,
+  rw [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top,
+    ← ennreal.rpow_two] at this,
+  simp only [pi.sub_apply, ennreal.to_real_bit0, ennreal.one_to_real, one_div] at this,
+  rw [← ennreal.rpow_mul, inv_mul_cancel (two_ne_zero : (2 : ℝ) ≠ 0), ennreal.rpow_one] at this,
+  simp_rw ennreal.rpow_two at this,
+  exact this,
+end
+
+lemma evariance_eq_top [is_finite_measure μ]
+  (hXm : ae_strongly_measurable X μ) (hX : ¬ mem_ℒp X 2 μ) :
+  evariance X μ = ∞ :=
+begin
+  by_contra h,
+  rw [← ne.def, ← lt_top_iff_ne_top] at h,
+  have : mem_ℒp (λ ω, X ω - μ[X]) 2 μ,
+  { refine ⟨hXm.sub ae_strongly_measurable_const, _⟩,
+    rw snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top,
+    simp only [ennreal.to_real_bit0, ennreal.one_to_real, ennreal.rpow_two, ne.def],
+    exact ennreal.rpow_lt_top_of_nonneg (by simp) h.ne },
+  refine hX _,
+  convert this.add (mem_ℒp_const $ μ[X]),
+  ext ω,
+  rw [pi.add_apply, sub_add_cancel],
+end
+
+lemma evariance_lt_top_iff_mem_ℒp [is_finite_measure μ]
+  (hX : ae_strongly_measurable X μ) :
+  evariance X μ < ∞ ↔ mem_ℒp X 2 μ :=
+begin
+  refine ⟨_, measure_theory.mem_ℒp.evariance_lt_top⟩,
+  contrapose,
+  rw [not_lt, top_le_iff],
+  exact evariance_eq_top hX
+end
+
+lemma _root_.measure_theory.mem_ℒp.of_real_variance_eq [is_finite_measure μ]
+  (hX : mem_ℒp X 2 μ) :
+  ennreal.of_real (variance X μ) = evariance X μ :=
+by { rw [variance, ennreal.of_real_to_real], exact hX.evariance_lt_top.ne, }
 
-lemma variance_smul {Ω : Type*} {m : measurable_space Ω} (c : ℝ) (f : Ω → ℝ) (μ : measure Ω) :
-  variance (c • f) μ = c^2 * variance f μ :=
-variance_mul c f μ
+include m
+
+lemma evariance_eq_lintegral_of_real (X : Ω → ℝ) (μ : measure Ω) :
+  evariance X μ = ∫⁻ ω, ennreal.of_real ((X ω - μ[X])^2) ∂μ :=
+begin
+  rw evariance,
+  congr,
+  ext1 ω,
+  rw [pow_two, ← ennreal.coe_mul, ← nnnorm_mul, ← pow_two],
+  congr,
+  exact (real.to_nnreal_eq_nnnorm_of_nonneg $ sq_nonneg _).symm,
+end
+
+lemma _root_.measure_theory.mem_ℒp.variance_eq_of_integral_eq_zero
+  (hX : mem_ℒp X 2 μ) (hXint : μ[X] = 0) :
+  variance X μ = μ[X^2] :=
+begin
+  rw [variance, evariance_eq_lintegral_of_real, ← of_real_integral_eq_lintegral_of_real,
+    ennreal.to_real_of_real];
+  simp_rw [hXint, sub_zero],
+  { refl },
+  { exact integral_nonneg (λ ω, pow_two_nonneg _) },
+  { convert hX.integrable_norm_rpow two_ne_zero ennreal.two_ne_top,
+    ext ω,
+    simp only [pi.sub_apply, real.norm_eq_abs, ennreal.to_real_bit0, ennreal.one_to_real,
+      real.rpow_two, pow_bit0_abs] },
+  { exact ae_of_all _ (λ ω, pow_two_nonneg _) }
+end
+
+lemma _root_.measure_theory.mem_ℒp.variance_eq [is_finite_measure μ]
+  (hX : mem_ℒp X 2 μ) :
+  variance X μ = μ[(X - (λ ω, μ[X]))^2] :=
+begin
+  rw [variance, evariance_eq_lintegral_of_real, ← of_real_integral_eq_lintegral_of_real,
+    ennreal.to_real_of_real],
+  { refl },
+  { exact integral_nonneg (λ ω, pow_two_nonneg _) },
+  { convert (hX.sub $ mem_ℒp_const (μ[X])).integrable_norm_rpow
+      two_ne_zero ennreal.two_ne_top,
+    ext ω,
+    simp only [pi.sub_apply, real.norm_eq_abs, ennreal.to_real_bit0, ennreal.one_to_real,
+      real.rpow_two, pow_bit0_abs] },
+  { exact ae_of_all _ (λ ω, pow_two_nonneg _) }
+end
+
+@[simp] lemma evariance_zero : evariance 0 μ = 0 :=
+by simp [evariance]
+
+lemma evariance_eq_zero_iff (hX : ae_measurable X μ) :
+  evariance X μ = 0 ↔ X =ᵐ[μ] λ ω, μ[X] :=
+begin
+  rw [evariance, lintegral_eq_zero_iff'],
+  split; intro hX; filter_upwards [hX] with ω hω,
+  { simp only [pi.zero_apply, pow_eq_zero_iff, nat.succ_pos', ennreal.coe_eq_zero,
+      nnnorm_eq_zero, sub_eq_zero] at hω,
+    exact hω },
+  { rw hω,
+    simp },
+  { measurability }
+end
+
+lemma evariance_mul (c : ℝ) (X : Ω → ℝ) (μ : measure Ω) :
+  evariance (λ ω, c * X ω) μ = ennreal.of_real (c^2) * evariance X μ :=
+begin
+  rw [evariance, evariance, ← lintegral_const_mul' _ _ ennreal.of_real_lt_top.ne],
+  congr,
+  ext1 ω,
+  rw [ennreal.of_real, ← ennreal.coe_pow, ← ennreal.coe_pow, ← ennreal.coe_mul],
+  congr,
+  rw [← sq_abs, ← real.rpow_two, real.to_nnreal_rpow_of_nonneg (abs_nonneg _), nnreal.rpow_two,
+    ← mul_pow, real.to_nnreal_mul_nnnorm _ (abs_nonneg _)],
+  conv_rhs { rw [← nnnorm_norm, norm_mul, norm_abs_eq_norm, ← norm_mul, nnnorm_norm, mul_sub] },
+  congr,
+  rw mul_comm,
+  simp_rw [← smul_eq_mul, ← integral_smul_const, smul_eq_mul, mul_comm],
+end
+
+localized "notation (name := probability_theory.evariance) `eVar[` X `]` :=
+  probability_theory.evariance X measure_theory.measure_space.volume" in probability_theory
+
+@[simp] lemma variance_zero (μ : measure Ω) : variance 0 μ = 0 :=
+by simp only [variance, evariance_zero, ennreal.zero_to_real]
+
+lemma variance_nonneg (X : Ω → ℝ) (μ : measure Ω) :
+  0 ≤ variance X μ :=
+ennreal.to_real_nonneg
+
+lemma variance_mul (c : ℝ) (X : Ω → ℝ) (μ : measure Ω) :
+  variance (λ ω, c * X ω) μ = c^2 * variance X μ :=
+begin
+  rw [variance, evariance_mul, ennreal.to_real_mul, ennreal.to_real_of_real (sq_nonneg _)],
+  refl,
+end
+
+lemma variance_smul (c : ℝ) (X : Ω → ℝ) (μ : measure Ω) :
+  variance (c • X) μ = c^2 * variance X μ :=
+variance_mul c X μ
 
 lemma variance_smul' {A : Type*} [comm_semiring A] [algebra A ℝ]
-  {Ω : Type*} {m : measurable_space Ω} (c : A) (f : Ω → ℝ) (μ : measure Ω) :
-  variance (c • f) μ = c^2 • variance f μ :=
+  (c : A) (X : Ω → ℝ) (μ : measure Ω) :
+  variance (c • X) μ = c^2 • variance X μ :=
 begin
-  convert variance_smul (algebra_map A ℝ c) f μ,
+  convert variance_smul (algebra_map A ℝ c) X μ,
   { ext1 x, simp only [algebra_map_smul], },
   { simp only [algebra.smul_def, map_pow], }
 end
 
-localized
-"notation `Var[` X `]` := probability_theory.variance X measure_theory.measure_space.volume"
-in probability_theory
+localized "notation (name := probability_theory.variance) `Var[` X `]` :=
+  probability_theory.variance X measure_theory.measure_space.volume" in probability_theory
 
-variables {Ω : Type*} [measure_space Ω] [is_probability_measure (volume : measure Ω)]
+omit m
 
-lemma variance_def' {X : Ω → ℝ} (hX : mem_ℒp X 2) :
+variables [measure_space Ω]
+
+lemma variance_def' [is_probability_measure (ℙ : measure Ω)]
+  {X : Ω → ℝ} (hX : mem_ℒp X 2) :
   Var[X] = 𝔼[X^2] - 𝔼[X]^2 :=
 begin
-  rw [variance, sub_sq', integral_sub', integral_add'], rotate,
+  rw [hX.variance_eq, sub_sq', integral_sub', integral_add'], rotate,
   { exact hX.integrable_sq },
   { convert integrable_const (𝔼[X] ^ 2),
     apply_instance },
   { apply hX.integrable_sq.add,
     convert integrable_const (𝔼[X] ^ 2),
     apply_instance },
-  { exact ((hX.integrable ennreal.one_le_two).const_mul 2).mul_const' _ },
+  { exact ((hX.integrable one_le_two).const_mul 2).mul_const' _ },
   simp only [integral_mul_right, pi.pow_apply, pi.mul_apply, pi.bit0_apply, pi.one_apply,
     integral_const (integral ℙ X ^ 2), integral_mul_left (2 : ℝ), one_mul,
     variance, pi.pow_apply, measure_univ, ennreal.one_to_real, algebra.id.smul_eq_mul],
   ring,
 end
 
-lemma variance_le_expectation_sq {X : Ω → ℝ} :
+lemma variance_le_expectation_sq [is_probability_measure (ℙ : measure Ω)]
+  {X : Ω → ℝ} (hm : ae_strongly_measurable X ℙ) :
   Var[X] ≤ 𝔼[X^2] :=
 begin
-  by_cases h_int : integrable X, swap,
-  { simp only [variance, integral_undef h_int, pi.pow_apply, pi.sub_apply, sub_zero] },
   by_cases hX : mem_ℒp X 2,
   { rw variance_def' hX,
     simp only [sq_nonneg, sub_le_self_iff] },
-  { rw [variance, integral_undef],
+  rw [variance, evariance_eq_lintegral_of_real, ← integral_eq_lintegral_of_nonneg_ae],
+  by_cases hint : integrable X, swap,
+  { simp only [integral_undef hint, pi.pow_apply, pi.sub_apply, sub_zero] },
+  { rw integral_undef,
     { exact integral_nonneg (λ a, sq_nonneg _) },
-    { assume h,
-      have A : mem_ℒp (X - λ (x : Ω), 𝔼[X]) 2 ℙ := (mem_ℒp_two_iff_integrable_sq
-        (h_int.ae_strongly_measurable.sub ae_strongly_measurable_const)).2 h,
-      have B : mem_ℒp (λ (x : Ω), 𝔼[X]) 2 ℙ := mem_ℒp_const _,
+    { intro h,
+      have A : mem_ℒp (X - λ (ω : Ω), 𝔼[X]) 2 ℙ := (mem_ℒp_two_iff_integrable_sq
+        (hint.ae_strongly_measurable.sub ae_strongly_measurable_const)).2 h,
+      have B : mem_ℒp (λ (ω : Ω), 𝔼[X]) 2 ℙ := mem_ℒp_const _,
       apply hX,
       convert A.add B,
-      simp } }
+      simp } },
+  { exact ae_of_all _ (λ x, sq_nonneg _) },
+  { exact (ae_measurable.pow_const (hm.ae_measurable.sub_const _) _).ae_strongly_measurable },
 end
 
-/-- *Chebyshev's inequality* : one can control the deviation probability of a real random variable
-from its expectation in terms of the variance. -/
-theorem meas_ge_le_variance_div_sq {X : Ω → ℝ} (hX : mem_ℒp X 2) {c : ℝ} (hc : 0 < c) :
-  ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2) :=
+lemma evariance_def' [is_probability_measure (ℙ : measure Ω)]
+  {X : Ω → ℝ} (hX : ae_strongly_measurable X ℙ) :
+  eVar[X] = (∫⁻ ω, ‖X ω‖₊^2) - ennreal.of_real (𝔼[X]^2) :=
+begin
+  by_cases hℒ : mem_ℒp X 2,
+  { rw [← hℒ.of_real_variance_eq, variance_def' hℒ, ennreal.of_real_sub _ (sq_nonneg _)],
+    congr,
+    simp_rw ← ennreal.coe_pow,
+    rw lintegral_coe_eq_integral,
+    { congr' 2 with ω,
+      simp only [pi.pow_apply, nnreal.coe_pow, coe_nnnorm, real.norm_eq_abs, pow_bit0_abs] },
+    { exact hℒ.abs.integrable_sq } },
+  { symmetry,
+    rw [evariance_eq_top hX hℒ, ennreal.sub_eq_top_iff],
+    refine ⟨_, ennreal.of_real_ne_top⟩,
+    rw [mem_ℒp, not_and] at hℒ,
+    specialize hℒ hX,
+    simp only [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top, not_lt,
+      top_le_iff, ennreal.to_real_bit0, ennreal.one_to_real, ennreal.rpow_two, one_div,
+      ennreal.rpow_eq_top_iff, inv_lt_zero, inv_pos, zero_lt_bit0, zero_lt_one, and_true,
+      or_iff_not_imp_left, not_and_distrib] at hℒ,
+    exact hℒ (λ _, zero_le_two) }
+end
+
+/-- *Chebyshev's inequality* for `ℝ≥0∞`-valued variance. -/
+theorem meas_ge_le_evariance_div_sq {X : Ω → ℝ}
+  (hX : ae_strongly_measurable X ℙ) {c : ℝ≥0} (hc : c ≠ 0) :
+  ℙ {ω | ↑c ≤ |X ω - 𝔼[X]|} ≤ eVar[X] / c ^ 2 :=
 begin
-  have A : (ennreal.of_real c : ℝ≥0∞) ≠ 0,
-    by simp only [hc, ne.def, ennreal.of_real_eq_zero, not_le],
+  have A : (c : ℝ≥0∞) ≠ 0, { rwa [ne.def, ennreal.coe_eq_zero] },
   have B : ae_strongly_measurable (λ (ω : Ω), 𝔼[X]) ℙ := ae_strongly_measurable_const,
-  convert meas_ge_le_mul_pow_snorm ℙ ennreal.two_ne_zero ennreal.two_ne_top
-    (hX.ae_strongly_measurable.sub B) A,
+  convert meas_ge_le_mul_pow_snorm ℙ two_ne_zero ennreal.two_ne_top (hX.sub B) A,
   { ext ω,
-    set d : ℝ≥0 := ⟨c, hc.le⟩ with hd,
-    have cd : c = d, by simp only [subtype.coe_mk],
     simp only [pi.sub_apply, ennreal.coe_le_coe, ← real.norm_eq_abs, ← coe_nnnorm,
-      nnreal.coe_le_coe, cd, ennreal.of_real_coe_nnreal] },
-  { rw (hX.sub (mem_ℒp_const _)).snorm_eq_integral_rpow_norm
-      ennreal.two_ne_zero ennreal.two_ne_top,
-    simp only [pi.sub_apply, ennreal.to_real_bit0, ennreal.one_to_real],
-    rw ennreal.of_real_rpow_of_nonneg _ zero_le_two, rotate,
-    { apply real.rpow_nonneg_of_nonneg,
-      exact integral_nonneg (λ x, real.rpow_nonneg_of_nonneg (norm_nonneg _) _) },
-    rw [variance, ← real.rpow_mul, inv_mul_cancel], rotate,
-    { exact two_ne_zero },
-    { exact integral_nonneg (λ x, real.rpow_nonneg_of_nonneg (norm_nonneg _) _) },
-    simp only [pi.pow_apply, pi.sub_apply, real.rpow_two, real.rpow_one, real.norm_eq_abs,
-      pow_bit0_abs, ennreal.of_real_inv_of_pos hc, ennreal.rpow_two],
-    rw [← ennreal.of_real_pow (inv_nonneg.2 hc.le), ← ennreal.of_real_mul (sq_nonneg _),
-      div_eq_inv_mul, inv_pow₀] }
+      nnreal.coe_le_coe, ennreal.of_real_coe_nnreal] },
+  { rw snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top,
+    simp only [ennreal.to_real_bit0, ennreal.one_to_real, pi.sub_apply, one_div],
+    rw [div_eq_mul_inv, ennreal.inv_pow, mul_comm, ennreal.rpow_two],
+    congr,
+    simp_rw [← ennreal.rpow_mul, inv_mul_cancel (two_ne_zero : (2 : ℝ) ≠ 0), ennreal.rpow_two,
+      ennreal.rpow_one, evariance] }
+end
+
+/-- *Chebyshev's inequality* : one can control the deviation probability of a real random variable
+from its expectation in terms of the variance. -/
+theorem meas_ge_le_variance_div_sq [is_finite_measure (ℙ : measure Ω)]
+  {X : Ω → ℝ} (hX : mem_ℒp X 2) {c : ℝ} (hc : 0 < c) :
+  ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2) :=
+begin
+  rw [ennreal.of_real_div_of_pos (sq_pos_of_ne_zero _ hc.ne.symm), hX.of_real_variance_eq],
+  convert @meas_ge_le_evariance_div_sq _ _ _ hX.1 (c.to_nnreal) (by simp [hc]),
+  { simp only [real.coe_to_nnreal', max_le_iff, abs_nonneg, and_true] },
+  { rw ennreal.of_real_pow hc.le,
+    refl }
 end
 
 /-- The variance of the sum of two independent random variables is the sum of the variances. -/
-theorem indep_fun.variance_add {X Y : Ω → ℝ}
-  (hX : mem_ℒp X 2) (hY : mem_ℒp Y 2) (h : indep_fun X Y) :
+theorem indep_fun.variance_add [is_probability_measure (ℙ : measure Ω)]
+  {X Y : Ω → ℝ} (hX : mem_ℒp X 2) (hY : mem_ℒp Y 2) (h : indep_fun X Y) :
   Var[X + Y] = Var[X] + Var[Y] :=
 calc
 Var[X + Y] = 𝔼[λ a, (X a)^2 + (Y a)^2 + 2 * X a * Y a] - 𝔼[X+Y]^2 :
@@ -149,26 +321,27 @@ Var[X + Y] = 𝔼[λ a, (X a)^2 + (Y a)^2 + 2 * X a * Y a] - 𝔼[X+Y]^2 :
 begin
   simp only [pi.add_apply, pi.pow_apply, pi.mul_apply, mul_assoc],
   rw [integral_add, integral_add, integral_add, integral_mul_left],
-  { exact hX.integrable ennreal.one_le_two },
-  { exact hY.integrable ennreal.one_le_two },
+  { exact hX.integrable one_le_two },
+  { exact hY.integrable one_le_two },
   { exact hX.integrable_sq },
   { exact hY.integrable_sq },
   { exact hX.integrable_sq.add hY.integrable_sq },
   { apply integrable.const_mul,
-    exact h.integrable_mul (hX.integrable ennreal.one_le_two) (hY.integrable ennreal.one_le_two) }
+    exact h.integrable_mul (hX.integrable one_le_two) (hY.integrable one_le_two) }
 end
 ... = (𝔼[X^2] + 𝔼[Y^2] + 2 * (𝔼[X] * 𝔼[Y])) - (𝔼[X] + 𝔼[Y])^2 :
 begin
   congr,
   exact h.integral_mul_of_integrable
-    (hX.integrable ennreal.one_le_two) (hY.integrable ennreal.one_le_two),
+    (hX.integrable one_le_two) (hY.integrable one_le_two),
 end
 ... = Var[X] + Var[Y] :
   by { simp only [variance_def', hX, hY, pi.pow_apply], ring }
 
 /-- The variance of a finite sum of pairwise independent random variables is the sum of the
 variances. -/
-theorem indep_fun.variance_sum {ι : Type*} {X : ι → Ω → ℝ} {s : finset ι}
+theorem indep_fun.variance_sum [is_probability_measure (ℙ : measure Ω)]
+  {ι : Type*} {X : ι → Ω → ℝ} {s : finset ι}
   (hs : ∀ i ∈ s, mem_ℒp (X i) 2) (h : set.pairwise ↑s (λ i j, indep_fun (X i) (X j))) :
   Var[∑ i in s, X i] = ∑ i in s, Var[X i] :=
 begin
@@ -182,9 +355,9 @@ begin
     - (𝔼[X k] + 𝔼[∑ i in s, X i]) ^ 2 :
   begin
     rw [integral_add', integral_add', integral_add'],
-    { exact mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_self _ _)) },
+    { exact mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)) },
     { apply integrable_finset_sum' _ (λ i hi, _),
-      exact mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_of_mem hi)) },
+      exact mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)) },
     { exact mem_ℒp.integrable_sq (hs _ (mem_insert_self _ _)) },
     { apply mem_ℒp.integrable_sq,
       exact mem_ℒp_finset_sum' _ (λ i hi, (hs _ (mem_insert_of_mem hi))) },
@@ -193,12 +366,12 @@ begin
       { apply mem_ℒp.integrable_sq,
         exact mem_ℒp_finset_sum' _ (λ i hi, (hs _ (mem_insert_of_mem hi))) } },
     { rw mul_assoc,
-      apply integrable.const_mul _ 2,
+      apply integrable.const_mul _ (2:ℝ),
       simp only [mul_sum, sum_apply, pi.mul_apply],
       apply integrable_finset_sum _ (λ i hi, _),
       apply indep_fun.integrable_mul _
-        (mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_self _ _)))
-        (mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_of_mem hi))),
+        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)))
+        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi))),
       apply h (mem_insert_self _ _) (mem_insert_of_mem hi),
       exact (λ hki, ks (hki.symm ▸ hi)) }
   end
@@ -214,21 +387,21 @@ begin
     simp only [mul_assoc, integral_mul_left, pi.mul_apply, pi.bit0_apply, pi.one_apply, sum_apply,
       add_right_eq_self, mul_sum],
     rw integral_finset_sum s (λ i hi, _), swap,
-    { apply integrable.const_mul _ 2,
+    { apply integrable.const_mul _ (2:ℝ),
       apply indep_fun.integrable_mul _
-        (mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_self _ _)))
-        (mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_of_mem hi))),
+        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)))
+        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi))),
       apply h (mem_insert_self _ _) (mem_insert_of_mem hi),
       exact (λ hki, ks (hki.symm ▸ hi)) },
     rw [integral_finset_sum s
-      (λ i hi, (mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_of_mem hi)))),
+      (λ i hi, (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)))),
       mul_sum, mul_sum, ← sum_sub_distrib],
     apply finset.sum_eq_zero (λ i hi, _),
-    rw [integral_mul_left, indep_fun.integral_mul_of_integrable', sub_self],
+    rw [integral_mul_left, indep_fun.integral_mul', sub_self],
     { apply h (mem_insert_self _ _) (mem_insert_of_mem hi),
       exact (λ hki, ks (hki.symm ▸ hi)) },
-    { exact mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_self _ _)) },
-    { exact mem_ℒp.integrable ennreal.one_le_two (hs _ (mem_insert_of_mem hi)) }
+    { exact mem_ℒp.ae_strongly_measurable (hs _ (mem_insert_self _ _)) },
+    { exact mem_ℒp.ae_strongly_measurable (hs _ (mem_insert_of_mem hi)) }
   end
   ... = Var[X k] + ∑ i in s, Var[X i] :
     by rw IH (λ i hi, hs i (mem_insert_of_mem hi))
diff --git a/src/representation_theory/Action.lean b/src/representation_theory/Action.lean
index bb29fd03d19cc..df29ca63dca5a 100644
--- a/src/representation_theory/Action.lean
+++ b/src/representation_theory/Action.lean
@@ -14,6 +14,7 @@ import category_theory.monoidal.rigid.of_equivalence
 import category_theory.monoidal.rigid.functor_category
 import category_theory.monoidal.linear
 import category_theory.monoidal.braided
+import category_theory.monoidal.types.symmetric
 import category_theory.abelian.functor_category
 import category_theory.abelian.transfer
 import category_theory.conj
@@ -22,6 +23,9 @@ import category_theory.linear.functor_category
 /-!
 # `Action V G`, the category of actions of a monoid `G` inside some category `V`.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The prototypical example is `V = Module R`,
 where `Action (Module R) G` is the category of `R`-linear representations of `G`.
 
@@ -33,7 +37,7 @@ and construct the restriction functors `res {G H : Mon} (f : G ⟶ H) : Action V
 * When `V` is preadditive, linear, or abelian so is `Action V G`.
 -/
 
-universes u
+universes u v
 
 open category_theory
 open category_theory.limits
@@ -74,6 +78,8 @@ variable (G : Mon.{u})
 
 section
 
+instance inhabited' : inhabited (Action (Type u) G) := ⟨⟨punit, 1⟩⟩
+
 /-- The trivial representation of a group. -/
 def trivial : Action AddCommGroup G :=
 { V := AddCommGroup.of punit,
@@ -140,6 +146,14 @@ def mk_iso {M N : Action V G} (f : M.V ≅ N.V) (comm : ∀ g : G, M.ρ g ≫ f.
   { hom := f.inv,
     comm' := λ g, by { have w := comm g =≫ f.inv, simp at w, simp [w], }, }}
 
+@[priority 100]
+instance is_iso_of_hom_is_iso {M N : Action V G} (f : M ⟶ N) [is_iso f.hom] : is_iso f :=
+by { convert is_iso.of_iso (mk_iso (as_iso f.hom) f.comm), ext, refl, }
+
+instance is_iso_hom_mk {M N : Action V G} (f : M.V ⟶ N.V) [is_iso f] (w) :
+  @is_iso _ _ M N ⟨f, w⟩ :=
+is_iso.of_iso (mk_iso (as_iso f) w)
+
 namespace functor_category_equivalence
 
 /-- Auxilliary definition for `functor_category_equivalence`. -/
@@ -196,9 +210,19 @@ def functor_category_equivalence : Action V G ≌ (single_obj G ⥤ V) :=
 
 attribute [simps] functor_category_equivalence
 
+lemma functor_category_equivalence.functor_def :
+  (functor_category_equivalence V G).functor = functor_category_equivalence.functor := rfl
+
+lemma functor_category_equivalence.inverse_def :
+  (functor_category_equivalence V G).inverse = functor_category_equivalence.inverse := rfl
+
 instance [has_finite_products V] : has_finite_products (Action V G) :=
-{ out := λ J _ _, by exactI
-  adjunction.has_limits_of_shape_of_equivalence (Action.functor_category_equivalence _ _).functor }
+{ out := λ n, adjunction.has_limits_of_shape_of_equivalence
+    (Action.functor_category_equivalence _ _).functor }
+
+instance [has_finite_limits V] : has_finite_limits (Action V G) :=
+{ out := λ J _ _, by exactI adjunction.has_limits_of_shape_of_equivalence
+    (Action.functor_category_equivalence _ _).functor }
 
 instance [has_limits V] : has_limits (Action V G) :=
 adjunction.has_limits_of_equivalence (Action.functor_category_equivalence _ _).functor
@@ -257,9 +281,15 @@ section has_zero_morphisms
 variables [has_zero_morphisms V]
 
 instance : has_zero_morphisms (Action V G) :=
-{ has_zero := λ X Y, ⟨⟨0, by tidy⟩⟩, }
+{ has_zero := λ X Y, ⟨⟨0, by { intro g, simp }⟩⟩,
+  comp_zero' := λ P Q f R, by { ext1, simp },
+  zero_comp' := λ P Q R f, by { ext1, simp }, }
 
-instance : functor.preserves_zero_morphisms (functor_category_equivalence V G).functor := {}
+instance forget_preserves_zero_morphisms : functor.preserves_zero_morphisms (forget V G) := {}
+instance forget₂_preserves_zero_morphisms [concrete_category V] :
+  functor.preserves_zero_morphisms (forget₂ (Action V G) V) := {}
+instance functor_category_equivalence_preserves_zero_morphisms :
+  functor.preserves_zero_morphisms (functor_category_equivalence V G).functor := {}
 
 end has_zero_morphisms
 
@@ -279,11 +309,18 @@ instance : preadditive (Action V G) :=
   add_comp' := by { intros, ext, exact preadditive.add_comp _ _ _ _ _ _, },
   comp_add' := by { intros, ext, exact preadditive.comp_add _ _ _ _ _ _, }, }
 
-instance : functor.additive (functor_category_equivalence V G).functor := {}
+instance forget_additive :
+  functor.additive (forget V G) := {}
+instance forget₂_additive [concrete_category V] :
+  functor.additive (forget₂ (Action V G) V) := {}
+instance functor_category_equivalence_additive :
+  functor.additive (functor_category_equivalence V G).functor := {}
 
 @[simp] lemma zero_hom {X Y : Action V G} : (0 : X ⟶ Y).hom = 0 := rfl
 @[simp] lemma neg_hom {X Y : Action V G} (f : X ⟶ Y) : (-f).hom = -f.hom := rfl
 @[simp] lemma add_hom {X Y : Action V G} (f g : X ⟶ Y) : (f + g).hom = f.hom + g.hom := rfl
+@[simp] lemma sum_hom {X Y : Action V G} {ι : Type*} (f : ι → (X ⟶ Y)) (s : finset ι) :
+  (s.sum f).hom = s.sum (λ i, (f i).hom) := (forget V G).map_sum f s
 
 end preadditive
 
@@ -302,7 +339,12 @@ instance : linear R (Action V G) :=
   smul_comp' := by { intros, ext, exact linear.smul_comp _ _ _ _ _ _, },
   comp_smul' := by { intros, ext, exact linear.comp_smul _ _ _ _ _ _, }, }
 
-instance : functor.linear R (functor_category_equivalence V G).functor := {}
+instance forget_linear :
+  functor.linear R (forget V G) := {}
+instance forget₂_linear [concrete_category V] :
+  functor.linear R (forget₂ (Action V G) V) := {}
+instance functor_category_equivalence_linear :
+  functor.linear R (functor_category_equivalence V G).functor := {}
 
 @[simp] lemma smul_hom {X Y : Action V G} (r : R) (f : X ⟶ Y) : (r • f).hom = r • f.hom := rfl
 
@@ -324,6 +366,8 @@ variables [monoidal_category V]
 instance : monoidal_category (Action V G) :=
 monoidal.transport (Action.functor_category_equivalence _ _).symm
 
+@[simp] lemma tensor_unit_V : (𝟙_ (Action V G)).V = 𝟙_ V := rfl
+@[simp] lemma tensor_unit_rho {g : G} : (𝟙_ (Action V G)).ρ g = 𝟙 (𝟙_ V) := rfl
 @[simp] lemma tensor_V {X Y : Action V G} : (X ⊗ Y).V = X.V ⊗ Y.V := rfl
 @[simp] lemma tensor_rho {X Y : Action V G} {g : G} : (X ⊗ Y).ρ g = X.ρ g ⊗ Y.ρ g := rfl
 @[simp] lemma tensor_hom {W X Y Z : Action V G} (f : W ⟶ X) (g : Y ⟶ Z) :
@@ -365,6 +409,13 @@ begin
   simp,
 end
 
+/-- Given an object `X` isomorphic to the tensor unit of `V`, `X` equipped with the trivial action
+is isomorphic to the tensor unit of `Action V G`. -/
+def tensor_unit_iso {X : V} (f : 𝟙_ V ≅ X) :
+  𝟙_ (Action V G) ≅ Action.mk X 1 :=
+Action.mk_iso f (λ g, by simp only [monoid_hom.one_apply, End.one_def, category.id_comp f.hom,
+  tensor_unit_rho, category.comp_id])
+
 variables (V G)
 
 /-- When `V` is monoidal the forgetful functor `Action V G` to `V` is monoidal. -/
@@ -397,10 +448,10 @@ instance [symmetric_category V] : symmetric_category (Action V G) :=
 symmetric_category_of_faithful (forget_braided V G)
 
 section
-local attribute [simp] monoidal_preadditive.tensor_add monoidal_preadditive.add_tensor
-
 variables [preadditive V] [monoidal_preadditive V]
 
+local attribute [simp] monoidal_preadditive.tensor_add monoidal_preadditive.add_tensor
+
 instance : monoidal_preadditive (Action V G) := {}
 
 variables {R : Type*} [semiring R] [linear R V] [monoidal_linear R V]
@@ -419,8 +470,75 @@ monoidal.from_transported (Action.functor_category_equivalence _ _).symm
 instance : is_equivalence ((functor_category_monoidal_equivalence V G).to_functor) :=
 by { change is_equivalence (Action.functor_category_equivalence _ _).functor, apply_instance, }
 
+@[simp] lemma functor_category_monoidal_equivalence.μ_app (A B : Action V G) :
+  ((functor_category_monoidal_equivalence V G).μ A B).app punit.star = 𝟙 _ :=
+begin
+  dunfold functor_category_monoidal_equivalence,
+  simp only [monoidal.from_transported_to_lax_monoidal_functor_μ],
+  show (𝟙 A.V ⊗ 𝟙 B.V) ≫ 𝟙 (A.V ⊗ B.V) ≫ (𝟙 A.V ⊗ 𝟙 B.V) = 𝟙 (A.V ⊗ B.V),
+  simp only [monoidal_category.tensor_id, category.comp_id],
+end
+
+@[simp] lemma functor_category_monoidal_equivalence.μ_iso_inv_app (A B : Action V G) :
+  ((functor_category_monoidal_equivalence V G).μ_iso A B).inv.app punit.star = 𝟙 _ :=
+begin
+  rw [←nat_iso.app_inv, ←is_iso.iso.inv_hom],
+  refine is_iso.inv_eq_of_hom_inv_id _,
+  rw [category.comp_id, nat_iso.app_hom, monoidal_functor.μ_iso_hom,
+    functor_category_monoidal_equivalence.μ_app],
+end
+
+@[simp] lemma functor_category_monoidal_equivalence.ε_app :
+  (functor_category_monoidal_equivalence V G).ε.app punit.star = 𝟙 _ :=
+begin
+  dunfold functor_category_monoidal_equivalence,
+  simp only [monoidal.from_transported_to_lax_monoidal_functor_ε],
+  show 𝟙 (monoidal_category.tensor_unit V) ≫ _ = 𝟙 (monoidal_category.tensor_unit V),
+  rw [nat_iso.is_iso_inv_app, category.id_comp],
+  exact is_iso.inv_id,
+end
+
+@[simp] lemma functor_category_monoidal_equivalence.inv_counit_app_hom (A : Action V G) :
+  ((functor_category_monoidal_equivalence _ _).inv.adjunction.counit.app A).hom = 𝟙 _ :=
+rfl
+
+@[simp] lemma functor_category_monoidal_equivalence.counit_app (A : single_obj G ⥤ V) :
+  ((functor_category_monoidal_equivalence _ _).adjunction.counit.app A).app punit.star = 𝟙 _ := rfl
+
+@[simp] lemma functor_category_monoidal_equivalence.inv_unit_app_app
+  (A : single_obj G ⥤ V) :
+  ((functor_category_monoidal_equivalence _ _).inv.adjunction.unit.app A).app
+  punit.star = 𝟙 _ := rfl
+
+@[simp] lemma functor_category_monoidal_equivalence.unit_app_hom (A : Action V G) :
+  ((functor_category_monoidal_equivalence _ _).adjunction.unit.app A).hom = 𝟙 _ :=
+rfl
+
+@[simp] lemma functor_category_monoidal_equivalence.functor_map {A B : Action V G} (f : A ⟶ B) :
+  (functor_category_monoidal_equivalence _ _).map f
+    = functor_category_equivalence.functor.map f := rfl
+
+@[simp] lemma functor_category_monoidal_equivalence.inverse_map
+  {A B : single_obj G ⥤ V} (f : A ⟶ B) :
+  (functor_category_monoidal_equivalence _ _).inv.map f
+    = functor_category_equivalence.inverse.map f := rfl
+
 variables (H : Group.{u})
 
+instance [right_rigid_category V] : right_rigid_category (single_obj (H : Mon.{u}) ⥤ V) :=
+by { change right_rigid_category (single_obj H ⥤ V), apply_instance }
+
+/-- If `V` is right rigid, so is `Action V G`. -/
+instance [right_rigid_category V] : right_rigid_category (Action V H) :=
+right_rigid_category_of_equivalence (functor_category_monoidal_equivalence V _)
+
+instance [left_rigid_category V] : left_rigid_category (single_obj (H : Mon.{u}) ⥤ V) :=
+by { change left_rigid_category (single_obj H ⥤ V), apply_instance }
+
+/-- If `V` is left rigid, so is `Action V G`. -/
+instance [left_rigid_category V] : left_rigid_category (Action V H) :=
+left_rigid_category_of_equivalence (functor_category_monoidal_equivalence V _)
+
 instance [rigid_category V] : rigid_category (single_obj (H : Mon.{u}) ⥤ V) :=
 by { change rigid_category (single_obj H ⥤ V), apply_instance }
 
@@ -428,6 +546,18 @@ by { change rigid_category (single_obj H ⥤ V), apply_instance }
 instance [rigid_category V] : rigid_category (Action V H) :=
 rigid_category_of_equivalence (functor_category_monoidal_equivalence V _)
 
+variables {V H} (X : Action V H)
+
+@[simp] lemma right_dual_V [right_rigid_category V] : (Xᘁ).V = (X.V)ᘁ := rfl
+
+@[simp] lemma left_dual_V [left_rigid_category V] : (ᘁX).V = ᘁ(X.V) := rfl
+
+@[simp] lemma right_dual_ρ [right_rigid_category V] (h : H) : (Xᘁ).ρ h = (X.ρ (h⁻¹ : H))ᘁ :=
+by { rw ←single_obj.inv_as_inv, refl }
+
+@[simp] lemma left_dual_ρ [left_rigid_category V] (h : H) : (ᘁX).ρ h = ᘁ(X.ρ (h⁻¹ : H)) :=
+by { rw ←single_obj.inv_as_inv, refl }
+
 end monoidal
 
 /-- Actions/representations of the trivial group are just objects in the ambient category. -/
@@ -485,6 +615,96 @@ variables {R : Type*} [semiring R]
 
 instance res_linear [preadditive V] [linear R V] : (res V f).linear R := {}
 
+/-- Bundles a type `H` with a multiplicative action of `G` as an `Action`. -/
+def of_mul_action (G H : Type u) [monoid G] [mul_action G H] : Action (Type u) (Mon.of G) :=
+{ V := H,
+  ρ := @mul_action.to_End_hom _ _ _ (by assumption) }
+
+@[simp] lemma of_mul_action_apply {G H : Type u} [monoid G] [mul_action G H] (g : G) (x : H) :
+  (of_mul_action G H).ρ g x = (g • x : H) :=
+rfl
+
+/-- Given a family `F` of types with `G`-actions, this is the limit cone demonstrating that the
+product of `F` as types is a product in the category of `G`-sets. -/
+def of_mul_action_limit_cone {ι : Type v} (G : Type (max v u)) [monoid G]
+  (F : ι → Type (max v u)) [Π i : ι, mul_action G (F i)] :
+  limit_cone (discrete.functor (λ i : ι, Action.of_mul_action G (F i))) :=
+{ cone :=
+  { X := Action.of_mul_action G (Π i : ι, F i),
+    π :=
+    { app := λ i, ⟨λ x, x i.as, λ g, by ext; refl⟩,
+      naturality' := λ i j x,
+      begin
+        ext,
+        discrete_cases,
+        cases x,
+        congr
+      end } },
+  is_limit :=
+  { lift := λ s,
+    { hom := λ x i, (s.π.app ⟨i⟩).hom x,
+      comm' := λ g,
+      begin
+        ext x j,
+        dsimp,
+        exact congr_fun ((s.π.app ⟨j⟩).comm g) x,
+      end },
+    fac' := λ s j,
+    begin
+      ext,
+      dsimp,
+      congr,
+      rw discrete.mk_as,
+    end,
+    uniq' := λ s f h,
+    begin
+      ext x j,
+      dsimp at *,
+      rw ←h ⟨j⟩,
+      congr,
+    end } }
+
+/-- The `G`-set `G`, acting on itself by left multiplication. -/
+@[simps] def left_regular (G : Type u) [monoid G] : Action (Type u) (Mon.of G) :=
+Action.of_mul_action G G
+
+/-- The `G`-set `Gⁿ`, acting on itself by left multiplication. -/
+@[simps] def diagonal (G : Type u) [monoid G] (n : ℕ) : Action (Type u) (Mon.of G) :=
+Action.of_mul_action G (fin n → G)
+
+/-- We have `fin 1 → G ≅ G` as `G`-sets, with `G` acting by left multiplication. -/
+def diagonal_one_iso_left_regular (G : Type u) [monoid G] :
+  diagonal G 1 ≅ left_regular G := Action.mk_iso (equiv.fun_unique _ _).to_iso (λ g, rfl)
+
+/-- Given `X : Action (Type u) (Mon.of G)` for `G` a group, then `G × X` (with `G` acting as left
+multiplication on the first factor and by `X.ρ` on the second) is isomorphic as a `G`-set to
+`G × X` (with `G` acting as left multiplication on the first factor and trivially on the second).
+The isomorphism is given by `(g, x) ↦ (g, g⁻¹ • x)`. -/
+@[simps] def left_regular_tensor_iso (G : Type u) [group G]
+  (X : Action (Type u) (Mon.of G)) :
+  left_regular G ⊗ X ≅ left_regular G ⊗ Action.mk X.V 1 :=
+{ hom :=
+  { hom := λ g, ⟨g.1, (X.ρ (g.1⁻¹ : G) g.2 : X.V)⟩,
+    comm' := λ g, funext $ λ x, prod.ext rfl $
+      show (X.ρ ((g * x.1)⁻¹ : G) * X.ρ g) x.2 = _,
+      by simpa only [mul_inv_rev, ←X.ρ.map_mul, inv_mul_cancel_right] },
+  inv :=
+  { hom := λ g, ⟨g.1, X.ρ g.1 g.2⟩,
+    comm' := λ g, funext $ λ x, prod.ext rfl $
+      by simpa only [tensor_rho, types_comp_apply, tensor_apply, left_regular_ρ_apply, map_mul] },
+  hom_inv_id' := hom.ext _ _ (funext $ λ x, prod.ext rfl $
+    show (X.ρ x.1 * X.ρ (x.1⁻¹ : G)) x.2 = _,
+      by simpa only [←X.ρ.map_mul, mul_inv_self, X.ρ.map_one]),
+  inv_hom_id' := hom.ext _ _ (funext $ λ x, prod.ext rfl $
+    show (X.ρ (x.1⁻¹ : G) * X.ρ x.1) _ = _,
+      by simpa only [←X.ρ.map_mul, inv_mul_self, X.ρ.map_one]) }
+
+/-- The natural isomorphism of `G`-sets `Gⁿ⁺¹ ≅ G × Gⁿ`, where `G` acts by left multiplication on
+each factor. -/
+@[simps] def diagonal_succ (G : Type u) [monoid G] (n : ℕ) :
+  diagonal G (n + 1) ≅ left_regular G ⊗ diagonal G n :=
+mk_iso (equiv.pi_fin_succ_above_equiv _ 0).to_iso (λ g, rfl)
+
 end Action
 
 namespace category_theory.functor
@@ -516,3 +736,46 @@ variables {R : Type*} [semiring R] [category_theory.linear R V] [category_theory
 instance map_Action_linear [F.additive] [F.linear R] : (F.map_Action G).linear R := {}
 
 end category_theory.functor
+
+namespace category_theory.monoidal_functor
+
+open Action
+variables {V} {W : Type (u+1)} [large_category W] [monoidal_category V] [monoidal_category W]
+  (F : monoidal_functor V W) (G : Mon.{u})
+
+/-- A monoidal functor induces a monoidal functor between
+the categories of `G`-actions within those categories. -/
+@[simps] def map_Action :
+  monoidal_functor (Action V G) (Action W G) :=
+{ ε :=
+  { hom := F.ε,
+    comm' := λ g,
+    by { dsimp, erw [category.id_comp, category_theory.functor.map_id, category.comp_id], }, },
+  μ := λ X Y,
+  { hom := F.μ X.V Y.V,
+    comm' := λ g, F.to_lax_monoidal_functor.μ_natural (X.ρ g) (Y.ρ g), },
+  ε_is_iso := by apply_instance,
+  μ_is_iso := by apply_instance,
+  μ_natural' := by { intros, ext, dsimp, simp, },
+  associativity' := by { intros, ext, dsimp, simp, dsimp, simp, }, -- See note [dsimp, simp].
+  left_unitality' := by { intros, ext, dsimp, simp, dsimp, simp, },
+  right_unitality' := by { intros, ext, dsimp, simp, dsimp, simp, },
+  ..F.to_functor.map_Action G, }
+
+@[simp] lemma map_Action_ε_inv_hom :
+  (inv (F.map_Action G).ε).hom = inv F.ε :=
+begin
+  ext,
+  simp only [←F.map_Action_to_lax_monoidal_functor_ε_hom G, ←Action.comp_hom,
+    is_iso.hom_inv_id, id_hom],
+end
+
+@[simp] lemma map_Action_μ_inv_hom (X Y : Action V G) :
+  (inv ((F.map_Action G).μ X Y)).hom = inv (F.μ X.V Y.V) :=
+begin
+  ext,
+  simpa only [←F.map_Action_to_lax_monoidal_functor_μ_hom G, ←Action.comp_hom,
+    is_iso.hom_inv_id, id_hom],
+end
+
+end category_theory.monoidal_functor
diff --git a/src/representation_theory/Rep.lean b/src/representation_theory/Rep.lean
index ad9e093c6632d..cd4ef0178d7bd 100644
--- a/src/representation_theory/Rep.lean
+++ b/src/representation_theory/Rep.lean
@@ -3,14 +3,20 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
+import representation_theory.basic
 import representation_theory.Action
 import algebra.category.Module.abelian
 import algebra.category.Module.colimits
-import algebra.category.Module.monoidal
+import algebra.category.Module.monoidal.closed
+import algebra.category.Module.adjunctions
+import category_theory.closed.functor_category
 
 /-!
 # `Rep k G` is the category of `k`-linear representations of `G`.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `V : Rep k G`, there is a coercion that allows you to treat `V` as a type,
 and this type comes equipped with a `module k V` instance.
 Also `V.ρ` gives the homomorphism `G →* (V →ₗ[k] V)`.
@@ -18,6 +24,7 @@ Also `V.ρ` gives the homomorphism `G →* (V →ₗ[k] V)`.
 Conversely, given a homomorphism `ρ : G →* (V →ₗ[k] V)`,
 you can construct the bundled representation as `Rep.of ρ`.
 
+We construct the categorical equivalence `Rep k G ≌ Module (monoid_algebra k G)`.
 We verify that `Rep k G` is a `k`-linear abelian symmetric monoidal category with all (co)limits.
 -/
 
@@ -36,33 +43,336 @@ instance (k G : Type u) [comm_ring k] [monoid G] : linear k (Rep k G) :=
 by apply_instance
 
 namespace Rep
-
-variables {k G : Type u} [ring k] [monoid G]
+variables {k G : Type u} [comm_ring k]
+section
+variables [monoid G]
 
 instance : has_coe_to_sort (Rep k G) (Type u) := concrete_category.has_coe_to_sort _
 
-instance (V : Rep k G) : add_comm_monoid V :=
-by { change add_comm_monoid ((forget₂ (Rep k G) (Module k)).obj V), apply_instance, }
+instance (V : Rep k G) : add_comm_group V :=
+by { change add_comm_group ((forget₂ (Rep k G) (Module k)).obj V), apply_instance, }
 
 instance (V : Rep k G) : module k V :=
 by { change module k ((forget₂ (Rep k G) (Module k)).obj V), apply_instance, }
 
--- This works well with the new design for representations:
-example (V : Rep k G) : G →* (V →ₗ[k] V) := V.ρ
+/--
+Specialize the existing `Action.ρ`, changing the type to `representation k G V`.
+-/
+def ρ (V : Rep k G) : representation k G V := V.ρ
 
 /-- Lift an unbundled representation to `Rep`. -/
-@[simps ρ]
 def of {V : Type u} [add_comm_group V] [module k V] (ρ : G →* (V →ₗ[k] V)) : Rep k G :=
 ⟨Module.of k V, ρ⟩
 
+@[simp]
+lemma coe_of {V : Type u} [add_comm_group V] [module k V] (ρ : G →* (V →ₗ[k] V)) :
+  (of ρ : Type u) = V := rfl
+
+@[simp] lemma of_ρ {V : Type u} [add_comm_group V] [module k V] (ρ : G →* (V →ₗ[k] V)) :
+  (of ρ).ρ = ρ := rfl
+
+lemma Action_ρ_eq_ρ {A : Rep k G} : Action.ρ A = A.ρ := rfl
+
+/-- Allows us to apply lemmas about the underlying `ρ`, which would take an element `g : G` rather
+than `g : Mon.of G` as an argument. -/
+lemma of_ρ_apply {V : Type u} [add_comm_group V] [module k V]
+  (ρ : representation k G V) (g : Mon.of G) :
+  (Rep.of ρ).ρ g = ρ (g : G) := rfl
+
+@[simp] lemma ρ_inv_self_apply {G : Type u} [group G] (A : Rep k G) (g : G) (x : A) :
+  A.ρ g⁻¹ (A.ρ g x) = x :=
+show (A.ρ g⁻¹ * A.ρ g) x = x, by rw [←map_mul, inv_mul_self, map_one, linear_map.one_apply]
+
+@[simp] lemma ρ_self_inv_apply {G : Type u} [group G] {A : Rep k G} (g : G) (x : A) :
+  A.ρ g (A.ρ g⁻¹ x) = x :=
+show (A.ρ g * A.ρ g⁻¹) x = x, by rw [←map_mul, mul_inv_self, map_one, linear_map.one_apply]
+
+lemma hom_comm_apply {A B : Rep k G} (f : A ⟶ B) (g : G) (x : A) :
+  f.hom (A.ρ g x) = B.ρ g (f.hom x) :=
+linear_map.ext_iff.1 (f.comm g) x
+
+variables (k G)
+
+/-- The trivial `k`-linear `G`-representation on a `k`-module `V.` -/
+def trivial (V : Type u) [add_comm_group V] [module k V] : Rep k G :=
+Rep.of (@representation.trivial k G V _ _ _ _)
+
+variables {k G}
+
+lemma trivial_def {V : Type u} [add_comm_group V] [module k V] (g : G) (v : V) :
+  (trivial k G V).ρ g v = v := rfl
+
 -- Verify that limits are calculated correctly.
 noncomputable example : preserves_limits (forget₂ (Rep k G) (Module.{u} k)) :=
 by apply_instance
 noncomputable example : preserves_colimits (forget₂ (Rep k G) (Module.{u} k)) :=
 by apply_instance
 
+@[simp] lemma monoidal_category.braiding_hom_apply {A B : Rep k G} (x : A) (y : B) :
+  Action.hom.hom (β_ A B).hom (tensor_product.tmul k x y) = tensor_product.tmul k y x := rfl
+
+@[simp] lemma monoidal_category.braiding_inv_apply {A B : Rep k G} (x : A) (y : B) :
+  Action.hom.hom (β_ A B).inv (tensor_product.tmul k y x) = tensor_product.tmul k x y := rfl
+
+section linearization
+
+variables (k G)
+
+/-- The monoidal functor sending a type `H` with a `G`-action to the induced `k`-linear
+`G`-representation on `k[H].` -/
+noncomputable def linearization :
+  monoidal_functor (Action (Type u) (Mon.of G)) (Rep k G) :=
+(Module.monoidal_free k).map_Action (Mon.of G)
+
+variables {k G}
+
+@[simp] lemma linearization_obj_ρ (X : Action (Type u) (Mon.of G)) (g : G) (x : X.V →₀ k) :
+  ((linearization k G).obj X).ρ g x = finsupp.lmap_domain k k (X.ρ g) x := rfl
+
+@[simp] lemma linearization_of (X : Action (Type u) (Mon.of G)) (g : G) (x : X.V) :
+  ((linearization k G).obj X).ρ g (finsupp.single x (1 : k))
+    = finsupp.single (X.ρ g x) (1 : k) :=
+by rw [linearization_obj_ρ, finsupp.lmap_domain_apply, finsupp.map_domain_single]
+
+variables {X Y : Action (Type u) (Mon.of G)} (f : X ⟶ Y)
+
+@[simp] lemma linearization_map_hom :
+  ((linearization k G).map f).hom = finsupp.lmap_domain k k f.hom := rfl
+
+lemma linearization_map_hom_single (x : X.V) (r : k) :
+  ((linearization k G).map f).hom (finsupp.single x r)
+    = finsupp.single (f.hom x) r :=
+by rw [linearization_map_hom, finsupp.lmap_domain_apply, finsupp.map_domain_single]
+
+@[simp] lemma linearization_μ_hom (X Y : Action (Type u) (Mon.of G)) :
+  ((linearization k G).μ X Y).hom = (finsupp_tensor_finsupp' k X.V Y.V).to_linear_map :=
+rfl
+
+@[simp] lemma linearization_μ_inv_hom (X Y : Action (Type u) (Mon.of G)) :
+  (inv ((linearization k G).μ X Y)).hom = (finsupp_tensor_finsupp' k X.V Y.V).symm.to_linear_map :=
+begin
+  simp_rw [←Action.forget_map, functor.map_inv, Action.forget_map, linearization_μ_hom],
+  apply is_iso.inv_eq_of_hom_inv_id _,
+  exact linear_map.ext (λ x, linear_equiv.symm_apply_apply _ _),
+end
+
+@[simp] lemma linearization_ε_hom :
+  (linearization k G).ε.hom = finsupp.lsingle punit.star :=
+rfl
+
+@[simp] lemma linearization_ε_inv_hom_apply (r : k) :
+  (inv (linearization k G).ε).hom (finsupp.single punit.star r) = r :=
+begin
+  simp_rw [←Action.forget_map, functor.map_inv, Action.forget_map],
+  rw [←finsupp.lsingle_apply punit.star r],
+  apply is_iso.hom_inv_id_apply _ _,
+end
+
+variables (k G)
+
+/-- The linearization of a type `X` on which `G` acts trivially is the trivial `G`-representation
+on `k[X]`. -/
+@[simps] noncomputable def linearization_trivial_iso (X : Type u) :
+  (linearization k G).obj (Action.mk X 1) ≅ trivial k G (X →₀ k) :=
+Action.mk_iso (iso.refl _) $ λ g, by { ext1, ext1, exact linearization_of _ _ _ }
+
+variables (k G)
+
+/-- Given a `G`-action on `H`, this is `k[H]` bundled with the natural representation
+`G →* End(k[H])` as a term of type `Rep k G`. -/
+noncomputable abbreviation of_mul_action (H : Type u) [mul_action G H] : Rep k G :=
+of $ representation.of_mul_action k G H
+
+/-- The `k`-linear `G`-representation on `k[G]`, induced by left multiplication. -/
+noncomputable def left_regular : Rep k G :=
+of_mul_action k G G
+
+/-- The `k`-linear `G`-representation on `k[Gⁿ]`, induced by left multiplication. -/
+noncomputable def diagonal (n : ℕ) : Rep k G :=
+of_mul_action k G (fin n → G)
+
+/-- The linearization of a type `H` with a `G`-action is definitionally isomorphic to the
+`k`-linear `G`-representation on `k[H]` induced by the `G`-action on `H`. -/
+noncomputable def linearization_of_mul_action_iso (H : Type u) [mul_action G H] :
+  (linearization k G).obj (Action.of_mul_action G H)
+    ≅ of_mul_action k G H := iso.refl _
+
+variables {k G}
+
+/-- Given an element `x : A`, there is a natural morphism of representations `k[G] ⟶ A` sending
+`g ↦ A.ρ(g)(x).` -/
+@[simps] noncomputable def left_regular_hom (A : Rep k G) (x : A) :
+  Rep.of_mul_action k G G ⟶ A :=
+{ hom := finsupp.lift _ _ _ (λ g, A.ρ g x),
+  comm' := λ g,
+  begin
+    refine finsupp.lhom_ext' (λ y, linear_map.ext_ring _),
+    simpa only [linear_map.comp_apply, Module.comp_def, finsupp.lsingle_apply,
+      finsupp.lift_apply, Action_ρ_eq_ρ, of_ρ_apply, representation.of_mul_action_single,
+      finsupp.sum_single_index, zero_smul, one_smul, smul_eq_mul, A.ρ.map_mul],
+  end }
+
+lemma left_regular_hom_apply {A : Rep k G} (x : A) :
+  (left_regular_hom A x).hom (finsupp.single 1 1) = x :=
+begin
+  simpa only [left_regular_hom_hom, finsupp.lift_apply, finsupp.sum_single_index, one_smul,
+    A.ρ.map_one, zero_smul],
+end
+
+/-- Given a `k`-linear `G`-representation `A`, there is a `k`-linear isomorphism between
+representation morphisms `Hom(k[G], A)` and `A`. -/
+@[simps] noncomputable def left_regular_hom_equiv (A : Rep k G) :
+  (Rep.of_mul_action k G G ⟶ A) ≃ₗ[k] A :=
+{ to_fun := λ f, f.hom (finsupp.single 1 1),
+  map_add' := λ x y, rfl,
+  map_smul' := λ r x, rfl,
+  inv_fun := λ x, left_regular_hom A x,
+  left_inv := λ f,
+  begin
+    refine Action.hom.ext _ _ (finsupp.lhom_ext' (λ (x : G), linear_map.ext_ring _)),
+    have : f.hom (((of_mul_action k G G).ρ) x (finsupp.single (1 : G) (1 : k)))
+      = A.ρ x (f.hom (finsupp.single (1 : G) (1 : k))) :=
+      linear_map.ext_iff.1 (f.comm x) (finsupp.single 1 1),
+    simp only [linear_map.comp_apply, finsupp.lsingle_apply,
+      left_regular_hom_hom, finsupp.lift_apply, finsupp.sum_single_index, one_smul, ←this,
+      zero_smul, of_ρ_apply, representation.of_mul_action_single x (1 : G) (1 : k), smul_eq_mul,
+      mul_one],
+  end,
+  right_inv := λ x, left_regular_hom_apply x }
+
+lemma left_regular_hom_equiv_symm_single {A : Rep k G} (x : A) (g : G) :
+  ((left_regular_hom_equiv A).symm x).hom (finsupp.single g 1) = A.ρ g x :=
+begin
+  simp only [left_regular_hom_equiv_symm_apply, left_regular_hom_hom,
+    finsupp.lift_apply, finsupp.sum_single_index, zero_smul, one_smul],
+end
+
+end linearization
+end
+section monoidal_closed
+open Action
+variables [group G] (A B C : Rep k G)
+
+/-- Given a `k`-linear `G`-representation `(A, ρ₁)`, this is the 'internal Hom' functor sending
+`(B, ρ₂)` to the representation `Homₖ(A, B)` that maps `g : G` and `f : A →ₗ[k] B` to
+`(ρ₂ g) ∘ₗ f ∘ₗ (ρ₁ g⁻¹)`. -/
+@[simps] protected def ihom (A : Rep k G) : Rep k G ⥤ Rep k G :=
+{ obj := λ B, Rep.of (representation.lin_hom A.ρ B.ρ),
+  map := λ X Y f,
+    { hom := Module.of_hom (linear_map.llcomp k _ _ _ f.hom),
+      comm' := λ g, linear_map.ext (λ x, linear_map.ext (λ y,
+        show f.hom (X.ρ g _) = _, by simpa only [hom_comm_apply])) },
+  map_id' := λ B, by ext; refl,
+  map_comp' := λ B C D f g, by ext; refl }
+
+@[simp] protected lemma ihom_obj_ρ_apply {A B : Rep k G} (g : G) (x : A →ₗ[k] B) :
+  ((Rep.ihom A).obj B).ρ g x = (B.ρ g) ∘ₗ x ∘ₗ (A.ρ g⁻¹) := rfl
+
+/-- Given a `k`-linear `G`-representation `A`, this is the Hom-set bijection in the adjunction
+`A ⊗ - ⊣ ihom(A, -)`. It sends `f : A ⊗ B ⟶ C` to a `Rep k G` morphism defined by currying the
+`k`-linear map underlying `f`, giving a map `A →ₗ[k] B →ₗ[k] C`, then flipping the arguments. -/
+@[simps] protected def hom_equiv (A B C : Rep k G) : (A ⊗ B ⟶ C) ≃ (B ⟶ (Rep.ihom A).obj C) :=
+{ to_fun := λ f,
+  { hom := (tensor_product.curry f.hom).flip,
+    comm' := λ g,
+      begin
+        refine linear_map.ext (λ x, linear_map.ext (λ y, _)),
+        change f.hom (_ ⊗ₜ[k] _) = C.ρ g (f.hom (_ ⊗ₜ[k] _)),
+        rw [←hom_comm_apply],
+        change _ = f.hom ((A.ρ g * A.ρ g⁻¹) y ⊗ₜ[k] _),
+        simpa only [←map_mul, mul_inv_self, map_one],
+      end },
+  inv_fun := λ f,
+  { hom := tensor_product.uncurry k _ _ _ f.hom.flip,
+    comm' := λ g, tensor_product.ext' (λ x y,
+      begin
+        dsimp only [monoidal_category.tensor_left_obj, Module.comp_def, linear_map.comp_apply,
+          tensor_rho, Module.monoidal_category.hom_apply, tensor_product.map_tmul],
+        simp only [tensor_product.uncurry_apply f.hom.flip, linear_map.flip_apply,
+          Action_ρ_eq_ρ, hom_comm_apply f g y, Rep.ihom_obj_ρ_apply, linear_map.comp_apply,
+          ρ_inv_self_apply],
+      end) },
+  left_inv := λ f, Action.hom.ext _ _ (tensor_product.ext' (λ x y, rfl)),
+  right_inv := λ f, by ext; refl }
+
+instance : monoidal_closed (Rep k G) :=
+{ closed' := λ A,
+  { is_adj :=
+    { right := Rep.ihom A,
+      adj := adjunction.mk_of_hom_equiv
+      { hom_equiv := Rep.hom_equiv A,
+        hom_equiv_naturality_left_symm' := λ X Y Z f g, by ext; refl,
+        hom_equiv_naturality_right' := λ X Y Z f g, by ext; refl } } } }
+
+@[simp] lemma ihom_obj_ρ_def (A B : Rep k G) : ((ihom A).obj B).ρ = ((Rep.ihom A).obj B).ρ := rfl
+
+@[simp] lemma hom_equiv_def (A B C : Rep k G) :
+  (ihom.adjunction A).hom_equiv B C = Rep.hom_equiv A B C := rfl
+
+@[simp] lemma ihom_ev_app_hom (A B : Rep k G) :
+  Action.hom.hom ((ihom.ev A).app B)
+    = tensor_product.uncurry _ _ _ _ linear_map.id.flip :=
+by ext; refl
+
+@[simp] lemma ihom_coev_app_hom (A B : Rep k G) :
+  Action.hom.hom ((ihom.coev A).app B) = (tensor_product.mk _ _ _).flip :=
+by ext; refl
+
+variables (A B C)
+
+/-- There is a `k`-linear isomorphism between the sets of representation morphisms`Hom(A ⊗ B, C)`
+and `Hom(B, Homₖ(A, C))`. -/
+def monoidal_closed.linear_hom_equiv :
+  (A ⊗ B ⟶ C) ≃ₗ[k] (B ⟶ (A ⟶[Rep k G] C)) :=
+{ map_add' := λ f g, rfl,
+  map_smul' := λ r f, rfl, ..(ihom.adjunction A).hom_equiv _ _ }
+
+/-- There is a `k`-linear isomorphism between the sets of representation morphisms`Hom(A ⊗ B, C)`
+and `Hom(A, Homₖ(B, C))`. -/
+def monoidal_closed.linear_hom_equiv_comm :
+  (A ⊗ B ⟶ C) ≃ₗ[k] (A ⟶ (B ⟶[Rep k G] C)) :=
+(linear.hom_congr k (β_ A B) (iso.refl _)) ≪≫ₗ
+  monoidal_closed.linear_hom_equiv _ _ _
+
+variables {A B C}
+
+@[simp] lemma monoidal_closed.linear_hom_equiv_hom (f : A ⊗ B ⟶ C) :
+  (monoidal_closed.linear_hom_equiv A B C f).hom =
+  (tensor_product.curry f.hom).flip := rfl
+
+@[simp] lemma monoidal_closed.linear_hom_equiv_comm_hom (f : A ⊗ B ⟶ C) :
+  (monoidal_closed.linear_hom_equiv_comm A B C f).hom =
+ tensor_product.curry f.hom := rfl
+
+@[simp] lemma monoidal_closed.linear_hom_equiv_symm_hom (f : B ⟶ (A ⟶[Rep k G] C)) :
+  ((monoidal_closed.linear_hom_equiv A B C).symm f).hom =
+  tensor_product.uncurry k A B C f.hom.flip := rfl
+
+@[simp] lemma monoidal_closed.linear_hom_equiv_comm_symm_hom (f : A ⟶ (B ⟶[Rep k G] C)) :
+  ((monoidal_closed.linear_hom_equiv_comm A B C).symm f).hom =
+  tensor_product.uncurry k A B C f.hom :=
+by ext; refl
+
+end monoidal_closed
 end Rep
+namespace representation
+variables {k G : Type u} [comm_ring k] [monoid G] {V W : Type u}
+  [add_comm_group V] [add_comm_group W] [module k V] [module k W]
+  (ρ : representation k G V) (τ : representation k G W)
 
+/-- Tautological isomorphism to help Lean in typechecking. -/
+def Rep_of_tprod_iso : Rep.of (ρ.tprod τ) ≅ Rep.of ρ ⊗ Rep.of τ := iso.refl _
+
+lemma Rep_of_tprod_iso_apply (x : tensor_product k V W) :
+  (Rep_of_tprod_iso ρ τ).hom.hom x = x := rfl
+
+lemma Rep_of_tprod_iso_inv_apply (x : tensor_product k V W) :
+  (Rep_of_tprod_iso ρ τ).inv.hom x = x := rfl
+
+end representation
+/-!
+# The categorical equivalence `Rep k G ≌ Module.{u} (monoid_algebra k G)`.
+-/
 namespace Rep
 variables {k G : Type u} [comm_ring k] [monoid G]
 
@@ -71,4 +381,109 @@ example : symmetric_category (Rep k G) := by apply_instance
 example : monoidal_preadditive (Rep k G) := by apply_instance
 example : monoidal_linear k (Rep k G) := by apply_instance
 
+noncomputable theory
+
+/-- Auxilliary lemma for `to_Module_monoid_algebra`. -/
+lemma to_Module_monoid_algebra_map_aux {k G : Type*} [comm_ring k] [monoid G]
+  (V W : Type*) [add_comm_group V] [add_comm_group W] [module k V] [module k W]
+  (ρ : G →* V →ₗ[k] V) (σ : G →* W →ₗ[k] W)
+  (f : V →ₗ[k] W) (w : ∀ (g : G), f.comp (ρ g) = (σ g).comp f)
+  (r : monoid_algebra k G) (x : V) :
+  f ((((monoid_algebra.lift k G (V →ₗ[k] V)) ρ) r) x) =
+    (((monoid_algebra.lift k G (W →ₗ[k] W)) σ) r) (f x) :=
+begin
+  apply monoid_algebra.induction_on r,
+  { intro g,
+    simp only [one_smul, monoid_algebra.lift_single, monoid_algebra.of_apply],
+    exact linear_map.congr_fun (w g) x, },
+  { intros g h gw hw, simp only [map_add, add_left_inj, linear_map.add_apply, hw, gw], },
+  { intros r g w,
+    simp only [alg_hom.map_smul, w, ring_hom.id_apply,
+      linear_map.smul_apply, linear_map.map_smulₛₗ], }
+end
+
+/-- Auxilliary definition for `to_Module_monoid_algebra`. -/
+def to_Module_monoid_algebra_map {V W : Rep k G} (f : V ⟶ W) :
+  Module.of (monoid_algebra k G) V.ρ.as_module ⟶ Module.of (monoid_algebra k G) W.ρ.as_module :=
+{ map_smul' := λ r x, to_Module_monoid_algebra_map_aux V.V W.V V.ρ W.ρ f.hom f.comm r x,
+  ..f.hom, }
+
+/-- Functorially convert a representation of `G` into a module over `monoid_algebra k G`. -/
+def to_Module_monoid_algebra : Rep k G ⥤ Module.{u} (monoid_algebra k G) :=
+{ obj := λ V, Module.of _ V.ρ.as_module ,
+  map := λ V W f, to_Module_monoid_algebra_map f, }
+
+/-- Functorially convert a module over `monoid_algebra k G` into a representation of `G`. -/
+def of_Module_monoid_algebra : Module.{u} (monoid_algebra k G) ⥤ Rep k G :=
+{ obj := λ M, Rep.of (representation.of_module k G M),
+  map := λ M N f,
+  { hom :=
+    { map_smul' := λ r x, f.map_smul (algebra_map k _ r) x,
+      ..f },
+    comm' := λ g, by { ext, apply f.map_smul, }, }, }.
+
+lemma of_Module_monoid_algebra_obj_coe (M : Module.{u} (monoid_algebra k G)) :
+  (of_Module_monoid_algebra.obj M : Type u) = restrict_scalars k (monoid_algebra k G) M := rfl
+
+lemma of_Module_monoid_algebra_obj_ρ (M : Module.{u} (monoid_algebra k G)) :
+  (of_Module_monoid_algebra.obj M).ρ = representation.of_module k G M := rfl
+
+/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
+def counit_iso_add_equiv {M : Module.{u} (monoid_algebra k G)} :
+  ((of_Module_monoid_algebra ⋙ to_Module_monoid_algebra).obj M) ≃+ M :=
+begin
+  dsimp [of_Module_monoid_algebra, to_Module_monoid_algebra],
+  refine (representation.of_module k G ↥M).as_module_equiv.trans (restrict_scalars.add_equiv _ _ _),
+end
+
+/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
+def unit_iso_add_equiv {V : Rep k G} :
+  V ≃+ ((to_Module_monoid_algebra ⋙ of_Module_monoid_algebra).obj V) :=
+begin
+  dsimp [of_Module_monoid_algebra, to_Module_monoid_algebra],
+  refine V.ρ.as_module_equiv.symm.trans _,
+  exact (restrict_scalars.add_equiv _ _ _).symm,
+end
+
+/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
+def counit_iso (M : Module.{u} (monoid_algebra k G)) :
+  (of_Module_monoid_algebra ⋙ to_Module_monoid_algebra).obj M ≅ M :=
+linear_equiv.to_Module_iso'
+{ map_smul' := λ r x, begin
+    dsimp [counit_iso_add_equiv],
+    simp,
+  end,
+  ..counit_iso_add_equiv, }
+
+lemma unit_iso_comm (V : Rep k G) (g : G) (x : V) :
+  unit_iso_add_equiv (((V.ρ) g).to_fun x) =
+    (((of_Module_monoid_algebra.obj (to_Module_monoid_algebra.obj V)).ρ) g).to_fun
+      (unit_iso_add_equiv x) :=
+begin
+  dsimp [unit_iso_add_equiv, of_Module_monoid_algebra, to_Module_monoid_algebra],
+  simp only [add_equiv.apply_eq_iff_eq, add_equiv.apply_symm_apply,
+    representation.as_module_equiv_symm_map_rho, representation.of_module_as_module_act],
+end
+
+/-- Auxilliary definition for `equivalence_Module_monoid_algebra`. -/
+def unit_iso (V : Rep k G) :
+  V ≅ ((to_Module_monoid_algebra ⋙ of_Module_monoid_algebra).obj V) :=
+Action.mk_iso (linear_equiv.to_Module_iso'
+{ map_smul' := λ r x, begin
+    dsimp [unit_iso_add_equiv],
+    simp only [representation.as_module_equiv_symm_map_smul,
+      restrict_scalars.add_equiv_symm_map_algebra_map_smul],
+  end,
+  ..unit_iso_add_equiv, })
+  (λ g, by { ext, apply unit_iso_comm, })
+
+/-- The categorical equivalence `Rep k G ≌ Module (monoid_algebra k G)`. -/
+def equivalence_Module_monoid_algebra : Rep k G ≌ Module.{u} (monoid_algebra k G) :=
+{ functor := to_Module_monoid_algebra,
+  inverse := of_Module_monoid_algebra,
+  unit_iso := nat_iso.of_components (λ V, unit_iso V) (by tidy),
+  counit_iso := nat_iso.of_components (λ M, counit_iso M) (by tidy), }
+
+-- TODO Verify that the equivalence with `Module (monoid_algebra k G)` is a monoidal functor.
+
 end Rep
diff --git a/src/representation_theory/basic.lean b/src/representation_theory/basic.lean
index a3c22e6f7e513..8d13447b4d399 100644
--- a/src/representation_theory/basic.lean
+++ b/src/representation_theory/basic.lean
@@ -6,13 +6,16 @@ Authors: Antoine Labelle
 import algebra.module.basic
 import algebra.module.linear_map
 import algebra.monoid_algebra.basic
-import linear_algebra.trace
 import linear_algebra.dual
-import linear_algebra.free_module.basic
+import linear_algebra.contraction
+import ring_theory.tensor_product
 
 /-!
 # Monoid representations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file introduces monoid representations and their characters and defines a few ways to construct
 representations.
 
@@ -47,15 +50,15 @@ namespace representation
 
 section trivial
 
-variables {k G V : Type*} [comm_semiring k] [monoid G] [add_comm_monoid V] [module k V]
+variables (k : Type*) {G V : Type*} [comm_semiring k] [monoid G] [add_comm_monoid V] [module k V]
 
 /--
-The trivial representation of `G` on the one-dimensional module `k`.
+The trivial representation of `G` on a `k`-module V.
 -/
-def trivial : representation k G k := 1
+def trivial : representation k G V := 1
 
 @[simp]
-lemma trivial_def (g : G) (v : k) : trivial g v = v := rfl
+lemma trivial_def (g : G) (v : V) : trivial k g v = v := rfl
 
 end trivial
 
@@ -69,72 +72,227 @@ A `k`-linear representation of `G` on `V` can be thought of as
 an algebra map from `monoid_algebra k G` into the `k`-linear endomorphisms of `V`.
 -/
 noncomputable def as_algebra_hom : monoid_algebra k G →ₐ[k] (module.End k V) :=
-  (lift k G _) ρ
+(lift k G _) ρ
 
-lemma as_algebra_hom_def :
-  as_algebra_hom ρ = (lift k G _) ρ := rfl
+lemma as_algebra_hom_def : as_algebra_hom ρ = (lift k G _) ρ :=
+rfl
 
 @[simp]
-lemma as_algebra_hom_single (g : G):
+lemma as_algebra_hom_single (g : G) (r : k) :
+  (as_algebra_hom ρ (finsupp.single g r)) = r • ρ g :=
+by simp only [as_algebra_hom_def, monoid_algebra.lift_single]
+
+lemma as_algebra_hom_single_one (g : G):
   (as_algebra_hom ρ (finsupp.single g 1)) = ρ g :=
-by simp only [as_algebra_hom_def, monoid_algebra.lift_single, one_smul]
+by simp
 
-lemma as_algebra_hom_of (g : G):
+lemma as_algebra_hom_of (g : G) :
   (as_algebra_hom ρ (of k G g)) = ρ g :=
-by simp only [monoid_algebra.of_apply, as_algebra_hom_single]
+by simp only [monoid_algebra.of_apply, as_algebra_hom_single, one_smul]
+
+/--
+If `ρ : representation k G V`, then `ρ.as_module` is a type synonym for `V`,
+which we equip with an instance `module (monoid_algebra k G) ρ.as_module`.
+
+You should use `as_module_equiv : ρ.as_module ≃+ V` to translate terms.
+-/
+@[nolint unused_arguments, derive [add_comm_monoid, module (module.End k V)]]
+def as_module (ρ : representation k G V) := V
+
+instance : inhabited ρ.as_module := ⟨0⟩
 
 /--
 A `k`-linear representation of `G` on `V` can be thought of as
 a module over `monoid_algebra k G`.
 -/
-noncomputable def as_module : module (monoid_algebra k G) V :=
-  module.comp_hom V (as_algebra_hom ρ).to_ring_hom
+noncomputable instance as_module_module : module (monoid_algebra k G) ρ.as_module :=
+module.comp_hom V (as_algebra_hom ρ).to_ring_hom
 
-end monoid_algebra
+/--
+The additive equivalence from the `module (monoid_algebra k G)` to the original vector space
+of the representative.
 
-section group
+This is just the identity, but it is helpful for typechecking and keeping track of instances.
+-/
+def as_module_equiv : ρ.as_module ≃+ V :=
+add_equiv.refl _
 
-variables {k G V : Type*} [comm_semiring k] [group G] [add_comm_monoid V] [module k V]
-variables (ρ : representation k G V)
+@[simp]
+lemma as_module_equiv_map_smul (r : monoid_algebra k G) (x : ρ.as_module) :
+  ρ.as_module_equiv (r • x) = ρ.as_algebra_hom r (ρ.as_module_equiv x) :=
+rfl
+
+@[simp]
+lemma as_module_equiv_symm_map_smul (r : k) (x : V) :
+  ρ.as_module_equiv.symm (r • x) =
+    algebra_map k (monoid_algebra k G) r • (ρ.as_module_equiv.symm x) :=
+begin
+  apply_fun ρ.as_module_equiv,
+  simp,
+end
+
+@[simp]
+lemma as_module_equiv_symm_map_rho (g : G) (x : V) :
+  ρ.as_module_equiv.symm (ρ g x) = monoid_algebra.of k G g • (ρ.as_module_equiv.symm x) :=
+begin
+  apply_fun ρ.as_module_equiv,
+  simp,
+end
 
 /--
-When `G` is a group, a `k`-linear representation of `G` on `V` can be thought of as
-a group homomorphism from `G` into the invertible `k`-linear endomorphisms of `V`.
+Build a `representation k G M` from a `[module (monoid_algebra k G) M]`.
+
+This version is not always what we want, as it relies on an existing `[module k M]`
+instance, along with a `[is_scalar_tower k (monoid_algebra k G) M]` instance.
+
+We remedy this below in `of_module`
+(with the tradeoff that the representation is defined
+only on a type synonym of the original module.)
 -/
-def as_group_hom : G →* units (V →ₗ[k] V) :=
-  monoid_hom.to_hom_units ρ
+noncomputable
+def of_module' (M : Type*) [add_comm_monoid M] [module k M] [module (monoid_algebra k G) M]
+  [is_scalar_tower k (monoid_algebra k G) M] : representation k G M :=
+(monoid_algebra.lift k G (M →ₗ[k] M)).symm (algebra.lsmul k M)
 
-lemma as_group_hom_apply (g : G) : ↑(as_group_hom ρ g) = ρ g :=
-by simp only [as_group_hom, monoid_hom.coe_to_hom_units]
+section
+variables (k G) (M : Type*) [add_comm_monoid M] [module (monoid_algebra k G) M]
 
-end group
+/--
+Build a `representation` from a `[module (monoid_algebra k G) M]`.
 
-section character
+Note that the representation is built on `restrict_scalars k (monoid_algebra k G) M`,
+rather than on `M` itself.
+-/
+noncomputable
+def of_module :
+  representation k G (restrict_scalars k (monoid_algebra k G) M) :=
+(monoid_algebra.lift k G
+  (restrict_scalars k (monoid_algebra k G) M →ₗ[k] restrict_scalars k (monoid_algebra k G) M)).symm
+  (restrict_scalars.lsmul k (monoid_algebra k G) M)
 
-variables {k G V : Type*} [comm_ring k] [group G] [add_comm_group V] [module k V]
-variables (ρ : representation k G V)
+/-!
+## `of_module` and `as_module` are inverses.
 
-/--
-The character associated to a representation of `G`, which as a map `G → k`
-sends each element to the trace of the corresponding linear map.
+This requires a little care in both directions:
+this is a categorical equivalence, not an isomorphism.
+
+See `Rep.equivalence_Module_monoid_algebra` for the full statement.
+
+Starting with `ρ : representation k G V`, converting to a module and back again
+we have a `representation k G (restrict_scalars k (monoid_algebra k G) ρ.as_module)`.
+To compare these, we use the composition of `restrict_scalars_add_equiv` and `ρ.as_module_equiv`.
+
+Similarly, starting with `module (monoid_algebra k G) M`,
+after we convert to a representation and back to a module,
+we have `module (monoid_algebra k G) (restrict_scalars k (monoid_algebra k G) M)`.
 -/
+
+@[simp] lemma of_module_as_algebra_hom_apply_apply
+  (r : monoid_algebra k G) (m : restrict_scalars k (monoid_algebra k G) M) :
+  ((((of_module k G M).as_algebra_hom) r) m) =
+    (restrict_scalars.add_equiv _ _ _).symm (r • restrict_scalars.add_equiv _ _ _ m) :=
+begin
+  apply monoid_algebra.induction_on r,
+  { intros g,
+    simp only [one_smul, monoid_algebra.lift_symm_apply, monoid_algebra.of_apply,
+      representation.as_algebra_hom_single, representation.of_module,
+      add_equiv.apply_eq_iff_eq, restrict_scalars.lsmul_apply_apply], },
+  { intros f g fw gw,
+    simp only [fw, gw, map_add, add_smul, linear_map.add_apply], },
+  { intros r f w,
+    simp only [w, alg_hom.map_smul, linear_map.smul_apply,
+      restrict_scalars.add_equiv_symm_map_smul_smul], }
+end
+
 @[simp]
-noncomputable def character (g : G) : k := trace k V (ρ g)
+lemma of_module_as_module_act (g : G) (x : restrict_scalars k (monoid_algebra k G) ρ.as_module) :
+  of_module k G (ρ.as_module) g x =
+    (restrict_scalars.add_equiv _ _ _).symm ((ρ.as_module_equiv).symm
+      (ρ g (ρ.as_module_equiv (restrict_scalars.add_equiv _ _ _ x)))) :=
+begin
+  apply_fun restrict_scalars.add_equiv _ _ ρ.as_module using
+    (restrict_scalars.add_equiv _ _ _).injective,
+  dsimp [of_module, restrict_scalars.lsmul_apply_apply],
+  simp,
+end
+
+lemma smul_of_module_as_module (r : monoid_algebra k G)
+  (m : (of_module k G M).as_module) :
+   (restrict_scalars.add_equiv _ _ _) ((of_module k G M).as_module_equiv (r • m)) =
+     r • (restrict_scalars.add_equiv _ _ _) ((of_module k G M).as_module_equiv m) :=
+by { dsimp, simp only [add_equiv.apply_symm_apply, of_module_as_algebra_hom_apply_apply], }
+
+end
+
+end monoid_algebra
+
+section add_comm_group
+
+variables {k G V : Type*} [comm_ring k] [monoid G] [I : add_comm_group V] [module k V]
+variables (ρ : representation k G V)
+
+instance : add_comm_group ρ.as_module := I
+
+end add_comm_group
+
+section mul_action
+variables (k : Type*) [comm_semiring k] (G : Type*) [monoid G] (H : Type*) [mul_action G H]
+
+/-- A `G`-action on `H` induces a representation `G →* End(k[H])` in the natural way. -/
+noncomputable def of_mul_action : representation k G (H →₀ k) :=
+{ to_fun := λ g, finsupp.lmap_domain k k ((•) g),
+  map_one' := by { ext x y, dsimp, simp },
+  map_mul' := λ x y, by { ext z w, simp [mul_smul] }}
+
+variables {k G H}
+
+lemma of_mul_action_def (g : G) : of_mul_action k G H g = finsupp.lmap_domain k k ((•) g) := rfl
+
+lemma of_mul_action_single (g : G) (x : H) (r : k) :
+  of_mul_action k G H g (finsupp.single x r) = finsupp.single (g • x) r :=
+finsupp.map_domain_single
+
+end mul_action
+section group
+
+variables {k G V : Type*} [comm_semiring k] [group G] [add_comm_monoid V] [module k V]
+variables (ρ : representation k G V)
+
+@[simp] lemma of_mul_action_apply {H : Type*} [mul_action G H]
+  (g : G) (f : H →₀ k) (h : H) : of_mul_action k G H g f h = f (g⁻¹ • h) :=
+begin
+  conv_lhs { rw ← smul_inv_smul g h, },
+  let h' := g⁻¹ • h,
+  change of_mul_action k G H g f (g • h') = f h',
+  have hg : function.injective ((•) g : H → H), { intros h₁ h₂, simp, },
+  simp only [of_mul_action_def, finsupp.lmap_domain_apply, finsupp.map_domain_apply, hg],
+end
 
-theorem char_mul_comm (g : G) (h : G) : character ρ (h * g) = character ρ (g * h) :=
-by simp only [trace_mul_comm, character, map_mul]
+lemma of_mul_action_self_smul_eq_mul
+  (x : monoid_algebra k G) (y : (of_mul_action k G G).as_module) :
+  x • y = (x * y : monoid_algebra k G) :=
+x.induction_on (λ g, by show as_algebra_hom _ _ _ = _; ext; simp)
+  (λ x y hx hy, by simp only [hx, hy, add_mul, add_smul])
+  (λ r x hx, by show as_algebra_hom _ _ _ = _; simpa [←hx])
 
-/-- The character of a representation is constant on conjugacy classes. -/
-theorem char_conj (g : G) (h : G) : (character ρ) (h * g * h⁻¹) = (character ρ) g :=
-by simp only [character, ←as_group_hom_apply, map_mul, map_inv, trace_conj]
+/-- If we equip `k[G]` with the `k`-linear `G`-representation induced by the left regular action of
+`G` on itself, the resulting object is isomorphic as a `k[G]`-module to `k[G]` with its natural
+`k[G]`-module structure. -/
+@[simps] noncomputable def of_mul_action_self_as_module_equiv :
+  (of_mul_action k G G).as_module ≃ₗ[monoid_algebra k G] monoid_algebra k G :=
+{ map_smul' := of_mul_action_self_smul_eq_mul, ..as_module_equiv _ }
 
-variables [nontrivial k] [module.free k V] [module.finite k V]
+/--
+When `G` is a group, a `k`-linear representation of `G` on `V` can be thought of as
+a group homomorphism from `G` into the invertible `k`-linear endomorphisms of `V`.
+-/
+def as_group_hom : G →* units (V →ₗ[k] V) :=
+monoid_hom.to_hom_units ρ
 
-/-- The evaluation of the character at the identity is the dimension of the representation. -/
-theorem char_one : character ρ 1 = finite_dimensional.finrank k V :=
-by simp only [character, map_one, trace_one]
+lemma as_group_hom_apply (g : G) : ↑(as_group_hom ρ g) = ρ g :=
+by simp only [as_group_hom, monoid_hom.coe_to_hom_units]
 
-end character
+end group
 
 section tensor_product
 
@@ -153,11 +311,32 @@ def tprod : representation k G (V ⊗[k] W) :=
   map_one' := by simp only [map_one, tensor_product.map_one],
   map_mul' := λ g h, by simp only [map_mul, tensor_product.map_mul] }
 
-notation ρV ` ⊗ ` ρW := tprod ρV ρW
+local notation ρV ` ⊗ ` ρW := tprod ρV ρW
 
 @[simp]
 lemma tprod_apply (g : G) : (ρV ⊗ ρW) g = tensor_product.map (ρV g) (ρW g) := rfl
 
+lemma smul_tprod_one_as_module (r : monoid_algebra k G) (x : V) (y : W) :
+  (r • (x ⊗ₜ y) : (ρV.tprod 1).as_module) = (r • x : ρV.as_module) ⊗ₜ y :=
+begin
+  show as_algebra_hom _ _ _ = as_algebra_hom _ _ _ ⊗ₜ _,
+  simp only [as_algebra_hom_def, monoid_algebra.lift_apply,
+    tprod_apply, monoid_hom.one_apply, linear_map.finsupp_sum_apply,
+    linear_map.smul_apply, tensor_product.map_tmul, linear_map.one_apply],
+  simp only [finsupp.sum, tensor_product.sum_tmul],
+  refl,
+end
+
+lemma smul_one_tprod_as_module (r : monoid_algebra k G) (x : V) (y : W) :
+  (r • (x ⊗ₜ y) : ((1 : representation k G V).tprod ρW).as_module) = x ⊗ₜ (r • y : ρW.as_module) :=
+begin
+  show as_algebra_hom _ _ _ = _ ⊗ₜ as_algebra_hom _ _ _,
+  simp only [as_algebra_hom_def, monoid_algebra.lift_apply,
+    tprod_apply, monoid_hom.one_apply, linear_map.finsupp_sum_apply,
+    linear_map.smul_apply, tensor_product.map_tmul, linear_map.one_apply],
+  simp only [finsupp.sum, tensor_product.tmul_sum, tensor_product.tmul_smul],
+end
+
 end tensor_product
 
 section linear_hom
@@ -176,10 +355,11 @@ def lin_hom : representation k G (V →ₗ[k] W) :=
     map_add' := λ f₁ f₂, by simp_rw [add_comp, comp_add],
     map_smul' := λ r f, by simp_rw [ring_hom.id_apply, smul_comp, comp_smul]},
   map_one' := linear_map.ext $ λ x,
-    by simp_rw [coe_mk, one_inv, map_one, one_apply, one_eq_id, comp_id, id_comp],
+    by simp_rw [coe_mk, inv_one, map_one, one_apply, one_eq_id, comp_id, id_comp],
   map_mul' := λ g h,  linear_map.ext $ λ x,
     by simp_rw [coe_mul, coe_mk, function.comp_apply, mul_inv_rev, map_mul, mul_eq_comp,
                 comp_assoc ]}
+
 @[simp]
 lemma lin_hom_apply (g : G) (f : V →ₗ[k] W) : (lin_hom ρV ρW) g f = (ρW g) ∘ₗ f ∘ₗ (ρV g⁻¹) := rfl
 
@@ -194,12 +374,26 @@ def dual : representation k G (module.dual k V) :=
     map_smul' := λ r f,
       by {ext, simp only [coe_comp, function.comp_app, smul_apply, ring_hom.id_apply]} },
   map_one' :=
-    by {ext, simp only [coe_comp, function.comp_app, map_one, one_inv, coe_mk, one_apply]},
+    by {ext, simp only [coe_comp, function.comp_app, map_one, inv_one, coe_mk, one_apply]},
   map_mul' := λ g h,
     by {ext, simp only [coe_comp, function.comp_app, mul_inv_rev, map_mul, coe_mk, mul_apply]}}
 
 @[simp]
-lemma dual_apply (g : G) (f : module.dual k V) : (dual ρV) g f = f ∘ₗ (ρV g⁻¹) := rfl
+lemma dual_apply (g : G) : (dual ρV) g = module.dual.transpose (ρV g⁻¹) := rfl
+
+/--
+Given $k$-modules $V, W$, there is a homomorphism $φ : V^* ⊗ W → Hom_k(V, W)$
+(implemented by `linear_algebra.contraction.dual_tensor_hom`).
+Given representations of $G$ on $V$ and $W$,there are representations of $G$ on  $V^* ⊗ W$ and on
+$Hom_k(V, W)$.
+This lemma says that $φ$ is $G$-linear.
+-/
+lemma dual_tensor_hom_comm (g : G) :
+  (dual_tensor_hom k V W) ∘ₗ (tensor_product.map (ρV.dual g) (ρW g)) =
+  (lin_hom ρV ρW) g ∘ₗ (dual_tensor_hom k V W) :=
+begin
+  ext, simp [module.dual.transpose_apply],
+end
 
 end linear_hom
 
diff --git a/src/representation_theory/character.lean b/src/representation_theory/character.lean
new file mode 100644
index 0000000000000..07ddd2fbf264d
--- /dev/null
+++ b/src/representation_theory/character.lean
@@ -0,0 +1,118 @@
+/-
+Copyright (c) 2022 Antoine Labelle. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Antoine Labelle
+-/
+import representation_theory.fdRep
+import linear_algebra.trace
+import representation_theory.invariants
+
+/-!
+# Characters of representations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file introduces characters of representation and proves basic lemmas about how characters
+behave under various operations on representations.
+
+# TODO
+* Once we have the monoidal closed structure on `fdRep k G` and a better API for the rigid
+structure, `char_dual` and `char_lin_hom` should probably be stated in terms of `Vᘁ` and `ihom V W`.
+-/
+
+noncomputable theory
+
+universes u
+
+open category_theory linear_map category_theory.monoidal_category representation finite_dimensional
+open_locale big_operators
+
+variables {k : Type u} [field k]
+
+namespace fdRep
+
+section monoid
+
+variables {G : Type u} [monoid G]
+
+/-- The character of a representation `V : fdRep k G` is the function associating to `g : G` the
+trace of the linear map `V.ρ g`.-/
+def character (V : fdRep k G) (g : G) := linear_map.trace k V (V.ρ g)
+
+lemma char_mul_comm (V : fdRep k G) (g : G) (h : G) : V.character (h * g) = V.character (g * h) :=
+by simp only [trace_mul_comm, character, map_mul]
+
+@[simp] lemma char_one  (V : fdRep k G) : V.character 1 = finite_dimensional.finrank k V :=
+by simp only [character, map_one, trace_one]
+
+/-- The character is multiplicative under the tensor product. -/
+@[simp] lemma char_tensor (V W : fdRep k G) : (V ⊗ W).character = V.character * W.character :=
+by { ext g, convert trace_tensor_product' (V.ρ g) (W.ρ g) }
+
+/-- The character of isomorphic representations is the same. -/
+lemma char_iso  {V W : fdRep k G} (i : V ≅ W) : V.character = W.character :=
+by { ext g, simp only [character, fdRep.iso.conj_ρ i], exact (trace_conj' (V.ρ g) _).symm }
+
+end monoid
+
+section group
+
+variables {G : Type u} [group G]
+
+/-- The character of a representation is constant on conjugacy classes. -/
+@[simp] lemma char_conj (V : fdRep k G) (g : G) (h : G) :
+  V.character (h * g * h⁻¹) = V.character g :=
+by rw [char_mul_comm, inv_mul_cancel_left]
+
+@[simp] lemma char_dual (V : fdRep k G) (g : G) : (of (dual V.ρ)).character g = V.character g⁻¹ :=
+  trace_transpose' (V.ρ g⁻¹)
+
+@[simp] lemma char_lin_hom (V W : fdRep k G) (g : G) :
+  (of (lin_hom V.ρ W.ρ)).character g = (V.character g⁻¹) * (W.character g) :=
+by rw [←char_iso (dual_tensor_iso_lin_hom _ _), char_tensor, pi.mul_apply, char_dual]
+
+variables [fintype G] [invertible (fintype.card G : k)]
+
+theorem average_char_eq_finrank_invariants (V : fdRep k G) :
+  ⅟(fintype.card G : k) • ∑ g : G, V.character g = finrank k (invariants V.ρ) :=
+by { rw ←(is_proj_average_map V.ρ).trace, simp [character, group_algebra.average, _root_.map_sum], }
+
+end group
+
+section orthogonality
+
+variables {G : Group.{u}} [is_alg_closed k]
+
+open_locale classical
+
+variables [fintype G] [invertible (fintype.card G : k)]
+
+/-- Orthogonality of characters for irreducible representations of finite group over an
+algebraically closed field whose characteristic doesn't divide the order of the group. -/
+lemma char_orthonormal (V W : fdRep k G) [simple V] [simple W] :
+  ⅟(fintype.card G : k) • ∑ g : G, V.character g * W.character g⁻¹ =
+  if nonempty (V ≅ W) then ↑1 else ↑0 :=
+begin
+  -- First, we can rewrite the summand `V.character g * W.character g⁻¹` as the character
+  -- of the representation `V ⊗ W* ≅ Hom(W, V)` applied to `g`.
+  conv in (V.character _ * W.character _)
+  { rw [mul_comm, ←char_dual, ←pi.mul_apply, ←char_tensor],
+    rw [char_iso (fdRep.dual_tensor_iso_lin_hom W.ρ V)], } ,
+
+  -- The average over the group of the character of a representation equals the dimension of the
+  -- space of invariants.
+  rw average_char_eq_finrank_invariants,
+  rw [show (of (lin_hom W.ρ V.ρ)).ρ = lin_hom W.ρ V.ρ, from fdRep.of_ρ (lin_hom W.ρ V.ρ)],
+
+  -- The space of invariants of `Hom(W, V)` is the subspace of `G`-equivariant linear maps,
+  -- `Hom_G(W, V)`.
+  rw (lin_hom.invariants_equiv_fdRep_hom W V).finrank_eq,
+
+  -- By Schur's Lemma, the dimension of `Hom_G(W, V)` is `1` is `V ≅ W` and `0` otherwise.
+  rw_mod_cast [finrank_hom_simple_simple W V, iso.nonempty_iso_symm],
+end
+
+end orthogonality
+
+end fdRep
diff --git a/src/representation_theory/fdRep.lean b/src/representation_theory/fdRep.lean
new file mode 100644
index 0000000000000..70cef6ac6b148
--- /dev/null
+++ b/src/representation_theory/fdRep.lean
@@ -0,0 +1,168 @@
+/-
+Copyright (c) 2022 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Scott Morrison
+-/
+import representation_theory.Rep
+import algebra.category.fgModule.limits
+import category_theory.preadditive.schur
+import representation_theory.basic
+
+/-!
+# `fdRep k G` is the category of finite dimensional `k`-linear representations of `G`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+If `V : fdRep k G`, there is a coercion that allows you to treat `V` as a type,
+and this type comes equipped with `module k V` and `finite_dimensional k V` instances.
+Also `V.ρ` gives the homomorphism `G →* (V →ₗ[k] V)`.
+
+Conversely, given a homomorphism `ρ : G →* (V →ₗ[k] V)`,
+you can construct the bundled representation as `Rep.of ρ`.
+
+We verify that `fdRep k G` is a `k`-linear monoidal category, and rigid when `G` is a group.
+
+`fdRep k G` has all finite limits.
+
+## TODO
+* `fdRep k G ≌ full_subcategory (finite_dimensional k)`
+* Upgrade the right rigid structure to a rigid structure
+  (this just needs to be done for `fgModule`).
+* `fdRep k G` has all finite colimits.
+* `fdRep k G` is abelian.
+* `fdRep k G ≌ fgModule (monoid_algebra k G)`.
+
+-/
+
+universes u
+
+open category_theory
+open category_theory.limits
+
+/-- The category of finite dimensional `k`-linear representations of a monoid `G`. -/
+@[derive [large_category, concrete_category, preadditive, has_finite_limits]]
+abbreviation fdRep (k G : Type u) [field k] [monoid G] :=
+Action (fgModule.{u} k) (Mon.of G)
+
+namespace fdRep
+
+variables {k G : Type u} [field k] [monoid G]
+
+instance : linear k (fdRep k G) := by apply_instance
+
+instance : has_coe_to_sort (fdRep k G) (Type u) := concrete_category.has_coe_to_sort _
+
+instance (V : fdRep k G) : add_comm_group V :=
+by { change add_comm_group ((forget₂ (fdRep k G) (fgModule k)).obj V).obj, apply_instance, }
+
+instance (V : fdRep k G) : module k V :=
+by { change module k ((forget₂ (fdRep k G) (fgModule k)).obj V).obj, apply_instance, }
+
+instance (V : fdRep k G) : finite_dimensional k V :=
+by { change finite_dimensional k ((forget₂ (fdRep k G) (fgModule k)).obj V).obj, apply_instance, }
+
+/-- All hom spaces are finite dimensional. -/
+instance (V W : fdRep k G) : finite_dimensional k (V ⟶ W) :=
+finite_dimensional.of_injective
+  ((forget₂ (fdRep k G) (fgModule k)).map_linear_map k) (functor.map_injective _)
+
+/-- The monoid homomorphism corresponding to the action of `G` onto `V : fdRep k G`. -/
+def ρ (V : fdRep k G) : G →* (V →ₗ[k] V) := V.ρ
+
+/-- The underlying `linear_equiv` of an isomorphism of representations. -/
+def iso_to_linear_equiv {V W : fdRep k G} (i : V ≅ W) : V ≃ₗ[k] W :=
+  fgModule.iso_to_linear_equiv ((Action.forget (fgModule k) (Mon.of G)).map_iso i)
+
+lemma iso.conj_ρ {V W : fdRep k G} (i : V ≅ W) (g : G) :
+   W.ρ g = (fdRep.iso_to_linear_equiv i).conj (V.ρ g) :=
+begin
+  rw [fdRep.iso_to_linear_equiv, ←fgModule.iso.conj_eq_conj, iso.conj_apply],
+  rw [iso.eq_inv_comp ((Action.forget (fgModule k) (Mon.of G)).map_iso i)],
+  exact (i.hom.comm g).symm,
+end
+
+/-- Lift an unbundled representation to `fdRep`. -/
+@[simps ρ]
+def of {V : Type u} [add_comm_group V] [module k V] [finite_dimensional k V]
+  (ρ : representation k G V) : fdRep k G :=
+⟨fgModule.of k V, ρ⟩
+
+instance : has_forget₂ (fdRep k G) (Rep k G) :=
+{ forget₂ := (forget₂ (fgModule k) (Module k)).map_Action (Mon.of G), }
+
+lemma forget₂_ρ (V : fdRep k G) : ((forget₂ (fdRep k G) (Rep k G)).obj V).ρ = V.ρ :=
+by { ext g v, refl }
+
+-- Verify that the monoidal structure is available.
+example : monoidal_category (fdRep k G) := by apply_instance
+example : monoidal_preadditive (fdRep k G) := by apply_instance
+example : monoidal_linear k (fdRep k G) := by apply_instance
+
+open finite_dimensional
+open_locale classical
+
+-- We need to provide this instance explicitely as otherwise `finrank_hom_simple_simple` gives a
+-- deterministic timeout.
+instance : has_kernels (fdRep k G) := by apply_instance
+
+-- Verify that Schur's lemma applies out of the box.
+lemma finrank_hom_simple_simple [is_alg_closed k] (V W : fdRep k G) [simple V] [simple W] :
+  finrank k (V ⟶ W) = if nonempty (V ≅ W) then 1 else 0 :=
+category_theory.finrank_hom_simple_simple k V W
+
+/-- The forgetful functor to `Rep k G` preserves hom-sets and their vector space structure -/
+def forget₂_hom_linear_equiv (X Y : fdRep k G) :
+  (((forget₂ (fdRep k G) (Rep k G)).obj X) ⟶ ((forget₂ (fdRep k G) (Rep k G)).obj Y)) ≃ₗ[k]
+  (X ⟶ Y) :=
+{ to_fun := λ f, ⟨f.hom, f.comm⟩,
+  map_add' := λ _ _, rfl,
+  map_smul' := λ _ _, rfl,
+  inv_fun := λ f, ⟨(forget₂ (fgModule k) (Module k)).map f.hom, f.comm⟩,
+  left_inv := λ _, by { ext, refl },
+  right_inv := λ _, by { ext, refl } }
+
+end fdRep
+
+namespace fdRep
+variables {k G : Type u} [field k] [group G]
+
+-- Verify that the right rigid structure is available when the monoid is a group.
+noncomputable instance : right_rigid_category (fdRep k G) :=
+by { change right_rigid_category (Action (fgModule k) (Group.of G)), apply_instance, }
+
+end fdRep
+
+namespace fdRep
+
+-- The variables in this section are slightly weird, living half in `representation` and half in
+-- `fdRep`. When we have a better API for general monoidal closed and rigid categories and these
+-- structures on `fdRep`, we should remove the dependancy of statements about `fdRep` on
+-- `representation.lin_hom` and `representation.dual`. The isomorphism `dual_tensor_iso_lin_hom`
+-- below should then just be obtained from general results about rigid categories.
+
+ open representation
+
+variables {k G V : Type u} [field k] [group G]
+variables [add_comm_group V] [module k V]
+variables [finite_dimensional k V]
+variables (ρV : representation k G V) (W : fdRep k G)
+
+/-- Auxiliary definition for `fdRep.dual_tensor_iso_lin_hom`. -/
+noncomputable def dual_tensor_iso_lin_hom_aux :
+  ((fdRep.of ρV.dual) ⊗ W).V ≅ (fdRep.of (lin_hom ρV W.ρ)).V :=
+(dual_tensor_hom_equiv k V W).to_fgModule_iso
+
+/-- When `V` and `W` are finite dimensional representations of a group `G`, the isomorphism
+`dual_tensor_hom_equiv k V W` of vector spaces induces an isomorphism of representations. -/
+noncomputable def dual_tensor_iso_lin_hom :
+  (fdRep.of ρV.dual) ⊗ W ≅ fdRep.of (lin_hom ρV W.ρ) :=
+begin
+  apply Action.mk_iso (dual_tensor_iso_lin_hom_aux ρV W),
+  convert (dual_tensor_hom_comm ρV W.ρ),
+end
+
+@[simp] lemma dual_tensor_iso_lin_hom_hom_hom :
+  (dual_tensor_iso_lin_hom ρV W).hom.hom = dual_tensor_hom k V W := rfl
+
+end fdRep
diff --git a/src/representation_theory/group_cohomology/basic.lean b/src/representation_theory/group_cohomology/basic.lean
new file mode 100644
index 0000000000000..b2860c0192415
--- /dev/null
+++ b/src/representation_theory/group_cohomology/basic.lean
@@ -0,0 +1,187 @@
+/-
+Copyright (c) 2023 Amelia Livingston. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Amelia Livingston
+-/
+
+import algebra.homology.opposite
+import representation_theory.group_cohomology.resolution
+
+/-!
+# The group cohomology of a `k`-linear `G`-representation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `k` be a commutative ring and `G` a group. This file defines the group cohomology of
+`A : Rep k G` to be the cohomology of the complex
+$$0 \to \mathrm{Fun}(G^0, A) \to \mathrm{Fun}(G^1, A) \to \mathrm{Fun}(G^2, A) \to \dots$$
+with differential $d^n$ sending $f: G^n \to A$ to the function mapping $(g_0, \dots, g_n)$ to
+$$\rho(g_0)(f(g_1, \dots, g_n))
++ \sum_{i = 0}^{n - 1} (-1)^{i + 1}\cdot f(g_0, \dots, g_ig_{i + 1}, \dots, g_n)$$
+$$+ (-1)^{n + 1}\cdot f(g_0, \dots, g_{n - 1})$$ (where `ρ` is the representation attached to `A`).
+
+We have a `k`-linear isomorphism $\mathrm{Fun}(G^n, A) \cong \mathrm{Hom}(k[G^{n + 1}], A)$, where
+the righthand side is morphisms in `Rep k G`, and the representation on $k[G^{n + 1}]$
+is induced by the diagonal action of `G`. If we conjugate the $n$th differential in
+$\mathrm{Hom}(P, A)$ by this isomorphism, where `P` is the standard resolution of `k` as a trivial
+`k`-linear `G`-representation, then the resulting map agrees with the differential $d^n$ defined
+above, a fact we prove.
+
+This gives us for free a proof that our $d^n$ squares to zero. It also gives us an isomorphism
+$\mathrm{H}^n(G, A) \cong \mathrm{Ext}^n(k, A),$ where $\mathrm{Ext}$ is taken in the category
+`Rep k G`.
+
+## Main definitions
+
+* `group_cohomology.linear_yoneda_obj_resolution A`: a complex whose objects are the representation
+morphisms $\mathrm{Hom}(k[G^{n + 1}], A)$ and whose cohomology is the group cohomology
+$\mathrm{H}^n(G, A)$.
+* `group_cohomology.inhomogeneous_cochains A`: a complex whose objects are
+$\mathrm{Fun}(G^n, A)$ and whose cohomology is the group cohomology $\mathrm{H}^n(G, A).$
+* `group_cohomology.inhomogeneous_cochains_iso A`: an isomorphism between the above two complexes.
+* `group_cohomology A n`: this is $\mathrm{H}^n(G, A),$ defined as the $n$th cohomology of the
+second complex, `inhomogeneous_cochains A`.
+* `group_cohomology_iso_Ext A n`: an isomorphism $\mathrm{H}^n(G, A) \cong \mathrm{Ext}^n(k, A)$
+(where $\mathrm{Ext}$ is taken in the category `Rep k G`) induced by `inhomogeneous_cochains_iso A`.
+
+## Implementation notes
+
+Group cohomology is typically stated for `G`-modules, or equivalently modules over the group ring
+`ℤ[G].` However, `ℤ` can be generalized to any commutative ring `k`, which is what we use.
+Moreover, we express `k[G]`-module structures on a module `k`-module `A` using the `Rep`
+definition. We avoid using instances `module (monoid_algebra k G) A` so that we do not run into
+possible scalar action diamonds.
+
+## TODO
+
+* API for cohomology in low degree: $\mathrm{H}^0, \mathrm{H}^1$ and $\mathrm{H}^2.$ For example,
+the inflation-restriction exact sequence.
+* The long exact sequence in cohomology attached to a short exact sequence of representations.
+* Upgrading `group_cohomology_iso_Ext` to an isomorphism of derived functors.
+* Profinite cohomology.
+
+Longer term:
+* The Hochschild-Serre spectral sequence (this is perhaps a good toy example for the theory of
+spectral sequences in general).
+-/
+
+noncomputable theory
+universes u
+
+variables {k G : Type u} [comm_ring k] {n : ℕ}
+
+open category_theory
+namespace group_cohomology
+variables [monoid G]
+
+/-- The complex `Hom(P, A)`, where `P` is the standard resolution of `k` as a trivial `k`-linear
+`G`-representation. -/
+abbreviation linear_yoneda_obj_resolution (A : Rep k G) : cochain_complex (Module.{u} k) ℕ :=
+homological_complex.unop
+  ((((linear_yoneda k (Rep k G)).obj A).right_op.map_homological_complex _).obj (resolution k G))
+
+lemma linear_yoneda_obj_resolution_d_apply {A : Rep k G} (i j : ℕ) (x : (resolution k G).X i ⟶ A) :
+  (linear_yoneda_obj_resolution A).d i j x = (resolution k G).d j i ≫ x :=
+rfl
+
+end group_cohomology
+namespace inhomogeneous_cochains
+open Rep group_cohomology
+
+/-- The differential in the complex of inhomogeneous cochains used to
+calculate group cohomology. -/
+@[simps] def d [monoid G] (n : ℕ) (A : Rep k G) :
+  ((fin n → G) → A) →ₗ[k] (fin (n + 1) → G) → A :=
+{ to_fun := λ f g, A.ρ (g 0) (f (λ i, g i.succ))
+    + finset.univ.sum (λ j : fin (n + 1), (-1 : k) ^ ((j : ℕ) + 1) • f (fin.contract_nth j (*) g)),
+  map_add' := λ f g,
+  begin
+    ext x,
+    simp only [pi.add_apply, map_add, smul_add, finset.sum_add_distrib, add_add_add_comm],
+  end,
+  map_smul' := λ r f,
+  begin
+    ext x,
+    simp only [pi.smul_apply, ring_hom.id_apply, map_smul, smul_add, finset.smul_sum,
+      ←smul_assoc, smul_eq_mul, mul_comm r],
+  end }
+
+variables [group G] (n) (A : Rep k G)
+
+/-- The theorem that our isomorphism `Fun(Gⁿ, A) ≅ Hom(k[Gⁿ⁺¹], A)` (where the righthand side is
+morphisms in `Rep k G`) commutes with the differentials in the complex of inhomogeneous cochains
+and the homogeneous `linear_yoneda_obj_resolution`. -/
+lemma d_eq :
+  d n A = ((diagonal_hom_equiv n A).to_Module_iso.inv
+    ≫ (linear_yoneda_obj_resolution A).d n (n + 1)
+    ≫ (diagonal_hom_equiv (n + 1) A).to_Module_iso.hom) :=
+begin
+  ext f g,
+  simp only [Module.coe_comp, linear_equiv.coe_coe, function.comp_app,
+    linear_equiv.to_Module_iso_inv, linear_yoneda_obj_resolution_d_apply,
+    linear_equiv.to_Module_iso_hom, diagonal_hom_equiv_apply, Action.comp_hom,
+    resolution.d_eq k G n, resolution.d_of (fin.partial_prod g), linear_map.map_sum,
+    ←finsupp.smul_single_one _ ((-1 : k) ^ _), map_smul, d_apply],
+  simp only [@fin.sum_univ_succ _ _ (n + 1), fin.coe_zero, pow_zero, one_smul, fin.succ_above_zero,
+    diagonal_hom_equiv_symm_apply f (fin.partial_prod g ∘ @fin.succ (n + 1)), function.comp_app,
+    fin.partial_prod_succ, fin.cast_succ_zero, fin.partial_prod_zero, one_mul],
+  congr' 1,
+  { congr,
+    ext,
+    have := fin.partial_prod_right_inv g (fin.cast_succ x),
+    simp only [mul_inv_rev, fin.cast_succ_fin_succ] at *,
+    rw [mul_assoc, ←mul_assoc _ _ (g x.succ), this, inv_mul_cancel_left] },
+  { exact finset.sum_congr rfl (λ j hj,
+      by rw [diagonal_hom_equiv_symm_partial_prod_succ, fin.coe_succ]) }
+end
+
+end inhomogeneous_cochains
+namespace group_cohomology
+variables [group G] (n) (A : Rep k G)
+
+open inhomogeneous_cochains
+
+/-- Given a `k`-linear `G`-representation `A`, this is the complex of inhomogeneous cochains
+$$0 \to \mathrm{Fun}(G^0, A) \to \mathrm{Fun}(G^1, A) \to \mathrm{Fun}(G^2, A) \to \dots$$
+which calculates the group cohomology of `A`. -/
+noncomputable abbreviation inhomogeneous_cochains : cochain_complex (Module k) ℕ :=
+cochain_complex.of (λ n, Module.of k ((fin n → G) → A))
+(λ n, inhomogeneous_cochains.d n A) (λ n,
+begin
+  ext x y,
+  have := linear_map.ext_iff.1 ((linear_yoneda_obj_resolution A).d_comp_d n (n + 1) (n + 2)),
+  simp only [Module.coe_comp, function.comp_app] at this,
+  simp only [Module.coe_comp, function.comp_app, d_eq, linear_equiv.to_Module_iso_hom,
+    linear_equiv.to_Module_iso_inv, linear_equiv.coe_coe, linear_equiv.symm_apply_apply,
+    this, linear_map.zero_apply, map_zero, pi.zero_apply],
+end)
+
+/-- Given a `k`-linear `G`-representation `A`, the complex of inhomogeneous cochains is isomorphic
+to `Hom(P, A)`, where `P` is the standard resolution of `k` as a trivial `G`-representation. -/
+def inhomogeneous_cochains_iso :
+  inhomogeneous_cochains A ≅ linear_yoneda_obj_resolution A :=
+homological_complex.hom.iso_of_components
+  (λ i, (Rep.diagonal_hom_equiv i A).to_Module_iso.symm) $
+begin
+  rintros i j (h : i + 1 = j),
+  subst h,
+  simp only [cochain_complex.of_d, d_eq, category.assoc, iso.symm_hom,
+    iso.hom_inv_id, category.comp_id],
+end
+
+end group_cohomology
+open group_cohomology
+
+/-- The group cohomology of a `k`-linear `G`-representation `A`, as the cohomology of its complex
+of inhomogeneous cochains. -/
+def group_cohomology [group G] (A : Rep k G) (n : ℕ) : Module k :=
+(inhomogeneous_cochains A).homology n
+
+/-- The `n`th group cohomology of a `k`-linear `G`-representation `A` is isomorphic to
+`Extⁿ(k, A)` (taken in `Rep k G`), where `k` is a trivial `k`-linear `G`-representation. -/
+def group_cohomology_iso_Ext [group G] (A : Rep k G) (n : ℕ) :
+  group_cohomology A n ≅ ((Ext k (Rep k G) n).obj
+    (opposite.op $ Rep.trivial k G k)).obj A :=
+(homology_obj_iso_of_homotopy_equiv (homotopy_equiv.of_iso (inhomogeneous_cochains_iso _)) _)
+  ≪≫ (homological_complex.homology_unop _ _) ≪≫ (Ext_iso k G A n).symm
diff --git a/src/representation_theory/group_cohomology/resolution.lean b/src/representation_theory/group_cohomology/resolution.lean
new file mode 100644
index 0000000000000..c31a3397b8fc2
--- /dev/null
+++ b/src/representation_theory/group_cohomology/resolution.lean
@@ -0,0 +1,560 @@
+/-
+Copyright (c) 2022 Amelia Livingston. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Amelia Livingston
+-/
+
+import algebra.category.Module.projective
+import algebraic_topology.extra_degeneracy
+import category_theory.abelian.ext
+import representation_theory.Rep
+
+/-!
+# The structure of the `k[G]`-module `k[Gⁿ]`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains facts about an important `k[G]`-module structure on `k[Gⁿ]`, where `k` is a
+commutative ring and `G` is a group. The module structure arises from the representation
+`G →* End(k[Gⁿ])` induced by the diagonal action of `G` on `Gⁿ.`
+
+In particular, we define an isomorphism of `k`-linear `G`-representations between `k[Gⁿ⁺¹]` and
+`k[G] ⊗ₖ k[Gⁿ]` (on which `G` acts by `ρ(g₁)(g₂ ⊗ x) = (g₁ * g₂) ⊗ x`).
+
+This allows us to define a `k[G]`-basis on `k[Gⁿ⁺¹]`, by mapping the natural `k[G]`-basis of
+`k[G] ⊗ₖ k[Gⁿ]` along the isomorphism.
+
+We then define the standard resolution of `k` as a trivial representation, by
+taking the alternating face map complex associated to an appropriate simplicial `k`-linear
+`G`-representation. This simplicial object is the `linearization` of the simplicial `G`-set given
+by the universal cover of the classifying space of `G`, `EG`. We prove this simplicial `G`-set `EG`
+is isomorphic to the Čech nerve of the natural arrow of `G`-sets `G ⟶ {pt}`.
+
+We then use this isomorphism to deduce that as a complex of `k`-modules, the standard resolution
+of `k` as a trivial `G`-representation is homotopy equivalent to the complex with `k` at 0 and 0
+elsewhere.
+
+Putting this material together allows us to define `group_cohomology.ProjectiveResolution`, the
+standard projective resolution of `k` as a trivial `k`-linear `G`-representation.
+
+## Main definitions
+
+ * `group_cohomology.resolution.Action_diagonal_succ`
+ * `group_cohomology.resolution.diagonal_succ`
+ * `group_cohomology.resolution.of_mul_action_basis`
+ * `classifying_space_universal_cover`
+ * `group_cohomology.resolution.forget₂_to_Module_homotopy_equiv`
+ * `group_cohomology.ProjectiveResolution`
+
+## Implementation notes
+
+We express `k[G]`-module structures on a module `k`-module `V` using the `representation`
+definition. We avoid using instances `module (G →₀ k) V` so that we do not run into possible
+scalar action diamonds.
+
+We also use the category theory library to bundle the type `k[Gⁿ]` - or more generally `k[H]` when
+`H` has `G`-action - and the representation together, as a term of type `Rep k G`, and call it
+`Rep.of_mul_action k G H.` This enables us to express the fact that certain maps are
+`G`-equivariant by constructing morphisms in the category `Rep k G`, i.e., representations of `G`
+over `k`.
+-/
+
+noncomputable theory
+universes u v w
+
+variables {k G : Type u} [comm_ring k] {n : ℕ}
+
+open category_theory
+
+local notation `Gⁿ` := fin n → G
+local notation `Gⁿ⁺¹` := fin (n + 1) → G
+
+namespace group_cohomology.resolution
+
+open finsupp (hiding lift) fin (partial_prod)
+
+section basis
+variables (k G n) [group G]
+
+section Action
+open Action
+
+/-- An isomorphism of `G`-sets `Gⁿ⁺¹ ≅ G × Gⁿ`, where `G` acts by left multiplication on `Gⁿ⁺¹` and
+`G` but trivially on `Gⁿ`. The map sends `(g₀, ..., gₙ) ↦ (g₀, (g₀⁻¹g₁, g₁⁻¹g₂, ..., gₙ₋₁⁻¹gₙ))`,
+and the inverse is `(g₀, (g₁, ..., gₙ)) ↦ (g₀, g₀g₁, g₀g₁g₂, ..., g₀g₁...gₙ).` -/
+def Action_diagonal_succ (G : Type u) [group G] : Π (n : ℕ),
+  diagonal G (n + 1) ≅ left_regular G ⊗ Action.mk (fin n → G) 1
+| 0 := diagonal_one_iso_left_regular G ≪≫ (ρ_ _).symm ≪≫ tensor_iso (iso.refl _)
+  (tensor_unit_iso (equiv.equiv_of_unique punit _).to_iso)
+| (n+1) := diagonal_succ _ _ ≪≫ tensor_iso (iso.refl _) (Action_diagonal_succ n)
+  ≪≫ left_regular_tensor_iso _ _ ≪≫ tensor_iso (iso.refl _) (mk_iso
+  (equiv.pi_fin_succ_above_equiv (λ j, G) 0).symm.to_iso (λ g, rfl))
+
+lemma Action_diagonal_succ_hom_apply {G : Type u} [group G] {n : ℕ} (f : fin (n + 1) → G) :
+  (Action_diagonal_succ G n).hom.hom f = (f 0, λ i, (f i.cast_succ)⁻¹ * f i.succ) :=
+begin
+  induction n with n hn,
+  { exact prod.ext rfl (funext $ λ x, fin.elim0 x) },
+  { ext,
+    { refl },
+    { dunfold Action_diagonal_succ,
+      simp only [iso.trans_hom, comp_hom, types_comp_apply, diagonal_succ_hom_hom,
+        left_regular_tensor_iso_hom_hom, tensor_iso_hom, mk_iso_hom_hom, equiv.to_iso_hom,
+        tensor_hom, equiv.pi_fin_succ_above_equiv_symm_apply, tensor_apply, types_id_apply,
+        tensor_rho, monoid_hom.one_apply, End.one_def, hn (λ (j : fin (n + 1)), f j.succ),
+        fin.insert_nth_zero'],
+      refine fin.cases (fin.cons_zero _ _) (λ i, _) x,
+      { simp only [fin.cons_succ, mul_left_inj, inv_inj, fin.cast_succ_fin_succ], }}}
+end
+
+lemma Action_diagonal_succ_inv_apply {G : Type u} [group G] {n : ℕ} (g : G) (f : fin n → G) :
+  (Action_diagonal_succ G n).inv.hom (g, f) = (g • fin.partial_prod f : fin (n + 1) → G) :=
+begin
+  revert g,
+  induction n with n hn,
+  { intros g,
+    ext,
+    simpa only [subsingleton.elim x 0, pi.smul_apply, fin.partial_prod_zero,
+      smul_eq_mul, mul_one] },
+  { intro g,
+    ext,
+    dunfold Action_diagonal_succ,
+    simp only [iso.trans_inv, comp_hom, hn, diagonal_succ_inv_hom, types_comp_apply,
+      tensor_iso_inv, iso.refl_inv, tensor_hom, id_hom, tensor_apply, types_id_apply,
+      left_regular_tensor_iso_inv_hom, tensor_rho, left_regular_ρ_apply, pi.smul_apply,
+      smul_eq_mul],
+    refine fin.cases _ _ x,
+    { simp only [fin.cons_zero, fin.partial_prod_zero, mul_one], },
+    { intro i,
+      simpa only [fin.cons_succ, pi.smul_apply, smul_eq_mul, fin.partial_prod_succ', mul_assoc], }}
+end
+
+end Action
+section Rep
+open Rep
+
+/-- An isomorphism of `k`-linear representations of `G` from `k[Gⁿ⁺¹]` to `k[G] ⊗ₖ k[Gⁿ]` (on
+which `G` acts by `ρ(g₁)(g₂ ⊗ x) = (g₁ * g₂) ⊗ x`) sending `(g₀, ..., gₙ)` to
+`g₀ ⊗ (g₀⁻¹g₁, g₁⁻¹g₂, ..., gₙ₋₁⁻¹gₙ)`. The inverse sends `g₀ ⊗ (g₁, ..., gₙ)` to
+`(g₀, g₀g₁, ..., g₀g₁...gₙ)`. -/
+def diagonal_succ (n : ℕ) :
+  diagonal k G (n + 1) ≅ left_regular k G ⊗ trivial k G ((fin n → G) →₀ k) :=
+(linearization k G).map_iso (Action_diagonal_succ G n)
+  ≪≫ (as_iso ((linearization k G).μ (Action.left_regular G) _)).symm
+  ≪≫ tensor_iso (iso.refl _) (linearization_trivial_iso k G (fin n → G))
+
+variables {k G n}
+
+lemma diagonal_succ_hom_single (f : Gⁿ⁺¹) (a : k) :
+  (diagonal_succ k G n).hom.hom (single f a) =
+  single (f 0) 1 ⊗ₜ single (λ i, (f i.cast_succ)⁻¹ * f i.succ) a :=
+begin
+  dunfold diagonal_succ,
+  simpa only [iso.trans_hom, iso.symm_hom, Action.comp_hom, Module.comp_def, linear_map.comp_apply,
+    functor.map_iso_hom, linearization_map_hom_single (Action_diagonal_succ G n).hom f a,
+    as_iso_inv, linearization_μ_inv_hom, Action_diagonal_succ_hom_apply, finsupp_tensor_finsupp',
+    linear_equiv.trans_symm, lcongr_symm, linear_equiv.trans_apply, lcongr_single,
+    tensor_product.lid_symm_apply, finsupp_tensor_finsupp_symm_single,
+    linear_equiv.coe_to_linear_map],
+end
+
+lemma diagonal_succ_inv_single_single (g : G) (f : Gⁿ) (a b : k) :
+  (diagonal_succ k G n).inv.hom (finsupp.single g a ⊗ₜ finsupp.single f b) =
+  single (g • partial_prod f) (a * b) :=
+begin
+  dunfold diagonal_succ,
+  simp only [iso.trans_inv, iso.symm_inv, iso.refl_inv, tensor_iso_inv, Action.tensor_hom,
+    Action.comp_hom, Module.comp_def, linear_map.comp_apply, as_iso_hom, functor.map_iso_inv,
+    Module.monoidal_category.hom_apply, linearization_trivial_iso_inv_hom_apply,
+    linearization_μ_hom, Action.id_hom ((linearization k G).obj _), Action_diagonal_succ_inv_apply,
+    Module.id_apply, linear_equiv.coe_to_linear_map,
+    finsupp_tensor_finsupp'_single_tmul_single k (Action.left_regular G).V,
+    linearization_map_hom_single (Action_diagonal_succ G n).inv (g, f) (a * b)],
+end
+
+lemma diagonal_succ_inv_single_left (g : G) (f : Gⁿ →₀ k) (r : k) :
+  (diagonal_succ k G n).inv.hom (finsupp.single g r ⊗ₜ f) =
+  finsupp.lift (Gⁿ⁺¹ →₀ k) k Gⁿ (λ f, single (g • partial_prod f) r) f :=
+begin
+  refine f.induction _ _,
+  { simp only [tensor_product.tmul_zero, map_zero] },
+  { intros a b x ha hb hx,
+    simp only [lift_apply, smul_single', mul_one, tensor_product.tmul_add, map_add,
+      diagonal_succ_inv_single_single, hx, finsupp.sum_single_index,
+      mul_comm b, zero_mul, single_zero] },
+end
+
+lemma diagonal_succ_inv_single_right (g : G →₀ k) (f : Gⁿ) (r : k) :
+  (diagonal_succ k G n).inv.hom (g ⊗ₜ finsupp.single f r) =
+  finsupp.lift _ k G (λ a, single (a • partial_prod f) r) g :=
+begin
+  refine g.induction _ _,
+  { simp only [tensor_product.zero_tmul, map_zero], },
+  { intros a b x ha hb hx,
+    simp only [lift_apply, smul_single', map_add, hx, diagonal_succ_inv_single_single,
+      tensor_product.add_tmul, finsupp.sum_single_index, zero_mul, single_zero] }
+end
+
+end Rep
+variables (k G n)
+open_locale tensor_product
+open representation
+
+/-- The `k[G]`-linear isomorphism `k[G] ⊗ₖ k[Gⁿ] ≃ k[Gⁿ⁺¹]`, where the `k[G]`-module structure on
+the lefthand side is `tensor_product.left_module`, whilst that of the righthand side comes from
+`representation.as_module`. Allows us to use `basis.algebra_tensor_product` to get a `k[G]`-basis
+of the righthand side. -/
+def of_mul_action_basis_aux : (monoid_algebra k G ⊗[k] ((fin n → G) →₀ k)) ≃ₗ[monoid_algebra k G]
+  (of_mul_action k G (fin (n + 1) → G)).as_module :=
+{ map_smul' := λ r x,
+  begin
+    rw [ring_hom.id_apply, linear_equiv.to_fun_eq_coe, ←linear_equiv.map_smul],
+    congr' 1,
+    refine x.induction_on _ (λ x y, _) (λ y z hy hz, _),
+    { simp only [smul_zero] },
+    { simp only [tensor_product.smul_tmul'],
+      show (r * x) ⊗ₜ y = _,
+      rw [←of_mul_action_self_smul_eq_mul, smul_tprod_one_as_module] },
+    { rw [smul_add, hz, hy, smul_add], }
+  end, .. ((Rep.equivalence_Module_monoid_algebra.1).map_iso
+    (diagonal_succ k G n).symm).to_linear_equiv }
+
+/-- A `k[G]`-basis of `k[Gⁿ⁺¹]`, coming from the `k[G]`-linear isomorphism
+`k[G] ⊗ₖ k[Gⁿ] ≃ k[Gⁿ⁺¹].` -/
+def of_mul_action_basis  :
+  basis (fin n → G) (monoid_algebra k G) (of_mul_action k G (fin (n + 1) → G)).as_module :=
+@basis.map _ (monoid_algebra k G) (monoid_algebra k G ⊗[k] ((fin n → G) →₀ k))
+  _ _ _ _ _ _ (@algebra.tensor_product.basis k _ (monoid_algebra k G) _ _ ((fin n → G) →₀ k) _ _
+  (fin n → G) ⟨linear_equiv.refl k _⟩) (of_mul_action_basis_aux k G n)
+
+lemma of_mul_action_free :
+  module.free (monoid_algebra k G) (of_mul_action k G (fin (n + 1) → G)).as_module :=
+module.free.of_basis (of_mul_action_basis k G n)
+
+end basis
+end group_cohomology.resolution
+namespace Rep
+variables (n) [group G] (A : Rep k G)
+open group_cohomology.resolution
+
+/-- Given a `k`-linear `G`-representation `A`, the set of representation morphisms
+`Hom(k[Gⁿ⁺¹], A)` is `k`-linearly isomorphic to the set of functions `Gⁿ → A`. -/
+noncomputable def diagonal_hom_equiv :
+  (Rep.of_mul_action k G (fin (n + 1) → G) ⟶ A) ≃ₗ[k] ((fin n → G) → A) :=
+linear.hom_congr k ((diagonal_succ k G n).trans
+  ((representation.of_mul_action k G G).Rep_of_tprod_iso 1)) (iso.refl _) ≪≫ₗ
+  ((Rep.monoidal_closed.linear_hom_equiv_comm _ _ _) ≪≫ₗ (Rep.left_regular_hom_equiv _))
+  ≪≫ₗ (finsupp.llift A k k (fin n → G)).symm
+
+variables {n A}
+
+/-- Given a `k`-linear `G`-representation `A`, `diagonal_hom_equiv` is a `k`-linear isomorphism of
+the set of representation morphisms `Hom(k[Gⁿ⁺¹], A)` with `Fun(Gⁿ, A)`. This lemma says that this
+sends a morphism of representations `f : k[Gⁿ⁺¹] ⟶ A` to the function
+`(g₁, ..., gₙ) ↦ f(1, g₁, g₁g₂, ..., g₁g₂...gₙ).` -/
+lemma diagonal_hom_equiv_apply (f : Rep.of_mul_action k G (fin (n + 1) → G) ⟶ A)
+  (x : fin n → G) : diagonal_hom_equiv n A f x = f.hom (finsupp.single (fin.partial_prod x) 1) :=
+begin
+  unfold diagonal_hom_equiv,
+  simpa only [linear_equiv.trans_apply, Rep.left_regular_hom_equiv_apply,
+    monoidal_closed.linear_hom_equiv_comm_hom, finsupp.llift_symm_apply, tensor_product.curry_apply,
+    linear.hom_congr_apply, iso.refl_hom, iso.trans_inv, Action.comp_hom, Module.comp_def,
+    linear_map.comp_apply, representation.Rep_of_tprod_iso_inv_apply,
+    diagonal_succ_inv_single_single (1 : G) x, one_smul, one_mul],
+end
+
+/-- Given a `k`-linear `G`-representation `A`, `diagonal_hom_equiv` is a `k`-linear isomorphism of
+the set of representation morphisms `Hom(k[Gⁿ⁺¹], A)` with `Fun(Gⁿ, A)`. This lemma says that the
+inverse map sends a function `f : Gⁿ → A` to the representation morphism sending
+`(g₀, ... gₙ) ↦ ρ(g₀)(f(g₀⁻¹g₁, g₁⁻¹g₂, ..., gₙ₋₁⁻¹gₙ))`, where `ρ` is the representation attached
+to `A`. -/
+lemma diagonal_hom_equiv_symm_apply (f : (fin n → G) → A) (x : fin (n + 1) → G) :
+  ((diagonal_hom_equiv n A).symm f).hom (finsupp.single x 1)
+    = A.ρ (x 0) (f (λ (i : fin n), (x i.cast_succ)⁻¹ * x i.succ)) :=
+begin
+  unfold diagonal_hom_equiv,
+  simp only [linear_equiv.trans_symm, linear_equiv.symm_symm, linear_equiv.trans_apply,
+    Rep.left_regular_hom_equiv_symm_apply, linear.hom_congr_symm_apply, Action.comp_hom,
+    iso.refl_inv, category.comp_id, Rep.monoidal_closed.linear_hom_equiv_comm_symm_hom,
+    iso.trans_hom, Module.comp_def, linear_map.comp_apply, representation.Rep_of_tprod_iso_apply,
+    diagonal_succ_hom_single x (1 : k), tensor_product.uncurry_apply, Rep.left_regular_hom_hom,
+    finsupp.lift_apply, ihom_obj_ρ_def, Rep.ihom_obj_ρ_apply, finsupp.sum_single_index,
+    zero_smul, one_smul, Rep.of_ρ, Rep.Action_ρ_eq_ρ, Rep.trivial_def (x 0)⁻¹,
+    finsupp.llift_apply A k k],
+end
+
+/-- Auxiliary lemma for defining group cohomology, used to show that the isomorphism
+`diagonal_hom_equiv` commutes with the differentials in two complexes which compute
+group cohomology. -/
+lemma diagonal_hom_equiv_symm_partial_prod_succ
+  (f : (fin n → G) → A) (g : fin (n + 1) → G) (a : fin (n + 1)) :
+  ((diagonal_hom_equiv n A).symm f).hom (finsupp.single (fin.partial_prod g ∘ a.succ.succ_above) 1)
+    = f (fin.contract_nth a (*) g) :=
+begin
+  simp only [diagonal_hom_equiv_symm_apply, function.comp_app, fin.succ_succ_above_zero,
+    fin.partial_prod_zero, map_one, fin.succ_succ_above_succ,
+    linear_map.one_apply, fin.partial_prod_succ],
+  congr,
+  ext,
+  rw [←fin.partial_prod_succ, fin.inv_partial_prod_mul_eq_contract_nth],
+end
+
+end Rep
+variables (G)
+
+/-- The simplicial `G`-set sending `[n]` to `Gⁿ⁺¹` equipped with the diagonal action of `G`. -/
+def classifying_space_universal_cover [monoid G] :
+  simplicial_object (Action (Type u) $ Mon.of G) :=
+{ obj := λ n, Action.of_mul_action G (fin (n.unop.len + 1) → G),
+  map := λ m n f,
+  { hom := λ x, x ∘ f.unop.to_order_hom,
+    comm' := λ g, rfl },
+  map_id' := λ n, rfl,
+  map_comp' := λ i j k f g, rfl }
+
+namespace classifying_space_universal_cover
+open category_theory category_theory.limits
+variables [monoid G]
+
+/-- When the category is `G`-Set, `cech_nerve_terminal_from` of `G` with the left regular action is
+isomorphic to `EG`, the universal cover of the classifying space of `G` as a simplicial `G`-set. -/
+def cech_nerve_terminal_from_iso :
+  cech_nerve_terminal_from (Action.of_mul_action G G) ≅ classifying_space_universal_cover G :=
+nat_iso.of_components (λ n, limit.iso_limit_cone (Action.of_mul_action_limit_cone _ _)) $ λ m n f,
+begin
+  refine is_limit.hom_ext (Action.of_mul_action_limit_cone.{u 0} _ _).2 (λ j, _),
+  dunfold cech_nerve_terminal_from pi.lift,
+  dsimp,
+  rw [category.assoc, limit.iso_limit_cone_hom_π, limit.lift_π, category.assoc],
+  exact (limit.iso_limit_cone_hom_π _ _).symm,
+end
+
+/-- As a simplicial set, `cech_nerve_terminal_from` of a monoid `G` is isomorphic to the universal
+cover of the classifying space of `G` as a simplicial set. -/
+def cech_nerve_terminal_from_iso_comp_forget :
+  cech_nerve_terminal_from G ≅ classifying_space_universal_cover G ⋙ forget _ :=
+nat_iso.of_components (λ n, types.product_iso _) $ λ m n f, matrix.ext $ λ i j,
+  types.limit.lift_π_apply _ _ _ _
+
+variables (k G)
+open algebraic_topology simplicial_object.augmented simplicial_object category_theory.arrow
+
+/-- The universal cover of the classifying space of `G` as a simplicial set, augmented by the map
+from `fin 1 → G` to the terminal object in `Type u`. -/
+def comp_forget_augmented : simplicial_object.augmented (Type u) :=
+simplicial_object.augment (classifying_space_universal_cover G ⋙ forget _) (terminal _)
+(terminal.from _) $ λ i g h, subsingleton.elim _ _
+
+/-- The augmented Čech nerve of the map from `fin 1 → G` to the terminal object in `Type u` has an
+extra degeneracy. -/
+def extra_degeneracy_augmented_cech_nerve :
+  extra_degeneracy (arrow.mk $ terminal.from G).augmented_cech_nerve :=
+augmented_cech_nerve.extra_degeneracy (arrow.mk $ terminal.from G)
+  ⟨λ x, (1 : G), @subsingleton.elim _ (@unique.subsingleton _ (limits.unique_to_terminal _)) _ _⟩
+
+/-- The universal cover of the classifying space of `G` as a simplicial set, augmented by the map
+from `fin 1 → G` to the terminal object in `Type u`, has an extra degeneracy. -/
+def extra_degeneracy_comp_forget_augmented :
+  extra_degeneracy (comp_forget_augmented G) :=
+begin
+  refine extra_degeneracy.of_iso (_ : (arrow.mk $ terminal.from G).augmented_cech_nerve ≅ _)
+    (extra_degeneracy_augmented_cech_nerve G),
+  exact comma.iso_mk (cech_nerve_terminal_from.iso G ≪≫
+    cech_nerve_terminal_from_iso_comp_forget G) (iso.refl _)
+    (by ext : 2; apply is_terminal.hom_ext terminal_is_terminal),
+end
+
+/-- The free functor `Type u ⥤ Module.{u} k` applied to the universal cover of the classifying
+space of `G` as a simplicial set, augmented by the map from `fin 1 → G` to the terminal object
+in `Type u`. -/
+def comp_forget_augmented.to_Module : simplicial_object.augmented (Module.{u} k) :=
+((simplicial_object.augmented.whiskering _ _).obj (Module.free k)).obj (comp_forget_augmented G)
+
+/-- If we augment the universal cover of the classifying space of `G` as a simplicial set by the
+map from `fin 1 → G` to the terminal object in `Type u`, then apply the free functor
+`Type u ⥤ Module.{u} k`, the resulting augmented simplicial `k`-module has an extra degeneracy. -/
+def extra_degeneracy_comp_forget_augmented_to_Module :
+  extra_degeneracy (comp_forget_augmented.to_Module k G) :=
+extra_degeneracy.map (extra_degeneracy_comp_forget_augmented G) (Module.free k)
+
+end classifying_space_universal_cover
+
+variables (k)
+
+/-- The standard resolution of `k` as a trivial representation, defined as the alternating
+face map complex of a simplicial `k`-linear `G`-representation. -/
+def group_cohomology.resolution [monoid G] :=
+(algebraic_topology.alternating_face_map_complex (Rep k G)).obj
+  (classifying_space_universal_cover G ⋙ (Rep.linearization k G).1.1)
+
+namespace group_cohomology.resolution
+open classifying_space_universal_cover algebraic_topology category_theory category_theory.limits
+
+variables (k G) [monoid G]
+
+/-- The `k`-linear map underlying the differential in the standard resolution of `k` as a trivial
+`k`-linear `G`-representation. It sends `(g₀, ..., gₙ) ↦ ∑ (-1)ⁱ • (g₀, ..., ĝᵢ, ..., gₙ)`. -/
+def d (G : Type u) (n : ℕ) : ((fin (n + 1) → G) →₀ k) →ₗ[k] ((fin n → G) →₀ k) :=
+finsupp.lift ((fin n → G) →₀ k) k (fin (n + 1) → G) (λ g, (@finset.univ (fin (n + 1)) _).sum
+  (λ p, finsupp.single (g ∘ p.succ_above) ((-1 : k) ^ (p : ℕ))))
+
+variables {k G}
+
+@[simp] lemma d_of {G : Type u} {n : ℕ} (c : fin (n + 1) → G) :
+  d k G n (finsupp.single c 1) = finset.univ.sum (λ p : fin (n + 1), finsupp.single
+    (c ∘ p.succ_above) ((-1 : k) ^ (p : ℕ))) :=
+by simp [d]
+
+variables (k G)
+
+/-- The `n`th object of the standard resolution of `k` is definitionally isomorphic to `k[Gⁿ⁺¹]`
+equipped with the representation induced by the diagonal action of `G`. -/
+def X_iso (n : ℕ) :
+  (group_cohomology.resolution k G).X n ≅ Rep.of_mul_action k G (fin (n + 1) → G) := iso.refl _
+
+lemma X_projective (G : Type u) [group G] (n : ℕ) :
+  projective ((group_cohomology.resolution k G).X n) :=
+Rep.equivalence_Module_monoid_algebra.to_adjunction.projective_of_map_projective _ $
+  @Module.projective_of_free.{u} _ _ (Module.of (monoid_algebra k G)
+  (representation.of_mul_action k G (fin (n + 1) → G)).as_module) _ (of_mul_action_basis k G n)
+
+/-- Simpler expression for the differential in the standard resolution of `k` as a
+`G`-representation. It sends `(g₀, ..., gₙ₊₁) ↦ ∑ (-1)ⁱ • (g₀, ..., ĝᵢ, ..., gₙ₊₁)`. -/
+theorem d_eq (n : ℕ) :
+  ((group_cohomology.resolution k G).d (n + 1) n).hom = d k G (n + 1) :=
+begin
+  ext x y,
+  dsimp [group_cohomology.resolution],
+  simpa [←@int_cast_smul k, simplicial_object.δ],
+end
+
+section exactness
+
+/-- The standard resolution of `k` as a trivial representation as a complex of `k`-modules. -/
+def forget₂_to_Module := ((forget₂ (Rep k G) (Module.{u} k)).map_homological_complex _).obj
+(group_cohomology.resolution k G)
+
+/-- If we apply the free functor `Type u ⥤ Module.{u} k` to the universal cover of the classifying
+space of `G` as a simplicial set, then take the alternating face map complex, the result is
+isomorphic to the standard resolution of the trivial `G`-representation `k` as a complex of
+`k`-modules. -/
+def comp_forget_augmented_iso : (alternating_face_map_complex.obj
+  (simplicial_object.augmented.drop.obj (comp_forget_augmented.to_Module k G))) ≅
+  group_cohomology.resolution.forget₂_to_Module k G :=
+eq_to_iso (functor.congr_obj (map_alternating_face_map_complex (forget₂ (Rep k G)
+  (Module.{u} k))).symm (classifying_space_universal_cover G ⋙ (Rep.linearization k G).1.1))
+
+/-- As a complex of `k`-modules, the standard resolution of the trivial `G`-representation `k` is
+homotopy equivalent to the complex which is `k` at 0 and 0 elsewhere. -/
+def forget₂_to_Module_homotopy_equiv : homotopy_equiv
+  (group_cohomology.resolution.forget₂_to_Module k G)
+  ((chain_complex.single₀ (Module k)).obj
+  ((forget₂ (Rep k G) _).obj $ Rep.trivial k G k)) :=
+(homotopy_equiv.of_iso (comp_forget_augmented_iso k G).symm).trans $
+  (simplicial_object.augmented.extra_degeneracy.homotopy_equiv
+    (extra_degeneracy_comp_forget_augmented_to_Module k G)).trans
+  (homotopy_equiv.of_iso $ (chain_complex.single₀ (Module.{u} k)).map_iso
+    (@finsupp.linear_equiv.finsupp_unique k k _ _ _ (⊤_ (Type u))
+      types.terminal_iso.to_equiv.unique).to_Module_iso)
+
+/-- The hom of `k`-linear `G`-representations `k[G¹] → k` sending `∑ nᵢgᵢ ↦ ∑ nᵢ`. -/
+def ε : Rep.of_mul_action k G (fin 1 → G) ⟶ Rep.trivial k G k :=
+{ hom := finsupp.total _ _ _ (λ f, (1 : k)),
+  comm' := λ g,
+  begin
+    ext,
+    show finsupp.total (fin 1 → G) k k (λ f, (1 : k))
+      (finsupp.map_domain _ (finsupp.single _ _)) = finsupp.total _ _ _ _ (finsupp.single _ _),
+    simp only [finsupp.map_domain_single, finsupp.total_single],
+  end }
+
+/-- The homotopy equivalence of complexes of `k`-modules between the standard resolution of `k` as
+a trivial `G`-representation, and the complex which is `k` at 0 and 0 everywhere else, acts as
+`∑ nᵢgᵢ ↦ ∑ nᵢ : k[G¹] → k` at 0. -/
+lemma forget₂_to_Module_homotopy_equiv_f_0_eq :
+  (forget₂_to_Module_homotopy_equiv k G).1.f 0 =
+  (forget₂ (Rep k G) _).map (ε k G) :=
+begin
+  show (homotopy_equiv.hom _ ≫ (homotopy_equiv.hom _ ≫ homotopy_equiv.hom _)).f 0 = _,
+  simp only [homological_complex.comp_f],
+  convert category.id_comp _,
+  { dunfold homotopy_equiv.of_iso comp_forget_augmented_iso map_alternating_face_map_complex,
+    simp only [iso.symm_hom, eq_to_iso.inv, homological_complex.eq_to_hom_f, eq_to_hom_refl] },
+  transitivity ((finsupp.total _ _ _ (λ f, (1 : k))).comp
+    ((Module.free k).map (terminal.from _))),
+  { dsimp,
+    rw [@finsupp.lmap_domain_total (fin 1 → G) k k _ _ _ (⊤_ (Type u)) k _ _ (λ i, (1 : k))
+      (λ i, (1 : k)) (terminal.from ((classifying_space_universal_cover G).obj
+      (opposite.op (simplex_category.mk 0))).V) linear_map.id (λ i, rfl), linear_map.id_comp],
+    refl },
+  { congr,
+    { ext,
+      dsimp [homotopy_equiv.of_iso],
+      rw [finsupp.total_single, one_smul, @unique.eq_default _
+        types.terminal_iso.to_equiv.unique a, finsupp.single_eq_same] },
+    { exact (@subsingleton.elim _ (@unique.subsingleton _ (limits.unique_to_terminal _)) _ _) }}
+end
+
+lemma d_comp_ε : (group_cohomology.resolution k G).d 1 0 ≫ ε k G = 0 :=
+begin
+  ext1,
+  refine linear_map.ext (λ x, _),
+  have : (forget₂_to_Module k G).d 1 0 ≫ (forget₂ (Rep k G) (Module.{u} k)).map (ε k G) = 0,
+  by rw [←forget₂_to_Module_homotopy_equiv_f_0_eq,
+    ←(forget₂_to_Module_homotopy_equiv k G).1.2 1 0 rfl]; exact comp_zero,
+  exact linear_map.ext_iff.1 this _,
+end
+
+/-- The chain map from the standard resolution of `k` to `k[0]` given by `∑ nᵢgᵢ ↦ ∑ nᵢ` in
+degree zero. -/
+def ε_to_single₀ : group_cohomology.resolution k G ⟶ (chain_complex.single₀ _).obj
+  (Rep.trivial k G k) :=
+((group_cohomology.resolution k G).to_single₀_equiv _).symm ⟨ε k G, d_comp_ε k G⟩
+
+lemma ε_to_single₀_comp_eq : ((forget₂ _ (Module.{u} k)).map_homological_complex _).map
+  (ε_to_single₀ k G) ≫ ((chain_complex.single₀_map_homological_complex _).hom.app _) =
+  (forget₂_to_Module_homotopy_equiv k G).hom :=
+begin
+  refine chain_complex.to_single₀_ext _ _ _,
+  dsimp,
+  rw category.comp_id,
+  exact (forget₂_to_Module_homotopy_equiv_f_0_eq k G).symm,
+end
+
+lemma quasi_iso_of_forget₂_ε_to_single₀ :
+  quasi_iso (((forget₂ _ (Module.{u} k)).map_homological_complex _).map (ε_to_single₀ k G)) :=
+begin
+  have h : quasi_iso (forget₂_to_Module_homotopy_equiv k G).hom := homotopy_equiv.to_quasi_iso _,
+  rw ← ε_to_single₀_comp_eq k G at h,
+  haveI := h,
+  exact quasi_iso_of_comp_right _ (((chain_complex.single₀_map_homological_complex _).hom.app _)),
+end
+
+instance : quasi_iso (ε_to_single₀ k G) :=
+(forget₂ _ (Module.{u} k)).quasi_iso_of_map_quasi_iso _ (quasi_iso_of_forget₂_ε_to_single₀ k G)
+
+end exactness
+end group_cohomology.resolution
+open group_cohomology.resolution
+
+variables [group G]
+
+/-- The standard projective resolution of `k` as a trivial `k`-linear `G`-representation. -/
+def group_cohomology.ProjectiveResolution :
+  ProjectiveResolution (Rep.trivial k G k) :=
+(ε_to_single₀ k G).to_single₀_ProjectiveResolution (X_projective k G)
+
+instance : enough_projectives (Rep k G) :=
+Rep.equivalence_Module_monoid_algebra.enough_projectives_iff.2
+  (Module.Module_enough_projectives.{u})
+
+/-- Given a `k`-linear `G`-representation `V`, `Extⁿ(k, V)` (where `k` is a trivial `k`-linear
+`G`-representation) is isomorphic to the `n`th cohomology group of `Hom(P, V)`, where `P` is the
+standard resolution of `k` called `group_cohomology.resolution k G`. -/
+def group_cohomology.Ext_iso (V : Rep k G) (n : ℕ) :
+  ((Ext k (Rep k G) n).obj (opposite.op $ Rep.trivial k G k)).obj V ≅
+    (((((linear_yoneda k (Rep k G)).obj V).right_op.map_homological_complex _).obj
+      (group_cohomology.resolution k G)).homology n).unop :=
+by let := (((linear_yoneda k (Rep k G)).obj V).right_op.left_derived_obj_iso
+  n (group_cohomology.ProjectiveResolution k G)).unop.symm; exact this
diff --git a/src/representation_theory/invariants.lean b/src/representation_theory/invariants.lean
index 88bbe9353dc05..5a9380d2cc6c3 100644
--- a/src/representation_theory/invariants.lean
+++ b/src/representation_theory/invariants.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Antoine Labelle
 -/
 import representation_theory.basic
-import representation_theory.Rep
+import representation_theory.fdRep
 
 /-!
 # Subspace of invariants a group representation
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file introduces the subspace of invariants of a group representation
 and proves basic results about it.
 The main tool used is the average of all elements of the group, seen as an element of
@@ -33,8 +36,6 @@ The average of all elements of the group `G`, considered as an element of `monoi
 noncomputable def average : monoid_algebra k G :=
   ⅟(fintype.card G : k) • ∑ g : G, of k G g
 
-lemma average_def : average k G = ⅟(fintype.card G : k) • ∑ g : G, of k G g := rfl
-
 /--
 `average k G` is invariant under left multiplication by elements of `G`.
 -/
@@ -42,7 +43,7 @@ lemma average_def : average k G = ⅟(fintype.card G : k) • ∑ g : G, of k G
 theorem mul_average_left (g : G) :
   (finsupp.single g 1 * average k G : monoid_algebra k G) = average k G :=
 begin
-  simp only [mul_one, finset.mul_sum, algebra.mul_smul_comm, average_def, monoid_algebra.of_apply,
+  simp only [mul_one, finset.mul_sum, algebra.mul_smul_comm, average, monoid_algebra.of_apply,
     finset.sum_congr, monoid_algebra.single_mul_single],
   set f : G → monoid_algebra k G := λ x, finsupp.single x 1,
   show ⅟ ↑(fintype.card G) • ∑ (x : G), f (g * x) = ⅟ ↑(fintype.card G) • ∑ (x : G), f x,
@@ -56,7 +57,7 @@ end
 theorem mul_average_right (g : G) :
   average k G * finsupp.single g 1 = average k G :=
 begin
-  simp only [mul_one, finset.sum_mul, algebra.smul_mul_assoc, average_def, monoid_algebra.of_apply,
+  simp only [mul_one, finset.sum_mul, algebra.smul_mul_assoc, average, monoid_algebra.of_apply,
     finset.sum_congr, monoid_algebra.single_mul_single],
   set f : G → monoid_algebra k G := λ x, finsupp.single x 1,
   show ⅟ ↑(fintype.card G) • ∑ (x : G), f (x * g) = ⅟ ↑(fintype.card G) • ∑ (x : G), f x,
@@ -102,8 +103,8 @@ noncomputable def average_map : V →ₗ[k] V := as_algebra_hom ρ (average k G)
 The `average_map` sends elements of `V` to the subspace of invariants.
 -/
 theorem average_map_invariant (v : V) : average_map ρ v ∈ invariants ρ :=
-λ g, by rw [average_map, ←as_algebra_hom_single, ←linear_map.mul_apply, ←map_mul (as_algebra_hom ρ),
-            mul_average_left]
+λ g, by rw [average_map, ←as_algebra_hom_single_one, ←linear_map.mul_apply,
+  ←map_mul (as_algebra_hom ρ), mul_average_left]
 
 /--
 The `average_map` acts as the identity on the subspace of invariants.
@@ -111,9 +112,12 @@ The `average_map` acts as the identity on the subspace of invariants.
 theorem average_map_id (v : V) (hv : v ∈ invariants ρ) : average_map ρ v = v :=
 begin
   rw mem_invariants at hv,
-  simp [average_def, map_sum, hv, finset.card_univ, nsmul_eq_smul_cast k _ v, smul_smul],
+  simp [average, map_sum, hv, finset.card_univ, nsmul_eq_smul_cast k _ v, smul_smul],
 end
 
+theorem is_proj_average_map : linear_map.is_proj ρ.invariants ρ.average_map :=
+⟨ρ.average_map_invariant, ρ.average_map_id⟩
+
 end invariants
 
 namespace lin_hom
@@ -122,13 +126,17 @@ universes u
 
 open category_theory Action
 
+section Rep
+
 variables {k : Type u} [comm_ring k] {G : Group.{u}}
 
 lemma mem_invariants_iff_comm {X Y : Rep k G} (f : X.V →ₗ[k] Y.V) (g : G) :
-  (lin_hom X.ρ Y.ρ) g f = f ↔ X.ρ g ≫ f = f ≫ Y.ρ g :=
+  (lin_hom X.ρ Y.ρ) g f = f ↔ f.comp (X.ρ g) = (Y.ρ g).comp f :=
 begin
-  rw [lin_hom_apply, ←ρ_Aut_apply_inv, ←linear_map.comp_assoc, ←Module.comp_def, ←Module.comp_def,
-  iso.inv_comp_eq, ρ_Aut_apply_hom], exact comm,
+  dsimp,
+  erw [←ρ_Aut_apply_inv],
+  rw [←linear_map.comp_assoc, ←Module.comp_def, ←Module.comp_def, iso.inv_comp_eq, ρ_Aut_apply_hom],
+  exact comm,
 end
 
 /-- The invariants of the representation `lin_hom X.ρ Y.ρ` correspond to the the representation
@@ -142,6 +150,22 @@ def invariants_equiv_Rep_hom (X Y : Rep k G) : (lin_hom X.ρ Y.ρ).invariants 
   left_inv := λ _, by { ext, refl },
   right_inv := λ _, by { ext, refl } }
 
+end Rep
+
+section fdRep
+
+variables {k : Type u} [field k] {G : Group.{u}}
+
+/-- The invariants of the representation `lin_hom X.ρ Y.ρ` correspond to the the representation
+homomorphisms from `X` to `Y` -/
+def invariants_equiv_fdRep_hom (X Y : fdRep k G) : (lin_hom X.ρ Y.ρ).invariants ≃ₗ[k] (X ⟶ Y) :=
+begin
+  rw [←fdRep.forget₂_ρ, ←fdRep.forget₂_ρ],
+  exact (lin_hom.invariants_equiv_Rep_hom _ _) ≪≫ₗ (fdRep.forget₂_hom_linear_equiv X Y),
+end
+
+end fdRep
+
 end lin_hom
 
 end representation
diff --git a/src/representation_theory/maschke.lean b/src/representation_theory/maschke.lean
index cb4e0aa7bf7c4..6240b8f84dea3 100644
--- a/src/representation_theory/maschke.lean
+++ b/src/representation_theory/maschke.lean
@@ -5,12 +5,14 @@ Authors: Scott Morrison
 -/
 import algebra.monoid_algebra.basic
 import algebra.char_p.invertible
-import algebra.regular.basic
 import linear_algebra.basis
 
 /-!
 # Maschke's theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We prove **Maschke's theorem** for finite groups,
 in the formulation that every submodule of a `k[G]` module has a complement,
 when `k` is a field with `invertible (fintype.card G : k)`.
@@ -104,8 +106,10 @@ In fact, the sum over `g : G` of the conjugate of `π` by `g` is a `k[G]`-linear
 def sum_of_conjugates_equivariant : W →ₗ[monoid_algebra k G] V :=
 monoid_algebra.equivariant_of_linear_of_comm (π.sum_of_conjugates G) (λ g v,
 begin
-  dsimp [sum_of_conjugates],
-  simp only [linear_map.sum_apply, finset.smul_sum],
+  simp only [sum_of_conjugates, linear_map.sum_apply,
+    -- We have a `module (monoid_algebra k G)` instance but are working with `finsupp`s,
+    -- so help the elaborator unfold everything correctly.
+    @finset.smul_sum (monoid_algebra k G)],
   dsimp [conjugate],
   conv_lhs
   { rw [←finset.univ_map_embedding (mul_right_embedding g⁻¹)],
@@ -184,7 +188,7 @@ let ⟨f, hf⟩ := monoid_algebra.exists_left_inverse_of_injective p.subtype p.k
 ⟨f.ker, linear_map.is_compl_of_proj $ linear_map.ext_iff.1 hf⟩
 
 /-- This also implies an instance `is_semisimple_module (monoid_algebra k G) V`. -/
-instance is_complemented : is_complemented (submodule (monoid_algebra k G) V) :=
+instance complemented_lattice : complemented_lattice (submodule (monoid_algebra k G) V) :=
 ⟨exists_is_compl⟩
 
 end submodule
diff --git a/src/ring_theory/adjoin/basic.lean b/src/ring_theory/adjoin/basic.lean
index b771859d49263..1e8853cbe9fbf 100644
--- a/src/ring_theory/adjoin/basic.lean
+++ b/src/ring_theory/adjoin/basic.lean
@@ -3,14 +3,17 @@ Copyright (c) 2019 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
-import algebra.algebra.tower
+import algebra.algebra.operations
+import algebra.algebra.subalgebra.tower
 import linear_algebra.prod
 import linear_algebra.finsupp
-import algebra.algebra.operations
 
 /-!
 # Adjoining elements to form subalgebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file develops the basic theory of subalgebras of an R-algebra generated
 by a set of elements. A basic interface for `adjoin` is set up.
 
@@ -137,7 +140,7 @@ begin
     rw [list.map_cons, list.sum_cons],
     refine submodule.add_mem _ _ (ih HL.2),
     replace HL := HL.1, clear ih tl,
-    suffices : ∃ z r (hr : r ∈ submonoid.closure s), has_scalar.smul z r = list.prod hd,
+    suffices : ∃ z r (hr : r ∈ submonoid.closure s), has_smul.smul z r = list.prod hd,
     { rcases this with ⟨z, r, hr, hzr⟩, rw ← hzr,
       exact smul_mem _ _ (subset_span hr) },
     induction hd with hd tl ih, { exact ⟨1, 1, (submonoid.closure s).one_mem', one_smul _ _⟩ },
@@ -164,6 +167,10 @@ lemma adjoin_eq_span_of_subset {s : set A} (hs : ↑(submonoid.closure s) ⊆ (s
   (adjoin R s).to_submodule = span R s :=
 le_antisymm ((adjoin_to_submodule_le R).mpr hs) (span_le_adjoin R s)
 
+@[simp] lemma adjoin_span {s : set A} :
+  adjoin R (submodule.span R s : set A) = adjoin R s :=
+le_antisymm (adjoin_le (span_le_adjoin _ _)) (adjoin_mono submodule.subset_span)
+
 lemma adjoin_image (f : A →ₐ[R] B) (s : set A) :
   adjoin R (f '' s) = (adjoin R s).map f :=
 le_antisymm (adjoin_le $ set.image_subset _ subset_adjoin) $
@@ -266,8 +273,23 @@ begin
   congr' 1 with z, simp [submonoid.closure_union, submonoid.mem_sup, set.mem_mul]
 end
 
-lemma pow_smul_mem_adjoin_smul (r : R) (s : set A) {x : A} (hx : x ∈ adjoin R s) :
-  ∃ n₀ : ℕ, ∀ n ≥ n₀, r ^ n • x ∈ adjoin R (r • s) :=
+lemma adjoin_adjoin_of_tower [semiring B] [algebra R B] [algebra A B] [is_scalar_tower R A B]
+  (s : set B) : adjoin A (adjoin R s : set B) = adjoin A s :=
+begin
+  apply le_antisymm (adjoin_le _),
+  { exact adjoin_mono subset_adjoin },
+  { change adjoin R s ≤ (adjoin A s).restrict_scalars R,
+    refine adjoin_le _,
+    exact subset_adjoin }
+end
+
+variable {R}
+
+lemma pow_smul_mem_of_smul_subset_of_mem_adjoin
+  [comm_semiring B] [algebra R B] [algebra A B] [is_scalar_tower R A B]
+  (r : A) (s : set B) (B' : subalgebra R B) (hs : r • s ⊆ B') {x : B} (hx : x ∈ adjoin R s)
+  (hr : algebra_map A B r ∈ B') :
+  ∃ n₀ : ℕ, ∀ n ≥ n₀, r ^ n • x ∈ B' :=
 begin
   change x ∈ (adjoin R s).to_submodule at hx,
   rw [adjoin_eq_span, finsupp.mem_span_iff_total] at hx,
@@ -276,16 +298,24 @@ begin
   use l.support.sup n₁,
   intros n hn,
   rw finsupp.smul_sum,
-  refine (adjoin R (r • s)).to_submodule.sum_mem _,
+  refine B'.to_submodule.sum_mem _,
   intros a ha,
   have : n ≥ n₁ a := le_trans (finset.le_sup ha) hn,
   dsimp only,
-  rw [← tsub_add_cancel_of_le this, pow_add, ← smul_smul, smul_smul _ (l a), mul_comm,
-    ← smul_smul, adjoin_eq_span],
-  refine submodule.smul_mem _ _ _,
-  exact submodule.smul_mem _ _ (submodule.subset_span (n₂ a))
+  rw [← tsub_add_cancel_of_le this, pow_add, ← smul_smul,
+    ← is_scalar_tower.algebra_map_smul A (l a) (a : B), smul_smul (r ^ n₁ a),
+    mul_comm, ← smul_smul, smul_def, map_pow, is_scalar_tower.algebra_map_smul],
+  apply subalgebra.mul_mem _ (subalgebra.pow_mem _ hr _) _,
+  refine subalgebra.smul_mem _ _ _,
+  change _ ∈ B'.to_submonoid,
+  rw ← submonoid.closure_eq B'.to_submonoid,
+  apply submonoid.closure_mono hs (n₂ a),
 end
 
+lemma pow_smul_mem_adjoin_smul (r : R) (s : set A) {x : A} (hx : x ∈ adjoin R s) :
+  ∃ n₀ : ℕ, ∀ n ≥ n₀, r ^ n • x ∈ adjoin R (r • s) :=
+pow_smul_mem_of_smul_subset_of_mem_adjoin r s _ subset_adjoin hx (subalgebra.algebra_map_mem _ _)
+
 end comm_semiring
 
 section ring
diff --git a/src/ring_theory/adjoin/default.lean b/src/ring_theory/adjoin/default.lean
deleted file mode 100644
index 775aeca5c20d8..0000000000000
--- a/src/ring_theory/adjoin/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import ring_theory.adjoin.basic
diff --git a/src/ring_theory/adjoin/fg.lean b/src/ring_theory/adjoin/fg.lean
index 12e288469c2f4..1c598c5365d47 100644
--- a/src/ring_theory/adjoin/fg.lean
+++ b/src/ring_theory/adjoin/fg.lean
@@ -10,6 +10,9 @@ import data.mv_polynomial.basic
 /-!
 # Adjoining elements to form subalgebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file develops the basic theory of finitely-generated subalgebras.
 
 ## Definitions
@@ -87,8 +90,7 @@ lemma fg_adjoin_finset (s : finset A) : (algebra.adjoin R (↑s : set A)).fg :=
 ⟨s, rfl⟩
 
 theorem fg_def {S : subalgebra R A} : S.fg ↔ ∃ t : set A, set.finite t ∧ algebra.adjoin R t = S :=
-⟨λ ⟨t, ht⟩, ⟨↑t, set.finite_mem_finset t, ht⟩,
-λ ⟨t, ht1, ht2⟩, ⟨ht1.to_finset, by rwa set.finite.coe_to_finset⟩⟩
+iff.symm set.exists_finite_iff_finset
 
 theorem fg_bot : (⊥ : subalgebra R A).fg :=
 ⟨∅, algebra.adjoin_empty R A⟩
@@ -105,7 +107,7 @@ theorem fg_of_noetherian [is_noetherian R A] (S : subalgebra R A) : S.fg :=
 fg_of_fg_to_submodule (is_noetherian.noetherian S.to_submodule)
 
 lemma fg_of_submodule_fg (h : (⊤ : submodule R A).fg) : (⊤ : subalgebra R A).fg :=
-let ⟨s, hs⟩ := h in ⟨s, to_submodule_injective $
+let ⟨s, hs⟩ := h in ⟨s, to_submodule.injective $
 by { rw [algebra.top_to_submodule, eq_top_iff, ← hs, span_le], exact algebra.subset_adjoin }⟩
 
 lemma fg.prod {S : subalgebra R A} {T : subalgebra R B} (hS : S.fg) (hT : T.fg) : (S.prod T).fg :=
@@ -127,7 +129,7 @@ end
 
 lemma fg_of_fg_map (S : subalgebra R A) (f : A →ₐ[R] B) (hf : function.injective f)
   (hs : (S.map f).fg) : S.fg :=
-let ⟨s, hs⟩ := hs in ⟨s.preimage f $ λ _ _ _ _ h, hf h, map_injective f hf $
+let ⟨s, hs⟩ := hs in ⟨s.preimage f $ λ _ _ _ _ h, hf h, map_injective hf $
 by { rw [← algebra.adjoin_image, finset.coe_preimage, set.image_preimage_eq_of_subset, hs],
   rw [← alg_hom.coe_range, ← algebra.adjoin_le_iff, hs, ← algebra.map_top], exact map_mono le_top }⟩
 
diff --git a/src/ring_theory/adjoin/field.lean b/src/ring_theory/adjoin/field.lean
new file mode 100644
index 0000000000000..7a4b4920535d2
--- /dev/null
+++ b/src/ring_theory/adjoin/field.lean
@@ -0,0 +1,88 @@
+/-
+Copyright (c) 2018 Chris Hughes. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Chris Hughes
+-/
+
+import data.polynomial.splits
+import ring_theory.adjoin.basic
+import ring_theory.adjoin_root
+
+/-!
+# Adjoining elements to a field
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Some lemmas on the ring generating by adjoining an element to a field.
+
+## Main statements
+
+* `lift_of_splits`: If `K` and `L` are field extensions of `F` and we have `s : finset K` such that
+the minimal polynomial of each `x ∈ s` splits in `L` then `algebra.adjoin F s` embeds in `L`.
+
+-/
+
+noncomputable theory
+open_locale big_operators polynomial
+
+section embeddings
+
+variables (F : Type*) [field F]
+
+/-- If `p` is the minimal polynomial of `a` over `F` then `F[a] ≃ₐ[F] F[x]/(p)` -/
+def alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly
+  {R : Type*} [comm_ring R] [algebra F R] (x : R) :
+  algebra.adjoin F ({x} : set R) ≃ₐ[F] adjoin_root (minpoly F x) :=
+alg_equiv.symm $ alg_equiv.of_bijective
+  (alg_hom.cod_restrict
+    (adjoin_root.lift_hom _ x $ minpoly.aeval F x) _
+    (λ p, adjoin_root.induction_on _ p $ λ p,
+      (algebra.adjoin_singleton_eq_range_aeval F x).symm ▸
+        (polynomial.aeval _).mem_range.mpr ⟨p, rfl⟩))
+  ⟨(alg_hom.injective_cod_restrict _ _ _).2 $ (injective_iff_map_eq_zero _).2 $ λ p,
+    adjoin_root.induction_on _ p $ λ p hp, ideal.quotient.eq_zero_iff_mem.2 $
+    ideal.mem_span_singleton.2 $ minpoly.dvd F x hp,
+  λ y,
+    let ⟨p, hp⟩ := (set_like.ext_iff.1
+      (algebra.adjoin_singleton_eq_range_aeval F x) (y : R)).1 y.2 in
+    ⟨adjoin_root.mk _ p, subtype.eq hp⟩⟩
+
+open finset
+
+/-- If `K` and `L` are field extensions of `F` and we have `s : finset K` such that
+the minimal polynomial of each `x ∈ s` splits in `L` then `algebra.adjoin F s` embeds in `L`. -/
+theorem lift_of_splits {F K L : Type*} [field F] [field K] [field L]
+  [algebra F K] [algebra F L] (s : finset K) :
+  (∀ x ∈ s, is_integral F x ∧ polynomial.splits (algebra_map F L) (minpoly F x)) →
+  nonempty (algebra.adjoin F (↑s : set K) →ₐ[F] L) :=
+begin
+  classical,
+  refine finset.induction_on s (λ H, _) (λ a s has ih H, _),
+  { rw [coe_empty, algebra.adjoin_empty],
+    exact ⟨(algebra.of_id F L).comp (algebra.bot_equiv F K)⟩ },
+  rw forall_mem_insert at H, rcases H with ⟨⟨H1, H2⟩, H3⟩, cases ih H3 with f,
+  choose H3 H4 using H3,
+  rw [coe_insert, set.insert_eq, set.union_comm, algebra.adjoin_union_eq_adjoin_adjoin],
+  letI := (f : algebra.adjoin F (↑s : set K) →+* L).to_algebra,
+  haveI : finite_dimensional F (algebra.adjoin F (↑s : set K)) := (
+    (submodule.fg_iff_finite_dimensional _).1
+      (fg_adjoin_of_finite s.finite_to_set H3)).of_subalgebra_to_submodule,
+  letI := field_of_finite_dimensional F (algebra.adjoin F (↑s : set K)),
+  have H5 : is_integral (algebra.adjoin F (↑s : set K)) a := is_integral_of_is_scalar_tower H1,
+  have H6 : (minpoly (algebra.adjoin F (↑s : set K)) a).splits
+    (algebra_map (algebra.adjoin F (↑s : set K)) L),
+  { refine polynomial.splits_of_splits_of_dvd _
+      (polynomial.map_ne_zero $ minpoly.ne_zero H1 :
+        polynomial.map (algebra_map _ _) _ ≠ 0)
+      ((polynomial.splits_map_iff _ _).2 _)
+      (minpoly.dvd _ _ _),
+    { rw ← is_scalar_tower.algebra_map_eq, exact H2 },
+    { rw [polynomial.aeval_map_algebra_map, minpoly.aeval] } },
+  obtain ⟨y, hy⟩ := polynomial.exists_root_of_splits _ H6 (ne_of_lt (minpoly.degree_pos H5)).symm,
+  refine ⟨subalgebra.of_restrict_scalars _ _ _⟩,
+  refine (adjoin_root.lift_hom (minpoly (algebra.adjoin F (↑s : set K)) a) y hy).comp _,
+  exact alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly (algebra.adjoin F (↑s : set K)) a
+end
+
+end embeddings
diff --git a/src/ring_theory/adjoin/power_basis.lean b/src/ring_theory/adjoin/power_basis.lean
index ad351319b24b0..070b9fc1506c1 100644
--- a/src/ring_theory/adjoin/power_basis.lean
+++ b/src/ring_theory/adjoin/power_basis.lean
@@ -11,6 +11,9 @@ import linear_algebra.matrix.basis
 /-!
 # Power basis for `algebra.adjoin R {x}`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the canonical power basis on `algebra.adjoin R {x}`,
 where `x` is an integral element over `R`.
 -/
@@ -27,11 +30,11 @@ open_locale big_operators
 
 /-- The elements `1, x, ..., x ^ (d - 1)` for a basis for the `K`-module `K[x]`,
 where `d` is the degree of the minimal polynomial of `x`. -/
-noncomputable def adjoin.power_basis_aux {x : S} (hx : _root_.is_integral K x) :
+noncomputable def adjoin.power_basis_aux {x : S} (hx : is_integral K x) :
   basis (fin (minpoly K x).nat_degree) K (adjoin K ({x} : set S)) :=
 begin
   have hST : function.injective (algebra_map (adjoin K ({x} : set S)) S) := subtype.coe_injective,
-  have hx' : _root_.is_integral K
+  have hx' : is_integral K
     (show adjoin K ({x} : set S), from ⟨x, subset_adjoin (set.mem_singleton x)⟩),
   { apply (is_integral_algebra_map_iff hST).mp,
     convert hx,
@@ -39,10 +42,9 @@ begin
   have minpoly_eq := minpoly.eq_of_algebra_map_eq hST hx' rfl,
   apply @basis.mk (fin (minpoly K x).nat_degree) _
     (adjoin K {x}) (λ i, ⟨x, subset_adjoin (set.mem_singleton x)⟩ ^ (i : ℕ)),
-  { have := hx'.linear_independent_pow,
+  { have := linear_independent_pow _,
     rwa minpoly_eq at this },
-  { rw _root_.eq_top_iff,
-    rintros ⟨y, hy⟩ _,
+  { rintros ⟨y, hy⟩ _,
     have := hx'.mem_span_pow,
     rw minpoly_eq at this,
     apply this,
@@ -50,12 +52,13 @@ begin
       obtain ⟨f, rfl⟩ := (aeval x).mem_range.mp hy,
       use f,
       ext,
-      exact (is_scalar_tower.algebra_map_aeval K (adjoin K {x}) S ⟨x, _⟩ _).symm } }
+      exact aeval_algebra_map_apply S (⟨x, _⟩ : adjoin K {x}) _, } }
 end
 
 /-- The power basis `1, x, ..., x ^ (d - 1)` for `K[x]`,
-where `d` is the degree of the minimal polynomial of `x`. -/
-@[simps gen dim] noncomputable def adjoin.power_basis {x : S} (hx : _root_.is_integral K x) :
+where `d` is the degree of the minimal polynomial of `x`. See `algebra.adjoin.power_basis'` for
+a version over a more general base ring. -/
+@[simps gen dim] noncomputable def adjoin.power_basis {x : S} (hx : is_integral K x) :
   power_basis K (adjoin K ({x} : set S)) :=
 { gen := ⟨x, subset_adjoin (set.mem_singleton x)⟩,
   dim := (minpoly K x).nat_degree,
@@ -66,9 +69,10 @@ end algebra
 
 open algebra
 
-/-- The power basis given by `x` if `B.gen ∈ adjoin K {x}`. -/
+/-- The power basis given by `x` if `B.gen ∈ adjoin K {x}`. See `power_basis.of_gen_mem_adjoin'`
+for a version over a more general base ring. -/
 @[simps] noncomputable def power_basis.of_gen_mem_adjoin {x : S} (B : power_basis K S)
-  (hint : _root_.is_integral K x) (hx : B.gen ∈ adjoin K ({x} : set S)) : power_basis K S :=
+  (hint : is_integral K x) (hx : B.gen ∈ adjoin K ({x} : set S)) : power_basis K S :=
 (algebra.adjoin.power_basis hint).map $
   (subalgebra.equiv_of_eq _ _ $ power_basis.adjoin_eq_top_of_gen_mem_adjoin hx).trans
   subalgebra.top_equiv
@@ -172,7 +176,7 @@ if `minpoly K B.gen = (minpoly R B.gen).map (algebra_map R L)`. This is the case
 if `R` is a GCD domain and `K` is its fraction ring. -/
 lemma to_matrix_is_integral {B B' : power_basis K S} {P : R[X]} (h : aeval B.gen P = B'.gen)
   (hB : is_integral R B.gen) (hmin : minpoly K B.gen = (minpoly R B.gen).map (algebra_map R K)) :
-  ∀ i j, _root_.is_integral R (B.basis.to_matrix B'.basis i j) :=
+  ∀ i j, is_integral R (B.basis.to_matrix B'.basis i j) :=
 begin
   intros i j,
   rw [B.basis.to_matrix_apply, B'.coe_basis],
diff --git a/src/ring_theory/adjoin/tower.lean b/src/ring_theory/adjoin/tower.lean
new file mode 100644
index 0000000000000..eb67e7e843c1f
--- /dev/null
+++ b/src/ring_theory/adjoin/tower.lean
@@ -0,0 +1,147 @@
+/-
+Copyright (c) 2020 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau
+-/
+import ring_theory.adjoin.fg
+
+/-!
+# Adjoining elements and being finitely generated in an algebra tower
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main results
+
+ * `algebra.fg_trans'`: if `S` is finitely generated as `R`-algebra and `A` as `S`-algebra,
+   then `A` is finitely generated as `R`-algebra
+ * `fg_of_fg_of_fg`: **Artin--Tate lemma**: if C/B/A is a tower of rings, and A is noetherian, and
+   C is algebra-finite over A, and C is module-finite over B, then B is algebra-finite over A.
+-/
+
+open_locale pointwise
+universes u v w u₁
+
+variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)
+
+namespace algebra
+
+theorem adjoin_algebra_map (R : Type u) (S : Type v) (A : Type w)
+  [comm_semiring R] [comm_semiring S] [semiring A] [algebra R S] [algebra S A] [algebra R A]
+  [is_scalar_tower R S A] (s : set S) :
+  adjoin R (algebra_map S A '' s) = (adjoin R s).map (is_scalar_tower.to_alg_hom R S A) :=
+le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
+  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)
+
+lemma adjoin_restrict_scalars (C D E : Type*) [comm_semiring C] [comm_semiring D] [comm_semiring E]
+  [algebra C D] [algebra C E] [algebra D E] [is_scalar_tower C D E] (S : set E) :
+(algebra.adjoin D S).restrict_scalars C =
+  (algebra.adjoin
+    ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) S).restrict_scalars C :=
+begin
+  suffices : set.range (algebra_map D E) =
+    set.range (algebra_map ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) E),
+  { ext x, change x ∈ subsemiring.closure (_ ∪ S) ↔ x ∈ subsemiring.closure (_ ∪ S), rw this },
+  ext x,
+  split,
+  { rintros ⟨y, hy⟩,
+    exact ⟨⟨algebra_map D E y, ⟨y, ⟨algebra.mem_top, rfl⟩⟩⟩, hy⟩ },
+  { rintros ⟨⟨y, ⟨z, ⟨h0, h1⟩⟩⟩, h2⟩,
+    exact ⟨z, eq.trans h1 h2⟩ },
+end
+
+lemma adjoin_res_eq_adjoin_res (C D E F : Type*) [comm_semiring C] [comm_semiring D]
+  [comm_semiring E] [comm_semiring F] [algebra C D] [algebra C E] [algebra C F] [algebra D F]
+  [algebra E F] [is_scalar_tower C D F] [is_scalar_tower C E F] {S : set D} {T : set E}
+  (hS : algebra.adjoin C S = ⊤) (hT : algebra.adjoin C T = ⊤) :
+(algebra.adjoin E (algebra_map D F '' S)).restrict_scalars C =
+  (algebra.adjoin D (algebra_map E F '' T)).restrict_scalars C :=
+by rw [adjoin_restrict_scalars C E, adjoin_restrict_scalars C D, ←hS, ←hT, ←algebra.adjoin_image,
+  ←algebra.adjoin_image, ←alg_hom.coe_to_ring_hom, ←alg_hom.coe_to_ring_hom,
+  is_scalar_tower.coe_to_alg_hom, is_scalar_tower.coe_to_alg_hom, ←adjoin_union_eq_adjoin_adjoin,
+  ←adjoin_union_eq_adjoin_adjoin, set.union_comm]
+
+end algebra
+
+section
+open_locale classical
+lemma algebra.fg_trans' {R S A : Type*} [comm_semiring R] [comm_semiring S] [comm_semiring A]
+  [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]
+  (hRS : (⊤ : subalgebra R S).fg) (hSA : (⊤ : subalgebra S A).fg) :
+  (⊤ : subalgebra R A).fg :=
+let ⟨s, hs⟩ := hRS, ⟨t, ht⟩ := hSA in ⟨s.image (algebra_map S A) ∪ t,
+by rw [finset.coe_union, finset.coe_image, algebra.adjoin_union_eq_adjoin_adjoin,
+  algebra.adjoin_algebra_map, hs, algebra.map_top, is_scalar_tower.adjoin_range_to_alg_hom, ht,
+  subalgebra.restrict_scalars_top]⟩
+end
+
+section artin_tate
+
+variables (C : Type*)
+
+section semiring
+
+variables [comm_semiring A] [comm_semiring B] [semiring C]
+variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]
+
+open finset submodule
+open_locale classical
+
+lemma exists_subalgebra_of_fg (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg) :
+  ∃ B₀ : subalgebra A B, B₀.fg ∧ (⊤ : submodule B₀ C).fg :=
+begin
+  cases hAC with x hx,
+  cases hBC with y hy, have := hy,
+  simp_rw [eq_top_iff', mem_span_finset] at this, choose f hf,
+  let s : finset B := finset.image₂ f (x ∪ (y * y)) y,
+  have hxy : ∀ xi ∈ x, xi ∈ span (algebra.adjoin A (↑s : set B))
+               (↑(insert 1 y : finset C) : set C) :=
+    λ xi hxi, hf xi ▸ sum_mem (λ yj hyj, smul_mem
+      (span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C))
+      ⟨f xi yj, algebra.subset_adjoin $ mem_image₂_of_mem (mem_union_left _ hxi) hyj⟩
+      (subset_span $ mem_insert_of_mem hyj)),
+  have hyy : span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) *
+      span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) ≤
+    span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C),
+  { rw [span_mul_span, span_le, coe_insert], rintros _ ⟨yi, yj, rfl | hyi, rfl | hyj, rfl⟩,
+    { rw mul_one, exact subset_span (set.mem_insert _ _) },
+    { rw one_mul, exact subset_span (set.mem_insert_of_mem _ hyj) },
+    { rw mul_one, exact subset_span (set.mem_insert_of_mem _ hyi) },
+    { rw ← hf (yi * yj), exact set_like.mem_coe.2 (sum_mem $ λ yk hyk, smul_mem
+        (span (algebra.adjoin A (↑s : set B)) (insert 1 ↑y : set C))
+        ⟨f (yi * yj) yk, algebra.subset_adjoin $ mem_image₂_of_mem (mem_union_right _ $
+          mul_mem_mul hyi hyj) hyk⟩
+        (subset_span $ set.mem_insert_of_mem _ hyk : yk ∈ _)) } },
+  refine ⟨algebra.adjoin A (↑s : set B), subalgebra.fg_adjoin_finset _, insert 1 y, _⟩,
+  refine restrict_scalars_injective A _ _ _,
+  rw [restrict_scalars_top, eq_top_iff, ← algebra.top_to_submodule, ← hx,
+    algebra.adjoin_eq_span, span_le],
+  refine λ r hr, submonoid.closure_induction hr (λ c hc, hxy c hc)
+    (subset_span $ mem_insert_self _ _) (λ p q hp hq, hyy $ submodule.mul_mem_mul hp hq)
+end
+
+end semiring
+
+section ring
+
+variables [comm_ring A] [comm_ring B] [comm_ring C]
+variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]
+
+/-- **Artin--Tate lemma**: if A ⊆ B ⊆ C is a chain of subrings of commutative rings, and
+A is noetherian, and C is algebra-finite over A, and C is module-finite over B,
+then B is algebra-finite over A.
+
+References: Atiyah--Macdonald Proposition 7.8; Stacks 00IS; Altman--Kleiman 16.17. -/
+theorem fg_of_fg_of_fg [is_noetherian_ring A]
+  (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg)
+  (hBCi : function.injective (algebra_map B C)) :
+  (⊤ : subalgebra A B).fg :=
+let ⟨B₀, hAB₀, hB₀C⟩ := exists_subalgebra_of_fg A B C hAC hBC in
+algebra.fg_trans' (B₀.fg_top.2 hAB₀) $ subalgebra.fg_of_submodule_fg $
+have is_noetherian_ring B₀, from is_noetherian_ring_of_fg hAB₀,
+have is_noetherian B₀ C, by exactI is_noetherian_of_fg_of_noetherian' hB₀C,
+by exactI fg_of_injective (is_scalar_tower.to_alg_hom B₀ B C).to_linear_map hBCi
+
+end ring
+
+end artin_tate
diff --git a/src/ring_theory/adjoin_root.lean b/src/ring_theory/adjoin_root.lean
index 6cbe1d691a6b2..efb922d502378 100644
--- a/src/ring_theory/adjoin_root.lean
+++ b/src/ring_theory/adjoin_root.lean
@@ -3,19 +3,30 @@ Copyright (c) 2018 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Chris Hughes
 -/
+import algebra.algebra.basic
 import data.polynomial.field_division
-import linear_algebra.finite_dimensional
+import field_theory.minpoly.basic
 import ring_theory.adjoin.basic
+import ring_theory.finite_presentation
+import ring_theory.finite_type
 import ring_theory.power_basis
 import ring_theory.principal_ideal_domain
+import ring_theory.quotient_noetherian
 
 /-!
 # Adjoining roots of polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the commutative ring `adjoin_root f`, the ring R[X]/(f) obtained from a
 commutative ring `R` and a polynomial `f : R[X]`. If furthermore `R` is a field and `f` is
 irreducible, the field structure on `adjoin_root f` is constructed.
 
+We suggest stating results on `is_adjoin_root` instead of `adjoin_root` to achieve higher
+generality, since `is_adjoin_root` works for all different constructions of `R[α]`
+including `adjoin_root f = R[X]/(f)` itself.
+
 ## Main definitions and results
 
 The main definitions are in the `adjoin_root` namespace.
@@ -47,7 +58,7 @@ variables {R : Type u} {S : Type v} {K : Type w}
 open polynomial ideal
 
 /-- Adjoin a root of a polynomial `f` to a commutative ring `R`. We define the new ring
-as the quotient of `polynomial R` by the principal ideal generated by `f`. -/
+as the quotient of `R[X]` by the principal ideal generated by `f`. -/
 def adjoin_root [comm_ring R] (f : R[X]) : Type u :=
 polynomial R ⧸ (span {f} : ideal R[X])
 
@@ -62,6 +73,14 @@ instance : inhabited (adjoin_root f) := ⟨0⟩
 
 instance : decidable_eq (adjoin_root f) := classical.dec_eq _
 
+protected lemma nontrivial [is_domain R] (h : degree f ≠ 0) : nontrivial (adjoin_root f) :=
+ideal.quotient.nontrivial
+begin
+  simp_rw [ne.def, span_singleton_eq_top, polynomial.is_unit_iff, not_exists, not_and],
+  rintro x hx rfl,
+  exact h (degree_C hx.ne_zero),
+end
+
 /-- Ring homomorphism from `R[x]` to `adjoin_root f` sending `X` to the `root`. -/
 def mk : R[X] →+* adjoin_root f := ideal.quotient.mk _
 
@@ -73,18 +92,41 @@ quotient.induction_on' x ih
 /-- Embedding of the original ring `R` into `adjoin_root f`. -/
 def of : R →+* adjoin_root f := (mk f).comp C
 
-instance [comm_semiring S] [algebra S R] : algebra S (adjoin_root f) :=
-ideal.quotient.algebra S
+instance [distrib_smul S R] [is_scalar_tower S R R] : has_smul S (adjoin_root f) :=
+submodule.quotient.has_smul' _
+
+instance [distrib_smul S R] [is_scalar_tower S R R] : distrib_smul S (adjoin_root f) :=
+submodule.quotient.distrib_smul' _
+
+@[simp]
+lemma smul_mk [distrib_smul S R] [is_scalar_tower S R R] (a : S) (x : R[X]) :
+  a • mk f x = mk f (a • x) := rfl
 
-instance [comm_semiring S] [comm_semiring K] [has_scalar S K] [algebra S R] [algebra K R]
-  [is_scalar_tower S K R] :
-  is_scalar_tower S K (adjoin_root f) :=
+lemma smul_of [distrib_smul S R] [is_scalar_tower S R R] (a : S) (x : R) :
+  a • of f x = of f (a • x) :=
+by rw [of, ring_hom.comp_apply, ring_hom.comp_apply, smul_mk, smul_C]
+
+instance (R₁ R₂ : Type*) [has_smul R₁ R₂] [distrib_smul R₁ R] [distrib_smul R₂ R]
+  [is_scalar_tower R₁ R R] [is_scalar_tower R₂ R R] [is_scalar_tower R₁ R₂ R] (f : R[X]) :
+  is_scalar_tower R₁ R₂ (adjoin_root f) :=
 submodule.quotient.is_scalar_tower _ _
 
-instance [comm_semiring S] [comm_semiring K] [algebra S R] [algebra K R] [smul_comm_class S K R] :
-  smul_comm_class S K (adjoin_root f) :=
+instance (R₁ R₂ : Type*) [distrib_smul R₁ R] [distrib_smul R₂ R]
+  [is_scalar_tower R₁ R R] [is_scalar_tower R₂ R R] [smul_comm_class R₁ R₂ R] (f : R[X]) :
+  smul_comm_class R₁ R₂ (adjoin_root f) :=
 submodule.quotient.smul_comm_class _ _
 
+instance is_scalar_tower_right [distrib_smul S R] [is_scalar_tower S R R] :
+  is_scalar_tower S (adjoin_root f) (adjoin_root f) :=
+ideal.quotient.is_scalar_tower_right
+
+instance [monoid S] [distrib_mul_action S R] [is_scalar_tower S R R] (f : R[X]) :
+  distrib_mul_action S (adjoin_root f) :=
+submodule.quotient.distrib_mul_action' _
+
+instance [comm_semiring S] [algebra S R] : algebra S (adjoin_root f) :=
+ideal.quotient.algebra S
+
 @[simp] lemma algebra_map_eq : algebra_map R (adjoin_root f) = of f := rfl
 
 variables (S)
@@ -94,23 +136,46 @@ lemma algebra_map_eq' [comm_semiring S] [algebra S R] :
 
 variables {S}
 
+lemma finite_type : algebra.finite_type R (adjoin_root f) :=
+(algebra.finite_type.polynomial R).of_surjective _ (ideal.quotient.mkₐ_surjective R _)
+
+lemma finite_presentation : algebra.finite_presentation R (adjoin_root f) :=
+(algebra.finite_presentation.polynomial R).quotient (submodule.fg_span_singleton f)
+
 /-- The adjoined root. -/
 def root : adjoin_root f := mk f X
 
 variables {f}
 
-instance adjoin_root.has_coe_t : has_coe_t R (adjoin_root f) := ⟨of f⟩
+instance has_coe_t : has_coe_t R (adjoin_root f) := ⟨of f⟩
+
+/-- Two `R`-`alg_hom` from `adjoin_root f` to the same `R`-algebra are the same iff
+    they agree on `root f`. -/
+@[ext] lemma alg_hom_ext [semiring S] [algebra R S] {g₁ g₂ : adjoin_root f →ₐ[R] S}
+  (h : g₁ (root f) = g₂ (root f)) : g₁ = g₂ :=
+ideal.quotient.alg_hom_ext R $ polynomial.alg_hom_ext h
 
 @[simp] lemma mk_eq_mk {g h : R[X]} : mk f g = mk f h ↔ f ∣ g - h :=
 ideal.quotient.eq.trans ideal.mem_span_singleton
 
+@[simp] lemma mk_eq_zero {g : R[X]} : mk f g = 0 ↔ f ∣ g :=
+mk_eq_mk.trans $ by rw sub_zero
+
 @[simp] lemma mk_self : mk f f = 0 :=
-quotient.sound' (mem_span_singleton.2 $ by simp)
+quotient.sound' $ quotient_add_group.left_rel_apply.mpr (mem_span_singleton.2 $ by simp)
 
 @[simp] lemma mk_C (x : R) : mk f (C x) = x := rfl
 
 @[simp] lemma mk_X : mk f X = root f := rfl
 
+lemma mk_ne_zero_of_degree_lt (hf : monic f)
+  {g : R[X]} (h0 : g ≠ 0) (hd : degree g < degree f) : mk f g ≠ 0 :=
+mk_eq_zero.not.2 $ hf.not_dvd_of_degree_lt h0 hd
+
+lemma mk_ne_zero_of_nat_degree_lt (hf : monic f)
+  {g : R[X]} (h0 : g ≠ 0) (hd : nat_degree g < nat_degree f) : mk f g ≠ 0 :=
+mk_eq_zero.not.2 $ hf.not_dvd_of_nat_degree_lt h0 hd
+
 @[simp] lemma aeval_eq (p : R[X]) : aeval (root f) p = mk f p :=
 polynomial.induction_on p (λ x, by { rw aeval_C, refl })
   (λ p q ihp ihq, by rw [alg_hom.map_add, ring_hom.map_add, ihp, ihq])
@@ -130,6 +195,20 @@ by rw [is_root, eval_map, eval₂_root]
 lemma is_algebraic_root (hf : f ≠ 0) : is_algebraic R (root f) :=
 ⟨f, hf, eval₂_root f⟩
 
+lemma of.injective_of_degree_ne_zero [is_domain R] (hf : f.degree ≠ 0) :
+  function.injective (adjoin_root.of f) :=
+begin
+  rw injective_iff_map_eq_zero,
+  intros p hp,
+  rw [adjoin_root.of, ring_hom.comp_apply, adjoin_root.mk_eq_zero] at hp,
+  by_cases h : f = 0,
+  { exact C_eq_zero.mp (eq_zero_of_zero_dvd (by rwa h at hp)) },
+  { contrapose! hf with h_contra,
+    rw ← degree_C h_contra,
+    apply le_antisymm (degree_le_of_dvd hp (by rwa [ne.def, C_eq_zero])) _,
+    rwa [degree_C h_contra, zero_le_degree_iff] },
+end
+
 variables [comm_ring S]
 
 /-- Lift a ring homomorphism `i : R →+* S` to `adjoin_root f →+* S`. -/
@@ -192,31 +271,80 @@ lift_root hfx
 @[simp] lemma lift_hom_of {x : R} : lift_hom f a hfx (of f x) = algebra_map _ _ x :=
 lift_of hfx
 
+section adjoin_inv
+
+@[simp] lemma root_is_inv (r : R) : of _ r * root (C r * X - 1) = 1 :=
+by convert sub_eq_zero.1 ((eval₂_sub _).symm.trans $ eval₂_root $ C r * X - 1);
+  simp only [eval₂_mul, eval₂_C, eval₂_X, eval₂_one]
+
+lemma alg_hom_subsingleton {S : Type*} [comm_ring S] [algebra R S] {r : R} :
+  subsingleton (adjoin_root (C r * X - 1) →ₐ[R] S) :=
+⟨λ f g, alg_hom_ext (@inv_unique _ _ (algebra_map R S r) _ _
+  (by rw [← f.commutes, ← f.map_mul, algebra_map_eq, root_is_inv, map_one])
+  (by rw [← g.commutes, ← g.map_mul, algebra_map_eq, root_is_inv, map_one]))⟩
+
+end adjoin_inv
+
+section prime
+
+variable {f}
+
+theorem is_domain_of_prime (hf : prime f) : is_domain (adjoin_root f) :=
+(ideal.quotient.is_domain_iff_prime (span {f} : ideal R[X])).mpr $
+  (ideal.span_singleton_prime hf.ne_zero).mpr hf
+
+theorem no_zero_smul_divisors_of_prime_of_degree_ne_zero [is_domain R] (hf : prime f)
+  (hf' : f.degree ≠ 0) : no_zero_smul_divisors R (adjoin_root f) :=
+begin
+  haveI := is_domain_of_prime hf,
+  exact no_zero_smul_divisors.iff_algebra_map_injective.mpr (of.injective_of_degree_ne_zero hf')
+end
+
+end prime
+
 end comm_ring
 
 section irreducible
 
-variables [field K] {f : K[X]} [irreducible f]
+variables [field K] {f : K[X]}
+
+instance span_maximal_of_irreducible [fact (irreducible f)] : (span {f}).is_maximal :=
+principal_ideal_ring.is_maximal_of_irreducible $ fact.out _
 
-instance is_maximal_span : is_maximal (span {f} : ideal K[X]) :=
-principal_ideal_ring.is_maximal_of_irreducible ‹irreducible f›
+noncomputable instance field [fact (irreducible f)] : field (adjoin_root f) :=
+{ rat_cast := λ a, of f (a : K),
+  rat_cast_mk := λ a b h1 h2,
+  begin
+    letI : group_with_zero (adjoin_root f) := ideal.quotient.group_with_zero _,
+    rw [rat.cast_mk', _root_.map_mul, _root_.map_int_cast, map_inv₀, map_nat_cast],
+  end,
+  qsmul := (•),
+  qsmul_eq_mul' := λ a x, adjoin_root.induction_on _ x (λ p,
+    by { rw [smul_mk, of, ring_hom.comp_apply, ← (mk f).map_mul, polynomial.rat_smul_eq_C_mul] }),
+  ..adjoin_root.comm_ring f,
+  ..ideal.quotient.group_with_zero (span {f} : ideal K[X]) }
 
-noncomputable instance field : field (adjoin_root f) :=
-{ ..adjoin_root.comm_ring f,
-  ..ideal.quotient.field (span {f} : ideal K[X]) }
+lemma coe_injective (h : degree f ≠ 0) : function.injective (coe : K → adjoin_root f) :=
+have _ := adjoin_root.nontrivial f h, by exactI (of f).injective
 
-lemma coe_injective : function.injective (coe : K → adjoin_root f) :=
+lemma coe_injective' [fact (irreducible f)] : function.injective (coe : K → adjoin_root f) :=
 (of f).injective
 
 variable (f)
 
-lemma mul_div_root_cancel :
-  ((X - C (root f)) * (f.map (of f) / (X - C (root f))) : polynomial (adjoin_root f)) =
-    f.map (of f) :=
+lemma mul_div_root_cancel [fact (irreducible f)] :
+  ((X - C (root f)) * (f.map (of f) / (X - C (root f)))) = f.map (of f) :=
 mul_div_eq_iff_is_root.2 $ is_root_root _
 
 end irreducible
 
+section is_noetherian_ring
+
+instance [comm_ring R] [is_noetherian_ring R] {f : R[X]} : is_noetherian_ring (adjoin_root f) :=
+ideal.quotient.is_noetherian_ring _
+
+end is_noetherian_ring
+
 section power_basis
 
 variables [comm_ring R] {g : R[X]}
@@ -251,7 +379,7 @@ lemma mk_surjective (hg : g.monic) : function.surjective (mk g) :=
 
 /-- The elements `1, root g, ..., root g ^ (d - 1)` form a basis for `adjoin_root g`,
 where `g` is a monic polynomial of degree `d`. -/
-@[simps] def power_basis_aux' (hg : g.monic) :
+def power_basis_aux' (hg : g.monic) :
   basis (fin g.nat_degree) R (adjoin_root g) :=
 basis.of_equiv_fun
 { to_fun := λ f i, (mod_by_monic_hom hg f).coeff i,
@@ -267,17 +395,24 @@ basis.of_equiv_fun
   right_inv := λ x, funext $ λ i, begin
     nontriviality R,
     simp only [mod_by_monic_hom_mk],
-    rw [(mod_by_monic_eq_self_iff hg).mpr, finset_sum_coeff, finset.sum_eq_single i];
-      try { simp only [coeff_monomial, eq_self_iff_true, if_true] },
-    { intros j _ hj, exact if_neg (fin.coe_injective.ne hj) },
-    { intros, have := finset.mem_univ i, contradiction },
-    { refine (degree_sum_le _ _).trans_lt ((finset.sup_lt_iff _).mpr (λ j _, _)),
-      { exact bot_lt_iff_ne_bot.mpr (mt degree_eq_bot.mp hg.ne_zero) },
-      { refine (degree_monomial_le _ _).trans_lt _,
-        rw [degree_eq_nat_degree hg.ne_zero, with_bot.coe_lt_coe],
-        exact j.2 } },
+    rw [(mod_by_monic_eq_self_iff hg).mpr, finset_sum_coeff],
+    { simp_rw [coeff_monomial, fin.coe_eq_coe, finset.sum_ite_eq', if_pos (finset.mem_univ _)] },
+    { simp_rw ← C_mul_X_pow_eq_monomial,
+      exact (degree_eq_nat_degree $ hg.ne_zero).symm ▸ degree_sum_fin_lt _ },
   end}
 
+/-- This lemma could be autogenerated by `@[simps]` but unfortunately that would require
+unfolding that causes a timeout. -/
+@[simp] lemma power_basis_aux'_repr_symm_apply (hg : g.monic) (c : fin g.nat_degree →₀ R) :
+  (power_basis_aux' hg).repr.symm c = mk g (∑ (i : fin _), monomial i (c i)) := rfl
+
+/-- This lemma could be autogenerated by `@[simps]` but unfortunately that would require
+unfolding that causes a timeout. -/
+@[simp] theorem power_basis_aux'_repr_apply_to_fun (hg : g.monic) (f : adjoin_root g)
+  (i : fin g.nat_degree) :
+  (power_basis_aux' hg).repr f i = (mod_by_monic_hom hg f).coeff ↑i :=
+rfl
+
 /-- The power basis `1, root g, ..., root g ^ (d - 1)` for `adjoin_root g`,
 where `g` is a monic polynomial of degree `d`. -/
 @[simps] def power_basis' (hg : g.monic) : power_basis R (adjoin_root g) :=
@@ -329,9 +464,8 @@ begin
   have minpoly_eq : minpoly K (root f) = f' := minpoly_root hf,
   apply @basis.mk _ _ _ (λ (i : fin f.nat_degree), (root f ^ i.val)),
   { rw [← deg_f', ← minpoly_eq],
-    exact (is_integral_root hf).linear_independent_pow },
-  { rw _root_.eq_top_iff,
-    rintros y -,
+    exact linear_independent_pow (root f) },
+  { rintros y -,
     rw [← deg_f', ← minpoly_eq],
     apply (is_integral_root hf).mem_span_pow,
     obtain ⟨g⟩ := y,
@@ -361,9 +495,45 @@ end power_basis
 
 section equiv
 
-section is_domain
+section minpoly
+
+variables [comm_ring R] [comm_ring S] [algebra R S] (x : S) (R)
+
+open algebra polynomial
+
+/-- The surjective algebra morphism `R[X]/(minpoly R x) → R[x]`.
+If `R` is a GCD domain and `x` is integral, this is an isomorphism,
+see `adjoin_root.minpoly.equiv_adjoin`. -/
+@[simps] def minpoly.to_adjoin : adjoin_root (minpoly R x) →ₐ[R] adjoin R ({x} : set S) :=
+lift_hom _ ⟨x, self_mem_adjoin_singleton R x⟩
+  (by simp [← subalgebra.coe_eq_zero, aeval_subalgebra_coe])
 
-variables [comm_ring R] [is_domain R] [comm_ring S] [is_domain S] [algebra R S]
+variables {R x}
+
+lemma minpoly.to_adjoin_apply' (a : adjoin_root (minpoly R x)) : minpoly.to_adjoin R x a =
+  lift_hom (minpoly R x) (⟨x, self_mem_adjoin_singleton R x⟩ : adjoin R ({x} : set S))
+  (by simp [← subalgebra.coe_eq_zero, aeval_subalgebra_coe]) a := rfl
+
+lemma minpoly.to_adjoin.apply_X : minpoly.to_adjoin R x (mk (minpoly R x) X) =
+  ⟨x, self_mem_adjoin_singleton R x⟩ :=
+by simp
+
+variables (R x)
+
+lemma minpoly.to_adjoin.surjective : function.surjective (minpoly.to_adjoin R x) :=
+begin
+  rw [← range_top_iff_surjective, _root_.eq_top_iff, ← adjoin_adjoin_coe_preimage],
+  refine adjoin_le _,
+  simp only [alg_hom.coe_range, set.mem_range],
+  rintro ⟨y₁, y₂⟩ h,
+  refine ⟨mk (minpoly R x) X, by simpa using h.symm⟩
+end
+
+end minpoly
+
+section equiv'
+
+variables [comm_ring R] [comm_ring S] [algebra R S]
 variables (g : R[X]) (pb : _root_.power_basis R S)
 
 /-- If `S` is an extension of `R` with power basis `pb` and `g` is a monic polynomial over `R`
@@ -379,6 +549,7 @@ def equiv' (h₁ : aeval (root g) (minpoly R pb.gen) = 0) (h₂ : aeval pb.gen g
   inv_fun := pb.lift (root g) h₁,
   left_inv := λ x, induction_on g x $ λ f, by rw [lift_hom_mk, pb.lift_aeval, aeval_eq],
   right_inv := λ x, begin
+    nontriviality S,
     obtain ⟨f, hf, rfl⟩ := pb.exists_eq_aeval x,
     rw [pb.lift_aeval, aeval_eq, lift_hom_mk]
   end,
@@ -394,7 +565,7 @@ rfl
   (equiv' g pb h₁ h₂).symm.to_alg_hom = pb.lift (root g) h₁ :=
 rfl
 
-end is_domain
+end equiv'
 
 section field
 
@@ -409,7 +580,7 @@ def equiv (f : F[X]) (hf : f ≠ 0) :
   begin
     rw [power_basis_gen, minpoly_root hf, polynomial.map_mul, roots_mul,
         polynomial.map_C, roots_C, add_zero, equiv.refl_apply],
-    { rw ← polynomial.map_mul, exact map_monic_ne_zero (monic_mul_leading_coeff_inv hf) }
+    rw ← polynomial.map_mul, exact map_monic_ne_zero (monic_mul_leading_coeff_inv hf)
   end))
 
 end field
@@ -420,14 +591,15 @@ section
 
 open ideal double_quot polynomial
 
-variables [comm_ring R] (I : ideal R) (f : polynomial R)
+variables [comm_ring R] (I : ideal R) (f : R[X])
 
 /-- The natural isomorphism `R[α]/(I[α]) ≅ R[α]/((I[x] ⊔ (f)) / (f))` for `α` a root of
-`f : polynomial R` and `I : ideal R`.
+`f : R[X]` and `I : ideal R`.
 
 See `adjoin_root.quot_map_of_equiv` for the isomorphism with `(R/I)[X] / (f mod I)`. -/
 def quot_map_of_equiv_quot_map_C_map_span_mk :
-  adjoin_root f ⧸ I.map (of f) ≃+* adjoin_root f ⧸ (I.map C).map (span {f})^.quotient.mk :=
+  adjoin_root f ⧸ I.map (of f) ≃+*
+    adjoin_root f ⧸ (I.map (C : R →+* R[X])).map (span {f})^.quotient.mk :=
 ideal.quot_equiv_of_eq (by rw [of, adjoin_root.mk, ideal.map_map])
 
 @[simp]
@@ -436,12 +608,20 @@ lemma quot_map_of_equiv_quot_map_C_map_span_mk_mk (x : adjoin_root f) :
     ideal.quotient.mk _ x :=
 rfl
 
+--this lemma should have the simp tag but this causes a lint issue
+lemma quot_map_of_equiv_quot_map_C_map_span_mk_symm_mk (x : adjoin_root f) :
+  (quot_map_of_equiv_quot_map_C_map_span_mk I f).symm
+  (ideal.quotient.mk ((I.map (C : R →+* R[X])).map (span {f})^.quotient.mk) x) =
+    ideal.quotient.mk (I.map (of f)) x :=
+by rw [quot_map_of_equiv_quot_map_C_map_span_mk, ideal.quot_equiv_of_eq_symm, quot_equiv_of_eq_mk]
+
 /-- The natural isomorphism `R[α]/((I[x] ⊔ (f)) / (f)) ≅ (R[x]/I[x])/((f) ⊔ I[x] / I[x])`
-  for `α` a root of `f : polynomial R` and `I : ideal R`-/
+  for `α` a root of `f : R[X]` and `I : ideal R`-/
 def quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk :
-  (adjoin_root f) ⧸ ((I.map (C : R →+* R[X]))).map (span {f})^.quotient.mk ≃+*
-    (R[X] ⧸ map C I) ⧸ (span {f}).map (I.map C)^.quotient.mk :=
-quot_quot_equiv_comm (span ({f} : set (polynomial R))) (I.map (C : R →+* polynomial R))
+  (adjoin_root f) ⧸ (I.map (C : R →+* R[X])).map (span ({f} : set R[X]))^.quotient.mk ≃+*
+    (R[X] ⧸ I.map (C : R →+* R[X])) ⧸ (span ({f} : set R[X])).map
+    (I.map (C : R →+* R[X]))^.quotient.mk :=
+quot_quot_equiv_comm (ideal.span ({f} : set R[X])) (I.map (C : R →+* R[X]))
 
 @[simp]
 lemma quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk_mk (p : R[X]) :
@@ -449,8 +629,14 @@ lemma quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk_mk (p : R[X]) :
     quot_quot_mk (I.map C) (span {f}) p :=
 rfl
 
+@[simp]
+lemma quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk_symm_quot_quot_mk (p : R[X]) :
+  (quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk I f).symm
+  (quot_quot_mk (I.map C) (span {f}) p) = (ideal.quotient.mk _ (mk f p)) :=
+rfl
+
 /-- The natural isomorphism `(R/I)[x]/(f mod I) ≅ (R[x]/I*R[x])/(f mod I[x])` where
-  `f : polynomial R` and `I : ideal R`-/
+  `f : R[X]` and `I : ideal R`-/
 def polynomial.quot_quot_equiv_comm :
   (R ⧸ I)[X] ⧸ span ({f.map (I^.quotient.mk)} : set (polynomial (R ⧸ I))) ≃+*
     (R[X] ⧸ map C I) ⧸ span ({(ideal.quotient.mk (I.map C)) f} : set (R[X] ⧸ map C I)) :=
@@ -461,34 +647,127 @@ quotient_equiv (span ({f.map (I^.quotient.mk)} : set (polynomial (R ⧸ I))))
     polynomial_quotient_equiv_quotient_polynomial_map_mk I f])
 
 @[simp]
-lemma polynomial.quot_quot_equiv_comm_mk_mk (p : R[X]) :
+lemma polynomial.quot_quot_equiv_comm_mk (p : R[X]) :
+  (polynomial.quot_quot_equiv_comm I f) (ideal.quotient.mk  _ (p.map I^.quotient.mk)) =
+  (ideal.quotient.mk _ (ideal.quotient.mk _ p)) :=
+by simp only [polynomial.quot_quot_equiv_comm, quotient_equiv_mk,
+  polynomial_quotient_equiv_quotient_polynomial_map_mk]
+
+@[simp]
+lemma polynomial.quot_quot_equiv_comm_symm_mk_mk (p : R[X]) :
   (polynomial.quot_quot_equiv_comm I f).symm (ideal.quotient.mk _ (ideal.quotient.mk _ p)) =
     (ideal.quotient.mk  _ (p.map I^.quotient.mk)) :=
 by simp only [polynomial.quot_quot_equiv_comm, quotient_equiv_symm_mk,
   polynomial_quotient_equiv_quotient_polynomial_symm_mk]
 
-/-- The natural isomorphism `R[α]/I[α] ≅ (R/I)[X]/(f mod I)` for `α` a root of `f : polynomial R`
-  and `I : ideal R`-/
-def quot_map_of_equiv : (adjoin_root f) ⧸ (I.map (of f)) ≃+*
-  polynomial (R ⧸ I) ⧸ (span ({f.map (I^.quotient.mk)} : set (polynomial (R ⧸ I)))) :=
+/-- The natural isomorphism `R[α]/I[α] ≅ (R/I)[X]/(f mod I)` for `α` a root of `f : R[X]`
+  and `I : ideal R`.-/
+def quot_adjoin_root_equiv_quot_polynomial_quot : (adjoin_root f) ⧸ (I.map (of f)) ≃+*
+  (R ⧸ I)[X] ⧸ (span ({f.map (I^.quotient.mk)} : set (R ⧸ I)[X])) :=
 (quot_map_of_equiv_quot_map_C_map_span_mk I f).trans
   ((quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk I f).trans
   ((ideal.quot_equiv_of_eq
-  (show (span ({f} : set (polynomial R))).map (I.map (C : R →+* polynomial R))^.quotient.mk =
-    span ({(ideal.quotient.mk (I.map polynomial.C)) f} : set (polynomial R ⧸ map C I)),
+  (show (span ({f} : set R[X])).map (I.map (C : R →+* R[X]))^.quotient.mk =
+    span ({(ideal.quotient.mk (I.map polynomial.C)) f} : set (R[X] ⧸ map C I)),
     from by rw [map_span, set.image_singleton])).trans
   (polynomial.quot_quot_equiv_comm I f).symm))
 
 @[simp]
 lemma quot_adjoin_root_equiv_quot_polynomial_quot_mk_of (p : R[X]) :
-  quot_map_of_equiv I f (ideal.quotient.mk (I.map (of f)) (mk f p)) =
-    ideal.quotient.mk (span ({f.map (I^.quotient.mk)} : set (polynomial (R ⧸ I))))
+  quot_adjoin_root_equiv_quot_polynomial_quot I f (ideal.quotient.mk (I.map (of f)) (mk f p)) =
+    ideal.quotient.mk (span ({f.map (I^.quotient.mk)} : set (R ⧸ I)[X]))
     (p.map I^.quotient.mk) :=
-by rw [quot_map_of_equiv, ring_equiv.trans_apply, ring_equiv.trans_apply, ring_equiv.trans_apply,
-    quot_map_of_equiv_quot_map_C_map_span_mk_mk,
-    quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk_mk,quot_quot_mk, ring_hom.comp_apply,
-    quot_equiv_of_eq_mk, polynomial.quot_quot_equiv_comm_mk_mk]
+by rw [quot_adjoin_root_equiv_quot_polynomial_quot, ring_equiv.trans_apply, ring_equiv.trans_apply,
+    ring_equiv.trans_apply, quot_map_of_equiv_quot_map_C_map_span_mk_mk,
+    quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk_mk, quot_quot_mk, ring_hom.comp_apply,
+    quot_equiv_of_eq_mk, polynomial.quot_quot_equiv_comm_symm_mk_mk]
+
+@[simp]
+lemma quot_adjoin_root_equiv_quot_polynomial_quot_symm_mk_mk (p : R[X]) :
+  (quot_adjoin_root_equiv_quot_polynomial_quot I f).symm
+  (ideal.quotient.mk (span ({f.map (I^.quotient.mk)} : set (R ⧸ I)[X]))
+    (p.map I^.quotient.mk)) = (ideal.quotient.mk (I.map (of f)) (mk f p)) :=
+by rw [quot_adjoin_root_equiv_quot_polynomial_quot, ring_equiv.symm_trans_apply,
+    ring_equiv.symm_trans_apply, ring_equiv.symm_trans_apply, ring_equiv.symm_symm,
+    polynomial.quot_quot_equiv_comm_mk, ideal.quot_equiv_of_eq_symm,
+    ideal.quot_equiv_of_eq_mk, ← ring_hom.comp_apply, ← double_quot.quot_quot_mk,
+    quot_map_C_map_span_mk_equiv_quot_map_C_quot_map_span_mk_symm_quot_quot_mk,
+    quot_map_of_equiv_quot_map_C_map_span_mk_symm_mk]
+
+/-- Promote `adjoin_root.quot_adjoin_root_equiv_quot_polynomial_quot` to an alg_equiv.  -/
+@[simps apply symm_apply]
+noncomputable def quot_equiv_quot_map (f : R[X]) (I : ideal R) :
+  ((adjoin_root f) ⧸ (ideal.map (of f) I)) ≃ₐ[R]
+     ((R ⧸ I) [X]) ⧸ (ideal.span ({polynomial.map I^.quotient.mk f} : set ((R ⧸ I) [X]))) :=
+alg_equiv.of_ring_equiv (show ∀ x, (quot_adjoin_root_equiv_quot_polynomial_quot I f)
+  (algebra_map R _ x) = algebra_map R _ x, from λ x, begin
+    have : algebra_map R ((adjoin_root f) ⧸ (ideal.map (of f) I)) x = ideal.quotient.mk
+      (ideal.map (adjoin_root.of f) I) ((mk f) (C x)) := rfl,
+    simpa only [this, quot_adjoin_root_equiv_quot_polynomial_quot_mk_of, map_C]
+  end)
+
+@[simp]
+lemma quot_equiv_quot_map_apply_mk (f g : R[X]) (I : ideal R)  :
+  adjoin_root.quot_equiv_quot_map f I (ideal.quotient.mk _ (adjoin_root.mk f g)) =
+    ideal.quotient.mk _ (g.map I^.quotient.mk) :=
+by rw [adjoin_root.quot_equiv_quot_map_apply,
+    adjoin_root.quot_adjoin_root_equiv_quot_polynomial_quot_mk_of]
+
+@[simp]
+lemma quot_equiv_quot_map_symm_apply_mk (f g : R[X]) (I : ideal R)  :
+  (adjoin_root.quot_equiv_quot_map f I).symm (ideal.quotient.mk _ (map (ideal.quotient.mk I) g)) =
+    ideal.quotient.mk _ (adjoin_root.mk f g) :=
+by rw [adjoin_root.quot_equiv_quot_map_symm_apply,
+    adjoin_root.quot_adjoin_root_equiv_quot_polynomial_quot_symm_mk_mk]
 
 end
 
 end adjoin_root
+
+namespace power_basis
+
+open adjoin_root alg_equiv
+
+variables [comm_ring R] [comm_ring S] [algebra R S]
+
+/-- Let `α` have minimal polynomial `f` over `R` and `I` be an ideal of `R`,
+then `R[α] / (I) = (R[x] / (f)) / pS = (R/p)[x] / (f mod p)`. -/
+@[simps apply symm_apply]
+noncomputable def quotient_equiv_quotient_minpoly_map (pb : power_basis R S)
+  (I : ideal R) :
+  (S ⧸ I.map (algebra_map R S)) ≃ₐ[R] (polynomial (R ⧸ I)) ⧸
+    (ideal.span ({(minpoly R pb.gen).map I^.quotient.mk} : set (polynomial (R ⧸ I)))) :=
+(of_ring_equiv
+  (show ∀ x, (ideal.quotient_equiv _ (ideal.map (adjoin_root.of (minpoly R pb.gen)) I)
+    (adjoin_root.equiv' (minpoly R pb.gen) pb
+    (by rw [adjoin_root.aeval_eq, adjoin_root.mk_self])
+    (minpoly.aeval _ _)).symm.to_ring_equiv
+    (by rw [ideal.map_map, alg_equiv.to_ring_equiv_eq_coe, ← alg_equiv.coe_ring_hom_commutes,
+          ← adjoin_root.algebra_map_eq, alg_hom.comp_algebra_map]))
+    (algebra_map R (S ⧸ I.map (algebra_map R S)) x) = algebra_map R _ x, from
+  (λ x, by rw [← ideal.quotient.mk_algebra_map, ideal.quotient_equiv_apply,
+    ring_hom.to_fun_eq_coe, ideal.quotient_map_mk, alg_equiv.to_ring_equiv_eq_coe,
+    ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv, alg_equiv.commutes,
+    quotient.mk_algebra_map]))).trans (adjoin_root.quot_equiv_quot_map _ _)
+
+@[simp]
+lemma quotient_equiv_quotient_minpoly_map_apply_mk (pb : power_basis R S) (I : ideal R)
+  (g : R[X]) : pb.quotient_equiv_quotient_minpoly_map I
+  (ideal.quotient.mk _ (aeval pb.gen g)) = ideal.quotient.mk _ (g.map I^.quotient.mk) :=
+by rw [power_basis.quotient_equiv_quotient_minpoly_map, alg_equiv.trans_apply,
+    alg_equiv.of_ring_equiv_apply, quotient_equiv_mk, alg_equiv.coe_ring_equiv',
+    adjoin_root.equiv'_symm_apply, power_basis.lift_aeval,
+    adjoin_root.aeval_eq, adjoin_root.quot_equiv_quot_map_apply_mk]
+
+@[simp]
+lemma quotient_equiv_quotient_minpoly_map_symm_apply_mk (pb : power_basis R S) (I : ideal R)
+  (g : R[X]) : (pb.quotient_equiv_quotient_minpoly_map I).symm
+  (ideal.quotient.mk _ (g.map I^.quotient.mk)) = (ideal.quotient.mk _ (aeval pb.gen g)) :=
+begin simp only [quotient_equiv_quotient_minpoly_map, to_ring_equiv_eq_coe, symm_trans_apply,
+    quot_equiv_quot_map_symm_apply_mk, of_ring_equiv_symm_apply, quotient_equiv_symm_mk,
+    to_ring_equiv_symm, ring_equiv.symm_symm, adjoin_root.equiv'_apply, coe_ring_equiv,
+    lift_hom_mk, symm_to_ring_equiv],
+
+end
+
+end power_basis
diff --git a/src/ring_theory/algebra_tower.lean b/src/ring_theory/algebra_tower.lean
index 8d019859161ba..84b1b34d5c37c 100644
--- a/src/ring_theory/algebra_tower.lean
+++ b/src/ring_theory/algebra_tower.lean
@@ -3,15 +3,17 @@ Copyright (c) 2020 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
+import algebra.algebra.tower
 import algebra.invertible
-import ring_theory.adjoin.fg
+import algebra.module.big_operators
 import linear_algebra.basis
-import algebra.algebra.tower
-import algebra.algebra.restrict_scalars
 
 /-!
 # Towers of algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We set up the basic theory of algebra towers.
 An algebra tower A/S/R is expressed by having instances of `algebra A S`,
 `algebra R S`, `algebra R A` and `is_scalar_tower R S A`, the later asserting the
@@ -63,58 +65,6 @@ end comm_semiring
 
 end is_scalar_tower
 
-namespace algebra
-
-theorem adjoin_algebra_map (R : Type u) (S : Type v) (A : Type w)
-  [comm_semiring R] [comm_semiring S] [semiring A] [algebra R S] [algebra S A] [algebra R A]
-  [is_scalar_tower R S A] (s : set S) :
-  adjoin R (algebra_map S A '' s) =
-    subalgebra.map (adjoin R s) (is_scalar_tower.to_alg_hom R S A) :=
-le_antisymm (adjoin_le $ set.image_subset_iff.2 $ λ y hy, ⟨y, subset_adjoin hy, rfl⟩)
-  (subalgebra.map_le.2 $ adjoin_le $ λ y hy, subset_adjoin ⟨y, hy, rfl⟩)
-
-lemma adjoin_restrict_scalars (C D E : Type*) [comm_semiring C] [comm_semiring D] [comm_semiring E]
-  [algebra C D] [algebra C E] [algebra D E] [is_scalar_tower C D E] (S : set E) :
-(algebra.adjoin D S).restrict_scalars C =
-  (algebra.adjoin
-    ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) S).restrict_scalars C :=
-begin
-  suffices : set.range (algebra_map D E) =
-    set.range (algebra_map ((⊤ : subalgebra C D).map (is_scalar_tower.to_alg_hom C D E)) E),
-  { ext x, change x ∈ subsemiring.closure (_ ∪ S) ↔ x ∈ subsemiring.closure (_ ∪ S), rw this },
-  ext x,
-  split,
-  { rintros ⟨y, hy⟩,
-    exact ⟨⟨algebra_map D E y, ⟨y, ⟨algebra.mem_top, rfl⟩⟩⟩, hy⟩ },
-  { rintros ⟨⟨y, ⟨z, ⟨h0, h1⟩⟩⟩, h2⟩,
-    exact ⟨z, eq.trans h1 h2⟩ },
-end
-
-lemma adjoin_res_eq_adjoin_res (C D E F : Type*) [comm_semiring C] [comm_semiring D]
-  [comm_semiring E] [comm_semiring F] [algebra C D] [algebra C E] [algebra C F] [algebra D F]
-  [algebra E F] [is_scalar_tower C D F] [is_scalar_tower C E F] {S : set D} {T : set E}
-  (hS : algebra.adjoin C S = ⊤) (hT : algebra.adjoin C T = ⊤) :
-(algebra.adjoin E (algebra_map D F '' S)).restrict_scalars C =
-  (algebra.adjoin D (algebra_map E F '' T)).restrict_scalars C :=
-by rw [adjoin_restrict_scalars C E, adjoin_restrict_scalars C D, ←hS, ←hT, ←algebra.adjoin_image,
-  ←algebra.adjoin_image, ←alg_hom.coe_to_ring_hom, ←alg_hom.coe_to_ring_hom,
-  is_scalar_tower.coe_to_alg_hom, is_scalar_tower.coe_to_alg_hom, ←adjoin_union_eq_adjoin_adjoin,
-  ←adjoin_union_eq_adjoin_adjoin, set.union_comm]
-
-end algebra
-
-section
-open_locale classical
-lemma algebra.fg_trans' {R S A : Type*} [comm_semiring R] [comm_semiring S] [comm_semiring A]
-  [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]
-  (hRS : (⊤ : subalgebra R S).fg) (hSA : (⊤ : subalgebra S A).fg) :
-  (⊤ : subalgebra R A).fg :=
-let ⟨s, hs⟩ := hRS, ⟨t, ht⟩ := hSA in ⟨s.image (algebra_map S A) ∪ t,
-by rw [finset.coe_union, finset.coe_image, algebra.adjoin_union_eq_adjoin_adjoin,
-  algebra.adjoin_algebra_map, hs, algebra.map_top, is_scalar_tower.adjoin_range_to_alg_hom, ht,
-  subalgebra.restrict_scalars_top]⟩
-end
-
 section algebra_map_coeffs
 
 variables {R} (A) {ι M : Type*} [comm_semiring R] [semiring A] [add_comm_monoid M]
@@ -151,7 +101,7 @@ theorem linear_independent_smul {ι : Type v₁} {b : ι → S} {ι' : Type w₁
 begin
   rw linear_independent_iff' at hb hc, rw linear_independent_iff'', rintros s g hg hsg ⟨i, k⟩,
   by_cases hik : (i, k) ∈ s,
-  { have h1 : ∑ i in (s.image prod.fst).product (s.image prod.snd), g i • b i.1 • c i.2 = 0,
+  { have h1 : ∑ i in s.image prod.fst ×ˢ s.image prod.snd, g i • b i.1 • c i.2 = 0,
     { rw ← hsg, exact (finset.sum_subset finset.subset_product $ λ p _ hp,
         show g p • b p.1 • c p.2 = 0, by rw [hg p hp, zero_smul]).symm },
     rw finset.sum_product_right at h1,
@@ -209,82 +159,6 @@ by exactI no_zero_smul_divisors.algebra_map_injective R S
 
 end ring
 
-section artin_tate
-
-variables (C : Type*)
-
-section semiring
-
-variables [comm_semiring A] [comm_semiring B] [semiring C]
-variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]
-
-open finset submodule
-open_locale classical
-
-lemma exists_subalgebra_of_fg (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg) :
-  ∃ B₀ : subalgebra A B, B₀.fg ∧ (⊤ : submodule B₀ C).fg :=
-begin
-  cases hAC with x hx,
-  cases hBC with y hy, have := hy,
-  simp_rw [eq_top_iff', mem_span_finset] at this, choose f hf,
-  let s : finset B := (finset.product (x ∪ (y * y)) y).image (function.uncurry f),
-  have hsx : ∀ (xi ∈ x) (yj ∈ y), f xi yj ∈ s := λ xi hxi yj hyj,
-    show function.uncurry f (xi, yj) ∈ s,
-    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_left _ hxi, hyj⟩,
-  have hsy : ∀ (yi yj yk ∈ y), f (yi * yj) yk ∈ s := λ yi hyi yj hyj yk hyk,
-    show function.uncurry f (yi * yj, yk) ∈ s,
-    from mem_image_of_mem _ $ mem_product.2 ⟨mem_union_right _ $ finset.mul_mem_mul hyi hyj, hyk⟩,
-  have hxy : ∀ xi ∈ x, xi ∈ span (algebra.adjoin A (↑s : set B))
-               (↑(insert 1 y : finset C) : set C) :=
-    λ xi hxi, hf xi ▸ sum_mem (λ yj hyj, smul_mem
-      (span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C))
-      ⟨f xi yj, algebra.subset_adjoin $ hsx xi hxi yj hyj⟩
-      (subset_span $ mem_insert_of_mem hyj)),
-  have hyy : span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) *
-      span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C) ≤
-    span (algebra.adjoin A (↑s : set B)) (↑(insert 1 y : finset C) : set C),
-  { rw [span_mul_span, span_le, coe_insert], rintros _ ⟨yi, yj, rfl | hyi, rfl | hyj, rfl⟩,
-    { rw mul_one, exact subset_span (set.mem_insert _ _) },
-    { rw one_mul, exact subset_span (set.mem_insert_of_mem _ hyj) },
-    { rw mul_one, exact subset_span (set.mem_insert_of_mem _ hyi) },
-    { rw ← hf (yi * yj), exact set_like.mem_coe.2 (sum_mem $ λ yk hyk, smul_mem
-        (span (algebra.adjoin A (↑s : set B)) (insert 1 ↑y : set C))
-        ⟨f (yi * yj) yk, algebra.subset_adjoin $ hsy yi hyi yj hyj yk hyk⟩
-        (subset_span $ set.mem_insert_of_mem _ hyk : yk ∈ _)) } },
-  refine ⟨algebra.adjoin A (↑s : set B), subalgebra.fg_adjoin_finset _, insert 1 y, _⟩,
-  refine restrict_scalars_injective A _ _ _,
-  rw [restrict_scalars_top, eq_top_iff, ← algebra.top_to_submodule, ← hx,
-    algebra.adjoin_eq_span, span_le],
-  refine λ r hr, submonoid.closure_induction hr (λ c hc, hxy c hc)
-    (subset_span $ mem_insert_self _ _) (λ p q hp hq, hyy $ submodule.mul_mem_mul hp hq)
-end
-
-end semiring
-
-section ring
-
-variables [comm_ring A] [comm_ring B] [comm_ring C]
-variables [algebra A B] [algebra B C] [algebra A C] [is_scalar_tower A B C]
-
-/-- Artin--Tate lemma: if A ⊆ B ⊆ C is a chain of subrings of commutative rings, and
-A is noetherian, and C is algebra-finite over A, and C is module-finite over B,
-then B is algebra-finite over A.
-
-References: Atiyah--Macdonald Proposition 7.8; Stacks 00IS; Altman--Kleiman 16.17. -/
-theorem fg_of_fg_of_fg [is_noetherian_ring A]
-  (hAC : (⊤ : subalgebra A C).fg) (hBC : (⊤ : submodule B C).fg)
-  (hBCi : function.injective (algebra_map B C)) :
-  (⊤ : subalgebra A B).fg :=
-let ⟨B₀, hAB₀, hB₀C⟩ := exists_subalgebra_of_fg A B C hAC hBC in
-algebra.fg_trans' (B₀.fg_top.2 hAB₀) $ subalgebra.fg_of_submodule_fg $
-have is_noetherian_ring B₀, from is_noetherian_ring_of_fg hAB₀,
-have is_noetherian B₀ C, by exactI is_noetherian_of_fg_of_noetherian' hB₀C,
-by exactI fg_of_injective (is_scalar_tower.to_alg_hom B₀ B C).to_linear_map hBCi
-
-end ring
-
-end artin_tate
-
 section alg_hom_tower
 
 variables {A} {C D : Type*} [comm_semiring A] [comm_semiring C] [comm_semiring D]
diff --git a/src/ring_theory/algebraic.lean b/src/ring_theory/algebraic.lean
index 0156da504a91a..5c629e47a50cf 100644
--- a/src/ring_theory/algebraic.lean
+++ b/src/ring_theory/algebraic.lean
@@ -11,6 +11,9 @@ import data.polynomial.integral_normalization
 /-!
 # Algebraic elements and algebraic extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial.
 An R-algebra is algebraic over R if and only if all its elements are algebraic over R.
 The main result in this file proves transitivity of algebraicity:
@@ -25,7 +28,8 @@ open polynomial
 section
 variables (R : Type u) {A : Type v} [comm_ring R] [ring A] [algebra R A]
 
-/-- An element of an R-algebra is algebraic over R if it is the root of a nonzero polynomial. -/
+/-- An element of an R-algebra is algebraic over R if it is a root of a nonzero polynomial
+with coefficients in R. -/
 def is_algebraic (x : A) : Prop :=
 ∃ p : R[X], p ≠ 0 ∧ aeval x p = 0
 
@@ -97,15 +101,53 @@ lemma is_algebraic_nat [nontrivial R] (n : ℕ) : is_algebraic R (n : A) :=
 by { rw ←map_nat_cast _, exact is_algebraic_algebra_map n }
 
 lemma is_algebraic_int [nontrivial R] (n : ℤ) : is_algebraic R (n : A) :=
-by { rw ←ring_hom.map_int_cast (algebra_map R A), exact is_algebraic_algebra_map n }
+by { rw ←_root_.map_int_cast (algebra_map R A), exact is_algebraic_algebra_map n }
 
-lemma is_algebraic_rat (R : Type u) {A : Type v} [division_ring A] [field R] [char_zero R]
-  [algebra R A] (n : ℚ) : is_algebraic R (n : A) :=
+lemma is_algebraic_rat (R : Type u) {A : Type v} [division_ring A] [field R] [algebra R A] (n : ℚ) :
+  is_algebraic R (n : A) :=
 by { rw ←map_rat_cast (algebra_map R A), exact is_algebraic_algebra_map n }
 
+lemma is_algebraic_of_mem_root_set {R : Type u} {A : Type v} [field R] [field A] [algebra R A]
+  {p : R[X]} {x : A} (hx : x ∈ p.root_set A) : is_algebraic R x :=
+⟨p, ne_zero_of_mem_root_set hx, aeval_eq_zero_of_mem_root_set hx⟩
+
+open is_scalar_tower
+
 lemma is_algebraic_algebra_map_of_is_algebraic {a : S} :
   is_algebraic R a → is_algebraic R (algebra_map S A a) :=
-λ ⟨f, hf₁, hf₂⟩, ⟨f, hf₁, by rw [← is_scalar_tower.algebra_map_aeval R S A, hf₂, ring_hom.map_zero]⟩
+λ ⟨f, hf₁, hf₂⟩, ⟨f, hf₁, by rw [aeval_algebra_map_apply, hf₂, map_zero]⟩
+
+/-- This is slightly more general than `is_algebraic_algebra_map_of_is_algebraic` in that it
+  allows noncommutative intermediate rings `A`. -/
+lemma is_algebraic_alg_hom_of_is_algebraic {B} [ring B] [algebra R B]
+  (f : A →ₐ[R] B) {a : A} (h : is_algebraic R a) : is_algebraic R (f a) :=
+let ⟨p, hp, ha⟩ := h in ⟨p, hp, by rw [aeval_alg_hom, f.comp_apply, ha, map_zero]⟩
+
+/-- Transfer `algebra.is_algebraic` across an `alg_equiv`. -/
+lemma _root_.alg_equiv.is_algebraic {B} [ring B] [algebra R B] (e : A ≃ₐ[R] B)
+  (h : algebra.is_algebraic R A) : algebra.is_algebraic R B :=
+λ b, by convert ← is_algebraic_alg_hom_of_is_algebraic e.to_alg_hom (h _); apply e.apply_symm_apply
+
+lemma _root_.alg_equiv.is_algebraic_iff {B} [ring B] [algebra R B] (e : A ≃ₐ[R] B) :
+  algebra.is_algebraic R A ↔ algebra.is_algebraic R B := ⟨e.is_algebraic, e.symm.is_algebraic⟩
+
+lemma is_algebraic_algebra_map_iff {a : S} (h : function.injective (algebra_map S A)) :
+  is_algebraic R (algebra_map S A a) ↔ is_algebraic R a :=
+⟨λ ⟨p, hp0, hp⟩, ⟨p, hp0, h (by rwa [map_zero, ← aeval_algebra_map_apply])⟩,
+  is_algebraic_algebra_map_of_is_algebraic⟩
+
+lemma is_algebraic_of_pow {r : A} {n : ℕ} (hn : 0 < n) (ht : is_algebraic R (r ^ n)) :
+  is_algebraic R r :=
+begin
+  obtain ⟨p, p_nonzero, hp⟩ := ht,
+  refine ⟨polynomial.expand _ n p, _, _⟩,
+  { rwa polynomial.expand_ne_zero hn },
+  { rwa polynomial.expand_aeval n p r },
+end
+
+lemma transcendental.pow {r : A} (ht : transcendental R r) {n : ℕ} (hn : 0 < n) :
+  transcendental R (r ^ n) :=
+λ ht', ht $ is_algebraic_of_pow hn ht'
 
 end zero_ne_one
 
@@ -170,7 +212,7 @@ _root_.is_algebraic_of_larger_base_of_injective (algebra_map K L).injective A_al
 lemma is_algebraic_of_larger_base (A_alg : is_algebraic K A) : is_algebraic L A :=
 is_algebraic_of_larger_base_of_injective (algebra_map K L).injective A_alg
 
-variables {R S} (K L)
+variables (K L)
 
 /-- A field extension is integral if it is finite. -/
 lemma is_integral_of_finite [finite_dimensional K L] : algebra.is_integral K L :=
@@ -181,6 +223,39 @@ lemma is_integral_of_finite [finite_dimensional K L] : algebra.is_integral K L :
 lemma is_algebraic_of_finite [finite : finite_dimensional K L] : is_algebraic K L :=
 algebra.is_algebraic_iff_is_integral.mpr (is_integral_of_finite K L)
 
+variables {K L}
+
+theorem is_algebraic.alg_hom_bijective
+  (ha : algebra.is_algebraic K L) (f : L →ₐ[K] L) : function.bijective f :=
+begin
+  refine ⟨f.to_ring_hom.injective, λ b, _⟩,
+  obtain ⟨p, hp, he⟩ := ha b,
+  let f' : p.root_set L → p.root_set L := (root_set_maps_to' id f).restrict f _ _,
+  have : function.surjective f' := finite.injective_iff_surjective.1
+    (λ _ _ h, subtype.eq $ f.to_ring_hom.injective $ subtype.ext_iff.1 h),
+  obtain ⟨a, ha⟩ := this ⟨b, mem_root_set.2 ⟨hp, he⟩⟩,
+  exact ⟨a, subtype.ext_iff.1 ha⟩,
+end
+
+theorem _root_.alg_hom.bijective [finite_dimensional K L] (ϕ : L →ₐ[K] L) : function.bijective ϕ :=
+(algebra.is_algebraic_of_finite K L).alg_hom_bijective ϕ
+
+variables (K L)
+
+/-- Bijection between algebra equivalences and algebra homomorphisms -/
+@[simps] noncomputable
+def is_algebraic.alg_equiv_equiv_alg_hom
+  (ha : algebra.is_algebraic K L) : (L ≃ₐ[K] L) ≃* (L →ₐ[K] L) :=
+{ to_fun := λ ϕ, ϕ.to_alg_hom,
+  inv_fun := λ ϕ, alg_equiv.of_bijective ϕ (ha.alg_hom_bijective ϕ),
+  left_inv := λ _, by {ext, refl},
+  right_inv := λ _, by {ext, refl},
+  map_mul' := λ _ _, rfl }
+
+/-- Bijection between algebra equivalences and algebra homomorphisms -/
+@[reducible] noncomputable def _root_.alg_equiv_equiv_alg_hom [finite_dimensional K L] :
+  (L ≃ₐ[K] L) ≃* (L →ₐ[K] L) := (algebra.is_algebraic_of_finite K L).alg_equiv_equiv_alg_hom K L
+
 end algebra
 
 variables {R S : Type*} [comm_ring R] [is_domain R] [comm_ring S]
@@ -227,7 +302,7 @@ lemma inv_eq_of_aeval_div_X_ne_zero {x : L} {p : K[X]}
   (aeval_ne : aeval x (div_X p) ≠ 0) :
   x⁻¹ = aeval x (div_X p) / (aeval x p - algebra_map _ _ (p.coeff 0)) :=
 begin
-  rw [inv_eq_iff_inv_eq, inv_div, div_eq_iff, sub_eq_iff_eq_add, mul_comm],
+  rw [inv_eq_iff_eq_inv, inv_div, eq_comm, div_eq_iff, sub_eq_iff_eq_add, mul_comm],
   conv_lhs { rw ← div_X_mul_X_add p },
   rw [alg_hom.map_add, alg_hom.map_mul, aeval_X, aeval_C],
   exact aeval_ne
@@ -248,14 +323,11 @@ end
 lemma subalgebra.inv_mem_of_root_of_coeff_zero_ne_zero {x : A} {p : K[X]}
   (aeval_eq : aeval x p = 0) (coeff_zero_ne : p.coeff 0 ≠ 0) : (x⁻¹ : L) ∈ A :=
 begin
-  have : (x⁻¹ : L) = aeval x (div_X p) / (aeval x p - algebra_map _ _ (p.coeff 0)),
-  { rw [aeval_eq, subalgebra.coe_zero, zero_sub, div_neg],
-    convert inv_eq_of_root_of_coeff_zero_ne_zero _ coeff_zero_ne,
-    { rw subalgebra.aeval_coe },
-    { simpa using aeval_eq } },
-  rw [this, div_eq_mul_inv, aeval_eq, subalgebra.coe_zero, zero_sub, ← ring_hom.map_neg,
-      ← ring_hom.map_inv],
-  exact A.mul_mem (aeval x p.div_X).2 (A.algebra_map_mem _),
+  suffices : (x⁻¹ : L) = (-p.coeff 0)⁻¹ • aeval x (div_X p),
+  { rw [this], exact A.smul_mem (aeval x _).2 _ },
+  have : aeval (x : L) p = 0, by rw [subalgebra.aeval_coe, aeval_eq, subalgebra.coe_zero],
+  rw [inv_eq_of_root_of_coeff_zero_ne_zero this coeff_zero_ne, div_eq_inv_mul,
+    algebra.smul_def, map_inv₀, map_neg, inv_neg, neg_mul, subalgebra.aeval_coe]
 end
 
 lemma subalgebra.inv_mem_of_algebraic {x : A} (hx : is_algebraic K (x : L)) : (x⁻¹ : L) ∈ A :=
@@ -291,36 +363,36 @@ section pi
 
 variables (R' : Type u) (S' : Type v) (T' : Type w)
 
-/-- This is not an instance as it forms a diamond with `pi.has_scalar`.
+/-- This is not an instance as it forms a diamond with `pi.has_smul`.
 
 See the `instance_diamonds` test for details. -/
-def polynomial.has_scalar_pi [semiring R'] [has_scalar R' S'] :
-  has_scalar (R'[X]) (R' → S') :=
+def polynomial.has_smul_pi [semiring R'] [has_smul R' S'] :
+  has_smul (R'[X]) (R' → S') :=
 ⟨λ p f x, eval x p • f x⟩
 
-/-- This is not an instance as it forms a diamond with `pi.has_scalar`.
+/-- This is not an instance as it forms a diamond with `pi.has_smul`.
 
 See the `instance_diamonds` test for details. -/
-noncomputable def polynomial.has_scalar_pi' [comm_semiring R'] [semiring S'] [algebra R' S']
-  [has_scalar S' T'] :
-  has_scalar (R'[X]) (S' → T') :=
+noncomputable def polynomial.has_smul_pi' [comm_semiring R'] [semiring S'] [algebra R' S']
+  [has_smul S' T'] :
+  has_smul (R'[X]) (S' → T') :=
 ⟨λ p f x, aeval x p • f x⟩
 
 variables {R} {S}
 
-local attribute [instance] polynomial.has_scalar_pi polynomial.has_scalar_pi'
+local attribute [instance] polynomial.has_smul_pi polynomial.has_smul_pi'
 
-@[simp] lemma polynomial_smul_apply [semiring R'] [has_scalar R' S']
+@[simp] lemma polynomial_smul_apply [semiring R'] [has_smul R' S']
   (p : R'[X]) (f : R' → S') (x : R') :
   (p • f) x = eval x p • f x := rfl
 
 @[simp] lemma polynomial_smul_apply' [comm_semiring R'] [semiring S'] [algebra R' S']
-  [has_scalar S' T'] (p : R'[X]) (f : S' → T') (x : S') :
+  [has_smul S' T'] (p : R'[X]) (f : S' → T') (x : S') :
   (p • f) x = aeval x p • f x := rfl
 
 variables [comm_semiring R'] [comm_semiring S'] [comm_semiring T'] [algebra R' S'] [algebra S' T']
 
-/-- This is not an instance for the same reasons as `polynomial.has_scalar_pi'`. -/
+/-- This is not an instance for the same reasons as `polynomial.has_smul_pi'`. -/
 noncomputable def polynomial.algebra_pi :
   algebra (R'[X]) (S' → T') :=
 { to_fun := λ p z, algebra_map S' T' (aeval z p),
@@ -332,7 +404,7 @@ noncomputable def polynomial.algebra_pi :
   smul_def' := λ p f, funext $ λ z, by
     simp only [algebra.algebra_map_eq_smul_one, polynomial_smul_apply', one_mul,
       pi.mul_apply, algebra.smul_mul_assoc],
-  ..polynomial.has_scalar_pi' R' S' T' }
+  ..polynomial.has_smul_pi' R' S' T' }
 
 local attribute [instance] polynomial.algebra_pi
 
diff --git a/src/ring_theory/algebraic_independent.lean b/src/ring_theory/algebraic_independent.lean
index 9b7ef29765d7c..e6dbfbfd6aaaa 100644
--- a/src/ring_theory/algebraic_independent.lean
+++ b/src/ring_theory/algebraic_independent.lean
@@ -12,6 +12,9 @@ import data.mv_polynomial.equiv
 /-!
 # Algebraic Independence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines algebraic independence of a family of element of an `R` algebra
 
 ## Main definitions
@@ -153,8 +156,7 @@ lemma alg_hom.algebraic_independent_iff (f : A →ₐ[R] A') (hf : injective f)
 
 @[nontriviality]
 lemma algebraic_independent_of_subsingleton [subsingleton R] : algebraic_independent R x :=
-by haveI := @mv_polynomial.unique R ι;
-  exact algebraic_independent_iff.2 (λ l hl, subsingleton.elim _ _)
+algebraic_independent_iff.2 (λ l hl, subsingleton.elim _ _)
 
 theorem algebraic_independent_equiv (e : ι ≃ ι') {f : ι' → A} :
   algebraic_independent R (f ∘ e) ↔ algebraic_independent R f :=
@@ -278,7 +280,7 @@ theorem algebraic_independent_subtype {s : set A} :
 by apply @algebraic_independent_comp_subtype _ _ _ id
 
 lemma algebraic_independent_of_finite (s : set A)
-  (H : ∀ t ⊆ s, finite t → algebraic_independent R (λ x, x : t → A)) :
+  (H : ∀ t ⊆ s, t.finite → algebraic_independent R (λ x, x : t → A)) :
   algebraic_independent R (λ x, x : s → A) :=
 algebraic_independent_subtype.2 $
   λ p hp, algebraic_independent_subtype.1 (H _ (mem_supported.1 hp) (finset.finite_to_set _)) _
@@ -412,12 +414,9 @@ lemma algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_C
   hx.mv_polynomial_option_equiv_polynomial_adjoin (C r) =
     polynomial.C (algebra_map _ _ r) :=
 begin
-  -- TODO: this instance is slow to infer
-  have h : is_scalar_tower R (mv_polynomial ι R) (polynomial (mv_polynomial ι R)) :=
-    @polynomial.is_scalar_tower (mv_polynomial ι R) _ R _ _ _ _ _ _ _,
   rw [algebraic_independent.mv_polynomial_option_equiv_polynomial_adjoin_apply, aeval_C,
-    @is_scalar_tower.algebra_map_apply _ _ _ _ _ _ _ _ _ h, ← polynomial.C_eq_algebra_map,
-    polynomial.map_C, ring_hom.coe_coe, alg_equiv.commutes]
+      is_scalar_tower.algebra_map_apply R (mv_polynomial ι R), ← polynomial.C_eq_algebra_map,
+      polynomial.map_C, ring_hom.coe_coe, alg_equiv.commutes]
 end
 
 @[simp]
diff --git a/src/ring_theory/artinian.lean b/src/ring_theory/artinian.lean
index dc54afeb8af1b..c64f5903be576 100644
--- a/src/ring_theory/artinian.lean
+++ b/src/ring_theory/artinian.lean
@@ -3,32 +3,22 @@ Copyright (c) 2021 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
-import linear_algebra.basic
-import linear_algebra.prod
-import linear_algebra.pi
-import data.set_like.fintype
-import linear_algebra.linear_independent
-import tactic.linarith
-import algebra.algebra.basic
-import ring_theory.noetherian
-import ring_theory.jacobson_ideal
-import ring_theory.nilpotent
 import ring_theory.nakayama
+import data.set_like.fintype
 
 /-!
 # Artinian rings and modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 
 A module satisfying these equivalent conditions is said to be an *Artinian* R-module
 if every decreasing chain of submodules is eventually constant, or equivalently,
 if the relation `<` on submodules is well founded.
 
-A ring is an *Artinian ring* if it is Artinian as a module over itself.
-
-(Note that we do not assume yet that our rings are commutative,
-so perhaps this should be called "left Artinian".
-To avoid cumbersome names once we specialize to the commutative case,
-we don't make this explicit in the declaration names.)
+A ring is said to be left (or right) Artinian if it is Artinian as a left (or right) module over
+itself, or simply Artinian if it is both left and right Artinian.
 
 ## Main definitions
 
@@ -36,6 +26,7 @@ Let `R` be a ring and let `M` and `P` be `R`-modules. Let `N` be an `R`-submodul
 
 * `is_artinian R M` is the proposition that `M` is a Artinian `R`-module. It is a class,
   implemented as the predicate that the `<` relation on submodules is well founded.
+* `is_artinian_ring R` is the proposition that `R` is a left Artinian ring.
 
 ## References
 
@@ -58,7 +49,8 @@ class is_artinian (R M) [semiring R] [add_comm_monoid M] [module R M] : Prop :=
 (well_founded_submodule_lt [] : well_founded ((<) : submodule R M → submodule R M → Prop))
 
 section
-variables {R : Type*} {M : Type*} {P : Type*} {N : Type*}
+variables {R M P N : Type*}
+
 variables [ring R] [add_comm_group M] [add_comm_group P] [add_comm_group N]
 variables [module R M] [module R P] [module R N]
 open is_artinian
@@ -120,16 +112,16 @@ is_artinian_of_range_eq_ker
   linear_map.snd_surjective
   (linear_map.range_inl R M P)
 
-@[instance, priority 100]
-lemma is_artinian_of_fintype [fintype M] : is_artinian R M :=
-⟨fintype.well_founded_of_trans_of_irrefl _⟩
+@[priority 100]
+instance is_artinian_of_finite [finite M] : is_artinian R M :=
+⟨finite.well_founded_of_trans_of_irrefl _⟩
 
-local attribute [elab_as_eliminator] fintype.induction_empty_option
+local attribute [elab_as_eliminator] finite.induction_empty_option
 
-instance is_artinian_pi {R ι : Type*} [fintype ι] : Π {M : ι → Type*} [ring R]
+instance is_artinian_pi {R ι : Type*} [finite ι] : Π {M : ι → Type*} [ring R]
   [Π i, add_comm_group (M i)], by exactI Π [Π i, module R (M i)],
   by exactI Π [∀ i, is_artinian R (M i)], is_artinian R (Π i, M i) :=
-fintype.induction_empty_option
+finite.induction_empty_option
   (begin
     introsI α β e hα M _ _ _ _,
     exact is_artinian_of_linear_equiv
@@ -146,7 +138,7 @@ fintype.induction_empty_option
 /-- A version of `is_artinian_pi` for non-dependent functions. We need this instance because
 sometimes Lean fails to apply the dependent version in non-dependent settings (e.g., it fails to
 prove that `ι → ℝ` is finite dimensional over `ℝ`). -/
-instance is_artinian_pi' {R ι M : Type*} [ring R] [add_comm_group M] [module R M] [fintype ι]
+instance is_artinian_pi' {R ι M : Type*} [ring R] [add_comm_group M] [module R M] [finite ι]
   [is_artinian R M] : is_artinian R (ι → M) :=
 is_artinian_pi
 
@@ -154,7 +146,8 @@ end
 
 open is_artinian submodule function
 
-section
+section ring
+
 variables {R M : Type*} [ring R] [add_comm_group M] [module R M]
 
 theorem is_artinian_iff_well_founded :
@@ -168,7 +161,7 @@ lemma is_artinian.finite_of_linear_independent [nontrivial R] [is_artinian R M]
 begin
   refine classical.by_contradiction (λ hf, (rel_embedding.well_founded_iff_no_descending_seq.1
     (well_founded_submodule_lt R M)).elim' _),
-  have f : ℕ ↪ s, from @infinite.nat_embedding s ⟨λ f, hf ⟨f⟩⟩,
+  have f : ℕ ↪ s, from set.infinite.nat_embedding s hf,
   have : ∀ n, (coe ∘ f) '' {m | n ≤ m} ⊆ s,
   { rintros n x ⟨y, hy₁, rfl⟩, exact (f y).2 },
   have : ∀ a b : ℕ, a ≤ b ↔
@@ -191,39 +184,38 @@ end
 /-- A module is Artinian iff every nonempty set of submodules has a minimal submodule among them.
 -/
 theorem set_has_minimal_iff_artinian :
-  (∀ a : set $ submodule R M, a.nonempty → ∃ M' ∈ a, ∀ I ∈ a, I ≤ M' → I = M') ↔
-  is_artinian R M :=
-by rw [is_artinian_iff_well_founded, well_founded.well_founded_iff_has_min']
+  (∀ a : set $ submodule R M, a.nonempty → ∃ M' ∈ a, ∀ I ∈ a, ¬ I < M') ↔ is_artinian R M :=
+by rw [is_artinian_iff_well_founded, well_founded.well_founded_iff_has_min]
 
 theorem is_artinian.set_has_minimal [is_artinian R M] (a : set $ submodule R M) (ha : a.nonempty) :
-  ∃ M' ∈ a, ∀ I ∈ a, I ≤ M' → I = M' :=
+  ∃ M' ∈ a, ∀ I ∈ a, ¬ I < M' :=
 set_has_minimal_iff_artinian.mpr ‹_› a ha
 
 /-- A module is Artinian iff every decreasing chain of submodules stabilizes. -/
 theorem monotone_stabilizes_iff_artinian :
-  (∀ (f : ℕ →o (submodule R M)ᵒᵈ), ∃ n, ∀ m, n ≤ m → f n = f m)
-    ↔ is_artinian R M :=
-by rw [is_artinian_iff_well_founded];
-  exact (well_founded.monotone_chain_condition (submodule R M)ᵒᵈ).symm
+  (∀ (f : ℕ →o (submodule R M)ᵒᵈ), ∃ n, ∀ m, n ≤ m → f n = f m) ↔ is_artinian R M :=
+by { rw is_artinian_iff_well_founded, exact well_founded.monotone_chain_condition.symm }
+
+namespace is_artinian
+
+variables [is_artinian R M]
 
-theorem is_artinian.monotone_stabilizes [is_artinian R M] (f : ℕ →o (submodule R M)ᵒᵈ) :
-  ∃ n, ∀ m, n ≤ m → f n = f m :=
+theorem monotone_stabilizes (f : ℕ →o (submodule R M)ᵒᵈ) : ∃ n, ∀ m, n ≤ m → f n = f m :=
 monotone_stabilizes_iff_artinian.mpr ‹_› f
 
 /-- If `∀ I > J, P I` implies `P J`, then `P` holds for all submodules. -/
-lemma is_artinian.induction [is_artinian R M] {P : submodule R M → Prop}
-  (hgt : ∀ I, (∀ J < I, P J) → P I) (I : submodule R M) : P I :=
-well_founded.recursion (well_founded_submodule_lt R M) I hgt
+lemma induction {P : submodule R M → Prop} (hgt : ∀ I, (∀ J < I, P J) → P I) (I : submodule R M) :
+  P I :=
+(well_founded_submodule_lt R M).recursion I hgt
 
 /--
 For any endomorphism of a Artinian module, there is some nontrivial iterate
 with disjoint kernel and range.
 -/
-theorem is_artinian.exists_endomorphism_iterate_ker_sup_range_eq_top
-  [I : is_artinian R M] (f : M →ₗ[R] M) : ∃ n : ℕ, n ≠ 0 ∧ (f ^ n).ker ⊔ (f ^ n).range = ⊤ :=
+theorem exists_endomorphism_iterate_ker_sup_range_eq_top (f : M →ₗ[R] M) :
+  ∃ n : ℕ, n ≠ 0 ∧ (f ^ n).ker ⊔ (f ^ n).range = ⊤ :=
 begin
-  obtain ⟨n, w⟩ := monotone_stabilizes_iff_artinian.mpr I
-    (f.iterate_range.comp ⟨λ n, n+1, λ n m w, by linarith⟩),
+  obtain ⟨n, w⟩ := monotone_stabilizes (f.iterate_range.comp ⟨λ n, n+1, λ n m w, by linarith⟩),
   specialize w ((n + 1) + n) (by linarith),
   dsimp at w,
   refine ⟨n + 1, nat.succ_ne_zero _, _⟩,
@@ -241,51 +233,77 @@ begin
 end
 
 /-- Any injective endomorphism of an Artinian module is surjective. -/
-theorem is_artinian.surjective_of_injective_endomorphism [is_artinian R M]
-  (f : M →ₗ[R] M) (s : injective f) : surjective f :=
+theorem surjective_of_injective_endomorphism (f : M →ₗ[R] M) (s : injective f) : surjective f :=
 begin
-  obtain ⟨n, ne, w⟩ := is_artinian.exists_endomorphism_iterate_ker_sup_range_eq_top f,
+  obtain ⟨n, ne, w⟩ := exists_endomorphism_iterate_ker_sup_range_eq_top f,
   rw [linear_map.ker_eq_bot.mpr (linear_map.iterate_injective s n), bot_sup_eq,
     linear_map.range_eq_top] at w,
   exact linear_map.surjective_of_iterate_surjective ne w,
 end
 
 /-- Any injective endomorphism of an Artinian module is bijective. -/
-theorem is_artinian.bijective_of_injective_endomorphism [is_artinian R M]
-  (f : M →ₗ[R] M) (s : injective f) : bijective f :=
-⟨s, is_artinian.surjective_of_injective_endomorphism f s⟩
+theorem bijective_of_injective_endomorphism (f : M →ₗ[R] M) (s : injective f) : bijective f :=
+⟨s, surjective_of_injective_endomorphism f s⟩
 
 /--
 A sequence `f` of submodules of a artinian module,
 with the supremum `f (n+1)` and the infinum of `f 0`, ..., `f n` being ⊤,
 is eventually ⊤.
 -/
-lemma is_artinian.disjoint_partial_infs_eventually_top [I : is_artinian R M]
-  (f : ℕ → submodule R M) (h : ∀ n, disjoint
-    (partial_sups (order_dual.to_dual ∘ f) n) (order_dual.to_dual (f (n+1)))) :
+lemma disjoint_partial_infs_eventually_top (f : ℕ → submodule R M)
+  (h : ∀ n, disjoint (partial_sups (order_dual.to_dual ∘ f) n) (order_dual.to_dual (f (n+1)))) :
   ∃ n : ℕ, ∀ m, n ≤ m → f m = ⊤  :=
 begin
   -- A little off-by-one cleanup first:
-  suffices t : ∃ n : ℕ, ∀ m, n ≤ m → order_dual.to_dual f (m+1) = ⊤,
-  { obtain ⟨n, w⟩ := t,
-    use n+1,
+  rsuffices ⟨n, w⟩ : ∃ n : ℕ, ∀ m, n ≤ m → order_dual.to_dual f (m+1) = ⊤,
+  { use n+1,
     rintros (_|m) p,
     { cases p, },
     { apply w,
       exact nat.succ_le_succ_iff.mp p }, },
 
-  obtain ⟨n, w⟩ := monotone_stabilizes_iff_artinian.mpr I (partial_sups (order_dual.to_dual ∘ f)),
-  exact ⟨n, (λ m p, eq_bot_of_disjoint_absorbs (h m)
-    ((eq.symm (w (m + 1) (le_add_right p))).trans (w m p)))⟩
+  obtain ⟨n, w⟩ := monotone_stabilizes (partial_sups (order_dual.to_dual ∘ f)),
+  refine ⟨n, λ m p, _⟩,
+  exact (h m).eq_bot_of_ge (sup_eq_left.1 $ (w (m + 1) $ le_add_right p).symm.trans $ w m p)
 end
 
-universe w
-variables {N : Type w} [add_comm_group N] [module R N]
+end is_artinian
+
+end ring
+
+section comm_ring
+
+variables {R : Type*} (M : Type*) [comm_ring R] [add_comm_group M] [module R M] [is_artinian R M]
+
+namespace is_artinian
+
+lemma range_smul_pow_stabilizes (r : R) : ∃ n : ℕ, ∀ m, n ≤ m →
+  (r^n • linear_map.id : M →ₗ[R] M).range = (r^m • linear_map.id : M →ₗ[R] M).range :=
+monotone_stabilizes
+⟨λ n, (r^n • linear_map.id : M →ₗ[R] M).range,
+ λ n m h x ⟨y, hy⟩, ⟨r ^ (m - n) • y,
+   by { dsimp at ⊢ hy, rw [←smul_assoc, smul_eq_mul, ←pow_add, ←hy, add_tsub_cancel_of_le h] }⟩⟩
+
+variables {M}
+
+lemma exists_pow_succ_smul_dvd (r : R) (x : M) :
+  ∃ (n : ℕ) (y : M), r ^ n.succ • y = r ^ n • x :=
+begin
+  obtain ⟨n, hn⟩ := is_artinian.range_smul_pow_stabilizes M r,
+  simp_rw [set_like.ext_iff] at hn,
+  exact ⟨n, by simpa using hn n.succ n.le_succ (r ^ n • x)⟩,
+end
+
+end is_artinian
+
+end comm_ring
 
 -- TODO: Prove this for artinian modules
 -- /--
 -- If `M ⊕ N` embeds into `M`, for `M` noetherian over `R`, then `N` is trivial.
 -- -/
+-- universe w
+-- variables {N : Type w} [add_comm_group N] [module R N]
 -- noncomputable def is_noetherian.equiv_punit_of_prod_injective [is_noetherian R M]
 --   (f : M × N →ₗ[R] M) (i : injective f) : N ≃ₗ[R] punit.{w+1} :=
 -- begin
@@ -299,20 +317,17 @@ variables {N : Type w} [add_comm_group N] [module R N]
 --   exact submodule.bot_equiv_punit,
 -- end
 
-end
+/-- A ring is Artinian if it is Artinian as a module over itself.
 
-/--
-A ring is Artinian if it is Artinian as a module over itself.
--/
-class is_artinian_ring (R) [ring R] extends is_artinian R R : Prop
+Strictly speaking, this should be called `is_left_artinian_ring` but we omit the `left_` for
+convenience in the commutative case. For a right Artinian ring, use `is_artinian Rᵐᵒᵖ R`. -/
+@[reducible] def is_artinian_ring (R) [ring R] := is_artinian R R
 
 theorem is_artinian_ring_iff {R} [ring R] : is_artinian_ring R ↔ is_artinian R R :=
-⟨λ h, h.1, @is_artinian_ring.mk _ _⟩
+iff.rfl
 
 theorem ring.is_artinian_of_zero_eq_one {R} [ring R] (h01 : (0 : R) = 1) : is_artinian_ring R :=
-by haveI := subsingleton_of_zero_eq_one h01;
-   haveI := fintype.of_subsingleton (0:R); split;
-  apply_instance
+have _ := subsingleton_of_zero_eq_one h01, by exactI infer_instance
 
 theorem is_artinian_of_submodule_of_artinian (R M) [ring R] [add_comm_group M] [module R M]
   (N : submodule R M) (h : is_artinian R M) : is_artinian R N :=
@@ -338,7 +353,6 @@ let ⟨s, hs⟩ := hN in
 begin
   haveI := classical.dec_eq M,
   haveI := classical.dec_eq R,
-  letI : is_artinian R R := by apply_instance,
   have : ∀ x ∈ s, x ∈ N, from λ x hx, hs ▸ submodule.subset_span hx,
   refine @@is_artinian_of_surjective ((↑s : set M) → R) _ _ _ (pi.module _ _ _)
     _ _ _ is_artinian_pi,
@@ -370,25 +384,19 @@ by exactI is_artinian_of_linear_equiv (linear_equiv.of_top (⊤ : submodule R M)
 /-- In a module over a artinian ring, the submodule generated by finitely many vectors is
 artinian. -/
 theorem is_artinian_span_of_finite (R) {M} [ring R] [add_comm_group M] [module R M]
-  [is_artinian_ring R] {A : set M} (hA : finite A) : is_artinian R (submodule.span R A) :=
+  [is_artinian_ring R] {A : set M} (hA : A.finite) : is_artinian R (submodule.span R A) :=
 is_artinian_of_fg_of_artinian _ (submodule.fg_def.mpr ⟨A, hA, rfl⟩)
 
-theorem is_artinian_ring_of_surjective (R) [ring R] (S) [ring S]
-  (f : R →+* S) (hf : function.surjective f)
-  [H : is_artinian_ring R] : is_artinian_ring S :=
+theorem function.surjective.is_artinian_ring {R} [ring R] {S} [ring S] {F} [ring_hom_class F R S]
+  {f : F} (hf : function.surjective f) [H : is_artinian_ring R] : is_artinian_ring S :=
 begin
   rw [is_artinian_ring_iff, is_artinian_iff_well_founded] at H ⊢,
-  exact order_embedding.well_founded (ideal.order_embedding_of_surjective f hf) H,
+  exact (ideal.order_embedding_of_surjective f hf).well_founded H,
 end
 
-instance is_artinian_ring_range {R} [ring R] {S} [ring S] (f : R →+* S)
-  [is_artinian_ring R] : is_artinian_ring f.range :=
-is_artinian_ring_of_surjective R f.range f.range_restrict
-  f.range_restrict_surjective
-
-theorem is_artinian_ring_of_ring_equiv (R) [ring R] {S} [ring S]
-  (f : R ≃+* S) [is_artinian_ring R] : is_artinian_ring S :=
-is_artinian_ring_of_surjective R S f.to_ring_hom f.to_equiv.surjective
+instance is_artinian_ring_range {R} [ring R] {S} [ring S] (f : R →+* S) [is_artinian_ring R] :
+  is_artinian_ring f.range :=
+f.range_restrict_surjective.is_artinian_ring
 
 namespace is_artinian_ring
 
@@ -408,19 +416,19 @@ begin
     simpa only [this, top_smul, ideal.zero_eq_bot] using hJ },
   by_contradiction hJ, change J ≠ ⊤ at hJ,
   rcases is_artinian.set_has_minimal {J' : ideal R | J < J'} ⟨⊤, hJ.lt_top⟩
-    with ⟨J', hJJ' : J < J', hJ' : ∀ I, J < I → I ≤ J' → I = J'⟩,
+    with ⟨J', hJJ' : J < J', hJ' : ∀ I, J < I → ¬ I < J'⟩,
   rcases set_like.exists_of_lt hJJ' with ⟨x, hxJ', hxJ⟩,
   obtain rfl : J ⊔ ideal.span {x} = J',
-  { refine hJ' (J ⊔ ideal.span {x}) _ _,
+  { apply eq_of_le_of_not_lt _ (hJ' (J ⊔ ideal.span {x}) _),
+    { exact (sup_le hJJ'.le (span_le.2 (singleton_subset_iff.2 hxJ'))) },
     { rw set_like.lt_iff_le_and_exists,
-      exact ⟨le_sup_left, ⟨x, mem_sup_right (mem_span_singleton_self x), hxJ⟩⟩ },
-    { exact (sup_le hJJ'.le (span_le.2 (singleton_subset_iff.2 hxJ'))) } },
+      exact ⟨le_sup_left, ⟨x, mem_sup_right (mem_span_singleton_self x), hxJ⟩⟩ } },
   have : J ⊔ Jac • ideal.span {x} ≤ J ⊔ ideal.span {x},
     from sup_le_sup_left (smul_le.2 (λ _ _ _, submodule.smul_mem _ _)) _,
   have : Jac * ideal.span {x} ≤ J, --Need version 4 of Nakayamas lemma on Stacks
   { classical, by_contradiction H,
     refine H (smul_sup_le_of_le_smul_of_le_jacobson_bot
-      (fg_span_singleton _) le_rfl (hJ' _ _ this).ge),
+      (fg_span_singleton _) le_rfl (this.eq_of_not_lt (hJ' _ _)).ge),
     exact lt_of_le_of_ne le_sup_left (λ h, H $ h.symm ▸ le_sup_right) },
   have : ideal.span {x} * Jac ^ (n + 1) ≤ ⊥,
     calc ideal.span {x} * Jac ^ (n + 1) = ideal.span {x} * Jac * Jac ^ n :
@@ -432,4 +440,35 @@ begin
   rwa [← hn (n + 1) (nat.le_succ _)]
 end
 
+section localization
+
+variables (S : submonoid R) (L : Type*) [comm_ring L] [algebra R L] [is_localization S L]
+
+include S
+
+/-- Localizing an artinian ring can only reduce the amount of elements. -/
+theorem localization_surjective : function.surjective (algebra_map R L) :=
+begin
+  intro r',
+  obtain ⟨r₁, s, rfl⟩ := is_localization.mk'_surjective S r',
+  obtain ⟨r₂, h⟩ : ∃ r : R, is_localization.mk' L 1 s = algebra_map R L r,
+  swap, { exact ⟨r₁ * r₂, by rw [is_localization.mk'_eq_mul_mk'_one, map_mul, h]⟩ },
+  obtain ⟨n, r, hr⟩ := is_artinian.exists_pow_succ_smul_dvd (s : R) (1 : R),
+  use r,
+  rw [smul_eq_mul, smul_eq_mul, pow_succ', mul_assoc] at hr,
+  apply_fun algebra_map R L at hr,
+  simp only [map_mul, ←submonoid.coe_pow] at hr,
+  rw [←is_localization.mk'_one L, is_localization.mk'_eq_iff_eq, mul_one, submonoid.coe_one,
+      ←(is_localization.map_units L (s ^ n)).mul_left_cancel hr, map_mul],
+end
+
+lemma localization_artinian : is_artinian_ring L :=
+(localization_surjective S L).is_artinian_ring
+
+/-- `is_artinian_ring.localization_artinian` can't be made an instance, as it would make `S` + `R`
+into metavariables. However, this is safe. -/
+instance : is_artinian_ring (localization S) := localization_artinian S _
+
+end localization
+
 end is_artinian_ring
diff --git a/src/ring_theory/bezout.lean b/src/ring_theory/bezout.lean
new file mode 100644
index 0000000000000..07bbc8d8352c3
--- /dev/null
+++ b/src/ring_theory/bezout.lean
@@ -0,0 +1,148 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+
+import ring_theory.principal_ideal_domain
+import algebra.gcd_monoid.integrally_closed
+
+/-!
+
+# Bézout rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A Bézout ring (Bezout ring) is a ring whose finitely generated ideals are principal.
+Notible examples include principal ideal rings, valuation rings, and the ring of algebraic integers.
+
+## Main results
+- `is_bezout.iff_span_pair_is_principal`: It suffices to verify every `span {x, y}` is principal.
+- `is_bezout.to_gcd_monoid`: Every Bézout domain is a GCD domain. This is not an instance.
+- `is_bezout.tfae`: For a Bézout domain, noetherian ↔ PID ↔ UFD ↔ ACCP
+
+-/
+
+universes u v
+
+variables (R : Type u) [comm_ring R]
+
+/-- A Bézout ring is a ring whose finitely generated ideals are principal. -/
+class is_bezout : Prop :=
+(is_principal_of_fg : ∀ I : ideal R, I.fg → I.is_principal)
+
+namespace is_bezout
+
+variables {R}
+
+instance span_pair_is_principal [is_bezout R] (x y : R) :
+  (ideal.span {x, y} : ideal R).is_principal :=
+by { classical, exact is_principal_of_fg (ideal.span {x, y}) ⟨{x, y}, by simp⟩ }
+
+lemma iff_span_pair_is_principal :
+  is_bezout R ↔ (∀ x y : R, (ideal.span {x, y} : ideal R).is_principal) :=
+begin
+  classical,
+  split,
+  { introsI H x y, apply_instance },
+  { intro H,
+    constructor,
+    apply submodule.fg_induction,
+    { exact λ _, ⟨⟨_, rfl⟩⟩ },
+    { rintro _ _ ⟨⟨x, rfl⟩⟩ ⟨⟨y, rfl⟩⟩, rw ← submodule.span_insert, exact H _ _ } },
+end
+
+section gcd
+
+variable [is_bezout R]
+
+/-- The gcd of two elements in a bezout domain. -/
+noncomputable
+def gcd (x y : R) : R :=
+submodule.is_principal.generator (ideal.span {x, y})
+
+lemma span_gcd (x y : R) : (ideal.span {gcd x y} : ideal R) = ideal.span {x, y} :=
+ideal.span_singleton_generator _
+
+lemma gcd_dvd_left (x y : R) : gcd x y ∣ x :=
+(submodule.is_principal.mem_iff_generator_dvd _).mp (ideal.subset_span (by simp))
+
+lemma gcd_dvd_right (x y : R) : gcd x y ∣ y :=
+(submodule.is_principal.mem_iff_generator_dvd _).mp (ideal.subset_span (by simp))
+
+lemma dvd_gcd {x y z : R} (hx : z ∣ x) (hy : z ∣ y) : z ∣ gcd x y :=
+begin
+  rw [← ideal.span_singleton_le_span_singleton] at hx hy ⊢,
+  rw [span_gcd, ideal.span_insert, sup_le_iff],
+  exact ⟨hx, hy⟩
+end
+
+lemma gcd_eq_sum (x y : R) : ∃ a b : R, a * x + b * y = gcd x y :=
+ideal.mem_span_pair.mp (by { rw ← span_gcd, apply ideal.subset_span, simp })
+
+variable (R)
+
+/-- Any bezout domain is a GCD domain. This is not an instance since `gcd_monoid` contains data,
+and this might not be how we would like to construct it. -/
+noncomputable
+def to_gcd_domain [is_domain R] [decidable_eq R] :
+  gcd_monoid R :=
+gcd_monoid_of_gcd gcd gcd_dvd_left gcd_dvd_right
+  (λ _ _ _, dvd_gcd)
+
+end gcd
+
+local attribute [instance] to_gcd_domain
+
+-- Note that the proof, despite being `infer_instance`, depends on the `local attribute [instance]`
+-- lemma above, and is thus necessary to be restated.
+@[priority 100]
+instance [is_domain R] [is_bezout R] : is_integrally_closed R :=
+by classical; exact gcd_monoid.to_is_integrally_closed
+
+lemma _root_.function.surjective.is_bezout {S : Type v} [comm_ring S] (f : R →+* S)
+  (hf : function.surjective f) [is_bezout R] : is_bezout S :=
+begin
+  rw iff_span_pair_is_principal,
+  intros x y,
+  obtain ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩ := ⟨hf x, hf y⟩,
+  use f (gcd x y),
+  transitivity ideal.map f (ideal.span {gcd x y}),
+  { rw [span_gcd, ideal.map_span, set.image_insert_eq, set.image_singleton] },
+  { rw [ideal.map_span, set.image_singleton], refl }
+end
+
+@[priority 100]
+instance of_is_principal_ideal_ring [is_principal_ideal_ring R] : is_bezout R :=
+⟨λ I _, is_principal_ideal_ring.principal I⟩
+
+lemma tfae [is_bezout R] [is_domain R] :
+  tfae [is_noetherian_ring R,
+    is_principal_ideal_ring R,
+    unique_factorization_monoid R,
+    wf_dvd_monoid R] :=
+begin
+  classical,
+  tfae_have : 1 → 2,
+  { introI H, exact ⟨λ I, is_principal_of_fg _ (is_noetherian.noetherian _)⟩ },
+  tfae_have : 2 → 3,
+  { introI _, apply_instance },
+  tfae_have : 3 → 4,
+  { introI _, apply_instance },
+  tfae_have : 4 → 1,
+  { rintro ⟨h⟩,
+    rw [is_noetherian_ring_iff, is_noetherian_iff_fg_well_founded],
+    apply rel_embedding.well_founded _ h,
+    have : ∀ I : { J : ideal R // J.fg }, ∃ x : R, (I : ideal R) = ideal.span {x} :=
+      λ ⟨I, hI⟩, (is_bezout.is_principal_of_fg I hI).1,
+    choose f hf,
+    exact
+    { to_fun := f,
+      inj' := λ x y e, by { ext1, rw [hf, hf, e] },
+      map_rel_iff' := λ x y,
+      by { dsimp, rw [← ideal.span_singleton_lt_span_singleton, ← hf, ← hf], refl } } },
+  tfae_finish
+end
+
+end is_bezout
diff --git a/src/ring_theory/chain_of_divisors.lean b/src/ring_theory/chain_of_divisors.lean
index 60630db8efdb7..9c69310477c7f 100644
--- a/src/ring_theory/chain_of_divisors.lean
+++ b/src/ring_theory/chain_of_divisors.lean
@@ -5,11 +5,16 @@ Authors: Anne Baanen, Paul Lezeau
 -/
 import algebra.is_prime_pow
 import algebra.squarefree
+import order.hom.bounded
+import algebra.gcd_monoid.basic
 
 /-!
 
 # Chains of divisors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The results in this file show that in the monoid `associates M` of a `unique_factorization_monoid`
 `M`, an element `a` is an n-th prime power iff its set of divisors is a strictly increasing chain
 of length `n + 1`, meaning that we can find a strictly increasing bijection between `fin (n + 1)`
@@ -18,23 +23,38 @@ and the set of factors of `a`.
 ## Main results
 - `divisor_chain.exists_chain_of_prime_pow` : existence of a chain for prime powers.
 - `divisor_chain.is_prime_pow_of_has_chain` : elements that have a chain are prime powers.
-- `multiplicity_prime_le_multiplicity_image_by_factor_order_iso` : if there is a
+- `multiplicity_prime_eq_multiplicity_image_by_factor_order_iso` : if there is a
   monotone bijection `d` between the set of factors of `a : associates M` and the set of factors of
-  `b : associates N`, then, for any prime `p ∣ a`, `multiplicity p a ≤ multiplicity (d p) b`.
+  `b : associates N` then for any prime `p ∣ a`, `multiplicity p a = multiplicity (d p) b`.
+- `multiplicity_eq_multiplicity_factor_dvd_iso_of_mem_normalized_factor` : if there is a bijection
+  between the set of factors of `a : M` and `b : N` then for any prime `p ∣ a`,
+  `multiplicity p a = multiplicity (d p) b`
+
 
 ## Todo
-- Show that under the assumptions of `multiplicity_prime_le_multiplicity_image_by_factor_order_iso`,
-  `d p` is prime whenever `p` is prime. Applying
-  `multiplicity_prime_le_multiplicity_image_by_factor_order_iso` on `d.symm` then gives us
-  `multiplicity p a = multiplicity (d p) b`.
 - Create a structure for chains of divisors.
+- Simplify proof of `mem_normalized_factors_factor_dvd_iso_of_mem_normalized_factors` using
+  `mem_normalized_factors_factor_order_iso_of_mem_normalized_factors` or vice versa.
 
 -/
 
 
 variables {M : Type*} [cancel_comm_monoid_with_zero M]
 
-open unique_factorization_monoid multiplicity irreducible
+lemma associates.is_atom_iff {p : associates M} (h₁ : p ≠ 0) :
+  is_atom p ↔ irreducible p :=
+⟨λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one] using hp.1,
+        λ a b h, (hp.le_iff.mp ⟨_, h⟩).cases_on
+          (λ ha, or.inl (a.is_unit_iff_eq_one.mpr ha))
+          (λ ha, or.inr (show is_unit b, by {rw ha at h, apply is_unit_of_associated_mul
+          (show associated (p * b) p, by conv_rhs {rw h}) h₁ }))⟩,
+ λ hp, ⟨by simpa only [associates.is_unit_iff_eq_one, associates.bot_eq_one] using hp.1,
+        λ b ⟨⟨a, hab⟩, hb⟩, (hp.is_unit_or_is_unit hab).cases_on
+          (λ hb, show b = ⊥, by rwa [associates.is_unit_iff_eq_one, ← associates.bot_eq_one] at hb)
+          (λ ha, absurd (show p ∣ b, from ⟨(ha.unit⁻¹ : units _), by simp [hab]; rw mul_assoc;
+            rw is_unit.mul_coe_inv ha; rw mul_one⟩) hb)⟩⟩
+
+open unique_factorization_monoid multiplicity irreducible associates
 
 namespace divisor_chain
 
@@ -93,7 +113,7 @@ begin
   { contradiction },
   obtain ⟨i, rfl⟩ := h₂.1 (dvd_trans hp' hr),
   refine congr_arg c (eq_of_ge_of_not_gt _ $ λ hi, _),
-  { rw [fin.le_iff_coe_le_coe, fin.coe_one, nat.succ_le_iff, ← fin.coe_zero,
+  { rw [fin.le_iff_coe_le_coe, fin.coe_one, nat.succ_le_iff, ← fin.coe_zero (n.succ + 1),
         ← fin.lt_iff_coe_lt_coe, fin.pos_iff_ne_zero],
     rintro rfl,
     exact hp.not_unit (first_of_chain_is_unit h₁ @h₂) },
@@ -102,7 +122,7 @@ begin
   refine not_irreducible_of_not_unit_dvd_not_unit
     (dvd_not_unit.not_unit (associates.dvd_not_unit_iff_lt.2
     (h₁ (show (0 : fin (n + 2)) < j, from _)) )) _ hp.irreducible,
-  { simpa [← fin.succ_zero_eq_one, fin.succ_lt_succ_iff] using hi },
+  { simpa [fin.succ_lt_succ_iff, fin.lt_iff_coe_lt_coe] using hi },
   { refine associates.dvd_not_unit_iff_lt.2 (h₁ _),
     simpa only [fin.coe_eq_cast_succ] using fin.lt_succ }
 end
@@ -129,21 +149,21 @@ lemma element_of_chain_eq_pow_second_of_chain {q r : associates M} {n : ℕ} (hn
 begin
   classical,
   let i := (normalized_factors r).card,
-  have hi : normalized_factors r = multiset.repeat (c 1) i,
-  { apply multiset.eq_repeat_of_mem,
+  have hi : normalized_factors r = multiset.replicate i (c 1),
+  { apply multiset.eq_replicate_of_mem,
     intros b hb,
     refine eq_second_of_chain_of_prime_dvd hn h₁ (λ r', h₂) (prime_of_normalized_factor b hb) hr
       (dvd_of_mem_normalized_factors hb) },
   have H : r = (c 1)^i,
   { have := unique_factorization_monoid.normalized_factors_prod (ne_zero_of_dvd_ne_zero hq hr),
-    rw [associated_iff_eq, hi, multiset.prod_repeat] at this,
+    rw [associated_iff_eq, hi, multiset.prod_replicate] at this,
     rw this },
 
   refine ⟨⟨i, _⟩, H⟩,
   have : (finset.univ.image (λ (m : fin (i + 1)), (c 1) ^ (m : ℕ))).card = i + 1,
   { conv_rhs { rw [← finset.card_fin (i+1)] },
     cases n, { contradiction },
-    rw finset.card_image_eq_iff_inj_on,
+    rw finset.card_image_iff,
     refine set.inj_on_of_injective (λ m m' h, fin.ext _) _,
     refine pow_injective_of_not_unit
       (element_of_chain_not_is_unit_of_index_ne_zero (by simp) h₁) _ h,
@@ -172,7 +192,7 @@ begin
   refine (nat.lt_succ_iff.1 i.prop).antisymm' (nat.le_of_succ_le_succ _),
   calc n + 1 = (finset.univ : finset (fin (n + 1))).card : (finset.card_fin _).symm
          ... = (finset.univ.image c).card :
-    (finset.card_image_eq_iff_inj_on.mpr (h₁.injective.inj_on _)).symm
+    (finset.card_image_iff.mpr (h₁.injective.inj_on _)).symm
          ... ≤ (finset.univ.image (λ (m : fin (i + 1)), (c 1)^(m : ℕ))).card :
           finset.card_le_of_subset _
          ... ≤ (finset.univ : finset (fin (i + 1))).card : finset.card_image_le
@@ -195,15 +215,35 @@ lemma is_prime_pow_of_has_chain {q : associates M} {n : ℕ} (hn : n ≠ 0)
 
 end divisor_chain
 
-variables {N : Type*} [cancel_comm_monoid_with_zero N] [unique_factorization_monoid N]
-  [decidable_eq (associates M)] [unique_factorization_monoid M]
+variables {N : Type*} [cancel_comm_monoid_with_zero N]
+
+lemma factor_order_iso_map_one_eq_bot {m : associates M} {n : associates N}
+  (d : {l : associates M // l ≤ m} ≃o {l : associates N // l ≤ n}) :
+  (d ⟨1, one_dvd m⟩ : associates N) = 1 :=
+begin
+  letI : order_bot {l : associates M // l ≤ m} := subtype.order_bot bot_le,
+  letI : order_bot {l : associates N // l ≤ n} := subtype.order_bot bot_le,
+  simp [←associates.bot_eq_one]
+end
+
+lemma coe_factor_order_iso_map_eq_one_iff {m u : associates M} {n : associates N}
+  (hu' : u ≤ m) (d : set.Iic m ≃o set.Iic n) :
+  (d ⟨u, hu'⟩ : associates N) = 1 ↔ u = 1 :=
+⟨λ hu, by { rw (show u = ↑(d.symm ⟨↑(d ⟨u, hu'⟩), (d ⟨u, hu'⟩).prop⟩), by simp only
+    [subtype.coe_eta, order_iso.symm_apply_apply, subtype.coe_mk]),
+  convert factor_order_iso_map_one_eq_bot d.symm },
+  λ hu, by {simp_rw hu, convert factor_order_iso_map_one_eq_bot d } ⟩
+
+section
+
+variables [unique_factorization_monoid N] [unique_factorization_monoid M]
 
 open divisor_chain
 
-lemma pow_image_of_prime_by_factor_order_iso_dvd {m p : associates M} {n : associates N}
-  (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
-  (d : {l : associates M // l ≤ m} ≃o {l : associates N // l ≤ n}) {s : ℕ}
-  (hs' : p^s ≤ m) : (d ⟨p, dvd_of_mem_normalized_factors hp⟩ : associates N)^s ≤ n :=
+lemma pow_image_of_prime_by_factor_order_iso_dvd [decidable_eq (associates M)] {m p : associates M}
+  {n : associates N} (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
+  (d : set.Iic m ≃o set.Iic n) {s : ℕ} (hs' : p^s ≤ m) :
+  (d ⟨p, dvd_of_mem_normalized_factors hp⟩ : associates N)^s ≤ n :=
 begin
   by_cases hs : s = 0,
   { simp [hs], },
@@ -232,19 +272,168 @@ begin
   exact ne_zero_of_dvd_ne_zero hn (subtype.prop (d ⟨c₁ 1 ^ s, _⟩))
 end
 
-variables [decidable_rel ((∣) : associates M → associates M → Prop)]
- [decidable_rel ((∣) : associates N → associates N → Prop)]
+lemma map_prime_of_factor_order_iso [decidable_eq (associates M)]
+  {m p : associates M} {n : associates N} (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
+  (d : set.Iic m ≃o set.Iic n) : prime (d ⟨p, dvd_of_mem_normalized_factors hp⟩ : associates N) :=
+begin
+  rw ← irreducible_iff_prime,
+  refine (associates.is_atom_iff $ ne_zero_of_dvd_ne_zero hn (d ⟨p, _⟩).prop).mp ⟨_, λ b hb, _⟩,
+  { rw [ne.def, ← associates.is_unit_iff_eq_bot, associates.is_unit_iff_eq_one,
+      coe_factor_order_iso_map_eq_one_iff _ d],
+    rintro rfl,
+    exact (prime_of_normalized_factor 1 hp).not_unit is_unit_one },
+  { obtain ⟨x, hx⟩ := d.surjective ⟨b, le_trans (le_of_lt hb)
+      (d ⟨p, dvd_of_mem_normalized_factors hp⟩).prop⟩,
+    rw [← subtype.coe_mk b _ , subtype.coe_lt_coe, ← hx] at hb,
+    letI : order_bot {l : associates M // l ≤ m} := subtype.order_bot bot_le,
+    letI : order_bot {l : associates N // l ≤ n} := subtype.order_bot bot_le,
+    suffices : x = ⊥,
+    { rw [this, order_iso.map_bot d] at hx,
+      refine (subtype.mk_eq_bot_iff _ _).mp hx.symm,
+      exact bot_le },
+    obtain ⟨a, ha⟩ := x,
+    rw subtype.mk_eq_bot_iff,
+    { exact ((associates.is_atom_iff $ prime.ne_zero $ prime_of_normalized_factor p hp).mpr $
+      irreducible_of_normalized_factor p hp).right a (subtype.mk_lt_mk.mp $ d.lt_iff_lt.mp hb) },
+  exact bot_le }
+end
+
+lemma mem_normalized_factors_factor_order_iso_of_mem_normalized_factors
+  [decidable_eq (associates M)] [decidable_eq (associates N)] {m p : associates M}
+  {n : associates N} (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
+  (d : set.Iic m ≃o set.Iic n) :
+  ↑(d ⟨p, dvd_of_mem_normalized_factors hp⟩) ∈ normalized_factors n :=
+begin
+  obtain ⟨q, hq, hq'⟩ := exists_mem_normalized_factors_of_dvd hn
+    (map_prime_of_factor_order_iso hn hp d).irreducible
+    (d ⟨p, dvd_of_mem_normalized_factors hp⟩).prop,
+  rw associated_iff_eq at hq',
+  rwa hq'
+end
 
-lemma multiplicity_prime_le_multiplicity_image_by_factor_order_iso {m p : associates M}
-  {n : associates N} (hp : p ∈ normalized_factors m)
-  (d : {l : associates M // l ≤ m} ≃o {l : associates N // l ≤ n}) :
+variables [decidable_rel ((∣) : M → M → Prop)] [decidable_rel ((∣) : N → N → Prop)]
+
+lemma multiplicity_prime_le_multiplicity_image_by_factor_order_iso [decidable_eq (associates M)]
+  {m p : associates M} {n : associates N} (hp : p ∈ normalized_factors m)
+  (d : set.Iic m ≃o set.Iic n) :
   multiplicity p m ≤ multiplicity ↑(d ⟨p, dvd_of_mem_normalized_factors hp⟩) n :=
 begin
   by_cases hn : n = 0,
   { simp [hn], },
   by_cases hm : m = 0,
   { simpa [hm] using hp, },
-  rw [←enat.coe_get (finite_iff_dom.1 $ finite_prime_left (prime_of_normalized_factor p hp) hm),
-    ←pow_dvd_iff_le_multiplicity],
+  rw [← part_enat.coe_get
+    (finite_iff_dom.1 $ finite_prime_left (prime_of_normalized_factor p hp) hm),
+    ← pow_dvd_iff_le_multiplicity],
   exact pow_image_of_prime_by_factor_order_iso_dvd hn hp d (pow_multiplicity_dvd _),
 end
+
+lemma multiplicity_prime_eq_multiplicity_image_by_factor_order_iso [decidable_eq (associates M)]
+  {m p : associates M} {n : associates N} (hn : n ≠ 0)
+  (hp : p ∈ normalized_factors m) (d : set.Iic m ≃o set.Iic n) :
+  multiplicity p m = multiplicity ↑(d ⟨p, dvd_of_mem_normalized_factors hp⟩) n :=
+begin
+  refine le_antisymm (multiplicity_prime_le_multiplicity_image_by_factor_order_iso hp d) _,
+  suffices : multiplicity ↑(d ⟨p, dvd_of_mem_normalized_factors hp⟩) n ≤
+    multiplicity ↑(d.symm (d ⟨p, dvd_of_mem_normalized_factors hp⟩)) m,
+  { rw [d.symm_apply_apply ⟨p, dvd_of_mem_normalized_factors hp⟩, subtype.coe_mk] at this,
+    exact this },
+  letI := classical.dec_eq (associates N),
+  simpa only [subtype.coe_eta] using
+    (multiplicity_prime_le_multiplicity_image_by_factor_order_iso
+      (mem_normalized_factors_factor_order_iso_of_mem_normalized_factors hn hp d) d.symm),
+end
+
+end
+
+variables [unique (Mˣ)] [unique (Nˣ)]
+
+/-- The order isomorphism between the factors of `mk m` and the factors of `mk n` induced by a
+  bijection between the factors of `m` and the factors of `n` that preserves `∣`. -/
+@[simps]
+def mk_factor_order_iso_of_factor_dvd_equiv
+  {m : M} {n : N} {d : {l : M // l ∣ m} ≃ {l : N // l ∣ n}}
+  (hd : ∀ l l', ((d l) : N) ∣ (d l') ↔ (l : M) ∣ (l' : M)) :
+   set.Iic (associates.mk m) ≃o set.Iic (associates.mk n) :=
+{ to_fun := λ l, ⟨associates.mk (d ⟨associates_equiv_of_unique_units ↑l,
+    by { obtain ⟨x, hx⟩ := l, rw [subtype.coe_mk,  associates_equiv_of_unique_units_apply,
+      out_dvd_iff], exact hx } ⟩),
+    mk_le_mk_iff_dvd_iff.mpr (subtype.prop (d ⟨associates_equiv_of_unique_units ↑l, _ ⟩)) ⟩,
+  inv_fun := λ l, ⟨associates.mk (d.symm (⟨(associates_equiv_of_unique_units ↑l),
+      by obtain ⟨x, hx⟩ := l ; rw [subtype.coe_mk, associates_equiv_of_unique_units_apply,
+      out_dvd_iff] ; exact hx ⟩)),
+    mk_le_mk_iff_dvd_iff.mpr (subtype.prop (d.symm ⟨associates_equiv_of_unique_units ↑l, _ ⟩)) ⟩,
+  left_inv := λ ⟨l, hl⟩, by simp only [subtype.coe_eta, equiv.symm_apply_apply, subtype.coe_mk,
+    associates_equiv_of_unique_units_apply, mk_out, out_mk, normalize_eq],
+  right_inv := λ ⟨l, hl⟩, by simp only [subtype.coe_eta, equiv.apply_symm_apply, subtype.coe_mk,
+    associates_equiv_of_unique_units_apply, out_mk, normalize_eq, mk_out],
+  map_rel_iff' :=
+    by rintros ⟨a, ha⟩ ⟨b, hb⟩ ; simp only [equiv.coe_fn_mk, subtype.mk_le_mk,
+      associates.mk_le_mk_iff_dvd_iff, hd, subtype.coe_mk, associates_equiv_of_unique_units_apply,
+      out_dvd_iff, mk_out] }
+
+variables [unique_factorization_monoid M] [unique_factorization_monoid N]
+  [decidable_eq M]
+
+lemma mem_normalized_factors_factor_dvd_iso_of_mem_normalized_factors [decidable_eq N] {m p : M}
+  {n : N} (hm : m ≠ 0) (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
+  {d : {l : M // l ∣ m} ≃ {l : N // l ∣ n}}
+  (hd : ∀ l l', ((d l) : N) ∣ (d l') ↔ (l : M) ∣ (l' : M)) :
+    ↑(d ⟨p, dvd_of_mem_normalized_factors hp⟩) ∈ normalized_factors n :=
+begin
+  suffices : prime ↑(d ⟨associates_equiv_of_unique_units (associates_equiv_of_unique_units.symm p),
+    by simp [dvd_of_mem_normalized_factors hp]⟩),
+  { simp only [associates_equiv_of_unique_units_apply, out_mk, normalize_eq,
+      associates_equiv_of_unique_units_symm_apply] at this,
+    obtain ⟨q, hq, hq'⟩ := exists_mem_normalized_factors_of_dvd hn (this.irreducible)
+      (d ⟨p, by apply dvd_of_mem_normalized_factors ; convert hp⟩).prop,
+    rwa associated_iff_eq.mp hq' },
+  have : associates.mk ↑(d ⟨associates_equiv_of_unique_units
+    (associates_equiv_of_unique_units.symm p), by simp only [dvd_of_mem_normalized_factors hp,
+      associates_equiv_of_unique_units_apply, out_mk, normalize_eq,
+      associates_equiv_of_unique_units_symm_apply] ⟩)
+    = ↑(mk_factor_order_iso_of_factor_dvd_equiv hd ⟨( associates_equiv_of_unique_units.symm p),
+      by simp only [associates_equiv_of_unique_units_symm_apply] ;
+        exact mk_dvd_mk.mpr (dvd_of_mem_normalized_factors hp) ⟩),
+  { rw mk_factor_order_iso_of_factor_dvd_equiv_apply_coe,
+    simp only [subtype.coe_mk] },
+  rw [ ← associates.prime_mk, this],
+  letI := classical.dec_eq (associates M),
+  refine map_prime_of_factor_order_iso (mk_ne_zero.mpr hn) _ _,
+  obtain ⟨q, hq, hq'⟩ := exists_mem_normalized_factors_of_dvd (mk_ne_zero.mpr hm)
+    ((prime_mk p).mpr (prime_of_normalized_factor p (by convert hp))).irreducible
+      (mk_le_mk_of_dvd (dvd_of_mem_normalized_factors hp)),
+  simpa only [associated_iff_eq.mp hq', associates_equiv_of_unique_units_symm_apply] using hq,
+end
+
+variables [decidable_rel ((∣) : M → M → Prop)] [decidable_rel ((∣) : N → N → Prop)]
+
+lemma multiplicity_factor_dvd_iso_eq_multiplicity_of_mem_normalized_factor {m p : M} {n : N}
+  (hm : m ≠ 0) (hn : n ≠ 0) (hp : p ∈ normalized_factors m)
+  {d : {l : M // l ∣ m} ≃ {l : N // l ∣ n}} (hd : ∀ l l', ((d l) : N) ∣ (d l') ↔ (l : M) ∣ l') :
+    multiplicity ((d ⟨p, dvd_of_mem_normalized_factors hp⟩) : N) n = multiplicity p m :=
+begin
+  apply eq.symm,
+  suffices : multiplicity (associates.mk p) (associates.mk m) = multiplicity (associates.mk
+    ↑(d ⟨associates_equiv_of_unique_units (associates_equiv_of_unique_units.symm p),
+      by simp [dvd_of_mem_normalized_factors hp]⟩))
+    (associates.mk n),
+  { simpa only [multiplicity_mk_eq_multiplicity, associates_equiv_of_unique_units_symm_apply,
+      associates_equiv_of_unique_units_apply, out_mk, normalize_eq] using this },
+  have : associates.mk ↑(d ⟨associates_equiv_of_unique_units
+    (associates_equiv_of_unique_units.symm p), by simp only [dvd_of_mem_normalized_factors hp,
+      associates_equiv_of_unique_units_symm_apply, associates_equiv_of_unique_units_apply,
+      out_mk, normalize_eq] ⟩)
+      = ↑(mk_factor_order_iso_of_factor_dvd_equiv hd ⟨(associates_equiv_of_unique_units.symm p),
+        by rw [associates_equiv_of_unique_units_symm_apply] ;
+          exact mk_le_mk_of_dvd (dvd_of_mem_normalized_factors hp) ⟩),
+  { rw mk_factor_order_iso_of_factor_dvd_equiv_apply_coe, refl },
+  rw this,
+  letI := classical.dec_eq (associates M),
+  refine multiplicity_prime_eq_multiplicity_image_by_factor_order_iso (mk_ne_zero.mpr hn) _
+    (mk_factor_order_iso_of_factor_dvd_equiv hd),
+  obtain ⟨q, hq, hq'⟩ := exists_mem_normalized_factors_of_dvd (mk_ne_zero.mpr hm)
+    ((prime_mk p).mpr (prime_of_normalized_factor p hp)).irreducible
+      (mk_le_mk_of_dvd (dvd_of_mem_normalized_factors hp)),
+  rwa associated_iff_eq.mp hq',
+end
diff --git a/src/ring_theory/class_group.lean b/src/ring_theory/class_group.lean
index 5d6f4889966df..e6717c1bbf8bd 100644
--- a/src/ring_theory/class_group.lean
+++ b/src/ring_theory/class_group.lean
@@ -10,8 +10,11 @@ import ring_theory.dedekind_domain.ideal
 /-!
 # The ideal class group
 
-This file defines the ideal class group `class_group R K` of fractional ideals of `R`
-inside `A`'s field of fractions `K`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the ideal class group `class_group R` of fractional ideals of `R`
+inside its field of fractions.
 
 ## Main definitions
  - `to_principal_ideal` sends an invertible `x : K` to an invertible fractional ideal
@@ -21,6 +24,11 @@ inside `A`'s field of fractions `K`.
 ## Main results
  - `class_group.mk0_eq_mk0_iff` shows the equivalence with the "classical" definition,
    where `I ~ J` iff `x I = y J` for `x y ≠ (0 : R)`
+
+## Implementation details
+
+The definition of `class_group R` involves `fraction_ring R`. However, the API should be completely
+identical no matter the choice of field of fractions for `R`.
 -/
 
 variables {R K L : Type*} [comm_ring R]
@@ -49,152 +57,285 @@ def to_principal_ideal : Kˣ →* (fractional_ideal R⁰ K)ˣ :=
     (by simp only [units.coe_mk, units.coe_mul, span_singleton_mul_span_singleton]),
   map_one' := ext (by simp only [span_singleton_one, units.coe_mk, units.coe_one]) }
 
-local attribute [semireducible] to_principal_ideal
-
 variables {R K}
 
 @[simp] lemma coe_to_principal_ideal (x : Kˣ) :
   (to_principal_ideal R K x : fractional_ideal R⁰ K) = span_singleton _ x :=
-rfl
+by { simp only [to_principal_ideal], refl }
 
 @[simp] lemma to_principal_ideal_eq_iff {I : (fractional_ideal R⁰ K)ˣ} {x : Kˣ} :
   to_principal_ideal R K x = I ↔ span_singleton R⁰ (x : K) = I :=
-units.ext_iff
+by { simp only [to_principal_ideal], exact units.ext_iff }
 
+lemma mem_principal_ideals_iff {I : (fractional_ideal R⁰ K)ˣ} :
+  I ∈ (to_principal_ideal R K).range ↔ ∃ x : K, span_singleton R⁰ x = I :=
+begin
+  simp only [monoid_hom.mem_range, to_principal_ideal_eq_iff],
+  split; rintros ⟨x, hx⟩,
+  { exact ⟨x, hx⟩ },
+  { refine ⟨units.mk0 x _, hx⟩,
+    rintro rfl,
+    simpa [I.ne_zero.symm] using hx }
 end
 
 instance principal_ideals.normal : (to_principal_ideal R K).range.normal :=
 subgroup.normal_of_comm _
 
-section
+end
 
-variables (R K)
+variables (R) [is_domain R]
 
-/-- The ideal class group of `R` in a field of fractions `K`
-is the group of invertible fractional ideals modulo the principal ideals. -/
-@[derive(comm_group)]
-def class_group := (fractional_ideal R⁰ K)ˣ ⧸ (to_principal_ideal R K).range
+/-- The ideal class group of `R` is the group of invertible fractional ideals
+modulo the principal ideals. -/
+@[derive comm_group]
+def class_group :=
+(fractional_ideal R⁰ (fraction_ring R))ˣ ⧸ (to_principal_ideal R (fraction_ring R)).range
 
-instance : inhabited (class_group R K) := ⟨1⟩
+noncomputable instance : inhabited (class_group R) := ⟨1⟩
 
-variables {R} [is_domain R]
+variables {R K}
+
+/-- Send a nonzero fractional ideal to the corresponding class in the class group. -/
+noncomputable def class_group.mk : (fractional_ideal R⁰ K)ˣ →* class_group R :=
+(quotient_group.mk' (to_principal_ideal R (fraction_ring R)).range).comp
+  (units.map (fractional_ideal.canonical_equiv R⁰ K (fraction_ring R)))
+
+lemma class_group.mk_eq_mk {I J : (fractional_ideal R⁰ $ fraction_ring R)ˣ} :
+  class_group.mk I = class_group.mk J
+    ↔ ∃ x : (fraction_ring R)ˣ, I * to_principal_ideal R (fraction_ring R) x = J :=
+by { erw [quotient_group.mk'_eq_mk', canonical_equiv_self, units.map_id, set.exists_range_iff],
+     refl }
+
+lemma class_group.mk_eq_mk_of_coe_ideal
+  {I J : (fractional_ideal R⁰ $ fraction_ring R)ˣ} {I' J' : ideal R}
+  (hI : (I : fractional_ideal R⁰ $ fraction_ring R) = I')
+  (hJ : (J : fractional_ideal R⁰ $ fraction_ring R) = J') :
+  class_group.mk I = class_group.mk J
+    ↔ ∃ x y : R, x ≠ 0 ∧ y ≠ 0 ∧ ideal.span {x} * I' = ideal.span {y} * J' :=
+begin
+  rw [class_group.mk_eq_mk],
+  split,
+  { rintro ⟨x, rfl⟩,
+    rw [units.coe_mul, hI, coe_to_principal_ideal, mul_comm,
+        span_singleton_mul_coe_ideal_eq_coe_ideal] at hJ,
+    exact ⟨_, _, sec_fst_ne_zero le_rfl x.ne_zero, sec_snd_ne_zero le_rfl ↑x, hJ⟩ },
+  { rintro ⟨x, y, hx, hy, h⟩,
+    split, rw [mul_comm, ← units.eq_iff, units.coe_mul, coe_to_principal_ideal],
+    convert (mk'_mul_coe_ideal_eq_coe_ideal (fraction_ring R) $
+              mem_non_zero_divisors_of_ne_zero hy).2 h,
+    apply (ne.is_unit _).unit_spec,
+    rwa [ne, mk'_eq_zero_iff_eq_zero] }
+end
+
+lemma class_group.mk_eq_one_of_coe_ideal {I : (fractional_ideal R⁰ $ fraction_ring R)ˣ}
+  {I' : ideal R} (hI : (I : fractional_ideal R⁰ $ fraction_ring R) = I') :
+  class_group.mk I = 1 ↔ ∃ x : R, x ≠ 0 ∧ I' = ideal.span {x} :=
+begin
+  rw [← map_one class_group.mk, class_group.mk_eq_mk_of_coe_ideal hI (_ : _ = ↑⊤)],
+  any_goals { refl },
+  split,
+  { rintro ⟨x, y, hx, hy, h⟩,
+    rw [ideal.mul_top] at h,
+    rcases ideal.mem_span_singleton_mul.mp ((ideal.span_singleton_le_iff_mem _).mp h.ge)
+      with ⟨i, hi, rfl⟩,
+    rw [← ideal.span_singleton_mul_span_singleton, ideal.span_singleton_mul_right_inj hx] at h,
+    exact ⟨i, right_ne_zero_of_mul hy, h⟩ },
+  { rintro ⟨x, hx, rfl⟩,
+    exact ⟨1, x, one_ne_zero, hx, by rw [ideal.span_singleton_one, ideal.top_mul, ideal.mul_top]⟩ }
+end
+
+variables (K)
+
+/-- Induction principle for the class group: to show something holds for all `x : class_group R`,
+we can choose a fraction field `K` and show it holds for the equivalence class of each
+`I : fractional_ideal R⁰ K`. -/
+@[elab_as_eliminator] lemma class_group.induction {P : class_group R → Prop}
+  (h : ∀ (I : (fractional_ideal R⁰ K)ˣ), P (class_group.mk I)) (x : class_group R) : P x :=
+quotient_group.induction_on x (λ I, begin
+  convert h (units.map_equiv ↑(canonical_equiv R⁰ (fraction_ring R) K) I),
+  ext : 1,
+  rw [units.coe_map, units.coe_map_equiv],
+  exact (canonical_equiv_flip R⁰ K (fraction_ring R) I).symm
+end)
+
+/-- The definition of the class group does not depend on the choice of field of fractions. -/
+noncomputable def class_group.equiv :
+  class_group R ≃* (fractional_ideal R⁰ K)ˣ ⧸ (to_principal_ideal R K).range :=
+quotient_group.congr _ _
+  (units.map_equiv (fractional_ideal.canonical_equiv R⁰ (fraction_ring R) K :
+    fractional_ideal R⁰ (fraction_ring R) ≃* fractional_ideal R⁰ K)) $
+begin
+  ext I,
+  simp only [subgroup.mem_map, mem_principal_ideals_iff, monoid_hom.coe_coe],
+  split,
+  { rintro ⟨I, ⟨x, hx⟩, rfl⟩,
+    refine ⟨fraction_ring.alg_equiv R K x, _⟩,
+    rw [units.coe_map_equiv, ← hx, ring_equiv.coe_to_mul_equiv, canonical_equiv_span_singleton],
+    refl },
+  { rintro ⟨x, hx⟩,
+    refine ⟨units.map_equiv ↑(canonical_equiv R⁰ K (fraction_ring R)) I,
+      ⟨(fraction_ring.alg_equiv R K).symm x, _⟩,
+      units.ext _⟩,
+    { rw [units.coe_map_equiv, ← hx, ring_equiv.coe_to_mul_equiv, canonical_equiv_span_singleton],
+      refl },
+    simp only [ring_equiv.coe_to_mul_equiv, canonical_equiv_flip, units.coe_map_equiv] },
+end
+
+@[simp] lemma class_group.equiv_mk (K' : Type*) [field K'] [algebra R K'] [is_fraction_ring R K']
+  (I : (fractional_ideal R⁰ K)ˣ) :
+  class_group.equiv K' (class_group.mk I) =
+    quotient_group.mk' _ (units.map_equiv ↑(fractional_ideal.canonical_equiv R⁰ K K') I) :=
+begin
+  rw [class_group.equiv, class_group.mk, monoid_hom.comp_apply, quotient_group.congr_mk'],
+  congr,
+  ext : 1,
+  rw [units.coe_map_equiv, units.coe_map_equiv, units.coe_map],
+  exact fractional_ideal.canonical_equiv_canonical_equiv _ _ _ _ _
+end
+
+@[simp] lemma class_group.mk_canonical_equiv (K' : Type*) [field K'] [algebra R K']
+  [is_fraction_ring R K'] (I : (fractional_ideal R⁰ K)ˣ) :
+  class_group.mk (units.map ↑(canonical_equiv R⁰ K K') I : (fractional_ideal R⁰ K')ˣ) =
+    class_group.mk I :=
+by rw [class_group.mk, monoid_hom.comp_apply, ← monoid_hom.comp_apply (units.map _),
+  ← units.map_comp, ← ring_equiv.coe_monoid_hom_trans,
+  fractional_ideal.canonical_equiv_trans_canonical_equiv]; refl
 
 /-- Send a nonzero integral ideal to an invertible fractional ideal. -/
-@[simps]
 noncomputable def fractional_ideal.mk0 [is_dedekind_domain R] :
   (ideal R)⁰ →* (fractional_ideal R⁰ K)ˣ :=
-{ to_fun := λ I, units.mk0 I ((fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl R⁰)).mpr
-    (mem_non_zero_divisors_iff_ne_zero.mp I.2)),
+{ to_fun   := λ I, units.mk0 I (coe_ideal_ne_zero.mpr $ mem_non_zero_divisors_iff_ne_zero.mp I.2),
   map_one' := by simp,
   map_mul' := λ x y, by simp }
 
-/-- Send a nonzero ideal to the corresponding class in the class group. -/
-@[simps]
-noncomputable def class_group.mk0 [is_dedekind_domain R] :
-  (ideal R)⁰ →* class_group R K :=
-(quotient_group.mk' _).comp (fractional_ideal.mk0 K)
+@[simp] lemma fractional_ideal.coe_mk0 [is_dedekind_domain R] (I : (ideal R)⁰) :
+  (fractional_ideal.mk0 K I : fractional_ideal R⁰ K) = I :=
+rfl
 
-variables {K}
+lemma fractional_ideal.canonical_equiv_mk0 [is_dedekind_domain R]
+  (K' : Type*) [field K'] [algebra R K'] [is_fraction_ring R K'] (I : (ideal R)⁰) :
+  fractional_ideal.canonical_equiv R⁰ K K' (fractional_ideal.mk0 K I) = fractional_ideal.mk0 K' I :=
+by simp only [fractional_ideal.coe_mk0, coe_coe, fractional_ideal.canonical_equiv_coe_ideal]
 
-lemma quotient_group.mk'_eq_mk' {G : Type*} [group G] {N : subgroup G} [hN : N.normal] {x y : G} :
-  quotient_group.mk' N x = quotient_group.mk' N y ↔ ∃ z ∈ N, x * z = y :=
-(@quotient.eq _ (quotient_group.left_rel _) _ _).trans
-  ⟨λ (h : x⁻¹ * y ∈ N), ⟨_, h, by rw [← mul_assoc, mul_right_inv, one_mul]⟩,
-   λ ⟨z, z_mem, eq_y⟩,
-     by { rw ← eq_y, show x⁻¹ * (x * z) ∈ N, rwa [← mul_assoc, mul_left_inv, one_mul] }⟩
+@[simp] lemma fractional_ideal.map_canonical_equiv_mk0 [is_dedekind_domain R]
+  (K' : Type*) [field K'] [algebra R K'] [is_fraction_ring R K'] (I : (ideal R)⁰) :
+  units.map ↑(fractional_ideal.canonical_equiv R⁰ K K') (fractional_ideal.mk0 K I) =
+    fractional_ideal.mk0 K' I :=
+units.ext (fractional_ideal.canonical_equiv_mk0 K K' I)
+
+/-- Send a nonzero ideal to the corresponding class in the class group. -/
+noncomputable def class_group.mk0 [is_dedekind_domain R] : (ideal R)⁰ →* class_group R :=
+class_group.mk.comp (fractional_ideal.mk0 (fraction_ring R))
+
+@[simp] lemma class_group.mk_mk0 [is_dedekind_domain R] (I : (ideal R)⁰):
+  class_group.mk (fractional_ideal.mk0 K I) = class_group.mk0 I :=
+by rw [class_group.mk0, monoid_hom.comp_apply,
+      ← class_group.mk_canonical_equiv K (fraction_ring R),
+      fractional_ideal.map_canonical_equiv_mk0]
+
+@[simp] lemma class_group.equiv_mk0 [is_dedekind_domain R] (I : (ideal R)⁰):
+  class_group.equiv K (class_group.mk0 I) =
+    quotient_group.mk' (to_principal_ideal R K).range (fractional_ideal.mk0 K I) :=
+begin
+  rw [class_group.mk0, monoid_hom.comp_apply, class_group.equiv_mk],
+  congr,
+  ext,
+  simp
+end
 
 lemma class_group.mk0_eq_mk0_iff_exists_fraction_ring [is_dedekind_domain R] {I J : (ideal R)⁰} :
-  class_group.mk0 K I = class_group.mk0 K J ↔
-    ∃ (x ≠ (0 : K)), span_singleton R⁰ x * I = J :=
+  class_group.mk0 I = class_group.mk0 J ↔ ∃ (x ≠ (0 : K)), span_singleton R⁰ x * I = J :=
 begin
-  simp only [class_group.mk0, monoid_hom.comp_apply, quotient_group.mk'_eq_mk'],
+  refine (class_group.equiv K).injective.eq_iff.symm.trans _,
+  simp only [class_group.equiv_mk0, quotient_group.mk'_eq_mk', mem_principal_ideals_iff,
+    coe_coe, units.ext_iff, units.coe_mul, fractional_ideal.coe_mk0, exists_prop],
   split,
-  { rintros ⟨_, ⟨x, rfl⟩, hx⟩,
-    refine ⟨x, x.ne_zero, _⟩,
-    simpa only [mul_comm, coe_mk0, monoid_hom.to_fun_eq_coe, coe_to_principal_ideal, units.coe_mul]
-      using congr_arg (coe : _ → fractional_ideal R⁰ K) hx },
+  { rintros ⟨X, ⟨x, hX⟩, hx⟩,
+    refine ⟨x, _, _⟩,
+    { rintro rfl, simpa [X.ne_zero.symm] using hX },
+    simpa only [hX, mul_comm] using hx },
   { rintros ⟨x, hx, eq_J⟩,
-    refine ⟨_, ⟨units.mk0 x hx, rfl⟩, units.ext _⟩,
-    simpa only [fractional_ideal.mk0_apply, units.coe_mk0, mul_comm, coe_to_principal_ideal,
-        coe_coe, units.coe_mul] using eq_J }
+    refine ⟨units.mk0 _ (span_singleton_ne_zero_iff.mpr hx), ⟨x, rfl⟩, _⟩,
+    simpa only [mul_comm] using eq_J }
 end
 
+variables {K}
+
 lemma class_group.mk0_eq_mk0_iff [is_dedekind_domain R] {I J : (ideal R)⁰} :
-  class_group.mk0 K I = class_group.mk0 K J ↔
+  class_group.mk0 I = class_group.mk0 J ↔
     ∃ (x y : R) (hx : x ≠ 0) (hy : y ≠ 0), ideal.span {x} * (I : ideal R) = ideal.span {y} * J :=
 begin
-  refine class_group.mk0_eq_mk0_iff_exists_fraction_ring.trans ⟨_, _⟩,
+  refine (class_group.mk0_eq_mk0_iff_exists_fraction_ring (fraction_ring R)).trans ⟨_, _⟩,
   { rintros ⟨z, hz, h⟩,
     obtain ⟨x, ⟨y, hy⟩, rfl⟩ := is_localization.mk'_surjective R⁰ z,
     refine ⟨x, y, _, mem_non_zero_divisors_iff_ne_zero.mp hy, _⟩,
     { rintro hx, apply hz,
-      rw [hx, is_fraction_ring.mk'_eq_div, (algebra_map R K).map_zero, zero_div] },
-    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal K hy).mp h } },
+      rw [hx, is_fraction_ring.mk'_eq_div, _root_.map_zero, zero_div] },
+    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal _ hy).mp h } },
   { rintros ⟨x, y, hx, hy, h⟩,
     have hy' : y ∈ R⁰ := mem_non_zero_divisors_iff_ne_zero.mpr hy,
-    refine ⟨is_localization.mk' K x ⟨y, hy'⟩, _, _⟩,
+    refine ⟨is_localization.mk' _ x ⟨y, hy'⟩, _, _⟩,
     { contrapose! hx,
-      rwa [is_localization.mk'_eq_iff_eq_mul, zero_mul, ← (algebra_map R K).map_zero,
-           (is_fraction_ring.injective R K).eq_iff] at hx },
-    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal K hy').mpr h } },
+      rwa [mk'_eq_iff_eq_mul, zero_mul, ← (algebra_map R (fraction_ring R)).map_zero,
+           (is_fraction_ring.injective R (fraction_ring R)).eq_iff]
+        at hx },
+    { exact (fractional_ideal.mk'_mul_coe_ideal_eq_coe_ideal _ hy').mpr h } },
 end
 
 lemma class_group.mk0_surjective [is_dedekind_domain R] :
-  function.surjective (class_group.mk0 K : (ideal R)⁰ → class_group R K) :=
+  function.surjective (class_group.mk0 : (ideal R)⁰ → class_group R) :=
 begin
   rintros ⟨I⟩,
   obtain ⟨a, a_ne_zero', ha⟩ := I.1.2,
   have a_ne_zero := mem_non_zero_divisors_iff_ne_zero.mp a_ne_zero',
-  have fa_ne_zero : (algebra_map R K) a ≠ 0 :=
+  have fa_ne_zero : (algebra_map R (fraction_ring R)) a ≠ 0 :=
     is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors a_ne_zero',
-  refine ⟨⟨{ carrier := { x | (algebra_map R K a)⁻¹ * algebra_map R K x ∈ I.1 }, .. }, _⟩, _⟩,
+  refine ⟨⟨{ carrier := { x | (algebra_map R _ a)⁻¹ * algebra_map R _ x ∈ I.1 }, .. }, _⟩, _⟩,
   { simp only [ring_hom.map_add, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add],
     exact λ _ _ ha hb, submodule.add_mem I ha hb },
   { simp only [ring_hom.map_zero, set.mem_set_of_eq, mul_zero, ring_hom.map_mul],
     exact submodule.zero_mem I },
   { intros c _ hb,
     simp only [smul_eq_mul, set.mem_set_of_eq, mul_zero, ring_hom.map_mul, mul_add,
-               mul_left_comm ((algebra_map R K) a)⁻¹],
+               mul_left_comm ((algebra_map R (fraction_ring R)) a)⁻¹],
     rw ← algebra.smul_def c,
     exact submodule.smul_mem I c hb },
   { rw [mem_non_zero_divisors_iff_ne_zero, submodule.zero_eq_bot, submodule.ne_bot_iff],
     obtain ⟨x, x_ne, x_mem⟩ := exists_ne_zero_mem_is_integer I.ne_zero,
     refine ⟨a * x, _, mul_ne_zero a_ne_zero x_ne⟩,
-    change ((algebra_map R K) a)⁻¹ * (algebra_map R K) (a * x) ∈ I.1,
+    change ((algebra_map R _) a)⁻¹ * (algebra_map R _) (a * x) ∈ I.1,
     rwa [ring_hom.map_mul, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] },
   { symmetry,
     apply quotient.sound,
-    refine ⟨units.mk0 (algebra_map R K a) fa_ne_zero, _⟩,
-    apply @mul_left_cancel _ _ I,
-    rw [← mul_assoc, mul_right_inv, one_mul, eq_comm, mul_comm I],
+    change setoid.r _ _,
+    rw quotient_group.left_rel_apply,
+    refine ⟨units.mk0 (algebra_map R _ a) fa_ne_zero, _⟩,
+    rw [_root_.eq_inv_mul_iff_mul_eq, eq_comm, mul_comm I],
     apply units.ext,
-    simp only [monoid_hom.coe_mk, subtype.coe_mk, ring_hom.map_mul, coe_coe,
-               units.coe_mul, coe_to_principal_ideal, coe_mk0,
-               fractional_ideal.eq_span_singleton_mul],
+    simp only [fractional_ideal.coe_mk0, fractional_ideal.map_canonical_equiv_mk0, set_like.coe_mk,
+        units.coe_mk0, coe_to_principal_ideal, coe_coe, units.coe_mul,
+        fractional_ideal.eq_span_singleton_mul],
     split,
     { intros zJ' hzJ',
-      obtain ⟨zJ, hzJ : (algebra_map R K a)⁻¹ * algebra_map R K zJ ∈ ↑I, rfl⟩ :=
+      obtain ⟨zJ, hzJ : (algebra_map R _ a)⁻¹ * algebra_map R _ zJ ∈ ↑I, rfl⟩ :=
         (mem_coe_ideal R⁰).mp hzJ',
       refine ⟨_, hzJ, _⟩,
       rw [← mul_assoc, mul_inv_cancel fa_ne_zero, one_mul] },
     { intros zI' hzI',
       obtain ⟨y, hy⟩ := ha zI' hzI',
-      rw [← algebra.smul_def, fractional_ideal.mk0_apply, coe_mk0, coe_coe, mem_coe_ideal],
+      rw [← algebra.smul_def, mem_coe_ideal],
       refine ⟨y, _, hy⟩,
-      show (algebra_map R K a)⁻¹ * algebra_map R K y ∈ (I : fractional_ideal R⁰ K),
+      show (algebra_map R _ a)⁻¹ * algebra_map R _ y ∈ (I : fractional_ideal R⁰ (fraction_ring R)),
       rwa [hy, algebra.smul_def, ← mul_assoc, inv_mul_cancel fa_ne_zero, one_mul] } }
 end
 
-end
-
-lemma class_group.mk_eq_one_iff
-  {I : (fractional_ideal R⁰ K)ˣ} :
-  quotient_group.mk' (to_principal_ideal R K).range I = 1 ↔
-    (I : submodule R K).is_principal :=
+lemma class_group.mk_eq_one_iff {I : (fractional_ideal R⁰ K)ˣ} :
+  class_group.mk I = 1 ↔ (I : submodule R K).is_principal :=
 begin
-  rw [← (quotient_group.mk' _).map_one, eq_comm, quotient_group.mk'_eq_mk'],
-  simp only [exists_prop, one_mul, exists_eq_right, to_principal_ideal_eq_iff,
-             monoid_hom.mem_range, coe_coe],
+  simp only [← (class_group.equiv K).injective.eq_iff, _root_.map_one, class_group.equiv_mk,
+      quotient_group.mk'_apply, quotient_group.eq_one_iff, monoid_hom.mem_range, units.ext_iff,
+      coe_to_principal_ideal, units.coe_map_equiv, fractional_ideal.canonical_equiv_self, coe_coe,
+      ring_equiv.coe_mul_equiv_refl, mul_equiv.refl_apply],
   refine ⟨λ ⟨x, hx⟩, ⟨⟨x, by rw [← hx, coe_span_singleton]⟩⟩, _⟩,
   unfreezingI { intros hI },
   obtain ⟨x, hx⟩ := @submodule.is_principal.principal _ _ _ _ _ _ hI,
@@ -205,43 +346,41 @@ begin
   simp [hx']
 end
 
-variables [is_domain R]
-
-lemma class_group.mk0_eq_one_iff [is_dedekind_domain R]
-  {I : ideal R} (hI : I ∈ (ideal R)⁰) :
-  class_group.mk0 K ⟨I, hI⟩ = 1 ↔ I.is_principal :=
-class_group.mk_eq_one_iff.trans (coe_submodule_is_principal R K)
+lemma class_group.mk0_eq_one_iff [is_dedekind_domain R] {I : ideal R} (hI : I ∈ (ideal R)⁰) :
+  class_group.mk0 ⟨I, hI⟩ = 1 ↔ I.is_principal :=
+class_group.mk_eq_one_iff.trans (coe_submodule_is_principal R _)
 
 /-- The class group of principal ideal domain is finite (in fact a singleton).
-TODO: generalize to Dedekind domains -/
-instance [is_principal_ideal_ring R] :
-  fintype (class_group R K) :=
+
+See `class_group.fintype_of_admissible` for a finiteness proof that works for rings of integers
+of global fields.
+-/
+noncomputable instance [is_principal_ideal_ring R] : fintype (class_group R) :=
 { elems := {1},
   complete :=
   begin
-    rintros ⟨I⟩,
-    rw [finset.mem_singleton],
-    exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ K).is_principal
+    refine class_group.induction (fraction_ring R) (λ I, _),
+    rw finset.mem_singleton,
+    exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ (fraction_ring R)).is_principal
   end }
 
 /-- The class number of a principal ideal domain is `1`. -/
-lemma card_class_group_eq_one [is_principal_ideal_ring R] :
-  fintype.card (class_group R K) = 1 :=
+lemma card_class_group_eq_one [is_principal_ideal_ring R] : fintype.card (class_group R) = 1 :=
 begin
   rw fintype.card_eq_one_iff,
   use 1,
-  rintros ⟨I⟩,
-  exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ K).is_principal
+  refine class_group.induction (fraction_ring R) (λ I, _),
+  exact class_group.mk_eq_one_iff.mpr (I : fractional_ideal R⁰ (fraction_ring R)).is_principal
 end
 
 /-- The class number is `1` iff the ring of integers is a principal ideal domain. -/
-lemma card_class_group_eq_one_iff [is_dedekind_domain R] [fintype (class_group R K)] :
-  fintype.card (class_group R K) = 1 ↔ is_principal_ideal_ring R :=
+lemma card_class_group_eq_one_iff [is_dedekind_domain R] [fintype (class_group R)] :
+  fintype.card (class_group R) = 1 ↔ is_principal_ideal_ring R :=
 begin
-  split, swap, { introsI, convert card_class_group_eq_one, assumption, assumption, },
+  split, swap, { introsI, convert card_class_group_eq_one, assumption, },
   rw fintype.card_eq_one_iff,
   rintros ⟨I, hI⟩,
-  have eq_one : ∀ J : class_group R K, J = 1 := λ J, trans (hI J) (hI 1).symm,
+  have eq_one : ∀ J : class_group R, J = 1 := λ J, trans (hI J) (hI 1).symm,
   refine ⟨λ I, _⟩,
   by_cases hI : I = ⊥,
   { rw hI, exact bot_is_principal },
diff --git a/src/ring_theory/complex.lean b/src/ring_theory/complex.lean
new file mode 100644
index 0000000000000..88b939cc3fb71
--- /dev/null
+++ b/src/ring_theory/complex.lean
@@ -0,0 +1,46 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import data.complex.module
+import ring_theory.norm
+import ring_theory.trace
+
+/-! # Lemmas about `algebra.trace` and `algebra.norm` on `ℂ` 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
+
+open complex
+
+lemma algebra.left_mul_matrix_complex (z : ℂ) :
+  algebra.left_mul_matrix complex.basis_one_I z = !![z.re, -z.im; z.im, z.re] :=
+begin
+  ext i j,
+  rw [algebra.left_mul_matrix_eq_repr_mul, complex.coe_basis_one_I_repr, complex.coe_basis_one_I,
+    mul_re, mul_im, matrix.of_apply],
+  fin_cases j,
+  { simp_rw [matrix.cons_val_zero, one_re, one_im, mul_zero, mul_one, sub_zero, zero_add],
+    fin_cases i; refl },
+  { simp_rw [matrix.cons_val_one, matrix.head_cons, I_re, I_im, mul_zero, mul_one, zero_sub,
+      add_zero],
+    fin_cases i; refl },
+end
+
+lemma algebra.trace_complex_apply (z : ℂ) : algebra.trace ℝ ℂ z = 2*z.re :=
+begin
+  rw [algebra.trace_eq_matrix_trace complex.basis_one_I,
+    algebra.left_mul_matrix_complex, matrix.trace_fin_two],
+  exact (two_mul _).symm
+end
+
+lemma algebra.norm_complex_apply (z : ℂ) : algebra.norm ℝ z = z.norm_sq :=
+begin
+  rw [algebra.norm_eq_matrix_det complex.basis_one_I,
+    algebra.left_mul_matrix_complex, matrix.det_fin_two, norm_sq_apply],
+  simp,
+end
+
+lemma algebra.norm_complex_eq : algebra.norm ℝ = norm_sq.to_monoid_hom :=
+monoid_hom.ext algebra.norm_complex_apply
diff --git a/src/ring_theory/congruence.lean b/src/ring_theory/congruence.lean
new file mode 100644
index 0000000000000..865204133e71c
--- /dev/null
+++ b/src/ring_theory/congruence.lean
@@ -0,0 +1,291 @@
+/-
+Copyright (c) 2022 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+
+import algebra.group_ring_action.basic
+import algebra.hom.ring
+import algebra.ring.inj_surj
+import group_theory.congruence
+
+/-!
+# Congruence relations on rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines congruence relations on rings, which extend `con` and `add_con` on monoids and
+additive monoids.
+
+Most of the time you likely want to use the `ideal.quotient` API that is built on top of this.
+
+## Main Definitions
+
+* `ring_con R`: the type of congruence relations respecting `+` and `*`.
+* `ring_con_gen r`: the inductively defined smallest ring congruence relation containing a given
+  binary relation.
+
+## TODO
+
+* Use this for `ring_quot` too.
+* Copy across more API from `con` and `add_con` in `group_theory/congruence.lean`, such as:
+  * The `complete_lattice` structure.
+  * The `con_gen_eq` lemma, stating that
+    `ring_con_gen r = Inf {s : ring_con M | ∀ x y, r x y → s x y}`.
+-/
+
+/-- A congruence relation on a type with an addition and multiplication is an equivalence relation
+which preserves both. -/
+/- Note: we can't extend both `add_con R` and `mul_con R` in Lean 3 due to interactions between old-
+and new-style structures. We can revisit this in Lean 4. (After and not during the port!) -/
+structure ring_con (R : Type*) [has_add R] [has_mul R] extends setoid R :=
+(add' : ∀ {w x y z}, r w x → r y z → r (w + y) (x + z))
+(mul' : ∀ {w x y z}, r w x → r y z → r (w * y) (x * z))
+
+variables {α R : Type*}
+
+/-- The inductively defined smallest ring congruence relation containing a given binary
+    relation. -/
+inductive ring_con_gen.rel [has_add R] [has_mul R] (r : R → R → Prop) : R → R → Prop
+| of : Π x y, r x y → ring_con_gen.rel x y
+| refl : Π x, ring_con_gen.rel x x
+| symm : Π {x y}, ring_con_gen.rel x y → ring_con_gen.rel y x
+| trans : Π {x y z}, ring_con_gen.rel x y → ring_con_gen.rel y z → ring_con_gen.rel x z
+| add : Π {w x y z}, ring_con_gen.rel w x → ring_con_gen.rel y z → ring_con_gen.rel (w + y) (x + z)
+| mul : Π {w x y z}, ring_con_gen.rel w x → ring_con_gen.rel y z → ring_con_gen.rel (w * y) (x * z)
+
+/-- The inductively defined smallest ring congruence relation containing a given binary
+    relation. -/
+def ring_con_gen [has_add R] [has_mul R] (r : R → R → Prop) : ring_con R :=
+{ r := ring_con_gen.rel r,
+  iseqv := ⟨ring_con_gen.rel.refl, @ring_con_gen.rel.symm _ _ _ _, @ring_con_gen.rel.trans _ _ _ _⟩,
+  add' := λ _ _ _ _, ring_con_gen.rel.add,
+  mul' := λ _ _ _ _, ring_con_gen.rel.mul }
+
+namespace ring_con
+
+section basic
+variables [has_add R] [has_mul R] (c : ring_con R)
+
+/-- Every `ring_con` is also an `add_con` -/
+def to_add_con : add_con R := { ..c }
+
+/-- Every `ring_con` is also a `con` -/
+def to_con : con R := { ..c }
+
+/-- A coercion from a congruence relation to its underlying binary relation. -/
+instance : has_coe_to_fun (ring_con R) (λ _, R → R → Prop) := ⟨λ c, c.r⟩
+
+@[simp] lemma rel_eq_coe : c.r = c := rfl
+
+protected lemma refl (x) : c x x := c.refl' x
+protected lemma symm {x y} : c x y → c y x := c.symm'
+protected lemma trans {x y z} : c x y → c y z → c x z := c.trans'
+protected lemma add {w x y z} : c w x → c y z → c (w + y) (x + z) := c.add'
+protected lemma mul {w x y z} : c w x → c y z → c (w * y) (x * z) := c.mul'
+
+@[simp] lemma rel_mk {s : setoid R} {ha hm a b} : ring_con.mk s ha hm a b ↔ setoid.r a b := iff.rfl
+
+instance : inhabited (ring_con R) := ⟨ring_con_gen empty_relation⟩
+
+end basic
+
+section quotient
+
+section basic
+variables [has_add R] [has_mul R] (c : ring_con R)
+/-- Defining the quotient by a congruence relation of a type with addition and multiplication. -/
+protected def quotient := quotient c.to_setoid
+
+/-- Coercion from a type with addition and multiplication to its quotient by a congruence relation.
+
+See Note [use has_coe_t]. -/
+instance : has_coe_t R c.quotient := ⟨@quotient.mk _ c.to_setoid⟩
+
+/-- The quotient by a decidable congruence relation has decidable equality. -/
+-- Lower the priority since it unifies with any quotient type.
+@[priority 500] instance [d : ∀ a b, decidable (c a b)] : decidable_eq c.quotient :=
+@quotient.decidable_eq R c.to_setoid d
+
+@[simp] lemma quot_mk_eq_coe (x : R) : quot.mk c x = (x : c.quotient) := rfl
+
+/-- Two elements are related by a congruence relation `c` iff they are represented by the same
+element of the quotient by `c`. -/
+@[simp] protected lemma eq {a b : R} : (a : c.quotient) = b ↔ c a b := quotient.eq'
+
+end basic
+
+/-! ### Basic notation
+
+The basic algebraic notation, `0`, `1`, `+`, `*`, `-`, `^`, descend naturally under the quotient
+-/
+section data
+
+section add_mul
+variables [has_add R] [has_mul R] (c : ring_con R)
+instance : has_add c.quotient := c.to_add_con.has_add
+@[simp, norm_cast] lemma coe_add (x y : R) : (↑(x + y) : c.quotient) = ↑x + ↑y := rfl
+instance : has_mul c.quotient := c.to_con.has_mul
+@[simp, norm_cast] lemma coe_mul (x y : R) : (↑(x * y) : c.quotient) = ↑x * ↑y := rfl
+end add_mul
+
+section zero
+variables [add_zero_class R] [has_mul R] (c : ring_con R)
+instance : has_zero c.quotient := c.to_add_con^.quotient.has_zero
+@[simp, norm_cast] lemma coe_zero : (↑(0 : R) : c.quotient) = 0 := rfl
+end zero
+
+section one
+variables [has_add R] [mul_one_class R] (c : ring_con R)
+instance : has_one c.quotient := c.to_con^.quotient.has_one
+@[simp, norm_cast] lemma coe_one : (↑(1 : R) : c.quotient) = 1 := rfl
+end one
+
+section smul
+variables [has_add R] [mul_one_class R] [has_smul α R] [is_scalar_tower α R R] (c : ring_con R)
+instance : has_smul α c.quotient := c.to_con.has_smul
+@[simp, norm_cast] lemma coe_smul (a : α) (x : R) : (↑(a • x) : c.quotient) = a • x := rfl
+end smul
+
+section neg_sub_zsmul
+variables [add_group R] [has_mul R] (c : ring_con R)
+instance : has_neg c.quotient := c.to_add_con^.has_neg
+@[simp, norm_cast] lemma coe_neg (x : R) : (↑(-x) : c.quotient) = -x := rfl
+instance : has_sub c.quotient := c.to_add_con^.has_sub
+@[simp, norm_cast] lemma coe_sub (x y : R) : (↑(x - y) : c.quotient) = x - y := rfl
+instance has_zsmul : has_smul ℤ c.quotient := c.to_add_con^.quotient.has_zsmul
+@[simp, norm_cast] lemma coe_zsmul (z : ℤ) (x : R) : (↑(z • x) : c.quotient) = z • x := rfl
+end neg_sub_zsmul
+
+section nsmul
+variables [add_monoid R] [has_mul R] (c : ring_con R)
+instance has_nsmul : has_smul ℕ c.quotient := c.to_add_con^.quotient.has_nsmul
+@[simp, norm_cast] lemma coe_nsmul (n : ℕ) (x : R) : (↑(n • x) : c.quotient) = n • x := rfl
+end nsmul
+
+section pow
+variables [has_add R] [monoid R] (c : ring_con R)
+instance : has_pow c.quotient ℕ := c.to_con^.nat.has_pow
+@[simp, norm_cast] lemma coe_pow (x : R) (n : ℕ) : (↑(x ^ n) : c.quotient) = x ^ n := rfl
+end pow
+
+section nat_cast
+variables [add_monoid_with_one R] [has_mul R] (c : ring_con R)
+instance : has_nat_cast c.quotient := ⟨λ n, ↑(n : R)⟩
+@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : (↑(n : R) : c.quotient) = n := rfl
+end nat_cast
+
+section int_cast
+variables [add_group_with_one R] [has_mul R] (c : ring_con R)
+instance : has_int_cast c.quotient := ⟨λ z, ↑(z : R)⟩
+@[simp, norm_cast] lemma coe_int_cast (n : ℕ) : (↑(n : R) : c.quotient) = n := rfl
+end int_cast
+
+instance [inhabited R] [has_add R] [has_mul R] (c : ring_con R) : inhabited c.quotient :=
+⟨↑(default : R)⟩
+
+end data
+
+/-! ### Algebraic structure
+
+The operations above on the quotient by `c : ring_con R` preseverse the algebraic structure of `R`.
+-/
+
+section algebraic
+
+instance [non_unital_non_assoc_semiring R] (c : ring_con R) :
+  non_unital_non_assoc_semiring c.quotient :=
+function.surjective.non_unital_non_assoc_semiring _ quotient.surjective_quotient_mk'
+  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+
+instance [non_assoc_semiring R] (c : ring_con R) :
+  non_assoc_semiring c.quotient :=
+function.surjective.non_assoc_semiring _ quotient.surjective_quotient_mk'
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+instance [non_unital_semiring R] (c : ring_con R) :
+  non_unital_semiring c.quotient :=
+function.surjective.non_unital_semiring _ quotient.surjective_quotient_mk'
+  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+
+instance [semiring R] (c : ring_con R) :
+  semiring c.quotient :=
+function.surjective.semiring _ quotient.surjective_quotient_mk'
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+instance [comm_semiring R] (c : ring_con R) :
+  comm_semiring c.quotient :=
+function.surjective.comm_semiring _ quotient.surjective_quotient_mk'
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+instance [non_unital_non_assoc_ring R] (c : ring_con R) :
+  non_unital_non_assoc_ring c.quotient :=
+function.surjective.non_unital_non_assoc_ring _ quotient.surjective_quotient_mk'
+  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+
+instance [non_assoc_ring R] (c : ring_con R) :
+  non_assoc_ring c.quotient :=
+function.surjective.non_assoc_ring _ quotient.surjective_quotient_mk'
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _, rfl)
+
+instance [non_unital_ring R] (c : ring_con R) :
+  non_unital_ring c.quotient :=
+function.surjective.non_unital_ring _ quotient.surjective_quotient_mk'
+  rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+
+instance [ring R] (c : ring_con R) :
+  ring c.quotient :=
+function.surjective.ring _ quotient.surjective_quotient_mk'
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _, rfl) (λ _, rfl)
+
+instance [comm_ring R] (c : ring_con R) :
+  comm_ring c.quotient :=
+function.surjective.comm_ring _ quotient.surjective_quotient_mk'
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _, rfl) (λ _, rfl)
+
+instance is_scalar_tower_right [has_add R] [mul_one_class R] [has_smul α R] [is_scalar_tower α R R]
+  (c : ring_con R) :
+  is_scalar_tower α c.quotient c.quotient :=
+{ smul_assoc := λ a, quotient.ind₂' $ by exact λ m₁ m₂,
+    congr_arg quotient.mk' $ smul_mul_assoc _ _ _ }
+
+instance smul_comm_class [has_add R] [mul_one_class R] [has_smul α R]
+  [is_scalar_tower α R R] [smul_comm_class α R R] (c : ring_con R) :
+  smul_comm_class α c.quotient c.quotient :=
+{ smul_comm := λ a, quotient.ind₂' $ by exact λ m₁ m₂,
+    congr_arg quotient.mk' $ (mul_smul_comm _ _ _).symm }
+
+instance smul_comm_class' [has_add R] [mul_one_class R] [has_smul α R]
+  [is_scalar_tower α R R] [smul_comm_class R α R] (c : ring_con R) :
+  smul_comm_class c.quotient α c.quotient :=
+by haveI := smul_comm_class.symm R α R; exact smul_comm_class.symm _ _ _
+
+instance [monoid α] [non_assoc_semiring R] [distrib_mul_action α R] [is_scalar_tower α R R]
+  (c : ring_con R) :
+  distrib_mul_action α c.quotient :=
+{ smul := (•),
+  smul_zero := λ r, congr_arg quotient.mk' $ smul_zero _,
+  smul_add := λ r, quotient.ind₂' $ by exact λ m₁ m₂, congr_arg quotient.mk' $ smul_add _ _ _,
+  .. c.to_con.mul_action }
+
+instance [monoid α] [semiring R] [mul_semiring_action α R] [is_scalar_tower α R R]
+  (c : ring_con R) :
+  mul_semiring_action α c.quotient :=
+{ smul := (•),
+  .. c^.quotient.distrib_mul_action,
+  .. c.to_con.mul_distrib_mul_action }
+
+end algebraic
+
+/-- The natural homomorphism from a ring to its quotient by a congruence relation. -/
+def mk' [non_assoc_semiring R] (c : ring_con R) : R →+* c.quotient :=
+{ to_fun := quotient.mk', map_zero' := rfl, map_one' := rfl,
+  map_add' :=  λ _ _, rfl, map_mul' := λ _ _, rfl }
+
+end quotient
+
+end ring_con
diff --git a/src/ring_theory/coprime/basic.lean b/src/ring_theory/coprime/basic.lean
index 2eb406bc1b075..1a3f23e2a122f 100644
--- a/src/ring_theory/coprime/basic.lean
+++ b/src/ring_theory/coprime/basic.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Ken Lee, Chris Hughes
 -/
 import tactic.ring
-import algebra.ring.basic
 import group_theory.group_action.units
 
 /-!
 # Coprime elements of a ring
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `is_coprime x y`: that `x` and `y` are coprime, defined to be the existence of `a` and `b` such
diff --git a/src/ring_theory/coprime/ideal.lean b/src/ring_theory/coprime/ideal.lean
new file mode 100644
index 0000000000000..1cf3d3d97e7c0
--- /dev/null
+++ b/src/ring_theory/coprime/ideal.lean
@@ -0,0 +1,89 @@
+/-
+Copyright (c) 2022 Pierre-Alexandre Bazin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Pierre-Alexandre Bazin
+-/
+import linear_algebra.dfinsupp
+import ring_theory.ideal.operations
+
+/-!
+# An additional lemma about coprime ideals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This lemma generalises `exists_sum_eq_one_iff_pairwise_coprime` to the case of non-principal ideals.
+It is on a separate file due to import requirements.
+-/
+
+namespace ideal
+variables {ι R : Type*} [comm_semiring R]
+
+/--A finite family of ideals is pairwise coprime (that is, any two of them generate the whole ring)
+iff when taking all the possible intersections of all but one of these ideals, the resulting family
+of ideals still generate the whole ring.
+
+For example with three ideals : `I ⊔ J = I ⊔ K = J ⊔ K = ⊤ ↔ (I ⊓ J) ⊔ (I ⊓ K) ⊔ (J ⊓ K) = ⊤`.
+
+When ideals are all of the form `I i = R ∙ s i`, this is equivalent to the
+`exists_sum_eq_one_iff_pairwise_coprime` lemma.-/
+lemma supr_infi_eq_top_iff_pairwise {t : finset ι} (h : t.nonempty) (I : ι → ideal R) :
+  (⨆ i ∈ t, ⨅ j (hj : j ∈ t) (ij : j ≠ i), I j) = ⊤ ↔
+    (t : set ι).pairwise (λ i j, I i ⊔ I j = ⊤) :=
+begin
+  haveI : decidable_eq ι := classical.dec_eq ι,
+  rw [eq_top_iff_one, submodule.mem_supr_finset_iff_exists_sum],
+  refine h.cons_induction _ _; clear' t h,
+  { simp only [finset.sum_singleton, finset.coe_singleton, set.pairwise_singleton, iff_true],
+    refine λ a, ⟨λ i, if h : i = a then ⟨1, _⟩ else 0, _⟩,
+    { rw h, simp only [finset.mem_singleton, ne.def, infi_infi_eq_left, eq_self_iff_true,
+        not_true, infi_false]},
+    { simp only [dif_pos, dif_ctx_congr, submodule.coe_mk, eq_self_iff_true] } },
+  intros a t hat h ih,
+  rw [finset.coe_cons,
+    set.pairwise_insert_of_symmetric (λ i j (h : I i ⊔ I j = ⊤), sup_comm.trans h)],
+  split,
+  { rintro ⟨μ, hμ⟩, rw finset.sum_cons at hμ,
+    refine ⟨ih.mp ⟨pi.single h.some ⟨μ a, _⟩ + λ i, ⟨μ i, _⟩, _⟩, λ b hb ab, _⟩,
+    { have := submodule.coe_mem (μ a), rw mem_infi at this ⊢,
+      --for some reason `simp only [mem_infi]` times out
+      intro i, specialize this i, rw [mem_infi, mem_infi] at this ⊢,
+      intros hi _, apply this (finset.subset_cons _ hi),
+      rintro rfl, exact hat hi },
+    { have := submodule.coe_mem (μ i), simp only [mem_infi] at this ⊢,
+      intros j hj ij, exact this _ (finset.subset_cons _ hj) ij },
+    { rw [← @if_pos _ _ h.some_spec R (μ a) 0, ← finset.sum_pi_single',
+        ← finset.sum_add_distrib] at hμ,
+      convert hμ, ext i, rw [pi.add_apply, submodule.coe_add, submodule.coe_mk],
+      by_cases hi : i = h.some,
+      { rw [hi, pi.single_eq_same, pi.single_eq_same, submodule.coe_mk] },
+      { rw [pi.single_eq_of_ne hi, pi.single_eq_of_ne hi, submodule.coe_zero] } },
+    { rw [eq_top_iff_one, submodule.mem_sup],
+      rw add_comm at hμ, refine ⟨_, _, _, _, hμ⟩,
+      { refine sum_mem _ (λ x hx, _),
+        have := submodule.coe_mem (μ x), simp only [mem_infi] at this,
+        apply this _ (finset.mem_cons_self _ _), rintro rfl, exact hat hx },
+      { have := submodule.coe_mem (μ a), simp only [mem_infi] at this,
+        exact this _ (finset.subset_cons _ hb) ab.symm } } },
+  { rintro ⟨hs, Hb⟩,
+    obtain ⟨μ, hμ⟩ := ih.mpr hs,
+    have := sup_infi_eq_top (λ b hb, Hb b hb (ne_of_mem_of_not_mem hb hat).symm),
+    rw [eq_top_iff_one, submodule.mem_sup] at this,
+    obtain ⟨u, hu, v, hv, huv⟩ := this,
+    refine ⟨λ i, if hi : i = a then ⟨v, _⟩ else ⟨u * μ i, _⟩, _⟩,
+    { simp only [mem_infi] at hv ⊢,
+      intros j hj ij, rw [finset.mem_cons, ← hi] at hj,
+      exact hv _ (hj.resolve_left ij) },
+    { have := submodule.coe_mem (μ i), simp only [mem_infi] at this ⊢,
+      intros j hj ij,
+      rcases finset.mem_cons.mp hj with rfl | hj,
+      { exact mul_mem_right _ _ hu },
+      { exact mul_mem_left _ _ (this _ hj ij) } },
+    { rw [finset.sum_cons, dif_pos rfl, add_comm],
+      rw ← mul_one u at huv, rw [← huv, ← hμ, finset.mul_sum],
+      congr' 1, apply finset.sum_congr rfl, intros j hj,
+      rw dif_neg, refl,
+      rintro rfl, exact hat hj } }
+end
+
+end ideal
diff --git a/src/ring_theory/coprime/lemmas.lean b/src/ring_theory/coprime/lemmas.lean
index 454d672e59b7b..6d6c98a25f7ac 100644
--- a/src/ring_theory/coprime/lemmas.lean
+++ b/src/ring_theory/coprime/lemmas.lean
@@ -11,6 +11,9 @@ import ring_theory.coprime.basic
 /-!
 # Additional lemmas about elements of a ring satisfying `is_coprime`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 These lemmas are in a separate file to the definition of `is_coprime` as they require more imports.
 
 Notably, this includes lemmas about `finset.prod` as this requires importing big_operators, and
@@ -33,6 +36,8 @@ theorem nat.is_coprime_iff_coprime {m n : ℕ} : is_coprime (m : ℤ) n ↔ nat.
 λ H, ⟨nat.gcd_a m n, nat.gcd_b m n, by rw [mul_comm _ (m : ℤ), mul_comm _ (n : ℤ),
     ← nat.gcd_eq_gcd_ab, show _ = _, from H, int.coe_nat_one]⟩⟩
 
+alias nat.is_coprime_iff_coprime ↔ is_coprime.nat_coprime nat.coprime.is_coprime
+
 theorem is_coprime.prod_left : (∀ i ∈ t, is_coprime (s i) x) → is_coprime (∏ i in t, s i) x :=
 finset.induction_on t (λ _, is_coprime_one_left) $ λ b t hbt ih H,
 by { rw finset.prod_insert hbt, rw finset.forall_mem_insert at H, exact H.1.mul_left (ih H.2) }
@@ -96,7 +101,7 @@ begin
     refine ⟨ih.mp ⟨pi.single h.some (μ a * s h.some) + μ * λ _, s a, _⟩, λ b hb, _⟩,
     { rw [prod_eq_mul_prod_diff_singleton h.some_spec, ← mul_assoc,
         ← @if_pos _ _ h.some_spec R (_ * _) 0, ← sum_pi_single', ← sum_add_distrib] at hμ,
-      rw [← hμ, sum_congr rfl], intros x hx, convert add_mul _ _ _ using 2,
+      rw [← hμ, sum_congr rfl], intros x hx, convert @add_mul R _ _ _ _ _ _ using 2,
       { by_cases hx : x = h.some,
         { rw [hx, pi.single_eq_same, pi.single_eq_same] },
         { rw [pi.single_eq_of_ne hx, pi.single_eq_of_ne hx, zero_mul] } },
@@ -136,7 +141,7 @@ begin
   refine ⟨λ hp i hi, is_coprime.prod_right_iff.mpr (λ j hj, _), λ hp, _⟩,
   { rw [finset.mem_sdiff, finset.mem_singleton] at hj,
     obtain ⟨hj, ji⟩ := hj,
-    exact hp ⟨i, hi⟩ ⟨j, hj⟩ (λ h, ji (congr_arg coe h).symm) },
+    exact @hp ⟨i, hi⟩ ⟨j, hj⟩ (λ h, ji (congr_arg coe h).symm) },
   { rintro ⟨i, hi⟩ ⟨j, hj⟩ h,
     apply is_coprime.prod_right_iff.mp (hp i hi),
     exact finset.mem_sdiff.mpr ⟨hj, λ f, h $ subtype.ext (finset.mem_singleton.mp f).symm⟩ }
diff --git a/src/ring_theory/dedekind_domain/S_integer.lean b/src/ring_theory/dedekind_domain/S_integer.lean
new file mode 100644
index 0000000000000..a3cdfe38b2547
--- /dev/null
+++ b/src/ring_theory/dedekind_domain/S_integer.lean
@@ -0,0 +1,105 @@
+/-
+Copyright (c) 2022 David Kurniadi Angdinata. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: David Kurniadi Angdinata
+-/
+
+import ring_theory.dedekind_domain.adic_valuation
+
+/-!
+# `S`-integers and `S`-units of fraction fields of Dedekind domains
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `K` be the field of fractions of a Dedekind domain `R`, and let `S` be a set of prime ideals in
+the height one spectrum of `R`. An `S`-integer of `K` is defined to have `v`-adic valuation at most
+one for all primes ideals `v` away from `S`, whereas an `S`-unit of `Kˣ` is defined to have `v`-adic
+valuation exactly one for all prime ideals `v` away from `S`.
+
+This file defines the subalgebra of `S`-integers of `K` and the subgroup of `S`-units of `Kˣ`, where
+`K` can be specialised to the case of a number field or a function field separately.
+
+## Main definitions
+
+ * `set.integer`: `S`-integers.
+ * `set.unit`: `S`-units.
+ * TODO: localised notation for `S`-integers.
+
+## Main statements
+
+ * `set.unit_equiv_units_integer`: `S`-units are units of `S`-integers.
+ * TODO: proof that `S`-units is the kernel of a map to a product.
+ * TODO: proof that `∅`-integers is the usual ring of integers.
+ * TODO: finite generation of `S`-units and Dirichlet's `S`-unit theorem.
+
+## References
+
+ * [D Marcus, *Number Fields*][marcus1977number]
+ * [J W S Cassels, A Frölich, *Algebraic Number Theory*][cassels1967algebraic]
+ * [J Neukirch, *Algebraic Number Theory*][Neukirch1992]
+
+## Tags
+
+S integer, S-integer, S unit, S-unit
+-/
+
+namespace set
+
+noncomputable theory
+
+open is_dedekind_domain
+
+open_locale non_zero_divisors
+
+universes u v
+
+variables {R : Type u} [comm_ring R] [is_domain R] [is_dedekind_domain R]
+  (S : set $ height_one_spectrum R) (K : Type v) [field K] [algebra R K] [is_fraction_ring R K]
+
+/-! ## `S`-integers -/
+
+/-- The `R`-subalgebra of `S`-integers of `K`. -/
+@[simps] def integer : subalgebra R K :=
+{ algebra_map_mem' := λ x v _, v.valuation_le_one x,
+  .. (⨅ v ∉ S, (v : height_one_spectrum R).valuation.valuation_subring.to_subring).copy
+      {x : K | ∀ v ∉ S, (v : height_one_spectrum R).valuation x ≤ 1} $ set.ext $ λ _,
+      by simpa only [set_like.mem_coe, subring.mem_infi] }
+
+lemma integer_eq :
+  (S.integer K).to_subring
+    = ⨅ v ∉ S, (v : height_one_spectrum R).valuation.valuation_subring.to_subring :=
+set_like.ext' $ by simpa only [integer, subring.copy_eq]
+
+lemma integer_valuation_le_one (x : S.integer K) {v : height_one_spectrum R} (hv : v ∉ S) :
+  v.valuation (x : K) ≤ 1 :=
+x.property v hv
+
+/-! ## `S`-units -/
+
+/-- The subgroup of `S`-units of `Kˣ`. -/
+@[simps] def unit : subgroup Kˣ :=
+(⨅ v ∉ S, (v : height_one_spectrum R).valuation.valuation_subring.unit_group).copy
+  {x : Kˣ | ∀ v ∉ S, (v : height_one_spectrum R).valuation (x : K) = 1} $ set.ext $ λ _,
+  by simpa only [set_like.mem_coe, subgroup.mem_infi, valuation.mem_unit_group_iff]
+
+lemma unit_eq :
+  S.unit K = ⨅ v ∉ S, (v : height_one_spectrum R).valuation.valuation_subring.unit_group :=
+subgroup.copy_eq _ _ _
+
+lemma unit_valuation_eq_one (x : S.unit K) {v : height_one_spectrum R} (hv : v ∉ S) :
+  v.valuation (x : K) = 1 :=
+x.property v hv
+
+/-- The group of `S`-units is the group of units of the ring of `S`-integers. -/
+@[simps] def unit_equiv_units_integer : S.unit K ≃* (S.integer K)ˣ :=
+{ to_fun    := λ x, ⟨⟨x, λ v hv, (x.property v hv).le⟩, ⟨↑x⁻¹, λ v hv, ((x⁻¹).property v hv).le⟩,
+    subtype.ext x.val.val_inv, subtype.ext x.val.inv_val⟩,
+  inv_fun   := λ x, ⟨units.mk0 x $ λ hx, x.ne_zero ((subring.coe_eq_zero_iff _).mp hx),
+    λ v hv, eq_one_of_one_le_mul_left (x.val.property v hv) (x.inv.property v hv) $ eq.ge $
+      by { rw [← map_mul], convert v.valuation.map_one, exact subtype.mk_eq_mk.mp x.val_inv }⟩,
+  left_inv  := λ _, by { ext, refl },
+  right_inv := λ _, by { ext, refl },
+  map_mul'  := λ _ _, by { ext, refl } }
+
+end set
diff --git a/src/ring_theory/dedekind_domain/adic_valuation.lean b/src/ring_theory/dedekind_domain/adic_valuation.lean
index 8d515f612b515..a5d737de91673 100644
--- a/src/ring_theory/dedekind_domain/adic_valuation.lean
+++ b/src/ring_theory/dedekind_domain/adic_valuation.lean
@@ -4,16 +4,30 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: María Inés de Frutos-Fernández
 -/
 import ring_theory.dedekind_domain.ideal
+import ring_theory.valuation.extend_to_localization
+import ring_theory.valuation.valuation_subring
+import topology.algebra.valued_field
+import algebra.order.group.type_tags
 
 /-!
 # Adic valuations on Dedekind domains
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 Given a Dedekind domain `R` of Krull dimension 1 and a maximal ideal `v` of `R`, we define the
-`v`-adic valuation on `R`.
+`v`-adic valuation on `R` and its extension to the field of fractions `K` of `R`.
 We prove several properties of this valuation, including the existence of uniformizers.
-TODO: extend the valuation to the field of fractions `K` of `R`.
+
+We define the completion of `K` with respect to the `v`-adic valuation, denoted
+`v.adic_completion`,and its ring of integers, denoted `v.adic_completion_integers`.
 
 ## Main definitions
  - `is_dedekind_domain.height_one_spectrum.int_valuation v` is the `v`-adic valuation on `R`.
+ - `is_dedekind_domain.height_one_spectrum.valuation v` is the `v`-adic valuation on `K`.
+ - `is_dedekind_domain.height_one_spectrum.adic_completion v` is the completion of `K` with respect
+    to its `v`-adic valuation.
+ - `is_dedekind_domain.height_one_spectrum.adic_completion_integers v` is the ring of integers of
+    `v.adic_completion`.
 
 ## Main results
 - `is_dedekind_domain.height_one_spectrum.int_valuation_le_one` : The `v`-adic valuation on `R` is
@@ -25,6 +39,12 @@ TODO: extend the valuation to the field of fractions `K` of `R`.
   ideal `(r)`.
 - `is_dedekind_domain.height_one_spectrum.int_valuation_exists_uniformizer` : There exists `π ∈ R`
   with `v`-adic valuation `multiplicative.of_add (-1)`.
+- `is_dedekind_domain.height_one_spectrum.valuation_of_mk'` : The `v`-adic valuation of `r/s ∈ K`
+  is the valuation of `r` divided by the valuation of `s`.
+- `is_dedekind_domain.height_one_spectrum.valuation_of_algebra_map` : The `v`-adic valuation on `K`
+  extends the `v`-adic valuation on `R`.
+- `is_dedekind_domain.height_one_spectrum.valuation_exists_uniformizer` : There exists `π ∈ K` with
+  `v`-adic valuation `multiplicative.of_add (-1)`.
 
 ## Implementation notes
 We are only interested in Dedekind domains with Krull dimension 1.
@@ -39,7 +59,7 @@ dedekind domain, dedekind ring, adic valuation
 -/
 
 noncomputable theory
-open_locale classical
+open_locale classical discrete_valuation
 
 open multiplicative is_dedekind_domain
 
@@ -52,7 +72,7 @@ namespace is_dedekind_domain.height_one_spectrum
 /-- The additive `v`-adic valuation of `r ∈ R` is the exponent of `v` in the factorization of the
 ideal `(r)`, if `r` is nonzero, or infinity, if `r = 0`. `int_valuation_def` is the corresponding
 multiplicative valuation. -/
-def int_valuation_def (r : R) : with_zero (multiplicative ℤ) :=
+def int_valuation_def (r : R) : ℤₘ₀ :=
 if r = 0 then 0 else multiplicative.of_add
   (-(associates.mk v.as_ideal).count (associates.mk (ideal.span {r} : ideal R)).factors : ℤ)
 
@@ -189,7 +209,7 @@ begin
 end
 
 /-- The `v`-adic valuation on `R`. -/
-def int_valuation : valuation R (with_zero (multiplicative ℤ)) :=
+def int_valuation : valuation R ℤₘ₀ :=
 { to_fun          := v.int_valuation_def,
   map_zero'       := int_valuation.map_zero' v,
   map_one'        := int_valuation.map_one' v,
@@ -216,10 +236,195 @@ begin
   apply congr_arg,
   rw [neg_inj, ← int.coe_nat_one, int.coe_nat_inj'],
   rw [← ideal.dvd_span_singleton, ← associates.mk_le_mk_iff_dvd_iff] at mem nmem,
-  rw [← pow_one ( associates.mk v.as_ideal),
-    associates.prime_pow_dvd_iff_le hπ hv]  at mem,
+  rw [← pow_one (associates.mk v.as_ideal), associates.prime_pow_dvd_iff_le hπ hv] at mem,
   rw [associates.mk_pow, associates.prime_pow_dvd_iff_le hπ hv, not_le] at nmem,
   exact nat.eq_of_le_of_lt_succ mem nmem,
 end
 
+/-! ### Adic valuations on the field of fractions `K` -/
+
+/-- The `v`-adic valuation of `x ∈ K` is the valuation of `r` divided by the valuation of `s`,
+where `r` and `s` are chosen so that `x = r/s`. -/
+def valuation (v : height_one_spectrum R) : valuation K ℤₘ₀ :=
+v.int_valuation.extend_to_localization (λ r hr, set.mem_compl $ v.int_valuation_ne_zero' ⟨r, hr⟩) K
+
+lemma valuation_def (x : K) : v.valuation x = v.int_valuation.extend_to_localization
+  (λ r hr, set.mem_compl (v.int_valuation_ne_zero' ⟨r, hr⟩)) K x :=
+rfl
+
+/-- The `v`-adic valuation of `r/s ∈ K` is the valuation of `r` divided by the valuation of `s`. -/
+lemma valuation_of_mk' {r : R} {s : non_zero_divisors R} :
+  v.valuation (is_localization.mk' K r s) = v.int_valuation r / v.int_valuation s :=
+begin
+  erw [valuation_def, (is_localization.to_localization_map (non_zero_divisors R) K).lift_mk',
+    div_eq_mul_inv, mul_eq_mul_left_iff],
+  left,
+  rw [units.coe_inv, inv_inj],
+  refl,
+end
+
+/-- The `v`-adic valuation on `K` extends the `v`-adic valuation on `R`. -/
+lemma valuation_of_algebra_map (r : R) :
+  v.valuation (algebra_map R K r) = v.int_valuation r :=
+by rw [valuation_def, valuation.extend_to_localization_apply_map_apply]
+
+/-- The `v`-adic valuation on `R` is bounded above by 1. -/
+lemma valuation_le_one (r : R) : v.valuation (algebra_map R K r) ≤ 1 :=
+by { rw valuation_of_algebra_map, exact v.int_valuation_le_one r }
+
+/-- The `v`-adic valuation of `r ∈ R` is less than 1 if and only if `v` divides the ideal `(r)`. -/
+lemma valuation_lt_one_iff_dvd (r : R) :
+  v.valuation (algebra_map R K r) < 1 ↔ v.as_ideal ∣ ideal.span {r} :=
+by { rw valuation_of_algebra_map, exact v.int_valuation_lt_one_iff_dvd r }
+
+variable (K)
+/-- There exists `π ∈ K` with `v`-adic valuation `multiplicative.of_add (-1)`. -/
+lemma valuation_exists_uniformizer :
+  ∃ (π : K), v.valuation π = multiplicative.of_add (-1 : ℤ) :=
+begin
+  obtain ⟨r, hr⟩ := v.int_valuation_exists_uniformizer,
+  use algebra_map R K r,
+  rw [valuation_def, valuation.extend_to_localization_apply_map_apply],
+  exact hr,
+end
+
+/-- Uniformizers are nonzero. -/
+lemma valuation_uniformizer_ne_zero :
+  (classical.some (v.valuation_exists_uniformizer K)) ≠ 0 :=
+begin
+  have hu := classical.some_spec (v.valuation_exists_uniformizer K),
+  exact (valuation.ne_zero_iff _).mp (ne_of_eq_of_ne hu with_zero.coe_ne_zero),
+end
+
+/-! ### Completions with respect to adic valuations
+
+Given a Dedekind domain `R` with field of fractions `K` and a maximal ideal `v` of `R`, we define
+the completion of `K` with respect to its `v`-adic valuation, denoted `v.adic_completion`, and its
+ring of integers, denoted `v.adic_completion_integers`. -/
+
+variable {K}
+
+/-- `K` as a valued field with the `v`-adic valuation. -/
+def adic_valued : valued K ℤₘ₀ := valued.mk' v.valuation
+
+lemma adic_valued_apply {x : K} : (v.adic_valued.v : _) x = v.valuation x := rfl
+
+variables (K)
+
+/-- The completion of `K` with respect to its `v`-adic valuation. -/
+def adic_completion := @uniform_space.completion K v.adic_valued.to_uniform_space
+
+instance : field (v.adic_completion K) :=
+@uniform_space.completion.field K _ v.adic_valued.to_uniform_space _ _
+  v.adic_valued.to_uniform_add_group
+
+instance : inhabited (v.adic_completion K) := ⟨0⟩
+
+instance valued_adic_completion : valued (v.adic_completion K) ℤₘ₀ :=
+@valued.valued_completion _ _ _ _ v.adic_valued
+
+lemma valued_adic_completion_def {x : v.adic_completion K} :
+  valued.v x = @valued.extension K _ _ _ (adic_valued v) x := rfl
+
+instance adic_completion_complete_space : complete_space (v.adic_completion K) :=
+@uniform_space.completion.complete_space K v.adic_valued.to_uniform_space
+
+instance adic_completion.has_lift_t : has_lift_t K (v.adic_completion K) :=
+(infer_instance : has_lift_t K (@uniform_space.completion K v.adic_valued.to_uniform_space))
+
+/-- The ring of integers of `adic_completion`. -/
+def adic_completion_integers : valuation_subring (v.adic_completion K) := valued.v.valuation_subring
+
+instance : inhabited (adic_completion_integers K v) := ⟨0⟩
+
+variables (R K)
+
+lemma mem_adic_completion_integers {x : v.adic_completion K} :
+  x ∈ v.adic_completion_integers K ↔ (valued.v x : ℤₘ₀) ≤ 1 :=
+iff.rfl
+
+section algebra_instances
+
+@[priority 100] instance adic_valued.has_uniform_continuous_const_smul' :
+  @has_uniform_continuous_const_smul R K v.adic_valued.to_uniform_space _ :=
+@has_uniform_continuous_const_smul_of_continuous_const_smul R K _ _ _
+    v.adic_valued.to_uniform_space _ _
+
+instance adic_valued.has_uniform_continuous_const_smul :
+  @has_uniform_continuous_const_smul K K v.adic_valued.to_uniform_space _ :=
+@ring.has_uniform_continuous_const_smul K _ v.adic_valued.to_uniform_space _ _
+
+instance adic_completion.algebra' : algebra R (v.adic_completion K) :=
+@uniform_space.completion.algebra K _ v.adic_valued.to_uniform_space _ _ R _ _
+  (adic_valued.has_uniform_continuous_const_smul' R K v)
+
+@[simp] lemma coe_smul_adic_completion (r : R) (x : K) :
+  (↑(r • x) : v.adic_completion K) = r • (↑x : v.adic_completion K) :=
+@uniform_space.completion.coe_smul R K v.adic_valued.to_uniform_space _ _ r x
+
+instance : algebra K (v.adic_completion K) :=
+@uniform_space.completion.algebra' K _ v.adic_valued.to_uniform_space _ _
+
+lemma algebra_map_adic_completion' :
+  ⇑(algebra_map R $ v.adic_completion K) = coe ∘ algebra_map R K :=
+rfl
+
+lemma algebra_map_adic_completion :
+  ⇑(algebra_map K $ v.adic_completion K) = coe :=
+rfl
+
+instance : is_scalar_tower R K (v.adic_completion K) :=
+@uniform_space.completion.is_scalar_tower R K K v.adic_valued.to_uniform_space _ _ _
+  (adic_valued.has_uniform_continuous_const_smul' R K v) _ _
+
+instance : algebra R (v.adic_completion_integers K) :=
+{ smul      := λ r x, ⟨r • (x : v.adic_completion K), begin
+    have h : ((algebra_map R (adic_completion K v)) r) = (coe $ algebra_map R K r) := rfl,
+    rw algebra.smul_def,
+    refine valuation_subring.mul_mem _ _ _ _ x.2,
+    rw [mem_adic_completion_integers, h, valued.valued_completion_apply],
+    exact v.valuation_le_one _,
+  end⟩,
+  to_fun    := λ r, ⟨coe $ algebra_map R K r, by simpa only [mem_adic_completion_integers,
+    valued.valued_completion_apply] using v.valuation_le_one _⟩,
+  map_one'  := by simp only [map_one]; refl,
+  map_mul'  := λ x y,
+  begin
+    ext,
+    simp_rw [ring_hom.map_mul, subring.coe_mul, subtype.coe_mk, uniform_space.completion.coe_mul],
+  end,
+  map_zero' := by simp only [map_zero]; refl,
+  map_add'  := λ x y,
+  begin
+    ext,
+    simp_rw [ring_hom.map_add, subring.coe_add, subtype.coe_mk, uniform_space.completion.coe_add],
+  end,
+  commutes' := λ r x, by rw mul_comm,
+  smul_def' := λ r x, begin
+    ext,
+    simp only [subring.coe_mul, set_like.coe_mk, algebra.smul_def],
+    refl,
+  end }
+
+@[simp] lemma coe_smul_adic_completion_integers (r : R) (x : v.adic_completion_integers K) :
+  (↑(r • x) : v.adic_completion K) = r • (x : v.adic_completion K) :=
+rfl
+
+instance : no_zero_smul_divisors R (v.adic_completion_integers K) :=
+{ eq_zero_or_eq_zero_of_smul_eq_zero := λ c x hcx,
+  begin
+    rw [algebra.smul_def, mul_eq_zero] at hcx,
+    refine hcx.imp_left (λ hc, _),
+    letI : uniform_space K := v.adic_valued.to_uniform_space,
+    rw ← map_zero (algebra_map R (v.adic_completion_integers K)) at hc,
+    exact (is_fraction_ring.injective R K
+      (uniform_space.completion.coe_injective K (subtype.ext_iff.mp hc)))
+  end }
+
+instance adic_completion.is_scalar_tower' :
+  is_scalar_tower R (v.adic_completion_integers K) (v.adic_completion K) :=
+{ smul_assoc := λ x y z, by {simp only [algebra.smul_def], apply mul_assoc, }}
+
+end algebra_instances
+
 end is_dedekind_domain.height_one_spectrum
diff --git a/src/ring_theory/dedekind_domain/basic.lean b/src/ring_theory/dedekind_domain/basic.lean
index b5c2442176aab..7a4715fa81baf 100644
--- a/src/ring_theory/dedekind_domain/basic.lean
+++ b/src/ring_theory/dedekind_domain/basic.lean
@@ -9,6 +9,9 @@ import ring_theory.polynomial.rational_root
 /-!
 # Dedekind domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the notion of a Dedekind domain (or Dedekind ring),
 as a Noetherian integrally closed commutative ring of Krull dimension at most one.
 
@@ -65,6 +68,17 @@ lemma dimension_le_one.integral_closure [nontrivial R] [is_domain A] [algebra R
   (h : dimension_le_one R) : dimension_le_one (integral_closure R A) :=
 h.is_integral_closure R A (integral_closure R A)
 
+variables {R}
+
+lemma dimension_le_one.not_lt_lt (h : ring.dimension_le_one R)
+  (p₀ p₁ p₂ : ideal R) [hp₁ : p₁.is_prime] [hp₂ : p₂.is_prime] :
+  ¬ (p₀ < p₁ ∧ p₁ < p₂)
+| ⟨h01, h12⟩ := h12.ne ((h p₁ (bot_le.trans_lt h01).ne' hp₁).eq_of_le hp₂.ne_top h12.le)
+
+lemma dimension_le_one.eq_bot_of_lt (h : ring.dimension_le_one R)
+  (p P : ideal R) [hp : p.is_prime] [hP : P.is_prime] (hpP : p < P) : p = ⊥ :=
+by_contra (λ hp0, h.not_lt_lt ⊥ p P ⟨ne.bot_lt hp0, hpP⟩)
+
 end ring
 
 variables [is_domain A]
diff --git a/src/ring_theory/dedekind_domain/dvr.lean b/src/ring_theory/dedekind_domain/dvr.lean
index 0943227432454..4e4592bbdea22 100644
--- a/src/ring_theory/dedekind_domain/dvr.lean
+++ b/src/ring_theory/dedekind_domain/dvr.lean
@@ -3,21 +3,31 @@ Copyright (c) 2020 Kenji Nakagawa. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenji Nakagawa, Anne Baanen, Filippo A. E. Nuccio
 -/
-import ring_theory.localization.at_prime
-import ring_theory.discrete_valuation_ring
+import ring_theory.localization.localization_localization
+import ring_theory.localization.submodule
+import ring_theory.discrete_valuation_ring.tfae
 
 /-!
 # Dedekind domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines an equivalent notion of a Dedekind domain (or Dedekind ring),
 namely a Noetherian integral domain where the localization at all nonzero prime ideals is a DVR
-(TODO: and shows that it is equivalent to the main definition).
+(TODO: and shows that implies the main definition).
 
 ## Main definitions
 
  - `is_dedekind_domain_dvr` alternatively defines a Dedekind domain as an integral domain that
    is Noetherian, and the localization at every nonzero prime ideal is a DVR.
 
+## Main results
+ - `is_localization.at_prime.discrete_valuation_ring_of_dedekind_domain` shows that
+   `is_dedekind_domain` implies the localization at each nonzero prime ideal is a DVR.
+ - `is_dedekind_domain.is_dedekind_domain_dvr` is one direction of the equivalence of definitions
+   of a Dedekind domain
+
 ## Implementation notes
 
 The definitions that involve a field of fractions choose a canonical field of fractions,
@@ -52,3 +62,94 @@ structure is_dedekind_domain_dvr : Prop :=
 (is_noetherian_ring : is_noetherian_ring A)
 (is_dvr_at_nonzero_prime : ∀ P ≠ (⊥ : ideal A), P.is_prime →
   discrete_valuation_ring (localization.at_prime P))
+
+/-- Localizing a domain of Krull dimension `≤ 1` gives another ring of Krull dimension `≤ 1`.
+
+Note that the same proof can/should be generalized to preserving any Krull dimension,
+once we have a suitable definition.
+-/
+lemma ring.dimension_le_one.localization {R : Type*} (Rₘ : Type*) [comm_ring R] [is_domain R]
+  [comm_ring Rₘ] [algebra R Rₘ] {M : submonoid R} [is_localization M Rₘ] (hM : M ≤ R⁰)
+  (h : ring.dimension_le_one R) : ring.dimension_le_one Rₘ :=
+begin
+  introsI p hp0 hpp,
+  refine ideal.is_maximal_def.mpr ⟨hpp.ne_top, ideal.maximal_of_no_maximal (λ P hpP hPm, _)⟩,
+  have hpP' : (⟨p, hpp⟩ : {p : ideal Rₘ // p.is_prime}) < ⟨P, hPm.is_prime⟩ := hpP,
+  rw ← (is_localization.order_iso_of_prime M Rₘ).lt_iff_lt at hpP',
+  haveI : ideal.is_prime (ideal.comap (algebra_map R Rₘ) p) :=
+    ((is_localization.order_iso_of_prime M Rₘ) ⟨p, hpp⟩).2.1,
+  haveI : ideal.is_prime (ideal.comap (algebra_map R Rₘ) P) :=
+    ((is_localization.order_iso_of_prime M Rₘ) ⟨P, hPm.is_prime⟩).2.1,
+  have hlt : ideal.comap (algebra_map R Rₘ) p < ideal.comap (algebra_map R Rₘ) P := hpP',
+  refine h.not_lt_lt ⊥ (ideal.comap _ _) (ideal.comap _ _) ⟨_, hpP'⟩,
+  exact is_localization.bot_lt_comap_prime _ _ hM _ hp0
+end
+
+/-- The localization of a Dedekind domain is a Dedekind domain. -/
+lemma is_localization.is_dedekind_domain [is_dedekind_domain A] {M : submonoid A} (hM : M ≤ A⁰)
+  (Aₘ : Type*) [comm_ring Aₘ] [is_domain Aₘ] [algebra A Aₘ]
+  [is_localization M Aₘ] : is_dedekind_domain Aₘ :=
+begin
+  have : ∀ (y : M), is_unit (algebra_map A (fraction_ring A) y),
+  { rintros ⟨y, hy⟩,
+    exact is_unit.mk0 _ (mt is_fraction_ring.to_map_eq_zero_iff.mp (non_zero_divisors.ne_zero
+      (hM hy))) },
+  letI : algebra Aₘ (fraction_ring A) := ring_hom.to_algebra (is_localization.lift this),
+  haveI : is_scalar_tower A Aₘ (fraction_ring A) := is_scalar_tower.of_algebra_map_eq
+    (λ x, (is_localization.lift_eq this x).symm),
+  haveI : is_fraction_ring Aₘ (fraction_ring A) :=
+    is_fraction_ring.is_fraction_ring_of_is_domain_of_is_localization M _ _,
+  refine (is_dedekind_domain_iff _ (fraction_ring A)).mpr ⟨_, _, _⟩,
+  { exact is_localization.is_noetherian_ring M _ (by apply_instance) },
+  { exact is_dedekind_domain.dimension_le_one.localization Aₘ hM },
+  { intros x hx,
+    obtain ⟨⟨y, y_mem⟩, hy⟩ := hx.exists_multiple_integral_of_is_localization M _,
+    obtain ⟨z, hz⟩ := (is_integrally_closed_iff _).mp is_dedekind_domain.is_integrally_closed hy,
+    refine ⟨is_localization.mk' Aₘ z ⟨y, y_mem⟩, (is_localization.lift_mk'_spec _ _ _ _).mpr _⟩,
+    rw [hz, set_like.coe_mk, ← algebra.smul_def],
+    refl },
+end
+
+/-- The localization of a Dedekind domain at every nonzero prime ideal is a Dedekind domain. -/
+lemma is_localization.at_prime.is_dedekind_domain [is_dedekind_domain A]
+  (P : ideal A) [P.is_prime] (Aₘ : Type*) [comm_ring Aₘ] [is_domain Aₘ] [algebra A Aₘ]
+  [is_localization.at_prime Aₘ P] : is_dedekind_domain Aₘ :=
+is_localization.is_dedekind_domain A P.prime_compl_le_non_zero_divisors Aₘ
+
+lemma is_localization.at_prime.not_is_field
+  {P : ideal A} (hP : P ≠ ⊥) [pP : P.is_prime]
+  (Aₘ : Type*) [comm_ring Aₘ] [algebra A Aₘ] [is_localization.at_prime Aₘ P] :
+  ¬ (is_field Aₘ) :=
+begin
+  intro h,
+  letI := h.to_field,
+  obtain ⟨x, x_mem, x_ne⟩ := P.ne_bot_iff.mp hP,
+  exact (local_ring.maximal_ideal.is_maximal _).ne_top (ideal.eq_top_of_is_unit_mem _
+    ((is_localization.at_prime.to_map_mem_maximal_iff Aₘ P _).mpr x_mem)
+    (is_unit_iff_ne_zero.mpr ((map_ne_zero_iff (algebra_map A Aₘ)
+      (is_localization.injective Aₘ P.prime_compl_le_non_zero_divisors)).mpr x_ne))),
+end
+
+/-- In a Dedekind domain, the localization at every nonzero prime ideal is a DVR. -/
+lemma is_localization.at_prime.discrete_valuation_ring_of_dedekind_domain [is_dedekind_domain A]
+  {P : ideal A} (hP : P ≠ ⊥) [pP : P.is_prime]
+  (Aₘ : Type*) [comm_ring Aₘ] [is_domain Aₘ] [algebra A Aₘ] [is_localization.at_prime Aₘ P] :
+  discrete_valuation_ring Aₘ :=
+begin
+  classical,
+  letI : is_noetherian_ring Aₘ := is_localization.is_noetherian_ring P.prime_compl _
+    is_dedekind_domain.is_noetherian_ring,
+  letI : local_ring Aₘ := is_localization.at_prime.local_ring Aₘ P,
+  have hnf := is_localization.at_prime.not_is_field A hP Aₘ,
+  exact ((discrete_valuation_ring.tfae Aₘ hnf).out 0 2).mpr
+    (is_localization.at_prime.is_dedekind_domain A P _)
+end
+
+/-- Dedekind domains, in the sense of Noetherian integrally closed domains of Krull dimension ≤ 1,
+are also Dedekind domains in the sense of Noetherian domains where the localization at every
+nonzero prime ideal is a DVR. -/
+theorem is_dedekind_domain.is_dedekind_domain_dvr [is_dedekind_domain A] :
+  is_dedekind_domain_dvr A :=
+{ is_noetherian_ring := is_dedekind_domain.is_noetherian_ring,
+  is_dvr_at_nonzero_prime := λ P hP pP, by exactI
+    is_localization.at_prime.discrete_valuation_ring_of_dedekind_domain A hP _ }
diff --git a/src/ring_theory/dedekind_domain/factorization.lean b/src/ring_theory/dedekind_domain/factorization.lean
new file mode 100644
index 0000000000000..ad23edb9a51f3
--- /dev/null
+++ b/src/ring_theory/dedekind_domain/factorization.lean
@@ -0,0 +1,188 @@
+/-
+Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: María Inés de Frutos-Fernández
+-/
+import ring_theory.dedekind_domain.ideal
+/-!
+# Factorization of ideals of Dedekind domains
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+Every nonzero ideal `I` of a Dedekind domain `R` can be factored as a product `∏_v v^{n_v}` over the
+maximal ideals of `R`, where the exponents `n_v` are natural numbers.
+TODO: Extend the results in this file to fractional ideals of `R`.
+## Main results
+- `ideal.finite_factors` : Only finitely many maximal ideals of `R` divide a given nonzero ideal.
+- `ideal.finprod_height_one_spectrum_factorization` : The ideal `I` equals the finprod
+  `∏_v v^(val_v(I))`,where `val_v(I)` denotes the multiplicity of `v` in the factorization of `I`
+  and `v` runs over the maximal ideals of `R`.
+## Tags
+dedekind domain, ideal, factorization
+-/
+
+noncomputable theory
+open_locale big_operators classical non_zero_divisors
+
+open set function unique_factorization_monoid is_dedekind_domain
+  is_dedekind_domain.height_one_spectrum
+
+/-! ### Factorization of ideals of Dedekind domains -/
+
+variables {R : Type*} [comm_ring R] [is_domain R] [is_dedekind_domain R] {K : Type*} [field K]
+  [algebra R K] [is_fraction_ring R K] (v : height_one_spectrum R)
+
+/-- Given a maximal ideal `v` and an ideal `I` of `R`, `max_pow_dividing` returns the maximal
+  power of `v` dividing `I`. -/
+def is_dedekind_domain.height_one_spectrum.max_pow_dividing (I : ideal R) : ideal R :=
+v.as_ideal^(associates.mk v.as_ideal).count (associates.mk I).factors
+
+/-- Only finitely many maximal ideals of `R` divide a given nonzero ideal. -/
+lemma ideal.finite_factors {I : ideal R} (hI : I ≠ 0) :
+  {v : height_one_spectrum R | v.as_ideal ∣ I}.finite :=
+begin
+  rw [← set.finite_coe_iff, set.coe_set_of],
+  haveI h_fin := fintype_subtype_dvd I hI,
+  refine finite.of_injective (λ v, (⟨(v : height_one_spectrum R).as_ideal, v.2⟩ : {x // x ∣ I})) _,
+  intros v w hvw,
+  simp only at hvw,
+  exact subtype.coe_injective ((height_one_spectrum.ext_iff ↑v ↑w).mpr hvw)
+end
+
+/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that the
+  multiplicity of `v` in the factorization of `I`, denoted `val_v(I)`, is nonzero. -/
+lemma associates.finite_factors {I : ideal R} (hI : I ≠ 0) :
+  ∀ᶠ (v : height_one_spectrum R) in filter.cofinite,
+    ((associates.mk v.as_ideal).count (associates.mk I).factors : ℤ) = 0 :=
+begin
+  have h_supp : {v : height_one_spectrum R |
+    ¬((associates.mk v.as_ideal).count (associates.mk I).factors : ℤ) = 0} =
+    {v : height_one_spectrum R | v.as_ideal ∣ I},
+  { ext v,
+    simp_rw int.coe_nat_eq_zero,
+    exact associates.count_ne_zero_iff_dvd hI v.irreducible, },
+  rw [filter.eventually_cofinite, h_supp],
+  exact ideal.finite_factors hI,
+end
+
+namespace ideal
+
+/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that
+  `v^(val_v(I))` is not the unit ideal. -/
+lemma finite_mul_support {I : ideal R} (hI : I ≠ 0) :
+  (mul_support (λ (v : height_one_spectrum R), v.max_pow_dividing I)).finite :=
+begin
+  have h_subset : {v : height_one_spectrum R | v.max_pow_dividing I ≠ 1} ⊆
+    {v : height_one_spectrum R |
+      ((associates.mk v.as_ideal).count (associates.mk I).factors : ℤ) ≠ 0},
+  { intros v hv h_zero,
+    have hv' : v.max_pow_dividing I = 1,
+    { rw [is_dedekind_domain.height_one_spectrum.max_pow_dividing, int.coe_nat_eq_zero.mp h_zero,
+        pow_zero _] },
+    exact hv hv', },
+  exact finite.subset (filter.eventually_cofinite.mp (associates.finite_factors hI)) h_subset,
+end
+
+/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that
+`v^(val_v(I))`, regarded as a fractional ideal, is not `(1)`. -/
+lemma finite_mul_support_coe {I : ideal R} (hI : I ≠ 0) :
+  (mul_support (λ (v : height_one_spectrum R),
+    (v.as_ideal : fractional_ideal R⁰ K) ^
+      ((associates.mk v.as_ideal).count (associates.mk I).factors : ℤ))).finite :=
+begin
+  rw mul_support,
+  simp_rw [ne.def, zpow_coe_nat, ← fractional_ideal.coe_ideal_pow,
+    fractional_ideal.coe_ideal_eq_one],
+  exact finite_mul_support hI,
+end
+
+/-- For every nonzero ideal `I` of `v`, there are finitely many maximal ideals `v` such that
+`v^-(val_v(I))` is not the unit ideal. -/
+lemma finite_mul_support_inv {I : ideal R} (hI : I ≠ 0) :
+  (mul_support (λ (v : height_one_spectrum R),
+    (v.as_ideal : fractional_ideal R⁰ K) ^
+      -((associates.mk v.as_ideal).count (associates.mk I).factors : ℤ))).finite :=
+begin
+  rw mul_support,
+  simp_rw [zpow_neg, ne.def, inv_eq_one],
+  exact finite_mul_support_coe hI,
+end
+
+/-- For every nonzero ideal `I` of `v`, `v^(val_v(I) + 1)` does not divide `∏_v v^(val_v(I))`. -/
+lemma finprod_not_dvd (I : ideal R) (hI : I ≠ 0) :
+  ¬ (v.as_ideal) ^ ((associates.mk v.as_ideal).count (associates.mk I).factors + 1) ∣
+      (∏ᶠ (v : height_one_spectrum R), v.max_pow_dividing I) :=
+begin
+  have hf := finite_mul_support hI,
+  have h_ne_zero : v.max_pow_dividing I ≠ 0 := pow_ne_zero _ v.ne_bot,
+  rw [← mul_finprod_cond_ne v hf, pow_add, pow_one, finprod_cond_ne _ _ hf],
+  intro h_contr,
+  have hv_prime : prime v.as_ideal := ideal.prime_of_is_prime v.ne_bot v.is_prime,
+  obtain ⟨w, hw, hvw'⟩ :=
+    prime.exists_mem_finset_dvd hv_prime ((mul_dvd_mul_iff_left h_ne_zero).mp h_contr),
+  have hw_prime : prime w.as_ideal := ideal.prime_of_is_prime w.ne_bot w.is_prime,
+  have hvw := prime.dvd_of_dvd_pow hv_prime hvw',
+  rw [prime.dvd_prime_iff_associated hv_prime hw_prime, associated_iff_eq] at hvw,
+  exact (finset.mem_erase.mp hw).1 (height_one_spectrum.ext w v (eq.symm hvw)),
+end
+
+end ideal
+
+lemma associates.finprod_ne_zero (I : ideal R) :
+  associates.mk (∏ᶠ (v : height_one_spectrum R), v.max_pow_dividing I) ≠ 0 :=
+begin
+  rw [associates.mk_ne_zero, finprod_def],
+  split_ifs,
+  { rw finset.prod_ne_zero_iff,
+    intros v hv,
+    apply pow_ne_zero _ v.ne_bot, },
+  { exact one_ne_zero, }
+end
+
+namespace ideal
+
+/-- The multiplicity of `v` in `∏_v v^(val_v(I))` equals `val_v(I)`. -/
+lemma finprod_count (I : ideal R) (hI : I ≠ 0) : (associates.mk v.as_ideal).count
+  (associates.mk (∏ᶠ (v : height_one_spectrum R), v.max_pow_dividing I)).factors =
+  (associates.mk v.as_ideal).count (associates.mk I).factors :=
+begin
+  have h_ne_zero := associates.finprod_ne_zero I,
+  have hv : irreducible (associates.mk v.as_ideal) := v.associates_irreducible,
+  have h_dvd := finprod_mem_dvd v (ideal.finite_mul_support hI),
+  have h_not_dvd := ideal.finprod_not_dvd v I hI,
+  simp only [is_dedekind_domain.height_one_spectrum.max_pow_dividing] at h_dvd h_ne_zero h_not_dvd,
+  rw [← associates.mk_dvd_mk, associates.dvd_eq_le, associates.mk_pow,
+    associates.prime_pow_dvd_iff_le h_ne_zero hv] at h_dvd h_not_dvd,
+  rw not_le at h_not_dvd,
+  apply nat.eq_of_le_of_lt_succ h_dvd h_not_dvd,
+end
+
+/-- The ideal `I` equals the finprod `∏_v v^(val_v(I))`. -/
+lemma finprod_height_one_spectrum_factorization (I : ideal R) (hI : I ≠ 0) :
+  ∏ᶠ (v : height_one_spectrum R), v.max_pow_dividing I = I :=
+begin
+  rw [← associated_iff_eq, ← associates.mk_eq_mk_iff_associated],
+  apply associates.eq_of_eq_counts,
+  { apply associates.finprod_ne_zero I },
+  { apply associates.mk_ne_zero.mpr hI },
+  intros v hv,
+  obtain ⟨J, hJv⟩ := associates.exists_rep v,
+  rw [← hJv, associates.irreducible_mk] at hv,
+  rw ← hJv,
+  apply ideal.finprod_count ⟨J, ideal.is_prime_of_prime (irreducible_iff_prime.mp hv),
+    irreducible.ne_zero hv⟩ I hI,
+end
+
+/-- The ideal `I` equals the finprod `∏_v v^(val_v(I))`, when both sides are regarded as fractional
+ideals of `R`. -/
+lemma finprod_height_one_spectrum_factorization_coe (I : ideal R) (hI : I ≠ 0) :
+  ∏ᶠ (v : height_one_spectrum R), (v.as_ideal : fractional_ideal R⁰ K) ^
+    ((associates.mk v.as_ideal).count (associates.mk I).factors : ℤ) = I :=
+begin
+  conv_rhs { rw ← ideal.finprod_height_one_spectrum_factorization I hI },
+  rw fractional_ideal.coe_ideal_finprod R⁰ K (le_refl _),
+  simp_rw [is_dedekind_domain.height_one_spectrum.max_pow_dividing, fractional_ideal.coe_ideal_pow,
+    zpow_coe_nat],
+end
+
+end ideal
diff --git a/src/ring_theory/dedekind_domain/finite_adele_ring.lean b/src/ring_theory/dedekind_domain/finite_adele_ring.lean
new file mode 100644
index 0000000000000..78cf47915dd32
--- /dev/null
+++ b/src/ring_theory/dedekind_domain/finite_adele_ring.lean
@@ -0,0 +1,230 @@
+/-
+Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: María Inés de Frutos-Fernández
+-/
+import ring_theory.dedekind_domain.adic_valuation
+
+
+/-!
+# The finite adèle ring of a Dedekind domain
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+We define the ring of finite adèles of a Dedekind domain `R`.
+
+## Main definitions
+- `dedekind_domain.finite_integral_adeles` : product of `adic_completion_integers`, where `v`
+  runs over all maximal ideals of `R`.
+- `dedekind_domain.prod_adic_completions` : the product of `adic_completion`, where `v` runs over
+  all maximal ideals of `R`.
+- `dedekind_domain.finite_adele_ring` : The finite adèle ring of `R`, defined as the
+  restricted product `Π'_v K_v`.
+
+## Implementation notes
+We are only interested on Dedekind domains of Krull dimension 1 (i.e., not fields). If `R` is a
+field, its finite adèle ring is just defined to be the trivial ring.
+
+## References
+* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]
+
+## Tags
+finite adèle ring, dedekind domain
+-/
+
+noncomputable theory
+open function set is_dedekind_domain is_dedekind_domain.height_one_spectrum
+
+namespace dedekind_domain
+
+variables (R K : Type*) [comm_ring R] [is_domain R] [is_dedekind_domain R] [field K]
+  [algebra R K] [is_fraction_ring R K] (v : height_one_spectrum R)
+
+/-- The product of all `adic_completion_integers`, where `v` runs over the maximal ideals of `R`. -/
+@[derive [comm_ring, topological_space, inhabited]]
+def finite_integral_adeles : Type* := Π (v : height_one_spectrum R), v.adic_completion_integers K
+
+local notation `R_hat` := finite_integral_adeles
+
+/-- The product of all `adic_completion`, where `v` runs over the maximal ideals of `R`. -/
+@[derive [non_unital_non_assoc_ring, topological_space, topological_ring, comm_ring, inhabited]]
+def prod_adic_completions := Π (v : height_one_spectrum R), v.adic_completion K
+
+local notation `K_hat` := prod_adic_completions
+
+namespace finite_integral_adeles
+
+noncomputable! instance : has_coe (R_hat R K) (K_hat R K) := { coe := λ x v, x v }
+
+lemma coe_apply (x : R_hat R K) (v : height_one_spectrum R) : (x : K_hat R K) v = ↑(x v) := rfl
+
+/-- The inclusion of `R_hat` in `K_hat` as a homomorphism of additive monoids. -/
+@[simps] def coe.add_monoid_hom : add_monoid_hom (R_hat R K) (K_hat R K) :=
+{ to_fun    := coe,
+  map_zero' := rfl,
+  map_add'  := λ x y, by { ext v, simp only [coe_apply, pi.add_apply, subring.coe_add] }}
+
+/-- The inclusion of `R_hat` in `K_hat` as a ring homomorphism. -/
+@[simps] def coe.ring_hom : ring_hom (R_hat R K) (K_hat R K)  :=
+{ to_fun   := coe,
+  map_one' := rfl,
+  map_mul' := λ x y, by {ext p, simp only [pi.mul_apply, subring.coe_mul], refl },
+  ..coe.add_monoid_hom R K }
+
+end finite_integral_adeles
+
+section algebra_instances
+
+instance : algebra K (K_hat R K) :=
+(by apply_instance : algebra K $ Π v : height_one_spectrum R, v.adic_completion K)
+
+instance prod_adic_completions.algebra' : algebra R (K_hat R K) :=
+(by apply_instance : algebra R $ Π v : height_one_spectrum R, v.adic_completion K)
+
+instance : is_scalar_tower R K (K_hat R K) :=
+(by apply_instance : is_scalar_tower R K $ Π v : height_one_spectrum R, v.adic_completion K)
+
+instance : algebra R (R_hat R K) :=
+(by apply_instance : algebra R $ Π v : height_one_spectrum R, v.adic_completion_integers K)
+
+instance prod_adic_completions.algebra_completions : algebra (R_hat R K) (K_hat R K) :=
+(finite_integral_adeles.coe.ring_hom R K).to_algebra
+
+instance prod_adic_completions.is_scalar_tower_completions :
+  is_scalar_tower R (R_hat R K) (K_hat R K) :=
+(by apply_instance : is_scalar_tower R (Π v : height_one_spectrum R, v.adic_completion_integers K) $
+  Π v : height_one_spectrum R, v.adic_completion K)
+
+end algebra_instances
+
+namespace finite_integral_adeles
+
+/-- The inclusion of `R_hat` in `K_hat` as an algebra homomorphism. -/
+def coe.alg_hom : alg_hom R (R_hat R K) (K_hat R K)  :=
+{ to_fun    := coe,
+  commutes' := λ r, rfl,
+  ..coe.ring_hom R K  }
+
+lemma coe.alg_hom_apply (x : R_hat R K) (v : height_one_spectrum R) :
+  (coe.alg_hom R K) x v = x v := rfl
+
+end finite_integral_adeles
+
+/-! ### The finite adèle ring of a Dedekind domain
+We define the finite adèle ring of `R` as the restricted product over all maximal ideals `v` of `R`
+of `adic_completion` with respect to `adic_completion_integers`. We prove that it is a commutative
+ring. TODO: show that it is a topological ring with the restricted product topology. -/
+
+namespace prod_adic_completions
+
+variables {R K}
+
+/-- An element `x : K_hat R K` is a finite adèle if for all but finitely many height one ideals
+  `v`, the component `x v` is a `v`-adic integer. -/
+def is_finite_adele (x : K_hat R K) :=
+∀ᶠ v : height_one_spectrum R in filter.cofinite, x v ∈ v.adic_completion_integers K
+
+namespace is_finite_adele
+
+/-- The sum of two finite adèles is a finite adèle. -/
+lemma add {x y : K_hat R K} (hx : x.is_finite_adele) (hy : y.is_finite_adele) :
+  (x + y).is_finite_adele :=
+begin
+  rw [is_finite_adele, filter.eventually_cofinite] at hx hy ⊢,
+  have h_subset : {v : height_one_spectrum R | ¬ (x + y) v ∈  (v.adic_completion_integers K)} ⊆
+    {v : height_one_spectrum R | ¬ x v ∈ (v.adic_completion_integers K)} ∪
+    {v : height_one_spectrum R | ¬ y v ∈ (v.adic_completion_integers K)},
+  { intros v hv,
+    rw [mem_union, mem_set_of_eq, mem_set_of_eq],
+    rw mem_set_of_eq at hv,
+    contrapose! hv,
+    rw [mem_adic_completion_integers, mem_adic_completion_integers, ← max_le_iff] at hv,
+    rw [mem_adic_completion_integers, pi.add_apply],
+    exact le_trans (valued.v.map_add_le_max' (x v) (y v)) hv },
+  exact (hx.union hy).subset h_subset,
+end
+
+/-- The tuple `(0)_v` is a finite adèle. -/
+lemma zero : (0 : K_hat R K).is_finite_adele :=
+begin
+  rw [is_finite_adele, filter.eventually_cofinite],
+  have h_empty : {v : height_one_spectrum R |
+    ¬ ((0 : v.adic_completion K) ∈ v.adic_completion_integers K)} = ∅,
+  { ext v, rw [mem_empty_iff_false, iff_false], intro hv,
+    rw mem_set_of_eq at hv, apply hv, rw mem_adic_completion_integers,
+    have h_zero : (valued.v (0 : v.adic_completion K) : (with_zero(multiplicative ℤ))) = 0 :=
+    valued.v.map_zero',
+    rw h_zero, exact zero_le_one' _ },
+  simp_rw [pi.zero_apply, h_empty],
+  exact finite_empty,
+end
+
+/-- The negative of a finite adèle is a finite adèle. -/
+lemma neg {x : K_hat R K} (hx : x.is_finite_adele) : (-x).is_finite_adele  :=
+begin
+  rw is_finite_adele at hx ⊢,
+  have h : ∀ (v : height_one_spectrum R), (-x v ∈ v.adic_completion_integers K) ↔
+    (x v ∈ v.adic_completion_integers K),
+  { intro v,
+    rw [mem_adic_completion_integers, mem_adic_completion_integers, valuation.map_neg], },
+  simpa only [pi.neg_apply, h] using hx,
+end
+
+/-- The product of two finite adèles is a finite adèle. -/
+lemma mul {x y : K_hat R K} (hx : x.is_finite_adele) (hy : y.is_finite_adele) :
+  (x * y).is_finite_adele :=
+begin
+  rw [is_finite_adele, filter.eventually_cofinite] at hx hy ⊢,
+  have h_subset : {v : height_one_spectrum R | ¬ (x * y) v ∈  (v.adic_completion_integers K)} ⊆
+    {v : height_one_spectrum R | ¬ x v ∈ (v.adic_completion_integers K)} ∪
+    {v : height_one_spectrum R | ¬ y v ∈ (v.adic_completion_integers K)},
+  { intros v hv,
+    rw [mem_union, mem_set_of_eq, mem_set_of_eq],
+    rw mem_set_of_eq at hv,
+    contrapose! hv,
+    rw [mem_adic_completion_integers, mem_adic_completion_integers] at hv,
+    have h_mul : valued.v (x v * y v) = (valued.v (x v)) * (valued.v (y v)) :=
+      (valued.v).map_mul' (x v) (y v),
+    rw [mem_adic_completion_integers, pi.mul_apply, h_mul],
+    exact @mul_le_one' (with_zero (multiplicative ℤ)) _ _
+      (ordered_comm_monoid.to_covariant_class_left _) _ _ hv.left hv.right  },
+  exact (hx.union hy).subset h_subset,
+end
+
+/-- The tuple `(1)_v` is a finite adèle. -/
+lemma one : (1 : K_hat R K).is_finite_adele :=
+begin
+  rw [is_finite_adele, filter.eventually_cofinite],
+  have h_empty : {v : height_one_spectrum R |
+    ¬ ((1 : v.adic_completion K) ∈ v.adic_completion_integers K)} = ∅,
+  { ext v, rw [mem_empty_iff_false, iff_false], intro hv,
+    rw mem_set_of_eq at hv, apply hv, rw mem_adic_completion_integers,
+    exact le_of_eq valued.v.map_one' },
+  simp_rw [pi.one_apply, h_empty],
+  exact finite_empty,
+end
+
+end is_finite_adele
+
+end prod_adic_completions
+
+open prod_adic_completions.is_finite_adele
+
+variables (R K)
+/-- The finite adèle ring of `R` is the restricted product over all maximal ideals `v` of `R`
+of `adic_completion` with respect to `adic_completion_integers`. -/
+noncomputable! def finite_adele_ring : subring (K_hat R K) :=
+{ carrier   := { x : K_hat R K | x.is_finite_adele },
+  mul_mem'  := λ _ _ hx hy, mul hx hy,
+  one_mem'  := one,
+  add_mem'  := λ _ _ hx hy, add hx hy,
+  zero_mem' := zero,
+  neg_mem'  := λ _ hx, neg hx, }
+
+variables {R K}
+
+@[simp] lemma mem_finite_adele_ring_iff (x : K_hat R K) :
+  x ∈ finite_adele_ring R K ↔ x.is_finite_adele :=
+iff.rfl
+
+end dedekind_domain
diff --git a/src/ring_theory/dedekind_domain/ideal.lean b/src/ring_theory/dedekind_domain/ideal.lean
index 464db3d00ec61..be1aed2e252fd 100644
--- a/src/ring_theory/dedekind_domain/ideal.lean
+++ b/src/ring_theory/dedekind_domain/ideal.lean
@@ -4,13 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenji Nakagawa, Anne Baanen, Filippo A. E. Nuccio
 -/
 import algebra.algebra.subalgebra.pointwise
+import algebraic_geometry.prime_spectrum.maximal
 import algebraic_geometry.prime_spectrum.noetherian
+import order.hom.basic
 import ring_theory.dedekind_domain.basic
 import ring_theory.fractional_ideal
+import ring_theory.principal_ideal_domain
+import ring_theory.chain_of_divisors
 
 /-!
 # Dedekind domains and ideals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we show a ring is a Dedekind domain iff all fractional ideals are invertible.
 Then we prove some results on the unique factorization monoid structure of the ideals.
 
@@ -62,11 +69,10 @@ noncomputable instance : has_inv (fractional_ideal R₁⁰ K) := ⟨λ I, 1 / I
 
 lemma inv_eq : I⁻¹ = 1 / I := rfl
 
-lemma inv_zero' : (0 : fractional_ideal R₁⁰ K)⁻¹ = 0 := fractional_ideal.div_zero
+lemma inv_zero' : (0 : fractional_ideal R₁⁰ K)⁻¹ = 0 := div_zero
 
 lemma inv_nonzero {J : fractional_ideal R₁⁰ K} (h : J ≠ 0) :
-J⁻¹ = ⟨(1 : fractional_ideal R₁⁰ K) / J, fractional_ideal.fractional_div_of_nonzero h⟩ :=
-fractional_ideal.div_nonzero _
+J⁻¹ = ⟨(1 : fractional_ideal R₁⁰ K) / J, fractional_div_of_nonzero h⟩ := div_nonzero _
 
 lemma coe_inv_of_nonzero {J : fractional_ideal R₁⁰ K} (h : J ≠ 0) :
   (↑J⁻¹ : submodule R₁ K) = is_localization.coe_submodule K ⊤ / J :=
@@ -74,85 +80,104 @@ by { rwa inv_nonzero _, refl, assumption }
 
 variables {K}
 
-lemma mem_inv_iff (hI : I ≠ 0) {x : K} :
-  x ∈ I⁻¹ ↔ ∀ y ∈ I, x * y ∈ (1 : fractional_ideal R₁⁰ K) :=
-fractional_ideal.mem_div_iff_of_nonzero hI
+lemma mem_inv_iff (hI : I ≠ 0) {x : K} : x ∈ I⁻¹ ↔ ∀ y ∈ I, x * y ∈ (1 : fractional_ideal R₁⁰ K) :=
+mem_div_iff_of_nonzero hI
 
-lemma inv_anti_mono (hI : I ≠ 0) (hJ : J ≠ 0) (hIJ : I ≤ J) :
-  J⁻¹ ≤ I⁻¹ :=
+lemma inv_anti_mono (hI : I ≠ 0) (hJ : J ≠ 0) (hIJ : I ≤ J) : J⁻¹ ≤ I⁻¹ :=
 λ x, by { simp only [mem_inv_iff hI, mem_inv_iff hJ], exact λ h y hy, h y (hIJ hy) }
 
 lemma le_self_mul_inv {I : fractional_ideal R₁⁰ K} (hI : I ≤ (1 : fractional_ideal R₁⁰ K)) :
   I ≤ I * I⁻¹ :=
-fractional_ideal.le_self_mul_one_div hI
+le_self_mul_one_div hI
 
 variables (K)
 
-lemma coe_ideal_le_self_mul_inv (I : ideal R₁) :
-  (I : fractional_ideal R₁⁰ K) ≤ I * I⁻¹ :=
-le_self_mul_inv fractional_ideal.coe_ideal_le_one
+lemma coe_ideal_le_self_mul_inv (I : ideal R₁) : (I : fractional_ideal R₁⁰ K) ≤ I * I⁻¹ :=
+le_self_mul_inv coe_ideal_le_one
 
 /-- `I⁻¹` is the inverse of `I` if `I` has an inverse. -/
-theorem right_inverse_eq (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) :
-  J = I⁻¹ :=
+theorem right_inverse_eq (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) : J = I⁻¹ :=
 begin
-  have hI : I ≠ 0 := fractional_ideal.ne_zero_of_mul_eq_one I J h,
+  have hI : I ≠ 0 := ne_zero_of_mul_eq_one I J h,
   suffices h' : I * (1 / I) = 1,
   { exact (congr_arg units.inv $
       @units.ext _ _ (units.mk_of_mul_eq_one _ _ h) (units.mk_of_mul_eq_one _ _ h') rfl) },
   apply le_antisymm,
-  { apply fractional_ideal.mul_le.mpr _,
+  { apply mul_le.mpr _,
     intros x hx y hy,
     rw mul_comm,
-    exact (fractional_ideal.mem_div_iff_of_nonzero hI).mp hy x hx },
+    exact (mem_div_iff_of_nonzero hI).mp hy x hx },
   rw ← h,
-  apply fractional_ideal.mul_left_mono I,
-  apply (fractional_ideal.le_div_iff_of_nonzero hI).mpr _,
+  apply mul_left_mono I,
+  apply (le_div_iff_of_nonzero hI).mpr _,
   intros y hy x hx,
   rw mul_comm,
-  exact fractional_ideal.mul_mem_mul hx hy
+  exact mul_mem_mul hx hy
 end
 
-theorem mul_inv_cancel_iff {I : fractional_ideal R₁⁰ K} :
-  I * I⁻¹ = 1 ↔ ∃ J, I * J = 1 :=
+theorem mul_inv_cancel_iff {I : fractional_ideal R₁⁰ K} : I * I⁻¹ = 1 ↔ ∃ J, I * J = 1 :=
 ⟨λ h, ⟨I⁻¹, h⟩, λ ⟨J, hJ⟩, by rwa ← right_inverse_eq K I J hJ⟩
 
-lemma mul_inv_cancel_iff_is_unit {I : fractional_ideal R₁⁰ K} :
-  I * I⁻¹ = 1 ↔ is_unit I :=
+lemma mul_inv_cancel_iff_is_unit {I : fractional_ideal R₁⁰ K} : I * I⁻¹ = 1 ↔ is_unit I :=
 (mul_inv_cancel_iff K).trans is_unit_iff_exists_inv.symm
 
 variables {K' : Type*} [field K'] [algebra R₁ K'] [is_fraction_ring R₁ K']
 
 @[simp] lemma map_inv (I : fractional_ideal R₁⁰ K) (h : K ≃ₐ[R₁] K') :
   (I⁻¹).map (h : K →ₐ[R₁] K') = (I.map h)⁻¹ :=
-by rw [inv_eq, fractional_ideal.map_div, fractional_ideal.map_one, inv_eq]
+by rw [inv_eq, map_div, map_one, inv_eq]
 
 open submodule submodule.is_principal
 
-@[simp] lemma span_singleton_inv (x : K) :
-  (fractional_ideal.span_singleton R₁⁰ x)⁻¹ = fractional_ideal.span_singleton _ (x⁻¹) :=
-fractional_ideal.one_div_span_singleton x
+@[simp] lemma span_singleton_inv (x : K) : (span_singleton R₁⁰ x)⁻¹ = span_singleton _ x⁻¹ :=
+one_div_span_singleton x
+
+@[simp] lemma span_singleton_div_span_singleton (x y : K) :
+  span_singleton R₁⁰ x / span_singleton R₁⁰ y = span_singleton R₁⁰ (x / y) :=
+by rw [div_span_singleton, mul_comm, span_singleton_mul_span_singleton, div_eq_mul_inv]
+
+lemma span_singleton_div_self {x : K} (hx : x ≠ 0) :
+  span_singleton R₁⁰ x / span_singleton R₁⁰ x = 1 :=
+by rw [span_singleton_div_span_singleton, div_self hx, span_singleton_one]
+
+lemma coe_ideal_span_singleton_div_self {x : R₁} (hx : x ≠ 0) :
+  (ideal.span ({x} : set R₁) : fractional_ideal R₁⁰ K) / ideal.span ({x} : set R₁) = 1 :=
+by rw [coe_ideal_span_singleton, span_singleton_div_self K $
+        (map_ne_zero_iff _ $ no_zero_smul_divisors.algebra_map_injective R₁ K).mpr hx]
+
+lemma span_singleton_mul_inv {x : K} (hx : x ≠ 0) :
+  span_singleton R₁⁰ x * (span_singleton R₁⁰ x)⁻¹ = 1 :=
+by rw [span_singleton_inv, span_singleton_mul_span_singleton, mul_inv_cancel hx, span_singleton_one]
+
+lemma coe_ideal_span_singleton_mul_inv {x : R₁} (hx : x ≠ 0) :
+  (ideal.span ({x} : set R₁) : fractional_ideal R₁⁰ K) * (ideal.span ({x} : set R₁))⁻¹ = 1 :=
+by rw [coe_ideal_span_singleton, span_singleton_mul_inv K $
+        (map_ne_zero_iff _ $ no_zero_smul_divisors.algebra_map_injective R₁ K).mpr hx]
+
+lemma span_singleton_inv_mul {x : K} (hx : x ≠ 0) :
+  (span_singleton R₁⁰ x)⁻¹ * span_singleton R₁⁰ x = 1 :=
+by rw [mul_comm, span_singleton_mul_inv K hx]
+
+lemma coe_ideal_span_singleton_inv_mul {x : R₁} (hx : x ≠ 0) :
+  (ideal.span ({x} : set R₁) : fractional_ideal R₁⁰ K)⁻¹ * ideal.span ({x} : set R₁) = 1 :=
+by rw [mul_comm, coe_ideal_span_singleton_mul_inv K hx]
 
 lemma mul_generator_self_inv {R₁ : Type*} [comm_ring R₁] [algebra R₁ K] [is_localization R₁⁰ K]
   (I : fractional_ideal R₁⁰ K) [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
-  I * fractional_ideal.span_singleton _ (generator (I : submodule R₁ K))⁻¹ = 1 :=
+  I * span_singleton _ (generator (I : submodule R₁ K))⁻¹ = 1 :=
 begin
   -- Rewrite only the `I` that appears alone.
-  conv_lhs { congr, rw fractional_ideal.eq_span_singleton_of_principal I },
-  rw [fractional_ideal.span_singleton_mul_span_singleton, mul_inv_cancel,
-    fractional_ideal.span_singleton_one],
+  conv_lhs { congr, rw eq_span_singleton_of_principal I },
+  rw [span_singleton_mul_span_singleton, mul_inv_cancel, span_singleton_one],
   intro generator_I_eq_zero,
   apply h,
-  rw [fractional_ideal.eq_span_singleton_of_principal I, generator_I_eq_zero,
-    fractional_ideal.span_singleton_zero]
+  rw [eq_span_singleton_of_principal I, generator_I_eq_zero, span_singleton_zero]
 end
 
 lemma invertible_of_principal (I : fractional_ideal R₁⁰ K)
-  [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
-  I * I⁻¹ = 1 :=
-(fractional_ideal.mul_div_self_cancel_iff).mpr
-  ⟨fractional_ideal.span_singleton _ (generator (I : submodule R₁ K))⁻¹,
-    mul_generator_self_inv _ I h⟩
+  [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) : I * I⁻¹ = 1 :=
+(mul_div_self_cancel_iff).mpr
+  ⟨span_singleton _ (generator (I : submodule R₁ K))⁻¹, mul_generator_self_inv _ I h⟩
 
 lemma invertible_iff_generator_nonzero (I : fractional_ideal R₁⁰ K)
   [submodule.is_principal (I : submodule R₁ K)] :
@@ -160,15 +185,14 @@ lemma invertible_iff_generator_nonzero (I : fractional_ideal R₁⁰ K)
 begin
   split,
   { intros hI hg,
-    apply fractional_ideal.ne_zero_of_mul_eq_one _ _ hI,
-    rw [fractional_ideal.eq_span_singleton_of_principal I, hg,
-        fractional_ideal.span_singleton_zero] },
+    apply ne_zero_of_mul_eq_one _ _ hI,
+    rw [eq_span_singleton_of_principal I, hg, span_singleton_zero] },
   { intro hg,
     apply invertible_of_principal,
-    rw [fractional_ideal.eq_span_singleton_of_principal I],
+    rw [eq_span_singleton_of_principal I],
     intro hI,
-    have := fractional_ideal.mem_span_singleton_self _ (generator (I : submodule R₁ K)),
-    rw [hI, fractional_ideal.mem_zero_iff] at this,
+    have := mem_span_singleton_self _ (generator (I : submodule R₁ K)),
+    rw [hI, mem_zero_iff] at this,
     contradiction }
 end
 
@@ -176,16 +200,17 @@ lemma is_principal_inv (I : fractional_ideal R₁⁰ K)
   [submodule.is_principal (I : submodule R₁ K)] (h : I ≠ 0) :
   submodule.is_principal (I⁻¹).1 :=
 begin
-  rw [fractional_ideal.val_eq_coe, fractional_ideal.is_principal_iff],
+  rw [val_eq_coe, is_principal_iff],
   use (generator (I : submodule R₁ K))⁻¹,
-  have hI : I  * fractional_ideal.span_singleton _ ((generator (I : submodule R₁ K))⁻¹)  = 1,
+  have hI : I  * span_singleton _ ((generator (I : submodule R₁ K))⁻¹)  = 1,
   apply mul_generator_self_inv _ I h,
-  exact (right_inverse_eq _ I (fractional_ideal.span_singleton _
-    ((generator (I : submodule R₁ K))⁻¹)) hI).symm
+  exact (right_inverse_eq _ I (span_singleton _ ((generator (I : submodule R₁ K))⁻¹)) hI).symm
 end
 
-@[simp] lemma one_inv : (1⁻¹ : fractional_ideal R₁⁰ K) = 1 :=
-fractional_ideal.div_one
+noncomputable instance : inv_one_class (fractional_ideal R₁⁰ K) :=
+{ inv_one := div_one,
+  ..fractional_ideal.has_one,
+  ..fractional_ideal.has_inv K }
 
 end fractional_ideal
 
@@ -205,13 +230,12 @@ open fractional_ideal
 variables {R A K}
 
 lemma is_dedekind_domain_inv_iff [algebra A K] [is_fraction_ring A K] :
-  is_dedekind_domain_inv A ↔
-    (∀ I ≠ (⊥ : fractional_ideal A⁰ K), I * I⁻¹ = 1) :=
+  is_dedekind_domain_inv A ↔ (∀ I ≠ (⊥ : fractional_ideal A⁰ K), I * I⁻¹ = 1) :=
 begin
-  let h := fractional_ideal.map_equiv (fraction_ring.alg_equiv A K),
+  let h := map_equiv (fraction_ring.alg_equiv A K),
   refine h.to_equiv.forall_congr (λ I, _),
   rw ← h.to_equiv.apply_eq_iff_eq,
-  simp
+  simp [is_dedekind_domain_inv, show ⇑h.to_equiv = h, from rfl],
 end
 
 lemma fractional_ideal.adjoin_integral_eq_one_of_is_unit [algebra A K] [is_fraction_ring A K]
@@ -220,7 +244,7 @@ lemma fractional_ideal.adjoin_integral_eq_one_of_is_unit [algebra A K] [is_fract
 begin
   set I := adjoin_integral A⁰ x hx,
   have mul_self : I * I = I,
-  { apply fractional_ideal.coe_to_submodule_injective, simp },
+  { apply coe_to_submodule_injective, simp },
   convert congr_arg (* I⁻¹) mul_self;
   simp only [(mul_inv_cancel_iff_is_unit K).mpr hI, mul_assoc, mul_one],
 end
@@ -245,8 +269,7 @@ begin
   refine is_noetherian_ring_iff.mpr ⟨λ (I : ideal A), _⟩,
   by_cases hI : I = ⊥,
   { rw hI, apply submodule.fg_bot },
-  have hI : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
-    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr hI,
+  have hI : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 := coe_ideal_ne_zero.mpr hI,
   exact I.fg_of_is_unit (is_fraction_ring.injective A (fraction_ring A)) (h.is_unit hI)
 end
 
@@ -256,7 +279,7 @@ begin
   -- `A[x]` (which is a fractional ideal) is in fact equal to `A`.
   refine ⟨λ x hx, _⟩,
   rw [← set.mem_range, ← algebra.mem_bot, ← subalgebra.mem_to_submodule, algebra.to_submodule_bot,
-      ← coe_span_singleton A⁰ (1 : fraction_ring A), fractional_ideal.span_singleton_one,
+      ← coe_span_singleton A⁰ (1 : fraction_ring A), span_singleton_one,
       ← fractional_ideal.adjoin_integral_eq_one_of_is_unit x hx (h.is_unit _)],
   { exact mem_adjoin_integral_self A⁰ x hx },
   { exact λ h, one_ne_zero (eq_zero_iff.mp h 1 (subalgebra.one_mem _)) },
@@ -271,15 +294,13 @@ begin
   rintros P P_ne hP,
   refine ideal.is_maximal_def.mpr ⟨hP.ne_top, λ M hM, _⟩,
   -- We may assume `P` and `M` (as fractional ideals) are nonzero.
-  have P'_ne : (P : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
-    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr P_ne,
+  have P'_ne : (P : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 := coe_ideal_ne_zero.mpr P_ne,
   have M'_ne : (M : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
-    (coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr
-      (lt_of_le_of_lt bot_le hM).ne',
+    coe_ideal_ne_zero.mpr (lt_of_le_of_lt bot_le hM).ne',
 
   -- In particular, we'll show `M⁻¹ * P ≤ P`
   suffices : (M⁻¹ * P : fractional_ideal A⁰ (fraction_ring A)) ≤ P,
-  { rw [eq_top_iff, ← coe_ideal_le_coe_ideal (fraction_ring A), fractional_ideal.coe_ideal_top],
+  { rw [eq_top_iff, ← coe_ideal_le_coe_ideal (fraction_ring A), coe_ideal_top],
     calc (1 : fractional_ideal A⁰ (fraction_ring A)) = _ * _ * _ : _
     ... ≤ _ * _ : mul_right_mono (P⁻¹ * M : fractional_ideal A⁰ (fraction_ring A)) this
     ... = M : _,
@@ -291,13 +312,13 @@ begin
   intros x hx,
   have le_one : (M⁻¹ * P : fractional_ideal A⁰ (fraction_ring A)) ≤ 1,
   { rw [← h.inv_mul_eq_one M'_ne],
-    exact fractional_ideal.mul_left_mono _ ((coe_ideal_le_coe_ideal (fraction_ring A)).mpr hM.le) },
+    exact mul_left_mono _ ((coe_ideal_le_coe_ideal (fraction_ring A)).mpr hM.le) },
   obtain ⟨y, hy, rfl⟩ := (mem_coe_ideal _).mp (le_one hx),
 
   -- Since `M` is strictly greater than `P`, let `z ∈ M \ P`.
   obtain ⟨z, hzM, hzp⟩ := set_like.exists_of_lt hM,
   -- We have `z * y ∈ M * (M⁻¹ * P) = P`.
-  have zy_mem := fractional_ideal.mul_mem_mul (mem_coe_ideal_of_mem A⁰ hzM) hx,
+  have zy_mem := mul_mem_mul (mem_coe_ideal_of_mem A⁰ hzM) hx,
   rw [← ring_hom.map_mul, ← mul_assoc, h.mul_inv_eq_one M'_ne, one_mul] at zy_mem,
   obtain ⟨zy, hzy, zy_eq⟩ := (mem_coe_ideal A⁰).mp zy_mem,
   rw is_fraction_ring.injective A (fraction_ring A) zy_eq at hzy,
@@ -336,8 +357,8 @@ begin
   obtain ⟨_, hPZ', hPM⟩ := (hM.is_prime.multiset_prod_le (mt multiset.map_eq_zero.mp hZ0)).mp hZM,
   -- Then in fact there is a `P ∈ Z` with `P ≤ M`.
   obtain ⟨P, hPZ, rfl⟩ := multiset.mem_map.mp hPZ',
-  letI := classical.dec_eq (ideal A),
-  have := multiset.map_erase prime_spectrum.as_ideal subtype.coe_injective P Z,
+  classical,
+  have := multiset.map_erase prime_spectrum.as_ideal prime_spectrum.ext P Z,
   obtain ⟨hP0, hZP0⟩ : P.as_ideal ≠ ⊥ ∧ ((Z.erase P).map prime_spectrum.as_ideal).prod ≠ ⊥,
   { rwa [ne.def, ← multiset.cons_erase hPZ', multiset.prod_cons, ideal.mul_eq_bot,
          not_or_distrib, ← this] at hprodZ },
@@ -369,7 +390,7 @@ begin
     have hM0 := (M.bot_lt_of_maximal hNF).ne',
     obtain ⟨x, hxM, hx1⟩ := this hM,
     refine ⟨x, inv_anti_mono _ _ ((coe_ideal_le_coe_ideal _).mpr hIM) hxM, hx1⟩;
-      apply fractional_ideal.coe_ideal_ne_zero; assumption },
+      rw coe_ideal_ne_zero; assumption },
 
   -- Let `a` be a nonzero element of `M` and `J` the ideal generated by `a`.
   intros M hM,
@@ -393,9 +414,9 @@ begin
       (λ h, hbJ $ h.symm ▸ J.zero_mem),
   -- Then `b a⁻¹ : K` is in `M⁻¹` but not in `1`.
   refine ⟨algebra_map A K b * (algebra_map A K a)⁻¹, (mem_inv_iff _).mpr _, _⟩,
-  { exact (fractional_ideal.coe_to_fractional_ideal_ne_zero le_rfl).mpr hM0.ne' },
+  { exact coe_ideal_ne_zero.mpr hM0.ne' },
   { rintro y₀ hy₀,
-    obtain ⟨y, h_Iy, rfl⟩ := (fractional_ideal.mem_coe_ideal _).mp hy₀,
+    obtain ⟨y, h_Iy, rfl⟩ := (mem_coe_ideal _).mp hy₀,
     rw [mul_comm, ← mul_assoc, ← ring_hom.map_mul],
     have h_yb : y * b ∈ J,
     { apply hle,
@@ -404,8 +425,8 @@ begin
     rw ideal.mem_span_singleton' at h_yb,
     rcases h_yb with ⟨c, hc⟩,
     rw [← hc, ring_hom.map_mul, mul_assoc, mul_inv_cancel hnz_fa, mul_one],
-    apply fractional_ideal.coe_mem_one },
-  { refine mt (fractional_ideal.mem_one_iff _).mp _,
+    apply coe_mem_one },
+  { refine mt (mem_one_iff _).mp _,
     rintros ⟨x', h₂_abs⟩,
     rw [← div_eq_mul_inv, eq_div_iff_mul_eq hnz_fa, ← ring_hom.map_mul] at h₂_abs,
     have := ideal.mem_span_singleton'.mpr ⟨x', is_fraction_ring.injective A K h₂_abs⟩,
@@ -415,7 +436,7 @@ end
 lemma one_mem_inv_coe_ideal {I : ideal A} (hI : I ≠ ⊥) :
   (1 : K) ∈ (I : fractional_ideal A⁰ K)⁻¹ :=
 begin
-  rw mem_inv_iff (fractional_ideal.coe_ideal_ne_zero hI),
+  rw mem_inv_iff (coe_ideal_ne_zero.mpr hI),
   intros y hy,
   rw one_mul,
   exact coe_ideal_le_one hy,
@@ -428,7 +449,7 @@ lemma mul_inv_cancel_of_le_one [h : is_dedekind_domain A]
 begin
   -- Handle a few trivial cases.
   by_cases hI1 : I = ⊤,
-  { rw [hI1, coe_ideal_top, one_mul, fractional_ideal.one_inv] },
+  { rw [hI1, coe_ideal_top, one_mul, inv_one] },
   by_cases hNF : is_field A,
   { letI := hNF.to_field, rcases hI1 (I.eq_bot_or_top.resolve_left hI0) },
   -- We'll show a contradiction with `exists_not_mem_one_of_ne_bot`:
@@ -462,12 +483,12 @@ begin
   -- We'll show `1 ≤ J⁻¹ = (I * I⁻¹)⁻¹ ≤ 1`.
   apply mul_inv_cancel_of_le_one hI0,
   by_cases hJ0 : (I * I⁻¹ : fractional_ideal A⁰ K) = 0,
-  { rw [hJ0, inv_zero'], exact fractional_ideal.zero_le _ },
+  { rw [hJ0, inv_zero'], exact zero_le _ },
   intros x hx,
   -- In particular, we'll show all `x ∈ J⁻¹` are integral.
   suffices : x ∈ integral_closure A K,
   { rwa [is_integrally_closed.integral_closure_eq_bot, algebra.mem_bot, set.mem_range,
-         ← fractional_ideal.mem_one_iff] at this;
+         ← mem_one_iff] at this;
       assumption },
   -- For that, we'll find a subalgebra that is f.g. as a module and contains `x`.
   -- `A` is a noetherian ring, so we just need to find a subalgebra between `{x}` and `I⁻¹`.
@@ -475,14 +496,14 @@ begin
   have x_mul_mem : ∀ b ∈ (I⁻¹ : fractional_ideal A⁰ K), x * b ∈ (I⁻¹ : fractional_ideal A⁰ K),
   { intros b hb,
     rw mem_inv_iff at ⊢ hx,
-    swap, { exact fractional_ideal.coe_ideal_ne_zero hI0 },
+    swap, { exact coe_ideal_ne_zero.mpr hI0 },
     swap, { exact hJ0 },
     simp only [mul_assoc, mul_comm b] at ⊢ hx,
     intros y hy,
-    exact hx _ (fractional_ideal.mul_mem_mul hy hb) },
-  -- It turns out the subalgebra consisting of all `p(x)` for `p : polynomial A` works.
+    exact hx _ (mul_mem_mul hy hb) },
+  -- It turns out the subalgebra consisting of all `p(x)` for `p : A[X]` works.
   refine ⟨alg_hom.range (polynomial.aeval x : A[X] →ₐ[A] K),
-          is_noetherian_submodule.mp (fractional_ideal.is_noetherian I⁻¹) _ (λ y hy, _),
+          is_noetherian_submodule.mp (is_noetherian I⁻¹) _ (λ y hy, _),
           ⟨polynomial.X, polynomial.aeval_X x⟩⟩,
   obtain ⟨p, rfl⟩ := (alg_hom.mem_range _).mp hy,
   rw polynomial.aeval_eq_sum_range,
@@ -510,11 +531,10 @@ begin
     exact ⟨span_singleton A⁰ (algebra_map _ _ a) * J⁻¹, h₂⟩ },
   subst hJ,
   rw [mul_assoc, mul_left_comm (J : fractional_ideal A⁰ K), coe_ideal_mul_inv, mul_one,
-      fractional_ideal.span_singleton_mul_span_singleton, inv_mul_cancel,
-      fractional_ideal.span_singleton_one],
+      span_singleton_mul_span_singleton, inv_mul_cancel, span_singleton_one],
   { exact mt ((injective_iff_map_eq_zero (algebra_map A K)).mp
       (is_fraction_ring.injective A K) _) ha },
-  { exact fractional_ideal.coe_ideal_ne_zero_iff.mp (right_ne_zero_of_mul hne) }
+  { exact coe_ideal_ne_zero.mp (right_ne_zero_of_mul hne) }
 end
 
 lemma mul_right_le_iff [is_dedekind_domain A] {J : fractional_ideal A⁰ K}
@@ -529,7 +549,7 @@ end
 
 lemma mul_left_le_iff [is_dedekind_domain A] {J : fractional_ideal A⁰ K}
   (hJ : J ≠ 0) {I I'} : J * I ≤ J * I' ↔ I ≤ I' :=
-by convert fractional_ideal.mul_right_le_iff hJ using 1; simp only [mul_comm]
+by convert mul_right_le_iff hJ using 1; simp only [mul_comm]
 
 lemma mul_right_strict_mono [is_dedekind_domain A] {I : fractional_ideal A⁰ K}
   (hI : I ≠ 0) : strict_mono (* I) :=
@@ -574,22 +594,36 @@ variables {R A} [is_dedekind_domain A] [algebra A K] [is_fraction_ring A K]
 open fractional_ideal
 open ideal
 
-noncomputable instance fractional_ideal.comm_group_with_zero :
-  comm_group_with_zero (fractional_ideal A⁰ K) :=
+noncomputable instance fractional_ideal.semifield :
+  semifield (fractional_ideal A⁰ K) :=
 { inv := λ I, I⁻¹,
   inv_zero := inv_zero' _,
   div := (/),
   div_eq_mul_inv := fractional_ideal.div_eq_mul_inv,
-  exists_pair_ne := ⟨0, 1, (coe_to_fractional_ideal_injective le_rfl).ne
-    (by simpa using @zero_ne_one (ideal A) _ _)⟩,
   mul_inv_cancel := λ I, fractional_ideal.mul_inv_cancel,
-  .. fractional_ideal.comm_semiring }
+  .. fractional_ideal.comm_semiring, .. coe_ideal_injective.nontrivial }
+
+/-- Fractional ideals have cancellative multiplication in a Dedekind domain.
+
+Although this instance is a direct consequence of the instance
+`fractional_ideal.comm_group_with_zero`, we define this instance to provide
+a computable alternative.
+-/
+instance fractional_ideal.cancel_comm_monoid_with_zero :
+  cancel_comm_monoid_with_zero (fractional_ideal A⁰ K) :=
+{ .. fractional_ideal.comm_semiring, -- Project out the computable fields first.
+  .. (by apply_instance : cancel_comm_monoid_with_zero (fractional_ideal A⁰ K)) }
 
-noncomputable instance ideal.cancel_comm_monoid_with_zero :
+instance ideal.cancel_comm_monoid_with_zero :
   cancel_comm_monoid_with_zero (ideal A) :=
-function.injective.cancel_comm_monoid_with_zero (coe_ideal_hom A⁰ (fraction_ring A))
-  coe_ideal_injective (ring_hom.map_zero _) (ring_hom.map_one _) (ring_hom.map_mul _)
-  (ring_hom.map_pow _)
+{ .. ideal.idem_comm_semiring,
+  .. function.injective.cancel_comm_monoid_with_zero (coe_ideal_hom A⁰ (fraction_ring A))
+    coe_ideal_injective (ring_hom.map_zero _) (ring_hom.map_one _) (ring_hom.map_mul _)
+    (ring_hom.map_pow _) }
+
+instance ideal.is_domain :
+  is_domain (ideal A) :=
+{ .. (infer_instance : is_cancel_mul_zero _), .. ideal.nontrivial }
 
 /-- For ideals in a Dedekind domain, to divide is to contain. -/
 lemma ideal.dvd_iff_le {I J : ideal A} : (I ∣ J) ↔ J ≤ I :=
@@ -598,16 +632,15 @@ lemma ideal.dvd_iff_le {I J : ideal A} : (I ∣ J) ↔ J ≤ I :=
     by_cases hI : I = ⊥,
     { have hJ : J = ⊥, { rwa [hI, ← eq_bot_iff] at h },
       rw [hI, hJ] },
-    have hI' : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 :=
-      (fractional_ideal.coe_to_fractional_ideal_ne_zero (le_refl (non_zero_divisors A))).mpr hI,
+    have hI' : (I : fractional_ideal A⁰ (fraction_ring A)) ≠ 0 := coe_ideal_ne_zero.mpr hI,
     have : (I : fractional_ideal A⁰ (fraction_ring A))⁻¹ * J ≤ 1 := le_trans
-      (fractional_ideal.mul_left_mono (↑I)⁻¹ ((coe_ideal_le_coe_ideal _).mpr h))
+      (mul_left_mono (↑I)⁻¹ ((coe_ideal_le_coe_ideal _).mpr h))
       (le_of_eq (inv_mul_cancel hI')),
-    obtain ⟨H, hH⟩ := fractional_ideal.le_one_iff_exists_coe_ideal.mp this,
+    obtain ⟨H, hH⟩ := le_one_iff_exists_coe_ideal.mp this,
     use H,
-    refine coe_to_fractional_ideal_injective (le_refl (non_zero_divisors A))
-      (show (J : fractional_ideal A⁰ (fraction_ring A)) = _, from _),
-    rw [fractional_ideal.coe_ideal_mul, hH, ← mul_assoc, mul_inv_cancel hI', one_mul]
+    refine coe_ideal_injective
+      (show (J : fractional_ideal A⁰ (fraction_ring A)) = ↑(I * H), from _),
+    rw [coe_ideal_mul, hH, ← mul_assoc, mul_inv_cancel hI', one_mul]
 end⟩
 
 lemma ideal.dvd_not_unit_iff_lt {I J : ideal A} :
@@ -644,7 +677,7 @@ instance ideal.unique_factorization_monoid :
    prime.irreducible⟩,
   .. ideal.wf_dvd_monoid }
 
-noncomputable instance ideal.normalization_monoid : normalization_monoid (ideal A) :=
+instance ideal.normalization_monoid : normalization_monoid (ideal A) :=
 normalization_monoid_of_unique_units
 
 @[simp] lemma ideal.dvd_span_singleton {I : ideal A} {x : A} :
@@ -673,6 +706,13 @@ theorem ideal.prime_iff_is_prime {P : ideal A} (hP : P ≠ ⊥) :
   prime P ↔ is_prime P :=
 ⟨ideal.is_prime_of_prime, ideal.prime_of_is_prime hP⟩
 
+/-- In a Dedekind domain, the the prime ideals are the zero ideal together with the prime elements
+of the monoid with zero `ideal A`. -/
+theorem ideal.is_prime_iff_bot_or_prime {P : ideal A} :
+  is_prime P ↔ P = ⊥ ∨ prime P :=
+⟨λ hp, (eq_or_ne P ⊥).imp_right $ λ hp0, (ideal.prime_of_is_prime hp0 hp),
+ λ hp, hp.elim (λ h, h.symm ▸ ideal.bot_prime) ideal.is_prime_of_prime⟩
+
 lemma ideal.strict_anti_pow (I : ideal A) (hI0 : I ≠ ⊥) (hI1 : I ≠ ⊤) :
   strict_anti ((^) I : ℕ → ideal A) :=
 strict_anti_nat_of_succ_lt $ λ e, ideal.dvd_not_unit_iff_lt.mp
@@ -685,6 +725,33 @@ lemma ideal.exists_mem_pow_not_mem_pow_succ (I : ideal A) (hI0 : I ≠ ⊥) (hI1
   ∃ x ∈ I^e, x ∉ I^(e+1) :=
 set_like.exists_of_lt (I.strict_anti_pow hI0 hI1 e.lt_succ_self)
 
+open unique_factorization_monoid
+
+lemma ideal.eq_prime_pow_of_succ_lt_of_le {P I : ideal A} [P_prime : P.is_prime] (hP : P ≠ ⊥)
+  {i : ℕ} (hlt : P ^ (i + 1) < I) (hle : I ≤ P ^ i) :
+  I = P ^ i :=
+begin
+  letI := classical.dec_eq (ideal A),
+  refine le_antisymm hle _,
+  have P_prime' := ideal.prime_of_is_prime hP P_prime,
+  have : I ≠ ⊥ := (lt_of_le_of_lt bot_le hlt).ne',
+  have := pow_ne_zero i hP,
+  have := pow_ne_zero (i + 1) hP,
+  rw [← ideal.dvd_not_unit_iff_lt, dvd_not_unit_iff_normalized_factors_lt_normalized_factors,
+      normalized_factors_pow, normalized_factors_irreducible P_prime'.irreducible,
+      multiset.nsmul_singleton, multiset.lt_replicate_succ]
+    at hlt,
+  rw [← ideal.dvd_iff_le, dvd_iff_normalized_factors_le_normalized_factors, normalized_factors_pow,
+      normalized_factors_irreducible P_prime'.irreducible, multiset.nsmul_singleton],
+  all_goals { assumption }
+end
+
+lemma ideal.pow_succ_lt_pow {P : ideal A} [P_prime : P.is_prime] (hP : P ≠ ⊥)
+  (i : ℕ) :
+  P ^ (i + 1) < P ^ i :=
+lt_of_le_of_ne (ideal.pow_le_pow (nat.le_succ _))
+  (mt (pow_eq_pow_iff hP (mt ideal.is_unit_iff.mp P_prime.ne_top)).mp i.succ_ne_self)
+
 lemma associates.le_singleton_iff (x : A) (n : ℕ) (I : ideal A) :
   associates.mk I^n ≤ associates.mk (ideal.span {x}) ↔ x ∈ I^n :=
 begin
@@ -705,8 +772,8 @@ lemma ideal.exist_integer_multiples_not_mem
     ∃ i ∈ s, (a * f i) ∉ (J : fractional_ideal A⁰ K) :=
 begin
   -- Consider the fractional ideal `I` spanned by the `f`s.
-  let I : fractional_ideal A⁰ K := fractional_ideal.span_finset A s f,
-  have hI0 : I ≠ 0 := fractional_ideal.span_finset_ne_zero.mpr ⟨j, hjs, hjf⟩,
+  let I : fractional_ideal A⁰ K := span_finset A s f,
+  have hI0 : I ≠ 0 := span_finset_ne_zero.mpr ⟨j, hjs, hjf⟩,
   -- We claim the multiplier `a` we're looking for is in `I⁻¹ \ (J / I)`.
   suffices : ↑J / I < I⁻¹,
   { obtain ⟨_, a, hI, hpI⟩ := set_like.lt_iff_le_and_exists.mp this,
@@ -734,6 +801,66 @@ begin
       (lt_top_iff_ne_top.mpr hJ) },
 end
 
+section gcd
+
+namespace ideal
+
+/-! ### GCD and LCM of ideals in a Dedekind domain
+
+We show that the gcd of two ideals in a Dedekind domain is just their supremum,
+and the lcm is their infimum, and use this to instantiate `normalized_gcd_monoid (ideal A)`.
+-/
+
+@[simp] lemma sup_mul_inf (I J : ideal A) : (I ⊔ J) * (I ⊓ J) = I * J :=
+begin
+  letI := classical.dec_eq (ideal A),
+  letI := classical.dec_eq (associates (ideal A)),
+  letI := unique_factorization_monoid.to_normalized_gcd_monoid (ideal A),
+  have hgcd : gcd I J = I ⊔ J,
+  { rw [gcd_eq_normalize _ _, normalize_eq],
+    { rw [dvd_iff_le, sup_le_iff, ← dvd_iff_le, ← dvd_iff_le],
+      exact ⟨gcd_dvd_left _ _, gcd_dvd_right _ _⟩ },
+    { rw [dvd_gcd_iff, dvd_iff_le, dvd_iff_le],
+      simp } },
+  have hlcm : lcm I J = I ⊓ J,
+  { rw [lcm_eq_normalize _ _, normalize_eq],
+    { rw [lcm_dvd_iff, dvd_iff_le, dvd_iff_le],
+      simp },
+    { rw [dvd_iff_le, le_inf_iff, ← dvd_iff_le, ← dvd_iff_le],
+      exact ⟨dvd_lcm_left _ _, dvd_lcm_right _ _⟩ } },
+  rw [← hgcd, ← hlcm, associated_iff_eq.mp (gcd_mul_lcm _ _)],
+  apply_instance
+end
+
+/-- Ideals in a Dedekind domain have gcd and lcm operators that (trivially) are compatible with
+the normalization operator. -/
+instance : normalized_gcd_monoid (ideal A) :=
+{ gcd := (⊔),
+  gcd_dvd_left := λ _ _, by simpa only [dvd_iff_le] using le_sup_left,
+  gcd_dvd_right := λ _ _, by simpa only [dvd_iff_le] using le_sup_right,
+  dvd_gcd := λ _ _ _, by simpa only [dvd_iff_le] using sup_le,
+  lcm := (⊓),
+  lcm_zero_left := λ _, by simp only [zero_eq_bot, bot_inf_eq],
+  lcm_zero_right := λ _, by simp only [zero_eq_bot, inf_bot_eq],
+  gcd_mul_lcm := λ _ _, by rw [associated_iff_eq, sup_mul_inf],
+  normalize_gcd := λ _ _, normalize_eq _,
+  normalize_lcm := λ _ _, normalize_eq _,
+  .. ideal.normalization_monoid }
+
+-- In fact, any lawful gcd and lcm would equal sup and inf respectively.
+@[simp] lemma gcd_eq_sup (I J : ideal A) : gcd I J = I ⊔ J := rfl
+
+@[simp]
+lemma lcm_eq_inf (I J : ideal A) : lcm I J = I ⊓ J := rfl
+
+lemma inf_eq_mul_of_coprime {I J : ideal A} (coprime : I ⊔ J = ⊤) :
+  I ⊓ J = I * J :=
+by rw [← associated_iff_eq.mp (gcd_mul_lcm I J), lcm_eq_inf I J, gcd_eq_sup, coprime, top_mul]
+
+end ideal
+
+end gcd
+
 end is_dedekind_domain
 
 section is_dedekind_domain
@@ -745,12 +872,6 @@ open multiset unique_factorization_monoid ideal
 lemma prod_normalized_factors_eq_self (hI : I ≠ ⊥) : (normalized_factors I).prod = I :=
 associated_iff_eq.1 (normalized_factors_prod hI)
 
-lemma normalized_factors_prod {α : multiset (ideal T)}
-  (h : ∀ p ∈ α, prime p) : normalized_factors α.prod = α :=
-by { simp_rw [← multiset.rel_eq, ← associated_eq_eq],
-     exact prime_factors_unique (prime_of_normalized_factor) h
-      (normalized_factors_prod (α.prod_ne_zero_of_prime h)) }
-
 lemma count_le_of_ideal_ge {I J : ideal T} (h : I ≤ J) (hI : I ≠ ⊥) (K : ideal T) :
   count K (normalized_factors J) ≤ count K (normalized_factors I) :=
 le_iff_count.1 ((dvd_iff_normalized_factors_le_normalized_factors (ne_bot_of_le_ne_bot hI h) hI).1
@@ -761,7 +882,7 @@ lemma sup_eq_prod_inf_factors (hI : I ≠ ⊥) (hJ : J ≠ ⊥) :
 begin
   have H : normalized_factors (normalized_factors I ∩ normalized_factors J).prod =
     normalized_factors I ∩ normalized_factors J,
-  { apply _root_.normalized_factors_prod,
+  { apply normalized_factors_prod_of_prime,
     intros p hp,
     rw mem_inter at hp,
     exact prime_of_normalized_factor p hp.left },
@@ -775,7 +896,7 @@ begin
     { rw [dvd_iff_normalized_factors_le_normalized_factors this hJ, H],
       exact inf_le_right } },
   { rw [← dvd_iff_le, dvd_iff_normalized_factors_le_normalized_factors,
-      _root_.normalized_factors_prod, le_iff_count],
+      normalized_factors_prod_of_prime, le_iff_count],
     { intro a,
       rw multiset.count_inter,
       exact le_min (count_le_of_ideal_ge le_sup_left hI a)
@@ -789,8 +910,8 @@ end
 
 lemma irreducible_pow_sup (hI : I ≠ ⊥) (hJ : irreducible J) (n : ℕ) :
   J^n ⊔ I = J^(min ((normalized_factors I).count J) n) :=
-by rw [sup_eq_prod_inf_factors (pow_ne_zero n hJ.ne_zero) hI, ← inf_eq_inter,
-       normalized_factors_of_irreducible_pow hJ, normalize_eq J, repeat_inf, prod_repeat]
+by rw [sup_eq_prod_inf_factors (pow_ne_zero n hJ.ne_zero) hI, min_comm,
+       normalized_factors_of_irreducible_pow hJ, normalize_eq J, replicate_inter, prod_replicate]
 
 lemma irreducible_pow_sup_of_le (hJ : irreducible J) (n : ℕ)
   (hn : ↑n ≤ multiplicity J I) : J^n ⊔ I = J^n :=
@@ -798,30 +919,29 @@ begin
   by_cases hI : I = ⊥,
   { simp [*] at *, },
   rw [irreducible_pow_sup hI hJ, min_eq_right],
-  rwa [multiplicity_eq_count_normalized_factors hJ hI, enat.coe_le_coe, normalize_eq J] at hn
+  rwa [multiplicity_eq_count_normalized_factors hJ hI, part_enat.coe_le_coe, normalize_eq J] at hn
 end
 
 lemma irreducible_pow_sup_of_ge (hI : I ≠ ⊥) (hJ : irreducible J) (n : ℕ)
-  (hn : multiplicity J I ≤ n) : J^n ⊔ I = J ^ (multiplicity J I).get (enat.dom_of_le_coe hn) :=
+  (hn : multiplicity J I ≤ n) : J^n ⊔ I = J ^ (multiplicity J I).get (part_enat.dom_of_le_coe hn) :=
 begin
   rw [irreducible_pow_sup hI hJ, min_eq_left],
   congr,
-  { rw [← enat.coe_inj, enat.coe_get, multiplicity_eq_count_normalized_factors hJ hI,
+  { rw [← part_enat.coe_inj, part_enat.coe_get, multiplicity_eq_count_normalized_factors hJ hI,
     normalize_eq J] },
-  { rwa [multiplicity_eq_count_normalized_factors hJ hI, enat.coe_le_coe, normalize_eq J]
+  { rwa [multiplicity_eq_count_normalized_factors hJ hI, part_enat.coe_le_coe, normalize_eq J]
       at hn }
 end
 
 end is_dedekind_domain
 
-section height_one_spectrum
-
 /-!
 ### Height one spectrum of a Dedekind domain
 If `R` is a Dedekind domain of Krull dimension 1, the maximal ideals of `R` are exactly its nonzero
 prime ideals.
 We define `height_one_spectrum` and provide lemmas to recover the facts that prime ideals of height
-one are prime and irreducible. -/
+one are prime and irreducible.
+-/
 
 namespace is_dedekind_domain
 
@@ -829,34 +949,200 @@ variables [is_domain R] [is_dedekind_domain R]
 
 /-- The height one prime spectrum of a Dedekind domain `R` is the type of nonzero prime ideals of
 `R`. Note that this equals the maximal spectrum if `R` has Krull dimension 1. -/
-@[ext, nolint has_inhabited_instance unused_arguments]
+@[ext, nolint has_nonempty_instance unused_arguments]
 structure height_one_spectrum :=
 (as_ideal : ideal R)
 (is_prime : as_ideal.is_prime)
-(ne_bot   : as_ideal ≠ ⊥)
+(ne_bot : as_ideal ≠ ⊥)
+
+attribute [instance] height_one_spectrum.is_prime
 
 variables (v : height_one_spectrum R) {R}
 
-lemma height_one_spectrum.prime (v : height_one_spectrum R) : prime v.as_ideal :=
-ideal.prime_of_is_prime v.ne_bot v.is_prime
+namespace height_one_spectrum
+
+instance is_maximal : v.as_ideal.is_maximal := dimension_le_one v.as_ideal v.ne_bot v.is_prime
+
+lemma prime : prime v.as_ideal := ideal.prime_of_is_prime v.ne_bot v.is_prime
+
+lemma irreducible : irreducible v.as_ideal :=
+unique_factorization_monoid.irreducible_iff_prime.mpr v.prime
+
+lemma associates_irreducible : _root_.irreducible $ associates.mk v.as_ideal :=
+(associates.irreducible_mk _).mpr v.irreducible
+
+/-- An equivalence between the height one and maximal spectra for rings of Krull dimension 1. -/
+def equiv_maximal_spectrum (hR : ¬is_field R) : height_one_spectrum R ≃ maximal_spectrum R :=
+{ to_fun    := λ v, ⟨v.as_ideal, dimension_le_one v.as_ideal v.ne_bot v.is_prime⟩,
+  inv_fun   := λ v,
+    ⟨v.as_ideal, v.is_maximal.is_prime, ring.ne_bot_of_is_maximal_of_not_is_field v.is_maximal hR⟩,
+  left_inv  := λ ⟨_, _, _⟩, rfl,
+  right_inv := λ ⟨_, _⟩, rfl }
+
+variables (R K)
+
+/-- A Dedekind domain is equal to the intersection of its localizations at all its height one
+non-zero prime ideals viewed as subalgebras of its field of fractions. -/
+theorem infi_localization_eq_bot [algebra R K] [hK : is_fraction_ring R K] :
+  (⨅ v : height_one_spectrum R,
+    localization.subalgebra.of_field K _ v.as_ideal.prime_compl_le_non_zero_divisors) = ⊥ :=
+begin
+  ext x,
+  rw [algebra.mem_infi],
+  split,
+  by_cases hR : is_field R,
+  { rcases function.bijective_iff_has_inverse.mp
+      (is_field.localization_map_bijective (flip non_zero_divisors.ne_zero rfl : 0 ∉ R⁰) hR)
+      with ⟨algebra_map_inv, _, algebra_map_right_inv⟩,
+    exact λ _, algebra.mem_bot.mpr ⟨algebra_map_inv x, algebra_map_right_inv x⟩,
+    exact hK },
+  all_goals { rw [← maximal_spectrum.infi_localization_eq_bot, algebra.mem_infi] },
+  { exact λ hx ⟨v, hv⟩, hx ((equiv_maximal_spectrum hR).symm ⟨v, hv⟩) },
+  { exact λ hx ⟨v, hv, hbot⟩, hx ⟨v, dimension_le_one v hbot hv⟩ }
+end
+
+end height_one_spectrum
+
+end is_dedekind_domain
+
+section
+
+open ideal
 
-lemma height_one_spectrum.irreducible (v : height_one_spectrum R) :
-  irreducible v.as_ideal :=
+variables {R} {A} [is_dedekind_domain A] {I : ideal R} {J : ideal A}
+
+/-- The map from ideals of `R` dividing `I` to the ideals of `A` dividing `J` induced by
+  a homomorphism `f : R/I →+* A/J` -/
+@[simps]
+def ideal_factors_fun_of_quot_hom {f : R ⧸ I →+* A ⧸ J} (hf : function.surjective f ) :
+  {p : ideal R | p ∣ I} →o {p : ideal A | p ∣ J} :=
+{ to_fun := λ X, ⟨comap J^.quotient.mk (map f (map I^.quotient.mk X)),
+    begin
+      have : (J^.quotient.mk).ker ≤ comap J^.quotient.mk (map f (map I^.quotient.mk X)),
+      { exact ker_le_comap J^.quotient.mk },
+      rw mk_ker at this,
+      exact dvd_iff_le.mpr this,
+    end ⟩,
+  monotone' :=
+    begin
+      rintros ⟨X, hX⟩ ⟨Y, hY⟩ h,
+      rw [← subtype.coe_le_coe, subtype.coe_mk, subtype.coe_mk] at h ⊢,
+      rw [subtype.coe_mk, comap_le_comap_iff_of_surjective J^.quotient.mk quotient.mk_surjective,
+        map_le_iff_le_comap, subtype.coe_mk, comap_map_of_surjective _ hf (map I^.quotient.mk Y)],
+      suffices : map I^.quotient.mk X ≤ map I^.quotient.mk Y,
+      { exact le_sup_of_le_left this },
+      rwa [map_le_iff_le_comap, comap_map_of_surjective I^.quotient.mk quotient.mk_surjective,
+        ← ring_hom.ker_eq_comap_bot, mk_ker, sup_eq_left.mpr $ le_of_dvd hY],
+    end }
+
+@[simp]
+lemma ideal_factors_fun_of_quot_hom_id :
+  ideal_factors_fun_of_quot_hom  (ring_hom.id (A ⧸ J)).is_surjective = order_hom.id :=
+order_hom.ext _ _ (funext $ λ X, by simp only [ideal_factors_fun_of_quot_hom, map_id,
+  order_hom.coe_fun_mk, order_hom.id_coe, id.def, comap_map_of_surjective J^.quotient.mk
+  quotient.mk_surjective, ← ring_hom.ker_eq_comap_bot J^.quotient.mk, mk_ker, sup_eq_left.mpr
+  (dvd_iff_le.mp X.prop), subtype.coe_eta] )
+
+variables {B : Type*} [comm_ring B] [is_domain B] [is_dedekind_domain B] {L : ideal B}
+
+lemma ideal_factors_fun_of_quot_hom_comp {f : R ⧸ I →+* A ⧸ J}  {g : A ⧸ J →+* B ⧸ L}
+  (hf : function.surjective f) (hg : function.surjective g) :
+  (ideal_factors_fun_of_quot_hom hg).comp (ideal_factors_fun_of_quot_hom hf)
+    = ideal_factors_fun_of_quot_hom (show function.surjective (g.comp f), from hg.comp hf) :=
 begin
-  rw [unique_factorization_monoid.irreducible_iff_prime],
-  apply v.prime,
+  refine order_hom.ext _ _ (funext $ λ x, _),
+  rw [ideal_factors_fun_of_quot_hom, ideal_factors_fun_of_quot_hom, order_hom.comp_coe,
+    order_hom.coe_fun_mk, order_hom.coe_fun_mk, function.comp_app,
+    ideal_factors_fun_of_quot_hom,  order_hom.coe_fun_mk, subtype.mk_eq_mk, subtype.coe_mk,
+    map_comap_of_surjective J^.quotient.mk quotient.mk_surjective, map_map],
 end
 
-lemma height_one_spectrum.associates_irreducible (v : height_one_spectrum R) :
-  irreducible (associates.mk v.as_ideal) :=
+variables [is_domain R] [is_dedekind_domain R] (f : R ⧸ I ≃+* A ⧸ J)
+
+/-- The bijection between ideals of `R` dividing `I` and the ideals of `A` dividing `J` induced by
+  an isomorphism `f : R/I ≅ A/J`. -/
+@[simps]
+def ideal_factors_equiv_of_quot_equiv : {p : ideal R | p ∣ I} ≃o {p : ideal A | p ∣ J} :=
+order_iso.of_hom_inv
+  (ideal_factors_fun_of_quot_hom (show function.surjective
+    (f : R ⧸I →+* A ⧸ J), from f.surjective))
+    (ideal_factors_fun_of_quot_hom (show function.surjective
+    (f.symm : A ⧸J →+* R ⧸ I), from f.symm.surjective))
+  (by simp only [← ideal_factors_fun_of_quot_hom_id, order_hom.coe_eq, order_hom.coe_eq,
+    ideal_factors_fun_of_quot_hom_comp, ← ring_equiv.to_ring_hom_eq_coe,
+    ← ring_equiv.to_ring_hom_eq_coe, ← ring_equiv.to_ring_hom_trans, ring_equiv.symm_trans_self,
+    ring_equiv.to_ring_hom_refl])
+  (by simp only [← ideal_factors_fun_of_quot_hom_id, order_hom.coe_eq, order_hom.coe_eq,
+    ideal_factors_fun_of_quot_hom_comp, ← ring_equiv.to_ring_hom_eq_coe,
+    ← ring_equiv.to_ring_hom_eq_coe, ← ring_equiv.to_ring_hom_trans, ring_equiv.self_trans_symm,
+    ring_equiv.to_ring_hom_refl])
+
+lemma ideal_factors_equiv_of_quot_equiv_symm :
+  (ideal_factors_equiv_of_quot_equiv f).symm = ideal_factors_equiv_of_quot_equiv f.symm := rfl
+
+lemma ideal_factors_equiv_of_quot_equiv_is_dvd_iso {L M : ideal R} (hL : L ∣ I) (hM : M ∣ I) :
+  (ideal_factors_equiv_of_quot_equiv f ⟨L, hL⟩ : ideal A) ∣
+    ideal_factors_equiv_of_quot_equiv f ⟨M, hM⟩  ↔ L ∣ M :=
 begin
-  rw [associates.irreducible_mk _],
-  apply v.irreducible,
+  suffices : ideal_factors_equiv_of_quot_equiv f ⟨M, hM⟩ ≤
+    ideal_factors_equiv_of_quot_equiv f ⟨L, hL⟩ ↔ (⟨M, hM⟩ : {p : ideal R | p ∣ I}) ≤ ⟨L, hL⟩,
+  { rw [dvd_iff_le, dvd_iff_le, subtype.coe_le_coe, this, subtype.mk_le_mk] },
+  exact (ideal_factors_equiv_of_quot_equiv f).le_iff_le,
 end
 
-end is_dedekind_domain
+open unique_factorization_monoid
 
-end height_one_spectrum
+variables [decidable_eq (ideal R)] [decidable_eq (ideal A)]
+
+lemma ideal_factors_equiv_of_quot_equiv_mem_normalized_factors_of_mem_normalized_factors
+  (hJ : J ≠ ⊥) {L : ideal R} (hL : L ∈ normalized_factors I) :
+  ↑(ideal_factors_equiv_of_quot_equiv f
+    ⟨L, dvd_of_mem_normalized_factors hL⟩) ∈ normalized_factors J :=
+begin
+  by_cases hI : I = ⊥,
+  { exfalso,
+    rw [hI, bot_eq_zero, normalized_factors_zero, ← multiset.empty_eq_zero] at hL,
+    exact hL, },
+  { apply mem_normalized_factors_factor_dvd_iso_of_mem_normalized_factors hI hJ hL _,
+    rintros ⟨l, hl⟩ ⟨l', hl'⟩,
+    rw [subtype.coe_mk, subtype.coe_mk],
+    apply ideal_factors_equiv_of_quot_equiv_is_dvd_iso f }
+end
+
+/-- The bijection between the sets of normalized factors of I and J induced by a ring
+    isomorphism `f : R/I ≅ A/J`. -/
+@[simps apply]
+def normalized_factors_equiv_of_quot_equiv (hI : I ≠ ⊥) (hJ : J ≠ ⊥) :
+  {L : ideal R | L ∈ normalized_factors I } ≃ {M : ideal A | M ∈ normalized_factors J } :=
+{ to_fun := λ j, ⟨ideal_factors_equiv_of_quot_equiv f ⟨↑j, dvd_of_mem_normalized_factors j.prop⟩,
+   ideal_factors_equiv_of_quot_equiv_mem_normalized_factors_of_mem_normalized_factors f hJ j.prop⟩,
+  inv_fun := λ j, ⟨(ideal_factors_equiv_of_quot_equiv f).symm
+    ⟨↑j, dvd_of_mem_normalized_factors j.prop⟩, by { rw ideal_factors_equiv_of_quot_equiv_symm,
+      exact ideal_factors_equiv_of_quot_equiv_mem_normalized_factors_of_mem_normalized_factors
+        f.symm hI j.prop} ⟩,
+  left_inv := λ ⟨j, hj⟩, by simp,
+  right_inv := λ ⟨j, hj⟩, by simp }
+
+@[simp]
+lemma normalized_factors_equiv_of_quot_equiv_symm (hI : I ≠ ⊥) (hJ : J ≠ ⊥) :
+  (normalized_factors_equiv_of_quot_equiv f hI hJ).symm =
+    normalized_factors_equiv_of_quot_equiv f.symm hJ hI :=
+rfl
+
+variable [decidable_rel ((∣) : ideal R → ideal R → Prop)]
+variable [decidable_rel ((∣) : ideal A → ideal A → Prop)]
+
+/-- The map `normalized_factors_equiv_of_quot_equiv` preserves multiplicities. -/
+lemma normalized_factors_equiv_of_quot_equiv_multiplicity_eq_multiplicity (hI : I ≠ ⊥) (hJ : J ≠ ⊥)
+  (L : ideal R) (hL : L ∈ normalized_factors I) :
+  multiplicity ↑(normalized_factors_equiv_of_quot_equiv f hI hJ ⟨L, hL⟩) J = multiplicity L I :=
+begin
+  rw [normalized_factors_equiv_of_quot_equiv, equiv.coe_fn_mk, subtype.coe_mk],
+  exact multiplicity_factor_dvd_iso_eq_multiplicity_of_mem_normalized_factor hI hJ hL
+    (λ ⟨l, hl⟩ ⟨l', hl'⟩, ideal_factors_equiv_of_quot_equiv_is_dvd_iso f hl hl'),
+end
+
+end
 
 section chinese_remainder
 
@@ -899,11 +1185,15 @@ section
 
 open_locale classical
 
-lemma ideal.count_normalized_factors_eq {p x : ideal R} (hp0 : p ≠ ⊥) [hp : p.is_prime] {n : ℕ}
+lemma ideal.count_normalized_factors_eq {p x : ideal R} [hp : p.is_prime] {n : ℕ}
   (hle : x ≤ p^n) (hlt : ¬ (x ≤ p^(n+1))) :
   (normalized_factors x).count p = n :=
-count_normalized_factors_eq ((ideal.prime_iff_is_prime hp0).mpr hp).irreducible (normalize_eq _)
-  (ideal.dvd_iff_le.mpr hle) (mt ideal.le_of_dvd hlt)
+count_normalized_factors_eq'
+  ((ideal.is_prime_iff_bot_or_prime.mp hp).imp_right prime.irreducible)
+  (by { haveI : unique (ideal R)ˣ := ideal.unique_units, apply normalize_eq })
+  (by convert ideal.dvd_iff_le.mpr hle) (by convert mt ideal.le_of_dvd hlt)
+/- Warning: even though a pure term-mode proof typechecks (the `by convert` can simply be
+  removed), it's slower to the point of a possible timeout. -/
 
 end
 
@@ -1018,6 +1308,164 @@ is_dedekind_domain.quotient_equiv_pi_of_prod_eq _ _ _
     λ P, ideal.quotient.mk _ x :=
 rfl
 
+/-- **Chinese remainder theorem**, specialized to two ideals. -/
+noncomputable def ideal.quotient_mul_equiv_quotient_prod (I J : ideal R)
+  (coprime : I ⊔ J = ⊤) :
+  (R ⧸ (I * J)) ≃+* (R ⧸ I) × R ⧸ J :=
+ring_equiv.trans
+  (ideal.quot_equiv_of_eq (inf_eq_mul_of_coprime coprime).symm)
+  (ideal.quotient_inf_equiv_quotient_prod I J coprime)
+
+/-- **Chinese remainder theorem** for a Dedekind domain: if the ideal `I` factors as
+`∏ i in s, P i ^ e i`, then `R ⧸ I` factors as `Π (i : s), R ⧸ (P i ^ e i)`.
+
+This is a version of `is_dedekind_domain.quotient_equiv_pi_of_prod_eq` where we restrict
+the product to a finite subset `s` of a potentially infinite indexing type `ι`.
+-/
+noncomputable def is_dedekind_domain.quotient_equiv_pi_of_finset_prod_eq {ι : Type*} {s : finset ι}
+  (I : ideal R) (P : ι → ideal R) (e : ι → ℕ)
+  (prime : ∀ i ∈ s, prime (P i)) (coprime : ∀ (i j ∈ s), i ≠ j → P i ≠ P j)
+  (prod_eq : (∏ i in s, P i ^ e i) = I) :
+  R ⧸ I ≃+* Π (i : s), R ⧸ (P i ^ e i) :=
+is_dedekind_domain.quotient_equiv_pi_of_prod_eq I (λ (i : s), P i) (λ (i : s), e i)
+  (λ i, prime i i.2)
+  (λ i j h, coprime i i.2 j j.2 (subtype.coe_injective.ne h))
+  (trans (finset.prod_coe_sort s (λ i, P i ^ e i)) prod_eq)
+
+/-- Corollary of the Chinese remainder theorem: given elements `x i : R / P i ^ e i`,
+we can choose a representative `y : R` such that `y ≡ x i (mod P i ^ e i)`.-/
+lemma is_dedekind_domain.exists_representative_mod_finset {ι : Type*} {s : finset ι}
+  (P : ι → ideal R) (e : ι → ℕ)
+  (prime : ∀ i ∈ s, prime (P i)) (coprime : ∀ (i j ∈ s), i ≠ j → P i ≠ P j)
+  (x : Π (i : s), R ⧸ (P i ^ e i)) :
+  ∃ y, ∀ i (hi : i ∈ s), ideal.quotient.mk (P i ^ e i) y = x ⟨i, hi⟩ :=
+begin
+  let f := is_dedekind_domain.quotient_equiv_pi_of_finset_prod_eq _ P e prime coprime rfl,
+  obtain ⟨y, rfl⟩ := f.surjective x,
+  obtain ⟨z, rfl⟩ := ideal.quotient.mk_surjective y,
+  exact ⟨z, λ i hi, rfl⟩
+end
+
+/-- Corollary of the Chinese remainder theorem: given elements `x i : R`,
+we can choose a representative `y : R` such that `y - x i ∈ P i ^ e i`.-/
+lemma is_dedekind_domain.exists_forall_sub_mem_ideal {ι : Type*} {s : finset ι}
+  (P : ι → ideal R) (e : ι → ℕ)
+  (prime : ∀ i ∈ s, prime (P i)) (coprime : ∀ (i j ∈ s), i ≠ j → P i ≠ P j)
+  (x : s → R) :
+  ∃ y, ∀ i (hi : i ∈ s), y - x ⟨i, hi⟩ ∈ P i ^ e i :=
+begin
+  obtain ⟨y, hy⟩ := is_dedekind_domain.exists_representative_mod_finset P e prime coprime
+    (λ i, ideal.quotient.mk _ (x i)),
+  exact ⟨y, λ i hi, ideal.quotient.eq.mp (hy i hi)⟩
+end
+
 end dedekind_domain
 
 end chinese_remainder
+
+section PID
+
+open multiplicity unique_factorization_monoid ideal
+
+variables {R} [is_domain R] [is_principal_ideal_ring R]
+
+lemma span_singleton_dvd_span_singleton_iff_dvd {a b : R} :
+  (ideal.span {a}) ∣ (ideal.span ({b} : set R)) ↔ a ∣ b :=
+⟨λ h, mem_span_singleton.mp (dvd_iff_le.mp h (mem_span_singleton.mpr (dvd_refl b))),
+  λ h, dvd_iff_le.mpr (λ d hd, mem_span_singleton.mpr (dvd_trans h (mem_span_singleton.mp hd)))⟩
+
+lemma singleton_span_mem_normalized_factors_of_mem_normalized_factors [normalization_monoid R]
+  [decidable_eq R] [decidable_eq (ideal R)] {a b : R} (ha : a ∈ normalized_factors b) :
+  ideal.span ({a} : set R) ∈ normalized_factors (ideal.span ({b} : set R)) :=
+begin
+  by_cases hb : b = 0,
+  { rw [ideal.span_singleton_eq_bot.mpr hb, bot_eq_zero, normalized_factors_zero],
+    rw [hb, normalized_factors_zero] at ha,
+    simpa only [multiset.not_mem_zero] },
+  { suffices : prime (ideal.span ({a} : set R)),
+    { obtain ⟨c, hc, hc'⟩ := exists_mem_normalized_factors_of_dvd _ this.irreducible
+        (dvd_iff_le.mpr (span_singleton_le_span_singleton.mpr (dvd_of_mem_normalized_factors ha))),
+      rwa associated_iff_eq.mp hc',
+      { by_contra,
+        exact hb (span_singleton_eq_bot.mp h) } },
+    rw prime_iff_is_prime,
+    exact (span_singleton_prime (prime_of_normalized_factor a ha).ne_zero).mpr
+      (prime_of_normalized_factor a ha),
+    by_contra,
+    exact (prime_of_normalized_factor a ha).ne_zero (span_singleton_eq_bot.mp h) },
+end
+
+lemma multiplicity_eq_multiplicity_span [decidable_rel ((∣) : R → R → Prop)]
+  [decidable_rel ((∣) : ideal R → ideal R → Prop)] {a b : R} :
+  multiplicity (ideal.span {a}) (ideal.span ({b} : set R)) = multiplicity a b :=
+begin
+  by_cases h : finite a b,
+    { rw ← part_enat.coe_get (finite_iff_dom.mp h),
+      refine (multiplicity.unique
+        (show (ideal.span {a})^(((multiplicity a b).get h)) ∣ (ideal.span {b}), from _) _).symm ;
+        rw [ideal.span_singleton_pow, span_singleton_dvd_span_singleton_iff_dvd],
+      exact pow_multiplicity_dvd h ,
+      { exact multiplicity.is_greatest ((part_enat.lt_coe_iff _ _).mpr (exists.intro
+          (finite_iff_dom.mp h) (nat.lt_succ_self _))) } },
+    { suffices : ¬ (finite (ideal.span ({a} : set R)) (ideal.span ({b} : set R))),
+      { rw [finite_iff_dom, part_enat.not_dom_iff_eq_top] at h this,
+        rw [h, this] },
+      refine not_finite_iff_forall.mpr (λ n, by {rw [ideal.span_singleton_pow,
+        span_singleton_dvd_span_singleton_iff_dvd], exact not_finite_iff_forall.mp h n }) }
+end
+
+variables [decidable_eq R] [decidable_eq (ideal R)] [normalization_monoid R]
+
+/-- The bijection between the (normalized) prime factors of `r` and the (normalized) prime factors
+    of `span {r}` -/
+@[simps]
+noncomputable def normalized_factors_equiv_span_normalized_factors {r : R} (hr : r ≠ 0) :
+  {d : R | d ∈ normalized_factors r} ≃
+    {I : ideal R | I ∈ normalized_factors (ideal.span ({r} : set R))} :=
+equiv.of_bijective
+  (λ d, ⟨ideal.span {↑d}, singleton_span_mem_normalized_factors_of_mem_normalized_factors d.prop⟩)
+begin
+  split,
+  { rintros ⟨a, ha⟩ ⟨b, hb⟩ h,
+    rw [subtype.mk_eq_mk, ideal.span_singleton_eq_span_singleton, subtype.coe_mk,
+      subtype.coe_mk] at h,
+    exact subtype.mk_eq_mk.mpr (mem_normalized_factors_eq_of_associated ha hb h) },
+  { rintros ⟨i, hi⟩,
+    letI : i.is_principal := infer_instance,
+    letI : i.is_prime := is_prime_of_prime (prime_of_normalized_factor i hi),
+    obtain ⟨a, ha, ha'⟩ := exists_mem_normalized_factors_of_dvd hr
+      (submodule.is_principal.prime_generator_of_is_prime i
+        (prime_of_normalized_factor i hi).ne_zero).irreducible _,
+    { use ⟨a, ha⟩,
+      simp only [subtype.coe_mk, subtype.mk_eq_mk, ← span_singleton_eq_span_singleton.mpr ha',
+        ideal.span_singleton_generator] },
+    {exact (submodule.is_principal.mem_iff_generator_dvd i).mp (((show ideal.span {r} ≤ i, from
+      dvd_iff_le.mp (dvd_of_mem_normalized_factors hi))) (mem_span_singleton.mpr (dvd_refl r))) } }
+end
+
+variables [decidable_rel ((∣) : R → R → Prop)] [decidable_rel ((∣) : ideal R → ideal R → Prop)]
+
+/-- The bijection `normalized_factors_equiv_span_normalized_factors` between the set of prime
+    factors of `r` and the set of prime factors of the ideal `⟨r⟩` preserves multiplicities. -/
+lemma multiplicity_normalized_factors_equiv_span_normalized_factors_eq_multiplicity {r d: R}
+  (hr : r ≠ 0) (hd : d ∈ normalized_factors r) :
+  multiplicity d r =
+    multiplicity (normalized_factors_equiv_span_normalized_factors hr ⟨d, hd⟩ : ideal R)
+      (ideal.span {r}) :=
+by simp only [normalized_factors_equiv_span_normalized_factors, multiplicity_eq_multiplicity_span,
+    subtype.coe_mk, equiv.of_bijective_apply]
+
+/-- The bijection `normalized_factors_equiv_span_normalized_factors.symm` between the set of prime
+    factors of the ideal `⟨r⟩` and the set of prime factors of `r` preserves multiplicities. -/
+lemma multiplicity_normalized_factors_equiv_span_normalized_factors_symm_eq_multiplicity
+  {r : R} (hr : r ≠ 0) (I : {I : ideal R | I ∈ normalized_factors (ideal.span ({r} : set R))}) :
+  multiplicity ((normalized_factors_equiv_span_normalized_factors hr).symm I : R) r =
+    multiplicity (I : ideal R) (ideal.span {r}) :=
+begin
+  obtain ⟨x, hx⟩ := (normalized_factors_equiv_span_normalized_factors hr).surjective I,
+  obtain ⟨a, ha⟩ := x,
+  rw [hx.symm, equiv.symm_apply_apply, subtype.coe_mk,
+    multiplicity_normalized_factors_equiv_span_normalized_factors_eq_multiplicity hr ha, hx],
+end
+
+end PID
diff --git a/src/ring_theory/dedekind_domain/integral_closure.lean b/src/ring_theory/dedekind_domain/integral_closure.lean
index a627b3548870d..357d4b6ec65e0 100644
--- a/src/ring_theory/dedekind_domain/integral_closure.lean
+++ b/src/ring_theory/dedekind_domain/integral_closure.lean
@@ -3,12 +3,17 @@ Copyright (c) 2020 Kenji Nakagawa. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenji Nakagawa, Anne Baanen, Filippo A. E. Nuccio
 -/
+import linear_algebra.free_module.pid
 import ring_theory.dedekind_domain.basic
+import ring_theory.localization.module
 import ring_theory.trace
 
 /-!
 # Integral closure of Dedekind domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file shows the integral closure of a Dedekind domain (in particular, the ring of integers
 of a number field) is a Dedekind domain.
 
@@ -48,11 +53,41 @@ of a number field is a Dedekind domain. -/
 open algebra
 open_locale big_operators
 
-variables {A K} [algebra A K] [is_fraction_ring A K]
-variables {L : Type*} [field L] (C : Type*) [comm_ring C]
-variables [algebra K L] [finite_dimensional K L] [algebra A L] [is_scalar_tower A K L]
+variables (A K) [algebra A K] [is_fraction_ring A K]
+variables (L : Type*) [field L] (C : Type*) [comm_ring C]
+variables [algebra K L]  [algebra A L] [is_scalar_tower A K L]
 variables [algebra C L] [is_integral_closure C A L] [algebra A C] [is_scalar_tower A C L]
 
+/- If `L` is a separable extension of `K = Frac(A)` and `L` has no zero smul divisors by `A`,
+then `L` is the localization of the integral closure `C` of `A` in `L` at `A⁰`. -/
+lemma is_integral_closure.is_localization [is_separable K L] [no_zero_smul_divisors A L] :
+  is_localization (algebra.algebra_map_submonoid C A⁰) L :=
+begin
+  haveI : is_domain C :=
+    (is_integral_closure.equiv A C L (integral_closure A L)).to_ring_equiv.is_domain
+      (integral_closure A L),
+  haveI : no_zero_smul_divisors A C := is_integral_closure.no_zero_smul_divisors A L,
+  refine ⟨_, λ z, _, λ x y, ⟨λ h, ⟨1, _⟩, _⟩⟩,
+  { rintros ⟨_, x, hx, rfl⟩,
+    rw [is_unit_iff_ne_zero, map_ne_zero_iff _ (is_integral_closure.algebra_map_injective C A L),
+      subtype.coe_mk, map_ne_zero_iff _ (no_zero_smul_divisors.algebra_map_injective A C)],
+    exact mem_non_zero_divisors_iff_ne_zero.mp hx, },
+  { obtain ⟨m, hm⟩ := is_integral.exists_multiple_integral_of_is_localization A⁰ z
+      (is_separable.is_integral K z),
+    obtain ⟨x, hx⟩ : ∃ x, algebra_map C L x = m • z := is_integral_closure.is_integral_iff.mp hm,
+    refine ⟨⟨x, algebra_map A C m, m, set_like.coe_mem m, rfl⟩, _⟩,
+    rw [subtype.coe_mk, ← is_scalar_tower.algebra_map_apply, hx, mul_comm, submonoid.smul_def,
+      smul_def], },
+  { simp only [is_integral_closure.algebra_map_injective C A L h], },
+  { rintros ⟨⟨_, m, hm, rfl⟩, h⟩,
+    refine congr_arg (algebra_map C L) ((mul_right_inj' _).mp h),
+    rw [subtype.coe_mk, map_ne_zero_iff _ (no_zero_smul_divisors.algebra_map_injective A C)],
+    exact mem_non_zero_divisors_iff_ne_zero.mp hm, },
+end
+
+variable [finite_dimensional K L]
+variables {A K L}
+
 lemma is_integral_closure.range_le_span_dual_basis [is_separable K L]
   {ι : Type*} [fintype ι] [decidable_eq ι] (b : basis ι K L)
   (hb_int : ∀ i, is_integral A (b i)) [is_integrally_closed A] :
@@ -64,9 +99,8 @@ begin
   simp only [linear_map.coe_restrict_scalars_eq_coe, algebra.linear_map_apply],
   have hx : is_integral A (algebra_map C L x) :=
     (is_integral_closure.is_integral A L x).algebra_map,
-  suffices : ∃ (c : ι → A), algebra_map C L x = ∑ i, c i • db i,
-  { obtain ⟨c, x_eq⟩ := this,
-    rw x_eq,
+  rsuffices ⟨c, x_eq⟩ : ∃ (c : ι → A), algebra_map C L x = ∑ i, c i • db i,
+  { rw x_eq,
     refine submodule.sum_mem _ (λ i _, submodule.smul_mem _ _ (submodule.subset_span _)),
     rw set.mem_range,
     exact ⟨i, rfl⟩ },
@@ -157,23 +191,55 @@ include L
 
 /- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
 integrally closed and Noetherian, the integral closure `C` of `A` in `L` is
-Noetherian. -/
-lemma is_integral_closure.is_noetherian_ring [is_integrally_closed A] [is_noetherian_ring A] :
-  is_noetherian_ring C :=
+Noetherian over `A`. -/
+lemma is_integral_closure.is_noetherian [is_integrally_closed A] [is_noetherian_ring A] :
+  is_noetherian A C :=
 begin
   haveI := classical.dec_eq L,
   obtain ⟨s, b, hb_int⟩ := finite_dimensional.exists_is_basis_integral A K L,
-  rw is_noetherian_ring_iff,
   let b' := (trace_form K L).dual_basis (trace_form_nondegenerate K L) b,
   letI := is_noetherian_span_of_finite A (set.finite_range b'),
   let f : C →ₗ[A] submodule.span A (set.range b') :=
     (submodule.of_le (is_integral_closure.range_le_span_dual_basis C b hb_int)).comp
     ((algebra.linear_map C L).restrict_scalars A).range_restrict,
-  refine is_noetherian_of_tower A (is_noetherian_of_ker_bot f _),
+  refine is_noetherian_of_ker_bot f _,
   rw [linear_map.ker_comp, submodule.ker_of_le, submodule.comap_bot, linear_map.ker_cod_restrict],
   exact linear_map.ker_eq_bot_of_injective (is_integral_closure.algebra_map_injective C A L)
 end
 
+/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
+integrally closed and Noetherian, the integral closure `C` of `A` in `L` is
+Noetherian. -/
+lemma is_integral_closure.is_noetherian_ring [is_integrally_closed A] [is_noetherian_ring A] :
+  is_noetherian_ring C :=
+is_noetherian_ring_iff.mpr $ is_noetherian_of_tower A (is_integral_closure.is_noetherian A K L C)
+
+/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a principal ring
+and `L` has no zero smul divisors by `A`, the integral closure `C` of `A` in `L` is
+a free `A`-module. -/
+lemma is_integral_closure.module_free [no_zero_smul_divisors A L] [is_principal_ideal_ring A] :
+  module.free A C :=
+begin
+  haveI : no_zero_smul_divisors A C := is_integral_closure.no_zero_smul_divisors A L,
+  haveI : is_noetherian A C := is_integral_closure.is_noetherian A K L _,
+  exact module.free_of_finite_type_torsion_free',
+end
+
+/- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is a principal ring
+and `L` has no zero smul divisors by `A`, the `A`-rank of the integral closure `C` of `A` in `L`
+is equal to the `K`-rank of `L`. -/
+lemma is_integral_closure.rank [is_principal_ideal_ring A] [no_zero_smul_divisors A L] :
+  finite_dimensional.finrank A C = finite_dimensional.finrank K L :=
+begin
+  haveI : module.free A C := is_integral_closure.module_free A K L C,
+  haveI : is_noetherian A C := is_integral_closure.is_noetherian A K L C,
+  haveI : is_localization (algebra.algebra_map_submonoid C A⁰) L :=
+    is_integral_closure.is_localization A K L C,
+  let b := basis.localization_localization K A⁰ L (module.free.choose_basis A C),
+  rw [finite_dimensional.finrank_eq_card_choose_basis_index,
+    finite_dimensional.finrank_eq_card_basis b],
+end
+
 variables {A K}
 
 /- If `L` is a finite separable extension of `K = Frac(A)`, where `A` is
diff --git a/src/ring_theory/dedekind_domain/pid.lean b/src/ring_theory/dedekind_domain/pid.lean
new file mode 100644
index 0000000000000..0cab71477b16b
--- /dev/null
+++ b/src/ring_theory/dedekind_domain/pid.lean
@@ -0,0 +1,255 @@
+/-
+Copyright (c) 2023 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+
+import ring_theory.dedekind_domain.dvr
+import ring_theory.dedekind_domain.ideal
+
+/-!
+# Proving a Dedekind domain is a PID
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains some results that we can use to show all ideals in a Dedekind domain are
+principal.
+
+## Main results
+
+ * `ideal.is_principal.of_finite_maximals_of_is_unit`: an invertible ideal in a commutative ring
+   with finitely many maximal ideals, is a principal ideal.
+ * `is_principal_ideal_ring.of_finite_primes`: if a Dedekind domain has finitely many prime ideals,
+   it is a principal ideal domain.
+-/
+
+variables {R : Type*} [comm_ring R]
+
+open ideal
+open unique_factorization_monoid
+open_locale big_operators
+open_locale non_zero_divisors
+
+open unique_factorization_monoid
+
+/-- Let `P` be a prime ideal, `x ∈ P \ P²` and `x ∉ Q` for all prime ideals `Q ≠ P`.
+Then `P` is generated by `x`. -/
+lemma ideal.eq_span_singleton_of_mem_of_not_mem_sq_of_not_mem_prime_ne
+  {P : ideal R} (hP : P.is_prime) [is_domain R] [is_dedekind_domain R]
+  {x : R} (x_mem : x ∈ P) (hxP2 : x ∉ P^2)
+  (hxQ : ∀ (Q : ideal R), is_prime Q → Q ≠ P → x ∉ Q) :
+  P = ideal.span {x} :=
+begin
+  letI := classical.dec_eq (ideal R),
+  have hx0 : x ≠ 0,
+  { rintro rfl,
+    exact hxP2 (zero_mem _) },
+  by_cases hP0 : P = ⊥,
+  { unfreezingI { subst hP0 },
+    simpa using hxP2 },
+  have hspan0 : span ({x} : set R) ≠ ⊥ := mt ideal.span_singleton_eq_bot.mp hx0,
+  have span_le := (ideal.span_singleton_le_iff_mem _).mpr x_mem,
+  refine associated_iff_eq.mp
+    ((associated_iff_normalized_factors_eq_normalized_factors hP0 hspan0).mpr
+      (le_antisymm ((dvd_iff_normalized_factors_le_normalized_factors hP0 hspan0).mp _) _)),
+  { rwa [ideal.dvd_iff_le, ideal.span_singleton_le_iff_mem] },
+  simp only [normalized_factors_irreducible ((ideal.prime_of_is_prime hP0 hP).irreducible),
+      normalize_eq, multiset.le_iff_count, multiset.count_singleton],
+  intros Q,
+  split_ifs with hQ,
+  { unfreezingI { subst hQ },
+    refine (ideal.count_normalized_factors_eq _ _).le;
+      simp only [ideal.span_singleton_le_iff_mem, pow_one];
+      assumption },
+  by_cases hQp : is_prime Q,
+  { resetI,
+    refine (ideal.count_normalized_factors_eq _ _).le;
+      simp only [ideal.span_singleton_le_iff_mem, pow_one, pow_zero, one_eq_top, submodule.mem_top],
+    exact hxQ _ hQp hQ },
+  { exact (multiset.count_eq_zero.mpr (λ hQi, hQp (is_prime_of_prime (irreducible_iff_prime.mp
+      (irreducible_of_normalized_factor _ hQi))))).le }
+end
+
+lemma fractional_ideal.is_principal_of_unit_of_comap_mul_span_singleton_eq_top
+  {R A : Type*} [comm_ring R] [comm_ring A] [algebra R A] {S : submonoid R} [is_localization S A]
+  (I : (fractional_ideal S A)ˣ) {v : A} (hv : v ∈ (↑I⁻¹ : fractional_ideal S A))
+  (h : submodule.comap (algebra.linear_map R A) (I * submodule.span R {v}) = ⊤) :
+  submodule.is_principal (I : submodule R A) :=
+begin
+  have hinv := I.mul_inv,
+  set J := submodule.comap (algebra.linear_map R A) (I * submodule.span R {v}),
+  have hJ : is_localization.coe_submodule A J = I * submodule.span R {v},
+  { rw [subtype.ext_iff, fractional_ideal.coe_mul, fractional_ideal.coe_one] at hinv,
+    apply submodule.map_comap_eq_self,
+    rw [← submodule.one_eq_range, ← hinv],
+    exact submodule.mul_le_mul_right ((submodule.span_singleton_le_iff_mem _ _).2 hv) },
+  have : (1 : A) ∈ ↑I * submodule.span R {v},
+  { rw [← hJ, h, is_localization.coe_submodule_top, submodule.mem_one],
+    exact ⟨1, (algebra_map R _).map_one⟩ },
+  obtain ⟨w, hw, hvw⟩ := submodule.mem_mul_span_singleton.1 this,
+  refine ⟨⟨w, _⟩⟩,
+  rw [← fractional_ideal.coe_span_singleton S, ← inv_inv I, eq_comm, coe_coe],
+  refine congr_arg coe (units.eq_inv_of_mul_eq_one_left (le_antisymm _ _)),
+  { apply_instance },
+  { conv_rhs { rw [← hinv, mul_comm] },
+    apply fractional_ideal.mul_le_mul_left (fractional_ideal.span_singleton_le_iff_mem.mpr hw) },
+  { rw [fractional_ideal.one_le, ← hvw, mul_comm],
+    exact fractional_ideal.mul_mem_mul hv (fractional_ideal.mem_span_singleton_self _ _) }
+end
+
+/--
+An invertible fractional ideal of a commutative ring with finitely many maximal ideals is principal.
+
+https://math.stackexchange.com/a/95857 -/
+theorem fractional_ideal.is_principal.of_finite_maximals_of_inv
+  {A : Type*} [comm_ring A] [algebra R A] {S : submonoid R} [is_localization S A]
+  (hS : S ≤ R⁰) (hf : {I : ideal R | I.is_maximal}.finite)
+  (I I' : fractional_ideal S A) (hinv : I * I' = 1) :
+  submodule.is_principal (I : submodule R A) :=
+begin
+  have hinv' := hinv,
+  rw [subtype.ext_iff, fractional_ideal.coe_mul] at hinv,
+  let s := hf.to_finset,
+  haveI := classical.dec_eq (ideal R),
+  have coprime : ∀ (M ∈ s) (M' ∈ s.erase M), M ⊔ M' = ⊤,
+  { simp_rw [finset.mem_erase, hf.mem_to_finset],
+    rintro M hM M' ⟨hne, hM'⟩,
+    exact ideal.is_maximal.coprime_of_ne hM hM' hne.symm },
+  have nle : ∀ M ∈ s, ¬ (⨅ M' ∈ s.erase M, M') ≤ M := λ M hM, left_lt_sup.1
+    ((hf.mem_to_finset.1 hM).ne_top.lt_top.trans_eq (ideal.sup_infi_eq_top $ coprime M hM).symm),
+  have : ∀ M ∈ s, ∃ (a ∈ I) (b ∈ I'), a * b ∉ is_localization.coe_submodule A M,
+  { intros M hM, by_contra' h,
+    obtain ⟨x, hx, hxM⟩ := set_like.exists_of_lt ((is_localization.coe_submodule_strict_mono
+      hS (hf.mem_to_finset.1 hM).ne_top.lt_top).trans_eq hinv.symm),
+    refine hxM (submodule.map₂_le.2 _ hx), exact h },
+  choose! a ha b hb hm using this,
+  choose! u hu hum using λ M hM, set_like.not_le_iff_exists.1 (nle M hM),
+  let v := ∑ M in s, u M • b M,
+  have hv : v ∈ I' := submodule.sum_mem _ (λ M hM, submodule.smul_mem _ _ $ hb M hM),
+  refine fractional_ideal.is_principal_of_unit_of_comap_mul_span_singleton_eq_top
+    (units.mk_of_mul_eq_one I I' hinv') hv (of_not_not $ λ h, _),
+  obtain ⟨M, hM, hJM⟩ := ideal.exists_le_maximal _ h,
+  replace hM := hf.mem_to_finset.2 hM,
+  have : ∀ (a ∈ I) (b ∈ I'), ∃ c, algebra_map R _ c = a * b,
+  { intros a ha b hb, have hi := hinv.le,
+    obtain ⟨c, -, hc⟩ := hi (submodule.mul_mem_mul ha hb),
+    exact ⟨c, hc⟩ },
+  have hmem: a M * v ∈ is_localization.coe_submodule A M,
+  { obtain ⟨c, hc⟩ := this _ (ha M hM) v hv,
+    refine is_localization.coe_submodule_mono _ hJM ⟨c, _, hc⟩,
+    have := submodule.mul_mem_mul (ha M hM) (submodule.mem_span_singleton_self v),
+    rwa ← hc at this },
+  simp_rw [finset.mul_sum, mul_smul_comm] at hmem,
+  rw [← s.add_sum_erase _ hM, submodule.add_mem_iff_left] at hmem,
+  { refine hm M hM _,
+    obtain ⟨c, (hc : algebra_map R A c = a M * b M)⟩ := this _ (ha M hM) _ (hb M hM),
+    rw ← hc at hmem ⊢,
+    rw [algebra.smul_def, ← _root_.map_mul] at hmem,
+    obtain ⟨d, hdM, he⟩ := hmem,
+    rw is_localization.injective _ hS he at hdM,
+    exact submodule.mem_map_of_mem
+      (((hf.mem_to_finset.1 hM).is_prime.mem_or_mem hdM).resolve_left $ hum M hM) },
+  { refine submodule.sum_mem _ (λ M' hM', _),
+    rw finset.mem_erase at hM',
+    obtain ⟨c, hc⟩ := this _ (ha M hM) _ (hb M' hM'.2),
+    rw [← hc, algebra.smul_def, ← _root_.map_mul],
+    specialize hu M' hM'.2,
+    simp_rw [ideal.mem_infi, finset.mem_erase] at hu,
+    exact submodule.mem_map_of_mem (M.mul_mem_right _ $ hu M ⟨hM'.1.symm, hM⟩) },
+end
+
+/-- An invertible ideal in a commutative ring with finitely many maximal ideals is principal.
+
+https://math.stackexchange.com/a/95857 -/
+theorem ideal.is_principal.of_finite_maximals_of_is_unit
+  (hf : {I : ideal R | I.is_maximal}.finite)
+  {I : ideal R} (hI : is_unit (I : fractional_ideal R⁰ (fraction_ring R))) :
+  I.is_principal :=
+(is_localization.coe_submodule_is_principal _ le_rfl).mp
+  (fractional_ideal.is_principal.of_finite_maximals_of_inv le_rfl hf I
+    (↑(hI.unit⁻¹) : fractional_ideal R⁰ (fraction_ring R))
+    hI.unit.mul_inv)
+
+/-- A Dedekind domain is a PID if its set of primes is finite. -/
+theorem is_principal_ideal_ring.of_finite_primes [is_domain R] [is_dedekind_domain R]
+  (h : {I : ideal R | I.is_prime}.finite) :
+  is_principal_ideal_ring R :=
+⟨λ I, begin
+  obtain rfl | hI := eq_or_ne I ⊥,
+  { exact bot_is_principal },
+  apply ideal.is_principal.of_finite_maximals_of_is_unit,
+  { apply h.subset, exact @ideal.is_maximal.is_prime _ _ },
+  { exact is_unit_of_mul_eq_one _ _ (fractional_ideal.coe_ideal_mul_inv I hI) },
+end⟩
+
+variables [is_domain R] [is_dedekind_domain R]
+variables (S : Type*) [comm_ring S] [is_domain S]
+variables [algebra R S] [module.free R S] [module.finite R S]
+variables (p : ideal R) (hp0 : p ≠ ⊥) [is_prime p]
+variables {Sₚ : Type*} [comm_ring Sₚ] [algebra S Sₚ]
+variables [is_localization (algebra.algebra_map_submonoid S p.prime_compl) Sₚ]
+variables [algebra R Sₚ] [is_scalar_tower R S Sₚ]
+/- The first hypothesis below follows from properties of the localization but is needed for the
+second, so we leave it to the user to provide (automatically). -/
+variables [is_domain Sₚ] [is_dedekind_domain Sₚ]
+
+include S hp0
+
+/-- If `p` is a prime in the Dedekind domain `R`, `S` an extension of `R` and `Sₚ` the localization
+of `S` at `p`, then all primes in `Sₚ` are factors of the image of `p` in `Sₚ`. -/
+lemma is_localization.over_prime.mem_normalized_factors_of_is_prime [decidable_eq (ideal Sₚ)]
+  {P : ideal Sₚ} (hP : is_prime P) (hP0 : P ≠ ⊥) :
+  P ∈ normalized_factors (ideal.map (algebra_map R Sₚ) p) :=
+begin
+  have non_zero_div : algebra.algebra_map_submonoid S p.prime_compl ≤ S⁰ :=
+    map_le_non_zero_divisors_of_injective _ (no_zero_smul_divisors.algebra_map_injective _ _)
+      p.prime_compl_le_non_zero_divisors,
+  letI : algebra (localization.at_prime p) Sₚ := localization_algebra p.prime_compl S,
+  haveI : is_scalar_tower R (localization.at_prime p) Sₚ := is_scalar_tower.of_algebra_map_eq
+    (λ x, by erw [is_localization.map_eq, is_scalar_tower.algebra_map_apply R S]),
+  obtain ⟨pid, p', ⟨hp'0, hp'p⟩, hpu⟩ :=
+    (discrete_valuation_ring.iff_pid_with_one_nonzero_prime (localization.at_prime p)).mp
+      (is_localization.at_prime.discrete_valuation_ring_of_dedekind_domain R hp0 _),
+  have : local_ring.maximal_ideal (localization.at_prime p) ≠ ⊥,
+  { rw submodule.ne_bot_iff at ⊢ hp0,
+    obtain ⟨x, x_mem, x_ne⟩ := hp0,
+    exact ⟨algebra_map _ _ x,
+      (is_localization.at_prime.to_map_mem_maximal_iff _ _ _).mpr x_mem,
+      is_localization.to_map_ne_zero_of_mem_non_zero_divisors _ p.prime_compl_le_non_zero_divisors
+        (mem_non_zero_divisors_of_ne_zero x_ne)⟩ },
+  rw [← multiset.singleton_le, ← normalize_eq P,
+      ← normalized_factors_irreducible (ideal.prime_of_is_prime hP0 hP).irreducible,
+      ← dvd_iff_normalized_factors_le_normalized_factors hP0, dvd_iff_le,
+      is_scalar_tower.algebra_map_eq R (localization.at_prime p) Sₚ, ← ideal.map_map,
+      localization.at_prime.map_eq_maximal_ideal, ideal.map_le_iff_le_comap,
+      hpu (local_ring.maximal_ideal _) ⟨this, _⟩, hpu (comap _ _) ⟨_, _⟩],
+  { exact le_rfl },
+  { have hRS : algebra.is_integral R S := is_integral_of_noetherian
+      (is_noetherian_of_fg_of_noetherian' module.finite.out),
+    exact mt (ideal.eq_bot_of_comap_eq_bot (is_integral_localization hRS)) hP0 },
+  { exact ideal.comap_is_prime (algebra_map (localization.at_prime p) Sₚ) P },
+  { exact (local_ring.maximal_ideal.is_maximal _).is_prime },
+  { rw [ne.def, zero_eq_bot, ideal.map_eq_bot_iff_of_injective],
+    { assumption },
+    rw is_scalar_tower.algebra_map_eq R S Sₚ,
+    exact (is_localization.injective Sₚ non_zero_div).comp
+      (no_zero_smul_divisors.algebra_map_injective _ _) },
+end
+
+/-- Let `p` be a prime in the Dedekind domain `R` and `S` be an integral extension of `R`,
+then the localization `Sₚ` of `S` at `p` is a PID. -/
+theorem is_dedekind_domain.is_principal_ideal_ring_localization_over_prime :
+  is_principal_ideal_ring Sₚ :=
+begin
+  letI := classical.dec_eq (ideal Sₚ),
+  letI := classical.dec_pred (λ (P : ideal Sₚ), P.is_prime),
+  refine is_principal_ideal_ring.of_finite_primes
+    (set.finite.of_finset (finset.filter (λ P, P.is_prime)
+      ({⊥} ∪ (normalized_factors (ideal.map (algebra_map R Sₚ) p)).to_finset))
+      (λ P, _)),
+  rw [finset.mem_filter, finset.mem_union, finset.mem_singleton, set.mem_set_of,
+      multiset.mem_to_finset],
+  exact and_iff_right_of_imp (λ hP, or_iff_not_imp_left.mpr
+    (is_localization.over_prime.mem_normalized_factors_of_is_prime S p hp0 hP))
+end
diff --git a/src/ring_theory/dedekind_domain/selmer_group.lean b/src/ring_theory/dedekind_domain/selmer_group.lean
new file mode 100644
index 0000000000000..adcbbfc9e1fb3
--- /dev/null
+++ b/src/ring_theory/dedekind_domain/selmer_group.lean
@@ -0,0 +1,227 @@
+/-
+Copyright (c) 2022 David Kurniadi Angdinata. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: David Kurniadi Angdinata
+-/
+import algebra.hom.equiv.type_tags
+import data.zmod.quotient
+import ring_theory.dedekind_domain.adic_valuation
+import ring_theory.norm
+
+/-!
+# Selmer groups of fraction fields of Dedekind domains
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let $K$ be the field of fractions of a Dedekind domain $R$. For any set $S$ of prime ideals in the
+height one spectrum of $R$, and for any natural number $n$, the Selmer group $K(S, n)$ is defined to
+be the subgroup of the unit group $K^\times$ modulo $n$-th powers where each element has $v$-adic
+valuation divisible by $n$ for all prime ideals $v$ away from $S$. In other words, this is precisely
+$$ K(S, n) := \{x(K^\times)^n \in K^\times / (K^\times)^n \ \mid \
+                \forall v \notin S, \ \mathrm{ord}_v(x) \equiv 0 \pmod n\}. $$
+
+There is a fundamental short exact sequence
+$$ 1 \to R_S^\times / (R_S^\times)^n \to K(S, n) \to \mathrm{Cl}_S(R)[n] \to 0, $$
+where $R_S^\times$ is the $S$-unit group of $R$ and $\mathrm{Cl}_S(R)$ is the $S$-class group of
+$R$. If the flanking groups are both finite, then $K(S, n)$ is finite by the first isomorphism
+theorem. Such is the case when $R$ is the ring of integers of a number field $K$, $S$ is finite, and
+$n$ is positive, in which case $R_S^\times$ is finitely generated by Dirichlet's unit theorem and
+$\mathrm{Cl}_S(R)$ is finite by the class number theorem.
+
+This file defines the Selmer group $K(S, n)$ and some basic facts.
+
+## Main definitions
+
+ * `is_dedekind_domain.selmer_group`: the Selmer group.
+ * TODO: maps in the sequence.
+
+## Main statements
+
+ * TODO: proofs of exactness of the sequence.
+ * TODO: proofs of finiteness for global fields.
+
+## Notations
+
+ * `K⟮S, n⟯`: the Selmer group with parameters `K`, `S`, and `n`.
+
+## Implementation notes
+
+The Selmer group is typically defined as a subgroup of the Galois cohomology group $H^1(K, \mu_n)$
+with certain local conditions defined by $v$-adic valuations, where $\mu_n$ is the group of $n$-th
+roots of unity over a separable closure of $K$. Here $H^1(K, \mu_n)$ is identified with
+$K^\times / (K^\times)^n$ by the long exact sequence from Kummer theory and Hilbert's theorem 90,
+and the fundamental short exact sequence becomes an easy consequence of the snake lemma. This file
+will define all the maps explicitly for computational purposes, but isomorphisms to the Galois
+cohomological definition will be provided when possible.
+
+## References
+
+https://doc.sagemath.org/html/en/reference/number_fields/sage/rings/number_field/selmer_group.html
+
+## Tags
+
+class group, selmer group, unit group
+-/
+
+local notation (name := quot) K/n := Kˣ ⧸ (pow_monoid_hom n : Kˣ →* Kˣ).range
+
+namespace is_dedekind_domain
+
+noncomputable theory
+
+open_locale classical discrete_valuation non_zero_divisors
+
+universes u v
+
+variables {R : Type u} [comm_ring R] [is_domain R] [is_dedekind_domain R] {K : Type v} [field K]
+  [algebra R K] [is_fraction_ring R K] (v : height_one_spectrum R)
+
+/-! ### Valuations of non-zero elements -/
+
+namespace height_one_spectrum
+
+/-- The multiplicative `v`-adic valuation on `Kˣ`. -/
+def valuation_of_ne_zero_to_fun (x : Kˣ) : multiplicative ℤ :=
+let hx := is_localization.sec R⁰ (x : K) in multiplicative.of_add $
+  (-(associates.mk v.as_ideal).count (associates.mk $ ideal.span {hx.fst}).factors : ℤ)
+  - (-(associates.mk v.as_ideal).count (associates.mk $ ideal.span {(hx.snd : R)}).factors : ℤ)
+
+@[simp] lemma valuation_of_ne_zero_to_fun_eq (x : Kˣ) :
+  (v.valuation_of_ne_zero_to_fun x : ℤₘ₀) = v.valuation (x : K) :=
+begin
+  change _ = _ * _,
+  rw [units.coe_inv],
+  change _ = ite _ _ _ * (ite (coe _ = _) _ _)⁻¹,
+  rw [is_localization.to_localization_map_sec,
+      if_neg $ is_localization.sec_fst_ne_zero le_rfl x.ne_zero,
+      if_neg $ non_zero_divisors.coe_ne_zero _],
+  any_goals { exact is_domain.to_nontrivial R },
+  refl
+end
+
+/-- The multiplicative `v`-adic valuation on `Kˣ`. -/
+def valuation_of_ne_zero : Kˣ →* multiplicative ℤ :=
+{ to_fun   := v.valuation_of_ne_zero_to_fun,
+  map_one' := by { rw [← with_zero.coe_inj, valuation_of_ne_zero_to_fun_eq], exact map_one _ },
+  map_mul' := λ _ _, by { rw [← with_zero.coe_inj, with_zero.coe_mul],
+                          simp only [valuation_of_ne_zero_to_fun_eq], exact map_mul _ _ _ } }
+
+@[simp] lemma valuation_of_ne_zero_eq (x : Kˣ) :
+  (v.valuation_of_ne_zero x : ℤₘ₀) = v.valuation (x : K) :=
+valuation_of_ne_zero_to_fun_eq v x
+
+@[simp] lemma valuation_of_unit_eq (x : Rˣ) :
+  v.valuation_of_ne_zero (units.map (algebra_map R K : R →* K) x) = 1 :=
+begin
+  rw [← with_zero.coe_inj, valuation_of_ne_zero_eq, units.coe_map, eq_iff_le_not_lt],
+  split,
+  { exact v.valuation_le_one x },
+  { cases x with x _ hx _,
+    change ¬v.valuation (algebra_map R K x) < 1,
+    apply_fun v.int_valuation at hx,
+    rw [map_one, map_mul] at hx,
+    rw [not_lt, ← hx, ← mul_one $ v.valuation _, valuation_of_algebra_map,
+        mul_le_mul_left₀ $ left_ne_zero_of_mul_eq_one hx],
+    exact v.int_valuation_le_one _ }
+end
+
+local attribute [semireducible] mul_opposite
+
+/-- The multiplicative `v`-adic valuation on `Kˣ` modulo `n`-th powers. -/
+def valuation_of_ne_zero_mod (n : ℕ) : K/n →* multiplicative (zmod n) :=
+(int.quotient_zmultiples_nat_equiv_zmod n).to_multiplicative.to_monoid_hom.comp $
+  quotient_group.map (pow_monoid_hom n : Kˣ →* Kˣ).range
+  (add_subgroup.zmultiples (n : ℤ)).to_subgroup v.valuation_of_ne_zero
+begin
+  rintro _ ⟨x, rfl⟩,
+  exact ⟨v.valuation_of_ne_zero x, by simpa only [pow_monoid_hom_apply, map_pow, int.to_add_pow]⟩
+end
+
+@[simp] lemma valuation_of_unit_mod_eq (n : ℕ) (x : Rˣ) :
+  v.valuation_of_ne_zero_mod n (units.map (algebra_map R K : R →* K) x : K/n) = 1 :=
+by rw [valuation_of_ne_zero_mod, monoid_hom.comp_apply, ← quotient_group.coe_mk',
+       quotient_group.map_mk', valuation_of_unit_eq, quotient_group.coe_one, map_one]
+
+end height_one_spectrum
+
+/-! ### Selmer groups -/
+
+variables {S S' : set $ height_one_spectrum R} {n : ℕ}
+
+/-- The Selmer group `K⟮S, n⟯`. -/
+def selmer_group : subgroup $ K/n :=
+{ carrier  := {x : K/n | ∀ v ∉ S, (v : height_one_spectrum R).valuation_of_ne_zero_mod n x = 1},
+  one_mem' := λ _ _, by rw [map_one],
+  mul_mem' := λ _ _ hx hy v hv, by rw [map_mul, hx v hv, hy v hv, one_mul],
+  inv_mem' := λ _ hx v hv, by rw [map_inv, hx v hv, inv_one] }
+
+localized "notation K`⟮`S, n`⟯` := @selmer_group _ _ _ _ K _ _ _ S n" in selmer_group
+
+namespace selmer_group
+
+lemma monotone (hS : S ≤ S') : K⟮S, n⟯ ≤ (K⟮S', n⟯) := λ _ hx v, hx v ∘ mt (@hS v)
+
+/-- The multiplicative `v`-adic valuations on `K⟮S, n⟯` for all `v ∈ S`. -/
+def valuation : K⟮S, n⟯ →* S → multiplicative (zmod n) :=
+{ to_fun   := λ x v, (v : height_one_spectrum R).valuation_of_ne_zero_mod n (x : K/n),
+  map_one' := funext $ λ v, map_one _,
+  map_mul' := λ x y, funext $ λ v, map_mul _ x y }
+
+lemma valuation_ker_eq :
+  valuation.ker = (K⟮(∅ : set $ height_one_spectrum R), n⟯).subgroup_of (K⟮S, n⟯) :=
+begin
+  ext ⟨_, hx⟩,
+  split,
+  { intros hx' v _,
+    by_cases hv : v ∈ S,
+    { exact congr_fun hx' ⟨v, hv⟩ },
+    { exact hx v hv } },
+  { exact λ hx', funext $ λ v, hx' v $ set.not_mem_empty v }
+end
+
+/-- The natural homomorphism from `Rˣ` to `K⟮∅, n⟯`. -/
+def from_unit {n : ℕ} : Rˣ →* K⟮(∅ : set $ height_one_spectrum R), n⟯ :=
+{ to_fun   := λ x, ⟨quotient_group.mk $ units.map (algebra_map R K).to_monoid_hom x,
+                    λ v _, v.valuation_of_unit_mod_eq n x⟩,
+  map_one' := by simpa only [map_one],
+  map_mul' := λ _ _, by simpa only [map_mul] }
+
+lemma from_unit_ker [hn : fact $ 0 < n] :
+  (@from_unit R _ _ _ K _ _ _ n).ker = (pow_monoid_hom n : Rˣ →* Rˣ).range :=
+begin
+  ext ⟨_, _, _, _⟩,
+  split,
+  { intro hx,
+    rcases (quotient_group.eq_one_iff _).mp (subtype.mk.inj hx) with ⟨⟨v, i, vi, iv⟩, hx⟩,
+    have hv : ↑(_ ^ n : Kˣ) = algebra_map R K _ := congr_arg units.val hx,
+    have hi : ↑(_ ^ n : Kˣ)⁻¹ = algebra_map R K _ := congr_arg units.inv hx,
+    rw [units.coe_pow] at hv,
+    rw [← inv_pow, units.inv_mk, units.coe_pow] at hi,
+    rcases @is_integrally_closed.exists_algebra_map_eq_of_is_integral_pow R _ _ _ _ _ _ _ v _
+      hn.out (hv.symm ▸ is_integral_algebra_map) with ⟨v', rfl⟩,
+    rcases @is_integrally_closed.exists_algebra_map_eq_of_is_integral_pow R _ _ _ _ _ _ _ i _
+      hn.out (hi.symm ▸ is_integral_algebra_map) with ⟨i', rfl⟩,
+    rw [← map_mul, map_eq_one_iff _ $ no_zero_smul_divisors.algebra_map_injective R K] at vi,
+    rw [← map_mul, map_eq_one_iff _ $ no_zero_smul_divisors.algebra_map_injective R K] at iv,
+    rw [units.coe_mk, ← map_pow] at hv,
+    exact ⟨⟨v', i', vi, iv⟩, by simpa only [units.ext_iff, pow_monoid_hom_apply, units.coe_pow]
+                               using no_zero_smul_divisors.algebra_map_injective R K hv⟩ },
+  { rintro ⟨_, hx⟩,
+    rw [← hx],
+    exact subtype.mk_eq_mk.mpr
+      ((quotient_group.eq_one_iff _).mpr ⟨_, by simp only [pow_monoid_hom_apply, map_pow]⟩) }
+end
+
+/-- The injection induced by the natural homomorphism from `Rˣ` to `K⟮∅, n⟯`. -/
+def from_unit_lift [fact $ 0 < n] : R/n →* K⟮(∅ : set $ height_one_spectrum R), n⟯ :=
+(quotient_group.ker_lift _).comp
+  (quotient_group.quotient_mul_equiv_of_eq from_unit_ker).symm.to_monoid_hom
+
+lemma from_unit_lift_injective [fact $ 0 < n] :
+  function.injective $ @from_unit_lift R _ _ _ K _ _ _ n _ :=
+function.injective.comp (quotient_group.ker_lift_injective _) (mul_equiv.injective _)
+
+end selmer_group
+
+end is_dedekind_domain
diff --git a/src/ring_theory/derivation.lean b/src/ring_theory/derivation.lean
deleted file mode 100644
index f9938fbe18b51..0000000000000
--- a/src/ring_theory/derivation.lean
+++ /dev/null
@@ -1,335 +0,0 @@
-/-
-Copyright © 2020 Nicolò Cavalleri. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Nicolò Cavalleri
--/
-
-import ring_theory.adjoin.basic
-import algebra.lie.of_associative
-
-/-!
-# Derivations
-
-This file defines derivation. A derivation `D` from the `R`-algebra `A` to the `A`-module `M` is an
-`R`-linear map that satisfy the Leibniz rule `D (a * b) = a * D b + D a * b`.
-
-## Notation
-
-The notation `⁅D1, D2⁆` is used for the commutator of two derivations.
-
-TODO: this file is just a stub to go on with some PRs in the geometry section. It only
-implements the definition of derivations in commutative algebra. This will soon change: as soon
-as bimodules will be there in mathlib I will change this file to take into account the
-non-commutative case. Any development on the theory of derivations is discouraged until the
-definitive definition of derivation will be implemented.
--/
-
-open algebra
-open_locale big_operators
-
-/-- `D : derivation R A M` is an `R`-linear map from `A` to `M` that satisfies the `leibniz`
-equality. We also require that `D 1 = 0`. See `derivation.mk'` for a constructor that deduces this
-assumption from the Leibniz rule when `M` is cancellative.
-
-TODO: update this when bimodules are defined. -/
-@[protect_proj]
-structure derivation (R : Type*) (A : Type*) [comm_semiring R] [comm_semiring A]
-  [algebra R A] (M : Type*) [add_comm_monoid M] [module A M] [module R M]
-  extends A →ₗ[R] M :=
-(map_one_eq_zero' : to_linear_map 1 = 0)
-(leibniz' (a b : A) : to_linear_map (a * b) = a • to_linear_map b + b • to_linear_map a)
-
-/-- The `linear_map` underlying a `derivation`. -/
-add_decl_doc derivation.to_linear_map
-
-namespace derivation
-
-section
-
-variables {R : Type*} [comm_semiring R]
-variables {A : Type*} [comm_semiring A] [algebra R A]
-variables {M : Type*} [add_comm_monoid M] [module A M] [module R M]
-variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)
-
-instance : add_monoid_hom_class (derivation R A M) A M :=
-{ coe := λ D, D.to_fun,
-  coe_injective' := λ D1 D2 h, by { cases D1, cases D2, congr, exact fun_like.coe_injective h },
-  map_add := λ D, D.to_linear_map.map_add',
-  map_zero := λ D, D.to_linear_map.map_zero }
-
-/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
-directly. -/
-instance : has_coe_to_fun (derivation R A M) (λ _, A → M) := ⟨λ D, D.to_linear_map.to_fun⟩
-
--- Not a simp lemma because it can be proved via `coe_fn_coe` + `to_linear_map_eq_coe`
-lemma to_fun_eq_coe : D.to_fun = ⇑D := rfl
-
-instance has_coe_to_linear_map : has_coe (derivation R A M) (A →ₗ[R] M) :=
-⟨λ D, D.to_linear_map⟩
-
-@[simp] lemma to_linear_map_eq_coe : D.to_linear_map = D := rfl
-
-@[simp] lemma mk_coe (f : A →ₗ[R] M) (h₁ h₂) :
-  ((⟨f, h₁, h₂⟩ : derivation R A M) : A → M) = f := rfl
-
-@[simp, norm_cast]
-lemma coe_fn_coe (f : derivation R A M) : ⇑(f : A →ₗ[R] M) = f := rfl
-
-lemma coe_injective : @function.injective (derivation R A M) (A → M) coe_fn :=
-fun_like.coe_injective
-
-@[ext] theorem ext (H : ∀ a, D1 a = D2 a) : D1 = D2 :=
-fun_like.ext _ _ H
-
-lemma congr_fun (h : D1 = D2) (a : A) : D1 a = D2 a := fun_like.congr_fun h a
-
-protected lemma map_add : D (a + b) = D a + D b := map_add D a b
-protected lemma map_zero : D 0 = 0 := map_zero D
-@[simp] lemma map_smul : D (r • a) = r • D a := D.to_linear_map.map_smul r a
-@[simp] lemma leibniz : D (a * b) = a • D b + b • D a := D.leibniz' _ _
-
-lemma map_sum {ι : Type*} (s : finset ι) (f : ι → A) : D (∑ i in s, f i) = ∑ i in s, D (f i) :=
-D.to_linear_map.map_sum
-
-@[simp, priority 900] lemma map_smul_of_tower {S : Type*} [has_scalar S A] [has_scalar S M]
-  [linear_map.compatible_smul A M S R] (D : derivation R A M) (r : S) (a : A) :
-  D (r • a) = r • D a :=
-D.to_linear_map.map_smul_of_tower r a
-
-@[simp] lemma map_one_eq_zero : D 1 = 0 := D.map_one_eq_zero'
-
-@[simp] lemma map_algebra_map : D (algebra_map R A r) = 0 :=
-by rw [←mul_one r, ring_hom.map_mul, ring_hom.map_one, ←smul_def, map_smul, map_one_eq_zero,
-  smul_zero]
-
-@[simp] lemma map_coe_nat (n : ℕ) : D (n : A) = 0 :=
-by rw [← nsmul_one, D.map_smul_of_tower n, map_one_eq_zero, smul_zero]
-
-@[simp] lemma leibniz_pow (n : ℕ) : D (a ^ n) = n • a ^ (n - 1) • D a :=
-begin
-  induction n with n ihn,
-  { rw [pow_zero, map_one_eq_zero, zero_smul] },
-  { rcases (zero_le n).eq_or_lt with (rfl|hpos),
-    { rw [pow_one, one_smul, pow_zero, one_smul] },
-    { have : a * a ^ (n - 1) = a ^ n, by rw [← pow_succ, nat.sub_add_cancel hpos],
-      simp only [pow_succ, leibniz, ihn, smul_comm a n, smul_smul a, add_smul, this,
-        nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, one_nsmul] } }
-end
-
-lemma eq_on_adjoin {s : set A} (h : set.eq_on D1 D2 s) : set.eq_on D1 D2 (adjoin R s) :=
-λ x hx, algebra.adjoin_induction hx h
-  (λ r, (D1.map_algebra_map r).trans (D2.map_algebra_map r).symm)
-  (λ x y hx hy, by simp only [map_add, *])
-  (λ x y hx hy, by simp only [leibniz, *])
-
-/-- If adjoin of a set is the whole algebra, then any two derivations equal on this set are equal
-on the whole algebra. -/
-lemma ext_of_adjoin_eq_top (s : set A) (hs : adjoin R s = ⊤) (h : set.eq_on D1 D2 s) : D1 = D2 :=
-ext $ λ a, eq_on_adjoin h $ hs.symm ▸ trivial
-
-/- Data typeclasses -/
-
-instance : has_zero (derivation R A M) :=
-⟨{ to_linear_map := 0,
-   map_one_eq_zero' := rfl,
-   leibniz' := λ a b, by simp only [add_zero, linear_map.zero_apply, smul_zero] }⟩
-
-@[simp] lemma coe_zero : ⇑(0 : derivation R A M) = 0 := rfl
-@[simp] lemma coe_zero_linear_map : ↑(0 : derivation R A M) = (0 : A →ₗ[R] M) := rfl
-lemma zero_apply (a : A) : (0 : derivation R A M) a = 0 := rfl
-
-instance : has_add (derivation R A M) :=
-⟨λ D1 D2,
-  { to_linear_map := D1 + D2,
-    map_one_eq_zero' := by simp,
-    leibniz' := λ a b, by simp only [leibniz, linear_map.add_apply,
-      coe_fn_coe, smul_add, add_add_add_comm] }⟩
-
-@[simp] lemma coe_add (D1 D2 : derivation R A M) : ⇑(D1 + D2) = D1 + D2 := rfl
-@[simp] lemma coe_add_linear_map (D1 D2 : derivation R A M) : ↑(D1 + D2) = (D1 + D2 : A →ₗ[R] M) :=
-rfl
-lemma add_apply : (D1 + D2) a = D1 a + D2 a := rfl
-
-instance : inhabited (derivation R A M) := ⟨0⟩
-
-section scalar
-
-variables {S : Type*} [monoid S] [distrib_mul_action S M] [smul_comm_class R S M]
-  [smul_comm_class S A M]
-
-@[priority 100]
-instance : has_scalar S (derivation R A M) :=
-⟨λ r D,
-  { to_linear_map := r • D,
-    map_one_eq_zero' := by rw [linear_map.smul_apply, coe_fn_coe, D.map_one_eq_zero, smul_zero],
-    leibniz' := λ a b, by simp only [linear_map.smul_apply, coe_fn_coe, leibniz, smul_add,
-      smul_comm r] }⟩
-
-@[simp] lemma coe_smul (r : S) (D : derivation R A M) : ⇑(r • D) = r • D := rfl
-@[simp] lemma coe_smul_linear_map (r : S) (D : derivation R A M) :
-  ↑(r • D) = (r • D : A →ₗ[R] M) := rfl
-lemma smul_apply (r : S) (D : derivation R A M) : (r • D) a = r • D a := rfl
-
-instance : add_comm_monoid (derivation R A M) :=
-coe_injective.add_comm_monoid _ coe_zero coe_add (λ _ _, rfl)
-
-/-- `coe_fn` as an `add_monoid_hom`. -/
-def coe_fn_add_monoid_hom : derivation R A M →+ (A → M) :=
-{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add }
-
-@[priority 100]
-instance : distrib_mul_action S (derivation R A M) :=
-function.injective.distrib_mul_action coe_fn_add_monoid_hom coe_injective coe_smul
-
-instance [distrib_mul_action Sᵐᵒᵖ M] [is_central_scalar S M] :
-  is_central_scalar S (derivation R A M) :=
-{ op_smul_eq_smul := λ _ _, ext $ λ _, op_smul_eq_smul _ _}
-
-end scalar
-
-@[priority 100]
-instance {S : Type*} [semiring S] [module S M] [smul_comm_class R S M] [smul_comm_class S A M] :
-  module S (derivation R A M) :=
-function.injective.module S coe_fn_add_monoid_hom coe_injective coe_smul
-
-instance [is_scalar_tower R A M] : is_scalar_tower R A (derivation R A M) :=
-⟨λ x y z, ext (λ a, smul_assoc _ _ _)⟩
-
-section push_forward
-
-variables {N : Type*} [add_comm_monoid N] [module A N] [module R N] [is_scalar_tower R A M]
-  [is_scalar_tower R A N]
-variables (f : M →ₗ[A] N)
-
-/-- We can push forward derivations using linear maps, i.e., the composition of a derivation with a
-linear map is a derivation. Furthermore, this operation is linear on the spaces of derivations. -/
-def _root_.linear_map.comp_der : derivation R A M →ₗ[R] derivation R A N :=
-{ to_fun    := λ D,
-  { to_linear_map := (f : M →ₗ[R] N).comp (D : A →ₗ[R] M),
-    map_one_eq_zero' := by simp only [linear_map.comp_apply, coe_fn_coe, map_one_eq_zero, map_zero],
-    leibniz'  := λ a b, by simp only [coe_fn_coe, linear_map.comp_apply, linear_map.map_add,
-      leibniz, linear_map.coe_coe_is_scalar_tower, linear_map.map_smul] },
-  map_add'  := λ D₁ D₂, by { ext, exact linear_map.map_add _ _ _, },
-  map_smul' := λ r D, by { ext, exact linear_map.map_smul _ _ _, }, }
-
-@[simp] lemma coe_to_linear_map_comp :
-  (f.comp_der D : A →ₗ[R] N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
-rfl
-
-@[simp] lemma coe_comp :
-  (f.comp_der D : A → N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
-rfl
-
-end push_forward
-
-end
-
-section cancel
-
-variables {R : Type*} [comm_semiring R] {A : Type*} [comm_semiring A] [algebra R A]
-  {M : Type*} [add_cancel_comm_monoid M] [module R M] [module A M]
-
-/-- Define `derivation R A M` from a linear map when `M` is cancellative by verifying the Leibniz
-rule. -/
-def mk' (D : A →ₗ[R] M) (h : ∀ a b, D (a * b) = a • D b + b • D a) : derivation R A M :=
-{ to_linear_map := D,
-  map_one_eq_zero' := add_right_eq_self.1 $ by simpa only [one_smul, one_mul] using (h 1 1).symm,
-  leibniz' := h }
-
-@[simp] lemma coe_mk' (D : A →ₗ[R] M) (h) : ⇑(mk' D h) = D := rfl
-@[simp] lemma coe_mk'_linear_map (D : A →ₗ[R] M) (h) : (mk' D h : A →ₗ[R] M) = D := rfl
-
-end cancel
-
-section
-
-variables {R : Type*} [comm_ring R]
-variables {A : Type*} [comm_ring A] [algebra R A]
-
-section
-
-variables {M : Type*} [add_comm_group M] [module A M] [module R M]
-variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)
-
-protected lemma map_neg : D (-a) = -D a := map_neg D a
-protected lemma map_sub : D (a - b) = D a - D b := map_sub D a b
-
-@[simp] lemma map_coe_int (n : ℤ) : D (n : A) = 0 :=
-by rw [← zsmul_one, D.map_smul_of_tower n, map_one_eq_zero, smul_zero]
-
-lemma leibniz_of_mul_eq_one {a b : A} (h : a * b = 1) : D a = -a^2 • D b :=
-begin
-  rw neg_smul,
-  refine eq_neg_of_add_eq_zero _,
-  calc D a + a ^ 2 • D b = a • b • D a + a • a • D b : by simp only [smul_smul, h, one_smul, sq]
-                     ... = a • D (a * b)             : by rw [leibniz, smul_add, add_comm]
-                     ... = 0                         : by rw [h, map_one_eq_zero, smul_zero]
-end
-
-lemma leibniz_inv_of [invertible a] : D (⅟a) = -⅟a^2 • D a :=
-D.leibniz_of_mul_eq_one $ inv_of_mul_self a
-
-lemma leibniz_inv {K : Type*} [field K] [module K M] [algebra R K] (D : derivation R K M) (a : K) :
-  D (a⁻¹) = -a⁻¹ ^ 2 • D a :=
-begin
-  rcases eq_or_ne a 0 with (rfl|ha),
-  { simp },
-  { exact D.leibniz_of_mul_eq_one (inv_mul_cancel ha) }
-end
-
-instance : has_neg (derivation R A M) :=
-⟨λ D, mk' (-D) $  λ a b,
-  by simp only [linear_map.neg_apply, smul_neg, neg_add_rev, leibniz, coe_fn_coe, add_comm]⟩
-
-@[simp] lemma coe_neg (D : derivation R A M) : ⇑(-D) = -D := rfl
-@[simp] lemma coe_neg_linear_map (D : derivation R A M) : ↑(-D) = (-D : A →ₗ[R] M) :=
-rfl
-lemma neg_apply : (-D) a = -D a := rfl
-
-instance : has_sub (derivation R A M) :=
-⟨λ D1 D2, mk' (D1 - D2 : A →ₗ[R] M) $ λ a b,
-  by simp only [linear_map.sub_apply, leibniz, coe_fn_coe, smul_sub, add_sub_comm]⟩
-
-@[simp] lemma coe_sub (D1 D2 : derivation R A M) : ⇑(D1 - D2) = D1 - D2 := rfl
-@[simp] lemma coe_sub_linear_map (D1 D2 : derivation R A M) : ↑(D1 - D2) = (D1 - D2 : A →ₗ[R] M) :=
-rfl
-lemma sub_apply : (D1 - D2) a = D1 a - D2 a := rfl
-
-instance : add_comm_group (derivation R A M) :=
-coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)
-
-end
-
-section lie_structures
-
-/-! # Lie structures -/
-
-variables (D : derivation R A A) {D1 D2 : derivation R A A} (r : R) (a b : A)
-
-/-- The commutator of derivations is again a derivation. -/
-instance : has_bracket (derivation R A A) (derivation R A A) :=
-⟨λ D1 D2, mk' (⁅(D1 : module.End R A), (D2 : module.End R A)⁆) $ λ a b,
-  by { simp only [ring.lie_def, map_add, id.smul_eq_mul, linear_map.mul_apply, leibniz, coe_fn_coe,
-    linear_map.sub_apply], ring, }⟩
-
-@[simp] lemma commutator_coe_linear_map :
-  ↑⁅D1, D2⁆ = ⁅(D1 : module.End R A), (D2 : module.End R A)⁆ := rfl
-
-lemma commutator_apply : ⁅D1, D2⁆ a = D1 (D2 a) - D2 (D1 a) := rfl
-
-instance : lie_ring (derivation R A A) :=
-{ add_lie     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
-  lie_add     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
-  lie_self    := λ d, by { ext a, simp only [commutator_apply, add_apply, map_add], ring_nf, },
-  leibniz_lie := λ d e f,
-    by { ext a, simp only [commutator_apply, add_apply, sub_apply, map_sub], ring, } }
-
-instance : lie_algebra R (derivation R A A) :=
-{ lie_smul := λ r d e, by { ext a, simp only [commutator_apply, map_smul, smul_sub, smul_apply]},
-  ..derivation.module }
-
-end lie_structures
-
-end
-
-end derivation
diff --git a/src/ring_theory/derivation/basic.lean b/src/ring_theory/derivation/basic.lean
new file mode 100644
index 0000000000000..95a1d1ed3e837
--- /dev/null
+++ b/src/ring_theory/derivation/basic.lean
@@ -0,0 +1,351 @@
+/-
+Copyright © 2020 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Andrew Yang
+-/
+
+import ring_theory.adjoin.basic
+
+/-!
+# Derivations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines derivation. A derivation `D` from the `R`-algebra `A` to the `A`-module `M` is an
+`R`-linear map that satisfy the Leibniz rule `D (a * b) = a * D b + D a * b`.
+
+## Main results
+
+- `derivation`: The type of `R`-derivations from `A` to `M`. This has an `A`-module structure.
+- `derivation.llcomp`: We may compose linear maps and derivations to obtain a derivation,
+  and the composition is bilinear.
+
+See `ring_theory.derivation.lie` for
+- `derivation.lie_algebra`: The `R`-derivations from `A` to `A` form an lie algebra over `R`.
+
+and `ring_theory.derivation.to_square_zero` for
+- `derivation_to_square_zero_equiv_lift`: The `R`-derivations from `A` into a square-zero ideal `I`
+  of `B` corresponds to the lifts `A →ₐ[R] B` of the map `A →ₐ[R] B ⧸ I`.
+
+## Future project
+
+- Generalize derivations into bimodules.
+
+-/
+
+open algebra
+open_locale big_operators
+
+/-- `D : derivation R A M` is an `R`-linear map from `A` to `M` that satisfies the `leibniz`
+equality. We also require that `D 1 = 0`. See `derivation.mk'` for a constructor that deduces this
+assumption from the Leibniz rule when `M` is cancellative.
+
+TODO: update this when bimodules are defined. -/
+@[protect_proj]
+structure derivation (R : Type*) (A : Type*) [comm_semiring R] [comm_semiring A]
+  [algebra R A] (M : Type*) [add_comm_monoid M] [module A M] [module R M]
+  extends A →ₗ[R] M :=
+(map_one_eq_zero' : to_linear_map 1 = 0)
+(leibniz' (a b : A) : to_linear_map (a * b) = a • to_linear_map b + b • to_linear_map a)
+
+/-- The `linear_map` underlying a `derivation`. -/
+add_decl_doc derivation.to_linear_map
+
+namespace derivation
+
+section
+
+variables {R : Type*} [comm_semiring R]
+variables {A : Type*} [comm_semiring A] [algebra R A]
+variables {M : Type*} [add_comm_monoid M] [module A M] [module R M]
+variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)
+
+instance : add_monoid_hom_class (derivation R A M) A M :=
+{ coe := λ D, D.to_fun,
+  coe_injective' := λ D1 D2 h, by { cases D1, cases D2, congr, exact fun_like.coe_injective h },
+  map_add := λ D, D.to_linear_map.map_add',
+  map_zero := λ D, D.to_linear_map.map_zero }
+
+/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
+directly. -/
+instance : has_coe_to_fun (derivation R A M) (λ _, A → M) := ⟨λ D, D.to_linear_map.to_fun⟩
+
+-- Not a simp lemma because it can be proved via `coe_fn_coe` + `to_linear_map_eq_coe`
+lemma to_fun_eq_coe : D.to_fun = ⇑D := rfl
+
+instance has_coe_to_linear_map : has_coe (derivation R A M) (A →ₗ[R] M) :=
+⟨λ D, D.to_linear_map⟩
+
+@[simp] lemma to_linear_map_eq_coe : D.to_linear_map = D := rfl
+
+@[simp] lemma mk_coe (f : A →ₗ[R] M) (h₁ h₂) :
+  ((⟨f, h₁, h₂⟩ : derivation R A M) : A → M) = f := rfl
+
+@[simp, norm_cast]
+lemma coe_fn_coe (f : derivation R A M) : ⇑(f : A →ₗ[R] M) = f := rfl
+
+lemma coe_injective : @function.injective (derivation R A M) (A → M) coe_fn :=
+fun_like.coe_injective
+
+@[ext] theorem ext (H : ∀ a, D1 a = D2 a) : D1 = D2 :=
+fun_like.ext _ _ H
+
+lemma congr_fun (h : D1 = D2) (a : A) : D1 a = D2 a := fun_like.congr_fun h a
+
+protected lemma map_add : D (a + b) = D a + D b := map_add D a b
+protected lemma map_zero : D 0 = 0 := map_zero D
+@[simp] lemma map_smul : D (r • a) = r • D a := D.to_linear_map.map_smul r a
+@[simp] lemma leibniz : D (a * b) = a • D b + b • D a := D.leibniz' _ _
+
+lemma map_sum {ι : Type*} (s : finset ι) (f : ι → A) : D (∑ i in s, f i) = ∑ i in s, D (f i) :=
+D.to_linear_map.map_sum
+
+@[simp, priority 900] lemma map_smul_of_tower {S : Type*} [has_smul S A] [has_smul S M]
+  [linear_map.compatible_smul A M S R] (D : derivation R A M) (r : S) (a : A) :
+  D (r • a) = r • D a :=
+D.to_linear_map.map_smul_of_tower r a
+
+@[simp] lemma map_one_eq_zero : D 1 = 0 := D.map_one_eq_zero'
+
+@[simp] lemma map_algebra_map : D (algebra_map R A r) = 0 :=
+by rw [←mul_one r, ring_hom.map_mul, ring_hom.map_one, ←smul_def, map_smul, map_one_eq_zero,
+  smul_zero]
+
+@[simp] lemma map_coe_nat (n : ℕ) : D (n : A) = 0 :=
+by rw [← nsmul_one, D.map_smul_of_tower n, map_one_eq_zero, smul_zero]
+
+@[simp] lemma leibniz_pow (n : ℕ) : D (a ^ n) = n • a ^ (n - 1) • D a :=
+begin
+  induction n with n ihn,
+  { rw [pow_zero, map_one_eq_zero, zero_smul] },
+  { rcases (zero_le n).eq_or_lt with (rfl|hpos),
+    { rw [pow_one, one_smul, pow_zero, one_smul] },
+    { have : a * a ^ (n - 1) = a ^ n, by rw [← pow_succ, nat.sub_add_cancel hpos],
+      simp only [pow_succ, leibniz, ihn, smul_comm a n, smul_smul a, add_smul, this,
+        nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, one_nsmul] } }
+end
+
+lemma eq_on_adjoin {s : set A} (h : set.eq_on D1 D2 s) : set.eq_on D1 D2 (adjoin R s) :=
+λ x hx, algebra.adjoin_induction hx h
+  (λ r, (D1.map_algebra_map r).trans (D2.map_algebra_map r).symm)
+  (λ x y hx hy, by simp only [map_add, *])
+  (λ x y hx hy, by simp only [leibniz, *])
+
+/-- If adjoin of a set is the whole algebra, then any two derivations equal on this set are equal
+on the whole algebra. -/
+lemma ext_of_adjoin_eq_top (s : set A) (hs : adjoin R s = ⊤) (h : set.eq_on D1 D2 s) : D1 = D2 :=
+ext $ λ a, eq_on_adjoin h $ hs.symm ▸ trivial
+
+/- Data typeclasses -/
+
+instance : has_zero (derivation R A M) :=
+⟨{ to_linear_map := 0,
+   map_one_eq_zero' := rfl,
+   leibniz' := λ a b, by simp only [add_zero, linear_map.zero_apply, smul_zero] }⟩
+
+@[simp] lemma coe_zero : ⇑(0 : derivation R A M) = 0 := rfl
+@[simp] lemma coe_zero_linear_map : ↑(0 : derivation R A M) = (0 : A →ₗ[R] M) := rfl
+lemma zero_apply (a : A) : (0 : derivation R A M) a = 0 := rfl
+
+instance : has_add (derivation R A M) :=
+⟨λ D1 D2,
+  { to_linear_map := D1 + D2,
+    map_one_eq_zero' := by simp,
+    leibniz' := λ a b, by simp only [leibniz, linear_map.add_apply,
+      coe_fn_coe, smul_add, add_add_add_comm] }⟩
+
+@[simp] lemma coe_add (D1 D2 : derivation R A M) : ⇑(D1 + D2) = D1 + D2 := rfl
+@[simp] lemma coe_add_linear_map (D1 D2 : derivation R A M) : ↑(D1 + D2) = (D1 + D2 : A →ₗ[R] M) :=
+rfl
+lemma add_apply : (D1 + D2) a = D1 a + D2 a := rfl
+
+instance : inhabited (derivation R A M) := ⟨0⟩
+
+section scalar
+
+variables {S T : Type*}
+variables [monoid S] [distrib_mul_action S M] [smul_comm_class R S M] [smul_comm_class S A M]
+variables [monoid T] [distrib_mul_action T M] [smul_comm_class R T M] [smul_comm_class T A M]
+
+@[priority 100]
+instance : has_smul S (derivation R A M) :=
+⟨λ r D,
+  { to_linear_map := r • D,
+    map_one_eq_zero' := by rw [linear_map.smul_apply, coe_fn_coe, D.map_one_eq_zero, smul_zero],
+    leibniz' := λ a b, by simp only [linear_map.smul_apply, coe_fn_coe, leibniz, smul_add,
+      smul_comm r] }⟩
+
+@[simp] lemma coe_smul (r : S) (D : derivation R A M) : ⇑(r • D) = r • D := rfl
+@[simp] lemma coe_smul_linear_map (r : S) (D : derivation R A M) :
+  ↑(r • D) = (r • D : A →ₗ[R] M) := rfl
+lemma smul_apply (r : S) (D : derivation R A M) : (r • D) a = r • D a := rfl
+
+instance : add_comm_monoid (derivation R A M) :=
+coe_injective.add_comm_monoid _ coe_zero coe_add (λ _ _, rfl)
+
+/-- `coe_fn` as an `add_monoid_hom`. -/
+def coe_fn_add_monoid_hom : derivation R A M →+ (A → M) :=
+{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add }
+
+@[priority 100]
+instance : distrib_mul_action S (derivation R A M) :=
+function.injective.distrib_mul_action coe_fn_add_monoid_hom coe_injective coe_smul
+
+instance [distrib_mul_action Sᵐᵒᵖ M] [is_central_scalar S M] :
+  is_central_scalar S (derivation R A M) :=
+{ op_smul_eq_smul := λ _ _, ext $ λ _, op_smul_eq_smul _ _}
+
+instance [has_smul S T] [is_scalar_tower S T M] : is_scalar_tower S T (derivation R A M) :=
+⟨λ x y z, ext $ λ a, smul_assoc _ _ _⟩
+
+instance [smul_comm_class S T M] : smul_comm_class S T (derivation R A M) :=
+⟨λ x y z, ext $ λ a, smul_comm _ _ _⟩
+
+end scalar
+
+@[priority 100]
+instance {S : Type*} [semiring S] [module S M] [smul_comm_class R S M] [smul_comm_class S A M] :
+  module S (derivation R A M) :=
+function.injective.module S coe_fn_add_monoid_hom coe_injective coe_smul
+
+section push_forward
+
+variables {N : Type*} [add_comm_monoid N] [module A N] [module R N] [is_scalar_tower R A M]
+  [is_scalar_tower R A N]
+variables (f : M →ₗ[A] N) (e : M ≃ₗ[A] N)
+
+/-- We can push forward derivations using linear maps, i.e., the composition of a derivation with a
+linear map is a derivation. Furthermore, this operation is linear on the spaces of derivations. -/
+def _root_.linear_map.comp_der : derivation R A M →ₗ[R] derivation R A N :=
+{ to_fun    := λ D,
+  { to_linear_map := (f : M →ₗ[R] N).comp (D : A →ₗ[R] M),
+    map_one_eq_zero' := by simp only [linear_map.comp_apply, coe_fn_coe, map_one_eq_zero, map_zero],
+    leibniz'  := λ a b, by simp only [coe_fn_coe, linear_map.comp_apply, linear_map.map_add,
+      leibniz, linear_map.coe_coe_is_scalar_tower, linear_map.map_smul] },
+  map_add'  := λ D₁ D₂, by { ext, exact linear_map.map_add _ _ _, },
+  map_smul' := λ r D, by { ext, exact linear_map.map_smul _ _ _, }, }
+
+@[simp] lemma coe_to_linear_map_comp :
+  (f.comp_der D : A →ₗ[R] N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
+rfl
+
+@[simp] lemma coe_comp :
+  (f.comp_der D : A → N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
+rfl
+
+/-- The composition of a derivation with a linear map as a bilinear map -/
+@[simps]
+def llcomp : (M →ₗ[A] N) →ₗ[A] derivation R A M →ₗ[R] derivation R A N :=
+{ to_fun := λ f, f.comp_der,
+  map_add' := λ f₁ f₂, by { ext, refl },
+  map_smul' := λ r D, by { ext, refl } }
+
+/-- Pushing a derivation foward through a linear equivalence is an equivalence. -/
+def _root_.linear_equiv.comp_der : derivation R A M ≃ₗ[R] derivation R A N :=
+{ inv_fun := e.symm.to_linear_map.comp_der,
+  left_inv := λ D, by { ext a, exact e.symm_apply_apply (D a) },
+  right_inv := λ D, by { ext a, exact e.apply_symm_apply (D a) },
+  ..e.to_linear_map.comp_der }
+
+
+end push_forward
+
+section restrict_scalars
+
+variables {S : Type*} [comm_semiring S]
+variables [algebra S A] [module S M] [linear_map.compatible_smul A M R S]
+
+variables (R)
+
+/-- If `A` is both an `R`-algebra and an `S`-algebra; `M` is both an `R`-module and an `S`-module,
+then an `S`-derivation `A → M` is also an `R`-derivation if it is also `R`-linear. -/
+protected
+def restrict_scalars (d : derivation S A M) : derivation R A M :=
+{ map_one_eq_zero' := d.map_one_eq_zero,
+  leibniz' := d.leibniz,
+  to_linear_map := d.to_linear_map.restrict_scalars R }
+
+end restrict_scalars
+
+end
+
+section cancel
+
+variables {R : Type*} [comm_semiring R] {A : Type*} [comm_semiring A] [algebra R A]
+  {M : Type*} [add_cancel_comm_monoid M] [module R M] [module A M]
+
+/-- Define `derivation R A M` from a linear map when `M` is cancellative by verifying the Leibniz
+rule. -/
+def mk' (D : A →ₗ[R] M) (h : ∀ a b, D (a * b) = a • D b + b • D a) : derivation R A M :=
+{ to_linear_map := D,
+  map_one_eq_zero' := add_right_eq_self.1 $ by simpa only [one_smul, one_mul] using (h 1 1).symm,
+  leibniz' := h }
+
+@[simp] lemma coe_mk' (D : A →ₗ[R] M) (h) : ⇑(mk' D h) = D := rfl
+@[simp] lemma coe_mk'_linear_map (D : A →ₗ[R] M) (h) : (mk' D h : A →ₗ[R] M) = D := rfl
+
+end cancel
+
+section
+
+variables {R : Type*} [comm_ring R]
+variables {A : Type*} [comm_ring A] [algebra R A]
+
+section
+
+variables {M : Type*} [add_comm_group M] [module A M] [module R M]
+variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)
+
+protected lemma map_neg : D (-a) = -D a := map_neg D a
+protected lemma map_sub : D (a - b) = D a - D b := map_sub D a b
+
+@[simp] lemma map_coe_int (n : ℤ) : D (n : A) = 0 :=
+by rw [← zsmul_one, D.map_smul_of_tower n, map_one_eq_zero, smul_zero]
+
+lemma leibniz_of_mul_eq_one {a b : A} (h : a * b = 1) : D a = -a^2 • D b :=
+begin
+  rw neg_smul,
+  refine eq_neg_of_add_eq_zero_left _,
+  calc D a + a ^ 2 • D b = a • b • D a + a • a • D b : by simp only [smul_smul, h, one_smul, sq]
+                     ... = a • D (a * b)             : by rw [leibniz, smul_add, add_comm]
+                     ... = 0                         : by rw [h, map_one_eq_zero, smul_zero]
+end
+
+lemma leibniz_inv_of [invertible a] : D (⅟a) = -⅟a^2 • D a :=
+D.leibniz_of_mul_eq_one $ inv_of_mul_self a
+
+lemma leibniz_inv {K : Type*} [field K] [module K M] [algebra R K] (D : derivation R K M) (a : K) :
+  D (a⁻¹) = -a⁻¹ ^ 2 • D a :=
+begin
+  rcases eq_or_ne a 0 with (rfl|ha),
+  { simp },
+  { exact D.leibniz_of_mul_eq_one (inv_mul_cancel ha) }
+end
+
+instance : has_neg (derivation R A M) :=
+⟨λ D, mk' (-D) $  λ a b,
+  by simp only [linear_map.neg_apply, smul_neg, neg_add_rev, leibniz, coe_fn_coe, add_comm]⟩
+
+@[simp] lemma coe_neg (D : derivation R A M) : ⇑(-D) = -D := rfl
+@[simp] lemma coe_neg_linear_map (D : derivation R A M) : ↑(-D) = (-D : A →ₗ[R] M) :=
+rfl
+lemma neg_apply : (-D) a = -D a := rfl
+
+instance : has_sub (derivation R A M) :=
+⟨λ D1 D2, mk' (D1 - D2 : A →ₗ[R] M) $ λ a b,
+  by simp only [linear_map.sub_apply, leibniz, coe_fn_coe, smul_sub, add_sub_add_comm]⟩
+
+@[simp] lemma coe_sub (D1 D2 : derivation R A M) : ⇑(D1 - D2) = D1 - D2 := rfl
+@[simp] lemma coe_sub_linear_map (D1 D2 : derivation R A M) : ↑(D1 - D2) = (D1 - D2 : A →ₗ[R] M) :=
+rfl
+lemma sub_apply : (D1 - D2) a = D1 a - D2 a := rfl
+
+instance : add_comm_group (derivation R A M) :=
+coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)
+
+end
+
+end
+
+end derivation
diff --git a/src/ring_theory/derivation/lie.lean b/src/ring_theory/derivation/lie.lean
new file mode 100644
index 0000000000000..458b0340a8936
--- /dev/null
+++ b/src/ring_theory/derivation/lie.lean
@@ -0,0 +1,53 @@
+/-
+Copyright © 2020 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Andrew Yang
+-/
+import algebra.lie.of_associative
+import ring_theory.derivation.basic
+
+/-!
+# Results
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+- `derivation.lie_algebra`: The `R`-derivations from `A` to `A` form an lie algebra over `R`.
+
+-/
+
+namespace derivation
+
+variables {R : Type*} [comm_ring R]
+variables {A : Type*} [comm_ring A] [algebra R A]
+variables (D : derivation R A A) {D1 D2 : derivation R A A} (a : A)
+
+section lie_structures
+
+/-! # Lie structures -/
+
+/-- The commutator of derivations is again a derivation. -/
+instance : has_bracket (derivation R A A) (derivation R A A) :=
+⟨λ D1 D2, mk' (⁅(D1 : module.End R A), (D2 : module.End R A)⁆) $ λ a b,
+  by { simp only [ring.lie_def, map_add, algebra.id.smul_eq_mul, linear_map.mul_apply, leibniz,
+    coe_fn_coe, linear_map.sub_apply], ring, }⟩
+
+@[simp] lemma commutator_coe_linear_map :
+  ↑⁅D1, D2⁆ = ⁅(D1 : module.End R A), (D2 : module.End R A)⁆ := rfl
+
+lemma commutator_apply : ⁅D1, D2⁆ a = D1 (D2 a) - D2 (D1 a) := rfl
+
+instance : lie_ring (derivation R A A) :=
+{ add_lie     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
+  lie_add     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
+  lie_self    := λ d, by { ext a, simp only [commutator_apply, add_apply, map_add], ring_nf, },
+  leibniz_lie := λ d e f,
+    by { ext a, simp only [commutator_apply, add_apply, sub_apply, map_sub], ring, } }
+
+instance : lie_algebra R (derivation R A A) :=
+{ lie_smul := λ r d e, by { ext a, simp only [commutator_apply, map_smul, smul_sub, smul_apply]},
+  ..derivation.module }
+
+end lie_structures
+
+end derivation
diff --git a/src/ring_theory/derivation/to_square_zero.lean b/src/ring_theory/derivation/to_square_zero.lean
new file mode 100644
index 0000000000000..d9d0d6aae2484
--- /dev/null
+++ b/src/ring_theory/derivation/to_square_zero.lean
@@ -0,0 +1,124 @@
+/-
+Copyright © 2020 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Andrew Yang
+-/
+import ring_theory.derivation.basic
+import ring_theory.ideal.quotient_operations
+
+/-!
+# Results
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+- `derivation_to_square_zero_equiv_lift`: The `R`-derivations from `A` into a square-zero ideal `I`
+  of `B` corresponds to the lifts `A →ₐ[R] B` of the map `A →ₐ[R] B ⧸ I`.
+
+-/
+
+section to_square_zero
+
+universes u v w
+
+variables {R : Type u} {A : Type v} {B : Type w} [comm_semiring R] [comm_semiring A] [comm_ring B]
+variables [algebra R A] [algebra R B] (I : ideal B) (hI : I ^ 2 = ⊥)
+
+/-- If `f₁ f₂ : A →ₐ[R] B` are two lifts of the same `A →ₐ[R] B ⧸ I`,
+  we may define a map `f₁ - f₂ : A →ₗ[R] I`. -/
+def diff_to_ideal_of_quotient_comp_eq (f₁ f₂ : A →ₐ[R] B)
+  (e : (ideal.quotient.mkₐ R I).comp f₁ = (ideal.quotient.mkₐ R I).comp f₂) :
+  A →ₗ[R] I :=
+linear_map.cod_restrict (I.restrict_scalars _) (f₁.to_linear_map - f₂.to_linear_map)
+begin
+  intro x,
+  change f₁ x - f₂ x ∈ I,
+  rw [← ideal.quotient.eq, ← ideal.quotient.mkₐ_eq_mk R, ← alg_hom.comp_apply, e],
+  refl,
+end
+
+@[simp]
+lemma diff_to_ideal_of_quotient_comp_eq_apply (f₁ f₂ : A →ₐ[R] B)
+  (e : (ideal.quotient.mkₐ R I).comp f₁ = (ideal.quotient.mkₐ R I).comp f₂) (x : A) :
+  ((diff_to_ideal_of_quotient_comp_eq I f₁ f₂ e) x : B) = f₁ x - f₂ x :=
+rfl
+
+variables [algebra A B] [is_scalar_tower R A B]
+
+include hI
+
+/-- Given a tower of algebras `R → A → B`, and a square-zero `I : ideal B`, each lift `A →ₐ[R] B`
+of the canonical map `A →ₐ[R] B ⧸ I` corresponds to a `R`-derivation from `A` to `I`. -/
+def derivation_to_square_zero_of_lift
+  (f : A →ₐ[R] B) (e : (ideal.quotient.mkₐ R I).comp f = is_scalar_tower.to_alg_hom R A (B ⧸ I)) :
+  derivation R A I :=
+begin
+  refine
+  { map_one_eq_zero' := _,
+    leibniz' := _,
+    ..(diff_to_ideal_of_quotient_comp_eq I f (is_scalar_tower.to_alg_hom R A B) _) },
+  { rw e, ext, refl },
+  { ext, change f 1 - algebra_map A B 1 = 0, rw [map_one, map_one, sub_self] },
+  { intros x y,
+    let F := diff_to_ideal_of_quotient_comp_eq I f (is_scalar_tower.to_alg_hom R A B)
+      (by { rw e, ext, refl }),
+    have : (f x - algebra_map A B x) * (f y - algebra_map A B y) = 0,
+    { rw [← ideal.mem_bot, ← hI, pow_two],
+      convert (ideal.mul_mem_mul (F x).2 (F y).2) using 1 },
+    ext,
+    dsimp only [submodule.coe_add, submodule.coe_mk, linear_map.coe_mk,
+      diff_to_ideal_of_quotient_comp_eq_apply, submodule.coe_smul_of_tower,
+      is_scalar_tower.coe_to_alg_hom', linear_map.to_fun_eq_coe],
+    simp only [map_mul, sub_mul, mul_sub, algebra.smul_def] at ⊢ this,
+    rw [sub_eq_iff_eq_add, sub_eq_iff_eq_add] at this,
+    rw this,
+    ring }
+end
+
+lemma derivation_to_square_zero_of_lift_apply (f : A →ₐ[R] B)
+  (e : (ideal.quotient.mkₐ R I).comp f = is_scalar_tower.to_alg_hom R A (B ⧸ I))
+  (x : A) : (derivation_to_square_zero_of_lift I hI f e x : B) = f x - algebra_map A B x := rfl
+
+/-- Given a tower of algebras `R → A → B`, and a square-zero `I : ideal B`, each `R`-derivation
+from `A` to `I` corresponds to a lift `A →ₐ[R] B` of the canonical map `A →ₐ[R] B ⧸ I`. -/
+@[simps {attrs := []}]
+def lift_of_derivation_to_square_zero (f : derivation R A I) :
+  A →ₐ[R] B :=
+{ to_fun := λ x, f x + algebra_map A B x,
+  map_one' := by rw [map_one, f.map_one_eq_zero, submodule.coe_zero, zero_add],
+  map_mul' := λ x y, begin
+    have : (f x : B) * (f y) = 0,
+    { rw [← ideal.mem_bot, ← hI, pow_two], convert (ideal.mul_mem_mul (f x).2 (f y).2) using 1 },
+    simp only [map_mul, f.leibniz, add_mul, mul_add, submodule.coe_add,
+      submodule.coe_smul_of_tower, algebra.smul_def, this],
+    ring
+  end,
+  commutes' := λ r,
+    by simp only [derivation.map_algebra_map, eq_self_iff_true, zero_add, submodule.coe_zero,
+      ←is_scalar_tower.algebra_map_apply R A B r],
+  map_zero' := ((I.restrict_scalars R).subtype.comp f.to_linear_map +
+    (is_scalar_tower.to_alg_hom R A B).to_linear_map).map_zero,
+  ..((I.restrict_scalars R).subtype.comp f.to_linear_map +
+    (is_scalar_tower.to_alg_hom R A B).to_linear_map : A →ₗ[R] B) }
+
+@[simp] lemma lift_of_derivation_to_square_zero_mk_apply (d : derivation R A I) (x : A) :
+  ideal.quotient.mk I (lift_of_derivation_to_square_zero I hI d x) = algebra_map A (B ⧸ I) x :=
+by { rw [lift_of_derivation_to_square_zero_apply, map_add,
+  ideal.quotient.eq_zero_iff_mem.mpr (d x).prop, zero_add], refl }
+
+/-- Given a tower of algebras `R → A → B`, and a square-zero `I : ideal B`,
+there is a 1-1 correspondance between `R`-derivations from `A` to `I` and
+lifts `A →ₐ[R] B` of the canonical map `A →ₐ[R] B ⧸ I`. -/
+@[simps]
+def derivation_to_square_zero_equiv_lift :
+  derivation R A I ≃
+    { f : A →ₐ[R] B // (ideal.quotient.mkₐ R I).comp f = is_scalar_tower.to_alg_hom R A (B ⧸ I) } :=
+begin
+  refine ⟨λ d, ⟨lift_of_derivation_to_square_zero I hI d, _⟩, λ f,
+    (derivation_to_square_zero_of_lift I hI f.1 f.2 : _), _, _⟩,
+  { ext x, exact lift_of_derivation_to_square_zero_mk_apply I hI d x },
+  { intro d, ext x, exact add_sub_cancel (d x : B) (algebra_map A B x) },
+  { rintro ⟨f, hf⟩, ext x,  exact sub_add_cancel (f x) (algebra_map A B x) }
+end
+
+end to_square_zero
diff --git a/src/ring_theory/discrete_valuation_ring.lean b/src/ring_theory/discrete_valuation_ring.lean
deleted file mode 100644
index 90f2457dfa66f..0000000000000
--- a/src/ring_theory/discrete_valuation_ring.lean
+++ /dev/null
@@ -1,482 +0,0 @@
-/-
-Copyright (c) 2020 Kevin Buzzard. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kevin Buzzard
--/
-
-import ring_theory.principal_ideal_domain
-import order.conditionally_complete_lattice
-import ring_theory.ideal.local_ring
-import ring_theory.multiplicity
-import ring_theory.valuation.basic
-import linear_algebra.adic_completion
-
-/-!
-# Discrete valuation rings
-
-This file defines discrete valuation rings (DVRs) and develops a basic interface
-for them.
-
-## Important definitions
-
-There are various definitions of a DVR in the literature; we define a DVR to be a local PID
-which is not a field (the first definition in Wikipedia) and prove that this is equivalent
-to being a PID with a unique non-zero prime ideal (the definition in Serre's
-book "Local Fields").
-
-Let R be an integral domain, assumed to be a principal ideal ring and a local ring.
-
-* `discrete_valuation_ring R` : a predicate expressing that R is a DVR
-
-### Definitions
-
-* `add_val R : add_valuation R enat` : the additive valuation on a DVR.
-
-## Implementation notes
-
-It's a theorem that an element of a DVR is a uniformizer if and only if it's irreducible.
-We do not hence define `uniformizer` at all, because we can use `irreducible` instead.
-
-## Tags
-
-discrete valuation ring
--/
-
-open_locale classical
-
-universe u
-
-open ideal local_ring
-
-/-- An integral domain is a *discrete valuation ring* (DVR) if it's a local PID which
-  is not a field. -/
-class discrete_valuation_ring (R : Type u) [comm_ring R] [is_domain R]
-  extends is_principal_ideal_ring R, local_ring R : Prop :=
-(not_a_field' : maximal_ideal R ≠ ⊥)
-
-namespace discrete_valuation_ring
-
-variables (R : Type u) [comm_ring R] [is_domain R] [discrete_valuation_ring R]
-
-lemma not_a_field : maximal_ideal R ≠ ⊥ := not_a_field'
-
-variable {R}
-
-open principal_ideal_ring
-
-/-- An element of a DVR is irreducible iff it is a uniformizer, that is, generates the
-  maximal ideal of R -/
-theorem irreducible_iff_uniformizer (ϖ : R) :
-  irreducible ϖ ↔ maximal_ideal R = ideal.span {ϖ} :=
-⟨λ hϖ, (eq_maximal_ideal (is_maximal_of_irreducible hϖ)).symm,
-begin
-  intro h,
-  have h2 : ¬(is_unit ϖ) := show ϖ ∈ maximal_ideal R,
-    from h.symm ▸ submodule.mem_span_singleton_self ϖ,
-  refine ⟨h2, _⟩,
-  intros a b hab,
-  by_contra' h,
-  obtain ⟨ha : a ∈ maximal_ideal R, hb : b ∈ maximal_ideal R⟩ := h,
-  rw [h, mem_span_singleton'] at ha hb,
-  rcases ha with ⟨a, rfl⟩,
-  rcases hb with ⟨b, rfl⟩,
-  rw (show a * ϖ * (b * ϖ) = ϖ * (ϖ * (a * b)), by ring) at hab,
-  have h3 := eq_zero_of_mul_eq_self_right _ hab.symm,
-  { apply not_a_field R,
-    simp [h, h3] },
-  { exact λ hh, h2 (is_unit_of_dvd_one ϖ ⟨_, hh.symm⟩) }
-end⟩
-
-lemma _root_.irreducible.maximal_ideal_eq {ϖ : R} (h : irreducible ϖ) :
-  maximal_ideal R = ideal.span {ϖ} :=
-(irreducible_iff_uniformizer _).mp h
-
-variable (R)
-
-/-- Uniformisers exist in a DVR -/
-theorem exists_irreducible : ∃ ϖ : R, irreducible ϖ :=
-by {simp_rw [irreducible_iff_uniformizer],
-    exact (is_principal_ideal_ring.principal $ maximal_ideal R).principal}
-
-/-- Uniformisers exist in a DVR -/
-theorem exists_prime : ∃ ϖ : R, prime ϖ :=
-(exists_irreducible R).imp (λ _, principal_ideal_ring.irreducible_iff_prime.1)
-
-/-- an integral domain is a DVR iff it's a PID with a unique non-zero prime ideal -/
-theorem iff_pid_with_one_nonzero_prime (R : Type u) [comm_ring R] [is_domain R] :
-  discrete_valuation_ring R ↔ is_principal_ideal_ring R ∧ ∃! P : ideal R, P ≠ ⊥ ∧ is_prime P :=
-begin
-  split,
-  { intro RDVR,
-    rcases id RDVR with ⟨RPID, Rlocal, Rnotafield⟩,
-    split, assumption,
-    resetI,
-    use local_ring.maximal_ideal R,
-    split, split,
-    { assumption },
-    { apply_instance } ,
-    { rintro Q ⟨hQ1, hQ2⟩,
-      obtain ⟨q, rfl⟩ := (is_principal_ideal_ring.principal Q).1,
-      have hq : q ≠ 0,
-      { rintro rfl,
-        apply hQ1,
-        simp },
-      erw span_singleton_prime hq at hQ2,
-      replace hQ2 := hQ2.irreducible,
-      rw irreducible_iff_uniformizer at hQ2,
-      exact hQ2.symm } },
-  { rintro ⟨RPID, Punique⟩,
-    haveI : local_ring R := local_ring.of_unique_nonzero_prime Punique,
-    refine {not_a_field' := _},
-    rcases Punique with ⟨P, ⟨hP1, hP2⟩, hP3⟩,
-    have hPM : P ≤ maximal_ideal R := le_maximal_ideal (hP2.1),
-    intro h, rw [h, le_bot_iff] at hPM, exact hP1 hPM }
-end
-
-lemma associated_of_irreducible {a b : R} (ha : irreducible a) (hb : irreducible b) :
-  associated a b :=
-begin
-  rw irreducible_iff_uniformizer at ha hb,
-  rw [←span_singleton_eq_span_singleton, ←ha, hb],
-end
-
-end discrete_valuation_ring
-
-namespace discrete_valuation_ring
-
-variable (R : Type*)
-
-/-- Alternative characterisation of discrete valuation rings. -/
-def has_unit_mul_pow_irreducible_factorization [comm_ring R] : Prop :=
-∃ p : R, irreducible p ∧ ∀ {x : R}, x ≠ 0 → ∃ (n : ℕ), associated (p ^ n) x
-
-namespace has_unit_mul_pow_irreducible_factorization
-
-variables {R} [comm_ring R] (hR : has_unit_mul_pow_irreducible_factorization R)
-include hR
-
-lemma unique_irreducible ⦃p q : R⦄ (hp : irreducible p) (hq : irreducible q) :
-  associated p q :=
-begin
-  rcases hR with ⟨ϖ, hϖ, hR⟩,
-  suffices : ∀ {p : R} (hp : irreducible p), associated p ϖ,
-  { apply associated.trans (this hp) (this hq).symm, },
-  clear hp hq p q,
-  intros p hp,
-  obtain ⟨n, hn⟩ := hR hp.ne_zero,
-  have : irreducible (ϖ ^ n) := hn.symm.irreducible hp,
-  rcases lt_trichotomy n 1 with (H|rfl|H),
-  { obtain rfl : n = 0, { clear hn this, revert H n, exact dec_trivial },
-    simpa only [not_irreducible_one, pow_zero] using this, },
-  { simpa only [pow_one] using hn.symm, },
-  { obtain ⟨n, rfl⟩ : ∃ k, n = 1 + k + 1 := nat.exists_eq_add_of_lt H,
-    rw pow_succ at this,
-    rcases this.is_unit_or_is_unit rfl with H0|H0,
-    { exact (hϖ.not_unit H0).elim, },
-    { rw [add_comm, pow_succ] at H0,
-      exact (hϖ.not_unit (is_unit_of_mul_is_unit_left H0)).elim } }
-end
-
-variables [is_domain R]
-
-/-- An integral domain in which there is an irreducible element `p`
-such that every nonzero element is associated to a power of `p` is a unique factorization domain.
-See `discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization`. -/
-theorem to_unique_factorization_monoid : unique_factorization_monoid R :=
-let p := classical.some hR in
-let spec := classical.some_spec hR in
-unique_factorization_monoid.of_exists_prime_factors $ λ x hx,
-begin
-  use multiset.repeat p (classical.some (spec.2 hx)),
-  split,
-  { intros q hq,
-    have hpq := multiset.eq_of_mem_repeat hq,
-    rw hpq,
-    refine ⟨spec.1.ne_zero, spec.1.not_unit, _⟩,
-    intros a b h,
-    by_cases ha : a = 0,
-    { rw ha, simp only [true_or, dvd_zero], },
-    obtain ⟨m, u, rfl⟩ := spec.2 ha,
-    rw [mul_assoc, mul_left_comm, is_unit.dvd_mul_left _ _ _ (units.is_unit _)] at h,
-    rw is_unit.dvd_mul_right (units.is_unit _),
-    by_cases hm : m = 0,
-    { simp only [hm, one_mul, pow_zero] at h ⊢, right, exact h },
-    left,
-    obtain ⟨m, rfl⟩ := nat.exists_eq_succ_of_ne_zero hm,
-    rw pow_succ,
-    apply dvd_mul_of_dvd_left dvd_rfl _ },
-  { rw [multiset.prod_repeat], exact (classical.some_spec (spec.2 hx)), }
-end
-
-omit hR
-
-lemma of_ufd_of_unique_irreducible [unique_factorization_monoid R]
-  (h₁ : ∃ p : R, irreducible p)
-  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
-  has_unit_mul_pow_irreducible_factorization R :=
-begin
-  obtain ⟨p, hp⟩ := h₁,
-  refine ⟨p, hp, _⟩,
-  intros x hx,
-  cases wf_dvd_monoid.exists_factors x hx with fx hfx,
-  refine ⟨fx.card, _⟩,
-  have H := hfx.2,
-  rw ← associates.mk_eq_mk_iff_associated at H ⊢,
-  rw [← H, ← associates.prod_mk, associates.mk_pow, ← multiset.prod_repeat],
-  congr' 1,
-  symmetry,
-  rw multiset.eq_repeat,
-  simp only [true_and, and_imp, multiset.card_map, eq_self_iff_true,
-    multiset.mem_map, exists_imp_distrib],
-  rintros _ q hq rfl,
-  rw associates.mk_eq_mk_iff_associated,
-  apply h₂ (hfx.1 _ hq) hp,
-end
-
-end has_unit_mul_pow_irreducible_factorization
-
-lemma aux_pid_of_ufd_of_unique_irreducible
-  (R : Type u) [comm_ring R] [is_domain R] [unique_factorization_monoid R]
-  (h₁ : ∃ p : R, irreducible p)
-  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
-  is_principal_ideal_ring R :=
-begin
-  constructor,
-  intro I,
-  by_cases I0 : I = ⊥, { rw I0, use 0, simp only [set.singleton_zero, submodule.span_zero], },
-  obtain ⟨x, hxI, hx0⟩ : ∃ x ∈ I, x ≠ (0:R) := I.ne_bot_iff.mp I0,
-  obtain ⟨p, hp, H⟩ :=
-    has_unit_mul_pow_irreducible_factorization.of_ufd_of_unique_irreducible h₁ h₂,
-  have ex : ∃ n : ℕ, p ^ n ∈ I,
-  { obtain ⟨n, u, rfl⟩ := H hx0,
-    refine ⟨n, _⟩,
-    simpa only [units.mul_inv_cancel_right] using I.mul_mem_right ↑u⁻¹ hxI, },
-  constructor,
-  use p ^ (nat.find ex),
-  show I = ideal.span _,
-  apply le_antisymm,
-  { intros r hr,
-    by_cases hr0 : r = 0,
-    { simp only [hr0, submodule.zero_mem], },
-    obtain ⟨n, u, rfl⟩ := H hr0,
-    simp only [mem_span_singleton, units.is_unit, is_unit.dvd_mul_right],
-    apply pow_dvd_pow,
-    apply nat.find_min',
-    simpa only [units.mul_inv_cancel_right] using I.mul_mem_right ↑u⁻¹ hr, },
-  { erw submodule.span_singleton_le_iff_mem,
-    exact nat.find_spec ex, },
-end
-
-/--
-A unique factorization domain with at least one irreducible element
-in which all irreducible elements are associated
-is a discrete valuation ring.
--/
-lemma of_ufd_of_unique_irreducible
-  {R : Type u} [comm_ring R] [is_domain R] [unique_factorization_monoid R]
-  (h₁ : ∃ p : R, irreducible p)
-  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
-  discrete_valuation_ring R :=
-begin
-  rw iff_pid_with_one_nonzero_prime,
-  haveI PID : is_principal_ideal_ring R := aux_pid_of_ufd_of_unique_irreducible R h₁ h₂,
-  obtain ⟨p, hp⟩ := h₁,
-  refine ⟨PID, ⟨ideal.span {p}, ⟨_, _⟩, _⟩⟩,
-  { rw submodule.ne_bot_iff,
-    refine ⟨p, ideal.mem_span_singleton.mpr (dvd_refl p), hp.ne_zero⟩, },
-  { rwa [ideal.span_singleton_prime hp.ne_zero,
-        ← unique_factorization_monoid.irreducible_iff_prime], },
-  { intro I,
-    rw ← submodule.is_principal.span_singleton_generator I,
-    rintro ⟨I0, hI⟩,
-    apply span_singleton_eq_span_singleton.mpr,
-    apply h₂ _ hp,
-    erw [ne.def, span_singleton_eq_bot] at I0,
-    rwa [unique_factorization_monoid.irreducible_iff_prime, ← ideal.span_singleton_prime I0],
-    apply_instance, },
-end
-
-/--
-An integral domain in which there is an irreducible element `p`
-such that every nonzero element is associated to a power of `p`
-is a discrete valuation ring.
--/
-lemma of_has_unit_mul_pow_irreducible_factorization {R : Type u} [comm_ring R] [is_domain R]
-  (hR : has_unit_mul_pow_irreducible_factorization R) :
-  discrete_valuation_ring R :=
-begin
-  letI : unique_factorization_monoid R := hR.to_unique_factorization_monoid,
-  apply of_ufd_of_unique_irreducible _ hR.unique_irreducible,
-  unfreezingI { obtain ⟨p, hp, H⟩ := hR, exact ⟨p, hp⟩, },
-end
-
-section
-
-variables [comm_ring R] [is_domain R] [discrete_valuation_ring R]
-
-variable {R}
-
-lemma associated_pow_irreducible {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
-  ∃ (n : ℕ), associated x (ϖ ^ n) :=
-begin
-  have : wf_dvd_monoid R := is_noetherian_ring.wf_dvd_monoid,
-  cases wf_dvd_monoid.exists_factors x hx with fx hfx,
-  unfreezingI { use fx.card },
-  have H := hfx.2,
-  rw ← associates.mk_eq_mk_iff_associated at H ⊢,
-  rw [← H, ← associates.prod_mk, associates.mk_pow, ← multiset.prod_repeat],
-  congr' 1,
-  rw multiset.eq_repeat,
-  simp only [true_and, and_imp, multiset.card_map, eq_self_iff_true,
-             multiset.mem_map, exists_imp_distrib],
-  rintros _ _ _ rfl,
-  rw associates.mk_eq_mk_iff_associated,
-  refine associated_of_irreducible _ _ hirr,
-  apply hfx.1,
-  assumption
-end
-
-lemma eq_unit_mul_pow_irreducible {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
-  ∃ (n : ℕ) (u : Rˣ), x = u * ϖ ^ n :=
-begin
-  obtain ⟨n, hn⟩ := associated_pow_irreducible hx hirr,
-  obtain ⟨u, rfl⟩ := hn.symm,
-  use [n, u],
-  apply mul_comm,
-end
-
-open submodule.is_principal
-
-lemma ideal_eq_span_pow_irreducible {s : ideal R} (hs : s ≠ ⊥) {ϖ : R} (hirr : irreducible ϖ) :
-  ∃ n : ℕ, s = ideal.span {ϖ ^ n} :=
-begin
-  have gen_ne_zero : generator s ≠ 0,
-  { rw [ne.def, ← eq_bot_iff_generator_eq_zero], assumption },
-  rcases associated_pow_irreducible gen_ne_zero hirr with ⟨n, u, hnu⟩,
-  use n,
-  have : span _ = _ := span_singleton_generator s,
-  rw [← this, ← hnu, span_singleton_eq_span_singleton],
-  use u
-end
-
-lemma unit_mul_pow_congr_pow {p q : R} (hp : irreducible p) (hq : irreducible q)
-  (u v : Rˣ) (m n : ℕ) (h : ↑u * p ^ m = v * q ^ n) :
-  m = n :=
-begin
-  have key : associated (multiset.repeat p m).prod (multiset.repeat q n).prod,
-  { rw [multiset.prod_repeat, multiset.prod_repeat, associated],
-    refine ⟨u * v⁻¹, _⟩,
-    simp only [units.coe_mul],
-    rw [mul_left_comm, ← mul_assoc, h, mul_right_comm, units.mul_inv, one_mul], },
-  have := multiset.card_eq_card_of_rel (unique_factorization_monoid.factors_unique _ _ key),
-  { simpa only [multiset.card_repeat] },
-  all_goals
-  { intros x hx,
-    unfreezingI { obtain rfl := multiset.eq_of_mem_repeat hx, assumption } },
-end
-
-lemma unit_mul_pow_congr_unit {ϖ : R} (hirr : irreducible ϖ) (u v : Rˣ) (m n : ℕ)
-  (h : ↑u * ϖ ^ m = v * ϖ ^ n) :
-  u = v :=
-begin
-  obtain rfl : m = n := unit_mul_pow_congr_pow hirr hirr u v m n h,
-  rw ← sub_eq_zero at h,
-  rw [← sub_mul, mul_eq_zero] at h,
-  cases h,
-  { rw sub_eq_zero at h, exact_mod_cast h },
-  { apply (hirr.ne_zero (pow_eq_zero h)).elim, }
-end
-
-/-!
-## The additive valuation on a DVR
--/
-
-open multiplicity
-
-/-- The `enat`-valued additive valuation on a DVR -/
-noncomputable def add_val
-  (R : Type u) [comm_ring R] [is_domain R] [discrete_valuation_ring R] :
-  add_valuation R enat :=
-add_valuation (classical.some_spec (exists_prime R))
-
-lemma add_val_def (r : R) (u : Rˣ) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) (hr : r = u * ϖ ^ n) :
-  add_val R r = n :=
-by rw [add_val, add_valuation_apply, hr,
-    eq_of_associated_left (associated_of_irreducible R hϖ
-      (classical.some_spec (exists_prime R)).irreducible),
-    eq_of_associated_right (associated.symm ⟨u, mul_comm _ _⟩),
-    multiplicity_pow_self_of_prime (principal_ideal_ring.irreducible_iff_prime.1 hϖ)]
-
-lemma add_val_def' (u : Rˣ) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) :
-  add_val R ((u : R) * ϖ ^ n) = n :=
-add_val_def _ u hϖ n rfl
-
-@[simp] lemma add_val_zero : add_val R 0 = ⊤ :=
-(add_val R).map_zero
-
-@[simp] lemma add_val_one : add_val R 1 = 0 :=
-(add_val R).map_one
-
-@[simp] lemma add_val_uniformizer {ϖ : R} (hϖ : irreducible ϖ) : add_val R ϖ = 1 :=
-by simpa only [one_mul, eq_self_iff_true, units.coe_one, pow_one, forall_true_left, nat.cast_one]
-  using add_val_def ϖ 1 hϖ 1
-
-@[simp] lemma add_val_mul {a b : R} :
-  add_val R (a * b) = add_val R a + add_val R b :=
-(add_val R).map_mul _ _
-
-lemma add_val_pow (a : R) (n : ℕ) : add_val R (a ^ n) = n • add_val R a :=
-(add_val R).map_pow _ _
-
-lemma _root_.irreducible.add_val_pow {ϖ : R} (h : irreducible ϖ) (n : ℕ) :
-  add_val R (ϖ ^ n) = n :=
-by rw [add_val_pow, add_val_uniformizer h, nsmul_one]
-
-lemma add_val_eq_top_iff {a : R} : add_val R a = ⊤ ↔ a = 0 :=
-begin
-  have hi := (classical.some_spec (exists_prime R)).irreducible,
-  split,
-  { contrapose,
-    intro h,
-    obtain ⟨n, ha⟩ := associated_pow_irreducible h hi,
-    obtain ⟨u, rfl⟩ := ha.symm,
-    rw [mul_comm, add_val_def' u hi n],
-    exact enat.coe_ne_top _ },
-  { rintro rfl,
-    exact add_val_zero }
-end
-
-lemma add_val_le_iff_dvd {a b : R} : add_val R a ≤ add_val R b ↔ a ∣ b :=
-begin
-  have hp := classical.some_spec (exists_prime R),
-  split; intro h,
-  { by_cases ha0 : a = 0,
-    { rw [ha0, add_val_zero, top_le_iff, add_val_eq_top_iff] at h,
-      rw h,
-      apply dvd_zero },
-    obtain ⟨n, ha⟩ := associated_pow_irreducible ha0 hp.irreducible,
-    rw [add_val, add_valuation_apply, add_valuation_apply,
-      multiplicity_le_multiplicity_iff] at h,
-    exact ha.dvd.trans (h n ha.symm.dvd), },
-  { rw [add_val, add_valuation_apply, add_valuation_apply],
-    exact multiplicity_le_multiplicity_of_dvd_right h }
-end
-
-lemma add_val_add {a b : R} :
-  min (add_val R a) (add_val R b) ≤ add_val R (a + b) :=
-(add_val R).map_add _ _
-
-end
-
-instance (R : Type*) [comm_ring R] [is_domain R] [discrete_valuation_ring R] :
-  is_Hausdorff (maximal_ideal R) R :=
-{ haus' := λ x hx,
-  begin
-    obtain ⟨ϖ, hϖ⟩ := exists_irreducible R,
-    simp only [← ideal.one_eq_top, smul_eq_mul, mul_one, smodeq.zero,
-      hϖ.maximal_ideal_eq, ideal.span_singleton_pow, ideal.mem_span_singleton,
-      ← add_val_le_iff_dvd, hϖ.add_val_pow] at hx,
-    rwa [← add_val_eq_top_iff, enat.eq_top_iff_forall_le],
-  end }
-
-end discrete_valuation_ring
diff --git a/src/ring_theory/discrete_valuation_ring/basic.lean b/src/ring_theory/discrete_valuation_ring/basic.lean
new file mode 100644
index 0000000000000..27a78c164a18b
--- /dev/null
+++ b/src/ring_theory/discrete_valuation_ring/basic.lean
@@ -0,0 +1,490 @@
+/-
+Copyright (c) 2020 Kevin Buzzard. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kevin Buzzard
+-/
+
+import ring_theory.principal_ideal_domain
+import ring_theory.ideal.local_ring
+import ring_theory.multiplicity
+import ring_theory.valuation.basic
+import linear_algebra.adic_completion
+
+/-!
+# Discrete valuation rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines discrete valuation rings (DVRs) and develops a basic interface
+for them.
+
+## Important definitions
+
+There are various definitions of a DVR in the literature; we define a DVR to be a local PID
+which is not a field (the first definition in Wikipedia) and prove that this is equivalent
+to being a PID with a unique non-zero prime ideal (the definition in Serre's
+book "Local Fields").
+
+Let R be an integral domain, assumed to be a principal ideal ring and a local ring.
+
+* `discrete_valuation_ring R` : a predicate expressing that R is a DVR
+
+### Definitions
+
+* `add_val R : add_valuation R part_enat` : the additive valuation on a DVR.
+
+## Implementation notes
+
+It's a theorem that an element of a DVR is a uniformizer if and only if it's irreducible.
+We do not hence define `uniformizer` at all, because we can use `irreducible` instead.
+
+## Tags
+
+discrete valuation ring
+-/
+
+open_locale classical
+
+universe u
+
+open ideal local_ring
+
+/-- An integral domain is a *discrete valuation ring* (DVR) if it's a local PID which
+  is not a field. -/
+class discrete_valuation_ring (R : Type u) [comm_ring R] [is_domain R]
+  extends is_principal_ideal_ring R, local_ring R : Prop :=
+(not_a_field' : maximal_ideal R ≠ ⊥)
+
+namespace discrete_valuation_ring
+
+variables (R : Type u) [comm_ring R] [is_domain R] [discrete_valuation_ring R]
+
+lemma not_a_field : maximal_ideal R ≠ ⊥ := not_a_field'
+
+/-- A discrete valuation ring `R` is not a field. -/
+lemma not_is_field : ¬ is_field R :=
+local_ring.is_field_iff_maximal_ideal_eq.not.mpr (not_a_field R)
+
+variable {R}
+
+open principal_ideal_ring
+
+theorem irreducible_of_span_eq_maximal_ideal {R : Type*} [comm_ring R] [local_ring R] [is_domain R]
+  (ϖ : R) (hϖ : ϖ ≠ 0) (h : maximal_ideal R = ideal.span {ϖ}) : irreducible ϖ :=
+begin
+  have h2 : ¬(is_unit ϖ) := show ϖ ∈ maximal_ideal R,
+    from h.symm ▸ submodule.mem_span_singleton_self ϖ,
+  refine ⟨h2, _⟩,
+  intros a b hab,
+  by_contra' h,
+  obtain ⟨ha : a ∈ maximal_ideal R, hb : b ∈ maximal_ideal R⟩ := h,
+  rw [h, mem_span_singleton'] at ha hb,
+  rcases ha with ⟨a, rfl⟩,
+  rcases hb with ⟨b, rfl⟩,
+  rw (show a * ϖ * (b * ϖ) = ϖ * (ϖ * (a * b)), by ring) at hab,
+  apply hϖ,
+  apply eq_zero_of_mul_eq_self_right _ hab.symm,
+  exact λ hh, h2 (is_unit_of_dvd_one ϖ ⟨_, hh.symm⟩)
+end
+
+/-- An element of a DVR is irreducible iff it is a uniformizer, that is, generates the
+  maximal ideal of R -/
+theorem irreducible_iff_uniformizer (ϖ : R) :
+  irreducible ϖ ↔ maximal_ideal R = ideal.span {ϖ} :=
+⟨λ hϖ, (eq_maximal_ideal (is_maximal_of_irreducible hϖ)).symm, λ h,
+  irreducible_of_span_eq_maximal_ideal ϖ (λ e, not_a_field R $ by rwa [h, span_singleton_eq_bot]) h⟩
+
+lemma _root_.irreducible.maximal_ideal_eq {ϖ : R} (h : irreducible ϖ) :
+  maximal_ideal R = ideal.span {ϖ} :=
+(irreducible_iff_uniformizer _).mp h
+
+variable (R)
+
+/-- Uniformisers exist in a DVR -/
+theorem exists_irreducible : ∃ ϖ : R, irreducible ϖ :=
+by {simp_rw [irreducible_iff_uniformizer],
+    exact (is_principal_ideal_ring.principal $ maximal_ideal R).principal}
+
+/-- Uniformisers exist in a DVR -/
+theorem exists_prime : ∃ ϖ : R, prime ϖ :=
+(exists_irreducible R).imp (λ _, principal_ideal_ring.irreducible_iff_prime.1)
+
+/-- an integral domain is a DVR iff it's a PID with a unique non-zero prime ideal -/
+theorem iff_pid_with_one_nonzero_prime (R : Type u) [comm_ring R] [is_domain R] :
+  discrete_valuation_ring R ↔ is_principal_ideal_ring R ∧ ∃! P : ideal R, P ≠ ⊥ ∧ is_prime P :=
+begin
+  split,
+  { intro RDVR,
+    rcases id RDVR with ⟨Rlocal⟩,
+    split, assumption,
+    resetI,
+    use local_ring.maximal_ideal R,
+    split, split,
+    { assumption },
+    { apply_instance } ,
+    { rintro Q ⟨hQ1, hQ2⟩,
+      obtain ⟨q, rfl⟩ := (is_principal_ideal_ring.principal Q).1,
+      have hq : q ≠ 0,
+      { rintro rfl,
+        apply hQ1,
+        simp },
+      erw span_singleton_prime hq at hQ2,
+      replace hQ2 := hQ2.irreducible,
+      rw irreducible_iff_uniformizer at hQ2,
+      exact hQ2.symm } },
+  { rintro ⟨RPID, Punique⟩,
+    haveI : local_ring R := local_ring.of_unique_nonzero_prime Punique,
+    refine {not_a_field' := _},
+    rcases Punique with ⟨P, ⟨hP1, hP2⟩, hP3⟩,
+    have hPM : P ≤ maximal_ideal R := le_maximal_ideal (hP2.1),
+    intro h, rw [h, le_bot_iff] at hPM, exact hP1 hPM }
+end
+
+lemma associated_of_irreducible {a b : R} (ha : irreducible a) (hb : irreducible b) :
+  associated a b :=
+begin
+  rw irreducible_iff_uniformizer at ha hb,
+  rw [←span_singleton_eq_span_singleton, ←ha, hb],
+end
+
+end discrete_valuation_ring
+
+namespace discrete_valuation_ring
+
+variable (R : Type*)
+
+/-- Alternative characterisation of discrete valuation rings. -/
+def has_unit_mul_pow_irreducible_factorization [comm_ring R] : Prop :=
+∃ p : R, irreducible p ∧ ∀ {x : R}, x ≠ 0 → ∃ (n : ℕ), associated (p ^ n) x
+
+namespace has_unit_mul_pow_irreducible_factorization
+
+variables {R} [comm_ring R] (hR : has_unit_mul_pow_irreducible_factorization R)
+include hR
+
+lemma unique_irreducible ⦃p q : R⦄ (hp : irreducible p) (hq : irreducible q) :
+  associated p q :=
+begin
+  rcases hR with ⟨ϖ, hϖ, hR⟩,
+  suffices : ∀ {p : R} (hp : irreducible p), associated p ϖ,
+  { apply associated.trans (this hp) (this hq).symm, },
+  clear hp hq p q,
+  intros p hp,
+  obtain ⟨n, hn⟩ := hR hp.ne_zero,
+  have : irreducible (ϖ ^ n) := hn.symm.irreducible hp,
+  rcases lt_trichotomy n 1 with (H|rfl|H),
+  { obtain rfl : n = 0, { clear hn this, revert H n, exact dec_trivial },
+    simpa only [not_irreducible_one, pow_zero] using this, },
+  { simpa only [pow_one] using hn.symm, },
+  { obtain ⟨n, rfl⟩ : ∃ k, n = 1 + k + 1 := nat.exists_eq_add_of_lt H,
+    rw pow_succ at this,
+    rcases this.is_unit_or_is_unit rfl with H0|H0,
+    { exact (hϖ.not_unit H0).elim, },
+    { rw [add_comm, pow_succ] at H0,
+      exact (hϖ.not_unit (is_unit_of_mul_is_unit_left H0)).elim } }
+end
+
+variables [is_domain R]
+
+/-- An integral domain in which there is an irreducible element `p`
+such that every nonzero element is associated to a power of `p` is a unique factorization domain.
+See `discrete_valuation_ring.of_has_unit_mul_pow_irreducible_factorization`. -/
+theorem to_unique_factorization_monoid : unique_factorization_monoid R :=
+let p := classical.some hR in
+let spec := classical.some_spec hR in
+unique_factorization_monoid.of_exists_prime_factors $ λ x hx,
+begin
+  use multiset.replicate (classical.some (spec.2 hx)) p,
+  split,
+  { intros q hq,
+    have hpq := multiset.eq_of_mem_replicate hq,
+    rw hpq,
+    refine ⟨spec.1.ne_zero, spec.1.not_unit, _⟩,
+    intros a b h,
+    by_cases ha : a = 0,
+    { rw ha, simp only [true_or, dvd_zero], },
+    obtain ⟨m, u, rfl⟩ := spec.2 ha,
+    rw [mul_assoc, mul_left_comm, is_unit.dvd_mul_left _ _ _ (units.is_unit _)] at h,
+    rw is_unit.dvd_mul_right (units.is_unit _),
+    by_cases hm : m = 0,
+    { simp only [hm, one_mul, pow_zero] at h ⊢, right, exact h },
+    left,
+    obtain ⟨m, rfl⟩ := nat.exists_eq_succ_of_ne_zero hm,
+    rw pow_succ,
+    apply dvd_mul_of_dvd_left dvd_rfl _ },
+  { rw [multiset.prod_replicate], exact (classical.some_spec (spec.2 hx)), }
+end
+
+omit hR
+
+lemma of_ufd_of_unique_irreducible [unique_factorization_monoid R]
+  (h₁ : ∃ p : R, irreducible p)
+  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
+  has_unit_mul_pow_irreducible_factorization R :=
+begin
+  obtain ⟨p, hp⟩ := h₁,
+  refine ⟨p, hp, _⟩,
+  intros x hx,
+  cases wf_dvd_monoid.exists_factors x hx with fx hfx,
+  refine ⟨fx.card, _⟩,
+  have H := hfx.2,
+  rw ← associates.mk_eq_mk_iff_associated at H ⊢,
+  rw [← H, ← associates.prod_mk, associates.mk_pow, ← multiset.prod_replicate],
+  congr' 1,
+  symmetry,
+  rw multiset.eq_replicate,
+  simp only [true_and, and_imp, multiset.card_map, eq_self_iff_true,
+    multiset.mem_map, exists_imp_distrib],
+  rintros _ q hq rfl,
+  rw associates.mk_eq_mk_iff_associated,
+  apply h₂ (hfx.1 _ hq) hp,
+end
+
+end has_unit_mul_pow_irreducible_factorization
+
+lemma aux_pid_of_ufd_of_unique_irreducible
+  (R : Type u) [comm_ring R] [is_domain R] [unique_factorization_monoid R]
+  (h₁ : ∃ p : R, irreducible p)
+  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
+  is_principal_ideal_ring R :=
+begin
+  constructor,
+  intro I,
+  by_cases I0 : I = ⊥, { rw I0, use 0, simp only [set.singleton_zero, submodule.span_zero], },
+  obtain ⟨x, hxI, hx0⟩ : ∃ x ∈ I, x ≠ (0:R) := I.ne_bot_iff.mp I0,
+  obtain ⟨p, hp, H⟩ :=
+    has_unit_mul_pow_irreducible_factorization.of_ufd_of_unique_irreducible h₁ h₂,
+  have ex : ∃ n : ℕ, p ^ n ∈ I,
+  { obtain ⟨n, u, rfl⟩ := H hx0,
+    refine ⟨n, _⟩,
+    simpa only [units.mul_inv_cancel_right] using I.mul_mem_right ↑u⁻¹ hxI, },
+  constructor,
+  use p ^ (nat.find ex),
+  show I = ideal.span _,
+  apply le_antisymm,
+  { intros r hr,
+    by_cases hr0 : r = 0,
+    { simp only [hr0, submodule.zero_mem], },
+    obtain ⟨n, u, rfl⟩ := H hr0,
+    simp only [mem_span_singleton, units.is_unit, is_unit.dvd_mul_right],
+    apply pow_dvd_pow,
+    apply nat.find_min',
+    simpa only [units.mul_inv_cancel_right] using I.mul_mem_right ↑u⁻¹ hr, },
+  { erw submodule.span_singleton_le_iff_mem,
+    exact nat.find_spec ex, },
+end
+
+/--
+A unique factorization domain with at least one irreducible element
+in which all irreducible elements are associated
+is a discrete valuation ring.
+-/
+lemma of_ufd_of_unique_irreducible
+  {R : Type u} [comm_ring R] [is_domain R] [unique_factorization_monoid R]
+  (h₁ : ∃ p : R, irreducible p)
+  (h₂ : ∀ ⦃p q : R⦄, irreducible p → irreducible q → associated p q) :
+  discrete_valuation_ring R :=
+begin
+  rw iff_pid_with_one_nonzero_prime,
+  haveI PID : is_principal_ideal_ring R := aux_pid_of_ufd_of_unique_irreducible R h₁ h₂,
+  obtain ⟨p, hp⟩ := h₁,
+  refine ⟨PID, ⟨ideal.span {p}, ⟨_, _⟩, _⟩⟩,
+  { rw submodule.ne_bot_iff,
+    refine ⟨p, ideal.mem_span_singleton.mpr (dvd_refl p), hp.ne_zero⟩, },
+  { rwa [ideal.span_singleton_prime hp.ne_zero,
+        ← unique_factorization_monoid.irreducible_iff_prime], },
+  { intro I,
+    rw ← submodule.is_principal.span_singleton_generator I,
+    rintro ⟨I0, hI⟩,
+    apply span_singleton_eq_span_singleton.mpr,
+    apply h₂ _ hp,
+    erw [ne.def, span_singleton_eq_bot] at I0,
+    rwa [unique_factorization_monoid.irreducible_iff_prime, ← ideal.span_singleton_prime I0],
+    apply_instance, },
+end
+
+/--
+An integral domain in which there is an irreducible element `p`
+such that every nonzero element is associated to a power of `p`
+is a discrete valuation ring.
+-/
+lemma of_has_unit_mul_pow_irreducible_factorization {R : Type u} [comm_ring R] [is_domain R]
+  (hR : has_unit_mul_pow_irreducible_factorization R) :
+  discrete_valuation_ring R :=
+begin
+  letI : unique_factorization_monoid R := hR.to_unique_factorization_monoid,
+  apply of_ufd_of_unique_irreducible _ hR.unique_irreducible,
+  unfreezingI { obtain ⟨p, hp, H⟩ := hR, exact ⟨p, hp⟩, },
+end
+
+section
+
+variables [comm_ring R] [is_domain R] [discrete_valuation_ring R]
+
+variable {R}
+
+lemma associated_pow_irreducible {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
+  ∃ (n : ℕ), associated x (ϖ ^ n) :=
+begin
+  have : wf_dvd_monoid R := is_noetherian_ring.wf_dvd_monoid,
+  cases wf_dvd_monoid.exists_factors x hx with fx hfx,
+  unfreezingI { use fx.card },
+  have H := hfx.2,
+  rw ← associates.mk_eq_mk_iff_associated at H ⊢,
+  rw [← H, ← associates.prod_mk, associates.mk_pow, ← multiset.prod_replicate],
+  congr' 1,
+  rw multiset.eq_replicate,
+  simp only [true_and, and_imp, multiset.card_map, eq_self_iff_true,
+             multiset.mem_map, exists_imp_distrib],
+  rintros _ _ _ rfl,
+  rw associates.mk_eq_mk_iff_associated,
+  refine associated_of_irreducible _ _ hirr,
+  apply hfx.1,
+  assumption
+end
+
+lemma eq_unit_mul_pow_irreducible {x : R} (hx : x ≠ 0) {ϖ : R} (hirr : irreducible ϖ) :
+  ∃ (n : ℕ) (u : Rˣ), x = u * ϖ ^ n :=
+begin
+  obtain ⟨n, hn⟩ := associated_pow_irreducible hx hirr,
+  obtain ⟨u, rfl⟩ := hn.symm,
+  use [n, u],
+  apply mul_comm,
+end
+
+open submodule.is_principal
+
+lemma ideal_eq_span_pow_irreducible {s : ideal R} (hs : s ≠ ⊥) {ϖ : R} (hirr : irreducible ϖ) :
+  ∃ n : ℕ, s = ideal.span {ϖ ^ n} :=
+begin
+  have gen_ne_zero : generator s ≠ 0,
+  { rw [ne.def, ← eq_bot_iff_generator_eq_zero], assumption },
+  rcases associated_pow_irreducible gen_ne_zero hirr with ⟨n, u, hnu⟩,
+  use n,
+  have : span _ = _ := span_singleton_generator s,
+  rw [← this, ← hnu, span_singleton_eq_span_singleton],
+  use u
+end
+
+lemma unit_mul_pow_congr_pow {p q : R} (hp : irreducible p) (hq : irreducible q)
+  (u v : Rˣ) (m n : ℕ) (h : ↑u * p ^ m = v * q ^ n) :
+  m = n :=
+begin
+  have key : associated (multiset.replicate m p).prod (multiset.replicate n q).prod,
+  { rw [multiset.prod_replicate, multiset.prod_replicate, associated],
+    refine ⟨u * v⁻¹, _⟩,
+    simp only [units.coe_mul],
+    rw [mul_left_comm, ← mul_assoc, h, mul_right_comm, units.mul_inv, one_mul], },
+  have := multiset.card_eq_card_of_rel (unique_factorization_monoid.factors_unique _ _ key),
+  { simpa only [multiset.card_replicate] },
+  all_goals
+  { intros x hx,
+    unfreezingI { obtain rfl := multiset.eq_of_mem_replicate hx, assumption } },
+end
+
+lemma unit_mul_pow_congr_unit {ϖ : R} (hirr : irreducible ϖ) (u v : Rˣ) (m n : ℕ)
+  (h : ↑u * ϖ ^ m = v * ϖ ^ n) :
+  u = v :=
+begin
+  obtain rfl : m = n := unit_mul_pow_congr_pow hirr hirr u v m n h,
+  rw ← sub_eq_zero at h,
+  rw [← sub_mul, mul_eq_zero] at h,
+  cases h,
+  { rw sub_eq_zero at h, exact_mod_cast h },
+  { apply (hirr.ne_zero (pow_eq_zero h)).elim, }
+end
+
+/-!
+## The additive valuation on a DVR
+-/
+
+open multiplicity
+
+/-- The `part_enat`-valued additive valuation on a DVR -/
+noncomputable def add_val
+  (R : Type u) [comm_ring R] [is_domain R] [discrete_valuation_ring R] :
+  add_valuation R part_enat :=
+add_valuation (classical.some_spec (exists_prime R))
+
+lemma add_val_def (r : R) (u : Rˣ) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) (hr : r = u * ϖ ^ n) :
+  add_val R r = n :=
+by rw [add_val, add_valuation_apply, hr,
+    eq_of_associated_left (associated_of_irreducible R hϖ
+      (classical.some_spec (exists_prime R)).irreducible),
+    eq_of_associated_right (associated.symm ⟨u, mul_comm _ _⟩),
+    multiplicity_pow_self_of_prime (principal_ideal_ring.irreducible_iff_prime.1 hϖ)]
+
+lemma add_val_def' (u : Rˣ) {ϖ : R} (hϖ : irreducible ϖ) (n : ℕ) :
+  add_val R ((u : R) * ϖ ^ n) = n :=
+add_val_def _ u hϖ n rfl
+
+@[simp] lemma add_val_zero : add_val R 0 = ⊤ :=
+(add_val R).map_zero
+
+@[simp] lemma add_val_one : add_val R 1 = 0 :=
+(add_val R).map_one
+
+@[simp] lemma add_val_uniformizer {ϖ : R} (hϖ : irreducible ϖ) : add_val R ϖ = 1 :=
+by simpa only [one_mul, eq_self_iff_true, units.coe_one, pow_one, forall_true_left, nat.cast_one]
+  using add_val_def ϖ 1 hϖ 1
+
+@[simp] lemma add_val_mul {a b : R} :
+  add_val R (a * b) = add_val R a + add_val R b :=
+(add_val R).map_mul _ _
+
+lemma add_val_pow (a : R) (n : ℕ) : add_val R (a ^ n) = n • add_val R a :=
+(add_val R).map_pow _ _
+
+lemma _root_.irreducible.add_val_pow {ϖ : R} (h : irreducible ϖ) (n : ℕ) :
+  add_val R (ϖ ^ n) = n :=
+by rw [add_val_pow, add_val_uniformizer h, nsmul_one]
+
+lemma add_val_eq_top_iff {a : R} : add_val R a = ⊤ ↔ a = 0 :=
+begin
+  have hi := (classical.some_spec (exists_prime R)).irreducible,
+  split,
+  { contrapose,
+    intro h,
+    obtain ⟨n, ha⟩ := associated_pow_irreducible h hi,
+    obtain ⟨u, rfl⟩ := ha.symm,
+    rw [mul_comm, add_val_def' u hi n],
+    exact part_enat.coe_ne_top _ },
+  { rintro rfl,
+    exact add_val_zero }
+end
+
+lemma add_val_le_iff_dvd {a b : R} : add_val R a ≤ add_val R b ↔ a ∣ b :=
+begin
+  have hp := classical.some_spec (exists_prime R),
+  split; intro h,
+  { by_cases ha0 : a = 0,
+    { rw [ha0, add_val_zero, top_le_iff, add_val_eq_top_iff] at h,
+      rw h,
+      apply dvd_zero },
+    obtain ⟨n, ha⟩ := associated_pow_irreducible ha0 hp.irreducible,
+    rw [add_val, add_valuation_apply, add_valuation_apply,
+      multiplicity_le_multiplicity_iff] at h,
+    exact ha.dvd.trans (h n ha.symm.dvd), },
+  { rw [add_val, add_valuation_apply, add_valuation_apply],
+    exact multiplicity_le_multiplicity_of_dvd_right h }
+end
+
+lemma add_val_add {a b : R} :
+  min (add_val R a) (add_val R b) ≤ add_val R (a + b) :=
+(add_val R).map_add _ _
+
+end
+
+instance (R : Type*) [comm_ring R] [is_domain R] [discrete_valuation_ring R] :
+  is_Hausdorff (maximal_ideal R) R :=
+{ haus' := λ x hx,
+  begin
+    obtain ⟨ϖ, hϖ⟩ := exists_irreducible R,
+    simp only [← ideal.one_eq_top, smul_eq_mul, mul_one, smodeq.zero,
+      hϖ.maximal_ideal_eq, ideal.span_singleton_pow, ideal.mem_span_singleton,
+      ← add_val_le_iff_dvd, hϖ.add_val_pow] at hx,
+    rwa [← add_val_eq_top_iff, part_enat.eq_top_iff_forall_le],
+  end }
+
+end discrete_valuation_ring
diff --git a/src/ring_theory/discrete_valuation_ring/tfae.lean b/src/ring_theory/discrete_valuation_ring/tfae.lean
new file mode 100644
index 0000000000000..6beb45ac83a56
--- /dev/null
+++ b/src/ring_theory/discrete_valuation_ring/tfae.lean
@@ -0,0 +1,249 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.ideal.cotangent
+import ring_theory.dedekind_domain.basic
+import ring_theory.valuation.valuation_ring
+import ring_theory.nakayama
+
+/-!
+
+# Equivalent conditions for DVR
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In `discrete_valuation_ring.tfae`, we show that the following are equivalent for a
+noetherian local domain `(R, m, k)`:
+- `R` is a discrete valuation ring
+- `R` is a valuation ring
+- `R` is a dedekind domain
+- `R` is integrally closed with a unique prime ideal
+- `m` is principal
+- `dimₖ m/m² = 1`
+- Every nonzero ideal is a power of `m`.
+
+-/
+
+
+variables (R : Type*) [comm_ring R] (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]
+
+open_locale discrete_valuation
+open local_ring
+
+open_locale big_operators
+
+lemma exists_maximal_ideal_pow_eq_of_principal [is_noetherian_ring R] [local_ring R] [is_domain R]
+  (h : ¬ is_field R) (h' : (maximal_ideal R).is_principal) (I : ideal R) (hI : I ≠ ⊥) :
+    ∃ n : ℕ, I = (maximal_ideal R) ^ n :=
+begin
+  classical,
+  unfreezingI { obtain ⟨x, hx : _ = ideal.span _⟩ := h' },
+  by_cases hI' : I = ⊤, { use 0, rw [pow_zero, hI', ideal.one_eq_top] },
+  have H : ∀ r : R, ¬ (is_unit r) ↔ x ∣ r :=
+    λ r, (set_like.ext_iff.mp hx r).trans ideal.mem_span_singleton,
+  have : x ≠ 0,
+  { rintro rfl,
+    apply ring.ne_bot_of_is_maximal_of_not_is_field (maximal_ideal.is_maximal R) h,
+    simp [hx] },
+  have hx' := discrete_valuation_ring.irreducible_of_span_eq_maximal_ideal x this hx,
+  have H' : ∀ r : R, r ≠ 0 → r ∈ nonunits R → ∃ (n : ℕ), associated (x ^ n) r,
+  { intros r hr₁ hr₂,
+    obtain ⟨f, hf₁, rfl, hf₂⟩ := (wf_dvd_monoid.not_unit_iff_exists_factors_eq r hr₁).mp hr₂,
+    have : ∀ b ∈ f, associated x b,
+    { intros b hb,
+      exact irreducible.associated_of_dvd hx' (hf₁ b hb) ((H b).mp (hf₁ b hb).1) },
+    clear hr₁ hr₂ hf₁,
+    induction f using multiset.induction with fa fs fh,
+    { exact (hf₂ rfl).elim },
+    rcases eq_or_ne fs ∅ with rfl|hf',
+    { use 1,
+      rw [pow_one, multiset.prod_cons, multiset.empty_eq_zero, multiset.prod_zero, mul_one],
+      exact this _ (multiset.mem_cons_self _ _) },
+    { obtain ⟨n, hn⟩ := fh hf' (λ b hb, this _ (multiset.mem_cons_of_mem hb)),
+      use n + 1,
+      rw [pow_add, multiset.prod_cons, mul_comm, pow_one],
+      exact associated.mul_mul (this _ (multiset.mem_cons_self _ _)) hn } },
+  have : ∃ n : ℕ, x ^ n ∈ I,
+  { obtain ⟨r, hr₁, hr₂⟩ : ∃ r : R, r ∈ I ∧ r ≠ 0,
+    { by_contra h, push_neg at h, apply hI, rw eq_bot_iff, exact h },
+    obtain ⟨n, u, rfl⟩ := H' r hr₂ (le_maximal_ideal hI' hr₁),
+    use n,
+    rwa [← I.unit_mul_mem_iff_mem u.is_unit, mul_comm] },
+  use nat.find this,
+  apply le_antisymm,
+  { change ∀ s ∈ I, s ∈ _,
+    by_contra hI'',
+    push_neg at hI'',
+    obtain ⟨s, hs₁, hs₂⟩ := hI'',
+    apply hs₂,
+    by_cases hs₃ : s = 0, { rw hs₃, exact zero_mem _ },
+    obtain ⟨n, u, rfl⟩ := H' s hs₃ (le_maximal_ideal hI' hs₁),
+    rw [mul_comm, ideal.unit_mul_mem_iff_mem _ u.is_unit] at ⊢ hs₁,
+    apply ideal.pow_le_pow (nat.find_min' this hs₁),
+    apply ideal.pow_mem_pow,
+    exact (H _).mpr (dvd_refl _) },
+  { rw [hx, ideal.span_singleton_pow, ideal.span_le, set.singleton_subset_iff],
+    exact nat.find_spec this }
+end
+
+lemma maximal_ideal_is_principal_of_is_dedekind_domain
+  [local_ring R] [is_domain R] [is_dedekind_domain R] : (maximal_ideal R).is_principal :=
+begin
+  classical,
+  by_cases ne_bot : maximal_ideal R = ⊥,
+  { rw ne_bot, apply_instance },
+  obtain ⟨a, ha₁, ha₂⟩ : ∃ a ∈ maximal_ideal R, a ≠ (0 : R),
+  { by_contra h', push_neg at h', apply ne_bot, rwa eq_bot_iff },
+  have hle : ideal.span {a} ≤ maximal_ideal R,
+  { rwa [ideal.span_le, set.singleton_subset_iff] },
+  have : (ideal.span {a}).radical = maximal_ideal R,
+  { rw ideal.radical_eq_Inf,
+    apply le_antisymm,
+    { exact Inf_le ⟨hle, infer_instance⟩ },
+    { refine le_Inf (λ I hI, (eq_maximal_ideal $
+        is_dedekind_domain.dimension_le_one _ (λ e, ha₂ _) hI.2).ge),
+      rw [← ideal.span_singleton_eq_bot, eq_bot_iff, ← e], exact hI.1 } },
+  have : ∃ n, maximal_ideal R ^ n ≤ ideal.span {a},
+  { rw ← this, apply ideal.exists_radical_pow_le_of_fg, exact is_noetherian.noetherian _ },
+  cases hn : nat.find this,
+  { have := nat.find_spec this,
+    rw [hn, pow_zero, ideal.one_eq_top] at this,
+    exact (ideal.is_maximal.ne_top infer_instance (eq_top_iff.mpr $ this.trans hle)).elim },
+  obtain ⟨b, hb₁, hb₂⟩ : ∃ b ∈ maximal_ideal R ^ n, ¬ b ∈ ideal.span {a},
+  { by_contra h', push_neg at h', rw nat.find_eq_iff at hn,
+    exact hn.2 n n.lt_succ_self (λ x hx, not_not.mp (h' x hx)) },
+  have hb₃ : ∀ m ∈ maximal_ideal R, ∃ k : R, k * a = b * m,
+  { intros m hm, rw ← ideal.mem_span_singleton', apply nat.find_spec this,
+    rw [hn, pow_succ'], exact ideal.mul_mem_mul hb₁ hm },
+  have hb₄ : b ≠ 0,
+  { rintro rfl, apply hb₂, exact zero_mem _ },
+  let K := fraction_ring R,
+  let x : K := algebra_map R K b / algebra_map R K a,
+  let M := submodule.map (algebra.of_id R K).to_linear_map (maximal_ideal R),
+  have ha₃ : algebra_map R K a ≠ 0 := is_fraction_ring.to_map_eq_zero_iff.not.mpr ha₂,
+  by_cases hx : ∀ y ∈ M, x * y ∈ M,
+  { have := is_integral_of_smul_mem_submodule M _ _ x hx,
+    { obtain ⟨y, e⟩ := is_integrally_closed.algebra_map_eq_of_integral this,
+      refine (hb₂ (ideal.mem_span_singleton'.mpr ⟨y, _⟩)).elim,
+      apply is_fraction_ring.injective R K,
+      rw [map_mul, e, div_mul_cancel _ ha₃] },
+    { rw submodule.ne_bot_iff, refine ⟨_, ⟨a, ha₁, rfl⟩, _⟩,
+      exact is_fraction_ring.to_map_eq_zero_iff.not.mpr ha₂ },
+    { apply submodule.fg.map, exact is_noetherian.noetherian _ } },
+  { have : (M.map (distrib_mul_action.to_linear_map R K x)).comap
+      (algebra.of_id R K).to_linear_map = ⊤,
+    { by_contra h, apply hx,
+      rintros m' ⟨m, hm, (rfl : algebra_map R K m = m')⟩,
+      obtain ⟨k, hk⟩ := hb₃ m hm,
+      have hk' : x * algebra_map R K m = algebra_map R K k,
+      { rw [← mul_div_right_comm, ← map_mul, ← hk, map_mul, mul_div_cancel _ ha₃] },
+      exact ⟨k, le_maximal_ideal h ⟨_, ⟨_, hm, rfl⟩, hk'⟩, hk'.symm⟩ },
+    obtain ⟨y, hy₁, hy₂⟩ : ∃ y ∈ maximal_ideal R, b * y = a,
+    { rw [ideal.eq_top_iff_one, submodule.mem_comap] at this,
+      obtain ⟨_, ⟨y, hy, rfl⟩, hy' : x * algebra_map R K y = algebra_map R K 1⟩ := this,
+      rw [map_one, ← mul_div_right_comm, div_eq_one_iff_eq ha₃, ← map_mul] at hy',
+      exact ⟨y, hy, is_fraction_ring.injective R K hy'⟩ },
+    refine ⟨⟨y, _⟩⟩,
+    apply le_antisymm,
+    { intros m hm, obtain ⟨k, hk⟩ := hb₃ m hm, rw [← hy₂, mul_comm, mul_assoc] at hk,
+      rw [← mul_left_cancel₀ hb₄ hk, mul_comm], exact ideal.mem_span_singleton'.mpr ⟨_, rfl⟩ },
+    { rwa [submodule.span_le, set.singleton_subset_iff] } }
+end
+
+lemma discrete_valuation_ring.tfae [is_noetherian_ring R] [local_ring R] [is_domain R]
+  (h : ¬ is_field R) :
+  tfae [discrete_valuation_ring R,
+    valuation_ring R,
+    is_dedekind_domain R,
+    is_integrally_closed R ∧ ∃! P : ideal R, P ≠ ⊥ ∧ P.is_prime,
+    (maximal_ideal R).is_principal,
+    finite_dimensional.finrank (residue_field R) (cotangent_space R) = 1,
+    ∀ I ≠ ⊥, ∃ n : ℕ, I = (maximal_ideal R) ^ n] :=
+begin
+  have ne_bot := ring.ne_bot_of_is_maximal_of_not_is_field (maximal_ideal.is_maximal R) h,
+  classical,
+  rw finrank_eq_one_iff',
+  tfae_have : 1 → 2,
+  { introI _, apply_instance },
+  tfae_have : 2 → 1,
+  { introI _,
+    haveI := is_bezout.to_gcd_domain R,
+    haveI : unique_factorization_monoid R := ufm_of_gcd_of_wf_dvd_monoid,
+    apply discrete_valuation_ring.of_ufd_of_unique_irreducible,
+    { obtain ⟨x, hx₁, hx₂⟩ := ring.exists_not_is_unit_of_not_is_field h,
+      obtain ⟨p, hp₁, hp₂⟩ := wf_dvd_monoid.exists_irreducible_factor hx₂ hx₁,
+      exact ⟨p, hp₁⟩ },
+    { exact valuation_ring.unique_irreducible } },
+  tfae_have : 1 → 4,
+  { introI H,
+    exact ⟨infer_instance, ((discrete_valuation_ring.iff_pid_with_one_nonzero_prime R).mp H).2⟩ },
+  tfae_have : 4 → 3,
+  { rintros ⟨h₁, h₂⟩, exact ⟨infer_instance, λ I hI hI', unique_of_exists_unique h₂
+      ⟨ne_bot, infer_instance⟩ ⟨hI, hI'⟩ ▸ maximal_ideal.is_maximal R, h₁⟩ },
+  tfae_have : 3 → 5,
+  { introI h, exact maximal_ideal_is_principal_of_is_dedekind_domain R },
+  tfae_have : 5 → 6,
+  { rintro ⟨x, hx⟩,
+    have : x ∈ maximal_ideal R := by { rw hx, exact submodule.subset_span (set.mem_singleton x) },
+    let x' : maximal_ideal R := ⟨x, this⟩,
+    use submodule.quotient.mk x',
+    split,
+    { intro e,
+      rw submodule.quotient.mk_eq_zero at e,
+      apply ring.ne_bot_of_is_maximal_of_not_is_field (maximal_ideal.is_maximal R) h,
+      apply submodule.eq_bot_of_le_smul_of_le_jacobson_bot (maximal_ideal R),
+      { exact ⟨{x}, (finset.coe_singleton x).symm ▸ hx.symm⟩ },
+      { conv_lhs { rw hx },
+        rw submodule.mem_smul_top_iff at e,
+        rwa [submodule.span_le, set.singleton_subset_iff] },
+      { rw local_ring.jacobson_eq_maximal_ideal (⊥ : ideal R) bot_ne_top, exact le_refl _ } },
+    { refine λ w, quotient.induction_on' w $ λ y, _,
+      obtain ⟨y, hy⟩ := y,
+      rw [hx, submodule.mem_span_singleton] at hy,
+      obtain ⟨a, rfl⟩ := hy,
+      exact ⟨ideal.quotient.mk _ a, rfl⟩ } },
+  tfae_have : 6 → 5,
+  { rintro ⟨x, hx, hx'⟩,
+    induction x using quotient.induction_on',
+    use x,
+    apply le_antisymm,
+    swap, { rw [submodule.span_le, set.singleton_subset_iff], exact x.prop },
+    have h₁ : (ideal.span {x} : ideal R) ⊔ maximal_ideal R ≤
+      ideal.span {x} ⊔ (maximal_ideal R) • (maximal_ideal R),
+    { refine sup_le le_sup_left _,
+      rintros m hm,
+      obtain ⟨c, hc⟩ := hx' (submodule.quotient.mk ⟨m, hm⟩),
+      induction c using quotient.induction_on',
+      rw ← sub_sub_cancel (c * x) m,
+      apply sub_mem _ _,
+      { apply_instance },
+      { refine ideal.mem_sup_left (ideal.mem_span_singleton'.mpr ⟨c, rfl⟩) },
+      { have := (submodule.quotient.eq _).mp hc,
+        rw [submodule.mem_smul_top_iff] at this,
+        exact ideal.mem_sup_right this } },
+    have h₂ : maximal_ideal R ≤ (⊥ : ideal R).jacobson,
+    { rw local_ring.jacobson_eq_maximal_ideal, exacts [le_refl _, bot_ne_top] },
+    have := submodule.smul_sup_eq_smul_sup_of_le_smul_of_le_jacobson
+      (is_noetherian.noetherian _) h₂ h₁,
+    rw [submodule.bot_smul, sup_bot_eq] at this,
+    rw [← sup_eq_left, eq_comm],
+    exact le_sup_left.antisymm (h₁.trans $ le_of_eq this) },
+  tfae_have : 5 → 7,
+  { exact exists_maximal_ideal_pow_eq_of_principal R h },
+  tfae_have : 7 → 2,
+  { rw valuation_ring.iff_ideal_total,
+    intro H,
+    constructor,
+    intros I J,
+    by_cases hI : I = ⊥, { subst hI,  left, exact bot_le },
+    by_cases hJ : J = ⊥, { subst hJ, right, exact bot_le },
+    obtain ⟨n, rfl⟩ := H I hI,
+    obtain ⟨m, rfl⟩ := H J hJ,
+    cases le_total m n with h' h',
+    {  left, exact ideal.pow_le_pow h' },
+    { right, exact ideal.pow_le_pow h' } },
+  tfae_finish,
+end
diff --git a/src/ring_theory/discriminant.lean b/src/ring_theory/discriminant.lean
index cb55318b03c98..57849e8c1f982 100644
--- a/src/ring_theory/discriminant.lean
+++ b/src/ring_theory/discriminant.lean
@@ -6,11 +6,14 @@ Authors: Riccardo Brasca
 
 import ring_theory.trace
 import ring_theory.norm
-import number_theory.number_field
+import number_theory.number_field.basic
 
 /-!
 # Discriminant of a family of vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given an `A`-algebra `B` and `b`, an `ι`-indexed family of elements of `B`, we define the
 *discriminant* of `b` as the determinant of the matrix whose `(i j)`-th element is the trace of
 `b i * b j`.
@@ -89,7 +92,7 @@ begin
   { ext i,
     have : ∀ j, (trace A B) (b i * b j) * g j = (trace A B) (((g j) • (b j)) * b i),
     { intro j, simp [mul_comm], },
-    simp only [mul_vec, dot_product, trace_matrix, pi.zero_apply, trace_form_apply,
+    simp only [mul_vec, dot_product, trace_matrix_apply, pi.zero_apply, trace_form_apply,
       λ j, this j, ← linear_map.map_sum, ← sum_mul, hg, zero_mul, linear_map.map_zero] },
   by_contra h,
   rw discr_def at h,
@@ -123,16 +126,15 @@ variables [module.finite K L]  [is_alg_closed E]
 /-- Over a field, if `b` is a basis, then `algebra.discr K b ≠ 0`. -/
 lemma discr_not_zero_of_basis [is_separable K L] (b : basis ι K L) : discr K b ≠ 0 :=
 begin
-  by_cases h : nonempty ι,
-  { classical,
-    have := span_eq_top_of_linear_independent_of_card_eq_finrank b.linear_independent
+  casesI is_empty_or_nonempty ι,
+  { simp [discr] },
+  { have := span_eq_top_of_linear_independent_of_card_eq_finrank b.linear_independent
       (finrank_eq_card_basis b).symm,
-    rw [discr_def, trace_matrix_def],
-    simp_rw [← basis.mk_apply b.linear_independent this],
-    rw [← trace_matrix_def, trace_matrix_of_basis, ← bilin_form.nondegenerate_iff_det_ne_zero],
-    exact trace_form_nondegenerate _ _  },
-  letI := not_nonempty_iff.1 h,
-  simp [discr],
+    classical,
+    rw [discr_def, trace_matrix],
+    simp_rw [← basis.mk_apply b.linear_independent this.ge],
+    rw [← trace_matrix, trace_matrix_of_basis, ← bilin_form.nondegenerate_iff_det_ne_zero],
+    exact trace_form_nondegenerate _ _ },
 end
 
 /-- Over a field, if `b` is a basis, then `algebra.discr K b` is a unit. -/
@@ -154,7 +156,7 @@ by rw [discr_def, ring_hom.map_det, ring_hom.map_matrix_apply,
 /-- The discriminant of a power basis. -/
 lemma discr_power_basis_eq_prod (e : fin pb.dim ≃ (L →ₐ[K] E)) [is_separable K L] :
   algebra_map K E (discr K pb.basis) =
-  ∏ i : fin pb.dim, ∏ j in finset.univ.filter (λ j, i < j), (e j pb.gen- (e i pb.gen)) ^ 2 :=
+  ∏ i : fin pb.dim, ∏ j in Ioi i, (e j pb.gen- (e i pb.gen)) ^ 2 :=
 begin
   rw [discr_eq_det_embeddings_matrix_reindex_pow_two K E pb.basis e,
     embeddings_matrix_reindex_eq_vandermonde, det_transpose, det_vandermonde, ← prod_pow],
@@ -165,8 +167,7 @@ end
 /-- A variation of `of_power_basis_eq_prod`. -/
 lemma discr_power_basis_eq_prod' [is_separable K L] (e : fin pb.dim ≃ (L →ₐ[K] E)) :
   algebra_map K E (discr K pb.basis) =
-  ∏ i : fin pb.dim, ∏ j in finset.univ.filter (λ j, i < j),
-  -((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))) :=
+  ∏ i : fin pb.dim, ∏ j in Ioi i, -((e j pb.gen - e i pb.gen) * (e i pb.gen - e j pb.gen)) :=
 begin
   rw [discr_power_basis_eq_prod _ _ _ e],
   congr, ext i, congr, ext j,
@@ -178,8 +179,8 @@ local notation `n` := finrank K L
 /-- A variation of `of_power_basis_eq_prod`. -/
 lemma discr_power_basis_eq_prod'' [is_separable K L] (e : fin pb.dim ≃ (L →ₐ[K] E)) :
   algebra_map K E (discr K pb.basis) =
-  (-1) ^ (n * (n - 1) / 2) * ∏ i : fin pb.dim, ∏ j in finset.univ.filter (λ j, i < j),
-  ((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))) :=
+  (-1) ^ (n * (n - 1) / 2) * ∏ i : fin pb.dim, ∏ j in Ioi i,
+    (e j pb.gen - e i pb.gen) * (e i pb.gen - e j pb.gen) :=
 begin
   rw [discr_power_basis_eq_prod' _ _ _ e],
   simp_rw [λ i j, neg_eq_neg_one_mul ((e j pb.gen- (e i pb.gen)) * (e i pb.gen- (e j pb.gen))),
@@ -187,11 +188,9 @@ begin
   congr,
   simp only [prod_pow_eq_pow_sum, prod_const],
   congr,
-  simp_rw [fin.card_filter_lt],
-  apply (@nat.cast_inj ℚ _ _ _ _ _).1,
-  rw [nat.cast_sum],
+  rw [← @nat.cast_inj ℚ, nat.cast_sum],
   have : ∀ (x : fin pb.dim), (↑x + 1) ≤ pb.dim := by simp [nat.succ_le_iff, fin.is_lt],
-  simp_rw [nat.sub_sub],
+  simp_rw [fin.card_Ioi, nat.sub_sub, add_comm 1],
   simp only [nat.cast_sub, this, finset.card_fin, nsmul_eq_mul, sum_const, sum_sub_distrib,
     nat.cast_add, nat.cast_one, sum_add_distrib, mul_one],
   rw [← nat.cast_sum, ← @finset.sum_range ℕ _ pb.dim (λ i, i), sum_range_id ],
@@ -230,7 +229,7 @@ begin
   rw [ring_hom.map_mul, ring_hom.map_pow, ring_hom.map_neg, ring_hom.map_one,
     discr_power_basis_eq_prod'' _ _ _ e],
   congr,
-  rw [norm_eq_prod_embeddings, fin.prod_filter_lt_mul_neg_eq_prod_off_diag],
+  rw [norm_eq_prod_embeddings, prod_prod_Ioi_mul_eq_prod_prod_off_diag],
   conv_rhs { congr, skip, funext,
     rw [← aeval_alg_hom_apply, aeval_root_derivative_of_splits (minpoly.monic
       (is_separable.is_integral K pb.gen)) (is_alg_closed.splits_codomain _) (hroots σ),
@@ -241,16 +240,15 @@ begin
   { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma],
     rw [multiset.mem_erase_of_ne (λ h, _)],
     { exact hroots _ },
-    { simp only [true_and, mem_filter, mem_univ, ne.def, mem_sigma] at hi,
-      refine hi (equiv.injective e (equiv.injective (power_basis.lift_equiv pb) _)),
+    { simp only [true_and, mem_univ, ne.def, mem_sigma, mem_compl, mem_singleton] at hi,
       rw [← power_basis.lift_equiv_apply_coe, ← power_basis.lift_equiv_apply_coe] at h,
-      exact subtype.eq h } },
+      exact hi (e.injective $ pb.lift_equiv.injective $ subtype.eq h.symm) } },
   { simp only [equiv.apply_eq_iff_eq, heq_iff_eq] at hij,
     have h := hij.2,
     rw [← power_basis.lift_equiv_apply_coe, ← power_basis.lift_equiv_apply_coe] at h,
     refine sigma.eq (equiv.injective e (equiv.injective _ (subtype.eq h))) (by simp [hij.1]) },
-  { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma] at hσ,
-    simp only [sigma.exists, true_and, exists_prop, mem_filter, mem_univ, ne.def, mem_sigma],
+  { simp only [true_and, finset.mem_mk, mem_univ, mem_sigma] at ⊢ hσ,
+    simp only [sigma.exists, exists_prop, mem_compl, mem_singleton, ne.def],
     refine ⟨e.symm (power_basis.lift pb σ.2 _), e.symm σ.1, ⟨λ h, _, sigma.eq _ _⟩⟩,
     { rw [aeval_def, eval₂_eq_eval_map, ← is_root.def, ← mem_roots],
       { exact multiset.erase_subset _ _ hσ },
@@ -266,8 +264,6 @@ section integral
 
 variables {R : Type z} [comm_ring R] [algebra R K] [algebra R L] [is_scalar_tower R K L]
 
-local notation `is_integral` := _root_.is_integral
-
 /-- If `K` and `L` are fields and `is_scalar_tower R K L`, and `b : ι → L` satisfies
 ` ∀ i, is_integral R (b i)`, then `is_integral R (discr K b)`. -/
 lemma discr_is_integral {b : ι → L} (h : ∀ i, is_integral R (b i)) :
diff --git a/src/ring_theory/eisenstein_criterion.lean b/src/ring_theory/eisenstein_criterion.lean
index efd0a39bcc2af..78fc40f281f19 100644
--- a/src/ring_theory/eisenstein_criterion.lean
+++ b/src/ring_theory/eisenstein_criterion.lean
@@ -3,11 +3,16 @@ Copyright (c) 2020 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
+import data.nat.cast.with_top
 import ring_theory.prime
 import ring_theory.polynomial.content
+import ring_theory.ideal.quotient_operations
 /-!
 # Eisenstein's criterion
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A proof of a slight generalisation of Eisenstein's criterion for the irreducibility of
 a polynomial over an integral domain.
 -/
diff --git a/src/ring_theory/etale.lean b/src/ring_theory/etale.lean
new file mode 100644
index 0000000000000..93367714fc187
--- /dev/null
+++ b/src/ring_theory/etale.lean
@@ -0,0 +1,573 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.quotient_nilpotent
+import ring_theory.kaehler
+
+/-!
+
+# Formally étale morphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+An `R`-algebra `A` is formally étale (resp. unramified, smooth) if for every `R`-algebra,
+every square-zero ideal `I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists
+exactly (resp. at most, at least) one lift `A →ₐ[R] B`.
+
+We show that the property extends onto nilpotent ideals, and that these properties are stable
+under `R`-algebra homomorphisms and compositions.
+
+-/
+
+universes u
+
+namespace algebra
+
+section
+
+variables (R : Type u) [comm_semiring R]
+variables (A : Type u) [semiring A] [algebra R A]
+variables {B : Type u} [comm_ring B] [algebra R B] (I : ideal B)
+
+include R A
+
+/-- An `R`-algebra `A` is formally unramified if for every `R`-algebra, every square-zero ideal
+`I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists at most one lift `A →ₐ[R] B`. -/
+@[mk_iff]
+class formally_unramified : Prop :=
+(comp_injective :
+  ∀ ⦃B : Type u⦄ [comm_ring B], by exactI ∀ [algebra R B] (I : ideal B) (hI : I ^ 2 = ⊥), by exactI
+    function.injective ((ideal.quotient.mkₐ R I).comp : (A →ₐ[R] B) → (A →ₐ[R] B ⧸ I)))
+
+/-- An `R` algebra `A` is formally smooth if for every `R`-algebra, every square-zero ideal
+`I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists at least one lift `A →ₐ[R] B`. -/
+@[mk_iff]
+class formally_smooth : Prop :=
+(comp_surjective :
+  ∀ ⦃B : Type u⦄ [comm_ring B], by exactI ∀ [algebra R B] (I : ideal B) (hI : I ^ 2 = ⊥), by exactI
+  function.surjective ((ideal.quotient.mkₐ R I).comp : (A →ₐ[R] B) → (A →ₐ[R] B ⧸ I)))
+
+/-- An `R` algebra `A` is formally étale if for every `R`-algebra, every square-zero ideal
+`I : ideal B` and `f : A →ₐ[R] B ⧸ I`, there exists exactly one lift `A →ₐ[R] B`. -/
+@[mk_iff]
+class formally_etale : Prop :=
+(comp_bijective :
+  ∀ ⦃B : Type u⦄ [comm_ring B], by exactI ∀ [algebra R B] (I : ideal B) (hI : I ^ 2 = ⊥), by exactI
+  function.bijective ((ideal.quotient.mkₐ R I).comp : (A →ₐ[R] B) → (A →ₐ[R] B ⧸ I)))
+
+variables {R A}
+
+lemma formally_etale.iff_unramified_and_smooth :
+  formally_etale R A ↔ formally_unramified R A ∧ formally_smooth R A :=
+begin
+  rw [formally_unramified_iff, formally_smooth_iff, formally_etale_iff],
+  simp_rw ← forall_and_distrib,
+  refl
+end
+
+@[priority 100]
+instance formally_etale.to_unramified [h : formally_etale R A] : formally_unramified R A :=
+(formally_etale.iff_unramified_and_smooth.mp h).1
+
+@[priority 100]
+instance formally_etale.to_smooth [h : formally_etale R A] : formally_smooth R A :=
+(formally_etale.iff_unramified_and_smooth.mp h).2
+
+lemma formally_etale.of_unramified_and_smooth [h₁ : formally_unramified R A]
+  [h₂ : formally_smooth R A] : formally_etale R A :=
+formally_etale.iff_unramified_and_smooth.mpr ⟨h₁, h₂⟩
+
+omit R A
+
+lemma formally_unramified.lift_unique {B : Type u} [comm_ring B] [_RB : algebra R B]
+  [formally_unramified R A] (I : ideal B)
+  (hI : is_nilpotent I) (g₁ g₂ : A →ₐ[R] B) (h : (ideal.quotient.mkₐ R I).comp g₁ =
+  (ideal.quotient.mkₐ R I).comp g₂) : g₁ = g₂ :=
+begin
+  revert g₁ g₂,
+  change function.injective (ideal.quotient.mkₐ R I).comp,
+  unfreezingI { revert _RB },
+  apply ideal.is_nilpotent.induction_on I hI,
+  { introsI B _ I hI _, exact formally_unramified.comp_injective I hI },
+  { introsI B _ I J hIJ h₁ h₂ _ g₁ g₂ e,
+    apply h₁,
+    apply h₂,
+    ext x,
+    replace e := alg_hom.congr_fun e x,
+    dsimp only [alg_hom.comp_apply, ideal.quotient.mkₐ_eq_mk] at e ⊢,
+    rwa [ideal.quotient.eq, ← map_sub, ideal.mem_quotient_iff_mem hIJ, ← ideal.quotient.eq] },
+end
+
+lemma formally_unramified.ext [formally_unramified R A] (hI : is_nilpotent I)
+  {g₁ g₂ : A →ₐ[R] B} (H : ∀ x, ideal.quotient.mk I (g₁ x) = ideal.quotient.mk I (g₂ x)) :
+  g₁ = g₂ :=
+formally_unramified.lift_unique I hI g₁ g₂ (alg_hom.ext H)
+
+lemma formally_unramified.lift_unique_of_ring_hom [formally_unramified R A]
+  {C : Type u} [comm_ring C] (f : B →+* C) (hf : is_nilpotent f.ker)
+  (g₁ g₂ : A →ₐ[R] B) (h : f.comp ↑g₁ = f.comp (g₂ : A →+* B)) : g₁ = g₂ :=
+formally_unramified.lift_unique _ hf _ _
+begin
+  ext x,
+  have := ring_hom.congr_fun h x,
+  simpa only [ideal.quotient.eq, function.comp_app, alg_hom.coe_comp, ideal.quotient.mkₐ_eq_mk,
+    ring_hom.mem_ker, map_sub, sub_eq_zero],
+end
+
+lemma formally_unramified.ext' [formally_unramified R A]
+  {C : Type u} [comm_ring C] (f : B →+* C) (hf : is_nilpotent f.ker)
+  (g₁ g₂ : A →ₐ[R] B) (h : ∀ x, f (g₁ x) = f (g₂ x)) : g₁ = g₂ :=
+formally_unramified.lift_unique_of_ring_hom f hf g₁ g₂ (ring_hom.ext h)
+
+lemma formally_unramified.lift_unique' [formally_unramified R A]
+  {C : Type u} [comm_ring C] [algebra R C] (f : B →ₐ[R] C) (hf : is_nilpotent (f : B →+* C).ker)
+  (g₁ g₂ : A →ₐ[R] B) (h : f.comp g₁ = f.comp g₂) : g₁ = g₂ :=
+formally_unramified.ext' _ hf g₁ g₂ (alg_hom.congr_fun h)
+
+lemma formally_smooth.exists_lift {B : Type u} [comm_ring B] [_RB : algebra R B]
+  [formally_smooth R A] (I : ideal B)
+  (hI : is_nilpotent I) (g : A →ₐ[R] B ⧸ I) :
+    ∃ f : A →ₐ[R] B, (ideal.quotient.mkₐ R I).comp f = g :=
+begin
+  revert g,
+  change function.surjective (ideal.quotient.mkₐ R I).comp,
+  unfreezingI { revert _RB },
+  apply ideal.is_nilpotent.induction_on I hI,
+  { introsI B _ I hI _, exact formally_smooth.comp_surjective I hI },
+  { introsI B _ I J hIJ h₁ h₂ _ g,
+    let : ((B ⧸ I) ⧸ J.map (ideal.quotient.mk I)) ≃ₐ[R] B ⧸ J :=
+      { commutes' := λ x, rfl,
+        ..((double_quot.quot_quot_equiv_quot_sup I J).trans
+          (ideal.quot_equiv_of_eq (sup_eq_right.mpr hIJ))) },
+    obtain ⟨g', e⟩ := h₂ (this.symm.to_alg_hom.comp g),
+    obtain ⟨g', rfl⟩ := h₁ g',
+    replace e := congr_arg this.to_alg_hom.comp e,
+    conv_rhs at e { rw [← alg_hom.comp_assoc, alg_equiv.to_alg_hom_eq_coe,
+      alg_equiv.to_alg_hom_eq_coe, alg_equiv.comp_symm, alg_hom.id_comp] },
+    exact ⟨g', e⟩ }
+end
+
+/-- For a formally smooth `R`-algebra `A` and a map `f : A →ₐ[R] B ⧸ I` with `I` square-zero,
+this is an arbitrary lift `A →ₐ[R] B`. -/
+noncomputable
+def formally_smooth.lift [formally_smooth R A] (I : ideal B)
+  (hI : is_nilpotent I) (g : A →ₐ[R] B ⧸ I) : A →ₐ[R] B :=
+(formally_smooth.exists_lift I hI g).some
+
+@[simp]
+lemma formally_smooth.comp_lift [formally_smooth R A] (I : ideal B)
+  (hI : is_nilpotent I) (g : A →ₐ[R] B ⧸ I) :
+    (ideal.quotient.mkₐ R I).comp (formally_smooth.lift I hI g) = g :=
+(formally_smooth.exists_lift I hI g).some_spec
+
+@[simp]
+lemma formally_smooth.mk_lift [formally_smooth R A] (I : ideal B)
+  (hI : is_nilpotent I) (g : A →ₐ[R] B ⧸ I) (x : A) :
+    ideal.quotient.mk I (formally_smooth.lift I hI g x) = g x :=
+alg_hom.congr_fun (formally_smooth.comp_lift I hI g : _) x
+
+variables {C : Type u} [comm_ring C] [algebra R C]
+
+/-- For a formally smooth `R`-algebra `A` and a map `f : A →ₐ[R] B ⧸ I` with `I` nilpotent,
+this is an arbitrary lift `A →ₐ[R] B`. -/
+noncomputable
+def formally_smooth.lift_of_surjective [formally_smooth R A] (f : A →ₐ[R] C) (g : B →ₐ[R] C)
+  (hg : function.surjective g) (hg' : is_nilpotent (g : B →+* C).ker) : A →ₐ[R] B :=
+formally_smooth.lift _ hg'
+  ((ideal.quotient_ker_alg_equiv_of_surjective hg).symm.to_alg_hom.comp f)
+
+@[simp]
+lemma formally_smooth.lift_of_surjective_apply [formally_smooth R A] (f : A →ₐ[R] C) (g : B →ₐ[R] C)
+  (hg : function.surjective g) (hg' : is_nilpotent (g : B →+* C).ker) (x : A) :
+    g (formally_smooth.lift_of_surjective f g hg hg' x) = f x :=
+begin
+  apply (ideal.quotient_ker_alg_equiv_of_surjective hg).symm.injective,
+  change _ = ((ideal.quotient_ker_alg_equiv_of_surjective hg).symm.to_alg_hom.comp f) x,
+  rw [← formally_smooth.mk_lift _ hg'
+    ((ideal.quotient_ker_alg_equiv_of_surjective hg).symm.to_alg_hom.comp f)],
+  apply (ideal.quotient_ker_alg_equiv_of_surjective hg).injective,
+  rw [alg_equiv.apply_symm_apply, ideal.quotient_ker_alg_equiv_of_surjective,
+    ideal.quotient_ker_alg_equiv_of_right_inverse.apply],
+  exact (ideal.ker_lift_alg_mk _ _).symm
+end
+
+@[simp]
+lemma formally_smooth.comp_lift_of_surjective [formally_smooth R A] (f : A →ₐ[R] C) (g : B →ₐ[R] C)
+  (hg : function.surjective g) (hg' : is_nilpotent (g : B →+* C).ker) :
+    g.comp (formally_smooth.lift_of_surjective f g hg hg') = f :=
+alg_hom.ext (formally_smooth.lift_of_surjective_apply f g hg hg')
+
+end
+
+section of_equiv
+
+variables {R : Type u} [comm_semiring R]
+variables {A B : Type u} [semiring A] [algebra R A] [semiring B] [algebra R B]
+
+lemma formally_smooth.of_equiv [formally_smooth R A] (e : A ≃ₐ[R] B) : formally_smooth R B :=
+begin
+  constructor,
+  introsI C _ _ I hI f,
+  use (formally_smooth.lift I ⟨2, hI⟩ (f.comp e : A →ₐ[R] C ⧸ I)).comp e.symm,
+  rw [← alg_hom.comp_assoc, formally_smooth.comp_lift, alg_hom.comp_assoc, alg_equiv.comp_symm,
+    alg_hom.comp_id],
+end
+
+lemma formally_unramified.of_equiv [formally_unramified R A] (e : A ≃ₐ[R] B) :
+  formally_unramified R B :=
+begin
+  constructor,
+  introsI C _ _ I hI f₁ f₂ e',
+  rw [← f₁.comp_id, ← f₂.comp_id, ← e.comp_symm, ← alg_hom.comp_assoc, ← alg_hom.comp_assoc],
+  congr' 1,
+  refine formally_unramified.comp_injective I hI _,
+  rw [← alg_hom.comp_assoc, e', alg_hom.comp_assoc],
+end
+
+lemma formally_etale.of_equiv [formally_etale R A] (e : A ≃ₐ[R] B) : formally_etale R B :=
+formally_etale.iff_unramified_and_smooth.mpr
+  ⟨formally_unramified.of_equiv e, formally_smooth.of_equiv e⟩
+
+end of_equiv
+
+section polynomial
+
+open_locale polynomial
+variables (R : Type u) [comm_semiring R]
+
+instance formally_smooth.mv_polynomial (σ : Type u) : formally_smooth R (mv_polynomial σ R) :=
+begin
+  constructor,
+  introsI C _ _ I hI f,
+  have : ∀ (s : σ), ∃ c : C, ideal.quotient.mk I c = f (mv_polynomial.X s),
+  { exact λ s, ideal.quotient.mk_surjective _ },
+  choose g hg,
+  refine ⟨mv_polynomial.aeval g, _⟩,
+  ext s,
+  rw [← hg, alg_hom.comp_apply, mv_polynomial.aeval_X],
+  refl,
+end
+
+instance formally_smooth.polynomial : formally_smooth R R[X] :=
+@@formally_smooth.of_equiv _ _ _ _ _
+  (formally_smooth.mv_polynomial R punit) (mv_polynomial.punit_alg_equiv R)
+
+end polynomial
+
+section comp
+
+variables (R : Type u) [comm_semiring R]
+variables (A : Type u) [comm_semiring A] [algebra R A]
+variables (B : Type u) [semiring B] [algebra R B] [algebra A B] [is_scalar_tower R A B]
+
+lemma formally_smooth.comp [formally_smooth R A] [formally_smooth A B] :
+  formally_smooth R B :=
+begin
+  constructor,
+  introsI C _ _ I hI f,
+  obtain ⟨f', e⟩ := formally_smooth.comp_surjective I hI
+    (f.comp (is_scalar_tower.to_alg_hom R A B)),
+  letI := f'.to_ring_hom.to_algebra,
+  obtain ⟨f'', e'⟩ := formally_smooth.comp_surjective I hI
+    { commutes' := alg_hom.congr_fun e.symm, ..f.to_ring_hom },
+  apply_fun (alg_hom.restrict_scalars R) at e',
+  exact ⟨f''.restrict_scalars _, e'.trans (alg_hom.ext $ λ _, rfl)⟩,
+end
+
+lemma formally_unramified.comp [formally_unramified R A] [formally_unramified A B] :
+  formally_unramified R B :=
+begin
+  constructor,
+  introsI C _ _ I hI f₁ f₂ e,
+  have e' := formally_unramified.lift_unique I ⟨2, hI⟩ (f₁.comp $ is_scalar_tower.to_alg_hom R A B)
+    (f₂.comp $ is_scalar_tower.to_alg_hom R A B)
+    (by rw [← alg_hom.comp_assoc, e, alg_hom.comp_assoc]),
+  letI := (f₁.comp (is_scalar_tower.to_alg_hom R A B)).to_ring_hom.to_algebra,
+  let F₁ : B →ₐ[A] C := { commutes' := λ r, rfl, ..f₁ },
+  let F₂ : B →ₐ[A] C := { commutes' := alg_hom.congr_fun e'.symm, ..f₂ },
+  ext1,
+  change F₁ x = F₂ x,
+  congr,
+  exact formally_unramified.ext I ⟨2, hI⟩ (alg_hom.congr_fun e),
+end
+
+lemma formally_unramified.of_comp [formally_unramified R B] :
+  formally_unramified A B :=
+begin
+  constructor,
+  introsI Q _ _ I e f₁ f₂ e',
+  letI := ((algebra_map A Q).comp (algebra_map R A)).to_algebra,
+  letI : is_scalar_tower R A Q := is_scalar_tower.of_algebra_map_eq' rfl,
+  refine alg_hom.restrict_scalars_injective R _,
+  refine formally_unramified.ext I ⟨2, e⟩ _,
+  intro x,
+  exact alg_hom.congr_fun e' x
+end
+
+lemma formally_etale.comp [formally_etale R A] [formally_etale A B] : formally_etale R B :=
+formally_etale.iff_unramified_and_smooth.mpr
+  ⟨formally_unramified.comp R A B, formally_smooth.comp R A B⟩
+
+end comp
+
+section of_surjective
+
+variables {R S : Type u} [comm_ring R] [comm_semiring S]
+variables {P A : Type u} [comm_ring A] [algebra R A] [comm_ring P] [algebra R P]
+variables (I : ideal P) (f : P →ₐ[R] A) (hf : function.surjective f)
+
+lemma formally_smooth.of_split [formally_smooth R P] (g : A →ₐ[R] P ⧸ f.to_ring_hom.ker ^ 2)
+  (hg : f.ker_square_lift.comp g = alg_hom.id R A) :
+  formally_smooth R A :=
+begin
+  constructor,
+  introsI C _ _ I hI i,
+  let l : P ⧸ f.to_ring_hom.ker ^ 2 →ₐ[R] C,
+  { refine ideal.quotient.liftₐ _ (formally_smooth.lift I ⟨2, hI⟩ (i.comp f)) _,
+    have : ring_hom.ker f ≤ I.comap (formally_smooth.lift I ⟨2, hI⟩ (i.comp f)),
+    { rintros x (hx : f x = 0),
+      have : _ = i (f x) := (formally_smooth.mk_lift I ⟨2, hI⟩ (i.comp f) x : _),
+      rwa [hx, map_zero, ← ideal.quotient.mk_eq_mk, submodule.quotient.mk_eq_zero] at this },
+    intros x hx,
+    have := (ideal.pow_mono this 2).trans (ideal.le_comap_pow _ 2) hx,
+    rwa hI at this },
+  have : i.comp f.ker_square_lift = (ideal.quotient.mkₐ R _).comp l,
+  { apply alg_hom.coe_ring_hom_injective,
+    apply ideal.quotient.ring_hom_ext,
+    ext x,
+    exact (formally_smooth.mk_lift I ⟨2, hI⟩ (i.comp f) x).symm },
+  exact ⟨l.comp g, by rw [← alg_hom.comp_assoc, ← this, alg_hom.comp_assoc, hg, alg_hom.comp_id]⟩
+end
+
+include hf
+
+/-- Let `P →ₐ[R] A` be a surjection with kernel `J`, and `P` a formally smooth `R`-algebra,
+then `A` is formally smooth over `R` iff the surjection `P ⧸ J ^ 2 →ₐ[R] A` has a section.
+
+Geometric intuition: we require that a first-order thickening of `Spec A` inside `Spec P` admits
+a retraction. -/
+lemma formally_smooth.iff_split_surjection [formally_smooth R P] :
+  formally_smooth R A ↔ ∃ g, f.ker_square_lift.comp g = alg_hom.id R A :=
+begin
+  split,
+  { introI,
+    have surj : function.surjective f.ker_square_lift :=
+      λ x, ⟨submodule.quotient.mk (hf x).some, (hf x).some_spec⟩,
+    have sqz : ring_hom.ker f.ker_square_lift.to_ring_hom ^ 2 = 0,
+    { rw [alg_hom.ker_ker_sqare_lift, ideal.cotangent_ideal_square, ideal.zero_eq_bot] },
+    refine ⟨formally_smooth.lift _ ⟨2, sqz⟩
+      (ideal.quotient_ker_alg_equiv_of_surjective surj).symm.to_alg_hom, _⟩,
+    ext x,
+    have := (ideal.quotient_ker_alg_equiv_of_surjective surj).to_alg_hom.congr_arg
+      (formally_smooth.mk_lift _ ⟨2, sqz⟩
+        (ideal.quotient_ker_alg_equiv_of_surjective surj).symm.to_alg_hom x),
+    dsimp at this,
+    rw [alg_equiv.apply_symm_apply] at this,
+    conv_rhs { rw [← this, alg_hom.id_apply] },
+    obtain ⟨y, e⟩ := ideal.quotient.mk_surjective (formally_smooth.lift _ ⟨2, sqz⟩
+      (ideal.quotient_ker_alg_equiv_of_surjective surj).symm.to_alg_hom x),
+    dsimp at e ⊢,
+    rw ← e,
+    refl },
+  { rintro ⟨g, hg⟩, exact formally_smooth.of_split f g hg }
+end
+
+end of_surjective
+
+section unramified_derivation
+
+open_locale tensor_product
+
+variables {R S : Type u} [comm_ring R] [comm_ring S] [algebra R S]
+
+instance formally_unramified.subsingleton_kaehler_differential [formally_unramified R S] :
+  subsingleton Ω[S⁄R] :=
+begin
+  rw ← not_nontrivial_iff_subsingleton,
+  introsI h,
+  obtain ⟨f₁, f₂, e⟩ := (kaehler_differential.End_equiv R S).injective.nontrivial,
+  apply e,
+  ext1,
+  apply formally_unramified.lift_unique' _ _ _ _ (f₁.2.trans f₂.2.symm),
+  rw [← alg_hom.to_ring_hom_eq_coe, alg_hom.ker_ker_sqare_lift],
+  exact ⟨_, ideal.cotangent_ideal_square _⟩,
+end
+
+lemma formally_unramified.iff_subsingleton_kaehler_differential :
+  formally_unramified R S ↔ subsingleton Ω[S⁄R] :=
+begin
+  split,
+  { introsI, apply_instance },
+  { introI H,
+    constructor,
+    introsI B _ _ I hI f₁ f₂ e,
+    letI := f₁.to_ring_hom.to_algebra,
+    haveI := is_scalar_tower.of_algebra_map_eq' (f₁.comp_algebra_map).symm,
+    have := ((kaehler_differential.linear_map_equiv_derivation R S).to_equiv.trans
+      (derivation_to_square_zero_equiv_lift I hI)).surjective.subsingleton,
+    exact subtype.ext_iff.mp (@@subsingleton.elim this ⟨f₁, rfl⟩ ⟨f₂, e.symm⟩) }
+end
+
+end unramified_derivation
+
+section base_change
+
+open_locale tensor_product
+
+variables {R : Type u} [comm_semiring R]
+variables {A : Type u} [semiring A] [algebra R A]
+variables (B : Type u) [comm_semiring B] [algebra R B]
+
+
+instance formally_unramified.base_change [formally_unramified R A] :
+  formally_unramified B (B ⊗[R] A) :=
+begin
+  constructor,
+  introsI C _ _ I hI f₁ f₂ e,
+  letI := ((algebra_map B C).comp (algebra_map R B)).to_algebra,
+  haveI : is_scalar_tower R B C := is_scalar_tower.of_algebra_map_eq' rfl,
+  apply alg_hom.restrict_scalars_injective R,
+  apply tensor_product.ext,
+  any_goals { apply_instance },
+  intros b a,
+  have : b ⊗ₜ[R] a = b • (1 ⊗ₜ a), by { rw [tensor_product.smul_tmul', smul_eq_mul, mul_one] },
+  rw [this, alg_hom.restrict_scalars_apply, alg_hom.restrict_scalars_apply, map_smul, map_smul],
+  congr' 1,
+  change ((f₁.restrict_scalars R).comp tensor_product.include_right) a =
+    ((f₂.restrict_scalars R).comp tensor_product.include_right) a,
+  congr' 1,
+  refine formally_unramified.ext I ⟨2, hI⟩ _,
+  intro x,
+  exact alg_hom.congr_fun e (1 ⊗ₜ x)
+end
+
+instance formally_smooth.base_change [formally_smooth R A] :
+  formally_smooth B (B ⊗[R] A) :=
+begin
+  constructor,
+  introsI C _ _ I hI f,
+  letI := ((algebra_map B C).comp (algebra_map R B)).to_algebra,
+  haveI : is_scalar_tower R B C := is_scalar_tower.of_algebra_map_eq' rfl,
+  refine ⟨tensor_product.product_left_alg_hom (algebra.of_id B C) _, _⟩,
+  { exact formally_smooth.lift I ⟨2, hI⟩
+      ((f.restrict_scalars R).comp tensor_product.include_right) },
+  { apply alg_hom.restrict_scalars_injective R,
+    apply tensor_product.ext,
+    any_goals { apply_instance },
+    intros b a,
+    suffices : algebra_map B _ b * f (1 ⊗ₜ[R] a) = f (b ⊗ₜ[R] a),
+    { simpa [algebra.of_id_apply] },
+    rw [← algebra.smul_def, ← map_smul, tensor_product.smul_tmul', smul_eq_mul, mul_one] },
+end
+
+instance formally_etale.base_change [formally_etale R A] :
+  formally_etale B (B ⊗[R] A) :=
+formally_etale.iff_unramified_and_smooth.mpr ⟨infer_instance, infer_instance⟩
+
+end base_change
+
+section localization
+
+variables {R S Rₘ Sₘ : Type u} [comm_ring R] [comm_ring S] [comm_ring Rₘ] [comm_ring Sₘ]
+variables (M : submonoid R)
+variables [algebra R S] [algebra R Sₘ] [algebra S Sₘ] [algebra R Rₘ] [algebra Rₘ Sₘ]
+variables [is_scalar_tower R Rₘ Sₘ] [is_scalar_tower R S Sₘ]
+variables [is_localization M Rₘ] [is_localization (M.map (algebra_map R S)) Sₘ]
+local attribute [elab_as_eliminator] ideal.is_nilpotent.induction_on
+
+include M
+
+lemma formally_smooth.of_is_localization : formally_smooth R Rₘ :=
+begin
+  constructor,
+  introsI Q _ _ I e f,
+  have : ∀ x : M, is_unit (algebra_map R Q x),
+  { intro x,
+    apply (is_nilpotent.is_unit_quotient_mk_iff ⟨2, e⟩).mp,
+    convert (is_localization.map_units Rₘ x).map f,
+    simp only [ideal.quotient.mk_algebra_map, alg_hom.commutes] },
+  let : Rₘ →ₐ[R] Q := { commutes' := is_localization.lift_eq this, ..(is_localization.lift this) },
+  use this,
+  apply alg_hom.coe_ring_hom_injective,
+  refine is_localization.ring_hom_ext M _,
+  ext,
+  simp,
+end
+
+/-- This holds in general for epimorphisms. -/
+lemma formally_unramified.of_is_localization : formally_unramified R Rₘ :=
+begin
+  constructor,
+  introsI Q _ _ I e f₁ f₂ e,
+  apply alg_hom.coe_ring_hom_injective,
+  refine is_localization.ring_hom_ext M _,
+  ext,
+  simp,
+end
+
+lemma formally_etale.of_is_localization : formally_etale R Rₘ :=
+formally_etale.iff_unramified_and_smooth.mpr
+  ⟨formally_unramified.of_is_localization M, formally_smooth.of_is_localization M⟩
+
+lemma formally_smooth.localization_base [formally_smooth R Sₘ] : formally_smooth Rₘ Sₘ :=
+begin
+  constructor,
+  introsI Q _ _ I e f,
+  letI := ((algebra_map Rₘ Q).comp (algebra_map R Rₘ)).to_algebra,
+  letI : is_scalar_tower R Rₘ Q := is_scalar_tower.of_algebra_map_eq' rfl,
+  let f : Sₘ →ₐ[Rₘ] Q,
+  { refine { commutes' := _, ..(formally_smooth.lift I ⟨2, e⟩ (f.restrict_scalars R)) },
+    intro r,
+    change (ring_hom.comp (formally_smooth.lift I ⟨2, e⟩ (f.restrict_scalars R) : Sₘ →+* Q)
+      (algebra_map _ _)) r = algebra_map _ _ r,
+    congr' 1,
+    refine is_localization.ring_hom_ext M _,
+    rw [ring_hom.comp_assoc, ← is_scalar_tower.algebra_map_eq, ← is_scalar_tower.algebra_map_eq,
+      alg_hom.comp_algebra_map] },
+  use f,
+  ext,
+  simp,
+end
+
+/-- This actually does not need the localization instance, and is stated here again for
+consistency. See `algebra.formally_unramified.of_comp` instead.
+
+ The intended use is for copying proofs between `formally_{unramified, smooth, etale}`
+ without the need to change anything (including removing redundant arguments). -/
+@[nolint unused_arguments]
+lemma formally_unramified.localization_base [formally_unramified R Sₘ] :
+  formally_unramified Rₘ Sₘ :=
+formally_unramified.of_comp R Rₘ Sₘ
+
+lemma formally_etale.localization_base [formally_etale R Sₘ] : formally_etale Rₘ Sₘ :=
+formally_etale.iff_unramified_and_smooth.mpr
+  ⟨formally_unramified.localization_base M, formally_smooth.localization_base M⟩
+
+lemma formally_smooth.localization_map [formally_smooth R S] : formally_smooth Rₘ Sₘ :=
+begin
+  haveI : formally_smooth S Sₘ := formally_smooth.of_is_localization (M.map (algebra_map R S)),
+  haveI : formally_smooth R Sₘ := formally_smooth.comp R S Sₘ,
+  exact formally_smooth.localization_base M
+end
+
+lemma formally_unramified.localization_map [formally_unramified R S] : formally_unramified Rₘ Sₘ :=
+begin
+  haveI : formally_unramified S Sₘ :=
+    formally_unramified.of_is_localization (M.map (algebra_map R S)),
+  haveI : formally_unramified R Sₘ := formally_unramified.comp R S Sₘ,
+  exact formally_unramified.localization_base M
+end
+
+lemma formally_etale.localization_map [formally_etale R S] : formally_etale Rₘ Sₘ :=
+begin
+  haveI : formally_etale S Sₘ := formally_etale.of_is_localization (M.map (algebra_map R S)),
+  haveI : formally_etale R Sₘ := formally_etale.comp R S Sₘ,
+  exact formally_etale.localization_base M
+end
+
+end localization
+
+end algebra
diff --git a/src/ring_theory/euclidean_domain.lean b/src/ring_theory/euclidean_domain.lean
index fb6460f69cd8e..c8a290d8ffc03 100644
--- a/src/ring_theory/euclidean_domain.lean
+++ b/src/ring_theory/euclidean_domain.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Chris Hughes
 -/
 import algebra.gcd_monoid.basic
-import ring_theory.coprime.basic
+import algebra.euclidean_domain.basic
 import ring_theory.ideal.basic
 import ring_theory.principal_ideal_domain
 
 /-!
 # Lemmas about Euclidean domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Various about Euclidean domains are proved; all of them seem to be true
 more generally for principal ideal domains, so these lemmas should
 probably be reproved in more generality and this file perhaps removed?
@@ -26,14 +29,12 @@ open euclidean_domain set ideal
 
 section gcd_monoid
 
-variables {R : Type*} [euclidean_domain R] [gcd_monoid R]
+variables {R : Type*} [euclidean_domain R] [gcd_monoid R] {p q : R}
 
-lemma gcd_ne_zero_of_left (p q : R) (hp : p ≠ 0) :
-  gcd_monoid.gcd p q ≠ 0 :=
+lemma gcd_ne_zero_of_left (hp : p ≠ 0) : gcd_monoid.gcd p q ≠ 0 :=
 λ h, hp $ eq_zero_of_zero_dvd (h ▸ gcd_dvd_left p q)
 
-lemma gcd_ne_zero_of_right (p q : R) (hp : q ≠ 0) :
-  gcd_monoid.gcd p q ≠ 0 :=
+lemma gcd_ne_zero_of_right (hp : q ≠ 0) : gcd_monoid.gcd p q ≠ 0 :=
 λ h, hp $ eq_zero_of_zero_dvd (h ▸ gcd_dvd_right p q)
 
 lemma left_div_gcd_ne_zero {p q : R} (hp : p ≠ 0) :
@@ -54,6 +55,13 @@ begin
   exact r0,
 end
 
+lemma is_coprime_div_gcd_div_gcd (hq : q ≠ 0) :
+  is_coprime (p / gcd_monoid.gcd p q) (q / gcd_monoid.gcd p q) :=
+(gcd_is_unit_iff _ _).1 $ is_unit_gcd_of_eq_mul_gcd
+    (euclidean_domain.mul_div_cancel' (gcd_ne_zero_of_right hq) $ gcd_dvd_left _ _).symm
+    (euclidean_domain.mul_div_cancel' (gcd_ne_zero_of_right hq) $ gcd_dvd_right _ _).symm $
+    gcd_ne_zero_of_right hq
+
 end gcd_monoid
 
 namespace euclidean_domain
diff --git a/src/ring_theory/filtration.lean b/src/ring_theory/filtration.lean
new file mode 100644
index 0000000000000..b037c0da93ecb
--- /dev/null
+++ b/src/ring_theory/filtration.lean
@@ -0,0 +1,452 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.ideal.local_ring
+import ring_theory.noetherian
+import ring_theory.rees_algebra
+import ring_theory.finiteness
+import data.polynomial.module
+import order.hom.lattice
+
+/-!
+
+# `I`-filtrations of modules
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains the definitions and basic results around (stable) `I`-filtrations of modules.
+
+## Main results
+
+- `ideal.filtration`: An `I`-filtration on the module `M` is a sequence of decreasing submodules
+  `N i` such that `I • N ≤ I (i + 1)`. Note that we do not require the filtration to start from `⊤`.
+- `ideal.filtration.stable`: An `I`-filtration is stable if `I • (N i) = N (i + 1)` for large
+  enough `i`.
+- `ideal.filtration.submodule`: The associated module `⨁ Nᵢ` of a filtration, implemented as a
+  submodule of `M[X]`.
+- `ideal.filtration.submodule_fg_iff_stable`: If `F.N i` are all finitely generated, then
+  `F.stable` iff `F.submodule.fg`.
+- `ideal.filtration.stable.of_le`: In a finite module over a noetherian ring,
+  if `F' ≤ F`, then `F.stable → F'.stable`.
+- `ideal.exists_pow_inf_eq_pow_smul`: **Artin-Rees lemma**.
+  given `N ≤ M`, there exists a `k` such that `IⁿM ⊓ N = Iⁿ⁻ᵏ(IᵏM ⊓ N)` for all `n ≥ k`.
+- `ideal.infi_pow_eq_bot_of_local_ring`:
+  **Krull's intersection theorem** (`⨅ i, I ^ i = ⊥`) for noetherian local rings.
+- `ideal.infi_pow_eq_bot_of_is_domain`:
+  **Krull's intersection theorem** (`⨅ i, I ^ i = ⊥`) for noetherian domains.
+
+-/
+
+
+universes u v
+
+variables {R M : Type u} [comm_ring R] [add_comm_group M] [module R M] (I : ideal R)
+
+open polynomial
+open_locale polynomial big_operators
+
+/-- An `I`-filtration on the module `M` is a sequence of decreasing submodules `N i` such that
+`I • (N i) ≤ N (i + 1)`. Note that we do not require the filtration to start from `⊤`. -/
+@[ext]
+structure ideal.filtration (M : Type u) [add_comm_group M] [module R M] :=
+(N : ℕ → submodule R M)
+(mono : ∀ i, N (i + 1) ≤ N i)
+(smul_le : ∀ i, I • N i ≤ N (i + 1))
+
+variables (F F' : I.filtration M) {I}
+
+namespace ideal.filtration
+
+lemma pow_smul_le (i j : ℕ) : I ^ i • F.N j ≤ F.N (i + j) :=
+begin
+  induction i,
+  { simp },
+  { rw [pow_succ, mul_smul, nat.succ_eq_add_one, add_assoc, add_comm 1, ← add_assoc],
+    exact (submodule.smul_mono_right i_ih).trans (F.smul_le _) }
+end
+
+lemma pow_smul_le_pow_smul (i j k : ℕ) : I ^ (i + k) • F.N j ≤ I ^ k • F.N (i + j) :=
+by { rw [add_comm, pow_add, mul_smul], exact submodule.smul_mono_right (F.pow_smul_le i j) }
+
+protected
+lemma antitone : antitone F.N :=
+antitone_nat_of_succ_le F.mono
+
+/-- The trivial `I`-filtration of `N`. -/
+@[simps]
+def _root_.ideal.trivial_filtration (I : ideal R) (N : submodule R M) : I.filtration M :=
+{ N := λ i, N,
+  mono := λ i, le_of_eq rfl,
+  smul_le := λ i, submodule.smul_le_right }
+
+/-- The `sup` of two `I.filtration`s is an `I.filtration`. -/
+instance : has_sup (I.filtration M) :=
+⟨λ F F', ⟨F.N ⊔ F'.N, λ i, sup_le_sup (F.mono i) (F'.mono i),
+    λ i, (le_of_eq (submodule.smul_sup _ _ _)).trans $ sup_le_sup (F.smul_le i) (F'.smul_le i)⟩⟩
+
+/-- The `Sup` of a family of `I.filtration`s is an `I.filtration`. -/
+instance : has_Sup (I.filtration M) := ⟨λ S,
+{ N := Sup (ideal.filtration.N '' S),
+  mono := λ i, begin
+    apply Sup_le_Sup_of_forall_exists_le _,
+    rintros _ ⟨⟨_, F, hF, rfl⟩, rfl⟩,
+    exact ⟨_, ⟨⟨_, F, hF, rfl⟩, rfl⟩, F.mono i⟩,
+  end,
+  smul_le := λ i, begin
+    rw [Sup_eq_supr', supr_apply, submodule.smul_supr, supr_apply],
+    apply supr_mono _,
+    rintro ⟨_, F, hF, rfl⟩,
+    exact F.smul_le i,
+  end }⟩
+
+/-- The `inf` of two `I.filtration`s is an `I.filtration`. -/
+instance : has_inf (I.filtration M) :=
+⟨λ F F', ⟨F.N ⊓ F'.N, λ i, inf_le_inf (F.mono i) (F'.mono i),
+    λ i, (submodule.smul_inf_le _ _ _).trans $ inf_le_inf (F.smul_le i) (F'.smul_le i)⟩⟩
+
+/-- The `Inf` of a family of `I.filtration`s is an `I.filtration`. -/
+instance : has_Inf (I.filtration M) := ⟨λ S,
+{ N := Inf (ideal.filtration.N '' S),
+  mono := λ i, begin
+    apply Inf_le_Inf_of_forall_exists_le _,
+    rintros _ ⟨⟨_, F, hF, rfl⟩, rfl⟩,
+    exact ⟨_, ⟨⟨_, F, hF, rfl⟩, rfl⟩, F.mono i⟩,
+  end,
+  smul_le := λ i, begin
+    rw [Inf_eq_infi', infi_apply, infi_apply],
+    refine submodule.smul_infi_le.trans _,
+    apply infi_mono _,
+    rintro ⟨_, F, hF, rfl⟩,
+    exact F.smul_le i,
+  end }⟩
+
+instance : has_top (I.filtration M) := ⟨I.trivial_filtration ⊤⟩
+instance : has_bot (I.filtration M) := ⟨I.trivial_filtration ⊥⟩
+
+@[simp] lemma sup_N : (F ⊔ F').N = F.N ⊔ F'.N := rfl
+@[simp] lemma Sup_N (S : set (I.filtration M)) : (Sup S).N = Sup (ideal.filtration.N '' S) := rfl
+@[simp] lemma inf_N : (F ⊓ F').N = F.N ⊓ F'.N := rfl
+@[simp] lemma Inf_N (S : set (I.filtration M)) : (Inf S).N = Inf (ideal.filtration.N '' S) := rfl
+@[simp] lemma top_N : (⊤ : I.filtration M).N = ⊤ := rfl
+@[simp] lemma bot_N : (⊥ : I.filtration M).N = ⊥ := rfl
+
+@[simp] lemma supr_N {ι : Sort*} (f : ι → I.filtration M) : (supr f).N = ⨆ i, (f i).N :=
+congr_arg Sup (set.range_comp _ _).symm
+
+@[simp] lemma infi_N {ι : Sort*} (f : ι → I.filtration M) : (infi f).N = ⨅ i, (f i).N :=
+congr_arg Inf (set.range_comp _ _).symm
+
+instance : complete_lattice (I.filtration M) :=
+function.injective.complete_lattice ideal.filtration.N ideal.filtration.ext
+  sup_N inf_N (λ _, Sup_image) (λ _, Inf_image) top_N bot_N
+
+instance : inhabited (I.filtration M) := ⟨⊥⟩
+
+/-- An `I` filtration is stable if `I • F.N n = F.N (n+1)` for large enough `n`. -/
+def stable : Prop :=
+∃ n₀, ∀ n ≥ n₀, I • F.N n = F.N (n + 1)
+
+/-- The trivial stable `I`-filtration of `N`. -/
+@[simps]
+def _root_.ideal.stable_filtration (I : ideal R) (N : submodule R M) :
+  I.filtration M :=
+{ N := λ i, I ^ i • N,
+  mono := λ i, by { rw [add_comm, pow_add, mul_smul], exact submodule.smul_le_right },
+  smul_le := λ i, by { rw [add_comm, pow_add, mul_smul, pow_one], exact le_refl _ } }
+
+lemma _root_.ideal.stable_filtration_stable (I : ideal R) (N : submodule R M) :
+  (I.stable_filtration N).stable :=
+by { use 0, intros n _, dsimp, rw [add_comm, pow_add, mul_smul, pow_one] }
+
+variables {F F'} (h : F.stable)
+
+include h
+
+lemma stable.exists_pow_smul_eq :
+  ∃ n₀, ∀ k, F.N (n₀ + k) = I ^ k • F.N n₀ :=
+begin
+  obtain ⟨n₀, hn⟩ := h,
+  use n₀,
+  intro k,
+  induction k,
+  { simp },
+  { rw [nat.succ_eq_add_one, ← add_assoc, ← hn, k_ih, add_comm, pow_add, mul_smul, pow_one],
+    linarith }
+end
+
+lemma stable.exists_pow_smul_eq_of_ge :
+  ∃ n₀, ∀ n ≥ n₀, F.N n = I ^ (n - n₀) • F.N n₀ :=
+begin
+  obtain ⟨n₀, hn₀⟩ := h.exists_pow_smul_eq,
+  use n₀,
+  intros n hn,
+  convert hn₀ (n - n₀),
+  rw [add_comm, tsub_add_cancel_of_le hn],
+end
+
+omit h
+
+lemma stable_iff_exists_pow_smul_eq_of_ge :
+  F.stable ↔ ∃ n₀, ∀ n ≥ n₀, F.N n = I ^ (n - n₀) • F.N n₀ :=
+begin
+  refine ⟨stable.exists_pow_smul_eq_of_ge, λ h, ⟨h.some, λ n hn, _⟩⟩,
+  rw [h.some_spec n hn, h.some_spec (n+1) (by linarith), smul_smul, ← pow_succ,
+    tsub_add_eq_add_tsub hn],
+end
+
+lemma stable.exists_forall_le (h : F.stable) (e : F.N 0 ≤ F'.N 0) :
+  ∃ n₀, ∀ n, F.N (n + n₀) ≤ F'.N n :=
+begin
+  obtain ⟨n₀, hF⟩ := h,
+  use n₀,
+  intro n,
+  induction n with n hn,
+  { refine (F.antitone _).trans e, simp },
+  { rw [nat.succ_eq_one_add, add_assoc, add_comm, add_comm 1 n, ← hF],
+    exact (submodule.smul_mono_right hn).trans (F'.smul_le _),
+    simp },
+end
+
+lemma stable.bounded_difference (h : F.stable) (h' : F'.stable) (e : F.N 0 = F'.N 0) :
+  ∃ n₀, ∀ n, F.N (n + n₀) ≤ F'.N n ∧ F'.N (n + n₀) ≤ F.N n :=
+begin
+  obtain ⟨n₁, h₁⟩ := h.exists_forall_le (le_of_eq e),
+  obtain ⟨n₂, h₂⟩ := h'.exists_forall_le (le_of_eq e.symm),
+  use max n₁ n₂,
+  intro n,
+  refine ⟨(F.antitone _).trans (h₁ n), (F'.antitone _).trans (h₂ n)⟩; simp
+end
+
+open polynomial_module
+
+variables (F F')
+
+/-- The `R[IX]`-submodule of `M[X]` associated with an `I`-filtration. -/
+protected
+def submodule : submodule (rees_algebra I) (polynomial_module R M) :=
+{ carrier := { f | ∀ i, f i ∈ F.N i },
+  add_mem' := λ f g hf hg i, submodule.add_mem _ (hf i) (hg i),
+  zero_mem' := λ i, submodule.zero_mem _,
+  smul_mem' := λ r f hf i, begin
+    rw [subalgebra.smul_def, polynomial_module.smul_apply],
+    apply submodule.sum_mem,
+    rintro ⟨j, k⟩ e,
+    rw finset.nat.mem_antidiagonal at e,
+    subst e,
+    exact F.pow_smul_le j k (submodule.smul_mem_smul (r.2 j) (hf k))
+  end }
+
+@[simp]
+lemma mem_submodule (f : polynomial_module R M) : f ∈ F.submodule ↔ ∀ i, f i ∈ F.N i := iff.rfl
+
+lemma inf_submodule : (F ⊓ F').submodule = F.submodule ⊓ F'.submodule :=
+by { ext, exact forall_and_distrib }
+
+variables (I M)
+
+/-- `ideal.filtration.submodule` as an `inf_hom` -/
+def submodule_inf_hom :
+  inf_hom (I.filtration M) (submodule (rees_algebra I) (polynomial_module R M)) :=
+{ to_fun := ideal.filtration.submodule, map_inf' := inf_submodule }
+
+variables {I M}
+
+lemma submodule_closure_single :
+  add_submonoid.closure (⋃ i, single R i '' (F.N i : set M)) = F.submodule.to_add_submonoid :=
+begin
+  apply le_antisymm,
+  { rw [add_submonoid.closure_le, set.Union_subset_iff],
+    rintro i _ ⟨m, hm, rfl⟩ j,
+    rw single_apply,
+    split_ifs,
+    { rwa ← h },
+    { exact (F.N j).zero_mem } },
+  { intros f hf,
+    rw [← f.sum_single],
+    apply add_submonoid.sum_mem _ _,
+    rintros c -,
+    exact add_submonoid.subset_closure (set.subset_Union _ c $ set.mem_image_of_mem _ (hf c)) }
+end
+
+lemma submodule_span_single :
+  submodule.span (rees_algebra I) (⋃ i, single R i '' (F.N i : set M)) = F.submodule :=
+begin
+  rw [← submodule.span_closure, submodule_closure_single],
+  simp,
+end
+
+lemma submodule_eq_span_le_iff_stable_ge (n₀ : ℕ) :
+  F.submodule = submodule.span _ (⋃ i ≤ n₀, single R i '' (F.N i : set M)) ↔
+    ∀ n ≥ n₀, I • F.N n = F.N (n + 1) :=
+begin
+  rw [← submodule_span_single, ← has_le.le.le_iff_eq, submodule.span_le,
+    set.Union_subset_iff],
+  swap, { exact submodule.span_mono (set.Union₂_subset_Union _ _) },
+  split,
+  { intros H n hn,
+    refine (F.smul_le n).antisymm _,
+    intros x hx,
+    obtain ⟨l, hl⟩ := (finsupp.mem_span_iff_total _ _ _).mp (H _ ⟨x, hx, rfl⟩),
+    replace hl := congr_arg (λ f : ℕ →₀ M, f (n + 1)) hl,
+    dsimp only at hl,
+    erw finsupp.single_eq_same at hl,
+    rw [← hl, finsupp.total_apply, finsupp.sum_apply],
+    apply submodule.sum_mem _ _,
+    rintros ⟨_, _, ⟨n', rfl⟩, _, ⟨hn', rfl⟩, m, hm, rfl⟩ -,
+    dsimp only [subtype.coe_mk],
+    rw [subalgebra.smul_def, smul_single_apply, if_pos (show n' ≤ n + 1, by linarith)],
+    have e : n' ≤ n := by linarith,
+    have := F.pow_smul_le_pow_smul (n - n') n' 1,
+    rw [tsub_add_cancel_of_le e, pow_one, add_comm _ 1, ← add_tsub_assoc_of_le e, add_comm] at this,
+    exact this (submodule.smul_mem_smul ((l _).2 $ n + 1 - n') hm) },
+  { let F' := submodule.span (rees_algebra I) (⋃ i ≤ n₀, single R i '' (F.N i : set M)),
+    intros hF i,
+    have : ∀ i ≤ n₀, single R i '' (F.N i : set M) ⊆ F' :=
+      λ i hi, set.subset.trans (set.subset_Union₂ i hi) submodule.subset_span,
+    induction i with j hj,
+    { exact this _ (zero_le _) },
+    by_cases hj' : j.succ ≤ n₀,
+    { exact this _ hj' },
+    simp only [not_le, nat.lt_succ_iff] at hj',
+    rw [nat.succ_eq_add_one, ← hF _ hj'],
+    rintro _ ⟨m, hm, rfl⟩,
+    apply submodule.smul_induction_on hm,
+    { intros r hr m' hm',
+      rw [add_comm, ← monomial_smul_single],
+      exact F'.smul_mem ⟨_, rees_algebra.monomial_mem.mpr (by rwa pow_one)⟩
+        (hj $ set.mem_image_of_mem _ hm') },
+    { intros x y hx hy, rw map_add, exact F'.add_mem hx hy } }
+end
+
+/-- If the components of a filtration are finitely generated, then the filtration is stable iff
+its associated submodule of is finitely generated.  -/
+lemma submodule_fg_iff_stable (hF' : ∀ i, (F.N i).fg) :
+  F.submodule.fg ↔ F.stable :=
+begin
+  classical,
+  delta ideal.filtration.stable,
+  simp_rw ← F.submodule_eq_span_le_iff_stable_ge,
+  split,
+  { rintro H,
+    apply H.stablizes_of_supr_eq
+      ⟨λ n₀, submodule.span _ (⋃ (i : ℕ) (H : i ≤ n₀), single R i '' ↑(F.N i)), _⟩,
+    { dsimp,
+      rw [← submodule.span_Union, ← submodule_span_single],
+      congr' 1,
+      ext,
+      simp only [set.mem_Union, set.mem_image, set_like.mem_coe, exists_prop],
+      split,
+      { rintro ⟨-, i, -, e⟩, exact ⟨i, e⟩ },
+      { rintro ⟨i, e⟩, exact ⟨i, i, le_refl i, e⟩ } },
+    { intros n m e,
+      rw [submodule.span_le, set.Union₂_subset_iff],
+      intros i hi,
+      refine (set.subset.trans _ (set.subset_Union₂ i (hi.trans e : _))).trans
+        submodule.subset_span,
+      refl } },
+  { rintros ⟨n, hn⟩,
+    rw hn,
+    simp_rw [submodule.span_Union₂, ← finset.mem_range_succ_iff, supr_subtype'],
+    apply submodule.fg_supr,
+    rintro ⟨i, hi⟩,
+    obtain ⟨s, hs⟩ := hF' i,
+    have : submodule.span (rees_algebra I) (s.image (lsingle R i) : set (polynomial_module R M))
+      = submodule.span _ (single R i '' (F.N i : set M)),
+    { rw [finset.coe_image, ← submodule.span_span_of_tower R, ← submodule.map_span, hs], refl },
+    rw [subtype.coe_mk, ← this],
+    exact ⟨_, rfl⟩ }
+end
+.
+variables {F}
+
+lemma stable.of_le [is_noetherian_ring R] [h : module.finite R M] (hF : F.stable)
+  {F' : I.filtration M} (hf : F' ≤ F) : F'.stable :=
+begin
+  haveI := is_noetherian_of_fg_of_noetherian' h.1,
+  rw ← submodule_fg_iff_stable at hF ⊢,
+  any_goals { intro i, exact is_noetherian.noetherian _ },
+  have := is_noetherian_of_fg_of_noetherian _ hF,
+  rw is_noetherian_submodule at this,
+  exact this _ (order_hom_class.mono (submodule_inf_hom M I) hf),
+end
+
+lemma stable.inter_right [is_noetherian_ring R] [h : module.finite R M] (hF : F.stable) :
+  (F ⊓ F').stable :=
+hF.of_le inf_le_left
+
+lemma stable.inter_left [is_noetherian_ring R] [h : module.finite R M] (hF : F.stable) :
+  (F' ⊓ F).stable :=
+hF.of_le inf_le_right
+
+end ideal.filtration
+
+variable (I)
+
+/-- **Artin-Rees lemma** -/
+lemma ideal.exists_pow_inf_eq_pow_smul [is_noetherian_ring R] [h : module.finite R M]
+  (N : submodule R M) : ∃ k : ℕ, ∀ n ≥ k, I ^ n • ⊤ ⊓ N = I ^ (n - k) • (I ^ k • ⊤ ⊓ N) :=
+((I.stable_filtration_stable ⊤).inter_right (I.trivial_filtration N)).exists_pow_smul_eq_of_ge
+
+lemma ideal.mem_infi_smul_pow_eq_bot_iff [is_noetherian_ring R] [hM : module.finite R M] (x : M) :
+  x ∈ (⨅ i : ℕ, I ^ i • ⊤ : submodule R M) ↔ ∃ r : I, (r : R) • x = x :=
+begin
+  let N := (⨅ i : ℕ, I ^ i • ⊤ : submodule R M),
+  have hN : ∀ k, (I.stable_filtration ⊤ ⊓ I.trivial_filtration N).N k = N,
+  { intro k, exact inf_eq_right.mpr ((infi_le _ k).trans $ le_of_eq $ by simp) },
+  split,
+  { haveI := is_noetherian_of_fg_of_noetherian' hM.out,
+    obtain ⟨r, hr₁, hr₂⟩ := submodule.exists_mem_and_smul_eq_self_of_fg_of_le_smul I N
+      (is_noetherian.noetherian N) _,
+    { intro H, exact ⟨⟨r, hr₁⟩, hr₂ _ H⟩ },
+    obtain ⟨k, hk⟩ := (I.stable_filtration_stable ⊤).inter_right (I.trivial_filtration N),
+    have := hk k (le_refl _),
+    rw [hN, hN] at this,
+    exact le_of_eq this.symm },
+  { rintro ⟨r, eq⟩,
+    rw submodule.mem_infi,
+    intro i,
+    induction i with i hi,
+    { simp },
+    { rw [nat.succ_eq_one_add, pow_add, ← smul_smul, pow_one, ← eq],
+      exact submodule.smul_mem_smul r.prop hi } }
+end
+
+lemma ideal.infi_pow_smul_eq_bot_of_local_ring [is_noetherian_ring R] [local_ring R]
+  [module.finite R M] (h : I ≠ ⊤) :
+  (⨅ i : ℕ, I ^ i • ⊤ : submodule R M) = ⊥ :=
+begin
+  rw eq_bot_iff,
+  intros x hx,
+  obtain ⟨r, hr⟩ := (I.mem_infi_smul_pow_eq_bot_iff x).mp hx,
+  have := local_ring.is_unit_one_sub_self_of_mem_nonunits _ (local_ring.le_maximal_ideal h r.prop),
+  apply this.smul_left_cancel.mp,
+  swap, { apply_instance },
+  simp [sub_smul, hr],
+end
+
+/-- **Krull's intersection theorem** for noetherian local rings. -/
+lemma ideal.infi_pow_eq_bot_of_local_ring [is_noetherian_ring R] [local_ring R] (h : I ≠ ⊤) :
+  (⨅ i : ℕ, I ^ i) = ⊥ :=
+begin
+  convert I.infi_pow_smul_eq_bot_of_local_ring h,
+  ext i,
+  rw [smul_eq_mul, ← ideal.one_eq_top, mul_one],
+  apply_instance,
+end
+
+/-- **Krull's intersection theorem** for noetherian domains. -/
+lemma ideal.infi_pow_eq_bot_of_is_domain [is_noetherian_ring R] [is_domain R] (h : I ≠ ⊤) :
+  (⨅ i : ℕ, I ^ i) = ⊥ :=
+begin
+  rw eq_bot_iff,
+  intros x hx,
+  by_contra hx',
+  have := ideal.mem_infi_smul_pow_eq_bot_iff I x,
+  simp_rw [smul_eq_mul, ← ideal.one_eq_top, mul_one] at this,
+  obtain ⟨r, hr⟩ := this.mp hx,
+  have := mul_right_cancel₀ hx' (hr.trans (one_mul x).symm),
+  exact I.eq_top_iff_one.not.mp h (this ▸ r.prop),
+end
diff --git a/src/ring_theory/finite_presentation.lean b/src/ring_theory/finite_presentation.lean
new file mode 100644
index 0000000000000..87e17d5d983e2
--- /dev/null
+++ b/src/ring_theory/finite_presentation.lean
@@ -0,0 +1,459 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+
+import ring_theory.finite_type
+import ring_theory.mv_polynomial.tower
+import ring_theory.ideal.quotient_operations
+
+/-!
+# Finiteness conditions in commutative algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define several notions of finiteness that are common in commutative algebra.
+
+## Main declarations
+
+- `module.finite`, `algebra.finite`, `ring_hom.finite`, `alg_hom.finite`
+  all of these express that some object is finitely generated *as module* over some base ring.
+- `algebra.finite_type`, `ring_hom.finite_type`, `alg_hom.finite_type`
+  all of these express that some object is finitely generated *as algebra* over some base ring.
+- `algebra.finite_presentation`, `ring_hom.finite_presentation`, `alg_hom.finite_presentation`
+  all of these express that some object is finitely presented *as algebra* over some base ring.
+
+-/
+
+open function (surjective)
+open_locale big_operators polynomial
+
+section module_and_algebra
+
+variables (R A B M N : Type*)
+
+/-- An algebra over a commutative semiring is `finite_presentation` if it is the quotient of a
+polynomial ring in `n` variables by a finitely generated ideal. -/
+def algebra.finite_presentation [comm_semiring R] [semiring A] [algebra R A] : Prop :=
+∃ (n : ℕ) (f : mv_polynomial (fin n) R →ₐ[R] A),
+  surjective f ∧ f.to_ring_hom.ker.fg
+
+namespace algebra
+
+variables [comm_ring R] [comm_ring A] [algebra R A] [comm_ring B] [algebra R B]
+variables [add_comm_group M] [module R M]
+variables [add_comm_group N] [module R N]
+
+namespace finite_type
+
+variables {R A B}
+
+/-- A finitely presented algebra is of finite type. -/
+lemma of_finite_presentation : finite_presentation R A → finite_type R A :=
+begin
+  rintro ⟨n, f, hf⟩,
+  apply (finite_type.iff_quotient_mv_polynomial'').2,
+  exact ⟨n, f, hf.1⟩
+end
+
+end finite_type
+
+namespace finite_presentation
+
+variables {R A B}
+
+/-- An algebra over a Noetherian ring is finitely generated if and only if it is finitely
+presented. -/
+lemma of_finite_type [is_noetherian_ring R] : finite_type R A ↔ finite_presentation R A :=
+begin
+  refine ⟨λ h, _, algebra.finite_type.of_finite_presentation⟩,
+  obtain ⟨n, f, hf⟩ := algebra.finite_type.iff_quotient_mv_polynomial''.1 h,
+  refine ⟨n, f, hf, _⟩,
+  have hnoet : is_noetherian_ring (mv_polynomial (fin n) R) := by apply_instance,
+  replace hnoet := (is_noetherian_ring_iff.1 hnoet).noetherian,
+  exact hnoet f.to_ring_hom.ker,
+end
+
+/-- If `e : A ≃ₐ[R] B` and `A` is finitely presented, then so is `B`. -/
+lemma equiv (hfp : finite_presentation R A) (e : A ≃ₐ[R] B) : finite_presentation R B :=
+begin
+  obtain ⟨n, f, hf⟩ := hfp,
+  use [n, alg_hom.comp ↑e f],
+  split,
+  { exact function.surjective.comp e.surjective hf.1 },
+  suffices hker : (alg_hom.comp ↑e f).to_ring_hom.ker = f.to_ring_hom.ker,
+  { rw hker, exact hf.2 },
+  { have hco : (alg_hom.comp ↑e f).to_ring_hom = ring_hom.comp ↑e.to_ring_equiv f.to_ring_hom,
+    { have h : (alg_hom.comp ↑e f).to_ring_hom = e.to_alg_hom.to_ring_hom.comp f.to_ring_hom := rfl,
+      have h1 : ↑(e.to_ring_equiv) = (e.to_alg_hom).to_ring_hom := rfl,
+      rw [h, h1] },
+    rw [ring_hom.ker_eq_comap_bot, hco, ← ideal.comap_comap, ← ring_hom.ker_eq_comap_bot,
+      ring_hom.ker_coe_equiv (alg_equiv.to_ring_equiv e), ring_hom.ker_eq_comap_bot] }
+end
+
+variable (R)
+
+/-- The ring of polynomials in finitely many variables is finitely presented. -/
+protected lemma mv_polynomial (ι : Type u_2) [finite ι] :
+  finite_presentation R (mv_polynomial ι R) :=
+by casesI nonempty_fintype ι; exact
+let eqv := (mv_polynomial.rename_equiv R $ fintype.equiv_fin ι).symm in
+⟨fintype.card ι, eqv, eqv.surjective,
+  ((ring_hom.injective_iff_ker_eq_bot _).1 eqv.injective).symm ▸ submodule.fg_bot⟩
+
+/-- `R` is finitely presented as `R`-algebra. -/
+lemma self : finite_presentation R R :=
+equiv (finite_presentation.mv_polynomial R pempty) (mv_polynomial.is_empty_alg_equiv R pempty)
+
+/-- `R[X]` is finitely presented as `R`-algebra. -/
+lemma polynomial : finite_presentation R R[X] :=
+equiv (finite_presentation.mv_polynomial R punit) (mv_polynomial.punit_alg_equiv R)
+
+variable {R}
+
+/-- The quotient of a finitely presented algebra by a finitely generated ideal is finitely
+presented. -/
+protected lemma quotient {I : ideal A} (h : I.fg) (hfp : finite_presentation R A) :
+  finite_presentation R (A ⧸ I) :=
+begin
+  obtain ⟨n, f, hf⟩ := hfp,
+  refine ⟨n, (ideal.quotient.mkₐ R I).comp f, _, _⟩,
+  { exact (ideal.quotient.mkₐ_surjective R I).comp hf.1 },
+  { refine ideal.fg_ker_comp _ _ hf.2 _ hf.1,
+    simp [h] }
+end
+
+/-- If `f : A →ₐ[R] B` is surjective with finitely generated kernel and `A` is finitely presented,
+then so is `B`. -/
+lemma of_surjective {f : A →ₐ[R] B} (hf : function.surjective f) (hker : f.to_ring_hom.ker.fg)
+  (hfp : finite_presentation R A) : finite_presentation R B :=
+equiv (hfp.quotient hker) (ideal.quotient_ker_alg_equiv_of_surjective hf)
+
+lemma iff : finite_presentation R A ↔
+  ∃ n (I : ideal (mv_polynomial (fin n) R)) (e : (_ ⧸ I) ≃ₐ[R] A), I.fg :=
+begin
+  split,
+  { rintros ⟨n, f, hf⟩,
+    exact ⟨n, f.to_ring_hom.ker, ideal.quotient_ker_alg_equiv_of_surjective hf.1, hf.2⟩ },
+  { rintros ⟨n, I, e, hfg⟩,
+    exact equiv ((finite_presentation.mv_polynomial R _).quotient hfg) e }
+end
+
+/-- An algebra is finitely presented if and only if it is a quotient of a polynomial ring whose
+variables are indexed by a fintype by a finitely generated ideal. -/
+lemma iff_quotient_mv_polynomial' : finite_presentation R A ↔ ∃ (ι : Type u_2) (_ : fintype ι)
+  (f : mv_polynomial ι R →ₐ[R] A), surjective f ∧ f.to_ring_hom.ker.fg :=
+begin
+  split,
+  { rintro ⟨n, f, hfs, hfk⟩,
+    set ulift_var := mv_polynomial.rename_equiv R equiv.ulift,
+    refine ⟨ulift (fin n), infer_instance, f.comp ulift_var.to_alg_hom,
+      hfs.comp ulift_var.surjective,
+      ideal.fg_ker_comp _ _ _ hfk ulift_var.surjective⟩,
+    convert submodule.fg_bot,
+    exact ring_hom.ker_coe_equiv ulift_var.to_ring_equiv, },
+  { rintro ⟨ι, hfintype, f, hf⟩,
+    resetI,
+    have equiv := mv_polynomial.rename_equiv R (fintype.equiv_fin ι),
+    refine ⟨fintype.card ι, f.comp equiv.symm,
+      hf.1.comp (alg_equiv.symm equiv).surjective,
+      ideal.fg_ker_comp _ f _ hf.2 equiv.symm.surjective⟩,
+    convert submodule.fg_bot,
+    exact ring_hom.ker_coe_equiv (equiv.symm.to_ring_equiv), }
+end
+
+/-- If `A` is a finitely presented `R`-algebra, then `mv_polynomial (fin n) A` is finitely presented
+as `R`-algebra. -/
+lemma mv_polynomial_of_finite_presentation (hfp : finite_presentation R A) (ι : Type*)
+  [finite ι] : finite_presentation R (mv_polynomial ι A) :=
+begin
+  rw iff_quotient_mv_polynomial' at hfp ⊢,
+  classical,
+  obtain ⟨ι', _, f, hf_surj, hf_ker⟩ := hfp,
+  resetI,
+  let g := (mv_polynomial.map_alg_hom f).comp (mv_polynomial.sum_alg_equiv R ι ι').to_alg_hom,
+  casesI nonempty_fintype (ι ⊕ ι'),
+  refine ⟨ι ⊕ ι', by apply_instance, g,
+    (mv_polynomial.map_surjective f.to_ring_hom hf_surj).comp (alg_equiv.surjective _),
+    ideal.fg_ker_comp _ _ _ _ (alg_equiv.surjective _)⟩,
+  { convert submodule.fg_bot,
+    exact ring_hom.ker_coe_equiv (mv_polynomial.sum_alg_equiv R ι ι').to_ring_equiv },
+  { rw [alg_hom.to_ring_hom_eq_coe, mv_polynomial.map_alg_hom_coe_ring_hom, mv_polynomial.ker_map],
+    exact hf_ker.map mv_polynomial.C, }
+end
+
+/-- If `A` is an `R`-algebra and `S` is an `A`-algebra, both finitely presented, then `S` is
+  finitely presented as `R`-algebra. -/
+lemma trans [algebra A B] [is_scalar_tower R A B] (hfpA : finite_presentation R A)
+  (hfpB : finite_presentation A B) : finite_presentation R B :=
+begin
+  obtain ⟨n, I, e, hfg⟩ := iff.1 hfpB,
+  exact equiv ((mv_polynomial_of_finite_presentation hfpA _).quotient hfg) (e.restrict_scalars R)
+end
+
+open mv_polynomial
+
+-- We follow the proof of https://stacks.math.columbia.edu/tag/0561
+-- TODO: extract out helper lemmas and tidy proof.
+lemma of_restrict_scalars_finite_presentation [algebra A B] [is_scalar_tower R A B]
+  (hRB : finite_presentation R B) [hRA : finite_type R A] : finite_presentation A B :=
+begin
+  classical,
+  obtain ⟨n, f, hf, s, hs⟩ := hRB,
+  let RX := mv_polynomial (fin n) R, let AX := mv_polynomial (fin n) A,
+  refine ⟨n, mv_polynomial.aeval (f ∘ X), _, _⟩,
+  { rw [← algebra.range_top_iff_surjective, ← algebra.adjoin_range_eq_range_aeval, set.range_comp,
+      _root_.eq_top_iff, ← @adjoin_adjoin_of_tower R A B, adjoin_image,
+      adjoin_range_X, algebra.map_top, (algebra.range_top_iff_surjective _).mpr hf],
+    exact subset_adjoin },
+  { obtain ⟨t, ht⟩ := hRA.out,
+    have := λ i : t, hf (algebra_map A B i),
+    choose t' ht',
+    have ht'' : algebra.adjoin R ((algebra_map A AX) '' t ∪ set.range (X : _ → AX)) = ⊤,
+    { rw [adjoin_union_eq_adjoin_adjoin, ← subalgebra.restrict_scalars_top R],
+      congr' 1,
+      swap, { exact subalgebra.is_scalar_tower_mid _ },
+      rw [adjoin_algebra_map, ht],
+      apply subalgebra.restrict_scalars_injective R,
+      rw [← adjoin_restrict_scalars, adjoin_range_X, subalgebra.restrict_scalars_top,
+        subalgebra.restrict_scalars_top] },
+    let g : t → AX := λ x, C (x : A) - map (algebra_map R A) (t' x),
+    refine ⟨s.image (map (algebra_map R A)) ∪ t.attach.image g, _⟩,
+    rw [finset.coe_union, finset.coe_image, finset.coe_image, finset.attach_eq_univ,
+      finset.coe_univ, set.image_univ],
+    let s₀ := _, let I := _, change ideal.span s₀ = I,
+    have leI : ideal.span s₀ ≤ I,
+    { rw [ideal.span_le],
+      rintros _ (⟨x, hx, rfl⟩|⟨⟨x, hx⟩, rfl⟩),
+      all_goals
+        { dsimp [g], rw [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom] },
+      { rw [mv_polynomial.aeval_map_algebra_map, ← aeval_unique],
+        have := ideal.subset_span hx,
+        rwa hs at this },
+      { rw [map_sub, mv_polynomial.aeval_map_algebra_map, ← aeval_unique,
+          aeval_C, ht', subtype.coe_mk, sub_self] } },
+    apply leI.antisymm,
+    intros x hx,
+    rw [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom] at hx,
+    let s₀ := _, change x ∈ ideal.span s₀,
+    have : x ∈ (map (algebra_map R A) : _ →+* AX).srange.to_add_submonoid ⊔
+      (ideal.span s₀).to_add_submonoid,
+    { have : x ∈ (⊤ : subalgebra R AX) := trivial,
+      rw ← ht'' at this,
+      apply adjoin_induction this,
+      { rintros _ (⟨x, hx, rfl⟩|⟨i, rfl⟩),
+        { rw [algebra_map_eq, ← sub_add_cancel (C x) (map (algebra_map R A) (t' ⟨x, hx⟩)),
+          add_comm],
+          apply add_submonoid.add_mem_sup,
+          { exact set.mem_range_self _ },
+          { apply ideal.subset_span,
+            apply set.mem_union_right,
+            exact set.mem_range_self ⟨x, hx⟩ } },
+        { apply add_submonoid.mem_sup_left,
+          exact ⟨X i, map_X _ _⟩ } },
+      { intro r, apply add_submonoid.mem_sup_left, exact ⟨C r, map_C _ _⟩ },
+      { intros _ _ h₁ h₂, exact add_mem h₁ h₂ },
+      { intros x₁ x₂ h₁ h₂,
+        obtain ⟨_, ⟨p₁, rfl⟩, q₁, hq₁, rfl⟩ := add_submonoid.mem_sup.mp h₁,
+        obtain ⟨_, ⟨p₂, rfl⟩, q₂, hq₂, rfl⟩ := add_submonoid.mem_sup.mp h₂,
+        rw [add_mul, mul_add, add_assoc, ← map_mul],
+        apply add_submonoid.add_mem_sup,
+        { exact set.mem_range_self _ },
+        { refine add_mem (ideal.mul_mem_left _ _ hq₂) (ideal.mul_mem_right _ _ hq₁) } } },
+    obtain ⟨_, ⟨p, rfl⟩, q, hq, rfl⟩ := add_submonoid.mem_sup.mp this,
+    rw [map_add, aeval_map_algebra_map, ← aeval_unique, (show aeval (f ∘ X) q = 0, from leI hq),
+      add_zero] at hx,
+    suffices : ideal.span (s : set RX) ≤ (ideal.span s₀).comap (map $ algebra_map R A),
+    { refine add_mem _ hq, rw hs at this, exact this hx },
+    rw ideal.span_le,
+    intros x hx,
+    apply ideal.subset_span,
+    apply set.mem_union_left,
+    exact set.mem_image_of_mem _ hx }
+end
+
+/-- This is used to prove the strictly stronger `ker_fg_of_surjective`. Use it instead. -/
+-- TODO: extract out helper lemmas and tidy proof.
+lemma ker_fg_of_mv_polynomial {n : ℕ} (f : mv_polynomial (fin n) R →ₐ[R] A)
+  (hf : function.surjective f) (hfp : finite_presentation R A) : f.to_ring_hom.ker.fg :=
+begin
+  classical,
+  obtain ⟨m, f', hf', s, hs⟩ := hfp,
+  let RXn := mv_polynomial (fin n) R, let RXm := mv_polynomial (fin m) R,
+  have := λ (i : fin n), hf' (f $ X i),
+  choose g hg,
+  have := λ (i : fin m), hf (f' $ X i),
+  choose h hh,
+  let aeval_h : RXm →ₐ[R] RXn := aeval h,
+  let g' : fin n → RXn := λ i, X i - aeval_h (g i),
+  refine ⟨finset.univ.image g' ∪ s.image aeval_h, _⟩,
+  simp only [finset.coe_image, finset.coe_union, finset.coe_univ, set.image_univ],
+  have hh' : ∀ x, f (aeval_h x) = f' x,
+  { intro x, rw [← f.coe_to_ring_hom, map_aeval], simp_rw [alg_hom.coe_to_ring_hom, hh],
+    rw [alg_hom.comp_algebra_map, ← aeval_eq_eval₂_hom, ← aeval_unique] },
+  let s' := set.range g' ∪ aeval_h '' s,
+  have leI : ideal.span s' ≤ f.to_ring_hom.ker,
+  { rw ideal.span_le,
+    rintros _ (⟨i, rfl⟩|⟨x, hx, rfl⟩),
+    { change f (g' i) = 0, rw [map_sub, ← hg, hh', sub_self], },
+    { change f (aeval_h x) = 0,
+      rw hh',
+      change x ∈ f'.to_ring_hom.ker,
+      rw ← hs,
+      exact ideal.subset_span hx } },
+  apply leI.antisymm,
+  intros x hx,
+  have : x ∈ aeval_h.range.to_add_submonoid ⊔ (ideal.span s').to_add_submonoid,
+  { have : x ∈ adjoin R (set.range X : set RXn) := by { rw [adjoin_range_X], trivial },
+    apply adjoin_induction this,
+    { rintros _ ⟨i, rfl⟩,
+      rw [← sub_add_cancel (X i) (aeval h (g i)), add_comm],
+      apply add_submonoid.add_mem_sup,
+    { exact set.mem_range_self _ },
+    { apply submodule.subset_span,
+      apply set.mem_union_left,
+      exact set.mem_range_self _ } },
+    { intros r, apply add_submonoid.mem_sup_left, exact ⟨C r, aeval_C _ _⟩ },
+    { intros _ _ h₁ h₂, exact add_mem h₁ h₂ },
+    { intros p₁ p₂ h₁ h₂,
+      obtain ⟨_, ⟨x₁, rfl⟩, y₁, hy₁, rfl⟩ := add_submonoid.mem_sup.mp h₁,
+      obtain ⟨_, ⟨x₂, rfl⟩, y₂, hy₂, rfl⟩ := add_submonoid.mem_sup.mp h₂,
+      rw [mul_add, add_mul, add_assoc, ← map_mul],
+      apply add_submonoid.add_mem_sup,
+    { exact set.mem_range_self _ },
+    { exact add_mem (ideal.mul_mem_right _ _ hy₁) (ideal.mul_mem_left _ _ hy₂) } } },
+  obtain ⟨_, ⟨x, rfl⟩, y, hy, rfl⟩ := add_submonoid.mem_sup.mp this,
+  refine add_mem _ hy,
+  simp only [ring_hom.mem_ker, alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom, map_add,
+    (show f y = 0, from leI hy), add_zero, hh'] at hx,
+  suffices : ideal.span (s : set RXm) ≤ (ideal.span s').comap aeval_h,
+  { apply this, rwa hs },
+  rw ideal.span_le,
+  intros x hx,
+  apply submodule.subset_span,
+  apply set.mem_union_right,
+  exact set.mem_image_of_mem _ hx
+end
+
+/-- If `f : A →ₐ[R] B` is a sujection between finitely-presented `R`-algebras, then the kernel of
+`f` is finitely generated. -/
+lemma ker_fg_of_surjective (f : A →ₐ[R] B) (hf : function.surjective f)
+  (hRA : finite_presentation R A) (hRB : finite_presentation R B) : f.to_ring_hom.ker.fg :=
+begin
+  obtain ⟨n, g, hg, hg'⟩ := hRA,
+  convert (ker_fg_of_mv_polynomial (f.comp g) (hf.comp hg) hRB).map g.to_ring_hom,
+  simp_rw [ring_hom.ker_eq_comap_bot, alg_hom.to_ring_hom_eq_coe, alg_hom.comp_to_ring_hom],
+  rw [← ideal.comap_comap, ideal.map_comap_of_surjective (g : mv_polynomial (fin n) R →+* A) hg],
+end
+
+end finite_presentation
+
+end algebra
+
+end module_and_algebra
+
+namespace ring_hom
+variables {A B C : Type*} [comm_ring A] [comm_ring B] [comm_ring C]
+
+/-- A ring morphism `A →+* B` is of `finite_presentation` if `B` is finitely presented as
+`A`-algebra. -/
+def finite_presentation (f : A →+* B) : Prop := @algebra.finite_presentation A B _ _ f.to_algebra
+
+namespace finite_type
+
+lemma of_finite_presentation {f : A →+* B} (hf : f.finite_presentation) : f.finite_type :=
+@algebra.finite_type.of_finite_presentation A B _ _ f.to_algebra hf
+
+end finite_type
+
+namespace finite_presentation
+
+variables (A)
+
+lemma id : finite_presentation (ring_hom.id A) := algebra.finite_presentation.self A
+
+variables {A}
+
+lemma comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.finite_presentation) (hg : surjective g)
+  (hker : g.ker.fg) :  (g.comp f).finite_presentation :=
+@algebra.finite_presentation.of_surjective A B C _ _ f.to_algebra _ (g.comp f).to_algebra
+{ to_fun := g, commutes' := λ a, rfl, .. g } hg hker hf
+
+lemma of_surjective (f : A →+* B) (hf : surjective f) (hker : f.ker.fg) : f.finite_presentation :=
+by { rw ← f.comp_id, exact (id A).comp_surjective hf hker}
+
+lemma of_finite_type [is_noetherian_ring A] {f : A →+* B} : f.finite_type ↔ f.finite_presentation :=
+@algebra.finite_presentation.of_finite_type A B _ _ f.to_algebra _
+
+lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite_presentation) (hf : f.finite_presentation) :
+  (g.comp f).finite_presentation :=
+@algebra.finite_presentation.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
+{ smul_assoc := λ a b c, begin
+    simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
+    refl
+  end }
+hf hg
+
+lemma of_comp_finite_type (f : A →+* B) {g : B →+* C} (hg : (g.comp f).finite_presentation)
+  (hf : f.finite_type) : g.finite_presentation :=
+@@algebra.finite_presentation.of_restrict_scalars_finite_presentation _ _ f.to_algebra _
+  (g.comp f).to_algebra g.to_algebra
+  (@@is_scalar_tower.of_algebra_map_eq' _ _ _ f.to_algebra g.to_algebra (g.comp f).to_algebra rfl)
+  hg hf
+
+end finite_presentation
+
+end ring_hom
+
+namespace alg_hom
+
+variables {R A B C : Type*} [comm_ring R]
+variables [comm_ring A] [comm_ring B] [comm_ring C]
+variables [algebra R A] [algebra R B] [algebra R C]
+
+/-- An algebra morphism `A →ₐ[R] B` is of `finite_presentation` if it is of finite presentation as
+ring morphism. In other words, if `B` is finitely presented as `A`-algebra. -/
+def finite_presentation (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite_presentation
+
+namespace finite_type
+
+variables {R A}
+
+lemma of_finite_presentation {f : A →ₐ[R] B} (hf : f.finite_presentation) : f.finite_type :=
+ring_hom.finite_type.of_finite_presentation hf
+
+end finite_type
+
+namespace finite_presentation
+
+variables (R A)
+
+lemma id : finite_presentation (alg_hom.id R A) := ring_hom.finite_presentation.id A
+
+variables {R A}
+
+lemma comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.finite_presentation)
+  (hf : f.finite_presentation) : (g.comp f).finite_presentation :=
+ring_hom.finite_presentation.comp hg hf
+
+lemma comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.finite_presentation)
+  (hg : surjective g) (hker : g.to_ring_hom.ker.fg) : (g.comp f).finite_presentation :=
+ring_hom.finite_presentation.comp_surjective hf hg hker
+
+lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) (hker : f.to_ring_hom.ker.fg) :
+  f.finite_presentation :=
+ring_hom.finite_presentation.of_surjective f hf hker
+
+lemma of_finite_type [is_noetherian_ring A] {f : A →ₐ[R] B} :
+  f.finite_type ↔ f.finite_presentation :=
+ring_hom.finite_presentation.of_finite_type
+
+lemma of_comp_finite_type (f : A →ₐ[R] B) {g : B →ₐ[R] C} (h : (g.comp f).finite_presentation)
+  (h' : f.finite_type) : g.finite_presentation :=
+h.of_comp_finite_type _ h'
+
+end finite_presentation
+
+end alg_hom
diff --git a/src/ring_theory/finite_type.lean b/src/ring_theory/finite_type.lean
new file mode 100644
index 0000000000000..b0c17406ed9b7
--- /dev/null
+++ b/src/ring_theory/finite_type.lean
@@ -0,0 +1,646 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+
+import group_theory.finiteness
+import ring_theory.adjoin.tower
+import ring_theory.finiteness
+import ring_theory.noetherian
+
+/-!
+# Finiteness conditions in commutative algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define a notion of finiteness that is common in commutative algebra.
+
+## Main declarations
+
+- `algebra.finite_type`, `ring_hom.finite_type`, `alg_hom.finite_type`
+  all of these express that some object is finitely generated *as algebra* over some base ring.
+
+-/
+
+open function (surjective)
+open_locale big_operators polynomial
+
+section module_and_algebra
+
+variables (R A B M N : Type*)
+
+/-- An algebra over a commutative semiring is of `finite_type` if it is finitely generated
+over the base ring as algebra. -/
+class algebra.finite_type [comm_semiring R] [semiring A] [algebra R A] : Prop :=
+(out : (⊤ : subalgebra R A).fg)
+
+namespace module
+
+variables [semiring R] [add_comm_monoid M] [module R M] [add_comm_monoid N] [module R N]
+
+namespace finite
+open _root_.submodule set
+
+variables {R M N}
+
+section algebra
+
+@[priority 100] -- see Note [lower instance priority]
+instance finite_type {R : Type*} (A : Type*) [comm_semiring R] [semiring A]
+  [algebra R A] [hRA : finite R A] : algebra.finite_type R A :=
+⟨subalgebra.fg_of_submodule_fg hRA.1⟩
+
+end algebra
+
+end finite
+
+end module
+
+namespace algebra
+
+variables [comm_ring R] [comm_ring A] [algebra R A] [comm_ring B] [algebra R B]
+variables [add_comm_group M] [module R M]
+variables [add_comm_group N] [module R N]
+
+namespace finite_type
+
+lemma self : finite_type R R := ⟨⟨{1}, subsingleton.elim _ _⟩⟩
+
+protected lemma polynomial : finite_type R R[X] :=
+⟨⟨{polynomial.X}, by { rw finset.coe_singleton, exact polynomial.adjoin_X }⟩⟩
+
+open_locale classical
+
+protected lemma mv_polynomial (ι : Type*) [finite ι] : finite_type R (mv_polynomial ι R) :=
+by casesI nonempty_fintype ι; exact ⟨⟨finset.univ.image mv_polynomial.X,
+  by {rw [finset.coe_image, finset.coe_univ, set.image_univ], exact mv_polynomial.adjoin_range_X}⟩⟩
+
+lemma of_restrict_scalars_finite_type [algebra A B] [is_scalar_tower R A B] [hB : finite_type R B] :
+  finite_type A B :=
+begin
+  obtain ⟨S, hS⟩ := hB.out,
+  refine ⟨⟨S, eq_top_iff.2 (λ b, _)⟩⟩,
+  have le : adjoin R (S : set B) ≤ subalgebra.restrict_scalars R (adjoin A S),
+  { apply (algebra.adjoin_le _ : _ ≤ (subalgebra.restrict_scalars R (adjoin A ↑S))),
+    simp only [subalgebra.coe_restrict_scalars],
+    exact algebra.subset_adjoin, },
+  exact le (eq_top_iff.1 hS b),
+end
+
+variables {R A B}
+
+lemma of_surjective (hRA : finite_type R A) (f : A →ₐ[R] B) (hf : surjective f) :
+  finite_type R B :=
+⟨begin
+  convert hRA.1.map f,
+  simpa only [map_top f, @eq_comm _ ⊤, eq_top_iff, alg_hom.mem_range] using hf
+end⟩
+
+lemma equiv (hRA : finite_type R A) (e : A ≃ₐ[R] B) : finite_type R B :=
+hRA.of_surjective e e.surjective
+
+lemma trans [algebra A B] [is_scalar_tower R A B] (hRA : finite_type R A) (hAB : finite_type A B) :
+  finite_type R B :=
+⟨fg_trans' hRA.1 hAB.1⟩
+
+/-- An algebra is finitely generated if and only if it is a quotient
+of a polynomial ring whose variables are indexed by a finset. -/
+lemma iff_quotient_mv_polynomial : (finite_type R A) ↔ ∃ (s : finset A)
+  (f : (mv_polynomial {x // x ∈ s} R) →ₐ[R] A), (surjective f) :=
+begin
+  split,
+  { rintro ⟨s, hs⟩,
+    use [s, mv_polynomial.aeval coe],
+    intro x,
+    have hrw : (↑s : set A) = (λ (x : A), x ∈ s.val) := rfl,
+    rw [← set.mem_range, ← alg_hom.coe_range, ← adjoin_eq_range, ← hrw, hs],
+    exact set.mem_univ x },
+  { rintro ⟨s, ⟨f, hsur⟩⟩,
+    exact finite_type.of_surjective (finite_type.mv_polynomial R {x // x ∈ s}) f hsur }
+end
+
+/-- An algebra is finitely generated if and only if it is a quotient
+of a polynomial ring whose variables are indexed by a fintype. -/
+lemma iff_quotient_mv_polynomial' : (finite_type R A) ↔ ∃ (ι : Type u_2) (_ : fintype ι)
+  (f : (mv_polynomial ι R) →ₐ[R] A), (surjective f) :=
+begin
+  split,
+  { rw iff_quotient_mv_polynomial,
+    rintro ⟨s, ⟨f, hsur⟩⟩,
+    use [{x // x ∈ s}, by apply_instance, f, hsur] },
+  { rintro ⟨ι, ⟨hfintype, ⟨f, hsur⟩⟩⟩,
+    letI : fintype ι := hfintype,
+    exact finite_type.of_surjective (finite_type.mv_polynomial R ι) f hsur }
+end
+
+/-- An algebra is finitely generated if and only if it is a quotient of a polynomial ring in `n`
+variables. -/
+lemma iff_quotient_mv_polynomial'' : (finite_type R A) ↔ ∃ (n : ℕ)
+  (f : (mv_polynomial (fin n) R) →ₐ[R] A), (surjective f) :=
+begin
+  split,
+  { rw iff_quotient_mv_polynomial',
+    rintro ⟨ι, hfintype, ⟨f, hsur⟩⟩,
+    resetI,
+    have equiv := mv_polynomial.rename_equiv R (fintype.equiv_fin ι),
+    exact ⟨fintype.card ι, alg_hom.comp f equiv.symm, function.surjective.comp hsur
+      (alg_equiv.symm equiv).surjective⟩ },
+  { rintro ⟨n, ⟨f, hsur⟩⟩,
+    exact finite_type.of_surjective (finite_type.mv_polynomial R (fin n)) f hsur }
+end
+
+instance prod [hA : finite_type R A] [hB : finite_type R B] : finite_type R (A × B) :=
+⟨begin
+  rw ← subalgebra.prod_top,
+  exact hA.1.prod hB.1
+end⟩
+
+lemma is_noetherian_ring (R S : Type*) [comm_ring R] [comm_ring S] [algebra R S]
+  [h : algebra.finite_type R S] [is_noetherian_ring R] : is_noetherian_ring S :=
+begin
+  obtain ⟨s, hs⟩ := h.1,
+  apply is_noetherian_ring_of_surjective
+    (mv_polynomial s R) S (mv_polynomial.aeval coe : mv_polynomial s R →ₐ[R] S),
+  rw [← set.range_iff_surjective, alg_hom.coe_to_ring_hom, ← alg_hom.coe_range,
+    ← algebra.adjoin_range_eq_range_aeval, subtype.range_coe_subtype, finset.set_of_mem, hs],
+  refl
+end
+
+lemma _root_.subalgebra.fg_iff_finite_type {R A : Type*} [comm_semiring R] [semiring A]
+  [algebra R A] (S : subalgebra R A) : S.fg ↔ algebra.finite_type R S :=
+S.fg_top.symm.trans ⟨λ h, ⟨h⟩, λ h, h.out⟩
+
+end finite_type
+
+end algebra
+
+end module_and_algebra
+
+namespace ring_hom
+variables {A B C : Type*} [comm_ring A] [comm_ring B] [comm_ring C]
+
+/-- A ring morphism `A →+* B` is of `finite_type` if `B` is finitely generated as `A`-algebra. -/
+def finite_type (f : A →+* B) : Prop := @algebra.finite_type A B _ _ f.to_algebra
+
+namespace finite
+
+variables {A}
+
+lemma finite_type {f : A →+* B} (hf : f.finite) : finite_type f :=
+@module.finite.finite_type _ _ _ _ f.to_algebra hf
+
+end finite
+
+namespace finite_type
+
+variables (A)
+
+lemma id : finite_type (ring_hom.id A) := algebra.finite_type.self A
+
+variables {A}
+
+lemma comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.finite_type) (hg : surjective g) :
+  (g.comp f).finite_type :=
+@algebra.finite_type.of_surjective A B C _ _ f.to_algebra _ (g.comp f).to_algebra hf
+{ to_fun := g, commutes' := λ a, rfl, .. g } hg
+
+lemma of_surjective (f : A →+* B) (hf : surjective f) : f.finite_type :=
+by { rw ← f.comp_id, exact (id A).comp_surjective hf }
+
+lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite_type) (hf : f.finite_type) :
+  (g.comp f).finite_type :=
+@algebra.finite_type.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
+begin
+  fconstructor,
+  intros a b c,
+  simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
+  refl
+end
+hf hg
+
+lemma of_finite {f : A →+* B} (hf : f.finite) : f.finite_type :=
+@module.finite.finite_type _ _ _ _ f.to_algebra hf
+
+alias of_finite ← _root_.ring_hom.finite.to_finite_type
+
+lemma of_comp_finite_type {f : A →+* B} {g : B →+* C} (h : (g.comp f).finite_type) :
+  g.finite_type :=
+begin
+  letI := f.to_algebra,
+  letI := g.to_algebra,
+  letI := (g.comp f).to_algebra,
+  letI : is_scalar_tower A B C := restrict_scalars.is_scalar_tower A B C,
+  letI : algebra.finite_type A C := h,
+  exact algebra.finite_type.of_restrict_scalars_finite_type A B C
+end
+
+end finite_type
+
+end ring_hom
+
+namespace alg_hom
+
+variables {R A B C : Type*} [comm_ring R]
+variables [comm_ring A] [comm_ring B] [comm_ring C]
+variables [algebra R A] [algebra R B] [algebra R C]
+
+/-- An algebra morphism `A →ₐ[R] B` is of `finite_type` if it is of finite type as ring morphism.
+In other words, if `B` is finitely generated as `A`-algebra. -/
+def finite_type (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite_type
+
+namespace finite
+
+variables {R A}
+
+lemma finite_type {f : A →ₐ[R] B} (hf : f.finite) : finite_type f :=
+ring_hom.finite.finite_type hf
+
+end finite
+
+namespace finite_type
+
+variables (R A)
+
+lemma id : finite_type (alg_hom.id R A) := ring_hom.finite_type.id A
+
+variables {R A}
+
+lemma comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.finite_type) (hf : f.finite_type) :
+  (g.comp f).finite_type :=
+ring_hom.finite_type.comp hg hf
+
+lemma comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.finite_type) (hg : surjective g) :
+  (g.comp f).finite_type :=
+ring_hom.finite_type.comp_surjective hf hg
+
+lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) : f.finite_type :=
+ring_hom.finite_type.of_surjective f hf
+
+lemma of_comp_finite_type {f : A →ₐ[R] B} {g : B →ₐ[R] C} (h : (g.comp f).finite_type) :
+g.finite_type :=
+ring_hom.finite_type.of_comp_finite_type h
+
+end finite_type
+
+end alg_hom
+
+section monoid_algebra
+
+variables {R : Type*} {M : Type*}
+
+namespace add_monoid_algebra
+
+open algebra add_submonoid submodule
+
+section span
+
+section semiring
+
+variables [comm_semiring R] [add_monoid M]
+
+/-- An element of `add_monoid_algebra R M` is in the subalgebra generated by its support. -/
+lemma mem_adjoin_support (f : add_monoid_algebra R M) : f ∈ adjoin R (of' R M '' f.support) :=
+begin
+  suffices : span R (of' R M '' f.support) ≤ (adjoin R (of' R M '' f.support)).to_submodule,
+  { exact this (mem_span_support f) },
+  rw submodule.span_le,
+  exact subset_adjoin
+end
+
+/-- If a set `S` generates, as algebra, `add_monoid_algebra R M`, then the set of supports of
+elements of `S` generates `add_monoid_algebra R M`. -/
+lemma support_gen_of_gen {S : set (add_monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
+  algebra.adjoin R (⋃ f ∈ S, (of' R M '' (f.support : set M))) = ⊤ :=
+begin
+  refine le_antisymm le_top _,
+  rw [← hS, adjoin_le_iff],
+  intros f hf,
+  have hincl : of' R M '' f.support ⊆
+    ⋃ (g : add_monoid_algebra R M) (H : g ∈ S), of' R M '' g.support,
+  { intros s hs,
+    exact set.mem_Union₂.2 ⟨f, ⟨hf, hs⟩⟩ },
+  exact adjoin_mono hincl (mem_adjoin_support f)
+end
+
+/-- If a set `S` generates, as algebra, `add_monoid_algebra R M`, then the image of the union of
+the supports of elements of `S` generates `add_monoid_algebra R M`. -/
+lemma support_gen_of_gen' {S : set (add_monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
+  algebra.adjoin R (of' R M '' (⋃ f ∈ S, (f.support : set M))) = ⊤ :=
+begin
+  suffices : of' R M '' (⋃ f ∈ S, (f.support : set M)) = ⋃ f ∈ S, (of' R M '' (f.support : set M)),
+  { rw this,
+    exact support_gen_of_gen hS },
+  simp only [set.image_Union]
+end
+
+end semiring
+
+section ring
+
+variables [comm_ring R] [add_comm_monoid M]
+
+/-- If `add_monoid_algebra R M` is of finite type, there there is a `G : finset M` such that its
+image generates, as algera, `add_monoid_algebra R M`. -/
+lemma exists_finset_adjoin_eq_top [h : finite_type R (add_monoid_algebra R M)] :
+  ∃ G : finset M, algebra.adjoin R (of' R M '' G) = ⊤ :=
+begin
+  unfreezingI { obtain ⟨S, hS⟩ := h },
+  letI : decidable_eq M := classical.dec_eq M,
+  use finset.bUnion S (λ f, f.support),
+  have : (finset.bUnion S (λ f, f.support) : set M) = ⋃ f ∈ S, (f.support : set M),
+  { simp only [finset.set_bUnion_coe, finset.coe_bUnion] },
+  rw [this],
+  exact support_gen_of_gen' hS
+end
+
+/-- The image of an element `m : M` in `add_monoid_algebra R M` belongs the submodule generated by
+`S : set M` if and only if `m ∈ S`. -/
+lemma of'_mem_span [nontrivial R] {m : M} {S : set M} :
+  of' R M m ∈ span R (of' R M '' S) ↔ m ∈ S :=
+begin
+  refine ⟨λ h, _, λ h, submodule.subset_span $ set.mem_image_of_mem (of R M) h⟩,
+  rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported,
+    finsupp.support_single_ne_zero _ (one_ne_zero' R)] at h,
+  simpa using h
+end
+
+/--If the image of an element `m : M` in `add_monoid_algebra R M` belongs the submodule generated by
+the closure of some `S : set M` then `m ∈ closure S`. -/
+lemma mem_closure_of_mem_span_closure [nontrivial R] {m : M} {S : set M}
+  (h : of' R M m ∈ span R (submonoid.closure (of' R M '' S) : set (add_monoid_algebra R M))) :
+  m ∈ closure S :=
+begin
+  suffices : multiplicative.of_add m ∈ submonoid.closure (multiplicative.to_add ⁻¹' S),
+  { simpa [← to_submonoid_closure] },
+  let S' := @submonoid.closure M multiplicative.mul_one_class S,
+  have h' : submonoid.map (of R M) S' = submonoid.closure ((λ (x : M), (of R M) x) '' S) :=
+    monoid_hom.map_mclosure _ _,
+  rw [set.image_congr' (show ∀ x, of' R M x = of R M x, from λ x, of'_eq_of x), ← h'] at h,
+  simpa using of'_mem_span.1 h
+end
+
+end ring
+
+end span
+
+variables [add_comm_monoid M]
+
+/-- If a set `S` generates an additive monoid `M`, then the image of `M` generates, as algebra,
+`add_monoid_algebra R M`. -/
+lemma mv_polynomial_aeval_of_surjective_of_closure [comm_semiring R] {S : set M}
+  (hS : closure S = ⊤) : function.surjective (mv_polynomial.aeval
+  (λ (s : S), of' R M ↑s) : mv_polynomial S R → add_monoid_algebra R M) :=
+begin
+  refine λ f, induction_on f (λ m, _) _ _,
+  { have : m ∈ closure S := hS.symm ▸ mem_top _,
+    refine closure_induction this (λ m hm, _) _ _,
+    { exact ⟨mv_polynomial.X ⟨m, hm⟩, mv_polynomial.aeval_X _ _⟩ },
+    { exact ⟨1, alg_hom.map_one _⟩ },
+    { rintro m₁ m₂ ⟨P₁, hP₁⟩ ⟨P₂, hP₂⟩,
+      exact ⟨P₁ * P₂, by rw [alg_hom.map_mul, hP₁, hP₂, of_apply, of_apply, of_apply,
+        single_mul_single, one_mul]; refl⟩ } },
+  { rintro f g ⟨P, rfl⟩ ⟨Q, rfl⟩,
+    exact ⟨P + Q, alg_hom.map_add _ _ _⟩ },
+  { rintro r f ⟨P, rfl⟩,
+    exact ⟨r • P, alg_hom.map_smul _ _ _⟩ }
+end
+
+variables (R M)
+
+/-- If an additive monoid `M` is finitely generated then `add_monoid_algebra R M` is of finite
+type. -/
+instance finite_type_of_fg [comm_ring R] [h : add_monoid.fg M] :
+  finite_type R (add_monoid_algebra R M) :=
+begin
+  obtain ⟨S, hS⟩ := h.out,
+  exact (finite_type.mv_polynomial R (S : set M)).of_surjective (mv_polynomial.aeval
+    (λ (s : (S : set M)), of' R M ↑s)) (mv_polynomial_aeval_of_surjective_of_closure hS)
+end
+
+variables {R M}
+
+/-- An additive monoid `M` is finitely generated if and only if `add_monoid_algebra R M` is of
+finite type. -/
+lemma finite_type_iff_fg [comm_ring R] [nontrivial R] :
+  finite_type R (add_monoid_algebra R M) ↔ add_monoid.fg M :=
+begin
+  refine ⟨λ h, _, λ h, @add_monoid_algebra.finite_type_of_fg _ _ _ _ h⟩,
+  obtain ⟨S, hS⟩ := @exists_finset_adjoin_eq_top R M _ _ h,
+  refine add_monoid.fg_def.2 ⟨S, (eq_top_iff' _).2 (λ m, _)⟩,
+  have hm : of' R M m ∈ (adjoin R (of' R M '' ↑S)).to_submodule,
+  { simp only [hS, top_to_submodule, submodule.mem_top], },
+  rw [adjoin_eq_span] at hm,
+  exact mem_closure_of_mem_span_closure hm
+end
+
+/-- If `add_monoid_algebra R M` is of finite type then `M` is finitely generated. -/
+lemma fg_of_finite_type [comm_ring R] [nontrivial R] [h : finite_type R (add_monoid_algebra R M)] :
+  add_monoid.fg M :=
+finite_type_iff_fg.1 h
+
+/-- An additive group `G` is finitely generated if and only if `add_monoid_algebra R G` is of
+finite type. -/
+lemma finite_type_iff_group_fg {G : Type*} [add_comm_group G] [comm_ring R] [nontrivial R] :
+  finite_type R (add_monoid_algebra R G) ↔ add_group.fg G :=
+by simpa [add_group.fg_iff_add_monoid.fg] using finite_type_iff_fg
+
+end add_monoid_algebra
+
+namespace monoid_algebra
+
+open algebra submonoid submodule
+
+section span
+
+section semiring
+
+variables [comm_semiring R] [monoid M]
+
+/-- An element of `monoid_algebra R M` is in the subalgebra generated by its support. -/
+lemma mem_adjoin_support (f : monoid_algebra R M) : f ∈ adjoin R (of R M '' f.support) :=
+begin
+  suffices : span R (of R M '' f.support) ≤ (adjoin R (of R M '' f.support)).to_submodule,
+  { exact this (mem_span_support f) },
+  rw submodule.span_le,
+  exact subset_adjoin
+end
+
+/-- If a set `S` generates, as algebra, `monoid_algebra R M`, then the set of supports of elements
+of `S` generates `monoid_algebra R M`. -/
+lemma support_gen_of_gen {S : set (monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
+  algebra.adjoin R (⋃ f ∈ S, (of R M '' (f.support : set M))) = ⊤ :=
+begin
+  refine le_antisymm le_top _,
+  rw [← hS, adjoin_le_iff],
+  intros f hf,
+  have hincl : (of R M) '' f.support ⊆
+    ⋃ (g : monoid_algebra R M) (H : g ∈ S), of R M '' g.support,
+  { intros s hs,
+    exact set.mem_Union₂.2 ⟨f, ⟨hf, hs⟩⟩ },
+  exact adjoin_mono hincl (mem_adjoin_support f)
+end
+
+/-- If a set `S` generates, as algebra, `monoid_algebra R M`, then the image of the union of the
+supports of elements of `S` generates `monoid_algebra R M`. -/
+lemma support_gen_of_gen' {S : set (monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
+  algebra.adjoin R (of R M '' (⋃ f ∈ S, (f.support : set M))) = ⊤ :=
+begin
+  suffices : of R M '' (⋃ f ∈ S, (f.support : set M)) = ⋃ f ∈ S, (of R M '' (f.support : set M)),
+  { rw this,
+    exact support_gen_of_gen hS },
+  simp only [set.image_Union]
+end
+
+end semiring
+
+section ring
+
+variables [comm_ring R] [comm_monoid M]
+
+/-- If `monoid_algebra R M` is of finite type, there there is a `G : finset M` such that its image
+generates, as algera, `monoid_algebra R M`. -/
+lemma exists_finset_adjoin_eq_top [h :finite_type R (monoid_algebra R M)] :
+  ∃ G : finset M, algebra.adjoin R (of R M '' G) = ⊤ :=
+begin
+  unfreezingI { obtain ⟨S, hS⟩ := h },
+  letI : decidable_eq M := classical.dec_eq M,
+  use finset.bUnion S (λ f, f.support),
+  have : (finset.bUnion S (λ f, f.support) : set M) = ⋃ f ∈ S, (f.support : set M),
+  { simp only [finset.set_bUnion_coe, finset.coe_bUnion] },
+  rw [this],
+  exact support_gen_of_gen' hS
+end
+
+/-- The image of an element `m : M` in `monoid_algebra R M` belongs the submodule generated by
+`S : set M` if and only if `m ∈ S`. -/
+lemma of_mem_span_of_iff [nontrivial R] {m : M} {S : set M} :
+  of R M m ∈ span R (of R M '' S) ↔ m ∈ S :=
+begin
+  refine ⟨λ h, _, λ h, submodule.subset_span $ set.mem_image_of_mem (of R M) h⟩,
+  rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported,
+    finsupp.support_single_ne_zero _ (one_ne_zero' R)] at h,
+  simpa using h
+end
+
+/--If the image of an element `m : M` in `monoid_algebra R M` belongs the submodule generated by the
+closure of some `S : set M` then `m ∈ closure S`. -/
+lemma mem_closure_of_mem_span_closure [nontrivial R] {m : M} {S : set M}
+  (h : of R M m ∈ span R (submonoid.closure (of R M '' S) : set (monoid_algebra R M))) :
+  m ∈ closure S :=
+begin
+  rw ← monoid_hom.map_mclosure at h,
+  simpa using of_mem_span_of_iff.1 h
+end
+
+end ring
+
+end span
+
+variables [comm_monoid M]
+
+/-- If a set `S` generates a monoid `M`, then the image of `M` generates, as algebra,
+`monoid_algebra R M`. -/
+lemma mv_polynomial_aeval_of_surjective_of_closure [comm_semiring R] {S : set M}
+  (hS : closure S = ⊤) : function.surjective (mv_polynomial.aeval
+  (λ (s : S), of R M ↑s) : mv_polynomial S R → monoid_algebra R M) :=
+begin
+  refine λ f, induction_on f (λ m, _) _ _,
+  { have : m ∈ closure S := hS.symm ▸ mem_top _,
+    refine closure_induction this (λ m hm, _) _ _,
+    { exact ⟨mv_polynomial.X ⟨m, hm⟩, mv_polynomial.aeval_X _ _⟩ },
+    { exact ⟨1, alg_hom.map_one _⟩ },
+    { rintro m₁ m₂ ⟨P₁, hP₁⟩ ⟨P₂, hP₂⟩,
+      exact ⟨P₁ * P₂, by rw [alg_hom.map_mul, hP₁, hP₂, of_apply, of_apply, of_apply,
+        single_mul_single, one_mul]⟩ } },
+  { rintro f g ⟨P, rfl⟩ ⟨Q, rfl⟩,
+    exact ⟨P + Q, alg_hom.map_add _ _ _⟩ },
+  { rintro r f ⟨P, rfl⟩,
+    exact ⟨r • P, alg_hom.map_smul _ _ _⟩ }
+end
+
+/-- If a monoid `M` is finitely generated then `monoid_algebra R M` is of finite type. -/
+instance finite_type_of_fg [comm_ring R] [monoid.fg M] : finite_type R (monoid_algebra R M) :=
+(add_monoid_algebra.finite_type_of_fg R (additive M)).equiv (to_additive_alg_equiv R M).symm
+
+/-- A monoid `M` is finitely generated if and only if `monoid_algebra R M` is of finite type. -/
+lemma finite_type_iff_fg [comm_ring R] [nontrivial R] :
+  finite_type R (monoid_algebra R M) ↔ monoid.fg M :=
+⟨λ h, monoid.fg_iff_add_fg.2 $ add_monoid_algebra.finite_type_iff_fg.1 $ h.equiv $
+  to_additive_alg_equiv R M, λ h, @monoid_algebra.finite_type_of_fg _ _ _ _ h⟩
+
+/-- If `monoid_algebra R M` is of finite type then `M` is finitely generated. -/
+lemma fg_of_finite_type [comm_ring R] [nontrivial R] [h : finite_type R (monoid_algebra R M)] :
+  monoid.fg M :=
+finite_type_iff_fg.1 h
+
+/-- A group `G` is finitely generated if and only if `add_monoid_algebra R G` is of finite type. -/
+lemma finite_type_iff_group_fg {G : Type*} [comm_group G] [comm_ring R] [nontrivial R] :
+  finite_type R (monoid_algebra R G) ↔ group.fg G :=
+by simpa [group.fg_iff_monoid.fg] using finite_type_iff_fg
+
+end monoid_algebra
+
+end monoid_algebra
+
+section vasconcelos
+variables {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M] (f : M →ₗ[R] M)
+
+noncomputable theory
+
+/-- The structure of a module `M` over a ring `R` as a module over `R[X]` when given a
+choice of how `X` acts by choosing a linear map `f : M →ₗ[R] M` -/
+def module_polynomial_of_endo : module R[X] M :=
+module.comp_hom M (polynomial.aeval f).to_ring_hom
+
+lemma module_polynomial_of_endo_smul_def (n : R[X]) (a : M) :
+  @@has_smul.smul (module_polynomial_of_endo f).to_has_smul n a = polynomial.aeval f n a := rfl
+
+local attribute [simp] module_polynomial_of_endo_smul_def
+
+include f
+lemma module_polynomial_of_endo.is_scalar_tower : @is_scalar_tower R R[X] M _
+  (by { letI := module_polynomial_of_endo f, apply_instance }) _ :=
+begin
+  letI := module_polynomial_of_endo f,
+  constructor,
+  intros x y z,
+  simp,
+end
+
+open polynomial module
+
+/-- A theorem/proof by Vasconcelos, given a finite module `M` over a commutative ring, any
+surjective endomorphism of `M` is also injective. Based on,
+https://math.stackexchange.com/a/239419/31917,
+https://www.ams.org/journals/tran/1969-138-00/S0002-9947-1969-0238839-5/.
+This is similar to `is_noetherian.injective_of_surjective_endomorphism` but only applies in the
+commutative case, but does not use a Noetherian hypothesis. -/
+theorem module.finite.injective_of_surjective_endomorphism [hfg : finite R M]
+  (f_surj : function.surjective f) : function.injective f :=
+begin
+  letI := module_polynomial_of_endo f,
+  haveI : is_scalar_tower R R[X] M := module_polynomial_of_endo.is_scalar_tower f,
+  have hfgpoly : finite R[X] M, from finite.of_restrict_scalars_finite R _ _,
+  have X_mul : ∀ o, (X : R[X]) • o = f o,
+  { intro,
+    simp, },
+  have : (⊤ : submodule R[X] M) ≤ ideal.span {X} • ⊤,
+  { intros a ha,
+    obtain ⟨y, rfl⟩ := f_surj a,
+    rw [← X_mul y],
+    exact submodule.smul_mem_smul (ideal.mem_span_singleton.mpr (dvd_refl _)) trivial, },
+  obtain ⟨F, hFa, hFb⟩ := submodule.exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul _
+    (⊤ : submodule R[X] M) (finite_def.mp hfgpoly) this,
+  rw [← linear_map.ker_eq_bot, linear_map.ker_eq_bot'],
+  intros m hm,
+  rw ideal.mem_span_singleton' at hFa,
+  obtain ⟨G, hG⟩ := hFa,
+  suffices : (F - 1) • m = 0,
+  { have Fmzero := hFb m (by simp),
+    rwa [← sub_add_cancel F 1, add_smul, one_smul, this, zero_add] at Fmzero, },
+  rw [← hG, mul_smul, X_mul m, hm, smul_zero],
+end
+
+end vasconcelos
diff --git a/src/ring_theory/finiteness.lean b/src/ring_theory/finiteness.lean
index 9e38911ef024d..770b1bb947c6e 100644
--- a/src/ring_theory/finiteness.lean
+++ b/src/ring_theory/finiteness.lean
@@ -4,29 +4,438 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 
+import algebra.algebra.restrict_scalars
+import algebra.algebra.subalgebra.basic
 import group_theory.finiteness
-import ring_theory.algebra_tower
-import ring_theory.ideal.quotient
-import ring_theory.noetherian
+import ring_theory.ideal.operations
 
 /-!
 # Finiteness conditions in commutative algebra
 
-In this file we define several notions of finiteness that are common in commutative algebra.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define a notion of finiteness that is common in commutative algebra.
 
 ## Main declarations
 
-- `module.finite`, `algebra.finite`, `ring_hom.finite`, `alg_hom.finite`
+- `submodule.fg`, `ideal.fg`
+  These express that some object is finitely generated as *submodule* over some base ring.
+
+- `module.finite`, `ring_hom.finite`, `alg_hom.finite`
   all of these express that some object is finitely generated *as module* over some base ring.
-- `algebra.finite_type`, `ring_hom.finite_type`, `alg_hom.finite_type`
-  all of these express that some object is finitely generated *as algebra* over some base ring.
-- `algebra.finite_presentation`, `ring_hom.finite_presentation`, `alg_hom.finite_presentation`
-  all of these express that some object is finitely presented *as algebra* over some base ring.
+
+## Main results
+
+* `exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul` is Nakayama's lemma, in the following form:
+  if N is a finitely generated submodule of an ambient R-module M and I is an ideal of R
+  such that N ⊆ IN, then there exists r ∈ 1 + I such that rN = 0.
 
 -/
 
 open function (surjective)
-open_locale big_operators polynomial
+open_locale big_operators
+
+namespace submodule
+variables {R : Type*} {M : Type*} [semiring R] [add_comm_monoid M] [module R M]
+
+open set
+
+/-- A submodule of `M` is finitely generated if it is the span of a finite subset of `M`. -/
+def fg (N : submodule R M) : Prop := ∃ S : finset M, submodule.span R ↑S = N
+
+theorem fg_def {N : submodule R M} :
+  N.fg ↔ ∃ S : set M, S.finite ∧ span R S = N :=
+⟨λ ⟨t, h⟩, ⟨_, finset.finite_to_set t, h⟩, begin
+  rintro ⟨t', h, rfl⟩,
+  rcases finite.exists_finset_coe h with ⟨t, rfl⟩,
+  exact ⟨t, rfl⟩
+end⟩
+
+lemma fg_iff_add_submonoid_fg (P : submodule ℕ M) :
+  P.fg ↔ P.to_add_submonoid.fg :=
+⟨λ ⟨S, hS⟩, ⟨S, by simpa [← span_nat_eq_add_submonoid_closure] using hS⟩,
+  λ ⟨S, hS⟩, ⟨S, by simpa [← span_nat_eq_add_submonoid_closure] using hS⟩⟩
+
+lemma fg_iff_add_subgroup_fg {G : Type*} [add_comm_group G] (P : submodule ℤ G) :
+  P.fg ↔ P.to_add_subgroup.fg :=
+⟨λ ⟨S, hS⟩, ⟨S, by simpa [← span_int_eq_add_subgroup_closure] using hS⟩,
+  λ ⟨S, hS⟩, ⟨S, by simpa [← span_int_eq_add_subgroup_closure] using hS⟩⟩
+
+lemma fg_iff_exists_fin_generating_family {N : submodule R M} :
+  N.fg ↔ ∃ (n : ℕ) (s : fin n → M), span R (range s) = N :=
+begin
+  rw fg_def,
+  split,
+  { rintros ⟨S, Sfin, hS⟩,
+    obtain ⟨n, f, rfl⟩ := Sfin.fin_embedding,
+    exact ⟨n, f, hS⟩, },
+  { rintros ⟨n, s, hs⟩,
+    refine ⟨range s, finite_range s, hs⟩ },
+end
+
+/-- **Nakayama's Lemma**. Atiyah-Macdonald 2.5, Eisenbud 4.7, Matsumura 2.2,
+[Stacks 00DV](https://stacks.math.columbia.edu/tag/00DV) -/
+theorem exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul {R : Type*} [comm_ring R]
+  {M : Type*} [add_comm_group M] [module R M]
+  (I : ideal R) (N : submodule R M) (hn : N.fg) (hin : N ≤ I • N) :
+  ∃ r : R, r - 1 ∈ I ∧ ∀ n ∈ N, r • n = (0 : M) :=
+begin
+  rw fg_def at hn, rcases hn with ⟨s, hfs, hs⟩,
+  have : ∃ r : R, r - 1 ∈ I ∧ N ≤ (I • span R s).comap (linear_map.lsmul R M r) ∧ s ⊆ N,
+  { refine ⟨1, _, _, _⟩,
+    { rw sub_self, exact I.zero_mem },
+    { rw [hs], intros n hn, rw [mem_comap], change (1:R) • n ∈ I • N, rw one_smul, exact hin hn },
+    { rw [← span_le, hs], exact le_refl N } },
+  clear hin hs, revert this,
+  refine set.finite.dinduction_on hfs (λ H, _) (λ i s his hfs ih H, _),
+  { rcases H with ⟨r, hr1, hrn, hs⟩, refine ⟨r, hr1, λ n hn, _⟩, specialize hrn hn,
+    rwa [mem_comap, span_empty, smul_bot, mem_bot] at hrn },
+  apply ih, rcases H with ⟨r, hr1, hrn, hs⟩,
+  rw [← set.singleton_union, span_union, smul_sup] at hrn,
+  rw [set.insert_subset] at hs,
+  have : ∃ c : R, c - 1 ∈ I ∧ c • i ∈ I • span R s,
+  { specialize hrn hs.1, rw [mem_comap, mem_sup] at hrn,
+    rcases hrn with ⟨y, hy, z, hz, hyz⟩, change y + z = r • i at hyz,
+    rw mem_smul_span_singleton at hy, rcases hy with ⟨c, hci, rfl⟩,
+    use r-c, split,
+    { rw [sub_right_comm], exact I.sub_mem hr1 hci },
+    { rw [sub_smul, ← hyz, add_sub_cancel'], exact hz } },
+  rcases this with ⟨c, hc1, hci⟩, refine ⟨c * r, _, _, hs.2⟩,
+  { simpa only [mul_sub, mul_one, sub_add_sub_cancel] using I.add_mem (I.mul_mem_left c hr1) hc1 },
+  { intros n hn, specialize hrn hn, rw [mem_comap, mem_sup] at hrn,
+    rcases hrn with ⟨y, hy, z, hz, hyz⟩, change y + z = r • n at hyz,
+    rw mem_smul_span_singleton at hy, rcases hy with ⟨d, hdi, rfl⟩,
+    change _ • _ ∈ I • span R s,
+    rw [mul_smul, ← hyz, smul_add, smul_smul, mul_comm, mul_smul],
+    exact add_mem (smul_mem _ _ hci) (smul_mem _ _ hz) }
+end
+
+theorem exists_mem_and_smul_eq_self_of_fg_of_le_smul {R : Type*} [comm_ring R]
+  {M : Type*} [add_comm_group M] [module R M]
+  (I : ideal R) (N : submodule R M) (hn : N.fg) (hin : N ≤ I • N) :
+  ∃ r ∈ I, ∀ n ∈ N, r • n = n :=
+begin
+  obtain ⟨r, hr, hr'⟩ := N.exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul I hn hin,
+  exact ⟨-(r-1), I.neg_mem hr, λ n hn, by simpa [sub_smul] using hr' n hn⟩,
+end
+
+theorem fg_bot : (⊥ : submodule R M).fg :=
+⟨∅, by rw [finset.coe_empty, span_empty]⟩
+
+lemma _root_.subalgebra.fg_bot_to_submodule {R A : Type*}
+  [comm_semiring R] [semiring A] [algebra R A] :
+  (⊥ : subalgebra R A).to_submodule.fg :=
+⟨{1}, by simp [algebra.to_submodule_bot] ⟩
+
+lemma fg_unit {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
+  (I : (submodule R A)ˣ) : (I : submodule R A).fg :=
+begin
+  have : (1 : A) ∈ (I * ↑I⁻¹ : submodule R A),
+  { rw I.mul_inv, exact one_le.mp le_rfl },
+  obtain ⟨T, T', hT, hT', one_mem⟩ := mem_span_mul_finite_of_mem_mul this,
+  refine ⟨T, span_eq_of_le _ hT _⟩,
+  rw [← one_mul ↑I, ← mul_one (span R ↑T)],
+  conv_rhs { rw [← I.inv_mul, ← mul_assoc] },
+  refine mul_le_mul_left (le_trans _ $ mul_le_mul_right $ span_le.mpr hT'),
+  rwa [one_le, span_mul_span],
+end
+
+lemma fg_of_is_unit {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
+  {I : submodule R A} (hI : is_unit I) : I.fg := fg_unit hI.unit
+
+theorem fg_span {s : set M} (hs : s.finite) : fg (span R s) :=
+⟨hs.to_finset, by rw [hs.coe_to_finset]⟩
+
+theorem fg_span_singleton (x : M) : fg (R ∙ x) :=
+fg_span (finite_singleton x)
+
+theorem fg.sup {N₁ N₂ : submodule R M}
+  (hN₁ : N₁.fg) (hN₂ : N₂.fg) : (N₁ ⊔ N₂).fg :=
+let ⟨t₁, ht₁⟩ := fg_def.1 hN₁, ⟨t₂, ht₂⟩ := fg_def.1 hN₂ in
+fg_def.2 ⟨t₁ ∪ t₂, ht₁.1.union ht₂.1, by rw [span_union, ht₁.2, ht₂.2]⟩
+
+lemma fg_finset_sup {ι : Type*} (s : finset ι) (N : ι → submodule R M) (h : ∀ i ∈ s, (N i).fg) :
+  (s.sup N).fg :=
+finset.sup_induction fg_bot (λ a ha b hb, ha.sup hb) h
+
+lemma fg_bsupr {ι : Type*} (s : finset ι) (N : ι → submodule R M) (h : ∀ i ∈ s, (N i).fg) :
+  (⨆ i ∈ s, N i).fg :=
+by simpa only [finset.sup_eq_supr] using fg_finset_sup s N h
+
+lemma fg_supr {ι : Type*} [finite ι] (N : ι → submodule R M) (h : ∀ i, (N i).fg) :
+  (supr N).fg :=
+by { casesI nonempty_fintype ι, simpa using fg_bsupr finset.univ N (λ i hi, h i) }
+
+variables {P : Type*} [add_comm_monoid P] [module R P]
+variables (f : M →ₗ[R] P)
+
+theorem fg.map {N : submodule R M} (hs : N.fg) : (N.map f).fg :=
+let ⟨t, ht⟩ := fg_def.1 hs in fg_def.2 ⟨f '' t, ht.1.image _, by rw [span_image, ht.2]⟩
+
+variables {f}
+
+lemma fg_of_fg_map_injective (f : M →ₗ[R] P) (hf : function.injective f) {N : submodule R M}
+  (hfn : (N.map f).fg) : N.fg :=
+let ⟨t, ht⟩ := hfn in ⟨t.preimage f $ λ x _ y _ h, hf h,
+submodule.map_injective_of_injective hf $ by { rw [f.map_span, finset.coe_preimage,
+    set.image_preimage_eq_inter_range, set.inter_eq_self_of_subset_left, ht],
+  rw [← linear_map.range_coe, ← span_le, ht, ← map_top], exact map_mono le_top }⟩
+
+lemma fg_of_fg_map {R M P : Type*} [ring R] [add_comm_group M] [module R M]
+  [add_comm_group P] [module R P] (f : M →ₗ[R] P) (hf : f.ker = ⊥) {N : submodule R M}
+  (hfn : (N.map f).fg) : N.fg :=
+fg_of_fg_map_injective f (linear_map.ker_eq_bot.1 hf) hfn
+
+lemma fg_top (N : submodule R M) : (⊤ : submodule R N).fg ↔ N.fg :=
+⟨λ h, N.range_subtype ▸ map_top N.subtype ▸ h.map _,
+λ h, fg_of_fg_map_injective N.subtype subtype.val_injective $ by rwa [map_top, range_subtype]⟩
+
+lemma fg_of_linear_equiv (e : M ≃ₗ[R] P) (h : (⊤ : submodule R P).fg) :
+  (⊤ : submodule R M).fg :=
+e.symm.range ▸ map_top (e.symm : P →ₗ[R] M) ▸ h.map _
+
+theorem fg.prod {sb : submodule R M} {sc : submodule R P}
+  (hsb : sb.fg) (hsc : sc.fg) : (sb.prod sc).fg :=
+let ⟨tb, htb⟩ := fg_def.1 hsb, ⟨tc, htc⟩ := fg_def.1 hsc in
+fg_def.2 ⟨linear_map.inl R M P '' tb ∪ linear_map.inr R M P '' tc,
+  (htb.1.image _).union (htc.1.image _),
+  by rw [linear_map.span_inl_union_inr, htb.2, htc.2]⟩
+
+theorem fg_pi {ι : Type*} {M : ι → Type*} [finite ι] [Π i, add_comm_monoid (M i)]
+  [Π i, module R (M i)] {p : Π i, submodule R (M i)} (hsb : ∀ i, (p i).fg) :
+  (submodule.pi set.univ p).fg :=
+begin
+  classical,
+  simp_rw fg_def at hsb ⊢,
+  choose t htf hts using hsb,
+  refine ⟨
+    ⋃ i, (linear_map.single i : _ →ₗ[R] _) '' t i, set.finite_Union $ λ i, (htf i).image _, _⟩,
+  simp_rw [span_Union, span_image, hts, submodule.supr_map_single],
+end
+
+/-- If 0 → M' → M → M'' → 0 is exact and M' and M'' are
+finitely generated then so is M. -/
+theorem fg_of_fg_map_of_fg_inf_ker {R M P : Type*} [ring R] [add_comm_group M] [module R M]
+  [add_comm_group P] [module R P] (f : M →ₗ[R] P)
+  {s : submodule R M} (hs1 : (s.map f).fg) (hs2 : (s ⊓ f.ker).fg) : s.fg :=
+begin
+  haveI := classical.dec_eq R, haveI := classical.dec_eq M, haveI := classical.dec_eq P,
+  cases hs1 with t1 ht1, cases hs2 with t2 ht2,
+  have : ∀ y ∈ t1, ∃ x ∈ s, f x = y,
+  { intros y hy,
+    have : y ∈ map f s, { rw ← ht1, exact subset_span hy },
+    rcases mem_map.1 this with ⟨x, hx1, hx2⟩,
+    exact ⟨x, hx1, hx2⟩ },
+  have : ∃ g : P → M, ∀ y ∈ t1, g y ∈ s ∧ f (g y) = y,
+  { choose g hg1 hg2,
+    existsi λ y, if H : y ∈ t1 then g y H else 0,
+    intros y H, split,
+    { simp only [dif_pos H], apply hg1 },
+    { simp only [dif_pos H], apply hg2 } },
+  cases this with g hg, clear this,
+  existsi t1.image g ∪ t2,
+  rw [finset.coe_union, span_union, finset.coe_image],
+  apply le_antisymm,
+  { refine sup_le (span_le.2 $ image_subset_iff.2 _) (span_le.2 _),
+    { intros y hy, exact (hg y hy).1 },
+    { intros x hx, have := subset_span hx,
+      rw ht2 at this,
+      exact this.1 } },
+  intros x hx,
+  have : f x ∈ map f s, { rw mem_map, exact ⟨x, hx, rfl⟩ },
+  rw [← ht1,← set.image_id ↑t1, finsupp.mem_span_image_iff_total] at this,
+  rcases this with ⟨l, hl1, hl2⟩,
+  refine mem_sup.2 ⟨(finsupp.total M M R id).to_fun
+    ((finsupp.lmap_domain R R g : (P →₀ R) → M →₀ R) l), _,
+    x - finsupp.total M M R id ((finsupp.lmap_domain R R g : (P →₀ R) → M →₀ R) l),
+    _, add_sub_cancel'_right _ _⟩,
+  { rw [← set.image_id (g '' ↑t1), finsupp.mem_span_image_iff_total], refine ⟨_, _, rfl⟩,
+    haveI : inhabited P := ⟨0⟩,
+    rw [← finsupp.lmap_domain_supported _ _ g, mem_map],
+    refine ⟨l, hl1, _⟩,
+    refl, },
+  rw [ht2, mem_inf], split,
+  { apply s.sub_mem hx,
+    rw [finsupp.total_apply, finsupp.lmap_domain_apply, finsupp.sum_map_domain_index],
+    refine s.sum_mem _,
+    { intros y hy, exact s.smul_mem _ (hg y (hl1 hy)).1 },
+    { exact zero_smul _ }, { exact λ _ _ _, add_smul _ _ _ } },
+  { rw [linear_map.mem_ker, f.map_sub, ← hl2],
+    rw [finsupp.total_apply, finsupp.total_apply, finsupp.lmap_domain_apply],
+    rw [finsupp.sum_map_domain_index, finsupp.sum, finsupp.sum, f.map_sum],
+    rw sub_eq_zero,
+    refine finset.sum_congr rfl (λ y hy, _),
+    unfold id,
+    rw [f.map_smul, (hg y (hl1 hy)).2],
+    { exact zero_smul _ }, { exact λ _ _ _, add_smul _ _ _ } }
+end
+
+lemma fg_induction (R M : Type*) [semiring R] [add_comm_monoid M] [module R M]
+  (P : submodule R M → Prop)
+  (h₁ : ∀ x, P (submodule.span R {x})) (h₂ : ∀ M₁ M₂, P M₁ → P M₂ → P (M₁ ⊔ M₂))
+  (N : submodule R M) (hN : N.fg) : P N :=
+begin
+  classical,
+  obtain ⟨s, rfl⟩ := hN,
+  induction s using finset.induction,
+  { rw [finset.coe_empty, submodule.span_empty, ← submodule.span_zero_singleton], apply h₁ },
+  { rw [finset.coe_insert, submodule.span_insert], apply h₂; apply_assumption }
+end
+
+/-- The kernel of the composition of two linear maps is finitely generated if both kernels are and
+the first morphism is surjective. -/
+lemma fg_ker_comp {R M N P : Type*} [ring R] [add_comm_group M] [module R M]
+  [add_comm_group N] [module R N] [add_comm_group P] [module R P] (f : M →ₗ[R] N)
+  (g : N →ₗ[R] P) (hf1 : f.ker.fg) (hf2 : g.ker.fg) (hsur : function.surjective f) :
+  (g.comp f).ker.fg :=
+begin
+  rw linear_map.ker_comp,
+  apply fg_of_fg_map_of_fg_inf_ker f,
+  { rwa [submodule.map_comap_eq, linear_map.range_eq_top.2 hsur, top_inf_eq] },
+  { rwa [inf_of_le_right (show f.ker ≤ (comap f g.ker), from comap_mono bot_le)] }
+end
+
+lemma fg_restrict_scalars {R S M : Type*} [comm_semiring R] [semiring S] [algebra R S]
+  [add_comm_group M] [module S M] [module R M] [is_scalar_tower R S M] (N : submodule S M)
+  (hfin : N.fg) (h : function.surjective (algebra_map R S)) : (submodule.restrict_scalars R N).fg :=
+begin
+  obtain ⟨X, rfl⟩ := hfin,
+  use X,
+  exact (submodule.restrict_scalars_span R S h ↑X).symm
+end
+
+lemma fg.stablizes_of_supr_eq {M' : submodule R M} (hM' : M'.fg)
+  (N : ℕ →o submodule R M) (H : supr N = M') : ∃ n, M' = N n :=
+begin
+  obtain ⟨S, hS⟩ := hM',
+  have : ∀ s : S, ∃ n, (s : M) ∈ N n :=
+    λ s, (submodule.mem_supr_of_chain N s).mp
+      (by { rw [H, ← hS], exact submodule.subset_span s.2 }),
+  choose f hf,
+  use S.attach.sup f,
+  apply le_antisymm,
+  { conv_lhs { rw ← hS },
+    rw submodule.span_le,
+    intros s hs,
+    exact N.2 (finset.le_sup $ S.mem_attach ⟨s, hs⟩) (hf _) },
+  { rw ← H, exact le_supr _ _ }
+end
+
+/-- Finitely generated submodules are precisely compact elements in the submodule lattice. -/
+theorem fg_iff_compact (s : submodule R M) : s.fg ↔ complete_lattice.is_compact_element s :=
+begin
+  classical,
+  -- Introduce shorthand for span of an element
+  let sp : M → submodule R M := λ a, span R {a},
+  -- Trivial rewrite lemma; a small hack since simp (only) & rw can't accomplish this smoothly.
+  have supr_rw : ∀ t : finset M, (⨆ x ∈ t, sp x) = (⨆ x ∈ (↑t : set M), sp x), from λ t, by refl,
+  split,
+  { rintro ⟨t, rfl⟩,
+    rw [span_eq_supr_of_singleton_spans, ←supr_rw, ←(finset.sup_eq_supr t sp)],
+    apply complete_lattice.finset_sup_compact_of_compact,
+    exact λ n _, singleton_span_is_compact_element n, },
+  { intro h,
+    -- s is the Sup of the spans of its elements.
+    have sSup : s = Sup (sp '' ↑s),
+    by rw [Sup_eq_supr, supr_image, ←span_eq_supr_of_singleton_spans, eq_comm, span_eq],
+    -- by h, s is then below (and equal to) the sup of the spans of finitely many elements.
+    obtain ⟨u, ⟨huspan, husup⟩⟩ := h (sp '' ↑s) (le_of_eq sSup),
+    have ssup : s = u.sup id,
+    { suffices : u.sup id ≤ s, from le_antisymm husup this,
+      rw [sSup, finset.sup_id_eq_Sup], exact Sup_le_Sup huspan, },
+    obtain ⟨t, ⟨hts, rfl⟩⟩ := finset.subset_image_iff.mp huspan,
+    rw [finset.sup_image, function.comp.left_id, finset.sup_eq_supr, supr_rw,
+      ←span_eq_supr_of_singleton_spans, eq_comm] at ssup,
+    exact ⟨t, ssup⟩, },
+end
+
+end submodule
+
+namespace submodule
+
+section map₂
+variables {R M N P : Type*}
+variables [comm_semiring R] [add_comm_monoid M] [add_comm_monoid N] [add_comm_monoid P]
+variables [module R M] [module R N] [module R P]
+
+theorem fg.map₂ (f : M →ₗ[R] N →ₗ[R] P) {p : submodule R M} {q : submodule R N}
+  (hp : p.fg) (hq : q.fg) : (map₂ f p q).fg :=
+let ⟨sm, hfm, hm⟩ := fg_def.1 hp, ⟨sn, hfn, hn⟩ := fg_def.1 hq in
+fg_def.2 ⟨set.image2 (λ m n, f m n) sm sn,
+  hfm.image2 _ hfn, map₂_span_span R f sm sn ▸ hm ▸ hn ▸ rfl⟩
+
+end map₂
+
+section mul
+variables {R : Type*} {A : Type*} [comm_semiring R] [semiring A] [algebra R A]
+variables {M N : submodule R A}
+
+theorem fg.mul (hm : M.fg) (hn : N.fg) : (M * N).fg := hm.map₂ _ hn
+
+lemma fg.pow (h : M.fg) (n : ℕ) : (M ^ n).fg :=
+nat.rec_on n
+  (⟨{1}, by simp [one_eq_span]⟩)
+  (λ n ih, by simpa [pow_succ] using h.mul ih)
+
+end mul
+
+end submodule
+
+namespace ideal
+
+variables {R : Type*} {M : Type*} [semiring R] [add_comm_monoid M] [module R M]
+
+/-- An ideal of `R` is finitely generated if it is the span of a finite subset of `R`.
+
+This is defeq to `submodule.fg`, but unfolds more nicely. -/
+def fg (I : ideal R) : Prop := ∃ S : finset R, ideal.span ↑S = I
+
+/-- The image of a finitely generated ideal is finitely generated.
+
+This is the `ideal` version of `submodule.fg.map`. -/
+lemma fg.map {R S : Type*} [semiring R] [semiring S] {I : ideal R} (h : I.fg)
+  (f : R →+* S) : (I.map f).fg :=
+begin
+  classical,
+  obtain ⟨s, hs⟩ := h,
+  refine ⟨s.image f, _⟩,
+  rw [finset.coe_image, ←ideal.map_span, hs],
+end
+
+lemma fg_ker_comp {R S A : Type*} [comm_ring R] [comm_ring S] [comm_ring A]
+  (f : R →+* S) (g : S →+* A) (hf : f.ker.fg) (hg : g.ker.fg) (hsur : function.surjective f) :
+  (g.comp f).ker.fg :=
+begin
+  letI : algebra R S := ring_hom.to_algebra f,
+  letI : algebra R A := ring_hom.to_algebra (g.comp f),
+  letI : algebra S A := ring_hom.to_algebra g,
+  letI : is_scalar_tower R S A := is_scalar_tower.of_algebra_map_eq (λ _, rfl),
+  let f₁ := algebra.linear_map R S,
+  let g₁ := (is_scalar_tower.to_alg_hom R S A).to_linear_map,
+  exact submodule.fg_ker_comp f₁ g₁ hf (submodule.fg_restrict_scalars g.ker hg hsur) hsur
+end
+
+lemma exists_radical_pow_le_of_fg {R : Type*} [comm_semiring R] (I : ideal R) (h : I.radical.fg) :
+  ∃ n : ℕ, I.radical ^ n ≤ I :=
+begin
+  have := le_refl I.radical, revert this,
+  refine submodule.fg_induction _ _ (λ J, J ≤ I.radical → ∃ n : ℕ, J ^ n ≤ I) _ _ _ h,
+  { intros x hx, obtain ⟨n, hn⟩ := hx (subset_span (set.mem_singleton x)),
+    exact ⟨n, by rwa [← ideal.span, span_singleton_pow, span_le, set.singleton_subset_iff]⟩ },
+  { intros J K hJ hK hJK,
+    obtain ⟨n, hn⟩ := hJ (λ x hx, hJK $ ideal.mem_sup_left hx),
+    obtain ⟨m, hm⟩ := hK (λ x hx, hJK $ ideal.mem_sup_right hx),
+    use n + m,
+    rw [← ideal.add_eq_sup, add_pow, ideal.sum_eq_sup, finset.sup_le_iff],
+    refine λ i hi, ideal.mul_le_right.trans _,
+    obtain h | h := le_or_lt n i,
+    { exact ideal.mul_le_right.trans ((ideal.pow_le_pow h).trans hn) },
+    { refine ideal.mul_le_left.trans ((ideal.pow_le_pow _).trans hm),
+      rw [add_comm, nat.add_sub_assoc h.le], apply nat.le_add_right } },
+end
+
+end ideal
 
 section module_and_algebra
 
@@ -36,17 +445,6 @@ variables (R A B M N : Type*)
 class module.finite [semiring R] [add_comm_monoid M] [module R M] :
   Prop := (out : (⊤ : submodule R M).fg)
 
-/-- An algebra over a commutative semiring is of `finite_type` if it is finitely generated
-over the base ring as algebra. -/
-class algebra.finite_type [comm_semiring R] [semiring A] [algebra R A] : Prop :=
-(out : (⊤ : subalgebra R A).fg)
-
-/-- An algebra over a commutative semiring is `finite_presentation` if it is the quotient of a
-polynomial ring in `n` variables by a finitely generated ideal. -/
-def algebra.finite_presentation [comm_semiring R] [semiring A] [algebra R A] : Prop :=
-∃ (n : ℕ) (f : mv_polynomial (fin n) R →ₐ[R] A),
-  surjective f ∧ f.to_ring_hom.ker.fg
-
 namespace module
 
 variables [semiring R] [add_comm_monoid M] [module R M] [add_comm_monoid N] [module R N]
@@ -54,10 +452,6 @@ variables [semiring R] [add_comm_monoid M] [module R M] [add_comm_monoid N] [mod
 lemma finite_def {R M} [semiring R] [add_comm_monoid M] [module R M] :
   finite R M ↔ (⊤ : submodule R M).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩
 
-@[priority 100] -- see Note [lower instance priority]
-instance is_noetherian.finite [is_noetherian R M] : finite R M :=
-⟨is_noetherian.noetherian ⊤⟩
-
 namespace finite
 open _root_.submodule set
 
@@ -81,9 +475,13 @@ lemma of_surjective [hM : finite R M] (f : M →ₗ[R] N) (hf : surjective f) :
   exact hM.1.map f
 end⟩
 
-lemma of_injective [is_noetherian R N] (f : M →ₗ[R] N)
-  (hf : function.injective f) : finite R M :=
-⟨fg_of_injective f hf⟩
+/-- The range of a linear map from a finite module is finite. -/
+instance range [finite R M] (f : M →ₗ[R] N) : finite R f.range :=
+of_surjective f.range_restrict $ λ ⟨x, y, hy⟩, ⟨y, subtype.ext hy⟩
+
+/-- Pushforwards of finite submodules are finite. -/
+instance map (p : submodule R M) [finite R p] (f : M →ₗ[R] N) : finite R (p.map f) :=
+of_surjective (f.restrict $ λ _, mem_map_of_mem) $ λ ⟨x, y, hy, hy'⟩, ⟨⟨_, hy⟩, subtype.ext hy'⟩
 
 variables (R)
 
@@ -112,7 +510,7 @@ instance prod [hM : finite R M] [hN : finite R N] : finite R (M × N) :=
   exact hM.1.prod hN.1
 end⟩
 
-instance pi {ι : Type*} {M : ι → Type*} [fintype ι] [Π i, add_comm_monoid (M i)]
+instance pi {ι : Type*} {M : ι → Type*} [_root_.finite ι] [Π i, add_comm_monoid (M i)]
   [Π i, module R (M i)] [h : ∀ i, finite R (M i)] : finite R (Π i, M i) :=
 ⟨begin
   rw ← submodule.pi_top,
@@ -124,281 +522,43 @@ of_surjective (e : M →ₗ[R] N) e.surjective
 
 section algebra
 
-lemma trans {R : Type*} (A B : Type*) [comm_semiring R] [comm_semiring A] [algebra R A]
-  [semiring B] [algebra R B] [algebra A B] [is_scalar_tower R A B] :
-  ∀ [finite R A] [finite A B], finite R B
+lemma trans {R : Type*} (A M : Type*) [comm_semiring R] [semiring A] [algebra R A]
+  [add_comm_monoid M] [module R M] [module A M] [is_scalar_tower R A M] :
+  ∀ [finite R A] [finite A M], finite R M
 | ⟨⟨s, hs⟩⟩ ⟨⟨t, ht⟩⟩ := ⟨submodule.fg_def.2
-  ⟨set.image2 (•) (↑s : set A) (↑t : set B),
+  ⟨set.image2 (•) (↑s : set A) (↑t : set M),
     set.finite.image2 _ s.finite_to_set t.finite_to_set,
-    by rw [set.image2_smul, submodule.span_smul hs (↑t : set B),
+    by rw [set.image2_smul, submodule.span_smul_of_span_eq_top hs (↑t : set M),
       ht, submodule.restrict_scalars_top]⟩⟩
 
-@[priority 100] -- see Note [lower instance priority]
-instance finite_type {R : Type*} (A : Type*) [comm_semiring R] [semiring A]
-  [algebra R A] [hRA : finite R A] : algebra.finite_type R A :=
-⟨subalgebra.fg_of_submodule_fg hRA.1⟩
-
 end algebra
 
 end finite
 
 end module
 
-namespace algebra
-
-variables [comm_ring R] [comm_ring A] [algebra R A] [comm_ring B] [algebra R B]
-variables [add_comm_group M] [module R M]
-variables [add_comm_group N] [module R N]
-
-namespace finite_type
-
-lemma self : finite_type R R := ⟨⟨{1}, subsingleton.elim _ _⟩⟩
-
-section
-open_locale classical
-
-protected lemma mv_polynomial (ι : Type*) [fintype ι] : finite_type R (mv_polynomial ι R) :=
-⟨⟨finset.univ.image mv_polynomial.X, begin
-  rw eq_top_iff, refine λ p, mv_polynomial.induction_on' p
-    (λ u x, finsupp.induction u (subalgebra.algebra_map_mem _ x)
-      (λ i n f hif hn ih, _))
-    (λ p q ihp ihq, subalgebra.add_mem _ ihp ihq),
-  rw [add_comm, mv_polynomial.monomial_add_single],
-  exact subalgebra.mul_mem _ ih
-    (subalgebra.pow_mem _ (subset_adjoin $ finset.mem_image_of_mem _ $ finset.mem_univ _) _)
-end⟩⟩
-end
-
-lemma of_restrict_scalars_finite_type [algebra A B] [is_scalar_tower R A B] [hB : finite_type R B] :
-  finite_type A B :=
+instance module.finite.base_change [comm_semiring R] [semiring A] [algebra R A]
+  [add_comm_monoid M] [module R M] [h : module.finite R M] :
+  module.finite A (tensor_product R A M) :=
 begin
-  obtain ⟨S, hS⟩ := hB.out,
-  refine ⟨⟨S, eq_top_iff.2 (λ b, _)⟩⟩,
-  have le : adjoin R (S : set B) ≤ subalgebra.restrict_scalars R (adjoin A S),
-  { apply (algebra.adjoin_le _ : _ ≤ (subalgebra.restrict_scalars R (adjoin A ↑S))),
-    simp only [subalgebra.coe_restrict_scalars],
-    exact algebra.subset_adjoin, },
-  exact le (eq_top_iff.1 hS b),
-end
-
-variables {R A B}
-
-lemma of_surjective (hRA : finite_type R A) (f : A →ₐ[R] B) (hf : surjective f) :
-  finite_type R B :=
-⟨begin
-  convert hRA.1.map f,
-  simpa only [map_top f, @eq_comm _ ⊤, eq_top_iff, alg_hom.mem_range] using hf
-end⟩
-
-lemma equiv (hRA : finite_type R A) (e : A ≃ₐ[R] B) : finite_type R B :=
-hRA.of_surjective e e.surjective
-
-lemma trans [algebra A B] [is_scalar_tower R A B] (hRA : finite_type R A) (hAB : finite_type A B) :
-  finite_type R B :=
-⟨fg_trans' hRA.1 hAB.1⟩
-
-/-- An algebra is finitely generated if and only if it is a quotient
-of a polynomial ring whose variables are indexed by a finset. -/
-lemma iff_quotient_mv_polynomial : (finite_type R A) ↔ ∃ (s : finset A)
-  (f : (mv_polynomial {x // x ∈ s} R) →ₐ[R] A), (surjective f) :=
-begin
-  split,
-  { rintro ⟨s, hs⟩,
-    use [s, mv_polynomial.aeval coe],
-    intro x,
-    have hrw : (↑s : set A) = (λ (x : A), x ∈ s.val) := rfl,
-    rw [← set.mem_range, ← alg_hom.coe_range, ← adjoin_eq_range, ← hrw, hs],
-    exact set.mem_univ x },
-  { rintro ⟨s, ⟨f, hsur⟩⟩,
-    exact finite_type.of_surjective (finite_type.mv_polynomial R {x // x ∈ s}) f hsur }
-end
-
-/-- An algebra is finitely generated if and only if it is a quotient
-of a polynomial ring whose variables are indexed by a fintype. -/
-lemma iff_quotient_mv_polynomial' : (finite_type R A) ↔ ∃ (ι : Type u_2) (_ : fintype ι)
-  (f : (mv_polynomial ι R) →ₐ[R] A), (surjective f) :=
-begin
-  split,
-  { rw iff_quotient_mv_polynomial,
-    rintro ⟨s, ⟨f, hsur⟩⟩,
-    use [{x // x ∈ s}, by apply_instance, f, hsur] },
-  { rintro ⟨ι, ⟨hfintype, ⟨f, hsur⟩⟩⟩,
-    letI : fintype ι := hfintype,
-    exact finite_type.of_surjective (finite_type.mv_polynomial R ι) f hsur }
-end
-
-/-- An algebra is finitely generated if and only if it is a quotient of a polynomial ring in `n`
-variables. -/
-lemma iff_quotient_mv_polynomial'' : (finite_type R A) ↔ ∃ (n : ℕ)
-  (f : (mv_polynomial (fin n) R) →ₐ[R] A), (surjective f) :=
-begin
-  split,
-  { rw iff_quotient_mv_polynomial',
-    rintro ⟨ι, hfintype, ⟨f, hsur⟩⟩,
-    letI := hfintype,
-    obtain ⟨equiv⟩ := @fintype.trunc_equiv_fin ι (classical.dec_eq ι) hfintype,
-    replace equiv := mv_polynomial.rename_equiv R equiv,
-    exact ⟨fintype.card ι, alg_hom.comp f equiv.symm, function.surjective.comp hsur
-      (alg_equiv.symm equiv).surjective⟩ },
-  { rintro ⟨n, ⟨f, hsur⟩⟩,
-    exact finite_type.of_surjective (finite_type.mv_polynomial R (fin n)) f hsur }
-end
-
-/-- A finitely presented algebra is of finite type. -/
-lemma of_finite_presentation : finite_presentation R A → finite_type R A :=
-begin
-  rintro ⟨n, f, hf⟩,
-  apply (finite_type.iff_quotient_mv_polynomial'').2,
-  exact ⟨n, f, hf.1⟩
-end
-
-instance prod [hA : finite_type R A] [hB : finite_type R B] : finite_type R (A × B) :=
-⟨begin
-  rw ← subalgebra.prod_top,
-  exact hA.1.prod hB.1
-end⟩
-
-end finite_type
-
-namespace finite_presentation
-
-variables {R A B}
-
-/-- An algebra over a Noetherian ring is finitely generated if and only if it is finitely
-presented. -/
-lemma of_finite_type [is_noetherian_ring R] : finite_type R A ↔ finite_presentation R A :=
-begin
-  refine ⟨λ h, _, algebra.finite_type.of_finite_presentation⟩,
-  obtain ⟨n, f, hf⟩ := algebra.finite_type.iff_quotient_mv_polynomial''.1 h,
-  refine ⟨n, f, hf, _⟩,
-  have hnoet : is_noetherian_ring (mv_polynomial (fin n) R) := by apply_instance,
-  replace hnoet := (is_noetherian_ring_iff.1 hnoet).noetherian,
-  exact hnoet f.to_ring_hom.ker,
-end
-
-/-- If `e : A ≃ₐ[R] B` and `A` is finitely presented, then so is `B`. -/
-lemma equiv (hfp : finite_presentation R A) (e : A ≃ₐ[R] B) : finite_presentation R B :=
-begin
-  obtain ⟨n, f, hf⟩ := hfp,
-  use [n, alg_hom.comp ↑e f],
-  split,
-  { exact function.surjective.comp e.surjective hf.1 },
-  suffices hker : (alg_hom.comp ↑e f).to_ring_hom.ker = f.to_ring_hom.ker,
-  { rw hker, exact hf.2 },
-  { have hco : (alg_hom.comp ↑e f).to_ring_hom = ring_hom.comp ↑e.to_ring_equiv f.to_ring_hom,
-    { have h : (alg_hom.comp ↑e f).to_ring_hom = e.to_alg_hom.to_ring_hom.comp f.to_ring_hom := rfl,
-      have h1 : ↑(e.to_ring_equiv) = (e.to_alg_hom).to_ring_hom := rfl,
-      rw [h, h1] },
-    rw [ring_hom.ker_eq_comap_bot, hco, ← ideal.comap_comap, ← ring_hom.ker_eq_comap_bot,
-      ring_hom.ker_coe_equiv (alg_equiv.to_ring_equiv e), ring_hom.ker_eq_comap_bot] }
-end
-
-variable (R)
-
-/-- The ring of polynomials in finitely many variables is finitely presented. -/
-protected lemma mv_polynomial (ι : Type u_2) [fintype ι] :
-  finite_presentation R (mv_polynomial ι R) :=
-begin
-  obtain ⟨equiv⟩ := @fintype.trunc_equiv_fin ι (classical.dec_eq ι) _,
-  replace equiv := mv_polynomial.rename_equiv R equiv,
-  refine ⟨_, alg_equiv.to_alg_hom equiv.symm, _⟩,
-  split,
-  { exact (alg_equiv.symm equiv).surjective },
-  suffices hinj : function.injective equiv.symm.to_alg_hom.to_ring_hom,
-  { rw [(ring_hom.injective_iff_ker_eq_bot _).1 hinj],
-    exact submodule.fg_bot },
-  exact (alg_equiv.symm equiv).injective
-end
-
-/-- `R` is finitely presented as `R`-algebra. -/
-lemma self : finite_presentation R R :=
-equiv (finite_presentation.mv_polynomial R pempty) (mv_polynomial.is_empty_alg_equiv R pempty)
-
-variable {R}
-
-/-- The quotient of a finitely presented algebra by a finitely generated ideal is finitely
-presented. -/
-protected lemma quotient {I : ideal A} (h : I.fg) (hfp : finite_presentation R A) :
-  finite_presentation R (A ⧸ I) :=
-begin
-  obtain ⟨n, f, hf⟩ := hfp,
-  refine ⟨n, (ideal.quotient.mkₐ R I).comp f, _, _⟩,
-  { exact (ideal.quotient.mkₐ_surjective R I).comp hf.1 },
-  { refine ideal.fg_ker_comp _ _ hf.2 _ hf.1,
-    simp [h] }
-end
-
-/-- If `f : A →ₐ[R] B` is surjective with finitely generated kernel and `A` is finitely presented,
-then so is `B`. -/
-lemma of_surjective {f : A →ₐ[R] B} (hf : function.surjective f) (hker : f.to_ring_hom.ker.fg)
-  (hfp : finite_presentation R A) : finite_presentation R B :=
-equiv (hfp.quotient hker) (ideal.quotient_ker_alg_equiv_of_surjective hf)
-
-lemma iff : finite_presentation R A ↔
-  ∃ n (I : ideal (mv_polynomial (fin n) R)) (e : (_ ⧸ I) ≃ₐ[R] A), I.fg :=
-begin
-  split,
-  { rintros ⟨n, f, hf⟩,
-    exact ⟨n, f.to_ring_hom.ker, ideal.quotient_ker_alg_equiv_of_surjective hf.1, hf.2⟩ },
-  { rintros ⟨n, I, e, hfg⟩,
-    exact equiv ((finite_presentation.mv_polynomial R _).quotient hfg) e }
-end
-
-/-- An algebra is finitely presented if and only if it is a quotient of a polynomial ring whose
-variables are indexed by a fintype by a finitely generated ideal. -/
-lemma iff_quotient_mv_polynomial' : finite_presentation R A ↔ ∃ (ι : Type u_2) (_ : fintype ι)
-  (f : mv_polynomial ι R →ₐ[R] A), surjective f ∧ f.to_ring_hom.ker.fg :=
-begin
-  split,
-  { rintro ⟨n, f, hfs, hfk⟩,
-    set ulift_var := mv_polynomial.rename_equiv R equiv.ulift,
-    refine ⟨ulift (fin n), infer_instance, f.comp ulift_var.to_alg_hom,
-      hfs.comp ulift_var.surjective,
-      ideal.fg_ker_comp _ _ _ hfk ulift_var.surjective⟩,
-    convert submodule.fg_bot,
-    exact ring_hom.ker_coe_equiv ulift_var.to_ring_equiv, },
-  { rintro ⟨ι, hfintype, f, hf⟩,
-    haveI : fintype ι := hfintype,
-    obtain ⟨equiv⟩ := @fintype.trunc_equiv_fin ι (classical.dec_eq ι) _,
-    replace equiv := mv_polynomial.rename_equiv R equiv,
-    refine ⟨fintype.card ι, f.comp equiv.symm,
-      hf.1.comp (alg_equiv.symm equiv).surjective,
-      ideal.fg_ker_comp _ f _ hf.2 equiv.symm.surjective⟩,
-    convert submodule.fg_bot,
-    exact ring_hom.ker_coe_equiv (equiv.symm.to_ring_equiv), }
-end
-
-/-- If `A` is a finitely presented `R`-algebra, then `mv_polynomial (fin n) A` is finitely presented
-as `R`-algebra. -/
-lemma mv_polynomial_of_finite_presentation (hfp : finite_presentation R A) (ι : Type*)
-  [fintype ι] : finite_presentation R (mv_polynomial ι A) :=
-begin
-  rw iff_quotient_mv_polynomial' at hfp ⊢,
   classical,
-  obtain ⟨ι', _, f, hf_surj, hf_ker⟩ := hfp,
-  resetI,
-  let g := (mv_polynomial.map_alg_hom f).comp (mv_polynomial.sum_alg_equiv R ι ι').to_alg_hom,
-  refine ⟨ι ⊕ ι', by apply_instance, g,
-    (mv_polynomial.map_surjective f.to_ring_hom hf_surj).comp (alg_equiv.surjective _),
-    ideal.fg_ker_comp _ _ _ _ (alg_equiv.surjective _)⟩,
-  { convert submodule.fg_bot,
-    exact ring_hom.ker_coe_equiv (mv_polynomial.sum_alg_equiv R ι ι').to_ring_equiv },
-  { rw [alg_hom.to_ring_hom_eq_coe, mv_polynomial.map_alg_hom_coe_ring_hom, mv_polynomial.ker_map],
-    exact hf_ker.map mv_polynomial.C, }
-end
-
-/-- If `A` is an `R`-algebra and `S` is an `A`-algebra, both finitely presented, then `S` is
-  finitely presented as `R`-algebra. -/
-lemma trans [algebra A B] [is_scalar_tower R A B] (hfpA : finite_presentation R A)
-  (hfpB : finite_presentation A B) : finite_presentation R B :=
-begin
-  obtain ⟨n, I, e, hfg⟩ := iff.1 hfpB,
-  exact equiv ((mv_polynomial_of_finite_presentation hfpA _).quotient hfg) (e.restrict_scalars R)
-end
-
-end finite_presentation
-
-end algebra
+  obtain ⟨s, hs⟩ := h.out,
+  refine ⟨⟨s.image (tensor_product.mk R A M 1), eq_top_iff.mpr $ λ x _, _⟩⟩,
+  apply tensor_product.induction_on x,
+  { exact zero_mem _ },
+  { intros x y,
+    rw [finset.coe_image, ← submodule.span_span_of_tower R, submodule.span_image, hs,
+      submodule.map_top, linear_map.range_coe],
+      change _ ∈ submodule.span A (set.range $ tensor_product.mk R A M 1),
+    rw [← mul_one x, ← smul_eq_mul, ← tensor_product.smul_tmul'],
+    exact submodule.smul_mem _ x (submodule.subset_span $ set.mem_range_self y) },
+  { exact λ _ _, submodule.add_mem _ }
+end
+
+instance module.finite.tensor_product [comm_semiring R]
+  [add_comm_monoid M] [module R M] [add_comm_monoid N] [module R N]
+  [hM : module.finite R M] [hN : module.finite R N] : module.finite R (tensor_product R M N) :=
+{ out := (tensor_product.map₂_mk_top_top_eq_top R M N).subst (hM.out.map₂ _ hN.out) }
 
 end module_and_algebra
 
@@ -409,13 +569,6 @@ variables {A B C : Type*} [comm_ring A] [comm_ring B] [comm_ring C]
 def finite (f : A →+* B) : Prop :=
 by letI : algebra A B := f.to_algebra; exact module.finite A B
 
-/-- A ring morphism `A →+* B` is of `finite_type` if `B` is finitely generated as `A`-algebra. -/
-def finite_type (f : A →+* B) : Prop := @algebra.finite_type A B _ _ f.to_algebra
-
-/-- A ring morphism `A →+* B` is of `finite_presentation` if `B` is finitely presented as
-`A`-algebra. -/
-def finite_presentation (f : A →+* B) : Prop := @algebra.finite_presentation A B _ _ f.to_algebra
-
 namespace finite
 
 variables (A)
@@ -431,102 +584,27 @@ begin
 end
 
 lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite) (hf : f.finite) : (g.comp f).finite :=
-@module.finite.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
-begin
-  fconstructor,
-  intros a b c,
-  simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
-  refl
-end
-hf hg
-
-lemma finite_type {f : A →+* B} (hf : f.finite) : finite_type f :=
-@module.finite.finite_type _ _ _ _ f.to_algebra hf
-
-lemma of_comp_finite {f : A →+* B} {g : B →+* C} (h : (g.comp f).finite) : g.finite :=
 begin
   letI := f.to_algebra,
   letI := g.to_algebra,
   letI := (g.comp f).to_algebra,
   letI : is_scalar_tower A B C := restrict_scalars.is_scalar_tower A B C,
-  letI : module.finite A C := h,
-  exact module.finite.of_restrict_scalars_finite A B C
-end
-
-end finite
-
-namespace finite_type
-
-variables (A)
-
-lemma id : finite_type (ring_hom.id A) := algebra.finite_type.self A
-
-variables {A}
-
-lemma comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.finite_type) (hg : surjective g) :
-  (g.comp f).finite_type :=
-@algebra.finite_type.of_surjective A B C _ _ f.to_algebra _ (g.comp f).to_algebra hf
-{ to_fun := g, commutes' := λ a, rfl, .. g } hg
-
-lemma of_surjective (f : A →+* B) (hf : surjective f) : f.finite_type :=
-by { rw ← f.comp_id, exact (id A).comp_surjective hf }
-
-lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite_type) (hf : f.finite_type) :
-  (g.comp f).finite_type :=
-@algebra.finite_type.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
-begin
-  fconstructor,
-  intros a b c,
-  simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
-  refl
+  letI : module.finite A B := hf,
+  letI : module.finite B C := hg,
+  exact module.finite.trans B C,
 end
-hf hg
 
-lemma of_finite_presentation {f : A →+* B} (hf : f.finite_presentation) : f.finite_type :=
-@algebra.finite_type.of_finite_presentation A B _ _ f.to_algebra hf
-
-lemma of_comp_finite_type {f : A →+* B} {g : B →+* C} (h : (g.comp f).finite_type) :
-  g.finite_type :=
+lemma of_comp_finite {f : A →+* B} {g : B →+* C} (h : (g.comp f).finite) : g.finite :=
 begin
   letI := f.to_algebra,
   letI := g.to_algebra,
   letI := (g.comp f).to_algebra,
   letI : is_scalar_tower A B C := restrict_scalars.is_scalar_tower A B C,
-  letI : algebra.finite_type A C := h,
-  exact algebra.finite_type.of_restrict_scalars_finite_type A B C
+  letI : module.finite A C := h,
+  exact module.finite.of_restrict_scalars_finite A B C
 end
 
-end finite_type
-
-namespace finite_presentation
-
-variables (A)
-
-lemma id : finite_presentation (ring_hom.id A) := algebra.finite_presentation.self A
-
-variables {A}
-
-lemma comp_surjective {f : A →+* B} {g : B →+* C} (hf : f.finite_presentation) (hg : surjective g)
-  (hker : g.ker.fg) :  (g.comp f).finite_presentation :=
-@algebra.finite_presentation.of_surjective A B C _ _ f.to_algebra _ (g.comp f).to_algebra
-{ to_fun := g, commutes' := λ a, rfl, .. g } hg hker hf
-
-lemma of_surjective (f : A →+* B) (hf : surjective f) (hker : f.ker.fg) : f.finite_presentation :=
-by { rw ← f.comp_id, exact (id A).comp_surjective hf hker}
-
-lemma of_finite_type [is_noetherian_ring A] {f : A →+* B} : f.finite_type ↔ f.finite_presentation :=
-@algebra.finite_presentation.of_finite_type A B _ _ f.to_algebra _
-
-lemma comp {g : B →+* C} {f : A →+* B} (hg : g.finite_presentation) (hf : f.finite_presentation) :
-  (g.comp f).finite_presentation :=
-@algebra.finite_presentation.trans A B C _ _ f.to_algebra _ (g.comp f).to_algebra g.to_algebra
-{ smul_assoc := λ a b c, begin
-    simp only [algebra.smul_def, ring_hom.map_mul, mul_assoc],
-    refl
-  end }
-hf hg
-
-end finite_presentation
+end finite
 
 end ring_hom
 
@@ -540,14 +618,6 @@ variables [algebra R A] [algebra R B] [algebra R C]
 In other words, if `B` is finitely generated as `A`-module. -/
 def finite (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite
 
-/-- An algebra morphism `A →ₐ[R] B` is of `finite_type` if it is of finite type as ring morphism.
-In other words, if `B` is finitely generated as `A`-algebra. -/
-def finite_type (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite_type
-
-/-- An algebra morphism `A →ₐ[R] B` is of `finite_presentation` if it is of finite presentation as
-ring morphism. In other words, if `B` is finitely presented as `A`-algebra. -/
-def finite_presentation (f : A →ₐ[R] B) : Prop := f.to_ring_hom.finite_presentation
-
 namespace finite
 
 variables (R A)
@@ -562,419 +632,9 @@ ring_hom.finite.comp hg hf
 lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) : f.finite :=
 ring_hom.finite.of_surjective f hf
 
-lemma finite_type {f : A →ₐ[R] B} (hf : f.finite) : finite_type f :=
-ring_hom.finite.finite_type hf
-
 lemma of_comp_finite {f : A →ₐ[R] B} {g : B →ₐ[R] C} (h : (g.comp f).finite) : g.finite :=
 ring_hom.finite.of_comp_finite h
 
 end finite
 
-namespace finite_type
-
-variables (R A)
-
-lemma id : finite_type (alg_hom.id R A) := ring_hom.finite_type.id A
-
-variables {R A}
-
-lemma comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.finite_type) (hf : f.finite_type) :
-  (g.comp f).finite_type :=
-ring_hom.finite_type.comp hg hf
-
-lemma comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.finite_type) (hg : surjective g) :
-  (g.comp f).finite_type :=
-ring_hom.finite_type.comp_surjective hf hg
-
-lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) : f.finite_type :=
-ring_hom.finite_type.of_surjective f hf
-
-lemma of_finite_presentation {f : A →ₐ[R] B} (hf : f.finite_presentation) : f.finite_type :=
-ring_hom.finite_type.of_finite_presentation hf
-
-lemma of_comp_finite_type {f : A →ₐ[R] B} {g : B →ₐ[R] C} (h : (g.comp f).finite_type) :
-g.finite_type :=
-ring_hom.finite_type.of_comp_finite_type h
-
-end finite_type
-
-namespace finite_presentation
-
-variables (R A)
-
-lemma id : finite_presentation (alg_hom.id R A) := ring_hom.finite_presentation.id A
-
-variables {R A}
-
-lemma comp {g : B →ₐ[R] C} {f : A →ₐ[R] B} (hg : g.finite_presentation)
-  (hf : f.finite_presentation) : (g.comp f).finite_presentation :=
-ring_hom.finite_presentation.comp hg hf
-
-lemma comp_surjective {f : A →ₐ[R] B} {g : B →ₐ[R] C} (hf : f.finite_presentation)
-  (hg : surjective g) (hker : g.to_ring_hom.ker.fg) : (g.comp f).finite_presentation :=
-ring_hom.finite_presentation.comp_surjective hf hg hker
-
-lemma of_surjective (f : A →ₐ[R] B) (hf : surjective f) (hker : f.to_ring_hom.ker.fg) :
-  f.finite_presentation :=
-ring_hom.finite_presentation.of_surjective f hf hker
-
-lemma of_finite_type [is_noetherian_ring A] {f : A →ₐ[R] B} :
-  f.finite_type ↔ f.finite_presentation :=
-ring_hom.finite_presentation.of_finite_type
-
-end finite_presentation
-
 end alg_hom
-
-section monoid_algebra
-
-variables {R : Type*} {M : Type*}
-
-namespace add_monoid_algebra
-
-open algebra add_submonoid submodule
-
-section span
-
-section semiring
-
-variables [comm_semiring R] [add_monoid M]
-
-/-- An element of `add_monoid_algebra R M` is in the subalgebra generated by its support. -/
-lemma mem_adjoin_support (f : add_monoid_algebra R M) : f ∈ adjoin R (of' R M '' f.support) :=
-begin
-  suffices : span R (of' R M '' f.support) ≤ (adjoin R (of' R M '' f.support)).to_submodule,
-  { exact this (mem_span_support f) },
-  rw submodule.span_le,
-  exact subset_adjoin
-end
-
-/-- If a set `S` generates, as algebra, `add_monoid_algebra R M`, then the set of supports of
-elements of `S` generates `add_monoid_algebra R M`. -/
-lemma support_gen_of_gen {S : set (add_monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
-  algebra.adjoin R (⋃ f ∈ S, (of' R M '' (f.support : set M))) = ⊤ :=
-begin
-  refine le_antisymm le_top _,
-  rw [← hS, adjoin_le_iff],
-  intros f hf,
-  have hincl : of' R M '' f.support ⊆
-    ⋃ (g : add_monoid_algebra R M) (H : g ∈ S), of' R M '' g.support,
-  { intros s hs,
-    exact set.mem_Union₂.2 ⟨f, ⟨hf, hs⟩⟩ },
-  exact adjoin_mono hincl (mem_adjoin_support f)
-end
-
-/-- If a set `S` generates, as algebra, `add_monoid_algebra R M`, then the image of the union of
-the supports of elements of `S` generates `add_monoid_algebra R M`. -/
-lemma support_gen_of_gen' {S : set (add_monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
-  algebra.adjoin R (of' R M '' (⋃ f ∈ S, (f.support : set M))) = ⊤ :=
-begin
-  suffices : of' R M '' (⋃ f ∈ S, (f.support : set M)) = ⋃ f ∈ S, (of' R M '' (f.support : set M)),
-  { rw this,
-    exact support_gen_of_gen hS },
-  simp only [set.image_Union]
-end
-
-end semiring
-
-section ring
-
-variables [comm_ring R] [add_comm_monoid M]
-
-/-- If `add_monoid_algebra R M` is of finite type, there there is a `G : finset M` such that its
-image generates, as algera, `add_monoid_algebra R M`. -/
-lemma exists_finset_adjoin_eq_top [h : finite_type R (add_monoid_algebra R M)] :
-  ∃ G : finset M, algebra.adjoin R (of' R M '' G) = ⊤ :=
-begin
-  unfreezingI { obtain ⟨S, hS⟩ := h },
-  letI : decidable_eq M := classical.dec_eq M,
-  use finset.bUnion S (λ f, f.support),
-  have : (finset.bUnion S (λ f, f.support) : set M) = ⋃ f ∈ S, (f.support : set M),
-  { simp only [finset.set_bUnion_coe, finset.coe_bUnion] },
-  rw [this],
-  exact support_gen_of_gen' hS
-end
-
-/-- The image of an element `m : M` in `add_monoid_algebra R M` belongs the submodule generated by
-`S : set M` if and only if `m ∈ S`. -/
-lemma of'_mem_span [nontrivial R] {m : M} {S : set M} :
-  of' R M m ∈ span R (of' R M '' S) ↔ m ∈ S :=
-begin
-  refine ⟨λ h, _, λ h, submodule.subset_span $ set.mem_image_of_mem (of R M) h⟩,
-  rw [of', ← finsupp.supported_eq_span_single, finsupp.mem_supported,
-    finsupp.support_single_ne_zero (@one_ne_zero R _ (by apply_instance))] at h,
-  simpa using h
-end
-
-/--If the image of an element `m : M` in `add_monoid_algebra R M` belongs the submodule generated by
-the closure of some `S : set M` then `m ∈ closure S`. -/
-lemma mem_closure_of_mem_span_closure [nontrivial R] {m : M} {S : set M}
-  (h : of' R M m ∈ span R (submonoid.closure (of' R M '' S) : set (add_monoid_algebra R M))) :
-  m ∈ closure S :=
-begin
-  suffices : multiplicative.of_add m ∈ submonoid.closure (multiplicative.to_add ⁻¹' S),
-  { simpa [← to_submonoid_closure] },
-  rw [set.image_congr' (show ∀ x, of' R M x = of R M x, from λ x, of'_eq_of x),
-    ← monoid_hom.map_mclosure] at h,
-  simpa using of'_mem_span.1 h
-end
-
-end ring
-
-end span
-
-variables [add_comm_monoid M]
-
-/-- If a set `S` generates an additive monoid `M`, then the image of `M` generates, as algebra,
-`add_monoid_algebra R M`. -/
-lemma mv_polynomial_aeval_of_surjective_of_closure [comm_semiring R] {S : set M}
-  (hS : closure S = ⊤) : function.surjective (mv_polynomial.aeval
-  (λ (s : S), of' R M ↑s) : mv_polynomial S R → add_monoid_algebra R M) :=
-begin
-  refine λ f, induction_on f (λ m, _) _ _,
-  { have : m ∈ closure S := hS.symm ▸ mem_top _,
-    refine closure_induction this (λ m hm, _) _ _,
-    { exact ⟨mv_polynomial.X ⟨m, hm⟩, mv_polynomial.aeval_X _ _⟩ },
-    { exact ⟨1, alg_hom.map_one _⟩ },
-    { rintro m₁ m₂ ⟨P₁, hP₁⟩ ⟨P₂, hP₂⟩,
-      exact ⟨P₁ * P₂, by rw [alg_hom.map_mul, hP₁, hP₂, of_apply, of_apply, of_apply,
-        single_mul_single, one_mul]; refl⟩ } },
-  { rintro f g ⟨P, rfl⟩ ⟨Q, rfl⟩,
-    exact ⟨P + Q, alg_hom.map_add _ _ _⟩ },
-  { rintro r f ⟨P, rfl⟩,
-    exact ⟨r • P, alg_hom.map_smul _ _ _⟩ }
-end
-
-variables (R M)
-
-/-- If an additive monoid `M` is finitely generated then `add_monoid_algebra R M` is of finite
-type. -/
-instance finite_type_of_fg [comm_ring R] [h : add_monoid.fg M] :
-  finite_type R (add_monoid_algebra R M) :=
-begin
-  obtain ⟨S, hS⟩ := h.out,
-  exact (finite_type.mv_polynomial R (S : set M)).of_surjective (mv_polynomial.aeval
-    (λ (s : (S : set M)), of' R M ↑s)) (mv_polynomial_aeval_of_surjective_of_closure hS)
-end
-
-variables {R M}
-
-/-- An additive monoid `M` is finitely generated if and only if `add_monoid_algebra R M` is of
-finite type. -/
-lemma finite_type_iff_fg [comm_ring R] [nontrivial R] :
-  finite_type R (add_monoid_algebra R M) ↔ add_monoid.fg M :=
-begin
-  refine ⟨λ h, _, λ h, @add_monoid_algebra.finite_type_of_fg _ _ _ _ h⟩,
-  obtain ⟨S, hS⟩ := @exists_finset_adjoin_eq_top R M _ _ h,
-  refine add_monoid.fg_def.2 ⟨S, (eq_top_iff' _).2 (λ m, _)⟩,
-  have hm : of' R M m ∈ (adjoin R (of' R M '' ↑S)).to_submodule,
-  { simp only [hS, top_to_submodule, submodule.mem_top], },
-  rw [adjoin_eq_span] at hm,
-  exact mem_closure_of_mem_span_closure hm
-end
-
-/-- If `add_monoid_algebra R M` is of finite type then `M` is finitely generated. -/
-lemma fg_of_finite_type [comm_ring R] [nontrivial R] [h : finite_type R (add_monoid_algebra R M)] :
-  add_monoid.fg M :=
-finite_type_iff_fg.1 h
-
-/-- An additive group `G` is finitely generated if and only if `add_monoid_algebra R G` is of
-finite type. -/
-lemma finite_type_iff_group_fg {G : Type*} [add_comm_group G] [comm_ring R] [nontrivial R] :
-  finite_type R (add_monoid_algebra R G) ↔ add_group.fg G :=
-by simpa [add_group.fg_iff_add_monoid.fg] using finite_type_iff_fg
-
-end add_monoid_algebra
-
-namespace monoid_algebra
-
-open algebra submonoid submodule
-
-section span
-
-section semiring
-
-variables [comm_semiring R] [monoid M]
-
-/-- An element of `monoid_algebra R M` is in the subalgebra generated by its support. -/
-lemma mem_adjoint_support (f : monoid_algebra R M) : f ∈ adjoin R (of R M '' f.support) :=
-begin
-  suffices : span R (of R M '' f.support) ≤ (adjoin R (of R M '' f.support)).to_submodule,
-  { exact this (mem_span_support f) },
-  rw submodule.span_le,
-  exact subset_adjoin
-end
-
-/-- If a set `S` generates, as algebra, `monoid_algebra R M`, then the set of supports of elements
-of `S` generates `monoid_algebra R M`. -/
-lemma support_gen_of_gen {S : set (monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
-  algebra.adjoin R (⋃ f ∈ S, (of R M '' (f.support : set M))) = ⊤ :=
-begin
-  refine le_antisymm le_top _,
-  rw [← hS, adjoin_le_iff],
-  intros f hf,
-  have hincl : (of R M) '' f.support ⊆
-    ⋃ (g : monoid_algebra R M) (H : g ∈ S), of R M '' g.support,
-  { intros s hs,
-    exact set.mem_Union₂.2 ⟨f, ⟨hf, hs⟩⟩ },
-  exact adjoin_mono hincl (mem_adjoint_support f)
-end
-
-/-- If a set `S` generates, as algebra, `monoid_algebra R M`, then the image of the union of the
-supports of elements of `S` generates `monoid_algebra R M`. -/
-lemma support_gen_of_gen' {S : set (monoid_algebra R M)} (hS : algebra.adjoin R S = ⊤) :
-  algebra.adjoin R (of R M '' (⋃ f ∈ S, (f.support : set M))) = ⊤ :=
-begin
-  suffices : of R M '' (⋃ f ∈ S, (f.support : set M)) = ⋃ f ∈ S, (of R M '' (f.support : set M)),
-  { rw this,
-    exact support_gen_of_gen hS },
-  simp only [set.image_Union]
-end
-
-end semiring
-
-section ring
-
-variables [comm_ring R] [comm_monoid M]
-
-/-- If `monoid_algebra R M` is of finite type, there there is a `G : finset M` such that its image
-generates, as algera, `monoid_algebra R M`. -/
-lemma exists_finset_adjoin_eq_top [h :finite_type R (monoid_algebra R M)] :
-  ∃ G : finset M, algebra.adjoin R (of R M '' G) = ⊤ :=
-begin
-  unfreezingI { obtain ⟨S, hS⟩ := h },
-  letI : decidable_eq M := classical.dec_eq M,
-  use finset.bUnion S (λ f, f.support),
-  have : (finset.bUnion S (λ f, f.support) : set M) = ⋃ f ∈ S, (f.support : set M),
-  { simp only [finset.set_bUnion_coe, finset.coe_bUnion] },
-  rw [this],
-  exact support_gen_of_gen' hS
-end
-
-/-- The image of an element `m : M` in `monoid_algebra R M` belongs the submodule generated by
-`S : set M` if and only if `m ∈ S`. -/
-lemma of_mem_span_of_iff [nontrivial R] {m : M} {S : set M} :
-  of R M m ∈ span R (of R M '' S) ↔ m ∈ S :=
-begin
-  refine ⟨λ h, _, λ h, submodule.subset_span $ set.mem_image_of_mem (of R M) h⟩,
-  rw [of, monoid_hom.coe_mk, ← finsupp.supported_eq_span_single, finsupp.mem_supported,
-    finsupp.support_single_ne_zero (@one_ne_zero R _ (by apply_instance))] at h,
-  simpa using h
-end
-
-/--If the image of an element `m : M` in `monoid_algebra R M` belongs the submodule generated by the
-closure of some `S : set M` then `m ∈ closure S`. -/
-lemma mem_closure_of_mem_span_closure [nontrivial R] {m : M} {S : set M}
-  (h : of R M m ∈ span R (submonoid.closure (of R M '' S) : set (monoid_algebra R M))) :
-  m ∈ closure S :=
-begin
-  rw ← monoid_hom.map_mclosure at h,
-  simpa using of_mem_span_of_iff.1 h
-end
-
-end ring
-
-end span
-
-variables [comm_monoid M]
-
-/-- If a set `S` generates a monoid `M`, then the image of `M` generates, as algebra,
-`monoid_algebra R M`. -/
-lemma mv_polynomial_aeval_of_surjective_of_closure [comm_semiring R] {S : set M}
-  (hS : closure S = ⊤) : function.surjective (mv_polynomial.aeval
-  (λ (s : S), of R M ↑s) : mv_polynomial S R → monoid_algebra R M) :=
-begin
-  refine λ f, induction_on f (λ m, _) _ _,
-  { have : m ∈ closure S := hS.symm ▸ mem_top _,
-    refine closure_induction this (λ m hm, _) _ _,
-    { exact ⟨mv_polynomial.X ⟨m, hm⟩, mv_polynomial.aeval_X _ _⟩ },
-    { exact ⟨1, alg_hom.map_one _⟩ },
-    { rintro m₁ m₂ ⟨P₁, hP₁⟩ ⟨P₂, hP₂⟩,
-      exact ⟨P₁ * P₂, by rw [alg_hom.map_mul, hP₁, hP₂, of_apply, of_apply, of_apply,
-        single_mul_single, one_mul]⟩ } },
-  { rintro f g ⟨P, rfl⟩ ⟨Q, rfl⟩,
-    exact ⟨P + Q, alg_hom.map_add _ _ _⟩ },
-  { rintro r f ⟨P, rfl⟩,
-    exact ⟨r • P, alg_hom.map_smul _ _ _⟩ }
-end
-
-/-- If a monoid `M` is finitely generated then `monoid_algebra R M` is of finite type. -/
-instance finite_type_of_fg [comm_ring R] [monoid.fg M] : finite_type R (monoid_algebra R M) :=
-(add_monoid_algebra.finite_type_of_fg R (additive M)).equiv (to_additive_alg_equiv R M).symm
-
-/-- A monoid `M` is finitely generated if and only if `monoid_algebra R M` is of finite type. -/
-lemma finite_type_iff_fg [comm_ring R] [nontrivial R] :
-  finite_type R (monoid_algebra R M) ↔ monoid.fg M :=
-⟨λ h, monoid.fg_iff_add_fg.2 $ add_monoid_algebra.finite_type_iff_fg.1 $ h.equiv $
-  to_additive_alg_equiv R M, λ h, @monoid_algebra.finite_type_of_fg _ _ _ _ h⟩
-
-/-- If `monoid_algebra R M` is of finite type then `M` is finitely generated. -/
-lemma fg_of_finite_type [comm_ring R] [nontrivial R] [h : finite_type R (monoid_algebra R M)] :
-  monoid.fg M :=
-finite_type_iff_fg.1 h
-
-/-- A group `G` is finitely generated if and only if `add_monoid_algebra R G` is of finite type. -/
-lemma finite_type_iff_group_fg {G : Type*} [comm_group G] [comm_ring R] [nontrivial R] :
-  finite_type R (monoid_algebra R G) ↔ group.fg G :=
-by simpa [group.fg_iff_monoid.fg] using finite_type_iff_fg
-
-end monoid_algebra
-
-end monoid_algebra
-
-section vasconcelos
-variables {R : Type*} [comm_ring R] {M : Type*} [add_comm_group M] [module R M] (f : M →ₗ[R] M)
-
-noncomputable theory
-
-/-- The structure of a module `M` over a ring `R` as a module over `polynomial R` when given a
-choice of how `X` acts by choosing a linear map `f : M →ₗ[R] M` -/
-@[simps]
-def module_polynomial_of_endo : module R[X] M :=
-module.comp_hom M (polynomial.aeval f).to_ring_hom
-
-include f
-lemma module_polynomial_of_endo.is_scalar_tower : @is_scalar_tower R R[X] M _
-  (by { letI := module_polynomial_of_endo f, apply_instance }) _ :=
-begin
-  letI := module_polynomial_of_endo f,
-  constructor,
-  intros x y z,
-  simp,
-end
-
-open polynomial module
-
-/-- A theorem/proof by Vasconcelos, given a finite module `M` over a commutative ring, any
-surjective endomorphism of `M` is also injective. Based on,
-https://math.stackexchange.com/a/239419/31917,
-https://www.ams.org/journals/tran/1969-138-00/S0002-9947-1969-0238839-5/.
-This is similar to `is_noetherian.injective_of_surjective_endomorphism` but only applies in the
-commutative case, but does not use a Noetherian hypothesis. -/
-theorem module.finite.injective_of_surjective_endomorphism [hfg : finite R M]
-  (f_surj : function.surjective f) : function.injective f :=
-begin
-  letI := module_polynomial_of_endo f,
-  haveI : is_scalar_tower R R[X] M := module_polynomial_of_endo.is_scalar_tower f,
-  have hfgpoly : finite R[X] M, from finite.of_restrict_scalars_finite R _ _,
-  have X_mul : ∀ o, (X : R[X]) • o = f o,
-  { intro,
-    simp, },
-  have : (⊤ : submodule R[X] M) ≤ ideal.span {X} • ⊤,
-  { intros a ha,
-    obtain ⟨y, rfl⟩ := f_surj a,
-    rw [← X_mul y],
-    exact submodule.smul_mem_smul (ideal.mem_span_singleton.mpr (dvd_refl _)) trivial, },
-  obtain ⟨F, hFa, hFb⟩ := submodule.exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul _
-    (⊤ : submodule R[X] M) (finite_def.mp hfgpoly) this,
-  rw [← linear_map.ker_eq_bot, linear_map.ker_eq_bot'],
-  intros m hm,
-  rw ideal.mem_span_singleton' at hFa,
-  obtain ⟨G, hG⟩ := hFa,
-  suffices : (F - 1) • m = 0,
-  { have Fmzero := hFb m (by simp),
-    rwa [← sub_add_cancel F 1, add_smul, one_smul, this, zero_add] at Fmzero, },
-  rw [← hG, mul_smul, X_mul m, hm, smul_zero],
-end
-
-end vasconcelos
diff --git a/src/ring_theory/fintype.lean b/src/ring_theory/fintype.lean
index efdb548d3547d..f5f0a5e97256f 100644
--- a/src/ring_theory/fintype.lean
+++ b/src/ring_theory/fintype.lean
@@ -3,10 +3,13 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import data.fintype.basic
+import data.fintype.units
 
 /-!
 # Some facts about finite rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 open_locale classical
diff --git a/src/ring_theory/flat.lean b/src/ring_theory/flat.lean
index 7e0bae6227572..ffce2a604777c 100644
--- a/src/ring_theory/flat.lean
+++ b/src/ring_theory/flat.lean
@@ -9,6 +9,9 @@ import ring_theory.noetherian
 /-!
 # Flat modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A module `M` over a commutative ring `R` is *flat*
 if for all finitely generated ideals `I` of `R`,
 the canonical map `I ⊗ M →ₗ M` is injective.
@@ -38,7 +41,7 @@ This result is not yet formalised.
   For base change, it will be very useful to have a "characteristic predicate"
   instead of relying on the construction `A ⊗ B`.
   Indeed, such a predicate should allow us to treat both
-  `polynomial A` and `A ⊗ polynomial R` as the base change of `polynomial R` to `A`.
+  `A[X]` and `A ⊗ R[X]` as the base change of `R[X]` to `A`.
   (Similar examples exist with `fin n → R`, `R × R`, `ℤ[i] ⊗ ℝ`, etc...)
 * Generalize flatness to noncommutative rings.
 
diff --git a/src/ring_theory/fractional_ideal.lean b/src/ring_theory/fractional_ideal.lean
index a01ca08d79030..7eea94685ba78 100644
--- a/src/ring_theory/fractional_ideal.lean
+++ b/src/ring_theory/fractional_ideal.lean
@@ -14,6 +14,9 @@ import tactic.field_simp
 /-!
 # Fractional ideals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines fractional ideals of an integral domain and proves basic facts about them.
 
 ## Main definitions
@@ -108,8 +111,7 @@ variables [algebra R P] [loc : is_localization S P]
 This coercion is typically called `coe_to_submodule` in lemma names
 (or `coe` when the coercion is clear from the context),
 not to be confused with `is_localization.coe_submodule : ideal R → submodule R P`
-(which we use to define `coe : ideal R → fractional_ideal S P`,
-referred to as `coe_ideal` in theorem names).
+(which we use to define `coe : ideal R → fractional_ideal S P`).
 -/
 instance : has_coe (fractional_ideal S P) (submodule R P) := ⟨λ I, I.val⟩
 
@@ -134,6 +136,13 @@ Useful to fix definitional equalities. -/
 protected def copy (p : fractional_ideal S P) (s : set P) (hs : s = ↑p) : fractional_ideal S P :=
 ⟨submodule.copy p s hs, by { convert p.is_fractional, ext, simp only [hs], refl }⟩
 
+@[simp] lemma coe_copy (p : fractional_ideal S P) (s : set P) (hs : s = ↑p) :
+  ↑(p.copy s hs) = s :=
+rfl
+
+lemma coe_eq (p : fractional_ideal S P) (s : set P) (hs : s = ↑p) : p.copy s hs = p :=
+set_like.coe_injective hs
+
 end set_like
 
 @[simp] lemma val_eq_coe (I : fractional_ideal S P) : I.val = I := rfl
@@ -141,12 +150,18 @@ end set_like
 @[simp, norm_cast] lemma coe_mk (I : submodule R P) (hI : is_fractional S I) :
   (subtype.mk I hI : submodule R P) = I := rfl
 
+/-! Transfer instances from `submodule R P` to `fractional_ideal S P`. -/
+instance (I : fractional_ideal S P) : add_comm_group I := submodule.add_comm_group ↑I
+instance (I : fractional_ideal S P) : module R I := submodule.module ↑I
+
 lemma coe_to_submodule_injective :
   function.injective (coe : fractional_ideal S P → submodule R P) :=
 subtype.coe_injective
 
-lemma is_fractional_of_le_one (I : submodule R P) (h : I ≤ 1) :
-  is_fractional S I :=
+lemma coe_to_submodule_inj {I J : fractional_ideal S P} : (I : submodule R P) = J ↔ I = J :=
+coe_to_submodule_injective.eq_iff
+
+lemma is_fractional_of_le_one (I : submodule R P) (h : I ≤ 1) : is_fractional S I :=
 begin
   use [1, S.one_mem],
   intros b hb,
@@ -155,8 +170,8 @@ begin
   exact set.mem_range_self b',
 end
 
-lemma is_fractional_of_le {I : submodule R P} {J : fractional_ideal S P}
-  (hIJ : I ≤ J) : is_fractional S I :=
+lemma is_fractional_of_le {I : submodule R P} {J : fractional_ideal S P} (hIJ : I ≤ J) :
+  is_fractional S I :=
 begin
   obtain ⟨a, a_mem, ha⟩ := J.is_fractional,
   use [a, a_mem],
@@ -173,9 +188,9 @@ also called `coe_to_submodule` in theorem names.
 This map is available as a ring hom, called `fractional_ideal.coe_ideal_hom`.
 -/
 -- Is a `coe_t` rather than `coe` to speed up failing inference, see library note [use has_coe_t]
-instance coe_to_fractional_ideal : has_coe_t (ideal R) (fractional_ideal S P) :=
-⟨λ I, ⟨coe_submodule P I, is_fractional_of_le_one _
-  (by simpa using coe_submodule_mono P (le_top : I ≤ ⊤))⟩⟩
+instance : has_coe_t (ideal R) (fractional_ideal S P) :=
+⟨λ I, ⟨coe_submodule P I,
+  is_fractional_of_le_one _ $ by simpa using coe_submodule_mono P (le_top : I ≤ ⊤)⟩⟩
 
 @[simp, norm_cast] lemma coe_coe_ideal (I : ideal R) :
   ((I : fractional_ideal S P) : submodule R P) = coe_submodule P I := rfl
@@ -211,8 +226,7 @@ variables {S}
 @[simp, norm_cast] lemma coe_zero : ↑(0 : fractional_ideal S P) = (⊥ : submodule R P) :=
 submodule.ext $ λ _, mem_zero_iff S
 
-@[simp, norm_cast] lemma coe_to_fractional_ideal_bot : ((⊥ : ideal R) : fractional_ideal S P) = 0 :=
-rfl
+@[simp, norm_cast] lemma coe_ideal_bot : ((⊥ : ideal R) : fractional_ideal S P) = 0 := rfl
 
 variables (P)
 
@@ -224,22 +238,21 @@ include loc
 
 variables {P}
 
-lemma coe_to_fractional_ideal_injective (h : S ≤ non_zero_divisors R) :
+lemma coe_ideal_injective' (h : S ≤ non_zero_divisors R) :
   function.injective (coe : ideal R → fractional_ideal S P) :=
-λ I J heq, have
-  ∀ (x : R), algebra_map R P x ∈ (I : fractional_ideal S P) ↔
-             algebra_map R P x ∈ (J : fractional_ideal S P) :=
-λ x, heq ▸ iff.rfl,
-ideal.ext (by simpa only [mem_coe_ideal, exists_prop, exists_mem_to_map_eq P h] using this)
+λ _ _ h', ((coe_ideal_le_coe_ideal' S h).mp h'.le).antisymm ((coe_ideal_le_coe_ideal' S h).mp h'.ge)
 
-lemma coe_to_fractional_ideal_eq_zero {I : ideal R} (hS : S ≤ non_zero_divisors R) :
+lemma coe_ideal_inj' (h : S ≤ non_zero_divisors R) {I J : ideal R} :
+  (I : fractional_ideal S P) = J ↔ I = J :=
+(coe_ideal_injective' h).eq_iff
+
+@[simp] lemma coe_ideal_eq_zero' {I : ideal R} (h : S ≤ non_zero_divisors R) :
   (I : fractional_ideal S P) = 0 ↔ I = (⊥ : ideal R) :=
-⟨λ h, coe_to_fractional_ideal_injective hS h,
- λ h, by rw [h, coe_to_fractional_ideal_bot]⟩
+coe_ideal_inj' h
 
-lemma coe_to_fractional_ideal_ne_zero {I : ideal R} (hS : S ≤ non_zero_divisors R) :
+lemma coe_ideal_ne_zero' {I : ideal R} (h : S ≤ non_zero_divisors R) :
   (I : fractional_ideal S P) ≠ 0 ↔ I ≠ (⊥ : ideal R) :=
-not_iff_not.mpr (coe_to_fractional_ideal_eq_zero hS)
+not_iff_not.mpr $ coe_ideal_eq_zero' h
 
 omit loc
 
@@ -259,8 +272,7 @@ instance : has_one (fractional_ideal S P) :=
 
 variables (S)
 
-@[simp, norm_cast] lemma coe_ideal_top : ((⊤ : ideal R) : fractional_ideal S P) = 1 :=
-rfl
+@[simp, norm_cast] lemma coe_ideal_top : ((⊤ : ideal R) : fractional_ideal S P) = 1 := rfl
 
 lemma mem_one_iff {x : P} : x ∈ (1 : fractional_ideal S P) ↔ ∃ x' : R, algebra_map R P x' = x :=
 iff.intro (λ ⟨x', _, h⟩, ⟨x', h⟩) (λ ⟨x', h⟩, ⟨x', ⟨⟩, h⟩)
@@ -382,7 +394,7 @@ lemma _root_.is_fractional.nsmul {I : submodule R P} :
   exact h.sup (_root_.is_fractional.nsmul n h)
 end
 
-instance : has_scalar ℕ (fractional_ideal S P) :=
+instance : has_smul ℕ (fractional_ideal S P) :=
 { smul := λ n I, ⟨n • I, I.is_fractional.nsmul n⟩}
 
 @[norm_cast]
@@ -419,31 +431,47 @@ so by making definitions irreducible, we hope to avoid deep unfolds.
 def mul (I J : fractional_ideal S P) : fractional_ideal S P :=
 ⟨I * J, I.is_fractional.mul J.is_fractional⟩
 
-local attribute [semireducible] mul
+-- local attribute [semireducible] mul
 
 instance : has_mul (fractional_ideal S P) := ⟨λ I J, mul I J⟩
 
 @[simp] lemma mul_eq_mul (I J : fractional_ideal S P) : mul I J = I * J := rfl
 
+lemma mul_def (I J : fractional_ideal S P) : I * J = ⟨I * J, I.is_fractional.mul J.is_fractional⟩ :=
+by simp only [← mul_eq_mul, mul]
+
 @[simp, norm_cast]
-lemma coe_mul (I J : fractional_ideal S P) : (↑(I * J) : submodule R P) = I * J := rfl
+lemma coe_mul (I J : fractional_ideal S P) : (↑(I * J) : submodule R P) = I * J :=
+by { simp only [mul_def], refl }
 
 @[simp, norm_cast]
 lemma coe_ideal_mul (I J : ideal R) : (↑(I * J) : fractional_ideal S P) = I * J :=
-coe_to_submodule_injective $ coe_submodule_mul _ _ _
+begin
+  simp only [mul_def],
+  exact coe_to_submodule_injective (coe_submodule_mul _ _ _)
+end
 
 lemma mul_left_mono (I : fractional_ideal S P) : monotone ((*) I) :=
-λ J J' h, mul_le.mpr (λ x hx y hy, mul_mem_mul hx (h hy))
+begin
+  intros J J' h,
+  simp only [mul_def],
+  exact mul_le.mpr (λ x hx y hy, mul_mem_mul hx (h hy))
+end
 
 lemma mul_right_mono (I : fractional_ideal S P) : monotone (λ J, J * I) :=
-λ J J' h, mul_le.mpr (λ x hx y hy, mul_mem_mul (h hx) hy)
+begin
+  intros J J' h,
+  simp only [mul_def],
+  exact mul_le.mpr (λ x hx y hy, mul_mem_mul (h hx) hy)
+end
 
 lemma mul_mem_mul {I J : fractional_ideal S P} {i j : P} (hi : i ∈ I) (hj : j ∈ J) :
-  i * j ∈ I * J := submodule.mul_mem_mul hi hj
+  i * j ∈ I * J :=
+by { simp only [mul_def], exact submodule.mul_mem_mul hi hj }
 
 lemma mul_le {I J K : fractional_ideal S P} :
   I * J ≤ K ↔ (∀ (i ∈ I) (j ∈ J), i * j ∈ K) :=
-submodule.mul_le
+by { simp only [mul_def], exact submodule.mul_le }
 
 instance : has_pow (fractional_ideal S P) ℕ := ⟨λ I n, ⟨I^n, I.is_fractional.pow n⟩⟩
 
@@ -455,11 +483,25 @@ lemma coe_pow (I : fractional_ideal S P) (n : ℕ) : ↑(I ^ n) = (I ^ n : submo
   {C : P → Prop} {r : P} (hr : r ∈ I * J)
   (hm : ∀ (i ∈ I) (j ∈ J), C (i * j))
   (ha : ∀ x y, C x → C y → C (x + y)) : C r :=
-submodule.mul_induction_on hr hm ha
+begin
+  simp only [mul_def] at hr,
+  exact submodule.mul_induction_on hr hm ha
+end
+
+instance : has_nat_cast (fractional_ideal S P) := ⟨nat.unary_cast⟩
+
+lemma coe_nat_cast (n : ℕ) : ((n : fractional_ideal S P) : submodule R P) = n :=
+show ↑n.unary_cast = ↑n, by induction n; simp [*, nat.unary_cast]
 
 instance : comm_semiring (fractional_ideal S P) :=
-function.injective.comm_semiring _ subtype.coe_injective
-  coe_zero coe_one coe_add coe_mul (λ _ _, coe_nsmul _ _) coe_pow
+function.injective.comm_semiring coe subtype.coe_injective
+  coe_zero coe_one coe_add coe_mul (λ _ _, coe_nsmul _ _) coe_pow coe_nat_cast
+
+variables (S P)
+/-- `fractional_ideal.submodule.has_coe` as a bundled `ring_hom`. -/
+@[simps] def coe_submodule_hom : fractional_ideal S P →+* submodule R P :=
+⟨coe, coe_one, coe_mul, coe_zero, coe_add⟩
+variables {S P}
 
 section order
 
@@ -484,8 +526,7 @@ begin
 end
 
 lemma coe_ideal_le_one {I : ideal R} : (I : fractional_ideal S P) ≤ 1 :=
-λ x hx, let ⟨y, _, hy⟩ := (fractional_ideal.mem_coe_ideal S).mp hx
-  in (fractional_ideal.mem_one_iff S).mpr ⟨y, hy⟩
+λ x hx, let ⟨y, _, hy⟩ := (mem_coe_ideal S).mp hx in (mem_one_iff S).mpr ⟨y, hy⟩
 
 lemma le_one_iff_exists_coe_ideal {J : fractional_ideal S P} :
   J ≤ (1 : fractional_ideal S P) ↔ ∃ (I : ideal R), ↑I = J :=
@@ -506,7 +547,7 @@ begin
       { rintros ⟨y, hy, eq_y⟩,
         rwa ← eq_y },
       { intro hx,
-        obtain ⟨y, eq_x⟩ := (fractional_ideal.mem_one_iff S).mp (hJ hx),
+        obtain ⟨y, eq_x⟩ := (mem_one_iff S).mp (hJ hx),
         rw ← eq_x at *,
         exact ⟨y, hx, rfl⟩ } } },
   { rintro ⟨I, hI⟩,
@@ -514,6 +555,10 @@ begin
     apply coe_ideal_le_one },
 end
 
+@[simp] lemma one_le {I : fractional_ideal S P} :
+  1 ≤ I ↔ (1 : P) ∈ I :=
+by rw [← coe_le_coe, coe_one, submodule.one_le, mem_coe]
+
 variables (S P)
 
 /-- `coe_ideal_hom (S : submonoid R) P` is `coe : ideal R → fractional_ideal S P` as a ring hom -/
@@ -523,17 +568,16 @@ def coe_ideal_hom : ideal R →+* fractional_ideal S P :=
   map_add' := coe_ideal_sup,
   map_mul' := coe_ideal_mul,
   map_one' := by rw [ideal.one_eq_top, coe_ideal_top],
-  map_zero' := coe_to_fractional_ideal_bot }
+  map_zero' := coe_ideal_bot }
 
 lemma coe_ideal_pow (I : ideal R) (n : ℕ) : (↑(I^n) : fractional_ideal S P) = I^n :=
-(fractional_ideal.coe_ideal_hom S P).map_pow _ n
+(coe_ideal_hom S P).map_pow _ n
 
 open_locale big_operators
 lemma coe_ideal_finprod [is_localization S P] {α : Sort*} {f : α → ideal R}
   (hS : S ≤ non_zero_divisors R) :
   ((∏ᶠ a : α, f a : ideal R) : fractional_ideal S P) = ∏ᶠ a : α, (f a : fractional_ideal S P) :=
-monoid_hom.map_finprod_of_injective (fractional_ideal.coe_ideal_hom S P).to_monoid_hom
-  (fractional_ideal.coe_to_fractional_ideal_injective hS) f
+monoid_hom.map_finprod_of_injective (coe_ideal_hom S P).to_monoid_hom (coe_ideal_injective' hS) f
 
 end order
 
@@ -594,7 +638,10 @@ map_coe_ideal g 0
 coe_to_submodule_injective (submodule.map_sup _ _ _)
 
 @[simp] lemma map_mul : (I * J).map g = I.map g * J.map g :=
-coe_to_submodule_injective (submodule.map_mul _ _ _)
+begin
+  simp only [mul_def],
+  exact coe_to_submodule_injective (submodule.map_mul _ _ _)
+end
 
 @[simp] lemma map_map_symm (g : P ≃ₐ[R] P') :
   (I.map (g : P →ₐ[R] P')).map (g.symm : P' →ₐ[R] P) = I :=
@@ -610,8 +657,7 @@ mem_map.trans ⟨λ ⟨x', hx', x'_eq⟩, h x'_eq ▸ hx', λ h, ⟨x, h, rfl⟩
 
 lemma map_injective (f : P →ₐ[R] P') (h : function.injective f) :
   function.injective (map f : fractional_ideal S P → fractional_ideal S P') :=
-λ I J hIJ, fractional_ideal.ext (λ x, (fractional_ideal.map_mem_map h).symm.trans
-  (hIJ.symm ▸ fractional_ideal.map_mem_map h))
+λ I J hIJ, ext (λ x, (map_mem_map h).symm.trans (hIJ.symm ▸ map_mem_map h))
 
 /-- If `g` is an equivalence, `map g` is an isomorphism -/
 def map_equiv (g : P ≃ₐ[R] P') :
@@ -673,22 +719,11 @@ variables {S}
 
 lemma fg_unit (I : (fractional_ideal S P)ˣ) :
   fg (I : submodule R P) :=
-begin
-  have : (1 : P) ∈ (I * ↑I⁻¹ : fractional_ideal S P),
-  { rw units.mul_inv, exact one_mem_one _ },
-  obtain ⟨T, T', hT, hT', one_mem⟩ := mem_span_mul_finite_of_mem_mul this,
-  refine ⟨T, submodule.span_eq_of_le _ hT _⟩,
-  rw [← one_mul ↑I, ← mul_one (span R ↑T)],
-  conv_rhs { rw [← fractional_ideal.coe_one, ← units.mul_inv I, fractional_ideal.coe_mul,
-                 mul_comm ↑↑I, ← mul_assoc] },
-  refine submodule.mul_le_mul_left
-    (le_trans _ (submodule.mul_le_mul_right (submodule.span_le.mpr hT'))),
-  rwa [submodule.one_le, submodule.span_mul_span]
-end
+submodule.fg_unit $ units.map (coe_submodule_hom S P).to_monoid_hom I
 
 lemma fg_of_is_unit (I : fractional_ideal S P) (h : is_unit I) :
   fg (I : submodule R P) :=
-by { rcases h with ⟨I, rfl⟩, exact fg_unit I }
+fg_unit h.unit
 
 lemma _root_.ideal.fg_of_is_unit (inj : function.injective (algebra_map R P))
   (I : ideal R) (h : is_unit (I : fractional_ideal S P)) :
@@ -725,10 +760,41 @@ by { rw [mem_canonical_equiv_apply, canonical_equiv, map_equiv_symm, map_equiv,
          ring_equiv.coe_mk, mem_map],
     exact ⟨λ ⟨y, mem, eq⟩, ⟨y, mem, eq⟩, λ ⟨y, mem, eq⟩, ⟨y, mem, eq⟩⟩ }
 
-@[simp] lemma canonical_equiv_flip (I) :
+lemma canonical_equiv_flip (I) :
   canonical_equiv S P P' (canonical_equiv S P' P I) = I :=
 by rw [←canonical_equiv_symm, ring_equiv.symm_apply_apply]
 
+@[simp]
+lemma canonical_equiv_canonical_equiv (P'' : Type*) [comm_ring P''] [algebra R P'']
+  [is_localization S P''] (I : fractional_ideal S P) :
+  canonical_equiv S P' P'' (canonical_equiv S P P' I) = canonical_equiv S P P'' I :=
+begin
+  ext,
+  simp only [is_localization.map_map, ring_hom_inv_pair.comp_eq₂, mem_canonical_equiv_apply,
+      exists_prop, exists_exists_and_eq_and],
+  refl
+end
+
+lemma canonical_equiv_trans_canonical_equiv (P'' : Type*) [comm_ring P'']
+  [algebra R P''] [is_localization S P''] :
+  (canonical_equiv S P P').trans (canonical_equiv S P' P'') = canonical_equiv S P P'' :=
+ring_equiv.ext (canonical_equiv_canonical_equiv S P P' P'')
+
+@[simp]
+lemma canonical_equiv_coe_ideal (I : ideal R) :
+  canonical_equiv S P P' I = I :=
+by { ext, simp [is_localization.map_eq] }
+
+omit loc'
+
+@[simp]
+lemma canonical_equiv_self : canonical_equiv S P P = ring_equiv.refl _ :=
+begin
+  rw ← canonical_equiv_trans_canonical_equiv S P P,
+  convert (canonical_equiv S P P).symm_trans_self,
+  exact (canonical_equiv_symm S P P).symm
+end
+
 end semiring
 
 section is_fraction_ring
@@ -771,19 +837,23 @@ end
 ⟨imp_of_not_imp_not _ _ (map_ne_zero _), λ hI, hI.symm ▸ map_zero h⟩
 
 lemma coe_ideal_injective : function.injective (coe : ideal R → fractional_ideal R⁰ K) :=
-injective_of_le_imp_le _ (λ _ _, (coe_ideal_le_coe_ideal _).mp)
+coe_ideal_injective' le_rfl
+
+lemma coe_ideal_inj {I J : ideal R} :
+  (I : fractional_ideal R⁰ K) = (J : fractional_ideal R⁰ K) ↔ I = J :=
+coe_ideal_inj' le_rfl
 
-@[simp] lemma coe_ideal_eq_zero_iff {I : ideal R} : (I : fractional_ideal R⁰ K) = 0 ↔ I = ⊥ :=
-coe_ideal_injective.eq_iff
+@[simp] lemma coe_ideal_eq_zero {I : ideal R} : (I : fractional_ideal R⁰ K) = 0 ↔ I = ⊥ :=
+coe_ideal_eq_zero' le_rfl
 
-lemma coe_ideal_ne_zero_iff {I : ideal R} : (I : fractional_ideal R⁰ K) ≠ 0 ↔ I ≠ ⊥ :=
-not_iff_not.mpr coe_ideal_eq_zero_iff
+lemma coe_ideal_ne_zero {I : ideal R} : (I : fractional_ideal R⁰ K) ≠ 0 ↔ I ≠ ⊥ :=
+coe_ideal_ne_zero' le_rfl
 
-lemma coe_ideal_ne_zero {I : ideal R} (hI : I ≠ ⊥) : (I : fractional_ideal R⁰ K) ≠ 0 :=
-coe_ideal_ne_zero_iff.mpr hI
+@[simp] lemma coe_ideal_eq_one {I : ideal R} : (I : fractional_ideal R⁰ K) = 1 ↔ I = 1 :=
+by simpa only [ideal.one_eq_top] using coe_ideal_inj
 
-@[simp] lemma coe_ideal_eq_one_iff {I : ideal R} : (I : fractional_ideal R⁰ K) = 1 ↔ I = 1 :=
-by simpa only [ideal.one_eq_top] using coe_ideal_injective.eq_iff
+lemma coe_ideal_ne_one {I : ideal R} : (I : fractional_ideal R⁰ K) ≠ 1 ↔ I ≠ 1 :=
+not_iff_not.mpr coe_ideal_eq_one
 
 end is_fraction_ring
 
@@ -812,7 +882,7 @@ instance : nontrivial (fractional_ideal R₁⁰ K) :=
   one_ne_zero ((mem_zero_iff _).mp this)⟩⟩
 
 lemma ne_zero_of_mul_eq_one (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) : I ≠ 0 :=
-λ hI, @zero_ne_one (fractional_ideal R₁⁰ K) _ _ (by { convert h, simp [hI], })
+λ hI, zero_ne_one' (fractional_ideal R₁⁰ K) (by { convert h, simp [hI], })
 
 variables [is_domain R₁]
 
@@ -845,8 +915,7 @@ lemma fractional_div_of_nonzero {I J : fractional_ideal R₁⁰ K} (h : J ≠ 0)
 I.is_fractional.div_of_nonzero J.is_fractional $ λ H, h $
   coe_to_submodule_injective $ H.trans coe_zero.symm
 
-noncomputable instance fractional_ideal_has_div :
-  has_div (fractional_ideal R₁⁰ K) :=
+noncomputable instance : has_div (fractional_ideal R₁⁰ K) :=
 ⟨ λ I J, if h : J = 0 then 0 else ⟨I / J, fractional_div_of_nonzero h⟩ ⟩
 
 variables {I J : fractional_ideal R₁⁰ K} [ J ≠ 0 ]
@@ -901,7 +970,7 @@ end
 
 @[simp] lemma div_one {I : fractional_ideal R₁⁰ K} : I / 1 = I :=
 begin
-  rw [div_nonzero (@one_ne_zero (fractional_ideal R₁⁰ K) _ _)],
+  rw [div_nonzero (one_ne_zero' (fractional_ideal R₁⁰ K))],
   ext,
   split; intro h,
   { simpa using mem_div_iff_forall_mul_mem.mp h 1
@@ -913,7 +982,7 @@ begin
     exact (algebra.smul_def _ _).symm }
 end
 
-theorem eq_one_div_of_mul_eq_one (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) :
+theorem eq_one_div_of_mul_eq_one_right (I J : fractional_ideal R₁⁰ K) (h : I * J = 1) :
   J = 1 / I :=
 begin
   have hI : I ≠ 0 := ne_zero_of_mul_eq_one I J h,
@@ -935,7 +1004,7 @@ end
 
 theorem mul_div_self_cancel_iff {I : fractional_ideal R₁⁰ K} :
   I * (1 / I) = 1 ↔ ∃ J, I * J = 1 :=
-⟨λ h, ⟨(1 / I), h⟩, λ ⟨J, hJ⟩, by rwa [← eq_one_div_of_mul_eq_one I J hJ]⟩
+⟨λ h, ⟨(1 / I), h⟩, λ ⟨J, hJ⟩, by rwa [← eq_one_div_of_mul_eq_one_right I J hJ]⟩
 
 variables {K' : Type*} [field K'] [algebra R₁ K'] [is_fraction_ring R₁ K']
 
@@ -956,32 +1025,28 @@ end quotient
 
 section field
 
-variables {R₁ K L : Type*} [comm_ring R₁] [is_domain R₁] [field K] [field L]
+variables {R₁ K L : Type*} [comm_ring R₁] [field K] [field L]
 variables [algebra R₁ K] [is_fraction_ring R₁ K] [algebra K L] [is_fraction_ring K L]
 
 lemma eq_zero_or_one (I : fractional_ideal K⁰ L) : I = 0 ∨ I = 1 :=
 begin
   rw or_iff_not_imp_left,
   intro hI,
-  simp_rw [@set_like.ext_iff _ _ _ I 1, fractional_ideal.mem_one_iff],
+  simp_rw [@set_like.ext_iff _ _ _ I 1, mem_one_iff],
   intro x,
   split,
   { intro x_mem,
     obtain ⟨n, d, rfl⟩ := is_localization.mk'_surjective K⁰ x,
     refine ⟨n / d, _⟩,
-    rw [ring_hom.map_div, is_fraction_ring.mk'_eq_div] },
+    rw [map_div₀, is_fraction_ring.mk'_eq_div] },
   { rintro ⟨x, rfl⟩,
-    obtain ⟨y, y_ne, y_mem⟩ := fractional_ideal.exists_ne_zero_mem_is_integer hI,
+    obtain ⟨y, y_ne, y_mem⟩ := exists_ne_zero_mem_is_integer hI,
     rw [← div_mul_cancel x y_ne, ring_hom.map_mul, ← algebra.smul_def],
     exact submodule.smul_mem I _ y_mem }
 end
 
 lemma eq_zero_or_one_of_is_field (hF : is_field R₁) (I : fractional_ideal R₁⁰ K) : I = 0 ∨ I = 1 :=
-begin
-  letI : field R₁ := hF.to_field,
-  -- TODO can this be less ugly?
-  exact @eq_zero_or_one R₁ K _ _ _ (by { unfreezingI {cases _inst_4}, convert _inst_9 }) I
-end
+by letI : field R₁ := hF.to_field; exact eq_zero_or_one I
 
 end field
 
@@ -995,8 +1060,7 @@ open_locale classical
 variables (R₁)
 
 /-- `fractional_ideal.span_finset R₁ s f` is the fractional ideal of `R₁` generated by `f '' s`. -/
-@[simps] def span_finset {ι : Type*} (s : finset ι) (f : ι → K) :
-  fractional_ideal R₁⁰ K :=
+@[simps] def span_finset {ι : Type*} (s : finset ι) (f : ι → K) : fractional_ideal R₁⁰ K :=
 ⟨submodule.span R₁ (f '' s), begin
   obtain ⟨a', ha'⟩ := is_localization.exist_integer_multiples R₁⁰ s f,
   refine ⟨a', a'.2, λ x hx, submodule.span_induction hx _ _ _ _⟩,
@@ -1010,7 +1074,7 @@ variables {R₁}
 
 @[simp] lemma span_finset_eq_zero {ι : Type*} {s : finset ι} {f : ι → K} :
   span_finset R₁ s f = 0 ↔ ∀ j ∈ s, f j = 0 :=
-by simp only [← coe_to_submodule_injective.eq_iff, span_finset_coe, coe_zero, submodule.span_eq_bot,
+by simp only [← coe_to_submodule_inj, span_finset_coe, coe_zero, submodule.span_eq_bot,
   set.mem_image, finset.mem_coe, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂]
 
 lemma span_finset_ne_zero {ι : Type*} {s : finset ι} {f : ι → K} :
@@ -1032,14 +1096,15 @@ variables (S)
 def span_singleton (x : P) : fractional_ideal S P :=
 ⟨span R {x}, is_fractional_span_singleton x⟩
 
-local attribute [semireducible] span_singleton
+-- local attribute [semireducible] span_singleton
 
 @[simp] lemma coe_span_singleton (x : P) :
-  (span_singleton S x : submodule R P) = span R {x} := rfl
+  (span_singleton S x : submodule R P) = span R {x} :=
+by { rw span_singleton, refl }
 
 @[simp] lemma mem_span_singleton {x y : P} :
   x ∈ span_singleton S y ↔ ∃ (z : R), z • y = x :=
-submodule.mem_span_singleton
+by { rw span_singleton, exact submodule.mem_span_singleton }
 
 lemma mem_span_singleton_self (x : P) :
   x ∈ span_singleton S x :=
@@ -1047,14 +1112,19 @@ lemma mem_span_singleton_self (x : P) :
 
 variables {S}
 
+@[simp] lemma span_singleton_le_iff_mem {x : P} {I : fractional_ideal S P} :
+  span_singleton S x ≤ I ↔ x ∈ I :=
+by rw [← coe_le_coe, coe_span_singleton, submodule.span_singleton_le_iff_mem x ↑I, mem_coe]
+
 lemma span_singleton_eq_span_singleton [no_zero_smul_divisors R P] {x y : P} :
   span_singleton S x = span_singleton S y ↔ ∃ z : Rˣ, z • x = y :=
-by { rw [← submodule.span_singleton_eq_span_singleton], exact subtype.mk_eq_mk }
+by { rw [← submodule.span_singleton_eq_span_singleton, span_singleton, span_singleton],
+  exact subtype.mk_eq_mk }
 
 lemma eq_span_singleton_of_principal (I : fractional_ideal S P)
   [is_principal (I : submodule R P)] :
   I = span_singleton S (generator (I : submodule R P)) :=
-coe_to_submodule_injective (span_singleton_generator ↑I).symm
+by { rw span_singleton, exact coe_to_submodule_injective (span_singleton_generator ↑I).symm }
 
 lemma is_principal_iff (I : fractional_ideal S P) :
   is_principal (I : submodule R P) ↔ ∃ x, I = span_singleton S x :=
@@ -1158,15 +1228,13 @@ lemma mk'_mul_coe_ideal_eq_coe_ideal {I J : ideal R₁} {x y : R₁} (hy : y ∈
   span_singleton R₁⁰ (is_localization.mk' K x ⟨y, hy⟩) * I = (J : fractional_ideal R₁⁰ K) ↔
   ideal.span {x} * I = ideal.span {y} * J :=
 begin
-  have inj : function.injective (coe : ideal R₁ → fractional_ideal R₁⁰ K) :=
-    fractional_ideal.coe_ideal_injective,
   have : span_singleton R₁⁰ (is_localization.mk' _ (1 : R₁) ⟨y, hy⟩) *
            span_singleton R₁⁰ (algebra_map R₁ K y) = 1,
   { rw [span_singleton_mul_span_singleton, mul_comm, ← is_localization.mk'_eq_mul_mk'_one,
         is_localization.mk'_self, span_singleton_one] },
   let y' : (fractional_ideal R₁⁰ K)ˣ := units.mk_of_mul_eq_one _ _ this,
   have coe_y' : ↑y' = span_singleton R₁⁰ (is_localization.mk' K (1 : R₁) ⟨y, hy⟩) := rfl,
-  refine iff.trans _ (y'.mul_right_inj.trans inj.eq_iff),
+  refine iff.trans _ (y'.mul_right_inj.trans coe_ideal_inj),
   rw [coe_y', coe_ideal_mul, coe_ideal_span_singleton, coe_ideal_mul, coe_ideal_span_singleton,
     ←mul_assoc, span_singleton_mul_span_singleton, ←mul_assoc, span_singleton_mul_span_singleton,
     mul_comm (mk' _ _ _), ← is_localization.mk'_eq_mul_mk'_one,
@@ -1188,7 +1256,7 @@ variables [is_domain R₁]
 
 lemma one_div_span_singleton (x : K) :
   1 / span_singleton R₁⁰ x = span_singleton R₁⁰ (x⁻¹) :=
-if h : x = 0 then by simp [h] else (eq_one_div_of_mul_eq_one _ _ (by simp [h])).symm
+if h : x = 0 then by simp [h] else (eq_one_div_of_mul_eq_one_right _ _ (by simp [h])).symm
 
 @[simp] lemma div_span_singleton (J : fractional_ideal R₁⁰ K) (d : K) :
   J / span_singleton R₁⁰ d = span_singleton R₁⁰ (d⁻¹) * J :=
@@ -1241,7 +1309,7 @@ begin
   obtain ⟨a, aI, -, ha⟩ := exists_eq_span_singleton_mul I,
   use (algebra_map R K a)⁻¹ * algebra_map R K (generator aI),
   suffices : I = span_singleton R⁰ ((algebra_map R K a)⁻¹ * algebra_map R K (generator aI)),
-  { exact congr_arg subtype.val this },
+  { rw span_singleton at this, exact congr_arg subtype.val this },
   conv_lhs { rw [ha, ←span_singleton_generator aI] },
   rw [ideal.submodule_span_eq, coe_ideal_span_singleton (generator aI),
       span_singleton_mul_span_singleton]
@@ -1252,13 +1320,12 @@ include loc
 lemma le_span_singleton_mul_iff {x : P} {I J : fractional_ideal S P} :
   I ≤ span_singleton S x * J ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI :=
 show (∀ {zI} (hzI : zI ∈ I), zI ∈ span_singleton _ x * J) ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI,
-by simp only [fractional_ideal.mem_singleton_mul, eq_comm]
+by simp only [mem_singleton_mul, eq_comm]
 
 lemma span_singleton_mul_le_iff {x : P} {I J : fractional_ideal S P} :
   span_singleton _ x * I ≤ J ↔ ∀ z ∈ I, x * z ∈ J :=
 begin
-  simp only [fractional_ideal.mul_le, fractional_ideal.mem_singleton_mul,
-             fractional_ideal.mem_span_singleton],
+  simp only [mul_le, mem_singleton_mul, mem_span_singleton],
   split,
   { intros h zI hzI,
     exact h x ⟨1, one_smul _ _⟩ zI hzI },
@@ -1269,8 +1336,7 @@ end
 
 lemma eq_span_singleton_mul {x : P} {I J : fractional_ideal S P} :
   I = span_singleton _ x * J ↔ (∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI) ∧ ∀ z ∈ J, x * z ∈ I :=
-by simp only [le_antisymm_iff, fractional_ideal.le_span_singleton_mul_iff,
-              fractional_ideal.span_singleton_mul_le_iff]
+by simp only [le_antisymm_iff, le_span_singleton_mul_iff, span_singleton_mul_le_iff]
 
 end principal_ideal_ring
 
@@ -1287,7 +1353,7 @@ lemma is_noetherian_iff {I : fractional_ideal R₁⁰ K} :
   is_noetherian R₁ I ↔ ∀ J ≤ I, (J : submodule R₁ K).fg :=
 is_noetherian_submodule.trans ⟨λ h J hJ, h _ hJ, λ h J hJ, h ⟨J, is_fractional_of_le hJ⟩ hJ⟩
 
-lemma is_noetherian_coe_to_fractional_ideal [_root_.is_noetherian_ring R₁] (I : ideal R₁) :
+lemma is_noetherian_coe_ideal [_root_.is_noetherian_ring R₁] (I : ideal R₁) :
   is_noetherian R₁ (I : fractional_ideal R₁⁰ K) :=
 begin
   rw is_noetherian_iff,
@@ -1328,7 +1394,7 @@ theorem is_noetherian [_root_.is_noetherian_ring R₁] (I : fractional_ideal R
 begin
   obtain ⟨d, J, h_nzd, rfl⟩ := exists_eq_span_singleton_mul I,
   apply is_noetherian_span_singleton_inv_to_map_mul,
-  apply is_noetherian_coe_to_fractional_ideal,
+  apply is_noetherian_coe_ideal
 end
 
 section adjoin
diff --git a/src/ring_theory/free_comm_ring.lean b/src/ring_theory/free_comm_ring.lean
index 214f602c4430a..7a3211dfad72a 100644
--- a/src/ring_theory/free_comm_ring.lean
+++ b/src/ring_theory/free_comm_ring.lean
@@ -11,6 +11,9 @@ import ring_theory.free_ring
 /-!
 # Free commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The theory of the free commutative ring generated by a type `α`.
 It is isomorphic to the polynomial ring over ℤ with variables
 in `α`
@@ -196,7 +199,7 @@ assume hps : is_supported (of p) s, begin
     ∃ (n : ℤ), lift (λ a, if a ∈ s then (0 : ℤ[X]) else polynomial.X) x = n,
   { intros x hx, refine subring.in_closure.rec_on hx _ _ _ _,
     { use 1, rw [ring_hom.map_one], norm_cast },
-    { use -1, rw [ring_hom.map_neg, ring_hom.map_one], norm_cast },
+    { use -1, rw [ring_hom.map_neg, ring_hom.map_one, int.cast_neg, int.cast_one] },
     { rintros _ ⟨z, hzs, rfl⟩ _ _, use 0, rw [ring_hom.map_mul, lift_of, if_pos hzs, zero_mul],
       norm_cast },
     { rintros x y ⟨q, hq⟩ ⟨r, hr⟩, refine ⟨q+r, _⟩, rw [ring_hom.map_add, hq, hr], norm_cast } },
@@ -328,7 +331,7 @@ ring_equiv.trans (free_comm_ring_equiv_mv_polynomial_int _)
   (mv_polynomial.is_empty_ring_equiv _ pempty)
 
 /-- The free commutative ring on a type with one term is isomorphic to `ℤ[X]`. -/
-def free_comm_ring_punit_equiv_polynomial_int : free_comm_ring punit.{u+1} ≃+* polynomial ℤ :=
+def free_comm_ring_punit_equiv_polynomial_int : free_comm_ring punit.{u+1} ≃+* ℤ[X] :=
 (free_comm_ring_equiv_mv_polynomial_int _).trans (mv_polynomial.punit_alg_equiv ℤ).to_ring_equiv
 
 open free_ring
@@ -338,5 +341,5 @@ def free_ring_pempty_equiv_int : free_ring pempty.{u+1} ≃+* ℤ :=
 ring_equiv.trans (subsingleton_equiv_free_comm_ring _) free_comm_ring_pempty_equiv_int
 
 /-- The free ring on a type with one term is isomorphic to `ℤ[X]`. -/
-def free_ring_punit_equiv_polynomial_int : free_ring punit.{u+1} ≃+* polynomial ℤ :=
+def free_ring_punit_equiv_polynomial_int : free_ring punit.{u+1} ≃+* ℤ[X] :=
 ring_equiv.trans (subsingleton_equiv_free_comm_ring _) free_comm_ring_punit_equiv_polynomial_int
diff --git a/src/ring_theory/free_ring.lean b/src/ring_theory/free_ring.lean
index 026bd954c7a20..983f8c47dac84 100644
--- a/src/ring_theory/free_ring.lean
+++ b/src/ring_theory/free_ring.lean
@@ -8,6 +8,9 @@ import group_theory.free_abelian_group
 /-!
 # Free rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The theory of the free ring over a type.
 
 ## Main definitions
diff --git a/src/ring_theory/graded_algebra/basic.lean b/src/ring_theory/graded_algebra/basic.lean
index cb47f95c02b29..86eebeb51333a 100644
--- a/src/ring_theory/graded_algebra/basic.lean
+++ b/src/ring_theory/graded_algebra/basic.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser, Kevin Buzzard, Jujian Zhang
 -/
 import algebra.direct_sum.algebra
+import algebra.direct_sum.decomposition
 import algebra.direct_sum.internal
 import algebra.direct_sum.ring
-import group_theory.subgroup.basic
 
 /-!
-# Internally-graded algebras
+# Internally-graded rings and algebras
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
 This file defines the typeclass `graded_algebra 𝒜`, for working with an algebra `A` that is
 internally graded by a collection of submodules `𝒜 : ι → submodule R A`.
@@ -17,14 +20,15 @@ See the docstring of that typeclass for more information.
 
 ## Main definitions
 
-* `graded_algebra 𝒜`: the typeclass, which is a combination of `set_like.graded_monoid`, and
-  a constructive version of `direct_sum.submodule_is_internal 𝒜`.
-* `graded_algebra.decompose : A ≃ₐ[R] ⨁ i, 𝒜 i`, which breaks apart an element of the algebra into
-  its constituent pieces.
+* `graded_ring 𝒜`: the typeclass, which is a combination of `set_like.graded_monoid`, and
+  `direct_sum.decomposition 𝒜`.
+* `graded_algebra 𝒜`: A convenience alias for `graded_ring` when `𝒜` is a family of submodules.
+* `direct_sum.decompose_ring_equiv 𝒜 : A ≃ₐ[R] ⨁ i, 𝒜 i`, a more bundled version of
+  `direct_sum.decompose 𝒜`.
+* `direct_sum.decompose_alg_equiv 𝒜 : A ≃ₐ[R] ⨁ i, 𝒜 i`, a more bundled version of
+  `direct_sum.decompose 𝒜`.
 * `graded_algebra.proj 𝒜 i` is the linear map from `A` to its degree `i : ι` component, such that
   `proj 𝒜 i x = decompose 𝒜 x i`.
-* `graded_algebra.support 𝒜 r` is the `finset ι` containing the `i : ι` such that the degree `i`
-  component of `r` is not zero.
 
 ## Implementation notes
 
@@ -39,11 +43,14 @@ graded algebra, graded ring, graded semiring, decomposition
 
 open_locale direct_sum big_operators
 
-section graded_algebra
-
-variables {ι R A : Type*}
+variables {ι R A σ : Type*}
+section graded_ring
 variables [decidable_eq ι] [add_monoid ι] [comm_semiring R] [semiring A] [algebra R A]
-variables (𝒜 : ι → submodule R A)
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ)
+
+include A
+
+open direct_sum
 
 /-- An internally-graded `R`-algebra `A` is one that can be decomposed into a collection
 of `submodule R A`s indexed by `ι` such that the canonical map `A → ⨁ i, 𝒜 i` is bijective and
@@ -54,15 +61,93 @@ Note that the fact that `A` is internally-graded, `graded_algebra 𝒜`, implies
 algebra structure `direct_sum.galgebra R (λ i, ↥(𝒜 i))`, which in turn makes available an
 `algebra R (⨁ i, 𝒜 i)` instance.
 -/
+class graded_ring (𝒜 : ι → σ) extends set_like.graded_monoid 𝒜, direct_sum.decomposition 𝒜.
+
+variables [graded_ring 𝒜]
+namespace direct_sum
+
+/-- If `A` is graded by `ι` with degree `i` component `𝒜 i`, then it is isomorphic as
+a ring to a direct sum of components. -/
+def decompose_ring_equiv : A ≃+* ⨁ i, 𝒜 i := ring_equiv.symm
+{ map_mul' := (coe_ring_hom 𝒜).map_mul,
+  map_add' := (coe_ring_hom 𝒜).map_add,
+  ..(decompose_add_equiv 𝒜).symm }
+
+@[simp] lemma decompose_one : decompose 𝒜 (1 : A) = 1 := map_one (decompose_ring_equiv 𝒜)
+@[simp] lemma decompose_symm_one : (decompose 𝒜).symm 1 = (1 : A) :=
+map_one (decompose_ring_equiv 𝒜).symm
+
+@[simp] lemma decompose_mul (x y : A) : decompose 𝒜 (x * y) = decompose 𝒜 x * decompose 𝒜 y :=
+map_mul (decompose_ring_equiv 𝒜) x y
+@[simp] lemma decompose_symm_mul (x y : ⨁ i, 𝒜 i) :
+  (decompose 𝒜).symm (x * y) = (decompose 𝒜).symm x * (decompose 𝒜).symm y :=
+map_mul (decompose_ring_equiv 𝒜).symm x y
+
+end direct_sum
+
+/-- The projection maps of a graded ring -/
+def graded_ring.proj (i : ι) : A →+ A :=
+(add_submonoid_class.subtype (𝒜 i)).comp $
+  (dfinsupp.eval_add_monoid_hom i).comp $
+  ring_hom.to_add_monoid_hom $ ring_equiv.to_ring_hom $ direct_sum.decompose_ring_equiv 𝒜
+
+@[simp] lemma graded_ring.proj_apply (i : ι) (r : A) :
+  graded_ring.proj 𝒜 i r = (decompose 𝒜 r : ⨁ i, 𝒜 i) i := rfl
+
+lemma graded_ring.proj_recompose (a : ⨁ i, 𝒜 i) (i : ι) :
+  graded_ring.proj 𝒜 i ((decompose 𝒜).symm a) =
+  (decompose 𝒜).symm (direct_sum.of _ i (a i)) :=
+by rw [graded_ring.proj_apply, decompose_symm_of, equiv.apply_symm_apply]
+
+lemma graded_ring.mem_support_iff [Π i (x : 𝒜 i), decidable (x ≠ 0)] (r : A) (i : ι) :
+  i ∈ (decompose 𝒜 r).support ↔ graded_ring.proj 𝒜 i r ≠ 0 :=
+dfinsupp.mem_support_iff.trans zero_mem_class.coe_eq_zero.not.symm
+
+end graded_ring
+
+section add_cancel_monoid
+
+open direct_sum
+
+variables [decidable_eq ι] [semiring A] [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ)
+variables {i j : ι}
+
+namespace direct_sum
+
+lemma coe_decompose_mul_add_of_left_mem
+  [add_left_cancel_monoid ι] [graded_ring 𝒜] {a b : A} (a_mem : a ∈ 𝒜 i) :
+  (decompose 𝒜 (a * b) (i + j) : A) = a * decompose 𝒜 b j :=
+by { lift a to 𝒜 i using a_mem, rw [decompose_mul, decompose_coe, coe_of_mul_apply_add] }
+
+lemma coe_decompose_mul_add_of_right_mem
+  [add_right_cancel_monoid ι] [graded_ring 𝒜] {a b : A} (b_mem : b ∈ 𝒜 j) :
+  (decompose 𝒜 (a * b) (i + j) : A) = decompose 𝒜 a i * b :=
+by { lift b to 𝒜 j using b_mem, rw [decompose_mul, decompose_coe, coe_mul_of_apply_add] }
+
+lemma decompose_mul_add_left
+  [add_left_cancel_monoid ι] [graded_ring 𝒜] (a : 𝒜 i) {b : A} :
+  decompose 𝒜 (↑a * b) (i + j) =
+    @graded_monoid.ghas_mul.mul ι (λ i, 𝒜 i) _ _ _ _ a (decompose 𝒜 b j) :=
+subtype.ext $ coe_decompose_mul_add_of_left_mem 𝒜 a.2
 
-class graded_algebra extends set_like.graded_monoid 𝒜 :=
-(decompose' : A → ⨁ i, 𝒜 i)
-(left_inv : function.left_inverse decompose' (direct_sum.submodule_coe 𝒜))
-(right_inv : function.right_inverse decompose' (direct_sum.submodule_coe 𝒜))
+lemma decompose_mul_add_right
+  [add_right_cancel_monoid ι] [graded_ring 𝒜] {a : A} (b : 𝒜 j) :
+  decompose 𝒜 (a * ↑b) (i + j) =
+    @graded_monoid.ghas_mul.mul ι (λ i, 𝒜 i) _ _ _ _ (decompose 𝒜 a i) b :=
+subtype.ext $ coe_decompose_mul_add_of_right_mem 𝒜 b.2
 
-lemma graded_algebra.is_internal [graded_algebra 𝒜] :
-  direct_sum.submodule_is_internal 𝒜 :=
-⟨graded_algebra.left_inv.injective, graded_algebra.right_inv.surjective⟩
+end direct_sum
+
+end add_cancel_monoid
+
+section graded_algebra
+variables [decidable_eq ι] [add_monoid ι] [comm_semiring R] [semiring A] [algebra R A]
+variables (𝒜 : ι → submodule R A)
+
+/-- A special case of `graded_ring` with `σ = submodule R A`. This is useful both because it
+can avoid typeclass search, and because it provides a more concise name. -/
+@[reducible]
+def graded_algebra := graded_ring 𝒜
 
 /-- A helper to construct a `graded_algebra` when the `set_like.graded_monoid` structure is already
 available. This makes the `left_inv` condition easier to prove, and phrases the `right_inv`
@@ -71,130 +156,125 @@ condition in a way that allows custom `@[ext]` lemmas to apply.
 See note [reducible non-instances]. -/
 @[reducible]
 def graded_algebra.of_alg_hom [set_like.graded_monoid 𝒜] (decompose : A →ₐ[R] ⨁ i, 𝒜 i)
-  (right_inv : (direct_sum.submodule_coe_alg_hom 𝒜).comp decompose = alg_hom.id R A)
+  (right_inv : (direct_sum.coe_alg_hom 𝒜).comp decompose = alg_hom.id R A)
   (left_inv : ∀ i (x : 𝒜 i), decompose (x : A) = direct_sum.of (λ i, ↥(𝒜 i)) i x) :
   graded_algebra 𝒜 :=
 { decompose' := decompose,
-  right_inv := alg_hom.congr_fun right_inv,
-  left_inv := begin
-    suffices : decompose.comp (direct_sum.submodule_coe_alg_hom 𝒜) = alg_hom.id _ _,
+  left_inv := alg_hom.congr_fun right_inv,
+  right_inv := begin
+    suffices : decompose.comp (direct_sum.coe_alg_hom 𝒜) = alg_hom.id _ _,
     from alg_hom.congr_fun this,
     ext i x : 2,
-    exact (decompose.congr_arg $ direct_sum.submodule_coe_alg_hom_of _ _ _).trans (left_inv i x),
+    exact (decompose.congr_arg $ direct_sum.coe_alg_hom_of _ _ _).trans (left_inv i x),
   end}
 
 variable [graded_algebra 𝒜]
 
+namespace direct_sum
+
 /-- If `A` is graded by `ι` with degree `i` component `𝒜 i`, then it is isomorphic as
 an algebra to a direct sum of components. -/
-def graded_algebra.decompose : A ≃ₐ[R] ⨁ i, 𝒜 i := alg_equiv.symm
-{ to_fun := direct_sum.submodule_coe_alg_hom 𝒜,
-  inv_fun := graded_algebra.decompose',
-  left_inv := graded_algebra.left_inv,
-  right_inv := graded_algebra.right_inv,
-  map_mul' := alg_hom.map_mul _,
-  map_add' := alg_hom.map_add _,
-  commutes' := alg_hom.commutes _ }
-
-@[simp] lemma graded_algebra.decompose'_def :
-  graded_algebra.decompose' = graded_algebra.decompose 𝒜 := rfl
-
-@[simp] lemma graded_algebra.decompose_symm_of {i : ι} (x : 𝒜 i) :
-  (graded_algebra.decompose 𝒜).symm (direct_sum.of _ i x) = x :=
-direct_sum.submodule_coe_alg_hom_of 𝒜 _ _
+@[simps]
+def decompose_alg_equiv : A ≃ₐ[R] ⨁ i, 𝒜 i := alg_equiv.symm
+{ map_mul' := (coe_alg_hom 𝒜).map_mul,
+  map_add' := (coe_alg_hom 𝒜).map_add,
+  commutes' := (coe_alg_hom 𝒜).commutes,
+  ..(decompose_add_equiv 𝒜).symm }
+
+end direct_sum
+
+open direct_sum
 
 /-- The projection maps of graded algebra-/
 def graded_algebra.proj (𝒜 : ι → submodule R A) [graded_algebra 𝒜] (i : ι) : A →ₗ[R] A :=
 (𝒜 i).subtype.comp $
   (dfinsupp.lapply i).comp $
-  (graded_algebra.decompose 𝒜).to_alg_hom.to_linear_map
+  (decompose_alg_equiv 𝒜).to_alg_hom.to_linear_map
 
 @[simp] lemma graded_algebra.proj_apply (i : ι) (r : A) :
-  graded_algebra.proj 𝒜 i r = (graded_algebra.decompose 𝒜 r : ⨁ i, 𝒜 i) i := rfl
-
-/-- The support of `r` is the `finset` where `proj R A i r ≠ 0 ↔ i ∈ r.support`-/
-def graded_algebra.support [Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0)]
-  (r : A) : finset ι :=
-(graded_algebra.decompose 𝒜 r).support
+  graded_algebra.proj 𝒜 i r = (decompose 𝒜 r : ⨁ i, 𝒜 i) i := rfl
 
 lemma graded_algebra.proj_recompose (a : ⨁ i, 𝒜 i) (i : ι) :
-  graded_algebra.proj 𝒜 i ((graded_algebra.decompose 𝒜).symm a) =
-  (graded_algebra.decompose 𝒜).symm (direct_sum.of _ i (a i)) :=
-by rw [graded_algebra.proj_apply, graded_algebra.decompose_symm_of, alg_equiv.apply_symm_apply]
-
-@[simp] lemma graded_algebra.decompose_coe {i : ι} (x : 𝒜 i) :
-  graded_algebra.decompose 𝒜 x = direct_sum.of _ i x :=
-by rw [←graded_algebra.decompose_symm_of, alg_equiv.apply_symm_apply]
-
-lemma graded_algebra.decompose_of_mem {x : A} {i : ι} (hx : x ∈ 𝒜 i) :
-  graded_algebra.decompose 𝒜 x = direct_sum.of _ i (⟨x, hx⟩ : 𝒜 i) :=
-graded_algebra.decompose_coe _ ⟨x, hx⟩
-
-lemma graded_algebra.decompose_of_mem_same {x : A} {i : ι} (hx : x ∈ 𝒜 i) :
-  (graded_algebra.decompose 𝒜 x i : A) = x :=
-by rw [graded_algebra.decompose_of_mem _ hx, direct_sum.of_eq_same, subtype.coe_mk]
-
-lemma graded_algebra.decompose_of_mem_ne {x : A} {i j : ι} (hx : x ∈ 𝒜 i) (hij : i ≠ j):
-  (graded_algebra.decompose 𝒜 x j : A) = 0 :=
-by rw [graded_algebra.decompose_of_mem _ hx, direct_sum.of_eq_of_ne _ _ _ _ hij, submodule.coe_zero]
-
-variable [Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0)]
-
-lemma graded_algebra.mem_support_iff (r : A) (i : ι) :
-  i ∈ graded_algebra.support 𝒜 r ↔ graded_algebra.proj 𝒜 i r ≠ 0 :=
-begin
-  rw [graded_algebra.support, dfinsupp.mem_support_iff, graded_algebra.proj_apply],
-  simp only [ne.def, submodule.coe_eq_zero],
-end
-
-lemma graded_algebra.sum_support_decompose (r : A) :
-  ∑ i in graded_algebra.support 𝒜 r, (graded_algebra.decompose 𝒜 r i : A) = r :=
-begin
-  conv_rhs { rw [←(graded_algebra.decompose 𝒜).symm_apply_apply r,
-    ←direct_sum.sum_support_of _ (graded_algebra.decompose 𝒜 r)] },
-  rw [alg_equiv.map_sum, graded_algebra.support],
-  simp_rw graded_algebra.decompose_symm_of,
-end
+  graded_algebra.proj 𝒜 i ((decompose 𝒜).symm a) =
+  (decompose 𝒜).symm (of _ i (a i)) :=
+by rw [graded_algebra.proj_apply, decompose_symm_of, equiv.apply_symm_apply]
+
+lemma graded_algebra.mem_support_iff [decidable_eq A] (r : A) (i : ι) :
+  i ∈ (decompose 𝒜 r).support ↔ graded_algebra.proj 𝒜 i r ≠ 0 :=
+dfinsupp.mem_support_iff.trans submodule.coe_eq_zero.not.symm
 
 end graded_algebra
 
 section canonical_order
 
-open graded_algebra set_like.graded_monoid direct_sum
+open set_like.graded_monoid direct_sum
 
-variables {ι R A : Type*}
-variables [comm_semiring R] [semiring A]
-variables [algebra R A] [decidable_eq ι]
+variables [semiring A] [decidable_eq ι]
 variables [canonically_ordered_add_monoid ι]
-variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
 
 /--
 If `A` is graded by a canonically ordered add monoid, then the projection map `x ↦ x₀` is a ring
 homomorphism.
 -/
 @[simps]
-def graded_algebra.proj_zero_ring_hom : A →+* A :=
+def graded_ring.proj_zero_ring_hom : A →+* A :=
 { to_fun := λ a, decompose 𝒜 a 0,
   map_one' := decompose_of_mem_same 𝒜 one_mem,
-  map_zero' := by simp only [subtype.ext_iff_val, map_zero, zero_apply, submodule.coe_zero],
-  map_add' := λ _ _, by simp [subtype.ext_iff_val, map_add, add_apply, submodule.coe_add],
-  map_mul' := λ x y,
-    have m : ∀ x, x ∈ supr 𝒜, from λ x, (is_internal 𝒜).supr_eq_top.symm ▸ submodule.mem_top,
-    begin
-    refine submodule.supr_induction 𝒜 (m x) (λ i c hc, _) _ _,
-    { refine submodule.supr_induction 𝒜 (m y) (λ j c' hc', _) _ _,
-      { by_cases h : i + j = 0,
-        { rw [decompose_of_mem_same 𝒜 (show c * c' ∈ 𝒜 0, from h ▸ mul_mem hc hc'),
-            decompose_of_mem_same 𝒜 (show c ∈ 𝒜 0, from (add_eq_zero_iff.mp h).1 ▸ hc),
-            decompose_of_mem_same 𝒜 (show c' ∈ 𝒜 0, from (add_eq_zero_iff.mp h).2 ▸ hc')] },
-        { rw [decompose_of_mem_ne 𝒜 (mul_mem hc hc') h],
-          cases (show i ≠ 0 ∨ j ≠ 0, by rwa [add_eq_zero_iff, not_and_distrib] at h) with h' h',
-          { simp only [decompose_of_mem_ne 𝒜 hc h', zero_mul] },
-          { simp only [decompose_of_mem_ne 𝒜 hc' h', mul_zero] } } },
-      { simp only [map_zero, zero_apply, submodule.coe_zero, mul_zero] },
-      { intros _ _ hd he, simp only [mul_add, map_add, add_apply, submodule.coe_add, hd, he] } },
-    { simp only [map_zero, zero_apply, submodule.coe_zero, zero_mul] },
-    { rintros _ _ ha hb, simp only [add_mul, map_add, add_apply, submodule.coe_add, ha, hb] },
+  map_zero' := by { rw decompose_zero, refl },
+  map_add' := λ _ _, by { rw decompose_add, refl },
+  map_mul' := begin
+    refine direct_sum.decomposition.induction_on 𝒜 (λ x, _) _ _,
+    { simp only [zero_mul, decompose_zero, zero_apply, zero_mem_class.coe_zero] },
+    { rintros i ⟨c, hc⟩,
+      refine direct_sum.decomposition.induction_on 𝒜 _ _ _,
+      { simp only [mul_zero, decompose_zero, zero_apply, zero_mem_class.coe_zero] },
+      { rintros j ⟨c', hc'⟩,
+        { simp only [subtype.coe_mk],
+          by_cases h : i + j = 0,
+          { rw [decompose_of_mem_same 𝒜 (show c * c' ∈ 𝒜 0, from h ▸ mul_mem hc hc'),
+              decompose_of_mem_same 𝒜 (show c ∈ 𝒜 0, from (add_eq_zero_iff.mp h).1 ▸ hc),
+              decompose_of_mem_same 𝒜 (show c' ∈ 𝒜 0, from (add_eq_zero_iff.mp h).2 ▸ hc')] },
+          { rw [decompose_of_mem_ne 𝒜 (mul_mem hc hc') h],
+            cases (show i ≠ 0 ∨ j ≠ 0, by rwa [add_eq_zero_iff, not_and_distrib] at h) with h' h',
+            { simp only [decompose_of_mem_ne 𝒜 hc h', zero_mul] },
+            { simp only [decompose_of_mem_ne 𝒜 hc' h', mul_zero] } } }, },
+      { intros _ _ hd he,
+        simp only [mul_add, decompose_add, add_apply, add_mem_class.coe_add, hd, he] }, },
+    { rintros _ _ ha hb _,
+      simp only [add_mul, decompose_add, add_apply, add_mem_class.coe_add, ha, hb], },
   end }
 
+variables {a b : A} {n i : ι}
+
+namespace direct_sum
+
+lemma coe_decompose_mul_of_left_mem_of_not_le
+  (a_mem : a ∈ 𝒜 i) (h : ¬ i ≤ n) : (decompose 𝒜 (a * b) n : A) = 0 :=
+by { lift a to 𝒜 i using a_mem, rwa [decompose_mul, decompose_coe, coe_of_mul_apply_of_not_le] }
+
+lemma coe_decompose_mul_of_right_mem_of_not_le
+  (b_mem : b ∈ 𝒜 i) (h : ¬ i ≤ n) : (decompose 𝒜 (a * b) n : A) = 0 :=
+by { lift b to 𝒜 i using b_mem, rwa [decompose_mul, decompose_coe, coe_mul_of_apply_of_not_le] }
+
+variables [has_sub ι] [has_ordered_sub ι] [contravariant_class ι ι (+) (≤)]
+
+lemma coe_decompose_mul_of_left_mem_of_le
+  (a_mem : a ∈ 𝒜 i) (h : i ≤ n) : (decompose 𝒜 (a * b) n : A) = a * decompose 𝒜 b (n - i) :=
+by { lift a to 𝒜 i using a_mem, rwa [decompose_mul, decompose_coe, coe_of_mul_apply_of_le] }
+
+lemma coe_decompose_mul_of_right_mem_of_le
+  (b_mem : b ∈ 𝒜 i) (h : i ≤ n) : (decompose 𝒜 (a * b) n : A) = decompose 𝒜 a (n - i) * b :=
+by { lift b to 𝒜 i using b_mem, rwa [decompose_mul, decompose_coe, coe_mul_of_apply_of_le] }
+
+lemma coe_decompose_mul_of_left_mem (n) [decidable (i ≤ n)] (a_mem : a ∈ 𝒜 i) :
+  (decompose 𝒜 (a * b) n : A) = if i ≤ n then a * decompose 𝒜 b (n - i) else 0 :=
+by { lift a to 𝒜 i using a_mem, rwa [decompose_mul, decompose_coe, coe_of_mul_apply] }
+
+lemma coe_decompose_mul_of_right_mem (n) [decidable (i ≤ n)] (b_mem : b ∈ 𝒜 i) :
+  (decompose 𝒜 (a * b) n : A) = if i ≤ n then decompose 𝒜 a (n - i) * b else 0 :=
+by { lift b to 𝒜 i using b_mem, rwa [decompose_mul, decompose_coe, coe_mul_of_apply] }
+
+end direct_sum
+
 end canonical_order
diff --git a/src/ring_theory/graded_algebra/homogeneous_ideal.lean b/src/ring_theory/graded_algebra/homogeneous_ideal.lean
index aa81e7fb4e9a9..535d934b73de8 100644
--- a/src/ring_theory/graded_algebra/homogeneous_ideal.lean
+++ b/src/ring_theory/graded_algebra/homogeneous_ideal.lean
@@ -10,13 +10,16 @@ import ring_theory.graded_algebra.basic
 /-!
 # Homogeneous ideals of a graded algebra
 
-This file defines homogeneous ideals of `graded_algebra 𝒜` where `𝒜 : ι → submodule R A` and
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines homogeneous ideals of `graded_ring 𝒜` where `𝒜 : ι → submodule R A` and
 operations on them.
 
 ## Main definitions
 
 For any `I : ideal A`:
-* `ideal.is_homogeneous 𝒜 I`: The property that an ideal is closed under `graded_algebra.proj`.
+* `ideal.is_homogeneous 𝒜 I`: The property that an ideal is closed under `graded_ring.proj`.
 * `homogeneous_ideal 𝒜`: The structure extending ideals which satisfy `ideal.is_homogeneous`
 * `ideal.homogeneous_core I 𝒜`: The largest homogeneous ideal smaller than `I`.
 * `ideal.homogeneous_hull I 𝒜`: The smallest homogeneous ideal larger than `I`.
@@ -41,19 +44,20 @@ graded algebra, homogeneous
 open set_like direct_sum set
 open_locale big_operators pointwise direct_sum
 
-variables {ι R A : Type*}
+variables {ι σ R A : Type*}
 
 section homogeneous_def
 
-variables [comm_semiring R] [semiring A] [algebra R A]
-variables (𝒜 : ι → submodule R A)
-variables [decidable_eq ι] [add_monoid ι] [graded_algebra 𝒜]
+variables [semiring A]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ)
+variables [decidable_eq ι] [add_monoid ι] [graded_ring 𝒜]
 variable (I : ideal A)
+include A
 
 /--An `I : ideal A` is homogeneous if for every `r ∈ I`, all homogeneous components
   of `r` are in `I`.-/
 def ideal.is_homogeneous : Prop :=
-∀ (i : ι) ⦃r : A⦄, r ∈ I → (graded_algebra.decompose 𝒜 r i : A) ∈ I
+∀ (i : ι) ⦃r : A⦄, r ∈ I → (direct_sum.decompose 𝒜 r i : A) ∈ I
 
 /-- For any `semiring A`, we collect the homogeneous ideals of `A` into a type. -/
 structure homogeneous_ideal extends submodule A A :=
@@ -84,13 +88,14 @@ end homogeneous_def
 
 section homogeneous_core
 
-variables [comm_semiring R] [semiring A] [algebra R A]
-variables (𝒜 : ι → submodule R A)
+variables [semiring A]
+variables [set_like σ A]  (𝒜 : ι → σ)
 variable (I : ideal A)
+include A
 
 /-- For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_core' 𝒜`
 is the largest homogeneous ideal of `A` contained in `I`, as an ideal. -/
-def ideal.homogeneous_core' : ideal A :=
+def ideal.homogeneous_core' (I : ideal A) : ideal A :=
 ideal.span (coe '' ((coe : subtype (is_homogeneous 𝒜) → A) ⁻¹' I))
 
 lemma ideal.homogeneous_core'_mono : monotone (ideal.homogeneous_core' 𝒜) :=
@@ -103,32 +108,33 @@ end homogeneous_core
 
 section is_homogeneous_ideal_defs
 
-variables [comm_semiring R] [semiring A] [algebra R A]
-variables (𝒜 : ι → submodule R A)
-variables [decidable_eq ι] [add_monoid ι] [graded_algebra 𝒜]
+variables [semiring A]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ)
+variables [decidable_eq ι] [add_monoid ι] [graded_ring 𝒜]
 variable (I : ideal A)
+include A
 
 lemma ideal.is_homogeneous_iff_forall_subset :
-  I.is_homogeneous 𝒜 ↔ ∀ i, (I : set A) ⊆ graded_algebra.proj 𝒜 i ⁻¹' I :=
+  I.is_homogeneous 𝒜 ↔ ∀ i, (I : set A) ⊆ graded_ring.proj 𝒜 i ⁻¹' I :=
 iff.rfl
 
 lemma ideal.is_homogeneous_iff_subset_Inter :
-  I.is_homogeneous 𝒜 ↔ (I : set A) ⊆ ⋂ i, graded_algebra.proj 𝒜 i ⁻¹' ↑I :=
+  I.is_homogeneous 𝒜 ↔ (I : set A) ⊆ ⋂ i, graded_ring.proj 𝒜 i ⁻¹' ↑I :=
 subset_Inter_iff.symm
 
 lemma ideal.mul_homogeneous_element_mem_of_mem
   {I : ideal A} (r x : A) (hx₁ : is_homogeneous 𝒜 x) (hx₂ : x ∈ I) (j : ι) :
-  graded_algebra.proj 𝒜 j (r * x) ∈ I :=
+  graded_ring.proj 𝒜 j (r * x) ∈ I :=
 begin
-  letI : Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0) := λ _ _, classical.dec _,
-  rw [←graded_algebra.sum_support_decompose 𝒜 r, finset.sum_mul, linear_map.map_sum],
+  classical,
+  rw [←direct_sum.sum_support_decompose 𝒜 r, finset.sum_mul, map_sum],
   apply ideal.sum_mem,
   intros k hk,
   obtain ⟨i, hi⟩ := hx₁,
-  have mem₁ : (graded_algebra.decompose 𝒜 r k : A) * x ∈ 𝒜 (k + i) := graded_monoid.mul_mem
-    (submodule.coe_mem _) hi,
-  erw [graded_algebra.proj_apply, graded_algebra.decompose_of_mem 𝒜 mem₁,
-    coe_of_submodule_apply 𝒜, submodule.coe_mk],
+  have mem₁ : (direct_sum.decompose 𝒜 r k : A) * x ∈ 𝒜 (k + i) := graded_monoid.mul_mem
+    (set_like.coe_mem _) hi,
+  erw [graded_ring.proj_apply, direct_sum.decompose_of_mem 𝒜 mem₁,
+    coe_of_apply, set_like.coe_mk],
   split_ifs,
   { exact I.mul_mem_left _ hx₂ },
   { exact I.zero_mem },
@@ -141,7 +147,8 @@ begin
   rw [ideal.span, finsupp.span_eq_range_total] at hr,
   rw linear_map.mem_range at hr,
   obtain ⟨s, rfl⟩ := hr,
-  rw [←graded_algebra.proj_apply, finsupp.total_apply, finsupp.sum, linear_map.map_sum],
+  rw [finsupp.total_apply, finsupp.sum, decompose_sum, dfinsupp.finset_sum_apply,
+    add_submonoid_class.coe_finset_sum],
   refine ideal.sum_mem _ _,
   rintros z hz1,
   rw [smul_eq_mul],
@@ -174,8 +181,8 @@ lemma ideal.is_homogeneous.to_ideal_homogeneous_core_eq_self (h : I.is_homogeneo
 begin
   apply le_antisymm (I.homogeneous_core'_le 𝒜) _,
   intros x hx,
-  letI : Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0) := λ _ _, classical.dec _,
-  rw ←graded_algebra.sum_support_decompose 𝒜 x,
+  classical,
+  rw ←direct_sum.sum_support_decompose 𝒜 x,
   exact ideal.sum_mem _ (λ j hj, ideal.subset_span ⟨⟨_, is_homogeneous_coe _⟩, h _ hx, rfl⟩)
 end
 
@@ -207,16 +214,16 @@ section operations
 
 section semiring
 
-variables [comm_semiring R] [semiring A] [algebra R A]
-variables [decidable_eq ι] [add_monoid ι]
-variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
+variables [semiring A] [decidable_eq ι] [add_monoid ι]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
+include A
 
 namespace ideal.is_homogeneous
 
 lemma bot : ideal.is_homogeneous 𝒜 ⊥ := λ i r hr,
 begin
   simp only [ideal.mem_bot] at hr,
-  rw [hr, alg_equiv.map_zero, zero_apply],
+  rw [hr, decompose_zero, zero_apply],
   apply ideal.zero_mem
 end
 
@@ -352,10 +359,11 @@ end homogeneous_ideal
 end semiring
 
 section comm_semiring
-variables [comm_semiring R] [comm_semiring A] [algebra R A]
+variables [comm_semiring A]
 variables [decidable_eq ι] [add_monoid ι]
-variables {𝒜 : ι → submodule R A} [graded_algebra 𝒜]
+variables [set_like σ A] [add_submonoid_class σ A] {𝒜 : ι → σ} [graded_ring 𝒜]
 variable (I : ideal A)
+include A
 
 lemma ideal.is_homogeneous.mul {I J : ideal A}
   (HI : I.is_homogeneous 𝒜) (HJ : J.is_homogeneous 𝒜) : (I * J).is_homogeneous 𝒜 :=
@@ -387,10 +395,10 @@ section homogeneous_core
 
 open homogeneous_ideal
 
-variables [comm_semiring R] [semiring A]
-variables [algebra R A] [decidable_eq ι] [add_monoid ι]
-variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
+variables [semiring A] [decidable_eq ι] [add_monoid ι]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
 variable (I : ideal A)
+include A
 
 lemma ideal.homogeneous_core.gc : galois_connection to_ideal (ideal.homogeneous_core 𝒜) :=
 λ I J, ⟨
@@ -430,15 +438,15 @@ section homogeneous_hull
 
 open homogeneous_ideal
 
-variables [comm_semiring R] [semiring A]
-variables [algebra R A] [decidable_eq ι] [add_monoid ι]
-variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
+variables [semiring A] [decidable_eq ι] [add_monoid ι]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
 variable (I : ideal A)
+include A
 
 /--For any `I : ideal A`, not necessarily homogeneous, `I.homogeneous_hull 𝒜` is
 the smallest homogeneous ideal containing `I`. -/
 def ideal.homogeneous_hull : homogeneous_ideal 𝒜 :=
-⟨ideal.span {r : A | ∃ (i : ι) (x : I), (graded_algebra.decompose 𝒜 x i : A) = r}, begin
+⟨ideal.span {r : A | ∃ (i : ι) (x : I), (direct_sum.decompose 𝒜 (x : A) i : A) = r}, begin
   refine ideal.is_homogeneous_span _ _ (λ x hx, _),
   obtain ⟨i, x, rfl⟩ := hx,
   apply set_like.is_homogeneous_coe
@@ -448,8 +456,8 @@ lemma ideal.le_to_ideal_homogeneous_hull :
   I ≤ (ideal.homogeneous_hull 𝒜 I).to_ideal :=
 begin
   intros r hr,
-  letI : Π (i : ι) (x : 𝒜 i), decidable (x ≠ 0) := λ _ _, classical.dec _,
-  rw [←graded_algebra.sum_support_decompose 𝒜 r],
+  classical,
+  rw [←direct_sum.sum_support_decompose 𝒜 r],
   refine ideal.sum_mem _ _, intros j hj,
   apply ideal.subset_span, use j, use ⟨r, hr⟩, refl,
 end
@@ -479,18 +487,18 @@ homogeneous_ideal.to_ideal_injective $ I.is_homogeneous.to_ideal_homogeneous_hul
 variables (I 𝒜)
 
 lemma ideal.to_ideal_homogeneous_hull_eq_supr :
-  (I.homogeneous_hull 𝒜).to_ideal = ⨆ i, ideal.span (graded_algebra.proj 𝒜 i '' I) :=
+  (I.homogeneous_hull 𝒜).to_ideal = ⨆ i, ideal.span (graded_ring.proj 𝒜 i '' I) :=
 begin
   rw ←ideal.span_Union,
   apply congr_arg ideal.span _,
   ext1,
-  simp only [set.mem_Union, set.mem_image, mem_set_of_eq, graded_algebra.proj_apply,
+  simp only [set.mem_Union, set.mem_image, mem_set_of_eq, graded_ring.proj_apply,
     set_like.exists, exists_prop, subtype.coe_mk, set_like.mem_coe],
 end
 
 lemma ideal.homogeneous_hull_eq_supr :
   (I.homogeneous_hull 𝒜) =
-  ⨆ i, ⟨ideal.span (graded_algebra.proj 𝒜 i '' I), ideal.is_homogeneous_span 𝒜 _
+  ⨆ i, ⟨ideal.span (graded_ring.proj 𝒜 i '' I), ideal.is_homogeneous_span 𝒜 _
     (by {rintros _ ⟨x, -, rfl⟩, apply set_like.is_homogeneous_coe})⟩ :=
 by { ext1, rw [ideal.to_ideal_homogeneous_hull_eq_supr, to_ideal_supr], refl }
 
@@ -500,9 +508,9 @@ section galois_connection
 
 open homogeneous_ideal
 
-variables [comm_semiring R] [semiring A]
-variables [algebra R A] [decidable_eq ι] [add_monoid ι]
-variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
+variables [semiring A] [decidable_eq ι] [add_monoid ι]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
+include A
 
 lemma ideal.homogeneous_hull.gc : galois_connection (ideal.homogeneous_hull 𝒜) to_ideal :=
 λ I J, ⟨
@@ -525,12 +533,13 @@ end galois_connection
 
 section irrelevant_ideal
 
-variables [comm_semiring R] [semiring A]
-variables [algebra R A] [decidable_eq ι]
+variables [semiring A]
+variables [decidable_eq ι]
 variables [canonically_ordered_add_monoid ι]
-variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
+variables [set_like σ A] [add_submonoid_class σ A] (𝒜 : ι → σ) [graded_ring 𝒜]
+include A
 
-open graded_algebra set_like.graded_monoid direct_sum
+open graded_ring set_like.graded_monoid direct_sum
 
 /--
 For a graded ring `⨁ᵢ 𝒜ᵢ` graded by a `canonically_ordered_add_monoid ι`, the irrelevant ideal
@@ -544,17 +553,17 @@ of irrelevant ideal makes sense in a more general setting by defining it as the
 with `0` as i-th coordinate for all `i ≤ 0`, i.e. `{a | ∀ (i : ι), i ≤ 0 → aᵢ = 0}`.
 -/
 def homogeneous_ideal.irrelevant : homogeneous_ideal 𝒜 :=
-⟨(graded_algebra.proj_zero_ring_hom 𝒜).ker, λ i r (hr : (decompose 𝒜 r 0 : A) = 0), begin
-  change (decompose 𝒜 (decompose 𝒜 r _) 0 : A) = 0,
+⟨(graded_ring.proj_zero_ring_hom 𝒜).ker, λ i r (hr : (decompose 𝒜 r 0 : A) = 0), begin
+  change (decompose 𝒜 (decompose 𝒜 r _ : A) 0 : A) = 0,
   by_cases h : i = 0,
-  { rw [h, hr, map_zero, zero_apply, submodule.coe_zero] },
-  { rw [decompose_of_mem_ne 𝒜 (submodule.coe_mem _) h] }
+  { rw [h, hr, decompose_zero, zero_apply, zero_mem_class.coe_zero] },
+  { rw [decompose_of_mem_ne 𝒜 (set_like.coe_mem _) h] }
 end⟩
 
 @[simp] lemma homogeneous_ideal.mem_irrelevant_iff (a : A) :
   a ∈ homogeneous_ideal.irrelevant 𝒜 ↔ proj 𝒜 0 a = 0 := iff.rfl
 
 @[simp] lemma homogeneous_ideal.to_ideal_irrelevant :
-  (homogeneous_ideal.irrelevant 𝒜).to_ideal = (graded_algebra.proj_zero_ring_hom 𝒜).ker := rfl
+  (homogeneous_ideal.irrelevant 𝒜).to_ideal = (graded_ring.proj_zero_ring_hom 𝒜).ker := rfl
 
 end irrelevant_ideal
diff --git a/src/ring_theory/graded_algebra/homogeneous_localization.lean b/src/ring_theory/graded_algebra/homogeneous_localization.lean
index cae0fdc564539..0fcacd0ccbdc9 100644
--- a/src/ring_theory/graded_algebra/homogeneous_localization.lean
+++ b/src/ring_theory/graded_algebra/homogeneous_localization.lean
@@ -9,12 +9,15 @@ import ring_theory.graded_algebra.basic
 /-!
 # Homogeneous Localization
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Notation
 - `ι` is a commutative monoid;
 - `R` is a commutative semiring;
 - `A` is a commutative ring and an `R`-algebra;
 - `𝒜 : ι → submodule R A` is the grading of `A`;
-- `x : ideal A` is a prime ideal.
+- `x : submonoid A` is a submonoid
 
 ## Main definitions and results
 
@@ -29,7 +32,7 @@ is a `num_denom_same_deg`, then generally, `c + (-c)` is not necessarily `0` for
 `0` is considered to have grade zero (see `deg_zero`) but `c + (-c)` has the same degree as `c`. To
 circumvent this, we quotient `num_denom_same_deg 𝒜 x` by the kernel of `c ↦ c.num / c.denom`.
 
-* `homogeneous_localization.num_denom_same_deg.embedding` : for `x : prime ideal of A` and any
+* `homogeneous_localization.num_denom_same_deg.embedding` : for `x : submonoid A` and any
   `c : num_denom_same_deg 𝒜 x`, or equivalent a numerator and a denominator of the same degree,
   we get an element `c.num / c.denom` of `Aₓ`.
 * `homogeneous_localization`: `num_denom_same_deg 𝒜 x` quotiented by kernel of `embedding 𝒜 x`.
@@ -38,19 +41,20 @@ circumvent this, we quotient `num_denom_same_deg 𝒜 x` by the kernel of `c ↦
   through `homogeneous_localization.val`.
 * `homogeneous_localization.num`: if `f : homogeneous_localization 𝒜 x`, then `f.num : A` is the
   numerator of `f`.
-* `homogeneous_localization.num`: if `f : homogeneous_localization 𝒜 x`, then `f.denom : A` is the
+* `homogeneous_localization.denom`: if `f : homogeneous_localization 𝒜 x`, then `f.denom : A` is the
   denominator of `f`.
 * `homogeneous_localization.deg`: if `f : homogeneous_localization 𝒜 x`, then `f.deg : ι` is the
   degree of `f` such that `f.num ∈ 𝒜 f.deg` and `f.denom ∈ 𝒜 f.deg`
-  (see `homogeneous_localization.num_mem` and `homogeneous_localization.denom_mem`).
-* `homogeneous_localization.num_mem`: if `f : homogeneous_localization 𝒜 x`, then `f.num_mem` is a
-  proof that `f.num ∈ f.deg`.
-* `homogeneous_localization.denom_mem`: if `f : homogeneous_localization 𝒜 x`, then `f.denom_mem`
-  is a proof that `f.denom ∈ f.deg`.
+  (see `homogeneous_localization.num_mem_deg` and `homogeneous_localization.denom_mem_deg`).
+* `homogeneous_localization.num_mem_deg`: if `f : homogeneous_localization 𝒜 x`, then
+  `f.num_mem_deg` is a proof that `f.num ∈ 𝒜 f.deg`.
+* `homogeneous_localization.denom_mem_deg`: if `f : homogeneous_localization 𝒜 x`, then
+  `f.denom_mem_deg` is a proof that `f.denom ∈ 𝒜 f.deg`.
 * `homogeneous_localization.eq_num_div_denom`: if `f : homogeneous_localization 𝒜 x`, then
   `f.val : Aₓ` is equal to `f.num / f.denom`.
 
-* `homogeneous_localization.local_ring`: `homogeneous_localization 𝒜 x` is a local ring.
+* `homogeneous_localization.local_ring`: `homogeneous_localization 𝒜 x` is a local ring when `x` is
+  the complement of some prime ideals.
 
 ## References
 
@@ -68,22 +72,22 @@ variables {ι R A: Type*}
 variables [add_comm_monoid ι] [decidable_eq ι]
 variables [comm_ring R] [comm_ring A] [algebra R A]
 variables (𝒜 : ι → submodule R A) [graded_algebra 𝒜]
-variables (x : ideal A) [ideal.is_prime x]
+variables (x : submonoid A)
 
-local notation `at ` x := localization.at_prime x
+local notation `at ` x := localization x
 
 namespace homogeneous_localization
 
 section
 /--
-Let `x` be a prime ideal, then `num_denom_same_deg 𝒜 x` is a structure with a numerator and a
-denominator with same grading such that the denominator is not contained in `x`.
+Let `x` be a submonoid of `A`, then `num_denom_same_deg 𝒜 x` is a structure with a numerator and a
+denominator with same grading such that the denominator is contained in `x`.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure num_denom_same_deg :=
 (deg : ι)
 (num denom : 𝒜 deg)
-(denom_not_mem : (denom : A) ∉ x)
+(denom_mem : (denom : A) ∈ x)
 
 end
 
@@ -99,8 +103,7 @@ begin
   rcases c1 with ⟨i1, ⟨n1, hn1⟩, ⟨d1, hd1⟩, h1⟩,
   rcases c2 with ⟨i2, ⟨n2, hn2⟩, ⟨d2, hd2⟩, h2⟩,
   dsimp only [subtype.coe_mk] at *,
-  simp only,
-  exact ⟨hdeg, by subst hdeg; subst hnum, by subst hdeg; subst hdenom⟩,
+  simp only, exact ⟨hdeg, by subst hdeg; subst hnum, by subst hdeg; subst hdenom⟩,
 end
 
 instance : has_one (num_denom_same_deg 𝒜 x) :=
@@ -108,14 +111,14 @@ instance : has_one (num_denom_same_deg 𝒜 x) :=
   { deg := 0,
     num := ⟨1, one_mem⟩,
     denom := ⟨1, one_mem⟩,
-    denom_not_mem := λ r, (infer_instance : x.is_prime).ne_top $ x.eq_top_iff_one.mpr r } }
+    denom_mem := submonoid.one_mem _ } }
 
 @[simp] lemma deg_one : (1 : num_denom_same_deg 𝒜 x).deg = 0 := rfl
 @[simp] lemma num_one : ((1 : num_denom_same_deg 𝒜 x).num : A) = 1 := rfl
 @[simp] lemma denom_one : ((1 : num_denom_same_deg 𝒜 x).denom : A) = 1 := rfl
 
 instance : has_zero (num_denom_same_deg 𝒜 x) :=
-{ zero := ⟨0, 0, ⟨1, one_mem⟩, λ r, (infer_instance : x.is_prime).ne_top $ x.eq_top_iff_one.mpr r⟩ }
+{ zero := ⟨0, 0, ⟨1, one_mem⟩, submonoid.one_mem _⟩ }
 
 @[simp] lemma deg_zero : (0 : num_denom_same_deg 𝒜 x).deg = 0 := rfl
 @[simp] lemma num_zero : (0 : num_denom_same_deg 𝒜 x).num = 0 := rfl
@@ -126,8 +129,7 @@ instance : has_mul (num_denom_same_deg 𝒜 x) :=
   { deg := p.deg + q.deg,
     num := ⟨p.num * q.num, mul_mem p.num.prop q.num.prop⟩,
     denom := ⟨p.denom * q.denom, mul_mem p.denom.prop q.denom.prop⟩,
-    denom_not_mem := λ r, or.elim
-      ((infer_instance : x.is_prime).mem_or_mem r) p.denom_not_mem q.denom_not_mem } }
+    denom_mem := submonoid.mul_mem _ p.denom_mem q.denom_mem } }
 
 @[simp] lemma deg_mul (c1 c2 : num_denom_same_deg 𝒜 x) : (c1 * c2).deg = c1.deg + c2.deg := rfl
 @[simp] lemma num_mul (c1 c2 : num_denom_same_deg 𝒜 x) :
@@ -142,8 +144,7 @@ instance : has_add (num_denom_same_deg 𝒜 x) :=
       add_mem (mul_mem c1.denom.2 c2.num.2)
         (add_comm c2.deg c1.deg ▸ mul_mem c2.denom.2 c1.num.2)⟩,
     denom := ⟨c1.denom * c2.denom, mul_mem c1.denom.2 c2.denom.2⟩,
-    denom_not_mem := λ r, or.elim
-      ((infer_instance : x.is_prime).mem_or_mem r) c1.denom_not_mem c2.denom_not_mem } }
+    denom_mem := submonoid.mul_mem _ c1.denom_mem c2.denom_mem } }
 
 @[simp] lemma deg_add (c1 c2 : num_denom_same_deg 𝒜 x) : (c1 + c2).deg = c1.deg + c2.deg := rfl
 @[simp] lemma num_add (c1 c2 : num_denom_same_deg 𝒜 x) :
@@ -152,7 +153,7 @@ instance : has_add (num_denom_same_deg 𝒜 x) :=
   ((c1 + c2).denom : A) = c1.denom * c2.denom := rfl
 
 instance : has_neg (num_denom_same_deg 𝒜 x) :=
-{ neg := λ c, ⟨c.deg, ⟨-c.num, neg_mem c.num.2⟩, c.denom, c.denom_not_mem⟩ }
+{ neg := λ c, ⟨c.deg, ⟨-c.num, neg_mem c.num.2⟩, c.denom, c.denom_mem⟩ }
 
 @[simp] lemma deg_neg (c : num_denom_same_deg 𝒜 x) : (-c).deg = c.deg := rfl
 @[simp] lemma num_neg (c : num_denom_same_deg 𝒜 x) : ((-c).num : A) = -c.num := rfl
@@ -167,13 +168,13 @@ instance : comm_monoid (num_denom_same_deg 𝒜 x) :=
   mul_comm := λ c1 c2, ext _ (add_comm _ _) (mul_comm _ _) (mul_comm _ _) }
 
 instance : has_pow (num_denom_same_deg 𝒜 x) ℕ :=
-{ pow := λ c n, ⟨n • c.deg, ⟨c.num ^ n, pow_mem n c.num.2⟩, ⟨c.denom ^ n, pow_mem n c.denom.2⟩,
+{ pow := λ c n, ⟨n • c.deg,
+    @graded_monoid.gmonoid.gnpow _ (λ i, ↥(𝒜 i)) _ _ n _ c.num,
+    @graded_monoid.gmonoid.gnpow _ (λ i, ↥(𝒜 i)) _ _ n _ c.denom,
     begin
-      cases n,
-      { simp only [pow_zero],
-        exact λ r, (infer_instance : x.is_prime).ne_top $ (ideal.eq_top_iff_one _).mpr r, },
-      { exact λ r, c.denom_not_mem $
-          ((infer_instance : x.is_prime).pow_mem_iff_mem n.succ (nat.zero_lt_succ _)).mp r }
+      induction n with n ih,
+      { simpa only [coe_gnpow, pow_zero] using submonoid.one_mem _ },
+      { simpa only [pow_succ', coe_gnpow] using x.mul_mem ih c.denom_mem, },
     end⟩ }
 
 @[simp] lemma deg_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) : (c ^ n).deg = n • c.deg := rfl
@@ -181,18 +182,18 @@ instance : has_pow (num_denom_same_deg 𝒜 x) ℕ :=
 @[simp] lemma denom_pow (c : num_denom_same_deg 𝒜 x) (n : ℕ) :
   ((c ^ n).denom : A) = c.denom ^ n := rfl
 
-section has_scalar
-variables {α : Type*} [has_scalar α R] [has_scalar α A] [is_scalar_tower α R A]
+section has_smul
+variables {α : Type*} [has_smul α R] [has_smul α A] [is_scalar_tower α R A]
 
-instance : has_scalar α (num_denom_same_deg 𝒜 x) :=
-{ smul := λ m c, ⟨c.deg, m • c.num, c.denom, c.denom_not_mem⟩ }
+instance : has_smul α (num_denom_same_deg 𝒜 x) :=
+{ smul := λ m c, ⟨c.deg, m • c.num, c.denom, c.denom_mem⟩ }
 
 @[simp] lemma deg_smul (c : num_denom_same_deg 𝒜 x) (m : α) : (m • c).deg = c.deg := rfl
 @[simp] lemma num_smul (c : num_denom_same_deg 𝒜 x) (m : α) : ((m • c).num : A) = m • c.num := rfl
 @[simp] lemma denom_smul (c : num_denom_same_deg 𝒜 x) (m : α) :
   ((m • c).denom : A) = c.denom := rfl
 
-end has_scalar
+end has_smul
 
 variable (𝒜)
 
@@ -201,7 +202,7 @@ For `x : prime ideal of A` and any `p : num_denom_same_deg 𝒜 x`, or equivalen
 denominator of the same degree, we get an element `p.num / p.denom` of `Aₓ`.
 -/
 def embedding (p : num_denom_same_deg 𝒜 x) : at x :=
-localization.mk p.num ⟨p.denom, p.denom_not_mem⟩
+localization.mk p.num ⟨p.denom, p.denom_mem⟩
 
 end num_denom_same_deg
 
@@ -212,7 +213,7 @@ For `x : prime ideal of A`, `homogeneous_localization 𝒜 x` is `num_denom_same
 kernel of `embedding 𝒜 x`. This is essentially the subring of `Aₓ` where the numerator and
 denominator share the same grading.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def homogeneous_localization : Type* :=
 quotient (setoid.ker $ homogeneous_localization.num_denom_same_deg.embedding 𝒜 x)
 
@@ -229,12 +230,12 @@ def val (y : homogeneous_localization 𝒜 x) : at x :=
 quotient.lift_on' y (num_denom_same_deg.embedding 𝒜 x) $ λ _ _, id
 
 @[simp] lemma val_mk' (i : num_denom_same_deg 𝒜 x) :
-  val (quotient.mk' i) = localization.mk i.num ⟨i.denom, i.denom_not_mem⟩ :=
+  val (quotient.mk' i) = localization.mk i.num ⟨i.denom, i.denom_mem⟩ :=
 rfl
 
 variable (x)
 lemma val_injective :
-  function.injective (@homogeneous_localization.val _ _ _ _ _ _ _ _ 𝒜 _ x _) :=
+  function.injective (@homogeneous_localization.val _ _ _ _ _ _ _ _ 𝒜 _ x) :=
 λ a b, quotient.rec_on_subsingleton₂' a b $ λ a b h, quotient.sound' h
 
 instance has_pow : has_pow (homogeneous_localization 𝒜 x) ℕ :=
@@ -247,11 +248,11 @@ instance has_pow : has_pow (homogeneous_localization 𝒜 x) ℕ :=
       refl,
     end) : homogeneous_localization 𝒜 x → homogeneous_localization 𝒜 x) z }
 
-section has_scalar
-variables {α : Type*} [has_scalar α R] [has_scalar α A] [is_scalar_tower α R A]
+section has_smul
+variables {α : Type*} [has_smul α R] [has_smul α A] [is_scalar_tower α R A]
 variables [is_scalar_tower α A A]
 
-instance : has_scalar α (homogeneous_localization 𝒜 x) :=
+instance : has_smul α (homogeneous_localization 𝒜 x) :=
 { smul := λ m, quotient.map' ((•) m)
     (λ c1 c2 (h : localization.mk _ _ = localization.mk _ _), begin
       change localization.mk _ _ = localization.mk _ _,
@@ -265,7 +266,7 @@ instance : has_scalar α (homogeneous_localization 𝒜 x) :=
   (n • y).val = n • y.val :=
 begin
   induction y using quotient.induction_on,
-  unfold homogeneous_localization.val has_scalar.smul,
+  unfold homogeneous_localization.val has_smul.smul,
   simp only [quotient.lift_on₂'_mk, quotient.lift_on'_mk],
   change localization.mk _ _ = n • localization.mk _ _,
   dsimp only,
@@ -273,7 +274,7 @@ begin
   congr' 1,
 end
 
-end has_scalar
+end has_smul
 
 instance : has_neg (homogeneous_localization 𝒜 x) :=
 { neg := quotient.map' has_neg.neg
@@ -379,9 +380,29 @@ begin
   congr' 1,
 end
 
-instance : comm_ring (homogeneous_localization 𝒜 x) :=
+instance : has_nat_cast (homogeneous_localization 𝒜 x) := ⟨nat.unary_cast⟩
+instance : has_int_cast (homogeneous_localization 𝒜 x) := ⟨int.cast_def⟩
+
+@[simp] lemma nat_cast_val (n : ℕ) : (n : homogeneous_localization 𝒜 x).val = n :=
+show val (nat.unary_cast n) = _, by induction n; simp [nat.unary_cast, zero_val, one_val, *]
+
+@[simp] lemma int_cast_val (n : ℤ) : (n : homogeneous_localization 𝒜 x).val = n :=
+show val (int.cast_def n) = _, by cases n; simp [int.cast_def, zero_val, one_val, *]
+
+instance homogenous_localization_comm_ring : comm_ring (homogeneous_localization 𝒜 x) :=
 (homogeneous_localization.val_injective x).comm_ring _ zero_val one_val add_val mul_val neg_val
-  sub_val (λ z n, smul_val x z n) (λ z n, smul_val x z n) pow_val
+  sub_val (λ z n, smul_val x z n) (λ z n, smul_val x z n) pow_val nat_cast_val int_cast_val
+
+instance homogeneous_localization_algebra :
+  algebra (homogeneous_localization 𝒜 x) (localization x) :=
+{ smul := λ p q, p.val * q,
+  to_fun := val,
+  map_one' := one_val,
+  map_mul' := mul_val,
+  map_zero' := zero_val,
+  map_add' := add_val,
+  commutes' := λ p q, mul_comm _ _,
+  smul_def' := λ p q, rfl }
 
 end homogeneous_localization
 
@@ -404,18 +425,18 @@ def denom (f : homogeneous_localization 𝒜 x) : A :=
 def deg (f : homogeneous_localization 𝒜 x) : ι :=
 (quotient.out' f).deg
 
-lemma denom_not_mem (f : homogeneous_localization 𝒜 x) :
-  f.denom ∉ x :=
-(quotient.out' f).denom_not_mem
+lemma denom_mem (f : homogeneous_localization 𝒜 x) :
+  f.denom ∈ x :=
+(quotient.out' f).denom_mem
 
-lemma num_mem (f : homogeneous_localization 𝒜 x) : f.num ∈ 𝒜 f.deg :=
+lemma num_mem_deg (f : homogeneous_localization 𝒜 x) : f.num ∈ 𝒜 f.deg :=
 (quotient.out' f).num.2
 
-lemma denom_mem (f : homogeneous_localization 𝒜 x) : f.denom ∈ 𝒜 f.deg :=
+lemma denom_mem_deg (f : homogeneous_localization 𝒜 x) : f.denom ∈ 𝒜 f.deg :=
 (quotient.out' f).denom.2
 
 lemma eq_num_div_denom (f : homogeneous_localization 𝒜 x) :
-  f.val = localization.mk f.num ⟨f.denom, f.denom_not_mem⟩ :=
+  f.val = localization.mk f.num ⟨f.denom, f.denom_mem⟩ :=
 begin
   have := (quotient.out_eq' f),
   apply_fun homogeneous_localization.val at this,
@@ -435,7 +456,14 @@ lemma ext_iff_val (f g : homogeneous_localization 𝒜 x) : f = g ↔ f.val = g.
     simpa only [quotient.lift_on'_mk] using h,
   end }
 
-lemma is_unit_iff_is_unit_val (f : homogeneous_localization 𝒜 x) :
+section
+
+variables (𝒜) (𝔭 : ideal A) [ideal.is_prime 𝔭]
+
+/--Localizing a ring homogeneously at a prime ideal-/
+abbreviation at_prime  := homogeneous_localization 𝒜 𝔭.prime_compl
+
+lemma is_unit_iff_is_unit_val (f : homogeneous_localization.at_prime 𝒜 𝔭) :
   is_unit f.val ↔ is_unit f :=
 ⟨λ h1, begin
   rcases h1 with ⟨⟨a, b, eq0, eq1⟩, (eq2 : a = f.val)⟩,
@@ -444,23 +472,24 @@ lemma is_unit_iff_is_unit_val (f : homogeneous_localization 𝒜 x) :
   induction b using localization.induction_on with data,
   rcases data with ⟨a, ⟨b, hb⟩⟩,
   dsimp only at eq0 eq1,
-  have b_f_denom_not_mem : b * f.denom ∈ x.prime_compl := λ r, or.elim
-    (ideal.is_prime.mem_or_mem infer_instance r) (λ r2, hb r2) (λ r2, f.denom_not_mem r2),
+  have b_f_denom_not_mem : b * f.denom ∈ 𝔭.prime_compl := λ r, or.elim
+    (ideal.is_prime.mem_or_mem infer_instance r) (λ r2, hb r2) (λ r2, f.denom_mem r2),
   rw [f.eq_num_div_denom, localization.mk_mul,
-    show (⟨b, hb⟩ : x.prime_compl) * ⟨f.denom, _⟩ = ⟨b * f.denom, _⟩, from rfl,
-    show (1 : at x) = localization.mk 1 1, by erw localization.mk_self 1,
+    show (⟨b, hb⟩ : 𝔭.prime_compl) * ⟨f.denom, _⟩ = ⟨b * f.denom, _⟩, from rfl,
+    show (1 : localization.at_prime 𝔭) = localization.mk 1 1, by erw localization.mk_self 1,
     localization.mk_eq_mk', is_localization.eq] at eq1,
   rcases eq1 with ⟨⟨c, hc⟩, eq1⟩,
   simp only [← subtype.val_eq_coe] at eq1,
-  change a * f.num * 1 * c = _ at eq1,
+  change c * (1 * (a * f.num)) = _ at eq1,
   simp only [one_mul, mul_one] at eq1,
-  have mem1 : a * f.num * c ∈ x.prime_compl :=
-    eq1.symm ▸ λ r, or.elim (ideal.is_prime.mem_or_mem infer_instance r) (by tauto)(by tauto),
-  have mem2 : f.num ∉ x,
+  have mem1 : c * (a * f.num) ∈ 𝔭.prime_compl :=
+    eq1.symm ▸ λ r, or.elim (ideal.is_prime.mem_or_mem infer_instance r) (by tauto) (by tauto),
+  have mem2 : f.num ∉ 𝔭,
   { contrapose! mem1,
     erw [not_not],
-    exact ideal.mul_mem_right _ _ (ideal.mul_mem_left _ _ mem1), },
-  refine ⟨⟨f, quotient.mk' ⟨f.deg, ⟨f.denom, f.denom_mem⟩, ⟨f.num, f.num_mem⟩, mem2⟩, _, _⟩, rfl⟩;
+    exact ideal.mul_mem_left _ _ (ideal.mul_mem_left _ _ mem1), },
+  refine ⟨⟨f, quotient.mk' ⟨f.deg, ⟨f.denom, f.denom_mem_deg⟩, ⟨f.num, f.num_mem_deg⟩, mem2⟩,
+    _, _⟩, rfl⟩;
   simp only [ext_iff_val, mul_val, val_mk', ← subtype.val_eq_coe, f.eq_num_div_denom,
     localization.mk_mul, one_val];
   convert localization.mk_self _;
@@ -470,18 +499,18 @@ end, λ ⟨⟨_, b, eq1, eq2⟩, rfl⟩, begin
   exact ⟨⟨f.val, b.val, eq1, eq2⟩, rfl⟩
 end⟩
 
-instance : nontrivial (homogeneous_localization 𝒜 x) :=
+instance : nontrivial (homogeneous_localization.at_prime 𝒜 𝔭) :=
 ⟨⟨0, 1, λ r, by simpa [ext_iff_val, zero_val, one_val, zero_ne_one] using r⟩⟩
 
-instance : local_ring (homogeneous_localization 𝒜 x) :=
+instance : local_ring (homogeneous_localization.at_prime 𝒜 𝔭) :=
 local_ring.of_is_unit_or_is_unit_one_sub_self $ λ a, begin
   simp only [← is_unit_iff_is_unit_val, sub_val, one_val],
   induction a using quotient.induction_on',
   simp only [homogeneous_localization.val_mk', ← subtype.val_eq_coe],
-  by_cases mem1 : a.num.1 ∈ x,
+  by_cases mem1 : a.num.1 ∈ 𝔭,
   { right,
-    have : a.denom.1 - a.num.1 ∈ x.prime_compl := λ h, a.denom_not_mem
-      ((sub_add_cancel a.denom.val a.num.val) ▸ ideal.add_mem _ h mem1 : a.denom.1 ∈ x),
+    have : a.denom.1 - a.num.1 ∈ 𝔭.prime_compl := λ h, a.denom_mem
+      ((sub_add_cancel a.denom.val a.num.val) ▸ ideal.add_mem _ h mem1 : a.denom.1 ∈ 𝔭),
     apply is_unit_of_mul_eq_one _ (localization.mk a.denom.1 ⟨a.denom.1 - a.num.1, this⟩),
     simp only [sub_mul, localization.mk_mul, one_mul, localization.sub_mk, ← subtype.val_eq_coe,
       submonoid.coe_mul],
@@ -489,11 +518,22 @@ local_ring.of_is_unit_or_is_unit_one_sub_self $ λ a, begin
     simp only [← subtype.val_eq_coe, submonoid.coe_mul],
     ring, },
   { left,
-    change _ ∈ x.prime_compl at mem1,
+    change _ ∈ 𝔭.prime_compl at mem1,
     apply is_unit_of_mul_eq_one _ (localization.mk a.denom.1 ⟨a.num.1, mem1⟩),
     rw [localization.mk_mul],
     convert localization.mk_self _,
     simpa only [mul_comm], },
 end
 
+end
+
+section
+
+variables (𝒜) (f : A)
+
+/--Localising away from powers of `f` homogeneously.-/
+abbreviation away := homogeneous_localization 𝒜 (submonoid.powers f)
+
+end
+
 end homogeneous_localization
diff --git a/src/ring_theory/graded_algebra/radical.lean b/src/ring_theory/graded_algebra/radical.lean
index 8c72570374cc1..9d6ebfc071937 100644
--- a/src/ring_theory/graded_algebra/radical.lean
+++ b/src/ring_theory/graded_algebra/radical.lean
@@ -12,6 +12,9 @@ This file contains a proof that the radical of any homogeneous ideal is a homoge
 
 ## Main statements
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 * `ideal.is_homogeneous.is_prime_iff`: for any `I : ideal A`, if `I` is homogeneous, then
   `I` is prime if and only if `I` is homogeneously prime, i.e. `I ≠ ⊤` and if `x, y` are
   homogeneous elements such that `x * y ∈ I`, then at least one of `x,y` is in `I`.
@@ -34,13 +37,14 @@ fails for a non-cancellative set see `counterexample/homogeneous_prime_not_prime
 homogeneous, radical
 -/
 
-open graded_algebra set_like finset
+open graded_ring direct_sum set_like finset
 open_locale big_operators
 
-variables {ι R A : Type*}
-variables [comm_semiring R] [comm_ring A] [algebra R A]
+variables {ι σ A : Type*}
+variables [comm_ring A]
 variables [linear_ordered_cancel_add_comm_monoid ι]
-variables {𝒜 : ι → submodule R A} [graded_algebra 𝒜]
+variables [set_like σ A] [add_submonoid_class σ A] {𝒜 : ι → σ} [graded_ring 𝒜]
+include A
 
 lemma ideal.is_homogeneous.is_prime_of_homogeneous_mem_or_mem
   {I : ideal A} (hI : I.is_homogeneous 𝒜) (I_ne_top : I ≠ ⊤)
@@ -65,17 +69,17 @@ lemma ideal.is_homogeneous.is_prime_of_homogeneous_mem_or_mem
   This is a contradiction, because both `proj (max₁ + max₂) (x * y) ∈ I` and the sum on the
   right hand side is in `I` however `proj max₁ x * proj max₂ y` is not in `I`.
   -/
-  letI : Π (x : A),
-    decidable_pred (λ (i : ι), proj 𝒜 i x ∉ I) := λ x, classical.dec_pred _,
-  letI : Π i (x : 𝒜 i), decidable (x ≠ 0) := λ i x, classical.dec _,
-  set set₁ := (support 𝒜 x).filter (λ i, proj 𝒜 i x ∉ I) with set₁_eq,
-  set set₂ := (support 𝒜 y).filter (λ i, proj 𝒜 i y ∉ I) with set₂_eq,
-  have nonempty : ∀ (x : A), (x ∉ I) → ((support 𝒜 x).filter (λ i, proj 𝒜 i x ∉ I)).nonempty,
+  classical,
+  set set₁ := (decompose 𝒜 x).support.filter (λ i, proj 𝒜 i x ∉ I) with set₁_eq,
+  set set₂ := (decompose 𝒜 y).support.filter (λ i, proj 𝒜 i y ∉ I) with set₂_eq,
+  have nonempty :
+    ∀ (x : A), (x ∉ I) → ((decompose 𝒜 x).support.filter (λ i, proj 𝒜 i x ∉ I)).nonempty,
   { intros x hx,
     rw filter_nonempty_iff,
     contrapose! hx,
+    simp_rw proj_apply at hx,
     rw ← sum_support_decompose 𝒜 x,
-    apply ideal.sum_mem _ hx, },
+    exact ideal.sum_mem _ hx, },
   set max₁ := set₁.max' (nonempty x rid₁) with max₁_eq,
   set max₂ := set₂.max' (nonempty y rid₂) with max₂_eq,
   have mem_max₁ : max₁ ∈ set₁ := max'_mem set₁ (nonempty x rid₁),
@@ -84,14 +88,16 @@ lemma ideal.is_homogeneous.is_prime_of_homogeneous_mem_or_mem
 
   have mem_I : proj 𝒜 max₁ x * proj 𝒜 max₂ y ∈ I,
   { set antidiag :=
-      ((support 𝒜 x).product (support 𝒜 y)).filter (λ z : ι × ι, z.1 + z.2 = max₁ + max₂) with ha,
+      ((decompose 𝒜 x).support ×ˢ (decompose 𝒜 y).support)
+        .filter (λ z : ι × ι, z.1 + z.2 = max₁ + max₂) with ha,
     have mem_antidiag : (max₁, max₂) ∈ antidiag,
     { simp only [add_sum_erase, mem_filter, mem_product],
       exact ⟨⟨mem_of_mem_filter _ mem_max₁, mem_of_mem_filter _ mem_max₂⟩, rfl⟩ },
     have eq_add_sum :=
       calc  proj 𝒜 (max₁ + max₂) (x * y)
           = ∑ ij in antidiag, proj 𝒜 ij.1 x * proj 𝒜 ij.2 y
-          : by simp_rw [ha, proj_apply, map_mul, support, direct_sum.coe_mul_apply_submodule]
+          : by simp_rw [ha, proj_apply, direct_sum.decompose_mul,
+                        direct_sum.coe_mul_apply 𝒜]
       ... = proj 𝒜 max₁ x * proj 𝒜 max₂ y + ∑ ij in antidiag.erase (max₁, max₂),
                                               proj 𝒜 ij.1 x * proj 𝒜 ij.2 y
           : (add_sum_erase _ _ mem_antidiag).symm,
@@ -113,13 +119,13 @@ lemma ideal.is_homogeneous.is_prime_of_homogeneous_mem_or_mem
       have not_mem : i ∉ set₁ := λ h, lt_irrefl _
         ((max'_lt_iff set₁ (nonempty x rid₁)).mp max_lt i h),
       rw set₁_eq at not_mem,
-      simp only [not_and, not_not, ne.def, dfinsupp.mem_support_to_fun, mem_filter] at not_mem,
+      simp only [not_and, not_not, ne.def, mem_filter] at not_mem,
       exact ideal.mul_mem_right _ I (not_mem H₂), },
     { -- in this case  `max₂ < j`, then `yⱼ ∈ I`; for otherwise `j ∈ set₂`, then `j ≤ max₂`.
       have not_mem : j ∉ set₂ := λ h, lt_irrefl _
         ((max'_lt_iff set₂ (nonempty y rid₂)).mp max_lt j h),
       rw set₂_eq at not_mem,
-      simp only [not_and, not_not, ne.def, dfinsupp.mem_support_to_fun, mem_filter] at not_mem,
+      simp only [not_and, not_not, ne.def, mem_filter] at not_mem,
       exact ideal.mul_mem_left I _ (not_mem H₃), }, },
 
   have not_mem_I : proj 𝒜 max₁ x * proj 𝒜 max₂ y ∉ I,
@@ -127,7 +133,7 @@ lemma ideal.is_homogeneous.is_prime_of_homogeneous_mem_or_mem
     { rw mem_filter at mem_max₁ mem_max₂,
       exact ⟨mem_max₁.2, mem_max₂.2⟩, },
     intro rid,
-    cases homogeneous_mem_or_mem ⟨max₁, submodule.coe_mem _⟩ ⟨max₂, submodule.coe_mem _⟩ mem_I,
+    cases homogeneous_mem_or_mem ⟨max₁, set_like.coe_mem _⟩ ⟨max₂, set_like.coe_mem _⟩ mem_I,
     { apply neither_mem.1 h },
     { apply neither_mem.2 h }, },
 
diff --git a/src/ring_theory/hahn_series.lean b/src/ring_theory/hahn_series.lean
index 37d7efe8c1191..e0e25df39dd32 100644
--- a/src/ring_theory/hahn_series.lean
+++ b/src/ring_theory/hahn_series.lean
@@ -6,12 +6,16 @@ Authors: Aaron Anderson
 import order.well_founded_set
 import algebra.big_operators.finprod
 import ring_theory.valuation.basic
-import algebra.module.pi
 import ring_theory.power_series.basic
 import data.finsupp.pwo
+import data.finset.mul_antidiagonal
+import algebra.order.group.with_top
 
 /-!
 # Hahn Series
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 If `Γ` is ordered and `R` has zero, then `hahn_series Γ R` consists of formal series over `Γ` with
 coefficients in `R`, whose supports are partially well-ordered. With further structure on `R` and
 `Γ`, we can add further structure on `hahn_series Γ R`, with the most studied case being when `Γ` is
@@ -393,6 +397,10 @@ lemma sub_coeff' {x y : hahn_series Γ R} :
 lemma sub_coeff {x y : hahn_series Γ R} {a : Γ} :
   (x - y).coeff a = x.coeff a - y.coeff a := by simp
 
+@[simp] lemma order_neg [has_zero Γ] {f : hahn_series Γ R} : (- f).order = f.order :=
+by { by_cases hf : f = 0, { simp only [hf, neg_zero] },
+    simp only [order, support_neg, neg_eq_zero] }
+
 end add_group
 
 instance [add_comm_group R] : add_comm_group (hahn_series Γ R) :=
@@ -404,7 +412,7 @@ end addition
 section distrib_mul_action
 variables [partial_order Γ] {V : Type*} [monoid R] [add_monoid V] [distrib_mul_action R V]
 
-instance : has_scalar R (hahn_series Γ V) :=
+instance : has_smul R (hahn_series Γ V) :=
 ⟨λ r x, { coeff := r • x.coeff,
           is_pwo_support' := x.is_pwo_support.mono (function.support_smul_subset_right r x.coeff) }⟩
 
@@ -420,7 +428,7 @@ instance : distrib_mul_action R (hahn_series Γ V) :=
 
 variables {S : Type*} [monoid S] [distrib_mul_action S V]
 
-instance [has_scalar R S] [is_scalar_tower R S V] :
+instance [has_smul R S] [is_scalar_tower R S V] :
   is_scalar_tower R S (hahn_series Γ V) :=
 ⟨λ r s a, by { ext, simp }⟩
 
@@ -524,9 +532,8 @@ begin
   rw mul_coeff,
   apply sum_subset_zero_on_sdiff (add_antidiagonal_mono_right hys) _ (λ _ _, rfl),
   intros b hb,
-  simp only [not_and, not_not, mem_sdiff, mem_add_antidiagonal,
-      ne.def, set.mem_set_of_eq, mem_support] at hb,
-  rw [(hb.2 hb.1.1 hb.1.2.1), mul_zero]
+  simp only [not_and, mem_sdiff, mem_add_antidiagonal, mem_support, not_imp_not] at hb,
+  rw [hb.2 hb.1.1 hb.1.2.2, mul_zero],
 end
 
 lemma mul_coeff_left' [non_unital_non_assoc_semiring R] {x y : hahn_series Γ R} {a : Γ} {s : set Γ}
@@ -537,9 +544,8 @@ begin
   rw mul_coeff,
   apply sum_subset_zero_on_sdiff (add_antidiagonal_mono_left hxs) _ (λ _ _, rfl),
   intros b hb,
-  simp only [not_and, not_not, mem_sdiff, mem_add_antidiagonal,
-      ne.def, set.mem_set_of_eq, mem_support] at hb,
-  rw [not_not.1 (λ con, hb.1.2.2 (hb.2 hb.1.1 con)), zero_mul],
+  simp only [not_and', mem_sdiff, mem_add_antidiagonal, mem_support, not_ne_iff] at hb,
+  rw [hb.2 ⟨hb.1.2.1, hb.1.2.2⟩, zero_mul],
 end
 
 instance [non_unital_non_assoc_semiring R] : distrib (hahn_series Γ R) :=
@@ -550,7 +556,7 @@ instance [non_unital_non_assoc_semiring R] : distrib (hahn_series Γ R) :=
       mul_coeff_right' hwf (set.subset_union_left _ _)],
     { simp only [add_coeff, mul_add, sum_add_distrib] },
     { intro b,
-      simp only [add_coeff, ne.def, set.mem_union_eq, set.mem_set_of_eq, mem_support],
+      simp only [add_coeff, ne.def, set.mem_union, set.mem_set_of_eq, mem_support],
       contrapose!,
       intro h,
       rw [h.1, h.2, add_zero], }
@@ -562,7 +568,7 @@ instance [non_unital_non_assoc_semiring R] : distrib (hahn_series Γ R) :=
       mul_coeff_left' hwf (set.subset_union_left _ _)],
     { simp only [add_coeff, add_mul, sum_add_distrib] },
     { intro b,
-      simp only [add_coeff, ne.def, set.mem_union_eq, set.mem_set_of_eq, mem_support],
+      simp only [add_coeff, ne.def, set.mem_union, set.mem_set_of_eq, mem_support],
       contrapose!,
       intro h,
       rw [h.1, h.2, add_zero], },
@@ -583,7 +589,7 @@ begin
     ext ⟨a1, a2⟩,
     simp only [not_mem_empty, not_and, set.mem_singleton_iff, not_not,
       mem_add_antidiagonal, set.mem_set_of_eq, iff_false],
-    rintro h1 rfl h2,
+    rintro rfl h2 h1,
     rw add_comm at h1,
     rw ← add_right_cancel h1 at hx,
     exact h2 hx, },
@@ -593,12 +599,11 @@ begin
     simp only [set.mem_singleton_iff, prod.mk.inj_iff, mem_add_antidiagonal,
       mem_singleton, set.mem_set_of_eq],
     split,
-    { rintro ⟨h1, rfl, h2⟩,
+    { rintro ⟨rfl, h2, h1⟩,
       rw add_comm at h1,
       refine ⟨rfl, add_right_cancel h1⟩ },
     { rintro ⟨rfl, rfl⟩,
-      refine ⟨add_comm _ _, _⟩,
-      simp [hx] } },
+      exact ⟨rfl, by simp [hx], add_comm _ _⟩ } },
   { simp }
 end
 
@@ -615,7 +620,7 @@ begin
     ext ⟨a1, a2⟩,
     simp only [not_mem_empty, not_and, set.mem_singleton_iff, not_not,
       mem_add_antidiagonal, set.mem_set_of_eq, iff_false],
-    rintro h1 h2 rfl,
+    rintro h2 rfl h1,
     rw ← add_right_cancel h1 at hx,
     exact h2 hx, },
   transitivity ∑ (ij : Γ × Γ) in {(a,b)}, x.coeff ij.fst * (single b r).coeff ij.snd,
@@ -624,7 +629,7 @@ begin
     simp only [set.mem_singleton_iff, prod.mk.inj_iff, mem_add_antidiagonal,
       mem_singleton, set.mem_set_of_eq],
     split,
-    { rintro ⟨h1, h2, rfl⟩,
+    { rintro ⟨h2, rfl, h1⟩,
       refine ⟨add_right_cancel h1, rfl⟩ },
     { rintro ⟨rfl, rfl⟩,
       simp [hx] } },
@@ -678,22 +683,21 @@ begin
   simp only [mul_coeff, add_coeff, sum_mul, mul_sum, sum_sigma'],
   refine sum_bij_ne_zero (λ a has ha0, ⟨⟨a.2.1, a.2.2 + a.1.2⟩, ⟨a.2.2, a.1.2⟩⟩) _ _ _ _,
   { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
-    simp only [true_and, set.image2_add, eq_self_iff_true, mem_add_antidiagonal, ne.def,
+    simp only [and_true, set.image2_add, eq_self_iff_true, mem_add_antidiagonal, ne.def,
       set.image_prod, mem_sigma, set.mem_set_of_eq] at H1 H2 ⊢,
-    obtain ⟨⟨rfl, ⟨H3, nz⟩⟩, ⟨rfl, nx, ny⟩⟩ := H1,
-    refine ⟨⟨(add_assoc _ _ _).symm, nx, set.add_mem_add ny nz⟩, ny, nz⟩ },
-  { rintros ⟨⟨i1,j1⟩, ⟨k1,l1⟩⟩ ⟨⟨i2,j2⟩, ⟨k2,l2⟩⟩ H1 H2 H3 H4 H5,
+    obtain ⟨⟨H3, nz, rfl⟩, nx, ny, rfl⟩ := H1,
+    exact ⟨⟨nx, set.add_mem_add ny nz, (add_assoc _ _ _).symm⟩, ny, nz⟩ },
+  { rintros ⟨⟨i1,j1⟩, k1,l1⟩ ⟨⟨i2,j2⟩, k2,l2⟩ H1 H2 H3 H4 H5,
     simp only [set.image2_add, prod.mk.inj_iff, mem_add_antidiagonal, ne.def,
       set.image_prod, mem_sigma, set.mem_set_of_eq, heq_iff_eq] at H1 H3 H5,
     obtain ⟨⟨rfl, H⟩, rfl, rfl⟩ := H5,
-    simp only [and_true, prod.mk.inj_iff, eq_self_iff_true, heq_iff_eq],
-    exact add_right_cancel (H1.1.1.trans H3.1.1.symm) },
+    simp only [and_true, prod.mk.inj_iff, eq_self_iff_true, heq_iff_eq, ←H1.2.2.2, ←H3.2.2.2] },
   { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
     simp only [exists_prop, set.image2_add, prod.mk.inj_iff, mem_add_antidiagonal,
       sigma.exists, ne.def, set.image_prod, mem_sigma, set.mem_set_of_eq, heq_iff_eq,
       prod.exists] at H1 H2 ⊢,
-    obtain ⟨⟨rfl, nx, H⟩, rfl, ny, nz⟩ := H1,
-    exact ⟨i + k, l, i, k, ⟨⟨add_assoc _ _ _, set.add_mem_add nx ny, nz⟩, rfl, nx, ny⟩,
+    obtain ⟨⟨nx, H, rfl⟩, ny, nz, rfl⟩ := H1,
+    exact ⟨i + k, l, i, k, ⟨⟨set.add_mem_add nx ny, nz, add_assoc _ _ _⟩, nx, ny, rfl⟩,
       λ con, H2 ((mul_assoc _ _ _).symm.trans con), ⟨rfl, rfl⟩, rfl, rfl⟩ },
   { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
     simp [mul_assoc], }
@@ -722,6 +726,7 @@ instance [non_assoc_semiring R] : non_assoc_semiring (hahn_series Γ R) :=
   mul := (*),
   one_mul := λ x, by { ext, exact single_zero_mul_coeff.trans (one_mul _) },
   mul_one := λ x, by { ext, exact mul_single_zero_coeff.trans (mul_one _) },
+  .. add_monoid_with_one.unary,
   .. hahn_series.non_unital_non_assoc_semiring }
 
 instance [semiring R] : semiring (hahn_series Γ R) :=
@@ -736,20 +741,9 @@ instance [non_unital_comm_semiring R] : non_unital_comm_semiring (hahn_series Γ
 { mul_comm := λ x y, begin
     ext,
     simp_rw [mul_coeff, mul_comm],
-    refine sum_bij (λ a ha, ⟨a.2, a.1⟩) _ (λ a ha, by simp) _ _,
-    { intros a ha,
-      simp only [mem_add_antidiagonal, ne.def, set.mem_set_of_eq] at ha ⊢,
-      obtain ⟨h1, h2, h3⟩ := ha,
-      refine ⟨_, h3, h2⟩,
-      rw [add_comm, h1], },
-    { rintros ⟨a1, a2⟩ ⟨b1, b2⟩ ha hb hab,
-      rw prod.ext_iff at *,
-      refine ⟨hab.2, hab.1⟩, },
-    { intros a ha,
-      refine ⟨a.swap, _, by simp⟩,
-      simp only [prod.fst_swap, mem_add_antidiagonal, prod.snd_swap,
-        ne.def, set.mem_set_of_eq] at ha ⊢,
-      exact ⟨(add_comm _ _).trans ha.1, ha.2.2, ha.2.1⟩ }
+    refine sum_bij (λ a ha, a.swap) (λ a ha, _) (λ a ha, rfl) (λ _ _ _ _, prod.swap_inj.1)
+      (λ a ha, ⟨a.swap, _, a.swap_swap.symm⟩);
+    rwa swap_mem_add_antidiagonal,
   end,
   .. hahn_series.non_unital_semiring }
 
@@ -796,9 +790,7 @@ instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [non_unital_non_assoc_s
 
 instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R] :
   is_domain (hahn_series Γ R) :=
-{ .. hahn_series.no_zero_divisors,
-  .. hahn_series.nontrivial,
-  .. hahn_series.ring }
+no_zero_divisors.to_is_domain _
 
 @[simp]
 lemma order_mul {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [non_unital_non_assoc_semiring R]
@@ -836,9 +828,9 @@ begin
   { rw [h, mul_single_coeff_add],
     simp },
   { rw [single_coeff_of_ne h, mul_coeff, sum_eq_zero],
-    rintros ⟨y1, y2⟩ hy,
-    obtain ⟨rfl, hy1, hy2⟩ := mem_add_antidiagonal.1 hy,
-    rw [eq_of_mem_support_single hy1, eq_of_mem_support_single hy2] at h,
+    simp_rw mem_add_antidiagonal,
+    rintro ⟨y, z⟩ ⟨hy, hz, rfl⟩,
+    rw [eq_of_mem_support_single hy, eq_of_mem_support_single hz] at h,
     exact (h rfl).elim }
 end
 
@@ -911,20 +903,19 @@ begin
     { simp },
     apply sum_subset,
     { rintro ⟨i, j⟩ hij,
-      simp only [exists_prop, mem_map, prod.mk.inj_iff,
-        mem_add_antidiagonal, ne.def, function.embedding.coe_prod_map, mem_support,
-        prod.exists] at hij,
-      obtain ⟨i, j, ⟨rfl, hx, hy⟩, rfl, rfl⟩ := hij,
+      simp only [exists_prop, mem_map, prod.mk.inj_iff, mem_add_antidiagonal,
+        function.embedding.coe_prod_map, mem_support, prod.exists] at hij,
+      obtain ⟨i, j, ⟨hx, hy, rfl⟩, rfl, rfl⟩ := hij,
       simp [hx, hy, hf], },
     { rintro ⟨_, _⟩ h1 h2,
       contrapose! h2,
       obtain ⟨i, hi, rfl⟩ := support_emb_domain_subset (ne_zero_and_ne_zero_of_mul h2).1,
       obtain ⟨j, hj, rfl⟩ := support_emb_domain_subset (ne_zero_and_ne_zero_of_mul h2).2,
-      simp only [exists_prop, mem_map, prod.mk.inj_iff,
-        mem_add_antidiagonal, ne.def, function.embedding.coe_prod_map, mem_support,
-        prod.exists],
-      simp only [mem_add_antidiagonal, emb_domain_coeff, ne.def, mem_support, ← hf] at h1,
-      exact ⟨i, j, ⟨f.injective h1.1, h1.2⟩, rfl⟩, } },
+      simp only [exists_prop, mem_map, prod.mk.inj_iff, mem_add_antidiagonal,
+        function.embedding.coe_prod_map, mem_support, prod.exists],
+      simp only [mem_add_antidiagonal, emb_domain_coeff, mem_support, ←hf,
+        order_embedding.eq_iff_eq] at h1,
+      exact ⟨i, j, h1, rfl⟩ } },
   { rw [emb_domain_notin_range hg, eq_comm],
     contrapose! hg,
     obtain ⟨_, _, hi, hj, rfl⟩ := support_mul_subset_add_support ((mem_support _ _).2 hg),
@@ -1002,7 +993,7 @@ section semiring
 variables [semiring R]
 
 /-- The ring `hahn_series ℕ R` is isomorphic to `power_series R`. -/
-@[simps] def to_power_series : (hahn_series ℕ R) ≃+* power_series R :=
+@[simps] def to_power_series : hahn_series ℕ R ≃+* power_series R :=
 { to_fun := λ f, power_series.mk f.coeff,
   inv_fun := λ f, ⟨λ n, power_series.coeff R n f, (nat.lt_wf.is_wf _).is_pwo⟩,
   left_inv := λ f, by { ext, simp },
@@ -1012,15 +1003,12 @@ variables [semiring R]
     ext n,
     simp only [power_series.coeff_mul, power_series.coeff_mk, mul_coeff, is_pwo_support],
     classical,
-    refine sum_filter_ne_zero.symm.trans
-      ((sum_congr _ (λ _ _, rfl)).trans sum_filter_ne_zero),
+    refine sum_filter_ne_zero.symm.trans ((sum_congr _ $ λ _ _, rfl).trans sum_filter_ne_zero),
     ext m,
-    simp only [nat.mem_antidiagonal, and.congr_left_iff, mem_add_antidiagonal, ne.def,
-      and_iff_left_iff_imp, mem_filter, mem_support],
-    intros h1 h2,
-    contrapose h1,
-    rw ← decidable.or_iff_not_and_not at h1,
-    cases h1; simp [h1]
+    simp only [nat.mem_antidiagonal, mem_add_antidiagonal, and.congr_left_iff, mem_filter,
+      mem_support],
+    rintro h,
+    rw [and_iff_right (left_ne_zero_of_mul h), and_iff_right (right_ne_zero_of_mul h)],
   end }
 
 lemma coeff_to_power_series {f : hahn_series ℕ R} {n : ℕ} :
@@ -1030,8 +1018,9 @@ power_series.coeff_mk _ _
 lemma coeff_to_power_series_symm {f : power_series R} {n : ℕ} :
   (hahn_series.to_power_series.symm f).coeff n = power_series.coeff R n f := rfl
 
-variables (Γ) (R) [ordered_semiring Γ] [nontrivial Γ]
-/-- Casts a power series as a Hahn series with coefficients from an `ordered_semiring`. -/
+variables (Γ R) [strict_ordered_semiring Γ]
+
+/-- Casts a power series as a Hahn series with coefficients from an `strict_ordered_semiring`. -/
 def of_power_series : (power_series R) →+* hahn_series Γ R :=
 (hahn_series.emb_domain_ring_hom (nat.cast_add_monoid_hom Γ) nat.strict_mono_cast.injective
   (λ _ _, nat.cast_le)).comp
@@ -1059,9 +1048,8 @@ begin
   ext n,
   simp only [C, single_coeff, of_power_series_apply, ring_hom.coe_mk],
   split_ifs with hn hn,
-  { rw hn,
-    convert @emb_domain_coeff _ _ _ _ _ _ _ _ 0,
-    simp },
+  { subst hn,
+    convert @emb_domain_coeff _ _ _ _ _ _ _ _ 0; simp },
   { rw emb_domain_notin_image_support,
     simp only [not_exists, set.mem_image, to_power_series_symm_apply_coeff, mem_support,
                power_series.coeff_C],
@@ -1090,7 +1078,7 @@ end
 begin
   rw ring_hom.map_pow,
   induction n with n ih,
-  { refl },
+  { simp, refl },
   rw [pow_succ, ih, of_power_series_X, mul_comm, single_mul_single, one_mul, nat.cast_succ]
 end
 
@@ -1116,12 +1104,10 @@ After importing `algebra.order.pi` the ring `hahn_series (σ → ℕ) R` could b
     simp_rw [mul_coeff],
     refine sum_filter_ne_zero.symm.trans ((sum_congr _ (λ _ _, rfl)).trans sum_filter_ne_zero),
     ext m,
-    simp only [and.congr_left_iff, mem_add_antidiagonal, ne.def, and_iff_left_iff_imp, mem_filter,
-      mem_support, finsupp.mem_antidiagonal],
-    intros h1 h2,
-    contrapose h1,
-    rw ← decidable.or_iff_not_and_not at h1,
-    cases h1; simp [h1],
+    simp only [and.congr_left_iff, mem_add_antidiagonal, mem_filter, mem_support,
+      finsupp.mem_antidiagonal],
+    rintro h,
+    rw [and_iff_right (left_ne_zero_of_mul h), and_iff_right (right_ne_zero_of_mul h)],
   end }
 
 variables {σ : Type*} [fintype σ]
@@ -1151,8 +1137,9 @@ variables (R) [comm_semiring R] {A : Type*} [semiring A] [algebra R A]
   end,
   .. to_power_series }
 
-variables (Γ) (R) [ordered_semiring Γ] [nontrivial Γ]
-/-- Casting a power series as a Hahn series with coefficients from an `ordered_semiring`
+variables (Γ R) [strict_ordered_semiring Γ]
+
+/-- Casting a power series as a Hahn series with coefficients from an `strict_ordered_semiring`
   is an algebra homomorphism. -/
 @[simps] def of_power_series_alg : (power_series A) →ₐ[R] hahn_series Γ A :=
 (hahn_series.emb_domain_alg_hom (nat.cast_add_monoid_hom Γ) nat.strict_mono_cast.injective
@@ -1179,19 +1166,7 @@ end algebra
 
 section valuation
 
-variables [linear_ordered_add_comm_group Γ] [ring R] [is_domain R]
-
-instance : linear_ordered_comm_group (multiplicative Γ) :=
-{ .. (infer_instance : linear_order (multiplicative Γ)),
-  .. (infer_instance : ordered_comm_group (multiplicative Γ)) }
-
-instance : linear_ordered_comm_group_with_zero (with_zero (multiplicative Γ)) :=
-{ zero_le_one := with_zero.zero_le 1,
-  .. (with_zero.ordered_comm_monoid),
-  .. (infer_instance : linear_order (with_zero (multiplicative Γ))),
-  .. (infer_instance : comm_group_with_zero (with_zero (multiplicative Γ))) }
-
-variables (Γ) (R)
+variables (Γ R) [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R]
 
 /-- The additive valuation on `hahn_series Γ R`, returning the smallest index at which
   a Hahn Series has a nonzero coefficient, or `⊤` for the 0 series.  -/
@@ -1240,7 +1215,7 @@ end
 end valuation
 
 lemma is_pwo_Union_support_powers
-  [linear_ordered_add_comm_group Γ] [ring R] [is_domain R]
+  [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R]
   {x : hahn_series Γ R} (hx : 0 < add_val Γ R x) :
   (⋃ n : ℕ, (x ^ n).support).is_pwo :=
 begin
@@ -1396,7 +1371,7 @@ section semiring
 
 variables [ordered_cancel_add_comm_monoid Γ] [semiring R] {α : Type*}
 
-instance : has_scalar (hahn_series Γ R) (summable_family Γ R α) :=
+instance : has_smul (hahn_series Γ R) (summable_family Γ R α) :=
 { smul := λ x s, { to_fun := λ a, x * (s a),
     is_pwo_Union_support' := begin
       apply (x.is_pwo_support.add s.is_pwo_Union_support).mono,
@@ -1406,14 +1381,14 @@ instance : has_scalar (hahn_series Γ R) (summable_family Γ R α) :=
       exact λ a ha, (set.add_subset_add (set.subset.refl _) (set.subset_Union _ a)) ha,
     end,
     finite_co_support' := λ g, begin
-      refine ((add_antidiagonal x.is_pwo_support s.is_pwo_Union_support g).finite_to_set.bUnion
+      refine ((add_antidiagonal x.is_pwo_support s.is_pwo_Union_support g).finite_to_set.bUnion'
         (λ ij hij, _)).subset (λ a ha, _),
       { exact λ ij hij, function.support (λ a, (s a).coeff ij.2) },
       { apply s.finite_co_support },
       { obtain ⟨i, j, hi, hj, rfl⟩ := support_mul_subset_add_support ha,
-        simp only [exists_prop, set.mem_Union, mem_add_antidiagonal,
-          mul_coeff, ne.def, mem_support, is_pwo_support, prod.exists],
-        refine ⟨i, j, mem_coe.2 (mem_add_antidiagonal.2 ⟨rfl, hi, set.mem_Union.2 ⟨a, hj⟩⟩), hj⟩, }
+        simp only [exists_prop, set.mem_Union, mem_add_antidiagonal, mul_coeff, mem_support,
+          is_pwo_support, prod.exists],
+        exact ⟨i, j, mem_coe.2 (mem_add_antidiagonal.2 ⟨hi, set.mem_Union.2 ⟨a, hj⟩, rfl⟩), hj⟩ }
     end } }
 
 @[simp]
@@ -1442,7 +1417,7 @@ begin
   { refine sum_subset (add_antidiagonal_mono_right (set.subset_Union _ a)) _,
     rintro ⟨i, j⟩ hU ha,
     rw mem_add_antidiagonal at *,
-    rw [not_not.1 (λ con, ha ⟨hU.1, hU.2.1, con⟩), mul_zero] },
+    rw [not_not.1 (λ con, ha ⟨hU.1, con, hU.2.2⟩), mul_zero] },
   { rintro ⟨i, j⟩ hij,
     refine (s.finite_co_support j).subset _,
     simp_rw [function.support_subset_iff', function.mem_support, not_not],
@@ -1458,7 +1433,7 @@ begin
       simp [hx] },
     { rintro ⟨i, j⟩ hU ha,
       rw mem_add_antidiagonal at *,
-      rw [← hsum_coeff, not_not.1 (λ con, ha ⟨hU.1, hU.2.1, con⟩), mul_zero] } }
+      rw [← hsum_coeff, not_not.1 (λ con, ha ⟨hU.1, con, hU.2.2⟩), mul_zero] } }
 end
 
 /-- The summation of a `summable_family` as a `linear_map`. -/
@@ -1480,16 +1455,12 @@ def of_finsupp (f : α →₀ (hahn_series Γ R)) :
   summable_family Γ R α :=
 { to_fun := f,
   is_pwo_Union_support' := begin
-      apply (f.support.is_pwo_sup (λ a, (f a).support) (λ a ha, (f a).is_pwo_support)).mono,
-      intros g hg,
-      obtain ⟨a, ha⟩ := set.mem_Union.1 hg,
+      apply (f.support.is_pwo_bUnion.2 $ λ a ha, (f a).is_pwo_support).mono,
+      refine set.Union_subset_iff.2 (λ a g hg, _),
       have haf : a ∈ f.support,
-      { rw finsupp.mem_support_iff,
-        contrapose! ha,
-        rw [ha, support_zero],
-        exact set.not_mem_empty _ },
-      have h : (λ i, (f i).support) a ≤ _ := le_sup haf,
-      exact h ha,
+      { rw [finsupp.mem_support_iff, ← support_nonempty_iff],
+        exact ⟨g, hg⟩ },
+      exact set.mem_bUnion haf hg
     end,
   finite_co_support' := λ g, begin
     refine f.support.finite_to_set.subset (λ a ha, _),
@@ -1567,7 +1538,7 @@ end emb_domain
 
 section powers
 
-variables [linear_ordered_add_comm_group Γ] [comm_ring R] [is_domain R]
+variables [linear_ordered_cancel_add_comm_monoid Γ] [comm_ring R] [is_domain R]
 
 /-- The powers of an element of positive valuation form a summable family. -/
 def powers (x : hahn_series Γ R) (hx : 0 < add_val Γ R x) :
@@ -1582,19 +1553,18 @@ def powers (x : hahn_series Γ R) (hx : 0 < add_val Γ R x) :
     intros y ys hy,
     refine ((((add_antidiagonal x.is_pwo_support hpwo y).finite_to_set.bUnion (λ ij hij,
       hy ij.snd _ _)).image nat.succ).union (set.finite_singleton 0)).subset _,
-    { exact (mem_add_antidiagonal.1 (mem_coe.1 hij)).2.2 },
-    { obtain ⟨rfl, hi, hj⟩ := mem_add_antidiagonal.1 (mem_coe.1 hij),
+    { exact (mem_add_antidiagonal.1 (mem_coe.1 hij)).2.1 },
+    { obtain ⟨hi, hj, rfl⟩ := mem_add_antidiagonal.1 (mem_coe.1 hij),
       rw [← zero_add ij.snd, ← add_assoc, add_zero],
       exact add_lt_add_right (with_top.coe_lt_coe.1
         (lt_of_lt_of_le hx (add_val_le_of_coeff_ne_zero hi))) _, },
-    { intros n hn,
-      cases n,
+    { rintro (_ | n) hn,
       { exact set.mem_union_right _ (set.mem_singleton 0) },
       { obtain ⟨i, j, hi, hj, rfl⟩ := support_mul_subset_add_support hn,
         refine set.mem_union_left _ ⟨n, set.mem_Union.2 ⟨⟨i, j⟩, set.mem_Union.2 ⟨_, hj⟩⟩, rfl⟩,
-        simp only [true_and, set.mem_Union, mem_add_antidiagonal, mem_coe, eq_self_iff_true,
+        simp only [and_true, set.mem_Union, mem_add_antidiagonal, mem_coe, eq_self_iff_true,
           ne.def, mem_support, set.mem_set_of_eq],
-        exact ⟨hi, ⟨n, hj⟩⟩ } }
+        exact ⟨hi, n, hj⟩ } }
   end }
 
 variables {x : hahn_series Γ R} (hx : 0 < add_val Γ R x)
diff --git a/src/ring_theory/henselian.lean b/src/ring_theory/henselian.lean
index c9f699638c54f..eb5ff41b66ed1 100644
--- a/src/ring_theory/henselian.lean
+++ b/src/ring_theory/henselian.lean
@@ -11,6 +11,9 @@ import linear_algebra.adic_completion
 /-!
 # Henselian rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we set up the basic theory of Henselian (local) rings.
 A ring `R` is *Henselian* at an ideal `I` if the following conditions hold:
 * `I` is contained in the Jacobson radical of `R`
@@ -138,7 +141,7 @@ begin
   { intros H, constructor, intros f hf a₀ h₁ h₂,
     specialize H f hf (residue R a₀),
     have aux := flip mem_nonunits_iff.mp h₂,
-    simp only [aeval_def, ring_hom.algebra_map_to_algebra, eval₂_at_apply,
+    simp only [aeval_def, residue_field.algebra_map_eq, eval₂_at_apply,
       ← ideal.quotient.eq_zero_iff_mem, ← local_ring.mem_maximal_ideal] at H h₁ aux,
     obtain ⟨a, ha₁, ha₂⟩ := H h₁ aux,
     refine ⟨a, ha₁, _⟩,
@@ -228,7 +231,7 @@ instance is_adic_complete.henselian_ring
     -- we are now in the position to show that `c : ℕ → R` is a Cauchy sequence
     have aux : ∀ m n, m ≤ n → c m ≡ c n [SMOD (I ^ m • ⊤ : ideal R)],
     { intros m n hmn,
-      rw [← ideal.one_eq_top, algebra.id.smul_eq_mul, mul_one],
+      rw [← ideal.one_eq_top, ideal.smul_eq_mul, mul_one],
       obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn, clear hmn,
       induction k with k ih, { rw add_zero, },
       rw [nat.succ_eq_add_one, ← add_assoc, hc, ← add_zero (c m), sub_eq_add_neg],
@@ -242,15 +245,15 @@ instance is_adic_complete.henselian_ring
     { show f.is_root a,
       suffices : ∀ n, f.eval a ≡ 0 [SMOD (I ^ n • ⊤ : ideal R)], { from is_Hausdorff.haus' _ this },
       intro n, specialize ha n,
-      rw [← ideal.one_eq_top, algebra.id.smul_eq_mul, mul_one] at ha ⊢,
+      rw [← ideal.one_eq_top, ideal.smul_eq_mul, mul_one] at ha ⊢,
       refine (ha.symm.eval f).trans _,
       rw [smodeq.zero],
       exact ideal.pow_le_pow le_self_add (hfcI _), },
     { show a - a₀ ∈ I,
       specialize ha 1,
-      rw [hc, pow_one, ← ideal.one_eq_top, algebra.id.smul_eq_mul, mul_one, sub_eq_add_neg] at ha,
+      rw [hc, pow_one, ← ideal.one_eq_top, ideal.smul_eq_mul, mul_one, sub_eq_add_neg] at ha,
       rw [← smodeq.sub_mem, ← add_zero a₀],
-      refine ha.symm.trans (smodeq.refl.add _),
+      refine ha.symm.trans (smodeq.rfl.add _),
       rw [smodeq.zero, ideal.neg_mem_iff],
       exact ideal.mul_mem_right _ _ h₁, }
   end }
diff --git a/src/ring_theory/ideal/associated_prime.lean b/src/ring_theory/ideal/associated_prime.lean
new file mode 100644
index 0000000000000..5306118f8f003
--- /dev/null
+++ b/src/ring_theory/ideal/associated_prime.lean
@@ -0,0 +1,168 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import linear_algebra.span
+import ring_theory.ideal.operations
+import ring_theory.ideal.quotient_operations
+import ring_theory.noetherian
+
+/-!
+
+# Associated primes of a module
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We provide the definition and related lemmas about associated primes of modules.
+
+## Main definition
+- `is_associated_prime`: `is_associated_prime I M` if the prime ideal `I` is the
+  annihilator of some `x : M`.
+- `associated_primes`: The set of associated primes of a module.
+
+## Main results
+- `exists_le_is_associated_prime_of_is_noetherian_ring`: In a noetherian ring, any `ann(x)` is
+  contained in an associated prime for `x ≠ 0`.
+- `associated_primes.eq_singleton_of_is_primary`: In a noetherian ring, `I.radical` is the only
+  associated prime of `R ⧸ I` when `I` is primary.
+
+## Todo
+
+Generalize this to a non-commutative setting once there are annihilator for non-commutative rings.
+
+-/
+
+variables {R : Type*} [comm_ring R] (I J : ideal R) (M : Type*) [add_comm_group M] [module R M]
+
+/-- `is_associated_prime I M` if the prime ideal `I` is the annihilator of some `x : M`. -/
+def is_associated_prime : Prop :=
+I.is_prime ∧ ∃ x : M, I = (R ∙ x).annihilator
+
+variables (R)
+
+/-- The set of associated primes of a module. -/
+def associated_primes : set (ideal R) := { I | is_associated_prime I M }
+
+variables {I J M R} (h : is_associated_prime I M)
+variables {M' : Type*} [add_comm_group M'] [module R M'] (f : M →ₗ[R] M')
+
+lemma associate_primes.mem_iff : I ∈ associated_primes R M ↔ is_associated_prime I M := iff.rfl
+
+lemma is_associated_prime.is_prime : I.is_prime := h.1
+
+lemma is_associated_prime.map_of_injective
+  (h : is_associated_prime I M) (hf : function.injective f) :
+  is_associated_prime I M' :=
+begin
+  obtain ⟨x, rfl⟩ := h.2,
+  refine ⟨h.1, ⟨f x, _⟩⟩,
+  ext r,
+  rw [submodule.mem_annihilator_span_singleton, submodule.mem_annihilator_span_singleton,
+    ← map_smul, ← f.map_zero, hf.eq_iff],
+end
+
+lemma linear_equiv.is_associated_prime_iff (l : M ≃ₗ[R] M') :
+  is_associated_prime I M ↔ is_associated_prime I M' :=
+⟨λ h, h.map_of_injective l l.injective, λ h, h.map_of_injective l.symm l.symm.injective⟩
+
+lemma not_is_associated_prime_of_subsingleton [subsingleton M] : ¬ is_associated_prime I M :=
+begin
+  rintro ⟨hI, x, hx⟩,
+  apply hI.ne_top,
+  rwa [subsingleton.elim x 0, submodule.span_singleton_eq_bot.mpr rfl,
+    submodule.annihilator_bot] at hx
+end
+
+variable (R)
+
+lemma exists_le_is_associated_prime_of_is_noetherian_ring [H : is_noetherian_ring R]
+  (x : M) (hx : x ≠ 0) :
+  ∃ P : ideal R, is_associated_prime P M ∧ (R ∙ x).annihilator ≤ P :=
+begin
+  have : (R ∙ x).annihilator ≠ ⊤,
+  { rwa [ne.def, ideal.eq_top_iff_one, submodule.mem_annihilator_span_singleton, one_smul] },
+  obtain ⟨P, ⟨l, h₁, y, rfl⟩, h₃⟩ := set_has_maximal_iff_noetherian.mpr H
+    ({ P | (R ∙ x).annihilator ≤ P ∧ P ≠ ⊤ ∧ ∃ y : M, P = (R ∙ y).annihilator })
+    ⟨(R ∙ x).annihilator, rfl.le, this, x, rfl⟩,
+  refine ⟨_, ⟨⟨h₁, _⟩, y, rfl⟩, l⟩,
+  intros a b hab,
+  rw or_iff_not_imp_left,
+  intro ha,
+  rw submodule.mem_annihilator_span_singleton at ha hab,
+  have H₁ : (R ∙ y).annihilator ≤ (R ∙ a • y).annihilator,
+  { intros c hc,
+    rw submodule.mem_annihilator_span_singleton at hc ⊢,
+    rw [smul_comm, hc, smul_zero] },
+  have H₂ : (submodule.span R {a • y}).annihilator ≠ ⊤,
+  { rwa [ne.def, submodule.annihilator_eq_top_iff, submodule.span_singleton_eq_bot] },
+  rwa [H₁.eq_of_not_lt (h₃ (R ∙ a • y).annihilator ⟨l.trans H₁, H₂, _, rfl⟩),
+    submodule.mem_annihilator_span_singleton, smul_comm, smul_smul]
+end
+
+variable {R}
+
+lemma associated_primes.subset_of_injective (hf : function.injective f) :
+  associated_primes R M ⊆ associated_primes R M' :=
+λ I h, h.map_of_injective f hf
+
+lemma linear_equiv.associated_primes.eq (l : M ≃ₗ[R] M') :
+  associated_primes R M = associated_primes R M' :=
+le_antisymm (associated_primes.subset_of_injective l l.injective)
+  (associated_primes.subset_of_injective l.symm l.symm.injective)
+
+lemma associated_primes.eq_empty_of_subsingleton [subsingleton M] : associated_primes R M = ∅ :=
+begin
+  ext, simp only [set.mem_empty_iff_false, iff_false], apply not_is_associated_prime_of_subsingleton
+end
+
+variables (R M)
+
+lemma associated_primes.nonempty [is_noetherian_ring R] [nontrivial M] :
+  (associated_primes R M).nonempty :=
+begin
+  obtain ⟨x, hx⟩ := exists_ne (0 : M),
+  obtain ⟨P, hP, _⟩ := exists_le_is_associated_prime_of_is_noetherian_ring R x hx,
+  exact ⟨P, hP⟩,
+end
+
+variables {R M}
+
+lemma is_associated_prime.annihilator_le (h : is_associated_prime I M) :
+  (⊤ : submodule R M).annihilator ≤ I :=
+begin
+  obtain ⟨hI, x, rfl⟩ := h,
+  exact submodule.annihilator_mono le_top,
+end
+
+lemma is_associated_prime.eq_radical (hI : I.is_primary) (h : is_associated_prime J (R ⧸ I)) :
+  J = I.radical :=
+begin
+  obtain ⟨hJ, x, e⟩ := h,
+  have : x ≠ 0,
+  { rintro rfl, apply hJ.1,
+    rwa [submodule.span_singleton_eq_bot.mpr rfl, submodule.annihilator_bot] at e },
+  obtain ⟨x, rfl⟩ := ideal.quotient.mkₐ_surjective R _ x,
+  replace e : ∀ {y}, y ∈ J ↔ x * y ∈ I,
+  { intro y, rw [e, submodule.mem_annihilator_span_singleton, ← map_smul, smul_eq_mul, mul_comm,
+      ideal.quotient.mkₐ_eq_mk, ← ideal.quotient.mk_eq_mk, submodule.quotient.mk_eq_zero] },
+  apply le_antisymm,
+  { intros y hy,
+    exact (hI.2 $ e.mp hy).resolve_left ((submodule.quotient.mk_eq_zero I).not.mp this) },
+  { rw hJ.radical_le_iff, intros y hy, exact e.mpr (I.mul_mem_left x hy) }
+end
+
+lemma associated_primes.eq_singleton_of_is_primary [is_noetherian_ring R] (hI : I.is_primary) :
+  associated_primes R (R ⧸ I) = {I.radical} :=
+begin
+  ext J,
+  rw [set.mem_singleton_iff],
+  refine ⟨is_associated_prime.eq_radical hI, _⟩,
+  rintro rfl,
+  haveI : nontrivial (R ⧸ I) := ⟨⟨(I^.quotient.mk : _) 1, (I^.quotient.mk : _) 0, _⟩⟩,
+  obtain ⟨a, ha⟩ := associated_primes.nonempty R (R ⧸ I),
+  exact ha.eq_radical hI ▸ ha,
+  rw [ne.def, ideal.quotient.eq, sub_zero, ← ideal.eq_top_iff_one],
+  exact hI.1
+end
diff --git a/src/ring_theory/ideal/basic.lean b/src/ring_theory/ideal/basic.lean
index b085195f21f20..21f966e5aafed 100644
--- a/src/ring_theory/ideal/basic.lean
+++ b/src/ring_theory/ideal/basic.lean
@@ -5,7 +5,6 @@ Authors: Kenny Lau, Chris Hughes, Mario Carneiro
 -/
 import algebra.associated
 import linear_algebra.basic
-import order.zorn
 import order.atoms
 import order.compactly_generated
 import tactic.abel
@@ -15,6 +14,9 @@ import linear_algebra.finsupp
 
 # Ideals over a ring
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `ideal R`, the type of (left) ideals over a ring `R`.
 Note that over commutative rings, left ideals and two-sided ideals are equivalent.
 
@@ -119,6 +121,16 @@ lemma mem_span_insert {s : set α} {x y} :
 lemma mem_span_singleton' {x y : α} :
   x ∈ span ({y} : set α) ↔ ∃ a, a * y = x := submodule.mem_span_singleton
 
+lemma span_singleton_le_iff_mem {x : α} : span {x} ≤ I ↔ x ∈ I :=
+submodule.span_singleton_le_iff_mem _ _
+
+lemma span_singleton_mul_left_unit {a : α} (h2 : is_unit a) (x : α) :
+  span ({a * x} : set α) = span {x} := 
+begin
+  apply le_antisymm; rw [span_singleton_le_iff_mem, mem_span_singleton'],
+  exacts [⟨a, rfl⟩, ⟨_, h2.unit.inv_mul_cancel_left x⟩],
+end
+
 lemma span_insert (x) (s : set α) : span (insert x s) = span ({x} : set α) ⊔ span s :=
 submodule.span_insert x s
 
@@ -127,6 +139,11 @@ lemma span_eq_bot {s : set α} : span s = ⊥ ↔ ∀ x ∈ s, (x:α) = 0 := sub
 @[simp] lemma span_singleton_eq_bot {x} : span ({x} : set α) = ⊥ ↔ x = 0 :=
 submodule.span_singleton_eq_bot
 
+lemma span_singleton_ne_top {α : Type*} [comm_semiring α] {x : α} (hx : ¬ is_unit x) :
+  ideal.span ({x} : set α) ≠ ⊤ :=
+(ideal.ne_top_iff_one _).mpr $ λ h1, let ⟨y, hy⟩ := ideal.mem_span_singleton'.mp h1 in
+  hx ⟨⟨x, y, mul_comm y x ▸ hy, hy⟩, rfl⟩
+
 @[simp] lemma span_zero : span (0 : set α) = ⊥ := by rw [←set.singleton_zero, span_singleton_eq_bot]
 
 @[simp] lemma span_one : span (1 : set α) = ⊤ := by rw [←set.singleton_one, span_singleton_one]
@@ -138,6 +155,18 @@ begin
   exact ⟨submodule.mem_span_finite_of_mem_span, λ ⟨s', h₁, h₂⟩, span_mono h₁ h₂⟩
 end
 
+lemma mem_span_singleton_sup {S : Type*} [comm_semiring S] {x y : S} {I : ideal S} :
+  x ∈ ideal.span {y} ⊔ I ↔ ∃ (a : S) (b ∈ I), a * y + b = x :=
+begin
+  rw submodule.mem_sup,
+  split,
+  { rintro ⟨ya, hya, b, hb, rfl⟩,
+    obtain ⟨a, rfl⟩ := mem_span_singleton'.mp hya,
+    exact ⟨a, b, hb, rfl⟩ },
+  { rintro ⟨a, b, hb, rfl⟩,
+    exact ⟨a * y, ideal.mem_span_singleton'.mpr ⟨a, rfl⟩, b, hb, rfl⟩ }
+end
+
 /--
 The ideal generated by an arbitrary binary relation.
 -/
@@ -151,12 +180,12 @@ class is_prime (I : ideal α) : Prop :=
 
 theorem is_prime_iff {I : ideal α} :
   is_prime I ↔ I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I :=
-⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩
+⟨λ h, ⟨h.1, λ _ _, h.2⟩, λ h, ⟨h.1, λ _ _, h.2⟩⟩
 
 theorem is_prime.ne_top {I : ideal α} (hI : I.is_prime) : I ≠ ⊤ := hI.1
 
-theorem is_prime.mem_or_mem {I : ideal α} (hI : I.is_prime) :
-  ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I := hI.2
+theorem is_prime.mem_or_mem {I : ideal α} (hI : I.is_prime) {x y : α} :
+  x * y ∈ I → x ∈ I ∨ y ∈ I := hI.2
 
 theorem is_prime.mem_or_mem_of_mul_eq_zero {I : ideal α} (hI : I.is_prime)
   {x y : α} (h : x * y = 0) : x ∈ I ∨ y ∈ I :=
@@ -211,6 +240,13 @@ begin
   exact submodule.singleton_span_is_compact_element 1,
 end
 
+lemma is_maximal.coprime_of_ne {M M' : ideal α} (hM : M.is_maximal) (hM' : M'.is_maximal)
+  (hne : M ≠ M') : M ⊔ M' = ⊤ :=
+begin
+  contrapose! hne with h,
+  exact hM.eq_of_le hM'.ne_top (le_sup_left.trans_eq (hM'.eq_of_le h le_sup_right).symm)
+end
+
 /-- **Krull's theorem**: if `I` is an ideal that is not the whole ring, then it is included in some
     maximal ideal. -/
 theorem exists_le_maximal (I : ideal α) (hI : I ≠ ⊤) :
@@ -241,9 +277,25 @@ begin
   exact hmax M (lt_of_lt_of_le hPJ hM2) hM1,
 end
 
+lemma span_pair_comm {x y : α} : (span {x, y} : ideal α) = span {y, x} :=
+by simp only [span_insert, sup_comm]
+
 theorem mem_span_pair {x y z : α} :
   z ∈ span ({x, y} : set α) ↔ ∃ a b, a * x + b * y = z :=
-by simp [mem_span_insert, mem_span_singleton', @eq_comm _ _ z]
+submodule.mem_span_pair
+
+@[simp] lemma span_pair_add_mul_left {R : Type u} [comm_ring R] {x y : R} (z : R) :
+  (span {x + y * z, y} : ideal R) = span {x, y} :=
+begin
+  ext,
+  rw [mem_span_pair, mem_span_pair],
+  exact ⟨λ ⟨a, b, h⟩, ⟨a, b + a * z, by { rw [← h], ring1 }⟩,
+         λ ⟨a, b, h⟩, ⟨a, b - a * z, by { rw [← h], ring1 }⟩⟩
+end
+
+@[simp] lemma span_pair_add_mul_right {R : Type u} [comm_ring R] {x y : R} (z : R) :
+  (span {x, y + x * z} : ideal R) = span {x, y} :=
+by rw [span_pair_comm, span_pair_add_mul_left, span_pair_comm]
 
 theorem is_maximal.exists_inv {I : ideal α}
   (hI : I.is_maximal) {x} (hx : x ∉ I) : ∃ y, ∃ i ∈ I, y * x + i = 1 :=
@@ -301,6 +353,20 @@ lemma mem_pi (x : ι → α) : x ∈ I.pi ι ↔ ∀ i, x i ∈ I := iff.rfl
 
 end pi
 
+lemma Inf_is_prime_of_is_chain {s : set (ideal α)} (hs : s.nonempty) (hs' : is_chain (≤) s)
+  (H : ∀ p ∈ s, ideal.is_prime p) :
+  (Inf s).is_prime :=
+⟨λ e, let ⟨x, hx⟩ := hs in (H x hx).ne_top (eq_top_iff.mpr (e.symm.trans_le (Inf_le hx))),
+  λ x y e, or_iff_not_imp_left.mpr $ λ hx, begin
+    rw ideal.mem_Inf at hx ⊢ e,
+    push_neg at hx,
+    obtain ⟨I, hI, hI'⟩ := hx,
+    intros J hJ,
+    cases hs'.total hI hJ,
+    { exact h (((H I hI).mem_or_mem (e hI)).resolve_left hI') },
+    { exact ((H J hJ).mem_or_mem (e hJ)).resolve_left (λ x, hI' $ h x) },
+  end⟩
+
 end ideal
 
 end semiring
@@ -318,10 +384,11 @@ variables [comm_semiring α] (I : ideal α)
 theorem mul_unit_mem_iff_mem {x y : α} (hy : is_unit y) : x * y ∈ I ↔ x ∈ I :=
 mul_comm y x ▸ unit_mul_mem_iff_mem I hy
 
-lemma mem_span_singleton {x y : α} :
-  x ∈ span ({y} : set α) ↔ y ∣ x :=
+lemma mem_span_singleton {x y : α} : x ∈ span ({y} : set α) ↔ y ∣ x :=
 mem_span_singleton'.trans $ exists_congr $ λ _, by rw [eq_comm, mul_comm]
 
+lemma mem_span_singleton_self (x : α) : x ∈ span ({x} : set α) := mem_span_singleton.mpr dvd_rfl
+
 lemma span_singleton_le_span_singleton {x y : α} :
   span ({x} : set α) ≤ span ({y} : set α) ↔ y ∣ x :=
 span_le.trans $ singleton_subset_iff.trans mem_span_singleton
@@ -335,15 +402,7 @@ begin
 end
 
 lemma span_singleton_mul_right_unit {a : α} (h2 : is_unit a) (x : α) :
-  span ({x * a} : set α) = span {x} :=
-begin
-  apply le_antisymm,
-  { rw span_singleton_le_span_singleton, use a},
-  { rw span_singleton_le_span_singleton, rw is_unit.mul_right_dvd h2}
-end
-
-lemma span_singleton_mul_left_unit {a : α} (h2 : is_unit a) (x : α) :
-  span ({a * x} : set α) = span {x} := by rw [mul_comm, span_singleton_mul_right_unit h2]
+  span ({x * a} : set α) = span {x} := by rw [mul_comm, span_singleton_mul_left_unit h2]
 
 lemma span_singleton_eq_top {x} : span ({x} : set α) = ⊤ ↔ is_unit x :=
 by rw [is_unit_iff_dvd_one, ← span_singleton_le_span_singleton, span_singleton_one,
@@ -478,16 +537,20 @@ protected lemma sub_mem : a ∈ I → b ∈ I → a - b ∈ I := sub_mem
 lemma mem_span_insert' {s : set α} {x y} :
   x ∈ span (insert y s) ↔ ∃a, x + a * y ∈ span s := submodule.mem_span_insert'
 
+@[simp] lemma span_singleton_neg (x : α) : (span {-x} : ideal α) = span {x} :=
+by { ext, simp only [mem_span_singleton'],
+     exact ⟨λ ⟨y, h⟩, ⟨-y, h ▸ neg_mul_comm y x⟩, λ ⟨y, h⟩, ⟨-y, h ▸ neg_mul_neg y x⟩⟩ }
+
 end ideal
 
 end ring
 
-section division_ring
-variables {K : Type u} [division_ring K] (I : ideal K)
+section division_semiring
+variables {K : Type u} [division_semiring K] (I : ideal K)
 
 namespace ideal
 
-/-- All ideals in a division ring are trivial. -/
+/-- All ideals in a division (semi)ring are trivial. -/
 lemma eq_bot_or_top : I = ⊥ ∨ I = ⊤ :=
 begin
   rw or_iff_not_imp_right,
@@ -500,6 +563,10 @@ begin
   simpa [H, h1] using I.mul_mem_left r⁻¹ hr,
 end
 
+/-- Ideals of a `division_semiring` are a simple order. Thanks to the way abbreviations work,
+this automatically gives a `is_simple_module K` instance. -/
+instance : is_simple_order (ideal K) := ⟨eq_bot_or_top⟩
+
 lemma eq_bot_of_prime [h : I.is_prime] : I = ⊥ :=
 or_iff_not_imp_right.mp I.eq_bot_or_top h.1
 
@@ -509,7 +576,7 @@ lemma bot_is_maximal : is_maximal (⊥ : ideal K) :=
 
 end ideal
 
-end division_ring
+end division_semiring
 
 section comm_ring
 
@@ -526,12 +593,11 @@ end ideal
 
 end comm_ring
 
+-- TODO: consider moving the lemmas below out of the `ring` namespace since they are
+-- about `comm_semiring`s.
 namespace ring
 
-variables {R : Type*} [comm_ring R]
-
-lemma not_is_field_of_subsingleton {R : Type*} [ring R] [subsingleton R] : ¬ is_field R :=
-λ ⟨⟨x, y, hxy⟩, _, _⟩, hxy (subsingleton.elim x y)
+variables {R : Type*} [comm_semiring R]
 
 lemma exists_not_is_unit_of_not_is_field [nontrivial R] (hf : ¬ is_field R) :
   ∃ x ≠ (0 : R), ¬ is_unit x :=
@@ -567,6 +633,22 @@ not_is_field_iff_exists_ideal_bot_lt_and_lt_top.trans
     ⟨p, bot_lt_iff_ne_bot.mp (lt_of_lt_of_le bot_lt le_p), hp.is_prime⟩,
    λ ⟨p, ne_bot, prime⟩, ⟨p, bot_lt_iff_ne_bot.mpr ne_bot, lt_top_iff_ne_top.mpr prime.1⟩⟩
 
+/-- Also see `ideal.is_simple_order` for the forward direction as an instance when `R` is a
+division (semi)ring. 
+
+This result actually holds for all division semirings, but we lack the predicate to state it. -/
+lemma is_field_iff_is_simple_order_ideal :
+  is_field R ↔ is_simple_order (ideal R) :=
+begin
+  casesI subsingleton_or_nontrivial R,
+  { exact ⟨λ h, (not_is_field_of_subsingleton _ h).elim,
+      λ h, by exactI (false_of_nontrivial_of_subsingleton $ ideal R).elim⟩ },
+  rw [← not_iff_not, ring.not_is_field_iff_exists_ideal_bot_lt_and_lt_top, ← not_iff_not],
+  push_neg,
+  simp_rw [lt_top_iff_ne_top, bot_lt_iff_ne_bot, ← or_iff_not_imp_left, not_ne_iff],
+  exact ⟨λ h, ⟨h⟩, λ h, h.2⟩
+end
+
 /-- When a ring is not a field, the maximal ideals are nontrivial. -/
 lemma ne_bot_of_is_maximal_of_not_is_field [nontrivial R] {M : ideal R} (max : M.is_maximal)
   (not_field : ¬ is_field R) : M ≠ ⊥ :=
diff --git a/src/ring_theory/ideal/cotangent.lean b/src/ring_theory/ideal/cotangent.lean
new file mode 100644
index 0000000000000..fe303936f6e4e
--- /dev/null
+++ b/src/ring_theory/ideal/cotangent.lean
@@ -0,0 +1,204 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.ideal.operations
+import algebra.module.torsion
+import algebra.ring.idempotents
+import linear_algebra.finite_dimensional
+import ring_theory.ideal.local_ring
+
+/-!
+# The module `I ⧸ I ^ 2`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we provide special API support for the module `I ⧸ I ^ 2`. The official
+definition is a quotient module of `I`, but the alternative definition as an ideal of `R ⧸ I ^ 2` is
+also given, and the two are `R`-equivalent as in `ideal.cotangent_equiv_ideal`.
+
+Additional support is also given to the cotangent space `m ⧸ m ^ 2` of a local ring.
+
+-/
+
+namespace ideal
+
+variables {R S S' : Type*} [comm_ring R] [comm_semiring S] [algebra S R]
+variables [comm_semiring S'] [algebra S' R] [algebra S S'] [is_scalar_tower S S' R] (I : ideal R)
+
+/-- `I ⧸ I ^ 2` as a quotient of `I`. -/
+@[derive [add_comm_group, module (R ⧸ I)]]
+def cotangent : Type* := I ⧸ (I • ⊤ : submodule R I)
+
+instance : inhabited I.cotangent := ⟨0⟩
+
+instance cotangent.module_of_tower : module S I.cotangent :=
+submodule.quotient.module' _
+
+instance : is_scalar_tower S S' I.cotangent :=
+submodule.quotient.is_scalar_tower _ _
+
+instance [is_noetherian R I] : is_noetherian R I.cotangent :=
+submodule.quotient.is_noetherian _
+
+/-- The quotient map from `I` to `I ⧸ I ^ 2`. -/
+@[simps apply (lemmas_only)]
+def to_cotangent : I →ₗ[R] I.cotangent := submodule.mkq _
+
+lemma map_to_cotangent_ker : I.to_cotangent.ker.map I.subtype = I ^ 2 :=
+by simp [ideal.to_cotangent, submodule.map_smul'', pow_two]
+
+lemma mem_to_cotangent_ker {x : I} : x ∈ I.to_cotangent.ker ↔ (x : R) ∈ I ^ 2 :=
+begin
+  rw ← I.map_to_cotangent_ker,
+  simp,
+end
+
+lemma to_cotangent_eq {x y : I} : I.to_cotangent x = I.to_cotangent y ↔ (x - y : R) ∈ I ^ 2 :=
+begin
+  rw [← sub_eq_zero, ← map_sub],
+  exact I.mem_to_cotangent_ker
+end
+
+lemma to_cotangent_eq_zero (x : I) : I.to_cotangent x = 0 ↔ (x : R) ∈ I ^ 2 :=
+I.mem_to_cotangent_ker
+
+lemma to_cotangent_surjective : function.surjective I.to_cotangent :=
+submodule.mkq_surjective _
+
+lemma to_cotangent_range : I.to_cotangent.range = ⊤ :=
+submodule.range_mkq _
+
+lemma cotangent_subsingleton_iff :
+  subsingleton I.cotangent ↔ is_idempotent_elem I :=
+begin
+  split,
+  { introI H,
+    refine (pow_two I).symm.trans (le_antisymm (ideal.pow_le_self two_ne_zero) _),
+    exact λ x hx, (I.to_cotangent_eq_zero ⟨x, hx⟩).mp (subsingleton.elim _ _) },
+  { exact λ e, ⟨λ x y, quotient.induction_on₂' x y $ λ x y,
+      I.to_cotangent_eq.mpr $ ((pow_two I).trans e).symm ▸ I.sub_mem x.prop y.prop⟩ }
+end
+
+/-- The inclusion map `I ⧸ I ^ 2` to `R ⧸ I ^ 2`. -/
+def cotangent_to_quotient_square : I.cotangent →ₗ[R] R ⧸ I ^ 2 :=
+submodule.mapq (I • ⊤) (I ^ 2) I.subtype
+  (by { rw [← submodule.map_le_iff_le_comap, submodule.map_smul'', submodule.map_top,
+    submodule.range_subtype, smul_eq_mul, pow_two], exact rfl.le })
+
+lemma to_quotient_square_comp_to_cotangent : I.cotangent_to_quotient_square.comp I.to_cotangent =
+  (I ^ 2).mkq.comp (submodule.subtype I) :=
+linear_map.ext $ λ _, rfl
+
+@[simp]
+lemma to_cotangent_to_quotient_square (x : I) : I.cotangent_to_quotient_square (I.to_cotangent x) =
+  (I ^ 2).mkq x := rfl
+
+/-- `I ⧸ I ^ 2` as an ideal of `R ⧸ I ^ 2`. -/
+def cotangent_ideal (I : ideal R) : ideal (R ⧸ I ^ 2) :=
+begin
+  haveI : @ring_hom_surjective R (R ⧸ I ^ 2) _ _ _ := ⟨ideal.quotient.mk_surjective⟩,
+  let rq := (I ^ 2)^.quotient.mk,
+  exact submodule.map rq.to_semilinear_map I,
+end
+
+lemma cotangent_ideal_square (I : ideal R) : I.cotangent_ideal ^ 2 = ⊥ :=
+begin
+  rw [eq_bot_iff, pow_two I.cotangent_ideal, ← smul_eq_mul],
+  intros x hx,
+  apply submodule.smul_induction_on hx,
+  { rintros _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩, apply (submodule.quotient.eq _).mpr _,
+    rw [sub_zero, pow_two], exact ideal.mul_mem_mul hx hy },
+  { intros x y hx hy, exact add_mem hx hy }
+end
+
+lemma to_quotient_square_range :
+  I.cotangent_to_quotient_square.range = I.cotangent_ideal.restrict_scalars R :=
+begin
+  transitivity (I.cotangent_to_quotient_square.comp I.to_cotangent).range,
+  { rw [linear_map.range_comp, I.to_cotangent_range, submodule.map_top] },
+  { rw [to_quotient_square_comp_to_cotangent, linear_map.range_comp, I.range_subtype], ext, refl }
+end
+
+/-- The equivalence of the two definitions of `I / I ^ 2`, either as the quotient of `I` or the
+ideal of `R / I ^ 2`. -/
+noncomputable
+def cotangent_equiv_ideal : I.cotangent ≃ₗ[R] I.cotangent_ideal :=
+begin
+  refine
+  { ..(I.cotangent_to_quotient_square.cod_restrict (I.cotangent_ideal.restrict_scalars R)
+    (λ x, by { rw ← to_quotient_square_range, exact linear_map.mem_range_self _ _ })),
+    ..(equiv.of_bijective _ ⟨_, _⟩) },
+  { rintros x y e,
+    replace e := congr_arg subtype.val e,
+    obtain ⟨x, rfl⟩ := I.to_cotangent_surjective x,
+    obtain ⟨y, rfl⟩ := I.to_cotangent_surjective y,
+    rw I.to_cotangent_eq,
+    dsimp only [to_cotangent_to_quotient_square, submodule.mkq_apply] at e,
+    rwa submodule.quotient.eq at e },
+  { rintro ⟨_, x, hx, rfl⟩,
+    refine ⟨I.to_cotangent ⟨x, hx⟩, subtype.ext rfl⟩ }
+end
+
+@[simp, nolint simp_nf]
+lemma cotangent_equiv_ideal_apply (x : I.cotangent) :
+  ↑(I.cotangent_equiv_ideal x) = I.cotangent_to_quotient_square x := rfl
+
+lemma cotangent_equiv_ideal_symm_apply (x : R) (hx : x ∈ I) :
+  I.cotangent_equiv_ideal.symm ⟨(I ^ 2).mkq x, submodule.mem_map_of_mem hx⟩ =
+    I.to_cotangent ⟨x, hx⟩ :=
+begin
+  apply I.cotangent_equiv_ideal.injective,
+  rw I.cotangent_equiv_ideal.apply_symm_apply,
+  ext,
+  refl
+end
+
+variables {A B : Type*} [comm_ring A] [comm_ring B] [algebra R A] [algebra R B]
+
+/-- The lift of `f : A →ₐ[R] B` to `A ⧸ J ^ 2 →ₐ[R] B` with `J` being the kernel of `f`. -/
+def _root_.alg_hom.ker_square_lift (f : A →ₐ[R] B) : A ⧸ f.to_ring_hom.ker ^ 2 →ₐ[R] B :=
+begin
+  refine { commutes' := _, ..(ideal.quotient.lift (f.to_ring_hom.ker ^ 2) f.to_ring_hom _) },
+  { intros a ha, exact ideal.pow_le_self two_ne_zero ha },
+  { intro r, rw [is_scalar_tower.algebra_map_apply R A, ring_hom.to_fun_eq_coe,
+      ideal.quotient.algebra_map_eq, ideal.quotient.lift_mk], exact f.map_algebra_map r },
+end
+
+lemma _root_.alg_hom.ker_ker_sqare_lift (f : A →ₐ[R] B) :
+  f.ker_square_lift.to_ring_hom.ker = f.to_ring_hom.ker.cotangent_ideal :=
+begin
+  apply le_antisymm,
+  { intros x hx, obtain ⟨x, rfl⟩ := ideal.quotient.mk_surjective x, exact ⟨x, hx, rfl⟩ },
+  { rintros _ ⟨x, hx, rfl⟩, exact hx }
+end
+
+/-- The quotient ring of `I ⧸ I ^ 2` is `R ⧸ I`. -/
+def quot_cotangent : ((R ⧸ I ^ 2) ⧸ I.cotangent_ideal) ≃+* R ⧸ I :=
+begin
+  refine (ideal.quot_equiv_of_eq (ideal.map_eq_submodule_map _ _).symm).trans _,
+  refine (double_quot.quot_quot_equiv_quot_sup _ _).trans _,
+  exact (ideal.quot_equiv_of_eq (sup_eq_right.mpr $ ideal.pow_le_self two_ne_zero)),
+end
+
+end ideal
+
+namespace local_ring
+
+variables (R : Type*) [comm_ring R] [local_ring R]
+
+/-- The `A ⧸ I`-vector space `I ⧸ I ^ 2`. -/
+@[reducible] def cotangent_space : Type* := (maximal_ideal R).cotangent
+
+instance : module (residue_field R) (cotangent_space R) :=
+ideal.cotangent.module _
+
+instance : is_scalar_tower R (residue_field R) (cotangent_space R) :=
+module.is_torsion_by_set.is_scalar_tower _
+
+instance [is_noetherian_ring R] : finite_dimensional (residue_field R) (cotangent_space R) :=
+module.finite.of_restrict_scalars_finite R _ _
+
+end local_ring
diff --git a/src/ring_theory/ideal/idempotent_fg.lean b/src/ring_theory/ideal/idempotent_fg.lean
new file mode 100644
index 0000000000000..61bdcf8506b19
--- /dev/null
+++ b/src/ring_theory/ideal/idempotent_fg.lean
@@ -0,0 +1,50 @@
+/-
+Copyright (c) 2018 Mario Carneiro, Kevin Buzzard. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro, Kevin Buzzard
+-/
+import algebra.ring.idempotents
+import ring_theory.finiteness
+
+/-!
+## Lemmas on idempotent finitely generated ideals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+namespace ideal
+
+/-- A finitely generated idempotent ideal is generated by an idempotent element -/
+lemma is_idempotent_elem_iff_of_fg {R : Type*} [comm_ring R] (I : ideal R)
+  (h : I.fg) :
+  is_idempotent_elem I ↔ ∃ e : R, is_idempotent_elem e ∧ I = R ∙ e :=
+begin
+  split,
+  { intro e,
+    obtain ⟨r, hr, hr'⟩ := submodule.exists_mem_and_smul_eq_self_of_fg_of_le_smul I I h
+      (by { rw [smul_eq_mul], exact e.ge }),
+    simp_rw smul_eq_mul at hr',
+    refine ⟨r, hr' r hr, antisymm _ ((submodule.span_singleton_le_iff_mem _ _).mpr hr)⟩,
+    intros x hx,
+    rw ← hr' x hx,
+    exact ideal.mem_span_singleton'.mpr ⟨_, mul_comm _ _⟩ },
+  { rintros ⟨e, he, rfl⟩,
+    simp [is_idempotent_elem, ideal.span_singleton_mul_span_singleton, he.eq] }
+end
+
+lemma is_idempotent_elem_iff_eq_bot_or_top {R : Type*} [comm_ring R] [is_domain R]
+  (I : ideal R) (h : I.fg) :
+  is_idempotent_elem I ↔ I = ⊥ ∨ I = ⊤ :=
+begin
+  split,
+  { intro H,
+    obtain ⟨e, he, rfl⟩ := (I.is_idempotent_elem_iff_of_fg h).mp H,
+    simp only [ideal.submodule_span_eq, ideal.span_singleton_eq_bot],
+    apply or_of_or_of_imp_of_imp (is_idempotent_elem.iff_eq_zero_or_one.mp he) id,
+    rintro rfl,
+    simp },
+  { rintro (rfl|rfl); simp [is_idempotent_elem] }
+end
+
+end ideal
diff --git a/src/ring_theory/ideal/local_ring.lean b/src/ring_theory/ideal/local_ring.lean
index 1cd68f3c33f37..ef24d74567017 100644
--- a/src/ring_theory/ideal/local_ring.lean
+++ b/src/ring_theory/ideal/local_ring.lean
@@ -5,13 +5,17 @@ Authors: Kenny Lau, Chris Hughes, Mario Carneiro
 -/
 
 import algebra.algebra.basic
-import algebra.category.Ring.basic
 import ring_theory.ideal.operations
+import ring_theory.jacobson_ideal
+import logic.equiv.transfer_instance
 
 /-!
 
 # Local rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Define local rings as commutative rings having a unique maximal ideal.
 
 ## Main definitions
@@ -84,9 +88,9 @@ lemma is_unit_or_is_unit_of_is_unit_add {a b : R} (h : is_unit (a + b)) :
   is_unit a ∨ is_unit b :=
 begin
   rcases h with ⟨u, hu⟩,
-  replace hu : ↑u⁻¹ * a + ↑u⁻¹ * b = 1, from by rw [←mul_add, ←hu, units.inv_mul],
-  cases is_unit_or_is_unit_of_add_one hu; [left, right];
-    exact (is_unit_of_mul_is_unit_right (by assumption))
+  rw [←units.inv_mul_eq_one, mul_add] at hu,
+  apply or.imp _ _ (is_unit_or_is_unit_of_add_one hu);
+    exact is_unit_of_mul_is_unit_right,
 end
 
 lemma nonunits_add {a b : R} (ha : a ∈ nonunits R) (hb : b ∈ nonunits R) : a + b ∈ nonunits R:=
@@ -130,6 +134,11 @@ end
 
 @[simp] lemma mem_maximal_ideal (x) : x ∈ maximal_ideal R ↔ x ∈ nonunits R := iff.rfl
 
+lemma is_field_iff_maximal_ideal_eq :
+  is_field R ↔ maximal_ideal R = ⊥ :=
+not_iff_not.mp ⟨ring.ne_bot_of_is_maximal_of_not_is_field infer_instance,
+  λ h, ring.not_is_field_iff_exists_prime.mpr ⟨_, h, ideal.is_maximal.is_prime' _⟩⟩
+
 end local_ring
 
 end comm_semiring
@@ -167,6 +176,15 @@ begin
   apply f.is_unit_map,
 end
 
+lemma jacobson_eq_maximal_ideal (I : ideal R) (h : I ≠ ⊤) :
+  I.jacobson = local_ring.maximal_ideal R :=
+begin
+  apply le_antisymm,
+  { exact Inf_le ⟨local_ring.le_maximal_ideal h, local_ring.maximal_ideal.is_maximal R⟩ },
+  { exact le_Inf (λ J (hJ : I ≤ J ∧ J.is_maximal),
+      le_of_eq (local_ring.eq_maximal_ideal hJ.2).symm) }
+end
+
 end local_ring
 
 end comm_ring
@@ -217,10 +235,6 @@ lemma is_local_ring_hom_of_comp (f : R →+* S) (g : S →+* T) [is_local_ring_h
   is_local_ring_hom f :=
 ⟨λ a ha, (is_unit_map_iff (g.comp f) _).mp (g.is_unit_map ha)⟩
 
-instance _root_.CommRing.is_local_ring_hom_comp {R S T : CommRing} (f : R ⟶ S) (g : S ⟶ T)
-  [is_local_ring_hom g] [is_local_ring_hom f] :
-  is_local_ring_hom (f ≫ g) := is_local_ring_hom_comp _ _
-
 /-- If `f : R →+* S` is a local ring hom, then `R` is a local ring if `S` is. -/
 lemma _root_.ring_hom.domain_local_ring {R S : Type*} [comm_semiring R] [comm_semiring S]
   [H : _root_.local_ring S] (f : R →+* S)
@@ -233,23 +247,6 @@ begin
   exact local_ring.nonunits_add
 end
 
-section
-open category_theory
-
-lemma is_local_ring_hom_of_iso {R S : CommRing} (f : R ≅ S) : is_local_ring_hom f.hom :=
-{ map_nonunit := λ a ha,
-  begin
-    convert f.inv.is_unit_map ha,
-    rw category_theory.coe_hom_inv_id,
-  end }
-
-@[priority 100] -- see Note [lower instance priority]
-instance is_local_ring_hom_of_is_iso {R S : CommRing} (f : R ⟶ S) [is_iso f] :
-  is_local_ring_hom f :=
-is_local_ring_hom_of_iso (as_iso f)
-
-end
-
 end
 
 section
@@ -302,36 +299,64 @@ begin
   intros a b hab,
   obtain ⟨a, rfl⟩ := hf a,
   obtain ⟨b, rfl⟩ := hf b,
-  replace hab : is_unit (f (a + b)), from by simpa only [map_add] using hab,
+  rw ←map_add at hab,
   exact (is_unit_or_is_unit_of_is_unit_add $ is_local_ring_hom.map_nonunit _ hab).imp
     f.is_unit_map f.is_unit_map
 end
 
+/-- If `f : R →+* S` is a surjective local ring hom, then the induced units map is surjective. -/
+lemma surjective_units_map_of_local_ring_hom [comm_ring R] [comm_ring S]
+  (f : R →+* S) (hf : function.surjective f) (h : is_local_ring_hom f) :
+  function.surjective (units.map $ f.to_monoid_hom) :=
+begin
+  intro a,
+  obtain ⟨b,hb⟩ := hf (a : S),
+  use (is_unit_of_map_unit f _ (by { rw hb, exact units.is_unit _})).unit, ext, exact hb,
+end
+
 section
-variables (R) [comm_ring R] [local_ring R] [comm_ring S] [local_ring S]
+variables (R) [comm_ring R] [local_ring R] [comm_ring S] [local_ring S] [comm_ring T] [local_ring T]
 
 /-- The residue field of a local ring is the quotient of the ring by its maximal ideal. -/
+@[derive [ring, comm_ring, inhabited]]
 def residue_field := R ⧸ maximal_ideal R
 
 noncomputable instance residue_field.field : field (residue_field R) :=
 ideal.quotient.field (maximal_ideal R)
 
-noncomputable instance : inhabited (residue_field R) := ⟨37⟩
-
 /-- The quotient map from a local ring to its residue field. -/
 def residue : R →+* (residue_field R) :=
 ideal.quotient.mk _
 
-noncomputable
-instance residue_field.algebra : algebra R (residue_field R) := (residue R).to_algebra
+instance residue_field.algebra : algebra R (residue_field R) :=
+ideal.quotient.algebra _
+
+lemma residue_field.algebra_map_eq : algebra_map R (residue_field R) = residue R := rfl
+
+instance : is_local_ring_hom (local_ring.residue R) :=
+⟨λ a ha, not_not.mp (ideal.quotient.eq_zero_iff_mem.not.mp (is_unit_iff_ne_zero.mp ha))⟩
 
 variables {R}
 
 namespace residue_field
 
+/-- A local ring homomorphism into a field can be descended onto the residue field. -/
+def lift {R S : Type*} [comm_ring R] [local_ring R] [field S]
+  (f : R →+* S) [is_local_ring_hom f] : local_ring.residue_field R →+* S :=
+ideal.quotient.lift _ f (λ a ha,
+  classical.by_contradiction (λ h, ha (is_unit_of_map_unit f a (is_unit_iff_ne_zero.mpr h))))
+
+lemma lift_comp_residue {R S : Type*} [comm_ring R] [local_ring R] [field S] (f : R →+* S)
+  [is_local_ring_hom f] : (lift f).comp (residue R) = f :=
+ring_hom.ext (λ _, rfl)
+
+@[simp]
+lemma lift_residue_apply {R S : Type*} [comm_ring R] [local_ring R] [field S] (f : R →+* S)
+  [is_local_ring_hom f] (x) : lift f (residue R x) = f x :=
+rfl
+
 /-- The map on residue fields induced by a local homomorphism between local rings -/
-noncomputable def map (f : R →+* S) [is_local_ring_hom f] :
-  residue_field R →+* residue_field S :=
+def map (f : R →+* S) [is_local_ring_hom f] : residue_field R →+* residue_field S :=
 ideal.quotient.lift (maximal_ideal R) ((ideal.quotient.mk _).comp f) $
 λ a ha,
 begin
@@ -339,11 +364,84 @@ begin
   exact map_nonunit f a ha
 end
 
+/-- Applying `residue_field.map` to the identity ring homomorphism gives the identity
+ring homomorphism. -/
+@[simp] lemma map_id :
+  local_ring.residue_field.map (ring_hom.id R) = ring_hom.id (local_ring.residue_field R) :=
+ideal.quotient.ring_hom_ext $ ring_hom.ext $ λx, rfl
+
+/-- The composite of two `residue_field.map`s is the `residue_field.map` of the composite. -/
+lemma map_comp (f : T →+* R) (g : R →+* S) [is_local_ring_hom f] [is_local_ring_hom g] :
+  local_ring.residue_field.map (g.comp f) =
+  (local_ring.residue_field.map g).comp (local_ring.residue_field.map f) :=
+ideal.quotient.ring_hom_ext $ ring_hom.ext $ λx, rfl
+
+lemma map_comp_residue (f : R →+* S) [is_local_ring_hom f] :
+  (residue_field.map f).comp (residue R) = (residue S).comp f := rfl
+
+lemma map_residue (f : R →+* S) [is_local_ring_hom f] (r : R) :
+  residue_field.map f (residue R r) = residue S (f r) := rfl
+
+lemma map_id_apply (x : residue_field R) : map (ring_hom.id R) x = x :=
+fun_like.congr_fun map_id x
+
+@[simp] lemma map_map (f : R →+* S) (g : S →+* T) (x : residue_field R)
+  [is_local_ring_hom f] [is_local_ring_hom g] :
+  map g (map f x) = map (g.comp f) x :=
+fun_like.congr_fun (map_comp f g).symm x
+
+/-- A ring isomorphism defines an isomorphism of residue fields. -/
+@[simps apply]
+def map_equiv (f : R ≃+* S) : local_ring.residue_field R ≃+* local_ring.residue_field S :=
+{ to_fun := map (f : R →+* S),
+  inv_fun := map (f.symm : S →+* R),
+  left_inv := λ x, by simp only [map_map, ring_equiv.symm_comp, map_id, ring_hom.id_apply],
+  right_inv := λ x, by simp only [map_map, ring_equiv.comp_symm, map_id, ring_hom.id_apply],
+  map_mul' := ring_hom.map_mul _,
+  map_add' := ring_hom.map_add _ }
+
+@[simp] lemma map_equiv.symm (f : R ≃+* S) : (map_equiv f).symm = map_equiv f.symm := rfl
+
+@[simp] lemma map_equiv_trans (e₁ : R ≃+* S) (e₂ : S ≃+* T) :
+  map_equiv (e₁.trans e₂) = (map_equiv e₁).trans (map_equiv e₂) :=
+ring_equiv.to_ring_hom_injective $ map_comp (e₁ : R →+* S) (e₂ : S →+* T)
+
+@[simp] lemma map_equiv_refl : map_equiv (ring_equiv.refl R) = ring_equiv.refl _ :=
+ring_equiv.to_ring_hom_injective map_id
+
+/-- The group homomorphism from `ring_aut R` to `ring_aut k` where `k`
+is the residue field of `R`. -/
+@[simps] def map_aut : ring_aut R →* ring_aut (local_ring.residue_field R) :=
+{ to_fun := map_equiv,
+  map_mul' := λ e₁ e₂, map_equiv_trans e₂ e₁,
+  map_one' := map_equiv_refl }
+
+section mul_semiring_action
+variables (G : Type*) [group G] [mul_semiring_action G R]
+
+/-- If `G` acts on `R` as a `mul_semiring_action`, then it also acts on `residue_field R`. -/
+instance : mul_semiring_action G (local_ring.residue_field R) :=
+mul_semiring_action.comp_hom _ $ map_aut.comp (mul_semiring_action.to_ring_aut G R)
+
+@[simp] lemma residue_smul (g : G) (r : R) : residue R (g • r) = g • residue R r := rfl
+
+end mul_semiring_action
+
 end residue_field
 
 lemma ker_eq_maximal_ideal [field K] (φ : R →+* K) (hφ : function.surjective φ) :
   φ.ker = maximal_ideal R :=
-local_ring.eq_maximal_ideal $ φ.ker_is_maximal_of_surjective hφ
+local_ring.eq_maximal_ideal $ (ring_hom.ker_is_maximal_of_surjective φ) hφ
+
+lemma is_local_ring_hom_residue :
+  is_local_ring_hom (local_ring.residue R) :=
+begin
+  constructor,
+  intros a ha,
+  by_contra,
+  erw ideal.quotient.eq_zero_iff_mem.mpr ((local_ring.mem_maximal_ideal _).mpr h) at ha,
+  exact ha.ne_zero rfl,
+end
 
 end
 
@@ -362,3 +460,18 @@ local_ring.of_is_unit_or_is_unit_one_sub_self $ λ a,
   else or.inl $ is_unit.mk0 a h
 
 end field
+
+lemma local_ring.maximal_ideal_eq_bot {R : Type*} [field R] :
+  local_ring.maximal_ideal R = ⊥ :=
+local_ring.is_field_iff_maximal_ideal_eq.mp (field.to_is_field R)
+
+namespace ring_equiv
+
+@[reducible] protected lemma local_ring {A B : Type*} [comm_semiring A] [local_ring A]
+  [comm_semiring B] (e : A ≃+* B) : local_ring B :=
+begin
+  haveI := e.symm.to_equiv.nontrivial,
+  exact local_ring.of_surjective (e : A →+* B) e.surjective
+end
+
+end ring_equiv
diff --git a/src/ring_theory/ideal/minimal_prime.lean b/src/ring_theory/ideal/minimal_prime.lean
new file mode 100644
index 0000000000000..bcdf0bd853eb7
--- /dev/null
+++ b/src/ring_theory/ideal/minimal_prime.lean
@@ -0,0 +1,219 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+
+import ring_theory.localization.at_prime
+import order.minimal
+
+/-!
+
+# Minimal primes
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We provide various results concerning the minimal primes above an ideal
+
+## Main results
+- `ideal.minimal_primes`: `I.minimal_primes` is the set of ideals that are minimal primes over `I`.
+- `minimal_primes`: `minimal_primes R` is the set of minimal primes of `R`.
+- `ideal.exists_minimal_primes_le`: Every prime ideal over `I` contains a minimal prime over `I`.
+- `ideal.radical_minimal_primes`: The minimal primes over `I.radical` are precisely
+  the minimal primes over `I`.
+- `ideal.Inf_minimal_primes`: The intersection of minimal primes over `I` is `I.radical`.
+- `ideal.exists_minimal_primes_comap_eq` If `p` is a minimal prime over `f ⁻¹ I`, then it is the
+  preimage of some minimal prime over `I`.
+- `ideal.minimal_primes_eq_comap`: The minimal primes over `I` are precisely the preimages of
+  minimal primes of `R ⧸ I`.
+
+
+-/
+
+
+section
+
+variables {R S : Type*} [comm_ring R] [comm_ring S] (I J : ideal R)
+
+/-- `I.minimal_primes` is the set of ideals that are minimal primes over `I`. -/
+def ideal.minimal_primes : set (ideal R) :=
+minimals (≤) { p | p.is_prime ∧ I ≤ p }
+
+/-- `minimal_primes R` is the set of minimal primes of `R`.
+This is defined as `ideal.minimal_primes ⊥`. -/
+def minimal_primes (R : Type*) [comm_ring R] : set (ideal R) := ideal.minimal_primes ⊥
+
+variables {I J}
+
+lemma ideal.exists_minimal_primes_le [J.is_prime] (e : I ≤ J) :
+  ∃ p ∈ I.minimal_primes, p ≤ J :=
+begin
+  suffices : ∃ m ∈ { p : (ideal R)ᵒᵈ | ideal.is_prime p ∧ I ≤ order_dual.of_dual p },
+    (order_dual.to_dual J) ≤ m ∧
+      ∀ z ∈ { p : (ideal R)ᵒᵈ | ideal.is_prime p ∧ I ≤ p }, m ≤ z → z = m,
+  { obtain ⟨p, h₁, h₂, h₃⟩ := this,
+    simp_rw ← @eq_comm _ p at h₃,
+    exact ⟨p, ⟨h₁, λ a b c, (h₃ a b c).le⟩, h₂⟩ },
+  apply zorn_nonempty_partial_order₀,
+  swap, { refine ⟨show J.is_prime, by apply_instance, e⟩ },
+  rintros (c : set (ideal R)) hc hc' J' hJ',
+  refine ⟨order_dual.to_dual (Inf c),
+    ⟨ideal.Inf_is_prime_of_is_chain ⟨J', hJ'⟩ hc'.symm (λ x hx, (hc hx).1), _⟩, _⟩,
+  { rw order_dual.of_dual_to_dual, convert le_Inf _, intros x hx, exact (hc hx).2 },
+  { rintro z hz,
+    rw order_dual.le_to_dual,
+    exact Inf_le hz }
+end
+
+@[simp]
+lemma ideal.radical_minimal_primes : I.radical.minimal_primes = I.minimal_primes :=
+begin
+  rw [ideal.minimal_primes, ideal.minimal_primes],
+  congr,
+  ext p,
+  exact ⟨λ ⟨a, b⟩, ⟨a, ideal.le_radical.trans b⟩, λ ⟨a, b⟩, ⟨a, a.radical_le_iff.mpr b⟩⟩,
+end
+
+@[simp]
+lemma ideal.Inf_minimal_primes :
+  Inf I.minimal_primes = I.radical :=
+begin
+  rw I.radical_eq_Inf,
+  apply le_antisymm,
+  { intros x hx,
+    rw ideal.mem_Inf at hx ⊢,
+    rintros J ⟨e, hJ⟩,
+    resetI,
+    obtain ⟨p, hp, hp'⟩ := ideal.exists_minimal_primes_le e,
+    exact hp' (hx hp) },
+  { apply Inf_le_Inf _,
+    intros I hI,
+    exact hI.1.symm },
+end
+
+lemma ideal.exists_comap_eq_of_mem_minimal_primes_of_injective {f : R →+* S}
+  (hf : function.injective f) (p ∈ minimal_primes R) :
+  ∃ p' : ideal S, p'.is_prime ∧ p'.comap f = p :=
+begin
+  haveI := H.1.1,
+  haveI : nontrivial (localization (submonoid.map f p.prime_compl)),
+  { refine ⟨⟨1, 0, _⟩⟩,
+    convert (is_localization.map_injective_of_injective p.prime_compl (localization.at_prime p)
+      (localization $ p.prime_compl.map f) hf).ne one_ne_zero,
+    { rw map_one }, { rw map_zero } },
+  obtain ⟨M, hM⟩ := ideal.exists_maximal (localization (submonoid.map f p.prime_compl)),
+  resetI,
+  refine ⟨M.comap (algebra_map S $ localization (submonoid.map f p.prime_compl)),
+    infer_instance, _⟩,
+  rw [ideal.comap_comap, ← @@is_localization.map_comp _ _ _ _ localization.is_localization _
+    p.prime_compl.le_comap_map _ localization.is_localization, ← ideal.comap_comap],
+  suffices : _ ≤ p,
+  { exact this.antisymm (H.2 ⟨infer_instance, bot_le⟩ this) },
+  intros x hx,
+  by_contra h,
+  apply hM.ne_top,
+  apply M.eq_top_of_is_unit_mem hx,
+  apply is_unit.map,
+  apply is_localization.map_units _ (show p.prime_compl, from ⟨x, h⟩),
+  apply_instance
+end
+
+lemma ideal.exists_comap_eq_of_mem_minimal_primes {I : ideal S}
+  (f : R →+* S) (p ∈ (I.comap f).minimal_primes) :
+  ∃ p' : ideal S, p'.is_prime ∧ I ≤ p' ∧ p'.comap f = p :=
+begin
+  haveI := H.1.1,
+  let f' := I^.quotient.mk^.comp f,
+  have e : (I^.quotient.mk^.comp f).ker = I.comap f,
+  { ext1, exact (submodule.quotient.mk_eq_zero _) },
+  have : (I^.quotient.mk^.comp f).ker^.quotient.mk^.ker ≤ p,
+  { rw [ideal.mk_ker, e], exact H.1.2 },
+  obtain ⟨p', hp₁, hp₂⟩ := ideal.exists_comap_eq_of_mem_minimal_primes_of_injective
+    (I^.quotient.mk^.comp f).ker_lift_injective (p.map (I^.quotient.mk^.comp f).ker^.quotient.mk) _,
+  { resetI,
+    refine ⟨p'.comap I^.quotient.mk, ideal.is_prime.comap _, _, _⟩,
+    { exact ideal.mk_ker.symm.trans_le (ideal.comap_mono bot_le) },
+    convert congr_arg (ideal.comap (I^.quotient.mk^.comp f).ker^.quotient.mk) hp₂,
+    rwa [ideal.comap_map_of_surjective (I^.quotient.mk^.comp f).ker^.quotient.mk
+      ideal.quotient.mk_surjective, eq_comm, sup_eq_left] },
+  refine ⟨⟨_, bot_le⟩, _⟩,
+  { apply ideal.map_is_prime_of_surjective _ this, exact ideal.quotient.mk_surjective },
+  { rintro q ⟨hq, -⟩ hq',
+    rw ← ideal.map_comap_of_surjective (I^.quotient.mk^.comp f).ker^.quotient.mk
+      ideal.quotient.mk_surjective q,
+    apply ideal.map_mono,
+    resetI,
+    apply H.2,
+    { refine ⟨infer_instance, (ideal.mk_ker.trans e).symm.trans_le (ideal.comap_mono bot_le)⟩ },
+    { refine (ideal.comap_mono hq').trans _, rw ideal.comap_map_of_surjective,
+      exacts [sup_le rfl.le this, ideal.quotient.mk_surjective] } }
+end
+
+lemma ideal.exists_minimal_primes_comap_eq {I : ideal S}
+  (f : R →+* S) (p ∈ (I.comap f).minimal_primes) :
+  ∃ p' ∈ I.minimal_primes, ideal.comap f p' = p :=
+begin
+  obtain ⟨p', h₁, h₂, h₃⟩ := ideal.exists_comap_eq_of_mem_minimal_primes f p H,
+  resetI,
+  obtain ⟨q, hq, hq'⟩ := ideal.exists_minimal_primes_le h₂,
+  refine ⟨q, hq, eq.symm _⟩,
+  haveI := hq.1.1,
+  have := (ideal.comap_mono hq').trans_eq h₃,
+  exact (H.2 ⟨infer_instance, ideal.comap_mono hq.1.2⟩ this).antisymm this
+end
+
+lemma ideal.mimimal_primes_comap_of_surjective {f : R →+* S} (hf : function.surjective f)
+  {I J : ideal S} (h : J ∈ I.minimal_primes) :
+  J.comap f ∈ (I.comap f).minimal_primes :=
+begin
+  haveI := h.1.1,
+  refine ⟨⟨infer_instance, ideal.comap_mono h.1.2⟩, _⟩,
+  rintros K ⟨hK, e₁⟩ e₂,
+  have : f.ker ≤ K := (ideal.comap_mono bot_le).trans e₁,
+  rw [← sup_eq_left.mpr this, ring_hom.ker_eq_comap_bot, ← ideal.comap_map_of_surjective f hf],
+  apply ideal.comap_mono _,
+  apply h.2 _ _,
+  { exactI ⟨ideal.map_is_prime_of_surjective hf this,
+      ideal.le_map_of_comap_le_of_surjective f hf e₁⟩ },
+  { exact ideal.map_le_of_le_comap e₂ }
+end
+
+lemma ideal.comap_minimal_primes_eq_of_surjective {f : R →+* S} (hf : function.surjective f)
+  (I : ideal S) :
+  (I.comap f).minimal_primes = ideal.comap f '' I.minimal_primes :=
+begin
+  ext J,
+  split,
+  { intro H, obtain ⟨p, h, rfl⟩ := ideal.exists_minimal_primes_comap_eq f J H, exact ⟨p, h, rfl⟩ },
+  { rintros ⟨J, hJ, rfl⟩, exact ideal.mimimal_primes_comap_of_surjective hf hJ }
+end
+
+lemma ideal.minimal_primes_eq_comap :
+  I.minimal_primes = ideal.comap I^.quotient.mk '' minimal_primes (R ⧸ I) :=
+begin
+  rw [minimal_primes, ← ideal.comap_minimal_primes_eq_of_surjective ideal.quotient.mk_surjective,
+    ← ring_hom.ker_eq_comap_bot, ideal.mk_ker],
+end
+
+lemma ideal.minimal_primes_eq_subsingleton (hI : I.is_primary) :
+  I.minimal_primes = {I.radical} :=
+begin
+  ext J,
+  split,
+  { exact λ H, let e := H.1.1.radical_le_iff.mpr H.1.2 in
+      (H.2 ⟨ideal.is_prime_radical hI, ideal.le_radical⟩ e).antisymm e },
+  { rintro (rfl : J = I.radical),
+    exact ⟨⟨ideal.is_prime_radical hI, ideal.le_radical⟩, λ _ H _, H.1.radical_le_iff.mpr H.2⟩ }
+end
+
+lemma ideal.minimal_primes_eq_subsingleton_self [I.is_prime] :
+  I.minimal_primes = {I} :=
+begin
+  ext J,
+  split,
+  { exact λ H, (H.2 ⟨infer_instance, rfl.le⟩ H.1.2).antisymm H.1.2 },
+  { unfreezingI { rintro (rfl : J = I) }, refine ⟨⟨infer_instance, rfl.le⟩, λ _ h _, h.2⟩ },
+end
+
+end
diff --git a/src/ring_theory/ideal/norm.lean b/src/ring_theory/ideal/norm.lean
new file mode 100644
index 0000000000000..ef4f65f73d77b
--- /dev/null
+++ b/src/ring_theory/ideal/norm.lean
@@ -0,0 +1,674 @@
+/-
+Copyright (c) 2022 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen, Alex J. Best
+-/
+
+import algebra.char_p.quotient
+import data.finsupp.fintype
+import data.int.absolute_value
+import data.int.associated
+import linear_algebra.free_module.determinant
+import linear_algebra.free_module.ideal_quotient
+import ring_theory.dedekind_domain.pid
+import ring_theory.local_properties
+import ring_theory.localization.norm
+
+/-!
+
+# Ideal norms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the absolute ideal norm `ideal.abs_norm (I : ideal R) : ℕ` as the cardinality of
+the quotient `R ⧸ I` (setting it to 0 if the cardinality is infinite),
+and the relative ideal norm `ideal.span_norm R (I : ideal S) : ideal S` as the ideal spanned by
+the norms of elements in `I`.
+
+## Main definitions
+
+ * `submodule.card_quot (S : submodule R M)`: the cardinality of the quotient `M ⧸ S`, in `ℕ`.
+   This maps `⊥` to `0` and `⊤` to `1`.
+ * `ideal.abs_norm (I : ideal R)`: the absolute ideal norm, defined as
+   the cardinality of the quotient `R ⧸ I`, as a bundled monoid-with-zero homomorphism.
+ * `ideal.span_norm R (I : ideal S)`: the ideal spanned by the norms of elements in `I`.
+    This is used to define `ideal.rel_norm`.
+ * `ideal.rel_norm R (I : ideal S)`: the relative ideal norm as a bundled monoid-with-zero morphism,
+   defined as the ideal spanned by the norms of elements in `I`.
+
+## Main results
+
+ * `map_mul ideal.abs_norm`: multiplicativity of the ideal norm is bundled in
+   the definition of `ideal.abs_norm`
+ * `ideal.nat_abs_det_basis_change`: the ideal norm is given by the determinant
+   of the basis change matrix
+ * `ideal.abs_norm_span_singleton`: the ideal norm of a principal ideal is the
+   norm of its generator
+ * `map_mul ideal.rel_norm`: multiplicativity of the relative ideal norm
+-/
+
+open_locale big_operators
+open_locale non_zero_divisors
+
+section abs_norm
+
+namespace submodule
+
+variables {R M : Type*} [ring R] [add_comm_group M] [module R M]
+
+section
+
+/-- The cardinality of `(M ⧸ S)`, if `(M ⧸ S)` is finite, and `0` otherwise.
+This is used to define the absolute ideal norm `ideal.abs_norm`.
+-/
+noncomputable def card_quot (S : submodule R M) : ℕ :=
+add_subgroup.index S.to_add_subgroup
+
+@[simp] lemma card_quot_apply (S : submodule R M) [fintype (M ⧸ S)] :
+  card_quot S = fintype.card (M ⧸ S) :=
+add_subgroup.index_eq_card _
+
+variables (R M)
+
+@[simp] lemma card_quot_bot [infinite M] : card_quot (⊥ : submodule R M) = 0 :=
+add_subgroup.index_bot.trans nat.card_eq_zero_of_infinite
+
+@[simp] lemma card_quot_top : card_quot (⊤ : submodule R M) = 1 :=
+add_subgroup.index_top
+
+variables {R M}
+
+@[simp] lemma card_quot_eq_one_iff {P : submodule R M} : card_quot P = 1 ↔ P = ⊤ :=
+add_subgroup.index_eq_one.trans (by simp [set_like.ext_iff])
+
+end
+
+end submodule
+
+section ring_of_integers
+
+variables {S : Type*} [comm_ring S] [is_domain S]
+
+open submodule
+
+/-- Multiplicity of the ideal norm, for coprime ideals.
+This is essentially just a repackaging of the Chinese Remainder Theorem.
+-/
+lemma card_quot_mul_of_coprime [is_dedekind_domain S] [module.free ℤ S] [module.finite ℤ S]
+  {I J : ideal S} (coprime : I ⊔ J = ⊤) : card_quot (I * J) = card_quot I * card_quot J :=
+begin
+  let b := module.free.choose_basis ℤ S,
+  casesI is_empty_or_nonempty (module.free.choose_basis_index ℤ S),
+  { haveI : subsingleton S := function.surjective.subsingleton b.repr.to_equiv.symm.surjective,
+    nontriviality S,
+    exfalso,
+    exact not_nontrivial_iff_subsingleton.mpr ‹subsingleton S› ‹nontrivial S› },
+  haveI : infinite S := infinite.of_surjective _ b.repr.to_equiv.surjective,
+  by_cases hI : I = ⊥,
+  { rw [hI, submodule.bot_mul, card_quot_bot, zero_mul] },
+  by_cases hJ : J = ⊥,
+  { rw [hJ, submodule.mul_bot, card_quot_bot, mul_zero] },
+  have hIJ : I * J ≠ ⊥ := mt ideal.mul_eq_bot.mp (not_or hI hJ),
+
+  letI := classical.dec_eq (module.free.choose_basis_index ℤ S),
+  letI := I.fintype_quotient_of_free_of_ne_bot hI,
+  letI := J.fintype_quotient_of_free_of_ne_bot hJ,
+  letI := (I * J).fintype_quotient_of_free_of_ne_bot hIJ,
+
+  rw [card_quot_apply, card_quot_apply, card_quot_apply,
+      fintype.card_eq.mpr ⟨(ideal.quotient_mul_equiv_quotient_prod I J coprime).to_equiv⟩,
+      fintype.card_prod]
+end
+
+/-- If the `d` from `ideal.exists_mul_add_mem_pow_succ` is unique, up to `P`,
+then so are the `c`s, up to `P ^ (i + 1)`.
+Inspired by [Neukirch], proposition 6.1 -/
+lemma ideal.mul_add_mem_pow_succ_inj
+  (P : ideal S) {i : ℕ} (a d d' e e' : S) (a_mem : a ∈ P ^ i)
+  (e_mem : e ∈ P ^ (i + 1)) (e'_mem : e' ∈ P ^ (i + 1))
+  (h : d - d' ∈ P) : (a * d + e) - (a * d' + e') ∈ P ^ (i + 1) :=
+begin
+  have : a * d - a * d' ∈ P ^ (i + 1),
+  { convert ideal.mul_mem_mul a_mem h; simp [mul_sub, pow_succ, mul_comm] },
+  convert ideal.add_mem _ this (ideal.sub_mem _ e_mem e'_mem),
+  ring,
+end
+
+section P_prime
+
+variables {P : ideal S} [P_prime : P.is_prime] (hP : P ≠ ⊥)
+include P_prime hP
+
+/-- If `a ∈ P^i \ P^(i+1)` and `c ∈ P^i`, then `a * d + e = c` for `e ∈ P^(i+1)`.
+`ideal.mul_add_mem_pow_succ_unique` shows the choice of `d` is unique, up to `P`.
+Inspired by [Neukirch], proposition 6.1 -/
+lemma ideal.exists_mul_add_mem_pow_succ [is_dedekind_domain S] {i : ℕ}
+  (a c : S) (a_mem : a ∈ P ^ i) (a_not_mem : a ∉ P ^ (i + 1)) (c_mem : c ∈ P ^ i) :
+  ∃ (d : S) (e ∈ P ^ (i + 1)), a * d + e = c :=
+begin
+  suffices eq_b : P ^ i = ideal.span {a} ⊔ P ^ (i + 1),
+  { rw eq_b at c_mem,
+    simp only [mul_comm a],
+    exact ideal.mem_span_singleton_sup.mp c_mem },
+  refine (ideal.eq_prime_pow_of_succ_lt_of_le hP
+    (lt_of_le_of_ne le_sup_right _)
+    (sup_le (ideal.span_le.mpr (set.singleton_subset_iff.mpr a_mem))
+      (ideal.pow_succ_lt_pow hP i).le)).symm,
+  contrapose! a_not_mem with this,
+  rw this,
+  exact mem_sup.mpr ⟨a, mem_span_singleton_self a, 0, by simp, by simp⟩
+end
+
+lemma ideal.mem_prime_of_mul_mem_pow [is_dedekind_domain S]
+  {P : ideal S} [P_prime : P.is_prime] (hP : P ≠ ⊥) {i : ℕ}
+  {a b : S} (a_not_mem : a ∉ P ^ (i + 1))
+  (ab_mem : a * b ∈ P ^ (i + 1)) : b ∈ P :=
+begin
+  simp only [← ideal.span_singleton_le_iff_mem, ← ideal.dvd_iff_le, pow_succ,
+       ← ideal.span_singleton_mul_span_singleton] at a_not_mem ab_mem ⊢,
+  exact (prime_pow_succ_dvd_mul (ideal.prime_of_is_prime hP P_prime) ab_mem).resolve_left a_not_mem
+end
+
+/-- The choice of `d` in `ideal.exists_mul_add_mem_pow_succ` is unique, up to `P`.
+Inspired by [Neukirch], proposition 6.1 -/
+lemma ideal.mul_add_mem_pow_succ_unique [is_dedekind_domain S] {i : ℕ}
+  (a d d' e e' : S) (a_not_mem : a ∉ P ^ (i + 1))
+  (e_mem : e ∈ P ^ (i + 1)) (e'_mem : e' ∈ P ^ (i + 1))
+  (h : (a * d + e) - (a * d' + e') ∈ P ^ (i + 1)) : d - d' ∈ P :=
+begin
+  have : e' - e ∈ P ^ (i + 1) := ideal.sub_mem _ e'_mem e_mem,
+  have h' : a * (d - d') ∈ P ^ (i + 1),
+  { convert ideal.add_mem _ h (ideal.sub_mem _ e'_mem e_mem),
+    ring },
+  exact ideal.mem_prime_of_mul_mem_pow hP a_not_mem h'
+end
+
+/-- Multiplicity of the ideal norm, for powers of prime ideals. -/
+lemma card_quot_pow_of_prime [is_dedekind_domain S] [module.finite ℤ S] [module.free ℤ S] {i : ℕ} :
+  card_quot (P ^ i) = card_quot P ^ i :=
+begin
+  let b := module.free.choose_basis ℤ S,
+  classical,
+  induction i with i ih,
+  { simp },
+  letI := ideal.fintype_quotient_of_free_of_ne_bot (P ^ i.succ) (pow_ne_zero _ hP),
+  letI := ideal.fintype_quotient_of_free_of_ne_bot (P ^ i) (pow_ne_zero _ hP),
+  letI := ideal.fintype_quotient_of_free_of_ne_bot P hP,
+  have : P ^ (i + 1) < P ^ i := ideal.pow_succ_lt_pow hP i,
+  suffices hquot : map (P ^ i.succ).mkq (P ^ i) ≃ S ⧸ P,
+  { rw [pow_succ (card_quot P), ← ih, card_quot_apply (P ^ i.succ),
+      ← card_quotient_mul_card_quotient (P ^ i) (P ^ i.succ) this.le,
+      card_quot_apply (P ^ i), card_quot_apply P],
+    congr' 1,
+    rw fintype.card_eq,
+    exact ⟨hquot⟩ },
+  choose a a_mem a_not_mem using set_like.exists_of_lt this,
+  choose f g hg hf using λ c (hc : c ∈ P ^ i),
+    ideal.exists_mul_add_mem_pow_succ hP a c a_mem a_not_mem hc,
+  choose k hk_mem hk_eq using λ c' (hc' : c' ∈ (map (mkq (P ^ i.succ)) (P ^ i))),
+    submodule.mem_map.mp hc',
+  refine equiv.of_bijective (λ c', quotient.mk' (f (k c' c'.prop) (hk_mem c' c'.prop))) ⟨_, _⟩,
+  { rintros ⟨c₁', hc₁'⟩ ⟨c₂', hc₂'⟩ h,
+    rw [subtype.mk_eq_mk, ← hk_eq _ hc₁', ← hk_eq _ hc₂', mkq_apply, mkq_apply,
+        submodule.quotient.eq, ← hf _ (hk_mem _ hc₁'), ← hf _ (hk_mem _ hc₂')],
+    refine ideal.mul_add_mem_pow_succ_inj _ _ _ _ _ _ a_mem (hg _ _) (hg _ _) _,
+    simpa only [submodule.quotient.mk'_eq_mk, submodule.quotient.mk'_eq_mk, submodule.quotient.eq]
+      using h, },
+  { intros d',
+    refine quotient.induction_on' d' (λ d, _),
+    have hd' := mem_map.mpr ⟨a * d, ideal.mul_mem_right d _ a_mem, rfl⟩,
+    refine ⟨⟨_, hd'⟩, _⟩,
+    simp only [submodule.quotient.mk'_eq_mk, ideal.quotient.mk_eq_mk, ideal.quotient.eq,
+        subtype.coe_mk],
+    refine ideal.mul_add_mem_pow_succ_unique hP a _ _ _ _ a_not_mem
+      (hg _ (hk_mem _ hd'))
+      (zero_mem _)
+      _,
+    rw [hf, add_zero],
+    exact (submodule.quotient.eq _).mp (hk_eq _ hd') }
+end
+
+end P_prime
+
+/-- Multiplicativity of the ideal norm in number rings. -/
+theorem card_quot_mul [is_dedekind_domain S] [module.free ℤ S] [module.finite ℤ S] (I J : ideal S) :
+  card_quot (I * J) = card_quot I * card_quot J :=
+begin
+  let b := module.free.choose_basis ℤ S,
+  casesI is_empty_or_nonempty (module.free.choose_basis_index ℤ S),
+  { haveI : subsingleton S := function.surjective.subsingleton b.repr.to_equiv.symm.surjective,
+    nontriviality S,
+    exfalso,
+    exact not_nontrivial_iff_subsingleton.mpr ‹subsingleton S› ‹nontrivial S›, },
+  haveI : infinite S := infinite.of_surjective _ b.repr.to_equiv.surjective,
+  exact unique_factorization_monoid.multiplicative_of_coprime card_quot I J
+    (card_quot_bot _ _)
+    (λ I J hI, by simp [ideal.is_unit_iff.mp hI, ideal.mul_top])
+    (λ I i hI, have ideal.is_prime I := ideal.is_prime_of_prime hI,
+              by exactI card_quot_pow_of_prime hI.ne_zero)
+    (λ I J hIJ, card_quot_mul_of_coprime (ideal.is_unit_iff.mp (hIJ _
+      (ideal.dvd_iff_le.mpr le_sup_left)
+      (ideal.dvd_iff_le.mpr le_sup_right))))
+end
+
+/-- The absolute norm of the ideal `I : ideal R` is the cardinality of the quotient `R ⧸ I`. -/
+noncomputable def ideal.abs_norm [infinite S] [is_dedekind_domain S]
+  [module.free ℤ S] [module.finite ℤ S] :
+  ideal S →*₀ ℕ :=
+{ to_fun := submodule.card_quot,
+  map_mul' := λ I J, by rw card_quot_mul,
+  map_one' := by rw [ideal.one_eq_top, card_quot_top],
+  map_zero' := by rw [ideal.zero_eq_bot, card_quot_bot] }
+
+namespace ideal
+
+variables [infinite S] [is_dedekind_domain S] [module.free ℤ S] [module.finite ℤ S]
+
+lemma abs_norm_apply (I : ideal S) : abs_norm I = card_quot I := rfl
+
+@[simp] lemma abs_norm_bot : abs_norm (⊥ : ideal S) = 0 :=
+by rw [← ideal.zero_eq_bot, _root_.map_zero]
+
+@[simp] lemma abs_norm_top : abs_norm (⊤ : ideal S) = 1 :=
+by rw [← ideal.one_eq_top, _root_.map_one]
+
+@[simp] lemma abs_norm_eq_one_iff {I : ideal S} : abs_norm I = 1 ↔ I = ⊤ :=
+by rw [abs_norm_apply, card_quot_eq_one_iff]
+
+lemma abs_norm_ne_zero_iff (I : ideal S) : ideal.abs_norm I ≠ 0 ↔ finite (S ⧸ I) :=
+⟨λ h,nat.finite_of_card_ne_zero h,
+  λ h, (@add_subgroup.finite_index_of_finite_quotient _ _ _ h).finite_index⟩
+
+/-- Let `e : S ≃ I` be an additive isomorphism (therefore a `ℤ`-linear equiv).
+Then an alternative way to compute the norm of `I` is given by taking the determinant of `e`.
+See `nat_abs_det_basis_change` for a more familiar formulation of this result. -/
+theorem nat_abs_det_equiv (I : ideal S) {E : Type*} [add_equiv_class E S I] (e : E) :
+  int.nat_abs (linear_map.det
+      ((submodule.subtype I).restrict_scalars ℤ ∘ₗ add_monoid_hom.to_int_linear_map (e : S →+ I))) =
+  ideal.abs_norm I :=
+begin
+  -- `S ⧸ I` might be infinite if `I = ⊥`, but then `e` can't be an equiv.
+  by_cases hI : I = ⊥,
+  { unfreezingI { subst hI },
+    have : (1 : S) ≠ 0 := one_ne_zero,
+    have : (1 : S) = 0 := equiv_like.injective e (subsingleton.elim _ _),
+    contradiction },
+
+  let ι := module.free.choose_basis_index ℤ S,
+  let b := module.free.choose_basis ℤ S,
+  casesI is_empty_or_nonempty ι,
+  { nontriviality S,
+    exact (not_nontrivial_iff_subsingleton.mpr
+      (function.surjective.subsingleton b.repr.to_equiv.symm.surjective)
+      (by apply_instance)).elim },
+
+  -- Thus `(S ⧸ I)` is isomorphic to a product of `zmod`s, so it is a fintype.
+  letI := ideal.fintype_quotient_of_free_of_ne_bot I hI,
+  -- Use the Smith normal form to choose a nice basis for `I`.
+  letI := classical.dec_eq ι,
+  let a := I.smith_coeffs b hI,
+  let b' := I.ring_basis b hI,
+  let ab := I.self_basis b hI,
+  have ab_eq := I.self_basis_def b hI,
+  let e' : S ≃ₗ[ℤ] I := b'.equiv ab (equiv.refl _),
+  let f : S →ₗ[ℤ] S := (I.subtype.restrict_scalars ℤ).comp (e' : S →ₗ[ℤ] I),
+  let f_apply : ∀ x, f x = b'.equiv ab (equiv.refl _) x := λ x, rfl,
+  suffices : (linear_map.det f).nat_abs = ideal.abs_norm I,
+  { calc  (linear_map.det ((submodule.subtype I).restrict_scalars ℤ ∘ₗ _)).nat_abs
+        = (linear_map.det ((submodule.subtype I).restrict_scalars ℤ ∘ₗ
+            (↑(add_equiv.to_int_linear_equiv ↑e) : S →ₗ[ℤ] I))).nat_abs : rfl
+    ... = (linear_map.det ((submodule.subtype I).restrict_scalars ℤ ∘ₗ _)).nat_abs :
+      int.nat_abs_eq_iff_associated.mpr (linear_map.associated_det_comp_equiv _ _ _)
+    ... = abs_norm I : this },
+
+  have ha : ∀ i, f (b' i) = a i • b' i,
+  { intro i, rw [f_apply, b'.equiv_apply, equiv.refl_apply, ab_eq] },
+  have mem_I_iff : ∀ x, x ∈ I ↔ ∀ i, a i ∣ b'.repr x i,
+  { intro x, simp_rw [ab.mem_ideal_iff', ab_eq],
+    have : ∀ (c : ι → ℤ) i, b'.repr (∑ (j : ι), c j • a j • b' j) i = a i * c i,
+    { intros c i,
+      simp only [← mul_action.mul_smul, b'.repr_sum_self, mul_comm] },
+    split,
+    { rintro ⟨c, rfl⟩ i, exact ⟨c i, this c i⟩ },
+    { rintros ha,
+      choose c hc using ha, exact ⟨c, b'.ext_elem (λ i, trans (hc i) (this c i).symm)⟩ } },
+
+  -- `det f` is equal to `∏ i, a i`,
+  letI := classical.dec_eq ι,
+  calc  int.nat_abs (linear_map.det f)
+      = int.nat_abs (linear_map.to_matrix b' b' f).det : by rw linear_map.det_to_matrix
+  ... = int.nat_abs (matrix.diagonal a).det : _
+  ... = int.nat_abs (∏ i, a i) : by rw matrix.det_diagonal
+  ... = ∏ i, int.nat_abs (a i) : map_prod int.nat_abs_hom a finset.univ
+  ... = fintype.card (S ⧸ I) : _
+  ... = abs_norm I : (submodule.card_quot_apply _).symm,
+  -- since `linear_map.to_matrix b' b' f` is the diagonal matrix with `a` along the diagonal.
+  { congr, ext i j,
+    rw [linear_map.to_matrix_apply, ha, linear_equiv.map_smul, basis.repr_self, finsupp.smul_single,
+        smul_eq_mul, mul_one],
+    by_cases h : i = j,
+    { rw [h, matrix.diagonal_apply_eq, finsupp.single_eq_same] },
+    { rw [matrix.diagonal_apply_ne _ h, finsupp.single_eq_of_ne (ne.symm h)] } },
+
+  -- Now we map everything through the linear equiv `S ≃ₗ (ι → ℤ)`,
+  -- which maps `(S ⧸ I)` to `Π i, zmod (a i).nat_abs`.
+  haveI : ∀ i, ne_zero ((a i).nat_abs) := λ i,
+    ⟨int.nat_abs_ne_zero_of_ne_zero (ideal.smith_coeffs_ne_zero b I hI i)⟩,
+  simp_rw [fintype.card_eq.mpr ⟨(ideal.quotient_equiv_pi_zmod I b hI).to_equiv⟩, fintype.card_pi,
+           zmod.card] ,
+end
+
+/-- Let `b` be a basis for `S` over `ℤ` and `bI` a basis for `I` over `ℤ` of the same dimension.
+Then an alternative way to compute the norm of `I` is given by taking the determinant of `bI`
+over `b`. -/
+theorem nat_abs_det_basis_change {ι : Type*} [fintype ι] [decidable_eq ι]
+  (b : basis ι ℤ S) (I : ideal S) (bI : basis ι ℤ I) :
+  (b.det (coe ∘ bI)).nat_abs = ideal.abs_norm I :=
+begin
+  let e := b.equiv bI (equiv.refl _),
+  calc (b.det ((submodule.subtype I).restrict_scalars ℤ ∘ bI)).nat_abs
+      = (linear_map.det ((submodule.subtype I).restrict_scalars ℤ ∘ₗ (e : S →ₗ[ℤ] I))).nat_abs
+    : by rw basis.det_comp_basis
+  ... = _ : nat_abs_det_equiv I e
+end
+
+@[simp]
+lemma abs_norm_span_singleton (r : S) :
+  abs_norm (span ({r} : set S)) = (algebra.norm ℤ r).nat_abs :=
+begin
+  rw algebra.norm_apply,
+  by_cases hr : r = 0,
+  { simp only [hr, ideal.span_zero, algebra.coe_lmul_eq_mul, eq_self_iff_true, ideal.abs_norm_bot,
+      linear_map.det_zero'', set.singleton_zero, _root_.map_zero, int.nat_abs_zero] },
+  letI := ideal.fintype_quotient_of_free_of_ne_bot (span {r}) (mt span_singleton_eq_bot.mp hr),
+  let b := module.free.choose_basis ℤ S,
+  rw [← nat_abs_det_equiv _ (b.equiv (basis_span_singleton b hr) (equiv.refl _))],
+  swap, apply_instance,
+  congr,
+  refine b.ext (λ i, _),
+  simp
+end
+
+lemma abs_norm_dvd_abs_norm_of_le {I J : ideal S} (h : J ≤ I) : I.abs_norm ∣ J.abs_norm :=
+map_dvd abs_norm (dvd_iff_le.mpr h)
+
+lemma abs_norm_dvd_norm_of_mem {I : ideal S} {x : S} (h : x ∈ I) : ↑I.abs_norm ∣ algebra.norm ℤ x :=
+begin
+  rw [← int.dvd_nat_abs, ← abs_norm_span_singleton x, int.coe_nat_dvd],
+  exact abs_norm_dvd_abs_norm_of_le ((span_singleton_le_iff_mem _).mpr h)
+end
+
+@[simp]
+lemma abs_norm_span_insert (r : S) (s : set S) :
+  abs_norm (span (insert r s)) ∣ gcd (abs_norm (span s)) (algebra.norm ℤ r).nat_abs :=
+(dvd_gcd_iff _ _ _).mpr
+  ⟨abs_norm_dvd_abs_norm_of_le (span_mono (set.subset_insert _ _)),
+  trans
+    (abs_norm_dvd_abs_norm_of_le (span_mono (set.singleton_subset_iff.mpr (set.mem_insert _ _))))
+    (by rw abs_norm_span_singleton)⟩
+
+lemma irreducible_of_irreducible_abs_norm {I : ideal S} (hI : irreducible I.abs_norm) :
+  irreducible I :=
+irreducible_iff.mpr
+  ⟨λ h, hI.not_unit (by simpa only [ideal.is_unit_iff, nat.is_unit_iff, abs_norm_eq_one_iff]
+      using h),
+   by rintro a b rfl; simpa only [ideal.is_unit_iff, nat.is_unit_iff, abs_norm_eq_one_iff]
+      using hI.is_unit_or_is_unit (_root_.map_mul abs_norm a b)⟩
+
+lemma is_prime_of_irreducible_abs_norm {I : ideal S} (hI : irreducible I.abs_norm) :
+  I.is_prime :=
+is_prime_of_prime (unique_factorization_monoid.irreducible_iff_prime.mp
+  (irreducible_of_irreducible_abs_norm hI))
+
+lemma prime_of_irreducible_abs_norm_span {a : S} (ha : a ≠ 0)
+  (hI : irreducible (ideal.span ({a} : set S)).abs_norm) :
+  prime a :=
+(ideal.span_singleton_prime ha).mp (is_prime_of_irreducible_abs_norm hI)
+
+lemma abs_norm_mem (I : ideal S) : ↑I.abs_norm ∈ I :=
+by rw [abs_norm_apply, card_quot, ← ideal.quotient.eq_zero_iff_mem, map_nat_cast,
+       quotient.index_eq_zero]
+
+lemma span_singleton_abs_norm_le (I : ideal S) :
+  ideal.span { (ideal.abs_norm I : S) } ≤ I :=
+by simp only [ideal.span_le, set.singleton_subset_iff, set_like.mem_coe, ideal.abs_norm_mem I]
+
+lemma finite_set_of_abs_norm_eq [char_zero S] {n : ℕ} (hn : 0 < n) :
+  { I : ideal S | ideal.abs_norm I = n }.finite :=
+begin
+  let f := λ I : ideal S, ideal.map (ideal.quotient.mk (@ideal.span S _ {n})) I,
+  refine @set.finite.of_finite_image _ _ _ f _ _,
+  { suffices : finite (S ⧸ @ideal.span S _ {n}),
+    { let g := (coe : ideal (S ⧸ @ideal.span S _ {n}) → set (S ⧸ @ideal.span S _ {n})),
+      refine @set.finite.of_finite_image _ _ _ g _ (set_like.coe_injective.inj_on _),
+      exact set.finite.subset (@set.finite_univ _ (@set.finite' _ this)) ( set.subset_univ _), },
+    rw [← abs_norm_ne_zero_iff, abs_norm_span_singleton],
+    simpa only [ne.def, int.nat_abs_eq_zero, algebra.norm_eq_zero_iff, nat.cast_eq_zero]
+      using ne_of_gt hn, },
+  { intros I hI J hJ h,
+    rw [← comap_map_mk (span_singleton_abs_norm_le I), ← hI.symm,
+      ← comap_map_mk (span_singleton_abs_norm_le J), ← hJ.symm],
+    exact congr_arg (ideal.comap (ideal.quotient.mk (@ideal.span S _ {n}))) h, },
+end
+
+end ideal
+
+end ring_of_integers
+
+end abs_norm
+
+section span_norm
+
+namespace ideal
+
+open submodule
+
+variables (R : Type*) [comm_ring R] {S : Type*} [comm_ring S] [algebra R S]
+
+/-- `ideal.span_norm R (I : ideal S)` is the ideal generated by mapping `algebra.norm R` over `I`.
+
+See also `ideal.rel_norm`.
+-/
+def span_norm (I : ideal S) : ideal R :=
+ideal.span (algebra.norm R '' (I : set S))
+
+@[simp] lemma span_norm_bot
+  [nontrivial S] [module.free R S] [module.finite R S] :
+  span_norm R (⊥ : ideal S) = ⊥ :=
+span_eq_bot.mpr (λ x hx, by simpa using hx)
+
+variables {R}
+
+@[simp] lemma span_norm_eq_bot_iff [is_domain R] [is_domain S]
+  [module.free R S] [module.finite R S] {I : ideal S} :
+  span_norm R I = ⊥ ↔ I = ⊥ :=
+begin
+  simp only [span_norm, ideal.span_eq_bot, set.mem_image, set_like.mem_coe, forall_exists_index,
+    and_imp, forall_apply_eq_imp_iff₂,
+    algebra.norm_eq_zero_iff_of_basis (module.free.choose_basis R S), @eq_bot_iff _ _ _ I,
+    set_like.le_def],
+  refl
+end
+
+variables (R)
+
+lemma norm_mem_span_norm {I : ideal S} (x : S) (hx : x ∈ I) : algebra.norm R x ∈ I.span_norm R :=
+subset_span (set.mem_image_of_mem _ hx)
+
+@[simp] lemma span_norm_singleton {r : S} :
+  span_norm R (span ({r} : set S)) = span {algebra.norm R r} :=
+le_antisymm
+  (span_le.mpr (λ x hx, mem_span_singleton.mpr begin
+    obtain ⟨x, hx', rfl⟩ := (set.mem_image _ _ _).mp hx,
+    exact map_dvd _ (mem_span_singleton.mp hx')
+  end))
+  ((span_singleton_le_iff_mem _).mpr (norm_mem_span_norm _ _ (mem_span_singleton_self _)))
+
+@[simp] lemma span_norm_top : span_norm R (⊤ : ideal S) = ⊤ :=
+by simp [← ideal.span_singleton_one]
+
+lemma map_span_norm (I : ideal S) {T : Type*} [comm_ring T] (f : R →+* T) :
+  map f (span_norm R I) = span ((f ∘ algebra.norm R) '' (I : set S)) :=
+by rw [span_norm, map_span, set.image_image]
+
+@[mono]
+lemma span_norm_mono {I J : ideal S} (h : I ≤ J) : span_norm R I ≤ span_norm R J :=
+ideal.span_mono (set.monotone_image h)
+
+lemma span_norm_localization (I : ideal S) [module.finite R S] [module.free R S]
+  (M : submonoid R) {Rₘ : Type*} (Sₘ : Type*)
+  [comm_ring Rₘ] [algebra R Rₘ] [comm_ring Sₘ] [algebra S Sₘ]
+  [algebra Rₘ Sₘ] [algebra R Sₘ] [is_scalar_tower R Rₘ Sₘ] [is_scalar_tower R S Sₘ]
+  [is_localization M Rₘ] [is_localization (algebra.algebra_map_submonoid S M) Sₘ] :
+  span_norm Rₘ (I.map (algebra_map S Sₘ)) = (span_norm R I).map (algebra_map R Rₘ) :=
+begin
+  casesI h : subsingleton_or_nontrivial R,
+  { haveI := is_localization.unique R Rₘ M,
+    simp },
+  let b := module.free.choose_basis R S,
+  rw map_span_norm,
+  refine span_eq_span (set.image_subset_iff.mpr _) (set.image_subset_iff.mpr _),
+  { rintros a' ha',
+    simp only [set.mem_preimage, submodule_span_eq, ← map_span_norm, set_like.mem_coe,
+        is_localization.mem_map_algebra_map_iff (algebra.algebra_map_submonoid S M) Sₘ,
+        is_localization.mem_map_algebra_map_iff M Rₘ, prod.exists]
+      at ⊢ ha',
+    obtain ⟨⟨a, ha⟩, ⟨_, ⟨s, hs, rfl⟩⟩, has⟩ := ha',
+    refine ⟨⟨algebra.norm R a, norm_mem_span_norm _ _ ha⟩,
+            ⟨s ^ fintype.card (module.free.choose_basis_index R S), pow_mem hs _⟩, _⟩,
+    swap,
+    simp only [submodule.coe_mk, subtype.coe_mk, map_pow] at ⊢ has,
+    apply_fun algebra.norm Rₘ at has,
+    rwa [_root_.map_mul, ← is_scalar_tower.algebra_map_apply,
+        is_scalar_tower.algebra_map_apply R Rₘ,
+        algebra.norm_algebra_map_of_basis (b.localization_localization Rₘ M Sₘ),
+        algebra.norm_localization R M a] at has,
+    all_goals { apply_instance } },
+  { intros a ha,
+    rw [set.mem_preimage, function.comp_app, ← algebra.norm_localization R M a],
+    exact subset_span (set.mem_image_of_mem _ (mem_map_of_mem _ ha)),
+    all_goals { apply_instance } },
+end
+
+lemma span_norm_mul_span_norm_le (I J : ideal S) :
+  span_norm R I * span_norm R J ≤ span_norm R (I * J) :=
+begin
+  rw [span_norm, span_norm, span_norm, ideal.span_mul_span', ← set.image_mul],
+  refine ideal.span_mono (set.monotone_image _),
+  rintros _ ⟨x, y, hxI, hyJ, rfl⟩,
+  exact ideal.mul_mem_mul hxI hyJ
+end
+
+/-- This condition `eq_bot_or_top` is equivalent to being a field.
+However, `span_norm_mul_of_field` is harder to apply since we'd need to upgrade a `comm_ring R`
+instance to a `field R` instance. -/
+lemma span_norm_mul_of_bot_or_top [is_domain R] [is_domain S]
+  [module.free R S] [module.finite R S]
+  (eq_bot_or_top : ∀ I : ideal R, I = ⊥ ∨ I = ⊤)
+  (I J : ideal S) :
+  span_norm R (I * J) = span_norm R I * span_norm R J :=
+begin
+  refine le_antisymm _ (span_norm_mul_span_norm_le _ _ _),
+  cases eq_bot_or_top (span_norm R I) with hI hI,
+  { rw [hI, span_norm_eq_bot_iff.mp hI, bot_mul, span_norm_bot],
+    exact bot_le },
+  rw [hI, ideal.top_mul],
+  cases eq_bot_or_top (span_norm R J) with hJ hJ,
+  { rw [hJ, span_norm_eq_bot_iff.mp hJ, mul_bot, span_norm_bot],
+    exact bot_le },
+  rw hJ,
+  exact le_top
+end
+
+@[simp] lemma span_norm_mul_of_field {K : Type*} [field K] [algebra K S] [is_domain S]
+  [module.finite K S] (I J : ideal S) :
+  span_norm K (I * J) = span_norm K I * span_norm K J :=
+span_norm_mul_of_bot_or_top K eq_bot_or_top I J
+
+variables [is_domain R] [is_domain S] [is_dedekind_domain R] [is_dedekind_domain S]
+variables [module.finite R S] [module.free R S]
+
+/-- Multiplicativity of `ideal.span_norm`. simp-normal form is `map_mul (ideal.rel_norm R)`. -/
+lemma span_norm_mul (I J : ideal S) : span_norm R (I * J) = span_norm R I * span_norm R J :=
+begin
+  nontriviality R,
+  casesI subsingleton_or_nontrivial S,
+  { have : ∀ I : ideal S, I = ⊤ := λ I, subsingleton.elim I ⊤,
+    simp [this I, this J, this (I * J)] },
+  refine eq_of_localization_maximal _,
+  unfreezingI { intros P hP },
+  by_cases hP0 : P = ⊥,
+  { unfreezingI { subst hP0 },
+    rw span_norm_mul_of_bot_or_top,
+    intros I,
+    refine or_iff_not_imp_right.mpr (λ hI, _),
+    exact (hP.eq_of_le hI bot_le).symm },
+  let P' := algebra.algebra_map_submonoid S P.prime_compl,
+  letI : algebra (localization.at_prime P) (localization P') :=
+    localization_algebra P.prime_compl S,
+  haveI : is_scalar_tower R (localization.at_prime P) (localization P') :=
+    is_scalar_tower.of_algebra_map_eq (λ x, (is_localization.map_eq _ _).symm),
+  have h : P' ≤ S⁰ :=
+    map_le_non_zero_divisors_of_injective _ (no_zero_smul_divisors.algebra_map_injective _ _)
+      P.prime_compl_le_non_zero_divisors,
+  haveI : is_domain (localization P') := is_localization.is_domain_localization h,
+  haveI : is_dedekind_domain (localization P') := is_localization.is_dedekind_domain S h _,
+  letI := classical.dec_eq (ideal (localization P')),
+  haveI : is_principal_ideal_ring (localization P') :=
+    is_dedekind_domain.is_principal_ideal_ring_localization_over_prime S P hP0,
+  rw [ideal.map_mul, ← span_norm_localization R I P.prime_compl (localization P'),
+    ← span_norm_localization R J P.prime_compl (localization P'),
+    ← span_norm_localization R (I * J) P.prime_compl (localization P'), ideal.map_mul,
+    ← (I.map _).span_singleton_generator, ← (J.map _).span_singleton_generator,
+    span_singleton_mul_span_singleton, span_norm_singleton, span_norm_singleton,
+    span_norm_singleton, span_singleton_mul_span_singleton, _root_.map_mul],
+  repeat { apply_instance },
+  repeat { assumption },
+end
+
+/-- The relative norm `ideal.rel_norm R (I : ideal S)`, where `R` and `S` are Dedekind domains,
+and `S` is an extension of `R` that is finite and free as a module. -/
+def rel_norm : ideal S →*₀ ideal R :=
+{ to_fun := span_norm R,
+  map_zero' := span_norm_bot R,
+  map_one' := by rw [one_eq_top, span_norm_top R, one_eq_top],
+  map_mul' := span_norm_mul R }
+
+lemma rel_norm_apply (I : ideal S) :
+  rel_norm R I = span (algebra.norm R '' (I : set S) : set R) :=
+rfl
+
+@[simp] lemma span_norm_eq (I : ideal S) : span_norm R I = rel_norm R I := rfl
+
+@[simp] lemma rel_norm_bot : rel_norm R (⊥ : ideal S) = ⊥ :=
+by simpa only [zero_eq_bot] using map_zero (rel_norm R : ideal S →*₀ _)
+
+@[simp] lemma rel_norm_top : rel_norm R (⊤ : ideal S) = ⊤ :=
+by simpa only [one_eq_top] using map_one (rel_norm R : ideal S →*₀ _)
+
+variables {R}
+
+@[simp] lemma rel_norm_eq_bot_iff {I : ideal S} : rel_norm R I = ⊥ ↔ I = ⊥ :=
+span_norm_eq_bot_iff
+
+variables (R)
+
+lemma norm_mem_rel_norm (I : ideal S) {x : S} (hx : x ∈ I) : algebra.norm R x ∈ rel_norm R I :=
+norm_mem_span_norm R x hx
+
+@[simp] lemma rel_norm_singleton (r : S) :
+  rel_norm R (span ({r} : set S)) = span {algebra.norm R r} :=
+span_norm_singleton R
+
+lemma map_rel_norm (I : ideal S) {T : Type*} [comm_ring T] (f : R →+* T) :
+  map f (rel_norm R I) = span ((f ∘ algebra.norm R) '' (I : set S)) :=
+map_span_norm R I f
+
+@[mono]
+lemma rel_norm_mono {I J : ideal S} (h : I ≤ J) : rel_norm R I ≤ rel_norm R J :=
+span_norm_mono R h
+
+end ideal
+
+end span_norm
diff --git a/src/ring_theory/ideal/operations.lean b/src/ring_theory/ideal/operations.lean
index 54a445ca08fa1..aef44435a9b5a 100644
--- a/src/ring_theory/ideal/operations.lean
+++ b/src/ring_theory/ideal/operations.lean
@@ -6,11 +6,15 @@ Authors: Kenny Lau
 import algebra.algebra.operations
 import algebra.ring.equiv
 import data.nat.choose.sum
+import linear_algebra.basis.bilinear
 import ring_theory.coprime.lemmas
-import ring_theory.ideal.quotient
+import ring_theory.ideal.basic
 import ring_theory.non_zero_divisors
 /-!
 # More operations on modules and ideals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 universes u v w x
 
@@ -18,15 +22,19 @@ open_locale big_operators pointwise
 
 namespace submodule
 
-variables {R : Type u} {M : Type v}
+variables {R : Type u} {M : Type v} {F : Type*} {G : Type*}
 
 section comm_semiring
 variables [comm_semiring R] [add_comm_monoid M] [module R M]
 
 open_locale pointwise
 
-instance has_scalar' : has_scalar (ideal R) (submodule R M) :=
-⟨λ I N, ⨆ r : I, (r : R) • N⟩
+instance has_smul' : has_smul (ideal R) (submodule R M) :=
+⟨submodule.map₂ (linear_map.lsmul R M)⟩
+
+/-- This duplicates the global `smul_eq_mul`, but doesn't have to unfold anywhere near as much to
+apply. -/
+protected lemma _root_.ideal.smul_eq_mul (I J : ideal R) : I • J = I * J := rfl
 
 /-- `N.annihilator` is the ideal of all elements `r : R` such that `r • N = 0`. -/
 def annihilator (N : submodule R M) : ideal R :=
@@ -38,7 +46,7 @@ theorem mem_annihilator {r} : r ∈ N.annihilator ↔ ∀ n ∈ N, r • n = (0:
 ⟨λ hr n hn, congr_arg subtype.val (linear_map.ext_iff.1 (linear_map.mem_ker.1 hr) ⟨n, hn⟩),
 λ h, linear_map.mem_ker.2 $ linear_map.ext $ λ n, subtype.eq $ h n.1 n.2⟩
 
-theorem mem_annihilator' {r} : r ∈ N.annihilator ↔ N ≤ comap (r • linear_map.id) ⊥ :=
+theorem mem_annihilator' {r} : r ∈ N.annihilator ↔ N ≤ comap (r • (linear_map.id : M →ₗ[R] M)) ⊥ :=
 mem_annihilator.trans ⟨λ H n hn, (mem_bot R).2 $ H n hn, λ H n hn, (mem_bot R).1 $ H hn⟩
 
 lemma mem_annihilator_span (s : set M) (r : R) :
@@ -76,12 +84,9 @@ le_antisymm (le_infi $ λ i, annihilator_mono $ le_supr _ _)
 (λ r H, mem_annihilator'.2 $ supr_le $ λ i,
   have _ := (mem_infi _).1 H i, mem_annihilator'.1 this)
 
-theorem smul_mem_smul {r} {n} (hr : r ∈ I) (hn : n ∈ N) : r • n ∈ I • N :=
-(le_supr _ ⟨r, hr⟩ : _ ≤ I • N) ⟨n, hn, rfl⟩
+theorem smul_mem_smul {r} {n} (hr : r ∈ I) (hn : n ∈ N) : r • n ∈ I • N := apply_mem_map₂ _ hr hn
 
-theorem smul_le {P : submodule R M} : I • N ≤ P ↔ ∀ (r ∈ I) (n ∈ N), r • n ∈ P :=
-⟨λ H r hr n hn, H $ smul_mem_smul hr hn,
-λ H, supr_le $ λ r, map_le_iff_le_comap.2 $ λ n hn, H r.1 r.2 n hn⟩
+theorem smul_le {P : submodule R M} : I • N ≤ P ↔ ∀ (r ∈ I) (n ∈ N), r • n ∈ P := map₂_le
 
 @[elab_as_eliminator]
 theorem smul_induction_on {p : M → Prop} {x} (H : x ∈ I • N)
@@ -94,6 +99,21 @@ begin
   exact Hb _ hi _ hj,
 end
 
+/-- Dependent version of `submodule.smul_induction_on`. -/
+@[elab_as_eliminator]
+theorem smul_induction_on' {x : M} (hx : x ∈ I • N)
+  {p : Π x, x ∈ I • N → Prop}
+  (Hb : ∀ (r : R) (hr : r ∈ I) (n : M) (hn : n ∈ N),
+    p (r • n) (smul_mem_smul hr hn))
+  (H1 : ∀ x hx y hy, p x hx → p y hy → p (x + y) (submodule.add_mem _ ‹_› ‹_›)) :
+  p x hx :=
+begin
+  refine exists.elim _ (λ (h : x ∈ I • N) (H : p x h), H),
+  exact smul_induction_on hx
+    (λ a ha x hx, ⟨_, Hb _ ha _ hx⟩)
+    (λ x y ⟨_, hx⟩ ⟨_, hy⟩, ⟨_, H1 _ _ _ _ hx hy⟩),
+end
+
 theorem mem_smul_span_singleton {I : ideal R} {m : M} {x : M} :
   x ∈ I • span R ({m} : set M) ↔ ∃ y ∈ I, y • m = x :=
 ⟨λ hx, smul_induction_on hx
@@ -106,14 +126,11 @@ theorem mem_smul_span_singleton {I : ideal R} {m : M} {x : M} :
 theorem smul_le_right : I • N ≤ N :=
 smul_le.2 $ λ r hr n, N.smul_mem r
 
-theorem smul_mono (hij : I ≤ J) (hnp : N ≤ P) : I • N ≤ J • P :=
-smul_le.2 $ λ r hr n hn, smul_mem_smul (hij hr) (hnp hn)
+theorem smul_mono (hij : I ≤ J) (hnp : N ≤ P) : I • N ≤ J • P := map₂_le_map₂ hij hnp
 
-theorem smul_mono_left (h : I ≤ J) : I • N ≤ J • N :=
-smul_mono h (le_refl N)
+theorem smul_mono_left (h : I ≤ J) : I • N ≤ J • N := map₂_le_map₂_left h
 
-theorem smul_mono_right (h : N ≤ P) : I • N ≤ I • P :=
-smul_mono (le_refl I) h
+theorem smul_mono_right (h : N ≤ P) : I • N ≤ I • P := map₂_le_map₂_right h
 
 lemma map_le_smul_top (I : ideal R) (f : R →ₗ[R] M) :
   submodule.map f I ≤ I • (⊤ : submodule R M) :=
@@ -133,28 +150,16 @@ annihilator_smul I
 by rw [mul_comm, annihilator_mul]
 
 variables (I J N P)
-@[simp] theorem smul_bot : I • (⊥ : submodule R M) = ⊥ :=
-eq_bot_iff.2 $ smul_le.2 $ λ r hri s hsb,
-(submodule.mem_bot R).2 $ ((submodule.mem_bot R).1 hsb).symm ▸ smul_zero r
+@[simp] theorem smul_bot : I • (⊥ : submodule R M) = ⊥ := map₂_bot_right _ _
 
-@[simp] theorem bot_smul : (⊥ : ideal R) • N = ⊥ :=
-eq_bot_iff.2 $ smul_le.2 $ λ r hrb s hsi,
-(submodule.mem_bot R).2 $ ((submodule.mem_bot R).1 hrb).symm ▸ zero_smul _ s
+@[simp] theorem bot_smul : (⊥ : ideal R) • N = ⊥ := map₂_bot_left _ _
 
 @[simp] theorem top_smul : (⊤ : ideal R) • N = N :=
 le_antisymm smul_le_right $ λ r hri, one_smul R r ▸ smul_mem_smul mem_top hri
 
-theorem smul_sup : I • (N ⊔ P) = I • N ⊔ I • P :=
-le_antisymm (smul_le.2 $ λ r hri m hmnp, let ⟨n, hn, p, hp, hnpm⟩ := mem_sup.1 hmnp in
-  mem_sup.2 ⟨_, smul_mem_smul hri hn, _, smul_mem_smul hri hp, hnpm ▸ (smul_add _ _ _).symm⟩)
-(sup_le (smul_mono_right le_sup_left)
-  (smul_mono_right le_sup_right))
+theorem smul_sup : I • (N ⊔ P) = I • N ⊔ I • P := map₂_sup_right _ _ _ _
 
-theorem sup_smul : (I ⊔ J) • N = I • N ⊔ J • N :=
-le_antisymm (smul_le.2 $ λ r hrij n hn, let ⟨ri, hri, rj, hrj, hrijr⟩ := mem_sup.1 hrij in
-  mem_sup.2 ⟨_, smul_mem_smul hri hn, _, smul_mem_smul hrj hn, hrijr ▸ (add_smul _ _ _).symm⟩)
-(sup_le (smul_mono_left le_sup_left)
-  (smul_mono_left le_sup_right))
+theorem sup_smul : (I ⊔ J) • N = I • N ⊔ J • N := map₂_sup_left _ _ _ _
 
 protected theorem smul_assoc : (I • J) • N = I • (J • N) :=
 le_antisymm (smul_le.2 $ λ rs hrsij t htn,
@@ -162,48 +167,38 @@ le_antisymm (smul_le.2 $ λ rs hrsij t htn,
   (λ r hr s hs,
     (@smul_eq_mul R _ r s).symm ▸ smul_smul r s t ▸ smul_mem_smul hr (smul_mem_smul hs htn))
   (λ x y, (add_smul x y t).symm ▸ submodule.add_mem _))
-(smul_le.2 $ λ r hr sn hsn, suffices J • N ≤ submodule.comap (r • linear_map.id) ((I • J) • N),
+(smul_le.2 $ λ r hr sn hsn,
+  suffices J • N ≤ submodule.comap (r • (linear_map.id : M →ₗ[R] M)) ((I • J) • N),
   from this hsn,
 smul_le.2 $ λ s hs n hn, show r • (s • n) ∈ (I • J) • N,
   from mul_smul r s n ▸ smul_mem_smul (smul_mem_smul hr hs) hn)
 
+lemma smul_inf_le (M₁ M₂ : submodule R M) : I • (M₁ ⊓ M₂) ≤ I • M₁ ⊓ I • M₂ :=
+le_inf (submodule.smul_mono_right inf_le_left) (submodule.smul_mono_right inf_le_right)
+
+lemma smul_supr {ι : Sort*} {I : ideal R} {t : ι → submodule R M} :
+  I • supr t = ⨆ i, I • t i :=
+map₂_supr_right _ _ _
+
+lemma smul_infi_le {ι : Sort*} {I : ideal R} {t : ι → submodule R M} :
+  I • infi t ≤ ⨅ i, I • t i :=
+le_infi (λ i, smul_mono_right (infi_le _ _))
+
 variables (S : set R) (T : set M)
 
 theorem span_smul_span : (ideal.span S) • (span R T) =
   span R (⋃ (s ∈ S) (t ∈ T), {s • t}) :=
-le_antisymm (smul_le.2 $ λ r hrS n hnT, span_induction hrS
-  (λ r hrS, span_induction hnT
-    (λ n hnT, subset_span $ set.mem_bUnion hrS $
-      set.mem_bUnion hnT $ set.mem_singleton _)
-    ((smul_zero r : r • 0 = (0:M)).symm ▸ submodule.zero_mem _)
-    (λ x y, (smul_add r x y).symm ▸ submodule.add_mem _)
-    (λ c m, by rw [smul_smul, mul_comm, mul_smul]; exact submodule.smul_mem _ _))
-  ((zero_smul R n).symm ▸ submodule.zero_mem _)
-  (λ r s, (add_smul r s n).symm ▸ submodule.add_mem _)
-  (λ c r, by rw [smul_eq_mul, mul_smul]; exact submodule.smul_mem _ _)) $
-span_le.2 $ set.Union₂_subset $ λ r hrS, set.Union₂_subset $ λ n hnT, set.singleton_subset_iff.2 $
-smul_mem_smul (subset_span hrS) (subset_span hnT)
-
-lemma union_eq_smul_set (r : R) (T : set M) :
-  (⋃ (t : M) (x : t ∈ T), {r • t}) = r • T := by tidy
+(map₂_span_span _ _ _ _).trans $ congr_arg _ $ set.image2_eq_Union _ _ _
 
 lemma ideal_span_singleton_smul (r : R) (N : submodule R M) :
   (ideal.span {r} : ideal R) • N = r • N :=
 begin
   have : span R (⋃ (t : M) (x : t ∈ N), {r • t}) = r • N,
-  { convert span_eq _, exact union_eq_smul_set r (N : set M) },
+  { convert span_eq _, exact (set.image_eq_Union _ (N : set M)).symm },
   conv_lhs { rw [← span_eq N, span_smul_span] },
   simpa
 end
 
-lemma span_smul_eq (r : R) (s : set M) :
-  span R (r • s) = r • span R s :=
-begin
-  rw [← ideal_span_singleton_smul, span_smul_span],
-  congr,
-  simpa using (union_eq_smul_set r s).symm
-end
-
 lemma mem_of_span_top_of_smul_mem (M' : submodule R M)
   (s : set R) (hs : ideal.span s = ⊤) (x : M) (H : ∀ r : s, (r : R) • x ∈ M') : x ∈ M' :=
 begin
@@ -249,21 +244,24 @@ variables (I)
 
 /-- If `x` is an `I`-multiple of the submodule spanned by `f '' s`,
 then we can write `x` as an `I`-linear combination of the elements of `f '' s`. -/
-lemma exists_sum_of_mem_ideal_smul_span {ι : Type*} (s : set ι) (f : ι → M) (x : M)
-  (hx : x ∈ I • span R (f '' s)) :
-  ∃ (a : s →₀ R) (ha : ∀ i, a i ∈ I), a.sum (λ i c, c • f i) = x :=
+lemma mem_ideal_smul_span_iff_exists_sum {ι : Type*} (f : ι → M) (x : M) :
+  x ∈ I • span R (set.range f) ↔
+  ∃ (a : ι →₀ R) (ha : ∀ i, a i ∈ I), a.sum (λ i c, c • f i) = x :=
 begin
-  refine span_induction (mem_smul_span.mp hx) _ _ _ _,
+  split, swap,
+  { rintro ⟨a, ha, rfl⟩,
+    exact submodule.sum_mem _ (λ c _, smul_mem_smul (ha c) $ subset_span $ set.mem_range_self _) },
+  refine λ hx, span_induction (mem_smul_span.mp hx) _ _ _ _,
   { simp only [set.mem_Union, set.mem_range, set.mem_singleton_iff],
-    rintros x ⟨y, hy, x, ⟨i, hi, rfl⟩, rfl⟩,
-    refine ⟨finsupp.single ⟨i, hi⟩ y, λ j, _, _⟩,
-    { letI := classical.dec_eq s,
+    rintros x ⟨y, hy, x, ⟨i, rfl⟩, rfl⟩,
+    refine ⟨finsupp.single i y, λ j, _, _⟩,
+    { letI := classical.dec_eq ι,
       rw finsupp.single_apply, split_ifs, { assumption }, { exact I.zero_mem } },
-    refine @finsupp.sum_single_index s R M _ _ ⟨i, hi⟩ _ (λ i y, y • f i) _,
+    refine @finsupp.sum_single_index ι R M _ _ i _ (λ i y, y • f i) _,
     simp },
   { exact ⟨0, λ i, I.zero_mem, finsupp.sum_zero_index⟩ },
   { rintros x y ⟨ax, hax, rfl⟩ ⟨ay, hay, rfl⟩,
-    refine ⟨ax + ay, λ i, I.add_mem (hax i) (hay i), finsupp.sum_add_index _ _⟩;
+    refine ⟨ax + ay, λ i, I.add_mem (hax i) (hay i), finsupp.sum_add_index' _ _⟩;
       intros; simp only [zero_smul, add_smul] },
   { rintros c x ⟨a, ha, rfl⟩,
     refine ⟨c • a, λ i, I.mul_mem_left c (ha i), _⟩,
@@ -271,6 +269,22 @@ begin
       intros; simp only [zero_smul, mul_smul] },
 end
 
+theorem mem_ideal_smul_span_iff_exists_sum' {ι : Type*} (s : set ι) (f : ι → M) (x : M) :
+  x ∈ I • span R (f '' s) ↔
+  ∃ (a : s →₀ R) (ha : ∀ i, a i ∈ I), a.sum (λ i c, c • f i) = x :=
+by rw [← submodule.mem_ideal_smul_span_iff_exists_sum, ← set.image_eq_range]
+
+lemma mem_smul_top_iff  (N : submodule R M) (x : N) :
+  x ∈ I • (⊤ : submodule R N) ↔ (x : M) ∈ I • N :=
+begin
+  change _ ↔ N.subtype x ∈ I • N,
+  have : submodule.map N.subtype (I • ⊤) = I • N,
+  { rw [submodule.map_smul'', submodule.map_top, submodule.range_subtype] },
+  rw ← this,
+  convert (function.injective.mem_set_image N.injective_subtype).symm using 1,
+  refl,
+end
+
 @[simp] lemma smul_comap_le_comap_smul (f : M →ₗ[R] M') (S : submodule R M') (I : ideal R) :
   I • S.comap f ≤ (I • S).comap f :=
 begin
@@ -295,7 +309,7 @@ theorem mem_colon {r} : r ∈ N.colon P ↔ ∀ p ∈ P, r • p ∈ N :=
 mem_annihilator.trans ⟨λ H p hp, (quotient.mk_eq_zero N).1 (H (quotient.mk p) (mem_map_of_mem hp)),
 λ H m ⟨p, hp, hpm⟩, hpm ▸ (N.mkq).map_smul r p ▸ (quotient.mk_eq_zero N).2 $ H p hp⟩
 
-theorem mem_colon' {r} : r ∈ N.colon P ↔ P ≤ comap (r • linear_map.id) N :=
+theorem mem_colon' {r} : r ∈ N.colon P ↔ P ≤ comap (r • (linear_map.id : M →ₗ[R] M)) N :=
 mem_colon
 
 theorem colon_mono (hn : N₁ ≤ N₂) (hp : P₁ ≤ P₂) : N₁.colon P₂ ≤ N₂.colon P₁ :=
@@ -309,20 +323,40 @@ le_antisymm (le_infi $ λ i, le_infi $ λ j, colon_mono (infi_le _ _) (le_supr _
   map_le_iff_le_comap.2 $ mem_colon'.1 $ have _ := ((mem_infi _).1 H i),
   have _ := ((mem_infi _).1 this j), this)
 
+@[simp] lemma mem_colon_singleton {N : submodule R M} {x : M} {r : R} :
+  r ∈ N.colon (submodule.span R {x}) ↔ r • x ∈ N :=
+calc r ∈ N.colon (submodule.span R {x}) ↔ ∀ (a : R), r • (a • x) ∈ N :
+  by simp [submodule.mem_colon, submodule.mem_span_singleton]
+                                    ... ↔ r • x ∈ N :
+  by { simp_rw [smul_comm r]; exact set_like.forall_smul_mem_iff }
+
+@[simp] lemma _root_.ideal.mem_colon_singleton {I : ideal R} {x r : R} :
+  r ∈ I.colon (ideal.span {x}) ↔ r * x ∈ I :=
+by simp [← ideal.submodule_span_eq, submodule.mem_colon_singleton, smul_eq_mul]
+
 end comm_ring
 
 end submodule
 
 namespace ideal
 
+section add
+
+variables {R : Type u} [semiring R]
+
+@[simp] lemma add_eq_sup {I J : ideal R} : I + J = I ⊔ J := rfl
+@[simp] lemma zero_eq_bot : (0 : ideal R) = ⊥ := rfl
+
+@[simp] lemma sum_eq_sup {ι : Type*} (s : finset ι) (f : ι → ideal R) : s.sum f = s.sup f := rfl
+
+end add
+
 section mul_and_radical
 variables {R : Type u} {ι : Type*} [comm_semiring R]
 variables {I J K L : ideal R}
 
 instance : has_mul (ideal R) := ⟨(•)⟩
 
-@[simp] lemma add_eq_sup : I + J = I ⊔ J := rfl
-@[simp] lemma zero_eq_bot : (0 : ideal R) = ⊥ := rfl
 @[simp] lemma one_eq_top : (1 : ideal R) = ⊤ :=
 by erw [submodule.one_eq_range, linear_map.range_id]
 
@@ -333,9 +367,18 @@ theorem mul_mem_mul_rev {r s} (hr : r ∈ I) (hs : s ∈ J) : s * r ∈ I * J :=
 mul_comm r s ▸ mul_mem_mul hr hs
 
 lemma pow_mem_pow {x : R} (hx : x ∈ I) (n : ℕ) : x ^ n ∈ I ^ n :=
+submodule.pow_mem_pow _ hx _
+
+lemma prod_mem_prod {ι : Type*} {s : finset ι} {I : ι → ideal R} {x : ι → R} :
+  (∀ i ∈ s, x i ∈ I i) → ∏ i in s, x i ∈ ∏ i in s, I i :=
 begin
-  induction n with n ih, { simp only [pow_zero, ideal.one_eq_top], },
-  simpa only [pow_succ] using mul_mem_mul hx ih,
+  classical,
+  apply finset.induction_on s,
+  { intro _, rw [finset.prod_empty, finset.prod_empty, one_eq_top], exact submodule.mem_top },
+  { intros a s ha IH h,
+    rw [finset.prod_insert ha, finset.prod_insert ha],
+    exact mul_mem_mul (h a $ finset.mem_insert_self a s)
+      (IH $ λ i hi, h i $ finset.mem_insert_of_mem hi) }
 end
 
 theorem mul_le : I * J ≤ K ↔ ∀ (r ∈ I) (s ∈ J), r * s ∈ K :=
@@ -415,6 +458,31 @@ lemma span_singleton_mul_le_span_singleton_mul {x y : R} {I J : ideal R} :
   span {x} * I ≤ span {y} * J ↔ ∀ zI ∈ I, ∃ zJ ∈ J, x * zI = y * zJ :=
 by simp only [span_singleton_mul_le_iff, mem_span_singleton_mul, eq_comm]
 
+lemma span_singleton_mul_right_mono [is_domain R] {x : R} (hx : x ≠ 0) :
+  span {x} * I ≤ span {x} * J ↔ I ≤ J :=
+by simp_rw [span_singleton_mul_le_span_singleton_mul, mul_right_inj' hx, exists_prop,
+            exists_eq_right', set_like.le_def]
+
+lemma span_singleton_mul_left_mono [is_domain R] {x : R} (hx : x ≠ 0) :
+  I * span {x} ≤ J * span {x} ↔ I ≤ J :=
+by simpa only [mul_comm I, mul_comm J] using span_singleton_mul_right_mono hx
+
+lemma span_singleton_mul_right_inj [is_domain R] {x : R} (hx : x ≠ 0) :
+  span {x} * I = span {x} * J ↔ I = J :=
+by simp only [le_antisymm_iff, span_singleton_mul_right_mono hx]
+
+lemma span_singleton_mul_left_inj [is_domain R] {x : R} (hx : x ≠ 0) :
+  I * span {x} = J * span {x} ↔ I = J :=
+by simp only [le_antisymm_iff, span_singleton_mul_left_mono hx]
+
+lemma span_singleton_mul_right_injective [is_domain R] {x : R} (hx : x ≠ 0) :
+  function.injective ((*) (span {x} : ideal R)) :=
+λ _ _, (span_singleton_mul_right_inj hx).mp
+
+lemma span_singleton_mul_left_injective [is_domain R] {x : R} (hx : x ≠ 0) :
+  function.injective (λ I : ideal R, I * span {x}) :=
+λ _ _, (span_singleton_mul_left_inj hx).mp
+
 lemma eq_span_singleton_mul {x : R} (I J : ideal R) :
   I = span {x} * J ↔ ((∀ zI ∈ I, ∃ zJ ∈ J, x * zJ = zI) ∧ (∀ z ∈ J, x * z ∈ I)) :=
 by simp only [le_antisymm_iff, le_span_singleton_mul_iff, span_singleton_mul_le_iff]
@@ -433,6 +501,12 @@ lemma prod_span_singleton {ι : Type*} (s : finset ι) (I : ι → R) :
   (∏ i in s, ideal.span ({I i} : set R)) = ideal.span {∏ i in s, I i} :=
 submodule.prod_span_singleton s I
 
+@[simp] lemma multiset_prod_span_singleton (m : multiset R) :
+  (m.map (λ x, ideal.span {x})).prod = ideal.span ({multiset.prod m} : set R) :=
+multiset.induction_on m (by simp)
+  (λ a m ih, by simp only [multiset.map_cons, multiset.prod_cons, ih,
+                           ← ideal.span_singleton_mul_span_singleton])
+
 lemma finset_inf_span_singleton {ι : Type*} (s : finset ι) (I : ι → R)
   (hI : set.pairwise ↑s (is_coprime on I)) :
   (s.inf $ λ i, ideal.span ({I i} : set R)) = ideal.span {∏ i in s, I i} :=
@@ -451,6 +525,19 @@ begin
   rwa [finset.coe_univ, set.pairwise_univ]
 end
 
+lemma sup_eq_top_iff_is_coprime {R : Type*} [comm_semiring R] (x y : R) :
+  span ({x} : set R) ⊔ span {y} = ⊤ ↔ is_coprime x y :=
+begin
+  rw [eq_top_iff_one, submodule.mem_sup],
+  split,
+  { rintro ⟨u, hu, v, hv, h1⟩,
+    rw mem_span_singleton' at hu hv,
+    rw [← hu.some_spec, ← hv.some_spec] at h1,
+    exact ⟨_, _, h1⟩ },
+  { exact λ ⟨u, v, h1⟩,
+      ⟨_, mem_span_singleton'.mpr ⟨_, rfl⟩, _, mem_span_singleton'.mpr ⟨_, rfl⟩, h1⟩ },
+end
+
 theorem mul_le_inf : I * J ≤ I ⊓ J :=
 mul_le.2 $ λ r hri s hsj, ⟨I.mul_mem_right s hri, J.mul_mem_left r hsj⟩
 
@@ -473,6 +560,51 @@ let ⟨s, hsi, t, htj, hst⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 h) in
 mul_one r ▸ hst ▸ (mul_add r s t).symm ▸ ideal.add_mem (I * J) (mul_mem_mul_rev hsi hrj)
   (mul_mem_mul hri htj)
 
+lemma sup_mul_eq_of_coprime_left (h : I ⊔ J = ⊤) : I ⊔ (J * K) = I ⊔ K :=
+le_antisymm (sup_le_sup_left mul_le_left _) $ λ i hi,
+begin
+  rw eq_top_iff_one at h, rw submodule.mem_sup at h hi ⊢,
+  obtain ⟨i1, hi1, j, hj, h⟩ := h, obtain ⟨i', hi', k, hk, hi⟩ := hi,
+  refine ⟨_, add_mem hi' (mul_mem_right k _ hi1), _, mul_mem_mul hj hk, _⟩,
+  rw [add_assoc, ← add_mul, h, one_mul, hi]
+end
+
+lemma sup_mul_eq_of_coprime_right (h : I ⊔ K = ⊤) : I ⊔ (J * K) = I ⊔ J :=
+by { rw mul_comm, exact sup_mul_eq_of_coprime_left h }
+
+lemma mul_sup_eq_of_coprime_left (h : I ⊔ J = ⊤) : (I * K) ⊔ J = K ⊔ J :=
+by { rw sup_comm at h, rw [sup_comm, sup_mul_eq_of_coprime_left h, sup_comm] }
+
+lemma mul_sup_eq_of_coprime_right (h : K ⊔ J = ⊤) : (I * K) ⊔ J = I ⊔ J :=
+by { rw sup_comm at h, rw [sup_comm, sup_mul_eq_of_coprime_right h, sup_comm] }
+
+lemma sup_prod_eq_top {s : finset ι} {J : ι → ideal R} (h : ∀ i, i ∈ s → I ⊔ J i = ⊤) :
+  I ⊔ ∏ i in s, J i = ⊤ :=
+finset.prod_induction _ (λ J, I ⊔ J = ⊤) (λ J K hJ hK, (sup_mul_eq_of_coprime_left hJ).trans hK)
+(by rw [one_eq_top, sup_top_eq]) h
+
+lemma sup_infi_eq_top {s : finset ι} {J : ι → ideal R} (h : ∀ i, i ∈ s → I ⊔ J i = ⊤) :
+  I ⊔ (⨅ i ∈ s, J i) = ⊤ :=
+eq_top_iff.mpr $ le_of_eq_of_le (sup_prod_eq_top h).symm $ sup_le_sup_left
+  (le_of_le_of_eq prod_le_inf $ finset.inf_eq_infi _ _) _
+
+lemma prod_sup_eq_top {s : finset ι} {J : ι → ideal R} (h : ∀ i, i ∈ s → J i ⊔ I = ⊤) :
+  (∏ i in s, J i) ⊔ I = ⊤ :=
+sup_comm.trans (sup_prod_eq_top $ λ i hi, sup_comm.trans $ h i hi)
+
+lemma infi_sup_eq_top {s : finset ι} {J : ι → ideal R} (h : ∀ i, i ∈ s → J i ⊔ I = ⊤) :
+  (⨅ i ∈ s, J i) ⊔ I = ⊤ :=
+sup_comm.trans (sup_infi_eq_top $ λ i hi, sup_comm.trans $ h i hi)
+
+lemma sup_pow_eq_top {n : ℕ} (h : I ⊔ J = ⊤) : I ⊔ (J ^ n) = ⊤ :=
+by { rw [← finset.card_range n, ← finset.prod_const], exact sup_prod_eq_top (λ _ _, h) }
+
+lemma pow_sup_eq_top {n : ℕ} (h : I ⊔ J = ⊤) : (I ^ n) ⊔ J = ⊤ :=
+by { rw [← finset.card_range n, ← finset.prod_const], exact prod_sup_eq_top (λ _ _, h) }
+
+lemma pow_sup_pow_eq_top {m n : ℕ} (h : I ⊔ J = ⊤) : (I ^ m) ⊔ (J ^ n) = ⊤ :=
+sup_pow_eq_top (pow_sup_eq_top h)
+
 variables (I)
 @[simp] theorem mul_bot : I * ⊥ = ⊥ :=
 submodule.smul_bot I
@@ -516,14 +648,21 @@ lemma pow_le_self {n : ℕ} (hn : n ≠ 0) : I^n ≤ I :=
 calc I^n ≤ I ^ 1 : pow_le_pow (nat.pos_of_ne_zero hn)
      ... = I : pow_one _
 
-lemma mul_eq_bot {R : Type*} [comm_ring R] [is_domain R] {I J : ideal R} :
+lemma pow_mono {I J : ideal R} (e : I ≤ J) (n : ℕ) : I ^ n ≤ J ^ n :=
+begin
+  induction n,
+  { rw [pow_zero, pow_zero], exact rfl.le },
+  { rw [pow_succ, pow_succ], exact ideal.mul_mono e n_ih }
+end
+
+lemma mul_eq_bot {R : Type*} [comm_semiring R] [no_zero_divisors R] {I J : ideal R} :
   I * J = ⊥ ↔ I = ⊥ ∨ J = ⊥ :=
 ⟨λ hij, or_iff_not_imp_left.mpr (λ I_ne_bot, J.eq_bot_iff.mpr (λ j hj,
   let ⟨i, hi, ne0⟩ := I.ne_bot_iff.mp I_ne_bot in
     or.resolve_left (mul_eq_zero.mp ((I * J).eq_bot_iff.mp hij _ (mul_mem_mul hi hj))) ne0)),
  λ h, by cases h; rw [← ideal.mul_bot, h, ideal.mul_comm]⟩
 
-instance {R : Type*} [comm_ring R] [is_domain R] : no_zero_divisors (ideal R) :=
+instance {R : Type*} [comm_semiring R] [no_zero_divisors R] : no_zero_divisors (ideal R) :=
 { eq_zero_or_eq_zero_of_mul_eq_zero := λ I J, mul_eq_bot.1 }
 
 /-- A product of ideals in an integral domain is zero if and only if one of the terms is zero. -/
@@ -531,6 +670,10 @@ lemma prod_eq_bot {R : Type*} [comm_ring R] [is_domain R]
   {s : multiset (ideal R)} : s.prod = ⊥ ↔ ∃ I ∈ s, I = ⊥ :=
 prod_zero_iff_exists_zero
 
+lemma span_pair_mul_span_pair (w x y z : R) :
+  (span {w, x} : ideal R) * span {y, z} = span {w * y, w * z, x * y, x * z} :=
+by simp_rw [span_insert, sup_mul, mul_sup, span_singleton_mul_span_singleton, sup_assoc]
+
 /-- The radical of an ideal `I` consists of the elements `r` such that `r^n ∈ I` for some `n`. -/
 def radical (I : ideal R) : ideal R :=
 { carrier := { r | ∃ n : ℕ, r ^ n ∈ I },
@@ -547,9 +690,18 @@ def radical (I : ideal R) : ideal R :=
         (pow_add x m (c-m)).symm ▸ I.mul_mem_right _ hxmi)⟩,
   smul_mem' := λ r s ⟨n, hsni⟩, ⟨n, (mul_pow r s n).symm ▸ I.mul_mem_left (r^n) hsni⟩ }
 
+/-- An ideal is radical if it contains its radical. -/
+def is_radical (I : ideal R) : Prop := I.radical ≤ I
+
 theorem le_radical : I ≤ radical I :=
 λ r hri, ⟨1, (pow_one r).symm ▸ hri⟩
 
+/-- An ideal is radical iff it is equal to its radical. -/
+theorem radical_eq_iff : I.radical = I ↔ I.is_radical :=
+by rw [le_antisymm_iff, and_iff_left le_radical, is_radical]
+
+alias radical_eq_iff ↔ _ is_radical.radical
+
 variables (R)
 theorem radical_top : (radical ⊤ : ideal R) = ⊤ :=
 (eq_top_iff_one _).2 ⟨0, submodule.mem_top⟩
@@ -559,26 +711,34 @@ theorem radical_mono (H : I ≤ J) : radical I ≤ radical J :=
 λ r ⟨n, hrni⟩, ⟨n, H hrni⟩
 
 variables (I)
+
+theorem radical_is_radical : (radical I).is_radical :=
+λ r ⟨n, k, hrnki⟩, ⟨n * k, (pow_mul r n k).symm ▸ hrnki⟩
+
 @[simp] theorem radical_idem : radical (radical I) = radical I :=
-le_antisymm (λ r ⟨n, k, hrnki⟩, ⟨n * k, (pow_mul r n k).symm ▸ hrnki⟩) le_radical
+(radical_is_radical I).radical
+
 variables {I}
 
+theorem is_radical.radical_le_iff (hJ : J.is_radical) : radical I ≤ J ↔ I ≤ J :=
+⟨le_trans le_radical, λ h, hJ.radical ▸ radical_mono h⟩
+
 theorem radical_le_radical_iff : radical I ≤ radical J ↔ I ≤ radical J :=
-⟨λ h, le_trans le_radical h, λ h, radical_idem J ▸ radical_mono h⟩
+(radical_is_radical J).radical_le_iff
 
 theorem radical_eq_top : radical I = ⊤ ↔ I = ⊤ :=
 ⟨λ h, (eq_top_iff_one _).2 $ let ⟨n, hn⟩ := (eq_top_iff_one _).1 h in
   @one_pow R _ n ▸ hn, λ h, h.symm ▸ radical_top R⟩
 
-theorem is_prime.radical (H : is_prime I) : radical I = I :=
-le_antisymm (λ r ⟨n, hrni⟩, H.mem_of_pow_mem n hrni) le_radical
+theorem is_prime.is_radical (H : is_prime I) : I.is_radical :=
+λ r ⟨n, hrni⟩, H.mem_of_pow_mem n hrni
+
+theorem is_prime.radical (H : is_prime I) : radical I = I := H.is_radical.radical
 
 variables (I J)
 theorem radical_sup : radical (I ⊔ J) = radical (radical I ⊔ radical J) :=
 le_antisymm (radical_mono $ sup_le_sup le_radical le_radical) $
-λ r ⟨n, hrnij⟩, let ⟨s, hs, t, ht, hst⟩ := submodule.mem_sup.1 hrnij in
-@radical_idem _ _ (I ⊔ J) ▸ ⟨n, hst ▸ ideal.add_mem _
-  (radical_mono le_sup_left hs) (radical_mono le_sup_right ht)⟩
+  radical_le_radical_iff.2 $ sup_le (radical_mono le_sup_left) (radical_mono le_sup_right)
 
 theorem radical_inf : radical (I ⊓ J) = radical I ⊓ radical J :=
 le_antisymm (le_inf (radical_mono inf_le_left) (radical_mono inf_le_right))
@@ -588,11 +748,11 @@ le_antisymm (le_inf (radical_mono inf_le_left) (radical_mono inf_le_right))
 theorem radical_mul : radical (I * J) = radical I ⊓ radical J :=
 le_antisymm (radical_inf I J ▸ radical_mono $ @mul_le_inf _ _ I J)
 (λ r ⟨⟨m, hrm⟩, ⟨n, hrn⟩⟩, ⟨m + n, (pow_add r m n).symm ▸ mul_mem_mul hrm hrn⟩)
+
 variables {I J}
 
-theorem is_prime.radical_le_iff (hj : is_prime J) :
-  radical I ≤ J ↔ I ≤ J :=
-⟨le_trans le_radical, λ hij r ⟨n, hrni⟩, hj.mem_of_pow_mem n $ hij hrni⟩
+theorem is_prime.radical_le_iff (hJ : is_prime J) :
+  radical I ≤ J ↔ I ≤ J := hJ.is_radical.radical_le_iff
 
 theorem radical_eq_Inf (I : ideal R) :
   radical I = Inf { J : ideal R | I ≤ J ∧ is_prime J } :=
@@ -620,11 +780,14 @@ have is_prime m, from ⟨by rintro rfl; rw radical_top at hrm; exact hrm trivial
       (m.mul_mem_left _ hxym))⟩⟩,
 hrm $ this.radical.symm ▸ (Inf_le ⟨him, this⟩ : Inf {J : ideal R | I ≤ J ∧ is_prime J} ≤ m) hr
 
-@[simp] lemma radical_bot_of_is_domain {R : Type u} [comm_ring R] [is_domain R] :
+lemma is_radical_bot_of_no_zero_divisors {R} [comm_semiring R] [no_zero_divisors R] :
+  (⊥ : ideal R).is_radical := λ x hx, hx.rec_on (λ n hn, pow_eq_zero hn)
+
+@[simp] lemma radical_bot_of_no_zero_divisors {R : Type u} [comm_semiring R] [no_zero_divisors R] :
   radical (⊥ : ideal R) = ⊥ :=
-eq_bot_iff.2 (λ x hx, hx.rec_on (λ n hn, pow_eq_zero hn))
+eq_bot_iff.2 is_radical_bot_of_no_zero_divisors
 
-instance : comm_semiring (ideal R) := submodule.comm_semiring
+instance : idem_comm_semiring (ideal R) := submodule.idem_comm_semiring
 
 variables (R)
 theorem top_pow (n : ℕ) : (⊤ ^ n : ideal R) = ⊤ :=
@@ -665,7 +828,7 @@ begin
   obtain ⟨t, rfl⟩ : ∃ t, s = b ::ₘ t,
   from ⟨s.erase b, (multiset.cons_erase hb).symm⟩,
   refine t.induction_on _ _,
-  { simp only [exists_prop, ←multiset.singleton_eq_cons, multiset.prod_singleton,
+  { simp only [exists_prop, multiset.cons_zero, multiset.prod_singleton,
       multiset.mem_singleton, exists_eq_left, imp_self] },
   intros a s ih h,
   rw [multiset.cons_swap, multiset.prod_cons, hp.mul_le] at h,
@@ -695,7 +858,7 @@ theorem is_prime.inf_le' {s : finset ι} {f : ι → ideal R} {P : ideal R} (hp
 ⟨λ h, (hp.prod_le hsne).1 $ le_trans prod_le_inf h,
   λ ⟨i, his, hip⟩, le_trans (finset.inf_le his) hip⟩
 
-theorem subset_union {R : Type u} [comm_ring R] {I J K : ideal R} :
+theorem subset_union {R : Type u} [ring R] {I J K : ideal R} :
   (I : set R) ⊆ J ∪ K ↔ I ≤ J ∨ I ≤ K :=
 ⟨λ h, or_iff_not_imp_left.2 $ λ hij s hsi,
   let ⟨r, hri, hrj⟩ := set.not_subset.1 hij in classical.by_contradiction $ λ hsk,
@@ -873,10 +1036,12 @@ section map_and_comap
 variables {R : Type u} {S : Type v}
 
 section semiring
-variables [semiring R] [semiring S]
-variables (f : R →+* S)
+variables {F : Type*} [semiring R] [semiring S]
+variables [rc : ring_hom_class F R S]
+variables (f : F)
 variables {I J : ideal R} {K L : ideal S}
 
+include rc
 /-- `I.map f` is the span of the image of the ideal `I` under `f`, which may be bigger than
   the image itself. -/
 def map (I : ideal R) : ideal S :=
@@ -885,16 +1050,21 @@ span (f '' I)
 /-- `I.comap f` is the preimage of `I` under `f`. -/
 def comap (I : ideal S) : ideal R :=
 { carrier := f ⁻¹' I,
-  .. I.comap f.to_semilinear_map }
+  add_mem' := λ x y hx hy, by simp only [set.mem_preimage, set_like.mem_coe,
+                                         map_add, add_mem hx hy] at *,
+  zero_mem' := by simp only [set.mem_preimage, map_zero, set_like.mem_coe, submodule.zero_mem],
+  smul_mem' := λ c x hx, by { simp only [smul_eq_mul, set.mem_preimage, map_mul,
+                                         set_like.mem_coe] at *,
+                              exact mul_mem_left I _ hx } }
 
 variables {f}
 theorem map_mono (h : I ≤ J) : map f I ≤ map f J :=
 span_mono $ set.image_subset _ h
 
-theorem mem_map_of_mem (f : R →+* S) {I : ideal R} {x : R} (h : x ∈ I) : f x ∈ map f I :=
+theorem mem_map_of_mem (f : F) {I : ideal R} {x : R} (h : x ∈ I) : f x ∈ map f I :=
 subset_span ⟨x, h, rfl⟩
 
-lemma apply_coe_mem_map (f : R →+* S) (I : ideal R) (x : I) : f x ∈ I.map f :=
+lemma apply_coe_mem_map (f : F) (I : ideal R) (x : I) : f x ∈ I.map f :=
 mem_map_of_mem f x.prop
 
 theorem map_le_iff_le_comap :
@@ -908,10 +1078,13 @@ set.preimage_mono (λ x hx, h hx)
 variables (f)
 
 theorem comap_ne_top (hK : K ≠ ⊤) : comap f K ≠ ⊤ :=
-(ne_top_iff_one _).2 $ by rw [mem_comap, f.map_one];
+(ne_top_iff_one _).2 $ by rw [mem_comap, map_one];
   exact (ne_top_iff_one _).1 hK
 
-lemma map_le_comap_of_inv_on (g : S →+* R) (I : ideal R) (hf : set.left_inv_on g f I) :
+variables {G : Type*} [rcg : ring_hom_class G S R]
+
+include rcg
+lemma map_le_comap_of_inv_on (g : G) (I : ideal R) (hf : set.left_inv_on g f I) :
   I.map f ≤ I.comap g :=
 begin
   refine ideal.span_le.2 _,
@@ -920,32 +1093,34 @@ begin
   exact hx,
 end
 
-lemma comap_le_map_of_inv_on (g : S →+* R) (I : ideal S) (hf : set.left_inv_on g f (f ⁻¹' I)) :
+lemma comap_le_map_of_inv_on (g : G) (I : ideal S) (hf : set.left_inv_on g f (f ⁻¹' I)) :
   I.comap f ≤ I.map g :=
 λ x (hx : f x ∈ I), hf hx ▸ ideal.mem_map_of_mem g hx
 
 /-- The `ideal` version of `set.image_subset_preimage_of_inverse`. -/
-lemma map_le_comap_of_inverse (g : S →+* R) (I : ideal R) (h : function.left_inverse g f) :
+lemma map_le_comap_of_inverse (g : G) (I : ideal R) (h : function.left_inverse g f) :
   I.map f ≤ I.comap g :=
 map_le_comap_of_inv_on _ _ _ $ h.left_inv_on _
 
 /-- The `ideal` version of `set.preimage_subset_image_of_inverse`. -/
-lemma comap_le_map_of_inverse (g : S →+* R) (I : ideal S) (h : function.left_inverse g f) :
+lemma comap_le_map_of_inverse (g : G) (I : ideal S) (h : function.left_inverse g f) :
   I.comap f ≤ I.map g :=
 comap_le_map_of_inv_on _ _ _ $ h.left_inv_on _
+omit rcg
 
 instance is_prime.comap [hK : K.is_prime] : (comap f K).is_prime :=
 ⟨comap_ne_top _ hK.1, λ x y,
-  by simp only [mem_comap, f.map_mul]; apply hK.2⟩
+  by simp only [mem_comap, map_mul]; apply hK.2⟩
 
 variables (I J K L)
 
 theorem map_top : map f ⊤ = ⊤ :=
-(eq_top_iff_one _).2 $ subset_span ⟨1, trivial, f.map_one⟩
+(eq_top_iff_one _).2 $ subset_span ⟨1, trivial, map_one f⟩
 
 variable (f)
 lemma gc_map_comap : galois_connection (ideal.map f) (ideal.comap f) :=
 λ I J, ideal.map_le_iff_le_comap
+omit rc
 
 @[simp] lemma comap_id : I.comap (ring_hom.id R) = I :=
 ideal.ext $ λ _, iff.rfl
@@ -961,7 +1136,8 @@ lemma map_map {T : Type*} [semiring T] {I : ideal R} (f : R →+* S)
 ((gc_map_comap f).compose (gc_map_comap g)).l_unique
   (gc_map_comap (g.comp f)) (λ _, comap_comap _ _)
 
-lemma map_span (f : R →+* S) (s : set R) :
+include rc
+lemma map_span (f : F) (s : set R) :
   map f (span s) = span (f '' s) :=
 symm $ submodule.span_eq_of_le _
   (λ y ⟨x, hy, x_eq⟩, x_eq ▸ mem_map_of_mem f (subset_span hy))
@@ -985,7 +1161,7 @@ lemma map_comap_le : (K.comap f).map f ≤ K :=
 (gc_map_comap f).u_top
 
 @[simp] lemma comap_eq_top_iff {I : ideal S} : I.comap f = ⊤ ↔ I = ⊤ :=
-⟨ λ h, I.eq_top_iff_one.mpr (f.map_one ▸ mem_comap.mp ((I.comap f).eq_top_iff_one.mp h)),
+⟨ λ h, I.eq_top_iff_one.mpr (map_one f ▸ mem_comap.mp ((I.comap f).eq_top_iff_one.mp h)),
   λ h, by rw [h, comap_top] ⟩
 
 @[simp] lemma map_bot : (⊥ : ideal R).map f = ⊥ :=
@@ -1000,38 +1176,39 @@ variables (f I J K L)
 (gc_map_comap f).u_l_u_eq_u K
 
 lemma map_sup : (I ⊔ J).map f = I.map f ⊔ J.map f :=
-(gc_map_comap f).l_sup
+(gc_map_comap f : galois_connection (map f) (comap f)).l_sup
 
 theorem comap_inf : comap f (K ⊓ L) = comap f K ⊓ comap f L := rfl
 
 variables {ι : Sort*}
 
 lemma map_supr (K : ι → ideal R) : (supr K).map f = ⨆ i, (K i).map f :=
-(gc_map_comap f).l_supr
+(gc_map_comap f : galois_connection (map f) (comap f)).l_supr
 
 lemma comap_infi (K : ι → ideal S) : (infi K).comap f = ⨅ i, (K i).comap f :=
-(gc_map_comap f).u_infi
+(gc_map_comap f : galois_connection (map f) (comap f)).u_infi
 
 lemma map_Sup (s : set (ideal R)): (Sup s).map f = ⨆ I ∈ s, (I : ideal R).map f :=
-(gc_map_comap f).l_Sup
+(gc_map_comap f : galois_connection (map f) (comap f)).l_Sup
 
 lemma comap_Inf (s : set (ideal S)): (Inf s).comap f = ⨅ I ∈ s, (I : ideal S).comap f :=
-(gc_map_comap f).u_Inf
+(gc_map_comap f : galois_connection (map f) (comap f)).u_Inf
 
 lemma comap_Inf' (s : set (ideal S)) : (Inf s).comap f = ⨅ I ∈ (comap f '' s), I :=
 trans (comap_Inf f s) (by rw infi_image)
 
 theorem comap_is_prime [H : is_prime K] : is_prime (comap f K) :=
 ⟨comap_ne_top f H.ne_top,
-  λ x y h, H.mem_or_mem $ by rwa [mem_comap, ring_hom.map_mul] at h⟩
+  λ x y h, H.mem_or_mem $ by rwa [mem_comap, map_mul] at h⟩
 
 variables {I J K L}
 
 theorem map_inf_le : map f (I ⊓ J) ≤ map f I ⊓ map f J :=
-(gc_map_comap f).monotone_l.map_inf_le _ _
+(gc_map_comap f : galois_connection (map f) (comap f)).monotone_l.map_inf_le _ _
 
 theorem le_comap_sup : comap f K ⊔ comap f L ≤ comap f (K ⊔ L) :=
-(gc_map_comap f).monotone_u.le_map_sup _ _
+(gc_map_comap f : galois_connection (map f) (comap f)).monotone_u.le_map_sup _ _
+omit rc
 
 @[simp] lemma smul_top_eq_map {R S : Type*} [comm_semiring R] [comm_semiring S] [algebra R S]
   (I : ideal R) : I • (⊤ : submodule R S) = (I.map (algebra_map R S)).restrict_scalars R :=
@@ -1055,6 +1232,19 @@ begin
     rw smul_add, exact submodule.add_mem _ hx hy },
 end
 
+@[simp] lemma coe_restrict_scalars {R S : Type*} [comm_semiring R] [semiring S] [algebra R S]
+  (I : ideal S) : ((I.restrict_scalars R) : set S) = ↑I :=
+rfl
+
+/-- The smallest `S`-submodule that contains all `x ∈ I * y ∈ J`
+is also the smallest `R`-submodule that does so. -/
+@[simp] lemma restrict_scalars_mul {R S : Type*} [comm_semiring R] [comm_semiring S] [algebra R S]
+  (I J : ideal S) : (I * J).restrict_scalars R = I.restrict_scalars R * J.restrict_scalars R :=
+le_antisymm (λ x hx, submodule.mul_induction_on hx
+    (λ x hx y hy, submodule.mul_mem_mul hx hy)
+    (λ x y, submodule.add_mem _))
+  (submodule.mul_le.mpr (λ x hx y hy, ideal.mul_mem_mul hx hy))
+
 section surjective
 variables (hf : function.surjective f)
 include hf
@@ -1096,11 +1286,11 @@ lemma map_infi_comap_of_surjective (K : ι → ideal S) : (⨅i, (K i).comap f).
 
 theorem mem_image_of_mem_map_of_surjective {I : ideal R} {y}
   (H : y ∈ map f I) : y ∈ f '' I :=
-submodule.span_induction H (λ _, id) ⟨0, I.zero_mem, f.map_zero⟩
+submodule.span_induction H (λ _, id) ⟨0, I.zero_mem, map_zero f⟩
 (λ y1 y2 ⟨x1, hx1i, hxy1⟩ ⟨x2, hx2i, hxy2⟩,
-  ⟨x1 + x2, I.add_mem hx1i hx2i, hxy1 ▸ hxy2 ▸ f.map_add _ _⟩)
+  ⟨x1 + x2, I.add_mem hx1i hx2i, hxy1 ▸ hxy2 ▸ map_add f _ _⟩)
 (λ c y ⟨x, hxi, hxy⟩,
-  let ⟨d, hdc⟩ := hf c in ⟨d * x, I.mul_mem_left _ hxi, hdc ▸ hxy ▸ f.map_mul _ _⟩)
+  let ⟨d, hdc⟩ := hf c in ⟨d * x, I.mul_mem_left _ hxi, hdc ▸ hxy ▸ map_mul f _ _⟩)
 
 lemma mem_map_iff_of_surjective {I : ideal R} {y} :
   y ∈ map f I ↔ ∃ x, x ∈ I ∧ f x = y :=
@@ -1110,6 +1300,12 @@ lemma mem_map_iff_of_surjective {I : ideal R} {y} :
 lemma le_map_of_comap_le_of_surjective : comap f K ≤ I → K ≤ map f I :=
 λ h, (map_comap_of_surjective f hf K) ▸ map_mono h
 
+omit hf
+
+lemma map_eq_submodule_map (f : R →+* S) [h : ring_hom_surjective f] (I : ideal R) :
+  I.map f = submodule.map f.to_semilinear_map I :=
+submodule.ext (λ x, mem_map_iff_of_surjective f h.1)
+
 end surjective
 
 section injective
@@ -1119,16 +1315,20 @@ include hf
 lemma comap_bot_le_of_injective : comap f ⊥ ≤ I :=
 begin
   refine le_trans (λ x hx, _) bot_le,
-  rw [mem_comap, submodule.mem_bot, ← ring_hom.map_zero f] at hx,
+  rw [mem_comap, submodule.mem_bot, ← map_zero f] at hx,
   exact eq.symm (hf hx) ▸ (submodule.zero_mem ⊥)
 end
 
+lemma comap_bot_of_injective : ideal.comap f ⊥ = ⊥ :=
+le_bot_iff.mp (ideal.comap_bot_le_of_injective f hf)
+
 end injective
 
 end semiring
 
 section ring
-variables [ring R] [ring S] (f : R →+* S) {I : ideal R}
+variables {F : Type*} [ring R] [ring S]
+variables [ring_hom_class F R S] (f : F) {I : ideal R}
 
 section surjective
 
@@ -1137,7 +1337,7 @@ include hf
 
 theorem comap_map_of_surjective (I : ideal R) : comap f (map f I) = I ⊔ comap f ⊥ :=
 le_antisymm (assume r h, let ⟨s, hsi, hfsr⟩ := mem_image_of_mem_map_of_surjective f hf h in
-  submodule.mem_sup.2 ⟨s, hsi, r - s, (submodule.mem_bot S).2 $ by rw [f.map_sub, hfsr, sub_self],
+  submodule.mem_sup.2 ⟨s, hsi, r - s, (submodule.mem_bot S).2 $ by rw [map_sub, hfsr, sub_self],
   add_sub_cancel'_right s r⟩)
 (sup_le (map_le_iff_le_comap.1 le_rfl) (comap_mono bot_le))
 
@@ -1214,7 +1414,7 @@ def rel_iso_of_bijective : ideal S ≃o ideal R :=
   left_inv := (rel_iso_of_surjective f hf.right).left_inv,
   right_inv := λ J, subtype.ext_iff.1
     ((rel_iso_of_surjective f hf.right).right_inv ⟨J, comap_bot_le_of_injective f hf.left⟩),
-  map_rel_iff' := (rel_iso_of_surjective f hf.right).map_rel_iff' }
+  map_rel_iff' := λ _ _, (rel_iso_of_surjective f hf.right).map_rel_iff' }
 
 lemma comap_le_iff_le_map {I : ideal R} {K : ideal S} : comap f K ≤ I ↔ K ≤ map f I :=
 ⟨λ h, le_map_of_comap_le_of_surjective f hf.right h,
@@ -1231,28 +1431,31 @@ end bijective
 
 lemma ring_equiv.bot_maximal_iff (e : R ≃+* S) :
   (⊥ : ideal R).is_maximal ↔ (⊥ : ideal S).is_maximal :=
-⟨λ h, (@map_bot _ _ _ _ e.to_ring_hom) ▸ map.is_maximal e.to_ring_hom e.bijective h,
-  λ h, (@map_bot _ _ _ _ e.symm.to_ring_hom) ▸ map.is_maximal e.symm.to_ring_hom e.symm.bijective h⟩
+⟨λ h, (@map_bot _ _ _ _ _ _ e.to_ring_hom) ▸ map.is_maximal e.to_ring_hom e.bijective h,
+  λ h, (@map_bot _ _ _ _ _ _ e.symm.to_ring_hom) ▸ map.is_maximal e.symm.to_ring_hom
+          e.symm.bijective h⟩
 
 end ring
 
 section comm_ring
 
-variables [comm_ring R] [comm_ring S]
-variables (f : R →+* S)
+variables {F : Type*} [comm_ring R] [comm_ring S]
+variables [rc : ring_hom_class F R S]
+variables (f : F)
 variables {I J : ideal R} {K L : ideal S}
 
 variables (I J K L)
 
+include rc
 theorem map_mul : map f (I * J) = map f I * map f J :=
 le_antisymm (map_le_iff_le_comap.2 $ mul_le.2 $ λ r hri s hsj,
-  show f (r * s) ∈ _, by rw f.map_mul;
+  show f (r * s) ∈ _, by rw map_mul;
   exact mul_mem_mul (mem_map_of_mem f hri) (mem_map_of_mem f hsj))
 (trans_rel_right _ (span_mul_span _ _) $ span_le.2 $
   set.Union₂_subset $ λ i ⟨r, hri, hfri⟩,
   set.Union₂_subset $ λ j ⟨s, hsj, hfsj⟩,
   set.singleton_subset_iff.2 $ hfri ▸ hfsj ▸
-  by rw [← f.map_mul];
+  by rw [← map_mul];
   exact mem_map_of_mem f (mul_mem_mul hri hsj))
 
 /-- The pushforward `ideal.map` as a monoid-with-zero homomorphism. -/
@@ -1267,24 +1470,31 @@ protected theorem map_pow (n : ℕ) : map f (I^n) = (map f I)^n :=
 map_pow (map_hom f) I n
 
 theorem comap_radical : comap f (radical K) = radical (comap f K) :=
-le_antisymm (λ r ⟨n, hfrnk⟩, ⟨n, show f (r ^ n) ∈ K,
-  from (f.map_pow r n).symm ▸ hfrnk⟩)
-(λ r ⟨n, hfrnk⟩, ⟨n, f.map_pow r n ▸ hfrnk⟩)
+by { ext, simpa only [radical, mem_comap, map_pow] }
 
-@[simp] lemma map_quotient_self :
-  map (quotient.mk I) I = ⊥ :=
-eq_bot_iff.2 $ ideal.map_le_iff_le_comap.2 $ λ x hx,
-(submodule.mem_bot (R ⧸ I)).2 $ ideal.quotient.eq_zero_iff_mem.2 hx
+variable {K}
+theorem is_radical.comap (hK : K.is_radical) : (comap f K).is_radical :=
+by { rw [←hK.radical, comap_radical], apply radical_is_radical }
 
-variables {I J K L}
+variables {I J L}
 
 theorem map_radical_le : map f (radical I) ≤ radical (map f I) :=
-map_le_iff_le_comap.2 $ λ r ⟨n, hrni⟩, ⟨n, f.map_pow r n ▸ mem_map_of_mem f hrni⟩
+map_le_iff_le_comap.2 $ λ r ⟨n, hrni⟩, ⟨n, map_pow f r n ▸ mem_map_of_mem f hrni⟩
 
 theorem le_comap_mul : comap f K * comap f L ≤ comap f (K * L) :=
 map_le_iff_le_comap.1 $ (map_mul f (comap f K) (comap f L)).symm ▸
 mul_mono (map_le_iff_le_comap.2 $ le_rfl) (map_le_iff_le_comap.2 $ le_rfl)
 
+lemma le_comap_pow (n : ℕ) :
+  (K.comap f) ^ n ≤ (K ^ n).comap f :=
+begin
+  induction n,
+  { rw [pow_zero, pow_zero, ideal.one_eq_top, ideal.one_eq_top], exact rfl.le },
+  { rw [pow_succ, pow_succ], exact (ideal.mul_mono_right n_ih).trans (ideal.le_comap_mul f) }
+end
+
+omit rc
+
 end comm_ring
 
 end map_and_comap
@@ -1323,19 +1533,109 @@ end⟩
 
 end is_primary
 
+section total
+
+variables (ι : Type*)
+variables (M : Type*) [add_comm_group M] {R : Type*} [comm_ring R] [module R M] (I : ideal R)
+variables (v : ι → M) (hv : submodule.span R (set.range v) = ⊤)
+
+
+open_locale big_operators
+
+/-- A variant of `finsupp.total` that takes in vectors valued in `I`. -/
+noncomputable
+def finsupp_total : (ι →₀ I) →ₗ[R] M :=
+(finsupp.total ι M R v).comp (finsupp.map_range.linear_map I.subtype)
+
+variables {ι M v}
+
+lemma finsupp_total_apply (f : ι →₀ I) :
+  finsupp_total ι M I v f = f.sum (λ i x, (x : R) • v i) :=
+begin
+  dsimp [finsupp_total],
+  rw [finsupp.total_apply, finsupp.sum_map_range_index],
+  exact λ _, zero_smul _ _
+end
+
+lemma finsupp_total_apply_eq_of_fintype [fintype ι] (f : ι →₀ I) :
+  finsupp_total ι M I v f = ∑ i, (f i : R) • v i :=
+by { rw [finsupp_total_apply, finsupp.sum_fintype], exact λ _, zero_smul _ _ }
+
+lemma range_finsupp_total :
+  (finsupp_total ι M I v).range = I • (submodule.span R (set.range v)) :=
+begin
+  ext,
+  rw submodule.mem_ideal_smul_span_iff_exists_sum,
+  refine ⟨λ ⟨f, h⟩, ⟨finsupp.map_range.linear_map I.subtype f, λ i, (f i).2, h⟩, _⟩,
+  rintro ⟨a, ha, rfl⟩,
+  classical,
+  refine ⟨a.map_range (λ r, if h : r ∈ I then ⟨r, h⟩ else 0) (by split_ifs; refl), _⟩,
+  rw [finsupp_total_apply, finsupp.sum_map_range_index],
+  { apply finsupp.sum_congr, intros i _, rw dif_pos (ha i), refl },
+  { exact λ _, zero_smul _ _ },
+end
+
+end total
+
+section basis
+
+variables {ι R S : Type*} [comm_semiring R] [comm_ring S] [is_domain S] [algebra R S]
+
+/-- A basis on `S` gives a basis on `ideal.span {x}`, by multiplying everything by `x`. -/
+noncomputable def basis_span_singleton (b : basis ι R S) {x : S} (hx : x ≠ 0) :
+  basis ι R (span ({x} : set S)) :=
+b.map $ ((linear_equiv.of_injective (algebra.lmul R S x) (linear_map.mul_injective hx)) ≪≫ₗ
+  (linear_equiv.of_eq _ _ (by { ext, simp [mem_span_singleton', mul_comm] })) ≪≫ₗ
+  ((submodule.restrict_scalars_equiv R S S (ideal.span ({x} : set S))).restrict_scalars R))
+
+@[simp] lemma basis_span_singleton_apply (b : basis ι R S) {x : S} (hx : x ≠ 0) (i : ι) :
+  (basis_span_singleton b hx i : S) = x * b i :=
+begin
+  simp only [basis_span_singleton, basis.map_apply, linear_equiv.trans_apply,
+    submodule.restrict_scalars_equiv_apply, linear_equiv.of_injective_apply,
+    linear_equiv.coe_of_eq_apply, linear_equiv.restrict_scalars_apply,
+    algebra.coe_lmul_eq_mul, linear_map.mul_apply']
+end
+
+@[simp] lemma constr_basis_span_singleton
+  {N : Type*} [semiring N] [module N S] [smul_comm_class R N S]
+  (b : basis ι R S) {x : S} (hx : x ≠ 0) :
+  b.constr N (coe ∘ basis_span_singleton b hx) = algebra.lmul R S x :=
+b.ext (λ i, by erw [basis.constr_basis, function.comp_app, basis_span_singleton_apply,
+                   linear_map.mul_apply'])
+
+end basis
+
 end ideal
 
-lemma associates.mk_ne_zero' {R : Type*} [comm_ring R] {r : R} :
+lemma associates.mk_ne_zero' {R : Type*} [comm_semiring R] {r : R} :
   (associates.mk (ideal.span {r} : ideal R)) ≠ 0 ↔ (r ≠ 0):=
 by rw [associates.mk_ne_zero, ideal.zero_eq_bot, ne.def, ideal.span_singleton_eq_bot]
 
+/-- If `I : ideal S` has a basis over `R`,
+`x ∈ I` iff it is a linear combination of basis vectors. -/
+lemma basis.mem_ideal_iff {ι R S : Type*} [comm_ring R] [comm_ring S] [algebra R S]
+  {I : ideal S} (b : basis ι R I) {x : S} :
+  x ∈ I ↔ ∃ (c : ι →₀ R), x = finsupp.sum c (λ i x, x • b i) :=
+(b.map ((I.restrict_scalars_equiv R _ _).restrict_scalars R).symm).mem_submodule_iff
+
+/-- If `I : ideal S` has a finite basis over `R`,
+`x ∈ I` iff it is a linear combination of basis vectors. -/
+lemma basis.mem_ideal_iff' {ι R S : Type*} [fintype ι] [comm_ring R] [comm_ring S] [algebra R S]
+  {I : ideal S} (b : basis ι R I) {x : S} :
+  x ∈ I ↔ ∃ (c : ι → R), x = ∑ i, c i • b i :=
+(b.map ((I.restrict_scalars_equiv R _ _).restrict_scalars R).symm).mem_submodule_iff'
+
 namespace ring_hom
 
-variables {R : Type u} {S : Type v} {T : Type v}
+variables {R : Type u} {S : Type v} {T : Type w}
 
 section semiring
-variables [semiring R] [semiring S] [semiring T] (f : R →+* S) (g : T →+* S)
+variables {F : Type*} {G : Type*} [semiring R] [semiring S] [semiring T]
+variables [rcf : ring_hom_class F R S] [rcg : ring_hom_class G T S]
+(f : F) (g : G)
 
+include rcf
 /-- Kernel of a ring homomorphism as an ideal of the domain. -/
 def ker : ideal R := ideal.comap f ⊥
 
@@ -1345,130 +1645,101 @@ by rw [ker, ideal.mem_comap, submodule.mem_bot]
 
 lemma ker_eq : ((ker f) : set R) = set.preimage f {0} := rfl
 
-lemma ker_eq_comap_bot (f : R →+* S) : f.ker = ideal.comap f ⊥ := rfl
+lemma ker_eq_comap_bot (f : F) : ker f = ideal.comap f ⊥ := rfl
+omit rcf
 
-lemma comap_ker (f : S →+* R) : f.ker.comap g = (f.comp g).ker :=
+lemma comap_ker (f : S →+* R) (g : T →+* S) : f.ker.comap g = (f.comp g).ker :=
 by rw [ring_hom.ker_eq_comap_bot, ideal.comap_comap, ring_hom.ker_eq_comap_bot]
 
+include rcf
 /-- If the target is not the zero ring, then one is not in the kernel.-/
-lemma not_one_mem_ker [nontrivial S] (f : R →+* S) : (1:R) ∉ ker f :=
-by { rw [mem_ker, f.map_one], exact one_ne_zero }
+lemma not_one_mem_ker [nontrivial S] (f : F) : (1:R) ∉ ker f :=
+by { rw [mem_ker, map_one], exact one_ne_zero }
 
-lemma ker_ne_top [nontrivial S] (f : R →+* S) : f.ker ≠ ⊤ :=
+lemma ker_ne_top [nontrivial S] (f : F) : ker f ≠ ⊤ :=
 (ideal.ne_top_iff_one _).mpr $ not_one_mem_ker f
+omit rcf
 
 end semiring
 
 section ring
-variables [ring R] [semiring S] (f : R →+* S)
+variables {F : Type*} [ring R] [semiring S] [rc : ring_hom_class F R S] (f : F)
 
+include rc
 lemma injective_iff_ker_eq_bot : function.injective f ↔ ker f = ⊥ :=
 by { rw [set_like.ext'_iff, ker_eq, set.ext_iff], exact injective_iff_map_eq_zero' f }
 
 lemma ker_eq_bot_iff_eq_zero : ker f = ⊥ ↔ ∀ x, f x = 0 → x = 0 :=
 by { rw [← injective_iff_map_eq_zero f, injective_iff_ker_eq_bot] }
 
-@[simp] lemma ker_coe_equiv (f : R ≃+* S) : ker (f : R →+* S) = ⊥ :=
-by simpa only [←injective_iff_ker_eq_bot] using f.injective
+omit rc
 
-end ring
-
-section comm_ring
-variables [comm_ring R] [comm_ring S] (f : R →+* S)
+@[simp] lemma ker_coe_equiv (f : R ≃+* S) :
+  ker (f : R →+* S) = ⊥ :=
+by simpa only [←injective_iff_ker_eq_bot] using equiv_like.injective f
 
-/-- The induced map from the quotient by the kernel to the codomain.
+@[simp] lemma ker_equiv {F' : Type*} [ring_equiv_class F' R S] (f : F') :
+  ker f = ⊥ :=
+by simpa only [←injective_iff_ker_eq_bot] using equiv_like.injective f
 
-This is an isomorphism if `f` has a right inverse (`quotient_ker_equiv_of_right_inverse`) /
-is surjective (`quotient_ker_equiv_of_surjective`).
--/
-def ker_lift (f : R →+* S) : R ⧸ f.ker →+* S :=
-ideal.quotient.lift _ f $ λ r, f.mem_ker.mp
-
-@[simp]
-lemma ker_lift_mk (f : R →+* S) (r : R) : ker_lift f (ideal.quotient.mk f.ker r) = f r :=
-ideal.quotient.lift_mk _ _ _
-
-/-- The induced map from the quotient by the kernel is injective. -/
-lemma ker_lift_injective (f : R →+* S) : function.injective (ker_lift f) :=
-assume a b, quotient.induction_on₂' a b $
-  assume a b (h : f a = f b), ideal.quotient.eq.2 $
-show a - b ∈ ker f, by rw [mem_ker, map_sub, h, sub_self]
-
-variable {f}
-
-/-- The **first isomorphism theorem** for commutative rings, computable version. -/
-def quotient_ker_equiv_of_right_inverse
-  {g : S → R} (hf : function.right_inverse g f) :
-  R ⧸ f.ker ≃+* S :=
-{ to_fun := ker_lift f,
-  inv_fun := (ideal.quotient.mk f.ker) ∘ g,
-  left_inv := begin
-    rintro ⟨x⟩,
-    apply ker_lift_injective,
-    simp [hf (f x)],
-  end,
-  right_inv := hf,
-  ..ker_lift f}
+end ring
 
-@[simp]
-lemma quotient_ker_equiv_of_right_inverse.apply {g : S → R} (hf : function.right_inverse g f)
-  (x : R ⧸ f.ker) : quotient_ker_equiv_of_right_inverse hf x = ker_lift f x := rfl
+section ring_ring
 
-@[simp]
-lemma quotient_ker_equiv_of_right_inverse.symm.apply {g : S → R} (hf : function.right_inverse g f)
-  (x : S) : (quotient_ker_equiv_of_right_inverse hf).symm x = ideal.quotient.mk f.ker (g x) := rfl
+variables {F : Type*} [ring R] [ring S] [rc : ring_hom_class F R S] (f : F)
+include rc
 
-/-- The **first isomorphism theorem** for commutative rings. -/
-noncomputable def quotient_ker_equiv_of_surjective (hf : function.surjective f) :
-  R ⧸ f.ker ≃+* S :=
-quotient_ker_equiv_of_right_inverse (classical.some_spec hf.has_right_inverse)
+theorem sub_mem_ker_iff {x y} : x - y ∈ ker f ↔ f x = f y :=
+by rw [mem_ker, map_sub, sub_eq_zero]
 
-end comm_ring
+end ring_ring
 
 /-- The kernel of a homomorphism to a domain is a prime ideal. -/
-lemma ker_is_prime [ring R] [ring S] [is_domain S] (f : R →+* S) :
-  (ker f).is_prime :=
+lemma ker_is_prime {F : Type*} [ring R] [ring S] [is_domain S] [ring_hom_class F R S]
+  (f : F) : (ker f).is_prime :=
 ⟨by { rw [ne.def, ideal.eq_top_iff_one], exact not_one_mem_ker f },
-λ x y, by simpa only [mem_ker, f.map_mul] using @eq_zero_or_eq_zero_of_mul_eq_zero S _ _ _ _ _⟩
+λ x y, by simpa only [mem_ker, map_mul] using @eq_zero_or_eq_zero_of_mul_eq_zero S _ _ _ _ _⟩
 
 /-- The kernel of a homomorphism to a field is a maximal ideal. -/
-lemma ker_is_maximal_of_surjective {R K : Type*} [ring R] [field K]
-  (f : R →+* K) (hf : function.surjective f) :
-  f.ker.is_maximal :=
+lemma ker_is_maximal_of_surjective {R K F : Type*} [ring R] [field K] [ring_hom_class F R K]
+  (f : F) (hf : function.surjective f) :
+  (ker f).is_maximal :=
 begin
   refine ideal.is_maximal_iff.mpr
-    ⟨λ h1, @one_ne_zero K _ _ $ f.map_one ▸ f.mem_ker.mp h1,
+    ⟨λ h1, one_ne_zero' K $ map_one f ▸ (mem_ker f).mp h1,
     λ J x hJ hxf hxJ, _⟩,
   obtain ⟨y, hy⟩ := hf (f x)⁻¹,
   have H : 1 = y * x - (y * x - 1) := (sub_sub_cancel _ _).symm,
   rw H,
   refine J.sub_mem (J.mul_mem_left _ hxJ) (hJ _),
-  rw f.mem_ker,
-  simp only [hy, ring_hom.map_sub, ring_hom.map_one, ring_hom.map_mul,
-    inv_mul_cancel (mt f.mem_ker.mpr hxf), sub_self],
+  rw mem_ker,
+  simp only [hy, map_sub, map_one, map_mul,
+    inv_mul_cancel (mt (mem_ker f).mpr hxf), sub_self],
 end
 
 end ring_hom
 
 namespace ideal
 
-variables {R : Type*} {S : Type*}
+variables {R : Type*} {S : Type*} {F : Type*}
 
 section semiring
-variables [semiring R] [semiring S]
+variables [semiring R] [semiring S] [rc : ring_hom_class F R S]
 
-lemma map_eq_bot_iff_le_ker {I : ideal R} (f : R →+* S) : I.map f = ⊥ ↔ I ≤ f.ker :=
+include rc
+lemma map_eq_bot_iff_le_ker {I : ideal R} (f : F) : I.map f = ⊥ ↔ I ≤ (ring_hom.ker f) :=
 by rw [ring_hom.ker, eq_bot_iff, map_le_iff_le_comap]
 
-lemma ker_le_comap {K : ideal S} (f : R →+* S) : f.ker ≤ comap f K :=
+lemma ker_le_comap {K : ideal S} (f : F) : ring_hom.ker f ≤ comap f K :=
 λ x hx, mem_comap.2 (((ring_hom.mem_ker f).1 hx).symm ▸ K.zero_mem)
 
 end semiring
 
 section ring
-variables [ring R] [ring S]
+variables [ring R] [ring S] [rc : ring_hom_class F R S]
 
-lemma map_Inf {A : set (ideal R)} {f : R →+* S} (hf : function.surjective f) :
+include rc
+lemma map_Inf {A : set (ideal R)} {f : F} (hf : function.surjective f) :
   (∀ J ∈ A, ring_hom.ker f ≤ J) → map f (Inf A) = Inf (map f '' A) :=
 begin
   refine λ h, le_antisymm (le_Inf _) _,
@@ -1486,11 +1757,11 @@ begin
     rcases (mem_map_iff_of_surjective f hf).1 (this J hJ) with ⟨x', hx', rfl⟩,
     have : x - x' ∈ J,
     { apply h J hJ,
-      rw [ring_hom.mem_ker, ring_hom.map_sub, hx, sub_self] },
+      rw [ring_hom.mem_ker, map_sub, hx, sub_self] },
     simpa only [sub_add_cancel] using J.add_mem this hx' }
 end
 
-theorem map_is_prime_of_surjective {f : R →+* S} (hf : function.surjective f) {I : ideal R}
+theorem map_is_prime_of_surjective {f : F} (hf : function.surjective f) {I : ideal R}
   [H : is_prime I] (hk : ring_hom.ker f ≤ I) : is_prime (map f I) :=
 begin
   refine ⟨λ h, H.ne_top (eq_top_iff.2 _), λ x y, _⟩,
@@ -1498,47 +1769,31 @@ begin
     rw [comap_map_of_surjective _ hf, comap_top] at h,
     exact h ▸ sup_le (le_of_eq rfl) hk },
   { refine λ hxy, (hf x).rec_on (λ a ha, (hf y).rec_on (λ b hb, _)),
-    rw [← ha, ← hb, ← ring_hom.map_mul, mem_map_iff_of_surjective _ hf] at hxy,
+    rw [← ha, ← hb, ← _root_.map_mul f, mem_map_iff_of_surjective _ hf] at hxy,
     rcases hxy with ⟨c, hc, hc'⟩,
-    rw [← sub_eq_zero, ← ring_hom.map_sub] at hc',
+    rw [← sub_eq_zero, ← map_sub] at hc',
     have : a * b ∈ I,
-    { convert I.sub_mem hc (hk (hc' : c - a * b ∈ f.ker)),
+    { convert I.sub_mem hc (hk (hc' : c - a * b ∈ ring_hom.ker f)),
       abel },
     exact (H.mem_or_mem this).imp (λ h, ha ▸ mem_map_of_mem f h) (λ h, hb ▸ mem_map_of_mem f h) }
 end
 
-theorem map_is_prime_of_equiv (f : R ≃+* S) {I : ideal R} [is_prime I] :
-  is_prime (map (f : R →+* S) I) :=
-map_is_prime_of_surjective f.surjective $ by simp
+lemma map_eq_bot_iff_of_injective {I : ideal R} {f : F} (hf : function.injective f) :
+  I.map f = ⊥ ↔ I = ⊥ :=
+by rw [map_eq_bot_iff_le_ker, (ring_hom.injective_iff_ker_eq_bot f).mp hf, le_bot_iff]
+
+omit rc
+
+theorem map_is_prime_of_equiv {F' : Type*} [ring_equiv_class F' R S]
+  (f : F') {I : ideal R} [is_prime I] :
+  is_prime (map f I) :=
+map_is_prime_of_surjective (equiv_like.surjective f) $ by simp only [ring_hom.ker_equiv, bot_le]
 
 end ring
 
 section comm_ring
 variables [comm_ring R] [comm_ring S]
 
-@[simp] lemma mk_ker {I : ideal R} : (quotient.mk I).ker = I :=
-by ext; rw [ring_hom.ker, mem_comap, submodule.mem_bot, quotient.eq_zero_iff_mem]
-
-lemma map_mk_eq_bot_of_le {I J : ideal R} (h : I ≤ J) : I.map (J^.quotient.mk) = ⊥ :=
-by { rw [map_eq_bot_iff_le_ker, mk_ker], exact h }
-
-lemma ker_quotient_lift {S : Type v} [comm_ring S] {I : ideal R} (f : R →+* S) (H : I ≤ f.ker) :
-  (ideal.quotient.lift I f H).ker = (f.ker).map I^.quotient.mk :=
-begin
-  ext x,
-  split,
-  { intro hx,
-    obtain ⟨y, hy⟩ := quotient.mk_surjective x,
-    rw [ring_hom.mem_ker, ← hy, ideal.quotient.lift_mk, ← ring_hom.mem_ker] at hx,
-    rw [← hy, mem_map_iff_of_surjective I^.quotient.mk quotient.mk_surjective],
-    exact ⟨y, hx, rfl⟩ },
-  { intro hx,
-    rw mem_map_iff_of_surjective I^.quotient.mk quotient.mk_surjective at hx,
-    obtain ⟨y, hy⟩ := hx,
-    rw [ring_hom.mem_ker, ← hy.right, ideal.quotient.lift_mk, ← (ring_hom.mem_ker f)],
-    exact hy.left },
-end
-
 theorem map_eq_iff_sup_ker_eq_of_surjective {I J : ideal R} (f : R →+* S)
   (hf : function.surjective f) : map f I = map f J ↔ I ⊔ f.ker = J ⊔ f.ker :=
 by rw [← (comap_injective_of_surjective f hf).eq_iff, comap_map_of_surjective f hf,
@@ -1560,243 +1815,6 @@ begin
     refine ⟨hJ' ▸ map_mono hJ.left, hJ' ▸ map_is_prime_of_surjective hf (le_trans h hJ.left)⟩ },
 end
 
-@[simp] lemma bot_quotient_is_maximal_iff (I : ideal R) :
-  (⊥ : ideal (R ⧸ I)).is_maximal ↔ I.is_maximal :=
-⟨λ hI, (@mk_ker _ _ I) ▸
-  @comap_is_maximal_of_surjective _ _ _ _ (quotient.mk I) quotient.mk_surjective ⊥ hI,
- λ hI, @bot_is_maximal _ (@field.to_division_ring _ (@quotient.field _ _ I hI)) ⟩
-
-/-- See also `ideal.mem_quotient_iff_mem` in case `I ≤ J`. -/
-@[simp]
-lemma mem_quotient_iff_mem_sup {I J : ideal R} {x : R} :
-  quotient.mk I x ∈ J.map (quotient.mk I) ↔ x ∈ J ⊔ I :=
-by rw [← mem_comap, comap_map_of_surjective _ quotient.mk_surjective, ← ring_hom.ker_eq_comap_bot,
-  mk_ker]
-
-/-- See also `ideal.mem_quotient_iff_mem_sup` if the assumption `I ≤ J` is not available. -/
-lemma mem_quotient_iff_mem {I J : ideal R} (hIJ : I ≤ J) {x : R} :
-  quotient.mk I x ∈ J.map (quotient.mk I) ↔ x ∈ J :=
-by rw [mem_quotient_iff_mem_sup, sup_eq_left.mpr hIJ]
-
-section quotient_algebra
-
-variables (R₁ R₂ : Type*) {A B : Type*}
-variables [comm_semiring R₁] [comm_semiring R₂] [comm_ring A] [comm_ring B]
-variables [algebra R₁ A] [algebra R₂ A] [algebra R₁ B]
-
-/-- The `R₁`-algebra structure on `A/I` for an `R₁`-algebra `A` -/
-instance quotient.algebra {I : ideal A} : algebra R₁ (A ⧸ I) :=
-{ to_fun := λ x, ideal.quotient.mk I (algebra_map R₁ A x),
-  smul := (•),
-  smul_def' := λ r x, quotient.induction_on' x $ λ x,
-      ((quotient.mk I).congr_arg $ algebra.smul_def _ _).trans (ring_hom.map_mul _ _ _),
-  commutes' := λ _ _, mul_comm _ _,
-  .. ring_hom.comp (ideal.quotient.mk I) (algebra_map R₁ A) }
-
--- Lean can struggle to find this instance later if we don't provide this shortcut
-instance quotient.is_scalar_tower [has_scalar R₁ R₂] [is_scalar_tower R₁ R₂ A] (I : ideal A) :
-  is_scalar_tower R₁ R₂ (A ⧸ I) :=
-by apply_instance
-
-/-- The canonical morphism `A →ₐ[R₁] A ⧸ I` as morphism of `R₁`-algebras, for `I` an ideal of
-`A`, where `A` is an `R₁`-algebra. -/
-def quotient.mkₐ (I : ideal A) : A →ₐ[R₁] A ⧸ I :=
-⟨λ a, submodule.quotient.mk a, rfl, λ _ _, rfl, rfl, λ _ _, rfl, λ _, rfl⟩
-
-lemma quotient.alg_map_eq (I : ideal A) :
-  algebra_map R₁ (A ⧸ I) = (algebra_map A (A ⧸ I)).comp (algebra_map R₁ A) :=
-rfl
-
-lemma quotient.mkₐ_to_ring_hom (I : ideal A) :
-  (quotient.mkₐ R₁ I).to_ring_hom = ideal.quotient.mk I := rfl
-
-@[simp] lemma quotient.mkₐ_eq_mk (I : ideal A) :
-  ⇑(quotient.mkₐ R₁ I) = ideal.quotient.mk I := rfl
-
-@[simp] lemma quotient.algebra_map_eq (I : ideal R) :
-  algebra_map R (R ⧸ I) = I^.quotient.mk :=
-rfl
-
-@[simp] lemma quotient.mk_comp_algebra_map (I : ideal A) :
-  (quotient.mk I).comp (algebra_map R₁ A) = algebra_map R₁ (A ⧸ I) :=
-rfl
-
-@[simp] lemma quotient.mk_algebra_map (I : ideal A) (x : R₁) :
-  quotient.mk I (algebra_map R₁ A x) = algebra_map R₁ (A ⧸ I) x :=
-rfl
-
-/-- The canonical morphism `A →ₐ[R₁] I.quotient` is surjective. -/
-lemma quotient.mkₐ_surjective (I : ideal A) : function.surjective (quotient.mkₐ R₁ I) :=
-surjective_quot_mk _
-
-/-- The kernel of `A →ₐ[R₁] I.quotient` is `I`. -/
-@[simp]
-lemma quotient.mkₐ_ker (I : ideal A) : (quotient.mkₐ R₁ I : A →+* A ⧸ I).ker = I :=
-ideal.mk_ker
-
-variables {R₁}
-
-lemma ker_lift.map_smul (f : A →ₐ[R₁] B) (r : R₁) (x : A ⧸ f.to_ring_hom.ker) :
-  f.to_ring_hom.ker_lift (r • x) = r • f.to_ring_hom.ker_lift x :=
-begin
-  obtain ⟨a, rfl⟩ := quotient.mkₐ_surjective R₁ _ x,
-  rw [← alg_hom.map_smul, quotient.mkₐ_eq_mk, ring_hom.ker_lift_mk],
-  exact f.map_smul _ _
-end
-
-/-- The induced algebras morphism from the quotient by the kernel to the codomain.
-
-This is an isomorphism if `f` has a right inverse (`quotient_ker_alg_equiv_of_right_inverse`) /
-is surjective (`quotient_ker_alg_equiv_of_surjective`).
--/
-def ker_lift_alg (f : A →ₐ[R₁] B) : (A ⧸ f.to_ring_hom.ker) →ₐ[R₁] B :=
-alg_hom.mk' f.to_ring_hom.ker_lift (λ _ _, ker_lift.map_smul f _ _)
-
-@[simp]
-lemma ker_lift_alg_mk (f : A →ₐ[R₁] B) (a : A) :
-  ker_lift_alg f (quotient.mk f.to_ring_hom.ker a) = f a := rfl
-
-@[simp]
-lemma ker_lift_alg_to_ring_hom (f : A →ₐ[R₁] B) :
-  (ker_lift_alg f).to_ring_hom = ring_hom.ker_lift f := rfl
-
-/-- The induced algebra morphism from the quotient by the kernel is injective. -/
-lemma ker_lift_alg_injective (f : A →ₐ[R₁] B) : function.injective (ker_lift_alg f) :=
-ring_hom.ker_lift_injective f
-
-/-- The **first isomorphism** theorem for algebras, computable version. -/
-def quotient_ker_alg_equiv_of_right_inverse
-  {f : A →ₐ[R₁] B} {g : B → A} (hf : function.right_inverse g f) :
-  (A ⧸ f.to_ring_hom.ker) ≃ₐ[R₁] B :=
-{ ..ring_hom.quotient_ker_equiv_of_right_inverse (λ x, show f.to_ring_hom (g x) = x, from hf x),
-  ..ker_lift_alg f}
-
-@[simp]
-lemma quotient_ker_alg_equiv_of_right_inverse.apply {f : A →ₐ[R₁] B} {g : B → A}
-  (hf : function.right_inverse g f) (x : A ⧸ f.to_ring_hom.ker) :
-  quotient_ker_alg_equiv_of_right_inverse hf x = ker_lift_alg f x := rfl
-
-@[simp]
-lemma quotient_ker_alg_equiv_of_right_inverse_symm.apply {f : A →ₐ[R₁] B} {g : B → A}
-  (hf : function.right_inverse g f) (x : B) :
-  (quotient_ker_alg_equiv_of_right_inverse hf).symm x = quotient.mkₐ R₁ f.to_ring_hom.ker (g x) :=
-  rfl
-
-/-- The **first isomorphism theorem** for algebras. -/
-noncomputable def quotient_ker_alg_equiv_of_surjective
-  {f : A →ₐ[R₁] B} (hf : function.surjective f) : (A ⧸ f.to_ring_hom.ker) ≃ₐ[R₁] B :=
-quotient_ker_alg_equiv_of_right_inverse (classical.some_spec hf.has_right_inverse)
-
-/-- The ring hom `R/I →+* S/J` induced by a ring hom `f : R →+* S` with `I ≤ f⁻¹(J)` -/
-def quotient_map {I : ideal R} (J : ideal S) (f : R →+* S) (hIJ : I ≤ J.comap f) :
-  R ⧸ I →+* S ⧸ J :=
-(quotient.lift I ((quotient.mk J).comp f) (λ _ ha,
-  by simpa [function.comp_app, ring_hom.coe_comp, quotient.eq_zero_iff_mem] using hIJ ha))
-
-@[simp]
-lemma quotient_map_mk {J : ideal R} {I : ideal S} {f : R →+* S} {H : J ≤ I.comap f}
-  {x : R} : quotient_map I f H (quotient.mk J x) = quotient.mk I (f x) :=
-quotient.lift_mk J _ _
-
-@[simp]
-lemma quotient_map_algebra_map {J : ideal A} {I : ideal S} {f : A →+* S} {H : J ≤ I.comap f}
-  {x : R₁} :
-  quotient_map I f H (algebra_map R₁ (A ⧸ J) x) = quotient.mk I (f (algebra_map _ _ x)) :=
-quotient.lift_mk J _ _
-
-lemma quotient_map_comp_mk {J : ideal R} {I : ideal S} {f : R →+* S} (H : J ≤ I.comap f) :
-  (quotient_map I f H).comp (quotient.mk J) = (quotient.mk I).comp f :=
-ring_hom.ext (λ x, by simp only [function.comp_app, ring_hom.coe_comp, ideal.quotient_map_mk])
-
-/-- The ring equiv `R/I ≃+* S/J` induced by a ring equiv `f : R ≃+** S`,  where `J = f(I)`. -/
-@[simps]
-def quotient_equiv (I : ideal R) (J : ideal S) (f : R ≃+* S) (hIJ : J = I.map (f : R →+* S)) :
-  R ⧸ I ≃+* S ⧸ J :=
-{ inv_fun := quotient_map I ↑f.symm (by {rw hIJ, exact le_of_eq (map_comap_of_equiv I f)}),
-  left_inv := by {rintro ⟨r⟩, simp },
-  right_inv := by {rintro ⟨s⟩, simp },
-  ..quotient_map J ↑f (by {rw hIJ, exact @le_comap_map _ S _ _ _ _}) }
-
-@[simp]
-lemma quotient_equiv_mk (I : ideal R) (J : ideal S) (f : R ≃+* S) (hIJ : J = I.map (f : R →+* S))
-  (x : R) : quotient_equiv I J f hIJ (ideal.quotient.mk I x) = ideal.quotient.mk J (f x) := rfl
-
-@[simp]
-lemma quotient_equiv_symm_mk (I : ideal R) (J : ideal S) (f : R ≃+* S)
-  (hIJ : J = I.map (f : R →+* S)) (x : S) :
-  (quotient_equiv I J f hIJ).symm (ideal.quotient.mk J x) = ideal.quotient.mk I (f.symm x) := rfl
-
-/-- `H` and `h` are kept as separate hypothesis since H is used in constructing the quotient map. -/
-lemma quotient_map_injective' {J : ideal R} {I : ideal S} {f : R →+* S} {H : J ≤ I.comap f}
-  (h : I.comap f ≤ J) : function.injective (quotient_map I f H) :=
-begin
-  refine (injective_iff_map_eq_zero (quotient_map I f H)).2 (λ a ha, _),
-  obtain ⟨r, rfl⟩ := quotient.mk_surjective a,
-  rw [quotient_map_mk, quotient.eq_zero_iff_mem] at ha,
-  exact (quotient.eq_zero_iff_mem).mpr (h ha),
-end
-
-/-- If we take `J = I.comap f` then `quotient_map` is injective automatically. -/
-lemma quotient_map_injective {I : ideal S} {f : R →+* S} :
-  function.injective (quotient_map I f le_rfl) :=
-quotient_map_injective' le_rfl
-
-lemma quotient_map_surjective {J : ideal R} {I : ideal S} {f : R →+* S} {H : J ≤ I.comap f}
-  (hf : function.surjective f) : function.surjective (quotient_map I f H) :=
-λ x, let ⟨x, hx⟩ := quotient.mk_surjective x in
-  let ⟨y, hy⟩ := hf x in ⟨(quotient.mk J) y, by simp [hx, hy]⟩
-
-/-- Commutativity of a square is preserved when taking quotients by an ideal. -/
-lemma comp_quotient_map_eq_of_comp_eq {R' S' : Type*} [comm_ring R'] [comm_ring S']
-  {f : R →+* S} {f' : R' →+* S'} {g : R →+* R'} {g' : S →+* S'} (hfg : f'.comp g = g'.comp f)
-  (I : ideal S') : (quotient_map I g' le_rfl).comp (quotient_map (I.comap g') f le_rfl) =
-    (quotient_map I f' le_rfl).comp (quotient_map (I.comap f') g
-      (le_of_eq (trans (comap_comap f g') (hfg ▸ (comap_comap g f'))))) :=
-begin
-  refine ring_hom.ext (λ a, _),
-  obtain ⟨r, rfl⟩ := quotient.mk_surjective a,
-  simp only [ring_hom.comp_apply, quotient_map_mk],
-  exact congr_arg (quotient.mk I) (trans (g'.comp_apply f r).symm (hfg ▸ (f'.comp_apply g r))),
-end
-
-/-- The algebra hom `A/I →+* B/J` induced by an algebra hom `f : A →ₐ[R₁] B` with `I ≤ f⁻¹(J)`. -/
-def quotient_mapₐ {I : ideal A} (J : ideal B) (f : A →ₐ[R₁] B) (hIJ : I ≤ J.comap f) :
-  A ⧸ I →ₐ[R₁] B ⧸ J :=
-{ commutes' := λ r, by simp,
-  ..quotient_map J ↑f hIJ }
-
-@[simp]
-lemma quotient_map_mkₐ {I : ideal A} (J : ideal B) (f : A →ₐ[R₁] B) (H : I ≤ J.comap f)
-  {x : A} : quotient_mapₐ J f H (quotient.mk I x) = quotient.mkₐ R₁ J (f x) := rfl
-
-lemma quotient_map_comp_mkₐ {I : ideal A} (J : ideal B) (f : A →ₐ[R₁] B) (H : I ≤ J.comap f) :
-  (quotient_mapₐ J f H).comp (quotient.mkₐ R₁ I) = (quotient.mkₐ R₁ J).comp f :=
-alg_hom.ext (λ x, by simp only [quotient_map_mkₐ, quotient.mkₐ_eq_mk, alg_hom.comp_apply])
-
-/-- The algebra equiv `A/I ≃ₐ[R] B/J` induced by an algebra equiv `f : A ≃ₐ[R] B`,
-where`J = f(I)`. -/
-def quotient_equiv_alg (I : ideal A) (J : ideal B) (f : A ≃ₐ[R₁] B)
-  (hIJ : J = I.map (f : A →+* B)) :
-  (A ⧸ I) ≃ₐ[R₁] B ⧸ J :=
-{ commutes' := λ r, by simp,
-  ..quotient_equiv I J (f : A ≃+* B) hIJ }
-
-@[priority 100]
-instance quotient_algebra {I : ideal A} [algebra R A] :
-  algebra (R ⧸ I.comap (algebra_map R A)) (A ⧸ I) :=
-(quotient_map I (algebra_map R A) (le_of_eq rfl)).to_algebra
-
-lemma algebra_map_quotient_injective {I : ideal A} [algebra R A]:
-  function.injective (algebra_map (R ⧸ I.comap (algebra_map R A)) (A ⧸ I)) :=
-begin
-  rintros ⟨a⟩ ⟨b⟩ hab,
-  replace hab := quotient.eq.mp hab,
-  rw ← ring_hom.map_sub at hab,
-  exact quotient.eq.mpr hab
-end
-
-end quotient_algebra
-
 end comm_ring
 
 end ideal
@@ -1905,76 +1923,3 @@ begin
 end
 
 end ring_hom
-
-namespace double_quot
-open ideal
-variables {R : Type u} [comm_ring R] (I J : ideal R)
-
-/-- The obvious ring hom `R/I → R/(I ⊔ J)` -/
-def quot_left_to_quot_sup : R ⧸ I →+* R ⧸ (I ⊔ J) :=
-ideal.quotient.factor I (I ⊔ J) le_sup_left
-
-/-- The kernel of `quot_left_to_quot_sup` -/
-lemma ker_quot_left_to_quot_sup :
-  (quot_left_to_quot_sup I J).ker = J.map (ideal.quotient.mk I) :=
-by simp only [mk_ker, sup_idem, sup_comm, quot_left_to_quot_sup, quotient.factor, ker_quotient_lift,
-    map_eq_iff_sup_ker_eq_of_surjective I^.quotient.mk quotient.mk_surjective, ← sup_assoc]
-
-/-- The ring homomorphism `(R/I)/J' -> R/(I ⊔ J)` induced by `quot_left_to_quot_sup` where `J'`
-  is the image of `J` in `R/I`-/
-def quot_quot_to_quot_sup : (R ⧸ I) ⧸ J.map (ideal.quotient.mk I) →+* R ⧸ I ⊔ J :=
-ideal.quotient.lift (ideal.map (ideal.quotient.mk I) J) (quot_left_to_quot_sup I J)
-  (ker_quot_left_to_quot_sup I J).symm.le
-
-/-- The composite of the maps `R → (R/I)` and `(R/I) → (R/I)/J'` -/
-def quot_quot_mk : R →+* ((R ⧸ I) ⧸ J.map I^.quotient.mk) :=
-((J.map I^.quotient.mk)^.quotient.mk).comp I^.quotient.mk
-
-/-- The kernel of `quot_quot_mk` -/
-lemma ker_quot_quot_mk : (quot_quot_mk I J).ker = I ⊔ J :=
-by rw [ring_hom.ker_eq_comap_bot, quot_quot_mk, ← comap_comap, ← ring_hom.ker, mk_ker,
-  comap_map_of_surjective (ideal.quotient.mk I) (quotient.mk_surjective), ← ring_hom.ker, mk_ker,
-  sup_comm]
-
-/-- The ring homomorphism `R/(I ⊔ J) → (R/I)/J' `induced by `quot_quot_mk` -/
-def lift_sup_quot_quot_mk (I J : ideal R) :
-  R ⧸ (I ⊔ J) →+* (R ⧸ I) ⧸ J.map (ideal.quotient.mk I) :=
-ideal.quotient.lift (I ⊔ J) (quot_quot_mk I J) (ker_quot_quot_mk I J).symm.le
-
-/-- `quot_quot_to_quot_add` and `lift_sup_double_qot_mk` are inverse isomorphisms -/
-def quot_quot_equiv_quot_sup : (R ⧸ I) ⧸ J.map (ideal.quotient.mk I) ≃+* R ⧸ I ⊔ J :=
-ring_equiv.of_hom_inv (quot_quot_to_quot_sup I J) (lift_sup_quot_quot_mk I J)
-  (by { ext z, refl }) (by { ext z, refl })
-
-@[simp]
-lemma quot_quot_equiv_quot_sup_quot_quot_mk (x : R) :
-  quot_quot_equiv_quot_sup I J (quot_quot_mk I J x) = ideal.quotient.mk (I ⊔ J) x :=
-rfl
-
-@[simp]
-lemma quot_quot_equiv_quot_sup_symm_quot_quot_mk (x : R) :
-  (quot_quot_equiv_quot_sup I J).symm (ideal.quotient.mk (I ⊔ J) x) = quot_quot_mk I J x :=
-rfl
-
-/-- The obvious isomorphism `(R/I)/J' → (R/J)/I' `   -/
-def quot_quot_equiv_comm :
-  (R ⧸ I) ⧸ J.map I^.quotient.mk ≃+* (R ⧸ J) ⧸ I.map J^.quotient.mk :=
-((quot_quot_equiv_quot_sup I J).trans (quot_equiv_of_eq sup_comm)).trans
-  (quot_quot_equiv_quot_sup J I).symm
-
-@[simp]
-lemma quot_quot_equiv_comm_quot_quot_mk (x : R) :
-  quot_quot_equiv_comm I J (quot_quot_mk I J x) = quot_quot_mk J I x :=
-rfl
-
-@[simp]
-lemma quot_quot_equiv_comm_comp_quot_quot_mk :
-  ring_hom.comp ↑(quot_quot_equiv_comm I J) (quot_quot_mk I J) = quot_quot_mk J I :=
-ring_hom.ext $ quot_quot_equiv_comm_quot_quot_mk I J
-
-@[simp]
-lemma quot_quot_equiv_comm_symm :
-  (quot_quot_equiv_comm I J).symm = quot_quot_equiv_comm J I :=
-rfl
-
-end double_quot
diff --git a/src/ring_theory/ideal/over.lean b/src/ring_theory/ideal/over.lean
index ab89c1bb2d87b..e9a5a86776ecf 100644
--- a/src/ring_theory/ideal/over.lean
+++ b/src/ring_theory/ideal/over.lean
@@ -11,6 +11,9 @@ import ring_theory.localization.integral
 /-!
 # Ideals over/under ideals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file concerns ideals lying over other ideals.
 Let `f : R →+* S` be a ring homomorphism (typically a ring extension), `I` an ideal of `R` and
 `J` an ideal of `S`. We say `J` lies over `I` (and `I` under `J`) if `I` is the `f`-preimage of `J`.
@@ -69,12 +72,13 @@ end
 is injective.
 -/
 lemma injective_quotient_le_comap_map (P : ideal R[X]) :
-  function.injective ((map (map_ring_hom (quotient.mk (P.comap C))) P).quotient_map
-    (map_ring_hom (quotient.mk (P.comap C))) le_comap_map) :=
+  function.injective ((map (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) P).quotient_map
+    (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) le_comap_map) :=
 begin
   refine quotient_map_injective' (le_of_eq _),
   rw comap_map_of_surjective
-    (map_ring_hom (quotient.mk (P.comap C))) (map_surjective _ quotient.mk_surjective),
+    (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X]))))
+      (map_surjective (quotient.mk (P.comap (C : R →+* R[X]))) quotient.mk_surjective),
   refine le_antisymm (sup_le le_rfl _) (le_sup_of_le_left le_rfl),
   refine λ p hp, polynomial_mem_ideal_of_coeff_mem_ideal P p (λ n, quotient.eq_zero_iff_mem.mp _),
   simpa only [coeff_map, coe_map_ring_hom] using ext_iff.mp (ideal.mem_bot.mp (mem_comap.mp hp)) n,
@@ -91,10 +95,11 @@ commutes.  It is used, for instance, in the proof of `quotient_mk_comp_C_is_inte
 in the file `ring_theory/jacobson`.
 -/
 lemma quotient_mk_maps_eq (P : ideal R[X]) :
-  ((quotient.mk (map (map_ring_hom (quotient.mk (P.comap C))) P)).comp C).comp
-    (quotient.mk (P.comap C)) =
-  ((map (map_ring_hom (quotient.mk (P.comap C))) P).quotient_map
-    (map_ring_hom (quotient.mk (P.comap C))) le_comap_map).comp ((quotient.mk P).comp C) :=
+  ((quotient.mk (map (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) P)).comp C).comp
+    (quotient.mk (P.comap (C : R →+* R[X]))) =
+  ((map (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) P).quotient_map
+    (map_ring_hom (quotient.mk (P.comap (C : R →+* R[X])))) le_comap_map).comp
+      ((quotient.mk P).comp C) :=
 begin
   refine ring_hom.ext (λ x, _),
   repeat { rw [ring_hom.coe_comp, function.comp_app] },
@@ -108,11 +113,12 @@ that is non-zero in the quotient `R / (P ∩ R) [x]`.  The assumptions are equiv
 -/
 lemma exists_nonzero_mem_of_ne_bot {P : ideal R[X]}
   (Pb : P ≠ ⊥) (hP : ∀ (x : R), C x ∈ P → x = 0) :
-  ∃ p : R[X], p ∈ P ∧ (polynomial.map (quotient.mk (P.comap C)) p) ≠ 0 :=
+  ∃ p : R[X], p ∈ P ∧ (polynomial.map (quotient.mk (P.comap (C : R →+* R[X]))) p) ≠ 0 :=
 begin
   obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr Pb),
   refine ⟨m, submodule.coe_mem m, λ pp0, hm (submodule.coe_eq_zero.mp _)⟩,
-  refine (injective_iff_map_eq_zero (polynomial.map_ring_hom (quotient.mk (P.comap C)))).mp _ _ pp0,
+  refine (injective_iff_map_eq_zero
+    (polynomial.map_ring_hom (quotient.mk (P.comap (C : R →+* R[X]))))).mp _ _ pp0,
   refine map_injective _ ((quotient.mk (P.comap C)).injective_iff_ker_eq_bot.mpr _),
   rw [mk_ker],
   exact (submodule.eq_bot_iff _).mpr (λ x hx, hP x (mem_comap.mp hx)),
@@ -150,7 +156,7 @@ ring_hom.to_algebra $ quotient_map _ f h
 /-- `R / p` has a canonical map to `S / pS`. -/
 instance quotient.algebra_quotient_map_quotient :
   algebra (R ⧸ p) (S ⧸ map f p) :=
-quotient.algebra_quotient_of_le_comap le_comap_map
+by exact quotient.algebra_quotient_of_le_comap le_comap_map
 
 @[simp] lemma quotient.algebra_map_quotient_map_quotient (x : R) :
   algebra_map (R ⧸ p) (S ⧸ map f p) (quotient.mk p x) = quotient.mk _ (f x) :=
@@ -219,7 +225,7 @@ lemma mem_of_one_mem (h : (1 : S) ∈ I) (x) : x ∈ I :=
 
 lemma comap_lt_comap_of_integral_mem_sdiff [algebra R S] [hI : I.is_prime] (hIJ : I ≤ J)
   {x : S} (mem : x ∈ (J : set S) \ I) (integral : is_integral R x) :
-  I.comap (algebra_map R S) < J.comap (algebra_map _ _) :=
+  I.comap (algebra_map R S) < J.comap (algebra_map R S) :=
 begin
   obtain ⟨p, p_monic, hpx⟩ := integral,
   refine comap_lt_comap_of_root_mem_sdiff hIJ mem _ _,
@@ -290,7 +296,7 @@ variables [algebra R A] [algebra A S] [is_scalar_tower R A S] [is_integral_closu
 
 lemma is_integral_closure.comap_lt_comap {I J : ideal A} [I.is_prime]
   (I_lt_J : I < J) :
-  I.comap (algebra_map R A) < J.comap (algebra_map _ _) :=
+  I.comap (algebra_map R A) < J.comap (algebra_map R A) :=
 let ⟨I_le_J, x, hxJ, hxI⟩ := set_like.lt_iff_le_and_exists.mp I_lt_J in
 comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (is_integral_closure.is_integral R S x)
 
@@ -314,7 +320,7 @@ end is_integral_closure
 
 lemma integral_closure.comap_lt_comap {I J : ideal (integral_closure R S)} [I.is_prime]
   (I_lt_J : I < J) :
-  I.comap (algebra_map R (integral_closure R S)) < J.comap (algebra_map _ _) :=
+  I.comap (algebra_map R (integral_closure R S)) < J.comap (algebra_map R (integral_closure R S)) :=
 is_integral_closure.comap_lt_comap S I_lt_J
 
 lemma integral_closure.is_maximal_of_is_maximal_comap
@@ -366,9 +372,10 @@ theorem exists_ideal_over_prime_of_is_integral (H : algebra.is_integral R S)
   (P : ideal R) [is_prime P] (I : ideal S) [is_prime I] (hIP : I.comap (algebra_map R S) ≤ P) :
   ∃ Q ≥ I, is_prime Q ∧ Q.comap (algebra_map R S) = P :=
 begin
+  let quot := (R ⧸ I.comap (algebra_map R S)),
   obtain ⟨Q' : ideal (S ⧸ I), ⟨Q'_prime, hQ'⟩⟩ :=
     @exists_ideal_over_prime_of_is_integral'
-      (R ⧸ I.comap (algebra_map R S)) _ (S ⧸ I) _
+      quot _ (S ⧸ I) _
       ideal.quotient_algebra
       _
       (is_integral_quotient_of_is_integral H)
diff --git a/src/ring_theory/ideal/prod.lean b/src/ring_theory/ideal/prod.lean
index bc215de07d23a..96485fbc8535e 100644
--- a/src/ring_theory/ideal/prod.lean
+++ b/src/ring_theory/ideal/prod.lean
@@ -8,6 +8,9 @@ import ring_theory.ideal.operations
 /-!
 # Ideals in product rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For commutative rings `R` and `S` and ideals `I ≤ R`, `J ≤ S`, we define `ideal.prod I J` as the
 product `I × J`, viewed as an ideal of `R × S`. In `ideal_prod_eq` we show that every ideal of
 `R × S` is of this form.  Furthermore, we show that every prime ideal of `R × S` is of the form
@@ -66,7 +69,7 @@ begin
 end
 
 @[simp] lemma map_prod_comm_prod :
-  map ↑(ring_equiv.prod_comm : R × S ≃+* S × R) (prod I J) = prod J I :=
+  map ((ring_equiv.prod_comm : R × S ≃+* S × R) : R × S →+* S × R) (prod I J) = prod J I :=
 begin
   refine trans (ideal_prod_eq _) _,
   simp [map_map],
@@ -155,41 +158,4 @@ begin
     { exactI is_prime_ideal_prod_top' } }
 end
 
-@[simp] private def prime_ideals_equiv_impl :
-  { I : ideal R // I.is_prime } ⊕ { J : ideal S // J.is_prime } →
-    { K : ideal (R × S) // K.is_prime }
-| (sum.inl ⟨I, hI⟩) := ⟨ideal.prod I ⊤, by exactI is_prime_ideal_prod_top⟩
-| (sum.inr ⟨J, hJ⟩) := ⟨ideal.prod ⊤ J, by exactI is_prime_ideal_prod_top'⟩
-
-section
-variables (R S)
-
-/-- The prime ideals of `R × S` are in bijection with the disjoint union of the prime ideals
-    of `R` and the prime ideals of `S`. -/
-noncomputable def prime_ideals_equiv : { K : ideal (R × S) // K.is_prime } ≃
-  { I : ideal R // I.is_prime } ⊕ { J : ideal S // J.is_prime } :=
-equiv.symm $ equiv.of_bijective prime_ideals_equiv_impl
-begin
-  split,
-  { rintros (⟨I, hI⟩|⟨J, hJ⟩) (⟨I',  hI'⟩|⟨J', hJ'⟩) h;
-    simp [prod.ext_iff] at h,
-    { simp [h] },
-    { exact false.elim (hI.ne_top h.1) },
-    { exact false.elim (hJ.ne_top h.2) },
-    { simp [h] } },
-  { rintro ⟨I, hI⟩,
-    rcases (ideal_prod_prime I).1 hI with (⟨p, ⟨hp, rfl⟩⟩|⟨p, ⟨hp, rfl⟩⟩),
-    { exact ⟨sum.inl ⟨p, hp⟩, rfl⟩ },
-    { exact ⟨sum.inr ⟨p, hp⟩, rfl⟩ } }
-end
-
-end
-
-@[simp] lemma prime_ideals_equiv_symm_inl (h : I.is_prime) :
-  (prime_ideals_equiv R S).symm (sum.inl ⟨I, h⟩) = ⟨prod I ⊤, by exactI is_prime_ideal_prod_top⟩ :=
-rfl
-@[simp] lemma prime_ideals_equiv_symm_inr (h : J.is_prime) :
-  (prime_ideals_equiv R S).symm (sum.inr ⟨J, h⟩) = ⟨prod ⊤ J, by exactI is_prime_ideal_prod_top'⟩ :=
-rfl
-
 end ideal
diff --git a/src/ring_theory/ideal/quotient.lean b/src/ring_theory/ideal/quotient.lean
index f2e732ba00571..2b1256b650dcc 100644
--- a/src/ring_theory/ideal/quotient.lean
+++ b/src/ring_theory/ideal/quotient.lean
@@ -3,11 +3,18 @@ Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Chris Hughes, Mario Carneiro, Anne Baanen
 -/
+import algebra.ring.fin
+import algebra.ring.prod
 import linear_algebra.quotient
+import ring_theory.congruence
 import ring_theory.ideal.basic
+import tactic.fin_cases
 /-!
 # Ideal quotients
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines ideal quotients as a special case of submodule quotients and proves some basic
 results about these quotients.
 
@@ -49,33 +56,35 @@ variables {I} {x y : R}
 
 instance has_one (I : ideal R) : has_one (R ⧸ I) := ⟨submodule.quotient.mk 1⟩
 
-instance has_mul (I : ideal R) : has_mul (R ⧸ I) :=
-⟨λ a b, quotient.lift_on₂' a b (λ a b, submodule.quotient.mk (a * b)) $
- λ a₁ a₂ b₁ b₂ h₁ h₂, quot.sound $ begin
-  rw submodule.quotient_rel_r_def at h₁ h₂ ⊢,
-  have F := I.add_mem (I.mul_mem_left a₂ h₁) (I.mul_mem_right b₁ h₂),
-  have : a₁ * a₂ - b₁ * b₂ = a₂ * (a₁ - b₁) + (a₂ - b₂) * b₁,
-  { rw [mul_sub, sub_mul, sub_add_sub_cancel, mul_comm, mul_comm b₁] },
-  rw ← this at F,
-  change _ ∈ _, convert F,
-end⟩
+/-- On `ideal`s, `submodule.quotient_rel` is a ring congruence. -/
+protected def ring_con (I : ideal R) : ring_con R :=
+{ mul' := λ a₁ b₁ a₂ b₂ h₁ h₂, begin
+    rw submodule.quotient_rel_r_def at h₁ h₂ ⊢,
+    have F := I.add_mem (I.mul_mem_left a₂ h₁) (I.mul_mem_right b₁ h₂),
+    have : a₁ * a₂ - b₁ * b₂ = a₂ * (a₁ - b₁) + (a₂ - b₂) * b₁,
+    { rw [mul_sub, sub_mul, sub_add_sub_cancel, mul_comm, mul_comm b₁] },
+    rw ← this at F,
+    change _ ∈ _, convert F,
+  end,
+  .. quotient_add_group.con I.to_add_subgroup }
 
 instance comm_ring (I : ideal R) : comm_ring (R ⧸ I) :=
-{ mul := (*),
-  one := 1,
-  mul_assoc := λ a b c, quotient.induction_on₃' a b c $
-    λ a b c, congr_arg submodule.quotient.mk (mul_assoc a b c),
-  mul_comm := λ a b, quotient.induction_on₂' a b $
-    λ a b, congr_arg submodule.quotient.mk (mul_comm a b),
-  one_mul := λ a, quotient.induction_on' a $
-    λ a, congr_arg submodule.quotient.mk (one_mul a),
-  mul_one := λ a, quotient.induction_on' a $
-    λ a, congr_arg submodule.quotient.mk (mul_one a),
-  left_distrib := λ a b c, quotient.induction_on₃' a b c $
-    λ a b c, congr_arg submodule.quotient.mk (left_distrib a b c),
-  right_distrib := λ a b c, quotient.induction_on₃' a b c $
-    λ a b c, congr_arg submodule.quotient.mk (right_distrib a b c),
-  ..submodule.quotient.add_comm_group I }
+{ ..submodule.quotient.add_comm_group I,  -- to help with unification
+  ..(quotient.ring_con I)^.quotient.comm_ring }
+
+-- this instance is harder to find than the one via `algebra α (R ⧸ I)`, so use a lower priority
+@[priority 100]
+instance is_scalar_tower_right {α} [has_smul α R] [is_scalar_tower α R R] :
+  is_scalar_tower α (R ⧸ I) (R ⧸ I) :=
+(quotient.ring_con I)^.is_scalar_tower_right
+
+instance smul_comm_class {α} [has_smul α R] [is_scalar_tower α R R] [smul_comm_class α R R] :
+  smul_comm_class α (R ⧸ I) (R ⧸ I) :=
+(quotient.ring_con I)^.smul_comm_class
+
+instance smul_comm_class' {α} [has_smul α R] [is_scalar_tower α R R] [smul_comm_class R α R] :
+  smul_comm_class (R ⧸ I) α (R ⧸ I) :=
+(quotient.ring_con I)^.smul_comm_class'
 
 /-- The ring homomorphism from a ring `R` to a quotient ring `R/I`. -/
 def mk (I : ideal R) : R →+* (R ⧸ I) :=
@@ -118,6 +127,8 @@ instance : unique (R ⧸ (⊤ : ideal R)) :=
 lemma mk_surjective : function.surjective (mk I) :=
 λ y, quotient.induction_on' y (λ x, exists.intro x rfl)
 
+instance : ring_hom_surjective (mk I) := ⟨mk_surjective⟩
+
 /-- If `I` is an ideal of a commutative ring `R`, if `q : R → R/I` is the quotient map, and if
 `s ⊆ R` is a subset, then `q⁻¹(q(s)) = ⋃ᵢ(i + s)`, the union running over all `i ∈ I`. -/
 lemma quotient_ring_saturate (I : ideal R) (s : set R) :
@@ -130,18 +141,25 @@ begin
            ⟨a, ha, by rw [← eq, sub_add_eq_sub_sub_swap, sub_self, zero_sub]; exact I.neg_mem hi⟩⟩
 end
 
-instance is_domain (I : ideal R) [hI : I.is_prime] : is_domain (R ⧸ I) :=
+instance no_zero_divisors (I : ideal R) [hI : I.is_prime] : no_zero_divisors (R ⧸ I) :=
 { eq_zero_or_eq_zero_of_mul_eq_zero := λ a b,
     quotient.induction_on₂' a b $ λ a b hab,
       (hI.mem_or_mem (eq_zero_iff_mem.1 hab)).elim
         (or.inl ∘ eq_zero_iff_mem.2)
-        (or.inr ∘ eq_zero_iff_mem.2),
-  .. quotient.nontrivial hI.1 }
+        (or.inr ∘ eq_zero_iff_mem.2) }
+
+instance is_domain (I : ideal R) [hI : I.is_prime] : is_domain (R ⧸ I) :=
+let _ := quotient.nontrivial hI.1 in by exactI no_zero_divisors.to_is_domain _
 
 lemma is_domain_iff_prime (I : ideal R) : is_domain (R ⧸ I) ↔ I.is_prime :=
-⟨ λ ⟨h1, h2⟩, ⟨zero_ne_one_iff.1 $ @zero_ne_one _ _ ⟨h2⟩, λ x y h,
-    by { simp only [←eq_zero_iff_mem, (mk I).map_mul] at ⊢ h, exact h1 h}⟩,
-  λ h, by { resetI, apply_instance }⟩
+begin
+  refine ⟨λ H, ⟨zero_ne_one_iff.1 _, λ x y h, _⟩, λ h, by { resetI, apply_instance }⟩,
+  { haveI : nontrivial (R ⧸ I) := ⟨H.3⟩,
+    exact zero_ne_one },
+  { simp only [←eq_zero_iff_mem, (mk I).map_mul] at ⊢ h,
+    haveI := @is_domain.to_no_zero_divisors (R ⧸ I) _ H,
+    exact eq_zero_or_eq_zero_of_mul_eq_zero h }
+end
 
 lemma exists_inv {I : ideal R} [hI : I.is_maximal] :
   ∀ {a : (R ⧸ I)}, a ≠ 0 → ∃ b : (R ⧸ I), a * b = 1 :=
@@ -158,19 +176,30 @@ end
 
 open_locale classical
 
-/-- quotient by maximal ideal is a field. def rather than instance, since users will have
-computable inverses in some applications.
+/-- The quotient by a maximal ideal is a group with zero. This is a `def` rather than `instance`,
+since users will have computable inverses in some applications.
+
 See note [reducible non-instances]. -/
 @[reducible]
-protected noncomputable def field (I : ideal R) [hI : I.is_maximal] : field (R ⧸ I) :=
+protected noncomputable def group_with_zero (I : ideal R) [hI : I.is_maximal] :
+  group_with_zero (R ⧸ I) :=
 { inv := λ a, if ha : a = 0 then 0 else classical.some (exists_inv ha),
   mul_inv_cancel := λ a (ha : a ≠ 0), show a * dite _ _ _ = _,
     by rw dif_neg ha;
     exact classical.some_spec (exists_inv ha),
   inv_zero := dif_pos rfl,
-  ..quotient.comm_ring I,
+  ..(by apply_instance : monoid_with_zero (R ⧸ I)),
   ..quotient.is_domain I }
 
+/-- The quotient by a maximal ideal is a field. This is a `def` rather than `instance`, since users
+will have computable inverses (and `qsmul`, `rat_cast`) in some applications.
+
+See note [reducible non-instances]. -/
+@[reducible]
+protected noncomputable def field (I : ideal R) [hI : I.is_maximal] : field (R ⧸ I) :=
+{ ..quotient.comm_ring I,
+  ..quotient.group_with_zero I }
+
 /-- If the quotient by an ideal is a field, then the ideal is maximal. -/
 theorem maximal_of_is_field (I : ideal R)
   (hqf : is_field (R ⧸ I)) : I.is_maximal :=
@@ -187,10 +216,8 @@ begin
 end
 
 /-- The quotient of a ring by an ideal is a field iff the ideal is maximal. -/
-theorem maximal_ideal_iff_is_field_quotient (I : ideal R) :
-  I.is_maximal ↔ is_field (R ⧸ I) :=
-⟨λ h, @field.to_is_field (R ⧸ I) (@ideal.quotient.field _ _ I h),
- λ h, maximal_of_is_field I h⟩
+theorem maximal_ideal_iff_is_field_quotient (I : ideal R) : I.is_maximal ↔ is_field (R ⧸ I) :=
+⟨λ h, by { letI := @quotient.field _ _ I h, exact field.to_is_field _ }, maximal_of_is_field _⟩
 
 variable [comm_ring S]
 
@@ -207,6 +234,15 @@ def lift (I : ideal R) (f : R →+* S) (H : ∀ (a : R), a ∈ I → f a = 0) :
 @[simp] lemma lift_mk (I : ideal R) (f : R →+* S) (H : ∀ (a : R), a ∈ I → f a = 0) :
   lift I f H (mk I a) = f a := rfl
 
+lemma lift_surjective_of_surjective (I : ideal R) {f : R →+* S} (H : ∀ (a : R), a ∈ I → f a = 0)
+  (hf : function.surjective f) : function.surjective (ideal.quotient.lift I f H) :=
+begin
+  intro y,
+  obtain ⟨x, rfl⟩ := hf y,
+  use ideal.quotient.mk I x,
+  simp only [ideal.quotient.lift_mk],
+end
+
 /-- The ring homomorphism from the quotient by a smaller ideal to the quotient by a larger ideal.
 
 This is the `ideal.quotient` version of `quot.factor` -/
@@ -223,7 +259,7 @@ end quotient
 
 /-- Quotienting by equal ideals gives equivalent rings.
 
-See also `submodule.quot_equiv_of_eq`.
+See also `submodule.quot_equiv_of_eq` and `ideal.quotient_equiv_alg_of_eq`.
 -/
 def quot_equiv_of_eq {R : Type*} [comm_ring R] {I J : ideal R} (h : I = J) :
   (R ⧸ I) ≃+* R ⧸ J :=
@@ -235,6 +271,11 @@ lemma quot_equiv_of_eq_mk {R : Type*} [comm_ring R] {I J : ideal R} (h : I = J)
   quot_equiv_of_eq h (ideal.quotient.mk I x) = ideal.quotient.mk J x :=
 rfl
 
+@[simp]
+lemma quot_equiv_of_eq_symm {R : Type*} [comm_ring R] {I J : ideal R} (h : I = J) :
+  (ideal.quot_equiv_of_eq h).symm = ideal.quot_equiv_of_eq h.symm :=
+by ext; refl
+
 section pi
 variables (ι : Type v)
 
@@ -249,40 +290,41 @@ instance module_pi : module (R ⧸ I) ((ι → R) ⧸ I.pi ι) :=
   end,
   one_smul := begin
     rintro ⟨a⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
     congr' with i, exact one_mul (a i),
   end,
   mul_smul := begin
     rintro ⟨a⟩ ⟨b⟩ ⟨c⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
     simp only [(•)],
     congr' with i, exact mul_assoc a b (c i),
   end,
   smul_add := begin
     rintro ⟨a⟩ ⟨b⟩ ⟨c⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
     congr' with i, exact mul_add a (b i) (c i),
   end,
   smul_zero := begin
     rintro ⟨a⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
     congr' with i, exact mul_zero a,
   end,
   add_smul := begin
     rintro ⟨a⟩ ⟨b⟩ ⟨c⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
     congr' with i, exact add_mul a b (c i),
   end,
   zero_smul := begin
     rintro ⟨a⟩,
-    change ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
+    convert_to ideal.quotient.mk _ _ = ideal.quotient.mk _ _,
     congr' with i, exact zero_mul (a i),
   end, }
 
 /-- `R^n/I^n` is isomorphic to `(R/I)^n` as an `R/I`-module. -/
 noncomputable def pi_quot_equiv : ((ι → R) ⧸ I.pi ι) ≃ₗ[(R ⧸ I)] (ι → (R ⧸ I)) :=
 { to_fun := λ x, quotient.lift_on' x (λ f i, ideal.quotient.mk I (f i)) $
-    λ a b hab, funext (λ i, (submodule.quotient.eq' _).2 (hab i)),
+    λ a b hab, funext (λ i, (submodule.quotient.eq' _).2
+      (quotient_add_group.left_rel_apply.mp hab i)),
   map_add' := by { rintros ⟨_⟩ ⟨_⟩, refl },
   map_smul' := by { rintros ⟨_⟩ ⟨_⟩, refl },
   inv_fun := λ x, ideal.quotient.mk (I.pi ι) $ λ i, quotient.out' (x i),
@@ -302,9 +344,11 @@ noncomputable def pi_quot_equiv : ((ι → R) ⧸ I.pi ι) ≃ₗ[(R ⧸ I)] (ι
 
 /-- If `f : R^n → R^m` is an `R`-linear map and `I ⊆ R` is an ideal, then the image of `I^n` is
     contained in `I^m`. -/
-lemma map_pi {ι} [fintype ι] {ι' : Type w} (x : ι → R) (hi : ∀ i, x i ∈ I)
+lemma map_pi {ι : Type*} [finite ι] {ι' : Type w} (x : ι → R) (hi : ∀ i, x i ∈ I)
   (f : (ι → R) →ₗ[R] (ι' → R)) (i : ι') : f x i ∈ I :=
 begin
+  classical,
+  casesI nonempty_fintype ι,
   rw pi_eq_sum_univ x,
   simp only [finset.sum_apply, smul_eq_mul, linear_map.map_sum, pi.smul_apply, linear_map.map_smul],
   exact I.sum_mem (λ j hj, I.mul_mem_right _ (hi j))
@@ -339,10 +383,11 @@ begin
   rw quotient.eq_zero_iff_mem, exact hgj j hjs hji
 end
 
-theorem exists_sub_mem [fintype ι] {f : ι → ideal R}
-  (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) (g : ι → R) :
+theorem exists_sub_mem [finite ι] {f : ι → ideal R} (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤)
+  (g : ι → R) :
   ∃ r : R, ∀ i, r - g i ∈ f i :=
 begin
+  casesI nonempty_fintype ι,
   have : ∃ φ : ι → R, (∀ i, φ i - 1 ∈ f i) ∧ (∀ i j, i ≠ j → φ i ∈ f j),
   { have := exists_sub_one_mem_and_mem (finset.univ : finset ι) (λ i _ j _ hij, hf i j hij),
     choose φ hφ,
@@ -371,7 +416,7 @@ quotient.lift (⨅ i, f i)
     exact quotient.eq_zero_iff_mem.2 (hr i)
   end
 
-theorem quotient_inf_to_pi_quotient_bijective [fintype ι] {f : ι → ideal R}
+theorem quotient_inf_to_pi_quotient_bijective [finite ι] {f : ι → ideal R}
   (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) :
   function.bijective (quotient_inf_to_pi_quotient f) :=
 ⟨λ x y, quotient.induction_on₂' x y $ λ r s hrs, quotient.eq.2 $
@@ -381,7 +426,7 @@ theorem quotient_inf_to_pi_quotient_bijective [fintype ι] {f : ι → ideal R}
 ⟨quotient.mk _ r, funext $ λ i, quotient.out_eq' (g i) ▸ quotient.eq.2 (hr i)⟩⟩
 
 /-- Chinese Remainder Theorem. Eisenbud Ex.2.6. Similar to Atiyah-Macdonald 1.10 and Stacks 00DT -/
-noncomputable def quotient_inf_ring_equiv_pi_quotient [fintype ι] (f : ι → ideal R)
+noncomputable def quotient_inf_ring_equiv_pi_quotient [finite ι] (f : ι → ideal R)
   (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) :
   R ⧸ (⨅ i, f i) ≃+* Π i, R ⧸ f i :=
 { .. equiv.of_bijective _ (quotient_inf_to_pi_quotient_bijective hf),
@@ -389,4 +434,38 @@ noncomputable def quotient_inf_ring_equiv_pi_quotient [fintype ι] (f : ι → i
 
 end chinese_remainder
 
+/-- **Chinese remainder theorem**, specialized to two ideals. -/
+noncomputable def quotient_inf_equiv_quotient_prod (I J : ideal R)
+  (coprime : I ⊔ J = ⊤) :
+  (R ⧸ (I ⊓ J)) ≃+* (R ⧸ I) × R ⧸ J :=
+let f : fin 2 → ideal R := ![I, J] in
+have hf : ∀ (i j : fin 2), i ≠ j → f i ⊔ f j = ⊤,
+by { intros i j h,
+  fin_cases i; fin_cases j; try { contradiction }; simpa [f, sup_comm] using coprime },
+(ideal.quot_equiv_of_eq (by simp [infi, inf_comm])).trans $
+(ideal.quotient_inf_ring_equiv_pi_quotient f hf).trans $
+ring_equiv.pi_fin_two (λ i, R ⧸ f i)
+
+@[simp] lemma quotient_inf_equiv_quotient_prod_fst (I J : ideal R) (coprime : I ⊔ J = ⊤)
+  (x : R ⧸ (I ⊓ J)) : (quotient_inf_equiv_quotient_prod I J coprime x).fst =
+  ideal.quotient.factor (I ⊓ J) I inf_le_left x :=
+quot.induction_on x (λ x, rfl)
+
+@[simp] lemma quotient_inf_equiv_quotient_prod_snd (I J : ideal R) (coprime : I ⊔ J = ⊤)
+  (x : R ⧸ (I ⊓ J)) : (quotient_inf_equiv_quotient_prod I J coprime x).snd =
+  ideal.quotient.factor (I ⊓ J) J inf_le_right x :=
+quot.induction_on x (λ x, rfl)
+
+@[simp] lemma fst_comp_quotient_inf_equiv_quotient_prod (I J : ideal R) (coprime : I ⊔ J = ⊤) :
+  (ring_hom.fst _ _).comp
+    (quotient_inf_equiv_quotient_prod I J coprime : R ⧸ I ⊓ J →+* (R ⧸ I) × R ⧸ J) =
+  ideal.quotient.factor (I ⊓ J) I inf_le_left :=
+by ext; refl
+
+@[simp] lemma snd_comp_quotient_inf_equiv_quotient_prod (I J : ideal R) (coprime : I ⊔ J = ⊤) :
+  (ring_hom.snd _ _).comp
+    (quotient_inf_equiv_quotient_prod I J coprime : R ⧸ I ⊓ J →+* (R ⧸ I) × R ⧸ J) =
+  ideal.quotient.factor (I ⊓ J) J inf_le_right :=
+by ext; refl
+
 end ideal
diff --git a/src/ring_theory/ideal/quotient_operations.lean b/src/ring_theory/ideal/quotient_operations.lean
new file mode 100644
index 0000000000000..106c861b9cc01
--- /dev/null
+++ b/src/ring_theory/ideal/quotient_operations.lean
@@ -0,0 +1,680 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau
+-/
+import ring_theory.ideal.operations
+import ring_theory.ideal.quotient
+/-!
+# More operations on modules and ideals related to quotients
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+universes u v w
+
+namespace ring_hom
+
+variables {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] (f : R →+* S)
+
+/-- The induced map from the quotient by the kernel to the codomain.
+
+This is an isomorphism if `f` has a right inverse (`quotient_ker_equiv_of_right_inverse`) /
+is surjective (`quotient_ker_equiv_of_surjective`).
+-/
+def ker_lift (f : R →+* S) : R ⧸ f.ker →+* S :=
+ideal.quotient.lift _ f $ λ r, f.mem_ker.mp
+
+@[simp]
+lemma ker_lift_mk (f : R →+* S) (r : R) : ker_lift f (ideal.quotient.mk f.ker r) = f r :=
+ideal.quotient.lift_mk _ _ _
+
+/-- The induced map from the quotient by the kernel is injective. -/
+lemma ker_lift_injective (f : R →+* S) : function.injective (ker_lift f) :=
+assume a b, quotient.induction_on₂' a b $
+  assume a b (h : f a = f b), ideal.quotient.eq.2 $
+show a - b ∈ ker f, by rw [mem_ker, map_sub, h, sub_self]
+
+lemma lift_injective_of_ker_le_ideal (I : ideal R) {f : R →+* S}
+  (H : ∀ (a : R), a ∈ I → f a = 0) (hI : f.ker ≤ I) :
+  function.injective (ideal.quotient.lift I f H) :=
+begin
+  rw [ring_hom.injective_iff_ker_eq_bot, ring_hom.ker_eq_bot_iff_eq_zero],
+  intros u hu,
+  obtain ⟨v, rfl⟩ := ideal.quotient.mk_surjective u,
+  rw ideal.quotient.lift_mk at hu,
+  rw [ideal.quotient.eq_zero_iff_mem],
+  exact hI ((ring_hom.mem_ker f).mpr hu),
+end
+
+variable {f}
+
+/-- The **first isomorphism theorem** for commutative rings, computable version. -/
+def quotient_ker_equiv_of_right_inverse
+  {g : S → R} (hf : function.right_inverse g f) :
+  R ⧸ f.ker ≃+* S :=
+{ to_fun := ker_lift f,
+  inv_fun := (ideal.quotient.mk f.ker) ∘ g,
+  left_inv := begin
+    rintro ⟨x⟩,
+    apply ker_lift_injective,
+    simp [hf (f x)],
+  end,
+  right_inv := hf,
+  ..ker_lift f}
+
+@[simp]
+lemma quotient_ker_equiv_of_right_inverse.apply {g : S → R} (hf : function.right_inverse g f)
+  (x : R ⧸ f.ker) : quotient_ker_equiv_of_right_inverse hf x = ker_lift f x := rfl
+
+@[simp]
+lemma quotient_ker_equiv_of_right_inverse.symm.apply {g : S → R} (hf : function.right_inverse g f)
+  (x : S) : (quotient_ker_equiv_of_right_inverse hf).symm x = ideal.quotient.mk f.ker (g x) := rfl
+
+/-- The **first isomorphism theorem** for commutative rings. -/
+noncomputable def quotient_ker_equiv_of_surjective (hf : function.surjective f) :
+  R ⧸ f.ker ≃+* S :=
+quotient_ker_equiv_of_right_inverse (classical.some_spec hf.has_right_inverse)
+
+end ring_hom
+
+namespace ideal
+
+variables {R : Type u} {S : Type v} {F : Type w} [comm_ring R] [comm_ring S]
+
+@[simp] lemma map_quotient_self (I : ideal R) :
+  map (quotient.mk I) I = ⊥ :=
+eq_bot_iff.2 $ ideal.map_le_iff_le_comap.2 $ λ x hx,
+(submodule.mem_bot (R ⧸ I)).2 $ ideal.quotient.eq_zero_iff_mem.2 hx
+
+@[simp] lemma mk_ker {I : ideal R} : (quotient.mk I).ker = I :=
+by ext; rw [ring_hom.ker, mem_comap, submodule.mem_bot, quotient.eq_zero_iff_mem]
+
+lemma map_mk_eq_bot_of_le {I J : ideal R} (h : I ≤ J) : I.map (J^.quotient.mk) = ⊥ :=
+by { rw [map_eq_bot_iff_le_ker, mk_ker], exact h }
+
+lemma ker_quotient_lift {S : Type v} [comm_ring S] {I : ideal R} (f : R →+* S) (H : I ≤ f.ker) :
+  (ideal.quotient.lift I f H).ker = (f.ker).map I^.quotient.mk :=
+begin
+  ext x,
+  split,
+  { intro hx,
+    obtain ⟨y, hy⟩ := quotient.mk_surjective x,
+    rw [ring_hom.mem_ker, ← hy, ideal.quotient.lift_mk, ← ring_hom.mem_ker] at hx,
+    rw [← hy, mem_map_iff_of_surjective I^.quotient.mk quotient.mk_surjective],
+    exact ⟨y, hx, rfl⟩ },
+  { intro hx,
+    rw mem_map_iff_of_surjective I^.quotient.mk quotient.mk_surjective at hx,
+    obtain ⟨y, hy⟩ := hx,
+    rw [ring_hom.mem_ker, ← hy.right, ideal.quotient.lift_mk, ← (ring_hom.mem_ker f)],
+    exact hy.left },
+end
+
+@[simp] lemma bot_quotient_is_maximal_iff (I : ideal R) :
+  (⊥ : ideal (R ⧸ I)).is_maximal ↔ I.is_maximal :=
+⟨λ hI, (@mk_ker _ _ I) ▸
+  @comap_is_maximal_of_surjective _ _ _ _ _ _ (quotient.mk I) quotient.mk_surjective ⊥ hI,
+ λ hI, by { resetI, letI := quotient.field I, exact bot_is_maximal }⟩
+
+/-- See also `ideal.mem_quotient_iff_mem` in case `I ≤ J`. -/
+@[simp]
+lemma mem_quotient_iff_mem_sup {I J : ideal R} {x : R} :
+  quotient.mk I x ∈ J.map (quotient.mk I) ↔ x ∈ J ⊔ I :=
+by rw [← mem_comap, comap_map_of_surjective (quotient.mk I) quotient.mk_surjective,
+       ← ring_hom.ker_eq_comap_bot, mk_ker]
+
+/-- See also `ideal.mem_quotient_iff_mem_sup` if the assumption `I ≤ J` is not available. -/
+lemma mem_quotient_iff_mem {I J : ideal R} (hIJ : I ≤ J) {x : R} :
+  quotient.mk I x ∈ J.map (quotient.mk I) ↔ x ∈ J :=
+by rw [mem_quotient_iff_mem_sup, sup_eq_left.mpr hIJ]
+
+lemma comap_map_mk {I J : ideal R} (h : I ≤ J) :
+  ideal.comap (ideal.quotient.mk I) (ideal.map (ideal.quotient.mk I) J) = J :=
+by { ext, rw [← ideal.mem_quotient_iff_mem h, ideal.mem_comap], }
+
+section quotient_algebra
+
+variables (R₁ R₂ : Type*) {A B : Type*}
+variables [comm_semiring R₁] [comm_semiring R₂] [comm_ring A] [comm_ring B]
+variables [algebra R₁ A] [algebra R₂ A] [algebra R₁ B]
+
+/-- The `R₁`-algebra structure on `A/I` for an `R₁`-algebra `A` -/
+instance quotient.algebra {I : ideal A} : algebra R₁ (A ⧸ I) :=
+{ to_fun := λ x, ideal.quotient.mk I (algebra_map R₁ A x),
+  smul := (•),
+  smul_def' := λ r x, quotient.induction_on' x $ λ x,
+      ((quotient.mk I).congr_arg $ algebra.smul_def _ _).trans (ring_hom.map_mul _ _ _),
+  commutes' := λ _ _, mul_comm _ _,
+  .. ring_hom.comp (ideal.quotient.mk I) (algebra_map R₁ A) }
+
+-- Lean can struggle to find this instance later if we don't provide this shortcut
+instance quotient.is_scalar_tower [has_smul R₁ R₂] [is_scalar_tower R₁ R₂ A] (I : ideal A) :
+  is_scalar_tower R₁ R₂ (A ⧸ I) :=
+by apply_instance
+
+/-- The canonical morphism `A →ₐ[R₁] A ⧸ I` as morphism of `R₁`-algebras, for `I` an ideal of
+`A`, where `A` is an `R₁`-algebra. -/
+def quotient.mkₐ (I : ideal A) : A →ₐ[R₁] A ⧸ I :=
+⟨λ a, submodule.quotient.mk a, rfl, λ _ _, rfl, rfl, λ _ _, rfl, λ _, rfl⟩
+
+lemma quotient.alg_hom_ext {I : ideal A} {S} [semiring S] [algebra R₁ S] ⦃f g : A ⧸ I →ₐ[R₁] S⦄
+  (h : f.comp (quotient.mkₐ R₁ I) = g.comp (quotient.mkₐ R₁ I)) : f = g :=
+alg_hom.ext $ λ x, quotient.induction_on' x $ alg_hom.congr_fun h
+
+lemma quotient.alg_map_eq (I : ideal A) :
+  algebra_map R₁ (A ⧸ I) = (algebra_map A (A ⧸ I)).comp (algebra_map R₁ A) :=
+rfl
+
+lemma quotient.mkₐ_to_ring_hom (I : ideal A) :
+  (quotient.mkₐ R₁ I).to_ring_hom = ideal.quotient.mk I := rfl
+
+@[simp] lemma quotient.mkₐ_eq_mk (I : ideal A) :
+  ⇑(quotient.mkₐ R₁ I) = ideal.quotient.mk I := rfl
+
+@[simp] lemma quotient.algebra_map_eq (I : ideal R) :
+  algebra_map R (R ⧸ I) = I^.quotient.mk :=
+rfl
+
+@[simp] lemma quotient.mk_comp_algebra_map (I : ideal A) :
+  (quotient.mk I).comp (algebra_map R₁ A) = algebra_map R₁ (A ⧸ I) :=
+rfl
+
+@[simp] lemma quotient.mk_algebra_map (I : ideal A) (x : R₁) :
+  quotient.mk I (algebra_map R₁ A x) = algebra_map R₁ (A ⧸ I) x :=
+rfl
+
+/-- The canonical morphism `A →ₐ[R₁] I.quotient` is surjective. -/
+lemma quotient.mkₐ_surjective (I : ideal A) : function.surjective (quotient.mkₐ R₁ I) :=
+surjective_quot_mk _
+
+/-- The kernel of `A →ₐ[R₁] I.quotient` is `I`. -/
+@[simp]
+lemma quotient.mkₐ_ker (I : ideal A) : (quotient.mkₐ R₁ I : A →+* A ⧸ I).ker = I :=
+ideal.mk_ker
+
+variables {R₁}
+
+/-- `ideal.quotient.lift` as an `alg_hom`. -/
+def quotient.liftₐ (I : ideal A) (f : A →ₐ[R₁] B) (hI : ∀ (a : A), a ∈ I → f a = 0) :
+  A ⧸ I →ₐ[R₁] B :=
+{ commutes' := λ r, begin
+    -- this is is_scalar_tower.algebra_map_apply R₁ A (A ⧸ I) but the file `algebra.algebra.tower`
+    -- imports this file.
+    have : algebra_map R₁ (A ⧸ I) r = algebra_map A (A ⧸ I) (algebra_map R₁ A r),
+    { simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul] },
+    rw [this, ideal.quotient.algebra_map_eq,
+      ring_hom.to_fun_eq_coe, ideal.quotient.lift_mk, alg_hom.coe_to_ring_hom,
+      algebra.algebra_map_eq_smul_one, algebra.algebra_map_eq_smul_one, map_smul, map_one],
+  end
+  ..(ideal.quotient.lift I (f : A →+* B) hI) }
+
+@[simp]
+lemma quotient.liftₐ_apply (I : ideal A) (f : A →ₐ[R₁] B) (hI : ∀ (a : A), a ∈ I → f a = 0) (x) :
+  ideal.quotient.liftₐ I f hI x = ideal.quotient.lift I (f : A →+* B) hI x :=
+rfl
+
+lemma quotient.liftₐ_comp (I : ideal A) (f : A →ₐ[R₁] B) (hI : ∀ (a : A), a ∈ I → f a = 0) :
+  (ideal.quotient.liftₐ I f hI).comp (ideal.quotient.mkₐ R₁ I) = f :=
+alg_hom.ext (λ x, (ideal.quotient.lift_mk I (f : A →+* B) hI : _))
+
+
+lemma ker_lift.map_smul (f : A →ₐ[R₁] B) (r : R₁) (x : A ⧸ f.to_ring_hom.ker) :
+  f.to_ring_hom.ker_lift (r • x) = r • f.to_ring_hom.ker_lift x :=
+begin
+  obtain ⟨a, rfl⟩ := quotient.mkₐ_surjective R₁ _ x,
+  rw [← alg_hom.map_smul, quotient.mkₐ_eq_mk, ring_hom.ker_lift_mk],
+  exact f.map_smul _ _
+end
+
+/-- The induced algebras morphism from the quotient by the kernel to the codomain.
+
+This is an isomorphism if `f` has a right inverse (`quotient_ker_alg_equiv_of_right_inverse`) /
+is surjective (`quotient_ker_alg_equiv_of_surjective`).
+-/
+def ker_lift_alg (f : A →ₐ[R₁] B) : (A ⧸ f.to_ring_hom.ker) →ₐ[R₁] B :=
+alg_hom.mk' f.to_ring_hom.ker_lift (λ _ _, ker_lift.map_smul f _ _)
+
+@[simp]
+lemma ker_lift_alg_mk (f : A →ₐ[R₁] B) (a : A) :
+  ker_lift_alg f (quotient.mk f.to_ring_hom.ker a) = f a := rfl
+
+@[simp]
+lemma ker_lift_alg_to_ring_hom (f : A →ₐ[R₁] B) :
+  (ker_lift_alg f).to_ring_hom = ring_hom.ker_lift f := rfl
+
+/-- The induced algebra morphism from the quotient by the kernel is injective. -/
+lemma ker_lift_alg_injective (f : A →ₐ[R₁] B) : function.injective (ker_lift_alg f) :=
+ring_hom.ker_lift_injective f
+
+/-- The **first isomorphism** theorem for algebras, computable version. -/
+def quotient_ker_alg_equiv_of_right_inverse
+  {f : A →ₐ[R₁] B} {g : B → A} (hf : function.right_inverse g f) :
+  (A ⧸ f.to_ring_hom.ker) ≃ₐ[R₁] B :=
+{ ..ring_hom.quotient_ker_equiv_of_right_inverse (λ x, show f.to_ring_hom (g x) = x, from hf x),
+  ..ker_lift_alg f}
+
+@[simp]
+lemma quotient_ker_alg_equiv_of_right_inverse.apply {f : A →ₐ[R₁] B} {g : B → A}
+  (hf : function.right_inverse g f) (x : A ⧸ f.to_ring_hom.ker) :
+  quotient_ker_alg_equiv_of_right_inverse hf x = ker_lift_alg f x := rfl
+
+@[simp]
+lemma quotient_ker_alg_equiv_of_right_inverse_symm.apply {f : A →ₐ[R₁] B} {g : B → A}
+  (hf : function.right_inverse g f) (x : B) :
+  (quotient_ker_alg_equiv_of_right_inverse hf).symm x = quotient.mkₐ R₁ f.to_ring_hom.ker (g x) :=
+  rfl
+
+/-- The **first isomorphism theorem** for algebras. -/
+noncomputable def quotient_ker_alg_equiv_of_surjective
+  {f : A →ₐ[R₁] B} (hf : function.surjective f) : (A ⧸ f.to_ring_hom.ker) ≃ₐ[R₁] B :=
+quotient_ker_alg_equiv_of_right_inverse (classical.some_spec hf.has_right_inverse)
+
+/-- The ring hom `R/I →+* S/J` induced by a ring hom `f : R →+* S` with `I ≤ f⁻¹(J)` -/
+def quotient_map {I : ideal R} (J : ideal S) (f : R →+* S) (hIJ : I ≤ J.comap f) :
+  R ⧸ I →+* S ⧸ J :=
+(quotient.lift I ((quotient.mk J).comp f) (λ _ ha,
+  by simpa [function.comp_app, ring_hom.coe_comp, quotient.eq_zero_iff_mem] using hIJ ha))
+
+@[simp]
+lemma quotient_map_mk {J : ideal R} {I : ideal S} {f : R →+* S} {H : J ≤ I.comap f}
+  {x : R} : quotient_map I f H (quotient.mk J x) = quotient.mk I (f x) :=
+quotient.lift_mk J _ _
+
+@[simp]
+lemma quotient_map_algebra_map {J : ideal A} {I : ideal S} {f : A →+* S} {H : J ≤ I.comap f}
+  {x : R₁} :
+  quotient_map I f H (algebra_map R₁ (A ⧸ J) x) = quotient.mk I (f (algebra_map _ _ x)) :=
+quotient.lift_mk J _ _
+
+lemma quotient_map_comp_mk {J : ideal R} {I : ideal S} {f : R →+* S} (H : J ≤ I.comap f) :
+  (quotient_map I f H).comp (quotient.mk J) = (quotient.mk I).comp f :=
+ring_hom.ext (λ x, by simp only [function.comp_app, ring_hom.coe_comp, ideal.quotient_map_mk])
+
+/-- The ring equiv `R/I ≃+* S/J` induced by a ring equiv `f : R ≃+** S`,  where `J = f(I)`. -/
+@[simps]
+def quotient_equiv (I : ideal R) (J : ideal S) (f : R ≃+* S) (hIJ : J = I.map (f : R →+* S)) :
+  R ⧸ I ≃+* S ⧸ J :=
+{ inv_fun := quotient_map I ↑f.symm (by {rw hIJ, exact le_of_eq (map_comap_of_equiv I f)}),
+  left_inv := by {rintro ⟨r⟩, simp },
+  right_inv := by {rintro ⟨s⟩, simp },
+  ..quotient_map J ↑f (by {rw hIJ, exact @le_comap_map _ S _ _ _ _ _ _}) }
+
+@[simp]
+lemma quotient_equiv_mk (I : ideal R) (J : ideal S) (f : R ≃+* S) (hIJ : J = I.map (f : R →+* S))
+  (x : R) : quotient_equiv I J f hIJ (ideal.quotient.mk I x) = ideal.quotient.mk J (f x) := rfl
+
+@[simp]
+lemma quotient_equiv_symm_mk (I : ideal R) (J : ideal S) (f : R ≃+* S)
+  (hIJ : J = I.map (f : R →+* S)) (x : S) :
+  (quotient_equiv I J f hIJ).symm (ideal.quotient.mk J x) = ideal.quotient.mk I (f.symm x) := rfl
+
+/-- `H` and `h` are kept as separate hypothesis since H is used in constructing the quotient map. -/
+lemma quotient_map_injective' {J : ideal R} {I : ideal S} {f : R →+* S} {H : J ≤ I.comap f}
+  (h : I.comap f ≤ J) : function.injective (quotient_map I f H) :=
+begin
+  refine (injective_iff_map_eq_zero (quotient_map I f H)).2 (λ a ha, _),
+  obtain ⟨r, rfl⟩ := quotient.mk_surjective a,
+  rw [quotient_map_mk, quotient.eq_zero_iff_mem] at ha,
+  exact (quotient.eq_zero_iff_mem).mpr (h ha),
+end
+
+/-- If we take `J = I.comap f` then `quotient_map` is injective automatically. -/
+lemma quotient_map_injective {I : ideal S} {f : R →+* S} :
+  function.injective (quotient_map I f le_rfl) :=
+quotient_map_injective' le_rfl
+
+lemma quotient_map_surjective {J : ideal R} {I : ideal S} {f : R →+* S} {H : J ≤ I.comap f}
+  (hf : function.surjective f) : function.surjective (quotient_map I f H) :=
+λ x, let ⟨x, hx⟩ := quotient.mk_surjective x in
+  let ⟨y, hy⟩ := hf x in ⟨(quotient.mk J) y, by simp [hx, hy]⟩
+
+/-- Commutativity of a square is preserved when taking quotients by an ideal. -/
+lemma comp_quotient_map_eq_of_comp_eq {R' S' : Type*} [comm_ring R'] [comm_ring S']
+  {f : R →+* S} {f' : R' →+* S'} {g : R →+* R'} {g' : S →+* S'} (hfg : f'.comp g = g'.comp f)
+  (I : ideal S') : (quotient_map I g' le_rfl).comp (quotient_map (I.comap g') f le_rfl) =
+    (quotient_map I f' le_rfl).comp (quotient_map (I.comap f') g
+      (le_of_eq (trans (comap_comap f g') (hfg ▸ (comap_comap g f'))))) :=
+begin
+  refine ring_hom.ext (λ a, _),
+  obtain ⟨r, rfl⟩ := quotient.mk_surjective a,
+  simp only [ring_hom.comp_apply, quotient_map_mk],
+  exact congr_arg (quotient.mk I) (trans (g'.comp_apply f r).symm (hfg ▸ (f'.comp_apply g r))),
+end
+
+/-- The algebra hom `A/I →+* B/J` induced by an algebra hom `f : A →ₐ[R₁] B` with `I ≤ f⁻¹(J)`. -/
+def quotient_mapₐ {I : ideal A} (J : ideal B) (f : A →ₐ[R₁] B) (hIJ : I ≤ J.comap f) :
+  A ⧸ I →ₐ[R₁] B ⧸ J :=
+{ commutes' := λ r, by simp,
+  ..quotient_map J (f : A →+* B) hIJ }
+
+@[simp]
+lemma quotient_map_mkₐ {I : ideal A} (J : ideal B) (f : A →ₐ[R₁] B) (H : I ≤ J.comap f)
+  {x : A} : quotient_mapₐ J f H (quotient.mk I x) = quotient.mkₐ R₁ J (f x) := rfl
+
+lemma quotient_map_comp_mkₐ {I : ideal A} (J : ideal B) (f : A →ₐ[R₁] B) (H : I ≤ J.comap f) :
+  (quotient_mapₐ J f H).comp (quotient.mkₐ R₁ I) = (quotient.mkₐ R₁ J).comp f :=
+alg_hom.ext (λ x, by simp only [quotient_map_mkₐ, quotient.mkₐ_eq_mk, alg_hom.comp_apply])
+
+/-- The algebra equiv `A/I ≃ₐ[R] B/J` induced by an algebra equiv `f : A ≃ₐ[R] B`,
+where`J = f(I)`. -/
+def quotient_equiv_alg (I : ideal A) (J : ideal B) (f : A ≃ₐ[R₁] B)
+  (hIJ : J = I.map (f : A →+* B)) :
+  (A ⧸ I) ≃ₐ[R₁] B ⧸ J :=
+{ commutes' := λ r, by simp,
+  ..quotient_equiv I J (f : A ≃+* B) hIJ }
+
+@[priority 100]
+instance quotient_algebra {I : ideal A} [algebra R A] :
+  algebra (R ⧸ I.comap (algebra_map R A)) (A ⧸ I) :=
+(quotient_map I (algebra_map R A) (le_of_eq rfl)).to_algebra
+
+lemma algebra_map_quotient_injective {I : ideal A} [algebra R A]:
+  function.injective (algebra_map (R ⧸ I.comap (algebra_map R A)) (A ⧸ I)) :=
+begin
+  rintros ⟨a⟩ ⟨b⟩ hab,
+  replace hab := quotient.eq.mp hab,
+  rw ← ring_hom.map_sub at hab,
+  exact quotient.eq.mpr hab
+end
+
+variable (R₁)
+
+/-- Quotienting by equal ideals gives equivalent algebras. -/
+def quotient_equiv_alg_of_eq {I J : ideal A} (h : I = J) : (A ⧸ I) ≃ₐ[R₁] A ⧸ J :=
+quotient_equiv_alg I J alg_equiv.refl $ h ▸ (map_id I).symm
+
+@[simp] lemma quotient_equiv_alg_of_eq_mk {I J : ideal A} (h : I = J) (x : A) :
+  quotient_equiv_alg_of_eq R₁ h (ideal.quotient.mk I x) = ideal.quotient.mk J x :=
+rfl
+
+@[simp] lemma quotient_equiv_alg_of_eq_symm {I J : ideal A} (h : I = J) :
+  (quotient_equiv_alg_of_eq R₁ h).symm = quotient_equiv_alg_of_eq R₁ h.symm :=
+by ext; refl
+
+end quotient_algebra
+
+end ideal
+
+namespace double_quot
+open ideal
+variable {R : Type u}
+
+section
+
+variables [comm_ring R] (I J : ideal R)
+
+/-- The obvious ring hom `R/I → R/(I ⊔ J)` -/
+def quot_left_to_quot_sup : R ⧸ I →+* R ⧸ (I ⊔ J) :=
+ideal.quotient.factor I (I ⊔ J) le_sup_left
+
+/-- The kernel of `quot_left_to_quot_sup` -/
+lemma ker_quot_left_to_quot_sup :
+  (quot_left_to_quot_sup I J).ker = J.map (ideal.quotient.mk I) :=
+by simp only [mk_ker, sup_idem, sup_comm, quot_left_to_quot_sup, quotient.factor, ker_quotient_lift,
+    map_eq_iff_sup_ker_eq_of_surjective I^.quotient.mk quotient.mk_surjective, ← sup_assoc]
+
+/-- The ring homomorphism `(R/I)/J' -> R/(I ⊔ J)` induced by `quot_left_to_quot_sup` where `J'`
+  is the image of `J` in `R/I`-/
+def quot_quot_to_quot_sup : (R ⧸ I) ⧸ J.map (ideal.quotient.mk I) →+* R ⧸ I ⊔ J :=
+by exact ideal.quotient.lift (J.map (ideal.quotient.mk I)) (quot_left_to_quot_sup I J)
+  (ker_quot_left_to_quot_sup I J).symm.le
+
+/-- The composite of the maps `R → (R/I)` and `(R/I) → (R/I)/J'` -/
+def quot_quot_mk : R →+* ((R ⧸ I) ⧸ J.map I^.quotient.mk) :=
+by exact ((J.map I^.quotient.mk)^.quotient.mk).comp I^.quotient.mk
+
+/-- The kernel of `quot_quot_mk` -/
+lemma ker_quot_quot_mk : (quot_quot_mk I J).ker = I ⊔ J :=
+by rw [ring_hom.ker_eq_comap_bot, quot_quot_mk, ← comap_comap, ← ring_hom.ker, mk_ker,
+  comap_map_of_surjective (ideal.quotient.mk I) (quotient.mk_surjective), ← ring_hom.ker, mk_ker,
+  sup_comm]
+
+/-- The ring homomorphism `R/(I ⊔ J) → (R/I)/J' `induced by `quot_quot_mk` -/
+def lift_sup_quot_quot_mk (I J : ideal R) :
+  R ⧸ (I ⊔ J) →+* (R ⧸ I) ⧸ J.map (ideal.quotient.mk I) :=
+ideal.quotient.lift (I ⊔ J) (quot_quot_mk I J) (ker_quot_quot_mk I J).symm.le
+
+/-- `quot_quot_to_quot_add` and `lift_sup_double_qot_mk` are inverse isomorphisms. In the case where
+    `I ≤ J`, this is the Third Isomorphism Theorem (see `quot_quot_equiv_quot_of_le`)-/
+def quot_quot_equiv_quot_sup : (R ⧸ I) ⧸ J.map (ideal.quotient.mk I) ≃+* R ⧸ I ⊔ J :=
+ring_equiv.of_hom_inv (quot_quot_to_quot_sup I J) (lift_sup_quot_quot_mk I J)
+  (by { ext z, refl }) (by { ext z, refl })
+
+@[simp]
+lemma quot_quot_equiv_quot_sup_quot_quot_mk (x : R) :
+  quot_quot_equiv_quot_sup I J (quot_quot_mk I J x) = ideal.quotient.mk (I ⊔ J) x :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_quot_sup_symm_quot_quot_mk (x : R) :
+  (quot_quot_equiv_quot_sup I J).symm (ideal.quotient.mk (I ⊔ J) x) = quot_quot_mk I J x :=
+rfl
+
+/-- The obvious isomorphism `(R/I)/J' → (R/J)/I' `   -/
+def quot_quot_equiv_comm :
+  (R ⧸ I) ⧸ J.map I^.quotient.mk ≃+* (R ⧸ J) ⧸ I.map J^.quotient.mk :=
+((quot_quot_equiv_quot_sup I J).trans (quot_equiv_of_eq sup_comm)).trans
+  (quot_quot_equiv_quot_sup J I).symm
+
+@[simp]
+lemma quot_quot_equiv_comm_quot_quot_mk (x : R) :
+  quot_quot_equiv_comm I J (quot_quot_mk I J x) = quot_quot_mk J I x :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_comm_comp_quot_quot_mk :
+  ring_hom.comp ↑(quot_quot_equiv_comm I J) (quot_quot_mk I J) = quot_quot_mk J I :=
+ring_hom.ext $ quot_quot_equiv_comm_quot_quot_mk I J
+
+@[simp]
+lemma quot_quot_equiv_comm_symm :
+  (quot_quot_equiv_comm I J).symm = quot_quot_equiv_comm J I :=
+rfl
+
+variables {I J}
+
+/-- **The Third Isomorphism theorem** for rings. See `quot_quot_equiv_quot_sup` for a version
+    that does not assume an inclusion of ideals. -/
+def quot_quot_equiv_quot_of_le (h : I ≤ J) : (R ⧸ I) ⧸ (J.map I^.quotient.mk) ≃+* R ⧸ J :=
+    (quot_quot_equiv_quot_sup I J).trans (ideal.quot_equiv_of_eq $ sup_eq_right.mpr h)
+
+@[simp]
+lemma quot_quot_equiv_quot_of_le_quot_quot_mk (x : R) (h : I ≤ J) :
+  quot_quot_equiv_quot_of_le h (quot_quot_mk I J x) = J^.quotient.mk x := rfl
+
+@[simp]
+lemma quot_quot_equiv_quot_of_le_symm_mk (x : R) (h : I ≤ J) :
+  (quot_quot_equiv_quot_of_le h).symm (J^.quotient.mk x) = (quot_quot_mk I J x) := rfl
+
+lemma quot_quot_equiv_quot_of_le_comp_quot_quot_mk (h : I ≤ J) :
+  ring_hom.comp ↑(quot_quot_equiv_quot_of_le h) (quot_quot_mk I J) = J^.quotient.mk :=
+by ext ; refl
+
+lemma quot_quot_equiv_quot_of_le_symm_comp_mk (h : I ≤ J) :
+  ring_hom.comp ↑(quot_quot_equiv_quot_of_le h).symm J^.quotient.mk = quot_quot_mk I J :=
+by ext ; refl
+
+end
+
+section algebra
+
+@[simp]
+lemma quot_quot_equiv_comm_mk_mk [comm_ring R] (I J : ideal R) (x : R) :
+  quot_quot_equiv_comm I J (ideal.quotient.mk _ (ideal.quotient.mk _ x)) =
+    algebra_map R _ x := rfl
+
+variables [comm_semiring R] {A : Type v} [comm_ring A] [algebra R A] (I J : ideal A)
+
+@[simp]
+lemma quot_quot_equiv_quot_sup_quot_quot_algebra_map (x : R) :
+  double_quot.quot_quot_equiv_quot_sup I J (algebra_map R _ x) = algebra_map _ _ x :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_comm_algebra_map (x : R) :
+  quot_quot_equiv_comm I J (algebra_map R _ x) = algebra_map _ _ x := rfl
+
+end algebra
+
+section algebra_quotient
+
+variables (R) {A : Type*} [comm_semiring R] [comm_ring A] [algebra R A]
+variables (I J : ideal A)
+
+/-- The natural algebra homomorphism `A / I → A / (I ⊔ J)`. -/
+def quot_left_to_quot_supₐ : A ⧸ I →ₐ[R] A ⧸ (I ⊔ J) :=
+alg_hom.mk (quot_left_to_quot_sup I J) rfl (map_mul _) rfl (map_add _) (λ _, rfl)
+
+@[simp]
+lemma quot_left_to_quot_supₐ_to_ring_hom :
+  (quot_left_to_quot_supₐ R I J).to_ring_hom = quot_left_to_quot_sup I J :=
+rfl
+
+@[simp]
+lemma coe_quot_left_to_quot_supₐ :
+  ⇑(quot_left_to_quot_supₐ R I J) = quot_left_to_quot_sup I J :=
+rfl
+
+/-- The algebra homomorphism `(A / I) / J' -> A / (I ⊔ J) induced by `quot_left_to_quot_sup`,
+  where `J'` is the projection of `J` in `A / I`. -/
+def quot_quot_to_quot_supₐ : (A ⧸ I) ⧸ J.map (I^.quotient.mkₐ R) →ₐ[R] A ⧸ I ⊔ J :=
+alg_hom.mk (quot_quot_to_quot_sup I J) rfl (map_mul _) rfl (map_add _) (λ _, rfl)
+
+@[simp]
+lemma quot_quot_to_quot_supₐ_to_ring_hom :
+  (quot_quot_to_quot_supₐ R I J).to_ring_hom = quot_quot_to_quot_sup I J :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_to_quot_supₐ :
+  ⇑(quot_quot_to_quot_supₐ R I J) = quot_quot_to_quot_sup I J :=
+rfl
+
+/-- The composition of the algebra homomorphisms `A → (A / I)` and `(A / I) → (A / I) / J'`,
+  where `J'` is the projection `J` in `A / I`. -/
+def quot_quot_mkₐ : A →ₐ[R] ((A ⧸ I) ⧸ J.map (I^.quotient.mkₐ R)) :=
+alg_hom.mk (quot_quot_mk I J) rfl (map_mul _) rfl (map_add _) (λ _, rfl)
+
+@[simp]
+lemma quot_quot_mkₐ_to_ring_hom :
+  (quot_quot_mkₐ R I J).to_ring_hom = quot_quot_mk I J :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_mkₐ :
+  ⇑(quot_quot_mkₐ R I J) = quot_quot_mk I J :=
+rfl
+
+/-- The injective algebra homomorphism `A / (I ⊔ J) → (A / I) / J'`induced by `quot_quot_mk`,
+  where `J'` is the projection `J` in `A / I`. -/
+def lift_sup_quot_quot_mkₐ (I J : ideal A) :
+  A ⧸ (I ⊔ J) →ₐ[R] (A ⧸ I) ⧸ J.map (I^.quotient.mkₐ R) :=
+alg_hom.mk (lift_sup_quot_quot_mk I J) rfl (map_mul _) rfl (map_add _) (λ _, rfl)
+
+@[simp]
+lemma lift_sup_quot_quot_mkₐ_to_ring_hom :
+  (lift_sup_quot_quot_mkₐ R I J).to_ring_hom = lift_sup_quot_quot_mk I J :=
+rfl
+
+@[simp]
+lemma coe_lift_sup_quot_quot_mkₐ :
+  ⇑(lift_sup_quot_quot_mkₐ R I J) = lift_sup_quot_quot_mk I J :=
+rfl
+
+/-- `quot_quot_to_quot_add` and `lift_sup_quot_quot_mk` are inverse isomorphisms. In the case where
+    `I ≤ J`, this is the Third Isomorphism Theorem (see `quot_quot_equiv_quot_of_le`). -/
+def quot_quot_equiv_quot_supₐ : ((A ⧸ I) ⧸ J.map (I^.quotient.mkₐ R)) ≃ₐ[R] A ⧸ I ⊔ J :=
+@alg_equiv.of_ring_equiv R _ _ _ _ _ _ _ (quot_quot_equiv_quot_sup I J) (λ _, rfl)
+
+@[simp]
+lemma quot_quot_equiv_quot_supₐ_to_ring_equiv :
+  (quot_quot_equiv_quot_supₐ R I J).to_ring_equiv = quot_quot_equiv_quot_sup I J :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_equiv_quot_supₐ :
+  ⇑(quot_quot_equiv_quot_supₐ R I J) = quot_quot_equiv_quot_sup I J :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_quot_supₐ_symm_to_ring_equiv:
+  (quot_quot_equiv_quot_supₐ R I J).symm.to_ring_equiv = (quot_quot_equiv_quot_sup I J).symm :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_equiv_quot_supₐ_symm:
+  ⇑(quot_quot_equiv_quot_supₐ R I J).symm = (quot_quot_equiv_quot_sup I J).symm :=
+rfl
+
+/-- The natural algebra isomorphism `(A / I) / J' → (A / J) / I'`,
+  where `J'` (resp. `I'`) is the projection of `J` in `A / I` (resp. `I` in `A / J`). -/
+def quot_quot_equiv_commₐ :
+  ((A ⧸ I) ⧸ J.map (I^.quotient.mkₐ R)) ≃ₐ[R]
+    ((A ⧸ J) ⧸ I.map (J^.quotient.mkₐ R)) :=
+@alg_equiv.of_ring_equiv R _ _ _ _ _ _ _ (quot_quot_equiv_comm I J) (λ _, rfl)
+
+@[simp]
+lemma quot_quot_equiv_commₐ_to_ring_equiv :
+  (quot_quot_equiv_commₐ R I J).to_ring_equiv = quot_quot_equiv_comm I J :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_equiv_commₐ :
+  ⇑(quot_quot_equiv_commₐ R I J) = quot_quot_equiv_comm I J :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_comm_symmₐ :
+  (quot_quot_equiv_commₐ R I J).symm = quot_quot_equiv_commₐ R J I :=
+-- TODO: should be `rfl` but times out
+alg_equiv.ext $ λ x, (fun_like.congr_fun (quot_quot_equiv_comm_symm I J) x : _)
+
+@[simp]
+lemma quot_quot_equiv_comm_comp_quot_quot_mkₐ :
+  alg_hom.comp ↑(quot_quot_equiv_commₐ R I J) (quot_quot_mkₐ R I J) = quot_quot_mkₐ R J I :=
+alg_hom.ext $ quot_quot_equiv_comm_quot_quot_mk I J
+
+variables {I J}
+
+/-- The **third isomoprhism theorem** for rings. See `quot_quot_equiv_quot_sup` for version
+    that does not assume an inclusion of ideals. -/
+def quot_quot_equiv_quot_of_leₐ (h : I ≤ J) :
+  ((A ⧸ I) ⧸ (J.map (I^.quotient.mkₐ R))) ≃ₐ[R] A ⧸ J :=
+@alg_equiv.of_ring_equiv R _ _ _ _ _ _ _ (quot_quot_equiv_quot_of_le h) (λ _, rfl)
+
+@[simp]
+lemma quot_quot_equiv_quot_of_leₐ_to_ring_equiv (h : I ≤ J) :
+  (quot_quot_equiv_quot_of_leₐ R h).to_ring_equiv = quot_quot_equiv_quot_of_le h :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_equiv_quot_of_leₐ (h : I ≤ J) :
+  ⇑(quot_quot_equiv_quot_of_leₐ R h) = quot_quot_equiv_quot_of_le h :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_quot_of_leₐ_symm_to_ring_equiv (h : I ≤ J) :
+  (quot_quot_equiv_quot_of_leₐ R h).symm.to_ring_equiv = (quot_quot_equiv_quot_of_le h).symm :=
+rfl
+
+@[simp]
+lemma coe_quot_quot_equiv_quot_of_leₐ_symm (h : I ≤ J) :
+  ⇑(quot_quot_equiv_quot_of_leₐ R h).symm = (quot_quot_equiv_quot_of_le h).symm :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_quot_of_le_comp_quot_quot_mkₐ (h : I ≤ J) :
+  alg_hom.comp ↑(quot_quot_equiv_quot_of_leₐ R h) (quot_quot_mkₐ R I J) =
+    J^.quotient.mkₐ R :=
+rfl
+
+@[simp]
+lemma quot_quot_equiv_quot_of_le_symm_comp_mkₐ (h : I ≤ J) :
+  alg_hom.comp ↑(quot_quot_equiv_quot_of_leₐ R h).symm (J^.quotient.mkₐ R) =
+    quot_quot_mkₐ R I J :=
+rfl
+
+end algebra_quotient
+
+end double_quot
diff --git a/src/ring_theory/int/basic.lean b/src/ring_theory/int/basic.lean
index fbd3891627807..f03522efeb169 100644
--- a/src/ring_theory/int/basic.lean
+++ b/src/ring_theory/int/basic.lean
@@ -3,12 +3,17 @@ Copyright (c) 2018 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson
 -/
+import algebra.euclidean_domain.basic
+import data.nat.factors
 import ring_theory.coprime.basic
 import ring_theory.principal_ideal_domain
 
 /-!
 # Divisibility over ℕ and ℤ
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file collects results for the integers and natural numbers that use abstract algebra in
 their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.
 
@@ -31,13 +36,13 @@ namespace nat
 instance : wf_dvd_monoid ℕ :=
 ⟨begin
   refine rel_hom_class.well_founded
-    (⟨λ (x : ℕ), if x = 0 then (⊤ : with_top ℕ) else x, _⟩ : dvd_not_unit →r (<))
+    (⟨λ (x : ℕ), if x = 0 then (⊤ : ℕ∞) else x, _⟩ : dvd_not_unit →r (<))
     (with_top.well_founded_lt nat.lt_wf),
   intros a b h,
   cases a,
   { exfalso, revert h, simp [dvd_not_unit] },
   cases b,
-  { simp [succ_ne_zero, with_top.coe_lt_top] },
+  { simpa [succ_ne_zero] using with_top.coe_lt_top (a + 1) },
   cases dvd_and_not_dvd_iff.2 h with h1 h2,
   simp only [succ_ne_zero, with_top.coe_lt_coe, if_false],
   apply lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h1) (λ con, h2 _),
@@ -89,24 +94,22 @@ instance : normalization_monoid ℤ :=
 lemma normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : normalize z = z :=
 show z * ↑(ite _ _ _) = z, by rw [if_pos h, units.coe_one, mul_one]
 
-lemma normalize_of_neg {z : ℤ} (h : z < 0) : normalize z = -z :=
-show z * ↑(ite _ _ _) = -z,
-by rw [if_neg (not_le_of_gt h), units.coe_neg, units.coe_one, mul_neg_one]
+lemma normalize_of_nonpos {z : ℤ} (h : z ≤ 0) : normalize z = -z :=
+begin
+  obtain rfl | h := h.eq_or_lt,
+  { simp },
+  { change z * ↑(ite _ _ _) = -z,
+   rw [if_neg (not_le_of_gt h), units.coe_neg, units.coe_one, mul_neg_one] }
+end
 
 lemma normalize_coe_nat (n : ℕ) : normalize (n : ℤ) = n :=
 normalize_of_nonneg (coe_nat_le_coe_nat_of_le $ nat.zero_le n)
 
-theorem coe_nat_abs_eq_normalize (z : ℤ) : (z.nat_abs : ℤ) = normalize z :=
-begin
-  by_cases 0 ≤ z,
-  { simp [nat_abs_of_nonneg h, normalize_of_nonneg h] },
-  { simp [of_nat_nat_abs_of_nonpos (le_of_not_ge h), normalize_of_neg (lt_of_not_ge h)] }
-end
+lemma abs_eq_normalize (z : ℤ) : |z| = normalize z :=
+by cases le_total 0 z; simp [normalize_of_nonneg, normalize_of_nonpos, *]
 
 lemma nonneg_of_normalize_eq_self {z : ℤ} (hz : normalize z = z) : 0 ≤ z :=
-calc 0 ≤ (z.nat_abs : ℤ) : coe_zero_le _
-... = normalize z : coe_nat_abs_eq_normalize _
-... = z : hz
+abs_eq_self.1 $ by rw [abs_eq_normalize, hz]
 
 lemma nonneg_iff_normalize_eq_self (z : ℤ) : normalize z = z ↔ 0 ≤ z :=
 ⟨nonneg_of_normalize_eq_self, normalize_of_nonneg⟩
@@ -125,7 +128,7 @@ instance : gcd_monoid ℤ :=
   gcd_dvd_right  := assume a b, int.gcd_dvd_right _ _,
   dvd_gcd        := assume a b c, dvd_gcd,
   gcd_mul_lcm    := λ a b, by
-  { rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs_eq_normalize],
+  { rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs, abs_eq_normalize],
     exact normalize_associated (a * b) },
   lcm_zero_left  := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_left _,
   lcm_zero_right := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_right _}
@@ -148,7 +151,7 @@ lemma exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ) (h : is_unit u), (int.nat_abs
 begin
   cases (nat_abs_eq a) with h,
   { use [1, is_unit_one], rw [← h, one_mul], },
-  { use [-1, is_unit_one.neg], rw [ ← neg_eq_iff_neg_eq.mp (eq.symm h)],
+  { use [-1, is_unit_one.neg], rw [← neg_eq_iff_eq_neg.mpr h],
     simp only [neg_mul, one_mul] }
 end
 
@@ -176,6 +179,21 @@ end
 lemma coprime_iff_nat_coprime {a b : ℤ} : is_coprime a b ↔ nat.coprime a.nat_abs b.nat_abs :=
 by rw [←gcd_eq_one_iff_coprime, nat.coprime_iff_gcd_eq_one, gcd_eq_nat_abs]
 
+/-- If `gcd a (m * n) ≠ 1`, then `gcd a m ≠ 1` or `gcd a n ≠ 1`. -/
+lemma gcd_ne_one_iff_gcd_mul_right_ne_one {a : ℤ} {m n : ℕ} :
+  a.gcd (m * n) ≠ 1 ↔ a.gcd m ≠ 1 ∨ a.gcd n ≠ 1 :=
+by simp only [gcd_eq_one_iff_coprime, ← not_and_distrib, not_iff_not, is_coprime.mul_right_iff]
+
+/-- If `gcd a (m * n) = 1`, then `gcd a m = 1`. -/
+lemma gcd_eq_one_of_gcd_mul_right_eq_one_left {a : ℤ} {m n : ℕ} (h : a.gcd (m * n) = 1) :
+  a.gcd m = 1 :=
+nat.dvd_one.mp $ trans_rel_left _ (gcd_dvd_gcd_mul_right_right a m n) h
+
+/-- If `gcd a (m * n) = 1`, then `gcd a n = 1`. -/
+lemma gcd_eq_one_of_gcd_mul_right_eq_one_right {a : ℤ} {m n : ℕ} (h : a.gcd (m * n) = 1) :
+  a.gcd n = 1 :=
+nat.dvd_one.mp $ trans_rel_left _ (gcd_dvd_gcd_mul_left_right a n m) h
+
 lemma sq_of_gcd_eq_one {a b c : ℤ} (h : int.gcd a b = 1) (heq : a * b = c ^ 2) :
   ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) :=
 begin
@@ -208,10 +226,10 @@ begin
   { refine (assume a, quotient.induction_on' a $ assume a,
       associates.mk_eq_mk_iff_associated.2 $ associated.symm $ ⟨norm_unit a, _⟩),
     show normalize a = int.nat_abs (normalize a),
-    rw [int.coe_nat_abs_eq_normalize, normalize_idem] },
+    rw [int.coe_nat_abs, int.abs_eq_normalize, normalize_idem] },
   { intro n,
     dsimp,
-    rw [←normalize_apply, ← int.coe_nat_abs_eq_normalize, int.nat_abs_of_nat, int.nat_abs_of_nat] }
+    rw [←normalize_apply, ←int.abs_eq_normalize, int.nat_abs_abs, int.nat_abs_of_nat] }
 end
 
 lemma int.prime.dvd_mul {m n : ℤ} {p : ℕ}
@@ -313,7 +331,7 @@ begin
     rw nat.is_unit_iff.1 h,
     exact h₁, },
   { intros a p _ hp ha,
-    exact h p a (nat.prime_iff.2 hp) ha, },
+    exact h p a hp.nat_prime ha, },
 end
 
 lemma int.associated_nat_abs (k : ℤ) : associated k k.nat_abs :=
@@ -340,8 +358,8 @@ namespace int
 lemma zmultiples_nat_abs (a : ℤ) :
   add_subgroup.zmultiples (a.nat_abs : ℤ) = add_subgroup.zmultiples a :=
 le_antisymm
-  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (dvd_nat_abs.mpr (dvd_refl a))))
-  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (nat_abs_dvd.mpr (dvd_refl a))))
+  (add_subgroup.zmultiples_le_of_mem (mem_zmultiples_iff.mpr (dvd_nat_abs.mpr (dvd_refl a))))
+  (add_subgroup.zmultiples_le_of_mem (mem_zmultiples_iff.mpr (nat_abs_dvd.mpr (dvd_refl a))))
 
 lemma span_nat_abs (a : ℤ) : ideal.span ({a.nat_abs} : set ℤ) = ideal.span {a} :=
 by { rw ideal.span_singleton_eq_span_singleton, exact (associated_nat_abs _).symm }
diff --git a/src/ring_theory/integral_closure.lean b/src/ring_theory/integral_closure.lean
index 792ee40e4076e..fa887f467ad12 100644
--- a/src/ring_theory/integral_closure.lean
+++ b/src/ring_theory/integral_closure.lean
@@ -3,15 +3,21 @@ Copyright (c) 2019 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau
 -/
+import data.polynomial.expand
 import linear_algebra.finite_dimensional
+import linear_algebra.matrix.charpoly.linear_map
 import ring_theory.adjoin.fg
+import ring_theory.finite_type
 import ring_theory.polynomial.scale_roots
 import ring_theory.polynomial.tower
-import linear_algebra.matrix.determinant
+import ring_theory.tensor_product
 
 /-!
 # Integral closure of a subring.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If A is an R-algebra then `a : A` is integral over R if it is a root of a monic polynomial
 with coefficients in R. Enough theory is developed to prove that integral elements
 form a sub-R-algebra of A.
@@ -56,7 +62,7 @@ def is_integral (x : A) : Prop :=
 variable (A)
 
 /-- An algebra is integral if every element of the extension is integral over the base ring -/
-def algebra.is_integral : Prop :=
+protected def algebra.is_integral : Prop :=
 (algebra_map R A).is_integral
 
 variables {R A}
@@ -112,23 +118,57 @@ variables {R A B S : Type*}
 variables [comm_ring R] [comm_ring A] [comm_ring B] [comm_ring S]
 variables [algebra R A] [algebra R B] (f : R →+* S)
 
-theorem is_integral_alg_hom (f : A →ₐ[R] B) {x : A} (hx : is_integral R x) : is_integral R (f x) :=
-let ⟨p, hp, hpx⟩ :=
-hx in ⟨p, hp, by rw [← aeval_def, aeval_alg_hom_apply, aeval_def, hpx, f.map_zero]⟩
+lemma map_is_integral {B C F : Type*} [ring B] [ring C] [algebra R B] [algebra A B]
+  [algebra R C] [is_scalar_tower R A B] [algebra A C] [is_scalar_tower R A C] {b : B}
+  [alg_hom_class F A B C] (f : F) (hb : is_integral R b) : is_integral R (f b) :=
+begin
+  obtain ⟨P, hP⟩ := hb,
+  refine ⟨P, hP.1, _⟩,
+  rw [← aeval_def, show (aeval (f b)) P = (aeval (f b)) (P.map (algebra_map R A)), by simp,
+    aeval_alg_hom_apply, aeval_map_algebra_map, aeval_def, hP.2, _root_.map_zero]
+end
+
+lemma is_integral_map_of_comp_eq_of_is_integral {R S T U : Type*} [comm_ring R] [comm_ring S]
+  [comm_ring T] [comm_ring U] [algebra R S] [algebra T U] (φ : R →+* T) (ψ : S →+* U)
+  (h : (algebra_map T U).comp φ = ψ.comp (algebra_map R S)) {a : S} (ha : is_integral R a) :
+  is_integral T (ψ a) :=
+begin
+  rw [is_integral, ring_hom.is_integral_elem] at ⊢ ha,
+  obtain ⟨p, hp⟩ := ha,
+  refine ⟨p.map φ, hp.left.map _, _⟩,
+  rw [← eval_map, map_map, h, ← map_map, eval_map, eval₂_at_apply,
+    eval_map, hp.right, ring_hom.map_zero],
+end
+
+theorem is_integral_alg_hom_iff {A B : Type*} [ring A] [ring B] [algebra R A] [algebra R B]
+  (f : A →ₐ[R] B) (hf : function.injective f) {x : A} : is_integral R (f x) ↔ is_integral R x :=
+begin
+  refine ⟨_, map_is_integral f⟩,
+  rintros ⟨p, hp, hx⟩,
+  use [p, hp],
+  rwa [← f.comp_algebra_map, ← alg_hom.coe_to_ring_hom, ← polynomial.hom_eval₂,
+    alg_hom.coe_to_ring_hom, map_eq_zero_iff f hf] at hx
+end
 
 @[simp]
-theorem is_integral_alg_equiv (f : A ≃ₐ[R] B) {x : A} : is_integral R (f x) ↔ is_integral R x :=
-⟨λ h, by simpa using is_integral_alg_hom f.symm.to_alg_hom h, is_integral_alg_hom f.to_alg_hom⟩
+theorem is_integral_alg_equiv {A B : Type*} [ring A] [ring B] [algebra R A] [algebra R B]
+  (f : A ≃ₐ[R] B) {x : A} : is_integral R (f x) ↔ is_integral R x :=
+⟨λ h, by simpa using map_is_integral f.symm.to_alg_hom h, map_is_integral f.to_alg_hom⟩
 
 theorem is_integral_of_is_scalar_tower [algebra A B] [is_scalar_tower R A B]
-  (x : B) (hx : is_integral R x) : is_integral A x :=
+  {x : B} (hx : is_integral R x) : is_integral A x :=
 let ⟨p, hp, hpx⟩ := hx in
 ⟨p.map $ algebra_map R A, hp.map _,
-  by rw [← aeval_def, ← is_scalar_tower.aeval_apply, aeval_def, hpx]⟩
+  by rw [← aeval_def, aeval_map_algebra_map, aeval_def, hpx]⟩
+
+lemma map_is_integral_int {B C F : Type*} [ring B] [ring C] {b : B}
+  [ring_hom_class F B C] (f : F) (hb : is_integral ℤ b) :
+  is_integral ℤ (f b) :=
+map_is_integral (f : B →+* C).to_int_alg_hom hb
 
 theorem is_integral_of_subring {x : A} (T : subring R)
   (hx : is_integral T x) : is_integral R x :=
-is_integral_of_is_scalar_tower x hx
+is_integral_of_is_scalar_tower hx
 
 lemma is_integral.algebra_map [algebra A B] [is_scalar_tower R A B]
   {x : A} (h : is_integral R x) :
@@ -142,20 +182,16 @@ end
 lemma is_integral_algebra_map_iff [algebra A B] [is_scalar_tower R A B]
   {x : A} (hAB : function.injective (algebra_map A B)) :
   is_integral R (algebra_map A B x) ↔ is_integral R x :=
-begin
-  refine ⟨_, λ h, h.algebra_map⟩,
-  rintros ⟨f, hf, hx⟩,
-  use [f, hf],
-  exact is_scalar_tower.aeval_eq_zero_of_aeval_algebra_map_eq_zero R A B hAB hx,
-end
+is_integral_alg_hom_iff (is_scalar_tower.to_alg_hom R A B) hAB
 
 theorem is_integral_iff_is_integral_closure_finite {r : A} :
   is_integral R r ↔ ∃ s : set R, s.finite ∧ is_integral (subring.closure s) r :=
 begin
   split; intro hr,
   { rcases hr with ⟨p, hmp, hpr⟩,
-    refine ⟨_, set.finite_mem_finset _, p.restriction, monic_restriction.2 hmp, _⟩,
-    erw [← aeval_def, is_scalar_tower.aeval_apply _ R, map_restriction, aeval_def, hpr] },
+    refine ⟨_, finset.finite_to_set _, p.restriction, monic_restriction.2 hmp, _⟩,
+    rw [← aeval_def, ← aeval_map_algebra_map R r p.restriction,
+      map_restriction, aeval_def, hpr], },
   rcases hr with ⟨s, hs, hsr⟩,
   exact is_integral_of_subring _ hsr
 end
@@ -177,7 +213,7 @@ begin
   rw [alg_hom.map_add, alg_hom.map_mul, hfx, zero_mul, add_zero],
   have : degree (p %ₘ f) ≤ degree f := degree_mod_by_monic_le p hfm,
   generalize_hyp : p %ₘ f = q at this ⊢,
-  rw [← sum_C_mul_X_eq q, aeval_def, eval₂_sum, sum_def],
+  rw [← sum_C_mul_X_pow_eq q, aeval_def, eval₂_sum, sum_def],
   refine sum_mem (λ k hkq, _),
   rw [eval₂_mul, eval₂_C, eval₂_pow, eval₂_X, ← algebra.smul_def],
   refine smul_mem _ _ (subset_span _),
@@ -218,7 +254,7 @@ begin
   have hyS : ∀ {p}, p ∈ y → p ∈ S := λ p hp, show p ∈ S.to_submodule,
     by { rw ← hy, exact subset_span hp },
   -- Now `S` is a subalgebra so the product of two elements of `y` is also in `S`.
-  have : ∀ (jk : (↑(y.product y) : set (A × A))), jk.1.1 * jk.1.2 ∈ S.to_submodule :=
+  have : ∀ (jk : (↑(y ×ˢ y) : set (A × A))), jk.1.1 * jk.1.2 ∈ S.to_submodule :=
     λ jk, S.mul_mem (hyS (finset.mem_product.1 jk.2).1) (hyS (finset.mem_product.1 jk.2).2),
   rw [← hy, ← set.image_id ↑y] at this, simp only [finsupp.mem_span_image_iff_total] at this,
   -- Say `yᵢyⱼ = ∑rᵢⱼₖ yₖ`
@@ -255,7 +291,7 @@ begin
     zero_mem' := (span S₀ (insert 1 ↑y : set A)).zero_mem,
     add_mem' := λ _ _, (span S₀ (insert 1 ↑y : set A)).add_mem,
     neg_mem' := λ _, (span S₀ (insert 1 ↑y : set A)).neg_mem },
-  have : S₁ = (algebra.adjoin S₀ (↑y : set A)).to_subring,
+  have : S₁ = subalgebra.to_subring (algebra.adjoin S₀ (↑y : set A)),
   { ext z,
     suffices : z ∈ span ↥S₀ (insert 1 ↑y : set A) ↔
       z ∈ (algebra.adjoin ↥S₀ (y : set A)).to_submodule,
@@ -285,6 +321,90 @@ begin
   exact subalgebra.smul_mem _ (algebra.subset_adjoin $ hlx1 hr) _
 end
 
+lemma module.End.is_integral {M : Type*} [add_comm_group M] [module R M] [module.finite R M] :
+  algebra.is_integral R (module.End R M) :=
+linear_map.exists_monic_and_aeval_eq_zero R
+
+/-- Suppose `A` is an `R`-algebra, `M` is an `A`-module such that `a • m ≠ 0` for all non-zero `a`
+and `m`. If `x : A` fixes a nontrivial f.g. `R`-submodule `N` of `M`, then `x` is `R`-integral. -/
+lemma is_integral_of_smul_mem_submodule {M : Type*} [add_comm_group M] [module R M]
+  [module A M] [is_scalar_tower R A M] [no_zero_smul_divisors A M]
+  (N : submodule R M) (hN : N ≠ ⊥) (hN' : N.fg) (x : A)
+    (hx : ∀ n ∈ N, x • n ∈ N) : is_integral R x :=
+begin
+  let A' : subalgebra R A :=
+  { carrier := { x | ∀ n ∈ N, x • n ∈ N },
+    mul_mem' := λ a b ha hb n hn, smul_smul a b n ▸ ha _ (hb _ hn),
+    one_mem' := λ n hn, (one_smul A n).symm ▸ hn,
+    add_mem' := λ a b ha hb n hn, (add_smul a b n).symm ▸ N.add_mem (ha _ hn) (hb _ hn),
+    zero_mem' := λ n hn, (zero_smul A n).symm ▸ N.zero_mem,
+    algebra_map_mem' := λ r n hn, (algebra_map_smul A r n).symm ▸ N.smul_mem r hn },
+  let f : A' →ₐ[R] module.End R N := alg_hom.of_linear_map
+    { to_fun := λ x, (distrib_mul_action.to_linear_map R M x).restrict x.prop,
+      map_add' := λ x y, linear_map.ext $ λ n, subtype.ext $ add_smul x y n,
+      map_smul' := λ r s, linear_map.ext $ λ n, subtype.ext $ smul_assoc r s n }
+      (linear_map.ext $ λ n, subtype.ext $ one_smul _ _)
+      (λ x y, linear_map.ext $ λ n, subtype.ext $ mul_smul x y n),
+  obtain ⟨a, ha₁, ha₂⟩ : ∃ a ∈ N, a ≠ (0 : M),
+  { by_contra h', push_neg at h', apply hN, rwa eq_bot_iff },
+  have : function.injective f,
+  { show function.injective f.to_linear_map,
+    rw [← linear_map.ker_eq_bot, eq_bot_iff],
+    intros s hs,
+    have : s.1 • a = 0 := congr_arg subtype.val (linear_map.congr_fun hs ⟨a, ha₁⟩),
+    exact subtype.ext ((eq_zero_or_eq_zero_of_smul_eq_zero this).resolve_right ha₂) },
+  show is_integral R (A'.val ⟨x, hx⟩),
+  rw [is_integral_alg_hom_iff A'.val subtype.val_injective,
+    ← is_integral_alg_hom_iff f this],
+  haveI : module.finite R N := by rwa [module.finite_def, submodule.fg_top],
+  apply module.End.is_integral,
+end
+
+variables {f}
+
+lemma ring_hom.finite.to_is_integral (h : f.finite) : f.is_integral :=
+by { letI := f.to_algebra, exact λ x, is_integral_of_mem_of_fg ⊤ h.1 _ trivial }
+
+alias ring_hom.finite.to_is_integral ← ring_hom.is_integral.of_finite
+
+lemma ring_hom.is_integral.to_finite (h : f.is_integral) (h' : f.finite_type) : f.finite :=
+begin
+  letI := f.to_algebra,
+  unfreezingI { obtain ⟨s, hs⟩ := h' },
+  constructor,
+  change (⊤ : subalgebra R S).to_submodule.fg,
+  rw ← hs,
+  exact fg_adjoin_of_finite (set.to_finite _) (λ x _, h x)
+end
+
+alias ring_hom.is_integral.to_finite ← ring_hom.finite.of_is_integral_of_finite_type
+
+/-- finite = integral + finite type -/
+lemma ring_hom.finite_iff_is_integral_and_finite_type :
+  f.finite ↔ f.is_integral ∧ f.finite_type :=
+⟨λ h, ⟨h.to_is_integral, h.to_finite_type⟩, λ ⟨h, h'⟩, h.to_finite h'⟩
+
+lemma algebra.is_integral.finite (h : algebra.is_integral R A) [h' : algebra.finite_type R A] :
+  module.finite R A :=
+begin
+  have := h.to_finite
+    (by { delta ring_hom.finite_type, convert h', ext, exact (algebra.smul_def _ _).symm }),
+  delta ring_hom.finite at this, convert this, ext, exact algebra.smul_def _ _,
+end
+
+lemma algebra.is_integral.of_finite [h : module.finite R A] : algebra.is_integral R A :=
+begin
+  apply ring_hom.finite.to_is_integral,
+  delta ring_hom.finite, convert h, ext, exact (algebra.smul_def _ _).symm,
+end
+
+/-- finite = integral + finite type -/
+lemma algebra.finite_iff_is_integral_and_finite_type :
+  module.finite R A ↔ algebra.is_integral R A ∧ algebra.finite_type R A :=
+⟨λ h, by exactI ⟨algebra.is_integral.of_finite, infer_instance⟩, λ ⟨h, h'⟩, by exactI h.finite⟩
+
+variables (f)
+
 lemma ring_hom.is_integral_of_mem_closure {x y z : S}
   (hx : f.is_integral_elem x) (hy : f.is_integral_elem y)
   (hz : z ∈ subring.closure ({x, y} : set S)) :
@@ -358,6 +478,14 @@ begin
   exact is_integral_mul is_integral_algebra_map hx,
 end
 
+lemma is_integral_of_pow {x : A} {n : ℕ} (hn : 0 < n) (hx : is_integral R $ x ^ n) :
+  is_integral R x :=
+begin
+  rcases hx with ⟨p, ⟨hmonic, heval⟩⟩,
+  exact ⟨expand R n p, monic.expand hn hmonic,
+         by rwa [eval₂_eq_eval_map, map_expand, expand_eval, ← eval₂_eq_eval_map]⟩
+end
+
 variables (R A)
 
 /-- The integral closure of R in an R-algebra A. -/
@@ -401,9 +529,9 @@ begin
   rw subalgebra.mem_map,
   split,
   { rintros ⟨x, hx, rfl⟩,
-    exact is_integral_alg_hom f hx },
+    exact map_is_integral f hx },
   { intro hy,
-    use [f.symm y, is_integral_alg_hom (f.symm : B →ₐ[R] A) hy],
+    use [f.symm y, map_is_integral (f.symm : B →ₐ[R] A) hy],
     simp }
 end
 
@@ -467,6 +595,28 @@ begin
   exact is_integral.sum _ (λ σ hσ, is_integral.zsmul (is_integral.prod _ (λ i hi, h _ _)) _)
 end
 
+@[simp] lemma is_integral.pow_iff {x : A} {n : ℕ} (hn : 0 < n) :
+  is_integral R (x ^ n) ↔ is_integral R x :=
+⟨is_integral_of_pow hn, λ hx, is_integral.pow hx n⟩
+
+open_locale tensor_product
+
+lemma is_integral.tmul (x : A) {y : B} (h : is_integral R y) : is_integral A (x ⊗ₜ[R] y) :=
+begin
+  obtain ⟨p, hp, hp'⟩ := h,
+  refine ⟨(p.map (algebra_map R A)).scale_roots x, _, _⟩,
+  { rw polynomial.monic_scale_roots_iff, exact hp.map _ },
+  convert @polynomial.scale_roots_eval₂_mul (A ⊗[R] B) A _ _ _
+    algebra.tensor_product.include_left.to_ring_hom (1 ⊗ₜ y) x using 2,
+  { simp only [alg_hom.to_ring_hom_eq_coe, alg_hom.coe_to_ring_hom, mul_one, one_mul,
+      algebra.tensor_product.include_left_apply, algebra.tensor_product.tmul_mul_tmul] },
+  convert (mul_zero _).symm,
+  rw [polynomial.eval₂_map, algebra.tensor_product.include_left_comp_algebra_map,
+    ← polynomial.eval₂_map],
+  convert polynomial.eval₂_at_apply algebra.tensor_product.include_right.to_ring_hom y,
+  rw [polynomial.eval_map, hp', _root_.map_zero],
+end
+
 section
 
 variables (p : R[X]) (x : S)
@@ -614,6 +764,14 @@ theorem is_integral_algebra [algebra R A] [is_scalar_tower R A B] :
   algebra.is_integral R A :=
 λ x, is_integral_closure.is_integral R B x
 
+theorem no_zero_smul_divisors [algebra R A] [is_scalar_tower R A B] [no_zero_smul_divisors R B] :
+  no_zero_smul_divisors R A :=
+begin
+  refine function.injective.no_zero_smul_divisors
+      _ (is_integral_closure.algebra_map_injective A R B) (map_zero _) (λ _ _, _),
+  simp only [algebra.algebra_map_eq_smul_one, is_scalar_tower.smul_assoc],
+ end
+
 variables {R} (A) {B}
 
 /-- If `x : B` is integral over `R`, then it is an element of the integral closure of `R` in `B`. -/
@@ -718,7 +876,7 @@ variables [algebra R A] [is_scalar_tower R A B]
 
 /-- If A is an R-algebra all of whose elements are integral over R,
 and x is an element of an A-algebra that is integral over A, then x is integral over R.-/
-lemma is_integral_trans (A_int : is_integral R A) (x : B) (hx : is_integral A x) :
+lemma is_integral_trans (A_int : algebra.is_integral R A) (x : B) (hx : is_integral A x) :
   is_integral R x :=
 begin
   rcases hx with ⟨p, pmonic, hp⟩,
@@ -728,7 +886,7 @@ begin
   { rw [finset.mem_coe, frange, finset.mem_image] at hx,
     rcases hx with ⟨i, _, rfl⟩,
     rw coeff_map,
-    exact is_integral_alg_hom (is_scalar_tower.to_alg_hom R A B) (A_int _) },
+    exact map_is_integral (is_scalar_tower.to_alg_hom R A B) (A_int _) },
   { apply fg_adjoin_singleton_of_integral,
     exact is_integral_trans_aux _ pmonic hp }
 end
@@ -736,7 +894,8 @@ end
 /-- If A is an R-algebra all of whose elements are integral over R,
 and B is an A-algebra all of whose elements are integral over A,
 then all elements of B are integral over R.-/
-lemma algebra.is_integral_trans (hA : is_integral R A) (hB : is_integral A B) : is_integral R B :=
+lemma algebra.is_integral_trans (hA : algebra.is_integral R A) (hB : algebra.is_integral A B) :
+  algebra.is_integral R B :=
 λ x, is_integral_trans hA x (hB x)
 
 lemma ring_hom.is_integral_trans (hf : f.is_integral) (hg : g.is_integral) :
@@ -748,8 +907,8 @@ lemma ring_hom.is_integral_trans (hf : f.is_integral) (hg : g.is_integral) :
 lemma ring_hom.is_integral_of_surjective (hf : function.surjective f) : f.is_integral :=
 λ x, (hf x).rec_on (λ y hy, (hy ▸ f.is_integral_map : f.is_integral_elem x))
 
-lemma is_integral_of_surjective (h : function.surjective (algebra_map R A)) : is_integral R A :=
-(algebra_map R A).is_integral_of_surjective h
+lemma is_integral_of_surjective (h : function.surjective (algebra_map R A)) :
+  algebra.is_integral R A := (algebra_map R A).is_integral_of_surjective h
 
 /-- If `R → A → B` is an algebra tower with `A → B` injective,
 then if the entire tower is an integral extension so is `R → A` -/
@@ -802,8 +961,8 @@ begin
   simpa only [hom_eval₂, eval₂_map] using congr_arg (ideal.quotient.mk I) hpx
 end
 
-lemma is_integral_quotient_of_is_integral {I : ideal A} (hRA : is_integral R A) :
-  is_integral (R ⧸ I.comap (algebra_map R A)) (A ⧸ I) :=
+lemma is_integral_quotient_of_is_integral {I : ideal A} (hRA : algebra.is_integral R A) :
+  algebra.is_integral (R ⧸ I.comap (algebra_map R A)) (A ⧸ I) :=
 (algebra_map R A).is_integral_quotient_of_is_integral hRA
 
 lemma is_integral_quotient_map_iff {I : ideal S} :
@@ -820,7 +979,7 @@ end
 /-- If the integral extension `R → S` is injective, and `S` is a field, then `R` is also a field. -/
 lemma is_field_of_is_integral_of_is_field
   {R S : Type*} [comm_ring R] [nontrivial R] [comm_ring S] [is_domain S]
-  [algebra R S] (H : is_integral R S) (hRS : function.injective (algebra_map R S))
+  [algebra R S] (H : algebra.is_integral R S) (hRS : function.injective (algebra_map R S))
   (hS : is_field S) : is_field R :=
 begin
   refine ⟨⟨0, 1, zero_ne_one⟩, mul_comm, λ a ha, _⟩,
@@ -871,12 +1030,12 @@ begin
   haveI : is_noetherian R A :=
   is_noetherian_of_fg_of_noetherian A.to_submodule (fg_adjoin_singleton_of_integral x (H x)),
   haveI : module.finite R A := module.is_noetherian.finite R A,
-  obtain ⟨y, hy⟩ := linear_map.surjective_of_injective (@lmul_left_injective R A _ _ _ _
+  obtain ⟨y, hy⟩ := linear_map.surjective_of_injective (@linear_map.mul_left_injective R A _ _ _ _
     ⟨x, subset_adjoin (set.mem_singleton x)⟩ (λ h, hx (subtype.ext_iff.mp h))) 1,
   exact ⟨y, subtype.ext_iff.mp hy⟩,
 end
 
-lemma is_integral.is_field_iff_is_field
+lemma algebra.is_integral.is_field_iff_is_field
   {R S : Type*} [comm_ring R] [nontrivial R] [comm_ring S] [is_domain S] [algebra R S]
   (H : algebra.is_integral R S) (hRS : function.injective (algebra_map R S)) :
   is_field R ↔ is_field S :=
@@ -896,4 +1055,8 @@ variables {R S : Type*} [comm_ring R] [comm_ring S] [is_domain S] [algebra R S]
 instance : is_domain (integral_closure R S) :=
 infer_instance
 
+theorem roots_mem_integral_closure {f : R[X]} (hf : f.monic) {a : S}
+  (ha : a ∈ (f.map $ algebra_map R S).roots) : a ∈ integral_closure R S :=
+⟨f, hf, (eval₂_eq_eval_map _).trans $ (mem_roots $ (hf.map _).ne_zero).1 ha⟩
+
 end is_domain
diff --git a/src/ring_theory/integral_domain.lean b/src/ring_theory/integral_domain.lean
index 8c9618b8c8c80..1f325173541f9 100644
--- a/src/ring_theory/integral_domain.lean
+++ b/src/ring_theory/integral_domain.lean
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Chris Hughes
 -/
 
-import data.fintype.card
 import data.polynomial.ring_division
 import group_theory.specific_groups.cyclic
 import algebra.geom_sum
@@ -12,6 +11,9 @@ import algebra.geom_sum
 /-!
 # Integral domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Assorted theorems about integral domains.
 
 ## Main theorems
@@ -35,24 +37,49 @@ open_locale big_operators nat
 
 section cancel_monoid_with_zero
 -- There doesn't seem to be a better home for these right now
-variables {M : Type*} [cancel_monoid_with_zero M] [fintype M]
+variables {M : Type*} [cancel_monoid_with_zero M] [finite M]
 
-lemma mul_right_bijective_of_fintype₀ {a : M} (ha : a ≠ 0) : bijective (λ b, a * b) :=
-fintype.injective_iff_bijective.1 $ mul_right_injective₀ ha
+lemma mul_right_bijective_of_finite₀ {a : M} (ha : a ≠ 0) : bijective (λ b, a * b) :=
+finite.injective_iff_bijective.1 $ mul_right_injective₀ ha
 
-lemma mul_left_bijective_of_fintype₀ {a : M} (ha : a ≠ 0) : bijective (λ b, b * a) :=
-fintype.injective_iff_bijective.1 $ mul_left_injective₀ ha
+lemma mul_left_bijective_of_finite₀ {a : M} (ha : a ≠ 0) : bijective (λ b, b * a) :=
+finite.injective_iff_bijective.1 $ mul_left_injective₀ ha
 
 /-- Every finite nontrivial cancel_monoid_with_zero is a group_with_zero. -/
 def fintype.group_with_zero_of_cancel (M : Type*) [cancel_monoid_with_zero M] [decidable_eq M]
   [fintype M] [nontrivial M] : group_with_zero M :=
-{ inv := λ a, if h : a = 0 then 0 else fintype.bij_inv (mul_right_bijective_of_fintype₀ h) 1,
+{ inv := λ a, if h : a = 0 then 0 else fintype.bij_inv (mul_right_bijective_of_finite₀ h) 1,
   mul_inv_cancel := λ a ha,
     by { simp [has_inv.inv, dif_neg ha], exact fintype.right_inverse_bij_inv _ _ },
   inv_zero := by { simp [has_inv.inv, dif_pos rfl] },
   ..‹nontrivial M›,
   ..‹cancel_monoid_with_zero M› }
 
+lemma exists_eq_pow_of_mul_eq_pow_of_coprime {R : Type*} [comm_semiring R] [is_domain R]
+  [gcd_monoid R] [unique Rˣ] {a b c : R} {n : ℕ} (cp : is_coprime a b) (h : a * b = c ^ n) :
+  ∃ d : R, a = d ^ n :=
+begin
+  refine exists_eq_pow_of_mul_eq_pow (is_unit_of_dvd_one _ _) h,
+  obtain ⟨x, y, hxy⟩ := cp,
+  rw [← hxy],
+  exact dvd_add (dvd_mul_of_dvd_right (gcd_dvd_left _ _) _)
+    (dvd_mul_of_dvd_right (gcd_dvd_right _ _) _)
+end
+
+lemma finset.exists_eq_pow_of_mul_eq_pow_of_coprime {ι R : Type*} [comm_semiring R] [is_domain R]
+  [gcd_monoid R] [unique Rˣ] {n : ℕ} {c : R} {s : finset ι} {f : ι → R}
+  (h : ∀ i j ∈ s, i ≠ j → is_coprime (f i) (f j))
+  (hprod : ∏ i in s, f i = c ^ n) : ∀ i ∈ s, ∃ d : R, f i = d ^ n :=
+begin
+  classical,
+  intros i hi,
+  rw [← insert_erase hi, prod_insert (not_mem_erase i s)] at hprod,
+  refine exists_eq_pow_of_mul_eq_pow_of_coprime
+    (is_coprime.prod_right (λ j hj, h i hi j (erase_subset i s hj) (λ hij, _))) hprod,
+  rw [hij] at hj,
+  exact (s.not_mem_erase _) hj
+end
+
 end cancel_monoid_with_zero
 
 variables {R : Type*} {G : Type*}
@@ -79,14 +106,16 @@ def fintype.field_of_domain (R) [comm_ring R] [is_domain R] [decidable_eq R] [fi
 { .. fintype.group_with_zero_of_cancel R,
   .. ‹comm_ring R› }
 
-lemma fintype.is_field_of_domain (R) [comm_ring R] [is_domain R] [fintype R] :
-  is_field R := @field.to_is_field R $ @@fintype.field_of_domain R _ _ (classical.dec_eq R) _
+lemma finite.is_field_of_domain (R) [comm_ring R] [is_domain R] [finite R] : is_field R :=
+by { casesI nonempty_fintype R,
+  exact @field.to_is_field R (@@fintype.field_of_domain R _ _ (classical.dec_eq R) _) }
 
 end ring
 
-variables [comm_ring R] [is_domain R] [group G] [fintype G]
+variables [comm_ring R] [is_domain R] [group G]
 
-lemma card_nth_roots_subgroup_units (f : G →* R) (hf : injective f) {n : ℕ} (hn : 0 < n) (g₀ : G) :
+lemma card_nth_roots_subgroup_units [fintype G] (f : G →* R) (hf : injective f) {n : ℕ} (hn : 0 < n)
+  (g₀ : G) :
   ({g ∈ univ | g ^ n = g₀} : finset G).card ≤ (nth_roots n (f g₀)).card :=
 begin
   haveI : decidable_eq R := classical.dec_eq _,
@@ -99,9 +128,10 @@ begin
 end
 
 /-- A finite subgroup of the unit group of an integral domain is cyclic. -/
-lemma is_cyclic_of_subgroup_is_domain (f : G →* R) (hf : injective f) : is_cyclic G :=
+lemma is_cyclic_of_subgroup_is_domain [finite G] (f : G →* R) (hf : injective f) : is_cyclic G :=
 begin
   classical,
+  casesI nonempty_fintype G,
   apply is_cyclic_of_card_pow_eq_one_le,
   intros n hn,
   convert (le_trans (card_nth_roots_subgroup_units f hf hn 1) (card_nth_roots n (f 1)))
@@ -110,13 +140,13 @@ end
 /-- The unit group of a finite integral domain is cyclic.
 
 To support `ℤˣ` and other infinite monoids with finite groups of units, this requires only
-`fintype Rˣ` rather than deducing it from `fintype R`. -/
-instance [fintype Rˣ] : is_cyclic Rˣ :=
+`finite Rˣ` rather than deducing it from `finite R`. -/
+instance [finite Rˣ] : is_cyclic Rˣ :=
 is_cyclic_of_subgroup_is_domain (units.coe_hom R) $ units.ext
 
 section
 
-variables (S : subgroup Rˣ) [fintype S]
+variables (S : subgroup Rˣ) [finite S]
 
 /-- A finite subgroup of the units of an integral domain is cyclic. -/
 instance subgroup_units_cyclic : is_cyclic S :=
@@ -129,6 +159,31 @@ end
 
 end
 
+section euclidean_division
+
+namespace polynomial
+
+open_locale polynomial
+
+variables (K : Type) [field K] [algebra R[X] K] [is_fraction_ring R[X] K]
+
+lemma div_eq_quo_add_rem_div (f : R[X]) {g : R[X]} (hg : g.monic) :
+  ∃ q r : R[X], r.degree < g.degree ∧ (↑f : K) / ↑g = ↑q + ↑r / ↑g :=
+begin
+  refine ⟨f /ₘ g, f %ₘ g, _, _⟩,
+  { exact degree_mod_by_monic_lt _ hg },
+  { have hg' : (↑g : K) ≠ 0 := by exact_mod_cast (monic.ne_zero hg),
+    field_simp [hg'],
+    norm_cast,
+    rw [add_comm, mul_comm, mod_by_monic_add_div f hg] },
+end
+
+end polynomial
+
+end euclidean_division
+
+variables [fintype G]
+
 lemma card_fiber_eq_of_mem_range {H : Type*} [group H] [decidable_eq H]
   (f : G →* H) {x y : H} (hx : x ∈ set.range f) (hy : y ∈ set.range f) :
   (univ.filter $ λ g, f g = x).card = (univ.filter $ λ g, f g = y).card :=
@@ -193,7 +248,7 @@ begin
       (λ b hb, let ⟨n, hn⟩ := hx b in ⟨n % order_of x, mem_range.2 (nat.mod_lt _ (order_of_pos _)),
         by rw [← pow_eq_mod_order_of, hn]⟩)
   ... = 0 : _,
-  rw [← mul_left_inj' hx1, zero_mul, ← geom_sum, geom_sum_mul, coe_coe],
+  rw [← mul_left_inj' hx1, zero_mul, geom_sum_mul, coe_coe],
   norm_cast,
   simp [pow_order_of_eq_one],
 end
diff --git a/src/ring_theory/integrally_closed.lean b/src/ring_theory/integrally_closed.lean
index 2696fdab3e6dc..874aaff7990da 100644
--- a/src/ring_theory/integrally_closed.lean
+++ b/src/ring_theory/integrally_closed.lean
@@ -9,6 +9,9 @@ import ring_theory.localization.integral
 /-!
 # Integrally closed rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 An integrally closed domain `R` contains all the elements of `Frac(R)` that are
 integral over `R`. A special case of integrally closed domains are the Dedekind domains.
 
@@ -22,7 +25,9 @@ integral over `R`. A special case of integrally closed domains are the Dedekind
   is integrally closed iff it is the integral closure of `R` in `K`
 -/
 
-open_locale non_zero_divisors
+open_locale non_zero_divisors polynomial
+
+open polynomial
 
 /-- `R` is integrally closed if all integral elements of `Frac(R)` are also elements of `R`.
 
@@ -75,18 +80,29 @@ end iff
 
 namespace is_integrally_closed
 
-variables {R : Type*} [comm_ring R] [is_domain R] [iic : is_integrally_closed R]
-variables {K : Type*} [field K] [algebra R K] [is_fraction_ring R K]
+variables {R : Type*} [comm_ring R] [id : is_domain R] [iic : is_integrally_closed R]
+variables {K : Type*} [field K] [algebra R K] [ifr : is_fraction_ring R K]
 
-instance : is_integral_closure R R K :=
-(is_integrally_closed_iff_is_integral_closure K).mp iic
+include iic ifr
 
-include iic
+instance : is_integral_closure R R K := (is_integrally_closed_iff_is_integral_closure K).mp iic
 
-lemma is_integral_iff {x : K} : is_integral R x ↔ ∃ y, algebra_map R K y = x :=
+lemma is_integral_iff {x : K} : is_integral R x ↔ ∃ y : R, algebra_map R K y = x :=
 is_integral_closure.is_integral_iff
 
-omit iic
+lemma exists_algebra_map_eq_of_is_integral_pow {x : K} {n : ℕ} (hn : 0 < n)
+  (hx : is_integral R $ x ^ n) : ∃ y : R, algebra_map R K y = x :=
+is_integral_iff.mp $ is_integral_of_pow hn hx
+
+omit iic ifr
+
+lemma exists_algebra_map_eq_of_pow_mem_subalgebra {K : Type*} [field K] [algebra R K]
+  {S : subalgebra R K} [is_integrally_closed S] [is_fraction_ring S K] {x : K} {n : ℕ} (hn : 0 < n)
+  (hx : x ^ n ∈ S) : ∃ y : S, algebra_map S K y = x :=
+exists_algebra_map_eq_of_is_integral_pow hn $ is_integral_iff.mpr ⟨⟨x ^ n, hx⟩, rfl⟩
+
+include id ifr
+
 variables {R} (K)
 lemma integral_closure_eq_bot_iff :
   integral_closure R K = ⊥ ↔ is_integrally_closed R :=
@@ -113,8 +129,10 @@ namespace integral_closure
 
 open is_integrally_closed
 
-variables {R : Type*} [comm_ring R] [is_domain R] [iic : is_integrally_closed R]
-variables (K : Type*) [field K] [algebra R K] [is_fraction_ring R K]
+variables {R : Type*} [comm_ring R]
+variables (K : Type*) [field K] [algebra R K]
+
+variables  [is_domain R] [is_fraction_ring R K]
 variables {L : Type*} [field L] [algebra K L] [algebra R L] [is_scalar_tower R K L]
 
 -- Can't be an instance because you need to supply `K`.
diff --git a/src/ring_theory/is_adjoin_root.lean b/src/ring_theory/is_adjoin_root.lean
new file mode 100644
index 0000000000000..b13d9a322511e
--- /dev/null
+++ b/src/ring_theory/is_adjoin_root.lean
@@ -0,0 +1,681 @@
+/-
+Copyright (c) 2022 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+import data.polynomial.algebra_map
+import field_theory.minpoly.is_integrally_closed
+import ring_theory.power_basis
+
+/-!
+# A predicate on adjoining roots of polynomial
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines a predicate `is_adjoin_root S f`, which states that the ring `S` can be
+constructed by adjoining a specified root of the polynomial `f : R[X]` to `R`.
+This predicate is useful when the same ring can be generated by adjoining the root of different
+polynomials, and you want to vary which polynomial you're considering.
+
+The results in this file are intended to mirror those in `ring_theory.adjoin_root`,
+in order to provide an easier way to translate results from one to the other.
+
+## Motivation
+
+`adjoin_root` presents one construction of a ring `R[α]`. However, it is possible to obtain
+rings of this form in many ways, such as `number_field.ring_of_integers ℚ(√-5)`,
+or `algebra.adjoin R {α, α^2}`, or `intermediate_field.adjoin R {α, 2 - α}`,
+or even if we want to view `ℂ` as adjoining a root of `X^2 + 1` to `ℝ`.
+
+## Main definitions
+
+The two main predicates in this file are:
+
+ * `is_adjoin_root S f`: `S` is generated by adjoining a specified root of `f : R[X]` to `R`
+ * `is_adjoin_root_monic S f`: `S` is generated by adjoining a root of the monic polynomial
+   `f : R[X]` to `R`
+
+Using `is_adjoin_root` to map into `S`:
+
+ * `is_adjoin_root.map`: inclusion from `R[X]` to `S`
+ * `is_adjoin_root.root`: the specific root adjoined to `R` to give `S`
+
+Using `is_adjoin_root` to map out of `S`:
+
+ * `is_adjoin_root.repr`: choose a non-unique representative in `R[X]`
+ * `is_adjoin_root.lift`, `is_adjoin_root.lift_hom`: lift a morphism `R →+* T` to `S →+* T`
+ * `is_adjoin_root_monic.mod_by_monic_hom`: a unique representative in `R[X]` if `f` is monic
+
+## Main results
+
+ * `adjoin_root.is_adjoin_root` and `adjoin_root.is_adjoin_root_monic`:
+   `adjoin_root` satisfies the conditions on `is_adjoin_root`(`_monic`)
+ * `is_adjoin_root_monic.power_basis`: the `root` generates a power basis on `S` over `R`
+ * `is_adjoin_root.aequiv`: algebra isomorphism showing adjoining a root gives a unique ring
+   up to isomorphism
+ * `is_adjoin_root.of_equiv`: transfer `is_adjoin_root` across an algebra isomorphism
+ * `is_adjoin_root_eq.minpoly_eq`: the minimal polynomial of the adjoined root of `f` is equal to
+   `f`, if `f` is irreducible and monic, and `R` is a GCD domain
+-/
+
+open_locale polynomial
+open polynomial
+noncomputable theory
+
+universes u v
+
+section move_me
+
+end move_me
+
+/-- `is_adjoin_root S f` states that the ring `S` can be constructed by adjoining a specified root
+of the polynomial `f : R[X]` to `R`.
+
+Compare `power_basis R S`, which does not explicitly specify which polynomial we adjoin a root of
+(in particular `f` does not need to be the minimal polynomial of the root we adjoin),
+and `adjoin_root` which constructs a new type.
+
+This is not a typeclass because the choice of root given `S` and `f` is not unique.
+-/
+@[nolint has_nonempty_instance] -- This class doesn't really make sense on a predicate
+structure is_adjoin_root {R : Type u} (S : Type v) [comm_semiring R] [semiring S] [algebra R S]
+  (f : R[X]) : Type (max u v) :=
+(map : R[X] →+* S)
+(map_surjective : function.surjective map)
+(ker_map : ring_hom.ker map = ideal.span {f})
+(algebra_map_eq : algebra_map R S = map.comp polynomial.C)
+
+/-- `is_adjoin_root_monic S f` states that the ring `S` can be constructed by adjoining a specified
+root of the monic polynomial `f : R[X]` to `R`.
+
+As long as `f` is monic, there is a well-defined representation of elements of `S` as polynomials
+in `R[X]` of degree lower than `deg f` (see `mod_by_monic_hom` and `coeff`). In particular,
+we have `is_adjoin_root_monic.power_basis`.
+
+Bundling `monic` into this structure is very useful when working with explicit `f`s such as
+`X^2 - C a * X - C b` since it saves you carrying around the proofs of monicity.
+-/
+@[nolint has_nonempty_instance] -- This class doesn't really make sense on a predicate
+structure is_adjoin_root_monic {R : Type u} (S : Type v) [comm_semiring R] [semiring S]
+  [algebra R S] (f : R[X]) extends is_adjoin_root S f :=
+(monic : monic f)
+
+section ring
+
+variables {R : Type u} {S : Type v} [comm_ring R] [ring S] {f : R[X]} [algebra R S]
+
+namespace is_adjoin_root
+
+/-- `(h : is_adjoin_root S f).root` is the root of `f` that can be adjoined to generate `S`. -/
+def root (h : is_adjoin_root S f) : S := h.map X
+
+lemma subsingleton (h : is_adjoin_root S f) [subsingleton R] : subsingleton S :=
+h.map_surjective.subsingleton
+
+lemma algebra_map_apply (h : is_adjoin_root S f) (x : R) :
+  algebra_map R S x = h.map (polynomial.C x) :=
+by rw [h.algebra_map_eq, ring_hom.comp_apply]
+
+@[simp] lemma mem_ker_map (h : is_adjoin_root S f) {p} : p ∈ ring_hom.ker h.map ↔ f ∣ p :=
+by rw [h.ker_map, ideal.mem_span_singleton]
+
+lemma map_eq_zero_iff (h : is_adjoin_root S f) {p} : h.map p = 0 ↔ f ∣ p :=
+by rw [← h.mem_ker_map, ring_hom.mem_ker]
+
+@[simp] lemma map_X (h : is_adjoin_root S f) : h.map X = h.root := rfl
+
+@[simp] lemma map_self (h : is_adjoin_root S f) : h.map f = 0 :=
+h.map_eq_zero_iff.mpr dvd_rfl
+
+@[simp] lemma aeval_eq (h : is_adjoin_root S f) (p : R[X]) : aeval h.root p = h.map p :=
+polynomial.induction_on p (λ x, by { rw [aeval_C, h.algebra_map_apply] })
+  (λ p q ihp ihq, by rw [alg_hom.map_add, ring_hom.map_add, ihp, ihq])
+  (λ n x ih, by { rw [alg_hom.map_mul, aeval_C, alg_hom.map_pow, aeval_X, ring_hom.map_mul,
+    ← h.algebra_map_apply, ring_hom.map_pow, map_X] })
+
+@[simp] lemma aeval_root (h : is_adjoin_root S f) : aeval h.root f = 0 :=
+by rw [aeval_eq, map_self]
+
+/-- Choose an arbitrary representative so that `h.map (h.repr x) = x`.
+
+If `f` is monic, use `is_adjoin_root_monic.mod_by_monic_hom` for a unique choice of representative.
+-/
+def repr (h : is_adjoin_root S f) (x : S) : R[X] :=
+(h.map_surjective x).some
+
+lemma map_repr (h : is_adjoin_root S f) (x : S) : h.map (h.repr x) = x :=
+(h.map_surjective x).some_spec
+
+/-- `repr` preserves zero, up to multiples of `f` -/
+lemma repr_zero_mem_span (h : is_adjoin_root S f) : h.repr 0 ∈ ideal.span ({f} : set R[X]) :=
+by rw [← h.ker_map, ring_hom.mem_ker, h.map_repr]
+
+/-- `repr` preserves addition, up to multiples of `f` -/
+lemma repr_add_sub_repr_add_repr_mem_span (h : is_adjoin_root S f) (x y : S) :
+  h.repr (x + y) - (h.repr x + h.repr y) ∈ ideal.span ({f} : set R[X]) :=
+by rw [← h.ker_map, ring_hom.mem_ker, map_sub, h.map_repr, map_add, h.map_repr, h.map_repr,
+       sub_self]
+
+/-- Extensionality of the `is_adjoin_root` structure itself. See `is_adjoin_root_monic.ext_elem`
+for extensionality of the ring elements. -/
+lemma ext_map (h h' : is_adjoin_root S f) (eq : ∀ x, h.map x = h'.map x) : h = h' :=
+begin
+  cases h, cases h', congr,
+  exact ring_hom.ext eq
+end
+
+/-- Extensionality of the `is_adjoin_root` structure itself. See `is_adjoin_root_monic.ext_elem`
+for extensionality of the ring elements. -/
+@[ext]
+lemma ext (h h' : is_adjoin_root S f) (eq : h.root = h'.root) : h = h' :=
+h.ext_map h' (λ x, by rw [← h.aeval_eq, ← h'.aeval_eq, eq])
+
+section lift
+
+variables {T : Type*} [comm_ring T] {i : R →+* T} {x : T} (hx : f.eval₂ i x = 0)
+
+include hx
+
+/-- Auxiliary lemma for `is_adjoin_root.lift` -/
+lemma eval₂_repr_eq_eval₂_of_map_eq (h : is_adjoin_root S f) (z : S) (w : R[X])
+  (hzw : h.map w = z) :
+  (h.repr z).eval₂ i x = w.eval₂ i x :=
+begin
+  rw [eq_comm, ← sub_eq_zero, ← h.map_repr z, ← map_sub, h.map_eq_zero_iff] at hzw,
+  obtain ⟨y, hy⟩ := hzw,
+  rw [← sub_eq_zero, ← eval₂_sub, hy, eval₂_mul, hx, zero_mul]
+end
+
+variables (i x) -- To match `adjoin_root.lift`
+
+/-- Lift a ring homomorphism `R →+* T` to `S →+* T` by specifying a root `x` of `f` in `T`,
+where `S` is given by adjoining a root of `f` to `R`. -/
+def lift (h : is_adjoin_root S f) : S →+* T :=
+{ to_fun := λ z, (h.repr z).eval₂ i x,
+  map_zero' := by rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ _ (map_zero _), eval₂_zero],
+  map_add' := λ z w, begin
+    rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ (h.repr z + h.repr w), eval₂_add],
+    { rw [map_add, map_repr, map_repr] }
+  end,
+  map_one' := by rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ _ (map_one _), eval₂_one],
+  map_mul' := λ z w, begin
+    rw [h.eval₂_repr_eq_eval₂_of_map_eq hx _ (h.repr z * h.repr w), eval₂_mul],
+    { rw [map_mul, map_repr, map_repr] }
+  end }
+
+variables {i x}
+
+@[simp] lemma lift_map (h : is_adjoin_root S f) (z : R[X]) :
+  h.lift i x hx (h.map z) = z.eval₂ i x :=
+by rw [lift, ring_hom.coe_mk, h.eval₂_repr_eq_eval₂_of_map_eq hx _ _ rfl]
+
+@[simp] lemma lift_root (h : is_adjoin_root S f) :
+  h.lift i x hx h.root = x :=
+by rw [← h.map_X, lift_map, eval₂_X]
+
+@[simp] lemma lift_algebra_map (h : is_adjoin_root S f) (a : R) :
+  h.lift i x hx (algebra_map R S a) = i a :=
+by rw [h.algebra_map_apply, lift_map, eval₂_C]
+
+/-- Auxiliary lemma for `apply_eq_lift` -/
+lemma apply_eq_lift (h : is_adjoin_root S f) (g : S →+* T)
+  (hmap : ∀ a, g (algebra_map R S a) = i a) (hroot : g h.root = x) (a : S):
+  g a = h.lift i x hx a :=
+begin
+  rw [← h.map_repr a, polynomial.as_sum_range_C_mul_X_pow (h.repr a)],
+  simp only [map_sum, map_mul, map_pow, h.map_X, hroot, ← h.algebra_map_apply, hmap, lift_root,
+    lift_algebra_map]
+end
+
+/-- Unicity of `lift`: a map that agrees on `R` and `h.root` agrees with `lift` everywhere. -/
+lemma eq_lift (h : is_adjoin_root S f) (g : S →+* T)
+  (hmap : ∀ a, g (algebra_map R S a) = i a) (hroot : g h.root = x) :
+  g = h.lift i x hx :=
+ring_hom.ext (h.apply_eq_lift hx g hmap hroot)
+
+variables [algebra R T] (hx' : aeval x f = 0)
+
+omit hx
+
+variables (x) -- To match `adjoin_root.lift_hom`
+
+/-- Lift the algebra map `R → T` to `S →ₐ[R] T` by specifying a root `x` of `f` in `T`,
+where `S` is given by adjoining a root of `f` to `R`. -/
+def lift_hom (h : is_adjoin_root S f) : S →ₐ[R] T :=
+{ commutes' := λ a, h.lift_algebra_map hx' a,
+  .. h.lift (algebra_map R T) x hx' }
+
+variables {x}
+
+@[simp] lemma coe_lift_hom (h : is_adjoin_root S f) :
+  (h.lift_hom x hx' : S →+* T) = h.lift (algebra_map R T) x hx' := rfl
+
+lemma lift_algebra_map_apply (h : is_adjoin_root S f) (z : S) :
+  h.lift (algebra_map R T) x hx' z = h.lift_hom x hx' z := rfl
+
+@[simp] lemma lift_hom_map (h : is_adjoin_root S f) (z : R[X]) :
+  h.lift_hom x hx' (h.map z) = aeval x z :=
+by rw [← lift_algebra_map_apply, lift_map, aeval_def]
+
+@[simp] lemma lift_hom_root (h : is_adjoin_root S f) :
+  h.lift_hom x hx' h.root = x :=
+by rw [← lift_algebra_map_apply, lift_root]
+
+/-- Unicity of `lift_hom`: a map that agrees on `h.root` agrees with `lift_hom` everywhere. -/
+lemma eq_lift_hom (h : is_adjoin_root S f) (g : S →ₐ[R] T) (hroot : g h.root = x) :
+  g = h.lift_hom x hx' :=
+alg_hom.ext (h.apply_eq_lift hx' g g.commutes hroot)
+
+end lift
+
+end is_adjoin_root
+
+namespace adjoin_root
+
+variables (f)
+
+/-- `adjoin_root f` is indeed given by adjoining a root of `f`. -/
+protected def is_adjoin_root : is_adjoin_root (adjoin_root f) f :=
+{ map := adjoin_root.mk f,
+  map_surjective := ideal.quotient.mk_surjective,
+  ker_map := begin
+    ext,
+    rw [ring_hom.mem_ker, ← @adjoin_root.mk_self _ _ f, adjoin_root.mk_eq_mk,
+        ideal.mem_span_singleton, ← dvd_add_left (dvd_refl f), sub_add_cancel]
+  end,
+  algebra_map_eq := adjoin_root.algebra_map_eq f }
+
+/-- `adjoin_root f` is indeed given by adjoining a root of `f`. If `f` is monic this is more
+powerful than `adjoin_root.is_adjoin_root`. -/
+protected def is_adjoin_root_monic (hf : monic f) :
+  is_adjoin_root_monic (adjoin_root f) f :=
+{ monic := hf,
+  .. adjoin_root.is_adjoin_root f }
+
+@[simp]
+lemma is_adjoin_root_map_eq_mk :
+  (adjoin_root.is_adjoin_root f).map = adjoin_root.mk f := rfl
+
+@[simp]
+lemma is_adjoin_root_monic_map_eq_mk (hf : f.monic) :
+  (adjoin_root.is_adjoin_root_monic f hf).map = adjoin_root.mk f := rfl
+
+@[simp]
+lemma is_adjoin_root_root_eq_root :
+  (adjoin_root.is_adjoin_root f).root = adjoin_root.root f :=
+by simp only [is_adjoin_root.root, adjoin_root.root, adjoin_root.is_adjoin_root_map_eq_mk]
+
+@[simp]
+lemma is_adjoin_root_monic_root_eq_root (hf : monic f) :
+  (adjoin_root.is_adjoin_root_monic f hf).root = adjoin_root.root f :=
+by simp only [is_adjoin_root.root, adjoin_root.root, adjoin_root.is_adjoin_root_monic_map_eq_mk]
+
+end adjoin_root
+
+namespace is_adjoin_root_monic
+
+open is_adjoin_root
+
+lemma map_mod_by_monic (h : is_adjoin_root_monic S f) (g : R[X]) :
+  h.map (g %ₘ f) = h.map g :=
+begin
+  rw [← ring_hom.sub_mem_ker_iff, mem_ker_map, mod_by_monic_eq_sub_mul_div _ h.monic,
+      sub_right_comm, sub_self, zero_sub, dvd_neg],
+  exact ⟨_, rfl⟩
+end
+
+lemma mod_by_monic_repr_map (h : is_adjoin_root_monic S f) (g : R[X]) :
+  h.repr (h.map g) %ₘ f = g %ₘ f :=
+mod_by_monic_eq_of_dvd_sub h.monic $ by rw [← h.mem_ker_map, ring_hom.sub_mem_ker_iff, map_repr]
+
+/-- `is_adjoin_root.mod_by_monic_hom` sends the equivalence class of `f` mod `g` to `f %ₘ g`. -/
+def mod_by_monic_hom (h : is_adjoin_root_monic S f) : S →ₗ[R] R[X] :=
+{ to_fun := λ x, h.repr x %ₘ f,
+  map_add' := λ x y,
+    by conv_lhs { rw [← h.map_repr x, ← h.map_repr y, ← map_add, h.mod_by_monic_repr_map,
+                      add_mod_by_monic] },
+  map_smul' := λ c x,
+    by rw [ring_hom.id_apply, ← h.map_repr x, algebra.smul_def, h.algebra_map_apply, ← map_mul,
+           h.mod_by_monic_repr_map, ← smul_eq_C_mul, smul_mod_by_monic, h.map_repr] }
+
+@[simp] lemma mod_by_monic_hom_map (h : is_adjoin_root_monic S f) (g : R[X]) :
+  h.mod_by_monic_hom (h.map g) = g %ₘ f :=
+h.mod_by_monic_repr_map g
+
+@[simp] lemma map_mod_by_monic_hom (h : is_adjoin_root_monic S f) (x : S) :
+  h.map (h.mod_by_monic_hom x) = x :=
+by rw [mod_by_monic_hom, linear_map.coe_mk, map_mod_by_monic, map_repr]
+
+@[simp] lemma mod_by_monic_hom_root_pow (h : is_adjoin_root_monic S f) {n : ℕ}
+  (hdeg : n < nat_degree f) :
+  h.mod_by_monic_hom (h.root ^ n) = X ^ n :=
+begin
+  nontriviality R,
+  rwa [← h.map_X, ← map_pow, mod_by_monic_hom_map, mod_by_monic_eq_self_iff h.monic, degree_X_pow],
+  contrapose! hdeg,
+  simpa [nat_degree_le_iff_degree_le] using hdeg
+end
+
+@[simp] lemma mod_by_monic_hom_root (h : is_adjoin_root_monic S f) (hdeg : 1 < nat_degree f) :
+  h.mod_by_monic_hom h.root = X :=
+by simpa using mod_by_monic_hom_root_pow h hdeg
+
+/-- The basis on `S` generated by powers of `h.root`.
+
+Auxiliary definition for `is_adjoin_root_monic.power_basis`. -/
+def basis (h : is_adjoin_root_monic S f) : basis (fin (nat_degree f)) R S :=
+basis.of_repr
+{ to_fun := λ x, (h.mod_by_monic_hom x).to_finsupp.comap_domain coe (fin.coe_injective.inj_on _),
+  inv_fun := λ g, h.map (of_finsupp (g.map_domain coe)),
+  left_inv := λ x, begin
+    casesI subsingleton_or_nontrivial R,
+    { haveI := h.subsingleton,
+      exact subsingleton.elim _ _ },
+    simp only,
+    rw [finsupp.map_domain_comap_domain, polynomial.eta, h.map_mod_by_monic_hom x],
+    intros i hi,
+    refine set.mem_range.mpr ⟨⟨i, _⟩, rfl⟩,
+    contrapose! hi,
+    simp only [polynomial.to_finsupp_apply, not_not, finsupp.mem_support_iff, ne.def,
+        mod_by_monic_hom, linear_map.coe_mk, finset.mem_coe],
+    by_cases hx : h.to_is_adjoin_root.repr x %ₘ f = 0,
+    { simp [hx] },
+    refine coeff_eq_zero_of_nat_degree_lt (lt_of_lt_of_le _ hi),
+    rw nat_degree_lt_nat_degree_iff hx,
+    { exact degree_mod_by_monic_lt _ h.monic },
+  end,
+  right_inv := λ g, begin
+    nontriviality R,
+    ext i,
+    simp only [h.mod_by_monic_hom_map, finsupp.comap_domain_apply, polynomial.to_finsupp_apply],
+    rw [(polynomial.mod_by_monic_eq_self_iff h.monic).mpr, polynomial.coeff,
+        finsupp.map_domain_apply fin.coe_injective],
+    rw [degree_eq_nat_degree h.monic.ne_zero, degree_lt_iff_coeff_zero],
+    intros m hm,
+    rw [polynomial.coeff, finsupp.map_domain_notin_range],
+    rw [set.mem_range, not_exists],
+    rintro i rfl,
+    exact i.prop.not_le hm
+  end,
+  map_add' := λ x y,
+    by simp only [map_add, finsupp.comap_domain_add_of_injective fin.coe_injective, to_finsupp_add],
+  map_smul' := λ c x,
+    by simp only [map_smul, finsupp.comap_domain_smul_of_injective fin.coe_injective,
+        ring_hom.id_apply, to_finsupp_smul] }
+
+@[simp] lemma basis_apply (h : is_adjoin_root_monic S f) (i) : h.basis i = h.root ^ (i : ℕ) :=
+basis.apply_eq_iff.mpr $
+show (h.mod_by_monic_hom (h.to_is_adjoin_root.root ^ (i : ℕ))).to_finsupp
+  .comap_domain coe (fin.coe_injective.inj_on _) = finsupp.single _ _,
+begin
+  ext j,
+  rw [finsupp.comap_domain_apply, mod_by_monic_hom_root_pow],
+  { rw [X_pow_eq_monomial, to_finsupp_monomial, finsupp.single_apply_left fin.coe_injective] },
+  { exact i.is_lt },
+end
+
+lemma deg_pos [nontrivial S] (h : is_adjoin_root_monic S f) : 0 < nat_degree f :=
+begin
+  rcases h.basis.index_nonempty with ⟨⟨i, hi⟩⟩,
+  exact (nat.zero_le _).trans_lt hi
+end
+
+lemma deg_ne_zero [nontrivial S] (h : is_adjoin_root_monic S f) : nat_degree f ≠ 0 :=
+h.deg_pos.ne'
+
+/-- If `f` is monic, the powers of `h.root` form a basis. -/
+@[simps gen dim basis]
+def power_basis (h : is_adjoin_root_monic S f) : power_basis R S :=
+{ gen := h.root,
+  dim := nat_degree f,
+  basis := h.basis,
+  basis_eq_pow := h.basis_apply }
+
+@[simp] lemma basis_repr (h : is_adjoin_root_monic S f) (x : S) (i : fin (nat_degree f)) :
+  h.basis.repr x i = (h.mod_by_monic_hom x).coeff (i : ℕ) :=
+begin
+  change (h.mod_by_monic_hom x).to_finsupp.comap_domain coe (fin.coe_injective.inj_on _) i = _,
+  rw [finsupp.comap_domain_apply, polynomial.to_finsupp_apply]
+end
+
+lemma basis_one (h : is_adjoin_root_monic S f) (hdeg : 1 < nat_degree f) :
+  h.basis ⟨1, hdeg⟩ = h.root :=
+by rw [h.basis_apply, fin.coe_mk, pow_one]
+
+/-- `is_adjoin_root_monic.lift_polyₗ` lifts a linear map on polynomials to a linear map on `S`. -/
+@[simps]
+def lift_polyₗ {T : Type*} [add_comm_group T] [module R T] (h : is_adjoin_root_monic S f)
+  (g : R[X] →ₗ[R] T) : S →ₗ[R] T :=
+g.comp h.mod_by_monic_hom
+
+/-- `is_adjoin_root_monic.coeff h x i` is the `i`th coefficient of the representative of `x : S`.
+-/
+def coeff (h : is_adjoin_root_monic S f) : S →ₗ[R] (ℕ → R) :=
+h.lift_polyₗ
+{ to_fun := polynomial.coeff,
+  map_add' := λ p q, funext (polynomial.coeff_add p q),
+  map_smul' := λ c p, funext (polynomial.coeff_smul c p) }
+
+lemma coeff_apply_lt (h : is_adjoin_root_monic S f) (z : S) (i : ℕ) (hi : i < nat_degree f) :
+  h.coeff z i = h.basis.repr z ⟨i, hi⟩ :=
+begin
+  simp only [coeff, linear_map.comp_apply, finsupp.lcoe_fun_apply, finsupp.lmap_domain_apply,
+             linear_equiv.coe_coe, lift_polyₗ_apply, linear_map.coe_mk, h.basis_repr],
+  refl
+end
+
+lemma coeff_apply_coe (h : is_adjoin_root_monic S f) (z : S) (i : fin (nat_degree f)) :
+  h.coeff z i = h.basis.repr z i :=
+h.coeff_apply_lt z i i.prop
+
+lemma coeff_apply_le (h : is_adjoin_root_monic S f) (z : S) (i : ℕ) (hi : nat_degree f ≤ i) :
+  h.coeff z i = 0 :=
+begin
+  simp only [coeff, linear_map.comp_apply, finsupp.lcoe_fun_apply, finsupp.lmap_domain_apply,
+             linear_equiv.coe_coe, lift_polyₗ_apply, linear_map.coe_mk, h.basis_repr],
+  nontriviality R,
+  exact polynomial.coeff_eq_zero_of_degree_lt ((degree_mod_by_monic_lt _ h.monic).trans_le
+    (polynomial.degree_le_of_nat_degree_le hi)),
+end
+
+lemma coeff_apply (h : is_adjoin_root_monic S f) (z : S) (i : ℕ) :
+  h.coeff z i = if hi : i < nat_degree f then h.basis.repr z ⟨i, hi⟩ else 0 :=
+begin
+  split_ifs with hi,
+  { exact h.coeff_apply_lt z i hi },
+  { exact h.coeff_apply_le z i (le_of_not_lt hi) },
+end
+
+lemma coeff_root_pow (h : is_adjoin_root_monic S f) {n} (hn : n < nat_degree f) :
+  h.coeff (h.root ^ n) = pi.single n 1 :=
+begin
+  ext i,
+  rw coeff_apply,
+  split_ifs with hi,
+  { calc h.basis.repr (h.root ^ n) ⟨i, _⟩
+        = h.basis.repr (h.basis ⟨n, hn⟩) ⟨i, hi⟩
+      : by rw [h.basis_apply, fin.coe_mk]
+    ... = pi.single ((⟨n, hn⟩ : fin _) : ℕ) (1 : (λ _, R) _) ↑(⟨i, _⟩ : fin _) :
+      by rw [h.basis.repr_self, ← finsupp.single_eq_pi_single,
+             finsupp.single_apply_left fin.coe_injective]
+    ... = pi.single n 1 i : by rw [fin.coe_mk, fin.coe_mk] },
+  { refine (pi.single_eq_of_ne _ (1 : (λ _, R) _)).symm,
+    rintro rfl,
+    simpa [hi] using hn },
+end
+
+lemma coeff_one [nontrivial S] (h : is_adjoin_root_monic S f) :
+  h.coeff 1 = pi.single 0 1 :=
+by rw [← h.coeff_root_pow h.deg_pos, pow_zero]
+
+lemma coeff_root (h : is_adjoin_root_monic S f) (hdeg : 1 < (nat_degree f)) :
+  h.coeff h.root = pi.single 1 1 :=
+by rw [← h.coeff_root_pow hdeg, pow_one]
+
+lemma coeff_algebra_map [nontrivial S] (h : is_adjoin_root_monic S f) (x : R) :
+  h.coeff (algebra_map R S x) = pi.single 0 x :=
+begin
+  ext i,
+  rw [algebra.algebra_map_eq_smul_one, map_smul, coeff_one, pi.smul_apply, smul_eq_mul],
+  refine (pi.apply_single (λ _ y, x * y) _ 0 1 i).trans (by simp),
+  intros,
+  simp
+end
+
+lemma ext_elem (h : is_adjoin_root_monic S f) ⦃x y : S⦄
+  (hxy : ∀ i < (nat_degree f), h.coeff x i = h.coeff y i) : x = y :=
+equiv_like.injective h.basis.equiv_fun $ funext $ λ i,
+show h.basis.equiv_fun x i = h.basis.equiv_fun y i,
+by rw [basis.equiv_fun_apply, ← h.coeff_apply_coe, basis.equiv_fun_apply, ← h.coeff_apply_coe,
+       hxy i i.prop]
+
+lemma ext_elem_iff (h : is_adjoin_root_monic S f) {x y : S} :
+  x = y ↔ ∀ i < (nat_degree f), h.coeff x i = h.coeff y i :=
+⟨λ hxy i hi, hxy ▸ rfl, λ hxy, h.ext_elem hxy⟩
+
+lemma coeff_injective (h : is_adjoin_root_monic S f) : function.injective h.coeff :=
+λ x y hxy, h.ext_elem (λ i hi, hxy ▸ rfl)
+
+lemma is_integral_root (h : is_adjoin_root_monic S f) : is_integral R h.root :=
+⟨f, h.monic, h.aeval_root⟩
+
+end is_adjoin_root_monic
+
+end ring
+
+section comm_ring
+
+variables {R : Type u} {S : Type v} [comm_ring R] [comm_ring S] [algebra R S] {f : R[X]}
+
+namespace is_adjoin_root
+
+section lift
+
+@[simp] lemma lift_self_apply (h : is_adjoin_root S f) (x : S) :
+  h.lift (algebra_map R S) h.root h.aeval_root x = x :=
+by rw [← h.map_repr x, lift_map, ← aeval_def, h.aeval_eq]
+
+lemma lift_self (h : is_adjoin_root S f) :
+  h.lift (algebra_map R S) h.root h.aeval_root = ring_hom.id S :=
+ring_hom.ext (h.lift_self_apply)
+
+end lift
+
+section equiv
+
+variables {T : Type*} [comm_ring T] [algebra R T]
+
+/-- Adjoining a root gives a unique ring up to algebra isomorphism.
+
+This is the converse of `is_adjoin_root.of_equiv`: this turns an `is_adjoin_root` into an
+`alg_equiv`, and `is_adjoin_root.of_equiv` turns an `alg_equiv` into an `is_adjoin_root`.
+-/
+def aequiv (h : is_adjoin_root S f) (h' : is_adjoin_root T f) : S ≃ₐ[R] T :=
+{ to_fun := h.lift_hom h'.root h'.aeval_root,
+  inv_fun := h'.lift_hom h.root h.aeval_root,
+  left_inv := λ x, by rw [← h.map_repr x, lift_hom_map, aeval_eq, lift_hom_map, aeval_eq],
+  right_inv := λ x, by rw [← h'.map_repr x, lift_hom_map, aeval_eq, lift_hom_map, aeval_eq],
+  .. h.lift_hom h'.root h'.aeval_root }
+
+@[simp] lemma aequiv_map (h : is_adjoin_root S f) (h' : is_adjoin_root T f) (z : R[X]) :
+  h.aequiv h' (h.map z) = h'.map z :=
+by rw [aequiv, alg_equiv.coe_mk, lift_hom_map, aeval_eq]
+
+@[simp] lemma aequiv_root (h : is_adjoin_root S f) (h' : is_adjoin_root T f) :
+  h.aequiv h' h.root = h'.root :=
+by rw [aequiv, alg_equiv.coe_mk, lift_hom_root]
+
+@[simp] lemma aequiv_self (h : is_adjoin_root S f) : h.aequiv h = alg_equiv.refl :=
+by { ext a, exact h.lift_self_apply a }
+
+@[simp] lemma aequiv_symm (h : is_adjoin_root S f) (h' : is_adjoin_root T f) :
+  (h.aequiv h').symm = h'.aequiv h :=
+by { ext, refl }
+
+@[simp] lemma lift_aequiv {U : Type*} [comm_ring U]
+  (h : is_adjoin_root S f) (h' : is_adjoin_root T f) (i : R →+* U) (x hx z) :
+  (h'.lift i x hx (h.aequiv h' z)) = h.lift i x hx z :=
+by rw [← h.map_repr z, aequiv_map, lift_map, lift_map]
+
+@[simp] lemma lift_hom_aequiv {U : Type*} [comm_ring U] [algebra R U]
+  (h : is_adjoin_root S f) (h' : is_adjoin_root T f) (x : U) (hx z) :
+  (h'.lift_hom x hx (h.aequiv h' z)) = h.lift_hom x hx z :=
+h.lift_aequiv h' _ _ hx _
+
+@[simp] lemma aequiv_aequiv {U : Type*} [comm_ring U] [algebra R U]
+  (h : is_adjoin_root S f) (h' : is_adjoin_root T f) (h'' : is_adjoin_root U f) (x) :
+  (h'.aequiv h'') (h.aequiv h' x) = h.aequiv h'' x :=
+h.lift_hom_aequiv _ _ h''.aeval_root _
+
+@[simp] lemma aequiv_trans {U : Type*} [comm_ring U] [algebra R U]
+  (h : is_adjoin_root S f) (h' : is_adjoin_root T f) (h'' : is_adjoin_root U f) :
+  (h.aequiv h').trans (h'.aequiv h'') = h.aequiv h'' :=
+by { ext z, exact h.aequiv_aequiv h' h'' z }
+
+/-- Transfer `is_adjoin_root` across an algebra isomorphism.
+
+This is the converse of `is_adjoin_root.aequiv`: this turns an `alg_equiv` into an `is_adjoin_root`,
+and `is_adjoin_root.aequiv` turns an `is_adjoin_root` into an `alg_equiv`.
+-/
+@[simps map_apply]
+def of_equiv (h : is_adjoin_root S f) (e : S ≃ₐ[R] T) : is_adjoin_root T f :=
+{ map := ((e : S ≃+* T) : S →+* T).comp h.map,
+  map_surjective := e.surjective.comp h.map_surjective,
+  ker_map := by rw [← ring_hom.comap_ker, ring_hom.ker_coe_equiv, ← ring_hom.ker_eq_comap_bot,
+                    h.ker_map],
+  algebra_map_eq := by ext;
+    simp only [alg_equiv.commutes, ring_hom.comp_apply, alg_equiv.coe_ring_equiv,
+               ring_equiv.coe_to_ring_hom, ← h.algebra_map_apply] }
+
+@[simp] lemma of_equiv_root (h : is_adjoin_root S f) (e : S ≃ₐ[R] T) :
+  (h.of_equiv e).root = e h.root := rfl
+
+@[simp] lemma aequiv_of_equiv {U : Type*} [comm_ring U] [algebra R U]
+  (h : is_adjoin_root S f) (h' : is_adjoin_root T f) (e : T ≃ₐ[R] U) :
+  h.aequiv (h'.of_equiv e) = (h.aequiv h').trans e :=
+by ext a; rw [← h.map_repr a, aequiv_map, alg_equiv.trans_apply, aequiv_map, of_equiv_map_apply]
+
+@[simp] lemma of_equiv_aequiv {U : Type*} [comm_ring U] [algebra R U]
+  (h : is_adjoin_root S f) (h' : is_adjoin_root U f) (e : S ≃ₐ[R] T) :
+  (h.of_equiv e).aequiv h' = e.symm.trans (h.aequiv h') :=
+by ext a; rw [← (h.of_equiv e).map_repr a, aequiv_map, alg_equiv.trans_apply, of_equiv_map_apply,
+              e.symm_apply_apply, aequiv_map]
+
+end equiv
+
+end is_adjoin_root
+
+namespace is_adjoin_root_monic
+
+lemma minpoly_eq [is_domain R] [is_domain S] [no_zero_smul_divisors R S] [is_integrally_closed R]
+  (h : is_adjoin_root_monic S f) (hirr : irreducible f) :
+  minpoly R h.root = f :=
+let ⟨q, hq⟩ := minpoly.is_integrally_closed_dvd h.is_integral_root h.aeval_root in
+symm $ eq_of_monic_of_associated h.monic (minpoly.monic h.is_integral_root) $
+by convert (associated.mul_left (minpoly R h.root) $
+    associated_one_iff_is_unit.2 $ (hirr.is_unit_or_is_unit hq).resolve_left $
+    minpoly.not_is_unit R h.root);
+  rw mul_one
+
+end is_adjoin_root_monic
+
+section algebra
+
+open adjoin_root is_adjoin_root minpoly power_basis is_adjoin_root_monic algebra
+
+lemma algebra.adjoin.power_basis'_minpoly_gen [is_domain R] [is_domain S]
+  [no_zero_smul_divisors R S] [is_integrally_closed R] {x : S} (hx' : is_integral R x) :
+  minpoly R x = minpoly R (algebra.adjoin.power_basis' hx').gen :=
+begin
+  haveI := is_domain_of_prime (prime_of_is_integrally_closed hx'),
+  haveI := no_zero_smul_divisors_of_prime_of_degree_ne_zero
+    (prime_of_is_integrally_closed hx') (ne_of_lt (degree_pos hx')).symm,
+  rw [← minpoly_gen_eq, adjoin.power_basis', minpoly_gen_map, minpoly_gen_eq, power_basis'_gen,
+    ← is_adjoin_root_monic_root_eq_root _ (monic hx'), minpoly_eq],
+  exact irreducible hx',
+end
+
+end algebra
+
+end comm_ring
diff --git a/src/ring_theory/is_tensor_product.lean b/src/ring_theory/is_tensor_product.lean
new file mode 100644
index 0000000000000..23e7bdcfeb9b8
--- /dev/null
+++ b/src/ring_theory/is_tensor_product.lean
@@ -0,0 +1,464 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+
+import ring_theory.tensor_product
+import algebra.module.ulift
+
+/-!
+# The characteristice predicate of tensor product
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+- `is_tensor_product`: A predicate on `f : M₁ →ₗ[R] M₂ →ₗ[R] M` expressing that `f` realizes `M` as
+  the tensor product of `M₁ ⊗[R] M₂`. This is defined by requiring the lift `M₁ ⊗[R] M₂ → M` to be
+  bijective.
+- `is_base_change`: A predicate on an `R`-algebra `S` and a map `f : M →ₗ[R] N` with `N` being a
+  `S`-module, expressing that `f` realizes `N` as the base change of `M` along `R → S`.
+- `algebra.is_pushout`: A predicate on the following diagram of scalar towers
+  ```
+    R  →  S
+    ↓     ↓
+    R' →  S'
+  ```
+    asserting that is a pushout diagram (i.e. `S' = S ⊗[R] R'`)
+
+## Main results
+- `tensor_product.is_base_change`: `S ⊗[R] M` is the base change of `M` along `R → S`.
+
+-/
+
+universes u v₁ v₂ v₃ v₄
+
+open_locale tensor_product
+
+open tensor_product
+
+section is_tensor_product
+
+variables {R : Type*} [comm_ring R]
+variables {M₁ M₂ M M' : Type*}
+variables [add_comm_monoid M₁] [add_comm_monoid M₂] [add_comm_monoid M] [add_comm_monoid M']
+variables [module R M₁] [module R M₂] [module R M] [module R M']
+variable (f : M₁ →ₗ[R] M₂ →ₗ[R] M)
+variables {N₁ N₂ N : Type*} [add_comm_monoid N₁] [add_comm_monoid N₂] [add_comm_monoid N]
+variables [module R N₁] [module R N₂] [module R N]
+variable {g : N₁ →ₗ[R] N₂ →ₗ[R] N}
+
+/--
+Given a bilinear map `f : M₁ →ₗ[R] M₂ →ₗ[R] M`, `is_tensor_product f` means that
+`M` is the tensor product of `M₁` and `M₂` via `f`.
+This is defined by requiring the lift `M₁ ⊗[R] M₂ → M` to be bijective.
+-/
+def is_tensor_product : Prop := function.bijective (tensor_product.lift f)
+
+variables (R M N) {f}
+
+lemma tensor_product.is_tensor_product : is_tensor_product (tensor_product.mk R M N) :=
+begin
+  delta is_tensor_product,
+  convert_to function.bijective linear_map.id using 2,
+  { apply tensor_product.ext', simp },
+  { exact function.bijective_id }
+end
+
+variables {R M N}
+
+/-- If `M` is the tensor product of `M₁` and `M₂`, it is linearly equivalent to `M₁ ⊗[R] M₂`. -/
+@[simps apply] noncomputable
+def is_tensor_product.equiv (h : is_tensor_product f) : M₁ ⊗[R] M₂ ≃ₗ[R] M :=
+linear_equiv.of_bijective _ h
+
+@[simp] lemma is_tensor_product.equiv_to_linear_map (h : is_tensor_product f) :
+  h.equiv.to_linear_map = tensor_product.lift f := rfl
+
+@[simp] lemma is_tensor_product.equiv_symm_apply (h : is_tensor_product f) (x₁ : M₁) (x₂ : M₂) :
+  h.equiv.symm (f x₁ x₂) = x₁ ⊗ₜ x₂ :=
+begin
+  apply h.equiv.injective,
+  refine (h.equiv.apply_symm_apply _).trans _,
+  simp
+end
+
+/-- If `M` is the tensor product of `M₁` and `M₂`, we may lift a bilinear map `M₁ →ₗ[R] M₂ →ₗ[R] M'`
+to a `M →ₗ[R] M'`. -/
+noncomputable
+def is_tensor_product.lift (h : is_tensor_product f) (f' : M₁ →ₗ[R] M₂ →ₗ[R] M') : M →ₗ[R] M' :=
+(tensor_product.lift f').comp h.equiv.symm.to_linear_map
+
+lemma is_tensor_product.lift_eq (h : is_tensor_product f) (f' : M₁ →ₗ[R] M₂ →ₗ[R] M')
+  (x₁ : M₁) (x₂ : M₂) : h.lift f' (f x₁ x₂) = f' x₁ x₂ :=
+begin
+  delta is_tensor_product.lift,
+  simp,
+end
+
+/-- The tensor product of a pair of linear maps between modules. -/
+noncomputable
+def is_tensor_product.map (hf : is_tensor_product f) (hg : is_tensor_product g)
+  (i₁ : M₁ →ₗ[R] N₁) (i₂ : M₂ →ₗ[R] N₂) : M →ₗ[R] N :=
+hg.equiv.to_linear_map.comp ((tensor_product.map i₁ i₂).comp hf.equiv.symm.to_linear_map)
+
+lemma is_tensor_product.map_eq (hf : is_tensor_product f) (hg : is_tensor_product g)
+  (i₁ : M₁ →ₗ[R] N₁) (i₂ : M₂ →ₗ[R] N₂) (x₁ : M₁) (x₂ : M₂) :
+    hf.map hg i₁ i₂ (f x₁ x₂) = g (i₁ x₁) (i₂ x₂) :=
+begin
+  delta is_tensor_product.map,
+  simp
+end
+
+lemma is_tensor_product.induction_on (h : is_tensor_product f) {C : M → Prop}
+  (m : M) (h0 : C 0) (htmul : ∀ x y, C (f x y)) (hadd : ∀ x y, C x → C y → C (x + y)) : C m :=
+begin
+  rw ← h.equiv.right_inv m,
+  generalize : h.equiv.inv_fun m = y,
+  change C (tensor_product.lift f y),
+  induction y using tensor_product.induction_on,
+  { rwa map_zero },
+  { rw tensor_product.lift.tmul, apply htmul },
+  { rw map_add, apply hadd; assumption }
+end
+
+end is_tensor_product
+
+section is_base_change
+
+variables {R : Type*} {M : Type v₁} {N : Type v₂} (S : Type v₃)
+variables [add_comm_monoid M] [add_comm_monoid N] [comm_ring R]
+variables [comm_ring S] [algebra R S] [module R M] [module R N] [module S N] [is_scalar_tower R S N]
+variables (f : M →ₗ[R] N)
+
+include f
+
+/-- Given an `R`-algebra `S` and an `R`-module `M`, an `S`-module `N` together with a map
+`f : M →ₗ[R] N` is the base change of `M` to `S` if the map `S × M → N, (s, m) ↦ s • f m` is the
+tensor product. -/
+def is_base_change : Prop := is_tensor_product
+(((algebra.of_id S $ module.End S (M →ₗ[R] N)).to_linear_map.flip f).restrict_scalars R)
+
+variables {S f} (h : is_base_change S f)
+variables {P Q : Type*} [add_comm_monoid P] [module R P]
+variables [add_comm_monoid Q] [module S Q]
+
+section
+
+variables [module R Q] [is_scalar_tower R S Q]
+
+/-- Suppose `f : M →ₗ[R] N` is the base change of `M` along `R → S`. Then any `R`-linear map from
+`M` to an `S`-module factors thorugh `f`. -/
+noncomputable
+def is_base_change.lift (g : M →ₗ[R] Q) : N →ₗ[S] Q :=
+{ map_smul' := λ r x, begin
+    let F := ((algebra.of_id S $ module.End S (M →ₗ[R] Q))
+      .to_linear_map.flip g).restrict_scalars R,
+    have hF : ∀ (s : S) (m : M), h.lift F (s • f m) = s • g m := h.lift_eq F,
+    change h.lift F (r • x) = r • h.lift F x,
+    apply h.induction_on x,
+    { rw [smul_zero, map_zero, smul_zero] },
+    { intros s m,
+      change h.lift F (r • s • f m) = r • h.lift F (s • f m),
+      rw [← mul_smul, hF, hF, mul_smul] },
+    { intros x₁ x₂ e₁ e₂, rw [map_add, smul_add, map_add, smul_add, e₁, e₂] }
+  end,
+  ..(h.lift (((algebra.of_id S $ module.End S (M →ₗ[R] Q))
+    .to_linear_map.flip g).restrict_scalars R)) }
+
+lemma is_base_change.lift_eq (g : M →ₗ[R] Q) (x : M) : h.lift g (f x) = g x :=
+begin
+  have hF : ∀ (s : S) (m : M), h.lift g (s • f m) = s • g m := h.lift_eq _,
+  convert hF 1 x; rw one_smul,
+end
+
+lemma is_base_change.lift_comp (g : M →ₗ[R] Q) : ((h.lift g).restrict_scalars R).comp f = g :=
+linear_map.ext (h.lift_eq g)
+
+end
+include h
+
+@[elab_as_eliminator]
+lemma is_base_change.induction_on (x : N) (P : N → Prop)
+  (h₁ : P 0)
+  (h₂ : ∀ m : M, P (f m))
+  (h₃ : ∀ (s : S) n, P n → P (s • n))
+  (h₄ : ∀ n₁ n₂, P n₁ → P n₂ → P (n₁ + n₂)) : P x :=
+h.induction_on x h₁ (λ s y, h₃ _ _ (h₂ _)) h₄
+
+lemma is_base_change.alg_hom_ext (g₁ g₂ : N →ₗ[S] Q) (e : ∀ x, g₁ (f x) = g₂ (f x)) :
+  g₁ = g₂ :=
+begin
+  ext x,
+  apply h.induction_on x,
+  { rw [map_zero, map_zero] },
+  { assumption },
+  { intros s n e', rw [g₁.map_smul, g₂.map_smul, e'] },
+  { intros x y e₁ e₂, rw [map_add, map_add, e₁, e₂] }
+end
+
+lemma is_base_change.alg_hom_ext' [module R Q] [is_scalar_tower R S Q] (g₁ g₂ : N →ₗ[S] Q)
+  (e : (g₁.restrict_scalars R).comp f = (g₂.restrict_scalars R).comp f) :
+  g₁ = g₂ :=
+h.alg_hom_ext g₁ g₂ (linear_map.congr_fun e)
+
+variables (R M N S)
+
+omit h f
+
+lemma tensor_product.is_base_change : is_base_change S (tensor_product.mk R S M 1) :=
+begin
+  delta is_base_change,
+  convert tensor_product.is_tensor_product R S M using 1,
+  ext s x,
+  change s • 1 ⊗ₜ x = s ⊗ₜ x,
+  rw tensor_product.smul_tmul',
+  congr' 1,
+  exact mul_one _,
+end
+
+variables {R M N S}
+
+/-- The base change of `M` along `R → S` is linearly equivalent to `S ⊗[R] M`. -/
+noncomputable
+def is_base_change.equiv : S ⊗[R] M ≃ₗ[S] N :=
+{ map_smul' := λ r x, begin
+    change h.equiv (r • x) = r • h.equiv x,
+    apply tensor_product.induction_on x,
+    { rw [smul_zero, map_zero, smul_zero] },
+    { intros x y, simp [smul_tmul', algebra.of_id_apply] },
+    { intros x y hx hy, rw [map_add, smul_add, map_add, smul_add, hx, hy] },
+  end,
+  ..h.equiv }
+
+lemma is_base_change.equiv_tmul (s : S) (m : M) : h.equiv (s ⊗ₜ m) = s • (f m) :=
+tensor_product.lift.tmul s m
+
+lemma is_base_change.equiv_symm_apply (m : M) : h.equiv.symm (f m) = 1 ⊗ₜ m :=
+by rw [h.equiv.symm_apply_eq, h.equiv_tmul, one_smul]
+
+
+variable (f)
+
+lemma is_base_change.of_lift_unique
+  (h : ∀ (Q : Type (max v₁ v₂ v₃)) [add_comm_monoid Q], by exactI ∀ [module R Q] [module S Q],
+    by exactI ∀ [is_scalar_tower R S Q], by exactI ∀ (g : M →ₗ[R] Q),
+      ∃! (g' : N →ₗ[S] Q), (g'.restrict_scalars R).comp f = g) : is_base_change S f :=
+begin
+  obtain ⟨g, hg, -⟩ := h (ulift.{v₂} $ S ⊗[R] M)
+    (ulift.module_equiv.symm.to_linear_map.comp $ tensor_product.mk R S M 1),
+  let f' : S ⊗[R] M →ₗ[R] N := _, change function.bijective f',
+  let f'' : S ⊗[R] M →ₗ[S] N,
+  { refine { to_fun := f', map_smul' := λ s x, 
+      tensor_product.induction_on x _ (λ s' y, smul_assoc s s' _) (λ x y hx hy, _), .. f' },
+    { rw [map_zero, smul_zero, map_zero, smul_zero] },
+    { rw [smul_add, map_add, map_add, smul_add, hx, hy] } },
+  simp_rw [fun_like.ext_iff, linear_map.comp_apply, linear_map.restrict_scalars_apply] at hg,
+  let fe : S ⊗[R] M ≃ₗ[S] N :=
+    linear_equiv.of_linear f'' (ulift.module_equiv.to_linear_map.comp g) _ _,
+  { exact fe.bijective },
+  { rw ← (linear_map.cancel_left (ulift.module_equiv : ulift.{max v₁ v₃} N ≃ₗ[S] N).symm.injective),
+    refine (h (ulift.{max v₁ v₃} N) $ ulift.module_equiv.symm.to_linear_map.comp f).unique _ rfl,
+    { apply_instance },
+    ext x,
+    simp only [linear_map.comp_apply, linear_map.restrict_scalars_apply, hg],
+    apply one_smul },
+  { ext x, change (g $ (1 : S) • f x).down = _, rw [one_smul, hg], refl },
+end
+
+variable {f}
+
+lemma is_base_change.iff_lift_unique :
+  is_base_change S f ↔
+    ∀ (Q : Type (max v₁ v₂ v₃)) [add_comm_monoid Q], by exactI ∀ [module R Q] [module S Q],
+    by exactI ∀ [is_scalar_tower R S Q], by exactI ∀ (g : M →ₗ[R] Q),
+      ∃! (g' : N →ₗ[S] Q), (g'.restrict_scalars R).comp f = g :=
+⟨λ h, by { introsI,
+  exact ⟨h.lift g, h.lift_comp g, λ g' e, h.alg_hom_ext' _ _ (e.trans (h.lift_comp g).symm)⟩ },
+  is_base_change.of_lift_unique f⟩
+
+lemma is_base_change.of_equiv (e : M ≃ₗ[R] N) : is_base_change R e.to_linear_map :=
+begin
+  apply is_base_change.of_lift_unique,
+  introsI Q I₁ I₂ I₃ I₄ g,
+  have : I₂ = I₃,
+  { ext r q,
+    rw [← one_smul R q, smul_smul, ← smul_assoc, smul_eq_mul, mul_one] },
+  unfreezingI { cases this },
+  refine ⟨g.comp e.symm.to_linear_map, by { ext, simp }, _⟩,
+  rintros y (rfl : _ = _),
+  ext,
+  simp,
+end
+
+variables {T O : Type*} [comm_ring T] [algebra R T] [algebra S T] [is_scalar_tower R S T]
+variables [add_comm_monoid O] [module R O] [module S O] [module T O] [is_scalar_tower S T O]
+variables [is_scalar_tower R S O] [is_scalar_tower R T O]
+
+lemma is_base_change.comp {f : M →ₗ[R] N} (hf : is_base_change S f) {g : N →ₗ[S] O}
+  (hg : is_base_change T g) : is_base_change T ((g.restrict_scalars R).comp f) :=
+begin
+  apply is_base_change.of_lift_unique,
+  introsI Q _ _ _ _ i,
+  letI := module.comp_hom Q (algebra_map S T),
+  haveI : is_scalar_tower S T Q := ⟨λ x y z, by { rw [algebra.smul_def, mul_smul], refl }⟩,
+  haveI : is_scalar_tower R S Q,
+  { refine ⟨λ x y z, _⟩,
+    change (is_scalar_tower.to_alg_hom R S T) (x • y) • z = x • (algebra_map S T y • z),
+    rw [alg_hom.map_smul, smul_assoc],
+    refl },
+  refine ⟨hg.lift (hf.lift i), by { ext, simp [is_base_change.lift_eq] }, _⟩,
+  rintros g' (e : _ = _),
+  refine hg.alg_hom_ext' _ _ (hf.alg_hom_ext' _ _ _),
+  rw [is_base_change.lift_comp, is_base_change.lift_comp, ← e],
+  ext,
+  refl
+end
+
+variables {R' S' : Type*} [comm_ring R'] [comm_ring S']
+variables [algebra R R'] [algebra S S'] [algebra R' S'] [algebra R S']
+variables [is_scalar_tower R R' S'] [is_scalar_tower R S S']
+
+open is_scalar_tower (to_alg_hom)
+
+variables (R S R' S')
+
+/--
+A type-class stating that the following diagram of scalar towers
+R  →  S
+↓     ↓
+R' →  S'
+is a pushout diagram (i.e. `S' = S ⊗[R] R'`)
+-/
+@[mk_iff]
+class algebra.is_pushout : Prop :=
+(out : is_base_change S (to_alg_hom R R' S').to_linear_map)
+
+variables {R S R' S'}
+
+lemma algebra.is_pushout.symm
+  (h : algebra.is_pushout R S R' S') :
+  algebra.is_pushout R R' S S' :=
+begin
+  letI := (algebra.tensor_product.include_right : R' →ₐ[R] S ⊗ R').to_ring_hom.to_algebra,
+  let e : R' ⊗[R] S ≃ₗ[R'] S',
+  { refine { map_smul' := _, ..(tensor_product.comm R R' S).trans $ h.1.equiv.restrict_scalars R },
+    intros r x,
+    change
+      h.1.equiv (tensor_product.comm R R' S (r • x)) = r • h.1.equiv (tensor_product.comm R R' S x),
+    apply tensor_product.induction_on x,
+    { simp only [smul_zero, map_zero] },
+    { intros x y,
+      simp [smul_tmul', algebra.smul_def, ring_hom.algebra_map_to_algebra, h.1.equiv_tmul],
+      ring },
+    { intros x y hx hy, simp only [map_add, smul_add, hx, hy] } },
+  have : (to_alg_hom R S S').to_linear_map
+    = (e.to_linear_map.restrict_scalars R).comp (tensor_product.mk R R' S 1),
+  { ext, simp [e, h.1.equiv_tmul, algebra.smul_def] },
+  constructor,
+  rw this,
+  exact (tensor_product.is_base_change R S R').comp (is_base_change.of_equiv e),
+end
+
+variables (R S R' S')
+
+lemma algebra.is_pushout.comm :
+  algebra.is_pushout R S R' S' ↔ algebra.is_pushout R R' S S' :=
+⟨algebra.is_pushout.symm, algebra.is_pushout.symm⟩
+
+variables {R S R'}
+
+local attribute [instance] algebra.tensor_product.right_algebra
+
+instance tensor_product.is_pushout {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
+  [algebra R S] [algebra R T] :
+  algebra.is_pushout R S T (tensor_product R S T) :=
+⟨tensor_product.is_base_change R T S⟩
+
+instance tensor_product.is_pushout' {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
+  [algebra R S] [algebra R T] :
+  algebra.is_pushout R T S (tensor_product R S T) :=
+algebra.is_pushout.symm infer_instance
+
+/--
+If `S' = S ⊗[R] R'`, then any pair of `R`-algebra homomorphisms `f : S → A` and `g : R' → A`
+such that `f x` and `g y` commutes for all `x, y` descends to a (unique) homomoprhism `S' → A`.
+-/
+@[simps apply (lemmas_only)] noncomputable
+def algebra.pushout_desc [H : algebra.is_pushout R S R' S']
+  {A : Type*} [semiring A] [algebra R A] (f : S →ₐ[R] A) (g : R' →ₐ[R] A)
+    (hf : ∀ x y, f x * g y = g y * f x) : S' →ₐ[R] A :=
+begin
+  letI := module.comp_hom A f.to_ring_hom,
+  haveI : is_scalar_tower R S A :=
+  { smul_assoc := λ r s a, show f (r • s) * a = r • (f s * a), by rw [f.map_smul, smul_mul_assoc] },
+  haveI : is_scalar_tower S A A :=
+  { smul_assoc := λ r a b, mul_assoc _ _ _ },
+  have : ∀ x, H.out.lift g.to_linear_map (algebra_map R' S' x) = g x := H.out.lift_eq _,
+  refine alg_hom.of_linear_map ((H.out.lift g.to_linear_map).restrict_scalars R) _ _,
+  { dsimp only [linear_map.restrict_scalars_apply],
+    rw [← (algebra_map R' S').map_one, this, g.map_one] },
+  { intros x y,
+    apply H.out.induction_on x,
+    { rw [zero_mul, map_zero, zero_mul] },
+    rotate,
+    { intros s s' e, dsimp only [linear_map.restrict_scalars_apply] at e ⊢,
+      rw [linear_map.map_smul, smul_mul_assoc, linear_map.map_smul, e, smul_mul_assoc] },
+    { intros s s' e₁ e₂, dsimp only [linear_map.restrict_scalars_apply] at e₁ e₂ ⊢,
+      rw [add_mul, map_add, map_add, add_mul, e₁, e₂] },
+    intro x, dsimp, rw this, apply H.out.induction_on y,
+    { rw [mul_zero, map_zero, mul_zero] },
+    { intro y, dsimp, rw [← _root_.map_mul, this, this, _root_.map_mul] },
+    { intros s s' e,
+      rw [mul_comm, smul_mul_assoc, linear_map.map_smul, linear_map.map_smul, mul_comm, e],
+      change f s * (g x * _) = g x * (f s * _),
+      rw [← mul_assoc, ← mul_assoc, hf] },
+    { intros s s' e₁ e₂, rw [mul_add, map_add, map_add, mul_add, e₁, e₂] }, }
+end
+
+@[simp]
+lemma algebra.pushout_desc_left [H : algebra.is_pushout R S R' S']
+  {A : Type*} [semiring A] [algebra R A] (f : S →ₐ[R] A) (g : R' →ₐ[R] A) (H) (x : S) :
+  algebra.pushout_desc S' f g H (algebra_map S S' x) = f x :=
+begin
+  rw [algebra.pushout_desc_apply, algebra.algebra_map_eq_smul_one, linear_map.map_smul,
+    ← algebra.pushout_desc_apply S' f g H, _root_.map_one],
+  exact mul_one (f x)
+end
+
+lemma algebra.lift_alg_hom_comp_left [H : algebra.is_pushout R S R' S']
+  {A : Type*} [semiring A] [algebra R A] (f : S →ₐ[R] A) (g : R' →ₐ[R] A) (H) :
+  (algebra.pushout_desc S' f g H).comp (to_alg_hom R S S') = f :=
+alg_hom.ext (λ x, (algebra.pushout_desc_left S' f g H x : _))
+
+@[simp]
+lemma algebra.pushout_desc_right [H : algebra.is_pushout R S R' S']
+  {A : Type*} [semiring A] [algebra R A] (f : S →ₐ[R] A) (g : R' →ₐ[R] A) (H) (x : R') :
+  algebra.pushout_desc S' f g H (algebra_map R' S' x) = g x :=
+begin
+  apply_with @@is_base_change.lift_eq { instances := ff },
+end
+
+lemma algebra.lift_alg_hom_comp_right [H : algebra.is_pushout R S R' S']
+  {A : Type*} [semiring A] [algebra R A] (f : S →ₐ[R] A) (g : R' →ₐ[R] A) (H) :
+  (algebra.pushout_desc S' f g H).comp (to_alg_hom R R' S') = g :=
+alg_hom.ext (λ x, (algebra.pushout_desc_right S' f g H x : _))
+
+@[ext]
+lemma algebra.is_pushout.alg_hom_ext [H : algebra.is_pushout R S R' S']
+  {A : Type*} [semiring A] [algebra R A] {f g : S' →ₐ[R] A}
+  (h₁ : f.comp (to_alg_hom R R' S') = g.comp (to_alg_hom R R' S'))
+  (h₂ : f.comp (to_alg_hom R S S') = g.comp (to_alg_hom R S S')) : f = g :=
+begin
+  ext x,
+  apply H.1.induction_on x,
+  { simp only [map_zero] },
+  { exact alg_hom.congr_fun h₁ },
+  { intros s s' e, rw [algebra.smul_def, f.map_mul, g.map_mul, e],
+    congr' 1, exact (alg_hom.congr_fun h₂ s : _) },
+  { intros s₁ s₂ e₁ e₂, rw [map_add, map_add, e₁, e₂] }
+end
+
+end is_base_change
diff --git a/src/ring_theory/jacobson.lean b/src/ring_theory/jacobson.lean
index 9edb5dd598b61..8c0a791739917 100644
--- a/src/ring_theory/jacobson.lean
+++ b/src/ring_theory/jacobson.lean
@@ -3,12 +3,15 @@ Copyright (c) 2020 Devon Tuma. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Devon Tuma
 -/
-import ring_theory.localization.away
+import ring_theory.localization.away.basic
 import ring_theory.ideal.over
 import ring_theory.jacobson_ideal
 
 /-!
 # Jacobson Rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 The following conditions are equivalent for a ring `R`:
 1. Every radical ideal `I` is equal to its Jacobson radical
 2. Every radical ideal `I` can be written as an intersection of maximal ideals
@@ -21,7 +24,7 @@ Some particular examples of Jacobson rings are also proven.
 ## Main definitions
 Let `R` be a commutative ring. Jacobson Rings are defined using the first of the above conditions
 * `is_jacobson R` is the proposition that `R` is a Jacobson ring. It is a class,
-  implemented as the predicate that for any ideal, `I.radical = I` implies `I.jacobson = I`.
+  implemented as the predicate that for any ideal, `I.is_radical` implies `I.jacobson = I`.
 
 ## Main statements
 * `is_jacobson_iff_prime_eq` is the equivalence between conditions 1 and 3 above.
@@ -45,22 +48,22 @@ variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}
  the Jacobson radical of `I` is equal to `I`.
  See `is_jacobson_iff_prime_eq` and `is_jacobson_iff_Inf_maximal` for equivalent definitions. -/
 class is_jacobson (R : Type*) [comm_ring R] : Prop :=
-(out' : ∀ (I : ideal R), I.radical = I → I.jacobson = I)
+(out' : ∀ (I : ideal R), I.is_radical → I.jacobson = I)
 
 theorem is_jacobson_iff {R} [comm_ring R] :
-  is_jacobson R ↔ ∀ (I : ideal R), I.radical = I → I.jacobson = I :=
+  is_jacobson R ↔ ∀ (I : ideal R), I.is_radical → I.jacobson = I :=
 ⟨λ h, h.1, λ h, ⟨h⟩⟩
 
 theorem is_jacobson.out {R} [comm_ring R] :
-  is_jacobson R → ∀ {I : ideal R}, I.radical = I → I.jacobson = I := is_jacobson_iff.1
+  is_jacobson R → ∀ {I : ideal R}, I.is_radical → I.jacobson = I := is_jacobson_iff.1
 
 /--  A ring is a Jacobson ring if and only if for all prime ideals `P`,
  the Jacobson radical of `P` is equal to `P`. -/
 lemma is_jacobson_iff_prime_eq : is_jacobson R ↔ ∀ P : ideal R, is_prime P → P.jacobson = P :=
 begin
-  refine is_jacobson_iff.trans ⟨λ h I hI, h I (is_prime.radical hI), _⟩,
+  refine is_jacobson_iff.trans ⟨λ h I hI, h I hI.is_radical, _⟩,
   refine λ h I hI, le_antisymm (λ x hx, _) (λ x hx, mem_Inf.mpr (λ _ hJ, hJ.left hx)),
-  rw [← hI, radical_eq_Inf I, mem_Inf],
+  rw [← hI.radical, radical_eq_Inf I, mem_Inf],
   intros P hP,
   rw set.mem_set_of_eq at hP,
   erw mem_Inf at hx,
@@ -73,26 +76,24 @@ end
  Allowing ⊤ in the set `M` of maximal ideals is equivalent, but makes some proofs cleaner. -/
 lemma is_jacobson_iff_Inf_maximal : is_jacobson R ↔
   ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
-⟨λ H I h, eq_jacobson_iff_Inf_maximal.1 (H.out (is_prime.radical h)),
+⟨λ H I h, eq_jacobson_iff_Inf_maximal.1 (H.out h.is_radical),
   λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal.2 (H hP))⟩
 
 lemma is_jacobson_iff_Inf_maximal' : is_jacobson R ↔
   ∀ {I : ideal R}, I.is_prime → ∃ M : set (ideal R),
   (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
-⟨λ H I h, eq_jacobson_iff_Inf_maximal'.1 (H.out (is_prime.radical h)),
+⟨λ H I h, eq_jacobson_iff_Inf_maximal'.1 (H.out h.is_radical),
   λ H, is_jacobson_iff_prime_eq.2 (λ P hP, eq_jacobson_iff_Inf_maximal'.2 (H hP))⟩
 
 lemma radical_eq_jacobson [H : is_jacobson R] (I : ideal R) : I.radical = I.jacobson :=
 le_antisymm (le_Inf (λ J ⟨hJ, hJ_max⟩, (is_prime.radical_le_iff hJ_max.is_prime).mpr hJ))
-            ((H.out (radical_idem I)) ▸ (jacobson_mono le_radical))
+            (H.out (radical_is_radical I) ▸ jacobson_mono le_radical)
 
 /-- Fields have only two ideals, and the condition holds for both of them.  -/
 @[priority 100]
 instance is_jacobson_field {K : Type*} [field K] : is_jacobson K :=
 ⟨λ I hI, or.rec_on (eq_bot_or_top I)
-(λ h, le_antisymm
-  (Inf_le ⟨le_of_eq rfl, (eq.symm h) ▸ bot_is_maximal⟩)
-  ((eq.symm h) ▸ bot_le))
+(λ h, le_antisymm (Inf_le ⟨le_rfl, h.symm ▸ bot_is_maximal⟩) (h.symm ▸ bot_le))
 (λ h, by rw [h, jacobson_eq_top_iff])⟩
 
 theorem is_jacobson_of_surjective [H : is_jacobson R] :
@@ -102,11 +103,10 @@ begin
   rw is_jacobson_iff_Inf_maximal,
   intros p hp,
   use map f '' {J : ideal R | comap f p ≤ J ∧ J.is_maximal },
-  use λ j ⟨J, hJ, hmap⟩, hmap ▸ or.symm (map_eq_top_or_is_maximal_of_surjective f hf hJ.right),
-  have : p = map f ((comap f p).jacobson),
-  from (is_jacobson.out' (comap f p) (by rw [← comap_radical, is_prime.radical hp])).symm
-    ▸ (map_comap_of_surjective f hf p).symm,
-  exact eq.trans this (map_Inf hf (λ J ⟨hJ, _⟩, le_trans (ideal.ker_le_comap f) hJ)),
+  use λ j ⟨J, hJ, hmap⟩, hmap ▸ (map_eq_top_or_is_maximal_of_surjective f hf hJ.right).symm,
+  have : p = map f (comap f p).jacobson :=
+    (is_jacobson.out' _ $ hp.is_radical.comap f).symm ▸ (map_comap_of_surjective f hf p).symm,
+  exact this.trans (map_Inf hf (λ J ⟨hJ, _⟩, le_trans (ideal.ker_le_comap f) hJ)),
 end
 
 @[priority 100]
@@ -148,13 +148,12 @@ open is_localization submonoid
 variables {R S : Type*} [comm_ring R] [comm_ring S] {I : ideal R}
 variables (y : R) [algebra R S] [is_localization.away y S]
 
-lemma disjoint_powers_iff_not_mem (hI : I.radical = I) :
+lemma disjoint_powers_iff_not_mem (hI : I.is_radical) :
   disjoint ((submonoid.powers y) : set R) ↑I ↔ y ∉ I.1 :=
 begin
-  refine ⟨λ h, set.disjoint_left.1 h (mem_powers _), λ h, (disjoint_iff).mpr (eq_bot_iff.mpr _)⟩,
+  refine ⟨λ h, set.disjoint_left.1 h (mem_powers _), λ h, disjoint_iff.mpr (eq_bot_iff.mpr _)⟩,
   rintros x ⟨⟨n, rfl⟩, hx'⟩,
-  rw [← hI] at hx',
-  exact absurd (hI ▸ mem_radical_of_pow_mem hx' : y ∈ I.carrier) h
+  exact h (hI $ mem_radical_of_pow_mem $ le_radical hx')
 end
 
 variables (S)
@@ -173,16 +172,16 @@ begin
     rw is_prime_iff_is_prime_disjoint (submonoid.powers y) at hJ,
     have : y ∉ (comap (algebra_map R S) J).1 :=
       set.disjoint_left.1 hJ.right (submonoid.mem_powers _),
-    erw [← H.out (is_prime.radical hJ.left), mem_Inf] at this,
+    erw [← H.out hJ.left.is_radical, mem_Inf] at this,
     push_neg at this,
     rcases this with ⟨I, hI, hI'⟩,
     convert hI.right,
     by_cases hJ : J = map (algebra_map R S) I,
     { rw [hJ, comap_map_of_is_prime_disjoint (powers y) S I (is_maximal.is_prime hI.right)],
-      rwa disjoint_powers_iff_not_mem y (is_maximal.is_prime hI.right).radical },
+      rwa disjoint_powers_iff_not_mem y hI.right.is_prime.is_radical },
     { have hI_p : (map (algebra_map R S) I).is_prime,
       { refine is_prime_of_is_prime_disjoint (powers y) _ I hI.right.is_prime _,
-        rwa disjoint_powers_iff_not_mem y (is_maximal.is_prime hI.right).radical },
+        rwa disjoint_powers_iff_not_mem y hI.right.is_prime.is_radical },
       have : J ≤ map (algebra_map R S) I :=
         (map_comap (submonoid.powers y) S J) ▸ (map_mono hI.left),
       exact absurd (h.1.2 _ (lt_of_le_of_ne this hJ)) hI_p.1 } },
@@ -206,7 +205,7 @@ lemma is_maximal_of_is_maximal_disjoint [is_jacobson R] (I : ideal R) (hI : I.is
 begin
   rw [is_maximal_iff_is_maximal_disjoint S y,
     comap_map_of_is_prime_disjoint (powers y) S I (is_maximal.is_prime hI)
-    ((disjoint_powers_iff_not_mem y (is_maximal.is_prime hI).radical).2 hy)],
+    ((disjoint_powers_iff_not_mem y hI.is_prime.is_radical).2 hy)],
   exact ⟨hI, hy⟩
 end
 
@@ -220,7 +219,7 @@ def order_iso_of_maximal [is_jacobson R] :
     ⟨ideal.map (algebra_map R S) p.1, is_maximal_of_is_maximal_disjoint y p.1 p.2.1 p.2.2⟩,
   left_inv := λ J, subtype.eq (map_comap (powers y) S J),
   right_inv := λ I, subtype.eq (comap_map_of_is_prime_disjoint _ _ I.1 (is_maximal.is_prime I.2.1)
-    ((disjoint_powers_iff_not_mem y I.2.1.is_prime.radical).2 I.2.2)),
+    ((disjoint_powers_iff_not_mem y I.2.1.is_prime.is_radical).2 I.2.2)),
   map_rel_iff' := λ I I', ⟨λ h, (show I.val ≤ I'.val,
     from (map_comap (powers y) S I.val) ▸ (map_comap (powers y) S I'.val) ▸ (ideal.map_mono h)),
     λ h x hx, h hx⟩ }
@@ -234,9 +233,9 @@ begin
   rw is_jacobson_iff_prime_eq,
   refine λ P' hP', le_antisymm _ le_jacobson,
   obtain ⟨hP', hPM⟩ := (is_localization.is_prime_iff_is_prime_disjoint (powers y) S P').mp hP',
-  have hP := H.out (is_prime.radical hP'),
-  refine (le_of_eq (is_localization.map_comap (powers y) S P'.jacobson).symm).trans
-    ((map_mono _).trans (le_of_eq (is_localization.map_comap (powers y) S P'))),
+  have hP := H.out hP'.is_radical,
+  refine (is_localization.map_comap (powers y) S P'.jacobson).ge.trans
+    ((map_mono _).trans (is_localization.map_comap (powers y) S P').le),
   have : Inf { I : ideal R | comap (algebra_map R S) P' ≤ I ∧ I.is_maximal ∧ y ∉ I } ≤
     comap (algebra_map R S) P',
   { intros x hx,
@@ -249,14 +248,14 @@ begin
     rw hP at hxy,
     cases hP'.mem_or_mem hxy with hxy hxy,
     { exact hxy },
-    { exact (hPM ⟨submonoid.mem_powers _, hxy⟩).elim } },
+    { exact (hPM.le_bot ⟨submonoid.mem_powers _, hxy⟩).elim } },
   refine le_trans _ this,
   rw [ideal.jacobson, comap_Inf', Inf_eq_infi],
   refine infi_le_infi_of_subset (λ I hI, ⟨map (algebra_map R S) I, ⟨_, _⟩⟩),
   { exact ⟨le_trans (le_of_eq ((is_localization.map_comap (powers y) S P').symm)) (map_mono hI.1),
     is_maximal_of_is_maximal_disjoint y _ hI.2.1 hI.2.2⟩ },
   { exact is_localization.comap_map_of_is_prime_disjoint _ S I (is_maximal.is_prime hI.2.1)
-    ((disjoint_powers_iff_not_mem y hI.2.1.is_prime.radical).2 hI.2.2) }
+    ((disjoint_powers_iff_not_mem y hI.2.1.is_prime.is_radical).2 hI.2.2) }
 end
 
 end localization
@@ -268,26 +267,29 @@ section comm_ring
 variables {R S : Type*} [comm_ring R] [comm_ring S] [is_domain S]
 variables {Rₘ Sₘ : Type*} [comm_ring Rₘ] [comm_ring Sₘ]
 
-/-- If `I` is a prime ideal of `polynomial R` and `pX ∈ I` is a non-constant polynomial,
+/-- If `I` is a prime ideal of `R[X]` and `pX ∈ I` is a non-constant polynomial,
   then the map `R →+* R[x]/I` descends to an integral map when localizing at `pX.leading_coeff`.
   In particular `X` is integral because it satisfies `pX`, and constants are trivially integral,
   so integrality of the entire extension follows by closure under addition and multiplication. -/
 lemma is_integral_is_localization_polynomial_quotient
   (P : ideal R[X]) (pX : R[X]) (hpX : pX ∈ P)
   [algebra (R ⧸ P.comap (C : R →+* _)) Rₘ]
-  [is_localization.away (pX.map (quotient.mk (P.comap C))).leading_coeff Rₘ]
+  [is_localization.away (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff Rₘ]
   [algebra (R[X] ⧸ P) Sₘ]
-  [is_localization ((submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).map
+  [is_localization ((submonoid.powers (pX.map
+    (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff).map
     (quotient_map P C le_rfl) : submonoid (R[X] ⧸ P)) Sₘ] :
   (is_localization.map Sₘ (quotient_map P C le_rfl)
-    ((submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).le_comap_map) : Rₘ →+* _)
+    ((submonoid.powers
+      (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff).le_comap_map) : Rₘ →+* _)
     .is_integral :=
 begin
   let P' : ideal R := P.comap C,
   let M : submonoid (R ⧸ P') :=
-  submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff,
+  submonoid.powers (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff,
   let M' : submonoid (R[X] ⧸ P) :=
-  (submonoid.powers (pX.map (quotient.mk (P.comap C))).leading_coeff).map (quotient_map P C le_rfl),
+  (submonoid.powers (pX.map (quotient.mk (P.comap (C : R →+* R[X])))).leading_coeff).map
+    (quotient_map P C le_rfl),
   let φ : R ⧸ P' →+* R[X] ⧸ P := quotient_map P C le_rfl,
   let φ' : Rₘ →+* Sₘ := is_localization.map Sₘ φ M.le_comap_map,
   have hφ' : φ.comp (quotient.mk P') = (quotient.mk P).comp C := rfl,
@@ -343,7 +345,7 @@ begin
       exact is_localization.injective Sₘ hM },
     have hSₘ : is_jacobson Sₘ := is_jacobson_of_is_integral' φ' hφ' (is_jacobson_localization x),
     refine eq_bot_iff.mpr (le_trans _ (le_of_eq hϕ')),
-    rw [← hSₘ.out radical_bot_of_is_domain, comap_jacobson],
+    rw [← hSₘ.out is_radical_bot_of_no_zero_divisors, comap_jacobson],
     exact Inf_le_Inf (λ j hj, ⟨bot_le, let ⟨J, hJ⟩ := hj in hJ.2 ▸ this J hJ.1.2⟩) },
   introsI I hI,
   -- Remainder of the proof is pulling and pushing ideals around the square and the quotient square
@@ -353,8 +355,7 @@ begin
   have hcomm: φ'.comp (algebra_map R Rₘ) = (algebra_map S Sₘ).comp φ := is_localization.map_comp _,
   let f := quotient_map (I.comap (algebra_map S Sₘ)) φ le_rfl,
   let g := quotient_map I (algebra_map S Sₘ) le_rfl,
-  have := is_maximal_comap_of_is_integral_of_is_maximal' φ' hφ' I
-    (by convert hI; casesI _inst_4; refl),
+  have := is_maximal_comap_of_is_integral_of_is_maximal' φ' hφ' I hI,
   have := ((is_maximal_iff_is_maximal_disjoint Rₘ x _).1 this).left,
   have : ((I.comap (algebra_map S Sₘ)).comap φ).is_maximal,
   { rwa [comap_comap, hcomm, ← comap_comap] at this },
@@ -378,7 +379,7 @@ private lemma is_jacobson_polynomial_of_domain
 begin
   by_cases Pb : P = ⊥,
   { exact Pb.symm ▸ jacobson_bot_polynomial_of_jacobson_bot
-      (hR.out radical_bot_of_is_domain) },
+      (hR.out is_radical_bot_of_no_zero_divisors) },
   { rw jacobson_eq_iff_jacobson_quotient_eq_bot,
     haveI : (P.comap (C : R →+* R[X])).is_prime := comap_is_prime C P,
     obtain ⟨p, pP, p0⟩ := exists_nonzero_mem_of_ne_bot Pb hP,
@@ -443,24 +444,26 @@ variables (P : ideal R[X]) [hP : P.is_maximal]
 include P hP
 
 lemma is_maximal_comap_C_of_is_maximal [nontrivial R] (hP' : ∀ (x : R), C x ∈ P → x = 0) :
-  is_maximal (comap C P : ideal R) :=
+  is_maximal (comap (C : R →+* R[X]) P : ideal R) :=
 begin
-  haveI hp'_prime : (P.comap C : ideal R).is_prime := comap_is_prime C P,
+  haveI hp'_prime : (P.comap (C : R →+* R[X]) : ideal R).is_prime := comap_is_prime C P,
   obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_of_maximal P polynomial_not_is_field),
   have : (m : R[X]) ≠ 0, rwa [ne.def, submodule.coe_eq_zero],
-  let φ : R ⧸ P.comap C →+* R[X] ⧸ P := quotient_map P C le_rfl,
+  let φ : R ⧸ P.comap (C : R →+* R[X])  →+* R[X] ⧸ P := quotient_map P (C : R →+* R[X]) le_rfl,
   let M : submonoid (R ⧸ P.comap C) :=
-    submonoid.powers ((m : R[X]).map (quotient.mk (P.comap C : ideal R))).leading_coeff,
+    submonoid.powers ((m : R[X]).map
+      (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))).leading_coeff,
   rw ← bot_quotient_is_maximal_iff,
-  have hp0 : ((m : R[X]).map (quotient.mk (P.comap C : ideal R))).leading_coeff ≠ 0 :=
-    λ hp0', this $ map_injective (quotient.mk (P.comap C : ideal R))
-      ((injective_iff_map_eq_zero (quotient.mk (P.comap C : ideal R))).2 (λ x hx,
+  have hp0 : ((m : R[X]).map
+    (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))).leading_coeff ≠ 0 :=
+    λ hp0', this $ map_injective (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))
+      ((injective_iff_map_eq_zero (quotient.mk (P.comap (C : R →+* R[X]) : ideal R))).2 (λ x hx,
       by rwa [quotient.eq_zero_iff_mem, (by rwa eq_bot_iff : (P.comap C : ideal R) = ⊥)] at hx))
       (by simpa only [leading_coeff_eq_zero, polynomial.map_zero] using hp0'),
   have hM : (0 : R ⧸ P.comap C) ∉ M := λ ⟨n, hn⟩, hp0 (pow_eq_zero hn),
   suffices : (⊥ : ideal (localization M)).is_maximal,
   { rw ← is_localization.comap_map_of_is_prime_disjoint M (localization M) ⊥ bot_prime
-        (λ x hx, hM (hx.2 ▸ hx.1)),
+        (disjoint_iff_inf_le.mpr $ λ x hx, hM (hx.2 ▸ hx.1)),
     refine ((is_maximal_iff_is_maximal_disjoint (localization M) _ _).mp (by rwa map_bot)).1,
     swap, exact localization.is_localization },
   let M' : submonoid (R[X] ⧸ P) := M.map φ,
@@ -470,8 +473,7 @@ begin
     is_localization.is_domain_localization (le_non_zero_divisors_of_no_zero_divisors hM'),
   suffices : (⊥ : ideal (localization M')).is_maximal,
   { rw le_antisymm bot_le (comap_bot_le_of_injective _ (is_localization.map_injective_of_injective
-      M (localization M) (localization M')
-      quotient_map_injective (le_non_zero_divisors_of_no_zero_divisors hM'))),
+      M (localization M) (localization M') quotient_map_injective )),
     refine is_maximal_comap_of_is_integral_of_is_maximal' _ _ ⊥ this,
     apply is_integral_is_localization_polynomial_quotient P _ (submodule.coe_mem m) },
   rw (map_bot.symm : (⊥ : ideal (localization M')) =
@@ -510,7 +512,7 @@ begin
       convert is_integral_is_localization_polynomial_quotient P pX hpX } }
 end
 
-/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `polynomial R`,
+/-- If `R` is a Jacobson ring, and `P` is a maximal ideal of `R[X]`,
   then `R → R[X]/P` is an integral map. -/
 lemma quotient_mk_comp_C_is_integral_of_jacobson :
   ((quotient.mk P).comp C : R →+* R[X] ⧸ P).is_integral :=
@@ -551,7 +553,7 @@ lemma comp_C_integral_of_surjective_of_jacobson
   {S : Type*} [field S] (f : R[X] →+* S) (hf : function.surjective f) :
   (f.comp C).is_integral :=
 begin
-  haveI : (f.ker).is_maximal := f.ker_is_maximal_of_surjective hf,
+  haveI : (f.ker).is_maximal := ring_hom.ker_is_maximal_of_surjective f hf,
   let g : R[X] ⧸ f.ker →+* S := ideal.quotient.lift f.ker f (λ _ h, h),
   have hfg : (g.comp (quotient.mk f.ker)) = f := ring_hom_ext' rfl rfl,
   rw [← hfg, ring_hom.comp_assoc],
@@ -580,9 +582,10 @@ lemma is_jacobson_mv_polynomial_fin {R : Type*} [comm_ring R] [H : is_jacobson R
   `Inf {P maximal | P ≥ I} = Inf {P prime | P ≥ I} = I.radical`. Fields are always Jacobson,
   and in that special case this is (most of) the classical Nullstellensatz,
   since `I(V(I))` is the intersection of maximal ideals containing `I`, which is then `I.radical` -/
-instance {R : Type*} [comm_ring R] {ι : Type*} [fintype ι] [is_jacobson R] :
+instance is_jacobson {R : Type*} [comm_ring R] {ι : Type*} [finite ι] [is_jacobson R] :
   is_jacobson (mv_polynomial ι R) :=
 begin
+  casesI nonempty_fintype ι,
   haveI := classical.dec_eq ι,
   let e := fintype.equiv_fin ι,
   rw is_jacobson_iso (rename_equiv R e).to_ring_equiv,
@@ -625,17 +628,17 @@ end
 
 lemma comp_C_integral_of_surjective_of_jacobson
   {R : Type*} [comm_ring R] [is_jacobson R]
-  {σ : Type*} [fintype σ] {S : Type*} [field S] (f : mv_polynomial σ R →+* S)
+  {σ : Type*} [finite σ] {S : Type*} [field S] (f : mv_polynomial σ R →+* S)
   (hf : function.surjective f) : (f.comp C).is_integral :=
 begin
-  haveI := classical.dec_eq σ,
-  obtain ⟨e⟩ := fintype.trunc_equiv_fin σ,
+  casesI nonempty_fintype σ,
+  have e := (fintype.equiv_fin σ).symm,
   let f' : mv_polynomial (fin _) R →+* S :=
-    f.comp (rename_equiv R e.symm).to_ring_equiv.to_ring_hom,
+    f.comp (rename_equiv R e).to_ring_equiv.to_ring_hom,
   have hf' : function.surjective f' :=
-    ((function.surjective.comp hf (rename_equiv R e.symm).surjective)),
+    ((function.surjective.comp hf (rename_equiv R e).surjective)),
   have : (f'.comp C).is_integral,
-  { haveI : (f'.ker).is_maximal := f'.ker_is_maximal_of_surjective hf',
+  { haveI : (f'.ker).is_maximal := ker_is_maximal_of_surjective f' hf',
     let g : mv_polynomial _ R ⧸ f'.ker →+* S := ideal.quotient.lift f'.ker f' (λ _ h, h),
     have hfg : (g.comp (quotient.mk f'.ker)) = f' := ring_hom_ext (λ r, rfl) (λ i, rfl),
     rw [← hfg, ring_hom.comp_assoc],
@@ -646,7 +649,7 @@ begin
   rw ring_hom.comp_assoc at this,
   convert this,
   refine ring_hom.ext (λ x, _),
-  exact ((rename_equiv R e.symm).commutes' x).symm,
+  exact ((rename_equiv R e).commutes' x).symm,
 end
 
 end mv_polynomial
diff --git a/src/ring_theory/jacobson_ideal.lean b/src/ring_theory/jacobson_ideal.lean
index a210e27453396..85d0476833875 100644
--- a/src/ring_theory/jacobson_ideal.lean
+++ b/src/ring_theory/jacobson_ideal.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Devon Tuma
 -/
 import ring_theory.ideal.quotient
-import ring_theory.polynomial.basic
+import ring_theory.polynomial.quotient
 
 /-!
 # Jacobson radical
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Jacobson radical of a ring `R` is defined to be the intersection of all maximal ideals of `R`.
 This is similar to how the nilradical is equal to the intersection of all prime ideals of `R`.
 
@@ -209,8 +212,8 @@ variables [comm_ring R] [comm_ring S] {I : ideal R}
 lemma radical_le_jacobson : radical I ≤ jacobson I :=
 le_Inf (λ J hJ, (radical_eq_Inf I).symm ▸ Inf_le ⟨hJ.left, is_maximal.is_prime hJ.right⟩)
 
-lemma eq_radical_of_eq_jacobson : jacobson I = I → radical I = I :=
-λ h, le_antisymm (le_trans radical_le_jacobson (le_of_eq h)) le_radical
+lemma is_radical_of_eq_jacobson (h : jacobson I = I) : I.is_radical :=
+radical_le_jacobson.trans h.le
 
 lemma is_unit_of_sub_one_mem_jacobson_bot (r : R)
   (h : r - 1 ∈ jacobson (⊥ : ideal R)) : is_unit r :=
@@ -277,7 +280,7 @@ open polynomial
 variables [comm_ring R]
 
 lemma jacobson_bot_polynomial_le_Inf_map_maximal :
-  jacobson (⊥ : ideal R[X]) ≤ Inf (map C '' {J : ideal R | J.is_maximal}) :=
+  jacobson (⊥ : ideal R[X]) ≤ Inf (map (C : R →+* R[X]) '' {J : ideal R | J.is_maximal}) :=
 begin
   refine le_Inf (λ J, exists_imp_distrib.2 (λ j hj, _)),
   haveI : j.is_maximal := hj.1,
diff --git a/src/ring_theory/kaehler.lean b/src/ring_theory/kaehler.lean
new file mode 100644
index 0000000000000..2ec88c0e1d9fa
--- /dev/null
+++ b/src/ring_theory/kaehler.lean
@@ -0,0 +1,633 @@
+/-
+Copyright © 2020 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Andrew Yang
+-/
+
+import ring_theory.derivation.to_square_zero
+import ring_theory.ideal.cotangent
+import ring_theory.is_tensor_product
+
+/-!
+# The module of kaehler differentials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main results
+
+- `kaehler_differential`: The module of kaehler differentials. For an `R`-algebra `S`, we provide
+  the notation `Ω[S⁄R]` for `kaehler_differential R S`.
+  Note that the slash is `\textfractionsolidus`.
+- `kaehler_differential.D`: The derivation into the module of kaehler differentials.
+- `kaehler_differential.span_range_derivation`: The image of `D` spans `Ω[S⁄R]` as an `S`-module.
+- `kaehler_differential.linear_map_equiv_derivation`:
+  The isomorphism `Hom_R(Ω[S⁄R], M) ≃ₗ[S] Der_R(S, M)`.
+- `kaehler_differential.quot_ker_total_equiv`: An alternative description of `Ω[S⁄R]` as `S` copies
+  of `S` with kernel (`kaehler_differential.ker_total`) generated by the relations:
+  1. `dx + dy = d(x + y)`
+  2. `x dy + y dx = d(x * y)`
+  3. `dr = 0` for `r ∈ R`
+- `kaehler_differential.map`: Given a map between the arrows `R → A` and `S → B`, we have an
+  `A`-linear map `Ω[A⁄R] → Ω[B⁄S]`.
+
+## Future project
+
+- Define a `is_kaehler_differential` predicate.
+-/
+
+section kaehler_differential
+
+open_locale tensor_product
+open algebra
+
+variables (R S : Type*) [comm_ring R] [comm_ring S] [algebra R S]
+
+/-- The kernel of the multiplication map `S ⊗[R] S →ₐ[R] S`. -/
+abbreviation kaehler_differential.ideal : ideal (S ⊗[R] S) :=
+ring_hom.ker (tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S)
+
+variable {S}
+
+lemma kaehler_differential.one_smul_sub_smul_one_mem_ideal (a : S) :
+  (1 : S) ⊗ₜ[R] a - a ⊗ₜ[R] (1 : S) ∈ kaehler_differential.ideal R S :=
+by simp [ring_hom.mem_ker]
+
+variables {R}
+
+variables {M : Type*} [add_comm_group M] [module R M] [module S M] [is_scalar_tower R S M]
+
+/-- For a `R`-derivation `S → M`, this is the map `S ⊗[R] S →ₗ[S] M` sending `s ⊗ₜ t ↦ s • D t`. -/
+def derivation.tensor_product_to (D : derivation R S M) : S ⊗[R] S →ₗ[S] M :=
+tensor_product.algebra_tensor_module.lift ((linear_map.lsmul S (S →ₗ[R] M)).flip D.to_linear_map)
+
+lemma derivation.tensor_product_to_tmul (D : derivation R S M) (s t : S) :
+  D.tensor_product_to (s ⊗ₜ t) = s • D t :=
+rfl
+
+lemma derivation.tensor_product_to_mul (D : derivation R S M) (x y : S ⊗[R] S) :
+  D.tensor_product_to (x * y) = tensor_product.lmul' R x • D.tensor_product_to y +
+    tensor_product.lmul' R y • D.tensor_product_to x :=
+begin
+  apply tensor_product.induction_on x,
+  { rw [zero_mul, map_zero, map_zero, zero_smul, smul_zero, add_zero] },
+  swap, { rintros, simp only [add_mul, map_add, add_smul, *, smul_add], rw add_add_add_comm },
+  intros x₁ x₂,
+  apply tensor_product.induction_on y,
+  { rw [mul_zero, map_zero, map_zero, zero_smul, smul_zero, add_zero] },
+  swap, { rintros, simp only [mul_add, map_add, add_smul, *, smul_add], rw add_add_add_comm },
+  intros x y,
+  simp only [tensor_product.tmul_mul_tmul, derivation.tensor_product_to,
+    tensor_product.algebra_tensor_module.lift_apply, tensor_product.lift.tmul',
+    tensor_product.lmul'_apply_tmul],
+  dsimp,
+  rw D.leibniz,
+  simp only [smul_smul, smul_add, mul_comm (x * y) x₁, mul_right_comm x₁ x₂, ← mul_assoc],
+end
+
+variables (R S)
+
+/-- The kernel of `S ⊗[R] S →ₐ[R] S` is generated by `1 ⊗ s - s ⊗ 1` as a `S`-module. -/
+lemma kaehler_differential.submodule_span_range_eq_ideal :
+  submodule.span S (set.range $ λ s : S, (1 : S) ⊗ₜ[R] s - s ⊗ₜ[R] (1 : S)) =
+    (kaehler_differential.ideal R S).restrict_scalars S :=
+begin
+  apply le_antisymm,
+  { rw submodule.span_le,
+    rintros _ ⟨s, rfl⟩,
+    exact kaehler_differential.one_smul_sub_smul_one_mem_ideal _ _ },
+  { rintros x (hx : _ = _),
+    have : x - (tensor_product.lmul' R x) ⊗ₜ[R] (1 : S)   = x,
+    { rw [hx, tensor_product.zero_tmul, sub_zero] },
+    rw ← this,
+    clear this hx,
+    apply tensor_product.induction_on x; clear x,
+    { rw [map_zero, tensor_product.zero_tmul, sub_zero], exact zero_mem _ },
+    { intros x y,
+      convert_to x • (1 ⊗ₜ y - y ⊗ₜ 1) ∈ _,
+      { rw [tensor_product.lmul'_apply_tmul, smul_sub, tensor_product.smul_tmul',
+          tensor_product.smul_tmul', smul_eq_mul, smul_eq_mul, mul_one] },
+      { refine submodule.smul_mem _ x _,
+        apply submodule.subset_span,
+        exact set.mem_range_self y } },
+    { intros x y hx hy,
+      rw [map_add, tensor_product.add_tmul, ← sub_add_sub_comm],
+      exact add_mem hx hy } }
+end
+
+lemma kaehler_differential.span_range_eq_ideal :
+  ideal.span (set.range $ λ s : S, (1 : S) ⊗ₜ[R] s - s ⊗ₜ[R] (1 : S)) =
+    kaehler_differential.ideal R S :=
+begin
+  apply le_antisymm,
+  { rw ideal.span_le,
+    rintros _ ⟨s, rfl⟩,
+    exact kaehler_differential.one_smul_sub_smul_one_mem_ideal _ _ },
+  { change (kaehler_differential.ideal R S).restrict_scalars S ≤ (ideal.span _).restrict_scalars S,
+    rw [← kaehler_differential.submodule_span_range_eq_ideal, ideal.span],
+    conv_rhs { rw ← submodule.span_span_of_tower S },
+    exact submodule.subset_span }
+end
+
+/--
+The module of Kähler differentials (Kahler differentials, Kaehler differentials).
+This is implemented as `I / I ^ 2` with `I` the kernel of the multiplication map `S ⊗[R] S →ₐ[R] S`.
+To view elements as a linear combination of the form `s • D s'`, use
+`kaehler_differential.tensor_product_to_surjective` and `derivation.tensor_product_to_tmul`.
+
+We also provide the notation `Ω[S⁄R]` for `kaehler_differential R S`.
+Note that the slash is `\textfractionsolidus`.
+-/
+@[derive [add_comm_group, module (S ⊗[R] S)]]
+def kaehler_differential : Type* := (kaehler_differential.ideal R S).cotangent
+
+notation `Ω[`:100 S `⁄`:0 R `]`:0 := kaehler_differential R S
+
+instance : nonempty Ω[S⁄R] := ⟨0⟩
+
+instance kaehler_differential.module' {R' : Type*} [comm_ring R'] [algebra R' S]
+  [smul_comm_class R R' S] :
+  module R' Ω[S⁄R] :=
+submodule.quotient.module' _
+
+instance : is_scalar_tower S (S ⊗[R] S) Ω[S⁄R] :=
+ideal.cotangent.is_scalar_tower _
+
+instance kaehler_differential.is_scalar_tower_of_tower {R₁ R₂ : Type*} [comm_ring R₁] [comm_ring R₂]
+  [algebra R₁ S] [algebra R₂ S] [has_smul R₁ R₂]
+  [smul_comm_class R R₁ S] [smul_comm_class R R₂ S] [is_scalar_tower R₁ R₂ S] :
+  is_scalar_tower R₁ R₂ Ω[S⁄R] :=
+submodule.quotient.is_scalar_tower _ _
+
+instance kaehler_differential.is_scalar_tower' :
+  is_scalar_tower R (S ⊗[R] S) Ω[S⁄R] :=
+submodule.quotient.is_scalar_tower _ _
+
+/-- The quotient map `I → Ω[S⁄R]` with `I` being the kernel of `S ⊗[R] S → S`. -/
+def kaehler_differential.from_ideal : kaehler_differential.ideal R S →ₗ[S ⊗[R] S] Ω[S⁄R] :=
+(kaehler_differential.ideal R S).to_cotangent
+
+/-- (Implementation) The underlying linear map of the derivation into `Ω[S⁄R]`. -/
+def kaehler_differential.D_linear_map : S →ₗ[R] Ω[S⁄R] :=
+((kaehler_differential.from_ideal R S).restrict_scalars R).comp
+  ((tensor_product.include_right.to_linear_map - tensor_product.include_left.to_linear_map :
+    S →ₗ[R] S ⊗[R] S).cod_restrict ((kaehler_differential.ideal R S).restrict_scalars R)
+      (kaehler_differential.one_smul_sub_smul_one_mem_ideal R) : _ →ₗ[R] _)
+
+lemma kaehler_differential.D_linear_map_apply (s : S) :
+  kaehler_differential.D_linear_map R S s = (kaehler_differential.ideal R S).to_cotangent
+    ⟨1 ⊗ₜ s - s ⊗ₜ 1, kaehler_differential.one_smul_sub_smul_one_mem_ideal R s⟩ :=
+rfl
+
+/-- The universal derivation into `Ω[S⁄R]`. -/
+def kaehler_differential.D : derivation R S Ω[S⁄R] :=
+{ map_one_eq_zero' := begin
+    dsimp only [kaehler_differential.D_linear_map_apply],
+    rw [ideal.to_cotangent_eq_zero, subtype.coe_mk, sub_self],
+    exact zero_mem _
+  end,
+  leibniz' := λ a b, begin
+    dsimp only [kaehler_differential.D_linear_map_apply],
+    rw [← linear_map.map_smul_of_tower ((kaehler_differential.ideal R S).to_cotangent) a,
+      ← linear_map.map_smul_of_tower ((kaehler_differential.ideal R S).to_cotangent) b, ← map_add,
+      ideal.to_cotangent_eq, pow_two],
+    convert submodule.mul_mem_mul (kaehler_differential.one_smul_sub_smul_one_mem_ideal R a : _)
+      (kaehler_differential.one_smul_sub_smul_one_mem_ideal R b : _) using 1,
+    simp only [add_subgroup_class.coe_sub, submodule.coe_add, submodule.coe_mk,
+      tensor_product.tmul_mul_tmul, mul_sub, sub_mul, mul_comm b,
+      submodule.coe_smul_of_tower, smul_sub, tensor_product.smul_tmul', smul_eq_mul, mul_one],
+    ring_nf,
+  end,
+  to_linear_map := kaehler_differential.D_linear_map R S }
+
+lemma kaehler_differential.D_apply (s : S) :
+  kaehler_differential.D R S s = (kaehler_differential.ideal R S).to_cotangent
+    ⟨1 ⊗ₜ s - s ⊗ₜ 1, kaehler_differential.one_smul_sub_smul_one_mem_ideal R s⟩ :=
+rfl
+
+lemma kaehler_differential.span_range_derivation :
+  submodule.span S (set.range $ kaehler_differential.D R S) = ⊤ :=
+begin
+  rw _root_.eq_top_iff,
+  rintros x -,
+  obtain ⟨⟨x, hx⟩, rfl⟩ := ideal.to_cotangent_surjective _ x,
+  have : x ∈ (kaehler_differential.ideal R S).restrict_scalars S := hx,
+  rw ← kaehler_differential.submodule_span_range_eq_ideal at this,
+  suffices : ∃ hx, (kaehler_differential.ideal R S).to_cotangent ⟨x, hx⟩ ∈
+    submodule.span S (set.range $ kaehler_differential.D R S),
+  { exact this.some_spec },
+  apply submodule.span_induction this,
+  { rintros _ ⟨x, rfl⟩,
+    refine ⟨kaehler_differential.one_smul_sub_smul_one_mem_ideal R x, _⟩,
+    apply submodule.subset_span,
+    exact ⟨x, kaehler_differential.D_linear_map_apply R S x⟩ },
+  { exact ⟨zero_mem _, submodule.zero_mem _⟩ },
+  { rintros x y ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩, exact ⟨add_mem hx₁ hy₁, submodule.add_mem _ hx₂ hy₂⟩ },
+  { rintros r x ⟨hx₁, hx₂⟩, exact ⟨((kaehler_differential.ideal R S).restrict_scalars S).smul_mem
+      r hx₁, submodule.smul_mem _ r hx₂⟩ }
+end
+
+variables {R S}
+
+/-- The linear map from `Ω[S⁄R]`, associated with a derivation. -/
+def derivation.lift_kaehler_differential (D : derivation R S M) : Ω[S⁄R] →ₗ[S] M :=
+begin
+  refine ((kaehler_differential.ideal R S • ⊤ :
+    submodule (S ⊗[R] S) (kaehler_differential.ideal R S)).restrict_scalars S).liftq _ _,
+  { exact D.tensor_product_to.comp ((kaehler_differential.ideal R S).subtype.restrict_scalars S) },
+  { intros x hx,
+    change _ = _,
+    apply submodule.smul_induction_on hx; clear hx x,
+    { rintros x (hx : _ = _) ⟨y, hy : _ = _⟩ -,
+      dsimp,
+      rw [derivation.tensor_product_to_mul, hx, hy, zero_smul, zero_smul, zero_add] },
+    { intros x y ex ey, rw [map_add, ex, ey, zero_add] } }
+end
+
+lemma derivation.lift_kaehler_differential_apply (D : derivation R S M) (x) :
+  D.lift_kaehler_differential
+    ((kaehler_differential.ideal R S).to_cotangent x) = D.tensor_product_to x :=
+rfl
+
+lemma derivation.lift_kaehler_differential_comp (D : derivation R S M) :
+  D.lift_kaehler_differential.comp_der (kaehler_differential.D R S) = D :=
+begin
+  ext a,
+  dsimp [kaehler_differential.D_apply],
+  refine (D.lift_kaehler_differential_apply _).trans _,
+  rw [subtype.coe_mk, map_sub, derivation.tensor_product_to_tmul,
+    derivation.tensor_product_to_tmul, one_smul, D.map_one_eq_zero, smul_zero, sub_zero],
+end
+
+@[simp] lemma derivation.lift_kaehler_differential_comp_D (D' : derivation R S M) (x : S) :
+  D'.lift_kaehler_differential (kaehler_differential.D R S x) = D' x :=
+derivation.congr_fun D'.lift_kaehler_differential_comp x
+
+@[ext]
+lemma derivation.lift_kaehler_differential_unique
+  (f f' : Ω[S⁄R] →ₗ[S] M)
+  (hf : f.comp_der (kaehler_differential.D R S) =
+    f'.comp_der (kaehler_differential.D R S)) :
+  f = f' :=
+begin
+  apply linear_map.ext,
+  intro x,
+  have : x ∈ submodule.span S (set.range $ kaehler_differential.D R S),
+  { rw kaehler_differential.span_range_derivation, trivial },
+  apply submodule.span_induction this,
+  { rintros _ ⟨x, rfl⟩, exact congr_arg (λ D : derivation R S M, D x) hf },
+  { rw [map_zero, map_zero] },
+  { intros x y hx hy, rw [map_add, map_add, hx, hy] },
+  { intros a x e, rw [map_smul, map_smul, e] }
+end
+
+variables (R S)
+
+lemma derivation.lift_kaehler_differential_D :
+  (kaehler_differential.D R S).lift_kaehler_differential = linear_map.id :=
+derivation.lift_kaehler_differential_unique _ _
+  (kaehler_differential.D R S).lift_kaehler_differential_comp
+
+variables {R S}
+
+lemma kaehler_differential.D_tensor_product_to (x : kaehler_differential.ideal R S) :
+  (kaehler_differential.D R S).tensor_product_to x =
+    (kaehler_differential.ideal R S).to_cotangent x :=
+begin
+  rw [← derivation.lift_kaehler_differential_apply, derivation.lift_kaehler_differential_D],
+  refl,
+end
+
+variables (R S)
+
+lemma kaehler_differential.tensor_product_to_surjective :
+  function.surjective (kaehler_differential.D R S).tensor_product_to :=
+begin
+  intro x, obtain ⟨x, rfl⟩ := (kaehler_differential.ideal R S).to_cotangent_surjective x,
+  exact ⟨x, kaehler_differential.D_tensor_product_to x⟩
+end
+
+/-- The `S`-linear maps from `Ω[S⁄R]` to `M` are (`S`-linearly) equivalent to `R`-derivations
+from `S` to `M`.  -/
+def kaehler_differential.linear_map_equiv_derivation : (Ω[S⁄R] →ₗ[S] M) ≃ₗ[S] derivation R S M :=
+{ inv_fun := derivation.lift_kaehler_differential,
+  left_inv := λ f, derivation.lift_kaehler_differential_unique _ _
+    (derivation.lift_kaehler_differential_comp _),
+  right_inv := derivation.lift_kaehler_differential_comp,
+  ..(derivation.llcomp.flip $ kaehler_differential.D R S) }
+
+/-- The quotient ring of `S ⊗ S ⧸ J ^ 2` by `Ω[S⁄R]` is isomorphic to `S`. -/
+def kaehler_differential.quotient_cotangent_ideal_ring_equiv :
+  (S ⊗ S ⧸ kaehler_differential.ideal R S ^ 2) ⧸
+    (kaehler_differential.ideal R S).cotangent_ideal ≃+* S :=
+begin
+  have : function.right_inverse tensor_product.include_left
+    (↑(tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S) : S ⊗[R] S →+* S),
+  { intro x, rw [alg_hom.coe_to_ring_hom, ← alg_hom.comp_apply,
+      tensor_product.lmul'_comp_include_left], refl },
+  refine (ideal.quot_cotangent _).trans _,
+  refine (ideal.quot_equiv_of_eq _).trans (ring_hom.quotient_ker_equiv_of_right_inverse this),
+  ext, refl,
+end
+
+/-- The quotient ring of `S ⊗ S ⧸ J ^ 2` by `Ω[S⁄R]` is isomorphic to `S` as an `S`-algebra. -/
+def kaehler_differential.quotient_cotangent_ideal :
+  ((S ⊗ S ⧸ kaehler_differential.ideal R S ^ 2) ⧸
+    (kaehler_differential.ideal R S).cotangent_ideal) ≃ₐ[S] S :=
+{ commutes' := (kaehler_differential.quotient_cotangent_ideal_ring_equiv R S).apply_symm_apply,
+  ..kaehler_differential.quotient_cotangent_ideal_ring_equiv R S }
+
+lemma kaehler_differential.End_equiv_aux (f : S →ₐ[R] S ⊗ S ⧸ kaehler_differential.ideal R S ^ 2) :
+  (ideal.quotient.mkₐ R (kaehler_differential.ideal R S).cotangent_ideal).comp f =
+    is_scalar_tower.to_alg_hom R S _ ↔
+  (tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S).ker_square_lift.comp f = alg_hom.id R S :=
+begin
+  rw [alg_hom.ext_iff, alg_hom.ext_iff],
+  apply forall_congr,
+  intro x,
+  have e₁ : (tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S).ker_square_lift (f x) =
+    kaehler_differential.quotient_cotangent_ideal_ring_equiv R S
+      (ideal.quotient.mk (kaehler_differential.ideal R S).cotangent_ideal $ f x),
+  { generalize : f x = y, obtain ⟨y, rfl⟩ := ideal.quotient.mk_surjective y, refl },
+  have e₂ : x = kaehler_differential.quotient_cotangent_ideal_ring_equiv
+    R S (is_scalar_tower.to_alg_hom R S _ x),
+  { exact (mul_one x).symm },
+  split,
+  { intro e,
+    exact (e₁.trans (@ring_equiv.congr_arg _ _ _ _ _ _
+      (kaehler_differential.quotient_cotangent_ideal_ring_equiv R S) _ _ e)).trans e₂.symm },
+  { intro e, apply (kaehler_differential.quotient_cotangent_ideal_ring_equiv R S).injective,
+    exact e₁.symm.trans (e.trans e₂) }
+end
+
+/-- Derivations into `Ω[S⁄R]` is equivalent to derivations
+into `(kaehler_differential.ideal R S).cotangent_ideal` -/
+-- This has type
+-- `derivation R S Ω[S⁄R] ≃ₗ[R] derivation R S (kaehler_differential.ideal R S).cotangent_ideal`
+-- But lean times-out if this is given explicitly.
+noncomputable
+def kaehler_differential.End_equiv_derivation' :
+  derivation R S Ω[S⁄R] ≃ₗ[R] derivation R S _ :=
+linear_equiv.comp_der ((kaehler_differential.ideal R S).cotangent_equiv_ideal.restrict_scalars S)
+
+/-- (Implementation) An `equiv` version of `kaehler_differential.End_equiv_aux`.
+Used in `kaehler_differential.End_equiv`. -/
+def kaehler_differential.End_equiv_aux_equiv :
+  {f // (ideal.quotient.mkₐ R (kaehler_differential.ideal R S).cotangent_ideal).comp f =
+    is_scalar_tower.to_alg_hom R S _ } ≃
+  { f // (tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S).ker_square_lift.comp f = alg_hom.id R S } :=
+(equiv.refl _).subtype_equiv (kaehler_differential.End_equiv_aux R S)
+
+/--
+The endomorphisms of `Ω[S⁄R]` corresponds to sections of the surjection `S ⊗[R] S ⧸ J ^ 2 →ₐ[R] S`,
+with `J` being the kernel of the multiplication map `S ⊗[R] S →ₐ[R] S`.
+-/
+noncomputable
+def kaehler_differential.End_equiv :
+  module.End S Ω[S⁄R] ≃
+    { f // (tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S).ker_square_lift.comp f = alg_hom.id R S } :=
+(kaehler_differential.linear_map_equiv_derivation R S).to_equiv.trans $
+  (kaehler_differential.End_equiv_derivation' R S).to_equiv.trans $
+  (derivation_to_square_zero_equiv_lift
+  (kaehler_differential.ideal R S).cotangent_ideal
+  (kaehler_differential.ideal R S).cotangent_ideal_square).trans $
+  kaehler_differential.End_equiv_aux_equiv R S
+
+section presentation
+
+open kaehler_differential (D)
+open finsupp (single)
+
+/-- The `S`-submodule of `S →₀ S` (the direct sum of copies of `S` indexed by `S`) generated by
+the relations:
+1. `dx + dy = d(x + y)`
+2. `x dy + y dx = d(x * y)`
+3. `dr = 0` for `r ∈ R`
+where `db` is the unit in the copy of `S` with index `b`.
+
+This is the kernel of the surjection `finsupp.total S Ω[S⁄R] S (kaehler_differential.D R S)`.
+See `kaehler_differential.ker_total_eq` and `kaehler_differential.total_surjective`.
+-/
+noncomputable
+def kaehler_differential.ker_total : submodule S (S →₀ S) :=
+submodule.span S
+  ((set.range (λ (x : S × S), single x.1 1 + single x.2 1 - single (x.1 + x.2) 1)) ∪
+  (set.range (λ (x : S × S), single x.2 x.1 + single x.1 x.2 - single (x.1 * x.2) 1)) ∪
+  (set.range (λ x : R, single (algebra_map R S x) 1)))
+
+local notation x `𝖣` y := (kaehler_differential.ker_total R S).mkq (single y x)
+
+lemma kaehler_differential.ker_total_mkq_single_add (x y z) :
+  (z 𝖣 (x + y)) = (z 𝖣 x) + (z 𝖣 y) :=
+begin
+  rw [← map_add, eq_comm, ← sub_eq_zero, ← map_sub, submodule.mkq_apply,
+    submodule.quotient.mk_eq_zero],
+  simp_rw [← finsupp.smul_single_one _ z, ← smul_add, ← smul_sub],
+  exact submodule.smul_mem _ _ (submodule.subset_span (or.inl $ or.inl $ ⟨⟨_, _⟩, rfl⟩)),
+end
+
+lemma kaehler_differential.ker_total_mkq_single_mul (x y z) :
+  (z 𝖣 (x * y)) = ((z * x) 𝖣 y) + ((z * y) 𝖣 x) :=
+begin
+  rw [← map_add, eq_comm, ← sub_eq_zero, ← map_sub, submodule.mkq_apply,
+    submodule.quotient.mk_eq_zero],
+  simp_rw [← finsupp.smul_single_one _ z, ← @smul_eq_mul _ _ z,
+    ← finsupp.smul_single, ← smul_add, ← smul_sub],
+  exact submodule.smul_mem _ _ (submodule.subset_span (or.inl $ or.inr $ ⟨⟨_, _⟩, rfl⟩)),
+end
+
+lemma kaehler_differential.ker_total_mkq_single_algebra_map (x y) :
+  (y 𝖣 (algebra_map R S x)) = 0 :=
+begin
+  rw [submodule.mkq_apply, submodule.quotient.mk_eq_zero, ← finsupp.smul_single_one _ y],
+  exact submodule.smul_mem _ _ (submodule.subset_span (or.inr $ ⟨_, rfl⟩)),
+end
+
+lemma kaehler_differential.ker_total_mkq_single_algebra_map_one (x) :
+  (x 𝖣 1) = 0 :=
+begin
+  rw [← (algebra_map R S).map_one, kaehler_differential.ker_total_mkq_single_algebra_map],
+end
+
+lemma kaehler_differential.ker_total_mkq_single_smul (r : R) (x y) :
+  (y 𝖣 (r • x)) = r • (y 𝖣 x) :=
+begin
+  rw [algebra.smul_def, kaehler_differential.ker_total_mkq_single_mul,
+    kaehler_differential.ker_total_mkq_single_algebra_map, add_zero,
+    ← linear_map.map_smul_of_tower, finsupp.smul_single, mul_comm, algebra.smul_def],
+end
+
+/-- The (universal) derivation into `(S →₀ S) ⧸ kaehler_differential.ker_total R S`. -/
+noncomputable
+def kaehler_differential.derivation_quot_ker_total :
+  derivation R S ((S →₀ S) ⧸ kaehler_differential.ker_total R S) :=
+{ to_fun := λ x, 1 𝖣 x,
+  map_add' := λ x y, kaehler_differential.ker_total_mkq_single_add _ _ _ _ _,
+  map_smul' := λ r s, kaehler_differential.ker_total_mkq_single_smul _ _ _ _ _,
+  map_one_eq_zero' := kaehler_differential.ker_total_mkq_single_algebra_map_one _ _ _,
+  leibniz' := λ a b, (kaehler_differential.ker_total_mkq_single_mul _ _ _ _ _).trans
+    (by { simp_rw [← finsupp.smul_single_one _ (1 * _ : S)], dsimp, simp }) }
+
+lemma kaehler_differential.derivation_quot_ker_total_apply (x) :
+  kaehler_differential.derivation_quot_ker_total R S x = (1 𝖣 x) := rfl
+
+lemma kaehler_differential.derivation_quot_ker_total_lift_comp_total :
+  (kaehler_differential.derivation_quot_ker_total R S).lift_kaehler_differential.comp
+    (finsupp.total S Ω[S⁄R] S (kaehler_differential.D R S)) = submodule.mkq _ :=
+begin
+  apply finsupp.lhom_ext,
+  intros a b,
+  conv_rhs { rw [← finsupp.smul_single_one a b, linear_map.map_smul] },
+  simp [kaehler_differential.derivation_quot_ker_total_apply],
+end
+
+lemma kaehler_differential.ker_total_eq :
+  (finsupp.total S Ω[S⁄R] S (kaehler_differential.D R S)).ker =
+    kaehler_differential.ker_total R S :=
+begin
+  apply le_antisymm,
+  { conv_rhs { rw ← (kaehler_differential.ker_total R S).ker_mkq },
+    rw ← kaehler_differential.derivation_quot_ker_total_lift_comp_total,
+    exact linear_map.ker_le_ker_comp _ _ },
+  { rw [kaehler_differential.ker_total, submodule.span_le],
+    rintros _ ((⟨⟨x, y⟩, rfl⟩|⟨⟨x, y⟩, rfl⟩)|⟨x, rfl⟩); dsimp; simp [linear_map.mem_ker] },
+end
+
+lemma kaehler_differential.total_surjective :
+  function.surjective (finsupp.total S Ω[S⁄R] S (kaehler_differential.D R S)) :=
+begin
+  rw [← linear_map.range_eq_top, finsupp.range_total, kaehler_differential.span_range_derivation],
+end
+
+/-- `Ω[S⁄R]` is isomorphic to `S` copies of `S` with kernel `kaehler_differential.ker_total`. -/
+@[simps] noncomputable
+def kaehler_differential.quot_ker_total_equiv :
+  ((S →₀ S) ⧸ kaehler_differential.ker_total R S) ≃ₗ[S] Ω[S⁄R] :=
+{ inv_fun := (kaehler_differential.derivation_quot_ker_total R S).lift_kaehler_differential,
+  left_inv := begin
+    intro x,
+    obtain ⟨x, rfl⟩ := submodule.mkq_surjective _ x,
+    exact linear_map.congr_fun
+      (kaehler_differential.derivation_quot_ker_total_lift_comp_total R S : _) x,
+  end,
+  right_inv := begin
+    intro x,
+    obtain ⟨x, rfl⟩ := kaehler_differential.total_surjective R S x,
+    erw linear_map.congr_fun
+      (kaehler_differential.derivation_quot_ker_total_lift_comp_total R S : _) x,
+    refl
+  end,
+  ..(kaehler_differential.ker_total R S).liftq
+    (finsupp.total S Ω[S⁄R] S (kaehler_differential.D R S))
+    (kaehler_differential.ker_total_eq R S).ge }
+
+lemma kaehler_differential.quot_ker_total_equiv_symm_comp_D :
+  (kaehler_differential.quot_ker_total_equiv R S).symm.to_linear_map.comp_der
+    (kaehler_differential.D R S) = kaehler_differential.derivation_quot_ker_total R S :=
+by convert
+  (kaehler_differential.derivation_quot_ker_total R S).lift_kaehler_differential_comp using 0
+
+variables (A B : Type*) [comm_ring A] [comm_ring B] [algebra R A] [algebra S B] [algebra R B]
+variables [algebra A B] [is_scalar_tower R S B] [is_scalar_tower R A B]
+
+-- The map `(A →₀ A) →ₗ[A] (B →₀ B)`
+local notation `finsupp_map` := ((finsupp.map_range.linear_map (algebra.linear_map A B))
+  .comp (finsupp.lmap_domain A A (algebra_map A B)))
+
+lemma kaehler_differential.ker_total_map (h : function.surjective (algebra_map A B)) :
+  (kaehler_differential.ker_total R A).map finsupp_map ⊔
+    submodule.span A (set.range (λ x : S, single (algebra_map S B x) (1 : B))) =
+    (kaehler_differential.ker_total S B).restrict_scalars _  :=
+begin
+  rw [kaehler_differential.ker_total, submodule.map_span, kaehler_differential.ker_total,
+    submodule.restrict_scalars_span _ _ h],
+  simp_rw [set.image_union, submodule.span_union, ← set.image_univ, set.image_image,
+    set.image_univ, map_sub, map_add],
+  simp only [linear_map.comp_apply, finsupp.map_range.linear_map_apply, finsupp.map_range_single,
+    finsupp.lmap_domain_apply, finsupp.map_domain_single, alg_hom.to_linear_map_apply,
+    algebra.linear_map_apply, ← is_scalar_tower.algebra_map_apply, map_one, map_add, map_mul],
+  simp_rw [sup_assoc, ← (h.prod_map h).range_comp],
+  congr' 3,
+  rw [sup_eq_right],
+  apply submodule.span_mono,
+  simp_rw is_scalar_tower.algebra_map_apply R S B,
+  exact set.range_comp_subset_range (algebra_map R S) (λ x, single (algebra_map S B x) (1 : B))
+end
+
+end presentation
+
+section exact_sequence
+
+/- We have the commutative diagram
+A --→ B
+↑     ↑
+|     |
+R --→ S -/
+variables (A B : Type*) [comm_ring A] [comm_ring B] [algebra R A] [algebra R B]
+variables [algebra A B] [algebra S B] [is_scalar_tower R A B] [is_scalar_tower R S B]
+
+variables {R B}
+
+/-- For a tower `R → A → B` and an `R`-derivation `B → M`, we may compose with `A → B` to obtain an
+`R`-derivation `A → M`. -/
+def derivation.comp_algebra_map [module A M] [module B M] [is_scalar_tower A B M]
+  (d : derivation R B M) : derivation R A M :=
+{ map_one_eq_zero' := by simp,
+  leibniz' := λ a b, by simp,
+  to_linear_map := d.to_linear_map.comp (is_scalar_tower.to_alg_hom R A B).to_linear_map }
+
+variables (R B) [smul_comm_class S A B]
+
+/-- The map `Ω[A⁄R] →ₗ[A] Ω[B⁄R]` given a square
+A --→ B
+↑     ↑
+|     |
+R --→ S -/
+def kaehler_differential.map : Ω[A⁄R] →ₗ[A] Ω[B⁄S] :=
+derivation.lift_kaehler_differential
+  (((kaehler_differential.D S B).restrict_scalars R).comp_algebra_map A)
+
+lemma kaehler_differential.map_comp_der :
+  (kaehler_differential.map R S A B).comp_der (kaehler_differential.D R A) =
+    (((kaehler_differential.D S B).restrict_scalars R).comp_algebra_map A) :=
+derivation.lift_kaehler_differential_comp _
+
+lemma kaehler_differential.map_D (x : A) :
+  kaehler_differential.map R S A B (kaehler_differential.D R A x) =
+    kaehler_differential.D S B (algebra_map A B x) :=
+derivation.congr_fun (kaehler_differential.map_comp_der R S A B) x
+
+open is_scalar_tower (to_alg_hom)
+
+lemma kaehler_differential.map_surjective_of_surjective
+  (h : function.surjective (algebra_map A B)) :
+  function.surjective (kaehler_differential.map R S A B) :=
+begin
+  rw [← linear_map.range_eq_top, _root_.eq_top_iff, ← @submodule.restrict_scalars_top B A,
+    ← kaehler_differential.span_range_derivation, submodule.restrict_scalars_span _ _ h,
+    submodule.span_le],
+  rintros _ ⟨x, rfl⟩,
+  obtain ⟨y, rfl⟩ := h x,
+  rw ← kaehler_differential.map_D R S A B,
+  exact ⟨_, rfl⟩,
+end
+
+/-- The lift of the map `Ω[A⁄R] →ₗ[A] Ω[B⁄R]` to the base change along `A → B`.
+This is the first map in the exact sequence `B ⊗[A] Ω[A⁄R] → Ω[B⁄R] → Ω[B⁄A] → 0`. -/
+noncomputable
+def kaehler_differential.map_base_change : B ⊗[A] Ω[A⁄R] →ₗ[B] Ω[B⁄R] :=
+(tensor_product.is_base_change A Ω[A⁄R] B).lift (kaehler_differential.map R R A B)
+
+@[simp]
+lemma kaehler_differential.map_base_change_tmul (x : B) (y : Ω[A⁄R]) :
+  kaehler_differential.map_base_change R A B (x ⊗ₜ y) =
+    x • kaehler_differential.map R R A B y :=
+begin
+  conv_lhs { rw [← mul_one x, ← smul_eq_mul, ← tensor_product.smul_tmul', linear_map.map_smul] },
+  congr' 1,
+  exact is_base_change.lift_eq _ _ _
+end
+
+end exact_sequence
+
+end kaehler_differential
diff --git a/src/ring_theory/laurent_series.lean b/src/ring_theory/laurent_series.lean
index a4b55ca32c77a..430e199e496ea 100644
--- a/src/ring_theory/laurent_series.lean
+++ b/src/ring_theory/laurent_series.lean
@@ -9,6 +9,9 @@ import ring_theory.localization.fraction_ring
 /-!
 # Laurent Series
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 * Defines `laurent_series` as an abbreviation for `hahn_series ℤ`.
 * Provides a coercion `power_series R` into `laurent_series R` given by
@@ -43,7 +46,7 @@ lemma coe_power_series (x : power_series R) : (x : laurent_series R) =
 
 @[simp] lemma coeff_coe_power_series (x : power_series R) (n : ℕ) :
   hahn_series.coeff (x : laurent_series R) n = power_series.coeff R n x :=
-by rw [← int.nat_cast_eq_coe_nat, coe_power_series, of_power_series_apply_coeff]
+by rw [coe_power_series, of_power_series_apply_coeff]
 
 /-- This is a power series that can be multiplied by an integer power of `X` to give our
   Laurent series. If the Laurent series is nonzero, `power_series_part` has a nonzero
@@ -84,8 +87,7 @@ begin
     { contrapose! h,
       exact order_le_of_coeff_ne_zero h.symm },
     { contrapose! h,
-      simp only [set.mem_range, rel_embedding.coe_fn_mk, function.embedding.coe_fn_mk,
-        int.nat_cast_eq_coe_nat] at h,
+      simp only [set.mem_range, rel_embedding.coe_fn_mk, function.embedding.coe_fn_mk] at h,
       obtain ⟨m, hm⟩ := h,
       rw [← sub_nonneg, ← hm],
       exact int.zero_le_of_nat _ } }
@@ -122,14 +124,13 @@ rfl
     by_cases h : 0 ≤ z.order,
     { refine ⟨⟨power_series.X ^ (int.nat_abs z.order) * power_series_part z, 1⟩, _⟩,
       simp only [ring_hom.map_one, mul_one, ring_hom.map_mul, coe_algebra_map,
-        of_power_series_X_pow, submonoid.coe_one, int.nat_cast_eq_coe_nat],
+        of_power_series_X_pow, submonoid.coe_one],
       rw [int.nat_abs_of_nonneg h, ← coe_power_series, single_order_mul_power_series_part] },
     { refine ⟨⟨power_series_part z, power_series.X ^ (int.nat_abs z.order), ⟨_, rfl⟩⟩, _⟩,
       simp only [coe_algebra_map, of_power_series_power_series_part],
       rw [mul_comm _ z],
       refine congr rfl _,
-      rw [subtype.coe_mk, of_power_series_X_pow,
-          int.nat_cast_eq_coe_nat, int.of_nat_nat_abs_of_nonpos],
+      rw [subtype.coe_mk, of_power_series_X_pow, int.of_nat_nat_abs_of_nonpos],
       exact le_of_not_ge h } end),
   eq_iff_exists := (begin intros x y,
     rw [coe_algebra_map, of_power_series_injective.eq_iff],
@@ -137,14 +138,13 @@ rfl
     { rintro rfl,
       exact ⟨1, rfl⟩ },
     { rintro ⟨⟨_, n, rfl⟩, hc⟩,
-      rw [← sub_eq_zero, ← sub_mul, power_series.ext_iff] at hc,
+      rw [← sub_eq_zero, ← mul_sub, power_series.ext_iff] at hc,
       rw [← sub_eq_zero, power_series.ext_iff],
       intro m,
       have h := hc (m + n),
-      rw [linear_map.map_zero, subtype.coe_mk, power_series.X_pow_eq, power_series.monomial,
-        power_series.coeff, finsupp.single_add, mv_power_series.coeff_add_mul_monomial,
-        mul_one] at h,
-      exact h } end) }
+      rwa [linear_map.map_zero, subtype.coe_mk, power_series.X_pow_eq, power_series.monomial,
+        add_comm m, power_series.coeff, finsupp.single_add, mv_power_series.coeff_add_monomial_mul,
+        one_mul] at h } end) }
 
 instance {K : Type u} [field K] : is_fraction_ring (power_series K) (laurent_series K) :=
 is_localization.of_le (submonoid.powers (power_series.X : power_series K)) _
@@ -189,7 +189,7 @@ begin
         if_pos (int.neg_succ_lt_zero _)],
     simp only [not_exists, rel_embedding.coe_fn_mk, set.mem_image, not_and,
                function.embedding.coe_fn_mk, ne.def, to_power_series_symm_apply_coeff, mem_support,
-               int.nat_cast_eq_coe_nat, int.coe_nat_eq, implies_true_iff, not_false_iff] }
+               int.coe_nat_eq, implies_true_iff, not_false_iff] }
 end
 
 @[simp, norm_cast] lemma coe_C (r : R) : ((C R r : power_series R) : laurent_series R) =
diff --git a/src/ring_theory/local_properties.lean b/src/ring_theory/local_properties.lean
index 55d84571f12df..47bf634d18d70 100644
--- a/src/ring_theory/local_properties.lean
+++ b/src/ring_theory/local_properties.lean
@@ -3,33 +3,36 @@ Copyright (c) 2021 Andrew Yang. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Andrew Yang
 -/
-import group_theory.submonoid.pointwise
-import logic.equiv.transfer_instance
-import ring_theory.finiteness
+import ring_theory.finite_type
 import ring_theory.localization.at_prime
-import ring_theory.localization.away
+import ring_theory.localization.away.basic
 import ring_theory.localization.integer
 import ring_theory.localization.submodule
 import ring_theory.nilpotent
+import ring_theory.ring_hom_properties
 
 /-!
 # Local properties of commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we provide the proofs of various local properties.
 
 ## Naming Conventions
 
 * `localization_P` : `P` holds for `S⁻¹R` if `P` holds for `R`.
-* `P_of_localization_maximal` : `P` holds for `R` if `P` holds for `Aₘ` for all maximal `m`.
+* `P_of_localization_maximal` : `P` holds for `R` if `P` holds for `Rₘ` for all maximal `m`.
+* `P_of_localization_prime` : `P` holds for `R` if `P` holds for `Rₘ` for all prime `m`.
 * `P_of_localization_span` : `P` holds for `R` if given a spanning set `{fᵢ}`, `P` holds for all
-  `A_{fᵢ}`.
+  `R_{fᵢ}`.
 
 ## Main results
 
 The following properties are covered:
 
 * The triviality of an ideal or an element:
-  `ideal_eq_zero_of_localization`, `eq_zero_of_localization`
+  `ideal_eq_bot_of_localization`, `eq_zero_of_localization`
 * `is_reduced` : `localization_is_reduced`, `is_reduced_of_localization_maximal`.
 * `finite`: `localization_finite`, `finite_of_localization_span`
 * `finite_type`: `localization_finite_type`, `finite_type_of_localization_span`
@@ -75,10 +78,10 @@ include P
 /-- A property `P` of ring homs is said to be preserved by localization
  if `P` holds for `M⁻¹R →+* M⁻¹S` whenever `P` holds for `R →+* S`. -/
 def ring_hom.localization_preserves :=
-  ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S) (M : by exactI submonoid R)
+  ∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S) (M : by exactI submonoid R)
     (R' S' : Type u) [comm_ring R'] [comm_ring S'] [by exactI algebra R R']
     [by exactI algebra S S'] [by exactI is_localization M R']
-    [by exactI is_localization (M.map (f : R →* S)) S'],
+    [by exactI is_localization (M.map f) S'],
     by exactI (P f → P (is_localization.map S' f (submonoid.le_comap_map M) : R' →+* S'))
 
 /-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span`
@@ -88,7 +91,7 @@ if `P` holds for `R →+* S` whenever there exists a finite set `{ r }` that spa
 Note that this is equivalent to `ring_hom.of_localization_span` via
 `ring_hom.of_localization_span_iff_finite`, but this is easier to prove. -/
 def ring_hom.of_localization_finite_span :=
-  ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
+  ∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
     (s : finset R) (hs : by exactI ideal.span (s : set R) = ⊤)
     (H : by exactI (∀ (r : s), P (localization.away_map f r))), by exactI P f
 
@@ -99,10 +102,55 @@ if `P` holds for `R →+* S` whenever there exists a set `{ r }` that spans `R`
 Note that this is equivalent to `ring_hom.of_localization_finite_span` via
 `ring_hom.of_localization_span_iff_finite`, but this has less restrictions when applying. -/
 def ring_hom.of_localization_span :=
-  ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
+  ∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
     (s : set R) (hs : by exactI ideal.span s = ⊤)
     (H : by exactI (∀ (r : s), P (localization.away_map f r))), by exactI P f
 
+/-- A property `P` of ring homs satisfies `ring_hom.holds_for_localization_away`
+ if `P` holds for each localization map `R →+* Rᵣ`. -/
+def ring_hom.holds_for_localization_away : Prop :=
+∀ ⦃R : Type u⦄ (S : Type u) [comm_ring R] [comm_ring S] [by exactI algebra R S] (r : R)
+  [by exactI is_localization.away r S], by exactI P (algebra_map R S)
+
+/-- A property `P` of ring homs satisfies `ring_hom.of_localization_finite_span_target`
+if `P` holds for `R →+* S` whenever there exists a finite set `{ r }` that spans `S` such that
+`P` holds for `R →+* Sᵣ`.
+
+Note that this is equivalent to `ring_hom.of_localization_span_target` via
+`ring_hom.of_localization_span_target_iff_finite`, but this is easier to prove. -/
+def ring_hom.of_localization_finite_span_target : Prop :=
+∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
+  (s : finset S) (hs : by exactI ideal.span (s : set S) = ⊤)
+  (H : by exactI (∀ (r : s), P ((algebra_map S (localization.away (r : S))).comp f))),
+  by exactI P f
+
+/-- A property `P` of ring homs satisfies `ring_hom.of_localization_span_target`
+if `P` holds for `R →+* S` whenever there exists a set `{ r }` that spans `S` such that
+`P` holds for `R →+* Sᵣ`.
+
+Note that this is equivalent to `ring_hom.of_localization_finite_span_target` via
+`ring_hom.of_localization_span_target_iff_finite`, but this has less restrictions when applying. -/
+def ring_hom.of_localization_span_target : Prop :=
+∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S)
+  (s : set S) (hs : by exactI ideal.span s = ⊤)
+  (H : by exactI (∀ (r : s), P ((algebra_map S (localization.away (r : S))).comp f))),
+  by exactI P f
+
+/-- A property `P` of ring homs satisfies `of_localization_prime` if
+  if `P` holds for `R` whenever `P` holds for `Rₘ` for all prime ideals `p`. -/
+def ring_hom.of_localization_prime : Prop :=
+∀ ⦃R S : Type u⦄ [comm_ring R] [comm_ring S] (f : by exactI R →+* S),
+  by exactI (∀ (J : ideal S) (hJ : J.is_prime),
+    by exactI P (localization.local_ring_hom _ J f rfl)) → P f
+
+/-- A property of ring homs is local if it is preserved by localizations and compositions, and for
+each `{ r }` that spans `S`, we have `P (R →+* S) ↔ ∀ r, P (R →+* Sᵣ)`. -/
+structure ring_hom.property_is_local : Prop :=
+(localization_preserves : ring_hom.localization_preserves @P)
+(of_localization_span_target : ring_hom.of_localization_span_target @P)
+(stable_under_composition : ring_hom.stable_under_composition @P)
+(holds_for_localization_away : ring_hom.holds_for_localization_away @P)
+
 lemma ring_hom.of_localization_span_iff_finite :
   ring_hom.of_localization_span @P ↔ ring_hom.of_localization_finite_span @P :=
 begin
@@ -116,63 +164,126 @@ begin
     exact h s' h₂ (λ x, hs' ⟨_, h₁ x.prop⟩) }
 end
 
+lemma ring_hom.of_localization_span_target_iff_finite :
+  ring_hom.of_localization_span_target @P ↔ ring_hom.of_localization_finite_span_target @P :=
+begin
+  delta ring_hom.of_localization_span_target ring_hom.of_localization_finite_span_target,
+  apply forall₅_congr, -- TODO: Using `refine` here breaks `resetI`.
+  introsI,
+  split,
+  { intros h s, exact h s },
+  { intros h s hs hs',
+    obtain ⟨s', h₁, h₂⟩ := (ideal.span_eq_top_iff_finite s).mp hs,
+    exact h s' h₂ (λ x, hs' ⟨_, h₁ x.prop⟩) }
+end
+
 variables {P f R' S'}
 
+lemma _root_.ring_hom.property_is_local.respects_iso (hP : ring_hom.property_is_local @P) :
+  ring_hom.respects_iso @P :=
+begin
+  apply hP.stable_under_composition.respects_iso,
+  introv,
+  resetI,
+  letI := e.to_ring_hom.to_algebra,
+  apply_with hP.holds_for_localization_away { instances := ff },
+  apply is_localization.away_of_is_unit_of_bijective _ is_unit_one,
+  exact e.bijective
+end
+
 -- Almost all arguments are implicit since this is not intended to use mid-proof.
-lemma ring_hom.localization_away_of_localization_preserves
-  (H : ring_hom.localization_preserves @P) {r : R} [is_localization.away r R']
+lemma ring_hom.localization_preserves.away
+  (H : ring_hom.localization_preserves @P) (r : R) [is_localization.away r R']
   [is_localization.away (f r) S'] (hf : P f) :
     P (by exactI is_localization.away.map R' S' f r) :=
 begin
   resetI,
-  haveI : is_localization ((submonoid.powers r).map (f : R →* S)) S',
+  haveI : is_localization ((submonoid.powers r).map f) S',
   { rw submonoid.map_powers, assumption },
   exact H f (submonoid.powers r) R' S' hf,
 end
 
+lemma ring_hom.property_is_local.of_localization_span (hP : ring_hom.property_is_local @P) :
+  ring_hom.of_localization_span @P :=
+begin
+  introv R hs hs',
+  resetI,
+  apply_fun (ideal.map f) at hs,
+  rw [ideal.map_span, ideal.map_top] at hs,
+  apply hP.of_localization_span_target _ _ hs,
+  rintro ⟨_, r, hr, rfl⟩,
+  have := hs' ⟨r, hr⟩,
+  convert hP.stable_under_composition _ _ (hP.holds_for_localization_away (localization.away r) r)
+    (hs' ⟨r, hr⟩) using 1,
+  exact (is_localization.map_comp _).symm
+end
+
 end ring_hom
 
 end properties
 
 section ideal
 
--- This proof should work for all modules, but we do not know how to localize a module yet.
-/-- An ideal is trivial if its localization at every maximal ideal is trivial. -/
-lemma ideal_eq_zero_of_localization (I : ideal R)
-   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
-      by exactI is_localization.coe_submodule (localization.at_prime J) I = 0) : I = 0 :=
+open_locale non_zero_divisors
+
+/-- Let `I J : ideal R`. If the localization of `I` at each maximal ideal `P` is included in
+the localization of `J` at `P`, then `I ≤ J`. -/
+lemma ideal.le_of_localization_maximal {I J : ideal R}
+  (h : ∀ (P : ideal R) (hP : P.is_maximal),
+    ideal.map (algebra_map R (by exactI localization.at_prime P)) I ≤
+      ideal.map (algebra_map R (by exactI localization.at_prime P)) J) :
+  I ≤ J :=
 begin
-  by_contradiction hI,
-  obtain ⟨x, hx, hx'⟩ := set.exists_of_ssubset (bot_lt_iff_ne_bot.mpr hI),
-  rw [submodule.bot_coe, set.mem_singleton_iff] at hx',
-  have H : (ideal.span ({x} : set R)).annihilator ≠ ⊤,
-  { rw [ne.def, submodule.annihilator_eq_top_iff],
-    by_contra,
-    apply hx',
-    rw [← set.mem_singleton_iff, ← @submodule.bot_coe R, ← h],
-    exact ideal.subset_span (set.mem_singleton x) },
-  obtain ⟨p, hp₁, hp₂⟩ := ideal.exists_le_maximal _ H,
-  resetI,
-  specialize h p hp₁,
-  have : algebra_map R (localization.at_prime p) x = 0,
-  { rw ← set.mem_singleton_iff,
-    change algebra_map R (localization.at_prime p) x ∈ (0 : submodule R (localization.at_prime p)),
-    rw ← h,
-    exact submodule.mem_map_of_mem hx },
-  rw is_localization.map_eq_zero_iff p.prime_compl at this,
-  obtain ⟨m, hm⟩ := this,
-  apply m.prop,
-  refine hp₂ _,
-  erw submodule.mem_annihilator_span_singleton,
-  rwa mul_comm at hm,
+  intros x hx,
+  suffices : J.colon (ideal.span {x}) = ⊤,
+  { simpa using submodule.mem_colon.mp
+      (show (1 : R) ∈ J.colon (ideal.span {x}), from this.symm ▸ submodule.mem_top)
+      x (ideal.mem_span_singleton_self x) },
+  refine not.imp_symm (J.colon (ideal.span {x})).exists_le_maximal _,
+  push_neg,
+  introsI P hP le,
+  obtain ⟨⟨⟨a, ha⟩, ⟨s, hs⟩⟩, eq⟩ := (is_localization.mem_map_algebra_map_iff P.prime_compl _).mp
+    (h P hP (ideal.mem_map_of_mem _ hx)),
+  rw [← _root_.map_mul, ← sub_eq_zero, ← map_sub] at eq,
+  obtain ⟨⟨m, hm⟩, eq⟩ := (is_localization.map_eq_zero_iff P.prime_compl _ _).mp eq,
+  refine hs ((hP.is_prime.mem_or_mem (le (ideal.mem_colon_singleton.mpr _))).resolve_right hm),
+  simp only [subtype.coe_mk, mul_sub, sub_eq_zero, mul_comm x s, mul_left_comm] at eq,
+  simpa only [mul_assoc, eq] using J.mul_mem_left m ha
 end
 
+/-- Let `I J : ideal R`. If the localization of `I` at each maximal ideal `P` is equal to
+the localization of `J` at `P`, then `I = J`. -/
+theorem ideal.eq_of_localization_maximal {I J : ideal R}
+  (h : ∀ (P : ideal R) (hP : P.is_maximal),
+    ideal.map (algebra_map R (by exactI localization.at_prime P)) I =
+      ideal.map (algebra_map R (by exactI localization.at_prime P)) J) :
+  I = J :=
+le_antisymm
+  (ideal.le_of_localization_maximal (λ P hP, (h P hP).le))
+  (ideal.le_of_localization_maximal (λ P hP, (h P hP).ge))
+
+/-- An ideal is trivial if its localization at every maximal ideal is trivial. -/
+lemma ideal_eq_bot_of_localization' (I : ideal R)
+   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
+      ideal.map (algebra_map R (by exactI (localization.at_prime J))) I = ⊥) : I = ⊥ :=
+ideal.eq_of_localization_maximal (λ P hP, (by simpa using h P hP))
+
+-- TODO: This proof should work for all modules, once we have enough material on submodules of
+-- localized modules.
+/-- An ideal is trivial if its localization at every maximal ideal is trivial. -/
+lemma ideal_eq_bot_of_localization (I : ideal R)
+   (h : ∀ (J : ideal R) (hJ : J.is_maximal),
+      by exactI is_localization.coe_submodule (localization.at_prime J) I = ⊥) : I = ⊥ :=
+ideal_eq_bot_of_localization' _ (λ P hP, (ideal.map_eq_bot_iff_le_ker _).mpr (λ x hx,
+  by { rw [ring_hom.mem_ker, ← submodule.mem_bot R, ← h P hP, is_localization.mem_coe_submodule],
+       exact ⟨x, hx, rfl⟩ }))
+
 lemma eq_zero_of_localization (r : R)
    (h : ∀ (J : ideal R) (hJ : J.is_maximal),
       by exactI algebra_map R (localization.at_prime J) r = 0) : r = 0 :=
 begin
   rw ← ideal.span_singleton_eq_bot,
-  apply ideal_eq_zero_of_localization,
+  apply ideal_eq_bot_of_localization,
   intros J hJ,
   delta is_localization.coe_submodule,
   erw [submodule.map_span, submodule.span_eq_bot],
@@ -199,8 +310,8 @@ begin
   rw [← (algebra_map R S).map_zero] at hx',
   obtain ⟨m', hm'⟩ := (is_localization.eq_iff_exists M S).mp hx',
   apply_fun (*m'^n) at hm',
-  simp only [mul_assoc, zero_mul] at hm',
-  rw [mul_comm, ← pow_succ, ← mul_pow] at hm',
+  simp only [mul_assoc, zero_mul, mul_zero] at hm',
+  rw [← mul_left_comm, ← pow_succ, ← mul_pow] at hm',
   replace hm' := is_nilpotent.eq_zero ⟨_, hm'.symm⟩,
   rw [← (is_localization.map_units S m).mul_left_inj, hx, zero_mul,
     is_localization.map_eq_zero_iff M],
@@ -224,6 +335,41 @@ end
 
 end reduced
 
+section surjective
+
+lemma localization_preserves_surjective :
+  ring_hom.localization_preserves (λ R S _ _ f, function.surjective f) :=
+begin
+  introv R H x,
+  resetI,
+  obtain ⟨x, ⟨_, s, hs, rfl⟩, rfl⟩ := is_localization.mk'_surjective (M.map f) x,
+  obtain ⟨y, rfl⟩ := H x,
+  use is_localization.mk' R' y ⟨s, hs⟩,
+  rw is_localization.map_mk',
+  refl,
+end
+
+lemma surjective_of_localization_span :
+  ring_hom.of_localization_span (λ R S _ _ f, function.surjective f) :=
+begin
+  introv R e H,
+  rw [← set.range_iff_surjective, set.eq_univ_iff_forall],
+  resetI,
+  letI := f.to_algebra,
+  intro x,
+  apply submodule.mem_of_span_eq_top_of_smul_pow_mem (algebra.of_id R S).to_linear_map.range s e,
+  intro r,
+  obtain ⟨a, e'⟩ := H r (algebra_map _ _ x),
+  obtain ⟨b, ⟨_, n, rfl⟩, rfl⟩ := is_localization.mk'_surjective (submonoid.powers (r : R)) a,
+  erw is_localization.map_mk' at e',
+  rw [eq_comm, is_localization.eq_mk'_iff_mul_eq, subtype.coe_mk, subtype.coe_mk, ← map_mul] at e',
+  obtain ⟨⟨_, n', rfl⟩, e''⟩ := (is_localization.eq_iff_exists (submonoid.powers (f r)) _).mp e',
+  rw [subtype.coe_mk, mul_comm x, ←mul_assoc, ← map_pow, ← map_mul, ← map_mul, ← pow_add] at e'',
+  exact ⟨n' + n, _, e''.symm⟩
+end
+
+end surjective
+
 section finite
 
 /-- If `S` is a finite `R`-algebra, then `S' = M⁻¹S` is a finite `R' = M⁻¹R`-algebra. -/
@@ -231,7 +377,7 @@ lemma localization_finite : ring_hom.localization_preserves @ring_hom.finite :=
 begin
   introv R hf,
   -- Setting up the `algebra` and `is_scalar_tower` instances needed
-  classical,
+  resetI,
   letI := f.to_algebra,
   letI := ((algebra_map S S').comp f).to_algebra,
   let f' : R' →+* S' := is_localization.map S' f (submonoid.le_comap_map M),
@@ -249,7 +395,7 @@ begin
 
   -- By the hypotheses, for each `x : S'`, we have `x = y / (f r)` for some `y : S` and `r : M`.
   -- Since `S` is generated by `T`, the image of `y` should fall in the span of the image of `T`.
-  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map (f : R →* S)) x,
+  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map f) x,
   rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, finset.coe_image],
   have hy : y ∈ submodule.span R ↑T, by { rw hT, trivial },
   replace hy : algebra_map S S' y ∈ submodule.map fₐ.to_linear_map (submodule.span R T) :=
@@ -271,7 +417,7 @@ end
 lemma localization_away_map_finite (r : R) [is_localization.away r R']
   [is_localization.away (f r) S'] (hf : f.finite) :
     (is_localization.away.map R' S' f r).finite :=
-ring_hom.localization_away_of_localization_preserves @localization_finite hf
+localization_finite.away r hf
 
 /--
 Let `S` be an `R`-algebra, `M` an submonoid of `R`, and `S' = M⁻¹S`.
@@ -281,23 +427,23 @@ span of `finset_integer_multiple _ s` over `R`.
 -/
 lemma is_localization.smul_mem_finset_integer_multiple_span [algebra R S]
   [algebra R S'] [is_scalar_tower R S S']
-  [is_localization (M.map (algebra_map R S : R →* S)) S'] (x : S)
+  [is_localization (M.map (algebra_map R S)) S'] (x : S)
   (s : finset S') (hx : algebra_map S S' x ∈ submodule.span R (s : set S')) :
     ∃ m : M, m • x ∈ submodule.span R
-      (is_localization.finset_integer_multiple (M.map (algebra_map R S : R →* S)) s : set S) :=
+      (is_localization.finset_integer_multiple (M.map (algebra_map R S)) s : set S) :=
 begin
   let g : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S')
     (λ c x, by simp [algebra.algebra_map_eq_smul_one]),
 
   -- We first obtain the `y' ∈ M` such that `s' = y' • s` is falls in the image of `S` in `S'`.
-  let y := is_localization.common_denom_of_finset (M.map (algebra_map R S : R →* S)) s,
+  let y := is_localization.common_denom_of_finset (M.map (algebra_map R S)) s,
   have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
   obtain ⟨y', hy', e : algebra_map R S y' = y⟩ := y.prop,
   have : algebra_map R S y' • (s : set S') = y' • s :=
     by simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul],
   rw [← e, this] at hx₁,
   replace hx₁ := congr_arg (submodule.span R) hx₁,
-  rw submodule.span_smul_eq at hx₁,
+  rw submodule.span_smul at hx₁,
   replace hx : _ ∈ y' • submodule.span R (s : set S') := set.smul_mem_smul_set hx,
   rw hx₁ at hx,
   erw [← g.map_smul, ← submodule.map_span (g : S →ₗ[R] S')] at hx,
@@ -306,14 +452,14 @@ begin
   -- Thus `a • (y' • x) = a • x' ∈ span s'` in `S` for some `a ∈ M`.
   obtain ⟨x', hx', hx'' : algebra_map _ _ _ = _⟩ := hx,
   obtain ⟨⟨_, a, ha₁, rfl⟩, ha₂⟩ := (is_localization.eq_iff_exists
-    (M.map (algebra_map R S : R →* S)) S').mp hx'',
+    (M.map (algebra_map R S)) S').mp hx'',
   use (⟨a, ha₁⟩ : M) * (⟨y', hy'⟩ : M),
   convert (submodule.span R (is_localization.finset_integer_multiple
-    (submonoid.map (algebra_map R S : R →* S) M) s : set S)).smul_mem a hx' using 1,
+    (submonoid.map (algebra_map R S) M) s : set S)).smul_mem a hx' using 1,
   convert ha₂.symm,
-  { rw [mul_comm (y' • x), subtype.coe_mk, submonoid.smul_def, submonoid.coe_mul, ← smul_smul],
+  { rw [subtype.coe_mk, submonoid.smul_def, submonoid.coe_mul, ← smul_smul],
     exact algebra.smul_def _ _ },
-  { rw mul_comm, exact algebra.smul_def _ _ }
+  { exact algebra.smul_def _ _ }
 end
 
 /-- If `S` is an `R' = M⁻¹R` algebra, and `x ∈ span R' s`,
@@ -325,9 +471,8 @@ lemma multiple_mem_span_of_mem_localization_span [algebra R' S] [algebra R S]
 begin
   classical,
   obtain ⟨s', hss', hs'⟩ := submodule.mem_span_finite_of_mem_span hx,
-  suffices : ∃ t : M, t • x ∈ submodule.span R (s' : set S),
-  { obtain ⟨t, ht⟩ := this,
-    exact ⟨t, submodule.span_mono hss' ht⟩ },
+  rsuffices ⟨t, ht⟩ : ∃ t : M, t • x ∈ submodule.span R (s' : set S),
+  { exact ⟨t, submodule.span_mono hss' ht⟩ },
   clear hx hss' s,
   revert x,
   apply s'.induction_on,
@@ -364,10 +509,10 @@ begin
   rw ring_hom.of_localization_span_iff_finite,
   introv R hs H,
   -- We first setup the instances
-  classical,
+  resetI,
   letI := f.to_algebra,
   letI := λ (r : s), (localization.away_map f r).to_algebra,
-  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S : R →* S))
+  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S))
     (localization.away (f r)),
   { intro r, rw submonoid.map_powers, exact localization.is_localization },
   haveI : ∀ r : s, is_scalar_tower R (localization.away (r : R)) (localization.away (f r)) :=
@@ -398,12 +543,9 @@ begin
   obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.smul_mem_finset_integer_multiple_span
     (submonoid.powers (r : R)) (localization.away (f r)) _ (s₁ r) hn₁,
   rw [submonoid.smul_def, ← algebra.smul_def, smul_smul, subtype.coe_mk, ← pow_add] at hn₂,
+  simp_rw submonoid.map_powers at hn₂,
   use n₂ + n₁,
-  refine le_supr (λ (x : s), submodule.span R (sf x : set S)) r _,
-  change _ ∈ submodule.span R
-    ((is_localization.finset_integer_multiple _ (s₁ r) : finset S) : set S),
-  convert hn₂,
-  rw submonoid.map_powers, refl,
+  exact le_supr (λ (x : s), submodule.span R (sf x : set S)) r hn₂,
 end
 
 end finite
@@ -414,7 +556,7 @@ lemma localization_finite_type : ring_hom.localization_preserves @ring_hom.finit
 begin
   introv R hf,
   -- mirrors the proof of `localization_map_finite`
-  classical,
+  resetI,
   letI := f.to_algebra,
   letI := ((algebra_map S S').comp f).to_algebra,
   let f' : R' →+* S' := is_localization.map S' f (submonoid.le_comap_map M),
@@ -427,7 +569,7 @@ begin
   use T.image (algebra_map S S'),
   rw eq_top_iff,
   rintro x -,
-  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map (f : R →* S)) x,
+  obtain ⟨y, ⟨_, ⟨r, hr, rfl⟩⟩, rfl⟩ := is_localization.mk'_surjective (M.map f) x,
   rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, finset.coe_image],
   have hy : y ∈ algebra.adjoin R (T : set S), by { rw hT, trivial },
   replace hy : algebra_map S S' y ∈ (algebra.adjoin R (T : set S)).map fₐ :=
@@ -447,7 +589,37 @@ end
 lemma localization_away_map_finite_type (r : R) [is_localization.away r R']
   [is_localization.away (f r) S'] (hf : f.finite_type) :
     (is_localization.away.map R' S' f r).finite_type :=
-ring_hom.localization_away_of_localization_preserves @localization_finite_type hf
+localization_finite_type.away r hf
+
+variable {S'}
+
+/--
+Let `S` be an `R`-algebra, `M` a submonoid of `S`, `S' = M⁻¹S`.
+Suppose the image of some `x : S` falls in the adjoin of some finite `s ⊆ S'` over `R`,
+and `A` is an `R`-subalgebra of `S` containing both `M` and the numerators of `s`.
+Then, there exists some `m : M` such that `m • x` falls in `A`.
+-/
+lemma is_localization.exists_smul_mem_of_mem_adjoin [algebra R S]
+  [algebra R S'] [is_scalar_tower R S S'] (M : submonoid S)
+  [is_localization M S'] (x : S) (s : finset S') (A : subalgebra R S)
+  (hA₁ : (is_localization.finset_integer_multiple M s : set S) ⊆ A)
+  (hA₂ : M ≤ A.to_submonoid)
+  (hx : algebra_map S S' x ∈ algebra.adjoin R (s : set S')) :
+    ∃ m : M, m • x ∈ A :=
+begin
+  let g : S →ₐ[R] S' := is_scalar_tower.to_alg_hom R S S',
+  let y := is_localization.common_denom_of_finset M s,
+  have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
+  obtain ⟨n, hn⟩ := algebra.pow_smul_mem_of_smul_subset_of_mem_adjoin (y : S) (s : set S')
+    (A.map g) (by { rw hx₁, exact set.image_subset _ hA₁ }) hx (set.mem_image_of_mem _ (hA₂ y.2)),
+  obtain ⟨x', hx', hx''⟩ := hn n (le_of_eq rfl),
+  rw [algebra.smul_def, ← _root_.map_mul] at hx'',
+  obtain ⟨a, ha₂⟩ := (is_localization.eq_iff_exists M S').mp hx'',
+  use a * y ^ n,
+  convert A.mul_mem hx' (hA₂ a.prop),
+  rw [submonoid.smul_def, smul_eq_mul, submonoid.coe_mul, submonoid.coe_pow, mul_assoc, ←ha₂,
+    mul_comm],
+end
 
 /--
 Let `S` be an `R`-algebra, `M` an submonoid of `R`, and `S' = M⁻¹S`.
@@ -457,35 +629,15 @@ adjoin of `finset_integer_multiple _ s` over `R`.
 -/
 lemma is_localization.lift_mem_adjoin_finset_integer_multiple [algebra R S]
   [algebra R S'] [is_scalar_tower R S S']
-  [is_localization (M.map (algebra_map R S : R →* S)) S'] (x : S)
+  [is_localization (M.map (algebra_map R S)) S'] (x : S)
   (s : finset S') (hx : algebra_map S S' x ∈ algebra.adjoin R (s : set S')) :
     ∃ m : M, m • x ∈ algebra.adjoin R
-      (is_localization.finset_integer_multiple (M.map (algebra_map R S : R →* S)) s : set S) :=
+      (is_localization.finset_integer_multiple (M.map (algebra_map R S)) s : set S) :=
 begin
-  -- mirrors the proof of `is_localization.smul_mem_finset_integer_multiple_span`
-  let g : S →ₐ[R] S' := alg_hom.mk' (algebra_map S S')
-    (λ c x, by simp [algebra.algebra_map_eq_smul_one]),
-
-  let y := is_localization.common_denom_of_finset (M.map (algebra_map R S : R →* S)) s,
-  have hx₁ : (y : S) • ↑s = g '' _ := (is_localization.finset_integer_multiple_image _ s).symm,
-  obtain ⟨y', hy', e : algebra_map R S y' = y⟩ := y.prop,
-  have : algebra_map R S y' • (s : set S') = y' • s :=
-    by simp_rw [algebra.algebra_map_eq_smul_one, smul_assoc, one_smul],
-  rw [← e, this] at hx₁,
-  replace hx₁ := congr_arg (algebra.adjoin R) hx₁,
-  obtain ⟨n, hn⟩ := algebra.pow_smul_mem_adjoin_smul _ y' (s : set S') hx,
-  specialize hn n (le_of_eq rfl),
-  erw [hx₁, ← g.map_smul, ← g.map_adjoin] at hn,
-  obtain ⟨x', hx', hx''⟩ := hn,
-  obtain ⟨⟨_, a, ha₁, rfl⟩, ha₂⟩ := (is_localization.eq_iff_exists
-    (M.map (algebra_map R S : R →* S)) S').mp hx'',
-  use (⟨a, ha₁⟩ : M) * (⟨y', hy'⟩ : M) ^ n,
-  convert (algebra.adjoin R (is_localization.finset_integer_multiple
-    (submonoid.map (algebra_map R S : R →* S) M) s : set S)).smul_mem hx' a using 1,
-  convert ha₂.symm,
-  { rw [mul_comm (y' ^ n • x), subtype.coe_mk, submonoid.smul_def, submonoid.coe_mul, ← smul_smul,
-        algebra.smul_def, submonoid_class.coe_pow], refl },
-  { rw mul_comm, exact algebra.smul_def _ _ }
+  obtain ⟨⟨_, a, ha, rfl⟩, e⟩ := is_localization.exists_smul_mem_of_mem_adjoin
+    (M.map (algebra_map R S)) x s (algebra.adjoin R _) algebra.subset_adjoin _ hx,
+  { exact ⟨⟨a, ha⟩, by simpa [submonoid.smul_def] using e⟩ },
+{ rintros _ ⟨a, ha, rfl⟩, exact subalgebra.algebra_map_mem _ a }
 end
 
 lemma finite_type_of_localization_span : ring_hom.of_localization_span @ring_hom.finite_type :=
@@ -493,10 +645,10 @@ begin
   rw ring_hom.of_localization_span_iff_finite,
   introv R hs H,
   -- mirrors the proof of `finite_of_localization_span`
-  classical,
+  resetI,
   letI := f.to_algebra,
   letI := λ (r : s), (localization.away_map f r).to_algebra,
-  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S : R →* S))
+  haveI : ∀ r : s, is_localization ((submonoid.powers (r : R)).map (algebra_map R S))
     (localization.away (f r)),
   { intro r, rw submonoid.map_powers, exact localization.is_localization },
   haveI : ∀ r : s, is_scalar_tower R (localization.away (r : R)) (localization.away (f r)) :=
@@ -519,15 +671,11 @@ begin
   rw [submonoid.smul_def, algebra.smul_def, is_scalar_tower.algebra_map_apply R S,
     subtype.coe_mk, ← map_mul] at hn₁,
   obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.lift_mem_adjoin_finset_integer_multiple
-    (submonoid.powers (r : R)) (localization.away (f r)) _ (s₁ r) hn₁,
+    (submonoid.powers (r : R)) _ (s₁ r) hn₁,
   rw [submonoid.smul_def, ← algebra.smul_def, smul_smul, subtype.coe_mk, ← pow_add] at hn₂,
+  simp_rw submonoid.map_powers at hn₂,
   use n₂ + n₁,
-  refine le_supr (λ (x : s), algebra.adjoin R (sf x : set S)) r _,
-  change _ ∈ algebra.adjoin R
-    ((is_localization.finset_integer_multiple _ (s₁ r) : finset S) : set S),
-  convert hn₂,
-  rw submonoid.map_powers,
-  refl,
+  exact le_supr (λ (x : s), algebra.adjoin R (sf x : set S)) r hn₂
 end
 
 end finite_type
diff --git a/src/ring_theory/localization/as_subring.lean b/src/ring_theory/localization/as_subring.lean
index c3457a89f702b..516c28af1768c 100644
--- a/src/ring_theory/localization/as_subring.lean
+++ b/src/ring_theory/localization/as_subring.lean
@@ -9,6 +9,9 @@ import ring_theory.localization.localization_localization
 
 # Localizations of domains as subalgebras of the fraction field.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a domain `A` with fraction field `K`, and a submonoid `S` of `A` which
 does not contain zero, this file constructs the localization of `A` at `S`
 as a subalgebra of the field `K` over `A`.
@@ -102,7 +105,7 @@ lemma mem_range_map_to_fraction_ring_iff_of_field
   ∃ (a s : A) (hs : s ∈ S), x = algebra_map A K a * (algebra_map A K s)⁻¹ :=
 begin
   rw mem_range_map_to_fraction_ring_iff,
-  iterate 3 { congr' with }, convert iff.rfl, rw units.coe_inv', refl,
+  iterate 3 { congr' with }, convert iff.rfl, rw units.coe_inv, refl,
 end
 
 /--
diff --git a/src/ring_theory/localization/at_prime.lean b/src/ring_theory/localization/at_prime.lean
index 49ec3ca61a51f..fc7325ff90e02 100644
--- a/src/ring_theory/localization/at_prime.lean
+++ b/src/ring_theory/localization/at_prime.lean
@@ -9,6 +9,9 @@ import ring_theory.localization.ideal
 /-!
 # Localizations of commutative rings at the complement of a prime ideal
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
  * `is_localization.at_prime (I : ideal R) [is_prime I] (S : Type*)` expresses that `S` is a
@@ -44,6 +47,9 @@ def prime_compl :
   one_mem' := by convert I.ne_top_iff_one.1 hp.1; refl,
   mul_mem' := λ x y hnx hny hxy, or.cases_on (hp.mem_or_mem hxy) hnx hny }
 
+lemma prime_compl_le_non_zero_divisors [no_zero_divisors R] : I.prime_compl ≤ non_zero_divisors R :=
+le_non_zero_divisors_of_no_zero_divisors $ not_not_intro I.zero_mem
+
 end ideal
 
 variables (S)
@@ -86,12 +92,12 @@ begin
   rw ←hrx at hx, rw ←hry at hy,
   obtain ⟨t, ht⟩ := is_localization.eq.1 hxyz,
   simp only [mul_one, one_mul, submonoid.coe_mul, subtype.coe_mk] at ht,
-  suffices : ↑sx * ↑sy * ↑sz * ↑t ∈ I, from
+  suffices : ↑t * (↑sx * ↑sy * ↑sz) ∈ I, from
     not_or (mt hp.mem_or_mem $ not_or sx.2 sy.2) sz.2
-      (hp.mem_or_mem $ (hp.mem_or_mem this).resolve_right t.2),
-  rw [←ht, mul_assoc],
-  exact I.mul_mem_right _ (I.add_mem (I.mul_mem_right _ $ this hx)
-                                     (I.mul_mem_right _ $ this hy))
+      (hp.mem_or_mem $ (hp.mem_or_mem this).resolve_left t.2),
+  rw [←ht],
+  exact I.mul_mem_left _ (I.mul_mem_right _ (I.add_mem (I.mul_mem_right _ $ this hx)
+                                                       (I.mul_mem_right _ $ this hy))),
 end
 
 end is_localization
@@ -115,8 +121,7 @@ The localization of an integral domain at the complement of a prime ideal is an
 -/
 instance is_domain_of_local_at_prime {P : ideal A} (hp : P.is_prime) :
   is_domain (localization.at_prime P) :=
-is_domain_localization (le_non_zero_divisors_of_no_zero_divisors
-  (not_not_intro P.zero_mem))
+is_domain_localization P.prime_compl_le_non_zero_divisors
 
 namespace at_prime
 
@@ -137,6 +142,10 @@ not_iff_not.mp $ by
 simpa only [local_ring.mem_maximal_ideal, mem_nonunits_iff, not_not]
   using is_unit_to_map_iff S I x
 
+lemma comap_maximal_ideal (h : _root_.local_ring S := local_ring S I) :
+  (local_ring.maximal_ideal S).comap (algebra_map R S) = I :=
+ideal.ext $ λ x, by simpa only [ideal.mem_comap] using to_map_mem_maximal_iff _ I x
+
 lemma is_unit_mk'_iff (x : R) (y : I.prime_compl) :
   is_unit (mk' S x y) ↔ x ∈ I.prime_compl :=
 ⟨λ h hx, mk'_mem_iff.mpr ((to_map_mem_maximal_iff S I x).mpr hx) h,
@@ -166,8 +175,7 @@ variables {I}
 lemma at_prime.comap_maximal_ideal :
   ideal.comap (algebra_map R (localization.at_prime I))
     (local_ring.maximal_ideal (localization I.prime_compl)) = I :=
-ideal.ext $ λ x, by
-simpa only [ideal.mem_comap] using at_prime.to_map_mem_maximal_iff _ I x
+at_prime.comap_maximal_ideal _ _
 
 /-- The image of `I` in the localization at `I.prime_compl` is a maximal ideal, and in particular
 it is the unique maximal ideal given by the local ring structure `at_prime.local_ring` -/
diff --git a/src/ring_theory/localization/away.lean b/src/ring_theory/localization/away.lean
deleted file mode 100644
index 2c1f2359e9adb..0000000000000
--- a/src/ring_theory/localization/away.lean
+++ /dev/null
@@ -1,151 +0,0 @@
-/-
-Copyright (c) 2018 Kenny Lau. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
--/
-import ring_theory.localization.basic
-
-/-!
-# Localizations away from an element
-
-## Main definitions
-
- * `is_localization.away (x : R) S` expresses that `S` is a localization away from `x`, as an
-   abbreviation of `is_localization (submonoid.powers x) S`
-
-## Implementation notes
-
-See `src/ring_theory/localization/basic.lean` for a design overview.
-
-## Tags
-localization, ring localization, commutative ring localization, characteristic predicate,
-commutative ring, field of fractions
--/
-variables {R : Type*} [comm_semiring R] (M : submonoid R) {S : Type*} [comm_semiring S]
-variables [algebra R S] {P : Type*} [comm_semiring P]
-
-
-namespace is_localization
-
-section away
-
-variables (x : R)
-
-/-- Given `x : R`, the typeclass `is_localization.away x S` states that `S` is
-isomorphic to the localization of `R` at the submonoid generated by `x`. -/
-abbreviation away (S : Type*) [comm_semiring S] [algebra R S] :=
-is_localization (submonoid.powers x) S
-
-namespace away
-
-variables [is_localization.away x S]
-
-/-- Given `x : R` and a localization map `F : R →+* S` away from `x`, `inv_self` is `(F x)⁻¹`. -/
-noncomputable def inv_self : S :=
-mk' S (1 : R) ⟨x, submonoid.mem_powers _⟩
-
-variables {g : R →+* P}
-
-/-- Given `x : R`, a localization map `F : R →+* S` away from `x`, and a map of `comm_semiring`s
-`g : R →+* P` such that `g x` is invertible, the homomorphism induced from `S` to `P` sending
-`z : S` to `g y * (g x)⁻ⁿ`, where `y : R, n : ℕ` are such that `z = F y * (F x)⁻ⁿ`. -/
-noncomputable def lift (hg : is_unit (g x)) : S →+* P :=
-is_localization.lift $ λ (y : submonoid.powers x), show is_unit (g y.1),
-begin
-  obtain ⟨n, hn⟩ := y.2,
-  rw [←hn, g.map_pow],
-  exact is_unit.map (pow_monoid_hom n : P →* P) hg,
-end
-
-@[simp] lemma away_map.lift_eq (hg : is_unit (g x)) (a : R) :
-  lift x hg ((algebra_map R S) a) = g a := lift_eq _ _
-
-@[simp] lemma away_map.lift_comp (hg : is_unit (g x)) :
-  (lift x hg).comp (algebra_map R S) = g := lift_comp _
-
-/-- Given `x y : R` and localizations `S`, `P` away from `x` and `x * y`
-respectively, the homomorphism induced from `S` to `P`. -/
-noncomputable def away_to_away_right (y : R) [algebra R P] [is_localization.away (x * y) P] :
-  S →+* P :=
-lift x $ show is_unit ((algebra_map R P) x), from
-is_unit_of_mul_eq_one ((algebra_map R P) x) (mk' P y ⟨x * y, submonoid.mem_powers _⟩) $
-by rw [mul_mk'_eq_mk'_of_mul, mk'_self]
-
-variables (S) (Q : Type*) [comm_semiring Q] [algebra P Q]
-
-/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
-noncomputable
-def map (f : R →+* P) (r : R) [is_localization.away r S]
-  [is_localization.away (f r) Q] : S →+* Q :=
-is_localization.map Q f
-  (show submonoid.powers r ≤ (submonoid.powers (f r)).comap f,
-    by { rintros x ⟨n, rfl⟩, use n, simp })
-
-end away
-
-end away
-
-variables [is_localization M S]
-
-section at_units
-variables (R) (S) (M)
-
-/-- The localization at a module of units is isomorphic to the ring -/
-noncomputable
-def at_units (H : ∀ x : M, is_unit (x : R)) : R ≃ₐ[R] S :=
-begin
-  refine alg_equiv.of_bijective (algebra.of_id R S) ⟨_, _⟩,
-  { intros x y hxy,
-    obtain ⟨c, eq⟩ := (is_localization.eq_iff_exists M S).mp hxy,
-    obtain ⟨u, hu⟩ := H c,
-    rwa [← hu, units.mul_left_inj] at eq },
-  { intros y,
-    obtain ⟨⟨x, s⟩, eq⟩ := is_localization.surj M y,
-    obtain ⟨u, hu⟩ := H s,
-    use x * u.inv,
-    dsimp only [algebra.of_id, ring_hom.to_fun_eq_coe, alg_hom.coe_mk],
-    rw [ring_hom.map_mul, ← eq, ← hu, mul_assoc, ← ring_hom.map_mul],
-    simp }
-end
-
-/-- The localization away from a unit is isomorphic to the ring -/
-noncomputable
-def at_unit (x : R) (e : is_unit x) [is_localization.away x S] : R ≃ₐ[R] S :=
-begin
-  apply at_units R (submonoid.powers x),
-  rintros ⟨xn, n, hxn⟩,
-  obtain ⟨u, hu⟩ := e,
-  rw is_unit_iff_exists_inv,
-  use u.inv ^ n,
-  simp[← hxn, ← hu, ← mul_pow]
-end
-
-/-- The localization at one is isomorphic to the ring. -/
-noncomputable
-def at_one [is_localization.away (1 : R) S] : R ≃ₐ[R] S :=
-@at_unit R _ S _ _ (1 : R) is_unit_one _
-
-end at_units
-
-end is_localization
-
-namespace localization
-
-open is_localization
-
-variables {M}
-
-/-- Given a map `f : R →+* S` and an element `r : R`, such that `f r` is invertible,
-  we may construct a map `Rᵣ →+* S`. -/
-noncomputable
-abbreviation away_lift (f : R →+* P) (r : R) (hr : is_unit (f r)) :
-  localization.away r →+* P :=
-is_localization.away.lift r hr
-
-/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
-noncomputable
-abbreviation away_map (f : R →+* P) (r : R) :
-  localization.away r →+* localization.away (f r) :=
-is_localization.away.map _ _ f r
-
-end localization
diff --git a/src/ring_theory/localization/away/adjoin_root.lean b/src/ring_theory/localization/away/adjoin_root.lean
new file mode 100644
index 0000000000000..2d5ed60a9769c
--- /dev/null
+++ b/src/ring_theory/localization/away/adjoin_root.lean
@@ -0,0 +1,40 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
+-/
+import ring_theory.adjoin_root
+import ring_theory.localization.away.basic
+
+/-!
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The `R`-`alg_equiv` between the localization of `R` away from `r` and
+`R` with an inverse of `r` adjoined.
+-/
+
+open polynomial adjoin_root localization
+
+variables {R : Type*} [comm_ring R]
+
+local attribute [instance] is_localization.alg_hom_subsingleton adjoin_root.alg_hom_subsingleton
+
+/-- The `R`-`alg_equiv` between the localization of `R` away from `r` and
+    `R` with an inverse of `r` adjoined. -/
+noncomputable def localization.away_equiv_adjoin (r : R) : away r ≃ₐ[R] adjoin_root (C r * X - 1) :=
+alg_equiv.of_alg_hom
+  { commutes' := is_localization.away.away_map.lift_eq r
+      (is_unit_of_mul_eq_one _ _ $ root_is_inv r), .. away_lift _ r _ }
+  (lift_hom _ (is_localization.away.inv_self r) $ by simp only
+    [map_sub, map_mul, aeval_C, aeval_X, is_localization.away.mul_inv_self, aeval_one, sub_self])
+  (subsingleton.elim _ _)
+  (subsingleton.elim _ _)
+
+lemma is_localization.adjoin_inv (r : R) : is_localization.away r (adjoin_root $ C r * X - 1) :=
+is_localization.is_localization_of_alg_equiv _ (localization.away_equiv_adjoin r)
+
+lemma is_localization.away.finite_presentation (r : R) {S} [comm_ring S] [algebra R S]
+  [is_localization.away r S] : algebra.finite_presentation R S :=
+(adjoin_root.finite_presentation _).equiv $ (localization.away_equiv_adjoin r).symm.trans $
+  is_localization.alg_equiv (submonoid.powers r) _ _
diff --git a/src/ring_theory/localization/away/basic.lean b/src/ring_theory/localization/away/basic.lean
new file mode 100644
index 0000000000000..417bfe02d192c
--- /dev/null
+++ b/src/ring_theory/localization/away/basic.lean
@@ -0,0 +1,320 @@
+/-
+Copyright (c) 2018 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
+-/
+import ring_theory.unique_factorization_domain
+import ring_theory.localization.basic
+
+/-!
+# Localizations away from an element
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+ * `is_localization.away (x : R) S` expresses that `S` is a localization away from `x`, as an
+   abbreviation of `is_localization (submonoid.powers x) S`
+ * `exists_reduced_fraction (hb : b ≠ 0)` produces a reduced fraction of the form `b = a * x^n` for
+   some `n : ℤ` and some `a : R` that is not divisible by `x`.
+
+## Implementation notes
+
+See `src/ring_theory/localization/basic.lean` for a design overview.
+
+## Tags
+localization, ring localization, commutative ring localization, characteristic predicate,
+commutative ring, field of fractions
+-/
+
+section comm_semiring
+
+variables {R : Type*} [comm_semiring R] (M : submonoid R) {S : Type*} [comm_semiring S]
+variables [algebra R S] {P : Type*} [comm_semiring P]
+
+namespace is_localization
+
+section away
+
+variables (x : R)
+
+/-- Given `x : R`, the typeclass `is_localization.away x S` states that `S` is
+isomorphic to the localization of `R` at the submonoid generated by `x`. -/
+abbreviation away (S : Type*) [comm_semiring S] [algebra R S] :=
+is_localization (submonoid.powers x) S
+
+namespace away
+
+variables [is_localization.away x S]
+
+/-- Given `x : R` and a localization map `F : R →+* S` away from `x`, `inv_self` is `(F x)⁻¹`. -/
+noncomputable def inv_self : S :=
+mk' S (1 : R) ⟨x, submonoid.mem_powers _⟩
+
+@[simp] lemma mul_inv_self : algebra_map R S x * inv_self x = 1 :=
+by { convert is_localization.mk'_mul_mk'_eq_one _ 1, symmetry, apply is_localization.mk'_one }
+
+variables {g : R →+* P}
+
+/-- Given `x : R`, a localization map `F : R →+* S` away from `x`, and a map of `comm_semiring`s
+`g : R →+* P` such that `g x` is invertible, the homomorphism induced from `S` to `P` sending
+`z : S` to `g y * (g x)⁻ⁿ`, where `y : R, n : ℕ` are such that `z = F y * (F x)⁻ⁿ`. -/
+noncomputable def lift (hg : is_unit (g x)) : S →+* P :=
+is_localization.lift $ λ (y : submonoid.powers x), show is_unit (g y.1),
+begin
+  obtain ⟨n, hn⟩ := y.2,
+  rw [←hn, g.map_pow],
+  exact is_unit.map (pow_monoid_hom n : P →* P) hg,
+end
+
+@[simp] lemma away_map.lift_eq (hg : is_unit (g x)) (a : R) :
+  lift x hg ((algebra_map R S) a) = g a := lift_eq _ _
+
+@[simp] lemma away_map.lift_comp (hg : is_unit (g x)) :
+  (lift x hg).comp (algebra_map R S) = g := lift_comp _
+
+/-- Given `x y : R` and localizations `S`, `P` away from `x` and `x * y`
+respectively, the homomorphism induced from `S` to `P`. -/
+noncomputable def away_to_away_right (y : R) [algebra R P] [is_localization.away (x * y) P] :
+  S →+* P :=
+lift x $ show is_unit ((algebra_map R P) x), from
+is_unit_of_mul_eq_one ((algebra_map R P) x) (mk' P y ⟨x * y, submonoid.mem_powers _⟩) $
+by rw [mul_mk'_eq_mk'_of_mul, mk'_self]
+
+variables (S) (Q : Type*) [comm_semiring Q] [algebra P Q]
+
+/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
+noncomputable
+def map (f : R →+* P) (r : R) [is_localization.away r S]
+  [is_localization.away (f r) Q] : S →+* Q :=
+is_localization.map Q f
+  (show submonoid.powers r ≤ (submonoid.powers (f r)).comap f,
+    by { rintros x ⟨n, rfl⟩, use n, simp })
+
+end away
+
+end away
+
+variables [is_localization M S]
+
+section at_units
+variables (R) (S) (M)
+
+/-- The localization at a module of units is isomorphic to the ring -/
+noncomputable
+def at_units (H : ∀ x : M, is_unit (x : R)) : R ≃ₐ[R] S :=
+begin
+  refine alg_equiv.of_bijective (algebra.of_id R S) ⟨_, _⟩,
+  { intros x y hxy,
+    obtain ⟨c, eq⟩ := (is_localization.eq_iff_exists M S).mp hxy,
+    obtain ⟨u, hu⟩ := H c,
+    rwa [← hu, units.mul_right_inj] at eq },
+  { intros y,
+    obtain ⟨⟨x, s⟩, eq⟩ := is_localization.surj M y,
+    obtain ⟨u, hu⟩ := H s,
+    use x * u.inv,
+    dsimp only [algebra.of_id, ring_hom.to_fun_eq_coe, alg_hom.coe_mk],
+    rw [ring_hom.map_mul, ← eq, ← hu, mul_assoc, ← ring_hom.map_mul],
+    simp }
+end
+
+/-- The localization away from a unit is isomorphic to the ring -/
+noncomputable
+def at_unit (x : R) (e : is_unit x) [is_localization.away x S] : R ≃ₐ[R] S :=
+begin
+  apply at_units R (submonoid.powers x),
+  rintros ⟨xn, n, hxn⟩,
+  obtain ⟨u, hu⟩ := e,
+  rw is_unit_iff_exists_inv,
+  use u.inv ^ n,
+  simp[← hxn, ← hu, ← mul_pow]
+end
+
+/-- The localization at one is isomorphic to the ring. -/
+noncomputable
+def at_one [is_localization.away (1 : R) S] : R ≃ₐ[R] S :=
+@at_unit R _ S _ _ (1 : R) is_unit_one _
+
+lemma away_of_is_unit_of_bijective {R : Type*} (S : Type*) [comm_ring R] [comm_ring S]
+  [algebra R S] {r : R} (hr : is_unit r) (H : function.bijective (algebra_map R S)) :
+  is_localization.away r S :=
+{ map_units := by { rintros ⟨_, n, rfl⟩, exact (algebra_map R S).is_unit_map (hr.pow _) },
+  surj := λ z, by { obtain ⟨z', rfl⟩ := H.2 z, exact ⟨⟨z', 1⟩, by simp⟩ },
+  eq_iff_exists := λ x y, begin
+    erw H.1.eq_iff,
+    split,
+    { rintro rfl, exact ⟨1, rfl⟩ },
+    { rintro ⟨⟨_, n, rfl⟩, e⟩, exact (hr.pow _).mul_right_inj.mp e }
+  end }
+
+end at_units
+
+end is_localization
+
+namespace localization
+
+open is_localization
+
+variables {M}
+
+/-- Given a map `f : R →+* S` and an element `r : R`, such that `f r` is invertible,
+  we may construct a map `Rᵣ →+* S`. -/
+noncomputable
+abbreviation away_lift (f : R →+* P) (r : R) (hr : is_unit (f r)) :
+  localization.away r →+* P :=
+is_localization.away.lift r hr
+
+/-- Given a map `f : R →+* S` and an element `r : R`, we may construct a map `Rᵣ →+* Sᵣ`. -/
+noncomputable
+abbreviation away_map (f : R →+* P) (r : R) :
+  localization.away r →+* localization.away (f r) :=
+is_localization.away.map _ _ f r
+
+end localization
+
+end comm_semiring
+
+open localization
+
+variables {R : Type*} [comm_ring R]
+
+section num_denom
+
+open unique_factorization_monoid is_localization
+
+variable (x : R)
+
+variables (B : Type*) [comm_ring B] [algebra R B] [is_localization.away x B]
+
+/-- `self_zpow x (m : ℤ)` is `x ^ m` as an element of the localization away from `x`. -/
+noncomputable def self_zpow (m : ℤ) : B :=
+if hm : 0 ≤ m
+then algebra_map _ _ x ^ m.nat_abs
+else mk' _ (1 : R) (submonoid.pow x m.nat_abs)
+
+lemma self_zpow_of_nonneg {n : ℤ} (hn : 0 ≤ n) : self_zpow x B n =
+  algebra_map R B x ^ n.nat_abs :=
+dif_pos hn
+
+@[simp] lemma self_zpow_coe_nat (d : ℕ) : self_zpow x B d = (algebra_map R B x)^d :=
+self_zpow_of_nonneg _ _ (int.coe_nat_nonneg d)
+
+@[simp] lemma self_zpow_zero : self_zpow x B 0 = 1 :=
+by simp [self_zpow_of_nonneg _ _ le_rfl]
+
+lemma self_zpow_of_neg {n : ℤ} (hn : n < 0) :
+  self_zpow x B n = mk' _ (1 : R) (submonoid.pow x n.nat_abs) :=
+dif_neg hn.not_le
+
+lemma self_zpow_of_nonpos {n : ℤ} (hn : n ≤ 0) :
+  self_zpow x B n = mk' _ (1 : R) (submonoid.pow x n.nat_abs) :=
+begin
+  by_cases hn0 : n = 0,
+  { simp [hn0, self_zpow_zero, submonoid.pow_apply] },
+  { simp [self_zpow_of_neg _ _ (lt_of_le_of_ne hn hn0)] }
+end
+
+@[simp] lemma self_zpow_neg_coe_nat (d : ℕ) :
+  self_zpow x B (-d) = mk' _ (1 : R) (submonoid.pow x d) :=
+by simp [self_zpow_of_nonpos _ _ (neg_nonpos.mpr (int.coe_nat_nonneg d))]
+
+@[simp] lemma self_zpow_sub_cast_nat {n m : ℕ} :
+  self_zpow x B (n - m) = mk' _ (x ^ n) (submonoid.pow x m) :=
+begin
+  by_cases h : m ≤ n,
+  { rw [is_localization.eq_mk'_iff_mul_eq, submonoid.pow_apply, subtype.coe_mk,
+        ← int.coe_nat_sub h, self_zpow_coe_nat, ← map_pow, ← map_mul, ← pow_add,
+        nat.sub_add_cancel h] },
+  { rw [← neg_sub, ← int.coe_nat_sub (le_of_not_le h), self_zpow_neg_coe_nat,
+        is_localization.mk'_eq_iff_eq],
+    simp [submonoid.pow_apply, ← pow_add, nat.sub_add_cancel (le_of_not_le h)] }
+end
+
+@[simp] lemma self_zpow_add {n m : ℤ} :
+  self_zpow x B (n + m) = self_zpow x B n * self_zpow x B m :=
+begin
+  cases le_or_lt 0 n with hn hn; cases le_or_lt 0 m with hm hm,
+  { rw [self_zpow_of_nonneg _ _ hn, self_zpow_of_nonneg _ _ hm,
+        self_zpow_of_nonneg _ _ (add_nonneg hn hm), int.nat_abs_add_nonneg hn hm, pow_add] },
+  { have : n + m = n.nat_abs - m.nat_abs,
+    { rw [int.nat_abs_of_nonneg hn, int.of_nat_nat_abs_of_nonpos hm.le, sub_neg_eq_add] },
+    rw [self_zpow_of_nonneg _ _ hn, self_zpow_of_neg _ _ hm,
+        this, self_zpow_sub_cast_nat, is_localization.mk'_eq_mul_mk'_one, map_pow] },
+  { have : n + m = m.nat_abs - n.nat_abs,
+    { rw [int.nat_abs_of_nonneg hm, int.of_nat_nat_abs_of_nonpos hn.le, sub_neg_eq_add, add_comm] },
+    rw [self_zpow_of_nonneg _ _ hm, self_zpow_of_neg _ _ hn,
+        this, self_zpow_sub_cast_nat, is_localization.mk'_eq_mul_mk'_one, map_pow, mul_comm] },
+  { rw [self_zpow_of_neg _ _ hn, self_zpow_of_neg _ _ hm, self_zpow_of_neg _ _ (add_neg hn hm),
+        int.nat_abs_add_neg hn hm, ← mk'_mul, one_mul],
+    congr,
+    ext,
+    simp [pow_add] },
+end
+
+lemma self_zpow_mul_neg (d : ℤ) : self_zpow x B d * self_zpow x B (-d) = 1 :=
+begin
+  by_cases hd : d ≤ 0,
+  { erw [self_zpow_of_nonpos x B hd, self_zpow_of_nonneg, ← map_pow, int.nat_abs_neg,
+      is_localization.mk'_spec, map_one],
+    apply nonneg_of_neg_nonpos,
+    rwa [neg_neg]},
+  { erw [self_zpow_of_nonneg x B (le_of_not_le hd), self_zpow_of_nonpos, ← map_pow, int.nat_abs_neg,
+     @is_localization.mk'_spec' R _ (submonoid.powers x) B _ _ _ 1 (submonoid.pow x d.nat_abs),
+      map_one],
+    refine nonpos_of_neg_nonneg (le_of_lt _),
+    rwa [neg_neg, ← not_le] },
+end
+
+lemma self_zpow_neg_mul (d : ℤ) : self_zpow x B (-d) * self_zpow x B d = 1 :=
+by rw [mul_comm, self_zpow_mul_neg x B d]
+
+
+lemma self_zpow_pow_sub (a : R) (b : B) (m d : ℤ) :
+  (self_zpow x B (m - d)) * mk' B a (1 : submonoid.powers x) = b ↔
+  (self_zpow x B m) * mk' B a (1 : submonoid.powers x) = (self_zpow x B d) * b :=
+begin
+  rw [sub_eq_add_neg, self_zpow_add, mul_assoc, mul_comm _ (mk' B a 1), ← mul_assoc],
+  split,
+  { intro h,
+    have := congr_arg (λ s : B, s * self_zpow x B d) h,
+    simp only at this,
+    rwa [mul_assoc, mul_assoc, self_zpow_neg_mul, mul_one, mul_comm b _] at this},
+  { intro h,
+    have := congr_arg (λ s : B, s * self_zpow x B (-d)) h,
+    simp only at this,
+    rwa [mul_comm _ b, mul_assoc b _ _, self_zpow_mul_neg, mul_one] at this}
+end
+
+
+variables [is_domain R] [normalization_monoid R] [unique_factorization_monoid R]
+
+
+theorem exists_reduced_fraction' {b : B} (hb : b ≠ 0) (hx : irreducible x) :
+  ∃ (a : R) (n : ℤ), ¬ x ∣ a ∧
+    self_zpow x B n * algebra_map R B a = b :=
+begin
+  classical,
+  obtain ⟨⟨a₀, y⟩, H⟩ := surj (submonoid.powers x) b,
+  obtain ⟨d, hy⟩ := (submonoid.mem_powers_iff y.1 x).mp y.2,
+  have ha₀ : a₀ ≠ 0,
+  { haveI := @is_domain_of_le_non_zero_divisors B _ R _ _ _ (submonoid.powers x) _
+      (powers_le_non_zero_divisors_of_no_zero_divisors hx.ne_zero),
+    simp only [map_zero, ← subtype.val_eq_coe, ← hy, map_pow] at H,
+    apply ((injective_iff_map_eq_zero' (algebra_map R B)).mp _ a₀).mpr.mt,
+    rw ← H,
+    apply mul_ne_zero hb (pow_ne_zero _ _),
+    exact is_localization.to_map_ne_zero_of_mem_non_zero_divisors B
+      (powers_le_non_zero_divisors_of_no_zero_divisors (hx.ne_zero))
+      (mem_non_zero_divisors_iff_ne_zero.mpr hx.ne_zero),
+    exact is_localization.injective B (powers_le_non_zero_divisors_of_no_zero_divisors
+      (hx.ne_zero)) },
+  simp only [← subtype.val_eq_coe, ← hy] at H,
+  obtain ⟨m, a, hyp1, hyp2⟩ := max_power_factor ha₀ hx,
+  refine ⟨a, m-d, _⟩,
+  rw [← mk'_one B, self_zpow_pow_sub, self_zpow_coe_nat, self_zpow_coe_nat, ← map_pow _ _ d,
+    mul_comm _ b, H, hyp2, map_mul, map_pow _ _ m],
+  exact ⟨hyp1, (congr_arg _ (is_localization.mk'_one _ _))⟩,
+end
+
+end num_denom
diff --git a/src/ring_theory/localization/basic.lean b/src/ring_theory/localization/basic.lean
index bd6dcb212d573..06c272a17bd50 100644
--- a/src/ring_theory/localization/basic.lean
+++ b/src/ring_theory/localization/basic.lean
@@ -3,7 +3,7 @@ Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
 -/
-import algebra.algebra.basic
+import algebra.algebra.tower
 import algebra.ring.equiv
 import group_theory.monoid_localization
 import ring_theory.ideal.basic
@@ -13,6 +13,9 @@ import tactic.ring_exp
 /-!
 # Localizations of commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We characterize the localization of a commutative ring `R` at a submonoid `M` up to
 isomorphism; that is, a commutative ring `S` is the localization of `R` at `M` iff we can find a
 ring homomorphism `f : R →+* S` satisfying 3 properties:
@@ -93,7 +96,7 @@ expresses that `S` is isomorphic to the localization of `R` at `M`. -/
 class is_localization : Prop :=
 (map_units [] : ∀ y : M, is_unit (algebra_map R S y))
 (surj [] : ∀ z : S, ∃ x : R × M, z * algebra_map R S x.2 = algebra_map R S x.1)
-(eq_iff_exists [] : ∀ {x y}, algebra_map R S x = algebra_map R S y ↔ ∃ c : M, x * c = y * c)
+(eq_iff_exists [] : ∀ {x y}, algebra_map R S x = algebra_map R S y ↔ ∃ c : M, ↑c * x = ↑c * y)
 
 variables {M S}
 
@@ -117,7 +120,7 @@ lemma of_le (N : submonoid R) (h₁ : M ≤ N)
       rintro ⟨c, hc⟩,
       exact ⟨⟨c, h₁ c.2⟩, hc⟩ },
     { rintro ⟨c, h⟩,
-      simpa only [set_like.coe_mk, map_mul, (h₂ c c.2).mul_left_inj] using
+      simpa only [set_like.coe_mk, map_mul, (h₂ c c.2).mul_right_inj] using
         congr_arg (algebra_map R S) h }
   end }
 
@@ -187,7 +190,7 @@ by { rw [hx, (algebra_map R S).map_zero] at h,
 variables (M S)
 
 lemma map_eq_zero_iff (r : R) :
-  algebra_map R S r = 0 ↔ ∃ m : M, r * m = 0 :=
+  algebra_map R S r = 0 ↔ ∃ m : M, ↑m * r = 0 :=
 begin
   split,
   intro h,
@@ -195,7 +198,7 @@ begin
       ((algebra_map R S).map_zero.trans h.symm),
     exact ⟨m, by simpa using hm.symm⟩ },
   { rintro ⟨m, hm⟩,
-    rw [← (is_localization.map_units S m).mul_left_inj, zero_mul, ← ring_hom.map_mul, hm,
+    rw [← (is_localization.map_units S m).mul_right_inj, mul_zero, ← ring_hom.map_mul, hm,
       ring_hom.map_zero] }
 end
 
@@ -275,9 +278,13 @@ def unique_of_zero_mem (h : (0 : R) ∈ M) : unique S :=
 unique_of_zero_eq_one $ by simpa using is_localization.map_units S ⟨0, h⟩
 
 lemma mk'_eq_iff_eq {x₁ x₂} {y₁ y₂ : M} :
-  mk' S x₁ y₁ = mk' S x₂ y₂ ↔ algebra_map R S (x₁ * y₂) = algebra_map R S (x₂ * y₁) :=
+  mk' S x₁ y₁ = mk' S x₂ y₂ ↔ algebra_map R S (y₂ * x₁) = algebra_map R S (y₁ * x₂) :=
 (to_localization_map M S).mk'_eq_iff_eq
 
+lemma mk'_eq_iff_eq' {x₁ x₂} {y₁ y₂ : M} :
+  mk' S x₁ y₁ = mk' S x₂ y₂ ↔ algebra_map R S (x₁ * y₂) = algebra_map R S (x₂ * y₁) :=
+(to_localization_map M S).mk'_eq_iff_eq'
+
 lemma mk'_mem_iff {x} {y : M} {I : ideal S} : mk' S x y ∈ I ↔ algebra_map R S x ∈ I :=
 begin
   split;
@@ -291,11 +298,11 @@ begin
 end
 
 protected lemma eq {a₁ b₁} {a₂ b₂ : M} :
-  mk' S a₁ a₂ = mk' S b₁ b₂ ↔ ∃ c : M, a₁ * b₂ * c = b₁ * a₂ * c :=
+  mk' S a₁ a₂ = mk' S b₁ b₂ ↔ ∃ c : M, ↑c * (↑b₂ * a₁) = c * (a₂ * b₁) :=
 (to_localization_map M S).eq
 
 lemma mk'_eq_zero_iff (x : R) (s : M) :
-  mk' S x s = 0 ↔ ∃ (m : M), x * m = 0 :=
+  mk' S x s = 0 ↔ ∃ (m : M), ↑m * x = 0 :=
 by rw [← (map_units S s).mul_left_inj, mk'_spec, zero_mul, map_eq_zero_iff M]
 
 @[simp] lemma mk'_zero (s : M) : is_localization.mk' S 0 s = 0 :=
@@ -319,10 +326,14 @@ lemma mk'_eq_iff_mk'_eq {x₁ x₂}
   {y₁ y₂ : M} : mk' S x₁ y₁ = mk' S x₂ y₂ ↔ mk' P x₁ y₁ = mk' P x₂ y₂ :=
 (to_localization_map M S).mk'_eq_iff_mk'_eq (to_localization_map M P)
 
-lemma mk'_eq_of_eq {a₁ b₁ : R} {a₂ b₂ : M} (H : b₁ * a₂ = a₁ * b₂) :
+lemma mk'_eq_of_eq {a₁ b₁ : R} {a₂ b₂ : M} (H : ↑a₂ * b₁ = ↑b₂ * a₁) :
   mk' S a₁ a₂ = mk' S b₁ b₂ :=
 (to_localization_map M S).mk'_eq_of_eq H
 
+lemma mk'_eq_of_eq' {a₁ b₁ : R} {a₂ b₂ : M} (H : b₁ * ↑a₂ = a₁ * ↑b₂) :
+  mk' S a₁ a₂ = mk' S b₁ b₂ :=
+(to_localization_map M S).mk'_eq_of_eq' H
+
 variables (S)
 
 @[simp] lemma mk'_self {x : R} (hx : x ∈ M) : mk' S x ⟨x, hx⟩ = 1 :=
@@ -390,13 +401,13 @@ begin
 end
 
 lemma mul_add_inv_left {g : R →+* P} (h : ∀ y : M, is_unit (g y)) (y : M) (w z₁ z₂ : P) :
-  w * ↑(is_unit.lift_right (g.to_monoid_hom.mrestrict M) h y)⁻¹ + z₁ = z₂
+  w * ↑(is_unit.lift_right (g.to_monoid_hom.restrict M) h y)⁻¹ + z₁ = z₂
     ↔ w + g y * z₁ = g y * z₂ :=
 begin
-  rw [mul_comm, ←one_mul z₁, ←units.inv_mul (is_unit.lift_right (g.to_monoid_hom.mrestrict M) h y),
+  rw [mul_comm, ←one_mul z₁, ←units.inv_mul (is_unit.lift_right (g.to_monoid_hom.restrict M) h y),
     mul_assoc, ←mul_add, units.inv_mul_eq_iff_eq_mul, units.inv_mul_cancel_left,
     is_unit.coe_lift_right],
-  simp only [ring_hom.to_monoid_hom_eq_coe, monoid_hom.mrestrict_apply, ring_hom.coe_monoid_hom]
+  simp only [ring_hom.to_monoid_hom_eq_coe, monoid_hom.restrict_apply, ring_hom.coe_monoid_hom]
 end
 
 lemma lift_spec_mul_add {g : R →+* P} (hg : ∀ y : M, is_unit (g y)) (z w w' v) :
@@ -435,7 +446,7 @@ variables {g : R →+* P} (hg : ∀ y : M, is_unit (g y))
 `g : R →* P` such that `g y` is invertible for all `y : M`, the homomorphism induced from
 `S` to `P` maps `f x * (f y)⁻¹` to `g x * (g y)⁻¹` for all `x : R, y ∈ M`. -/
 lemma lift_mk' (x y) :
-  lift hg (mk' S x y) = g x * ↑(is_unit.lift_right (g.to_monoid_hom.mrestrict M) hg y)⁻¹ :=
+  lift hg (mk' S x y) = g x * ↑(is_unit.lift_right (g.to_monoid_hom.restrict M) hg y)⁻¹ :=
 (to_localization_map M S).lift_mk' _ _ _
 
 lemma lift_mk'_spec (x v) (y : M) :
@@ -469,6 +480,12 @@ lemma ring_hom_ext ⦃j k : S →+* P⦄
   (h : j.comp (algebra_map R S) = k.comp (algebra_map R S)) : j = k :=
 ring_hom.coe_monoid_hom_injective $ monoid_hom_ext M $ monoid_hom.ext $ ring_hom.congr_fun h
 
+/- This is not an instance because the submonoid `M` would become a metavariable
+  in typeclass search. -/
+lemma alg_hom_subsingleton [algebra R P] : subsingleton (S →ₐ[R] P) :=
+⟨λ f g, alg_hom.coe_ring_hom_injective $ is_localization.ring_hom_ext M $
+  by rw [f.comp_algebra_map, g.comp_algebra_map]⟩
+
 /-- To show `j` and `k` agree on the whole localization, it suffices to show they agree
 on the image of the base ring, if they preserve `1` and `*`. -/
 protected lemma ext (j k : S → P) (hj1 : j 1 = 1) (hk1 : k 1 = 1)
@@ -675,7 +692,7 @@ begin
     rw [ring_hom.algebra_map_to_algebra, ring_hom.comp_apply, ring_hom.comp_apply,
       is_localization.eq_iff_exists M S],
     simp_rw ← h.to_equiv.apply_eq_iff_eq,
-    change (∃ (c : M), h (h.symm x * c) = h (h.symm y * c)) ↔ _,
+    change (∃ (c : M), h (c * h.symm x) = h (c * h.symm y)) ↔ _,
     simp only [ring_equiv.apply_symm_apply, ring_equiv.map_mul],
     exact ⟨λ ⟨c, e⟩, ⟨⟨_, _, c.prop, rfl⟩, e⟩, λ ⟨⟨_, c, h, e₁⟩, e₂⟩, ⟨⟨_, h⟩, e₁.symm ▸ e₂⟩⟩ }
 end
@@ -704,20 +721,20 @@ variables (M S)
 include M
 
 lemma non_zero_divisors_le_comap [is_localization M S] :
-    non_zero_divisors R ≤ (non_zero_divisors S).comap (algebra_map R S)  :=
+  non_zero_divisors R ≤ (non_zero_divisors S).comap (algebra_map R S)  :=
 begin
   rintros a ha b (e : b * algebra_map R S a = 0),
   obtain ⟨x, s, rfl⟩ := mk'_surjective M b,
   rw [← @mk'_one R _ M, ← mk'_mul, ← (algebra_map R S).map_zero, ← @mk'_one R _ M,
     is_localization.eq] at e,
   obtain ⟨c, e⟩ := e,
-  rw [zero_mul, zero_mul, submonoid.coe_one, mul_one, mul_comm x a, mul_assoc, mul_comm] at e,
+  rw [mul_zero, mul_zero, submonoid.coe_one, one_mul, ←mul_assoc] at e,
   rw mk'_eq_zero_iff,
   exact ⟨c, ha _ e⟩
 end
 
 lemma map_non_zero_divisors_le [is_localization M S] :
-    (non_zero_divisors R).map (algebra_map R S).to_monoid_hom ≤ non_zero_divisors S  :=
+  (non_zero_divisors R).map (algebra_map R S) ≤ non_zero_divisors S  :=
 submonoid.map_le_iff_le_comap.mpr (non_zero_divisors_le_comap M S)
 
 end is_localization
@@ -748,10 +765,11 @@ begin
   rw r_eq_r' at h1 h2 ⊢,
   cases h1 with t₅ ht₅,
   cases h2 with t₆ ht₆,
-  use t₆ * t₅,
-  calc ((b : R) * c + d * a) * (b' * d') * (t₆ * t₅) =
-      (c * d' * t₆) * (b * b' * t₅) + (a * b' * t₅) * (d * d' * t₆) : by ring
-      ... = (b' * c' + d' * a') * (b * d) * (t₆ * t₅) : by rw [ht₆, ht₅]; ring
+  use t₅ * t₆,
+  dsimp only,
+  calc  (↑t₅ * ↑t₆) * ((↑b' * ↑d') * ((b : R) * c + d * a)) =
+      (t₆ * (d' * c)) * (t₅ * (b' * b)) + (t₅ * (b' * a)) * (t₆ * (d' * d)) : by ring
+      ... = (t₅ * t₆) * ((b * d)  * (b' * c' + d' * a')) : by rw [ht₆, ht₅]; ring
 end
 
 instance : has_add (localization M) := ⟨localization.add⟩
@@ -793,6 +811,26 @@ instance : comm_semiring (localization M) :=
   right_distrib  := λ m n k, localization.induction_on₃ m n k (by tac),
   .. localization.comm_monoid_with_zero M }
 
+/--For any given denominator `b : M`, the map `a ↦ a / b` is an `add_monoid_hom` from `R` to
+  `localization M`-/
+@[simps]
+def mk_add_monoid_hom (b : M) : R →+ localization M :=
+{ to_fun := λ a, mk a b,
+  map_zero' := mk_zero _,
+  map_add' := λ x y, (add_mk_self _ _ _).symm }
+
+lemma mk_sum {ι : Type*} (f : ι → R) (s : finset ι) (b : M) :
+  mk (∑ i in s, f i) b = ∑ i in s, mk (f i) b :=
+(mk_add_monoid_hom b).map_sum f s
+
+lemma mk_list_sum (l : list R) (b : M) :
+  mk l.sum b = (l.map $ λ a, mk a b).sum :=
+(mk_add_monoid_hom b).map_list_sum l
+
+lemma mk_multiset_sum (l : multiset R) (b : M) :
+  mk l.sum b = (l.map $ λ a, mk a b).sum :=
+(mk_add_monoid_hom b).map_multiset_sum l
+
 instance {S : Type*} [monoid S] [distrib_mul_action S R] [is_scalar_tower S R R] :
   distrib_mul_action S (localization M) :=
 { smul_zero := λ s, by simp only [←localization.mk_zero 1, localization.smul_mk, smul_zero],
@@ -915,7 +953,7 @@ begin
   rw r_eq_r' at h ⊢,
   cases h with t ht,
   use t,
-  rw [neg_mul, neg_mul, ht],
+  rw [mul_neg, mul_neg, ht],
   ring_nf,
 end
 
@@ -967,7 +1005,7 @@ begin
   rw ← (algebra_map R S).map_zero,
   split; intro h,
   { cases (eq_iff_exists M S).mp h with c hc,
-    rw zero_mul at hc,
+    rw [mul_zero, mul_comm] at hc,
     exact hM c.2 x hc },
   { rw h },
 end
@@ -985,33 +1023,52 @@ protected lemma to_map_ne_zero_of_mem_non_zero_divisors [nontrivial R]
 show (algebra_map R S).to_monoid_with_zero_hom x ≠ 0,
 from map_ne_zero_of_mem_non_zero_divisors (algebra_map R S) (is_localization.injective S hM) hx
 
+variables {S}
+
+lemma sec_snd_ne_zero [nontrivial R] (hM : M ≤ non_zero_divisors R) (x : S) :
+  ((sec M x).snd : R) ≠ 0 :=
+non_zero_divisors.coe_ne_zero ⟨(sec M x).snd.val, hM (sec M x).snd.property⟩
+
+lemma sec_fst_ne_zero [nontrivial R] [no_zero_divisors S] (hM : M ≤ non_zero_divisors R) {x : S}
+  (hx : x ≠ 0) : (sec M x).fst ≠ 0 :=
+begin
+  have hsec := sec_spec M x,
+  intro hfst,
+  rw [hfst, map_zero, mul_eq_zero, _root_.map_eq_zero_iff] at hsec,
+  { exact or.elim hsec hx (sec_snd_ne_zero hM x) },
+  { exact is_localization.injective S hM }
+end
+
 variables (S M) (Q : Type*) [comm_ring Q] {g : R →+* P} [algebra P Q]
 
 /-- Injectivity of a map descends to the map induced on localizations. -/
 lemma map_injective_of_injective
-  (hg : function.injective g) [is_localization (M.map g : submonoid P) Q]
-  (hM : (M.map g : submonoid P) ≤ non_zero_divisors P) :
+  (hg : function.injective g) [is_localization (M.map g : submonoid P) Q] :
   function.injective (map Q g M.le_comap_map : S → Q) :=
 begin
-  rintros x y hxy,
-  obtain ⟨a, b, rfl⟩ := mk'_surjective M x,
-  obtain ⟨c, d, rfl⟩ := mk'_surjective M y,
-  rw [map_mk' _ a b, map_mk' _ c d, mk'_eq_iff_eq] at hxy,
-  refine mk'_eq_iff_eq.2 (congr_arg (algebra_map _ _) (hg _)),
-  convert is_localization.injective _ hM hxy; simp,
+  rw injective_iff_map_eq_zero,
+  intros z hz,
+  obtain ⟨a, b, rfl⟩ := mk'_surjective M z,
+  rw [map_mk', mk'_eq_zero_iff] at hz,
+  obtain ⟨⟨m', hm'⟩, hm⟩ := hz,
+  rw submonoid.mem_map at hm',
+  obtain ⟨n, hn, hnm⟩ := hm',
+  rw [subtype.coe_mk, ← hnm,  ← map_mul, ← map_zero g] at hm,
+  rw [mk'_eq_zero_iff],
+  exact ⟨⟨n, hn⟩, hg hm⟩,
 end
 
 variables {S Q M}
 
 variables (A : Type*) [comm_ring A] [is_domain A]
 
-/-- A `comm_ring` `S` which is the localization of an integral domain `R` at a subset of
-non-zero elements is an integral domain.
+/-- A `comm_ring` `S` which is the localization of a ring `R` without zero divisors at a subset of
+non-zero elements does not have zero divisors.
 See note [reducible non-instances]. -/
 @[reducible]
-theorem is_domain_of_le_non_zero_divisors
+theorem no_zero_divisors_of_le_non_zero_divisors
   [algebra A S] {M : submonoid A} [is_localization M S]
-  (hM : M ≤ non_zero_divisors A) : is_domain S :=
+  (hM : M ≤ non_zero_divisors A) : no_zero_divisors S :=
 { eq_zero_or_eq_zero_of_mul_eq_zero :=
     begin
       intros z w h,
@@ -1024,9 +1081,21 @@ theorem is_domain_of_le_non_zero_divisors
       cases eq_zero_or_eq_zero_of_mul_eq_zero ((to_map_eq_zero_iff S hM).mp this.symm) with H H,
       { exact or.inl (eq_zero_of_fst_eq_zero hx H) },
       { exact or.inr (eq_zero_of_fst_eq_zero hy H) },
-    end,
-  exists_pair_ne := ⟨(algebra_map A S) 0, (algebra_map A S) 1,
-                     λ h, zero_ne_one (is_localization.injective S hM h)⟩, }
+    end }
+
+/-- A `comm_ring` `S` which is the localization of an integral domain `R` at a subset of
+non-zero elements is an integral domain.
+See note [reducible non-instances]. -/
+@[reducible]
+theorem is_domain_of_le_non_zero_divisors
+  [algebra A S] {M : submonoid A} [is_localization M S]
+  (hM : M ≤ non_zero_divisors A) : is_domain S :=
+begin
+  apply no_zero_divisors.to_is_domain _,
+  { exact ⟨⟨(algebra_map A S) 0, (algebra_map A S) 1,
+                      λ h, zero_ne_one (is_localization.injective S hM h)⟩⟩ },
+  { exact no_zero_divisors_of_le_non_zero_divisors _ hM }
+end
 
 variables {A}
 
@@ -1077,7 +1146,12 @@ variables (S M)
 Given an algebra `R → S`, a submonoid `R` of `M`, and a localization `Rₘ` for `M`,
 let `Sₘ` be the localization of `S` to the image of `M` under `algebra_map R S`.
 Then this is the natural algebra structure on `Rₘ → Sₘ`, such that the entire square commutes,
-where `localization_map.map_comp` gives the commutativity of the underlying maps -/
+where `localization_map.map_comp` gives the commutativity of the underlying maps.
+
+This instance can be helpful if you define `Sₘ := localization (algebra.algebra_map_submonoid S M)`,
+however we will instead use the hypotheses `[algebra Rₘ Sₘ] [is_scalar_tower R Rₘ Sₘ]` in lemmas
+since the algebra structure may arise in different ways.
+-/
 noncomputable def localization_algebra : algebra Rₘ Sₘ :=
 (map Sₘ (algebra_map R S)
     (show _ ≤ (algebra.algebra_map_submonoid S M).comap _, from M.le_comap_map)
@@ -1085,18 +1159,75 @@ noncomputable def localization_algebra : algebra Rₘ Sₘ :=
 
 end
 
-lemma algebra_map_mk' (r : R) (m : M) :
-  (@algebra_map Rₘ Sₘ _ _ (localization_algebra M S)) (mk' Rₘ r m) =
-    mk' Sₘ (algebra_map R S r) ⟨algebra_map R S m, algebra.mem_algebra_map_submonoid_of_mem m⟩ :=
-map_mk' _ _ _
+section
+
+variables [algebra Rₘ Sₘ] [algebra R Sₘ] [is_scalar_tower R Rₘ Sₘ] [is_scalar_tower R S Sₘ]
+
+variables (S Rₘ Sₘ)
+include S
+
+lemma is_localization.map_units_map_submonoid (y : M) : is_unit (algebra_map R Sₘ y) :=
+begin
+  rw is_scalar_tower.algebra_map_apply _ S,
+  exact is_localization.map_units Sₘ ⟨algebra_map R S y, algebra.mem_algebra_map_submonoid_of_mem y⟩
+end
+
+@[simp] lemma is_localization.algebra_map_mk' (x : R) (y : M) :
+  algebra_map Rₘ Sₘ (is_localization.mk' Rₘ x y) =
+    is_localization.mk' Sₘ (algebra_map R S x) ⟨algebra_map R S y,
+      algebra.mem_algebra_map_submonoid_of_mem y⟩ :=
+begin
+  rw [is_localization.eq_mk'_iff_mul_eq, subtype.coe_mk, ← is_scalar_tower.algebra_map_apply,
+      ← is_scalar_tower.algebra_map_apply, is_scalar_tower.algebra_map_apply R Rₘ Sₘ,
+      is_scalar_tower.algebra_map_apply R Rₘ Sₘ, ← _root_.map_mul,
+      mul_comm, is_localization.mul_mk'_eq_mk'_of_mul],
+  exact congr_arg (algebra_map Rₘ Sₘ) (is_localization.mk'_mul_cancel_left x y)
+end
+
+variables (M)
+
+/-- If the square below commutes, the bottom map is uniquely specified:
+```
+R  →  S
+↓     ↓
+Rₘ → Sₘ
+```
+-/
+lemma is_localization.algebra_map_eq_map_map_submonoid :
+  algebra_map Rₘ Sₘ = map Sₘ (algebra_map R S)
+    (show _ ≤ (algebra.algebra_map_submonoid S M).comap _, from M.le_comap_map) :=
+eq.symm $ is_localization.map_unique _ (algebra_map Rₘ Sₘ) (λ x,
+  by rw [← is_scalar_tower.algebra_map_apply R S Sₘ, ← is_scalar_tower.algebra_map_apply R Rₘ Sₘ])
+
+/-- If the square below commutes, the bottom map is uniquely specified:
+```
+R  →  S
+↓     ↓
+Rₘ → Sₘ
+```
+-/
+lemma is_localization.algebra_map_apply_eq_map_map_submonoid (x) :
+  algebra_map Rₘ Sₘ x = map Sₘ (algebra_map R S)
+    (show _ ≤ (algebra.algebra_map_submonoid S M).comap _, from M.le_comap_map)
+    x :=
+fun_like.congr_fun (is_localization.algebra_map_eq_map_map_submonoid _ _ _ _) x
+
+variables {R}
+
+lemma is_localization.lift_algebra_map_eq_algebra_map :
+  @is_localization.lift R _ M Rₘ _ _ Sₘ _ _ (algebra_map R Sₘ)
+    (is_localization.map_units_map_submonoid S Sₘ) =
+    algebra_map Rₘ Sₘ :=
+is_localization.lift_unique _ (λ x, (is_scalar_tower.algebra_map_apply _ _ _ _).symm)
+
+end
 
 variables (Rₘ Sₘ)
 
 /-- Injectivity of the underlying `algebra_map` descends to the algebra induced by localization. -/
-lemma localization_algebra_injective (hRS : function.injective (algebra_map R S))
-  (hM : algebra.algebra_map_submonoid S M ≤ non_zero_divisors S) :
+lemma localization_algebra_injective (hRS : function.injective (algebra_map R S)) :
   function.injective (@algebra_map Rₘ Sₘ _ _ (localization_algebra M S)) :=
-is_localization.map_injective_of_injective M Rₘ Sₘ hRS hM
+is_localization.map_injective_of_injective M Rₘ Sₘ hRS
 
 end algebra
 
diff --git a/src/ring_theory/localization/cardinality.lean b/src/ring_theory/localization/cardinality.lean
index 5bc32507eea44..4451cea455ffb 100644
--- a/src/ring_theory/localization/cardinality.lean
+++ b/src/ring_theory/localization/cardinality.lean
@@ -3,13 +3,15 @@ Copyright (c) 2022 Eric Rodriguez. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Rodriguez
 -/
-import ring_theory.integral_domain
-import ring_theory.localization.basic
 import set_theory.cardinal.ordinal
+import ring_theory.artinian
 
 /-!
 # Cardinality of localizations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we establish the cardinality of localizations. In most cases, a localization has
 cardinality equal to the base ring. If there are zero-divisors, however, this is no longer true -
 for example, `zmod 6` localized at `{2, 4}` is equal to `zmod 3`, and if you have zero in your
@@ -23,7 +25,6 @@ submonoid, then your localization is trivial (see `is_localization.unique_of_zer
 
 -/
 
-
 open_locale cardinal non_zero_divisors
 
 universes u v
@@ -34,26 +35,13 @@ variables {R : Type u} [comm_ring R] (S : submonoid R) {L : Type u} [comm_ring L
           [algebra R L] [is_localization S L]
 include S
 
-/-- Localizing a finite ring can only reduce the amount of elements. -/
-lemma algebra_map_surjective_of_fintype [fintype R] : function.surjective (algebra_map R L) :=
-begin
-  classical,
-  haveI : fintype L := is_localization.fintype' S L,
-  intro x,
-  obtain ⟨⟨r, s⟩, h : x * (algebra_map R L) ↑s = (algebra_map R L) r⟩ := is_localization.surj S x,
-  obtain ⟨n, hn, hp⟩ :=
-    (is_of_fin_order_iff_pow_eq_one _).1 (exists_pow_eq_one (is_localization.map_units L s).unit),
-  rw [units.ext_iff, units.coe_pow, is_unit.unit_spec, ←nat.succ_pred_eq_of_pos hn, pow_succ] at hp,
-  exact ⟨r * s ^ (n - 1), by erw [map_mul, map_pow, ←h, mul_assoc, hp, mul_one]⟩
-end
-
 /-- A localization always has cardinality less than or equal to the base ring. -/
 lemma card_le : #L ≤ #R :=
 begin
   classical,
   casesI fintype_or_infinite R,
-  { exact cardinal.mk_le_of_surjective (algebra_map_surjective_of_fintype S) },
-  erw [←cardinal.mul_eq_self $ cardinal.omega_le_mk R],
+  { exact cardinal.mk_le_of_surjective (is_artinian_ring.localization_surjective S _) },
+  erw [←cardinal.mul_eq_self $ cardinal.aleph_0_le_mk R],
   set f : R × R → L := λ aa, is_localization.mk' _ aa.1 (if h : aa.2 ∈ S then ⟨aa.2, h⟩ else 1),
   refine @cardinal.mk_le_of_surjective _ _ f (λ a, _),
   obtain ⟨x, y, h⟩ := is_localization.mk'_surjective S a,
diff --git a/src/ring_theory/localization/fraction_ring.lean b/src/ring_theory/localization/fraction_ring.lean
index 24db6a6ca6fc4..3f54a8978216d 100644
--- a/src/ring_theory/localization/fraction_ring.lean
+++ b/src/ring_theory/localization/fraction_ring.lean
@@ -9,6 +9,9 @@ import ring_theory.localization.basic
 /-!
 # Fraction ring / fraction field Frac(R) as localization
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
  * `is_fraction_ring R K` expresses that `K` is a field of fractions of `R`, as an abbreviation of
@@ -42,7 +45,7 @@ instance rat.is_fraction_ring : is_fraction_ring ℤ ℚ :=
   begin
     rintro ⟨x, hx⟩,
     rw mem_non_zero_divisors_iff_ne_zero at hx,
-    simpa only [ring_hom.eq_int_cast, is_unit_iff_ne_zero, int.cast_eq_zero,
+    simpa only [eq_int_cast, is_unit_iff_ne_zero, int.cast_eq_zero,
                 ne.def, subtype.coe_mk] using hx,
     end,
   surj :=
@@ -54,10 +57,10 @@ instance rat.is_fraction_ring : is_fraction_ring ℤ ℚ :=
   eq_iff_exists :=
   begin
     intros x y,
-    rw [ring_hom.eq_int_cast, ring_hom.eq_int_cast, int.cast_inj],
+    rw [eq_int_cast, eq_int_cast, int.cast_inj],
     refine ⟨by { rintro rfl, use 1 }, _⟩,
     rintro ⟨⟨c, hc⟩, h⟩,
-    apply int.eq_of_mul_eq_mul_right _ h,
+    apply mul_left_cancel₀ _ h,
     rwa mem_non_zero_divisors_iff_ne_zero at hc,
   end }
 
@@ -82,6 +85,9 @@ is_localization.injective _ (le_of_eq rfl)
 
 variables {R K}
 
+@[norm_cast, simp] lemma coe_inj {a b : R} : (↑a : K) = ↑b ↔ a = b :=
+(is_fraction_ring.injective R K).eq_iff
+
 @[priority 100] instance [no_zero_divisors K] : no_zero_smul_divisors R K :=
 no_zero_smul_divisors.of_algebra_map_injective $ is_fraction_ring.injective R K
 
@@ -109,14 +115,16 @@ mk' K ↑(sec (non_zero_divisors A) z).2
    mem_non_zero_divisors_iff_ne_zero.2 $ λ h0, h $
     eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) z) h0⟩
 
-local attribute [semireducible] is_fraction_ring.inv
-
 protected lemma mul_inv_cancel (x : K) (hx : x ≠ 0) :
   x * is_fraction_ring.inv A x = 1 :=
-show x * dite _ _ _ = 1, by rw [dif_neg hx,
-  ←is_unit.mul_left_inj (map_units K ⟨(sec _ x).1, mem_non_zero_divisors_iff_ne_zero.2 $
-    λ h0, hx $ eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) x) h0⟩),
-  one_mul, mul_assoc, mk'_spec, ←eq_mk'_iff_mul_eq]; exact (mk'_sec _ x).symm
+begin
+  rw [is_fraction_ring.inv, dif_neg hx, ←is_unit.mul_left_inj
+    (map_units K ⟨(sec _ x).1, mem_non_zero_divisors_iff_ne_zero.2 $
+      λ h0, hx $ eq_zero_of_fst_eq_zero (sec_spec (non_zero_divisors A) x) h0⟩),
+    one_mul, mul_assoc],
+  rw [mk'_spec, ←eq_mk'_iff_mul_eq],
+  exact (mk'_sec _ x).symm
+end
 
 /-- A `comm_ring` `K` which is the localization of an integral domain `R` at `R - {0}` is a field.
 See note [reducible non-instances]. -/
@@ -124,7 +132,11 @@ See note [reducible non-instances]. -/
 noncomputable def to_field : field K :=
 { inv := is_fraction_ring.inv A,
   mul_inv_cancel := is_fraction_ring.mul_inv_cancel A,
-  inv_zero := dif_pos rfl,
+  inv_zero := begin
+    change is_fraction_ring.inv A (0 : K) = 0,
+    rw [is_fraction_ring.inv],
+    exact dif_pos rfl
+  end,
   .. is_fraction_ring.is_domain A,
   .. show comm_ring K, by apply_instance }
 
@@ -156,7 +168,7 @@ is_unit.mk0 (g y) $ show g.to_monoid_with_zero_hom y ≠ 0,
   {y : non_zero_divisors R} : mk' K x y = 0 ↔ x = 0 :=
 begin
   refine ⟨λ hxy, _, λ h, by rw [h, mk'_zero]⟩,
-  { simp_rw [mk'_eq_zero_iff, mul_right_coe_non_zero_divisors_eq_zero_iff] at hxy,
+  { simp_rw [mk'_eq_zero_iff, mul_left_coe_non_zero_divisors_eq_zero_iff] at hxy,
     exact (exists_const _).mp hxy },
 end
 
@@ -192,7 +204,7 @@ field hom induced from `K` to `L` maps `f x / f y` to `g x / g y` for all
 `x : A, y ∈ non_zero_divisors A`. -/
 lemma lift_mk' (hg : injective g) (x) (y : non_zero_divisors A) :
   lift hg (mk' K x y) = g x / g y :=
-by simp only [mk'_eq_div, ring_hom.map_div, lift_algebra_map]
+by simp only [mk'_eq_div, map_div₀, lift_algebra_map]
 
 /-- Given integral domains `A, B` with fields of fractions `K`, `L`
 and an injective ring hom `j : A →+* B`, we get a field hom
diff --git a/src/ring_theory/localization/ideal.lean b/src/ring_theory/localization/ideal.lean
index 9ccf7028ff2bf..93a871f3285fd 100644
--- a/src/ring_theory/localization/ideal.lean
+++ b/src/ring_theory/localization/ideal.lean
@@ -3,12 +3,15 @@ Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
 -/
-import ring_theory.ideal.operations
+import ring_theory.ideal.quotient_operations
 import ring_theory.localization.basic
 
 /-!
 # Ideals in localizations of commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Implementation notes
 
 See `src/ring_theory/localization/basic.lean` for a design overview.
@@ -80,10 +83,11 @@ theorem comap_map_of_is_prime_disjoint (I : ideal R) (hI : I.is_prime)
 begin
   refine le_antisymm (λ a ha, _) ideal.le_comap_map,
   obtain ⟨⟨b, s⟩, h⟩ := (mem_map_algebra_map_iff M S).1 (ideal.mem_comap.1 ha),
-  replace h : algebra_map R S (a * s) = algebra_map R S b := by simpa only [←map_mul] using h,
+  replace h : algebra_map R S (s * a) = algebra_map R S b :=
+    by simpa only [←map_mul, mul_comm] using h,
   obtain ⟨c, hc⟩ := (eq_iff_exists M S).1 h,
-  have : a * (s * c) ∈ I := by { rw [←mul_assoc, hc], exact I.mul_mem_right c b.2 },
-  exact (hI.mem_or_mem this).resolve_right (λ hsc, hM ⟨(s * c).2, hsc⟩)
+  have : (↑c * ↑s) * a ∈ I := by { rw [mul_assoc, hc], exact I.mul_mem_left c b.2 },
+  exact (hI.mem_or_mem this).resolve_left (λ hsc, hM.le_bot ⟨(c * s).2, hsc⟩)
 end
 
 /-- If `S` is the localization of `R` at a submonoid, the ordering of ideals of `S` is
@@ -103,8 +107,8 @@ lemma is_prime_iff_is_prime_disjoint (J : ideal S) :
     disjoint (M : set R) ↑(ideal.comap (algebra_map R S) J) :=
 begin
   split,
-  { refine λ h, ⟨⟨_, _⟩, λ m hm,
-      h.ne_top (ideal.eq_top_of_is_unit_mem _ hm.2 (map_units S ⟨m, hm.left⟩))⟩,
+  { refine λ h, ⟨⟨_, _⟩, set.disjoint_left.mpr $ λ m hm1 hm2,
+      h.ne_top (ideal.eq_top_of_is_unit_mem _ hm2 (map_units S ⟨m, hm1⟩))⟩,
     { refine λ hJ, h.ne_top _,
       rw [eq_top_iff, ← (order_embedding M S).le_iff_le],
       exact le_of_eq hJ.symm },
@@ -189,6 +193,18 @@ begin
       (by rw [← ring_hom.map_mul, ← mk'_eq_mul_mk'_one, mk'_self, ring_hom.map_one]))) }
 end
 
+open_locale non_zero_divisors
+
+lemma bot_lt_comap_prime [is_domain R] (hM : M ≤ R⁰)
+  (p : ideal S) [hpp : p.is_prime] (hp0 : p ≠ ⊥) :
+  ⊥ < ideal.comap (algebra_map R S) p :=
+begin
+  haveI : is_domain S := is_domain_of_le_non_zero_divisors _ hM,
+  convert (order_iso_of_prime M S).lt_iff_lt.mpr
+    (show (⟨⊥, ideal.bot_prime⟩ : {p : ideal S // p.is_prime}) < ⟨p, hpp⟩, from hp0.bot_lt),
+  exact (ideal.comap_bot_of_injective (algebra_map R S) (is_localization.injective _ hM)).symm,
+end
+
 end comm_ring
 
 end is_localization
diff --git a/src/ring_theory/localization/integer.lean b/src/ring_theory/localization/integer.lean
index aee8886cdb5c6..65928aeded7b1 100644
--- a/src/ring_theory/localization/integer.lean
+++ b/src/ring_theory/localization/integer.lean
@@ -8,6 +8,9 @@ import ring_theory.localization.basic
 /-!
 # Integer elements of a localization
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
  * `is_localization.is_integer` is a predicate stating that `x : S` is in the image of `R`
@@ -71,7 +74,7 @@ let ⟨⟨num, denom⟩, h⟩ := is_localization.surj _ a in ⟨denom, set.mem_r
 
 /-- Each element `a : S` has an `M`-multiple which is an integer.
 
-This version multiplies `a` on the left, matching the argument order in the `has_scalar` instance.
+This version multiplies `a` on the left, matching the argument order in the `has_smul` instance.
 -/
 lemma exists_integer_multiple (a : S) :
   ∃ (b : M), is_integer R ((b : R) • a) :=
@@ -91,10 +94,11 @@ begin
   refl
 end
 
-/-- We can clear the denominators of a `fintype`-indexed family of fractions. -/
-lemma exist_integer_multiples_of_fintype {ι : Type*} [fintype ι] (f : ι → S) :
+/-- We can clear the denominators of a finite indexed family of fractions. -/
+lemma exist_integer_multiples_of_finite {ι : Type*} [finite ι] (f : ι → S) :
   ∃ (b : M), ∀ i, is_localization.is_integer R ((b : R) • f i) :=
 begin
+  casesI nonempty_fintype ι,
   obtain ⟨b, hb⟩ := exist_integer_multiples M finset.univ f,
   exact ⟨b, λ i, hb i (finset.mem_univ _)⟩
 end
diff --git a/src/ring_theory/localization/integral.lean b/src/ring_theory/localization/integral.lean
index a2defcc55fc68..3ffbf6a9d4928 100644
--- a/src/ring_theory/localization/integral.lean
+++ b/src/ring_theory/localization/integral.lean
@@ -3,21 +3,22 @@ Copyright (c) 2018 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
 -/
-import algebra.ring.equiv
+import data.polynomial.lifts
 import group_theory.monoid_localization
 import ring_theory.algebraic
 import ring_theory.ideal.local_ring
-import ring_theory.ideal.quotient
 import ring_theory.integral_closure
 import ring_theory.localization.fraction_ring
 import ring_theory.localization.integer
 import ring_theory.non_zero_divisors
-import group_theory.submonoid.inverses
 import tactic.ring_exp
 
 /-!
 # Integral and algebraic elements of a fraction field
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Implementation notes
 
 See `src/ring_theory/localization/basic.lean` for a design overview.
@@ -152,7 +153,7 @@ begin
   { refine ⟨p.map (algebra_map A K), λ h, hp (polynomial.ext (λ i, _)), _⟩,
     { have : algebra_map A K (p.coeff i) = 0 := trans (polynomial.coeff_map _ _).symm (by simp [h]),
       exact to_map_eq_zero_iff.mp this },
-    { rwa is_scalar_tower.aeval_apply _ K at px } },
+    { exact (polynomial.aeval_map_algebra_map K _ _).trans px, } },
   { exact ⟨integer_normalization _ p,
            mt integer_normalization_eq_zero_iff.mp hp,
            integer_normalization_aeval_eq_zero _ p px⟩ },
@@ -236,9 +237,55 @@ end
 
 lemma is_integral_localization' {R S : Type*} [comm_ring R] [comm_ring S]
   {f : R →+* S} (hf : f.is_integral) (M : submonoid R) :
-  (map (localization (M.map (f : R →* S))) f M.le_comap_map : localization M →+* _).is_integral :=
+  (map (localization (M.map (f : R →* S))) f
+    (M.le_comap_map : _ ≤ submonoid.comap (f : R →* S) _) : localization M →+* _).is_integral :=
 @is_integral_localization R _ M S _ f.to_algebra _ _ _ _ _ _ _ _ hf
 
+variable (M)
+
+lemma is_localization.scale_roots_common_denom_mem_lifts (p : Rₘ[X])
+  (hp : p.leading_coeff ∈ (algebra_map R Rₘ).range) :
+  p.scale_roots (algebra_map R Rₘ $ is_localization.common_denom M p.support p.coeff) ∈
+    polynomial.lifts (algebra_map R Rₘ) :=
+begin
+  rw polynomial.lifts_iff_coeff_lifts,
+  intro n,
+  rw [polynomial.coeff_scale_roots],
+  by_cases h₁ : n ∈ p.support,
+  by_cases h₂ : n = p.nat_degree,
+  { rwa [h₂, polynomial.coeff_nat_degree, tsub_self, pow_zero, _root_.mul_one] },
+  { have : n + 1 ≤ p.nat_degree := lt_of_le_of_ne (polynomial.le_nat_degree_of_mem_supp _ h₁) h₂,
+    rw [← tsub_add_cancel_of_le (le_tsub_of_add_le_left this), pow_add, pow_one, mul_comm,
+      _root_.mul_assoc, ← map_pow],
+    change _ ∈ (algebra_map R Rₘ).range,
+    apply mul_mem,
+    { exact ring_hom.mem_range_self _ _ },
+    { rw ← algebra.smul_def,
+      exact ⟨_, is_localization.map_integer_multiple M p.support p.coeff ⟨n, h₁⟩⟩ } },
+  { rw polynomial.not_mem_support_iff at h₁,
+    rw [h₁, zero_mul],
+    exact zero_mem (algebra_map R Rₘ).range }
+end
+
+lemma is_integral.exists_multiple_integral_of_is_localization
+  [algebra Rₘ S] [is_scalar_tower R Rₘ S] (x : S) (hx : is_integral Rₘ x) :
+    ∃ m : M, is_integral R (m • x) :=
+begin
+  cases subsingleton_or_nontrivial Rₘ with _ nontriv; resetI,
+  { haveI := (algebra_map Rₘ S).codomain_trivial,
+    exact ⟨1, polynomial.X, polynomial.monic_X, subsingleton.elim _ _⟩ },
+  obtain ⟨p, hp₁, hp₂⟩ := hx,
+  obtain ⟨p', hp'₁, -, hp'₂⟩ := lifts_and_nat_degree_eq_and_monic
+    (is_localization.scale_roots_common_denom_mem_lifts M p _) _,
+  { refine ⟨is_localization.common_denom M p.support p.coeff, p', hp'₂, _⟩,
+    rw [is_scalar_tower.algebra_map_eq R Rₘ S, ← polynomial.eval₂_map, hp'₁,
+      submonoid.smul_def, algebra.smul_def, is_scalar_tower.algebra_map_apply R Rₘ S],
+    exact polynomial.scale_roots_eval₂_eq_zero _ hp₂ },
+  { rw hp₁.leading_coeff, exact one_mem _ },
+  { rwa polynomial.monic_scale_roots_iff },
+end
+
+
 end is_integral
 
 variables {A K : Type*} [comm_ring A] [is_domain A]
@@ -265,7 +312,7 @@ lemma is_fraction_ring_of_algebraic (alg : is_algebraic A L)
           (by rw [is_scalar_tower.algebra_map_apply A C L, h, ring_hom.map_zero])))⟩,
      by rw [set_like.coe_mk, algebra_map_mk', ← is_scalar_tower.algebra_map_apply A C L, hxy]⟩,
   eq_iff_exists := λ x y, ⟨λ h, ⟨1, by simpa using algebra_map_injective C A L h⟩, λ ⟨c, hc⟩,
-    congr_arg (algebra_map _ L) (mul_right_cancel₀ (mem_non_zero_divisors_iff_ne_zero.mp c.2) hc)⟩ }
+    congr_arg (algebra_map _ L) (mul_left_cancel₀ (mem_non_zero_divisors_iff_ne_zero.mp c.2) hc)⟩ }
 
 variables (K L)
 
@@ -275,7 +322,7 @@ lemma is_fraction_ring_of_finite_extension [algebra K L] [is_scalar_tower A K L]
   [finite_dimensional K L] : is_fraction_ring C L :=
 is_fraction_ring_of_algebraic A C
   (is_fraction_ring.comap_is_algebraic_iff.mpr (is_algebraic_of_finite K L))
-  (λ x hx, is_fraction_ring.to_map_eq_zero_iff.mp ((algebra_map K L).map_eq_zero.mp $
+  (λ x hx, is_fraction_ring.to_map_eq_zero_iff.mp ((map_eq_zero $ algebra_map K L).mp $
     (is_scalar_tower.algebra_map_apply _ _ _ _).symm.trans hx))
 
 end is_integral_closure
@@ -340,11 +387,11 @@ begin
                     (no_zero_smul_divisors.algebra_map_injective _ _) b h)))),
         rw [polynomial.aeval_def, ← inv_of_eq_inv, polynomial.eval₂_reverse_eq_zero_iff,
           polynomial.eval₂_map, ← is_scalar_tower.algebra_map_eq, ← polynomial.aeval_def,
-          ← is_scalar_tower.algebra_map_aeval, hf₂, ring_hom.map_zero] } } },
+          polynomial.aeval_algebra_map_apply, hf₂, ring_hom.map_zero] } } },
   { intros h x,
     obtain ⟨f, hf₁, hf₂⟩ := h (algebra_map S K x),
     use [f, hf₁],
-    rw [← is_scalar_tower.algebra_map_aeval] at hf₂,
+    rw [polynomial.aeval_algebra_map_apply] at hf₂,
     exact (injective_iff_map_eq_zero (algebra_map S K)).1
       (no_zero_smul_divisors.algebra_map_injective _ _) _ hf₂ }
 end
@@ -376,11 +423,11 @@ begin
   have mk_yz_eq : is_localization.mk' L y' z' = is_localization.mk' L y ⟨_, hz0'⟩,
   { rw [algebra.smul_def, mul_comm _ y, mul_comm _ y', ← set_like.coe_mk (algebra_map R S z) hz0']
         at yz_eq,
-    exact is_localization.mk'_eq_of_eq yz_eq.symm },
+    exact is_localization.mk'_eq_of_eq (by rw [mul_comm _ y, mul_comm _ y', yz_eq]), },
   suffices hy : algebra_map S L (a * y) ∈ submodule.span K (⇑(algebra_map S L) '' b),
   { rw [mk_yz_eq, is_fraction_ring.mk'_eq_div, set_like.coe_mk,
         ← is_scalar_tower.algebra_map_apply, is_scalar_tower.algebra_map_apply R K L,
-        div_eq_mul_inv, ← mul_assoc, mul_comm, ← ring_hom.map_inv, ← algebra.smul_def,
+        div_eq_mul_inv, ← mul_assoc, mul_comm, ← map_inv₀, ← algebra.smul_def,
         ← _root_.map_mul],
     exact (submodule.span K _).smul_mem _ hy },
   refine submodule.span_subset_span R K _ _,
diff --git a/src/ring_theory/localization/inv_submonoid.lean b/src/ring_theory/localization/inv_submonoid.lean
index 4c1ba1919ad43..51092aebf7fd4 100644
--- a/src/ring_theory/localization/inv_submonoid.lean
+++ b/src/ring_theory/localization/inv_submonoid.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kenny Lau, Mario Carneiro, Johan Commelin, Amelia Livingston, Anne Baanen
 -/
 import group_theory.submonoid.inverses
-import ring_theory.finiteness
+import ring_theory.finite_type
 import ring_theory.localization.basic
 import tactic.ring_exp
 
 /-!
 # Submonoid of inverses
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
  * `is_localization.inv_submonoid M S` is the submonoid of `S = M⁻¹R` consisting of inverses of
@@ -38,17 +41,17 @@ section inv_submonoid
 variables (M S)
 
 /-- The submonoid of `S = M⁻¹R` consisting of `{ 1 / x | x ∈ M }`. -/
-def inv_submonoid : submonoid S := (M.map (algebra_map R S : R →* S)).left_inv
+def inv_submonoid : submonoid S := (M.map (algebra_map R S)).left_inv
 
 variable [is_localization M S]
 
-lemma submonoid_map_le_is_unit : M.map (algebra_map R S : R →* S) ≤ is_unit.submonoid S :=
+lemma submonoid_map_le_is_unit : M.map (algebra_map R S) ≤ is_unit.submonoid S :=
 by { rintros _ ⟨a, ha, rfl⟩, exact is_localization.map_units S ⟨_, ha⟩ }
 
 /-- There is an equivalence of monoids between the image of `M` and `inv_submonoid`. -/
 noncomputable
-abbreviation equiv_inv_submonoid : M.map (algebra_map R S : R →* S) ≃* inv_submonoid M S :=
-((M.map (algebra_map R S : R →* S)).left_inv_equiv (submonoid_map_le_is_unit M S)).symm
+abbreviation equiv_inv_submonoid : M.map (algebra_map R S) ≃* inv_submonoid M S :=
+((M.map (algebra_map R S)).left_inv_equiv (submonoid_map_le_is_unit M S)).symm
 
 /-- There is a canonical map from `M` to `inv_submonoid` sending `x` to `1 / x`. -/
 noncomputable
diff --git a/src/ring_theory/localization/localization_localization.lean b/src/ring_theory/localization/localization_localization.lean
index 901d2763d30a6..5cb930a24a433 100644
--- a/src/ring_theory/localization/localization_localization.lean
+++ b/src/ring_theory/localization/localization_localization.lean
@@ -10,6 +10,9 @@ import ring_theory.localization.fraction_ring
 /-!
 # Localizations of localizations
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Implementation notes
 
 See `src/ring_theory/localization/basic.lean` for a design overview.
@@ -87,7 +90,7 @@ end
 
 lemma localization_localization_eq_iff_exists [is_localization N T] (x y : R) :
   algebra_map R T x = algebra_map R T y ↔
-    ∃ (c : localization_localization_submodule M N), x * c = y * c :=
+    ∃ (c : localization_localization_submodule M N), ↑c * x = ↑c * y :=
 begin
   rw [is_scalar_tower.algebra_map_apply R S T, is_scalar_tower.algebra_map_apply R S T,
       is_localization.eq_iff_exists N T],
@@ -95,19 +98,20 @@ begin
   { rintros ⟨z, eq₁⟩,
     rcases is_localization.surj M (z : S) with ⟨⟨z', s⟩, eq₂⟩,
     dsimp only at eq₂,
-    obtain ⟨c, eq₃ : x * z' * ↑ c = y * z' * ↑ c⟩ := (is_localization.eq_iff_exists M S).mp _,
-    swap, { rw [ring_hom.map_mul, ring_hom.map_mul, ← eq₂, ← mul_assoc, ← mul_assoc, ← eq₁] },
-    use z' * c,
+    obtain ⟨c, eq₃ :  ↑c * (x * z') = ↑c * (y * z')⟩ := (is_localization.eq_iff_exists M S).mp _,
+    swap,
+    { rw [map_mul, map_mul, ←eq₂, ←mul_assoc, ←mul_assoc, mul_comm _ ↑z, eq₁, mul_comm _ ↑z] },
+    use c * z',
     { rw mem_localization_localization_submodule,
-      refine ⟨z, s * c, _⟩,
-      rw [ring_hom.map_mul, ← eq₂, mul_assoc, ← ring_hom.map_mul, submonoid.coe_mul] },
-    { simpa only [mul_assoc] using eq₃ } },
-  { rintro ⟨⟨c, hc⟩, eq₁ : x * c = y * c⟩,
+      refine ⟨z, c * s, _⟩,
+      rw [map_mul, ← eq₂, submonoid.coe_mul, map_mul, mul_left_comm] },
+    { rwa [mul_comm _ z', mul_comm _ z', ←mul_assoc, ←mul_assoc] at eq₃ } },
+  { rintro ⟨⟨c, hc⟩, eq₁ : c * x = c * y⟩,
     rw mem_localization_localization_submodule at hc,
     rcases hc with ⟨z₁, z, eq₂⟩,
     use z₁,
-    refine (is_localization.map_units S z).mul_left_inj.mp _,
-    rw [mul_assoc, mul_assoc, ← eq₂, ← ring_hom.map_mul, ← ring_hom.map_mul, eq₁] }
+    refine (is_localization.map_units S z).mul_right_inj.mp _,
+    rw [←mul_assoc, mul_comm _ ↑z₁, ←eq₂, ←map_mul, eq₁, map_mul, eq₂, ←mul_assoc, mul_comm _ ↑z₁] }
 end
 
 /--
@@ -129,7 +133,7 @@ localization is a localization.
 -/
 lemma localization_localization_is_localization_of_has_all_units
   [is_localization N T] (H : ∀ (x : S), is_unit x → x ∈ N) :
-  is_localization (N.comap (algebra_map R S).to_monoid_hom) T :=
+  is_localization (N.comap (algebra_map R S)) T :=
 begin
   convert localization_localization_is_localization M N T,
   symmetry,
@@ -168,8 +172,8 @@ map, then `(M⁻¹R)ₚ` is isomorphic (as an `R`-algebra) to the localization o
 -/
 noncomputable
 def localization_localization_at_prime_iso_localization (p : ideal (localization M)) [p.is_prime] :
-  localization.at_prime (p.comap (algebra_map R _)) ≃ₐ[R] localization.at_prime p :=
-is_localization.alg_equiv (p.comap (algebra_map R _)).prime_compl _ _
+  localization.at_prime (p.comap (algebra_map R (localization M))) ≃ₐ[R] localization.at_prime p :=
+is_localization.alg_equiv (p.comap (algebra_map R (localization M))).prime_compl _ _
 
 end
 
@@ -187,7 +191,7 @@ def localization_algebra_of_submonoid_le
 localization maps -/
 lemma localization_is_scalar_tower_of_submonoid_le
   (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T] :
-  @@is_scalar_tower R S T _ (localization_algebra_of_submonoid_le S T M N h).to_has_scalar _ :=
+  @@is_scalar_tower R S T _ (localization_algebra_of_submonoid_le S T M N h).to_has_smul _ :=
 begin
   letI := localization_algebra_of_submonoid_le S T M N h,
   exact is_scalar_tower.of_algebra_map_eq' (is_localization.lift_comp _).symm
@@ -203,7 +207,7 @@ localization_algebra_of_submonoid_le _ _ x.prime_compl (non_zero_divisors R)
 lemma is_localization_of_submonoid_le
   (M N : submonoid R) (h : M ≤ N) [is_localization M S] [is_localization N T]
   [algebra S T] [is_scalar_tower R S T] :
-  is_localization (N.map (algebra_map R S).to_monoid_hom) T :=
+  is_localization (N.map (algebra_map R S)) T :=
 { map_units := begin
     rintro ⟨_, ⟨y, hy, rfl⟩⟩,
     convert is_localization.map_units T ⟨y, hy⟩,
@@ -217,7 +221,7 @@ lemma is_localization_of_submonoid_le
   eq_iff_exists := λ x₁ x₂, begin
     obtain ⟨⟨y₁, s₁⟩, e₁⟩ := is_localization.surj M x₁,
     obtain ⟨⟨y₂, s₂⟩, e₂⟩ := is_localization.surj M x₂,
-    refine iff.trans _ (set.exists_image_iff (algebra_map R S) N (λ c, x₁ * c = x₂ * c)).symm,
+    refine iff.trans _ (set.exists_image_iff (algebra_map R S) N (λ c, c * x₁ = c * x₂)).symm,
     dsimp only at e₁ e₂ ⊢,
     suffices : algebra_map R T (y₁ * s₂) = algebra_map R T (y₂ * s₁) ↔
       ∃ (a : N), algebra_map R S (a * (y₁ * s₂)) = algebra_map R S (a * (y₂ * s₁)),
@@ -254,7 +258,7 @@ lemma is_localization_of_is_exists_mul_mem (M N : submonoid R) [is_localization
     rintros ⟨x, h⟩,
     obtain ⟨m, hm⟩ := h' x,
     refine ⟨⟨_, hm⟩, _⟩,
-    simp [mul_comm m, ← mul_assoc, h]
+    simp [h, mul_assoc],
   end }
 
 end localization_localization
@@ -300,7 +304,7 @@ begin
   intro hx',
   apply @zero_ne_one S,
   rw [← (algebra_map R S).map_one, ← @mk'_one R _ M, @comm _ eq, mk'_eq_zero_iff],
-  exact ⟨⟨_, hx⟩, (one_mul x).symm ▸ hx'⟩,
+  exact ⟨⟨x, hx⟩, by simp [hx'] ⟩,
 end
 
 end is_fraction_ring
diff --git a/src/ring_theory/localization/module.lean b/src/ring_theory/localization/module.lean
index e47d7f15b914a..efdab085b7ee2 100644
--- a/src/ring_theory/localization/module.lean
+++ b/src/ring_theory/localization/module.lean
@@ -3,21 +3,24 @@ Copyright (c) 2022 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Junyan Xu, Anne Baanen
 -/
-import linear_algebra.linear_independent
+import linear_algebra.basis
 import ring_theory.localization.fraction_ring
 import ring_theory.localization.integer
 
 /-!
 # Modules / vector spaces over localizations / fraction fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some results about vector spaces over the field of fractions of a ring.
 
 ## Main results
 
  * `linear_independent.localization`: `b` is linear independent over a localization of `R`
    if it is linear independent over `R` itself
- * `basis.localization`: promote an `R`-basis `b` to an `Rₛ`-basis,
-   where `Rₛ` is a localization of `R`
+ * `basis.localization_localization`: promote an `R`-basis `b` of `A` to an `Rₛ`-basis of `Aₛ`,
+   where `Rₛ` and `Aₛ` are localizations of `R` and `A` at `s` respectively
  * `linear_independent.iff_fraction_ring`: `b` is linear independent over `R` iff it is
    linear independent over `Frac(R)`
 -/
@@ -40,30 +43,98 @@ lemma linear_independent.localization {ι : Type*} {b : ι → M} (hli : linear_
 begin
   rw linear_independent_iff' at ⊢ hli,
   intros s g hg i hi,
-  choose a g' hg' using is_localization.exist_integer_multiples S s g,
-  letI := λ i, classical.prop_decidable (i ∈ s),
-  specialize hli s (λ i, if hi : i ∈ s then g' i hi else 0) _ i hi,
-  { rw [← @smul_zero _ M _ _ _ (a : R), ← hg, finset.smul_sum],
+  choose! a g' hg' using is_localization.exist_integer_multiples S s g,
+  specialize hli s g' _ i hi,
+  { rw [← @smul_zero _ M _ _ (a : R), ← hg, finset.smul_sum],
     refine finset.sum_congr rfl (λ i hi, _),
-    dsimp only,
-    rw [dif_pos hi, ← is_scalar_tower.algebra_map_smul Rₛ, hg' i hi, smul_assoc],
+    rw [← is_scalar_tower.algebra_map_smul Rₛ, hg' i hi, smul_assoc],
     apply_instance },
   refine ((is_localization.map_units Rₛ a).mul_right_eq_zero).mp _,
-  rw [← algebra.smul_def, ← map_zero (algebra_map R Rₛ), ← hli],
-  simp [hi, hg']
+  rw [← algebra.smul_def, ← map_zero (algebra_map R Rₛ), ← hli, hg' i hi],
 end
 end add_comm_monoid
 
-section add_comm_group
-variables {M : Type*} [add_comm_group M] [module R M] [module Rₛ M] [is_scalar_tower R Rₛ M]
+section localization_localization
+
+variables {A : Type*} [comm_ring A] [algebra R A]
+variables (Aₛ : Type*) [comm_ring Aₛ] [algebra A Aₛ]
+variables [algebra Rₛ Aₛ] [algebra R Aₛ] [is_scalar_tower R Rₛ Aₛ] [is_scalar_tower R A Aₛ]
+variables [hA : is_localization (algebra.algebra_map_submonoid A S) Aₛ]
+include hA
+
+open submodule
+
+lemma linear_independent.localization_localization
+  {ι : Type*} {v : ι → A} (hv : linear_independent R v) :
+  linear_independent Rₛ (algebra_map A Aₛ ∘ v) :=
+begin
+  rw linear_independent_iff' at ⊢ hv,
+  intros s g hg i hi,
+  choose! a g' hg' using is_localization.exist_integer_multiples S s g,
+  have h0 : algebra_map A Aₛ (∑ i in s, g' i • v i) = 0,
+  { apply_fun ((•) (a : R)) at hg,
+    rw [smul_zero, finset.smul_sum] at hg,
+    rw [map_sum, ← hg],
+    refine finset.sum_congr rfl (λ i hi, _),
+    rw [← smul_assoc, ← hg' i hi, algebra.smul_def, map_mul,
+        ← is_scalar_tower.algebra_map_apply, ← algebra.smul_def, algebra_map_smul] },
+  obtain ⟨⟨_, r, hrS, rfl⟩, (hr : algebra_map R A r * _ = 0)⟩ :=
+    (is_localization.map_eq_zero_iff (algebra.algebra_map_submonoid A S) _ _).1 h0,
+  simp_rw [finset.mul_sum, ← algebra.smul_def, smul_smul] at hr,
+  specialize hv s _ hr i hi,
+  rw [← (is_localization.map_units Rₛ a).mul_right_eq_zero, ← algebra.smul_def, ← hg' i hi],
+  exact (is_localization.map_eq_zero_iff S _ _).2 ⟨⟨r, hrS⟩, hv⟩,
+end
+
+lemma span_eq_top.localization_localization {v : set A} (hv : span R v = ⊤) :
+  span Rₛ (algebra_map A Aₛ '' v) = ⊤ :=
+begin
+  rw eq_top_iff,
+  rintros a' -,
+  obtain ⟨a, ⟨_, s, hs, rfl⟩, rfl⟩ := is_localization.mk'_surjective
+    (algebra.algebra_map_submonoid A S) a',
+  rw [is_localization.mk'_eq_mul_mk'_one, mul_comm, ← map_one (algebra_map R A)],
+  erw ← is_localization.algebra_map_mk' A Rₛ Aₛ (1 : R) ⟨s, hs⟩, -- `erw` needed to unify `⟨s, hs⟩`
+  rw ← algebra.smul_def,
+  refine smul_mem _ _ (span_subset_span R _ _ _),
+  rw [← algebra.coe_linear_map, ← linear_map.coe_restrict_scalars R, ← linear_map.map_span],
+  exact mem_map_of_mem (hv.symm ▸ mem_top),
+  { apply_instance }
+end
 
-/-- Promote a basis for `M` over `R` to a basis for `M` over the localization `Rₛ` -/
-noncomputable def basis.localization {ι : Type*} (b : basis ι R M) : basis ι Rₛ M :=
-basis.mk (b.linear_independent.localization Rₛ S) $
-by { rw [← @submodule.restrict_scalars_eq_top_iff Rₛ R, eq_top_iff, ← b.span_eq],
-     apply submodule.span_le_restrict_scalars }
+/-- If `A` has an `R`-basis, then localizing `A` at `S` has a basis over `R` localized at `S`.
 
-end add_comm_group
+A suitable instance for `[algebra A Aₛ]` is `localization_algebra`.
+-/
+noncomputable def basis.localization_localization {ι : Type*} (b : basis ι R A) : basis ι Rₛ Aₛ :=
+basis.mk
+  (b.linear_independent.localization_localization _ S _)
+  (by { rw [set.range_comp, span_eq_top.localization_localization Rₛ S Aₛ b.span_eq],
+        exact le_rfl })
+
+@[simp] lemma basis.localization_localization_apply {ι : Type*} (b : basis ι R A) (i) :
+  b.localization_localization Rₛ S Aₛ i = algebra_map A Aₛ (b i) :=
+basis.mk_apply _ _ _
+
+@[simp] lemma basis.localization_localization_repr_algebra_map
+  {ι : Type*} (b : basis ι R A) (x i) :
+  (b.localization_localization Rₛ S Aₛ).repr (algebra_map A Aₛ x) i =
+    algebra_map R Rₛ (b.repr x i) :=
+calc (b.localization_localization Rₛ S Aₛ).repr (algebra_map A Aₛ x) i
+    = (b.localization_localization Rₛ S Aₛ).repr
+        ((b.repr x).sum (λ j c, algebra_map R Rₛ c • algebra_map A Aₛ (b j))) i :
+  by simp_rw [is_scalar_tower.algebra_map_smul, algebra.smul_def,
+              is_scalar_tower.algebra_map_apply R A Aₛ, ← _root_.map_mul, ← map_finsupp_sum,
+              ← algebra.smul_def, ← finsupp.total_apply, basis.total_repr]
+... = (b.repr x).sum (λ j c, algebra_map R Rₛ c • finsupp.single j 1 i) :
+  by simp_rw [← b.localization_localization_apply Rₛ S Aₛ, map_finsupp_sum,
+              linear_equiv.map_smul, basis.repr_self, finsupp.sum_apply, finsupp.smul_apply]
+... = _ : finset.sum_eq_single i
+            (λ j _ hj, by simp [hj])
+            (λ hi, by simp [finsupp.not_mem_support_iff.mp hi])
+... = algebra_map R Rₛ (b.repr x i) : by simp [algebra.smul_def]
+
+end localization_localization
 
 end localization
 
diff --git a/src/ring_theory/localization/norm.lean b/src/ring_theory/localization/norm.lean
new file mode 100644
index 0000000000000..641c9a51d323d
--- /dev/null
+++ b/src/ring_theory/localization/norm.lean
@@ -0,0 +1,58 @@
+/-
+Copyright (c) 2023 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+
+import ring_theory.localization.module
+import ring_theory.norm
+
+/-!
+
+# Field/algebra norm and localization
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains results on the combination of `algebra.norm` and `is_localization`.
+
+## Main results
+
+ * `algebra.norm_localization`: let `S` be an extension of `R` and `Rₘ Sₘ` be localizations at `M`
+  of `R S` respectively. Then the norm of `a : Sₘ` over `Rₘ` is the norm of `a : S` over `R`
+  if `S` is free as `R`-module
+
+## Tags
+
+field norm, algebra norm, localization
+
+-/
+
+open_locale non_zero_divisors
+
+variables (R : Type*) {S : Type*} [comm_ring R] [comm_ring S] [algebra R S]
+variables {Rₘ Sₘ : Type*} [comm_ring Rₘ] [algebra R Rₘ] [comm_ring Sₘ] [algebra S Sₘ]
+variables (M : submonoid R)
+variables [is_localization M Rₘ] [is_localization (algebra.algebra_map_submonoid S M) Sₘ]
+variables [algebra Rₘ Sₘ] [algebra R Sₘ] [is_scalar_tower R Rₘ Sₘ] [is_scalar_tower R S Sₘ]
+include M
+
+/-- Let `S` be an extension of `R` and `Rₘ Sₘ` be localizations at `M` of `R S` respectively.
+Then the norm of `a : Sₘ` over `Rₘ` is the norm of `a : S` over `R` if `S` is free as `R`-module.
+-/
+lemma algebra.norm_localization [module.free R S] [module.finite R S] (a : S) :
+  algebra.norm Rₘ (algebra_map S Sₘ a) = algebra_map R Rₘ (algebra.norm R a) :=
+begin
+  casesI subsingleton_or_nontrivial R,
+  { haveI : subsingleton Rₘ := module.subsingleton R Rₘ,
+    simp },
+  let b := module.free.choose_basis R S,
+  letI := classical.dec_eq (module.free.choose_basis_index R S),
+  rw [algebra.norm_eq_matrix_det (b.localization_localization Rₘ M Sₘ),
+      algebra.norm_eq_matrix_det b, ring_hom.map_det],
+  congr,
+  ext i j,
+  simp only [matrix.map_apply, ring_hom.map_matrix_apply, algebra.left_mul_matrix_eq_repr_mul,
+      basis.localization_localization_apply, ← _root_.map_mul],
+  apply basis.localization_localization_repr_algebra_map
+end
diff --git a/src/ring_theory/localization/num_denom.lean b/src/ring_theory/localization/num_denom.lean
index b5727660f5d91..1b1ff85f10758 100644
--- a/src/ring_theory/localization/num_denom.lean
+++ b/src/ring_theory/localization/num_denom.lean
@@ -10,6 +10,9 @@ import ring_theory.unique_factorization_domain
 /-!
 # Numerator and denominator in a localization
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Implementation notes
 
 See `src/ring_theory/localization/basic.lean` for a design overview.
@@ -54,8 +57,7 @@ classical.some (exists_reduced_fraction A x)
 noncomputable def denom (x : K) : non_zero_divisors A :=
 classical.some (classical.some_spec (exists_reduced_fraction A x))
 
-lemma num_denom_reduced (x : K) :
-  ∀ {d}, d ∣ num A x → d ∣ denom A x → is_unit d :=
+lemma num_denom_reduced (x : K) {d} : d ∣ num A x → d ∣ denom A x → is_unit d :=
 (classical.some_spec (classical.some_spec (exists_reduced_fraction A x))).1
 
 @[simp] lemma mk'_num_denom (x : K) : mk' K (num A x) (denom A x) = x :=
@@ -75,7 +77,7 @@ lemma num_mul_denom_eq_num_iff_eq' {x y : K} :
 
 lemma num_mul_denom_eq_num_mul_denom_iff_eq {x y : K} :
   num A y * denom A x = num A x * denom A y ↔ x = y :=
-⟨λ h, by simpa only [mk'_num_denom] using mk'_eq_of_eq h,
+⟨λ h, by simpa only [mk'_num_denom] using mk'_eq_of_eq' h,
  λ h, by rw h⟩
 
 lemma eq_zero_of_num_eq_zero {x : K} (h : num A x = 0) : x = 0 :=
@@ -88,7 +90,7 @@ begin
     is_fraction_ring.to_map_ne_zero_of_mem_non_zero_divisors (denom A x).2,
   use ↑d⁻¹ * num A x,
   refine trans _ (mk'_num_denom A x),
-  rw [ring_hom.map_mul, ring_hom.map_units_inv, hd],
+  rw [map_mul, map_units_inv, hd],
   apply mul_left_cancel₀ d_ne_zero,
   rw [←mul_assoc, mul_inv_cancel d_ne_zero, one_mul, mk'_spec']
 end
diff --git a/src/ring_theory/localization/submodule.lean b/src/ring_theory/localization/submodule.lean
index ffe41ebd8441f..ef2f6f717de87 100644
--- a/src/ring_theory/localization/submodule.lean
+++ b/src/ring_theory/localization/submodule.lean
@@ -10,6 +10,9 @@ import ring_theory.principal_ideal_domain
 /-!
 # Submodules in localizations of commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Implementation notes
 
 See `src/ring_theory/localization/basic.lean` for a design overview.
diff --git a/src/ring_theory/matrix_algebra.lean b/src/ring_theory/matrix_algebra.lean
index 13d9febcf0284..11c41cba4fd22 100644
--- a/src/ring_theory/matrix_algebra.lean
+++ b/src/ring_theory/matrix_algebra.lean
@@ -1,12 +1,15 @@
 /-
 Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Scott Morrison
+Authors: Scott Morrison, Eric Wieser
 -/
 import data.matrix.basis
 import ring_theory.tensor_product
 
 /-!
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We show `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)`.
 -/
 
@@ -27,39 +30,16 @@ variables {n : Type w}
 variables (R A n)
 namespace matrix_equiv_tensor
 
-/--
-(Implementation detail).
-The bare function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`, on pure tensors.
--/
-def to_fun (a : A) (m : matrix n n R) : matrix n n A :=
-λ i j, a * algebra_map R A (m i j)
-
-/--
-(Implementation detail).
-The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
-as an `R`-linear map in the second tensor factor.
--/
-def to_fun_right_linear (a : A) : matrix n n R →ₗ[R] matrix n n A :=
-{ to_fun := to_fun R A n a,
-  map_add' := λ x y, by { dsimp only [to_fun], ext, simp [mul_add], },
-  map_smul' := λ r x,
-  begin
-    dsimp only [to_fun],
-    ext,
-    simp only [pi.smul_apply, ring_hom.map_mul, algebra.id.smul_eq_mul],
-    dsimp,
-    rw [algebra.smul_def r, ←_root_.mul_assoc, ←_root_.mul_assoc, algebra.commutes],
-  end, }
-
 /--
 (Implementation detail).
 The function underlying `(A ⊗[R] matrix n n R) →ₐ[R] matrix n n A`,
 as an `R`-bilinear map.
 -/
 def to_fun_bilinear : A →ₗ[R] matrix n n R →ₗ[R] matrix n n A :=
-{ to_fun := to_fun_right_linear R A n,
-  map_add' := λ x y, by { ext, simp [to_fun_right_linear, to_fun, add_mul], },
-  map_smul' := λ r x, by { ext, simp [to_fun_right_linear, to_fun] }, }
+(algebra.lsmul R (matrix n n A)).to_linear_map.compl₂ (algebra.linear_map R A).map_matrix
+
+@[simp] lemma to_fun_bilinear_apply (a : A) (m : matrix n n R) :
+  to_fun_bilinear R A n a m = a • m.map (algebra_map R A) := rfl
 
 /--
 (Implementation detail).
@@ -78,28 +58,23 @@ def to_fun_alg_hom : (A ⊗[R] matrix n n R) →ₐ[R] matrix n n A :=
 alg_hom_of_linear_map_tensor_product
 (to_fun_linear R A n)
 begin
-  intros, ext,
-  simp_rw [to_fun_linear, to_fun_bilinear, lift.tmul],
-  dsimp,
-  simp_rw [to_fun_right_linear],
+  intros,
+  simp_rw [to_fun_linear, lift.tmul, to_fun_bilinear_apply, mul_eq_mul, matrix.map_mul],
+  ext,
   dsimp,
-  simp_rw [to_fun, matrix.mul_mul_left, pi.smul_apply, smul_eq_mul, matrix.mul_apply,
-    ←_root_.mul_assoc _ a₂ _, algebra.commutes, _root_.mul_assoc a₂ _ _, ←finset.mul_sum,
-    ring_hom.map_sum, ring_hom.map_mul, _root_.mul_assoc],
+  simp_rw [matrix.mul_apply, pi.smul_apply, matrix.map_apply, smul_eq_mul, finset.mul_sum,
+    _root_.mul_assoc, algebra.left_comm],
 end
 begin
-  intros, ext,
-  simp only [to_fun_linear, to_fun_bilinear, to_fun_right_linear, to_fun, matrix.one_apply,
-    algebra_map_matrix_apply, lift.tmul, linear_map.coe_mk],
-  split_ifs; simp,
+  intros,
+  simp_rw [to_fun_linear, lift.tmul, to_fun_bilinear_apply,
+    matrix.map_one (algebra_map R A) (map_zero _) (map_one _), algebra_map_smul,
+    algebra.algebra_map_eq_smul_one],
 end
 
 @[simp] lemma to_fun_alg_hom_apply (a : A) (m : matrix n n R) :
-  to_fun_alg_hom R A n (a ⊗ₜ m) = λ i j, a * algebra_map R A (m i j) :=
-begin
-  simp [to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear],
-  refl,
-end
+  to_fun_alg_hom R A n (a ⊗ₜ m) = a • m.map (algebra_map R A) :=
+by simp [to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear]
 
 /--
 (Implementation detail.)
@@ -118,11 +93,11 @@ by simp [inv_fun]
 by simp [inv_fun, add_tmul, finset.sum_add_distrib]
 
 @[simp] lemma inv_fun_smul (a : A) (M : matrix n n A) :
-  inv_fun R A n (λ i j, a * M i j) = (a ⊗ₜ 1) * inv_fun R A n M :=
+  inv_fun R A n (a • M) = (a ⊗ₜ 1) * inv_fun R A n M :=
 by simp [inv_fun,finset.mul_sum]
 
 @[simp] lemma inv_fun_algebra_map (M : matrix n n R) :
-  inv_fun R A n (λ i j, algebra_map R A (M i j)) = 1 ⊗ₜ M :=
+  inv_fun R A n (M.map (algebra_map R A)) = 1 ⊗ₜ M :=
 begin
   dsimp [inv_fun],
   simp only [algebra.algebra_map_eq_smul_one, smul_tmul, ←tmul_sum, mul_boole],
@@ -133,17 +108,18 @@ end
 
 lemma right_inv (M : matrix n n A) : (to_fun_alg_hom R A n) (inv_fun R A n M) = M :=
 begin
-  simp only [inv_fun, alg_hom.map_sum, std_basis_matrix, apply_ite ⇑(algebra_map R A),
-    mul_boole, to_fun_alg_hom_apply, ring_hom.map_zero, ring_hom.map_one],
+  simp only [inv_fun, alg_hom.map_sum, std_basis_matrix, apply_ite ⇑(algebra_map R A), smul_eq_mul,
+    mul_boole, to_fun_alg_hom_apply, ring_hom.map_zero, ring_hom.map_one, matrix.map_apply,
+    pi.smul_def],
   convert finset.sum_product, apply matrix_eq_sum_std_basis,
 end
 
 lemma left_inv (M : A ⊗[R] matrix n n R) : inv_fun R A n (to_fun_alg_hom R A n M) = M :=
 begin
-  apply tensor_product.induction_on M,
+  induction M using tensor_product.induction_on with a m x y hx hy,
+  { simp, },
   { simp, },
-  { intros a m, simp, },
-  { intros x y hx hy, simp [alg_hom.map_sum, hx, hy], },
+  { simp [alg_hom.map_sum, hx, hy], },
 end
 
 /--
@@ -184,7 +160,7 @@ end
 
 @[simp] lemma matrix_equiv_tensor_apply_symm (a : A) (M : matrix n n R) :
   (matrix_equiv_tensor R A n).symm (a ⊗ₜ M) =
-    λ i j, a * algebra_map R A (M i j) :=
+    M.map (λ x, a * algebra_map R A x) :=
 begin
   simp [matrix_equiv_tensor, to_fun_alg_hom, alg_hom_of_linear_map_tensor_product, to_fun_linear],
   refl,
diff --git a/src/ring_theory/multiplicity.lean b/src/ring_theory/multiplicity.lean
index 64b509ce77a60..a0bfb28b60031 100644
--- a/src/ring_theory/multiplicity.lean
+++ b/src/ring_theory/multiplicity.lean
@@ -6,11 +6,13 @@ Authors: Robert Y. Lewis, Chris Hughes
 import algebra.associated
 import algebra.big_operators.basic
 import ring_theory.valuation.basic
-import data.nat.factorization
 
 /-!
 # Multiplicity of a divisor
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For a commutative monoid, this file introduces the notion of multiplicity of a divisor and proves
 several basic results on it.
 
@@ -28,15 +30,15 @@ open nat part
 open_locale big_operators
 
 /-- `multiplicity a b` returns the largest natural number `n` such that
-  `a ^ n ∣ b`, as an `enat` or natural with infinity. If `∀ n, a ^ n ∣ b`,
+  `a ^ n ∣ b`, as an `part_enat` or natural with infinity. If `∀ n, a ^ n ∣ b`,
   then it returns `⊤`-/
-def multiplicity [comm_monoid α] [decidable_rel ((∣) : α → α → Prop)] (a b : α) : enat :=
-enat.find $ λ n, ¬a ^ (n + 1) ∣ b
+def multiplicity [monoid α] [decidable_rel ((∣) : α → α → Prop)] (a b : α) : part_enat :=
+part_enat.find $ λ n, ¬a ^ (n + 1) ∣ b
 
 namespace multiplicity
 
-section comm_monoid
-variables [comm_monoid α]
+section monoid
+variables [monoid α]
 
 /-- `multiplicity.finite a b` indicates that the multiplicity of `a` in `b` is finite. -/
 @[reducible] def finite (a b : α) : Prop := ∃ n : ℕ, ¬a ^ (n + 1) ∣ b
@@ -46,6 +48,9 @@ lemma finite_iff_dom [decidable_rel ((∣) : α → α → Prop)] {a b : α} :
 
 lemma finite_def {a b : α} : finite a b ↔ ∃ n : ℕ, ¬a ^ (n + 1) ∣ b := iff.rfl
 
+lemma not_dvd_one_of_finite_one_right {a : α} : finite a 1 → ¬a ∣ 1 :=
+λ ⟨n, hn⟩ ⟨d, hd⟩, hn ⟨d ^ (n + 1), (pow_mul_pow_eq_one (n + 1) hd.symm).symm⟩
+
 @[norm_cast]
 theorem int.coe_nat_multiplicity (a b : ℕ) :
     multiplicity (a : ℤ) (b : ℤ) = multiplicity a b :=
@@ -62,31 +67,28 @@ lemma not_finite_iff_forall {a b : α} : (¬ finite a b) ↔ ∀ n : ℕ, a ^ n
   by simp [finite, multiplicity, not_not]; tauto⟩
 
 lemma not_unit_of_finite {a b : α} (h : finite a b) : ¬is_unit a :=
-let ⟨n, hn⟩ := h in mt (is_unit_iff_forall_dvd.1 ∘ is_unit.pow (n + 1)) $
-λ h, hn (h b)
-
-lemma finite_of_finite_mul_left {a b c : α} : finite a (b * c) → finite a c :=
-λ ⟨n, hn⟩, ⟨n, λ h, hn (h.trans (by simp [mul_pow]))⟩
+let ⟨n, hn⟩ := h in hn ∘ is_unit.dvd ∘ is_unit.pow (n + 1)
 
 lemma finite_of_finite_mul_right {a b c : α} : finite a (b * c) → finite a b :=
-by rw mul_comm; exact finite_of_finite_mul_left
+λ ⟨n, hn⟩, ⟨n, λ h, hn (h.trans (dvd_mul_right _ _))⟩
 
 variable [decidable_rel ((∣) : α → α → Prop)]
 
-lemma pow_dvd_of_le_multiplicity {a b : α} {k : ℕ} : (k : enat) ≤ multiplicity a b → a ^ k ∣ b :=
-by { rw ← enat.some_eq_coe, exact
+lemma pow_dvd_of_le_multiplicity {a b : α} {k : ℕ} :
+  (k : part_enat) ≤ multiplicity a b → a ^ k ∣ b :=
+by { rw ← part_enat.some_eq_coe, exact
 nat.cases_on k (λ _, by { rw pow_zero, exact one_dvd _ })
   (λ k ⟨h₁, h₂⟩, by_contradiction (λ hk, (nat.find_min _ (lt_of_succ_le (h₂ ⟨k, hk⟩)) hk))) }
 
 lemma pow_multiplicity_dvd {a b : α} (h : finite a b) : a ^ get (multiplicity a b) h ∣ b :=
-pow_dvd_of_le_multiplicity (by rw enat.coe_get)
+pow_dvd_of_le_multiplicity (by rw part_enat.coe_get)
 
 lemma is_greatest  {a b : α} {m : ℕ} (hm : multiplicity a b < m) : ¬a ^ m ∣ b :=
-λ h, by rw [enat.lt_coe_iff] at hm; exact nat.find_spec hm.fst ((pow_dvd_pow _ hm.snd).trans h)
+λ h, by rw [part_enat.lt_coe_iff] at hm; exact nat.find_spec hm.fst ((pow_dvd_pow _ hm.snd).trans h)
 
 lemma is_greatest' {a b : α} {m : ℕ} (h : finite a b) (hm : get (multiplicity a b) h < m) :
   ¬a ^ m ∣ b :=
-is_greatest (by rwa [← enat.coe_lt_coe, enat.coe_get] at hm)
+is_greatest (by rwa [← part_enat.coe_lt_coe, part_enat.coe_get] at hm)
 
 lemma pos_of_dvd {a b : α} (hfin : finite a b) (hdiv : a ∣ b) : 0 < (multiplicity a b).get hfin :=
 begin
@@ -95,69 +97,61 @@ begin
 end
 
 lemma unique {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) :
-  (k : enat) = multiplicity a b :=
+  (k : part_enat) = multiplicity a b :=
 le_antisymm (le_of_not_gt (λ hk', is_greatest hk' hk)) $
   have finite a b, from ⟨k, hsucc⟩,
-  by { rw [enat.le_coe_iff], exact ⟨this, nat.find_min' _ hsucc⟩ }
+  by { rw [part_enat.le_coe_iff], exact ⟨this, nat.find_min' _ hsucc⟩ }
 
 lemma unique' {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬ a ^ (k + 1) ∣ b) :
   k = get (multiplicity a b) ⟨k, hsucc⟩ :=
-by rw [← enat.coe_inj, enat.coe_get, unique hk hsucc]
+by rw [← part_enat.coe_inj, part_enat.coe_get, unique hk hsucc]
 
 lemma le_multiplicity_of_pow_dvd {a b : α}
-  {k : ℕ} (hk : a ^ k ∣ b) : (k : enat) ≤ multiplicity a b :=
+  {k : ℕ} (hk : a ^ k ∣ b) : (k : part_enat) ≤ multiplicity a b :=
 le_of_not_gt $ λ hk', is_greatest hk' hk
 
 lemma pow_dvd_iff_le_multiplicity {a b : α}
-  {k : ℕ} : a ^ k ∣ b ↔ (k : enat) ≤ multiplicity a b :=
+  {k : ℕ} : a ^ k ∣ b ↔ (k : part_enat) ≤ multiplicity a b :=
 ⟨le_multiplicity_of_pow_dvd, pow_dvd_of_le_multiplicity⟩
 
 lemma multiplicity_lt_iff_neg_dvd {a b : α} {k : ℕ} :
-  multiplicity a b < (k : enat) ↔ ¬ a ^ k ∣ b :=
+  multiplicity a b < (k : part_enat) ↔ ¬ a ^ k ∣ b :=
 by { rw [pow_dvd_iff_le_multiplicity, not_le] }
 
 lemma eq_coe_iff {a b : α} {n : ℕ} :
-  multiplicity a b = (n : enat) ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b :=
+  multiplicity a b = (n : part_enat) ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b :=
 begin
-  rw [← enat.some_eq_coe],
+  rw [← part_enat.some_eq_coe],
   exact ⟨λ h, let ⟨h₁, h₂⟩ := eq_some_iff.1 h in
       h₂ ▸ ⟨pow_multiplicity_dvd _, is_greatest
-        (by { rw [enat.lt_coe_iff], exact ⟨h₁, lt_succ_self _⟩ })⟩,
+        (by { rw [part_enat.lt_coe_iff], exact ⟨h₁, lt_succ_self _⟩ })⟩,
     λ h, eq_some_iff.2 ⟨⟨n, h.2⟩, eq.symm $ unique' h.1 h.2⟩⟩
 end
 
 lemma eq_top_iff {a b : α} :
   multiplicity a b = ⊤ ↔ ∀ n : ℕ, a ^ n ∣ b :=
-(enat.find_eq_top_iff _).trans $
+(part_enat.find_eq_top_iff _).trans $
 by { simp only [not_not],
      exact ⟨λ h n, nat.cases_on n (by { rw pow_zero, exact one_dvd _}) (λ n, h _), λ h n, h _⟩ }
 
 @[simp] lemma is_unit_left {a : α} (b : α) (ha : is_unit a) : multiplicity a b = ⊤ :=
-eq_top_iff.2 (λ _, is_unit_iff_forall_dvd.1 (ha.pow _) _)
-
-lemma is_unit_right {a b : α} (ha : ¬is_unit a) (hb : is_unit b) :
-  multiplicity a b = 0 :=
-eq_coe_iff.2 ⟨show a ^ 0 ∣ b, by simp only [pow_zero, one_dvd],
-  by { rw pow_one, exact λ h, mt (is_unit_of_dvd_unit h) ha hb }⟩
+eq_top_iff.2 (λ _, is_unit.dvd (ha.pow _))
 
 @[simp] lemma one_left (b : α) : multiplicity 1 b = ⊤ := is_unit_left b is_unit_one
 
-lemma one_right {a : α} (ha : ¬is_unit a) : multiplicity a 1 = 0 := is_unit_right ha is_unit_one
-
 @[simp] lemma get_one_right {a : α} (ha : finite a 1) : get (multiplicity a 1) ha = 0 :=
 begin
-  rw [enat.get_eq_iff_eq_coe, eq_coe_iff, pow_zero],
-  simpa [is_unit_iff_dvd_one.symm] using not_unit_of_finite ha,
+  rw [part_enat.get_eq_iff_eq_coe, eq_coe_iff, pow_zero],
+  simp [not_dvd_one_of_finite_one_right ha],
 end
 
 @[simp] lemma unit_left (a : α) (u : αˣ) : multiplicity (u : α) a = ⊤ :=
 is_unit_left a u.is_unit
 
-lemma unit_right {a : α} (ha : ¬is_unit a) (u : αˣ) : multiplicity a u = 0 :=
-is_unit_right ha u.is_unit
+lemma multiplicity_eq_zero {a b : α} : multiplicity a b = 0 ↔ ¬ a ∣ b :=
+by { rw [← nat.cast_zero, eq_coe_iff], simp }
 
-lemma multiplicity_eq_zero_of_not_dvd {a b : α} (ha : ¬a ∣ b) : multiplicity a b = 0 :=
-by { rw [← nat.cast_zero, eq_coe_iff], simpa }
+lemma multiplicity_ne_zero {a b : α} : multiplicity a b ≠ 0 ↔ a ∣ b := multiplicity_eq_zero.not_left
 
 lemma eq_top_iff_not_finite {a b : α} : multiplicity a b = ⊤ ↔ ¬ finite a b :=
 part.eq_none_iff'
@@ -185,21 +179,18 @@ lemma multiplicity_le_multiplicity_iff {a b c d : α} : multiplicity a b ≤ mul
   (∀ n : ℕ, a ^ n ∣ b → c ^ n ∣ d) :=
 ⟨λ h n hab, (pow_dvd_of_le_multiplicity (le_trans (le_multiplicity_of_pow_dvd hab) h)),
   λ h, if hab : finite a b
-    then by rw [← enat.coe_get (finite_iff_dom.1 hab)];
+    then by rw [← part_enat.coe_get (finite_iff_dom.1 hab)];
       exact le_multiplicity_of_pow_dvd (h _ (pow_multiplicity_dvd _))
     else
     have ∀ n : ℕ, c ^ n ∣ d, from λ n, h n (not_finite_iff_forall.1 hab _),
     by rw [eq_top_iff_not_finite.2 hab, eq_top_iff_not_finite.2
       (not_finite_iff_forall.2 this)]⟩
 
-lemma multiplicity_le_multiplicity_of_dvd_left {a b c : α} (hdvd : a ∣ b) :
-  multiplicity b c ≤ multiplicity a c :=
-multiplicity_le_multiplicity_iff.2 $ λ n h, (pow_dvd_pow_of_dvd hdvd n).trans h
-
-lemma eq_of_associated_left {a b c : α} (h : associated a b) :
-  multiplicity b c = multiplicity a c :=
-le_antisymm (multiplicity_le_multiplicity_of_dvd_left h.dvd)
-  (multiplicity_le_multiplicity_of_dvd_left h.symm.dvd)
+lemma multiplicity_eq_multiplicity_iff {a b c d : α} : multiplicity a b = multiplicity c d ↔
+  (∀ n : ℕ, a ^ n ∣ b ↔ c ^ n ∣ d) :=
+⟨λ h n, ⟨multiplicity_le_multiplicity_iff.mp h.le n, multiplicity_le_multiplicity_iff.mp h.ge n⟩,
+ λ h, le_antisymm (multiplicity_le_multiplicity_iff.mpr (λ n, (h n).mp))
+                  (multiplicity_le_multiplicity_iff.mpr (λ n, (h n).mpr))⟩
 
 lemma multiplicity_le_multiplicity_of_dvd_right {a b c : α} (h : b ∣ c) :
   multiplicity a b ≤ multiplicity a c :=
@@ -210,24 +201,24 @@ lemma eq_of_associated_right {a b c : α} (h : associated b c) :
 le_antisymm (multiplicity_le_multiplicity_of_dvd_right h.dvd)
   (multiplicity_le_multiplicity_of_dvd_right h.symm.dvd)
 
-lemma dvd_of_multiplicity_pos {a b : α} (h : (0 : enat) < multiplicity a b) : a ∣ b :=
+lemma dvd_of_multiplicity_pos {a b : α} (h : (0 : part_enat) < multiplicity a b) : a ∣ b :=
 begin
   rw ← pow_one a,
   apply pow_dvd_of_le_multiplicity,
-  simpa only [nat.cast_one, enat.pos_iff_one_le] using h
+  simpa only [nat.cast_one, part_enat.pos_iff_one_le] using h
 end
 
-lemma dvd_iff_multiplicity_pos {a b : α} : (0 : enat) < multiplicity a b ↔ a ∣ b :=
+lemma dvd_iff_multiplicity_pos {a b : α} : (0 : part_enat) < multiplicity a b ↔ a ∣ b :=
 ⟨dvd_of_multiplicity_pos,
   λ hdvd, lt_of_le_of_ne (zero_le _) (λ heq, is_greatest
     (show multiplicity a b < ↑1,
-      by simpa only [heq, nat.cast_zero] using enat.coe_lt_coe.mpr zero_lt_one)
+      by simpa only [heq, nat.cast_zero] using part_enat.coe_lt_coe.mpr zero_lt_one)
     (by rwa pow_one a))⟩
 
 lemma finite_nat_iff {a b : ℕ} : finite a b ↔ (a ≠ 1 ∧ 0 < b) :=
 begin
   rw [← not_iff_not, not_finite_iff_forall, not_and_distrib, ne.def,
-    not_not, not_lt, nat.le_zero_iff],
+    not_not, not_lt, le_zero_iff],
   exact ⟨λ h, or_iff_not_imp_right.2 (λ hb,
     have ha : a ≠ 0, from λ ha, by simpa [ha] using h 1,
     by_contradiction (λ ha1 : a ≠ 1,
@@ -238,13 +229,46 @@ begin
     λ h, by cases h; simp *⟩
 end
 
-alias dvd_iff_multiplicity_pos ↔ _ has_dvd.dvd.multiplicity_pos
+alias dvd_iff_multiplicity_pos ↔ _ _root_.has_dvd.dvd.multiplicity_pos
+
+end monoid
+
+section comm_monoid
+variables [comm_monoid α]
+
+lemma finite_of_finite_mul_left {a b c : α} : finite a (b * c) → finite a c :=
+by rw mul_comm; exact finite_of_finite_mul_right
+
+variable [decidable_rel ((∣) : α → α → Prop)]
+
+lemma is_unit_right {a b : α} (ha : ¬is_unit a) (hb : is_unit b) :
+  multiplicity a b = 0 :=
+eq_coe_iff.2 ⟨show a ^ 0 ∣ b, by simp only [pow_zero, one_dvd],
+  by { rw pow_one, exact λ h, mt (is_unit_of_dvd_unit h) ha hb }⟩
+
+lemma one_right {a : α} (ha : ¬is_unit a) : multiplicity a 1 = 0 := is_unit_right ha is_unit_one
+
+lemma unit_right {a : α} (ha : ¬is_unit a) (u : αˣ) : multiplicity a u = 0 :=
+is_unit_right ha u.is_unit
+
+open_locale classical
+
+lemma multiplicity_le_multiplicity_of_dvd_left {a b c : α} (hdvd : a ∣ b) :
+  multiplicity b c ≤ multiplicity a c :=
+multiplicity_le_multiplicity_iff.2 $ λ n h, (pow_dvd_pow_of_dvd hdvd n).trans h
+
+lemma eq_of_associated_left {a b c : α} (h : associated a b) :
+  multiplicity b c = multiplicity a c :=
+le_antisymm (multiplicity_le_multiplicity_of_dvd_left h.dvd)
+  (multiplicity_le_multiplicity_of_dvd_left h.symm.dvd)
+
+alias dvd_iff_multiplicity_pos ↔ _ _root_.has_dvd.dvd.multiplicity_pos
 
 end comm_monoid
 
-section comm_monoid_with_zero
+section monoid_with_zero
 
-variable [comm_monoid_with_zero α]
+variable [monoid_with_zero α]
 
 lemma ne_zero_of_finite {a b : α} (h : finite a b) : b ≠ 0 :=
 let ⟨n, hn⟩ := h in λ hb, by simpa [hb] using hn
@@ -255,17 +279,39 @@ variable [decidable_rel ((∣) : α → α → Prop)]
 part.eq_none_iff.2 (λ n ⟨⟨k, hk⟩, _⟩, hk (dvd_zero _))
 
 @[simp] lemma multiplicity_zero_eq_zero_of_ne_zero (a : α) (ha : a ≠ 0) : multiplicity 0 a = 0 :=
+multiplicity.multiplicity_eq_zero.2 $ mt zero_dvd_iff.1 ha
+
+end monoid_with_zero
+
+section comm_monoid_with_zero
+
+variable [comm_monoid_with_zero α]
+
+variable [decidable_rel ((∣) : α → α → Prop)]
+
+lemma multiplicity_mk_eq_multiplicity [decidable_rel ((∣) : associates α → associates α → Prop)]
+  {a b : α} : multiplicity (associates.mk a) (associates.mk b) = multiplicity a b :=
 begin
-  apply multiplicity.multiplicity_eq_zero_of_not_dvd,
-  rwa zero_dvd_iff,
+  by_cases h : finite a b,
+  { rw ← part_enat.coe_get (finite_iff_dom.mp h),
+    refine (multiplicity.unique
+      (show (associates.mk a)^(((multiplicity a b).get h)) ∣ associates.mk b, from _) _).symm ;
+      rw [← associates.mk_pow, associates.mk_dvd_mk],
+    { exact pow_multiplicity_dvd h },
+    { exact is_greatest ((part_enat.lt_coe_iff _ _).mpr (exists.intro
+        (finite_iff_dom.mp h) (nat.lt_succ_self _))) } },
+  { suffices : ¬ (finite (associates.mk a) (associates.mk b)),
+    { rw [finite_iff_dom, part_enat.not_dom_iff_eq_top] at h this,
+      rw [h, this] },
+    refine not_finite_iff_forall.mpr (λ n, by { rw [← associates.mk_pow, associates.mk_dvd_mk],
+      exact not_finite_iff_forall.mp h n }) }
 end
 
-
 end comm_monoid_with_zero
 
-section comm_semiring
+section semiring
 
-variables [comm_semiring α] [decidable_rel ((∣) : α → α → Prop)]
+variables [semiring α] [decidable_rel ((∣) : α → α → Prop)]
 
 lemma min_le_multiplicity_add {p a b : α} :
   min (multiplicity p a) (multiplicity p b) ≤ multiplicity p (a + b) :=
@@ -275,19 +321,17 @@ lemma min_le_multiplicity_add {p a b : α} :
   (λ h, by rw [min_eq_right h, multiplicity_le_multiplicity_iff];
     exact λ n hn, dvd_add (multiplicity_le_multiplicity_iff.1 h n hn) hn)
 
-end comm_semiring
+end semiring
 
-section comm_ring
+section ring
 
-variables [comm_ring α] [decidable_rel ((∣) : α → α → Prop)]
-
-open_locale classical
+variables [ring α] [decidable_rel ((∣) : α → α → Prop)]
 
 @[simp] protected lemma neg (a b : α) : multiplicity a (-b) = multiplicity a b :=
-part.ext' (by simp only [multiplicity, enat.find, dvd_neg])
-  (λ h₁ h₂, enat.coe_inj.1 (by rw [enat.coe_get]; exact
-    eq.symm (unique ((dvd_neg _ _).2 (pow_multiplicity_dvd _))
-      (mt (dvd_neg _ _).1 (is_greatest' _ (lt_succ_self _))))))
+part.ext' (by simp only [multiplicity, part_enat.find, dvd_neg])
+  (λ h₁ h₂, part_enat.coe_inj.1 (by rw [part_enat.coe_get]; exact
+    eq.symm (unique (pow_multiplicity_dvd _).neg_right
+      (mt dvd_neg.1 (is_greatest' _ (lt_succ_self _))))))
 
 theorem int.nat_abs (a : ℕ) (b : ℤ) : multiplicity a b.nat_abs = multiplicity (a : ℤ) b :=
 begin
@@ -300,13 +344,13 @@ lemma multiplicity_add_of_gt {p a b : α} (h : multiplicity p b < multiplicity p
   multiplicity p (a + b) = multiplicity p b :=
 begin
   apply le_antisymm,
-  { apply enat.le_of_lt_add_one,
-    cases enat.ne_top_iff.mp (enat.ne_top_of_lt h) with k hk,
-    rw [hk], rw_mod_cast [multiplicity_lt_iff_neg_dvd], intro h_dvd,
-    rw [← dvd_add_iff_right] at h_dvd,
+  { apply part_enat.le_of_lt_add_one,
+    cases part_enat.ne_top_iff.mp (part_enat.ne_top_of_lt h) with k hk,
+    rw [hk], rw_mod_cast [multiplicity_lt_iff_neg_dvd, dvd_add_right],
+    intro h_dvd,
     apply multiplicity.is_greatest _ h_dvd, rw [hk], apply_mod_cast nat.lt_succ_self,
     rw [pow_dvd_iff_le_multiplicity, nat.cast_add, ← hk, nat.cast_one],
-    exact enat.add_one_le_of_lt h },
+    exact part_enat.add_one_le_of_lt h },
   { convert min_le_multiplicity_add, rw [min_eq_right (le_of_lt h)] }
 end
 
@@ -323,7 +367,7 @@ begin
   { rw [multiplicity_add_of_gt hab, min_eq_right], exact le_of_lt hab},
 end
 
-end comm_ring
+end ring
 
 section cancel_comm_monoid_with_zero
 
@@ -383,7 +427,7 @@ eq_coe_iff.2 ⟨by simp, λ ⟨b, hb⟩, ha (is_unit_iff_dvd_one.2
 
 @[simp] lemma get_multiplicity_self {a : α} (ha : finite a a) :
   get (multiplicity a a) ha = 1 :=
-enat.get_eq_iff_eq_coe.2 (eq_coe_iff.2
+part_enat.get_eq_iff_eq_coe.2 (eq_coe_iff.2
   ⟨by simp, λ ⟨b, hb⟩,
     by rw [← mul_one a, pow_add, pow_one, mul_assoc, mul_assoc,
         mul_right_inj' (ne_zero_of_finite ha)] at hb;
@@ -412,7 +456,7 @@ have hsucc : ¬p ^ ((get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
   from λ h, by exact
     not_or (is_greatest' _ (lt_succ_self _)) (is_greatest' _ (lt_succ_self _))
       (_root_.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul hp hdiva hdivb h),
-by rw [← enat.coe_inj, enat.coe_get, eq_coe_iff];
+by rw [← part_enat.coe_inj, part_enat.coe_get, eq_coe_iff];
   exact ⟨hdiv, hsucc⟩
 
 open_locale classical
@@ -420,9 +464,9 @@ open_locale classical
 protected lemma mul {p a b : α} (hp : prime p) :
   multiplicity p (a * b) = multiplicity p a + multiplicity p b :=
 if h : finite p a ∧ finite p b then
-by rw [← enat.coe_get (finite_iff_dom.1 h.1), ← enat.coe_get (finite_iff_dom.1 h.2),
-  ← enat.coe_get (finite_iff_dom.1 (finite_mul hp h.1 h.2)),
-    ← nat.cast_add, enat.coe_inj, multiplicity.mul' hp]; refl
+by rw [← part_enat.coe_get (finite_iff_dom.1 h.1), ← part_enat.coe_get (finite_iff_dom.1 h.2),
+  ← part_enat.coe_get (finite_iff_dom.1 (finite_mul hp h.1 h.2)),
+    ← nat.cast_add, part_enat.coe_inj, multiplicity.mul' hp]; refl
 else begin
   rw [eq_top_iff_not_finite.2 (mt (finite_mul_iff hp).1 h)],
   cases not_and_distrib.1 h with h h;
@@ -459,7 +503,6 @@ lemma multiplicity_pow_self_of_prime {p : α} (hp : prime p) (n : ℕ) :
   multiplicity p (p ^ n) = n :=
 multiplicity_pow_self hp.ne_zero hp.not_unit n
 
-
 end cancel_comm_monoid_with_zero
 
 section valuation
@@ -467,8 +510,8 @@ section valuation
 variables {R : Type*} [comm_ring R] [is_domain R] {p : R}
   [decidable_rel (has_dvd.dvd : R → R → Prop)]
 
-/-- `multiplicity` of a prime inan integral domain as an additive valuation to `enat`. -/
-noncomputable def add_valuation (hp : prime p) : add_valuation R enat :=
+/-- `multiplicity` of a prime inan integral domain as an additive valuation to `part_enat`. -/
+noncomputable def add_valuation (hp : prime p) : add_valuation R part_enat :=
 add_valuation.of (multiplicity p) (multiplicity.zero _) (one_right hp.not_unit)
   (λ _ _, min_le_multiplicity_add) (λ a b, multiplicity.mul hp)
 
@@ -487,7 +530,7 @@ lemma multiplicity_eq_zero_of_coprime {p a b : ℕ} (hp : p ≠ 1)
   (hab : nat.coprime a b) : multiplicity p a = 0 :=
 begin
   rw [multiplicity_le_multiplicity_iff] at hle,
-  rw [← nonpos_iff_eq_zero, ← not_lt, enat.pos_iff_one_le, ← nat.cast_one,
+  rw [← nonpos_iff_eq_zero, ← not_lt, part_enat.pos_iff_one_le, ← nat.cast_one,
     ← pow_dvd_iff_le_multiplicity],
   assume h,
   have := nat.dvd_gcd h (hle _ h),
@@ -495,8 +538,4 @@ begin
   exact hp this
 end
 
-lemma multiplicity_eq_factorization {n p : ℕ} (pp : p.prime) (hn : n ≠ 0) :
-  multiplicity p n = n.factorization p :=
-multiplicity.eq_coe_iff.mpr ⟨pow_factorization_dvd n p, pow_succ_factorization_not_dvd hn pp⟩
-
 end nat
diff --git a/src/ring_theory/mv_polynomial/basic.lean b/src/ring_theory/mv_polynomial/basic.lean
index 1bd49bdd30719..6d68cb3780924 100644
--- a/src/ring_theory/mv_polynomial/basic.lean
+++ b/src/ring_theory/mv_polynomial/basic.lean
@@ -5,11 +5,16 @@ Authors: Johannes Hölzl
 -/
 
 import algebra.char_p.basic
+import data.polynomial.algebra_map
+import data.mv_polynomial.variables
 import linear_algebra.finsupp_vector_space
 
 /-!
 # Multivariate polynomials over commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains basic facts about multivariate polynomials over commutative rings, for example
 that the monomials form a basis.
 
@@ -34,8 +39,6 @@ Generalise to noncommutative (semi)rings
 
 noncomputable theory
 
-open_locale classical
-
 open set linear_map submodule
 open_locale big_operators polynomial
 
@@ -94,10 +97,10 @@ begin
   refl
 end
 
-lemma mem_restrict_degree_iff_sup (p : mv_polynomial σ R) (n : ℕ) :
+lemma mem_restrict_degree_iff_sup [decidable_eq σ] (p : mv_polynomial σ R) (n : ℕ) :
   p ∈ restrict_degree σ R n ↔ ∀i, p.degrees.count i ≤ n :=
 begin
-  simp only [mem_restrict_degree, degrees, multiset.count_finset_sup, finsupp.count_to_multiset,
+  simp only [mem_restrict_degree, degrees_def, multiset.count_finset_sup, finsupp.count_to_multiset,
     finset.sup_le_iff],
   exact ⟨assume h n s hs, h s hs n, assume h s hs n, h n s hs⟩
 end
@@ -123,7 +126,7 @@ end mv_polynomial
 /- this is here to avoid import cycle issues -/
 namespace polynomial
 
-/-- The monomials form a basis on `polynomial R`. -/
+/-- The monomials form a basis on `R[X]`. -/
 noncomputable def basis_monomials : basis ℕ R R[X] :=
 basis.of_repr (to_finsupp_iso_alg R).to_linear_equiv
 
diff --git a/src/ring_theory/polynomial/homogeneous.lean b/src/ring_theory/mv_polynomial/homogeneous.lean
similarity index 97%
rename from src/ring_theory/polynomial/homogeneous.lean
rename to src/ring_theory/mv_polynomial/homogeneous.lean
index aab46047cd89a..e3b3e6e53cbd8 100644
--- a/src/ring_theory/polynomial/homogeneous.lean
+++ b/src/ring_theory/mv_polynomial/homogeneous.lean
@@ -3,15 +3,16 @@ Copyright (c) 2020 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Eric Wieser
 -/
-
 import algebra.direct_sum.internal
 import algebra.graded_monoid
-import data.fintype.card
 import data.mv_polynomial.variables
 
 /-!
 # Homogeneous polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A multivariate polynomial `φ` is homogeneous of degree `n`
 if all monomials occuring in `φ` have degree `n`.
 
@@ -152,7 +153,7 @@ lemma is_homogeneous_X (i : σ) :
   is_homogeneous (X i : mv_polynomial σ R) 1 :=
 begin
   apply is_homogeneous_monomial,
-  simp only [finsupp.support_single_ne_zero one_ne_zero, finset.sum_singleton],
+  simp only [finsupp.support_single_ne_zero _ one_ne_zero, finset.sum_singleton],
   exact finsupp.single_eq_same
 end
 
@@ -231,7 +232,6 @@ end is_homogeneous
 
 section
 noncomputable theory
-open_locale classical
 open finset
 
 /-- `homogeneous_component n φ` is the part of `φ` that is homogeneous of degree `n`.
@@ -267,7 +267,8 @@ lemma homogeneous_component_zero : homogeneous_component 0 φ = C (coeff 0 φ) :
 begin
   ext1 d,
   rcases em (d = 0) with (rfl|hd),
-  { simp only [coeff_homogeneous_component, sum_eq_zero_iff, finsupp.zero_apply, if_true, coeff_C,
+  { classical,
+    simp only [coeff_homogeneous_component, sum_eq_zero_iff, finsupp.zero_apply, if_true, coeff_C,
       eq_self_iff_true, forall_true_iff] },
   { rw [coeff_homogeneous_component, if_neg, coeff_C, if_neg (ne.symm hd)],
     simp only [finsupp.ext_iff, finsupp.zero_apply] at hd,
diff --git a/src/ring_theory/mv_polynomial/ideal.lean b/src/ring_theory/mv_polynomial/ideal.lean
new file mode 100644
index 0000000000000..b7ddbc120d4e0
--- /dev/null
+++ b/src/ring_theory/mv_polynomial/ideal.lean
@@ -0,0 +1,61 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import algebra.monoid_algebra.ideal
+import data.mv_polynomial.division
+
+/-!
+# Lemmas about ideals of `mv_polynomial`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Notably this contains results about monomial ideals.
+
+## Main results
+
+* `mv_polynomial.mem_ideal_span_monomial_image`
+* `mv_polynomial.mem_ideal_span_X_image`
+-/
+
+variables {σ R : Type*}
+
+namespace mv_polynomial
+variables [comm_semiring R]
+
+
+/-- `x` is in a monomial ideal generated by `s` iff every element of of its support dominates one of
+the generators. Note that `si ≤ xi` is analogous to saying that the monomial corresponding to `si`
+divides the monomial corresponding to `xi`. -/
+lemma mem_ideal_span_monomial_image
+  {x : mv_polynomial σ R} {s : set (σ →₀ ℕ)} :
+  x ∈ ideal.span ((λ s, monomial s (1 : R)) '' s) ↔ ∀ xi ∈ x.support, ∃ si ∈ s, si ≤ xi :=
+begin
+  refine add_monoid_algebra.mem_ideal_span_of'_image.trans _,
+  simp_rw [le_iff_exists_add, add_comm],
+  refl,
+end
+
+lemma mem_ideal_span_monomial_image_iff_dvd {x : mv_polynomial σ R} {s : set (σ →₀ ℕ)} :
+  x ∈ ideal.span ((λ s, monomial s (1 : R)) '' s) ↔
+    ∀ xi ∈ x.support, ∃ si ∈ s, monomial si 1 ∣ monomial xi (x.coeff xi) :=
+begin
+  refine mem_ideal_span_monomial_image.trans (forall₂_congr $ λ xi hxi, _),
+  simp_rw [monomial_dvd_monomial, one_dvd, and_true, mem_support_iff.mp hxi, false_or],
+end
+
+/-- `x` is in a monomial ideal generated by variables `X` iff every element of of its support
+has a component in `s`. -/
+lemma mem_ideal_span_X_image {x : mv_polynomial σ R} {s : set σ} :
+  x ∈ ideal.span (mv_polynomial.X '' s : set (mv_polynomial σ R)) ↔
+    ∀ m ∈ x.support, ∃ i ∈ s, (m : σ →₀ ℕ) i ≠ 0 :=
+begin
+  have := @mem_ideal_span_monomial_image σ R _ _ ((λ i, finsupp.single i 1) '' s),
+  rw set.image_image at this,
+  refine this.trans _,
+  simp [nat.one_le_iff_ne_zero],
+end
+
+end mv_polynomial
diff --git a/src/ring_theory/mv_polynomial/symmetric.lean b/src/ring_theory/mv_polynomial/symmetric.lean
new file mode 100644
index 0000000000000..9eb7b27d26b8f
--- /dev/null
+++ b/src/ring_theory/mv_polynomial/symmetric.lean
@@ -0,0 +1,229 @@
+/-
+Copyright (c) 2020 Hanting Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Hanting Zhang, Johan Commelin
+-/
+import data.mv_polynomial.rename
+import data.mv_polynomial.comm_ring
+import algebra.algebra.subalgebra.basic
+
+/-!
+# Symmetric Polynomials and Elementary Symmetric Polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines symmetric `mv_polynomial`s and elementary symmetric `mv_polynomial`s.
+We also prove some basic facts about them.
+
+## Main declarations
+
+* `mv_polynomial.is_symmetric`
+
+* `mv_polynomial.symmetric_subalgebra`
+
+* `mv_polynomial.esymm`
+
+## Notation
+
++ `esymm σ R n`, is the `n`th elementary symmetric polynomial in `mv_polynomial σ R`.
+
+As in other polynomial files, we typically use the notation:
+
++ `σ τ : Type*` (indexing the variables)
+
++ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)
+
++ `r : R` elements of the coefficient ring
+
++ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians
+
++ `φ ψ : mv_polynomial σ R`
+
+-/
+
+open equiv (perm)
+open_locale big_operators
+noncomputable theory
+
+namespace multiset
+
+variables {R : Type*} [comm_semiring R]
+
+/-- The `n`th elementary symmetric function evaluated at the elements of `s` -/
+def esymm (s : multiset R) (n : ℕ) : R := ((s.powerset_len n).map multiset.prod).sum
+
+lemma _root_.finset.esymm_map_val {σ} (f : σ → R) (s : finset σ) (n : ℕ) :
+  (s.val.map f).esymm n = (s.powerset_len n).sum (λ t, t.prod f) :=
+by simpa only [esymm, powerset_len_map, ← finset.map_val_val_powerset_len, map_map]
+
+end multiset
+
+namespace mv_polynomial
+
+variables {σ : Type*} {R : Type*}
+variables {τ : Type*} {S : Type*}
+
+/-- A `mv_polynomial φ` is symmetric if it is invariant under
+permutations of its variables by the  `rename` operation -/
+def is_symmetric [comm_semiring R] (φ : mv_polynomial σ R) : Prop :=
+∀ e : perm σ, rename e φ = φ
+
+variables (σ R)
+
+/-- The subalgebra of symmetric `mv_polynomial`s. -/
+def symmetric_subalgebra [comm_semiring R] : subalgebra R (mv_polynomial σ R) :=
+{ carrier := set_of is_symmetric,
+  algebra_map_mem' := λ r e, rename_C e r,
+  mul_mem' := λ a b ha hb e, by rw [alg_hom.map_mul, ha, hb],
+  add_mem' := λ a b ha hb e, by rw [alg_hom.map_add, ha, hb] }
+
+variables {σ R}
+
+@[simp] lemma mem_symmetric_subalgebra [comm_semiring R] (p : mv_polynomial σ R) :
+  p ∈ symmetric_subalgebra σ R ↔ p.is_symmetric := iff.rfl
+
+namespace is_symmetric
+
+section comm_semiring
+variables [comm_semiring R] [comm_semiring S] {φ ψ : mv_polynomial σ R}
+
+@[simp]
+lemma C (r : R) : is_symmetric (C r : mv_polynomial σ R) :=
+(symmetric_subalgebra σ R).algebra_map_mem r
+
+@[simp]
+lemma zero : is_symmetric (0 : mv_polynomial σ R) :=
+(symmetric_subalgebra σ R).zero_mem
+
+@[simp]
+lemma one : is_symmetric (1 : mv_polynomial σ R) :=
+(symmetric_subalgebra σ R).one_mem
+
+lemma add (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ + ψ) :=
+(symmetric_subalgebra σ R).add_mem hφ hψ
+
+lemma mul (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ * ψ) :=
+(symmetric_subalgebra σ R).mul_mem hφ hψ
+
+lemma smul (r : R) (hφ : is_symmetric φ) : is_symmetric (r • φ) :=
+(symmetric_subalgebra σ R).smul_mem hφ r
+
+@[simp]
+lemma map (hφ : is_symmetric φ) (f : R →+* S) : is_symmetric (map f φ) :=
+λ e, by rw [← map_rename, hφ]
+
+end comm_semiring
+
+section comm_ring
+variables [comm_ring R] {φ ψ : mv_polynomial σ R}
+
+lemma neg (hφ : is_symmetric φ) : is_symmetric (-φ) :=
+(symmetric_subalgebra σ R).neg_mem hφ
+
+lemma sub (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ - ψ) :=
+(symmetric_subalgebra σ R).sub_mem hφ hψ
+
+end comm_ring
+
+end is_symmetric
+
+section elementary_symmetric
+open finset
+variables (σ R) [comm_semiring R] [comm_semiring S] [fintype σ] [fintype τ]
+
+/-- The `n`th elementary symmetric `mv_polynomial σ R`. -/
+def esymm (n : ℕ) : mv_polynomial σ R :=
+∑ t in powerset_len n univ, ∏ i in t, X i
+
+/-- The `n`th elementary symmetric `mv_polynomial σ R` is obtained by evaluating the
+`n`th elementary symmetric at the `multiset` of the monomials -/
+lemma esymm_eq_multiset_esymm : esymm σ R = (finset.univ.val.map X).esymm :=
+funext $ λ n, (finset.univ.esymm_map_val X n).symm
+
+lemma aeval_esymm_eq_multiset_esymm [algebra R S] (f : σ → S) (n : ℕ) :
+  aeval f (esymm σ R n) = (finset.univ.val.map f).esymm n :=
+by simp_rw [esymm, aeval_sum, aeval_prod, aeval_X, esymm_map_val]
+
+/-- We can define `esymm σ R n` by summing over a subtype instead of over `powerset_len`. -/
+lemma esymm_eq_sum_subtype (n : ℕ) : esymm σ R n =
+  ∑ t : {s : finset σ // s.card = n}, ∏ i in (t : finset σ), X i :=
+sum_subtype _ (λ _, mem_powerset_len_univ_iff) _
+
+/-- We can define `esymm σ R n` as a sum over explicit monomials -/
+lemma esymm_eq_sum_monomial (n : ℕ) : esymm σ R n =
+  ∑ t in powerset_len n univ, monomial (∑ i in t, finsupp.single i 1) 1 :=
+begin
+  simp_rw monomial_sum_one,
+  refl,
+end
+
+@[simp] lemma esymm_zero : esymm σ R 0 = 1 :=
+by simp only [esymm, powerset_len_zero, sum_singleton, prod_empty]
+
+lemma map_esymm (n : ℕ) (f : R →+* S) : map f (esymm σ R n) = esymm σ S n :=
+by simp_rw [esymm, map_sum, map_prod, map_X]
+
+lemma rename_esymm (n : ℕ) (e : σ ≃ τ) : rename e (esymm σ R n) = esymm τ R n :=
+calc rename e (esymm σ R n)
+     = ∑ x in powerset_len n univ, ∏ i in x, X (e i)
+       : by simp_rw [esymm, map_sum, map_prod, rename_X]
+ ... = ∑ t in powerset_len n (univ.map e.to_embedding), ∏ i in t, X i
+       : by simp [finset.powerset_len_map, -finset.map_univ_equiv]
+ ... = ∑ t in powerset_len n univ, ∏ i in t, X i : by rw finset.map_univ_equiv
+
+lemma esymm_is_symmetric (n : ℕ) : is_symmetric (esymm σ R n) :=
+by { intro, rw rename_esymm }
+
+lemma support_esymm'' (n : ℕ) [decidable_eq σ] [nontrivial R] :
+  (esymm σ R n).support = (powerset_len n (univ : finset σ)).bUnion
+    (λ t, (finsupp.single (∑ (i : σ) in t, finsupp.single i 1) (1:R)).support) :=
+begin
+  rw esymm_eq_sum_monomial,
+  simp only [← single_eq_monomial],
+  convert finsupp.support_sum_eq_bUnion (powerset_len n (univ : finset σ)) _,
+  intros s t hst,
+  rw finset.disjoint_left,
+  simp only [finsupp.support_single_ne_zero _ one_ne_zero, mem_singleton],
+  rintro a h rfl,
+  have := congr_arg finsupp.support h,
+  rw [finsupp.support_sum_eq_bUnion, finsupp.support_sum_eq_bUnion] at this,
+  { simp only [finsupp.support_single_ne_zero _ one_ne_zero, bUnion_singleton_eq_self] at this,
+    exact absurd this hst.symm },
+  all_goals { intros x y, simp [finsupp.support_single_disjoint] }
+end
+
+lemma support_esymm' (n : ℕ) [decidable_eq σ] [nontrivial R] :
+  (esymm σ R n).support =
+  (powerset_len n (univ : finset σ)).bUnion (λ t, {∑ (i : σ) in t, finsupp.single i 1}) :=
+begin
+  rw support_esymm'',
+  congr,
+  funext,
+  exact finsupp.support_single_ne_zero _ one_ne_zero
+end
+
+lemma support_esymm (n : ℕ) [decidable_eq σ] [nontrivial R] :
+  (esymm σ R n).support =
+  (powerset_len n (univ : finset σ)).image (λ t, ∑ (i : σ) in t, finsupp.single i 1) :=
+by { rw support_esymm', exact bUnion_singleton }
+
+lemma degrees_esymm [nontrivial R]
+  (n : ℕ) (hpos : 0 < n) (hn : n ≤ fintype.card σ) :
+  (esymm σ R n).degrees = (univ : finset σ).val :=
+begin
+  classical,
+  have : (finsupp.to_multiset ∘ λ (t : finset σ), ∑ (i : σ) in t, finsupp.single i 1) = finset.val,
+  { funext, simp [finsupp.to_multiset_sum_single] },
+  rw [degrees_def, support_esymm, sup_image, this, ←comp_sup_eq_sup_comp],
+  { obtain ⟨k, rfl⟩ := nat.exists_eq_succ_of_ne_zero hpos.ne',
+    simpa using powerset_len_sup _ _ (nat.lt_of_succ_le hn) },
+  { intros,
+    simp only [union_val, sup_eq_union],
+    congr },
+  { refl }
+end
+
+end elementary_symmetric
+
+end mv_polynomial
diff --git a/src/ring_theory/mv_polynomial/tower.lean b/src/ring_theory/mv_polynomial/tower.lean
new file mode 100644
index 0000000000000..ddfee025e7909
--- /dev/null
+++ b/src/ring_theory/mv_polynomial/tower.lean
@@ -0,0 +1,83 @@
+/-
+Copyright (c) 2022 Yuyang Zhao. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yuyang Zhao
+-/
+
+import algebra.algebra.tower
+import data.mv_polynomial.basic
+
+/-!
+# Algebra towers for multivariate polynomial
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves some basic results about the algebra tower structure for the type
+`mv_polynomial σ R`.
+
+This structure itself is provided elsewhere as `mv_polynomial.is_scalar_tower`
+
+When you update this file, you can also try to make a corresponding update in
+`ring_theory.polynomial.tower`.
+-/
+
+variables (R A B : Type*) {σ : Type*}
+
+namespace mv_polynomial
+
+section semiring
+variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
+variables [algebra R A] [algebra A B] [algebra R B]
+variables [is_scalar_tower R A B]
+
+variables {R B}
+
+theorem aeval_map_algebra_map (x : σ → B) (p : mv_polynomial σ R) :
+  aeval x (map (algebra_map R A) p) = aeval x p :=
+by rw [aeval_def, aeval_def, eval₂_map, is_scalar_tower.algebra_map_eq R A B]
+
+end semiring
+
+section comm_semiring
+variables [comm_semiring R] [comm_semiring A] [comm_semiring B]
+variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]
+
+variables {R A}
+
+lemma aeval_algebra_map_apply (x : σ → A) (p : mv_polynomial σ R) :
+  aeval (algebra_map A B ∘ x) p = algebra_map A B (mv_polynomial.aeval x p) :=
+by rw [aeval_def, aeval_def, ← coe_eval₂_hom, ← coe_eval₂_hom, map_eval₂_hom,
+  ←is_scalar_tower.algebra_map_eq]
+
+lemma aeval_algebra_map_eq_zero_iff [no_zero_smul_divisors A B] [nontrivial B]
+  (x : σ → A) (p : mv_polynomial σ R) :
+  aeval (algebra_map A B ∘ x) p = 0 ↔ aeval x p = 0 :=
+by rw [aeval_algebra_map_apply, algebra.algebra_map_eq_smul_one, smul_eq_zero,
+  iff_false_intro (one_ne_zero' B), or_false]
+
+lemma aeval_algebra_map_eq_zero_iff_of_injective
+  {x : σ → A} {p : mv_polynomial σ R}
+  (h : function.injective (algebra_map A B)) :
+  aeval (algebra_map A B ∘ x) p = 0 ↔ aeval x p = 0 :=
+by rw [aeval_algebra_map_apply, ← (algebra_map A B).map_zero, h.eq_iff]
+
+end comm_semiring
+
+end mv_polynomial
+
+namespace subalgebra
+
+open mv_polynomial
+
+section comm_semiring
+
+variables {R A} [comm_semiring R] [comm_semiring A] [algebra R A]
+
+@[simp] lemma mv_polynomial_aeval_coe (S : subalgebra R A) (x : σ → S) (p : mv_polynomial σ R) :
+  aeval (λ i, (x i : A)) p = aeval x p :=
+by convert aeval_algebra_map_apply A x p
+
+end comm_semiring
+
+end subalgebra
diff --git a/src/ring_theory/mv_polynomial/weighted_homogeneous.lean b/src/ring_theory/mv_polynomial/weighted_homogeneous.lean
new file mode 100644
index 0000000000000..6def165740d0f
--- /dev/null
+++ b/src/ring_theory/mv_polynomial/weighted_homogeneous.lean
@@ -0,0 +1,448 @@
+/-
+Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Antoine Chambert-Loir, María Inés de Frutos-Fernández
+-/
+import algebra.graded_monoid
+import data.mv_polynomial.variables
+
+/-!
+# Weighted homogeneous polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+It is possible to assign weights (in a commutative additive monoid `M`) to the variables of a
+multivariate polynomial ring, so that monomials of the ring then have a weighted degree with
+respect to the weights of the variables. The weights are represented by a function `w : σ → M`,
+where `σ` are the indeterminates.
+
+A multivariate polynomial `φ` is weighted homogeneous of weighted degree `m : M` if all monomials
+occuring in `φ` have the same weighted degree `m`.
+
+## Main definitions/lemmas
+
+* `weighted_total_degree' w φ` : the weighted total degree of a multivariate polynomial with respect
+to the weights `w`, taking values in `with_bot M`.
+
+* `weighted_total_degree w φ` : When `M` has a `⊥` element, we can define the weighted total degree
+of a multivariate polynomial as a function taking values in `M`.
+
+* `is_weighted_homogeneous w φ m`: a predicate that asserts that `φ` is weighted homogeneous
+of weighted degree `m` with respect to the weights `w`.
+
+* `weighted_homogeneous_submodule R w m`: the submodule of homogeneous polynomials
+of weighted degree `m`.
+
+* `weighted_homogeneous_component w m`: the additive morphism that projects polynomials
+onto their summand that is weighted homogeneous of degree `n` with respect to `w`.
+
+* `sum_weighted_homogeneous_component`: every polynomial is the sum of its weighted homogeneous
+components.
+-/
+
+noncomputable theory
+
+open_locale big_operators
+
+open set function finset finsupp add_monoid_algebra
+
+variables {R M : Type*} [comm_semiring R]
+
+namespace mv_polynomial
+variables {σ : Type*}
+
+section add_comm_monoid
+variables [add_comm_monoid M]
+
+/-! ### `weighted_degree'` -/
+
+/-- The `weighted degree'` of the finitely supported function `s : σ →₀ ℕ` is the sum
+  `∑(s i)•(w i)`. -/
+def weighted_degree' (w : σ → M) : (σ →₀ ℕ) →+ M :=
+(finsupp.total σ M ℕ w).to_add_monoid_hom
+
+section semilattice_sup
+variable [semilattice_sup M]
+
+/-- The weighted total degree of a multivariate polynomial, taking values in `with_bot M`. -/
+def weighted_total_degree' (w : σ → M) (p : mv_polynomial σ R) : with_bot M :=
+p.support.sup (λ s, weighted_degree' w s)
+
+/-- The `weighted_total_degree'` of a polynomial `p` is `⊥` if and only if `p = 0`. -/
+lemma weighted_total_degree'_eq_bot_iff (w : σ → M) (p : mv_polynomial σ R) :
+  weighted_total_degree' w p = ⊥ ↔ p = 0 :=
+begin
+  simp only [weighted_total_degree',finset.sup_eq_bot_iff, mem_support_iff, with_bot.coe_ne_bot,
+    mv_polynomial.eq_zero_iff ],
+  exact forall_congr (λ _, not_not)
+end
+
+/-- The `weighted_total_degree'` of the zero polynomial is `⊥`. -/
+lemma weighted_total_degree'_zero (w : σ → M) :
+  weighted_total_degree' w (0 : mv_polynomial σ R) = ⊥ :=
+by simp only [weighted_total_degree', support_zero, finset.sup_empty]
+
+section order_bot
+variable [order_bot M]
+
+/-- When `M` has a `⊥` element, we can define the weighted total degree of a multivariate
+  polynomial as a function taking values in `M`. -/
+def weighted_total_degree (w : σ → M) (p : mv_polynomial σ R) : M :=
+p.support.sup (λ s, weighted_degree' w s)
+
+/-- This lemma relates `weighted_total_degree` and `weighted_total_degree'`. -/
+lemma weighted_total_degree_coe (w : σ → M) (p : mv_polynomial σ R) (hp : p ≠ 0):
+  weighted_total_degree' w p = ↑(weighted_total_degree w p) :=
+begin
+  rw [ne.def, ← weighted_total_degree'_eq_bot_iff w p, ← ne.def, with_bot.ne_bot_iff_exists] at hp,
+  obtain ⟨m, hm⟩ := hp,
+  apply le_antisymm,
+  { simp only [weighted_total_degree, weighted_total_degree', finset.sup_le_iff,
+      with_bot.coe_le_coe],
+    intro b,
+    exact finset.le_sup },
+  { simp only [weighted_total_degree],
+    have hm' : weighted_total_degree' w p ≤ m := le_of_eq hm.symm,
+    rw ← hm,
+    simpa [weighted_total_degree'] using hm' }
+end
+
+/-- The `weighted_total_degree` of the zero polynomial is `⊥`. -/
+lemma weighted_total_degree_zero (w : σ → M) :
+  weighted_total_degree w (0 : mv_polynomial σ R) = ⊥ :=
+by simp only [weighted_total_degree, support_zero, finset.sup_empty]
+
+lemma le_weighted_total_degree (w : σ → M) {φ : mv_polynomial σ R} {d : σ →₀ ℕ}
+  (hd : d ∈ φ.support) : weighted_degree' w d ≤ φ.weighted_total_degree w :=
+le_sup hd
+
+end order_bot
+end semilattice_sup
+
+/-- A multivariate polynomial `φ` is weighted homogeneous of weighted degree `m` if all monomials
+  occuring in `φ` have weighted degree `m`. -/
+def is_weighted_homogeneous (w : σ → M) (φ : mv_polynomial σ R) (m : M) : Prop :=
+∀ ⦃d⦄, coeff d φ ≠ 0 → weighted_degree' w d = m
+
+variable (R)
+
+/-- The submodule of homogeneous `mv_polynomial`s of degree `n`. -/
+def weighted_homogeneous_submodule (w : σ → M) (m : M) :
+  submodule R (mv_polynomial σ R) :=
+{ carrier := { x | x.is_weighted_homogeneous w m },
+  smul_mem' := λ r a ha c hc, begin
+    rw coeff_smul at hc,
+    exact ha (right_ne_zero_of_mul hc),
+  end,
+  zero_mem' := λ d hd, false.elim (hd $ coeff_zero _),
+  add_mem' := λ a b ha hb c hc, begin
+    rw coeff_add at hc,
+    obtain h|h : coeff c a ≠ 0 ∨ coeff c b ≠ 0,
+    { contrapose! hc, simp only [hc, add_zero] },
+    { exact ha h },
+    { exact hb h },
+  end }
+
+@[simp] lemma mem_weighted_homogeneous_submodule (w : σ → M) (m : M) (p : mv_polynomial σ R) :
+  p ∈ weighted_homogeneous_submodule R w m ↔ p.is_weighted_homogeneous w m := iff.rfl
+
+variables (R)
+
+/-- The submodule ` weighted_homogeneous_submodule R w m` of homogeneous `mv_polynomial`s of
+  degree `n` is equal to the `R`-submodule of all `p : (σ →₀ ℕ) →₀ R` such that
+  `p.support ⊆ {d | weighted_degree' w d = m}`. While equal, the former has a
+  convenient definitional reduction. -/
+lemma weighted_homogeneous_submodule_eq_finsupp_supported (w : σ → M) (m : M) :
+  weighted_homogeneous_submodule R w m =
+  finsupp.supported _ R {d | weighted_degree' w d = m} :=
+begin
+  ext,
+  simp only [mem_supported, set.subset_def, finsupp.mem_support_iff, mem_coe],
+  refl,
+end
+
+variables {R}
+
+/-- The submodule generated by products `Pm *Pn` of weighted homogeneous polynomials of degrees `m`
+  and `n` is contained in the submodule of weighted homogeneous polynomials of degree `m + n`. -/
+lemma weighted_homogeneous_submodule_mul (w : σ → M) (m n : M) :
+  weighted_homogeneous_submodule R w m * weighted_homogeneous_submodule R w n ≤
+    weighted_homogeneous_submodule R w (m + n) :=
+begin
+  rw submodule.mul_le,
+  intros φ hφ ψ hψ c hc,
+  rw [coeff_mul] at hc,
+  obtain ⟨⟨d, e⟩, hde, H⟩ := finset.exists_ne_zero_of_sum_ne_zero hc,
+  have aux : coeff d φ ≠ 0 ∧ coeff e ψ ≠ 0,
+  { contrapose! H,
+    by_cases h : coeff d φ = 0;
+    simp only [*, ne.def, not_false_iff, zero_mul, mul_zero] at * },
+  rw [← (finsupp.mem_antidiagonal.mp hde), ← hφ aux.1, ← hψ aux.2, map_add],
+end
+
+/-- Monomials are weighted homogeneous. -/
+lemma is_weighted_homogeneous_monomial (w : σ → M) (d : σ →₀ ℕ) (r : R) {m : M}
+  (hm : weighted_degree' w d = m) : is_weighted_homogeneous w (monomial d r) m :=
+begin
+  classical,
+  intros c hc,
+  rw coeff_monomial at hc,
+  split_ifs at hc with h,
+  { subst c, exact hm },
+  { contradiction }
+end
+
+/-- A polynomial of weighted_total_degree `⊥` is weighted_homogeneous of degree `⊥`. -/
+lemma is_weighted_homogeneous_of_total_degree_zero [semilattice_sup M] [order_bot M]
+  (w : σ → M) {p : mv_polynomial σ R} (hp : weighted_total_degree w p = (⊥ : M)) :
+  is_weighted_homogeneous w p (⊥ : M) :=
+begin
+  intros d hd,
+  have h := weighted_total_degree_coe w p (mv_polynomial.ne_zero_iff.mpr ⟨d, hd⟩),
+  simp only [weighted_total_degree', hp] at h,
+  rw [eq_bot_iff, ← with_bot.coe_le_coe, ← h],
+  exact finset.le_sup (mem_support_iff.mpr hd),
+end
+
+/-- Constant polynomials are weighted homogeneous of degree 0. -/
+lemma is_weighted_homogeneous_C (w : σ → M) (r : R) :
+  is_weighted_homogeneous w (C r : mv_polynomial σ R) 0 :=
+is_weighted_homogeneous_monomial _ _ _ (map_zero _)
+
+variables (R)
+
+/-- 0 is weighted homogeneous of any degree. -/
+lemma is_weighted_homogeneous_zero (w : σ → M) (m : M) :
+  is_weighted_homogeneous w (0 : mv_polynomial σ R) m :=
+(weighted_homogeneous_submodule R w m).zero_mem
+
+/-- 1 is weighted homogeneous of degree 0. -/
+lemma is_weighted_homogeneous_one (w : σ → M) :
+  is_weighted_homogeneous w (1 : mv_polynomial σ R) 0 :=
+is_weighted_homogeneous_C _ _
+
+/-- An indeterminate `i : σ` is weighted homogeneous of degree `w i`. -/
+lemma is_weighted_homogeneous_X (w : σ → M) (i : σ) :
+  is_weighted_homogeneous w (X i : mv_polynomial σ R) (w i) :=
+begin
+  apply is_weighted_homogeneous_monomial,
+  simp only [weighted_degree', linear_map.to_add_monoid_hom_coe, total_single, one_nsmul],
+end
+
+namespace is_weighted_homogeneous
+variables {R} {φ ψ : mv_polynomial σ R} {m n : M}
+
+/-- The weighted degree of a weighted homogeneous polynomial controls its support. -/
+lemma coeff_eq_zero {w : σ → M} (hφ : is_weighted_homogeneous w φ n) (d : σ →₀ ℕ)
+  (hd : weighted_degree' w d ≠ n) : coeff d φ = 0 :=
+by { have aux := mt (@hφ d) hd, rwa not_not at aux }
+
+/-- The weighted degree of a nonzero weighted homogeneous polynomial is well-defined. -/
+lemma inj_right {w : σ → M} (hφ : φ ≠ 0) (hm : is_weighted_homogeneous w φ m)
+  (hn : is_weighted_homogeneous w φ n) : m = n :=
+begin
+  obtain ⟨d, hd⟩ : ∃ d, coeff d φ ≠ 0 := exists_coeff_ne_zero hφ,
+  rw [← hm hd, ← hn hd]
+end
+
+/-- The sum of two weighted homogeneous polynomials of degree `n` is weighted homogeneous of
+  weighted degree `n`. -/
+lemma add {w : σ → M} (hφ : is_weighted_homogeneous w φ n) (hψ : is_weighted_homogeneous w ψ n) :
+  is_weighted_homogeneous w (φ + ψ) n :=
+(weighted_homogeneous_submodule R w n).add_mem hφ hψ
+
+/-- The sum of weighted homogeneous polynomials of degree `n` is weighted homogeneous of
+  weighted degree `n`. -/
+lemma sum  {ι : Type*} (s : finset ι)  (φ : ι → mv_polynomial σ R) (n : M) {w : σ → M}
+  (h : ∀ i ∈ s, is_weighted_homogeneous w (φ i) n) :
+  is_weighted_homogeneous w (∑ i in s, φ i) n :=
+(weighted_homogeneous_submodule R w n).sum_mem h
+
+/-- The product of weighted homogeneous polynomials of weighted degrees `m` and `n` is weighted
+  homogeneous of weighted degree `m + n`. -/
+lemma mul {w : σ → M} (hφ : is_weighted_homogeneous w φ m) (hψ : is_weighted_homogeneous w ψ n) :
+  is_weighted_homogeneous w (φ * ψ) (m + n) :=
+weighted_homogeneous_submodule_mul w m n $ submodule.mul_mem_mul hφ hψ
+
+/-- A product of weighted homogeneous polynomials is weighted homogeneous, with weighted degree
+  equal to the sum of the weighted degrees. -/
+lemma prod {ι : Type*} (s : finset ι) (φ : ι → mv_polynomial σ R) (n : ι → M) {w : σ → M} :
+  (∀ i ∈ s, is_weighted_homogeneous w (φ i) (n i)) →
+  is_weighted_homogeneous w (∏ i in s, φ i) (∑ i in s, n i) :=
+begin
+  classical,
+  apply finset.induction_on s,
+  { intro, simp only [is_weighted_homogeneous_one, finset.sum_empty, finset.prod_empty] },
+  { intros i s his IH h,
+    simp only [his, finset.prod_insert, finset.sum_insert, not_false_iff],
+    apply (h i (finset.mem_insert_self _ _)).mul (IH _),
+    intros j hjs,
+    exact h j (finset.mem_insert_of_mem hjs) }
+end
+
+/-- A non zero weighted homogeneous polynomial of weighted degree `n` has weighted total degree
+  `n`. -/
+lemma weighted_total_degree [semilattice_sup M] {w : σ → M} (hφ : is_weighted_homogeneous w φ n)
+  (h : φ ≠ 0) : weighted_total_degree' w φ = n :=
+begin
+  simp only [weighted_total_degree'],
+  apply le_antisymm,
+  { simp only [finset.sup_le_iff, mem_support_iff, with_bot.coe_le_coe],
+    exact λ d hd, le_of_eq (hφ hd), },
+  { obtain ⟨d, hd⟩ : ∃ d, coeff d φ ≠ 0 := exists_coeff_ne_zero h,
+    simp only [← hφ hd, finsupp.sum],
+    replace hd := finsupp.mem_support_iff.mpr hd,
+    exact finset.le_sup hd, }
+end
+
+/-- The weighted homogeneous submodules form a graded monoid. -/
+instance weighted_homogeneous_submodule.gcomm_monoid {w : σ → M} :
+  set_like.graded_monoid (weighted_homogeneous_submodule R w) :=
+{ one_mem := is_weighted_homogeneous_one R w,
+  mul_mem := λ i j xi xj, is_weighted_homogeneous.mul }
+
+end is_weighted_homogeneous
+
+variables {R}
+
+/-- `weighted_homogeneous_component w n φ` is the part of `φ` that is weighted homogeneous of
+  weighted degree `n`, with respect to the weights `w`.
+  See `sum_weighted_homogeneous_component` for the statement that `φ` is equal to the sum
+  of all its weighted homogeneous components. -/
+def weighted_homogeneous_component (w : σ → M) (n : M) :
+  mv_polynomial σ R →ₗ[R] mv_polynomial σ R :=
+(submodule.subtype _).comp $ finsupp.restrict_dom _ _ {d | weighted_degree' w d = n}
+
+section weighted_homogeneous_component
+
+variables {w : σ → M} (n : M) (φ ψ : mv_polynomial σ R)
+
+lemma coeff_weighted_homogeneous_component [decidable_eq M] (d : σ →₀ ℕ) :
+  coeff d (weighted_homogeneous_component w n φ) =
+    if weighted_degree' w d = n then coeff d φ else 0 :=
+finsupp.filter_apply (λ d : σ →₀ ℕ, weighted_degree' w d = n) φ d
+
+lemma weighted_homogeneous_component_apply [decidable_eq M] :
+  weighted_homogeneous_component w n φ =
+  ∑ d in φ.support.filter (λ d, weighted_degree' w d = n), monomial d (coeff d φ) :=
+finsupp.filter_eq_sum (λ d : σ →₀ ℕ, weighted_degree' w d = n) φ
+
+/-- The `n` weighted homogeneous component of a polynomial is weighted homogeneous of
+weighted degree `n`. -/
+lemma weighted_homogeneous_component_is_weighted_homogeneous :
+  (weighted_homogeneous_component w n φ).is_weighted_homogeneous w n :=
+begin
+  classical,
+  intros d hd,
+  contrapose! hd,
+  rw [coeff_weighted_homogeneous_component, if_neg hd]
+end
+
+@[simp] lemma weighted_homogeneous_component_C_mul (n : M) (r : R) :
+  weighted_homogeneous_component w n (C r * φ) = C r * weighted_homogeneous_component w n φ :=
+by simp only [C_mul', linear_map.map_smul]
+
+lemma weighted_homogeneous_component_eq_zero' (h : ∀ d : σ →₀ ℕ, d ∈ φ.support →
+  weighted_degree' w d ≠ n) : weighted_homogeneous_component w n φ = 0 :=
+begin
+  classical,
+  rw [weighted_homogeneous_component_apply, sum_eq_zero],
+  intros d hd, rw mem_filter at hd,
+  exfalso, exact h _ hd.1 hd.2
+end
+
+lemma weighted_homogeneous_component_eq_zero [semilattice_sup M] [order_bot M]
+  (h : weighted_total_degree w φ < n) : weighted_homogeneous_component w n φ = 0 :=
+begin
+  classical,
+  rw [weighted_homogeneous_component_apply, sum_eq_zero],
+  intros d hd, rw mem_filter at hd,
+  exfalso,
+  apply lt_irrefl n,
+  nth_rewrite 0 ← hd.2,
+  exact lt_of_le_of_lt (le_weighted_total_degree w hd.1) h,
+end
+
+lemma weighted_homogeneous_component_finsupp :
+  (function.support (λ m, weighted_homogeneous_component w m φ)).finite :=
+begin
+  suffices : function.support (λ m, weighted_homogeneous_component w m φ) ⊆
+    (λ d, weighted_degree' w d) '' φ.support,
+  { exact finite.subset ((λ (d : σ →₀ ℕ), (weighted_degree' w) d) '' ↑(support φ)).to_finite this },
+  intros m hm,
+  by_contradiction hm', apply hm,
+  simp only [mem_support, ne.def] at hm,
+  simp only [set.mem_image, not_exists, not_and] at hm',
+  exact weighted_homogeneous_component_eq_zero' m φ hm',
+end
+
+variable (w)
+
+/-- Every polynomial is the sum of its weighted homogeneous components. -/
+lemma sum_weighted_homogeneous_component :
+  finsum (λ m, weighted_homogeneous_component w m φ) = φ :=
+begin
+  classical,
+  rw finsum_eq_sum _ (weighted_homogeneous_component_finsupp φ),
+  ext1 d,
+  simp only [coeff_sum, coeff_weighted_homogeneous_component],
+  rw finset.sum_eq_single (weighted_degree' w d),
+  { rw if_pos rfl, },
+  { intros m hm hm', rw if_neg hm'.symm, },
+  { intro hm, rw if_pos rfl,
+    simp only [finite.mem_to_finset, mem_support, ne.def, not_not] at hm,
+    have := coeff_weighted_homogeneous_component (_ : M) φ d,
+    rw [hm, if_pos rfl, coeff_zero] at this,
+    exact this.symm, },
+end
+
+variable {w}
+
+/-- The weighted homogeneous components of a weighted homogeneous polynomial. -/
+lemma weighted_homogeneous_component_weighted_homogeneous_polynomial [decidable_eq M] (m n : M)
+  (p : mv_polynomial σ R) (h : p ∈ weighted_homogeneous_submodule R w n) :
+  weighted_homogeneous_component w m p = if m = n then p else 0 :=
+begin
+  simp only [mem_weighted_homogeneous_submodule] at h,
+  ext x,
+  rw coeff_weighted_homogeneous_component,
+  by_cases zero_coeff : coeff x p = 0,
+  { split_ifs,
+    all_goals { simp only [zero_coeff, coeff_zero], }, },
+  { rw h zero_coeff,
+    simp only [show n = m ↔ m = n, from eq_comm],
+    split_ifs with h1,
+    { refl },
+    { simp only [coeff_zero] } }
+end
+
+end weighted_homogeneous_component
+
+end add_comm_monoid
+
+section canonically_ordered_add_monoid
+
+variables [canonically_ordered_add_monoid M] {w : σ → M} (φ : mv_polynomial σ R)
+
+/-- If `M` is a `canonically_ordered_add_monoid`, then the `weighted_homogeneous_component`
+  of weighted degree `0` of a polynomial is its constant coefficient. -/
+@[simp] lemma weighted_homogeneous_component_zero [no_zero_smul_divisors ℕ M]
+  (hw : ∀ i : σ, w i ≠ 0) : weighted_homogeneous_component w 0 φ = C (coeff 0 φ) :=
+begin
+  classical,
+  ext1 d,
+  rcases em (d = 0) with (rfl|hd),
+  { simp only [coeff_weighted_homogeneous_component, if_pos, map_zero, coeff_zero_C] },
+  { rw [coeff_weighted_homogeneous_component, if_neg, coeff_C, if_neg (ne.symm hd)],
+    simp only [weighted_degree', linear_map.to_add_monoid_hom_coe, finsupp.total_apply,
+      finsupp.sum, sum_eq_zero_iff, finsupp.mem_support_iff, ne.def, smul_eq_zero,
+      not_forall, not_or_distrib, and_self_left, exists_prop],
+    simp only [finsupp.ext_iff, finsupp.coe_zero, pi.zero_apply, not_forall] at hd,
+    obtain ⟨i, hi⟩ := hd,
+    exact ⟨i, hi, hw i⟩ }
+end
+
+end canonically_ordered_add_monoid
+
+end mv_polynomial
diff --git a/src/ring_theory/nakayama.lean b/src/ring_theory/nakayama.lean
index 58714ac589368..b5fe642599314 100644
--- a/src/ring_theory/nakayama.lean
+++ b/src/ring_theory/nakayama.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes
 -/
-import ring_theory.noetherian
 import ring_theory.jacobson_ideal
+
 /-!
 # Nakayama's lemma
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some alternative statements of Nakayama's Lemma as found in
 [Stacks: Nakayama's Lemma](https://stacks.math.columbia.edu/tag/00DV).
 
diff --git a/src/ring_theory/nilpotent.lean b/src/ring_theory/nilpotent.lean
index cbd0e92609f27..1795de367c5f9 100644
--- a/src/ring_theory/nilpotent.lean
+++ b/src/ring_theory/nilpotent.lean
@@ -10,6 +10,9 @@ import ring_theory.ideal.operations
 /-!
 # Nilpotent elements
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
   * `is_nilpotent`
@@ -53,7 +56,7 @@ lemma is_nilpotent.map [monoid_with_zero R] [monoid_with_zero S] {r : R}
 by { use hr.some, rw [← map_pow, hr.some_spec, map_zero] }
 
 /-- A structure that has zero and pow is reduced if it has no nonzero nilpotent elements. -/
-class is_reduced (R : Type*) [has_zero R] [has_pow R ℕ] : Prop :=
+@[mk_iff] class is_reduced (R : Type*) [has_zero R] [has_pow R ℕ] : Prop :=
 (eq_zero : ∀ (x : R), is_nilpotent x → x = 0)
 
 @[priority 900]
@@ -83,6 +86,35 @@ begin
   exact (hx.map f).eq_zero,
 end
 
+lemma ring_hom.ker_is_radical_iff_reduced_of_surjective {S F} [comm_semiring R] [comm_ring S]
+  [ring_hom_class F R S] {f : F} (hf : function.surjective f) :
+  (ring_hom.ker f).is_radical ↔ is_reduced S :=
+by simp_rw [is_reduced_iff, hf.forall, is_nilpotent, ← map_pow, ← ring_hom.mem_ker]; refl
+
+/-- An element `y` in a monoid is radical if for any element `x`, `y` divides `x` whenever it
+  divides a power of `x`. -/
+def is_radical [has_dvd R] [has_pow R ℕ] (y : R) : Prop := ∀ (n : ℕ) x, y ∣ x ^ n → y ∣ x
+
+lemma zero_is_radical_iff [monoid_with_zero R] : is_radical (0 : R) ↔ is_reduced R :=
+by { simp_rw [is_reduced_iff, is_nilpotent, exists_imp_distrib, ← zero_dvd_iff], exact forall_swap }
+
+lemma is_radical_iff_span_singleton [comm_semiring R] :
+  is_radical y ↔ (ideal.span ({y} : set R)).is_radical :=
+begin
+  simp_rw [is_radical, ← ideal.mem_span_singleton],
+  exact forall_swap.trans (forall_congr $ λ r, exists_imp_distrib.symm),
+end
+
+lemma is_radical_iff_pow_one_lt [monoid_with_zero R] (k : ℕ) (hk : 1 < k) :
+  is_radical y ↔ ∀ x, y ∣ x ^ k → y ∣ x :=
+⟨λ h x, h k x, λ h, k.cauchy_induction_mul
+  (λ n h x hd, h x $ (pow_succ' x n).symm ▸ hd.mul_right x) 0 hk
+  (λ x hd, pow_one x ▸ hd) (λ n _ hn x hd, h x $ hn _ $ (pow_mul x k n).subst hd)⟩
+
+lemma is_reduced_iff_pow_one_lt [monoid_with_zero R] (k : ℕ) (hk : 1 < k) :
+  is_reduced R ↔ ∀ x : R, x ^ k = 0 → x = 0 :=
+by simp_rw [← zero_is_radical_iff, is_radical_iff_pow_one_lt k hk, zero_dvd_iff]
+
 namespace commute
 
 section semiring
@@ -146,7 +178,7 @@ lemma mem_nilradical : x ∈ nilradical R ↔ is_nilpotent x := iff.rfl
 
 lemma nilradical_eq_Inf (R : Type*) [comm_semiring R] :
   nilradical R = Inf { J : ideal R | J.is_prime } :=
-by { convert ideal.radical_eq_Inf 0, simp }
+(ideal.radical_eq_Inf ⊥).trans $ by simp_rw and_iff_right bot_le
 
 lemma nilpotent_iff_mem_prime : is_nilpotent x ↔ ∀ (J : ideal R), J.is_prime → x ∈ J :=
 by { rw [← mem_nilradical, nilradical_eq_Inf, submodule.mem_Inf], refl }
@@ -159,27 +191,27 @@ ideal.ext $ λ _, is_nilpotent_iff_eq_zero
 
 end comm_semiring
 
-namespace algebra
+namespace linear_map
 
 variables (R) {A : Type v} [comm_semiring R] [semiring A] [algebra R A]
 
-@[simp] lemma is_nilpotent_lmul_left_iff (a : A) :
-  is_nilpotent (lmul_left R a) ↔ is_nilpotent a :=
+@[simp] lemma is_nilpotent_mul_left_iff (a : A) :
+  is_nilpotent (mul_left R a) ↔ is_nilpotent a :=
 begin
   split; rintros ⟨n, hn⟩; use n;
-  simp only [lmul_left_eq_zero_iff, pow_lmul_left] at ⊢ hn;
+  simp only [mul_left_eq_zero_iff, pow_mul_left] at ⊢ hn;
   exact hn,
 end
 
-@[simp] lemma is_nilpotent_lmul_right_iff (a : A) :
-  is_nilpotent (lmul_right R a) ↔ is_nilpotent a :=
+@[simp] lemma is_nilpotent_mul_right_iff (a : A) :
+  is_nilpotent (mul_right R a) ↔ is_nilpotent a :=
 begin
   split; rintros ⟨n, hn⟩; use n;
-  simp only [lmul_right_eq_zero_iff, pow_lmul_right] at ⊢ hn;
+  simp only [mul_right_eq_zero_iff, pow_mul_right] at ⊢ hn;
   exact hn,
 end
 
-end algebra
+end linear_map
 
 namespace module.End
 
diff --git a/src/ring_theory/noetherian.lean b/src/ring_theory/noetherian.lean
index cb4176840af2d..a0067dc2d6d6f 100644
--- a/src/ring_theory/noetherian.lean
+++ b/src/ring_theory/noetherian.lean
@@ -3,17 +3,22 @@ Copyright (c) 2018 Mario Carneiro, Kevin Buzzard. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Kevin Buzzard
 -/
-import group_theory.finiteness
-import data.multiset.finset_ops
+import algebra.algebra.subalgebra.basic
 import algebra.algebra.tower
-import order.order_iso_nat
-import ring_theory.ideal.operations
-import order.compactly_generated
+import algebra.ring.idempotents
+import group_theory.finiteness
 import linear_algebra.linear_independent
+import order.compactly_generated
+import order.order_iso_nat
+import ring_theory.finiteness
+import ring_theory.nilpotent
 
 /-!
 # Noetherian rings and modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The following are equivalent for a module M over a ring R:
 1. Every increasing chain of submodules M₁ ⊆ M₂ ⊆ M₃ ⊆ ⋯ eventually stabilises.
 2. Every submodule is finitely generated.
@@ -30,17 +35,11 @@ we don't make this explicit in the declaration names.)
 
 Let `R` be a ring and let `M` and `P` be `R`-modules. Let `N` be an `R`-submodule of `M`.
 
-* `submodule.fg N : Prop` is the assertion that `N` is finitely generated as an `R`-module.
-
 * `is_noetherian R M` is the proposition that `M` is a Noetherian `R`-module. It is a class,
   implemented as the predicate that all `R`-submodules of `M` are finitely generated.
 
 ## Main statements
 
-* `exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul` is Nakayama's lemma, in the following form:
-  if N is a finitely generated submodule of an ambient R-module M and I is an ideal of R
-  such that N ⊆ IN, then there exists r ∈ 1 + I such that rN = 0.
-
 * `is_noetherian_iff_well_founded` is the theorem that an R-module M is Noetherian iff
   `>` is well-founded on `submodule R M`.
 
@@ -61,285 +60,6 @@ Noetherian, noetherian, Noetherian ring, Noetherian module, noetherian ring, noe
 open set
 open_locale big_operators pointwise
 
-namespace submodule
-variables {R : Type*} {M : Type*} [semiring R] [add_comm_monoid M] [module R M]
-
-/-- A submodule of `M` is finitely generated if it is the span of a finite subset of `M`. -/
-def fg (N : submodule R M) : Prop := ∃ S : finset M, submodule.span R ↑S = N
-
-theorem fg_def {N : submodule R M} :
-  N.fg ↔ ∃ S : set M, finite S ∧ span R S = N :=
-⟨λ ⟨t, h⟩, ⟨_, finset.finite_to_set t, h⟩, begin
-  rintro ⟨t', h, rfl⟩,
-  rcases finite.exists_finset_coe h with ⟨t, rfl⟩,
-  exact ⟨t, rfl⟩
-end⟩
-
-lemma fg_iff_add_submonoid_fg (P : submodule ℕ M) :
-  P.fg ↔ P.to_add_submonoid.fg :=
-⟨λ ⟨S, hS⟩, ⟨S, by simpa [← span_nat_eq_add_submonoid_closure] using hS⟩,
-  λ ⟨S, hS⟩, ⟨S, by simpa [← span_nat_eq_add_submonoid_closure] using hS⟩⟩
-
-lemma fg_iff_add_subgroup_fg {G : Type*} [add_comm_group G] (P : submodule ℤ G) :
-  P.fg ↔ P.to_add_subgroup.fg :=
-⟨λ ⟨S, hS⟩, ⟨S, by simpa [← span_int_eq_add_subgroup_closure] using hS⟩,
-  λ ⟨S, hS⟩, ⟨S, by simpa [← span_int_eq_add_subgroup_closure] using hS⟩⟩
-
-lemma fg_iff_exists_fin_generating_family {N : submodule R M} :
-  N.fg ↔ ∃ (n : ℕ) (s : fin n → M), span R (range s) = N :=
-begin
-  rw fg_def,
-  split,
-  { rintros ⟨S, Sfin, hS⟩,
-    obtain ⟨n, f, rfl⟩ := Sfin.fin_embedding,
-    exact ⟨n, f, hS⟩, },
-  { rintros ⟨n, s, hs⟩,
-    refine ⟨range s, finite_range s, hs⟩ },
-end
-
-/-- **Nakayama's Lemma**. Atiyah-Macdonald 2.5, Eisenbud 4.7, Matsumura 2.2,
-[Stacks 00DV](https://stacks.math.columbia.edu/tag/00DV) -/
-theorem exists_sub_one_mem_and_smul_eq_zero_of_fg_of_le_smul {R : Type*} [comm_ring R]
-  {M : Type*} [add_comm_group M] [module R M]
-  (I : ideal R) (N : submodule R M) (hn : N.fg) (hin : N ≤ I • N) :
-  ∃ r : R, r - 1 ∈ I ∧ ∀ n ∈ N, r • n = (0 : M) :=
-begin
-  rw fg_def at hn, rcases hn with ⟨s, hfs, hs⟩,
-  have : ∃ r : R, r - 1 ∈ I ∧ N ≤ (I • span R s).comap (linear_map.lsmul R M r) ∧ s ⊆ N,
-  { refine ⟨1, _, _, _⟩,
-    { rw sub_self, exact I.zero_mem },
-    { rw [hs], intros n hn, rw [mem_comap], change (1:R) • n ∈ I • N, rw one_smul, exact hin hn },
-    { rw [← span_le, hs], exact le_refl N } },
-  clear hin hs, revert this,
-  refine set.finite.dinduction_on hfs (λ H, _) (λ i s his hfs ih H, _),
-  { rcases H with ⟨r, hr1, hrn, hs⟩, refine ⟨r, hr1, λ n hn, _⟩, specialize hrn hn,
-    rwa [mem_comap, span_empty, smul_bot, mem_bot] at hrn },
-  apply ih, rcases H with ⟨r, hr1, hrn, hs⟩,
-  rw [← set.singleton_union, span_union, smul_sup] at hrn,
-  rw [set.insert_subset] at hs,
-  have : ∃ c : R, c - 1 ∈ I ∧ c • i ∈ I • span R s,
-  { specialize hrn hs.1, rw [mem_comap, mem_sup] at hrn,
-    rcases hrn with ⟨y, hy, z, hz, hyz⟩, change y + z = r • i at hyz,
-    rw mem_smul_span_singleton at hy, rcases hy with ⟨c, hci, rfl⟩,
-    use r-c, split,
-    { rw [sub_right_comm], exact I.sub_mem hr1 hci },
-    { rw [sub_smul, ← hyz, add_sub_cancel'], exact hz } },
-  rcases this with ⟨c, hc1, hci⟩, refine ⟨c * r, _, _, hs.2⟩,
-  { rw [← ideal.quotient.eq, ring_hom.map_one] at hr1 hc1 ⊢,
-    rw [ring_hom.map_mul, hc1, hr1, mul_one] },
-  { intros n hn, specialize hrn hn, rw [mem_comap, mem_sup] at hrn,
-    rcases hrn with ⟨y, hy, z, hz, hyz⟩, change y + z = r • n at hyz,
-    rw mem_smul_span_singleton at hy, rcases hy with ⟨d, hdi, rfl⟩,
-    change _ • _ ∈ I • span R s,
-    rw [mul_smul, ← hyz, smul_add, smul_smul, mul_comm, mul_smul],
-    exact add_mem (smul_mem _ _ hci) (smul_mem _ _ hz) }
-end
-
-theorem fg_bot : (⊥ : submodule R M).fg :=
-⟨∅, by rw [finset.coe_empty, span_empty]⟩
-
-lemma _root_.subalgebra.fg_bot_to_submodule {R A : Type*}
-  [comm_semiring R] [semiring A] [algebra R A] :
-  (⊥ : subalgebra R A).to_submodule.fg :=
-⟨{1}, by simp [algebra.to_submodule_bot] ⟩
-
-theorem fg_span {s : set M} (hs : finite s) : fg (span R s) :=
-⟨hs.to_finset, by rw [hs.coe_to_finset]⟩
-
-theorem fg_span_singleton (x : M) : fg (R ∙ x) :=
-fg_span (finite_singleton x)
-
-theorem fg.sup {N₁ N₂ : submodule R M}
-  (hN₁ : N₁.fg) (hN₂ : N₂.fg) : (N₁ ⊔ N₂).fg :=
-let ⟨t₁, ht₁⟩ := fg_def.1 hN₁, ⟨t₂, ht₂⟩ := fg_def.1 hN₂ in
-fg_def.2 ⟨t₁ ∪ t₂, ht₁.1.union ht₂.1, by rw [span_union, ht₁.2, ht₂.2]⟩
-
-variables {P : Type*} [add_comm_monoid P] [module R P]
-variables (f : M →ₗ[R] P)
-
-theorem fg.map {N : submodule R M} (hs : N.fg) : (N.map f).fg :=
-let ⟨t, ht⟩ := fg_def.1 hs in fg_def.2 ⟨f '' t, ht.1.image _, by rw [span_image, ht.2]⟩
-
-variables {f}
-
-lemma fg_of_fg_map_injective (f : M →ₗ[R] P) (hf : function.injective f) {N : submodule R M}
-  (hfn : (N.map f).fg) : N.fg :=
-let ⟨t, ht⟩ := hfn in ⟨t.preimage f $ λ x _ y _ h, hf h,
-submodule.map_injective_of_injective hf $ by { rw [f.map_span, finset.coe_preimage,
-    set.image_preimage_eq_inter_range, set.inter_eq_self_of_subset_left, ht],
-  rw [← linear_map.range_coe, ← span_le, ht, ← map_top], exact map_mono le_top }⟩
-
-lemma fg_of_fg_map {R M P : Type*} [ring R] [add_comm_group M] [module R M]
-  [add_comm_group P] [module R P] (f : M →ₗ[R] P) (hf : f.ker = ⊥) {N : submodule R M}
-  (hfn : (N.map f).fg) : N.fg :=
-fg_of_fg_map_injective f (linear_map.ker_eq_bot.1 hf) hfn
-
-lemma fg_top (N : submodule R M) : (⊤ : submodule R N).fg ↔ N.fg :=
-⟨λ h, N.range_subtype ▸ map_top N.subtype ▸ h.map _,
-λ h, fg_of_fg_map_injective N.subtype subtype.val_injective $ by rwa [map_top, range_subtype]⟩
-
-lemma fg_of_linear_equiv (e : M ≃ₗ[R] P) (h : (⊤ : submodule R P).fg) :
-  (⊤ : submodule R M).fg :=
-e.symm.range ▸ map_top (e.symm : P →ₗ[R] M) ▸ h.map _
-
-theorem fg.prod {sb : submodule R M} {sc : submodule R P}
-  (hsb : sb.fg) (hsc : sc.fg) : (sb.prod sc).fg :=
-let ⟨tb, htb⟩ := fg_def.1 hsb, ⟨tc, htc⟩ := fg_def.1 hsc in
-fg_def.2 ⟨linear_map.inl R M P '' tb ∪ linear_map.inr R M P '' tc,
-  (htb.1.image _).union (htc.1.image _),
-  by rw [linear_map.span_inl_union_inr, htb.2, htc.2]⟩
-
-theorem fg_pi {ι : Type*} {M : ι → Type*} [fintype ι] [Π i, add_comm_monoid (M i)]
-  [Π i, module R (M i)] {p : Π i, submodule R (M i)} (hsb : ∀ i, (p i).fg) :
-  (submodule.pi set.univ p).fg :=
-begin
-  classical,
-  simp_rw fg_def at hsb ⊢,
-  choose t htf hts using hsb,
-  refine ⟨
-    ⋃ i, (linear_map.single i : _ →ₗ[R] _) '' t i, set.finite_Union $ λ i, (htf i).image _, _⟩,
-  simp_rw [span_Union, span_image, hts, submodule.supr_map_single],
-end
-
-/-- If 0 → M' → M → M'' → 0 is exact and M' and M'' are
-finitely generated then so is M. -/
-theorem fg_of_fg_map_of_fg_inf_ker {R M P : Type*} [ring R] [add_comm_group M] [module R M]
-  [add_comm_group P] [module R P] (f : M →ₗ[R] P)
-  {s : submodule R M} (hs1 : (s.map f).fg) (hs2 : (s ⊓ f.ker).fg) : s.fg :=
-begin
-  haveI := classical.dec_eq R, haveI := classical.dec_eq M, haveI := classical.dec_eq P,
-  cases hs1 with t1 ht1, cases hs2 with t2 ht2,
-  have : ∀ y ∈ t1, ∃ x ∈ s, f x = y,
-  { intros y hy,
-    have : y ∈ map f s, { rw ← ht1, exact subset_span hy },
-    rcases mem_map.1 this with ⟨x, hx1, hx2⟩,
-    exact ⟨x, hx1, hx2⟩ },
-  have : ∃ g : P → M, ∀ y ∈ t1, g y ∈ s ∧ f (g y) = y,
-  { choose g hg1 hg2,
-    existsi λ y, if H : y ∈ t1 then g y H else 0,
-    intros y H, split,
-    { simp only [dif_pos H], apply hg1 },
-    { simp only [dif_pos H], apply hg2 } },
-  cases this with g hg, clear this,
-  existsi t1.image g ∪ t2,
-  rw [finset.coe_union, span_union, finset.coe_image],
-  apply le_antisymm,
-  { refine sup_le (span_le.2 $ image_subset_iff.2 _) (span_le.2 _),
-    { intros y hy, exact (hg y hy).1 },
-    { intros x hx, have := subset_span hx,
-      rw ht2 at this,
-      exact this.1 } },
-  intros x hx,
-  have : f x ∈ map f s, { rw mem_map, exact ⟨x, hx, rfl⟩ },
-  rw [← ht1,← set.image_id ↑t1, finsupp.mem_span_image_iff_total] at this,
-  rcases this with ⟨l, hl1, hl2⟩,
-  refine mem_sup.2 ⟨(finsupp.total M M R id).to_fun
-    ((finsupp.lmap_domain R R g : (P →₀ R) → M →₀ R) l), _,
-    x - finsupp.total M M R id ((finsupp.lmap_domain R R g : (P →₀ R) → M →₀ R) l),
-    _, add_sub_cancel'_right _ _⟩,
-  { rw [← set.image_id (g '' ↑t1), finsupp.mem_span_image_iff_total], refine ⟨_, _, rfl⟩,
-    haveI : inhabited P := ⟨0⟩,
-    rw [← finsupp.lmap_domain_supported _ _ g, mem_map],
-    refine ⟨l, hl1, _⟩,
-    refl, },
-  rw [ht2, mem_inf], split,
-  { apply s.sub_mem hx,
-    rw [finsupp.total_apply, finsupp.lmap_domain_apply, finsupp.sum_map_domain_index],
-    refine s.sum_mem _,
-    { intros y hy, exact s.smul_mem _ (hg y (hl1 hy)).1 },
-    { exact zero_smul _ }, { exact λ _ _ _, add_smul _ _ _ } },
-  { rw [linear_map.mem_ker, f.map_sub, ← hl2],
-    rw [finsupp.total_apply, finsupp.total_apply, finsupp.lmap_domain_apply],
-    rw [finsupp.sum_map_domain_index, finsupp.sum, finsupp.sum, f.map_sum],
-    rw sub_eq_zero,
-    refine finset.sum_congr rfl (λ y hy, _),
-    unfold id,
-    rw [f.map_smul, (hg y (hl1 hy)).2],
-    { exact zero_smul _ }, { exact λ _ _ _, add_smul _ _ _ } }
-end
-
-/-- An ideal of `R` is finitely generated if it is the span of a finite subset of `R`.
-
-This is defeq to `submodule.fg`, but unfolds more nicely. -/
-def _root_.ideal.fg (I : ideal R) : Prop := ∃ S : finset R, ideal.span ↑S = I
-
-/-- The image of a finitely generated ideal is finitely generated.
-
-This is the `ideal` version of `submodule.fg.map`. -/
-lemma _root_.ideal.fg.map {R S : Type*} [semiring R] [semiring S] {I : ideal R} (h : I.fg)
-  (f : R →+* S) : (I.map f).fg :=
-begin
-  classical,
-  obtain ⟨s, hs⟩ := h,
-  refine ⟨s.image f, _⟩,
-  rw [finset.coe_image, ←ideal.map_span, hs],
-end
-
-/-- The kernel of the composition of two linear maps is finitely generated if both kernels are and
-the first morphism is surjective. -/
-lemma fg_ker_comp {R M N P : Type*} [ring R] [add_comm_group M] [module R M]
-  [add_comm_group N] [module R N] [add_comm_group P] [module R P] (f : M →ₗ[R] N)
-  (g : N →ₗ[R] P) (hf1 : f.ker.fg) (hf2 : g.ker.fg) (hsur : function.surjective f) :
-  (g.comp f).ker.fg :=
-begin
-  rw linear_map.ker_comp,
-  apply fg_of_fg_map_of_fg_inf_ker f,
-  { rwa [submodule.map_comap_eq, linear_map.range_eq_top.2 hsur, top_inf_eq] },
-  { rwa [inf_of_le_right (show f.ker ≤ (comap f g.ker), from comap_mono bot_le)] }
-end
-
-lemma fg_restrict_scalars {R S M : Type*} [comm_semiring R] [semiring S] [algebra R S]
-  [add_comm_group M] [module S M] [module R M] [is_scalar_tower R S M] (N : submodule S M)
-  (hfin : N.fg) (h : function.surjective (algebra_map R S)) : (submodule.restrict_scalars R N).fg :=
-begin
-  obtain ⟨X, rfl⟩ := hfin,
-  use X,
-  exact submodule.span_eq_restrict_scalars R S M X h
-end
-
-lemma _root_.ideal.fg_ker_comp {R S A : Type*} [comm_ring R] [comm_ring S] [comm_ring A]
-  (f : R →+* S) (g : S →+* A) (hf : f.ker.fg) (hg : g.ker.fg) (hsur : function.surjective f) :
-  (g.comp f).ker.fg :=
-begin
-  letI : algebra R S := ring_hom.to_algebra f,
-  letI : algebra R A := ring_hom.to_algebra (g.comp f),
-  letI : algebra S A := ring_hom.to_algebra g,
-  letI : is_scalar_tower R S A := is_scalar_tower.of_algebra_map_eq (λ _, rfl),
-  let f₁ := algebra.linear_map R S,
-  let g₁ := (is_scalar_tower.to_alg_hom R S A).to_linear_map,
-  exact fg_ker_comp f₁ g₁ hf (fg_restrict_scalars g.ker hg hsur) hsur
-end
-
-/-- Finitely generated submodules are precisely compact elements in the submodule lattice. -/
-theorem fg_iff_compact (s : submodule R M) : s.fg ↔ complete_lattice.is_compact_element s :=
-begin
-  classical,
-  -- Introduce shorthand for span of an element
-  let sp : M → submodule R M := λ a, span R {a},
-  -- Trivial rewrite lemma; a small hack since simp (only) & rw can't accomplish this smoothly.
-  have supr_rw : ∀ t : finset M, (⨆ x ∈ t, sp x) = (⨆ x ∈ (↑t : set M), sp x), from λ t, by refl,
-  split,
-  { rintro ⟨t, rfl⟩,
-    rw [span_eq_supr_of_singleton_spans, ←supr_rw, ←(finset.sup_eq_supr t sp)],
-    apply complete_lattice.finset_sup_compact_of_compact,
-    exact λ n _, singleton_span_is_compact_element n, },
-  { intro h,
-    -- s is the Sup of the spans of its elements.
-    have sSup : s = Sup (sp '' ↑s),
-    by rw [Sup_eq_supr, supr_image, ←span_eq_supr_of_singleton_spans, eq_comm, span_eq],
-    -- by h, s is then below (and equal to) the sup of the spans of finitely many elements.
-    obtain ⟨u, ⟨huspan, husup⟩⟩ := h (sp '' ↑s) (le_of_eq sSup),
-    have ssup : s = u.sup id,
-    { suffices : u.sup id ≤ s, from le_antisymm husup this,
-      rw [sSup, finset.sup_id_eq_Sup], exact Sup_le_Sup huspan, },
-    obtain ⟨t, ⟨hts, rfl⟩⟩ := finset.subset_image_iff.mp huspan,
-    rw [finset.sup_finset_image, function.comp.left_id, finset.sup_eq_supr, supr_rw,
-      ←span_eq_supr_of_singleton_spans, eq_comm] at ssup,
-    exact ⟨t, ssup⟩, },
-end
-
-end submodule
-
 /--
 `is_noetherian R M` is the proposition that `M` is a Noetherian `R`-module,
 implemented as the predicate that all `R`-submodules of `M` are finitely generated.
@@ -365,7 +85,7 @@ begin
     submodule.map_comap_eq_self this ▸ (hn _).map _, λ h, ⟨λ s, _⟩⟩,
   have f := (submodule.equiv_map_of_injective N.subtype subtype.val_injective s).symm,
   have h₁ := h (s.map N.subtype) (submodule.map_subtype_le N s),
-  have h₂ : (⊤ : submodule R (s.map N.subtype)).map (↑f : _ →ₗ[R] s) = ⊤ := by simp,
+  have h₂ : (⊤ : submodule R (s.map N.subtype)).map f = ⊤ := by simp,
   have h₃ := ((submodule.fg_top _).2 h₁).map (↑f : _ →ₗ[R] s),
   exact (submodule.fg_top _).1 (h₂ ▸ h₃),
 end
@@ -416,6 +136,24 @@ lemma fg_of_injective [is_noetherian R P] {N : submodule R M} (f : M →ₗ[R] P
 
 end
 
+namespace module
+variables {R M N : Type*}
+variables [semiring R] [add_comm_monoid M] [add_comm_monoid N] [module R M] [module R N]
+
+variables (R M)
+
+@[priority 100] -- see Note [lower instance priority]
+instance is_noetherian.finite [is_noetherian R M] : finite R M :=
+⟨is_noetherian.noetherian ⊤⟩
+
+variables {R M}
+
+lemma finite.of_injective [is_noetherian R N] (f : M →ₗ[R] N)
+  (hf : function.injective f) : finite R M :=
+⟨fg_of_injective f hf⟩
+
+end module
+
 section
 variables {R : Type*} {M : Type*} {P : Type*}
 variables [ring R] [add_comm_group M] [add_comm_group P]
@@ -439,9 +177,10 @@ from λ x ⟨hx1, hx2⟩, ⟨x.1, prod.ext rfl $ eq.symm $ linear_map.mem_ker.1
 submodule.map_comap_eq_self this ▸ (noetherian _).map _⟩
 
 instance is_noetherian_pi {R ι : Type*} {M : ι → Type*} [ring R]
-  [Π i, add_comm_group (M i)] [Π i, module R (M i)] [fintype ι]
+  [Π i, add_comm_group (M i)] [Π i, module R (M i)] [finite ι]
   [∀ i, is_noetherian R (M i)] : is_noetherian R (Π i, M i) :=
 begin
+  casesI nonempty_fintype ι,
   haveI := classical.dec_eq ι,
   suffices on_finset : ∀ s : finset ι, is_noetherian R (Π i : s, M i),
   { let coe_e := equiv.subtype_univ_equiv finset.mem_univ,
@@ -449,8 +188,7 @@ begin
     exact is_noetherian_of_linear_equiv (linear_equiv.Pi_congr_left R M coe_e), },
   intro s,
   induction s using finset.induction with a s has ih,
-  { split, intro s, convert submodule.fg_bot, apply eq_bot_iff.2,
-    intros x hx, refine (submodule.mem_bot R).2 _, ext i, cases i.2 },
+  { exact ⟨λ s, by convert submodule.fg_bot⟩ },
   refine @is_noetherian_of_linear_equiv _ _ _ _ _ _ _ _
     _ (@is_noetherian_prod _ (M a) _ _ _ _ _ _ _ ih),
   fconstructor,
@@ -472,8 +210,7 @@ begin
     { simp only [or.by_cases, dif_pos] },
     { ext ⟨i, his⟩,
       have : ¬i = a, { rintro rfl, exact has his },
-      dsimp only [or.by_cases], change i ∈ s at his,
-      rw [dif_neg this, dif_pos his] } },
+      simp only [or.by_cases, this, not_false_iff, dif_neg] } },
   { intro f, ext ⟨i, hi⟩,
     rcases finset.mem_insert.1 hi with rfl | h,
     { simp only [or.by_cases, dif_pos], },
@@ -484,7 +221,7 @@ end
 /-- A version of `is_noetherian_pi` for non-dependent functions. We need this instance because
 sometimes Lean fails to apply the dependent version in non-dependent settings (e.g., it fails to
 prove that `ι → ℝ` is finite dimensional over `ℝ`). -/
-instance is_noetherian_pi' {R ι M : Type*} [ring R] [add_comm_group M] [module R M] [fintype ι]
+instance is_noetherian_pi' {R ι M : Type*} [ring R] [add_comm_group M] [module R M] [finite ι]
   [is_noetherian R M] : is_noetherian R (ι → M) :=
 is_noetherian_pi
 
@@ -504,6 +241,34 @@ begin
   exact ⟨λ ⟨h⟩, λ k, (fg_iff_compact k).mp (h k), λ h, ⟨λ k, (fg_iff_compact k).mpr (h k)⟩⟩,
 end
 
+lemma is_noetherian_iff_fg_well_founded :
+  is_noetherian R M ↔ well_founded
+    ((>) : { N : submodule R M // N.fg } → { N : submodule R M // N.fg } → Prop) :=
+begin
+  let α := { N : submodule R M // N.fg },
+  split,
+  { introI H,
+    let f : α ↪o submodule R M := order_embedding.subtype _,
+    exact order_embedding.well_founded f.dual (is_noetherian_iff_well_founded.mp H) },
+  { intro H,
+    constructor,
+    intro N,
+    obtain ⟨⟨N₀, h₁⟩, e : N₀ ≤ N, h₂⟩ := well_founded.has_min
+      H { N' : α | N'.1 ≤ N } ⟨⟨⊥, submodule.fg_bot⟩, bot_le⟩,
+    convert h₁,
+    refine (e.antisymm _).symm,
+    by_contra h₃,
+    obtain ⟨x, hx₁ : x ∈ N, hx₂ : x ∉ N₀⟩ := set.not_subset.mp h₃,
+    apply hx₂,
+    have := eq_of_le_of_not_lt _ (h₂ ⟨(R ∙ x) ⊔ N₀, _⟩ _),
+    { injection this with eq,
+      rw eq,
+      exact (le_sup_left : (R ∙ x) ≤ (R ∙ x) ⊔ N₀) (submodule.mem_span_singleton_self _) },
+    { exact submodule.fg.sup ⟨{x}, by rw [finset.coe_singleton]⟩ h₁ },
+    { show N₀ ≤ (R ∙ x) ⊔ N₀, from le_sup_right },
+    { exact sup_le ((submodule.span_singleton_le_iff_mem _ _).mpr hx₁) e } }
+end
+
 variables (R M)
 
 lemma well_founded_submodule_gt (R M) [semiring R] [add_comm_monoid M] [module R M] :
@@ -515,14 +280,12 @@ variables {R M}
 /-- A module is Noetherian iff every nonempty set of submodules has a maximal submodule among them.
 -/
 theorem set_has_maximal_iff_noetherian :
-  (∀ a : set $ submodule R M, a.nonempty → ∃ M' ∈ a, ∀ I ∈ a, M' ≤ I → I = M') ↔
-  is_noetherian R M :=
-by rw [is_noetherian_iff_well_founded, well_founded.well_founded_iff_has_max']
+  (∀ a : set $ submodule R M, a.nonempty → ∃ M' ∈ a, ∀ I ∈ a, ¬ M' < I) ↔ is_noetherian R M :=
+by rw [is_noetherian_iff_well_founded, well_founded.well_founded_iff_has_min]
 
 /-- A module is Noetherian iff every increasing chain of submodules stabilizes. -/
 theorem monotone_stabilizes_iff_noetherian :
-  (∀ (f : ℕ →o submodule R M), ∃ n, ∀ m, n ≤ m → f n = f m)
-    ↔ is_noetherian R M :=
+  (∀ (f : ℕ →o submodule R M), ∃ n, ∀ m, n ≤ m → f n = f m) ↔ is_noetherian R M :=
 by rw [is_noetherian_iff_well_founded, well_founded.monotone_chain_condition]
 
 /-- If `∀ I > J, P I` implies `P J`, then `P` holds for all submodules. -/
@@ -543,7 +306,7 @@ lemma finite_of_linear_independent [nontrivial R] [is_noetherian R M]
 begin
   refine classical.by_contradiction (λ hf, (rel_embedding.well_founded_iff_no_descending_seq.1
     (well_founded_submodule_gt R M)).elim' _),
-  have f : ℕ ↪ s, from @infinite.nat_embedding s ⟨λ f, hf ⟨f⟩⟩,
+  have f : ℕ ↪ s, from set.infinite.nat_embedding s hf,
   have : ∀ n, (coe ∘ f) '' {m | m ≤ n} ⊆ s,
   { rintros n x ⟨y, hy₁, rfl⟩, exact (f y).2 },
   have : ∀ a b : ℕ, a ≤ b ↔
@@ -590,7 +353,7 @@ theorem is_noetherian.exists_endomorphism_iterate_ker_inf_range_eq_bot
 begin
   obtain ⟨n, w⟩ := monotone_stabilizes_iff_noetherian.mpr I
     (f.iterate_ker.comp ⟨λ n, n+1, λ n m w, by linarith⟩),
-  specialize w (2 * n + 1) (by linarith),
+  specialize w (2 * n + 1) (by linarith only),
   dsimp at w,
   refine ⟨n+1, nat.succ_ne_zero _, _⟩,
   rw eq_bot_iff,
@@ -600,7 +363,7 @@ begin
   change ((f ^ (n + 1)) * (f ^ (n + 1))) y = 0 at h,
   rw ←pow_add at h,
   convert h using 3,
-  linarith,
+  ring
 end
 
 /-- Any surjective endomorphism of a Noetherian module is injective. -/
@@ -637,8 +400,8 @@ begin
       exact nat.succ_le_succ_iff.mp p }, },
 
   obtain ⟨n, w⟩ := monotone_stabilizes_iff_noetherian.mpr I (partial_sups f),
-  exact ⟨n, (λ m p,
-    eq_bot_of_disjoint_absorbs (h m) ((eq.symm (w (m + 1) (le_add_right p))).trans (w m p)))⟩
+  exact ⟨n, λ m p, (h m).eq_bot_of_ge $ sup_eq_left.1 $ (w (m + 1) $ le_add_right p).symm.trans $
+    w m p⟩
 end
 
 /--
@@ -663,10 +426,10 @@ end
 A (semi)ring is Noetherian if it is Noetherian as a module over itself,
 i.e. all its ideals are finitely generated.
 -/
-class is_noetherian_ring (R) [semiring R] extends is_noetherian R R : Prop
+@[reducible] def is_noetherian_ring (R) [semiring R] := is_noetherian R R
 
 theorem is_noetherian_ring_iff {R} [semiring R] : is_noetherian_ring R ↔ is_noetherian R R :=
-⟨λ h, h.1, @is_noetherian_ring.mk _ _⟩
+iff.rfl
 
 /-- A ring is Noetherian if and only if all its ideals are finitely-generated. -/
 lemma is_noetherian_ring_iff_ideal_fg (R : Type*) [semiring R] :
@@ -674,17 +437,15 @@ lemma is_noetherian_ring_iff_ideal_fg (R : Type*) [semiring R] :
 is_noetherian_ring_iff.trans is_noetherian_def
 
 @[priority 80] -- see Note [lower instance priority]
-instance ring.is_noetherian_of_fintype (R M) [fintype M] [semiring R] [add_comm_monoid M]
-  [module R M] :
+instance is_noetherian_of_finite (R M) [finite M] [semiring R] [add_comm_monoid M] [module R M] :
   is_noetherian R M :=
-by letI := classical.dec; exact
-⟨assume s, ⟨to_finset s, by rw [set.coe_to_finset, submodule.span_eq]⟩⟩
+⟨λ s, ⟨(s : set M).to_finite.to_finset, by rw [set.finite.coe_to_finset, submodule.span_eq]⟩⟩
 
-theorem ring.is_noetherian_of_zero_eq_one {R} [semiring R] (h01 : (0 : R) = 1) :
-  is_noetherian_ring R :=
-by haveI := subsingleton_of_zero_eq_one h01;
-   haveI := fintype.of_subsingleton (0:R);
-   exact is_noetherian_ring_iff.2 (ring.is_noetherian_of_fintype R R)
+/-- Modules over the trivial ring are Noetherian. -/
+@[priority 100] -- see Note [lower instance priority]
+instance is_noetherian_of_subsingleton (R M) [subsingleton R] [semiring R] [add_comm_monoid M]
+  [module R M] : is_noetherian R M :=
+by { haveI := module.subsingleton R M, exact is_noetherian_of_finite R M }
 
 theorem is_noetherian_of_submodule_of_noetherian (R M) [semiring R] [add_comm_monoid M] [module R M]
   (N : submodule R M) (h : is_noetherian R M) : is_noetherian R N :=
@@ -703,17 +464,13 @@ end
 /-- If `M / S / R` is a scalar tower, and `M / R` is Noetherian, then `M / S` is
 also noetherian. -/
 theorem is_noetherian_of_tower (R) {S M} [semiring R] [semiring S]
-  [add_comm_monoid M] [has_scalar R S] [module S M] [module R M] [is_scalar_tower R S M]
+  [add_comm_monoid M] [has_smul R S] [module S M] [module R M] [is_scalar_tower R S M]
   (h : is_noetherian R M) : is_noetherian S M :=
 begin
   rw is_noetherian_iff_well_founded at h ⊢,
   refine (submodule.restrict_scalars_embedding R S M).dual.well_founded h
 end
 
-instance ideal.quotient.is_noetherian_ring {R : Type*} [comm_ring R] [h : is_noetherian_ring R]
-  (I : ideal R) : is_noetherian_ring (R ⧸ I) :=
-is_noetherian_ring_iff.mpr $ is_noetherian_of_tower R $ submodule.quotient.is_noetherian _
-
 theorem is_noetherian_of_fg_of_noetherian {R M} [ring R] [add_comm_group M] [module R M]
   (N : submodule R M) [is_noetherian_ring R] (hN : N.fg) : is_noetherian R N :=
 let ⟨s, hs⟩ := hN in
@@ -753,7 +510,7 @@ by exactI is_noetherian_of_linear_equiv (linear_equiv.of_top (⊤ : submodule R
 /-- In a module over a noetherian ring, the submodule generated by finitely many vectors is
 noetherian. -/
 theorem is_noetherian_span_of_finite (R) {M} [ring R] [add_comm_group M] [module R M]
-  [is_noetherian_ring R] {A : set M} (hA : finite A) : is_noetherian R (submodule.span R A) :=
+  [is_noetherian_ring R] {A : set M} (hA : A.finite) : is_noetherian R (submodule.span R A) :=
 is_noetherian_of_fg_of_noetherian _ (submodule.fg_def.mpr ⟨A, hA, rfl⟩)
 
 theorem is_noetherian_ring_of_surjective (R) [ring R] (S) [ring S]
@@ -773,17 +530,9 @@ theorem is_noetherian_ring_of_ring_equiv (R) [ring R] {S} [ring S]
   (f : R ≃+* S) [is_noetherian_ring R] : is_noetherian_ring S :=
 is_noetherian_ring_of_surjective R S f.to_ring_hom f.to_equiv.surjective
 
-namespace submodule
-variables {R : Type*} {A : Type*} [comm_semiring R] [semiring A] [algebra R A]
-variables {M N : submodule R A}
-
-theorem fg.mul (hm : M.fg) (hn : N.fg) : (M * N).fg :=
-let ⟨m, hfm, hm⟩ := fg_def.1 hm, ⟨n, hfn, hn⟩ := fg_def.1 hn in
-fg_def.2 ⟨m * n, hfm.mul hfn, span_mul_span R m n ▸ hm ▸ hn ▸ rfl⟩
-
-lemma fg.pow (h : M.fg) (n : ℕ) : (M ^ n).fg :=
-nat.rec_on n
-  (⟨{1}, by simp [one_eq_span]⟩)
-  (λ n ih, by simpa [pow_succ] using h.mul ih)
-
-end submodule
+lemma is_noetherian_ring.is_nilpotent_nilradical (R : Type*) [comm_ring R] [is_noetherian_ring R] :
+  is_nilpotent (nilradical R) :=
+begin
+  obtain ⟨n, hn⟩ := ideal.exists_radical_pow_le_of_fg (⊥ : ideal R) (is_noetherian.noetherian _),
+  exact ⟨n, eq_bot_iff.mpr hn⟩
+end
diff --git a/src/ring_theory/non_unital_subsemiring/basic.lean b/src/ring_theory/non_unital_subsemiring/basic.lean
new file mode 100644
index 0000000000000..8b32d68f38039
--- /dev/null
+++ b/src/ring_theory/non_unital_subsemiring/basic.lean
@@ -0,0 +1,823 @@
+/-
+Copyright (c) 2022 Jireh Loreaux All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jireh Loreaux
+-/
+
+import algebra.ring.equiv
+import algebra.ring.prod
+import data.set.finite
+import group_theory.submonoid.membership
+import group_theory.subsemigroup.membership
+import group_theory.subsemigroup.centralizer
+
+/-!
+# Bundled non-unital subsemirings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define bundled non-unital subsemirings and some standard constructions:
+`complete_lattice` structure, `subtype` and `inclusion` ring homomorphisms, non-unital subsemiring
+`map`, `comap` and range (`srange`) of a `non_unital_ring_hom` etc.
+-/
+
+open_locale big_operators
+
+universes u v w
+
+variables {R : Type u} {S : Type v} {T : Type w} [non_unital_non_assoc_semiring R]
+  (M : subsemigroup R)
+
+/-- `non_unital_subsemiring_class S R` states that `S` is a type of subsets `s ⊆ R` that
+are both an additive submonoid and also a multiplicative subsemigroup. -/
+class non_unital_subsemiring_class (S : Type*) (R : Type u)
+  [non_unital_non_assoc_semiring R] [set_like S R] extends add_submonoid_class S R :=
+(mul_mem : ∀ {s : S} {a b : R}, a ∈ s → b ∈ s → a * b ∈ s)
+
+@[priority 100] -- See note [lower instance priority]
+instance non_unital_subsemiring_class.mul_mem_class (S : Type*) (R : Type u)
+  [non_unital_non_assoc_semiring R] [set_like S R] [h : non_unital_subsemiring_class S R] :
+  mul_mem_class S R :=
+{ .. h }
+
+namespace non_unital_subsemiring_class
+
+variables [set_like S R] [non_unital_subsemiring_class S R] (s : S)
+include R S
+
+open add_submonoid_class
+
+/-- A non-unital subsemiring of a `non_unital_non_assoc_semiring` inherits a
+`non_unital_non_assoc_semiring` structure -/
+@[priority 75] /- Prefer subclasses of `non_unital_non_assoc_semiring` over subclasses of
+`non_unital_subsemiring_class`. -/
+instance to_non_unital_non_assoc_semiring : non_unital_non_assoc_semiring s :=
+subtype.coe_injective.non_unital_non_assoc_semiring coe rfl (by simp) (λ _ _, rfl) (λ _ _, rfl)
+
+instance no_zero_divisors [no_zero_divisors R] : no_zero_divisors s :=
+subtype.coe_injective.no_zero_divisors coe rfl (λ x y, rfl)
+
+/-- The natural non-unital ring hom from a non-unital subsemiring of a non-unital semiring `R` to
+`R`. -/
+def subtype : s →ₙ+* R :=
+{ to_fun := coe, .. add_submonoid_class.subtype s, .. mul_mem_class.subtype s }
+
+@[simp] theorem coe_subtype : (subtype s : s → R) = coe := rfl
+
+omit R S
+
+/-- A non-unital subsemiring of a `non_unital_semiring` is a `non_unital_semiring`. -/
+instance to_non_unital_semiring {R} [non_unital_semiring R] [set_like S R]
+  [non_unital_subsemiring_class S R] : non_unital_semiring s :=
+subtype.coe_injective.non_unital_semiring coe rfl (by simp) (λ _ _, rfl) (λ _ _, rfl)
+
+/-- A non-unital subsemiring of a `non_unital_comm_semiring` is a `non_unital_comm_semiring`. -/
+instance to_non_unital_comm_semiring {R} [non_unital_comm_semiring R] [set_like S R]
+  [non_unital_subsemiring_class S R] : non_unital_comm_semiring s :=
+subtype.coe_injective.non_unital_comm_semiring coe rfl (by simp) (λ _ _, rfl) (λ _ _, rfl)
+
+/-! Note: currently, there are no ordered versions of non-unital rings. -/
+
+end non_unital_subsemiring_class
+
+variables [non_unital_non_assoc_semiring S] [non_unital_non_assoc_semiring T]
+
+set_option old_structure_cmd true
+
+/-- A non-unital subsemiring of a non-unital semiring `R` is a subset `s` that is both an additive
+submonoid and a semigroup. -/
+structure non_unital_subsemiring (R : Type u) [non_unital_non_assoc_semiring R]
+  extends add_submonoid R, subsemigroup R
+
+/-- Reinterpret a `non_unital_subsemiring` as a `subsemigroup`. -/
+add_decl_doc non_unital_subsemiring.to_subsemigroup
+
+/-- Reinterpret a `non_unital_subsemiring` as an `add_submonoid`. -/
+add_decl_doc non_unital_subsemiring.to_add_submonoid
+
+namespace non_unital_subsemiring
+
+instance : set_like (non_unital_subsemiring R) R :=
+{ coe := non_unital_subsemiring.carrier,
+  coe_injective' := λ p q h, by cases p; cases q; congr' }
+
+instance : non_unital_subsemiring_class (non_unital_subsemiring R) R :=
+{ zero_mem := zero_mem',
+  add_mem := add_mem',
+  mul_mem := mul_mem' }
+
+@[simp]
+lemma mem_carrier {s : non_unital_subsemiring R} {x : R} : x ∈ s.carrier ↔ x ∈ s := iff.rfl
+
+/-- Two non-unital subsemirings are equal if they have the same elements. -/
+@[ext] theorem ext {S T : non_unital_subsemiring R} (h : ∀ x, x ∈ S ↔ x ∈ T) : S = T :=
+set_like.ext h
+
+/-- Copy of a non-unital subsemiring with a new `carrier` equal to the old one. Useful to fix
+definitional equalities.-/
+protected def copy (S : non_unital_subsemiring R) (s : set R) (hs : s = ↑S) :
+  non_unital_subsemiring R :=
+{ carrier := s,
+  ..S.to_add_submonoid.copy s hs,
+  ..S.to_subsemigroup.copy s hs }
+
+@[simp] lemma coe_copy (S : non_unital_subsemiring R) (s : set R) (hs : s = ↑S) :
+  (S.copy s hs : set R) = s := rfl
+
+lemma copy_eq (S : non_unital_subsemiring R) (s : set R) (hs : s = ↑S) : S.copy s hs = S :=
+set_like.coe_injective hs
+
+lemma to_subsemigroup_injective :
+  function.injective (to_subsemigroup : non_unital_subsemiring R → subsemigroup R)
+| r s h := ext (set_like.ext_iff.mp h : _)
+
+@[mono] lemma to_subsemigroup_strict_mono :
+  strict_mono (to_subsemigroup : non_unital_subsemiring R → subsemigroup R) :=
+λ _ _, id
+
+@[mono] lemma to_subsemigroup_mono :
+  monotone (to_subsemigroup : non_unital_subsemiring R → subsemigroup R) :=
+to_subsemigroup_strict_mono.monotone
+
+lemma to_add_submonoid_injective :
+  function.injective (to_add_submonoid : non_unital_subsemiring R → add_submonoid R)
+| r s h := ext (set_like.ext_iff.mp h : _)
+
+@[mono] lemma to_add_submonoid_strict_mono :
+  strict_mono (to_add_submonoid : non_unital_subsemiring R → add_submonoid R) := λ _ _, id
+
+@[mono]
+lemma to_add_submonoid_mono :
+  monotone (to_add_submonoid : non_unital_subsemiring R → add_submonoid R) :=
+to_add_submonoid_strict_mono.monotone
+
+/-- Construct a `non_unital_subsemiring R` from a set `s`, a subsemigroup `sg`, and an additive
+submonoid `sa` such that `x ∈ s ↔ x ∈ sg ↔ x ∈ sa`. -/
+protected def mk' (s : set R) (sg : subsemigroup R) (hg : ↑sg = s)
+  (sa : add_submonoid R) (ha : ↑sa = s) :
+  non_unital_subsemiring R :=
+{ carrier := s,
+  zero_mem' := ha ▸ sa.zero_mem,
+  add_mem' := λ x y, by simpa only [← ha] using sa.add_mem,
+  mul_mem' := λ x y, by simpa only [← hg] using sg.mul_mem }
+
+@[simp] lemma coe_mk' {s : set R} {sg : subsemigroup R} (hg : ↑sg = s)
+  {sa : add_submonoid R} (ha : ↑sa = s) :
+  (non_unital_subsemiring.mk' s sg hg sa ha : set R) = s := rfl
+
+@[simp] lemma mem_mk' {s : set R} {sg : subsemigroup R} (hg : ↑sg = s)
+  {sa : add_submonoid R} (ha : ↑sa = s) {x : R} :
+  x ∈ non_unital_subsemiring.mk' s sg hg sa ha ↔ x ∈ s :=
+iff.rfl
+
+@[simp] lemma mk'_to_subsemigroup {s : set R} {sg : subsemigroup R} (hg : ↑sg = s)
+  {sa : add_submonoid R} (ha : ↑sa = s) :
+  (non_unital_subsemiring.mk' s sg hg sa ha).to_subsemigroup = sg :=
+set_like.coe_injective hg.symm
+
+@[simp] lemma mk'_to_add_submonoid {s : set R} {sg : subsemigroup R} (hg : ↑sg = s)
+  {sa : add_submonoid R} (ha : ↑sa  =s) :
+  (non_unital_subsemiring.mk' s sg hg sa ha).to_add_submonoid = sa :=
+set_like.coe_injective ha.symm
+
+end non_unital_subsemiring
+
+namespace non_unital_subsemiring
+
+variables {F G : Type*} [non_unital_ring_hom_class F R S] [non_unital_ring_hom_class G S T]
+  (s : non_unital_subsemiring R)
+
+@[simp, norm_cast] lemma coe_zero : ((0 : s) : R) = (0 : R) := rfl
+@[simp, norm_cast] lemma coe_add (x y : s) : ((x + y : s) : R) = (x + y : R) := rfl
+@[simp, norm_cast] lemma coe_mul (x y : s) : ((x * y : s) : R) = (x * y : R) := rfl
+
+/-! Note: currently, there are no ordered versions of non-unital rings. -/
+
+@[simp] lemma mem_to_subsemigroup {s : non_unital_subsemiring R} {x : R} :
+  x ∈ s.to_subsemigroup ↔ x ∈ s := iff.rfl
+@[simp] lemma coe_to_subsemigroup (s : non_unital_subsemiring R) :
+  (s.to_subsemigroup : set R) = s := rfl
+@[simp] lemma mem_to_add_submonoid {s : non_unital_subsemiring R} {x : R} :
+  x ∈ s.to_add_submonoid ↔ x ∈ s := iff.rfl
+@[simp] lemma coe_to_add_submonoid (s : non_unital_subsemiring R) :
+  (s.to_add_submonoid : set R) = s := rfl
+
+/-- The non-unital subsemiring `R` of the non-unital semiring `R`. -/
+instance : has_top (non_unital_subsemiring R) :=
+⟨{ .. (⊤ : subsemigroup R), .. (⊤ : add_submonoid R) }⟩
+
+@[simp] lemma mem_top (x : R) : x ∈ (⊤ : non_unital_subsemiring R) := set.mem_univ x
+
+@[simp] lemma coe_top : ((⊤ : non_unital_subsemiring R) : set R) = set.univ := rfl
+
+/-- The preimage of a non-unital subsemiring along a non-unital ring homomorphism is a
+non-unital subsemiring. -/
+def comap (f : F) (s : non_unital_subsemiring S) : non_unital_subsemiring R :=
+{ carrier := f ⁻¹' s,
+  .. s.to_subsemigroup.comap (f : mul_hom R S), .. s.to_add_submonoid.comap (f : R →+ S) }
+
+@[simp] lemma coe_comap (s : non_unital_subsemiring S) (f : F) :
+  (s.comap f : set R) = f ⁻¹' s := rfl
+
+@[simp]
+lemma mem_comap {s : non_unital_subsemiring S} {f : F} {x : R} :
+  x ∈ s.comap f ↔ f x ∈ s := iff.rfl
+
+-- this has some nasty coercions, how to deal with it?
+lemma comap_comap (s : non_unital_subsemiring T) (g : G) (f : F) :
+  ((s.comap g : non_unital_subsemiring S).comap f : non_unital_subsemiring R) =
+  s.comap ((g : S →ₙ+* T).comp (f : R →ₙ+* S)) :=
+rfl
+
+/-- The image of a non-unital subsemiring along a ring homomorphism is a non-unital subsemiring. -/
+def map (f : F) (s : non_unital_subsemiring R) : non_unital_subsemiring S :=
+{ carrier := f '' s,
+  .. s.to_subsemigroup.map (f : R →ₙ* S), .. s.to_add_submonoid.map (f : R →+ S) }
+
+@[simp] lemma coe_map (f : F) (s : non_unital_subsemiring R) : (s.map f : set S) = f '' s := rfl
+
+@[simp] lemma mem_map {f : F} {s : non_unital_subsemiring R} {y : S} :
+  y ∈ s.map f ↔ ∃ x ∈ s, f x = y :=
+set.mem_image_iff_bex
+
+@[simp] lemma map_id : s.map (non_unital_ring_hom.id R) = s :=
+set_like.coe_injective $ set.image_id _
+
+-- unavoidable coercions?
+lemma map_map (g : G) (f : F) :
+  (s.map (f : R →ₙ+* S)).map (g : S →ₙ+* T) = s.map ((g : S →ₙ+* T).comp (f : R →ₙ+* S)) :=
+set_like.coe_injective $ set.image_image _ _ _
+
+lemma map_le_iff_le_comap {f : F} {s : non_unital_subsemiring R} {t : non_unital_subsemiring S} :
+  s.map f ≤ t ↔ s ≤ t.comap f :=
+set.image_subset_iff
+
+lemma gc_map_comap (f : F) :
+  @galois_connection (non_unital_subsemiring R) (non_unital_subsemiring S) _ _ (map f) (comap f) :=
+λ S T, map_le_iff_le_comap
+/-- A non-unital subsemiring is isomorphic to its image under an injective function -/
+
+noncomputable def equiv_map_of_injective
+  (f : F) (hf : function.injective (f : R → S)) : s ≃+* s.map f :=
+{ map_mul' := λ _ _, subtype.ext (map_mul f _ _),
+  map_add' := λ _ _, subtype.ext (map_add f _ _),
+  ..equiv.set.image f s hf }
+
+@[simp] lemma coe_equiv_map_of_injective_apply
+  (f : F) (hf : function.injective f) (x : s) :
+  (equiv_map_of_injective s f hf x : S) = f x := rfl
+
+end non_unital_subsemiring
+
+namespace non_unital_ring_hom
+
+open non_unital_subsemiring
+
+variables {F G : Type*} [non_unital_ring_hom_class F R S] [non_unital_ring_hom_class G S T]
+  (f : F) (g : G)
+
+/-- The range of a non-unital ring homomorphism is a non-unital subsemiring.
+See note [range copy pattern]. -/
+def srange : non_unital_subsemiring S :=
+((⊤ : non_unital_subsemiring R).map (f : R →ₙ+* S)).copy (set.range f) set.image_univ.symm
+
+@[simp] lemma coe_srange : (@srange R S _ _ _ _ f : set S) = set.range f := rfl
+
+@[simp] lemma mem_srange {f : F} {y : S} : y ∈ (@srange R S _ _ _ _ f) ↔ ∃ x, f x = y :=
+iff.rfl
+
+lemma srange_eq_map : @srange R S _ _ _ _ f = (⊤ : non_unital_subsemiring R).map f :=
+by { ext, simp }
+
+lemma mem_srange_self (f : F) (x : R) : f x ∈ @srange R S _ _ _ _ f :=
+mem_srange.mpr ⟨x, rfl⟩
+
+lemma map_srange (g : S →ₙ+* T) (f : R →ₙ+* S) : map g (srange f) = srange (g.comp f) :=
+by simpa only [srange_eq_map] using (⊤ : non_unital_subsemiring R).map_map g f
+
+/-- The range of a morphism of non-unital semirings is finite if the domain is a finite. -/
+instance finite_srange [finite R] (f : F) : finite (srange f : non_unital_subsemiring S) :=
+(set.finite_range f).to_subtype
+
+end non_unital_ring_hom
+
+namespace non_unital_subsemiring
+
+-- should we define this as the range of the zero homomorphism?
+instance : has_bot (non_unital_subsemiring R) :=
+⟨{ carrier := {0},
+   add_mem' := λ _ _ _ _, by simp * at *,
+   zero_mem' := set.mem_singleton 0,
+   mul_mem' := λ _ _ _ _, by simp * at *}⟩
+
+instance : inhabited (non_unital_subsemiring R) := ⟨⊥⟩
+
+lemma coe_bot : ((⊥ : non_unital_subsemiring R) : set R) = {0} := rfl
+
+lemma mem_bot {x : R} : x ∈ (⊥ : non_unital_subsemiring R) ↔ x = 0 := set.mem_singleton_iff
+
+/-- The inf of two non-unital subsemirings is their intersection. -/
+instance : has_inf (non_unital_subsemiring R) :=
+⟨λ s t,
+  { carrier := s ∩ t,
+    .. s.to_subsemigroup ⊓ t.to_subsemigroup,
+    .. s.to_add_submonoid ⊓ t.to_add_submonoid }⟩
+
+@[simp] lemma coe_inf (p p' : non_unital_subsemiring R) :
+  ((p ⊓ p' : non_unital_subsemiring R) : set R) = p ∩ p' := rfl
+
+@[simp] lemma mem_inf {p p' : non_unital_subsemiring R} {x : R} :x ∈ p ⊓ p' ↔ x ∈ p ∧ x ∈ p' :=
+iff.rfl
+
+instance : has_Inf (non_unital_subsemiring R) :=
+⟨λ s, non_unital_subsemiring.mk' (⋂ t ∈ s, ↑t) (⨅ t ∈ s, non_unital_subsemiring.to_subsemigroup t)
+  (by simp) (⨅ t ∈ s, non_unital_subsemiring.to_add_submonoid t) (by simp)⟩
+
+@[simp, norm_cast] lemma coe_Inf (S : set (non_unital_subsemiring R)) :
+  ((Inf S : non_unital_subsemiring R) : set R) = ⋂ s ∈ S, ↑s := rfl
+
+lemma mem_Inf {S : set (non_unital_subsemiring R)} {x : R} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
+set.mem_Inter₂
+
+@[simp] lemma Inf_to_subsemigroup (s : set (non_unital_subsemiring R)) :
+  (Inf s).to_subsemigroup = ⨅ t ∈ s, non_unital_subsemiring.to_subsemigroup t :=
+mk'_to_subsemigroup _ _
+
+@[simp] lemma Inf_to_add_submonoid (s : set (non_unital_subsemiring R)) :
+  (Inf s).to_add_submonoid = ⨅ t ∈ s, non_unital_subsemiring.to_add_submonoid t :=
+mk'_to_add_submonoid _ _
+
+/-- Non-unital subsemirings of a non-unital semiring form a complete lattice. -/
+instance : complete_lattice (non_unital_subsemiring R) :=
+{ bot := (⊥),
+  bot_le := λ s x hx, (mem_bot.mp hx).symm ▸ zero_mem s,
+  top := (⊤),
+  le_top := λ s x hx, trivial,
+  inf := (⊓),
+  inf_le_left := λ s t x, and.left,
+  inf_le_right := λ s t x, and.right,
+  le_inf := λ s t₁ t₂ h₁ h₂ x hx, ⟨h₁ hx, h₂ hx⟩,
+  .. complete_lattice_of_Inf (non_unital_subsemiring R)
+    (λ s, is_glb.of_image (λ s t,
+      show (s : set R) ≤ t ↔ s ≤ t, from set_like.coe_subset_coe) is_glb_binfi)}
+
+lemma eq_top_iff' (A : non_unital_subsemiring R) : A = ⊤ ↔ ∀ x : R, x ∈ A :=
+eq_top_iff.trans ⟨λ h m, h $ mem_top m, λ h m _, h m⟩
+
+section center
+
+/-- The center of a semiring `R` is the set of elements that commute with everything in `R` -/
+def center (R) [non_unital_semiring R] : non_unital_subsemiring R :=
+{ carrier := set.center R,
+  zero_mem' := set.zero_mem_center R,
+  add_mem' := λ a b, set.add_mem_center,
+  .. subsemigroup.center R }
+
+lemma coe_center (R) [non_unital_semiring R] : ↑(center R) = set.center R := rfl
+
+@[simp]
+lemma center_to_subsemigroup (R) [non_unital_semiring R] :
+  (center R).to_subsemigroup = subsemigroup.center R := rfl
+
+lemma mem_center_iff {R} [non_unital_semiring R] {z : R} : z ∈ center R ↔ ∀ g, g * z = z * g :=
+iff.rfl
+
+instance decidable_mem_center {R} [non_unital_semiring R] [decidable_eq R] [fintype R] :
+  decidable_pred (∈ center R) :=
+λ _, decidable_of_iff' _ mem_center_iff
+
+@[simp] lemma center_eq_top (R) [non_unital_comm_semiring R] : center R = ⊤ :=
+set_like.coe_injective (set.center_eq_univ R)
+
+/-- The center is commutative. -/
+instance {R} [non_unital_semiring R] : non_unital_comm_semiring (center R) :=
+{ ..subsemigroup.center.comm_semigroup,
+  ..(non_unital_subsemiring_class.to_non_unital_semiring (center R)) }
+
+end center
+
+section centralizer
+
+/-- The centralizer of a set as non-unital subsemiring. -/
+def centralizer {R} [non_unital_semiring R] (s : set R) : non_unital_subsemiring R :=
+{ carrier := s.centralizer,
+  zero_mem' := set.zero_mem_centralizer _,
+  add_mem' := λ x y hx hy, set.add_mem_centralizer hx hy,
+  ..subsemigroup.centralizer s }
+
+@[simp, norm_cast]
+lemma coe_centralizer {R} [non_unital_semiring R] (s : set R) :
+  (centralizer s : set R) = s.centralizer := rfl
+
+lemma centralizer_to_subsemigroup {R} [non_unital_semiring R] (s : set R) :
+  (centralizer s).to_subsemigroup = subsemigroup.centralizer s := rfl
+
+lemma mem_centralizer_iff {R} [non_unital_semiring R] {s : set R} {z : R} :
+  z ∈ centralizer s ↔ ∀ g ∈ s, g * z = z * g :=
+iff.rfl
+
+lemma center_le_centralizer {R} [non_unital_semiring R] (s) : center R ≤ centralizer s :=
+  s.center_subset_centralizer
+
+lemma centralizer_le {R} [non_unital_semiring R] (s t : set R) (h : s ⊆ t) :
+  centralizer t ≤ centralizer s :=
+set.centralizer_subset h
+
+@[simp] lemma centralizer_eq_top_iff_subset {R} [non_unital_semiring R] {s : set R} :
+  centralizer s = ⊤ ↔ s ⊆ center R :=
+set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset
+
+@[simp]
+lemma centralizer_univ {R} [non_unital_semiring R] : centralizer set.univ = center R :=
+set_like.ext' (set.centralizer_univ R)
+
+end centralizer
+
+/-- The `non_unital_subsemiring` generated by a set. -/
+def closure (s : set R) : non_unital_subsemiring R := Inf {S | s ⊆ S}
+
+lemma mem_closure {x : R} {s : set R} : x ∈ closure s ↔ ∀ S :
+  non_unital_subsemiring R, s ⊆ S → x ∈ S := mem_Inf
+
+/-- The non-unital subsemiring generated by a set includes the set. -/
+@[simp] lemma subset_closure {s : set R} : s ⊆ closure s := λ x hx, mem_closure.2 $ λ S hS, hS hx
+
+lemma not_mem_of_not_mem_closure {s : set R} {P : R} (hP : P ∉ closure s) : P ∉ s :=
+λ h, hP (subset_closure h)
+
+/-- A non-unital subsemiring `S` includes `closure s` if and only if it includes `s`. -/
+@[simp]
+lemma closure_le {s : set R} {t : non_unital_subsemiring R} : closure s ≤ t ↔ s ⊆ t :=
+⟨set.subset.trans subset_closure, λ h, Inf_le h⟩
+
+/-- Subsemiring closure of a set is monotone in its argument: if `s ⊆ t`,
+then `closure s ≤ closure t`. -/
+lemma closure_mono ⦃s t : set R⦄ (h : s ⊆ t) : closure s ≤ closure t :=
+closure_le.2 $ set.subset.trans h subset_closure
+
+lemma closure_eq_of_le {s : set R} {t : non_unital_subsemiring R} (h₁ : s ⊆ t)
+  (h₂ : t ≤ closure s) : closure s = t :=
+le_antisymm (closure_le.2 h₁) h₂
+
+lemma mem_map_equiv {f : R ≃+* S} {K : non_unital_subsemiring R} {x : S} :
+  x ∈ K.map (f : R →ₙ+* S) ↔ f.symm x ∈ K :=
+@set.mem_image_equiv _ _ ↑K f.to_equiv x
+
+lemma map_equiv_eq_comap_symm (f : R ≃+* S) (K : non_unital_subsemiring R) :
+  K.map (f : R →ₙ+* S) = K.comap f.symm :=
+set_like.coe_injective (f.to_equiv.image_eq_preimage K)
+
+lemma comap_equiv_eq_map_symm (f : R ≃+* S) (K : non_unital_subsemiring S) :
+  K.comap (f : R →ₙ+* S) = K.map f.symm :=
+(map_equiv_eq_comap_symm f.symm K).symm
+
+end non_unital_subsemiring
+
+namespace subsemigroup
+
+/-- The additive closure of a non-unital subsemigroup is a non-unital subsemiring. -/
+def non_unital_subsemiring_closure (M : subsemigroup R) : non_unital_subsemiring R :=
+{ mul_mem' := λ x y, mul_mem_class.mul_mem_add_closure,
+  ..add_submonoid.closure (M : set R)}
+
+lemma non_unital_subsemiring_closure_coe :
+  (M.non_unital_subsemiring_closure : set R) = add_submonoid.closure (M : set R) := rfl
+
+lemma non_unital_subsemiring_closure_to_add_submonoid :
+  M.non_unital_subsemiring_closure.to_add_submonoid = add_submonoid.closure (M : set R) := rfl
+
+/-- The `non_unital_subsemiring` generated by a multiplicative subsemigroup coincides with the
+`non_unital_subsemiring.closure` of the subsemigroup itself . -/
+lemma non_unital_subsemiring_closure_eq_closure :
+  M.non_unital_subsemiring_closure = non_unital_subsemiring.closure (M : set R) :=
+begin
+  ext,
+  refine ⟨λ hx, _,
+    λ hx, (non_unital_subsemiring.mem_closure.mp hx) M.non_unital_subsemiring_closure (λ s sM, _)⟩;
+  rintros - ⟨H1, rfl⟩;
+  rintros - ⟨H2, rfl⟩,
+  { exact add_submonoid.mem_closure.mp hx H1.to_add_submonoid H2 },
+  { exact H2 sM }
+end
+
+end subsemigroup
+
+namespace non_unital_subsemiring
+
+@[simp]
+lemma closure_subsemigroup_closure (s : set R) : closure ↑(subsemigroup.closure s) = closure s :=
+le_antisymm
+  (closure_le.mpr (λ y hy, (subsemigroup.mem_closure.mp hy)
+    (closure s).to_subsemigroup subset_closure))
+  (closure_mono (subsemigroup.subset_closure))
+
+/-- The elements of the non-unital subsemiring closure of `M` are exactly the elements of the
+additive closure of a multiplicative subsemigroup `M`. -/
+lemma coe_closure_eq (s : set R) :
+  (closure s : set R) = add_submonoid.closure (subsemigroup.closure s : set R) :=
+by simp [← subsemigroup.non_unital_subsemiring_closure_to_add_submonoid,
+  subsemigroup.non_unital_subsemiring_closure_eq_closure]
+
+lemma mem_closure_iff {s : set R} {x} :
+  x ∈ closure s ↔ x ∈ add_submonoid.closure (subsemigroup.closure s : set R) :=
+set.ext_iff.mp (coe_closure_eq s) x
+
+@[simp]
+lemma closure_add_submonoid_closure {s : set R} : closure ↑(add_submonoid.closure s) = closure s :=
+begin
+  ext x,
+  refine ⟨λ hx, _, λ hx, closure_mono add_submonoid.subset_closure hx⟩,
+  rintros - ⟨H, rfl⟩,
+  rintros - ⟨J, rfl⟩,
+  refine (add_submonoid.mem_closure.mp (mem_closure_iff.mp hx)) H.to_add_submonoid (λ y hy, _),
+  refine (subsemigroup.mem_closure.mp hy) H.to_subsemigroup (λ z hz, _),
+  exact (add_submonoid.mem_closure.mp hz) H.to_add_submonoid (λ w hw, J hw),
+end
+
+/-- An induction principle for closure membership. If `p` holds for `0`, `1`, and all elements
+of `s`, and is preserved under addition and multiplication, then `p` holds for all elements
+of the closure of `s`. -/
+@[elab_as_eliminator]
+lemma closure_induction {s : set R} {p : R → Prop} {x} (h : x ∈ closure s)
+  (Hs : ∀ x ∈ s, p x) (H0 : p 0)
+  (Hadd : ∀ x y, p x → p y → p (x + y)) (Hmul : ∀ x y, p x → p y → p (x * y)) : p x :=
+(@closure_le _ _ _ ⟨p, Hadd, H0, Hmul⟩).2 Hs h
+
+/-- An induction principle for closure membership for predicates with two arguments. -/
+@[elab_as_eliminator]
+lemma closure_induction₂ {s : set R} {p : R → R → Prop} {x} {y : R} (hx : x ∈ closure s)
+  (hy : y ∈ closure s)
+  (Hs : ∀ (x ∈ s) (y ∈ s), p x y)
+  (H0_left : ∀ x, p 0 x)
+  (H0_right : ∀ x, p x 0)
+  (Hadd_left : ∀ x₁ x₂ y, p x₁ y → p x₂ y → p (x₁ + x₂) y)
+  (Hadd_right : ∀ x y₁ y₂, p x y₁ → p x y₂ → p x (y₁ + y₂))
+  (Hmul_left : ∀ x₁ x₂ y, p x₁ y → p x₂ y → p (x₁ * x₂) y)
+  (Hmul_right : ∀ x y₁ y₂, p x y₁ → p x y₂ → p x (y₁ * y₂))
+  : p x y :=
+closure_induction hx
+  (λ x₁ x₁s, closure_induction hy (Hs x₁ x₁s) (H0_right x₁) (Hadd_right x₁) (Hmul_right x₁))
+  (H0_left y) (λ z z', Hadd_left z z' y) (λ z z', Hmul_left z z' y)
+
+variable (R)
+
+/-- `closure` forms a Galois insertion with the coercion to set. -/
+protected def gi : galois_insertion (@closure R _) coe :=
+{ choice := λ s _, closure s,
+  gc := λ s t, closure_le,
+  le_l_u := λ s, subset_closure,
+  choice_eq := λ s h, rfl }
+
+variables {R} {F : Type*} [non_unital_ring_hom_class F R S]
+
+/-- Closure of a non-unital subsemiring `S` equals `S`. -/
+lemma closure_eq (s : non_unital_subsemiring R) : closure (s : set R) = s :=
+(non_unital_subsemiring.gi R).l_u_eq s
+
+@[simp] lemma closure_empty : closure (∅ : set R) = ⊥ := (non_unital_subsemiring.gi R).gc.l_bot
+
+@[simp] lemma closure_univ : closure (set.univ : set R) = ⊤ := @coe_top R _ ▸ closure_eq ⊤
+
+lemma closure_union (s t : set R) : closure (s ∪ t) = closure s ⊔ closure t :=
+(non_unital_subsemiring.gi R).gc.l_sup
+
+lemma closure_Union {ι} (s : ι → set R) : closure (⋃ i, s i) = ⨆ i, closure (s i) :=
+(non_unital_subsemiring.gi R).gc.l_supr
+
+lemma closure_sUnion (s : set (set R)) : closure (⋃₀ s) = ⨆ t ∈ s, closure t :=
+(non_unital_subsemiring.gi R).gc.l_Sup
+
+lemma map_sup (s t : non_unital_subsemiring R) (f : F) :
+  (map f (s ⊔ t) : non_unital_subsemiring S) = map f s ⊔ map f t :=
+@galois_connection.l_sup _ _ s t  _ _ _ _ (gc_map_comap f)
+
+lemma map_supr {ι : Sort*} (f : F) (s : ι → non_unital_subsemiring R) :
+  (map f (supr s) : non_unital_subsemiring S) = ⨆ i, map f (s i) :=
+@galois_connection.l_supr _ _ _ _ _ _ _ (gc_map_comap f) s
+
+lemma comap_inf (s t : non_unital_subsemiring S) (f : F) :
+  (comap f (s ⊓ t) : non_unital_subsemiring R) = comap f s ⊓ comap f t :=
+@galois_connection.u_inf _ _ s t  _ _ _ _ (gc_map_comap f)
+
+lemma comap_infi {ι : Sort*} (f : F) (s : ι → non_unital_subsemiring S) :
+  (comap f (infi s) : non_unital_subsemiring R) = ⨅ i, comap f (s i) :=
+@galois_connection.u_infi _ _ _ _ _ _ _ (gc_map_comap f) s
+
+@[simp] lemma map_bot (f : F) :
+  map f (⊥ : non_unital_subsemiring R) = (⊥ : non_unital_subsemiring S) :=
+(gc_map_comap f).l_bot
+
+@[simp] lemma comap_top (f : F) :
+  comap f (⊤ : non_unital_subsemiring S) = (⊤ : non_unital_subsemiring R) :=
+(gc_map_comap f).u_top
+
+/-- Given `non_unital_subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is
+`s × t` as a non-unital subsemiring of `R × S`. -/
+def prod (s : non_unital_subsemiring R) (t : non_unital_subsemiring S) :
+  non_unital_subsemiring (R × S) :=
+{ carrier := (s : set R) ×ˢ (t : set S),
+  .. s.to_subsemigroup.prod t.to_subsemigroup, .. s.to_add_submonoid.prod t.to_add_submonoid}
+
+@[norm_cast]
+lemma coe_prod (s : non_unital_subsemiring R) (t : non_unital_subsemiring S) :
+  (s.prod t : set (R × S)) = (s : set R) ×ˢ (t : set S) :=
+rfl
+
+lemma mem_prod {s : non_unital_subsemiring R} {t : non_unital_subsemiring S} {p : R × S} :
+  p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl
+
+@[mono] lemma prod_mono ⦃s₁ s₂ : non_unital_subsemiring R⦄ (hs : s₁ ≤ s₂)
+  ⦃t₁ t₂ : non_unital_subsemiring S⦄ (ht : t₁ ≤ t₂) : s₁.prod t₁ ≤ s₂.prod t₂ :=
+set.prod_mono hs ht
+
+lemma prod_mono_right (s : non_unital_subsemiring R) :
+  monotone (λ t : non_unital_subsemiring S, s.prod t) :=
+prod_mono (le_refl s)
+
+lemma prod_mono_left (t : non_unital_subsemiring S) :
+  monotone (λ s : non_unital_subsemiring R, s.prod t) :=
+λ s₁ s₂ hs, prod_mono hs (le_refl t)
+
+lemma prod_top (s : non_unital_subsemiring R) :
+  s.prod (⊤ : non_unital_subsemiring S) = s.comap (non_unital_ring_hom.fst R S) :=
+ext $ λ x, by simp [mem_prod, monoid_hom.coe_fst]
+
+lemma top_prod (s : non_unital_subsemiring S) :
+  (⊤ : non_unital_subsemiring R).prod s = s.comap (non_unital_ring_hom.snd R S) :=
+ext $ λ x, by simp [mem_prod, monoid_hom.coe_snd]
+
+@[simp]
+lemma top_prod_top : (⊤ : non_unital_subsemiring R).prod (⊤ : non_unital_subsemiring S) = ⊤ :=
+(top_prod _).trans $ comap_top _
+
+/-- Product of non-unital subsemirings is isomorphic to their product as semigroups. -/
+def prod_equiv (s : non_unital_subsemiring R) (t : non_unital_subsemiring S) : s.prod t ≃+* s × t :=
+{ map_mul' := λ x y, rfl, map_add' := λ x y, rfl, .. equiv.set.prod ↑s ↑t }
+
+lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → non_unital_subsemiring R}
+  (hS : directed (≤) S) {x : R} :
+  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
+begin
+  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
+  let U : non_unital_subsemiring R := non_unital_subsemiring.mk' (⋃ i, (S i : set R))
+    (⨆ i, (S i).to_subsemigroup) (subsemigroup.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id))
+    (⨆ i, (S i).to_add_submonoid) (add_submonoid.coe_supr_of_directed $ hS.mono_comp _ (λ _ _, id)),
+  suffices : (⨆ i, S i) ≤ U, by simpa using @this x,
+  exact supr_le (λ i x hx, set.mem_Union.2 ⟨i, hx⟩),
+end
+
+lemma coe_supr_of_directed {ι} [hι : nonempty ι] {S : ι → non_unital_subsemiring R}
+  (hS : directed (≤) S) : ((⨆ i, S i : non_unital_subsemiring R) : set R) = ⋃ i, ↑(S i) :=
+set.ext $ λ x, by simp [mem_supr_of_directed hS]
+
+lemma mem_Sup_of_directed_on {S : set (non_unital_subsemiring R)} (Sne : S.nonempty)
+  (hS : directed_on (≤) S) {x : R} :
+  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
+begin
+  haveI : nonempty S := Sne.to_subtype,
+  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
+end
+
+lemma coe_Sup_of_directed_on {S : set (non_unital_subsemiring R)} (Sne : S.nonempty)
+  (hS : directed_on (≤) S) : (↑(Sup S) : set R) = ⋃ s ∈ S, ↑s :=
+set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]
+
+end non_unital_subsemiring
+
+namespace non_unital_ring_hom
+
+variables {F : Type*} [non_unital_non_assoc_semiring T] [non_unital_ring_hom_class F R S]
+  {s : non_unital_subsemiring R}
+
+open non_unital_subsemiring_class non_unital_subsemiring
+
+/-- Restriction of a non-unital ring homomorphism to a non-unital subsemiring of the codomain. -/
+def cod_restrict (f : F) (s : non_unital_subsemiring S) (h : ∀ x, f x ∈ s) : R →ₙ+* s :=
+{ to_fun := λ n, ⟨f n, h n⟩,
+  .. (f : R →ₙ* S).cod_restrict s.to_subsemigroup h,
+  .. (f : R →+ S).cod_restrict s.to_add_submonoid h }
+
+/-- Restriction of a non-unital ring homomorphism to its range interpreted as a
+non-unital subsemiring.
+
+This is the bundled version of `set.range_factorization`. -/
+def srange_restrict (f : F) : R →ₙ+* (srange f : non_unital_subsemiring S) :=
+cod_restrict f (srange f) (mem_srange_self f)
+
+@[simp] lemma coe_srange_restrict (f : F) (x : R) :
+  (srange_restrict f x : S) = f x :=
+rfl
+
+lemma srange_restrict_surjective (f : F) :
+  function.surjective (srange_restrict f : R → (srange f : non_unital_subsemiring S)) :=
+λ ⟨y, hy⟩, let ⟨x, hx⟩ := mem_srange.mp hy in ⟨x, subtype.ext hx⟩
+
+lemma srange_top_iff_surjective {f : F} :
+  srange f = (⊤ : non_unital_subsemiring S) ↔ function.surjective (f : R → S):=
+set_like.ext'_iff.trans $ iff.trans (by rw [coe_srange, coe_top]) set.range_iff_surjective
+
+/-- The range of a surjective non-unital ring homomorphism is the whole of the codomain. -/
+lemma srange_top_of_surjective (f : F) (hf : function.surjective (f : R → S)) :
+  srange f = (⊤ : non_unital_subsemiring S) :=
+srange_top_iff_surjective.2 hf
+
+/-- The non-unital subsemiring of elements `x : R` such that `f x = g x` -/
+def eq_slocus (f g : F) : non_unital_subsemiring R :=
+{ carrier := {x | f x = g x},
+  .. (f : R →ₙ* S).eq_mlocus (g : R →ₙ* S),
+  .. (f : R →+ S).eq_mlocus g }
+
+/-- If two non-unital ring homomorphisms are equal on a set, then they are equal on its
+non-unital subsemiring closure. -/
+lemma eq_on_sclosure {f g : F} {s : set R} (h : set.eq_on (f : R → S) (g : R → S) s) :
+  set.eq_on f g (closure s) :=
+show closure s ≤ eq_slocus f g, from closure_le.2 h
+
+lemma eq_of_eq_on_stop {f g : F} (h : set.eq_on (f : R → S) (g : R → S)
+  (⊤ : non_unital_subsemiring R)) : f = g :=
+fun_like.ext _ _ (λ x, h trivial)
+
+lemma eq_of_eq_on_sdense {s : set R} (hs : closure s = ⊤) {f g : F}
+  (h : s.eq_on (f : R → S) (g : R → S)) :
+  f = g :=
+eq_of_eq_on_stop $ hs ▸ eq_on_sclosure h
+
+lemma sclosure_preimage_le (f : F) (s : set S) :
+  closure ((f : R → S) ⁻¹' s) ≤ (closure s).comap f :=
+closure_le.2 $ λ x hx, set_like.mem_coe.2 $ mem_comap.2 $ subset_closure hx
+
+/-- The image under a ring homomorphism of the subsemiring generated by a set equals
+the subsemiring generated by the image of the set. -/
+lemma map_sclosure (f : F) (s : set R) :
+  (closure s).map f = closure ((f : R → S) '' s) :=
+le_antisymm
+  (map_le_iff_le_comap.2 $ le_trans (closure_mono $ set.subset_preimage_image _ _)
+    (sclosure_preimage_le _ _))
+  (closure_le.2 $ set.image_subset _ subset_closure)
+
+end non_unital_ring_hom
+
+namespace non_unital_subsemiring
+
+open non_unital_ring_hom non_unital_subsemiring_class
+
+/-- The non-unital ring homomorphism associated to an inclusion of
+non-unital subsemirings. -/
+def inclusion {S T : non_unital_subsemiring R} (h : S ≤ T) : S →ₙ+* T :=
+cod_restrict (subtype S) _ (λ x, h x.2)
+
+@[simp] lemma srange_subtype (s : non_unital_subsemiring R) : (subtype s).srange = s :=
+set_like.coe_injective $ (coe_srange _).trans subtype.range_coe
+
+@[simp]
+lemma range_fst : (fst R S).srange = ⊤ :=
+non_unital_ring_hom.srange_top_of_surjective (fst R S) prod.fst_surjective
+
+@[simp]
+lemma range_snd : (snd R S).srange = ⊤ :=
+non_unital_ring_hom.srange_top_of_surjective (snd R S) $ prod.snd_surjective
+
+end non_unital_subsemiring
+
+namespace ring_equiv
+
+open non_unital_ring_hom non_unital_subsemiring_class
+
+variables {s t : non_unital_subsemiring R}
+variables {F : Type*} [non_unital_ring_hom_class F R S]
+
+/-- Makes the identity isomorphism from a proof two non-unital subsemirings of a multiplicative
+monoid are equal. -/
+def non_unital_subsemiring_congr (h : s = t) : s ≃+* t :=
+{ map_mul' :=  λ _ _, rfl, map_add' := λ _ _, rfl, ..equiv.set_congr $ congr_arg _ h }
+
+/-- Restrict a non-unital ring homomorphism with a left inverse to a ring isomorphism to its
+`non_unital_ring_hom.srange`. -/
+def sof_left_inverse' {g : S → R} {f : F} (h : function.left_inverse g f) :
+  R ≃+* srange f :=
+{ to_fun := srange_restrict f,
+  inv_fun := λ x, g (subtype (srange f) x),
+  left_inv := h,
+  right_inv := λ x, subtype.ext $
+    let ⟨x', hx'⟩ := non_unital_ring_hom.mem_srange.mp x.prop in
+    show f (g x) = x, by rw [←hx', h x'],
+  ..(srange_restrict f) }
+
+@[simp] lemma sof_left_inverse'_apply
+  {g : S → R} {f : F} (h : function.left_inverse g f) (x : R) :
+  ↑(sof_left_inverse' h x) = f x := rfl
+
+@[simp] lemma sof_left_inverse'_symm_apply
+  {g : S → R} {f : F} (h : function.left_inverse g f) (x : srange f) :
+  (sof_left_inverse' h).symm x = g x := rfl
+
+/-- Given an equivalence `e : R ≃+* S` of non-unital semirings and a non-unital subsemiring
+`s` of `R`, `non_unital_subsemiring_map e s` is the induced equivalence between `s` and
+`s.map e` -/
+@[simps] def non_unital_subsemiring_map (e : R ≃+* S) (s : non_unital_subsemiring R) :
+  s ≃+* non_unital_subsemiring.map e.to_non_unital_ring_hom s :=
+{ ..e.to_add_equiv.add_submonoid_map s.to_add_submonoid,
+  ..e.to_mul_equiv.subsemigroup_map s.to_subsemigroup }
+
+end ring_equiv
diff --git a/src/ring_theory/non_zero_divisors.lean b/src/ring_theory/non_zero_divisors.lean
index e7697ffd98585..539d03416b96c 100644
--- a/src/ring_theory/non_zero_divisors.lean
+++ b/src/ring_theory/non_zero_divisors.lean
@@ -10,6 +10,9 @@ import group_theory.submonoid.membership
 /-!
 # Non-zero divisors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the submonoid `non_zero_divisors` of a `monoid_with_zero`.
 
 ## Notations
@@ -30,7 +33,8 @@ def non_zero_divisors (R : Type*) [monoid_with_zero R] : submonoid R :=
     have z * x₁ * x₂ = 0, by rwa mul_assoc,
     hx₁ z $ hx₂ (z * x₁) this }
 
-localized "notation R`⁰`:9000 := non_zero_divisors R" in non_zero_divisors
+localized "notation (name := non_zero_divisors)
+  R`⁰`:9000 := non_zero_divisors R" in non_zero_divisors
 
 variables {M M' M₁ R R' F : Type*} [monoid_with_zero M] [monoid_with_zero M']
   [comm_monoid_with_zero M₁] [ring R] [comm_ring R']
@@ -132,7 +136,7 @@ le_non_zero_divisors_of_no_zero_divisors (λ h, absurd (h.rec_on (λ _ hn, pow_e
 
 lemma map_le_non_zero_divisors_of_injective [no_zero_divisors M']
   [monoid_with_zero_hom_class F M M'] (f : F) (hf : function.injective f) {S : submonoid M}
-  (hS : S ≤ M⁰) : S.map ↑f ≤ M'⁰ :=
+  (hS : S ≤ M⁰) : S.map f ≤ M'⁰ :=
 begin
   casesI subsingleton_or_nontrivial M,
   { simp [subsingleton.elim S ⊥] },
diff --git a/src/ring_theory/norm.lean b/src/ring_theory/norm.lean
index 1ccbfdd353385..5a8687eeb9bad 100644
--- a/src/ring_theory/norm.lean
+++ b/src/ring_theory/norm.lean
@@ -6,13 +6,18 @@ Authors: Anne Baanen
 
 import field_theory.primitive_element
 import linear_algebra.determinant
+import linear_algebra.finite_dimensional
 import linear_algebra.matrix.charpoly.minpoly
 import linear_algebra.matrix.to_linear_equiv
 import field_theory.is_alg_closed.algebraic_closure
+import field_theory.galois
 
 /-!
 # Norm for (finite) ring extensions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
 the determinant of the linear map given by multiplying by `s` gives information
 about the roots of the minimal polynomial of `s` over `R`.
@@ -24,7 +29,7 @@ The current definition is as general as possible and the assumption that we have
 fields or that the extension is finite is added to the lemmas as needed.
 
 We only define the norm for left multiplication (`algebra.left_mul_matrix`,
-i.e. `algebra.lmul_left`).
+i.e. `linear_map.mul_left`).
 For now, the definitions assume `S` is commutative, so the choice doesn't
 matter anyway.
 
@@ -39,11 +44,11 @@ See also `algebra.trace`, which is defined similarly as the trace of
 
 universes u v w
 
-variables {R S T : Type*} [comm_ring R] [comm_ring S]
+variables {R S T : Type*} [comm_ring R] [ring S]
 variables [algebra R S]
 variables {K L F : Type*} [field K] [field L] [field F]
 variables [algebra K L] [algebra K F]
-variables {ι : Type w} [fintype ι]
+variables {ι : Type w}
 
 open finite_dimensional
 open linear_map
@@ -68,13 +73,21 @@ by { rw [norm_apply, linear_map.det], split_ifs with h, refl }
 
 variables {R}
 
+lemma norm_eq_one_of_not_module_finite (h : ¬ module.finite R S) (x : S) :
+  norm R x = 1 :=
+begin
+  refine norm_eq_one_of_not_exists_basis _ (mt _ h) _,
+  rintro ⟨s, ⟨b⟩⟩,
+  exact module.finite.of_basis b,
+end
+
 -- Can't be a `simp` lemma because it depends on a choice of basis
-lemma norm_eq_matrix_det [decidable_eq ι] (b : basis ι R S) (s : S) :
+lemma norm_eq_matrix_det [fintype ι] [decidable_eq ι] (b : basis ι R S) (s : S) :
   norm R s = matrix.det (algebra.left_mul_matrix b s) :=
-by rw [norm_apply, ← linear_map.det_to_matrix b, to_matrix_lmul_eq]
+by { rwa [norm_apply, ← linear_map.det_to_matrix b, ← to_matrix_lmul_eq], refl }
 
-/-- If `x` is in the base field `K`, then the norm is `x ^ [L : K]`. -/
-lemma norm_algebra_map_of_basis (b : basis ι R S) (x : R) :
+/-- If `x` is in the base ring `K`, then the norm is `x ^ [L : K]`. -/
+lemma norm_algebra_map_of_basis [fintype ι] (b : basis ι R S) (x : R) :
   norm R (algebra_map R S x) = x ^ fintype.card ι :=
 begin
   haveI := classical.dec_eq ι,
@@ -89,7 +102,8 @@ end
 (If `L` is not finite-dimensional over `K`, then `norm = 1 = x ^ 0 = x ^ (finrank L K)`.)
 -/
 @[simp]
-protected lemma norm_algebra_map (x : K) : norm K (algebra_map K L x) = x ^ finrank K L :=
+protected lemma norm_algebra_map {L : Type*} [ring L] [algebra K L] (x : K) :
+  norm K (algebra_map K L x) = x ^ finrank K L :=
 begin
   by_cases H : ∃ (s : finset L), nonempty (basis s K L),
   { rw [norm_algebra_map_of_basis H.some_spec.some, finrank_eq_card_basis H.some_spec.some] },
@@ -102,66 +116,81 @@ section eq_prod_roots
 
 /-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
 `(-1) ^ pb.dim * coeff (minpoly K pb.gen) 0`. -/
-lemma power_basis.norm_gen_eq_coeff_zero_minpoly [algebra K S] (pb : power_basis K S) :
-  norm K pb.gen = (-1) ^ pb.dim * coeff (minpoly K pb.gen) 0 :=
-begin
-  rw [norm_eq_matrix_det pb.basis, det_eq_sign_charpoly_coeff, charpoly_left_mul_matrix,
-    fintype.card_fin]
-end
-
-/-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
-`((minpoly K pb.gen).map (algebra_map K F)).roots.prod`. -/
-lemma power_basis.norm_gen_eq_prod_roots [algebra K S] (pb : power_basis K S)
-  (hf : (minpoly K pb.gen).splits (algebra_map K F)) :
-  algebra_map K F (norm K pb.gen) =
-    ((minpoly K pb.gen).map (algebra_map K F)).roots.prod :=
+lemma power_basis.norm_gen_eq_coeff_zero_minpoly (pb : power_basis R S) :
+  norm R pb.gen = (-1) ^ pb.dim * coeff (minpoly R pb.gen) 0 :=
+by rw [norm_eq_matrix_det pb.basis, det_eq_sign_charpoly_coeff,
+       charpoly_left_mul_matrix, fintype.card_fin]
+
+/-- Given `pb : power_basis R S`, then the norm of `pb.gen` is
+`((minpoly R pb.gen).map (algebra_map R F)).roots.prod`. -/
+lemma power_basis.norm_gen_eq_prod_roots [algebra R F] (pb : power_basis R S)
+  (hf : (minpoly R pb.gen).splits (algebra_map R F)) :
+  algebra_map R F (norm R pb.gen) =
+    ((minpoly R pb.gen).map (algebra_map R F)).roots.prod :=
 begin
+  haveI := module.nontrivial R F,
+  have := minpoly.monic pb.is_integral_gen,
   rw [power_basis.norm_gen_eq_coeff_zero_minpoly, ← pb.nat_degree_minpoly, ring_hom.map_mul,
-    ← coeff_map, prod_roots_eq_coeff_zero_of_monic_of_split
-      ((minpoly.monic (power_basis.is_integral_gen _)).map _)
-      ((splits_id_iff_splits _).2 hf), nat_degree_map, map_pow, ← mul_assoc, ← mul_pow],
-  simp
+    ← coeff_map, prod_roots_eq_coeff_zero_of_monic_of_split (this.map _)
+      ((splits_id_iff_splits _).2 hf), this.nat_degree_map, map_pow, ← mul_assoc, ← mul_pow],
+  { simp only [map_neg, _root_.map_one, neg_mul, neg_neg, one_pow, one_mul] }, apply_instance,
 end
 
 end eq_prod_roots
 
 section eq_zero_iff
+variables [finite ι]
 
-lemma norm_eq_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
-  algebra.norm R x = 0 ↔ x = 0 :=
+@[simp] lemma norm_zero [nontrivial S] [module.free R S] [module.finite R S] :
+  norm R (0 : S) = 0 :=
+begin
+  nontriviality,
+  rw [norm_apply, coe_lmul_eq_mul, map_zero, linear_map.det_zero' (module.free.choose_basis R S)]
+end
+
+@[simp] lemma norm_eq_zero_iff [is_domain R] [is_domain S] [module.free R S] [module.finite R S]
+  {x : S} :
+  norm R x = 0 ↔ x = 0 :=
 begin
-  have hι : nonempty ι := b.index_nonempty,
-  letI := classical.dec_eq ι,
-  rw algebra.norm_eq_matrix_det b,
   split,
-  { rw ← matrix.exists_mul_vec_eq_zero_iff,
+  let b := module.free.choose_basis R S,
+  swap, { rintro rfl, exact norm_zero },
+  { letI := classical.dec_eq (module.free.choose_basis_index R S),
+    rw [norm_eq_matrix_det b,
+        ← matrix.exists_mul_vec_eq_zero_iff],
     rintros ⟨v, v_ne, hv⟩,
     rw [← b.equiv_fun.apply_symm_apply v, b.equiv_fun_symm_apply, b.equiv_fun_apply,
-        algebra.left_mul_matrix_mul_vec_repr] at hv,
+        left_mul_matrix_mul_vec_repr] at hv,
     refine (mul_eq_zero.mp (b.ext_elem $ λ i, _)).resolve_right (show ∑ i, v i • b i ≠ 0, from _),
     { simpa only [linear_equiv.map_zero, pi.zero_apply] using congr_fun hv i },
     { contrapose! v_ne with sum_eq,
       apply b.equiv_fun.symm.injective,
       rw [b.equiv_fun_symm_apply, sum_eq, linear_equiv.map_zero] } },
-  { rintro rfl,
-    rw [alg_hom.map_zero, matrix.det_zero hι] },
 end
 
-lemma norm_ne_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
-  algebra.norm R x ≠ 0 ↔ x ≠ 0 :=
-not_iff_not.mpr (algebra.norm_eq_zero_iff_of_basis b)
-
-/-- See also `algebra.norm_eq_zero_iff'` if you already have rewritten with `algebra.norm_apply`. -/
-@[simp]
-lemma norm_eq_zero_iff [finite_dimensional K L] {x : L} :
-  algebra.norm K x = 0 ↔ x = 0 :=
-algebra.norm_eq_zero_iff_of_basis (basis.of_vector_space K L)
+lemma norm_ne_zero_iff [is_domain R] [is_domain S] [module.free R S] [module.finite R S]
+  {x : S} :
+  norm R x ≠ 0 ↔ x ≠ 0 :=
+not_iff_not.mpr norm_eq_zero_iff
 
 /-- This is `algebra.norm_eq_zero_iff` composed with `algebra.norm_apply`. -/
 @[simp]
-lemma norm_eq_zero_iff' [finite_dimensional K L] {x : L} :
-  linear_map.det (algebra.lmul K L x) = 0 ↔ x = 0 :=
-algebra.norm_eq_zero_iff_of_basis (basis.of_vector_space K L)
+lemma norm_eq_zero_iff' [is_domain R] [is_domain S] [module.free R S] [module.finite R S]
+  {x : S} :
+  linear_map.det (linear_map.mul R S x) = 0 ↔ x = 0 :=
+norm_eq_zero_iff
+
+lemma norm_eq_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
+  algebra.norm R x = 0 ↔ x = 0 :=
+begin
+  haveI : module.free R S := module.free.of_basis b,
+  haveI : module.finite R S := module.finite.of_basis b,
+  exact norm_eq_zero_iff
+end
+
+lemma norm_ne_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
+  algebra.norm R x ≠ 0 ↔ x ≠ 0 :=
+not_iff_not.mpr (norm_eq_zero_iff_of_basis b)
 
 end eq_zero_iff
 
@@ -187,13 +216,13 @@ variable {K}
 section intermediate_field
 
 lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_one {x : L}
-  (hx : ¬_root_.is_integral K x) : norm K (adjoin_simple.gen K x) = 1 :=
+  (hx : ¬is_integral K x) : norm K (adjoin_simple.gen K x) = 1 :=
 begin
   rw [norm_eq_one_of_not_exists_basis],
   contrapose! hx,
   obtain ⟨s, ⟨b⟩⟩ := hx,
   refine is_integral_of_mem_of_fg (K⟮x⟯).to_subalgebra _ x _,
-  { exact (submodule.fg_iff_finite_dimensional _).mpr (of_finset_basis b) },
+  { exact (submodule.fg_iff_finite_dimensional _).mpr (of_fintype_basis b) },
   { exact intermediate_field.subset_adjoin K _ (set.mem_singleton x) }
 end
 
@@ -203,9 +232,9 @@ lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_prod_roots (x : L)
     ((minpoly K x).map (algebra_map K F)).roots.prod :=
 begin
   have injKxL := (algebra_map K⟮x⟯ L).injective,
-  by_cases hx : _root_.is_integral K x, swap,
+  by_cases hx : is_integral K x, swap,
   { simp [minpoly.eq_zero hx, intermediate_field.adjoin_simple.norm_gen_eq_one hx] },
-  have hx' : _root_.is_integral K (adjoin_simple.gen K x),
+  have hx' : is_integral K (adjoin_simple.gen K x),
   { rwa [← is_integral_algebra_map_iff injKxL, adjoin_simple.algebra_map_gen],
     apply_instance },
   rw [← adjoin.power_basis_gen hx, power_basis.norm_gen_eq_prod_roots];
@@ -220,21 +249,19 @@ section eq_prod_embeddings
 
 open intermediate_field intermediate_field.adjoin_simple polynomial
 
-variables (E : Type*) [field E] [algebra K E]
+variables (F) (E : Type*) [field E] [algebra K E]
 
-lemma norm_eq_prod_embeddings_gen
-  (pb : power_basis K L)
-  (hE : (minpoly K pb.gen).splits (algebra_map K E)) (hfx : (minpoly K pb.gen).separable) :
-  algebra_map K E (norm K pb.gen) =
-    (@@finset.univ (power_basis.alg_hom.fintype pb)).prod (λ σ, σ pb.gen) :=
+lemma norm_eq_prod_embeddings_gen [algebra R F] (pb : power_basis R S)
+  (hE : (minpoly R pb.gen).splits (algebra_map R F)) (hfx : (minpoly R pb.gen).separable) :
+  algebra_map R F (norm R pb.gen) = (@@finset.univ pb^.alg_hom.fintype).prod (λ σ, σ pb.gen) :=
 begin
-  letI := classical.dec_eq E,
-  rw [power_basis.norm_gen_eq_prod_roots pb hE, fintype.prod_equiv pb.lift_equiv',
+  letI := classical.dec_eq F,
+  rw [pb.norm_gen_eq_prod_roots hE, fintype.prod_equiv pb.lift_equiv',
     finset.prod_mem_multiset, finset.prod_eq_multiset_prod, multiset.to_finset_val,
     multiset.dedup_eq_self.mpr, multiset.map_id],
-  { exact nodup_roots ((separable_map _).mpr hfx) },
+  { exact nodup_roots hfx.map },
   { intro x, refl },
-  { intro σ, rw [power_basis.lift_equiv'_apply_coe, id.def] }
+  { intro σ, rw [pb.lift_equiv'_apply_coe, id.def] }
 end
 
 lemma norm_eq_prod_roots [is_separable K L] [finite_dimensional K L]
@@ -243,13 +270,10 @@ lemma norm_eq_prod_roots [is_separable K L] [finite_dimensional K L]
 by rw [norm_eq_norm_adjoin K x, map_pow,
   intermediate_field.adjoin_simple.norm_gen_eq_prod_roots _ hF]
 
-variable (F)
-
-lemma prod_embeddings_eq_finrank_pow [algebra L F] [is_scalar_tower K L F][is_alg_closed E]
+lemma prod_embeddings_eq_finrank_pow [algebra L F] [is_scalar_tower K L F] [is_alg_closed E]
   [is_separable K F] [finite_dimensional K F] (pb : power_basis K L) :
   ∏ σ : F →ₐ[K] E, σ (algebra_map L F pb.gen) =
-  ((@@finset.univ (power_basis.alg_hom.fintype pb)).prod
-    (λ σ : L →ₐ[K] E, σ pb.gen)) ^ finrank L F :=
+  ((@@finset.univ pb^.alg_hom.fintype).prod (λ σ : L →ₐ[K] E, σ pb.gen)) ^ finrank L F :=
 begin
   haveI : finite_dimensional L F := finite_dimensional.right K L F,
   haveI : is_separable L F := is_separable_tower_top_of_is_separable K L F,
@@ -273,7 +297,7 @@ variable (K)
 of `K`, the norm (down to `K`) of an element `x` of `L` is equal to the product of the images
 of `x` over all the `K`-embeddings `σ`  of `L` into `E`. -/
 lemma norm_eq_prod_embeddings [finite_dimensional K L] [is_separable K L] [is_alg_closed E]
-  {x : L} : algebra_map K E (norm K x) = ∏ σ : L →ₐ[K] E, σ x :=
+  (x : L) : algebra_map K E (norm K x) = ∏ σ : L →ₐ[K] E, σ x :=
 begin
   have hx := is_separable.is_integral K x,
   rw [norm_eq_norm_adjoin K x, ring_hom.map_pow, ← adjoin.power_basis_gen hx,
@@ -283,22 +307,72 @@ begin
     exact is_separable.separable K _ }
 end
 
-lemma is_integral_norm [algebra S L] [algebra S K] [is_scalar_tower S K L]
-  [is_separable K L] [finite_dimensional K L] {x : L} (hx : _root_.is_integral S x) :
-  _root_.is_integral S (norm K x) :=
+lemma norm_eq_prod_automorphisms [finite_dimensional K L] [is_galois K L] (x : L) :
+  algebra_map K L (norm K x) = ∏ (σ : L ≃ₐ[K] L), σ x :=
 begin
-  have hx' : _root_.is_integral K x := is_integral_of_is_scalar_tower _ hx,
+  apply no_zero_smul_divisors.algebra_map_injective L (algebraic_closure L),
+  rw map_prod (algebra_map L (algebraic_closure L)),
+  rw ← fintype.prod_equiv (normal.alg_hom_equiv_aut K (algebraic_closure L) L),
+  { rw ← norm_eq_prod_embeddings,
+    simp only [algebra_map_eq_smul_one, smul_one_smul] },
+  { intro σ,
+    simp only [normal.alg_hom_equiv_aut, alg_hom.restrict_normal', equiv.coe_fn_mk,
+               alg_equiv.coe_of_bijective, alg_hom.restrict_normal_commutes, id.map_eq_id,
+               ring_hom.id_apply] },
+end
+
+lemma is_integral_norm [algebra R L] [algebra R K] [is_scalar_tower R K L]
+  [is_separable K L] [finite_dimensional K L] {x : L} (hx : is_integral R x) :
+  is_integral R (norm K x) :=
+begin
+  have hx' : is_integral K x := is_integral_of_is_scalar_tower hx,
   rw [← is_integral_algebra_map_iff (algebra_map K (algebraic_closure L)).injective,
       norm_eq_prod_roots],
   { refine (is_integral.multiset_prod (λ y hy, _)).pow _,
     rw mem_roots_map (minpoly.ne_zero hx') at hy,
-    use [minpoly S x, minpoly.monic hx],
+    use [minpoly R x, minpoly.monic hx],
     rw ← aeval_def at ⊢ hy,
-    exact minpoly.aeval_of_is_scalar_tower S x y hy },
+    exact minpoly.aeval_of_is_scalar_tower R x y hy },
   { apply is_alg_closed.splits_codomain },
   { apply_instance }
 end
 
+variables {F} (L)
+
+-- TODO. Generalize this proof to rings
+lemma norm_norm [algebra L F] [is_scalar_tower K L F] [is_separable K F] (x : F) :
+  norm K (norm L x) = norm K x :=
+begin
+  by_cases hKF : finite_dimensional K F,
+  { haveI := hKF,
+    let A := algebraic_closure K,
+    apply (algebra_map K A).injective,
+    haveI : finite_dimensional L F := finite_dimensional.right K L F,
+    haveI : finite_dimensional K L := finite_dimensional.left K L F,
+    haveI : is_separable K L := is_separable_tower_bot_of_is_separable K L F,
+    haveI : is_separable L F := is_separable_tower_top_of_is_separable K L F,
+    letI : ∀ (σ : L →ₐ[K] A), by haveI := σ.to_ring_hom.to_algebra; exact fintype (F →ₐ[L] A) :=
+      λ _, infer_instance,
+    rw [norm_eq_prod_embeddings K A (_ : F), fintype.prod_equiv alg_hom_equiv_sigma
+      (λ σ : F →ₐ[K] A, σ x) (λ π : (Σ f : L →ₐ[K] A, _), (π.2 : F → A) x) (λ _, rfl)],
+    suffices : ∀ σ : L →ₐ[K] A,
+      by haveI := σ.to_ring_hom.to_algebra; exact ∏ π : F →ₐ[L] A, π x = σ (norm L x),
+    { simp_rw [← finset.univ_sigma_univ, finset.prod_sigma, this, norm_eq_prod_embeddings], },
+    { intro σ,
+      letI : algebra L A := σ.to_ring_hom.to_algebra,
+      rw ← norm_eq_prod_embeddings L A (_ : F),
+      refl, }},
+  { rw norm_eq_one_of_not_module_finite hKF,
+    by_cases hKL : finite_dimensional K L,
+    { have hLF : ¬ finite_dimensional L F,
+      { refine (mt _) hKF,
+        introI hKF,
+        exact finite_dimensional.trans K L F },
+      rw [norm_eq_one_of_not_module_finite hLF, _root_.map_one], },
+    { rw norm_eq_one_of_not_module_finite hKL, }},
+end
+
+
 end eq_prod_embeddings
 
 end algebra
diff --git a/src/ring_theory/nullstellensatz.lean b/src/ring_theory/nullstellensatz.lean
index 91682491d504a..def2196661005 100644
--- a/src/ring_theory/nullstellensatz.lean
+++ b/src/ring_theory/nullstellensatz.lean
@@ -10,6 +10,9 @@ import algebraic_geometry.prime_spectrum.basic
 
 /-!
 # Nullstellensatz
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file establishes a version of Hilbert's classical Nullstellensatz for `mv_polynomial`s.
 The main statement of the theorem is `vanishing_ideal_zero_locus_eq_radical`.
 
@@ -128,11 +131,12 @@ lemma point_to_point_zero_locus_le (I : ideal (mv_polynomial σ k)) :
 λ J hJ, let ⟨x, hx⟩ := hJ in (le_trans (le_vanishing_ideal_zero_locus I)
   (hx.2 ▸ vanishing_ideal_anti_mono (set.singleton_subset_iff.2 hx.1)) : I ≤ J.as_ideal)
 
-variables [is_alg_closed k] [fintype σ]
+variables [is_alg_closed k] [finite σ]
 
 lemma is_maximal_iff_eq_vanishing_ideal_singleton (I : ideal (mv_polynomial σ k)) :
   I.is_maximal ↔ ∃ (x : σ → k), I = vanishing_ideal {x} :=
 begin
+  casesI nonempty_fintype σ,
   refine ⟨λ hI, _, λ h, let ⟨x, hx⟩ := h in
     hx.symm ▸ (mv_polynomial.vanishing_ideal_singleton_is_maximal)⟩,
   letI : I.is_maximal := hI,
@@ -148,8 +152,7 @@ begin
   intros p hp,
   rw [← quotient.eq_zero_iff_mem, map_mv_polynomial_eq_eval₂ (ideal.quotient.mk I) p, eval₂_eq'],
   rw [mem_vanishing_ideal_singleton_iff, eval_eq'] at hp,
-  convert (trans (congr_arg ϕ hp) ϕ.map_zero),
-  simp only [ϕ.map_sum, ϕ.map_mul, ϕ.map_prod, ϕ.map_pow, hx],
+  simpa only [ϕ.map_sum, ϕ.map_mul, ϕ.map_prod, ϕ.map_pow, ϕ.map_zero, hx] using congr_arg ϕ hp,
 end
 
 /-- Main statement of the Nullstellensatz -/
diff --git a/src/ring_theory/ore_localization/basic.lean b/src/ring_theory/ore_localization/basic.lean
new file mode 100644
index 0000000000000..d307a9e61ee95
--- /dev/null
+++ b/src/ring_theory/ore_localization/basic.lean
@@ -0,0 +1,791 @@
+/-
+Copyright (c) 2022 Jakob von Raumer. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jakob von Raumer, Kevin Klinge
+-/
+import group_theory.monoid_localization
+import ring_theory.non_zero_divisors
+import ring_theory.ore_localization.ore_set
+import tactic.noncomm_ring
+
+/-!
+
+# Localization over right Ore sets.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the localization of a monoid over a right Ore set and proves its universal
+mapping property. It then extends the definition and its properties first to semirings and then
+to rings. We show that in the case of a commutative monoid this definition coincides with the
+common monoid localization. Finally we show that in a ring without zero divisors, taking the Ore
+localization at `R - {0}` results in a division ring.
+
+## Notations
+
+Introduces the notation `R[S⁻¹]` for the Ore localization of a monoid `R` at a right Ore
+subset `S`. Also defines a new heterogeneos division notation `r /ₒ s` for a numerator `r : R` and
+a denominator `s : S`.
+
+## References
+
+* 
+* [Zoran Škoda, *Noncommutative localization in noncommutative geometry*][skoda2006]
+
+
+## Tags
+localization, Ore, non-commutative
+
+-/
+
+universe u
+
+open ore_localization
+
+namespace ore_localization
+
+variables (R : Type*) [monoid R] (S : submonoid R) [ore_set S]
+
+/-- The setoid on `R × S` used for the Ore localization. -/
+def ore_eqv : setoid (R × S) :=
+{ r := λ rs rs', ∃ (u : S) (v : R), rs'.1 * u = rs.1 * v
+                            ∧ (rs'.2 : R) * u = rs.2 * v,
+  iseqv :=
+  begin
+    refine ⟨_, _, _⟩,
+    { rintro ⟨r,s⟩, use 1, use 1, simp [submonoid.one_mem] },
+    { rintros ⟨r, s⟩ ⟨r', s'⟩ ⟨u, v, hru, hsu⟩,
+      rcases ore_condition (s : R) s' with ⟨r₂, s₂, h₁⟩,
+      rcases ore_condition r₂ u with ⟨r₃, s₃, h₂⟩,
+      have : (s : R) * ((v : R) * r₃) = (s : R) * (s₂ * s₃),
+      { assoc_rw [h₁, h₂, hsu], symmetry, apply mul_assoc },
+      rcases ore_left_cancel (v * r₃) (s₂ * s₃) s this with ⟨w, hw⟩,
+      use s₂ * s₃ * w, use u * r₃ * w, split; simp only [submonoid.coe_mul],
+      { assoc_rw [hru, ←hw], simp [mul_assoc] },
+      { assoc_rw [hsu, ←hw], simp [mul_assoc] } },
+    { rintros ⟨r₁, s₁⟩ ⟨r₂, s₂⟩ ⟨r₃, s₃⟩ ⟨u, v, hur₁, hs₁u⟩ ⟨u', v', hur₂, hs₂u⟩,
+      rcases ore_condition v' u with ⟨r', s', h⟩,
+      use u' * s', use v * r', split; simp only [submonoid.coe_mul],
+      { assoc_rw [hur₂, h, hur₁, mul_assoc] },
+      { assoc_rw [hs₂u, h, hs₁u, mul_assoc] } }
+  end }
+
+end ore_localization
+
+/-- The ore localization of a monoid and a submonoid fulfilling the ore condition. -/
+def ore_localization (R : Type*) [monoid R] (S : submonoid R) [ore_set S] :=
+quotient (ore_localization.ore_eqv R S)
+
+namespace ore_localization
+
+section monoid
+
+variables {R : Type*} [monoid R] {S : submonoid R}
+
+variables (R S) [ore_set S]
+
+notation R `[`:1075 S `⁻¹]`:1075 := ore_localization R S
+
+local attribute [instance] ore_eqv
+
+variables {R S}
+
+/-- The division in the ore localization `R[S⁻¹]`, as a fraction of an element of `R` and `S`. -/
+def ore_div (r : R) (s : S) : R[S⁻¹] := quotient.mk (r, s)
+
+infixl ` /ₒ `:70 := ore_div
+
+@[elab_as_eliminator]
+protected lemma ind {β : R [S ⁻¹] → Prop} (c : ∀ (r : R) (s : S), β (r /ₒ s)) : ∀ q, β q :=
+by { apply quotient.ind, rintro ⟨r, s⟩, exact c r s }
+
+lemma ore_div_eq_iff {r₁ r₂ : R} {s₁ s₂ : S} :
+  r₁ /ₒ s₁ = r₂ /ₒ s₂ ↔ (∃ (u : S) (v : R), r₂ * u = r₁ * v ∧ (s₂ : R) * u = s₁ * v) :=
+quotient.eq'
+
+/-- A fraction `r /ₒ s` is equal to its expansion by an arbitrary factor `t` if `s * t ∈ S`. -/
+protected lemma expand (r : R) (s : S) (t : R) (hst : (s : R) * t ∈ S) :
+  r /ₒ s = (r * t) /ₒ (⟨s * t, hst⟩) :=
+by { apply quotient.sound, refine ⟨s, t * s, _, _⟩; dsimp; rw [mul_assoc]; refl }
+
+/-- A fraction is equal to its expansion by an factor from s. -/
+protected lemma expand' (r : R) (s s' : S) : r /ₒ s = (r * s') /ₒ (s * s') :=
+ore_localization.expand r s s' (by norm_cast; apply set_like.coe_mem)
+
+/-- Fractions which differ by a factor of the numerator can be proven equal if
+those factors expand to equal elements of `R`. -/
+protected lemma eq_of_num_factor_eq {r r' r₁ r₂ : R} {s t : S}
+  (h : r * t = r' * t) : (r₁ * r * r₂) /ₒ s = (r₁ * r' * r₂) /ₒ s :=
+begin
+  rcases ore_condition r₂ t with ⟨r₂',t', hr₂⟩,
+  calc (r₁ * r * r₂) /ₒ s = (r₁ * r * r₂ * t') /ₒ (s * t') : ore_localization.expand _ _ t' _
+  ...                     = ((r₁ * r) * (r₂ * t')) /ₒ (s * t') : by simp [←mul_assoc]
+  ...                     = ((r₁ * r) * (t * r₂')) /ₒ (s * t') : by rw hr₂
+  ...                     = (r₁ * (r * t) * r₂') /ₒ (s * t') : by simp [←mul_assoc]
+  ...                     = (r₁ * (r' * t) * r₂') /ₒ (s * t') : by rw h
+  ...                     = (r₁ * r' * (t * r₂')) /ₒ (s * t') : by simp [←mul_assoc]
+  ...                     = (r₁ * r' * (r₂ * t')) /ₒ (s * t') : by rw hr₂
+  ...                     = (r₁ * r' * r₂ * t') /ₒ (s * t') : by simp [←mul_assoc]
+  ...                     = (r₁ * r' * r₂) /ₒ s : by symmetry; apply ore_localization.expand
+end
+
+/-- A function or predicate over `R` and `S` can be lifted to `R[S⁻¹]` if it is invariant
+under expansion on the right. -/
+def lift_expand {C : Sort*} (P : R → S → C)
+  (hP : ∀ (r t : R) (s : S) (ht : ((s : R) * t) ∈ S), P r s = P (r * t) ⟨s * t, ht⟩) :
+  R[S⁻¹] → C :=
+quotient.lift (λ (p : R × S), P p.1 p.2) $ λ p q pq,
+begin
+  cases p with r₁ s₁, cases q with r₂ s₂, rcases pq with ⟨u, v, hr₂, hs₂⟩,
+  dsimp at *,
+  have s₁vS : (s₁ : R) * v ∈ S,
+  { rw [←hs₂, ←S.coe_mul], exact set_like.coe_mem (s₂ * u) },
+  replace hs₂ : s₂ * u = ⟨(s₁ : R) * v, s₁vS⟩, { ext, simp [hs₂] },
+  rw [hP r₁ v s₁ s₁vS, hP r₂ u s₂ (by { norm_cast, rw hs₂, assumption }), hr₂],
+  simpa [← hs₂]
+end
+
+@[simp]
+lemma lift_expand_of {C : Sort*} {P : R → S → C}
+  {hP : ∀ (r t : R) (s : S) (ht : ((s : R) * t) ∈ S), P r s = P (r * t) ⟨s * t, ht⟩}
+  (r : R) (s : S) :
+  lift_expand P hP (r /ₒ s) = P r s := rfl
+
+/-- A version of `lift_expand` used to simultaneously lift functions with two arguments
+in ``R[S⁻¹]`.-/
+def lift₂_expand {C : Sort*} (P : R → S → R → S → C)
+  (hP : ∀ (r₁ t₁ : R) (s₁ : S) (ht₁ : (s₁ : R) * t₁ ∈ S)
+          (r₂ t₂ : R) (s₂ : S) (ht₂ : (s₂ : R) * t₂ ∈ S),
+    P r₁ s₁ r₂ s₂ = P (r₁ * t₁) ⟨s₁ * t₁, ht₁⟩ (r₂ * t₂) ⟨s₂ * t₂, ht₂⟩) : R[S⁻¹] → R[S⁻¹] → C :=
+lift_expand
+  (λ r₁ s₁, lift_expand (P r₁ s₁) $ λ r₂ t₂ s₂ ht₂, by simp [hP r₁ 1 s₁ (by simp) r₂ t₂ s₂ ht₂]) $
+   λ r₁ t₁ s₁ ht₁,
+   begin
+     ext x, induction x using ore_localization.ind with r₂ s₂,
+     rw [lift_expand_of, lift_expand_of, hP r₁ t₁ s₁ ht₁ r₂ 1 s₂ (by simp)], simp,
+   end
+
+@[simp]
+lemma lift₂_expand_of {C : Sort*} {P : R → S → R → S → C}
+  {hP : ∀ (r₁ t₁ : R) (s₁ : S) (ht₁ : (s₁ : R) * t₁ ∈ S)
+          (r₂ t₂ : R) (s₂ : S) (ht₂ : (s₂ : R) * t₂ ∈ S),
+    P r₁ s₁ r₂ s₂ = P (r₁ * t₁) ⟨s₁ * t₁, ht₁⟩ (r₂ * t₂) ⟨s₂ * t₂, ht₂⟩}
+  (r₁ : R) (s₁ : S) (r₂ : R) (s₂ : S) :
+  lift₂_expand P hP (r₁ /ₒ s₁) (r₂ /ₒ s₂) = P r₁ s₁ r₂ s₂ :=
+rfl
+
+private def mul' (r₁ : R) (s₁ : S) (r₂ : R) (s₂ : S) : R[S⁻¹] :=
+  (r₁ * ore_num r₂ s₁) /ₒ (s₂ * ore_denom r₂ s₁)
+
+private lemma mul'_char (r₁ r₂ : R) (s₁ s₂ : S) (u : S) (v : R) (huv : r₂ * (u : R) = s₁ * v) :
+  mul' r₁ s₁ r₂ s₂ = (r₁ * v) /ₒ (s₂ * u) :=
+begin
+  simp only [mul'],
+  have h₀ := ore_eq r₂ s₁, set v₀ := ore_num r₂ s₁, set u₀ := ore_denom r₂ s₁,
+  rcases ore_condition (u₀ : R) u with ⟨r₃, s₃, h₃⟩,
+  have :=
+  calc (s₁ : R) * (v * r₃) = r₂ * u * r₃ : by assoc_rw ←huv; symmetry; apply mul_assoc
+  ...                      = r₂ * u₀ * s₃ : by assoc_rw ←h₃; refl
+  ...                      = s₁ * (v₀ * s₃) : by assoc_rw h₀; apply mul_assoc,
+  rcases ore_left_cancel _ _ _ this with ⟨s₄, hs₄⟩,
+  symmetry, rw ore_div_eq_iff,
+  use s₃ * s₄, use r₃ * s₄, simp only [submonoid.coe_mul], split,
+  { assoc_rw ←hs₄, simp only [mul_assoc] },
+  { assoc_rw h₃, simp only [mul_assoc] }
+end
+
+/-- The multiplication on the Ore localization of monoids. -/
+protected def mul : R[S⁻¹] → R[S⁻¹] → R[S⁻¹] :=
+lift₂_expand mul' $ λ r₂ p s₂ hp r₁ r s₁ hr,
+begin
+  have h₁ := ore_eq r₁ s₂, set r₁' := ore_num r₁ s₂, set s₂' := ore_denom r₁ s₂,
+  rcases ore_condition (↑s₂ * r₁') ⟨s₂ * p, hp⟩ with ⟨p', s_star, h₂⟩, dsimp at h₂,
+  rcases ore_condition r (s₂' * s_star) with ⟨p_flat, s_flat, h₃⟩, simp only [S.coe_mul] at h₃,
+  have : r₁ * r * s_flat = s₂ * p * (p' * p_flat),
+  { rw [←mul_assoc, ←h₂, ←h₁, mul_assoc, h₃], simp only [mul_assoc] },
+  rw mul'_char (r₂ * p) (r₁ * r) ⟨↑s₂ * p, hp⟩ ⟨↑s₁ * r, hr⟩ _ _ this, clear this,
+  have hsssp : ↑s₁ * ↑s₂' * ↑s_star * p_flat ∈ S,
+  { rw [mul_assoc, mul_assoc, ←mul_assoc ↑s₂', ←h₃, ←mul_assoc],
+    exact S.mul_mem hr (set_like.coe_mem s_flat) },
+  have : (⟨↑s₁ * r, hr⟩ : S) * s_flat = ⟨s₁ * s₂' * s_star * p_flat, hsssp⟩,
+  { ext, simp only [set_like.coe_mk, submonoid.coe_mul],
+    rw [mul_assoc, h₃, ←mul_assoc, ←mul_assoc] },
+  rw this, clear this,
+  rcases ore_left_cancel (p * p') (r₁' * ↑s_star) s₂ (by simp [←mul_assoc, h₂]) with ⟨s₂'', h₂''⟩,
+  rw [←mul_assoc, mul_assoc r₂, ore_localization.eq_of_num_factor_eq h₂''],
+  norm_cast at ⊢ hsssp, rw [←ore_localization.expand _ _ _ hsssp, ←mul_assoc],
+  apply ore_localization.expand
+end
+
+instance : has_mul R[S⁻¹] := ⟨ore_localization.mul⟩
+
+lemma ore_div_mul_ore_div {r₁ r₂ : R} {s₁ s₂ : S} :
+  (r₁ /ₒ s₁) * (r₂ /ₒ s₂) = (r₁ * ore_num r₂ s₁) /ₒ (s₂ * ore_denom r₂ s₁) := rfl
+
+/-- A characterization lemma for the multiplication on the Ore localization, allowing for a choice
+of Ore numerator and Ore denominator. -/
+lemma ore_div_mul_char (r₁ r₂ : R) (s₁ s₂ : S) (r' : R) (s' : S)
+  (huv : r₂ * (s' : R) = s₁ * r') : (r₁ /ₒ s₁) * (r₂ /ₒ s₂) = (r₁ * r') /ₒ (s₂ * s') :=
+mul'_char r₁ r₂ s₁ s₂ s' r' huv
+
+/-- Another characterization lemma for the multiplication on the Ore localizaion delivering
+Ore witnesses and conditions bundled in a sigma type. -/
+def ore_div_mul_char' (r₁ r₂ : R) (s₁ s₂ : S) :
+  Σ' r' : R, Σ' s' : S, r₂ * (s' : R) = s₁ * r'
+                        ∧  (r₁ /ₒ s₁) * (r₂ /ₒ s₂) = (r₁ * r') /ₒ (s₂ * s') :=
+⟨ore_num r₂ s₁, ore_denom r₂ s₁, ore_eq r₂ s₁, ore_div_mul_ore_div⟩
+
+instance : has_one R[S⁻¹] := ⟨1 /ₒ 1⟩
+
+protected lemma one_def : (1 : R[S⁻¹]) = 1 /ₒ 1 := rfl
+
+instance : inhabited R[S⁻¹] := ⟨1⟩
+
+@[simp]
+protected lemma div_eq_one' {r : R} (hr : r ∈ S) : r /ₒ ⟨r, hr⟩ = 1 :=
+by { rw [ore_localization.one_def, ore_div_eq_iff], exact ⟨⟨r, hr⟩, 1, by simp, by simp⟩ }
+
+@[simp]
+protected lemma div_eq_one {s : S} : (s : R) /ₒ s = 1 :=
+by { cases s; apply ore_localization.div_eq_one' }
+
+protected lemma one_mul (x : R[S⁻¹]) : 1 * x = x :=
+begin
+  induction x using ore_localization.ind with r s,
+  simp [ore_localization.one_def, ore_div_mul_char (1 : R) r (1 : S) s r 1 (by simp)]
+end
+
+protected lemma mul_one (x : R[S⁻¹]) : x * 1 = x :=
+begin
+  induction x using ore_localization.ind with r s,
+  simp [ore_localization.one_def, ore_div_mul_char r 1 s 1 1 s (by simp)]
+end
+
+protected lemma mul_assoc (x y z : R[S⁻¹]) : x * y * z = x * (y * z) :=
+begin
+  induction x using ore_localization.ind with r₁ s₁,
+  induction y using ore_localization.ind with r₂ s₂,
+  induction z using ore_localization.ind with r₃ s₃,
+  rcases ore_div_mul_char' r₁ r₂ s₁ s₂ with ⟨ra, sa, ha, ha'⟩, rw ha', clear ha',
+  rcases ore_div_mul_char' r₂ r₃ s₂ s₃ with ⟨rb, sb, hb, hb'⟩, rw hb', clear hb',
+  rcases ore_condition rb sa with ⟨rc, sc, hc⟩,
+  rw ore_div_mul_char (r₁ * ra) r₃ (s₂ * sa) s₃ rc (sb * sc)
+    (by { simp only [submonoid.coe_mul], assoc_rw [hb, hc] }),
+  rw [mul_assoc, ←mul_assoc s₃],
+  symmetry, apply ore_div_mul_char,
+  assoc_rw [hc, ←ha], apply mul_assoc
+end
+
+instance : monoid R[S⁻¹] :=
+{ one_mul := ore_localization.one_mul,
+  mul_one := ore_localization.mul_one,
+  mul_assoc := ore_localization.mul_assoc,
+  .. ore_localization.has_mul,
+  .. ore_localization.has_one }
+
+protected lemma mul_inv (s s' : S) : ((s : R) /ₒ s') * (s' /ₒ s) = 1 :=
+by simp [ore_div_mul_char (s :R) s' s' s 1 1 (by simp)]
+
+@[simp]
+protected lemma mul_one_div {r : R} {s t : S} : (r /ₒ s) * (1 /ₒ t) = r /ₒ (t * s) :=
+by simp [ore_div_mul_char r 1 s t 1 s (by simp)]
+
+@[simp]
+protected lemma mul_cancel {r : R} {s t : S} : (r /ₒ s) * (s /ₒ t) = r /ₒ t :=
+by simp [ore_div_mul_char r s s t 1 1 (by simp)]
+
+@[simp]
+protected lemma mul_cancel' {r₁ r₂ : R} {s t : S} : (r₁ /ₒ s) * ((s * r₂) /ₒ t) = (r₁ * r₂) /ₒ t :=
+by simp [ore_div_mul_char r₁ (s * r₂) s t r₂ 1 (by simp)]
+
+@[simp]
+lemma div_one_mul {p r : R} {s : S} :
+  (r /ₒ 1) * (p /ₒ s) = (r * p) /ₒ s := --TODO use coercion r ↦ r /ₒ 1
+by simp [ore_div_mul_char r p 1 s p 1 (by simp)]
+
+/-- The fraction `s /ₒ 1` as a unit in `R[S⁻¹]`, where `s : S`. -/
+def numerator_unit (s : S) : units R[S⁻¹] :=
+{ val := (s : R) /ₒ 1,
+  inv := (1 : R) /ₒ s,
+  val_inv := ore_localization.mul_inv s 1,
+  inv_val := ore_localization.mul_inv 1 s }
+
+/-- The multiplicative homomorphism from `R` to `R[S⁻¹]`, mapping `r : R` to the
+fraction `r /ₒ 1`. -/
+def numerator_hom : R →* R[S⁻¹] :=
+{ to_fun := λ r, r /ₒ 1,
+  map_one' := rfl,
+  map_mul' := λ r₁ r₂, div_one_mul.symm }
+
+lemma numerator_hom_apply {r : R} : numerator_hom r = r /ₒ (1 : S) := rfl
+
+lemma numerator_is_unit (s : S) : is_unit ((numerator_hom (s : R)) : R[S⁻¹]) :=
+⟨numerator_unit s, rfl⟩
+
+section UMP
+
+variables {T : Type*} [monoid T]
+variables (f : R →* T) (fS : S →* units T)
+variables (hf : ∀ (s : S), f s = fS s)
+
+include f fS hf
+
+/-- The universal lift from a morphism `R →* T`, which maps elements of `S` to units of `T`,
+to a morphism `R[S⁻¹] →* T`. -/
+def universal_mul_hom : R[S⁻¹] →* T :=
+{ to_fun := λ x, x.lift_expand (λ r s, (f r) * ((fS s)⁻¹ : units T)) $ λ r t s ht,
+  begin
+    have : ((fS ⟨s * t, ht⟩) : T) = fS s * f t,
+    { simp only [←hf, set_like.coe_mk, monoid_hom.map_mul] },
+    conv_rhs { rw [monoid_hom.map_mul, ←mul_one (f r), ←units.coe_one, ←mul_left_inv (fS s)],
+      rw [units.coe_mul, ←mul_assoc, mul_assoc _ ↑(fS s), ←this, mul_assoc] },
+    simp only [mul_one, units.mul_inv]
+  end,
+  map_one' := by rw [ore_localization.one_def, lift_expand_of]; simp,
+  map_mul' := λ x y,
+  begin
+    induction x using ore_localization.ind with r₁ s₁,
+    induction y using ore_localization.ind with r₂ s₂,
+    rcases ore_div_mul_char' r₁ r₂ s₁ s₂ with ⟨ra, sa, ha, ha'⟩, rw ha', clear ha',
+    rw [lift_expand_of, lift_expand_of, lift_expand_of],
+    conv_rhs { congr, skip, congr,
+      rw [←mul_one (f r₂), ←(fS sa).mul_inv, ←mul_assoc, ←hf, ←f.map_mul, ha, f.map_mul] },
+    rw [mul_assoc, mul_assoc, mul_assoc, ←mul_assoc _ (f s₁), hf s₁, (fS s₁).inv_mul, one_mul,
+      f.map_mul, mul_assoc, fS.map_mul, ←units.coe_mul], refl
+  end }
+
+lemma universal_mul_hom_apply {r : R} {s : S} :
+  universal_mul_hom f fS hf (r /ₒ s) = (f r) * ((fS s)⁻¹ : units T) :=
+rfl
+
+lemma universal_mul_hom_commutes {r : R} : universal_mul_hom f fS hf (numerator_hom r) = f r :=
+by simp [numerator_hom_apply, universal_mul_hom_apply]
+
+/-- The universal morphism `universal_mul_hom` is unique. -/
+lemma universal_mul_hom_unique (φ : R[S⁻¹] →* T) (huniv : ∀ (r : R), φ (numerator_hom r) = f r) :
+  φ = universal_mul_hom f fS hf :=
+begin
+  ext, induction x using ore_localization.ind with r s,
+  rw [universal_mul_hom_apply, ←huniv r, numerator_hom_apply, ←mul_one (φ (r /ₒ s)),
+    ←units.coe_one, ←mul_right_inv (fS s), units.coe_mul, ←mul_assoc,
+    ←hf, ←huniv, ←φ.map_mul, numerator_hom_apply, ore_localization.mul_cancel],
+end
+
+end UMP
+
+end monoid
+
+section comm_monoid
+
+variables {R : Type*} [comm_monoid R] {S : submonoid R} [ore_set S]
+
+lemma ore_div_mul_ore_div_comm {r₁ r₂ : R} {s₁ s₂ : S} :
+  (r₁ /ₒ s₁) * (r₂ /ₒ s₂) = (r₁ * r₂) /ₒ (s₁ * s₂) :=
+by rw [ore_div_mul_char r₁ r₂ s₁ s₂ r₂ s₁ (by simp [mul_comm]), mul_comm s₂]
+
+instance : comm_monoid R[S⁻¹] :=
+{ mul_comm := λ x y,
+  begin
+    induction x using ore_localization.ind with r₁ s₁,
+    induction y using ore_localization.ind with r₂ s₂,
+    rw [ore_div_mul_ore_div_comm, ore_div_mul_ore_div_comm, mul_comm r₁, mul_comm s₁],
+  end,
+  ..ore_localization.monoid }
+
+variables (R S)
+
+/-- The morphism `numerator_hom` is a monoid localization map in the case of commutative `R`. -/
+protected def localization_map : S.localization_map R[S⁻¹] :=
+{ to_fun := numerator_hom,
+  map_one' := rfl,
+  map_mul' := λ r₁ r₂, by simp,
+  map_units' := numerator_is_unit,
+  surj' := λ z,
+  begin
+    induction z using ore_localization.ind with r s,
+    use (r, s), dsimp,
+    rw [numerator_hom_apply, numerator_hom_apply], simp
+  end,
+  eq_iff_exists' := λ r₁ r₂,
+  begin
+    dsimp, split,
+    { intro h,
+      rw [numerator_hom_apply, numerator_hom_apply, ore_div_eq_iff] at h,
+      rcases h with ⟨u, v, h₁, h₂⟩, dsimp at h₂,
+      rw [one_mul, one_mul] at h₂,
+      subst h₂,
+      use u,
+      simpa only [mul_comm] using h₁.symm },
+    { rintro ⟨s, h⟩,
+      rw [numerator_hom_apply, numerator_hom_apply, ore_div_eq_iff],
+      refine ⟨s, s, _, _⟩,
+      { simpa [mul_comm] using h.symm },
+      { simp [one_mul]} }
+  end }
+
+/-- If `R` is commutative, Ore localization and monoid localization are isomorphic. -/
+protected noncomputable def equiv_monoid_localization : localization S ≃* R[S⁻¹] :=
+localization.mul_equiv_of_quotient (ore_localization.localization_map R S)
+
+end comm_monoid
+
+section semiring
+
+variables {R : Type*} [semiring R] {S : submonoid R} [ore_set S]
+
+private def add'' (r₁ : R) (s₁ : S) (r₂ : R) (s₂ : S) : R[S⁻¹] :=
+(r₁ * ore_denom (s₁ : R) s₂ + r₂ * ore_num s₁ s₂) /ₒ (s₁ * ore_denom s₁ s₂)
+
+private lemma add''_char
+  (r₁ : R) (s₁ : S) (r₂ : R) (s₂ : S)
+  (rb : R) (sb : S) (hb : (s₁ : R) * sb = (s₂ : R) * rb) :
+add'' r₁ s₁ r₂ s₂ = (r₁ * sb + r₂ * rb) /ₒ (s₁ * sb) :=
+begin
+  simp only [add''],
+  have ha := ore_eq (s₁ : R) s₂,
+  set! ra := ore_num (s₁ : R) s₂ with h, rw ←h at *, clear h, -- r tilde
+  set! sa := ore_denom (s₁ : R) s₂ with h, rw ←h at *, clear h, -- s tilde
+  rcases ore_condition (sa : R) sb with ⟨rc, sc, hc⟩, -- s*, r*
+  have : (s₂ : R) * (rb * rc) = s₂ * (ra * sc),
+  { rw [←mul_assoc, ←hb, mul_assoc, ←hc, ←mul_assoc, ←mul_assoc, ha] },
+  rcases ore_left_cancel _ _ s₂ this with ⟨sd, hd⟩, -- s#
+  symmetry, rw ore_div_eq_iff,
+  use sc * sd, use rc * sd,
+  split; simp only [submonoid.coe_mul],
+  { noncomm_ring, assoc_rw [hd, hc], noncomm_ring },
+  { assoc_rewrite [hc], noncomm_ring }
+end
+
+local attribute [instance] ore_localization.ore_eqv
+
+private def add' (r₂ : R) (s₂ : S) : R[S⁻¹] → R[S⁻¹] := --plus tilde
+quotient.lift (λ (r₁s₁ : R × S), add'' r₁s₁.1 r₁s₁.2 r₂ s₂) $
+begin
+  rintros ⟨r₁', s₁'⟩ ⟨r₁, s₁⟩ ⟨sb, rb, hb, hb'⟩, -- s*, r*
+  rcases ore_condition (s₁' : R) s₂ with ⟨rc, sc, hc⟩, --s~~, r~~
+  rcases ore_condition rb sc with ⟨rd, sd, hd⟩, -- s#, r#
+  dsimp at *, rw add''_char _ _ _ _ rc sc hc,
+  have : ↑s₁ * ↑(sb * sd) = ↑s₂ * (rc * rd),
+  { simp only [submonoid.coe_mul], assoc_rewrite [hb', hd, hc], noncomm_ring },
+  rw add''_char _ _ _ _ (rc * rd : R) (sb * sd : S) this,
+  simp only [submonoid.coe_mul], assoc_rw [hb, hd],
+  rw [←mul_assoc, ←add_mul, ore_div_eq_iff],
+  use 1, use rd, split,
+  { simp },
+  { simp only [mul_one, submonoid.coe_one, submonoid.coe_mul] at ⊢ this, assoc_rw [hc, this] },
+end
+
+private lemma add'_comm (r₁ r₂ : R) (s₁ s₂ : S) : add' r₁ s₁ (r₂ /ₒ s₂) = add' r₂ s₂ (r₁ /ₒ s₁) :=
+begin
+  simp only [add', ore_div, add'', quotient.lift_mk, quotient.eq],
+  have hb := ore_eq ↑s₂ s₁, set rb := ore_num ↑s₂ s₁ with h, -- r~~
+    rw ←h, clear h, set sb := ore_denom ↑s₂ s₁ with h, rw ←h, clear h, -- s~~
+  have ha := ore_eq ↑s₁ s₂, set ra := ore_num ↑s₁ s₂ with h, -- r~
+    rw ←h, clear h, set sa := ore_denom ↑s₁ s₂ with h, rw ←h, clear h, -- s~
+  rcases ore_condition ra sb with ⟨rc, sc, hc⟩, -- r#, s#
+  have : (s₁ : R) * (rb * rc) = s₁ * (sa * sc),
+  { rw [←mul_assoc, ←hb, mul_assoc, ←hc, ←mul_assoc, ←ha, mul_assoc] },
+  rcases ore_left_cancel _ _ s₁ this with ⟨sd, hd⟩, -- s+
+  use sc * sd, use rc * sd,
+  dsimp, split,
+  { rw [add_mul, add_mul, add_comm], assoc_rw [←hd, hc], noncomm_ring },
+  { rw [mul_assoc, ←mul_assoc ↑sa, ←hd, hb], noncomm_ring }
+end
+
+/-- The addition on the Ore localization. -/
+private def add : R[S⁻¹] → R[S⁻¹] → R[S⁻¹] :=
+λ x,
+quotient.lift (λ rs : R × S, add' rs.1 rs.2 x)
+begin
+  rintros ⟨r₁, s₁⟩ ⟨r₂, s₂⟩ hyz,
+  induction x using ore_localization.ind with r₃ s₃,
+  dsimp, rw [add'_comm, add'_comm r₂],
+  simp [(/ₒ), quotient.sound hyz],
+end
+
+instance : has_add R[S⁻¹] := ⟨add⟩
+
+lemma ore_div_add_ore_div {r r' : R} {s s' : S} :
+  r /ₒ s + r' /ₒ s' = (r * ore_denom (s : R) s' + r' * ore_num s s') /ₒ (s * ore_denom s s') :=
+rfl
+
+/-- A characterization of the addition on the Ore localizaion, allowing for arbitrary Ore
+numerator and Ore denominator. -/
+lemma ore_div_add_char {r r' : R} (s s' : S) (rb : R) (sb : S)
+  (h : (s : R) * sb = s' * rb) :
+  r /ₒ s + r' /ₒ s' = (r * sb + r' * rb) /ₒ (s * sb) :=
+add''_char r s r' s' rb sb h
+
+/-- Another characterization of the addition on the Ore localization, bundling up all witnesses
+and conditions into a sigma type. -/
+def ore_div_add_char' (r r' : R) (s s' : S) :
+  Σ' r'' : R, Σ' s'' : S, (s : R) * s'' = s' * r'' ∧
+                  r /ₒ s + r' /ₒs' = (r * s'' + r' * r'') /ₒ (s * s'') :=
+⟨ore_num s s', ore_denom s s', ore_eq s s', ore_div_add_ore_div⟩
+
+@[simp] lemma add_ore_div {r r' : R} {s : S} : (r /ₒ s) + (r' /ₒ s) = (r + r') /ₒ s :=
+by simp [ore_div_add_char s s 1 1 (by simp)]
+
+protected lemma add_assoc (x y z : R[S⁻¹]) :
+  (x + y) + z = x + (y + z) :=
+begin
+  induction x using ore_localization.ind with r₁ s₁,
+  induction y using ore_localization.ind with r₂ s₂,
+  induction z using ore_localization.ind with r₃ s₃,
+  rcases ore_div_add_char' r₁ r₂ s₁ s₂ with ⟨ra, sa, ha, ha'⟩, rw ha', clear ha',
+  rcases ore_div_add_char' r₂ r₃ s₂ s₃ with ⟨rb, sb, hb, hb'⟩, rw hb', clear hb',
+  rcases ore_div_add_char' (r₁ * sa + r₂ * ra) r₃ (s₁ * sa) s₃ with ⟨rc, sc, hc, q⟩, rw q, clear q,
+  rcases ore_div_add_char' r₁ (r₂ * sb + r₃ * rb) s₁ (s₂ * sb) with ⟨rd, sd, hd, q⟩, rw q, clear q,
+  noncomm_ring, rw add_comm (r₂ * _),
+  repeat { rw ←add_ore_div },
+  congr' 1,
+  { rcases ore_condition (sd : R) (sa * sc) with ⟨re, se, he⟩,
+    { simp_rw ←submonoid.coe_mul at hb hc hd,
+      assoc_rw [subtype.coe_eq_of_eq_mk hc],
+      rw [←ore_localization.expand, subtype.coe_eq_of_eq_mk hd, ←mul_assoc,
+        ←ore_localization.expand, subtype.coe_eq_of_eq_mk hb],
+      apply ore_localization.expand } },
+  congr' 1,
+  { rw [←ore_localization.expand', ←mul_assoc, ←mul_assoc,
+      ←ore_localization.expand', ←ore_localization.expand'] },
+  { simp_rw [←submonoid.coe_mul] at ha hd,
+    rw [subtype.coe_eq_of_eq_mk hd, ←mul_assoc, ←mul_assoc,
+      ←mul_assoc, ←ore_localization.expand, ←ore_localization.expand',
+      subtype.coe_eq_of_eq_mk ha, ←ore_localization.expand],
+    apply ore_localization.expand' }
+end
+
+private def zero : R[S⁻¹] := 0 /ₒ 1
+
+instance : has_zero R[S⁻¹] := ⟨zero⟩
+
+protected lemma zero_def : (0 : R[S⁻¹]) = 0 /ₒ 1 := rfl
+
+@[simp]
+lemma zero_div_eq_zero (s : S) : 0 /ₒ s = 0 :=
+by { rw [ore_localization.zero_def, ore_div_eq_iff], exact ⟨s, 1, by simp⟩ }
+
+protected lemma zero_add (x : R[S⁻¹]) : 0 + x = x :=
+begin
+  induction x using ore_localization.ind,
+  rw [←zero_div_eq_zero, add_ore_div], simp
+end
+
+protected lemma add_comm (x y : R[S⁻¹]) : x + y = y + x :=
+begin
+  induction x using ore_localization.ind,
+  induction y using ore_localization.ind,
+  change add' _ _ (_ /ₒ _) = _, apply add'_comm
+end
+
+instance : add_comm_monoid R[S⁻¹] :=
+{ add_comm := ore_localization.add_comm,
+  add_assoc := ore_localization.add_assoc,
+  zero := zero,
+  zero_add := ore_localization.zero_add,
+  add_zero := λ x, by rw [ore_localization.add_comm, ore_localization.zero_add],
+  .. ore_localization.has_add }
+
+protected lemma zero_mul (x : R[S⁻¹]) : 0 * x = 0 :=
+begin
+  induction x using ore_localization.ind with r s,
+  rw [ore_localization.zero_def, ore_div_mul_char 0 r 1 s r 1 (by simp)], simp
+end
+
+protected lemma mul_zero (x : R[S⁻¹]) : x * 0 = 0 :=
+begin
+  induction x using ore_localization.ind with r s,
+  rw [ore_localization.zero_def, ore_div_mul_char r 0 s 1 0 1 (by simp)], simp
+end
+
+protected lemma left_distrib (x y z : R[S⁻¹]) : x * (y + z) = x * y + x * z :=
+begin
+  induction x using ore_localization.ind with r₁ s₁,
+  induction y using ore_localization.ind with r₂ s₂,
+  induction z using ore_localization.ind with r₃ s₃,
+  rcases ore_div_add_char' r₂ r₃ s₂ s₃ with ⟨ra, sa, ha, q⟩, rw q, clear q,
+  rw ore_localization.expand' r₂ s₂ sa,
+  rcases ore_div_mul_char' r₁ (r₂ * sa) s₁ (s₂ * sa) with ⟨rb, sb, hb, q⟩, rw q, clear q,
+  have hs₃rasb : ↑s₃ * (ra * sb) ∈ S, { rw [←mul_assoc, ←ha], norm_cast, apply set_like.coe_mem },
+  rw ore_localization.expand _ _ _ hs₃rasb,
+  have ha' : (↑(s₂ * sa * sb)) = ↑s₃ * (ra * sb), { simp [ha, ←mul_assoc] },
+  rw ←subtype.coe_eq_of_eq_mk ha',
+  rcases ore_div_mul_char' r₁ (r₃ * (ra * sb)) s₁ (s₂ * sa * sb) with ⟨rc, sc, hc, hc'⟩, rw hc',
+  rw ore_div_add_char (s₂ * sa * sb) (s₂ * sa * sb * sc) 1 sc (by simp),
+  rw ore_localization.expand' (r₂ * ↑sa + r₃ * ra) (s₂ * sa) (sb * sc),
+  conv_lhs { congr, skip, congr,
+    rw [add_mul, S.coe_mul, ←mul_assoc, hb, ←mul_assoc, mul_assoc r₃, hc, mul_assoc, ←mul_add] },
+  rw ore_localization.mul_cancel', simp only [mul_one, submonoid.coe_mul, mul_add, ←mul_assoc],
+end
+
+lemma right_distrib (x y z : R[S⁻¹]) : (x + y) * z = x * z + y * z :=
+begin
+  induction x using ore_localization.ind with r₁ s₁,
+  induction y using ore_localization.ind with r₂ s₂,
+  induction z using ore_localization.ind with r₃ s₃,
+  rcases ore_div_add_char' r₁ r₂ s₁ s₂ with ⟨ra, sa, ha, ha'⟩, rw ha', clear ha', norm_cast at ha,
+  rw ore_localization.expand' r₁ s₁ sa,
+  rw ore_localization.expand r₂ s₂ ra (by rw ←ha; apply set_like.coe_mem),
+  rw ←subtype.coe_eq_of_eq_mk ha,
+  repeat { rw ore_div_mul_ore_div }, simp only [add_mul, add_ore_div]
+end
+
+instance : semiring R[S⁻¹] :=
+{ zero_mul := ore_localization.zero_mul,
+  mul_zero := ore_localization.mul_zero,
+  left_distrib := ore_localization.left_distrib,
+  right_distrib := right_distrib,
+  .. ore_localization.add_comm_monoid,
+  .. ore_localization.monoid }
+
+section UMP
+variables {T : Type*} [semiring T]
+variables (f : R →+* T) (fS : S →* units T)
+variables (hf : ∀ (s : S), f s = fS s)
+
+include f fS hf
+
+/-- The universal lift from a ring homomorphism `f : R →+* T`, which maps elements in `S` to
+units of `T`, to a ring homomorphism `R[S⁻¹] →+* T`. This extends the construction on
+monoids. -/
+def universal_hom : R[S⁻¹] →+* T :=
+{ map_zero' :=
+  begin
+    rw [monoid_hom.to_fun_eq_coe, ore_localization.zero_def, universal_mul_hom_apply],
+    simp
+  end,
+  map_add' := λ x y,
+  begin
+    induction x using ore_localization.ind with r₁ s₁,
+    induction y using ore_localization.ind with r₂ s₂,
+    rcases ore_div_add_char' r₁ r₂ s₁ s₂ with ⟨r₃, s₃, h₃, h₃'⟩, rw h₃', clear h₃',
+    simp only [universal_mul_hom_apply, ring_hom.coe_monoid_hom,
+      ring_hom.to_monoid_hom_eq_coe, monoid_hom.to_fun_eq_coe],
+    simp only [mul_inv_rev, monoid_hom.map_mul, ring_hom.map_add, ring_hom.map_mul, units.coe_mul],
+    rw [add_mul, ←mul_assoc, mul_assoc (f r₁), hf, ←units.coe_mul],
+    simp only [mul_one, mul_right_inv, units.coe_one],
+    congr' 1, rw [mul_assoc], congr' 1,
+    norm_cast at h₃, have h₃' := subtype.coe_eq_of_eq_mk h₃,
+    rw [←units.coe_mul, ←mul_inv_rev, ←fS.map_mul, h₃'],
+    have hs₂r₃ : ↑s₂ * r₃ ∈ S, { rw ←h₃, exact set_like.coe_mem (s₁ * s₃)},
+    apply (units.inv_mul_cancel_left (fS s₂) _).symm.trans,
+    conv_lhs { congr, skip,
+      rw [←units.mul_inv_cancel_left (fS ⟨s₂ * r₃, hs₂r₃⟩) (fS s₂), mul_assoc, mul_assoc],
+      congr, skip, rw [←hf, ←mul_assoc (f s₂), ←f.map_mul],
+      conv { congr, skip, congr, rw [←h₃] },
+      rw [hf, ←mul_assoc, ←h₃', units.inv_mul] },
+    rw [one_mul, ←h₃', units.mul_inv, mul_one],
+  end,
+  .. universal_mul_hom f.to_monoid_hom fS hf }
+
+lemma universal_hom_apply {r : R} {s : S} :
+  universal_hom f fS hf (r /ₒ s) = (f r) * ((fS s)⁻¹ : units T) := rfl
+
+lemma universal_hom_commutes {r : R} : universal_hom f fS hf (numerator_hom r) = f r :=
+by simp [numerator_hom_apply, universal_hom_apply]
+
+lemma universal_hom_unique (φ : R[S⁻¹] →+* T) (huniv : ∀ (r : R), φ (numerator_hom r) = f r) :
+  φ = universal_hom f fS hf :=
+ring_hom.coe_monoid_hom_injective $
+universal_mul_hom_unique (ring_hom.to_monoid_hom f) fS hf ↑φ huniv
+
+end UMP
+
+end semiring
+
+section ring
+variables {R : Type*} [ring R] {S : submonoid R} [ore_set S]
+
+/-- Negation on the Ore localization is defined via negation on the numerator. -/
+protected def neg : R[S⁻¹] → R[S⁻¹] :=
+lift_expand (λ (r : R) (s : S), (- r) /ₒ s) $
+  λ r t s ht, by rw [neg_mul_eq_neg_mul, ←ore_localization.expand]
+
+instance : has_neg R[S⁻¹] := ⟨ore_localization.neg⟩
+
+@[simp] protected lemma neg_def (r : R) (s : S) : - (r /ₒ s) = (- r) /ₒ s := rfl
+
+protected lemma add_left_neg (x : R[S⁻¹]) : (- x) + x = 0 :=
+by induction x using ore_localization.ind with r s; simp
+
+instance : ring R[S⁻¹] :=
+{ add_left_neg := ore_localization.add_left_neg,
+  .. ore_localization.semiring,
+  .. ore_localization.has_neg }
+
+open_locale non_zero_divisors
+
+lemma numerator_hom_inj (hS : S ≤ R⁰) : function.injective (numerator_hom : R → R[S⁻¹]) :=
+λ r₁ r₂ h,
+begin
+  rw [numerator_hom_apply, numerator_hom_apply, ore_div_eq_iff] at h,
+  rcases h with ⟨u, v, h₁, h₂⟩,
+  simp only [S.coe_one, one_mul] at h₂,
+  rwa [←h₂, mul_cancel_right_mem_non_zero_divisor (hS (set_like.coe_mem u)), eq_comm] at h₁,
+end
+
+lemma nontrivial_of_non_zero_divisors [nontrivial R] (hS : S ≤ R⁰) : nontrivial R[S⁻¹] :=
+⟨⟨0, 1, λ h,
+  begin
+    rw [ore_localization.one_def, ore_localization.zero_def] at h,
+    apply non_zero_divisors.coe_ne_zero 1 (numerator_hom_inj hS h).symm
+  end⟩⟩
+
+end ring
+
+section division_ring
+
+open_locale non_zero_divisors
+open_locale classical
+
+variables {R : Type*} [ring R] [nontrivial R] [ore_set R⁰]
+
+instance : nontrivial R[R⁰⁻¹] := nontrivial_of_non_zero_divisors (refl R⁰)
+
+variables [no_zero_divisors R]
+
+noncomputable theory
+
+/-- The inversion of Ore fractions for a ring without zero divisors, satisying `0⁻¹ = 0` and
+`(r /ₒ r')⁻¹ = r' /ₒ r` for `r ≠ 0`. -/
+protected def inv : R[R⁰⁻¹] → R[R⁰⁻¹] :=
+lift_expand (λ r s, if hr: r = (0 : R) then (0 : R[R⁰⁻¹])
+  else (s /ₒ ⟨r, λ _, eq_zero_of_ne_zero_of_mul_right_eq_zero hr⟩))
+begin
+  intros r t s hst,
+  by_cases hr : r = 0,
+  { simp [hr] },
+  { by_cases ht : t = 0,
+    { exfalso, apply non_zero_divisors.coe_ne_zero ⟨_, hst⟩, simp [ht, mul_zero] },
+    { simp only [hr, ht, set_like.coe_mk, dif_neg, not_false_iff, or_self, mul_eq_zero],
+      apply ore_localization.expand } }
+end
+
+instance : has_inv R[R⁰⁻¹] := ⟨ore_localization.inv⟩
+
+protected lemma inv_def {r : R} {s : R⁰} :
+  (r /ₒ s)⁻¹ = if hr: r = (0 : R) then (0 : R[R⁰⁻¹])
+  else (s /ₒ ⟨r, λ _, eq_zero_of_ne_zero_of_mul_right_eq_zero hr⟩) := rfl
+
+protected lemma mul_inv_cancel (x : R[R⁰⁻¹]) (h : x ≠ 0) : x * x⁻¹ = 1 :=
+begin
+  induction x using ore_localization.ind with r s,
+  rw [ore_localization.inv_def, ore_localization.one_def],
+  by_cases hr : r = 0,
+  { exfalso, apply h, simp [hr] },
+  { simp [hr], apply ore_localization.div_eq_one' }
+end
+
+protected lemma inv_zero : (0 : R[R⁰⁻¹])⁻¹ = 0 :=
+by { rw [ore_localization.zero_def, ore_localization.inv_def], simp }
+
+instance : division_ring R[(R⁰)⁻¹] :=
+{ mul_inv_cancel := ore_localization.mul_inv_cancel,
+  inv_zero := ore_localization.inv_zero,
+  .. ore_localization.nontrivial,
+  .. ore_localization.has_inv,
+  .. ore_localization.ring }
+
+end division_ring
+
+end ore_localization
diff --git a/src/ring_theory/ore_localization/ore_set.lean b/src/ring_theory/ore_localization/ore_set.lean
new file mode 100644
index 0000000000000..5524547685e07
--- /dev/null
+++ b/src/ring_theory/ore_localization/ore_set.lean
@@ -0,0 +1,106 @@
+/-
+Copyright (c) 2022 Jakob von Raumer. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jakob von Raumer, Kevin Klinge
+-/
+import algebra.ring.regular
+import group_theory.submonoid.basic
+
+/-!
+
+# (Right) Ore sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This defines right Ore sets on arbitrary monoids.
+
+## References
+
+* https://ncatlab.org/nlab/show/Ore+set
+
+-/
+
+namespace ore_localization
+
+section monoid
+
+/-- A submonoid `S` of a monoid `R` is (right) Ore if common factors on the left can be turned
+into common factors on the right, and if each pair of `r : R` and `s : S` admits an Ore numerator
+`v : R` and an Ore denominator `u : S` such that `r * u = s * v`. -/
+class ore_set {R : Type*} [monoid R] (S : submonoid R) :=
+(ore_left_cancel : ∀ (r₁ r₂ : R) (s : S), ↑s * r₁ = s * r₂ → ∃ s' : S, r₁ * s' = r₂ * s')
+(ore_num : R → S → R)
+(ore_denom : R → S → S)
+(ore_eq : ∀ (r : R) (s : S), r * ore_denom r s = s * ore_num r s)
+
+variables {R : Type*} [monoid R] {S : submonoid R} [ore_set S]
+
+/-- Common factors on the left can be turned into common factors on the right, a weak form of
+cancellability. -/
+lemma ore_left_cancel (r₁ r₂ : R) (s : S) (h : ↑s * r₁ = s * r₂) : ∃ s' : S, r₁ * s' = r₂ * s' :=
+ore_set.ore_left_cancel r₁ r₂ s h
+
+/-- The Ore numerator of a fraction. -/
+def ore_num (r : R) (s : S) : R := ore_set.ore_num r s
+
+/-- The Ore denominator of a fraction. -/
+def ore_denom (r : R) (s : S) : S := ore_set.ore_denom r s
+
+/-- The Ore condition of a fraction, expressed in terms of `ore_num` and `ore_denom`. -/
+lemma ore_eq (r : R) (s : S) : r * (ore_denom r s) = s * (ore_num r s) := ore_set.ore_eq r s
+
+/-- The Ore condition bundled in a sigma type. This is useful in situations where we want to obtain
+both witnesses and the condition for a given fraction. -/
+def ore_condition (r : R) (s : S) : Σ' r' : R, Σ' s' : S, r * s' = s * r' :=
+⟨ore_num r s, ore_denom r s, ore_eq r s⟩
+
+/-- The trivial submonoid is an Ore set. -/
+instance ore_set_bot : ore_set (⊥ : submonoid R) :=
+{ ore_left_cancel := λ _ _ s h,
+    ⟨s, begin
+          rcases s with ⟨s, hs⟩,
+          rw submonoid.mem_bot at hs,
+          subst hs,
+          rw [set_like.coe_mk, one_mul, one_mul] at h,
+          subst h
+        end⟩,
+  ore_num := λ r _, r,
+  ore_denom := λ _ s, s,
+  ore_eq := λ _ s, by { rcases s with ⟨s, hs⟩, rw submonoid.mem_bot at hs, simp [hs] } }
+
+/-- Every submonoid of a commutative monoid is an Ore set. -/
+@[priority 100]
+instance ore_set_comm {R} [comm_monoid R] (S : submonoid R) : ore_set S :=
+{ ore_left_cancel := λ m n s h, ⟨s, by rw [mul_comm n s, mul_comm m s, h]⟩,
+  ore_num := λ r _, r,
+  ore_denom := λ _ s, s,
+  ore_eq := λ r s, by rw mul_comm }
+
+end monoid
+
+/-- Cancellability in monoids with zeros can act as a replacement for the `ore_left_cancel`
+condition of an ore set. -/
+def ore_set_of_cancel_monoid_with_zero
+  {R : Type*} [cancel_monoid_with_zero R] {S : submonoid R}
+  (ore_num : R → S → R) (ore_denom : R → S → S)
+  (ore_eq : ∀ (r : R) (s : S), r * (ore_denom r s) = s * (ore_num r s)) :
+  ore_set S :=
+{ ore_left_cancel := λ r₁ r₂ s h, ⟨s, mul_eq_mul_right_iff.mpr (mul_eq_mul_left_iff.mp h)⟩,
+  ore_num := ore_num,
+  ore_denom := ore_denom,
+  ore_eq := ore_eq }
+
+/-- In rings without zero divisors, the first (cancellability) condition is always fulfilled,
+it suffices to give a proof for the Ore condition itself. -/
+def ore_set_of_no_zero_divisors
+  {R : Type*} [ring R] [no_zero_divisors R] {S : submonoid R}
+  (ore_num : R → S → R) (ore_denom : R → S → S)
+  (ore_eq : ∀ (r : R) (s : S), r * (ore_denom r s) = s * (ore_num r s)) :
+  ore_set S :=
+begin
+  letI : cancel_monoid_with_zero R := no_zero_divisors.to_cancel_monoid_with_zero,
+  exact ore_set_of_cancel_monoid_with_zero ore_num ore_denom ore_eq
+end
+
+end ore_localization
diff --git a/src/ring_theory/perfection.lean b/src/ring_theory/perfection.lean
index c4f8b0bb7bb69..519d14d808be5 100644
--- a/src/ring_theory/perfection.lean
+++ b/src/ring_theory/perfection.lean
@@ -8,7 +8,7 @@ import algebra.char_p.pi
 import algebra.char_p.quotient
 import algebra.char_p.subring
 import algebra.ring.pi
-import analysis.special_functions.pow
+import analysis.special_functions.pow.nnreal
 import field_theory.perfect_closure
 import ring_theory.localization.fraction_ring
 import ring_theory.subring.basic
@@ -17,6 +17,9 @@ import ring_theory.valuation.integers
 /-!
 # Ring Perfection and Tilt
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the perfection of a ring of characteristic p, and the tilt of a field
 given a valuation to `ℝ≥0`.
 
@@ -201,7 +204,7 @@ end perfection
 
 /-- A perfection map to a ring of characteristic `p` is a map that is isomorphic
 to its perfection. -/
-@[nolint has_inhabited_instance] structure perfection_map (p : ℕ) [fact p.prime]
+@[nolint has_nonempty_instance] structure perfection_map (p : ℕ) [fact p.prime]
   {R : Type u₁} [comm_semiring R] [char_p R p]
   {P : Type u₂} [comm_semiring P] [char_p P p] [perfect_ring P p] (π : P →+* R) : Prop :=
 (injective : ∀ ⦃x y : P⦄, (∀ n, π (pth_root P p ^[n] x) = π (pth_root P p ^[n] y)) → x = y)
@@ -321,7 +324,7 @@ variables (p : ℕ)
 include hv
 
 /-- `O/(p)` for `O`, ring of integers of `K`. -/
-@[nolint unused_arguments has_inhabited_instance] def mod_p :=
+@[nolint unused_arguments has_nonempty_instance] def mod_p :=
 O ⧸ (ideal.span {p} : ideal O)
 
 variables [hp : fact p.prime] [hvp : fact (v p ≠ 1)]
@@ -431,7 +434,7 @@ end classical
 end mod_p
 
 /-- Perfection of `O/(p)` where `O` is the ring of integers of `K`. -/
-@[nolint has_inhabited_instance] def pre_tilt :=
+@[nolint has_nonempty_instance] def pre_tilt :=
 ring.perfection (mod_p K v O hv p) p
 
 include hp hvp
@@ -485,7 +488,9 @@ dif_neg $ λ ⟨n, hn⟩, hn rfl
 lemma val_aux_one : val_aux K v O hv p 1 = 1 :=
 (val_aux_eq $ show coeff (mod_p K v O hv p) p 0 1 ≠ 0, from one_ne_zero).trans $
 by { rw [pow_zero, pow_one, ring_hom.map_one, ← (ideal.quotient.mk _).map_one, mod_p.pre_val_mk,
-    ring_hom.map_one, v.map_one], exact @one_ne_zero (mod_p K v O hv p) _ _ }
+    ring_hom.map_one, v.map_one],
+  change (1 : mod_p K v O hv p) ≠ 0,
+  exact one_ne_zero }
 
 lemma val_aux_mul (f g : pre_tilt K v O hv p) :
   val_aux K v O hv p (f * g) = val_aux K v O hv p f * val_aux K v O hv p g :=
@@ -548,18 +553,20 @@ end
 end classical
 
 instance : is_domain (pre_tilt K v O hv p) :=
-{ exists_pair_ne := (char_p.nontrivial_of_char_ne_one hp.1.ne_one).1,
-  eq_zero_or_eq_zero_of_mul_eq_zero := λ f g hfg,
+begin
+  haveI : nontrivial (pre_tilt K v O hv p) := ⟨(char_p.nontrivial_of_char_ne_one hp.1.ne_one).1⟩,
+  haveI : no_zero_divisors (pre_tilt K v O hv p) := ⟨λ f g hfg,
     by { simp_rw ← map_eq_zero at hfg ⊢, contrapose! hfg, rw valuation.map_mul,
-      exact mul_ne_zero hfg.1 hfg.2 },
-  .. (infer_instance : comm_ring (pre_tilt K v O hv p)) }
+    exact mul_ne_zero hfg.1 hfg.2 }⟩,
+  exact no_zero_divisors.to_is_domain _
+end
 
 end pre_tilt
 
 /-- The tilt of a field, as defined in Perfectoid Spaces by Peter Scholze, as in
 [scholze2011perfectoid]. Given a field `K` with valuation `K → ℝ≥0` and ring of integers `O`,
 this is implemented as the fraction field of the perfection of `O/(p)`. -/
-@[nolint has_inhabited_instance] def tilt :=
+@[nolint has_nonempty_instance] def tilt :=
 fraction_ring (pre_tilt K v O hv p)
 
 namespace tilt
diff --git a/src/ring_theory/polynomial/basic.lean b/src/ring_theory/polynomial/basic.lean
index f9abb04851f25..f287919dda4e2 100644
--- a/src/ring_theory/polynomial/basic.lean
+++ b/src/ring_theory/polynomial/basic.lean
@@ -5,6 +5,7 @@ Authors: Kenny Lau
 -/
 
 import algebra.char_p.basic
+import algebra.geom_sum
 import data.mv_polynomial.comm_ring
 import data.mv_polynomial.equiv
 import ring_theory.polynomial.content
@@ -13,6 +14,9 @@ import ring_theory.unique_factorization_domain
 /-!
 # Ring-theoretic supplement of data.polynomial.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main results
 * `mv_polynomial.is_domain`:
   If a ring is an integral domain, then so is its polynomial ring over finitely many variables.
@@ -27,6 +31,7 @@ import ring_theory.unique_factorization_domain
 
 noncomputable theory
 open_locale classical big_operators polynomial
+open finset
 
 universes u v w
 variables {R : Type u} {S : Type*}
@@ -68,7 +73,7 @@ begin
     refine submodule.sum_mem _ (λ k hk, _),
     show monomial _ _ ∈ _,
     have := with_bot.coe_le_coe.1 (finset.sup_le_iff.1 hp k hk),
-    rw [monomial_eq_C_mul_X, C_mul'],
+    rw [← C_mul_X_pow_eq_monomial, C_mul'],
     refine submodule.smul_mem _ _ (submodule.subset_span $ finset.mem_coe.2 $
       finset.mem_image.2 ⟨_, finset.mem_range.2 (nat.lt_succ_of_le this), rfl⟩) },
   rw [submodule.span_le, finset.coe_image, set.image_subset_iff],
@@ -79,8 +84,8 @@ end
 
 theorem mem_degree_lt {n : ℕ} {f : R[X]} :
   f ∈ degree_lt R n ↔ degree f < n :=
-by { simp_rw [degree_lt, submodule.mem_infi, linear_map.mem_ker, degree,
-    finset.sup_lt_iff (with_bot.bot_lt_coe n), mem_support_iff, with_bot.some_eq_coe,
+by { simp_rw [degree_lt, submodule.mem_infi, linear_map.mem_ker, degree, finset.max_eq_sup_coe,
+    finset.sup_lt_iff (with_bot.bot_lt_coe n), mem_support_iff,
     with_bot.coe_lt_coe, lt_iff_not_le, ne, not_imp_not], refl }
 
 @[mono] theorem degree_lt_mono {m n : ℕ} (H : m ≤ n) :
@@ -96,7 +101,7 @@ begin
     refine submodule.sum_mem _ (λ k hk, _),
     show monomial _ _ ∈ _,
     have := with_bot.coe_lt_coe.1 ((finset.sup_lt_iff $ with_bot.bot_lt_coe n).1 hp k hk),
-    rw [monomial_eq_C_mul_X, C_mul'],
+    rw [← C_mul_X_pow_eq_monomial, C_mul'],
     refine submodule.smul_mem _ _ (submodule.subset_span $ finset.mem_coe.2 $
       finset.mem_image.2 ⟨_, finset.mem_range.2 this, rfl⟩) },
   rw [submodule.span_le, finset.coe_image, set.image_subset_iff],
@@ -126,10 +131,21 @@ def degree_lt_equiv (R) [semiring R] (n : ℕ) : degree_lt R n ≃ₗ[R] (fin n
     intro f, ext i,
     simp only [finset_sum_coeff, submodule.coe_mk],
     rw [finset.sum_eq_single i, coeff_monomial, if_pos rfl],
-    { rintro j - hji, rw [coeff_monomial, if_neg], rwa [← subtype.ext_iff] },
+    { rintro j - hji, rw [coeff_monomial, if_neg], rwa [← fin.ext_iff] },
     { intro h, exact (h (finset.mem_univ _)).elim }
   end }
 
+@[simp] theorem degree_lt_equiv_eq_zero_iff_eq_zero {n : ℕ} {p : R[X]} (hp : p ∈ degree_lt R n) :
+  degree_lt_equiv _ _ ⟨p, hp⟩ = 0 ↔ p = 0 :=
+by rw [linear_equiv.map_eq_zero_iff, submodule.mk_eq_zero]
+
+theorem eval_eq_sum_degree_lt_equiv {n : ℕ} {p : R[X]} (hp : p ∈ degree_lt R n) (x : R) :
+  p.eval x = ∑ i, degree_lt_equiv _ _ ⟨p, hp⟩ i * (x ^ (i : ℕ)) :=
+begin
+  simp_rw [eval_eq_sum],
+  exact (sum_fin _ (by simp_rw [zero_mul, forall_const]) (mem_degree_lt.mp hp)).symm
+end
+
 /-- The finset of nonzero coefficients of a polynomial. -/
 def frange (p : R[X]) : finset R :=
 finset.image (λ n, p.coeff n) p.support
@@ -158,7 +174,7 @@ begin
 end
 
 lemma geom_sum_X_comp_X_add_one_eq_sum (n : ℕ) :
-  (geom_sum (X : R[X]) n).comp (X + 1) =
+  (∑ i in range n, (X : R[X]) ^ i).comp (X + 1) =
   (finset.range n).sum (λ (i : ℕ), (n.choose (i + 1) : R[X]) * X ^ i) :=
 begin
   ext i,
@@ -175,11 +191,11 @@ begin
 end
 
 lemma monic.geom_sum {P : R[X]}
-  (hP : P.monic) (hdeg : 0 < P.nat_degree) {n : ℕ} (hn : n ≠ 0) : (geom_sum P n).monic :=
+  (hP : P.monic) (hdeg : 0 < P.nat_degree) {n : ℕ} (hn : n ≠ 0) : (∑ i in range n, P ^ i).monic :=
 begin
   nontriviality R,
   cases n, { exact (hn rfl).elim },
-  rw [geom_sum_succ', geom_sum_def],
+  rw [geom_sum_succ'],
   refine (hP.pow _).add_of_left _,
   refine lt_of_le_of_lt (degree_sum_le _ _) _,
   rw [finset.sup_lt_iff],
@@ -191,11 +207,11 @@ begin
 end
 
 lemma monic.geom_sum' {P : R[X]}
-  (hP : P.monic) (hdeg : 0 < P.degree) {n : ℕ} (hn : n ≠ 0) : (geom_sum P n).monic :=
+  (hP : P.monic) (hdeg : 0 < P.degree) {n : ℕ} (hn : n ≠ 0) : (∑ i in range n, P ^ i).monic :=
 hP.geom_sum (nat_degree_pos_iff_degree_pos.2 hdeg) hn
 
 lemma monic_geom_sum_X {n : ℕ} (hn : n ≠ 0) :
-  (geom_sum (X : R[X]) n).monic :=
+  (∑ i in range n, (X : R[X]) ^ i).monic :=
 begin
   nontriviality R,
   apply monic_X.geom_sum _ hn,
@@ -422,13 +438,13 @@ variables [comm_semiring R] [semiring S]
 
 /-- If every coefficient of a polynomial is in an ideal `I`, then so is the polynomial itself -/
 lemma polynomial_mem_ideal_of_coeff_mem_ideal (I : ideal R[X]) (p : R[X])
-  (hp : ∀ (n : ℕ), (p.coeff n) ∈ I.comap C) : p ∈ I :=
-sum_C_mul_X_eq p ▸ submodule.sum_mem I (λ n hn, I.mul_mem_right _ (hp n))
+  (hp : ∀ (n : ℕ), (p.coeff n) ∈ I.comap (C : R →+* R[X])) : p ∈ I :=
+sum_C_mul_X_pow_eq p ▸ submodule.sum_mem I (λ n hn, I.mul_mem_right _ (hp n))
 
-/-- The push-forward of an ideal `I` of `R` to `polynomial R` via inclusion
+/-- The push-forward of an ideal `I` of `R` to `R[X]` via inclusion
  is exactly the set of polynomials whose coefficients are in `I` -/
 theorem mem_map_C_iff {I : ideal R} {f : R[X]} :
-  f ∈ (ideal.map C I : ideal R[X]) ↔ ∀ n : ℕ, f.coeff n ∈ I :=
+  f ∈ (ideal.map (C : R →+* R[X]) I : ideal R[X]) ↔ ∀ n : ℕ, f.coeff n ∈ I :=
 begin
   split,
   { intros hf,
@@ -447,13 +463,13 @@ begin
   { intros hf,
     rw ← sum_monomial_eq f,
     refine (I.map C : ideal R[X]).sum_mem (λ n hn, _),
-    simp [monomial_eq_C_mul_X],
+    simp [← C_mul_X_pow_eq_monomial],
     rw mul_comm,
     exact (I.map C : ideal R[X]).mul_mem_left _ (mem_map_of_mem _ (hf n)) }
 end
 
 lemma _root_.polynomial.ker_map_ring_hom (f : R →+* S) :
-  (polynomial.map_ring_hom f).ker = f.ker.map C :=
+  (polynomial.map_ring_hom f).ker = f.ker.map (C : R →+* R[X]) :=
 begin
   ext,
   rw [mem_map_C_iff, ring_hom.mem_ker, polynomial.ext_iff],
@@ -518,12 +534,34 @@ begin
     I.leading_coeff_nth_mono (nat.le_add_left _ _)⟩
 end
 
+/--
+If `I` is an ideal, and `pᵢ` is a finite family of polynomials each satisfying
+`∀ k, (pᵢ)ₖ ∈ Iⁿⁱ⁻ᵏ` for some `nᵢ`, then `p = ∏ pᵢ` also satisfies `∀ k, pₖ ∈ Iⁿ⁻ᵏ` with `n = ∑ nᵢ`.
+-/
+lemma _root_.polynomial.coeff_prod_mem_ideal_pow_tsub {ι : Type*} (s : finset ι) (f : ι → R[X])
+  (I : ideal R) (n : ι → ℕ) (h : ∀ (i ∈ s) k, (f i).coeff k ∈ I ^ (n i - k)) (k : ℕ) :
+  (s.prod f).coeff k ∈ I ^ (s.sum n - k) :=
+begin
+  classical,
+  induction s using finset.induction with a s ha hs generalizing k,
+  { rw [sum_empty, prod_empty, coeff_one, zero_tsub, pow_zero, ideal.one_eq_top],
+    exact submodule.mem_top },
+  { rw [sum_insert ha, prod_insert ha, coeff_mul],
+    apply sum_mem,
+    rintro ⟨i, j⟩ e,
+    obtain rfl : i + j = k := nat.mem_antidiagonal.mp e,
+    apply ideal.pow_le_pow add_tsub_add_le_tsub_add_tsub,
+    rw pow_add,
+    exact ideal.mul_mem_mul (h _ (finset.mem_insert.mpr $ or.inl rfl) _)
+      (hs (λ i hi k, h _ (finset.mem_insert.mpr $ or.inr hi) _) j) }
+end
+
 end comm_semiring
 
 section ring
 variables [ring R]
 
-/-- `polynomial R` is never a field for any ring `R`. -/
+/-- `R[X]` is never a field for any ring `R`. -/
 lemma polynomial_not_is_field : ¬ is_field R[X] :=
 begin
   nontriviality R,
@@ -553,124 +591,56 @@ end ring
 section comm_ring
 variables [comm_ring R]
 
-lemma quotient_map_C_eq_zero {I : ideal R} :
-  ∀ a ∈ I, ((quotient.mk (map C I : ideal R[X])).comp C) a = 0 :=
-begin
-  intros a ha,
-  rw [ring_hom.comp_apply, quotient.eq_zero_iff_mem],
-  exact mem_map_of_mem _ ha,
-end
-
-lemma eval₂_C_mk_eq_zero {I : ideal R} :
-  ∀ f ∈ (map C I : ideal R[X]), eval₂_ring_hom (C.comp (quotient.mk I)) X f = 0 :=
-begin
-  intros a ha,
-  rw ← sum_monomial_eq a,
-  dsimp,
-  rw eval₂_sum,
-  refine finset.sum_eq_zero (λ n hn, _),
-  dsimp,
-  rw eval₂_monomial (C.comp (quotient.mk I)) X,
-  refine mul_eq_zero_of_left (polynomial.ext (λ m, _)) (X ^ n),
-  erw coeff_C,
-  by_cases h : m = 0,
-  { simpa [h] using quotient.eq_zero_iff_mem.2 ((mem_map_C_iff.1 ha) n) },
-  { simp [h] }
-end
-
-/-- If `I` is an ideal of `R`, then the ring polynomials over the quotient ring `I.quotient` is
-isomorphic to the quotient of `polynomial R` by the ideal `map C I`,
-where `map C I` contains exactly the polynomials whose coefficients all lie in `I` -/
-def polynomial_quotient_equiv_quotient_polynomial (I : ideal R) :
-  polynomial (R ⧸ I) ≃+* R[X] ⧸ (map C I : ideal R[X]) :=
-{ to_fun := eval₂_ring_hom
-    (quotient.lift I ((quotient.mk (map C I : ideal R[X])).comp C) quotient_map_C_eq_zero)
-    ((quotient.mk (map C I : ideal R[X]) X)),
-  inv_fun := quotient.lift (map C I : ideal R[X])
-    (eval₂_ring_hom (C.comp (quotient.mk I)) X) eval₂_C_mk_eq_zero,
-  map_mul' := λ f g, by simp only [coe_eval₂_ring_hom, eval₂_mul],
-  map_add' := λ f g, by simp only [eval₂_add, coe_eval₂_ring_hom],
-  left_inv := begin
-    intro f,
-    apply polynomial.induction_on' f,
-    { intros p q hp hq,
-      simp only [coe_eval₂_ring_hom] at hp,
-      simp only [coe_eval₂_ring_hom] at hq,
-      simp only [coe_eval₂_ring_hom, hp, hq, ring_hom.map_add] },
-    { rintros n ⟨x⟩,
-      simp only [monomial_eq_smul_X, C_mul', quotient.lift_mk, submodule.quotient.quot_mk_eq_mk,
-        quotient.mk_eq_mk, eval₂_X_pow, eval₂_smul, coe_eval₂_ring_hom, ring_hom.map_pow,
-        eval₂_C, ring_hom.coe_comp, ring_hom.map_mul, eval₂_X] }
-  end,
-  right_inv := begin
-    rintro ⟨f⟩,
-    apply polynomial.induction_on' f,
-    { simp_intros p q hp hq,
-      rw [hp, hq] },
-    { intros n a,
-      simp only [monomial_eq_smul_X, ← C_mul' a (X ^ n), quotient.lift_mk,
-        submodule.quotient.quot_mk_eq_mk, quotient.mk_eq_mk, eval₂_X_pow,
-        eval₂_smul, coe_eval₂_ring_hom, ring_hom.map_pow, eval₂_C, ring_hom.coe_comp,
-        ring_hom.map_mul, eval₂_X] },
-  end, }
-
-@[simp]
-lemma polynomial_quotient_equiv_quotient_polynomial_symm_mk (I : ideal R) (f : R[X]) :
-  I.polynomial_quotient_equiv_quotient_polynomial.symm (quotient.mk _ f) = f.map (quotient.mk I) :=
-by rw [polynomial_quotient_equiv_quotient_polynomial, ring_equiv.symm_mk, ring_equiv.coe_mk,
-  ideal.quotient.lift_mk, coe_eval₂_ring_hom, eval₂_eq_eval_map, ←polynomial.map_map,
-  ←eval₂_eq_eval_map, polynomial.eval₂_C_X]
-
-@[simp]
-lemma polynomial_quotient_equiv_quotient_polynomial_map_mk (I : ideal R) (f : R[X]) :
-  I.polynomial_quotient_equiv_quotient_polynomial (f.map I^.quotient.mk) = quotient.mk _ f :=
+/-- If `P` is a prime ideal of `R`, then `P.R[x]` is a prime ideal of `R[x]`. -/
+lemma is_prime_map_C_iff_is_prime (P : ideal R) :
+  is_prime (map (C : R →+* R[X]) P : ideal R[X]) ↔ is_prime P :=
 begin
-  apply (polynomial_quotient_equiv_quotient_polynomial I).symm.injective,
-  rw [ring_equiv.symm_apply_apply, polynomial_quotient_equiv_quotient_polynomial_symm_mk],
+  -- Porting note: the following proof avoids quotient rings
+  -- It can be golfed substantially by using something like
+  -- `(quotient.is_domain_iff_prime (map C P : ideal R[X]))`
+  split,
+  { intro H,
+    have := @comap_is_prime R R[X] (R →+* R[X]) _ _ _ C (map C P) H,
+    convert this using 1,
+    ext x,
+    simp only [mem_comap, mem_map_C_iff],
+    split,
+    { rintro h (-|n),
+      { simpa only [coeff_C_zero] using h },
+      { simp only [coeff_C_ne_zero (nat.succ_ne_zero _), submodule.zero_mem] } },
+    { intro h, simpa only [coeff_C_zero] using h 0 } },
+  { intro h,
+    constructor,
+    { rw [ne.def, eq_top_iff_one, mem_map_C_iff, not_forall],
+      use 0,
+      rw [coeff_one_zero, ← eq_top_iff_one], exact h.1 },
+    { intros f g, simp only [mem_map_C_iff], contrapose!,
+      rintro ⟨hf, hg⟩,
+      classical,
+      let m := nat.find hf,
+      let n := nat.find hg,
+      refine ⟨m + n, _⟩,
+      rw [coeff_mul, ← finset.insert_erase ((@finset.nat.mem_antidiagonal _ (m,n)).mpr rfl),
+        finset.sum_insert (finset.not_mem_erase _ _), (P.add_mem_iff_left _).not],
+      { apply mt h.2, rw [not_or_distrib], exact ⟨nat.find_spec hf, nat.find_spec hg⟩ },
+      apply P.sum_mem,
+      rintro ⟨i, j⟩ hij,
+      rw [finset.mem_erase, finset.nat.mem_antidiagonal] at hij,
+      simp only [ne.def, prod.mk.inj_iff, not_and_distrib] at hij,
+      obtain (hi|hj) : i < m ∨ j < n,
+      { rw [or_iff_not_imp_left, not_lt, le_iff_lt_or_eq],
+        rintro (hmi|rfl),
+        { rw [← not_le], intro hnj, exact (add_lt_add_of_lt_of_le hmi hnj).ne hij.2.symm, },
+        { simpa only [eq_self_iff_true, not_true, false_or, add_right_inj, not_and_self]
+            using hij, } },
+      { rw [mul_comm], apply P.mul_mem_left, exact not_not.1 (nat.find_min hf hi) },
+      { apply P.mul_mem_left, exact not_not.1 (nat.find_min hg hj) } } }
 end
 
-/-- If `P` is a prime ideal of `R`, then `R[x]/(P)` is an integral domain. -/
-lemma is_domain_map_C_quotient {P : ideal R} (H : is_prime P) :
-  is_domain (R[X] ⧸ (map C P : ideal R[X])) :=
-ring_equiv.is_domain (polynomial (R ⧸ P))
-  (polynomial_quotient_equiv_quotient_polynomial P).symm
-
 /-- If `P` is a prime ideal of `R`, then `P.R[x]` is a prime ideal of `R[x]`. -/
 lemma is_prime_map_C_of_is_prime {P : ideal R} (H : is_prime P) :
-  is_prime (map C P : ideal R[X]) :=
-(quotient.is_domain_iff_prime (map C P : ideal R[X])).mp
-  (is_domain_map_C_quotient H)
-
-/-- Given any ring `R` and an ideal `I` of `polynomial R`, we get a map `R → R[x] → R[x]/I`.
-  If we let `R` be the image of `R` in `R[x]/I` then we also have a map `R[x] → R'[x]`.
-  In particular we can map `I` across this map, to get `I'` and a new map `R' → R'[x] → R'[x]/I`.
-  This theorem shows `I'` will not contain any non-zero constant polynomials
-  -/
-lemma eq_zero_of_polynomial_mem_map_range (I : ideal R[X])
-  (x : ((quotient.mk I).comp C).range)
-  (hx : C x ∈ (I.map (polynomial.map_ring_hom ((quotient.mk I).comp C).range_restrict))) :
-  x = 0 :=
-begin
-  let i := ((quotient.mk I).comp C).range_restrict,
-  have hi' : (polynomial.map_ring_hom i).ker ≤ I,
-  { refine λ f hf, polynomial_mem_ideal_of_coeff_mem_ideal I f (λ n, _),
-    rw [mem_comap, ← quotient.eq_zero_iff_mem, ← ring_hom.comp_apply],
-    rw [ring_hom.mem_ker, coe_map_ring_hom] at hf,
-    replace hf := congr_arg (λ (f : polynomial _), f.coeff n) hf,
-    simp only [coeff_map, coeff_zero] at hf,
-    rwa [subtype.ext_iff, ring_hom.coe_range_restrict] at hf },
-  obtain ⟨x, hx'⟩ := x,
-  obtain ⟨y, rfl⟩ := (ring_hom.mem_range).1 hx',
-  refine subtype.eq _,
-  simp only [ring_hom.comp_apply, quotient.eq_zero_iff_mem, add_submonoid_class.coe_zero,
-    subtype.val_eq_coe],
-  suffices : C (i y) ∈ (I.map (polynomial.map_ring_hom i)),
-  { obtain ⟨f, hf⟩ := mem_image_of_mem_map_of_surjective (polynomial.map_ring_hom i)
-      (polynomial.map_surjective _ (((quotient.mk I).comp C).range_restrict_surjective)) this,
-    refine sub_add_cancel (C y) f ▸ I.add_mem (hi' _ : (C y - f) ∈ I) hf.1,
-    rw [ring_hom.mem_ker, ring_hom.map_sub, hf.2, sub_eq_zero, coe_map_ring_hom, map_C] },
-  exact hx,
-end
+  is_prime (map (C : R →+* R[X]) P : ideal R[X]) :=
+(is_prime_map_C_iff_is_prime P).mpr H
 
 theorem is_fg_degree_le [is_noetherian_ring R] (I : ideal R[X]) (n : ℕ) :
   submodule.fg (I.degree_le n) :=
@@ -711,9 +681,9 @@ begin
 end
 
 lemma prime_C_iff : prime (C r : mv_polynomial σ R) ↔ prime r :=
-⟨ comap_prime C constant_coeff constant_coeff_C,
+⟨ comap_prime C constant_coeff (constant_coeff_C _),
   λ hr, ⟨ λ h, hr.1 $ by { rw [← C_inj, h], simp },
-    λ h, hr.2.1 $ by { rw ← constant_coeff_C r, exact h.map _ },
+    λ h, hr.2.1 $ by { rw ← constant_coeff_C _ r, exact h.map _ },
     λ a b hd, begin
       obtain ⟨s,a',b',rfl,rfl⟩ := exists_finset_rename₂ a b,
       rw ← algebra_map_eq at hd, have : algebra_map R _ r ∣ a' * b',
@@ -873,6 +843,7 @@ lemma disjoint_ker_aeval_of_coprime
   (f : M →ₗ[R] M) {p q : R[X]} (hpq : is_coprime p q) :
   disjoint (aeval f p).ker (aeval f q).ker :=
 begin
+  rw disjoint_iff_inf_le,
   intros v hv,
   rcases hpq with ⟨p', q', hpq'⟩,
   simpa [linear_map.mem_ker.1 (submodule.mem_inf.1 hv).1,
@@ -930,7 +901,7 @@ begin
   refine ⟨aeval f (q * q') v, linear_map.mem_ker.1 h_eval₂_pqq',
           aeval f (p * p') v, linear_map.mem_ker.1 h_eval₂_qpp', _⟩,
   rw [add_comm, mul_comm p p', mul_comm q q'],
-  simpa using congr_arg (λ p : R[X], aeval f p v) hpq'
+  simpa only [map_add, map_mul, aeval_one] using congr_arg (λ p : R[X], aeval f p v) hpq'
 end
 
 end polynomial
@@ -953,78 +924,67 @@ theorem is_noetherian_ring_fin [is_noetherian_ring R] :
 
 /-- The multivariate polynomial ring in finitely many variables over a noetherian ring
 is itself a noetherian ring. -/
-instance is_noetherian_ring [fintype σ] [is_noetherian_ring R] :
+instance is_noetherian_ring [finite σ] [is_noetherian_ring R] :
   is_noetherian_ring (mv_polynomial σ R) :=
+by casesI nonempty_fintype σ; exact
 @is_noetherian_ring_of_ring_equiv (mv_polynomial (fin (fintype.card σ)) R) _ _ _
   (rename_equiv R (fintype.equiv_fin σ).symm).to_ring_equiv is_noetherian_ring_fin
 
-lemma is_domain_fin_zero (R : Type u) [comm_ring R] [is_domain R] :
-  is_domain (mv_polynomial (fin 0) R) :=
-ring_equiv.is_domain R
-  ((rename_equiv R fin_zero_equiv').to_ring_equiv.trans
-    (mv_polynomial.is_empty_ring_equiv R pempty))
-
 /-- Auxiliary lemma:
 Multivariate polynomials over an integral domain
 with variables indexed by `fin n` form an integral domain.
 This fact is proven inductively,
 and then used to prove the general case without any finiteness hypotheses.
-See `mv_polynomial.is_domain` for the general case. -/
-lemma is_domain_fin (R : Type u) [comm_ring R] [is_domain R] :
-  ∀ (n : ℕ), is_domain (mv_polynomial (fin n) R)
-| 0 := is_domain_fin_zero R
-| (n+1) :=
-  begin
-    haveI := is_domain_fin n,
-    exact ring_equiv.is_domain
-      (polynomial (mv_polynomial (fin n) R))
-      (mv_polynomial.fin_succ_equiv _ n).to_ring_equiv
+See `mv_polynomial.no_zero_divisors` for the general case. -/
+lemma no_zero_divisors_fin (R : Type u) [comm_semiring R] [no_zero_divisors R] :
+  ∀ (n : ℕ), no_zero_divisors (mv_polynomial (fin n) R)
+| 0 := (mv_polynomial.is_empty_alg_equiv R _).injective.no_zero_divisors _ (map_zero _) (map_mul _)
+| (n+1) := begin
+    haveI := no_zero_divisors_fin n,
+    exact (mv_polynomial.fin_succ_equiv R n).injective.no_zero_divisors _ (map_zero _) (map_mul _)
   end
 
 /-- Auxiliary definition:
 Multivariate polynomials in finitely many variables over an integral domain form an integral domain.
-This fact is proven by transport of structure from the `mv_polynomial.is_domain_fin`,
+This fact is proven by transport of structure from the `mv_polynomial.no_zero_divisors_fin`,
 and then used to prove the general case without finiteness hypotheses.
-See `mv_polynomial.is_domain` for the general case. -/
-lemma is_domain_fintype (R : Type u) (σ : Type v) [comm_ring R] [fintype σ]
-  [is_domain R] : is_domain (mv_polynomial σ R) :=
-@ring_equiv.is_domain _ (mv_polynomial (fin $ fintype.card σ) R) _ _
-  (mv_polynomial.is_domain_fin _ _)
-  (rename_equiv R (fintype.equiv_fin σ)).to_ring_equiv
-
-protected theorem eq_zero_or_eq_zero_of_mul_eq_zero
-  {R : Type u} [comm_ring R] [is_domain R] {σ : Type v}
-  (p q : mv_polynomial σ R) (h : p * q = 0) : p = 0 ∨ q = 0 :=
+See `mv_polynomial.no_zero_divisors` for the general case. -/
+lemma no_zero_divisors_of_finite (R : Type u) (σ : Type v) [comm_semiring R] [finite σ]
+  [no_zero_divisors R] : no_zero_divisors (mv_polynomial σ R) :=
 begin
+  casesI nonempty_fintype σ,
+  haveI := no_zero_divisors_fin R (fintype.card σ),
+  exact (rename_equiv R (fintype.equiv_fin σ)).injective.no_zero_divisors _ (map_zero _) (map_mul _)
+end
+
+instance {R : Type u} [comm_semiring R] [no_zero_divisors R] {σ : Type v} :
+  no_zero_divisors (mv_polynomial σ R) :=
+⟨λ p q h, begin
   obtain ⟨s, p, rfl⟩ := exists_finset_rename p,
   obtain ⟨t, q, rfl⟩ := exists_finset_rename q,
   have :
     rename (subtype.map id (finset.subset_union_left s t) : {x // x ∈ s} → {x // x ∈ s ∪ t}) p *
     rename (subtype.map id (finset.subset_union_right s t) : {x // x ∈ t} → {x // x ∈ s ∪ t}) q = 0,
   { apply rename_injective _ subtype.val_injective, simpa using h },
-  letI := mv_polynomial.is_domain_fintype R {x // x ∈ (s ∪ t)},
+  letI := mv_polynomial.no_zero_divisors_of_finite R {x // x ∈ (s ∪ t)},
   rw mul_eq_zero at this,
   cases this; [left, right],
   all_goals { simpa using congr_arg (rename subtype.val) this }
-end
+end⟩
 
 /-- The multivariate polynomial ring over an integral domain is an integral domain. -/
-instance {R : Type u} {σ : Type v} [comm_ring R] [is_domain R] :
-  is_domain (mv_polynomial σ R) :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := mv_polynomial.eq_zero_or_eq_zero_of_mul_eq_zero,
-  exists_pair_ne := ⟨0, 1, λ H,
-  begin
-    have : eval₂ (ring_hom.id _) (λ s, (0:R)) (0 : mv_polynomial σ R) =
-      eval₂ (ring_hom.id _) (λ s, (0:R)) (1 : mv_polynomial σ R),
-    { congr, exact H },
-    simpa,
-  end⟩,
-  .. (by apply_instance : comm_ring (mv_polynomial σ R)) }
-
-lemma map_mv_polynomial_eq_eval₂ {S : Type*} [comm_ring S] [fintype σ]
+instance {R : Type u} {σ : Type v} [comm_ring R] [is_domain R] : is_domain (mv_polynomial σ R) :=
+begin
+  apply no_zero_divisors.to_is_domain _,
+  exact add_monoid_algebra.nontrivial,
+  exact mv_polynomial.no_zero_divisors
+end
+
+lemma map_mv_polynomial_eq_eval₂ {S : Type*} [comm_ring S] [finite σ]
   (ϕ : mv_polynomial σ R →+* S) (p : mv_polynomial σ R) :
   ϕ p = mv_polynomial.eval₂ (ϕ.comp mv_polynomial.C) (λ s, ϕ (mv_polynomial.X s)) p :=
 begin
+  casesI nonempty_fintype σ,
   refine trans (congr_arg ϕ (mv_polynomial.as_sum p)) _,
   rw [mv_polynomial.eval₂_eq', ϕ.map_sum],
   congr,
@@ -1032,17 +992,10 @@ begin
   simp only [monomial_eq, ϕ.map_pow, ϕ.map_prod, ϕ.comp_apply, ϕ.map_mul, finsupp.prod_pow],
 end
 
-lemma quotient_map_C_eq_zero {I : ideal R} {i : R} (hi : i ∈ I) :
-  (ideal.quotient.mk (ideal.map C I : ideal (mv_polynomial σ R))).comp C i = 0 :=
-begin
-  simp only [function.comp_app, ring_hom.coe_comp, ideal.quotient.eq_zero_iff_mem],
-  exact ideal.mem_map_of_mem _ hi
-end
-
 /-- If every coefficient of a polynomial is in an ideal `I`, then so is the polynomial itself,
 multivariate version. -/
 lemma mem_ideal_of_coeff_mem_ideal (I : ideal (mv_polynomial σ R)) (p : mv_polynomial σ R)
-  (hcoe : ∀ (m : σ →₀ ℕ), p.coeff m ∈ I.comap C) : p ∈ I :=
+  (hcoe : ∀ (m : σ →₀ ℕ), p.coeff m ∈ I.comap (C : R →+* mv_polynomial σ R)) : p ∈ I :=
 begin
   rw as_sum p,
   suffices : ∀ m ∈ p.support, monomial m (mv_polynomial.coeff m p) ∈ I,
@@ -1057,7 +1010,8 @@ end
 /-- The push-forward of an ideal `I` of `R` to `mv_polynomial σ R` via inclusion
  is exactly the set of polynomials whose coefficients are in `I` -/
 theorem mem_map_C_iff {I : ideal R} {f : mv_polynomial σ R} :
-  f ∈ (ideal.map C I : ideal (mv_polynomial σ R)) ↔ ∀ (m : σ →₀ ℕ), f.coeff m ∈ I :=
+  f ∈ (ideal.map (C : R →+* mv_polynomial σ R) I :
+  ideal (mv_polynomial σ R)) ↔ ∀ (m : σ →₀ ℕ), f.coeff m ∈ I :=
 begin
   split,
   { intros hf,
@@ -1086,70 +1040,14 @@ begin
     exact hf m }
 end
 
-lemma ker_map (f : R →+* S) : (map f : mv_polynomial σ R →+* mv_polynomial σ S).ker = f.ker.map C :=
+lemma ker_map (f : R →+* S) :
+  (map f : mv_polynomial σ R →+* mv_polynomial σ S).ker = f.ker.map (C : R →+* mv_polynomial σ R) :=
 begin
   ext,
   rw [mv_polynomial.mem_map_C_iff, ring_hom.mem_ker, mv_polynomial.ext_iff],
   simp_rw [coeff_map, coeff_zero, ring_hom.mem_ker],
 end
 
-lemma eval₂_C_mk_eq_zero {I : ideal R} {a : mv_polynomial σ R}
-  (ha : a ∈ (ideal.map C I : ideal (mv_polynomial σ R))) :
-  eval₂_hom (C.comp (ideal.quotient.mk I)) X a = 0 :=
-begin
-  rw as_sum a,
-  rw [coe_eval₂_hom, eval₂_sum],
-  refine finset.sum_eq_zero (λ n hn, _),
-  simp only [eval₂_monomial, function.comp_app, ring_hom.coe_comp],
-  refine mul_eq_zero_of_left _ _,
-  suffices : coeff n a ∈ I,
-  { rw [← @ideal.mk_ker R _ I, ring_hom.mem_ker] at this,
-    simp only [this, C_0] },
-  exact mem_map_C_iff.1 ha n
-end
-
-/-- If `I` is an ideal of `R`, then the ring `mv_polynomial σ I.quotient` is isomorphic as an
-`R`-algebra to the quotient of `mv_polynomial σ R` by the ideal generated by `I`. -/
-def quotient_equiv_quotient_mv_polynomial (I : ideal R) :
-  mv_polynomial σ (R ⧸ I) ≃ₐ[R]
-    mv_polynomial σ R ⧸ (ideal.map C I : ideal (mv_polynomial σ R)) :=
-{ to_fun := eval₂_hom (ideal.quotient.lift I ((ideal.quotient.mk (ideal.map C I : ideal
-    (mv_polynomial σ R))).comp C) (λ i hi, quotient_map_C_eq_zero hi))
-    (λ i, ideal.quotient.mk (ideal.map C I : ideal (mv_polynomial σ R)) (X i)),
-  inv_fun := ideal.quotient.lift (ideal.map C I : ideal (mv_polynomial σ R))
-    (eval₂_hom (C.comp (ideal.quotient.mk I)) X) (λ a ha, eval₂_C_mk_eq_zero ha),
-  map_mul' := ring_hom.map_mul _,
-  map_add' := ring_hom.map_add _,
-  left_inv := begin
-    intro f,
-    apply induction_on f,
-    { rintro ⟨r⟩,
-      rw [coe_eval₂_hom, eval₂_C],
-      simp only [eval₂_hom_eq_bind₂, submodule.quotient.quot_mk_eq_mk, ideal.quotient.lift_mk,
-        ideal.quotient.mk_eq_mk, bind₂_C_right, ring_hom.coe_comp] },
-    { simp_intros p q hp hq only [ring_hom.map_add, mv_polynomial.coe_eval₂_hom, coe_eval₂_hom,
-        mv_polynomial.eval₂_add, mv_polynomial.eval₂_hom_eq_bind₂, eval₂_hom_eq_bind₂],
-      rw [hp, hq] },
-    { simp_intros p i hp only [eval₂_hom_eq_bind₂, coe_eval₂_hom],
-      simp only [hp, eval₂_hom_eq_bind₂, coe_eval₂_hom, ideal.quotient.lift_mk, bind₂_X_right,
-        eval₂_mul, ring_hom.map_mul, eval₂_X] }
-  end,
-  right_inv := begin
-    rintro ⟨f⟩,
-    apply induction_on f,
-    { intros r,
-      simp only [submodule.quotient.quot_mk_eq_mk, ideal.quotient.lift_mk, ideal.quotient.mk_eq_mk,
-        ring_hom.coe_comp, eval₂_hom_C] },
-    { simp_intros p q hp hq only [eval₂_hom_eq_bind₂, submodule.quotient.quot_mk_eq_mk, eval₂_add,
-        ring_hom.map_add, coe_eval₂_hom, ideal.quotient.lift_mk, ideal.quotient.mk_eq_mk],
-      rw [hp, hq] },
-    { simp_intros p i hp only [eval₂_hom_eq_bind₂, submodule.quotient.quot_mk_eq_mk, coe_eval₂_hom,
-        ideal.quotient.lift_mk, ideal.quotient.mk_eq_mk, bind₂_X_right, eval₂_mul, ring_hom.map_mul,
-        eval₂_X],
-      simp only [hp] }
-  end,
-  commutes' := λ r, eval₂_hom_C _ _ (ideal.quotient.mk I r) }
-
 end mv_polynomial
 
 section unique_factorization_domain
@@ -1159,7 +1057,7 @@ open unique_factorization_monoid
 namespace polynomial
 
 @[priority 100]
-instance unique_factorization_monoid : unique_factorization_monoid (polynomial D) :=
+instance unique_factorization_monoid : unique_factorization_monoid D[X] :=
 begin
   haveI := arbitrary (normalization_monoid D),
   haveI := to_normalized_gcd_monoid D,
diff --git a/src/ring_theory/polynomial/bernstein.lean b/src/ring_theory/polynomial/bernstein.lean
index 8d4f2331c648f..bbf4b6078196e 100644
--- a/src/ring_theory/polynomial/bernstein.lean
+++ b/src/ring_theory/polynomial/bernstein.lean
@@ -13,6 +13,9 @@ import data.mv_polynomial.pderiv
 /-!
 # Bernstein polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The definition of the Bernstein polynomials
 ```
 bernstein_polynomial (R : Type*) [comm_ring R] (n ν : ℕ) : R[X] :=
@@ -33,7 +36,6 @@ of a continuous function `f : C([0,1], ℝ)`, and shows that these converge unif
 
 noncomputable theory
 
-
 open nat (choose)
 open polynomial (X)
 open_locale big_operators polynomial
@@ -69,21 +71,15 @@ end
 
 lemma flip (n ν : ℕ) (h : ν ≤ n) :
   (bernstein_polynomial R n ν).comp (1-X) = bernstein_polynomial R n (n-ν) :=
-begin
-  dsimp [bernstein_polynomial],
-  simp [h, tsub_tsub_assoc, mul_right_comm],
-end
+by simp [bernstein_polynomial, h, tsub_tsub_assoc, mul_right_comm]
 
 lemma flip' (n ν : ℕ) (h : ν ≤ n) :
   bernstein_polynomial R n ν = (bernstein_polynomial R n (n-ν)).comp (1-X) :=
-begin
-  rw [←flip _ _ _ h, polynomial.comp_assoc],
-  simp,
-end
+by simp [←flip _ _ _ h, polynomial.comp_assoc]
 
 lemma eval_at_0 (n ν : ℕ) : (bernstein_polynomial R n ν).eval 0 = if ν = 0 then 1 else 0 :=
 begin
-  dsimp [bernstein_polynomial],
+  rw [bernstein_polynomial],
   split_ifs,
   { subst h, simp, },
   { simp [zero_pow (nat.pos_of_ne_zero h)], },
@@ -91,7 +87,7 @@ end
 
 lemma eval_at_1 (n ν : ℕ) : (bernstein_polynomial R n ν).eval 1 = if ν = n then 1 else 0 :=
 begin
-  dsimp [bernstein_polynomial],
+  rw [bernstein_polynomial],
   split_ifs,
   { subst h, simp, },
   { obtain w | w := (n - ν).eq_zero_or_pos,
@@ -103,13 +99,17 @@ lemma derivative_succ_aux (n ν : ℕ) :
   (bernstein_polynomial R (n+1) (ν+1)).derivative =
     (n+1) * (bernstein_polynomial R n ν - bernstein_polynomial R n (ν + 1)) :=
 begin
-  dsimp [bernstein_polynomial],
+  rw [bernstein_polynomial],
   suffices :
-    ↑((n + 1).choose (ν + 1)) * ((↑ν + 1) * X ^ ν) * (1 - X) ^ (n - ν)
+    ↑((n + 1).choose (ν + 1)) * (↑(ν + 1) * X ^ ν) * (1 - X) ^ (n - ν)
       -(↑((n + 1).choose (ν + 1)) * X ^ (ν + 1) * (↑(n - ν) * (1 - X) ^ (n - ν - 1))) =
-    (↑n + 1) * (↑(n.choose ν) * X ^ ν * (1 - X) ^ (n - ν) -
+    ↑(n + 1) * (↑(n.choose ν) * X ^ ν * (1 - X) ^ (n - ν) -
          ↑(n.choose (ν + 1)) * X ^ (ν + 1) * (1 - X) ^ (n - (ν + 1))),
-  { simpa [polynomial.derivative_pow, ←sub_eq_add_neg], },
+  { simpa only [polynomial.derivative_pow, ←sub_eq_add_neg, nat.succ_sub_succ_eq_sub,
+      polynomial.derivative_mul, polynomial.derivative_nat_cast, zero_mul, nat.cast_add,
+      algebra_map.coe_one, polynomial.derivative_X, mul_one, zero_add,
+      polynomial.derivative_sub, polynomial.derivative_one, zero_sub, mul_neg,
+      nat.sub_zero, ← nat.cast_succ, polynomial.C_eq_nat_cast], },
   conv_rhs { rw mul_sub, },
   -- We'll prove the two terms match up separately.
   refine congr (congr_arg has_sub.sub _) _,
@@ -118,7 +118,7 @@ begin
     -- Now it's just about binomial coefficients
     exact_mod_cast congr_arg (λ m : ℕ, (m : R[X])) (nat.succ_mul_choose_eq n ν).symm, },
   { rw [← tsub_add_eq_tsub_tsub, ← mul_assoc, ← mul_assoc], congr' 1,
-    rw mul_comm , rw [←mul_assoc,←mul_assoc],  congr' 1,
+    rw [mul_comm, ←mul_assoc, ←mul_assoc], congr' 1,
     norm_cast,
     congr' 1,
     convert (nat.choose_mul_succ_eq n (ν + 1)).symm using 1,
@@ -133,15 +133,12 @@ lemma derivative_succ (n ν : ℕ) :
 begin
   cases n,
   { simp [bernstein_polynomial], },
-  { apply derivative_succ_aux, }
+  { rw nat.cast_succ, apply derivative_succ_aux, }
 end
 
 lemma derivative_zero (n : ℕ) :
   (bernstein_polynomial R n 0).derivative = -n * bernstein_polynomial R (n-1) 0 :=
-begin
-  dsimp [bernstein_polynomial],
-  simp [polynomial.derivative_pow],
-end
+by simp [bernstein_polynomial, polynomial.derivative_pow]
 
 lemma iterate_derivative_at_0_eq_zero_of_lt (n : ℕ) {ν k : ℕ} :
   k < ν → (polynomial.derivative^[k] (bernstein_polynomial R n ν)).eval 0 = 0 :=
@@ -151,9 +148,9 @@ begin
   { rw nat.lt_succ_iff,
     induction k with k ih generalizing n ν,
     { simp [eval_at_0], },
-    { simp only [derivative_succ, int.coe_nat_eq_zero, int.nat_cast_eq_coe_nat, mul_eq_zero,
+    { simp only [derivative_succ, int.coe_nat_eq_zero, mul_eq_zero,
         function.comp_app, function.iterate_succ,
-        polynomial.iterate_derivative_sub, polynomial.iterate_derivative_cast_nat_mul,
+        polynomial.iterate_derivative_sub, polynomial.iterate_derivative_nat_cast_mul,
         polynomial.eval_mul, polynomial.eval_nat_cast, polynomial.eval_sub],
       intro h,
       apply mul_eq_zero_of_right,
@@ -180,7 +177,7 @@ begin
     { have h' : ν ≤ n-1 := le_tsub_of_add_le_right h,
       simp only [derivative_succ, ih (n-1) h', iterate_derivative_succ_at_0_eq_zero,
         nat.succ_sub_succ_eq_sub, tsub_zero, sub_zero,
-        iterate_derivative_sub, iterate_derivative_cast_nat_mul,
+        iterate_derivative_sub, iterate_derivative_nat_cast_mul,
         eval_one, eval_mul, eval_add, eval_sub, eval_X, eval_comp, eval_nat_cast,
         function.comp_app, function.iterate_succ, pochhammer_succ_left],
       obtain rfl | h'' := ν.eq_zero_or_pos,
@@ -303,6 +300,7 @@ open mv_polynomial
 lemma sum_smul (n : ℕ) :
   ∑ ν in finset.range (n + 1), ν • bernstein_polynomial R n ν = n • X :=
 begin
+
   -- We calculate the `x`-derivative of `(x+y)^n`, evaluated at `y=(1-x)`,
   -- either directly or by using the binomial theorem.
 
@@ -310,43 +308,41 @@ begin
   let x : mv_polynomial bool R := mv_polynomial.X tt,
   let y : mv_polynomial bool R := mv_polynomial.X ff,
 
-  have pderiv_tt_x : pderiv tt x = 1, { simp [x], },
-  have pderiv_tt_y : pderiv tt y = 0, { simp [pderiv_X, y], },
+  have pderiv_tt_x : pderiv tt x = 1, { rw [pderiv_X], refl, },
+  have pderiv_tt_y : pderiv tt y = 0, { rw [pderiv_X], refl, },
 
   let e : bool → R[X] := λ i, cond i X (1-X),
 
   -- Start with `(x+y)^n = (x+y)^n`,
   -- take the `x`-derivative, evaluate at `x=X, y=1-X`, and multiply by `X`:
-  have h : (x+y)^n = (x+y)^n := rfl,
-  apply_fun (pderiv tt) at h,
-  apply_fun (aeval e) at h,
-  apply_fun (λ p, p * X) at h,
+  transitivity aeval e (pderiv tt ((x + y) ^ n)) * X,
 
   -- On the left hand side we'll use the binomial theorem, then simplify.
 
-  -- We first prepare a tedious rewrite:
-  have w : ∀ k : ℕ,
-    ↑k * polynomial.X ^ (k - 1) * (1 - polynomial.X) ^ (n - k) * ↑(n.choose k) * polynomial.X =
-      k • bernstein_polynomial R n k,
-  { rintro (_|k),
-    { simp, },
-    { dsimp [bernstein_polynomial],
-      simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
-      push_cast,
-      ring, }, },
+  { -- We first prepare a tedious rewrite:
+    have w : ∀ k : ℕ,
+      k • bernstein_polynomial R n k =
+        ↑k * polynomial.X ^ (k - 1) * (1 - polynomial.X) ^ (n - k) * ↑(n.choose k) * polynomial.X,
+    { rintro (_|k),
+      { simp, },
+      { rw [bernstein_polynomial],
+        simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
+        push_cast,
+        ring, }, },
 
-  conv at h
-  { to_lhs,
     rw [add_pow, (pderiv tt).map_sum, (mv_polynomial.aeval e).map_sum, finset.sum_mul],
     -- Step inside the sum:
-    apply_congr, skip,
-    simp [pderiv_mul, pderiv_tt_x, pderiv_tt_y, e, w], },
-  -- On the right hand side, we'll just simplify.
-  conv at h
-  { to_rhs,
-    rw [(pderiv tt).leibniz_pow, (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y],
-    simp [e] },
-  simpa using h,
+    refine finset.sum_congr rfl (λ k hk, (w k).trans _),
+    simp only [pderiv_tt_x, pderiv_tt_y, algebra.id.smul_eq_mul, nsmul_eq_mul,
+      e, bool.cond_tt, bool.cond_ff, add_zero, mul_one, mul_zero, smul_zero,
+      mv_polynomial.aeval_X, mv_polynomial.pderiv_mul,
+      derivation.leibniz_pow, derivation.map_coe_nat,
+      map_nat_cast, map_pow, map_mul], },
+
+  { rw [(pderiv tt).leibniz_pow, (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y],
+    simp only [algebra.id.smul_eq_mul, nsmul_eq_mul,
+      map_nat_cast, map_pow, map_add, map_mul, e, bool.cond_tt, bool.cond_ff,
+      mv_polynomial.aeval_X, add_sub_cancel'_right, one_pow, add_zero, mul_one] },
 end
 
 lemma sum_mul_smul (n : ℕ) :
@@ -359,49 +355,44 @@ begin
   let x : mv_polynomial bool R := mv_polynomial.X tt,
   let y : mv_polynomial bool R := mv_polynomial.X ff,
 
-  have pderiv_tt_x : pderiv tt x = 1, { simp [x], },
-  have pderiv_tt_y : pderiv tt y = 0, { simp [pderiv_X, y], },
+  have pderiv_tt_x : pderiv tt x = 1, { rw [pderiv_X], refl, },
+  have pderiv_tt_y : pderiv tt y = 0, { rw [pderiv_X], refl, },
 
   let e : bool → R[X] := λ i, cond i X (1-X),
 
   -- Start with `(x+y)^n = (x+y)^n`,
   -- take the second `x`-derivative, evaluate at `x=X, y=1-X`, and multiply by `X`:
-  have h : (x+y)^n = (x+y)^n := rfl,
-  apply_fun (pderiv tt) at h,
-  apply_fun (pderiv tt) at h,
-  apply_fun (aeval e) at h,
-  apply_fun (λ p, p * X^2) at h,
+  transitivity aeval e (pderiv tt (pderiv tt ((x + y) ^ n))) * X ^ 2,
 
   -- On the left hand side we'll use the binomial theorem, then simplify.
-
-  -- We first prepare a tedious rewrite:
-  have w : ∀ k : ℕ,
-    ↑k * (↑(k-1) * polynomial.X ^ (k - 1 - 1)) *
-      (1 - polynomial.X) ^ (n - k) * ↑(n.choose k) * polynomial.X^2 =
-      (k * (k-1)) • bernstein_polynomial R n k,
-  { rintro (_|k),
-    { simp, },
-    { rcases k with (_|k),
+  { -- We first prepare a tedious rewrite:
+    have w : ∀ k : ℕ,
+      (k * (k-1)) • bernstein_polynomial R n k =
+        ↑(n.choose k) * ((1 - polynomial.X) ^ (n - k) *
+          (↑k * (↑(k-1) * polynomial.X ^ (k - 1 - 1)))) * polynomial.X^2,
+    { rintro (_|_|k),
       { simp, },
-      { dsimp [bernstein_polynomial],
+      { simp, },
+      { rw [bernstein_polynomial],
         simp only [←nat_cast_mul, nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, pow_succ],
         push_cast,
-        ring, }, }, },
+        ring, }, },
 
-  conv at h
-  { to_lhs,
     rw [add_pow, (pderiv tt).map_sum, (pderiv tt).map_sum, (mv_polynomial.aeval e).map_sum,
       finset.sum_mul],
     -- Step inside the sum:
-    apply_congr, skip,
-    simp [pderiv_mul, pderiv_tt_x, pderiv_tt_y, e, w] },
+    refine finset.sum_congr rfl (λ k hk, (w k).trans _),
+    simp only [pderiv_tt_x, pderiv_tt_y, algebra.id.smul_eq_mul, nsmul_eq_mul,
+      e, bool.cond_tt, bool.cond_ff, add_zero, zero_add, mul_zero, smul_zero, mul_one,
+      mv_polynomial.aeval_X, mv_polynomial.pderiv_X_self, mv_polynomial.pderiv_X_of_ne,
+      derivation.leibniz_pow, derivation.leibniz, derivation.map_coe_nat,
+      map_nat_cast, map_pow, map_mul, map_add], },
+
   -- On the right hand side, we'll just simplify.
-  conv at h
-  { to_rhs,
-    simp only [pderiv_one, pderiv_mul, (pderiv _).leibniz_pow, (pderiv _).map_coe_nat,
-      (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y],
-    simp [e, smul_smul] },
-  simpa using h,
+  { simp only [pderiv_one, pderiv_mul, (pderiv _).leibniz_pow, (pderiv _).map_coe_nat,
+      (pderiv tt).map_add, pderiv_tt_x, pderiv_tt_y, algebra.id.smul_eq_mul, add_zero, mul_one,
+      derivation.map_smul_of_tower, map_nsmul, map_pow, map_add, e, bool.cond_tt, bool.cond_ff,
+      mv_polynomial.aeval_X, add_sub_cancel'_right, one_pow, smul_smul, smul_one_mul] },
 end
 
 /--
diff --git a/src/ring_theory/polynomial/chebyshev.lean b/src/ring_theory/polynomial/chebyshev.lean
index 5adc60a4038bf..a62e98c5e4e9a 100644
--- a/src/ring_theory/polynomial/chebyshev.lean
+++ b/src/ring_theory/polynomial/chebyshev.lean
@@ -9,6 +9,9 @@ import tactic.linear_combination
 /-!
 # Chebyshev polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Chebyshev polynomials are two families of polynomials indexed by `ℕ`,
 with integral coefficients.
 
@@ -65,35 +68,17 @@ noncomputable def T : ℕ → R[X]
 
 @[simp] lemma T_zero : T R 0 = 1 := rfl
 @[simp] lemma T_one : T R 1 = X := rfl
-lemma T_two : T R 2 = 2 * X ^ 2 - 1 :=
-by simp only [T, sub_left_inj, sq, mul_assoc]
-@[simp] lemma T_add_two (n : ℕ) :
-  T R (n + 2) = 2 * X * T R (n + 1) - T R n :=
-by rw T
-
-lemma T_of_two_le (n : ℕ) (h : 2 ≤ n) :
-  T R n = 2 * X * T R (n - 1) - T R (n - 2) :=
+@[simp] lemma T_add_two (n : ℕ) : T R (n + 2) = 2 * X * T R (n + 1) - T R n := by rw T
+
+lemma T_two : T R 2 = 2 * X ^ 2 - 1 := by simp only [T, sub_left_inj, sq, mul_assoc]
+
+lemma T_of_two_le (n : ℕ) (h : 2 ≤ n) : T R n = 2 * X * T R (n - 1) - T R (n - 2) :=
 begin
   obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
   rw add_comm,
   exact T_add_two R n
 end
 
-variables {R S}
-
-lemma map_T (f : R →+* S) :
-  ∀ (n : ℕ), map f (T R n) = T S n
-| 0       := by simp only [T_zero, polynomial.map_one]
-| 1       := by simp only [T_one, map_X]
-| (n + 2) :=
-begin
-  simp only [T_add_two, polynomial.map_mul, polynomial.map_sub, map_X, bit0,
-             polynomial.map_add, polynomial.map_one],
-  rw [map_T (n + 1), map_T n],
-end
-
-variables (R S)
-
 /-- `U n` is the `n`-th Chebyshev polynomial of the second kind -/
 noncomputable def U : ℕ → R[X]
 | 0       := 1
@@ -102,23 +87,18 @@ noncomputable def U : ℕ → R[X]
 
 @[simp] lemma U_zero : U R 0 = 1 := rfl
 @[simp] lemma U_one : U R 1 = 2 * X := rfl
-lemma U_two : U R 2 = 4 * X ^ 2 - 1 :=
-by { simp only [U], ring, }
+@[simp] lemma U_add_two (n : ℕ) : U R (n + 2) = 2 * X * U R (n + 1) - U R n := by rw U
 
-@[simp] lemma U_add_two (n : ℕ) :
-  U R (n + 2) = 2 * X * U R (n + 1) - U R n :=
-by rw U
+lemma U_two : U R 2 = 4 * X ^ 2 - 1 := by { simp only [U], ring, }
 
-lemma U_of_two_le (n : ℕ) (h : 2 ≤ n) :
-  U R n = 2 * X * U R (n - 1) - U R (n - 2) :=
+lemma U_of_two_le (n : ℕ) (h : 2 ≤ n) : U R n = 2 * X * U R (n - 1) - U R (n - 2) :=
 begin
   obtain ⟨n, rfl⟩ := nat.exists_eq_add_of_le h,
   rw add_comm,
   exact U_add_two R n
 end
 
-lemma U_eq_X_mul_U_add_T :
-  ∀ (n : ℕ), U R (n+1) = X * U R n + T R (n+1)
+lemma U_eq_X_mul_U_add_T : ∀ n : ℕ, U R (n + 1) = X * U R n + T R (n + 1)
 | 0        := by { simp only [U_zero, U_one, T_one], ring }
 | 1        := by { simp only [U_one, T_two, U_two], ring }
 | (n + 2)  :=
@@ -127,13 +107,10 @@ lemma U_eq_X_mul_U_add_T :
   ... = X * (2 * X * U R (n + 1) - U R n) + (2 * X * T R (n + 2) - T R (n + 1)) : by ring
   ... = X * U R (n + 2) + T R (n + 2 + 1) : by simp only [U_add_two, T_add_two]
 
-lemma T_eq_U_sub_X_mul_U (n : ℕ) :
-  T R (n+1) = U R (n+1) - X * U R n :=
+lemma T_eq_U_sub_X_mul_U (n : ℕ) : T R (n + 1) = U R (n + 1) - X * U R n :=
 by rw [U_eq_X_mul_U_add_T, add_comm (X * U R n), add_sub_cancel]
 
-
-lemma T_eq_X_mul_T_sub_pol_U :
-  ∀ (n : ℕ), T R (n+2) = X * T R (n+1) - (1 - X ^ 2) * U R n
+lemma T_eq_X_mul_T_sub_pol_U : ∀ n : ℕ, T R (n + 2) = X * T R (n + 1) - (1 - X ^ 2) * U R n
 | 0        := by { simp only [T_one, T_two, U_zero], ring }
 | 1        := by { simp only [T_add_two, T_zero, T_add_two,
                               U_one, T_one], ring }
@@ -152,13 +129,22 @@ by rw [T_eq_X_mul_T_sub_pol_U, ←sub_add, sub_self, zero_add]
 
 variables {R S}
 
-@[simp] lemma map_U (f : R →+* S) :
-  ∀ (n : ℕ), map f (U R n) = U S n
+@[simp] lemma map_T (f : R →+* S) : ∀ n : ℕ, map f (T R n) = T S n
+| 0       := by simp only [T_zero, polynomial.map_one]
+| 1       := by simp only [T_one, map_X]
+| (n + 2) :=
+begin
+  simp only [T_add_two, polynomial.map_mul, polynomial.map_sub, map_X, bit0,
+             polynomial.map_add, polynomial.map_one],
+  rw [map_T (n + 1), map_T n],
+end
+
+@[simp] lemma map_U (f : R →+* S) : ∀ n : ℕ, map f (U R n) = U S n
 | 0       := by simp only [U_zero, polynomial.map_one]
 | 1       :=
 begin
   simp only [U_one, map_X, polynomial.map_mul, polynomial.map_add, polynomial.map_one],
-  change map f (1+1) * X = 2 * X,
+  change map f (1 + 1) * X = 2 * X,
   simpa only [polynomial.map_add, polynomial.map_one]
 end
 | (n + 2) :=
@@ -168,8 +154,7 @@ begin
   rw [map_U (n + 1), map_U n],
 end
 
-lemma T_derivative_eq_U :
-  ∀ (n : ℕ), derivative (T R (n + 1)) = (n + 1) * U R n
+lemma T_derivative_eq_U : ∀ n : ℕ, derivative (T R (n + 1)) = (n + 1) * U R n
 | 0        := by simp only [T_one, U_zero, derivative_X, nat.cast_zero, zero_add, mul_one]
 | 1        := by { simp only [T_two, U_one, derivative_sub, derivative_one, derivative_mul,
                               derivative_X_pow, nat.cast_one, nat.cast_two],
@@ -188,27 +173,25 @@ lemma T_derivative_eq_U :
   ... = (↑(n + 2) + 1) * U R (n + 2) : by norm_cast
 
 lemma one_sub_X_sq_mul_derivative_T_eq_poly_in_T (n : ℕ) :
-  (1 - X ^ 2)  * (derivative (T R (n+1))) =
-    (n + 1) * (T R n - X * T R (n+1)) :=
+  (1 - X ^ 2) * (derivative (T R (n + 1))) = (n + 1) * (T R n - X * T R (n+1)) :=
   calc
-  (1 - X ^ 2)  * (derivative (T R (n+1))) = (1 - X ^ 2 ) * ((n + 1) * U R n) :
+  (1 - X ^ 2) * (derivative (T R (n + 1))) = (1 - X ^ 2) * ((n + 1) * U R n) :
             by rw T_derivative_eq_U
   ... = (n + 1) * ((1 - X ^ 2) * U R n) : by ring
   ... = (n + 1) * (X * T R (n + 1) - (2 * X * T R (n + 1) - T R n)) :
             by rw [one_sub_X_sq_mul_U_eq_pol_in_T, T_add_two]
-  ... = (n + 1) * (T R n - X * T R (n+1)) : by ring
+  ... = (n + 1) * (T R n - X * T R (n + 1)) : by ring
 
 lemma add_one_mul_T_eq_poly_in_U (n : ℕ) :
-  ((n : R[X]) + 1) * T R (n+1) =
-    X * U R n - (1 - X ^ 2) * derivative ( U R n) :=
+  ((n : R[X]) + 1) * T R (n + 1) = X * U R n - (1 - X ^ 2) * derivative (U R n) :=
 begin
   have h : derivative (T R (n + 2)) = (U R (n + 1) - X * U R n) + X * derivative (T R (n + 1))
                                       + 2 * X * U R n - (1 - X ^ 2) * derivative (U R n),
   { conv_lhs { rw T_eq_X_mul_T_sub_pol_U },
-  simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
-  one_mul, T_derivative_eq_U],
-  rw [T_eq_U_sub_X_mul_U, nat.cast_bit0, nat.cast_one],
-  ring },
+    simp only [derivative_sub, derivative_mul, derivative_X, derivative_one, derivative_X_pow,
+              one_mul, T_derivative_eq_U],
+    rw [T_eq_U_sub_X_mul_U, C_eq_nat_cast, nat.cast_bit0, nat.cast_one],
+    ring },
   calc ((n : R[X]) + 1) * T R (n + 1)
       = ((n : R[X]) + 1 + 1) * (X * U R n + T R (n + 1))
         - X * ((n + 1) * U R n) - (X * U R n + T R (n + 1)) : by ring
@@ -224,9 +207,7 @@ end
 variables (R)
 
 /-- The product of two Chebyshev polynomials is the sum of two other Chebyshev polynomials. -/
-lemma mul_T :
-  ∀ m : ℕ, ∀ k,
-  2 * T R m * T R (m + k) = T R (2 * m + k) + T R k
+lemma mul_T : ∀ m k, 2 * T R m * T R (m + k) = T R (2 * m + k) + T R k
 | 0 := by simp [two_mul, add_mul]
 | 1 := by simp [add_comm]
 | (m + 2) := begin
@@ -252,12 +233,11 @@ lemma mul_T :
   have h₂ := T_add_two R (2 * m + k + 2),
   have h₃ := T_add_two R k,
   -- the desired identity is an appropriate linear combination of H₁, H₂, h₁, h₂, h₃
-  linear_combination (h₁, 2 * T R (m + k + 2)) (H₁, 2 * X) (H₂, -1) (h₂, -1) (h₃, -1),
+  linear_combination 2 * T R (m + k + 2) * h₁ + 2 * X * H₁ - H₂ - h₂ - h₃,
 end
 
 /-- The `(m * n)`-th Chebyshev polynomial is the composition of the `m`-th and `n`-th -/
-lemma T_mul :
-  ∀ m : ℕ, ∀ n : ℕ, T R (m * n) = (T R m).comp (T R n)
+lemma T_mul : ∀ m n, T R (m * n) = (T R m).comp (T R n)
 | 0 := by simp
 | 1 := by simp
 | (m + 2) := begin
diff --git a/src/ring_theory/polynomial/content.lean b/src/ring_theory/polynomial/content.lean
index d3ca14358a2df..121e7934aa498 100644
--- a/src/ring_theory/polynomial/content.lean
+++ b/src/ring_theory/polynomial/content.lean
@@ -11,6 +11,9 @@ import data.polynomial.cancel_leads
 /-!
 # GCD structures on polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Definitions and basic results about polynomials over GCD domains, particularly their contents
 and primitive polynomials.
 
@@ -58,6 +61,9 @@ begin
   exact (hp 0 (dvd_zero (C 0))).ne_zero rfl,
 end
 
+lemma is_primitive_of_dvd {p q : R[X]} (hp : is_primitive p) (hq : q ∣ p) : is_primitive q :=
+λ a ha, is_primitive_iff_is_unit_of_C_dvd.mp hp a (dvd_trans ha hq)
+
 end primitive
 
 variables {R : Type*} [comm_ring R] [is_domain R]
@@ -82,7 +88,7 @@ begin
   rw content,
   by_cases h0 : r = 0,
   { simp [h0] },
-  have h : (C r).support = {0} := support_monomial _ _ h0,
+  have h : (C r).support = {0} := support_monomial _ h0,
   simp [h],
 end
 
@@ -136,7 +142,7 @@ begin
 end
 
 @[simp] lemma content_monomial {r : R} {k : ℕ} : content (monomial k r) = normalize r :=
-by { rw [monomial_eq_C_mul_X, content_C_mul, content_X_pow, mul_one] }
+by rw [← C_mul_X_pow_eq_monomial, content_C_mul, content_X_pow, mul_one]
 
 lemma content_eq_zero_iff {p : R[X]} : content p = 0 ↔ p = 0 :=
 begin
@@ -275,6 +281,28 @@ end
 lemma prim_part_dvd (p : R[X]) : p.prim_part ∣ p :=
 dvd.intro_left (C p.content) p.eq_C_content_mul_prim_part.symm
 
+lemma aeval_prim_part_eq_zero {S : Type*} [ring S] [is_domain S] [algebra R S]
+  [no_zero_smul_divisors R S] {p : R[X]} {s : S} (hpzero : p ≠ 0) (hp : aeval s p = 0) :
+  aeval s p.prim_part = 0 :=
+begin
+  rw [eq_C_content_mul_prim_part p, map_mul, aeval_C] at hp,
+  have hcont : p.content ≠ 0 := λ h, hpzero (content_eq_zero_iff.1 h),
+  replace hcont := function.injective.ne (no_zero_smul_divisors.algebra_map_injective R S) hcont,
+  rw [map_zero] at hcont,
+  exact eq_zero_of_ne_zero_of_mul_left_eq_zero hcont hp
+end
+
+lemma eval₂_prim_part_eq_zero {S : Type*} [comm_ring S] [is_domain S] {f : R →+* S}
+  (hinj : function.injective f) {p : R[X]} {s : S} (hpzero : p ≠ 0)
+  (hp : eval₂ f s p = 0) : eval₂ f s p.prim_part = 0 :=
+begin
+  rw [eq_C_content_mul_prim_part p, eval₂_mul, eval₂_C] at hp,
+  have hcont : p.content ≠ 0 := λ h, hpzero (content_eq_zero_iff.1 h),
+  replace hcont := function.injective.ne hinj hcont,
+  rw [map_zero] at hcont,
+  exact eq_zero_of_ne_zero_of_mul_left_eq_zero hcont hp
+end
+
 end prim_part
 
 lemma gcd_content_eq_of_dvd_sub {a : R} {p q : R[X]} (h : C a ∣ p - q) :
@@ -360,15 +388,6 @@ begin
   ring,
 end
 
-lemma is_primitive.is_primitive_of_dvd {p q : R[X]} (hp : p.is_primitive) (hdvd : q ∣ p) :
-  q.is_primitive :=
-begin
-  rcases hdvd with ⟨r, rfl⟩,
-  rw [is_primitive_iff_content_eq_one, ← normalize_content, normalize_eq_one, is_unit_iff_dvd_one],
-  apply dvd.intro r.content,
-  rwa [is_primitive_iff_content_eq_one, content_mul] at hp,
-end
-
 lemma is_primitive.dvd_prim_part_iff_dvd {p q : R[X]}
   (hp : p.is_primitive) (hq : q ≠ 0) :
   p ∣ q.prim_part ↔ p ∣ q :=
diff --git a/src/ring_theory/polynomial/cyclotomic/basic.lean b/src/ring_theory/polynomial/cyclotomic/basic.lean
index 1aea80bb1b45f..31c0f26811d84 100644
--- a/src/ring_theory/polynomial/cyclotomic/basic.lean
+++ b/src/ring_theory/polynomial/cyclotomic/basic.lean
@@ -4,19 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Riccardo Brasca
 -/
 
+import algebra.ne_zero
 import algebra.polynomial.big_operators
-import analysis.complex.roots_of_unity
+import ring_theory.roots_of_unity.complex
 import data.polynomial.lifts
+import data.polynomial.splits
+import data.zmod.algebra
+import field_theory.ratfunc
 import field_theory.separable
-import field_theory.splitting_field
 import number_theory.arithmetic_function
-import ring_theory.roots_of_unity
-import field_theory.ratfunc
-import algebra.ne_zero
+import ring_theory.roots_of_unity.basic
 
 /-!
 # Cyclotomic polynomials.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For `n : ℕ` and an integral domain `R`, we define a modified version of the `n`-th cyclotomic
 polynomial with coefficients in `R`, denoted `cyclotomic' n R`, as `∏ (X - μ)`, where `μ` varies
 over the primitive `n`th roots of unity. If there is a primitive `n`th root of unity in `R` then
@@ -29,13 +33,11 @@ with coefficients in any ring `R`.
 
 ## Main results
 
-* `int_coeff_of_cycl` : If there is a primitive `n`-th root of unity in `K`, then `cyclotomic' n K`
-comes from a polynomial with integer coefficients.
-* `deg_of_cyclotomic` : The degree of `cyclotomic n` is `totient n`.
-* `prod_cyclotomic_eq_X_pow_sub_one` : `X ^ n - 1 = ∏ (cyclotomic i)`, where `i` divides `n`.
-* `cyclotomic_eq_prod_X_pow_sub_one_pow_moebius` : The Möbius inversion formula for
-  `cyclotomic n R` over an abstract fraction field for `polynomial R`.
-* `cyclotomic.irreducible` : `cyclotomic n ℤ` is irreducible.
+* `polynomial.degree_cyclotomic` : The degree of `cyclotomic n` is `totient n`.
+* `polynomial.prod_cyclotomic_eq_X_pow_sub_one` : `X ^ n - 1 = ∏ (cyclotomic i)`, where `i`
+  divides `n`.
+* `polynomial.cyclotomic_eq_prod_X_pow_sub_one_pow_moebius` : The Möbius inversion formula for
+  `cyclotomic n R` over an abstract fraction field for `R[X]`.
 
 ## Implementation details
 
@@ -45,7 +47,7 @@ not the standard one unless there is a primitive `n`th root of unity in `R`. For
 `cyclotomic' 3 ℤ = 1`, since there are no primitive cube roots of unity in `ℤ`. The main example is
 `R = ℂ`, we decided to work in general since the difficulties are essentially the same.
 To get the standard cyclotomic polynomials, we use `int_coeff_of_cycl`, with `R = ℂ`, to get a
-polynomial with integer coefficients and then we map it to `polynomial R`, for any ring `R`.
+polynomial with integer coefficients and then we map it to `R[X]`, for any ring `R`.
 To prove `cyclotomic.irreducible`, the irreducibility of `cyclotomic n ℤ`, we show in
 `cyclotomic_eq_minpoly` that `cyclotomic n ℤ` is the minimal polynomial of any `n`-th primitive root
 of unity `μ : K`, where `K` is a field of characteristic `0`.
@@ -72,7 +74,7 @@ def cyclotomic' (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : R[X] :=
 /-- The zeroth modified cyclotomic polyomial is `1`. -/
 @[simp] lemma cyclotomic'_zero
   (R : Type*) [comm_ring R] [is_domain R] : cyclotomic' 0 R = 1 :=
-by simp only [cyclotomic', finset.prod_empty, is_primitive_root.primitive_roots_zero]
+by simp only [cyclotomic', finset.prod_empty, primitive_roots_zero]
 
 /-- The first modified cyclotomic polyomial is `X - 1`. -/
 @[simp] lemma cyclotomic'_one
@@ -89,12 +91,8 @@ end
 begin
   rw [cyclotomic'],
   have prim_root_two : primitive_roots 2 R = {(-1 : R)},
-  { apply finset.eq_singleton_iff_unique_mem.2,
-    split,
-    { simp only [is_primitive_root.neg_one p hp, nat.succ_pos', mem_primitive_roots] },
-    { intros x hx,
-      rw [mem_primitive_roots zero_lt_two] at hx,
-      exact is_primitive_root.eq_neg_one_of_two_right hx } },
+  { simp only [finset.eq_singleton_iff_unique_mem, mem_primitive_roots two_pos],
+    exact ⟨is_primitive_root.neg_one p hp, λ x, is_primitive_root.eq_neg_one_of_two_right⟩ },
   simp only [prim_root_two, finset.prod_singleton, ring_hom.map_neg, ring_hom.map_one,
   sub_neg_eq_add]
 end
@@ -172,19 +170,10 @@ by rw [splits_iff_card_roots, ← nth_roots, is_primitive_root.card_nth_roots h,
 `∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1`. -/
 lemma prod_cyclotomic'_eq_X_pow_sub_one {K : Type*} [comm_ring K] [is_domain K] {ζ : K} {n : ℕ}
   (hpos : 0 < n) (h : is_primitive_root ζ n) : ∏ i in nat.divisors n, cyclotomic' i K = X ^ n - 1 :=
-begin
-  rw [X_pow_sub_one_eq_prod hpos h],
-  have rwcyc : ∀ i ∈ nat.divisors n, cyclotomic' i K = ∏ μ in primitive_roots i K, (X - C μ),
-  { intros i hi,
-    simp only [cyclotomic'] },
-  conv_lhs { apply_congr,
-             skip,
-             simp [rwcyc, H] },
-  rw ← finset.prod_bUnion,
-  { simp only [is_primitive_root.nth_roots_one_eq_bUnion_primitive_roots h] },
-  intros x hx y hy hdiff,
-  exact is_primitive_root.disjoint hdiff,
-end
+have hd : (n.divisors : set ℕ).pairwise_disjoint (λ k, primitive_roots k K),
+  from λ x hx y hy hne, is_primitive_root.disjoint hne,
+by simp only [X_pow_sub_one_eq_prod hpos h, cyclotomic', ← finset.prod_bUnion hd,
+    h.nth_roots_one_eq_bUnion_primitive_roots]
 
 /-- If there is a primitive `n`-th root of unity in `K`, then
 `cyclotomic' n K = (X ^ k - 1) /ₘ (∏ i in nat.proper_divisors k, cyclotomic' i K)`. -/
@@ -192,9 +181,8 @@ lemma cyclotomic'_eq_X_pow_sub_one_div {K : Type*} [comm_ring K] [is_domain K] {
   (hpos : 0 < n) (h : is_primitive_root ζ n) :
   cyclotomic' n K = (X ^ n - 1) /ₘ (∏ i in nat.proper_divisors n, cyclotomic' i K) :=
 begin
-  rw [←prod_cyclotomic'_eq_X_pow_sub_one hpos h,
-  nat.divisors_eq_proper_divisors_insert_self_of_pos hpos,
-  finset.prod_insert nat.proper_divisors.not_self_mem],
+  rw [←prod_cyclotomic'_eq_X_pow_sub_one hpos h, ← nat.cons_self_proper_divisors hpos.ne',
+    finset.prod_cons],
   have prod_monic : (∏ i in nat.proper_divisors n, cyclotomic' i K).monic,
   { apply monic_prod_of_monic,
     intros i hi,
@@ -215,11 +203,10 @@ lemma int_coeff_of_cyclotomic' {K : Type*} [comm_ring K] [is_domain K] {ζ : K}
     P.degree = (cyclotomic' n K).degree ∧ P.monic) :=
 begin
   refine lifts_and_degree_eq_and_monic _ (cyclotomic'.monic n K),
-  induction n using nat.strong_induction_on with k hk generalizing ζ h,
-  cases nat.eq_zero_or_pos k with hzero hpos,
+  induction n using nat.strong_induction_on with k ihk generalizing ζ h,
+  rcases k.eq_zero_or_pos with rfl|hpos,
   { use 1,
-    simp only [hzero, cyclotomic'_zero, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
-    coe_map_ring_hom, polynomial.map_one, and_self] },
+    simp only [cyclotomic'_zero, coe_map_ring_hom, polynomial.map_one] },
   let B : K[X] := ∏ i in nat.proper_divisors k, cyclotomic' i K,
   have Bmo : B.monic,
   { apply monic_prod_of_monic,
@@ -231,18 +218,15 @@ begin
     have xsmall := (nat.mem_proper_divisors.1 hx).2,
     obtain ⟨d, hd⟩ := (nat.mem_proper_divisors.1 hx).1,
     rw [mul_comm] at hd,
-    exact hk x xsmall (is_primitive_root.pow hpos h hd) },
+    exact ihk x xsmall (h.pow hpos hd) },
   replace Bint := lifts_and_degree_eq_and_monic Bint Bmo,
   obtain ⟨B₁, hB₁, hB₁deg, hB₁mo⟩ := Bint,
   let Q₁ : ℤ[X] := (X ^ k - 1) /ₘ B₁,
   have huniq : 0 + B * cyclotomic' k K = X ^ k - 1 ∧ (0 : K[X]).degree < B.degree,
   { split,
-    { rw [zero_add, mul_comm, ←(prod_cyclotomic'_eq_X_pow_sub_one hpos h),
-      nat.divisors_eq_proper_divisors_insert_self_of_pos hpos],
-      simp only [true_and, finset.prod_insert, not_lt, nat.mem_proper_divisors, dvd_refl] },
-    rw [degree_zero, bot_lt_iff_ne_bot],
-    intro habs,
-    exact (monic.ne_zero Bmo) (degree_eq_bot.1 habs) },
+    { rw [zero_add, mul_comm, ← prod_cyclotomic'_eq_X_pow_sub_one hpos h,
+         ← nat.cons_self_proper_divisors hpos.ne', finset.prod_cons] },
+    { simpa only [degree_zero, bot_lt_iff_ne_bot, ne.def, degree_eq_bot] using Bmo.ne_zero } },
   replace huniq := div_mod_by_monic_unique (cyclotomic' k K) (0 : K[X]) Bmo huniq,
   simp only [lifts, ring_hom.mem_srange],
   use Q₁,
@@ -278,7 +262,7 @@ lemma int_cyclotomic_rw {n : ℕ} (h : n ≠ 0) :
 begin
   simp only [cyclotomic, h, dif_neg, not_false_iff],
   ext i,
-  simp only [coeff_map, int.cast_id, ring_hom.eq_int_cast]
+  simp only [coeff_map, int.cast_id, eq_int_cast]
 end
 
 /-- `cyclotomic n R` comes from `cyclotomic n ℤ`. -/
@@ -311,9 +295,8 @@ end
 @[simp] lemma map_cyclotomic (n : ℕ) {R S : Type*} [ring R] [ring S] (f : R →+* S) :
   map f (cyclotomic n R) = cyclotomic n S :=
 begin
-  rw [←map_cyclotomic_int n R, ←map_cyclotomic_int n S],
-  ext i,
-  simp only [coeff_map, ring_hom.eq_int_cast, ring_hom.map_int_cast]
+  rw [←map_cyclotomic_int n R, ←map_cyclotomic_int n S, map_map],
+  congr
 end
 
 lemma cyclotomic.eval_apply {R S : Type*} (q : R) (n : ℕ) [ring R] [ring S] (f : R →+* S) :
@@ -334,17 +317,6 @@ begin
   simp only [map_X, polynomial.map_one, polynomial.map_sub]
 end
 
-/-- The second cyclotomic polyomial is `X + 1`. -/
-@[simp] lemma cyclotomic_two (R : Type*) [ring R] : cyclotomic 2 R = X + 1 :=
-begin
-  have hspec : map (int.cast_ring_hom ℂ) (X + 1) = cyclotomic' 2 ℂ,
-  { simp only [cyclotomic'_two ℂ 0 two_ne_zero.symm, polynomial.map_add, map_X,
-               polynomial.map_one], },
-  symmetry,
-  rw [←map_cyclotomic_int, ←(int_cyclotomic_unique hspec)],
-  simp only [polynomial.map_add, map_X, polynomial.map_one]
-end
-
 /-- `cyclotomic n` is monic. -/
 lemma cyclotomic.monic (n : ℕ) (R : Type*) [ring R] : (cyclotomic n R).monic :=
 begin
@@ -370,72 +342,82 @@ begin
     { simp only [cyclotomic, degree_one, dif_pos, nat.totient_zero, with_top.coe_zero]},
       rw [←degree_cyclotomic' (complex.is_primitive_root_exp k.succ (nat.succ_ne_zero k))],
       exact (int_cyclotomic_spec k.succ).2.1 },
-  simp only [(int_cyclotomic_spec n).right.right, ring_hom.eq_int_cast, monic.leading_coeff,
+  simp only [(int_cyclotomic_spec n).right.right, eq_int_cast, monic.leading_coeff,
   int.cast_one, ne.def, not_false_iff, one_ne_zero]
 end
 
 /-- The natural degree of `cyclotomic n` is `totient n`. -/
 lemma nat_degree_cyclotomic (n : ℕ) (R : Type*) [ring R] [nontrivial R] :
   (cyclotomic n R).nat_degree = nat.totient n :=
-begin
-  have hdeg := degree_cyclotomic n R,
-  rw degree_eq_nat_degree (cyclotomic_ne_zero n R) at hdeg,
-  exact_mod_cast hdeg
-end
+by rw [nat_degree, degree_cyclotomic, with_bot.unbot'_coe]
 
 /-- The degree of `cyclotomic n R` is positive. -/
 lemma degree_cyclotomic_pos (n : ℕ) (R : Type*) (hpos : 0 < n) [ring R] [nontrivial R] :
   0 < (cyclotomic n R).degree := by
 { rw degree_cyclotomic n R, exact_mod_cast (nat.totient_pos hpos) }
 
+open finset
+
 /-- `∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1`. -/
 lemma prod_cyclotomic_eq_X_pow_sub_one {n : ℕ} (hpos : 0 < n) (R : Type*) [comm_ring R] :
   ∏ i in nat.divisors n, cyclotomic i R = X ^ n - 1 :=
 begin
   have integer : ∏ i in nat.divisors n, cyclotomic i ℤ = X ^ n - 1,
   { apply map_injective (int.cast_ring_hom ℂ) int.cast_injective,
-    rw polynomial.map_prod (int.cast_ring_hom ℂ) (λ i, cyclotomic i ℤ),
-    simp only [int_cyclotomic_spec, polynomial.map_pow, nat.cast_id, map_X, polynomial.map_one,
-               polynomial.map_sub],
-    exact prod_cyclotomic'_eq_X_pow_sub_one hpos
-          (complex.is_primitive_root_exp n (ne_of_lt hpos).symm) },
-  have coerc : X ^ n - 1 = map (int.cast_ring_hom R) (X ^ n - 1),
-  { simp only [polynomial.map_pow, polynomial.map_X, polynomial.map_one, polynomial.map_sub] },
-  have h : ∀ i ∈ n.divisors, cyclotomic i R = map (int.cast_ring_hom R) (cyclotomic i ℤ),
-  { intros i hi,
-    exact (map_cyclotomic_int i R).symm },
-  rw [finset.prod_congr (refl n.divisors) h, coerc,
-      ← polynomial.map_prod (int.cast_ring_hom R) (λ i, cyclotomic i ℤ), integer]
+    simp only [polynomial.map_prod, int_cyclotomic_spec, polynomial.map_pow, map_X,
+               polynomial.map_one, polynomial.map_sub],
+    exact prod_cyclotomic'_eq_X_pow_sub_one hpos (complex.is_primitive_root_exp n hpos.ne') },
+  simpa only [polynomial.map_prod, map_cyclotomic_int, polynomial.map_sub, polynomial.map_one,
+    polynomial.map_pow, polynomial.map_X] using congr_arg (map (int.cast_ring_hom R)) integer
 end
 
-lemma cyclotomic.dvd_X_pow_sub_one (n : ℕ) (R : Type*) [comm_ring R] :
+lemma cyclotomic.dvd_X_pow_sub_one (n : ℕ) (R : Type*) [ring R] :
   (cyclotomic n R) ∣ X ^ n - 1 :=
 begin
+  suffices : cyclotomic n ℤ ∣ X ^ n - 1,
+  { simpa only [map_cyclotomic_int, polynomial.map_sub, polynomial.map_one, polynomial.map_pow,
+      polynomial.map_X] using map_dvd (int.cast_ring_hom R) this },
   rcases n.eq_zero_or_pos with rfl | hn,
   { simp },
-  refine ⟨∏ i in n.proper_divisors, cyclotomic i R, _⟩,
-  rw [←prod_cyclotomic_eq_X_pow_sub_one hn,
-      nat.divisors_eq_proper_divisors_insert_self_of_pos hn, finset.prod_insert],
-  exact nat.proper_divisors.not_self_mem
+  rw [← prod_cyclotomic_eq_X_pow_sub_one hn],
+  exact finset.dvd_prod_of_mem _ (n.mem_divisors_self hn.ne')
 end
 
-lemma prod_cyclotomic_eq_geom_sum {n : ℕ} (h : 0 < n) (R) [comm_ring R] [is_domain R] :
-  ∏ i in n.divisors \ {1}, cyclotomic i R = geom_sum X n :=
+lemma prod_cyclotomic_eq_geom_sum {n : ℕ} (h : 0 < n) (R) [comm_ring R] :
+  ∏ i in n.divisors.erase 1, cyclotomic i R = ∑ i in finset.range n, X ^ i :=
+suffices ∏ i in n.divisors.erase 1, cyclotomic i ℤ = ∑ i in finset.range n, X ^ i,
+by simpa only [polynomial.map_prod, map_cyclotomic_int, polynomial.map_sum, polynomial.map_pow,
+  polynomial.map_X] using congr_arg (map (int.cast_ring_hom R)) this,
+by rw [← mul_left_inj' (cyclotomic_ne_zero 1 ℤ), prod_erase_mul _ _ (nat.one_mem_divisors.2 h.ne'),
+  cyclotomic_one, geom_sum_mul, prod_cyclotomic_eq_X_pow_sub_one h]
+
+/-- If `p` is prime, then `cyclotomic p R = ∑ i in range p, X ^ i`. -/
+lemma cyclotomic_prime (R : Type*) [ring R] (p : ℕ) [hp : fact p.prime] :
+  cyclotomic p R = ∑ i in finset.range p, X ^ i :=
 begin
-  apply_fun (* cyclotomic 1 R) using mul_left_injective₀ (cyclotomic_ne_zero 1 R),
-  have : ∏ i in {1}, cyclotomic i R = cyclotomic 1 R := finset.prod_singleton,
-  simp_rw [←this, finset.prod_sdiff $ show {1} ⊆ n.divisors, by simp [h.ne'], this, cyclotomic_one,
-           geom_sum_mul, prod_cyclotomic_eq_X_pow_sub_one h]
+  suffices : cyclotomic p ℤ = ∑ i in range p, X ^ i,
+  { simpa only [map_cyclotomic_int, polynomial.map_sum, polynomial.map_pow, polynomial.map_X]
+      using congr_arg (map (int.cast_ring_hom R)) this },
+  rw [← prod_cyclotomic_eq_geom_sum hp.out.pos, hp.out.divisors,
+    erase_insert (mem_singleton.not.2 hp.out.ne_one.symm), prod_singleton]
 end
 
-lemma cyclotomic_dvd_geom_sum_of_dvd (R) [comm_ring R] {d n : ℕ} (hdn : d ∣ n)
-  (hd : d ≠ 1) : cyclotomic d R ∣ geom_sum X n :=
+lemma cyclotomic_prime_mul_X_sub_one (R : Type*) [ring R] (p : ℕ) [hn : fact (nat.prime p)] :
+  (cyclotomic p R) * (X - 1) = X ^ p - 1 :=
+by rw [cyclotomic_prime, geom_sum_mul]
+
+@[simp] lemma cyclotomic_two (R : Type*) [ring R] : cyclotomic 2 R = X + 1 :=
+by simp [cyclotomic_prime]
+
+@[simp] lemma cyclotomic_three (R : Type*) [ring R] : cyclotomic 3 R = X ^ 2 + X + 1 :=
+by simp [cyclotomic_prime, sum_range_succ']
+
+lemma cyclotomic_dvd_geom_sum_of_dvd (R) [ring R] {d n : ℕ} (hdn : d ∣ n)
+  (hd : d ≠ 1) : cyclotomic d R ∣ ∑ i in finset.range n, X ^ i :=
 begin
-  suffices : (cyclotomic d ℤ).map (int.cast_ring_hom R) ∣ (geom_sum X n).map (int.cast_ring_hom R),
-  { have key := (map_ring_hom (int.cast_ring_hom R)).map_geom_sum X n,
-    simp only [coe_map_ring_hom, map_X] at key,
-    rwa [map_cyclotomic, key] at this },
-  apply map_dvd,
+  suffices : cyclotomic d ℤ ∣ ∑ i in finset.range n, X ^ i,
+  { simpa only [map_cyclotomic_int, polynomial.map_sum, polynomial.map_pow, polynomial.map_X]
+      using map_dvd (int.cast_ring_hom R) this },
   rcases n.eq_zero_or_pos with rfl | hn,
   { simp },
   rw ←prod_cyclotomic_eq_geom_sum hn,
@@ -448,9 +430,8 @@ lemma X_pow_sub_one_mul_prod_cyclotomic_eq_X_pow_sub_one_of_dvd (R) [comm_ring R
   (X ^ d - 1) * ∏ x in n.divisors \ d.divisors, cyclotomic x R = X ^ n - 1 :=
 begin
   obtain ⟨hd, hdn⟩ := nat.mem_proper_divisors.mp h,
-  have h0n := pos_of_gt hdn,
-  rcases d.eq_zero_or_pos with rfl | h0d,
-  { exfalso, linarith [eq_zero_of_zero_dvd hd] },
+  have h0n : 0 < n := pos_of_gt hdn,
+  have h0d : 0 < d := nat.pos_of_dvd_of_pos hd h0n,
   rw [←prod_cyclotomic_eq_X_pow_sub_one h0d, ←prod_cyclotomic_eq_X_pow_sub_one h0n,
       mul_comm, finset.prod_sdiff (nat.divisors_subset_of_dvd h0n.ne' hd)]
 end
@@ -464,35 +445,16 @@ begin
   convert X_pow_sub_one_mul_prod_cyclotomic_eq_X_pow_sub_one_of_dvd R h using 1,
   rw mul_assoc,
   congr' 1,
-  rw [nat.divisors_eq_proper_divisors_insert_self_of_pos $ pos_of_gt hdn,
-      finset.insert_sdiff_of_not_mem, finset.prod_insert],
+  rw [← nat.insert_self_proper_divisors hdn.ne_bot, insert_sdiff_of_not_mem, prod_insert],
   { exact finset.not_mem_sdiff_of_not_mem_left nat.proper_divisors.not_self_mem },
   { exact λ hk, hdn.not_le $ nat.divisor_le hk }
 end
 
-lemma _root_.is_root_of_unity_iff {n : ℕ} (h : 0 < n) (R : Type*) [comm_ring R] [is_domain R]
-  {ζ : R} : ζ ^ n = 1 ↔ ∃ i ∈ n.divisors, (cyclotomic i R).is_root ζ :=
-by rw [←mem_nth_roots h, nth_roots, mem_roots $ X_pow_sub_C_ne_zero h _,
-       C_1, ←prod_cyclotomic_eq_X_pow_sub_one h, is_root_prod]; apply_instance
-
-lemma is_root_of_unity_of_root_cyclotomic {n : ℕ} {R} [comm_ring R] {ζ : R} {i : ℕ}
-  (hi : i ∈ n.divisors) (h : (cyclotomic i R).is_root ζ) : ζ ^ n = 1 :=
-begin
-  rcases n.eq_zero_or_pos with rfl | hn,
-  { exact pow_zero _ },
-  have := congr_arg (eval ζ) (prod_cyclotomic_eq_X_pow_sub_one hn R).symm,
-  rw [eval_sub, eval_pow, eval_X, eval_one] at this,
-  convert eq_add_of_sub_eq' this,
-  convert (add_zero _).symm,
-  apply eval_eq_zero_of_dvd_of_eval_eq_zero _ h,
-  exact finset.dvd_prod_of_mem _ hi
-end
-
 section arithmetic_function
 open nat.arithmetic_function
 open_locale arithmetic_function
 
-/-- `cyclotomic n R` can be expressed as a product in a fraction field of `polynomial R`
+/-- `cyclotomic n R` can be expressed as a product in a fraction field of `R[X]`
   using Möbius inversion. -/
 lemma cyclotomic_eq_prod_X_pow_sub_one_pow_moebius {n : ℕ} (R : Type*) [comm_ring R] [is_domain R] :
   algebra_map _ (ratfunc R) (cyclotomic n R) =
@@ -519,9 +481,8 @@ lemma cyclotomic_eq_X_pow_sub_one_div {R : Type*} [comm_ring R] {n : ℕ}
   (hpos: 0 < n) : cyclotomic n R = (X ^ n - 1) /ₘ (∏ i in nat.proper_divisors n, cyclotomic i R) :=
 begin
   nontriviality R,
-  rw [←prod_cyclotomic_eq_X_pow_sub_one hpos,
-  nat.divisors_eq_proper_divisors_insert_self_of_pos hpos,
-  finset.prod_insert nat.proper_divisors.not_self_mem],
+  rw [←prod_cyclotomic_eq_X_pow_sub_one hpos, ← nat.cons_self_proper_divisors hpos.ne',
+    finset.prod_cons],
   have prod_monic : (∏ i in nat.proper_divisors n, cyclotomic i R).monic,
   { apply monic_prod_of_monic,
     intros i hi,
@@ -541,11 +502,11 @@ lemma X_pow_sub_one_dvd_prod_cyclotomic (R : Type*) [comm_ring R] {n m : ℕ} (h
   (hm : m ∣ n) (hdiff : m ≠ n) : X ^ m - 1 ∣ ∏ i in nat.proper_divisors n, cyclotomic i R :=
 begin
   replace hm := nat.mem_proper_divisors.2 ⟨hm, lt_of_le_of_ne (nat.divisor_le (nat.mem_divisors.2
-    ⟨hm, (ne_of_lt hpos).symm⟩)) hdiff⟩,
+    ⟨hm, hpos.ne'⟩)) hdiff⟩,
   rw [← finset.sdiff_union_of_subset (nat.divisors_subset_proper_divisors (ne_of_lt hpos).symm
     (nat.mem_proper_divisors.1 hm).1 (ne_of_lt (nat.mem_proper_divisors.1 hm).2)),
-    finset.prod_union finset.sdiff_disjoint, prod_cyclotomic_eq_X_pow_sub_one
-    (nat.pos_of_mem_proper_divisors hm)],
+    finset.prod_union finset.sdiff_disjoint,
+    prod_cyclotomic_eq_X_pow_sub_one (nat.pos_of_mem_proper_divisors hm)],
   exact ⟨(∏ (x : ℕ) in n.proper_divisors \ m.divisors, cyclotomic x R), by rw mul_comm⟩
 end
 
@@ -569,126 +530,14 @@ begin
       cyclotomic'_eq_X_pow_sub_one_div hpos hz, finset.prod_congr (refl k.proper_divisors) h]
 end
 
-section roots
-
-variables {R : Type*} {n : ℕ} [comm_ring R] [is_domain R]
-
-/-- Any `n`-th primitive root of unity is a root of `cyclotomic n K`.-/
-lemma _root_.is_primitive_root.is_root_cyclotomic (hpos : 0 < n) {μ : R}
-  (h : is_primitive_root μ n) : is_root (cyclotomic n R) μ :=
-begin
-  rw [← mem_roots (cyclotomic_ne_zero n R),
-      cyclotomic_eq_prod_X_sub_primitive_roots h, roots_prod_X_sub_C, ← finset.mem_def],
-  rwa [← mem_primitive_roots hpos] at h,
-end
-
-private lemma is_root_cyclotomic_iff' {n : ℕ} {K : Type*} [field K] {μ : K} [ne_zero (n : K)] :
-  is_root (cyclotomic n K) μ ↔ is_primitive_root μ n :=
-begin
-  -- in this proof, `o` stands for `order_of μ`
-  have hnpos : 0 < n := (ne_zero.of_ne_zero_coe K).out.bot_lt,
-  refine ⟨λ hμ, _, is_primitive_root.is_root_cyclotomic hnpos⟩,
-  have hμn : μ ^ n = 1,
-  { rw is_root_of_unity_iff hnpos,
-    exact ⟨n, n.mem_divisors_self hnpos.ne', hμ⟩ },
-  by_contra hnμ,
-  have ho : 0 < order_of μ,
-  { apply order_of_pos',
-    rw is_of_fin_order_iff_pow_eq_one,
-    exact ⟨n, hnpos, hμn⟩ },
-  have := pow_order_of_eq_one μ,
-  rw is_root_of_unity_iff ho at this,
-  obtain ⟨i, hio, hiμ⟩ := this,
-  replace hio := nat.dvd_of_mem_divisors hio,
-  rw is_primitive_root.not_iff at hnμ,
-  rw ←order_of_dvd_iff_pow_eq_one at hμn,
-  have key  : i < n := (nat.le_of_dvd ho hio).trans_lt ((nat.le_of_dvd hnpos hμn).lt_of_ne hnμ),
-  have key' : i ∣ n := hio.trans hμn,
-  rw ←polynomial.dvd_iff_is_root at hμ hiμ,
-  have hni : {i, n} ⊆ n.divisors,
-  { simpa [finset.insert_subset, key'] using hnpos.ne' },
-  obtain ⟨k, hk⟩ := hiμ,
-  obtain ⟨j, hj⟩ := hμ,
-  have := prod_cyclotomic_eq_X_pow_sub_one hnpos K,
-  rw [←finset.prod_sdiff hni, finset.prod_pair key.ne, hk, hj] at this,
-  have hn := (X_pow_sub_one_separable_iff.mpr $ ne_zero.ne' n K).squarefree,
-  rw [←this, squarefree] at hn,
-  contrapose! hn,
-  refine ⟨X - C μ, ⟨(∏ x in n.divisors \ {i, n}, cyclotomic x K) * k * j, by ring⟩, _⟩,
-  simp [polynomial.is_unit_iff_degree_eq_zero]
-end
-
-lemma is_root_cyclotomic_iff [ne_zero (n : R)] {μ : R} :
-  is_root (cyclotomic n R) μ ↔ is_primitive_root μ n :=
-begin
-  have hf : function.injective _ := is_fraction_ring.injective R (fraction_ring R),
-  haveI : ne_zero (n : fraction_ring R) := ne_zero.nat_of_injective hf,
-  rw [←is_root_map_iff hf, ←is_primitive_root.map_iff_of_injective hf, map_cyclotomic,
-      ←is_root_cyclotomic_iff']
-end
-
-lemma roots_cyclotomic_nodup [ne_zero (n : R)] : (cyclotomic n R).roots.nodup :=
-begin
-  obtain h | ⟨ζ, hζ⟩ := (cyclotomic n R).roots.empty_or_exists_mem,
-  { exact h.symm ▸ multiset.nodup_zero },
-  rw [mem_roots $ cyclotomic_ne_zero n R, is_root_cyclotomic_iff] at hζ,
-  refine multiset.nodup_of_le (roots.le_of_dvd (X_pow_sub_C_ne_zero
-    (ne_zero.pos_of_ne_zero_coe R) 1) $ cyclotomic.dvd_X_pow_sub_one n R) hζ.nth_roots_nodup,
-end
-
-lemma cyclotomic.roots_to_finset_eq_primitive_roots [ne_zero (n : R)] :
-    (⟨(cyclotomic n R).roots, roots_cyclotomic_nodup⟩ : finset _) = primitive_roots n R :=
-by { ext, simp [cyclotomic_ne_zero n R, is_root_cyclotomic_iff,
-                mem_primitive_roots, ne_zero.pos_of_ne_zero_coe R] }
-
-lemma cyclotomic.roots_eq_primitive_roots_val [ne_zero (n : R)] :
-  (cyclotomic n R).roots = (primitive_roots n R).val :=
-by rw ←cyclotomic.roots_to_finset_eq_primitive_roots
-
-end roots
-
-/-- If `R` is of characteristic zero, then `ζ` is a root of `cyclotomic n R` if and only if it is a
-primitive `n`-th root of unity. -/
-lemma is_root_cyclotomic_iff_char_zero {n : ℕ} {R : Type*} [comm_ring R] [is_domain R]
-  [char_zero R] {μ : R} (hn : 0 < n) :
-  (polynomial.cyclotomic n R).is_root μ ↔ is_primitive_root μ n :=
-by { letI := ne_zero.of_gt hn, exact is_root_cyclotomic_iff }
-
-/-- Over a ring `R` of characteristic zero, `λ n, cyclotomic n R` is injective. -/
-lemma cyclotomic_injective {R : Type*} [comm_ring R] [char_zero R] :
-  function.injective (λ n, cyclotomic n R) :=
-begin
-  intros n m hnm,
-  simp only at hnm,
-  rcases eq_or_ne n 0 with rfl | hzero,
-  { rw [cyclotomic_zero] at hnm,
-    replace hnm := congr_arg nat_degree hnm,
-    rw [nat_degree_one, nat_degree_cyclotomic] at hnm,
-    by_contra,
-    exact (nat.totient_pos (zero_lt_iff.2 (ne.symm h))).ne hnm },
-  { haveI := ne_zero.mk hzero,
-    rw [← map_cyclotomic_int _ R, ← map_cyclotomic_int _ R] at hnm,
-    replace hnm := map_injective (int.cast_ring_hom R) int.cast_injective hnm,
-    replace hnm := congr_arg (map (int.cast_ring_hom ℂ)) hnm,
-    rw [map_cyclotomic_int, map_cyclotomic_int] at hnm,
-    have hprim := complex.is_primitive_root_exp _ hzero,
-    have hroot := is_root_cyclotomic_iff.2 hprim,
-    rw hnm at hroot,
-    haveI hmzero : ne_zero m := ⟨λ h, by simpa [h] using hroot⟩,
-    rw is_root_cyclotomic_iff at hroot,
-    replace hprim := hprim.eq_order_of,
-    rwa [← is_primitive_root.eq_order_of hroot] at hprim}
-end
-
 lemma eq_cyclotomic_iff {R : Type*} [comm_ring R] {n : ℕ} (hpos: 0 < n)
   (P : R[X]) :
   P = cyclotomic n R ↔ P * (∏ i in nat.proper_divisors n, polynomial.cyclotomic i R) = X ^ n - 1 :=
 begin
   nontriviality R,
   refine ⟨λ hcycl, _, λ hP, _⟩,
-  { rw [hcycl, ← finset.prod_insert (@nat.proper_divisors.not_self_mem n),
-      ← nat.divisors_eq_proper_divisors_insert_self_of_pos hpos],
-    exact prod_cyclotomic_eq_X_pow_sub_one hpos R },
+  { rw [hcycl, ← prod_cyclotomic_eq_X_pow_sub_one hpos R, ← nat.cons_self_proper_divisors hpos.ne',
+        finset.prod_cons] },
   { have prod_monic : (∏ i in nat.proper_divisors n, cyclotomic i R).monic,
     { apply monic_prod_of_monic,
       intros i hi,
@@ -701,35 +550,24 @@ begin
     exact monic.ne_zero prod_monic (degree_eq_bot.1 h) },
 end
 
-/-- If `p` is prime, then `cyclotomic p R = geom_sum X p`. -/
-lemma cyclotomic_eq_geom_sum {R : Type*} [comm_ring R] {p : ℕ}
-  (hp : nat.prime p) : cyclotomic p R = geom_sum X p :=
-begin
-  refine ((eq_cyclotomic_iff hp.pos _).mpr _).symm,
-  simp only [nat.prime.proper_divisors hp, geom_sum_mul, finset.prod_singleton, cyclotomic_one],
-end
-
-lemma cyclotomic_prime_mul_X_sub_one (R : Type*) [comm_ring R] (p : ℕ) [hn : fact (nat.prime p)] :
-  (cyclotomic p R) * (X - 1) = X ^ p - 1 :=
-by rw [cyclotomic_eq_geom_sum hn.out, geom_sum_mul]
-
-/-- If `p ^ k` is a prime power, then `cyclotomic (p ^ (n + 1)) R = geom_sum (X ^ p ^ n) p`. -/
-lemma cyclotomic_prime_pow_eq_geom_sum {R : Type*} [comm_ring R] {p n : ℕ} (hp : nat.prime p) :
-  cyclotomic (p ^ (n + 1)) R = geom_sum (X ^ p ^ n) p :=
+/-- If `p ^ k` is a prime power, then
+`cyclotomic (p ^ (n + 1)) R = ∑ i in range p, (X ^ (p ^ n)) ^ i`. -/
+lemma cyclotomic_prime_pow_eq_geom_sum {R : Type*} [comm_ring R] {p n : ℕ} (hp : p.prime) :
+  cyclotomic (p ^ (n + 1)) R = ∑ i in finset.range p, (X ^ (p ^ n)) ^ i :=
 begin
-  have : ∀ m, cyclotomic (p ^ (m + 1)) R = geom_sum (X ^ (p ^ m)) p ↔
-    geom_sum (X ^ p ^ m) p * ∏ (x : ℕ) in finset.range (m + 1),
+  have : ∀ m, cyclotomic (p ^ (m + 1)) R = ∑ i in finset.range p, (X ^ (p ^ m)) ^ i ↔
+    (∑ i in finset.range p, (X ^ (p ^ m)) ^ i) * ∏ (x : ℕ) in finset.range (m + 1),
       cyclotomic (p ^ x) R = X ^ p ^ (m + 1) - 1,
   { intro m,
     have := eq_cyclotomic_iff (pow_pos hp.pos (m + 1)) _,
     rw eq_comm at this,
     rw [this, nat.prod_proper_divisors_prime_pow hp], },
   induction n with n_n n_ih,
-  { simp [cyclotomic_eq_geom_sum hp], },
+  { haveI := fact.mk hp, simp [cyclotomic_prime], },
   rw ((eq_cyclotomic_iff (pow_pos hp.pos (n_n.succ + 1)) _).mpr _).symm,
   rw [nat.prod_proper_divisors_prime_pow hp, finset.prod_range_succ, n_ih],
   rw this at n_ih,
-  rw [mul_comm _ (geom_sum _ _), n_ih, geom_sum_mul, sub_left_inj, ← pow_mul, pow_add, pow_one],
+  rw [mul_comm _ (∑ i in _, _), n_ih, geom_sum_mul, sub_left_inj, ← pow_mul, pow_add, pow_one],
 end
 
 lemma cyclotomic_prime_pow_mul_X_pow_sub_one (R : Type*) [comm_ring R] (p k : ℕ)
@@ -738,7 +576,7 @@ lemma cyclotomic_prime_pow_mul_X_pow_sub_one (R : Type*) [comm_ring R] (p k : 
 by rw [cyclotomic_prime_pow_eq_geom_sum hn.out, geom_sum_mul, ← pow_mul, pow_succ, mul_comm]
 
 /-- The constant term of `cyclotomic n R` is `1` if `2 ≤ n`. -/
-lemma cyclotomic_coeff_zero (R : Type*) [comm_ring R] {n : ℕ} (hn : 2 ≤ n) :
+lemma cyclotomic_coeff_zero (R : Type*) [comm_ring R] {n : ℕ} (hn : 1 < n) :
   (cyclotomic n R).coeff 0 = 1 :=
 begin
   induction n using nat.strong_induction_on with n hi,
@@ -759,10 +597,9 @@ begin
       simp only [finset.prod_const_one] },
     simp only [hrw, mul_one, zero_sub, coeff_one_zero, coeff_X_zero, coeff_sub] },
   have heq : (X ^ n - 1).coeff 0 = -(cyclotomic n R).coeff 0,
-  { rw [←prod_cyclotomic_eq_X_pow_sub_one (lt_of_lt_of_le zero_lt_two hn),
-        nat.divisors_eq_proper_divisors_insert_self_of_pos (lt_of_lt_of_le zero_lt_two hn),
-        finset.prod_insert nat.proper_divisors.not_self_mem, mul_coeff_zero, coeff_zero_prod, hprod,
-        mul_neg, mul_one] },
+  { rw [← prod_cyclotomic_eq_X_pow_sub_one (zero_le_one.trans_lt hn),
+        ← nat.cons_self_proper_divisors hn.ne_bot, finset.prod_cons, mul_coeff_zero,
+        coeff_zero_prod, hprod, mul_neg, mul_one] },
   have hzero : (X ^ n - 1).coeff 0 = (-1 : R),
   { rw coeff_zero_eq_eval_zero _,
     simp only [zero_pow (lt_of_lt_of_le zero_lt_two hn), eval_X, eval_one, zero_sub, eval_pow,
@@ -807,244 +644,10 @@ begin
     apply units.coe_eq_one.1,
     simp only [sub_eq_zero.mp hpow, zmod.coe_unit_of_coprime, units.coe_pow] },
   rw [is_root.def] at hroot,
-  rw [← prod_cyclotomic_eq_X_pow_sub_one hpos (zmod p),
-    nat.divisors_eq_proper_divisors_insert_self_of_pos hpos,
-    finset.prod_insert nat.proper_divisors.not_self_mem, eval_mul, hroot, zero_mul]
+  rw [← prod_cyclotomic_eq_X_pow_sub_one hpos (zmod p), ← nat.cons_self_proper_divisors hpos.ne',
+    finset.prod_cons, eval_mul, hroot, zero_mul]
 end
 
 end order
 
-section minpoly
-
-open is_primitive_root complex
-
-/-- The minimal polynomial of a primitive `n`-th root of unity `μ` divides `cyclotomic n ℤ`. -/
-lemma _root_.is_primitive_root.minpoly_dvd_cyclotomic {n : ℕ} {K : Type*} [field K] {μ : K}
-  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
-  minpoly ℤ μ ∣ cyclotomic n ℤ :=
-begin
-  apply minpoly.gcd_domain_dvd ℚ (is_integral h hpos) (cyclotomic.monic n ℤ).is_primitive,
-  simpa [aeval_def, eval₂_eq_eval_map, is_root.def] using is_root_cyclotomic hpos h
-end
-
-lemma _root_.is_primitive_root.minpoly_eq_cyclotomic_of_irreducible {K : Type*} [field K]
-  {R : Type*} [comm_ring R] [is_domain R] {μ : R} {n : ℕ} [algebra K R] (hμ : is_primitive_root μ n)
-  (h : irreducible $ cyclotomic n K) [ne_zero (n : K)] : cyclotomic n K = minpoly K μ :=
-begin
-  haveI := ne_zero.of_no_zero_smul_divisors K R n,
-  refine minpoly.eq_of_irreducible_of_monic h _ (cyclotomic.monic n K),
-  rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic, ←is_root.def, is_root_cyclotomic_iff]
-end
-
-/-- `cyclotomic n ℤ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
-lemma cyclotomic_eq_minpoly {n : ℕ} {K : Type*} [field K] {μ : K}
-  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
-  cyclotomic n ℤ = minpoly ℤ μ :=
-begin
-  refine eq_of_monic_of_dvd_of_nat_degree_le (minpoly.monic (is_integral h hpos))
-    (cyclotomic.monic n ℤ) (h.minpoly_dvd_cyclotomic hpos) _,
-  simpa [nat_degree_cyclotomic n ℤ] using totient_le_degree_minpoly h
-end
-
-/-- `cyclotomic n ℚ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
-lemma cyclotomic_eq_minpoly_rat {n : ℕ} {K : Type*} [field K] {μ : K}
-  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
-  cyclotomic n ℚ = minpoly ℚ μ :=
-begin
-  rw [← map_cyclotomic_int, cyclotomic_eq_minpoly h hpos],
-  exact (minpoly.gcd_domain_eq_field_fractions _ (is_integral h hpos)).symm
-end
-
-/-- `cyclotomic n ℤ` is irreducible. -/
-lemma cyclotomic.irreducible {n : ℕ} (hpos : 0 < n) : irreducible (cyclotomic n ℤ) :=
-begin
-  rw [cyclotomic_eq_minpoly (is_primitive_root_exp n hpos.ne') hpos],
-  apply minpoly.irreducible,
-  exact (is_primitive_root_exp n hpos.ne').is_integral hpos,
-end
-
-/-- `cyclotomic n ℚ` is irreducible. -/
-lemma cyclotomic.irreducible_rat {n : ℕ} (hpos : 0 < n) : irreducible (cyclotomic n ℚ) :=
-begin
-  rw [← map_cyclotomic_int],
-  exact (is_primitive.int.irreducible_iff_irreducible_map_cast (cyclotomic.is_primitive n ℤ)).1
-    (cyclotomic.irreducible hpos),
-end
-
-/-- If `n ≠ m`, then `(cyclotomic n ℚ)` and `(cyclotomic m ℚ)` are coprime. -/
-lemma cyclotomic.is_coprime_rat {n m : ℕ} (h : n ≠ m) :
-  is_coprime (cyclotomic n ℚ) (cyclotomic m ℚ) :=
-begin
-  rcases n.eq_zero_or_pos with rfl | hnzero,
-  { exact is_coprime_one_left },
-  rcases m.eq_zero_or_pos with rfl | hmzero,
-  { exact is_coprime_one_right },
-  rw (irreducible.coprime_iff_not_dvd $ cyclotomic.irreducible_rat $ hnzero),
-  exact (λ hdiv, h $ cyclotomic_injective $ eq_of_monic_of_associated (cyclotomic.monic n ℚ)
-    (cyclotomic.monic m ℚ) $ irreducible.associated_of_dvd (cyclotomic.irreducible_rat
-    hnzero) (cyclotomic.irreducible_rat hmzero) hdiv),
-end
-
-end minpoly
-
-section expand
-
-/-- If `p` is a prime such that `¬ p ∣ n`, then
-`expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R)`. -/
-@[simp] lemma cyclotomic_expand_eq_cyclotomic_mul {p n : ℕ} (hp : nat.prime p) (hdiv : ¬p ∣ n)
-  (R : Type*) [comm_ring R] :
-  expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R) :=
-begin
-  rcases nat.eq_zero_or_pos n with rfl | hnpos,
-  { simp },
-  haveI := ne_zero.of_pos hnpos,
-  suffices : expand ℤ p (cyclotomic n ℤ) = (cyclotomic (n * p) ℤ) * (cyclotomic n ℤ),
-  { rw [← map_cyclotomic_int, ← map_expand, this, polynomial.map_mul, map_cyclotomic_int] },
-  refine eq_of_monic_of_dvd_of_nat_degree_le ((cyclotomic.monic _ _).mul
-    (cyclotomic.monic _ _)) ((cyclotomic.monic n ℤ).expand hp.pos) _ _,
-  { refine (is_primitive.int.dvd_iff_map_cast_dvd_map_cast _ _ (is_primitive.mul
-      (cyclotomic.is_primitive (n * p) ℤ) (cyclotomic.is_primitive n ℤ))
-      ((cyclotomic.monic n ℤ).expand hp.pos).is_primitive).2 _,
-    rw [polynomial.map_mul, map_cyclotomic_int, map_cyclotomic_int, map_expand, map_cyclotomic_int],
-    refine is_coprime.mul_dvd (cyclotomic.is_coprime_rat (λ h, _)) _ _,
-    { replace h : n * p = n * 1 := by simp [h],
-      exact nat.prime.ne_one hp (nat.eq_of_mul_eq_mul_left hnpos h) },
-    { have hpos : 0 < n * p := mul_pos hnpos hp.pos,
-      have hprim := complex.is_primitive_root_exp _ hpos.ne',
-      rw [cyclotomic_eq_minpoly_rat hprim hpos],
-      refine @minpoly.dvd ℚ ℂ _ _ algebra_rat _ _ _,
-      rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval, ← is_root.def,
-        is_root_cyclotomic_iff],
-      convert is_primitive_root.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n),
-      rw [nat.mul_div_cancel _ (nat.prime.pos hp)] },
-    { have hprim := complex.is_primitive_root_exp _ hnpos.ne.symm,
-      rw [cyclotomic_eq_minpoly_rat hprim hnpos],
-      refine @minpoly.dvd ℚ ℂ _ _ algebra_rat _ _ _,
-      rw [aeval_def, ← eval_map, map_expand, expand_eval, ← is_root.def,
-        ← cyclotomic_eq_minpoly_rat hprim hnpos, map_cyclotomic, is_root_cyclotomic_iff],
-      exact is_primitive_root.pow_of_prime hprim hp hdiv,} },
-  { rw [nat_degree_expand, nat_degree_cyclotomic, nat_degree_mul (cyclotomic_ne_zero _ ℤ)
-      (cyclotomic_ne_zero _ ℤ), nat_degree_cyclotomic, nat_degree_cyclotomic, mul_comm n,
-      nat.totient_mul ((nat.prime.coprime_iff_not_dvd hp).2 hdiv),
-      nat.totient_prime hp, mul_comm (p - 1), ← nat.mul_succ, nat.sub_one,
-      nat.succ_pred_eq_of_pos hp.pos] }
-end
-
-/-- If `p` is a prime such that `p ∣ n`, then
-`expand R p (cyclotomic n R) = cyclotomic (p * n) R`. -/
-@[simp] lemma cyclotomic_expand_eq_cyclotomic {p n : ℕ} (hp : nat.prime p) (hdiv : p ∣ n)
-  (R : Type*) [comm_ring R] : expand R p (cyclotomic n R) = cyclotomic (n * p) R :=
-begin
-  rcases n.eq_zero_or_pos with rfl | hzero,
-  { simp },
-  haveI := ne_zero.of_pos hzero,
-  suffices : expand ℤ p (cyclotomic n ℤ) = cyclotomic (n * p) ℤ,
-  { rw [← map_cyclotomic_int, ← map_expand, this, map_cyclotomic_int] },
-  refine eq_of_monic_of_dvd_of_nat_degree_le (cyclotomic.monic _ _)
-    ((cyclotomic.monic n ℤ).expand hp.pos) _ _,
-  { have hpos := nat.mul_pos hzero hp.pos,
-    have hprim := complex.is_primitive_root_exp _ hpos.ne.symm,
-    rw [cyclotomic_eq_minpoly hprim hpos],
-    refine @minpoly.gcd_domain_dvd ℤ ℂ ℚ _ _ _ _ _ _ _ _ complex.algebra (algebra_int ℂ) _ _
-      (is_primitive_root.is_integral hprim hpos) _ ((cyclotomic.monic n ℤ).expand
-      hp.pos).is_primitive _,
-    rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval,
-        ← is_root.def, is_root_cyclotomic_iff],
-    { convert is_primitive_root.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n),
-      rw [nat.mul_div_cancel _ hp.pos] } },
-  { rw [nat_degree_expand, nat_degree_cyclotomic, nat_degree_cyclotomic, mul_comm n,
-        nat.totient_mul_of_prime_of_dvd hp hdiv, mul_comm] }
-end
-
-/-- If the `p ^ n`th cyclotomic polynomial is irreducible, so is the `p ^ m`th, for `m ≤ n`. -/
-lemma cyclotomic_irreducible_pow_of_irreducible_pow {p : ℕ} (hp : nat.prime p)
-  {R} [comm_ring R] [is_domain R] {n m : ℕ} (hmn : m ≤ n)
-  (h : irreducible (cyclotomic (p ^ n) R)) : irreducible (cyclotomic (p ^ m) R) :=
-begin
-  unfreezingI
-  { rcases m.eq_zero_or_pos with rfl | hm,
-    { simpa using irreducible_X_sub_C (1 : R) },
-    obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn,
-    induction k with k hk },
-  { simpa using h },
-  have : m + k ≠ 0 := (add_pos_of_pos_of_nonneg hm k.zero_le).ne',
-  rw [nat.add_succ, pow_succ', ←cyclotomic_expand_eq_cyclotomic hp $ dvd_pow_self p this] at h,
-  exact hk (by linarith) (of_irreducible_expand hp.ne_zero h)
-end
-
-/-- If `irreducible (cyclotomic (p ^ n) R)` then `irreducible (cyclotomic p R).` -/
-lemma cyclotomic_irreducible_of_irreducible_pow {p : ℕ} (hp : nat.prime p) {R} [comm_ring R]
-  [is_domain R] {n : ℕ} (hn : n ≠ 0) (h : irreducible (cyclotomic (p ^ n) R)) :
-  irreducible (cyclotomic p R) :=
-pow_one p ▸ cyclotomic_irreducible_pow_of_irreducible_pow hp hn.bot_lt h
-
-end expand
-
-section char_p
-
-/-- If `R` is of characteristic `p` and `¬p ∣ n`, then
-`cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1)`. -/
-lemma cyclotomic_mul_prime_eq_pow_of_not_dvd (R : Type*) {p n : ℕ} [hp : fact (nat.prime p)]
-  [ring R] [char_p R p] (hn : ¬p ∣ n) : cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1) :=
-begin
-  suffices : cyclotomic (n * p) (zmod p) = (cyclotomic n (zmod p)) ^ (p - 1),
-  { rw [← map_cyclotomic _ (algebra_map (zmod p) R), ← map_cyclotomic _ (algebra_map (zmod p) R),
-      this, polynomial.map_pow] },
-  apply mul_right_injective₀ (cyclotomic_ne_zero n $ zmod p),
-  rw [←pow_succ, tsub_add_cancel_of_le hp.out.one_lt.le, mul_comm, ← zmod.expand_card],
-  nth_rewrite 2 [← map_cyclotomic_int],
-  rw [← map_expand, cyclotomic_expand_eq_cyclotomic_mul hp.out hn, polynomial.map_mul,
-    map_cyclotomic, map_cyclotomic]
-end
-
-/-- If `R` is of characteristic `p` and `p ∣ n`, then
-`cyclotomic (n * p) R = (cyclotomic n R) ^ p`. -/
-lemma cyclotomic_mul_prime_dvd_eq_pow (R : Type*) {p n : ℕ} [hp : fact (nat.prime p)] [ring R]
-  [char_p R p] (hn : p ∣ n) : cyclotomic (n * p) R = (cyclotomic n R) ^ p :=
-begin
-  suffices : cyclotomic (n * p) (zmod p) = (cyclotomic n (zmod p)) ^ p,
-  { rw [← map_cyclotomic _ (algebra_map (zmod p) R), ← map_cyclotomic _ (algebra_map (zmod p) R),
-      this, polynomial.map_pow] },
-  rw [← zmod.expand_card, ← map_cyclotomic_int n, ← map_expand, cyclotomic_expand_eq_cyclotomic
-    hp.out hn, map_cyclotomic, mul_comm]
-end
-
-/-- If `R` is of characteristic `p` and `¬p ∣ m`, then
-`cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))`. -/
-lemma cyclotomic_mul_prime_pow_eq (R : Type*) {p m : ℕ} [fact (nat.prime p)]
-  [ring R] [char_p R p] (hm : ¬p ∣ m) :
-  ∀ {k}, 0 < k → cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))
-| 1 _ := by rw [pow_one, nat.sub_self, pow_zero, mul_comm,
-  cyclotomic_mul_prime_eq_pow_of_not_dvd R hm]
-| (a + 2) _ :=
-begin
-  have hdiv : p ∣ p ^ a.succ * m := ⟨p ^ a * m, by rw [← mul_assoc, pow_succ]⟩,
-  rw [pow_succ, mul_assoc, mul_comm, cyclotomic_mul_prime_dvd_eq_pow R hdiv,
-      cyclotomic_mul_prime_pow_eq a.succ_pos, ← pow_mul],
-  congr' 1,
-  simp only [tsub_zero, nat.succ_sub_succ_eq_sub],
-  rw [nat.mul_sub_right_distrib, mul_comm, pow_succ']
-end
-
-/-- If `R` is of characteristic `p` and `¬p ∣ m`, then `ζ` is a root of `cyclotomic (p ^ k * m) R`
- if and only if it is a primitive `m`-th root of unity. -/
-lemma is_root_cyclotomic_prime_pow_mul_iff_of_char_p {m k p : ℕ} {R : Type*} [comm_ring R]
-  [is_domain R] [hp : fact (nat.prime p)] [hchar : char_p R p] {μ : R} [ne_zero (m : R)] :
-  (polynomial.cyclotomic (p ^ k * m) R).is_root μ ↔ is_primitive_root μ m :=
-begin
-  rcases k.eq_zero_or_pos with rfl | hk,
-  { rw [pow_zero, one_mul, is_root_cyclotomic_iff] },
-  refine ⟨λ h, _, λ h, _⟩,
-  { rw [is_root.def, cyclotomic_mul_prime_pow_eq R (ne_zero.not_char_dvd R p m) hk, eval_pow] at h,
-    replace h := pow_eq_zero h,
-    rwa [← is_root.def, is_root_cyclotomic_iff] at h },
-  { rw [← is_root_cyclotomic_iff, is_root.def] at h,
-    rw [cyclotomic_mul_prime_pow_eq R (ne_zero.not_char_dvd R p m) hk,
-        is_root.def, eval_pow, h, zero_pow],
-    simp only [tsub_pos_iff_lt],
-    apply strict_mono_pow hp.out.one_lt (nat.pred_lt hk.ne') }
-end
-
-end char_p
-
 end polynomial
diff --git a/src/ring_theory/polynomial/cyclotomic/eval.lean b/src/ring_theory/polynomial/cyclotomic/eval.lean
index 88595c50e62bb..266c5c6c3698c 100644
--- a/src/ring_theory/polynomial/cyclotomic/eval.lean
+++ b/src/ring_theory/polynomial/cyclotomic/eval.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Rodriguez
 -/
 
-import ring_theory.polynomial.cyclotomic.basic
+import ring_theory.polynomial.cyclotomic.roots
 import tactic.by_contra
 import topology.algebra.polynomial
 import number_theory.padics.padic_val
@@ -12,6 +12,9 @@ import analysis.complex.arg
 
 /-!
 # Evaluating cyclotomic polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file states some results about evaluating cyclotomic polynomials in various different ways.
 ## Main definitions
 * `polynomial.eval(₂)_one_cyclotomic_prime(_pow)`: `eval 1 (cyclotomic p^k R) = p`.
@@ -26,8 +29,8 @@ open_locale big_operators
 
 @[simp] lemma eval_one_cyclotomic_prime {R : Type*} [comm_ring R] {p : ℕ} [hn : fact p.prime] :
   eval 1 (cyclotomic p R) = p :=
-by simp only [cyclotomic_eq_geom_sum hn.out, geom_sum_def, eval_X, one_pow, sum_const, eval_pow,
-              eval_finset_sum, card_range, smul_one_eq_coe]
+by simp only [cyclotomic_prime, eval_X, one_pow, finset.sum_const, eval_pow,
+              eval_finset_sum, finset.card_range, smul_one_eq_coe]
 
 @[simp] lemma eval₂_one_cyclotomic_prime {R S : Type*} [comm_ring R] [semiring S] (f : R →+* S)
   {p : ℕ} [fact p.prime] : eval₂ f 1 (cyclotomic p R) = p :=
@@ -35,8 +38,8 @@ by simp
 
 @[simp] lemma eval_one_cyclotomic_prime_pow {R : Type*} [comm_ring R] {p : ℕ} (k : ℕ)
   [hn : fact p.prime] : eval 1 (cyclotomic (p ^ (k + 1)) R) = p :=
-by simp only [cyclotomic_prime_pow_eq_geom_sum hn.out, geom_sum_def, eval_X, one_pow, sum_const,
-              eval_pow, eval_finset_sum, card_range, smul_one_eq_coe]
+by simp only [cyclotomic_prime_pow_eq_geom_sum hn.out, eval_X, one_pow, finset.sum_const,
+              eval_pow, eval_finset_sum, finset.card_range, smul_one_eq_coe]
 
 @[simp] lemma eval₂_one_cyclotomic_prime_pow {R S : Type*} [comm_ring R] [semiring S] (f : R →+* S)
   {p : ℕ} (k : ℕ) [fact p.prime] : eval₂ f 1 (cyclotomic (p ^ (k + 1)) R) = p :=
@@ -71,44 +74,40 @@ begin
   dsimp at ih,
   have := prod_cyclotomic_eq_geom_sum hn' R,
   apply_fun eval x at this,
-  rw [divisors_eq_proper_divisors_insert_self_of_pos hn', insert_sdiff_of_not_mem,
-      prod_insert, eval_mul, eval_geom_sum] at this,
-  rotate,
-  { simp only [lt_self_iff_false, mem_sdiff, not_false_iff, mem_proper_divisors, and_false,
-      false_and]},
-  { simpa only [mem_singleton] using hn''.ne' },
-  rcases lt_trichotomy 0 (geom_sum x n) with h | h | h,
-  { apply pos_of_mul_pos_right,
+  rw [← cons_self_proper_divisors hn'.ne', finset.erase_cons_of_ne _ hn''.ne',
+      finset.prod_cons, eval_mul, eval_geom_sum] at this,
+  rcases lt_trichotomy 0 (∑ i in finset.range n, x ^ i) with h | h | h,
+  { apply pos_of_mul_pos_left,
     { rwa this },
     rw eval_prod,
-    refine prod_nonneg (λ i hi, _),
-    simp only [mem_sdiff, mem_proper_divisors, mem_singleton] at hi,
-    rw geom_sum_pos_iff hn'' at h,
+    refine finset.prod_nonneg (λ i hi, _),
+    simp only [finset.mem_erase, mem_proper_divisors] at hi,
+    rw geom_sum_pos_iff hn'.ne' at h,
     cases h with hk hx,
-    { refine (ih _ hi.1.2 (nat.two_lt_of_ne _ hi.2 _)).le; rintro rfl,
-      { exact hn'.ne' (zero_dvd_iff.mp hi.1.1) },
-      { exact even_iff_not_odd.mp (even_iff_two_dvd.mpr hi.1.1) hk } },
+    { refine (ih _ hi.2.2 (nat.two_lt_of_ne _ hi.1 _)).le; rintro rfl,
+      { exact hn'.ne' (zero_dvd_iff.mp hi.2.1) },
+      { exact even_iff_not_odd.mp (even_iff_two_dvd.mpr hi.2.1) hk } },
     { rcases eq_or_ne i 2 with rfl | hk,
       { simpa only [eval_X, eval_one, cyclotomic_two, eval_add] using hx.le },
-      refine (ih _ hi.1.2 (nat.two_lt_of_ne _ hi.2 hk)).le,
+      refine (ih _ hi.2.2 (nat.two_lt_of_ne _ hi.1 hk)).le,
       rintro rfl,
-      exact (hn'.ne' $ zero_dvd_iff.mp hi.1.1) } },
-  { rw [eq_comm, geom_sum_eq_zero_iff_neg_one hn''] at h,
+      exact (hn'.ne' $ zero_dvd_iff.mp hi.2.1) } },
+  { rw [eq_comm, geom_sum_eq_zero_iff_neg_one hn'.ne'] at h,
     exact h.1.symm ▸ cyclotomic_neg_one_pos hn },
   { apply pos_of_mul_neg_left,
     { rwa this },
-    rw [geom_sum_neg_iff hn''] at h,
-    have h2 : {2} ⊆ n.proper_divisors \ {1},
-    { rw [singleton_subset_iff, mem_sdiff, mem_proper_divisors, not_mem_singleton],
-      exact ⟨⟨even_iff_two_dvd.mp h.1, hn⟩, (nat.one_lt_bit0 one_ne_zero).ne'⟩ },
-    rw [eval_prod, ←prod_sdiff h2, prod_singleton]; try { apply_instance },
+    rw geom_sum_neg_iff hn'.ne' at h,
+    have h2 : 2 ∈ n.proper_divisors.erase 1,
+    { rw [finset.mem_erase, mem_proper_divisors],
+      exact ⟨dec_trivial, even_iff_two_dvd.mp h.1, hn⟩ },
+    rw [eval_prod, ← finset.prod_erase_mul _ _ h2],
     apply mul_nonpos_of_nonneg_of_nonpos,
-    { refine prod_nonneg (λ i hi, le_of_lt _),
-      simp only [mem_sdiff, mem_proper_divisors, mem_singleton] at hi,
-      refine ih _ hi.1.1.2 (nat.two_lt_of_ne _ hi.1.2 hi.2),
+    { refine finset.prod_nonneg (λ i hi, le_of_lt _),
+      simp only [finset.mem_erase, mem_proper_divisors] at hi,
+      refine ih _ hi.2.2.2 (nat.two_lt_of_ne _ hi.2.1 hi.1),
       rintro rfl,
       rw zero_dvd_iff at hi,
-      exact hn'.ne' hi.1.1.1 },
+      exact hn'.ne' hi.2.2.1 },
     { simpa only [eval_X, eval_one, cyclotomic_two, eval_add] using h.right.le } }
 end
 
@@ -136,18 +135,17 @@ lemma cyclotomic_nonneg (n : ℕ) {R} [linear_ordered_comm_ring R] {x : R} (hx :
   0 ≤ eval x (cyclotomic n R) :=
 (cyclotomic_pos_and_nonneg n x).2 hx
 
-lemma eval_one_cyclotomic_not_prime_pow {R : Type*} [comm_ring R] {n : ℕ}
+lemma eval_one_cyclotomic_not_prime_pow {R : Type*} [ring R] {n : ℕ}
   (h : ∀ {p : ℕ}, p.prime → ∀ k : ℕ, p ^ k ≠ n) : eval 1 (cyclotomic n R) = 1 :=
 begin
   rcases n.eq_zero_or_pos with rfl | hn',
   { simp },
   have hn : 1 < n := one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn'.ne', (h nat.prime_two 0).symm⟩,
-  suffices : eval 1 (cyclotomic n ℤ) = 1 ∨ eval 1 (cyclotomic n ℤ) = -1,
-  { cases this with h h,
-    { have := eval_int_cast_map (int.cast_ring_hom R) (cyclotomic n ℤ) 1,
-      simpa only [map_cyclotomic, int.cast_one, h, ring_hom.eq_int_cast] using this },
-    { exfalso,
-      linarith [cyclotomic_nonneg n (le_refl (1 : ℤ))] }, },
+  rsuffices (h | h) : eval 1 (cyclotomic n ℤ) = 1 ∨ eval 1 (cyclotomic n ℤ) = -1,
+  { have := eval_int_cast_map (int.cast_ring_hom R) (cyclotomic n ℤ) 1,
+    simpa only [map_cyclotomic, int.cast_one, h, eq_int_cast] using this },
+  { exfalso,
+    linarith [cyclotomic_nonneg n (le_refl (1 : ℤ))] },
   rw [←int.nat_abs_eq_nat_abs_iff, int.nat_abs_one, nat.eq_one_iff_not_exists_prime_dvd],
   intros p hp hpe,
   haveI := fact.mk hp,
@@ -155,30 +153,28 @@ begin
   have hpn : p ∣ n,
   { apply hpe.trans,
     nth_rewrite 1 ←int.nat_abs_of_nat n,
-    rw [int.nat_abs_dvd_iff_dvd, ←int.nat_cast_eq_coe_nat,
-        ←one_geom_sum, ←eval_geom_sum, ←prod_cyclotomic_eq_geom_sum hn'],
+    rw [int.nat_abs_dvd_iff_dvd, ←one_geom_sum, ←eval_geom_sum, ←prod_cyclotomic_eq_geom_sum hn'],
     apply eval_dvd,
     apply finset.dvd_prod_of_mem,
-    simpa using and.intro hn'.ne' hn.ne' },
+    simp [hn'.ne', hn.ne'] },
 
   have := prod_cyclotomic_eq_geom_sum hn' ℤ,
   apply_fun eval 1 at this,
-  rw [eval_geom_sum, one_geom_sum, eval_prod, eq_comm,
-      ←finset.prod_sdiff $ range_pow_padic_val_nat_subset_divisors' p, finset.prod_image] at this,
+  rw [eval_geom_sum, one_geom_sum, eval_prod, eq_comm, ←finset.prod_sdiff $
+        @range_pow_padic_val_nat_subset_divisors' p _ _, finset.prod_image] at this,
   simp_rw [eval_one_cyclotomic_prime_pow, finset.prod_const, finset.card_range, mul_comm] at this,
   rw [←finset.prod_sdiff $ show {n} ⊆ _, from _] at this,
   any_goals {apply_instance},
   swap,
-  { simp only [not_exists, true_and, exists_prop, dvd_rfl, finset.mem_image, finset.mem_range,
-    finset.mem_singleton, finset.singleton_subset_iff, finset.mem_sdiff, nat.mem_divisors, not_and],
-    exact ⟨⟨hn'.ne', hn.ne'⟩, λ t _, h hp _⟩ },
+  { simp only [singleton_subset_iff, mem_sdiff, mem_erase, ne.def, mem_divisors, dvd_refl,
+      true_and, mem_image, mem_range, exists_prop, not_exists, not_and],
+    exact ⟨⟨hn.ne', hn'.ne'⟩, λ t _, h hp _⟩ },
   rw [←int.nat_abs_of_nat p, int.nat_abs_dvd_iff_dvd] at hpe,
   obtain ⟨t, ht⟩ := hpe,
   rw [finset.prod_singleton, ht, mul_left_comm, mul_comm, ←mul_assoc, mul_assoc] at this,
-  simp only [int.nat_cast_eq_coe_nat] at *,
   have : (p ^ (padic_val_nat p n) * p : ℤ) ∣ n := ⟨_, this⟩,
   simp only [←pow_succ', ←int.nat_abs_dvd_iff_dvd, int.nat_abs_of_nat, int.nat_abs_pow] at this,
-  exact pow_succ_padic_val_nat_not_dvd hn' this,
+  exact pow_succ_padic_val_nat_not_dvd hn'.ne' this,
   { rintro x - y - hxy,
     apply nat.succ_injective,
     exact nat.pow_right_injective hp.two_le hxy }
@@ -189,7 +185,7 @@ lemma sub_one_pow_totient_lt_cyclotomic_eval {n : ℕ} {q : ℝ} (hn' : 2 ≤ n)
 begin
   have hn : 0 < n := pos_of_gt hn',
   have hq := zero_lt_one.trans hq',
-  have hfor : ∀ ζ' ∈ primitive_roots n ℂ, q - 1 ≤ ∥↑q - ζ'∥,
+  have hfor : ∀ ζ' ∈ primitive_roots n ℂ, q - 1 ≤ ‖↑q - ζ'‖,
   { intros ζ' hζ',
     rw mem_primitive_roots hn at hζ',
     convert norm_sub_norm_le (↑q) ζ',
@@ -197,11 +193,11 @@ begin
     { rw [hζ'.norm'_eq_one hn.ne'] } },
   let ζ := complex.exp (2 * ↑real.pi * complex.I / ↑n),
   have hζ : is_primitive_root ζ n := complex.is_primitive_root_exp n hn.ne',
-  have hex : ∃ ζ' ∈ primitive_roots n ℂ, q - 1 < ∥↑q - ζ'∥,
+  have hex : ∃ ζ' ∈ primitive_roots n ℂ, q - 1 < ‖↑q - ζ'‖,
   { refine ⟨ζ, (mem_primitive_roots hn).mpr hζ, _⟩,
     suffices : ¬ same_ray ℝ (q : ℂ) ζ,
     { convert lt_norm_sub_of_not_same_ray this;
-      simp [real.norm_of_nonneg hq.le, hζ.norm'_eq_one hn.ne'] },
+      simp only [hζ.norm'_eq_one hn.ne', real.norm_of_nonneg hq.le, complex.norm_real] },
     rw complex.same_ray_iff,
     push_neg,
     refine ⟨by exact_mod_cast hq.ne', hζ.ne_zero hn.ne', _⟩,
@@ -211,36 +207,44 @@ begin
     linarith [hζ.unique is_primitive_root.one] },
   have : ¬eval ↑q (cyclotomic n ℂ) = 0,
   { erw cyclotomic.eval_apply q n (algebra_map ℝ ℂ),
-    simpa using (cyclotomic_pos' n hq').ne' },
+    simpa only [complex.coe_algebra_map, complex.of_real_eq_zero]
+                using (cyclotomic_pos' n hq').ne' },
   suffices : (units.mk0 (real.to_nnreal (q - 1)) (by simp [hq'])) ^ totient n
-              < units.mk0 (∥(cyclotomic n ℂ).eval q∥₊) (by simp [this]),
+              < units.mk0 (‖(cyclotomic n ℂ).eval q‖₊) (by simp [this]),
   { simp only [←units.coe_lt_coe, units.coe_pow, units.coe_mk0, ← nnreal.coe_lt_coe, hq'.le,
                real.to_nnreal_lt_to_nnreal_iff_of_nonneg, coe_nnnorm, complex.norm_eq_abs,
                nnreal.coe_pow, real.coe_to_nnreal', max_eq_left, sub_nonneg] at this,
     convert this,
     erw [(cyclotomic.eval_apply q n (algebra_map ℝ ℂ)), eq_comm],
-    simp [cyclotomic_nonneg n hq'.le], },
+    simp only [cyclotomic_nonneg n hq'.le, complex.coe_algebra_map,
+               complex.abs_of_real, abs_eq_self], },
   simp only [cyclotomic_eq_prod_X_sub_primitive_roots hζ, eval_prod, eval_C,
              eval_X, eval_sub, nnnorm_prod, units.mk0_prod],
-  convert prod_lt_prod' _ _,
+  convert finset.prod_lt_prod' _ _,
   swap, { exact λ _, units.mk0 (real.to_nnreal (q - 1)) (by simp [hq']) },
-  { simp [complex.card_primitive_roots] },
-  { simp only [subtype.coe_mk, mem_attach, forall_true_left, subtype.forall, ←units.coe_le_coe,
-      ← nnreal.coe_le_coe, complex.abs_nonneg, hq'.le, units.coe_mk0, real.coe_to_nnreal',
-      coe_nnnorm, complex.norm_eq_abs, max_le_iff, tsub_le_iff_right],
+  { simp only [complex.card_primitive_roots, prod_const, card_attach] },
+  { simp only [subtype.coe_mk, finset.mem_attach, forall_true_left, subtype.forall,
+      ←units.coe_le_coe, ← nnreal.coe_le_coe, complex.abs.nonneg, hq'.le, units.coe_mk0,
+      real.coe_to_nnreal', coe_nnnorm, complex.norm_eq_abs, max_le_iff, tsub_le_iff_right],
     intros x hx,
-    simpa using hfor x hx, },
-  { simp only [subtype.coe_mk, mem_attach, exists_true_left, subtype.exists,
+    simpa only [and_true, tsub_le_iff_right] using hfor x hx, },
+  { simp only [subtype.coe_mk, finset.mem_attach, exists_true_left, subtype.exists,
       ← nnreal.coe_lt_coe, ← units.coe_lt_coe, units.coe_mk0 _, coe_nnnorm],
-    simpa [hq'.le] using hex, },
+    simpa only [hq'.le, real.coe_to_nnreal', max_eq_left, sub_nonneg] using hex },
 end
 
-lemma cyclotomic_eval_lt_sub_one_pow_totient {n : ℕ} {q : ℝ} (hn' : 3 ≤ n) (hq' : 1 < q) :
+lemma sub_one_pow_totient_le_cyclotomic_eval {q : ℝ} (hq' : 1 < q) :
+  ∀ n, (q - 1) ^ totient n ≤ (cyclotomic n ℝ).eval q
+| 0 := by simp only [totient_zero, pow_zero, cyclotomic_zero, eval_one]
+| 1 := by simp only [totient_one, pow_one, cyclotomic_one, eval_sub, eval_X, eval_one]
+| (n + 2) := (sub_one_pow_totient_lt_cyclotomic_eval dec_trivial hq').le
+
+lemma cyclotomic_eval_lt_add_one_pow_totient {n : ℕ} {q : ℝ} (hn' : 3 ≤ n) (hq' : 1 < q) :
   (cyclotomic n ℝ).eval q < (q + 1) ^ totient n :=
 begin
   have hn : 0 < n := pos_of_gt hn',
   have hq := zero_lt_one.trans hq',
-  have hfor : ∀ ζ' ∈ primitive_roots n ℂ, ∥↑q - ζ'∥ ≤ q + 1,
+  have hfor : ∀ ζ' ∈ primitive_roots n ℂ, ‖↑q - ζ'‖ ≤ q + 1,
   { intros ζ' hζ',
     rw mem_primitive_roots hn at hζ',
     convert norm_sub_le (↑q) ζ',
@@ -248,11 +252,11 @@ begin
     { rw [hζ'.norm'_eq_one hn.ne'] }, },
   let ζ := complex.exp (2 * ↑real.pi * complex.I / ↑n),
   have hζ : is_primitive_root ζ n := complex.is_primitive_root_exp n hn.ne',
-  have hex : ∃ ζ' ∈ primitive_roots n ℂ, ∥↑q - ζ'∥ < q + 1,
+  have hex : ∃ ζ' ∈ primitive_roots n ℂ, ‖↑q - ζ'‖ < q + 1,
   { refine ⟨ζ, (mem_primitive_roots hn).mpr hζ, _⟩,
     suffices : ¬ same_ray ℝ (q : ℂ) (-ζ),
     { convert norm_add_lt_of_not_same_ray this;
-      simp [real.norm_of_nonneg hq.le, hζ.norm'_eq_one hn.ne', -complex.norm_eq_abs] },
+        simp [abs_of_pos hq, hζ.norm'_eq_one hn.ne', -complex.norm_eq_abs] },
     rw complex.same_ray_iff,
     push_neg,
     refine ⟨by exact_mod_cast hq.ne', neg_ne_zero.mpr $ hζ.ne_zero hn.ne', _⟩,
@@ -273,7 +277,7 @@ begin
   { erw cyclotomic.eval_apply q n (algebra_map ℝ ℂ),
     simp only [complex.coe_algebra_map, complex.of_real_eq_zero],
     exact (cyclotomic_pos' n hq').ne.symm, },
-  suffices : units.mk0 (∥(cyclotomic n ℂ).eval q∥₊) (by simp [this])
+  suffices : units.mk0 (‖(cyclotomic n ℂ).eval q‖₊) (by simp [this])
            < (units.mk0 (real.to_nnreal (q + 1)) (by simp; linarith)) ^ totient n,
   { simp only [←units.coe_lt_coe, units.coe_pow, units.coe_mk0, ← nnreal.coe_lt_coe, hq'.le,
                real.to_nnreal_lt_to_nnreal_iff_of_nonneg, coe_nnnorm, complex.norm_eq_abs,
@@ -285,48 +289,43 @@ begin
     linarith },
   simp only [cyclotomic_eq_prod_X_sub_primitive_roots hζ, eval_prod, eval_C,
              eval_X, eval_sub, nnnorm_prod, units.mk0_prod],
-  convert prod_lt_prod' _ _,
+  convert finset.prod_lt_prod' _ _,
   swap, { exact λ _, units.mk0 (real.to_nnreal (q + 1)) (by simp; linarith only [hq']) },
   { simp [complex.card_primitive_roots], },
-  { simp only [subtype.coe_mk, mem_attach, forall_true_left, subtype.forall, ←units.coe_le_coe,
-      ← nnreal.coe_le_coe, complex.abs_nonneg, hq'.le, units.coe_mk0, real.coe_to_nnreal,
-      coe_nnnorm, complex.norm_eq_abs, max_le_iff],
+  { simp only [subtype.coe_mk, finset.mem_attach, forall_true_left, subtype.forall,
+      ←units.coe_le_coe, ← nnreal.coe_le_coe, complex.abs.nonneg, hq'.le, units.coe_mk0,
+      real.coe_to_nnreal, coe_nnnorm, complex.norm_eq_abs, max_le_iff],
     intros x hx,
     have : complex.abs _ ≤ _ := hfor x hx,
     simp [this], },
-  { simp only [subtype.coe_mk, mem_attach, exists_true_left, subtype.exists,
+  { simp only [subtype.coe_mk, finset.mem_attach, exists_true_left, subtype.exists,
       ← nnreal.coe_lt_coe, ← units.coe_lt_coe, units.coe_mk0 _, coe_nnnorm],
     obtain ⟨ζ, hζ, hhζ : complex.abs _ < _⟩ := hex,
     exact ⟨ζ, hζ, by simp [hhζ]⟩ },
 end
 
-lemma sub_one_lt_nat_abs_cyclotomic_eval {n : ℕ} {q : ℕ} (hn' : 1 < n) (hq' : q ≠ 1) :
-  q - 1 < ((cyclotomic n ℤ).eval ↑q).nat_abs :=
+lemma cyclotomic_eval_le_add_one_pow_totient {q : ℝ} (hq' : 1 < q) :
+  ∀ n, (cyclotomic n ℝ).eval q ≤ (q + 1) ^ totient n
+| 0 := by simp
+| 1 := by simp [add_assoc, add_nonneg, zero_le_one]
+| 2 := by simp
+| (n + 3) := (cyclotomic_eval_lt_add_one_pow_totient dec_trivial hq').le
+
+lemma sub_one_pow_totient_lt_nat_abs_cyclotomic_eval {n : ℕ} {q : ℕ} (hn' : 1 < n) (hq : q ≠ 1) :
+  (q - 1) ^ totient n < ((cyclotomic n ℤ).eval ↑q).nat_abs :=
 begin
-  rcases q with _ | _ | q,
-  iterate 2
-  { rw [pos_iff_ne_zero, ne.def, int.nat_abs_eq_zero],
-    intro h,
-    have := degree_eq_one_of_irreducible_of_root (cyclotomic.irreducible (pos_of_gt hn')) h,
-    rw [degree_cyclotomic, with_top.coe_eq_one, totient_eq_one_iff] at this,
-    rcases this with rfl|rfl; simpa using h },
-  suffices : (q.succ : ℝ) < (eval (↑q + 1 + 1) (cyclotomic n ℤ)).nat_abs,
-  { exact_mod_cast this },
-  calc _ ≤ ((q + 2 - 1) ^ n.totient : ℝ) : _
-    ...  < _ : _,
-  { norm_num,
-    convert pow_mono (by simp : 1 ≤ (q : ℝ) + 1) (totient_pos (pos_of_gt hn') : 1 ≤ n.totient),
-    { simp },
-    { ring }, },
-  convert sub_one_pow_totient_lt_cyclotomic_eval (show 2 ≤ n, by linarith)
-                          (show (1 : ℝ) < q + 2, by {norm_cast, linarith}),
-  norm_cast,
-  erw cyclotomic.eval_apply (q + 2 : ℤ) n (algebra_map ℤ ℝ),
-  simp only [int.coe_nat_succ, ring_hom.eq_int_cast],
-  norm_cast,
-  rw [int.coe_nat_abs_eq_normalize, int.normalize_of_nonneg],
-  simp only [int.coe_nat_succ],
-  exact cyclotomic_nonneg n (by linarith),
+  rcases hq.lt_or_lt.imp_left nat.lt_one_iff.mp with rfl | hq',
+  { rw [zero_tsub, zero_pow (nat.totient_pos (pos_of_gt hn')), pos_iff_ne_zero, int.nat_abs_ne_zero,
+      nat.cast_zero, ← coeff_zero_eq_eval_zero, cyclotomic_coeff_zero _ hn'],
+    exact one_ne_zero },
+  rw [← @nat.cast_lt ℝ, nat.cast_pow, nat.cast_sub hq'.le, nat.cast_one, int.cast_nat_abs],
+  refine (sub_one_pow_totient_lt_cyclotomic_eval hn' (nat.one_lt_cast.2 hq')).trans_le _,
+  exact (cyclotomic.eval_apply (q : ℤ) n (algebra_map ℤ ℝ)).trans_le (le_abs_self _)
 end
 
+lemma sub_one_lt_nat_abs_cyclotomic_eval {n : ℕ} {q : ℕ} (hn' : 1 < n) (hq : q ≠ 1) :
+  q - 1 < ((cyclotomic n ℤ).eval ↑q).nat_abs :=
+calc q - 1 ≤ (q - 1) ^ totient n : nat.le_self_pow (nat.totient_pos $ pos_of_gt hn').ne' _
+... < ((cyclotomic n ℤ).eval ↑q).nat_abs : sub_one_pow_totient_lt_nat_abs_cyclotomic_eval hn' hq
+
 end polynomial
diff --git a/src/ring_theory/polynomial/cyclotomic/expand.lean b/src/ring_theory/polynomial/cyclotomic/expand.lean
new file mode 100644
index 0000000000000..72a5e23858061
--- /dev/null
+++ b/src/ring_theory/polynomial/cyclotomic/expand.lean
@@ -0,0 +1,192 @@
+/-
+Copyright (c) 2020 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca
+-/
+
+import ring_theory.polynomial.cyclotomic.roots
+
+/-!
+# Cyclotomic polynomials and `expand`.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We gather results relating cyclotomic polynomials and `expand`.
+
+## Main results
+
+* `polynomial.cyclotomic_expand_eq_cyclotomic_mul` : If `p` is a prime such that `¬ p ∣ n`, then
+  `expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R)`.
+* `polynomial.cyclotomic_expand_eq_cyclotomic` : If `p` is a prime such that `p ∣ n`, then
+  `expand R p (cyclotomic n R) = cyclotomic (p * n) R`.
+* `polynomial.cyclotomic_mul_prime_eq_pow_of_not_dvd` : If `R` is of characteristic `p` and
+  `¬p ∣ n`, then `cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1)`.
+* `polynomial.cyclotomic_mul_prime_dvd_eq_pow` : If `R` is of characteristic `p` and `p ∣ n`, then
+  `cyclotomic (n * p) R = (cyclotomic n R) ^ p`.
+* `polynomial.cyclotomic_mul_prime_pow_eq` : If `R` is of characteristic `p` and `¬p ∣ m`, then
+  `cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))`.
+* `polynomial.cyclotomic_mul_prime_pow_eq` : If `R` is of characteristic `p` and `¬p ∣ m`, then
+  `cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))`.
+-/
+
+namespace polynomial
+
+/-- If `p` is a prime such that `¬ p ∣ n`, then
+`expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R)`. -/
+@[simp] lemma cyclotomic_expand_eq_cyclotomic_mul {p n : ℕ} (hp : nat.prime p) (hdiv : ¬p ∣ n)
+  (R : Type*) [comm_ring R] :
+  expand R p (cyclotomic n R) = (cyclotomic (n * p) R) * (cyclotomic n R) :=
+begin
+  rcases nat.eq_zero_or_pos n with rfl | hnpos,
+  { simp },
+  haveI := ne_zero.of_pos hnpos,
+  suffices : expand ℤ p (cyclotomic n ℤ) = (cyclotomic (n * p) ℤ) * (cyclotomic n ℤ),
+  { rw [← map_cyclotomic_int, ← map_expand, this, polynomial.map_mul, map_cyclotomic_int] },
+  refine eq_of_monic_of_dvd_of_nat_degree_le ((cyclotomic.monic _ _).mul
+    (cyclotomic.monic _ _)) ((cyclotomic.monic n ℤ).expand hp.pos) _ _,
+  { refine (is_primitive.int.dvd_iff_map_cast_dvd_map_cast _ _ (is_primitive.mul
+      (cyclotomic.is_primitive (n * p) ℤ) (cyclotomic.is_primitive n ℤ))
+      ((cyclotomic.monic n ℤ).expand hp.pos).is_primitive).2 _,
+    rw [polynomial.map_mul, map_cyclotomic_int, map_cyclotomic_int, map_expand, map_cyclotomic_int],
+    refine is_coprime.mul_dvd (cyclotomic.is_coprime_rat (λ h, _)) _ _,
+    { replace h : n * p = n * 1 := by simp [h],
+      exact nat.prime.ne_one hp (mul_left_cancel₀ hnpos.ne' h) },
+    { have hpos : 0 < n * p := mul_pos hnpos hp.pos,
+      have hprim := complex.is_primitive_root_exp _ hpos.ne',
+      rw [cyclotomic_eq_minpoly_rat hprim hpos],
+      refine @minpoly.dvd ℚ ℂ _ _ algebra_rat _ _ _,
+      rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval, ← is_root.def,
+        is_root_cyclotomic_iff],
+      convert is_primitive_root.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n),
+      rw [nat.mul_div_cancel _ (nat.prime.pos hp)] },
+    { have hprim := complex.is_primitive_root_exp _ hnpos.ne.symm,
+      rw [cyclotomic_eq_minpoly_rat hprim hnpos],
+      refine @minpoly.dvd ℚ ℂ _ _ algebra_rat _ _ _,
+      rw [aeval_def, ← eval_map, map_expand, expand_eval, ← is_root.def,
+        ← cyclotomic_eq_minpoly_rat hprim hnpos, map_cyclotomic, is_root_cyclotomic_iff],
+      exact is_primitive_root.pow_of_prime hprim hp hdiv,} },
+  { rw [nat_degree_expand, nat_degree_cyclotomic, nat_degree_mul (cyclotomic_ne_zero _ ℤ)
+      (cyclotomic_ne_zero _ ℤ), nat_degree_cyclotomic, nat_degree_cyclotomic, mul_comm n,
+      nat.totient_mul ((nat.prime.coprime_iff_not_dvd hp).2 hdiv),
+      nat.totient_prime hp, mul_comm (p - 1), ← nat.mul_succ, nat.sub_one,
+      nat.succ_pred_eq_of_pos hp.pos] }
+end
+
+/-- If `p` is a prime such that `p ∣ n`, then
+`expand R p (cyclotomic n R) = cyclotomic (p * n) R`. -/
+@[simp] lemma cyclotomic_expand_eq_cyclotomic {p n : ℕ} (hp : nat.prime p) (hdiv : p ∣ n)
+  (R : Type*) [comm_ring R] : expand R p (cyclotomic n R) = cyclotomic (n * p) R :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hzero,
+  { simp },
+  haveI := ne_zero.of_pos hzero,
+  suffices : expand ℤ p (cyclotomic n ℤ) = cyclotomic (n * p) ℤ,
+  { rw [← map_cyclotomic_int, ← map_expand, this, map_cyclotomic_int] },
+  refine eq_of_monic_of_dvd_of_nat_degree_le (cyclotomic.monic _ _)
+    ((cyclotomic.monic n ℤ).expand hp.pos) _ _,
+  { have hpos := nat.mul_pos hzero hp.pos,
+    have hprim := complex.is_primitive_root_exp _ hpos.ne.symm,
+    rw [cyclotomic_eq_minpoly hprim hpos],
+    refine minpoly.is_integrally_closed_dvd (hprim.is_integral hpos) _,
+    rw [aeval_def, ← eval_map, map_expand, map_cyclotomic, expand_eval,
+        ← is_root.def, is_root_cyclotomic_iff],
+    { convert is_primitive_root.pow_of_dvd hprim hp.ne_zero (dvd_mul_left p n),
+      rw [nat.mul_div_cancel _ hp.pos] } },
+  { rw [nat_degree_expand, nat_degree_cyclotomic, nat_degree_cyclotomic, mul_comm n,
+        nat.totient_mul_of_prime_of_dvd hp hdiv, mul_comm] }
+end
+
+/-- If the `p ^ n`th cyclotomic polynomial is irreducible, so is the `p ^ m`th, for `m ≤ n`. -/
+lemma cyclotomic_irreducible_pow_of_irreducible_pow {p : ℕ} (hp : nat.prime p)
+  {R} [comm_ring R] [is_domain R] {n m : ℕ} (hmn : m ≤ n)
+  (h : irreducible (cyclotomic (p ^ n) R)) : irreducible (cyclotomic (p ^ m) R) :=
+begin
+  unfreezingI
+  { rcases m.eq_zero_or_pos with rfl | hm,
+    { simpa using irreducible_X_sub_C (1 : R) },
+    obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le hmn,
+    induction k with k hk },
+  { simpa using h },
+  have : m + k ≠ 0 := (add_pos_of_pos_of_nonneg hm k.zero_le).ne',
+  rw [nat.add_succ, pow_succ', ←cyclotomic_expand_eq_cyclotomic hp $ dvd_pow_self p this] at h,
+  exact hk (by linarith) (of_irreducible_expand hp.ne_zero h)
+end
+
+/-- If `irreducible (cyclotomic (p ^ n) R)` then `irreducible (cyclotomic p R).` -/
+lemma cyclotomic_irreducible_of_irreducible_pow {p : ℕ} (hp : nat.prime p) {R} [comm_ring R]
+  [is_domain R] {n : ℕ} (hn : n ≠ 0) (h : irreducible (cyclotomic (p ^ n) R)) :
+  irreducible (cyclotomic p R) :=
+pow_one p ▸ cyclotomic_irreducible_pow_of_irreducible_pow hp hn.bot_lt h
+
+section char_p
+
+/-- If `R` is of characteristic `p` and `¬p ∣ n`, then
+`cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1)`. -/
+lemma cyclotomic_mul_prime_eq_pow_of_not_dvd (R : Type*) {p n : ℕ} [hp : fact (nat.prime p)]
+  [ring R] [char_p R p] (hn : ¬p ∣ n) : cyclotomic (n * p) R = (cyclotomic n R) ^ (p - 1) :=
+begin
+  letI : algebra (zmod p) R := zmod.algebra _ _,
+  suffices : cyclotomic (n * p) (zmod p) = (cyclotomic n (zmod p)) ^ (p - 1),
+  { rw [← map_cyclotomic _ (algebra_map (zmod p) R), ← map_cyclotomic _ (algebra_map (zmod p) R),
+      this, polynomial.map_pow] },
+  apply mul_right_injective₀ (cyclotomic_ne_zero n $ zmod p),
+  rw [←pow_succ, tsub_add_cancel_of_le hp.out.one_lt.le, mul_comm, ← zmod.expand_card],
+  nth_rewrite 2 [← map_cyclotomic_int],
+  rw [← map_expand, cyclotomic_expand_eq_cyclotomic_mul hp.out hn, polynomial.map_mul,
+    map_cyclotomic, map_cyclotomic]
+end
+
+/-- If `R` is of characteristic `p` and `p ∣ n`, then
+`cyclotomic (n * p) R = (cyclotomic n R) ^ p`. -/
+lemma cyclotomic_mul_prime_dvd_eq_pow (R : Type*) {p n : ℕ} [hp : fact (nat.prime p)] [ring R]
+  [char_p R p] (hn : p ∣ n) : cyclotomic (n * p) R = (cyclotomic n R) ^ p :=
+begin
+  letI : algebra (zmod p) R := zmod.algebra _ _,
+  suffices : cyclotomic (n * p) (zmod p) = (cyclotomic n (zmod p)) ^ p,
+  { rw [← map_cyclotomic _ (algebra_map (zmod p) R), ← map_cyclotomic _ (algebra_map (zmod p) R),
+      this, polynomial.map_pow] },
+  rw [← zmod.expand_card, ← map_cyclotomic_int n, ← map_expand, cyclotomic_expand_eq_cyclotomic
+    hp.out hn, map_cyclotomic, mul_comm]
+end
+
+/-- If `R` is of characteristic `p` and `¬p ∣ m`, then
+`cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))`. -/
+lemma cyclotomic_mul_prime_pow_eq (R : Type*) {p m : ℕ} [fact (nat.prime p)]
+  [ring R] [char_p R p] (hm : ¬p ∣ m) :
+  ∀ {k}, 0 < k → cyclotomic (p ^ k * m) R = (cyclotomic m R) ^ (p ^ k - p ^ (k - 1))
+| 1 _ := by rw [pow_one, nat.sub_self, pow_zero, mul_comm,
+  cyclotomic_mul_prime_eq_pow_of_not_dvd R hm]
+| (a + 2) _ :=
+begin
+  have hdiv : p ∣ p ^ a.succ * m := ⟨p ^ a * m, by rw [← mul_assoc, pow_succ]⟩,
+  rw [pow_succ, mul_assoc, mul_comm, cyclotomic_mul_prime_dvd_eq_pow R hdiv,
+      cyclotomic_mul_prime_pow_eq a.succ_pos, ← pow_mul],
+  congr' 1,
+  simp only [tsub_zero, nat.succ_sub_succ_eq_sub],
+  rw [nat.mul_sub_right_distrib, mul_comm, pow_succ']
+end
+
+/-- If `R` is of characteristic `p` and `¬p ∣ m`, then `ζ` is a root of `cyclotomic (p ^ k * m) R`
+ if and only if it is a primitive `m`-th root of unity. -/
+lemma is_root_cyclotomic_prime_pow_mul_iff_of_char_p {m k p : ℕ} {R : Type*} [comm_ring R]
+  [is_domain R] [hp : fact (nat.prime p)] [hchar : char_p R p] {μ : R} [ne_zero (m : R)] :
+  (polynomial.cyclotomic (p ^ k * m) R).is_root μ ↔ is_primitive_root μ m :=
+begin
+  letI : algebra (zmod p) R := zmod.algebra _ _,
+  rcases k.eq_zero_or_pos with rfl | hk,
+  { rw [pow_zero, one_mul, is_root_cyclotomic_iff] },
+  refine ⟨λ h, _, λ h, _⟩,
+  { rw [is_root.def, cyclotomic_mul_prime_pow_eq R (ne_zero.not_char_dvd R p m) hk, eval_pow] at h,
+    replace h := pow_eq_zero h,
+    rwa [← is_root.def, is_root_cyclotomic_iff] at h },
+  { rw [← is_root_cyclotomic_iff, is_root.def] at h,
+    rw [cyclotomic_mul_prime_pow_eq R (ne_zero.not_char_dvd R p m) hk,
+        is_root.def, eval_pow, h, zero_pow],
+    simp only [tsub_pos_iff_lt],
+    apply pow_strict_mono_right hp.out.one_lt (nat.pred_lt hk.ne') }
+end
+
+end char_p
+
+end polynomial
diff --git a/src/ring_theory/polynomial/cyclotomic/roots.lean b/src/ring_theory/polynomial/cyclotomic/roots.lean
new file mode 100644
index 0000000000000..41e73830f5ffc
--- /dev/null
+++ b/src/ring_theory/polynomial/cyclotomic/roots.lean
@@ -0,0 +1,247 @@
+/-
+Copyright (c) 2020 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca
+-/
+
+import ring_theory.polynomial.cyclotomic.basic
+import ring_theory.roots_of_unity.minpoly
+
+/-!
+# Roots of cyclotomic polynomials.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We gather results about roots of cyclotomic polynomials. In particular we show in
+`polynomial.cyclotomic_eq_minpoly` that `cyclotomic n R` is the minimal polynomial of a primitive
+root of unity.
+
+## Main results
+
+* `is_primitive_root.is_root_cyclotomic` : Any `n`-th primitive root of unity is a root of
+  `cyclotomic n R`.
+* `is_root_cyclotomic_iff` : if `ne_zero (n : R)`, then `μ` is a root of `cyclotomic n R`
+  if and only if `μ` is a primitive root of unity.
+* `polynomial.cyclotomic_eq_minpoly` : `cyclotomic n ℤ` is the minimal polynomial of a primitive
+  `n`-th root of unity `μ`.
+* `polynomial.cyclotomic.irreducible` : `cyclotomic n ℤ` is irreducible.
+
+## Implementation details
+
+To prove `polynomial.cyclotomic.irreducible`, the irreducibility of `cyclotomic n ℤ`, we show in
+`polynomial.cyclotomic_eq_minpoly` that `cyclotomic n ℤ` is the minimal polynomial of any `n`-th
+primitive root of unity `μ : K`, where `K` is a field of characteristic `0`.
+-/
+
+open_locale big_operators
+
+namespace polynomial
+
+variables {R : Type*} [comm_ring R] {n : ℕ}
+
+lemma is_root_of_unity_of_root_cyclotomic {ζ : R} {i : ℕ}
+  (hi : i ∈ n.divisors) (h : (cyclotomic i R).is_root ζ) : ζ ^ n = 1 :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hn,
+  { exact pow_zero _ },
+  have := congr_arg (eval ζ) (prod_cyclotomic_eq_X_pow_sub_one hn R).symm,
+  rw [eval_sub, eval_pow, eval_X, eval_one] at this,
+  convert eq_add_of_sub_eq' this,
+  convert (add_zero _).symm,
+  apply eval_eq_zero_of_dvd_of_eval_eq_zero _ h,
+  exact finset.dvd_prod_of_mem _ hi
+end
+
+section is_domain
+
+variable [is_domain R]
+
+lemma _root_.is_root_of_unity_iff (h : 0 < n) (R : Type*) [comm_ring R] [is_domain R]
+  {ζ : R} : ζ ^ n = 1 ↔ ∃ i ∈ n.divisors, (cyclotomic i R).is_root ζ :=
+by rw [←mem_nth_roots h, nth_roots, mem_roots $ X_pow_sub_C_ne_zero h _,
+       C_1, ←prod_cyclotomic_eq_X_pow_sub_one h, is_root_prod]; apply_instance
+
+/-- Any `n`-th primitive root of unity is a root of `cyclotomic n R`.-/
+lemma _root_.is_primitive_root.is_root_cyclotomic (hpos : 0 < n) {μ : R}
+  (h : is_primitive_root μ n) : is_root (cyclotomic n R) μ :=
+begin
+  rw [← mem_roots (cyclotomic_ne_zero n R),
+      cyclotomic_eq_prod_X_sub_primitive_roots h, roots_prod_X_sub_C, ← finset.mem_def],
+  rwa [← mem_primitive_roots hpos] at h,
+end
+
+private lemma is_root_cyclotomic_iff' {n : ℕ} {K : Type*} [field K] {μ : K} [ne_zero (n : K)] :
+  is_root (cyclotomic n K) μ ↔ is_primitive_root μ n :=
+begin
+  -- in this proof, `o` stands for `order_of μ`
+  have hnpos : 0 < n := (ne_zero.of_ne_zero_coe K).out.bot_lt,
+  refine ⟨λ hμ, _, is_primitive_root.is_root_cyclotomic hnpos⟩,
+  have hμn : μ ^ n = 1,
+  { rw is_root_of_unity_iff hnpos _,
+    exact ⟨n, n.mem_divisors_self hnpos.ne', hμ⟩,
+    all_goals { apply_instance } },
+  by_contra hnμ,
+  have ho : 0 < order_of μ,
+  { apply order_of_pos',
+    rw is_of_fin_order_iff_pow_eq_one,
+    exact ⟨n, hnpos, hμn⟩ },
+  have := pow_order_of_eq_one μ,
+  rw is_root_of_unity_iff ho at this,
+  obtain ⟨i, hio, hiμ⟩ := this,
+  replace hio := nat.dvd_of_mem_divisors hio,
+  rw is_primitive_root.not_iff at hnμ,
+  rw ←order_of_dvd_iff_pow_eq_one at hμn,
+  have key  : i < n := (nat.le_of_dvd ho hio).trans_lt ((nat.le_of_dvd hnpos hμn).lt_of_ne hnμ),
+  have key' : i ∣ n := hio.trans hμn,
+  rw ←polynomial.dvd_iff_is_root at hμ hiμ,
+  have hni : {i, n} ⊆ n.divisors,
+  { simpa [finset.insert_subset, key'] using hnpos.ne' },
+  obtain ⟨k, hk⟩ := hiμ,
+  obtain ⟨j, hj⟩ := hμ,
+  have := prod_cyclotomic_eq_X_pow_sub_one hnpos K,
+  rw [←finset.prod_sdiff hni, finset.prod_pair key.ne, hk, hj] at this,
+  have hn := (X_pow_sub_one_separable_iff.mpr $ ne_zero.nat_cast_ne n K).squarefree,
+  rw [←this, squarefree] at hn,
+  contrapose! hn,
+  refine ⟨X - C μ, ⟨(∏ x in n.divisors \ {i, n}, cyclotomic x K) * k * j, by ring⟩, _⟩,
+  simp [polynomial.is_unit_iff_degree_eq_zero],
+  all_goals { apply_instance }
+end
+
+lemma is_root_cyclotomic_iff [ne_zero (n : R)] {μ : R} :
+  is_root (cyclotomic n R) μ ↔ is_primitive_root μ n :=
+begin
+  have hf : function.injective _ := is_fraction_ring.injective R (fraction_ring R),
+  haveI : ne_zero (n : fraction_ring R) := ne_zero.nat_of_injective hf,
+  rw [←is_root_map_iff hf, ←is_primitive_root.map_iff_of_injective hf, map_cyclotomic,
+      ←is_root_cyclotomic_iff']
+end
+
+lemma roots_cyclotomic_nodup [ne_zero (n : R)] : (cyclotomic n R).roots.nodup :=
+begin
+  obtain h | ⟨ζ, hζ⟩ := (cyclotomic n R).roots.empty_or_exists_mem,
+  { exact h.symm ▸ multiset.nodup_zero },
+  rw [mem_roots $ cyclotomic_ne_zero n R, is_root_cyclotomic_iff] at hζ,
+  refine multiset.nodup_of_le (roots.le_of_dvd (X_pow_sub_C_ne_zero
+    (ne_zero.pos_of_ne_zero_coe R) 1) $ cyclotomic.dvd_X_pow_sub_one n R) hζ.nth_roots_nodup,
+end
+
+lemma cyclotomic.roots_to_finset_eq_primitive_roots [ne_zero (n : R)] :
+    (⟨(cyclotomic n R).roots, roots_cyclotomic_nodup⟩ : finset _) = primitive_roots n R :=
+by { ext, simp [cyclotomic_ne_zero n R, is_root_cyclotomic_iff,
+                mem_primitive_roots, ne_zero.pos_of_ne_zero_coe R] }
+
+lemma cyclotomic.roots_eq_primitive_roots_val [ne_zero (n : R)] :
+  (cyclotomic n R).roots = (primitive_roots n R).val :=
+by rw ←cyclotomic.roots_to_finset_eq_primitive_roots
+
+/-- If `R` is of characteristic zero, then `ζ` is a root of `cyclotomic n R` if and only if it is a
+primitive `n`-th root of unity. -/
+lemma is_root_cyclotomic_iff_char_zero {n : ℕ} {R : Type*} [comm_ring R] [is_domain R]
+  [char_zero R] {μ : R} (hn : 0 < n) :
+  (polynomial.cyclotomic n R).is_root μ ↔ is_primitive_root μ n :=
+by { letI := ne_zero.of_gt hn, exact is_root_cyclotomic_iff }
+
+end is_domain
+
+/-- Over a ring `R` of characteristic zero, `λ n, cyclotomic n R` is injective. -/
+lemma cyclotomic_injective [char_zero R] :
+  function.injective (λ n, cyclotomic n R) :=
+begin
+  intros n m hnm,
+  simp only at hnm,
+  rcases eq_or_ne n 0 with rfl | hzero,
+  { rw [cyclotomic_zero] at hnm,
+    replace hnm := congr_arg nat_degree hnm,
+    rw [nat_degree_one, nat_degree_cyclotomic] at hnm,
+    by_contra,
+    exact (nat.totient_pos (zero_lt_iff.2 (ne.symm h))).ne hnm },
+  { haveI := ne_zero.mk hzero,
+    rw [← map_cyclotomic_int _ R, ← map_cyclotomic_int _ R] at hnm,
+    replace hnm := map_injective (int.cast_ring_hom R) int.cast_injective hnm,
+    replace hnm := congr_arg (map (int.cast_ring_hom ℂ)) hnm,
+    rw [map_cyclotomic_int, map_cyclotomic_int] at hnm,
+    have hprim := complex.is_primitive_root_exp _ hzero,
+    have hroot := is_root_cyclotomic_iff.2 hprim,
+    rw hnm at hroot,
+    haveI hmzero : ne_zero m := ⟨λ h, by simpa [h] using hroot⟩,
+    rw is_root_cyclotomic_iff at hroot,
+    replace hprim := hprim.eq_order_of,
+    rwa [← is_primitive_root.eq_order_of hroot] at hprim}
+end
+
+/-- The minimal polynomial of a primitive `n`-th root of unity `μ` divides `cyclotomic n ℤ`. -/
+lemma _root_.is_primitive_root.minpoly_dvd_cyclotomic {n : ℕ} {K : Type*} [field K] {μ : K}
+  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
+  minpoly ℤ μ ∣ cyclotomic n ℤ :=
+begin
+  apply minpoly.is_integrally_closed_dvd (h.is_integral hpos),
+  simpa [aeval_def, eval₂_eq_eval_map, is_root.def] using h.is_root_cyclotomic hpos
+end
+
+section minpoly
+
+open is_primitive_root complex
+
+lemma _root_.is_primitive_root.minpoly_eq_cyclotomic_of_irreducible {K : Type*} [field K]
+  {R : Type*} [comm_ring R] [is_domain R] {μ : R} {n : ℕ} [algebra K R] (hμ : is_primitive_root μ n)
+  (h : irreducible $ cyclotomic n K) [ne_zero (n : K)] : cyclotomic n K = minpoly K μ :=
+begin
+  haveI := ne_zero.of_no_zero_smul_divisors K R n,
+  refine minpoly.eq_of_irreducible_of_monic h _ (cyclotomic.monic n K),
+  rwa [aeval_def, eval₂_eq_eval_map, map_cyclotomic, ←is_root.def, is_root_cyclotomic_iff]
+end
+
+/-- `cyclotomic n ℤ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
+lemma cyclotomic_eq_minpoly {n : ℕ} {K : Type*} [field K] {μ : K}
+  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
+  cyclotomic n ℤ = minpoly ℤ μ :=
+begin
+  refine eq_of_monic_of_dvd_of_nat_degree_le (minpoly.monic (is_integral h hpos))
+    (cyclotomic.monic n ℤ) (h.minpoly_dvd_cyclotomic hpos) _,
+  simpa [nat_degree_cyclotomic n ℤ] using totient_le_degree_minpoly h
+end
+
+/-- `cyclotomic n ℚ` is the minimal polynomial of a primitive `n`-th root of unity `μ`. -/
+lemma cyclotomic_eq_minpoly_rat {n : ℕ} {K : Type*} [field K] {μ : K}
+  (h : is_primitive_root μ n) (hpos : 0 < n) [char_zero K] :
+  cyclotomic n ℚ = minpoly ℚ μ :=
+begin
+  rw [← map_cyclotomic_int, cyclotomic_eq_minpoly h hpos],
+  exact (minpoly.is_integrally_closed_eq_field_fractions' _ (is_integral h hpos)).symm
+end
+
+/-- `cyclotomic n ℤ` is irreducible. -/
+lemma cyclotomic.irreducible {n : ℕ} (hpos : 0 < n) : irreducible (cyclotomic n ℤ) :=
+begin
+  rw [cyclotomic_eq_minpoly (is_primitive_root_exp n hpos.ne') hpos],
+  apply minpoly.irreducible,
+  exact (is_primitive_root_exp n hpos.ne').is_integral hpos,
+end
+
+/-- `cyclotomic n ℚ` is irreducible. -/
+lemma cyclotomic.irreducible_rat {n : ℕ} (hpos : 0 < n) : irreducible (cyclotomic n ℚ) :=
+begin
+  rw [← map_cyclotomic_int],
+  exact (is_primitive.irreducible_iff_irreducible_map_fraction_map (cyclotomic.is_primitive n ℤ)).1
+    (cyclotomic.irreducible hpos),
+end
+
+/-- If `n ≠ m`, then `(cyclotomic n ℚ)` and `(cyclotomic m ℚ)` are coprime. -/
+lemma cyclotomic.is_coprime_rat {n m : ℕ} (h : n ≠ m) :
+  is_coprime (cyclotomic n ℚ) (cyclotomic m ℚ) :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hnzero,
+  { exact is_coprime_one_left },
+  rcases m.eq_zero_or_pos with rfl | hmzero,
+  { exact is_coprime_one_right },
+  rw (irreducible.coprime_iff_not_dvd $ cyclotomic.irreducible_rat $ hnzero),
+  exact (λ hdiv, h $ cyclotomic_injective $ eq_of_monic_of_associated (cyclotomic.monic n ℚ)
+    (cyclotomic.monic m ℚ) $ irreducible.associated_of_dvd (cyclotomic.irreducible_rat
+    hnzero) (cyclotomic.irreducible_rat hmzero) hdiv),
+end
+
+end minpoly
+
+end polynomial
diff --git a/src/ring_theory/polynomial/default.lean b/src/ring_theory/polynomial/default.lean
deleted file mode 100644
index 0b78bd13fb19a..0000000000000
--- a/src/ring_theory/polynomial/default.lean
+++ /dev/null
@@ -1 +0,0 @@
-import ring_theory.polynomial.basic
diff --git a/src/ring_theory/polynomial/dickson.lean b/src/ring_theory/polynomial/dickson.lean
index 76e01282385bd..c6cb3c157b108 100644
--- a/src/ring_theory/polynomial/dickson.lean
+++ b/src/ring_theory/polynomial/dickson.lean
@@ -5,14 +5,16 @@ Authors: Julian Kuelshammer
 -/
 import algebra.char_p.invertible
 import data.zmod.basic
-import field_theory.finite.basic
 import ring_theory.localization.fraction_ring
 import ring_theory.polynomial.chebyshev
-
+import ring_theory.ideal.local_ring
 
 /-!
 # Dickson polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The (generalised) Dickson polynomials are a family of polynomials indexed by `ℕ × ℕ`,
 with coefficients in a commutative ring `R` depending on an element `a∈R`. More precisely, the
 they satisfy the recursion `dickson k a (n + 2) = X * (dickson k a n + 1) - a * (dickson k a n)`
@@ -104,12 +106,12 @@ end
 section dickson
 /-!
 
-### A Lambda structure on `polynomial ℤ`
+### A Lambda structure on `ℤ[X]`
 
 Mathlib doesn't currently know what a Lambda ring is.
-But once it does, we can endow `polynomial ℤ` with a Lambda structure
+But once it does, we can endow `ℤ[X]` with a Lambda structure
 in terms of the `dickson 1 1` polynomials defined below.
-There is exactly one other Lambda structure on `polynomial ℤ` in terms of binomial polynomials.
+There is exactly one other Lambda structure on `ℤ[X]` in terms of binomial polynomials.
 
 -/
 
@@ -157,12 +159,12 @@ lemma dickson_one_one_mul (m n : ℕ) :
   dickson 1 (1 : R) (m * n) = (dickson 1 1 m).comp (dickson 1 1 n) :=
 begin
   have h : (1 : R) = int.cast_ring_hom R (1),
-    simp only [ring_hom.eq_int_cast, int.cast_one],
+    simp only [eq_int_cast, int.cast_one],
   rw h,
   simp only [← map_dickson (int.cast_ring_hom R), ← map_comp],
   congr' 1,
   apply map_injective (int.cast_ring_hom ℚ) int.cast_injective,
-  simp only [map_dickson, map_comp, ring_hom.eq_int_cast, int.cast_one,
+  simp only [map_dickson, map_comp, eq_int_cast, int.cast_one,
     dickson_one_one_eq_chebyshev_T, chebyshev.T_mul, two_mul, ← add_comp],
   simp only [← two_mul, ← comp_assoc],
   apply eval₂_congr rfl rfl,
@@ -200,7 +202,7 @@ begin
   apply @set.infinite.mono _ {x : K | ∃ y, x = y + y⁻¹ ∧ y ≠ 0},
   { rintro _ ⟨x, rfl, hx⟩,
     simp only [eval_X, eval_pow, set.mem_set_of_eq, @add_pow_char K _ p,
-      dickson_one_one_eval_add_inv _ _ (mul_inv_cancel hx), inv_pow₀, zmod.cast_hom_apply,
+      dickson_one_one_eval_add_inv _ _ (mul_inv_cancel hx), inv_pow, zmod.cast_hom_apply,
       zmod.cast_one'] },
   -- Now we need to show that the set of such `x` is infinite.
   -- If the set is finite, then we will show that `K` is also finite.
diff --git a/src/ring_theory/polynomial/eisenstein.lean b/src/ring_theory/polynomial/eisenstein.lean
deleted file mode 100644
index 9c7ab6a9d8edb..0000000000000
--- a/src/ring_theory/polynomial/eisenstein.lean
+++ /dev/null
@@ -1,562 +0,0 @@
-/-
-Copyright (c) 2022 Riccardo Brasca. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Riccardo Brasca
--/
-
-import ring_theory.eisenstein_criterion
-import ring_theory.integrally_closed
-import ring_theory.norm
-import ring_theory.polynomial.cyclotomic.basic
-
-/-!
-# Eisenstein polynomials
-Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]` is
-*Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
-`f.coeff 0 ∉ 𝓟 ^ 2`. In this file we gather miscellaneous results about Eisenstein polynomials.
-
-## Main definitions
-* `polynomial.is_eisenstein_at f 𝓟`: the property of being Eisenstein at `𝓟`.
-
-## Main results
-* `polynomial.is_eisenstein_at.irreducible`: if a primitive `f` satisfies `f.is_eisenstein_at 𝓟`,
-  where `𝓟.is_prime`, then `f` is irreducible.
-* `mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at`: let `K` be the field of fraction
-  of an integrally closed domain `R` and let `L` be a separable extension of `K`, generated by an
-  integral power basis `B` such that the minimal polynomial of `B.gen` is Eisenstein at `p`. Given
-  `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`, then `z ∈ adjoin R {B.gen}`.
-  Together with `algebra.discr_mul_is_integral_mem_adjoin` this result often allows to compute the
-  ring of integers of `L`.
-
-## Implementation details
-We also define a notion `is_weakly_eisenstein_at` requiring only that
-`∀ n < f.nat_degree → f.coeff n ∈ 𝓟`. This makes certain results slightly more general and it is
-useful since it is sometimes better behaved (for example it is stable under `polynomial.map`).
-
--/
-
-universes u v w z
-
-variables {R : Type u}
-
-open ideal algebra finset
-
-open_locale big_operators polynomial
-
-namespace polynomial
-
-/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
-is *weakly Eisenstein at `𝓟`* if `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟`. -/
-@[mk_iff] structure is_weakly_eisenstein_at [comm_semiring R] (f : R[X]) (𝓟 : ideal R) :
-  Prop := (mem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟)
-
-/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
-is *Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
-`f.coeff 0 ∉ 𝓟 ^ 2`. -/
-@[mk_iff] structure is_eisenstein_at [comm_semiring R] (f : R[X]) (𝓟 : ideal R) : Prop :=
-(leading : f.leading_coeff ∉ 𝓟)
-(mem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟)
-(not_mem : f.coeff 0 ∉ 𝓟 ^ 2)
-
-namespace is_weakly_eisenstein_at
-
-section comm_semiring
-
-variables [comm_semiring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_weakly_eisenstein_at 𝓟)
-
-include hf
-
-lemma map {A : Type v} [comm_ring A] (φ : R →+* A) : (f.map φ).is_weakly_eisenstein_at (𝓟.map φ) :=
-begin
-  refine (is_weakly_eisenstein_at_iff _ _).2 (λ n hn, _),
-  rw [coeff_map],
-  exact mem_map_of_mem _ (hf.mem (lt_of_lt_of_le hn (nat_degree_map_le _ _)))
-end
-
-end comm_semiring
-
-section comm_ring
-
-variables [comm_ring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_weakly_eisenstein_at 𝓟)
-variables {S : Type v} [comm_ring S] [algebra R S]
-
-section principal
-
-variable {p : R}
-
-local notation `P` := submodule.span R {p}
-
-lemma exists_mem_adjoin_mul_eq_pow_nat_degree {x : S} (hx : aeval x f = 0)
-  (hmo : f.monic) (hf : f.is_weakly_eisenstein_at P) : ∃ y ∈ adjoin R ({x} : set S),
-  (algebra_map R S) p * y = x ^ (f.map (algebra_map R S)).nat_degree :=
-begin
-  rw [aeval_def, polynomial.eval₂_eq_eval_map, eval_eq_sum_range, range_add_one,
-    sum_insert not_mem_range_self, sum_range, (hmo.map
-    (algebra_map R S)).coeff_nat_degree, one_mul] at hx,
-  replace hx := eq_neg_of_add_eq_zero hx,
-  have : ∀ n < f.nat_degree, p ∣ f.coeff n,
-  { intros n hn,
-    refine mem_span_singleton.1 (by simpa using hf.mem hn) },
-  choose! φ hφ using this,
-  conv_rhs at hx { congr, congr, skip, funext,
-    rw [fin.coe_eq_val, coeff_map, hφ i.1 (lt_of_lt_of_le i.2 (nat_degree_map_le _ _)),
-      ring_hom.map_mul, mul_assoc] },
-  rw [hx, ← mul_sum, neg_eq_neg_one_mul, ← mul_assoc (-1 : S), mul_comm (-1 : S), mul_assoc],
-  refine ⟨-1 * ∑ (i : fin (f.map (algebra_map R S)).nat_degree),
-    (algebra_map R S) (φ i.1) * x ^ i.1, _, rfl⟩,
-  exact subalgebra.mul_mem _ (subalgebra.neg_mem _ (subalgebra.one_mem _))
-    (subalgebra.sum_mem _ (λ i hi, subalgebra.mul_mem _ (subalgebra.algebra_map_mem _ _)
-    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton x)) _)))
-end
-
-lemma exists_mem_adjoin_mul_eq_pow_nat_degree_le {x : S} (hx : aeval x f = 0)
-  (hmo : f.monic) (hf : f.is_weakly_eisenstein_at P) :
-  ∀ i, (f.map (algebra_map R S)).nat_degree ≤ i →
-  ∃ y ∈ adjoin R ({x} : set S), (algebra_map R S) p * y = x ^ i :=
-begin
-  intros i hi,
-  obtain ⟨k, hk⟩ := le_iff_exists_add.1 hi,
-  rw [hk, pow_add],
-  obtain ⟨y, hy, H⟩ := exists_mem_adjoin_mul_eq_pow_nat_degree hx hmo hf,
-  refine ⟨y * x ^ k, _, _⟩,
-  { exact subalgebra.mul_mem _ hy (subalgebra.pow_mem _  (subset_adjoin (set.mem_singleton x)) _) },
-  { rw [← mul_assoc _ y, H] }
-end
-
-end principal
-
-include hf
-
-lemma pow_nat_degree_le_of_root_of_monic_mem {x : R} (hroot : is_root f x) (hmo : f.monic) :
-  ∀ i, f.nat_degree ≤ i → x ^ i ∈ 𝓟 :=
-begin
-  intros i hi,
-  obtain ⟨k, hk⟩ := le_iff_exists_add.1 hi,
-  rw [hk, pow_add],
-  suffices : x ^ f.nat_degree ∈ 𝓟,
-  { exact mul_mem_right (x ^ k) 𝓟 this },
-  rw [is_root.def, eval_eq_sum_range, finset.range_add_one, finset.sum_insert
-    finset.not_mem_range_self, finset.sum_range, hmo.coeff_nat_degree, one_mul] at hroot,
-  rw [eq_neg_of_add_eq_zero hroot, neg_mem_iff],
-  refine submodule.sum_mem _ (λ i hi,  mul_mem_right _ _ (hf.mem (fin.is_lt i)))
-end
-
-lemma pow_nat_degree_le_of_aeval_zero_of_monic_mem_map {x : S} (hx : aeval x f = 0)
-  (hmo : f.monic) :
-  ∀ i, (f.map (algebra_map R S)).nat_degree ≤ i → x ^ i ∈ 𝓟.map (algebra_map R S) :=
-begin
-  suffices : x ^ (f.map (algebra_map R S)).nat_degree ∈ 𝓟.map (algebra_map R S),
-  { intros i hi,
-    obtain ⟨k, hk⟩ := le_iff_exists_add.1 hi,
-    rw [hk, pow_add],
-    refine mul_mem_right _ _ this },
-  rw [aeval_def, eval₂_eq_eval_map, ← is_root.def] at hx,
-  refine pow_nat_degree_le_of_root_of_monic_mem (hf.map _) hx (hmo.map _) _ rfl.le
-end
-
-end comm_ring
-
-end is_weakly_eisenstein_at
-
-namespace is_eisenstein_at
-
-section comm_semiring
-
-variables [comm_semiring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_eisenstein_at 𝓟)
-
-lemma _root_.polynomial.monic.leading_coeff_not_mem (hf : f.monic) (h : 𝓟 ≠ ⊤) :
-  ¬f.leading_coeff ∈ 𝓟 :=
-hf.leading_coeff.symm ▸ (ideal.ne_top_iff_one _).1 h
-
-lemma _root_.polynomial.monic.is_eisenstein_at_of_mem_of_not_mem (hf : f.monic) (h : 𝓟 ≠ ⊤)
-  (hmem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟) (hnot_mem : f.coeff 0 ∉ 𝓟 ^ 2) :
-  f.is_eisenstein_at 𝓟 :=
-{ leading := hf.leading_coeff_not_mem h,
-  mem := λ n hn, hmem hn,
-  not_mem := hnot_mem }
-
-include hf
-
-lemma is_weakly_eisenstein_at : is_weakly_eisenstein_at f 𝓟 := ⟨hf.mem⟩
-
-lemma coeff_mem {n : ℕ} (hn : n ≠ f.nat_degree) : f.coeff n ∈ 𝓟 :=
-begin
-  cases ne_iff_lt_or_gt.1 hn,
-  { exact hf.mem h },
-  { rw [coeff_eq_zero_of_nat_degree_lt h],
-    exact ideal.zero_mem _}
-end
-
-end comm_semiring
-
-section is_domain
-
-variables [comm_ring R] [is_domain R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_eisenstein_at 𝓟)
-
-/-- If a primitive `f` satisfies `f.is_eisenstein_at 𝓟`, where `𝓟.is_prime`, then `f` is
-irreducible. -/
-lemma irreducible (hprime : 𝓟.is_prime) (hu : f.is_primitive)
-  (hfd0 : 0 < f.nat_degree) : irreducible f :=
-irreducible_of_eisenstein_criterion hprime hf.leading (λ n hn, hf.mem (coe_lt_degree.1 hn))
-  (nat_degree_pos_iff_degree_pos.1 hfd0) hf.not_mem hu
-
-end is_domain
-
-end is_eisenstein_at
-
-end polynomial
-
-section cyclotomic
-
-variables (p : ℕ)
-
-local notation `𝓟` := submodule.span ℤ {p}
-
-open polynomial
-
-lemma cyclotomic_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] :
-  ((cyclotomic p ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
-begin
-  refine monic.is_eisenstein_at_of_mem_of_not_mem _
-    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
-    nat.prime_iff_prime_int.1 hp.out) (λ i hi, _) _,
-  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
-    refine ((cyclotomic.monic p ℤ).comp (monic_X_add_C 1) (λ h, _)),
-    rw [nat_degree_X_add_C] at h,
-    exact zero_ne_one h.symm },
-  { rw [cyclotomic_eq_geom_sum hp.out, geom_sum_X_comp_X_add_one_eq_sum, ← lcoeff_apply,
-      linear_map.map_sum],
-    conv { congr, congr, skip, funext,
-      rw [lcoeff_apply, ← C_eq_nat_cast, ← monomial_eq_C_mul_X, coeff_monomial] },
-    rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C, mul_one,
-      nat_degree_cyclotomic, nat.totient_prime hp.out] at hi,
-    simp only [lt_of_lt_of_le hi (nat.sub_le _ _), int.nat_cast_eq_coe_nat, sum_ite_eq', mem_range,
-      if_true, ideal.submodule_span_eq, ideal.mem_span_singleton],
-    exact int.coe_nat_dvd.2
-      (nat.prime.dvd_choose_self (nat.succ_pos i) (lt_tsub_iff_right.1 hi) hp.out) },
-  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_eq_geom_sum hp.out, eval_add, eval_X,
-      eval_one, zero_add, eval_geom_sum, one_geom_sum, int.nat_cast_eq_coe_nat,
-      ideal.submodule_span_eq, ideal.span_singleton_pow, ideal.mem_span_singleton],
-    intro h,
-    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
-    rw [← mul_assoc, mul_one, mul_assoc] at hk,
-    nth_rewrite 0 [← nat.mul_one p] at hk,
-    rw [nat.mul_right_inj hp.out.pos] at hk,
-    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
-end
-
-lemma cyclotomic_prime_pow_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] (n : ℕ) :
-  ((cyclotomic (p ^ (n + 1)) ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
-begin
-  refine monic.is_eisenstein_at_of_mem_of_not_mem _
-    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
-    nat.prime_iff_prime_int.1 hp.out) _ _,
-  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
-    refine ((cyclotomic.monic _ ℤ).comp (monic_X_add_C 1) (λ h, _)),
-    rw [nat_degree_X_add_C] at h,
-    exact zero_ne_one h.symm },
-  { induction n with n hn,
-    { intros i hi,
-      rw [zero_add, pow_one] at hi ⊢,
-      exact (cyclotomic_comp_X_add_one_is_eisenstein_at p).mem hi },
-    { intros i hi,
-      rw [ideal.submodule_span_eq, ideal.mem_span_singleton, ← zmod.int_coe_zmod_eq_zero_iff_dvd,
-        ← int.coe_cast_ring_hom, ← coeff_map, map_comp, map_cyclotomic, polynomial.map_add, map_X,
-        polynomial.map_one, pow_add, pow_one, cyclotomic_mul_prime_dvd_eq_pow, pow_comp,
-        ← zmod.expand_card, coeff_expand hp.out.pos],
-      { simp only [ite_eq_right_iff],
-        rintro ⟨k, hk⟩,
-        rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C,
-          mul_one, nat_degree_cyclotomic, nat.totient_prime_pow hp.out (nat.succ_pos _),
-          nat.succ_sub_one] at hn hi,
-        rw [hk, pow_succ, mul_assoc] at hi,
-        rw [hk, mul_comm, nat.mul_div_cancel _ hp.out.pos],
-        replace hn := hn (lt_of_mul_lt_mul_left' hi),
-        rw [ideal.submodule_span_eq, ideal.mem_span_singleton,
-          ← zmod.int_coe_zmod_eq_zero_iff_dvd, ← int.coe_cast_ring_hom, ← coeff_map] at hn,
-        simpa [map_comp] using hn },
-      { exact ⟨p ^ n, by rw [pow_succ]⟩ } } },
-  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime_pow_eq_geom_sum hp.out, eval_add,
-      eval_X, eval_one, zero_add, geom_sum_def, eval_finset_sum],
-    simp only [eval_pow, eval_X, one_pow, sum_const, card_range, nat.smul_one_eq_coe,
-      int.nat_cast_eq_coe_nat, submodule_span_eq, ideal.submodule_span_eq,
-      ideal.span_singleton_pow, ideal.mem_span_singleton],
-    intro h,
-    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
-    rw [← mul_assoc, mul_one, mul_assoc] at hk,
-    nth_rewrite 0 [← nat.mul_one p] at hk,
-    rw [nat.mul_right_inj hp.out.pos] at hk,
-    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
-end
-
-end cyclotomic
-
-section is_integral
-
-variables {K : Type v} {L : Type z} {p : R} [comm_ring R] [field K] [field L]
-variables [algebra K L] [algebra R L] [algebra R K] [is_scalar_tower R K L] [is_separable K L]
-variables [is_domain R] [normalized_gcd_monoid R] [is_fraction_ring R K] [is_integrally_closed R]
-
-local notation `𝓟` := submodule.span R {p}
-
-open is_integrally_closed power_basis nat polynomial is_scalar_tower
-
-/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
-extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
-`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `Q : polynomial R` is such that
-`aeval B.gen Q = p • z`, then `p ∣ Q.coeff 0`. -/
-lemma dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
-  (hp : prime p) (hBint : is_integral R B.gen) {z : L} {Q : polynomial R}
-  (hQ : aeval B.gen Q = p • z) (hzint : is_integral R z)
-  (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) : p ∣ Q.coeff 0 :=
-begin
-  -- First define some abbreviations.
-  letI := B.finite_dimensional,
-  let P := minpoly R B.gen,
-  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
-  have finrank_K_L : finite_dimensional.finrank K L = B.dim := B.finrank,
-  have deg_K_P : (minpoly K B.gen).nat_degree = B.dim := B.nat_degree_minpoly,
-  have deg_R_P : P.nat_degree = B.dim,
-  { rw [← deg_K_P, minpoly.gcd_domain_eq_field_fractions K hBint,
-        (minpoly.monic hBint).nat_degree_map (algebra_map R K)] },
-  choose! f hf using hei.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
-    (minpoly.aeval R B.gen) (minpoly.monic hBint),
-  simp only [(minpoly.monic hBint).nat_degree_map, deg_R_P] at hf,
-
-  -- The Eisenstein condition shows that `p` divides `Q.coeff 0`
-  -- if `p^n.succ` divides the following multiple of `Q.coeff 0^n.succ`:
-  suffices : p ^ n.succ ∣
-    (Q.coeff 0 ^ n.succ * ((-1) ^ (n.succ * n) * (minpoly R B.gen).coeff 0 ^ n)),
-  { have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
-      hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
-    refine prime.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd hp ((_ : _ ^ n.succ ∣ _)) hndiv,
-    convert (is_unit.dvd_mul_right ⟨(-1) ^ (n.succ * n), rfl⟩).mpr this using 1,
-    push_cast,
-    ring_nf, simp [pow_right_comm _ _ 2] },
-
-  -- We claim the quotient of `Q^n * _` by `p^n` is the following `r`:
-  have aux : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0, B.dim ≤ i + n,
-  { intros i hi,
-    simp only [mem_range, mem_erase] at hi,
-    rw [hn],
-    exact le_add_pred_of_pos _ hi.1 },
-  have hintsum : is_integral R (z * B.gen ^ n -
-    ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0, Q.coeff x • f (x + n)),
-  { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
-      (is_integral.sum _ (λ i hi, (is_integral_smul _ _))),
-    exact adjoin_le_integral_closure hBint (hf _ (aux i hi)).1 },
-  obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
-  use r,
-
-  -- Do the computation in `K` so we can work in terms of `z` instead of `r`.
-  apply is_fraction_ring.injective R K,
-  simp only [_root_.map_mul, _root_.map_pow, _root_.map_neg, _root_.map_one],
-  -- Both sides are actually norms:
-  calc _ = norm K (Q.coeff 0 • B.gen ^ n) : _
-  ... = norm K (p • (z * B.gen ^ n) - ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
-          p • Q.coeff x • f (x + n))
-    : congr_arg (norm K) (eq_sub_of_add_eq _)
-  ... = _ : _,
-  { simp only [algebra.smul_def, algebra_map_apply R K L, algebra.norm_algebra_map, _root_.map_mul,
-      _root_.map_pow, finrank_K_L, power_basis.norm_gen_eq_coeff_zero_minpoly,
-      minpoly.gcd_domain_eq_field_fractions K hBint, coeff_map, ← hn],
-    ring_exp },
-  swap, { simp_rw [← smul_sum, ← smul_sub, algebra.smul_def p, algebra_map_apply R K L,
-      _root_.map_mul, algebra.norm_algebra_map, finrank_K_L, hr, ← hn] },
-
-  calc _ = (Q.coeff 0 • 1 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
-              Q.coeff x • B.gen ^ x) * B.gen ^ n : _
-  ... = (Q.coeff 0 • B.gen ^ 0 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
-              Q.coeff x • B.gen ^ x) * B.gen ^ n : by rw pow_zero
-  ... = (aeval B.gen Q) * B.gen ^ n : _
-  ... = _ : by rw [hQ, algebra.smul_mul_assoc],
-  { have : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0,
-      Q.coeff i • (B.gen ^ i * B.gen ^ n) =
-      p • Q.coeff i • f (i + n),
-    { intros i hi,
-      rw [←pow_add, ←(hf _ (aux i hi)).2, ←algebra.smul_def, smul_smul, mul_comm _ p, smul_smul] },
-    simp only [add_mul, smul_mul_assoc, one_mul, sum_mul, sum_congr rfl this] },
-  { rw [aeval_eq_sum_range,
-        finset.add_sum_erase (range (Q.nat_degree + 1)) (λ i, Q.coeff i • B.gen ^ i)],
-    simp },
-end
-
-lemma mem_adjoin_of_dvd_coeff_of_dvd_aeval {A B : Type*} [comm_semiring A] [comm_ring B]
-  [algebra A B] [no_zero_smul_divisors A B] {Q : polynomial A} {p : A} {x z : B} (hp : p ≠ 0)
-  (hQ : ∀ i ∈ range (Q.nat_degree + 1), p ∣ Q.coeff i) (hz : aeval x Q = p • z) :
-  z ∈ adjoin A ({x} : set B) :=
-begin
-  choose! f hf using hQ,
-  rw [aeval_eq_sum_range, sum_range] at hz,
-  conv_lhs at hz { congr, skip, funext,
-    rw [hf i (mem_range.2 (fin.is_lt i)), ← smul_smul] },
-  rw [← smul_sum] at hz,
-  rw [← smul_right_injective _ hp hz],
-  exact subalgebra.sum_mem _ (λ _ _, subalgebra.smul_mem _
-    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton _)) _) _)
-end
-
-/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
-extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
-`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p • z ∈ adjoin R {B.gen}`, then
-`z ∈ adjoin R {B.gen}`. -/
-lemma mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
-  (hp : prime p) (hBint : is_integral R B.gen) {z : L} (hzint : is_integral R z)
-  (hz : p • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
-  z ∈ adjoin R ({B.gen} : set L) :=
-begin
-  -- First define some abbreviations.
-  have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
-    hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
-  letI := finite_dimensional B,
-  set P := minpoly R B.gen with hP,
-  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
-  haveI : no_zero_smul_divisors R L := no_zero_smul_divisors.trans R K L,
-  let P₁ := P.map (algebra_map R L),
-
-  -- There is a polynomial `Q` such that `p • z = aeval B.gen Q`. We can assume that
-  -- `Q.degree < P.degree` and `Q ≠ 0`.
-  rw [adjoin_singleton_eq_range_aeval] at hz,
-  obtain ⟨Q₁, hQ⟩ := hz,
-  set Q := Q₁ %ₘ P with hQ₁,
-  replace hQ : aeval B.gen Q = p • z,
-  { rw [← mod_by_monic_add_div Q₁ (minpoly.monic hBint)] at hQ,
-    simpa using hQ },
-  by_cases hQzero : Q = 0,
-  { simp only [hQzero, algebra.smul_def, zero_eq_mul, aeval_zero] at hQ,
-    cases hQ with H H₁,
-    { have : function.injective (algebra_map R L),
-      { rw [algebra_map_eq R K L],
-        exact (algebra_map K L).injective.comp (is_fraction_ring.injective R K) },      exfalso,
-      exact hp.ne_zero ((injective_iff_map_eq_zero _).1 this _ H) },
-    { rw [H₁],
-      exact subalgebra.zero_mem _ } },
-
-  -- It is enough to prove that all coefficients of `Q` are divisible by `p`, by induction.
-  -- The base case is `dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at`.
-  refine mem_adjoin_of_dvd_coeff_of_dvd_aeval hp.ne_zero (λ i, _) hQ,
-  refine nat.case_strong_induction_on i _ (λ j hind, _),
-  { intro H,
-    exact dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at
-      hp hBint hQ hzint hei },
-  { intro hj,
-    refine hp.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd _ hndiv,
-    exact n,
-
-    -- Two technical results we will need about `P.nat_degree` and `Q.nat_degree`.
-    have H := degree_mod_by_monic_lt Q₁ (minpoly.monic hBint),
-    rw [← hQ₁, ← hP] at H,
-    replace H:= nat.lt_iff_add_one_le.1 (lt_of_lt_of_le (lt_of_le_of_lt
-      (nat.lt_iff_add_one_le.1 (nat.lt_of_succ_lt_succ (mem_range.1 hj))) (lt_succ_self _))
-      (nat.lt_iff_add_one_le.1 (((nat_degree_lt_nat_degree_iff hQzero).2 H)))),
-    rw [add_assoc] at H,
-    have Hj : Q.nat_degree + 1 = j + 1 + (Q.nat_degree - j),
-    { rw [← add_comm 1, ← add_comm 1, add_assoc, add_right_inj, ← nat.add_sub_assoc
-        (nat.lt_of_succ_lt_succ (mem_range.1 hj)).le, add_comm, nat.add_sub_cancel] },
-
-    -- By induction hypothesis we can find `g : ℕ → R` such that
-    -- `k ∈ range (j + 1) → Q.coeff k • B.gen ^ k = (algebra_map R L) p * g k • B.gen ^ k`-
-    choose! g hg using hind,
-    replace hg : ∀ k ∈ range (j + 1), Q.coeff k • B.gen ^ k =
-      (algebra_map R L p) * (g k • B.gen ^ k),
-    { intros k hk,
-      rw [hg k (mem_range_succ_iff.1 hk) (mem_range_succ_iff.2 (le_trans (mem_range_succ_iff.1 hk)
-        (succ_le_iff.1 (mem_range_succ_iff.1 hj)).le)), algebra.smul_def, algebra.smul_def,
-        ring_hom.map_mul, mul_assoc] },
-
-    -- Since `minpoly R B.gen` is Eiseinstein, we can find `f : ℕ → L` such that
-    -- `(map (algebra_map R L) (minpoly R B.gen)).nat_degree ≤ i` implies `f i ∈ adjoin R {B.gen}`
-    -- and `(algebra_map R L) p * f i = B.gen ^ i`. We will also need `hf₁`, a reformulation of this
-    -- property.
-    choose! f hf using (is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
-    (minpoly.aeval R B.gen) (minpoly.monic hBint) hei.is_weakly_eisenstein_at),
-    have hf₁ : ∀ k ∈ (range (Q.nat_degree - j)).erase 0,
-      Q.coeff (j + 1 + k) • B.gen ^ (j + 1 + k) * B.gen ^ (P.nat_degree - (j + 2)) =
-      (algebra_map R L) p * Q.coeff (j + 1 + k) • f (k + P.nat_degree - 1),
-    { intros k hk,
-      rw [smul_mul_assoc, ← pow_add, ← nat.add_sub_assoc H, ← add_assoc j 1 1,
-        add_comm (j + 1) 1, add_assoc (j + 1), add_comm _ (k + P.nat_degree),
-        nat.add_sub_add_right, ← (hf (k + P.nat_degree - 1) _).2, mul_smul_comm],
-      rw [(minpoly.monic hBint).nat_degree_map, add_comm, nat.add_sub_assoc,
-        le_add_iff_nonneg_right],
-      { exact nat.zero_le _ },
-      { refine one_le_iff_ne_zero.2 (λ h, _),
-        rw [h] at hk,
-        simpa using hk },
-      { apply_instance } },
-
-  -- The Eisenstein condition shows that `p` divides `Q.coeff j`
-  -- if `p^n.succ` divides the following multiple of `Q.coeff (succ j)^n.succ`:
-   suffices : p ^ n.succ ∣
-    Q.coeff (succ j) ^ n.succ * (minpoly R B.gen).coeff 0 ^ (succ j + (P.nat_degree - (j + 2))),
-  { convert this,
-    rw [nat.succ_eq_add_one, add_assoc, ← nat.add_sub_assoc H, ← add_assoc, add_comm (j + 1),
-      nat.add_sub_add_left, ← nat.add_sub_assoc, nat.add_sub_add_left, hP,
-      ← (minpoly.monic hBint).nat_degree_map  (algebra_map R K),
-      ← minpoly.gcd_domain_eq_field_fractions K hBint, nat_degree_minpoly, hn, nat.sub_one,
-      nat.pred_succ],
-    linarith },
-
-  -- Using `hQ : aeval B.gen Q = p • z`, we write `p • z` as a sum of terms of degree less than
-  -- `j+1`, that are multiples of `p` by induction, and terms of degree at least `j+1`.
-  rw [aeval_eq_sum_range, Hj, range_add, sum_union (disjoint_range_add_left_embedding _ _),
-      sum_congr rfl hg, add_comm] at hQ,
-  -- We multiply this equality by `B.gen ^ (P.nat_degree-(j+2))`, so we can use `hf₁` on the terms
-  -- we didn't know were multiples of `p`, and we take the norm on both sides.
-  replace hQ := congr_arg (λ x, x * B.gen ^ (P.nat_degree - (j + 2))) hQ,
-  simp_rw [sum_map, add_left_embedding_apply, add_mul, sum_mul, mul_assoc] at hQ,
-  rw [← insert_erase (mem_range.2 (tsub_pos_iff_lt.2 $ nat.lt_of_succ_lt_succ $ mem_range.1 hj)),
-      sum_insert (not_mem_erase 0 _), add_zero, sum_congr rfl hf₁, ← mul_sum, ← mul_sum,
-      add_assoc, ← mul_add, smul_mul_assoc, ← pow_add, algebra.smul_def] at hQ,
-  replace hQ := congr_arg (norm K) (eq_sub_of_add_eq hQ),
-
-  -- We obtain an equality of elements of `K`, but everything is integral, so we can move to `R`
-  -- and simplify `hQ`.
-  have hintsum : is_integral R (z * B.gen ^ (P.nat_degree - (j + 2)) -
-      (∑ (x : ℕ) in (range (Q.nat_degree - j)).erase 0, Q.coeff (j + 1 + x) •
-        f (x + P.nat_degree - 1) +
-      ∑ (x : ℕ) in range (j + 1), g x • B.gen ^ x * B.gen ^ (P.nat_degree - (j + 2)))),
-    { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
-        (is_integral_add (is_integral.sum _ (λ k hk, is_integral_smul _ _))
-        (is_integral.sum _ (λ k hk, is_integral_mul (is_integral_smul _ (is_integral.pow hBint _))
-        ((is_integral.pow hBint _))))),
-      refine adjoin_le_integral_closure hBint (hf _ _).1,
-      rw [(minpoly.monic hBint).nat_degree_map (algebra_map R L)],
-      rw [add_comm, nat.add_sub_assoc, le_add_iff_nonneg_right],
-      { exact zero_le _ },
-      { refine one_le_iff_ne_zero.2 (λ h, _),
-        rw [h] at hk,
-        simpa using hk } },
-    obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
-    rw [algebra.smul_def, mul_assoc, ← mul_sub, _root_.map_mul, algebra_map_apply R K L, map_pow,
-      algebra.norm_algebra_map, _root_.map_mul, algebra_map_apply R K L, algebra.norm_algebra_map,
-      finrank B, ← hr,
-      power_basis.norm_gen_eq_coeff_zero_minpoly, minpoly.gcd_domain_eq_field_fractions K hBint,
-      coeff_map, show (-1 : K) = algebra_map R K (-1), by simp, ← map_pow, ← map_pow,
-      ← _root_.map_mul, ← map_pow, ← _root_.map_mul, ← map_pow, ← _root_.map_mul] at hQ,
-
-    -- We can now finish the proof.
-    have hppdiv : p ^ B.dim ∣ p ^ B.dim * r := dvd_mul_of_dvd_left dvd_rfl _,
-    rwa [← is_fraction_ring.injective R K hQ, mul_comm, ← units.coe_neg_one, mul_pow,
-      ← units.coe_pow, ← units.coe_pow, mul_assoc, is_unit.dvd_mul_left _ _ _ ⟨_, rfl⟩, mul_comm,
-      ← nat.succ_eq_add_one, hn] at hppdiv }
-end
-
-/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
-extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
-`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`,
-then `z ∈ adjoin R {B.gen}`. Together with `algebra.discr_mul_is_integral_mem_adjoin` this result
-often allows to compute the ring of integers of `L`. -/
-lemma mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
-  (hp : prime p) (hBint : is_integral R B.gen) {n : ℕ} {z : L} (hzint : is_integral R z)
-  (hz : p ^ n • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
-  z ∈ adjoin R ({B.gen} : set L) :=
-begin
-  induction n with n hn,
-  { simpa using hz },
-  { rw [pow_succ, mul_smul] at hz,
-    exact hn (mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at
-      hp hBint (is_integral_smul _ hzint) hz hei) }
-end
-
-end is_integral
diff --git a/src/ring_theory/polynomial/eisenstein/basic.lean b/src/ring_theory/polynomial/eisenstein/basic.lean
new file mode 100644
index 0000000000000..3e3903a29d390
--- /dev/null
+++ b/src/ring_theory/polynomial/eisenstein/basic.lean
@@ -0,0 +1,236 @@
+/-
+Copyright (c) 2022 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca
+-/
+
+import ring_theory.eisenstein_criterion
+import ring_theory.polynomial.scale_roots
+
+/-!
+# Eisenstein polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]` is
+*Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
+`f.coeff 0 ∉ 𝓟 ^ 2`. In this file we gather miscellaneous results about Eisenstein polynomials.
+
+## Main definitions
+* `polynomial.is_eisenstein_at f 𝓟`: the property of being Eisenstein at `𝓟`.
+
+## Main results
+* `polynomial.is_eisenstein_at.irreducible`: if a primitive `f` satisfies `f.is_eisenstein_at 𝓟`,
+  where `𝓟.is_prime`, then `f` is irreducible.
+
+## Implementation details
+We also define a notion `is_weakly_eisenstein_at` requiring only that
+`∀ n < f.nat_degree → f.coeff n ∈ 𝓟`. This makes certain results slightly more general and it is
+useful since it is sometimes better behaved (for example it is stable under `polynomial.map`).
+
+-/
+
+universes u v w z
+
+variables {R : Type u}
+
+open ideal algebra finset
+
+open_locale big_operators polynomial
+
+namespace polynomial
+
+/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
+is *weakly Eisenstein at `𝓟`* if `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟`. -/
+@[mk_iff] structure is_weakly_eisenstein_at [comm_semiring R] (f : R[X]) (𝓟 : ideal R) :
+  Prop := (mem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟)
+
+/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
+is *Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
+`f.coeff 0 ∉ 𝓟 ^ 2`. -/
+@[mk_iff] structure is_eisenstein_at [comm_semiring R] (f : R[X]) (𝓟 : ideal R) : Prop :=
+(leading : f.leading_coeff ∉ 𝓟)
+(mem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟)
+(not_mem : f.coeff 0 ∉ 𝓟 ^ 2)
+
+namespace is_weakly_eisenstein_at
+
+section comm_semiring
+
+variables [comm_semiring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_weakly_eisenstein_at 𝓟)
+
+include hf
+
+lemma map {A : Type v} [comm_ring A] (φ : R →+* A) : (f.map φ).is_weakly_eisenstein_at (𝓟.map φ) :=
+begin
+  refine (is_weakly_eisenstein_at_iff _ _).2 (λ n hn, _),
+  rw [coeff_map],
+  exact mem_map_of_mem _ (hf.mem (lt_of_lt_of_le hn (nat_degree_map_le _ _)))
+end
+
+end comm_semiring
+
+section comm_ring
+
+variables [comm_ring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_weakly_eisenstein_at 𝓟)
+variables {S : Type v} [comm_ring S] [algebra R S]
+
+section principal
+
+variable {p : R}
+
+local notation `P` := submodule.span R {p}
+
+lemma exists_mem_adjoin_mul_eq_pow_nat_degree {x : S} (hx : aeval x f = 0)
+  (hmo : f.monic) (hf : f.is_weakly_eisenstein_at P) : ∃ y ∈ adjoin R ({x} : set S),
+  (algebra_map R S) p * y = x ^ (f.map (algebra_map R S)).nat_degree :=
+begin
+  rw [aeval_def, polynomial.eval₂_eq_eval_map, eval_eq_sum_range, range_add_one,
+    sum_insert not_mem_range_self, sum_range, (hmo.map
+    (algebra_map R S)).coeff_nat_degree, one_mul] at hx,
+  replace hx := eq_neg_of_add_eq_zero_left hx,
+  have : ∀ n < f.nat_degree, p ∣ f.coeff n,
+  { intros n hn,
+    refine mem_span_singleton.1 (by simpa using hf.mem hn) },
+  choose! φ hφ using this,
+  conv_rhs at hx { congr, congr, skip, funext,
+    rw [fin.coe_eq_val, coeff_map, hφ i.1 (lt_of_lt_of_le i.2 (nat_degree_map_le _ _)),
+      ring_hom.map_mul, mul_assoc] },
+  rw [hx, ← mul_sum, neg_eq_neg_one_mul, ← mul_assoc (-1 : S), mul_comm (-1 : S), mul_assoc],
+  refine ⟨-1 * ∑ (i : fin (f.map (algebra_map R S)).nat_degree),
+    (algebra_map R S) (φ i.1) * x ^ i.1, _, rfl⟩,
+  exact subalgebra.mul_mem _ (subalgebra.neg_mem _ (subalgebra.one_mem _))
+    (subalgebra.sum_mem _ (λ i hi, subalgebra.mul_mem _ (subalgebra.algebra_map_mem _ _)
+    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton x)) _)))
+end
+
+lemma exists_mem_adjoin_mul_eq_pow_nat_degree_le {x : S} (hx : aeval x f = 0)
+  (hmo : f.monic) (hf : f.is_weakly_eisenstein_at P) :
+  ∀ i, (f.map (algebra_map R S)).nat_degree ≤ i →
+  ∃ y ∈ adjoin R ({x} : set S), (algebra_map R S) p * y = x ^ i :=
+begin
+  intros i hi,
+  obtain ⟨k, hk⟩ := exists_add_of_le hi,
+  rw [hk, pow_add],
+  obtain ⟨y, hy, H⟩ := exists_mem_adjoin_mul_eq_pow_nat_degree hx hmo hf,
+  refine ⟨y * x ^ k, _, _⟩,
+  { exact subalgebra.mul_mem _ hy (subalgebra.pow_mem _  (subset_adjoin (set.mem_singleton x)) _) },
+  { rw [← mul_assoc _ y, H] }
+end
+
+end principal
+
+include hf
+
+lemma pow_nat_degree_le_of_root_of_monic_mem {x : R} (hroot : is_root f x) (hmo : f.monic) :
+  ∀ i, f.nat_degree ≤ i → x ^ i ∈ 𝓟 :=
+begin
+  intros i hi,
+  obtain ⟨k, hk⟩ := exists_add_of_le hi,
+  rw [hk, pow_add],
+  suffices : x ^ f.nat_degree ∈ 𝓟,
+  { exact mul_mem_right (x ^ k) 𝓟 this },
+  rw [is_root.def, eval_eq_sum_range, finset.range_add_one, finset.sum_insert
+    finset.not_mem_range_self, finset.sum_range, hmo.coeff_nat_degree, one_mul] at hroot,
+  rw [eq_neg_of_add_eq_zero_left hroot, neg_mem_iff],
+  refine submodule.sum_mem _ (λ i hi,  mul_mem_right _ _ (hf.mem (fin.is_lt i)))
+end
+
+lemma pow_nat_degree_le_of_aeval_zero_of_monic_mem_map {x : S} (hx : aeval x f = 0)
+  (hmo : f.monic) :
+  ∀ i, (f.map (algebra_map R S)).nat_degree ≤ i → x ^ i ∈ 𝓟.map (algebra_map R S) :=
+begin
+  suffices : x ^ (f.map (algebra_map R S)).nat_degree ∈ 𝓟.map (algebra_map R S),
+  { intros i hi,
+    obtain ⟨k, hk⟩ := exists_add_of_le hi,
+    rw [hk, pow_add],
+    refine mul_mem_right _ _ this },
+  rw [aeval_def, eval₂_eq_eval_map, ← is_root.def] at hx,
+  refine pow_nat_degree_le_of_root_of_monic_mem (hf.map _) hx (hmo.map _) _ rfl.le
+end
+
+end comm_ring
+
+end is_weakly_eisenstein_at
+
+section scale_roots
+
+variables {A : Type*} [comm_ring R] [comm_ring A]
+
+lemma scale_roots.is_weakly_eisenstein_at (p : R[X]) {x : R}
+  {P : ideal R} (hP : x ∈ P) : (scale_roots p x).is_weakly_eisenstein_at P :=
+begin
+  refine ⟨λ i hi, _⟩,
+  rw coeff_scale_roots,
+  rw [nat_degree_scale_roots, ← tsub_pos_iff_lt] at hi,
+  exact ideal.mul_mem_left _ _ (ideal.pow_mem_of_mem P hP _ hi)
+end
+
+lemma dvd_pow_nat_degree_of_eval₂_eq_zero {f : R →+* A}
+  (hf : function.injective f) {p : R[X]} (hp : p.monic) (x y : R) (z : A)
+  (h : p.eval₂ f z = 0) (hz : f x * z = f y) : x ∣ y ^ p.nat_degree :=
+begin
+  rw [← nat_degree_scale_roots p x, ← ideal.mem_span_singleton],
+  refine (scale_roots.is_weakly_eisenstein_at _ (ideal.mem_span_singleton.mpr $ dvd_refl x))
+    .pow_nat_degree_le_of_root_of_monic_mem _ ((monic_scale_roots_iff x).mpr hp) _ le_rfl,
+  rw injective_iff_map_eq_zero' at hf,
+  have := scale_roots_eval₂_eq_zero f h,
+  rwa [hz, polynomial.eval₂_at_apply, hf] at this
+end
+
+lemma dvd_pow_nat_degree_of_aeval_eq_zero [algebra R A] [nontrivial A]
+  [no_zero_smul_divisors R A] {p : R[X]} (hp : p.monic) (x y : R) (z : A)
+  (h : polynomial.aeval z p = 0) (hz : z * algebra_map R A x = algebra_map R A y) :
+  x ∣ y ^ p.nat_degree :=
+dvd_pow_nat_degree_of_eval₂_eq_zero (no_zero_smul_divisors.algebra_map_injective R A)
+  hp x y z h ((mul_comm _ _).trans hz)
+
+end scale_roots
+
+namespace is_eisenstein_at
+
+section comm_semiring
+
+variables [comm_semiring R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_eisenstein_at 𝓟)
+
+lemma _root_.polynomial.monic.leading_coeff_not_mem (hf : f.monic) (h : 𝓟 ≠ ⊤) :
+  ¬f.leading_coeff ∈ 𝓟 :=
+hf.leading_coeff.symm ▸ (ideal.ne_top_iff_one _).1 h
+
+lemma _root_.polynomial.monic.is_eisenstein_at_of_mem_of_not_mem (hf : f.monic) (h : 𝓟 ≠ ⊤)
+  (hmem : ∀ {n}, n < f.nat_degree → f.coeff n ∈ 𝓟) (hnot_mem : f.coeff 0 ∉ 𝓟 ^ 2) :
+  f.is_eisenstein_at 𝓟 :=
+{ leading := hf.leading_coeff_not_mem h,
+  mem := λ n hn, hmem hn,
+  not_mem := hnot_mem }
+
+include hf
+
+lemma is_weakly_eisenstein_at : is_weakly_eisenstein_at f 𝓟 := ⟨λ _, hf.mem⟩
+
+lemma coeff_mem {n : ℕ} (hn : n ≠ f.nat_degree) : f.coeff n ∈ 𝓟 :=
+begin
+  cases ne_iff_lt_or_gt.1 hn,
+  { exact hf.mem h },
+  { rw [coeff_eq_zero_of_nat_degree_lt h],
+    exact ideal.zero_mem _}
+end
+
+end comm_semiring
+
+section is_domain
+
+variables [comm_ring R] [is_domain R] {𝓟 : ideal R} {f : R[X]} (hf : f.is_eisenstein_at 𝓟)
+
+/-- If a primitive `f` satisfies `f.is_eisenstein_at 𝓟`, where `𝓟.is_prime`, then `f` is
+irreducible. -/
+lemma irreducible (hprime : 𝓟.is_prime) (hu : f.is_primitive)
+  (hfd0 : 0 < f.nat_degree) : irreducible f :=
+irreducible_of_eisenstein_criterion hprime hf.leading (λ n hn, hf.mem (coe_lt_degree.1 hn))
+  (nat_degree_pos_iff_degree_pos.1 hfd0) hf.not_mem hu
+
+end is_domain
+
+end is_eisenstein_at
+
+end polynomial
diff --git a/src/ring_theory/polynomial/eisenstein/is_integral.lean b/src/ring_theory/polynomial/eisenstein/is_integral.lean
new file mode 100644
index 0000000000000..ca3651eddda98
--- /dev/null
+++ b/src/ring_theory/polynomial/eisenstein/is_integral.lean
@@ -0,0 +1,388 @@
+/-
+Copyright (c) 2022 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca
+-/
+import data.nat.choose.dvd
+import ring_theory.integrally_closed
+import ring_theory.norm
+import ring_theory.polynomial.cyclotomic.expand
+
+/-!
+# Eisenstein polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+In this file we gather more miscellaneous results about Eisenstein polynomials
+
+## Main results
+* `mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at`: let `K` be the field of fraction
+  of an integrally closed domain `R` and let `L` be a separable extension of `K`, generated by an
+  integral power basis `B` such that the minimal polynomial of `B.gen` is Eisenstein at `p`. Given
+  `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`, then `z ∈ adjoin R {B.gen}`.
+  Together with `algebra.discr_mul_is_integral_mem_adjoin` this result often allows to compute the
+  ring of integers of `L`.
+
+-/
+
+universes u v w z
+
+variables {R : Type u}
+
+open ideal algebra finset
+
+open_locale big_operators polynomial
+
+section cyclotomic
+
+variables (p : ℕ)
+
+local notation `𝓟` := submodule.span ℤ {p}
+
+open polynomial
+
+lemma cyclotomic_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] :
+  ((cyclotomic p ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
+begin
+  refine monic.is_eisenstein_at_of_mem_of_not_mem _
+    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
+    nat.prime_iff_prime_int.1 hp.out) (λ i hi, _) _,
+  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
+    refine ((cyclotomic.monic p ℤ).comp (monic_X_add_C 1) (λ h, _)),
+    rw [nat_degree_X_add_C] at h,
+    exact zero_ne_one h.symm },
+  { rw [cyclotomic_prime, geom_sum_X_comp_X_add_one_eq_sum, ← lcoeff_apply,
+      linear_map.map_sum],
+    conv { congr, congr, skip, funext,
+      rw [lcoeff_apply, ← C_eq_nat_cast, C_mul_X_pow_eq_monomial, coeff_monomial] },
+    rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C, mul_one,
+      nat_degree_cyclotomic, nat.totient_prime hp.out] at hi,
+    simp only [hi.trans_le (nat.sub_le _ _), sum_ite_eq', mem_range, if_true,
+      ideal.submodule_span_eq, ideal.mem_span_singleton, int.coe_nat_dvd],
+    exact hp.out.dvd_choose_self i.succ_ne_zero (lt_tsub_iff_right.1 hi) },
+  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime, eval_add, eval_X,
+      eval_one, zero_add, eval_geom_sum, one_geom_sum,
+      ideal.submodule_span_eq, ideal.span_singleton_pow, ideal.mem_span_singleton],
+    intro h,
+    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
+    rw [← mul_assoc, mul_one, mul_assoc] at hk,
+    nth_rewrite 0 [← nat.mul_one p] at hk,
+    rw [mul_right_inj' hp.out.ne_zero] at hk,
+    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
+end
+
+lemma cyclotomic_prime_pow_comp_X_add_one_is_eisenstein_at [hp : fact p.prime] (n : ℕ) :
+  ((cyclotomic (p ^ (n + 1)) ℤ).comp (X + 1)).is_eisenstein_at 𝓟 :=
+begin
+  refine monic.is_eisenstein_at_of_mem_of_not_mem _
+    (ideal.is_prime.ne_top $(ideal.span_singleton_prime (by exact_mod_cast hp.out.ne_zero)).2 $
+    nat.prime_iff_prime_int.1 hp.out) _ _,
+  { rw [show (X + 1 : ℤ[X]) = X + C 1, by simp],
+    refine ((cyclotomic.monic _ ℤ).comp (monic_X_add_C 1) (λ h, _)),
+    rw [nat_degree_X_add_C] at h,
+    exact zero_ne_one h.symm },
+  { induction n with n hn,
+    { intros i hi,
+      rw [zero_add, pow_one] at hi ⊢,
+      exact (cyclotomic_comp_X_add_one_is_eisenstein_at p).mem hi },
+    { intros i hi,
+      rw [ideal.submodule_span_eq, ideal.mem_span_singleton, ← zmod.int_coe_zmod_eq_zero_iff_dvd,
+        ← int.coe_cast_ring_hom, ← coeff_map, map_comp, map_cyclotomic, polynomial.map_add, map_X,
+        polynomial.map_one, pow_add, pow_one, cyclotomic_mul_prime_dvd_eq_pow, pow_comp,
+        ← zmod.expand_card, coeff_expand hp.out.pos],
+      { simp only [ite_eq_right_iff],
+        rintro ⟨k, hk⟩,
+        rw [nat_degree_comp, show (X + 1 : ℤ[X]) = X + C 1, by simp, nat_degree_X_add_C,
+          mul_one, nat_degree_cyclotomic, nat.totient_prime_pow hp.out (nat.succ_pos _),
+          nat.succ_sub_one] at hn hi,
+        rw [hk, pow_succ, mul_assoc] at hi,
+        rw [hk, mul_comm, nat.mul_div_cancel _ hp.out.pos],
+        replace hn := hn (lt_of_mul_lt_mul_left' hi),
+        rw [ideal.submodule_span_eq, ideal.mem_span_singleton,
+          ← zmod.int_coe_zmod_eq_zero_iff_dvd, ← int.coe_cast_ring_hom, ← coeff_map] at hn,
+        simpa [map_comp] using hn },
+      { exact ⟨p ^ n, by rw [pow_succ]⟩ } } },
+  { rw [coeff_zero_eq_eval_zero, eval_comp, cyclotomic_prime_pow_eq_geom_sum hp.out, eval_add,
+      eval_X, eval_one, zero_add, eval_finset_sum],
+    simp only [eval_pow, eval_X, one_pow, sum_const, card_range, nat.smul_one_eq_coe,
+      submodule_span_eq, ideal.submodule_span_eq,
+      ideal.span_singleton_pow, ideal.mem_span_singleton],
+    intro h,
+    obtain ⟨k, hk⟩ := int.coe_nat_dvd.1 h,
+    rw [← mul_assoc, mul_one, mul_assoc] at hk,
+    nth_rewrite 0 [← nat.mul_one p] at hk,
+    rw [mul_right_inj' hp.out.ne_zero] at hk,
+    exact nat.prime.not_dvd_one hp.out (dvd.intro k (hk.symm)) }
+end
+
+end cyclotomic
+
+section is_integral
+
+variables {K : Type v} {L : Type z} {p : R} [comm_ring R] [field K] [field L]
+variables [algebra K L] [algebra R L] [algebra R K] [is_scalar_tower R K L] [is_separable K L]
+variables [is_domain R] [is_fraction_ring R K] [is_integrally_closed R]
+
+local notation `𝓟` := submodule.span R {p}
+
+open is_integrally_closed power_basis nat polynomial is_scalar_tower
+
+/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
+extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
+`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `Q : R[X]` is such that
+`aeval B.gen Q = p • z`, then `p ∣ Q.coeff 0`. -/
+lemma dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
+  (hp : prime p) (hBint : is_integral R B.gen) {z : L} {Q : R[X]}
+  (hQ : aeval B.gen Q = p • z) (hzint : is_integral R z)
+  (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) : p ∣ Q.coeff 0 :=
+begin
+  -- First define some abbreviations.
+  letI := B.finite_dimensional,
+  let P := minpoly R B.gen,
+  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
+  have finrank_K_L : finite_dimensional.finrank K L = B.dim := B.finrank,
+  have deg_K_P : (minpoly K B.gen).nat_degree = B.dim := B.nat_degree_minpoly,
+  have deg_R_P : P.nat_degree = B.dim,
+  { rw [← deg_K_P, minpoly.is_integrally_closed_eq_field_fractions' K hBint,
+        (minpoly.monic hBint).nat_degree_map (algebra_map R K)] },
+  choose! f hf using hei.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
+    (minpoly.aeval R B.gen) (minpoly.monic hBint),
+  simp only [(minpoly.monic hBint).nat_degree_map, deg_R_P] at hf,
+
+  -- The Eisenstein condition shows that `p` divides `Q.coeff 0`
+  -- if `p^n.succ` divides the following multiple of `Q.coeff 0^n.succ`:
+  suffices : p ^ n.succ ∣
+    (Q.coeff 0 ^ n.succ * ((-1) ^ (n.succ * n) * (minpoly R B.gen).coeff 0 ^ n)),
+  { have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
+      hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
+    refine prime.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd hp ((_ : _ ^ n.succ ∣ _)) hndiv,
+    convert (is_unit.dvd_mul_right ⟨(-1) ^ (n.succ * n), rfl⟩).mpr this using 1,
+    push_cast,
+    ring_nf, simp [pow_right_comm _ _ 2] },
+
+  -- We claim the quotient of `Q^n * _` by `p^n` is the following `r`:
+  have aux : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0, B.dim ≤ i + n,
+  { intros i hi,
+    simp only [mem_range, mem_erase] at hi,
+    rw [hn],
+    exact le_add_pred_of_pos _ hi.1 },
+  have hintsum : is_integral R (z * B.gen ^ n -
+    ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0, Q.coeff x • f (x + n)),
+  { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
+      (is_integral.sum _ (λ i hi, (is_integral_smul _ _))),
+    exact adjoin_le_integral_closure hBint (hf _ (aux i hi)).1 },
+  obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
+  use r,
+
+  -- Do the computation in `K` so we can work in terms of `z` instead of `r`.
+  apply is_fraction_ring.injective R K,
+  simp only [_root_.map_mul, _root_.map_pow, _root_.map_neg, _root_.map_one],
+  -- Both sides are actually norms:
+  calc _ = norm K (Q.coeff 0 • B.gen ^ n) : _
+  ... = norm K (p • (z * B.gen ^ n) - ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
+          p • Q.coeff x • f (x + n))
+    : congr_arg (norm K) (eq_sub_of_add_eq _)
+  ... = _ : _,
+  { simp only [algebra.smul_def, algebra_map_apply R K L, algebra.norm_algebra_map, _root_.map_mul,
+      _root_.map_pow, finrank_K_L, power_basis.norm_gen_eq_coeff_zero_minpoly,
+      minpoly.is_integrally_closed_eq_field_fractions' K hBint, coeff_map, ← hn],
+    ring_exp },
+  swap, { simp_rw [← smul_sum, ← smul_sub, algebra.smul_def p, algebra_map_apply R K L,
+      _root_.map_mul, algebra.norm_algebra_map, finrank_K_L, hr, ← hn] },
+
+  calc _ = (Q.coeff 0 • 1 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
+              Q.coeff x • B.gen ^ x) * B.gen ^ n : _
+  ... = (Q.coeff 0 • B.gen ^ 0 + ∑ (x : ℕ) in (range (Q.nat_degree + 1)).erase 0,
+              Q.coeff x • B.gen ^ x) * B.gen ^ n : by rw pow_zero
+  ... = (aeval B.gen Q) * B.gen ^ n : _
+  ... = _ : by rw [hQ, algebra.smul_mul_assoc],
+  { have : ∀ i ∈ (range (Q.nat_degree + 1)).erase 0,
+      Q.coeff i • (B.gen ^ i * B.gen ^ n) =
+      p • Q.coeff i • f (i + n),
+    { intros i hi,
+      rw [←pow_add, ←(hf _ (aux i hi)).2, ←algebra.smul_def, smul_smul, mul_comm _ p, smul_smul] },
+    simp only [add_mul, smul_mul_assoc, one_mul, sum_mul, sum_congr rfl this] },
+  { rw [aeval_eq_sum_range,
+        finset.add_sum_erase (range (Q.nat_degree + 1)) (λ i, Q.coeff i • B.gen ^ i)],
+    simp },
+end
+
+lemma mem_adjoin_of_dvd_coeff_of_dvd_aeval {A B : Type*} [comm_semiring A] [comm_ring B]
+  [algebra A B] [no_zero_smul_divisors A B] {Q : A[X]} {p : A} {x z : B} (hp : p ≠ 0)
+  (hQ : ∀ i ∈ range (Q.nat_degree + 1), p ∣ Q.coeff i) (hz : aeval x Q = p • z) :
+  z ∈ adjoin A ({x} : set B) :=
+begin
+  choose! f hf using hQ,
+  rw [aeval_eq_sum_range, sum_range] at hz,
+  conv_lhs at hz { congr, skip, funext,
+    rw [hf i (mem_range.2 (fin.is_lt i)), ← smul_smul] },
+  rw [← smul_sum] at hz,
+  rw [← smul_right_injective _ hp hz],
+  exact subalgebra.sum_mem _ (λ _ _, subalgebra.smul_mem _
+    (subalgebra.pow_mem _ (subset_adjoin (set.mem_singleton _)) _) _)
+end
+
+/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
+extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
+`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p • z ∈ adjoin R {B.gen}`, then
+`z ∈ adjoin R {B.gen}`. -/
+lemma mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
+  (hp : prime p) (hBint : is_integral R B.gen) {z : L} (hzint : is_integral R z)
+  (hz : p • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
+  z ∈ adjoin R ({B.gen} : set L) :=
+begin
+  -- First define some abbreviations.
+  have hndiv : ¬ p ^ 2 ∣ ((minpoly R B.gen)).coeff 0 := λ h,
+    hei.not_mem ((span_singleton_pow p 2).symm ▸ (ideal.mem_span_singleton.2 h)),
+  letI := finite_dimensional B,
+  set P := minpoly R B.gen with hP,
+  obtain ⟨n , hn⟩ := nat.exists_eq_succ_of_ne_zero B.dim_pos.ne',
+  haveI : no_zero_smul_divisors R L := no_zero_smul_divisors.trans R K L,
+  let P₁ := P.map (algebra_map R L),
+
+  -- There is a polynomial `Q` such that `p • z = aeval B.gen Q`. We can assume that
+  -- `Q.degree < P.degree` and `Q ≠ 0`.
+  rw [adjoin_singleton_eq_range_aeval] at hz,
+  obtain ⟨Q₁, hQ⟩ := hz,
+  set Q := Q₁ %ₘ P with hQ₁,
+  replace hQ : aeval B.gen Q = p • z,
+  { rw [← mod_by_monic_add_div Q₁ (minpoly.monic hBint)] at hQ,
+    simpa using hQ },
+  by_cases hQzero : Q = 0,
+  { simp only [hQzero, algebra.smul_def, zero_eq_mul, aeval_zero] at hQ,
+    cases hQ with H H₁,
+    { have : function.injective (algebra_map R L),
+      { rw [algebra_map_eq R K L],
+        exact (algebra_map K L).injective.comp (is_fraction_ring.injective R K) },      exfalso,
+      exact hp.ne_zero ((injective_iff_map_eq_zero _).1 this _ H) },
+    { rw [H₁],
+      exact subalgebra.zero_mem _ } },
+
+  -- It is enough to prove that all coefficients of `Q` are divisible by `p`, by induction.
+  -- The base case is `dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at`.
+  refine mem_adjoin_of_dvd_coeff_of_dvd_aeval hp.ne_zero (λ i, _) hQ,
+  refine nat.case_strong_induction_on i _ (λ j hind, _),
+  { intro H,
+    exact dvd_coeff_zero_of_aeval_eq_prime_smul_of_minpoly_is_eiseinstein_at
+      hp hBint hQ hzint hei },
+  { intro hj,
+    refine hp.dvd_of_pow_dvd_pow_mul_pow_of_square_not_dvd _ hndiv,
+    exact n,
+
+    -- Two technical results we will need about `P.nat_degree` and `Q.nat_degree`.
+    have H := degree_mod_by_monic_lt Q₁ (minpoly.monic hBint),
+    rw [← hQ₁, ← hP] at H,
+    replace H:= nat.lt_iff_add_one_le.1 (lt_of_lt_of_le (lt_of_le_of_lt
+      (nat.lt_iff_add_one_le.1 (nat.lt_of_succ_lt_succ (mem_range.1 hj))) (lt_succ_self _))
+      (nat.lt_iff_add_one_le.1 (((nat_degree_lt_nat_degree_iff hQzero).2 H)))),
+    rw [add_assoc] at H,
+    have Hj : Q.nat_degree + 1 = j + 1 + (Q.nat_degree - j),
+    { rw [← add_comm 1, ← add_comm 1, add_assoc, add_right_inj, ← nat.add_sub_assoc
+        (nat.lt_of_succ_lt_succ (mem_range.1 hj)).le, add_comm, nat.add_sub_cancel] },
+
+    -- By induction hypothesis we can find `g : ℕ → R` such that
+    -- `k ∈ range (j + 1) → Q.coeff k • B.gen ^ k = (algebra_map R L) p * g k • B.gen ^ k`-
+    choose! g hg using hind,
+    replace hg : ∀ k ∈ range (j + 1), Q.coeff k • B.gen ^ k =
+      (algebra_map R L p) * (g k • B.gen ^ k),
+    { intros k hk,
+      rw [hg k (mem_range_succ_iff.1 hk) (mem_range_succ_iff.2 (le_trans (mem_range_succ_iff.1 hk)
+        (succ_le_iff.1 (mem_range_succ_iff.1 hj)).le)), algebra.smul_def, algebra.smul_def,
+        ring_hom.map_mul, mul_assoc] },
+
+    -- Since `minpoly R B.gen` is Eiseinstein, we can find `f : ℕ → L` such that
+    -- `(map (algebra_map R L) (minpoly R B.gen)).nat_degree ≤ i` implies `f i ∈ adjoin R {B.gen}`
+    -- and `(algebra_map R L) p * f i = B.gen ^ i`. We will also need `hf₁`, a reformulation of this
+    -- property.
+    choose! f hf using (is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le
+    (minpoly.aeval R B.gen) (minpoly.monic hBint) hei.is_weakly_eisenstein_at),
+    have hf₁ : ∀ k ∈ (range (Q.nat_degree - j)).erase 0,
+      Q.coeff (j + 1 + k) • B.gen ^ (j + 1 + k) * B.gen ^ (P.nat_degree - (j + 2)) =
+      (algebra_map R L) p * Q.coeff (j + 1 + k) • f (k + P.nat_degree - 1),
+    { intros k hk,
+      rw [smul_mul_assoc, ← pow_add, ← nat.add_sub_assoc H, ← add_assoc j 1 1,
+        add_comm (j + 1) 1, add_assoc (j + 1), add_comm _ (k + P.nat_degree),
+        nat.add_sub_add_right, ← (hf (k + P.nat_degree - 1) _).2, mul_smul_comm],
+      rw [(minpoly.monic hBint).nat_degree_map, add_comm, nat.add_sub_assoc,
+        le_add_iff_nonneg_right],
+      { exact nat.zero_le _ },
+      { refine one_le_iff_ne_zero.2 (λ h, _),
+        rw [h] at hk,
+        simpa using hk },
+      { apply_instance } },
+
+  -- The Eisenstein condition shows that `p` divides `Q.coeff j`
+  -- if `p^n.succ` divides the following multiple of `Q.coeff (succ j)^n.succ`:
+   suffices : p ^ n.succ ∣
+    Q.coeff (succ j) ^ n.succ * (minpoly R B.gen).coeff 0 ^ (succ j + (P.nat_degree - (j + 2))),
+  { convert this,
+    rw [nat.succ_eq_add_one, add_assoc, ← nat.add_sub_assoc H, ← add_assoc, add_comm (j + 1),
+      nat.add_sub_add_left, ← nat.add_sub_assoc, nat.add_sub_add_left, hP,
+      ← (minpoly.monic hBint).nat_degree_map  (algebra_map R K),
+      ← minpoly.is_integrally_closed_eq_field_fractions' K hBint, nat_degree_minpoly, hn,
+        nat.sub_one, nat.pred_succ],
+    linarith },
+
+  -- Using `hQ : aeval B.gen Q = p • z`, we write `p • z` as a sum of terms of degree less than
+  -- `j+1`, that are multiples of `p` by induction, and terms of degree at least `j+1`.
+  rw [aeval_eq_sum_range, Hj, range_add, sum_union (disjoint_range_add_left_embedding _ _),
+      sum_congr rfl hg, add_comm] at hQ,
+  -- We multiply this equality by `B.gen ^ (P.nat_degree-(j+2))`, so we can use `hf₁` on the terms
+  -- we didn't know were multiples of `p`, and we take the norm on both sides.
+  replace hQ := congr_arg (λ x, x * B.gen ^ (P.nat_degree - (j + 2))) hQ,
+  simp_rw [sum_map, add_left_embedding_apply, add_mul, sum_mul, mul_assoc] at hQ,
+  rw [← insert_erase (mem_range.2 (tsub_pos_iff_lt.2 $ nat.lt_of_succ_lt_succ $ mem_range.1 hj)),
+      sum_insert (not_mem_erase 0 _), add_zero, sum_congr rfl hf₁, ← mul_sum, ← mul_sum,
+      add_assoc, ← mul_add, smul_mul_assoc, ← pow_add, algebra.smul_def] at hQ,
+  replace hQ := congr_arg (norm K) (eq_sub_of_add_eq hQ),
+
+  -- We obtain an equality of elements of `K`, but everything is integral, so we can move to `R`
+  -- and simplify `hQ`.
+  have hintsum : is_integral R (z * B.gen ^ (P.nat_degree - (j + 2)) -
+      (∑ (x : ℕ) in (range (Q.nat_degree - j)).erase 0, Q.coeff (j + 1 + x) •
+        f (x + P.nat_degree - 1) +
+      ∑ (x : ℕ) in range (j + 1), g x • B.gen ^ x * B.gen ^ (P.nat_degree - (j + 2)))),
+    { refine is_integral_sub (is_integral_mul hzint (is_integral.pow hBint _))
+        (is_integral_add (is_integral.sum _ (λ k hk, is_integral_smul _ _))
+        (is_integral.sum _ (λ k hk, is_integral_mul (is_integral_smul _ (is_integral.pow hBint _))
+        ((is_integral.pow hBint _))))),
+      refine adjoin_le_integral_closure hBint (hf _ _).1,
+      rw [(minpoly.monic hBint).nat_degree_map (algebra_map R L)],
+      rw [add_comm, nat.add_sub_assoc, le_add_iff_nonneg_right],
+      { exact zero_le _ },
+      { refine one_le_iff_ne_zero.2 (λ h, _),
+        rw [h] at hk,
+        simpa using hk } },
+    obtain ⟨r, hr⟩ := is_integral_iff.1 (is_integral_norm K hintsum),
+    rw [algebra.smul_def, mul_assoc, ← mul_sub, _root_.map_mul, algebra_map_apply R K L, map_pow,
+      algebra.norm_algebra_map, _root_.map_mul, algebra_map_apply R K L, algebra.norm_algebra_map,
+      finrank B, ← hr, power_basis.norm_gen_eq_coeff_zero_minpoly,
+      minpoly.is_integrally_closed_eq_field_fractions' K hBint,
+      coeff_map, show (-1 : K) = algebra_map R K (-1), by simp, ← map_pow, ← map_pow,
+      ← _root_.map_mul, ← map_pow, ← _root_.map_mul, ← map_pow, ← _root_.map_mul] at hQ,
+
+    -- We can now finish the proof.
+    have hppdiv : p ^ B.dim ∣ p ^ B.dim * r := dvd_mul_of_dvd_left dvd_rfl _,
+    rwa [← is_fraction_ring.injective R K hQ, mul_comm, ← units.coe_neg_one, mul_pow,
+      ← units.coe_pow, ← units.coe_pow, mul_assoc, is_unit.dvd_mul_left _ _ _ ⟨_, rfl⟩, mul_comm,
+      ← nat.succ_eq_add_one, hn] at hppdiv }
+end
+
+/-- Let `K` be the field of fraction of an integrally closed domain `R` and let `L` be a separable
+extension of `K`, generated by an integral power basis `B` such that the minimal polynomial of
+`B.gen` is Eisenstein at `p`. Given `z : L` integral over `R`, if `p ^ n • z ∈ adjoin R {B.gen}`,
+then `z ∈ adjoin R {B.gen}`. Together with `algebra.discr_mul_is_integral_mem_adjoin` this result
+often allows to compute the ring of integers of `L`. -/
+lemma mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at {B : power_basis K L}
+  (hp : prime p) (hBint : is_integral R B.gen) {n : ℕ} {z : L} (hzint : is_integral R z)
+  (hz : p ^ n • z ∈ adjoin R ({B.gen} : set L)) (hei : (minpoly R B.gen).is_eisenstein_at 𝓟) :
+  z ∈ adjoin R ({B.gen} : set L) :=
+begin
+  induction n with n hn,
+  { simpa using hz },
+  { rw [pow_succ, mul_smul] at hz,
+    exact hn (mem_adjoin_of_smul_prime_smul_of_minpoly_is_eiseinstein_at
+      hp hBint (is_integral_smul _ hzint) hz hei) }
+end
+
+end is_integral
diff --git a/src/ring_theory/polynomial/gauss_lemma.lean b/src/ring_theory/polynomial/gauss_lemma.lean
index c0681583f97d5..ee3651e4a3d0e 100644
--- a/src/ring_theory/polynomial/gauss_lemma.lean
+++ b/src/ring_theory/polynomial/gauss_lemma.lean
@@ -3,21 +3,36 @@ Copyright (c) 2020 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
+import field_theory.splitting_field.construction
 import ring_theory.int.basic
 import ring_theory.localization.integral
+import ring_theory.integrally_closed
+
 
 /-!
 # Gauss's Lemma
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Gauss's Lemma is one of a few results pertaining to irreducibility of primitive polynomials.
 
 ## Main Results
+ - `is_integrally_closed.eq_map_mul_C_of_dvd`: if `R` is integrally closed, `K = Frac(R)` and
+  `g : K[X]` divides a monic polynomial with coefficients in `R`, then `g * (C g.leading_coeff⁻¹)`
+  has coefficients in `R`
+ - `polynomial.monic.irreducible_iff_irreducible_map_fraction_map`:
+  A monic polynomial over an integrally closed domain is irreducible iff it is irreducible in a
+    fraction field
+ - `is_integrally_closed_iff'`:
+   Integrally closed domains are precisely the domains for in which Gauss's lemma holds
+    for monic polynomials
  - `polynomial.is_primitive.irreducible_iff_irreducible_map_fraction_map`:
-  A primitive polynomial is irreducible iff it is irreducible in a fraction field.
+  A primitive polynomial over a GCD domain is irreducible iff it is irreducible in a fraction field
  - `polynomial.is_primitive.int.irreducible_iff_irreducible_map_cast`:
   A primitive polynomial over `ℤ` is irreducible iff it is irreducible over `ℚ`.
  - `polynomial.is_primitive.dvd_iff_fraction_map_dvd_fraction_map`:
-  Two primitive polynomials divide each other iff they do in a fraction field.
+  Two primitive polynomials over a GCD domain divide each other iff they do in a fraction field.
  - `polynomial.is_primitive.int.dvd_iff_map_cast_dvd_map_cast`:
   Two primitive polynomials over `ℤ` divide each other if they do in `ℚ`.
 
@@ -25,15 +40,76 @@ Gauss's Lemma is one of a few results pertaining to irreducibility of primitive
 
 open_locale non_zero_divisors polynomial
 
-variables {R : Type*} [comm_ring R] [is_domain R]
+variables {R : Type*} [comm_ring R]
+
+section is_integrally_closed
+
+open polynomial
+open integral_closure
+open is_integrally_closed
+
+variables (K : Type*) [field K] [algebra R K]
+
+theorem integral_closure.mem_lifts_of_monic_of_dvd_map
+  {f : R[X]} (hf : f.monic) {g : K[X]} (hg : g.monic) (hd : g ∣ f.map (algebra_map R K)) :
+  g ∈ lifts (algebra_map (integral_closure R K) K) :=
+begin
+  have := mem_lift_of_splits_of_roots_mem_range (integral_closure R g.splitting_field)
+    ((splits_id_iff_splits _).2 $ splitting_field.splits g) (hg.map _)
+    (λ a ha, (set_like.ext_iff.mp (integral_closure R g.splitting_field).range_algebra_map _).mpr $
+      roots_mem_integral_closure hf _),
+  { rw [lifts_iff_coeff_lifts, ←ring_hom.coe_range, subalgebra.range_algebra_map] at this,
+    refine (lifts_iff_coeff_lifts _).2 (λ n, _),
+    rw [← ring_hom.coe_range, subalgebra.range_algebra_map],
+    obtain ⟨p, hp, he⟩ :=  (set_like.mem_coe.mp (this n)), use [p, hp],
+    rw [is_scalar_tower.algebra_map_eq R K, coeff_map, ← eval₂_map, eval₂_at_apply] at he,
+    rw eval₂_eq_eval_map, apply (injective_iff_map_eq_zero _).1 _ _ he,
+    { apply ring_hom.injective } },
+  rw [is_scalar_tower.algebra_map_eq R K _, ← map_map],
+  refine multiset.mem_of_le (roots.le_of_dvd ((hf.map _).map _).ne_zero _) ha,
+  { apply_instance },
+  { exact map_dvd (algebra_map K g.splitting_field) hd },
+  { apply_instance }
+end
+
+variables [is_domain R] [is_fraction_ring R K]
+
+/-- If `K = Frac(R)` and `g : K[X]` divides a monic polynomial with coefficients in `R`, then
+    `g * (C g.leading_coeff⁻¹)` has coefficients in `R` -/
+lemma is_integrally_closed.eq_map_mul_C_of_dvd [is_integrally_closed R] {f : R[X]} (hf : f.monic)
+  {g : K[X]} (hg : g ∣ f.map (algebra_map R K)) :
+  ∃ g' : R[X], (g'.map (algebra_map R K)) * (C $ leading_coeff g) = g :=
+begin
+  have g_ne_0 : g ≠ 0 := ne_zero_of_dvd_ne_zero (monic.ne_zero $ hf.map (algebra_map R K)) hg,
+  suffices lem : ∃ g' : R[X], g'.map (algebra_map R K) = g * (C g.leading_coeff⁻¹),
+  { obtain ⟨g', hg'⟩ := lem,
+    use g',
+    rw [hg', mul_assoc, ← C_mul, inv_mul_cancel (leading_coeff_ne_zero.mpr g_ne_0), C_1, mul_one] },
+
+  have g_mul_dvd : g * (C g.leading_coeff⁻¹) ∣ f.map (algebra_map R K),
+  { rwa associated.dvd_iff_dvd_left (show associated (g * (C (g.leading_coeff⁻¹))) g, from _),
+    rw associated_mul_is_unit_left_iff,
+    exact is_unit_C.mpr (inv_ne_zero $ leading_coeff_ne_zero.mpr g_ne_0).is_unit },
+  let algeq := (subalgebra.equiv_of_eq _ _ $ integral_closure_eq_bot R _).trans
+    (algebra.bot_equiv_of_injective $ is_fraction_ring.injective R $ K),
+  have : (algebra_map R _).comp algeq.to_alg_hom.to_ring_hom =
+    (integral_closure R _).to_subring.subtype,
+  { ext, conv_rhs { rw ← algeq.symm_apply_apply x }, refl },
+  have H := ((mem_lifts _).1 (integral_closure.mem_lifts_of_monic_of_dvd_map K hf
+    (monic_mul_leading_coeff_inv g_ne_0) g_mul_dvd)),
+  refine ⟨map algeq.to_alg_hom.to_ring_hom _, _⟩,
+  use classical.some H,
+  rw [map_map, this],
+  exact classical.some_spec H
+end
+
+end is_integrally_closed
 
 namespace polynomial
-section normalized_gcd_monoid
-variable [normalized_gcd_monoid R]
 
 section
-variables {S : Type*} [comm_ring S] [is_domain S] {φ : R →+* S} (hinj : function.injective φ)
-variables {f : R[X]} (hf : f.is_primitive)
+variables {S : Type*} [comm_ring S] [is_domain S]
+variables {φ : R →+* S} (hinj : function.injective φ) {f : R[X]} (hf : f.is_primitive)
 include hinj hf
 
 lemma is_primitive.is_unit_iff_is_unit_map_of_injective :
@@ -43,34 +119,109 @@ begin
   rcases is_unit_iff.1 h with ⟨_, ⟨u, rfl⟩, hu⟩,
   have hdeg := degree_C u.ne_zero,
   rw [hu, degree_map_eq_of_injective hinj] at hdeg,
-  rw [eq_C_of_degree_eq_zero hdeg, is_primitive_iff_content_eq_one,
-      content_C, normalize_eq_one] at hf,
-  rwa [eq_C_of_degree_eq_zero hdeg, is_unit_C],
+  rw [eq_C_of_degree_eq_zero hdeg] at hf ⊢,
+  exact is_unit_C.mpr (is_primitive_iff_is_unit_of_C_dvd.mp hf (f.coeff 0) dvd_rfl),
 end
 
 lemma is_primitive.irreducible_of_irreducible_map_of_injective (h_irr : irreducible (map φ f)) :
   irreducible f :=
 begin
-  refine ⟨λ h, h_irr.not_unit (is_unit.map (map_ring_hom φ) h), _⟩,
-  intros a b h,
-  rcases h_irr.is_unit_or_is_unit (by rw [h, polynomial.map_mul]) with hu | hu,
-  { left,
-    rwa (hf.is_primitive_of_dvd (dvd.intro _ h.symm)).is_unit_iff_is_unit_map_of_injective hinj },
-  right,
-  rwa (hf.is_primitive_of_dvd (dvd.intro_left _ h.symm)).is_unit_iff_is_unit_map_of_injective hinj
+  refine ⟨λ h, h_irr.not_unit (is_unit.map (map_ring_hom φ) h),
+    λ a b h, (h_irr.is_unit_or_is_unit $ by rw [h, polynomial.map_mul]).imp _ _⟩,
+  all_goals { apply ((is_primitive_of_dvd hf _).is_unit_iff_is_unit_map_of_injective hinj).mpr },
+  exacts [(dvd.intro _ h.symm), dvd.intro_left _ h.symm],
 end
 
 end
 
 section fraction_map
+
 variables {K : Type*} [field K] [algebra R K] [is_fraction_ring R K]
 
 lemma is_primitive.is_unit_iff_is_unit_map {p : R[X]} (hp : p.is_primitive) :
   is_unit p ↔ is_unit (p.map (algebra_map R K)) :=
 hp.is_unit_iff_is_unit_map_of_injective (is_fraction_ring.injective _ _)
 
+variable [is_domain R]
+
+section is_integrally_closed
+
+open is_integrally_closed
+
+/-- **Gauss's Lemma** for integrally closed domains states that a monic polynomial is irreducible
+  iff it is irreducible in the fraction field. -/
+theorem monic.irreducible_iff_irreducible_map_fraction_map [is_integrally_closed R] {p : R[X]}
+  (h : p.monic) : irreducible p ↔ irreducible (p.map $ algebra_map R K) :=
+begin
+  /- The ← direction follows from `is_primitive.irreducible_of_irreducible_map_of_injective`.
+     For the → direction, it is enought to show that if `(p.map $ algebra_map R K) = a * b` and
+     `a` is not a unit then `b` is a unit -/
+  refine ⟨λ hp, irreducible_iff.mpr ⟨hp.not_unit.imp h.is_primitive.is_unit_iff_is_unit_map.mpr,
+    λ a b H, or_iff_not_imp_left.mpr (λ hₐ, _)⟩,
+    λ hp, h.is_primitive.irreducible_of_irreducible_map_of_injective
+      (is_fraction_ring.injective R K) hp⟩,
+
+  obtain ⟨a', ha⟩ := eq_map_mul_C_of_dvd K h (dvd_of_mul_right_eq b H.symm),
+  obtain ⟨b', hb⟩ := eq_map_mul_C_of_dvd K h (dvd_of_mul_left_eq a H.symm),
+
+  have : a.leading_coeff * b.leading_coeff = 1,
+  { rw [← leading_coeff_mul, ← H, monic.leading_coeff (h.map $ algebra_map R K)] },
+
+  rw [← ha, ← hb, mul_comm _ (C b.leading_coeff), mul_assoc, ← mul_assoc (C a.leading_coeff),
+    ← C_mul, this, C_1, one_mul, ← polynomial.map_mul] at H,
+  rw [← hb, ← polynomial.coe_map_ring_hom],
+  refine is_unit.mul
+    (is_unit.map _ (or.resolve_left (hp.is_unit_or_is_unit _) (show ¬ is_unit a', from _)))
+    (is_unit_iff_exists_inv'.mpr (exists.intro (C a.leading_coeff) $ by rwa [← C_mul, this, C_1])),
+  { exact polynomial.map_injective _ (is_fraction_ring.injective R K) H },
+
+  { by_contra h_contra,
+    refine hₐ _,
+    rw [← ha, ← polynomial.coe_map_ring_hom],
+    exact is_unit.mul (is_unit.map _ h_contra) (is_unit_iff_exists_inv.mpr
+      (exists.intro (C b.leading_coeff) $ by rwa [← C_mul, this, C_1])) },
+end
+
+/-- Integrally closed domains are precisely the domains for in which Gauss's lemma holds
+    for monic polynomials -/
+theorem is_integrally_closed_iff' : is_integrally_closed R ↔
+  ∀ p : R[X], p.monic → (irreducible p ↔ irreducible (p.map $ algebra_map R K)) :=
+begin
+  split,
+  { intros hR p hp, letI := hR, exact monic.irreducible_iff_irreducible_map_fraction_map hp },
+  { intro H,
+    refine (is_integrally_closed_iff K).mpr (λ x hx, ring_hom.mem_range.mp $
+      minpoly.mem_range_of_degree_eq_one R x _),
+    rw ← monic.degree_map (minpoly.monic hx) (algebra_map R K),
+    apply degree_eq_one_of_irreducible_of_root ((H _ $ minpoly.monic hx).mp
+      (minpoly.irreducible hx)),
+    rw [is_root, eval_map, ← aeval_def, minpoly.aeval R x] },
+end
+
+theorem monic.dvd_of_fraction_map_dvd_fraction_map [is_integrally_closed R] {p q : R[X]}
+  (hp : p.monic ) (hq : q.monic) (h : q.map (algebra_map R K) ∣ p.map (algebra_map R K)) : q ∣ p :=
+begin
+  obtain ⟨r, hr⟩ := h,
+  obtain ⟨d', hr'⟩ := is_integrally_closed.eq_map_mul_C_of_dvd K hp (dvd_of_mul_left_eq _ hr.symm),
+  rw [monic.leading_coeff, C_1, mul_one] at hr',
+  rw [← hr', ← polynomial.map_mul] at hr,
+  exact dvd_of_mul_right_eq _ (polynomial.map_injective _ (is_fraction_ring.injective R K) hr.symm),
+   { exact monic.of_mul_monic_left (hq.map (algebra_map R K)) (by simpa [←hr] using hp.map _) },
+end
+
+theorem monic.dvd_iff_fraction_map_dvd_fraction_map [is_integrally_closed R] {p q : R[X]}
+  (hp : p.monic ) (hq : q.monic) : q.map (algebra_map R K) ∣ p.map (algebra_map R K) ↔ q ∣ p :=
+⟨λ h, hp.dvd_of_fraction_map_dvd_fraction_map hq h,
+  λ ⟨a,b⟩, ⟨a.map (algebra_map R K), b.symm ▸ polynomial.map_mul (algebra_map R K)⟩⟩
+
+end is_integrally_closed
+
 open is_localization
 
+section normalized_gcd_monoid
+
+variable [normalized_gcd_monoid R]
+
 lemma is_unit_or_eq_zero_of_is_unit_integer_normalization_prim_part
   {p : K[X]} (h0 : p ≠ 0) (h : is_unit (integer_normalization R⁰ p).prim_part) :
   is_unit p :=
@@ -91,8 +242,8 @@ begin
   { apply units.ne_zero _ con },
 end
 
-/-- **Gauss's Lemma** states that a primitive polynomial is irreducible iff it is irreducible in the
-  fraction field. -/
+/-- **Gauss's Lemma** for GCD domains states that a primitive polynomial is irreducible iff it is
+  irreducible in the fraction field. -/
 theorem is_primitive.irreducible_iff_irreducible_map_fraction_map
   {p : R[X]} (hp : p.is_primitive) :
   irreducible p ↔ irreducible (p.map (algebra_map R K)) :=
@@ -167,6 +318,8 @@ lemma is_primitive.dvd_iff_fraction_map_dvd_fraction_map {p q : R[X]}
 ⟨λ ⟨a,b⟩, ⟨a.map (algebra_map R K), b.symm ▸ polynomial.map_mul (algebra_map R K)⟩,
   λ h, hp.dvd_of_fraction_map_dvd_fraction_map hq h⟩
 
+end normalized_gcd_monoid
+
 end fraction_map
 
 /-- **Gauss's Lemma** for `ℤ` states that a primitive integer polynomial is irreducible iff it is
@@ -181,5 +334,4 @@ lemma is_primitive.int.dvd_iff_map_cast_dvd_map_cast (p q : ℤ[X])
   (p ∣ q) ↔ (p.map (int.cast_ring_hom ℚ) ∣ q.map (int.cast_ring_hom ℚ)) :=
 hp.dvd_iff_fraction_map_dvd_fraction_map ℚ hq
 
-end normalized_gcd_monoid
 end polynomial
diff --git a/src/ring_theory/polynomial/hermite/basic.lean b/src/ring_theory/polynomial/hermite/basic.lean
new file mode 100644
index 0000000000000..8c324c3e962c8
--- /dev/null
+++ b/src/ring_theory/polynomial/hermite/basic.lean
@@ -0,0 +1,212 @@
+/-
+Copyright (c) 2023 Luke Mantle. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Luke Mantle
+-/
+
+import data.polynomial.derivative
+import data.nat.parity
+import data.nat.factorial.double_factorial
+/-!
+# Hermite polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines `polynomial.hermite n`, the nth probabilist's Hermite polynomial.
+
+## Main definitions
+
+* `polynomial.hermite n`: the `n`th probabilist's Hermite polynomial,
+  defined recursively as a `polynomial ℤ`
+
+## Results
+
+* `polynomial.hermite_succ`: the recursion `hermite (n+1) = (x - d/dx) (hermite n)`
+* `polynomial.coeff_hermite_explicit`: a closed formula for (nonvanishing) coefficients in terms
+  of binomial coefficients and double factorials.
+* `polynomial.coeff_hermite_of_odd_add`: for `n`,`k` where `n+k` is odd, `(hermite n).coeff k` is
+  zero.
+* `polynomial.coeff_hermite_of_even_add`: a closed formula for `(hermite n).coeff k` when `n+k` is
+  even, equivalent to `polynomial.coeff_hermite_explicit`.
+* `polynomial.monic_hermite`: for all `n`, `hermite n` is monic.
+* `polynomial.degree_hermite`: for all `n`, `hermite n` has degree `n`.
+
+## References
+
+* [Hermite Polynomials](https://en.wikipedia.org/wiki/Hermite_polynomials)
+
+-/
+
+noncomputable theory
+open polynomial
+
+namespace polynomial
+
+/-- the nth probabilist's Hermite polynomial -/
+noncomputable def hermite : ℕ → polynomial ℤ
+| 0     := 1
+| (n+1) := X * (hermite n) - (hermite n).derivative
+
+/-- The recursion `hermite (n+1) = (x - d/dx) (hermite n)` -/
+@[simp] lemma hermite_succ (n : ℕ) : hermite (n+1) = X * (hermite n) - (hermite n).derivative :=
+by rw hermite
+
+lemma hermite_eq_iterate (n : ℕ) : hermite n = ((λ p, X*p - p.derivative)^[n] 1) :=
+begin
+  induction n with n ih,
+  { refl },
+  { rw [function.iterate_succ_apply', ← ih, hermite_succ] }
+end
+
+@[simp] lemma hermite_zero : hermite 0 = C 1 := rfl
+
+@[simp] lemma hermite_one : hermite 1 = X :=
+begin
+  rw [hermite_succ, hermite_zero],
+  simp only [map_one, mul_one, derivative_one, sub_zero]
+end
+
+/-! ### Lemmas about `polynomial.coeff` -/
+
+section coeff
+
+lemma coeff_hermite_succ_zero (n : ℕ) :
+  coeff (hermite (n + 1)) 0 = -(coeff (hermite n) 1) := by simp [coeff_derivative]
+
+lemma coeff_hermite_succ_succ (n k : ℕ) :
+  coeff (hermite (n + 1)) (k + 1) = coeff (hermite n) k - (k + 2) * (coeff (hermite n) (k + 2)) :=
+begin
+  rw [hermite_succ, coeff_sub, coeff_X_mul, coeff_derivative, mul_comm],
+  norm_cast
+end
+
+lemma coeff_hermite_of_lt {n k : ℕ} (hnk : n < k) : coeff (hermite n) k = 0 :=
+begin
+  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_lt hnk,
+  clear hnk,
+  induction n with n ih generalizing k,
+  { apply coeff_C },
+  { have : n + k + 1 + 2 = n + (k + 2) + 1 := by ring,
+    rw [nat.succ_eq_add_one, coeff_hermite_succ_succ, add_right_comm, this, ih k, ih (k + 2),
+      mul_zero, sub_zero] }
+end
+
+@[simp] lemma coeff_hermite_self (n : ℕ) : coeff (hermite n) n = 1 :=
+begin
+  induction n with n ih,
+  { apply coeff_C },
+  { rw [coeff_hermite_succ_succ, ih, coeff_hermite_of_lt, mul_zero, sub_zero],
+    simp }
+end
+
+@[simp] lemma degree_hermite (n : ℕ) : (hermite n).degree = n :=
+begin
+  rw degree_eq_of_le_of_coeff_ne_zero,
+  simp_rw [degree_le_iff_coeff_zero, with_bot.coe_lt_coe],
+  { intro m,
+    exact coeff_hermite_of_lt },
+  { simp [coeff_hermite_self n] }
+end
+
+@[simp] lemma nat_degree_hermite {n : ℕ} : (hermite n).nat_degree = n :=
+nat_degree_eq_of_degree_eq_some (degree_hermite n)
+
+@[simp] lemma leading_coeff_hermite (n : ℕ) : (hermite n).leading_coeff = 1 :=
+begin
+  rw [← coeff_nat_degree, nat_degree_hermite, coeff_hermite_self],
+end
+
+lemma hermite_monic (n : ℕ) : (hermite n).monic := leading_coeff_hermite n
+
+lemma coeff_hermite_of_odd_add {n k : ℕ} (hnk : odd (n + k)) : coeff (hermite n) k = 0 :=
+begin
+  induction n with n ih generalizing k,
+  { rw zero_add at hnk,
+    exact coeff_hermite_of_lt hnk.pos },
+  { cases k,
+    { rw nat.succ_add_eq_succ_add at hnk,
+      rw [coeff_hermite_succ_zero, ih hnk, neg_zero] },
+    { rw [coeff_hermite_succ_succ, ih, ih, mul_zero, sub_zero],
+      { rwa [nat.succ_add_eq_succ_add] at hnk },
+      { rw (by rw [nat.succ_add, nat.add_succ] : n.succ + k.succ = n + k + 2) at hnk,
+        exact (nat.odd_add.mp hnk).mpr even_two }}}
+end
+
+end coeff
+
+section coeff_explicit
+
+open_locale nat
+
+/-- Because of `coeff_hermite_of_odd_add`, every nonzero coefficient is described as follows. -/
+lemma coeff_hermite_explicit :
+  ∀ (n k : ℕ), coeff (hermite (2 * n + k)) k = (-1)^n * (2 * n - 1)‼ * nat.choose (2 * n + k) k
+| 0 _ := by simp
+| (n + 1) 0 := begin
+  convert coeff_hermite_succ_zero (2 * n + 1) using 1,
+  rw [coeff_hermite_explicit n 1,
+      (by ring_nf : 2 * (n + 1) - 1 = 2 * n + 1), nat.double_factorial_add_one,
+      nat.choose_zero_right, nat.choose_one_right, pow_succ],
+  push_cast,
+  ring,
+end
+| (n + 1) (k + 1) := begin
+  let hermite_explicit : ℕ → ℕ → ℤ :=
+      λ n k, (-1)^n * (2*n-1)‼ * nat.choose (2*n+k) k,
+  have hermite_explicit_recur :
+      ∀ (n k : ℕ),
+        hermite_explicit (n + 1) (k + 1) =
+        hermite_explicit (n + 1) k - (k + 2) * hermite_explicit n (k + 2) :=
+    begin
+      intros n k,
+      simp only [hermite_explicit],
+      -- Factor out (-1)'s.
+      rw [mul_comm (↑k + _), sub_eq_add_neg],
+      nth_rewrite 2 neg_eq_neg_one_mul,
+      simp only [mul_assoc, ← mul_add, pow_succ],
+      congr' 2,
+      -- Factor out double factorials.
+      norm_cast,
+      rw [(by ring_nf : 2 * (n + 1) - 1 = 2 * n + 1),
+          nat.double_factorial_add_one, mul_comm (2 * n + 1)],
+      simp only [mul_assoc, ← mul_add],
+      congr' 1,
+      -- Match up binomial coefficients using `nat.choose_succ_right_eq`.
+      rw [(by ring : 2 * (n + 1) + (k + 1) = (2 * n + 1) + (k + 1) + 1),
+          (by ring : 2 * (n + 1) + k = (2 * n + 1) + (k + 1)),
+          (by ring : 2 * n + (k + 2) = (2 * n + 1) + (k + 1))],
+      rw [nat.choose, nat.choose_succ_right_eq ((2 * n + 1) + (k + 1)) (k + 1),
+          nat.add_sub_cancel],
+      ring,
+    end,
+  change _ = hermite_explicit _ _,
+  rw [← add_assoc, coeff_hermite_succ_succ, hermite_explicit_recur],
+  congr,
+  { rw coeff_hermite_explicit (n + 1) k },
+  { rw [(by ring : 2 * (n + 1) + k = 2 * n + (k + 2)), coeff_hermite_explicit n (k + 2)] },
+end
+
+lemma coeff_hermite_of_even_add {n k : ℕ} (hnk : even (n + k)) :
+  coeff (hermite n) k = (-1)^((n - k) / 2) * (n - k - 1)‼ * nat.choose n k :=
+begin
+  cases le_or_lt k n with h_le h_lt,
+  { rw [nat.even_add, ← (nat.even_sub h_le)] at hnk,
+    obtain ⟨m, hm⟩ := hnk,
+    rw [(by linarith : n = 2 * m + k), nat.add_sub_cancel,
+        nat.mul_div_cancel_left _ (nat.succ_pos 1), coeff_hermite_explicit] },
+  { simp [nat.choose_eq_zero_of_lt h_lt, coeff_hermite_of_lt h_lt] },
+end
+
+lemma coeff_hermite (n k : ℕ) :
+  coeff (hermite n) k =
+  if even (n + k) then (-1)^((n - k) / 2) * (n - k - 1)‼ * nat.choose n k else 0 :=
+begin
+  split_ifs with h,
+  exact coeff_hermite_of_even_add h,
+  exact coeff_hermite_of_odd_add (nat.odd_iff_not_even.mpr h),
+end
+
+end coeff_explicit
+
+end polynomial
diff --git a/src/ring_theory/polynomial/hermite/gaussian.lean b/src/ring_theory/polynomial/hermite/gaussian.lean
new file mode 100644
index 0000000000000..307939d32d9fa
--- /dev/null
+++ b/src/ring_theory/polynomial/hermite/gaussian.lean
@@ -0,0 +1,75 @@
+/-
+Copyright (c) 2023 Luke Mantle. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Luke Mantle, Jake Levinson
+-/
+import ring_theory.polynomial.hermite.basic
+import analysis.calculus.deriv.pow
+import analysis.calculus.deriv.add
+import analysis.special_functions.exp
+import analysis.special_functions.exp_deriv
+
+/-!
+# Hermite polynomials and Gaussians
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file shows that the Hermite polynomial `hermite n` is (up to sign) the
+polynomial factor occurring in the `n`th derivative of a gaussian.
+
+## Results
+
+* `polynomial.deriv_gaussian_eq_hermite_mul_gaussian`:
+  The Hermite polynomial is (up to sign) the polynomial factor occurring in the
+  `n`th derivative of a gaussian.
+
+## References
+
+* [Hermite Polynomials](https://en.wikipedia.org/wiki/Hermite_polynomials)
+
+-/
+
+noncomputable theory
+open polynomial
+
+namespace polynomial
+
+/-- `hermite n` is (up to sign) the factor appearing in `deriv^[n]` of a gaussian -/
+lemma deriv_gaussian_eq_hermite_mul_gaussian (n : ℕ) (x : ℝ) :
+  deriv^[n] (λ y, real.exp (-(y^2 / 2))) x =
+  (-1 : ℝ)^n * aeval x (hermite n) * real.exp (-(x^2 / 2)) :=
+begin
+  rw mul_assoc,
+  induction n with n ih generalizing x,
+  { rw [function.iterate_zero_apply, pow_zero, one_mul, hermite_zero, C_1, map_one, one_mul] },
+  { replace ih : (deriv^[n] _) = _ := _root_.funext ih,
+    have deriv_gaussian : deriv (λ y, real.exp (-(y^2 / 2))) x = (-x) * real.exp (-(x^2 / 2)),
+    { simp [mul_comm, ← neg_mul] },
+    rw [function.iterate_succ_apply', ih, deriv_const_mul_field, deriv_mul, pow_succ (-1 : ℝ),
+        deriv_gaussian, hermite_succ, map_sub, map_mul, aeval_X, polynomial.deriv_aeval],
+    ring,
+    { apply polynomial.differentiable_aeval },
+    { simp } }
+end
+
+lemma hermite_eq_deriv_gaussian (n : ℕ) (x : ℝ) :
+  aeval x (hermite n) =
+  (-1 : ℝ)^n * (deriv^[n] (λ y, real.exp (-(y^2 / 2))) x) / real.exp (-(x^2 / 2)) :=
+begin
+  rw deriv_gaussian_eq_hermite_mul_gaussian,
+  field_simp [real.exp_ne_zero],
+  rw [← @smul_eq_mul ℝ _ ((-1)^n), ← inv_smul_eq_iff₀, mul_assoc, smul_eq_mul,
+      ← inv_pow, ← neg_inv, inv_one],
+  exact pow_ne_zero _ (by norm_num),
+end
+
+lemma hermite_eq_deriv_gaussian' (n : ℕ) (x : ℝ) :
+  aeval x (hermite n) =
+  (-1 : ℝ)^n * (deriv^[n] (λ y, real.exp (-(y^2 / 2))) x) * real.exp (x^2 / 2) :=
+begin
+  rw [hermite_eq_deriv_gaussian, real.exp_neg],
+  field_simp [real.exp_ne_zero],
+end
+
+end polynomial
diff --git a/src/ring_theory/polynomial/opposites.lean b/src/ring_theory/polynomial/opposites.lean
index 63f16474e19bf..4ecea9805d529 100644
--- a/src/ring_theory/polynomial/opposites.lean
+++ b/src/ring_theory/polynomial/opposites.lean
@@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Damiano Testa
 -/
 
-import data.polynomial.induction
 import data.polynomial.degree.definitions
 
 /-!  #  Interactions between `R[X]` and `Rᵐᵒᵖ[X]`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the basic API for "pushing through" the isomorphism
 `op_ring_equiv : R[X]ᵐᵒᵖ ≃+* Rᵐᵒᵖ[X]`.  It allows going back and forth between a polynomial ring
 over a semiring and the polynomial ring over the opposite semiring. -/
@@ -66,7 +68,7 @@ op_ring_equiv_symm_monomial 1 1
 
 lemma op_ring_equiv_symm_C_mul_X_pow (r : Rᵐᵒᵖ) (n : ℕ) :
   (op_ring_equiv R).symm (C r * X ^ n : Rᵐᵒᵖ[X]) = op (C (unop r) * X ^ n) :=
-by rw [← monomial_eq_C_mul_X, op_ring_equiv_symm_monomial, monomial_eq_C_mul_X]
+by rw [C_mul_X_pow_eq_monomial, op_ring_equiv_symm_monomial, ← C_mul_X_pow_eq_monomial]
 
 /-!  Lemmas about more global properties of polynomials and opposites. -/
 @[simp] lemma coeff_op_ring_equiv (p : R[X]ᵐᵒᵖ) (n : ℕ) :
diff --git a/src/ring_theory/polynomial/pochhammer.lean b/src/ring_theory/polynomial/pochhammer.lean
index 81f5de17ff7a7..2a9d59baac6c1 100644
--- a/src/ring_theory/polynomial/pochhammer.lean
+++ b/src/ring_theory/polynomial/pochhammer.lean
@@ -9,6 +9,9 @@ import data.polynomial.eval
 /-!
 # The Pochhammer polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define and prove some basic relations about
 `pochhammer S n : S[X] := X * (X + 1) * ... * (X + n - 1)`
 which is also known as the rising factorial. A version of this definition
@@ -88,8 +91,7 @@ begin
   { simp, },
   { conv_lhs
   { rw [pochhammer_succ_left, ih, mul_comp, ←mul_assoc, ←pochhammer_succ_left, add_comp, X_comp,
-      nat_cast_comp, add_assoc, add_comm (1 : ℕ[X])], },
-    refl, },
+      nat_cast_comp, add_assoc, add_comm (1 : ℕ[X]), ← nat.cast_succ] } },
 end
 
 lemma pochhammer_succ_eval {S : Type*} [semiring S] (n : ℕ) (k : S) :
@@ -146,8 +148,8 @@ end
 
 end semiring
 
-section ordered_semiring
-variables {S : Type*} [ordered_semiring S] [nontrivial S]
+section strict_ordered_semiring
+variables {S : Type*} [strict_ordered_semiring S]
 
 lemma pochhammer_pos (n : ℕ) (s : S) (h : 0 < s) : 0 < (pochhammer S n).eval s :=
 begin
@@ -159,7 +161,7 @@ begin
       (lt_of_lt_of_le h ((le_add_iff_nonneg_right _).mpr (nat.cast_nonneg n))), }
 end
 
-end ordered_semiring
+end strict_ordered_semiring
 
 section factorial
 
diff --git a/src/ring_theory/polynomial/quotient.lean b/src/ring_theory/polynomial/quotient.lean
new file mode 100644
index 0000000000000..c476511b7c122
--- /dev/null
+++ b/src/ring_theory/polynomial/quotient.lean
@@ -0,0 +1,243 @@
+/-
+Copyright (c) 2019 Kenny Lau. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kenny Lau, David Kurniadi Angdinata, Devon Tuma, Riccardo Brasca
+-/
+
+import data.polynomial.div
+import ring_theory.polynomial.basic
+import ring_theory.ideal.quotient_operations
+
+/-!
+# Quotients of polynomial rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open_locale polynomial
+
+namespace polynomial
+
+variables {R : Type*} [comm_ring R]
+
+/-- For a commutative ring $R$, evaluating a polynomial at an element $x \in R$ induces an
+isomorphism of $R$-algebras $R[X] / \langle X - x \rangle \cong R$. -/
+noncomputable def quotient_span_X_sub_C_alg_equiv (x : R) :
+  (R[X] ⧸ ideal.span ({X - C x} : set R[X])) ≃ₐ[R] R :=
+(ideal.quotient_equiv_alg_of_eq R
+  (by exact ker_eval_ring_hom x : ring_hom.ker (aeval x).to_ring_hom = _)).symm.trans $
+  ideal.quotient_ker_alg_equiv_of_right_inverse $ λ _, eval_C
+
+@[simp] lemma quotient_span_X_sub_C_alg_equiv_mk (x : R) (p : R[X]) :
+  quotient_span_X_sub_C_alg_equiv x (ideal.quotient.mk _ p) = p.eval x :=
+rfl
+
+@[simp] lemma quotient_span_X_sub_C_alg_equiv_symm_apply (x : R) (y : R) :
+  (quotient_span_X_sub_C_alg_equiv x).symm y = algebra_map R _ y :=
+rfl
+
+/-- For a commutative ring $R$, evaluating a polynomial at an element $y \in R$ induces an
+isomorphism of $R$-algebras $R[X] / \langle x, X - y \rangle \cong R / \langle x \rangle$. -/
+noncomputable def quotient_span_C_X_sub_C_alg_equiv (x y : R) :
+  (R[X] ⧸ (ideal.span {C x, X - C y} : ideal R[X])) ≃ₐ[R] R ⧸ (ideal.span {x} : ideal R) :=
+(ideal.quotient_equiv_alg_of_eq R $ by rw [ideal.span_insert, sup_comm]).trans $
+  (double_quot.quot_quot_equiv_quot_supₐ R _ _).symm.trans $
+    (ideal.quotient_equiv_alg _ _ (quotient_span_X_sub_C_alg_equiv y) rfl).trans $
+      ideal.quotient_equiv_alg_of_eq R $
+        by { simp only [ideal.map_span, set.image_singleton], congr' 2, exact eval_C }
+
+end polynomial
+
+namespace ideal
+
+noncomputable theory
+
+open polynomial
+
+variables {R : Type*} [comm_ring R]
+
+lemma quotient_map_C_eq_zero {I : ideal R} :
+  ∀ a ∈ I, ((quotient.mk (map (C : R →+* R[X]) I : ideal R[X])).comp C) a = 0 :=
+begin
+  intros a ha,
+  rw [ring_hom.comp_apply, quotient.eq_zero_iff_mem],
+  exact mem_map_of_mem _ ha,
+end
+
+lemma eval₂_C_mk_eq_zero {I : ideal R} :
+  ∀ f ∈ (map (C : R →+* R[X]) I : ideal R[X]), eval₂_ring_hom (C.comp (quotient.mk I)) X f = 0 :=
+begin
+  intros a ha,
+  rw ← sum_monomial_eq a,
+  dsimp,
+  rw eval₂_sum,
+  refine finset.sum_eq_zero (λ n hn, _),
+  dsimp,
+  rw eval₂_monomial (C.comp (quotient.mk I)) X,
+  refine mul_eq_zero_of_left (polynomial.ext (λ m, _)) (X ^ n),
+  erw coeff_C,
+  by_cases h : m = 0,
+  { simpa [h] using quotient.eq_zero_iff_mem.2 ((mem_map_C_iff.1 ha) n) },
+  { simp [h] }
+end
+
+/-- If `I` is an ideal of `R`, then the ring polynomials over the quotient ring `I.quotient` is
+isomorphic to the quotient of `R[X]` by the ideal `map C I`,
+where `map C I` contains exactly the polynomials whose coefficients all lie in `I` -/
+def polynomial_quotient_equiv_quotient_polynomial (I : ideal R) :
+  (R ⧸ I)[X] ≃+* R[X] ⧸ (map C I : ideal R[X]) :=
+{ to_fun := eval₂_ring_hom
+    (quotient.lift I ((quotient.mk (map C I : ideal R[X])).comp C) quotient_map_C_eq_zero)
+    ((quotient.mk (map C I : ideal R[X]) X)),
+  inv_fun := quotient.lift (map C I : ideal R[X])
+    (eval₂_ring_hom (C.comp (quotient.mk I)) X) eval₂_C_mk_eq_zero,
+  map_mul' := λ f g, by simp only [coe_eval₂_ring_hom, eval₂_mul],
+  map_add' := λ f g, by simp only [eval₂_add, coe_eval₂_ring_hom],
+  left_inv := begin
+    intro f,
+    apply polynomial.induction_on' f,
+    { intros p q hp hq,
+      simp only [coe_eval₂_ring_hom] at hp,
+      simp only [coe_eval₂_ring_hom] at hq,
+      simp only [coe_eval₂_ring_hom, hp, hq, ring_hom.map_add] },
+    { rintros n ⟨x⟩,
+      simp only [← smul_X_eq_monomial, C_mul', quotient.lift_mk, submodule.quotient.quot_mk_eq_mk,
+        quotient.mk_eq_mk, eval₂_X_pow, eval₂_smul, coe_eval₂_ring_hom, ring_hom.map_pow,
+        eval₂_C, ring_hom.coe_comp, ring_hom.map_mul, eval₂_X] }
+  end,
+  right_inv := begin
+    rintro ⟨f⟩,
+    apply polynomial.induction_on' f,
+    { simp_intros p q hp hq,
+      rw [hp, hq] },
+    { intros n a,
+      simp only [← smul_X_eq_monomial, ← C_mul' a (X ^ n), quotient.lift_mk,
+        submodule.quotient.quot_mk_eq_mk, quotient.mk_eq_mk, eval₂_X_pow,
+        eval₂_smul, coe_eval₂_ring_hom, ring_hom.map_pow, eval₂_C, ring_hom.coe_comp,
+        ring_hom.map_mul, eval₂_X] },
+  end, }
+
+@[simp]
+lemma polynomial_quotient_equiv_quotient_polynomial_symm_mk (I : ideal R) (f : R[X]) :
+  I.polynomial_quotient_equiv_quotient_polynomial.symm (quotient.mk _ f) = f.map (quotient.mk I) :=
+by rw [polynomial_quotient_equiv_quotient_polynomial, ring_equiv.symm_mk, ring_equiv.coe_mk,
+  ideal.quotient.lift_mk, coe_eval₂_ring_hom, eval₂_eq_eval_map, ←polynomial.map_map,
+  ←eval₂_eq_eval_map, polynomial.eval₂_C_X]
+
+@[simp]
+lemma polynomial_quotient_equiv_quotient_polynomial_map_mk (I : ideal R) (f : R[X]) :
+  I.polynomial_quotient_equiv_quotient_polynomial (f.map I^.quotient.mk) = quotient.mk _ f :=
+begin
+  apply (polynomial_quotient_equiv_quotient_polynomial I).symm.injective,
+  rw [ring_equiv.symm_apply_apply, polynomial_quotient_equiv_quotient_polynomial_symm_mk],
+end
+
+/-- If `P` is a prime ideal of `R`, then `R[x]/(P)` is an integral domain. -/
+lemma is_domain_map_C_quotient {P : ideal R} (H : is_prime P) :
+  is_domain (R[X] ⧸ (map (C : R →+* R[X]) P : ideal R[X])) :=
+ring_equiv.is_domain (polynomial (R ⧸ P))
+  (polynomial_quotient_equiv_quotient_polynomial P).symm
+
+/-- Given any ring `R` and an ideal `I` of `R[X]`, we get a map `R → R[x] → R[x]/I`.
+  If we let `R` be the image of `R` in `R[x]/I` then we also have a map `R[x] → R'[x]`.
+  In particular we can map `I` across this map, to get `I'` and a new map `R' → R'[x] → R'[x]/I`.
+  This theorem shows `I'` will not contain any non-zero constant polynomials
+  -/
+lemma eq_zero_of_polynomial_mem_map_range (I : ideal R[X])
+  (x : ((quotient.mk I).comp C).range)
+  (hx : C x ∈ (I.map (polynomial.map_ring_hom ((quotient.mk I).comp C).range_restrict))) :
+  x = 0 :=
+begin
+  let i := ((quotient.mk I).comp C).range_restrict,
+  have hi' : (polynomial.map_ring_hom i).ker ≤ I,
+  { refine λ f hf, polynomial_mem_ideal_of_coeff_mem_ideal I f (λ n, _),
+    rw [mem_comap, ← quotient.eq_zero_iff_mem, ← ring_hom.comp_apply],
+    rw [ring_hom.mem_ker, coe_map_ring_hom] at hf,
+    replace hf := congr_arg (λ (f : polynomial _), f.coeff n) hf,
+    simp only [coeff_map, coeff_zero] at hf,
+    rwa [subtype.ext_iff, ring_hom.coe_range_restrict] at hf },
+  obtain ⟨x, hx'⟩ := x,
+  obtain ⟨y, rfl⟩ := (ring_hom.mem_range).1 hx',
+  refine subtype.eq _,
+  simp only [ring_hom.comp_apply, quotient.eq_zero_iff_mem, zero_mem_class.coe_zero,
+    subtype.val_eq_coe],
+  suffices : C (i y) ∈ (I.map (polynomial.map_ring_hom i)),
+  { obtain ⟨f, hf⟩ := mem_image_of_mem_map_of_surjective (polynomial.map_ring_hom i)
+      (polynomial.map_surjective _ (((quotient.mk I).comp C).range_restrict_surjective)) this,
+    refine sub_add_cancel (C y) f ▸ I.add_mem (hi' _ : (C y - f) ∈ I) hf.1,
+    rw [ring_hom.mem_ker, ring_hom.map_sub, hf.2, sub_eq_zero, coe_map_ring_hom, map_C] },
+  exact hx,
+end
+
+end ideal
+
+namespace mv_polynomial
+
+variables {R : Type*} {σ : Type*} [comm_ring R] {r : R}
+
+lemma quotient_map_C_eq_zero {I : ideal R} {i : R} (hi : i ∈ I) :
+  (ideal.quotient.mk (ideal.map (C : R →+* mv_polynomial σ R) I :
+  ideal (mv_polynomial σ R))).comp C i = 0 :=
+begin
+  simp only [function.comp_app, ring_hom.coe_comp, ideal.quotient.eq_zero_iff_mem],
+  exact ideal.mem_map_of_mem _ hi
+end
+
+lemma eval₂_C_mk_eq_zero {I : ideal R} {a : mv_polynomial σ R}
+  (ha : a ∈ (ideal.map (C : R →+* mv_polynomial σ R) I : ideal (mv_polynomial σ R))) :
+  eval₂_hom (C.comp (ideal.quotient.mk I)) X a = 0 :=
+begin
+  rw as_sum a,
+  rw [coe_eval₂_hom, eval₂_sum],
+  refine finset.sum_eq_zero (λ n hn, _),
+  simp only [eval₂_monomial, function.comp_app, ring_hom.coe_comp],
+  refine mul_eq_zero_of_left _ _,
+  suffices : coeff n a ∈ I,
+  { rw [← @ideal.mk_ker R _ I, ring_hom.mem_ker] at this,
+    simp only [this, C_0] },
+  exact mem_map_C_iff.1 ha n
+end
+
+/-- If `I` is an ideal of `R`, then the ring `mv_polynomial σ I.quotient` is isomorphic as an
+`R`-algebra to the quotient of `mv_polynomial σ R` by the ideal generated by `I`. -/
+def quotient_equiv_quotient_mv_polynomial (I : ideal R) :
+  mv_polynomial σ (R ⧸ I) ≃ₐ[R]
+    mv_polynomial σ R ⧸ (ideal.map C I : ideal (mv_polynomial σ R)) :=
+{ to_fun := eval₂_hom (ideal.quotient.lift I ((ideal.quotient.mk (ideal.map C I : ideal
+    (mv_polynomial σ R))).comp C) (λ i hi, quotient_map_C_eq_zero hi))
+    (λ i, ideal.quotient.mk (ideal.map C I : ideal (mv_polynomial σ R)) (X i)),
+  inv_fun := ideal.quotient.lift (ideal.map C I : ideal (mv_polynomial σ R))
+    (eval₂_hom (C.comp (ideal.quotient.mk I)) X) (λ a ha, eval₂_C_mk_eq_zero ha),
+  map_mul' := ring_hom.map_mul _,
+  map_add' := ring_hom.map_add _,
+  left_inv := begin
+    intro f,
+    apply induction_on f,
+    { rintro ⟨r⟩,
+      rw [coe_eval₂_hom, eval₂_C],
+      simp only [submodule.quotient.quot_mk_eq_mk, ideal.quotient.lift_mk,
+        mv_polynomial.eval₂_hom_C, function.comp_app, ideal.quotient.mk_eq_mk, mv_polynomial.C_inj,
+        ring_hom.coe_comp], },
+    { simp_intros p q hp hq only [ring_hom.map_add, mv_polynomial.coe_eval₂_hom, coe_eval₂_hom,
+        mv_polynomial.eval₂_add],
+      rw [hp, hq] },
+    { simp_intros p i hp only [coe_eval₂_hom],
+      simp only [hp, coe_eval₂_hom, ideal.quotient.lift_mk, eval₂_mul, ring_hom.map_mul, eval₂_X] }
+  end,
+  right_inv := begin
+    rintro ⟨f⟩,
+    apply induction_on f,
+    { intros r,
+      simp only [submodule.quotient.quot_mk_eq_mk, ideal.quotient.lift_mk, ideal.quotient.mk_eq_mk,
+        ring_hom.coe_comp, eval₂_hom_C] },
+    { simp_intros p q hp hq only [submodule.quotient.quot_mk_eq_mk, eval₂_add,
+        ring_hom.map_add, coe_eval₂_hom, ideal.quotient.lift_mk, ideal.quotient.mk_eq_mk],
+      rw [hp, hq] },
+    { simp_intros p i hp only [submodule.quotient.quot_mk_eq_mk, coe_eval₂_hom,
+        ideal.quotient.lift_mk, ideal.quotient.mk_eq_mk, eval₂_mul, ring_hom.map_mul, eval₂_X],
+      simp only [hp] }
+  end,
+  commutes' := λ r, eval₂_hom_C _ _ (ideal.quotient.mk I r) }
+
+end mv_polynomial
diff --git a/src/ring_theory/polynomial/rational_root.lean b/src/ring_theory/polynomial/rational_root.lean
index 3a908e1cb6dd4..67b786831fd8a 100644
--- a/src/ring_theory/polynomial/rational_root.lean
+++ b/src/ring_theory/polynomial/rational_root.lean
@@ -11,9 +11,12 @@ import ring_theory.polynomial.scale_roots
 /-!
 # Rational root theorem and integral root theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the rational root theorem and integral root theorem.
 The rational root theorem for a unique factorization domain `A`
-with localization `S`, states that the roots of `p : polynomial A` in `A`'s
+with localization `S`, states that the roots of `p : A[X]` in `A`'s
 field of fractions are of the form `x / y` with `x y : A`, `x ∣ p.coeff 0` and
 `y ∣ p.leading_coeff`.
 The corollary is the integral root theorem `is_integer_of_is_root_of_monic`:
diff --git a/src/ring_theory/polynomial/scale_roots.lean b/src/ring_theory/polynomial/scale_roots.lean
index 5c7d9c18bed7c..81f1f9a01c644 100644
--- a/src/ring_theory/polynomial/scale_roots.lean
+++ b/src/ring_theory/polynomial/scale_roots.lean
@@ -10,16 +10,18 @@ import data.polynomial.algebra_map
 /-!
 # Scaling the roots of a polynomial
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `scale_roots p s` for a polynomial `p` in one variable and a ring element `s` to
 be the polynomial with root `r * s` for each root `r` of `p` and proves some basic results about it.
 -/
 
-section scale_roots
-
 variables {A K R S : Type*} [comm_ring A] [is_domain A] [field K] [comm_ring R] [comm_ring S]
 variables {M : submonoid A}
 
-open polynomial
+namespace polynomial
+
 open_locale big_operators polynomial
 
 /-- `scale_roots p s` is a polynomial with root `r * s` for each root `r` of `p`. -/
@@ -84,9 +86,9 @@ lemma monic_scale_roots_iff {p : R[X]} (s : R) :
   monic (scale_roots p s) ↔ monic p :=
 by simp only [monic, leading_coeff, nat_degree_scale_roots, coeff_scale_roots_nat_degree]
 
-lemma scale_roots_eval₂_eq_zero {p : S[X]} (f : S →+* R)
-  {r : R} {s : S} (hr : eval₂ f r p = 0) :
-  eval₂ f (f s * r) (scale_roots p s) = 0 :=
+lemma scale_roots_eval₂_mul {p : S[X]} (f : S →+* R)
+  (r : R) (s : S) :
+  eval₂ f (f s * r) (scale_roots p s) = f s ^ p.nat_degree * eval₂ f r p :=
 calc eval₂ f (f s * r) (scale_roots p s) =
   (scale_roots p s).support.sum (λ i, f (coeff p i * s ^ (p.nat_degree - i)) * (f s * r) ^ i) :
   by simp [eval₂_eq_sum, sum_def]
@@ -103,7 +105,11 @@ calc eval₂ f (f s * r) (scale_roots p s) =
                 exact le_nat_degree_of_ne_zero (polynomial.mem_support_iff.mp hi) })
 ... = f s ^ p.nat_degree * p.support.sum (λ (i : ℕ), (f (p.coeff i) * r ^ i)) : finset.mul_sum.symm
 ... = f s ^ p.nat_degree * eval₂ f r p : by { simp [eval₂_eq_sum, sum_def] }
-... = 0 : by rw [hr, _root_.mul_zero]
+
+lemma scale_roots_eval₂_eq_zero {p : S[X]} (f : S →+* R)
+  {r : R} {s : S} (hr : eval₂ f r p = 0) :
+  eval₂ f (f s * r) (scale_roots p s) = 0 :=
+by rw [scale_roots_eval₂_mul, hr, _root_.mul_zero]
 
 lemma scale_roots_aeval_eq_zero [algebra S R] {p : S[X]}
   {r : R} {s : S} (hr : aeval r p = 0) :
@@ -126,4 +132,11 @@ lemma scale_roots_aeval_eq_zero_of_aeval_div_eq_zero [algebra A K]
   aeval (algebra_map A K r) (scale_roots p s) = 0 :=
 scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero inj hr hs
 
-end scale_roots
+lemma map_scale_roots (p : R[X]) (x : R) (f : R →+* S) (h : f p.leading_coeff ≠ 0) :
+    (p.scale_roots x).map f = (p.map f).scale_roots (f x) :=
+begin
+  ext,
+  simp [polynomial.nat_degree_map_of_leading_coeff_ne_zero _ h],
+end
+
+end polynomial
diff --git a/src/ring_theory/polynomial/selmer.lean b/src/ring_theory/polynomial/selmer.lean
new file mode 100644
index 0000000000000..ba8ec36036055
--- /dev/null
+++ b/src/ring_theory/polynomial/selmer.lean
@@ -0,0 +1,85 @@
+/-
+Copyright (c) 2022 Thomas Browning. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Thomas Browning
+-/
+
+import data.polynomial.unit_trinomial
+import ring_theory.polynomial.gauss_lemma
+import tactic.linear_combination
+
+/-!
+# Irreducibility of Selmer Polynomials
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves irreducibility of the Selmer polynomials `X ^ n - X - 1`.
+
+## Main results
+
+- `polynomial.selmer_irreducible`: The Selmer polynomials `X ^ n - X - 1` are irreducible.
+
+TODO: Show that the Selmer polynomials have full Galois group.
+-/
+
+namespace polynomial
+open_locale polynomial
+
+variables {n : ℕ}
+
+lemma X_pow_sub_X_sub_one_irreducible_aux (z : ℂ) : ¬ (z ^ n = z + 1 ∧ z ^ n + z ^ 2 = 0) :=
+begin
+  rintros ⟨h1, h2⟩,
+  replace h3 : z ^ 3 = 1,
+  { linear_combination (1 - z - z ^ 2 - z ^ n) * h1 + (z ^ n - 2) * h2 }, -- thanks polyrith!
+  have key : z ^ n = 1 ∨ z ^ n = z ∨ z ^ n = z ^ 2,
+  { rw [←nat.mod_add_div n 3, pow_add, pow_mul, h3, one_pow, mul_one],
+    have : n % 3 < 3 := nat.mod_lt n zero_lt_three,
+    interval_cases n % 3; simp only [h, pow_zero, pow_one, eq_self_iff_true, or_true, true_or] },
+  have z_ne_zero : z ≠ 0 :=
+  λ h, zero_ne_one ((zero_pow zero_lt_three).symm.trans (show (0 : ℂ) ^ 3 = 1, from h ▸ h3)),
+  rcases key with key | key | key,
+  { exact z_ne_zero (by rwa [key, self_eq_add_left] at h1) },
+  { exact one_ne_zero (by rwa [key, self_eq_add_right] at h1) },
+  { exact z_ne_zero (pow_eq_zero (by rwa [key, add_self_eq_zero] at h2)) },
+end
+
+lemma X_pow_sub_X_sub_one_irreducible (hn1 : n ≠ 1) : irreducible (X ^ n - X - 1 : ℤ[X]) :=
+begin
+  by_cases hn0 : n = 0,
+  { rw [hn0, pow_zero, sub_sub, add_comm, ←sub_sub, sub_self, zero_sub],
+    exact associated.irreducible ⟨-1, mul_neg_one X⟩ irreducible_X },
+  have hn : 1 < n := nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn0, hn1⟩,
+  have hp : (X ^ n - X - 1 : ℤ[X]) = trinomial 0 1 n (-1) (-1) 1 :=
+    by simp only [trinomial, C_neg, C_1]; ring,
+  rw hp,
+  apply is_unit_trinomial.irreducible_of_coprime' ⟨0, 1, n, zero_lt_one, hn, -1, -1, 1, rfl⟩,
+  rintros z ⟨h1, h2⟩,
+  apply X_pow_sub_X_sub_one_irreducible_aux z,
+  rw [trinomial_mirror zero_lt_one hn (-1 : ℤˣ).ne_zero (1 : ℤˣ).ne_zero] at h2,
+  simp_rw [trinomial, aeval_add, aeval_mul, aeval_X_pow, aeval_C] at h1 h2,
+  simp_rw [units.coe_neg, units.coe_one, map_neg, map_one] at h1 h2,
+  replace h1 : z ^ n = z + 1 := by linear_combination h1,
+  replace h2 := mul_eq_zero_of_left h2 z,
+  rw [add_mul, add_mul, add_zero, mul_assoc (-1 : ℂ), ←pow_succ', nat.sub_add_cancel hn.le] at h2,
+  rw h1 at h2 ⊢,
+  exact ⟨rfl, by linear_combination -h2⟩,
+end
+
+lemma X_pow_sub_X_sub_one_irreducible_rat (hn1 : n ≠ 1) : irreducible (X ^ n - X - 1 : ℚ[X]) :=
+begin
+  by_cases hn0 : n = 0,
+  { rw [hn0, pow_zero, sub_sub, add_comm, ←sub_sub, sub_self, zero_sub],
+    exact associated.irreducible ⟨-1, mul_neg_one X⟩ irreducible_X },
+  have hp : (X ^ n - X - 1 : ℤ[X]) = trinomial 0 1 n (-1) (-1) 1 :=
+  by simp only [trinomial, C_neg, C_1]; ring,
+  have hn : 1 < n := nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn0, hn1⟩,
+  have h := (is_primitive.int.irreducible_iff_irreducible_map_cast _).mp
+    (X_pow_sub_X_sub_one_irreducible hn1),
+  { rwa [polynomial.map_sub, polynomial.map_sub, polynomial.map_pow, polynomial.map_one,
+      polynomial.map_X] at h },
+  { exact hp.symm ▸ (trinomial_monic zero_lt_one hn).is_primitive },
+end
+
+end polynomial
diff --git a/src/ring_theory/polynomial/symmetric.lean b/src/ring_theory/polynomial/symmetric.lean
deleted file mode 100644
index 33310236e4642..0000000000000
--- a/src/ring_theory/polynomial/symmetric.lean
+++ /dev/null
@@ -1,242 +0,0 @@
-/-
-Copyright (c) 2020 Hanting Zhang. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Hanting Zhang, Johan Commelin
--/
-import data.fintype.card
-import data.mv_polynomial.rename
-import data.mv_polynomial.comm_ring
-import algebra.algebra.subalgebra.basic
-
-/-!
-# Symmetric Polynomials and Elementary Symmetric Polynomials
-
-This file defines symmetric `mv_polynomial`s and elementary symmetric `mv_polynomial`s.
-We also prove some basic facts about them.
-
-## Main declarations
-
-* `mv_polynomial.is_symmetric`
-
-* `mv_polynomial.symmetric_subalgebra`
-
-* `mv_polynomial.esymm`
-
-## Notation
-
-+ `esymm σ R n`, is the `n`th elementary symmetric polynomial in `mv_polynomial σ R`.
-
-As in other polynomial files, we typically use the notation:
-
-+ `σ τ : Type*` (indexing the variables)
-
-+ `R S : Type*` `[comm_semiring R]` `[comm_semiring S]` (the coefficients)
-
-+ `r : R` elements of the coefficient ring
-
-+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians
-
-+ `φ ψ : mv_polynomial σ R`
-
--/
-
-open equiv (perm)
-open_locale big_operators
-noncomputable theory
-
-namespace mv_polynomial
-
-variables {σ : Type*} {R : Type*}
-variables {τ : Type*} {S : Type*}
-
-/-- A `mv_polynomial φ` is symmetric if it is invariant under
-permutations of its variables by the  `rename` operation -/
-def is_symmetric [comm_semiring R] (φ : mv_polynomial σ R) : Prop :=
-∀ e : perm σ, rename e φ = φ
-
-variables (σ R)
-
-/-- The subalgebra of symmetric `mv_polynomial`s. -/
-def symmetric_subalgebra [comm_semiring R] : subalgebra R (mv_polynomial σ R) :=
-{ carrier := set_of is_symmetric,
-  algebra_map_mem' := λ r e, rename_C e r,
-  mul_mem' := λ a b ha hb e, by rw [alg_hom.map_mul, ha, hb],
-  add_mem' := λ a b ha hb e, by rw [alg_hom.map_add, ha, hb] }
-
-variables {σ R}
-
-@[simp] lemma mem_symmetric_subalgebra [comm_semiring R] (p : mv_polynomial σ R) :
-  p ∈ symmetric_subalgebra σ R ↔ p.is_symmetric := iff.rfl
-
-namespace is_symmetric
-
-section comm_semiring
-variables [comm_semiring R] [comm_semiring S] {φ ψ : mv_polynomial σ R}
-
-@[simp]
-lemma C (r : R) : is_symmetric (C r : mv_polynomial σ R) :=
-(symmetric_subalgebra σ R).algebra_map_mem r
-
-@[simp]
-lemma zero : is_symmetric (0 : mv_polynomial σ R) :=
-(symmetric_subalgebra σ R).zero_mem
-
-@[simp]
-lemma one : is_symmetric (1 : mv_polynomial σ R) :=
-(symmetric_subalgebra σ R).one_mem
-
-lemma add (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ + ψ) :=
-(symmetric_subalgebra σ R).add_mem hφ hψ
-
-lemma mul (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ * ψ) :=
-(symmetric_subalgebra σ R).mul_mem hφ hψ
-
-lemma smul (r : R) (hφ : is_symmetric φ) : is_symmetric (r • φ) :=
-(symmetric_subalgebra σ R).smul_mem hφ r
-
-@[simp]
-lemma map (hφ : is_symmetric φ) (f : R →+* S) : is_symmetric (map f φ) :=
-λ e, by rw [← map_rename, hφ]
-
-end comm_semiring
-
-section comm_ring
-variables [comm_ring R] {φ ψ : mv_polynomial σ R}
-
-lemma neg (hφ : is_symmetric φ) : is_symmetric (-φ) :=
-(symmetric_subalgebra σ R).neg_mem hφ
-
-lemma sub (hφ : is_symmetric φ) (hψ : is_symmetric ψ) : is_symmetric (φ - ψ) :=
-(symmetric_subalgebra σ R).sub_mem hφ hψ
-
-end comm_ring
-
-end is_symmetric
-
-section elementary_symmetric
-open finset
-variables (σ R) [comm_semiring R] [comm_semiring S] [fintype σ] [fintype τ]
-
-/-- The `n`th elementary symmetric `mv_polynomial σ R`. -/
-def esymm (n : ℕ) : mv_polynomial σ R :=
-∑ t in powerset_len n univ, ∏ i in t, X i
-
-/-- We can define `esymm σ R n` by summing over a subtype instead of over `powerset_len`. -/
-lemma esymm_eq_sum_subtype (n : ℕ) : esymm σ R n =
-  ∑ t : {s : finset σ // s.card = n}, ∏ i in (t : finset σ), X i :=
-begin
-  rw esymm,
-  let i : Π (a : finset σ), a ∈ powerset_len n univ → {s : finset σ // s.card = n} :=
-    λ a ha, ⟨_, (mem_powerset_len.mp ha).2⟩,
-  refine sum_bij i (λ a ha, mem_univ (i a ha)) _ (λ _ _ _ _ hi, subtype.ext_iff_val.mp hi) _,
-  { intros,
-    apply prod_congr,
-    simp only [subtype.coe_mk],
-    intros, refl,},
-  { refine (λ b H, ⟨b.val, mem_powerset_len.mpr ⟨subset_univ b.val, b.property⟩, _⟩),
-    simp [i] },
-end
-
-/-- We can define `esymm σ R n` as a sum over explicit monomials -/
-lemma esymm_eq_sum_monomial (n : ℕ) : esymm σ R n =
-  ∑ t in powerset_len n univ, monomial (∑ i in t, finsupp.single i 1) 1 :=
-begin
-  refine sum_congr rfl (λ x hx, _),
-  rw monic_monomial_eq,
-  rw finsupp.prod_pow,
-  rw ← prod_subset (λ y _, finset.mem_univ y : x ⊆ univ) (λ y _ hy, _),
-  { refine prod_congr rfl (λ x' hx', _),
-    convert (pow_one _).symm,
-    convert (finsupp.apply_add_hom x' : (σ →₀ ℕ) →+ ℕ).map_sum _ x,
-    classical,
-    simp [finsupp.single_apply, finset.filter_eq', apply_ite, apply_ite finset.card],
-    rw if_pos, exact hx', },
-  { convert pow_zero _,
-    convert (finsupp.apply_add_hom y : (σ →₀ ℕ) →+ ℕ).map_sum _ x,
-    classical,
-    simp [finsupp.single_apply, finset.filter_eq', apply_ite, apply_ite finset.card],
-    rw if_neg, exact hy }
-end
-
-@[simp] lemma esymm_zero : esymm σ R 0 = 1 :=
-by simp only [esymm, powerset_len_zero, sum_singleton, prod_empty]
-
-lemma map_esymm (n : ℕ) (f : R →+* S) : map f (esymm σ R n) = esymm σ S n :=
-begin
-  rw [esymm, (map f).map_sum],
-  refine sum_congr rfl (λ x hx, _),
-  rw (map f).map_prod,
-  simp,
-end
-
-lemma rename_esymm (n : ℕ) (e : σ ≃ τ) : rename e (esymm σ R n) = esymm τ R n :=
-begin
-  rw [esymm_eq_sum_subtype, esymm_eq_sum_subtype, (rename ⇑e).map_sum],
-  let e' : {s : finset σ // s.card = n} ≃ {s : finset τ // s.card = n} :=
-    equiv.subtype_equiv (equiv.finset_congr e) (by simp),
-  rw ← equiv.sum_comp e'.symm,
-  apply fintype.sum_congr,
-  intro,
-  calc _ = (∏ i in (e'.symm a : finset σ), (rename e) (X i)) : (rename e).map_prod _ _
-     ... = (∏ i in (a : finset τ), (rename e) (X (e.symm i))) : prod_map (a : finset τ) _ _
-     ... = _ : _,
-  apply finset.prod_congr rfl,
-  intros,
-  simp,
-end
-
-lemma esymm_is_symmetric (n : ℕ) : is_symmetric (esymm σ R n) :=
-by { intro, rw rename_esymm }
-
-lemma support_esymm'' (n : ℕ) [decidable_eq σ] [nontrivial R] :
-  (esymm σ R n).support = (powerset_len n (univ : finset σ)).bUnion
-    (λ t, (finsupp.single (∑ (i : σ) in t, finsupp.single i 1) (1:R)).support) :=
-begin
-  rw esymm_eq_sum_monomial,
-  simp only [← single_eq_monomial],
-  convert finsupp.support_sum_eq_bUnion (powerset_len n (univ : finset σ)) _,
-  intros s t hst d,
-  simp only [finsupp.support_single_ne_zero one_ne_zero, and_imp, inf_eq_inter, mem_inter,
-             mem_singleton],
-  rintro h rfl,
-  have := congr_arg finsupp.support h,
-  rw [finsupp.support_sum_eq_bUnion, finsupp.support_sum_eq_bUnion] at this,
-  { simp only [finsupp.support_single_ne_zero one_ne_zero, bUnion_singleton_eq_self] at this,
-    exact absurd this hst.symm },
-  all_goals { intros x y, simp [finsupp.support_single_disjoint] }
-end
-
-lemma support_esymm' (n : ℕ) [decidable_eq σ] [nontrivial R] :
-  (esymm σ R n).support =
-  (powerset_len n (univ : finset σ)).bUnion (λ t, {∑ (i : σ) in t, finsupp.single i 1}) :=
-begin
-  rw support_esymm'',
-  congr,
-  funext,
-  exact finsupp.support_single_ne_zero one_ne_zero
-end
-
-lemma support_esymm (n : ℕ) [decidable_eq σ] [nontrivial R] :
-  (esymm σ R n).support =
-  (powerset_len n (univ : finset σ)).image (λ t, ∑ (i : σ) in t, finsupp.single i 1) :=
-by { rw support_esymm', exact bUnion_singleton }
-
-lemma degrees_esymm [nontrivial R]
-  (n : ℕ) (hpos : 0 < n) (hn : n ≤ fintype.card σ) :
-  (esymm σ R n).degrees = (univ : finset σ).val :=
-begin
-  classical,
-  have : (finsupp.to_multiset ∘ λ (t : finset σ), ∑ (i : σ) in t, finsupp.single i 1) = finset.val,
-  { funext, simp [finsupp.to_multiset_sum_single] },
-  rw [degrees, support_esymm, sup_finset_image, this, ←comp_sup_eq_sup_comp],
-  { obtain ⟨k, rfl⟩ := nat.exists_eq_succ_of_ne_zero hpos.ne',
-    simpa using powerset_len_sup _ _ (nat.lt_of_succ_le hn) },
-  { intros,
-    simp only [union_val, sup_eq_union],
-    congr },
-  { refl }
-end
-
-end elementary_symmetric
-
-end mv_polynomial
diff --git a/src/ring_theory/polynomial/tower.lean b/src/ring_theory/polynomial/tower.lean
index 39c38f58e0d03..8dc8313ae783e 100644
--- a/src/ring_theory/polynomial/tower.lean
+++ b/src/ring_theory/polynomial/tower.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2020 Kenny Lau. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kenny Lau
+Authors: Kenny Lau, Yuyang Zhao
 -/
 
 import algebra.algebra.tower
@@ -10,27 +10,33 @@ import data.polynomial.algebra_map
 /-!
 # Algebra towers for polynomial
 
-This file proves some basic results about the algebra tower structure for the type `polynomial R`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file proves some basic results about the algebra tower structure for the type `R[X]`.
 
 This structure itself is provided elsewhere as `polynomial.is_scalar_tower`
+
+When you update this file, you can also try to make a corresponding update in
+`ring_theory.mv_polynomial.tower`.
 -/
 
-universes u v w u₁
 open_locale polynomial
 
-variables (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)
+variables (R A B : Type*)
 
-namespace is_scalar_tower
+namespace polynomial
 
 section semiring
-variables [comm_semiring R] [comm_semiring S] [semiring A] [semiring B]
-variables [algebra R S] [algebra S A] [algebra S B] [algebra R A] [algebra R B]
-variables [is_scalar_tower R S A] [is_scalar_tower R S B]
+variables [comm_semiring R] [comm_semiring A] [semiring B]
+variables [algebra R A] [algebra A B] [algebra R B]
+variables [is_scalar_tower R A B]
+
+variables {R B}
 
-variables (R S A) {B}
-theorem aeval_apply (x : A) (p : R[X]) : polynomial.aeval x p =
-  polynomial.aeval x (polynomial.map (algebra_map R S) p) :=
-by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.eval₂_map, algebra_map_eq R S A]
+@[simp] theorem aeval_map_algebra_map (x : B) (p : R[X]) :
+  aeval x (map (algebra_map R A) p) = aeval x p :=
+by rw [aeval_def, aeval_def, eval₂_map, is_scalar_tower.algebra_map_eq R A B]
 
 end semiring
 
@@ -38,41 +44,41 @@ section comm_semiring
 variables [comm_semiring R] [comm_semiring A] [semiring B]
 variables [algebra R A] [algebra A B] [algebra R B] [is_scalar_tower R A B]
 
-lemma algebra_map_aeval (x : A) (p : R[X]) :
-  algebra_map A B (polynomial.aeval x p) = polynomial.aeval (algebra_map A B x) p :=
-by rw [polynomial.aeval_def, polynomial.aeval_def, polynomial.hom_eval₂,
-  ←is_scalar_tower.algebra_map_eq]
-
-lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero {x : A} {p : R[X]}
-  (h : function.injective (algebra_map A B)) (hp : polynomial.aeval (algebra_map A B x) p = 0) :
-  polynomial.aeval x p = 0 :=
-begin
-  rw [← algebra_map_aeval, ← (algebra_map A B).map_zero] at hp,
-  exact h hp,
-end
-
-lemma aeval_eq_zero_of_aeval_algebra_map_eq_zero_field {R A B : Type*} [comm_semiring R] [field A]
-  [comm_semiring B] [nontrivial B] [algebra R A] [algebra R B] [algebra A B] [is_scalar_tower R A B]
-  {x : A} {p : R[X]} (h : polynomial.aeval (algebra_map A B x) p = 0) :
-  polynomial.aeval x p = 0 :=
-aeval_eq_zero_of_aeval_algebra_map_eq_zero R A B (algebra_map A B).injective h
+variables {R A}
+
+lemma aeval_algebra_map_apply (x : A) (p : R[X]) :
+  aeval (algebra_map A B x) p = algebra_map A B (aeval x p) :=
+by rw [aeval_def, aeval_def, hom_eval₂, ←is_scalar_tower.algebra_map_eq]
+
+@[simp] lemma aeval_algebra_map_eq_zero_iff [no_zero_smul_divisors A B] [nontrivial B]
+  (x : A) (p : R[X]) :
+  aeval (algebra_map A B x) p = 0 ↔ aeval x p = 0 :=
+by rw [aeval_algebra_map_apply, algebra.algebra_map_eq_smul_one, smul_eq_zero,
+  iff_false_intro (one_ne_zero' B), or_false]
+
+variables {B}
+
+lemma aeval_algebra_map_eq_zero_iff_of_injective
+  {x : A} {p : R[X]}
+  (h : function.injective (algebra_map A B)) :
+  aeval (algebra_map A B x) p = 0 ↔ aeval x p = 0 :=
+by rw [aeval_algebra_map_apply, ← (algebra_map A B).map_zero, h.eq_iff]
 
 end comm_semiring
 
-end is_scalar_tower
+end polynomial
 
 namespace subalgebra
 
-open is_scalar_tower
+open polynomial
 
 section comm_semiring
 
-variables (R) {S A} [comm_semiring R] [comm_semiring S] [comm_semiring A]
-variables [algebra R S] [algebra S A] [algebra R A] [is_scalar_tower R S A]
+variables {R A} [comm_semiring R] [comm_semiring A] [algebra R A]
 
-@[simp] lemma aeval_coe {S : subalgebra R A} {x : S} {p : R[X]} :
-  polynomial.aeval (x : A) p = polynomial.aeval x p :=
-(algebra_map_aeval R S A x p).symm
+@[simp] lemma aeval_coe (S : subalgebra R A) (x : S) (p : R[X]) :
+  aeval (x : A) p = aeval x p :=
+aeval_algebra_map_apply A x p
 
 end comm_semiring
 
diff --git a/src/ring_theory/polynomial/vieta.lean b/src/ring_theory/polynomial/vieta.lean
index 16511dfa7ead1..d3687f762f0b2 100644
--- a/src/ring_theory/polynomial/vieta.lean
+++ b/src/ring_theory/polynomial/vieta.lean
@@ -3,103 +3,171 @@ Copyright (c) 2020 Hanting Zhang. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Hanting Zhang
 -/
-import ring_theory.polynomial.basic
-import ring_theory.polynomial.symmetric
+import data.polynomial.splits
+import ring_theory.mv_polynomial.symmetric
 
 /-!
 # Vieta's Formula
 
-The main result is `vieta.prod_X_add_C_eq_sum_esymm`, which shows that the product of linear terms
-`λ + X i` is equal to a linear combination of the symmetric polynomials `esymm σ R j`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-## Implementation Notes:
+The main result is `multiset.prod_X_add_C_eq_sum_esymm`, which shows that the product of
+linear terms `X + λ` with `λ` in a `multiset s` is equal to a linear combination of the
+symmetric functions `esymm s`.
 
-We first take the viewpoint where the "roots" `X i` are variables. This means we work over
-`polynomial (mv_polynomial σ R)`, which enables us to talk about linear combinations of
-`esymm σ R j`. We then derive Vieta's formula in `polynomial R` by giving a
-valuation from each `X i` to `r i`.
+From this, we deduce `mv_polynomial.prod_X_add_C_eq_sum_esymm` which is the equivalent formula
+for the product of linear terms `X + X i` with `i` in a `fintype σ` as a linear combination
+of the symmetric polynomials `esymm σ R j`.
 
+For `R` be an integral domain (so that `p.roots` is defined for any `p : R[X]` as a multiset),
+we derive `polynomial.coeff_eq_esymm_roots_of_card`, the relationship between the coefficients and
+the roots of `p` for a polynomial `p` that splits (i.e. having as many roots as its degree).
 -/
 
-universes u
 open_locale big_operators polynomial
 
-open finset polynomial fintype
+namespace multiset
 
-namespace mv_polynomial
+open polynomial
 
-variables {R : Type u} [comm_semiring R]
-variables (σ : Type u) [fintype σ]
+section semiring
 
-/-- A sum version of Vieta's formula. Viewing `X i` as variables,
-the product of linear terms `λ + X i` is equal to a linear combination of
-the symmetric polynomials `esymm σ R j`. -/
-lemma prod_X_add_C_eq_sum_esymm :
-  (∏ i : σ, (polynomial.C (X i) + polynomial.X) : polynomial (mv_polynomial σ R) )=
-  ∑ j in range (card σ + 1),
-    (polynomial.C (esymm σ R j) * polynomial.X ^ (card σ - j)) :=
+variables {R : Type*} [comm_semiring R]
+
+/-- A sum version of Vieta's formula for `multiset`: the product of the linear terms `X + λ` where
+`λ` runs through a multiset `s` is equal to a linear combination of the symmetric functions
+`esymm s` of the `λ`'s .-/
+lemma prod_X_add_C_eq_sum_esymm (s : multiset R) :
+  (s.map (λ r, X + C r)).prod =
+  ∑ j in finset.range (s.card + 1), C (s.esymm j) * X ^ (s.card - j) :=
 begin
   classical,
-  rw [prod_add, sum_powerset],
-  refine sum_congr begin congr end (λ j hj, _),
-  rw [esymm, map_sum, sum_mul],
-  refine sum_congr rfl (λ t ht, _),
-  have h : (univ \ t).card = card σ - j :=
-  by { rw card_sdiff (mem_powerset_len.mp ht).1, congr, exact (mem_powerset_len.mp ht).2 },
-  rw [map_prod, prod_const, ← h],
-  congr,
+  rw [prod_map_add, antidiagonal_eq_map_powerset, map_map, ←bind_powerset_len, function.comp,
+    map_bind, sum_bind, finset.sum_eq_multiset_sum, finset.range_val, map_congr (eq.refl _)],
+  intros _ _,
+  rw [esymm, ←sum_hom', ←sum_map_mul_right, map_congr (eq.refl _)],
+  intros _ ht,
+  rw mem_powerset_len at ht,
+  simp [ht, map_const, prod_replicate, prod_hom', map_id', card_sub],
 end
 
-/-- A fully expanded sum version of Vieta's formula, evaluated at the roots.
-The product of linear terms `X + r i` is equal to `∑ j in range (n + 1), e_j * X ^ (n - j)`,
-where `e_j` is the `j`th symmetric polynomial of the constant terms `r i`. -/
-lemma prod_X_add_C_eval (r : σ → R) : ∏ i : σ, (polynomial.C (r i) + polynomial.X) =
-  ∑ i in range (card σ + 1), (∑ t in powerset_len i (univ : finset σ),
-    ∏ i in t, polynomial.C (r i)) * polynomial.X ^ (card σ - i) :=
+/-- Vieta's formula for the coefficients of the product of linear terms `X + λ` where `λ` runs
+through a multiset `s` : the `k`th coefficient is the symmetric function `esymm (card s - k) s`. -/
+lemma prod_X_add_C_coeff (s : multiset R) {k : ℕ} (h : k ≤ s.card) :
+  (s.map (λ r, X + C r)).prod.coeff k = s.esymm (s.card - k) :=
 begin
-  classical,
-  have h := @prod_X_add_C_eq_sum_esymm _ _ σ _,
-  apply_fun (polynomial.map (eval r)) at h,
-  rw [polynomial.map_prod, polynomial.map_sum] at h,
-  convert h,
-  simp only [eval_X, polynomial.map_add, polynomial.map_C, polynomial.map_X, eq_self_iff_true],
-  funext,
-  simp only [function.funext_iff, esymm, polynomial.map_C, polynomial.map_sum, map_sum,
-    polynomial.map_C, polynomial.map_pow, polynomial.map_X, polynomial.map_mul],
-  congr,
-  funext,
-  simp only [eval_prod, eval_X, map_prod],
+  convert polynomial.ext_iff.mp (prod_X_add_C_eq_sum_esymm s) k,
+  simp_rw [finset_sum_coeff, coeff_C_mul_X_pow],
+  rw finset.sum_eq_single_of_mem (s.card - k) _,
+  { rw if_pos (nat.sub_sub_self h).symm, },
+  { intros j hj1 hj2,
+    suffices : k ≠ card s - j,
+    { rw if_neg this, },
+    { intro hn,
+      rw [hn, nat.sub_sub_self (nat.lt_succ_iff.mp (finset.mem_range.mp hj1))] at hj2,
+      exact ne.irrefl hj2, }},
+  { rw finset.mem_range,
+    exact nat.sub_lt_succ s.card k }
 end
 
-lemma esymm_to_sum (r : σ → R) (j : ℕ) : polynomial.C (eval r (esymm σ R j)) =
-  ∑ t in powerset_len j (univ : finset σ), ∏ i in t, polynomial.C (r i) :=
-by simp only [esymm, eval_sum, eval_prod, eval_X, map_sum, map_prod]
+lemma prod_X_add_C_coeff' {σ} (s : multiset σ) (r : σ → R) {k : ℕ} (h : k ≤ s.card) :
+  (s.map (λ i, X + C (r i))).prod.coeff k = (s.map r).esymm (s.card - k) :=
+by rw [← map_map (λ r, X + C r) r, prod_X_add_C_coeff]; rwa s.card_map r
+
+lemma _root_.finset.prod_X_add_C_coeff {σ} (s : finset σ) (r : σ → R) {k : ℕ} (h : k ≤ s.card) :
+  (∏ i in s, (X + C (r i))).coeff k = ∑ t in s.powerset_len (s.card - k), ∏ i in t, r i :=
+by { rw [finset.prod, prod_X_add_C_coeff' _ r h, finset.esymm_map_val], refl }
+
+end semiring
+
+section ring
+
+variables {R : Type*} [comm_ring R]
+
+lemma esymm_neg (s : multiset R) (k : ℕ) :
+  (map has_neg.neg s).esymm k = (-1) ^ k * esymm s k :=
+begin
+  rw [esymm, esymm, ←multiset.sum_map_mul_left, multiset.powerset_len_map, multiset.map_map,
+    map_congr (eq.refl _)],
+  intros x hx,
+  rw [(by { exact (mem_powerset_len.mp hx).right.symm }), ←prod_replicate, ←multiset.map_const],
+  nth_rewrite 2 ←map_id' x,
+  rw [←prod_map_mul, map_congr (eq.refl _)],
+  exact λ z _, neg_one_mul z,
+end
+
+lemma prod_X_sub_C_eq_sum_esymm (s : multiset R) :
+  (s.map (λ t, X - C t)).prod =
+  ∑ j in finset.range (s.card + 1), (-1) ^ j * (C (s.esymm j) * X ^ (s.card - j)) :=
+begin
+  conv_lhs { congr, congr, funext, rw sub_eq_add_neg, rw ←map_neg C _, },
+  convert prod_X_add_C_eq_sum_esymm (map (λ t, -t) s) using 1,
+  { rwa map_map, },
+  { simp only [esymm_neg, card_map, mul_assoc, map_mul, map_pow, map_neg, map_one], },
+end
+
+lemma prod_X_sub_C_coeff (s : multiset R) {k : ℕ} (h : k ≤ s.card) :
+  (s.map (λ t, X - C t)).prod.coeff k = (-1) ^ (s.card - k) * s.esymm (s.card - k) :=
+begin
+  conv_lhs { congr, congr, congr, funext, rw sub_eq_add_neg, rw ←map_neg C _, },
+  convert prod_X_add_C_coeff (map (λ t, -t) s) _ using 1,
+  { rwa map_map, },
+  { rwa [esymm_neg, card_map] },
+  { rwa card_map },
+end
+
+/-- Vieta's formula for the coefficients and the roots of a polynomial over an integral domain
+  with as many roots as its degree. -/
+theorem _root_.polynomial.coeff_eq_esymm_roots_of_card [is_domain R] {p : R[X]}
+  (hroots : p.roots.card = p.nat_degree) {k : ℕ} (h : k ≤ p.nat_degree) :
+  p.coeff k = p.leading_coeff * (-1) ^ (p.nat_degree - k) * p.roots.esymm (p.nat_degree - k) :=
+begin
+  conv_lhs { rw ← C_leading_coeff_mul_prod_multiset_X_sub_C hroots },
+  rw [coeff_C_mul, mul_assoc], congr,
+  convert p.roots.prod_X_sub_C_coeff _ using 3; rw hroots, exact h,
+end
+
+/-- Vieta's formula for split polynomials over a field. -/
+theorem _root_.polynomial.coeff_eq_esymm_roots_of_splits {F} [field F] {p : F[X]}
+  (hsplit : p.splits (ring_hom.id F)) {k : ℕ} (h : k ≤ p.nat_degree) :
+  p.coeff k = p.leading_coeff * (-1) ^ (p.nat_degree - k) * p.roots.esymm (p.nat_degree - k) :=
+polynomial.coeff_eq_esymm_roots_of_card (splits_iff_card_roots.1 hsplit) h
+
+end ring
+
+end multiset
+
+section mv_polynomial
+
+open finset polynomial fintype
+
+variables (R σ : Type*) [comm_semiring R] [fintype σ]
+
+/-- A sum version of Vieta's formula for `mv_polynomial`: viewing `X i` as variables,
+the product of linear terms `λ + X i` is equal to a linear combination of
+the symmetric polynomials `esymm σ R j`. -/
+lemma mv_polynomial.prod_C_add_X_eq_sum_esymm :
+  ∏ i : σ, (X + C (mv_polynomial.X i)) =
+  ∑ j in range (card σ + 1), (C (mv_polynomial.esymm σ R j) * X ^ (card σ - j)) :=
+begin
+  let s := finset.univ.val.map (λ i : σ, mv_polynomial.X i),
+  rw (_ : card σ = s.card),
+  { simp_rw [mv_polynomial.esymm_eq_multiset_esymm σ R, finset.prod_eq_multiset_prod],
+    convert multiset.prod_X_add_C_eq_sum_esymm s,
+    rwa multiset.map_map, },
+  { rw multiset.card_map, refl, }
+end
 
-/-- Vieta's formula for the coefficients of the product of linear terms `X + r i`,
-The `k`th coefficient is `∑ t in powerset_len (card σ - k) (univ : finset σ), ∏ i in t, r i`,
-i.e. the symmetric polynomial `esymm σ R (card σ - k)` of the constant terms `r i`. -/
-lemma prod_X_add_C_coeff (r : σ → R) (k : ℕ) (h : k ≤ card σ):
-  polynomial.coeff (∏ i : σ, (polynomial.C (r i) + polynomial.X)) k =
-  ∑ t in powerset_len (card σ - k) (univ : finset σ), ∏ i in t, r i :=
+lemma mv_polynomial.prod_X_add_C_coeff (k : ℕ) (h : k ≤ card σ) :
+  (∏ i : σ, (X + C (mv_polynomial.X i))).coeff k = mv_polynomial.esymm σ R (card σ - k) :=
 begin
-  have hk : filter (λ (x : ℕ), k = card σ - x) (range (card σ + 1)) = {card σ - k} :=
-  begin
-    refine finset.ext (λ a, ⟨λ ha, _, λ ha, _ ⟩),
-    rw mem_singleton,
-    have hσ := (tsub_eq_iff_eq_add_of_le (mem_range_succ_iff.mp
-      (mem_filter.mp ha).1)).mp ((mem_filter.mp ha).2).symm,
-    symmetry,
-    rwa [(tsub_eq_iff_eq_add_of_le h), add_comm],
-    rw mem_filter,
-    have haσ : a ∈ range (card σ + 1) :=
-    by { rw mem_singleton.mp ha, exact mem_range_succ_iff.mpr (@tsub_le_self _ _ _ _ _ k) },
-    refine ⟨haσ, eq.symm _⟩,
-    rw tsub_eq_iff_eq_add_of_le (mem_range_succ_iff.mp haσ),
-    have hσ := (tsub_eq_iff_eq_add_of_le h).mp (mem_singleton.mp ha).symm,
-    rwa add_comm,
-  end,
-  simp only [prod_X_add_C_eval, ← esymm_to_sum, finset_sum_coeff, coeff_C_mul_X_pow, sum_ite, hk,
-    sum_singleton, esymm, eval_sum, eval_prod, eval_X, add_zero, sum_const_zero],
+  let s := finset.univ.val.map (λ i, (mv_polynomial.X i : mv_polynomial σ R)),
+  rw (_ : card σ = s.card) at ⊢ h,
+  { rw [mv_polynomial.esymm_eq_multiset_esymm σ R, finset.prod_eq_multiset_prod],
+    convert multiset.prod_X_add_C_coeff s h,
+    rwa multiset.map_map },
+  repeat { rw multiset.card_map, refl, },
 end
 
 end mv_polynomial
diff --git a/src/ring_theory/polynomial_algebra.lean b/src/ring_theory/polynomial_algebra.lean
index f3be80b053384..7e08efc48eed2 100644
--- a/src/ring_theory/polynomial_algebra.lean
+++ b/src/ring_theory/polynomial_algebra.lean
@@ -11,13 +11,16 @@ import data.matrix.dmatrix
 /-!
 # Algebra isomorphism between matrices of polynomials and polynomials of matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given `[comm_ring R] [ring A] [algebra R A]`
-we show `polynomial A ≃ₐ[R] (A ⊗[R] R[X])`.
+we show `A[X] ≃ₐ[R] (A ⊗[R] R[X])`.
 Combining this with the isomorphism `matrix n n A ≃ₐ[R] (A ⊗[R] matrix n n R)` proved earlier
 in `ring_theory.matrix_algebra`, we obtain the algebra isomorphism
 ```
 def mat_poly_equiv :
-  matrix n n R[X] ≃ₐ[R] polynomial (matrix n n R)
+  matrix n n R[X] ≃ₐ[R] (matrix n n R)[X]
 ```
 which is characterized by
 ```
@@ -45,34 +48,33 @@ namespace poly_equiv_tensor
 
 /--
 (Implementation detail).
-The function underlying `A ⊗[R] R[X] →ₐ[R] polynomial A`,
+The function underlying `A ⊗[R] R[X] →ₐ[R] A[X]`,
 as a bilinear function of two arguments.
 -/
 @[simps apply_apply]
 def to_fun_bilinear : A →ₗ[A] R[X] →ₗ[R] A[X] :=
-linear_map.to_span_singleton A _ (aeval (polynomial.X : polynomial A)).to_linear_map
+linear_map.to_span_singleton A _ (aeval (polynomial.X : A[X])).to_linear_map
 
 lemma to_fun_bilinear_apply_eq_sum (a : A) (p : R[X]) :
   to_fun_bilinear R A a p = p.sum (λ n r, monomial n (a * algebra_map R A r)) :=
 begin
-  dsimp [to_fun_bilinear_apply_apply, aeval_def, eval₂_eq_sum, polynomial.sum],
-  rw finset.smul_sum,
+  simp only [to_fun_bilinear_apply_apply, aeval_def, eval₂_eq_sum, polynomial.sum, finset.smul_sum],
   congr' with i : 1,
-  rw [←algebra.smul_def, ←C_mul', mul_smul_comm, C_mul_X_pow_eq_monomial, ←algebra.commutes,
-    ←algebra.smul_def, smul_monomial],
+  rw [← algebra.smul_def, ←C_mul', mul_smul_comm, C_mul_X_pow_eq_monomial, ←algebra.commutes,
+      ← algebra.smul_def, smul_monomial],
 end
 
 /--
 (Implementation detail).
-The function underlying `A ⊗[R] R[X] →ₐ[R] polynomial A`,
+The function underlying `A ⊗[R] R[X] →ₐ[R] A[X]`,
 as a linear map.
 -/
-def to_fun_linear : A ⊗[R] R[X] →ₗ[R] polynomial A :=
+def to_fun_linear : A ⊗[R] R[X] →ₗ[R] A[X] :=
 tensor_product.lift (to_fun_bilinear R A)
 
 @[simp]
 lemma to_fun_linear_tmul_apply (a : A) (p : R[X]) :
-  to_fun_linear R A (a ⊗ₜ[R] p) = to_fun_bilinear R A a p := lift.tmul _ _
+  to_fun_linear R A (a ⊗ₜ[R] p) = to_fun_bilinear R A a p := rfl
 
 -- We apparently need to provide the decidable instance here
 -- in order to successfully rewrite by this lemma.
@@ -109,15 +111,15 @@ begin
 end
 
 lemma to_fun_linear_algebra_map_tmul_one (r : R) :
-  (to_fun_linear R A) ((algebra_map R A) r ⊗ₜ[R] 1) = (algebra_map R (polynomial A)) r :=
+  (to_fun_linear R A) ((algebra_map R A) r ⊗ₜ[R] 1) = (algebra_map R A[X]) r :=
 by rw [to_fun_linear_tmul_apply, to_fun_bilinear_apply_apply, polynomial.aeval_one,
   algebra_map_smul, algebra.algebra_map_eq_smul_one]
 
 /--
 (Implementation detail).
-The algebra homomorphism `A ⊗[R] R[X] →ₐ[R] polynomial A`.
+The algebra homomorphism `A ⊗[R] R[X] →ₐ[R] A[X]`.
 -/
-def to_fun_alg_hom : A ⊗[R] R[X] →ₐ[R] polynomial A :=
+def to_fun_alg_hom : A ⊗[R] R[X] →ₐ[R] A[X] :=
 alg_hom_of_linear_map_tensor_product
   (to_fun_linear R A)
   (to_fun_linear_mul_tmul_mul R A)
@@ -125,15 +127,12 @@ alg_hom_of_linear_map_tensor_product
 
 @[simp] lemma to_fun_alg_hom_apply_tmul (a : A) (p : R[X]) :
   to_fun_alg_hom R A (a ⊗ₜ[R] p) = p.sum (λ n r, monomial n (a * (algebra_map R A) r)) :=
-begin
-  dsimp [to_fun_alg_hom],
-  rw [to_fun_linear_tmul_apply, to_fun_bilinear_apply_eq_sum],
-end
+to_fun_bilinear_apply_eq_sum R A _ _
 
 /--
 (Implementation detail.)
 
-The bare function `polynomial A → A ⊗[R] R[X]`.
+The bare function `A[X] → A ⊗[R] R[X]`.
 (We don't need to show that it's an algebra map, thankfully --- just that it's an inverse.)
 -/
 def inv_fun (p : A[X]) : A ⊗[R] R[X] :=
@@ -159,7 +158,7 @@ begin
     simp_rw [eval₂_monomial, alg_hom.coe_to_ring_hom, algebra.tensor_product.tmul_pow, one_pow,
       algebra.tensor_product.include_left_apply, algebra.tensor_product.tmul_mul_tmul,
       mul_one, one_mul, ←algebra.commutes, ←algebra.smul_def, smul_tmul, sum_def, ←tmul_sum],
-    conv_rhs { rw [←sum_C_mul_X_eq p], },
+    conv_rhs { rw [←sum_C_mul_X_pow_eq p], },
     simp only [algebra.smul_def],
     refl, },
   { intros p q hp hq,
@@ -181,9 +180,9 @@ end
 /--
 (Implementation detail)
 
-The equivalence, ignoring the algebra structure, `(A ⊗[R] R[X]) ≃ polynomial A`.
+The equivalence, ignoring the algebra structure, `(A ⊗[R] R[X]) ≃ A[X]`.
 -/
-def equiv : (A ⊗[R] R[X]) ≃ polynomial A :=
+def equiv : (A ⊗[R] R[X]) ≃ A[X] :=
 { to_fun := to_fun_alg_hom R A,
   inv_fun := inv_fun R A,
   left_inv := left_inv R A,
@@ -194,7 +193,7 @@ end poly_equiv_tensor
 open poly_equiv_tensor
 
 /--
-The `R`-algebra isomorphism `polynomial A ≃ₐ[R] (A ⊗[R] R[X])`.
+The `R`-algebra isomorphism `A[X] ≃ₐ[R] (A ⊗[R] R[X])`.
 -/
 def poly_equiv_tensor : A[X] ≃ₐ[R] (A ⊗[R] R[X]) :=
 alg_equiv.symm
@@ -225,7 +224,7 @@ it's an algebra equivalence, and characterised extensionally by the lemma
 `mat_poly_equiv_coeff_apply` below.)
 -/
 noncomputable def mat_poly_equiv :
-  matrix n n R[X] ≃ₐ[R] polynomial (matrix n n R) :=
+  matrix n n R[X] ≃ₐ[R] (matrix n n R)[X] :=
 (((matrix_equiv_tensor R R[X] n)).trans
   (algebra.tensor_product.comm R _ _)).trans
   (poly_equiv_tensor R (matrix n n R)).symm
@@ -245,7 +244,7 @@ begin
   convert eval₂_monomial _ _,
   simp only [algebra.tensor_product.tmul_mul_tmul, one_pow, one_mul, matrix.mul_one,
     algebra.tensor_product.tmul_pow, algebra.tensor_product.include_left_apply, mul_eq_mul],
-  rw [monomial_eq_smul_X, ← tensor_product.smul_tmul],
+  rw [← smul_X_eq_monomial, ← tensor_product.smul_tmul],
   congr' with i' j'; simp
 end
 
diff --git a/src/ring_theory/power_basis.lean b/src/ring_theory/power_basis.lean
index 65d72d8a8f874..8cb2b73074fd1 100644
--- a/src/ring_theory/power_basis.lean
+++ b/src/ring_theory/power_basis.lean
@@ -3,11 +3,14 @@ Copyright (c) 2020 Anne Baanen. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
-import field_theory.minpoly
+import field_theory.minpoly.field
 
 /-!
 # Power basis
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a structure `power_basis R S`, giving a basis of the
 `R`-algebra `S` as a finite list of powers `1, x, ..., x^n`.
 For example, if `x` is algebraic over a ring/field, adjoining `x`
@@ -29,8 +32,7 @@ gives a `power_basis` structure generated by `x`.
 
 ## Implementation notes
 
-Throughout this file, `R`, `S`, ... are `comm_ring`s, `A`, `B`, ... are
-`comm_ring` with `is_domain`s and `K`, `L`, ... are `field`s.
+Throughout this file, `R`, `S`, `A`, `B` ... are `comm_ring`s, and `K`, `L`, ... are `field`s.
 `S` is an `R`-algebra, `B` is an `A`-algebra, `L` is a `K`-algebra.
 
 ## Tags
@@ -42,11 +44,9 @@ power basis, powerbasis
 open polynomial
 open_locale polynomial
 
-variables {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
-variables [algebra R S] [algebra S T] [algebra R T] [is_scalar_tower R S T]
-variables {A B : Type*} [comm_ring A]
-  [comm_ring B] [is_domain B] [algebra A B]
-variables {K L : Type*} [field K] [field L] [algebra K L]
+variables {R S T : Type*} [comm_ring R] [ring S] [algebra R S]
+variables {A B : Type*} [comm_ring A] [comm_ring B] [is_domain B] [algebra A B]
+variables {K : Type*} [field K]
 
 /-- `pb : power_basis R S` states that `1, pb.gen, ..., pb.gen ^ (pb.dim - 1)`
 is a basis for the `R`-algebra `S` (viewed as `R`-module).
@@ -55,7 +55,7 @@ This is a structure, not a class, since the same algebra can have many power bas
 For the common case where `S` is defined by adjoining an integral element to `R`,
 the canonical power basis is given by `{algebra,intermediate_field}.adjoin.power_basis`.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure power_basis (R S : Type*) [comm_ring R] [ring S] [algebra R S] :=
 (gen : S)
 (dim : ℕ)
@@ -143,16 +143,11 @@ open_locale big_operators
 
 variable [algebra A S]
 
-/-- `pb.minpoly_gen` is a minimal polynomial for `pb.gen`.
-
-If `A` is not a field, it might not necessarily be *the* minimal polynomial,
-however `nat_degree_minpoly` shows its degree is indeed minimal.
--/
+/-- `pb.minpoly_gen` is the minimal polynomial for `pb.gen`. -/
 noncomputable def minpoly_gen (pb : power_basis A S) : A[X] :=
 X ^ pb.dim -
   ∑ (i : fin pb.dim), C (pb.basis.repr (pb.gen ^ pb.dim) i) * X ^ (i : ℕ)
 
-@[simp]
 lemma aeval_minpoly_gen (pb : power_basis A S) : aeval pb.gen (minpoly_gen pb) = 0 :=
 begin
   simp_rw [minpoly_gen, alg_hom.map_sub, alg_hom.map_sum, alg_hom.map_mul, alg_hom.map_pow,
@@ -162,27 +157,25 @@ begin
     simp only [pb.coe_basis, zero_smul, eq_self_iff_true, implies_true_iff]
 end
 
-lemma dim_le_nat_degree_of_root (h : power_basis A S) {p : A[X]}
-  (ne_zero : p ≠ 0) (root : aeval h.gen p = 0) :
-  h.dim ≤ p.nat_degree :=
+lemma minpoly_gen_monic (pb : power_basis A S) : monic (minpoly_gen pb) :=
+begin
+  nontriviality A,
+  apply (monic_X_pow _).sub_of_left _,
+  rw degree_X_pow,
+  exact degree_sum_fin_lt _
+end
+
+lemma dim_le_nat_degree_of_root (pb : power_basis A S) {p : A[X]}
+  (ne_zero : p ≠ 0) (root : aeval pb.gen p = 0) :
+  pb.dim ≤ p.nat_degree :=
 begin
   refine le_of_not_lt (λ hlt, ne_zero _),
-  let p_coeff : fin (h.dim) → A := λ i, p.coeff i,
-  suffices : ∀ i, p_coeff i = 0,
-  { ext i,
-    by_cases hi : i < h.dim,
-    { exact this ⟨i, hi⟩ },
-    exact coeff_eq_zero_of_nat_degree_lt (lt_of_lt_of_le hlt (le_of_not_gt hi)) },
-  intro i,
-  refine linear_independent_iff'.mp h.basis.linear_independent _ _ _ i (finset.mem_univ _),
-  rw aeval_eq_sum_range' hlt at root,
-  rw finset.sum_fin_eq_sum_range,
-  convert root,
-  ext i,
-  split_ifs with hi,
-  { simp_rw [coe_basis, p_coeff, fin.coe_mk] },
-  { rw [coeff_eq_zero_of_nat_degree_lt (lt_of_lt_of_le hlt (le_of_not_gt hi)),
-        zero_smul] }
+  rw [p.as_sum_range' _ hlt, finset.sum_range],
+  refine fintype.sum_eq_zero _ (λ i, _),
+  simp_rw [aeval_eq_sum_range' hlt, finset.sum_range, ← pb.basis_eq_pow] at root,
+  have := fintype.linear_independent_iff.1 pb.basis.linear_independent _ root,
+  dsimp only at this,
+  rw [this, monomial_zero_right],
 end
 
 lemma dim_le_degree_of_root (h : power_basis A S) {p : A[X]}
@@ -191,10 +184,7 @@ lemma dim_le_degree_of_root (h : power_basis A S) {p : A[X]}
 by { rw [degree_eq_nat_degree ne_zero, with_bot.coe_le_coe],
      exact h.dim_le_nat_degree_of_root ne_zero root }
 
-variables [is_domain A]
-
-@[simp]
-lemma degree_minpoly_gen (pb : power_basis A S) :
+lemma degree_minpoly_gen [nontrivial A] (pb : power_basis A S) :
   degree (minpoly_gen pb) = pb.dim :=
 begin
   unfold minpoly_gen,
@@ -202,58 +192,61 @@ begin
   apply degree_sum_fin_lt
 end
 
-@[simp]
-lemma nat_degree_minpoly_gen (pb : power_basis A S) :
+lemma nat_degree_minpoly_gen [nontrivial A] (pb : power_basis A S) :
   nat_degree (minpoly_gen pb) = pb.dim :=
 nat_degree_eq_of_degree_eq_some pb.degree_minpoly_gen
 
-lemma minpoly_gen_monic (pb : power_basis A S) : monic (minpoly_gen pb) :=
+@[simp]
+lemma minpoly_gen_eq (pb : power_basis A S) : pb.minpoly_gen = minpoly A pb.gen :=
 begin
-  apply (monic_X_pow _).sub_of_left _,
-  rw degree_X_pow,
-  exact degree_sum_fin_lt _
+  nontriviality A,
+  refine minpoly.unique' A _ pb.minpoly_gen_monic
+    pb.aeval_minpoly_gen (λ q hq, or_iff_not_imp_left.2 $ λ hn0 h0, _),
+  exact (pb.dim_le_degree_of_root hn0 h0).not_lt (pb.degree_minpoly_gen ▸ hq),
 end
 
 lemma is_integral_gen (pb : power_basis A S) : is_integral A pb.gen :=
 ⟨minpoly_gen pb, minpoly_gen_monic pb, aeval_minpoly_gen pb⟩
 
 @[simp]
-lemma nat_degree_minpoly (pb : power_basis A S) :
+lemma degree_minpoly [nontrivial A] (pb : power_basis A S) : degree (minpoly A pb.gen) = pb.dim :=
+by rw [← minpoly_gen_eq, degree_minpoly_gen]
+
+@[simp]
+lemma nat_degree_minpoly [nontrivial A] (pb : power_basis A S) :
   (minpoly A pb.gen).nat_degree = pb.dim :=
+by rw [← minpoly_gen_eq, nat_degree_minpoly_gen]
+
+protected lemma left_mul_matrix (pb : power_basis A S) :
+  algebra.left_mul_matrix pb.basis pb.gen = matrix.of
+    (λ i j, if ↑j + 1 = pb.dim then -pb.minpoly_gen.coeff ↑i else if ↑i = ↑j + 1 then 1 else 0) :=
 begin
-  refine le_antisymm _
-    (dim_le_nat_degree_of_root pb (minpoly.ne_zero pb.is_integral_gen) (minpoly.aeval _ _)),
-  rw ← nat_degree_minpoly_gen,
-  apply nat_degree_le_of_degree_le,
-  rw ← degree_eq_nat_degree (minpoly_gen_monic pb).ne_zero,
-  exact minpoly.min _ _ (minpoly_gen_monic pb) (aeval_minpoly_gen pb)
+  casesI subsingleton_or_nontrivial A, { apply subsingleton.elim },
+  rw [algebra.left_mul_matrix_apply, ← linear_equiv.eq_symm_apply, linear_map.to_matrix_symm],
+  refine pb.basis.ext (λ k, _),
+  simp_rw [matrix.to_lin_self, matrix.of_apply, pb.basis_eq_pow],
+  apply (pow_succ _ _).symm.trans,
+  split_ifs with h h,
+  { simp_rw [h, neg_smul, finset.sum_neg_distrib, eq_neg_iff_add_eq_zero],
+    convert pb.aeval_minpoly_gen,
+    rw [add_comm, aeval_eq_sum_range, finset.sum_range_succ, ← leading_coeff,
+        pb.minpoly_gen_monic.leading_coeff, one_smul, nat_degree_minpoly_gen, finset.sum_range] },
+  { rw [fintype.sum_eq_single (⟨↑k + 1, lt_of_le_of_ne k.2 h⟩ : fin pb.dim), if_pos, one_smul],
+    { refl }, { refl }, intros x hx, rw [if_neg, zero_smul], apply mt fin.ext hx },
 end
 
-@[simp]
-lemma minpoly_gen_eq [algebra K S] (pb : power_basis K S) :
-  pb.minpoly_gen = minpoly K pb.gen :=
-minpoly.unique K pb.gen pb.minpoly_gen_monic pb.aeval_minpoly_gen (λ p p_monic p_root,
-  pb.degree_minpoly_gen.symm ▸ pb.dim_le_degree_of_root p_monic.ne_zero p_root)
-
 end minpoly
 
 section equiv
 
-variables [algebra A S] {S' : Type*} [comm_ring S'] [algebra A S']
-
-lemma nat_degree_lt_nat_degree {p q : R[X]} (hp : p ≠ 0) (hpq : p.degree < q.degree) :
-  p.nat_degree < q.nat_degree :=
-begin
-  by_cases hq : q = 0, { rw [hq, degree_zero] at hpq, have := not_lt_bot hpq, contradiction },
-  rwa [degree_eq_nat_degree hp, degree_eq_nat_degree hq, with_bot.coe_lt_coe] at hpq
-end
-
-variables [is_domain A]
+variables [algebra A S] {S' : Type*} [ring S'] [algebra A S']
 
 lemma constr_pow_aeval (pb : power_basis A S) {y : S'}
   (hy : aeval y (minpoly A pb.gen) = 0) (f : A[X]) :
   pb.basis.constr A (λ i, y ^ (i : ℕ)) (aeval pb.gen f) = aeval y f :=
 begin
+  casesI subsingleton_or_nontrivial A,
+  { rw [(subsingleton.elim _ _ : f = 0), aeval_zero, map_zero, aeval_zero] },
   rw [← aeval_mod_by_monic_eq_self_of_root (minpoly.monic pb.is_integral_gen) (minpoly.aeval _ _),
       ← @aeval_mod_by_monic_eq_self_of_root _ _ _ _ _ f _ (minpoly.monic pb.is_integral_gen) y hy],
   by_cases hf : f %ₘ minpoly A pb.gen = 0,
@@ -347,8 +340,6 @@ noncomputable def alg_hom.fintype (pb : power_basis A S) :
 by letI := classical.dec_eq B; exact
 fintype.of_equiv _ pb.lift_equiv'.symm
 
-local attribute [irreducible] power_basis.lift
-
 /-- `pb.equiv_of_root pb' h₁ h₂` is an equivalence of algebras with the same power basis,
 where "the same" means that `pb` is a root of `pb'`s minimal polynomial and vice versa.
 
@@ -431,63 +422,30 @@ open power_basis
 
 /-- Useful lemma to show `x` generates a power basis:
 the powers of `x` less than the degree of `x`'s minimal polynomial are linearly independent. -/
-lemma is_integral.linear_independent_pow [algebra K S] {x : S} (hx : is_integral K x) :
+lemma linear_independent_pow [algebra K S] (x : S) :
   linear_independent K (λ (i : fin (minpoly K x).nat_degree), x ^ (i : ℕ)) :=
 begin
-  rw linear_independent_iff,
-  intros p hp,
-  set f : K[X] := p.sum (λ i, monomial i) with hf0,
-  have f_def : ∀ (i : fin _), f.coeff i = p i,
-  { intro i,
-    simp only [f, finsupp.sum, coeff_monomial, finset_sum_coeff],
-    rw [finset.sum_eq_single, if_pos rfl],
-    { intros b _ hb,
-      rw if_neg (mt (λ h, _) hb),
-      exact fin.coe_injective h },
-    { intro hi,
-      rw if_pos rfl,
-      exact finsupp.not_mem_support_iff.mp hi } },
-  have f_def' : ∀ i, f.coeff i = if hi : i < _ then p ⟨i, hi⟩ else 0,
-  { intro i,
-    split_ifs with hi,
-    { exact f_def ⟨i, hi⟩ },
-    simp only [f, finsupp.sum, coeff_monomial, finset_sum_coeff],
-    apply finset.sum_eq_zero,
-    rintro ⟨j, hj⟩ -,
-    apply if_neg (mt _ hi),
-    rintro rfl,
-    exact hj },
-  suffices : f = 0,
-  { ext i, rw [← f_def, this, coeff_zero, finsupp.zero_apply] },
-  contrapose hp with hf,
-  intro h,
-  have : (minpoly K x).degree ≤ f.degree,
-  { apply minpoly.degree_le_of_ne_zero K x hf,
-    convert h,
-    simp_rw [finsupp.total_apply, aeval_def, hf0, finsupp.sum, eval₂_finset_sum],
-    apply finset.sum_congr rfl,
-    rintro i -,
-    simp only [algebra.smul_def, eval₂_monomial] },
-  have : ¬ (minpoly K x).degree ≤ f.degree,
-  { apply not_le_of_lt,
-    rw [degree_eq_nat_degree (minpoly.ne_zero hx), degree_lt_iff_coeff_zero],
-    intros i hi,
-    rw [f_def' i, dif_neg],
-    exact hi.not_lt },
-  contradiction
+  by_cases is_integral K x, swap,
+  { rw [minpoly.eq_zero h, nat_degree_zero], exact linear_independent_empty_type },
+  refine fintype.linear_independent_iff.2 (λ g hg i, _),
+  simp only at hg,
+  simp_rw [algebra.smul_def, ← aeval_monomial, ← map_sum] at hg,
+  apply (λ hn0, (minpoly.degree_le_of_ne_zero K x (mt (λ h0, _) hn0) hg).not_lt).mtr,
+  { simp_rw ← C_mul_X_pow_eq_monomial,
+    exact (degree_eq_nat_degree $ minpoly.ne_zero h).symm ▸ degree_sum_fin_lt _ },
+  { apply_fun lcoeff K i at h0,
+    simp_rw [map_sum, lcoeff_apply, coeff_monomial, fin.coe_eq_coe, finset.sum_ite_eq'] at h0,
+    exact (if_pos $ finset.mem_univ _).symm.trans h0 },
 end
 
 lemma is_integral.mem_span_pow [nontrivial R] {x y : S} (hx : is_integral R x)
   (hy : ∃ f : R[X], y = aeval x f) :
-  y ∈ submodule.span R (set.range (λ (i : fin (minpoly R x).nat_degree),
-    x ^ (i : ℕ))) :=
+  y ∈ submodule.span R (set.range (λ (i : fin (minpoly R x).nat_degree), x ^ (i : ℕ))) :=
 begin
   obtain ⟨f, rfl⟩ := hy,
   apply mem_span_pow'.mpr _,
   have := minpoly.monic hx,
-  refine ⟨f.mod_by_monic (minpoly R x),
-      lt_of_lt_of_le (degree_mod_by_monic_lt _ this) degree_le_nat_degree,
-      _⟩,
+  refine ⟨f %ₘ minpoly R x, (degree_mod_by_monic_lt _ this).trans_le degree_le_nat_degree, _⟩,
   conv_lhs { rw ← mod_by_monic_add_div f this },
   simp only [add_zero, zero_mul, minpoly.aeval, aeval_add, alg_hom.map_mul]
 end
@@ -517,8 +475,6 @@ by { dsimp only [minpoly_gen, map_dim], -- Turn `fin (pb.map e).dim` into `fin p
         map_gen, alg_equiv.to_linear_equiv_apply, e.to_linear_equiv_symm, alg_equiv.map_pow,
         alg_equiv.symm_apply_apply, sub_right_inj] }
 
-variables [is_domain A]
-
 @[simp]
 lemma equiv_of_root_map (pb : power_basis A S) (e : S ≃ₐ[A] S')
   (h₁ h₂) :
diff --git a/src/ring_theory/power_series/basic.lean b/src/ring_theory/power_series/basic.lean
index e160605a16c38..78e1c3e211180 100644
--- a/src/ring_theory/power_series/basic.lean
+++ b/src/ring_theory/power_series/basic.lean
@@ -3,7 +3,6 @@ Copyright (c) 2019 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Kenny Lau
 -/
-import algebra.big_operators.nat_antidiagonal
 import data.finsupp.interval
 import data.mv_polynomial.basic
 import data.polynomial.algebra_map
@@ -16,6 +15,9 @@ import tactic.linarith
 /-!
 # Formal power series
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines (multivariate) formal power series
 and develops the basic properties of these objects.
 
@@ -89,7 +91,7 @@ instance {A} [semiring R] [add_comm_monoid A] [module R A] :
   module R (mv_power_series σ A) := pi.module _ _ _
 
 instance {A S} [semiring R] [semiring S] [add_comm_monoid A] [module R A] [module S A]
-  [has_scalar R S] [is_scalar_tower R S A] :
+  [has_smul R S] [is_scalar_tower R S A] :
   is_scalar_tower R S (mv_power_series σ A) :=
 pi.is_scalar_tower
 
@@ -156,6 +158,12 @@ coeff_monomial_same 0 1
 
 lemma monomial_zero_one : monomial R (0 : σ →₀ ℕ) 1 = 1 := rfl
 
+instance : add_monoid_with_one (mv_power_series σ R) :=
+{ nat_cast := λ n, monomial R 0 n,
+  nat_cast_zero := by simp [nat.cast],
+  nat_cast_succ := by simp [nat.cast, monomial_zero_one],
+  one := 1, .. mv_power_series.add_monoid }
+
 instance : has_mul (mv_power_series σ R) :=
 ⟨λ φ ψ n, ∑ p in finsupp.antidiagonal n, coeff R p.1 φ * coeff R p.2 ψ⟩
 
@@ -204,6 +212,16 @@ begin
   exact le_add_left le_rfl
 end
 
+@[simp] lemma commute_monomial {a : R} {n} :
+  commute φ (monomial R n a) ↔ ∀ m, commute (coeff R m φ) a :=
+begin
+  refine ext_iff.trans ⟨λ h m, _, λ h m, _⟩,
+  { have := h (m + n),
+    rwa [coeff_add_mul_monomial, add_comm, coeff_add_monomial_mul] at this },
+  { rw [coeff_mul_monomial, coeff_monomial_mul],
+    split_ifs; [apply h, refl] }
+end
+
 protected lemma one_mul : (1 : mv_power_series σ R) * φ = φ :=
 ext $ λ n, by simpa using coeff_add_monomial_mul 0 n φ 1
 
@@ -244,7 +262,7 @@ instance : semiring (mv_power_series σ R) :=
   zero_mul := mv_power_series.zero_mul,
   left_distrib := mv_power_series.mul_add,
   right_distrib := mv_power_series.add_mul,
-  .. mv_power_series.has_one,
+  .. mv_power_series.add_monoid_with_one,
   .. mv_power_series.has_mul,
   .. mv_power_series.add_comm_monoid }
 
@@ -318,6 +336,9 @@ coeff_monomial_same _ _
 lemma coeff_zero_X (s : σ) : coeff R (0 : σ →₀ ℕ) (X s : mv_power_series σ R) = 0 :=
 by { rw [coeff_X, if_neg], intro h, exact one_ne_zero (single_eq_zero.mp h.symm) }
 
+lemma commute_X (φ : mv_power_series σ R) (s : σ) : commute φ (X s) :=
+φ.commute_monomial.mpr $ λ m, commute.one_right _
+
 lemma X_def (s : σ) : X s = monomial R (single s 1) 1 := rfl
 
 lemma X_pow_eq (s : σ) (n : ℕ) :
@@ -348,11 +369,8 @@ begin
 end
 
 lemma coeff_zero_X_mul (φ : mv_power_series σ R) (s : σ) :
- coeff R (0 : σ →₀ ℕ) (X s * φ) = 0 :=
-begin
-  have : ¬single s 1 ≤ 0, from λ h, by simpa using h s,
-  simp only [X, coeff_monomial_mul, if_neg this]
-end
+  coeff R (0 : σ →₀ ℕ) (X s * φ) = 0 :=
+by rw [← (φ.commute_X s).eq, coeff_zero_mul_X]
 
 variables (σ) (R)
 
@@ -527,8 +545,8 @@ end
 
 end trunc
 
-section comm_semiring
-variable [comm_semiring R]
+section semiring
+variable [semiring R]
 
 lemma X_pow_dvd_iff {s : σ} {n : ℕ} {φ : mv_power_series σ R} :
   (X s : mv_power_series σ R)^n ∣ φ ↔ ∀ m : σ →₀ ℕ, m s < n → coeff R m φ = 0 :=
@@ -570,7 +588,8 @@ begin
   { exact h m (hm.symm ▸ zero_lt_one) },
   { exact h m (nat.eq_zero_of_le_zero $ nat.le_of_succ_le_succ hm) }
 end
-end comm_semiring
+
+end semiring
 
 section ring
 variables [ring R]
@@ -758,8 +777,10 @@ begin
         mv_power_series.inv_mul_cancel _ h.right] }
 end
 
-@[simp] lemma one_inv : (1 : mv_power_series σ k)⁻¹ = 1 :=
-by { rw [mv_power_series.inv_eq_iff_mul_eq_one, mul_one], simp }
+instance : inv_one_class (mv_power_series σ k) :=
+{ inv_one := by { rw [mv_power_series.inv_eq_iff_mul_eq_one, mul_one], simp },
+  ..mv_power_series.has_one,
+  ..mv_power_series.has_inv }
 
 @[simp] lemma C_inv (r : k) : (C σ k r)⁻¹ = C σ k r⁻¹ :=
 begin
@@ -869,8 +890,6 @@ section algebra
 
 variables (A : Type*) [comm_semiring A] [algebra R A]
 
-lemma algebra_map_apply (r : R) : algebra_map R (mv_polynomial σ A) r = C (algebra_map R A r) := rfl
-
 /--
 The coercion from multivariable polynomials to multivariable power series
 as an algebra homomorphism.
@@ -932,7 +951,7 @@ instance {A} [semiring R] [add_comm_monoid A] [module R A] :
   module R (power_series A) := by apply_instance
 
 instance {A S} [semiring R] [semiring S] [add_comm_monoid A] [module R A] [module S A]
-  [has_scalar R S] [is_scalar_tower R S A] :
+  [has_smul R S] [is_scalar_tower R S A] :
   is_scalar_tower R S (power_series A) :=
 pi.is_scalar_tower
 
@@ -1003,6 +1022,8 @@ variable {R}
 /-- The variable of the formal power series ring.-/
 def X : power_series R := mv_power_series.X ()
 
+lemma commute_X (φ : power_series R) : commute φ X := φ.commute_X _
+
 @[simp] lemma coeff_zero_eq_constant_coeff :
   ⇑(coeff R 0) = constant_coeff R :=
 by { rw [coeff, finsupp.single_zero], refl }
@@ -1154,8 +1175,7 @@ begin
   { rw [← tsub_add_cancel_of_le h, coeff_mul_X_pow, add_tsub_cancel_right] },
   { refine (coeff_mul _ _ _).trans (finset.sum_eq_zero (λ x hx, _)),
     rw [coeff_X_pow, if_neg, mul_zero],
-    exact ne_of_lt (lt_of_le_of_lt (nat.le_of_add_le_right
-      (le_of_eq (finset.nat.mem_antidiagonal.mp hx))) (not_le.mp h)) },
+    exact ((le_of_add_le_right (finset.nat.mem_antidiagonal.mp hx).le).trans_lt $ not_le.mp h).ne }
 end
 
 lemma coeff_X_pow_mul' (p : power_series R) (n d : ℕ) :
@@ -1167,8 +1187,7 @@ begin
     rw [coeff_X_pow, if_neg, zero_mul],
     have := finset.nat.mem_antidiagonal.mp hx,
     rw add_comm at this,
-    exact ne_of_lt (lt_of_le_of_lt (nat.le_of_add_le_right
-      (le_of_eq this)) (not_le.mp h)) },
+    exact ((le_of_add_le_right this.le).trans_lt $ not_le.mp h).ne }
 end
 
 end
@@ -1224,11 +1243,6 @@ by { ext, simp [coeff_X, apply_ite f] }
 
 end map
 
-end semiring
-
-section comm_semiring
-variables [comm_semiring R]
-
 lemma X_pow_dvd_iff {n : ℕ} {φ : power_series R} :
   (X : power_series R)^n ∣ φ ↔ ∀ m, m < n → coeff R m φ = 0 :=
 begin
@@ -1247,6 +1261,11 @@ begin
   { intros m hm, rwa nat.eq_zero_of_le_zero (nat.le_of_succ_le_succ hm) }
 end
 
+end semiring
+
+section comm_semiring
+variables [comm_semiring R]
+
 open finset nat
 
 /-- The ring homomorphism taking a power series `f(X)` to `f(aX)`. -/
@@ -1284,6 +1303,21 @@ by simp
 by { ext, simp only [ring_hom.id_apply, rescale, one_pow, coeff_mk, one_mul,
   ring_hom.coe_mk], }
 
+lemma rescale_mk (f : ℕ → R) (a : R) :
+  rescale a (mk f) = mk (λ n : ℕ, a^n * (f n)) :=
+by { ext, rw [coeff_rescale, coeff_mk, coeff_mk], }
+
+lemma rescale_rescale (f : power_series R) (a b : R) :
+  rescale b (rescale a f) = rescale (a * b) f :=
+begin
+  ext,
+  repeat { rw coeff_rescale, },
+  rw [mul_pow, mul_comm _ (b^n), mul_assoc],
+end
+
+lemma rescale_mul (a b : R) : rescale (a * b) = (rescale b).comp (rescale a) :=
+by { ext, simp [← rescale_rescale], }
+
 section trunc
 
 /-- The `n`th truncation of a formal power series to a polynomial -/
@@ -1402,12 +1436,17 @@ end ring
 section comm_ring
 variables {A : Type*} [comm_ring A]
 
-@[simp] lemma rescale_neg_one_X : rescale (-1 : A) X = -X :=
+@[simp] lemma rescale_X (a : A) : rescale a X = C A a * X :=
 begin
-  ext, simp only [linear_map.map_neg, coeff_rescale, coeff_X],
-  split_ifs with h; simp [h]
+  ext,
+  simp only [coeff_rescale, coeff_C_mul, coeff_X],
+  split_ifs with h;
+  simp [h],
 end
 
+lemma rescale_neg_one_X : rescale (-1 : A) X = -X :=
+by rw [rescale_X, map_neg, map_one, neg_one_mul]
+
 /-- The ring homomorphism taking a power series `f(X)` to `f(-X)`. -/
 noncomputable def eval_neg_hom : power_series A →+* power_series A :=
 rescale (-1 : A)
@@ -1418,10 +1457,10 @@ rescale_neg_one_X
 end comm_ring
 
 section domain
-variables [ring R] [is_domain R]
+variables [ring R]
 
-lemma eq_zero_or_eq_zero_of_mul_eq_zero (φ ψ : power_series R) (h : φ * ψ = 0) :
-  φ = 0 ∨ ψ = 0 :=
+lemma eq_zero_or_eq_zero_of_mul_eq_zero [no_zero_divisors R] (φ ψ : power_series R)
+  (h : φ * ψ = 0) : φ = 0 ∨ ψ = 0 :=
 begin
   rw or_iff_not_imp_left, intro H,
   have ex : ∃ m, coeff R m φ ≠ 0, { contrapose! H, exact ext H },
@@ -1449,9 +1488,11 @@ begin
   { contrapose!, intro h, rw finset.nat.mem_antidiagonal }
 end
 
-instance : is_domain (power_series R) :=
-{ eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero,
-  .. power_series.nontrivial, }
+instance [no_zero_divisors R] : no_zero_divisors (power_series R) :=
+{ eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero }
+
+instance [is_domain R] : is_domain (power_series R) :=
+no_zero_divisors.to_is_domain _
 
 end domain
 
@@ -1579,8 +1620,7 @@ mv_power_series.inv_eq_iff_mul_eq_one h
   (φ * ψ)⁻¹ = ψ⁻¹ * φ⁻¹ :=
 mv_power_series.mul_inv_rev _ _
 
-@[simp] lemma one_inv : (1 : power_series k)⁻¹ = 1 :=
-mv_power_series.one_inv
+instance : inv_one_class (power_series k) := mv_power_series.inv_one_class
 
 @[simp] lemma C_inv (r : k) : (C k r)⁻¹ = C k r⁻¹ :=
 mv_power_series.C_inv _
@@ -1613,9 +1653,9 @@ begin
   simp [power_series.ext_iff]
 end
 
-/-- The order of a formal power series `φ` is the greatest `n : enat`
+/-- The order of a formal power series `φ` is the greatest `n : part_enat`
 such that `X^n` divides `φ`. The order is `⊤` if and only if `φ = 0`. -/
-def order (φ : power_series R) : enat :=
+def order (φ : power_series R) : part_enat :=
 if h : φ = 0 then ⊤ else nat.find (exists_coeff_ne_zero_iff_ne_zero.mpr h)
 
 /-- The order of the `0` power series is infinite.-/
@@ -1638,7 +1678,7 @@ then the coefficient indexed by the order is nonzero.-/
 lemma coeff_order (h : (order φ).dom) :
   coeff R (φ.order.get h) φ ≠ 0 :=
 begin
-  simp only [order, order_finite_iff_ne_zero.mp h, not_false_iff, dif_neg, enat.get_coe'],
+  simp only [order, order_finite_iff_ne_zero.mp h, not_false_iff, dif_neg, part_enat.get_coe'],
   generalize_proofs h,
   exact nat.find_spec h
 end
@@ -1650,7 +1690,7 @@ lemma order_le (n : ℕ) (h : coeff R n φ ≠ 0) :
 begin
   have := exists.intro n h,
   rw [order, dif_neg],
-  { simp only [enat.coe_le_coe, nat.find_le_iff],
+  { simp only [part_enat.coe_le_coe, nat.find_le_iff],
     exact ⟨n, le_rfl, h⟩ },
   { exact exists_coeff_ne_zero_iff_ne_zero.mp ⟨n, h⟩ }
 end
@@ -1676,20 +1716,20 @@ lemma nat_le_order (φ : power_series R) (n : ℕ) (h : ∀ i < n, coeff R i φ
   ↑n ≤ order φ :=
 begin
   by_contra H, rw not_le at H,
-  have : (order φ).dom := enat.dom_of_le_coe H.le,
-  rw [← enat.coe_get this, enat.coe_lt_coe] at H,
+  have : (order φ).dom := part_enat.dom_of_le_coe H.le,
+  rw [← part_enat.coe_get this, part_enat.coe_lt_coe] at H,
   exact coeff_order this (h _ H)
 end
 
 /-- The order of a formal power series is at least `n` if
 the `i`th coefficient is `0` for all `i < n`.-/
-lemma le_order (φ : power_series R) (n : enat) (h : ∀ i : ℕ, ↑i < n → coeff R i φ = 0) :
+lemma le_order (φ : power_series R) (n : part_enat) (h : ∀ i : ℕ, ↑i < n → coeff R i φ = 0) :
   n ≤ order φ :=
 begin
-  induction n using enat.cases_on,
+  induction n using part_enat.cases_on,
   { show _ ≤ _, rw [top_le_iff, order_eq_top],
-    ext i, exact h _ (enat.coe_lt_top i) },
-  { apply nat_le_order, simpa only [enat.coe_lt_coe] using h }
+    ext i, exact h _ (part_enat.coe_lt_top i) },
+  { apply nat_le_order, simpa only [part_enat.coe_lt_coe] using h }
 end
 
 /-- The order of a formal power series is exactly `n` if the `n`th coefficient is nonzero,
@@ -1698,22 +1738,22 @@ lemma order_eq_nat {φ : power_series R} {n : ℕ} :
   order φ = n ↔ (coeff R n φ ≠ 0) ∧ (∀ i, i < n → coeff R i φ = 0) :=
 begin
   rcases eq_or_ne φ 0 with rfl|hφ,
-  { simpa using (enat.coe_ne_top _).symm },
+  { simpa using (part_enat.coe_ne_top _).symm },
   simp [order, dif_neg hφ, nat.find_eq_iff]
 end
 
 /-- The order of a formal power series is exactly `n` if the `n`th coefficient is nonzero,
 and the `i`th coefficient is `0` for all `i < n`.-/
-lemma order_eq {φ : power_series R} {n : enat} :
+lemma order_eq {φ : power_series R} {n : part_enat} :
   order φ = n ↔ (∀ i:ℕ, ↑i = n → coeff R i φ ≠ 0) ∧ (∀ i:ℕ, ↑i < n → coeff R i φ = 0) :=
 begin
-  induction n using enat.cases_on,
+  induction n using part_enat.cases_on,
   { rw order_eq_top, split,
     { rintro rfl, split; intros,
-      { exfalso, exact enat.coe_ne_top ‹_› ‹_› },
+      { exfalso, exact part_enat.coe_ne_top ‹_› ‹_› },
       { exact (coeff _ _).map_zero } },
-    { rintro ⟨h₁, h₂⟩, ext i, exact h₂ i (enat.coe_lt_top i) } },
-  { simpa [enat.coe_inj] using order_eq_nat }
+    { rintro ⟨h₁, h₂⟩, ext i, exact h₂ i (part_enat.coe_lt_top i) } },
+  { simpa [part_enat.coe_inj] using order_eq_nat }
 end
 
 /-- The order of the sum of two formal power series
@@ -1777,8 +1817,8 @@ begin
   split_ifs with h,
   { rw [h, order_eq_top, linear_map.map_zero] },
   { rw [order_eq], split; intros i hi,
-    { rw [enat.coe_inj] at hi, rwa [hi, coeff_monomial_same] },
-    { rw [enat.coe_lt_coe] at hi, rw [coeff_monomial, if_neg], exact ne_of_lt hi } }
+    { rw [part_enat.coe_inj] at hi, rwa [hi, coeff_monomial_same] },
+    { rw [part_enat.coe_lt_coe] at hi, rw [coeff_monomial, if_neg], exact ne_of_lt hi } }
 end
 
 /-- The order of the monomial `a*X^n` is `n` if `a ≠ 0`.-/
@@ -1829,29 +1869,29 @@ begin
   { simp [tsub_add_cancel_of_le hn] },
   { simp only [finset.sum_empty],
     refine coeff_of_lt_order _ _,
-    simpa [enat.coe_lt_iff] using λ _, hn }
+    simpa [part_enat.coe_lt_iff] using λ _, hn }
 end
 
-lemma order_eq_multiplicity_X {R : Type*} [comm_semiring R] (φ : power_series R) :
+lemma order_eq_multiplicity_X {R : Type*} [semiring R] (φ : power_series R) :
   order φ = multiplicity X φ :=
 begin
   rcases eq_or_ne φ 0 with rfl|hφ,
   { simp },
-  induction ho : order φ using enat.cases_on with n,
+  induction ho : order φ using part_enat.cases_on with n,
   { simpa [hφ] using ho },
   have hn : φ.order.get (order_finite_iff_ne_zero.mpr hφ) = n,
   { simp [ho] },
   rw ←hn,
   refine le_antisymm (le_multiplicity_of_pow_dvd $ X_pow_order_dvd
-    (order_finite_iff_ne_zero.mpr hφ)) (enat.find_le _ _ _),
+    (order_finite_iff_ne_zero.mpr hφ)) (part_enat.find_le _ _ _),
   rintro ⟨ψ, H⟩,
   have := congr_arg (coeff R n) H,
-  rw [mul_comm, coeff_mul_of_lt_order, ←hn] at this,
+  rw [← (ψ.commute_X.pow_right _).eq, coeff_mul_of_lt_order, ←hn] at this,
   { exact coeff_order _ this },
   { rw [X_pow_eq, order_monomial],
     split_ifs,
-    { exact enat.coe_lt_top _ },
-    { rw [←hn, enat.coe_lt_coe],
+    { exact part_enat.coe_lt_top _ },
+    { rw [←hn, part_enat.coe_lt_coe],
       exact nat.lt_succ_self _ } }
 end
 
@@ -2008,9 +2048,9 @@ instance algebra_power_series : algebra (power_series R) (power_series A) :=
 (map (algebra_map R A)).to_algebra
 
 @[priority 100] -- see Note [lower instance priority]
-instance algebra_polynomial' {A : Type*} [comm_semiring A] [algebra R (polynomial A)] :
+instance algebra_polynomial' {A : Type*} [comm_semiring A] [algebra R A[X]] :
   algebra R (power_series A) :=
-ring_hom.to_algebra $ polynomial.coe_to_power_series.ring_hom.comp (algebra_map R (polynomial A))
+ring_hom.to_algebra $ polynomial.coe_to_power_series.ring_hom.comp (algebra_map R A[X])
 
 variables (A)
 
diff --git a/src/ring_theory/power_series/well_known.lean b/src/ring_theory/power_series/well_known.lean
index 0e1ee81f3f6fd..95b14d16c5a85 100644
--- a/src/ring_theory/power_series/well_known.lean
+++ b/src/ring_theory/power_series/well_known.lean
@@ -10,6 +10,9 @@ import algebra.big_operators.nat_antidiagonal
 /-!
 # Definition of well-known power series
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the following power series:
 
 * `power_series.inv_units_sub`: given `u : Rˣ`, this is the series for `1 / (u - x)`.
@@ -77,6 +80,20 @@ variables {A A'} (n : ℕ) (f : A →+* A')
 @[simp] lemma constant_coeff_exp : constant_coeff A (exp A) = 1 :=
 by { rw [← coeff_zero_eq_constant_coeff_apply, coeff_exp], simp }
 
+@[simp] lemma coeff_sin_bit0 : coeff A (bit0 n) (sin A) = 0 :=
+by rw [sin, coeff_mk, if_pos (even_bit0 n)]
+
+@[simp] lemma coeff_sin_bit1 : coeff A (bit1 n) (sin A) = (-1) ^ n * coeff A (bit1 n) (exp A) :=
+by rw [sin, coeff_mk, if_neg n.not_even_bit1, nat.bit1_div_two,
+  ←mul_one_div, map_mul, map_pow, map_neg, map_one, coeff_exp]
+
+@[simp] lemma coeff_cos_bit0 : coeff A (bit0 n) (cos A) = (-1) ^ n * coeff A (bit0 n) (exp A) :=
+by rw [cos, coeff_mk, if_pos (even_bit0 n), nat.bit0_div_two,
+  ←mul_one_div, map_mul, map_pow, map_neg, map_one, coeff_exp]
+
+@[simp] lemma coeff_cos_bit1 : coeff A (bit1 n) (cos A) = 0 :=
+by rw [cos, coeff_mk, if_neg n.not_even_bit1]
+
 @[simp] lemma map_exp : map (f : A →+* A') (exp A) = exp A' := by { ext, simp }
 
 @[simp] lemma map_sin : map f (sin A) = sin A' := by { ext, simp [sin, apply_ite f] }
diff --git a/src/ring_theory/prime.lean b/src/ring_theory/prime.lean
index 9d37527d15d08..d6b42a534d26d 100644
--- a/src/ring_theory/prime.lean
+++ b/src/ring_theory/prime.lean
@@ -7,6 +7,9 @@ import algebra.associated
 import algebra.big_operators.basic
 /-!
 # Prime elements in rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 This file contains lemmas about prime elements of commutative rings.
 -/
 
diff --git a/src/ring_theory/principal_ideal_domain.lean b/src/ring_theory/principal_ideal_domain.lean
index 4aeb34fc49dc6..4b08be8b78890 100644
--- a/src/ring_theory/principal_ideal_domain.lean
+++ b/src/ring_theory/principal_ideal_domain.lean
@@ -3,11 +3,15 @@ Copyright (c) 2018 Chris Hughes. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Chris Hughes, Morenikeji Neri
 -/
+import algebra.euclidean_domain.instances
 import ring_theory.unique_factorization_domain
 
 /-!
 # Principal ideal rings and principal ideal domains
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A principal ideal ring (PIR) is a ring in which all left ideals are principal. A
 principal ideal domain (PID) is an integral domain which is a principal ideal ring.
 
@@ -38,6 +42,7 @@ section
 variables [ring R] [add_comm_group M] [module R M]
 
 /-- An `R`-submodule of `M` is principal if it is generated by one element. -/
+@[mk_iff]
 class submodule.is_principal (S : submodule R M) : Prop :=
 (principal [] : ∃ a, S = span R {a})
 
@@ -50,7 +55,7 @@ instance top_is_principal : (⊤ : submodule R R).is_principal :=
 variables (R)
 
 /-- A ring is a principal ideal ring if all (left) ideals are principal. -/
-class is_principal_ideal_ring (R : Type u) [ring R] : Prop :=
+@[mk_iff] class is_principal_ideal_ring (R : Type u) [ring R] : Prop :=
 (principal : ∀ (S : ideal R), S.is_principal)
 
 attribute [instance] is_principal_ideal_ring.principal
@@ -103,7 +108,7 @@ lemma prime_generator_of_is_prime (S : ideal R) [submodule.is_principal S] [is_p
   prime (generator S) :=
 ⟨λ h, ne_bot ((eq_bot_iff_generator_eq_zero S).2 h),
  λ h, is_prime.ne_top (S.eq_top_of_is_unit_mem (generator_mem S) h),
- by simpa only [← mem_iff_generator_dvd S] using is_prime.2⟩
+ λ _ _, by simpa only [← mem_iff_generator_dvd S] using is_prime.2⟩
 
 -- Note that the converse may not hold if `ϕ` is not injective.
 lemma generator_map_dvd_of_mem {N : submodule R M}
@@ -306,19 +311,19 @@ begin
     exact (span_singleton_mul_right_unit D.is_unit _) },
   apply associated_of_dvd_dvd,
   { rw dvd_gcd_iff,
-    split; rw [←ideal.mem_span_singleton, ←hd, mem_span_pair],
+    split; rw [←ideal.mem_span_singleton, ←hd, ideal.mem_span_pair],
     { use [1, 0],
       rw [one_mul, zero_mul, add_zero] },
     { use [0, 1],
       rw [one_mul, zero_mul, zero_add] } },
   { obtain ⟨r, s, rfl⟩ : ∃ r s, r * x + s * y = d,
-    { rw [←mem_span_pair, hd, ideal.mem_span_singleton] },
+    { rw [←ideal.mem_span_pair, hd, ideal.mem_span_singleton] },
     apply dvd_add; apply dvd_mul_of_dvd_right,
     exacts [gcd_dvd_left x y, gcd_dvd_right x y] },
 end
 
 theorem gcd_dvd_iff_exists (a b : R) {z} : gcd a b ∣ z ↔ ∃ x y, z = a * x + b * y :=
-by simp_rw [mul_comm a, mul_comm b, @eq_comm _ z, ←mem_span_pair, ←span_gcd,
+by simp_rw [mul_comm a, mul_comm b, @eq_comm _ z, ←ideal.mem_span_pair, ←span_gcd,
   ideal.mem_span_singleton]
 
 /-- **Bézout's lemma** -/
@@ -326,7 +331,7 @@ theorem exists_gcd_eq_mul_add_mul (a b : R) : ∃ x y, gcd a b = a * x + b * y :
 by rw [←gcd_dvd_iff_exists]
 
 theorem gcd_is_unit_iff (x y : R) : is_unit (gcd x y) ↔ is_coprime x y :=
-by rw [is_coprime, ←mem_span_pair, ←span_gcd, ←span_singleton_eq_top, eq_top_iff_one]
+by rw [is_coprime, ←ideal.mem_span_pair, ←span_gcd, ←span_singleton_eq_top, eq_top_iff_one]
 
 -- this should be proved for UFDs surely?
 theorem is_coprime_of_dvd (x y : R)
@@ -405,3 +410,86 @@ theorem exists_associated_pow_of_mul_eq_pow' {a b c : R}
 exists_associated_pow_of_mul_eq_pow ((gcd_is_unit_iff _ _).mpr hab) h
 
 end
+
+section principal_of_prime
+
+open set ideal
+
+variables (R) [comm_ring R]
+
+/-- `non_principals R` is the set of all ideals of `R` that are not principal ideals. -/
+def non_principals := {I : ideal R | ¬ I.is_principal}
+
+lemma non_principals_def {I : ideal R} : I ∈ non_principals R ↔ ¬ I.is_principal :=
+iff.rfl
+
+variables {R}
+lemma non_principals_eq_empty_iff : non_principals R = ∅ ↔ is_principal_ideal_ring R :=
+by simp [set.eq_empty_iff_forall_not_mem, is_principal_ideal_ring_iff, non_principals_def]
+
+/-- Any chain in the set of non-principal ideals has an upper bound which is non-principal.
+(Namely, the union of the chain is such an upper bound.)
+-/
+lemma non_principals_zorn (c : set (ideal R)) (hs : c ⊆ non_principals R) (hchain : is_chain (≤) c)
+  {K : ideal R} (hKmem : K ∈ c) :
+  ∃ I ∈ non_principals R, ∀ J ∈ c, J ≤ I :=
+begin
+  refine ⟨Sup c, _, λ J hJ, le_Sup hJ⟩,
+  rintro ⟨x, hx⟩,
+  have hxmem : x ∈ Sup c := (hx.symm ▸ submodule.mem_span_singleton_self x),
+  obtain ⟨J, hJc, hxJ⟩ := (submodule.mem_Sup_of_directed ⟨K, hKmem⟩ hchain.directed_on).1 hxmem,
+  have hSupJ : Sup c = J := le_antisymm (by simp [hx, ideal.span_le, hxJ]) (le_Sup hJc),
+  specialize hs hJc,
+  rw [← hSupJ, hx, non_principals_def] at hs,
+  exact hs ⟨⟨x, rfl⟩⟩
+end
+
+/-- If all prime ideals in a commutative ring are principal, so are all other ideals. -/
+theorem is_principal_ideal_ring.of_prime (H : ∀ (P : ideal R), P.is_prime → P.is_principal) :
+  is_principal_ideal_ring R :=
+begin
+  -- Suppose the set of `non_principals` is not empty.
+  rw [← non_principals_eq_empty_iff, set.eq_empty_iff_forall_not_mem],
+  intros J hJ,
+  -- We will show a maximal element `I ∈ non_principals R` (which exists by Zorn) is prime.
+  obtain ⟨I, Ibad, -, Imax⟩ := zorn_nonempty_partial_order₀
+    (non_principals R) non_principals_zorn _ hJ,
+  have Imax' : ∀ {J}, I < J → J.is_principal,
+  { intros J hJ,
+    by_contra He,
+    exact hJ.ne (Imax _ ((non_principals_def R).2 He) hJ.le).symm },
+  by_cases hI1 : I = ⊤,
+  { subst hI1,
+    exact Ibad top_is_principal },
+  -- Let `x y : R` with `x * y ∈ I` and suppose WLOG `y ∉ I`.
+  refine Ibad (H I ⟨hI1, λ x y hxy, or_iff_not_imp_right.mpr (λ hy, _)⟩),
+  obtain ⟨a, ha⟩ : (I ⊔ span {y}).is_principal :=
+    Imax' (left_lt_sup.mpr (mt I.span_singleton_le_iff_mem.mp hy)),
+  -- Then `x ∈ I.colon (span {y})`, which is equal to `I` if it's not principal.
+  suffices He : ¬ ((I.colon (span {y})).is_principal),
+  { rw ← Imax _ ((non_principals_def R).2 He)
+        (λ a ha, ideal.mem_colon_singleton.2 (mul_mem_right _ _ ha)),
+    exact ideal.mem_colon_singleton.2 hxy },
+  -- So suppose for the sake of contradiction that both `I ⊔ span {y}` and `I.colon (span {y})`
+  -- are principal.
+  rintros ⟨b, hb⟩,
+  -- We will show `I` is generated by `a * b`.
+  refine (non_principals_def _).1 Ibad ⟨⟨a * b, le_antisymm (λ i hi, _) $
+    (span_singleton_mul_span_singleton a b).ge.trans _⟩⟩,
+  { have hisup : i ∈ I ⊔ span {y} := ideal.mem_sup_left hi,
+    have : y ∈ I ⊔ span {y} := ideal.mem_sup_right (ideal.mem_span_singleton_self y),
+    erw [ha, mem_span_singleton'] at hisup this,
+    obtain ⟨v, rfl⟩ := this,
+    obtain ⟨u, rfl⟩ := hisup,
+    have hucolon : u ∈ I.colon (span {v * a}),
+    { rw [ideal.mem_colon_singleton, mul_comm v, ← mul_assoc],
+      exact mul_mem_right _ _ hi },
+    erw [hb, mem_span_singleton'] at hucolon,
+    obtain ⟨z, rfl⟩ := hucolon,
+    exact mem_span_singleton'.2 ⟨z, by ring⟩ },
+  { rw [← ideal.submodule_span_eq, ← ha, ideal.sup_mul, sup_le_iff,
+        span_singleton_mul_span_singleton, mul_comm y, ideal.span_singleton_le_iff_mem],
+    exact ⟨mul_le_right, ideal.mem_colon_singleton.1 $ hb.symm ▸ ideal.mem_span_singleton_self b⟩ },
+end
+
+end principal_of_prime
diff --git a/src/ring_theory/quotient_nilpotent.lean b/src/ring_theory/quotient_nilpotent.lean
new file mode 100644
index 0000000000000..221c44c4f72fd
--- /dev/null
+++ b/src/ring_theory/quotient_nilpotent.lean
@@ -0,0 +1,77 @@
+/-
+Copyright (c) 2021 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import ring_theory.nilpotent
+import ring_theory.ideal.quotient_operations
+
+/-!
+# Nilpotent elements in quotient rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+lemma ideal.is_radical_iff_quotient_reduced {R : Type*} [comm_ring R] (I : ideal R) :
+  I.is_radical ↔ is_reduced (R ⧸ I) :=
+by { conv_lhs { rw ← @ideal.mk_ker R _ I },
+  exact ring_hom.ker_is_radical_iff_reduced_of_surjective (@ideal.quotient.mk_surjective R _ I) }
+
+variables {R S : Type*} [comm_semiring R] [comm_ring S] [algebra R S] (I : ideal S)
+
+/-- Let `P` be a property on ideals. If `P` holds for square-zero ideals, and if
+  `P I → P (J ⧸ I) → P J`, then `P` holds for all nilpotent ideals. -/
+lemma ideal.is_nilpotent.induction_on
+  (hI : is_nilpotent I)
+  {P : ∀ ⦃S : Type*⦄ [comm_ring S], by exactI ∀ I : ideal S, Prop}
+  (h₁ : ∀ ⦃S : Type*⦄ [comm_ring S], by exactI ∀ I : ideal S, I ^ 2 = ⊥ → P I)
+  (h₂ : ∀ ⦃S : Type*⦄ [comm_ring S], by exactI
+    ∀ I J : ideal S, I ≤ J → P I → P (J.map (ideal.quotient.mk I)) → P J) : P I :=
+begin
+  obtain ⟨n, hI : I ^ n = ⊥⟩ := hI,
+  unfreezingI { revert S },
+  apply nat.strong_induction_on n,
+  clear n,
+  introsI n H S _ I hI,
+  by_cases hI' : I = ⊥,
+  { subst hI', apply h₁, rw [← ideal.zero_eq_bot, zero_pow], exact zero_lt_two },
+  cases n,
+  { rw [pow_zero, ideal.one_eq_top] at hI,
+    haveI := subsingleton_of_bot_eq_top hI.symm,
+    exact (hI' (subsingleton.elim _ _)).elim },
+  cases n,
+  { rw [pow_one] at hI,
+    exact (hI' hI).elim },
+  apply h₂ (I ^ 2) _ (ideal.pow_le_self two_ne_zero),
+  { apply H n.succ _ (I ^ 2),
+    { rw [← pow_mul, eq_bot_iff, ← hI, nat.succ_eq_add_one, nat.succ_eq_add_one],
+      exact ideal.pow_le_pow (by linarith) },
+    { exact le_refl n.succ.succ } },
+  { apply h₁, rw [← ideal.map_pow, ideal.map_quotient_self] },
+end
+
+lemma is_nilpotent.is_unit_quotient_mk_iff {R : Type*} [comm_ring R] {I : ideal R}
+  (hI : is_nilpotent I) {x : R} : is_unit (ideal.quotient.mk I x) ↔ is_unit x :=
+begin
+  refine ⟨_, λ h, h.map I^.quotient.mk⟩,
+  revert x,
+  apply ideal.is_nilpotent.induction_on I hI; clear hI I,
+  swap,
+  { introv e h₁ h₂ h₃,
+    apply h₁,
+    apply h₂,
+    exactI h₃.map ((double_quot.quot_quot_equiv_quot_sup I J).trans
+      (ideal.quot_equiv_of_eq (sup_eq_right.mpr e))).symm.to_ring_hom },
+  { introv e H,
+    resetI,
+    obtain ⟨y, hy⟩ := ideal.quotient.mk_surjective (↑(H.unit⁻¹) : S ⧸ I),
+    have : ideal.quotient.mk I (x * y) = ideal.quotient.mk I 1,
+    { rw [map_one, _root_.map_mul, hy, is_unit.mul_coe_inv] },
+    rw ideal.quotient.eq at this,
+    have : (x * y - 1) ^ 2 = 0,
+    { rw [← ideal.mem_bot, ← e], exact ideal.pow_mem_pow this _ },
+    have : x * (y * (2 - x * y)) = 1,
+    { rw [eq_comm, ← sub_eq_zero, ← this], ring },
+    exact is_unit_of_mul_eq_one _ _ this }
+end
diff --git a/src/ring_theory/quotient_noetherian.lean b/src/ring_theory/quotient_noetherian.lean
new file mode 100644
index 0000000000000..2bbef7744a475
--- /dev/null
+++ b/src/ring_theory/quotient_noetherian.lean
@@ -0,0 +1,18 @@
+/-
+Copyright (c) 2021 Anne Baanen. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anne Baanen
+-/
+import ring_theory.noetherian
+import ring_theory.quotient_nilpotent
+
+/-!
+# Noetherian quotient rings and quotient modules
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+instance ideal.quotient.is_noetherian_ring {R : Type*} [comm_ring R] [h : is_noetherian_ring R]
+  (I : ideal R) : is_noetherian_ring (R ⧸ I) :=
+is_noetherian_ring_iff.mpr $ is_noetherian_of_tower R $ submodule.quotient.is_noetherian _
diff --git a/src/ring_theory/rees_algebra.lean b/src/ring_theory/rees_algebra.lean
new file mode 100644
index 0000000000000..8668d8794b884
--- /dev/null
+++ b/src/ring_theory/rees_algebra.lean
@@ -0,0 +1,126 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+
+import ring_theory.finite_type
+
+/-!
+
+# Rees algebra
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The Rees algebra of an ideal `I` is the subalgebra `R[It]` of `R[t]` defined as `R[It] = ⨁ₙ Iⁿ tⁿ`.
+This is used to prove the Artin-Rees lemma, and will potentially enable us to calculate some
+blowup in the future.
+
+## Main definition
+
+- `rees_algebra` : The Rees algebra of an ideal `I`, defined as a subalgebra of `R[X]`.
+- `adjoin_monomial_eq_rees_algebra` : The Rees algebra is generated by the degree one elements.
+- `rees_algebra.fg` : The Rees algebra of a f.g. ideal is of finite type. In particular, this
+implies that the rees algebra over a noetherian ring is still noetherian.
+
+-/
+
+universes u v
+
+variables {R M : Type u} [comm_ring R] [add_comm_group M] [module R M] (I : ideal R)
+
+open polynomial
+open_locale polynomial big_operators
+
+/-- The Rees algebra of an ideal `I`, defined as the subalgebra of `R[X]` whose `i`-th coefficient
+falls in `I ^ i`. -/
+def rees_algebra : subalgebra R R[X] :=
+{ carrier := { f | ∀ i, f.coeff i ∈ I ^ i },
+  mul_mem' := λ f g hf hg i, begin
+    rw coeff_mul,
+    apply ideal.sum_mem,
+    rintros ⟨j, k⟩ e,
+    rw [← finset.nat.mem_antidiagonal.mp e, pow_add],
+    exact ideal.mul_mem_mul (hf j) (hg k)
+  end,
+  one_mem' := λ i, begin
+    rw coeff_one,
+    split_ifs,
+    { subst h, simp },
+    { simp }
+  end,
+  add_mem' := λ f g hf hg i, begin
+    rw coeff_add,
+    exact ideal.add_mem _ (hf i) (hg i)
+  end,
+  zero_mem' := λ i, ideal.zero_mem _,
+  algebra_map_mem' := λ r i, begin
+    rw [algebra_map_apply, coeff_C],
+    split_ifs,
+    { subst h, simp },
+    { simp }
+  end }
+
+lemma mem_rees_algebra_iff (f : R[X]) :
+  f ∈ rees_algebra I ↔ ∀ i, f.coeff i ∈ I ^ i := iff.rfl
+
+lemma mem_rees_algebra_iff_support (f : R[X]) :
+  f ∈ rees_algebra I ↔ ∀ i ∈ f.support, f.coeff i ∈ I ^ i :=
+begin
+  apply forall_congr,
+  intro a,
+  rw [mem_support_iff, iff.comm, imp_iff_right_iff, ne.def, ← imp_iff_not_or],
+  exact λ e, e.symm ▸ (I ^ a).zero_mem
+end
+
+lemma rees_algebra.monomial_mem {I : ideal R} {i : ℕ} {r : R} :
+  monomial i r ∈ rees_algebra I ↔ r ∈ I ^ i :=
+by simp [mem_rees_algebra_iff_support, coeff_monomial, ← imp_iff_not_or] { contextual := tt }
+
+lemma monomial_mem_adjoin_monomial {I : ideal R} {n : ℕ} {r : R} (hr : r ∈ I ^ n) :
+  monomial n r ∈ algebra.adjoin R (submodule.map (monomial 1 : R →ₗ[R] R[X]) I : set R[X]) :=
+begin
+  induction n with n hn generalizing r,
+  { exact subalgebra.algebra_map_mem _ _ },
+  { rw pow_succ at hr,
+    apply submodule.smul_induction_on hr,
+    { intros r hr s hs,
+      rw [nat.succ_eq_one_add, smul_eq_mul, ← monomial_mul_monomial],
+      exact subalgebra.mul_mem _ (algebra.subset_adjoin (set.mem_image_of_mem _ hr)) (hn hs) },
+    { intros x y hx hy, rw monomial_add, exact subalgebra.add_mem _ hx hy } }
+end
+
+lemma adjoin_monomial_eq_rees_algebra :
+  algebra.adjoin R (submodule.map (monomial 1 : R →ₗ[R] R[X]) I : set R[X]) = rees_algebra I :=
+begin
+  apply le_antisymm,
+  { apply algebra.adjoin_le _,
+    rintro _ ⟨r, hr, rfl⟩,
+    exact rees_algebra.monomial_mem.mpr (by rwa pow_one) },
+  { intros p hp,
+    rw p.as_sum_support,
+    apply subalgebra.sum_mem _ _,
+    rintros i -,
+    exact monomial_mem_adjoin_monomial (hp i) }
+end
+
+variables {I}
+
+lemma rees_algebra.fg (hI : I.fg) : (rees_algebra I).fg :=
+begin
+  classical,
+  obtain ⟨s, hs⟩ := hI,
+  rw [← adjoin_monomial_eq_rees_algebra, ← hs],
+  use s.image (monomial 1),
+  rw finset.coe_image,
+  change _ = algebra.adjoin R (submodule.map (monomial 1 : R →ₗ[R] R[X])
+    (submodule.span R ↑s) : set R[X]),
+  rw [submodule.map_span, algebra.adjoin_span]
+end
+
+instance [is_noetherian_ring R] : algebra.finite_type R (rees_algebra I) :=
+⟨(rees_algebra I).fg_top.mpr (rees_algebra.fg $ is_noetherian.noetherian I)⟩
+
+instance [is_noetherian_ring R] : is_noetherian_ring (rees_algebra I) :=
+algebra.finite_type.is_noetherian_ring R _
diff --git a/src/ring_theory/ring_hom/finite.lean b/src/ring_theory/ring_hom/finite.lean
new file mode 100644
index 0000000000000..5b351cd00a69c
--- /dev/null
+++ b/src/ring_theory/ring_hom/finite.lean
@@ -0,0 +1,48 @@
+/-
+Copyright (c) 2021 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.ring_hom_properties
+
+/-!
+
+# The meta properties of finite ring homomorphisms.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+namespace ring_hom
+
+open_locale tensor_product
+
+open tensor_product algebra.tensor_product
+
+lemma finite_stable_under_composition :
+  stable_under_composition @finite :=
+by { introv R hf hg, exactI hg.comp hf }
+
+lemma finite_respects_iso :
+  respects_iso @finite :=
+begin
+  apply finite_stable_under_composition.respects_iso,
+  introsI,
+  exact finite.of_surjective _ e.to_equiv.surjective,
+end
+
+lemma finite_stable_under_base_change :
+  stable_under_base_change @finite :=
+begin
+  refine stable_under_base_change.mk _ finite_respects_iso _,
+  classical,
+  introv h,
+  resetI,
+  replace h : module.finite R T := by { convert h, ext, rw algebra.smul_def, refl },
+  suffices : module.finite S (S ⊗[R] T),
+  { change module.finite _ _, convert this, ext, rw algebra.smul_def, refl },
+  exactI infer_instance
+end
+
+end ring_hom
diff --git a/src/ring_theory/ring_hom/finite_type.lean b/src/ring_theory/ring_hom/finite_type.lean
new file mode 100644
index 0000000000000..3d5d2f9b43b15
--- /dev/null
+++ b/src/ring_theory/ring_hom/finite_type.lean
@@ -0,0 +1,98 @@
+/-
+Copyright (c) 2021 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.local_properties
+import ring_theory.localization.inv_submonoid
+
+/-!
+
+# The meta properties of finite-type ring homomorphisms.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The main result is `ring_hom.finite_is_local`.
+
+-/
+
+namespace ring_hom
+
+open_locale pointwise
+
+lemma finite_type_stable_under_composition :
+  stable_under_composition @finite_type :=
+by { introv R hf hg, exactI hg.comp hf }
+
+lemma finite_type_holds_for_localization_away :
+  holds_for_localization_away @finite_type :=
+begin
+  introv R _,
+  resetI,
+  suffices : algebra.finite_type R S,
+  { change algebra.finite_type _ _, convert this, ext, rw algebra.smul_def, refl },
+  exact is_localization.finite_type_of_monoid_fg (submonoid.powers r) S,
+end
+
+lemma finite_type_of_localization_span_target : of_localization_span_target @finite_type :=
+begin
+  -- Setup algebra intances.
+  rw of_localization_span_target_iff_finite,
+  introv R hs H,
+  resetI,
+  classical,
+  letI := f.to_algebra,
+  replace H : ∀ r : s, algebra.finite_type R (localization.away (r : S)),
+  { intro r, convert H r, ext, rw algebra.smul_def, refl },
+  replace H := λ r, (H r).1,
+  constructor,
+  -- Suppose `s : finset S` spans `S`, and each `Sᵣ` is finitely generated as an `R`-algebra.
+  -- Say `t r : finset Sᵣ` generates `Sᵣ`. By assumption, we may find `lᵢ` such that
+  -- `∑ lᵢ * sᵢ = 1`. I claim that all `s` and `l` and the numerators of `t` and generates `S`.
+  choose t ht using H,
+  obtain ⟨l, hl⟩ := (finsupp.mem_span_iff_total S (s : set S) 1).mp
+    (show (1 : S) ∈ ideal.span (s : set S), by { rw hs, trivial }),
+  let sf := λ (x : s), is_localization.finset_integer_multiple (submonoid.powers (x : S)) (t x),
+  use s.attach.bUnion sf ∪ s ∪ l.support.image l,
+  rw eq_top_iff,
+  -- We need to show that every `x` falls in the subalgebra generated by those elements.
+  -- Since all `s` and `l` are in the subalgebra, it suffices to check that `sᵢ ^ nᵢ • x` falls in
+  -- the algebra for each `sᵢ` and some `nᵢ`.
+  rintro x -,
+  apply subalgebra.mem_of_span_eq_top_of_smul_pow_mem _ (s : set S) l hl _ _ x _,
+  { intros x hx,
+    apply algebra.subset_adjoin,
+    rw [finset.coe_union, finset.coe_union],
+    exact or.inl (or.inr hx) },
+  { intros i,
+    by_cases h : l i = 0, { rw h, exact zero_mem _ },
+    apply algebra.subset_adjoin,
+    rw [finset.coe_union, finset.coe_image],
+    exact or.inr (set.mem_image_of_mem _ (finsupp.mem_support_iff.mpr h)) },
+  { intro r,
+    rw [finset.coe_union, finset.coe_union, finset.coe_bUnion],
+    -- Since all `sᵢ` and numerators of `t r` are in the algebra, it suffices to show that the
+    -- image of `x` in `Sᵣ` falls in the `R`-adjoin of `t r`, which is of course true.
+    obtain ⟨⟨_, n₂, rfl⟩, hn₂⟩ := is_localization.exists_smul_mem_of_mem_adjoin
+      (submonoid.powers (r : S)) x (t r)
+      (algebra.adjoin R _) _ _ _,
+    { exact ⟨n₂, hn₂⟩ },
+    { intros x hx,
+      apply algebra.subset_adjoin,
+      refine or.inl (or.inl ⟨_, ⟨r, rfl⟩, _, ⟨s.mem_attach r, rfl⟩, hx⟩) },
+    { rw [submonoid.powers_eq_closure, submonoid.closure_le, set.singleton_subset_iff],
+      apply algebra.subset_adjoin,
+      exact or.inl (or.inr r.2) },
+    { rw ht, trivial } }
+end
+
+lemma finite_type_is_local :
+  property_is_local @finite_type :=
+⟨localization_finite_type, finite_type_of_localization_span_target,
+  finite_type_stable_under_composition, finite_type_holds_for_localization_away⟩
+
+lemma finite_type_respects_iso : ring_hom.respects_iso @ring_hom.finite_type :=
+ring_hom.finite_type_is_local.respects_iso
+
+end ring_hom
diff --git a/src/ring_theory/ring_hom/integral.lean b/src/ring_theory/ring_hom/integral.lean
new file mode 100644
index 0000000000000..1d96571c23f5f
--- /dev/null
+++ b/src/ring_theory/ring_hom/integral.lean
@@ -0,0 +1,50 @@
+/-
+Copyright (c) 2021 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.ring_hom_properties
+import ring_theory.integral_closure
+
+/-!
+
+# The meta properties of integral ring homomorphisms.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+namespace ring_hom
+
+open_locale tensor_product
+
+open tensor_product algebra.tensor_product
+
+lemma is_integral_stable_under_composition :
+  stable_under_composition (λ R S _ _ f, by exactI f.is_integral) :=
+by { introv R hf hg, exactI ring_hom.is_integral_trans _ _ hf hg }
+
+lemma is_integral_respects_iso :
+  respects_iso (λ R S _ _ f, by exactI f.is_integral) :=
+begin
+  apply is_integral_stable_under_composition.respects_iso,
+  introv x,
+  resetI,
+  rw ← e.apply_symm_apply x,
+  apply ring_hom.is_integral_map
+end
+
+lemma is_integral_stable_under_base_change :
+  stable_under_base_change (λ R S _ _ f, by exactI f.is_integral) :=
+begin
+  refine stable_under_base_change.mk _ is_integral_respects_iso _,
+  introv h x,
+  resetI,
+  apply tensor_product.induction_on x,
+  { apply is_integral_zero },
+  { intros x y, exact is_integral.tmul x (h y) },
+  { intros x y hx hy, exact is_integral_add _ hx hy }
+end
+
+end ring_hom
diff --git a/src/ring_theory/ring_hom/surjective.lean b/src/ring_theory/ring_hom/surjective.lean
new file mode 100644
index 0000000000000..82cf95993fdab
--- /dev/null
+++ b/src/ring_theory/ring_hom/surjective.lean
@@ -0,0 +1,81 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import ring_theory.local_properties
+
+/-!
+
+# The meta properties of surjective ring homomorphisms.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+namespace ring_hom
+
+open_locale tensor_product
+
+open tensor_product algebra.tensor_product
+
+local notation `surjective` := λ {X Y : Type*} [comm_ring X] [comm_ring Y] ,
+  by exactI λ (f : X →+* Y), function.surjective f
+
+lemma surjective_stable_under_composition :
+  stable_under_composition surjective :=
+by { introv R hf hg, exactI hg.comp hf }
+
+lemma surjective_respects_iso :
+  respects_iso surjective :=
+begin
+  apply surjective_stable_under_composition.respects_iso,
+  introsI,
+  exact e.surjective
+end
+
+lemma surjective_stable_under_base_change :
+  stable_under_base_change surjective :=
+begin
+  refine stable_under_base_change.mk _ surjective_respects_iso _,
+  classical,
+  introv h x,
+  resetI,
+  induction x using tensor_product.induction_on with x y x y ex ey,
+  { exact ⟨0, map_zero _⟩ },
+  { obtain ⟨y, rfl⟩ := h y, use y • x, dsimp,
+    rw [tensor_product.smul_tmul, algebra.algebra_map_eq_smul_one] },
+  { obtain ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩ := ⟨ex, ey⟩, exact ⟨x + y, map_add _ x y⟩ }
+end
+
+open_locale big_operators
+
+lemma surjective_of_localization_span :
+  of_localization_span surjective :=
+begin
+  introv R hs H,
+  resetI,
+  letI := f.to_algebra,
+  show function.surjective (algebra.of_id R S),
+  rw [← algebra.range_top_iff_surjective, eq_top_iff],
+  rintro x -,
+  obtain ⟨l, hl⟩ :=
+    (finsupp.mem_span_iff_total R s 1).mp (show _ ∈ ideal.span s, by { rw hs, trivial }),
+  fapply subalgebra.mem_of_finset_sum_eq_one_of_pow_smul_mem _
+    l.support (λ x : s, f x) (λ x : s, f (l x)),
+  { dsimp only, simp_rw [← _root_.map_mul, ← map_sum, ← f.map_one], exact f.congr_arg hl },
+  { exact λ _, set.mem_range_self _ },
+  { exact λ _, set.mem_range_self _ },
+  { intro r,
+    obtain ⟨y, hy⟩ := H r (is_localization.mk' _ x (1 : submonoid.powers (f r))),
+    obtain ⟨z, ⟨_, n, rfl⟩, rfl⟩ := is_localization.mk'_surjective (submonoid.powers (r : R)) y,
+    erw [is_localization.map_mk', is_localization.eq] at hy,
+    obtain ⟨⟨_, m, rfl⟩, hm⟩ := hy,
+    refine ⟨m + n, _⟩,
+    dsimp at hm ⊢,
+    simp_rw [_root_.one_mul, ← _root_.mul_assoc, ← map_pow, ← f.map_mul, ← pow_add, map_pow] at hm,
+    exact ⟨_, hm⟩ }
+end
+
+end ring_hom
diff --git a/src/ring_theory/ring_hom_properties.lean b/src/ring_theory/ring_hom_properties.lean
new file mode 100644
index 0000000000000..e83e147d9c865
--- /dev/null
+++ b/src/ring_theory/ring_hom_properties.lean
@@ -0,0 +1,168 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import algebra.category.Ring.constructions
+import algebra.category.Ring.colimits
+import category_theory.isomorphism
+import ring_theory.localization.away.basic
+import ring_theory.is_tensor_product
+
+/-!
+# Properties of ring homomorphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We provide the basic framework for talking about properties of ring homomorphisms.
+The following meta-properties of predicates on ring homomorphisms are defined
+
+* `ring_hom.respects_iso`: `P` respects isomorphisms if `P f → P (e ≫ f)` and
+  `P f → P (f ≫ e)`, where `e` is an isomorphism.
+* `ring_hom.stable_under_composition`: `P` is stable under composition if `P f → P g → P (f ≫ g)`.
+* `ring_hom.stable_under_base_change`: `P` is stable under base change if `P (S ⟶ Y)`
+  implies `P (X ⟶ X ⊗[S] Y)`.
+
+-/
+
+universe u
+
+open category_theory opposite category_theory.limits
+
+namespace ring_hom
+
+variable (P : ∀ {R S : Type u} [comm_ring R] [comm_ring S] (f : by exactI R →+* S), Prop)
+
+include P
+
+section respects_iso
+
+/-- A property `respects_iso` if it still holds when composed with an isomorphism -/
+def respects_iso : Prop :=
+(∀ {R S T : Type u} [comm_ring R] [comm_ring S] [comm_ring T], by exactI
+    ∀ (f : R →+* S) (e : S ≃+* T) (hf : P f), P (e.to_ring_hom.comp f)) ∧
+  (∀ {R S T : Type u} [comm_ring R] [comm_ring S] [comm_ring T], by exactI
+    ∀ (f : S →+* T) (e : R ≃+* S) (hf : P f), P (f.comp e.to_ring_hom))
+
+variable {P}
+
+lemma respects_iso.cancel_left_is_iso (hP : respects_iso @P) {R S T : CommRing}
+  (f : R ⟶ S) (g : S ⟶ T)
+  [is_iso f] : P (f ≫ g) ↔ P g :=
+⟨λ H, by { convert hP.2 (f ≫ g) (as_iso f).symm.CommRing_iso_to_ring_equiv H,
+  exact (is_iso.inv_hom_id_assoc _ _).symm }, hP.2 g (as_iso f).CommRing_iso_to_ring_equiv⟩
+
+lemma respects_iso.cancel_right_is_iso (hP : respects_iso @P) {R S T : CommRing}
+  (f : R ⟶ S) (g : S ⟶ T)
+  [is_iso g] : P (f ≫ g) ↔ P f :=
+⟨λ H, by { convert hP.1 (f ≫ g) (as_iso g).symm.CommRing_iso_to_ring_equiv H,
+  change f = f ≫ g ≫ (inv g), simp }, hP.1 f (as_iso g).CommRing_iso_to_ring_equiv⟩
+
+lemma respects_iso.is_localization_away_iff (hP : ring_hom.respects_iso @P) {R S : Type*}
+  (R' S' : Type*) [comm_ring R] [comm_ring S] [comm_ring R'] [comm_ring S'] [algebra R R']
+  [algebra S S'] (f : R →+* S) (r : R) [is_localization.away r R'] [is_localization.away (f r) S'] :
+  P (localization.away_map f r) ↔ P (is_localization.away.map R' S' f r) :=
+begin
+  let e₁ : R' ≃+* localization.away r :=
+    (is_localization.alg_equiv (submonoid.powers r) _ _).to_ring_equiv,
+  let e₂ : localization.away (f r) ≃+* S' :=
+    (is_localization.alg_equiv (submonoid.powers (f r)) _ _).to_ring_equiv,
+  refine (hP.cancel_left_is_iso e₁.to_CommRing_iso.hom (CommRing.of_hom _)).symm.trans _,
+  refine (hP.cancel_right_is_iso (CommRing.of_hom _) e₂.to_CommRing_iso.hom).symm.trans _,
+  rw ← eq_iff_iff,
+  congr' 1,
+  dsimp [CommRing.of_hom, CommRing.of, bundled.of],
+  refine is_localization.ring_hom_ext (submonoid.powers r) _,
+  ext1,
+  revert e₁ e₂,
+  dsimp [ring_equiv.to_ring_hom, is_localization.away.map],
+  simp only [category_theory.comp_apply, ring_equiv.refl_apply, is_localization.alg_equiv_apply,
+    is_localization.ring_equiv_of_ring_equiv_apply, ring_hom.coe_mk, ring_equiv.to_fun_eq_coe,
+    is_localization.ring_equiv_of_ring_equiv_eq, is_localization.map_eq],
+end
+
+end respects_iso
+
+section stable_under_composition
+
+/-- A property is `stable_under_composition` if the composition of two such morphisms
+still falls in the class. -/
+def stable_under_composition : Prop :=
+  ∀ ⦃R S T⦄ [comm_ring R] [comm_ring S] [comm_ring T],
+    by exactI ∀ (f : R →+* S) (g : S →+* T) (hf : P f) (hg : P g), P (g.comp f)
+
+variable {P}
+
+lemma stable_under_composition.respects_iso (hP : ring_hom.stable_under_composition @P)
+  (hP' : ∀ {R S : Type*} [comm_ring R] [comm_ring S] (e : by exactI R ≃+* S),
+    by exactI P e.to_ring_hom) : ring_hom.respects_iso @P :=
+begin
+  split,
+  { introv H, resetI, apply hP, exacts [H, hP' e] },
+  { introv H, resetI, apply hP, exacts [hP' e, H] }
+end
+
+end stable_under_composition
+
+section stable_under_base_change
+
+/-- A morphism property `P` is `stable_under_base_change` if `P(S →+* A)` implies
+`P(B →+* A ⊗[S] B)`. -/
+def stable_under_base_change : Prop :=
+  ∀ (R S R' S') [comm_ring R] [comm_ring S] [comm_ring R'] [comm_ring S'],
+    by exactI ∀ [algebra R S] [algebra R R'] [algebra R S'] [algebra S S'] [algebra R' S'],
+    by exactI ∀ [is_scalar_tower R S S'] [is_scalar_tower R R' S'],
+    by exactI ∀ [algebra.is_pushout R S R' S'], P (algebra_map R S) → P (algebra_map R' S')
+
+lemma stable_under_base_change.mk
+  (h₁ : respects_iso @P)
+  (h₂ : ∀ ⦃R S T⦄ [comm_ring R] [comm_ring S] [comm_ring T],
+    by exactI ∀ [algebra R S] [algebra R T], by exactI (P (algebra_map R T) →
+      P (algebra.tensor_product.include_left.to_ring_hom : S →+* tensor_product R S T))) :
+  stable_under_base_change @P :=
+begin
+  introv R h H,
+  resetI,
+  let e := h.symm.1.equiv,
+  let f' := algebra.tensor_product.product_map (is_scalar_tower.to_alg_hom R R' S')
+    (is_scalar_tower.to_alg_hom R S S'),
+  have : ∀ x, e x = f' x,
+  { intro x,
+    change e.to_linear_map.restrict_scalars R x = f'.to_linear_map x,
+    congr' 1,
+    apply tensor_product.ext',
+    intros x y,
+    simp [is_base_change.equiv_tmul, algebra.smul_def] },
+  convert h₁.1 _ _ (h₂ H : P (_ : R' →+* _)),
+  swap,
+  { refine { map_mul' := λ x y, _, ..e },
+    change e (x * y) = e x * e y,
+    simp_rw this,
+    exact map_mul f' _ _ },
+  { ext,
+    change _ = e (x ⊗ₜ[R] 1),
+    dsimp only [e],
+    rw [h.symm.1.equiv_tmul, algebra.smul_def, alg_hom.to_linear_map_apply, map_one, mul_one] }
+end
+
+omit P
+
+local attribute [instance] algebra.tensor_product.right_algebra
+
+lemma stable_under_base_change.pushout_inl
+  (hP : ring_hom.stable_under_base_change @P) (hP' : ring_hom.respects_iso @P) {R S T : CommRing}
+  (f : R ⟶ S) (g : R ⟶ T) (H : P g) : P (pushout.inl : S ⟶ pushout f g) :=
+begin
+  rw [← (show _ = pushout.inl, from colimit.iso_colimit_cocone_ι_inv
+    ⟨_, CommRing.pushout_cocone_is_colimit f g⟩ walking_span.left), hP'.cancel_right_is_iso],
+  letI := f.to_algebra,
+  letI := g.to_algebra,
+  dsimp only [CommRing.pushout_cocone_inl, pushout_cocone.ι_app_left],
+  apply hP R T S (tensor_product R S T),
+  exact H,
+end
+
+end stable_under_base_change
+
+end ring_hom
diff --git a/src/ring_theory/ring_invo.lean b/src/ring_theory/ring_invo.lean
index 01324030be5c7..28fc739aec287 100644
--- a/src/ring_theory/ring_invo.lean
+++ b/src/ring_theory/ring_invo.lean
@@ -9,6 +9,9 @@ import algebra.ring.opposite
 /-!
 # Ring involutions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a ring involution as a structure extending `R ≃+* Rᵐᵒᵖ`,
 with the additional fact `f.involution : (f (f x).unop).unop = x`.
 
@@ -27,13 +30,34 @@ Ring involution
 
 variables (R : Type*)
 
+set_option old_structure_cmd true
+
 /-- A ring involution -/
 structure ring_invo [semiring R] extends R ≃+* Rᵐᵒᵖ :=
 (involution' : ∀ x, (to_fun (to_fun x).unop).unop = x)
 
+/-- The equivalence of rings underlying a ring involution. -/
+add_decl_doc ring_invo.to_ring_equiv
+
+/-- `ring_invo_class F R S` states that `F` is a type of ring involutions.
+You should extend this class when you extend `ring_invo`. -/
+class ring_invo_class (F : Type*) (R : out_param Type*) [semiring R]
+  extends ring_equiv_class F R Rᵐᵒᵖ :=
+(involution : ∀ (f : F) (x), (f (f x).unop).unop = x)
+
 namespace ring_invo
 variables {R} [semiring R]
 
+instance (R : Type*) [semiring R] : ring_invo_class (ring_invo R) R :=
+{ coe := to_fun,
+  inv :=  inv_fun,
+  coe_injective' := λ e f h₁ h₂, by { cases e, cases f, congr' },
+  map_add := map_add',
+  map_mul := map_mul',
+  left_inv := left_inv,
+  right_inv := right_inv,
+  involution := involution' }
+
 /-- Construct a ring involution from a ring homomorphism. -/
 def mk' (f : R →+* Rᵐᵒᵖ) (involution : ∀ r, (f (f r).unop).unop = r) :
   ring_invo R :=
@@ -43,6 +67,8 @@ def mk' (f : R →+* Rᵐᵒᵖ) (involution : ∀ r, (f (f r).unop).unop = r) :
   involution' := involution,
   .. f }
 
+/-- Helper instance for when there's too many metavariables to apply
+`fun_like.has_coe_to_fun` directly. -/
 instance : has_coe_to_fun (ring_invo R) (λ _, R → Rᵐᵒᵖ) := ⟨λ f, f.to_ring_equiv.to_fun⟩
 
 @[simp]
diff --git a/src/ring_theory/roots_of_unity.lean b/src/ring_theory/roots_of_unity.lean
deleted file mode 100644
index b1b717c3442d1..0000000000000
--- a/src/ring_theory/roots_of_unity.lean
+++ /dev/null
@@ -1,1157 +0,0 @@
-/-
-Copyright (c) 2020 Johan Commelin. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johan Commelin
--/
-
-import data.polynomial.ring_division
-import tactic.zify
-import field_theory.separable
-import data.zmod.basic
-import ring_theory.integral_domain
-import number_theory.divisors
-import field_theory.finite.basic
-import group_theory.specific_groups.cyclic
-import algebra.char_p.two
-
-/-!
-# Roots of unity and primitive roots of unity
-
-We define roots of unity in the context of an arbitrary commutative monoid,
-as a subgroup of the group of units. We also define a predicate `is_primitive_root` on commutative
-monoids, expressing that an element is a primitive root of unity.
-
-## Main definitions
-
-* `roots_of_unity n M`, for `n : ℕ+` is the subgroup of the units of a commutative monoid `M`
-  consisting of elements `x` that satisfy `x ^ n = 1`.
-* `is_primitive_root ζ k`: an element `ζ` is a primitive `k`-th root of unity if `ζ ^ k = 1`,
-  and if `l` satisfies `ζ ^ l = 1` then `k ∣ l`.
-* `primitive_roots k R`: the finset of primitive `k`-th roots of unity in an integral domain `R`.
-* `is_primitive_root.aut_to_pow`: the monoid hom that takes an automorphism of a ring to the power
-  it sends that specific primitive root, as a member of `(zmod n)ˣ`.
-
-## Main results
-
-* `roots_of_unity.is_cyclic`: the roots of unity in an integral domain form a cyclic group.
-* `is_primitive_root.zmod_equiv_zpowers`: `zmod k` is equivalent to
-  the subgroup generated by a primitive `k`-th root of unity.
-* `is_primitive_root.zpowers_eq`: in an integral domain, the subgroup generated by
-  a primitive `k`-th root of unity is equal to the `k`-th roots of unity.
-* `is_primitive_root.card_primitive_roots`: if an integral domain
-   has a primitive `k`-th root of unity, then it has `φ k` of them.
-
-## Implementation details
-
-It is desirable that `roots_of_unity` is a subgroup,
-and it will mainly be applied to rings (e.g. the ring of integers in a number field) and fields.
-We therefore implement it as a subgroup of the units of a commutative monoid.
-
-We have chosen to define `roots_of_unity n` for `n : ℕ+`, instead of `n : ℕ`,
-because almost all lemmas need the positivity assumption,
-and in particular the type class instances for `fintype` and `is_cyclic`.
-
-On the other hand, for primitive roots of unity, it is desirable to have a predicate
-not just on units, but directly on elements of the ring/field.
-For example, we want to say that `exp (2 * pi * I / n)` is a primitive `n`-th root of unity
-in the complex numbers, without having to turn that number into a unit first.
-
-This creates a little bit of friction, but lemmas like `is_primitive_root.is_unit` and
-`is_primitive_root.coe_units_iff` should provide the necessary glue.
-
--/
-
-open_locale classical big_operators polynomial
-noncomputable theory
-
-open polynomial
-open finset
-
-variables {M N G G₀ R S F : Type*}
-variables [comm_monoid M] [comm_monoid N] [comm_group G] [comm_group_with_zero G₀]
-
-section roots_of_unity
-
-variables {k l : ℕ+}
-
-/-- `roots_of_unity k M` is the subgroup of elements `m : Mˣ` that satisfy `m ^ k = 1` -/
-def roots_of_unity (k : ℕ+) (M : Type*) [comm_monoid M] : subgroup Mˣ :=
-{ carrier := { ζ | ζ ^ (k : ℕ) = 1 },
-  one_mem' := one_pow _,
-  mul_mem' := λ ζ ξ hζ hξ, by simp only [*, set.mem_set_of_eq, mul_pow, one_mul] at *,
-  inv_mem' := λ ζ hζ, by simp only [*, set.mem_set_of_eq, inv_pow, one_inv] at * }
-
-@[simp] lemma mem_roots_of_unity (k : ℕ+) (ζ : Mˣ) :
-  ζ ∈ roots_of_unity k M ↔ ζ ^ (k : ℕ) = 1 := iff.rfl
-
-lemma roots_of_unity.coe_injective {n : ℕ+} : function.injective (coe : (roots_of_unity n M) → M) :=
-units.ext.comp (λ x y, subtype.ext)
-
-/-- Make an element of `roots_of_unity` from a member of the base ring, and a proof that it has
-a positive power equal to one. -/
-@[simps coe_coe] def roots_of_unity.mk_of_pow_eq (ζ : M) {n : ℕ+} (h : ζ ^ (n : ℕ) = 1) :
-  roots_of_unity n M :=
-⟨units.mk_of_mul_eq_one ζ (ζ ^ n.nat_pred) $
-  by rwa [←pow_one ζ, ←pow_mul, ←pow_add, one_mul, pnat.one_add_nat_pred],
-units.ext $ by simpa⟩
-
-@[simp] lemma roots_of_unity.coe_mk_of_pow_eq {ζ : M} {n : ℕ+}
-  (h : ζ ^ (n : ℕ) = 1) : (roots_of_unity.mk_of_pow_eq _ h : M) = ζ := rfl
-
-lemma roots_of_unity_le_of_dvd (h : k ∣ l) : roots_of_unity k M ≤ roots_of_unity l M :=
-begin
-  obtain ⟨d, rfl⟩ := h,
-  intros ζ h,
-  simp only [mem_roots_of_unity, pnat.mul_coe, pow_mul, one_pow, *] at *,
-end
-
-lemma map_roots_of_unity (f : Mˣ →* Nˣ) (k : ℕ+) :
-  (roots_of_unity k M).map f ≤ roots_of_unity k N :=
-begin
-  rintros _ ⟨ζ, h, rfl⟩,
-  simp only [←map_pow, *, mem_roots_of_unity, set_like.mem_coe, monoid_hom.map_one] at *
-end
-
-@[norm_cast] lemma roots_of_unity.coe_pow [comm_monoid R] (ζ : roots_of_unity k R) (m : ℕ) :
-  ↑(ζ ^ m) = (ζ ^ m : R) :=
-begin
-  change ↑(↑(ζ ^ m) : Rˣ) = ↑(ζ : Rˣ) ^ m,
-  rw [subgroup.coe_pow, units.coe_pow],
-end
-
-section comm_semiring
-
-variables [comm_semiring R] [comm_semiring S]
-
-/-- Restrict a ring homomorphism to the nth roots of unity -/
-def restrict_roots_of_unity [ring_hom_class F R S] (σ : F) (n : ℕ+) :
-  roots_of_unity n R →* roots_of_unity n S :=
-let h : ∀ ξ : roots_of_unity n R, (σ ξ) ^ (n : ℕ) = 1 := λ ξ, by
-{ change (σ (ξ : Rˣ)) ^ (n : ℕ) = 1,
-  rw [←map_pow, ←units.coe_pow, show ((ξ : Rˣ) ^ (n : ℕ) = 1), from ξ.2,
-      units.coe_one, map_one σ] } in
-{ to_fun := λ ξ, ⟨@unit_of_invertible _ _ _ (invertible_of_pow_eq_one _ _ (h ξ) n.2),
-    by { ext, rw units.coe_pow, exact h ξ }⟩,
-  map_one' := by { ext, exact map_one σ },
-  map_mul' := λ ξ₁ ξ₂, by { ext, rw [subgroup.coe_mul, units.coe_mul], exact map_mul σ _ _ } }
-
-@[simp] lemma restrict_roots_of_unity_coe_apply [ring_hom_class F R S] (σ : F)
-  (ζ : roots_of_unity k R) : ↑(restrict_roots_of_unity σ k ζ) = σ ↑ζ :=
-rfl
-
-/-- Restrict a ring isomorphism to the nth roots of unity -/
-def ring_equiv.restrict_roots_of_unity (σ : R ≃+* S) (n : ℕ+) :
-  roots_of_unity n R ≃* roots_of_unity n S :=
-{ to_fun := restrict_roots_of_unity σ.to_ring_hom n,
-  inv_fun :=restrict_roots_of_unity σ.symm.to_ring_hom n,
-  left_inv := λ ξ, by { ext, exact σ.symm_apply_apply ξ },
-  right_inv := λ ξ, by { ext, exact σ.apply_symm_apply ξ },
-  map_mul' := (restrict_roots_of_unity _ n).map_mul }
-
-@[simp] lemma ring_equiv.restrict_roots_of_unity_coe_apply (σ : R ≃+* S) (ζ : roots_of_unity k R) :
-  ↑(σ.restrict_roots_of_unity k ζ) = σ ↑ζ :=
-rfl
-
-@[simp] lemma ring_equiv.restrict_roots_of_unity_symm (σ : R ≃+* S) :
-  (σ.restrict_roots_of_unity k).symm = σ.symm.restrict_roots_of_unity k :=
-rfl
-
-end comm_semiring
-
-section is_domain
-
-variables [comm_ring R] [is_domain R]
-
-lemma mem_roots_of_unity_iff_mem_nth_roots {ζ : Rˣ} :
-  ζ ∈ roots_of_unity k R ↔ (ζ : R) ∈ nth_roots k (1 : R) :=
-by simp only [mem_roots_of_unity, mem_nth_roots k.pos, units.ext_iff, units.coe_one, units.coe_pow]
-
-variables (k R)
-
-/-- Equivalence between the `k`-th roots of unity in `R` and the `k`-th roots of `1`.
-
-This is implemented as equivalence of subtypes,
-because `roots_of_unity` is a subgroup of the group of units,
-whereas `nth_roots` is a multiset. -/
-def roots_of_unity_equiv_nth_roots :
-  roots_of_unity k R ≃ {x // x ∈ nth_roots k (1 : R)} :=
-begin
-  refine
-  { to_fun := λ x, ⟨x, mem_roots_of_unity_iff_mem_nth_roots.mp x.2⟩,
-    inv_fun := λ x, ⟨⟨x, x ^ (k - 1 : ℕ), _, _⟩, _⟩,
-    left_inv := _,
-    right_inv := _ },
-  swap 4, { rintro ⟨x, hx⟩, ext, refl },
-  swap 4, { rintro ⟨x, hx⟩, ext, refl },
-  all_goals
-  { rcases x with ⟨x, hx⟩, rw [mem_nth_roots k.pos] at hx,
-    simp only [subtype.coe_mk, ← pow_succ, ← pow_succ', hx,
-      tsub_add_cancel_of_le (show 1 ≤ (k : ℕ), from k.one_le)] },
-  { show (_ : Rˣ) ^ (k : ℕ) = 1,
-    simp only [units.ext_iff, hx, units.coe_mk, units.coe_one, subtype.coe_mk, units.coe_pow] }
-end
-
-variables {k R}
-
-@[simp] lemma roots_of_unity_equiv_nth_roots_apply (x : roots_of_unity k R) :
-  (roots_of_unity_equiv_nth_roots R k x : R) = x :=
-rfl
-
-@[simp] lemma roots_of_unity_equiv_nth_roots_symm_apply (x : {x // x ∈ nth_roots k (1 : R)}) :
-  ((roots_of_unity_equiv_nth_roots R k).symm x : R) = x :=
-rfl
-
-variables (k R)
-
-instance roots_of_unity.fintype : fintype (roots_of_unity k R) :=
-fintype.of_equiv {x // x ∈ nth_roots k (1 : R)} $ (roots_of_unity_equiv_nth_roots R k).symm
-
-instance roots_of_unity.is_cyclic : is_cyclic (roots_of_unity k R) :=
-is_cyclic_of_subgroup_is_domain ((units.coe_hom R).comp (roots_of_unity k R).subtype)
-  (units.ext.comp subtype.val_injective)
-
-lemma card_roots_of_unity : fintype.card (roots_of_unity k R) ≤ k :=
-calc  fintype.card (roots_of_unity k R)
-    = fintype.card {x // x ∈ nth_roots k (1 : R)} :
-          fintype.card_congr (roots_of_unity_equiv_nth_roots R k)
-... ≤ (nth_roots k (1 : R)).attach.card           : multiset.card_le_of_le (multiset.dedup_le _)
-... = (nth_roots k (1 : R)).card                  : multiset.card_attach
-... ≤ k                                           : card_nth_roots k 1
-
-variables {k R}
-
-lemma map_root_of_unity_eq_pow_self [ring_hom_class F R R] (σ : F) (ζ : roots_of_unity k R) :
-  ∃ m : ℕ, σ ζ = ζ ^ m :=
-begin
-  obtain ⟨m, hm⟩ := monoid_hom.map_cyclic (restrict_roots_of_unity σ k),
-  rw [←restrict_roots_of_unity_coe_apply, hm, zpow_eq_mod_order_of, ←int.to_nat_of_nonneg
-      (m.mod_nonneg (int.coe_nat_ne_zero.mpr (pos_iff_ne_zero.mp (order_of_pos ζ)))),
-      zpow_coe_nat, roots_of_unity.coe_pow],
-  exact ⟨(m % (order_of ζ)).to_nat, rfl⟩,
-end
-
-end is_domain
-
-end roots_of_unity
-
-/-- An element `ζ` is a primitive `k`-th root of unity if `ζ ^ k = 1`,
-and if `l` satisfies `ζ ^ l = 1` then `k ∣ l`. -/
-structure is_primitive_root (ζ : M) (k : ℕ) : Prop :=
-(pow_eq_one : ζ ^ (k : ℕ) = 1)
-(dvd_of_pow_eq_one : ∀ l : ℕ, ζ ^ l = 1 → k ∣ l)
-
-/-- Turn a primitive root μ into a member of the `roots_of_unity` subgroup. -/
-@[simps] def is_primitive_root.to_roots_of_unity {μ : M} {n : ℕ+} (h : is_primitive_root μ n) :
-  roots_of_unity n M := roots_of_unity.mk_of_pow_eq μ h.pow_eq_one
-
-section primitive_roots
-variables {k : ℕ}
-
-/-- `primitive_roots k R` is the finset of primitive `k`-th roots of unity
-in the integral domain `R`. -/
-def primitive_roots (k : ℕ) (R : Type*) [comm_ring R] [is_domain R] : finset R :=
-(nth_roots k (1 : R)).to_finset.filter (λ ζ, is_primitive_root ζ k)
-
-variables [comm_ring R] [is_domain R]
-
-@[simp] lemma mem_primitive_roots {ζ : R} (h0 : 0 < k) :
-  ζ ∈ primitive_roots k R ↔ is_primitive_root ζ k :=
-begin
-  rw [primitive_roots, mem_filter, multiset.mem_to_finset, mem_nth_roots h0, and_iff_right_iff_imp],
-  exact is_primitive_root.pow_eq_one
-end
-
-end primitive_roots
-
-namespace is_primitive_root
-
-variables {k l : ℕ}
-
-lemma iff_def (ζ : M) (k : ℕ) :
-  is_primitive_root ζ k ↔ (ζ ^ k = 1) ∧ (∀ l : ℕ, ζ ^ l = 1 → k ∣ l) :=
-⟨λ ⟨h1, h2⟩, ⟨h1, h2⟩, λ ⟨h1, h2⟩, ⟨h1, h2⟩⟩
-
-lemma mk_of_lt (ζ : M) (hk : 0 < k) (h1 : ζ ^ k = 1) (h : ∀ l : ℕ, 0 < l →  l < k → ζ ^ l ≠ 1) :
-  is_primitive_root ζ k :=
-begin
-  refine ⟨h1, _⟩,
-  intros l hl,
-  apply dvd_trans _ (k.gcd_dvd_right l),
-  suffices : k.gcd l = k, { rw this },
-  rw eq_iff_le_not_lt,
-  refine ⟨nat.le_of_dvd hk (k.gcd_dvd_left l), _⟩,
-  intro h', apply h _ (nat.gcd_pos_of_pos_left _ hk) h',
-  exact pow_gcd_eq_one _ h1 hl
-end
-
-section comm_monoid
-
-variables {ζ : M} (h : is_primitive_root ζ k)
-
-@[nontriviality] lemma of_subsingleton [subsingleton M] (x : M) : is_primitive_root x 1 :=
-⟨subsingleton.elim _ _, λ _ _, one_dvd _⟩
-
-lemma pow_eq_one_iff_dvd (l : ℕ) : ζ ^ l = 1 ↔ k ∣ l :=
-⟨h.dvd_of_pow_eq_one l,
-by { rintro ⟨i, rfl⟩, simp only [pow_mul, h.pow_eq_one, one_pow, pnat.mul_coe] }⟩
-
-lemma is_unit (h : is_primitive_root ζ k) (h0 : 0 < k) : is_unit ζ :=
-begin
-  apply is_unit_of_mul_eq_one ζ (ζ ^ (k - 1)),
-  rw [← pow_succ, tsub_add_cancel_of_le h0.nat_succ_le, h.pow_eq_one]
-end
-
-lemma pow_ne_one_of_pos_of_lt (h0 : 0 < l) (hl : l < k) : ζ ^ l ≠ 1 :=
-mt (nat.le_of_dvd h0 ∘ h.dvd_of_pow_eq_one _) $ not_le_of_lt hl
-
-lemma pow_inj (h : is_primitive_root ζ k) ⦃i j : ℕ⦄ (hi : i < k) (hj : j < k) (H : ζ ^ i = ζ ^ j) :
-  i = j :=
-begin
-  wlog hij : i ≤ j,
-  apply le_antisymm hij,
-  rw ← tsub_eq_zero_iff_le,
-  apply nat.eq_zero_of_dvd_of_lt _ (lt_of_le_of_lt tsub_le_self hj),
-  apply h.dvd_of_pow_eq_one,
-  rw [← ((h.is_unit (lt_of_le_of_lt (nat.zero_le _) hi)).pow i).mul_left_inj,
-      ← pow_add, tsub_add_cancel_of_le hij, H, one_mul]
-end
-
-lemma one : is_primitive_root (1 : M) 1 :=
-{ pow_eq_one := pow_one _,
-  dvd_of_pow_eq_one := λ l hl, one_dvd _ }
-
-@[simp] lemma one_right_iff : is_primitive_root ζ 1 ↔ ζ = 1 :=
-begin
-  split,
-  { intro h, rw [← pow_one ζ, h.pow_eq_one] },
-  { rintro rfl, exact one }
-end
-
-@[simp] lemma coe_submonoid_class_iff {M B : Type*} [comm_monoid M] [set_like B M]
-  [submonoid_class B M] {N : B} {ζ : N} : is_primitive_root (ζ : M) k ↔ is_primitive_root ζ k :=
-by simp [iff_def, ← submonoid_class.coe_pow]
-
-@[simp] lemma coe_units_iff {ζ : Mˣ} :
-  is_primitive_root (ζ : M) k ↔ is_primitive_root ζ k :=
-by simp only [iff_def, units.ext_iff, units.coe_pow, units.coe_one]
-
-lemma pow_of_coprime (h : is_primitive_root ζ k) (i : ℕ) (hi : i.coprime k) :
-  is_primitive_root (ζ ^ i) k :=
-begin
-  by_cases h0 : k = 0,
-  { subst k, simp only [*, pow_one, nat.coprime_zero_right] at * },
-  rcases h.is_unit (nat.pos_of_ne_zero h0) with ⟨ζ, rfl⟩,
-  rw [← units.coe_pow],
-  rw coe_units_iff at h ⊢,
-  refine
-  { pow_eq_one := by rw [← pow_mul', pow_mul, h.pow_eq_one, one_pow],
-    dvd_of_pow_eq_one := _ },
-  intros l hl,
-  apply h.dvd_of_pow_eq_one,
-  rw [← pow_one ζ, ← zpow_coe_nat ζ, ← hi.gcd_eq_one, nat.gcd_eq_gcd_ab, zpow_add,
-      mul_pow, ← zpow_coe_nat, ← zpow_mul, mul_right_comm],
-  simp only [zpow_mul, hl, h.pow_eq_one, one_zpow, one_pow, one_mul, zpow_coe_nat]
-end
-
-lemma pow_of_prime (h : is_primitive_root ζ k) {p : ℕ} (hprime : nat.prime p) (hdiv : ¬ p ∣ k) :
-  is_primitive_root (ζ ^ p) k :=
-h.pow_of_coprime p (hprime.coprime_iff_not_dvd.2 hdiv)
-
-lemma pow_iff_coprime (h : is_primitive_root ζ k) (h0 : 0 < k) (i : ℕ) :
-  is_primitive_root (ζ ^ i) k ↔ i.coprime k :=
-begin
-  refine ⟨_, h.pow_of_coprime i⟩,
-  intro hi,
-  obtain ⟨a, ha⟩ := i.gcd_dvd_left k,
-  obtain ⟨b, hb⟩ := i.gcd_dvd_right k,
-  suffices : b = k,
-  { rwa [this, ← one_mul k, nat.mul_left_inj h0, eq_comm] at hb { occs := occurrences.pos [1] } },
-  rw [ha] at hi,
-  rw [mul_comm] at hb,
-  apply nat.dvd_antisymm ⟨i.gcd k, hb⟩ (hi.dvd_of_pow_eq_one b _),
-  rw [← pow_mul', ← mul_assoc, ← hb, pow_mul, h.pow_eq_one, one_pow]
-end
-
-protected lemma order_of (ζ : M) : is_primitive_root ζ (order_of ζ) :=
-⟨pow_order_of_eq_one ζ, λ l, order_of_dvd_of_pow_eq_one⟩
-
-lemma unique {ζ : M} (hk : is_primitive_root ζ k) (hl : is_primitive_root ζ l) : k = l :=
-begin
-  wlog hkl : k ≤ l,
-  rcases hkl.eq_or_lt with rfl | hkl,
-  { refl },
-  rcases k.eq_zero_or_pos with rfl | hk',
-  { exact (zero_dvd_iff.mp $ hk.dvd_of_pow_eq_one l hl.pow_eq_one).symm },
-  exact absurd hk.pow_eq_one (hl.pow_ne_one_of_pos_of_lt hk' hkl)
-end
-
-lemma eq_order_of : k = order_of ζ := h.unique (is_primitive_root.order_of ζ)
-
-protected lemma iff (hk : 0 < k) :
-  is_primitive_root ζ k ↔ ζ ^ k = 1 ∧ ∀ l : ℕ, 0 < l → l < k → ζ ^ l ≠ 1 :=
-begin
-  refine ⟨λ h, ⟨h.pow_eq_one, λ l hl' hl, _⟩, λ ⟨hζ, hl⟩, is_primitive_root.mk_of_lt ζ hk hζ hl⟩,
-  rw h.eq_order_of at hl,
-  exact pow_ne_one_of_lt_order_of' hl'.ne' hl,
-end
-
-protected lemma not_iff : ¬ is_primitive_root ζ k ↔ order_of ζ ≠ k :=
-⟨λ h hk, h $ hk ▸ is_primitive_root.order_of ζ,
- λ h hk, h.symm $ hk.unique $ is_primitive_root.order_of ζ⟩
-
-lemma pow_of_dvd (h : is_primitive_root ζ k) {p : ℕ} (hp : p ≠ 0) (hdiv : p ∣ k) :
-  is_primitive_root (ζ ^ p) (k / p) :=
-begin
-  suffices : order_of (ζ ^ p) = k / p,
-  { exact this ▸ is_primitive_root.order_of (ζ ^ p) },
-  rw [order_of_pow' _ hp, ← eq_order_of h, nat.gcd_eq_right hdiv]
-end
-
-protected
-lemma mem_roots_of_unity {ζ : Mˣ} {n : ℕ+} (h : is_primitive_root ζ n) : ζ ∈ roots_of_unity n M :=
-h.pow_eq_one
-
-/-- If there is a `n`-th primitive root of unity in `R` and `b` divides `n`,
-then there is a `b`-th primitive root of unity in `R`. -/
-lemma pow {n : ℕ} {a b : ℕ} (hn : 0 < n) (h : is_primitive_root ζ n) (hprod : n = a * b) :
-  is_primitive_root (ζ ^ a) b :=
-begin
-  subst n,
-  simp only [iff_def, ← pow_mul, h.pow_eq_one, eq_self_iff_true, true_and],
-  intros l hl,
-  have ha0 : a ≠ 0, { rintro rfl, simpa only [nat.not_lt_zero, zero_mul] using hn },
-  rwa ← mul_dvd_mul_iff_left ha0,
-  exact h.dvd_of_pow_eq_one _ hl
-end
-
-end comm_monoid
-
-section comm_monoid_with_zero
-
-variables {M₀ : Type*} [comm_monoid_with_zero M₀]
-
-lemma zero [nontrivial M₀] : is_primitive_root (0 : M₀) 0 :=
-⟨pow_zero 0, λ l hl, by simpa [zero_pow_eq, show ∀ p, ¬p → false ↔ p, from @not_not] using hl⟩
-
-protected lemma ne_zero [nontrivial M₀] {ζ : M₀} (h : is_primitive_root ζ k) : k ≠ 0 → ζ ≠ 0 :=
-mt $ λ hn, h.unique (hn.symm ▸ is_primitive_root.zero)
-
-end comm_monoid_with_zero
-
-section comm_group
-
-variables {ζ : G}
-
-lemma zpow_eq_one (h : is_primitive_root ζ k) : ζ ^ (k : ℤ) = 1 :=
-by { rw zpow_coe_nat, exact h.pow_eq_one }
-
-lemma zpow_eq_one_iff_dvd (h : is_primitive_root ζ k) (l : ℤ) :
-  ζ ^ l = 1 ↔ (k : ℤ) ∣ l :=
-begin
-  by_cases h0 : 0 ≤ l,
-  { lift l to ℕ using h0, rw [zpow_coe_nat], norm_cast, exact h.pow_eq_one_iff_dvd l },
-  { have : 0 ≤ -l, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
-    lift -l to ℕ using this with l' hl',
-    rw [← dvd_neg, ← hl'],
-    norm_cast,
-    rw [← h.pow_eq_one_iff_dvd, ← inv_inj, ← zpow_neg, ← hl', zpow_coe_nat, one_inv] }
-end
-
-lemma inv (h : is_primitive_root ζ k) : is_primitive_root ζ⁻¹ k :=
-{ pow_eq_one := by simp only [h.pow_eq_one, one_inv, eq_self_iff_true, inv_pow],
-  dvd_of_pow_eq_one :=
-  begin
-    intros l hl,
-    apply h.dvd_of_pow_eq_one l,
-    rw [← inv_inj, ← inv_pow, hl, one_inv]
-  end }
-
-@[simp] lemma inv_iff : is_primitive_root ζ⁻¹ k ↔ is_primitive_root ζ k :=
-by { refine ⟨_, λ h, inv h⟩, intro h, rw [← inv_inv ζ], exact inv h }
-
-lemma zpow_of_gcd_eq_one (h : is_primitive_root ζ k) (i : ℤ) (hi : i.gcd k = 1) :
-  is_primitive_root (ζ ^ i) k :=
-begin
-  by_cases h0 : 0 ≤ i,
-  { lift i to ℕ using h0,
-    rw zpow_coe_nat,
-    exact h.pow_of_coprime i hi },
-  have : 0 ≤ -i, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
-  lift -i to ℕ using this with i' hi',
-  rw [← inv_iff, ← zpow_neg, ← hi', zpow_coe_nat],
-  apply h.pow_of_coprime,
-  rw [int.gcd, ← int.nat_abs_neg, ← hi'] at hi,
-  exact hi
-end
-
-end comm_group
-
-section comm_group_with_zero
-
-variables {ζ : G₀}
-
-lemma zpow_eq_one₀ (h : is_primitive_root ζ k) : ζ ^ (k : ℤ) = 1 :=
-by { rw zpow_coe_nat, exact h.pow_eq_one }
-
-lemma zpow_eq_one_iff_dvd₀ (h : is_primitive_root ζ k) (l : ℤ) :
-  ζ ^ l = 1 ↔ (k : ℤ) ∣ l :=
-begin
-  by_cases h0 : 0 ≤ l,
-  { lift l to ℕ using h0, rw [zpow_coe_nat], norm_cast, exact h.pow_eq_one_iff_dvd l },
-  { have : 0 ≤ -l, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
-    lift -l to ℕ using this with l' hl',
-    rw [← dvd_neg, ← hl'],
-    norm_cast,
-    rw [← h.pow_eq_one_iff_dvd, ← inv_inj, ← zpow_neg₀, ← hl', zpow_coe_nat, inv_one] }
-end
-
-lemma inv' (h : is_primitive_root ζ k) : is_primitive_root ζ⁻¹ k :=
-{ pow_eq_one := by simp only [h.pow_eq_one, inv_one, eq_self_iff_true, inv_pow₀],
-  dvd_of_pow_eq_one :=
-  begin
-    intros l hl,
-    apply h.dvd_of_pow_eq_one l,
-    rw [← inv_inj, ← inv_pow₀, hl, inv_one]
-  end }
-
-@[simp] lemma inv_iff' : is_primitive_root ζ⁻¹ k ↔ is_primitive_root ζ k :=
-by { refine ⟨_, λ h, inv' h⟩, intro h, rw [← inv_inv ζ], exact inv' h }
-
-lemma zpow_of_gcd_eq_one₀ (h : is_primitive_root ζ k) (i : ℤ) (hi : i.gcd k = 1) :
-  is_primitive_root (ζ ^ i) k :=
-begin
-  by_cases h0 : 0 ≤ i,
-  { lift i to ℕ using h0,
-    rw zpow_coe_nat,
-    exact h.pow_of_coprime i hi },
-  have : 0 ≤ -i, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
-  lift -i to ℕ using this with i' hi',
-  rw [← inv_iff', ← zpow_neg₀, ← hi', zpow_coe_nat],
-  apply h.pow_of_coprime,
-  rw [int.gcd, ← int.nat_abs_neg, ← hi'] at hi,
-  exact hi
-end
-
-end comm_group_with_zero
-
-section comm_semiring
-
-variables [comm_semiring R] [comm_semiring S] {f : F} {ζ : R}
-
-open function
-
-lemma map_of_injective [monoid_hom_class F R S] (h : is_primitive_root ζ k) (hf : injective f) :
-  is_primitive_root (f ζ) k :=
-{ pow_eq_one := by rw [←map_pow, h.pow_eq_one, _root_.map_one],
-  dvd_of_pow_eq_one := begin
-    rw h.eq_order_of,
-    intros l hl,
-    rw [←map_pow, ←map_one f] at hl,
-    exact order_of_dvd_of_pow_eq_one (hf hl)
-  end }
-
-lemma of_map_of_injective [monoid_hom_class F R S] (h : is_primitive_root (f ζ) k)
-  (hf : injective f) : is_primitive_root ζ k :=
-{ pow_eq_one := by { apply_fun f, rw [map_pow, _root_.map_one, h.pow_eq_one] },
-  dvd_of_pow_eq_one := begin
-    rw h.eq_order_of,
-    intros l hl,
-    apply_fun f at hl,
-    rw [map_pow, _root_.map_one] at hl,
-    exact order_of_dvd_of_pow_eq_one hl
-  end }
-
-lemma map_iff_of_injective [monoid_hom_class F R S] (hf : injective f) :
-  is_primitive_root (f ζ) k ↔ is_primitive_root ζ k :=
-⟨λ h, h.of_map_of_injective hf, λ h, h.map_of_injective hf⟩
-
-end comm_semiring
-
-section is_domain
-
-variables {ζ : R}
-variables [comm_ring R] [is_domain R]
-
-@[simp] lemma primitive_roots_zero : primitive_roots 0 R = ∅ :=
-begin
-  rw [← finset.val_eq_zero, ← multiset.subset_zero, ← nth_roots_zero (1 : R), primitive_roots],
-    simp only [finset.not_mem_empty, forall_const, forall_prop_of_false, multiset.to_finset_zero,
-    finset.filter_true_of_mem, finset.empty_val, not_false_iff,
-    multiset.zero_subset, nth_roots_zero]
-end
-
-@[simp] lemma primitive_roots_one : primitive_roots 1 R = {(1 : R)} :=
-begin
-  apply finset.eq_singleton_iff_unique_mem.2,
-  split,
-  { simp only [is_primitive_root.one_right_iff, mem_primitive_roots zero_lt_one] },
-  { intros x hx,
-    rw [mem_primitive_roots zero_lt_one, is_primitive_root.one_right_iff] at hx,
-    exact hx }
-end
-
-end is_domain
-
-section is_domain
-
-variables [comm_ring R]
-variables {ζ : Rˣ} (h : is_primitive_root ζ k)
-
-lemma eq_neg_one_of_two_right [no_zero_divisors R] {ζ : R} (h : is_primitive_root ζ 2) : ζ = -1 :=
-begin
-  apply (eq_or_eq_neg_of_sq_eq_sq ζ 1 _).resolve_left,
-  { rw [← pow_one ζ], apply h.pow_ne_one_of_pos_of_lt; dec_trivial },
-  { simp only [h.pow_eq_one, one_pow] }
-end
-
-lemma neg_one (p : ℕ) [nontrivial R] [h : char_p R p] (hp : p ≠ 2) : is_primitive_root (-1 : R) 2 :=
-begin
-  convert is_primitive_root.order_of (-1 : R),
-  rw [order_of_neg_one, if_neg],
-  rwa ring_char.eq_iff.mpr h
-end
-
-/-- The (additive) monoid equivalence between `zmod k`
-and the powers of a primitive root of unity `ζ`. -/
-def zmod_equiv_zpowers (h : is_primitive_root ζ k) : zmod k ≃+ additive (subgroup.zpowers ζ) :=
-add_equiv.of_bijective
-  (add_monoid_hom.lift_of_right_inverse (int.cast_add_hom $ zmod k) _ zmod.int_cast_right_inverse
-    ⟨{ to_fun := λ i, additive.of_mul (⟨_, i, rfl⟩ : subgroup.zpowers ζ),
-      map_zero' := by { simp only [zpow_zero], refl },
-      map_add' := by { intros i j, simp only [zpow_add], refl } },
-    (λ i hi,
-    begin
-      simp only [add_monoid_hom.mem_ker, char_p.int_cast_eq_zero_iff (zmod k) k,
-        add_monoid_hom.coe_mk, int.coe_cast_add_hom] at hi ⊢,
-      obtain ⟨i, rfl⟩ := hi,
-      simp only [zpow_mul, h.pow_eq_one, one_zpow, zpow_coe_nat],
-      refl
-    end)⟩)
-  begin
-    split,
-    { rw injective_iff_map_eq_zero,
-      intros i hi,
-      rw subtype.ext_iff at hi,
-      have := (h.zpow_eq_one_iff_dvd _).mp hi,
-      rw [← (char_p.int_cast_eq_zero_iff (zmod k) k _).mpr this, eq_comm],
-      exact zmod.int_cast_right_inverse i },
-    { rintro ⟨ξ, i, rfl⟩,
-      refine ⟨int.cast_add_hom _ i, _⟩,
-      rw [add_monoid_hom.lift_of_right_inverse_comp_apply],
-      refl }
-  end
-
-@[simp] lemma zmod_equiv_zpowers_apply_coe_int (i : ℤ) :
-  h.zmod_equiv_zpowers i = additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ) :=
-add_monoid_hom.lift_of_right_inverse_comp_apply _ _ zmod.int_cast_right_inverse _ _
-
-@[simp] lemma zmod_equiv_zpowers_apply_coe_nat (i : ℕ) :
-  h.zmod_equiv_zpowers i = additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ) :=
-begin
-  have : (i : zmod k) = (i : ℤ), by norm_cast,
-  simp only [this, zmod_equiv_zpowers_apply_coe_int, zpow_coe_nat],
-  refl
-end
-
-@[simp] lemma zmod_equiv_zpowers_symm_apply_zpow (i : ℤ) :
-  h.zmod_equiv_zpowers.symm (additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ)) = i :=
-by rw [← h.zmod_equiv_zpowers.symm_apply_apply i, zmod_equiv_zpowers_apply_coe_int]
-
-@[simp] lemma zmod_equiv_zpowers_symm_apply_zpow' (i : ℤ) :
-  h.zmod_equiv_zpowers.symm ⟨ζ ^ i, i, rfl⟩ = i :=
-h.zmod_equiv_zpowers_symm_apply_zpow i
-
-@[simp] lemma zmod_equiv_zpowers_symm_apply_pow (i : ℕ) :
-  h.zmod_equiv_zpowers.symm (additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ)) = i :=
-by rw [← h.zmod_equiv_zpowers.symm_apply_apply i, zmod_equiv_zpowers_apply_coe_nat]
-
-@[simp] lemma zmod_equiv_zpowers_symm_apply_pow' (i : ℕ) :
-  h.zmod_equiv_zpowers.symm ⟨ζ ^ i, i, rfl⟩ = i :=
-h.zmod_equiv_zpowers_symm_apply_pow i
-
-variables [is_domain R]
-
-lemma zpowers_eq {k : ℕ+} {ζ : Rˣ} (h : is_primitive_root ζ k) :
-  subgroup.zpowers ζ = roots_of_unity k R :=
-begin
-  apply set_like.coe_injective,
-  haveI : fact (0 < (k : ℕ)) := ⟨k.pos⟩,
-  haveI F : fintype (subgroup.zpowers ζ) := fintype.of_equiv _ (h.zmod_equiv_zpowers).to_equiv,
-  refine @set.eq_of_subset_of_card_le Rˣ (subgroup.zpowers ζ) (roots_of_unity k R)
-    F (roots_of_unity.fintype R k)
-    (subgroup.zpowers_subset $ show ζ ∈ roots_of_unity k R, from h.pow_eq_one) _,
-  calc fintype.card (roots_of_unity k R)
-      ≤ k                                 : card_roots_of_unity R k
-  ... = fintype.card (zmod k)             : (zmod.card k).symm
-  ... = fintype.card (subgroup.zpowers ζ) : fintype.card_congr (h.zmod_equiv_zpowers).to_equiv
-end
-
-lemma eq_pow_of_mem_roots_of_unity {k : ℕ+} {ζ ξ : Rˣ}
-  (h : is_primitive_root ζ k) (hξ : ξ ∈ roots_of_unity k R) :
-  ∃ (i : ℕ) (hi : i < k), ζ ^ i = ξ :=
-begin
-  obtain ⟨n, rfl⟩ : ∃ n : ℤ, ζ ^ n = ξ, by rwa [← h.zpowers_eq] at hξ,
-  have hk0 : (0 : ℤ) < k := by exact_mod_cast k.pos,
-  let i := n % k,
-  have hi0 : 0 ≤ i := int.mod_nonneg _ (ne_of_gt hk0),
-  lift i to ℕ using hi0 with i₀ hi₀,
-  refine ⟨i₀, _, _⟩,
-  { zify, rw [hi₀], exact int.mod_lt_of_pos _ hk0 },
-  { have aux := h.zpow_eq_one, rw [← coe_coe] at aux,
-    rw [← zpow_coe_nat, hi₀, ← int.mod_add_div n k, zpow_add, zpow_mul,
-        aux, one_zpow, mul_one] }
-end
-
-lemma eq_pow_of_pow_eq_one {k : ℕ} {ζ ξ : R}
-  (h : is_primitive_root ζ k) (hξ : ξ ^ k = 1) (h0 : 0 < k) :
-  ∃ i < k, ζ ^ i = ξ :=
-begin
-  obtain ⟨ζ, rfl⟩ := h.is_unit h0,
-  obtain ⟨ξ, rfl⟩ := is_unit_of_pow_eq_one ξ k hξ h0,
-  obtain ⟨k, rfl⟩ : ∃ k' : ℕ+, k = k' := ⟨⟨k, h0⟩, rfl⟩,
-  simp only [← units.coe_pow, ← units.ext_iff],
-  rw coe_units_iff at h,
-  apply h.eq_pow_of_mem_roots_of_unity,
-  rw [mem_roots_of_unity, units.ext_iff, units.coe_pow, hξ, units.coe_one]
-end
-
-lemma is_primitive_root_iff' {k : ℕ+} {ζ ξ : Rˣ} (h : is_primitive_root ζ k) :
-  is_primitive_root ξ k ↔ ∃ (i < (k : ℕ)) (hi : i.coprime k), ζ ^ i = ξ :=
-begin
-  split,
-  { intro hξ,
-    obtain ⟨i, hik, rfl⟩ := h.eq_pow_of_mem_roots_of_unity hξ.pow_eq_one,
-    rw h.pow_iff_coprime k.pos at hξ,
-    exact ⟨i, hik, hξ, rfl⟩ },
-  { rintro ⟨i, -, hi, rfl⟩, exact h.pow_of_coprime i hi }
-end
-
-lemma is_primitive_root_iff {k : ℕ} {ζ ξ : R} (h : is_primitive_root ζ k) (h0 : 0 < k) :
-  is_primitive_root ξ k ↔ ∃ (i < k) (hi : i.coprime k), ζ ^ i = ξ :=
-begin
-  split,
-  { intro hξ,
-    obtain ⟨i, hik, rfl⟩ := h.eq_pow_of_pow_eq_one hξ.pow_eq_one h0,
-    rw h.pow_iff_coprime h0 at hξ,
-    exact ⟨i, hik, hξ, rfl⟩ },
-  { rintro ⟨i, -, hi, rfl⟩, exact h.pow_of_coprime i hi }
-end
-
-lemma card_roots_of_unity' {n : ℕ+} (h : is_primitive_root ζ n) :
-  fintype.card (roots_of_unity n R) = n :=
-begin
-  haveI : fact (0 < ↑n) := ⟨n.pos⟩,
-  let e := h.zmod_equiv_zpowers,
-  haveI F : fintype (subgroup.zpowers ζ) := fintype.of_equiv _ e.to_equiv,
-  calc fintype.card (roots_of_unity n R)
-      = fintype.card (subgroup.zpowers ζ) : fintype.card_congr $ by rw h.zpowers_eq
-  ... = fintype.card (zmod n)             : fintype.card_congr e.to_equiv.symm
-  ... = n                                 : zmod.card n
-end
-
-lemma card_roots_of_unity {ζ : R} {n : ℕ+} (h : is_primitive_root ζ n) :
-  fintype.card (roots_of_unity n R) = n :=
-begin
-  obtain ⟨ζ, hζ⟩ := h.is_unit n.pos,
-  rw [← hζ, is_primitive_root.coe_units_iff] at h,
-  exact h.card_roots_of_unity'
-end
-
-/-- The cardinality of the multiset `nth_roots ↑n (1 : R)` is `n`
-if there is a primitive root of unity in `R`. -/
-lemma card_nth_roots {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
-  (nth_roots n (1 : R)).card = n :=
-begin
-  cases nat.eq_zero_or_pos n with hzero hpos,
-  { simp only [hzero, multiset.card_zero, nth_roots_zero] },
-  rw eq_iff_le_not_lt,
-  use card_nth_roots n 1,
-  { rw [not_lt],
-    have hcard : fintype.card {x // x ∈ nth_roots n (1 : R)}
-      ≤ (nth_roots n (1 : R)).attach.card := multiset.card_le_of_le (multiset.dedup_le _),
-    rw multiset.card_attach at hcard,
-    rw ← pnat.to_pnat'_coe hpos at hcard h ⊢,
-    set m := nat.to_pnat' n,
-    rw [← fintype.card_congr (roots_of_unity_equiv_nth_roots R m), card_roots_of_unity h] at hcard,
-    exact hcard }
-end
-
-/-- The multiset `nth_roots ↑n (1 : R)` has no repeated elements
-if there is a primitive root of unity in `R`. -/
-lemma nth_roots_nodup {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) : (nth_roots n (1 : R)).nodup :=
-begin
-  cases nat.eq_zero_or_pos n with hzero hpos,
-  { simp only [hzero, multiset.nodup_zero, nth_roots_zero] },
-  apply (@multiset.dedup_eq_self R _ _).1,
-  rw eq_iff_le_not_lt,
-  split,
-  { exact multiset.dedup_le (nth_roots n (1 : R)) },
-  { by_contra ha,
-    replace ha := multiset.card_lt_of_lt ha,
-    rw card_nth_roots h at ha,
-    have hrw : (nth_roots n (1 : R)).dedup.card =
-      fintype.card {x // x ∈ (nth_roots n (1 : R))},
-    { set fs := (⟨(nth_roots n (1 : R)).dedup, multiset.nodup_dedup _⟩ : finset R),
-      rw [← finset.card_mk, ← fintype.card_of_subtype fs _],
-      intro x,
-      simp only [multiset.mem_dedup, finset.mem_mk] },
-    rw ← pnat.to_pnat'_coe hpos at h hrw ha,
-    set m := nat.to_pnat' n,
-    rw [hrw, ← fintype.card_congr (roots_of_unity_equiv_nth_roots R m),
-        card_roots_of_unity h] at ha,
-    exact nat.lt_asymm ha ha }
-end
-
-@[simp] lemma card_nth_roots_finset {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
-  (nth_roots_finset n R).card = n :=
-by rw [nth_roots_finset, ← multiset.to_finset_eq (nth_roots_nodup h), card_mk, h.card_nth_roots]
-
-open_locale nat
-
-/-- If an integral domain has a primitive `k`-th root of unity, then it has `φ k` of them. -/
-lemma card_primitive_roots {ζ : R} {k : ℕ} (h : is_primitive_root ζ k) :
-  (primitive_roots k R).card = φ k :=
-begin
-  by_cases h0 : k = 0,
-  { simp [h0], },
-  symmetry,
-  refine finset.card_congr (λ i _, ζ ^ i) _ _ _,
-  { simp only [true_and, and_imp, mem_filter, mem_range, mem_univ],
-    rintro i - hi,
-    rw mem_primitive_roots (nat.pos_of_ne_zero h0),
-    exact h.pow_of_coprime i hi.symm },
-  { simp only [true_and, and_imp, mem_filter, mem_range, mem_univ],
-    rintro i j hi - hj - H,
-    exact h.pow_inj hi hj H },
-  { simp only [exists_prop, true_and, mem_filter, mem_range, mem_univ],
-    intros ξ hξ,
-    rw [mem_primitive_roots (nat.pos_of_ne_zero h0),
-      h.is_primitive_root_iff (nat.pos_of_ne_zero h0)] at hξ,
-    rcases hξ with ⟨i, hin, hi, H⟩,
-    exact ⟨i, ⟨hin, hi.symm⟩, H⟩ }
-end
-
-/-- The sets `primitive_roots k R` are pairwise disjoint. -/
-lemma disjoint {k l : ℕ} (h : k ≠ l) :
-  disjoint (primitive_roots k R) (primitive_roots l R) :=
-begin
-  by_cases hk : k = 0, { simp [hk], },
-  by_cases hl : l = 0, { simp [hl], },
-  intro z,
-  simp only [finset.inf_eq_inter, finset.mem_inter, mem_primitive_roots,
-    nat.pos_of_ne_zero hk, nat.pos_of_ne_zero hl, iff_def],
-  rintro ⟨⟨hzk, Hzk⟩, ⟨hzl, Hzl⟩⟩,
-  apply_rules [h, nat.dvd_antisymm, Hzk, Hzl, hzk, hzl]
-end
-
-/-- `nth_roots n` as a `finset` is equal to the union of `primitive_roots i R` for `i ∣ n`
-if there is a primitive root of unity in `R`.
-This holds for any `nat`, not just `pnat`, see `nth_roots_one_eq_bUnion_primitive_roots`. -/
-lemma nth_roots_one_eq_bUnion_primitive_roots' {ζ : R} {n : ℕ+} (h : is_primitive_root ζ n) :
-  nth_roots_finset n R = (nat.divisors ↑n).bUnion (λ i, (primitive_roots i R)) :=
-begin
-  symmetry,
-  apply finset.eq_of_subset_of_card_le,
-  { intros x,
-    simp only [nth_roots_finset, ← multiset.to_finset_eq (nth_roots_nodup h),
-      exists_prop, finset.mem_bUnion, finset.mem_filter, finset.mem_range, mem_nth_roots,
-      finset.mem_mk, nat.mem_divisors, and_true, ne.def, pnat.ne_zero, pnat.pos, not_false_iff],
-    rintro ⟨a, ⟨d, hd⟩, ha⟩,
-    have hazero : 0 < a,
-    { contrapose! hd with ha0,
-      simp only [nonpos_iff_eq_zero, zero_mul, *] at *,
-      exact n.ne_zero },
-    rw mem_primitive_roots hazero at ha,
-    rw [hd, pow_mul, ha.pow_eq_one, one_pow] },
-  { apply le_of_eq,
-    rw [h.card_nth_roots_finset, finset.card_bUnion],
-    { rw [← nat.sum_totient n, nat.filter_dvd_eq_divisors (pnat.ne_zero n), sum_congr rfl]
-        { occs := occurrences.pos [1] },
-      simp only [finset.mem_filter, finset.mem_range, nat.mem_divisors],
-      rintro k ⟨H, hk⟩,
-      have hdvd := H,
-      rcases H with ⟨d, hd⟩,
-      rw mul_comm at hd,
-      rw (h.pow n.pos hd).card_primitive_roots },
-    { intros i hi j hj hdiff,
-      exact disjoint hdiff } }
-end
-
-/-- `nth_roots n` as a `finset` is equal to the union of `primitive_roots i R` for `i ∣ n`
-if there is a primitive root of unity in `R`. -/
-lemma nth_roots_one_eq_bUnion_primitive_roots {ζ : R} {n : ℕ}
-  (h : is_primitive_root ζ n) :
-  nth_roots_finset n R = (nat.divisors n).bUnion (λ i, (primitive_roots i R)) :=
-begin
-  by_cases hn : n = 0,
-  { simp [hn], },
-  exact @nth_roots_one_eq_bUnion_primitive_roots' _ _ _ _ ⟨n, nat.pos_of_ne_zero hn⟩ h
-end
-
-end is_domain
-
-section minpoly
-
-open minpoly
-
-section comm_ring
-variables {n : ℕ} {K : Type*} [comm_ring K] {μ : K} (h : is_primitive_root μ n) (hpos : 0 < n)
-
-include n μ h hpos
-
-/--`μ` is integral over `ℤ`. -/
-lemma is_integral : is_integral ℤ μ :=
-begin
-  use (X ^ n - 1),
-  split,
-  { exact (monic_X_pow_sub_C 1 (ne_of_lt hpos).symm) },
-  { simp only [((is_primitive_root.iff_def μ n).mp h).left, eval₂_one, eval₂_X_pow, eval₂_sub,
-      sub_self] }
-end
-end comm_ring
-
-variables {n : ℕ} {K : Type*} [field K] {μ : K} (h : is_primitive_root μ n) (hpos : 0 < n)
-
-include n μ h hpos
-
-variables [char_zero K]
-
-omit hpos
-/--The minimal polynomial of a root of unity `μ` divides `X ^ n - 1`. -/
-lemma minpoly_dvd_X_pow_sub_one : minpoly ℤ μ ∣ X ^ n - 1 :=
-begin
-  by_cases hpos : n = 0, { simp [hpos], },
-  apply minpoly.gcd_domain_dvd ℚ (is_integral h (nat.pos_of_ne_zero hpos))
-    (polynomial.monic.is_primitive (monic_X_pow_sub_C 1 (ne_of_lt (nat.pos_of_ne_zero hpos)).symm)),
-  simp only [((is_primitive_root.iff_def μ n).mp h).left, aeval_X_pow, ring_hom.eq_int_cast,
-  int.cast_one, aeval_one, alg_hom.map_sub, sub_self]
-end
-
-/-- The reduction modulo `p` of the minimal polynomial of a root of unity `μ` is separable. -/
-lemma separable_minpoly_mod {p : ℕ} [fact p.prime] (hdiv : ¬p ∣ n) :
-  separable (map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ)) :=
-begin
-  have hdvd : (map (int.cast_ring_hom (zmod p))
-    (minpoly ℤ μ)) ∣ X ^ n - 1,
-  { simpa [polynomial.map_pow, map_X, polynomial.map_one, polynomial.map_sub] using
-      ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p)))
-        (minpoly_dvd_X_pow_sub_one h) },
-  refine separable.of_dvd (separable_X_pow_sub_C 1 _ one_ne_zero) hdvd,
-  by_contra hzero,
-  exact hdiv ((zmod.nat_coe_zmod_eq_zero_iff_dvd n p).1 hzero)
-end
-
-/-- The reduction modulo `p` of the minimal polynomial of a root of unity `μ` is squarefree. -/
-lemma squarefree_minpoly_mod {p : ℕ} [fact p.prime] (hdiv : ¬ p ∣ n) :
-  squarefree (map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ)) :=
-(separable_minpoly_mod h hdiv).squarefree
-
-/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
-`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `expand ℤ p Q`. -/
-lemma minpoly_dvd_expand {p : ℕ} (hprime : nat.prime p) (hdiv : ¬ p ∣ n) :
-  minpoly ℤ μ ∣
-  expand ℤ p (minpoly ℤ (μ ^ p)) :=
-begin
-  by_cases hn : n = 0, { simp * at *, },
-  have hpos := nat.pos_of_ne_zero hn,
-  apply minpoly.gcd_domain_dvd ℚ (h.is_integral hpos),
-  { apply monic.is_primitive,
-    rw [polynomial.monic, leading_coeff, nat_degree_expand, mul_comm, coeff_expand_mul'
-        (nat.prime.pos hprime), ← leading_coeff, ← polynomial.monic],
-    exact minpoly.monic (is_integral (pow_of_prime h hprime hdiv) hpos) },
-  { rw [aeval_def, coe_expand, ← comp, eval₂_eq_eval_map, map_comp, polynomial.map_pow, map_X,
-        eval_comp, eval_pow, eval_X, ← eval₂_eq_eval_map, ← aeval_def],
-    exact minpoly.aeval _ _ }
-end
-
-/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
-`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `Q ^ p` modulo `p`. -/
-lemma minpoly_dvd_pow_mod {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
-  map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ) ∣
-  map (int.cast_ring_hom (zmod p)) (minpoly ℤ (μ ^ p)) ^ p :=
-begin
-  set Q := minpoly ℤ (μ ^ p),
-  have hfrob : map (int.cast_ring_hom (zmod p)) Q ^ p =
-    map (int.cast_ring_hom (zmod p)) (expand ℤ p Q),
-  by rw [← zmod.expand_card, map_expand],
-  rw [hfrob],
-  apply ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p))),
-  exact minpoly_dvd_expand h hprime.1 hdiv
-end
-
-/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
-`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `Q` modulo `p`. -/
-lemma minpoly_dvd_mod_p {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
-  map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ) ∣
-  map (int.cast_ring_hom (zmod p)) (minpoly ℤ (μ ^ p)) :=
-(unique_factorization_monoid.dvd_pow_iff_dvd_of_squarefree (squarefree_minpoly_mod h
-  hdiv) hprime.1.ne_zero).1 (minpoly_dvd_pow_mod h hdiv)
-
-/-- If `p` is a prime that does not divide `n`,
-then the minimal polynomials of a primitive `n`-th root of unity `μ`
-and of `μ ^ p` are the same. -/
-lemma minpoly_eq_pow {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
-  minpoly ℤ μ = minpoly ℤ (μ ^ p) :=
-begin
-  by_cases hn : n = 0, { simp * at *, },
-  have hpos := nat.pos_of_ne_zero hn,
-  by_contra hdiff,
-  set P := minpoly ℤ μ,
-  set Q := minpoly ℤ (μ ^ p),
-  have Pmonic : P.monic := minpoly.monic (h.is_integral hpos),
-  have Qmonic : Q.monic := minpoly.monic ((h.pow_of_prime hprime.1 hdiv).is_integral hpos),
-  have Pirr : irreducible P := minpoly.irreducible (h.is_integral hpos),
-  have Qirr : irreducible Q :=
-    minpoly.irreducible ((h.pow_of_prime hprime.1 hdiv).is_integral hpos),
-  have PQprim : is_primitive (P * Q) := Pmonic.is_primitive.mul Qmonic.is_primitive,
-  have prod : P * Q ∣ X ^ n - 1,
-  { rw [(is_primitive.int.dvd_iff_map_cast_dvd_map_cast (P * Q) (X ^ n - 1) PQprim
-      (monic_X_pow_sub_C (1 : ℤ) (ne_of_gt hpos)).is_primitive), polynomial.map_mul],
-    refine is_coprime.mul_dvd _ _ _,
-    { have aux := is_primitive.int.irreducible_iff_irreducible_map_cast Pmonic.is_primitive,
-      refine (dvd_or_coprime _ _ (aux.1 Pirr)).resolve_left _,
-      rw map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Pmonic,
-      intro hdiv,
-      refine hdiff (eq_of_monic_of_associated Pmonic Qmonic _),
-      exact associated_of_dvd_dvd hdiv (Pirr.dvd_symm Qirr hdiv) },
-    { apply (map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Pmonic).2,
-      exact minpoly_dvd_X_pow_sub_one h },
-    { apply (map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Qmonic).2,
-      exact minpoly_dvd_X_pow_sub_one (pow_of_prime h hprime.1 hdiv) } },
-  replace prod := ring_hom.map_dvd ((map_ring_hom (int.cast_ring_hom (zmod p)))) prod,
-  rw [coe_map_ring_hom, polynomial.map_mul, polynomial.map_sub,
-      polynomial.map_one, polynomial.map_pow, map_X] at prod,
-  obtain ⟨R, hR⟩ := minpoly_dvd_mod_p h hdiv,
-  rw [hR, ← mul_assoc, ← polynomial.map_mul, ← sq, polynomial.map_pow] at prod,
-  have habs : map (int.cast_ring_hom (zmod p)) P ^ 2 ∣ map (int.cast_ring_hom (zmod p)) P ^ 2 * R,
-  { use R },
-  replace habs := lt_of_lt_of_le (enat.coe_lt_coe.2 one_lt_two)
-    (multiplicity.le_multiplicity_of_pow_dvd (dvd_trans habs prod)),
-  have hfree : squarefree (X ^ n - 1 : (zmod p)[X]),
-  { exact (separable_X_pow_sub_C 1
-          (λ h, hdiv $ (zmod.nat_coe_zmod_eq_zero_iff_dvd n p).1 h) one_ne_zero).squarefree },
-  cases (multiplicity.squarefree_iff_multiplicity_le_one (X ^ n - 1)).1 hfree
-    (map (int.cast_ring_hom (zmod p)) P) with hle hunit,
-  { rw nat.cast_one at habs, exact hle.not_lt habs },
-  { replace hunit := degree_eq_zero_of_is_unit hunit,
-    rw degree_map_eq_of_leading_coeff_ne_zero (int.cast_ring_hom (zmod p)) _ at hunit,
-    { exact (minpoly.degree_pos (is_integral h hpos)).ne' hunit },
-    simp only [Pmonic, ring_hom.eq_int_cast, monic.leading_coeff, int.cast_one, ne.def,
-      not_false_iff, one_ne_zero] }
-end
-
-/-- If `m : ℕ` is coprime with `n`,
-then the minimal polynomials of a primitive `n`-th root of unity `μ`
-and of `μ ^ m` are the same. -/
-lemma minpoly_eq_pow_coprime {m : ℕ} (hcop : nat.coprime m n) :
-  minpoly ℤ μ = minpoly ℤ (μ ^ m) :=
-begin
-  revert n hcop,
-  refine unique_factorization_monoid.induction_on_prime m _ _ _,
-  { intros n hn h,
-    congr,
-    simpa [(nat.coprime_zero_left n).mp hn] using h },
-  { intros u hunit n hcop h,
-    congr,
-    simp [nat.is_unit_iff.mp hunit] },
-  { intros a p ha hprime hind n hcop h,
-    rw hind (nat.coprime.coprime_mul_left hcop) h, clear hind,
-    replace hprime := nat.prime_iff.2 hprime,
-    have hdiv := (nat.prime.coprime_iff_not_dvd hprime).1 (nat.coprime.coprime_mul_right hcop),
-    haveI := fact.mk hprime,
-    rw [minpoly_eq_pow (h.pow_of_coprime a (nat.coprime.coprime_mul_left hcop)) hdiv],
-    congr' 1,
-    ring_exp }
-end
-
-/-- If `m : ℕ` is coprime with `n`,
-then the minimal polynomial of a primitive `n`-th root of unity `μ`
-has `μ ^ m` as root. -/
-lemma pow_is_root_minpoly {m : ℕ} (hcop : nat.coprime m n) :
-  is_root (map (int.cast_ring_hom K) (minpoly ℤ μ)) (μ ^ m) :=
-by simpa [minpoly_eq_pow_coprime h hcop, eval_map, aeval_def (μ ^ m) _]
-  using minpoly.aeval ℤ (μ ^ m)
-
-/-- `primitive_roots n K` is a subset of the roots of the minimal polynomial of a primitive
-`n`-th root of unity `μ`. -/
-lemma is_roots_of_minpoly : primitive_roots n K ⊆ (map (int.cast_ring_hom K)
-  (minpoly ℤ μ)).roots.to_finset :=
-begin
-  by_cases hn : n = 0, { simp * at *, },
-  have hpos := nat.pos_of_ne_zero hn,
-  intros x hx,
-  obtain ⟨m, hle, hcop, rfl⟩ := (is_primitive_root_iff h hpos).1 ((mem_primitive_roots hpos).1 hx),
-  simpa [multiset.mem_to_finset,
-    mem_roots (map_monic_ne_zero $ minpoly.monic $ is_integral h hpos)]
-    using pow_is_root_minpoly h hcop
-end
-
-/-- The degree of the minimal polynomial of `μ` is at least `totient n`. -/
-lemma totient_le_degree_minpoly : nat.totient n ≤ (minpoly ℤ μ).nat_degree :=
-let P : ℤ[X] := minpoly ℤ μ,-- minimal polynomial of `μ`
-    P_K : K[X] := map (int.cast_ring_hom K) P -- minimal polynomial of `μ` sent to `K[X]`
-in calc
-n.totient = (primitive_roots n K).card : h.card_primitive_roots.symm
-... ≤ P_K.roots.to_finset.card : finset.card_le_of_subset (is_roots_of_minpoly h)
-... ≤ P_K.roots.card : multiset.to_finset_card_le _
-... ≤ P_K.nat_degree : card_roots' _
-... ≤ P.nat_degree : nat_degree_map_le _ _
-
-end minpoly
-
-section automorphisms
-
-variables {S} [comm_ring S] [is_domain S] {μ : S} {n : ℕ+} (hμ : is_primitive_root μ n)
-          (R) [comm_ring R] [algebra R S]
-
-/-- The `monoid_hom` that takes an automorphism to the power of μ that μ gets mapped to under it. -/
-@[simps {attrs := []}] noncomputable def aut_to_pow : (S ≃ₐ[R] S) →* (zmod n)ˣ :=
-let μ' := hμ.to_roots_of_unity in
-have ho : order_of μ' = n :=
-  by rw [hμ.eq_order_of, ←hμ.coe_to_roots_of_unity_coe, order_of_units, order_of_subgroup],
-monoid_hom.to_hom_units
-{ to_fun := λ σ, (map_root_of_unity_eq_pow_self σ.to_alg_hom μ').some,
-  map_one' := begin
-    generalize_proofs h1,
-    have h := h1.some_spec,
-    dsimp only [alg_equiv.one_apply, alg_equiv.to_ring_equiv_eq_coe, ring_equiv.to_ring_hom_eq_coe,
-                ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv] at *,
-    replace h : μ' = μ' ^ h1.some := roots_of_unity.coe_injective
-                 (by simpa only [roots_of_unity.coe_pow] using h),
-    rw ←pow_one μ' at h {occs := occurrences.pos [1]},
-    rw [←@nat.cast_one $ zmod n, zmod.nat_coe_eq_nat_coe_iff, ←ho, ←pow_eq_pow_iff_modeq μ', h]
-  end,
-  map_mul' := begin
-    generalize_proofs hxy' hx' hy',
-    have hxy := hxy'.some_spec,
-    have hx := hx'.some_spec,
-    have hy := hy'.some_spec,
-    dsimp only [alg_equiv.to_ring_equiv_eq_coe, ring_equiv.to_ring_hom_eq_coe,
-                ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv, alg_equiv.mul_apply] at *,
-    replace hxy : x (↑μ' ^ hy'.some) = ↑μ' ^ hxy'.some := hy ▸ hxy,
-    rw x.map_pow at hxy,
-    replace hxy : ((μ' : S) ^ hx'.some) ^ hy'.some = μ' ^ hxy'.some := hx ▸ hxy,
-    rw ←pow_mul at hxy,
-    replace hxy : μ' ^ (hx'.some * hy'.some) = μ' ^ hxy'.some := roots_of_unity.coe_injective
-                                           (by simpa only [roots_of_unity.coe_pow] using hxy),
-    rw [←nat.cast_mul, zmod.nat_coe_eq_nat_coe_iff, ←ho, ←pow_eq_pow_iff_modeq μ', hxy]
-  end }
-
-@[simp] lemma aut_to_pow_spec (f : S ≃ₐ[R] S) :
-  μ ^ (hμ.aut_to_pow R f : zmod n).val = f μ :=
-begin
-  rw is_primitive_root.coe_aut_to_pow_apply,
-  generalize_proofs h,
-  have := h.some_spec,
-  dsimp only [alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom] at this,
-  refine (_ : ↑hμ.to_roots_of_unity ^ _ = _).trans this.symm,
-  rw [←roots_of_unity.coe_pow, ←roots_of_unity.coe_pow],
-  congr' 1,
-  rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hμ.coe_to_roots_of_unity_coe,
-      ←hμ.eq_order_of, zmod.val_nat_cast],
-  exact nat.mod_modeq _ _
-end
-
-end automorphisms
-
-end is_primitive_root
diff --git a/src/ring_theory/roots_of_unity/basic.lean b/src/ring_theory/roots_of_unity/basic.lean
new file mode 100644
index 0000000000000..1af2919d9c743
--- /dev/null
+++ b/src/ring_theory/roots_of_unity/basic.lean
@@ -0,0 +1,944 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+
+import algebra.char_p.two
+import algebra.ne_zero
+import algebra.gcd_monoid.integrally_closed
+import data.polynomial.ring_division
+import field_theory.finite.basic
+import field_theory.separable
+import group_theory.specific_groups.cyclic
+import number_theory.divisors
+import ring_theory.integral_domain
+import tactic.zify
+
+/-!
+# Roots of unity and primitive roots of unity
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define roots of unity in the context of an arbitrary commutative monoid,
+as a subgroup of the group of units. We also define a predicate `is_primitive_root` on commutative
+monoids, expressing that an element is a primitive root of unity.
+
+## Main definitions
+
+* `roots_of_unity n M`, for `n : ℕ+` is the subgroup of the units of a commutative monoid `M`
+  consisting of elements `x` that satisfy `x ^ n = 1`.
+* `is_primitive_root ζ k`: an element `ζ` is a primitive `k`-th root of unity if `ζ ^ k = 1`,
+  and if `l` satisfies `ζ ^ l = 1` then `k ∣ l`.
+* `primitive_roots k R`: the finset of primitive `k`-th roots of unity in an integral domain `R`.
+* `is_primitive_root.aut_to_pow`: the monoid hom that takes an automorphism of a ring to the power
+  it sends that specific primitive root, as a member of `(zmod n)ˣ`.
+
+## Main results
+
+* `roots_of_unity.is_cyclic`: the roots of unity in an integral domain form a cyclic group.
+* `is_primitive_root.zmod_equiv_zpowers`: `zmod k` is equivalent to
+  the subgroup generated by a primitive `k`-th root of unity.
+* `is_primitive_root.zpowers_eq`: in an integral domain, the subgroup generated by
+  a primitive `k`-th root of unity is equal to the `k`-th roots of unity.
+* `is_primitive_root.card_primitive_roots`: if an integral domain
+   has a primitive `k`-th root of unity, then it has `φ k` of them.
+
+## Implementation details
+
+It is desirable that `roots_of_unity` is a subgroup,
+and it will mainly be applied to rings (e.g. the ring of integers in a number field) and fields.
+We therefore implement it as a subgroup of the units of a commutative monoid.
+
+We have chosen to define `roots_of_unity n` for `n : ℕ+`, instead of `n : ℕ`,
+because almost all lemmas need the positivity assumption,
+and in particular the type class instances for `fintype` and `is_cyclic`.
+
+On the other hand, for primitive roots of unity, it is desirable to have a predicate
+not just on units, but directly on elements of the ring/field.
+For example, we want to say that `exp (2 * pi * I / n)` is a primitive `n`-th root of unity
+in the complex numbers, without having to turn that number into a unit first.
+
+This creates a little bit of friction, but lemmas like `is_primitive_root.is_unit` and
+`is_primitive_root.coe_units_iff` should provide the necessary glue.
+
+-/
+
+open_locale classical big_operators polynomial
+noncomputable theory
+
+open polynomial
+open finset
+
+variables {M N G R S F : Type*}
+variables [comm_monoid M] [comm_monoid N] [division_comm_monoid G]
+
+section roots_of_unity
+
+variables {k l : ℕ+}
+
+/-- `roots_of_unity k M` is the subgroup of elements `m : Mˣ` that satisfy `m ^ k = 1` -/
+def roots_of_unity (k : ℕ+) (M : Type*) [comm_monoid M] : subgroup Mˣ :=
+{ carrier := { ζ | ζ ^ (k : ℕ) = 1 },
+  one_mem' := one_pow _,
+  mul_mem' := λ ζ ξ hζ hξ, by simp only [*, set.mem_set_of_eq, mul_pow, one_mul] at *,
+  inv_mem' := λ ζ hζ, by simp only [*, set.mem_set_of_eq, inv_pow, inv_one] at * }
+
+@[simp] lemma mem_roots_of_unity (k : ℕ+) (ζ : Mˣ) :
+  ζ ∈ roots_of_unity k M ↔ ζ ^ (k : ℕ) = 1 := iff.rfl
+
+lemma mem_roots_of_unity' (k : ℕ+) (ζ : Mˣ) :
+  ζ ∈ roots_of_unity k M ↔ (ζ : M) ^ (k : ℕ) = 1 :=
+by { rw [mem_roots_of_unity], norm_cast }
+
+lemma roots_of_unity.coe_injective {n : ℕ+} : function.injective (coe : (roots_of_unity n M) → M) :=
+units.ext.comp (λ x y, subtype.ext)
+
+/-- Make an element of `roots_of_unity` from a member of the base ring, and a proof that it has
+a positive power equal to one. -/
+@[simps coe_coe] def roots_of_unity.mk_of_pow_eq (ζ : M) {n : ℕ+} (h : ζ ^ (n : ℕ) = 1) :
+  roots_of_unity n M :=
+⟨units.of_pow_eq_one ζ n h n.ne_zero, units.pow_of_pow_eq_one _ _⟩
+
+@[simp] lemma roots_of_unity.coe_mk_of_pow_eq {ζ : M} {n : ℕ+}
+  (h : ζ ^ (n : ℕ) = 1) : (roots_of_unity.mk_of_pow_eq _ h : M) = ζ := rfl
+
+lemma roots_of_unity_le_of_dvd (h : k ∣ l) : roots_of_unity k M ≤ roots_of_unity l M :=
+begin
+  obtain ⟨d, rfl⟩ := h,
+  intros ζ h,
+  simp only [mem_roots_of_unity, pnat.mul_coe, pow_mul, one_pow, *] at *,
+end
+
+lemma map_roots_of_unity (f : Mˣ →* Nˣ) (k : ℕ+) :
+  (roots_of_unity k M).map f ≤ roots_of_unity k N :=
+begin
+  rintros _ ⟨ζ, h, rfl⟩,
+  simp only [←map_pow, *, mem_roots_of_unity, set_like.mem_coe, monoid_hom.map_one] at *
+end
+
+@[norm_cast] lemma roots_of_unity.coe_pow [comm_monoid R] (ζ : roots_of_unity k R) (m : ℕ) :
+  ↑(ζ ^ m) = (ζ ^ m : R) :=
+begin
+  change ↑(↑(ζ ^ m) : Rˣ) = ↑(ζ : Rˣ) ^ m,
+  rw [subgroup.coe_pow, units.coe_pow],
+end
+
+section comm_semiring
+
+variables [comm_semiring R] [comm_semiring S]
+
+/-- Restrict a ring homomorphism to the nth roots of unity -/
+def restrict_roots_of_unity [ring_hom_class F R S] (σ : F) (n : ℕ+) :
+  roots_of_unity n R →* roots_of_unity n S :=
+let h : ∀ ξ : roots_of_unity n R, (σ ξ) ^ (n : ℕ) = 1 := λ ξ, by
+{ change (σ (ξ : Rˣ)) ^ (n : ℕ) = 1,
+  rw [←map_pow, ←units.coe_pow, show ((ξ : Rˣ) ^ (n : ℕ) = 1), from ξ.2,
+      units.coe_one, map_one σ] } in
+{ to_fun := λ ξ, ⟨@unit_of_invertible _ _ _ (invertible_of_pow_eq_one _ _ (h ξ) n.ne_zero),
+    by { ext, rw units.coe_pow, exact h ξ }⟩,
+  map_one' := by { ext, exact map_one σ },
+  map_mul' := λ ξ₁ ξ₂, by { ext, rw [subgroup.coe_mul, units.coe_mul], exact map_mul σ _ _ } }
+
+@[simp] lemma restrict_roots_of_unity_coe_apply [ring_hom_class F R S] (σ : F)
+  (ζ : roots_of_unity k R) : ↑(restrict_roots_of_unity σ k ζ) = σ ↑ζ :=
+rfl
+
+/-- Restrict a ring isomorphism to the nth roots of unity -/
+def ring_equiv.restrict_roots_of_unity (σ : R ≃+* S) (n : ℕ+) :
+  roots_of_unity n R ≃* roots_of_unity n S :=
+{ to_fun := restrict_roots_of_unity σ.to_ring_hom n,
+  inv_fun :=restrict_roots_of_unity σ.symm.to_ring_hom n,
+  left_inv := λ ξ, by { ext, exact σ.symm_apply_apply ξ },
+  right_inv := λ ξ, by { ext, exact σ.apply_symm_apply ξ },
+  map_mul' := (restrict_roots_of_unity _ n).map_mul }
+
+@[simp] lemma ring_equiv.restrict_roots_of_unity_coe_apply (σ : R ≃+* S) (ζ : roots_of_unity k R) :
+  ↑(σ.restrict_roots_of_unity k ζ) = σ ↑ζ :=
+rfl
+
+@[simp] lemma ring_equiv.restrict_roots_of_unity_symm (σ : R ≃+* S) :
+  (σ.restrict_roots_of_unity k).symm = σ.symm.restrict_roots_of_unity k :=
+rfl
+
+end comm_semiring
+
+section is_domain
+
+variables [comm_ring R] [is_domain R]
+
+lemma mem_roots_of_unity_iff_mem_nth_roots {ζ : Rˣ} :
+  ζ ∈ roots_of_unity k R ↔ (ζ : R) ∈ nth_roots k (1 : R) :=
+by simp only [mem_roots_of_unity, mem_nth_roots k.pos, units.ext_iff, units.coe_one, units.coe_pow]
+
+variables (k R)
+
+/-- Equivalence between the `k`-th roots of unity in `R` and the `k`-th roots of `1`.
+
+This is implemented as equivalence of subtypes,
+because `roots_of_unity` is a subgroup of the group of units,
+whereas `nth_roots` is a multiset. -/
+def roots_of_unity_equiv_nth_roots :
+  roots_of_unity k R ≃ {x // x ∈ nth_roots k (1 : R)} :=
+begin
+  refine
+  { to_fun := λ x, ⟨x, mem_roots_of_unity_iff_mem_nth_roots.mp x.2⟩,
+    inv_fun := λ x, ⟨⟨x, x ^ (k - 1 : ℕ), _, _⟩, _⟩,
+    left_inv := _,
+    right_inv := _ },
+  swap 4, { rintro ⟨x, hx⟩, ext, refl },
+  swap 4, { rintro ⟨x, hx⟩, ext, refl },
+  all_goals
+  { rcases x with ⟨x, hx⟩, rw [mem_nth_roots k.pos] at hx,
+    simp only [subtype.coe_mk, ← pow_succ, ← pow_succ', hx,
+      tsub_add_cancel_of_le (show 1 ≤ (k : ℕ), from k.one_le)] },
+  { show (_ : Rˣ) ^ (k : ℕ) = 1,
+    simp only [units.ext_iff, hx, units.coe_mk, units.coe_one, subtype.coe_mk, units.coe_pow] }
+end
+
+variables {k R}
+
+@[simp] lemma roots_of_unity_equiv_nth_roots_apply (x : roots_of_unity k R) :
+  (roots_of_unity_equiv_nth_roots R k x : R) = x :=
+rfl
+
+@[simp] lemma roots_of_unity_equiv_nth_roots_symm_apply (x : {x // x ∈ nth_roots k (1 : R)}) :
+  ((roots_of_unity_equiv_nth_roots R k).symm x : R) = x :=
+rfl
+
+variables (k R)
+
+instance roots_of_unity.fintype : fintype (roots_of_unity k R) :=
+fintype.of_equiv {x // x ∈ nth_roots k (1 : R)} $ (roots_of_unity_equiv_nth_roots R k).symm
+
+instance roots_of_unity.is_cyclic : is_cyclic (roots_of_unity k R) :=
+is_cyclic_of_subgroup_is_domain ((units.coe_hom R).comp (roots_of_unity k R).subtype)
+  (units.ext.comp subtype.val_injective)
+
+lemma card_roots_of_unity : fintype.card (roots_of_unity k R) ≤ k :=
+calc  fintype.card (roots_of_unity k R)
+    = fintype.card {x // x ∈ nth_roots k (1 : R)} :
+          fintype.card_congr (roots_of_unity_equiv_nth_roots R k)
+... ≤ (nth_roots k (1 : R)).attach.card           : multiset.card_le_of_le (multiset.dedup_le _)
+... = (nth_roots k (1 : R)).card                  : multiset.card_attach
+... ≤ k                                           : card_nth_roots k 1
+
+variables {k R}
+
+lemma map_root_of_unity_eq_pow_self [ring_hom_class F R R] (σ : F) (ζ : roots_of_unity k R) :
+  ∃ m : ℕ, σ ζ = ζ ^ m :=
+begin
+  obtain ⟨m, hm⟩ := monoid_hom.map_cyclic (restrict_roots_of_unity σ k),
+  rw [←restrict_roots_of_unity_coe_apply, hm, zpow_eq_mod_order_of, ←int.to_nat_of_nonneg
+      (m.mod_nonneg (int.coe_nat_ne_zero.mpr (pos_iff_ne_zero.mp (order_of_pos ζ)))),
+      zpow_coe_nat, roots_of_unity.coe_pow],
+  exact ⟨(m % (order_of ζ)).to_nat, rfl⟩,
+end
+
+end is_domain
+
+section reduced
+
+variables (R) [comm_ring R] [is_reduced R]
+
+@[simp] lemma mem_roots_of_unity_prime_pow_mul_iff (p k : ℕ) (m : ℕ+) [hp : fact p.prime]
+  [char_p R p] {ζ : Rˣ} :
+  ζ ∈ roots_of_unity (⟨p, hp.1.pos⟩ ^ k * m) R ↔ ζ ∈ roots_of_unity m R :=
+by simp [mem_roots_of_unity']
+
+end reduced
+
+end roots_of_unity
+
+/-- An element `ζ` is a primitive `k`-th root of unity if `ζ ^ k = 1`,
+and if `l` satisfies `ζ ^ l = 1` then `k ∣ l`. -/
+structure is_primitive_root (ζ : M) (k : ℕ) : Prop :=
+(pow_eq_one : ζ ^ (k : ℕ) = 1)
+(dvd_of_pow_eq_one : ∀ l : ℕ, ζ ^ l = 1 → k ∣ l)
+
+/-- Turn a primitive root μ into a member of the `roots_of_unity` subgroup. -/
+@[simps] def is_primitive_root.to_roots_of_unity {μ : M} {n : ℕ+} (h : is_primitive_root μ n) :
+  roots_of_unity n M := roots_of_unity.mk_of_pow_eq μ h.pow_eq_one
+
+section primitive_roots
+variables {k : ℕ}
+
+/-- `primitive_roots k R` is the finset of primitive `k`-th roots of unity
+in the integral domain `R`. -/
+def primitive_roots (k : ℕ) (R : Type*) [comm_ring R] [is_domain R] : finset R :=
+(nth_roots k (1 : R)).to_finset.filter (λ ζ, is_primitive_root ζ k)
+
+variables [comm_ring R] [is_domain R]
+
+@[simp] lemma mem_primitive_roots {ζ : R} (h0 : 0 < k) :
+  ζ ∈ primitive_roots k R ↔ is_primitive_root ζ k :=
+begin
+  rw [primitive_roots, mem_filter, multiset.mem_to_finset, mem_nth_roots h0, and_iff_right_iff_imp],
+  exact is_primitive_root.pow_eq_one
+end
+
+@[simp] lemma primitive_roots_zero : primitive_roots 0 R = ∅ :=
+by rw [primitive_roots, nth_roots_zero, multiset.to_finset_zero, finset.filter_empty]
+
+lemma is_primitive_root_of_mem_primitive_roots {ζ : R} (h : ζ ∈ primitive_roots k R) :
+  is_primitive_root ζ k :=
+k.eq_zero_or_pos.elim (λ hk, false.elim $ by simpa [hk] using h)
+  (λ hk, (mem_primitive_roots hk).1 h)
+
+end primitive_roots
+
+namespace is_primitive_root
+
+variables {k l : ℕ}
+
+lemma iff_def (ζ : M) (k : ℕ) :
+  is_primitive_root ζ k ↔ (ζ ^ k = 1) ∧ (∀ l : ℕ, ζ ^ l = 1 → k ∣ l) :=
+⟨λ ⟨h1, h2⟩, ⟨h1, h2⟩, λ ⟨h1, h2⟩, ⟨h1, h2⟩⟩
+
+lemma mk_of_lt (ζ : M) (hk : 0 < k) (h1 : ζ ^ k = 1) (h : ∀ l : ℕ, 0 < l →  l < k → ζ ^ l ≠ 1) :
+  is_primitive_root ζ k :=
+begin
+  refine ⟨h1, λ l hl, _⟩,
+  suffices : k.gcd l = k, { exact this ▸ k.gcd_dvd_right l },
+  rw eq_iff_le_not_lt,
+  refine ⟨nat.le_of_dvd hk (k.gcd_dvd_left l), _⟩,
+  intro h', apply h _ (nat.gcd_pos_of_pos_left _ hk) h',
+  exact pow_gcd_eq_one _ h1 hl
+end
+
+section comm_monoid
+
+variables {ζ : M} {f : F} (h : is_primitive_root ζ k)
+
+@[nontriviality] lemma of_subsingleton [subsingleton M] (x : M) : is_primitive_root x 1 :=
+⟨subsingleton.elim _ _, λ _ _, one_dvd _⟩
+
+lemma pow_eq_one_iff_dvd (l : ℕ) : ζ ^ l = 1 ↔ k ∣ l :=
+⟨h.dvd_of_pow_eq_one l,
+by { rintro ⟨i, rfl⟩, simp only [pow_mul, h.pow_eq_one, one_pow, pnat.mul_coe] }⟩
+
+lemma is_unit (h : is_primitive_root ζ k) (h0 : 0 < k) : is_unit ζ :=
+begin
+  apply is_unit_of_mul_eq_one ζ (ζ ^ (k - 1)),
+  rw [← pow_succ, tsub_add_cancel_of_le h0.nat_succ_le, h.pow_eq_one]
+end
+
+lemma pow_ne_one_of_pos_of_lt (h0 : 0 < l) (hl : l < k) : ζ ^ l ≠ 1 :=
+mt (nat.le_of_dvd h0 ∘ h.dvd_of_pow_eq_one _) $ not_le_of_lt hl
+
+lemma ne_one (hk : 1 < k) : ζ ≠ 1 :=
+h.pow_ne_one_of_pos_of_lt zero_lt_one hk ∘ (pow_one ζ).trans
+
+lemma pow_inj (h : is_primitive_root ζ k) ⦃i j : ℕ⦄ (hi : i < k) (hj : j < k) (H : ζ ^ i = ζ ^ j) :
+  i = j :=
+begin
+  wlog hij : i ≤ j generalizing i j,
+  { exact (this hj hi H.symm (le_of_not_le hij)).symm },
+  apply le_antisymm hij,
+  rw ← tsub_eq_zero_iff_le,
+  apply nat.eq_zero_of_dvd_of_lt _ (lt_of_le_of_lt tsub_le_self hj),
+  apply h.dvd_of_pow_eq_one,
+  rw [← ((h.is_unit (lt_of_le_of_lt (nat.zero_le _) hi)).pow i).mul_left_inj,
+      ← pow_add, tsub_add_cancel_of_le hij, H, one_mul]
+end
+
+lemma one : is_primitive_root (1 : M) 1 :=
+{ pow_eq_one := pow_one _,
+  dvd_of_pow_eq_one := λ l hl, one_dvd _ }
+
+@[simp] lemma one_right_iff : is_primitive_root ζ 1 ↔ ζ = 1 :=
+begin
+  split,
+  { intro h, rw [← pow_one ζ, h.pow_eq_one] },
+  { rintro rfl, exact one }
+end
+
+@[simp] lemma coe_submonoid_class_iff {M B : Type*} [comm_monoid M] [set_like B M]
+  [submonoid_class B M] {N : B} {ζ : N} : is_primitive_root (ζ : M) k ↔ is_primitive_root ζ k :=
+by simp [iff_def, ← submonoid_class.coe_pow]
+
+@[simp] lemma coe_units_iff {ζ : Mˣ} :
+  is_primitive_root (ζ : M) k ↔ is_primitive_root ζ k :=
+by simp only [iff_def, units.ext_iff, units.coe_pow, units.coe_one]
+
+lemma pow_of_coprime (h : is_primitive_root ζ k) (i : ℕ) (hi : i.coprime k) :
+  is_primitive_root (ζ ^ i) k :=
+begin
+  by_cases h0 : k = 0,
+  { subst k, simp only [*, pow_one, nat.coprime_zero_right] at * },
+  rcases h.is_unit (nat.pos_of_ne_zero h0) with ⟨ζ, rfl⟩,
+  rw [← units.coe_pow],
+  rw coe_units_iff at h ⊢,
+  refine
+  { pow_eq_one := by rw [← pow_mul', pow_mul, h.pow_eq_one, one_pow],
+    dvd_of_pow_eq_one := _ },
+  intros l hl,
+  apply h.dvd_of_pow_eq_one,
+  rw [← pow_one ζ, ← zpow_coe_nat ζ, ← hi.gcd_eq_one, nat.gcd_eq_gcd_ab, zpow_add,
+      mul_pow, ← zpow_coe_nat, ← zpow_mul, mul_right_comm],
+  simp only [zpow_mul, hl, h.pow_eq_one, one_zpow, one_pow, one_mul, zpow_coe_nat]
+end
+
+lemma pow_of_prime (h : is_primitive_root ζ k) {p : ℕ} (hprime : nat.prime p) (hdiv : ¬ p ∣ k) :
+  is_primitive_root (ζ ^ p) k :=
+h.pow_of_coprime p (hprime.coprime_iff_not_dvd.2 hdiv)
+
+lemma pow_iff_coprime (h : is_primitive_root ζ k) (h0 : 0 < k) (i : ℕ) :
+  is_primitive_root (ζ ^ i) k ↔ i.coprime k :=
+begin
+  refine ⟨_, h.pow_of_coprime i⟩,
+  intro hi,
+  obtain ⟨a, ha⟩ := i.gcd_dvd_left k,
+  obtain ⟨b, hb⟩ := i.gcd_dvd_right k,
+  suffices : b = k,
+  { rwa [this, ← one_mul k, mul_left_inj' h0.ne', eq_comm] at hb { occs := occurrences.pos [1] } },
+  rw [ha] at hi,
+  rw [mul_comm] at hb,
+  apply nat.dvd_antisymm ⟨i.gcd k, hb⟩ (hi.dvd_of_pow_eq_one b _),
+  rw [← pow_mul', ← mul_assoc, ← hb, pow_mul, h.pow_eq_one, one_pow]
+end
+
+protected lemma order_of (ζ : M) : is_primitive_root ζ (order_of ζ) :=
+⟨pow_order_of_eq_one ζ, λ l, order_of_dvd_of_pow_eq_one⟩
+
+lemma unique {ζ : M} (hk : is_primitive_root ζ k) (hl : is_primitive_root ζ l) : k = l :=
+nat.dvd_antisymm (hk.2 _ hl.1) (hl.2 _ hk.1)
+
+lemma eq_order_of : k = order_of ζ := h.unique (is_primitive_root.order_of ζ)
+
+protected lemma iff (hk : 0 < k) :
+  is_primitive_root ζ k ↔ ζ ^ k = 1 ∧ ∀ l : ℕ, 0 < l → l < k → ζ ^ l ≠ 1 :=
+begin
+  refine ⟨λ h, ⟨h.pow_eq_one, λ l hl' hl, _⟩, λ ⟨hζ, hl⟩, is_primitive_root.mk_of_lt ζ hk hζ hl⟩,
+  rw h.eq_order_of at hl,
+  exact pow_ne_one_of_lt_order_of' hl'.ne' hl,
+end
+
+protected lemma not_iff : ¬ is_primitive_root ζ k ↔ order_of ζ ≠ k :=
+⟨λ h hk, h $ hk ▸ is_primitive_root.order_of ζ,
+ λ h hk, h.symm $ hk.unique $ is_primitive_root.order_of ζ⟩
+
+lemma pow_of_dvd (h : is_primitive_root ζ k) {p : ℕ} (hp : p ≠ 0) (hdiv : p ∣ k) :
+  is_primitive_root (ζ ^ p) (k / p) :=
+begin
+  suffices : order_of (ζ ^ p) = k / p,
+  { exact this ▸ is_primitive_root.order_of (ζ ^ p) },
+  rw [order_of_pow' _ hp, ← eq_order_of h, nat.gcd_eq_right hdiv]
+end
+
+protected
+lemma mem_roots_of_unity {ζ : Mˣ} {n : ℕ+} (h : is_primitive_root ζ n) : ζ ∈ roots_of_unity n M :=
+h.pow_eq_one
+
+/-- If there is a `n`-th primitive root of unity in `R` and `b` divides `n`,
+then there is a `b`-th primitive root of unity in `R`. -/
+lemma pow {n : ℕ} {a b : ℕ} (hn : 0 < n) (h : is_primitive_root ζ n) (hprod : n = a * b) :
+  is_primitive_root (ζ ^ a) b :=
+begin
+  subst n,
+  simp only [iff_def, ← pow_mul, h.pow_eq_one, eq_self_iff_true, true_and],
+  intros l hl,
+  have ha0 : a ≠ 0, { rintro rfl, simpa only [nat.not_lt_zero, zero_mul] using hn },
+  rwa ← mul_dvd_mul_iff_left ha0,
+  exact h.dvd_of_pow_eq_one _ hl
+end
+
+section maps
+
+open function
+
+lemma map_of_injective [monoid_hom_class F M N] (h : is_primitive_root ζ k) (hf : injective f) :
+  is_primitive_root (f ζ) k :=
+{ pow_eq_one := by rw [←map_pow, h.pow_eq_one, _root_.map_one],
+  dvd_of_pow_eq_one := begin
+    rw h.eq_order_of,
+    intros l hl,
+    rw [←map_pow, ←map_one f] at hl,
+    exact order_of_dvd_of_pow_eq_one (hf hl)
+  end }
+
+lemma of_map_of_injective [monoid_hom_class F M N] (h : is_primitive_root (f ζ) k)
+  (hf : injective f) : is_primitive_root ζ k :=
+{ pow_eq_one := by { apply_fun f, rw [map_pow, _root_.map_one, h.pow_eq_one] },
+  dvd_of_pow_eq_one := begin
+    rw h.eq_order_of,
+    intros l hl,
+    apply_fun f at hl,
+    rw [map_pow, _root_.map_one] at hl,
+    exact order_of_dvd_of_pow_eq_one hl
+  end }
+
+lemma map_iff_of_injective [monoid_hom_class F M N] (hf : injective f) :
+  is_primitive_root (f ζ) k ↔ is_primitive_root ζ k :=
+⟨λ h, h.of_map_of_injective hf, λ h, h.map_of_injective hf⟩
+
+end maps
+
+end comm_monoid
+
+section comm_monoid_with_zero
+
+variables {M₀ : Type*} [comm_monoid_with_zero M₀]
+
+lemma zero [nontrivial M₀] : is_primitive_root (0 : M₀) 0 :=
+⟨pow_zero 0, λ l hl, by simpa [zero_pow_eq, show ∀ p, ¬p → false ↔ p, from @not_not] using hl⟩
+
+protected lemma ne_zero [nontrivial M₀] {ζ : M₀} (h : is_primitive_root ζ k) : k ≠ 0 → ζ ≠ 0 :=
+mt $ λ hn, h.unique (hn.symm ▸ is_primitive_root.zero)
+
+end comm_monoid_with_zero
+
+section division_comm_monoid
+
+variables {ζ : G}
+
+lemma zpow_eq_one (h : is_primitive_root ζ k) : ζ ^ (k : ℤ) = 1 :=
+by { rw zpow_coe_nat, exact h.pow_eq_one }
+
+lemma zpow_eq_one_iff_dvd (h : is_primitive_root ζ k) (l : ℤ) :
+  ζ ^ l = 1 ↔ (k : ℤ) ∣ l :=
+begin
+  by_cases h0 : 0 ≤ l,
+  { lift l to ℕ using h0, rw [zpow_coe_nat], norm_cast, exact h.pow_eq_one_iff_dvd l },
+  { have : 0 ≤ -l, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
+    lift -l to ℕ using this with l' hl',
+    rw [← dvd_neg, ← hl'],
+    norm_cast,
+    rw [← h.pow_eq_one_iff_dvd, ← inv_inj, ← zpow_neg, ← hl', zpow_coe_nat, inv_one] }
+end
+
+lemma inv (h : is_primitive_root ζ k) : is_primitive_root ζ⁻¹ k :=
+{ pow_eq_one := by simp only [h.pow_eq_one, inv_one, eq_self_iff_true, inv_pow],
+  dvd_of_pow_eq_one :=
+  begin
+    intros l hl,
+    apply h.dvd_of_pow_eq_one l,
+    rw [← inv_inj, ← inv_pow, hl, inv_one]
+  end }
+
+@[simp] lemma inv_iff : is_primitive_root ζ⁻¹ k ↔ is_primitive_root ζ k :=
+by { refine ⟨_, λ h, inv h⟩, intro h, rw [← inv_inv ζ], exact inv h }
+
+lemma zpow_of_gcd_eq_one (h : is_primitive_root ζ k) (i : ℤ) (hi : i.gcd k = 1) :
+  is_primitive_root (ζ ^ i) k :=
+begin
+  by_cases h0 : 0 ≤ i,
+  { lift i to ℕ using h0,
+    rw zpow_coe_nat,
+    exact h.pow_of_coprime i hi },
+  have : 0 ≤ -i, { simp only [not_le, neg_nonneg] at h0 ⊢, exact le_of_lt h0 },
+  lift -i to ℕ using this with i' hi',
+  rw [← inv_iff, ← zpow_neg, ← hi', zpow_coe_nat],
+  apply h.pow_of_coprime,
+  rw [int.gcd, ← int.nat_abs_neg, ← hi'] at hi,
+  exact hi
+end
+
+end division_comm_monoid
+
+section is_domain
+
+variables {ζ : R}
+variables [comm_ring R] [is_domain R]
+
+@[simp] lemma primitive_roots_one : primitive_roots 1 R = {(1 : R)} :=
+begin
+  apply finset.eq_singleton_iff_unique_mem.2,
+  split,
+  { simp only [is_primitive_root.one_right_iff, mem_primitive_roots zero_lt_one] },
+  { intros x hx,
+    rw [mem_primitive_roots zero_lt_one, is_primitive_root.one_right_iff] at hx,
+    exact hx }
+end
+
+lemma ne_zero' {n : ℕ+} (hζ : is_primitive_root ζ n) : ne_zero ((n : ℕ) : R) :=
+begin
+  let p := ring_char R,
+  have hfin := (multiplicity.finite_nat_iff.2 ⟨char_p.char_ne_one R p, n.pos⟩),
+  obtain ⟨m, hm⟩ := multiplicity.exists_eq_pow_mul_and_not_dvd hfin,
+  by_cases hp : p ∣ n,
+  { obtain ⟨k, hk⟩ := nat.exists_eq_succ_of_ne_zero (multiplicity.pos_of_dvd hfin hp).ne',
+    haveI : ne_zero p := ne_zero.of_pos (nat.pos_of_dvd_of_pos hp n.pos),
+    haveI hpri : fact p.prime := char_p.char_is_prime_of_pos R p,
+    have := hζ.pow_eq_one,
+    rw [hm.1, hk, pow_succ, mul_assoc, pow_mul', ← frobenius_def, ← frobenius_one p] at this,
+    exfalso,
+    have hpos : 0 < p ^ k * m,
+    { refine (mul_pos (pow_pos hpri.1.pos _) (nat.pos_of_ne_zero (λ h, _))),
+      have H := hm.1,
+      rw [h] at H,
+      simpa using H },
+    refine hζ.pow_ne_one_of_pos_of_lt hpos _ (frobenius_inj R p this),
+    { rw [hm.1, hk, pow_succ, mul_assoc, mul_comm p],
+      exact lt_mul_of_one_lt_right hpos hpri.1.one_lt } },
+  { exact ne_zero.of_not_dvd R hp }
+end
+
+lemma mem_nth_roots_finset (hζ : is_primitive_root ζ k) (hk : 0 < k) :
+  ζ ∈ nth_roots_finset k R :=
+(mem_nth_roots_finset hk).2 hζ.pow_eq_one
+
+end is_domain
+
+section is_domain
+
+variables [comm_ring R]
+variables {ζ : Rˣ} (h : is_primitive_root ζ k)
+
+lemma eq_neg_one_of_two_right [no_zero_divisors R] {ζ : R} (h : is_primitive_root ζ 2) : ζ = -1 :=
+begin
+  apply (eq_or_eq_neg_of_sq_eq_sq ζ 1 _).resolve_left,
+  { rw [← pow_one ζ], apply h.pow_ne_one_of_pos_of_lt; dec_trivial },
+  { simp only [h.pow_eq_one, one_pow] }
+end
+
+lemma neg_one (p : ℕ) [nontrivial R] [h : char_p R p] (hp : p ≠ 2) : is_primitive_root (-1 : R) 2 :=
+begin
+  convert is_primitive_root.order_of (-1 : R),
+  rw [order_of_neg_one, if_neg],
+  rwa ring_char.eq_iff.mpr h
+end
+
+/-- If `1 < k` then `(∑ i in range k, ζ ^ i) = 0`. -/
+lemma geom_sum_eq_zero [is_domain R] {ζ : R} (hζ : is_primitive_root ζ k) (hk : 1 < k) :
+  (∑ i in range k, ζ ^ i) = 0 :=
+begin
+  refine eq_zero_of_ne_zero_of_mul_left_eq_zero (sub_ne_zero_of_ne (hζ.ne_one hk).symm) _,
+  rw [mul_neg_geom_sum, hζ.pow_eq_one, sub_self]
+end
+
+/-- If `1 < k`, then `ζ ^ k.pred = -(∑ i in range k.pred, ζ ^ i)`. -/
+lemma pow_sub_one_eq [is_domain R] {ζ : R} (hζ : is_primitive_root ζ k) (hk : 1 < k) :
+  ζ ^ k.pred = -(∑ i in range k.pred, ζ ^ i) :=
+by rw [eq_neg_iff_add_eq_zero, add_comm, ←sum_range_succ, ←nat.succ_eq_add_one,
+  nat.succ_pred_eq_of_pos (pos_of_gt hk), hζ.geom_sum_eq_zero hk]
+
+/-- The (additive) monoid equivalence between `zmod k`
+and the powers of a primitive root of unity `ζ`. -/
+def zmod_equiv_zpowers (h : is_primitive_root ζ k) : zmod k ≃+ additive (subgroup.zpowers ζ) :=
+add_equiv.of_bijective
+  (add_monoid_hom.lift_of_right_inverse (int.cast_add_hom $ zmod k) _ zmod.int_cast_right_inverse
+    ⟨{ to_fun := λ i, additive.of_mul (⟨_, i, rfl⟩ : subgroup.zpowers ζ),
+      map_zero' := by { simp only [zpow_zero], refl },
+      map_add' := by { intros i j, simp only [zpow_add], refl } },
+    (λ i hi,
+    begin
+      simp only [add_monoid_hom.mem_ker, char_p.int_cast_eq_zero_iff (zmod k) k,
+        add_monoid_hom.coe_mk, int.coe_cast_add_hom] at hi ⊢,
+      obtain ⟨i, rfl⟩ := hi,
+      simp only [zpow_mul, h.pow_eq_one, one_zpow, zpow_coe_nat],
+      refl
+    end)⟩)
+  begin
+    split,
+    { rw injective_iff_map_eq_zero,
+      intros i hi,
+      rw subtype.ext_iff at hi,
+      have := (h.zpow_eq_one_iff_dvd _).mp hi,
+      rw [← (char_p.int_cast_eq_zero_iff (zmod k) k _).mpr this, eq_comm],
+      exact zmod.int_cast_right_inverse i },
+    { rintro ⟨ξ, i, rfl⟩,
+      refine ⟨int.cast_add_hom _ i, _⟩,
+      rw [add_monoid_hom.lift_of_right_inverse_comp_apply],
+      refl }
+  end
+
+@[simp] lemma zmod_equiv_zpowers_apply_coe_int (i : ℤ) :
+  h.zmod_equiv_zpowers i = additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ) :=
+add_monoid_hom.lift_of_right_inverse_comp_apply _ _ zmod.int_cast_right_inverse _ _
+
+@[simp] lemma zmod_equiv_zpowers_apply_coe_nat (i : ℕ) :
+  h.zmod_equiv_zpowers i = additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ) :=
+begin
+  have : (i : zmod k) = (i : ℤ), by norm_cast,
+  simp only [this, zmod_equiv_zpowers_apply_coe_int, zpow_coe_nat],
+  refl
+end
+
+@[simp] lemma zmod_equiv_zpowers_symm_apply_zpow (i : ℤ) :
+  h.zmod_equiv_zpowers.symm (additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ)) = i :=
+by rw [← h.zmod_equiv_zpowers.symm_apply_apply i, zmod_equiv_zpowers_apply_coe_int]
+
+@[simp] lemma zmod_equiv_zpowers_symm_apply_zpow' (i : ℤ) :
+  h.zmod_equiv_zpowers.symm ⟨ζ ^ i, i, rfl⟩ = i :=
+h.zmod_equiv_zpowers_symm_apply_zpow i
+
+@[simp] lemma zmod_equiv_zpowers_symm_apply_pow (i : ℕ) :
+  h.zmod_equiv_zpowers.symm (additive.of_mul (⟨ζ ^ i, i, rfl⟩ : subgroup.zpowers ζ)) = i :=
+by rw [← h.zmod_equiv_zpowers.symm_apply_apply i, zmod_equiv_zpowers_apply_coe_nat]
+
+@[simp] lemma zmod_equiv_zpowers_symm_apply_pow' (i : ℕ) :
+  h.zmod_equiv_zpowers.symm ⟨ζ ^ i, i, rfl⟩ = i :=
+h.zmod_equiv_zpowers_symm_apply_pow i
+
+variables [is_domain R]
+
+lemma zpowers_eq {k : ℕ+} {ζ : Rˣ} (h : is_primitive_root ζ k) :
+  subgroup.zpowers ζ = roots_of_unity k R :=
+begin
+  apply set_like.coe_injective,
+  haveI F : fintype (subgroup.zpowers ζ) := fintype.of_equiv _ (h.zmod_equiv_zpowers).to_equiv,
+  refine @set.eq_of_subset_of_card_le Rˣ (subgroup.zpowers ζ) (roots_of_unity k R)
+    F (roots_of_unity.fintype R k)
+    (subgroup.zpowers_le_of_mem $ show ζ ∈ roots_of_unity k R, from h.pow_eq_one) _,
+  calc fintype.card (roots_of_unity k R)
+      ≤ k                                 : card_roots_of_unity R k
+  ... = fintype.card (zmod k)             : (zmod.card k).symm
+  ... = fintype.card (subgroup.zpowers ζ) : fintype.card_congr (h.zmod_equiv_zpowers).to_equiv
+end
+
+lemma eq_pow_of_mem_roots_of_unity {k : ℕ+} {ζ ξ : Rˣ}
+  (h : is_primitive_root ζ k) (hξ : ξ ∈ roots_of_unity k R) :
+  ∃ (i : ℕ) (hi : i < k), ζ ^ i = ξ :=
+begin
+  obtain ⟨n, rfl⟩ : ∃ n : ℤ, ζ ^ n = ξ, by rwa [← h.zpowers_eq] at hξ,
+  have hk0 : (0 : ℤ) < k := by exact_mod_cast k.pos,
+  let i := n % k,
+  have hi0 : 0 ≤ i := int.mod_nonneg _ (ne_of_gt hk0),
+  lift i to ℕ using hi0 with i₀ hi₀,
+  refine ⟨i₀, _, _⟩,
+  { zify, rw [hi₀], exact int.mod_lt_of_pos _ hk0 },
+  { have aux := h.zpow_eq_one, rw [← coe_coe] at aux,
+    rw [← zpow_coe_nat, hi₀, ← int.mod_add_div n k, zpow_add, zpow_mul,
+        aux, one_zpow, mul_one] }
+end
+
+lemma eq_pow_of_pow_eq_one {k : ℕ} {ζ ξ : R}
+  (h : is_primitive_root ζ k) (hξ : ξ ^ k = 1) (h0 : 0 < k) :
+  ∃ i < k, ζ ^ i = ξ :=
+begin
+  lift ζ to Rˣ using h.is_unit h0,
+  lift ξ to Rˣ using is_unit_of_pow_eq_one hξ h0.ne',
+  lift k to ℕ+ using h0,
+  simp only [← units.coe_pow, ← units.ext_iff],
+  rw coe_units_iff at h,
+  apply h.eq_pow_of_mem_roots_of_unity,
+  rw [mem_roots_of_unity, units.ext_iff, units.coe_pow, hξ, units.coe_one]
+end
+
+lemma is_primitive_root_iff' {k : ℕ+} {ζ ξ : Rˣ} (h : is_primitive_root ζ k) :
+  is_primitive_root ξ k ↔ ∃ (i < (k : ℕ)) (hi : i.coprime k), ζ ^ i = ξ :=
+begin
+  split,
+  { intro hξ,
+    obtain ⟨i, hik, rfl⟩ := h.eq_pow_of_mem_roots_of_unity hξ.pow_eq_one,
+    rw h.pow_iff_coprime k.pos at hξ,
+    exact ⟨i, hik, hξ, rfl⟩ },
+  { rintro ⟨i, -, hi, rfl⟩, exact h.pow_of_coprime i hi }
+end
+
+lemma is_primitive_root_iff {k : ℕ} {ζ ξ : R} (h : is_primitive_root ζ k) (h0 : 0 < k) :
+  is_primitive_root ξ k ↔ ∃ (i < k) (hi : i.coprime k), ζ ^ i = ξ :=
+begin
+  split,
+  { intro hξ,
+    obtain ⟨i, hik, rfl⟩ := h.eq_pow_of_pow_eq_one hξ.pow_eq_one h0,
+    rw h.pow_iff_coprime h0 at hξ,
+    exact ⟨i, hik, hξ, rfl⟩ },
+  { rintro ⟨i, -, hi, rfl⟩, exact h.pow_of_coprime i hi }
+end
+
+lemma card_roots_of_unity' {n : ℕ+} (h : is_primitive_root ζ n) :
+  fintype.card (roots_of_unity n R) = n :=
+begin
+  let e := h.zmod_equiv_zpowers,
+  haveI F : fintype (subgroup.zpowers ζ) := fintype.of_equiv _ e.to_equiv,
+  calc fintype.card (roots_of_unity n R)
+      = fintype.card (subgroup.zpowers ζ) : fintype.card_congr $ by rw h.zpowers_eq
+  ... = fintype.card (zmod n)             : fintype.card_congr e.to_equiv.symm
+  ... = n                                 : zmod.card n
+end
+
+lemma card_roots_of_unity {ζ : R} {n : ℕ+} (h : is_primitive_root ζ n) :
+  fintype.card (roots_of_unity n R) = n :=
+begin
+  obtain ⟨ζ, hζ⟩ := h.is_unit n.pos,
+  rw [← hζ, is_primitive_root.coe_units_iff] at h,
+  exact h.card_roots_of_unity'
+end
+
+/-- The cardinality of the multiset `nth_roots ↑n (1 : R)` is `n`
+if there is a primitive root of unity in `R`. -/
+lemma card_nth_roots {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
+  (nth_roots n (1 : R)).card = n :=
+begin
+  cases nat.eq_zero_or_pos n with hzero hpos,
+  { simp only [hzero, multiset.card_zero, nth_roots_zero] },
+  rw eq_iff_le_not_lt,
+  use card_nth_roots n 1,
+  { rw [not_lt],
+    have hcard : fintype.card {x // x ∈ nth_roots n (1 : R)}
+      ≤ (nth_roots n (1 : R)).attach.card := multiset.card_le_of_le (multiset.dedup_le _),
+    rw multiset.card_attach at hcard,
+    rw ← pnat.to_pnat'_coe hpos at hcard h ⊢,
+    set m := nat.to_pnat' n,
+    rw [← fintype.card_congr (roots_of_unity_equiv_nth_roots R m), card_roots_of_unity h] at hcard,
+    exact hcard }
+end
+
+/-- The multiset `nth_roots ↑n (1 : R)` has no repeated elements
+if there is a primitive root of unity in `R`. -/
+lemma nth_roots_nodup {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) : (nth_roots n (1 : R)).nodup :=
+begin
+  cases nat.eq_zero_or_pos n with hzero hpos,
+  { simp only [hzero, multiset.nodup_zero, nth_roots_zero] },
+  apply (@multiset.dedup_eq_self R _ _).1,
+  rw eq_iff_le_not_lt,
+  split,
+  { exact multiset.dedup_le (nth_roots n (1 : R)) },
+  { by_contra ha,
+    replace ha := multiset.card_lt_of_lt ha,
+    rw card_nth_roots h at ha,
+    have hrw : (nth_roots n (1 : R)).dedup.card =
+      fintype.card {x // x ∈ (nth_roots n (1 : R))},
+    { set fs := (⟨(nth_roots n (1 : R)).dedup, multiset.nodup_dedup _⟩ : finset R),
+      rw [← finset.card_mk, ← fintype.card_of_subtype fs _],
+      intro x,
+      simp only [multiset.mem_dedup, finset.mem_mk] },
+    rw ← pnat.to_pnat'_coe hpos at h hrw ha,
+    set m := nat.to_pnat' n,
+    rw [hrw, ← fintype.card_congr (roots_of_unity_equiv_nth_roots R m),
+        card_roots_of_unity h] at ha,
+    exact nat.lt_asymm ha ha }
+end
+
+@[simp] lemma card_nth_roots_finset {ζ : R} {n : ℕ} (h : is_primitive_root ζ n) :
+  (nth_roots_finset n R).card = n :=
+by rw [nth_roots_finset, ← multiset.to_finset_eq (nth_roots_nodup h), card_mk, h.card_nth_roots]
+
+open_locale nat
+
+/-- If an integral domain has a primitive `k`-th root of unity, then it has `φ k` of them. -/
+lemma card_primitive_roots {ζ : R} {k : ℕ} (h : is_primitive_root ζ k) :
+  (primitive_roots k R).card = φ k :=
+begin
+  by_cases h0 : k = 0,
+  { simp [h0], },
+  symmetry,
+  refine finset.card_congr (λ i _, ζ ^ i) _ _ _,
+  { simp only [true_and, and_imp, mem_filter, mem_range, mem_univ],
+    rintro i - hi,
+    rw mem_primitive_roots (nat.pos_of_ne_zero h0),
+    exact h.pow_of_coprime i hi.symm },
+  { simp only [true_and, and_imp, mem_filter, mem_range, mem_univ],
+    rintro i j hi - hj - H,
+    exact h.pow_inj hi hj H },
+  { simp only [exists_prop, true_and, mem_filter, mem_range, mem_univ],
+    intros ξ hξ,
+    rw [mem_primitive_roots (nat.pos_of_ne_zero h0),
+      h.is_primitive_root_iff (nat.pos_of_ne_zero h0)] at hξ,
+    rcases hξ with ⟨i, hin, hi, H⟩,
+    exact ⟨i, ⟨hin, hi.symm⟩, H⟩ }
+end
+
+/-- The sets `primitive_roots k R` are pairwise disjoint. -/
+lemma disjoint {k l : ℕ} (h : k ≠ l) :
+  disjoint (primitive_roots k R) (primitive_roots l R) :=
+finset.disjoint_left.2 $ λ z hk hl, h $ (is_primitive_root_of_mem_primitive_roots hk).unique $
+  is_primitive_root_of_mem_primitive_roots hl
+
+/-- `nth_roots n` as a `finset` is equal to the union of `primitive_roots i R` for `i ∣ n`
+if there is a primitive root of unity in `R`.
+This holds for any `nat`, not just `pnat`, see `nth_roots_one_eq_bUnion_primitive_roots`. -/
+lemma nth_roots_one_eq_bUnion_primitive_roots' {ζ : R} {n : ℕ+} (h : is_primitive_root ζ n) :
+  nth_roots_finset n R = (nat.divisors ↑n).bUnion (λ i, (primitive_roots i R)) :=
+begin
+  symmetry,
+  apply finset.eq_of_subset_of_card_le,
+  { intros x,
+    simp only [nth_roots_finset, ← multiset.to_finset_eq (nth_roots_nodup h),
+      exists_prop, finset.mem_bUnion, finset.mem_filter, finset.mem_range, mem_nth_roots,
+      finset.mem_mk, nat.mem_divisors, and_true, ne.def, pnat.ne_zero, pnat.pos, not_false_iff],
+    rintro ⟨a, ⟨d, hd⟩, ha⟩,
+    have hazero : 0 < a,
+    { contrapose! hd with ha0,
+      simp only [nonpos_iff_eq_zero, zero_mul, *] at *,
+      exact n.ne_zero },
+    rw mem_primitive_roots hazero at ha,
+    rw [hd, pow_mul, ha.pow_eq_one, one_pow] },
+  { apply le_of_eq,
+    rw [h.card_nth_roots_finset, finset.card_bUnion],
+    { nth_rewrite_lhs 0 ← nat.sum_totient n,
+      refine sum_congr rfl _,
+      simp only [nat.mem_divisors],
+      rintro k ⟨⟨d, hd⟩, -⟩,
+      rw mul_comm at hd,
+      rw (h.pow n.pos hd).card_primitive_roots },
+    { intros i hi j hj hdiff,
+      exact disjoint hdiff } }
+end
+
+/-- `nth_roots n` as a `finset` is equal to the union of `primitive_roots i R` for `i ∣ n`
+if there is a primitive root of unity in `R`. -/
+lemma nth_roots_one_eq_bUnion_primitive_roots {ζ : R} {n : ℕ}
+  (h : is_primitive_root ζ n) :
+  nth_roots_finset n R = (nat.divisors n).bUnion (λ i, (primitive_roots i R)) :=
+begin
+  by_cases hn : n = 0,
+  { simp [hn], },
+  exact @nth_roots_one_eq_bUnion_primitive_roots' _ _ _ _ ⟨n, nat.pos_of_ne_zero hn⟩ h
+end
+
+end is_domain
+
+section automorphisms
+
+variables {S} [comm_ring S] [is_domain S] {μ : S} {n : ℕ+} (hμ : is_primitive_root μ n)
+          (R) [comm_ring R] [algebra R S]
+
+/-- The `monoid_hom` that takes an automorphism to the power of μ that μ gets mapped to under it. -/
+noncomputable def aut_to_pow : (S ≃ₐ[R] S) →* (zmod n)ˣ :=
+let μ' := hμ.to_roots_of_unity in
+have ho : order_of μ' = n :=
+  by rw [hμ.eq_order_of, ←hμ.coe_to_roots_of_unity_coe, order_of_units, order_of_subgroup],
+monoid_hom.to_hom_units
+{ to_fun := λ σ, (map_root_of_unity_eq_pow_self σ.to_alg_hom μ').some,
+  map_one' := begin
+    generalize_proofs h1,
+    have h := h1.some_spec,
+    dsimp only [alg_equiv.one_apply, alg_equiv.to_ring_equiv_eq_coe, ring_equiv.to_ring_hom_eq_coe,
+                ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv] at *,
+    replace h : μ' = μ' ^ h1.some := roots_of_unity.coe_injective
+                 (by simpa only [roots_of_unity.coe_pow] using h),
+    rw ←pow_one μ' at h {occs := occurrences.pos [1]},
+    rw [←@nat.cast_one $ zmod n, zmod.nat_coe_eq_nat_coe_iff, ←ho, ←pow_eq_pow_iff_modeq μ', h]
+  end,
+  map_mul' := begin
+    generalize_proofs hxy' hx' hy',
+    have hxy := hxy'.some_spec,
+    have hx := hx'.some_spec,
+    have hy := hy'.some_spec,
+    dsimp only [alg_equiv.to_ring_equiv_eq_coe, ring_equiv.to_ring_hom_eq_coe,
+                ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv, alg_equiv.mul_apply] at *,
+    replace hxy : x (↑μ' ^ hy'.some) = ↑μ' ^ hxy'.some := hy ▸ hxy,
+    rw x.map_pow at hxy,
+    replace hxy : ((μ' : S) ^ hx'.some) ^ hy'.some = μ' ^ hxy'.some := hx ▸ hxy,
+    rw ←pow_mul at hxy,
+    replace hxy : μ' ^ (hx'.some * hy'.some) = μ' ^ hxy'.some := roots_of_unity.coe_injective
+                                           (by simpa only [roots_of_unity.coe_pow] using hxy),
+    rw [←nat.cast_mul, zmod.nat_coe_eq_nat_coe_iff, ←ho, ←pow_eq_pow_iff_modeq μ', hxy]
+  end }
+
+-- We are not using @[simps] in aut_to_pow to avoid a timeout.
+lemma coe_aut_to_pow_apply (f : S ≃ₐ[R] S) : (aut_to_pow R hμ f : zmod n) =
+  ((map_root_of_unity_eq_pow_self f hμ.to_roots_of_unity).some : zmod n) := rfl
+
+@[simp] lemma aut_to_pow_spec (f : S ≃ₐ[R] S) :
+  μ ^ (hμ.aut_to_pow R f : zmod n).val = f μ :=
+begin
+  rw is_primitive_root.coe_aut_to_pow_apply,
+  generalize_proofs h,
+  have := h.some_spec,
+  dsimp only [alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom] at this,
+  refine (_ : ↑hμ.to_roots_of_unity ^ _ = _).trans this.symm,
+  rw [←roots_of_unity.coe_pow, ←roots_of_unity.coe_pow],
+  congr' 1,
+  rw [pow_eq_pow_iff_modeq, ←order_of_subgroup, ←order_of_units, hμ.coe_to_roots_of_unity_coe,
+      ←hμ.eq_order_of, zmod.val_nat_cast],
+  exact nat.mod_modeq _ _
+end
+
+end automorphisms
+
+end is_primitive_root
diff --git a/src/ring_theory/roots_of_unity/complex.lean b/src/ring_theory/roots_of_unity/complex.lean
new file mode 100644
index 0000000000000..d5841c9d4726b
--- /dev/null
+++ b/src/ring_theory/roots_of_unity/complex.lean
@@ -0,0 +1,176 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+import analysis.special_functions.complex.log
+import ring_theory.roots_of_unity.basic
+
+/-!
+# Complex roots of unity
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we show that the `n`-th complex roots of unity
+are exactly the complex numbers `e ^ (2 * real.pi * complex.I * (i / n))` for `i ∈ finset.range n`.
+
+## Main declarations
+
+* `complex.mem_roots_of_unity`: the complex `n`-th roots of unity are exactly the
+  complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`.
+* `complex.card_roots_of_unity`: the number of `n`-th roots of unity is exactly `n`.
+
+-/
+
+namespace complex
+
+open polynomial real
+open_locale nat real
+
+lemma is_primitive_root_exp_of_coprime (i n : ℕ) (h0 : n ≠ 0) (hi : i.coprime n) :
+  is_primitive_root (exp (2 * π * I * (i / n))) n :=
+begin
+  rw is_primitive_root.iff_def,
+  simp only [← exp_nat_mul, exp_eq_one_iff],
+  have hn0 : (n : ℂ) ≠ 0, by exact_mod_cast h0,
+  split,
+  { use i,
+    field_simp [hn0, mul_comm (i : ℂ), mul_comm (n : ℂ)] },
+  { simp only [hn0, mul_right_comm _ _ ↑n, mul_left_inj' two_pi_I_ne_zero, ne.def, not_false_iff,
+      mul_comm _ (i : ℂ), ← mul_assoc _ (i : ℂ), exists_imp_distrib] with field_simps,
+    norm_cast,
+    rintro l k hk,
+    have : n ∣ i * l,
+    { rw [← int.coe_nat_dvd, hk], apply dvd_mul_left },
+    exact hi.symm.dvd_of_dvd_mul_left this }
+end
+
+lemma is_primitive_root_exp (n : ℕ) (h0 : n ≠ 0) : is_primitive_root (exp (2 * π * I / n)) n :=
+by simpa only [nat.cast_one, one_div]
+  using is_primitive_root_exp_of_coprime 1 n h0 n.coprime_one_left
+
+lemma is_primitive_root_iff (ζ : ℂ) (n : ℕ) (hn : n ≠ 0) :
+  is_primitive_root ζ n ↔ (∃ (i < (n : ℕ)) (hi : i.coprime n), exp (2 * π * I * (i / n)) = ζ) :=
+begin
+  have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast hn,
+  split, swap,
+  { rintro ⟨i, -, hi, rfl⟩, exact is_primitive_root_exp_of_coprime i n hn hi },
+  intro h,
+  obtain ⟨i, hi, rfl⟩ :=
+    (is_primitive_root_exp n hn).eq_pow_of_pow_eq_one h.pow_eq_one (nat.pos_of_ne_zero hn),
+  refine ⟨i, hi, ((is_primitive_root_exp n hn).pow_iff_coprime (nat.pos_of_ne_zero hn) i).mp h, _⟩,
+  rw [← exp_nat_mul],
+  congr' 1,
+  field_simp [hn0, mul_comm (i : ℂ)]
+end
+
+/-- The complex `n`-th roots of unity are exactly the
+complex numbers of the form `e ^ (2 * real.pi * complex.I * (i / n))` for some `i < n`. -/
+lemma mem_roots_of_unity (n : ℕ+) (x : units ℂ) :
+  x ∈ roots_of_unity n ℂ ↔ (∃ i < (n : ℕ), exp (2 * π * I * (i / n)) = x) :=
+begin
+  rw [mem_roots_of_unity, units.ext_iff, units.coe_pow, units.coe_one],
+  have hn0 : (n : ℂ) ≠ 0 := by exact_mod_cast (n.ne_zero),
+  split,
+  { intro h,
+    obtain ⟨i, hi, H⟩ : ∃ i < (n : ℕ), exp (2 * π * I / n) ^ i = x,
+    { simpa only using (is_primitive_root_exp n n.ne_zero).eq_pow_of_pow_eq_one h n.pos },
+    refine ⟨i, hi, _⟩,
+    rw [← H, ← exp_nat_mul],
+    congr' 1,
+    field_simp [hn0, mul_comm (i : ℂ)] },
+  { rintro ⟨i, hi, H⟩,
+    rw [← H, ← exp_nat_mul, exp_eq_one_iff],
+    use i,
+    field_simp [hn0, mul_comm ((n : ℕ) : ℂ), mul_comm (i : ℂ)] }
+end
+
+lemma card_roots_of_unity (n : ℕ+) : fintype.card (roots_of_unity n ℂ) = n :=
+(is_primitive_root_exp n n.ne_zero).card_roots_of_unity
+
+lemma card_primitive_roots (k : ℕ) : (primitive_roots k ℂ).card = φ k :=
+begin
+  by_cases h : k = 0,
+  { simp [h] },
+  exact (is_primitive_root_exp k h).card_primitive_roots,
+end
+
+end complex
+
+lemma is_primitive_root.norm'_eq_one {ζ : ℂ} {n : ℕ} (h : is_primitive_root ζ n) (hn : n ≠ 0) :
+  ‖ζ‖ = 1 := complex.norm_eq_one_of_pow_eq_one h.pow_eq_one hn
+
+lemma is_primitive_root.nnnorm_eq_one {ζ : ℂ} {n : ℕ} (h : is_primitive_root ζ n) (hn : n ≠ 0) :
+  ‖ζ‖₊ = 1 := subtype.ext $ h.norm'_eq_one hn
+
+lemma is_primitive_root.arg_ext {n m : ℕ} {ζ μ : ℂ} (hζ : is_primitive_root ζ n)
+  (hμ : is_primitive_root μ m) (hn : n ≠ 0) (hm : m ≠ 0) (h : ζ.arg = μ.arg) : ζ = μ :=
+complex.ext_abs_arg ((hζ.norm'_eq_one hn).trans (hμ.norm'_eq_one hm).symm) h
+
+lemma is_primitive_root.arg_eq_zero_iff {n : ℕ} {ζ : ℂ} (hζ : is_primitive_root ζ n)
+  (hn : n ≠ 0) : ζ.arg = 0 ↔ ζ = 1 :=
+⟨λ h, hζ.arg_ext is_primitive_root.one hn one_ne_zero (h.trans complex.arg_one.symm),
+ λ h, h.symm ▸ complex.arg_one⟩
+
+lemma is_primitive_root.arg_eq_pi_iff {n : ℕ} {ζ : ℂ} (hζ : is_primitive_root ζ n)
+  (hn : n ≠ 0) : ζ.arg = real.pi ↔ ζ = -1 :=
+⟨λ h, hζ.arg_ext (is_primitive_root.neg_one 0 two_ne_zero.symm) hn two_ne_zero
+      (h.trans complex.arg_neg_one.symm), λ h, h.symm ▸ complex.arg_neg_one⟩
+
+lemma is_primitive_root.arg {n : ℕ} {ζ : ℂ} (h : is_primitive_root ζ n) (hn : n ≠ 0) :
+  ∃ i : ℤ, ζ.arg = i / n * (2 * real.pi) ∧ is_coprime i n ∧ i.nat_abs < n :=
+begin
+  rw complex.is_primitive_root_iff _ _ hn at h,
+  obtain ⟨i, h, hin, rfl⟩ := h,
+  rw [mul_comm, ←mul_assoc, complex.exp_mul_I],
+  refine ⟨if i * 2 ≤ n then i else i - n, _, _, _⟩,
+  work_on_goal 2
+  { replace hin := nat.is_coprime_iff_coprime.mpr hin,
+    split_ifs with _,
+    { exact hin },
+    { convert hin.add_mul_left_left (-1),
+      rw [mul_neg_one, sub_eq_add_neg] } },
+  work_on_goal 2
+  { split_ifs with h₂,
+    { exact_mod_cast h },
+    suffices : (i - n : ℤ).nat_abs = n - i,
+    { rw this,
+      apply tsub_lt_self hn.bot_lt,
+      contrapose! h₂,
+      rw [nat.eq_zero_of_le_zero h₂, zero_mul],
+      exact zero_le _ },
+    rw [←int.nat_abs_neg, neg_sub, int.nat_abs_eq_iff],
+    exact or.inl (int.coe_nat_sub h.le).symm },
+  split_ifs with h₂,
+  { convert complex.arg_cos_add_sin_mul_I _,
+    { push_cast },
+    { push_cast },
+    field_simp [hn],
+    refine ⟨(neg_lt_neg real.pi_pos).trans_le _, _⟩,
+    { rw neg_zero,
+      exact mul_nonneg (mul_nonneg i.cast_nonneg $ by simp [real.pi_pos.le]) (by simp) },
+    rw [←mul_rotate', mul_div_assoc],
+    rw ←mul_one n at h₂,
+    exact mul_le_of_le_one_right real.pi_pos.le
+      ((div_le_iff' $ by exact_mod_cast (pos_of_gt h)).mpr $ by exact_mod_cast h₂) },
+  rw [←complex.cos_sub_two_pi, ←complex.sin_sub_two_pi],
+  convert complex.arg_cos_add_sin_mul_I _,
+  { push_cast,
+    rw [←sub_one_mul, sub_div, div_self],
+    exact_mod_cast hn },
+  { push_cast,
+    rw [←sub_one_mul, sub_div, div_self],
+    exact_mod_cast hn },
+  field_simp [hn],
+  refine ⟨_, le_trans _ real.pi_pos.le⟩,
+  work_on_goal 2
+  { rw [mul_div_assoc],
+    exact mul_nonpos_of_nonpos_of_nonneg (sub_nonpos.mpr $ by exact_mod_cast h.le)
+      (div_nonneg (by simp [real.pi_pos.le]) $ by simp) },
+  rw [←mul_rotate', mul_div_assoc, neg_lt, ←mul_neg, mul_lt_iff_lt_one_right real.pi_pos,
+      ←neg_div, ←neg_mul, neg_sub, div_lt_iff, one_mul, sub_mul, sub_lt_comm, ←mul_sub_one],
+  norm_num,
+  exact_mod_cast not_le.mp h₂,
+  { exact (nat.cast_pos.mpr hn.bot_lt) }
+end
diff --git a/src/ring_theory/roots_of_unity/minpoly.lean b/src/ring_theory/roots_of_unity/minpoly.lean
new file mode 100644
index 0000000000000..4c5cf407e5a63
--- /dev/null
+++ b/src/ring_theory/roots_of_unity/minpoly.lean
@@ -0,0 +1,236 @@
+/-
+Copyright (c) 2020 Riccardo Brasca. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Riccardo Brasca, Johan Commelin
+-/
+
+import ring_theory.roots_of_unity.basic
+import field_theory.minpoly.is_integrally_closed
+
+/-!
+# Minimal polynomial of roots of unity
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We gather several results about minimal polynomial of root of unity.
+
+## Main results
+
+* `is_primitive_root.totient_le_degree_minpoly`: The degree of the minimal polynomial of a `n`-th
+  primitive root of unity is at least `totient n`.
+
+-/
+
+open minpoly polynomial
+
+open_locale polynomial
+
+namespace is_primitive_root
+
+section comm_ring
+variables {n : ℕ} {K : Type*} [comm_ring K] {μ : K} (h : is_primitive_root μ n) (hpos : 0 < n)
+
+include n μ h hpos
+
+/--`μ` is integral over `ℤ`. -/
+lemma is_integral : is_integral ℤ μ :=
+begin
+  use (X ^ n - 1),
+  split,
+  { exact (monic_X_pow_sub_C 1 (ne_of_lt hpos).symm) },
+  { simp only [((is_primitive_root.iff_def μ n).mp h).left, eval₂_one, eval₂_X_pow, eval₂_sub,
+      sub_self] }
+end
+
+section is_domain
+
+variables [is_domain K] [char_zero K]
+
+omit hpos
+
+/--The minimal polynomial of a root of unity `μ` divides `X ^ n - 1`. -/
+lemma minpoly_dvd_X_pow_sub_one : minpoly ℤ μ ∣ X ^ n - 1 :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hpos,
+  { simp },
+  letI : is_integrally_closed ℤ := gcd_monoid.to_is_integrally_closed,
+  apply minpoly.is_integrally_closed_dvd (is_integral h hpos),
+  simp only [((is_primitive_root.iff_def μ n).mp h).left, aeval_X_pow, eq_int_cast,
+  int.cast_one, aeval_one, alg_hom.map_sub, sub_self]
+end
+
+/-- The reduction modulo `p` of the minimal polynomial of a root of unity `μ` is separable. -/
+lemma separable_minpoly_mod {p : ℕ} [fact p.prime] (hdiv : ¬p ∣ n) :
+  separable (map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ)) :=
+begin
+  have hdvd : (map (int.cast_ring_hom (zmod p))
+    (minpoly ℤ μ)) ∣ X ^ n - 1,
+  { simpa [polynomial.map_pow, map_X, polynomial.map_one, polynomial.map_sub] using
+      ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p)))
+        (minpoly_dvd_X_pow_sub_one h) },
+  refine separable.of_dvd (separable_X_pow_sub_C 1 _ one_ne_zero) hdvd,
+  by_contra hzero,
+  exact hdiv ((zmod.nat_coe_zmod_eq_zero_iff_dvd n p).1 hzero)
+end
+
+/-- The reduction modulo `p` of the minimal polynomial of a root of unity `μ` is squarefree. -/
+lemma squarefree_minpoly_mod {p : ℕ} [fact p.prime] (hdiv : ¬ p ∣ n) :
+  squarefree (map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ)) :=
+(separable_minpoly_mod h hdiv).squarefree
+
+/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
+`μ ^ p`, where `p` is a natural number that does not divide `n`. Then `P` divides `expand ℤ p Q`. -/
+lemma minpoly_dvd_expand {p : ℕ} (hdiv : ¬ p ∣ n) : minpoly ℤ μ ∣ expand ℤ p (minpoly ℤ (μ ^ p)) :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hpos,
+  { simp * at *, },
+  letI : is_integrally_closed ℤ := gcd_monoid.to_is_integrally_closed,
+  refine minpoly.is_integrally_closed_dvd (h.is_integral hpos) _,
+  { rw [aeval_def, coe_expand, ← comp, eval₂_eq_eval_map, map_comp, polynomial.map_pow, map_X,
+        eval_comp, eval_pow, eval_X, ← eval₂_eq_eval_map, ← aeval_def],
+    exact minpoly.aeval _ _ }
+end
+
+/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
+`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `Q ^ p` modulo `p`. -/
+lemma minpoly_dvd_pow_mod {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
+  map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ) ∣
+  map (int.cast_ring_hom (zmod p)) (minpoly ℤ (μ ^ p)) ^ p :=
+begin
+  set Q := minpoly ℤ (μ ^ p),
+  have hfrob : map (int.cast_ring_hom (zmod p)) Q ^ p =
+    map (int.cast_ring_hom (zmod p)) (expand ℤ p Q),
+  by rw [← zmod.expand_card, map_expand],
+  rw [hfrob],
+  apply ring_hom.map_dvd (map_ring_hom (int.cast_ring_hom (zmod p))),
+  exact minpoly_dvd_expand h hdiv
+end
+
+/- Let `P` be the minimal polynomial of a root of unity `μ` and `Q` be the minimal polynomial of
+`μ ^ p`, where `p` is a prime that does not divide `n`. Then `P` divides `Q` modulo `p`. -/
+lemma minpoly_dvd_mod_p {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
+  map (int.cast_ring_hom (zmod p)) (minpoly ℤ μ) ∣
+  map (int.cast_ring_hom (zmod p)) (minpoly ℤ (μ ^ p)) :=
+(unique_factorization_monoid.dvd_pow_iff_dvd_of_squarefree (squarefree_minpoly_mod h
+  hdiv) hprime.1.ne_zero).1 (minpoly_dvd_pow_mod h hdiv)
+
+/-- If `p` is a prime that does not divide `n`,
+then the minimal polynomials of a primitive `n`-th root of unity `μ`
+and of `μ ^ p` are the same. -/
+lemma minpoly_eq_pow {p : ℕ} [hprime : fact p.prime] (hdiv : ¬ p ∣ n) :
+  minpoly ℤ μ = minpoly ℤ (μ ^ p) :=
+begin
+  classical,
+  by_cases hn : n = 0, { simp * at *, },
+  have hpos := nat.pos_of_ne_zero hn,
+  by_contra hdiff,
+  set P := minpoly ℤ μ,
+  set Q := minpoly ℤ (μ ^ p),
+  have Pmonic : P.monic := minpoly.monic (h.is_integral hpos),
+  have Qmonic : Q.monic := minpoly.monic ((h.pow_of_prime hprime.1 hdiv).is_integral hpos),
+  have Pirr : irreducible P := minpoly.irreducible (h.is_integral hpos),
+  have Qirr : irreducible Q :=
+    minpoly.irreducible ((h.pow_of_prime hprime.1 hdiv).is_integral hpos),
+  have PQprim : is_primitive (P * Q) := Pmonic.is_primitive.mul Qmonic.is_primitive,
+  have prod : P * Q ∣ X ^ n - 1,
+  { rw [(is_primitive.int.dvd_iff_map_cast_dvd_map_cast (P * Q) (X ^ n - 1) PQprim
+      (monic_X_pow_sub_C (1 : ℤ) (ne_of_gt hpos)).is_primitive), polynomial.map_mul],
+    refine is_coprime.mul_dvd _ _ _,
+    { have aux := is_primitive.int.irreducible_iff_irreducible_map_cast Pmonic.is_primitive,
+      refine (dvd_or_coprime _ _ (aux.1 Pirr)).resolve_left _,
+      rw map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Pmonic,
+      intro hdiv,
+      refine hdiff (eq_of_monic_of_associated Pmonic Qmonic _),
+      exact associated_of_dvd_dvd hdiv (Pirr.dvd_symm Qirr hdiv) },
+    { apply (map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Pmonic).2,
+      exact minpoly_dvd_X_pow_sub_one h },
+    { apply (map_dvd_map (int.cast_ring_hom ℚ) int.cast_injective Qmonic).2,
+      exact minpoly_dvd_X_pow_sub_one (pow_of_prime h hprime.1 hdiv) } },
+  replace prod := ring_hom.map_dvd ((map_ring_hom (int.cast_ring_hom (zmod p)))) prod,
+  rw [coe_map_ring_hom, polynomial.map_mul, polynomial.map_sub,
+      polynomial.map_one, polynomial.map_pow, map_X] at prod,
+  obtain ⟨R, hR⟩ := minpoly_dvd_mod_p h hdiv,
+  rw [hR, ← mul_assoc, ← polynomial.map_mul, ← sq, polynomial.map_pow] at prod,
+  have habs : map (int.cast_ring_hom (zmod p)) P ^ 2 ∣ map (int.cast_ring_hom (zmod p)) P ^ 2 * R,
+  { use R },
+  replace habs := lt_of_lt_of_le (part_enat.coe_lt_coe.2 one_lt_two)
+    (multiplicity.le_multiplicity_of_pow_dvd (dvd_trans habs prod)),
+  have hfree : squarefree (X ^ n - 1 : (zmod p)[X]),
+  { exact (separable_X_pow_sub_C 1
+          (λ h, hdiv $ (zmod.nat_coe_zmod_eq_zero_iff_dvd n p).1 h) one_ne_zero).squarefree },
+  cases (multiplicity.squarefree_iff_multiplicity_le_one (X ^ n - 1)).1 hfree
+    (map (int.cast_ring_hom (zmod p)) P) with hle hunit,
+  { rw nat.cast_one at habs, exact hle.not_lt habs },
+  { replace hunit := degree_eq_zero_of_is_unit hunit,
+    rw degree_map_eq_of_leading_coeff_ne_zero (int.cast_ring_hom (zmod p)) _ at hunit,
+    { exact (minpoly.degree_pos (is_integral h hpos)).ne' hunit },
+    simp only [Pmonic, eq_int_cast, monic.leading_coeff, int.cast_one, ne.def,
+      not_false_iff, one_ne_zero] }
+end
+
+/-- If `m : ℕ` is coprime with `n`,
+then the minimal polynomials of a primitive `n`-th root of unity `μ`
+and of `μ ^ m` are the same. -/
+lemma minpoly_eq_pow_coprime {m : ℕ} (hcop : nat.coprime m n) :
+  minpoly ℤ μ = minpoly ℤ (μ ^ m) :=
+begin
+  revert n hcop,
+  refine unique_factorization_monoid.induction_on_prime m _ _ _,
+  { intros n hn h,
+    congr,
+    simpa [(nat.coprime_zero_left n).mp hn] using h },
+  { intros u hunit n hcop h,
+    congr,
+    simp [nat.is_unit_iff.mp hunit] },
+  { intros a p ha hprime hind n hcop h,
+    rw hind (nat.coprime.coprime_mul_left hcop) h, clear hind,
+    replace hprime := hprime.nat_prime,
+    have hdiv := (nat.prime.coprime_iff_not_dvd hprime).1 (nat.coprime.coprime_mul_right hcop),
+    haveI := fact.mk hprime,
+    rw [minpoly_eq_pow (h.pow_of_coprime a (nat.coprime.coprime_mul_left hcop)) hdiv],
+    congr' 1,
+    ring_exp }
+end
+
+/-- If `m : ℕ` is coprime with `n`,
+then the minimal polynomial of a primitive `n`-th root of unity `μ`
+has `μ ^ m` as root. -/
+lemma pow_is_root_minpoly {m : ℕ} (hcop : nat.coprime m n) :
+  is_root (map (int.cast_ring_hom K) (minpoly ℤ μ)) (μ ^ m) :=
+by simpa [minpoly_eq_pow_coprime h hcop, eval_map, aeval_def (μ ^ m) _]
+  using minpoly.aeval ℤ (μ ^ m)
+
+/-- `primitive_roots n K` is a subset of the roots of the minimal polynomial of a primitive
+`n`-th root of unity `μ`. -/
+lemma is_roots_of_minpoly [decidable_eq K] : primitive_roots n K ⊆ (map (int.cast_ring_hom K)
+  (minpoly ℤ μ)).roots.to_finset :=
+begin
+  by_cases hn : n = 0, { simp * at *, },
+  have hpos := nat.pos_of_ne_zero hn,
+  intros x hx,
+  obtain ⟨m, hle, hcop, rfl⟩ := (is_primitive_root_iff h hpos).1 ((mem_primitive_roots hpos).1 hx),
+  simpa [multiset.mem_to_finset,
+    mem_roots (map_monic_ne_zero $ minpoly.monic $ is_integral h hpos)]
+    using pow_is_root_minpoly h hcop
+end
+
+/-- The degree of the minimal polynomial of `μ` is at least `totient n`. -/
+lemma totient_le_degree_minpoly : nat.totient n ≤ (minpoly ℤ μ).nat_degree :=
+begin
+  classical,
+  let P : ℤ[X] := minpoly ℤ μ,-- minimal polynomial of `μ`
+  let P_K : K[X] := map (int.cast_ring_hom K) P, -- minimal polynomial of `μ` sent to `K[X]`
+  calc
+  n.totient = (primitive_roots n K).card : h.card_primitive_roots.symm
+        ... ≤ P_K.roots.to_finset.card : finset.card_le_of_subset (is_roots_of_minpoly h)
+        ... ≤ P_K.roots.card : multiset.to_finset_card_le _
+        ... ≤ P_K.nat_degree : card_roots' _
+        ... ≤ P.nat_degree : nat_degree_map_le _ _
+end
+
+end is_domain
+
+end comm_ring
+
+end is_primitive_root
diff --git a/src/ring_theory/simple_module.lean b/src/ring_theory/simple_module.lean
index 1baeee6b8877b..1fee19fed5a38 100644
--- a/src/ring_theory/simple_module.lean
+++ b/src/ring_theory/simple_module.lean
@@ -3,13 +3,15 @@ Copyright (c) 2020 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
-
-import linear_algebra.span
-import order.atoms
+import linear_algebra.isomorphisms
+import order.jordan_holder
 
 /-!
 # Simple Modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
   * `is_simple_module` indicates that a module has no proper submodules
   (the only submodules are `⊥` and `⊤`).
@@ -34,7 +36,7 @@ abbreviation is_simple_module := (is_simple_order (submodule R M))
 
 /-- A module is semisimple when every submodule has a complement, or equivalently, the module
   is a direct sum of simple modules. -/
-abbreviation is_semisimple_module := (is_complemented (submodule R M))
+abbreviation is_semisimple_module := (complemented_lattice (submodule R M))
 
 -- Making this an instance causes the linter to complain of "dangerous instances"
 theorem is_simple_module.nontrivial [is_simple_module R M] : nontrivial M :=
@@ -47,6 +49,9 @@ end⟩⟩
 
 variables {R} {M} {m : submodule R M} {N : Type*} [add_comm_group N] [module R N]
 
+lemma is_simple_module.congr (l : M ≃ₗ[R] N) [is_simple_module R N] : is_simple_module R M :=
+(submodule.order_iso_map_comap l).is_simple_order
+
 theorem is_simple_module_iff_is_atom :
   is_simple_module R m ↔ is_atom m :=
 begin
@@ -55,6 +60,23 @@ begin
   exact submodule.map_subtype.rel_iso m,
 end
 
+theorem is_simple_module_iff_is_coatom :
+  is_simple_module R (M ⧸ m) ↔ is_coatom m :=
+begin
+  rw ← set.is_simple_order_Ici_iff_is_coatom,
+  apply order_iso.is_simple_order_iff,
+  exact submodule.comap_mkq.rel_iso m,
+end
+
+theorem covby_iff_quot_is_simple {A B : submodule R M} (hAB : A ≤ B) :
+  A ⋖ B ↔ is_simple_module R (B ⧸ submodule.comap B.subtype A) :=
+begin
+  set f : submodule R B ≃o set.Iic B := submodule.map_subtype.rel_iso B with hf,
+  rw [covby_iff_coatom_Iic hAB, is_simple_module_iff_is_coatom, ←order_iso.is_coatom_iff f, hf],
+  simp [-order_iso.is_coatom_iff, submodule.map_subtype.rel_iso, submodule.map_comap_subtype,
+    inf_eq_right.2 hAB],
+end
+
 namespace is_simple_module
 
 variable [hm : is_simple_module R m]
@@ -67,7 +89,7 @@ end is_simple_module
 theorem is_semisimple_of_Sup_simples_eq_top
   (h : Sup {m : submodule R M | is_simple_module R m} = ⊤) :
   is_semisimple_module R M :=
-is_complemented_of_Sup_atoms_eq_top (by simp_rw [← h, is_simple_module_iff_is_atom])
+complemented_lattice_of_Sup_atoms_eq_top (by simp_rw [← h, is_simple_module_iff_is_atom])
 
 namespace is_semisimple_module
 
@@ -82,7 +104,7 @@ end
 instance is_semisimple_submodule {m : submodule R M} : is_semisimple_module R m :=
 begin
   have f : submodule R m ≃o set.Iic m := submodule.map_subtype.rel_iso m,
-  exact f.is_complemented_iff.2 is_modular_lattice.is_complemented_Iic,
+  exact f.complemented_lattice_iff.2 is_modular_lattice.complemented_lattice_Iic,
 end
 
 end is_semisimple_module
@@ -131,6 +153,13 @@ theorem bijective_of_ne_zero [is_simple_module R M] [is_simple_module R N]
   function.bijective f :=
 f.bijective_or_eq_zero.resolve_right h
 
+theorem is_coatom_ker_of_surjective [is_simple_module R N] {f : M →ₗ[R] N}
+  (hf : function.surjective f) : is_coatom f.ker :=
+begin
+  rw ←is_simple_module_iff_is_coatom,
+  exact is_simple_module.congr (f.quot_ker_equiv_of_surjective hf)
+end
+
 /-- Schur's Lemma makes the endomorphism ring of a simple module a division ring. -/
 noncomputable instance _root_.module.End.division_ring
   [decidable_eq (module.End R M)] [is_simple_module R M] :
@@ -158,3 +187,15 @@ noncomputable instance _root_.module.End.division_ring
 .. (module.End.ring : ring (module.End R M))}
 
 end linear_map
+
+instance jordan_holder_module : jordan_holder_lattice (submodule R M) :=
+{ is_maximal                            := (⋖),
+  lt_of_is_maximal                      := λ x y, covby.lt,
+  sup_eq_of_is_maximal                  := λ x y z hxz hyz, wcovby.sup_eq hxz.wcovby hyz.wcovby,
+  is_maximal_inf_left_of_is_maximal_sup := λ A B, inf_covby_of_covby_sup_of_covby_sup_left,
+  iso                                   := λ X Y,
+    nonempty $ (X.2 ⧸ X.1.comap X.2.subtype) ≃ₗ[R] Y.2 ⧸ Y.1.comap Y.2.subtype,
+  iso_symm                              := λ A B ⟨f⟩, ⟨f.symm⟩,
+  iso_trans                             := λ A B C ⟨f⟩ ⟨g⟩, ⟨f.trans g⟩,
+  second_iso                            := λ A B h,
+    ⟨by { rw [sup_comm, inf_comm], exact (linear_map.quotient_inf_equiv_sup_quotient B A).symm }⟩}
diff --git a/src/ring_theory/subring/basic.lean b/src/ring_theory/subring/basic.lean
index 57554df96a9d1..4df02ed3ade6b 100644
--- a/src/ring_theory/subring/basic.lean
+++ b/src/ring_theory/subring/basic.lean
@@ -10,6 +10,9 @@ import ring_theory.subsemiring.basic
 /-!
 # Subrings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `R` be a ring. This file defines the "bundled" subring type `subring R`, a type
 whose terms correspond to subrings of `R`. This is the preferred way to talk
 about subrings in mathlib. Unbundled subrings (`s : set R` and `is_subring s`)
@@ -71,12 +74,11 @@ section subring_class
 
 /-- `subring_class S R` states that `S` is a type of subsets `s ⊆ R` that
 are both a multiplicative submonoid and an additive subgroup. -/
-class subring_class (S : Type*) (R : out_param $ Type u) [ring R] [set_like S R]
-  extends subsemiring_class S R :=
-(neg_mem : ∀ {s : S} {a : R}, a ∈ s → -a ∈ s)
+class subring_class (S : Type*) (R : Type u) [ring R] [set_like S R]
+  extends subsemiring_class S R, neg_mem_class S R : Prop
 
 @[priority 100] -- See note [lower instance priority]
-instance subring_class.add_subgroup_class (S : Type*) (R : out_param $ Type u) [set_like S R]
+instance subring_class.add_subgroup_class (S : Type*) (R : Type u) [set_like S R]
   [ring R] [h : subring_class S R] : add_subgroup_class S R :=
 { .. h }
 
@@ -88,52 +90,57 @@ by simp only [← zsmul_one, zsmul_mem, one_mem]
 
 namespace subring_class
 
+@[priority 75]
+instance to_has_int_cast : has_int_cast s :=
+⟨λ n, ⟨n, coe_int_mem s n⟩⟩
+
 /-- A subring of a ring inherits a ring structure -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance to_ring : ring s :=
-{ right_distrib := λ x y z, subtype.eq $ right_distrib x y z,
-  left_distrib := λ x y z, subtype.eq $ left_distrib x y z,
-  .. submonoid_class.to_monoid s, .. add_subgroup_class.to_add_comm_group s }
+subtype.coe_injective.ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 omit hSR
 /-- A subring of a `comm_ring` is a `comm_ring`. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance to_comm_ring {R} [comm_ring R] [set_like S R] [subring_class S R] : comm_ring s :=
 subtype.coe_injective.comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subring of a domain is a domain. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance {R} [ring R] [is_domain R] [set_like S R] [subring_class S R] : is_domain s :=
-{ .. subsemiring_class.nontrivial s, .. subsemiring_class.no_zero_divisors s }
+no_zero_divisors.to_is_domain _
 
 /-- A subring of an `ordered_ring` is an `ordered_ring`. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance to_ordered_ring {R} [ordered_ring R] [set_like S R] [subring_class S R] :
   ordered_ring s :=
 subtype.coe_injective.ordered_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subring of an `ordered_comm_ring` is an `ordered_comm_ring`. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance to_ordered_comm_ring {R} [ordered_comm_ring R] [set_like S R] [subring_class S R] :
   ordered_comm_ring s :=
-subtype.coe_injective.ordered_comm_ring coe rfl rfl
-  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.ordered_comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subring of a `linear_ordered_ring` is a `linear_ordered_ring`. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance to_linear_ordered_ring {R} [linear_ordered_ring R] [set_like S R] [subring_class S R] :
   linear_ordered_ring s :=
-subtype.coe_injective.linear_ordered_ring coe rfl rfl
-  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.linear_ordered_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 /-- A subring of a `linear_ordered_comm_ring` is a `linear_ordered_comm_ring`. -/
 @[priority 75] -- Prefer subclasses of `ring` over subclasses of `subring_class`.
 instance to_linear_ordered_comm_ring {R} [linear_ordered_comm_ring R] [set_like S R]
   [subring_class S R] : linear_ordered_comm_ring s :=
-subtype.coe_injective.linear_ordered_comm_ring coe rfl rfl
-  (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.linear_ordered_comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 include hSR
 
@@ -144,10 +151,8 @@ def subtype (s : S) : s →+* R :=
  .. add_subgroup_class.subtype s }
 
 @[simp] theorem coe_subtype : (subtype s : s → R) = coe := rfl
-@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ((n : s) : R) = n :=
-map_nat_cast (subtype s) n
-@[simp, norm_cast] lemma coe_int_cast (n : ℤ) : ((n : s) : R) = n :=
-(subtype s : s →+* R).map_int_cast n
+@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ((n : s) : R) = n := map_nat_cast (subtype s) n
+@[simp, norm_cast] lemma coe_int_cast (n : ℤ) : ((n : s) : R) = n := map_int_cast (subtype s) n
 
 end subring_class
 
@@ -208,7 +213,7 @@ iff.rfl
 equalities. -/
 protected def copy (S : subring R) (s : set R) (hs : s = ↑S) : subring R :=
 { carrier := s,
-  neg_mem' := hs.symm ▸ S.neg_mem',
+  neg_mem' := λ _, hs.symm ▸ S.neg_mem',
   ..S.to_subsemiring.copy s hs }
 
 @[simp] lemma coe_copy (S : subring R) (s : set R) (hs : s = ↑S) :
@@ -343,9 +348,8 @@ sum_mem h
 
 /-- A subring of a ring inherits a ring structure -/
 instance to_ring : ring s :=
-{ right_distrib := λ x y z, subtype.eq $ right_distrib x y z,
-  left_distrib := λ x y z, subtype.eq $ left_distrib x y z,
-  .. s.to_submonoid.to_monoid, .. s.to_add_subgroup.to_add_comm_group }
+subtype.coe_injective.ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 protected lemma zsmul_mem {x : R} (hx : x ∈ s) (n : ℤ) : n • x ∈ s := zsmul_mem hx n
 
@@ -366,7 +370,8 @@ submonoid_class.coe_pow x n
 
 /-- A subring of a `comm_ring` is a `comm_ring`. -/
 instance to_comm_ring {R} [comm_ring R] (s : subring R) : comm_ring s :=
-{ mul_comm := λ _ _, subtype.eq $ mul_comm _ _, ..subring.to_ring s}
+subtype.coe_injective.comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subring of a non-trivial ring is non-trivial. -/
 instance {R} [ring R] [nontrivial R] (s : subring R) : nontrivial s :=
@@ -378,29 +383,31 @@ s.to_subsemiring.no_zero_divisors
 
 /-- A subring of a domain is a domain. -/
 instance {R} [ring R] [is_domain R] (s : subring R) : is_domain s :=
-{ .. s.nontrivial, .. s.no_zero_divisors, .. s.to_ring }
+no_zero_divisors.to_is_domain _
 
 /-- A subring of an `ordered_ring` is an `ordered_ring`. -/
 instance to_ordered_ring {R} [ordered_ring R] (s : subring R) : ordered_ring s :=
-subtype.coe_injective.ordered_ring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.ordered_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subring of an `ordered_comm_ring` is an `ordered_comm_ring`. -/
 instance to_ordered_comm_ring {R} [ordered_comm_ring R] (s : subring R) : ordered_comm_ring s :=
-subtype.coe_injective.ordered_comm_ring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.ordered_comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl)
 
 /-- A subring of a `linear_ordered_ring` is a `linear_ordered_ring`. -/
 instance to_linear_ordered_ring {R} [linear_ordered_ring R] (s : subring R) :
   linear_ordered_ring s :=
-subtype.coe_injective.linear_ordered_ring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.linear_ordered_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 /-- A subring of a `linear_ordered_comm_ring` is a `linear_ordered_comm_ring`. -/
 instance to_linear_ordered_comm_ring {R} [linear_ordered_comm_ring R] (s : subring R) :
   linear_ordered_comm_ring s :=
-subtype.coe_injective.linear_ordered_comm_ring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.linear_ordered_comm_ring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+  (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _, rfl) (λ _ _, rfl)
+  (λ _ _, rfl)
 
 /-- The natural ring hom from a subring of ring `R` to `R`. -/
 def subtype (s : subring R) : s →+* R :=
@@ -408,10 +415,8 @@ def subtype (s : subring R) : s →+* R :=
  .. s.to_submonoid.subtype, .. s.to_add_subgroup.subtype }
 
 @[simp] theorem coe_subtype : ⇑s.subtype = coe := rfl
-@[simp, norm_cast] lemma coe_nat_cast : ∀ (n : ℕ), ((n : s) : R) = n :=
-map_nat_cast s.subtype
-@[simp, norm_cast] lemma coe_int_cast (n : ℤ) : ((n : s) : R) = n :=
-s.subtype.map_int_cast n
+@[simp, norm_cast] lemma coe_nat_cast : ∀ n : ℕ, ((n : s) : R) = n := map_nat_cast s.subtype
+@[simp, norm_cast] lemma coe_int_cast : ∀ n : ℤ, ((n : s) : R) = n := map_int_cast s.subtype
 
 /-! ## Partial order -/
 
@@ -431,6 +436,10 @@ instance : has_top (subring R) :=
 
 @[simp] lemma coe_top : ((⊤ : subring R) : set R) = set.univ := rfl
 
+/-- The ring equiv between the top element of `subring R` and `R`. -/
+@[simps]
+def top_equiv : (⊤ : subring R) ≃+* R := subsemiring.top_equiv
+
 /-! ## comap -/
 
 /-- The preimage of a subring along a ring homomorphism is a subring. -/
@@ -513,16 +522,6 @@ mem_range.mpr ⟨x, rfl⟩
 lemma map_range : f.range.map g = (g.comp f).range :=
 by simpa only [range_eq_map] using (⊤ : subring R).map_map g f
 
--- TODO -- rename to `cod_restrict` when is_ring_hom is deprecated
-/-- Restrict the codomain of a ring homomorphism to a subring that includes the range. -/
-def cod_restrict' {R : Type u} {S : Type v} [ring R] [ring S] (f : R →+* S)
-  (s : subring S) (h : ∀ x, f x ∈ s) : R →+* s :=
-{ to_fun := λ x, ⟨f x, h x⟩,
-  map_add' := λ x y, subtype.eq $ f.map_add x y,
-  map_zero' := subtype.eq f.map_zero,
-  map_mul' := λ x y, subtype.eq $ f.map_mul x y,
-  map_one' := subtype.eq f.map_one }
-
 /-- The range of a ring homomorphism is a fintype, if the domain is a fintype.
 Note: this instance can form a diamond with `subtype.fintype` in the
   presence of `fintype S`. -/
@@ -567,6 +566,13 @@ instance : has_Inf (subring R) :=
 
 lemma mem_Inf {S : set (subring R)} {x : R} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p := set.mem_Inter₂
 
+@[simp, norm_cast] lemma coe_infi {ι : Sort*} {S : ι → subring R} :
+  (↑(⨅ i, S i) : set R) = ⋂ i, S i :=
+by simp only [infi, coe_Inf, set.bInter_range]
+
+lemma mem_infi {ι : Sort*} {S : ι → subring R} {x : R} : (x ∈ ⨅ i, S i) ↔ ∀ i, x ∈ S i :=
+by simp only [infi, mem_Inf, set.forall_range_iff]
+
 @[simp] lemma Inf_to_submonoid (s : set (subring R)) :
   (Inf s).to_submonoid = ⨅ t ∈ s, subring.to_submonoid t := mk'_to_submonoid _ _
 
@@ -645,6 +651,39 @@ lemma center.coe_div (a b : center K) : ((a / b : center K) : K) = (a : K) / (b
 
 end division_ring
 
+section centralizer
+
+/-- The centralizer of a set inside a ring as a `subring`. -/
+def centralizer (s : set R) : subring R :=
+{ neg_mem' := λ x, set.neg_mem_centralizer,
+  ..subsemiring.centralizer s }
+
+@[simp, norm_cast]
+lemma coe_centralizer (s : set R) : (centralizer s : set R) = s.centralizer := rfl
+
+lemma centralizer_to_submonoid (s : set R) :
+  (centralizer s).to_submonoid = submonoid.centralizer s := rfl
+
+lemma centralizer_to_subsemiring (s : set R) :
+  (centralizer s).to_subsemiring = subsemiring.centralizer s := rfl
+
+lemma mem_centralizer_iff {s : set R} {z : R} :
+  z ∈ centralizer s ↔ ∀ g ∈ s, g * z = z * g :=
+iff.rfl
+
+lemma center_le_centralizer (s) : center R ≤ centralizer s := s.center_subset_centralizer
+
+lemma centralizer_le (s t : set R) (h : s ⊆ t) : centralizer t ≤ centralizer s :=
+set.centralizer_subset h
+
+@[simp] lemma centralizer_eq_top_iff_subset {s : set R} : centralizer s = ⊤ ↔ s ⊆ center R :=
+set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset
+
+@[simp] lemma centralizer_univ : centralizer set.univ = center R :=
+set_like.ext' (set.centralizer_univ R)
+
+end centralizer
+
 /-! ## subring closure of a subset -/
 
 /-- The `subring` generated by a set. -/
@@ -819,13 +858,11 @@ lemma comap_infi {ι : Sort*} (f : R →+* S) (s : ι → subring S) :
 /-- Given `subring`s `s`, `t` of rings `R`, `S` respectively, `s.prod t` is `s ×̂ t`
 as a subring of `R × S`. -/
 def prod (s : subring R) (t : subring S) : subring (R × S) :=
-{ carrier := (s : set R) ×ˢ (t : set S),
+{ carrier := s ×ˢ t,
   .. s.to_submonoid.prod t.to_submonoid, .. s.to_add_subgroup.prod t.to_add_subgroup}
 
 @[norm_cast]
-lemma coe_prod (s : subring R) (t : subring S) :
-  (s.prod t : set (R × S)) = (s : set R) ×ˢ (t : set S) :=
-rfl
+lemma coe_prod (s : subring R) (t : subring S) : (s.prod t : set (R × S)) = s ×ˢ t := rfl
 
 lemma mem_prod {s : subring R} {t : subring S} {p : R × S} :
   p ∈ s.prod t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl
@@ -908,16 +945,11 @@ variables {s : subring R}
 
 open subring
 
-/-- Restriction of a ring homomorphism to a subring of the domain. -/
-def restrict (f : R →+* S) (s : subring R) : s →+* S := f.comp s.subtype
-
-@[simp] lemma restrict_apply (f : R →+* S) (x : s) : f.restrict s x = f x := rfl
-
 /-- Restriction of a ring homomorphism to its range interpreted as a subsemiring.
 
 This is the bundled version of `set.range_factorization`. -/
 def range_restrict (f : R →+* S) : R →+* f.range :=
-f.cod_restrict' f.range $ λ x, ⟨x, rfl⟩
+f.cod_restrict f.range $ λ x, ⟨x, rfl⟩
 
 @[simp] lemma coe_range_restrict (f : R →+* S) (x : R) : (f.range_restrict x : S) = f x := rfl
 
@@ -938,6 +970,9 @@ range_top_iff_surjective.2 hf
 def eq_locus (f g : R →+* S) : subring R :=
 { carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_locus g }
 
+@[simp] lemma eq_locus_same (f : R →+* S) : f.eq_locus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two ring homomorphisms are equal on a set, then they are equal on its subring closure. -/
 lemma eq_on_set_closure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
   set.eq_on f g (closure s) :=
@@ -972,7 +1007,7 @@ open ring_hom
 
 /-- The ring homomorphism associated to an inclusion of subrings. -/
 def inclusion {S T : subring R} (h : S ≤ T) : S →+* T :=
-S.subtype.cod_restrict' _ (λ x, h x.2)
+S.subtype.cod_restrict _ (λ x, h x.2)
 
 @[simp] lemma range_subtype (s : subring R) : s.subtype.range = s :=
 set_like.coe_injective $ (coe_srange _).trans subtype.range_coe
@@ -1050,14 +1085,13 @@ begin
   { rw [list.map_cons, list.sum_cons],
     exact ha this (ih HL.2) },
   replace HL := HL.1, clear ih tl,
-  suffices : ∃ L : list R, (∀ x ∈ L, x ∈ s) ∧
+  rsuffices ⟨L, HL', HP | HP⟩ : ∃ L : list R, (∀ x ∈ L, x ∈ s) ∧
     (list.prod hd = list.prod L ∨ list.prod hd = -list.prod L),
-  { rcases this with ⟨L, HL', HP | HP⟩,
-    { rw HP, clear HP HL hd, induction L with hd tl ih, { exact h1 },
-      rw list.forall_mem_cons at HL',
-      rw list.prod_cons,
-      exact hs _ HL'.1 _ (ih HL'.2) },
-    rw HP, clear HP HL hd, induction L with hd tl ih, { exact hneg1 },
+  { rw HP, clear HP HL hd, induction L with hd tl ih, { exact h1 },
+    rw list.forall_mem_cons at HL',
+    rw list.prod_cons,
+    exact hs _ HL'.1 _ (ih HL'.2) },
+  { rw HP, clear HP HL hd, induction L with hd tl ih, { exact hneg1 },
     rw [list.prod_cons, neg_mul_eq_mul_neg],
     rw list.forall_mem_cons at HL',
     exact hs _ HL'.1 _ (ih HL'.2) },
@@ -1098,29 +1132,29 @@ namespace subring
 variables {α β : Type*}
 
 /-- The action by a subring is the action by the underlying ring. -/
-instance [has_scalar R α] (S : subring R) : has_scalar S α := S.to_subsemiring.has_scalar
+instance [has_smul R α] (S : subring R) : has_smul S α := S.to_subsemiring.has_smul
 
-lemma smul_def [has_scalar R α] {S : subring R} (g : S) (m : α) : g • m = (g : R) • m := rfl
+lemma smul_def [has_smul R α] {S : subring R} (g : S) (m : α) : g • m = (g : R) • m := rfl
 
 instance smul_comm_class_left
-  [has_scalar R β] [has_scalar α β] [smul_comm_class R α β] (S : subring R) :
+  [has_smul R β] [has_smul α β] [smul_comm_class R α β] (S : subring R) :
   smul_comm_class S α β :=
 S.to_subsemiring.smul_comm_class_left
 
 instance smul_comm_class_right
-  [has_scalar α β] [has_scalar R β] [smul_comm_class α R β] (S : subring R) :
+  [has_smul α β] [has_smul R β] [smul_comm_class α R β] (S : subring R) :
   smul_comm_class α S β :=
 S.to_subsemiring.smul_comm_class_right
 
 /-- Note that this provides `is_scalar_tower S R R` which is needed by `smul_mul_assoc`. -/
 instance
-  [has_scalar α β] [has_scalar R α] [has_scalar R β] [is_scalar_tower R α β] (S : subring R) :
+  [has_smul α β] [has_smul R α] [has_smul R β] [is_scalar_tower R α β] (S : subring R) :
   is_scalar_tower S α β :=
 S.to_subsemiring.is_scalar_tower
 
-instance [has_scalar R α] [has_faithful_scalar R α] (S : subring R) :
-  has_faithful_scalar S α :=
-S.to_subsemiring.has_faithful_scalar
+instance [has_smul R α] [has_faithful_smul R α] (S : subring R) :
+  has_faithful_smul S α :=
+S.to_subsemiring.has_faithful_smul
 
 /-- The action by a subring is the action by the underlying ring. -/
 instance [mul_action R α] (S : subring R) : mul_action S α :=
@@ -1146,6 +1180,18 @@ S.to_subsemiring.mul_action_with_zero
 instance [add_comm_monoid α] [module R α] (S : subring R) : module S α :=
 S.to_subsemiring.module
 
+/-- The action by a subsemiring is the action by the underlying ring. -/
+instance [semiring α] [mul_semiring_action R α] (S : subring R) : mul_semiring_action S α :=
+S.to_submonoid.mul_semiring_action
+
+/-- The center of a semiring acts commutatively on that semiring. -/
+instance center.smul_comm_class_left : smul_comm_class (center R) R R :=
+subsemiring.center.smul_comm_class_left
+
+/-- The center of a semiring acts commutatively on that semiring. -/
+instance center.smul_comm_class_right : smul_comm_class R (center R) R :=
+subsemiring.center.smul_comm_class_right
+
 end subring
 
 end actions
diff --git a/src/ring_theory/subring/pointwise.lean b/src/ring_theory/subring/pointwise.lean
index f4893695db3f5..86242c30be28e 100644
--- a/src/ring_theory/subring/pointwise.lean
+++ b/src/ring_theory/subring/pointwise.lean
@@ -3,12 +3,16 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import ring_theory.subsemiring.pointwise
-import group_theory.subgroup.pointwise
 import ring_theory.subring.basic
+import group_theory.subgroup.pointwise
+import ring_theory.subsemiring.pointwise
+import data.set.pointwise.basic
 
 /-! # Pointwise instances on `subring`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides the action `subring.pointwise_mul_action` which matches the action of
 `mul_action_set`.
 
@@ -21,6 +25,8 @@ keep them in sync.
 
 -/
 
+open set
+
 variables {M R : Type*}
 
 namespace subring
@@ -59,6 +65,12 @@ lemma mem_smul_pointwise_iff_exists (m : M) (r : R) (S : subring R) :
   r ∈ m • S ↔ ∃ (s : R), s ∈ S ∧ m • s = r :=
 (set.mem_smul_set : r ∈ m • (S : set R) ↔ _)
 
+@[simp] lemma smul_bot (a : M) : a • (⊥ : subring R) = ⊥ := map_bot _
+lemma smul_sup (a : M) (S T : subring R) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : M) (s : set R) : a • closure s = closure (a • s) :=
+ring_hom.map_closure _ _
+
 instance pointwise_central_scalar [mul_semiring_action Mᵐᵒᵖ R] [is_central_scalar M R] :
   is_central_scalar M (subring R) :=
 ⟨λ a S, congr_arg (λ f, S.map f) $ ring_hom.ext $ by exact op_smul_eq_smul _⟩
diff --git a/src/ring_theory/subsemiring/basic.lean b/src/ring_theory/subsemiring/basic.lean
index 90dc42f73b607..4794203c5798c 100644
--- a/src/ring_theory/subsemiring/basic.lean
+++ b/src/ring_theory/subsemiring/basic.lean
@@ -7,6 +7,8 @@ Authors: Yury Kudryashov
 import algebra.module.basic
 import algebra.ring.equiv
 import algebra.ring.prod
+import algebra.order.ring.inj_surj
+import algebra.group_ring_action.subobjects
 import data.set.finite
 import group_theory.submonoid.centralizer
 import group_theory.submonoid.membership
@@ -14,6 +16,9 @@ import group_theory.submonoid.membership
 /-!
 # Bundled subsemirings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define bundled subsemirings and some standard constructions: `complete_lattice` structure,
 `subtype` and `inclusion` ring homomorphisms, subsemiring `map`, `comap` and range (`srange`) of
 a `ring_hom` etc.
@@ -23,28 +28,50 @@ open_locale big_operators
 
 universes u v w
 
+section add_submonoid_with_one_class
+
+/-- `add_submonoid_with_one_class S R` says `S` is a type of subsets `s ≤ R` that contain `0`, `1`,
+and are closed under `(+)` -/
+class add_submonoid_with_one_class (S : Type*) (R : Type*)
+  [add_monoid_with_one R] [set_like S R]
+  extends add_submonoid_class S R, one_mem_class S R : Prop
+
+variables {S R : Type*} [add_monoid_with_one R] [set_like S R] (s : S)
+
+lemma nat_cast_mem [add_submonoid_with_one_class S R] (n : ℕ) : (n : R) ∈ s :=
+by induction n; simp [zero_mem, add_mem, one_mem, *]
+
+@[priority 74]
+instance add_submonoid_with_one_class.to_add_monoid_with_one [add_submonoid_with_one_class S R] :
+  add_monoid_with_one s :=
+{ one := ⟨_, one_mem s⟩,
+  nat_cast := λ n, ⟨n, nat_cast_mem s n⟩,
+  nat_cast_zero := subtype.ext nat.cast_zero,
+  nat_cast_succ := λ n, subtype.ext (nat.cast_succ _),
+  .. add_submonoid_class.to_add_monoid s }
+
+end add_submonoid_with_one_class
+
 variables {R : Type u} {S : Type v} {T : Type w} [non_assoc_semiring R] (M : submonoid R)
 
 section subsemiring_class
 
 /-- `subsemiring_class S R` states that `S` is a type of subsets `s ⊆ R` that
 are both a multiplicative and an additive submonoid. -/
-class subsemiring_class (S : Type*) (R : out_param $ Type u) [non_assoc_semiring R] [set_like S R]
-  extends submonoid_class S R :=
-(add_mem : ∀ {s : S} {a b : R}, a ∈ s → b ∈ s → a + b ∈ s)
-(zero_mem : ∀ (s : S), (0 : R) ∈ s)
+class subsemiring_class (S : Type*) (R : Type u) [non_assoc_semiring R] [set_like S R]
+  extends submonoid_class S R, add_submonoid_class S R : Prop
 
 @[priority 100] -- See note [lower instance priority]
-instance subsemiring_class.add_submonoid_class (S : Type*) (R : out_param $ Type u)
+instance subsemiring_class.add_submonoid_with_one_class (S : Type*) (R : Type u)
   [non_assoc_semiring R] [set_like S R] [h : subsemiring_class S R] :
-  add_submonoid_class S R :=
+  add_submonoid_with_one_class S R :=
 { .. h }
 
 variables [set_like S R] [hSR : subsemiring_class S R] (s : S)
 include hSR
 
 lemma coe_nat_mem (n : ℕ) : (n : R) ∈ s :=
-by simp only [← nsmul_one, nsmul_mem, one_mem]
+by { rw ← nsmul_one, exact nsmul_mem (one_mem _) _ }
 
 namespace subsemiring_class
 
@@ -52,6 +79,7 @@ namespace subsemiring_class
 @[priority 75] -- Prefer subclasses of `non_assoc_semiring` over subclasses of `subsemiring_class`.
 instance to_non_assoc_semiring : non_assoc_semiring s :=
 subtype.coe_injective.non_assoc_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _, rfl)
 
 instance nontrivial [nontrivial R] : nontrivial s :=
 nontrivial_of_ne 0 1 $ λ H, zero_ne_one (congr_arg subtype.val H)
@@ -73,6 +101,7 @@ omit hSR
 @[priority 75] -- Prefer subclasses of `semiring` over subclasses of `subsemiring_class`.
 instance to_semiring {R} [semiring R] [set_like S R] [subsemiring_class S R] : semiring s :=
 subtype.coe_injective.semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  (λ _, rfl)
 
 @[simp, norm_cast] lemma coe_pow {R} [semiring R] [set_like S R] [subsemiring_class S R]
   (x : s) (n : ℕ) :
@@ -86,27 +115,46 @@ end
 /-- A subsemiring of a `comm_semiring` is a `comm_semiring`. -/
 instance to_comm_semiring {R} [comm_semiring R] [set_like S R] [subsemiring_class S R] :
   comm_semiring s :=
-subtype.coe_injective.comm_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+subtype.coe_injective.comm_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
 
 /-- A subsemiring of an `ordered_semiring` is an `ordered_semiring`. -/
 instance to_ordered_semiring {R} [ordered_semiring R] [set_like S R] [subsemiring_class S R] :
   ordered_semiring s :=
-subtype.coe_injective.ordered_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl)
+subtype.coe_injective.ordered_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+/-- A subsemiring of an `strict_ordered_semiring` is an `strict_ordered_semiring`. -/
+instance to_strict_ordered_semiring {R} [strict_ordered_semiring R] [set_like S R]
+  [subsemiring_class S R] :
+  strict_ordered_semiring s :=
+subtype.coe_injective.strict_ordered_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
 
 /-- A subsemiring of an `ordered_comm_semiring` is an `ordered_comm_semiring`. -/
 instance to_ordered_comm_semiring {R} [ordered_comm_semiring R] [set_like S R]
   [subsemiring_class S R] : ordered_comm_semiring s :=
-subtype.coe_injective.ordered_comm_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl)
+subtype.coe_injective.ordered_comm_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+/-- A subsemiring of an `strict_ordered_comm_semiring` is an `strict_ordered_comm_semiring`. -/
+instance to_strict_ordered_comm_semiring {R} [strict_ordered_comm_semiring R] [set_like S R]
+  [subsemiring_class S R] :
+  strict_ordered_comm_semiring s :=
+subtype.coe_injective.strict_ordered_comm_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
 
 /-- A subsemiring of a `linear_ordered_semiring` is a `linear_ordered_semiring`. -/
 instance to_linear_ordered_semiring {R} [linear_ordered_semiring R] [set_like S R]
   [subsemiring_class S R] : linear_ordered_semiring s :=
-subtype.coe_injective.linear_ordered_semiring coe rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
-  (λ _ _, rfl)
+subtype.coe_injective.linear_ordered_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
-/-! Note: currently, there is no `linear_ordered_comm_semiring`. -/
+/-- A subsemiring of a `linear_ordered_comm_semiring` is a `linear_ordered_comm_semiring`. -/
+instance to_linear_ordered_comm_semiring {R} [linear_ordered_comm_semiring R] [set_like S R]
+  [subsemiring_class S R] : linear_ordered_comm_semiring s :=
+subtype.coe_injective.linear_ordered_comm_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
 end subsemiring_class
 
@@ -264,6 +312,9 @@ instance to_non_assoc_semiring : non_assoc_semiring s :=
   zero_mul := λ x, subtype.eq $ zero_mul x,
   right_distrib := λ x y z, subtype.eq $ right_distrib x y z,
   left_distrib := λ x y z, subtype.eq $ left_distrib x y z,
+  nat_cast := λ n, ⟨n, coe_nat_mem s n⟩,
+  nat_cast_zero := by simp [nat.cast]; refl,
+  nat_cast_succ := λ _, by simp [nat.cast]; refl,
   .. s.to_submonoid.to_mul_one_class, .. s.to_add_submonoid.to_add_comm_monoid }
 
 @[simp, norm_cast] lemma coe_one : ((1 : s) : R) = (1 : R) := rfl
@@ -307,21 +358,37 @@ def subtype : s →+* R :=
 /-- A subsemiring of an `ordered_semiring` is an `ordered_semiring`. -/
 instance to_ordered_semiring {R} [ordered_semiring R] (s : subsemiring R) : ordered_semiring s :=
 subtype.coe_injective.ordered_semiring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+/-- A subsemiring of a `strict_ordered_semiring` is a `strict_ordered_semiring`. -/
+instance to_strict_ordered_semiring {R} [strict_ordered_semiring R] (s : subsemiring R) :
+  strict_ordered_semiring s :=
+subtype.coe_injective.strict_ordered_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
 
 /-- A subsemiring of an `ordered_comm_semiring` is an `ordered_comm_semiring`. -/
 instance to_ordered_comm_semiring {R} [ordered_comm_semiring R] (s : subsemiring R) :
   ordered_comm_semiring s :=
 subtype.coe_injective.ordered_comm_semiring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
+
+/-- A subsemiring of a `strict_ordered_comm_semiring` is a `strict_ordered_comm_semiring`. -/
+instance to_strict_ordered_comm_semiring {R} [strict_ordered_comm_semiring R] (s : subsemiring R) :
+  strict_ordered_comm_semiring s :=
+subtype.coe_injective.strict_ordered_comm_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl)
 
 /-- A subsemiring of a `linear_ordered_semiring` is a `linear_ordered_semiring`. -/
 instance to_linear_ordered_semiring {R} [linear_ordered_semiring R] (s : subsemiring R) :
   linear_ordered_semiring s :=
 subtype.coe_injective.linear_ordered_semiring coe
-  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
-/-! Note: currently, there is no `linear_ordered_comm_semiring`. -/
+/-- A subsemiring of a `linear_ordered_comm_semiring` is a `linear_ordered_comm_semiring`. -/
+instance to_linear_ordered_comm_semiring {R} [linear_ordered_comm_semiring R] (s : subsemiring R) :
+  linear_ordered_comm_semiring s :=
+subtype.coe_injective.linear_ordered_comm_semiring coe
+  rfl rfl (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
 protected lemma nsmul_mem {x : R} (hx : x ∈ s) (n : ℕ) :
   n • x ∈ s := nsmul_mem hx n
@@ -340,6 +407,16 @@ instance : has_top (subsemiring R) :=
 
 @[simp] lemma coe_top : ((⊤ : subsemiring R) : set R) = set.univ := rfl
 
+/-- The ring equiv between the top element of `subsemiring R` and `R`. -/
+@[simps]
+def top_equiv : (⊤ : subsemiring R) ≃+* R :=
+{ to_fun := λ r, r,
+  inv_fun := λ r, ⟨r, subsemiring.mem_top r⟩,
+  left_inv := λ r, set_like.eta r _,
+  right_inv := λ r, set_like.coe_mk r _,
+  map_mul' := (⊤ : subsemiring R).coe_mul,
+  map_add' := (⊤ : subsemiring R).coe_add, }
+
 /-- The preimage of a subsemiring along a ring homomorphism is a subsemiring. -/
 def comap (f : R →+* S) (s : subsemiring S) : subsemiring R :=
 { carrier := f ⁻¹' s,
@@ -527,10 +604,17 @@ lemma mem_centralizer_iff {R} [semiring R] {s : set R} {z : R} :
   z ∈ centralizer s ↔ ∀ g ∈ s, g * z = z * g :=
 iff.rfl
 
+lemma center_le_centralizer {R} [semiring R] (s) : center R ≤ centralizer s :=
+  s.center_subset_centralizer
+
 lemma centralizer_le {R} [semiring R] (s t : set R) (h : s ⊆ t) :
   centralizer t ≤ centralizer s :=
 set.centralizer_subset h
 
+@[simp] lemma centralizer_eq_top_iff_subset {R} [semiring R] {s : set R} :
+  centralizer s = ⊤ ↔ s ⊆ center R :=
+set_like.ext'_iff.trans set.centralizer_eq_top_iff_subset
+
 @[simp]
 lemma centralizer_univ {R} [semiring R] : centralizer set.univ = center R :=
 set_like.ext' (set.centralizer_univ R)
@@ -730,12 +814,11 @@ lemma comap_infi {ι : Sort*} (f : R →+* S) (s : ι → subsemiring S) :
 /-- Given `subsemiring`s `s`, `t` of semirings `R`, `S` respectively, `s.prod t` is `s × t`
 as a subsemiring of `R × S`. -/
 def prod (s : subsemiring R) (t : subsemiring S) : subsemiring (R × S) :=
-{ carrier := (s : set R) ×ˢ (t : set S),
+{ carrier := s ×ˢ t,
   .. s.to_submonoid.prod t.to_submonoid, .. s.to_add_submonoid.prod t.to_add_submonoid}
 
 @[norm_cast]
-lemma coe_prod (s : subsemiring R) (t : subsemiring S) :
-  (s.prod t : set (R × S)) = (s : set R) ×ˢ (t : set S) :=
+lemma coe_prod (s : subsemiring R) (t : subsemiring S) : (s.prod t : set (R × S)) = s ×ˢ t :=
 rfl
 
 lemma mem_prod {s : subsemiring R} {t : subsemiring S} {p : R × S} :
@@ -800,25 +883,38 @@ end subsemiring
 namespace ring_hom
 
 variables [non_assoc_semiring T] {s : subsemiring R}
+variables {σR σS : Type*}
+variables [set_like σR R] [set_like σS S] [subsemiring_class σR R] [subsemiring_class σS S]
 
 open subsemiring
 
 /-- Restriction of a ring homomorphism to a subsemiring of the domain. -/
-def srestrict (f : R →+* S) (s : subsemiring R) : s →+* S := f.comp s.subtype
+def dom_restrict (f : R →+* S) (s : σR) : s →+* S := f.comp $ subsemiring_class.subtype s
 
-@[simp] lemma srestrict_apply (f : R →+* S) (x : s) : f.srestrict s x = f x := rfl
+@[simp] lemma restrict_apply (f : R →+* S) {s : σR} (x : s) : f.dom_restrict s x = f x := rfl
 
 /-- Restriction of a ring homomorphism to a subsemiring of the codomain. -/
-def cod_srestrict (f : R →+* S) (s : subsemiring S) (h : ∀ x, f x ∈ s) : R →+* s :=
+def cod_restrict (f : R →+* S) (s : σS) (h : ∀ x, f x ∈ s) : R →+* s :=
 { to_fun := λ n, ⟨f n, h n⟩,
-  .. (f : R →* S).cod_mrestrict s.to_submonoid h,
-  .. (f : R →+ S).cod_mrestrict s.to_add_submonoid h }
+  .. (f : R →* S).cod_restrict s h,
+  .. (f : R →+ S).cod_restrict s h }
+
+/-- The ring homomorphism from the preimage of `s` to `s`. -/
+def restrict (f : R →+* S) (s' : σR) (s : σS) (h : ∀ x ∈ s', f x ∈ s) :
+  s' →+* s := (f.dom_restrict s').cod_restrict s (λ x, h x x.2)
+
+@[simp] lemma coe_restrict_apply (f : R →+* S) (s' : σR) (s : σS) (h : ∀ x ∈ s', f x ∈ s) (x : s') :
+  (f.restrict s' s h x : S) = f x := rfl
+
+@[simp] lemma comp_restrict (f : R →+* S) (s' : σR) (s : σS) (h : ∀ x ∈ s', f x ∈ s) :
+  (subsemiring_class.subtype s).comp (f.restrict s' s h) = f.comp (subsemiring_class.subtype s') :=
+rfl
 
 /-- Restriction of a ring homomorphism to its range interpreted as a subsemiring.
 
 This is the bundled version of `set.range_factorization`. -/
 def srange_restrict (f : R →+* S) : R →+* f.srange :=
-f.cod_srestrict f.srange f.mem_srange_self
+f.cod_restrict f.srange f.mem_srange_self
 
 @[simp] lemma coe_srange_restrict (f : R →+* S) (x : R) :
   (f.srange_restrict x : S) = f x :=
@@ -840,6 +936,9 @@ srange_top_iff_surjective.2 hf
 def eq_slocus (f g : R →+* S) : subsemiring R :=
 { carrier := {x | f x = g x}, .. (f : R →* S).eq_mlocus g, .. (f : R →+ S).eq_mlocus g }
 
+@[simp] lemma eq_slocus_same (f : R →+* S) : f.eq_slocus f = ⊤ :=
+set_like.ext $ λ _, eq_self_iff_true _
+
 /-- If two ring homomorphisms are equal on a set, then they are equal on its subsemiring closure. -/
 lemma eq_on_sclosure {f g : R →+* S} {s : set R} (h : set.eq_on f g s) :
   set.eq_on f g (closure s) :=
@@ -874,7 +973,7 @@ open ring_hom
 
 /-- The ring homomorphism associated to an inclusion of subsemirings. -/
 def inclusion {S T : subsemiring R} (h : S ≤ T) : S →+* T :=
-S.subtype.cod_srestrict _ (λ x, h x.2)
+S.subtype.cod_restrict _ (λ x, h x.2)
 
 @[simp] lemma srange_subtype (s : subsemiring R) : s.subtype.srange = s :=
 set_like.coe_injective $ (coe_srange _).trans subtype.range_coe
@@ -953,29 +1052,29 @@ section non_assoc_semiring
 variables [non_assoc_semiring R']
 
 /-- The action by a subsemiring is the action by the underlying semiring. -/
-instance [has_scalar R' α] (S : subsemiring R') : has_scalar S α := S.to_submonoid.has_scalar
+instance [has_smul R' α] (S : subsemiring R') : has_smul S α := S.to_submonoid.has_smul
 
-lemma smul_def [has_scalar R' α] {S : subsemiring R'} (g : S) (m : α) : g • m = (g : R') • m := rfl
+lemma smul_def [has_smul R' α] {S : subsemiring R'} (g : S) (m : α) : g • m = (g : R') • m := rfl
 
 instance smul_comm_class_left
-  [has_scalar R' β] [has_scalar α β] [smul_comm_class R' α β] (S : subsemiring R') :
+  [has_smul R' β] [has_smul α β] [smul_comm_class R' α β] (S : subsemiring R') :
   smul_comm_class S α β :=
 S.to_submonoid.smul_comm_class_left
 
 instance smul_comm_class_right
-  [has_scalar α β] [has_scalar R' β] [smul_comm_class α R' β] (S : subsemiring R') :
+  [has_smul α β] [has_smul R' β] [smul_comm_class α R' β] (S : subsemiring R') :
   smul_comm_class α S β :=
 S.to_submonoid.smul_comm_class_right
 
 /-- Note that this provides `is_scalar_tower S R R` which is needed by `smul_mul_assoc`. -/
-instance [has_scalar α β] [has_scalar R' α] [has_scalar R' β] [is_scalar_tower R' α β]
+instance [has_smul α β] [has_smul R' α] [has_smul R' β] [is_scalar_tower R' α β]
   (S : subsemiring R') :
   is_scalar_tower S α β :=
 S.to_submonoid.is_scalar_tower
 
-instance [has_scalar R' α] [has_faithful_scalar R' α] (S : subsemiring R') :
-  has_faithful_scalar S α :=
-S.to_submonoid.has_faithful_scalar
+instance [has_smul R' α] [has_faithful_smul R' α] (S : subsemiring R') :
+  has_faithful_smul S α :=
+S.to_submonoid.has_faithful_smul
 
 /-- The action by a subsemiring is the action by the underlying semiring. -/
 instance [has_zero α] [smul_with_zero R' α] (S : subsemiring R') : smul_with_zero S α :=
@@ -1006,6 +1105,18 @@ mul_action_with_zero.comp_hom _ S.subtype.to_monoid_with_zero_hom
 instance [add_comm_monoid α] [module R' α] (S : subsemiring R') : module S α :=
 { smul := (•), .. module.comp_hom _ S.subtype }
 
+/-- The action by a subsemiring is the action by the underlying semiring. -/
+instance [semiring α] [mul_semiring_action R' α] (S : subsemiring R') : mul_semiring_action S α :=
+S.to_submonoid.mul_semiring_action
+
+/-- The center of a semiring acts commutatively on that semiring. -/
+instance center.smul_comm_class_left : smul_comm_class (center R') R' R' :=
+submonoid.center.smul_comm_class_left
+
+/-- The center of a semiring acts commutatively on that semiring. -/
+instance center.smul_comm_class_right : smul_comm_class R' (center R') R' :=
+submonoid.center.smul_comm_class_right
+
 /-- If all the elements of a set `s` commute, then `closure s` is a commutative monoid. -/
 def closure_comm_semiring_of_comm {s : set R'} (hcomm : ∀ (a ∈ s) (b ∈ s), a * b = b * a) :
   comm_semiring (closure s) :=
@@ -1030,14 +1141,14 @@ end subsemiring
 end actions
 
 -- While this definition is not about `subsemiring`s, this is the earliest we have
--- both `ordered_semiring` and `submonoid` available.
+-- both `strict_ordered_semiring` and `submonoid` available.
 
 
 /-- Submonoid of positive elements of an ordered semiring. -/
-def pos_submonoid (R : Type*) [ordered_semiring R] [nontrivial R] : submonoid R :=
+def pos_submonoid (R : Type*) [strict_ordered_semiring R] : submonoid R :=
 { carrier := {x | 0 < x},
   one_mem' := show (0 : R) < 1, from zero_lt_one,
   mul_mem' := λ x y (hx : 0 < x) (hy : 0 < y), mul_pos hx hy }
 
-@[simp] lemma mem_pos_monoid {R : Type*} [ordered_semiring R] [nontrivial R] (u : Rˣ) :
+@[simp] lemma mem_pos_monoid {R : Type*} [strict_ordered_semiring R] (u : Rˣ) :
   ↑u ∈ pos_submonoid R ↔ (0 : R) < u := iff.rfl
diff --git a/src/ring_theory/subsemiring/pointwise.lean b/src/ring_theory/subsemiring/pointwise.lean
index d27e654731c07..602d99c4ccd9b 100644
--- a/src/ring_theory/subsemiring/pointwise.lean
+++ b/src/ring_theory/subsemiring/pointwise.lean
@@ -3,11 +3,16 @@ Copyright (c) 2021 Eric Wieser. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Eric Wieser
 -/
-import algebra.group_ring_action
+import algebra.group_ring_action.basic
 import ring_theory.subsemiring.basic
+import group_theory.submonoid.pointwise
+import data.set.pointwise.basic
 
 /-! # Pointwise instances on `subsemiring`s
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides the action `subsemiring.pointwise_mul_action` which matches the action of
 `mul_action_set`.
 
@@ -19,6 +24,8 @@ This file is almost identical to `group_theory/submonoid/pointwise.lean`. Where
 keep them in sync.
 -/
 
+open set
+
 variables {M R : Type*}
 
 namespace subsemiring
@@ -54,6 +61,12 @@ lemma mem_smul_pointwise_iff_exists (m : M) (r : R) (S : subsemiring R) :
   r ∈ m • S ↔ ∃ (s : R), s ∈ S ∧ m • s = r :=
 (set.mem_smul_set : r ∈ m • (S : set R) ↔ _)
 
+@[simp] lemma smul_bot (a : M) : a • (⊥ : subsemiring R) = ⊥ := map_bot _
+lemma smul_sup (a : M) (S T : subsemiring R) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _
+
+lemma smul_closure (a : M) (s : set R) : a • closure s = closure (a • s) :=
+ring_hom.map_sclosure _ _
+
 instance pointwise_central_scalar [mul_semiring_action Mᵐᵒᵖ R] [is_central_scalar M R] :
   is_central_scalar M (subsemiring R) :=
 ⟨λ a S, congr_arg (λ f, S.map f) $ ring_hom.ext $ by exact op_smul_eq_smul _⟩
diff --git a/src/ring_theory/tensor_product.lean b/src/ring_theory/tensor_product.lean
index 95948ab5228f1..fe3a5edcf8001 100644
--- a/src/ring_theory/tensor_product.lean
+++ b/src/ring_theory/tensor_product.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison, Johan Commelin
 -/
 
-import linear_algebra.tensor_product_basis
+import linear_algebra.finite_dimensional
 import ring_theory.adjoin.basic
+import linear_algebra.direct_sum.finsupp
 
 /-!
 # The tensor product of R-algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `R` be a (semi)ring and `A` an `R`-algebra.
 In this file we:
 
@@ -73,7 +77,8 @@ lemma smul_eq_lsmul_rtensor (a : A) (x : M ⊗[R] N) : a • x = (lsmul R M a).r
 Given a linear map `M ⊗[R] N →[A] P`, compose it with the canonical
 bilinear map `M →[A] N →[R] M ⊗[R] N` to form a bilinear map `M →[A] N →[R] P`. -/
 @[simps] def curry (f : (M ⊗[R] N) →ₗ[A] P) : M →ₗ[A] (N →ₗ[R] P) :=
-{ map_smul' := λ c x, linear_map.ext $ λ y, f.map_smul c (x ⊗ₜ y),
+{ to_fun := curry (f.restrict_scalars R),
+  map_smul' := λ c x, linear_map.ext $ λ y, f.map_smul c (x ⊗ₜ y),
   .. curry (f.restrict_scalars R) }
 
 lemma restrict_scalars_curry (f : (M ⊗[R] N) →ₗ[A] P) :
@@ -116,7 +121,7 @@ the given bilinear map `M →[A] N →[R] P`. -/
 
 @[simp] lemma lift_tmul (f : M →ₗ[A] (N →ₗ[R] P)) (x : M) (y : N) :
   lift f (x ⊗ₜ y) = f x y :=
-lift.tmul' x y
+rfl
 
 variables (R A M N P)
 /-- Heterobasic version of `tensor_product.uncurry`:
@@ -200,8 +205,8 @@ def base_change (f : M →ₗ[R] N) : A ⊗[R] M →ₗ[A] A ⊗[R] N :=
 { to_fun := f.ltensor A,
   map_add' := (f.ltensor A).map_add,
   map_smul' := λ a x,
-    show (f.ltensor A) (rtensor M (algebra.lmul R A a) x) =
-      (rtensor N ((algebra.lmul R A) a)) ((ltensor A f) x),
+    show (f.ltensor A) (rtensor M (linear_map.mul R A a) x) =
+      (rtensor N ((linear_map.mul R A) a)) ((ltensor A f) x),
     by { rw [← comp_apply, ← comp_apply],
       simp only [ltensor_comp_rtensor, rtensor_comp_ltensor] } }
 
@@ -270,7 +275,7 @@ for a fixed pure tensor in the first argument,
 as an `R`-linear map.
 -/
 def mul_aux (a₁ : A) (b₁ : B) : (A ⊗[R] B) →ₗ[R] (A ⊗[R] B) :=
-tensor_product.map (lmul_left R a₁) (lmul_left R b₁)
+tensor_product.map (linear_map.mul_left R a₁) (linear_map.mul_left R b₁)
 
 @[simp]
 lemma mul_aux_apply (a₁ a₂ : A) (b₁ b₂ : B) :
@@ -317,33 +322,39 @@ begin
   { intros, simp only [linear_map.map_add, *, linear_map.add_apply], },
 end
 
-lemma mul_assoc (x y z : A ⊗[R] B) : mul (mul x y) z = mul x (mul y z) :=
+protected lemma mul_assoc (x y z : A ⊗[R] B) : mul (mul x y) z = mul x (mul y z) :=
 mul_assoc' mul (by { intros, simp only [mul_apply, mul_assoc], }) x y z
 
-lemma one_mul (x : A ⊗[R] B) : mul (1 ⊗ₜ 1) x = x :=
+protected lemma one_mul (x : A ⊗[R] B) : mul (1 ⊗ₜ 1) x = x :=
 begin
   apply tensor_product.induction_on x;
   simp {contextual := tt},
 end
 
-lemma mul_one (x : A ⊗[R] B) : mul x (1 ⊗ₜ 1) = x :=
+protected lemma mul_one (x : A ⊗[R] B) : mul x (1 ⊗ₜ 1) = x :=
 begin
   apply tensor_product.induction_on x;
   simp {contextual := tt},
 end
 
+instance : has_one (A ⊗[R] B) :=
+{ one := 1 ⊗ₜ 1 }
+
+instance : add_monoid_with_one (A ⊗[R] B) := add_monoid_with_one.unary
+
 instance : semiring (A ⊗[R] B) :=
 { zero := 0,
   add := (+),
-  one := 1 ⊗ₜ 1,
+  one := 1,
   mul := λ a b, mul a b,
-  one_mul := one_mul,
-  mul_one := mul_one,
-  mul_assoc := mul_assoc,
+  one_mul := algebra.tensor_product.one_mul,
+  mul_one := algebra.tensor_product.mul_one,
+  mul_assoc := algebra.tensor_product.mul_assoc,
   zero_mul := by simp,
   mul_zero := by simp,
   left_distrib := by simp,
   right_distrib := by simp,
+  .. (by apply_instance : add_monoid_with_one (A ⊗[R] B)),
   .. (by apply_instance : add_comm_monoid (A ⊗[R] B)) }.
 
 lemma one_def : (1 : A ⊗[R] B) = (1 : A) ⊗ₜ (1 : B) := rfl
@@ -363,39 +374,77 @@ begin
 end
 
 
-/--
-The algebra map `R →+* (A ⊗[R] B)` giving `A ⊗[R] B` the structure of an `R`-algebra.
--/
-def tensor_algebra_map : R →+* (A ⊗[R] B) :=
-{ to_fun := λ r, algebra_map R A r ⊗ₜ[R] 1,
-  map_one' := by { simp, refl },
-  map_mul' := by simp,
-  map_zero' := by simp [zero_tmul],
-  map_add' := by simp [add_tmul], }
-
-instance : algebra R (A ⊗[R] B) :=
+/-- The ring morphism `A →+* A ⊗[R] B` sending `a` to `a ⊗ₜ 1`. -/
+@[simps]
+def include_left_ring_hom : A →+* A ⊗[R] B :=
+{ to_fun := λ a, a ⊗ₜ 1,
+  map_zero' := by simp,
+  map_add' := by simp [add_tmul],
+  map_one' := rfl,
+  map_mul' := by simp }
+
+variables {S : Type*}
+
+-- we want `is_scalar_tower_right` to take priority since it's better for unification elsewhere
+@[priority 100]
+instance is_scalar_tower_right
+  [monoid S] [distrib_mul_action S A] [is_scalar_tower S A A] [smul_comm_class R S A] :
+  is_scalar_tower S (A ⊗[R] B) (A ⊗[R] B) :=
+{ smul_assoc := λ r x y, begin
+    change (r • x) * y = r • (x * y),
+    apply tensor_product.induction_on y,
+    { simp [smul_zero], },
+    { apply tensor_product.induction_on x,
+      { simp [smul_zero] },
+      { intros a b a' b',
+        dsimp,
+        rw [tensor_product.smul_tmul', tensor_product.smul_tmul', tmul_mul_tmul, smul_mul_assoc], },
+      { intros, simp [smul_add, add_mul, *], } },
+    { intros, simp [smul_add, mul_add, *], },
+  end }
+
+-- we want `algebra.to_smul_comm_class` to take priority since it's better for unification elsewhere
+@[priority 100]
+instance smul_comm_class_right
+  [monoid S] [distrib_mul_action S A] [smul_comm_class S A A] [smul_comm_class R S A] :
+  smul_comm_class S (A ⊗[R] B) (A ⊗[R] B) :=
+{ smul_comm := λ r x y, begin
+    change r • (x * y) = x * r • y,
+    apply tensor_product.induction_on y,
+    { simp [smul_zero], },
+    { apply tensor_product.induction_on x,
+      { simp [smul_zero] },
+      { intros a b a' b',
+        dsimp,
+        rw [tensor_product.smul_tmul', tensor_product.smul_tmul', tmul_mul_tmul, mul_smul_comm], },
+      { intros, simp [smul_add, add_mul, *], } },
+    { intros, simp [smul_add, mul_add, *], },
+  end }
+
+variables [comm_semiring S] [algebra S A]
+
+instance left_algebra [smul_comm_class R S A] : algebra S (A ⊗[R] B) :=
 { commutes' := λ r x,
   begin
-    apply tensor_product.induction_on x,
-    { simp, },
-    { intros a b, simp [tensor_algebra_map, algebra.commutes], },
-    { intros y y' h h', simp at h h', simp [mul_add, add_mul, h, h'], },
+    dsimp only [ring_hom.to_fun_eq_coe, ring_hom.comp_apply, include_left_ring_hom_apply],
+    rw [algebra_map_eq_smul_one, ←smul_tmul', ←one_def, mul_smul_comm, smul_mul_assoc, mul_one,
+      one_mul],
   end,
   smul_def' := λ r x,
   begin
-    apply tensor_product.induction_on x,
-    { simp [smul_zero], },
-    { intros a b,
-      rw [tensor_algebra_map, ←tmul_smul, ←smul_tmul, algebra.smul_def r a],
-      simp, },
-    { intros, dsimp, simp [smul_add, mul_add, *], },
+    dsimp only [ring_hom.to_fun_eq_coe, ring_hom.comp_apply, include_left_ring_hom_apply],
+    rw [algebra_map_eq_smul_one, ←smul_tmul', smul_mul_assoc, ←one_def, one_mul],
   end,
-  .. tensor_algebra_map,
-  .. (by apply_instance : module R (A ⊗[R] B)) }.
+  .. tensor_product.include_left_ring_hom.comp (algebra_map S A),
+  .. (by apply_instance : module S (A ⊗[R] B)) }.
+
+-- This is for the `undergrad.yaml` list.
+/-- The tensor product of two `R`-algebras is an `R`-algebra. -/
+instance : algebra R (A ⊗[R] B) := infer_instance
 
 @[simp]
-lemma algebra_map_apply (r : R) :
-  (algebra_map R (A ⊗[R] B)) r = ((algebra_map R A) r) ⊗ₜ[R] 1 := rfl
+lemma algebra_map_apply [smul_comm_class R S A] (r : S) :
+  (algebra_map S (A ⊗[R] B)) r = ((algebra_map S A) r) ⊗ₜ 1 := rfl
 
 variables {C : Type v₃} [semiring C] [algebra R C]
 
@@ -408,14 +457,11 @@ begin
   simp [H],
 end
 
-/-- The algebra morphism `A →ₐ[R] A ⊗[R] B` sending `a` to `a ⊗ₜ 1`. -/
+-- TODO: with `smul_comm_class R S A` we can have this as an `S`-algebra morphism
+/-- The `R`-algebra morphism `A →ₐ[R] A ⊗[R] B` sending `a` to `a ⊗ₜ 1`. -/
 def include_left : A →ₐ[R] A ⊗[R] B :=
-{ to_fun := λ a, a ⊗ₜ 1,
-  map_zero' := by simp,
-  map_add' := by simp [add_tmul],
-  map_one' := rfl,
-  map_mul' := by simp,
-  commutes' := by simp, }
+{ commutes' := by simp,
+  ..include_left_ring_hom }
 
 @[simp]
 lemma include_left_apply (a : A) : (include_left : A →ₐ[R] A ⊗[R] B) a = a ⊗ₜ 1 := rfl
@@ -438,6 +484,12 @@ def include_right : B →ₐ[R] A ⊗[R] B :=
 @[simp]
 lemma include_right_apply (b : B) : (include_right : B →ₐ[R] A ⊗[R] B) b = 1 ⊗ₜ b := rfl
 
+lemma include_left_comp_algebra_map {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
+  [algebra R S] [algebra R T] :
+    (include_left.to_ring_hom.comp (algebra_map R S) : R →+* S ⊗[R] T) =
+      include_right.to_ring_hom.comp (algebra_map R T) :=
+by { ext, simp }
+
 end semiring
 
 section ring
@@ -475,6 +527,20 @@ instance : comm_ring (A ⊗[R] B) :=
   end
   .. (by apply_instance : ring (A ⊗[R] B)) }.
 
+section right_algebra
+
+/-- `S ⊗[R] T` has a `T`-algebra structure. This is not a global instance or else the action of
+`S` on `S ⊗[R] S` would be ambiguous. -/
+@[reducible] def right_algebra : algebra B (A ⊗[R] B) :=
+(algebra.tensor_product.include_right.to_ring_hom : B →+* A ⊗[R] B).to_algebra
+
+local attribute [instance] tensor_product.right_algebra
+
+instance right_is_scalar_tower : is_scalar_tower R B (A ⊗[R] B) :=
+is_scalar_tower.of_algebra_map_eq (λ r, (algebra.tensor_product.include_right.commutes r).symm)
+
+end right_algebra
+
 end comm_ring
 
 /--
@@ -742,25 +808,25 @@ variables (f : A →ₐ[R] S) (g : B →ₐ[R] S)
 
 variables (R)
 
-/-- `algebra.lmul'` is an alg_hom on commutative rings. -/
+/-- `linear_map.mul'` is an alg_hom on commutative rings. -/
 def lmul' : S ⊗[R] S →ₐ[R] S :=
-alg_hom_of_linear_map_tensor_product (algebra.lmul' R)
-  (λ a₁ a₂ b₁ b₂, by simp only [algebra.lmul'_apply, mul_mul_mul_comm])
-  (λ r, by simp only [algebra.lmul'_apply, _root_.mul_one])
+alg_hom_of_linear_map_tensor_product (linear_map.mul' R S)
+  (λ a₁ a₂ b₁ b₂, by simp only [linear_map.mul'_apply, mul_mul_mul_comm])
+  (λ r, by simp only [linear_map.mul'_apply, _root_.mul_one])
 
 variables {R}
 
-lemma lmul'_to_linear_map : (lmul' R : _ →ₐ[R] S).to_linear_map = algebra.lmul' R := rfl
+lemma lmul'_to_linear_map : (lmul' R : _ →ₐ[R] S).to_linear_map = linear_map.mul' R S := rfl
 
-@[simp] lemma lmul'_apply_tmul (a b : S) : lmul' R (a ⊗ₜ[R] b) = a * b := lmul'_apply
+@[simp] lemma lmul'_apply_tmul (a b : S) : lmul' R (a ⊗ₜ[R] b) = a * b := rfl
 
 @[simp]
 lemma lmul'_comp_include_left : (lmul' R : _ →ₐ[R] S).comp include_left = alg_hom.id R S :=
-alg_hom.ext $ λ _, (lmul'_apply_tmul _ _).trans (_root_.mul_one _)
+alg_hom.ext $ _root_.mul_one
 
 @[simp]
 lemma lmul'_comp_include_right : (lmul' R : _ →ₐ[R] S).comp include_right = alg_hom.id R S :=
-alg_hom.ext $ λ _, (lmul'_apply_tmul _ _).trans (_root_.one_mul _)
+alg_hom.ext $ _root_.one_mul
 
 /--
 If `S` is commutative, for a pair of morphisms `f : A →ₐ[R] S`, `g : B →ₐ[R] S`,
@@ -771,7 +837,8 @@ def product_map : A ⊗[R] B →ₐ[R] S := (lmul' R).comp (tensor_product.map f
 @[simp] lemma product_map_apply_tmul (a : A) (b : B) : product_map f g (a ⊗ₜ b) = f a * g b :=
 by { unfold product_map lmul', simp }
 
-lemma product_map_left_apply (a : A) : product_map f g (include_left a) = f a := by simp
+lemma product_map_left_apply (a : A) :
+  product_map f g ((include_left : A →ₐ[R] A ⊗ B) a) = f a := by simp
 
 @[simp] lemma product_map_left : (product_map f g).comp include_left = f := alg_hom.ext $ by simp
 
@@ -785,9 +852,93 @@ by rw [product_map, alg_hom.range_comp, map_range, map_sup, ←alg_hom.range_com
     lmul'_comp_include_right, alg_hom.id_comp, alg_hom.id_comp]
 
 end
+section
+
+variables {R A A' B S : Type*}
+variables [comm_semiring R] [comm_semiring A] [semiring A'] [semiring B] [comm_semiring S]
+variables [algebra R A] [algebra R A'] [algebra A A'] [is_scalar_tower R A A'] [algebra R B]
+variables [algebra R S] [algebra A S] [is_scalar_tower R A S]
+
+/-- If `A`, `B` are `R`-algebras, `A'` is an `A`-algebra, then the product map of `f : A' →ₐ[A] S`
+and `g : B →ₐ[R] S` is an `A`-algebra homomorphism. -/
+@[simps] def product_left_alg_hom (f : A' →ₐ[A] S) (g : B →ₐ[R] S) : A' ⊗[R] B →ₐ[A] S :=
+{ commutes' := λ r, by { dsimp, simp },
+  ..(product_map (f.restrict_scalars R) g).to_ring_hom }
+
+end
+section basis
+
+variables {k : Type*} [comm_ring k] (R : Type*) [ring R] [algebra k R] {M : Type*}
+  [add_comm_monoid M] [module k M] {ι : Type*} (b : basis ι k M)
+
+/-- Given a `k`-algebra `R` and a `k`-basis of `M,` this is a `k`-linear isomorphism
+`R ⊗[k] M ≃ (ι →₀ R)` (which is in fact `R`-linear). -/
+noncomputable def basis_aux : R ⊗[k] M ≃ₗ[k] (ι →₀ R) :=
+(_root_.tensor_product.congr (finsupp.linear_equiv.finsupp_unique k R punit).symm b.repr) ≪≫ₗ
+  (finsupp_tensor_finsupp k R k punit ι).trans (finsupp.lcongr (equiv.unique_prod ι punit)
+  (_root_.tensor_product.rid k R))
+
+variables {R}
+
+lemma basis_aux_tmul (r : R) (m : M) :
+  basis_aux R b (r ⊗ₜ m) = r • (finsupp.map_range (algebra_map k R)
+    (map_zero _) (b.repr m)) :=
+begin
+  ext,
+  simp [basis_aux, ←algebra.commutes, algebra.smul_def],
+end
+
+lemma basis_aux_map_smul (r : R) (x : R ⊗[k] M) :
+  basis_aux R b (r • x) = r • basis_aux R b x :=
+tensor_product.induction_on x (by simp) (λ x y, by simp only [tensor_product.smul_tmul',
+  basis_aux_tmul, smul_assoc]) (λ x y hx hy, by simp [hx, hy])
+
+variables (R)
+
+/-- Given a `k`-algebra `R`, this is the `R`-basis of `R ⊗[k] M` induced by a `k`-basis of `M`. -/
+noncomputable def basis : basis ι R (R ⊗[k] M) :=
+{ repr := { map_smul' := basis_aux_map_smul b, .. basis_aux R b } }
+
+variables {R}
+
+@[simp] lemma basis_repr_tmul (r : R) (m : M) :
+  (basis R b).repr (r ⊗ₜ m) = r • (finsupp.map_range (algebra_map k R) (map_zero _) (b.repr m)) :=
+basis_aux_tmul _ _ _
+
+@[simp] lemma basis_repr_symm_apply (r : R) (i : ι) :
+  (basis R b).repr.symm (finsupp.single i r) = r ⊗ₜ b.repr.symm (finsupp.single i 1) :=
+by simp [basis, equiv.unique_prod_symm_apply, basis_aux]
+
+end basis
 end tensor_product
 end algebra
 
+namespace module
+
+variables {R M N : Type*} [comm_semiring R]
+variables [add_comm_monoid M] [add_comm_monoid N]
+variables [module R M] [module R N]
+
+/-- The algebra homomorphism from `End M ⊗ End N` to `End (M ⊗ N)` sending `f ⊗ₜ g` to
+the `tensor_product.map f g`, the tensor product of the two maps. -/
+def End_tensor_End_alg_hom : (End R M) ⊗[R] (End R N) →ₐ[R] End R (M ⊗[R] N) :=
+begin
+  refine algebra.tensor_product.alg_hom_of_linear_map_tensor_product
+    (hom_tensor_hom_map R M N M N) _ _,
+  { intros f₁ f₂ g₁ g₂,
+    simp only [hom_tensor_hom_map_apply, tensor_product.map_mul] },
+  { intro r,
+    simp only [hom_tensor_hom_map_apply],
+    ext m n, simp [smul_tmul] }
+end
+
+lemma End_tensor_End_alg_hom_apply (f : End R M) (g : End R N) :
+  End_tensor_End_alg_hom (f ⊗ₜ[R] g) = tensor_product.map f g :=
+by simp only [End_tensor_End_alg_hom,
+  algebra.tensor_product.alg_hom_of_linear_map_tensor_product_apply, hom_tensor_hom_map_apply]
+
+end module
+
 lemma subalgebra.finite_dimensional_sup {K L : Type*} [field K] [comm_ring L] [algebra K L]
   (E1 E2 : subalgebra K L) [finite_dimensional K E1] [finite_dimensional K E2] :
   finite_dimensional K ↥(E1 ⊔ E2) :=
@@ -795,3 +946,74 @@ begin
   rw [←E1.range_val, ←E2.range_val, ←algebra.tensor_product.product_map_range],
   exact (algebra.tensor_product.product_map E1.val E2.val).to_linear_map.finite_dimensional_range,
 end
+
+namespace tensor_product.algebra
+
+variables {R A B M : Type*}
+variables [comm_semiring R] [add_comm_monoid M] [module R M]
+variables [semiring A] [semiring B] [module A M] [module B M]
+variables [algebra R A] [algebra R B]
+variables [is_scalar_tower R A M] [is_scalar_tower R B M]
+
+/-- An auxiliary definition, used for constructing the `module (A ⊗[R] B) M` in
+`tensor_product.algebra.module` below. -/
+def module_aux : A ⊗[R] B →ₗ[R] M →ₗ[R] M :=
+tensor_product.lift
+{ to_fun := λ a, a • (algebra.lsmul R M : B →ₐ[R] module.End R M).to_linear_map,
+  map_add' := λ r t, by { ext, simp only [add_smul, linear_map.add_apply] },
+  map_smul' := λ n r, by { ext, simp only [ring_hom.id_apply, linear_map.smul_apply, smul_assoc] } }
+
+lemma module_aux_apply (a : A) (b : B) (m : M) :
+  module_aux (a ⊗ₜ[R] b) m = a • b • m := rfl
+
+variables [smul_comm_class A B M]
+
+/-- If `M` is a representation of two different `R`-algebras `A` and `B` whose actions commute,
+then it is a representation the `R`-algebra `A ⊗[R] B`.
+
+An important example arises from a semiring `S`; allowing `S` to act on itself via left and right
+multiplication, the roles of `R`, `A`, `B`, `M` are played by `ℕ`, `S`, `Sᵐᵒᵖ`, `S`. This example
+is important because a submodule of `S` as a `module` over `S ⊗[ℕ] Sᵐᵒᵖ` is a two-sided ideal.
+
+NB: This is not an instance because in the case `B = A` and `M = A ⊗[R] A` we would have a diamond
+of `smul` actions. Furthermore, this would not be a mere definitional diamond but a true
+mathematical diamond in which `A ⊗[R] A` had two distinct scalar actions on itself: one from its
+multiplication, and one from this would-be instance. Arguably we could live with this but in any
+case the real fix is to address the ambiguity in notation, probably along the lines outlined here:
+https://leanprover.zulipchat.com/#narrow/stream/144837-PR-reviews/topic/.234773.20base.20change/near/240929258
+-/
+protected def module : module (A ⊗[R] B) M :=
+{ smul := λ x m, module_aux x m,
+  zero_smul := λ m, by simp only [map_zero, linear_map.zero_apply],
+  smul_zero := λ x, by simp only [map_zero],
+  smul_add := λ x m₁ m₂, by simp only [map_add],
+  add_smul := λ x y m, by simp only [map_add, linear_map.add_apply],
+  one_smul := λ m, by simp only [module_aux_apply, algebra.tensor_product.one_def, one_smul],
+  mul_smul := λ x y m,
+  begin
+    apply tensor_product.induction_on x;
+    apply tensor_product.induction_on y,
+    { simp only [mul_zero, map_zero, linear_map.zero_apply], },
+    { intros a b, simp only [zero_mul, map_zero, linear_map.zero_apply], },
+    { intros z w hz hw, simp only [zero_mul, map_zero, linear_map.zero_apply], },
+    { intros a b, simp only [mul_zero, map_zero, linear_map.zero_apply], },
+    { intros a₁ b₁ a₂ b₂,
+      simp only [module_aux_apply, mul_smul, smul_comm a₁ b₂, algebra.tensor_product.tmul_mul_tmul,
+        linear_map.mul_apply], },
+    { intros z w hz hw a b,
+      simp only at hz hw,
+      simp only [mul_add, hz, hw, map_add, linear_map.add_apply], },
+    { intros z w hz hw, simp only [mul_zero, map_zero, linear_map.zero_apply], },
+    { intros a b z w hz hw,
+      simp only at hz hw,
+      simp only [map_add, add_mul, linear_map.add_apply, hz, hw], },
+    { intros u v hu hv z w hz hw,
+      simp only at hz hw,
+      simp only [add_mul, hz, hw, map_add, linear_map.add_apply], },
+  end }
+
+local attribute [instance] tensor_product.algebra.module
+
+lemma smul_def (a : A) (b : B) (m : M) : (a ⊗ₜ[R] b) • m = a • b • m := rfl
+
+end tensor_product.algebra
diff --git a/src/ring_theory/trace.lean b/src/ring_theory/trace.lean
index a00ca29fbb241..c5d0ce8bf0fdf 100644
--- a/src/ring_theory/trace.lean
+++ b/src/ring_theory/trace.lean
@@ -7,15 +7,20 @@ Authors: Anne Baanen
 import linear_algebra.matrix.bilinear_form
 import linear_algebra.matrix.charpoly.minpoly
 import linear_algebra.determinant
+import linear_algebra.finite_dimensional
 import linear_algebra.vandermonde
 import linear_algebra.trace
 import field_theory.is_alg_closed.algebraic_closure
 import field_theory.primitive_element
+import field_theory.galois
 import ring_theory.power_basis
 
 /-!
 # Trace for (finite) ring extensions.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
 the trace of the linear map given by multiplying by `s` gives information about
 the roots of the minimal polynomial of `s` over `R`.
@@ -48,7 +53,7 @@ The definition is as general as possible and the assumption that we have
 fields or that the extension is finite is added to the lemmas as needed.
 
 We only define the trace for left multiplication (`algebra.left_mul_matrix`,
-i.e. `algebra.lmul_left`).
+i.e. `linear_map.mul_left`).
 For now, the definitions assume `S` is commutative, so the choice doesn't matter anyway.
 
 ## References
@@ -99,7 +104,7 @@ variables {R}
 -- Can't be a `simp` lemma because it depends on a choice of basis
 lemma trace_eq_matrix_trace [decidable_eq ι] (b : basis ι R S) (s : S) :
   trace R S s = matrix.trace (algebra.left_mul_matrix b s) :=
-by rw [trace_apply, linear_map.trace_eq_matrix_trace _ b, to_matrix_lmul_eq]
+by { rw [trace_apply, linear_map.trace_eq_matrix_trace _ b, ←to_matrix_lmul_eq], refl }
 
 /-- If `x` is in the base field `K`, then the trace is `[L : K] * x`. -/
 lemma trace_algebra_map_of_basis (x : R) :
@@ -109,7 +114,7 @@ begin
   rw [trace_apply, linear_map.trace_eq_matrix_trace R b, matrix.trace],
   convert finset.sum_const _,
   ext i,
-  simp,
+  simp [-coe_lmul_eq_mul],
 end
 omit b
 
@@ -125,13 +130,14 @@ begin
   { simp [trace_eq_zero_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis_finset H] }
 end
 
-lemma trace_trace_of_basis [algebra S T] [is_scalar_tower R S T]
-  {ι κ : Type*} [fintype ι] [fintype κ]
+lemma trace_trace_of_basis [algebra S T] [is_scalar_tower R S T] {ι κ : Type*} [finite ι] [finite κ]
   (b : basis ι R S) (c : basis κ S T) (x : T) :
   trace R S (trace S T x) = trace R T x :=
 begin
   haveI := classical.dec_eq ι,
   haveI := classical.dec_eq κ,
+  casesI nonempty_fintype ι,
+  casesI nonempty_fintype κ,
   rw [trace_eq_matrix_trace (b.smul c), trace_eq_matrix_trace b, trace_eq_matrix_trace c,
       matrix.trace, matrix.trace, matrix.trace,
       ← finset.univ_product_univ, finset.sum_product],
@@ -141,9 +147,8 @@ begin
       finset.sum_apply i _ (λ y, left_mul_matrix b (left_mul_matrix c x y y))]
 end
 
-lemma trace_comp_trace_of_basis [algebra S T] [is_scalar_tower R S T]
-  {ι κ : Type*} [fintype ι] [fintype κ]
-  (b : basis ι R S) (c : basis κ S T) :
+lemma trace_comp_trace_of_basis [algebra S T] [is_scalar_tower R S T] {ι κ : Type*} [finite ι]
+  [fintype κ] (b : basis ι R S) (c : basis κ S T) :
   (trace R S).comp ((trace S T).restrict_scalars R) = trace R T :=
 by { ext, rw [linear_map.comp_apply, linear_map.restrict_scalars_apply, trace_trace_of_basis b c] }
 
@@ -159,6 +164,24 @@ lemma trace_comp_trace [algebra K T] [algebra L T] [is_scalar_tower K L T]
   (trace K L).comp ((trace L T).restrict_scalars K) = trace K T :=
 by { ext, rw [linear_map.comp_apply, linear_map.restrict_scalars_apply, trace_trace] }
 
+@[simp]
+lemma trace_prod_apply
+  [module.free R S] [module.free R T] [module.finite R S] [module.finite R T]
+  (x : S × T) : trace R (S × T) x = trace R S x.fst + trace R T x.snd :=
+begin
+  nontriviality R,
+  let f := (lmul R S).to_linear_map.prod_map (lmul R T).to_linear_map,
+  have : (lmul R (S × T)).to_linear_map = (prod_map_linear R S T S T R).comp f :=
+    linear_map.ext₂ prod.mul_def,
+  simp_rw [trace, this],
+  exact trace_prod_map' _ _,
+end
+
+lemma trace_prod
+  [module.free R S] [module.free R T] [module.finite R S] [module.finite R T] :
+  trace R (S × T) = (trace R S).coprod (trace R T) :=
+linear_map.ext $ λ p, by rw [coprod_apply, trace_prod_apply]
+
 section trace_form
 
 variables (R S)
@@ -181,8 +204,8 @@ lemma trace_form_to_matrix [decidable_eq ι] (i j) :
 by rw [bilin_form.to_matrix_apply, trace_form_apply]
 
 lemma trace_form_to_matrix_power_basis (h : power_basis R S) :
-  bilin_form.to_matrix h.basis (trace_form R S) = λ i j, (trace R S (h.gen ^ (i + j : ℕ))) :=
-by { ext, rw [trace_form_to_matrix, pow_add, h.basis_eq_pow, h.basis_eq_pow] }
+  bilin_form.to_matrix h.basis (trace_form R S) = of (λ i j, trace R S (h.gen ^ (↑i + ↑j : ℕ))) :=
+by { ext, rw [trace_form_to_matrix, of_apply, pow_add, h.basis_eq_pow, h.basis_eq_pow] }
 
 end trace_form
 
@@ -230,7 +253,7 @@ begin
   contrapose! hx,
   obtain ⟨s, ⟨b⟩⟩ := hx,
   refine is_integral_of_mem_of_fg (K⟮x⟯).to_subalgebra _ x _,
-  { exact (submodule.fg_iff_finite_dimensional _).mpr (finite_dimensional.of_finset_basis b) },
+  { exact (submodule.fg_iff_finite_dimensional _).mpr (finite_dimensional.of_fintype_basis b) },
   { exact subset_adjoin K _ (set.mem_singleton x) }
 end
 
@@ -281,10 +304,10 @@ variables [algebra R L] [algebra L F] [algebra R F] [is_scalar_tower R L F]
 
 open polynomial
 
-lemma algebra.is_integral_trace [finite_dimensional L F] {x : F} (hx : _root_.is_integral R x) :
-  _root_.is_integral R (algebra.trace L F x) :=
+lemma algebra.is_integral_trace [finite_dimensional L F] {x : F} (hx : is_integral R x) :
+  is_integral R (algebra.trace L F x) :=
 begin
-  have hx' : _root_.is_integral L x := is_integral_of_is_scalar_tower _ hx,
+  have hx' : is_integral L x := is_integral_of_is_scalar_tower hx,
   rw [← is_integral_algebra_map_iff (algebra_map L (algebraic_closure F)).injective,
       trace_eq_sum_roots],
   { refine (is_integral.multiset_sum _).nsmul _,
@@ -356,6 +379,21 @@ begin
     exact is_separable.separable K _ }
 end
 
+lemma trace_eq_sum_automorphisms (x : L) [finite_dimensional K L] [is_galois K L] :
+  algebra_map K L (algebra.trace K L x) = ∑ (σ : L ≃ₐ[K] L), σ x :=
+begin
+  apply no_zero_smul_divisors.algebra_map_injective L (algebraic_closure L),
+  rw map_sum (algebra_map L (algebraic_closure L)),
+  rw ← fintype.sum_equiv (normal.alg_hom_equiv_aut K (algebraic_closure L) L),
+  { rw ←trace_eq_sum_embeddings (algebraic_closure L),
+    { simp only [algebra_map_eq_smul_one, smul_one_smul] },
+    { exact is_galois.to_is_separable } },
+  { intro σ,
+    simp only [normal.alg_hom_equiv_aut, alg_hom.restrict_normal', equiv.coe_fn_mk,
+               alg_equiv.coe_of_bijective, alg_hom.restrict_normal_commutes, id.map_eq_id,
+               ring_hom.id_apply] },
+end
+
 end eq_sum_embeddings
 
 section det_ne_zero
@@ -369,11 +407,15 @@ open finset
 
 /-- Given an `A`-algebra `B` and `b`, an `κ`-indexed family of elements of `B`, we define
 `trace_matrix A b` as the matrix whose `(i j)`-th element is the trace of `b i * b j`. -/
-@[simp] noncomputable
-def trace_matrix (b : κ → B) : matrix κ κ A
-| i j := trace_form A B (b i) (b j)
+noncomputable
+def trace_matrix (b : κ → B) : matrix κ κ A :=
+of $ λ i j, trace_form A B (b i) (b j)
 
-lemma trace_matrix_def (b : κ → B) : trace_matrix A b = λ i j, trace_form A B (b i) (b j) := rfl
+-- TODO: set as an equation lemma for `trace_matrix`, see mathlib4#3024
+@[simp]
+lemma trace_matrix_apply (b : κ → B) (i j) :
+  trace_matrix A b i j = trace_form A B (b i) (b j) :=
+rfl
 
 lemma trace_matrix_reindex {κ' : Type*} (b : basis κ A B) (f : κ ≃ κ') :
   trace_matrix A (b.reindex f) = reindex f f (trace_matrix A b) :=
@@ -385,7 +427,7 @@ lemma trace_matrix_of_matrix_vec_mul [fintype κ] (b : κ → B) (P : matrix κ
   trace_matrix A ((P.map (algebra_map A B)).vec_mul b) = Pᵀ ⬝ (trace_matrix A b) ⬝ P :=
 begin
   ext α β,
-  rw [trace_matrix, vec_mul, dot_product, vec_mul, dot_product, matrix.mul_apply,
+  rw [trace_matrix_apply, vec_mul, dot_product, vec_mul, dot_product, matrix.mul_apply,
     bilin_form.sum_left, fintype.sum_congr _ _ (λ (i : κ), @bilin_form.sum_right _ _ _ _ _ _ _ _
     (b i * P.map (algebra_map A B) i α) (λ (y : κ), b y * P.map (algebra_map A B) y β)), sum_comm],
   congr, ext x,
@@ -396,13 +438,13 @@ begin
     trace_form_apply, algebra.smul_mul_assoc],
   rw [mul_comm (b x), ← smul_def],
   ring_nf,
-  simp,
+  simp [mul_comm],
 end
 
 lemma trace_matrix_of_matrix_mul_vec [fintype κ] (b : κ → B) (P : matrix κ κ A) :
   trace_matrix A ((P.map (algebra_map A B)).mul_vec b) = P ⬝ (trace_matrix A b) ⬝ Pᵀ :=
 begin
-  refine add_equiv.injective transpose_add_equiv _,
+  refine add_equiv.injective (transpose_add_equiv _ _ _) _,
   rw [transpose_add_equiv_apply, transpose_add_equiv_apply, ← vec_mul_transpose,
     ← transpose_map, trace_matrix_of_matrix_vec_mul, transpose_transpose, transpose_mul,
     transpose_transpose, transpose_mul]
@@ -412,7 +454,7 @@ lemma trace_matrix_of_basis [fintype κ] [decidable_eq κ] (b : basis κ A B) :
   trace_matrix A b = bilin_form.to_matrix b (trace_form A B) :=
 begin
   ext i j,
-  rw [trace_matrix, trace_form_apply, trace_form_to_matrix]
+  rw [trace_matrix_apply, trace_form_apply, trace_form_to_matrix]
 end
 
 lemma trace_matrix_of_basis_mul_vec (b : basis ι A B) (z : B) :
@@ -420,11 +462,11 @@ lemma trace_matrix_of_basis_mul_vec (b : basis ι A B) (z : B) :
 begin
   ext i,
   rw [← col_apply ((trace_matrix A b).mul_vec (b.equiv_fun z)) i unit.star, col_mul_vec,
-    matrix.mul_apply, trace_matrix_def],
+    matrix.mul_apply, trace_matrix],
   simp only [col_apply, trace_form_apply],
   conv_lhs
   { congr, skip, funext,
-    rw [mul_comm _ (b.equiv_fun z _), ← smul_eq_mul, ← linear_map.map_smul] },
+    rw [mul_comm _ (b.equiv_fun z _), ← smul_eq_mul, of_apply, ← linear_map.map_smul] },
     rw [← linear_map.map_sum],
     congr,
     conv_lhs
@@ -439,8 +481,12 @@ variable (A)
 /-- `embeddings_matrix A C b : matrix κ (B →ₐ[A] C) C` is the matrix whose `(i, σ)` coefficient is
   `σ (b i)`. It is mostly useful for fields when `fintype.card κ = finrank A B` and `C` is
   algebraically closed. -/
-@[simp] def embeddings_matrix (b : κ → B) : matrix κ (B →ₐ[A] C) C
-| i σ := σ (b i)
+def embeddings_matrix (b : κ → B) : matrix κ (B →ₐ[A] C) C :=
+of $ λ i (σ : B →ₐ[A] C), σ (b i)
+
+-- TODO: set as an equation lemma for `embeddings_matrix`, see mathlib4#3024
+@[simp] lemma embeddings_matrix_apply (b : κ → B) (i) (σ : B →ₐ[A] C) :
+  embeddings_matrix A C b i σ = σ (b i) := rfl
 
 /-- `embeddings_matrix_reindex A C b e : matrix κ κ C` is the matrix whose `(i, j)` coefficient
   is `σⱼ (b i)`, where `σⱼ : B →ₐ[A] C` is the embedding corresponding to `j : κ` given by a
@@ -473,7 +519,7 @@ lemma trace_matrix_eq_embeddings_matrix_reindex_mul_trans [fintype κ]
   (e : κ ≃ (L →ₐ[K] E)) : (trace_matrix K b).map (algebra_map K E) =
   (embeddings_matrix_reindex K E b e) ⬝ (embeddings_matrix_reindex K E b e)ᵀ :=
 by rw [trace_matrix_eq_embeddings_matrix_mul_trans, embeddings_matrix_reindex, reindex_apply,
-  transpose_minor, ← minor_mul_transpose_minor, ← equiv.coe_refl, equiv.refl_symm]
+  transpose_submatrix, ← submatrix_mul_transpose_submatrix, ← equiv.coe_refl, equiv.refl_symm]
 
 end field
 
@@ -497,7 +543,7 @@ begin
   refine mt mul_self_eq_zero.mp _,
   { simp only [det_vandermonde, finset.prod_eq_zero_iff, not_exists, sub_eq_zero],
     intros i _ j hij h,
-    exact (finset.mem_filter.mp hij).2.ne' (e.injective $ pb.alg_hom_ext h) },
+    exact (finset.mem_Ioi.mp hij).ne' (e.injective $ pb.alg_hom_ext h) },
   { rw [alg_hom.card, pb.finrank] }
 end
 
diff --git a/src/ring_theory/unique_factorization_domain.lean b/src/ring_theory/unique_factorization_domain.lean
index a14c36192d98a..d4c443fe63a91 100644
--- a/src/ring_theory/unique_factorization_domain.lean
+++ b/src/ring_theory/unique_factorization_domain.lean
@@ -14,6 +14,9 @@ import ring_theory.multiplicity
 
 # Unique factorization
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 * `wf_dvd_monoid` holds for `monoid`s for which a strict divisibility relation is
   well-founded.
@@ -71,41 +74,32 @@ local attribute [elab_as_eliminator] well_founded.fix
 
 lemma exists_irreducible_factor {a : α} (ha : ¬ is_unit a) (ha0 : a ≠ 0) :
   ∃ i, irreducible i ∧ i ∣ a :=
-(irreducible_or_factor a ha).elim (λ hai, ⟨a, hai, dvd_rfl⟩)
-  (well_founded.fix
-    well_founded_dvd_not_unit
-    (λ a ih ha ha0 ⟨x, y, hx, hy, hxy⟩,
-      have hx0 : x ≠ 0, from λ hx0, ha0 (by rw [← hxy, hx0, zero_mul]),
-      (irreducible_or_factor x hx).elim
-        (λ hxi, ⟨x, hxi, hxy ▸ by simp⟩)
-        (λ hxf, let ⟨i, hi⟩ := ih x ⟨hx0, y, hy, hxy.symm⟩ hx hx0 hxf in
-          ⟨i, hi.1, hi.2.trans (hxy ▸ by simp)⟩)) a ha ha0)
+let ⟨b, hs, hr⟩ := well_founded_dvd_not_unit.has_min {b | b ∣ a ∧ ¬ is_unit b} ⟨a, dvd_rfl, ha⟩ in
+⟨b, ⟨hs.2, λ c d he, let h := dvd_trans ⟨d, he⟩ hs.1 in or_iff_not_imp_left.2 $
+  λ hc, of_not_not $ λ hd, hr c ⟨h, hc⟩ ⟨ne_zero_of_dvd_ne_zero ha0 h, d, hd, he⟩⟩, hs.1⟩
 
 @[elab_as_eliminator] lemma induction_on_irreducible {P : α → Prop} (a : α)
   (h0 : P 0) (hu : ∀ u : α, is_unit u → P u)
   (hi : ∀ a i : α, a ≠ 0 → irreducible i → P a → P (i * a)) :
   P a :=
 by haveI := classical.dec; exact
-well_founded.fix well_founded_dvd_not_unit
-  (λ a ih, if ha0 : a = 0 then ha0.symm ▸ h0
+well_founded_dvd_not_unit.fix
+  (λ a ih, if ha0 : a = 0 then ha0.substr h0
     else if hau : is_unit a then hu a hau
-    else let ⟨i, hii, ⟨b, hb⟩⟩ := exists_irreducible_factor hau ha0 in
-      have hb0 : b ≠ 0, from λ hb0, by simp * at *,
-      hb.symm ▸ hi _ _ hb0 hii (ih _ ⟨hb0, i,
-        hii.1, by rw [hb, mul_comm]⟩))
+    else let ⟨i, hii, b, hb⟩ := exists_irreducible_factor hau ha0,
+      hb0 : b ≠ 0 := ne_zero_of_dvd_ne_zero ha0 ⟨i, mul_comm i b ▸ hb⟩ in
+      hb.symm ▸ hi b i hb0 hii $ ih b ⟨hb0, i, hii.1, mul_comm i b ▸ hb⟩)
   a
 
 lemma exists_factors (a : α) : a ≠ 0 →
   ∃ f : multiset α, (∀ b ∈ f, irreducible b) ∧ associated f.prod a :=
 induction_on_irreducible a
   (λ h, (h rfl).elim)
-  (λ u hu _, ⟨0, ⟨by simp [hu], associated.symm (by simp [hu, associated_one_iff_is_unit])⟩⟩)
-  (λ a i ha0 hii ih hia0,
+  (λ u hu _, ⟨0, λ _ h, h.elim, hu.unit, one_mul _⟩)
+  (λ a i ha0 hi ih _,
     let ⟨s, hs⟩ := ih ha0 in
-    ⟨i ::ₘ s, ⟨by clear _let_match;
-    { intros b H, cases (multiset.mem_cons.mp H), { convert hii }, { exact hs.1 b h } },
-      by { rw multiset.prod_cons,
-           exact hs.2.mul_left _ }⟩⟩)
+    ⟨i ::ₘ s, λ b H, (multiset.mem_cons.1 H).elim (λ h, h.symm ▸ hi) (hs.1 b),
+      by { rw s.prod_cons i, exact hs.2.mul_left i }⟩)
 
 lemma not_unit_iff_exists_factors_eq (a : α) (hn0 : a ≠ 0) :
   ¬ is_unit a ↔ ∃ f : multiset α, (∀ b ∈ f, irreducible b) ∧ f.prod = a ∧ f ≠ ∅ :=
@@ -117,8 +111,8 @@ lemma not_unit_iff_exists_factors_eq (a : α) (hn0 : a ≠ 0) :
     exacts [associated.irreducible ⟨u,rfl⟩ (hi b h), hi a (multiset.mem_of_mem_erase ha)] },
   { rw [multiset.prod_cons, mul_comm b, mul_assoc, multiset.prod_erase h, mul_comm] },
 end,
-λ ⟨f,hi,he,hne⟩, let ⟨b, h⟩ := multiset.exists_mem_of_ne_zero hne in
-  not_is_unit_of_not_is_unit_dvd (hi b h).not_unit (he.subst $ multiset.dvd_prod h)⟩
+λ ⟨f, hi, he, hne⟩, let ⟨b, h⟩ := multiset.exists_mem_of_ne_zero hne in
+  not_is_unit_of_not_is_unit_dvd (hi b h).not_unit $ he ▸ multiset.dvd_prod h⟩
 
 end wf_dvd_monoid
 
@@ -184,32 +178,6 @@ begin
   exact wf_dvd_monoid.induction_on_irreducible a h₁ h₂ h₃,
 end
 
-lemma factors_unique : ∀{f g : multiset α},
-  (∀x∈f, irreducible x) → (∀x∈g, irreducible x) → f.prod ~ᵤ g.prod →
-  multiset.rel associated f g :=
-by haveI := classical.dec_eq α; exact
-λ f, multiset.induction_on f
-  (λ g _ hg h,
-    multiset.rel_zero_left.2 $
-      multiset.eq_zero_of_forall_not_mem (λ x hx,
-        have is_unit g.prod, by simpa [associated_one_iff_is_unit] using h.symm,
-        (hg x hx).not_unit (is_unit_iff_dvd_one.2 ((multiset.dvd_prod hx).trans
-          (is_unit_iff_dvd_one.1 this)))))
-  (λ p f ih g hf hg hfg,
-    let ⟨b, hbg, hb⟩ := exists_associated_mem_of_dvd_prod
-      (irreducible_iff_prime.1 (hf p (by simp)))
-      (λ q hq, irreducible_iff_prime.1 (hg _ hq)) $
-        hfg.dvd_iff_dvd_right.1
-          (show p ∣ (p ::ₘ f).prod, by simp) in
-    begin
-      rw ← multiset.cons_erase hbg,
-      exact multiset.rel.cons hb (ih (λ q hq, hf _ (by simp [hq]))
-        (λ q (hq : q ∈ g.erase b), hg q (multiset.mem_of_mem_erase hq))
-        (associated.of_mul_left
-          (by rwa [← multiset.prod_cons, ← multiset.prod_cons, multiset.cons_erase hbg]) hb
-        (hf p (by simp)).ne_zero))
-    end)
-
 end unique_factorization_monoid
 
 lemma prime_factors_unique [cancel_comm_monoid_with_zero α] : ∀ {f g : multiset α},
@@ -237,6 +205,18 @@ by haveI := classical.dec_eq α; exact
         (hf p (by simp)).ne_zero)),
     end)
 
+namespace unique_factorization_monoid
+variables [cancel_comm_monoid_with_zero α] [unique_factorization_monoid α]
+
+lemma factors_unique {f g : multiset α} (hf : ∀ x ∈ f, irreducible x) (hg : ∀ x ∈ g, irreducible x)
+  (h : f.prod ~ᵤ g.prod) : multiset.rel associated f g :=
+prime_factors_unique
+  (λ x hx, irreducible_iff_prime.mp (hf x hx))
+  (λ x hx, irreducible_iff_prime.mp (hg x hx))
+  h
+
+end unique_factorization_monoid
+
 /-- If an irreducible has a prime factorization,
   then it is an associate of one of its prime factors. -/
 lemma prime_factors_irreducible [cancel_comm_monoid_with_zero α] {a : α} {f : multiset α}
@@ -273,7 +253,7 @@ lemma wf_dvd_monoid.of_exists_prime_factors : wf_dvd_monoid α :=
 ⟨begin
   classical,
   refine rel_hom_class.well_founded
-    (rel_hom.mk _ _ : (dvd_not_unit : α → α → Prop) →r ((<) : with_top ℕ → with_top ℕ → Prop))
+    (rel_hom.mk _ _ : (dvd_not_unit : α → α → Prop) →r ((<) : ℕ∞ → ℕ∞ → Prop))
     (with_top.well_founded_lt nat.lt_wf),
   { intro a,
     by_cases h : a = 0, { exact ⊤ },
@@ -413,17 +393,38 @@ begin
   exact (classical.some_spec (exists_prime_factors a ane0)).2
 end
 
-theorem prime_of_factor {a : α} : ∀ (x : α), x ∈ factors a → prime x :=
+lemma ne_zero_of_mem_factors {p a : α} (h : p ∈ factors a) : a ≠ 0 :=
 begin
-  rw [factors],
-  split_ifs with ane0, { simp only [multiset.not_mem_zero, forall_false_left, forall_const] },
-  intros x hx,
+  intro ha,
+  rw [factors, dif_pos ha] at h,
+  exact multiset.not_mem_zero _ h
+end
+
+lemma dvd_of_mem_factors {p a : α} (h : p ∈ factors a) : p ∣ a :=
+dvd_trans (multiset.dvd_prod h) (associated.dvd (factors_prod (ne_zero_of_mem_factors h)))
+
+theorem prime_of_factor {a : α} (x : α) (hx : x ∈ factors a) : prime x :=
+begin
+  have ane0 := ne_zero_of_mem_factors hx,
+  rw [factors, dif_neg ane0] at hx,
   exact (classical.some_spec (unique_factorization_monoid.exists_prime_factors a ane0)).1 x hx,
 end
 
 theorem irreducible_of_factor {a : α} : ∀ (x : α), x ∈ factors a → irreducible x :=
 λ x h, (prime_of_factor x h).irreducible
 
+@[simp] lemma factors_zero : factors (0 : α) = 0 :=
+by simp [factors]
+
+@[simp] lemma factors_one : factors (1 : α) = 0 :=
+begin
+  nontriviality α using [factors],
+  rw ← multiset.rel_zero_right,
+  refine factors_unique irreducible_of_factor (λ x hx, (multiset.not_mem_zero x hx).elim) _,
+  rw multiset.prod_zero,
+  exact factors_prod one_ne_zero,
+end
+
 lemma exists_mem_factors_of_dvd {a p : α} (ha0 : a ≠ 0) (hp : irreducible p) : p ∣ a →
   ∃ q ∈ factors a, p ~ᵤ q :=
 λ ⟨b, hb⟩,
@@ -438,6 +439,48 @@ have multiset.rel associated (p ::ₘ factors b) (factors a),
         by rw multiset.prod_cons; exact (factors_prod hb0).symm.mul_left _),
 multiset.exists_mem_of_rel_of_mem this (by simp)
 
+lemma exists_mem_factors {x : α} (hx : x ≠ 0) (h : ¬ is_unit x) : ∃ p, p ∈ factors x :=
+begin
+  obtain ⟨p', hp', hp'x⟩ := wf_dvd_monoid.exists_irreducible_factor h hx,
+  obtain ⟨p, hp, hpx⟩ := exists_mem_factors_of_dvd hx hp' hp'x,
+  exact ⟨p, hp⟩
+end
+
+lemma factors_mul {x y : α} (hx : x ≠ 0) (hy : y ≠ 0) :
+  multiset.rel associated (factors (x * y)) (factors x + factors y) :=
+begin
+  refine factors_unique irreducible_of_factor
+    (λ a ha, (multiset.mem_add.mp ha).by_cases (irreducible_of_factor _) (irreducible_of_factor _))
+    ((factors_prod (mul_ne_zero hx hy)).trans _),
+  rw multiset.prod_add,
+  exact (associated.mul_mul (factors_prod hx) (factors_prod hy)).symm,
+end
+
+lemma factors_pow {x : α} (n : ℕ) :
+  multiset.rel associated (factors (x ^ n)) (n • factors x) :=
+begin
+  induction n with n ih,
+  { simp },
+  by_cases h0 : x = 0,
+  { simp [h0, zero_pow n.succ_pos, smul_zero] },
+  rw [pow_succ, succ_nsmul],
+  refine multiset.rel.trans _ (factors_mul h0 (pow_ne_zero n h0)) _,
+  refine multiset.rel.add _ ih,
+  exact multiset.rel_refl_of_refl_on (λ y hy, associated.refl _),
+end
+
+@[simp] lemma factors_pos (x : α) (hx : x ≠ 0) : 0 < factors x ↔ ¬ is_unit x :=
+begin
+  split,
+  { intros h hx,
+    obtain ⟨p, hp⟩ := multiset.exists_mem_of_ne_zero h.ne',
+    exact (prime_of_factor _ hp).not_unit (is_unit_of_dvd_unit (dvd_of_mem_factors hp) hx) },
+  { intros h,
+    obtain ⟨p, hp⟩ := exists_mem_factors hx h,
+    exact bot_lt_iff_ne_bot.mpr (mt multiset.eq_zero_iff_forall_not_mem.mp
+      (not_forall.mpr ⟨p, not_not.mpr hp⟩)) },
+end
+
 end unique_factorization_monoid
 
 namespace unique_factorization_monoid
@@ -505,6 +548,15 @@ begin
   rwa [← normalize_normalized_factor p p_mem, normalize_eq_normalize_iff, dvd_dvd_iff_associated]
 end
 
+lemma normalized_factors_eq_of_dvd (a : α) : ∀ (p q ∈ normalized_factors a), p ∣ q → p = q :=
+begin
+  intros p hp q hq hdvd,
+  convert normalize_eq_normalize hdvd
+    (((prime_of_normalized_factor _ hp).irreducible).dvd_symm
+      ((prime_of_normalized_factor _ hq).irreducible) hdvd);
+    apply (normalize_normalized_factor _ _).symm; assumption
+end
+
 lemma exists_mem_normalized_factors_of_dvd {a p : α} (ha0 : a ≠ 0) (hp : irreducible p) : p ∣ a →
   ∃ q ∈ normalized_factors a, p ~ᵤ q :=
 λ ⟨b, hb⟩,
@@ -520,6 +572,14 @@ have multiset.rel associated (p ::ₘ normalized_factors b) (normalized_factors
         by rw multiset.prod_cons; exact (normalized_factors_prod hb0).symm.mul_left _),
 multiset.exists_mem_of_rel_of_mem this (by simp)
 
+lemma exists_mem_normalized_factors {x : α} (hx : x ≠ 0) (h : ¬ is_unit x) :
+  ∃ p, p ∈ normalized_factors x :=
+begin
+  obtain ⟨p', hp', hp'x⟩ := wf_dvd_monoid.exists_irreducible_factor h hx,
+  obtain ⟨p, hp, hpx⟩ := exists_mem_normalized_factors_of_dvd hx hp' hp'x,
+  exact ⟨p, hp⟩
+end
+
 @[simp] lemma normalized_factors_zero : normalized_factors (0 : α) = 0 :=
 by simp [normalized_factors, factors]
 
@@ -531,7 +591,7 @@ begin
   { intros x hx,
     exfalso,
     apply multiset.not_mem_zero x hx },
-  { simp [normalized_factors_prod (@one_ne_zero α _ _)] },
+  { simp [normalized_factors_prod one_ne_zero] },
   apply_instance
 end
 
@@ -569,9 +629,25 @@ begin
 end
 
 theorem _root_.irreducible.normalized_factors_pow {p : α} (hp : irreducible p) (k : ℕ) :
-  normalized_factors (p ^ k) = multiset.repeat (normalize p) k :=
+  normalized_factors (p ^ k) = multiset.replicate k (normalize p) :=
 by rw [normalized_factors_pow, normalized_factors_irreducible hp, multiset.nsmul_singleton]
 
+theorem normalized_factors_prod_eq (s : multiset α) (hs : ∀ a ∈ s, irreducible a) :
+  normalized_factors s.prod = s.map normalize :=
+begin
+  induction s using multiset.induction with a s ih,
+  { rw [multiset.prod_zero, normalized_factors_one, multiset.map_zero] },
+  { have ia := hs a (multiset.mem_cons_self a _),
+    have ib := λ b h, hs b (multiset.mem_cons_of_mem h),
+    obtain rfl | ⟨b, hb⟩ := s.empty_or_exists_mem,
+    { rw [multiset.cons_zero, multiset.prod_singleton,
+          multiset.map_singleton, normalized_factors_irreducible ia] },
+    haveI := nontrivial_of_ne b 0 (ib b hb).ne_zero,
+    rw [multiset.prod_cons, multiset.map_cons, normalized_factors_mul ia.ne_zero,
+      normalized_factors_irreducible ia, ih],
+    exacts [rfl, ib, multiset.prod_ne_zero (λ h, (ib 0 h).ne_zero rfl)] },
+end
+
 lemma dvd_iff_normalized_factors_le_normalized_factors {x y : α} (hx : x ≠ 0) (hy : y ≠ 0) :
   x ∣ y ↔ normalized_factors x ≤ normalized_factors y :=
 begin
@@ -583,8 +659,17 @@ begin
     apply multiset.prod_dvd_prod_of_le }
 end
 
+lemma associated_iff_normalized_factors_eq_normalized_factors {x y : α} (hx : x ≠ 0) (hy : y ≠ 0) :
+  x ~ᵤ y ↔ normalized_factors x = normalized_factors y :=
+begin
+  refine ⟨λ h, _,
+    λ h, (normalized_factors_prod hx).symm.trans (trans (by rw h) (normalized_factors_prod hy))⟩,
+  apply le_antisymm; rw [← dvd_iff_normalized_factors_le_normalized_factors],
+  all_goals { simp [*, h.dvd, h.symm.dvd], },
+end
+
 theorem normalized_factors_of_irreducible_pow {p : α} (hp : irreducible p) (k : ℕ) :
-  normalized_factors (p ^ k) = multiset.repeat (normalize p) k :=
+  normalized_factors (p ^ k) = multiset.replicate k (normalize p) :=
 by rw [normalized_factors_pow, normalized_factors_irreducible hp, multiset.nsmul_singleton]
 
 lemma zero_not_mem_normalized_factors (x : α) : (0 : α) ∉ normalized_factors x :=
@@ -603,7 +688,48 @@ lemma exists_associated_prime_pow_of_unique_normalized_factor {p r : α}
 begin
   use (normalized_factors r).card,
   have := unique_factorization_monoid.normalized_factors_prod hr,
-  rwa [multiset.eq_repeat_of_mem (λ b, h), multiset.prod_repeat] at this
+  rwa [multiset.eq_replicate_of_mem (λ b, h), multiset.prod_replicate] at this
+end
+
+lemma normalized_factors_prod_of_prime [nontrivial α] [unique αˣ] {m : multiset α}
+  (h : ∀ p ∈ m, prime p) : (normalized_factors m.prod) = m :=
+by simpa only [←multiset.rel_eq, ←associated_eq_eq] using prime_factors_unique
+  (prime_of_normalized_factor) h (normalized_factors_prod (m.prod_ne_zero_of_prime h))
+
+lemma mem_normalized_factors_eq_of_associated {a b c : α} (ha : a ∈ normalized_factors c)
+  (hb : b ∈ normalized_factors c) (h : associated a b) : a = b :=
+begin
+  rw [← normalize_normalized_factor a ha, ← normalize_normalized_factor b hb,
+    normalize_eq_normalize_iff],
+  apply associated.dvd_dvd h,
+end
+
+@[simp] lemma normalized_factors_pos (x : α) (hx : x ≠ 0) :
+  0 < normalized_factors x ↔ ¬ is_unit x :=
+begin
+  split,
+  { intros h hx,
+    obtain ⟨p, hp⟩ := multiset.exists_mem_of_ne_zero h.ne',
+    exact (prime_of_normalized_factor _ hp).not_unit
+      (is_unit_of_dvd_unit (dvd_of_mem_normalized_factors hp) hx) },
+  { intros h,
+    obtain ⟨p, hp⟩ := exists_mem_normalized_factors hx h,
+    exact bot_lt_iff_ne_bot.mpr (mt multiset.eq_zero_iff_forall_not_mem.mp
+      (not_forall.mpr ⟨p, not_not.mpr hp⟩)) },
+end
+
+lemma dvd_not_unit_iff_normalized_factors_lt_normalized_factors
+  {x y : α} (hx : x ≠ 0) (hy : y ≠ 0) :
+  dvd_not_unit x y ↔ normalized_factors x < normalized_factors y :=
+begin
+  split,
+  { rintro ⟨_, c, hc, rfl⟩,
+    simp only [hx, right_ne_zero_of_mul hy, normalized_factors_mul, ne.def, not_false_iff,
+      lt_add_iff_pos_right, normalized_factors_pos, hc] },
+  { intro h,
+    exact dvd_not_unit_of_dvd_of_not_dvd
+      ((dvd_iff_normalized_factors_le_normalized_factors hx hy).mpr h.le)
+      (mt (dvd_iff_normalized_factors_le_normalized_factors hy hx).mp h.not_le) }
 end
 
 end unique_factorization_monoid
@@ -718,15 +844,33 @@ lemma exists_reduced_factors' (a b : R) (hb : b ≠ 0) :
 let ⟨b', a', c', no_factor, hb, ha⟩ := exists_reduced_factors b hb a
 in ⟨a', b', c', λ _ hpb hpa, no_factor hpa hpb, ha, hb⟩
 
+lemma pow_right_injective {a : R} (ha0 : a ≠ 0) (ha1 : ¬ is_unit a) :
+  function.injective ((^) a : ℕ → R) :=
+begin
+  letI := classical.dec_eq R,
+  intros i j hij,
+  letI : nontrivial R := ⟨⟨a, 0, ha0⟩⟩,
+  letI : normalization_monoid R := unique_factorization_monoid.normalization_monoid,
+  obtain ⟨p', hp', dvd'⟩ := wf_dvd_monoid.exists_irreducible_factor ha1 ha0,
+  obtain ⟨p, mem, _⟩ := exists_mem_normalized_factors_of_dvd ha0 hp' dvd',
+  have := congr_arg (λ x, multiset.count p (normalized_factors x)) hij,
+  simp only [normalized_factors_pow, multiset.count_nsmul] at this,
+  exact mul_right_cancel₀ (multiset.count_ne_zero.mpr mem) this
+end
+
+lemma pow_eq_pow_iff {a : R} (ha0 : a ≠ 0) (ha1 : ¬ is_unit a) {i j : ℕ} :
+  a ^ i = a ^ j ↔ i = j :=
+(pow_right_injective ha0 ha1).eq_iff
+
 section multiplicity
-variables [nontrivial R] [normalization_monoid R] [decidable_eq R]
+variables [nontrivial R] [normalization_monoid R]
 variables [dec_dvd : decidable_rel (has_dvd.dvd : R → R → Prop)]
 open multiplicity multiset
 
 include dec_dvd
-lemma le_multiplicity_iff_repeat_le_normalized_factors {a b : R} {n : ℕ}
+lemma le_multiplicity_iff_replicate_le_normalized_factors [decidable_eq R] {a b : R} {n : ℕ}
   (ha : irreducible a) (hb : b ≠ 0) :
-  ↑n ≤ multiplicity a b ↔ repeat (normalize a) n ≤ normalized_factors b :=
+  ↑n ≤ multiplicity a b ↔ replicate n (normalize a) ≤ normalized_factors b :=
 begin
   rw ← pow_dvd_iff_le_multiplicity,
   revert b,
@@ -735,12 +879,12 @@ begin
   split,
   { rintro ⟨c, rfl⟩,
     rw [ne.def, pow_succ, mul_assoc, mul_eq_zero, decidable.not_or_iff_and_not] at hb,
-    rw [pow_succ, mul_assoc, normalized_factors_mul hb.1 hb.2, repeat_succ,
+    rw [pow_succ, mul_assoc, normalized_factors_mul hb.1 hb.2, replicate_succ,
       normalized_factors_irreducible ha, singleton_add, cons_le_cons_iff, ← ih hb.2],
     apply dvd.intro _ rfl },
   { rw [multiset.le_iff_exists_add],
     rintro ⟨u, hu⟩,
-    rw [← (normalized_factors_prod hb).dvd_iff_dvd_right, hu, prod_add, prod_repeat],
+    rw [← (normalized_factors_prod hb).dvd_iff_dvd_right, hu, prod_add, prod_replicate],
     exact (associated.pow_pow $ associated_normalize a).dvd.trans (dvd.intro u.prod rfl) }
 end
 
@@ -750,40 +894,222 @@ the normalized factor occurs in the `normalized_factors`.
 See also `count_normalized_factors_eq` which expands the definition of `multiplicity`
 to produce a specification for `count (normalized_factors _) _`..
 -/
-lemma multiplicity_eq_count_normalized_factors {a b : R} (ha : irreducible a) (hb : b ≠ 0) :
-  multiplicity a b = (normalized_factors b).count (normalize a) :=
+lemma multiplicity_eq_count_normalized_factors [decidable_eq R] {a b : R} (ha : irreducible a)
+ (hb : b ≠ 0) : multiplicity a b = (normalized_factors b).count (normalize a) :=
 begin
   apply le_antisymm,
-  { apply enat.le_of_lt_add_one,
+  { apply part_enat.le_of_lt_add_one,
     rw [← nat.cast_one, ← nat.cast_add, lt_iff_not_ge, ge_iff_le,
-      le_multiplicity_iff_repeat_le_normalized_factors ha hb, ← le_count_iff_repeat_le],
+      le_multiplicity_iff_replicate_le_normalized_factors ha hb, ← le_count_iff_replicate_le],
     simp },
-  rw [le_multiplicity_iff_repeat_le_normalized_factors ha hb, ← le_count_iff_repeat_le],
+  rw [le_multiplicity_iff_replicate_le_normalized_factors ha hb, ← le_count_iff_replicate_le],
 end
 
 omit dec_dvd
+
 /-- The number of times an irreducible factor `p` appears in `normalized_factors x` is defined by
 the number of times it divides `x`.
 
 See also `multiplicity_eq_count_normalized_factors` if `n` is given by `multiplicity p x`.
 -/
-lemma count_normalized_factors_eq {p x : R} (hp : irreducible p) (hnorm : normalize p = p) {n : ℕ}
-  (hle : p^n ∣ x) (hlt : ¬ (p^(n+1) ∣ x)) :
+lemma count_normalized_factors_eq [decidable_eq R] {p x : R} (hp : irreducible p)
+  (hnorm : normalize p = p) {n : ℕ} (hle : p^n ∣ x) (hlt : ¬ (p^(n+1) ∣ x)) :
   (normalized_factors x).count p = n :=
 begin
   letI : decidable_rel ((∣) : R → R → Prop) := λ _ _, classical.prop_decidable _,
   by_cases hx0 : x = 0,
   { simp [hx0] at hlt, contradiction },
-  rw [← enat.coe_inj],
+  rw [← part_enat.coe_inj],
   convert (multiplicity_eq_count_normalized_factors hp hx0).symm,
   { exact hnorm.symm },
   exact (multiplicity.eq_coe_iff.mpr ⟨hle, hlt⟩).symm
 end
 
+/-- The number of times an irreducible factor `p` appears in `normalized_factors x` is defined by
+the number of times it divides `x`. This is a slightly more general version of
+`unique_factorization_monoid.count_normalized_factors_eq` that allows `p = 0`.
+
+See also `multiplicity_eq_count_normalized_factors` if `n` is given by `multiplicity p x`.
+-/
+lemma count_normalized_factors_eq' [decidable_eq R] {p x : R} (hp : p = 0 ∨ irreducible p)
+  (hnorm : normalize p = p) {n : ℕ} (hle : p^n ∣ x) (hlt : ¬ (p^(n+1) ∣ x)) :
+  (normalized_factors x).count p = n :=
+begin
+  rcases hp with rfl|hp,
+  { cases n,
+    { exact count_eq_zero.2 (zero_not_mem_normalized_factors _) },
+    { rw [zero_pow (nat.succ_pos _)] at hle hlt,
+      exact absurd hle hlt } },
+  { exact count_normalized_factors_eq hp hnorm hle hlt }
+end
+
+lemma max_power_factor {a₀ : R} {x : R} (h : a₀ ≠ 0) (hx : irreducible x) :
+  ∃ n : ℕ, ∃ a : R, ¬ x ∣ a ∧ a₀ = x ^ n * a :=
+begin
+  classical,
+  let n := (normalized_factors a₀).count (normalize x),
+  obtain ⟨a, ha1, ha2⟩ := (@exists_eq_pow_mul_and_not_dvd R _ _ x a₀
+    (ne_top_iff_finite.mp (part_enat.ne_top_iff.mpr _))),
+  simp_rw [← (multiplicity_eq_count_normalized_factors hx h).symm] at ha1,
+  use [n, a, ha2, ha1],
+  use [n, (multiplicity_eq_count_normalized_factors hx h)],
+end
+
 end multiplicity
 
-end unique_factorization_monoid
+section multiplicative
+
+variables [cancel_comm_monoid_with_zero α] [unique_factorization_monoid α]
+variables {β : Type*} [cancel_comm_monoid_with_zero β]
+
+open_locale big_operators
+
+lemma prime_pow_coprime_prod_of_coprime_insert [decidable_eq α] {s : finset α} (i : α → ℕ) (p : α)
+  (hps : p ∉ s) (is_prime : ∀ q ∈ insert p s, prime q)
+  (is_coprime : ∀ (q q' ∈ insert p s), q ∣ q' → q = q') :
+  ∀ (q : α), q ∣ p ^ i p → q ∣ ∏ p' in s, p' ^ i p' → is_unit q :=
+begin
+  have hp := is_prime _ (finset.mem_insert_self _ _),
+  refine λ _, no_factors_of_no_prime_factors (pow_ne_zero _ hp.ne_zero) _,
+  intros d hdp hdprod hd,
+  apply hps,
+  replace hdp := hd.dvd_of_dvd_pow hdp,
+  obtain ⟨q, q_mem', hdq⟩ := hd.exists_mem_multiset_dvd hdprod,
+  obtain ⟨q, q_mem, rfl⟩ := multiset.mem_map.mp q_mem',
+  replace hdq := hd.dvd_of_dvd_pow hdq,
+  have : p ∣ q := dvd_trans
+    (hd.irreducible.dvd_symm hp.irreducible hdp)
+    hdq,
+  convert q_mem,
+  exact is_coprime _  (finset.mem_insert_self p s) _ (finset.mem_insert_of_mem q_mem) this,
+end
+
+/-- If `P` holds for units and powers of primes,
+and `P x ∧ P y` for coprime `x, y` implies `P (x * y)`,
+then `P` holds on a product of powers of distinct primes. -/
+@[elab_as_eliminator]
+theorem induction_on_prime_power
+  {P : α → Prop} (s : finset α) (i : α → ℕ)
+  (is_prime : ∀ p ∈ s, prime p) (is_coprime : ∀ p q ∈ s, p ∣ q → p = q)
+  (h1 : ∀ {x}, is_unit x → P x) (hpr : ∀ {p} (i : ℕ), prime p → P (p ^ i))
+  (hcp : ∀ {x y}, (∀ p, p ∣ x → p ∣ y → is_unit p) → P x → P y → P (x * y)) :
+  P (∏ p in s, p ^ (i p)) :=
+begin
+  letI := classical.dec_eq α,
+  induction s using finset.induction_on with p f' hpf' ih,
+  { simpa using h1 is_unit_one },
+  rw finset.prod_insert hpf',
+  exact hcp
+    (prime_pow_coprime_prod_of_coprime_insert i p hpf' is_prime is_coprime)
+    (hpr (i p) (is_prime _ (finset.mem_insert_self _ _)))
+    (ih (λ q hq, is_prime _ (finset.mem_insert_of_mem hq))
+    (λ q hq q' hq', is_coprime _ (finset.mem_insert_of_mem hq) _ (finset.mem_insert_of_mem hq')))
+end
+
+/-- If `P` holds for `0`, units and powers of primes,
+and `P x ∧ P y` for coprime `x, y` implies `P (x * y)`,
+then `P` holds on all `a : α`. -/
+@[elab_as_eliminator]
+theorem induction_on_coprime
+  {P : α → Prop} (a : α) (h0 : P 0) (h1 : ∀ {x}, is_unit x → P x)
+  (hpr : ∀ {p} (i : ℕ), prime p → P (p ^ i))
+  (hcp : ∀ {x y}, (∀ p, p ∣ x → p ∣ y → is_unit p) → P x → P y → P (x * y)) :
+  P a :=
+begin
+  letI := classical.dec_eq α,
+  have P_of_associated : ∀ {x y}, associated x y → P x → P y,
+  { rintros x y ⟨u, rfl⟩ hx,
+    exact hcp (λ p _ hpx, is_unit_of_dvd_unit hpx u.is_unit) hx (h1 u.is_unit) },
+  by_cases ha0 : a = 0, { rwa ha0 },
+  haveI : nontrivial α := ⟨⟨_, _, ha0⟩⟩,
+  letI : normalization_monoid α := unique_factorization_monoid.normalization_monoid,
+  refine P_of_associated (normalized_factors_prod ha0) _,
+  rw [← (normalized_factors a).map_id, finset.prod_multiset_map_count],
+  refine induction_on_prime_power _ _ _ _ @h1 @hpr @hcp;
+    simp only [multiset.mem_to_finset],
+  { apply prime_of_normalized_factor },
+  { apply normalized_factors_eq_of_dvd },
+end
+
+/-- If `f` maps `p ^ i` to `(f p) ^ i` for primes `p`, and `f`
+is multiplicative on coprime elements, then `f` is multiplicative on all products of primes. -/
+@[elab_as_eliminator]
+theorem multiplicative_prime_power
+  {f : α → β} (s : finset α) (i j : α → ℕ)
+  (is_prime : ∀ p ∈ s, prime p) (is_coprime : ∀ p q ∈ s, p ∣ q → p = q)
+  (h1 : ∀ {x y}, is_unit y → f (x * y) = f x * f y)
+  (hpr : ∀ {p} (i : ℕ), prime p → f (p ^ i) = (f p) ^ i)
+  (hcp : ∀ {x y}, (∀ p, p ∣ x → p ∣ y → is_unit p) → f (x * y) = f x * f y) :
+  f (∏ p in s, p ^ (i p + j p)) = f (∏ p in s, p ^ i p) * f (∏ p in s, p ^ j p) :=
+begin
+  letI := classical.dec_eq α,
+  induction s using finset.induction_on with p s hps ih,
+  { simpa using h1 is_unit_one },
+  have hpr_p := is_prime _ (finset.mem_insert_self _ _),
+  have hpr_s : ∀ p ∈ s, prime p := λ p hp, is_prime _ (finset.mem_insert_of_mem hp),
+  have hcp_p := λ i, (prime_pow_coprime_prod_of_coprime_insert i p hps is_prime is_coprime),
+  have hcp_s : ∀ (p q ∈ s), p ∣ q → p = q := λ p hp q hq, is_coprime p
+    (finset.mem_insert_of_mem hp) q
+    (finset.mem_insert_of_mem hq),
+  rw [finset.prod_insert hps, finset.prod_insert hps, finset.prod_insert hps,
+      hcp (hcp_p _), hpr _ hpr_p, hcp (hcp_p _), hpr _ hpr_p, hcp (hcp_p _), hpr _ hpr_p,
+      ih hpr_s hcp_s,
+      pow_add, mul_assoc, mul_left_comm (f p ^ j p), mul_assoc],
+end
 
+/-- If `f` maps `p ^ i` to `(f p) ^ i` for primes `p`, and `f`
+is multiplicative on coprime elements, then `f` is multiplicative everywhere. -/
+theorem multiplicative_of_coprime
+  (f : α → β) (a b : α) (h0 : f 0 = 0) (h1 : ∀ {x y}, is_unit y → f (x * y) = f x * f y)
+  (hpr : ∀ {p} (i : ℕ), prime p → f (p ^ i) = (f p) ^ i)
+  (hcp : ∀ {x y}, (∀ p, p ∣ x → p ∣ y → is_unit p) → f (x * y) = f x * f y) :
+  f (a * b) = f a * f b :=
+begin
+  letI := classical.dec_eq α,
+  by_cases ha0 : a = 0, { rw [ha0, zero_mul, h0, zero_mul] },
+  by_cases hb0 : b = 0, { rw [hb0, mul_zero, h0, mul_zero] },
+  by_cases hf1 : f 1 = 0,
+  { calc f (a * b) = f ((a * b) * 1) : by rw mul_one
+               ... = 0 : by simp only [h1 is_unit_one, hf1, mul_zero]
+               ... = f a * f (b * 1) : by simp only [h1 is_unit_one, hf1, mul_zero]
+               ... = f a * f b : by rw mul_one },
+  have h1' : f 1 = 1 := (mul_left_inj' hf1).mp (by rw [← h1 is_unit_one, one_mul, one_mul]),
+  haveI : nontrivial α := ⟨⟨_, _, ha0⟩⟩,
+  letI : normalization_monoid α := unique_factorization_monoid.normalization_monoid,
+  suffices : f (∏ p in (normalized_factors a).to_finset ∪ (normalized_factors b).to_finset,
+        p ^ ((normalized_factors a).count p + (normalized_factors b).count p))
+    = f (∏ p in (normalized_factors a).to_finset ∪ (normalized_factors b).to_finset,
+        p ^ (normalized_factors a).count p) *
+      f (∏ (p : α) in (normalized_factors a).to_finset ∪ (normalized_factors b).to_finset,
+        p ^ (normalized_factors b).count p),
+  { obtain ⟨ua, a_eq⟩ := normalized_factors_prod ha0,
+    obtain ⟨ub, b_eq⟩ := normalized_factors_prod hb0,
+    rw [← a_eq, ← b_eq, mul_right_comm _ ↑ua, h1 ua.is_unit, h1 ub.is_unit, h1 ua.is_unit,
+        ← mul_assoc, h1 ub.is_unit, mul_right_comm _ (f ua), ← mul_assoc],
+    congr,
+    rw [← (normalized_factors a).map_id, ← (normalized_factors b).map_id,
+        finset.prod_multiset_map_count, finset.prod_multiset_map_count,
+        finset.prod_subset (finset.subset_union_left _ (normalized_factors b).to_finset),
+        finset.prod_subset (finset.subset_union_right _ (normalized_factors b).to_finset),
+        ← finset.prod_mul_distrib],
+    simp_rw [id.def, ← pow_add, this],
+    all_goals { simp only [multiset.mem_to_finset] },
+    { intros p hpab hpb, simp [hpb] },
+    { intros p hpab hpa, simp [hpa] } },
+  refine multiplicative_prime_power _ _ _ _ _ @h1 @hpr @hcp,
+  all_goals { simp only [multiset.mem_to_finset, finset.mem_union] },
+  { rintros p (hpa | hpb); apply prime_of_normalized_factor; assumption },
+  { rintro p (hp | hp) q (hq | hq) hdvd;
+      rw [← normalize_normalized_factor _ hp, ← normalize_normalized_factor _ hq];
+      exact normalize_eq_normalize hdvd
+        ((prime_of_normalized_factor _ hp).irreducible.dvd_symm
+          (prime_of_normalized_factor _ hq).irreducible
+          hdvd) },
+end
+
+end multiplicative
+
+end unique_factorization_monoid
 
 namespace associates
 open unique_factorization_monoid associated multiset
@@ -1268,9 +1594,9 @@ eq_of_prod_eq_prod (by rw [factors_prod, factor_set.prod, map_singleton, prod_si
                             subtype.coe_mk])
 
 theorem factors_prime_pow [nontrivial α] {p : associates α} (hp : irreducible p)
-  (k : ℕ) : factors (p ^ k) = some (multiset.repeat ⟨p, hp⟩ k) :=
-eq_of_prod_eq_prod (by rw [associates.factors_prod, factor_set.prod, multiset.map_repeat,
-                           multiset.prod_repeat, subtype.coe_mk])
+  (k : ℕ) : factors (p ^ k) = some (multiset.replicate k ⟨p, hp⟩) :=
+eq_of_prod_eq_prod (by rw [associates.factors_prod, factor_set.prod, multiset.map_replicate,
+                           multiset.prod_replicate, subtype.coe_mk])
 
 include dec_irr
 
@@ -1278,7 +1604,7 @@ theorem prime_pow_dvd_iff_le [nontrivial α] {m p : associates α} (h₁ : m ≠
   (h₂ : irreducible p) {k : ℕ} : p ^ k ≤ m ↔ k ≤ count p m.factors :=
 begin
   obtain ⟨a, nz, rfl⟩ := associates.exists_non_zero_rep h₁,
-  rw [factors_mk _ nz, ← with_top.some_eq_coe, count_some, multiset.le_count_iff_repeat_le,
+  rw [factors_mk _ nz, ← with_top.some_eq_coe, count_some, multiset.le_count_iff_replicate_le,
       ← factors_le, factors_prime_pow h₂, factors_mk _ nz],
   exact with_top.coe_le_coe
 end
@@ -1619,10 +1945,8 @@ by { ext, simp [factorization] }
 lemma associated_of_factorization_eq (a b: α) (ha: a ≠ 0) (hb: b ≠ 0)
   (h: factorization a = factorization b) : associated a b :=
 begin
-  simp only [factorization, add_equiv.apply_eq_iff_eq] at h,
-  have ha' := normalized_factors_prod ha,
-  rw h at ha',
-  exact associated.trans ha'.symm (normalized_factors_prod hb),
+  simp_rw [factorization, add_equiv.apply_eq_iff_eq] at h,
+  rwa [associated_iff_normalized_factors_eq_normalized_factors ha hb],
 end
 
 end finsupp
diff --git a/src/ring_theory/valuation/basic.lean b/src/ring_theory/valuation/basic.lean
index e966286baa593..0f209fc8b7965 100644
--- a/src/ring_theory/valuation/basic.lean
+++ b/src/ring_theory/valuation/basic.lean
@@ -5,13 +5,15 @@ Authors: Kevin Buzzard, Johan Commelin, Patrick Massot
 -/
 
 import algebra.order.with_zero
-import algebra.punit_instances
 import ring_theory.ideal.operations
 
 /-!
 
 # The basics of valuation theory.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The basic theory of valuations (non-archimedean norms) on a commutative ring,
 following T. Wedhorn's unpublished notes “Adic Spaces” ([wedhorn_adic]).
 
@@ -32,10 +34,6 @@ that the class of all valuations (as `Γ₀` varies) on a ring `R` is not a set.
 The "relation" is however reflexive, symmetric and transitive in the obvious
 sense. Note that we use 1.27(iii) of [wedhorn_adic] as the definition of equivalence.
 
-The support of a valuation `v : valuation R Γ₀` is `supp v`. If `J` is an ideal of `R`
-with `h : J ⊆ supp v` then the induced valuation
-on R / J = `ideal.quotient J` is `on_quot v h`.
-
 ## Main definitions
 
 * `valuation R Γ₀`, the type of valuations on `R` with values in `Γ₀`
@@ -49,6 +47,13 @@ on R / J = `ideal.quotient J` is `on_quot v h`.
 
 `add_valuation R Γ₀` is implemented as `valuation R (multiplicative Γ₀)ᵒᵈ`.
 
+## Notation
+
+In the `discrete_valuation` locale:
+
+ * `ℕₘ₀` is a shorthand for `with_zero (multiplicative ℕ)`
+ * `ℤₘ₀` is a shorthand for `with_zero (multiplicative ℤ)`
+
 ## TODO
 
 If ever someone extends `valuation`, we should fully comply to the `fun_like` by migrating the
@@ -60,7 +65,7 @@ noncomputable theory
 
 open function ideal
 
-variables {F R : Type*} -- This will be a ring, assumed commutative in some sections
+variables {K F R : Type*} [division_ring K]
 
 section
 variables (F R) (Γ₀ : Type*) [linear_ordered_comm_monoid_with_zero Γ₀] [ring R]
@@ -68,7 +73,7 @@ variables (F R) (Γ₀ : Type*) [linear_ordered_comm_monoid_with_zero Γ₀] [ri
 /-- The type of `Γ₀`-valued valuations on `R`.
 
 When you extend this structure, make sure to extend `valuation_class`. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure valuation extends R →*₀ Γ₀ :=
 (map_add_le_max' : ∀ x y, to_fun (x + y) ≤ max (to_fun x) (to_fun y))
 
@@ -163,13 +168,13 @@ lemma ext_iff {v₁ v₂ : valuation R Γ₀} : v₁ = v₂ ↔ ∀ r, v₁ r =
 def to_preorder : preorder R := preorder.lift v
 
 /-- If `v` is a valuation on a division ring then `v(x) = 0` iff `x = 0`. -/
-@[simp] lemma zero_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
-  (v : valuation K Γ₀) {x : K} : v x = 0 ↔ x = 0 :=
-v.to_monoid_with_zero_hom.map_eq_zero
+@[simp] lemma zero_iff [nontrivial Γ₀] (v : valuation K Γ₀) {x : K} :
+  v x = 0 ↔ x = 0 :=
+map_eq_zero v
 
-lemma ne_zero_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
-  (v : valuation K Γ₀) {x : K} : v x ≠ 0 ↔ x ≠ 0 :=
-v.to_monoid_with_zero_hom.map_ne_zero
+lemma ne_zero_iff [nontrivial Γ₀] (v : valuation K Γ₀) {x : K} :
+  v x ≠ 0 ↔ x ≠ 0 :=
+map_ne_zero v
 
 theorem unit_map_eq (u : Rˣ) :
   (units.map (v : R →* Γ₀) u : Γ₀) = v u := rfl
@@ -210,17 +215,6 @@ end monoid
 section group
 variables [linear_ordered_comm_group_with_zero Γ₀] {R} {Γ₀} (v : valuation R Γ₀) {x y z : R}
 
-@[simp] lemma map_inv {K : Type*} [division_ring K]
-  (v : valuation K Γ₀) {x : K} : v x⁻¹ = (v x)⁻¹ :=
-v.to_monoid_with_zero_hom.map_inv x
-
-@[simp] lemma map_zpow {K : Type*} [division_ring K] (v : valuation K Γ₀) {x : K} {n : ℤ} :
-  v (x^n) = (v x)^n :=
-v.to_monoid_with_zero_hom.map_zpow x n
-
-lemma map_units_inv (x : Rˣ) : v (x⁻¹ : Rˣ) = (v x)⁻¹ :=
-v.to_monoid_with_zero_hom.to_monoid_hom.map_units_inv x
-
 @[simp] lemma map_neg (x : R) : v (-x) = v x :=
 v.to_monoid_with_zero_hom.to_monoid_hom.map_neg x
 
@@ -243,15 +237,13 @@ begin
   suffices : ¬v (x + y) < max (v x) (v y),
     from or_iff_not_imp_right.1 (le_iff_eq_or_lt.1 (v.map_add x y)) this,
   intro h',
-  wlog vyx : v y < v x using x y,
-  { apply lt_or_gt_of_ne h.symm },
-  { rw max_eq_left_of_lt vyx at h',
-    apply lt_irrefl (v x),
-    calc v x = v ((x+y) - y)         : by simp
-         ... ≤ max (v $ x + y) (v y) : map_sub _ _ _
-         ... < v x                   : max_lt h' vyx },
-  { apply this h.symm,
-    rwa [add_comm, max_comm] at h' }
+  wlog vyx : v y < v x,
+  { refine this v h.symm _ (h.lt_or_lt.resolve_right vyx), rwa [add_comm, max_comm] },
+  rw max_eq_left_of_lt vyx at h',
+  apply lt_irrefl (v x),
+  calc v x = v ((x+y) - y)         : by simp
+        ... ≤ max (v $ x + y) (v y) : map_sub _ _ _
+        ... < v x                   : max_lt h' vyx
 end
 
 lemma map_add_eq_of_lt_right (h : v x < v y) : v (x + y) = v y :=
@@ -273,6 +265,23 @@ begin
   simpa using this
 end
 
+lemma map_one_add_of_lt (h : v x < 1) : v (1 + x) = 1 :=
+begin
+  rw ← v.map_one at h,
+  simpa only [v.map_one] using v.map_add_eq_of_lt_left h
+end
+
+lemma map_one_sub_of_lt (h : v x < 1) : v (1 - x) = 1 :=
+begin
+  rw [← v.map_one, ← v.map_neg] at h,
+  rw sub_eq_add_neg 1 x,
+  simpa only [v.map_one, v.map_neg] using v.map_add_eq_of_lt_left h
+end
+
+lemma one_lt_val_iff (v : valuation K Γ₀) {x : K} (h : x ≠ 0) :
+  1 < v x ↔ v x⁻¹ < 1 :=
+by simpa using (inv_lt_inv₀ (v.ne_zero_iff.2 h) one_ne_zero).symm
+
 /-- The subgroup of elements whose valuation is less than a certain unit.-/
 def lt_add_subgroup (v : valuation R Γ₀) (γ : Γ₀ˣ) : add_subgroup R :=
 { carrier   := {x | v x < γ},
@@ -338,7 +347,6 @@ lemma is_equiv_of_map_strict_mono [linear_ordered_comm_monoid_with_zero Γ₀]
 
 lemma is_equiv_of_val_le_one [linear_ordered_comm_group_with_zero Γ₀]
   [linear_ordered_comm_group_with_zero Γ'₀]
-  {K : Type*} [division_ring K]
   (v : valuation K Γ₀) (v' : valuation K Γ'₀) (h : ∀ {x:K}, v x ≤ 1 ↔ v' x ≤ 1) :
   v.is_equiv v' :=
 begin
@@ -362,7 +370,6 @@ end
 lemma is_equiv_iff_val_le_one
   [linear_ordered_comm_group_with_zero Γ₀]
   [linear_ordered_comm_group_with_zero Γ'₀]
-  {K : Type*} [division_ring K]
   (v : valuation K Γ₀) (v' : valuation K Γ'₀) :
   v.is_equiv v' ↔ ∀ {x : K}, v x ≤ 1 ↔ v' x ≤ 1 :=
 ⟨λ h x, by  simpa using h x 1, is_equiv_of_val_le_one _ _⟩
@@ -370,7 +377,6 @@ lemma is_equiv_iff_val_le_one
 lemma is_equiv_iff_val_eq_one
   [linear_ordered_comm_group_with_zero Γ₀]
   [linear_ordered_comm_group_with_zero Γ'₀]
-  {K : Type*} [division_ring K]
   (v : valuation K Γ₀) (v' : valuation K Γ'₀) :
   v.is_equiv v' ↔ ∀ {x : K}, v x = 1 ↔ v' x = 1 :=
 begin
@@ -399,6 +405,61 @@ begin
       { rw ← h at hx', exact le_of_eq hx' } } }
 end
 
+lemma is_equiv_iff_val_lt_one
+  [linear_ordered_comm_group_with_zero Γ₀]
+  [linear_ordered_comm_group_with_zero Γ'₀]
+  (v : valuation K Γ₀) (v' : valuation K Γ'₀) :
+  v.is_equiv v' ↔ ∀ {x : K}, v x < 1 ↔ v' x < 1 :=
+begin
+  split,
+  { intros h x,
+    simp only [lt_iff_le_and_ne, and_congr ((is_equiv_iff_val_le_one _ _).1 h)
+      ((is_equiv_iff_val_eq_one _ _).1 h).not] },
+  { rw is_equiv_iff_val_eq_one,
+    intros h x,
+    by_cases hx : x = 0, { simp only [(zero_iff _).2 hx, zero_ne_one] },
+    split,
+    { intro hh,
+      by_contra h_1,
+      cases ne_iff_lt_or_gt.1 h_1,
+      { simpa [hh, lt_self_iff_false] using h.2 h_2 },
+      { rw [← inv_one, ← inv_eq_iff_eq_inv, ← map_inv₀] at hh,
+        exact hh.not_lt (h.2 ((one_lt_val_iff v' hx).1 h_2)) } },
+    { intro hh,
+      by_contra h_1,
+      cases ne_iff_lt_or_gt.1 h_1,
+      { simpa [hh, lt_self_iff_false] using h.1 h_2 },
+      { rw [← inv_one, ← inv_eq_iff_eq_inv, ← map_inv₀] at hh,
+        exact hh.not_lt (h.1 ((one_lt_val_iff v hx).1 h_2)) } } }
+end
+
+lemma is_equiv_iff_val_sub_one_lt_one
+  [linear_ordered_comm_group_with_zero Γ₀]
+  [linear_ordered_comm_group_with_zero Γ'₀]
+  (v : valuation K Γ₀) (v' : valuation K Γ'₀) :
+  v.is_equiv v' ↔ ∀ {x : K}, v (x - 1) < 1 ↔ v' (x - 1) < 1 :=
+begin
+  rw is_equiv_iff_val_lt_one,
+  exact (equiv.sub_right 1).surjective.forall
+end
+
+lemma is_equiv_tfae
+  [linear_ordered_comm_group_with_zero Γ₀]
+  [linear_ordered_comm_group_with_zero Γ'₀]
+  (v : valuation K Γ₀) (v' : valuation K Γ'₀) :
+  [v.is_equiv v',
+   ∀ {x}, v x ≤ 1 ↔ v' x ≤ 1,
+   ∀ {x}, v x = 1 ↔ v' x = 1,
+   ∀ {x}, v x < 1 ↔ v' x < 1,
+   ∀ {x}, v (x-1) < 1 ↔ v' (x-1) < 1].tfae :=
+begin
+  tfae_have : 1 ↔ 2, { apply is_equiv_iff_val_le_one },
+  tfae_have : 1 ↔ 3, { apply is_equiv_iff_val_eq_one },
+  tfae_have : 1 ↔ 4, { apply is_equiv_iff_val_lt_one },
+  tfae_have : 1 ↔ 5, { apply is_equiv_iff_val_sub_one_lt_one },
+  tfae_finish
+end
+
 end
 
 section supp
@@ -442,27 +503,6 @@ begin
        ... ≤ v (a + s)      : aux (a + s) (-s) (by rwa ←ideal.neg_mem_iff at h)
 end
 
-/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
-Note: it's just the function; the valuation is `on_quot hJ`. -/
-def on_quot_val {J : ideal R} (hJ : J ≤ supp v) :
-  R ⧸ J → Γ₀ :=
-λ q, quotient.lift_on' q v $ λ a b h,
-calc v a = v (b + -(-a + b)) : by simp
-     ... = v b             : v.map_add_supp b ((ideal.neg_mem_iff _).2 $ hJ h)
-
-/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
-def on_quot {J : ideal R} (hJ : J ≤ supp v) :
-  valuation (R ⧸ J) Γ₀ :=
-{ to_fun := v.on_quot_val hJ,
-  map_zero' := v.map_zero,
-  map_one'  := v.map_one,
-  map_mul'  := λ xbar ybar, quotient.ind₂' v.map_mul xbar ybar,
-  map_add_le_max'  := λ xbar ybar, quotient.ind₂' v.map_add xbar ybar }
-
-@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
-  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
-ext $ λ r, rfl
-
 lemma comap_supp {S : Type*} [comm_ring S] (f : S →+* R) :
   supp (v.comap f) = ideal.comap f v.supp :=
 ideal.ext $ λ x,
@@ -471,29 +511,6 @@ begin
   refl,
 end
 
-lemma self_le_supp_comap (J : ideal R) (v : valuation (R ⧸ J) Γ₀) :
-  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
-by { rw [comap_supp, ← ideal.map_le_iff_le_comap], simp }
-
-@[simp] lemma comap_on_quot_eq (J : ideal R) (v : valuation (R ⧸ J) Γ₀) :
-  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
-ext $ by { rintro ⟨x⟩, refl }
-
-/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
-lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
-  supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
-begin
-  apply le_antisymm,
-  { rintro ⟨x⟩ hx,
-    apply ideal.subset_span,
-    exact ⟨x, hx, rfl⟩ },
-  { rw ideal.map_le_iff_le_comap,
-    intros x hx, exact hx }
-end
-
-lemma supp_quot_supp : supp (v.on_quot le_rfl) = 0 :=
-by { rw supp_quot, exact ideal.map_quotient_self _ }
-
 end supp -- end of section
 
 end valuation
@@ -503,7 +520,7 @@ section add_monoid
 variables (R) [ring R] (Γ₀ : Type*) [linear_ordered_add_comm_monoid_with_top Γ₀]
 
 /-- The type of `Γ₀`-valued additive valuations on `R`. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def add_valuation := valuation R (multiplicative Γ₀ᵒᵈ)
 
 end add_monoid
@@ -584,12 +601,13 @@ valuation.ext_iff
 def to_preorder : preorder R := preorder.lift v
 
 /-- If `v` is an additive valuation on a division ring then `v(x) = ⊤` iff `x = 0`. -/
-@[simp] lemma top_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
-  (v : add_valuation K Γ₀) {x : K} : v x = ⊤ ↔ x = 0 :=
+@[simp] lemma top_iff [nontrivial Γ₀] (v : add_valuation K Γ₀) {x : K} :
+  v x = ⊤ ↔ x = 0 :=
 v.zero_iff
 
-lemma ne_top_iff [nontrivial Γ₀] {K : Type*} [division_ring K]
-  (v : add_valuation K Γ₀) {x : K} : v x ≠ ⊤ ↔ x ≠ 0 := v.ne_zero_iff
+lemma ne_top_iff [nontrivial Γ₀] (v : add_valuation K Γ₀) {x : K} :
+  v x ≠ ⊤ ↔ x ≠ 0 :=
+v.ne_zero_iff
 
 /-- A ring homomorphism `S → R` induces a map `add_valuation R Γ₀ → add_valuation S Γ₀`. -/
 def comap {S : Type*} [ring S] (f : S →+* R) (v : add_valuation R Γ₀) :
@@ -623,12 +641,9 @@ end monoid
 section group
 variables [linear_ordered_add_comm_group_with_top Γ₀] [ring R] (v : add_valuation R Γ₀) {x y z : R}
 
-@[simp] lemma map_inv {K : Type*} [division_ring K]
-  (v : add_valuation K Γ₀) {x : K} : v x⁻¹ = - (v x) :=
-v.map_inv
-
-lemma map_units_inv (x : Rˣ) : v (x⁻¹ : Rˣ) = - (v x) :=
-v.map_units_inv x
+@[simp] lemma map_inv (v : add_valuation K Γ₀) {x : K} :
+  v x⁻¹ = - (v x) :=
+map_inv₀ v.valuation x
 
 @[simp] lemma map_neg (x : R) : v (-x) = v x :=
 v.map_neg x
@@ -705,41 +720,17 @@ def supp : ideal R := v.supp
 lemma map_add_supp (a : R) {s : R} (h : s ∈ supp v) : v (a + s) = v a :=
 v.map_add_supp a h
 
-/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
-Note: it's just the function; the valuation is `on_quot hJ`. -/
-def on_quot_val {J : ideal R} (hJ : J ≤ supp v) : (R ⧸ J) → Γ₀ := v.on_quot_val hJ
-
-/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
-def on_quot {J : ideal R} (hJ : J ≤ supp v) :
-  add_valuation (R ⧸ J) Γ₀ :=
-v.on_quot hJ
-
-@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
-  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
-v.on_quot_comap_eq hJ
-
-lemma comap_supp {S : Type*} [comm_ring S] (f : S →+* R) :
-  supp (v.comap f) = ideal.comap f v.supp :=
-v.comap_supp f
-
-lemma self_le_supp_comap (J : ideal R) (v : add_valuation (R ⧸ J) Γ₀) :
-  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
-v.self_le_supp_comap J
-
-@[simp] lemma comap_on_quot_eq (J : ideal R) (v : add_valuation (R ⧸ J) Γ₀) :
-  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
-v.comap_on_quot_eq J
-
-/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
-lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
-  supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
-v.supp_quot hJ
-
-lemma supp_quot_supp : supp (v.on_quot le_rfl) = 0 :=
-v.supp_quot_supp
-
 end supp -- end of section
 
 attribute [irreducible] add_valuation
 
 end add_valuation
+
+section valuation_notation
+
+localized "notation (name := nat.multiplicative_zero)
+  `ℕₘ₀` := with_zero (multiplicative ℕ)" in discrete_valuation
+localized "notation (name := int.multiplicative_zero)
+  `ℤₘ₀` := with_zero (multiplicative ℤ)" in discrete_valuation
+
+end valuation_notation
diff --git a/src/ring_theory/valuation/extend_to_localization.lean b/src/ring_theory/valuation/extend_to_localization.lean
index 03c7c8674849d..6175b6f334b17 100644
--- a/src/ring_theory/valuation/extend_to_localization.lean
+++ b/src/ring_theory/valuation/extend_to_localization.lean
@@ -10,6 +10,9 @@ import ring_theory.valuation.basic
 
 # Extending valuations to a localization
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We show that, given a valuation `v` taking values in a linearly ordered commutative *group*
 with zero `Γ`, and a submonoid `S` of `v.supp.prime_compl`, the valuation `v` can be naturally
 extended to the localization `S⁻¹A`.
diff --git a/src/ring_theory/valuation/integers.lean b/src/ring_theory/valuation/integers.lean
index 6955151a5148c..f1e917a727c7b 100644
--- a/src/ring_theory/valuation/integers.lean
+++ b/src/ring_theory/valuation/integers.lean
@@ -9,6 +9,9 @@ import ring_theory.valuation.basic
 /-!
 # Ring of integers under a given valuation
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The elements with valuation less than or equal to 1.
 
 TODO: Define characteristic predicate.
@@ -28,7 +31,7 @@ def integer : subring R :=
 { carrier := { x | v x ≤ 1 },
   one_mem' := le_of_eq v.map_one,
   mul_mem' := λ x y hx hy, trans_rel_right (≤) (v.map_mul x y) (mul_le_one' hx hy),
-  zero_mem' := trans_rel_right (≤) v.map_zero zero_le_one',
+  zero_mem' := trans_rel_right (≤) v.map_zero zero_le_one,
   add_mem' := λ x y hx hy, le_trans (v.map_add x y) (max_le hx hy),
   neg_mem' := λ x hx, trans_rel_right (≤) (v.map_neg x) hx }
 
diff --git a/src/ring_theory/valuation/integral.lean b/src/ring_theory/valuation/integral.lean
index 50ed4e6f915fe..147393bd09a4c 100644
--- a/src/ring_theory/valuation/integral.lean
+++ b/src/ring_theory/valuation/integral.lean
@@ -10,6 +10,9 @@ import ring_theory.valuation.integers
 /-!
 # Integral elements over the ring of integers of a valution
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The ring of integers is integrally closed inside the original ring.
 -/
 
@@ -34,7 +37,7 @@ let ⟨p, hpm, hpx⟩ := hx in le_of_not_lt $ λ (hvx : 1 < v x), begin
   rw [hpm.as_sum, eval₂_add, eval₂_pow, eval₂_X, eval₂_finset_sum, add_eq_zero_iff_eq_neg] at hpx,
   replace hpx := congr_arg v hpx, refine ne_of_gt _ hpx,
   rw [v.map_neg, v.map_pow],
-  refine v.map_sum_lt' (zero_lt_one₀.trans_le (one_le_pow_of_one_le' hvx.le _)) (λ i hi, _),
+  refine v.map_sum_lt' (zero_lt_one.trans_le (one_le_pow_of_one_le' hvx.le _)) (λ i hi, _),
   rw [eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, v.map_mul, v.map_pow, ← one_mul (v x ^ p.nat_degree)],
   cases (hv.2 $ p.coeff i).lt_or_eq with hvpi hvpi,
   { exact mul_lt_mul₀ hvpi (pow_lt_pow₀ hvx $ finset.mem_range.1 hi) },
diff --git a/src/ring_theory/valuation/quotient.lean b/src/ring_theory/valuation/quotient.lean
new file mode 100644
index 0000000000000..5b9839dab4fdf
--- /dev/null
+++ b/src/ring_theory/valuation/quotient.lean
@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2020 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kevin Buzzard, Johan Commelin, Patrick Massot
+-/
+
+import ring_theory.valuation.basic
+import ring_theory.ideal.quotient_operations
+
+/-!
+# The valuation on a quotient ring
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The support of a valuation `v : valuation R Γ₀` is `supp v`. If `J` is an ideal of `R`
+with `h : J ⊆ supp v` then the induced valuation
+on R / J = `ideal.quotient J` is `on_quot v h`.
+
+-/
+
+namespace valuation
+
+variables {R Γ₀ : Type*} [comm_ring R] [linear_ordered_comm_monoid_with_zero Γ₀]
+variables (v : valuation R Γ₀)
+
+/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
+Note: it's just the function; the valuation is `on_quot hJ`. -/
+def on_quot_val {J : ideal R} (hJ : J ≤ supp v) :
+  R ⧸ J → Γ₀ :=
+λ q, quotient.lift_on' q v $ λ a b h,
+calc v a = v (b + -(-a + b)) : by simp
+     ... = v b             :
+      v.map_add_supp b $ (ideal.neg_mem_iff _).2 $ hJ $ quotient_add_group.left_rel_apply.mp h
+
+/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
+def on_quot {J : ideal R} (hJ : J ≤ supp v) :
+  valuation (R ⧸ J) Γ₀ :=
+{ to_fun := v.on_quot_val hJ,
+  map_zero' := v.map_zero,
+  map_one'  := v.map_one,
+  map_mul'  := λ xbar ybar, quotient.ind₂' v.map_mul xbar ybar,
+  map_add_le_max'  := λ xbar ybar, quotient.ind₂' v.map_add xbar ybar }
+
+@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
+  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
+ext $ λ r, rfl
+
+lemma self_le_supp_comap (J : ideal R) (v : valuation (R ⧸ J) Γ₀) :
+  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
+by { rw [comap_supp, ← ideal.map_le_iff_le_comap], simp }
+
+@[simp] lemma comap_on_quot_eq (J : ideal R) (v : valuation (R ⧸ J) Γ₀) :
+  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
+ext $ by { rintro ⟨x⟩, refl }
+
+/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
+lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
+  supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
+begin
+  apply le_antisymm,
+  { rintro ⟨x⟩ hx,
+    apply ideal.subset_span,
+    exact ⟨x, hx, rfl⟩ },
+  { rw ideal.map_le_iff_le_comap,
+    intros x hx, exact hx }
+end
+
+lemma supp_quot_supp : supp (v.on_quot le_rfl) = 0 :=
+by { rw supp_quot, exact ideal.map_quotient_self _ }
+
+end valuation
+
+namespace add_valuation
+
+variables {R Γ₀ : Type*}
+variables [comm_ring R] [linear_ordered_add_comm_monoid_with_top Γ₀]
+variables (v : add_valuation R Γ₀)
+
+local attribute [reducible] add_valuation
+
+/-- If `hJ : J ⊆ supp v` then `on_quot_val hJ` is the induced function on R/J as a function.
+Note: it's just the function; the valuation is `on_quot hJ`. -/
+def on_quot_val {J : ideal R} (hJ : J ≤ supp v) : (R ⧸ J) → Γ₀ := v.on_quot_val hJ
+
+/-- The extension of valuation v on R to valuation on R/J if J ⊆ supp v -/
+def on_quot {J : ideal R} (hJ : J ≤ supp v) :
+  add_valuation (R ⧸ J) Γ₀ :=
+v.on_quot hJ
+
+@[simp] lemma on_quot_comap_eq {J : ideal R} (hJ : J ≤ supp v) :
+  (v.on_quot hJ).comap (ideal.quotient.mk J) = v :=
+v.on_quot_comap_eq hJ
+
+lemma comap_supp {S : Type*} [comm_ring S] (f : S →+* R) :
+  supp (v.comap f) = ideal.comap f v.supp :=
+v.comap_supp f
+
+lemma self_le_supp_comap (J : ideal R) (v : add_valuation (R ⧸ J) Γ₀) :
+  J ≤ (v.comap (ideal.quotient.mk J)).supp :=
+v.self_le_supp_comap J
+
+@[simp] lemma comap_on_quot_eq (J : ideal R) (v : add_valuation (R ⧸ J) Γ₀) :
+  (v.comap (ideal.quotient.mk J)).on_quot (v.self_le_supp_comap J) = v :=
+v.comap_on_quot_eq J
+
+/-- The quotient valuation on R/J has support supp(v)/J if J ⊆ supp v. -/
+lemma supp_quot {J : ideal R} (hJ : J ≤ supp v) :
+  supp (v.on_quot hJ) = (supp v).map (ideal.quotient.mk J) :=
+v.supp_quot hJ
+
+lemma supp_quot_supp : supp (v.on_quot le_rfl) = 0 :=
+v.supp_quot_supp
+
+end add_valuation
diff --git a/src/ring_theory/valuation/ramification_group.lean b/src/ring_theory/valuation/ramification_group.lean
new file mode 100644
index 0000000000000..ed286cb001bc3
--- /dev/null
+++ b/src/ring_theory/valuation/ramification_group.lean
@@ -0,0 +1,55 @@
+/-
+Copyright (c) 2022 Michail Karatarakis. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Michail Karatarakis
+-/
+import ring_theory.ideal.local_ring
+import ring_theory.valuation.valuation_subring
+
+/-!
+# Ramification groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The decomposition subgroup and inertia subgroups.
+
+TODO: Define higher ramification groups in lower numbering
+-/
+
+namespace valuation_subring
+
+open_locale pointwise
+
+variables (K : Type*) {L : Type*} [field K] [field L] [algebra K L]
+
+/-- The decomposition subgroup defined as the stabilizer of the action
+on the type of all valuation subrings of the field. -/
+@[reducible] def decomposition_subgroup (A : valuation_subring L) :
+  subgroup (L ≃ₐ[K] L) :=
+mul_action.stabilizer (L ≃ₐ[K] L) A
+
+/-- The valuation subring `A` (considered as a subset of `L`)
+is stable under the action of the decomposition group. -/
+def sub_mul_action (A : valuation_subring L) :
+  sub_mul_action (A.decomposition_subgroup K) L :=
+{ carrier := A,
+  smul_mem' := λ g l h, set.mem_of_mem_of_subset (set.smul_mem_smul_set h) g.prop.le }
+
+/-- The multiplicative action of the decomposition subgroup on `A`. -/
+instance decomposition_subgroup_mul_semiring_action (A : valuation_subring L) :
+  mul_semiring_action (A.decomposition_subgroup K) A :=
+{ smul_add :=  λ g k l, subtype.ext $ smul_add g k l,
+  smul_zero := λ g, subtype.ext $ smul_zero g,
+  smul_one := λ g, subtype.ext $ smul_one g,
+  smul_mul := λ g k l, subtype.ext $ smul_mul' g k l,
+   ..(sub_mul_action.mul_action (A.sub_mul_action K)) }
+
+/-- The inertia subgroup defined as the kernel of the group homomorphism from
+the decomposition subgroup to the group of automorphisms of the residue field of `A`. -/
+def inertia_subgroup (A : valuation_subring L) :
+  subgroup (A.decomposition_subgroup K) :=
+monoid_hom.ker $
+  mul_semiring_action.to_ring_aut (A.decomposition_subgroup K) (local_ring.residue_field A)
+
+end valuation_subring
diff --git a/src/ring_theory/valuation/valuation_ring.lean b/src/ring_theory/valuation/valuation_ring.lean
index b3701d3342b6f..9cc608de0f3bb 100644
--- a/src/ring_theory/valuation/valuation_ring.lean
+++ b/src/ring_theory/valuation/valuation_ring.lean
@@ -6,12 +6,17 @@ Authors: Adam Topaz
 import ring_theory.valuation.integers
 import ring_theory.ideal.local_ring
 import ring_theory.localization.fraction_ring
-import ring_theory.discrete_valuation_ring
+import ring_theory.localization.integer
+import ring_theory.discrete_valuation_ring.basic
+import ring_theory.bezout
 import tactic.field_simp
 
 /-!
 # Valuation Rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A valuation ring is a domain such that for every pair of elements `a b`, either `a` divides
 `b` or vice-versa.
 
@@ -21,7 +26,13 @@ Namely, given the following instances:
 there is a natural valuation `valuation A K` on `K` with values in `value_group A K` where
 the image of `A` under `algebra_map A K` agrees with `(valuation A K).integer`.
 
-We also show that valuation rings are local and that their lattice of ideals is totally ordered.
+We also provide the equivalence of the following notions for a domain `R` in `valuation_ring.tfae`.
+1. `R` is a valuation ring.
+2. For each `x : fraction_ring K`, either `x` or `x⁻¹` is in `R`.
+3. "divides" is a total relation on the elements of `R`.
+4. "contains" is a total relation on the ideals of `R`.
+5. `R` is a local bezout domain.
+
 -/
 
 universes u v w
@@ -37,7 +48,7 @@ section
 variables (A : Type u) [comm_ring A]
 variables (K : Type v) [field K] [algebra A K]
 
-/-- The value group of the valuation ring `A`. -/
+/-- The value group of the valuation ring `A`. Note: this is actually a group with zero. -/
 def value_group : Type v := quotient (mul_action.orbit_rel Aˣ K)
 
 instance : inhabited (value_group A K) := ⟨quotient.mk' 0⟩
@@ -81,7 +92,7 @@ begin
   use b⁻¹,
   dsimp,
   rw [units.smul_def, units.smul_def, algebra.smul_def, algebra.smul_def,
-    mul_inv₀, ring_hom.map_units_inv],
+    mul_inv, map_units_inv],
 end
 
 variables [is_domain A] [valuation_ring A] [is_fraction_ring A K]
@@ -121,8 +132,7 @@ instance : linear_ordered_comm_group_with_zero (value_group A K) :=
       rw [← mul_smul, algebra.smul_def] at hf,
       nth_rewrite 1 ← one_mul b at hf,
       rw ← (algebra_map A K).map_one at hf,
-      exact is_fraction_ring.injective _ _
-        (cancel_comm_monoid_with_zero.mul_right_cancel_of_ne_zero hb hf).symm },
+      exact is_fraction_ring.injective _ _ (mul_right_cancel₀ hb hf).symm },
     apply quotient.sound',
     use [this.unit, rfl],
   end,
@@ -270,6 +280,142 @@ end
 
 section
 
+variables {R : Type*} [comm_ring R] [is_domain R] {K : Type*}
+variables [field K] [algebra R K] [is_fraction_ring R K]
+
+lemma iff_dvd_total :
+  valuation_ring R ↔ is_total R (∣) :=
+begin
+  classical,
+  refine ⟨λ H, ⟨λ a b, _⟩, λ H, ⟨λ a b, _⟩⟩; resetI,
+  { obtain ⟨c,rfl|rfl⟩ := @@valuation_ring.cond _ _ H a b; simp },
+  { obtain (⟨c, rfl⟩|⟨c, rfl⟩) := @is_total.total _ _ H a b; use c; simp }
+end
+
+lemma iff_ideal_total :
+  valuation_ring R ↔ is_total (ideal R) (≤) :=
+begin
+  classical,
+  refine ⟨λ _, by exactI ⟨le_total⟩, λ H, iff_dvd_total.mpr ⟨λ a b, _⟩⟩,
+  have := @is_total.total _ _ H (ideal.span {a}) (ideal.span {b}),
+  simp_rw ideal.span_singleton_le_span_singleton at this,
+  exact this.symm
+end
+
+variables {R} (K)
+
+lemma dvd_total [h : valuation_ring R] (x y : R) : x ∣ y ∨ y ∣ x :=
+@@is_total.total _ (iff_dvd_total.mp h) x y
+
+lemma unique_irreducible [valuation_ring R] ⦃p q : R⦄
+  (hp : irreducible p) (hq : irreducible q) : associated p q :=
+begin
+  have := dvd_total p q,
+  rw [irreducible.dvd_comm hp hq, or_self] at this,
+  exact associated_of_dvd_dvd (irreducible.dvd_symm hq hp this) this,
+end
+
+variable (R)
+
+lemma iff_is_integer_or_is_integer :
+  valuation_ring R ↔ ∀ x : K, is_localization.is_integer R x ∨ is_localization.is_integer R x⁻¹ :=
+begin
+  split,
+  { introsI H x,
+    obtain ⟨x : R, y, hy, rfl⟩ := is_fraction_ring.div_surjective x,
+    any_goals { apply_instance },
+    have := (map_ne_zero_iff _ (is_fraction_ring.injective R K)).mpr (non_zero_divisors.ne_zero hy),
+    obtain ⟨s, rfl|rfl⟩ := valuation_ring.cond x y,
+    { exact or.inr ⟨s, eq_inv_of_mul_eq_one_left $
+        by rwa [mul_div, div_eq_one_iff_eq, map_mul, mul_comm]⟩ },
+    { exact or.inl ⟨s, by rwa [eq_div_iff, map_mul, mul_comm]⟩ } },
+  { intro H,
+    constructor,
+    intros a b,
+    by_cases ha : a = 0, { subst ha, exact ⟨0, or.inr $ mul_zero b⟩ },
+    by_cases hb : b = 0, { subst hb, exact ⟨0, or.inl $ mul_zero a⟩ },
+    replace ha := (map_ne_zero_iff _ (is_fraction_ring.injective R K)).mpr ha,
+    replace hb := (map_ne_zero_iff _ (is_fraction_ring.injective R K)).mpr hb,
+    obtain ⟨c, e⟩|⟨c, e⟩ := H (algebra_map R K a / algebra_map R K b),
+    { rw [eq_div_iff hb, ← map_mul, (is_fraction_ring.injective R K).eq_iff, mul_comm] at e,
+      exact ⟨c, or.inr e⟩ },
+    { rw [inv_div, eq_div_iff ha, ← map_mul,
+        (is_fraction_ring.injective R K).eq_iff, mul_comm c] at e,
+      exact ⟨c, or.inl e⟩ } }
+end
+
+variable {K}
+
+lemma is_integer_or_is_integer [h : valuation_ring R] (x : K) :
+  is_localization.is_integer R x ∨ is_localization.is_integer R x⁻¹ :=
+(iff_is_integer_or_is_integer R K).mp h x
+
+variable {R}
+
+-- This implies that valuation rings are integrally closed through typeclass search.
+@[priority 100]
+instance [valuation_ring R] : is_bezout R :=
+begin
+  classical,
+  rw is_bezout.iff_span_pair_is_principal,
+  intros x y,
+  rw ideal.span_insert,
+  cases le_total (ideal.span {x} : ideal R) (ideal.span {y}),
+  { erw sup_eq_right.mpr h, exact ⟨⟨_, rfl⟩⟩ },
+  { erw sup_eq_left.mpr h, exact ⟨⟨_, rfl⟩⟩ }
+end
+
+lemma iff_local_bezout_domain :
+  valuation_ring R ↔ local_ring R ∧ is_bezout R :=
+begin
+  classical,
+  refine ⟨λ H, by exactI ⟨infer_instance, infer_instance⟩, _⟩,
+  rintro ⟨h₁, h₂⟩,
+  resetI,
+  refine iff_dvd_total.mpr ⟨λ a b, _⟩,
+  obtain ⟨g, e : _ = ideal.span _⟩ := is_bezout.span_pair_is_principal a b,
+  obtain ⟨a, rfl⟩ := ideal.mem_span_singleton'.mp
+    (show a ∈ ideal.span {g}, by { rw [← e], exact ideal.subset_span (by simp) }),
+  obtain ⟨b, rfl⟩ := ideal.mem_span_singleton'.mp
+    (show b ∈ ideal.span {g}, by { rw [← e], exact ideal.subset_span (by simp) }),
+  obtain ⟨x, y, e'⟩ := ideal.mem_span_pair.mp
+    (show g ∈ ideal.span {a * g, b * g}, by { rw e, exact ideal.subset_span (by simp) }),
+  cases eq_or_ne g 0 with h h, { simp [h] },
+  have : x * a + y * b = 1,
+  { apply mul_left_injective₀ h, convert e'; ring_nf },
+  cases local_ring.is_unit_or_is_unit_of_add_one this with h' h',
+  left, swap, right,
+  all_goals
+  { exact mul_dvd_mul_right (is_unit_iff_forall_dvd.mp (is_unit_of_mul_is_unit_right h') _) _ },
+end
+
+protected lemma tfae (R : Type u) [comm_ring R] [is_domain R] :
+  tfae [valuation_ring R,
+    ∀ x : fraction_ring R, is_localization.is_integer R x ∨ is_localization.is_integer R x⁻¹,
+    is_total R (∣),
+    is_total (ideal R) (≤),
+    local_ring R ∧ is_bezout R] :=
+begin
+  tfae_have : 1 ↔ 2, { exact iff_is_integer_or_is_integer R _ },
+  tfae_have : 1 ↔ 3, { exact iff_dvd_total },
+  tfae_have : 1 ↔ 4, { exact iff_ideal_total },
+  tfae_have : 1 ↔ 5, { exact iff_local_bezout_domain },
+  tfae_finish
+end
+
+end
+
+lemma _root_.function.surjective.valuation_ring {R S : Type*} [comm_ring R] [is_domain R]
+  [valuation_ring R] [comm_ring S] [is_domain S] (f : R →+* S) (hf : function.surjective f) :
+  valuation_ring S :=
+⟨λ a b, begin
+  obtain ⟨⟨a, rfl⟩, ⟨b, rfl⟩⟩ := ⟨hf a, hf b⟩,
+  obtain ⟨c, rfl|rfl⟩ := valuation_ring.cond a b,
+  exacts [⟨f c, or.inl $ (map_mul _ _ _).symm⟩, ⟨f c, or.inr $ (map_mul _ _ _).symm⟩],
+end⟩
+
+section
+
 variables {𝒪 : Type u} {K : Type v} {Γ : Type w}
   [comm_ring 𝒪] [is_domain 𝒪] [field K] [algebra 𝒪 K]
   [linear_ordered_comm_group_with_zero Γ]
diff --git a/src/ring_theory/valuation/valuation_subring.lean b/src/ring_theory/valuation/valuation_subring.lean
index f814c27e93924..156e1ae708a0e 100644
--- a/src/ring_theory/valuation/valuation_subring.lean
+++ b/src/ring_theory/valuation/valuation_subring.lean
@@ -1,17 +1,21 @@
 /-
 Copyright (c) 2022 Adam Topaz. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Adam Topaz, Junyan Xu
+Authors: Adam Topaz, Junyan Xu, Jack McKoen
 -/
 import ring_theory.valuation.valuation_ring
 import ring_theory.localization.as_subring
+import ring_theory.subring.pointwise
 import algebraic_geometry.prime_spectrum.basic
 
 /-!
 
 # Valuation subrings of a field
 
-# Projects
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Projects
 
 The order structure on `valuation_subring K`.
 
@@ -23,7 +27,7 @@ noncomputable theory
 variables (K : Type*) [field K]
 
 /-- A valuation subring of a field `K` is a subring `A` such that for every `x : K`,
-either `x ∈ A` or `x⁻¹ ∈ K`. -/
+either `x ∈ A` or `x⁻¹ ∈ A`. -/
 structure valuation_subring extends subring K :=
 (mem_or_inv_mem' : ∀ x : K, x ∈ carrier ∨ x⁻¹ ∈ carrier)
 
@@ -49,6 +53,16 @@ lemma neg_mem (x : K) : x ∈ A → (-x) ∈ A := A.to_subring.neg_mem
 
 lemma mem_or_inv_mem (x : K) : x ∈ A ∨ x⁻¹ ∈ A := A.mem_or_inv_mem' _
 
+instance : subring_class (valuation_subring K) K :=
+{ zero_mem := zero_mem,
+  add_mem := add_mem,
+  one_mem := one_mem,
+  mul_mem := mul_mem,
+  neg_mem := neg_mem }
+
+lemma to_subring_injective : function.injective (to_subring : valuation_subring K → subring K) :=
+λ x y h, by { cases x, cases y, congr' }
+
 instance : comm_ring A := show comm_ring A.to_subring, by apply_instance
 instance : is_domain A := show is_domain A.to_subring, by apply_instance
 
@@ -72,9 +86,9 @@ instance : valuation_ring A :=
     by_cases (b : K) = 0, { use 0, left, ext, simp [h] },
     by_cases (a : K) = 0, { use 0, right, ext, simp [h] },
     cases A.mem_or_inv_mem (a/b) with hh hh,
-    { use ⟨a/b,hh⟩, right, ext, field_simp, ring },
+    { use ⟨a/b, hh⟩, right, ext, field_simp, ring },
     { rw (show (a/b : K)⁻¹ = b/a, by field_simp) at hh,
-      use ⟨b/a,hh⟩, left, ext, field_simp, ring },
+      use ⟨b/a, hh⟩, left, ext, field_simp, ring },
   end }
 
 instance : algebra A K :=
@@ -84,19 +98,19 @@ show algebra A.to_subring K, by apply_instance
 lemma algebra_map_apply (a : A) : algebra_map A K a = a := rfl
 
 instance : is_fraction_ring A K :=
-{ map_units := λ ⟨y,hy⟩,
+{ map_units := λ ⟨y, hy⟩,
     (units.mk0 (y : K) (λ c, non_zero_divisors.ne_zero hy $ subtype.ext c)).is_unit,
   surj := λ z, begin
-    by_cases z = 0, { use (0,1), simp [h] },
+    by_cases z = 0, { use (0, 1), simp [h] },
     cases A.mem_or_inv_mem z with hh hh,
-    { use (⟨z,hh⟩,1), simp },
-    { refine ⟨⟨1,⟨⟨_,hh⟩,_⟩⟩, mul_inv_cancel h⟩,
+    { use (⟨z, hh⟩, 1), simp },
+    { refine ⟨⟨1, ⟨⟨_, hh⟩, _⟩⟩, mul_inv_cancel h⟩,
       exact mem_non_zero_divisors_iff_ne_zero.2 (λ c, h (inv_eq_zero.mp (congr_arg coe c))) },
   end,
-  eq_iff_exists := λ a b, ⟨ λ h, ⟨1, by { ext, simpa using h }⟩, λ ⟨c,h⟩,
-    congr_arg coe ((mul_eq_mul_right_iff.1 h).resolve_right (non_zero_divisors.ne_zero c.2)) ⟩ }
+  eq_iff_exists := λ a b, ⟨ λ h, ⟨1, by { ext, simpa using h }⟩, λ ⟨c, h⟩,
+    congr_arg coe ((mul_eq_mul_left_iff.1 h).resolve_right (non_zero_divisors.ne_zero c.2)) ⟩ }
 
-/-- The value group of the valuation associated to `A`. -/
+/-- The value group of the valuation associated to `A`. Note: it is actually a group with zero. -/
 @[derive linear_ordered_comm_group_with_zero]
 def value_group := valuation_ring.value_group A K
 
@@ -106,13 +120,13 @@ def valuation : valuation K A.value_group := valuation_ring.valuation A K
 instance inhabited_value_group : inhabited A.value_group := ⟨A.valuation 0⟩
 
 lemma valuation_le_one (a : A) : A.valuation a ≤ 1 :=
-(valuation_ring.mem_integer_iff A K _).2 ⟨a,rfl⟩
+(valuation_ring.mem_integer_iff A K _).2 ⟨a, rfl⟩
 
 lemma mem_of_valuation_le_one (x : K) (h : A.valuation x ≤ 1) : x ∈ A :=
-let ⟨a,ha⟩ := (valuation_ring.mem_integer_iff A K x).1 h in ha ▸ a.2
+let ⟨a, ha⟩ := (valuation_ring.mem_integer_iff A K x).1 h in ha ▸ a.2
 
 lemma valuation_le_one_iff (x : K) : A.valuation x ≤ 1 ↔ x ∈ A :=
-⟨mem_of_valuation_le_one _ _, λ ha, A.valuation_le_one ⟨x,ha⟩⟩
+⟨mem_of_valuation_le_one _ _, λ ha, A.valuation_le_one ⟨x, ha⟩⟩
 
 lemma valuation_eq_iff (x y : K) : A.valuation x = A.valuation y ↔
   ∃ a : Aˣ, (a : K) * y = x := quotient.eq'
@@ -131,7 +145,7 @@ lemma valuation_eq_one_iff (a : A) : is_unit a ↔ A.valuation a = 1 :=
     have ha : (a : K) ≠ 0,
     { intro c, rw [c, A.valuation.map_zero] at h, exact zero_ne_one h },
     have ha' : (a : K)⁻¹ ∈ A,
-    { rw [← valuation_le_one_iff, A.valuation.map_inv, h, inv_one] },
+    { rw [← valuation_le_one_iff, map_inv₀, h, inv_one] },
     apply is_unit_of_mul_eq_one a ⟨a⁻¹, ha'⟩, ext, field_simp,
   end ⟩
 
@@ -179,7 +193,7 @@ subring.subtype R.to_subring
 /-- The canonical map on value groups induced by a coarsening of valuation rings. -/
 def map_of_le (R S : valuation_subring K) (h : R ≤ S) :
   R.value_group →*₀ S.value_group :=
-{ to_fun := quotient.map' id $ λ x y ⟨u,hu⟩, ⟨units.map (R.inclusion S h).to_monoid_hom u, hu⟩,
+{ to_fun := quotient.map' id $ λ x y ⟨u, hu⟩, ⟨units.map (R.inclusion S h).to_monoid_hom u, hu⟩,
   map_zero' := rfl,
   map_one' := rfl,
   map_mul' := by { rintro ⟨⟩ ⟨⟩, refl } }
@@ -187,7 +201,7 @@ def map_of_le (R S : valuation_subring K) (h : R ≤ S) :
 @[mono]
 lemma monotone_map_of_le (R S : valuation_subring K) (h : R ≤ S) :
   monotone (R.map_of_le S h) :=
-by { rintros ⟨⟩ ⟨⟩ ⟨a,ha⟩, exact ⟨R.inclusion S h a, ha⟩ }
+by { rintros ⟨⟩ ⟨⟩ ⟨a, ha⟩, exact ⟨R.inclusion S h a, ha⟩ }
 
 @[simp]
 lemma map_of_le_comp_valuation (R S : valuation_subring K) (h : R ≤ S) :
@@ -207,9 +221,8 @@ instance prime_ideal_of_le (R S : valuation_subring K) (h : R ≤ S) :
 /-- The coarsening of a valuation ring associated to a prime ideal. -/
 def of_prime (A : valuation_subring K) (P : ideal A) [P.is_prime] :
   valuation_subring K :=
-of_le A (localization.subalgebra.of_field K P.prime_compl $
-  le_non_zero_divisors_of_no_zero_divisors $ not_not_intro P.zero_mem).to_subring $
-  λ a ha, subalgebra.algebra_map_mem _ (⟨a,ha⟩ : A)
+of_le A (localization.subalgebra.of_field K _ P.prime_compl_le_non_zero_divisors).to_subring $
+  λ a ha, subalgebra.algebra_map_mem _ (⟨a, ha⟩ : A)
 
 instance of_prime_algebra (A : valuation_subring K) (P : ideal A) [P.is_prime] :
   algebra A (A.of_prime P) := subalgebra.algebra _
@@ -219,11 +232,12 @@ instance of_prime_scalar_tower (A : valuation_subring K) (P : ideal A) [P.is_pri
 
 instance of_prime_localization (A : valuation_subring K) (P : ideal A) [P.is_prime] :
   is_localization.at_prime (A.of_prime P) P :=
-by apply localization.subalgebra.is_localization_of_field K
+by apply localization.subalgebra.is_localization_of_field K P.prime_compl
+  P.prime_compl_le_non_zero_divisors
 
 lemma le_of_prime (A : valuation_subring K) (P : ideal A) [P.is_prime] :
   A ≤ of_prime A P :=
-λ a ha, subalgebra.algebra_map_mem _ (⟨a,ha⟩ : A)
+λ a ha, subalgebra.algebra_map_mem _ (⟨a, ha⟩ : A)
 
 lemma of_prime_valuation_eq_one_iff_mem_prime_compl
   (A : valuation_subring K)
@@ -243,8 +257,8 @@ lemma of_prime_ideal_of_le (R S : valuation_subring K) (h : R ≤ S) :
   of_prime R (ideal_of_le R S h) = S :=
 begin
   ext x, split,
-  { rintro ⟨a,r,hr,rfl⟩, apply mul_mem, { exact h a.2 },
-    { rw [← valuation_le_one_iff, valuation.map_inv, ← inv_one, inv_le_inv₀],
+  { rintro ⟨a, r, hr, rfl⟩, apply mul_mem, { exact h a.2 },
+    { rw [← valuation_le_one_iff, map_inv₀, ← inv_one, inv_le_inv₀],
       { exact not_lt.1 ((not_iff_not.2 $ valuation_lt_one_iff S _).1 hr) },
       { intro hh, erw [valuation.zero_iff, subring.coe_eq_zero_iff] at hh,
         apply hr, rw hh, apply ideal.zero_mem (R.ideal_of_le S h) },
@@ -255,7 +269,7 @@ begin
     { use [1, x⁻¹, hr], split,
       { change (⟨x⁻¹, h hr⟩ : S) ∉ nonunits S,
         erw [mem_nonunits_iff, not_not],
-        apply is_unit_of_mul_eq_one _ (⟨x,hx⟩ : S),
+        apply is_unit_of_mul_eq_one _ (⟨x, hx⟩ : S),
         ext, field_simp },
       { field_simp } } },
 end
@@ -279,7 +293,7 @@ def prime_spectrum_equiv :
   prime_spectrum A ≃ { S | A ≤ S } :=
 { to_fun := λ P, ⟨of_prime A P.as_ideal, le_of_prime _ _⟩,
   inv_fun := λ S, ⟨ideal_of_le _ S S.2, infer_instance⟩,
-  left_inv := λ P, by { ext1, simpa },
+  left_inv := λ P, by { ext1, simp },
   right_inv := λ S, by { ext1, simp } }
 
 /-- An ordered variant of `prime_spectrum_equiv`. -/
@@ -295,7 +309,8 @@ def prime_spectrum_order_equiv : (prime_spectrum A)ᵒᵈ ≃o {S | A ≤ S} :=
   ..(prime_spectrum_equiv A) }
 
 instance linear_order_overring : linear_order { S | A ≤ S } :=
-{ le_total := let i : is_total (prime_spectrum A) (≤) := (subtype.rel_embedding _ _).is_total in
+{ le_total :=
+  let i : is_total (prime_spectrum A) (≤) := ⟨λ ⟨x, _⟩ ⟨y, _⟩, has_le.le.is_total.total x y⟩ in
     by exactI (prime_spectrum_order_equiv A).symm.to_rel_embedding.is_total.total,
   decidable_le := infer_instance,
   ..(infer_instance : partial_order _) }
@@ -321,7 +336,7 @@ def valuation_subring : valuation_subring K :=
     cases le_or_lt (v x) 1,
     { left, exact h },
     { right, change v x⁻¹ ≤ 1,
-      rw [v.map_inv, ← inv_one, inv_le_inv₀],
+      rw [map_inv₀ v, ← inv_one, inv_le_inv₀],
       { exact le_of_lt h },
       { intro c, simpa [c] using h },
       { exact one_ne_zero } }
@@ -361,4 +376,385 @@ variables {K} (A : valuation_subring K)
 lemma valuation_subring_valuation : A.valuation.valuation_subring = A :=
 by { ext, rw ← A.valuation_le_one_iff, refl }
 
+section unit_group
+
+/-- The unit group of a valuation subring, as a subgroup of `Kˣ`. -/
+def unit_group : subgroup Kˣ :=
+(A.valuation.to_monoid_with_zero_hom.to_monoid_hom.comp (units.coe_hom K)).ker
+
+@[simp] lemma mem_unit_group_iff (x : Kˣ) : x ∈ A.unit_group ↔ A.valuation x = 1 := iff.rfl
+
+/-- For a valuation subring `A`, `A.unit_group` agrees with the units of `A`. -/
+def unit_group_mul_equiv : A.unit_group ≃* Aˣ :=
+{ to_fun := λ x,
+  { val := ⟨x, mem_of_valuation_le_one A _ x.prop.le⟩,
+    inv := ⟨↑(x⁻¹), mem_of_valuation_le_one _ _ (x⁻¹).prop.le⟩,
+    val_inv := subtype.ext (units.mul_inv x),
+    inv_val := subtype.ext (units.inv_mul x) },
+  inv_fun := λ x, ⟨units.map A.subtype.to_monoid_hom x, A.valuation_unit x⟩,
+  left_inv := λ a, by { ext, refl },
+  right_inv := λ a, by { ext, refl },
+  map_mul' := λ a b, by { ext, refl } }
+
+@[simp]
+lemma coe_unit_group_mul_equiv_apply (a : A.unit_group) :
+  (A.unit_group_mul_equiv a : K) = a := rfl
+
+@[simp]
+lemma coe_unit_group_mul_equiv_symm_apply (a : Aˣ) :
+  (A.unit_group_mul_equiv.symm a : K) = a := rfl
+
+lemma unit_group_le_unit_group {A B : valuation_subring K} :
+  A.unit_group ≤ B.unit_group ↔ A ≤ B :=
+begin
+  split,
+  { intros h x hx,
+    rw [← A.valuation_le_one_iff x, le_iff_lt_or_eq] at hx,
+    by_cases h_1 : x = 0, { simp only [h_1, zero_mem] },
+    by_cases h_2 : 1 + x = 0,
+      { simp only [← add_eq_zero_iff_neg_eq.1 h_2, neg_mem _ _ (one_mem _)] },
+    cases hx,
+    { have := h (show (units.mk0 _ h_2) ∈ A.unit_group, from A.valuation.map_one_add_of_lt hx),
+      simpa using B.add_mem _ _
+        (show 1 + x ∈ B, from set_like.coe_mem ((B.unit_group_mul_equiv ⟨_, this⟩) : B))
+        (B.neg_mem _ B.one_mem) },
+    { have := h (show (units.mk0 x h_1) ∈ A.unit_group, from hx),
+      refine set_like.coe_mem ((B.unit_group_mul_equiv ⟨_, this⟩) : B) } },
+  { rintros h x (hx : A.valuation x = 1),
+    apply_fun A.map_of_le B h at hx,
+    simpa using hx }
+end
+
+lemma unit_group_injective : function.injective (unit_group : valuation_subring K → subgroup _) :=
+λ A B h, by { simpa only [le_antisymm_iff, unit_group_le_unit_group] using h}
+
+lemma eq_iff_unit_group {A B : valuation_subring K} :
+  A = B ↔ A.unit_group = B.unit_group :=
+unit_group_injective.eq_iff.symm
+
+/-- The map on valuation subrings to their unit groups is an order embedding. -/
+def unit_group_order_embedding : valuation_subring K ↪o subgroup Kˣ :=
+{ to_fun := λ A, A.unit_group,
+  inj' := unit_group_injective,
+  map_rel_iff' := λ A B, unit_group_le_unit_group }
+
+lemma unit_group_strict_mono : strict_mono (unit_group : valuation_subring K → subgroup _) :=
+unit_group_order_embedding.strict_mono
+
+end unit_group
+
+section nonunits
+
+/-- The nonunits of a valuation subring of `K`, as a subsemigroup of `K`-/
+def nonunits : subsemigroup K :=
+{ carrier := { x | A.valuation x < 1 },
+  mul_mem' := λ a b ha hb, (mul_lt_mul₀ ha hb).trans_eq $ mul_one _ }
+
+lemma mem_nonunits_iff {x : K} : x ∈ A.nonunits ↔ A.valuation x < 1 := iff.rfl
+
+lemma nonunits_le_nonunits {A B : valuation_subring K} :
+  B.nonunits ≤ A.nonunits ↔ A ≤ B :=
+begin
+  split,
+  { intros h x hx,
+    by_cases h_1 : x = 0, { simp only [h_1, zero_mem] },
+    rw [← valuation_le_one_iff, ← not_lt, valuation.one_lt_val_iff _ h_1] at hx ⊢,
+    by_contra h_2, from hx (h h_2) },
+  { intros h x hx,
+    by_contra h_1, from not_lt.2 (monotone_map_of_le _ _ h (not_lt.1 h_1)) hx }
+end
+
+lemma nonunits_injective :
+  function.injective (nonunits : valuation_subring K → subsemigroup _) :=
+λ A B h, by { simpa only [le_antisymm_iff, nonunits_le_nonunits] using h.symm }
+
+lemma nonunits_inj {A B : valuation_subring K} : A.nonunits = B.nonunits ↔ A = B :=
+nonunits_injective.eq_iff
+
+/-- The map on valuation subrings to their nonunits is a dual order embedding. -/
+def nonunits_order_embedding :
+  valuation_subring K ↪o (subsemigroup K)ᵒᵈ :=
+{ to_fun := λ A, A.nonunits,
+  inj' := nonunits_injective,
+  map_rel_iff' := λ A B, nonunits_le_nonunits }
+
+variables {A}
+
+ /-- The elements of `A.nonunits` are those of the maximal ideal of `A` after coercion to `K`.
+
+See also `mem_nonunits_iff_exists_mem_maximal_ideal`, which gets rid of the coercion to `K`,
+at the expense of a more complicated right hand side.
+ -/
+theorem coe_mem_nonunits_iff {a : A} : (a : K) ∈ A.nonunits ↔ a ∈ local_ring.maximal_ideal A :=
+(valuation_lt_one_iff _ _).symm
+
+lemma nonunits_le : A.nonunits ≤ A.to_subring.to_submonoid.to_subsemigroup :=
+λ a ha, (A.valuation_le_one_iff _).mp (A.mem_nonunits_iff.mp ha).le
+
+lemma nonunits_subset : (A.nonunits : set K) ⊆ A := nonunits_le
+
+ /-- The elements of `A.nonunits` are those of the maximal ideal of `A`.
+
+See also `coe_mem_nonunits_iff`, which has a simpler right hand side but requires the element
+to be in `A` already.
+ -/
+theorem mem_nonunits_iff_exists_mem_maximal_ideal {a : K} :
+  a ∈ A.nonunits ↔ ∃ ha, (⟨a, ha⟩ : A) ∈ local_ring.maximal_ideal A :=
+⟨λ h, ⟨nonunits_subset h, coe_mem_nonunits_iff.mp h⟩,
+ λ ⟨ha, h⟩, coe_mem_nonunits_iff.mpr h⟩
+
+ /-- `A.nonunits` agrees with the maximal ideal of `A`, after taking its image in `K`. -/
+theorem image_maximal_ideal : (coe : A → K) '' local_ring.maximal_ideal A = A.nonunits :=
+begin
+  ext a,
+  simp only [set.mem_image, set_like.mem_coe, mem_nonunits_iff_exists_mem_maximal_ideal],
+  erw subtype.exists,
+  simp_rw [subtype.coe_mk, exists_and_distrib_right, exists_eq_right],
+end
+
+end nonunits
+
+section principal_unit_group
+
+/-- The principal unit group of a valuation subring, as a subgroup of `Kˣ`. -/
+def principal_unit_group : subgroup Kˣ :=
+{ carrier := { x | A.valuation (x - 1) < 1 },
+  mul_mem' := begin
+    intros a b ha hb,
+    refine lt_of_le_of_lt _ (max_lt hb ha),
+    rw [← one_mul (A.valuation (b - 1)), ← A.valuation.map_one_add_of_lt ha, add_sub_cancel'_right,
+      ← valuation.map_mul, mul_sub_one, ← sub_add_sub_cancel],
+    exact A.valuation.map_add _ _,
+  end,
+  one_mem' := by simp,
+  inv_mem' := begin
+    dsimp,
+    intros a ha,
+    conv {to_lhs, rw [← mul_one (A.valuation _), ← A.valuation.map_one_add_of_lt ha]},
+    rwa [add_sub_cancel'_right, ← valuation.map_mul, sub_mul, units.inv_mul, ← neg_sub, one_mul,
+      valuation.map_neg],
+  end }
+
+lemma principal_units_le_units : A.principal_unit_group ≤ A.unit_group :=
+λ a h, by simpa only [add_sub_cancel'_right] using A.valuation.map_one_add_of_lt h
+
+lemma mem_principal_unit_group_iff (x : Kˣ) :
+  x ∈ A.principal_unit_group ↔ A.valuation ((x : K) - 1) < 1 := iff.rfl
+
+lemma principal_unit_group_le_principal_unit_group {A B : valuation_subring K} :
+  B.principal_unit_group ≤ A.principal_unit_group ↔ A ≤ B :=
+begin
+  split,
+  { intros h x hx,
+    by_cases h_1 : x = 0, { simp only [h_1, zero_mem] },
+    by_cases h_2 : x⁻¹ + 1 = 0,
+    { rw [add_eq_zero_iff_eq_neg, inv_eq_iff_eq_inv, inv_neg, inv_one] at h_2,
+      simpa only [h_2] using B.neg_mem _ B.one_mem },
+    { rw [← valuation_le_one_iff, ← not_lt, valuation.one_lt_val_iff _ h_1, ← add_sub_cancel x⁻¹,
+        ← units.coe_mk0 h_2, ← mem_principal_unit_group_iff] at hx ⊢,
+      simpa only [hx] using @h (units.mk0 (x⁻¹ + 1) h_2) } },
+  { intros h x hx,
+    by_contra h_1, from not_lt.2 (monotone_map_of_le _ _ h (not_lt.1 h_1)) hx }
+end
+
+lemma principal_unit_group_injective :
+  function.injective (principal_unit_group : valuation_subring K → subgroup _) :=
+λ A B h, by { simpa [le_antisymm_iff, principal_unit_group_le_principal_unit_group] using h.symm }
+
+lemma eq_iff_principal_unit_group {A B : valuation_subring K} :
+  A = B ↔ A.principal_unit_group = B.principal_unit_group :=
+principal_unit_group_injective.eq_iff.symm
+
+/-- The map on valuation subrings to their principal unit groups is an order embedding. -/
+def principal_unit_group_order_embedding :
+  valuation_subring K ↪o (subgroup Kˣ)ᵒᵈ :=
+{ to_fun := λ A, A.principal_unit_group,
+  inj' := principal_unit_group_injective,
+  map_rel_iff' := λ A B, principal_unit_group_le_principal_unit_group }
+
+lemma coe_mem_principal_unit_group_iff {x : A.unit_group} :
+  (x : Kˣ) ∈ A.principal_unit_group ↔
+  A.unit_group_mul_equiv x ∈ (units.map (local_ring.residue A).to_monoid_hom).ker :=
+begin
+  rw [monoid_hom.mem_ker, units.ext_iff],
+  let π := ideal.quotient.mk (local_ring.maximal_ideal A), convert_to _ ↔ π _ = 1,
+  rw [← π.map_one, ← sub_eq_zero, ← π.map_sub, ideal.quotient.eq_zero_iff_mem,
+    valuation_lt_one_iff],
+  simpa,
+end
+
+/-- The principal unit group agrees with the kernel of the canonical map from
+the units of `A` to the units of the residue field of `A`. -/
+def principal_unit_group_equiv :
+  A.principal_unit_group ≃* (units.map (local_ring.residue A).to_monoid_hom).ker :=
+{ to_fun := λ x, ⟨A.unit_group_mul_equiv ⟨_, A.principal_units_le_units x.2⟩,
+    A.coe_mem_principal_unit_group_iff.1 x.2⟩,
+  inv_fun := λ x, ⟨A.unit_group_mul_equiv.symm x,
+    by { rw A.coe_mem_principal_unit_group_iff, simpa using set_like.coe_mem x }⟩,
+  left_inv := λ x, by simp,
+  right_inv := λ x, by simp,
+  map_mul' := λ x y, by refl, }
+
+@[simp]
+lemma principal_unit_group_equiv_apply (a : A.principal_unit_group) :
+  (principal_unit_group_equiv A a : K) = a := rfl
+
+@[simp]
+lemma principal_unit_group_symm_apply
+  (a : (units.map (local_ring.residue A).to_monoid_hom).ker) :
+  (A.principal_unit_group_equiv.symm a : K) = a := rfl
+
+/-- The canonical map from the unit group of `A` to the units of the residue field of `A`. -/
+def unit_group_to_residue_field_units :
+  A.unit_group →* (local_ring.residue_field A)ˣ :=
+monoid_hom.comp (units.map $ (ideal.quotient.mk _).to_monoid_hom)
+  A.unit_group_mul_equiv.to_monoid_hom
+
+@[simp]
+lemma coe_unit_group_to_residue_field_units_apply (x : A.unit_group) :
+  (A.unit_group_to_residue_field_units x : (local_ring.residue_field A) ) =
+  (ideal.quotient.mk _ (A.unit_group_mul_equiv x : A)) := rfl
+
+lemma ker_unit_group_to_residue_field_units :
+  A.unit_group_to_residue_field_units.ker = A.principal_unit_group.comap A.unit_group.subtype :=
+by { ext, simpa only [subgroup.mem_comap, subgroup.coe_subtype, coe_mem_principal_unit_group_iff] }
+
+lemma surjective_unit_group_to_residue_field_units :
+  function.surjective A.unit_group_to_residue_field_units :=
+(local_ring.surjective_units_map_of_local_ring_hom _
+ideal.quotient.mk_surjective local_ring.is_local_ring_hom_residue).comp (mul_equiv.surjective _)
+
+/-- The quotient of the unit group of `A` by the principal unit group of `A` agrees with
+the units of the residue field of `A`. -/
+def units_mod_principal_units_equiv_residue_field_units :
+  (A.unit_group ⧸ (A.principal_unit_group.comap A.unit_group.subtype)) ≃*
+  (local_ring.residue_field A)ˣ :=
+(quotient_group.quotient_mul_equiv_of_eq A.ker_unit_group_to_residue_field_units.symm).trans
+  (quotient_group.quotient_ker_equiv_of_surjective _ A.surjective_unit_group_to_residue_field_units)
+
+@[simp]
+lemma units_mod_principal_units_equiv_residue_field_units_comp_quotient_group_mk :
+  A.units_mod_principal_units_equiv_residue_field_units.to_monoid_hom.comp
+  (quotient_group.mk' _) = A.unit_group_to_residue_field_units := rfl
+
+@[simp]
+lemma units_mod_principal_units_equiv_residue_field_units_comp_quotient_group_mk_apply
+  (x : A.unit_group) :
+  A.units_mod_principal_units_equiv_residue_field_units.to_monoid_hom
+  (quotient_group.mk x) = A.unit_group_to_residue_field_units x := rfl
+
+end principal_unit_group
+
+/-! ### Pointwise actions
+
+This transfers the action from `subring.pointwise_mul_action`, noting that it only applies when
+the action is by a group. Notably this provides an instances when `G` is `K ≃+* K`.
+
+These instances are in the `pointwise` locale.
+
+The lemmas in this section are copied from `ring_theory/subring/pointwise.lean`; try to keep these
+in sync.
+-/
+section pointwise_actions
+open_locale pointwise
+
+variables {G : Type*} [group G] [mul_semiring_action G K]
+
+/-- The action on a valuation subring corresponding to applying the action to every element.
+
+This is available as an instance in the `pointwise` locale. -/
+def pointwise_has_smul : has_smul G (valuation_subring K) :=
+{ smul := λ g S,
+  -- TODO: if we add `valuation_subring.map` at a later date, we should use it here
+  { mem_or_inv_mem' := λ x, (mem_or_inv_mem S (g⁻¹ • x)).imp
+      (subring.mem_pointwise_smul_iff_inv_smul_mem.mpr)
+      (λ h, subring.mem_pointwise_smul_iff_inv_smul_mem.mpr $ by rwa smul_inv''),
+    .. g • S.to_subring } }
+
+localized "attribute [instance] valuation_subring.pointwise_has_smul" in pointwise
+open_locale pointwise
+
+@[simp] lemma coe_pointwise_smul (g : G) (S : valuation_subring K) : ↑(g • S) = g • (S : set K) :=
+rfl
+
+@[simp] lemma pointwise_smul_to_subring (g : G) (S : valuation_subring K) :
+  (g • S).to_subring = g • S.to_subring := rfl
+
+/-- The action on a valuation subring corresponding to applying the action to every element.
+
+This is available as an instance in the `pointwise` locale.
+
+This is a stronger version of `valuation_subring.pointwise_has_smul`. -/
+def pointwise_mul_action : mul_action G (valuation_subring K) :=
+to_subring_injective.mul_action to_subring pointwise_smul_to_subring
+
+localized "attribute [instance] valuation_subring.pointwise_mul_action" in pointwise
+open_locale pointwise
+
+lemma smul_mem_pointwise_smul (g : G) (x : K) (S : valuation_subring K) : x ∈ S → g • x ∈ g • S :=
+(set.smul_mem_smul_set : _ → _ ∈ g • (S : set K))
+
+lemma mem_smul_pointwise_iff_exists (g : G) (x : K) (S : valuation_subring K) :
+  x ∈ g • S ↔ ∃ (s : K), s ∈ S ∧ g • s = x :=
+(set.mem_smul_set : x ∈ g • (S : set K) ↔ _)
+
+instance pointwise_central_scalar [mul_semiring_action Gᵐᵒᵖ K] [is_central_scalar G K] :
+  is_central_scalar G (valuation_subring K) :=
+⟨λ g S, to_subring_injective $ by exact op_smul_eq_smul g S.to_subring⟩
+
+@[simp] lemma smul_mem_pointwise_smul_iff {g : G} {S : valuation_subring K} {x : K} :
+  g • x ∈ g • S ↔ x ∈ S :=
+set.smul_mem_smul_set_iff
+
+lemma mem_pointwise_smul_iff_inv_smul_mem {g : G} {S : valuation_subring K} {x : K} :
+  x ∈ g • S ↔ g⁻¹ • x ∈ S :=
+set.mem_smul_set_iff_inv_smul_mem
+
+lemma mem_inv_pointwise_smul_iff {g : G} {S : valuation_subring K} {x : K} :
+  x ∈ g⁻¹ • S ↔ g • x ∈ S :=
+set.mem_inv_smul_set_iff
+
+@[simp] lemma pointwise_smul_le_pointwise_smul_iff {g : G} {S T : valuation_subring K} :
+  g • S ≤ g • T ↔ S ≤ T :=
+set.set_smul_subset_set_smul_iff
+
+lemma pointwise_smul_subset_iff {g : G} {S T : valuation_subring K} : g • S ≤ T ↔ S ≤ g⁻¹ • T :=
+set.set_smul_subset_iff
+
+lemma subset_pointwise_smul_iff {g : G} {S T : valuation_subring K} : S ≤ g • T ↔ g⁻¹ • S ≤ T :=
+set.subset_set_smul_iff
+
+end pointwise_actions
+
+section
+
+variables {L J: Type*} [field L] [field J]
+
+/-- The pullback of a valuation subring `A` along a ring homomorphism `K →+* L`. -/
+def comap (A : valuation_subring L) (f : K →+* L) :
+  valuation_subring K :=
+{ mem_or_inv_mem' := λ k, by simp [valuation_subring.mem_or_inv_mem],
+  ..(A.to_subring.comap f) }
+
+@[simp]
+lemma coe_comap (A : valuation_subring L) (f : K →+* L) : (A.comap f : set K) = f ⁻¹' A := rfl
+
+@[simp]
+lemma mem_comap {A : valuation_subring L} {f : K →+* L} {x : K} : x ∈ A.comap f ↔ f x ∈ A := iff.rfl
+
+lemma comap_comap (A : valuation_subring J) (g : L →+* J) (f : K →+* L) :
+  (A.comap g).comap f = A.comap (g.comp f) :=
+rfl
+
+end
+
 end valuation_subring
+
+namespace valuation
+
+variables {Γ : Type*} [linear_ordered_comm_group_with_zero Γ] (v : valuation K Γ) (x : Kˣ)
+
+@[simp] lemma mem_unit_group_iff : x ∈ v.valuation_subring.unit_group ↔ v x = 1 :=
+(valuation.is_equiv_iff_val_eq_one _ _).mp (valuation.is_equiv_valuation_valuation_subring _).symm
+
+end valuation
diff --git a/src/ring_theory/witt_vector/basic.lean b/src/ring_theory/witt_vector/basic.lean
index 92143c761e0e8..bd5c1584a3451 100644
--- a/src/ring_theory/witt_vector/basic.lean
+++ b/src/ring_theory/witt_vector/basic.lean
@@ -11,6 +11,9 @@ import ring_theory.witt_vector.defs
 /-!
 # Witt vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file verifies that the ring operations on `witt_vector p R`
 satisfy the axioms of a commutative ring.
 
@@ -106,6 +109,14 @@ lemma zsmul (z : ℤ) : map_fun f (z • x) = z • map_fun f x := by map_fun_ta
 
 lemma pow (n : ℕ) : map_fun f (x^ n) = map_fun f x ^ n := by map_fun_tac
 
+lemma nat_cast (n : ℕ) : map_fun f (n : 𝕎 R) = n :=
+show map_fun f n.unary_cast = coe n,
+by induction n; simp [*, nat.unary_cast, add, one, zero]; refl
+
+lemma int_cast (n : ℤ) : map_fun f (n : 𝕎 R) = n :=
+show map_fun f n.cast_def = coe n,
+by cases n; simp [*, int.cast_def, add, one, neg, zero, nat_cast]; refl
+
 end map_fun
 
 end witt_vector
@@ -166,6 +177,10 @@ private lemma ghost_fun_one : ghost_fun (1 : 𝕎 R) = 1 := by ghost_fun_tac 1 !
 private lemma ghost_fun_add : ghost_fun (x + y) = ghost_fun x + ghost_fun y :=
 by ghost_fun_tac (X 0 + X 1) ![x.coeff, y.coeff]
 
+private lemma ghost_fun_nat_cast (i : ℕ) : ghost_fun (i : 𝕎 R) = i :=
+show ghost_fun i.unary_cast = _,
+by induction i; simp [*, nat.unary_cast, ghost_fun_zero, ghost_fun_one, ghost_fun_add, -pi.coe_nat]
+
 private lemma ghost_fun_sub : ghost_fun (x - y) = ghost_fun x - ghost_fun y :=
 by ghost_fun_tac (X 0 - X 1) ![x.coeff, y.coeff]
 
@@ -175,6 +190,10 @@ by ghost_fun_tac (X 0 * X 1) ![x.coeff, y.coeff]
 private lemma ghost_fun_neg : ghost_fun (-x) = - ghost_fun x :=
 by ghost_fun_tac (-X 0) ![x.coeff]
 
+private lemma ghost_fun_int_cast (i : ℤ) : ghost_fun (i : 𝕎 R) = i :=
+show ghost_fun i.cast_def = _,
+by cases i; simp [*, int.cast_def, ghost_fun_nat_cast, ghost_fun_neg, -pi.coe_nat, -pi.coe_int]
+
 private lemma ghost_fun_nsmul (m : ℕ) : ghost_fun (m • x) = m • ghost_fun x :=
 by ghost_fun_tac (m • X 0) ![x.coeff]
 
@@ -214,27 +233,30 @@ include hp
 
 local attribute [instance]
 private def comm_ring_aux₁ : comm_ring (𝕎 (mv_polynomial R ℚ)) :=
+by letI : comm_ring (mv_polynomial R ℚ) := mv_polynomial.comm_ring; exact
 (ghost_equiv' p (mv_polynomial R ℚ)).injective.comm_ring (ghost_fun)
   ghost_fun_zero ghost_fun_one ghost_fun_add ghost_fun_mul ghost_fun_neg ghost_fun_sub
-  ghost_fun_nsmul ghost_fun_zsmul ghost_fun_pow
+  ghost_fun_nsmul ghost_fun_zsmul ghost_fun_pow ghost_fun_nat_cast ghost_fun_int_cast
 
 local attribute [instance]
 private def comm_ring_aux₂ : comm_ring (𝕎 (mv_polynomial R ℤ)) :=
 (map_fun.injective _ $ map_injective (int.cast_ring_hom ℚ) int.cast_injective).comm_ring _
   (map_fun.zero _) (map_fun.one _) (map_fun.add _) (map_fun.mul _) (map_fun.neg _) (map_fun.sub _)
-  (map_fun.nsmul _) (map_fun.zsmul _) (map_fun.pow _)
+  (map_fun.nsmul _) (map_fun.zsmul _) (map_fun.pow _) (map_fun.nat_cast _) (map_fun.int_cast _)
+
+attribute [reducible] comm_ring_aux₂
 
 /-- The commutative ring structure on `𝕎 R`. -/
 instance : comm_ring (𝕎 R) :=
 (map_fun.surjective _ $ counit_surjective _).comm_ring (map_fun $ mv_polynomial.counit _)
   (map_fun.zero _) (map_fun.one _) (map_fun.add _) (map_fun.mul _) (map_fun.neg _) (map_fun.sub _)
-  (map_fun.nsmul _) (map_fun.zsmul _) (map_fun.pow _)
+  (map_fun.nsmul _) (map_fun.zsmul _) (map_fun.pow _) (map_fun.nat_cast _) (map_fun.int_cast _)
 
 variables {p R}
 
 /-- `witt_vector.map f` is the ring homomorphism `𝕎 R →+* 𝕎 S` naturally induced
 by a ring homomorphism `f : R →+* S`. It acts coefficientwise. -/
-def map (f : R →+* S) : 𝕎 R →+* 𝕎 S :=
+noncomputable! def map (f : R →+* S) : 𝕎 R →+* 𝕎 S :=
 { to_fun := map_fun f,
   map_zero' := map_fun.zero f,
   map_one' := map_fun.one f,
@@ -284,7 +306,7 @@ end invertible
 
 /-- `witt_vector.coeff x 0` as a `ring_hom` -/
 @[simps]
-def constant_coeff : 𝕎 R →+* R :=
+noncomputable! def constant_coeff : 𝕎 R →+* R :=
 { to_fun := λ x, x.coeff 0,
   map_zero' := by simp,
   map_one' := by simp,
diff --git a/src/ring_theory/witt_vector/compare.lean b/src/ring_theory/witt_vector/compare.lean
index e6e4ad3ef3fca..8041ad4f5aecb 100644
--- a/src/ring_theory/witt_vector/compare.lean
+++ b/src/ring_theory/witt_vector/compare.lean
@@ -12,6 +12,9 @@ import number_theory.padics.ring_homs
 
 # Comparison isomorphism between `witt_vector p (zmod p)` and `ℤ_[p]`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct a ring isomorphism between `witt_vector p (zmod p)` and `ℤ_[p]`.
 This isomorphism follows from the fact that both satisfy the universal property
 of the inverse limit of `zmod (p^n)`.
diff --git a/src/ring_theory/witt_vector/defs.lean b/src/ring_theory/witt_vector/defs.lean
index 09ca4b5ebfe2f..c3ba171fd8dfa 100644
--- a/src/ring_theory/witt_vector/defs.lean
+++ b/src/ring_theory/witt_vector/defs.lean
@@ -9,6 +9,9 @@ import ring_theory.witt_vector.structure_polynomial
 /-!
 # Witt vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the type of `p`-typical Witt vectors and ring operations on it.
 The ring axioms are verified in `ring_theory/witt_vector/basic.lean`.
 
@@ -175,10 +178,10 @@ instance : has_add (𝕎 R) :=
 instance : has_sub (𝕎 R) :=
 ⟨λ x y, eval (witt_sub p) ![x, y]⟩
 
-instance has_nat_scalar : has_scalar ℕ (𝕎 R) :=
+instance has_nat_scalar : has_smul ℕ (𝕎 R) :=
 ⟨λ n x, eval (witt_nsmul p n) ![x]⟩
 
-instance has_int_scalar : has_scalar ℤ (𝕎 R) :=
+instance has_int_scalar : has_smul ℤ (𝕎 R) :=
 ⟨λ n x, eval (witt_zsmul p n) ![x]⟩
 
 instance : has_mul (𝕎 R) :=
@@ -190,6 +193,9 @@ instance : has_neg (𝕎 R) :=
 instance has_nat_pow : has_pow (𝕎 R) ℕ :=
 ⟨λ x n, eval (witt_pow p n) ![x]⟩
 
+instance : has_nat_cast (𝕎 R) := ⟨nat.unary_cast⟩
+instance : has_int_cast (𝕎 R) := ⟨int.cast_def⟩
+
 end ring_operations
 
 section witt_structure_simplifications
@@ -221,7 +227,7 @@ begin
     bind₁_X_right, bind₁_C_right],
   rw [sub_mul, one_mul],
   rw [finset.sum_eq_single 0],
-  { simp only [inv_of_eq_inv, one_mul, inv_pow₀, tsub_zero, ring_hom.map_one, pow_zero],
+  { simp only [inv_of_eq_inv, one_mul, inv_pow, tsub_zero, ring_hom.map_one, pow_zero],
     simp only [one_pow, one_mul, X_in_terms_of_W_zero, sub_self, bind₁_X_right] },
   { intros i hin hi0,
     rw [finset.mem_range] at hin,
@@ -348,11 +354,11 @@ by simp [has_neg.neg, eval, matrix.cons_fin_one]
 
 lemma nsmul_coeff (m : ℕ) (x : 𝕎 R) (n : ℕ) :
   (m • x).coeff n = peval (witt_nsmul p m n) ![x.coeff] :=
-by simp [has_scalar.smul, eval, matrix.cons_fin_one]
+by simp [has_smul.smul, eval, matrix.cons_fin_one]
 
 lemma zsmul_coeff (m : ℤ) (x : 𝕎 R) (n : ℕ) :
   (m • x).coeff n = peval (witt_zsmul p m n) ![x.coeff] :=
-by simp [has_scalar.smul, eval, matrix.cons_fin_one]
+by simp [has_smul.smul, eval, matrix.cons_fin_one]
 
 lemma pow_coeff (m : ℕ) (x : 𝕎 R) (n : ℕ) :
   (x ^ m).coeff n = peval (witt_pow p m n) ![x.coeff] :=
@@ -366,32 +372,28 @@ by simp [mul_coeff, peval]
 
 end coeff
 
-lemma witt_add_vars (n : ℕ) :
-  (witt_add p n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+lemma witt_add_vars (n : ℕ) : (witt_add p n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
-lemma witt_sub_vars (n : ℕ) :
-  (witt_sub p n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+lemma witt_sub_vars (n : ℕ) : (witt_sub p n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
-lemma witt_mul_vars (n : ℕ) :
-  (witt_mul p n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+lemma witt_mul_vars (n : ℕ) : (witt_mul p n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
-lemma witt_neg_vars (n : ℕ) :
-  (witt_neg p n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+lemma witt_neg_vars (n : ℕ) : (witt_neg p n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
 lemma witt_nsmul_vars (m : ℕ) (n : ℕ) :
-  (witt_nsmul p m n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+  (witt_nsmul p m n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
 lemma witt_zsmul_vars (m : ℤ) (n : ℕ) :
-  (witt_zsmul p m n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+  (witt_zsmul p m n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
 lemma witt_pow_vars (m : ℕ) (n : ℕ) :
-  (witt_pow p m n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+  (witt_pow p m n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 witt_structure_int_vars _ _ _
 
 end witt_vector
diff --git a/src/ring_theory/witt_vector/discrete_valuation_ring.lean b/src/ring_theory/witt_vector/discrete_valuation_ring.lean
index f630199237330..f44bfbc19e7a6 100644
--- a/src/ring_theory/witt_vector/discrete_valuation_ring.lean
+++ b/src/ring_theory/witt_vector/discrete_valuation_ring.lean
@@ -6,13 +6,16 @@ Authors: Robert Y. Lewis, Heather Macbeth, Johan Commelin
 
 import ring_theory.witt_vector.domain
 import ring_theory.witt_vector.mul_coeff
-import ring_theory.discrete_valuation_ring
+import ring_theory.discrete_valuation_ring.basic
 import tactic.linear_combination
 
 /-!
 
 # Witt vectors over a perfect ring
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file establishes that Witt vectors over a perfect field are a discrete valuation ring.
 When `k` is a perfect ring, a nonzero `a : 𝕎 k` can be written as `p^m * b` for some `m : ℕ` and
 `b : 𝕎 k` with nonzero 0th coefficient.
@@ -64,7 +67,7 @@ units.mk_of_mul_eq_one A (witt_vector.mk p (inverse_coeff a A))
     let H_coeff := A.coeff (n + 1) * ↑(a⁻¹ ^ p ^ (n + 1))
       + nth_remainder p n (truncate_fun (n + 1) A) (λ (i : fin (n + 1)), inverse_coeff a A i),
     have H := units.mul_inv (a ^ p ^ (n + 1)),
-    linear_combination (H, -H_coeff) { normalize := ff },
+    linear_combination -H_coeff*H with { normalize := ff },
     have ha : (a:k) ^ (p ^ (n + 1)) = ↑(a ^ (p ^ (n + 1))) := by norm_cast,
     have ha_inv : (↑(a⁻¹):k) ^ (p ^ (n + 1)) = ↑(a ^ (p ^ (n + 1)))⁻¹ :=
       by exact_mod_cast inv_pow _ _,
diff --git a/src/ring_theory/witt_vector/domain.lean b/src/ring_theory/witt_vector/domain.lean
index 2f908ee64d019..2e00ed1545195 100644
--- a/src/ring_theory/witt_vector/domain.lean
+++ b/src/ring_theory/witt_vector/domain.lean
@@ -10,6 +10,9 @@ import ring_theory.witt_vector.identities
 
 # Witt vectors over a domain
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file builds to the proof `witt_vector.is_domain`,
 an instance that says if `R` is an integral domain, then so is `𝕎 R`.
 It depends on the API around iterated applications
@@ -114,7 +117,6 @@ instance [char_p R p] [no_zero_divisors R] : no_zero_divisors (𝕎 R) :=
 end⟩
 
 instance [char_p R p] [is_domain R] : is_domain (𝕎 R) :=
-{ ..witt_vector.no_zero_divisors,
-  ..witt_vector.nontrivial }
+no_zero_divisors.to_is_domain _
 
 end witt_vector
diff --git a/src/ring_theory/witt_vector/frobenius.lean b/src/ring_theory/witt_vector/frobenius.lean
index a0d22a0ece08a..2f9692e4afaa4 100644
--- a/src/ring_theory/witt_vector/frobenius.lean
+++ b/src/ring_theory/witt_vector/frobenius.lean
@@ -5,6 +5,7 @@ Authors: Johan Commelin
 -/
 
 import data.nat.multiplicity
+import data.zmod.algebra
 import ring_theory.witt_vector.basic
 import ring_theory.witt_vector.is_poly
 import field_theory.perfect_closure
@@ -13,6 +14,9 @@ import field_theory.perfect_closure
 /-!
 ## The Frobenius operator
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `R` has characteristic `p`, then there is a ring endomorphism `frobenius R p`
 that raises `r : R` to the power `p`.
 By applying `witt_vector.map` to `frobenius R p`, we obtain a ring endomorphism `𝕎 R →+* 𝕎 R`.
@@ -120,43 +124,30 @@ lemma map_frobenius_poly.key₁ (n j : ℕ) (hj : j < p ^ (n)) :
   p ^ (n - v p ⟨j + 1, j.succ_pos⟩) ∣ (p ^ n).choose (j + 1) :=
 begin
   apply multiplicity.pow_dvd_of_le_multiplicity,
-  have aux : (multiplicity p ((p ^ n).choose (j + 1))).dom,
-  { rw [← multiplicity.finite_iff_dom, multiplicity.finite_nat_iff],
-    exact ⟨hp.1.ne_one, nat.choose_pos hj⟩, },
-  rw [← enat.coe_get aux, enat.coe_le_coe, tsub_le_iff_left,
-      ← enat.coe_le_coe, nat.cast_add, pnat_multiplicity, enat.coe_get, enat.coe_get, add_comm],
-  exact (hp.1.multiplicity_choose_prime_pow hj j.succ_pos).ge,
+  rw [hp.out.multiplicity_choose_prime_pow hj j.succ_ne_zero],
+  refl,
 end
 
 /-- A key numerical identity needed for the proof of `witt_vector.map_frobenius_poly`. -/
-lemma map_frobenius_poly.key₂ {n i j : ℕ} (hi : i < n) (hj : j < p ^ (n - i)) :
-  j - (v p ⟨j + 1, j.succ_pos⟩) + n =
-    i + j + (n - i - v p ⟨j + 1, j.succ_pos⟩) :=
+lemma map_frobenius_poly.key₂ {n i j : ℕ} (hi : i ≤ n) (hj : j < p ^ (n - i)) :
+  j - v p ⟨j + 1, j.succ_pos⟩ + n = i + j + (n - i - v p ⟨j + 1, j.succ_pos⟩) :=
 begin
   generalize h : (v p ⟨j + 1, j.succ_pos⟩) = m,
-  suffices : m ≤ n - i ∧ m ≤ j,
-  { rw [tsub_add_eq_add_tsub this.2, add_comm i j,
-      add_tsub_assoc_of_le (this.1.trans (nat.sub_le n i)), add_assoc, tsub_right_comm, add_comm i,
-      tsub_add_cancel_of_le (le_tsub_of_add_le_right ((le_tsub_iff_left hi.le).mp this.1))] },
-  split,
-  { rw [← h, ← enat.coe_le_coe, pnat_multiplicity, enat.coe_get,
-        ← hp.1.multiplicity_choose_prime_pow hj j.succ_pos],
-    apply le_add_left, refl },
-  { obtain ⟨c, hc⟩ : p ^ m ∣ j + 1,
-    { rw [← h], exact multiplicity.pow_multiplicity_dvd _, },
-    obtain ⟨c, rfl⟩ : ∃ k : ℕ, c = k + 1,
-    { apply nat.exists_eq_succ_of_ne_zero, rintro rfl, simpa only using hc },
-    rw [mul_add, mul_one] at hc,
-    apply nat.le_of_lt_succ,
-    calc m < p ^ m : nat.lt_pow_self hp.1.one_lt m
-       ... ≤ j + 1 : by { rw ← tsub_eq_of_eq_add_rev hc, apply nat.sub_le } }
+  rsuffices ⟨h₁, h₂⟩ : m ≤ n - i ∧ m ≤ j,
+  { rw [tsub_add_eq_add_tsub h₂, add_comm i j,
+      add_tsub_assoc_of_le (h₁.trans (nat.sub_le n i)), add_assoc, tsub_right_comm, add_comm i,
+      tsub_add_cancel_of_le (le_tsub_of_add_le_right ((le_tsub_iff_left hi).mp h₁))] },
+  have hle : p ^ m ≤ j + 1,
+    from h ▸ nat.le_of_dvd j.succ_pos (multiplicity.pow_multiplicity_dvd _),
+  exact ⟨(pow_le_pow_iff hp.1.one_lt).1 (hle.trans hj),
+    nat.le_of_lt_succ ((nat.lt_pow_self hp.1.one_lt m).trans_le hle)⟩
 end
 
 lemma map_frobenius_poly (n : ℕ) :
   mv_polynomial.map (int.cast_ring_hom ℚ) (frobenius_poly p n) = frobenius_poly_rat p n :=
 begin
   rw [frobenius_poly, ring_hom.map_add, ring_hom.map_mul, ring_hom.map_pow, map_C, map_X,
-      ring_hom.eq_int_cast, int.cast_coe_nat, frobenius_poly_rat],
+      eq_int_cast, int.cast_coe_nat, frobenius_poly_rat],
   apply nat.strong_induction_on n, clear n,
   intros n IH,
   rw [X_in_terms_of_W_eq],
@@ -167,7 +158,7 @@ begin
       add_mul, add_mul, mul_right_comm, mul_right_comm (C (↑p ^ (n + 1))), ←C_mul, ←C_mul, pow_succ,
       mul_assoc ↑p (↑p ^ n), h1, mul_one, C_1, one_mul, add_comm _ (X n ^ p), add_assoc, ←add_sub,
       add_right_inj, frobenius_poly_aux_eq, ring_hom.map_sub, map_X, mul_sub, sub_eq_add_neg,
-      add_comm _ (C ↑p * X (n + 1)), ←add_sub, add_right_inj, neg_eq_iff_neg_eq, neg_sub],
+      add_comm _ (C ↑p * X (n + 1)), ←add_sub, add_right_inj, neg_eq_iff_eq_neg, neg_sub, eq_comm],
   simp only [ring_hom.map_sum, mul_sum, sum_mul, ←sum_sub_distrib],
   apply sum_congr rfl,
   intros i hi,
@@ -189,7 +180,8 @@ begin
   rw [←C_eq_coe_nat],
   simp only [←ring_hom.map_pow, ←C_mul],
   rw C_inj,
-  simp only [inv_of_eq_inv, ring_hom.eq_int_cast, inv_pow₀, int.cast_coe_nat, nat.cast_mul],
+  simp only [inv_of_eq_inv, eq_int_cast, inv_pow, int.cast_coe_nat, nat.cast_mul,
+    int.cast_mul],
   rw [rat.coe_nat_div _ _ (map_frobenius_poly.key₁ p (n - i) j hj)],
   simp only [nat.cast_pow, pow_add, pow_one],
   suffices : ((p ^ (n - i)).choose (j + 1) * p ^ (j - v p ⟨j + 1, j.succ_pos⟩) * p * p ^ n : ℚ) =
@@ -197,7 +189,7 @@ begin
   { have aux : ∀ k : ℕ, (p ^ k : ℚ) ≠ 0,
     { intro, apply pow_ne_zero, exact_mod_cast hp.1.ne_zero },
     simpa [aux, -one_div] with field_simps using this.symm },
-  rw [mul_comm _ (p : ℚ), mul_assoc, mul_assoc, ← pow_add, map_frobenius_poly.key₂ p hi hj],
+  rw [mul_comm _ (p : ℚ), mul_assoc, mul_assoc, ← pow_add, map_frobenius_poly.key₂ p hi.le hj],
   ring_exp
 end
 
@@ -205,7 +197,7 @@ lemma frobenius_poly_zmod (n : ℕ) :
   mv_polynomial.map (int.cast_ring_hom (zmod p)) (frobenius_poly p n) = X n ^ p :=
 begin
   rw [frobenius_poly, ring_hom.map_add, ring_hom.map_pow, ring_hom.map_mul, map_X, map_C],
-  simp only [int.cast_coe_nat, add_zero, ring_hom.eq_int_cast, zmod.nat_cast_self, zero_mul, C_0],
+  simp only [int.cast_coe_nat, add_zero, eq_int_cast, zmod.nat_cast_self, zero_mul, C_0],
 end
 
 @[simp]
@@ -293,6 +285,7 @@ lemma coeff_frobenius_char_p (x : 𝕎 R) (n : ℕ) :
   coeff (frobenius x) n = (x.coeff n) ^ p :=
 begin
   rw [coeff_frobenius],
+  letI : algebra (zmod p) R := zmod.algebra _ _,
   -- outline of the calculation, proofs follow below
   calc aeval (λ k, x.coeff k) (frobenius_poly p n)
       = aeval (λ k, x.coeff k)
diff --git a/src/ring_theory/witt_vector/frobenius_fraction_field.lean b/src/ring_theory/witt_vector/frobenius_fraction_field.lean
index b8df1f484e2a9..e9cd65c73af4f 100644
--- a/src/ring_theory/witt_vector/frobenius_fraction_field.lean
+++ b/src/ring_theory/witt_vector/frobenius_fraction_field.lean
@@ -3,13 +3,16 @@ Copyright (c) 2022 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis, Heather Macbeth
 -/
-
+import data.nat.cast.with_top
 import field_theory.is_alg_closed.basic
 import ring_theory.witt_vector.discrete_valuation_ring
 
 /-!
 # Solving equations about the Frobenius map on the field of fractions of `𝕎 k`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The goal of this file is to prove `witt_vector.exists_frobenius_solution_fraction_ring`,
 which says that for an algebraically closed field `k` of characteristic `p` and `a, b` in the
 field of fractions of Witt vectors over `k`,
@@ -96,7 +99,8 @@ lemma root_exists (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
   (ha₁ : a₁.coeff 0 ≠ 0) (ha₂ : a₂.coeff 0 ≠ 0) :
   ∃ b : k, (succ_nth_defining_poly p n a₁ a₂ bs).is_root b :=
 is_alg_closed.exists_root _ $
-  by simp [(succ_nth_defining_poly_degree p n a₁ a₂ bs ha₁ ha₂), hp.out.ne_zero]
+  by simp only [(succ_nth_defining_poly_degree p n a₁ a₂ bs ha₁ ha₂), hp.out.ne_zero,
+    with_top.coe_eq_zero, ne.def, not_false_iff]
 
 /-- This is the `n+1`st coefficient of our solution, projected from `root_exists`. -/
 def succ_nth_val (n : ℕ) (a₁ a₂ : 𝕎 k) (bs : fin (n+1) → k)
@@ -221,21 +225,17 @@ end
 
 local notation `φ` := is_fraction_ring.field_equiv_of_ring_equiv (frobenius_equiv p k)
 
-lemma exists_frobenius_solution_fraction_ring {a : fraction_ring (𝕎 k)} (ha : a ≠ 0) :
-  ∃ (b : fraction_ring (𝕎 k)) (hb : b ≠ 0) (m : ℤ), φ b * a = p ^ m * b :=
+lemma exists_frobenius_solution_fraction_ring_aux
+  (m n : ℕ) (r' q' : 𝕎 k) (hr' : r'.coeff 0 ≠ 0) (hq' : q'.coeff 0 ≠ 0)
+  (hq : ↑p ^ n * q' ∈ non_zero_divisors (𝕎 k)) :
+  let b : 𝕎 k := frobenius_rotation p hr' hq' in
+  is_fraction_ring.field_equiv_of_ring_equiv
+      (frobenius_equiv p k)
+      (algebra_map (𝕎 k) (fraction_ring (𝕎 k)) b) *
+    localization.mk (↑p ^ m * r') ⟨↑p ^ n * q', hq⟩ =
+  ↑p ^ (m - n : ℤ) * algebra_map (𝕎 k) (fraction_ring (𝕎 k)) b :=
 begin
-  revert ha,
-  refine localization.induction_on a _,
-  rintros ⟨r, q, hq⟩ hrq,
-  rw mem_non_zero_divisors_iff_ne_zero at hq,
-  have : r ≠ 0 := λ h, hrq (by simp [h]),
-  obtain ⟨m, r', hr', rfl⟩ := exists_eq_pow_p_mul r this,
-  obtain ⟨n, q', hq', rfl⟩ := exists_eq_pow_p_mul q hq,
-  let b := frobenius_rotation p hr' hq',
-  refine ⟨algebra_map (𝕎 k) _ b, _, m - n, _⟩,
-  { simpa only [map_zero] using
-      (is_fraction_ring.injective (witt_vector p k) (fraction_ring (witt_vector p k))).ne
-        (frobenius_rotation_nonzero p hr' hq')},
+  intros b,
   have key : witt_vector.frobenius b * p ^ m * r' * p ^ n = p ^ m * b * (p ^ n * q'),
   { have H := congr_arg (λ x : 𝕎 k, x * p ^ m * p ^ n) (frobenius_frobenius_rotation p hr' hq'),
     dsimp at H,
@@ -254,6 +254,24 @@ begin
   { simp only [ring_hom.map_mul, ring_hom.map_pow, map_nat_cast] }
 end
 
+lemma exists_frobenius_solution_fraction_ring {a : fraction_ring (𝕎 k)} (ha : a ≠ 0) :
+  ∃ (b : fraction_ring (𝕎 k)) (hb : b ≠ 0) (m : ℤ), φ b * a = p ^ m * b :=
+begin
+  revert ha,
+  refine localization.induction_on a _,
+  rintros ⟨r, q, hq⟩ hrq,
+  have hq0 : q ≠ 0 := mem_non_zero_divisors_iff_ne_zero.1 hq,
+  have hr0 : r ≠ 0 := λ h, hrq (by simp [h]),
+  obtain ⟨m, r', hr', rfl⟩ := exists_eq_pow_p_mul r hr0,
+  obtain ⟨n, q', hq', rfl⟩ := exists_eq_pow_p_mul q hq0,
+  let b := frobenius_rotation p hr' hq',
+  refine ⟨algebra_map (𝕎 k) _ b, _, m - n, _⟩,
+  { simpa only [map_zero] using
+      (is_fraction_ring.injective (witt_vector p k) (fraction_ring (witt_vector p k))).ne
+        (frobenius_rotation_nonzero p hr' hq')},
+  exact exists_frobenius_solution_fraction_ring_aux p m n r' q' hr' hq' hq,
+end
+
 end is_alg_closed
 
 end frobenius_rotation
diff --git a/src/ring_theory/witt_vector/identities.lean b/src/ring_theory/witt_vector/identities.lean
index 5f30cbae076ab..e64810ad66372 100644
--- a/src/ring_theory/witt_vector/identities.lean
+++ b/src/ring_theory/witt_vector/identities.lean
@@ -11,6 +11,9 @@ import ring_theory.witt_vector.mul_p
 /-!
 ## Identities between operations on the ring of Witt vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we derive common identities between the Frobenius and Verschiebung operators.
 
 ## Main declarations
diff --git a/src/ring_theory/witt_vector/init_tail.lean b/src/ring_theory/witt_vector/init_tail.lean
index 1333a32ac7a30..2be11f7e6b5d1 100644
--- a/src/ring_theory/witt_vector/init_tail.lean
+++ b/src/ring_theory/witt_vector/init_tail.lean
@@ -11,6 +11,9 @@ import ring_theory.witt_vector.is_poly
 
 # `init` and `tail`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a Witt vector `x`, we are sometimes interested
 in its components before and after an index `n`.
 This file defines those operations, proves that `init` is polynomial,
diff --git a/src/ring_theory/witt_vector/is_poly.lean b/src/ring_theory/witt_vector/is_poly.lean
index d0dfef20a0fbd..f967401b8e131 100644
--- a/src/ring_theory/witt_vector/is_poly.lean
+++ b/src/ring_theory/witt_vector/is_poly.lean
@@ -11,6 +11,9 @@ import data.mv_polynomial.funext
 /-!
 # The `is_poly` predicate
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 `witt_vector.is_poly` is a (type-valued) predicate on functions `f : Π R, 𝕎 R → 𝕎 R`.
 It asserts that there is a family of polynomials `φ : ℕ → mv_polynomial ℕ ℤ`,
 such that the `n`th coefficient of `f x` is equal to `φ n` evaluated on the coefficients of `x`.
@@ -97,9 +100,6 @@ end
 We define it here so it is a shared import.
 -/
 
-mk_simp_attribute ghost_simps
-"Simplification rules for ghost equations"
-
 namespace tactic
 namespace interactive
 setup_tactic_parser
diff --git a/src/ring_theory/witt_vector/isocrystal.lean b/src/ring_theory/witt_vector/isocrystal.lean
index a64ba515eb81f..02374a808e1f4 100644
--- a/src/ring_theory/witt_vector/isocrystal.lean
+++ b/src/ring_theory/witt_vector/isocrystal.lean
@@ -10,6 +10,9 @@ import ring_theory.witt_vector.frobenius_fraction_field
 
 ## F-isocrystals over a perfect field
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 When `k` is an integral domain, so is `𝕎 k`, and we can consider its field of fractions `K(p, k)`.
 The endomorphism `witt_vector.frobenius` lifts to `φ : K(p, k) → K(p, k)`; if `k` is perfect, `φ` is
 an automorphism.
@@ -58,7 +61,8 @@ namespace witt_vector
 
 variables (p : ℕ) [fact p.prime]
 variables (k : Type*) [comm_ring k]
-localized "notation `K(` p`,` k`)` := fraction_ring (witt_vector p k)" in isocrystal
+localized "notation (name := witt_vector.fraction_ring)
+  `K(`p`, `k`)` := fraction_ring (witt_vector p k)" in isocrystal
 
 section perfect_ring
 variables [is_domain k] [char_p k p] [perfect_ring k p]
@@ -72,8 +76,8 @@ is_fraction_ring.field_equiv_of_ring_equiv (frobenius_equiv p k)
 /-- The Frobenius automorphism of `k` induces an endomorphism of `K`. For notation purposes. -/
 def fraction_ring.frobenius_ring_hom : K(p, k) →+* K(p, k) := fraction_ring.frobenius p k
 
-localized "notation `φ(` p`,` k`)` := witt_vector.fraction_ring.frobenius_ring_hom p k"
-  in isocrystal
+localized "notation (name := witt_vector.frobenius_ring_hom)
+  `φ(`p`, `k`)` := witt_vector.fraction_ring.frobenius_ring_hom p k" in isocrystal
 
 instance inv_pair₁ : ring_hom_inv_pair (φ(p, k)) _ :=
 ring_hom_inv_pair.of_ring_equiv (fraction_ring.frobenius p k)
@@ -82,9 +86,9 @@ instance inv_pair₂ :
   ring_hom_inv_pair ((fraction_ring.frobenius p k).symm : K(p, k) →+* K(p, k)) _ :=
 ring_hom_inv_pair.of_ring_equiv (fraction_ring.frobenius p k).symm
 
-localized "notation M ` →ᶠˡ[`:50 p `,` k `] ` M₂ :=
+localized "notation (name := frobenius_ring_hom.linear_map) M ` →ᶠˡ[`:50 p `, ` k `] ` M₂ :=
   linear_map (witt_vector.fraction_ring.frobenius_ring_hom p k) M M₂" in isocrystal
-localized "notation M ` ≃ᶠˡ[`:50 p `,` k `] ` M₂ :=
+localized "notation (name := frobenius_ring_hom.linear_equiv) M ` ≃ᶠˡ[`:50 p `, ` k `] ` M₂ :=
   linear_equiv (witt_vector.fraction_ring.frobenius_ring_hom p k) M M₂" in isocrystal
 
 /-! ### Isocrystals -/
@@ -107,22 +111,22 @@ Project the Frobenius automorphism from an isocrystal. Denoted by `Φ(p, k)` whe
 def isocrystal.frobenius : V ≃ᶠˡ[p, k] V := @isocrystal.frob p _ k _ _ _ _ _ _ _
 variables (V)
 
-localized "notation `Φ(` p`,` k`)` := witt_vector.isocrystal.frobenius p k" in isocrystal
+localized "notation `Φ(`p`, `k`)` := witt_vector.isocrystal.frobenius p k" in isocrystal
 
 /-- A homomorphism between isocrystals respects the Frobenius map. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure isocrystal_hom extends V →ₗ[K(p, k)] V₂ :=
 ( frob_equivariant : ∀ x : V, Φ(p, k) (to_linear_map x) = to_linear_map (Φ(p, k) x) )
 
 /-- An isomorphism between isocrystals respects the Frobenius map. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure isocrystal_equiv extends V ≃ₗ[K(p, k)] V₂ :=
 ( frob_equivariant : ∀ x : V, Φ(p, k) (to_linear_equiv x) = to_linear_equiv (Φ(p, k) x) )
 
-localized "notation M ` →ᶠⁱ[`:50 p `,` k `] ` M₂ := witt_vector.isocrystal_hom p k M M₂"
-  in isocrystal
-localized "notation M ` ≃ᶠⁱ[`:50 p `,` k `] ` M₂ := witt_vector.isocrystal_equiv p k M M₂"
-  in isocrystal
+localized "notation (name := isocrystal_hom)
+  M ` →ᶠⁱ[`:50 p `, ` k `] ` M₂ := witt_vector.isocrystal_hom p k M M₂" in isocrystal
+localized "notation (name := isocrystal_equiv)
+  M ` ≃ᶠⁱ[`:50 p `, ` k `] ` M₂ := witt_vector.isocrystal_equiv p k M M₂" in isocrystal
 
 
 end perfect_ring
@@ -139,7 +143,7 @@ def fraction_ring.module : module K(p, k) K(p, k) := semiring.to_module
 Type synonym for `K(p, k)` to carry the standard 1-dimensional isocrystal structure
 of slope `m : ℤ`.
 -/
-@[nolint unused_arguments has_inhabited_instance, derive [add_comm_group, module K(p, k)]]
+@[nolint unused_arguments has_nonempty_instance, derive [add_comm_group, module K(p, k)]]
 def standard_one_dim_isocrystal (m : ℤ) : Type* :=
 K(p, k)
 
@@ -182,7 +186,7 @@ begin
   let F₀ : standard_one_dim_isocrystal p k m →ₗ[K(p,k)] V :=
     linear_map.to_span_singleton K(p, k) V x,
   let F : standard_one_dim_isocrystal p k m ≃ₗ[K(p,k)] V,
-  { refine linear_equiv.of_bijective F₀ _ _,
+  { refine linear_equiv.of_bijective F₀ ⟨_, _⟩,
     { rw ← linear_map.ker_eq_bot,
       exact linear_map.ker_to_span_singleton K(p, k) V hx },
     { rw ← linear_map.range_eq_top,
@@ -197,7 +201,7 @@ begin
     linear_equiv.map_smulₛₗ, standard_one_dim_isocrystal.frobenius_apply, algebra.id.smul_eq_mul],
   simp only [←mul_smul],
   congr' 1,
-  linear_combination (hmb, φ(p,k) c),
+  linear_combination φ(p,k) c * hmb,
 end
 
 end witt_vector
diff --git a/src/ring_theory/witt_vector/mul_coeff.lean b/src/ring_theory/witt_vector/mul_coeff.lean
index 4decf41963be3..c5973058f8a56 100644
--- a/src/ring_theory/witt_vector/mul_coeff.lean
+++ b/src/ring_theory/witt_vector/mul_coeff.lean
@@ -10,6 +10,9 @@ import data.mv_polynomial.supported
 /-!
 # Leading terms of Witt vector multiplication
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The goal of this file is to study the leading terms of the formula for the `n+1`st coefficient
 of a product of Witt vectors `x` and `y` over a ring of characteristic `p`.
 We aim to isolate the `n+1`st coefficients of `x` and `y`, and express the rest of the product
@@ -48,13 +51,12 @@ rename (prod.mk (0 : fin 2)) (witt_polynomial p ℤ n) *
 
 include hp
 
-lemma witt_poly_prod_vars (n : ℕ) :
-  (witt_poly_prod p n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+lemma witt_poly_prod_vars (n : ℕ) : (witt_poly_prod p n).vars ⊆ univ ×ˢ range (n + 1) :=
 begin
   rw [witt_poly_prod],
   apply subset.trans (vars_mul _ _),
-  apply union_subset;
-  { apply subset.trans (vars_rename _ _),
+  refine union_subset _ _;
+  { refine subset.trans (vars_rename _ _) _,
     simp [witt_polynomial_vars,image_subset_iff] }
 end
 
@@ -63,17 +65,17 @@ def witt_poly_prod_remainder (n : ℕ) : mv_polynomial (fin 2 × ℕ) ℤ :=
 ∑ i in range n, p^i * (witt_mul p i)^(p^(n-i))
 
 lemma witt_poly_prod_remainder_vars (n : ℕ) :
-  (witt_poly_prod_remainder p n).vars ⊆ finset.univ.product (finset.range n) :=
+  (witt_poly_prod_remainder p n).vars ⊆ univ ×ˢ range n :=
 begin
   rw [witt_poly_prod_remainder],
-  apply subset.trans (vars_sum_subset _ _),
+  refine subset.trans (vars_sum_subset _ _) _,
   rw bUnion_subset,
   intros x hx,
   apply subset.trans (vars_mul _ _),
-  apply union_subset,
+  refine union_subset _ _,
   { apply subset.trans (vars_pow _ _),
     have : (p : mv_polynomial (fin 2 × ℕ) ℤ) = (C (p : ℤ)),
-    { simp only [int.cast_coe_nat, ring_hom.eq_int_cast] },
+    { simp only [int.cast_coe_nat, eq_int_cast] },
     rw [this, vars_C],
     apply empty_subset },
   { apply subset.trans (vars_pow _ _),
@@ -100,12 +102,12 @@ def remainder (n : ℕ) : mv_polynomial (fin 2 × ℕ) ℤ :=
 
 include hp
 
-lemma remainder_vars (n : ℕ) : (remainder p n).vars ⊆ univ.product (range (n+1)) :=
+lemma remainder_vars (n : ℕ) : (remainder p n).vars ⊆ univ ×ˢ range (n + 1) :=
 begin
   rw [remainder],
   apply subset.trans (vars_mul _ _),
-  apply union_subset;
-  { apply subset.trans (vars_sum_subset _ _),
+  refine union_subset _ _;
+  { refine subset.trans (vars_sum_subset _ _) _,
     rw bUnion_subset,
     intros x hx,
     rw [rename_monomial, vars_monomial, finsupp.map_domain_single],
@@ -127,7 +129,7 @@ lemma mul_poly_of_interest_aux1 (n : ℕ) :
 begin
   simp only [witt_poly_prod],
   convert witt_structure_int_prop p (X (0 : fin 2) * X 1) n using 1,
-  { simp only [witt_polynomial, witt_mul, int.nat_cast_eq_coe_nat],
+  { simp only [witt_polynomial, witt_mul],
     rw alg_hom.map_sum,
     congr' 1 with i,
     congr' 1,
@@ -135,7 +137,7 @@ begin
     { rw finsupp.support_eq_singleton,
       simp only [and_true, finsupp.single_eq_same, eq_self_iff_true, ne.def],
       exact pow_ne_zero _ hp.out.ne_zero, },
-    simp only [bind₁_monomial, hsupp, int.cast_coe_nat, prod_singleton, ring_hom.eq_int_cast,
+    simp only [bind₁_monomial, hsupp, int.cast_coe_nat, prod_singleton, eq_int_cast,
       finsupp.single_eq_same, C_pow, mul_eq_mul_left_iff, true_or, eq_self_iff_true], },
   { simp only [map_mul, bind₁_X_right] }
 end
@@ -159,14 +161,14 @@ lemma mul_poly_of_interest_aux3 (n : ℕ) :
 begin
   -- a useful auxiliary fact
   have mvpz : (p ^ (n + 1) : mv_polynomial (fin 2 × ℕ) ℤ) = mv_polynomial.C (↑p ^ (n + 1)),
-  { simp only [int.cast_coe_nat, ring_hom.eq_int_cast, C_pow, eq_self_iff_true] },
+  { simp only [int.cast_coe_nat, eq_int_cast, C_pow, eq_self_iff_true] },
 
   -- unfold definitions and peel off the last entries of the sums.
   rw [witt_poly_prod, witt_polynomial, alg_hom.map_sum, alg_hom.map_sum,
       sum_range_succ],
   -- these are sums up to `n+2`, so be careful to only unfold to `n+1`.
   conv_lhs {congr, skip, rw [sum_range_succ] },
-  simp only [add_mul, mul_add, tsub_self, int.nat_cast_eq_coe_nat, pow_zero, alg_hom.map_sum],
+  simp only [add_mul, mul_add, tsub_self, pow_zero, alg_hom.map_sum],
 
   -- rearrange so that the first summand on rhs and lhs is `remainder`, and peel off
   conv_rhs { rw add_comm },
@@ -175,10 +177,9 @@ begin
   conv_rhs { rw sum_range_succ },
 
   -- the rest is equal with proper unfolding and `ring`
-  simp only [rename_monomial, monomial_eq_C_mul_X, map_mul, rename_C, pow_one, rename_X, mvpz],
-  simp only [int.cast_coe_nat, map_pow, ring_hom.eq_int_cast, rename_X, pow_one, tsub_self,
-    pow_zero],
-  ring,
+  simp only [rename_monomial, ← C_mul_X_pow_eq_monomial, map_mul, rename_C, pow_one, rename_X],
+  simp only [mvpz, int.cast_coe_nat, map_pow, eq_int_cast, rename_X, pow_one, tsub_self, pow_zero],
+  ring1
 end
 include hp
 
@@ -205,11 +206,11 @@ end
 
 lemma mul_poly_of_interest_vars (n : ℕ) :
   ((p ^ (n + 1) : mv_polynomial (fin 2 × ℕ) ℤ) * poly_of_interest p n).vars ⊆
-  univ.product (range (n+1)) :=
+  univ ×ˢ range (n + 1) :=
 begin
   rw mul_poly_of_interest_aux5,
   apply subset.trans (vars_sub_subset _ _),
-  apply union_subset,
+  refine union_subset _ _,
   { apply remainder_vars },
   { apply witt_poly_prod_remainder_vars }
 end
@@ -222,13 +223,13 @@ lemma poly_of_interest_vars_eq (n : ℕ) :
     (X (1, n+1)) * rename (prod.mk (0 : fin 2)) (witt_polynomial p ℤ (n + 1)))).vars :=
 begin
   have : (p ^ (n + 1) : mv_polynomial (fin 2 × ℕ) ℤ) = C (p ^ (n + 1) : ℤ),
-  { simp only [int.cast_coe_nat, ring_hom.eq_int_cast, C_pow, eq_self_iff_true] },
+  { simp only [int.cast_coe_nat, eq_int_cast, C_pow, eq_self_iff_true] },
   rw [poly_of_interest, this, vars_C_mul],
   apply pow_ne_zero,
   exact_mod_cast hp.out.ne_zero
 end
 
-lemma poly_of_interest_vars (n : ℕ) : (poly_of_interest p n).vars ⊆ univ.product (range (n+1)) :=
+lemma poly_of_interest_vars (n : ℕ) : (poly_of_interest p n).vars ⊆ univ ×ˢ (range (n+1)) :=
 by rw poly_of_interest_vars_eq; apply mul_poly_of_interest_vars
 
 lemma peval_poly_of_interest (n : ℕ) (x y : 𝕎 k) :
@@ -242,18 +243,11 @@ begin
   matrix.cons_val_one, map_mul, matrix.cons_val_zero, map_sub],
   rw [sub_sub, add_comm (_ * _), ← sub_sub],
   have mvpz : (p : mv_polynomial ℕ ℤ) = mv_polynomial.C ↑p,
-  { rw [ring_hom.eq_int_cast, int.cast_coe_nat] },
-  congr' 3,
-  { simp only [mul_coeff, peval, map_nat_cast, map_add, matrix.head_cons, map_pow,
-      function.uncurry_apply_pair, aeval_X, matrix.cons_val_one, map_mul, matrix.cons_val_zero], },
-  all_goals
-  { simp only [witt_polynomial_eq_sum_C_mul_X_pow, aeval, eval₂_rename, int.cast_coe_nat,
-      ring_hom.eq_int_cast, eval₂_mul, function.uncurry_apply_pair, function.comp_app, eval₂_sum,
-      eval₂_X, matrix.cons_val_zero, eval₂_pow, int.cast_pow, ring_hom.to_fun_eq_coe, coe_eval₂_hom,
-      int.nat_cast_eq_coe_nat, alg_hom.coe_mk],
-  congr' 1 with z,
-  rw [mvpz, mv_polynomial.eval₂_C],
-  refl }
+  { rw [eq_int_cast, int.cast_coe_nat] },
+  have : ∀ (f : ℤ →+* k) (g : ℕ → k), eval₂ f g p = f p,
+  { intros, rw [mvpz, mv_polynomial.eval₂_C] },
+  simp [witt_polynomial_eq_sum_C_mul_X_pow, aeval, eval₂_rename, this, mul_coeff, peval,
+    map_nat_cast, map_add, map_pow, map_mul]
 end
 
 variable [char_p k p]
@@ -292,7 +286,7 @@ begin
     apply f₀,
     rintros ⟨a, ha⟩,
     apply function.uncurry (![x, y]),
-    simp only [true_and, multiset.mem_cons, range_coe, product_val, multiset.mem_range,
+    simp only [true_and, multiset.mem_cons, range_val, product_val, multiset.mem_range,
        multiset.mem_product, multiset.range_succ, mem_univ_val] at ha,
     refine ⟨a.fst, ⟨a.snd, _⟩⟩,
     cases ha with ha ha; linarith only [ha] },
@@ -305,7 +299,7 @@ begin
   ext a,
   cases a with a ha,
   cases a with i m,
-  simp only [true_and, multiset.mem_cons, range_coe, product_val, multiset.mem_range,
+  simp only [true_and, multiset.mem_cons, range_val, product_val, multiset.mem_range,
     multiset.mem_product, multiset.range_succ, mem_univ_val] at ha,
   have ha' : m < n + 1 := by cases ha with ha ha; linarith only [ha],
   fin_cases i;  -- surely this case split is not necessary
diff --git a/src/ring_theory/witt_vector/mul_p.lean b/src/ring_theory/witt_vector/mul_p.lean
index c8cc34f12bd59..750ab4c8d9e65 100644
--- a/src/ring_theory/witt_vector/mul_p.lean
+++ b/src/ring_theory/witt_vector/mul_p.lean
@@ -9,6 +9,9 @@ import ring_theory.witt_vector.is_poly
 /-!
 ## Multiplication by `n` in the ring of Witt vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we show that multiplication by `n` in the ring of Witt vectors
 is a polynomial function. We then use this fact to show that the composition of Frobenius
 and Verschiebung is equal to multiplication by `p`.
diff --git a/src/ring_theory/witt_vector/structure_polynomial.lean b/src/ring_theory/witt_vector/structure_polynomial.lean
index d94292f8dc0de..0362bd35f4a7f 100644
--- a/src/ring_theory/witt_vector/structure_polynomial.lean
+++ b/src/ring_theory/witt_vector/structure_polynomial.lean
@@ -4,7 +4,6 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Robert Y. Lewis
 -/
 
-import data.fin.vec_notation
 import field_theory.finite.polynomial
 import number_theory.basic
 import ring_theory.witt_vector.witt_polynomial
@@ -12,6 +11,9 @@ import ring_theory.witt_vector.witt_polynomial
 /-!
 # Witt structure polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the main theorem that makes the whole theory of Witt vectors work.
 Briefly, consider a polynomial `Φ : mv_polynomial idx ℤ` over the integers,
 with polynomials variables indexed by an arbitrary type `idx`.
@@ -133,7 +135,7 @@ theorem witt_structure_rat_prop (Φ : mv_polynomial idx ℚ) (n : ℕ) :
 calc bind₁ (witt_structure_rat p Φ) (W_ ℚ n)
     = bind₁ (λ k, bind₁ (λ i, (rename (prod.mk i)) (W_ ℚ k)) Φ)
         (bind₁ (X_in_terms_of_W p ℚ) (W_ ℚ n)) :
-      by { rw bind₁_bind₁, apply eval₂_hom_congr (ring_hom.ext_rat _ _) rfl rfl }
+      by { rw bind₁_bind₁, exact eval₂_hom_congr (ring_hom.ext_rat _ _) rfl rfl }
 ... = bind₁ (λ i, (rename (prod.mk i) (W_ ℚ n))) Φ :
       by rw [bind₁_X_in_terms_of_W_witt_polynomial p _ n, bind₁_X_right]
 
@@ -242,7 +244,7 @@ begin
   intros k hk,
   rw [finset.mem_range, nat.lt_succ_iff] at hk,
   simp only [← sub_eq_zero, ← ring_hom.map_sub, ← C_dvd_iff_zmod, C_eq_coe_nat, ← mul_sub,
-    ← int.nat_cast_eq_coe_nat, ← nat.cast_pow],
+    ← nat.cast_pow],
   rw show p ^ (n + 1) = p ^ k * p ^ (n - k + 1),
   { rw [← pow_add, ←add_assoc], congr' 2, rw [add_comm, ←tsub_eq_iff_eq_add_of_le hk] },
   rw [nat.cast_mul, nat.cast_pow, nat.cast_pow],
@@ -252,7 +254,7 @@ begin
   rw [pow_mul],
   -- the machine!
   apply dvd_sub_pow_of_dvd_sub,
-  rw [← C_eq_coe_nat, int.nat_cast_eq_coe_nat, C_dvd_iff_zmod, ring_hom.map_sub,
+  rw [← C_eq_coe_nat, C_dvd_iff_zmod, ring_hom.map_sub,
       sub_eq_zero, map_expand, ring_hom.map_pow, mv_polynomial.expand_zmod],
 end
 
@@ -281,7 +283,7 @@ begin
   simp only [← sum_induction_steps, ← map_witt_polynomial p (int.cast_ring_hom ℚ),
     ← map_rename, ← map_bind₁, ← ring_hom.map_sub, coeff_map],
   rw show (p : ℚ)^n = ((p^n : ℕ) : ℤ), by norm_cast,
-  rw [← rat.denom_eq_one_iff, ring_hom.eq_int_cast, rat.denom_div_cast_eq_one_iff],
+  rw [← rat.denom_eq_one_iff, eq_int_cast, rat.denom_div_cast_eq_one_iff],
   swap, { exact_mod_cast pow_ne_zero n hp.1.ne_zero },
   revert c, rw [← C_dvd_iff_dvd_coeff],
   exact C_p_pow_dvd_bind₁_rename_witt_polynomial_sub_sum Φ n IH,
@@ -345,12 +347,12 @@ lemma constant_coeff_witt_structure_rat_zero (Φ : mv_polynomial idx ℚ) :
   constant_coeff (witt_structure_rat p Φ 0) = constant_coeff Φ :=
 by simp only [witt_structure_rat, bind₁, map_aeval, X_in_terms_of_W_zero, constant_coeff_rename,
   constant_coeff_witt_polynomial, aeval_X, constant_coeff_comp_algebra_map,
-  eval₂_hom_zero', ring_hom.id_apply]
+  eval₂_hom_zero'_apply, ring_hom.id_apply]
 
 lemma constant_coeff_witt_structure_rat (Φ : mv_polynomial idx ℚ)
   (h : constant_coeff Φ = 0) (n : ℕ) :
   constant_coeff (witt_structure_rat p Φ n) = 0 :=
-by simp only [witt_structure_rat, eval₂_hom_zero', h, bind₁, map_aeval, constant_coeff_rename,
+by simp only [witt_structure_rat, eval₂_hom_zero'_apply, h, bind₁, map_aeval, constant_coeff_rename,
   constant_coeff_witt_polynomial, constant_coeff_comp_algebra_map, ring_hom.id_apply,
   constant_coeff_X_in_terms_of_W]
 
@@ -382,7 +384,7 @@ variable (R)
 -- we could relax the fintype on `idx`, but then we need to cast from finset to set.
 -- for our applications `idx` is always finite.
 lemma witt_structure_rat_vars [fintype idx] (Φ : mv_polynomial idx ℚ) (n : ℕ) :
-  (witt_structure_rat p Φ n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+  (witt_structure_rat p Φ n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 begin
   rw witt_structure_rat,
   intros x hx,
@@ -399,7 +401,7 @@ end
 -- we could relax the fintype on `idx`, but then we need to cast from finset to set.
 -- for our applications `idx` is always finite.
 lemma witt_structure_int_vars [fintype idx] (Φ : mv_polynomial idx ℤ) (n : ℕ) :
-  (witt_structure_int p Φ n).vars ⊆ finset.univ.product (finset.range (n + 1)) :=
+  (witt_structure_int p Φ n).vars ⊆ finset.univ ×ˢ finset.range (n + 1) :=
 begin
   have : function.injective (int.cast_ring_hom ℚ) := int.cast_injective,
   rw [← vars_map_of_injective _ this, map_witt_structure_int],
diff --git a/src/ring_theory/witt_vector/teichmuller.lean b/src/ring_theory/witt_vector/teichmuller.lean
index edfd71b3d840c..e6a7e126407f8 100644
--- a/src/ring_theory/witt_vector/teichmuller.lean
+++ b/src/ring_theory/witt_vector/teichmuller.lean
@@ -9,6 +9,9 @@ import ring_theory.witt_vector.basic
 /-!
 # Teichmüller lifts
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `witt_vector.teichmuller`, a monoid hom `R →* 𝕎 R`, which embeds `r : R` as the
 `0`-th component of a Witt vector whose other coefficients are `0`.
 
diff --git a/src/ring_theory/witt_vector/truncated.lean b/src/ring_theory/witt_vector/truncated.lean
index 6b78157a69981..28a88b8f8070b 100644
--- a/src/ring_theory/witt_vector/truncated.lean
+++ b/src/ring_theory/witt_vector/truncated.lean
@@ -10,6 +10,9 @@ import ring_theory.witt_vector.init_tail
 
 # Truncated Witt vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The ring of truncated Witt vectors (of length `n`) is a quotient of the ring of Witt vectors.
 It retains the first `n` coefficients of each Witt vector.
 In this file, we set up the basic quotient API for this ring.
@@ -165,6 +168,12 @@ instance : has_zero (truncated_witt_vector p n R) :=
 instance : has_one (truncated_witt_vector p n R) :=
 ⟨truncate_fun n 1⟩
 
+instance : has_nat_cast (truncated_witt_vector p n R) :=
+⟨λ i, truncate_fun n i⟩
+
+instance : has_int_cast (truncated_witt_vector p n R) :=
+⟨λ i, truncate_fun n i⟩
+
 instance : has_add (truncated_witt_vector p n R) :=
 ⟨λ x y, truncate_fun n (x.out + y.out)⟩
 
@@ -177,10 +186,10 @@ instance : has_neg (truncated_witt_vector p n R) :=
 instance : has_sub (truncated_witt_vector p n R) :=
 ⟨λ x y, truncate_fun n (x.out - y.out)⟩
 
-instance has_nat_scalar : has_scalar ℕ (truncated_witt_vector p n R) :=
+instance has_nat_scalar : has_smul ℕ (truncated_witt_vector p n R) :=
 ⟨λ m x, truncate_fun n (m • x.out)⟩
 
-instance has_int_scalar : has_scalar ℤ (truncated_witt_vector p n R) :=
+instance has_int_scalar : has_smul ℤ (truncated_witt_vector p n R) :=
 ⟨λ m x, truncate_fun n (m • x.out)⟩
 
 instance has_nat_pow : has_pow (truncated_witt_vector p n R) ℕ :=
@@ -250,6 +259,10 @@ lemma truncate_fun_pow (x : 𝕎 R) (m : ℕ) :
   truncate_fun n (x ^ m) = truncate_fun n x ^ m :=
 by { witt_truncate_fun_tac, rw init_pow }
 
+lemma truncate_fun_nat_cast (m : ℕ) : truncate_fun n (m : 𝕎 R) = m := rfl
+
+lemma truncate_fun_int_cast (m : ℤ) : truncate_fun n (m : 𝕎 R) = m := rfl
+
 end witt_vector
 
 namespace truncated_witt_vector
@@ -269,6 +282,8 @@ instance : comm_ring (truncated_witt_vector p n R) :=
   (truncate_fun_nsmul n)
   (truncate_fun_zsmul n)
   (truncate_fun_pow n)
+  (truncate_fun_nat_cast n)
+  (truncate_fun_int_cast n)
 
 end truncated_witt_vector
 
@@ -281,7 +296,7 @@ include hp
 
 /-- `truncate n` is a ring homomorphism that truncates `x` to its first `n` entries
 to obtain a `truncated_witt_vector`, which has the same base `p` as `x`. -/
-def truncate : 𝕎 R →+* truncated_witt_vector p n R :=
+noncomputable! def truncate : 𝕎 R →+* truncated_witt_vector p n R :=
 { to_fun := truncate_fun n,
   map_zero' := truncate_fun_zero p n R,
   map_add' := truncate_fun_add n,
@@ -306,7 +321,7 @@ lemma mem_ker_truncate (x : 𝕎 R) :
 begin
   simp only [ring_hom.mem_ker, truncate, truncate_fun, ring_hom.coe_mk,
     truncated_witt_vector.ext_iff, truncated_witt_vector.coeff_mk, coeff_zero],
-  exact subtype.forall
+  exact fin.forall_iff
 end
 
 variables (p)
diff --git a/src/ring_theory/witt_vector/verschiebung.lean b/src/ring_theory/witt_vector/verschiebung.lean
index 164eb82bbd13d..24286e1adef51 100644
--- a/src/ring_theory/witt_vector/verschiebung.lean
+++ b/src/ring_theory/witt_vector/verschiebung.lean
@@ -11,6 +11,9 @@ import ring_theory.witt_vector.is_poly
 /-!
 ## The Verschiebung operator
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## References
 
 * [Hazewinkel, *Witt Vectors*][Haze09]
@@ -167,9 +170,7 @@ begin
       simp only [←aeval_verschiebung_poly, coeff_mk],
       funext k,
       exact eval₂_hom_congr (ring_hom.ext_int _ _) rfl rfl },
-    { rw [ghost_component_verschiebung],
-      congr' 1,
-      exact eval₂_hom_congr (ring_hom.ext_int _ _) rfl rfl } }
+    { rw [ghost_component_verschiebung], refl } }
 end
 
 end witt_vector
diff --git a/src/ring_theory/witt_vector/witt_polynomial.lean b/src/ring_theory/witt_vector/witt_polynomial.lean
index e8127c9c519b8..9adc726f54468 100644
--- a/src/ring_theory/witt_vector/witt_polynomial.lean
+++ b/src/ring_theory/witt_vector/witt_polynomial.lean
@@ -5,7 +5,7 @@ Authors: Johan Commelin, Robert Y. Lewis
 -/
 
 import algebra.char_p.invertible
-import data.fintype.card
+import data.fintype.big_operators
 import data.mv_polynomial.variables
 import data.mv_polynomial.comm_ring
 import data.mv_polynomial.expand
@@ -14,6 +14,9 @@ import data.zmod.basic
 /-!
 # Witt polynomials
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 To endow `witt_vector p R` with a ring structure,
 we need to study the so-called Witt polynomials.
 
@@ -88,9 +91,9 @@ end
 This allows us to simply write `W n` or `W_ ℤ n`. -/
 
 -- Notation with ring of coefficients explicit
-localized "notation `W_` := witt_polynomial p"   in witt
+localized "notation (name := witt_polynomial) `W_` := witt_polynomial p" in witt
 -- Notation with ring of coefficients implicit
-localized "notation `W`  := witt_polynomial p _" in witt
+localized "notation (name := witt_polynomial.infer) `W` := witt_polynomial p hole!" in witt
 
 open_locale witt
 open mv_polynomial
@@ -150,8 +153,8 @@ begin
 end
 
 section p_prime
--- in fact, `0 < p` would be sufficient
-variables [hp : fact p.prime]
+
+variables [hp : ne_zero p]
 include hp
 
 lemma witt_polynomial_vars [char_zero R] (n : ℕ) :
@@ -159,12 +162,12 @@ lemma witt_polynomial_vars [char_zero R] (n : ℕ) :
 begin
   have : ∀ i, (monomial (finsupp.single i (p ^ (n - i))) (p ^ i : R)).vars = {i},
   { intro i,
-    refine vars_monomial_single i (pow_ne_zero _ hp.1.ne_zero) _,
+    refine vars_monomial_single i (pow_ne_zero _ hp.1) _,
     rw [← nat.cast_pow, nat.cast_ne_zero],
-    exact pow_ne_zero i hp.1.ne_zero },
+    exact pow_ne_zero i hp.1 },
   rw [witt_polynomial, vars_sum_of_disjoint],
-  { simp only [this, int.nat_cast_eq_coe_nat, bUnion_singleton_eq_self], },
-  { simp only [this, int.nat_cast_eq_coe_nat],
+  { simp only [this, bUnion_singleton_eq_self], },
+  { simp only [this],
     intros a b h,
     apply disjoint_singleton_left.mpr,
     rwa mem_singleton, },
diff --git a/src/ring_theory/zmod.lean b/src/ring_theory/zmod.lean
new file mode 100644
index 0000000000000..85aa3d4eed097
--- /dev/null
+++ b/src/ring_theory/zmod.lean
@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2022 Alex J. Best. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Alex J. Best
+-/
+import algebra.squarefree
+import data.zmod.basic
+import ring_theory.int.basic
+
+/-!
+# Ring theoretic facts about `zmod n`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We collect a few facts about `zmod n` that need some ring theory to be proved/stated
+
+## Main statements
+
+* `is_reduced_zmod` - `zmod n` is reduced for all squarefree `n`.
+-/
+
+@[simp] lemma is_reduced_zmod {n : ℕ} : is_reduced (zmod n) ↔ squarefree n ∨ n = 0 :=
+by rw [← ring_hom.ker_is_radical_iff_reduced_of_surjective
+    (zmod.ring_hom_surjective $ int.cast_ring_hom $ zmod n),
+  zmod.ker_int_cast_ring_hom, ← is_radical_iff_span_singleton,
+  is_radical_iff_squarefree_or_zero, int.squarefree_coe_nat, nat.cast_eq_zero]
+
+instance {n : ℕ} [fact $ squarefree n] : is_reduced (zmod n) :=
+is_reduced_zmod.2 $ or.inl $ fact.out _
diff --git a/src/set_theory/cardinal/basic.lean b/src/set_theory/cardinal/basic.lean
index d861a75fcfb37..c04b208884d0f 100644
--- a/src/set_theory/cardinal/basic.lean
+++ b/src/set_theory/cardinal/basic.lean
@@ -3,15 +3,22 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Floris van Doorn
 -/
-import data.nat.enat
+import data.fintype.big_operators
+import data.finsupp.defs
+import data.nat.part_enat
 import data.set.countable
-import logic.small
-import order.conditionally_complete_lattice
-import set_theory.schroeder_bernstein
+import logic.small.basic
+import order.conditionally_complete_lattice.basic
+import order.succ_pred.limit
+import set_theory.cardinal.schroeder_bernstein
+import tactic.positivity
 
 /-!
 # Cardinal Numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define cardinal numbers as a quotient of types under the equivalence relation of equinumerity.
 
 ## Main definitions
@@ -19,20 +26,29 @@ We define cardinal numbers as a quotient of types under the equivalence relation
 * `cardinal` the type of cardinal numbers (in a given universe).
 * `cardinal.mk α` or `#α` is the cardinality of `α`. The notation `#` lives in the locale
   `cardinal`.
-* There is an instance that `cardinal` forms a `canonically_ordered_comm_semiring`.
 * Addition `c₁ + c₂` is defined by `cardinal.add_def α β : #α + #β = #(α ⊕ β)`.
 * Multiplication `c₁ * c₂` is defined by `cardinal.mul_def : #α * #β = #(α × β)`.
 * The order `c₁ ≤ c₂` is defined by `cardinal.le_def α β : #α ≤ #β ↔ nonempty (α ↪ β)`.
 * Exponentiation `c₁ ^ c₂` is defined by `cardinal.power_def α β : #α ^ #β = #(β → α)`.
-* `cardinal.omega` or `ω` the cardinality of `ℕ`. This definition is universe polymorphic:
-  `cardinal.omega.{u} : cardinal.{u}`
-  (contrast with `ℕ : Type`, which lives in a specific universe).
-  In some cases the universe level has to be given explicitly.
-* `cardinal.min (I : nonempty ι) (c : ι → cardinal)` is the minimal cardinal in the range of `c`.
-* `cardinal.succ c` is the successor cardinal, the smallest cardinal larger than `c`.
-* `cardinal.sum` is the sum of a collection of cardinals.
-* `cardinal.sup` is the supremum of a collection of cardinals.
-* `cardinal.powerlt c₁ c₂` or `c₁ ^< c₂` is defined as `sup_{γ < β} α^γ`.
+* `cardinal.is_limit c` means that `c` is a (weak) limit cardinal: `c ≠ 0 ∧ ∀ x < c, succ x < c`.
+* `cardinal.aleph_0` or `ℵ₀` is the cardinality of `ℕ`. This definition is universe polymorphic:
+  `cardinal.aleph_0.{u} : cardinal.{u}` (contrast with `ℕ : Type`, which lives in a specific
+  universe). In some cases the universe level has to be given explicitly.
+* `cardinal.sum` is the sum of an indexed family of cardinals, i.e. the cardinality of the
+  corresponding sigma type.
+* `cardinal.prod` is the product of an indexed family of cardinals, i.e. the cardinality of the
+  corresponding pi type.
+* `cardinal.powerlt a b` or `a ^< b` is defined as the supremum of `a ^ c` for `c < b`.
+
+## Main instances
+
+* Cardinals form a `canonically_ordered_comm_semiring` with the aforementioned sum and product.
+* Cardinals form a `succ_order`. Use `order.succ c` for the smallest cardinal greater than `c`.
+* The less than relation on cardinals forms a well-order.
+* Cardinals form a `conditionally_complete_linear_order_bot`. Bounded sets for cardinals in universe
+  `u` are precisely the sets indexed by some type in universe `u`, see
+  `cardinal.bdd_above_iff_small`. One can use `Sup` for the cardinal supremum, and `Inf` for the
+  minimum of a set of cardinals.
 
 ## Main Statements
 
@@ -49,7 +65,7 @@ We define cardinal numbers as a quotient of types under the equivalence relation
 * There is an instance `has_pow cardinal`, but this will only fire if Lean already knows that both
   the base and the exponent live in the same universe. As a workaround, you can add
   ```
-    local infixr ^ := @has_pow.pow cardinal cardinal cardinal.has_pow
+    local infixr (name := cardinal.pow) ^ := @has_pow.pow cardinal cardinal cardinal.has_pow
   ```
   to a file. This notation will work even if Lean doesn't know yet that the base and the exponent
   live in the same universe (but no exponents in other types can be used).
@@ -60,16 +76,16 @@ We define cardinal numbers as a quotient of types under the equivalence relation
 
 ## Tags
 
-cardinal number, cardinal arithmetic, cardinal exponentiation, omega,
+cardinal number, cardinal arithmetic, cardinal exponentiation, aleph,
 Cantor's theorem, König's theorem, Konig's theorem
 -/
 
-open function set
-open_locale classical
+open function set order
+open_locale big_operators classical
 
 noncomputable theory
 
-universes u v w x
+universes u v w
 variables {α β : Type u}
 
 /-- The equivalence relation on types given by equivalence (bijective correspondence) of types.
@@ -92,10 +108,10 @@ namespace cardinal
 /-- The cardinal number of a type -/
 def mk : Type u → cardinal := quotient.mk
 
-localized "notation `#` := cardinal.mk" in cardinal
+localized "prefix (name := cardinal.mk) `#` := cardinal.mk" in cardinal
 
-instance can_lift_cardinal_Type : can_lift cardinal.{u} (Type u) :=
-⟨mk, λ c, true, λ c _, quot.induction_on c $ λ α, ⟨α, rfl⟩⟩
+instance can_lift_cardinal_Type : can_lift cardinal.{u} (Type u) mk (λ _, true) :=
+⟨λ c _, quot.induction_on c $ λ α, ⟨α, rfl⟩⟩
 
 @[elab_as_eliminator]
 lemma induction_on {p : cardinal → Prop} (c : cardinal) (h : ∀ α, p (#α)) : p c :=
@@ -123,7 +139,7 @@ nonempty.some $ cardinal.eq.mp (by simp)
 
 lemma mk_congr (e : α ≃ β) : # α = # β := quot.sound ⟨e⟩
 
-alias mk_congr ← equiv.cardinal_eq
+alias mk_congr ← _root_.equiv.cardinal_eq
 
 /-- Lift a function between `Type*`s to a function between `cardinal`s. -/
 def map (f : Type u → Type v) (hf : ∀ α β, α ≃ β → f α ≃ f β) :
@@ -145,28 +161,46 @@ map ulift (λ α β e, equiv.ulift.trans $ e.trans equiv.ulift.symm) c
 
 @[simp] theorem mk_ulift (α) : #(ulift.{v u} α) = lift.{v} (#α) := rfl
 
-theorem lift_umax : lift.{(max u v) u} = lift.{v u} :=
+/-- `lift.{(max u v) u}` equals `lift.{v u}`. Using `set_option pp.universes true` will make it much
+    easier to understand what's happening when using this lemma. -/
+@[simp] theorem lift_umax : lift.{(max u v) u} = lift.{v u} :=
 funext $ λ a, induction_on a $ λ α, (equiv.ulift.trans equiv.ulift.symm).cardinal_eq
 
-theorem lift_umax' : lift.{(max v u) u} = lift.{v u} := lift_umax
+/-- `lift.{(max v u) u}` equals `lift.{v u}`. Using `set_option pp.universes true` will make it much
+    easier to understand what's happening when using this lemma. -/
+@[simp] theorem lift_umax' : lift.{(max v u) u} = lift.{v u} := lift_umax
 
-theorem lift_id' (a : cardinal.{max u v}) : lift.{u} a = a :=
+/-- A cardinal lifted to a lower or equal universe equals itself. -/
+@[simp] theorem lift_id' (a : cardinal.{max u v}) : lift.{u} a = a :=
 induction_on a $ λ α, mk_congr equiv.ulift
 
+/-- A cardinal lifted to the same universe equals itself. -/
 @[simp] theorem lift_id (a : cardinal) : lift.{u u} a = a := lift_id'.{u u} a
+
+/-- A cardinal lifted to the zero universe equals itself. -/
 @[simp] theorem lift_uzero (a : cardinal.{u}) : lift.{0} a = a := lift_id'.{0 u} a
 
 @[simp] theorem lift_lift (a : cardinal) :
-  lift.{w} (lift.{v} a) = lift.{(max v w)} a :=
+  lift.{w} (lift.{v} a) = lift.{max v w} a :=
 induction_on a $ λ α,
 (equiv.ulift.trans $ equiv.ulift.trans equiv.ulift.symm).cardinal_eq
 
 /-- We define the order on cardinal numbers by `#α ≤ #β` if and only if
   there exists an embedding (injective function) from α to β. -/
 instance : has_le cardinal.{u} :=
-⟨λq₁ q₂, quotient.lift_on₂ q₁ q₂ (λα β, nonempty $ α ↪ β) $
-  assume α β γ δ ⟨e₁⟩ ⟨e₂⟩,
-    propext ⟨assume ⟨e⟩, ⟨e.congr e₁ e₂⟩, assume ⟨e⟩, ⟨e.congr e₁.symm e₂.symm⟩⟩⟩
+⟨λ q₁ q₂, quotient.lift_on₂ q₁ q₂ (λ α β, nonempty $ α ↪ β) $
+  λ α β γ δ ⟨e₁⟩ ⟨e₂⟩, propext ⟨λ ⟨e⟩, ⟨e.congr e₁ e₂⟩, λ ⟨e⟩, ⟨e.congr e₁.symm e₂.symm⟩⟩⟩
+
+instance : partial_order cardinal.{u} :=
+{ le           := (≤),
+  le_refl      := by rintros ⟨α⟩; exact ⟨embedding.refl _⟩,
+  le_trans     := by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ ⟨e₁⟩ ⟨e₂⟩; exact ⟨e₁.trans e₂⟩,
+  le_antisymm  := by { rintros ⟨α⟩ ⟨β⟩ ⟨e₁⟩ ⟨e₂⟩, exact quotient.sound (e₁.antisymm e₂) }, }
+
+instance : linear_order cardinal.{u} :=
+{ le_total     := by { rintros ⟨α⟩ ⟨β⟩, apply embedding.total },
+  decidable_le := classical.dec_rel _,
+  ..cardinal.partial_order.{u}, }
 
 theorem le_def (α β : Type u) : #α ≤ #β ↔ nonempty (α ↪ β) :=
 iff.rfl
@@ -194,17 +228,8 @@ mk_subtype_le s
 theorem out_embedding {c c' : cardinal} : c ≤ c' ↔ nonempty (c.out ↪ c'.out) :=
 by { transitivity _, rw [←quotient.out_eq c, ←quotient.out_eq c'], refl }
 
-instance : preorder cardinal.{u} :=
-{ le          := (≤),
-  le_refl     := by rintros ⟨α⟩; exact ⟨embedding.refl _⟩,
-  le_trans    := by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ ⟨e₁⟩ ⟨e₂⟩; exact ⟨e₁.trans e₂⟩ }
-
-instance : partial_order cardinal.{u} :=
-{ le_antisymm := by { rintros ⟨α⟩ ⟨β⟩ ⟨e₁⟩ ⟨e₂⟩, exact quotient.sound (e₁.antisymm e₂) },
-  .. cardinal.preorder }
-
 theorem lift_mk_le {α : Type u} {β : Type v} :
-  lift.{(max v w)} (#α) ≤ lift.{(max u w)} (#β) ↔ nonempty (α ↪ β) :=
+  lift.{max v w} (#α) ≤ lift.{max u w} (#β) ↔ nonempty (α ↪ β) :=
 ⟨λ ⟨f⟩, ⟨embedding.congr equiv.ulift equiv.ulift f⟩,
  λ ⟨f⟩, ⟨embedding.congr equiv.ulift.symm equiv.ulift.symm f⟩⟩
 
@@ -217,7 +242,7 @@ theorem lift_mk_le' {α : Type u} {β : Type v} :
 lift_mk_le.{u v 0}
 
 theorem lift_mk_eq {α : Type u} {β : Type v} :
-  lift.{(max v w)} (#α) = lift.{(max u w)} (#β) ↔ nonempty (α ≃ β) :=
+  lift.{max v w} (#α) = lift.{max u w} (#β) ↔ nonempty (α ≃ β) :=
 quotient.eq.trans
 ⟨λ ⟨f⟩, ⟨equiv.ulift.symm.trans $ f.trans equiv.ulift⟩,
  λ ⟨f⟩, ⟨equiv.ulift.trans $ f.trans equiv.ulift.symm⟩⟩
@@ -245,6 +270,12 @@ lift_injective.eq_iff
 @[simp] theorem lift_lt {a b : cardinal} : lift a < lift b ↔ a < b :=
 lift_order_embedding.lt_iff_lt
 
+theorem lift_strict_mono : strict_mono lift :=
+λ a b, lift_lt.2
+
+theorem lift_monotone : monotone lift :=
+lift_strict_mono.monotone
+
 instance : has_zero cardinal.{u} := ⟨#pempty⟩
 
 instance : inhabited cardinal.{u} := ⟨0⟩
@@ -265,21 +296,28 @@ theorem mk_ne_zero_iff {α : Type u} : #α ≠ 0 ↔ nonempty α :=
 
 @[simp] lemma mk_ne_zero (α : Type u) [nonempty α] : #α ≠ 0 := mk_ne_zero_iff.2 ‹_›
 
-instance : has_one cardinal.{u} := ⟨⟦punit⟧⟩
+instance : has_one cardinal.{u} := ⟨#punit⟩
 
 instance : nontrivial cardinal.{u} := ⟨⟨1, 0, mk_ne_zero _⟩⟩
 
 lemma mk_eq_one (α : Type u) [unique α] : #α = 1 :=
-mk_congr equiv_punit_of_unique
+(equiv.equiv_punit α).cardinal_eq
 
 theorem le_one_iff_subsingleton {α : Type u} : #α ≤ 1 ↔ subsingleton α :=
 ⟨λ ⟨f⟩, ⟨λ a b, f.injective (subsingleton.elim _ _)⟩,
  λ ⟨h⟩, ⟨⟨λ a, punit.star, λ a b _, h _ _⟩⟩⟩
 
+@[simp] lemma mk_le_one_iff_set_subsingleton {s : set α} : #s ≤ 1 ↔ s.subsingleton :=
+le_one_iff_subsingleton.trans s.subsingleton_coe
+
+alias mk_le_one_iff_set_subsingleton ↔ _ _root_.set.subsingleton.cardinal_mk_le_one
+
 instance : has_add cardinal.{u} := ⟨map₂ sum $ λ α β γ δ, equiv.sum_congr⟩
 
 theorem add_def (α β : Type u) : #α + #β = #(α ⊕ β) := rfl
 
+instance : has_nat_cast cardinal.{u} := ⟨nat.unary_cast⟩
+
 @[simp] lemma mk_sum (α : Type u) (β : Type v) :
   #(α ⊕ β) = lift.{v u} (#α) + lift.{u v} (#β) :=
 mk_congr ((equiv.ulift).symm.sum_congr (equiv.ulift).symm)
@@ -292,11 +330,11 @@ mk_congr ((equiv.ulift).symm.sum_congr (equiv.ulift).symm)
 
 @[simp] lemma mk_fintype (α : Type u) [fintype α] : #α = fintype.card α :=
 begin
-  refine fintype.induction_empty_option' _ _ _ α,
+  refine fintype.induction_empty_option _ _ _ α,
   { introsI α β h e hα, letI := fintype.of_equiv β e.symm,
     rwa [mk_congr e, fintype.card_congr e] at hα },
   { refl },
-  { introsI α h hα, simp [hα] }
+  { introsI α h hα, simp [hα], refl }
 end
 
 instance : has_mul cardinal.{u} := ⟨map₂ prod $ λ α β γ δ, equiv.prod_congr⟩
@@ -307,40 +345,15 @@ theorem mul_def (α β : Type u) : #α * #β = #(α × β) := rfl
   #(α × β) = lift.{v u} (#α) * lift.{u v} (#β) :=
 mk_congr (equiv.ulift.symm.prod_congr (equiv.ulift).symm)
 
-protected theorem add_comm (a b : cardinal.{u}) : a + b = b + a :=
-induction_on₂ a b $ λ α β, mk_congr (equiv.sum_comm α β)
-
-protected theorem mul_comm (a b : cardinal.{u}) : a * b = b * a :=
-induction_on₂ a b $ λ α β, mk_congr (equiv.prod_comm α β)
-
-protected theorem zero_add (a : cardinal.{u}) : 0 + a = a :=
-induction_on a $ λ α, mk_congr (equiv.empty_sum pempty α)
-
-protected theorem zero_mul (a : cardinal.{u}) : 0 * a = 0 :=
-induction_on a $ λ α, mk_congr (equiv.pempty_prod α)
-
-protected theorem one_mul (a : cardinal.{u}) : 1 * a = a :=
-induction_on a $ λ α, mk_congr (equiv.punit_prod α)
-
-protected theorem left_distrib (a b c : cardinal.{u}) : a * (b + c) = a * b + a * c :=
-induction_on₃ a b c $ λ α β γ, mk_congr (equiv.prod_sum_distrib α β γ)
-
-protected theorem eq_zero_or_eq_zero_of_mul_eq_zero {a b : cardinal.{u}} :
-  a * b = 0 → a = 0 ∨ b = 0 :=
-begin
-  induction a using cardinal.induction_on with α,
-  induction b using cardinal.induction_on with β,
-  simp only [mul_def, mk_eq_zero_iff, is_empty_prod],
-  exact id
-end
+private theorem mul_comm' (a b : cardinal.{u}) : a * b = b * a :=
+induction_on₂ a b $ λ α β, mk_congr $ equiv.prod_comm α β
 
 /-- The cardinal exponential. `#α ^ #β` is the cardinal of `β → α`. -/
-protected def power (a b : cardinal.{u}) : cardinal.{u} :=
-map₂ (λ α β : Type u, β → α) (λ α β γ δ e₁ e₂, e₂.arrow_congr e₁) a b
+instance : has_pow cardinal.{u} cardinal.{u} :=
+⟨map₂ (λ α β, β → α) (λ α β γ δ e₁ e₂, e₂.arrow_congr e₁)⟩
 
-instance : has_pow cardinal cardinal := ⟨cardinal.power⟩
-local infixr ^ := @has_pow.pow cardinal cardinal cardinal.has_pow
-local infixr ` ^ℕ `:80 := @has_pow.pow cardinal ℕ monoid.has_pow
+local infixr (name := cardinal.pow) ^ := @has_pow.pow cardinal cardinal cardinal.has_pow
+local infixr (name := cardinal.pow.nat) ` ^ℕ `:80 := @has_pow.pow cardinal ℕ monoid.has_pow
 
 theorem power_def (α β) : #α ^ #β = #(β → α) := rfl
 
@@ -349,38 +362,37 @@ mk_congr (equiv.ulift.symm.arrow_congr equiv.ulift.symm)
 
 @[simp] theorem lift_power (a b) : lift (a ^ b) = lift a ^ lift b :=
 induction_on₂ a b $ λ α β,
-mk_congr (equiv.ulift.trans (equiv.ulift.arrow_congr equiv.ulift).symm)
+mk_congr $ equiv.ulift.trans (equiv.ulift.arrow_congr equiv.ulift).symm
 
 @[simp] theorem power_zero {a : cardinal} : a ^ 0 = 1 :=
-induction_on a $ assume α, (equiv.pempty_arrow_equiv_punit α).cardinal_eq
+induction_on a $ λ α, mk_congr $ equiv.pempty_arrow_equiv_punit α
 
 @[simp] theorem power_one {a : cardinal} : a ^ 1 = a :=
-induction_on a $ assume α, (equiv.punit_arrow_equiv α).cardinal_eq
+induction_on a $ λ α, mk_congr $ equiv.punit_arrow_equiv α
 
 theorem power_add {a b c : cardinal} : a ^ (b + c) = a ^ b * a ^ c :=
-induction_on₃ a b c $ assume α β γ, (equiv.sum_arrow_equiv_prod_arrow β γ α).cardinal_eq
+induction_on₃ a b c $ λ α β γ, mk_congr $ equiv.sum_arrow_equiv_prod_arrow β γ α
 
 instance : comm_semiring cardinal.{u} :=
 { zero          := 0,
   one           := 1,
   add           := (+),
   mul           := (*),
-  zero_add      := cardinal.zero_add,
-  add_zero      := assume a, by rw [cardinal.add_comm a 0, cardinal.zero_add a],
-  add_assoc     := λa b c, induction_on₃ a b c $ assume α β γ, mk_congr (equiv.sum_assoc α β γ),
-  add_comm      := cardinal.add_comm,
-  zero_mul      := cardinal.zero_mul,
-  mul_zero      := assume a, by rw [cardinal.mul_comm a 0, cardinal.zero_mul a],
-  one_mul       := cardinal.one_mul,
-  mul_one       := assume a, by rw [cardinal.mul_comm a 1, cardinal.one_mul a],
-  mul_assoc     := λa b c, induction_on₃ a b c $ assume α β γ, mk_congr (equiv.prod_assoc α β γ),
-  mul_comm      := cardinal.mul_comm,
-  left_distrib  := cardinal.left_distrib,
-  right_distrib := assume a b c, by rw [cardinal.mul_comm (a + b) c, cardinal.left_distrib c a b,
-    cardinal.mul_comm c a, cardinal.mul_comm c b],
+  zero_add      := λ a, induction_on a $ λ α, mk_congr $ equiv.empty_sum pempty α,
+  add_zero      := λ a, induction_on a $ λ α, mk_congr $ equiv.sum_empty α pempty,
+  add_assoc     := λ a b c, induction_on₃ a b c $ λ α β γ, mk_congr $ equiv.sum_assoc α β γ,
+  add_comm      := λ a b, induction_on₂ a b $ λ α β, mk_congr $ equiv.sum_comm α β,
+  zero_mul      := λ a, induction_on a $ λ α, mk_congr $ equiv.pempty_prod α,
+  mul_zero      := λ a, induction_on a $ λ α, mk_congr $ equiv.prod_pempty α,
+  one_mul       := λ a, induction_on a $ λ α, mk_congr $ equiv.punit_prod α,
+  mul_one       := λ a, induction_on a $ λ α, mk_congr $ equiv.prod_punit α,
+  mul_assoc     := λ a b c, induction_on₃ a b c $ λ α β γ, mk_congr $ equiv.prod_assoc α β γ,
+  mul_comm      := mul_comm',
+  left_distrib  := λ a b c, induction_on₃ a b c $ λ α β γ, mk_congr $ equiv.prod_sum_distrib α β γ,
+  right_distrib := λ a b c, induction_on₃ a b c $ λ α β γ, mk_congr $ equiv.sum_prod_distrib α β γ,
   npow          := λ n c, c ^ n,
   npow_zero'    := @power_zero,
-  npow_succ'    := λ n c, by rw [nat.cast_succ, power_add, power_one, cardinal.mul_comm] }
+  npow_succ'    := λ n c, show c ^ (n + 1) = c * c ^ n, by rw [power_add, power_one, mul_comm'] }
 
 theorem power_bit0 (a b : cardinal) : a ^ (bit0 b) = a ^ b * a ^ b :=
 power_add
@@ -389,14 +401,14 @@ theorem power_bit1 (a b : cardinal) : a ^ (bit1 b) = a ^ b * a ^ b * a :=
 by rw [bit1, ←power_bit0, power_add, power_one]
 
 @[simp] theorem one_power {a : cardinal} : 1 ^ a = 1 :=
-induction_on a $ assume α, (equiv.arrow_punit_equiv_punit α).cardinal_eq
+induction_on a $ λ α, (equiv.arrow_punit_equiv_punit α).cardinal_eq
 
 @[simp] theorem mk_bool : #bool = 2 := by simp
 
 @[simp] theorem mk_Prop : #(Prop) = 2 := by simp
 
 @[simp] theorem zero_power {a : cardinal} : a ≠ 0 → 0 ^ a = 0 :=
-induction_on a $ assume α heq, mk_eq_zero_iff.2 $ is_empty_pi.2 $
+induction_on a $ λ α heq, mk_eq_zero_iff.2 $ is_empty_pi.2 $
 let ⟨a⟩ := mk_ne_zero_iff.1 heq in ⟨a, pempty.is_empty⟩
 
 theorem power_ne_zero {a : cardinal} (b) : a ≠ 0 → a ^ b ≠ 0 :=
@@ -404,26 +416,24 @@ induction_on₂ a b $ λ α β h,
 let ⟨a⟩ := mk_ne_zero_iff.1 h in mk_ne_zero_iff.2 ⟨λ _, a⟩
 
 theorem mul_power {a b c : cardinal} : (a * b) ^ c = a ^ c * b ^ c :=
-induction_on₃ a b c $ assume α β γ, (equiv.arrow_prod_equiv_prod_arrow α β γ).cardinal_eq
+induction_on₃ a b c $ λ α β γ, mk_congr $ equiv.arrow_prod_equiv_prod_arrow α β γ
 
 theorem power_mul {a b c : cardinal} : a ^ (b * c) = (a ^ b) ^ c :=
-by rw [mul_comm b c];
-from (induction_on₃ a b c $ assume α β γ, mk_congr (equiv.curry γ β α))
+by { rw [mul_comm b c], exact induction_on₃ a b c (λ α β γ, mk_congr $ equiv.curry γ β α) }
 
-@[simp] lemma pow_cast_right (κ : cardinal.{u}) (n : ℕ) :
-  (κ ^ (↑n : cardinal.{u})) = κ ^ℕ n :=
+@[simp] lemma pow_cast_right (a : cardinal.{u}) (n : ℕ) : (a ^ (↑n : cardinal.{u})) = a ^ℕ n :=
 rfl
 
 @[simp] theorem lift_one : lift 1 = 1 :=
-mk_congr (equiv.ulift.trans equiv.punit_equiv_punit)
+mk_congr $ equiv.ulift.trans equiv.punit_equiv_punit
 
 @[simp] theorem lift_add (a b) : lift (a + b) = lift a + lift b :=
 induction_on₂ a b $ λ α β,
-mk_congr (equiv.ulift.trans (equiv.sum_congr equiv.ulift equiv.ulift).symm)
+mk_congr $ equiv.ulift.trans (equiv.sum_congr equiv.ulift equiv.ulift).symm
 
 @[simp] theorem lift_mul (a b) : lift (a * b) = lift a * lift b :=
 induction_on₂ a b $ λ α β,
-mk_congr (equiv.ulift.trans (equiv.prod_congr equiv.ulift equiv.ulift).symm)
+mk_congr $ equiv.ulift.trans (equiv.prod_congr equiv.ulift equiv.ulift).symm
 
 @[simp] theorem lift_bit0 (a : cardinal) : lift (bit0 a) = bit0 (lift a) :=
 lift_add a a
@@ -444,35 +454,49 @@ theorem lift_two_power (a) : lift (2 ^ a) = 2 ^ lift a := by simp
 section order_properties
 open sum
 
-protected theorem zero_le : ∀(a : cardinal), 0 ≤ a :=
+protected theorem zero_le : ∀ a : cardinal, 0 ≤ a :=
 by rintro ⟨α⟩; exact ⟨embedding.of_is_empty⟩
 
-protected theorem add_le_add : ∀{a b c d : cardinal}, a ≤ b → c ≤ d → a + c ≤ b + d :=
+private theorem add_le_add' : ∀ {a b c d : cardinal}, a ≤ b → c ≤ d → a + c ≤ b + d :=
 by rintros ⟨α⟩ ⟨β⟩ ⟨γ⟩ ⟨δ⟩ ⟨e₁⟩ ⟨e₂⟩; exact ⟨e₁.sum_map e₂⟩
 
-protected theorem add_le_add_left (a) {b c : cardinal} : b ≤ c → a + b ≤ a + c :=
-cardinal.add_le_add le_rfl
-
-protected theorem le_iff_exists_add {a b : cardinal} : a ≤ b ↔ ∃ c, b = a + c :=
-⟨induction_on₂ a b $ λ α β ⟨⟨f, hf⟩⟩,
-  have (α ⊕ ((range f)ᶜ : set β)) ≃ β, from
-    (equiv.sum_congr (equiv.of_injective f hf) (equiv.refl _)).trans $
-    (equiv.set.sum_compl (range f)),
-  ⟨#↥(range f)ᶜ, mk_congr this.symm⟩,
- λ ⟨c, e⟩, add_zero a ▸ e.symm ▸ cardinal.add_le_add_left _ (cardinal.zero_le _)⟩
+instance add_covariant_class : covariant_class cardinal cardinal (+) (≤) :=
+⟨λ a b c, add_le_add' le_rfl⟩
 
-instance : order_bot cardinal.{u} :=
-{ bot := 0, bot_le := cardinal.zero_le }
+instance add_swap_covariant_class : covariant_class cardinal cardinal (swap (+)) (≤) :=
+⟨λ a b c h, add_le_add' h le_rfl⟩
 
 instance : canonically_ordered_comm_semiring cardinal.{u} :=
-{ add_le_add_left       := λ a b h c, cardinal.add_le_add_left _ h,
-  le_iff_exists_add     := @cardinal.le_iff_exists_add,
-  eq_zero_or_eq_zero_of_mul_eq_zero := @cardinal.eq_zero_or_eq_zero_of_mul_eq_zero,
-  ..cardinal.order_bot,
+{ bot                   := 0,
+  bot_le                := cardinal.zero_le,
+  add_le_add_left       := λ a b, add_le_add_left,
+  exists_add_of_le     := λ a b, induction_on₂ a b $ λ α β ⟨⟨f, hf⟩⟩,
+    have (α ⊕ ((range f)ᶜ : set β)) ≃ β, from
+      (equiv.sum_congr (equiv.of_injective f hf) (equiv.refl _)).trans $
+      (equiv.set.sum_compl (range f)),
+    ⟨#↥(range f)ᶜ, mk_congr this.symm⟩,
+  le_self_add := λ a b, (add_zero a).ge.trans $ add_le_add_left (cardinal.zero_le _) _,
+  eq_zero_or_eq_zero_of_mul_eq_zero := λ a b, induction_on₂ a b $ λ α β,
+    by simpa only [mul_def, mk_eq_zero_iff, is_empty_prod] using id,
   ..cardinal.comm_semiring, ..cardinal.partial_order }
 
-@[simp] theorem zero_lt_one : (0 : cardinal) < 1 :=
-lt_of_le_of_ne (zero_le _) zero_ne_one
+instance : canonically_linear_ordered_add_monoid cardinal.{u} :=
+{ ..cardinal.canonically_ordered_comm_semiring,
+  ..cardinal.linear_order }
+
+-- Computable instance to prevent a non-computable one being found via the one above
+instance : canonically_ordered_add_monoid cardinal.{u} :=
+{ ..cardinal.canonically_ordered_comm_semiring }
+
+instance : linear_ordered_comm_monoid_with_zero cardinal.{u} :=
+{ mul_le_mul_left := @mul_le_mul_left' _ _ _ _,
+  zero_le_one := zero_le _,
+  ..cardinal.comm_semiring,
+  ..cardinal.linear_order }
+
+-- Computable instance to prevent a non-computable one being found via the one above
+instance : comm_monoid_with_zero cardinal.{u} :=
+{ ..cardinal.canonically_ordered_comm_semiring }
 
 lemma zero_power_le (c : cardinal.{u}) : (0 : cardinal.{u}) ^ c ≤ 1 :=
 by { by_cases h : c = 0, rw [h, power_zero], rw [zero_power h], apply zero_le }
@@ -500,16 +524,7 @@ begin
 end
 
 instance : no_max_order cardinal.{u} :=
-{ exists_gt := λ a, ⟨_, cantor a⟩, ..cardinal.partial_order }
-
-instance : linear_order cardinal.{u} :=
-{ le_total    := by rintros ⟨α⟩ ⟨β⟩; exact embedding.total,
-  decidable_le := classical.dec_rel _,
-  .. cardinal.partial_order }
-
-instance : canonically_linear_ordered_add_monoid cardinal.{u} :=
-{ .. (infer_instance : canonically_ordered_add_monoid cardinal.{u}),
-  .. cardinal.linear_order }
+{ exists_gt := λ a, ⟨_, cantor a⟩ }
 
 -- short-circuit type class inference
 instance : distrib_lattice cardinal.{u} := by apply_instance
@@ -521,69 +536,51 @@ theorem power_le_max_power_one {a b c : cardinal} (h : b ≤ c) : a ^ b ≤ max
 begin
   by_cases ha : a = 0,
   simp [ha, zero_power_le],
-  exact le_trans (power_le_power_left ha h) (le_max_left _ _)
+  exact (power_le_power_left ha h).trans (le_max_left _ _)
 end
 
 theorem power_le_power_right {a b c : cardinal} : a ≤ b → a ^ c ≤ b ^ c :=
-induction_on₃ a b c $ assume α β γ ⟨e⟩, ⟨embedding.arrow_congr_right e⟩
+induction_on₃ a b c $ λ α β γ ⟨e⟩, ⟨embedding.arrow_congr_right e⟩
 
-end order_properties
+theorem power_pos {a : cardinal} (b) (ha : 0 < a) : 0 < a ^ b := (power_ne_zero _ ha.ne').bot_lt
 
-/-- The minimum cardinal in a family of cardinals (the existence
-  of which is provided by `min_injective`). -/
-protected def min {ι} (I : nonempty ι) (f : ι → cardinal) : cardinal :=
-f $ classical.some $ @embedding.min_injective _ (λ i, (f i).out) I
-
-theorem min_eq {ι} (I) (f : ι → cardinal) : ∃ i, cardinal.min I f = f i :=
-⟨_, rfl⟩
-
-theorem min_le {ι I} (f : ι → cardinal) (i) : cardinal.min I f ≤ f i :=
-by rw [← mk_out (cardinal.min I f), ← mk_out (f i)]; exact
-let ⟨g⟩ := classical.some_spec
-  (@embedding.min_injective _ (λ i, (f i).out) I) in
-⟨g i⟩
-
-theorem le_min {ι I} {f : ι → cardinal} {a} : a ≤ cardinal.min I f ↔ ∀ i, a ≤ f i :=
-⟨λ h i, le_trans h (min_le _ _),
- λ h, let ⟨i, e⟩ := min_eq I f in e.symm ▸ h i⟩
+end order_properties
 
-protected theorem wf : @well_founded cardinal.{u} (<) :=
-⟨λ a, classical.by_contradiction $ λ h,
-  let ι := {c :cardinal // ¬ acc (<) c},
-      f : ι → cardinal := subtype.val,
-      ⟨⟨c, hc⟩, hi⟩ := @min_eq ι ⟨⟨_, h⟩⟩ f in
-    hc (acc.intro _ (λ j ⟨_, h'⟩,
-      classical.by_contradiction $ λ hj, h' $
-      by have := min_le f ⟨j, hj⟩; rwa hi at this))⟩
+protected theorem lt_wf : @well_founded cardinal.{u} (<) :=
+⟨λ a, classical.by_contradiction $ λ h, begin
+  let ι := {c : cardinal // ¬ acc (<) c},
+  let f : ι → cardinal := subtype.val,
+  haveI hι : nonempty ι := ⟨⟨_, h⟩⟩,
+  obtain ⟨⟨c : cardinal, hc : ¬acc (<) c⟩, ⟨h_1 : Π j, (f ⟨c, hc⟩).out ↪ (f j).out⟩⟩ :=
+    embedding.min_injective (λ i, (f i).out),
+  apply hc (acc.intro _ (λ j h', classical.by_contradiction (λ hj, h'.2 _))),
+  have : #_ ≤ #_ := ⟨h_1 ⟨j, hj⟩⟩,
+  simpa only [f, mk_out] using this
+end⟩
 
-instance has_wf : @has_well_founded cardinal.{u} := ⟨(<), cardinal.wf⟩
+instance : has_well_founded cardinal.{u} := ⟨(<), cardinal.lt_wf⟩
+instance wo : @is_well_order cardinal.{u} (<) := { }
 
 instance : conditionally_complete_linear_order_bot cardinal :=
-cardinal.wf.conditionally_complete_linear_order_with_bot 0 $ le_antisymm (cardinal.zero_le _) $
-  not_lt.1 (cardinal.wf.not_lt_min set.univ ⟨0, mem_univ _⟩ (mem_univ 0))
-
-instance wo : @is_well_order cardinal.{u} (<) := ⟨cardinal.wf⟩
+is_well_order.conditionally_complete_linear_order_bot _
 
-/-- The successor cardinal - the smallest cardinal greater than
-  `c`. This is not the same as `c + 1` except in the case of finite `c`. -/
-def succ (c : cardinal) : cardinal :=
-Inf {c' | c < c'}
+@[simp] theorem Inf_empty : Inf (∅ : set cardinal.{u}) = 0 :=
+dif_neg not_nonempty_empty
 
-theorem succ_nonempty (c : cardinal) : {c' : cardinal | c < c'}.nonempty :=
-⟨_, cantor _⟩
+/-- Note that the successor of `c` is not the same as `c + 1` except in the case of finite `c`. -/
+instance : succ_order cardinal :=
+succ_order.of_succ_le_iff (λ c, Inf {c' | c < c'})
+  (λ a b, ⟨lt_of_lt_of_le $ Inf_mem $ exists_gt a, cInf_le'⟩)
 
-theorem lt_succ_self (c : cardinal) : c < succ c :=
-Inf_mem (succ_nonempty c)
+theorem succ_def (c : cardinal) : succ c = Inf {c' | c < c'} := rfl
 
-theorem succ_le {a b : cardinal} : succ a ≤ b ↔ a < b :=
-⟨lt_of_lt_of_le (lt_succ_self _), λ h, cInf_le' h⟩
+lemma succ_pos : ∀ c : cardinal, 0 < succ c := bot_lt_succ
 
-@[simp] theorem lt_succ {a b : cardinal} : a < succ b ↔ a ≤ b :=
-by rw [← not_le, succ_le, not_lt]
+lemma succ_ne_zero (c : cardinal) : succ c ≠ 0 := (succ_pos _).ne'
 
 theorem add_one_le_succ (c : cardinal.{u}) : c + 1 ≤ succ c :=
 begin
-  refine (le_cInf_iff'' (succ_nonempty c)).2 (λ b hlt, _),
+  refine (le_cInf_iff'' (exists_gt c)).2 (λ b hlt, _),
   rcases ⟨b, c⟩ with ⟨⟨β⟩, ⟨γ⟩⟩,
   cases le_of_lt hlt with f,
   have : ¬ surjective f := λ hn, (not_le_of_lt hlt) (mk_le_of_surjective hn),
@@ -593,9 +590,19 @@ begin
           ... ≤ #β          : (f.option_elim b hb).cardinal_le
 end
 
-lemma succ_pos (c : cardinal) : 0 < succ c := by simp
+/-- A cardinal is a limit if it is not zero or a successor cardinal. Note that `ℵ₀` is a limit
+  cardinal by this definition, but `0` isn't.
 
-lemma succ_ne_zero (c : cardinal) : succ c ≠ 0 := (succ_pos _).ne'
+  Use `is_succ_limit` if you want to include the `c = 0` case. -/
+def is_limit (c : cardinal) : Prop := c ≠ 0 ∧ is_succ_limit c
+
+protected theorem is_limit.ne_zero {c} (h : is_limit c) : c ≠ 0 := h.1
+
+protected theorem is_limit.is_succ_limit {c} (h : is_limit c) : is_succ_limit c := h.2
+
+theorem is_limit.succ_lt {x c} (h : is_limit c) : x < c → succ x < c := h.is_succ_limit.succ_lt
+
+theorem is_succ_limit_zero : is_succ_limit (0 : cardinal) := is_succ_limit_bot
 
 /-- The indexed sum of cardinals is the cardinality of the
   indexed disjoint union, i.e. sigma type. -/
@@ -639,6 +646,13 @@ lemma mk_le_mk_mul_of_mk_preimage_le {c : cardinal} (f : α → β) (hf : ∀ b
 by simpa only [←mk_congr (@equiv.sigma_fiber_equiv α β f), mk_sigma, ←sum_const']
   using sum_le_sum _ _ hf
 
+lemma lift_mk_le_lift_mk_mul_of_lift_mk_preimage_le {α : Type u} {β : Type v} {c : cardinal}
+  (f : α → β) (hf : ∀ b : β, lift.{v} #(f ⁻¹' {b}) ≤ c) :
+  lift.{v} #α ≤ lift.{u} #β * c :=
+mk_le_mk_mul_of_mk_preimage_le (λ x : ulift.{v} α, ulift.up.{u} (f x.1)) $ ulift.forall.2 $ λ b,
+  (mk_congr $ (equiv.ulift.image _).trans (equiv.trans
+    (by { rw [equiv.image_eq_preimage], simp [set.preimage] }) equiv.ulift.symm)).trans_le (hf b)
+
 /-- The range of an indexed cardinal function, whose outputs live in a higher universe than the
     inputs, is always bounded above. -/
 theorem bdd_above_range {ι : Type u} (f : ι → cardinal.{max u v}) : bdd_above (set.range f) :=
@@ -652,8 +666,11 @@ begin
   simpa using le_mk_iff_exists_set.1 hx
 end
 
+instance (a : cardinal.{u}) : small.{u} (set.Iio a) :=
+small_subset Iio_subset_Iic_self
+
 /-- A set of cardinals is bounded above iff it's small, i.e. it corresponds to an usual ZFC set. -/
-theorem bdd_above_iff_small (s : set cardinal.{u}) : bdd_above s ↔ small.{u} s :=
+theorem bdd_above_iff_small {s : set cardinal.{u}} : bdd_above s ↔ small.{u} s :=
 ⟨λ ⟨a, ha⟩, @small_subset _ (Iic a) s (λ x h, ha h) _, begin
   rintro ⟨ι, ⟨e⟩⟩,
   suffices : range (λ x : ι, (e.symm x).1) = s,
@@ -666,38 +683,52 @@ theorem bdd_above_iff_small (s : set cardinal.{u}) : bdd_above s ↔ small.{u} s
   { simp_rw [subtype.val_eq_coe, equiv.symm_apply_apply], refl }
 end⟩
 
-/-- The indexed supremum of cardinals is the smallest cardinal above
-  everything in the family. -/
-def sup {ι : Type u} (f : ι → cardinal.{max u v}) : cardinal :=
-Sup (set.range f)
+theorem bdd_above_of_small (s : set cardinal.{u}) [h : small.{u} s] : bdd_above s :=
+bdd_above_iff_small.2 h
 
-theorem le_sup {ι} (f : ι → cardinal.{max u v}) (i) : f i ≤ sup f :=
-le_cSup (bdd_above_range f) (mem_range_self i)
+theorem bdd_above_image (f : cardinal.{u} → cardinal.{max u v}) {s : set cardinal.{u}}
+  (hs : bdd_above s) : bdd_above (f '' s) :=
+by { rw bdd_above_iff_small at hs ⊢, exactI small_lift _ }
 
-theorem sup_le_iff {ι} {f : ι → cardinal} {a} : sup f ≤ a ↔ ∀ i, f i ≤ a :=
-(cSup_le_iff' (bdd_above_range f)).trans (by simp)
+theorem bdd_above_range_comp {ι : Type u} {f : ι → cardinal.{v}} (hf : bdd_above (range f))
+  (g : cardinal.{v} → cardinal.{max v w}) : bdd_above (range (g ∘ f)) :=
+by { rw range_comp, exact bdd_above_image g hf }
 
-theorem sup_le {ι} {f : ι → cardinal} {a} : (∀ i, f i ≤ a) → sup f ≤ a :=
-sup_le_iff.2
+theorem supr_le_sum {ι} (f : ι → cardinal) : supr f ≤ sum f :=
+csupr_le' $ le_sum _
 
-theorem sup_le_sup {ι} (f g : ι → cardinal) (H : ∀ i, f i ≤ g i) : sup f ≤ sup g :=
-sup_le $ λ i, le_trans (H i) (le_sup _ _)
-
-theorem sup_le_sum {ι} (f : ι → cardinal) : sup f ≤ sum f :=
-sup_le $ le_sum _
+theorem sum_le_supr_lift {ι : Type u} (f : ι → cardinal.{max u v}) :
+  sum f ≤ (#ι).lift * supr f :=
+begin
+  rw [←(supr f).lift_id, ←lift_umax, lift_umax.{(max u v) u}, ←sum_const],
+  exact sum_le_sum _ _ (le_csupr $ bdd_above_range.{u v} f)
+end
 
-theorem sum_le_sup {ι : Type u} (f : ι → cardinal.{u}) : sum f ≤ #ι * sup.{u u} f :=
-by rw ← sum_const'; exact sum_le_sum _ _ (le_sup _)
+theorem sum_le_supr {ι : Type u} (f : ι → cardinal.{u}) : sum f ≤ #ι * supr f :=
+by { rw ←lift_id (#ι), exact sum_le_supr_lift f }
 
-theorem sum_le_sup_lift {ι : Type u} (f : ι → cardinal.{max u v}) :
-  sum f ≤ (#ι).lift * sup.{u v} f :=
+theorem sum_nat_eq_add_sum_succ (f : ℕ → cardinal.{u}) :
+  cardinal.sum f = f 0 + cardinal.sum (λ i, f (i + 1)) :=
 begin
-  rw [←(sup f).lift_id, ←lift_umax, lift_umax.{(max u v) u}, ←sum_const],
-  exact sum_le_sum _ _ (le_sup _)
+  refine (equiv.sigma_nat_succ (λ i, quotient.out (f i))).cardinal_eq.trans _,
+  simp only [mk_sum, mk_out, lift_id, mk_sigma],
 end
 
-theorem sup_eq_zero {ι} {f : ι → cardinal} [is_empty ι] : sup f = 0 :=
-by { rw ←nonpos_iff_eq_zero, exact sup_le is_empty_elim }
+/-- A variant of `csupr_of_empty` but with `0` on the RHS for convenience -/
+@[simp] protected theorem supr_of_empty {ι} (f : ι → cardinal) [is_empty ι] : supr f = 0 :=
+csupr_of_empty f
+
+@[simp] lemma lift_mk_shrink (α : Type u) [small.{v} α] :
+  cardinal.lift.{max u w} (# (shrink.{v} α)) = cardinal.lift.{max v w} (# α) :=
+lift_mk_eq.2 ⟨(equiv_shrink α).symm⟩
+
+@[simp] lemma lift_mk_shrink' (α : Type u) [small.{v} α] :
+  cardinal.lift.{u} (# (shrink.{v} α)) = cardinal.lift.{v} (# α) :=
+lift_mk_shrink.{u v 0} α
+
+@[simp] lemma lift_mk_shrink'' (α : Type (max u v)) [small.{v} α] :
+  cardinal.lift.{u} (# (shrink.{v} α)) = # α :=
+by rw [← lift_umax', lift_mk_shrink.{(max u v) v 0} α, ← lift_umax, lift_id]
 
 /-- The indexed product of cardinals is the cardinality of the Pi type
   (dependent product). -/
@@ -732,12 +763,32 @@ begin
   exact mk_congr (equiv.ulift.trans $ equiv.Pi_congr_right $ λ i, equiv.ulift.symm)
 end
 
-@[simp] theorem lift_min {ι I} (f : ι → cardinal) :
-  lift (cardinal.min I f) = cardinal.min I (lift ∘ f) :=
-le_antisymm (le_min.2 $ λ a, lift_le.2 $ min_le _ a) $
-let ⟨i, e⟩ := min_eq I (lift ∘ f) in
-by rw e; exact lift_le.2 (le_min.2 $ λ j, lift_le.1 $
-by have := min_le (lift ∘ f) j; rwa e at this)
+lemma prod_eq_of_fintype {α : Type u} [fintype α] (f : α → cardinal.{v}) :
+  prod f = cardinal.lift.{u} (∏ i, f i) :=
+begin
+  revert f,
+  refine fintype.induction_empty_option _ _ _ α,
+  { introsI α β hβ e h f,
+    letI := fintype.of_equiv β e.symm,
+    rw [←e.prod_comp f, ←h],
+    exact mk_congr (e.Pi_congr_left _).symm },
+  { intro f,
+    rw [fintype.univ_pempty, finset.prod_empty, lift_one, cardinal.prod, mk_eq_one] },
+  { intros α hα h f,
+    rw [cardinal.prod, mk_congr equiv.pi_option_equiv_prod, mk_prod, lift_umax', mk_out,
+        ←cardinal.prod, lift_prod, fintype.prod_option, lift_mul, ←h (λ a, f (some a))],
+    simp only [lift_id] },
+end
+
+@[simp] theorem lift_Inf (s : set cardinal) : lift (Inf s) = Inf (lift '' s) :=
+begin
+  rcases eq_empty_or_nonempty s with rfl | hs,
+  { simp },
+  { exact lift_monotone.map_Inf hs }
+end
+
+@[simp] theorem lift_infi {ι} (f : ι → cardinal) : lift (infi f) = ⨅ i, lift (f i) :=
+by { unfold infi, convert lift_Inf (range f), rw range_comp }
 
 theorem lift_down {a : cardinal.{u}} {b : cardinal.{max u v}} :
   b ≤ lift a → ∃ a', lift a' = b :=
@@ -755,66 +806,55 @@ theorem le_lift_iff {a : cardinal.{u}} {b : cardinal.{max u v}} :
 
 theorem lt_lift_iff {a : cardinal.{u}} {b : cardinal.{max u v}} :
   b < lift a ↔ ∃ a', lift a' = b ∧ a' < a :=
-⟨λ h, let ⟨a', e⟩ := lift_down (le_of_lt h) in
-      ⟨a', e, lift_lt.1 $ e.symm ▸ h⟩,
+⟨λ h, let ⟨a', e⟩ := lift_down h.le in ⟨a', e, lift_lt.1 $ e.symm ▸ h⟩,
  λ ⟨a', e, h⟩, e ▸ lift_lt.2 h⟩
 
 @[simp] theorem lift_succ (a) : lift (succ a) = succ (lift a) :=
 le_antisymm
   (le_of_not_gt $ λ h, begin
     rcases lt_lift_iff.1 h with ⟨b, e, h⟩,
-    rw [lt_succ, ← lift_le, e] at h,
-    exact not_lt_of_le h (lt_succ_self _)
+    rw [lt_succ_iff, ← lift_le, e] at h,
+    exact h.not_lt (lt_succ _)
   end)
-  (succ_le.2 $ lift_lt.2 $ lt_succ_self _)
-
-@[simp] theorem lift_max {a : cardinal.{u}} {b : cardinal.{v}} :
-  lift.{(max v w)} a = lift.{(max u w)} b ↔ lift.{v} a = lift.{u} b :=
-calc lift.{(max v w)} a = lift.{(max u w)} b
-  ↔ lift.{w} (lift.{v} a) = lift.{w} (lift.{u} b) : by simp
-  ... ↔ lift.{v} a = lift.{u} b : lift_inj
+  (succ_le_of_lt $ lift_lt.2 $ lt_succ a)
 
-@[simp] theorem lift_min' {a b : cardinal} : lift (min a b) = min (lift a) (lift b) :=
-begin
-  cases le_total a b,
-  { rw [min_eq_left h, min_eq_left (lift_le.2 h)] },
-  { rw [min_eq_right h, min_eq_right (lift_le.2 h)] }
-end
+@[simp] theorem lift_umax_eq {a : cardinal.{u}} {b : cardinal.{v}} :
+  lift.{max v w} a = lift.{max u w} b ↔ lift.{v} a = lift.{u} b :=
+by rw [←lift_lift, ←lift_lift, lift_inj]
 
-@[simp] theorem lift_max' {a b : cardinal} : lift (max a b) = max (lift a) (lift b) :=
-begin
-  cases le_total a b,
-  { rw [max_eq_right h, max_eq_right (lift_le.2 h)] },
-  { rw [max_eq_left h, max_eq_left (lift_le.2 h)] }
-end
+@[simp] theorem lift_min {a b : cardinal} : lift (min a b) = min (lift a) (lift b) :=
+lift_monotone.map_min
 
-protected lemma le_sup_iff {ι : Type v} {f : ι → cardinal.{max v w}} {c : cardinal} :
-  (c ≤ sup f) ↔ (∀ b, (∀ i, f i ≤ b) → c ≤ b) :=
-⟨λ h b hb, le_trans h (sup_le hb), λ h, h _ $ le_sup f⟩
+@[simp] theorem lift_max {a b : cardinal} : lift (max a b) = max (lift a) (lift b) :=
+lift_monotone.map_max
 
 /-- The lift of a supremum is the supremum of the lifts. -/
-lemma lift_sup {ι : Type v} (f : ι → cardinal.{max v w}) :
-  lift.{u} (sup.{v w} f) = sup.{v (max u w)} (λ i : ι, lift.{u} (f i)) :=
+lemma lift_Sup {s : set cardinal} (hs : bdd_above s) : lift.{u} (Sup s) = Sup (lift.{u} '' s) :=
 begin
-  apply le_antisymm,
-  { rw [cardinal.le_sup_iff], intros c hc, by_contra h,
-    obtain ⟨d, rfl⟩ := cardinal.lift_down (not_le.mp h).le,
-    simp only [lift_le, sup_le_iff] at h hc,
-    exact h hc },
-  { simp only [cardinal.sup_le, lift_le, le_sup, implies_true_iff] }
+  apply ((le_cSup_iff' (bdd_above_image _ hs)).2 (λ c hc, _)).antisymm (cSup_le' _),
+  { by_contra h,
+    obtain ⟨d, rfl⟩ := cardinal.lift_down (not_le.1 h).le,
+    simp_rw lift_le at h hc,
+    rw cSup_le_iff' hs at h,
+    exact h (λ a ha, lift_le.1 $ hc (mem_image_of_mem _ ha)) },
+  { rintros i ⟨j, hj, rfl⟩,
+    exact lift_le.2 (le_cSup hs hj) },
 end
 
+/-- The lift of a supremum is the supremum of the lifts. -/
+lemma lift_supr {ι : Type v} {f : ι → cardinal.{w}} (hf : bdd_above (range f)) :
+  lift.{u} (supr f) = ⨆ i, lift.{u} (f i) :=
+by rw [supr, supr, lift_Sup hf, ←range_comp]
+
 /-- To prove that the lift of a supremum is bounded by some cardinal `t`,
 it suffices to show that the lift of each cardinal is bounded by `t`. -/
-lemma lift_sup_le {ι : Type v} (f : ι → cardinal.{max v w})
-  (t : cardinal.{max u v w}) (w : ∀ i, lift.{u} (f i) ≤ t) :
-  lift.{u} (sup f) ≤ t :=
-by { rw lift_sup, exact sup_le w }
+lemma lift_supr_le {ι : Type v} {f : ι → cardinal.{w}} {t : cardinal} (hf : bdd_above (range f))
+  (w : ∀ i, lift.{u} (f i) ≤ t) : lift.{u} (supr f) ≤ t :=
+by { rw lift_supr hf, exact csupr_le' w }
 
-@[simp] lemma lift_sup_le_iff {ι : Type v} (f : ι → cardinal.{max v w}) (t : cardinal.{max u v w}) :
-  lift.{u} (sup f) ≤ t ↔ ∀ i, lift.{u} (f i) ≤ t :=
-⟨λ h i, (lift_le.mpr (le_sup f i)).trans h,
- λ h, lift_sup_le f t h⟩
+@[simp] lemma lift_supr_le_iff {ι : Type v} {f : ι → cardinal.{w}} (hf : bdd_above (range f))
+  {t : cardinal} : lift.{u} (supr f) ≤ t ↔ ∀ i, lift.{u} (f i) ≤ t :=
+by { rw lift_supr hf, exact csupr_le_iff' (bdd_above_range_comp hf _) }
 
 universes v' w'
 
@@ -823,45 +863,50 @@ To prove an inequality between the lifts to a common universe of two different s
 it suffices to show that the lift of each cardinal from the smaller supremum
 if bounded by the lift of some cardinal from the larger supremum.
 -/
-lemma lift_sup_le_lift_sup
-  {ι : Type v} {ι' : Type v'} (f : ι → cardinal.{max v w}) (f' : ι' → cardinal.{max v' w'})
-  (g : ι → ι') (h : ∀ i, lift.{(max v' w')} (f i) ≤ lift.{(max v w)} (f' (g i))) :
-  lift.{(max v' w')} (sup f) ≤ lift.{(max v w)} (sup f') :=
+lemma lift_supr_le_lift_supr
+  {ι : Type v} {ι' : Type v'} {f : ι → cardinal.{w}} {f' : ι' → cardinal.{w'}}
+  (hf : bdd_above (range f)) (hf' : bdd_above (range f'))
+  {g : ι → ι'} (h : ∀ i, lift.{w'} (f i) ≤ lift.{w} (f' (g i))) :
+  lift.{w'} (supr f) ≤ lift.{w} (supr f') :=
 begin
-  apply lift_sup_le.{(max v' w')} f,
-  intro i,
-  apply le_trans (h i),
-  simp only [lift_le],
-  apply le_sup,
+  rw [lift_supr hf, lift_supr hf'],
+  exact csupr_mono' (bdd_above_range_comp hf' _) (λ i, ⟨_, h i⟩)
 end
 
-/-- A variant of `lift_sup_le_lift_sup` with universes specialized via `w = v` and `w' = v'`.
+/-- A variant of `lift_supr_le_lift_supr` with universes specialized via `w = v` and `w' = v'`.
 This is sometimes necessary to avoid universe unification issues. -/
-lemma lift_sup_le_lift_sup'
-  {ι : Type v} {ι' : Type v'} (f : ι → cardinal.{v}) (f' : ι' → cardinal.{v'})
+lemma lift_supr_le_lift_supr'
+  {ι : Type v} {ι' : Type v'} {f : ι → cardinal.{v}} {f' : ι' → cardinal.{v'}}
+  (hf : bdd_above (range f)) (hf' : bdd_above (range f'))
   (g : ι → ι') (h : ∀ i, lift.{v'} (f i) ≤ lift.{v} (f' (g i))) :
-  lift.{v'} (sup.{v v} f) ≤ lift.{v} (sup.{v' v'} f') :=
-lift_sup_le_lift_sup f f' g h
+  lift.{v'} (supr f) ≤ lift.{v} (supr f') :=
+lift_supr_le_lift_supr hf hf' h
+
+/-- `ℵ₀` is the smallest infinite cardinal. -/
+def aleph_0 : cardinal.{u} := lift (#ℕ)
+
+localized "notation (name := cardinal.aleph_0) `ℵ₀` := cardinal.aleph_0" in cardinal
 
-/-- `ω` is the smallest infinite cardinal, also known as ℵ₀. -/
-def omega : cardinal.{u} := lift (#ℕ)
+lemma mk_nat : #ℕ = ℵ₀ := (lift_id _).symm
 
-localized "notation `ω` := cardinal.omega" in cardinal
+theorem aleph_0_ne_zero : ℵ₀ ≠ 0 := mk_ne_zero _
 
-lemma mk_nat : #ℕ = ω := (lift_id _).symm
+theorem aleph_0_pos : 0 < ℵ₀ :=
+pos_iff_ne_zero.2 aleph_0_ne_zero
 
-theorem omega_ne_zero : ω ≠ 0 := mk_ne_zero _
+@[simp] theorem lift_aleph_0 : lift ℵ₀ = ℵ₀ := lift_lift _
 
-theorem omega_pos : 0 < ω :=
-pos_iff_ne_zero.2 omega_ne_zero
+@[simp] theorem aleph_0_le_lift {c : cardinal.{u}} : ℵ₀ ≤ lift.{v} c ↔ ℵ₀ ≤ c :=
+by rw [←lift_aleph_0, lift_le]
 
-@[simp] theorem lift_omega : lift ω = ω := lift_lift _
+@[simp] theorem lift_le_aleph_0 {c : cardinal.{u}} : lift.{v} c ≤ ℵ₀ ↔ c ≤ ℵ₀ :=
+by rw [←lift_aleph_0, lift_le]
 
-@[simp] theorem omega_le_lift {c : cardinal.{u}} : ω ≤ lift.{v} c ↔ ω ≤ c :=
-by rw [← lift_omega, lift_le]
+@[simp] theorem aleph_0_lt_lift {c : cardinal.{u}} : ℵ₀ < lift.{v} c ↔ ℵ₀ < c :=
+by rw [←lift_aleph_0, lift_lt]
 
-@[simp] theorem lift_le_omega {c : cardinal.{u}} : lift.{v} c ≤ ω ↔ c ≤ ω :=
-by rw [← lift_omega, lift_le]
+@[simp] theorem lift_lt_aleph_0 {c : cardinal.{u}} : lift.{v} c < ℵ₀ ↔ c < ℵ₀ :=
+by rw [←lift_aleph_0, lift_lt]
 
 /-! ### Properties about the cast from `ℕ` -/
 
@@ -875,30 +920,48 @@ lift_injective.eq_iff' (lift_nat_cast n)
 
 @[simp] lemma nat_eq_lift_iff {n : ℕ} {a : cardinal.{u}} :
   (n : cardinal) = lift.{v} a ↔ (n : cardinal) = a :=
-by rw [← lift_nat_cast.{v} n, lift_inj]
+by rw [←lift_nat_cast.{v} n, lift_inj]
+
+@[simp] lemma lift_le_nat_iff {a : cardinal.{u}} {n : ℕ} : lift.{v} a ≤ n ↔ a ≤ n :=
+by simp only [←lift_nat_cast, lift_le]
+
+@[simp] lemma nat_le_lift_iff {n : ℕ} {a : cardinal.{u}} :
+  (n : cardinal) ≤ lift.{v} a ↔ (n : cardinal) ≤ a :=
+by simp only [←lift_nat_cast, lift_le]
+
+@[simp] lemma lift_lt_nat_iff {a : cardinal.{u}} {n : ℕ} : lift.{v} a < n ↔ a < n :=
+by simp only [←lift_nat_cast, lift_lt]
+
+@[simp] lemma nat_lt_lift_iff {n : ℕ} {a : cardinal.{u}} :
+  (n : cardinal) < lift.{v} a ↔ (n : cardinal) < a :=
+by simp only [←lift_nat_cast, lift_lt]
 
 theorem lift_mk_fin (n : ℕ) : lift (#(fin n)) = n := by simp
 
-lemma mk_finset {α : Type u} {s : finset α} : #s = ↑(finset.card s) := by simp
+lemma mk_coe_finset {α : Type u} {s : finset α} : #s = ↑(finset.card s) := by simp
 
-theorem card_le_of_finset {α} (s : finset α) :
-  (s.card : cardinal) ≤ #α :=
-begin
-  rw (_ : (s.card : cardinal) = #s),
-  { exact ⟨function.embedding.subtype _⟩ },
-  rw [cardinal.mk_fintype, fintype.card_coe]
-end
+lemma mk_finset_of_fintype [fintype α] : #(finset α) = 2 ^ℕ fintype.card α := by simp
+
+@[simp] lemma mk_finsupp_lift_of_fintype (α : Type u) (β : Type v) [fintype α] [has_zero β] :
+  #(α →₀ β) = lift.{u} (#β) ^ℕ fintype.card α :=
+by simpa using (@finsupp.equiv_fun_on_finite α β _ _).cardinal_eq
+
+lemma mk_finsupp_of_fintype (α β : Type u) [fintype α] [has_zero β] :
+  #(α →₀ β) = (#β) ^ℕ fintype.card α :=
+by simp
+
+theorem card_le_of_finset {α} (s : finset α) : (s.card : cardinal) ≤ #α :=
+@mk_coe_finset _ s ▸ mk_set_le _
 
 @[simp, norm_cast] theorem nat_cast_pow {m n : ℕ} : (↑(pow m n) : cardinal) = m ^ n :=
 by induction n; simp [pow_succ', power_add, *]
 
 @[simp, norm_cast] theorem nat_cast_le {m n : ℕ} : (m : cardinal) ≤ n ↔ m ≤ n :=
-by rw [← lift_mk_fin, ← lift_mk_fin, lift_le]; exact
-⟨λ ⟨⟨f, hf⟩⟩, by simpa only [fintype.card_fin] using fintype.card_le_of_injective f hf,
-  λ h, ⟨(fin.cast_le h).to_embedding⟩⟩
+by rw [← lift_mk_fin, ← lift_mk_fin, lift_le, le_def, function.embedding.nonempty_iff_card_le,
+  fintype.card_fin, fintype.card_fin]
 
 @[simp, norm_cast] theorem nat_cast_lt {m n : ℕ} : (m : cardinal) < n ↔ m < n :=
-by simp [lt_iff_le_not_le, -not_le]
+by simp [lt_iff_le_not_le, ←not_le]
 
 instance : char_zero cardinal := ⟨strict_mono.injective $ λ m n, nat_cast_lt.2⟩
 
@@ -908,223 +971,274 @@ lemma nat_cast_injective : injective (coe : ℕ → cardinal) :=
 nat.cast_injective
 
 @[simp, norm_cast, priority 900] theorem nat_succ (n : ℕ) : (n.succ : cardinal) = succ n :=
-le_antisymm (add_one_le_succ _) (succ_le.2 $ nat_cast_lt.2 $ nat.lt_succ_self _)
+(add_one_le_succ _).antisymm (succ_le_of_lt $ nat_cast_lt.2 $ nat.lt_succ_self _)
 
-@[simp] theorem succ_zero : succ 0 = 1 :=
-by norm_cast
+@[simp] theorem succ_zero : succ (0 : cardinal) = 1 := by norm_cast
 
-theorem card_le_of {α : Type u} {n : ℕ} (H : ∀ s : finset α, s.card ≤ n) :
-  # α ≤ n :=
+theorem card_le_of {α : Type u} {n : ℕ} (H : ∀ s : finset α, s.card ≤ n) : # α ≤ n :=
 begin
-  refine lt_succ.1 (lt_of_not_ge $ λ hn, _),
-  rw [← cardinal.nat_succ, ← cardinal.lift_mk_fin n.succ] at hn,
+  refine le_of_lt_succ (lt_of_not_ge $ λ hn, _),
+  rw [←cardinal.nat_succ, ←lift_mk_fin n.succ] at hn,
   cases hn with f,
-  refine not_lt_of_le (H $ finset.univ.map f) _,
-  rw [finset.card_map, ← fintype.card, fintype.card_ulift, fintype.card_fin],
+  refine (H $ finset.univ.map f).not_lt _,
+  rw [finset.card_map, ←fintype.card, fintype.card_ulift, fintype.card_fin],
   exact n.lt_succ_self
 end
 
 theorem cantor' (a) {b : cardinal} (hb : 1 < b) : a < b ^ a :=
-by rw [← succ_le, (by norm_cast : succ 1 = 2)] at hb;
-   exact lt_of_lt_of_le (cantor _) (power_le_power_right hb)
+begin
+  rw [←succ_le_iff, (by norm_cast : succ (1 : cardinal) = 2)] at hb,
+  exact (cantor a).trans_le (power_le_power_right hb)
+end
 
 theorem one_le_iff_pos {c : cardinal} : 1 ≤ c ↔ 0 < c :=
-by rw [← succ_zero, succ_le]
+by rw [←succ_zero, succ_le_iff]
 
 theorem one_le_iff_ne_zero {c : cardinal} : 1 ≤ c ↔ c ≠ 0 :=
 by rw [one_le_iff_pos, pos_iff_ne_zero]
 
-theorem nat_lt_omega (n : ℕ) : (n : cardinal.{u}) < ω :=
-succ_le.1 $ by rw [← nat_succ, ← lift_mk_fin, omega, lift_mk_le.{0 0 u}]; exact
-⟨⟨coe, λ a b, fin.ext⟩⟩
+theorem nat_lt_aleph_0 (n : ℕ) : (n : cardinal.{u}) < ℵ₀ :=
+succ_le_iff.1 begin
+  rw [←nat_succ, ←lift_mk_fin, aleph_0, lift_mk_le.{0 0 u}],
+  exact ⟨⟨coe, λ a b, fin.ext⟩⟩
+end
+
+@[simp] theorem one_lt_aleph_0 : 1 < ℵ₀ := by simpa using nat_lt_aleph_0 1
 
-@[simp] theorem one_lt_omega : 1 < ω :=
-by simpa using nat_lt_omega 1
+theorem one_le_aleph_0 : 1 ≤ ℵ₀ := one_lt_aleph_0.le
 
-theorem lt_omega {c : cardinal.{u}} : c < ω ↔ ∃ n : ℕ, c = n :=
+theorem lt_aleph_0 {c : cardinal} : c < ℵ₀ ↔ ∃ n : ℕ, c = n :=
 ⟨λ h, begin
   rcases lt_lift_iff.1 h with ⟨c, rfl, h'⟩,
   rcases le_mk_iff_exists_set.1 h'.1 with ⟨S, rfl⟩,
-  suffices : finite S,
+  suffices : S.finite,
   { lift S to finset ℕ using this,
     simp },
   contrapose! h',
   haveI := infinite.to_subtype h',
   exact ⟨infinite.nat_embedding S⟩
-end, λ ⟨n, e⟩, e.symm ▸ nat_lt_omega _⟩
+end, λ ⟨n, e⟩, e.symm ▸ nat_lt_aleph_0 _⟩
 
-theorem omega_le {c : cardinal.{u}} : ω ≤ c ↔ ∀ n : ℕ, (n:cardinal) ≤ c :=
-⟨λ h n, le_trans (le_of_lt (nat_lt_omega _)) h,
+theorem aleph_0_le {c : cardinal} : ℵ₀ ≤ c ↔ ∀ n : ℕ, ↑n ≤ c :=
+⟨λ h n, (nat_lt_aleph_0 _).le.trans h,
  λ h, le_of_not_lt $ λ hn, begin
-  rcases lt_omega.1 hn with ⟨n, rfl⟩,
-  exact not_le_of_lt (nat.lt_succ_self _) (nat_cast_le.1 (h (n+1)))
+  rcases lt_aleph_0.1 hn with ⟨n, rfl⟩,
+  exact (nat.lt_succ_self _).not_le (nat_cast_le.1 (h (n+1)))
 end⟩
 
-theorem lt_omega_iff_fintype {α : Type u} : #α < ω ↔ nonempty (fintype α) :=
-lt_omega.trans ⟨λ ⟨n, e⟩, begin
-  rw [← lift_mk_fin n] at e,
-  cases quotient.exact e with f,
-  exact ⟨fintype.of_equiv _ f.symm⟩
-end, λ ⟨_⟩, by exactI ⟨_, mk_fintype _⟩⟩
+theorem is_succ_limit_aleph_0 : is_succ_limit ℵ₀ :=
+is_succ_limit_of_succ_lt $ λ a ha, begin
+  rcases lt_aleph_0.1 ha with ⟨n, rfl⟩,
+  rw ←nat_succ,
+  apply nat_lt_aleph_0
+end
+
+theorem is_limit_aleph_0 : is_limit ℵ₀ := ⟨aleph_0_ne_zero, is_succ_limit_aleph_0⟩
+
+theorem is_limit.aleph_0_le {c : cardinal} (h : is_limit c) : ℵ₀ ≤ c :=
+begin
+  by_contra' h',
+  rcases lt_aleph_0.1 h' with ⟨_ | n, rfl⟩,
+  { exact h.ne_zero.irrefl },
+  { rw nat_succ at h,
+    exact not_is_succ_limit_succ _ h.is_succ_limit }
+end
+
+@[simp] lemma range_nat_cast : range (coe : ℕ → cardinal) = Iio ℵ₀ :=
+ext $ λ x, by simp only [mem_Iio, mem_range, eq_comm, lt_aleph_0]
+
+theorem mk_eq_nat_iff {α : Type u} {n : ℕ} : #α = n ↔ nonempty (α ≃ fin n) :=
+by rw [← lift_mk_fin, ← lift_uzero (#α), lift_mk_eq']
+
+theorem lt_aleph_0_iff_finite {α : Type u} : #α < ℵ₀ ↔ finite α :=
+by simp only [lt_aleph_0, mk_eq_nat_iff, finite_iff_exists_equiv_fin]
+
+theorem lt_aleph_0_iff_fintype {α : Type u} : #α < ℵ₀ ↔ nonempty (fintype α) :=
+lt_aleph_0_iff_finite.trans (finite_iff_nonempty_fintype _)
+
+theorem lt_aleph_0_of_finite (α : Type u) [finite α] : #α < ℵ₀ :=
+lt_aleph_0_iff_finite.2 ‹_›
+
+@[simp] theorem lt_aleph_0_iff_set_finite {S : set α} : #S < ℵ₀ ↔ S.finite :=
+lt_aleph_0_iff_finite.trans finite_coe_iff
 
-theorem lt_omega_of_fintype (α : Type u) [fintype α] : #α < ω :=
-lt_omega_iff_fintype.2 ⟨infer_instance⟩
+alias lt_aleph_0_iff_set_finite ↔ _ _root_.set.finite.lt_aleph_0
 
-theorem lt_omega_iff_finite {α} {S : set α} : #S < ω ↔ finite S :=
-lt_omega_iff_fintype.trans finite_def.symm
+@[simp] theorem lt_aleph_0_iff_subtype_finite {p : α → Prop} :
+  #{x // p x} < ℵ₀ ↔ {x | p x}.finite :=
+lt_aleph_0_iff_set_finite
 
-instance can_lift_cardinal_nat : can_lift cardinal ℕ :=
-⟨ coe, λ x, x < ω, λ x hx, let ⟨n, hn⟩ := lt_omega.mp hx in ⟨n, hn.symm⟩⟩
+lemma mk_le_aleph_0_iff : #α ≤ ℵ₀ ↔ countable α :=
+by rw [countable_iff_nonempty_embedding, aleph_0, ← lift_uzero (#α), lift_mk_le']
 
-theorem add_lt_omega {a b : cardinal} (ha : a < ω) (hb : b < ω) : a + b < ω :=
-match a, b, lt_omega.1 ha, lt_omega.1 hb with
-| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat.cast_add]; apply nat_lt_omega
+@[simp] lemma mk_le_aleph_0 [countable α] : #α ≤ ℵ₀ := mk_le_aleph_0_iff.mpr ‹_›
+
+@[simp] lemma le_aleph_0_iff_set_countable {s : set α} : #s ≤ ℵ₀ ↔ s.countable :=
+by rw [mk_le_aleph_0_iff, countable_coe_iff]
+
+alias le_aleph_0_iff_set_countable ↔ _ _root_.set.countable.le_aleph_0
+
+@[simp] lemma le_aleph_0_iff_subtype_countable {p : α → Prop} :
+  #{x // p x} ≤ ℵ₀ ↔ {x | p x}.countable :=
+le_aleph_0_iff_set_countable
+
+instance can_lift_cardinal_nat : can_lift cardinal ℕ coe (λ x, x < ℵ₀) :=
+⟨λ x hx, let ⟨n, hn⟩ := lt_aleph_0.mp hx in ⟨n, hn.symm⟩⟩
+
+theorem add_lt_aleph_0 {a b : cardinal} (ha : a < ℵ₀) (hb : b < ℵ₀) : a + b < ℵ₀ :=
+match a, b, lt_aleph_0.1 ha, lt_aleph_0.1 hb with
+| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat.cast_add]; apply nat_lt_aleph_0
 end
 
-lemma add_lt_omega_iff {a b : cardinal} : a + b < ω ↔ a < ω ∧ b < ω :=
-⟨λ h, ⟨lt_of_le_of_lt (self_le_add_right _ _) h, lt_of_le_of_lt (self_le_add_left _ _) h⟩,
-  λ⟨h1, h2⟩, add_lt_omega h1 h2⟩
+lemma add_lt_aleph_0_iff {a b : cardinal} : a + b < ℵ₀ ↔ a < ℵ₀ ∧ b < ℵ₀ :=
+⟨λ h, ⟨(self_le_add_right _ _).trans_lt h, (self_le_add_left _ _).trans_lt h⟩,
+  λ ⟨h1, h2⟩, add_lt_aleph_0 h1 h2⟩
 
-lemma omega_le_add_iff {a b : cardinal} : ω ≤ a + b ↔ ω ≤ a ∨ ω ≤ b :=
-by simp only [← not_lt, add_lt_omega_iff, not_and_distrib]
+lemma aleph_0_le_add_iff {a b : cardinal} : ℵ₀ ≤ a + b ↔ ℵ₀ ≤ a ∨ ℵ₀ ≤ b :=
+by simp only [←not_lt, add_lt_aleph_0_iff, not_and_distrib]
 
-/-- See also `cardinal.nsmul_lt_omega_iff_of_ne_zero` if you already have `n ≠ 0`. -/
-lemma nsmul_lt_omega_iff {n : ℕ} {a : cardinal} : n • a < ω ↔ n = 0 ∨ a < ω :=
+/-- See also `cardinal.nsmul_lt_aleph_0_iff_of_ne_zero` if you already have `n ≠ 0`. -/
+lemma nsmul_lt_aleph_0_iff {n : ℕ} {a : cardinal} : n • a < ℵ₀ ↔ n = 0 ∨ a < ℵ₀ :=
 begin
   cases n,
-  { simpa using nat_lt_omega 0 },
+  { simpa using nat_lt_aleph_0 0 },
   simp only [nat.succ_ne_zero, false_or],
   induction n with n ih,
   { simp },
-  rw [succ_nsmul, add_lt_omega_iff, ih, and_self]
+  rw [succ_nsmul, add_lt_aleph_0_iff, ih, and_self]
 end
 
-/-- See also `cardinal.nsmul_lt_omega_iff` for a hypothesis-free version. -/
-lemma nsmul_lt_omega_iff_of_ne_zero {n : ℕ} {a : cardinal} (h : n ≠ 0) : n • a < ω ↔ a < ω :=
-nsmul_lt_omega_iff.trans $ or_iff_right h
+/-- See also `cardinal.nsmul_lt_aleph_0_iff` for a hypothesis-free version. -/
+lemma nsmul_lt_aleph_0_iff_of_ne_zero {n : ℕ} {a : cardinal} (h : n ≠ 0) : n • a < ℵ₀ ↔ a < ℵ₀ :=
+nsmul_lt_aleph_0_iff.trans $ or_iff_right h
 
-theorem mul_lt_omega {a b : cardinal} (ha : a < ω) (hb : b < ω) : a * b < ω :=
-match a, b, lt_omega.1 ha, lt_omega.1 hb with
-| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat.cast_mul]; apply nat_lt_omega
+theorem mul_lt_aleph_0 {a b : cardinal} (ha : a < ℵ₀) (hb : b < ℵ₀) : a * b < ℵ₀ :=
+match a, b, lt_aleph_0.1 ha, lt_aleph_0.1 hb with
+| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat.cast_mul]; apply nat_lt_aleph_0
 end
 
-lemma mul_lt_omega_iff {a b : cardinal} : a * b < ω ↔ a = 0 ∨ b = 0 ∨ a < ω ∧ b < ω :=
+lemma mul_lt_aleph_0_iff {a b : cardinal} : a * b < ℵ₀ ↔ a = 0 ∨ b = 0 ∨ a < ℵ₀ ∧ b < ℵ₀ :=
 begin
-  split,
-  { intro h, by_cases ha : a = 0, { left, exact ha },
-    right, by_cases hb : b = 0, { left, exact hb },
-    right, rw [← ne, ← one_le_iff_ne_zero] at ha hb, split,
-    { rw [← mul_one a],
-      refine lt_of_le_of_lt (mul_le_mul' (le_refl a) hb) h },
-    { rw [← one_mul b],
-      refine lt_of_le_of_lt (mul_le_mul' ha (le_refl b)) h }},
-  rintro (rfl|rfl|⟨ha,hb⟩); simp only [*, mul_lt_omega, omega_pos, zero_mul, mul_zero]
+  refine ⟨λ h, _, _⟩,
+  { by_cases ha : a = 0, { exact or.inl ha },
+    right, by_cases hb : b = 0, { exact or.inl hb },
+    right, rw [←ne, ←one_le_iff_ne_zero] at ha hb, split,
+    { rw ←mul_one a,
+      refine (mul_le_mul' le_rfl hb).trans_lt h },
+    { rw ←one_mul b,
+      refine (mul_le_mul' ha le_rfl).trans_lt h }},
+  rintro (rfl|rfl|⟨ha,hb⟩); simp only [*, mul_lt_aleph_0, aleph_0_pos, zero_mul, mul_zero]
 end
 
-lemma omega_le_mul_iff {a b : cardinal} : ω ≤ a * b ↔ a ≠ 0 ∧ b ≠ 0 ∧ (ω ≤ a ∨ ω ≤ b) :=
-let h := (@mul_lt_omega_iff a b).not in
+/-- See also `cardinal.aleph_0_le_mul_iff`. -/
+lemma aleph_0_le_mul_iff {a b : cardinal} : ℵ₀ ≤ a * b ↔ a ≠ 0 ∧ b ≠ 0 ∧ (ℵ₀ ≤ a ∨ ℵ₀ ≤ b) :=
+let h := (@mul_lt_aleph_0_iff a b).not in
 by rwa [not_lt, not_or_distrib, not_or_distrib, not_and_distrib, not_lt, not_lt] at h
 
-lemma mul_lt_omega_iff_of_ne_zero {a b : cardinal} (ha : a ≠ 0) (hb : b ≠ 0) :
-  a * b < ω ↔ a < ω ∧ b < ω :=
-by simp [mul_lt_omega_iff, ha, hb]
+/-- See also `cardinal.aleph_0_le_mul_iff'`. -/
+lemma aleph_0_le_mul_iff' {a b : cardinal.{u}} : ℵ₀ ≤ a * b ↔ a ≠ 0 ∧ ℵ₀ ≤ b ∨ ℵ₀ ≤ a ∧ b ≠ 0 :=
+begin
+  have : ∀ {a : cardinal.{u}}, ℵ₀ ≤ a → a ≠ 0, from λ a, ne_bot_of_le_ne_bot aleph_0_ne_zero,
+  simp only [aleph_0_le_mul_iff, and_or_distrib_left, and_iff_right_of_imp this,
+    @and.left_comm (a ≠ 0)],
+  simp only [and.comm, or.comm]
+end
 
-theorem power_lt_omega {a b : cardinal} (ha : a < ω) (hb : b < ω) : a ^ b < ω :=
-match a, b, lt_omega.1 ha, lt_omega.1 hb with
-| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat_cast_pow]; apply nat_lt_omega
+lemma mul_lt_aleph_0_iff_of_ne_zero {a b : cardinal} (ha : a ≠ 0) (hb : b ≠ 0) :
+  a * b < ℵ₀ ↔ a < ℵ₀ ∧ b < ℵ₀ :=
+by simp [mul_lt_aleph_0_iff, ha, hb]
+
+theorem power_lt_aleph_0 {a b : cardinal} (ha : a < ℵ₀) (hb : b < ℵ₀) : a ^ b < ℵ₀ :=
+match a, b, lt_aleph_0.1 ha, lt_aleph_0.1 hb with
+| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by rw [← nat_cast_pow]; apply nat_lt_aleph_0
 end
 
 lemma eq_one_iff_unique {α : Type*} :
   #α = 1 ↔ subsingleton α ∧ nonempty α :=
-calc #α = 1 ↔ #α ≤ 1 ∧ ¬#α < 1 : eq_iff_le_not_lt
+calc #α = 1 ↔ #α ≤ 1 ∧ 1 ≤ #α : le_antisymm_iff
         ... ↔ subsingleton α ∧ nonempty α :
-begin
-  apply and_congr le_one_iff_subsingleton,
-  push_neg,
-  rw [one_le_iff_ne_zero, mk_ne_zero_iff]
-end
-
-theorem infinite_iff {α : Type u} : infinite α ↔ ω ≤ #α :=
-by rw [←not_lt, lt_omega_iff_fintype, not_nonempty_iff, is_empty_fintype]
+  le_one_iff_subsingleton.and (one_le_iff_ne_zero.trans mk_ne_zero_iff)
 
-@[simp] lemma omega_le_mk (α : Type u) [infinite α] : ω ≤ #α := infinite_iff.1 ‹_›
+theorem infinite_iff {α : Type u} : infinite α ↔ ℵ₀ ≤ #α :=
+by rw [← not_lt, lt_aleph_0_iff_finite, not_finite_iff_infinite]
 
-lemma encodable_iff {α : Type u} : nonempty (encodable α) ↔ #α ≤ ω :=
-⟨λ ⟨h⟩, ⟨(@encodable.encode' α h).trans equiv.ulift.symm.to_embedding⟩,
-  λ ⟨h⟩, ⟨encodable.of_inj _ (h.trans equiv.ulift.to_embedding).injective⟩⟩
+@[simp] lemma aleph_0_le_mk (α : Type u) [infinite α] : ℵ₀ ≤ #α := infinite_iff.1 ‹_›
 
-@[simp] lemma mk_le_omega [encodable α] : #α ≤ ω := encodable_iff.1 ⟨‹_›⟩
+@[simp] lemma mk_eq_aleph_0 (α : Type*) [countable α] [infinite α] : #α = ℵ₀ :=
+mk_le_aleph_0.antisymm $ aleph_0_le_mk _
 
-lemma denumerable_iff {α : Type u} : nonempty (denumerable α) ↔ #α = ω :=
+lemma denumerable_iff {α : Type u} : nonempty (denumerable α) ↔ #α = ℵ₀ :=
 ⟨λ ⟨h⟩, mk_congr ((@denumerable.eqv α h).trans equiv.ulift.symm),
  λ h, by { cases quotient.exact h with f, exact ⟨denumerable.mk' $ f.trans equiv.ulift⟩ }⟩
 
-@[simp] lemma mk_denumerable (α : Type u) [denumerable α] : #α = ω :=
+@[simp] lemma mk_denumerable (α : Type u) [denumerable α] : #α = ℵ₀ :=
 denumerable_iff.1 ⟨‹_›⟩
 
-@[simp] lemma mk_set_le_omega (s : set α) : #s ≤ ω ↔ countable s :=
-begin
-  rw [countable_iff_exists_injective], split,
-  { rintro ⟨f'⟩, cases embedding.trans f' equiv.ulift.to_embedding with f hf, exact ⟨f, hf⟩ },
-  { rintro ⟨f, hf⟩, exact ⟨embedding.trans ⟨f, hf⟩ equiv.ulift.symm.to_embedding⟩ }
-end
+@[simp] lemma aleph_0_add_aleph_0 : ℵ₀ + ℵ₀ = ℵ₀ := mk_denumerable _
+
+lemma aleph_0_mul_aleph_0 : ℵ₀ * ℵ₀ = ℵ₀ := mk_denumerable _
 
-@[simp] lemma omega_add_omega : ω + ω = ω := mk_denumerable _
+@[simp] lemma nat_mul_aleph_0 {n : ℕ} (hn : n ≠ 0) : ↑n * ℵ₀ = ℵ₀ :=
+le_antisymm (lift_mk_fin n ▸ mk_le_aleph_0) $ le_mul_of_one_le_left (zero_le _) $
+  by rwa [← nat.cast_one, nat_cast_le, nat.one_le_iff_ne_zero]
 
-lemma omega_mul_omega : ω * ω = ω := mk_denumerable _
+@[simp] lemma aleph_0_mul_nat {n : ℕ} (hn : n ≠ 0) : ℵ₀ * n = ℵ₀ :=
+by rw [mul_comm, nat_mul_aleph_0 hn]
 
-@[simp] lemma add_le_omega {c₁ c₂ : cardinal} : c₁ + c₂ ≤ ω ↔ c₁ ≤ ω ∧ c₂ ≤ ω :=
-⟨λ h, ⟨le_self_add.trans h, le_add_self.trans h⟩, λ h, omega_add_omega ▸ add_le_add h.1 h.2⟩
+@[simp] lemma add_le_aleph_0 {c₁ c₂ : cardinal} : c₁ + c₂ ≤ ℵ₀ ↔ c₁ ≤ ℵ₀ ∧ c₂ ≤ ℵ₀ :=
+⟨λ h, ⟨le_self_add.trans h, le_add_self.trans h⟩, λ h, aleph_0_add_aleph_0 ▸ add_le_add h.1 h.2⟩
+
+@[simp] lemma aleph_0_add_nat (n : ℕ) : ℵ₀ + n = ℵ₀ :=
+(add_le_aleph_0.2 ⟨le_rfl, (nat_lt_aleph_0 n).le⟩).antisymm le_self_add
+
+@[simp] lemma nat_add_aleph_0 (n : ℕ) : ↑n + ℵ₀ = ℵ₀ := by rw [add_comm, aleph_0_add_nat]
 
 /-- This function sends finite cardinals to the corresponding natural, and infinite cardinals
   to 0. -/
 def to_nat : zero_hom cardinal ℕ :=
-⟨λ c, if h : c < omega.{v} then classical.some (lt_omega.1 h) else 0,
+⟨λ c, if h : c < aleph_0.{v} then classical.some (lt_aleph_0.1 h) else 0,
   begin
-    have h : 0 < ω := nat_lt_omega 0,
-    rw [dif_pos h, ← cardinal.nat_cast_inj, ← classical.some_spec (lt_omega.1 h), nat.cast_zero],
+    have h : 0 < ℵ₀ := nat_lt_aleph_0 0,
+    rw [dif_pos h, ← cardinal.nat_cast_inj, ← classical.some_spec (lt_aleph_0.1 h), nat.cast_zero],
   end⟩
 
-lemma to_nat_apply_of_lt_omega {c : cardinal} (h : c < ω) :
-  c.to_nat = classical.some (lt_omega.1 h) :=
+lemma to_nat_apply_of_lt_aleph_0 {c : cardinal} (h : c < ℵ₀) :
+  c.to_nat = classical.some (lt_aleph_0.1 h) :=
 dif_pos h
 
-@[simp]
-lemma to_nat_apply_of_omega_le {c : cardinal} (h : ω ≤ c) :
-  c.to_nat = 0 :=
-dif_neg (not_lt_of_le h)
+lemma to_nat_apply_of_aleph_0_le {c : cardinal} (h : ℵ₀ ≤ c) : c.to_nat = 0 :=
+dif_neg h.not_lt
 
-@[simp]
-lemma cast_to_nat_of_lt_omega {c : cardinal} (h : c < ω) :
-  ↑c.to_nat = c :=
-by rw [to_nat_apply_of_lt_omega h, ← classical.some_spec (lt_omega.1 h)]
+lemma cast_to_nat_of_lt_aleph_0 {c : cardinal} (h : c < ℵ₀) : ↑c.to_nat = c :=
+by rw [to_nat_apply_of_lt_aleph_0 h, ← classical.some_spec (lt_aleph_0.1 h)]
 
-@[simp]
-lemma cast_to_nat_of_omega_le {c : cardinal} (h : ω ≤ c) :
-  ↑c.to_nat = (0 : cardinal) :=
-by rw [to_nat_apply_of_omega_le h, nat.cast_zero]
+lemma cast_to_nat_of_aleph_0_le {c : cardinal} (h : ℵ₀ ≤ c) : ↑c.to_nat = (0 : cardinal) :=
+by rw [to_nat_apply_of_aleph_0_le h, nat.cast_zero]
 
-lemma to_nat_le_iff_le_of_lt_omega {c d : cardinal} (hc : c < ω) (hd : d < ω) :
+lemma to_nat_eq_iff_eq_of_lt_aleph_0 {c d : cardinal} (hc : c < ℵ₀) (hd : d < ℵ₀) :
+  c.to_nat = d.to_nat ↔ c = d :=
+by rw [←nat_cast_inj, cast_to_nat_of_lt_aleph_0 hc, cast_to_nat_of_lt_aleph_0 hd]
+
+lemma to_nat_le_iff_le_of_lt_aleph_0 {c d : cardinal} (hc : c < ℵ₀) (hd : d < ℵ₀) :
   c.to_nat ≤ d.to_nat ↔ c ≤ d :=
-by rw [←nat_cast_le, cast_to_nat_of_lt_omega hc, cast_to_nat_of_lt_omega hd]
+by rw [←nat_cast_le, cast_to_nat_of_lt_aleph_0 hc, cast_to_nat_of_lt_aleph_0 hd]
 
-lemma to_nat_lt_iff_lt_of_lt_omega {c d : cardinal} (hc : c < ω) (hd : d < ω) :
+lemma to_nat_lt_iff_lt_of_lt_aleph_0 {c d : cardinal} (hc : c < ℵ₀) (hd : d < ℵ₀) :
   c.to_nat < d.to_nat ↔ c < d :=
-by rw [←nat_cast_lt, cast_to_nat_of_lt_omega hc, cast_to_nat_of_lt_omega hd]
+by rw [←nat_cast_lt, cast_to_nat_of_lt_aleph_0 hc, cast_to_nat_of_lt_aleph_0 hd]
 
-lemma to_nat_le_of_le_of_lt_omega {c d : cardinal} (hd : d < ω) (hcd : c ≤ d) :
+lemma to_nat_le_of_le_of_lt_aleph_0 {c d : cardinal} (hd : d < ℵ₀) (hcd : c ≤ d) :
   c.to_nat ≤ d.to_nat :=
-(to_nat_le_iff_le_of_lt_omega (lt_of_le_of_lt hcd hd) hd).mpr hcd
+(to_nat_le_iff_le_of_lt_aleph_0 (hcd.trans_lt hd) hd).mpr hcd
 
-lemma to_nat_lt_of_lt_of_lt_omega {c d : cardinal} (hd : d < ω) (hcd : c < d) :
+lemma to_nat_lt_of_lt_of_lt_aleph_0 {c d : cardinal} (hd : d < ℵ₀) (hcd : c < d) :
   c.to_nat < d.to_nat :=
-(to_nat_lt_iff_lt_of_lt_omega (hcd.trans hd) hd).mpr hcd
+(to_nat_lt_iff_lt_of_lt_aleph_0 (hcd.trans hd) hd).mpr hcd
 
-@[simp]
-lemma to_nat_cast (n : ℕ) : cardinal.to_nat n = n :=
+@[simp] lemma to_nat_cast (n : ℕ) : cardinal.to_nat n = n :=
 begin
-  rw [to_nat_apply_of_lt_omega (nat_lt_omega n), ← nat_cast_inj],
-  exact (classical.some_spec (lt_omega.1 (nat_lt_omega n))).symm,
+  rw [to_nat_apply_of_lt_aleph_0 (nat_lt_aleph_0 n), ← nat_cast_inj],
+  exact (classical.some_spec (lt_aleph_0.1 (nat_lt_aleph_0 n))).symm,
 end
 
 /-- `to_nat` has a right-inverse: coercion. -/
@@ -1132,24 +1246,31 @@ lemma to_nat_right_inverse : function.right_inverse (coe : ℕ → cardinal) to_
 
 lemma to_nat_surjective : surjective to_nat := to_nat_right_inverse.surjective
 
-@[simp]
-lemma mk_to_nat_of_infinite [h : infinite α] : (#α).to_nat = 0 :=
-dif_neg (not_lt_of_le (infinite_iff.1 h))
+lemma exists_nat_eq_of_le_nat {c : cardinal} {n : ℕ} (h : c ≤ n) : ∃ m, m ≤ n ∧ c = m :=
+let he := cast_to_nat_of_lt_aleph_0 (h.trans_lt $ nat_lt_aleph_0 n) in
+⟨c.to_nat, nat_cast_le.1 (he.trans_le h), he.symm⟩
+
+@[simp] lemma mk_to_nat_of_infinite [h : infinite α] : (#α).to_nat = 0 :=
+dif_neg (infinite_iff.1 h).not_lt
+
+@[simp] theorem aleph_0_to_nat : to_nat ℵ₀ = 0 :=
+to_nat_apply_of_aleph_0_le le_rfl
 
 lemma mk_to_nat_eq_card [fintype α] : (#α).to_nat = fintype.card α := by simp
 
-@[simp]
-lemma zero_to_nat : to_nat 0 = 0 :=
-by rw [← to_nat_cast 0, nat.cast_zero]
+@[simp] lemma zero_to_nat : to_nat 0 = 0 :=
+by rw [←to_nat_cast 0, nat.cast_zero]
+
+@[simp] lemma one_to_nat : to_nat 1 = 1 :=
+by rw [←to_nat_cast 1, nat.cast_one]
 
-@[simp]
-lemma one_to_nat : to_nat 1 = 1 :=
-by rw [← to_nat_cast 1, nat.cast_one]
+lemma to_nat_eq_iff {c : cardinal} {n : ℕ} (hn : n ≠ 0) : to_nat c = n ↔ c = n :=
+⟨λ h, (cast_to_nat_of_lt_aleph_0 (lt_of_not_ge (hn ∘ h.symm.trans ∘
+  to_nat_apply_of_aleph_0_le))).symm.trans (congr_arg coe h),
+  λ h, (congr_arg to_nat h).trans (to_nat_cast n)⟩
 
 @[simp] lemma to_nat_eq_one {c : cardinal} : to_nat c = 1 ↔ c = 1 :=
-⟨λ h, (cast_to_nat_of_lt_omega (lt_of_not_ge (one_ne_zero ∘ h.symm.trans ∘
-  to_nat_apply_of_omega_le))).symm.trans ((congr_arg coe h).trans nat.cast_one),
-  λ h, (congr_arg to_nat h).trans one_to_nat⟩
+by rw [to_nat_eq_iff one_ne_zero, nat.cast_one]
 
 lemma to_nat_eq_one_iff_unique {α : Type*} : (#α).to_nat = 1 ↔ subsingleton α ∧ nonempty α :=
 to_nat_eq_one.trans eq_one_iff_unique
@@ -1157,11 +1278,11 @@ to_nat_eq_one.trans eq_one_iff_unique
 @[simp] lemma to_nat_lift (c : cardinal.{v}) : (lift.{u v} c).to_nat = c.to_nat :=
 begin
   apply nat_cast_injective,
-  cases lt_or_ge c ω with hc hc,
-  { rw [cast_to_nat_of_lt_omega, ←lift_nat_cast, cast_to_nat_of_lt_omega hc],
-    rwa [←lift_omega, lift_lt] },
-  { rw [cast_to_nat_of_omega_le, ←lift_nat_cast, cast_to_nat_of_omega_le hc, lift_zero],
-    rwa [←lift_omega, lift_le] },
+  cases lt_or_ge c ℵ₀ with hc hc,
+  { rw [cast_to_nat_of_lt_aleph_0, ←lift_nat_cast, cast_to_nat_of_lt_aleph_0 hc],
+    rwa [lift_lt_aleph_0] },
+  { rw [cast_to_nat_of_aleph_0_le, ←lift_nat_cast, cast_to_nat_of_aleph_0_le hc, lift_zero],
+    rwa [aleph_0_le_lift] },
 end
 
 lemma to_nat_congr {β : Type v} (e : α ≃ β) : (#α).to_nat = (#β).to_nat :=
@@ -1169,85 +1290,165 @@ by rw [←to_nat_lift, lift_mk_eq.mpr ⟨e⟩, to_nat_lift]
 
 @[simp] lemma to_nat_mul (x y : cardinal) : (x * y).to_nat = x.to_nat * y.to_nat :=
 begin
-  by_cases hx1 : x = 0,
-  { rw [comm_semiring.mul_comm, hx1, mul_zero, zero_to_nat, nat.zero_mul] },
-  by_cases hy1 : y = 0,
-  { rw [hy1, zero_to_nat, mul_zero, mul_zero, zero_to_nat] },
-  refine nat_cast_injective (eq.trans _ (nat.cast_mul _ _).symm),
-  cases lt_or_ge x ω with hx2 hx2,
-  { cases lt_or_ge y ω with hy2 hy2,
-    { rw [cast_to_nat_of_lt_omega, cast_to_nat_of_lt_omega hx2, cast_to_nat_of_lt_omega hy2],
-      exact mul_lt_omega hx2 hy2 },
-    { rw [cast_to_nat_of_omega_le hy2, mul_zero, cast_to_nat_of_omega_le],
-      exact not_lt.mp (mt (mul_lt_omega_iff_of_ne_zero hx1 hy1).mp (λ h, not_lt.mpr hy2 h.2)) } },
-  { rw [cast_to_nat_of_omega_le hx2, zero_mul, cast_to_nat_of_omega_le],
-    exact not_lt.mp (mt (mul_lt_omega_iff_of_ne_zero hx1 hy1).mp (λ h, not_lt.mpr hx2 h.1)) },
+  rcases eq_or_ne x 0 with rfl | hx1,
+  { rw [zero_mul, zero_to_nat, zero_mul] },
+  rcases eq_or_ne y 0 with rfl | hy1,
+  { rw [mul_zero, zero_to_nat, mul_zero] },
+  cases lt_or_le x ℵ₀ with hx2 hx2,
+  { cases lt_or_le y ℵ₀ with hy2 hy2,
+    { lift x to ℕ using hx2, lift y to ℕ using hy2,
+      rw [← nat.cast_mul, to_nat_cast, to_nat_cast, to_nat_cast] },
+    { rw [to_nat_apply_of_aleph_0_le hy2, mul_zero, to_nat_apply_of_aleph_0_le],
+      exact aleph_0_le_mul_iff'.2 (or.inl ⟨hx1, hy2⟩) } },
+  { rw [to_nat_apply_of_aleph_0_le hx2, zero_mul, to_nat_apply_of_aleph_0_le],
+    exact aleph_0_le_mul_iff'.2 (or.inr ⟨hx2, hy1⟩) },
 end
 
-@[simp] lemma to_nat_add_of_lt_omega {a : cardinal.{u}} {b : cardinal.{v}}
-  (ha : a < ω) (hb : b < ω) : ((lift.{v u} a) + (lift.{u v} b)).to_nat = a.to_nat + b.to_nat :=
+/-- `cardinal.to_nat` as a `monoid_with_zero_hom`. -/
+@[simps]
+def to_nat_hom : cardinal →*₀ ℕ :=
+{ to_fun := to_nat,
+  map_zero' := zero_to_nat,
+  map_one' := one_to_nat,
+  map_mul' := to_nat_mul }
+
+lemma to_nat_finset_prod (s : finset α) (f : α → cardinal) :
+  to_nat (∏ i in s, f i) = ∏ i in s, to_nat (f i) :=
+map_prod to_nat_hom _ _
+
+@[simp] lemma to_nat_add_of_lt_aleph_0 {a : cardinal.{u}} {b : cardinal.{v}}
+  (ha : a < ℵ₀) (hb : b < ℵ₀) : ((lift.{v u} a) + (lift.{u v} b)).to_nat = a.to_nat + b.to_nat :=
 begin
   apply cardinal.nat_cast_injective,
-  replace ha : (lift.{v u} a) < ω := by { rw [← lift_omega], exact lift_lt.2 ha },
-  replace hb : (lift.{u v} b) < ω := by { rw [← lift_omega], exact lift_lt.2 hb },
-  rw [nat.cast_add, ← to_nat_lift.{v u} a, ← to_nat_lift.{u v} b, cast_to_nat_of_lt_omega ha,
-    cast_to_nat_of_lt_omega hb, cast_to_nat_of_lt_omega (add_lt_omega ha hb)]
+  replace ha : (lift.{v u} a) < ℵ₀ := by rwa lift_lt_aleph_0,
+  replace hb : (lift.{u v} b) < ℵ₀ := by rwa lift_lt_aleph_0,
+  rw [nat.cast_add, ←to_nat_lift.{v u} a, ←to_nat_lift.{u v} b, cast_to_nat_of_lt_aleph_0 ha,
+    cast_to_nat_of_lt_aleph_0 hb, cast_to_nat_of_lt_aleph_0 (add_lt_aleph_0 ha hb)]
 end
 
 /-- This function sends finite cardinals to the corresponding natural, and infinite cardinals
   to `⊤`. -/
-def to_enat : cardinal →+ enat :=
-{ to_fun := λ c, if c < omega.{v} then c.to_nat else ⊤,
-  map_zero' := by simp [if_pos (lt_trans zero_lt_one one_lt_omega)],
+def to_part_enat : cardinal →+ part_enat :=
+{ to_fun := λ c, if c < ℵ₀ then c.to_nat else ⊤,
+  map_zero' := by simp [if_pos (zero_lt_one.trans one_lt_aleph_0)],
   map_add' := λ x y, begin
-    by_cases hx : x < ω,
-    { obtain ⟨x0, rfl⟩ := lt_omega.1 hx,
-      by_cases hy : y < ω,
-      { obtain ⟨y0, rfl⟩ := lt_omega.1 hy,
-        simp only [add_lt_omega hx hy, hx, hy, to_nat_cast, if_true],
+    by_cases hx : x < ℵ₀,
+    { obtain ⟨x0, rfl⟩ := lt_aleph_0.1 hx,
+      by_cases hy : y < ℵ₀,
+      { obtain ⟨y0, rfl⟩ := lt_aleph_0.1 hy,
+        simp only [add_lt_aleph_0 hx hy, hx, hy, to_nat_cast, if_true],
         rw [← nat.cast_add, to_nat_cast, nat.cast_add] },
-      { rw [if_neg hy, if_neg, enat.add_top],
+      { rw [if_neg hy, if_neg, part_enat.add_top],
         contrapose! hy,
-        apply lt_of_le_of_lt le_add_self hy } },
-    { rw [if_neg hx, if_neg, enat.top_add],
+        apply le_add_self.trans_lt hy } },
+    { rw [if_neg hx, if_neg, part_enat.top_add],
       contrapose! hx,
-      apply lt_of_le_of_lt le_self_add hx },
+      apply le_self_add.trans_lt hx },
   end }
 
-@[simp]
-lemma to_enat_apply_of_lt_omega {c : cardinal} (h : c < ω) :
-  c.to_enat = c.to_nat :=
+lemma to_part_enat_apply_of_lt_aleph_0 {c : cardinal} (h : c < ℵ₀) : c.to_part_enat = c.to_nat :=
 if_pos h
 
-@[simp]
-lemma to_enat_apply_of_omega_le {c : cardinal} (h : ω ≤ c) :
-  c.to_enat = ⊤ :=
-if_neg (not_lt_of_le h)
+lemma to_part_enat_apply_of_aleph_0_le {c : cardinal} (h : ℵ₀ ≤ c) : c.to_part_enat = ⊤ :=
+if_neg h.not_lt
+
+@[simp] lemma to_part_enat_cast (n : ℕ) : cardinal.to_part_enat n = n :=
+by rw [to_part_enat_apply_of_lt_aleph_0 (nat_lt_aleph_0 n), to_nat_cast]
+
+@[simp] lemma mk_to_part_enat_of_infinite [h : infinite α] : (#α).to_part_enat = ⊤ :=
+to_part_enat_apply_of_aleph_0_le (infinite_iff.1 h)
+
+@[simp] theorem aleph_0_to_part_enat : to_part_enat ℵ₀ = ⊤ :=
+to_part_enat_apply_of_aleph_0_le le_rfl
+
+lemma to_part_enat_eq_top_iff_le_aleph_0 {c : cardinal} :
+  to_part_enat c = ⊤ ↔ aleph_0 ≤ c :=
+begin
+  cases lt_or_ge c aleph_0 with hc hc,
+  simp only [to_part_enat_apply_of_lt_aleph_0 hc, part_enat.coe_ne_top, false_iff, not_le, hc],
+  simp only [to_part_enat_apply_of_aleph_0_le hc, eq_self_iff_true, true_iff],
+  exact hc,
+end
 
-@[simp]
-lemma to_enat_cast (n : ℕ) : cardinal.to_enat n = n :=
-by rw [to_enat_apply_of_lt_omega (nat_lt_omega n), to_nat_cast]
+lemma to_part_enat_le_iff_le_of_le_aleph_0 {c c' : cardinal} (h : c ≤ aleph_0) :
+  to_part_enat c ≤ to_part_enat c' ↔ c ≤ c' :=
+begin
+  cases lt_or_ge c aleph_0 with hc hc,
+  rw to_part_enat_apply_of_lt_aleph_0 hc,
+  cases lt_or_ge c' aleph_0 with hc' hc',
+  { rw to_part_enat_apply_of_lt_aleph_0 hc',
+    rw part_enat.coe_le_coe,
+    exact to_nat_le_iff_le_of_lt_aleph_0 hc hc', },
+  { simp only [to_part_enat_apply_of_aleph_0_le hc',
+    le_top, true_iff],
+    exact le_trans h hc', },
+  { rw to_part_enat_apply_of_aleph_0_le hc,
+    simp only [top_le_iff, to_part_enat_eq_top_iff_le_aleph_0,
+    le_antisymm h hc], },
+end
+
+lemma to_part_enat_le_iff_le_of_lt_aleph_0 {c c' : cardinal} (hc' : c' < aleph_0) :
+  to_part_enat c ≤ to_part_enat c' ↔ c ≤ c' :=
+begin
+  cases lt_or_ge c aleph_0 with hc hc,
+  { rw to_part_enat_apply_of_lt_aleph_0 hc,
+    rw to_part_enat_apply_of_lt_aleph_0 hc',
+    rw part_enat.coe_le_coe,
+    exact to_nat_le_iff_le_of_lt_aleph_0 hc hc', },
+  { rw to_part_enat_apply_of_aleph_0_le hc,
+    simp only [top_le_iff, to_part_enat_eq_top_iff_le_aleph_0],
+    rw [← not_iff_not, not_le, not_le],
+    simp only [hc', lt_of_lt_of_le hc' hc], },
+end
+
+lemma to_part_enat_eq_iff_eq_of_le_aleph_0 {c c' : cardinal}
+  (hc : c ≤ aleph_0) (hc' : c' ≤ aleph_0) :
+  to_part_enat c = to_part_enat c' ↔ c = c' := by
+rw [le_antisymm_iff, le_antisymm_iff,
+  to_part_enat_le_iff_le_of_le_aleph_0 hc, to_part_enat_le_iff_le_of_le_aleph_0 hc']
+
+lemma to_part_enat_mono {c c' : cardinal} (h : c ≤ c') :
+  to_part_enat c ≤ to_part_enat c' :=
+begin
+  cases lt_or_ge c aleph_0 with hc hc,
+  rw to_part_enat_apply_of_lt_aleph_0 hc,
+  cases lt_or_ge c' aleph_0 with hc' hc',
+  rw to_part_enat_apply_of_lt_aleph_0 hc',
+  simp only [part_enat.coe_le_coe],
+  exact to_nat_le_of_le_of_lt_aleph_0 hc' h,
+  rw to_part_enat_apply_of_aleph_0_le hc',
+  exact le_top,
+  rw [to_part_enat_apply_of_aleph_0_le hc,
+  to_part_enat_apply_of_aleph_0_le (le_trans hc h)],
+end
 
-@[simp]
-lemma mk_to_enat_of_infinite [h : infinite α] : (#α).to_enat = ⊤ :=
-to_enat_apply_of_omega_le (infinite_iff.1 h)
+lemma to_part_enat_surjective : surjective to_part_enat :=
+λ x, part_enat.cases_on x ⟨ℵ₀, to_part_enat_apply_of_aleph_0_le le_rfl⟩ $
+  λ n, ⟨n, to_part_enat_cast n⟩
 
-lemma to_enat_surjective : surjective to_enat :=
+lemma to_part_enat_lift (c : cardinal.{v}) : (lift.{u v} c).to_part_enat = c.to_part_enat :=
 begin
-  intro x,
-  exact enat.cases_on x ⟨ω, to_enat_apply_of_omega_le (le_refl ω)⟩
-    (λ n, ⟨n, to_enat_cast n⟩),
+  cases lt_or_ge c ℵ₀ with hc hc,
+  { rw [to_part_enat_apply_of_lt_aleph_0 hc, cardinal.to_part_enat_apply_of_lt_aleph_0 _],
+    simp only [to_nat_lift],
+    rw [← lift_aleph_0, lift_lt], exact hc },
+  { rw [to_part_enat_apply_of_aleph_0_le hc, cardinal.to_part_enat_apply_of_aleph_0_le _],
+  rw [← lift_aleph_0, lift_le], exact hc }
 end
 
-lemma mk_to_enat_eq_coe_card [fintype α] : (#α).to_enat = fintype.card α :=
+lemma to_part_enat_congr {β : Type v} (e : α ≃ β) : (#α).to_part_enat = (#β).to_part_enat :=
+by rw [←to_part_enat_lift, lift_mk_eq.mpr ⟨e⟩, to_part_enat_lift]
+
+lemma mk_to_part_enat_eq_coe_card [fintype α] : (#α).to_part_enat = fintype.card α :=
 by simp
 
-lemma mk_int : #ℤ = ω := mk_denumerable ℤ
+lemma mk_int : #ℤ = ℵ₀ := mk_denumerable ℤ
 
-lemma mk_pnat : #ℕ+ = ω := mk_denumerable ℕ+
+lemma mk_pnat : #ℕ+ = ℵ₀ := mk_denumerable ℕ+
 
 /-- **König's theorem** -/
-theorem sum_lt_prod {ι} (f g : ι → cardinal) (H : ∀ i, f i < g i) : sum f < prod g :=
+theorem sum_lt_prod {ι} (f g : ι → cardinal) (H : ∀ i, f i < g i) :
+sum f < prod g :=
 lt_of_not_ge $ λ ⟨F⟩, begin
   haveI : inhabited (Π (i : ι), (g i).out),
   { refine ⟨λ i, classical.choice $ mk_ne_zero_iff.1 _⟩,
@@ -1256,9 +1457,9 @@ lt_of_not_ge $ λ ⟨F⟩, begin
   let G := inv_fun F,
   have sG : surjective G := inv_fun_surjective F.2,
   choose C hc using show ∀ i, ∃ b, ∀ a, G ⟨i, a⟩ i ≠ b,
-  { assume i,
+  { intro i,
     simp only [- not_exists, not_exists.symm, not_forall.symm],
-    refine λ h, not_le_of_lt (H i) _,
+    refine λ h, (H i).not_le _,
     rw [← mk_out (f i), ← mk_out (g i)],
     exact ⟨embedding.of_surjective _ h⟩ },
   exact (let ⟨⟨i, a⟩, h⟩ := sG C in hc i a (congr_fun h _))
@@ -1331,7 +1532,7 @@ lemma mk_range_eq_of_injective {α : Type u} {β : Type v} {f : α → β} (hf :
 lift_mk_eq'.mpr ⟨(equiv.of_injective f hf).symm⟩
 
 lemma mk_range_eq_lift {α : Type u} {β : Type v} {f : α → β} (hf : injective f) :
-  lift.{(max u w)} (# (range f)) = lift.{(max v w)} (# α) :=
+  lift.{max u w} (# (range f)) = lift.{max v w} (# α) :=
 lift_mk_eq.mpr ⟨(equiv.of_injective f hf).symm⟩
 
 theorem mk_image_eq {α β : Type u} {f : α → β} {s : set α} (hf : injective f) :
@@ -1347,30 +1548,41 @@ theorem mk_Union_eq_sum_mk {α ι : Type u} {f : ι → set α} (h : ∀i j, i 
 calc #(⋃ i, f i) = #(Σ i, f i)       : mk_congr (set.Union_eq_sigma_of_disjoint h)
               ... = sum (λi, #(f i)) : mk_sigma _
 
-lemma mk_Union_le {α ι : Type u} (f : ι → set α) :
-  #(⋃ i, f i) ≤ #ι * cardinal.sup.{u u} (λ i, #(f i)) :=
-le_trans mk_Union_le_sum_mk (sum_le_sup _)
+lemma mk_Union_le {α ι : Type u} (f : ι → set α) : #(⋃ i, f i) ≤ #ι * ⨆ i, #(f i) :=
+mk_Union_le_sum_mk.trans (sum_le_supr _)
 
-lemma mk_sUnion_le {α : Type u} (A : set (set α)) :
-  #(⋃₀ A) ≤ #A * cardinal.sup.{u u} (λ s : A, #s) :=
-by { rw [sUnion_eq_Union], apply mk_Union_le }
+lemma mk_sUnion_le {α : Type u} (A : set (set α)) : #(⋃₀ A) ≤ #A * ⨆ s : A, #s :=
+by { rw sUnion_eq_Union, apply mk_Union_le }
 
 lemma mk_bUnion_le {ι α : Type u} (A : ι → set α) (s : set ι) :
-  #(⋃(x ∈ s), A x) ≤ #s * cardinal.sup.{u u} (λ x : s, #(A x.1)) :=
-by { rw [bUnion_eq_Union], apply mk_Union_le }
+  #(⋃ x ∈ s, A x) ≤ #s * ⨆ x : s, #(A x.1) :=
+by { rw bUnion_eq_Union, apply mk_Union_le }
 
-lemma finset_card_lt_omega (s : finset α) : #(↑s : set α) < ω :=
-by { rw [lt_omega_iff_fintype], exact ⟨finset.subtype.fintype s⟩ }
+lemma finset_card_lt_aleph_0 (s : finset α) : #(↑s : set α) < ℵ₀ :=
+lt_aleph_0_of_finite _
 
-theorem mk_eq_nat_iff_finset {α} {s : set α} {n : ℕ} :
+theorem mk_set_eq_nat_iff_finset {α} {s : set α} {n : ℕ} :
   #s = n ↔ ∃ t : finset α, (t : set α) = s ∧ t.card = n :=
 begin
   split,
   { intro h,
-    lift s to finset α using lt_omega_iff_finite.1 (h.symm ▸ nat_lt_omega n),
+    lift s to finset α using lt_aleph_0_iff_set_finite.1 (h.symm ▸ nat_lt_aleph_0 n),
     simpa using h },
   { rintro ⟨t, rfl, rfl⟩,
-    exact mk_finset }
+    exact mk_coe_finset }
+end
+
+theorem mk_eq_nat_iff_finset {n : ℕ} : #α = n ↔ ∃ t : finset α, (t : set α) = univ ∧ t.card = n :=
+by rw [← mk_univ, mk_set_eq_nat_iff_finset]
+
+theorem mk_eq_nat_iff_fintype {n : ℕ} : #α = n ↔ ∃ (h : fintype α), @fintype.card α h = n :=
+begin
+  rw [mk_eq_nat_iff_finset],
+  split,
+  { rintro ⟨t, ht, hn⟩,
+    exact ⟨⟨t, eq_univ_iff_forall.1 ht⟩, hn⟩ },
+  { rintro ⟨⟨t, ht⟩, hn⟩,
+    exact ⟨t, eq_univ_iff_forall.2 ht, hn⟩ }
 end
 
 theorem mk_union_add_mk_inter {α : Type u} {S T : set α} :
@@ -1384,7 +1596,7 @@ lemma mk_union_le {α : Type u} (S T : set α) : #(S ∪ T : set α) ≤ #S + #T
 
 theorem mk_union_of_disjoint {α : Type u} {S T : set α} (H : disjoint S T) :
   #(S ∪ T : set α) = #S + #T :=
-quot.sound ⟨equiv.set.union H⟩
+quot.sound ⟨equiv.set.union H.le_bot⟩
 
 theorem mk_insert {α : Type u} {s : set α} {a : α} (h : a ∉ s) :
   #(insert a s : set α) = #s + 1 :=
@@ -1396,10 +1608,16 @@ mk_congr (equiv.set.sum_compl s)
 lemma mk_le_mk_of_subset {α} {s t : set α} (h : s ⊆ t) : #s ≤ #t :=
 ⟨set.embedding_of_subset s t h⟩
 
-lemma mk_subtype_mono {p q : α → Prop} (h : ∀x, p x → q x) : #{x // p x} ≤ #{x // q x} :=
+lemma mk_subtype_mono {p q : α → Prop} (h : ∀ x, p x → q x) : #{x // p x} ≤ #{x // q x} :=
 ⟨embedding_of_subset _ _ h⟩
 
-lemma mk_union_le_omega {α} {P Q : set α} : #((P ∪ Q : set α)) ≤ ω ↔ #P ≤ ω ∧ #Q ≤ ω :=
+lemma le_mk_diff_add_mk (S T : set α) : #S ≤ #(S \ T : set α) + #T :=
+(mk_le_mk_of_subset $ subset_diff_union _ _).trans $ mk_union_le _ _
+
+lemma mk_diff_add_mk {S T : set α} (h : T ⊆ S) : #(S \ T : set α) + #T = #S :=
+(mk_union_of_disjoint $ by exact disjoint_sdiff_self_left).symm.trans $ by rw diff_union_of_subset h
+
+lemma mk_union_le_aleph_0 {α} {P Q : set α} : #((P ∪ Q : set α)) ≤ ℵ₀ ↔ #P ≤ ℵ₀ ∧ #Q ≤ ℵ₀ :=
 by simp
 
 lemma mk_image_eq_lift {α : Type u} {β : Type v} (f : α → β) (s : set α) (h : injective f) :
@@ -1475,93 +1693,115 @@ begin
 end
 
 lemma two_le_iff : (2 : cardinal) ≤ #α ↔ ∃x y : α, x ≠ y :=
+by rw [← nat.cast_two, nat_succ, succ_le_iff, nat.cast_one, one_lt_iff_nontrivial, nontrivial_iff]
+
+lemma two_le_iff' (x : α) : (2 : cardinal) ≤ #α ↔ ∃y : α, y ≠ x :=
+by rw [two_le_iff, ← nontrivial_iff, nontrivial_iff_exists_ne x]
+
+lemma mk_eq_two_iff : #α = 2 ↔ ∃ x y : α, x ≠ y ∧ ({x, y} : set α) = univ :=
 begin
+  simp only [← @nat.cast_two cardinal, mk_eq_nat_iff_finset, finset.card_eq_two],
   split,
-  { rintro ⟨f⟩, refine ⟨f $ sum.inl ⟨⟩, f $ sum.inr ⟨⟩, _⟩, intro h, cases f.2 h },
-  { rintro ⟨x, y, h⟩, by_contra h',
-    rw [not_le, ←nat.cast_two, nat_succ, lt_succ, nat.cast_one, le_one_iff_subsingleton] at h',
-    apply h, exactI subsingleton.elim _ _ }
+  { rintro ⟨t, ht, x, y, hne, rfl⟩,
+    exact ⟨x, y, hne, by simpa using ht⟩ },
+  { rintro ⟨x, y, hne, h⟩,
+    exact ⟨{x, y}, by simpa using h, x, y, hne, rfl⟩ }
 end
 
-lemma two_le_iff' (x : α) : (2 : cardinal) ≤ #α ↔ ∃y : α, x ≠ y :=
+lemma mk_eq_two_iff' (x : α) : #α = 2 ↔ ∃! y, y ≠ x :=
 begin
-  rw [two_le_iff],
-  split,
-  { rintro ⟨y, z, h⟩, refine classical.by_cases (λ(h' : x = y), _) (λ h', ⟨y, h'⟩),
-    rw [←h'] at h, exact ⟨z, h⟩ },
-  { rintro ⟨y, h⟩, exact ⟨x, y, h⟩ }
+  rw [mk_eq_two_iff], split,
+  { rintro ⟨a, b, hne, h⟩,
+    simp only [eq_univ_iff_forall, mem_insert_iff, mem_singleton_iff] at h,
+    rcases h x with rfl|rfl,
+    exacts [⟨b, hne.symm, λ z, (h z).resolve_left⟩, ⟨a, hne, λ z, (h z).resolve_right⟩] },
+  { rintro ⟨y, hne, hy⟩,
+    exact ⟨x, y, hne.symm, eq_univ_of_forall $ λ z, or_iff_not_imp_left.2 (hy z)⟩ }
 end
 
-lemma exists_not_mem_of_length_le {α : Type*} (l : list α) (h : ↑l.length < # α) :
+lemma exists_not_mem_of_length_lt {α : Type*} (l : list α) (h : ↑l.length < # α) :
   ∃ (z : α), z ∉ l :=
 begin
   contrapose! h,
   calc # α = # (set.univ : set α) : mk_univ.symm
     ... ≤ # l.to_finset           : mk_le_mk_of_subset (λ x _, list.mem_to_finset.mpr (h x))
-    ... = l.to_finset.card        : cardinal.mk_finset
+    ... = l.to_finset.card        : cardinal.mk_coe_finset
     ... ≤ l.length                : cardinal.nat_cast_le.mpr (list.to_finset_card_le l),
 end
 
 lemma three_le {α : Type*} (h : 3 ≤ # α) (x : α) (y : α) :
   ∃ (z : α), z ≠ x ∧ z ≠ y :=
 begin
-  have : ((3:nat) : cardinal) ≤ # α, simpa using h,
-  have : ((2:nat) : cardinal) < # α, rwa [← cardinal.succ_le, ← cardinal.nat_succ],
-  have := exists_not_mem_of_length_le [x, y] this,
+  have : ↑(3 : ℕ) ≤ # α, simpa using h,
+  have : ↑(2 : ℕ) < # α, rwa [← succ_le_iff, ← cardinal.nat_succ],
+  have := exists_not_mem_of_length_lt [x, y] this,
   simpa [not_or_distrib] using this,
 end
 
-/-- The function α^{<β}, defined to be sup_{γ < β} α^γ.
-  We index over {s : set β.out // #s < β } instead of {γ // γ < β}, because the latter lives in a
-  higher universe -/
-def powerlt (α β : cardinal.{u}) : cardinal.{u} :=
-sup.{u u} (λ(s : {s : set β.out // #s < β}), α ^ mk.{u} s)
+/-- The function `a ^< b`, defined as the supremum of `a ^ c` for `c < b`. -/
+def powerlt (a b : cardinal.{u}) : cardinal.{u} :=
+⨆ c : Iio b, a ^ c
 
 infix ` ^< `:80 := powerlt
 
-theorem powerlt_aux {c c' : cardinal} (h : c < c') :
-  ∃(s : {s : set c'.out // #s < c'}), #s = c :=
+lemma le_powerlt {b c : cardinal.{u}} (a) (h : c < b) : a ^ c ≤ a ^< b :=
 begin
-  cases out_embedding.mp (le_of_lt h) with f,
-  have : #↥(range ⇑f) = c, { rwa [mk_range_eq, mk, quotient.out_eq c], exact f.2 },
-  exact ⟨⟨range f, by convert h⟩, this⟩
+  apply @le_csupr _ _ _ (λ y : Iio b, a ^ y) _ ⟨c, h⟩,
+  rw ←image_eq_range,
+  exact bdd_above_image.{u u} _ bdd_above_Iio
 end
 
-lemma le_powerlt {c₁ c₂ c₃ : cardinal} (h : c₂ < c₃) : c₁ ^ c₂ ≤ c₁ ^< c₃ :=
-by { rcases powerlt_aux h with ⟨s, rfl⟩, apply le_sup _ s }
-
-lemma powerlt_le {c₁ c₂ c₃ : cardinal} : c₁ ^< c₂ ≤ c₃ ↔ ∀(c₄ < c₂), c₁ ^ c₄ ≤ c₃ :=
+lemma powerlt_le {a b c : cardinal.{u}} : a ^< b ≤ c ↔ ∀ x < b, a ^ x ≤ c :=
 begin
-  rw [powerlt, sup_le_iff],
-  split,
-  { intros h c₄ hc₄, rcases powerlt_aux hc₄ with ⟨s, rfl⟩, exact h s },
-  intros h s, exact h _ s.2
+  rw [powerlt, csupr_le_iff'],
+  { simp },
+  { rw ←image_eq_range,
+    exact bdd_above_image.{u u} _ bdd_above_Iio }
 end
 
 lemma powerlt_le_powerlt_left {a b c : cardinal} (h : b ≤ c) : a ^< b ≤ a ^< c :=
-by { rw [powerlt, sup_le_iff], exact λ ⟨s, hs⟩, le_powerlt (lt_of_lt_of_le hs h) }
+powerlt_le.2 $ λ x hx, le_powerlt a $ hx.trans_le h
 
-lemma powerlt_succ {c₁ c₂ : cardinal} (h : c₁ ≠ 0) : c₁ ^< c₂.succ = c₁ ^ c₂ :=
-begin
-  apply le_antisymm,
-  { rw powerlt_le, intros c₃ h2, apply power_le_power_left h, rwa [←lt_succ] },
-  { apply le_powerlt, apply lt_succ_self }
-end
+lemma powerlt_mono_left (a) : monotone (λ c, a ^< c) :=
+λ b c, powerlt_le_powerlt_left
+
+lemma powerlt_succ {a b : cardinal} (h : a ≠ 0) : a ^< (succ b) = a ^ b :=
+(powerlt_le.2 $ λ c h', power_le_power_left h $ le_of_lt_succ h').antisymm $
+  le_powerlt a (lt_succ b)
 
-lemma powerlt_max {c₁ c₂ c₃ : cardinal} : c₁ ^< max c₂ c₃ = max (c₁ ^< c₂) (c₁ ^< c₃) :=
-by { cases le_total c₂ c₃; simp only [max_eq_left, max_eq_right, h, powerlt_le_powerlt_left] }
+lemma powerlt_min {a b c : cardinal} : a ^< min b c = min (a ^< b) (a ^< c) :=
+(powerlt_mono_left a).map_min
+
+lemma powerlt_max {a b c : cardinal} : a ^< max b c = max (a ^< b) (a ^< c) :=
+(powerlt_mono_left a).map_max
 
 lemma zero_powerlt {a : cardinal} (h : a ≠ 0) : 0 ^< a = 1 :=
 begin
-  apply le_antisymm,
-  { rw [powerlt_le], intros c hc, apply zero_power_le },
-  convert le_powerlt (pos_iff_ne_zero.2 h), rw [power_zero]
+  apply (powerlt_le.2 (λ c hc, zero_power_le _)).antisymm,
+  rw ←power_zero,
+  exact le_powerlt 0 (pos_iff_ne_zero.2 h)
 end
 
-lemma powerlt_zero {a : cardinal} : a ^< 0 = 0 :=
+@[simp] lemma powerlt_zero {a : cardinal} : a ^< 0 = 0 :=
 begin
-  convert sup_eq_zero,
-  exact subtype.is_empty_of_false (λ x, (zero_le _).not_lt),
+  convert cardinal.supr_of_empty _,
+  exact subtype.is_empty_of_false (λ x, (cardinal.zero_le _).not_lt),
 end
 
 end cardinal
+
+namespace tactic
+open cardinal positivity
+
+/-- Extension for the `positivity` tactic: The cardinal power of a positive cardinal is positive. -/
+@[positivity]
+meta def positivity_cardinal_pow : expr → tactic strictness
+| `(@has_pow.pow _ _ %%inst %%a %%b) := do
+  strictness_a ← core a,
+  match strictness_a with
+  | positive p := positive <$> mk_app ``power_pos [b, p]
+  | _ := failed -- We already know that `0 ≤ x` for all `x : cardinal`
+  end
+| _ := failed
+
+end tactic
diff --git a/src/set_theory/cardinal/cofinality.lean b/src/set_theory/cardinal/cofinality.lean
index f20ceedf8c4d3..9d59e9cda57a7 100644
--- a/src/set_theory/cardinal/cofinality.lean
+++ b/src/set_theory/cardinal/cofinality.lean
@@ -1,13 +1,18 @@
 /-
 Copyright (c) 2017 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Mario Carneiro, Floris van Doorn
+Authors: Mario Carneiro, Floris van Doorn, Violeta Hernández Palacios
 -/
+
 import set_theory.cardinal.ordinal
+import set_theory.ordinal.fixed_point
 
 /-!
 # Cofinality
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains the definition of cofinality of an ordinal number and regular cardinals
 
 ## Main Definitions
@@ -15,18 +20,17 @@ This file contains the definition of cofinality of an ordinal number and regular
 * `ordinal.cof o` is the cofinality of the ordinal `o`.
   If `o` is the order type of the relation `<` on `α`, then `o.cof` is the smallest cardinality of a
   subset `s` of α that is *cofinal* in `α`, i.e. `∀ x : α, ∃ y ∈ s, ¬ y < x`.
-* `cardinal.is_limit c` means that `c` is a (weak) limit cardinal: `c ≠ 0 ∧ ∀ x < c, succ x < c`.
 * `cardinal.is_strong_limit c` means that `c` is a strong limit cardinal:
   `c ≠ 0 ∧ ∀ x < c, 2 ^ x < c`.
-* `cardinal.is_regular c` means that `c` is a regular cardinal: `ω ≤ c ∧ c.ord.cof = c`.
+* `cardinal.is_regular c` means that `c` is a regular cardinal: `ℵ₀ ≤ c ∧ c.ord.cof = c`.
 * `cardinal.is_inaccessible c` means that `c` is strongly inaccessible:
-  `ω < c ∧ is_regular c ∧ is_strong_limit c`.
+  `ℵ₀ < c ∧ is_regular c ∧ is_strong_limit c`.
 
 ## Main Statements
 
 * `ordinal.infinite_pigeonhole_card`: the infinite pigeonhole principle
 * `cardinal.lt_power_cof`: A consequence of König's theorem stating that `c < c ^ c.ord.cof` for
-  `c ≥ ω`
+  `c ≥ ℵ₀`
 * `cardinal.univ_inaccessible`: The type of ordinals in `Type u` form an inaccessible cardinal
   (in `Type v` with `v > u`). This shows (externally) that in `Type u` there are at least `u`
   inaccessible cardinals.
@@ -40,13 +44,12 @@ This file contains the definition of cofinality of an ordinal number and regular
 
 cofinality, regular cardinals, limits cardinals, inaccessible cardinals,
 infinite pigeonhole principle
-
-
 -/
+
 noncomputable theory
 
-open function cardinal set
-open_locale classical cardinal
+open function cardinal set order
+open_locale classical cardinal ordinal
 
 universes u v w
 variables {α : Type*} {r : α → α → Prop}
@@ -54,49 +57,68 @@ variables {α : Type*} {r : α → α → Prop}
 /-! ### Cofinality of orders -/
 
 namespace order
+
 /-- Cofinality of a reflexive order `≼`. This is the smallest cardinality
   of a subset `S : set α` such that `∀ a, ∃ b ∈ S, a ≼ b`. -/
-def cof (r : α → α → Prop) [is_refl α r] : cardinal :=
-@cardinal.min {S : set α // ∀ a, ∃ b ∈ S, r a b}
-  ⟨⟨set.univ, λ a, ⟨a, ⟨⟩, refl _⟩⟩⟩
-  (λ S, #S)
+def cof (r : α → α → Prop) : cardinal :=
+Inf {c | ∃ S : set α, (∀ a, ∃ b ∈ S, r a b) ∧ #S = c}
 
-lemma cof_le (r : α → α → Prop) [is_refl α r] {S : set α} (h : ∀a, ∃(b ∈ S), r a b) :
-  order.cof r ≤ #S :=
-le_trans (cardinal.min_le _ ⟨S, h⟩) le_rfl
+/-- The set in the definition of `order.cof` is nonempty. -/
+theorem cof_nonempty (r : α → α → Prop) [is_refl α r] :
+  {c | ∃ S : set α, (∀ a, ∃ b ∈ S, r a b) ∧ #S = c}.nonempty :=
+⟨_, set.univ, λ a, ⟨a, ⟨⟩, refl _⟩, rfl⟩
+
+lemma cof_le (r : α → α → Prop) {S : set α} (h : ∀ a, ∃ b ∈ S, r a b) : cof r ≤ #S :=
+cInf_le' ⟨S, h, rfl⟩
 
 lemma le_cof {r : α → α → Prop} [is_refl α r] (c : cardinal) :
-  c ≤ order.cof r ↔ ∀ {S : set α} (h : ∀a, ∃(b ∈ S), r a b) , c ≤ #S :=
-by { rw [order.cof, cardinal.le_min], exact ⟨λ H S h, H ⟨S, h⟩, λ H ⟨S, h⟩, H h ⟩ }
+  c ≤ cof r ↔ ∀ {S : set α}, (∀ a, ∃ b ∈ S, r a b) → c ≤ #S :=
+begin
+  rw [cof, le_cInf_iff'' (cof_nonempty r)],
+  use λ H S h, H _ ⟨S, h, rfl⟩,
+  rintro H d ⟨S, h, rfl⟩,
+  exact H h
+end
 
 end order
 
-theorem rel_iso.cof.aux {α : Type u} {β : Type v} {r s}
-  [is_refl α r] [is_refl β s] (f : r ≃r s) :
-  cardinal.lift.{(max u v)} (order.cof r) ≤
-  cardinal.lift.{(max u v)} (order.cof s) :=
+theorem rel_iso.cof_le_lift {α : Type u} {β : Type v} {r : α → α → Prop} {s}
+  [is_refl β s] (f : r ≃r s) :
+  cardinal.lift.{max u v} (order.cof r) ≤ cardinal.lift.{max u v} (order.cof s) :=
 begin
-  rw [order.cof, order.cof, lift_min, lift_min, cardinal.le_min],
-  intro S, cases S with S H, simp only [comp, coe_sort_coe_base, subtype.coe_mk],
-  refine le_trans (min_le _ _) _,
-  { exact ⟨f ⁻¹' S, λ a,
-    let ⟨b, bS, h⟩ := H (f a) in ⟨f.symm b, by simp [bS, ← f.map_rel_iff, h,
-      -coe_fn_coe_base, -coe_fn_coe_trans, principal_seg.coe_coe_fn', initial_seg.coe_coe_fn]⟩⟩ },
-  { exact lift_mk_le.{u v (max u v)}.2
-    ⟨⟨λ ⟨x, h⟩, ⟨f x, h⟩, λ ⟨x, h₁⟩ ⟨y, h₂⟩ h₃,
-      by congr; injection h₃ with h'; exact f.to_equiv.injective h'⟩⟩ }
+  rw [order.cof, order.cof, lift_Inf, lift_Inf,
+    le_cInf_iff'' (nonempty_image_iff.2 (order.cof_nonempty s))],
+  rintros - ⟨-, ⟨u, H, rfl⟩, rfl⟩,
+  apply cInf_le',
+  refine ⟨_, ⟨f.symm '' u, λ a, _, rfl⟩,
+    lift_mk_eq.{u v (max u v)}.2 ⟨((f.symm).to_equiv.image u).symm⟩⟩,
+  rcases H (f a) with ⟨b, hb, hb'⟩,
+  refine ⟨f.symm b, mem_image_of_mem _ hb, f.map_rel_iff.1 _⟩,
+  rwa rel_iso.apply_symm_apply
 end
 
-theorem rel_iso.cof {α : Type u} {β : Type v} {r s}
+theorem rel_iso.cof_eq_lift {α : Type u} {β : Type v} {r s}
   [is_refl α r] [is_refl β s] (f : r ≃r s) :
-  cardinal.lift.{(max u v)} (order.cof r) =
-  cardinal.lift.{(max u v)} (order.cof s) :=
-le_antisymm (rel_iso.cof.aux f) (rel_iso.cof.aux f.symm)
+  cardinal.lift.{max u v} (order.cof r) = cardinal.lift.{max u v} (order.cof s) :=
+(rel_iso.cof_le_lift f).antisymm (rel_iso.cof_le_lift f.symm)
+
+theorem rel_iso.cof_le {α β : Type u} {r : α → α → Prop} {s} [is_refl β s] (f : r ≃r s) :
+  order.cof r ≤ order.cof s :=
+lift_le.1 (rel_iso.cof_le_lift f)
+
+theorem rel_iso.cof_eq {α β : Type u} {r s} [is_refl α r] [is_refl β s] (f : r ≃r s) :
+  order.cof r = order.cof s :=
+lift_inj.1 (rel_iso.cof_eq_lift f)
 
 /-- Cofinality of a strict order `≺`. This is the smallest cardinality of a set `S : set α` such
 that `∀ a, ∃ b ∈ S, ¬ b ≺ a`. -/
-def strict_order.cof (r : α → α → Prop) [h : is_irrefl α r] : cardinal :=
-@order.cof α (λ x y, ¬ r y x) ⟨h.1⟩
+def strict_order.cof (r : α → α → Prop) : cardinal :=
+order.cof (swap r)ᶜ
+
+/-- The set in the definition of `order.strict_order.cof` is nonempty. -/
+theorem strict_order.cof_nonempty (r : α → α → Prop) [is_irrefl α r] :
+  {c | ∃ S : set α, unbounded r S ∧ #S = c}.nonempty :=
+@order.cof_nonempty α _ (is_refl.swap rᶜ)
 
 /-! ### Cofinality of ordinals -/
 
@@ -108,49 +130,42 @@ namespace ordinal
   `cof 0 = 0` and `cof (succ o) = 1`, so it is only really
   interesting on limit ordinals (when it is an infinite cardinal). -/
 def cof (o : ordinal.{u}) : cardinal.{u} :=
-quot.lift_on o (λ a, by exactI strict_order.cof a.r)
+o.lift_on (λ a, strict_order.cof a.r)
 begin
-  rintros ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨⟨f, hf⟩⟩,
-  rw ← cardinal.lift_inj,
-  apply rel_iso.cof ⟨f, _⟩,
-  simp [hf]
+  rintros ⟨α, r, wo₁⟩ ⟨β, s, wo₂⟩ ⟨⟨f, hf⟩⟩,
+  haveI := wo₁, haveI := wo₂,
+  apply @rel_iso.cof_eq _ _ _ _ _ _ ,
+  { split, exact λ a b, not_iff_not.2 hf },
+  { exact ⟨(is_well_order.is_irrefl r).1⟩ },
+  { exact ⟨(is_well_order.is_irrefl s).1⟩ }
 end
 
 lemma cof_type (r : α → α → Prop) [is_well_order α r] : (type r).cof = strict_order.cof r := rfl
 
-theorem le_cof_type [is_well_order α r] {c} : c ≤ cof (type r) ↔
-  ∀ S : set α, (∀ a, ∃ b ∈ S, ¬ r b a) → c ≤ #S :=
-by dsimp [cof, strict_order.cof, order.cof, type, quotient.mk, quot.lift_on];
-   rw [cardinal.le_min, subtype.forall]; refl
+theorem le_cof_type [is_well_order α r] {c} : c ≤ cof (type r) ↔ ∀ S, unbounded r S → c ≤ #S :=
+(le_cInf_iff'' (strict_order.cof_nonempty r)).trans ⟨λ H S h, H _ ⟨S, h, rfl⟩,
+  by { rintros H d ⟨S, h, rfl⟩, exact H _ h }⟩
 
-theorem cof_type_le [is_well_order α r] (S : set α) (h : ∀ a, ∃ b ∈ S, ¬ r b a) :
-  cof (type r) ≤ #S :=
+theorem cof_type_le [is_well_order α r] {S : set α} (h : unbounded r S) : cof (type r) ≤ #S :=
 le_cof_type.1 le_rfl S h
 
-theorem lt_cof_type [is_well_order α r] (S : set α) (hl : #S < cof (type r)) :
-  ∃ a, ∀ b ∈ S, r b a :=
-not_forall_not.1 $ λ h, not_le_of_lt hl $ cof_type_le S (λ a, not_ball.1 (h a))
+theorem lt_cof_type [is_well_order α r] {S : set α} : #S < cof (type r) → bounded r S :=
+by simpa using not_imp_not.2 cof_type_le
 
-theorem cof_eq (r : α → α → Prop) [is_well_order α r] :
-  ∃ S : set α, (∀ a, ∃ b ∈ S, ¬ r b a) ∧ #S = cof (type r) :=
-begin
-  have : ∃ i, cof (type r) = _,
-  { dsimp [cof, order.cof, type, quotient.mk, quot.lift_on],
-    apply cardinal.min_eq },
-  exact let ⟨⟨S, hl⟩, e⟩ := this in ⟨S, hl, e.symm⟩,
-end
+theorem cof_eq (r : α → α → Prop) [is_well_order α r] : ∃ S, unbounded r S ∧ #S = cof (type r) :=
+Inf_mem (strict_order.cof_nonempty r)
 
 theorem ord_cof_eq (r : α → α → Prop) [is_well_order α r] :
-  ∃ S : set α, (∀ a, ∃ b ∈ S, ¬ r b a) ∧ type (subrel r S) = (cof (type r)).ord :=
+  ∃ S, unbounded r S ∧ type (subrel r S) = (cof (type r)).ord :=
 let ⟨S, hS, e⟩ := cof_eq r, ⟨s, _, e'⟩ := cardinal.ord_eq S,
     T : set α := {a | ∃ aS : a ∈ S, ∀ b : S, s b ⟨_, aS⟩ → r b a} in
 begin
   resetI, suffices,
   { refine ⟨T, this,
-      le_antisymm _ (cardinal.ord_le.2 $ cof_type_le T this)⟩,
+      le_antisymm _ (cardinal.ord_le.2 $ cof_type_le this)⟩,
     rw [← e, e'],
-    refine type_le'.2 ⟨rel_embedding.of_monotone
-      (λ a, ⟨a, let ⟨aS, _⟩ := a.2 in aS⟩) (λ a b h, _)⟩,
+    refine (rel_embedding.of_monotone (λ a : T, (⟨a, let ⟨aS, _⟩ := a.2 in aS⟩ : S)) (λ a b h, _))
+      .ordinal_type_le,
     rcases a with ⟨a, aS, ha⟩, rcases b with ⟨b, bS, hb⟩,
     change s ⟨a, _⟩ ⟨b, _⟩,
     refine ((trichotomous_of s _ _).resolve_left (λ hn, _)).resolve_left _,
@@ -159,11 +174,11 @@ begin
       exact irrefl _ h } },
   { intro a,
     have : {b : S | ¬ r b a}.nonempty := let ⟨b, bS, ba⟩ := hS a in ⟨⟨b, bS⟩, ba⟩,
-    let b := (is_well_order.wf).min _ this,
-    have ba : ¬r b a := (is_well_order.wf).min_mem _ this,
+    let b := (is_well_founded.wf).min _ this,
+    have ba : ¬r b a := (is_well_founded.wf).min_mem _ this,
     refine ⟨b, ⟨b.2, λ c, not_imp_not.1 $ λ h, _⟩, ba⟩,
     rw [show ∀b:S, (⟨b, b.2⟩:S) = b, by intro b; cases b; refl],
-    exact (is_well_order.wf).not_lt_min _ this
+    exact (is_well_founded.wf).not_lt_min _ this
       (is_order_connected.neg_trans h ba) }
 end
 
@@ -183,7 +198,7 @@ begin
   refine le_antisymm (le_cInf (cof_lsub_def_nonempty o) _) (cInf_le' _),
   { rintros a ⟨ι, f, hf, rfl⟩,
     rw ←type_lt o,
-    refine (cof_type_le _ (λ a, _)).trans (@mk_le_of_injective _ _
+    refine (cof_type_le (λ a, _)).trans (@mk_le_of_injective _ _
       (λ s : (typein ((<) : o.out.α → o.out.α → Prop))⁻¹' (set.range f), classical.some s.prop)
       (λ s t hst, let H := congr_arg f hst in by rwa [classical.some_spec s.prop,
         classical.some_spec t.prop, typein_inj, subtype.coe_inj] at H)),
@@ -204,29 +219,30 @@ begin
     exact hb'.trans_lt (lt_lsub.{u u} f ⟨b, hb⟩) }
 end
 
-theorem lift_cof (o) : (cof o).lift = cof o.lift :=
-induction_on o $ begin introsI α r _,
-  cases lift_type r with _ e, rw e,
+@[simp] theorem lift_cof (o) : (cof o).lift = cof o.lift :=
+begin
+  refine induction_on o _,
+  introsI α r _,
   apply le_antisymm,
-  { unfreezingI { refine le_cof_type.2 (λ S H, _) },
-    have : (#(ulift.up ⁻¹' S)).lift ≤ #S :=
-     ⟨⟨λ ⟨⟨x, h⟩⟩, ⟨⟨x⟩, h⟩,
-       λ ⟨⟨x, h₁⟩⟩ ⟨⟨y, h₂⟩⟩ e, by simp at e; congr; injection e⟩⟩,
-    refine le_trans (cardinal.lift_le.2 $ cof_type_le _ _) this,
+  { refine le_cof_type.2 (λ S H, _),
+    have : (#(ulift.up ⁻¹' S)).lift ≤ #S,
+    { rw [← cardinal.lift_umax, ← cardinal.lift_id' (#S)],
+      exact mk_preimage_of_injective_lift ulift.up _ ulift.up_injective },
+    refine (cardinal.lift_le.2 $ cof_type_le _).trans this,
     exact λ a, let ⟨⟨b⟩, bs, br⟩ := H ⟨a⟩ in ⟨b, bs, br⟩ },
   { rcases cof_eq r with ⟨S, H, e'⟩,
     have : #(ulift.down ⁻¹' S) ≤ (#S).lift :=
      ⟨⟨λ ⟨⟨x⟩, h⟩, ⟨⟨x, h⟩⟩,
        λ ⟨⟨x⟩, h₁⟩ ⟨⟨y⟩, h₂⟩ e, by simp at e; congr; injections⟩⟩,
     rw e' at this,
-    unfreezingI { refine le_trans (cof_type_le _ _) this },
+    unfreezingI { refine (cof_type_le _).trans this },
     exact λ ⟨a⟩, let ⟨b, bs, br⟩ := H a in ⟨⟨b⟩, bs, br⟩ }
 end
 
 theorem cof_le_card (o) : cof o ≤ card o :=
 by { rw cof_eq_Inf_lsub, exact cInf_le' card_mem_cof }
 
-theorem cof_ord_le (c : cardinal) : cof c.ord ≤ c :=
+theorem cof_ord_le (c : cardinal) : c.ord.cof ≤ c :=
 by simpa using cof_le_card c.ord
 
 theorem ord_cof_le (o : ordinal.{u}) : o.cof.ord ≤ o :=
@@ -276,13 +292,49 @@ theorem sup_lt_ord {ι} {f : ι → ordinal} {c : ordinal} (hι : #ι < c.cof) :
   (∀ i, f i < c) → sup.{u u} f < c :=
 sup_lt_ord_lift (by rwa (#ι).lift_id)
 
-theorem sup_lt_lift {ι} {f : ι → cardinal} {c : cardinal} (hι : cardinal.lift (#ι) < c.ord.cof)
-  (hf : ∀ i, f i < c) : cardinal.sup.{u v} f < c :=
-by { rw [←ord_lt_ord, ←sup_ord], refine sup_lt_ord_lift hι (λ i, _), rw ord_lt_ord, apply hf }
+theorem supr_lt_lift {ι} {f : ι → cardinal} {c : cardinal} (hι : cardinal.lift (#ι) < c.ord.cof)
+  (hf : ∀ i, f i < c) : supr f < c :=
+begin
+  rw [←ord_lt_ord, supr_ord (cardinal.bdd_above_range _)],
+  refine sup_lt_ord_lift hι (λ i, _),
+  rw ord_lt_ord,
+  apply hf
+end
+
+theorem supr_lt {ι} {f : ι → cardinal} {c : cardinal} (hι : #ι < c.ord.cof) :
+  (∀ i, f i < c) → supr f < c :=
+supr_lt_lift (by rwa (#ι).lift_id)
+
+theorem nfp_family_lt_ord_lift {ι} {f : ι → ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
+  (hc' : (#ι).lift < cof c) (hf : ∀ i (b < c), f i b < c) {a} (ha : a < c) :
+  nfp_family.{u v} f a < c :=
+begin
+  refine sup_lt_ord_lift ((cardinal.lift_le.2 (mk_list_le_max ι)).trans_lt _) (λ l, _),
+  { rw lift_max,
+    apply max_lt _ hc',
+    rwa cardinal.lift_aleph_0 },
+  { induction l with i l H,
+    { exact ha },
+    { exact hf _ _ H } }
+end
+
+theorem nfp_family_lt_ord {ι} {f : ι → ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
+  (hc' : #ι < cof c) (hf : ∀ i (b < c), f i b < c) {a} : a < c → nfp_family.{u u} f a < c :=
+nfp_family_lt_ord_lift hc (by rwa (#ι).lift_id) hf
+
+theorem nfp_bfamily_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
+  (hc' : o.card.lift < cof c) (hf : ∀ i hi (b < c), f i hi b < c) {a} :
+  a < c → nfp_bfamily.{u v} o f a < c :=
+nfp_family_lt_ord_lift hc (by rwa mk_ordinal_out) (λ i, hf _ _)
 
-theorem sup_lt {ι} {f : ι → cardinal} {c : cardinal} (hι : #ι < c.ord.cof) :
-  (∀ i, f i < c) → cardinal.sup.{u u} f < c :=
-sup_lt_lift (by rwa (#ι).lift_id)
+theorem nfp_bfamily_lt_ord {o : ordinal} {f : Π a < o, ordinal → ordinal} {c} (hc : ℵ₀ < cof c)
+  (hc' : o.card < cof c) (hf : ∀ i hi (b < c), f i hi b < c) {a} :
+  a < c → nfp_bfamily.{u u} o f a < c :=
+nfp_bfamily_lt_ord_lift hc (by rwa o.card.lift_id) hf
+
+theorem nfp_lt_ord {f : ordinal → ordinal} {c} (hc : ℵ₀ < cof c) (hf : ∀ i < c, f i < c) {a} :
+  a < c → nfp f a < c :=
+nfp_family_lt_ord_lift hc (by simpa using cardinal.one_lt_aleph_0.trans hc) (λ _, hf)
 
 theorem exists_blsub_cof (o : ordinal) : ∃ (f : Π a < (cof o).ord, ordinal), blsub.{u u} _ f = o :=
 begin
@@ -310,8 +362,8 @@ by { rw ←(o.card).lift_id, exact cof_blsub_le_lift f }
 
 theorem blsub_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal} {c : ordinal}
   (ho : o.card.lift < c.cof) (hf : ∀ i hi, f i hi < c) : blsub.{u v} o f < c :=
-lt_of_le_of_ne (blsub_le hf) (λ h, not_le_of_lt ho
-  (by simpa [sup_ord, hf, h] using cof_blsub_le_lift.{u} f))
+lt_of_le_of_ne (blsub_le hf) (λ h, ho.not_le
+  (by simpa [←supr_ord, hf, h] using cof_blsub_le_lift.{u} f))
 
 theorem blsub_lt_ord {o : ordinal} {f : Π a < o, ordinal} {c : ordinal} (ho : o.card < c.cof)
   (hf : ∀ i hi, f i hi < c) : blsub.{u u} o f < c :=
@@ -356,7 +408,7 @@ begin
     { refine λ a, ⟨sum.inr punit.star, set.mem_singleton _, _⟩,
       rcases a with a|⟨⟨⟨⟩⟩⟩; simp [empty_relation] },
     { rw [cardinal.mk_fintype, set.card_singleton], simp } },
-  { rw [← cardinal.succ_zero, cardinal.succ_le],
+  { rw [← cardinal.succ_zero, succ_le_iff],
     simpa [lt_iff_le_and_ne, cardinal.zero_le] using
       λ h, succ_ne_zero o (cof_eq_zero.1 (eq.symm h)) }
 end
@@ -389,28 +441,31 @@ end, λ ⟨a, e⟩, by simp [e]⟩
 def is_fundamental_sequence (a o : ordinal.{u}) (f : Π b < o, ordinal.{u}) : Prop :=
 o ≤ a.cof.ord ∧ (∀ {i j} (hi hj), i < j → f i hi < f j hj) ∧ blsub.{u u} o f = a
 
-section fundamental_sequence
-variables {a o : ordinal.{u}} {f : Π b < o, ordinal.{u}} (hf : is_fundamental_sequence a o f)
+namespace is_fundamental_sequence
+variables {a o : ordinal.{u}} {f : Π b < o, ordinal.{u}}
 
-theorem is_fundamental_sequence.cof_eq : a.cof.ord = o :=
-hf.1.antisymm' (by { rw ←hf.2.2, exact (ord_le_ord.2 (cof_blsub_le f)).trans (ord_card_le o) })
+protected theorem cof_eq (hf : is_fundamental_sequence a o f) : a.cof.ord = o :=
+hf.1.antisymm' $ by { rw ←hf.2.2, exact (ord_le_ord.2 (cof_blsub_le f)).trans (ord_card_le o) }
 
-theorem is_fundamental_sequence.strict_mono :
-  ∀ {i j : ordinal} (hi : i < o) (hj : j < o), i < j → f i hi < f j hj :=
+protected theorem strict_mono (hf : is_fundamental_sequence a o f) {i j} :
+  ∀ hi hj, i < j → f i hi < f j hj :=
 hf.2.1
 
-theorem is_fundamental_sequence.blsub_eq : blsub.{u u} o f = a :=
+theorem blsub_eq (hf : is_fundamental_sequence a o f) : blsub.{u u} o f = a :=
 hf.2.2
 
-theorem is_fundamental_sequence_id_of_le_cof (h : o ≤ o.cof.ord) :
-  is_fundamental_sequence o o (λ a _, a) :=
+theorem ord_cof (hf : is_fundamental_sequence a o f) :
+  is_fundamental_sequence a a.cof.ord (λ i hi, f i (hi.trans_le (by rw hf.cof_eq))) :=
+by { have H := hf.cof_eq, subst H, exact hf }
+
+theorem id_of_le_cof (h : o ≤ o.cof.ord) : is_fundamental_sequence o o (λ a _, a) :=
 ⟨h, λ _ _ _ _, id, blsub_id o⟩
 
-theorem is_fundamental_sequence_zero {f : Π b < (0 : ordinal), ordinal} :
+protected theorem zero {f : Π b < (0 : ordinal), ordinal} :
   is_fundamental_sequence 0 0 f :=
 ⟨by rw [cof_zero, ord_zero], λ i j hi, (ordinal.not_lt_zero i hi).elim, blsub_zero f⟩
 
-theorem is_fundamental_sequence_succ : is_fundamental_sequence o.succ 1 (λ _ _, o) :=
+protected theorem succ : is_fundamental_sequence (succ o) 1 (λ _ _, o) :=
 begin
   refine ⟨_, λ i j hi hj h, _, blsub_const ordinal.one_ne_zero o⟩,
   { rw [cof_succ, ord_one] },
@@ -419,18 +474,15 @@ begin
     exact h.false.elim }
 end
 
-include hf
-theorem is_fundamental_sequence.monotone {i j : ordinal} (hi : i < o) (hj : j < o) (hij : i ≤ j) :
-  f i hi ≤ f j hj :=
+protected theorem monotone (hf : is_fundamental_sequence a o f) {i j : ordinal} (hi : i < o)
+  (hj : j < o) (hij : i ≤ j) : f i hi ≤ f j hj :=
 begin
   rcases lt_or_eq_of_le hij with hij | rfl,
-  { exact le_of_lt (hf.2.1 hi hj hij) },
+  { exact (hf.2.1 hi hj hij).le },
   { refl }
 end
 
-end fundamental_sequence
-
-theorem is_fundamental_sequence.trans {a o o' : ordinal.{u}} {f : Π b < o, ordinal.{u}}
+theorem trans {a o o' : ordinal.{u}} {f : Π b < o, ordinal.{u}}
   (hf : is_fundamental_sequence a o f) {g : Π b < o', ordinal.{u}}
   (hg : is_fundamental_sequence o o' g) :
   is_fundamental_sequence a o' (λ i hi, f (g i hi) (by { rw ←hg.2.2, apply lt_blsub })) :=
@@ -442,30 +494,29 @@ begin
     exact hf.2.2 }
 end
 
+end is_fundamental_sequence
+
 /-- Every ordinal has a fundamental sequence. -/
 theorem exists_fundamental_sequence (a : ordinal.{u}) :
   ∃ f, is_fundamental_sequence a a.cof.ord f :=
 begin
-  suffices : ∃ o f, is_fundamental_sequence a o f,
-  { rcases this with ⟨o, f, hf⟩,
-    convert exists.intro f hf;
-    rw hf.cof_eq },
+  rsuffices ⟨o, f, hf⟩ : ∃ o f, is_fundamental_sequence a o f,
+  { exact ⟨_, hf.ord_cof⟩ },
   rcases exists_lsub_cof a with ⟨ι, f, hf, hι⟩,
   rcases ord_eq ι with ⟨r, wo, hr⟩,
   haveI := wo,
   let r' := subrel r {i | ∀ j, r j i → f j < f i},
   let hrr' : r' ↪r r := subrel.rel_embedding _ _,
   haveI := hrr'.is_well_order,
-  refine ⟨_, _, (type_le'.2 ⟨hrr'⟩).trans _, λ i j _ h _, (enum r' j h).prop _ _,
+  refine ⟨_, _, hrr'.ordinal_type_le.trans _, λ i j _ h _, (enum r' j h).prop _ _,
     le_antisymm (blsub_le (λ i hi, lsub_le_iff.1 hf.le _)) _⟩,
   { rw [←hι, hr] },
   { change r (hrr'.1 _ ) (hrr'.1 _ ),
     rwa [hrr'.2, @enum_lt_enum _ r'] },
   { rw [←hf, lsub_le_iff],
     intro i,
-    suffices : ∃ i' hi', f i ≤ bfamily_of_family' r' (λ i, f i) i' hi',
-    { rcases this with ⟨i', hi', hfg⟩,
-      exact hfg.trans_lt (lt_blsub _ _ _) },
+    rsuffices ⟨i', hi', hfg⟩ : ∃ i' hi', f i ≤ bfamily_of_family' r' (λ i, f i) i' hi',
+    { exact hfg.trans_lt (lt_blsub _ _ _) },
     by_cases h : ∀ j, r j i → f j < f i,
     { refine ⟨typein r' ⟨i, h⟩, typein_lt_type _ _, _⟩,
       rw bfamily_of_family'_typein,
@@ -499,15 +550,15 @@ begin
       have := lt_lsub.{u u} f' i,
       rwa [hf', ←is_normal.blsub_eq.{u u} hf ha, lt_blsub_iff] at this
     end,
-    refine le_antisymm (lsub_le (λ i, _)) (le_of_forall_lt (λ b hb, _)),
+    refine (lsub_le (λ i, _)).antisymm (le_of_forall_lt (λ b hb, _)),
     { rcases H i with ⟨b, hb, hb'⟩,
       exact lt_of_le_of_lt (cInf_le' hb') hb },
     { have := hf.strict_mono hb,
       rw [←hf', lt_lsub_iff] at this,
       cases this with i hi,
       rcases H i with ⟨b, _, hb⟩,
-      exact lt_of_le_of_lt ((le_cInf_iff'' ⟨b, hb⟩).2
-        (λ c hc, hf.strict_mono.le_iff_le.1 (hi.trans hc))) (lt_lsub _ i) } },
+      exact ((le_cInf_iff'' ⟨b, hb⟩).2 (λ c hc, hf.strict_mono.le_iff_le.1 (hi.trans hc))).trans_lt
+        (lt_lsub _ i) } },
   { rw @blsub_comp.{u u u} a _ (λ b _, f b) (λ i j hi hj h, hf.strict_mono.monotone h) g hg.2.2,
     exact is_normal.blsub_eq.{u u} hf ha }
 end
@@ -534,18 +585,18 @@ end
   { exact (add_is_normal a).cof_eq hb }
 end
 
-theorem omega_le_cof {o} : ω ≤ cof o ↔ is_limit o :=
+theorem aleph_0_le_cof {o} : ℵ₀ ≤ cof o ↔ is_limit o :=
 begin
   rcases zero_or_succ_or_limit o with rfl|⟨o,rfl⟩|l,
-  { simp [not_zero_is_limit, cardinal.omega_ne_zero] },
-  { simp [not_succ_is_limit, cardinal.one_lt_omega] },
+  { simp [not_zero_is_limit, cardinal.aleph_0_ne_zero] },
+  { simp [not_succ_is_limit, cardinal.one_lt_aleph_0] },
   { simp [l], refine le_of_not_lt (λ h, _),
-    cases cardinal.lt_omega.1 h with n e,
+    cases cardinal.lt_aleph_0.1 h with n e,
     have := cof_cof o,
     rw [e, ord_nat] at this,
     cases n,
     { simp at e, simpa [e, not_zero_is_limit] using l },
-    { rw [← nat_cast_succ, cof_succ] at this,
+    { rw [nat_cast_succ, cof_succ] at this,
       rw [← this, cof_eq_one_iff_is_succ] at e,
       rcases e with ⟨a, rfl⟩,
       exact not_succ_is_limit _ l } }
@@ -557,10 +608,8 @@ aleph'_is_normal.cof_eq ho
 @[simp] theorem aleph_cof {o : ordinal} (ho : o.is_limit) : (aleph o).ord.cof = o.cof :=
 aleph_is_normal.cof_eq ho
 
-@[simp] theorem cof_omega : cof omega = ω :=
-le_antisymm
-  (by rw ← card_omega; apply cof_le_card)
-  (omega_le_cof.2 omega_is_limit)
+@[simp] theorem cof_omega : cof ω = ℵ₀ :=
+(aleph_0_le_cof.2 omega_is_limit).antisymm' $ by { rw ←card_omega, apply cof_le_card }
 
 theorem cof_eq' (r : α → α → Prop) [is_well_order α r] (h : is_limit (type r)) :
   ∃ S : set α, (∀ a, ∃ b ∈ S, r a b) ∧ #S = cof (type r) :=
@@ -569,7 +618,7 @@ let ⟨S, H, e⟩ := cof_eq r in
   let a' := enum r _ (h.2 _ (typein_lt_type r a)) in
   let ⟨b, h, ab⟩ := H a' in
   ⟨b, h, (is_order_connected.conn a b a' $ (typein_lt_typein r).1
-    (by rw typein_enum; apply ordinal.lt_succ_self)).resolve_right ab⟩,
+    (by { rw typein_enum, exact lt_succ (typein _ _) })).resolve_right ab⟩,
 e⟩
 
 @[simp] theorem cof_univ : cof univ.{u v} = cardinal.univ :=
@@ -586,7 +635,7 @@ le_antisymm (cof_le_card _) begin
   let g := λ a, (f a).1,
   let o := succ (sup.{u u} g),
   rcases H o with ⟨b, h, l⟩,
-  refine l (lt_succ.2 _),
+  refine l (lt_succ_iff.2 _),
   rw ← show g (f.symm ⟨b, h⟩) = b, by dsimp [g]; simp,
   apply le_sup
 end
@@ -596,66 +645,63 @@ end
 /-- If the union of s is unbounded and s is smaller than the cofinality,
   then s has an unbounded member -/
 theorem unbounded_of_unbounded_sUnion (r : α → α → Prop) [wo : is_well_order α r] {s : set (set α)}
-  (h₁ : unbounded r $ ⋃₀ s) (h₂ : #s < strict_order.cof r) : ∃(x ∈ s), unbounded r x :=
+  (h₁ : unbounded r $ ⋃₀ s) (h₂ : #s < strict_order.cof r) : ∃ x ∈ s, unbounded r x :=
 begin
-  by_contra h, simp only [not_exists, exists_prop, not_and, not_unbounded_iff] at h,
-  apply not_le_of_lt h₂,
+  by_contra' h,
+  simp_rw not_unbounded_iff at h,
   let f : s → α := λ x : s, wo.wf.sup x (h x.1 x.2),
-  let t : set α := range f,
-  have : #t ≤ #s, exact mk_range_le, refine le_trans _ this,
-  have : unbounded r t,
-  { intro x, rcases h₁ x with ⟨y, ⟨c, hc, hy⟩, hxy⟩,
-    refine ⟨f ⟨c, hc⟩, mem_range_self _, _⟩, intro hxz, apply hxy,
-    refine trans (wo.wf.lt_sup _ hy) hxz },
-  exact cardinal.min_le _ (subtype.mk t this)
+  refine h₂.not_le (le_trans (cInf_le' ⟨range f, λ x, _, rfl⟩) mk_range_le),
+  rcases h₁ x with ⟨y, ⟨c, hc, hy⟩, hxy⟩,
+  exact ⟨f ⟨c, hc⟩, mem_range_self _, λ hxz, hxy (trans (wo.wf.lt_sup _ hy) hxz)⟩
 end
 
 /-- If the union of s is unbounded and s is smaller than the cofinality,
   then s has an unbounded member -/
 theorem unbounded_of_unbounded_Union {α β : Type u} (r : α → α → Prop) [wo : is_well_order α r]
   (s : β → set α)
-  (h₁ : unbounded r $ ⋃x, s x) (h₂ : #β < strict_order.cof r) : ∃x : β, unbounded r (s x) :=
+  (h₁ : unbounded r $ ⋃ x, s x) (h₂ : #β < strict_order.cof r) : ∃ x : β, unbounded r (s x) :=
 begin
-  rw [← sUnion_range] at h₁,
-  have : #(range (λ (i : β), s i)) < strict_order.cof r := lt_of_le_of_lt mk_range_le h₂,
-  rcases unbounded_of_unbounded_sUnion r h₁ this with ⟨_, ⟨x, rfl⟩, u⟩, exact ⟨x, u⟩
+  rw ←sUnion_range at h₁,
+  rcases unbounded_of_unbounded_sUnion r h₁ (mk_range_le.trans_lt h₂) with ⟨_, ⟨x, rfl⟩, u⟩,
+  exact ⟨x, u⟩
 end
 
 /-- The infinite pigeonhole principle -/
-theorem infinite_pigeonhole {β α : Type u} (f : β → α) (h₁ : ω ≤ #β)
-  (h₂ : #α < (#β).ord.cof) : ∃a : α, #(f ⁻¹' {a}) = #β :=
+theorem infinite_pigeonhole {β α : Type u} (f : β → α) (h₁ : ℵ₀ ≤ #β)
+  (h₂ : #α < (#β).ord.cof) : ∃ a : α, #(f ⁻¹' {a}) = #β :=
 begin
-  have : ¬∀a, #(f ⁻¹' {a}) < #β,
-  { intro h,
-    apply not_lt_of_ge (ge_of_eq $ mk_univ),
-    rw [←@preimage_univ _ _ f, ←Union_of_singleton, preimage_Union],
-    exact mk_Union_le_sum_mk.trans_lt ((sum_le_sup _).trans_lt $ mul_lt_of_lt h₁
-      (h₂.trans_le $ cof_ord_le _) (sup_lt h₂ h)) },
-  rw [not_forall] at this, cases this with x h,
-  use x, apply le_antisymm _ (le_of_not_gt h),
-  rw [le_mk_iff_exists_set], exact ⟨_, rfl⟩
+  have : ∃ a, #β ≤ #(f ⁻¹' {a}),
+  { by_contra' h,
+    apply mk_univ.not_lt,
+    rw [←preimage_univ, ←Union_of_singleton, preimage_Union],
+    exact mk_Union_le_sum_mk.trans_lt ((sum_le_supr _).trans_lt $ mul_lt_of_lt h₁
+      (h₂.trans_le $ cof_ord_le _) (supr_lt h₂ h)) },
+  cases this with x h,
+  refine ⟨x, h.antisymm' _⟩,
+  rw le_mk_iff_exists_set,
+  exact ⟨_, rfl⟩
 end
 
-/-- pigeonhole principle for a cardinality below the cardinality of the domain -/
+/-- Pigeonhole principle for a cardinality below the cardinality of the domain -/
 theorem infinite_pigeonhole_card {β α : Type u} (f : β → α) (θ : cardinal) (hθ : θ ≤ #β)
-  (h₁ : ω ≤ θ) (h₂ : #α < θ.ord.cof) : ∃a : α, θ ≤ #(f ⁻¹' {a}) :=
+  (h₁ : ℵ₀ ≤ θ) (h₂ : #α < θ.ord.cof) : ∃ a : α, θ ≤ #(f ⁻¹' {a}) :=
 begin
   rcases le_mk_iff_exists_set.1 hθ with ⟨s, rfl⟩,
   cases infinite_pigeonhole (f ∘ subtype.val : s → α) h₁ h₂ with a ha,
   use a, rw [←ha, @preimage_comp _ _ _ subtype.val f],
-  apply mk_preimage_of_injective _ _ subtype.val_injective
+  exact mk_preimage_of_injective _ _ subtype.val_injective
 end
 
 theorem infinite_pigeonhole_set {β α : Type u} {s : set β} (f : s → α) (θ : cardinal)
-  (hθ : θ ≤ #s) (h₁ : ω ≤ θ) (h₂ : #α < θ.ord.cof) :
-    ∃(a : α) (t : set β) (h : t ⊆ s), θ ≤ #t ∧ ∀{{x}} (hx : x ∈ t), f ⟨x, h hx⟩ = a :=
+  (hθ : θ ≤ #s) (h₁ : ℵ₀ ≤ θ) (h₂ : #α < θ.ord.cof) :
+    ∃ (a : α) (t : set β) (h : t ⊆ s), θ ≤ #t ∧ ∀ {{x}} (hx : x ∈ t), f ⟨x, h hx⟩ = a :=
 begin
   cases infinite_pigeonhole_card f θ hθ h₁ h₂ with a ha,
-  refine ⟨a, {x | ∃(h : x ∈ s), f ⟨x, h⟩ = a}, _, _, _⟩,
+  refine ⟨a, {x | ∃ h, f ⟨x, h⟩ = a}, _, _, _⟩,
   { rintro x ⟨hx, hx'⟩, exact hx },
-  { refine le_trans ha _, apply ge_of_eq, apply quotient.sound, constructor,
-    refine equiv.trans _ (equiv.subtype_subtype_equiv_subtype_exists _ _).symm,
-    simp only [set_coe_eq_subtype, mem_singleton_iff, mem_preimage, mem_set_of_eq] },
+  { refine ha.trans (ge_of_eq $ quotient.sound ⟨equiv.trans _
+      (equiv.subtype_subtype_equiv_subtype_exists _ _).symm⟩),
+    simp only [coe_eq_subtype, mem_singleton_iff, mem_preimage, mem_set_of_eq] },
   rintro x ⟨hx, hx'⟩, exact hx'
 end
 
@@ -666,86 +712,155 @@ end ordinal
 namespace cardinal
 open ordinal
 
-local infixr ^ := @pow cardinal.{u} cardinal cardinal.has_pow
-
-/-- A cardinal is a limit if it is not zero or a successor
-  cardinal. Note that `ω` is a limit cardinal by this definition. -/
-def is_limit (c : cardinal) : Prop :=
-c ≠ 0 ∧ ∀ x < c, succ x < c
+local infixr (name := cardinal.pow) ^ := @pow cardinal.{u} cardinal cardinal.has_pow
 
 /-- A cardinal is a strong limit if it is not zero and it is
-  closed under powersets. Note that `ω` is a strong limit by this definition. -/
+  closed under powersets. Note that `ℵ₀` is a strong limit by this definition. -/
 def is_strong_limit (c : cardinal) : Prop :=
 c ≠ 0 ∧ ∀ x < c, 2 ^ x < c
 
+theorem is_strong_limit.ne_zero {c} (h : is_strong_limit c) : c ≠ 0 :=
+h.1
+
+theorem is_strong_limit.two_power_lt {x c} (h : is_strong_limit c) : x < c → 2 ^ x < c :=
+h.2 x
+
+theorem is_strong_limit_aleph_0 : is_strong_limit ℵ₀ :=
+⟨aleph_0_ne_zero, λ x hx, begin
+  rcases lt_aleph_0.1 hx with ⟨n, rfl⟩,
+  exact_mod_cast nat_lt_aleph_0 (pow 2 n)
+end⟩
+
+protected theorem is_strong_limit.is_succ_limit {c} (H : is_strong_limit c) : is_succ_limit c :=
+is_succ_limit_of_succ_lt $ λ x h, (succ_le_of_lt $ cantor x).trans_lt (H.two_power_lt h)
+
 theorem is_strong_limit.is_limit {c} (H : is_strong_limit c) : is_limit c :=
-⟨H.1, λ x h, lt_of_le_of_lt (succ_le.2 $ cantor _) (H.2 _ h)⟩
+⟨H.ne_zero, H.is_succ_limit⟩
+
+theorem is_strong_limit_beth {o : ordinal} (H : is_succ_limit o) : is_strong_limit (beth o) :=
+begin
+  rcases eq_or_ne o 0 with rfl | h,
+  { rw beth_zero,
+    exact is_strong_limit_aleph_0 },
+  { refine ⟨beth_ne_zero o, λ a ha, _⟩,
+    rw beth_limit ⟨h, is_succ_limit_iff_succ_lt.1 H⟩ at ha,
+    rcases exists_lt_of_lt_csupr' ha with ⟨⟨i, hi⟩, ha⟩,
+    have := power_le_power_left two_ne_zero ha.le,
+    rw ←beth_succ at this,
+    exact this.trans_lt (beth_lt.2 (H.succ_lt hi)) }
+end
+
+theorem mk_bounded_subset {α : Type*} (h : ∀ x < #α, 2 ^ x < #α) {r : α → α → Prop}
+  [is_well_order α r] (hr : (#α).ord = type r) : #{s : set α // bounded r s} = #α :=
+begin
+  rcases eq_or_ne (#α) 0 with ha | ha,
+  { rw ha,
+    haveI := mk_eq_zero_iff.1 ha,
+    rw mk_eq_zero_iff,
+    split,
+    rintro ⟨s, hs⟩,
+    exact (not_unbounded_iff s).2 hs (unbounded_of_is_empty s) },
+  have h' : is_strong_limit (#α) := ⟨ha, h⟩,
+  have ha := h'.is_limit.aleph_0_le,
+  apply le_antisymm,
+  { have : {s : set α | bounded r s} = ⋃ i, 𝒫 {j | r j i} := set_of_exists _,
+    rw [←coe_set_of, this],
+    convert mk_Union_le_sum_mk.trans ((sum_le_supr _).trans (mul_le_max_of_aleph_0_le_left ha)),
+    apply (max_eq_left _).symm, apply csupr_le' (λ i, _),
+    rw mk_powerset,
+    apply (h'.two_power_lt _).le,
+    rw [coe_set_of, card_typein, ←lt_ord, hr],
+    apply typein_lt_type },
+  { refine @mk_le_of_injective α _ (λ x, subtype.mk {x} _) _,
+    { apply bounded_singleton,
+      rw ←hr,
+      apply ord_is_limit ha },
+    { intros a b hab,
+      simpa only [singleton_eq_singleton_iff] using hab } }
+end
+
+theorem mk_subset_mk_lt_cof {α : Type*} (h : ∀ x < #α, 2 ^ x < #α) :
+  #{s : set α // #s < cof (#α).ord} = #α :=
+begin
+  rcases eq_or_ne (#α) 0 with ha | ha,
+  { rw ha,
+    simp [λ s, (cardinal.zero_le s).not_lt] },
+  have h' : is_strong_limit (#α) := ⟨ha, h⟩,
+  rcases ord_eq α with ⟨r, wo, hr⟩,
+  haveI := wo,
+  apply le_antisymm,
+  { nth_rewrite_rhs 0 ←mk_bounded_subset h hr,
+    apply mk_le_mk_of_subset (λ s hs, _),
+    rw hr at hs,
+    exact lt_cof_type hs },
+  { refine @mk_le_of_injective α _ (λ x, subtype.mk {x} _) _,
+    { rw mk_singleton,
+      exact one_lt_aleph_0.trans_le (aleph_0_le_cof.2 (ord_is_limit h'.is_limit.aleph_0_le)) },
+    { intros a b hab,
+      simpa only [singleton_eq_singleton_iff] using hab } }
+end
 
 /-- A cardinal is regular if it is infinite and it equals its own cofinality. -/
 def is_regular (c : cardinal) : Prop :=
-ω ≤ c ∧ c.ord.cof = c
+ℵ₀ ≤ c ∧ c ≤ c.ord.cof
 
-lemma is_regular.omega_le {c : cardinal} (H : c.is_regular) : ω ≤ c :=
+lemma is_regular.aleph_0_le {c : cardinal} (H : c.is_regular) : ℵ₀ ≤ c :=
 H.1
 
 lemma is_regular.cof_eq {c : cardinal} (H : c.is_regular) : c.ord.cof = c :=
-H.2
+(cof_ord_le c).antisymm H.2
 
 lemma is_regular.pos {c : cardinal} (H : c.is_regular) : 0 < c :=
-omega_pos.trans_le H.1
+aleph_0_pos.trans_le H.1
 
 lemma is_regular.ord_pos {c : cardinal} (H : c.is_regular) : 0 < c.ord :=
 by { rw cardinal.lt_ord, exact H.pos }
 
 theorem is_regular_cof {o : ordinal} (h : o.is_limit) : is_regular o.cof :=
-⟨omega_le_cof.2 h, cof_cof _⟩
+⟨aleph_0_le_cof.2 h, (cof_cof o).ge⟩
 
-theorem is_regular_omega : is_regular ω :=
+theorem is_regular_aleph_0 : is_regular ℵ₀ :=
 ⟨le_rfl, by simp⟩
 
-theorem is_regular_succ {c : cardinal.{u}} (h : ω ≤ c) : is_regular (succ c) :=
-⟨le_trans h (le_of_lt $ lt_succ_self _), begin
-  refine le_antisymm (cof_ord_le _) (succ_le.2 _),
-  cases quotient.exists_rep (succ c) with α αe, simp at αe,
+theorem is_regular_succ {c : cardinal.{u}} (h : ℵ₀ ≤ c) : is_regular (succ c) :=
+⟨h.trans (le_succ c), succ_le_of_lt begin
+  cases quotient.exists_rep (@succ cardinal _ _ c) with α αe, simp at αe,
   rcases ord_eq α with ⟨r, wo, re⟩, resetI,
-  have := ord_is_limit (le_trans h $ le_of_lt $ lt_succ_self _),
+  have := ord_is_limit (h.trans (le_succ _)),
   rw [← αe, re] at this ⊢,
   rcases cof_eq' r this with ⟨S, H, Se⟩,
   rw [← Se],
-  apply lt_imp_lt_of_le_imp_le
-    (λ (h : #S ≤ c), mul_le_mul_right' h c),
-  rw [mul_eq_self h, ← succ_le, ← αe, ← sum_const'],
-  refine le_trans _ (sum_le_sum (λ x:S, card (typein r x)) _ _),
+  apply lt_imp_lt_of_le_imp_le (λ h, mul_le_mul_right' h c),
+  rw [mul_eq_self h, ← succ_le_iff, ← αe, ← sum_const'],
+  refine le_trans _ (sum_le_sum (λ x, card (typein r x)) _ (λ i, _)),
   { simp only [← card_typein, ← mk_sigma],
-    refine ⟨embedding.of_surjective _ _⟩,
-    { exact λ x, x.2.1 },
-    { exact λ a, let ⟨b, h, ab⟩ := H a in ⟨⟨⟨_, h⟩, _, ab⟩, rfl⟩ } },
-  { intro i,
-    rw [← lt_succ, ← lt_ord, ← αe, re],
+    exact ⟨embedding.of_surjective (λ x, x.2.1)
+      (λ a, let ⟨b, h, ab⟩ := H a in ⟨⟨⟨_, h⟩, _, ab⟩, rfl⟩)⟩ },
+  { rw [← lt_succ_iff, ← lt_ord, ← αe, re],
     apply typein_lt_type }
 end⟩
 
 theorem is_regular_aleph_one : is_regular (aleph 1) :=
-by { rw ← succ_omega, exact is_regular_succ le_rfl }
+by { rw ←succ_aleph_0, exact is_regular_succ le_rfl }
 
-theorem is_regular_aleph'_succ {o : ordinal} (h : ordinal.omega ≤ o) : is_regular (aleph' o.succ) :=
-by { rw aleph'_succ, exact is_regular_succ (omega_le_aleph'.2 h) }
+theorem is_regular_aleph'_succ {o : ordinal} (h : ω ≤ o) : is_regular (aleph' (succ o)) :=
+by { rw aleph'_succ, exact is_regular_succ (aleph_0_le_aleph'.2 h) }
 
-theorem is_regular_aleph_succ (o : ordinal) : is_regular (aleph o.succ) :=
-by { rw aleph_succ, exact is_regular_succ (omega_le_aleph o) }
+theorem is_regular_aleph_succ (o : ordinal) : is_regular (aleph (succ o)) :=
+by { rw aleph_succ, exact is_regular_succ (aleph_0_le_aleph o) }
 
 /--
 A function whose codomain's cardinality is infinite but strictly smaller than its domain's
 has a fiber with cardinality strictly great than the codomain.
 -/
 theorem infinite_pigeonhole_card_lt {β α : Type u} (f : β → α)
-  (w : #α < #β) (w' : ω ≤ #α) :
+  (w : #α < #β) (w' : ℵ₀ ≤ #α) :
   ∃ a : α, #α < #(f ⁻¹' {a}) :=
 begin
-  simp_rw [← succ_le],
-  exact ordinal.infinite_pigeonhole_card f (#α).succ (succ_le.mpr w)
-    (w'.trans (lt_succ_self _).le)
-    ((lt_succ_self _).trans_le (is_regular_succ w').2.ge),
+  simp_rw [← succ_le_iff],
+  exact ordinal.infinite_pigeonhole_card f (succ (#α)) (succ_le_of_lt w)
+    (w'.trans (lt_succ _).le)
+    ((lt_succ _).trans_le (is_regular_succ w').2.ge),
 end
 
 /--
@@ -790,66 +905,129 @@ end
 
 theorem lsub_lt_ord_lift_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c)
   (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c.ord) → ordinal.lsub f < c.ord :=
-lsub_lt_ord_lift (by rwa hc.2)
+lsub_lt_ord_lift (by rwa hc.cof_eq)
 
 theorem lsub_lt_ord_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c) (hι : #ι < c) :
   (∀ i, f i < c.ord) → ordinal.lsub f < c.ord :=
-lsub_lt_ord (by rwa hc.2)
+lsub_lt_ord (by rwa hc.cof_eq)
 
 theorem sup_lt_ord_lift_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c)
   (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c.ord) → ordinal.sup f < c.ord :=
-sup_lt_ord_lift (by rwa hc.2)
+sup_lt_ord_lift (by rwa hc.cof_eq)
 
 theorem sup_lt_ord_of_is_regular {ι} {f : ι → ordinal} {c} (hc : is_regular c) (hι : #ι < c) :
   (∀ i, f i < c.ord) → ordinal.sup f < c.ord :=
-sup_lt_ord (by rwa hc.2)
+sup_lt_ord (by rwa hc.cof_eq)
 
 theorem blsub_lt_ord_lift_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
   (ho : cardinal.lift o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.blsub o f < c.ord :=
-blsub_lt_ord_lift (by rwa hc.2)
+blsub_lt_ord_lift (by rwa hc.cof_eq)
 
 theorem blsub_lt_ord_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
   (ho : o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.blsub o f < c.ord :=
-blsub_lt_ord (by rwa hc.2)
+blsub_lt_ord (by rwa hc.cof_eq)
 
 theorem bsup_lt_ord_lift_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
   (hι : cardinal.lift o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.bsup o f < c.ord :=
-bsup_lt_ord_lift (by rwa hc.2)
+bsup_lt_ord_lift (by rwa hc.cof_eq)
 
 theorem bsup_lt_ord_of_is_regular {o : ordinal} {f : Π a < o, ordinal} {c} (hc : is_regular c)
   (hι : o.card < c) : (∀ i hi, f i hi < c.ord) → ordinal.bsup o f < c.ord :=
-bsup_lt_ord (by rwa hc.2)
+bsup_lt_ord (by rwa hc.cof_eq)
 
-theorem sup_lt_lift_of_is_regular {ι} {f : ι → cardinal} {c} (hc : is_regular c)
-  (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c) → sup.{u v} f < c :=
-sup_lt_lift (by rwa hc.2)
+theorem supr_lt_lift_of_is_regular {ι} {f : ι → cardinal} {c} (hc : is_regular c)
+  (hι : cardinal.lift (#ι) < c) : (∀ i, f i < c) → supr f < c :=
+supr_lt_lift (by rwa hc.cof_eq)
 
-theorem sup_lt_of_is_regular {ι} {f : ι → cardinal} {c} (hc : is_regular c) (hι : #ι < c) :
-  (∀ i, f i < c) → sup.{u u} f < c :=
-sup_lt (by rwa hc.2)
+theorem supr_lt_of_is_regular {ι} {f : ι → cardinal} {c} (hc : is_regular c) (hι : #ι < c) :
+  (∀ i, f i < c) → supr f < c :=
+supr_lt (by rwa hc.cof_eq)
 
 theorem sum_lt_lift_of_is_regular {ι : Type u} {f : ι → cardinal} {c : cardinal} (hc : is_regular c)
   (hι : cardinal.lift.{v u} (#ι) < c) (hf : ∀ i, f i < c) : sum f < c :=
-(sum_le_sup_lift _).trans_lt $ mul_lt_of_lt hc.1 hι (sup_lt_lift_of_is_regular hc hι hf)
+(sum_le_supr_lift _).trans_lt $ mul_lt_of_lt hc.1 hι (supr_lt_lift_of_is_regular hc hι hf)
 
 theorem sum_lt_of_is_regular {ι : Type u} {f : ι → cardinal} {c : cardinal} (hc : is_regular c)
   (hι : #ι < c) : (∀ i, f i < c) → sum f < c :=
 sum_lt_lift_of_is_regular.{u u} hc (by rwa lift_id)
 
+theorem nfp_family_lt_ord_lift_of_is_regular {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
+  (hι : (#ι).lift < c) (hc' : c ≠ ℵ₀) (hf : ∀ i (b < c.ord), f i b < c.ord) {a} (ha : a < c.ord) :
+  nfp_family.{u v} f a < c.ord :=
+by { apply nfp_family_lt_ord_lift _ _ hf ha; rwa hc.cof_eq, exact lt_of_le_of_ne hc.1 hc'.symm }
+
+theorem nfp_family_lt_ord_of_is_regular {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
+  (hι : #ι < c) (hc' : c ≠ ℵ₀) {a} (hf : ∀ i (b < c.ord), f i b < c.ord) :
+  a < c.ord → nfp_family.{u u} f a < c.ord :=
+nfp_family_lt_ord_lift_of_is_regular hc (by rwa lift_id) hc' hf
+
+theorem nfp_bfamily_lt_ord_lift_of_is_regular {o : ordinal} {f : Π a < o, ordinal → ordinal} {c}
+  (hc : is_regular c) (ho : o.card.lift < c) (hc' : c ≠ ℵ₀)
+  (hf : ∀ i hi (b < c.ord), f i hi b < c.ord) {a} : a < c.ord → nfp_bfamily.{u v} o f a < c.ord :=
+nfp_family_lt_ord_lift_of_is_regular hc (by rwa mk_ordinal_out) hc' (λ i, hf _ _)
+
+theorem nfp_bfamily_lt_ord_of_is_regular {o : ordinal} {f : Π a < o, ordinal → ordinal} {c}
+  (hc : is_regular c) (ho : o.card < c) (hc' : c ≠ ℵ₀) (hf : ∀ i hi (b < c.ord), f i hi b < c.ord)
+  {a} : a < c.ord → nfp_bfamily.{u u} o f a < c.ord :=
+nfp_bfamily_lt_ord_lift_of_is_regular hc (by rwa lift_id) hc' hf
+
+theorem nfp_lt_ord_of_is_regular {f : ordinal → ordinal} {c} (hc : is_regular c) (hc' : c ≠ ℵ₀)
+  (hf : ∀ i < c.ord, f i < c.ord) {a} : (a < c.ord) → nfp f a < c.ord :=
+nfp_lt_ord (by { rw hc.cof_eq, exact lt_of_le_of_ne hc.1 hc'.symm }) hf
+
+theorem deriv_family_lt_ord_lift {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
+  (hι : (#ι).lift < c) (hc' : c ≠ ℵ₀) (hf : ∀ i (b < c.ord), f i b < c.ord) {a} :
+  a < c.ord → deriv_family.{u v} f a < c.ord :=
+begin
+  have hω : ℵ₀ < c.ord.cof,
+  { rw hc.cof_eq, exact lt_of_le_of_ne hc.1 hc'.symm },
+  apply a.limit_rec_on,
+  { rw deriv_family_zero,
+    exact nfp_family_lt_ord_lift hω (by rwa hc.cof_eq) hf },
+  { intros b hb hb',
+    rw deriv_family_succ,
+    exact nfp_family_lt_ord_lift hω (by rwa hc.cof_eq) hf
+      ((ord_is_limit hc.1).2 _ (hb ((lt_succ b).trans hb'))) },
+  { intros b hb H hb',
+    rw deriv_family_limit f hb,
+    exact bsup_lt_ord_of_is_regular hc (ord_lt_ord.1 ((ord_card_le b).trans_lt hb'))
+      (λ o' ho', H o' ho' (ho'.trans hb')) }
+end
+
+theorem deriv_family_lt_ord {ι} {f : ι → ordinal → ordinal} {c} (hc : is_regular c)
+  (hι : #ι < c) (hc' : c ≠ ℵ₀) (hf : ∀ i (b < c.ord), f i b < c.ord) {a} :
+  a < c.ord → deriv_family.{u u} f a < c.ord :=
+deriv_family_lt_ord_lift hc (by rwa lift_id) hc' hf
+
+theorem deriv_bfamily_lt_ord_lift {o : ordinal} {f : Π a < o, ordinal → ordinal} {c}
+  (hc : is_regular c) (hι : o.card.lift < c) (hc' : c ≠ ℵ₀)
+  (hf : ∀ i hi (b < c.ord), f i hi b < c.ord) {a} :
+  a < c.ord → deriv_bfamily.{u v} o f a < c.ord :=
+deriv_family_lt_ord_lift hc (by rwa mk_ordinal_out) hc' (λ i, hf _ _)
+
+theorem deriv_bfamily_lt_ord {o : ordinal} {f : Π a < o, ordinal → ordinal} {c} (hc : is_regular c)
+  (hι : o.card < c) (hc' : c ≠ ℵ₀) (hf : ∀ i hi (b < c.ord), f i hi b < c.ord)
+  {a} : a < c.ord → deriv_bfamily.{u u} o f a < c.ord :=
+deriv_bfamily_lt_ord_lift hc (by rwa lift_id) hc' hf
+
+theorem deriv_lt_ord {f : ordinal.{u} → ordinal} {c} (hc : is_regular c) (hc' : c ≠ ℵ₀)
+  (hf : ∀ i < c.ord, f i < c.ord) {a} : a < c.ord → deriv f a < c.ord :=
+deriv_family_lt_ord_lift hc
+  (by simpa using cardinal.one_lt_aleph_0.trans (lt_of_le_of_ne hc.1 hc'.symm))
+  hc' (λ _, hf)
+
 /-- A cardinal is inaccessible if it is an uncountable regular strong limit cardinal. -/
 def is_inaccessible (c : cardinal) :=
-ω < c ∧ is_regular c ∧ is_strong_limit c
+ℵ₀ < c ∧ is_regular c ∧ is_strong_limit c
 
-theorem is_inaccessible.mk {c}
- (h₁ : ω < c) (h₂ : c ≤ c.ord.cof) (h₃ : ∀ x < c, 2 ^ x < c) :
- is_inaccessible c :=
-⟨h₁, ⟨le_of_lt h₁, le_antisymm (cof_ord_le _) h₂⟩,
-  ne_of_gt (lt_trans omega_pos h₁), h₃⟩
+theorem is_inaccessible.mk {c} (h₁ : ℵ₀ < c) (h₂ : c ≤ c.ord.cof) (h₃ : ∀ x < c, 2 ^ x < c) :
+  is_inaccessible c :=
+⟨h₁, ⟨h₁.le, h₂⟩, (aleph_0_pos.trans h₁).ne', h₃⟩
 
-/- Lean's foundations prove the existence of ω many inaccessible cardinals -/
+/- Lean's foundations prove the existence of ℵ₀ many inaccessible cardinals -/
 theorem univ_inaccessible : is_inaccessible (univ.{u v}) :=
 is_inaccessible.mk
-  (by simpa using lift_lt_univ' ω)
+  (by simpa using lift_lt_univ' ℵ₀)
   (by simp)
   (λ c h, begin
     rcases lt_univ'.1 h with ⟨c, rfl⟩,
@@ -857,7 +1035,7 @@ is_inaccessible.mk
     apply lift_lt_univ'
   end)
 
-theorem lt_power_cof {c : cardinal.{u}} : ω ≤ c → c < c ^ cof c.ord :=
+theorem lt_power_cof {c : cardinal.{u}} : ℵ₀ ≤ c → c < c ^ cof c.ord :=
 quotient.induction_on c $ λ α h, begin
   rcases ord_eq α with ⟨r, wo, re⟩, resetI,
   have := ord_is_limit h,
@@ -873,13 +1051,13 @@ quotient.induction_on c $ λ α h, begin
     rwa [← re, lt_ord] at this }
 end
 
-theorem lt_cof_power {a b : cardinal} (ha : ω ≤ a) (b1 : 1 < b) :
+theorem lt_cof_power {a b : cardinal} (ha : ℵ₀ ≤ a) (b1 : 1 < b) :
   a < cof (b ^ a).ord :=
 begin
-  have b0 : b ≠ 0 := ne_of_gt (lt_trans zero_lt_one b1),
+  have b0 : b ≠ 0 := (zero_lt_one.trans b1).ne',
   apply lt_imp_lt_of_le_imp_le (power_le_power_left $ power_ne_zero a b0),
-  rw [← power_mul, mul_eq_self ha],
-  exact lt_power_cof (le_trans ha $ le_of_lt $ cantor' _ b1),
+  rw [←power_mul, mul_eq_self ha],
+  exact lt_power_cof (ha.trans $ (cantor' _ b1).le),
 end
 
 end cardinal
diff --git a/src/set_theory/cardinal/continuum.lean b/src/set_theory/cardinal/continuum.lean
index 929e6a6369691..370883c8c72e3 100644
--- a/src/set_theory/cardinal/continuum.lean
+++ b/src/set_theory/cardinal/continuum.lean
@@ -8,7 +8,10 @@ import set_theory.cardinal.ordinal
 /-!
 # Cardinality of continuum
 
-In this file we define `cardinal.continuum` (notation: `𝔠`, localized in `cardinal`) to be `2 ^ ω`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define `cardinal.continuum` (notation: `𝔠`, localized in `cardinal`) to be `2 ^ ℵ₀`.
 We also prove some `simp` lemmas about cardinal arithmetic involving `𝔠`.
 
 ## Notation
@@ -23,24 +26,38 @@ universes u v
 open_locale cardinal
 
 /-- Cardinality of continuum. -/
-def continuum : cardinal.{u} := 2 ^ omega.{u}
+def continuum : cardinal.{u} := 2 ^ aleph_0.{u}
 
-localized "notation `𝔠` := cardinal.continuum" in cardinal
+localized "notation (name := cardinal.continuum) `𝔠` := cardinal.continuum" in cardinal
 
-@[simp] lemma two_power_omega : (2 ^ omega.{u} : cardinal.{u}) = 𝔠 := rfl
+@[simp] lemma two_power_aleph_0 : 2 ^ aleph_0.{u} = continuum.{u} := rfl
 
-@[simp] lemma lift_continuum : lift.{v} continuum.{u} = 𝔠 :=
-by rw [← two_power_omega, lift_two_power, lift_omega, two_power_omega]
+@[simp] lemma lift_continuum : lift.{v} 𝔠 = 𝔠 :=
+by rw [←two_power_aleph_0, lift_two_power, lift_aleph_0, two_power_aleph_0]
 
 /-!
 ### Inequalities
 -/
 
-lemma omega_lt_continuum : ω < 𝔠 := cantor ω
+@[simp] lemma continuum_le_lift {c : cardinal.{u}} : 𝔠 ≤ lift.{v} c ↔ 𝔠 ≤ c :=
+by rw [←lift_continuum, lift_le]
+
+@[simp] lemma lift_le_continuum {c : cardinal.{u}} : lift.{v} c ≤ 𝔠 ↔ c ≤ 𝔠 :=
+by rw [←lift_continuum, lift_le]
+
+@[simp] lemma continuum_lt_lift {c : cardinal.{u}} : 𝔠 < lift.{v} c ↔ 𝔠 < c :=
+by rw [←lift_continuum, lift_lt]
+
+@[simp] lemma lift_lt_continuum {c : cardinal.{u}} : lift.{v} c < 𝔠 ↔ c < 𝔠 :=
+by rw [←lift_continuum, lift_lt]
 
-lemma omega_le_continuum : ω ≤ 𝔠 := omega_lt_continuum.le
+lemma aleph_0_lt_continuum : ℵ₀ < 𝔠 := cantor ℵ₀
 
-lemma nat_lt_continuum (n : ℕ) : ↑n < 𝔠 := (nat_lt_omega n).trans omega_lt_continuum
+lemma aleph_0_le_continuum : ℵ₀ ≤ 𝔠 := aleph_0_lt_continuum.le
+
+@[simp] lemma beth_one : beth 1 = 𝔠 := by simpa using beth_succ 0
+
+lemma nat_lt_continuum (n : ℕ) : ↑n < 𝔠 := (nat_lt_aleph_0 n).trans aleph_0_lt_continuum
 
 lemma mk_set_nat : #(set ℕ) = 𝔠 := by simp
 
@@ -49,23 +66,29 @@ lemma continuum_pos : 0 < 𝔠 := nat_lt_continuum 0
 lemma continuum_ne_zero : 𝔠 ≠ 0 := continuum_pos.ne'
 
 lemma aleph_one_le_continuum : aleph 1 ≤ 𝔠 :=
-by { rw ← succ_omega, exact succ_le.2 omega_lt_continuum }
+by { rw ←succ_aleph_0, exact order.succ_le_of_lt aleph_0_lt_continuum }
+
+@[simp] theorem continuum_to_nat : continuum.to_nat = 0 :=
+to_nat_apply_of_aleph_0_le aleph_0_le_continuum
+
+@[simp] theorem continuum_to_part_enat : continuum.to_part_enat = ⊤ :=
+to_part_enat_apply_of_aleph_0_le aleph_0_le_continuum
 
 /-!
 ### Addition
 -/
 
-@[simp] lemma omega_add_continuum : ω + 𝔠 = 𝔠 :=
-add_eq_right omega_le_continuum omega_le_continuum
+@[simp] lemma aleph_0_add_continuum : ℵ₀ + 𝔠 = 𝔠 :=
+add_eq_right aleph_0_le_continuum aleph_0_le_continuum
 
-@[simp] lemma continuum_add_omega : 𝔠 + ω = 𝔠 :=
-(add_comm _ _).trans omega_add_continuum
+@[simp] lemma continuum_add_aleph_0 : 𝔠 + ℵ₀ = 𝔠 :=
+(add_comm _ _).trans aleph_0_add_continuum
 
 @[simp] lemma continuum_add_self : 𝔠 + 𝔠 = 𝔠 :=
-add_eq_right omega_le_continuum le_rfl
+add_eq_right aleph_0_le_continuum le_rfl
 
 @[simp] lemma nat_add_continuum (n : ℕ) : ↑n + 𝔠 = 𝔠 :=
-add_eq_right omega_le_continuum (nat_lt_continuum n).le
+add_eq_right aleph_0_le_continuum (nat_lt_continuum n).le
 
 @[simp] lemma continuum_add_nat (n : ℕ) : 𝔠 + n = 𝔠 :=
 (add_comm _ _).trans (nat_add_continuum n)
@@ -75,33 +98,31 @@ add_eq_right omega_le_continuum (nat_lt_continuum n).le
 -/
 
 @[simp] lemma continuum_mul_self : 𝔠 * 𝔠 = 𝔠 :=
-mul_eq_left omega_le_continuum le_rfl continuum_ne_zero
+mul_eq_left aleph_0_le_continuum le_rfl continuum_ne_zero
 
-@[simp] lemma continuum_mul_omega : 𝔠 * ω = 𝔠 :=
-mul_eq_left omega_le_continuum omega_le_continuum omega_ne_zero
+@[simp] lemma continuum_mul_aleph_0 : 𝔠 * ℵ₀ = 𝔠 :=
+mul_eq_left aleph_0_le_continuum aleph_0_le_continuum aleph_0_ne_zero
 
-@[simp] lemma omega_mul_continuum : ω * 𝔠 = 𝔠 :=
-(mul_comm _ _).trans continuum_mul_omega
+@[simp] lemma aleph_0_mul_continuum : ℵ₀ * 𝔠 = 𝔠 :=
+(mul_comm _ _).trans continuum_mul_aleph_0
 
-@[simp] lemma nat_mul_continuum {n : ℕ} (hn : n ≠ 0) :
-  ↑n * 𝔠 = 𝔠 :=
-mul_eq_right omega_le_continuum (nat_lt_continuum n).le (nat.cast_ne_zero.2 hn)
+@[simp] lemma nat_mul_continuum {n : ℕ} (hn : n ≠ 0) : ↑n * 𝔠 = 𝔠 :=
+mul_eq_right aleph_0_le_continuum (nat_lt_continuum n).le (nat.cast_ne_zero.2 hn)
 
-@[simp] lemma continuum_mul_nat {n : ℕ} (hn : n ≠ 0) :
-  𝔠 * n = 𝔠 :=
+@[simp] lemma continuum_mul_nat {n : ℕ} (hn : n ≠ 0) : 𝔠 * n = 𝔠 :=
 (mul_comm _ _).trans (nat_mul_continuum hn)
 
 /-!
 ### Power
 -/
 
-@[simp] lemma omega_power_omega : omega.{u} ^ omega.{u} = 𝔠 :=
+@[simp] lemma aleph_0_power_aleph_0 : aleph_0.{u} ^ aleph_0.{u} = 𝔠 :=
 power_self_eq le_rfl
 
-@[simp] lemma nat_power_omega {n : ℕ} (hn : 2 ≤ n) : (n ^ omega.{u} : cardinal.{u}) = 𝔠 :=
+@[simp] lemma nat_power_aleph_0 {n : ℕ} (hn : 2 ≤ n) : (n ^ aleph_0.{u} : cardinal.{u}) = 𝔠 :=
 nat_power_eq le_rfl hn
 
-@[simp] lemma continuum_power_omega : continuum.{u} ^ omega.{u} = 𝔠 :=
-by rw [← two_power_omega, ← power_mul, mul_eq_left le_rfl le_rfl omega_ne_zero]
+@[simp] lemma continuum_power_aleph_0 : continuum.{u} ^ aleph_0.{u} = 𝔠 :=
+by rw [←two_power_aleph_0, ←power_mul, mul_eq_left le_rfl le_rfl aleph_0_ne_zero]
 
 end cardinal
diff --git a/src/set_theory/cardinal/divisibility.lean b/src/set_theory/cardinal/divisibility.lean
index 0abd61ae6e5ba..361b70ec75526 100644
--- a/src/set_theory/cardinal/divisibility.lean
+++ b/src/set_theory/cardinal/divisibility.lean
@@ -10,17 +10,21 @@ import set_theory.cardinal.ordinal
 /-!
 # Cardinal Divisibility
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We show basic results about divisibility in the cardinal numbers. This relation can be characterised
-in the following simple way: if `a` and `b` are both less than `ω`, then `a ∣ b` iff they are
-divisible as natural numbers. If `b` is greater than `ω`, then `a ∣ b` iff `a ≤ b`. This furthermore
-shows that all infinite cardinals are prime; recall that `a * b = max a b` if `ω ≤ a * b`; therefore
-`a ∣ b * c = a ∣ max b c` and therefore clearly either `a ∣ b` or `a ∣ c`. Note furthermore that
-no infinite cardinal is irreducible (`cardinal.not_irreducible_of_omega_le`), showing that the
-cardinal numbers do not form a `comm_cancel_monoid_with_zero`.
+in the following simple way: if `a` and `b` are both less than `ℵ₀`, then `a ∣ b` iff they are
+divisible as natural numbers. If `b` is greater than `ℵ₀`, then `a ∣ b` iff `a ≤ b`. This
+furthermore shows that all infinite cardinals are prime; recall that `a * b = max a b` if
+`ℵ₀ ≤ a * b`; therefore `a ∣ b * c = a ∣ max b c` and therefore clearly either `a ∣ b` or `a ∣ c`.
+Note furthermore that no infinite cardinal is irreducible
+(`cardinal.not_irreducible_of_aleph_0_le`), showing that the cardinal numbers do not form a
+`comm_cancel_monoid_with_zero`.
 
 ## Main results
 
-* `cardinal.prime_of_omega_le`: a `cardinal` is prime if it is infinite.
+* `cardinal.prime_of_aleph_0_le`: a `cardinal` is prime if it is infinite.
 * `cardinal.is_prime_iff`: a `cardinal` is prime iff it is infinite or a prime natural number.
 * `cardinal.is_prime_pow_iff`: a `cardinal` is a prime power iff it is infinite or a natural number
   which is itself a prime power.
@@ -57,35 +61,38 @@ theorem le_of_dvd : ∀ {a b : cardinal}, b ≠ 0 → a ∣ b → a ≤ b
 | a _ b0 ⟨b, rfl⟩ := by simpa only [mul_one] using mul_le_mul_left'
   (one_le_iff_ne_zero.2 (λ h : b = 0, by simpa only [h, mul_zero] using b0)) a
 
-lemma dvd_of_le_of_omega_le (ha : a ≠ 0) (h : a ≤ b) (hb : ω ≤ b) : a ∣ b :=
+lemma dvd_of_le_of_aleph_0_le (ha : a ≠ 0) (h : a ≤ b) (hb : ℵ₀ ≤ b) : a ∣ b :=
 ⟨b, (mul_eq_right hb h ha).symm⟩
 
-@[simp] lemma prime_of_omega_le (ha : ω ≤ a) : prime a :=
+@[simp] lemma prime_of_aleph_0_le (ha : ℵ₀ ≤ a) : prime a :=
 begin
-  refine ⟨(omega_pos.trans_le ha).ne', _, λ b c hbc, _⟩,
+  refine ⟨(aleph_0_pos.trans_le ha).ne', _, λ b c hbc, _⟩,
   { rw is_unit_iff,
-    exact (one_lt_omega.trans_le ha).ne' },
+    exact (one_lt_aleph_0.trans_le ha).ne' },
   cases eq_or_ne (b * c) 0 with hz hz,
   { rcases mul_eq_zero.mp hz with rfl | rfl; simp },
   wlog h : c ≤ b,
+  { cases le_total c b; [skip, rw or_comm]; apply_assumption, assumption',
+    all_goals { rwa mul_comm } },
   left,
   have habc := le_of_dvd hz hbc,
-  rwa [mul_eq_max' $ ha.trans $ habc, max_def, if_pos h] at hbc
+  rwa [mul_eq_max' $ ha.trans $ habc, max_def', if_pos h] at hbc
 end
 
-lemma not_irreducible_of_omega_le (ha : ω ≤ a) : ¬irreducible a :=
+lemma not_irreducible_of_aleph_0_le (ha : ℵ₀ ≤ a) : ¬irreducible a :=
 begin
   rw [irreducible_iff, not_and_distrib],
   refine or.inr (λ h, _),
-  simpa [mul_omega_eq ha, is_unit_iff, (one_lt_omega.trans_le ha).ne', one_lt_omega.ne'] using h a ω
+  simpa [mul_aleph_0_eq ha, is_unit_iff, (one_lt_aleph_0.trans_le ha).ne', one_lt_aleph_0.ne']
+    using h a ℵ₀
 end
 
 @[simp, norm_cast] lemma nat_coe_dvd_iff : (n : cardinal) ∣ m ↔ n ∣ m :=
 begin
   refine ⟨_, λ ⟨h, ht⟩, ⟨h, by exact_mod_cast ht⟩⟩,
   rintro ⟨k, hk⟩,
-  have : ↑m < ω := nat_lt_omega m,
-  rw [hk, mul_lt_omega_iff] at this,
+  have : ↑m < ℵ₀ := nat_lt_aleph_0 m,
+  rw [hk, mul_lt_aleph_0_iff] at this,
   rcases this with h | h | ⟨-, hk'⟩,
   iterate 2 { simp only [h, mul_zero,  zero_mul, nat.cast_eq_zero] at hk, simp [hk] },
   lift k to ℕ using hk',
@@ -99,34 +106,36 @@ begin
   { simp only [is_unit_iff, nat.is_unit_iff],
     exact_mod_cast iff.rfl },
   { exact_mod_cast h b c (by exact_mod_cast hbc) },
-  cases lt_or_le (b * c) ω with h' h',
-  { rcases mul_lt_omega_iff.mp h' with rfl | rfl | ⟨hb, hc⟩,
+  cases lt_or_le (b * c) ℵ₀ with h' h',
+  { rcases mul_lt_aleph_0_iff.mp h' with rfl | rfl | ⟨hb, hc⟩,
     { simp },
     { simp },
     lift b to ℕ using hb,
     lift c to ℕ using hc,
     exact_mod_cast h b c (by exact_mod_cast hbc) },
-  rcases omega_le_mul_iff.mp h' with ⟨hb, hc, hω⟩,
+  rcases aleph_0_le_mul_iff.mp h' with ⟨hb, hc, hℵ₀⟩,
   have hn : (n : cardinal) ≠ 0,
   { intro h,
     rw [h, zero_dvd_iff, mul_eq_zero] at hbc,
     cases hbc; contradiction },
-  wlog hω : ω ≤ b := hω using [b c],
-  exact or.inl (dvd_of_le_of_omega_le hn ((nat_lt_omega n).le.trans hω) hω),
+  wlog hℵ₀b : ℵ₀ ≤ b,
+  { refine (this h c b _ _ hc hb hℵ₀.symm hn (hℵ₀.resolve_left hℵ₀b)).symm; rwa mul_comm },
+  exact or.inl (dvd_of_le_of_aleph_0_le hn ((nat_lt_aleph_0 n).le.trans hℵ₀b) hℵ₀b),
 end
 
-lemma is_prime_iff {a : cardinal} : prime a ↔ ω ≤ a ∨ ∃ p : ℕ, a = p ∧ p.prime :=
+lemma is_prime_iff {a : cardinal} : prime a ↔ ℵ₀ ≤ a ∨ ∃ p : ℕ, a = p ∧ p.prime :=
 begin
-  cases le_or_lt ω a with h h,
+  cases le_or_lt ℵ₀ a with h h,
   { simp [h] },
   lift a to ℕ using id h,
   simp [not_le.mpr h]
 end
 
-lemma is_prime_pow_iff {a : cardinal} : is_prime_pow a ↔ ω ≤ a ∨ ∃ n : ℕ, a = n ∧ is_prime_pow n :=
+lemma is_prime_pow_iff {a : cardinal} :
+  is_prime_pow a ↔ ℵ₀ ≤ a ∨ ∃ n : ℕ, a = n ∧ is_prime_pow n :=
 begin
-  by_cases h : ω ≤ a,
-  { simp [h, (prime_of_omega_le h).is_prime_pow] },
+  by_cases h : ℵ₀ ≤ a,
+  { simp [h, (prime_of_aleph_0_le h).is_prime_pow] },
   lift a to ℕ using not_le.mp h,
   simp only [h, nat.cast_inj, exists_eq_left', false_or, is_prime_pow_nat_iff],
   rw is_prime_pow_def,
@@ -135,7 +144,7 @@ begin
   have key : _ ≤ p ^ k :=
     power_le_power_left hp.ne_zero (show (1 : cardinal) ≤ k, by exact_mod_cast hk),
   rw [power_one, hpk] at key,
-  lift p to ℕ using key.trans_lt (nat_lt_omega a),
+  lift p to ℕ using key.trans_lt (nat_lt_aleph_0 a),
   exact ⟨p, k, nat_is_prime_iff.mp hp, hk, by exact_mod_cast hpk⟩
 end
 
diff --git a/src/set_theory/cardinal/finite.lean b/src/set_theory/cardinal/finite.lean
index 31afa0177383e..9e98d2bb67b27 100644
--- a/src/set_theory/cardinal/finite.lean
+++ b/src/set_theory/cardinal/finite.lean
@@ -3,24 +3,28 @@ Copyright (c) 2021 Aaron Anderson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Aaron Anderson
 -/
+import data.zmod.defs
 import set_theory.cardinal.basic
 
 /-!
 # Finite Cardinality Functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main Definitions
 
 * `nat.card α` is the cardinality of `α` as a natural number.
   If `α` is infinite, `nat.card α = 0`.
-* `enat.card α` is the cardinality of `α` as an extended natural number.
-  If `α` is infinite, `enat.card α = ⊤`.
-
+* `part_enat.card α` is the cardinality of `α` as an extended natural number
+  (`part ℕ` implementation). If `α` is infinite, `part_enat.card α = ⊤`.
 -/
 
 open cardinal
 noncomputable theory
+open_locale big_operators
 
-variable {α : Type*}
+variables {α β : Type*}
 
 namespace nat
 
@@ -34,18 +38,174 @@ lemma card_eq_fintype_card [fintype α] : nat.card α = fintype.card α := mk_to
 @[simp]
 lemma card_eq_zero_of_infinite [infinite α] : nat.card α = 0 := mk_to_nat_of_infinite
 
+lemma finite_of_card_ne_zero (h : nat.card α ≠ 0) : finite α :=
+not_infinite_iff_finite.mp $ h ∘ @nat.card_eq_zero_of_infinite α
+
+lemma card_congr (f : α ≃ β) : nat.card α = nat.card β :=
+cardinal.to_nat_congr f
+
+lemma card_eq_of_bijective (f : α → β) (hf : function.bijective f) : nat.card α = nat.card β :=
+card_congr (equiv.of_bijective f hf)
+
+lemma card_eq_of_equiv_fin {α : Type*} {n : ℕ}
+  (f : α ≃ fin n) : nat.card α = n :=
+by simpa using card_congr f
+
+/-- If the cardinality is positive, that means it is a finite type, so there is
+an equivalence between `α` and `fin (nat.card α)`. See also `finite.equiv_fin`. -/
+def equiv_fin_of_card_pos {α : Type*} (h : nat.card α ≠ 0) :
+  α ≃ fin (nat.card α) :=
+begin
+  casesI fintype_or_infinite α,
+  { simpa using fintype.equiv_fin α },
+  { simpa using h },
+end
+
+lemma card_of_subsingleton (a : α) [subsingleton α] : nat.card α = 1 :=
+begin
+  letI := fintype.of_subsingleton a,
+  rw [card_eq_fintype_card, fintype.card_of_subsingleton a]
+end
+
+@[simp] lemma card_unique [unique α] : nat.card α = 1 :=
+card_of_subsingleton default
+
+lemma card_eq_one_iff_unique : nat.card α = 1 ↔ subsingleton α ∧ nonempty α :=
+cardinal.to_nat_eq_one_iff_unique
+
+lemma card_eq_two_iff : nat.card α = 2 ↔ ∃ x y : α, x ≠ y ∧ {x, y} = @set.univ α :=
+(to_nat_eq_iff two_ne_zero).trans $ iff.trans (by rw [nat.cast_two]) mk_eq_two_iff
+
+lemma card_eq_two_iff' (x : α) : nat.card α = 2 ↔ ∃! y, y ≠ x :=
+(to_nat_eq_iff two_ne_zero).trans $ iff.trans (by rw [nat.cast_two]) (mk_eq_two_iff' x)
+
+theorem card_of_is_empty [is_empty α] : nat.card α = 0 := by simp
+
+@[simp] lemma card_prod (α β : Type*) : nat.card (α × β) = nat.card α * nat.card β :=
+by simp only [nat.card, mk_prod, to_nat_mul, to_nat_lift]
+
+@[simp] lemma card_ulift (α : Type*) : nat.card (ulift α) = nat.card α :=
+card_congr equiv.ulift
+
+@[simp] lemma card_plift (α : Type*) : nat.card (plift α) = nat.card α :=
+card_congr equiv.plift
+
+lemma card_pi {β : α → Type*} [fintype α] : nat.card (Π a, β a) = ∏ a, nat.card (β a) :=
+by simp_rw [nat.card, mk_pi, prod_eq_of_fintype, to_nat_lift, to_nat_finset_prod]
+
+lemma card_fun [finite α] : nat.card (α → β) = nat.card β ^ nat.card α :=
+begin
+  haveI := fintype.of_finite α,
+  rw [nat.card_pi, finset.prod_const, finset.card_univ, ←nat.card_eq_fintype_card],
+end
+
+@[simp] lemma card_zmod (n : ℕ) : nat.card (zmod n) = n :=
+begin
+  cases n,
+  { exact nat.card_eq_zero_of_infinite },
+  { rw [nat.card_eq_fintype_card, zmod.card] },
+end
+
 end nat
 
-namespace enat
+namespace part_enat
 
-/-- `enat.card α` is the cardinality of `α` as an extended natural number.
-  If `α` is infinite, `enat.card α = ⊤`. -/
-def card (α : Type*) : enat := (mk α).to_enat
+/-- `part_enat.card α` is the cardinality of `α` as an extended natural number.
+  If `α` is infinite, `part_enat.card α = ⊤`. -/
+def card (α : Type*) : part_enat := (mk α).to_part_enat
 
 @[simp]
-lemma card_eq_coe_fintype_card [fintype α] : card α = fintype.card α := mk_to_enat_eq_coe_card
+lemma card_eq_coe_fintype_card [fintype α] : card α = fintype.card α := mk_to_part_enat_eq_coe_card
 
 @[simp]
-lemma card_eq_top_of_infinite [infinite α] : card α = ⊤ := mk_to_enat_of_infinite
+lemma card_eq_top_of_infinite [infinite α] : card α = ⊤ := mk_to_part_enat_of_infinite
+
+lemma card_congr {α : Type*} {β : Type*} (f : α ≃ β) :
+  part_enat.card α = part_enat.card β :=
+cardinal.to_part_enat_congr f
+
+lemma card_ulift (α : Type*) : card (ulift α) = card α :=
+card_congr equiv.ulift
+
+@[simp] lemma card_plift (α : Type*) : card (plift α) = card α :=
+card_congr equiv.plift
+
+lemma card_image_of_inj_on {α : Type*} {β : Type*} {f : α → β} {s : set α} (h : set.inj_on f s) :
+  card (f '' s) = card s :=
+card_congr (equiv.set.image_of_inj_on f s h).symm
 
-end enat
+lemma card_image_of_injective {α : Type*} {β : Type*}
+  (f : α → β) (s : set α) (h : function.injective f) :
+  card (f '' s) = card s :=
+card_image_of_inj_on (set.inj_on_of_injective h s)
+
+-- Should I keep the 6 following lemmas ?
+@[simp]
+lemma _root_.cardinal.coe_nat_le_to_part_enat_iff {n : ℕ} {c : cardinal} :
+  ↑n ≤ to_part_enat c ↔ ↑n ≤ c :=
+by rw [← to_part_enat_cast n, to_part_enat_le_iff_le_of_le_aleph_0 (le_of_lt (nat_lt_aleph_0 n))]
+
+@[simp]
+lemma _root_.cardinal.to_part_enat_le_coe_nat_iff {c : cardinal} {n : ℕ} :
+  to_part_enat c ≤ n ↔ c ≤ n :=
+by rw [← to_part_enat_cast n,
+ to_part_enat_le_iff_le_of_lt_aleph_0 (nat_lt_aleph_0 n)]
+
+@[simp]
+lemma _root_.cardinal.coe_nat_eq_to_part_enat_iff {n : ℕ} {c : cardinal} :
+  ↑n = to_part_enat c ↔ ↑n = c :=
+by rw [le_antisymm_iff, le_antisymm_iff,
+  cardinal.coe_nat_le_to_part_enat_iff,  cardinal.to_part_enat_le_coe_nat_iff]
+
+@[simp]
+lemma _root_.cardinal.to_part_enat_eq_coe_nat_iff {c : cardinal} {n : ℕ} :
+  to_part_enat c = n ↔ c = n:=
+by rw [eq_comm, cardinal.coe_nat_eq_to_part_enat_iff, eq_comm]
+
+@[simp]
+lemma _root_.cardinal.coe_nat_lt_coe_iff_lt {n : ℕ} {c : cardinal} :
+  ↑n < to_part_enat c ↔ ↑n < c :=
+by simp only [← not_le, cardinal.to_part_enat_le_coe_nat_iff]
+
+@[simp]
+lemma _root_.cardinal.lt_coe_nat_iff_lt {n : ℕ} {c : cardinal} :
+  to_part_enat c < n ↔ c < n :=
+by simp only [← not_le, cardinal.coe_nat_le_to_part_enat_iff]
+
+lemma card_eq_zero_iff_empty (α : Type*) : card α = 0 ↔ is_empty α :=
+begin
+  rw ← cardinal.mk_eq_zero_iff,
+  conv_rhs { rw ← nat.cast_zero },
+  rw ← cardinal.to_part_enat_eq_coe_nat_iff,
+  simp only [part_enat.card, nat.cast_zero]
+end
+
+lemma card_le_one_iff_subsingleton (α : Type*) : card α ≤ 1 ↔ subsingleton α :=
+begin
+  rw ← le_one_iff_subsingleton,
+  conv_rhs { rw ← nat.cast_one},
+  rw ← cardinal.to_part_enat_le_coe_nat_iff,
+  simp only [part_enat.card, nat.cast_one]
+end
+
+lemma one_lt_card_iff_nontrivial (α : Type*) : 1 < card α ↔ nontrivial α :=
+begin
+  rw ← one_lt_iff_nontrivial,
+  conv_rhs { rw ← nat.cast_one},
+  rw ← cardinal.coe_nat_lt_coe_iff_lt,
+  simp only [part_enat.card, nat.cast_one]
+end
+
+lemma is_finite_of_card {α : Type*} {n : ℕ} (hα : part_enat.card α = n) :
+  finite α :=
+begin
+  apply or.resolve_right (finite_or_infinite α),
+  intro h, resetI,
+  apply part_enat.coe_ne_top n,
+  rw ← hα,
+  exact part_enat.card_eq_top_of_infinite,
+end
+
+
+
+end part_enat
diff --git a/src/set_theory/cardinal/ordinal.lean b/src/set_theory/cardinal/ordinal.lean
index 01e94fa0c6b25..655c3a267b92c 100644
--- a/src/set_theory/cardinal/ordinal.lean
+++ b/src/set_theory/cardinal/ordinal.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Floris van Doorn
 -/
 
+import data.finsupp.multiset
 import order.bounded
 import set_theory.ordinal.principal
 import tactic.linarith
@@ -11,6 +12,9 @@ import tactic.linarith
 /-!
 # Cardinals and ordinals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Relationships between cardinals and ordinals, properties of cardinals that are proved
 using ordinals.
 
@@ -18,11 +22,14 @@ using ordinals.
 
 * The function `cardinal.aleph'` gives the cardinals listed by their ordinal
   index, and is the inverse of `cardinal.aleph_idx`.
-  `aleph' n = n`, `aleph' ω = cardinal.omega = ℵ₀`, `aleph' (ω + 1) = ℵ₁`, etc.
+  `aleph' n = n`, `aleph' ω = ℵ₀`, `aleph' (ω + 1) = succ ℵ₀`, etc.
   It is an order isomorphism between ordinals and cardinals.
 * The function `cardinal.aleph` gives the infinite cardinals listed by their
-  ordinal index. `aleph 0 = cardinal.omega = ℵ₀`, `aleph 1 = ℵ₁` is the first
+  ordinal index. `aleph 0 = ℵ₀`, `aleph 1 = succ ℵ₀` is the first
   uncountable cardinal, and so on.
+* The function `cardinal.beth` enumerates the Beth cardinals. `beth 0 = ℵ₀`,
+  `beth (succ o) = 2 ^ beth o`, and for a limit ordinal `o`, `beth o` is the supremum of `beth a`
+  for `a < o`.
 
 ## Main Statements
 
@@ -39,8 +46,8 @@ cardinal arithmetic (for infinite cardinals)
 
 noncomputable theory
 
-open function cardinal set equiv
-open_locale classical cardinal
+open function cardinal set equiv order
+open_locale classical cardinal ordinal
 
 universes u v w
 
@@ -48,18 +55,20 @@ namespace cardinal
 section using_ordinals
 open ordinal
 
-theorem ord_is_limit {c} (co : ω ≤ c) : (ord c).is_limit :=
+theorem ord_is_limit {c} (co : ℵ₀ ≤ c) : (ord c).is_limit :=
 begin
-  refine ⟨λ h, omega_ne_zero _, λ a, lt_imp_lt_of_le_imp_le _⟩,
-  { rw [← ordinal.le_zero, ord_le] at h,
-    simpa only [card_zero, nonpos_iff_eq_zero] using le_trans co h },
-  { intro h, rw [ord_le] at h ⊢,
-    rwa [← @add_one_of_omega_le (card a), ← card_succ],
-    rw [← ord_le, ← le_succ_of_is_limit, ord_le],
-    { exact le_trans co h },
-    { rw ord_omega, exact omega_is_limit } }
+  refine ⟨λ h, aleph_0_ne_zero _, λ a, lt_imp_lt_of_le_imp_le (λ h, _)⟩,
+  { rw [←ordinal.le_zero, ord_le] at h,
+    simpa only [card_zero, nonpos_iff_eq_zero] using co.trans h },
+  { rw ord_le at h ⊢,
+    rwa [←@add_one_of_aleph_0_le (card a), ←card_succ],
+    rw [←ord_le, ←le_succ_of_is_limit, ord_le],
+    { exact co.trans h },
+    { rw ord_aleph_0, exact omega_is_limit } }
 end
 
+/-! ### Aleph cardinals -/
+
 /-- The `aleph'` index function, which gives the ordinal index of a cardinal.
   (The `aleph'` part is because unlike `aleph` this counts also the
   finite stages. So `aleph_idx n = n`, `aleph_idx ω = ω`,
@@ -88,11 +97,11 @@ aleph_idx.initial_seg.to_rel_embedding.map_rel_iff
 by rw [← not_lt, ← not_lt, aleph_idx_lt]
 
 theorem aleph_idx.init {a b} : b < aleph_idx a → ∃ c, aleph_idx c = b :=
-aleph_idx.initial_seg.init _ _
+aleph_idx.initial_seg.init
 
 /-- The `aleph'` index function, which gives the ordinal index of a cardinal.
   (The `aleph'` part is because unlike `aleph` this counts also the
-  finite stages. So `aleph_idx n = n`, `aleph_idx ω = ω`,
+  finite stages. So `aleph_idx n = n`, `aleph_idx ℵ₀ = ω`,
   `aleph_idx ℵ₁ = ω + 1` and so on.)
   In this version, we register additionally that this function is an order isomorphism
   between cardinals and ordinals.
@@ -103,18 +112,18 @@ def aleph_idx.rel_iso : @rel_iso cardinal.{u} ordinal.{u} (<) (<) :=
 λ ⟨o, e⟩, begin
   have : ∀ c, aleph_idx c < o := λ c, (e _).2 ⟨_, rfl⟩,
   refine ordinal.induction_on o _ this, introsI α r _ h,
-  let s := sup.{u u} (λ a:α, inv_fun aleph_idx (ordinal.typein r a)),
-  apply not_le_of_gt (lt_succ_self s),
+  let s := ⨆ a, inv_fun aleph_idx (ordinal.typein r a),
+  apply (lt_succ s).not_le,
   have I : injective aleph_idx := aleph_idx.initial_seg.to_embedding.injective,
-  simpa only [typein_enum, left_inverse_inv_fun I (succ s)] using
-    le_sup.{u u} (λ a, inv_fun aleph_idx (ordinal.typein r a))
-      (ordinal.enum r _ (h (succ s))),
+  simpa only [typein_enum, left_inverse_inv_fun I (succ s)] using le_csupr
+    (cardinal.bdd_above_range.{u u} (λ a : α, inv_fun aleph_idx (ordinal.typein r a)))
+    (ordinal.enum r _ (h (succ s)))
 end
 
 @[simp] theorem aleph_idx.rel_iso_coe :
   (aleph_idx.rel_iso : cardinal → ordinal) = aleph_idx := rfl
 
-@[simp] theorem type_cardinal : @ordinal.type cardinal (<) _ = ordinal.univ.{u (u+1)} :=
+@[simp] theorem type_cardinal : @type cardinal (<) _ = ordinal.univ.{u (u+1)} :=
 by rw ordinal.univ_id; exact quotient.sound ⟨aleph_idx.rel_iso⟩
 
 @[simp] theorem mk_cardinal : #cardinal = univ.{u (u+1)} :=
@@ -122,7 +131,7 @@ by simpa only [card_type, card_univ] using congr_arg card type_cardinal
 
 /-- The `aleph'` function gives the cardinals listed by their ordinal
   index, and is the inverse of `aleph_idx`.
-  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = ℵ₁`, etc.
+  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = succ ℵ₀`, etc.
   In this version, we register additionally that this function is an order isomorphism
   between ordinals and cardinals.
   For the basic function version, see `aleph'`. -/
@@ -130,53 +139,59 @@ def aleph'.rel_iso := cardinal.aleph_idx.rel_iso.symm
 
 /-- The `aleph'` function gives the cardinals listed by their ordinal
   index, and is the inverse of `aleph_idx`.
-  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = ℵ₁`, etc. -/
+  `aleph' n = n`, `aleph' ω = ω`, `aleph' (ω + 1) = succ ℵ₀`, etc. -/
 def aleph' : ordinal → cardinal := aleph'.rel_iso
 
 @[simp] theorem aleph'.rel_iso_coe :
   (aleph'.rel_iso : ordinal → cardinal) = aleph' := rfl
 
-@[simp] theorem aleph'_lt {o₁ o₂ : ordinal.{u}} : aleph' o₁ < aleph' o₂ ↔ o₁ < o₂ :=
+@[simp] theorem aleph'_lt {o₁ o₂ : ordinal} : aleph' o₁ < aleph' o₂ ↔ o₁ < o₂ :=
 aleph'.rel_iso.map_rel_iff
 
-@[simp] theorem aleph'_le {o₁ o₂ : ordinal.{u}} : aleph' o₁ ≤ aleph' o₂ ↔ o₁ ≤ o₂ :=
+@[simp] theorem aleph'_le {o₁ o₂ : ordinal} : aleph' o₁ ≤ aleph' o₂ ↔ o₁ ≤ o₂ :=
 le_iff_le_iff_lt_iff_lt.2 aleph'_lt
 
-@[simp] theorem aleph'_aleph_idx (c : cardinal.{u}) : aleph' c.aleph_idx = c :=
+@[simp] theorem aleph'_aleph_idx (c : cardinal) : aleph' c.aleph_idx = c :=
 cardinal.aleph_idx.rel_iso.to_equiv.symm_apply_apply c
 
-@[simp] theorem aleph_idx_aleph' (o : ordinal.{u}) : (aleph' o).aleph_idx = o :=
+@[simp] theorem aleph_idx_aleph' (o : ordinal) : (aleph' o).aleph_idx = o :=
 cardinal.aleph_idx.rel_iso.to_equiv.apply_symm_apply o
 
 @[simp] theorem aleph'_zero : aleph' 0 = 0 :=
-by rw [← nonpos_iff_eq_zero, ← aleph'_aleph_idx 0, aleph'_le];
-   apply ordinal.zero_le
+by { rw [← nonpos_iff_eq_zero, ← aleph'_aleph_idx 0, aleph'_le], apply ordinal.zero_le }
 
-@[simp] theorem aleph'_succ {o : ordinal.{u}} : aleph' o.succ = (aleph' o).succ :=
-le_antisymm
- (cardinal.aleph_idx_le.1 $
-  by rw [aleph_idx_aleph', ordinal.succ_le, ← aleph'_lt, aleph'_aleph_idx];
-     apply cardinal.lt_succ_self)
- (cardinal.succ_le.2 $ aleph'_lt.2 $ ordinal.lt_succ_self _)
+@[simp] theorem aleph'_succ {o : ordinal} : aleph' (succ o) = succ (aleph' o) :=
+begin
+  apply (succ_le_of_lt $ aleph'_lt.2 $ lt_succ o).antisymm' (cardinal.aleph_idx_le.1 $ _),
+  rw [aleph_idx_aleph', succ_le_iff, ← aleph'_lt, aleph'_aleph_idx],
+  apply lt_succ
+end
 
 @[simp] theorem aleph'_nat : ∀ n : ℕ, aleph' n = n
 | 0     := aleph'_zero
-| (n+1) := show aleph' (ordinal.succ n) = n.succ,
+| (n+1) := show aleph' (succ n) = n.succ,
            by rw [aleph'_succ, aleph'_nat, nat_succ]
 
-theorem aleph'_le_of_limit {o : ordinal.{u}} (l : o.is_limit) {c} :
+theorem aleph'_le_of_limit {o : ordinal} (l : o.is_limit) {c} :
   aleph' o ≤ c ↔ ∀ o' < o, aleph' o' ≤ c :=
-⟨λ h o' h', le_trans (aleph'_le.2 $ le_of_lt h') h,
+⟨λ h o' h', (aleph'_le.2 $ h'.le).trans h,
  λ h, begin
-  rw [← aleph'_aleph_idx c, aleph'_le, ordinal.limit_le l],
+  rw [←aleph'_aleph_idx c, aleph'_le, limit_le l],
   intros x h',
-  rw [← aleph'_le, aleph'_aleph_idx],
+  rw [←aleph'_le, aleph'_aleph_idx],
   exact h _ h'
 end⟩
 
-@[simp] theorem aleph'_omega : aleph' ordinal.omega = ω :=
+theorem aleph'_limit {o : ordinal} (ho : o.is_limit) : aleph' o = ⨆ a : Iio o, aleph' a :=
+begin
+  refine le_antisymm _ (csupr_le' (λ i, aleph'_le.2 (le_of_lt i.2))),
+  rw aleph'_le_of_limit ho,
+  exact λ a ha, le_csupr (bdd_above_of_small _) (⟨a, ha⟩ : Iio o)
+end
+
+@[simp] theorem aleph'_omega : aleph' ω = ℵ₀ :=
 eq_of_forall_ge_iff $ λ c, begin
-  simp only [aleph'_le_of_limit omega_is_limit, ordinal.lt_omega, exists_imp_distrib, omega_le],
+  simp only [aleph'_le_of_limit omega_is_limit, lt_omega, exists_imp_distrib, aleph_0_le],
   exact forall_swap.trans (forall_congr $ λ n, by simp only [forall_eq, aleph'_nat]),
 end
 
@@ -185,14 +200,14 @@ end
 ⟨aleph', aleph_idx, aleph_idx_aleph', aleph'_aleph_idx⟩
 
 /-- The `aleph` function gives the infinite cardinals listed by their
-  ordinal index. `aleph 0 = ω`, `aleph 1 = succ ω` is the first
+  ordinal index. `aleph 0 = ℵ₀`, `aleph 1 = succ ℵ₀` is the first
   uncountable cardinal, and so on. -/
-def aleph (o : ordinal) : cardinal := aleph' (ordinal.omega + o)
+def aleph (o : ordinal) : cardinal := aleph' (ω + o)
 
-@[simp] theorem aleph_lt {o₁ o₂ : ordinal.{u}} : aleph o₁ < aleph o₂ ↔ o₁ < o₂ :=
+@[simp] theorem aleph_lt {o₁ o₂ : ordinal} : aleph o₁ < aleph o₂ ↔ o₁ < o₂ :=
 aleph'_lt.trans (add_lt_add_iff_left _)
 
-@[simp] theorem aleph_le {o₁ o₂ : ordinal.{u}} : aleph o₁ ≤ aleph o₂ ↔ o₁ ≤ o₂ :=
+@[simp] theorem aleph_le {o₁ o₂ : ordinal} : aleph o₁ ≤ aleph o₂ ↔ o₁ ≤ o₂ :=
 le_iff_le_iff_lt_iff_lt.2 aleph_lt
 
 @[simp] theorem max_aleph_eq (o₁ o₂ : ordinal) : max (aleph o₁) (aleph o₂) = aleph (max o₁ o₂) :=
@@ -202,57 +217,77 @@ begin
   { rw [max_eq_left h, max_eq_left (aleph_le.1 h)] }
 end
 
-@[simp] theorem aleph_succ {o : ordinal.{u}} : aleph o.succ = (aleph o).succ :=
-by rw [aleph, ordinal.add_succ, aleph'_succ]; refl
+@[simp] theorem aleph_succ {o : ordinal} : aleph (succ o) = succ (aleph o) :=
+by rw [aleph, add_succ, aleph'_succ, aleph]
 
-@[simp] theorem aleph_zero : aleph 0 = ω :=
-by simp only [aleph, add_zero, aleph'_omega]
+@[simp] theorem aleph_zero : aleph 0 = ℵ₀ :=
+by rw [aleph, add_zero, aleph'_omega]
 
-theorem omega_le_aleph' {o : ordinal} : ω ≤ aleph' o ↔ ordinal.omega ≤ o :=
+theorem aleph_limit {o : ordinal} (ho : o.is_limit) : aleph o = ⨆ a : Iio o, aleph a :=
+begin
+  apply le_antisymm _ (csupr_le' _),
+  { rw [aleph, aleph'_limit (ho.add _)],
+    refine csupr_mono' (bdd_above_of_small _) _,
+    rintro ⟨i, hi⟩,
+    cases lt_or_le i ω,
+    { rcases lt_omega.1 h with ⟨n, rfl⟩,
+      use ⟨0, ho.pos⟩,
+      simpa using (nat_lt_aleph_0 n).le },
+    { exact ⟨⟨_, (sub_lt_of_le h).2 hi⟩, aleph'_le.2 (le_add_sub _ _)⟩ } },
+  { exact λ i, aleph_le.2 (le_of_lt i.2) }
+end
+
+theorem aleph_0_le_aleph' {o : ordinal} : ℵ₀ ≤ aleph' o ↔ ω ≤ o :=
 by rw [← aleph'_omega, aleph'_le]
 
-theorem omega_le_aleph (o : ordinal) : ω ≤ aleph o :=
-by rw [aleph, omega_le_aleph']; apply ordinal.le_add_right
+theorem aleph_0_le_aleph (o : ordinal) : ℵ₀ ≤ aleph o :=
+by { rw [aleph, aleph_0_le_aleph'], apply ordinal.le_add_right }
 
 theorem aleph'_pos {o : ordinal} (ho : 0 < o) : 0 < aleph' o :=
 by rwa [←aleph'_zero, aleph'_lt]
 
 theorem aleph_pos (o : ordinal) : 0 < aleph o :=
-omega_pos.trans_le (omega_le_aleph o)
+aleph_0_pos.trans_le (aleph_0_le_aleph o)
+
+@[simp] theorem aleph_to_nat (o : ordinal) : (aleph o).to_nat = 0 :=
+to_nat_apply_of_aleph_0_le $ aleph_0_le_aleph o
+
+@[simp] theorem aleph_to_part_enat (o : ordinal) : (aleph o).to_part_enat = ⊤ :=
+to_part_enat_apply_of_aleph_0_le $ aleph_0_le_aleph o
 
-instance (o : ordinal) : nonempty (aleph o).ord.out.α :=
+instance nonempty_out_aleph (o : ordinal) : nonempty (aleph o).ord.out.α :=
 begin
   rw [out_nonempty_iff_ne_zero, ←ord_zero],
   exact λ h, (ord_injective h).not_gt (aleph_pos o)
 end
 
-theorem ord_aleph_is_limit (o : ordinal) : is_limit (aleph o).ord :=
-ord_is_limit $ omega_le_aleph _
+theorem ord_aleph_is_limit (o : ordinal) : (aleph o).ord.is_limit :=
+ord_is_limit $ aleph_0_le_aleph _
 
 instance (o : ordinal) : no_max_order (aleph o).ord.out.α :=
-ordinal.out_no_max_of_succ_lt (ord_aleph_is_limit o).2
+out_no_max_of_succ_lt (ord_aleph_is_limit o).2
 
-theorem exists_aleph {c : cardinal} : ω ≤ c ↔ ∃ o, c = aleph o :=
-⟨λ h, ⟨aleph_idx c - ordinal.omega,
-  by rw [aleph, ordinal.add_sub_cancel_of_le, aleph'_aleph_idx];
-     rwa [← omega_le_aleph', aleph'_aleph_idx]⟩,
- λ ⟨o, e⟩, e.symm ▸ omega_le_aleph _⟩
+theorem exists_aleph {c : cardinal} : ℵ₀ ≤ c ↔ ∃ o, c = aleph o :=
+⟨λ h, ⟨aleph_idx c - ω,
+  by { rw [aleph, ordinal.add_sub_cancel_of_le, aleph'_aleph_idx],
+       rwa [← aleph_0_le_aleph', aleph'_aleph_idx] }⟩,
+ λ ⟨o, e⟩, e.symm ▸ aleph_0_le_aleph _⟩
 
 theorem aleph'_is_normal : is_normal (ord ∘ aleph') :=
-⟨λ o, ord_lt_ord.2 $ aleph'_lt.2 $ ordinal.lt_succ_self _,
+⟨λ o, ord_lt_ord.2 $ aleph'_lt.2 $ lt_succ o,
  λ o l a, by simp only [ord_le, aleph'_le_of_limit l]⟩
 
 theorem aleph_is_normal : is_normal (ord ∘ aleph) :=
-aleph'_is_normal.trans $ add_is_normal ordinal.omega
+aleph'_is_normal.trans $ add_is_normal ω
 
-theorem succ_omega : succ ω = aleph 1 :=
-by rw [← aleph_zero, ← aleph_succ, ordinal.succ_zero]
+theorem succ_aleph_0 : succ ℵ₀ = aleph 1 :=
+by rw [←aleph_zero, ←aleph_succ, ordinal.succ_zero]
 
-lemma omega_lt_aleph_one : ω < aleph 1 :=
-by { rw ← succ_omega, exact lt_succ_self _ }
+lemma aleph_0_lt_aleph_one : ℵ₀ < aleph 1 :=
+by { rw ←succ_aleph_0, apply lt_succ }
 
-lemma countable_iff_lt_aleph_one {α : Type*} (s : set α) : countable s ↔ #s < aleph 1 :=
-by rw [← succ_omega, lt_succ, mk_set_le_omega]
+lemma countable_iff_lt_aleph_one {α : Type*} (s : set α) : s.countable ↔ #s < aleph 1 :=
+by rw [←succ_aleph_0, lt_succ_iff, le_aleph_0_iff_set_countable]
 
 /-- Ordinals that are cardinals are unbounded. -/
 theorem ord_card_unbounded : unbounded (<) {b : ordinal | b.card.ord = b} :=
@@ -270,46 +305,115 @@ begin
 end
 
 /-- Infinite ordinals that are cardinals are unbounded. -/
-theorem ord_card_unbounded' : unbounded (<) {b : ordinal | b.card.ord = b ∧ ordinal.omega ≤ b} :=
-(unbounded_lt_inter_le ordinal.omega).2 ord_card_unbounded
+theorem ord_card_unbounded' : unbounded (<) {b : ordinal | b.card.ord = b ∧ ω ≤ b} :=
+(unbounded_lt_inter_le ω).2 ord_card_unbounded
 
-theorem eq_aleph_of_eq_card_ord {o : ordinal} (ho : o.card.ord = o) (ho' : ordinal.omega ≤ o) :
+theorem eq_aleph_of_eq_card_ord {o : ordinal} (ho : o.card.ord = o) (ho' : ω ≤ o) :
   ∃ a, (aleph a).ord = o :=
 begin
   cases eq_aleph'_of_eq_card_ord ho with a ha,
-  use a - ordinal.omega,
+  use a - ω,
   unfold aleph,
   rwa ordinal.add_sub_cancel_of_le,
-  rwa [←omega_le_aleph', ←ord_le_ord, ha, ord_omega]
+  rwa [←aleph_0_le_aleph', ←ord_le_ord, ha, ord_aleph_0]
 end
 
 /-- `ord ∘ aleph` enumerates the infinite ordinals that are cardinals. -/
 theorem ord_aleph_eq_enum_card :
-  ord ∘ aleph = enum_ord {b : ordinal | b.card.ord = b ∧ ordinal.omega ≤ b} :=
+  ord ∘ aleph = enum_ord {b : ordinal | b.card.ord = b ∧ ω ≤ b} :=
 begin
   rw ←eq_enum_ord _ ord_card_unbounded',
   use aleph_is_normal.strict_mono,
   rw range_eq_iff,
   refine ⟨(λ a, ⟨_, _⟩), λ b hb, eq_aleph_of_eq_card_ord hb.1 hb.2⟩,
   { rw card_ord },
-  { rw [←ord_omega, ord_le_ord],
-    exact omega_le_aleph _ }
+  { rw [←ord_aleph_0, ord_le_ord],
+    exact aleph_0_le_aleph _ }
+end
+
+/-! ### Beth cardinals -/
+
+/-- Beth numbers are defined so that `beth 0 = ℵ₀`, `beth (succ o) = 2 ^ (beth o)`, and when `o` is
+a limit ordinal, `beth o` is the supremum of `beth o'` for `o' < o`.
+
+Assuming the generalized continuum hypothesis, which is undecidable in ZFC, `beth o = aleph o` for
+every `o`. -/
+def beth (o : ordinal.{u}) : cardinal.{u} :=
+limit_rec_on o aleph_0 (λ _ x, 2 ^ x) (λ a ha IH, ⨆ b : Iio a, IH b.1 b.2)
+
+@[simp] theorem beth_zero : beth 0 = aleph_0 :=
+limit_rec_on_zero _ _ _
+
+@[simp] theorem beth_succ (o : ordinal) : beth (succ o) = 2 ^ beth o :=
+limit_rec_on_succ _ _ _ _
+
+theorem beth_limit {o : ordinal} : o.is_limit → beth o = ⨆ a : Iio o, beth a :=
+limit_rec_on_limit _ _ _ _
+
+theorem beth_strict_mono : strict_mono beth :=
+begin
+  intros a b,
+  induction b using ordinal.induction with b IH generalizing a,
+  intro h,
+  rcases zero_or_succ_or_limit b with rfl | ⟨c, rfl⟩ | hb,
+  { exact (ordinal.not_lt_zero a h).elim },
+  { rw lt_succ_iff at h,
+    rw beth_succ,
+    apply lt_of_le_of_lt _ (cantor _),
+    rcases eq_or_lt_of_le h with rfl | h, { refl },
+    exact (IH c (lt_succ c) h).le },
+  { apply (cantor _).trans_le,
+    rw [beth_limit hb, ←beth_succ],
+    exact le_csupr (bdd_above_of_small _) (⟨_, hb.succ_lt h⟩ : Iio b) }
+end
+
+lemma beth_mono : monotone beth := beth_strict_mono.monotone
+
+@[simp] theorem beth_lt {o₁ o₂ : ordinal} : beth o₁ < beth o₂ ↔ o₁ < o₂ :=
+beth_strict_mono.lt_iff_lt
+
+@[simp] theorem beth_le {o₁ o₂ : ordinal} : beth o₁ ≤ beth o₂ ↔ o₁ ≤ o₂ :=
+beth_strict_mono.le_iff_le
+
+theorem aleph_le_beth (o : ordinal) : aleph o ≤ beth o :=
+begin
+  apply limit_rec_on o,
+  { simp },
+  { intros o h,
+    rw [aleph_succ, beth_succ, succ_le_iff],
+    exact (cantor _).trans_le (power_le_power_left two_ne_zero h) },
+  { intros o ho IH,
+    rw [aleph_limit ho, beth_limit ho],
+    exact csupr_mono (bdd_above_of_small _) (λ x, IH x.1 x.2) }
 end
 
+theorem aleph_0_le_beth (o : ordinal) : ℵ₀ ≤ beth o :=
+(aleph_0_le_aleph o).trans $ aleph_le_beth o
+
+theorem beth_pos (o : ordinal) : 0 < beth o :=
+aleph_0_pos.trans_le $ aleph_0_le_beth o
+
+theorem beth_ne_zero (o : ordinal) : beth o ≠ 0 :=
+(beth_pos o).ne'
+
+lemma beth_normal : is_normal.{u} (λ o, (beth o).ord) :=
+(is_normal_iff_strict_mono_limit _).2 ⟨ord_strict_mono.comp beth_strict_mono, λ o ho a ha,
+  by { rw [beth_limit ho, ord_le], exact csupr_le' (λ b, ord_le.1 (ha _ b.2)) }⟩
+
 /-! ### Properties of `mul` -/
 
 /-- If `α` is an infinite type, then `α × α` and `α` have the same cardinality. -/
-theorem mul_eq_self {c : cardinal} (h : ω ≤ c) : c * c = c :=
+theorem mul_eq_self {c : cardinal} (h : ℵ₀ ≤ c) : c * c = c :=
 begin
   refine le_antisymm _
     (by simpa only [mul_one] using
-      mul_le_mul_left' (one_lt_omega.le.trans h) c),
+      mul_le_mul_left' (one_le_aleph_0.trans h) c),
   -- the only nontrivial part is `c * c ≤ c`. We prove it inductively.
-  refine acc.rec_on (cardinal.wf.apply c) (λ c _,
+  refine acc.rec_on (cardinal.lt_wf.apply c) (λ c _,
     quotient.induction_on c $ λ α IH ol, _) h,
   -- consider the minimal well-order `r` on `α` (a type with cardinality `c`).
   rcases ord_eq α with ⟨r, wo, e⟩, resetI,
-  letI := linear_order_of_STO' r,
+  letI := linear_order_of_STO r,
   haveI : is_well_order α (<) := wo,
   -- Define an order `s` on `α × α` by writing `(a, b) < (c, d)` if `max a b < max c d`, or
   -- the max are equal and `a < c`, or the max are equal and `a = c` and `b < d`.
@@ -328,7 +432,8 @@ begin
   refine le_of_forall_lt (λ o h, _),
   rcases typein_surj s h with ⟨p, rfl⟩,
   rw [← e, lt_ord],
-  refine lt_of_le_of_lt (_ : _ ≤ card (typein (<) (g p)).succ * card (typein (<) (g p)).succ) _,
+  refine lt_of_le_of_lt
+    (_ : _ ≤ card (succ (typein (<) (g p))) * card (succ (typein (<) (g p)))) _,
   { have : {q | s q p} ⊆ insert (g p) {x | x < g p} ×ˢ insert (g p) {x | x < g p},
     { intros q h,
       simp only [s, embedding.coe_fn_mk, order.preimage, typein_lt_typein, prod.lex_def, typein_inj]
@@ -340,9 +445,9 @@ begin
     refine (equiv.set.insert _).trans
       ((equiv.refl _).sum_congr punit_equiv_punit),
     apply @irrefl _ r },
-  cases lt_or_le (card (typein (<) (g p)).succ) ω with qo qo,
-  { exact lt_of_lt_of_le (mul_lt_omega qo qo) ol },
-  { suffices, {exact lt_of_le_of_lt (IH _ this qo) this},
+  cases lt_or_le (card (succ (typein (<) (g p)))) ℵ₀ with qo qo,
+  { exact (mul_lt_aleph_0 qo qo).trans_le ol },
+  { suffices, {exact (IH _ this qo).trans_lt this},
     rw ← lt_ord, apply (ord_is_limit ol).2,
     rw [mk_def, e], apply typein_lt_type }
 end
@@ -351,89 +456,95 @@ end using_ordinals
 
 /-- If `α` and `β` are infinite types, then the cardinality of `α × β` is the maximum
 of the cardinalities of `α` and `β`. -/
-theorem mul_eq_max {a b : cardinal} (ha : ω ≤ a) (hb : ω ≤ b) : a * b = max a b :=
+theorem mul_eq_max {a b : cardinal} (ha : ℵ₀ ≤ a) (hb : ℵ₀ ≤ b) : a * b = max a b :=
 le_antisymm
-  (mul_eq_self (le_trans ha (le_max_left a b)) ▸
+  (mul_eq_self (ha.trans (le_max_left a b)) ▸
     mul_le_mul' (le_max_left _ _) (le_max_right _ _)) $
 max_le
   (by simpa only [mul_one] using
-    mul_le_mul_left' (one_lt_omega.le.trans hb) a)
+    mul_le_mul_left' (one_le_aleph_0.trans hb) a)
   (by simpa only [one_mul] using
-    mul_le_mul_right' (one_lt_omega.le.trans ha) b)
+    mul_le_mul_right' (one_le_aleph_0.trans ha) b)
 
 @[simp] theorem mul_mk_eq_max {α β : Type*} [infinite α] [infinite β] : #α * #β = max (#α) (#β) :=
-mul_eq_max (omega_le_mk α) (omega_le_mk β)
+mul_eq_max (aleph_0_le_mk α) (aleph_0_le_mk β)
 
 @[simp] theorem aleph_mul_aleph (o₁ o₂ : ordinal) : aleph o₁ * aleph o₂ = aleph (max o₁ o₂) :=
-by rw [cardinal.mul_eq_max (omega_le_aleph o₁) (omega_le_aleph o₂), max_aleph_eq]
+by rw [cardinal.mul_eq_max (aleph_0_le_aleph o₁) (aleph_0_le_aleph o₂), max_aleph_eq]
 
-@[simp] theorem omega_mul_eq {a : cardinal} (ha : ω ≤ a) : ω * a = a :=
+@[simp] theorem aleph_0_mul_eq {a : cardinal} (ha : ℵ₀ ≤ a) : ℵ₀ * a = a :=
 (mul_eq_max le_rfl ha).trans (max_eq_right ha)
 
-@[simp] theorem mul_omega_eq {a : cardinal} (ha : ω ≤ a) : a * ω = a :=
+@[simp] theorem mul_aleph_0_eq {a : cardinal} (ha : ℵ₀ ≤ a) : a * ℵ₀ = a :=
 (mul_eq_max ha le_rfl).trans (max_eq_left ha)
 
-@[simp] theorem omega_mul_mk_eq {α : Type*} [infinite α] : ω * #α = #α :=
-omega_mul_eq (omega_le_mk α)
+@[simp] theorem aleph_0_mul_mk_eq {α : Type*} [infinite α] : ℵ₀ * #α = #α :=
+aleph_0_mul_eq (aleph_0_le_mk α)
 
-@[simp] theorem mk_mul_omega_eq {α : Type*} [infinite α] : #α * ω = #α :=
-mul_omega_eq (omega_le_mk α)
+@[simp] theorem mk_mul_aleph_0_eq {α : Type*} [infinite α] : #α * ℵ₀ = #α :=
+mul_aleph_0_eq (aleph_0_le_mk α)
 
-@[simp] theorem omega_mul_aleph (o : ordinal) : ω * aleph o = aleph o :=
-omega_mul_eq (omega_le_aleph o)
+@[simp] theorem aleph_0_mul_aleph (o : ordinal) : ℵ₀ * aleph o = aleph o :=
+aleph_0_mul_eq (aleph_0_le_aleph o)
 
-@[simp] theorem aleph_mul_omega (o : ordinal) : aleph o * ω = aleph o :=
-mul_omega_eq (omega_le_aleph o)
+@[simp] theorem aleph_mul_aleph_0 (o : ordinal) : aleph o * ℵ₀ = aleph o :=
+mul_aleph_0_eq (aleph_0_le_aleph o)
 
-theorem mul_lt_of_lt {a b c : cardinal} (hc : ω ≤ c)
-  (h1 : a < c) (h2 : b < c) : a * b < c :=
-lt_of_le_of_lt (mul_le_mul' (le_max_left a b) (le_max_right a b)) $
-(lt_or_le (max a b) ω).elim
-  (λ h, lt_of_lt_of_le (mul_lt_omega h h) hc)
-  (λ h, by rw mul_eq_self h; exact max_lt h1 h2)
+theorem mul_lt_of_lt {a b c : cardinal} (hc : ℵ₀ ≤ c) (h1 : a < c) (h2 : b < c) : a * b < c :=
+(mul_le_mul' (le_max_left a b) (le_max_right a b)).trans_lt $
+(lt_or_le (max a b) ℵ₀).elim
+  (λ h, (mul_lt_aleph_0 h h).trans_le hc)
+  (λ h, by { rw mul_eq_self h, exact max_lt h1 h2 })
 
-lemma mul_le_max_of_omega_le_left {a b : cardinal} (h : ω ≤ a) : a * b ≤ max a b :=
+lemma mul_le_max_of_aleph_0_le_left {a b : cardinal} (h : ℵ₀ ≤ a) : a * b ≤ max a b :=
 begin
   convert mul_le_mul' (le_max_left a b) (le_max_right a b),
-  rw [mul_eq_self],
-  refine le_trans h (le_max_left a b)
+  rw mul_eq_self,
+  refine h.trans (le_max_left a b)
 end
 
-lemma mul_eq_max_of_omega_le_left {a b : cardinal} (h : ω ≤ a) (h' : b ≠ 0) : a * b = max a b :=
+lemma mul_eq_max_of_aleph_0_le_left {a b : cardinal} (h : ℵ₀ ≤ a) (h' : b ≠ 0) : a * b = max a b :=
 begin
-  cases le_or_lt ω b with hb hb, { exact mul_eq_max h hb },
-  refine (mul_le_max_of_omega_le_left h).antisymm _,
+  cases le_or_lt ℵ₀ b with hb hb, { exact mul_eq_max h hb },
+  refine (mul_le_max_of_aleph_0_le_left h).antisymm _,
   have : b ≤ a, from hb.le.trans h,
   rw [max_eq_left this],
   convert mul_le_mul_left' (one_le_iff_ne_zero.mpr h') _, rw [mul_one],
 end
 
-lemma mul_eq_max' {a b : cardinal} (h : ω ≤ a * b) : a * b = max a b :=
+lemma mul_le_max_of_aleph_0_le_right {a b : cardinal} (h : ℵ₀ ≤ b) : a * b ≤ max a b :=
+by simpa only [mul_comm, max_comm] using mul_le_max_of_aleph_0_le_left h
+
+lemma mul_eq_max_of_aleph_0_le_right {a b : cardinal} (h' : a ≠ 0) (h : ℵ₀ ≤ b) : a * b = max a b :=
 begin
-  rcases omega_le_mul_iff.mp h with ⟨ha, hb, h⟩,
-  wlog h : ω ≤ a := h using [a b],
-  exact mul_eq_max_of_omega_le_left h hb
+  rw [mul_comm, max_comm],
+  exact mul_eq_max_of_aleph_0_le_left h h'
 end
 
-theorem mul_le_max (a b : cardinal) : a * b ≤ max (max a b) ω :=
+lemma mul_eq_max' {a b : cardinal} (h : ℵ₀ ≤ a * b) : a * b = max a b :=
 begin
-  by_cases ha0 : a = 0,
-  { simp [ha0] },
-  by_cases hb0 : b = 0,
-  { simp [hb0] },
-  by_cases ha : ω ≤ a,
-  { rw [mul_eq_max_of_omega_le_left ha hb0],
+  rcases aleph_0_le_mul_iff.mp h with ⟨ha, hb, ha' | hb'⟩,
+  { exact mul_eq_max_of_aleph_0_le_left ha' hb },
+  { exact mul_eq_max_of_aleph_0_le_right ha hb' }
+end
+
+theorem mul_le_max (a b : cardinal) : a * b ≤ max (max a b) ℵ₀ :=
+begin
+  rcases eq_or_ne a 0 with rfl | ha0, { simp },
+  rcases eq_or_ne b 0 with rfl | hb0, { simp },
+  cases le_or_lt ℵ₀ a with ha ha,
+  { rw [mul_eq_max_of_aleph_0_le_left ha hb0],
     exact le_max_left _ _ },
-  { by_cases hb : ω ≤ b,
-    { rw [mul_comm, mul_eq_max_of_omega_le_left hb ha0, max_comm],
+  { cases le_or_lt ℵ₀ b with hb hb,
+    { rw [mul_comm, mul_eq_max_of_aleph_0_le_left hb ha0, max_comm],
       exact le_max_left _ _ },
-    { exact le_max_of_le_right (le_of_lt (mul_lt_omega (lt_of_not_ge ha) (lt_of_not_ge hb))) } }
+    { exact le_max_of_le_right (mul_lt_aleph_0 ha hb).le } }
 end
 
-lemma mul_eq_left {a b : cardinal} (ha : ω ≤ a) (hb : b ≤ a) (hb' : b ≠ 0) : a * b = a :=
-by { rw [mul_eq_max_of_omega_le_left ha hb', max_eq_left hb] }
+lemma mul_eq_left {a b : cardinal} (ha : ℵ₀ ≤ a) (hb : b ≤ a) (hb' : b ≠ 0) : a * b = a :=
+by { rw [mul_eq_max_of_aleph_0_le_left ha hb', max_eq_left hb] }
 
-lemma mul_eq_right {a b : cardinal} (hb : ω ≤ b) (ha : a ≤ b) (ha' : a ≠ 0) : a * b = b :=
+lemma mul_eq_right {a b : cardinal} (hb : ℵ₀ ≤ b) (ha : a ≤ b) (ha' : a ≠ 0) : a * b = b :=
 by { rw [mul_comm, mul_eq_left hb ha ha'] }
 
 lemma le_mul_left {a b : cardinal} (h : b ≠ 0) : a ≤ b * a :=
@@ -443,77 +554,75 @@ by { convert mul_le_mul_right' (one_le_iff_ne_zero.mpr h) _,
 lemma le_mul_right {a b : cardinal} (h : b ≠ 0) : a ≤ a * b :=
 by { rw [mul_comm], exact le_mul_left h }
 
-lemma mul_eq_left_iff {a b : cardinal} : a * b = a ↔ ((max ω b ≤ a ∧ b ≠ 0) ∨ b = 1 ∨ a = 0) :=
+lemma mul_eq_left_iff {a b : cardinal} : a * b = a ↔ ((max ℵ₀ b ≤ a ∧ b ≠ 0) ∨ b = 1 ∨ a = 0) :=
 begin
-  rw [max_le_iff], split,
-  { intro h,
-    cases (le_or_lt ω a) with ha ha,
-    { have : a ≠ 0, { rintro rfl, exact not_lt_of_le ha omega_pos },
+  rw max_le_iff,
+  refine ⟨λ h, _, _⟩,
+  { cases le_or_lt ℵ₀ a with ha ha,
+    { have : a ≠ 0, { rintro rfl, exact ha.not_lt aleph_0_pos },
       left, use ha,
-      { rw [← not_lt], intro hb, apply ne_of_gt _ h, refine lt_of_lt_of_le hb (le_mul_left this) },
-      { rintro rfl, apply this, rw [_root_.mul_zero] at h, subst h }},
-    right, by_cases h2a : a = 0, { right, exact h2a },
-    have hb : b ≠ 0, { rintro rfl, apply h2a, rw [mul_zero] at h, subst h },
-    left, rw [← h, mul_lt_omega_iff, lt_omega, lt_omega] at ha,
+      { rw ←not_lt, exact λ hb, ne_of_gt (hb.trans_le (le_mul_left this)) h },
+      { rintro rfl, apply this, rw mul_zero at h, exact h.symm }},
+    right, by_cases h2a : a = 0, { exact or.inr h2a },
+    have hb : b ≠ 0, { rintro rfl, apply h2a, rw mul_zero at h, exact h.symm },
+    left, rw [←h, mul_lt_aleph_0_iff, lt_aleph_0, lt_aleph_0] at ha,
     rcases ha with rfl|rfl|⟨⟨n, rfl⟩, ⟨m, rfl⟩⟩, contradiction, contradiction,
-    rw [← ne] at h2a, rw [← one_le_iff_ne_zero] at h2a hb, norm_cast at h2a hb h ⊢,
-    apply le_antisymm _ hb, rw [← not_lt], intro h2b,
-    apply ne_of_gt _ h, conv_lhs { rw [← mul_one n] },
-    rwa [mul_lt_mul_left], apply nat.lt_of_succ_le h2a },
+    rw ←ne at h2a, rw ←one_le_iff_ne_zero at h2a hb, norm_cast at h2a hb h ⊢,
+    apply le_antisymm _ hb, rw ←not_lt,
+    apply λ h2b, ne_of_gt _ h, conv_lhs { rw ←mul_one n },
+    rwa mul_lt_mul_left, apply nat.lt_of_succ_le h2a },
   { rintro (⟨⟨ha, hab⟩, hb⟩|rfl|rfl),
-    { rw [mul_eq_max_of_omega_le_left ha hb, max_eq_left hab] },
-    all_goals {simp}}
+    { rw [mul_eq_max_of_aleph_0_le_left ha hb, max_eq_left hab] },
+    all_goals { simp }}
 end
 
 /-! ### Properties of `add` -/
 
 /-- If `α` is an infinite type, then `α ⊕ α` and `α` have the same cardinality. -/
-theorem add_eq_self {c : cardinal} (h : ω ≤ c) : c + c = c :=
+theorem add_eq_self {c : cardinal} (h : ℵ₀ ≤ c) : c + c = c :=
 le_antisymm
   (by simpa only [nat.cast_bit0, nat.cast_one, mul_eq_self h, two_mul] using
-     mul_le_mul_right' ((nat_lt_omega 2).le.trans h) c)
+     mul_le_mul_right' ((nat_lt_aleph_0 2).le.trans h) c)
   (self_le_add_left c c)
 
 /-- If `α` is an infinite type, then the cardinality of `α ⊕ β` is the maximum
 of the cardinalities of `α` and `β`. -/
-theorem add_eq_max {a b : cardinal} (ha : ω ≤ a) : a + b = max a b :=
+theorem add_eq_max {a b : cardinal} (ha : ℵ₀ ≤ a) : a + b = max a b :=
 le_antisymm
-  (add_eq_self (le_trans ha (le_max_left a b)) ▸
+  (add_eq_self (ha.trans (le_max_left a b)) ▸
     add_le_add (le_max_left _ _) (le_max_right _ _)) $
 max_le (self_le_add_right _ _) (self_le_add_left _ _)
 
-theorem add_eq_max' {a b : cardinal} (ha : ω ≤ b) : a + b = max a b :=
+theorem add_eq_max' {a b : cardinal} (ha : ℵ₀ ≤ b) : a + b = max a b :=
 by rw [add_comm, max_comm, add_eq_max ha]
 
 @[simp] theorem add_mk_eq_max {α β : Type*} [infinite α] : #α + #β = max (#α) (#β) :=
-add_eq_max (omega_le_mk α)
+add_eq_max (aleph_0_le_mk α)
 
 @[simp] theorem add_mk_eq_max' {α β : Type*} [infinite β] : #α + #β = max (#α) (#β) :=
-add_eq_max' (omega_le_mk β)
+add_eq_max' (aleph_0_le_mk β)
 
-theorem add_le_max (a b : cardinal) : a + b ≤ max (max a b) ω :=
+theorem add_le_max (a b : cardinal) : a + b ≤ max (max a b) ℵ₀ :=
 begin
-  by_cases ha : ω ≤ a,
+  cases le_or_lt ℵ₀ a with ha ha,
   { rw [add_eq_max ha],
     exact le_max_left _ _ },
-  { by_cases hb : ω ≤ b,
+  { cases le_or_lt ℵ₀ b with hb hb,
     { rw [add_comm, add_eq_max hb, max_comm],
       exact le_max_left _ _ },
-    { exact le_max_of_le_right (le_of_lt (add_lt_omega (lt_of_not_ge ha) (lt_of_not_ge hb))) } }
+    { exact le_max_of_le_right (add_lt_aleph_0 ha hb).le } }
 end
 
-theorem add_le_of_le {a b c : cardinal} (hc : ω ≤ c)
-  (h1 : a ≤ c) (h2 : b ≤ c) : a + b ≤ c :=
+theorem add_le_of_le {a b c : cardinal} (hc : ℵ₀ ≤ c) (h1 : a ≤ c) (h2 : b ≤ c) : a + b ≤ c :=
 (add_le_add h1 h2).trans $ le_of_eq $ add_eq_self hc
 
-theorem add_lt_of_lt {a b c : cardinal} (hc : ω ≤ c)
-  (h1 : a < c) (h2 : b < c) : a + b < c :=
-lt_of_le_of_lt (add_le_add (le_max_left a b) (le_max_right a b)) $
-(lt_or_le (max a b) ω).elim
-  (λ h, lt_of_lt_of_le (add_lt_omega h h) hc)
+theorem add_lt_of_lt {a b c : cardinal} (hc : ℵ₀ ≤ c) (h1 : a < c) (h2 : b < c) : a + b < c :=
+(add_le_add (le_max_left a b) (le_max_right a b)).trans_lt $
+(lt_or_le (max a b) ℵ₀).elim
+  (λ h, (add_lt_aleph_0 h h).trans_le hc)
   (λ h, by rw add_eq_self h; exact max_lt h1 h2)
 
-lemma eq_of_add_eq_of_omega_le {a b c : cardinal} (h : a + b = c) (ha : a < c) (hc : ω ≤ c) :
+lemma eq_of_add_eq_of_aleph_0_le {a b c : cardinal} (h : a + b = c) (ha : a < c) (hc : ℵ₀ ≤ c) :
   b = c :=
 begin
   apply le_antisymm,
@@ -523,83 +632,115 @@ begin
   simpa [h, lt_irrefl] using this
 end
 
-lemma add_eq_left {a b : cardinal} (ha : ω ≤ a) (hb : b ≤ a) : a + b = a :=
+lemma add_eq_left {a b : cardinal} (ha : ℵ₀ ≤ a) (hb : b ≤ a) : a + b = a :=
 by { rw [add_eq_max ha, max_eq_left hb] }
 
-lemma add_eq_right {a b : cardinal} (hb : ω ≤ b) (ha : a ≤ b) : a + b = b :=
+lemma add_eq_right {a b : cardinal} (hb : ℵ₀ ≤ b) (ha : a ≤ b) : a + b = b :=
 by { rw [add_comm, add_eq_left hb ha] }
 
-lemma add_eq_left_iff {a b : cardinal} : a + b = a ↔ (max ω b ≤ a ∨ b = 0) :=
+lemma add_eq_left_iff {a b : cardinal} : a + b = a ↔ (max ℵ₀ b ≤ a ∨ b = 0) :=
 begin
-  rw [max_le_iff], split,
-  { intro h, cases (le_or_lt ω a) with ha ha,
-    { left, use ha, rw [← not_lt], intro hb, apply ne_of_gt _ h,
-      exact lt_of_lt_of_le hb (self_le_add_left b a) },
-    right, rw [← h, add_lt_omega_iff, lt_omega, lt_omega] at ha,
+  rw max_le_iff,
+  refine ⟨λ h, _, _⟩,
+  { cases (le_or_lt ℵ₀ a) with ha ha,
+    { left, use ha, rw ←not_lt, apply λ hb, ne_of_gt _ h,
+      exact hb.trans_le (self_le_add_left b a) },
+    right, rw [←h, add_lt_aleph_0_iff, lt_aleph_0, lt_aleph_0] at ha,
     rcases ha with ⟨⟨n, rfl⟩, ⟨m, rfl⟩⟩, norm_cast at h ⊢,
-    rw [← add_right_inj, h, add_zero] },
-  { rintro (⟨h1, h2⟩|h3), rw [add_eq_max h1, max_eq_left h2], rw [h3, add_zero] }
+    rw [←add_right_inj, h, add_zero] },
+  { rintro (⟨h1, h2⟩|h3),
+    { rw [add_eq_max h1, max_eq_left h2] },
+    { rw [h3, add_zero] } }
 end
 
-lemma add_eq_right_iff {a b : cardinal} : a + b = b ↔ (max ω a ≤ b ∨ a = 0) :=
+lemma add_eq_right_iff {a b : cardinal} : a + b = b ↔ (max ℵ₀ a ≤ b ∨ a = 0) :=
 by { rw [add_comm, add_eq_left_iff] }
 
-lemma add_one_eq {a : cardinal} (ha : ω ≤ a) : a + 1 = a :=
-have 1 ≤ a, from le_trans (le_of_lt one_lt_omega) ha,
-add_eq_left ha this
+lemma add_nat_eq {a : cardinal} (n : ℕ) (ha : ℵ₀ ≤ a) : a + n = a :=
+add_eq_left ha ((nat_lt_aleph_0 _).le.trans ha)
+
+lemma add_one_eq {a : cardinal} (ha : ℵ₀ ≤ a) : a + 1 = a :=
+add_eq_left ha (one_le_aleph_0.trans ha)
 
 @[simp] lemma mk_add_one_eq {α : Type*} [infinite α] : #α + 1 = #α :=
-add_one_eq (omega_le_mk α)
+add_one_eq (aleph_0_le_mk α)
 
-protected lemma eq_of_add_eq_add_left {a b c : cardinal} (h : a + b = a + c) (ha : a < ω) :
+protected lemma eq_of_add_eq_add_left {a b c : cardinal} (h : a + b = a + c) (ha : a < ℵ₀) :
   b = c :=
 begin
-  cases le_or_lt ω b with hb hb,
-  { have : a < b := lt_of_lt_of_le ha hb,
-    rw [add_eq_right hb (le_of_lt this), eq_comm] at h,
-    rw [eq_of_add_eq_of_omega_le h this hb] },
-  { have hc : c < ω,
-    { rw [← not_le], intro hc,
-      apply lt_irrefl ω, apply lt_of_le_of_lt (le_trans hc (self_le_add_left _ a)),
-      rw [← h], apply add_lt_omega ha hb },
-    rw [lt_omega] at *,
+  cases le_or_lt ℵ₀ b with hb hb,
+  { have : a < b := ha.trans_le hb,
+    rw [add_eq_right hb this.le, eq_comm] at h,
+    rw [eq_of_add_eq_of_aleph_0_le h this hb] },
+  { have hc : c < ℵ₀,
+    { rw ←not_le, intro hc,
+      apply lt_irrefl ℵ₀, apply (hc.trans (self_le_add_left _ a)).trans_lt,
+      rw ←h, apply add_lt_aleph_0 ha hb },
+    rw lt_aleph_0 at *,
     rcases ha with ⟨n, rfl⟩, rcases hb with ⟨m, rfl⟩, rcases hc with ⟨k, rfl⟩,
     norm_cast at h ⊢, apply add_left_cancel h }
 end
 
-protected lemma eq_of_add_eq_add_right {a b c : cardinal} (h : a + b = c + b) (hb : b < ω) :
+protected lemma eq_of_add_eq_add_right {a b c : cardinal} (h : a + b = c + b) (hb : b < ℵ₀) :
   a = c :=
 by { rw [add_comm a b, add_comm c b] at h, exact cardinal.eq_of_add_eq_add_left h hb }
 
 @[simp] theorem aleph_add_aleph (o₁ o₂ : ordinal) : aleph o₁ + aleph o₂ = aleph (max o₁ o₂) :=
-by rw [cardinal.add_eq_max (omega_le_aleph o₁), max_aleph_eq]
+by rw [cardinal.add_eq_max (aleph_0_le_aleph o₁), max_aleph_eq]
 
-theorem principal_add_ord {c : cardinal} (hc : ω ≤ c) : ordinal.principal (+) c.ord :=
+theorem principal_add_ord {c : cardinal} (hc : ℵ₀ ≤ c) : ordinal.principal (+) c.ord :=
 λ a b ha hb, by { rw [lt_ord, ordinal.card_add] at *, exact add_lt_of_lt hc ha hb }
 
 theorem principal_add_aleph (o : ordinal) : ordinal.principal (+) (aleph o).ord :=
-principal_add_ord $ omega_le_aleph o
+principal_add_ord $ aleph_0_le_aleph o
+
+lemma add_right_inj_of_lt_aleph_0 {α β γ : cardinal} (γ₀ : γ < aleph_0) :
+  α + γ = β + γ ↔ α = β :=
+⟨λ h, cardinal.eq_of_add_eq_add_right h γ₀, λ h, congr_fun (congr_arg (+) h) γ⟩
+
+@[simp] lemma add_nat_inj {α β : cardinal} (n : ℕ) :
+  α + n = β + n ↔ α = β :=
+add_right_inj_of_lt_aleph_0 (nat_lt_aleph_0 _)
+
+@[simp] lemma add_one_inj {α β : cardinal} :
+  α + 1 = β + 1 ↔ α = β :=
+add_right_inj_of_lt_aleph_0 one_lt_aleph_0
+
+lemma add_le_add_iff_of_lt_aleph_0 {α β γ : cardinal} (γ₀ : γ < cardinal.aleph_0) :
+  α + γ ≤ β + γ ↔ α ≤ β :=
+begin
+  refine ⟨λ h, _, λ h, add_le_add_right h γ⟩,
+  contrapose h,
+  rw [not_le, lt_iff_le_and_ne, ne] at h ⊢,
+  exact ⟨add_le_add_right h.1 γ, mt (add_right_inj_of_lt_aleph_0 γ₀).1 h.2⟩,
+end
+
+@[simp] lemma add_nat_le_add_nat_iff_of_lt_aleph_0 {α β : cardinal} (n : ℕ) :
+  α + n ≤ β + n ↔ α ≤ β :=
+add_le_add_iff_of_lt_aleph_0 (nat_lt_aleph_0 n)
+
+@[simp] lemma add_one_le_add_one_iff_of_lt_aleph_0 {α β : cardinal} :
+  α + 1 ≤ β + 1 ↔ α ≤ β :=
+add_le_add_iff_of_lt_aleph_0 one_lt_aleph_0
 
 /-! ### Properties about power -/
 
-theorem pow_le {κ μ : cardinal.{u}} (H1 : ω ≤ κ) (H2 : μ < ω) : κ ^ μ ≤ κ :=
-let ⟨n, H3⟩ := lt_omega.1 H2 in
+theorem pow_le {κ μ : cardinal.{u}} (H1 : ℵ₀ ≤ κ) (H2 : μ < ℵ₀) : κ ^ μ ≤ κ :=
+let ⟨n, H3⟩ := lt_aleph_0.1 H2 in
 H3.symm ▸ (quotient.induction_on κ (λ α H1, nat.rec_on n
-  (le_of_lt $ lt_of_lt_of_le (by rw [nat.cast_zero, power_zero];
-    from one_lt_omega) H1)
+  (lt_of_lt_of_le (by { rw [nat.cast_zero, power_zero], exact one_lt_aleph_0 }) H1).le
   (λ n ih, trans_rel_left _
-    (by { rw [nat.cast_succ, power_add, power_one];
-      exact mul_le_mul_right' ih _ })
+    (by { rw [nat.cast_succ, power_add, power_one], exact mul_le_mul_right' ih _ })
     (mul_eq_self H1))) H1)
 
-theorem pow_eq {κ μ : cardinal.{u}} (H1 : ω ≤ κ) (H2 : 1 ≤ μ) (H3 : μ < ω) : κ ^ μ = κ :=
+theorem pow_eq {κ μ : cardinal.{u}} (H1 : ℵ₀ ≤ κ) (H2 : 1 ≤ μ) (H3 : μ < ℵ₀) : κ ^ μ = κ :=
 (pow_le H1 H3).antisymm $ self_le_power κ H2
 
-lemma power_self_eq {c : cardinal} (h : ω ≤ c) : c ^ c = 2 ^ c :=
+lemma power_self_eq {c : cardinal} (h : ℵ₀ ≤ c) : c ^ c = 2 ^ c :=
 begin
-  apply le_antisymm,
-  { apply le_trans (power_le_power_right $ le_of_lt $ cantor c), rw [← power_mul, mul_eq_self h] },
-  { convert power_le_power_right (le_trans (le_of_lt $ nat_lt_omega 2) h), apply nat.cast_two.symm }
+  apply ((power_le_power_right $ (cantor c).le).trans _).antisymm,
+  { convert power_le_power_right ((nat_lt_aleph_0 2).le.trans h), apply nat.cast_two.symm },
+  { rw [←power_mul, mul_eq_self h] }
 end
 
 lemma prod_eq_two_power {ι : Type u} [infinite ι] {c : ι → cardinal.{v}} (h₁ : ∀ i, 2 ≤ c i)
@@ -609,90 +750,135 @@ begin
   rw [← lift_id' (prod c), lift_prod, ← lift_two_power],
   apply le_antisymm,
   { refine (prod_le_prod _ _ h₂).trans_eq _,
-    rw [prod_const, lift_lift, ← lift_power, power_self_eq (omega_le_mk ι), lift_umax.{u v}] },
+    rw [prod_const, lift_lift, ← lift_power, power_self_eq (aleph_0_le_mk ι), lift_umax.{u v}] },
   { rw [← prod_const', lift_prod],
     refine prod_le_prod _ _ (λ i, _),
     rw [lift_two, ← lift_two.{u v}, lift_le],
     exact h₁ i }
 end
 
-lemma power_eq_two_power {c₁ c₂ : cardinal} (h₁ : ω ≤ c₁) (h₂ : 2 ≤ c₂) (h₂' : c₂ ≤ c₁) :
+lemma power_eq_two_power {c₁ c₂ : cardinal} (h₁ : ℵ₀ ≤ c₁) (h₂ : 2 ≤ c₂) (h₂' : c₂ ≤ c₁) :
   c₂ ^ c₁ = 2 ^ c₁ :=
 le_antisymm (power_self_eq h₁ ▸ power_le_power_right h₂') (power_le_power_right h₂)
 
-lemma nat_power_eq {c : cardinal.{u}} (h : ω ≤ c) {n : ℕ} (hn : 2 ≤ n) :
+lemma nat_power_eq {c : cardinal.{u}} (h : ℵ₀ ≤ c) {n : ℕ} (hn : 2 ≤ n) :
   (n : cardinal.{u}) ^ c = 2 ^ c :=
-power_eq_two_power h (by assumption_mod_cast) ((nat_lt_omega n).le.trans h)
+power_eq_two_power h (by assumption_mod_cast) ((nat_lt_aleph_0 n).le.trans h)
 
-lemma power_nat_le {c : cardinal.{u}} {n : ℕ} (h : ω ≤ c) : c ^ n ≤ c :=
-pow_le h (nat_lt_omega n)
+lemma power_nat_le {c : cardinal.{u}} {n : ℕ} (h : ℵ₀ ≤ c) : c ^ n ≤ c :=
+pow_le h (nat_lt_aleph_0 n)
 
-lemma power_nat_eq {c : cardinal.{u}} {n : ℕ} (h1 : ω ≤ c) (h2 : 1 ≤ n) : c ^ n = c :=
-pow_eq h1 (by exact_mod_cast h2) (nat_lt_omega n)
+lemma power_nat_eq {c : cardinal.{u}} {n : ℕ} (h1 : ℵ₀ ≤ c) (h2 : 1 ≤ n) : c ^ n = c :=
+pow_eq h1 (by exact_mod_cast h2) (nat_lt_aleph_0 n)
 
-lemma power_nat_le_max {c : cardinal.{u}} {n : ℕ} : c ^ (n : cardinal.{u}) ≤ max c ω :=
+lemma power_nat_le_max {c : cardinal.{u}} {n : ℕ} : c ^ (n : cardinal.{u}) ≤ max c ℵ₀ :=
 begin
-  by_cases hc : ω ≤ c,
+  cases le_or_lt ℵ₀ c with hc hc,
   { exact le_max_of_le_left (power_nat_le hc) },
-  { exact le_max_of_le_right (le_of_lt (power_lt_omega (lt_of_not_ge hc) (nat_lt_omega _))) }
+  { exact le_max_of_le_right ((power_lt_aleph_0 hc (nat_lt_aleph_0 _)).le) }
 end
 
-@[simp] lemma powerlt_omega {c : cardinal} (h : ω ≤ c) : c ^< ω = c :=
+lemma powerlt_aleph_0 {c : cardinal} (h : ℵ₀ ≤ c) : c ^< ℵ₀ = c :=
 begin
   apply le_antisymm,
-  { rw [powerlt_le], intro c', rw [lt_omega], rintro ⟨n, rfl⟩, apply power_nat_le h },
-  convert le_powerlt one_lt_omega, rw [power_one]
+  { rw powerlt_le, intro c', rw lt_aleph_0, rintro ⟨n, rfl⟩, apply power_nat_le h },
+  convert le_powerlt c one_lt_aleph_0, rw power_one
 end
 
-lemma powerlt_omega_le (c : cardinal) : c ^< ω ≤ max c ω :=
+lemma powerlt_aleph_0_le (c : cardinal) : c ^< ℵ₀ ≤ max c ℵ₀ :=
 begin
-  cases le_or_lt ω c,
-  { rw [powerlt_omega h], apply le_max_left },
-  rw [powerlt_le], intros c' hc',
-  refine le_trans (le_of_lt $ power_lt_omega h hc') (le_max_right _ _)
+  cases le_or_lt ℵ₀ c,
+  { rw powerlt_aleph_0 h, apply le_max_left },
+  rw powerlt_le,
+  exact λ c' hc', (power_lt_aleph_0 h hc').le.trans (le_max_right _ _)
 end
 
 /-! ### Computing cardinality of various types -/
 
-theorem mk_list_eq_mk (α : Type u) [infinite α] : #(list α) = #α :=
-have H1 : ω ≤ #α := omega_le_mk α,
+@[simp] theorem mk_list_eq_mk (α : Type u) [infinite α] : #(list α) = #α :=
+have H1 : ℵ₀ ≤ #α := aleph_0_le_mk α,
 eq.symm $ le_antisymm ⟨⟨λ x, [x], λ x y H, (list.cons.inj H).1⟩⟩ $
 calc  #(list α)
     = sum (λ n : ℕ, #α ^ (n : cardinal.{u})) : mk_list_eq_sum_pow α
-... ≤ sum (λ n : ℕ, #α) : sum_le_sum _ _ $ λ n, pow_le H1 $ nat_lt_omega n
+... ≤ sum (λ n : ℕ, #α) : sum_le_sum _ _ $ λ n, pow_le H1 $ nat_lt_aleph_0 n
 ... = #α : by simp [H1]
 
-theorem mk_list_eq_omega (α : Type u) [encodable α] [nonempty α] : #(list α) = ω :=
-mk_le_omega.antisymm (omega_le_mk _)
+theorem mk_list_eq_aleph_0 (α : Type u) [countable α] [nonempty α] : #(list α) = ℵ₀ :=
+mk_le_aleph_0.antisymm (aleph_0_le_mk _)
 
-theorem mk_list_eq_max_mk_omega (α : Type u) [nonempty α] : #(list α) = max (#α) ω :=
+theorem mk_list_eq_max_mk_aleph_0 (α : Type u) [nonempty α] : #(list α) = max (#α) ℵ₀ :=
 begin
-  casesI fintype_or_infinite α,
-  { haveI : encodable α := fintype.to_encodable α,
-    rw [mk_list_eq_omega, eq_comm, max_eq_right],
-    exact mk_le_omega },
+  casesI finite_or_infinite α,
+  { rw [mk_list_eq_aleph_0, eq_comm, max_eq_right],
+    exact mk_le_aleph_0 },
   { rw [mk_list_eq_mk, eq_comm, max_eq_left],
-    exact omega_le_mk α }
+    exact aleph_0_le_mk α }
 end
 
-theorem mk_list_le_max (α : Type u) : #(list α) ≤ max ω (#α) :=
+theorem mk_list_le_max (α : Type u) : #(list α) ≤ max ℵ₀ (#α) :=
 begin
-  casesI fintype_or_infinite α,
-  { haveI := fintype.to_encodable α,
-    exact mk_le_omega.trans (le_max_left _ _) },
+  casesI finite_or_infinite α,
+  { exact mk_le_aleph_0.trans (le_max_left _ _) },
   { rw mk_list_eq_mk,
     apply le_max_right }
 end
 
-theorem mk_finset_eq_mk (α : Type u) [infinite α] : #(finset α) = #α :=
+@[simp] theorem mk_finset_of_infinite (α : Type u) [infinite α] : #(finset α) = #α :=
 eq.symm $ le_antisymm (mk_le_of_injective (λ x y, finset.singleton_inj.1)) $
 calc #(finset α) ≤ #(list α) : mk_le_of_surjective list.to_finset_surjective
 ... = #α : mk_list_eq_mk α
 
+@[simp] lemma mk_finsupp_lift_of_infinite (α : Type u) (β : Type v) [infinite α] [has_zero β]
+  [nontrivial β] : #(α →₀ β) = max (lift.{v} (#α)) (lift.{u} (#β)) :=
+begin
+  apply le_antisymm,
+  { calc #(α →₀ β) ≤ # (finset (α × β)) : mk_le_of_injective (finsupp.graph_injective α β)
+    ... = #(α × β) : mk_finset_of_infinite _
+    ... = max (lift.{v} (#α)) (lift.{u} (#β)) :
+      by rw [mk_prod, mul_eq_max_of_aleph_0_le_left]; simp },
+  { apply max_le;
+    rw [←lift_id (# (α →₀ β)), ←lift_umax],
+    { cases exists_ne (0 : β) with b hb,
+      exact lift_mk_le.{u (max u v) v}.2 ⟨⟨_, finsupp.single_left_injective hb⟩⟩ },
+    { inhabit α,
+      exact lift_mk_le.{v (max u v) u}.2 ⟨⟨_, finsupp.single_injective default⟩⟩ } }
+end
+
+lemma mk_finsupp_of_infinite (α β : Type u) [infinite α] [has_zero β]
+  [nontrivial β] : #(α →₀ β) = max (#α) (#β) :=
+by simp
+
+@[simp] lemma mk_finsupp_lift_of_infinite' (α : Type u) (β : Type v) [nonempty α]
+  [has_zero β] [infinite β] : #(α →₀ β) = max (lift.{v} (#α)) (lift.{u} (#β)) :=
+begin
+  casesI fintype_or_infinite α,
+  { rw mk_finsupp_lift_of_fintype,
+    have : ℵ₀ ≤ (#β).lift := aleph_0_le_lift.2 (aleph_0_le_mk β),
+    rw [max_eq_right (le_trans _ this), power_nat_eq this],
+    exacts [fintype.card_pos, lift_le_aleph_0.2 (lt_aleph_0_of_finite _).le] },
+  { apply mk_finsupp_lift_of_infinite },
+end
+
+lemma mk_finsupp_of_infinite' (α β : Type u) [nonempty α] [has_zero β] [infinite β] :
+  #(α →₀ β) = max (#α) (#β) := by simp
+
+lemma mk_finsupp_nat (α : Type u) [nonempty α] : #(α →₀ ℕ) = max (#α) ℵ₀ := by simp
+
+@[simp] lemma mk_multiset_of_nonempty (α : Type u) [nonempty α] : #(multiset α) = max (#α) ℵ₀ :=
+multiset.to_finsupp.to_equiv.cardinal_eq.trans (mk_finsupp_nat α)
+
+lemma mk_multiset_of_infinite (α : Type u) [infinite α] : #(multiset α) = #α := by simp
+
+@[simp] lemma mk_multiset_of_is_empty (α : Type u) [is_empty α] : #(multiset α) = 1 :=
+multiset.to_finsupp.to_equiv.cardinal_eq.trans (by simp)
+
+lemma mk_multiset_of_countable (α : Type u) [countable α] [nonempty α] : #(multiset α) = ℵ₀ :=
+multiset.to_finsupp.to_equiv.cardinal_eq.trans (by simp)
+
 lemma mk_bounded_set_le_of_infinite (α : Type u) [infinite α] (c : cardinal) :
-  #{t : set α // mk t ≤ c} ≤ #α ^ c :=
+  #{t : set α // #t ≤ c} ≤ #α ^ c :=
 begin
-  refine le_trans _ (by rw [←add_one_eq (omega_le_mk α)]),
+  refine le_trans _ (by rw [←add_one_eq (aleph_0_le_mk α)]),
   induction c using cardinal.induction_on with β,
   fapply mk_le_of_surjective,
   { intro f, use sum.inl ⁻¹' range f,
@@ -712,61 +898,61 @@ begin
 end
 
 lemma mk_bounded_set_le (α : Type u) (c : cardinal) :
-  #{t : set α // #t ≤ c} ≤ max (#α) ω ^ c :=
+  #{t : set α // #t ≤ c} ≤ max (#α) ℵ₀ ^ c :=
 begin
   transitivity #{t : set (ulift.{u} ℕ ⊕ α) // #t ≤ c},
   { refine ⟨embedding.subtype_map _ _⟩, apply embedding.image,
-    use sum.inr, apply sum.inr.inj, intros s hs, exact le_trans mk_image_le hs },
-  refine le_trans
-    (mk_bounded_set_le_of_infinite (ulift.{u} ℕ ⊕ α) c) _,
+    use sum.inr, apply sum.inr.inj, intros s hs, exact mk_image_le.trans hs },
+  apply (mk_bounded_set_le_of_infinite (ulift.{u} ℕ ⊕ α) c).trans,
   rw [max_comm, ←add_eq_max]; refl
 end
 
 lemma mk_bounded_subset_le {α : Type u} (s : set α) (c : cardinal.{u}) :
-  #{t : set α // t ⊆ s ∧ #t ≤ c} ≤ max (#s) ω ^ c :=
+  #{t : set α // t ⊆ s ∧ #t ≤ c} ≤ max (#s) ℵ₀ ^ c :=
 begin
   refine le_trans _ (mk_bounded_set_le s c),
   refine ⟨embedding.cod_restrict _ _ _⟩,
   use λ t, coe ⁻¹' t.1,
   { rintros ⟨t, ht1, ht2⟩ ⟨t', h1t', h2t'⟩ h, apply subtype.eq, dsimp only at h ⊢,
     refine (preimage_eq_preimage' _ _).1 h; rw [subtype.range_coe]; assumption },
-  rintro ⟨t, h1t, h2t⟩, exact le_trans (mk_preimage_of_injective _ _ subtype.val_injective) h2t
+  rintro ⟨t, h1t, h2t⟩, exact (mk_preimage_of_injective _ _ subtype.val_injective).trans h2t
 end
 
 /-! ### Properties of `compl` -/
 
 lemma mk_compl_of_infinite {α : Type*} [infinite α] (s : set α) (h2 : #s < #α) :
   #(sᶜ : set α) = #α :=
-by { refine eq_of_add_eq_of_omega_le _ h2 (omega_le_mk α), exact mk_sum_compl s }
+by { refine eq_of_add_eq_of_aleph_0_le _ h2 (aleph_0_le_mk α), exact mk_sum_compl s }
 
 lemma mk_compl_finset_of_infinite {α : Type*} [infinite α] (s : finset α) :
   #((↑s)ᶜ : set α) = #α :=
-by { apply mk_compl_of_infinite, exact (finset_card_lt_omega s).trans_le (omega_le_mk α) }
+by { apply mk_compl_of_infinite, exact (finset_card_lt_aleph_0 s).trans_le (aleph_0_le_mk α) }
 
 lemma mk_compl_eq_mk_compl_infinite {α : Type*} [infinite α] {s t : set α} (hs : #s < #α)
   (ht : #t < #α) : #(sᶜ : set α) = #(tᶜ : set α) :=
 by { rw [mk_compl_of_infinite s hs, mk_compl_of_infinite t ht] }
 
-lemma mk_compl_eq_mk_compl_finite_lift {α : Type u} {β : Type v} [fintype α]
-  {s : set α} {t : set β} (h1 : lift.{(max v w)} (#α) = lift.{(max u w)} (#β))
-  (h2 : lift.{(max v w)} (#s) = lift.{(max u w)} (#t)) :
-  lift.{(max v w)} (#(sᶜ : set α)) = lift.{(max u w)} (#(tᶜ : set β)) :=
+lemma mk_compl_eq_mk_compl_finite_lift {α : Type u} {β : Type v} [finite α]
+  {s : set α} {t : set β} (h1 : lift.{max v w} (#α) = lift.{max u w} (#β))
+  (h2 : lift.{max v w} (#s) = lift.{max u w} (#t)) :
+  lift.{max v w} (#(sᶜ : set α)) = lift.{max u w} (#(tᶜ : set β)) :=
 begin
+  casesI nonempty_fintype α,
   rcases lift_mk_eq.1 h1 with ⟨e⟩, letI : fintype β := fintype.of_equiv α e,
   replace h1 : fintype.card α = fintype.card β := (fintype.of_equiv_card _).symm,
   classical,
-  lift s to finset α using finite.of_fintype s,
-  lift t to finset β using finite.of_fintype t,
-  simp only [finset.coe_sort_coe, mk_finset, lift_nat_cast, nat.cast_inj] at h2,
-  simp only [← finset.coe_compl, finset.coe_sort_coe, mk_finset, finset.card_compl,
+  lift s to finset α using s.to_finite,
+  lift t to finset β using t.to_finite,
+  simp only [finset.coe_sort_coe, mk_coe_finset, lift_nat_cast, nat.cast_inj] at h2,
+  simp only [← finset.coe_compl, finset.coe_sort_coe, mk_coe_finset, finset.card_compl,
     lift_nat_cast, nat.cast_inj, h1, h2]
 end
 
-lemma mk_compl_eq_mk_compl_finite {α β : Type u} [fintype α] {s : set α} {t : set β}
+lemma mk_compl_eq_mk_compl_finite {α β : Type u} [finite α] {s : set α} {t : set β}
   (h1 : #α = #β) (h : #s = #t) : #(sᶜ : set α) = #(tᶜ : set β) :=
 by { rw ← lift_inj, apply mk_compl_eq_mk_compl_finite_lift; rwa [lift_inj] }
 
-lemma mk_compl_eq_mk_compl_finite_same {α : Type*} [fintype α] {s t : set α}
+lemma mk_compl_eq_mk_compl_finite_same {α : Type*} [finite α] {s t : set α}
   (h : #s = #t) : #(sᶜ : set α) = #(tᶜ : set α) :=
 mk_compl_eq_mk_compl_finite rfl h
 
@@ -783,7 +969,7 @@ begin
   refine ⟨h, _⟩, rintro ⟨x, hx⟩, simp [set.sum_compl_symm_apply_of_mem, hx]
 end
 
-theorem extend_function_finite {α β : Type*} [fintype α] {s : set α} (f : s ↪ β)
+theorem extend_function_finite {α β : Type*} [finite α] {s : set α} (f : s ↪ β)
   (h : nonempty (α ≃ β)) : ∃ (g : α ≃ β), ∀ x : s, g x = f x :=
 begin
   apply extend_function f,
@@ -830,86 +1016,80 @@ by simp [bit1]
 by { rw ←not_iff_not, simp [bit0], }
 
 @[simp] lemma zero_lt_bit1 (a : cardinal) : 0 < bit1 a :=
-lt_of_lt_of_le zero_lt_one (self_le_add_left _ _)
+zero_lt_one.trans_le (self_le_add_left _ _)
 
 @[simp] lemma one_le_bit0 (a : cardinal) : 1 ≤ bit0 a ↔ 0 < a :=
-⟨λ h, (zero_lt_bit0 a).mp (lt_of_lt_of_le zero_lt_one h),
- λ h, le_trans (one_le_iff_pos.mpr h) (self_le_add_left a a)⟩
+⟨λ h, (zero_lt_bit0 a).mp (zero_lt_one.trans_le h),
+ λ h, (one_le_iff_pos.mpr h).trans (self_le_add_left a a)⟩
 
 @[simp] lemma one_le_bit1 (a : cardinal) : 1 ≤ bit1 a :=
 self_le_add_left _ _
 
-theorem bit0_eq_self {c : cardinal} (h : ω ≤ c) : bit0 c = c :=
+theorem bit0_eq_self {c : cardinal} (h : ℵ₀ ≤ c) : bit0 c = c :=
 add_eq_self h
 
-@[simp] theorem bit0_lt_omega {c : cardinal} : bit0 c < ω ↔ c < ω :=
-by simp [bit0, add_lt_omega_iff]
+@[simp] theorem bit0_lt_aleph_0 {c : cardinal} : bit0 c < ℵ₀ ↔ c < ℵ₀ :=
+by simp [bit0, add_lt_aleph_0_iff]
 
-@[simp] theorem omega_le_bit0 {c : cardinal} : ω ≤ bit0 c ↔ ω ≤ c :=
-by { rw ← not_iff_not, simp }
+@[simp] theorem aleph_0_le_bit0 {c : cardinal} : ℵ₀ ≤ bit0 c ↔ ℵ₀ ≤ c :=
+by { rw ←not_iff_not, simp }
 
-@[simp] theorem bit1_eq_self_iff {c : cardinal} : bit1 c = c ↔ ω ≤ c :=
+@[simp] theorem bit1_eq_self_iff {c : cardinal} : bit1 c = c ↔ ℵ₀ ≤ c :=
 begin
-  by_cases h : ω ≤ c,
-  { simp only [bit1, bit0_eq_self h, h, eq_self_iff_true, add_one_of_omega_le] },
+  by_cases h : ℵ₀ ≤ c,
+  { simp only [bit1, bit0_eq_self h, h, eq_self_iff_true, add_one_of_aleph_0_le] },
   { refine iff_of_false (ne_of_gt _) h,
-    rcases lt_omega.1 (not_le.1 h) with ⟨n, rfl⟩,
+    rcases lt_aleph_0.1 (not_le.1 h) with ⟨n, rfl⟩,
     norm_cast,
     dsimp [bit1, bit0],
     linarith }
 end
 
-@[simp] theorem bit1_lt_omega {c : cardinal} : bit1 c < ω ↔ c < ω :=
-by simp [bit1, bit0, add_lt_omega_iff, one_lt_omega]
+@[simp] theorem bit1_lt_aleph_0 {c : cardinal} : bit1 c < ℵ₀ ↔ c < ℵ₀ :=
+by simp [bit1, bit0, add_lt_aleph_0_iff, one_lt_aleph_0]
 
-@[simp] theorem omega_le_bit1 {c : cardinal} : ω ≤ bit1 c ↔ ω ≤ c :=
-by { rw ← not_iff_not, simp }
+@[simp] theorem aleph_0_le_bit1 {c : cardinal} : ℵ₀ ≤ bit1 c ↔ ℵ₀ ≤ c :=
+by { rw ←not_iff_not, simp }
 
 @[simp] lemma bit0_le_bit0 {a b : cardinal} : bit0 a ≤ bit0 b ↔ a ≤ b :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
   { rw [bit0_eq_self ha, bit0_eq_self hb] },
   { rw bit0_eq_self ha,
-    refine iff_of_false (λ h, _) (not_le_of_lt (hb.trans_le ha)),
-    have A : bit0 b < ω, by simpa using hb,
-    exact lt_irrefl _ (lt_of_lt_of_le (lt_of_lt_of_le A ha) h) },
-  { rw [bit0_eq_self hb],
-    exact iff_of_true ((bit0_lt_omega.2 ha).le.trans hb) (ha.le.trans hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+    refine iff_of_false (λ h, _) (hb.trans_le ha).not_le,
+    have A : bit0 b < ℵ₀, by simpa using hb,
+    exact lt_irrefl _ ((A.trans_le ha).trans_le h) },
+  { rw bit0_eq_self hb,
+    exact iff_of_true ((bit0_lt_aleph_0.2 ha).le.trans hb) (ha.le.trans hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
     exact bit0_le_bit0 }
 end
 
 @[simp] lemma bit0_le_bit1 {a b : cardinal} : bit0 a ≤ bit1 b ↔ a ≤ b :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
-  { rw [bit0_eq_self ha, bit1_eq_self_iff.2 hb], },
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
+  { rw [bit0_eq_self ha, bit1_eq_self_iff.2 hb] },
   { rw bit0_eq_self ha,
-    refine iff_of_false (λ h, _) (not_le_of_lt (hb.trans_le ha)),
-    have A : bit1 b < ω, by simpa using hb,
-    exact lt_irrefl _ (lt_of_lt_of_le (lt_of_lt_of_le A ha) h) },
-  { rw [bit1_eq_self_iff.2 hb],
-    exact iff_of_true ((bit0_lt_omega.2 ha).le.trans hb) (ha.le.trans hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+    refine iff_of_false (λ h, _) (hb.trans_le ha).not_le,
+    have A : bit1 b < ℵ₀, by simpa using hb,
+    exact lt_irrefl _ ((A.trans_le ha).trans_le h) },
+  { rw bit1_eq_self_iff.2 hb,
+    exact iff_of_true ((bit0_lt_aleph_0.2 ha).le.trans hb) (ha.le.trans hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
     exact nat.bit0_le_bit1_iff }
 end
 
 @[simp] lemma bit1_le_bit1 {a b : cardinal} : bit1 a ≤ bit1 b ↔ a ≤ b :=
-begin
-  split,
-  { assume h,
-    apply bit0_le_bit1.1 (le_trans (self_le_add_right (bit0 a) 1) h) },
-  { assume h,
-    calc a + a + 1 ≤ a + b + 1 : add_le_add_right (add_le_add_left h a) 1
-           ... ≤ b + b + 1 : add_le_add_right (add_le_add_right h b) 1 }
-end
+⟨λ h, bit0_le_bit1.1 ((self_le_add_right (bit0 a) 1).trans h), λ h,
+  (add_le_add_right (add_le_add_left h a) 1).trans (add_le_add_right (add_le_add_right h b) 1)⟩
 
-@[simp] lemma bit1_le_bit0 {a b : cardinal} : bit1 a ≤ bit0 b ↔ (a < b ∨ (a ≤ b ∧ ω ≤ a)) :=
+@[simp] lemma bit1_le_bit0 {a b : cardinal} : bit1 a ≤ bit0 b ↔ (a < b ∨ (a ≤ b ∧ ℵ₀ ≤ a)) :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
   { simp only [bit1_eq_self_iff.mpr ha, bit0_eq_self hb, ha, and_true],
     refine ⟨λ h, or.inr h, λ h, _⟩,
     cases h,
@@ -917,78 +1097,78 @@ begin
     { exact h } },
   { rw bit1_eq_self_iff.2 ha,
     refine iff_of_false (λ h, _) (λ h, _),
-    { have A : bit0 b < ω, by simpa using hb,
-      exact lt_irrefl _ (lt_of_lt_of_le (lt_of_lt_of_le A ha) h) },
+    { have A : bit0 b < ℵ₀, by simpa using hb,
+      exact lt_irrefl _ ((A.trans_le ha).trans_le h) },
     { exact not_le_of_lt (hb.trans_le ha) (h.elim le_of_lt and.left) } },
-  { rw [bit0_eq_self hb],
-    exact iff_of_true ((bit1_lt_omega.2 ha).le.trans hb) (or.inl $ ha.trans_le hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+  { rw bit0_eq_self hb,
+    exact iff_of_true ((bit1_lt_aleph_0.2 ha).le.trans hb) (or.inl $ ha.trans_le hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
-    simp [not_le.mpr ha], }
+    simp [not_le.mpr ha] }
 end
 
 @[simp] lemma bit0_lt_bit0 {a b : cardinal} : bit0 a < bit0 b ↔ a < b :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
   { rw [bit0_eq_self ha, bit0_eq_self hb] },
   { rw bit0_eq_self ha,
-    refine iff_of_false (λ h, _) (not_lt_of_le (hb.le.trans ha)),
-    have A : bit0 b < ω, by simpa using hb,
-    exact lt_irrefl _ (lt_trans (lt_of_lt_of_le A ha) h) },
-  { rw [bit0_eq_self hb],
-    exact iff_of_true ((bit0_lt_omega.2 ha).trans_le hb) (ha.trans_le hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+    refine iff_of_false (λ h, _) (hb.le.trans ha).not_lt,
+    have A : bit0 b < ℵ₀, by simpa using hb,
+    exact lt_irrefl _ ((A.trans_le ha).trans h) },
+  { rw bit0_eq_self hb,
+    exact iff_of_true ((bit0_lt_aleph_0.2 ha).trans_le hb) (ha.trans_le hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
     exact bit0_lt_bit0 }
 end
 
 @[simp] lemma bit1_lt_bit0 {a b : cardinal} : bit1 a < bit0 b ↔ a < b :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
-  { rw [bit1_eq_self_iff.2 ha, bit0_eq_self hb], },
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
+  { rw [bit1_eq_self_iff.2 ha, bit0_eq_self hb] },
   { rw bit1_eq_self_iff.2 ha,
-    refine iff_of_false (λ h, _) (not_lt_of_le (hb.le.trans ha)),
-    have A : bit0 b < ω, by simpa using hb,
-    exact lt_irrefl _ (lt_trans (lt_of_lt_of_le A ha) h) },
-  { rw [bit0_eq_self hb],
-    exact iff_of_true ((bit1_lt_omega.2 ha).trans_le hb) (ha.trans_le hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+    refine iff_of_false (λ h, _) (hb.le.trans ha).not_lt,
+    have A : bit0 b < ℵ₀, by simpa using hb,
+    exact lt_irrefl _ ((A.trans_le ha).trans h) },
+  { rw bit0_eq_self hb,
+    exact iff_of_true ((bit1_lt_aleph_0.2 ha).trans_le hb) (ha.trans_le hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
     exact nat.bit1_lt_bit0_iff }
 end
 
 @[simp] lemma bit1_lt_bit1 {a b : cardinal} : bit1 a < bit1 b ↔ a < b :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
-  { rw [bit1_eq_self_iff.2 ha, bit1_eq_self_iff.2 hb], },
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
+  { rw [bit1_eq_self_iff.2 ha, bit1_eq_self_iff.2 hb] },
   { rw bit1_eq_self_iff.2 ha,
-    refine iff_of_false (λ h, _) (not_lt_of_le (hb.le.trans ha)),
-    have A : bit1 b < ω, by simpa using hb,
-    exact lt_irrefl _ (lt_trans (lt_of_lt_of_le A ha) h) },
-  { rw [bit1_eq_self_iff.2 hb],
-    exact iff_of_true ((bit1_lt_omega.2 ha).trans_le hb) (ha.trans_le hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+    refine iff_of_false (λ h, _) (hb.le.trans ha).not_lt,
+    have A : bit1 b < ℵ₀, by simpa using hb,
+    exact lt_irrefl _ ((A.trans_le ha).trans h) },
+  { rw bit1_eq_self_iff.2 hb,
+    exact iff_of_true ((bit1_lt_aleph_0.2 ha).trans_le hb) (ha.trans_le hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
     exact bit1_lt_bit1 }
 end
 
-@[simp] lemma bit0_lt_bit1 {a b : cardinal} : bit0 a < bit1 b ↔ (a < b ∨ (a ≤ b ∧ a < ω)) :=
+@[simp] lemma bit0_lt_bit1 {a b : cardinal} : bit0 a < bit1 b ↔ (a < b ∨ (a ≤ b ∧ a < ℵ₀)) :=
 begin
-  cases le_or_lt ω a with ha ha; cases le_or_lt ω b with hb hb,
+  cases le_or_lt ℵ₀ a with ha ha; cases le_or_lt ℵ₀ b with hb hb,
   { simp [bit0_eq_self ha, bit1_eq_self_iff.2 hb, not_lt.mpr ha] },
   { rw bit0_eq_self ha,
     refine iff_of_false (λ h, _) (λ h, _),
-    { have A : bit1 b < ω, by simpa using hb,
-      exact lt_irrefl _ (lt_trans (lt_of_lt_of_le A ha) h) },
-    { exact not_le_of_lt (hb.trans_le ha) (h.elim le_of_lt and.left) } },
+    { have A : bit1 b < ℵ₀, by simpa using hb,
+      exact lt_irrefl _ ((A.trans_le ha).trans h) },
+    { exact (hb.trans_le ha).not_le (h.elim le_of_lt and.left) } },
   { rw [bit1_eq_self_iff.2 hb],
-    exact iff_of_true ((bit0_lt_omega.2 ha).trans_le hb) (or.inl $ ha.trans_le hb) },
-  { rcases lt_omega.1 ha with ⟨m, rfl⟩,
-    rcases lt_omega.1 hb with ⟨n, rfl⟩,
+    exact iff_of_true ((bit0_lt_aleph_0.2 ha).trans_le hb) (or.inl $ ha.trans_le hb) },
+  { rcases lt_aleph_0.1 ha with ⟨m, rfl⟩,
+    rcases lt_aleph_0.1 hb with ⟨n, rfl⟩,
     norm_cast,
     simp only [ha, and_true, nat.bit0_lt_bit1_iff, or_iff_right_of_imp le_of_lt] }
 end
@@ -998,13 +1178,10 @@ lemma one_lt_two : (1 : cardinal) < 2 :=
 by { norm_cast, norm_num }
 
 @[simp] lemma one_lt_bit0 {a : cardinal} : 1 < bit0 a ↔ 0 < a :=
-by simp [← bit1_zero]
+by simp [←bit1_zero]
 
 @[simp] lemma one_lt_bit1 (a : cardinal) : 1 < bit1 a ↔ 0 < a :=
-by simp [← bit1_zero]
-
-@[simp] lemma one_le_one : (1 : cardinal) ≤ 1 :=
-le_rfl
+by simp [←bit1_zero]
 
 end bit
 
diff --git a/src/set_theory/schroeder_bernstein.lean b/src/set_theory/cardinal/schroeder_bernstein.lean
similarity index 94%
rename from src/set_theory/schroeder_bernstein.lean
rename to src/set_theory/cardinal/schroeder_bernstein.lean
index 21e5211d3a003..411e0ec7a6247 100644
--- a/src/set_theory/schroeder_bernstein.lean
+++ b/src/set_theory/cardinal/schroeder_bernstein.lean
@@ -9,6 +9,9 @@ import order.zorn
 /-!
 # Schröder-Bernstein theorem, well-ordering of cardinals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves the Schröder-Bernstein theorem (see `schroeder_bernstein`), the well-ordering of
 cardinals (see `min_injective`) and the totality of their order (see `total`).
 
@@ -78,15 +81,15 @@ theorem antisymm : (α ↪ β) → (β ↪ α) → nonempty (α ≃ β)
 end antisymm
 
 section wo
-parameters {ι : Type u} {β : ι → Type v}
+parameters {ι : Type u} (β : ι → Type v)
 
 @[reducible] private def sets := {s : set (∀ i, β i) |
   ∀ (x ∈ s) (y ∈ s) i, (x : ∀ i, β i) i = y i → x = y}
 
 /-- The cardinals are well-ordered. We express it here by the fact that in any set of cardinals
 there is an element that injects into the others. See `cardinal.linear_order` for (one of) the
-lattice instance. -/
-theorem min_injective (I : nonempty ι) : ∃ i, nonempty (∀ j, β i ↪ β j) :=
+lattice instances. -/
+theorem min_injective [I : nonempty ι] : ∃ i, nonempty (∀ j, β i ↪ β j) :=
 let ⟨s, hs, ms⟩ := show ∃ s ∈ sets, ∀ a ∈ sets, s ⊆ a → a = s, from
   zorn_subset sets (λ c hc hcc, ⟨⋃₀ c,
     λ x ⟨p, hpc, hxp⟩ y ⟨q, hqc, hyq⟩ i hi, (hcc.total hpc hqc).elim
@@ -114,7 +117,7 @@ end wo
 
 /-- The cardinals are totally ordered. See `cardinal.linear_order` for (one of) the lattice
 instance. -/
-theorem total {α : Type u} {β : Type v} : nonempty (α ↪ β) ∨ nonempty (β ↪ α) :=
+theorem total (α : Type u) (β : Type v) : nonempty (α ↪ β) ∨ nonempty (β ↪ α) :=
 match @min_injective bool (λ b, cond b (ulift α) (ulift.{(max u v) v} β)) ⟨tt⟩ with
 | ⟨tt, ⟨h⟩⟩ := let ⟨f, hf⟩ := h ff in or.inl ⟨embedding.congr equiv.ulift equiv.ulift ⟨f, hf⟩⟩
 | ⟨ff, ⟨h⟩⟩ := let ⟨f, hf⟩ := h tt in or.inr ⟨embedding.congr equiv.ulift equiv.ulift ⟨f, hf⟩⟩
diff --git a/src/set_theory/game/basic.lean b/src/set_theory/game/basic.lean
index 254cc2f383344..d1f574448fbed 100644
--- a/src/set_theory/game/basic.lean
+++ b/src/set_theory/game/basic.lean
@@ -9,30 +9,29 @@ import tactic.abel
 /-!
 # Combinatorial games.
 
-In this file we define the quotient of pre-games by the equivalence relation `p ≈ q ↔ p ≤ q ∧ q ≤
-p`, and construct an instance `add_comm_group game`, as well as an instance `partial_order game`
-(although note carefully the warning that the `<` field in this instance is not the usual relation
-on combinatorial games).
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define the quotient of pre-games by the equivalence relation
+`p ≈ q ↔ p ≤ q ∧ q ≤ p` (its `antisymmetrization`), and construct an instance `add_comm_group game`,
+as well as an instance `partial_order game`.
 
 ## Multiplication on pre-games
 
 We define the operations of multiplication and inverse on pre-games, and prove a few basic theorems
-about them. Multiplication is not well-behaved under equivalence of pre-games i.e. `x.equiv y` does
-not imply `(x*z).equiv (y*z)`. Hence, multiplication is not a well-defined operation on games.
-Nevertheless, the abelian group structure on games allows us to simplify many proofs for pre-games.
+about them. Multiplication is not well-behaved under equivalence of pre-games i.e. `x ≈ y` does not
+imply `x * z ≈ y * z`. Hence, multiplication is not a well-defined operation on games. Nevertheless,
+the abelian group structure on games allows us to simplify many proofs for pre-games.
 -/
 
-open function
+open function pgame
 
-universes u
+open_locale pgame
 
-local infix ` ≈ ` := pgame.equiv
+universes u
 
 instance pgame.setoid : setoid pgame :=
-⟨λ x y, x ≈ y,
- λ x, pgame.equiv_refl _,
- λ x y, pgame.equiv_symm,
- λ x y z, pgame.equiv_trans⟩
+⟨(≈), equiv_refl, @pgame.equiv.symm, @pgame.equiv.trans⟩
 
 /-- The type of combinatorial games. In ZFC, a combinatorial game is constructed from
   two sets of combinatorial games that have been constructed at an earlier
@@ -44,75 +43,67 @@ instance pgame.setoid : setoid pgame :=
   `x ≈ y ↔ x ≤ y ∧ y ≤ x`. -/
 abbreviation game := quotient pgame.setoid
 
-open pgame
-
 namespace game
 
-instance : has_le game :=
-⟨quotient.lift₂ (λ x y, x ≤ y) (λ x₁ y₁ x₂ y₂ hx hy, propext (le_congr hx hy))⟩
+instance : add_comm_group_with_one game :=
+{ zero := ⟦0⟧,
+  one := ⟦1⟧,
+  neg := quot.lift (λ x, ⟦-x⟧) (λ x y h, quot.sound ((@neg_equiv_neg_iff x y).2 h)),
+  add := quotient.lift₂ (λ x y : pgame, ⟦x + y⟧)
+    (λ x₁ y₁ x₂ y₂ hx hy, quot.sound (pgame.add_congr hx hy)),
+  add_zero := by { rintro ⟨x⟩, exact quot.sound (add_zero_equiv x) },
+  zero_add := by { rintro ⟨x⟩, exact quot.sound (zero_add_equiv x) },
+  add_assoc := by { rintros ⟨x⟩ ⟨y⟩ ⟨z⟩, exact quot.sound add_assoc_equiv },
+  add_left_neg := by { rintro ⟨x⟩, exact quot.sound (add_left_neg_equiv x) },
+  add_comm := by { rintros ⟨x⟩ ⟨y⟩, exact quot.sound add_comm_equiv } }
 
--- Adding `@[refl]` and `@[trans]` attributes here would override the ones on
--- `preorder.le_refl` and `preorder.le_trans`, which breaks all non-`game` uses of `≤`!
-theorem le_rfl : ∀ {x : game}, x ≤ x :=
-by { rintro ⟨x⟩, exact pgame.le_rfl }
-theorem le_refl (x : game) : x ≤ x :=
-le_rfl
-theorem le_trans : ∀ x y z : game, x ≤ y → y ≤ z → x ≤ z :=
-by { rintro ⟨x⟩ ⟨y⟩ ⟨z⟩, apply pgame.le_trans }
-theorem le_antisymm : ∀ x y : game, x ≤ y → y ≤ x → x = y :=
-by { rintro ⟨x⟩ ⟨y⟩ h₁ h₂, apply quot.sound, exact ⟨h₁, h₂⟩ }
+instance : inhabited game := ⟨0⟩
 
-/-- This instance is incompatible with that provided by `game.partial_order`, which is why it's made
-into a `def` instead. -/
-instance : has_lt game :=
-⟨quotient.lift₂ (λ x y, x < y) (λ x₁ y₁ x₂ y₂ hx hy, propext (lt_congr hx hy))⟩
+instance : partial_order game :=
+{ le := quotient.lift₂ (≤) (λ x₁ y₁ x₂ y₂ hx hy, propext (le_congr hx hy)),
+  le_refl := by { rintro ⟨x⟩, exact le_refl x },
+  le_trans := by { rintro ⟨x⟩ ⟨y⟩ ⟨z⟩, exact @le_trans _ _ x y z },
+  le_antisymm := by { rintro ⟨x⟩ ⟨y⟩ h₁ h₂, apply quot.sound, exact ⟨h₁, h₂⟩ },
+  lt := quotient.lift₂ (<) (λ x₁ y₁ x₂ y₂ hx hy, propext (lt_congr hx hy)),
+  lt_iff_le_not_le := by { rintro ⟨x⟩ ⟨y⟩, exact @lt_iff_le_not_le _ _ x y }, }
 
-theorem lt_or_eq_of_le : ∀ {x y : game}, x ≤ y → x < y ∨ x = y :=
-by { rintro ⟨x⟩ ⟨y⟩, change _ → _ ∨ ⟦x⟧ = ⟦y⟧, rw quotient.eq, exact lt_or_equiv_of_le }
+/-- The less or fuzzy relation on games.
 
-instance : is_trichotomous game (<) :=
-⟨by { rintro ⟨x⟩ ⟨y⟩, change _ ∨ ⟦x⟧ = ⟦y⟧ ∨ _, rw quotient.eq, apply lt_or_equiv_or_gt }⟩
+If `0 ⧏ x` (less or fuzzy with), then Left can win `x` as the first player. -/
+def lf : game → game → Prop :=
+quotient.lift₂ lf (λ x₁ y₁ x₂ y₂ hx hy, propext (lf_congr hx hy))
 
-@[simp] theorem not_le : ∀ {x y : game}, ¬ x ≤ y ↔ y < x :=
-by { rintro ⟨x⟩ ⟨y⟩, exact not_le }
+local infix ` ⧏ `:50 := lf
 
-@[simp] theorem not_lt : ∀ {x y : game}, ¬ x < y ↔ y ≤ x :=
-by { rintro ⟨x⟩ ⟨y⟩, exact not_lt }
+/-- On `game`, simp-normal inequalities should use as few negations as possible. -/
+@[simp] theorem not_le : ∀ {x y : game}, ¬ x ≤ y ↔ y ⧏ x :=
+by { rintro ⟨x⟩ ⟨y⟩, exact pgame.not_le }
 
-instance : has_zero game := ⟨⟦0⟧⟩
-instance : inhabited game := ⟨0⟩
-instance : has_one game := ⟨⟦1⟧⟩
+/-- On `game`, simp-normal inequalities should use as few negations as possible. -/
+@[simp] theorem not_lf : ∀ {x y : game}, ¬ x ⧏ y ↔ y ≤ x :=
+by { rintro ⟨x⟩ ⟨y⟩, exact not_lf }
 
-/-- The negation of `{L | R}` is `{-R | -L}`. -/
-instance : has_neg game :=
-⟨quot.lift (λ x, ⟦-x⟧) (λ x y h, quot.sound (@neg_congr x y h))⟩
+instance : is_trichotomous game (⧏) :=
+⟨by { rintro ⟨x⟩ ⟨y⟩, change _ ∨ ⟦x⟧ = ⟦y⟧ ∨ _, rw quotient.eq, apply lf_or_equiv_or_gf }⟩
 
-/-- The sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
-instance : has_add game :=
-⟨quotient.lift₂ (λ x y : pgame, ⟦x + y⟧) (λ x₁ y₁ x₂ y₂ hx hy, quot.sound (pgame.add_congr hx hy))⟩
+/-! It can be useful to use these lemmas to turn `pgame` inequalities into `game` inequalities, as
+the `add_comm_group` structure on `game` often simplifies many proofs. -/
 
-instance : add_semigroup game.{u} :=
-{ add_assoc := by { rintros ⟨x⟩ ⟨y⟩ ⟨z⟩, exact quot.sound add_assoc_equiv },
-  ..game.has_add }
+theorem _root_.pgame.le_iff_game_le {x y : pgame} : x ≤ y ↔ ⟦x⟧ ≤ ⟦y⟧ := iff.rfl
+theorem _root_.pgame.lf_iff_game_lf {x y : pgame} : pgame.lf x y ↔ ⟦x⟧ ⧏ ⟦y⟧ := iff.rfl
+theorem _root_.pgame.lt_iff_game_lt {x y : pgame} : x < y ↔ ⟦x⟧ < ⟦y⟧ := iff.rfl
+theorem _root_.pgame.equiv_iff_game_eq {x y : pgame} : x ≈ y ↔ ⟦x⟧ = ⟦y⟧ :=
+(@quotient.eq _ _ x y).symm
 
-instance : add_monoid game :=
-{ add_zero := by { rintro ⟨x⟩, exact quot.sound (add_zero_equiv x) },
-  zero_add := by { rintro ⟨x⟩, exact quot.sound (zero_add_equiv x) },
-  ..game.has_zero,
-  ..game.add_semigroup }
+/-- The fuzzy, confused, or incomparable relation on games.
 
-instance : add_group game :=
-{ add_left_neg := by { rintro ⟨x⟩, exact quot.sound (add_left_neg_equiv x) },
-  ..game.has_neg,
-  ..game.add_monoid }
+If `x ‖ 0`, then the first player can always win `x`. -/
+def fuzzy : game → game → Prop :=
+quotient.lift₂ fuzzy (λ x₁ y₁ x₂ y₂ hx hy, propext (fuzzy_congr hx hy))
 
-instance : add_comm_semigroup game :=
-{ add_comm := by { rintros ⟨x⟩ ⟨y⟩, exact quot.sound add_comm_equiv },
-  ..game.add_semigroup }
+local infix ` ‖ `:50 := fuzzy
 
-instance : add_comm_group game :=
-{ ..game.add_comm_semigroup,
-  ..game.add_group }
+theorem _root_.pgame.fuzzy_iff_game_fuzzy {x y : pgame} : pgame.fuzzy x y ↔ ⟦x⟧ ‖ ⟦y⟧ := iff.rfl
 
 instance covariant_class_add_le : covariant_class game game (+) (≤) :=
 ⟨by { rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ h, exact @add_le_add_left _ _ _ _ b c h a }⟩
@@ -126,31 +117,27 @@ instance covariant_class_add_lt : covariant_class game game (+) (<) :=
 instance covariant_class_swap_add_lt : covariant_class game game (swap (+)) (<) :=
 ⟨by { rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ h, exact @add_lt_add_right _ _ _ _ b c h a }⟩
 
--- While it is very tempting to define a `partial_order` on games, and prove
--- that games form an `ordered_add_comm_group`, it is a bit dangerous.
-
--- The relations `≤` and `<` on games do not satisfy
--- `lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a)`
--- (Consider `a = 0`, `b = star`.)
--- (`lt_iff_le_not_le` is satisfied by surreal numbers, however.)
--- Thus we can not use `<` when defining a `partial_order`.
-
--- Because of this issue, we define the `partial_order` and `ordered_add_comm_group` instances,
--- but do not actually mark them as instances, for safety.
+theorem add_lf_add_right : ∀ {b c : game} (h : b ⧏ c) (a), b + a ⧏ c + a :=
+by { rintro ⟨b⟩ ⟨c⟩ h ⟨a⟩, apply add_lf_add_right h }
 
-/-- The `<` operation provided by this partial order is not the usual `<` on games! -/
-def partial_order : partial_order game :=
-{ le_refl := le_refl,
-  le_trans := le_trans,
-  le_antisymm := le_antisymm,
-  ..game.has_le }
+theorem add_lf_add_left : ∀ {b c : game} (h : b ⧏ c) (a), a + b ⧏ a + c :=
+by { rintro ⟨b⟩ ⟨c⟩ h ⟨a⟩, apply add_lf_add_left h }
 
-/-- The `<` operation provided by this `ordered_add_comm_group` is not the usual `<` on games! -/
-def ordered_add_comm_group : ordered_add_comm_group game :=
+instance ordered_add_comm_group : ordered_add_comm_group game :=
 { add_le_add_left := @add_le_add_left _ _ _ game.covariant_class_add_le,
-  ..game.add_comm_group,
+  ..game.add_comm_group_with_one,
   ..game.partial_order }
 
+/-- A small set `s` of games is bounded above. -/
+lemma bdd_above_of_small (s : set game.{u}) [small.{u} s] : bdd_above s :=
+⟨_, λ i hi, by simpa using pgame.le_iff_game_le.1
+  (upper_bound_mem_upper_bounds _ (set.mem_image_of_mem quotient.out hi))⟩
+
+/-- A small set `s` of games is bounded below. -/
+lemma bdd_below_of_small (s : set game.{u}) [small.{u} s] : bdd_below s :=
+⟨_, λ i hi, by simpa using pgame.le_iff_game_le.1
+  (lower_bound_mem_lower_bounds _ (set.mem_image_of_mem quotient.out hi))⟩
+
 end game
 
 namespace pgame
@@ -163,14 +150,9 @@ namespace pgame
 
 theorem quot_eq_of_mk_quot_eq {x y : pgame}
   (L : x.left_moves ≃ y.left_moves) (R : x.right_moves ≃ y.right_moves)
-  (hl : ∀ (i : x.left_moves), ⟦x.move_left i⟧ = ⟦y.move_left (L i)⟧)
-  (hr : ∀ (j : y.right_moves), ⟦x.move_right (R.symm j)⟧ = ⟦y.move_right j⟧) :
-  ⟦x⟧ = ⟦y⟧ :=
-begin
-  simp only [quotient.eq] at hl hr,
-  apply quotient.sound,
-  apply equiv_of_mk_equiv L R hl hr,
-end
+  (hl : ∀ i, ⟦x.move_left i⟧ = ⟦y.move_left (L i)⟧)
+  (hr : ∀ j, ⟦x.move_right j⟧ = ⟦y.move_right (R j)⟧) : ⟦x⟧ = ⟦y⟧ :=
+by { simp_rw [quotient.eq] at hl hr, exact quot.sound (equiv_of_mk_equiv L R hl hr) }
 
 /-! Multiplicative operations can be defined at the level of pre-games,
 but to prove their properties we need to use the abelian group structure of games.
@@ -202,135 +184,166 @@ theorem right_moves_mul : ∀ (x y : pgame.{u}), (x * y).right_moves
 
 Even though these types are the same (not definitionally so), this is the preferred way to convert
 between them. -/
-def to_left_moves_mul {x y : pgame} : x.left_moves × y.left_moves ⊕ x.right_moves × y.right_moves
-  ≃ (x * y).left_moves :=
+def to_left_moves_mul {x y : pgame} :
+  x.left_moves × y.left_moves ⊕ x.right_moves × y.right_moves ≃ (x * y).left_moves :=
 equiv.cast (left_moves_mul x y).symm
 
 /-- Turns a left and a right move for `x` and `y` into a right move for `x * y` and vice versa.
 
 Even though these types are the same (not definitionally so), this is the preferred way to convert
 between them. -/
-def to_right_moves_mul {x y : pgame} : x.left_moves × y.right_moves ⊕ x.right_moves × y.left_moves
-  ≃ (x * y).right_moves :=
+def to_right_moves_mul {x y : pgame} :
+  x.left_moves × y.right_moves ⊕ x.right_moves × y.left_moves ≃ (x * y).right_moves :=
 equiv.cast (right_moves_mul x y).symm
 
 @[simp] lemma mk_mul_move_left_inl {xl xr yl yr} {xL xR yL yR} {i j} :
-  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inl (i, j))
-  = xL i * (mk yl yr yL yR) + (mk xl xr xL xR) * yL j - xL i * yL j :=
+  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inl (i, j)) =
+  xL i * mk yl yr yL yR + mk xl xr xL xR * yL j - xL i * yL j :=
 rfl
 
 @[simp] lemma mul_move_left_inl {x y : pgame} {i j} :
-   (x * y).move_left (to_left_moves_mul (sum.inl (i, j)))
-   = x.move_left i * y + x * y.move_left j - x.move_left i * y.move_left j :=
+   (x * y).move_left (to_left_moves_mul (sum.inl (i, j))) =
+   x.move_left i * y + x * y.move_left j - x.move_left i * y.move_left j :=
 by { cases x, cases y, refl }
 
 @[simp] lemma mk_mul_move_left_inr {xl xr yl yr} {xL xR yL yR} {i j} :
-  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inr (i, j))
-  = xR i * (mk yl yr yL yR) + (mk xl xr xL xR) * yR j - xR i * yR j :=
+  (mk xl xr xL xR * mk yl yr yL yR).move_left (sum.inr (i, j)) =
+  xR i * mk yl yr yL yR + mk xl xr xL xR * yR j - xR i * yR j :=
 rfl
 
 @[simp] lemma mul_move_left_inr {x y : pgame} {i j} :
-   (x * y).move_left (to_left_moves_mul (sum.inr (i, j)))
-   = x.move_right i * y + x * y.move_right j - x.move_right i * y.move_right j :=
+  (x * y).move_left (to_left_moves_mul (sum.inr (i, j))) =
+  x.move_right i * y + x * y.move_right j - x.move_right i * y.move_right j :=
 by { cases x, cases y, refl }
 
 @[simp] lemma mk_mul_move_right_inl {xl xr yl yr} {xL xR yL yR} {i j} :
-  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inl (i, j))
-  = xL i * (mk yl yr yL yR) + (mk xl xr xL xR) * yR j - xL i * yR j :=
+  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inl (i, j)) =
+  xL i * mk yl yr yL yR + mk xl xr xL xR * yR j - xL i * yR j :=
 rfl
 
 @[simp] lemma mul_move_right_inl {x y : pgame} {i j} :
-   (x * y).move_right (to_right_moves_mul (sum.inl (i, j)))
-   = x.move_left i * y + x * y.move_right j - x.move_left i * y.move_right j :=
+  (x * y).move_right (to_right_moves_mul (sum.inl (i, j))) =
+  x.move_left i * y + x * y.move_right j - x.move_left i * y.move_right j :=
 by { cases x, cases y, refl }
 
 @[simp] lemma mk_mul_move_right_inr {xl xr yl yr} {xL xR yL yR} {i j} :
-  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inr (i,j))
-  = xR i * (mk yl yr yL yR) + (mk xl xr xL xR) * yL j - xR i * yL j :=
+  (mk xl xr xL xR * mk yl yr yL yR).move_right (sum.inr (i, j)) =
+  xR i * mk yl yr yL yR + mk xl xr xL xR * yL j - xR i * yL j :=
 rfl
 
 @[simp] lemma mul_move_right_inr {x y : pgame} {i j} :
-   (x * y).move_right (to_right_moves_mul (sum.inr (i, j)))
-   = x.move_right i * y + x * y.move_left j - x.move_right i * y.move_left j :=
+  (x * y).move_right (to_right_moves_mul (sum.inr (i, j))) =
+  x.move_right i * y + x * y.move_left j - x.move_right i * y.move_left j :=
 by { cases x, cases y, refl }
 
-theorem quot_mul_comm : Π (x y : pgame.{u}), ⟦x * y⟧ = ⟦y * x⟧
-| (mk xl xr xL xR) (mk yl yr yL yR) :=
+@[simp] lemma neg_mk_mul_move_left_inl {xl xr yl yr} {xL xR yL yR} {i j} :
+  (-(mk xl xr xL xR * mk yl yr yL yR)).move_left (sum.inl (i, j)) =
+  -(xL i * mk yl yr yL yR + mk xl xr xL xR * yR j - xL i * yR j) :=
+rfl
+
+@[simp] lemma neg_mk_mul_move_left_inr {xl xr yl yr} {xL xR yL yR} {i j} :
+  (-(mk xl xr xL xR * mk yl yr yL yR)).move_left (sum.inr (i, j)) =
+  -(xR i * mk yl yr yL yR + mk xl xr xL xR * yL j - xR i * yL j) :=
+rfl
+
+@[simp] lemma neg_mk_mul_move_right_inl {xl xr yl yr} {xL xR yL yR} {i j} :
+  (-(mk xl xr xL xR * mk yl yr yL yR)).move_right (sum.inl (i, j)) =
+  -(xL i * mk yl yr yL yR + mk xl xr xL xR * yL j - xL i * yL j) :=
+rfl
+
+@[simp] lemma neg_mk_mul_move_right_inr {xl xr yl yr} {xL xR yL yR} {i j} :
+  (-(mk xl xr xL xR * mk yl yr yL yR)).move_right (sum.inr (i, j)) =
+  -(xR i * mk yl yr yL yR + mk xl xr xL xR * yR j - xR i * yR j) :=
+rfl
+
+lemma left_moves_mul_cases {x y : pgame} (k) {P : (x * y).left_moves → Prop}
+  (hl : ∀ ix iy, P $ to_left_moves_mul (sum.inl ⟨ix, iy⟩))
+  (hr : ∀ jx jy, P $ to_left_moves_mul (sum.inr ⟨jx, jy⟩)) : P k :=
+begin
+  rw ←to_left_moves_mul.apply_symm_apply k,
+  rcases to_left_moves_mul.symm k with ⟨ix, iy⟩ | ⟨jx, jy⟩,
+  { apply hl },
+  { apply hr }
+end
+
+lemma right_moves_mul_cases {x y : pgame} (k) {P : (x * y).right_moves → Prop}
+  (hl : ∀ ix jy, P $ to_right_moves_mul (sum.inl ⟨ix, jy⟩))
+  (hr : ∀ jx iy, P $ to_right_moves_mul (sum.inr ⟨jx, iy⟩)) : P k :=
 begin
-  refine quot_eq_of_mk_quot_eq
-    (equiv.sum_congr (equiv.prod_comm _ _) (equiv.prod_comm _ _))
-    ((equiv.sum_comm _ _).trans (equiv.sum_congr (equiv.prod_comm _ _) (equiv.prod_comm _ _))) _ _,
-  all_goals { rintro (⟨i, j⟩ | ⟨i, j⟩); dsimp; rw [quot_mul_comm, quot_mul_comm (mk xl xr xL xR)] },
-  { rw [quot_mul_comm (xL i), add_comm] },
-  { rw [quot_mul_comm (xR i), add_comm] },
-  { rw [quot_mul_comm (xR j), add_comm] },
-  { rw [quot_mul_comm (xL j), add_comm] }
+  rw ←to_right_moves_mul.apply_symm_apply k,
+  rcases to_right_moves_mul.symm k with ⟨ix, iy⟩ | ⟨jx, jy⟩,
+  { apply hl },
+  { apply hr }
+end
+
+/-- `x * y` and `y * x` have the same moves. -/
+def mul_comm_relabelling : Π (x y : pgame.{u}), x * y ≡r y * x
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ := begin
+  refine ⟨equiv.sum_congr (equiv.prod_comm _ _) (equiv.prod_comm _ _),
+    (equiv.sum_comm _ _).trans (equiv.sum_congr (equiv.prod_comm _ _) (equiv.prod_comm _ _)), _, _⟩;
+  rintro (⟨i, j⟩ | ⟨i, j⟩);
+  dsimp;
+  exact ((add_comm_relabelling _ _).trans $ (mul_comm_relabelling _ _).add_congr
+    (mul_comm_relabelling _ _)).sub_congr (mul_comm_relabelling _ _)
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
+theorem quot_mul_comm (x y : pgame.{u}) : ⟦x * y⟧ = ⟦y * x⟧ :=
+quot.sound (mul_comm_relabelling x y).equiv
+
 /-- `x * y` is equivalent to `y * x`. -/
 theorem mul_comm_equiv (x y : pgame) : x * y ≈ y * x :=
 quotient.exact $ quot_mul_comm _ _
 
+instance is_empty_mul_zero_left_moves (x : pgame.{u}) : is_empty (x * 0).left_moves :=
+by { cases x, apply sum.is_empty }
+instance is_empty_mul_zero_right_moves (x : pgame.{u}) : is_empty (x * 0).right_moves :=
+by { cases x, apply sum.is_empty }
+instance is_empty_zero_mul_left_moves (x : pgame.{u}) : is_empty (0 * x).left_moves :=
+by { cases x, apply sum.is_empty }
+instance is_empty_zero_mul_right_moves (x : pgame.{u}) : is_empty (0 * x).right_moves :=
+by { cases x, apply sum.is_empty }
+
 /-- `x * 0` has exactly the same moves as `0`. -/
-def mul_zero_relabelling : Π (x : pgame), relabelling (x * 0) 0
-| (mk xl xr xL xR) :=
-⟨by fsplit; rintro (⟨_,⟨⟩⟩ | ⟨_,⟨⟩⟩),
- by fsplit; rintro (⟨_,⟨⟩⟩ | ⟨_,⟨⟩⟩),
- by rintro (⟨_,⟨⟩⟩ | ⟨_,⟨⟩⟩),
- by rintro ⟨⟩⟩
+def mul_zero_relabelling (x : pgame) : x * 0 ≡r 0 := relabelling.is_empty _
 
 /-- `x * 0` is equivalent to `0`. -/
-theorem mul_zero_equiv (x : pgame) : x * 0 ≈ 0 :=
-(mul_zero_relabelling x).equiv
+theorem mul_zero_equiv (x : pgame) : x * 0 ≈ 0 := (mul_zero_relabelling x).equiv
 
 @[simp] theorem quot_mul_zero (x : pgame) : ⟦x * 0⟧ = ⟦0⟧ :=
 @quotient.sound _ _ (x * 0) _ x.mul_zero_equiv
 
 /-- `0 * x` has exactly the same moves as `0`. -/
-def zero_mul_relabelling : Π (x : pgame), relabelling (0 * x) 0
-| (mk xl xr xL xR) :=
-⟨by fsplit; rintro (⟨⟨⟩,_⟩ | ⟨⟨⟩,_⟩),
- by fsplit; rintro (⟨⟨⟩,_⟩ | ⟨⟨⟩,_⟩),
- by rintro (⟨⟨⟩,_⟩ | ⟨⟨⟩,_⟩),
- by rintro ⟨⟩⟩
+def zero_mul_relabelling (x : pgame) : 0 * x ≡r 0 := relabelling.is_empty _
 
 /-- `0 * x` is equivalent to `0`. -/
-theorem zero_mul_equiv (x : pgame) : 0 * x ≈ 0 :=
-(zero_mul_relabelling x).equiv
+theorem zero_mul_equiv (x : pgame) : 0 * x ≈ 0 := (zero_mul_relabelling x).equiv
 
 @[simp] theorem quot_zero_mul (x : pgame) : ⟦0 * x⟧ = ⟦0⟧ :=
 @quotient.sound _ _ (0 * x) _ x.zero_mul_equiv
 
-@[simp] theorem quot_neg_mul : Π (x y : pgame), ⟦-x * y⟧ = -⟦x * y⟧
-| (mk xl xr xL xR) (mk yl yr yL yR) :=
-begin
-  let x := mk xl xr xL xR,
-  let y := mk yl yr yL yR,
-  refine quot_eq_of_mk_quot_eq _ _ _ _,
-  { fsplit; rintro (⟨_, _⟩ | ⟨_, _⟩);
-    solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 4 } },
-  { fsplit; rintro (⟨_, _⟩ | ⟨_, _⟩);
-    solve_by_elim [sum.inl, sum.inr, prod.mk] { max_depth := 4 } },
-  { rintro (⟨i, j⟩ | ⟨i, j⟩),
-    { change ⟦-xR i * y + (-x) * yL j - (-xR i) * yL j⟧ = ⟦-(xR i * y + x * yL j - xR i * yL j)⟧,
-      simp only [quot_add, quot_sub, quot_neg_mul],
-      simp, abel },
-    { change ⟦-xL i * y + (-x) * yR j - (-xL i) * yR j⟧ = ⟦-(xL i * y + x * yR j - xL i * yR j)⟧,
-      simp only [quot_add, quot_sub, quot_neg_mul],
-      simp, abel } },
-  { rintro (⟨i, j⟩ | ⟨i, j⟩),
-    { change ⟦-xL i * y + (-x) * yL j - (-xL i) * yL j⟧ = ⟦-(xL i * y + x * yL j - xL i * yL j)⟧,
-      simp only [quot_add, quot_sub, quot_neg_mul],
-      simp, abel },
-    { change ⟦-xR i * y + (-x) * yR j - (-xR i) * yR j⟧ = ⟦-(xR i * y + x * yR j - xR i * yR j)⟧,
-      simp only [quot_add, quot_sub, quot_neg_mul],
-      simp, abel } },
+/-- `-x * y` and `-(x * y)` have the same moves. -/
+def neg_mul_relabelling : Π (x y : pgame.{u}), -x * y ≡r -(x * y)
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ := begin
+  refine ⟨equiv.sum_comm _ _, equiv.sum_comm _ _, _, _⟩;
+  rintro (⟨i, j⟩ | ⟨i, j⟩);
+  dsimp;
+  apply ((neg_add_relabelling _ _).trans _).symm;
+  apply ((neg_add_relabelling _ _).trans (relabelling.add_congr _ _)).sub_congr;
+  exact (neg_mul_relabelling _ _).symm
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
+@[simp] theorem quot_neg_mul (x y : pgame) : ⟦-x * y⟧ = -⟦x * y⟧ :=
+quot.sound (neg_mul_relabelling x y).equiv
+
+/-- `x * -y` and `-(x * y)` have the same moves. -/
+def mul_neg_relabelling (x y : pgame) : x * -y ≡r -(x * y) :=
+(mul_comm_relabelling x _).trans $
+  (neg_mul_relabelling _ x).trans (mul_comm_relabelling y x).neg_congr
+
 @[simp] theorem quot_mul_neg (x y : pgame) : ⟦x * -y⟧ = -⟦x * y⟧ :=
-by rw [quot_mul_comm, quot_neg_mul, quot_mul_comm]
+quot.sound (mul_neg_relabelling x y).equiv
 
 @[simp] theorem quot_left_distrib : Π (x y z : pgame), ⟦x * (y + z)⟧ = ⟦x * y⟧ + ⟦x * z⟧
 | (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
@@ -366,16 +379,16 @@ begin
     { change ⟦xR i * (y + z) + x * (y + zR k) - xR i * (y + zR k)⟧
              = ⟦x * y + (xR i * z + x * zR k - xR i * zR k)⟧,
       simp [quot_left_distrib], abel } },
-  { rintro (⟨⟨i, j⟩ | ⟨i, j⟩⟩ | ⟨i, k⟩ | ⟨i, k⟩),
+  { rintro (⟨i, j | k⟩ | ⟨i, j | k⟩),
     { change ⟦xL i * (y + z) + x * (yR j + z) - xL i * (yR j + z)⟧
              = ⟦xL i * y + x * yR j - xL i * yR j + x * z⟧,
       simp [quot_left_distrib], abel },
-    { change ⟦xR i * (y + z) + x * (yL j + z) - xR i * (yL j + z)⟧
-             = ⟦xR i * y + x * yL j - xR i * yL j + x * z⟧,
-      simp [quot_left_distrib], abel },
     { change ⟦xL i * (y + z) + x * (y + zR k) - xL i * (y + zR k)⟧
              = ⟦x * y + (xL i * z + x * zR k - xL i * zR k)⟧,
       simp [quot_left_distrib], abel },
+    { change ⟦xR i * (y + z) + x * (yL j + z) - xR i * (yL j + z)⟧
+             = ⟦xR i * y + x * yL j - xR i * yL j + x * z⟧,
+      simp [quot_left_distrib], abel },
     { change ⟦xR i * (y + z) + x * (y + zL k) - xR i * (y + zL k)⟧
              = ⟦x * y + (xR i * z + x * zL k - xR i * zL k)⟧,
       simp [quot_left_distrib], abel } }
@@ -399,37 +412,33 @@ quotient.exact $ quot_right_distrib _ _ _
 @[simp] theorem quot_right_distrib_sub (x y z : pgame) : ⟦(y - z) * x⟧ = ⟦y * x⟧ - ⟦z * x⟧ :=
 by { change ⟦(y + -z) * x⟧ = ⟦y * x⟧ + -⟦z * x⟧, rw [quot_right_distrib, quot_neg_mul] }
 
-@[simp] theorem quot_mul_one : Π (x : pgame), ⟦x * 1⟧ = ⟦x⟧
-| (mk xl xr xL xR) :=
-begin
-  let x := mk xl xr xL xR,
-  refine quot_eq_of_mk_quot_eq _ _ _ _,
-  { fsplit,
-    { rintro (⟨_, ⟨ ⟩⟩ | ⟨_, ⟨ ⟩⟩), assumption },
-    { rintro i,  exact sum.inl(i, punit.star) },
-    { rintro (⟨_, ⟨ ⟩⟩ | ⟨_, ⟨ ⟩⟩), refl },
-    { rintro i, refl } },
-  { fsplit,
-    { rintro (⟨_, ⟨ ⟩⟩ | ⟨_, ⟨ ⟩⟩), assumption },
-    { rintro i,  exact sum.inr(i, punit.star) },
-    { rintro (⟨_, ⟨ ⟩⟩ | ⟨_, ⟨ ⟩⟩), refl },
-    { rintro i, refl } },
-  { rintro (⟨i, ⟨ ⟩⟩ | ⟨i, ⟨ ⟩⟩),
-    change ⟦xL i * 1 + x * 0 - xL i * 0⟧ = ⟦xL i⟧,
-    simp [quot_mul_one] },
-  { rintro i,
-    change ⟦xR i * 1 + x * 0 - xR i * 0⟧ = ⟦xR i⟧,
-    simp [quot_mul_one] }
+/-- `x * 1` has the same moves as `x`. -/
+def mul_one_relabelling : Π (x : pgame.{u}), x * 1 ≡r x
+| ⟨xl, xr, xL, xR⟩ := begin
+  unfold has_one.one,
+  refine ⟨(equiv.sum_empty _ _).trans (equiv.prod_punit _),
+    (equiv.empty_sum _ _).trans (equiv.prod_punit _), _, _⟩;
+  try { rintro (⟨i, ⟨ ⟩⟩ | ⟨i, ⟨ ⟩⟩) }; try { intro i };
+  dsimp;
+  apply (relabelling.sub_congr (relabelling.refl _) (mul_zero_relabelling _)).trans;
+  rw sub_zero;
+  exact (add_zero_relabelling _).trans (((mul_one_relabelling _).add_congr
+    (mul_zero_relabelling _)).trans $ add_zero_relabelling _)
 end
 
+@[simp] theorem quot_mul_one (x : pgame) : ⟦x * 1⟧ = ⟦x⟧ := quot.sound $ mul_one_relabelling x
+
 /-- `x * 1` is equivalent to `x`. -/
-theorem mul_one_equiv (x : pgame) : x * 1 ≈ x := quotient.exact $ quot_mul_one _
+theorem mul_one_equiv (x : pgame) : x * 1 ≈ x := quotient.exact $ quot_mul_one x
 
-@[simp] theorem quot_one_mul (x : pgame) : ⟦1 * x⟧ = ⟦x⟧ :=
-by rw [quot_mul_comm, quot_mul_one x]
+/-- `1 * x` has the same moves as `x`. -/
+def one_mul_relabelling (x : pgame) : 1 * x ≡r x :=
+(mul_comm_relabelling 1 x).trans $ mul_one_relabelling x
+
+@[simp] theorem quot_one_mul (x : pgame) : ⟦1 * x⟧ = ⟦x⟧ := quot.sound $ one_mul_relabelling x
 
 /-- `1 * x` is equivalent to `x`. -/
-theorem one_mul_equiv (x : pgame) : 1 * x ≈ x := quotient.exact $ quot_one_mul _
+theorem one_mul_equiv (x : pgame) : 1 * x ≈ x := quotient.exact $ quot_one_mul x
 
 theorem quot_mul_assoc : Π (x y z : pgame), ⟦x * y * z⟧ = ⟦x * (y * z)⟧
 | (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
@@ -473,12 +482,17 @@ begin
              = ⟦xR i * (y * z) + x * (yL j * z + y * zR k - yL j * zR k)
                - xR i * (yL j * z + y * zR k - yL j * zR k)⟧,
       simp [quot_mul_assoc], abel } },
-  { rintro (⟨i, ⟨j, k⟩ | ⟨j, k⟩⟩ | ⟨i, ⟨j, k⟩ | ⟨j, k⟩⟩),
+  { rintro (⟨⟨i, j⟩ | ⟨i, j⟩, k⟩ | ⟨⟨i, j⟩ | ⟨i, j⟩, k⟩),
     { change ⟦(xL i * y + x * yL j - xL i * yL j) * z + (x * y) * zR k
                - (xL i * y + x * yL j - xL i * yL j) * zR k⟧
              = ⟦xL i * (y * z) + x * (yL j * z + y * zR k - yL j * zR k)
                - xL i * (yL j * z + y * zR k - yL j * zR k)⟧,
       simp [quot_mul_assoc], abel },
+    { change ⟦(xR i * y + x * yR j - xR i * yR j) * z + (x * y) * zR k
+               - (xR i * y + x * yR j - xR i * yR j) * zR k⟧
+             = ⟦xR i * (y * z) + x * (yR j * z + y * zR k - yR j * zR k)
+               - xR i * (yR j * z + y * zR k - yR j * zR k)⟧,
+      simp [quot_mul_assoc], abel },
     { change ⟦(xL i * y + x * yR j - xL i * yR j) * z + (x * y) * zL k
                - (xL i * y + x * yR j - xL i * yR j) * zL k⟧
              = ⟦xL i * (y * z) + x * (yR j * z + y * zL k - yR j * zL k)
@@ -488,11 +502,6 @@ begin
                - (xR i * y + x * yL j - xR i * yL j) * zL k⟧
              = ⟦xR i * (y * z) + x * (yL j * z + y * zL k - yL j * zL k)
                - xR i * (yL j * z + y * zL k - yL j * zL k)⟧,
-      simp [quot_mul_assoc], abel },
-    { change ⟦(xR i * y + x * yR j - xR i * yR j) * z + (x * y) * zR k
-               - (xR i * y + x * yR j - xR i * yR j) * zR k⟧
-             = ⟦xR i * (y * z) + x * (yR j * z + y * zR k - yR j * zR k)
-               - xR i * (yR j * z + y * zR k - yR j * zR k)⟧,
       simp [quot_mul_assoc], abel } }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
@@ -511,8 +520,15 @@ inductive inv_ty (l r : Type u) : bool → Type u
 | right₁ : l → inv_ty ff → inv_ty tt
 | right₂ : r → inv_ty tt → inv_ty tt
 
+instance (l r : Type u) [is_empty l] [is_empty r] : is_empty (inv_ty l r tt) :=
+⟨by rintro (_|_|_|a|a); exact is_empty_elim a⟩
+
 instance (l r : Type u) : inhabited (inv_ty l r ff) := ⟨inv_ty.zero⟩
 
+instance unique_inv_ty (l r : Type u) [is_empty l] [is_empty r] : unique (inv_ty l r ff) :=
+{ uniq := by { rintro (a|a|a), refl, all_goals { exact is_empty_elim a } },
+  ..inv_ty.inhabited l r }
+
 /-- Because the two halves of the definition of `inv` produce more elements
 of each side, we have to define the two families inductively.
 This is the function part, defined by recursion on `inv_ty`. -/
@@ -524,6 +540,14 @@ def inv_val {l r} (L : l → pgame) (R : r → pgame)
 | _ (inv_ty.right₁ i j) := (1 + (L i - mk l r L R) * inv_val j) * IHl i
 | _ (inv_ty.right₂ i j) := (1 + (R i - mk l r L R) * inv_val j) * IHr i
 
+@[simp] theorem inv_val_is_empty {l r : Type u} {b} (L R IHl IHr) (i : inv_ty l r b)
+  [is_empty l] [is_empty r] : inv_val L R IHl IHr i = 0 :=
+begin
+  cases i with a _ a _ a _ a,
+  { refl },
+  all_goals { exact is_empty_elim a }
+end
+
 /-- The inverse of a positive surreal number `x = {L | R}` is
 given by `x⁻¹ = {0,
   (1 + (R - x) * x⁻¹L) * R, (1 + (L - x) * x⁻¹R) * L |
@@ -539,10 +563,62 @@ def inv' : pgame → pgame
   ⟨inv_ty l' r ff, inv_ty l' r tt,
     inv_val L' R IHl' IHr, inv_val L' R IHl' IHr⟩
 
-/-- The inverse of a surreal number in terms of the inverse on positive surreals. -/
+theorem zero_lf_inv' : ∀ (x : pgame), 0 ⧏ inv' x
+| ⟨xl, xr, xL, xR⟩ := by { convert lf_mk _ _ inv_ty.zero, refl }
+
+/-- `inv' 0` has exactly the same moves as `1`. -/
+def inv'_zero : inv' 0 ≡r 1 :=
+begin
+  change mk _ _ _ _ ≡r 1,
+  refine ⟨_, _, λ i, _, is_empty.elim _⟩,
+  { apply equiv.equiv_punit (inv_ty _ _ _),
+    apply_instance },
+  { apply equiv.equiv_pempty (inv_ty _ _ _),
+    apply_instance },
+  { simp },
+  { dsimp,
+    apply_instance }
+end
+
+theorem inv'_zero_equiv : inv' 0 ≈ 1 := inv'_zero.equiv
+
+/-- `inv' 1` has exactly the same moves as `1`. -/
+def inv'_one : inv' 1 ≡r (1 : pgame.{u}) :=
+begin
+  change relabelling (mk _ _ _ _) 1,
+  haveI : is_empty {i : punit.{u+1} // (0 : pgame.{u}) < 0},
+  { rw lt_self_iff_false, apply_instance },
+  refine ⟨_, _, λ i, _, is_empty.elim _⟩; dsimp,
+  { apply equiv.equiv_punit },
+  { apply equiv.equiv_of_is_empty },
+  { simp },
+  { apply_instance }
+end
+
+theorem inv'_one_equiv : inv' 1 ≈ 1 := inv'_one.equiv
+
+/-- The inverse of a pre-game in terms of the inverse on positive pre-games. -/
 noncomputable instance : has_inv pgame :=
-⟨by { classical, exact λ x, if x = 0 then 0 else if 0 < x then inv' x else inv' (-x) }⟩
+⟨by { classical, exact λ x, if x ≈ 0 then 0 else if 0 < x then inv' x else -inv' (-x) }⟩
 
 noncomputable instance : has_div pgame := ⟨λ x y, x * y⁻¹⟩
 
+theorem inv_eq_of_equiv_zero {x : pgame} (h : x ≈ 0) : x⁻¹ = 0 :=
+by { classical, exact if_pos h }
+
+@[simp] theorem inv_zero : (0 : pgame)⁻¹ = 0 :=
+inv_eq_of_equiv_zero (equiv_refl _)
+
+theorem inv_eq_of_pos {x : pgame} (h : 0 < x) : x⁻¹ = inv' x :=
+by { classical, exact (if_neg h.lf.not_equiv').trans (if_pos h) }
+
+theorem inv_eq_of_lf_zero {x : pgame} (h : x ⧏ 0) : x⁻¹ = -inv' (-x) :=
+by { classical, exact (if_neg h.not_equiv).trans (if_neg h.not_gt) }
+
+/-- `1⁻¹` has exactly the same moves as `1`. -/
+def inv_one : 1⁻¹ ≡r 1 :=
+by { rw inv_eq_of_pos pgame.zero_lt_one, exact inv'_one }
+
+theorem inv_one_equiv : 1⁻¹ ≈ 1 := inv_one.equiv
+
 end pgame
diff --git a/src/set_theory/game/birthday.lean b/src/set_theory/game/birthday.lean
index f4a5d013d524e..163336f5f2243 100644
--- a/src/set_theory/game/birthday.lean
+++ b/src/set_theory/game/birthday.lean
@@ -5,11 +5,14 @@ Authors: Violeta Hernández Palacios
 -/
 
 import set_theory.game.ordinal
-import set_theory.ordinal.arithmetic
+import set_theory.ordinal.natural_ops
 
 /-!
 # Birthdays of games
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The birthday of a game is an ordinal that represents at which "step" the game was constructed. We
 define it recursively as the least ordinal larger than the birthdays of its left and right games. We
 prove the basic properties about these.
@@ -28,6 +31,8 @@ universe u
 
 open ordinal
 
+open_locale natural_ops pgame
+
 namespace pgame
 
 /-- The birthday of a pre-game is inductively defined as the least strict upper bound of the
@@ -67,49 +72,33 @@ begin
     { exact hi.trans_lt (birthday_move_right_lt i) } }
 end
 
-theorem relabelling.birthday_congr : ∀ {x y : pgame.{u}}, relabelling x y → birthday x = birthday y
-| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ⟨L, R, hL, hR⟩ := begin
-  rw [birthday, birthday],
+theorem relabelling.birthday_congr : ∀ {x y : pgame.{u}}, x ≡r y → birthday x = birthday y
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ r := begin
+  unfold birthday,
   congr' 1,
   all_goals
   { apply lsub_eq_of_range_eq.{u u u},
-    ext i,
-    split },
-  { rintro ⟨j, rfl⟩,
-    exact ⟨L j, (relabelling.birthday_congr (hL j)).symm⟩ },
-  { rintro ⟨j, rfl⟩,
-    refine ⟨L.symm j, relabelling.birthday_congr _⟩,
-    convert hL (L.symm j),
-    rw L.apply_symm_apply },
-  { rintro ⟨j, rfl⟩,
-    refine ⟨R j, (relabelling.birthday_congr _).symm⟩,
-    convert hR (R j),
-    rw R.symm_apply_apply },
-  { rintro ⟨j, rfl⟩,
-    exact ⟨R.symm j, relabelling.birthday_congr (hR j)⟩ }
+    ext i, split },
+  all_goals { rintro ⟨j, rfl⟩ },
+  { exact ⟨_, (r.move_left j).birthday_congr.symm⟩ },
+  { exact ⟨_, (r.move_left_symm j).birthday_congr⟩ },
+  { exact ⟨_, (r.move_right j).birthday_congr.symm⟩ },
+  { exact ⟨_, (r.move_right_symm j).birthday_congr⟩ }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
-@[simp] theorem birthday_add_zero (x : pgame) : birthday (x + 0) = birthday x :=
-(add_zero_relabelling x).birthday_congr
-
-@[simp] theorem birthday_zero_add (x : pgame) : birthday (0 + x) = birthday x :=
-(zero_add_relabelling x).birthday_congr
-
-@[simp] theorem birthday_eq_zero (x : pgame) :
+@[simp] theorem birthday_eq_zero {x : pgame} :
   birthday x = 0 ↔ is_empty x.left_moves ∧ is_empty x.right_moves :=
-by rw [birthday_def, ordinal.max_eq_zero, ordinal.lsub_eq_zero_iff, ordinal.lsub_eq_zero_iff]
+by rw [birthday_def, max_eq_zero, lsub_eq_zero_iff, lsub_eq_zero_iff]
 
 @[simp] theorem birthday_zero : birthday 0 = 0 :=
-by { rw birthday_eq_zero, split; apply_instance }
+by simp [pempty.is_empty]
 
 @[simp] theorem birthday_one : birthday 1 = 1 :=
-begin
-  have : (λ i, (move_left 1 i).birthday) = λ i, 0 := funext (λ x, by simp),
-  rw [birthday_def, @ordinal.lsub_empty (right_moves 1), this, ordinal.lsub_const,
-    ordinal.succ_zero],
-  exact max_bot_right 1
-end
+by { rw birthday_def, simp }
+
+@[simp] theorem birthday_star : birthday star = 1 :=
+by { rw birthday_def, simp }
 
 @[simp] theorem neg_birthday : ∀ x : pgame, (-x).birthday = x.birthday
 | ⟨xl, xr, xL, xR⟩ := begin
@@ -121,11 +110,10 @@ end
 begin
   induction o using ordinal.induction with o IH,
   rw [to_pgame_def, pgame.birthday],
-  convert max_eq_left_iff.2 (ordinal.zero_le _),
-  { apply lsub_empty },
-  { nth_rewrite 0 ←lsub_typein o,
-    congr,
-    exact funext (λ x, (IH _ (typein_lt_self x)).symm) }
+  simp only [lsub_empty, max_zero_right],
+  nth_rewrite 0 ←lsub_typein o,
+  congr' with x,
+  exact IH _ (typein_lt_self x)
 end
 
 theorem le_birthday : ∀ x : pgame, x ≤ x.birthday.to_pgame
@@ -133,7 +121,41 @@ theorem le_birthday : ∀ x : pgame, x ≤ x.birthday.to_pgame
 le_def.2 ⟨λ i, or.inl ⟨to_left_moves_to_pgame ⟨_, birthday_move_left_lt i⟩,
   by simp [le_birthday (xL i)]⟩, is_empty_elim⟩
 
-theorem neg_birthday_le (x : pgame) : -x.birthday.to_pgame ≤ x :=
-let h := le_birthday (-x) in by rwa [neg_birthday, le_iff_neg_ge, neg_neg] at h
+variables (a b x : pgame.{u})
+
+theorem neg_birthday_le : -x.birthday.to_pgame ≤ x :=
+by simpa only [neg_birthday, ←neg_le_iff] using le_birthday (-x)
+
+@[simp] theorem birthday_add : ∀ x y : pgame.{u}, (x + y).birthday = x.birthday ♯ y.birthday
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ := begin
+  rw [birthday_def, nadd_def],
+  simp only [birthday_add, lsub_sum, mk_add_move_left_inl, move_left_mk, mk_add_move_left_inr,
+    mk_add_move_right_inl, move_right_mk, mk_add_move_right_inr],
+  rw max_max_max_comm,
+  congr; apply le_antisymm,
+  any_goals
+  { exact max_le_iff.2 ⟨lsub_le_iff.2 (λ i, lt_blsub _ _ (birthday_move_left_lt i)),
+      lsub_le_iff.2 (λ i, lt_blsub _ _ (birthday_move_right_lt i))⟩ },
+  all_goals
+  { apply blsub_le_iff.2 (λ i hi, _),
+    rcases lt_birthday_iff.1 hi with ⟨j, hj⟩ | ⟨j, hj⟩ },
+  { exact lt_max_of_lt_left ((nadd_le_nadd_right hj _).trans_lt (lt_lsub _ _)) },
+  { exact lt_max_of_lt_right ((nadd_le_nadd_right hj _).trans_lt (lt_lsub _ _)) },
+  { exact lt_max_of_lt_left ((nadd_le_nadd_left hj _).trans_lt (lt_lsub _ _)) },
+  { exact lt_max_of_lt_right ((nadd_le_nadd_left hj _).trans_lt (lt_lsub _ _)) }
+end
+using_well_founded { dec_tac := pgame_wf_tac }
+
+theorem birthday_add_zero : (a + 0).birthday = a.birthday := by simp
+theorem birthday_zero_add : (0 + a).birthday = a.birthday := by simp
+theorem birthday_add_one  : (a + 1).birthday = order.succ a.birthday := by simp
+theorem birthday_one_add  : (1 + a).birthday = order.succ a.birthday := by simp
+
+@[simp] theorem birthday_nat_cast : ∀ n : ℕ, birthday n = n
+| 0 := birthday_zero
+| (n + 1) := by simp [birthday_nat_cast]
+
+theorem birthday_add_nat (n : ℕ) : (a + n).birthday = a.birthday + n := by simp
+theorem birthday_nat_add (n : ℕ) : (↑n + a).birthday = a.birthday + n := by simp
 
 end pgame
diff --git a/src/set_theory/game/domineering.lean b/src/set_theory/game/domineering.lean
index dd6f0a0a8ef48..43958be820b70 100644
--- a/src/set_theory/game/domineering.lean
+++ b/src/set_theory/game/domineering.lean
@@ -8,6 +8,9 @@ import set_theory.game.state
 /-!
 # Domineering as a combinatorial game.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the game of Domineering, played on a chessboard of arbitrary shape
 (possibly even disconnected).
 Left moves by placing a domino vertically, while Right moves by placing a domino horizontally.
@@ -137,7 +140,7 @@ instance state : state board :=
 end domineering
 
 /-- Construct a pre-game from a Domineering board. -/
-def domineering (b : domineering.board) : pgame := pgame.of b
+def domineering (b : domineering.board) : pgame := pgame.of_state b
 
 /-- All games of Domineering are short, because each move removes two squares. -/
 instance short_domineering (b : domineering.board) : short (domineering b) :=
diff --git a/src/set_theory/game/impartial.lean b/src/set_theory/game/impartial.lean
index 30be3c1e85ff3..c361208cf43b6 100644
--- a/src/set_theory/game/impartial.lean
+++ b/src/set_theory/game/impartial.lean
@@ -3,13 +3,16 @@ Copyright (c) 2020 Fox Thomson. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Fox Thomson
 -/
-import set_theory.game.winner
-import tactic.nth_rewrite.default
-import tactic.equiv_rw
+
+import set_theory.game.basic
+import tactic.nth_rewrite
 
 /-!
 # Basic definitions about impartial (pre-)games
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We will define an impartial game, one in which left and right can make exactly the same moves.
 Our definition differs slightly by saying that the game is always equivalent to its negative,
 no matter what moves are played. This allows for games such as poker-nim to be classifed as
@@ -18,11 +21,11 @@ impartial.
 
 universe u
 
-namespace pgame
+open_locale pgame
 
-local infix ` ≈ ` := equiv
+namespace pgame
 
-/-- The definition for a impartial game, defined using Conway induction -/
+/-- The definition for a impartial game, defined using Conway induction. -/
 def impartial_aux : pgame → Prop
 | G := G ≈ -G ∧ (∀ i, impartial_aux (G.move_left i)) ∧ ∀ j, impartial_aux (G.move_right j)
 using_well_founded { dec_tac := pgame_wf_tac }
@@ -51,6 +54,9 @@ by { rw impartial_def, simpa using impartial.impartial_zero }
 
 lemma neg_equiv_self (G : pgame) [h : G.impartial] : G ≈ -G := (impartial_def.1 h).1
 
+@[simp] lemma mk_neg_equiv_self (G : pgame) [h : G.impartial] : -⟦G⟧ = ⟦G⟧ :=
+quot.sound (neg_equiv_self G).symm
+
 instance move_left_impartial {G : pgame} [h : G.impartial] (i : G.left_moves) :
   (G.move_left i).impartial :=
 (impartial_def.1 h).2.1 i
@@ -59,16 +65,12 @@ instance move_right_impartial {G : pgame} [h : G.impartial] (j : G.right_moves)
   (G.move_right j).impartial :=
 (impartial_def.1 h).2.2 j
 
-theorem impartial_congr : ∀ {G H : pgame} (e : relabelling G H) [G.impartial], H.impartial
-| G H e := begin
+theorem impartial_congr : ∀ {G H : pgame} (e : G ≡r H) [G.impartial], H.impartial
+| G H := λ e, begin
   introI h,
-  rw impartial_def,
-  refine ⟨equiv_trans e.symm.equiv (equiv_trans (neg_equiv_self G) (neg_congr e.equiv)),
-    λ i, _, λ j, _⟩;
-  cases e with _ _ L R hL hR,
-  { convert impartial_congr (hL (L.symm i)),
-    rw equiv.apply_symm_apply },
-  { exact impartial_congr (hR j) }
+  exact impartial_def.2
+    ⟨e.symm.equiv.trans ((neg_equiv_self G).trans (neg_equiv_neg_iff.2 e.equiv)),
+      λ i, impartial_congr (e.move_left_symm i), λ j, impartial_congr (e.move_right_symm j)⟩
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
@@ -77,17 +79,16 @@ instance impartial_add : ∀ (G H : pgame) [G.impartial] [H.impartial], (G + H).
 begin
   introsI hG hH,
   rw impartial_def,
-  split,
-  { apply equiv_trans _ (neg_add_relabelling G H).equiv.symm,
-    exact add_congr (neg_equiv_self _) (neg_equiv_self _) },
-  split,
-  all_goals
-  { intro i,
-    equiv_rw pgame.left_moves_add G H at i <|> equiv_rw pgame.right_moves_add G H at i,
-    cases i },
-  all_goals
-  { simp only [add_move_left_inl, add_move_right_inl, add_move_left_inr, add_move_right_inr],
-    exact impartial_add _ _ }
+  refine ⟨(add_congr (neg_equiv_self _) (neg_equiv_self _)).trans
+    (neg_add_relabelling _ _).equiv.symm, λ k, _, λ k, _⟩,
+  { apply left_moves_add_cases k,
+    all_goals
+    { intro i, simp only [add_move_left_inl, add_move_left_inr],
+      apply impartial_add } },
+  { apply right_moves_add_cases k,
+    all_goals
+    { intro i, simp only [add_move_right_inl, add_move_right_inr],
+      apply impartial_add } }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
@@ -106,119 +107,94 @@ begin
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
-lemma winner_cases (G : pgame) [G.impartial] : G.first_loses ∨ G.first_wins :=
-begin
-  rcases G.winner_cases with hl | hr | hp | hn,
-  { cases hl with hpos hnonneg,
-    rw ←not_lt at hnonneg,
-    have hneg := lt_of_lt_of_equiv hpos (neg_equiv_self G),
-    rw [lt_iff_neg_gt, neg_neg, pgame.neg_zero] at hneg,
-    contradiction },
-  { cases hr with hnonpos hneg,
-    rw ←not_lt at hnonpos,
-    have hpos := lt_of_equiv_of_lt (neg_equiv_self G).symm hneg,
-    rw [lt_iff_neg_gt, neg_neg, pgame.neg_zero] at hpos,
-    contradiction },
-  { left, assumption },
-  { right, assumption }
+variables (G : pgame) [impartial G]
+
+lemma nonpos : ¬ 0 < G :=
+λ h, begin
+  have h' := neg_lt_neg_iff.2 h,
+  rw [neg_zero, lt_congr_left (neg_equiv_self G).symm] at h',
+  exact (h.trans h').false
+end
+
+lemma nonneg : ¬ G < 0 :=
+λ h, begin
+  have h' := neg_lt_neg_iff.2 h,
+  rw [neg_zero, lt_congr_right (neg_equiv_self G).symm] at h',
+  exact (h.trans h').false
 end
 
-lemma not_first_wins (G : pgame) [G.impartial] : ¬G.first_wins ↔ G.first_loses :=
+/-- In an impartial game, either the first player always wins, or the second player always wins. -/
+lemma equiv_or_fuzzy_zero : G ≈ 0 ∨ G ‖ 0 :=
 begin
-  cases winner_cases G; -- `finish using [not_first_loses_of_first_wins]` can close these goals
-  simp [not_first_loses_of_first_wins, not_first_wins_of_first_loses, h]
+  rcases lt_or_equiv_or_gt_or_fuzzy G 0 with h | h | h | h,
+  { exact ((nonneg G) h).elim },
+  { exact or.inl h },
+  { exact ((nonpos G) h).elim },
+  { exact or.inr h }
 end
 
-lemma not_first_loses (G : pgame) [G.impartial] : ¬G.first_loses ↔ G.first_wins :=
-iff.symm $ iff_not_comm.1 $ iff.symm $ not_first_wins G
+@[simp] lemma not_equiv_zero_iff : ¬ G ≈ 0 ↔ G ‖ 0 :=
+⟨(equiv_or_fuzzy_zero G).resolve_left, fuzzy.not_equiv⟩
 
-lemma add_self (G : pgame) [G.impartial] : (G + G).first_loses :=
-  first_loses_is_zero.2 $ equiv_trans (add_congr (neg_equiv_self G) G.equiv_refl)
-  (add_left_neg_equiv G)
+@[simp] lemma not_fuzzy_zero_iff : ¬ G ‖ 0 ↔ G ≈ 0 :=
+⟨(equiv_or_fuzzy_zero G).resolve_right, equiv.not_fuzzy⟩
 
-lemma equiv_iff_sum_first_loses (G H : pgame) [G.impartial] [H.impartial] :
-  G ≈ H ↔ (G + H).first_loses :=
-begin
-  split,
-  { intro heq,
-    exact first_loses_of_equiv (add_congr (equiv_refl _) heq) (add_self G) },
-  { intro hGHp,
-    split,
-    { rw le_iff_sub_nonneg,
-      exact le_trans hGHp.2
-        (le_trans add_comm_le $ le_of_le_of_equiv (pgame.le_refl _) $ add_congr (equiv_refl _)
-        (neg_equiv_self G)) },
-    { rw le_iff_sub_nonneg,
-      exact le_trans hGHp.2
-        (le_of_le_of_equiv (pgame.le_refl _) $ add_congr (equiv_refl _) (neg_equiv_self H)) } }
-end
+lemma add_self : G + G ≈ 0 :=
+(add_congr_left (neg_equiv_self G)).trans (add_left_neg_equiv G)
 
-lemma le_zero_iff {G : pgame} [G.impartial] : G ≤ 0 ↔ 0 ≤ G :=
-by rw [le_zero_iff_zero_le_neg, le_congr (equiv_refl 0) (neg_equiv_self G)]
+@[simp] lemma mk_add_self : ⟦G⟧ + ⟦G⟧ = 0 := quot.sound (add_self G)
 
-lemma lt_zero_iff {G : pgame} [G.impartial] : G < 0 ↔ 0 < G :=
-by rw [lt_iff_neg_gt, pgame.neg_zero, lt_congr (equiv_refl 0) (neg_equiv_self G)]
+/-- This lemma doesn't require `H` to be impartial. -/
+lemma equiv_iff_add_equiv_zero (H : pgame) : H ≈ G ↔ H + G ≈ 0 :=
+by { rw [equiv_iff_game_eq, equiv_iff_game_eq, ←@add_right_cancel_iff _ _ _ (-⟦G⟧)], simpa }
 
-lemma first_loses_symm (G : pgame) [G.impartial] : G.first_loses ↔ G ≤ 0 :=
-⟨and.left, λ h, ⟨h, le_zero_iff.1 h⟩⟩
+/-- This lemma doesn't require `H` to be impartial. -/
+lemma equiv_iff_add_equiv_zero' (H : pgame) : G ≈ H ↔ G + H ≈ 0 :=
+by { rw [equiv_iff_game_eq, equiv_iff_game_eq, ←@add_left_cancel_iff _ _ _ (-⟦G⟧), eq_comm], simpa }
 
-lemma first_wins_symm (G : pgame) [G.impartial] : G.first_wins ↔ G < 0 :=
-⟨and.right, λ h, ⟨lt_zero_iff.1 h, h⟩⟩
+lemma le_zero_iff {G : pgame} [G.impartial] : G ≤ 0 ↔ 0 ≤ G :=
+by rw [←zero_le_neg_iff, le_congr_right (neg_equiv_self G)]
 
-lemma first_loses_symm' (G : pgame) [G.impartial] : G.first_loses ↔ 0 ≤ G :=
-⟨and.right, λ h, ⟨le_zero_iff.2 h, h⟩⟩
+lemma lf_zero_iff {G : pgame} [G.impartial] : G ⧏ 0 ↔ 0 ⧏ G :=
+by rw [←zero_lf_neg_iff, lf_congr_right (neg_equiv_self G)]
 
-lemma first_wins_symm' (G : pgame) [G.impartial] : G.first_wins ↔ 0 < G :=
-⟨and.left, λ h, ⟨h, lt_zero_iff.2 h⟩⟩
+lemma equiv_zero_iff_le: G ≈ 0 ↔ G ≤ 0 := ⟨and.left, λ h, ⟨h, le_zero_iff.1 h⟩⟩
+lemma fuzzy_zero_iff_lf : G ‖ 0 ↔ G ⧏ 0 := ⟨and.left, λ h, ⟨h, lf_zero_iff.1 h⟩⟩
+lemma equiv_zero_iff_ge : G ≈ 0 ↔ 0 ≤ G := ⟨and.right, λ h, ⟨le_zero_iff.2 h, h⟩⟩
+lemma fuzzy_zero_iff_gf : G ‖ 0 ↔ 0 ⧏ G := ⟨and.right, λ h, ⟨lf_zero_iff.2 h, h⟩⟩
 
-lemma no_good_left_moves_iff_first_loses (G : pgame) [G.impartial] :
-  (∀ (i : G.left_moves), (G.move_left i).first_wins) ↔ G.first_loses :=
+lemma forall_left_moves_fuzzy_iff_equiv_zero : (∀ i, G.move_left i ‖ 0) ↔ G ≈ 0 :=
 begin
-  split,
-  { intro hbad,
-    rw [first_loses_symm G, le_def_lt],
-    split,
-    { intro i,
-      specialize hbad i,
-      exact hbad.2 },
-    { intro j,
-      exact pempty.elim j } },
-  { intros hp i,
-    rw first_wins_symm,
-    exact (le_def_lt.1 $ (first_loses_symm G).1 hp).1 i }
+  refine ⟨λ hb, _, λ hp i, _⟩,
+  { rw [equiv_zero_iff_le G, le_zero_lf],
+    exact λ i, (hb i).1 },
+  { rw fuzzy_zero_iff_lf,
+    exact hp.1.move_left_lf i }
 end
 
-lemma no_good_right_moves_iff_first_loses (G : pgame) [G.impartial] :
-  (∀ (j : G.right_moves), (G.move_right j).first_wins) ↔ G.first_loses :=
+lemma forall_right_moves_fuzzy_iff_equiv_zero : (∀ j, G.move_right j ‖ 0) ↔ G ≈ 0 :=
 begin
-  rw [first_loses_of_equiv_iff (neg_equiv_self G), ←no_good_left_moves_iff_first_loses],
-  refine ⟨λ h i, _, λ h i, _⟩,
-  { rw [move_left_neg',
-      ←first_wins_of_equiv_iff (neg_equiv_self (G.move_right (to_left_moves_neg.symm i)))],
-    apply h },
-  { rw [move_right_neg_symm',
-      ←first_wins_of_equiv_iff (neg_equiv_self ((-G).move_left (to_left_moves_neg i)))],
-    apply h }
+  refine ⟨λ hb, _, λ hp i, _⟩,
+  { rw [equiv_zero_iff_ge G, zero_le_lf],
+    exact λ i, (hb i).2 },
+  { rw fuzzy_zero_iff_gf,
+    exact hp.2.lf_move_right i }
 end
 
-lemma good_left_move_iff_first_wins (G : pgame) [G.impartial] :
-  (∃ (i : G.left_moves), (G.move_left i).first_loses) ↔ G.first_wins :=
+lemma exists_left_move_equiv_iff_fuzzy_zero : (∃ i, G.move_left i ≈ 0) ↔ G ‖ 0 :=
 begin
-  refine ⟨λ ⟨i, hi⟩, (first_wins_symm' G).2 (lt_def_le.2 $ or.inl ⟨i, hi.2⟩), λ hn, _⟩,
-  rw [first_wins_symm' G, lt_def_le] at hn,
-  rcases hn with ⟨i, hi⟩ | ⟨j, _⟩,
-  { exact ⟨i, (first_loses_symm' _).2 hi⟩ },
-  { exact pempty.elim j }
+  refine ⟨λ ⟨i, hi⟩, (fuzzy_zero_iff_gf G).2 (lf_of_le_move_left hi.2), λ hn, _⟩,
+  rw [fuzzy_zero_iff_gf G, zero_lf_le] at hn,
+  cases hn with i hi,
+  exact ⟨i, (equiv_zero_iff_ge _).2 hi⟩
 end
 
-lemma good_right_move_iff_first_wins (G : pgame) [G.impartial] :
-  (∃ j : G.right_moves, (G.move_right j).first_loses) ↔ G.first_wins :=
+lemma exists_right_move_equiv_iff_fuzzy_zero : (∃ j, G.move_right j ≈ 0) ↔ G ‖ 0 :=
 begin
-  refine ⟨λ ⟨j, hj⟩, (first_wins_symm G).2 (lt_def_le.2 $ or.inr ⟨j, hj.1⟩), λ hn, _⟩,
-  rw [first_wins_symm G, lt_def_le] at hn,
-  rcases hn with ⟨i, _⟩ | ⟨j, hj⟩,
-  { exact pempty.elim i },
-  { exact ⟨j, (first_loses_symm _).2 hj⟩ }
+  refine ⟨λ ⟨i, hi⟩, (fuzzy_zero_iff_lf G).2 (lf_of_move_right_le hi.1), λ hn, _⟩,
+  rw [fuzzy_zero_iff_lf G, lf_zero_le] at hn,
+  cases hn with i hi,
+  exact ⟨i, (equiv_zero_iff_le _).2 hi⟩
 end
 
 end impartial
diff --git a/src/set_theory/game/nim.lean b/src/set_theory/game/nim.lean
index ef37d3db98c37..93d6b3f894ccd 100644
--- a/src/set_theory/game/nim.lean
+++ b/src/set_theory/game/nim.lean
@@ -6,11 +6,15 @@ Authors: Fox Thomson, Markus Himmel
 import data.nat.bitwise
 import set_theory.game.birthday
 import set_theory.game.impartial
+
 /-!
 # Nim and the Sprague-Grundy theorem
 
-This file contains the definition for nim for any ordinal `O`. In the game of `nim O₁` both players
-may move to `nim O₂` for any `O₂ < O₁`.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains the definition for nim for any ordinal `o`. In the game of `nim o₁` both players
+may move to `nim o₂` for any `o₂ < o₁`.
 We also define a Grundy value for an impartial game `G` and prove the Sprague-Grundy theorem, that
 `G` is equivalent to `nim (grundy_value G)`.
 Finally, we compute the sum of finite Grundy numbers: if `G` and `H` have Grundy values `n` and `m`,
@@ -18,188 +22,195 @@ where `n` and `m` are natural numbers, then `G + H` has the Grundy value `n xor
 
 ## Implementation details
 
-The pen-and-paper definition of nim defines the possible moves of `nim O` to be `{O' | O' < O}`.
+The pen-and-paper definition of nim defines the possible moves of `nim o` to be `set.Iio o`.
 However, this definition does not work for us because it would make the type of nim
 `ordinal.{u} → pgame.{u + 1}`, which would make it impossible for us to state the Sprague-Grundy
 theorem, since that requires the type of `nim` to be `ordinal.{u} → pgame.{u}`. For this reason, we
-instead use `O.out.α` for the possible moves, which makes proofs significantly more messy and
-tedious, but avoids the universe bump.
+instead use `o.out.α` for the possible moves. You can use `to_left_moves_nim` and
+`to_right_moves_nim` to convert an ordinal less than `o` into a left or right move of `nim o`, and
+vice versa.
+-/
 
-The lemma `nim_def` is somewhat prone to produce "motive is not type correct" errors. If you run
-into this problem, you may find the lemmas `exists_ordinal_move_left_eq` and `exists_move_left_eq`
-useful.
+noncomputable theory
 
--/
-universes u
+universe u
 
-/-- `ordinal.out'` has the sole purpose of making `nim` computable. It performs the same job as
-  `quotient.out` but is specific to ordinals. -/
-def ordinal.out' (o : ordinal) : Well_order :=
-⟨o.out.α, (<), o.out.wo⟩
+open_locale pgame
+
+namespace pgame
 
 /-- The definition of single-heap nim, which can be viewed as a pile of stones where each player can
   take a positive number of stones from it on their turn. -/
-def nim : ordinal → pgame
-| O₁ := let f := λ O₂, have hwf : ordinal.typein O₁.out'.r O₂ < O₁ := ordinal.typein_lt_self O₂,
-          nim (ordinal.typein O₁.out'.r O₂) in ⟨O₁.out'.α, O₁.out'.α, f, f⟩
+-- Uses `noncomputable!` to avoid `rec_fn_macro only allowed in meta definitions` VM error
+noncomputable! def nim : ordinal.{u} → pgame.{u}
+| o₁ :=
+  let f := λ o₂,
+    have ordinal.typein o₁.out.r o₂ < o₁ := ordinal.typein_lt_self o₂,
+    nim (ordinal.typein o₁.out.r o₂)
+  in ⟨o₁.out.α, o₁.out.α, f, f⟩
 using_well_founded { dec_tac := tactic.assumption }
 
-namespace pgame
+open ordinal
 
-local infix ` ≈ ` := equiv
+lemma nim_def (o : ordinal) : nim o = pgame.mk o.out.α o.out.α
+  (λ o₂, nim (ordinal.typein (<) o₂))
+  (λ o₂, nim (ordinal.typein (<) o₂)) :=
+by { rw nim, refl }
 
-namespace nim
+lemma left_moves_nim (o : ordinal) : (nim o).left_moves = o.out.α :=
+by { rw nim_def, refl }
+lemma right_moves_nim (o : ordinal) : (nim o).right_moves = o.out.α :=
+by { rw nim_def, refl }
 
-open ordinal
+lemma move_left_nim_heq (o : ordinal) : (nim o).move_left == λ i : o.out.α, nim (typein (<) i) :=
+by { rw nim_def, refl }
+lemma move_right_nim_heq (o : ordinal) : (nim o).move_right == λ i : o.out.α, nim (typein (<) i) :=
+by { rw nim_def, refl }
 
-lemma nim_def (O : ordinal) : nim O = pgame.mk O.out.α O.out.α
-  (λ O₂, nim (ordinal.typein (<) O₂))
-  (λ O₂, nim (ordinal.typein (<) O₂)) :=
-by { rw nim, refl }
+/-- Turns an ordinal less than `o` into a left move for `nim o` and viceversa. -/
+noncomputable def to_left_moves_nim {o : ordinal} : set.Iio o ≃ (nim o).left_moves :=
+(enum_iso_out o).to_equiv.trans (equiv.cast (left_moves_nim o).symm)
 
-instance : is_empty (left_moves (nim 0)) :=
-by { rw nim_def, exact α.is_empty }
+/-- Turns an ordinal less than `o` into a right move for `nim o` and viceversa. -/
+noncomputable def to_right_moves_nim {o : ordinal} : set.Iio o ≃ (nim o).right_moves :=
+(enum_iso_out o).to_equiv.trans (equiv.cast (right_moves_nim o).symm)
 
-instance : is_empty (right_moves (nim 0)) :=
-by { rw nim_def, exact α.is_empty }
+@[simp] theorem to_left_moves_nim_symm_lt {o : ordinal} (i : (nim o).left_moves) :
+  ↑(to_left_moves_nim.symm i) < o :=
+(to_left_moves_nim.symm i).prop
 
-noncomputable instance : unique (left_moves (nim 1)) :=
-by { rw nim_def, exact α.unique }
+@[simp] theorem to_right_moves_nim_symm_lt {o : ordinal} (i : (nim o).right_moves) :
+  ↑(to_right_moves_nim.symm i) < o :=
+(to_right_moves_nim.symm i).prop
 
-noncomputable instance : unique (right_moves (nim 1)) :=
-by { rw nim_def, exact α.unique }
+@[simp] lemma move_left_nim' {o : ordinal.{u}} (i) :
+  (nim o).move_left i = nim (to_left_moves_nim.symm i).val :=
+(congr_heq (move_left_nim_heq o).symm (cast_heq _ i)).symm
 
-/-- `0` has exactly the same moves as `nim 0`. -/
-def nim_zero_relabelling : relabelling 0 (nim 0) :=
-(relabelling.is_empty _).symm
+lemma move_left_nim {o : ordinal} (i) :
+  (nim o).move_left (to_left_moves_nim i) = nim i :=
+by simp
 
-@[simp] theorem nim_zero_equiv : 0 ≈ nim 0 := nim_zero_relabelling.equiv
+@[simp] lemma move_right_nim' {o : ordinal} (i) :
+  (nim o).move_right i = nim (to_right_moves_nim.symm i).val :=
+(congr_heq (move_right_nim_heq o).symm (cast_heq _ i)).symm
 
-/-- `nim 1` has exactly the same moves as `star`. -/
-noncomputable def nim_one_relabelling : relabelling star (nim 1) :=
-begin
-  rw nim_def,
-  refine ⟨_, _, λ i,  _, λ j, _⟩,
-  any_goals { dsimp, apply equiv_of_unique_of_unique },
-  all_goals { simp, exact nim_zero_relabelling }
-end
+lemma move_right_nim {o : ordinal} (i) :
+  (nim o).move_right (to_right_moves_nim i) = nim i :=
+by simp
 
-@[simp] theorem nim_one_equiv : star ≈ nim 1 := nim_one_relabelling.equiv
+/-- A recursion principle for left moves of a nim game. -/
+@[elab_as_eliminator] def left_moves_nim_rec_on {o : ordinal} {P : (nim o).left_moves → Sort*}
+  (i : (nim o).left_moves) (H : ∀ a < o, P $ to_left_moves_nim ⟨a, H⟩) : P i :=
+by { rw ←to_left_moves_nim.apply_symm_apply i, apply H }
 
-@[simp] lemma nim_birthday (O : ordinal) : (nim O).birthday = O :=
-begin
-  induction O using ordinal.induction with O IH,
-  rw [nim_def, birthday_def],
-  dsimp,
-  rw max_eq_right le_rfl,
-  convert lsub_typein O,
-  exact funext (λ i, IH _ (typein_lt_self i))
-end
+/-- A recursion principle for right moves of a nim game. -/
+@[elab_as_eliminator] def right_moves_nim_rec_on {o : ordinal} {P : (nim o).right_moves → Sort*}
+  (i : (nim o).right_moves) (H : ∀ a < o, P $ to_right_moves_nim ⟨a, H⟩) : P i :=
+by { rw ←to_right_moves_nim.apply_symm_apply i, apply H }
 
-lemma left_moves_nim (O : ordinal) : (nim O).left_moves = O.out.α :=
-by { rw nim_def, refl }
-lemma right_moves_nim (O : ordinal) : (nim O).right_moves = O.out.α :=
-by { rw nim_def, refl }
+instance is_empty_nim_zero_left_moves : is_empty (nim 0).left_moves :=
+by { rw nim_def, exact ordinal.is_empty_out_zero }
 
-lemma move_left_nim_heq (O : ordinal) : (nim O).move_left == λ i : O.out.α, nim (typein (<) i) :=
-by { rw nim_def, refl }
-lemma move_right_nim_heq (O : ordinal) : (nim O).move_right == λ i : O.out.α, nim (typein (<) i) :=
-by { rw nim_def, refl }
+instance is_empty_nim_zero_right_moves : is_empty (nim 0).right_moves :=
+by { rw nim_def, exact ordinal.is_empty_out_zero }
 
-/-- Turns an ordinal less than `O` into a left move for `nim O` and viceversa. -/
-noncomputable def to_left_moves_nim {O : ordinal} : {O' // O' < O} ≃ (nim O).left_moves :=
-(out_equiv_lt O).trans (equiv.cast (left_moves_nim O).symm)
+/-- `nim 0` has exactly the same moves as `0`. -/
+def nim_zero_relabelling : nim 0 ≡r 0 := relabelling.is_empty _
 
-/-- Turns an ordinal less than `O` into a right move for `nim O` and viceversa. -/
-noncomputable def to_right_moves_nim {O : ordinal} : {O' // O' < O} ≃ (nim O).right_moves :=
-(out_equiv_lt O).trans (equiv.cast (right_moves_nim O).symm)
+theorem nim_zero_equiv : nim 0 ≈ 0 := equiv.is_empty _
 
-@[simp] theorem to_left_moves_nim_symm_lt {O : ordinal} (i : (nim O).left_moves) :
-  ↑(to_left_moves_nim.symm i) < O :=
-(to_left_moves_nim.symm i).prop
+noncomputable instance unique_nim_one_left_moves : unique (nim 1).left_moves :=
+(equiv.cast $ left_moves_nim 1).unique
 
-@[simp] theorem to_right_moves_nim_symm_lt {O : ordinal} (i : (nim O).right_moves) :
-  ↑(to_right_moves_nim.symm i) < O :=
-(to_right_moves_nim.symm i).prop
+noncomputable instance unique_nim_one_right_moves : unique (nim 1).right_moves :=
+(equiv.cast $ right_moves_nim 1).unique
 
-@[simp] lemma move_left_nim' {O : ordinal.{u}} (i) :
-  (nim O).move_left i = nim (to_left_moves_nim.symm i).val :=
-(congr_heq (move_left_nim_heq O).symm (cast_heq _ i)).symm
+@[simp] theorem default_nim_one_left_moves_eq :
+  (default : (nim 1).left_moves) = @to_left_moves_nim 1 ⟨0, zero_lt_one⟩ :=
+rfl
 
-lemma move_left_nim {O : ordinal} (i) :
-  (nim O).move_left (to_left_moves_nim i) = nim i :=
+@[simp] theorem default_nim_one_right_moves_eq :
+  (default : (nim 1).right_moves) = @to_right_moves_nim 1 ⟨0, zero_lt_one⟩ :=
+rfl
+
+@[simp] theorem to_left_moves_nim_one_symm (i) :
+  (@to_left_moves_nim 1).symm i = ⟨0, zero_lt_one⟩ :=
 by simp
 
-@[simp] lemma move_right_nim' {O : ordinal} (i) :
-  (nim O).move_right i = nim (to_right_moves_nim.symm i).val :=
-(congr_heq (move_right_nim_heq O).symm (cast_heq _ i)).symm
+@[simp] theorem to_right_moves_nim_one_symm (i) :
+  (@to_right_moves_nim 1).symm i = ⟨0, zero_lt_one⟩ :=
+by simp
 
-lemma move_right_nim {O : ordinal} (i) :
-  (nim O).move_right (to_right_moves_nim i) = nim i :=
+theorem nim_one_move_left (x) : (nim 1).move_left x = nim 0 :=
 by simp
 
-@[simp] lemma neg_nim (O : ordinal) : -nim O = nim O :=
+theorem nim_one_move_right (x) : (nim 1).move_right x = nim 0 :=
+by simp
+
+/-- `nim 1` has exactly the same moves as `star`. -/
+def nim_one_relabelling : nim 1 ≡r star :=
 begin
-  induction O using ordinal.induction with O IH,
+  rw nim_def,
+  refine ⟨_, _, λ i, _, λ j, _⟩,
+  any_goals { dsimp, apply equiv.equiv_of_unique },
+  all_goals { simp, exact nim_zero_relabelling }
+end
+
+theorem nim_one_equiv : nim 1 ≈ star := nim_one_relabelling.equiv
+
+@[simp] lemma nim_birthday (o : ordinal) : (nim o).birthday = o :=
+begin
+  induction o using ordinal.induction with o IH,
+  rw [nim_def, birthday_def],
+  dsimp,
+  rw max_eq_right le_rfl,
+  convert lsub_typein o,
+  exact funext (λ i, IH _ (typein_lt_self i))
+end
+
+@[simp] lemma neg_nim (o : ordinal) : -nim o = nim o :=
+begin
+  induction o using ordinal.induction with o IH,
   rw nim_def, dsimp; congr;
   funext i;
   exact IH _ (ordinal.typein_lt_self i)
 end
 
-instance nim_impartial (O : ordinal) : impartial (nim O) :=
+instance nim_impartial (o : ordinal) : impartial (nim o) :=
 begin
-  induction O using ordinal.induction with O IH,
+  induction o using ordinal.induction with o IH,
   rw [impartial_def, neg_nim],
-  refine ⟨equiv_refl _, λ i, _, λ i, _⟩;
+  refine ⟨equiv_rfl, λ i, _, λ i, _⟩;
   simpa using IH _ (typein_lt_self _)
 end
 
-lemma exists_ordinal_move_left_eq {O : ordinal} (i) : ∃ O' < O, (nim O).move_left i = nim O' :=
-⟨_, typein_lt_self _, move_left_nim' i⟩
-
-lemma exists_move_left_eq {O O' : ordinal} (h : O' < O) : ∃ i, (nim O).move_left i = nim O' :=
-⟨to_left_moves_nim ⟨O', h⟩, by simp⟩
-
-@[simp] lemma zero_first_loses : (nim (0 : ordinal)).first_loses :=
-begin
-  rw [impartial.first_loses_symm, nim_def, le_def_lt],
-  exact ⟨@is_empty_elim (0 : ordinal).out.α _ _, @is_empty_elim pempty _ _⟩
-end
-
-lemma non_zero_first_wins {O : ordinal} (hO : O ≠ 0) : (nim O).first_wins :=
+lemma nim_fuzzy_zero_of_ne_zero {o : ordinal} (ho : o ≠ 0) : nim o ‖ 0 :=
 begin
-  rw [impartial.first_wins_symm, nim_def, lt_def_le],
-  rw ←ordinal.pos_iff_ne_zero at hO,
-  exact or.inr ⟨(ordinal.principal_seg_out hO).top, by simp⟩
+  rw [impartial.fuzzy_zero_iff_lf, nim_def, lf_zero_le],
+  rw ←ordinal.pos_iff_ne_zero at ho,
+  exact ⟨(ordinal.principal_seg_out ho).top, by simp⟩
 end
 
-@[simp] lemma sum_first_loses_iff_eq (O₁ O₂ : ordinal) : (nim O₁ + nim O₂).first_loses ↔ O₁ = O₂ :=
+@[simp] lemma nim_add_equiv_zero_iff (o₁ o₂ : ordinal) : nim o₁ + nim o₂ ≈ 0 ↔ o₁ = o₂ :=
 begin
   split,
-  { contrapose,
-    intro h,
-    rw [impartial.not_first_loses],
-    wlog h' : O₁ ≤ O₂ using [O₁ O₂, O₂ O₁],
-    { exact ordinal.le_total O₁ O₂ },
-    { have h : O₁ < O₂ := lt_of_le_of_ne h' h,
-      rw [impartial.first_wins_symm', lt_def_le, nim_def O₂],
-      refine or.inl ⟨(left_moves_add (nim O₁) _).symm (sum.inr _), _⟩,
-      { exact (ordinal.principal_seg_out h).top },
-      { simpa using (impartial.add_self (nim O₁)).2 } },
-    { exact first_wins_of_equiv add_comm_equiv (this (ne.symm h)) } },
+  { refine not_imp_not.1 (λ (hne : _ ≠ _), (impartial.not_equiv_zero_iff _).2 _),
+    wlog h : o₁ < o₂,
+    { exact (fuzzy_congr_left add_comm_equiv).1 (this _ _ hne.symm (hne.lt_or_lt.resolve_left h)) },
+    rw [impartial.fuzzy_zero_iff_gf, zero_lf_le, nim_def o₂],
+    refine ⟨to_left_moves_add (sum.inr _), _⟩,
+    { exact (ordinal.principal_seg_out h).top },
+    { simpa using (impartial.add_self (nim o₁)).2 } },
   { rintro rfl,
-    exact impartial.add_self (nim O₁) }
+    exact impartial.add_self (nim o₁) }
 end
 
-@[simp] lemma sum_first_wins_iff_neq (O₁ O₂ : ordinal) : (nim O₁ + nim O₂).first_wins ↔ O₁ ≠ O₂ :=
-by rw [iff_not_comm, impartial.not_first_wins, sum_first_loses_iff_eq]
-
-@[simp] lemma equiv_iff_eq (O₁ O₂ : ordinal) : nim O₁ ≈ nim O₂ ↔ O₁ = O₂ :=
-⟨λ h, (sum_first_loses_iff_eq _ _).1 $
-  by rw [first_loses_of_equiv_iff (add_congr h (equiv_refl _)), sum_first_loses_iff_eq],
- by { rintro rfl, refl }⟩
+@[simp] lemma nim_add_fuzzy_zero_iff {o₁ o₂ : ordinal} : nim o₁ + nim o₂ ‖ 0 ↔ o₁ ≠ o₂ :=
+by rw [iff_not_comm, impartial.not_fuzzy_zero_iff, nim_add_equiv_zero_iff]
 
-end nim
+@[simp] lemma nim_equiv_iff_eq {o₁ o₂ : ordinal} : nim o₁ ≈ nim o₂ ↔ o₁ = o₂ :=
+by rw [impartial.equiv_iff_add_equiv_zero, nim_add_equiv_zero_iff]
 
 /-- The Grundy value of an impartial game, the ordinal which corresponds to the game of nim that the
  game is equivalent to -/
@@ -207,7 +218,7 @@ noncomputable def grundy_value : Π (G : pgame.{u}), ordinal.{u}
 | G := ordinal.mex.{u u} (λ i, grundy_value (G.move_left i))
 using_well_founded { dec_tac := pgame_wf_tac }
 
-lemma grundy_value_def (G : pgame) :
+lemma grundy_value_eq_mex_left (G : pgame) :
   grundy_value G = ordinal.mex.{u u} (λ i, grundy_value (G.move_left i)) :=
 by rw grundy_value
 
@@ -217,131 +228,115 @@ theorem equiv_nim_grundy_value : ∀ (G : pgame.{u}) [G.impartial], G ≈ nim (g
 | G :=
 begin
   introI hG,
-  rw [impartial.equiv_iff_sum_first_loses, ←impartial.no_good_left_moves_iff_first_loses],
+  rw [impartial.equiv_iff_add_equiv_zero, ←impartial.forall_left_moves_fuzzy_iff_equiv_zero],
   intro i,
-  equiv_rw left_moves_add G (nim (grundy_value G)) at i,
-  cases i with i₁ i₂,
-  { rw add_move_left_inl,
-    apply first_wins_of_equiv
-     (add_congr (equiv_nim_grundy_value (G.move_left i₁)).symm (equiv_refl _)),
-    rw nim.sum_first_wins_iff_neq,
+  apply left_moves_add_cases i,
+  { intro i₁,
+    rw add_move_left_inl,
+    apply (fuzzy_congr_left (add_congr_left (equiv_nim_grundy_value (G.move_left i₁)).symm)).1,
+    rw nim_add_fuzzy_zero_iff,
     intro heq,
-    rw [eq_comm, grundy_value_def G] at heq,
+    rw [eq_comm, grundy_value_eq_mex_left G] at heq,
     have h := ordinal.ne_mex _,
     rw heq at h,
     exact (h i₁).irrefl },
-  { rw [add_move_left_inr, ←impartial.good_left_move_iff_first_wins],
+  { intro i₂,
+    rw [add_move_left_inr, ←impartial.exists_left_move_equiv_iff_fuzzy_zero],
     revert i₂,
-    rw nim.nim_def,
+    rw nim_def,
     intro i₂,
 
     have h' : ∃ i : G.left_moves, (grundy_value (G.move_left i)) =
       ordinal.typein (quotient.out (grundy_value G)).r i₂,
     { revert i₂,
-      rw grundy_value_def,
+      rw grundy_value_eq_mex_left,
       intros i₂,
       have hnotin : _ ∉ _ := λ hin, (le_not_le_of_lt (ordinal.typein_lt_self i₂)).2 (cInf_le' hin),
       simpa using hnotin},
 
     cases h' with i hi,
-    use (left_moves_add _ _).symm (sum.inl i),
+    use to_left_moves_add (sum.inl i),
     rw [add_move_left_inl, move_left_mk],
-    apply first_loses_of_equiv
-      (add_congr (equiv_symm (equiv_nim_grundy_value (G.move_left i))) (equiv_refl _)),
+    apply (add_congr_left (equiv_nim_grundy_value (G.move_left i))).trans,
     simpa only [hi] using impartial.add_self (nim (grundy_value (G.move_left i))) }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
-@[simp] lemma grundy_value_eq_iff_equiv_nim (G : pgame) [G.impartial] (O : ordinal) :
-  grundy_value G = O ↔ G ≈ nim O :=
+lemma grundy_value_eq_iff_equiv_nim {G : pgame} [G.impartial] {o : ordinal} :
+  grundy_value G = o ↔ G ≈ nim o :=
 ⟨by { rintro rfl, exact equiv_nim_grundy_value G },
-  by { intro h, rw ←nim.equiv_iff_eq, exact equiv_trans (equiv_symm (equiv_nim_grundy_value G)) h }⟩
+  by { intro h, rw ←nim_equiv_iff_eq, exact (equiv_nim_grundy_value G).symm.trans h }⟩
 
-lemma nim.grundy_value (O : ordinal.{u}) : grundy_value (nim O) = O :=
-by simp
+@[simp] lemma nim_grundy_value (o : ordinal.{u}) : grundy_value (nim o) = o :=
+grundy_value_eq_iff_equiv_nim.2 pgame.equiv_rfl
 
-@[simp] lemma grundy_value_eq_iff_equiv (G H : pgame) [G.impartial] [H.impartial] :
+lemma grundy_value_eq_iff_equiv (G H : pgame) [G.impartial] [H.impartial] :
   grundy_value G = grundy_value H ↔ G ≈ H :=
-(grundy_value_eq_iff_equiv_nim _ _).trans (equiv_congr_left.1 (equiv_nim_grundy_value H) _).symm
+grundy_value_eq_iff_equiv_nim.trans (equiv_congr_left.1 (equiv_nim_grundy_value H) _).symm
 
-lemma grundy_value_zero : grundy_value 0 = 0 :=
-by simp
+@[simp] lemma grundy_value_zero : grundy_value 0 = 0 :=
+grundy_value_eq_iff_equiv_nim.2 nim_zero_equiv.symm
 
-@[simp] lemma grundy_value_iff_equiv_zero (G : pgame) [G.impartial] : grundy_value G = 0 ↔ G ≈ 0 :=
+lemma grundy_value_iff_equiv_zero (G : pgame) [G.impartial] : grundy_value G = 0 ↔ G ≈ 0 :=
 by rw [←grundy_value_eq_iff_equiv, grundy_value_zero]
 
-lemma grundy_value_star : grundy_value star = 1 :=
-by simp
+@[simp] lemma grundy_value_star : grundy_value star = 1 :=
+grundy_value_eq_iff_equiv_nim.2 nim_one_equiv.symm
+
+@[simp] lemma grundy_value_neg (G : pgame) [G.impartial] : grundy_value (-G) = grundy_value G :=
+by rw [grundy_value_eq_iff_equiv_nim, neg_equiv_iff, neg_nim, ←grundy_value_eq_iff_equiv_nim]
+
+lemma grundy_value_eq_mex_right : ∀ (G : pgame) [G.impartial],
+  grundy_value G = ordinal.mex.{u u} (λ i, grundy_value (G.move_right i))
+| ⟨l, r, L, R⟩ := begin
+  introI H,
+  rw [←grundy_value_neg, grundy_value_eq_mex_left],
+  congr,
+  ext i,
+  haveI : (R i).impartial := @impartial.move_right_impartial ⟨l, r, L, R⟩ _ i,
+  apply grundy_value_neg
+end
 
+/-- The Grundy value of the sum of two nim games with natural numbers of piles equals their bitwise
+xor. -/
+-- Todo: this actually generalizes to all ordinals, by defining `ordinal.lxor` as the pairwise
+-- `nat.lxor` of base `ω` Cantor normal forms.
 @[simp] lemma grundy_value_nim_add_nim (n m : ℕ) :
   grundy_value (nim.{u} n + nim.{u} m) = nat.lxor n m :=
 begin
+  -- We do strong induction on both variables.
   induction n using nat.strong_induction_on with n hn generalizing m,
   induction m using nat.strong_induction_on with m hm,
-  rw [grundy_value_def],
-
-  -- We want to show that `n xor m` is the smallest unreachable Grundy value. We will do this in two
-  -- steps:
-  -- h₀: `n xor m` is not a reachable grundy number.
-  -- h₁: every Grundy number strictly smaller than `n xor m` is reachable.
-
-  have h₀ : ∀ i, grundy_value ((nim n + nim m).move_left i) ≠ (nat.lxor n m : ordinal),
-  { -- To show that `n xor m` is unreachable, we show that every move produces a Grundy number
-    -- different from `n xor m`.
-    equiv_rw left_moves_add _ _,
-
-    -- The move operates either on the left pile or on the right pile.
-    rintro (a|a),
-
-    all_goals
-    { -- One of the piles is reduced to `k` stones, with `k < n` or `k < m`.
-      obtain ⟨ok, hk, hk'⟩ := nim.exists_ordinal_move_left_eq a,
-      obtain ⟨k, rfl⟩ := ordinal.lt_omega.1 (lt_trans hk (ordinal.nat_lt_omega _)),
-      replace hk := ordinal.nat_cast_lt.1 hk,
-
-      -- Thus, the problem is reduced to computing the Grundy value of `nim n + nim k` or
-      -- `nim k + nim m`, both of which can be dealt with using an inductive hypothesis.
-      simp only [hk', add_move_left_inl, add_move_left_inr, id],
+  rw grundy_value_eq_mex_left,
+  apply (ordinal.mex_le_of_ne.{u u} (λ i, _)).antisymm (ordinal.le_mex_of_forall (λ ou hu, _)),
+  -- The Grundy value `nat.lxor n m` can't be reached by left moves.
+  { apply left_moves_add_cases i;
+    { -- A left move leaves us with a Grundy value of `nat.lxor k m` for `k < n`, or `nat.lxor n k`
+      -- for `k < m`.
+      refine λ a, left_moves_nim_rec_on a (λ ok hk, _),
+      obtain ⟨k, rfl⟩ := ordinal.lt_omega.1 (hk.trans (ordinal.nat_lt_omega _)),
+      simp only [add_move_left_inl, add_move_left_inr, move_left_nim', equiv.symm_apply_apply],
+
+      -- The inequality follows from injectivity.
+      rw nat_cast_lt at hk,
       rw hn _ hk <|> rw hm _ hk,
-
-      -- But of course xor is injective, so if we change one of the arguments, we will not get the
-      -- same value again.
-      intro h,
+      refine λ h, hk.ne _,
       rw ordinal.nat_cast_inj at h,
-      try { rw [nat.lxor_comm n k, nat.lxor_comm n m] at h },
-      exact hk.ne (nat.lxor_left_inj h) } },
-
-  have h₁ : ∀ (u : ordinal), u < nat.lxor n m →
-    u ∈ set.range (λ i, grundy_value ((nim n + nim m).move_left i)),
-  { -- Take any natural number `u` less than `n xor m`.
-    intros ou hu,
-    obtain ⟨u, rfl⟩ := ordinal.lt_omega.1 (lt_trans hu (ordinal.nat_lt_omega _)),
+      rwa nat.lxor_left_inj at h <|> rwa nat.lxor_right_inj at h } },
+  -- Every other smaller Grundy value can be reached by left moves.
+  { -- If `u < nat.lxor m n`, then either `nat.lxor u n < m` or `nat.lxor u m < n`.
+    obtain ⟨u, rfl⟩ := ordinal.lt_omega.1 (hu.trans (ordinal.nat_lt_omega _)),
     replace hu := ordinal.nat_cast_lt.1 hu,
+    cases nat.lt_lxor_cases hu with h h,
+
+    -- In the first case, reducing the `m` pile to `nat.lxor u n` gives the desired Grundy value.
+    { refine ⟨to_left_moves_add (sum.inl $ to_left_moves_nim ⟨_, ordinal.nat_cast_lt.2 h⟩), _⟩,
+      simp [nat.lxor_cancel_right, hn _ h] },
 
-    -- Our goal is to produce a move that gives the Grundy value `u`.
-    rw set.mem_range,
-
-    -- By a lemma about xor, either `u xor m < n` or `u xor n < m`.
-    have : nat.lxor u (nat.lxor n m) ≠ 0,
-    { intro h, rw nat.lxor_eq_zero at h, linarith },
-    rcases nat.lxor_trichotomy this with h|h|h,
-    { linarith },
-
-    -- Therefore, we can play the corresponding move, and by the inductive hypothesis the new state
-    -- is `(u xor m) xor m = u` or `n xor (u xor n) = u` as required.
-    { obtain ⟨i, hi⟩ := nim.exists_move_left_eq (ordinal.nat_cast_lt.2 h),
-      refine ⟨(left_moves_add _ _).symm (sum.inl i), _⟩,
-      simp only [hi, add_move_left_inl],
-      rw [hn _ h, nat.lxor_assoc, nat.lxor_self, nat.lxor_zero] },
-    { obtain ⟨i, hi⟩ := nim.exists_move_left_eq (ordinal.nat_cast_lt.2 h),
-      refine ⟨(left_moves_add _ _).symm (sum.inr i), _⟩,
-      simp only [hi, add_move_left_inr],
-      rw [hm _ h, nat.lxor_comm, nat.lxor_assoc, nat.lxor_self, nat.lxor_zero] } },
-
-  -- We are done!
-  apply (ordinal.mex_le_of_ne.{u u} h₀).antisymm,
-  contrapose! h₁,
-  exact ⟨_, ⟨h₁, ordinal.mex_not_mem_range _⟩⟩,
+    -- In the second case, reducing the `n` pile to `nat.lxor u m` gives the desired Grundy value.
+    { refine ⟨to_left_moves_add (sum.inr $ to_left_moves_nim ⟨_, ordinal.nat_cast_lt.2 h⟩), _⟩,
+      have : n.lxor (u.lxor n) = u, rw [nat.lxor_comm u, nat.lxor_cancel_left],
+      simpa [hm _ h] using this } }
 end
 
 lemma nim_add_nim_equiv {n m : ℕ} : nim n + nim m ≈ nim (nat.lxor n m) :=
@@ -350,8 +345,8 @@ by rw [←grundy_value_eq_iff_equiv_nim, grundy_value_nim_add_nim]
 lemma grundy_value_add (G H : pgame) [G.impartial] [H.impartial] {n m : ℕ} (hG : grundy_value G = n)
   (hH : grundy_value H = m) : grundy_value (G + H) = nat.lxor n m :=
 begin
-  rw [←nim.grundy_value (nat.lxor n m), grundy_value_eq_iff_equiv],
-  refine equiv_trans _ nim_add_nim_equiv,
+  rw [←nim_grundy_value (nat.lxor n m), grundy_value_eq_iff_equiv],
+  refine equiv.trans _ nim_add_nim_equiv,
   convert add_congr (equiv_nim_grundy_value G) (equiv_nim_grundy_value H);
   simp only [hG, hH]
 end
diff --git a/src/set_theory/game/ordinal.lean b/src/set_theory/game/ordinal.lean
index 93409d6988639..1fb9ef66b97e6 100644
--- a/src/set_theory/game/ordinal.lean
+++ b/src/set_theory/game/ordinal.lean
@@ -4,33 +4,36 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Violeta Hernández Palacios
 -/
 
-import set_theory.game.pgame
-import set_theory.ordinal.basic
+import set_theory.game.basic
+import set_theory.ordinal.natural_ops
 
 /-!
 # Ordinals as games
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define the canonical map `ordinal → pgame`, where every ordinal is mapped to the game whose left
 set consists of all previous ordinals.
 
+The map to surreals is defined in `ordinal.to_surreal`.
+
 # Main declarations
 
 - `ordinal.to_pgame`: The canonical map between ordinals and pre-games.
 - `ordinal.to_pgame_embedding`: The order embedding version of the previous map.
-
-# Todo
-
-- Extend this map to `game` and `surreal`.
 -/
 
-local infix ` ≈ ` := pgame.equiv
-
 universe u
 
+open pgame
+
+open_locale natural_ops pgame
+
 namespace ordinal
 
 /-- Converts an ordinal into the corresponding pre-game. -/
-noncomputable! def to_pgame : Π o : ordinal.{u}, pgame.{u}
+noncomputable! def to_pgame : ordinal.{u} → pgame.{u}
 | o := ⟨o.out.α, pempty, λ x, let hwf := ordinal.typein_lt_self x in
         (typein (<) x).to_pgame, pempty.elim⟩
 using_well_founded { dec_tac := tactic.assumption }
@@ -40,21 +43,21 @@ theorem to_pgame_def (o : ordinal) :
 by rw to_pgame
 
 @[simp] theorem to_pgame_left_moves (o : ordinal) : o.to_pgame.left_moves = o.out.α :=
-by rw [to_pgame, pgame.left_moves]
+by rw [to_pgame, left_moves]
 
 @[simp] theorem to_pgame_right_moves (o : ordinal) : o.to_pgame.right_moves = pempty :=
-by rw [to_pgame, pgame.right_moves]
+by rw [to_pgame, right_moves]
 
-instance : is_empty (to_pgame 0).left_moves :=
+instance is_empty_zero_to_pgame_left_moves : is_empty (to_pgame 0).left_moves :=
 by { rw to_pgame_left_moves, apply_instance }
 
-instance (o : ordinal) : is_empty o.to_pgame.right_moves :=
+instance is_empty_to_pgame_right_moves (o : ordinal) : is_empty o.to_pgame.right_moves :=
 by { rw to_pgame_right_moves, apply_instance }
 
 /-- Converts an ordinal less than `o` into a move for the `pgame` corresponding to `o`, and vice
 versa. -/
-noncomputable def to_left_moves_to_pgame {o : ordinal} : {o' // o' < o} ≃ o.to_pgame.left_moves :=
-(out_equiv_lt o).trans (equiv.cast (to_pgame_left_moves o).symm)
+noncomputable def to_left_moves_to_pgame {o : ordinal} : set.Iio o ≃ o.to_pgame.left_moves :=
+(enum_iso_out o).to_equiv.trans (equiv.cast (to_pgame_left_moves o).symm)
 
 @[simp] theorem to_left_moves_to_pgame_symm_lt {o : ordinal} (i : o.to_pgame.left_moves) :
   ↑(to_left_moves_to_pgame.symm i) < o :=
@@ -72,30 +75,62 @@ theorem to_pgame_move_left {o : ordinal} (i) :
   o.to_pgame.move_left (to_left_moves_to_pgame i) = i.val.to_pgame :=
 by simp
 
-theorem to_pgame_lt {a b : ordinal} (h : a < b) : a.to_pgame < b.to_pgame :=
-by { convert pgame.move_left_lt (to_left_moves_to_pgame ⟨a, h⟩), rw to_pgame_move_left }
+/-- `0.to_pgame` has the same moves as `0`. -/
+noncomputable def zero_to_pgame_relabelling : to_pgame 0 ≡r 0 :=
+relabelling.is_empty _
+
+noncomputable instance unique_one_to_pgame_left_moves : unique (to_pgame 1).left_moves :=
+(equiv.cast $ to_pgame_left_moves 1).unique
+
+@[simp] theorem one_to_pgame_left_moves_default_eq :
+  (default : (to_pgame 1).left_moves) = @to_left_moves_to_pgame 1 ⟨0, zero_lt_one⟩ :=
+rfl
+
+@[simp] theorem to_left_moves_one_to_pgame_symm (i) :
+  (@to_left_moves_to_pgame 1).symm i = ⟨0, zero_lt_one⟩ :=
+by simp
+
+theorem one_to_pgame_move_left (x) : (to_pgame 1).move_left x = to_pgame 0 :=
+by simp
+
+/-- `1.to_pgame` has the same moves as `1`. -/
+noncomputable def one_to_pgame_relabelling : to_pgame 1 ≡r 1 :=
+⟨equiv.equiv_of_unique _ _, equiv.equiv_of_is_empty _ _,
+  λ i, by simpa using zero_to_pgame_relabelling, is_empty_elim⟩
+
+theorem to_pgame_lf {a b : ordinal} (h : a < b) : a.to_pgame ⧏ b.to_pgame :=
+by { convert move_left_lf (to_left_moves_to_pgame ⟨a, h⟩), rw to_pgame_move_left }
 
 theorem to_pgame_le {a b : ordinal} (h : a ≤ b) : a.to_pgame ≤ b.to_pgame :=
-pgame.le_def.2 ⟨λ i, or.inl ⟨to_left_moves_to_pgame
-  ⟨_, (to_left_moves_to_pgame_symm_lt i).trans_le h⟩, by simp⟩, is_empty_elim⟩
+begin
+  refine le_iff_forall_lf.2 ⟨λ i, _, is_empty_elim⟩,
+  rw to_pgame_move_left',
+  exact to_pgame_lf ((to_left_moves_to_pgame_symm_lt i).trans_le h)
+end
 
-@[simp] theorem to_pgame_lt_iff {a b : ordinal} : a.to_pgame < b.to_pgame ↔ a < b :=
-⟨by { contrapose, rw [not_lt, pgame.not_lt], exact to_pgame_le }, to_pgame_lt⟩
+theorem to_pgame_lt {a b : ordinal} (h : a < b) : a.to_pgame < b.to_pgame :=
+⟨to_pgame_le h.le, to_pgame_lf h⟩
+
+theorem to_pgame_nonneg (a : ordinal) : 0 ≤ a.to_pgame :=
+zero_to_pgame_relabelling.ge.trans $ to_pgame_le $ ordinal.zero_le a
+
+@[simp] theorem to_pgame_lf_iff {a b : ordinal} : a.to_pgame ⧏ b.to_pgame ↔ a < b :=
+⟨by { contrapose, rw [not_lt, not_lf], exact to_pgame_le }, to_pgame_lf⟩
 
 @[simp] theorem to_pgame_le_iff {a b : ordinal} : a.to_pgame ≤ b.to_pgame ↔ a ≤ b :=
-⟨by { contrapose, rw [not_le, pgame.not_le], exact to_pgame_lt }, to_pgame_le⟩
+⟨by { contrapose, rw [not_le, pgame.not_le], exact to_pgame_lf }, to_pgame_le⟩
+
+@[simp] theorem to_pgame_lt_iff {a b : ordinal} : a.to_pgame < b.to_pgame ↔ a < b :=
+⟨by { contrapose, rw not_lt, exact λ h, not_lt_of_le (to_pgame_le h) }, to_pgame_lt⟩
 
 @[simp] theorem to_pgame_equiv_iff {a b : ordinal} : a.to_pgame ≈ b.to_pgame ↔ a = b :=
 by rw [pgame.equiv, le_antisymm_iff, to_pgame_le_iff, to_pgame_le_iff]
 
 theorem to_pgame_injective : function.injective ordinal.to_pgame :=
-λ a b h, begin
-  by_contra hne,
-  cases lt_or_gt_of_ne hne with hlt hlt;
-  { have := to_pgame_lt hlt,
-    rw h at this,
-    exact pgame.lt_irrefl _ this }
-end
+λ a b h, to_pgame_equiv_iff.1 $ equiv_of_eq h
+
+@[simp] theorem to_pgame_eq_iff {a b : ordinal} : a.to_pgame = b.to_pgame ↔ a = b :=
+to_pgame_injective.eq_iff
 
 /-- The order embedding version of `to_pgame`. -/
 @[simps] noncomputable def to_pgame_embedding : ordinal.{u} ↪o pgame.{u} :=
@@ -103,4 +138,30 @@ end
   inj' := to_pgame_injective,
   map_rel_iff' := @to_pgame_le_iff }
 
+/-- The sum of ordinals as games corresponds to natural addition of ordinals. -/
+theorem to_pgame_add : ∀ a b : ordinal.{u}, a.to_pgame + b.to_pgame ≈ (a ♯ b).to_pgame
+| a b := begin
+  refine ⟨le_of_forall_lf (λ i, _) is_empty_elim, le_of_forall_lf (λ i, _) is_empty_elim⟩,
+  { apply left_moves_add_cases i;
+    intro i;
+    let wf := to_left_moves_to_pgame_symm_lt i;
+    try { rw add_move_left_inl }; try { rw add_move_left_inr };
+    rw [to_pgame_move_left', lf_congr_left (to_pgame_add _ _), to_pgame_lf_iff],
+    { exact nadd_lt_nadd_right wf _ },
+    { exact nadd_lt_nadd_left wf _ } },
+  { rw to_pgame_move_left',
+    rcases lt_nadd_iff.1 (to_left_moves_to_pgame_symm_lt i) with ⟨c, hc, hc'⟩ | ⟨c, hc, hc'⟩;
+    rw [←to_pgame_le_iff, ←le_congr_right (to_pgame_add _ _)] at hc';
+    apply lf_of_le_of_lf hc',
+    { apply add_lf_add_right,
+      rwa to_pgame_lf_iff },
+    { apply add_lf_add_left,
+      rwa to_pgame_lf_iff } }
+end
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+@[simp] theorem to_pgame_add_mk (a b : ordinal) :
+  ⟦a.to_pgame⟧ + ⟦b.to_pgame⟧ = ⟦(a ♯ b).to_pgame⟧ :=
+quot.sound (to_pgame_add a b)
+
 end ordinal
diff --git a/src/set_theory/game/pgame.lean b/src/set_theory/game/pgame.lean
index 00924a6c460fb..b6a9580b9cbb2 100644
--- a/src/set_theory/game/pgame.lean
+++ b/src/set_theory/game/pgame.lean
@@ -6,10 +6,15 @@ Authors: Reid Barton, Mario Carneiro, Isabel Longbottom, Scott Morrison
 import data.fin.basic
 import data.list.basic
 import logic.relation
+import logic.small.basic
+import order.game_add
 
 /-!
 # Combinatorial (pre-)games.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The basic theory of combinatorial games, following Conway's book `On Numbers and Games`. We
 construct "pregames", define an ordering and arithmetic operations on them, then show that the
 operations descend to "games", defined via the equivalence relation `p ≈ q ↔ p ≤ q ∧ q ≤ p`.
@@ -39,35 +44,22 @@ obligations in inductive proofs relying on this relation.
 
 ## Order properties
 
-Pregames have both a `≤` and a `<` relation, which are related in quite a subtle way. In particular,
-it is worth noting that in Lean's (perhaps unfortunate?) definition of a `preorder`, we have
-`lt_iff_le_not_le : ∀ a b : α, a < b ↔ (a ≤ b ∧ ¬ b ≤ a)`, but this is _not_ satisfied by the usual
-`≤` and `<` relations on pregames. (It is satisfied once we restrict to the surreal numbers.) In
-particular, `<` is not transitive; there is an example below showing `0 < star ∧ star < 0`.
+Pregames have both a `≤` and a `<` relation, satisfying the usual properties of a `preorder`. The
+relation `0 < x` means that `x` can always be won by Left, while `0 ≤ x` means that `x` can be won
+by Left as the second player.
 
-We do have
-```
-theorem not_le {x y : pgame} : ¬ x ≤ y ↔ y < x := ...
-theorem not_lt {x y : pgame} : ¬ x < y ↔ y ≤ x := ...
-```
+It turns out to be quite convenient to define various relations on top of these. We define the "less
+or fuzzy" relation `x ⧏ y` as `¬ y ≤ x`, the equivalence relation `x ≈ y` as `x ≤ y ∧ y ≤ x`, and
+the fuzzy relation `x ‖ y` as `x ⧏ y ∧ y ⧏ x`. If `0 ⧏ x`, then `x` can be won by Left as the
+first player. If `x ≈ 0`, then `x` can be won by the second player. If `x ‖ 0`, then `x` can be won
+by the first player.
 
-The statement `0 ≤ x` means that Left has a good response to any move by Right; in particular, the
-theorem `zero_le` below states
-```
-0 ≤ x ↔ ∀ j : x.right_moves, ∃ i : (x.move_right j).left_moves, 0 ≤ (x.move_right j).move_left i
-```
-On the other hand the statement `0 < x` means that Left has a good move right now; in particular the
-theorem `zero_lt` below states
-```
-0 < x ↔ ∃ i : left_moves x, ∀ j : right_moves (x.move_left i), 0 < (x.move_left i).move_right j
-```
+Statements like `zero_le_lf`, `zero_lf_le`, etc. unfold these definitions. The theorems `le_def` and
+`lf_def` give a recursive characterisation of each relation in terms of themselves two moves later.
+The theorems `zero_le`, `zero_lf`, etc. also take into account that `0` has no moves.
 
-The theorems `le_def`, `lt_def`, give a recursive characterisation of each relation, in terms of
-themselves two moves later. The theorems `le_def_lt` and `lt_def_lt` give recursive
-characterisations of each relation in terms of the other relation one move later.
-
-We define an equivalence relation `equiv p q ↔ p ≤ q ∧ q ≤ p`. Later, games will be defined as the
-quotient by this relation.
+Later, games will be defined as the quotient by the `≈` relation; that is to say, the
+`antisymmetrization` of `pgame`.
 
 ## Algebraic structures
 
@@ -87,6 +79,7 @@ equivalence relations at the level of pregames, we introduce the notion of a `re
 game, and show, for example, that there is a relabelling between `x + (y + z)` and `(x + y) + z`.
 
 ## Future work
+
 * The theory of dominated and reversible positions, and unique normal form for short games.
 * Analysis of basic domineering positions.
 * Hex.
@@ -108,6 +101,8 @@ open function relation
 
 universes u
 
+/-! ### Pre-game moves -/
+
 /-- The type of pre-games, before we have quotiented
   by equivalence (`pgame.setoid`). In ZFC, a combinatorial game is constructed from
   two sets of combinatorial games that have been constructed at an earlier
@@ -212,8 +207,8 @@ trans_gen is_option
 
 instance : is_trans _ subsequent := trans_gen.is_trans
 
-@[trans] theorem subsequent.trans : ∀ {x y z}, subsequent x y → subsequent y z → subsequent x z :=
-@trans_gen.trans _ _
+@[trans] theorem subsequent.trans {x y z} : subsequent x y → subsequent y z → subsequent x z :=
+trans_gen.trans
 
 theorem wf_subsequent : well_founded subsequent := wf_is_option.trans_gen
 
@@ -240,6 +235,8 @@ meta def pgame_wf_tac :=
    subsequent.mk_left, subsequent.mk_right, subsequent.trans]
   { max_depth := 6 }]
 
+/-! ### Basic pre-games -/
+
 /-- The pre-game `zero` is defined by `0 = { | }`. -/
 instance : has_zero pgame := ⟨⟨pempty, pempty, pempty.elim, pempty.elim⟩⟩
 
@@ -261,437 +258,586 @@ instance : has_one pgame := ⟨⟨punit, pempty, λ _, 0, pempty.elim⟩⟩
 instance unique_one_left_moves : unique (left_moves 1) := punit.unique
 instance is_empty_one_right_moves : is_empty (right_moves 1) := pempty.is_empty
 
-/-- Define simultaneously by mutual induction the `<=` and `<`
-  relation on pre-games. The ZFC definition says that `x = {xL | xR}`
-  is less or equal to `y = {yL | yR}` if `∀ x₁ ∈ xL, x₁ < y`
-  and `∀ y₂ ∈ yR, x < y₂`, where `x < y` is the same as `¬ y <= x`.
-  This is a tricky induction because it only decreases one side at
-  a time, and it also swaps the arguments in the definition of `<`.
-  The solution is to define `x < y` and `x <= y` simultaneously. -/
-def le_lt : Π (x y : pgame), Prop × Prop
-| (mk xl xr xL xR) (mk yl yr yL yR) :=
-  -- the orderings of the clauses here are carefully chosen so that
-  --   and.left/or.inl refer to moves by Left, and
-  --   and.right/or.inr refer to moves by Right.
-((∀ i : xl, (le_lt (xL i) ⟨yl, yr, yL, yR⟩).2) ∧ (∀ j : yr, (le_lt ⟨xl, xr, xL, xR⟩ (yR j)).2),
-  (∃ i : yl, (le_lt ⟨xl, xr, xL, xR⟩ (yL i)).1) ∨ (∃ j : xr, (le_lt (xR j) ⟨yl, yr, yL, yR⟩).1))
-using_well_founded { dec_tac := pgame_wf_tac }
+/-! ### Pre-game order relations -/
+
+/-- The less or equal relation on pre-games.
+
+If `0 ≤ x`, then Left can win `x` as the second player. -/
+instance : has_le pgame :=
+⟨sym2.game_add.fix wf_is_option $ λ x y le,
+  (∀ i, ¬ le y (x.move_left i) (sym2.game_add.snd_fst $ is_option.move_left i)) ∧
+  (∀ j, ¬ le (y.move_right j) x (sym2.game_add.fst_snd $ is_option.move_right j))⟩
+
+/-- The less or fuzzy relation on pre-games.
+
+If `0 ⧏ x`, then Left can win `x` as the first player. -/
+def lf (x y : pgame) : Prop := ¬ y ≤ x
 
-instance : has_le pgame := ⟨λ x y, (le_lt x y).1⟩
-instance : has_lt pgame := ⟨λ x y, (le_lt x y).2⟩
+localized "infix (name := pgame.lf) ` ⧏ `:50 := pgame.lf" in pgame
+
+@[simp] protected theorem not_le {x y : pgame} : ¬ x ≤ y ↔ y ⧏ x := iff.rfl
+@[simp] theorem not_lf {x y : pgame} : ¬ x ⧏ y ↔ y ≤ x := not_not
+theorem _root_.has_le.le.not_gf {x y : pgame} : x ≤ y → ¬ y ⧏ x := not_lf.2
+theorem lf.not_ge {x y : pgame} : x ⧏ y → ¬ y ≤ x := id
+
+/-- Definition of `x ≤ y` on pre-games, in terms of `⧏`.
+
+The ordering here is chosen so that `and.left` refer to moves by Left, and `and.right` refer to
+moves by Right. -/
+
+theorem le_iff_forall_lf {x y : pgame} :
+  x ≤ y ↔ (∀ i, x.move_left i ⧏ y) ∧ ∀ j, x ⧏ y.move_right j :=
+by { unfold has_le.le, rw sym2.game_add.fix_eq, refl }
 
 /-- Definition of `x ≤ y` on pre-games built using the constructor. -/
 @[simp] theorem mk_le_mk {xl xr xL xR yl yr yL yR} :
-  (⟨xl, xr, xL, xR⟩ : pgame) ≤ ⟨yl, yr, yL, yR⟩ ↔
-  (∀ i, xL i < ⟨yl, yr, yL, yR⟩) ∧
-  (∀ j, (⟨xl, xr, xL, xR⟩ : pgame) < yR j) :=
-show (le_lt _ _).1 ↔ _, by { rw le_lt, refl }
-
-/-- Definition of `x ≤ y` on pre-games, in terms of `<` -/
-theorem le_def_lt {x y : pgame} : x ≤ y ↔
-  (∀ i : x.left_moves, x.move_left i < y) ∧
-  (∀ j : y.right_moves, x < y.move_right j) :=
-by { cases x, cases y, rw mk_le_mk, refl }
-
-/-- Definition of `x < y` on pre-games built using the constructor. -/
-@[simp] theorem mk_lt_mk {xl xr xL xR yl yr yL yR} :
-  (⟨xl, xr, xL, xR⟩ : pgame) < ⟨yl, yr, yL, yR⟩ ↔
-  (∃ i, (⟨xl, xr, xL, xR⟩ : pgame) ≤ yL i) ∨
-  (∃ j, xR j ≤ ⟨yl, yr, yL, yR⟩) :=
-show (le_lt _ _).2 ↔ _, by { rw le_lt, refl }
-
-/-- Definition of `x < y` on pre-games, in terms of `≤` -/
-theorem lt_def_le {x y : pgame} : x < y ↔
-  (∃ i : y.left_moves, x ≤ y.move_left i) ∨
-  (∃ j : x.right_moves, x.move_right j ≤ y) :=
-by { cases x, cases y, rw mk_lt_mk, refl }
+  mk xl xr xL xR ≤ mk yl yr yL yR ↔
+  (∀ i, xL i ⧏ mk yl yr yL yR) ∧ ∀ j, mk xl xr xL xR ⧏ yR j :=
+le_iff_forall_lf
+
+theorem le_of_forall_lf {x y : pgame} (h₁ : ∀ i, x.move_left i ⧏ y) (h₂ : ∀ j, x ⧏ y.move_right j) :
+  x ≤ y :=
+le_iff_forall_lf.2 ⟨h₁, h₂⟩
+
+/-- Definition of `x ⧏ y` on pre-games, in terms of `≤`.
+
+The ordering here is chosen so that `or.inl` refer to moves by Left, and `or.inr` refer to
+moves by Right. -/
+theorem lf_iff_exists_le {x y : pgame} :
+  x ⧏ y ↔ (∃ i, x ≤ y.move_left i) ∨ ∃ j, x.move_right j ≤ y :=
+by { rw [lf, le_iff_forall_lf, not_and_distrib], simp }
+
+/-- Definition of `x ⧏ y` on pre-games built using the constructor. -/
+@[simp] theorem mk_lf_mk {xl xr xL xR yl yr yL yR} :
+  mk xl xr xL xR ⧏ mk yl yr yL yR ↔
+  (∃ i, mk xl xr xL xR ≤ yL i) ∨ ∃ j, xR j ≤ mk yl yr yL yR :=
+lf_iff_exists_le
+
+theorem le_or_gf (x y : pgame) : x ≤ y ∨ y ⧏ x :=
+by { rw ←pgame.not_le, apply em }
+
+theorem move_left_lf_of_le {x y : pgame} (h : x ≤ y) (i) : x.move_left i ⧏ y :=
+(le_iff_forall_lf.1 h).1 i
+
+alias move_left_lf_of_le ← _root_.has_le.le.move_left_lf
+
+theorem lf_move_right_of_le {x y : pgame} (h : x ≤ y) (j) : x ⧏ y.move_right j :=
+(le_iff_forall_lf.1 h).2 j
+
+alias lf_move_right_of_le ← _root_.has_le.le.lf_move_right
+
+theorem lf_of_move_right_le {x y : pgame} {j} (h : x.move_right j ≤ y) : x ⧏ y :=
+lf_iff_exists_le.2 $ or.inr ⟨j, h⟩
+
+theorem lf_of_le_move_left {x y : pgame} {i} (h : x ≤ y.move_left i) : x ⧏ y :=
+lf_iff_exists_le.2 $ or.inl ⟨i, h⟩
+
+theorem lf_of_le_mk {xl xr xL xR y} : mk xl xr xL xR ≤ y → ∀ i, xL i ⧏ y :=
+move_left_lf_of_le
+
+theorem lf_of_mk_le {x yl yr yL yR} : x ≤ mk yl yr yL yR → ∀ j, x ⧏ yR j :=
+lf_move_right_of_le
+
+theorem mk_lf_of_le {xl xr y j} (xL) {xR : xr → pgame} : xR j ≤ y → mk xl xr xL xR ⧏ y :=
+@lf_of_move_right_le (mk _ _ _ _) y j
+
+theorem lf_mk_of_le {x yl yr} {yL : yl → pgame} (yR) {i} : x ≤ yL i → x ⧏ mk yl yr yL yR :=
+@lf_of_le_move_left x (mk _ _ _ _) i
+
+/- We prove that `x ≤ y → y ≤ z ← x ≤ z` inductively, by also simultaneously proving its cyclic
+reorderings. This auxiliary lemma is used during said induction. -/
+private theorem le_trans_aux {x y z : pgame}
+  (h₁ : ∀ {i}, y ≤ z → z ≤ x.move_left i → y ≤ x.move_left i)
+  (h₂ : ∀ {j}, z.move_right j ≤ x → x ≤ y → z.move_right j ≤ y)
+  (hxy : x ≤ y) (hyz : y ≤ z) : x ≤ z :=
+le_of_forall_lf
+  (λ i, pgame.not_le.1 $ λ h, (h₁ hyz h).not_gf $ hxy.move_left_lf i)
+  (λ j, pgame.not_le.1 $ λ h, (h₂ h hxy).not_gf $ hyz.lf_move_right j)
+
+instance : preorder pgame :=
+{ le_refl := λ x, begin
+    induction x with _ _ _ _ IHl IHr,
+    exact le_of_forall_lf (λ i, lf_of_le_move_left (IHl i)) (λ i, lf_of_move_right_le (IHr i))
+  end,
+  le_trans := begin
+    suffices : ∀ {x y z : pgame},
+      (x ≤ y → y ≤ z → x ≤ z) ∧ (y ≤ z → z ≤ x → y ≤ x) ∧ (z ≤ x → x ≤ y → z ≤ y),
+      from λ x y z, this.1,
+    intros x y z,
+    induction x with xl xr xL xR IHxl IHxr generalizing y z,
+    induction y with yl yr yL yR IHyl IHyr generalizing z,
+    induction z with zl zr zL zR IHzl IHzr,
+    exact ⟨le_trans_aux (λ i, (IHxl i).2.1) (λ j, (IHzr j).2.2),
+      le_trans_aux (λ i, (IHyl i).2.2) (λ j, (IHxr j).1),
+      le_trans_aux (λ i, (IHzl i).1) (λ j, (IHyr j).2.1)⟩
+  end,
+  lt := λ x y, x ≤ y ∧ x ⧏ y,
+  ..pgame.has_le, }
+
+theorem lt_iff_le_and_lf {x y : pgame} : x < y ↔ x ≤ y ∧ x ⧏ y := iff.rfl
+theorem lt_of_le_of_lf {x y : pgame} (h₁ : x ≤ y) (h₂ : x ⧏ y) : x < y := ⟨h₁, h₂⟩
+
+theorem lf_of_lt {x y : pgame} (h : x < y) : x ⧏ y := h.2
+alias lf_of_lt ← _root_.has_lt.lt.lf
+
+theorem lf_irrefl (x : pgame) : ¬ x ⧏ x := le_rfl.not_gf
+instance : is_irrefl _ (⧏) := ⟨lf_irrefl⟩
+
+@[trans] theorem lf_of_le_of_lf {x y z : pgame} (h₁ : x ≤ y) (h₂ : y ⧏ z) : x ⧏ z :=
+by { rw ←pgame.not_le at h₂ ⊢, exact λ h₃, h₂ (h₃.trans h₁) }
+@[trans] theorem lf_of_lf_of_le {x y z : pgame} (h₁ : x ⧏ y) (h₂ : y ≤ z) : x ⧏ z :=
+by { rw ←pgame.not_le at h₁ ⊢, exact λ h₃, h₁ (h₂.trans h₃) }
+
+alias lf_of_le_of_lf ← _root_.has_le.le.trans_lf
+alias lf_of_lf_of_le ← lf.trans_le
+
+@[trans] theorem lf_of_lt_of_lf {x y z : pgame} (h₁ : x < y) (h₂ : y ⧏ z) : x ⧏ z :=
+h₁.le.trans_lf h₂
+
+@[trans] theorem lf_of_lf_of_lt {x y z : pgame} (h₁ : x ⧏ y) (h₂ : y < z) : x ⧏ z :=
+h₁.trans_le h₂.le
+
+alias lf_of_lt_of_lf ← _root_.has_lt.lt.trans_lf
+alias lf_of_lf_of_lt ← lf.trans_lt
+
+theorem move_left_lf {x : pgame} : ∀ i, x.move_left i ⧏ x :=
+le_rfl.move_left_lf
+
+theorem lf_move_right {x : pgame} : ∀ j, x ⧏ x.move_right j :=
+le_rfl.lf_move_right
+
+theorem lf_mk {xl xr} (xL : xl → pgame) (xR : xr → pgame) (i) : xL i ⧏ mk xl xr xL xR :=
+@move_left_lf (mk _ _ _ _) i
+
+theorem mk_lf {xl xr} (xL : xl → pgame) (xR : xr → pgame) (j) : mk xl xr xL xR ⧏ xR j :=
+@lf_move_right (mk _ _ _ _) j
+
+/-- This special case of `pgame.le_of_forall_lf` is useful when dealing with surreals, where `<` is
+preferred over `⧏`. -/
+theorem le_of_forall_lt {x y : pgame} (h₁ : ∀ i, x.move_left i < y) (h₂ : ∀ j, x < y.move_right j) :
+  x ≤ y :=
+le_of_forall_lf (λ i, (h₁ i).lf) (λ i, (h₂ i).lf)
 
 /-- The definition of `x ≤ y` on pre-games, in terms of `≤` two moves later. -/
 theorem le_def {x y : pgame} : x ≤ y ↔
-  (∀ i : x.left_moves,
-   (∃ i' : y.left_moves, x.move_left i ≤ y.move_left i') ∨
-   (∃ j : (x.move_left i).right_moves, (x.move_left i).move_right j ≤ y)) ∧
-  (∀ j : y.right_moves,
-   (∃ i : (y.move_right j).left_moves, x ≤ (y.move_right j).move_left i) ∨
-   (∃ j' : x.right_moves, x.move_right j' ≤ y.move_right j)) :=
-begin
-  rw [le_def_lt],
-  conv { to_lhs, simp only [lt_def_le] },
-end
+  (∀ i, (∃ i', x.move_left i ≤ y.move_left i')  ∨ ∃ j, (x.move_left i).move_right j ≤ y) ∧
+   ∀ j, (∃ i, x ≤ (y.move_right j).move_left i) ∨ ∃ j', x.move_right j' ≤ y.move_right j :=
+by { rw le_iff_forall_lf, conv { to_lhs, simp only [lf_iff_exists_le] } }
 
-/-- The definition of `x < y` on pre-games, in terms of `<` two moves later. -/
-theorem lt_def {x y : pgame} : x < y ↔
-  (∃ i : y.left_moves,
-    (∀ i' : x.left_moves, x.move_left i' < y.move_left i) ∧
-    (∀ j : (y.move_left i).right_moves, x < (y.move_left i).move_right j)) ∨
-  (∃ j : x.right_moves,
-    (∀ i : (x.move_right j).left_moves, (x.move_right j).move_left i < y) ∧
-    (∀ j' : y.right_moves, x.move_right j < y.move_right j')) :=
-begin
-  rw [lt_def_le],
-  conv { to_lhs, simp only [le_def_lt] },
-end
+/-- The definition of `x ⧏ y` on pre-games, in terms of `⧏` two moves later. -/
+theorem lf_def {x y : pgame} : x ⧏ y ↔
+  (∃ i, (∀ i', x.move_left i' ⧏ y.move_left i)  ∧ ∀ j, x ⧏ (y.move_left i).move_right j) ∨
+   ∃ j, (∀ i, (x.move_right j).move_left i ⧏ y) ∧ ∀ j', x.move_right j ⧏ y.move_right j' :=
+by { rw lf_iff_exists_le, conv { to_lhs, simp only [le_iff_forall_lf] } }
 
-/-- The definition of `x ≤ 0` on pre-games, in terms of `≤ 0` two moves later. -/
-theorem le_zero {x : pgame} : x ≤ 0 ↔
-  ∀ i : x.left_moves, ∃ j : (x.move_left i).right_moves, (x.move_left i).move_right j ≤ 0 :=
-by { rw le_def, dsimp, simp [forall_pempty, exists_pempty] }
+/-- The definition of `0 ≤ x` on pre-games, in terms of `0 ⧏`. -/
+theorem zero_le_lf {x : pgame} : 0 ≤ x ↔ ∀ j, 0 ⧏ x.move_right j :=
+by { rw le_iff_forall_lf, simp }
+
+/-- The definition of `x ≤ 0` on pre-games, in terms of `⧏ 0`. -/
+theorem le_zero_lf {x : pgame} : x ≤ 0 ↔ ∀ i, x.move_left i ⧏ 0 :=
+by { rw le_iff_forall_lf, simp }
+
+/-- The definition of `0 ⧏ x` on pre-games, in terms of `0 ≤`. -/
+theorem zero_lf_le {x : pgame} : 0 ⧏ x ↔ ∃ i, 0 ≤ x.move_left i :=
+by { rw lf_iff_exists_le, simp }
+
+/-- The definition of `x ⧏ 0` on pre-games, in terms of `≤ 0`. -/
+theorem lf_zero_le {x : pgame} : x ⧏ 0 ↔ ∃ j, x.move_right j ≤ 0 :=
+by { rw lf_iff_exists_le, simp }
 
 /-- The definition of `0 ≤ x` on pre-games, in terms of `0 ≤` two moves later. -/
-theorem zero_le {x : pgame} : 0 ≤ x ↔
-  ∀ j : x.right_moves, ∃ i : (x.move_right j).left_moves, 0 ≤ (x.move_right j).move_left i :=
-by { rw le_def, dsimp, simp [forall_pempty, exists_pempty] }
+theorem zero_le {x : pgame} : 0 ≤ x ↔ ∀ j, ∃ i, 0 ≤ (x.move_right j).move_left i :=
+by { rw le_def, simp }
 
-/-- The definition of `x < 0` on pre-games, in terms of `< 0` two moves later. -/
-theorem lt_zero {x : pgame} : x < 0 ↔
-  ∃ j : x.right_moves, ∀ i : (x.move_right j).left_moves, (x.move_right j).move_left i < 0 :=
-by { rw lt_def, dsimp, simp [forall_pempty, exists_pempty] }
+/-- The definition of `x ≤ 0` on pre-games, in terms of `≤ 0` two moves later. -/
+theorem le_zero {x : pgame} : x ≤ 0 ↔ ∀ i, ∃ j, (x.move_left i).move_right j ≤ 0 :=
+by { rw le_def, simp }
 
-/-- The definition of `0 < x` on pre-games, in terms of `< x` two moves later. -/
-theorem zero_lt {x : pgame} : 0 < x ↔
-  ∃ i : x.left_moves, ∀ j : (x.move_left i).right_moves, 0 < (x.move_left i).move_right j :=
-by { rw lt_def, dsimp, simp [forall_pempty, exists_pempty] }
+/-- The definition of `0 ⧏ x` on pre-games, in terms of `0 ⧏` two moves later. -/
+theorem zero_lf {x : pgame} : 0 ⧏ x ↔ ∃ i, ∀ j, 0 ⧏ (x.move_left i).move_right j :=
+by { rw lf_def, simp }
 
-@[simp] theorem le_zero_of_is_empty_left_moves (x : pgame) [is_empty x.left_moves] : x ≤ 0 :=
-le_zero.2 is_empty_elim
+/-- The definition of `x ⧏ 0` on pre-games, in terms of `⧏ 0` two moves later. -/
+theorem lf_zero {x : pgame} : x ⧏ 0 ↔ ∃ j, ∀ i, (x.move_right j).move_left i ⧏ 0 :=
+by { rw lf_def, simp }
 
 @[simp] theorem zero_le_of_is_empty_right_moves (x : pgame) [is_empty x.right_moves] : 0 ≤ x :=
 zero_le.2 is_empty_elim
 
-/-- Given a right-player-wins game, provide a response to any move by left. -/
+@[simp] theorem le_zero_of_is_empty_left_moves (x : pgame) [is_empty x.left_moves] : x ≤ 0 :=
+le_zero.2 is_empty_elim
+
+/-- Given a game won by the right player when they play second, provide a response to any move by
+left. -/
 noncomputable def right_response {x : pgame} (h : x ≤ 0) (i : x.left_moves) :
   (x.move_left i).right_moves :=
 classical.some $ (le_zero.1 h) i
 
-/-- Show that the response for right provided by `right_response`
-    preserves the right-player-wins condition. -/
+/-- Show that the response for right provided by `right_response` preserves the right-player-wins
+condition. -/
 lemma right_response_spec {x : pgame} (h : x ≤ 0) (i : x.left_moves) :
   (x.move_left i).move_right (right_response h i) ≤ 0 :=
 classical.some_spec $ (le_zero.1 h) i
 
-/-- Given a left-player-wins game, provide a response to any move by right. -/
+/-- Given a game won by the left player when they play second, provide a response to any move by
+right. -/
 noncomputable def left_response {x : pgame} (h : 0 ≤ x) (j : x.right_moves) :
   (x.move_right j).left_moves :=
 classical.some $ (zero_le.1 h) j
 
-/-- Show that the response for left provided by `left_response`
-    preserves the left-player-wins condition. -/
+/-- Show that the response for left provided by `left_response` preserves the left-player-wins
+condition. -/
 lemma left_response_spec {x : pgame} (h : 0 ≤ x) (j : x.right_moves) :
   0 ≤ (x.move_right j).move_left (left_response h j) :=
 classical.some_spec $ (zero_le.1 h) j
 
-theorem lt_of_le_mk {xl xr xL xR y i} :
-  (⟨xl, xr, xL, xR⟩ : pgame) ≤ y → xL i < y :=
-by { cases y, rw mk_le_mk, tauto }
-
-theorem lt_of_mk_le {x : pgame} {yl yr yL yR i} :
-  x ≤ ⟨yl, yr, yL, yR⟩ → x < yR i :=
-by { cases x, rw mk_le_mk, tauto }
+/-- An explicit upper bound for a family of pre-games, whose left moves are the union of the left
+moves of all the pre-games in the family. -/
+def upper_bound {ι : Type u} (f : ι → pgame.{u}) : pgame :=
+⟨Σ i, (f i).left_moves, pempty, λ x, move_left _ x.2, pempty.elim⟩
 
-theorem mk_lt_of_le {xl xr xL xR y i} :
-  ((xR : xr → pgame) i ≤ y) → (⟨xl, xr, xL, xR⟩ : pgame) < y :=
-by { cases y, rw mk_lt_mk, tauto }
+instance upper_bound_right_moves_empty {ι : Type u} (f : ι → pgame.{u}) :
+  is_empty (upper_bound f).right_moves :=
+pempty.is_empty
 
-theorem lt_mk_of_le {x : pgame} {yl yr : Type*} {yL : yl → pgame} {yR i} :
-  (x ≤ yL i) → x < ⟨yl, yr, yL, yR⟩ :=
-by { cases x, rw mk_lt_mk, exact λ h, or.inl ⟨_, h⟩ }
+theorem le_upper_bound {ι : Type u} (f : ι → pgame.{u}) (i : ι) : f i ≤ upper_bound f :=
+begin
+  rw [upper_bound, le_iff_forall_lf],
+  dsimp,
+  simp only [and_true, is_empty.forall_iff],
+  exact λ j, @move_left_lf (upper_bound f) ⟨i, j⟩
+end
 
-theorem move_left_lt_of_le {x y : pgame} {i} :
-  x ≤ y → x.move_left i < y :=
-by { cases x, exact lt_of_le_mk }
+lemma upper_bound_mem_upper_bounds (s : set pgame.{u}) [small.{u} s] :
+  upper_bound (subtype.val ∘ (equiv_shrink s).symm) ∈ upper_bounds s :=
+λ i hi, by simpa using
+  le_upper_bound (subtype.val ∘ (equiv_shrink s).symm) (equiv_shrink s ⟨i, hi⟩)
 
-theorem lt_move_right_of_le {x y : pgame} {i} :
-  x ≤ y → x < y.move_right i :=
-by { cases y, exact lt_of_mk_le }
+/-- A small set `s` of pre-games is bounded above. -/
+lemma bdd_above_of_small (s : set pgame.{u}) [small.{u} s] : bdd_above s :=
+⟨_, upper_bound_mem_upper_bounds s⟩
 
-theorem lt_of_move_right_le {x y : pgame} {i} :
-  x.move_right i ≤ y → x < y :=
-by { cases x, rw move_right_mk, exact mk_lt_of_le }
+/-- An explicit lower bound for a family of pre-games, whose right moves are the union of the right
+moves of all the pre-games in the family. -/
+def lower_bound {ι : Type u} (f : ι → pgame.{u}) : pgame :=
+⟨pempty, Σ i, (f i).right_moves, pempty.elim, λ x, move_right _ x.2⟩
 
-theorem lt_of_le_move_left {x y : pgame} {i} :
-  x ≤ y.move_left i → x < y :=
-by { cases y, rw move_left_mk, exact lt_mk_of_le }
+instance lower_bound_left_moves_empty {ι : Type u} (f : ι → pgame.{u}) :
+  is_empty (lower_bound f).left_moves :=
+pempty.is_empty
 
-private theorem not_le_lt {x y : pgame} :
-  (¬ x ≤ y ↔ y < x) ∧ (¬ x < y ↔ y ≤ x) :=
+theorem lower_bound_le {ι : Type u} (f : ι → pgame.{u}) (i : ι) : lower_bound f ≤ f i :=
 begin
-  induction x with xl xr xL xR IHxl IHxr generalizing y,
-  induction y with yl yr yL yR IHyl IHyr,
-  classical,
-  simp only [mk_le_mk, mk_lt_mk,
-    not_and_distrib, not_or_distrib, not_forall, not_exists,
-    and_comm, or_comm, IHxl, IHxr, IHyl, IHyr, iff_self, and_self]
+  rw [lower_bound, le_iff_forall_lf],
+  dsimp,
+  simp only [is_empty.forall_iff, true_and],
+  exact λ j, @lf_move_right (lower_bound f) ⟨i, j⟩
 end
 
-@[simp] theorem not_le {x y : pgame} : ¬ x ≤ y ↔ y < x := not_le_lt.1
-@[simp] theorem not_lt {x y : pgame} : ¬ x < y ↔ y ≤ x := not_le_lt.2
-
-@[refl] protected theorem le_rfl : ∀ {x : pgame}, x ≤ x
-| ⟨l, r, L, R⟩ := by rw mk_le_mk; exact
-⟨λ i, lt_mk_of_le le_rfl, λ i, mk_lt_of_le le_rfl⟩
-
-protected theorem le_refl (x : pgame) : x ≤ x :=
-pgame.le_rfl
-
-protected theorem lt_irrefl (x : pgame) : ¬ x < x :=
-not_lt.2 pgame.le_rfl
-
-protected theorem ne_of_lt : ∀ {x y : pgame}, x < y → x ≠ y
-| x _ h rfl := pgame.lt_irrefl x h
-
-/-- In general, `xL i ≤ x` isn't true. It is true however for `numeric` games, see
-`numeric.move_left_le`. -/
-theorem lt_mk {xl xr : Type u} {xL : xl → pgame} {xR : xr → pgame} (i) : xL i < mk xl xr xL xR :=
-lt_mk_of_le pgame.le_rfl
-
-/-- In general, `x ≤ xR i` isn't true. It is true however for `numeric` games, see
-`numeric.move_right_le`. -/
-theorem mk_lt {xl xr : Type u} {xL : xl → pgame} {xR : xr → pgame} (i) : mk xl xr xL xR < xR i :=
-mk_lt_of_le pgame.le_rfl
-
-/-- In general, `x.move_left i ≤ x` isn't true. It is true however for `numeric` games, see
-`numeric.move_left_le`. -/
-theorem move_left_lt {x : pgame} (i) : x.move_left i < x :=
-move_left_lt_of_le pgame.le_rfl
-
-/-- In general, `x ≤ x.move_right i` isn't true. It is true however for `numeric` games, see
-`numeric.move_right_le`. -/
-theorem lt_move_right {x : pgame} (i) : x < x.move_right i :=
-lt_move_right_of_le pgame.le_rfl
-
-theorem le_trans_aux
-  {xl xr} {xL : xl → pgame} {xR : xr → pgame}
-  {yl yr} {yL : yl → pgame} {yR : yr → pgame}
-  {zl zr} {zL : zl → pgame} {zR : zr → pgame}
-  (h₁ : ∀ i, mk yl yr yL yR ≤ mk zl zr zL zR → mk zl zr zL zR ≤ xL i → mk yl yr yL yR ≤ xL i)
-  (h₂ : ∀ i, zR i ≤ mk xl xr xL xR → mk xl xr xL xR ≤ mk yl yr yL yR → zR i ≤ mk yl yr yL yR) :
-  mk xl xr xL xR ≤ mk yl yr yL yR →
-  mk yl yr yL yR ≤ mk zl zr zL zR →
-  mk xl xr xL xR ≤ mk zl zr zL zR :=
-by simp only [mk_le_mk] at *; exact
-λ ⟨xLy, xyR⟩ ⟨yLz, yzR⟩, ⟨
-  λ i, not_le.1 (λ h, not_lt.2 (h₁ _ ⟨yLz, yzR⟩ h) (xLy _)),
-  λ i, not_le.1 (λ h, not_lt.2 (h₂ _ h ⟨xLy, xyR⟩) (yzR _))⟩
-
-@[trans] theorem le_trans {x y z : pgame} : x ≤ y → y ≤ z → x ≤ z :=
-suffices ∀ {x y z : pgame},
-  (x ≤ y → y ≤ z → x ≤ z) ∧ (y ≤ z → z ≤ x → y ≤ x) ∧ (z ≤ x → x ≤ y → z ≤ y),
-from this.1, begin
-  clear x y z, intros,
-  induction x with xl xr xL xR IHxl IHxr generalizing y z,
-  induction y with yl yr yL yR IHyl IHyr generalizing z,
-  induction z with zl zr zL zR IHzl IHzr,
-  exact ⟨
-    le_trans_aux (λ i, (IHxl _).2.1) (λ i, (IHzr _).2.2),
-    le_trans_aux (λ i, (IHyl _).2.2) (λ i, (IHxr _).1),
-    le_trans_aux (λ i, (IHzl _).1) (λ i, (IHyr _).2.1)⟩,
-end
+lemma lower_bound_mem_lower_bounds (s : set pgame.{u}) [small.{u} s] :
+  lower_bound (subtype.val ∘ (equiv_shrink s).symm) ∈ lower_bounds s :=
+λ i hi, by simpa using
+  lower_bound_le (subtype.val ∘ (equiv_shrink s).symm) (equiv_shrink s ⟨i, hi⟩)
 
-@[trans] theorem lt_of_le_of_lt {x y z : pgame} (hxy : x ≤ y) (hyz : y < z) : x < z :=
-begin
-  rw ←not_le at ⊢ hyz,
-  exact mt (λ H, le_trans H hxy) hyz
-end
+/-- A small set `s` of pre-games is bounded below. -/
+lemma bdd_below_of_small (s : set pgame.{u}) [small.{u} s] : bdd_below s :=
+⟨_, lower_bound_mem_lower_bounds s⟩
 
-@[trans] theorem lt_of_lt_of_le {x y z : pgame} (hxy : x < y) (hyz : y ≤ z) : x < z :=
-begin
-  rw ←not_le at ⊢ hxy,
-  exact mt (λ H, le_trans hyz H) hxy
-end
+/-- The equivalence relation on pre-games. Two pre-games `x`, `y` are equivalent if `x ≤ y` and
+`y ≤ x`.
 
-/-- Define the equivalence relation on pre-games. Two pre-games
-  `x`, `y` are equivalent if `x ≤ y` and `y ≤ x`. -/
+If `x ≈ 0`, then the second player can always win `x`. -/
 def equiv (x y : pgame) : Prop := x ≤ y ∧ y ≤ x
 
-local infix ` ≈ ` := pgame.equiv
+localized "infix (name := pgame.equiv) ` ≈ ` := pgame.equiv" in pgame
+
+instance : is_equiv _ (≈) :=
+{ refl := λ x, ⟨le_rfl, le_rfl⟩,
+  trans := λ x y z ⟨xy, yx⟩ ⟨yz, zy⟩, ⟨xy.trans yz, zy.trans yx⟩,
+  symm := λ x y, and.symm }
+
+theorem equiv.le {x y : pgame} (h : x ≈ y) : x ≤ y := h.1
+theorem equiv.ge {x y : pgame} (h : x ≈ y) : y ≤ x := h.2
+
+@[refl, simp] theorem equiv_rfl {x} : x ≈ x := refl x
+theorem equiv_refl (x) : x ≈ x := refl x
+
+@[symm] protected theorem equiv.symm {x y} : x ≈ y → y ≈ x := symm
+@[trans] protected theorem equiv.trans {x y z} : x ≈ y → y ≈ z → x ≈ z := trans
+protected theorem equiv_comm {x y} : x ≈ y ↔ y ≈ x := comm
+
+theorem equiv_of_eq {x y} (h : x = y) : x ≈ y := by subst h
 
-@[refl, simp] theorem equiv_rfl {x} : x ≈ x := ⟨pgame.le_rfl, pgame.le_rfl⟩
-theorem equiv_refl (x) : x ≈ x := equiv_rfl
-@[symm] theorem equiv_symm {x y} : x ≈ y → y ≈ x | ⟨xy, yx⟩ := ⟨yx, xy⟩
-@[trans] theorem equiv_trans {x y z} : x ≈ y → y ≈ z → x ≈ z
-| ⟨xy, yx⟩ ⟨yz, zy⟩ := ⟨le_trans xy yz, le_trans zy yx⟩
+@[trans] theorem le_of_le_of_equiv {x y z} (h₁ : x ≤ y) (h₂ : y ≈ z) : x ≤ z := h₁.trans h₂.1
+@[trans] theorem le_of_equiv_of_le {x y z} (h₁ : x ≈ y) : y ≤ z → x ≤ z := h₁.1.trans
 
-@[trans]
-theorem lt_of_lt_of_equiv {x y z} (h₁ : x < y) (h₂ : y ≈ z) : x < z := lt_of_lt_of_le h₁ h₂.1
-@[trans]
-theorem le_of_le_of_equiv {x y z} (h₁ : x ≤ y) (h₂ : y ≈ z) : x ≤ z := le_trans h₁ h₂.1
-@[trans]
-theorem lt_of_equiv_of_lt {x y z} (h₁ : x ≈ y) (h₂ : y < z) : x < z := lt_of_le_of_lt h₁.1 h₂
-@[trans]
-theorem le_of_equiv_of_le {x y z} (h₁ : x ≈ y) (h₂ : y ≤ z) : x ≤ z := le_trans h₁.1 h₂
+theorem lf.not_equiv {x y} (h : x ⧏ y) : ¬ x ≈ y := λ h', h.not_ge h'.2
+theorem lf.not_equiv' {x y} (h : x ⧏ y) : ¬ y ≈ x := λ h', h.not_ge h'.1
 
-theorem le_congr {x₁ y₁ x₂ y₂} : x₁ ≈ x₂ → y₁ ≈ y₂ → (x₁ ≤ y₁ ↔ x₂ ≤ y₂)
-| ⟨x12, x21⟩ ⟨y12, y21⟩ := ⟨λ h, le_trans x21 (le_trans h y12), λ h, le_trans x12 (le_trans h y21)⟩
+theorem lf.not_gt {x y} (h : x ⧏ y) : ¬ y < x := λ h', h.not_ge h'.le
 
+theorem le_congr_imp {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) (h : x₁ ≤ y₁) : x₂ ≤ y₂ :=
+hx.2.trans (h.trans hy.1)
+theorem le_congr {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ ≤ y₁ ↔ x₂ ≤ y₂ :=
+⟨le_congr_imp hx hy, le_congr_imp hx.symm hy.symm⟩
+theorem le_congr_left {x₁ x₂ y} (hx : x₁ ≈ x₂) : x₁ ≤ y ↔ x₂ ≤ y :=
+le_congr hx equiv_rfl
+theorem le_congr_right {x y₁ y₂} (hy : y₁ ≈ y₂) : x ≤ y₁ ↔ x ≤ y₂ :=
+le_congr equiv_rfl hy
+
+theorem lf_congr {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ ⧏ y₁ ↔ x₂ ⧏ y₂ :=
+pgame.not_le.symm.trans $ (not_congr (le_congr hy hx)).trans pgame.not_le
+theorem lf_congr_imp {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ ⧏ y₁ → x₂ ⧏ y₂ :=
+(lf_congr hx hy).1
+theorem lf_congr_left {x₁ x₂ y} (hx : x₁ ≈ x₂) : x₁ ⧏ y ↔ x₂ ⧏ y :=
+lf_congr hx equiv_rfl
+theorem lf_congr_right {x y₁ y₂} (hy : y₁ ≈ y₂) : x ⧏ y₁ ↔ x ⧏ y₂ :=
+lf_congr equiv_rfl hy
+
+@[trans] theorem lf_of_lf_of_equiv {x y z} (h₁ : x ⧏ y) (h₂ : y ≈ z) : x ⧏ z :=
+lf_congr_imp equiv_rfl h₂ h₁
+@[trans] theorem lf_of_equiv_of_lf {x y z} (h₁ : x ≈ y) : y ⧏ z → x ⧏ z :=
+lf_congr_imp h₁.symm equiv_rfl
+
+@[trans] theorem lt_of_lt_of_equiv {x y z} (h₁ : x < y) (h₂ : y ≈ z) : x < z := h₁.trans_le h₂.1
+@[trans] theorem lt_of_equiv_of_lt {x y z} (h₁ : x ≈ y) : y < z → x < z := h₁.1.trans_lt
+
+theorem lt_congr_imp {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) (h : x₁ < y₁) : x₂ < y₂ :=
+hx.2.trans_lt (h.trans_le hy.1)
 theorem lt_congr {x₁ y₁ x₂ y₂} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ < y₁ ↔ x₂ < y₂ :=
-not_le.symm.trans $ (not_congr (le_congr hy hx)).trans not_le
+⟨lt_congr_imp hx hy, lt_congr_imp hx.symm hy.symm⟩
+theorem lt_congr_left {x₁ x₂ y} (hx : x₁ ≈ x₂) : x₁ < y ↔ x₂ < y :=
+lt_congr hx equiv_rfl
+theorem lt_congr_right {x y₁ y₂} (hy : y₁ ≈ y₂) : x < y₁ ↔ x < y₂ :=
+lt_congr equiv_rfl hy
 
 theorem lt_or_equiv_of_le {x y : pgame} (h : x ≤ y) : x < y ∨ x ≈ y :=
-or_iff_not_imp_left.2 $ λ h', ⟨h, not_lt.1 h'⟩
+and_or_distrib_left.mp ⟨h, (em $ y ≤ x).swap.imp_left pgame.not_le.1⟩
 
-theorem lt_or_equiv_or_gt (x y : pgame) : x < y ∨ x ≈ y ∨ y < x :=
+theorem lf_or_equiv_or_gf (x y : pgame) : x ⧏ y ∨ x ≈ y ∨ y ⧏ x :=
 begin
-  by_cases h : x < y,
+  by_cases h : x ⧏ y,
   { exact or.inl h },
   { right,
-    cases (lt_or_equiv_of_le (not_lt.1 h)) with h' h',
-    { exact or.inr h' },
+    cases (lt_or_equiv_of_le (pgame.not_lf.1 h)) with h' h',
+    { exact or.inr h'.lf },
     { exact or.inl h'.symm } }
 end
 
 theorem equiv_congr_left {y₁ y₂} : y₁ ≈ y₂ ↔ ∀ x₁, x₁ ≈ y₁ ↔ x₁ ≈ y₂ :=
-⟨λ h x₁, ⟨λ h', equiv_trans h' h, λ h', equiv_trans h' (equiv_symm h)⟩,
- λ h, (h y₁).1 $ equiv_refl _⟩
+⟨λ h x₁, ⟨λ h', h'.trans h, λ h', h'.trans h.symm⟩,
+ λ h, (h y₁).1 $ equiv_rfl⟩
 
 theorem equiv_congr_right {x₁ x₂} : x₁ ≈ x₂ ↔ ∀ y₁, x₁ ≈ y₁ ↔ x₂ ≈ y₁ :=
-⟨λ h y₁, ⟨λ h', equiv_trans (equiv_symm h) h', λ h', equiv_trans h h'⟩,
- λ h, (h x₂).2 $ equiv_refl _⟩
+⟨λ h y₁, ⟨λ h', h.symm.trans h', λ h', h.trans h'⟩,
+ λ h, (h x₂).2 $ equiv_rfl⟩
 
 theorem equiv_of_mk_equiv {x y : pgame}
   (L : x.left_moves ≃ y.left_moves) (R : x.right_moves ≃ y.right_moves)
-  (hl : ∀ (i : x.left_moves), x.move_left i ≈ y.move_left (L i))
-  (hr : ∀ (j : y.right_moves), x.move_right (R.symm j) ≈ y.move_right j) :
-  x ≈ y :=
+  (hl : ∀ i, x.move_left i ≈ y.move_left (L i))
+  (hr : ∀ j, x.move_right j ≈ y.move_right (R j)) : x ≈ y :=
 begin
   fsplit; rw le_def,
-  { exact ⟨λ i, or.inl ⟨L i, (hl i).1⟩, λ j, or.inr ⟨R.symm j, (hr j).1⟩⟩ },
-  { fsplit,
-    { intro i,
-      left,
-      specialize hl (L.symm i),
-      simp only [move_left_mk, equiv.apply_symm_apply] at hl,
-      use ⟨L.symm i, hl.2⟩ },
-    { intro j,
-      right,
-      specialize hr (R j),
-      simp only [move_right_mk, equiv.symm_apply_apply] at hr,
-      use ⟨R j, hr.2⟩ } }
+  { exact ⟨λ i, or.inl ⟨_, (hl i).1⟩, λ j, or.inr ⟨_, by simpa using (hr (R.symm j)).1⟩⟩ },
+  { exact ⟨λ i, or.inl ⟨_, by simpa using (hl (L.symm i)).2⟩, λ j, or.inr ⟨_, (hr j).2⟩⟩ }
 end
 
-/-- `restricted x y` says that Left always has no more moves in `x` than in `y`,
-     and Right always has no more moves in `y` than in `x` -/
-inductive restricted : pgame.{u} → pgame.{u} → Type (u+1)
-| mk : Π {x y : pgame} (L : x.left_moves → y.left_moves) (R : y.right_moves → x.right_moves),
-         (∀ (i : x.left_moves), restricted (x.move_left i) (y.move_left (L i))) →
-         (∀ (j : y.right_moves), restricted (x.move_right (R j)) (y.move_right j)) → restricted x y
-
-/-- The identity restriction. -/
-@[refl] def restricted.refl : Π (x : pgame), restricted x x
-| (mk xl xr xL xR) :=
-  restricted.mk
-    id id
-    (λ i, restricted.refl _) (λ j, restricted.refl _)
-using_well_founded { dec_tac := pgame_wf_tac }
+/-- The fuzzy, confused, or incomparable relation on pre-games.
+
+If `x ‖ 0`, then the first player can always win `x`. -/
+def fuzzy (x y : pgame) : Prop := x ⧏ y ∧ y ⧏ x
+
+localized "infix (name := pgame.fuzzy) ` ‖ `:50 := pgame.fuzzy" in pgame
+
+@[symm] theorem fuzzy.swap {x y : pgame} : x ‖ y → y ‖ x := and.swap
+instance : is_symm _ (‖) := ⟨λ x y, fuzzy.swap⟩
+theorem fuzzy.swap_iff {x y : pgame} : x ‖ y ↔ y ‖ x := ⟨fuzzy.swap, fuzzy.swap⟩
 
-instance (x : pgame) : inhabited (restricted x x) := ⟨restricted.refl _⟩
+theorem fuzzy_irrefl (x : pgame) : ¬ x ‖ x := λ h, lf_irrefl x h.1
+instance : is_irrefl _ (‖) := ⟨fuzzy_irrefl⟩
 
--- TODO trans for restricted
+theorem lf_iff_lt_or_fuzzy {x y : pgame} : x ⧏ y ↔ x < y ∨ x ‖ y :=
+by { simp only [lt_iff_le_and_lf, fuzzy, ←pgame.not_le], tauto! }
 
-theorem restricted.le : Π {x y : pgame} (r : restricted x y), x ≤ y
-| (mk xl xr xL xR) (mk yl yr yL yR)
-  (restricted.mk L_embedding R_embedding L_restriction R_restriction) :=
+theorem lf_of_fuzzy {x y : pgame} (h : x ‖ y) : x ⧏ y := lf_iff_lt_or_fuzzy.2 (or.inr h)
+alias lf_of_fuzzy ← fuzzy.lf
+
+theorem lt_or_fuzzy_of_lf {x y : pgame} : x ⧏ y → x < y ∨ x ‖ y :=
+lf_iff_lt_or_fuzzy.1
+
+theorem fuzzy.not_equiv {x y : pgame} (h : x ‖ y) : ¬ x ≈ y :=
+λ h', h'.1.not_gf h.2
+theorem fuzzy.not_equiv' {x y : pgame} (h : x ‖ y) : ¬ y ≈ x :=
+λ h', h'.2.not_gf h.2
+
+theorem not_fuzzy_of_le {x y : pgame} (h : x ≤ y) : ¬ x ‖ y :=
+λ h', h'.2.not_ge h
+theorem not_fuzzy_of_ge {x y : pgame} (h : y ≤ x) : ¬ x ‖ y :=
+λ h', h'.1.not_ge h
+
+theorem equiv.not_fuzzy {x y : pgame} (h : x ≈ y) : ¬ x ‖ y :=
+not_fuzzy_of_le h.1
+theorem equiv.not_fuzzy' {x y : pgame} (h : x ≈ y) : ¬ y ‖ x :=
+not_fuzzy_of_le h.2
+
+theorem fuzzy_congr {x₁ y₁ x₂ y₂ : pgame} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ ‖ y₁ ↔ x₂ ‖ y₂ :=
+show _ ∧ _ ↔ _ ∧ _, by rw [lf_congr hx hy, lf_congr hy hx]
+theorem fuzzy_congr_imp {x₁ y₁ x₂ y₂ : pgame} (hx : x₁ ≈ x₂) (hy : y₁ ≈ y₂) : x₁ ‖ y₁ → x₂ ‖ y₂ :=
+(fuzzy_congr hx hy).1
+theorem fuzzy_congr_left {x₁ x₂ y} (hx : x₁ ≈ x₂) : x₁ ‖ y ↔ x₂ ‖ y :=
+fuzzy_congr hx equiv_rfl
+theorem fuzzy_congr_right {x y₁ y₂} (hy : y₁ ≈ y₂) : x ‖ y₁ ↔ x ‖ y₂ :=
+fuzzy_congr equiv_rfl hy
+
+@[trans] theorem fuzzy_of_fuzzy_of_equiv {x y z} (h₁ : x ‖ y) (h₂ : y ≈ z) : x ‖ z :=
+(fuzzy_congr_right h₂).1 h₁
+@[trans] theorem fuzzy_of_equiv_of_fuzzy {x y z} (h₁ : x ≈ y) (h₂ : y ‖ z) : x ‖ z :=
+(fuzzy_congr_left h₁).2 h₂
+
+/-- Exactly one of the following is true (although we don't prove this here). -/
+theorem lt_or_equiv_or_gt_or_fuzzy (x y : pgame) : x < y ∨ x ≈ y ∨ y < x ∨ x ‖ y :=
 begin
-  rw le_def,
-  exact
-    ⟨λ i, or.inl ⟨L_embedding i, (L_restriction i).le⟩,
-     λ i, or.inr ⟨R_embedding i, (R_restriction i).le⟩⟩
+  cases le_or_gf x y with h₁ h₁;
+  cases le_or_gf y x with h₂ h₂,
+  { right, left, exact ⟨h₁, h₂⟩ },
+  { left, exact ⟨h₁, h₂⟩ },
+  { right, right, left, exact ⟨h₂, h₁⟩ },
+  { right, right, right, exact ⟨h₂, h₁⟩ }
 end
 
+theorem lt_or_equiv_or_gf (x y : pgame) : x < y ∨ x ≈ y ∨ y ⧏ x :=
+begin
+  rw [lf_iff_lt_or_fuzzy, fuzzy.swap_iff],
+  exact lt_or_equiv_or_gt_or_fuzzy x y
+end
+
+/-! ### Relabellings -/
+
 /--
 `relabelling x y` says that `x` and `y` are really the same game, just dressed up differently.
 Specifically, there is a bijection between the moves for Left in `x` and in `y`, and similarly
 for Right, and under these bijections we inductively have `relabelling`s for the consequent games.
-
-In ZFC, relabellings would indeed be the same games.
 -/
 inductive relabelling : pgame.{u} → pgame.{u} → Type (u+1)
 | mk : Π {x y : pgame} (L : x.left_moves ≃ y.left_moves) (R : x.right_moves ≃ y.right_moves),
-         (∀ (i : x.left_moves), relabelling (x.move_left i) (y.move_left (L i))) →
-         (∀ (j : y.right_moves), relabelling (x.move_right (R.symm j)) (y.move_right j)) →
+         (∀ i, relabelling (x.move_left i) (y.move_left (L i))) →
+         (∀ j, relabelling (x.move_right j) (y.move_right (R j))) →
        relabelling x y
 
-/-- If `x` is a relabelling of `y`, then Left and Right have the same moves in either game,
-    so `x` is a restriction of `y`. -/
-def relabelling.restricted : Π {x y : pgame} (r : relabelling x y), restricted x y
-| (mk xl xr xL xR) (mk yl yr yL yR) (relabelling.mk L_equiv R_equiv L_relabelling R_relabelling) :=
-restricted.mk L_equiv.to_embedding R_equiv.symm.to_embedding
-  (λ i, (L_relabelling i).restricted)
-  (λ j, (R_relabelling j).restricted)
+localized "infix (name := pgame.relabelling) ` ≡r `:50 := pgame.relabelling" in pgame
+
+namespace relabelling
+variables {x y : pgame.{u}}
+
+/-- A constructor for relabellings swapping the equivalences. -/
+def mk' (L : y.left_moves ≃ x.left_moves) (R : y.right_moves ≃ x.right_moves)
+  (hL : ∀ i, x.move_left (L i) ≡r y.move_left i)
+  (hR : ∀ j, x.move_right (R j) ≡r y.move_right j) : x ≡r y :=
+⟨L.symm, R.symm, λ i, by simpa using hL (L.symm i), λ j, by simpa using hR (R.symm j)⟩
+
+/-- The equivalence between left moves of `x` and `y` given by the relabelling. -/
+def left_moves_equiv : Π (r : x ≡r y), x.left_moves ≃ y.left_moves
+| ⟨L, R, hL, hR⟩ := L
+
+@[simp] theorem mk_left_moves_equiv {x y L R hL hR} :
+  (@relabelling.mk x y L R hL hR).left_moves_equiv = L := rfl
+@[simp] theorem mk'_left_moves_equiv {x y L R hL hR} :
+  (@relabelling.mk' x y L R hL hR).left_moves_equiv = L.symm := rfl
 
--- It's not the case that `restricted x y → restricted y x → relabelling x y`,
--- but if we insisted that the maps in a restriction were injective, then one
--- could use Schröder-Bernstein for do this.
+/-- The equivalence between right moves of `x` and `y` given by the relabelling. -/
+def right_moves_equiv : Π (r : x ≡r y), x.right_moves ≃ y.right_moves
+| ⟨L, R, hL, hR⟩ := R
+
+@[simp] theorem mk_right_moves_equiv {x y L R hL hR} :
+  (@relabelling.mk x y L R hL hR).right_moves_equiv = R := rfl
+@[simp] theorem mk'_right_moves_equiv {x y L R hL hR} :
+  (@relabelling.mk' x y L R hL hR).right_moves_equiv = R.symm := rfl
+
+/-- A left move of `x` is a relabelling of a left move of `y`. -/
+def move_left : ∀ (r : x ≡r y) (i : x.left_moves),
+  x.move_left i ≡r y.move_left (r.left_moves_equiv i)
+| ⟨L, R, hL, hR⟩ := hL
+
+/-- A left move of `y` is a relabelling of a left move of `x`. -/
+def move_left_symm : ∀ (r : x ≡r y) (i : y.left_moves),
+  x.move_left (r.left_moves_equiv.symm i) ≡r y.move_left i
+| ⟨L, R, hL, hR⟩ i := by simpa using hL (L.symm i)
+
+/-- A right move of `x` is a relabelling of a right move of `y`. -/
+def move_right : ∀ (r : x ≡r y) (i : x.right_moves),
+  x.move_right i ≡r y.move_right (r.right_moves_equiv i)
+| ⟨L, R, hL, hR⟩ := hR
+
+/-- A right move of `y` is a relabelling of a right move of `x`. -/
+def move_right_symm : ∀ (r : x ≡r y) (i : y.right_moves),
+  x.move_right (r.right_moves_equiv.symm i) ≡r y.move_right i
+| ⟨L, R, hL, hR⟩ i := by simpa using hR (R.symm i)
 
 /-- The identity relabelling. -/
-@[refl] def relabelling.refl : Π (x : pgame), relabelling x x
-| (mk xl xr xL xR) :=
-  relabelling.mk (equiv.refl _) (equiv.refl _)
-    (λ i, relabelling.refl _) (λ j, relabelling.refl _)
+@[refl] def refl : Π (x : pgame), x ≡r x
+| x := ⟨equiv.refl _, equiv.refl _, λ i, refl _, λ j, refl _⟩
 using_well_founded { dec_tac := pgame_wf_tac }
 
-instance (x : pgame) : inhabited (relabelling x x) := ⟨relabelling.refl _⟩
+instance (x : pgame) : inhabited (x ≡r x) := ⟨refl _⟩
 
-/-- Reverse a relabelling. -/
-@[symm] def relabelling.symm : Π {x y : pgame}, relabelling x y → relabelling y x
-| (mk xl xr xL xR) (mk yl yr yL yR) (relabelling.mk L_equiv R_equiv L_relabelling R_relabelling) :=
-begin
-  refine relabelling.mk L_equiv.symm R_equiv.symm _ _,
-  { intro i, simpa using (L_relabelling (L_equiv.symm i)).symm },
-  { intro j, simpa using (R_relabelling (R_equiv j)).symm }
-end
+/-- Flip a relabelling. -/
+@[symm] def symm : Π {x y : pgame}, x ≡r y → y ≡r x
+| x y ⟨L, R, hL, hR⟩ := mk' L R (λ i, (hL i).symm) (λ j, (hR j).symm)
 
-/-- Transitivity of relabelling -/
-@[trans] def relabelling.trans :
-  Π {x y z : pgame}, relabelling x y → relabelling y z → relabelling x z
-| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR)
-  (relabelling.mk L_equiv₁ R_equiv₁ L_relabelling₁ R_relabelling₁)
-  (relabelling.mk L_equiv₂ R_equiv₂ L_relabelling₂ R_relabelling₂) :=
-begin
-  refine relabelling.mk (L_equiv₁.trans L_equiv₂) (R_equiv₁.trans R_equiv₂) _ _,
-  { intro i, simpa using (L_relabelling₁ _).trans (L_relabelling₂ _) },
-  { intro j, simpa using (R_relabelling₁ _).trans (R_relabelling₂ _) },
-end
+theorem le : ∀ {x y : pgame} (r : x ≡r y), x ≤ y
+| x y r := le_def.2 ⟨λ i, or.inl ⟨_, (r.move_left i).le⟩, λ j, or.inr ⟨_, (r.move_right_symm j).le⟩⟩
+using_well_founded { dec_tac := pgame_wf_tac }
+
+theorem ge {x y : pgame} (r : x ≡r y) : y ≤ x := r.symm.le
+
+/-- A relabelling lets us prove equivalence of games. -/
+theorem equiv (r : x ≡r y) : x ≈ y := ⟨r.le, r.ge⟩
+
+/-- Transitivity of relabelling. -/
+@[trans] def trans : Π {x y z : pgame}, x ≡r y → y ≡r z → x ≡r z
+| x y z ⟨L₁, R₁, hL₁, hR₁⟩ ⟨L₂, R₂, hL₂, hR₂⟩ :=
+⟨L₁.trans L₂, R₁.trans R₂, λ i, (hL₁ i).trans (hL₂ _), λ j, (hR₁ j).trans (hR₂ _)⟩
 
 /-- Any game without left or right moves is a relabelling of 0. -/
-def relabelling.is_empty (x : pgame) [is_empty (x.left_moves)] [is_empty (x.right_moves)] :
-  relabelling x 0 :=
-⟨equiv.equiv_pempty _, equiv.equiv_pempty _, is_empty_elim, is_empty_elim⟩
+def is_empty (x : pgame) [is_empty x.left_moves] [is_empty x.right_moves] : x ≡r 0 :=
+⟨equiv.equiv_pempty _, equiv.equiv_of_is_empty _ _, is_empty_elim, is_empty_elim⟩
 
-theorem relabelling.le {x y : pgame} (r : relabelling x y) : x ≤ y :=
-r.restricted.le
+end relabelling
 
-/-- A relabelling lets us prove equivalence of games. -/
-theorem relabelling.equiv {x y : pgame} (r : relabelling x y) : x ≈ y :=
-⟨r.le, r.symm.le⟩
+theorem equiv.is_empty (x : pgame) [is_empty x.left_moves] [is_empty x.right_moves] : x ≈ 0 :=
+(relabelling.is_empty x).equiv
 
-instance {x y : pgame} : has_coe (relabelling x y) (x ≈ y) := ⟨relabelling.equiv⟩
+instance {x y : pgame} : has_coe (x ≡r y) (x ≈ y) := ⟨relabelling.equiv⟩
 
 /-- Replace the types indexing the next moves for Left and Right by equivalent types. -/
-def relabel {x : pgame} {xl' xr'} (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') :=
-pgame.mk xl' xr' (λ i, x.move_left (el.symm i)) (λ j, x.move_right (er.symm j))
+def relabel {x : pgame} {xl' xr'} (el : xl' ≃ x.left_moves) (er : xr' ≃ x.right_moves) : pgame :=
+⟨xl', xr', x.move_left ∘ el, x.move_right ∘ er⟩
 
 @[simp] lemma relabel_move_left' {x : pgame} {xl' xr'}
-  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (i : xl') :
-  move_left (relabel el er) i = x.move_left (el.symm i) :=
+  (el : xl' ≃ x.left_moves) (er : xr' ≃ x.right_moves) (i : xl') :
+  move_left (relabel el er) i = x.move_left (el i) :=
 rfl
 @[simp] lemma relabel_move_left {x : pgame} {xl' xr'}
-  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (i : x.left_moves) :
-  move_left (relabel el er) (el i) = x.move_left i :=
+  (el : xl' ≃ x.left_moves) (er : xr' ≃ x.right_moves) (i : x.left_moves) :
+  move_left (relabel el er) (el.symm i) = x.move_left i :=
 by simp
 
 @[simp] lemma relabel_move_right' {x : pgame} {xl' xr'}
-  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (j : xr') :
-  move_right (relabel el er) j = x.move_right (er.symm j) :=
+  (el : xl' ≃ x.left_moves) (er : xr' ≃ x.right_moves) (j : xr') :
+  move_right (relabel el er) j = x.move_right (er j) :=
 rfl
 @[simp] lemma relabel_move_right {x : pgame} {xl' xr'}
-  (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') (j : x.right_moves) :
-  move_right (relabel el er) (er j) = x.move_right j :=
+  (el : xl' ≃ x.left_moves) (er : xr' ≃ x.right_moves) (j : x.right_moves) :
+  move_right (relabel el er) (er.symm j) = x.move_right j :=
 by simp
 
 /-- The game obtained by relabelling the next moves is a relabelling of the original game. -/
-def relabel_relabelling {x : pgame} {xl' xr'} (el : x.left_moves ≃ xl') (er : x.right_moves ≃ xr') :
-  relabelling x (relabel el er) :=
-relabelling.mk el er (λ i, by simp) (λ j, by simp)
+def relabel_relabelling {x : pgame} {xl' xr'} (el : xl' ≃ x.left_moves) (er : xr' ≃ x.right_moves) :
+  x ≡r relabel el er :=
+relabelling.mk' el er (λ i, by simp) (λ j, by simp)
+
+/-! ### Negation -/
 
 /-- The negation of `{L | R}` is `{-R | -L}`. -/
 def neg : pgame → pgame
@@ -710,11 +856,14 @@ instance : has_involutive_neg pgame :=
   end,
   ..pgame.has_neg }
 
-@[simp] protected lemma neg_zero : -(0 : pgame) = 0 :=
-begin
-  dsimp [has_zero.zero, has_neg.neg, neg],
-  congr; funext i; cases i
-end
+instance : neg_zero_class pgame :=
+{ neg_zero :=
+  begin
+    dsimp [has_zero.zero, has_neg.neg, neg],
+    congr; funext i; cases i
+  end,
+  ..pgame.has_zero,
+  ..pgame.has_neg }
 
 @[simp] lemma neg_of_lists (L R : list pgame) :
   -of_lists L R = of_lists (R.map (λ x, -x)) (L.map (λ x, -x)) :=
@@ -731,6 +880,16 @@ begin
       exact this (list.length_map _ _).symm ha } }
 end
 
+theorem is_option_neg {x y : pgame} : is_option x (-y) ↔ is_option (-x) y :=
+begin
+  rw [is_option_iff, is_option_iff, or_comm],
+  cases y, apply or_congr;
+  { apply exists_congr, intro, rw neg_eq_iff_eq_neg, refl },
+end
+
+@[simp] theorem is_option_neg_neg {x y : pgame} : is_option (-x) (-y) ↔ is_option x y :=
+by rw [is_option_neg, neg_neg]
+
 theorem left_moves_neg : ∀ x : pgame, (-x).left_moves = x.right_moves
 | ⟨_, _, _, _⟩ := rfl
 
@@ -784,88 +943,130 @@ lemma move_right_neg_symm' {x : pgame} (i) :
 by simp
 
 /-- If `x` has the same moves as `y`, then `-x` has the sames moves as `-y`. -/
-def relabelling.neg_congr : ∀ {x y : pgame}, x.relabelling y → (-x).relabelling (-y)
-| (mk xl xr xL xR) (mk yl yr yL yR) ⟨L_equiv, R_equiv, L_relabelling, R_relabelling⟩ :=
-  ⟨R_equiv, L_equiv,
-    λ i, relabelling.neg_congr (by simpa using R_relabelling (R_equiv i)),
-    λ i, relabelling.neg_congr (by simpa using L_relabelling (L_equiv.symm i))⟩
+def relabelling.neg_congr : ∀ {x y : pgame}, x ≡r y → -x ≡r -y
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ⟨L, R, hL, hR⟩ :=
+⟨R, L, λ j, (hR j).neg_congr, λ i, (hL i).neg_congr⟩
 
-theorem le_iff_neg_ge : Π {x y : pgame}, x ≤ y ↔ -y ≤ -x
+private theorem neg_le_lf_neg_iff :
+  Π {x y : pgame.{u}}, (-y ≤ -x ↔ x ≤ y) ∧ (-y ⧏ -x ↔ x ⧏ y)
 | (mk xl xr xL xR) (mk yl yr yL yR) :=
 begin
-  rw [le_def, le_def],
-  dsimp [neg],
-  refine ⟨λ h, ⟨λ i, _, λ j, _⟩, λ h, ⟨λ i, _, λ j, _⟩⟩,
-  { rcases h.right i with ⟨w, h⟩ | ⟨w, h⟩,
-    { refine or.inr ⟨to_right_moves_neg w, _⟩,
-      convert le_iff_neg_ge.1 h,
-      rw move_right_neg },
-    { exact or.inl ⟨w, le_iff_neg_ge.1 h⟩ } },
-  { rcases h.left j with ⟨w, h⟩ | ⟨w, h⟩,
-    { exact or.inr ⟨w, le_iff_neg_ge.1 h⟩ },
-    { refine or.inl ⟨to_left_moves_neg w, _⟩,
-      convert le_iff_neg_ge.1 h,
-      rw move_left_neg } },
-  { rcases h.right i with ⟨w, h⟩ | ⟨w, h⟩,
-    { refine or.inr ⟨to_left_moves_neg.symm w, le_iff_neg_ge.2 _⟩,
-      rwa [move_right_neg_symm, neg_neg] },
-    { exact or.inl ⟨w, le_iff_neg_ge.2 h⟩ } },
-  { rcases h.left j with ⟨w, h⟩ | ⟨w, h⟩,
-    { exact or.inr ⟨w, le_iff_neg_ge.2 h⟩ },
-    { refine or.inl ⟨to_right_moves_neg.symm w, le_iff_neg_ge.2 _⟩,
-      rwa [move_left_neg_symm, neg_neg] } },
+  simp_rw [neg_def, mk_le_mk, mk_lf_mk, ← neg_def],
+  split,
+  { rw and_comm, apply and_congr; exact forall_congr (λ _, neg_le_lf_neg_iff.2) },
+  { rw or_comm, apply or_congr; exact exists_congr (λ _, neg_le_lf_neg_iff.1) },
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
-theorem neg_congr {x y : pgame} (h : x ≈ y) : -x ≈ -y :=
-⟨le_iff_neg_ge.1 h.2, le_iff_neg_ge.1 h.1⟩
+@[simp] theorem neg_le_neg_iff {x y : pgame} : -y ≤ -x ↔ x ≤ y := neg_le_lf_neg_iff.1
 
-theorem lt_iff_neg_gt : Π {x y : pgame}, x < y ↔ -y < -x :=
-begin
-  classical,
-  intros,
-  rw [←not_le, ←not_le, not_iff_not],
-  apply le_iff_neg_ge
-end
+@[simp] theorem neg_lf_neg_iff {x y : pgame} : -y ⧏ -x ↔ x ⧏ y := neg_le_lf_neg_iff.2
 
-theorem zero_le_iff_neg_le_zero {x : pgame} : 0 ≤ x ↔ -x ≤ 0 :=
-begin
-  convert le_iff_neg_ge,
-  rw pgame.neg_zero
-end
+@[simp] theorem neg_lt_neg_iff {x y : pgame} : -y < -x ↔ x < y :=
+by rw [lt_iff_le_and_lf, lt_iff_le_and_lf, neg_le_neg_iff, neg_lf_neg_iff]
 
-theorem le_zero_iff_zero_le_neg {x : pgame} : x ≤ 0 ↔ 0 ≤ -x :=
-begin
-  convert le_iff_neg_ge,
-  rw pgame.neg_zero
-end
+@[simp] theorem neg_equiv_neg_iff {x y : pgame} : -x ≈ -y ↔ x ≈ y :=
+by rw [equiv, equiv, neg_le_neg_iff, neg_le_neg_iff, and.comm]
+
+@[simp] theorem neg_fuzzy_neg_iff {x y : pgame} : -x ‖ -y ↔ x ‖ y :=
+by rw [fuzzy, fuzzy, neg_lf_neg_iff, neg_lf_neg_iff, and.comm]
+
+theorem neg_le_iff {x y : pgame} : -y ≤ x ↔ -x ≤ y :=
+by rw [←neg_neg x, neg_le_neg_iff, neg_neg]
+
+theorem neg_lf_iff {x y : pgame} : -y ⧏ x ↔ -x ⧏ y :=
+by rw [←neg_neg x, neg_lf_neg_iff, neg_neg]
+
+theorem neg_lt_iff {x y : pgame} : -y < x ↔ -x < y :=
+by rw [←neg_neg x, neg_lt_neg_iff, neg_neg]
+
+theorem neg_equiv_iff {x y : pgame} : -x ≈ y ↔ x ≈ -y :=
+by rw [←neg_neg y, neg_equiv_neg_iff, neg_neg]
+
+theorem neg_fuzzy_iff {x y : pgame} : -x ‖ y ↔ x ‖ -y :=
+by rw [←neg_neg y, neg_fuzzy_neg_iff, neg_neg]
+
+theorem le_neg_iff {x y : pgame} : y ≤ -x ↔ x ≤ -y :=
+by rw [←neg_neg x, neg_le_neg_iff, neg_neg]
+
+theorem lf_neg_iff {x y : pgame} : y ⧏ -x ↔ x ⧏ -y :=
+by rw [←neg_neg x, neg_lf_neg_iff, neg_neg]
+
+theorem lt_neg_iff {x y : pgame} : y < -x ↔ x < -y :=
+by rw [←neg_neg x, neg_lt_neg_iff, neg_neg]
+
+@[simp] theorem neg_le_zero_iff {x : pgame} : -x ≤ 0 ↔ 0 ≤ x :=
+by rw [neg_le_iff, neg_zero]
+
+@[simp] theorem zero_le_neg_iff {x : pgame} : 0 ≤ -x ↔ x ≤ 0 :=
+by rw [le_neg_iff, neg_zero]
+
+@[simp] theorem neg_lf_zero_iff {x : pgame} : -x ⧏ 0 ↔ 0 ⧏ x :=
+by rw [neg_lf_iff, neg_zero]
+
+@[simp] theorem zero_lf_neg_iff {x : pgame} : 0 ⧏ -x ↔ x ⧏ 0 :=
+by rw [lf_neg_iff, neg_zero]
+
+@[simp] theorem neg_lt_zero_iff {x : pgame} : -x < 0 ↔ 0 < x :=
+by rw [neg_lt_iff, neg_zero]
+
+@[simp] theorem zero_lt_neg_iff {x : pgame} : 0 < -x ↔ x < 0 :=
+by rw [lt_neg_iff, neg_zero]
+
+@[simp] theorem neg_equiv_zero_iff {x : pgame} : -x ≈ 0 ↔ x ≈ 0 :=
+by rw [neg_equiv_iff, neg_zero]
+
+@[simp] theorem neg_fuzzy_zero_iff {x : pgame} : -x ‖ 0 ↔ x ‖ 0 :=
+by rw [neg_fuzzy_iff, neg_zero]
+
+@[simp] theorem zero_equiv_neg_iff {x : pgame} : 0 ≈ -x ↔ 0 ≈ x :=
+by rw [←neg_equiv_iff, neg_zero]
+
+@[simp] theorem zero_fuzzy_neg_iff {x : pgame} : 0 ‖ -x ↔ 0 ‖ x :=
+by rw [←neg_fuzzy_iff, neg_zero]
+
+/-! ### Addition and subtraction -/
 
 /-- The sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x + yR}`. -/
-def add (x y : pgame) : pgame :=
-begin
+instance : has_add pgame.{u} := ⟨λ x y, begin
   induction x with xl xr xL xR IHxl IHxr generalizing y,
   induction y with yl yr yL yR IHyl IHyr,
   have y := mk yl yr yL yR,
   refine ⟨xl ⊕ yl, xr ⊕ yr, sum.rec _ _, sum.rec _ _⟩,
   { exact λ i, IHxl i y },
-  { exact λ i, IHyl i },
+  { exact IHyl },
   { exact λ i, IHxr i y },
-  { exact λ i, IHyr i }
-end
+  { exact IHyr }
+end⟩
+
+/-- The pre-game `((0+1)+⋯)+1`. -/
+instance : has_nat_cast pgame := ⟨nat.unary_cast⟩
 
-instance : has_add pgame := ⟨add⟩
+@[simp] protected theorem nat_succ (n : ℕ) : ((n + 1 : ℕ) : pgame) = n + 1 := rfl
 
-@[simp] theorem nat_one : ((1 : ℕ) : pgame) = 0 + 1 := rfl
+instance is_empty_left_moves_add (x y : pgame.{u})
+  [is_empty x.left_moves] [is_empty y.left_moves] : is_empty (x + y).left_moves :=
+begin
+  unfreezingI { cases x, cases y },
+  apply is_empty_sum.2 ⟨_, _⟩,
+  assumption'
+end
+
+instance is_empty_right_moves_add (x y : pgame.{u})
+  [is_empty x.right_moves] [is_empty y.right_moves] : is_empty (x + y).right_moves :=
+begin
+  unfreezingI { cases x, cases y },
+  apply is_empty_sum.2 ⟨_, _⟩,
+  assumption'
+end
 
 /-- `x + 0` has exactly the same moves as `x`. -/
-def add_zero_relabelling : Π (x : pgame.{u}), relabelling (x + 0) x
-| (mk xl xr xL xR) :=
+def add_zero_relabelling : Π (x : pgame.{u}), x + 0 ≡r x
+| ⟨xl, xr, xL, xR⟩ :=
 begin
-  refine ⟨equiv.sum_empty xl pempty, equiv.sum_empty xr pempty, _, _⟩,
-  { rintro (⟨i⟩|⟨⟨⟩⟩),
-    apply add_zero_relabelling, },
-  { rintro j,
-    apply add_zero_relabelling, }
+  refine ⟨equiv.sum_empty xl pempty, equiv.sum_empty xr pempty, _, _⟩;
+  rintro (⟨i⟩|⟨⟨⟩⟩);
+  apply add_zero_relabelling
 end
 
 /-- `x + 0` is equivalent to `x`. -/
@@ -873,129 +1074,151 @@ lemma add_zero_equiv (x : pgame.{u}) : x + 0 ≈ x :=
 (add_zero_relabelling x).equiv
 
 /-- `0 + x` has exactly the same moves as `x`. -/
-def zero_add_relabelling : Π (x : pgame.{u}), relabelling (0 + x) x
-| (mk xl xr xL xR) :=
+def zero_add_relabelling : Π (x : pgame.{u}), 0 + x ≡r x
+| ⟨xl, xr, xL, xR⟩ :=
 begin
-  refine ⟨equiv.empty_sum pempty xl, equiv.empty_sum pempty xr, _, _⟩,
-  { rintro (⟨⟨⟩⟩|⟨i⟩),
-    apply zero_add_relabelling, },
-  { rintro j,
-    apply zero_add_relabelling, }
+  refine ⟨equiv.empty_sum pempty xl, equiv.empty_sum pempty xr, _, _⟩;
+  rintro (⟨⟨⟩⟩|⟨i⟩);
+  apply zero_add_relabelling
 end
 
 /-- `0 + x` is equivalent to `x`. -/
 lemma zero_add_equiv (x : pgame.{u}) : 0 + x ≈ x :=
 (zero_add_relabelling x).equiv
 
-/-- An explicit equivalence between the moves for Left in `x + y` and the type-theory sum
-    of the moves for Left in `x` and in `y`. -/
-def left_moves_add (x y : pgame) : (x + y).left_moves ≃ x.left_moves ⊕ y.left_moves :=
-by { cases x, cases y, refl, }
+theorem left_moves_add : ∀ (x y : pgame.{u}),
+  (x + y).left_moves = (x.left_moves ⊕ y.left_moves)
+| ⟨_, _, _, _⟩ ⟨_, _, _, _⟩ := rfl
+
+theorem right_moves_add : ∀ (x y : pgame.{u}),
+  (x + y).right_moves = (x.right_moves ⊕ y.right_moves)
+| ⟨_, _, _, _⟩ ⟨_, _, _, _⟩ := rfl
+
+/-- Converts a left move for `x` or `y` into a left move for `x + y` and vice versa.
+
+Even though these types are the same (not definitionally so), this is the preferred way to convert
+between them. -/
+def to_left_moves_add {x y : pgame} :
+  x.left_moves ⊕ y.left_moves ≃ (x + y).left_moves :=
+equiv.cast (left_moves_add x y).symm
 
-/-- An explicit equivalence between the moves for Right in `x + y` and the type-theory sum
-    of the moves for Right in `x` and in `y`. -/
-def right_moves_add (x y : pgame) : (x + y).right_moves ≃ x.right_moves ⊕ y.right_moves :=
-by { cases x, cases y, refl, }
+/-- Converts a right move for `x` or `y` into a right move for `x + y` and vice versa.
+
+Even though these types are the same (not definitionally so), this is the preferred way to convert
+between them. -/
+def to_right_moves_add {x y : pgame} :
+  x.right_moves ⊕ y.right_moves ≃ (x + y).right_moves :=
+equiv.cast (right_moves_add x y).symm
 
 @[simp] lemma mk_add_move_left_inl {xl xr yl yr} {xL xR yL yR} {i} :
   (mk xl xr xL xR + mk yl yr yL yR).move_left (sum.inl i) =
     (mk xl xr xL xR).move_left i + (mk yl yr yL yR) :=
 rfl
-@[simp] lemma add_move_left_inl {x y : pgame} {i} :
-  (x + y).move_left ((@left_moves_add x y).symm (sum.inl i)) = x.move_left i + y :=
-by { cases x, cases y, refl, }
+@[simp] lemma add_move_left_inl {x : pgame} (y : pgame) (i) :
+  (x + y).move_left (to_left_moves_add (sum.inl i)) = x.move_left i + y :=
+by { cases x, cases y, refl }
 
 @[simp] lemma mk_add_move_right_inl {xl xr yl yr} {xL xR yL yR} {i} :
   (mk xl xr xL xR + mk yl yr yL yR).move_right (sum.inl i) =
     (mk xl xr xL xR).move_right i + (mk yl yr yL yR) :=
 rfl
-@[simp] lemma add_move_right_inl {x y : pgame} {i} :
-  (x + y).move_right ((@right_moves_add x y).symm (sum.inl i)) = x.move_right i + y :=
-by { cases x, cases y, refl, }
+@[simp] lemma add_move_right_inl {x : pgame} (y : pgame) (i) :
+  (x + y).move_right (to_right_moves_add (sum.inl i)) = x.move_right i + y :=
+by { cases x, cases y, refl }
 
 @[simp] lemma mk_add_move_left_inr {xl xr yl yr} {xL xR yL yR} {i} :
   (mk xl xr xL xR + mk yl yr yL yR).move_left (sum.inr i) =
     (mk xl xr xL xR) + (mk yl yr yL yR).move_left i :=
 rfl
-@[simp] lemma add_move_left_inr {x y : pgame} {i : y.left_moves} :
-  (x + y).move_left ((@left_moves_add x y).symm (sum.inr i)) = x + y.move_left i :=
-by { cases x, cases y, refl, }
+@[simp] lemma add_move_left_inr (x : pgame) {y : pgame} (i) :
+  (x + y).move_left (to_left_moves_add (sum.inr i)) = x + y.move_left i :=
+by { cases x, cases y, refl }
 
 @[simp] lemma mk_add_move_right_inr {xl xr yl yr} {xL xR yL yR} {i} :
   (mk xl xr xL xR + mk yl yr yL yR).move_right (sum.inr i) =
     (mk xl xr xL xR) + (mk yl yr yL yR).move_right i :=
 rfl
-@[simp] lemma add_move_right_inr {x y : pgame} {i} :
-  (x + y).move_right ((@right_moves_add x y).symm (sum.inr i)) = x + y.move_right i :=
-by { cases x, cases y, refl, }
+@[simp] lemma add_move_right_inr (x : pgame) {y : pgame} (i) :
+  (x + y).move_right (to_right_moves_add (sum.inr i)) = x + y.move_right i :=
+by { cases x, cases y, refl }
+
+lemma left_moves_add_cases {x y : pgame} (k) {P : (x + y).left_moves → Prop}
+  (hl : ∀ i, P $ to_left_moves_add (sum.inl i))
+  (hr : ∀ i, P $ to_left_moves_add (sum.inr i)) : P k :=
+begin
+  rw ←to_left_moves_add.apply_symm_apply k,
+  cases to_left_moves_add.symm k with i i,
+  { exact hl i },
+  { exact hr i }
+end
+
+lemma right_moves_add_cases {x y : pgame} (k) {P : (x + y).right_moves → Prop}
+  (hl : ∀ j, P $ to_right_moves_add (sum.inl j))
+  (hr : ∀ j, P $ to_right_moves_add (sum.inr j)) : P k :=
+begin
+  rw ←to_right_moves_add.apply_symm_apply k,
+  cases to_right_moves_add.symm k with i i,
+  { exact hl i },
+  { exact hr i }
+end
 
 instance is_empty_nat_right_moves : ∀ n : ℕ, is_empty (right_moves n)
 | 0 := pempty.is_empty
 | (n + 1) := begin
   haveI := is_empty_nat_right_moves n,
-  rw nat.cast_succ,
-  exact (right_moves_add _ _).is_empty
+  rw [pgame.nat_succ, right_moves_add],
+  apply_instance
 end
 
 /-- If `w` has the same moves as `x` and `y` has the same moves as `z`,
 then `w + y` has the same moves as `x + z`. -/
-def relabelling.add_congr : ∀ {w x y z : pgame.{u}},
-  w.relabelling x → y.relabelling z → (w + y).relabelling (x + z)
-| (mk wl wr wL wR) (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR)
-  ⟨L_equiv₁, R_equiv₁, L_relabelling₁, R_relabelling₁⟩
-  ⟨L_equiv₂, R_equiv₂, L_relabelling₂, R_relabelling₂⟩ :=
+def relabelling.add_congr : ∀ {w x y z : pgame.{u}}, w ≡r x → y ≡r z → w + y ≡r x + z
+| ⟨wl, wr, wL, wR⟩ ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ⟨zl, zr, zL, zR⟩
+  ⟨L₁, R₁, hL₁, hR₁⟩ ⟨L₂, R₂, hL₂, hR₂⟩ :=
 begin
-  refine ⟨equiv.sum_congr L_equiv₁ L_equiv₂, equiv.sum_congr R_equiv₁ R_equiv₂, _, _⟩,
-  { rintro (i|j),
-    { exact relabelling.add_congr
-        (L_relabelling₁ i)
-        (⟨L_equiv₂, R_equiv₂, L_relabelling₂, R_relabelling₂⟩) },
-    { exact relabelling.add_congr
-        (⟨L_equiv₁, R_equiv₁, L_relabelling₁, R_relabelling₁⟩)
-        (L_relabelling₂ j) }},
-  { rintro (i|j),
-    { exact relabelling.add_congr
-        (R_relabelling₁ i)
-        (⟨L_equiv₂, R_equiv₂, L_relabelling₂, R_relabelling₂⟩) },
-    { exact relabelling.add_congr
-        (⟨L_equiv₁, R_equiv₁, L_relabelling₁, R_relabelling₁⟩)
-        (R_relabelling₂ j) }}
+  let Hwx : ⟨wl, wr, wL, wR⟩ ≡r ⟨xl, xr, xL, xR⟩ := ⟨L₁, R₁, hL₁, hR₁⟩,
+  let Hyz : ⟨yl, yr, yL, yR⟩ ≡r ⟨zl, zr, zL, zR⟩ := ⟨L₂, R₂, hL₂, hR₂⟩,
+  refine ⟨equiv.sum_congr L₁ L₂, equiv.sum_congr R₁ R₂, _, _⟩;
+  rintro (i|j),
+  { exact (hL₁ i).add_congr Hyz },
+  { exact Hwx.add_congr (hL₂ j) },
+  { exact (hR₁ i).add_congr Hyz },
+  { exact Hwx.add_congr (hR₂ j) }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
 instance : has_sub pgame := ⟨λ x y, x + -y⟩
 
 @[simp] theorem sub_zero (x : pgame) : x - 0 = x + 0 :=
-show x + -0 = x + 0, by rw pgame.neg_zero
+show x + -0 = x + 0, by rw neg_zero
 
 /-- If `w` has the same moves as `x` and `y` has the same moves as `z`,
 then `w - y` has the same moves as `x - z`. -/
-def relabelling.sub_congr {w x y z : pgame}
-  (h₁ : w.relabelling x) (h₂ : y.relabelling z) : (w - y).relabelling (x - z) :=
+def relabelling.sub_congr {w x y z : pgame} (h₁ : w ≡r x) (h₂ : y ≡r z) : w - y ≡r x - z :=
 h₁.add_congr h₂.neg_congr
 
-/-- `-(x+y)` has exactly the same moves as `-x + -y`. -/
-def neg_add_relabelling : Π (x y : pgame), relabelling (-(x + y)) (-x + -y)
-| (mk xl xr xL xR) (mk yl yr yL yR) :=
-⟨equiv.refl _, equiv.refl _,
- λ j, sum.cases_on j
-   (λ j, neg_add_relabelling (xR j) (mk yl yr yL yR))
-   (λ j, neg_add_relabelling (mk xl xr xL xR) (yR j)),
- λ i, sum.cases_on i
-   (λ i, neg_add_relabelling (xL i) (mk yl yr yL yR))
-   (λ i, neg_add_relabelling (mk xl xr xL xR) (yL i))⟩
+/-- `-(x + y)` has exactly the same moves as `-x + -y`. -/
+def neg_add_relabelling : Π (x y : pgame), -(x + y) ≡r -x + -y
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ :=
+begin
+  refine ⟨equiv.refl _, equiv.refl _, _, _⟩,
+  all_goals {
+    exact λ j, sum.cases_on j
+      (λ j, neg_add_relabelling _ _)
+      (λ j, neg_add_relabelling ⟨xl, xr, xL, xR⟩ _) }
+end
 using_well_founded { dec_tac := pgame_wf_tac }
 
 theorem neg_add_le {x y : pgame} : -(x + y) ≤ -x + -y :=
 (neg_add_relabelling x y).le
 
 /-- `x + y` has exactly the same moves as `y + x`. -/
-def add_comm_relabelling : Π (x y : pgame.{u}), relabelling (x + y) (y + x)
+def add_comm_relabelling : Π (x y : pgame.{u}), x + y ≡r y + x
 | (mk xl xr xL xR) (mk yl yr yL yR) :=
 begin
   refine ⟨equiv.sum_comm _ _, equiv.sum_comm _ _, _, _⟩;
   rintros (_|_);
-  { simp [left_moves_add, right_moves_add], apply add_comm_relabelling }
+  { dsimp [left_moves_add, right_moves_add], apply add_comm_relabelling }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
@@ -1006,172 +1229,149 @@ theorem add_comm_equiv {x y : pgame} : x + y ≈ y + x :=
 (add_comm_relabelling x y).equiv
 
 /-- `(x + y) + z` has exactly the same moves as `x + (y + z)`. -/
-def add_assoc_relabelling : Π (x y z : pgame.{u}), relabelling ((x + y) + z) (x + (y + z))
-| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
+def add_assoc_relabelling : Π (x y z : pgame.{u}), x + y + z ≡r x + (y + z)
+| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ⟨zl, zr, zL, zR⟩ :=
 begin
   refine ⟨equiv.sum_assoc _ _ _, equiv.sum_assoc _ _ _, _, _⟩,
-  { rintro (⟨i|i⟩|i),
-    { apply add_assoc_relabelling, },
-    { change relabelling
-        (mk xl xr xL xR + yL i + mk zl zr zL zR) (mk xl xr xL xR + (yL i + mk zl zr zL zR)),
-      apply add_assoc_relabelling, },
-    { change relabelling
-        (mk xl xr xL xR + mk yl yr yL yR + zL i) (mk xl xr xL xR + (mk yl yr yL yR + zL i)),
-      apply add_assoc_relabelling, } },
-  { rintro (j|⟨j|j⟩),
-    { apply add_assoc_relabelling, },
-    { change relabelling
-        (mk xl xr xL xR + yR j + mk zl zr zL zR) (mk xl xr xL xR + (yR j + mk zl zr zL zR)),
-      apply add_assoc_relabelling, },
-    { change relabelling
-        (mk xl xr xL xR + mk yl yr yL yR + zR j) (mk xl xr xL xR + (mk yl yr yL yR + zR j)),
-      apply add_assoc_relabelling, } },
+  all_goals
+  { rintro (⟨i|i⟩|i) <|> rintro (j|⟨j|j⟩),
+    { apply add_assoc_relabelling },
+    { apply add_assoc_relabelling ⟨xl, xr, xL, xR⟩ },
+    { apply add_assoc_relabelling ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ } }
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
 theorem add_assoc_equiv {x y z : pgame} : (x + y) + z ≈ x + (y + z) :=
 (add_assoc_relabelling x y z).equiv
 
-private lemma add_le_add_right : ∀ {x y z : pgame} (h : x ≤ y), x + z ≤ y + z
-| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
-begin
-  intros h,
-  rw le_def,
-  split,
-  { -- if Left plays first
-    intros i,
-    change xl ⊕ zl at i,
-    cases i,
-    { -- either they play in x
-      rw le_def at h,
-      cases h,
-      have t := h_left i,
-      rcases t with ⟨i', ih⟩ | ⟨j, jh⟩,
-      { left,
-        refine ⟨(left_moves_add _ _).inv_fun (sum.inl i'), _⟩,
-        exact add_le_add_right ih, },
-      { right,
-        refine ⟨(right_moves_add _ _).inv_fun (sum.inl j), _⟩,
-        convert add_le_add_right jh,
-        apply add_move_right_inl } },
-    { -- or play in z
-      left,
-      refine ⟨(left_moves_add _ _).inv_fun (sum.inr i), _⟩,
-      exact add_le_add_right h, }, },
-  { -- if Right plays first
-    intros j,
-    change yr ⊕ zr at j,
-    cases j,
-    { -- either they play in y
-      rw le_def at h,
-      cases h,
-      have t := h_right j,
-      rcases t with ⟨i, ih⟩ | ⟨j', jh⟩,
-      { left,
-        refine ⟨(left_moves_add _ _).inv_fun (sum.inl i), _⟩,
-        convert add_le_add_right ih,
-        apply add_move_left_inl },
-      { right,
-        refine ⟨(right_moves_add _ _).inv_fun (sum.inl j'), _⟩,
-        exact add_le_add_right jh } },
-    { -- or play in z
-      right,
-      refine ⟨(right_moves_add _ _).inv_fun (sum.inr j), _⟩,
-      exact add_le_add_right h } }
-end
-using_well_founded { dec_tac := pgame_wf_tac }
-
-instance covariant_class_swap_add_le : covariant_class pgame pgame (swap (+)) (≤) :=
-⟨λ x y z, add_le_add_right⟩
-
-instance covariant_class_add_le : covariant_class pgame pgame (+) (≤) :=
-⟨λ x y z h, calc x + y ≤ y + x : add_comm_le
-                   ... ≤ z + x : add_le_add_right h _
-                   ... ≤ x + z : add_comm_le⟩
-
-theorem add_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w + y ≈ x + z :=
-⟨le_trans (add_le_add_left h₂.1 w) (add_le_add_right h₁.1 z),
-  le_trans (add_le_add_left h₂.2 x) (add_le_add_right h₁.2 y)⟩
-
-theorem add_congr_left {x y z : pgame} (h : x ≈ y) : x + z ≈ y + z :=
-add_congr h equiv_rfl
-
-theorem add_congr_right {x y z : pgame} : y ≈ z → x + y ≈ x + z :=
-add_congr equiv_rfl
-
-theorem sub_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w - y ≈ x - z :=
-add_congr h₁ (neg_congr h₂)
-
-theorem sub_congr_left {x y z : pgame} (h : x ≈ y) : x - z ≈ y - z :=
-sub_congr h equiv_rfl
-
-theorem sub_congr_right {x y z : pgame} : y ≈ z → x - y ≈ x - z :=
-sub_congr equiv_rfl
-
 theorem add_left_neg_le_zero : ∀ (x : pgame), -x + x ≤ 0
 | ⟨xl, xr, xL, xR⟩ :=
-begin
-  rw [le_def],
-  split,
-  { intro i,
-    change xr ⊕ xl at i,
-    cases i,
-    { -- If Left played in -x, Right responds with the same move in x.
-      right,
-      refine ⟨(right_moves_add _ _).inv_fun (sum.inr i), _⟩,
-      convert @add_left_neg_le_zero (xR i),
-      exact add_move_right_inr },
-    { -- If Left in x, Right responds with the same move in -x.
-      right,
-      dsimp,
-      refine ⟨(right_moves_add _ _).inv_fun (sum.inl i), _⟩,
-      convert @add_left_neg_le_zero (xL i),
-      exact add_move_right_inl }, },
-  { rintro ⟨⟩, }
+le_zero.2 $ λ i, begin
+  cases i,
+  { -- If Left played in -x, Right responds with the same move in x.
+    refine ⟨@to_right_moves_add _ ⟨_, _, _, _⟩ (sum.inr i), _⟩,
+    convert @add_left_neg_le_zero (xR i),
+    apply add_move_right_inr },
+  { -- If Left in x, Right responds with the same move in -x.
+    dsimp,
+    refine ⟨@to_right_moves_add ⟨_, _, _, _⟩ _ (sum.inl i), _⟩,
+    convert @add_left_neg_le_zero (xL i),
+    apply add_move_right_inl }
 end
-using_well_founded { dec_tac := pgame_wf_tac }
 
 theorem zero_le_add_left_neg (x : pgame) : 0 ≤ -x + x :=
 begin
-  rw [le_iff_neg_ge, pgame.neg_zero],
-  exact le_trans neg_add_le (add_left_neg_le_zero _)
+  rw [←neg_le_neg_iff, neg_zero],
+  exact neg_add_le.trans (add_left_neg_le_zero _)
 end
 
 theorem add_left_neg_equiv (x : pgame) : -x + x ≈ 0 :=
 ⟨add_left_neg_le_zero x, zero_le_add_left_neg x⟩
 
 theorem add_right_neg_le_zero (x : pgame) : x + -x ≤ 0 :=
-le_trans add_comm_le (add_left_neg_le_zero x)
+add_comm_le.trans (add_left_neg_le_zero x)
 
 theorem zero_le_add_right_neg (x : pgame) : 0 ≤ x + -x :=
-le_trans (zero_le_add_left_neg x) add_comm_le
+(zero_le_add_left_neg x).trans add_comm_le
 
 theorem add_right_neg_equiv (x : pgame) : x + -x ≈ 0 :=
 ⟨add_right_neg_le_zero x, zero_le_add_right_neg x⟩
 
-instance covariant_class_swap_add_lt : covariant_class pgame pgame (swap (+)) (<) :=
-⟨λ x y z h, suffices z + x ≤ y + x → z ≤ y, by { rw ←not_le at ⊢ h, exact mt this h }, λ w,
+theorem sub_self_equiv : ∀ x, x - x ≈ 0 :=
+add_right_neg_equiv
+
+private lemma add_le_add_right' : ∀ {x y z : pgame} (h : x ≤ y), x + z ≤ y + z
+| (mk xl xr xL xR) (mk yl yr yL yR) (mk zl zr zL zR) :=
+λ h, begin
+  refine le_def.2 ⟨λ i, _, λ i, _⟩;
+  cases i,
+  { rw le_def at h,
+    cases h,
+    rcases h_left i with ⟨i', ih⟩ | ⟨j, jh⟩,
+    { exact or.inl ⟨to_left_moves_add (sum.inl i'), add_le_add_right' ih⟩ },
+    { refine or.inr ⟨to_right_moves_add (sum.inl j), _⟩,
+      convert add_le_add_right' jh,
+      apply add_move_right_inl } },
+  { exact or.inl ⟨@to_left_moves_add _ ⟨_, _, _, _⟩ (sum.inr i), add_le_add_right' h⟩ },
+  { rw le_def at h,
+    cases h,
+    rcases h_right i with ⟨i, ih⟩ | ⟨j', jh⟩,
+    { refine or.inl ⟨to_left_moves_add (sum.inl i), _⟩,
+      convert add_le_add_right' ih,
+      apply add_move_left_inl },
+    { exact or.inr ⟨to_right_moves_add (sum.inl j'), add_le_add_right' jh⟩ } },
+  { exact or.inr ⟨@to_right_moves_add _ ⟨_, _, _, _⟩ (sum.inr i), add_le_add_right' h⟩ }
+end
+using_well_founded { dec_tac := pgame_wf_tac }
+
+instance covariant_class_swap_add_le : covariant_class pgame pgame (swap (+)) (≤) :=
+⟨λ x y z, add_le_add_right'⟩
+
+instance covariant_class_add_le : covariant_class pgame pgame (+) (≤) :=
+⟨λ x y z h, (add_comm_le.trans (add_le_add_right h x)).trans add_comm_le⟩
+
+theorem add_lf_add_right {y z : pgame} (h : y ⧏ z) (x) : y + x ⧏ z + x :=
+suffices z + x ≤ y + x → z ≤ y, by { rw ←pgame.not_le at ⊢ h, exact mt this h }, λ w,
   calc z ≤ z + 0        : (add_zero_relabelling _).symm.le
      ... ≤ z + (x + -x) : add_le_add_left (zero_le_add_right_neg x) _
      ... ≤ z + x + -x   : (add_assoc_relabelling _ _ _).symm.le
      ... ≤ y + x + -x   : add_le_add_right w _
      ... ≤ y + (x + -x) : (add_assoc_relabelling _ _ _).le
      ... ≤ y + 0        : add_le_add_left (add_right_neg_le_zero x) _
-     ... ≤ y            : (add_zero_relabelling _).le⟩
+     ... ≤ y            : (add_zero_relabelling _).le
+
+theorem add_lf_add_left {y z : pgame} (h : y ⧏ z) (x) : x + y ⧏ x + z :=
+by { rw lf_congr add_comm_equiv add_comm_equiv, apply add_lf_add_right h }
+
+instance covariant_class_swap_add_lt : covariant_class pgame pgame (swap (+)) (<) :=
+⟨λ x y z h, ⟨add_le_add_right h.1 x, add_lf_add_right h.2 x⟩⟩
 
 instance covariant_class_add_lt : covariant_class pgame pgame (+) (<) :=
-⟨λ x y z h, calc x + y ≤ y + x : add_comm_le
-                   ... < z + x   : add_lt_add_right h _
-                   ... ≤ x + z   : add_comm_le⟩
+⟨λ x y z h, ⟨add_le_add_left h.1 x, add_lf_add_left h.2 x⟩⟩
+
+theorem add_lf_add_of_lf_of_le {w x y z : pgame} (hwx : w ⧏ x) (hyz : y ≤ z) : w + y ⧏ x + z :=
+lf_of_lf_of_le (add_lf_add_right hwx y) (add_le_add_left hyz x)
+
+theorem add_lf_add_of_le_of_lf {w x y z : pgame} (hwx : w ≤ x) (hyz : y ⧏ z) : w + y ⧏ x + z :=
+lf_of_le_of_lf (add_le_add_right hwx y) (add_lf_add_left hyz x)
+
+theorem add_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w + y ≈ x + z :=
+⟨(add_le_add_left h₂.1 w).trans (add_le_add_right h₁.1 z),
+  (add_le_add_left h₂.2 x).trans (add_le_add_right h₁.2 y)⟩
+
+theorem add_congr_left {x y z : pgame} (h : x ≈ y) : x + z ≈ y + z :=
+add_congr h equiv_rfl
+
+theorem add_congr_right {x y z : pgame} : y ≈ z → x + y ≈ x + z :=
+add_congr equiv_rfl
+
+theorem sub_congr {w x y z : pgame} (h₁ : w ≈ x) (h₂ : y ≈ z) : w - y ≈ x - z :=
+add_congr h₁ (neg_equiv_neg_iff.2 h₂)
+
+theorem sub_congr_left {x y z : pgame} (h : x ≈ y) : x - z ≈ y - z :=
+sub_congr h equiv_rfl
+
+theorem sub_congr_right {x y z : pgame} : y ≈ z → x - y ≈ x - z :=
+sub_congr equiv_rfl
 
 theorem le_iff_sub_nonneg {x y : pgame} : x ≤ y ↔ 0 ≤ y - x :=
-⟨λ h, le_trans (zero_le_add_right_neg x) (add_le_add_right h _),
+⟨λ h, (zero_le_add_right_neg x).trans (add_le_add_right h _),
  λ h,
   calc x ≤ 0 + x : (zero_add_relabelling x).symm.le
      ... ≤ y - x + x : add_le_add_right h _
      ... ≤ y + (-x + x) : (add_assoc_relabelling _ _ _).le
      ... ≤ y + 0 : add_le_add_left (add_left_neg_le_zero x) _
      ... ≤ y : (add_zero_relabelling y).le⟩
+
+theorem lf_iff_sub_zero_lf {x y : pgame} : x ⧏ y ↔ 0 ⧏ y - x :=
+⟨λ h, (zero_le_add_right_neg x).trans_lf (add_lf_add_right h _),
+ λ h,
+  calc x ≤ 0 + x : (zero_add_relabelling x).symm.le
+     ... ⧏ y - x + x : add_lf_add_right h _
+     ... ≤ y + (-x + x) : (add_assoc_relabelling _ _ _).le
+     ... ≤ y + 0 : add_le_add_left (add_left_neg_le_zero x) _
+     ... ≤ y : (add_zero_relabelling y).le⟩
+
 theorem lt_iff_sub_pos {x y : pgame} : x < y ↔ 0 < y - x :=
 ⟨λ h, lt_of_le_of_lt (zero_le_add_right_neg x) (add_lt_add_right h _),
  λ h,
@@ -1181,7 +1381,9 @@ theorem lt_iff_sub_pos {x y : pgame} : x < y ↔ 0 < y - x :=
      ... ≤ y + 0 : add_le_add_left (add_left_neg_le_zero x) _
      ... ≤ y : (add_zero_relabelling y).le⟩
 
-/-- The pre-game `star`, which is fuzzy/confused with zero. -/
+/-! ### Special pre-games -/
+
+/-- The pre-game `star`, which is fuzzy with zero. -/
 def star : pgame.{u} := ⟨punit, punit, λ _, 0, λ _, 0⟩
 
 @[simp] theorem star_left_moves : star.left_moves = punit := rfl
@@ -1193,41 +1395,18 @@ def star : pgame.{u} := ⟨punit, punit, λ _, 0, λ _, 0⟩
 instance unique_star_left_moves : unique star.left_moves := punit.unique
 instance unique_star_right_moves : unique star.right_moves := punit.unique
 
-theorem star_lt_zero : star < 0 :=
-by { rw lt_zero, use default, rintros ⟨⟩ }
-theorem zero_lt_star : 0 < star :=
-by { rw zero_lt, use default, rintros ⟨⟩ }
+theorem star_fuzzy_zero : star ‖ 0 :=
+⟨by { rw lf_zero, use default, rintros ⟨⟩ }, by { rw zero_lf, use default, rintros ⟨⟩ }⟩
 
 @[simp] theorem neg_star : -star = star :=
 by simp [star]
 
-@[simp] theorem zero_lt_one : (0 : pgame) < 1 :=
-by { rw zero_lt, use default, rintro ⟨⟩ }
-
-theorem zero_le_one : (0 : pgame) ≤ 1 :=
-zero_le_of_is_empty_right_moves 1
-
-/-- The pre-game `half` is defined as `{0 | 1}`. -/
-def half : pgame := ⟨punit, punit, 0, 1⟩
+@[simp] protected theorem zero_lt_one : (0 : pgame) < 1 :=
+lt_of_le_of_lf (zero_le_of_is_empty_right_moves 1) (zero_lf_le.2 ⟨default, le_rfl⟩)
 
-@[simp] theorem half_left_moves : half.left_moves = punit := rfl
-@[simp] theorem half_right_moves : half.right_moves = punit := rfl
-@[simp] lemma half_move_left (x) : half.move_left x = 0 := rfl
-@[simp] lemma half_move_right (x) : half.move_right x = 1 := rfl
+instance : zero_le_one_class pgame := ⟨pgame.zero_lt_one.le⟩
 
-instance unique_half_left_moves : unique half.left_moves := punit.unique
-instance unique_half_right_moves : unique half.right_moves := punit.unique
-
-protected theorem zero_lt_half : 0 < half :=
-by { rw zero_lt, use default, rintro ⟨⟩ }
-
-theorem half_lt_one : half < 1 :=
-begin
-  rw lt_def,
-  right,
-  use default,
-  split; rintro ⟨⟩,
-  exact zero_lt_one
-end
+@[simp] theorem zero_lf_one : (0 : pgame) ⧏ 1 :=
+pgame.zero_lt_one.lf
 
 end pgame
diff --git a/src/set_theory/game/short.lean b/src/set_theory/game/short.lean
index 83bacb45a358e..6b5867a25770c 100644
--- a/src/set_theory/game/short.lean
+++ b/src/set_theory/game/short.lean
@@ -5,12 +5,14 @@ Authors: Scott Morrison
 -/
 import data.fintype.basic
 import set_theory.cardinal.cofinality
-import set_theory.game.basic
 import set_theory.game.birthday
 
 /-!
 # Short games
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A combinatorial game is `short` [Conway, ch.9][conway2001] if it has only finitely many positions.
 In particular, this means there is a finite set of moves at every point.
 
@@ -20,6 +22,8 @@ prove anything using these instances.
 -/
 universes u
 
+open_locale pgame
+
 namespace pgame
 
 /-- A short game is a game with a finite set of moves at every turn. -/
@@ -96,13 +100,13 @@ theorem short_birthday : ∀ (x : pgame.{u}) [short x], x.birthday < ordinal.ome
 | ⟨xl, xr, xL, xR⟩ hs :=
 begin
   haveI := hs,
-  unfreezingI { rcases hs with ⟨_, _, _, _, sL, sR, hl, hr⟩ },
+  unfreezingI { rcases hs with ⟨sL, sR⟩ },
   rw [birthday, max_lt_iff],
   split, all_goals
-  { rw ←cardinal.ord_omega,
-    refine cardinal.lsub_lt_ord_of_is_regular.{u u} cardinal.is_regular_omega
-      (cardinal.lt_omega_of_fintype _) (λ i, _),
-    rw cardinal.ord_omega,
+  { rw ←cardinal.ord_aleph_0,
+    refine cardinal.lsub_lt_ord_of_is_regular.{u u} cardinal.is_regular_aleph_0
+      (cardinal.lt_aleph_0_of_finite _) (λ i, _),
+    rw cardinal.ord_aleph_0,
     apply short_birthday _ },
   { exact move_left_short' xL xR i },
   { exact move_right_short' xL xR i }
@@ -148,7 +152,7 @@ begin
   haveI := fintype.of_equiv _ R,
   exact short.mk'
     (λ i, by { rw ←(L.right_inv i), apply short_of_relabelling (rL (L.symm i)) infer_instance, })
-    (λ j, short_of_relabelling (rR j) infer_instance)
+    (λ j, by simpa using short_of_relabelling (rR (R.symm j)) infer_instance)
 end
 
 instance short_neg : Π (x : pgame.{u}) [short x], short (-x)
@@ -178,10 +182,11 @@ by { dsimp [bit1], apply_instance }
 
 /--
 Auxiliary construction of decidability instances.
-We build `decidable (x ≤ y)` and `decidable (x < y)` in a simultaneous induction.
+We build `decidable (x ≤ y)` and `decidable (x ⧏ y)` in a simultaneous induction.
 Instances for the two projections separately are provided below.
 -/
-def le_lt_decidable : Π (x y : pgame.{u}) [short x] [short y], decidable (x ≤ y) × decidable (x < y)
+def le_lf_decidable : Π (x y : pgame.{u}) [short x] [short y],
+  decidable (x ≤ y) × decidable (x ⧏ y)
 | (mk xl xr xL xR) (mk yl yr yL yR) shortx shorty :=
 begin
   resetI,
@@ -190,26 +195,29 @@ begin
     apply @and.decidable _ _ _ _,
     { apply @fintype.decidable_forall_fintype xl _ _ (by apply_instance),
       intro i,
-      apply (@le_lt_decidable _ _ _ _).2; apply_instance, },
+      apply (@le_lf_decidable _ _ _ _).2; apply_instance, },
     { apply @fintype.decidable_forall_fintype yr _ _ (by apply_instance),
       intro i,
-      apply (@le_lt_decidable _ _ _ _).2; apply_instance, }, },
-  { refine @decidable_of_iff' _ _ mk_lt_mk (id _),
+      apply (@le_lf_decidable _ _ _ _).2; apply_instance, }, },
+  { refine @decidable_of_iff' _ _ mk_lf_mk (id _),
     apply @or.decidable _ _ _ _,
     { apply @fintype.decidable_exists_fintype yl _ _ (by apply_instance),
       intro i,
-      apply (@le_lt_decidable _ _ _ _).1; apply_instance, },
+      apply (@le_lf_decidable _ _ _ _).1; apply_instance, },
     { apply @fintype.decidable_exists_fintype xr _ _ (by apply_instance),
       intro i,
-      apply (@le_lt_decidable _ _ _ _).1; apply_instance, }, },
+      apply (@le_lf_decidable _ _ _ _).1; apply_instance, }, },
 end
 using_well_founded { dec_tac := pgame_wf_tac }
 
 instance le_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≤ y) :=
-(le_lt_decidable x y).1
+(le_lf_decidable x y).1
+
+instance lf_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ⧏ y) :=
+(le_lf_decidable x y).2
 
 instance lt_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x < y) :=
-(le_lt_decidable x y).2
+and.decidable
 
 instance equiv_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≈ y) :=
 and.decidable
diff --git a/src/set_theory/game/state.lean b/src/set_theory/game/state.lean
index c5520907f7692..27f9ca055dce5 100644
--- a/src/set_theory/game/state.lean
+++ b/src/set_theory/game/state.lean
@@ -8,6 +8,9 @@ import set_theory.game.short
 /-!
 # Games described via "the state of the board".
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We provide a simple mechanism for constructing combinatorial (pre-)games, by describing
 "the state of the board", and providing an upper bound on the number of turns remaining.
 
@@ -27,7 +30,7 @@ namespace pgame
 
 /--
 `pgame_state S` describes how to interpret `s : S` as a state of a combinatorial game.
-Use `pgame.of s` or `game.of s` to construct the game.
+Use `pgame.of_state s` or `game.of_state s` to construct the game.
 
 `pgame_state.L : S → finset S` and `pgame_state.R : S → finset S` describe the states reachable
 by a move by Left or Right. `pgame_state.turn_bound : S → ℕ` gives an upper bound on the number of
@@ -70,21 +73,21 @@ nat.le_of_lt_succ (nat.lt_of_lt_of_le (right_bound m) h)
 Construct a `pgame` from a state and a (not necessarily optimal) bound on the number of
 turns remaining.
 -/
-def of_aux : Π (n : ℕ) (s : S) (h : turn_bound s ≤ n), pgame
+def of_state_aux : Π (n : ℕ) (s : S) (h : turn_bound s ≤ n), pgame
 | 0 s h     := pgame.mk {t // t ∈ L s} {t // t ∈ R s}
     (λ t, begin exfalso, exact turn_bound_ne_zero_of_left_move t.2 (nonpos_iff_eq_zero.mp h) end)
     (λ t, begin exfalso, exact turn_bound_ne_zero_of_right_move t.2 (nonpos_iff_eq_zero.mp h) end)
 | (n+1) s h :=
   pgame.mk {t // t ∈ L s} {t // t ∈ R s}
-    (λ t, of_aux n t (turn_bound_of_left t.2 n h))
-    (λ t, of_aux n t (turn_bound_of_right t.2 n h))
+    (λ t, of_state_aux n t (turn_bound_of_left t.2 n h))
+    (λ t, of_state_aux n t (turn_bound_of_right t.2 n h))
 
 /-- Two different (valid) turn bounds give equivalent games. -/
-def of_aux_relabelling : Π (s : S) (n m : ℕ) (hn : turn_bound s ≤ n) (hm : turn_bound s ≤ m),
-  relabelling (of_aux n s hn) (of_aux m s hm)
+def of_state_aux_relabelling : Π (s : S) (n m : ℕ) (hn : turn_bound s ≤ n) (hm : turn_bound s ≤ m),
+  relabelling (of_state_aux n s hn) (of_state_aux m s hm)
 | s 0 0 hn hm :=
   begin
-    dsimp [pgame.of_aux],
+    dsimp [pgame.of_state_aux],
     fsplit, refl, refl,
     { intro i, dsimp at i, exfalso,
       exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp hn) },
@@ -93,7 +96,7 @@ def of_aux_relabelling : Π (s : S) (n m : ℕ) (hn : turn_bound s ≤ n) (hm :
   end
 | s 0 (m+1) hn hm :=
   begin
-    dsimp [pgame.of_aux],
+    dsimp [pgame.of_state_aux],
     fsplit, refl, refl,
     { intro i, dsimp at i, exfalso,
       exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp hn) },
@@ -102,7 +105,7 @@ def of_aux_relabelling : Π (s : S) (n m : ℕ) (hn : turn_bound s ≤ n) (hm :
   end
 | s (n+1) 0 hn hm :=
   begin
-    dsimp [pgame.of_aux],
+    dsimp [pgame.of_state_aux],
     fsplit, refl, refl,
     { intro i, dsimp at i, exfalso,
       exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp hm) },
@@ -111,52 +114,52 @@ def of_aux_relabelling : Π (s : S) (n m : ℕ) (hn : turn_bound s ≤ n) (hm :
   end
 | s (n+1) (m+1) hn hm :=
   begin
-    dsimp [pgame.of_aux],
+    dsimp [pgame.of_state_aux],
     fsplit, refl, refl,
     { intro i,
-      apply of_aux_relabelling, },
+      apply of_state_aux_relabelling, },
     { intro j,
-      apply of_aux_relabelling, }
+      apply of_state_aux_relabelling, }
   end
 
 /-- Construct a combinatorial `pgame` from a state. -/
-def of (s : S) : pgame := of_aux (turn_bound s) s (refl _)
+def of_state (s : S) : pgame := of_state_aux (turn_bound s) s (refl _)
 
-/--
-The equivalence between `left_moves` for a `pgame` constructed using `of_aux _ s _`, and `L s`.
--/
-def left_moves_of_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n) :
-  left_moves (of_aux n s h) ≃ {t // t ∈ L s} :=
+/-- The equivalence between `left_moves` for a `pgame` constructed using `of_state_aux _ s _`, and
+`L s`. -/
+def left_moves_of_state_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n) :
+  left_moves (of_state_aux n s h) ≃ {t // t ∈ L s} :=
 by induction n; refl
-/--
-The equivalence between `left_moves` for a `pgame` constructed using `of s`, and `L s`.
--/
-def left_moves_of (s : S) : left_moves (of s) ≃ {t // t ∈ L s} :=
-left_moves_of_aux _ _
-/--
-The equivalence between `right_moves` for a `pgame` constructed using `of_aux _ s _`, and `R s`.
--/
-def right_moves_of_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n) :
-  right_moves (of_aux n s h) ≃ {t // t ∈ R s} :=
+
+/-- The equivalence between `left_moves` for a `pgame` constructed using `of_state s`, and `L s`. -/
+def left_moves_of_state (s : S) : left_moves (of_state s) ≃ {t // t ∈ L s} :=
+left_moves_of_state_aux _ _
+
+/-- The equivalence between `right_moves` for a `pgame` constructed using `of_state_aux _ s _`, and
+`R s`. -/
+def right_moves_of_state_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n) :
+  right_moves (of_state_aux n s h) ≃ {t // t ∈ R s} :=
 by induction n; refl
-/-- The equivalence between `right_moves` for a `pgame` constructed using `of s`, and `R s`. -/
-def right_moves_of (s : S) : right_moves (of s) ≃ {t // t ∈ R s} :=
-right_moves_of_aux _ _
+
+/-- The equivalence between `right_moves` for a `pgame` constructed using `of_state s`, and
+`R s`. -/
+def right_moves_of_state (s : S) : right_moves (of_state s) ≃ {t // t ∈ R s} :=
+right_moves_of_state_aux _ _
 
 /--
-The relabelling showing `move_left` applied to a game constructed using `of_aux`
-has itself been constructed using `of_aux`.
+The relabelling showing `move_left` applied to a game constructed using `of_state_aux`
+has itself been constructed using `of_state_aux`.
 -/
 def relabelling_move_left_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n)
-  (t : left_moves (of_aux n s h)) :
+  (t : left_moves (of_state_aux n s h)) :
   relabelling
-    (move_left (of_aux n s h) t)
-    (of_aux (n-1) (((left_moves_of_aux n h) t) : S)
-      ((turn_bound_of_left ((left_moves_of_aux n h) t).2 (n-1)
+    (move_left (of_state_aux n s h) t)
+    (of_state_aux (n-1) (((left_moves_of_state_aux n h) t) : S)
+      ((turn_bound_of_left ((left_moves_of_state_aux n h) t).2 (n-1)
         (nat.le_trans h le_tsub_add)))) :=
 begin
   induction n,
-  { have t' := (left_moves_of_aux 0 h) t,
+  { have t' := (left_moves_of_state_aux 0 h) t,
     exfalso, exact turn_bound_ne_zero_of_left_move t'.2 (nonpos_iff_eq_zero.mp h), },
   { refl },
 end
@@ -164,29 +167,29 @@ end
 The relabelling showing `move_left` applied to a game constructed using `of`
 has itself been constructed using `of`.
 -/
-def relabelling_move_left (s : S) (t : left_moves (of s)) :
+def relabelling_move_left (s : S) (t : left_moves (of_state s)) :
   relabelling
-    (move_left (of s) t)
-    (of (((left_moves_of s).to_fun t) : S)) :=
+    (move_left (of_state s) t)
+    (of_state (((left_moves_of_state s).to_fun t) : S)) :=
 begin
   transitivity,
   apply relabelling_move_left_aux,
-  apply of_aux_relabelling,
+  apply of_state_aux_relabelling,
 end
 /--
-The relabelling showing `move_right` applied to a game constructed using `of_aux`
-has itself been constructed using `of_aux`.
+The relabelling showing `move_right` applied to a game constructed using `of_state_aux`
+has itself been constructed using `of_state_aux`.
 -/
 def relabelling_move_right_aux (n : ℕ) {s : S} (h : turn_bound s ≤ n)
-  (t : right_moves (of_aux n s h)) :
+  (t : right_moves (of_state_aux n s h)) :
   relabelling
-    (move_right (of_aux n s h) t)
-    (of_aux (n-1) (((right_moves_of_aux n h) t) : S)
-      ((turn_bound_of_right ((right_moves_of_aux n h) t).2 (n-1)
+    (move_right (of_state_aux n s h) t)
+    (of_state_aux (n-1) (((right_moves_of_state_aux n h) t) : S)
+      ((turn_bound_of_right ((right_moves_of_state_aux n h) t).2 (n-1)
         (nat.le_trans h le_tsub_add)))) :=
 begin
   induction n,
-  { have t' := (right_moves_of_aux 0 h) t,
+  { have t' := (right_moves_of_state_aux 0 h) t,
     exfalso, exact turn_bound_ne_zero_of_right_move t'.2 (nonpos_iff_eq_zero.mp h), },
   { refl },
 end
@@ -194,50 +197,50 @@ end
 The relabelling showing `move_right` applied to a game constructed using `of`
 has itself been constructed using `of`.
 -/
-def relabelling_move_right (s : S) (t : right_moves (of s)) :
+def relabelling_move_right (s : S) (t : right_moves (of_state s)) :
   relabelling
-    (move_right (of s) t)
-    (of (((right_moves_of s).to_fun t) : S)) :=
+    (move_right (of_state s) t)
+    (of_state (((right_moves_of_state s).to_fun t) : S)) :=
 begin
   transitivity,
   apply relabelling_move_right_aux,
-  apply of_aux_relabelling,
+  apply of_state_aux_relabelling,
 end
 
-instance fintype_left_moves_of_aux (n : ℕ) (s : S) (h : turn_bound s ≤ n) :
-  fintype (left_moves (of_aux n s h)) :=
+instance fintype_left_moves_of_state_aux (n : ℕ) (s : S) (h : turn_bound s ≤ n) :
+  fintype (left_moves (of_state_aux n s h)) :=
 begin
-  apply fintype.of_equiv _ (left_moves_of_aux _ _).symm,
+  apply fintype.of_equiv _ (left_moves_of_state_aux _ _).symm,
   apply_instance,
 end
-instance fintype_right_moves_of_aux (n : ℕ) (s : S) (h : turn_bound s ≤ n) :
-  fintype (right_moves (of_aux n s h)) :=
+instance fintype_right_moves_of_state_aux (n : ℕ) (s : S) (h : turn_bound s ≤ n) :
+  fintype (right_moves (of_state_aux n s h)) :=
 begin
-  apply fintype.of_equiv _ (right_moves_of_aux _ _).symm,
+  apply fintype.of_equiv _ (right_moves_of_state_aux _ _).symm,
   apply_instance,
 end
 
-instance short_of_aux : Π (n : ℕ) {s : S} (h : turn_bound s ≤ n), short (of_aux n s h)
+instance short_of_state_aux : Π (n : ℕ) {s : S} (h : turn_bound s ≤ n), short (of_state_aux n s h)
 | 0 s h :=
   short.mk'
   (λ i, begin
-    have i := (left_moves_of_aux _ _).to_fun i,
+    have i := (left_moves_of_state_aux _ _).to_fun i,
     exfalso,
     exact turn_bound_ne_zero_of_left_move i.2 (nonpos_iff_eq_zero.mp h),
   end)
   (λ j, begin
-    have j := (right_moves_of_aux _ _).to_fun j,
+    have j := (right_moves_of_state_aux _ _).to_fun j,
     exfalso,
     exact turn_bound_ne_zero_of_right_move j.2 (nonpos_iff_eq_zero.mp h),
   end)
 | (n+1) s h :=
   short.mk'
-  (λ i, short_of_relabelling (relabelling_move_left_aux (n+1) h i).symm (short_of_aux n _))
-  (λ j, short_of_relabelling (relabelling_move_right_aux (n+1) h j).symm (short_of_aux n _))
+  (λ i, short_of_relabelling (relabelling_move_left_aux (n+1) h i).symm (short_of_state_aux n _))
+  (λ j, short_of_relabelling (relabelling_move_right_aux (n+1) h j).symm (short_of_state_aux n _))
 
-instance short_of (s : S) : short (of s) :=
+instance short_of_state (s : S) : short (of_state s) :=
 begin
-  dsimp [pgame.of],
+  dsimp [pgame.of_state],
   apply_instance
 end
 
@@ -246,6 +249,6 @@ end pgame
 namespace game
 
 /-- Construct a combinatorial `game` from a state. -/
-def of {S : Type u} [pgame.state S] (s : S) : game := ⟦pgame.of s⟧
+def of_state {S : Type u} [pgame.state S] (s : S) : game := ⟦pgame.of_state s⟧
 
 end game
diff --git a/src/set_theory/game/winner.lean b/src/set_theory/game/winner.lean
deleted file mode 100644
index 1ba90d07d27ac..0000000000000
--- a/src/set_theory/game/winner.lean
+++ /dev/null
@@ -1,81 +0,0 @@
-/-
-Copyright (c) 2020 Fox Thomson. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Fox Thomson
--/
-import set_theory.game.pgame
-
-/-!
-# Basic definitions about who has a winning stratergy
-
-We define `G.first_loses`, `G.first_wins`, `G.left_wins` and `G.right_wins` for a pgame `G`, which
-means the second, first, left and right players have a winning strategy respectively.
-These are defined by inequalities which can be unfolded with `pgame.lt_def` and `pgame.le_def`.
--/
-
-namespace pgame
-
-local infix ` ≈ ` := equiv
-
-/-- The player who goes first loses -/
-def first_loses (G : pgame) : Prop := G ≤ 0 ∧ 0 ≤ G
-
-/-- The player who goes first wins -/
-def first_wins (G : pgame) : Prop := 0 < G ∧ G < 0
-
-/-- The left player can always win -/
-def left_wins (G : pgame) : Prop := 0 < G ∧ 0 ≤ G
-
-/-- The right player can always win -/
-def right_wins (G : pgame) : Prop := G ≤ 0 ∧ G < 0
-
-theorem zero_first_loses : first_loses 0 := by tidy
-theorem one_left_wins : left_wins 1 :=
-⟨by { rw lt_def_le, tidy }, by rw le_def; tidy⟩
-
-theorem star_first_wins : first_wins star := ⟨zero_lt_star, star_lt_zero⟩
-
-lemma winner_cases (G : pgame) : G.left_wins ∨ G.right_wins ∨ G.first_loses ∨ G.first_wins :=
-begin
-  classical,
-  by_cases hpos : 0 < G;
-  by_cases hneg : G < 0;
-  { try { rw not_lt at hpos },
-    try { rw not_lt at hneg },
-    try { left, exact ⟨hpos, hneg⟩ },
-    try { right, left, exact ⟨hpos, hneg⟩ },
-    try { right, right, left, exact ⟨hpos, hneg⟩ },
-    try { right, right, right, exact ⟨hpos, hneg⟩ } }
-end
-
-lemma first_loses_is_zero {G : pgame} : G.first_loses ↔ G ≈ 0 := by refl
-
-lemma first_loses_of_equiv {G H : pgame} (h : G ≈ H) : G.first_loses → H.first_loses :=
-λ hGp, ⟨le_of_equiv_of_le h.symm hGp.1, le_of_le_of_equiv hGp.2 h⟩
-lemma first_wins_of_equiv {G H : pgame} (h : G ≈ H) : G.first_wins → H.first_wins :=
-λ hGn, ⟨lt_of_lt_of_equiv hGn.1 h, lt_of_equiv_of_lt h.symm hGn.2⟩
-lemma left_wins_of_equiv {G H : pgame} (h : G ≈ H) : G.left_wins → H.left_wins :=
-λ hGl, ⟨lt_of_lt_of_equiv hGl.1 h, le_of_le_of_equiv hGl.2 h⟩
-lemma right_wins_of_equiv {G H : pgame} (h : G ≈ H) : G.right_wins → H.right_wins :=
-λ hGr, ⟨le_of_equiv_of_le h.symm hGr.1, lt_of_equiv_of_lt h.symm hGr.2⟩
-
-lemma first_loses_of_equiv_iff {G H : pgame} (h : G ≈ H) : G.first_loses ↔ H.first_loses :=
-⟨first_loses_of_equiv h, first_loses_of_equiv h.symm⟩
-lemma first_wins_of_equiv_iff {G H : pgame} (h : G ≈ H) : G.first_wins ↔ H.first_wins :=
-⟨first_wins_of_equiv h, first_wins_of_equiv h.symm⟩
-lemma left_wins_of_equiv_iff {G H : pgame} (h : G ≈ H) : G.left_wins ↔ H.left_wins :=
-⟨left_wins_of_equiv h, left_wins_of_equiv h.symm⟩
-lemma right_wins_of_equiv_iff {G H : pgame} (h : G ≈ H) : G.right_wins ↔ H.right_wins :=
-⟨right_wins_of_equiv h, right_wins_of_equiv h.symm⟩
-
-lemma not_first_wins_of_first_loses {G : pgame} : G.first_loses → ¬G.first_wins :=
-begin
-  rw first_loses_is_zero,
-  rintros h ⟨h₀, -⟩,
-  exact pgame.lt_irrefl 0 (lt_of_lt_of_equiv h₀ h)
-end
-
-lemma not_first_loses_of_first_wins {G : pgame} : G.first_wins → ¬G.first_loses :=
-imp_not_comm.1 $ not_first_wins_of_first_loses
-
-end pgame
diff --git a/src/set_theory/lists.lean b/src/set_theory/lists.lean
index c4de76367937c..c45a4fb7c6d2b 100644
--- a/src/set_theory/lists.lean
+++ b/src/set_theory/lists.lean
@@ -8,12 +8,15 @@ import data.list.basic
 /-!
 # A computable model of ZFA without infinity
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define finite hereditary lists. This is useful for calculations in naive set theory.
 
 We distinguish two kinds of ZFA lists:
 * Atoms. Directly correspond to an element of the original type.
-* Proper ZFA lists. Can thought of (but aren't implemented) as a list of ZFA lists (not necessarily
-  proper).
+* Proper ZFA lists. Can be thought of (but aren't implemented) as a list of ZFA lists (not
+  necessarily proper).
 
 For example, `lists ℕ` contains stuff like `23`, `[]`, `[37]`, `[1, [[2], 3], 4]`.
 
@@ -34,11 +37,8 @@ This calls for a two-steps definition of ZFA lists:
 * `lists' α tt`: Proper ZFA prelists. Defined inductively from the empty ZFA prelist (`lists'.nil`)
   and from appending a ZFA prelist to a proper ZFA prelist (`lists'.cons a l`).
 * `lists α`: ZFA lists. Sum of the atoms and proper ZFA prelists.
-
-## TODO
-
-The next step is to define ZFA sets as lists quotiented by `lists.equiv`.
-(-/
+* `finsets`: ZFA sets. Defined as `lists` quotiented by `lists.equiv`, the extensional equivalence.
+-/
 
 variables {α : Type*}
 
diff --git a/src/set_theory/ordinal/arithmetic.lean b/src/set_theory/ordinal/arithmetic.lean
index 307423455de80..daeab4abbea76 100644
--- a/src/set_theory/ordinal/arithmetic.lean
+++ b/src/set_theory/ordinal/arithmetic.lean
@@ -9,6 +9,9 @@ import tactic.by_contra
 /-!
 # Ordinal arithmetic
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Ordinals have an addition (corresponding to disjoint union) that turns them into an additive
 monoid, and a multiplication (corresponding to the lexicographic order on the product) that turns
 them into a monoid. One can also define correspondingly a subtraction, a division, a successor
@@ -25,11 +28,11 @@ successor ordinals and limit ordinals, in `limit_rec_on`.
 * `o₁ * o₂` is the lexicographic order on `o₂ × o₁`.
 * `o₁ / o₂` is the ordinal `o` such that `o₁ = o₂ * o + o'` with `o' < o₂`. We also define the
   divisibility predicate, and a modulo operation.
-* `succ o = o + 1` is the successor of `o`.
+* `order.succ o = o + 1` is the successor of `o`.
 * `pred o` if the predecessor of `o`. If `o` is not a successor, we set `pred o = o`.
 
-We also define the power function and the logarithm function on ordinals, and discuss the properties
-of casts of natural numbers of and of `omega` with respect to these operations.
+We discuss the properties of casts of natural numbers of and of `ω` with respect to these
+operations.
 
 Some properties of the operations are also used to discuss general tools on ordinals:
 
@@ -40,7 +43,6 @@ Some properties of the operations are also used to discuss general tools on ordi
   and order-continuous, i.e., the image `f o` of a limit ordinal `o` is the sup of `f a` for
   `a < o`.
 * `enum_ord`: enumerates an unbounded set of ordinals by the ordinals themselves.
-* `CNF b o` is the Cantor normal form of the ordinal `o` in base `b`.
 * `sup`, `lsub`: the supremum / least strict upper bound of an indexed family of ordinals in
   `Type u`, as an ordinal in `Type u`.
 * `bsup`, `blsub`: the supremum / least strict upper bound of a set of ordinals indexed by ordinals
@@ -51,14 +53,14 @@ Various other basic arithmetic results are given in `principal.lean` instead.
 
 noncomputable theory
 
-open function cardinal set equiv
-open_locale classical cardinal
+open function cardinal set equiv order
+open_locale classical cardinal ordinal
 
 universes u v w
-variables {α : Type*} {β : Type*} {γ : Type*}
-  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
 
 namespace ordinal
+variables {α : Type*} {β : Type*} {γ : Type*}
+  {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
 
 /-! ### Further properties of addition on ordinals -/
 
@@ -69,9 +71,9 @@ quotient.sound ⟨(rel_iso.preimage equiv.ulift _).trans
    (rel_iso.preimage equiv.ulift _)).symm⟩
 
 @[simp] theorem lift_succ (a) : lift (succ a) = succ (lift a) :=
-by unfold succ; simp only [lift_add, lift_one]
+by { rw [←add_one_eq_succ, lift_add, lift_one], refl }
 
-instance has_le.le.add_contravariant_class : contravariant_class ordinal.{u} ordinal.{u} (+) (≤) :=
+instance add_contravariant_class_le : contravariant_class ordinal.{u} ordinal.{u} (+) (≤) :=
 ⟨λ a b c, induction_on a $ λ α r hr, induction_on b $ λ β₁ s₁ hs₁, induction_on c $ λ β₂ s₂ hs₂ ⟨f⟩,
   ⟨have fl : ∀ a, f (sum.inl a) = sum.inl a := λ a,
     by simpa only [initial_seg.trans_apply, initial_seg.le_add_apply]
@@ -87,126 +89,40 @@ instance has_le.le.add_contravariant_class : contravariant_class ordinal.{u} ord
   ⟨⟨⟨g, λ x y h, by injection f.inj'
     (by rw [fr, fr, h] : f (sum.inr x) = f (sum.inr y))⟩,
     λ a b, by simpa only [sum.lex_inr_inr, fr, rel_embedding.coe_fn_to_embedding,
-        initial_seg.coe_fn_to_rel_embedding, function.embedding.coe_fn_mk]
+        initial_seg.coe_fn_to_rel_embedding, embedding.coe_fn_mk]
       using @rel_embedding.map_rel_iff _ _ _ _ f.to_rel_embedding (sum.inr a) (sum.inr b)⟩,
     λ a b H, begin
-      rcases f.init' (by rw fr; exact sum.lex_inr_inr.2 H) with ⟨a'|a', h⟩,
+      rcases f.init (by rw fr; exact sum.lex_inr_inr.2 H) with ⟨a'|a', h⟩,
       { rw fl at h, cases h },
       { rw fr at h, exact ⟨a', sum.inr.inj h⟩ }
     end⟩⟩⟩
 
-theorem add_succ (o₁ o₂ : ordinal) : o₁ + succ o₂ = succ (o₁ + o₂) :=
-(add_assoc _ _ _).symm
-
-@[simp] theorem succ_zero : succ 0 = 1 := zero_add _
-
-theorem one_le_iff_pos {o : ordinal} : 1 ≤ o ↔ 0 < o :=
-by rw [← succ_zero, succ_le]
-
-theorem one_le_iff_ne_zero {o : ordinal} : 1 ≤ o ↔ o ≠ 0 :=
-by rw [one_le_iff_pos, ordinal.pos_iff_ne_zero]
-
-theorem succ_pos (o : ordinal) : 0 < succ o :=
-lt_of_le_of_lt (ordinal.zero_le _) (lt_succ_self _)
-
-theorem succ_ne_zero (o : ordinal) : succ o ≠ 0 :=
-ne_of_gt $ succ_pos o
-
-@[simp] theorem card_succ (o : ordinal) : card (succ o) = card o + 1 :=
-by simp only [succ, card_add, card_one]
-
-theorem nat_cast_succ (n : ℕ) : (succ n : ordinal) = n.succ := rfl
-
 theorem add_left_cancel (a) {b c : ordinal} : a + b = a + c ↔ b = c :=
 by simp only [le_antisymm_iff, add_le_add_iff_left]
 
-theorem lt_one_iff_zero {a : ordinal} : a < 1 ↔ a = 0 :=
-by rw [←succ_zero, lt_succ, ordinal.le_zero]
-
 private theorem add_lt_add_iff_left' (a) {b c : ordinal} : a + b < a + c ↔ b < c :=
 by rw [← not_le, ← not_le, add_le_add_iff_left]
 
-instance : covariant_class ordinal.{u} ordinal.{u} (+) (<) :=
+instance add_covariant_class_lt : covariant_class ordinal.{u} ordinal.{u} (+) (<) :=
 ⟨λ a b c, (add_lt_add_iff_left' a).2⟩
 
-instance : contravariant_class ordinal.{u} ordinal.{u} (+) (<) :=
+instance add_contravariant_class_lt : contravariant_class ordinal.{u} ordinal.{u} (+) (<) :=
 ⟨λ a b c, (add_lt_add_iff_left' a).1⟩
 
-theorem lt_of_add_lt_add_right {a b c : ordinal} : a + b < c + b → a < c :=
-lt_imp_lt_of_le_imp_le (λ h, add_le_add_right h _)
-
-@[simp] theorem succ_lt_succ {a b : ordinal} : succ a < succ b ↔ a < b :=
-by rw [lt_succ, succ_le]
-
-@[simp] theorem succ_le_succ {a b : ordinal} : succ a ≤ succ b ↔ a ≤ b :=
-le_iff_le_iff_lt_iff_lt.2 succ_lt_succ
+instance add_swap_contravariant_class_lt :
+  contravariant_class ordinal.{u} ordinal.{u} (swap (+)) (<) :=
+⟨λ a b c, lt_imp_lt_of_le_imp_le (λ h, add_le_add_right h _)⟩
 
-theorem succ_inj {a b : ordinal} : succ a = succ b ↔ a = b :=
-by simp only [le_antisymm_iff, succ_le_succ]
-
-theorem add_le_add_iff_right {a b : ordinal} (n : ℕ) : a + n ≤ b + n ↔ a ≤ b :=
-by induction n with n ih; [rw [nat.cast_zero, add_zero, add_zero],
-  rw [← nat_cast_succ, add_succ, add_succ, succ_le_succ, ih]]
+theorem add_le_add_iff_right {a b : ordinal} : ∀ n : ℕ, a + n ≤ b + n ↔ a ≤ b
+| 0     := by simp
+| (n+1) := by rw [nat_cast_succ, add_succ, add_succ, succ_le_succ_iff, add_le_add_iff_right]
 
 theorem add_right_cancel {a b : ordinal} (n : ℕ) : a + n = b + n ↔ a = b :=
 by simp only [le_antisymm_iff, add_le_add_iff_right]
 
-/-! ### The zero ordinal -/
-
-@[simp] theorem card_eq_zero {o} : card o = 0 ↔ o = 0 :=
-⟨induction_on o $ λ α r _ h, begin
-  refine le_antisymm (le_of_not_lt $
-    λ hn, mk_ne_zero_iff.2 _ h) (ordinal.zero_le _),
-  rw [← succ_le, succ_zero] at hn, cases hn with f,
-  exact ⟨f punit.star⟩
-end, λ e, by simp only [e, card_zero]⟩
-
-@[simp] theorem type_eq_zero_of_empty [is_well_order α r] [is_empty α] : type r = 0 :=
-card_eq_zero.symm.mpr (mk_eq_zero _)
-
-@[simp] theorem type_eq_zero_iff_is_empty [is_well_order α r] : type r = 0 ↔ is_empty α :=
-(@card_eq_zero (type r)).symm.trans mk_eq_zero_iff
-
-theorem type_ne_zero_iff_nonempty [is_well_order α r] : type r ≠ 0 ↔ nonempty α :=
-(not_congr (@card_eq_zero (type r))).symm.trans mk_ne_zero_iff
-
-protected lemma one_ne_zero : (1 : ordinal) ≠ 0 :=
-type_ne_zero_iff_nonempty.2 ⟨punit.star⟩
-
-instance : nontrivial ordinal.{u} :=
-⟨⟨1, 0, ordinal.one_ne_zero⟩⟩
-
-@[simp] theorem zero_lt_one : (0 : ordinal) < 1 :=
-lt_iff_le_and_ne.2 ⟨ordinal.zero_le _, ne.symm $ ordinal.one_ne_zero⟩
-
-instance : unique (1 : ordinal).out.α :=
-{ default := enum (<) 0 (by simp),
-  uniq := λ a, begin
-    rw ←enum_typein (<) a,
-    unfold default,
-    congr,
-    rw ←lt_one_iff_zero,
-    apply typein_lt_self
-  end }
-
-theorem one_out_eq (x : (1 : ordinal).out.α) : x = enum (<) 0 (by simp) :=
-unique.eq_default x
-
-@[simp] theorem typein_one_out (x : (1 : ordinal).out.α) : typein (<) x = 0 :=
-by rw [one_out_eq x, typein_enum]
-
-theorem le_one_iff {a : ordinal} : a ≤ 1 ↔ a = 0 ∨ a = 1 :=
-begin
-  refine ⟨λ ha, _, _⟩,
-  { rcases eq_or_lt_of_le ha with rfl | ha,
-    exacts [or.inr rfl, or.inl (lt_one_iff_zero.1 ha)], },
-  { rintro (rfl | rfl),
-    exacts [le_of_lt zero_lt_one, le_refl _], }
-end
-
 theorem add_eq_zero_iff {a b : ordinal} : a + b = 0 ↔ (a = 0 ∧ b = 0) :=
 induction_on a $ λ α r _, induction_on b $ λ β s _, begin
-  simp_rw [type_add, type_eq_zero_iff_is_empty],
+  simp_rw [←type_sum_lex, type_eq_zero_iff_is_empty],
   exact is_empty_sum
 end
 
@@ -220,36 +136,41 @@ theorem right_eq_zero_of_add_eq_zero {a b : ordinal} (h : a + b = 0) : b = 0 :=
 
 /-- The ordinal predecessor of `o` is `o'` if `o = succ o'`,
   and `o` otherwise. -/
-def pred (o : ordinal.{u}) : ordinal.{u} :=
+def pred (o : ordinal) : ordinal :=
 if h : ∃ a, o = succ a then classical.some h else o
 
 @[simp] theorem pred_succ (o) : pred (succ o) = o :=
 by have h : ∃ a, succ o = succ a := ⟨_, rfl⟩;
-   simpa only [pred, dif_pos h] using (succ_inj.1 $ classical.some_spec h).symm
+   simpa only [pred, dif_pos h] using (succ_injective $ classical.some_spec h).symm
 
 theorem pred_le_self (o) : pred o ≤ o :=
 if h : ∃ a, o = succ a then let ⟨a, e⟩ := h in
-by rw [e, pred_succ]; exact le_of_lt (lt_succ_self _)
+by rw [e, pred_succ]; exact le_succ a
 else by rw [pred, dif_neg h]
 
 theorem pred_eq_iff_not_succ {o} : pred o = o ↔ ¬ ∃ a, o = succ a :=
-⟨λ e ⟨a, e'⟩, by rw [e', pred_succ] at e; exact ne_of_lt (lt_succ_self _) e,
+⟨λ e ⟨a, e'⟩, by rw [e', pred_succ] at e; exact (lt_succ a).ne e,
  λ h, dif_neg h⟩
 
+theorem pred_eq_iff_not_succ' {o} : pred o = o ↔ ∀ a, o ≠ succ a :=
+by simpa using pred_eq_iff_not_succ
+
 theorem pred_lt_iff_is_succ {o} : pred o < o ↔ ∃ a, o = succ a :=
 iff.trans (by simp only [le_antisymm_iff, pred_le_self, true_and, not_le])
   (iff_not_comm.1 pred_eq_iff_not_succ).symm
 
+@[simp] theorem pred_zero : pred 0 = 0 :=
+pred_eq_iff_not_succ'.2 $ λ a, (succ_ne_zero a).symm
+
 theorem succ_pred_iff_is_succ {o} : succ (pred o) = o ↔ ∃ a, o = succ a :=
 ⟨λ e, ⟨_, e.symm⟩, λ ⟨a, e⟩, by simp only [e, pred_succ]⟩
 
-theorem succ_lt_of_not_succ {o} (h : ¬ ∃ a, o = succ a) {b} : succ b < o ↔ b < o :=
-⟨lt_trans (lt_succ_self _), λ l,
-  lt_of_le_of_ne (succ_le.2 l) (λ e, h ⟨_, e.symm⟩)⟩
+theorem succ_lt_of_not_succ {o b : ordinal} (h : ¬ ∃ a, o = succ a) : succ b < o ↔ b < o :=
+⟨(lt_succ b).trans, λ l, lt_of_le_of_ne (succ_le_of_lt l) (λ e, h ⟨_, e.symm⟩)⟩
 
 theorem lt_pred {a b} : a < pred b ↔ succ a < b :=
 if h : ∃ a, b = succ a then let ⟨c, e⟩ := h in
-by rw [e, pred_succ, succ_lt_succ]
+by rw [e, pred_succ, succ_lt_succ_iff]
 else by simp only [pred, dif_neg h, succ_lt_of_not_succ h]
 
 theorem pred_le {a b} : pred a ≤ b ↔ a ≤ succ b :=
@@ -258,7 +179,7 @@ le_iff_le_iff_lt_iff_lt.2 lt_pred
 @[simp] theorem lift_is_succ {o} : (∃ a, lift o = succ a) ↔ (∃ a, o = succ a) :=
 ⟨λ ⟨a, h⟩,
   let ⟨b, e⟩ := lift_down $ show a ≤ lift o, from le_of_lt $
-    h.symm ▸ lt_succ_self _ in
+    h.symm ▸ lt_succ a in
   ⟨b, lift_inj.1 $ by rw [h, ← e, lift_succ]⟩,
  λ ⟨a, h⟩, ⟨lift a, by simp only [h, lift_succ]⟩⟩
 
@@ -273,25 +194,28 @@ else by rw [pred_eq_iff_not_succ.2 h,
 /-- A limit ordinal is an ordinal which is not zero and not a successor. -/
 def is_limit (o : ordinal) : Prop := o ≠ 0 ∧ ∀ a < o, succ a < o
 
+theorem is_limit.succ_lt {o a : ordinal} (h : is_limit o) : a < o → succ a < o :=
+h.2 a
+
 theorem not_zero_is_limit : ¬ is_limit 0
 | ⟨h, _⟩ := h rfl
 
 theorem not_succ_is_limit (o) : ¬ is_limit (succ o)
-| ⟨_, h⟩ := lt_irrefl _ (h _ (lt_succ_self _))
+| ⟨_, h⟩ := lt_irrefl _ (h _ (lt_succ o))
 
 theorem not_succ_of_is_limit {o} (h : is_limit o) : ¬ ∃ a, o = succ a
 | ⟨a, e⟩ := not_succ_is_limit a (e ▸ h)
 
-theorem succ_lt_of_is_limit {o} (h : is_limit o) {a} : succ a < o ↔ a < o :=
-⟨lt_trans (lt_succ_self _), h.2 _⟩
+theorem succ_lt_of_is_limit {o a : ordinal} (h : is_limit o) : succ a < o ↔ a < o :=
+⟨(lt_succ a).trans, h.2 _⟩
 
 theorem le_succ_of_is_limit {o} (h : is_limit o) {a} : o ≤ succ a ↔ o ≤ a :=
 le_iff_le_iff_lt_iff_lt.2 $ succ_lt_of_is_limit h
 
 theorem limit_le {o} (h : is_limit o) {a} : o ≤ a ↔ ∀ x < o, x ≤ a :=
-⟨λ h x l, le_trans (le_of_lt l) h,
+⟨λ h x l, l.le.trans h,
  λ H, (le_succ_of_is_limit h).1 $ le_of_not_lt $ λ hn,
-  not_lt_of_le (H _ hn) (lt_succ_self _)⟩
+  not_lt_of_le (H _ hn) (lt_succ a)⟩
 
 theorem lt_limit {o} (h : is_limit o) {a} : a < o ↔ ∃ x < o, a < x :=
 by simpa only [not_ball, not_le] using not_congr (@limit_le _ h a)
@@ -299,9 +223,11 @@ by simpa only [not_ball, not_le] using not_congr (@limit_le _ h a)
 @[simp] theorem lift_is_limit (o) : is_limit (lift o) ↔ is_limit o :=
 and_congr (not_congr $ by simpa only [lift_zero] using @lift_inj o 0)
 ⟨λ H a h, lift_lt.1 $ by simpa only [lift_succ] using H _ (lift_lt.2 h),
- λ H a h, let ⟨a', e⟩ := lift_down (le_of_lt h) in
-   by rw [← e, ← lift_succ, lift_lt];
-      rw [← e, lift_lt] at h; exact H a' h⟩
+ λ H a h, begin
+   obtain ⟨a', rfl⟩ := lift_down h.le,
+   rw [←lift_succ, lift_lt],
+   exact H a' (lift_lt.1 h)
+ end⟩
 
 theorem is_limit.pos {o : ordinal} (h : is_limit o) : 0 < o :=
 lt_of_le_of_ne (ordinal.zero_le _) h.1.symm
@@ -324,7 +250,7 @@ or.inr $ or.inr ⟨o0, λ a, (succ_lt_of_not_succ h).2⟩
 @[elab_as_eliminator] def limit_rec_on {C : ordinal → Sort*}
   (o : ordinal) (H₁ : C 0) (H₂ : ∀ o, C o → C (succ o))
   (H₃ : ∀ o, is_limit o → (∀ o' < o, C o') → C o) : C o :=
-wf.fix (λ o IH,
+lt_wf.fix (λ o IH,
   if o0 : o = 0 then by rw o0; exact H₁ else
   if h : ∃ a, o = succ a then
     by rw ← succ_pred_iff_is_succ.2 h; exact
@@ -332,13 +258,13 @@ wf.fix (λ o IH,
   else H₃ _ ⟨o0, λ a, (succ_lt_of_not_succ h).2⟩ IH) o
 
 @[simp] theorem limit_rec_on_zero {C} (H₁ H₂ H₃) : @limit_rec_on C 0 H₁ H₂ H₃ = H₁ :=
-by rw [limit_rec_on, wf.fix_eq, dif_pos rfl]; refl
+by rw [limit_rec_on, lt_wf.fix_eq, dif_pos rfl]; refl
 
 @[simp] theorem limit_rec_on_succ {C} (o H₁ H₂ H₃) :
   @limit_rec_on C (succ o) H₁ H₂ H₃ = H₂ o (@limit_rec_on C o H₁ H₂ H₃) :=
 begin
   have h : ∃ a, succ o = succ a := ⟨_, rfl⟩,
-  rw [limit_rec_on, wf.fix_eq, dif_neg (succ_ne_zero o), dif_pos h],
+  rw [limit_rec_on, lt_wf.fix_eq, dif_neg (succ_ne_zero o), dif_pos h],
   generalize : limit_rec_on._proof_2 (succ o) h = h₂,
   generalize : limit_rec_on._proof_3 (succ o) h = h₃,
   revert h₂ h₃, generalize e : pred (succ o) = o', intros,
@@ -347,31 +273,42 @@ end
 
 @[simp] theorem limit_rec_on_limit {C} (o H₁ H₂ H₃ h) :
   @limit_rec_on C o H₁ H₂ H₃ = H₃ o h (λ x h, @limit_rec_on C x H₁ H₂ H₃) :=
-by rw [limit_rec_on, wf.fix_eq, dif_neg h.1, dif_neg (not_succ_of_is_limit h)]; refl
+by rw [limit_rec_on, lt_wf.fix_eq, dif_neg h.1, dif_neg (not_succ_of_is_limit h)]; refl
 
-instance (o : ordinal) : order_top o.succ.out.α :=
+instance order_top_out_succ (o : ordinal) : order_top (succ o).out.α :=
 ⟨_, le_enum_succ⟩
 
 theorem enum_succ_eq_top {o : ordinal} :
-  enum (<) o (by { rw type_lt, apply lt_succ_self }) = (⊤ : o.succ.out.α) :=
+  enum (<) o (by { rw type_lt, exact lt_succ o }) = (⊤ : (succ o).out.α) :=
 rfl
 
 lemma has_succ_of_type_succ_lt {α} {r : α → α → Prop} [wo : is_well_order α r]
   (h : ∀ a < type r, succ a < type r) (x : α) : ∃ y, r x y :=
 begin
-  use enum r (typein r x).succ (h _ (typein_lt_type r x)),
-  convert (enum_lt_enum (typein_lt_type r x) _).mpr (lt_succ_self _), rw [enum_typein]
+  use enum r (succ (typein r x)) (h _ (typein_lt_type r x)),
+  convert (enum_lt_enum (typein_lt_type r x) _).mpr (lt_succ _), rw [enum_typein]
 end
 
 theorem out_no_max_of_succ_lt {o : ordinal} (ho : ∀ a < o, succ a < o) : no_max_order o.out.α :=
 ⟨has_succ_of_type_succ_lt (by rwa type_lt)⟩
 
+lemma bounded_singleton {r : α → α → Prop} [is_well_order α r] (hr : (type r).is_limit) (x) :
+  bounded r {x} :=
+begin
+  refine ⟨enum r (succ (typein r x)) (hr.2 _ (typein_lt_type r x)), _⟩,
+  intros b hb,
+  rw mem_singleton_iff.1 hb,
+  nth_rewrite 0 ←enum_typein r x,
+  rw @enum_lt_enum _ r,
+  apply lt_succ
+end
+
 lemma type_subrel_lt (o : ordinal.{u}) :
   type (subrel (<) {o' : ordinal | o' < o}) = ordinal.lift.{u+1} o :=
 begin
   refine quotient.induction_on o _,
   rintro ⟨α, r, wo⟩, resetI, apply quotient.sound,
-  constructor, symmetry, refine (rel_iso.preimage equiv.ulift r).trans (typein_iso r)
+  constructor, symmetry, refine (rel_iso.preimage equiv.ulift r).trans (enum_iso r).symm
 end
 
 lemma mk_initial_seg (o : ordinal.{u}) :
@@ -395,8 +332,8 @@ not_iff_not.1 $ by simpa only [exists_prop, not_exists, not_and, not_lt] using H
 
 theorem is_normal.strict_mono {f} (H : is_normal f) : strict_mono f :=
 λ a b, limit_rec_on b (not.elim (not_lt_of_le $ ordinal.zero_le _))
-  (λ b IH h, (lt_or_eq_of_le (lt_succ.1 h)).elim
-    (λ h, lt_trans (IH h) (H.1 _))
+  (λ b IH h, (lt_or_eq_of_le (le_of_lt_succ h)).elim
+    (λ h, (IH h).trans (H.1 _))
     (λ e, e ▸ H.1 _))
   (λ b l IH h, lt_of_lt_of_le (H.1 a)
     ((H.2 _ l _).1 le_rfl _ (l.2 _ h)))
@@ -406,7 +343,7 @@ H.strict_mono.monotone
 
 theorem is_normal_iff_strict_mono_limit (f : ordinal → ordinal) :
   is_normal f ↔ (strict_mono f ∧ ∀ o, is_limit o → ∀ a, (∀ b < o, f b ≤ a) → f o ≤ a) :=
-⟨λ hf, ⟨hf.strict_mono, λ a ha c, (hf.2 a ha c).2⟩, λ ⟨hs, hl⟩, ⟨λ a, hs (ordinal.lt_succ_self a),
+⟨λ hf, ⟨hf.strict_mono, λ a ha c, (hf.2 a ha c).2⟩, λ ⟨hs, hl⟩, ⟨λ a, hs (lt_succ a),
   λ a ha c, ⟨λ hac b hba, ((hs hba).trans_le hac).le, hl a ha c⟩⟩⟩
 
 theorem is_normal.lt_iff {f} (H : is_normal f) {a b} : f a < f b ↔ a < b :=
@@ -419,50 +356,40 @@ theorem is_normal.inj {f} (H : is_normal f) {a b} : f a = f b ↔ a = b :=
 by simp only [le_antisymm_iff, H.le_iff]
 
 theorem is_normal.self_le {f} (H : is_normal f) (a) : a ≤ f a :=
-wf.self_le_of_strict_mono H.strict_mono a
+lt_wf.self_le_of_strict_mono H.strict_mono a
 
-theorem is_normal.le_set {f} (H : is_normal f) (p : set ordinal) (p0 : p.nonempty) (b)
-  (H₂ : ∀ o, b ≤ o ↔ ∀ a ∈ p, a ≤ o) {o} : f b ≤ o ↔ ∀ a ∈ p, f a ≤ o :=
-⟨λ h a pa, (H.le_iff.2 ((H₂ _).1 (le_refl _) _ pa)).trans h,
+theorem is_normal.le_set {f o} (H : is_normal f) (p : set ordinal) (p0 : p.nonempty) (b)
+  (H₂ : ∀ o, b ≤ o ↔ ∀ a ∈ p, a ≤ o) : f b ≤ o ↔ ∀ a ∈ p, f a ≤ o :=
+⟨λ h a pa, (H.le_iff.2 ((H₂ _).1 le_rfl _ pa)).trans h,
 λ h, begin
   revert H₂, refine limit_rec_on b (λ H₂, _) (λ S _ H₂, _) (λ S L _ H₂, (H.2 _ L _).2 (λ a h', _)),
   { cases p0 with x px,
     have := ordinal.le_zero.1 ((H₂ _).1 (ordinal.zero_le _) _ px),
     rw this at px, exact h _ px },
-  { rcases not_ball.1 (mt (H₂ S).2 $ not_le_of_lt $ lt_succ_self _) with ⟨a, h₁, h₂⟩,
-    exact (H.le_iff.2 $ succ_le.2 $ not_le.1 h₂).trans (h _ h₁) },
-  { rcases not_ball.1 (mt (H₂ a).2 (not_le.2 h')) with ⟨b, h₁, h₂⟩,
-    exact (H.le_iff.2 $ le_of_lt $ not_le.1 h₂).trans (h _ h₁) }
+  { rcases not_ball.1 (mt (H₂ S).2 $ (lt_succ S).not_le) with ⟨a, h₁, h₂⟩,
+    exact (H.le_iff.2 $ succ_le_of_lt $ not_le.1 h₂).trans (h _ h₁) },
+  { rcases not_ball.1 (mt (H₂ a).2 h'.not_le) with ⟨b, h₁, h₂⟩,
+    exact (H.le_iff.2 $ (not_le.1 h₂).le).trans (h _ h₁) }
 end⟩
 
-theorem is_normal.le_set' {f} (H : is_normal f) (p : set α) (g : α → ordinal) (p0 : p.nonempty) (b)
-  (H₂ : ∀ o, b ≤ o ↔ ∀ a ∈ p, g a ≤ o) {o} : f b ≤ o ↔ ∀ a ∈ p, f (g a) ≤ o :=
-(H.le_set (λ x, ∃ y, p y ∧ x = g y)
-  (let ⟨x, px⟩ := p0 in ⟨_, _, px, rfl⟩) _
-  (λ o, (H₂ o).trans ⟨λ H a ⟨y, h1, h2⟩, h2.symm ▸ H y h1,
-    λ H a h1, H (g a) ⟨a, h1, rfl⟩⟩)).trans
-⟨λ H a h, H (g a) ⟨a, h, rfl⟩, λ H a ⟨y, h1, h2⟩, h2.symm ▸ H y h1⟩
-
-theorem is_normal.refl : is_normal id :=
-⟨λ x, lt_succ_self _, λ o l a, limit_le l⟩
-
-theorem is_normal.trans {f g} (H₁ : is_normal f) (H₂ : is_normal g) :
-  is_normal (λ x, f (g x)) :=
-⟨λ x, H₁.lt_iff.2 (H₂.1 _),
- λ o l a, H₁.le_set' (< o) g ⟨_, l.pos⟩ _ (λ c, H₂.2 _ l _)⟩
-
-theorem is_normal.is_limit {f} (H : is_normal f) {o} (l : is_limit o) :
-  is_limit (f o) :=
-⟨ne_of_gt $ lt_of_le_of_lt (ordinal.zero_le _) $ H.lt_iff.2 l.pos,
+theorem is_normal.le_set' {f o} (H : is_normal f) (p : set α) (p0 : p.nonempty) (g : α → ordinal)
+  (b) (H₂ : ∀ o, b ≤ o ↔ ∀ a ∈ p, g a ≤ o) : f b ≤ o ↔ ∀ a ∈ p, f (g a) ≤ o :=
+by simpa [H₂] using H.le_set (g '' p) (p0.image g) b
+
+theorem is_normal.refl : is_normal id := ⟨lt_succ, λ o l a, limit_le l⟩
+
+theorem is_normal.trans {f g} (H₁ : is_normal f) (H₂ : is_normal g) : is_normal (f ∘ g) :=
+⟨λ x, H₁.lt_iff.2 (H₂.1 _), λ o l a, H₁.le_set' (< o) ⟨_, l.pos⟩ g _ (λ c, H₂.2 _ l _)⟩
+
+theorem is_normal.is_limit {f} (H : is_normal f) {o} (l : is_limit o) : is_limit (f o) :=
+⟨ne_of_gt $ (ordinal.zero_le _).trans_lt $ H.lt_iff.2 l.pos,
 λ a h, let ⟨b, h₁, h₂⟩ := (H.limit_lt l).1 h in
-  lt_of_le_of_lt (succ_le.2 h₂) (H.lt_iff.2 h₁)⟩
+  (succ_le_of_lt h₂).trans_lt (H.lt_iff.2 h₁)⟩
 
-theorem is_normal.le_iff_eq {f} (H : is_normal f) {a} : f a ≤ a ↔ f a = a :=
-(H.self_le a).le_iff_eq
+theorem is_normal.le_iff_eq {f} (H : is_normal f) {a} : f a ≤ a ↔ f a = a := (H.self_le a).le_iff_eq
 
-theorem add_le_of_limit {a b c : ordinal.{u}}
-  (h : is_limit b) : a + b ≤ c ↔ ∀ b' < b, a + b' ≤ c :=
-⟨λ h b' l, le_trans (add_le_add_left (le_of_lt l) _) h,
+theorem add_le_of_limit {a b c : ordinal} (h : is_limit b) : a + b ≤ c ↔ ∀ b' < b, a + b' ≤ c :=
+⟨λ h b' l, (add_le_add_left l.le _).trans h,
 λ H, le_of_not_lt $
 induction_on a (λ α r _, induction_on b $ λ β s _ h H l, begin
   resetI,
@@ -471,11 +398,10 @@ induction_on a (λ α r _, induction_on b $ λ β s _ h H l, begin
     { cases this (enum s 0 h.pos) },
     { exact irrefl _ (this _) } },
   intros x,
-  rw [← typein_lt_typein (sum.lex r s), typein_enum],
+  rw [←typein_lt_typein (sum.lex r s), typein_enum],
   have := H _ (h.2 _ (typein_lt_type s x)),
-  rw [add_succ, succ_le] at this,
-  refine lt_of_le_of_lt (type_le'.2
-    ⟨rel_embedding.of_monotone (λ a, _) (λ a b, _)⟩) this,
+  rw [add_succ, succ_le_iff] at this,
+  refine (rel_embedding.of_monotone (λ a, _) (λ a b, _)).ordinal_type_le.trans_lt this,
   { rcases a with ⟨a | b, h⟩,
     { exact sum.inl a },
     { exact sum.inr ⟨b, by cases h; assumption⟩ } },
@@ -484,29 +410,28 @@ induction_on a (λ α r _, induction_on b $ λ β s _ h H l, begin
 end) h H⟩
 
 theorem add_is_normal (a : ordinal) : is_normal ((+) a) :=
-⟨λ b, (add_lt_add_iff_left a).2 (lt_succ_self _),
+⟨λ b, (add_lt_add_iff_left a).2 (lt_succ b),
  λ b l c, add_le_of_limit l⟩
 
 theorem add_is_limit (a) {b} : is_limit b → is_limit (a + b) :=
 (add_is_normal a).is_limit
 
-/-! ### Subtraction on ordinals-/
+alias add_is_limit ← is_limit.add
 
-/-- `a - b` is the unique ordinal satisfying `b + (a - b) = a` when `b ≤ a`. -/
-def sub (a b : ordinal.{u}) : ordinal.{u} :=
-Inf {o | a ≤ b + o}
+/-! ### Subtraction on ordinals-/
 
 /-- The set in the definition of subtraction is nonempty. -/
-theorem sub_nonempty {a b : ordinal.{u}} : {o | a ≤ b + o}.nonempty :=
+theorem sub_nonempty {a b : ordinal} : {o | a ≤ b + o}.nonempty :=
 ⟨a, le_add_left _ _⟩
 
-instance : has_sub ordinal := ⟨sub⟩
+/-- `a - b` is the unique ordinal satisfying `b + (a - b) = a` when `b ≤ a`. -/
+instance : has_sub ordinal := ⟨λ a b, Inf {o | a ≤ b + o}⟩
 
 theorem le_add_sub (a b : ordinal) : a ≤ b + (a - b) :=
 Inf_mem sub_nonempty
 
 theorem sub_le {a b c : ordinal} : a - b ≤ c ↔ a ≤ b + c :=
-⟨λ h, le_trans (le_add_sub a b) (add_le_add_left h _), λ h, cInf_le' h⟩
+⟨λ h, (le_add_sub a b).trans (add_le_add_left h _), λ h, cInf_le' h⟩
 
 theorem lt_sub {a b c : ordinal} : a < b - c ↔ c + a < b :=
 lt_iff_lt_of_le_iff_le sub_le
@@ -522,12 +447,21 @@ theorem sub_le_self (a b : ordinal) : a - b ≤ a :=
 sub_le.2 $ le_add_left _ _
 
 protected theorem add_sub_cancel_of_le {a b : ordinal} (h : b ≤ a) : b + (a - b) = a :=
-le_antisymm begin
+(le_add_sub a b).antisymm' begin
   rcases zero_or_succ_or_limit (a-b) with e|⟨c,e⟩|l,
   { simp only [e, add_zero, h] },
-  { rw [e, add_succ, succ_le, ← lt_sub, e], apply lt_succ_self },
-  { exact (add_le_of_limit l).2 (λ c l, le_of_lt (lt_sub.1 l)) }
-end (le_add_sub _ _)
+  { rw [e, add_succ, succ_le_iff, ← lt_sub, e], exact lt_succ c },
+  { exact (add_le_of_limit l).2 (λ c l, (lt_sub.1 l).le) }
+end
+
+theorem le_sub_of_le {a b c : ordinal} (h : b ≤ a) : c ≤ a - b ↔ b + c ≤ a :=
+by rw [←add_le_add_iff_left b, ordinal.add_sub_cancel_of_le h]
+
+theorem sub_lt_of_le {a b c : ordinal} (h : b ≤ a) : a - b < c ↔ a < b + c :=
+lt_iff_lt_of_le_iff_le (le_sub_of_le h)
+
+instance : has_exists_add_of_le ordinal :=
+⟨λ a b h, ⟨_, (ordinal.add_sub_cancel_of_le h).symm⟩⟩
 
 @[simp] theorem sub_zero (a : ordinal) : a - 0 = a :=
 by simpa only [zero_add] using add_sub_cancel 0 a
@@ -545,18 +479,17 @@ protected theorem sub_eq_zero_iff_le {a b : ordinal} : a - b = 0 ↔ a ≤ b :=
 theorem sub_sub (a b c : ordinal) : a - b - c = a - (b + c) :=
 eq_of_forall_ge_iff $ λ d, by rw [sub_le, sub_le, sub_le, add_assoc]
 
-theorem add_sub_add_cancel (a b c : ordinal) : a + b - (a + c) = b - c :=
+@[simp] theorem add_sub_add_cancel (a b c : ordinal) : a + b - (a + c) = b - c :=
 by rw [← sub_sub, add_sub_cancel]
 
 theorem sub_is_limit {a b} (l : is_limit a) (h : b < a) : is_limit (a - b) :=
 ⟨ne_of_gt $ lt_sub.2 $ by rwa add_zero,
  λ c h, by rw [lt_sub, add_succ]; exact l.2 _ (lt_sub.1 h)⟩
 
-@[simp] theorem one_add_omega : 1 + omega.{u} = omega :=
+@[simp] theorem one_add_omega : 1 + ω = ω :=
 begin
   refine le_antisymm _ (le_add_left _ _),
-  rw [omega, one_eq_lift_type_unit, ← lift_add, lift_le, type_add],
-  have : is_well_order unit empty_relation := by apply_instance,
+  rw [omega, ← lift_one.{0}, ← lift_add, lift_le, ← type_unit, ← type_sum_lex],
   refine ⟨rel_embedding.collapse (rel_embedding.of_monotone _ _)⟩,
   { apply sum.rec, exact λ _, 0, exact nat.succ },
   { intros a b, cases a; cases b; intro H; cases H with _ _ H _ _ H;
@@ -564,7 +497,7 @@ begin
 end
 
 @[simp, priority 990]
-theorem one_add_of_omega_le {o} (h : omega ≤ o) : 1 + o = o :=
+theorem one_add_of_omega_le {o} (h : ω ≤ o) : 1 + o = o :=
 by rw [← ordinal.add_sub_cancel_of_le h, ← add_assoc, one_add_omega]
 
 /-! ### Multiplication of ordinals-/
@@ -592,8 +525,24 @@ instance : monoid ordinal.{u} :=
     ⟨⟨prod_punit _, λ a b, by rcases a with ⟨a, ⟨⟨⟩⟩⟩; rcases b with ⟨b, ⟨⟨⟩⟩⟩;
     simp only [prod.lex_def, empty_relation, and_false, or_false]; refl⟩⟩ }
 
-@[simp] theorem type_mul {α β : Type u} (r : α → α → Prop) (s : β → β → Prop)
-  [is_well_order α r] [is_well_order β s] : type r * type s = type (prod.lex s r) := rfl
+@[simp] theorem type_prod_lex {α β : Type u} (r : α → α → Prop) (s : β → β → Prop)
+  [is_well_order α r] [is_well_order β s] : type (prod.lex s r) = type r * type s := rfl
+
+private theorem mul_eq_zero' {a b : ordinal} : a * b = 0 ↔ a = 0 ∨ b = 0 :=
+induction_on a $ λ α _ _, induction_on b $ λ β _ _, begin
+  simp_rw [←type_prod_lex, type_eq_zero_iff_is_empty],
+  rw or_comm,
+  exact is_empty_prod
+end
+
+instance : monoid_with_zero ordinal :=
+{ zero := 0,
+  mul_zero := λ a, mul_eq_zero'.2 $ or.inr rfl,
+  zero_mul := λ a, mul_eq_zero'.2 $ or.inl rfl,
+  ..ordinal.monoid }
+
+instance : no_zero_divisors ordinal :=
+⟨λ a b, mul_eq_zero'.1⟩
 
 @[simp] theorem lift_mul (a b) : lift (a * b) = lift a * lift b :=
 quotient.induction_on₂ a b $ λ ⟨α, r, _⟩ ⟨β, s, _⟩,
@@ -605,57 +554,32 @@ quotient.sound ⟨(rel_iso.preimage equiv.ulift _).trans
 quotient.induction_on₂ a b $ λ ⟨α, r, _⟩ ⟨β, s, _⟩,
 mul_comm (mk β) (mk α)
 
-theorem mul_eq_zero_iff {a b : ordinal} : a * b = 0 ↔ (a = 0 ∨ b = 0) :=
-induction_on a $ λ α _ _, induction_on b $ λ β _ _, begin
-  simp_rw [type_mul, type_eq_zero_iff_is_empty],
-  rw or_comm,
-  exact is_empty_prod
-end
-
-@[simp] theorem mul_zero (a : ordinal) : a * 0 = 0 :=
-mul_eq_zero_iff.2 $ or.inr rfl
-
-@[simp] theorem zero_mul (a : ordinal) : 0 * a = 0 :=
-mul_eq_zero_iff.2 $ or.inl rfl
-
-theorem mul_add (a b c : ordinal) : a * (b + c) = a * b + a * c :=
-quotient.induction_on₃ a b c $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩,
+instance : left_distrib_class ordinal.{u} :=
+⟨λ a b c, quotient.induction_on₃ a b c $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩,
 quotient.sound ⟨⟨sum_prod_distrib _ _ _, begin
-  rintro ⟨a₁|a₁, a₂⟩ ⟨b₁|b₁, b₂⟩; simp only [prod.lex_def,
+  rintro ⟨a₁|a₁, a₂⟩ ⟨b₁|b₁, b₂⟩;
+  simp only [prod.lex_def,
     sum.lex_inl_inl, sum.lex.sep, sum.lex_inr_inl, sum.lex_inr_inr,
     sum_prod_distrib_apply_left, sum_prod_distrib_apply_right];
   simp only [sum.inl.inj_iff, true_or, false_and, false_or]
-end⟩⟩
-
-@[simp] theorem mul_add_one (a b : ordinal) : a * (b + 1) = a * b + a :=
-by rw [mul_add, mul_one]
+end⟩⟩⟩
 
-@[simp] theorem mul_one_add (a b : ordinal) : a * (1 + b) = a + a * b :=
-by rw [mul_add, mul_one]
+theorem mul_succ (a b : ordinal) : a * succ b = a * b + a := mul_add_one a b
 
-@[simp] theorem mul_succ (a b : ordinal) : a * succ b = a * b + a := mul_add_one _ _
-
-theorem mul_two (a : ordinal) : a * 2 = a + a :=
-by { change a * (succ 1) = a + a, rw [mul_succ, mul_one] }
-
-instance has_le.le.mul_covariant_class : covariant_class ordinal.{u} ordinal.{u} (*) (≤) :=
+instance mul_covariant_class_le : covariant_class ordinal.{u} ordinal.{u} (*) (≤) :=
 ⟨λ c a b, quotient.induction_on₃ a b c $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨f⟩, begin
   resetI,
-  refine type_le'.2 ⟨rel_embedding.of_monotone
-    (λ a, (f a.1, a.2))
-    (λ a b h, _)⟩, clear_,
+  refine (rel_embedding.of_monotone (λ a : α × γ, (f a.1, a.2)) (λ a b h, _)).ordinal_type_le,
+  clear_,
   cases h with a₁ b₁ a₂ b₂ h' a b₁ b₂ h',
   { exact prod.lex.left _ _ (f.to_rel_embedding.map_rel_iff.2 h') },
   { exact prod.lex.right _ h' }
 end⟩
 
-instance has_le.le.mul_swap_covariant_class :
-  covariant_class ordinal.{u} ordinal.{u} (function.swap (*)) (≤) :=
+instance mul_swap_covariant_class_le : covariant_class ordinal.{u} ordinal.{u} (swap (*)) (≤) :=
 ⟨λ c a b, quotient.induction_on₃ a b c $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨f⟩, begin
   resetI,
-  refine type_le'.2 ⟨rel_embedding.of_monotone
-    (λ a, (a.1, f a.2))
-    (λ a b h, _)⟩,
+  refine (rel_embedding.of_monotone (λ a : γ × α, (a.1, f a.2)) (λ a b h, _)).ordinal_type_le,
   cases h with a₁ b₁ a₂ b₂ h' a b₁ b₂ h',
   { exact prod.lex.left _ _ h' },
   { exact prod.lex.right _ (f.to_rel_embedding.map_rel_iff.2 h') }
@@ -674,15 +598,11 @@ begin
   suffices : ∀ a b, prod.lex s r (b, a) (enum _ _ l),
   { cases enum _ _ l with b a, exact irrefl _ (this _ _) },
   intros a b,
-  rw [← typein_lt_typein (prod.lex s r), typein_enum],
+  rw [←typein_lt_typein (prod.lex s r), typein_enum],
   have := H _ (h.2 _ (typein_lt_type s b)),
-  rw [mul_succ] at this,
-  have := lt_of_lt_of_le ((add_lt_add_iff_left _).2
-    (typein_lt_type _ a)) this,
-  refine lt_of_le_of_lt _ this,
-  refine (type_le'.2 _),
-  constructor,
-  refine rel_embedding.of_monotone (λ a, _) (λ a b, _),
+  rw mul_succ at this,
+  have := ((add_lt_add_iff_left _).2 (typein_lt_type _ a)).trans_le this,
+  refine (rel_embedding.of_monotone (λ a, _) (λ a b, _)).ordinal_type_le.trans_lt this,
   { rcases a with ⟨⟨b', a'⟩, h⟩,
     by_cases e : b = b',
     { refine sum.inr ⟨a', _⟩,
@@ -707,9 +627,8 @@ begin
         sum.lex_inl_inl] using h } }
 end
 
-theorem mul_le_of_limit {a b c : ordinal.{u}}
-  (h : is_limit b) : a * b ≤ c ↔ ∀ b' < b, a * b' ≤ c :=
-⟨λ h b' l, (mul_le_mul_left' (le_of_lt l) _).trans h,
+theorem mul_le_of_limit {a b c : ordinal} (h : is_limit b) : a * b ≤ c ↔ ∀ b' < b, a * b' ≤ c :=
+⟨λ h b' l, (mul_le_mul_left' l.le _).trans h,
 λ H, le_of_not_lt $ induction_on a (λ α r _, induction_on b $ λ β s _,
   by exactI mul_le_of_limit_aux) h H⟩
 
@@ -717,7 +636,7 @@ theorem mul_is_normal {a : ordinal} (h : 0 < a) : is_normal ((*) a) :=
 ⟨λ b, by rw mul_succ; simpa only [add_zero] using (add_lt_add_iff_left (a*b)).2 h,
  λ b l c, mul_le_of_limit l⟩
 
-theorem lt_mul_of_limit {a b c : ordinal.{u}}
+theorem lt_mul_of_limit {a b c : ordinal}
   (h : is_limit c) : a < b * c ↔ ∃ c' < c, a < b * c' :=
 by simpa only [not_ball, not_le] using not_congr (@mul_le_of_limit b c a h)
 
@@ -763,21 +682,14 @@ theorem smul_eq_mul : ∀ (n : ℕ) (a : ordinal), n • a = a * n
 
 /-! ### Division on ordinals -/
 
-protected lemma div_aux (a b : ordinal.{u}) (h : b ≠ 0) : set.nonempty {o | a < b * succ o} :=
-⟨a, succ_le.1 $
-  by simpa only [succ_zero, one_mul]
-    using mul_le_mul_right' (succ_le.2 (ordinal.pos_iff_ne_zero.2 h)) (succ a)⟩
-
-/-- `a / b` is the unique ordinal `o` satisfying
-  `a = b * o + o'` with `o' < b`. -/
-protected def div (a b : ordinal.{u}) : ordinal.{u} :=
-if h : b = 0 then 0 else Inf {o | a < b * succ o}
-
 /-- The set in the definition of division is nonempty. -/
-theorem div_nonempty {a b : ordinal.{u}} (h : b ≠ 0) : {o | a < b * succ o}.nonempty :=
-ordinal.div_aux a b h
+theorem div_nonempty {a b : ordinal} (h : b ≠ 0) : {o | a < b * succ o}.nonempty :=
+⟨a, succ_le_iff.1 $
+  by simpa only [succ_zero, one_mul]
+    using mul_le_mul_right' (succ_le_of_lt (ordinal.pos_iff_ne_zero.2 h)) (succ a)⟩
 
-instance : has_div ordinal := ⟨ordinal.div⟩
+/-- `a / b` is the unique ordinal `o` satisfying `a = b * o + o'` with `o' < b`. -/
+instance : has_div ordinal := ⟨λ a b, if h : b = 0 then 0 else Inf {o | a < b * succ o}⟩
 
 @[simp] theorem div_zero (a : ordinal) : a / 0 = 0 :=
 dif_pos rfl
@@ -792,18 +704,20 @@ theorem lt_mul_div_add (a) {b : ordinal} (h : b ≠ 0) : a < b * (a / b) + b :=
 by simpa only [mul_succ] using lt_mul_succ_div a h
 
 theorem div_le {a b c : ordinal} (b0 : b ≠ 0) : a / b ≤ c ↔ a < b * succ c :=
-⟨λ h, (lt_mul_succ_div a b0).trans_le (mul_le_mul_left' (succ_le_succ.2 h) _),
+⟨λ h, (lt_mul_succ_div a b0).trans_le (mul_le_mul_left' (succ_le_succ_iff.2 h) _),
  λ h, by rw div_def a b0; exact cInf_le' h⟩
 
-theorem lt_div {a b c : ordinal} (c0 : c ≠ 0) : a < b / c ↔ c * succ a ≤ b :=
-by rw [← not_le, div_le c0, not_lt]
+theorem lt_div {a b c : ordinal} (h : c ≠ 0) : a < b / c ↔ c * succ a ≤ b :=
+by rw [← not_le, div_le h, not_lt]
+
+theorem div_pos {b c : ordinal} (h : c ≠ 0) : 0 < b / c ↔ c ≤ b := by simp [lt_div h]
 
 theorem le_div {a b c : ordinal} (c0 : c ≠ 0) :
   a ≤ b / c ↔ c * a ≤ b :=
 begin
   apply limit_rec_on a,
   { simp only [mul_zero, ordinal.zero_le] },
-  { intros, rw [succ_le, lt_div c0] },
+  { intros, rw [succ_le_iff, lt_div c0] },
   { simp only [mul_le_of_limit, limit_le, iff_self, forall_true_iff] {contextual := tt} }
 end
 
@@ -813,8 +727,7 @@ lt_iff_lt_of_le_iff_le $ le_div b0
 
 theorem div_le_of_le_mul {a b c : ordinal} (h : a ≤ b * c) : a / b ≤ c :=
 if b0 : b = 0 then by simp only [b0, div_zero, ordinal.zero_le] else
-(div_le b0).2 $ lt_of_le_of_lt h $
-mul_lt_mul_of_pos_left (lt_succ_self _) (ordinal.pos_iff_ne_zero.2 b0)
+(div_le b0).2 $ h.trans_lt $ mul_lt_mul_of_pos_left (lt_succ c) (ordinal.pos_iff_ne_zero.2 b0)
 
 theorem mul_lt_of_lt_div {a b c : ordinal} : a < b / c → c * a < b :=
 lt_imp_lt_of_le_imp_le div_le_of_le_mul
@@ -837,7 +750,7 @@ end
 
 theorem div_eq_zero_of_lt {a b : ordinal} (h : a < b) : a / b = 0 :=
 begin
-  rw [← ordinal.le_zero, div_le $ ordinal.pos_iff_ne_zero.1 $ lt_of_le_of_lt (ordinal.zero_le _) h],
+  rw [←ordinal.le_zero, div_le $ ordinal.pos_iff_ne_zero.1 $ (ordinal.zero_le _).trans_lt h],
   simpa only [succ_zero, mul_one] using h
 end
 
@@ -871,16 +784,6 @@ theorem dvd_add_iff : ∀ {a b c : ordinal}, a ∣ b → (a ∣ b + c ↔ a ∣
  ⟨λ ⟨d, e⟩, ⟨d - b, by rw [mul_sub, ← e, add_sub_cancel]⟩,
   λ ⟨d, e⟩, by { rw [e, ← mul_add], apply dvd_mul_right }⟩
 
-theorem dvd_add {a b c : ordinal} (h₁ : a ∣ b) : a ∣ c → a ∣ b + c :=
-(dvd_add_iff h₁).2
-
-theorem dvd_zero (a : ordinal) : a ∣ 0 := ⟨_, (mul_zero _).symm⟩
-
-theorem zero_dvd {a : ordinal} : 0 ∣ a ↔ a = 0 :=
-⟨λ ⟨h, e⟩, by simp only [e, zero_mul], λ e, e.symm ▸ dvd_zero _⟩
-
-theorem one_dvd (a : ordinal) : 1 ∣ a := ⟨a, (one_mul _).symm⟩
-
 theorem div_mul_cancel : ∀ {a b : ordinal}, a ≠ 0 → a ∣ b → a * (b / a) = b
 | a _ a0 ⟨b, rfl⟩ := by rw [mul_div_cancel _ a0]
 
@@ -889,9 +792,11 @@ theorem le_of_dvd : ∀ {a b : ordinal}, b ≠ 0 → a ∣ b → a ≤ b
   (one_le_iff_ne_zero.2 (λ h : b = 0, by simpa only [h, mul_zero] using b0)) a
 
 theorem dvd_antisymm {a b : ordinal} (h₁ : a ∣ b) (h₂ : b ∣ a) : a = b :=
-if a0 : a = 0 then by subst a; exact (zero_dvd.1 h₁).symm else
-if b0 : b = 0 then by subst b; exact zero_dvd.1 h₂ else
-le_antisymm (le_of_dvd b0 h₁) (le_of_dvd a0 h₂)
+if a0 : a = 0 then by subst a; exact (eq_zero_of_zero_dvd h₁).symm else
+if b0 : b = 0 then by subst b; exact eq_zero_of_zero_dvd h₂ else
+(le_of_dvd b0 h₁).antisymm (le_of_dvd a0 h₂)
+
+instance : is_antisymm ordinal (∣) := ⟨@dvd_antisymm⟩
 
 /-- `a % b` is the unique ordinal `o'` satisfying
   `a = b * o + o'` with `o' < b`. -/
@@ -899,6 +804,8 @@ instance : has_mod ordinal := ⟨λ a b, a - b * (a / b)⟩
 
 theorem mod_def (a b : ordinal) : a % b = a - b * (a / b) := rfl
 
+theorem mod_le (a b : ordinal) : a % b ≤ a := sub_le_self a _
+
 @[simp] theorem mod_zero (a : ordinal) : a % 0 = a :=
 by simp only [mod_def, div_zero, zero_mul, sub_zero]
 
@@ -936,6 +843,24 @@ end
 theorem dvd_iff_mod_eq_zero {a b : ordinal} : b ∣ a ↔ a % b = 0 :=
 ⟨mod_eq_zero_of_dvd, dvd_of_mod_eq_zero⟩
 
+@[simp] theorem mul_add_mod_self (x y z : ordinal) : (x * y + z) % x = z % x :=
+begin
+  rcases eq_or_ne x 0 with rfl | hx,
+  { simp },
+  { rwa [mod_def, mul_add_div, mul_add, ←sub_sub, add_sub_cancel, mod_def] }
+end
+
+@[simp] theorem mul_mod (x y : ordinal) : x * y % x = 0 := by simpa using mul_add_mod_self x y 0
+
+theorem mod_mod_of_dvd (a : ordinal) {b c : ordinal} (h : c ∣ b) : a % b % c = a % c :=
+begin
+  nth_rewrite_rhs 0 ←div_add_mod a b,
+  rcases h with ⟨d, rfl⟩,
+  rw [mul_assoc, mul_add_mod_self]
+end
+
+@[simp] theorem mod_mod (a b : ordinal) : a % b % b = a % b := mod_mod_of_dvd a dvd_rfl
+
 /-! ### Families of ordinals
 
 There are two kinds of indexed families that naturally arise when dealing with ordinals: those
@@ -1054,11 +979,12 @@ supr f
 @[simp] theorem Sup_eq_sup {ι : Type u} (f : ι → ordinal.{max u v}) : Sup (set.range f) = sup f :=
 rfl
 
-/-- The range of any family of ordinals is bounded above. See also `lsub_not_mem_range`. -/
+/-- The range of an indexed ordinal function, whose outputs live in a higher universe than the
+    inputs, is always bounded above. See `ordinal.lsub` for an explicit bound. -/
 theorem bdd_above_range {ι : Type u} (f : ι → ordinal.{max u v}) : bdd_above (set.range f) :=
-⟨(cardinal.sup.{u v} (cardinal.succ ∘ card ∘ f)).ord, begin
+⟨(supr (succ ∘ card ∘ f)).ord, begin
   rintros a ⟨i, rfl⟩,
-  exact le_of_lt (cardinal.lt_ord.2 ((cardinal.lt_succ_self _).trans_le (le_sup _ _)))
+  exact le_of_lt (cardinal.lt_ord.2 ((lt_succ _).trans_le (le_csupr (bdd_above_range _) _)))
 end⟩
 
 theorem le_sup {ι} (f : ι → ordinal) : ∀ i, f i ≤ sup f :=
@@ -1080,7 +1006,8 @@ theorem sup_not_succ_of_ne_sup {ι} {f : ι → ordinal} (hf : ∀ i, f i ≠ su
   (hao : a < sup f) : succ a < sup f :=
 begin
   by_contra' hoa,
-  exact hao.not_le (sup_le (λ i, lt_succ.1 ((lt_of_le_of_ne (le_sup _ _) (hf i)).trans_le hoa)))
+  exact hao.not_le (sup_le $ λ i, le_of_lt_succ $
+    (lt_of_le_of_ne (le_sup _ _) (hf i)).trans_le hoa)
 end
 
 @[simp] theorem sup_eq_zero_iff {ι} {f : ι → ordinal} : sup f = 0 ↔ ∀ i, f i = 0 :=
@@ -1091,17 +1018,13 @@ begin
   exact le_sup f i
 end
 
-theorem is_normal.sup {f} (H : is_normal f) {ι} (g : ι → ordinal) (h : nonempty ι) :
+theorem is_normal.sup {f} (H : is_normal f) {ι} (g : ι → ordinal) [nonempty ι] :
   f (sup g) = sup (f ∘ g) :=
 eq_of_forall_ge_iff $ λ a,
-by rw [sup_le_iff, comp, H.le_set' (λ_:ι, true) g (let ⟨i⟩ := h in ⟨i, ⟨⟩⟩)];
-  intros; simp only [sup_le_iff, true_implies_iff]; tauto
+by rw [sup_le_iff, comp, H.le_set' set.univ set.univ_nonempty g]; simp [sup_le_iff]
 
 @[simp] theorem sup_empty {ι} [is_empty ι] (f : ι → ordinal) : sup f = 0 :=
-sup_eq_zero_iff.2 is_empty_elim
-
-theorem sup_ord {ι} (f : ι → cardinal) : sup (λ i, (f i).ord) = (cardinal.sup f).ord :=
-eq_of_forall_ge_iff $ λ a, by simp only [sup_le_iff, cardinal.ord_le, cardinal.sup_le_iff]
+csupr_of_empty f
 
 @[simp] theorem sup_const {ι} [hι : nonempty ι] (o : ordinal) : sup (λ _ : ι, o) = o :=
 csupr_const
@@ -1117,6 +1040,19 @@ theorem sup_eq_of_range_eq {ι ι'} {f : ι → ordinal} {g : ι' → ordinal}
   (h : set.range f = set.range g) : sup.{u (max v w)} f = sup.{v (max u w)} g :=
 (sup_le_of_range_subset h.le).antisymm (sup_le_of_range_subset.{v u w} h.ge)
 
+@[simp] theorem sup_sum {α : Type u} {β : Type v} (f : α ⊕ β → ordinal) : sup.{(max u v) w} f =
+  max (sup.{u (max v w)} (λ a, f (sum.inl a))) (sup.{v (max u w)} (λ b, f (sum.inr b))) :=
+begin
+  apply (sup_le_iff.2 _).antisymm (max_le_iff.2 ⟨_, _⟩),
+  { rintro (i|i),
+    { exact le_max_of_le_left (le_sup _ i) },
+    { exact le_max_of_le_right (le_sup _ i) } },
+  all_goals
+  { apply sup_le_of_range_subset.{_ (max u v) w},
+    rintros i ⟨a, rfl⟩,
+    apply mem_range_self }
+end
+
 lemma unbounded_range_of_sup_ge {α β : Type u} (r : α → α → Prop) [is_well_order α r] (f : β → α)
   (h : type r ≤ sup.{u u} (typein r ∘ f)) : unbounded r (range f) :=
 (not_bounded_iff _).1 $ λ ⟨x, hx⟩, not_lt_of_le h $ lt_of_le_of_lt
@@ -1127,22 +1063,39 @@ theorem le_sup_shrink_equiv {s : set ordinal.{u}} (hs : small.{u} s) (a) (ha : a
   a ≤ sup.{u u} (λ x, ((@equiv_shrink s hs).symm x).val) :=
 by { convert le_sup.{u u} _ ((@equiv_shrink s hs) ⟨a, ha⟩), rw symm_apply_apply }
 
-theorem small_Iio (o : ordinal.{u}) : small.{u} (set.Iio o) :=
+instance small_Iio (o : ordinal.{u}) : small.{u} (set.Iio o) :=
 let f : o.out.α → set.Iio o := λ x, ⟨typein (<) x, typein_lt_self x⟩ in
 let hf : surjective f := λ b, ⟨enum (<) b.val (by { rw type_lt, exact b.prop }),
   subtype.ext (typein_enum _ _)⟩ in
 small_of_surjective hf
 
+instance small_Iic (o : ordinal.{u}) : small.{u} (set.Iic o) :=
+by { rw ←Iio_succ, apply_instance }
+
 theorem bdd_above_iff_small {s : set ordinal.{u}} : bdd_above s ↔ small.{u} s :=
-⟨λ ⟨a, h⟩, @small_subset _ _ _ (by exact λ b hb, lt_succ.2 (h hb)) (small_Iio a.succ),
+⟨λ ⟨a, h⟩, small_subset $ show s ⊆ Iic a, from λ x hx, h hx,
 λ h, ⟨sup.{u u} (λ x, ((@equiv_shrink s h).symm x).val), le_sup_shrink_equiv h⟩⟩
 
+theorem bdd_above_of_small (s : set ordinal.{u}) [h : small.{u} s] : bdd_above s :=
+bdd_above_iff_small.2 h
+
 theorem sup_eq_Sup {s : set ordinal.{u}} (hs : small.{u} s) :
   sup.{u u} (λ x, (@equiv_shrink s hs).symm x) = Sup s :=
 let hs' := bdd_above_iff_small.2 hs in
   ((cSup_le_iff' hs').2 (le_sup_shrink_equiv hs)).antisymm'
   (sup_le (λ x, le_cSup hs' (subtype.mem _)))
 
+theorem Sup_ord {s : set cardinal.{u}} (hs : bdd_above s) : (Sup s).ord = Sup (ord '' s) :=
+eq_of_forall_ge_iff $ λ a, begin
+  rw [cSup_le_iff' (bdd_above_iff_small.2 (@small_image _ _ _ s
+    (cardinal.bdd_above_iff_small.1 hs))), ord_le, cSup_le_iff' hs],
+  simp [ord_le]
+end
+
+theorem supr_ord {ι} {f : ι → cardinal} (hf : bdd_above (range f)) :
+  (supr f).ord = ⨆ i, (f i).ord :=
+by { unfold supr, convert Sup_ord hf, rw range_comp }
+
 private theorem sup_le_sup {ι ι' : Type u} (r : ι → ι → Prop) (r' : ι' → ι' → Prop)
   [is_well_order ι r] [is_well_order ι' r'] {o} (ho : type r = o) (ho' : type r' = o)
   (f : Π a < o, ordinal) : sup (family_of_bfamily' r ho f) ≤ sup (family_of_bfamily' r' ho' f) :=
@@ -1204,8 +1157,12 @@ by simpa only [not_forall, not_le] using not_congr (@bsup_le_iff _ f a)
 
 theorem is_normal.bsup {f} (H : is_normal f) {o} :
   ∀ (g : Π a < o, ordinal) (h : o ≠ 0), f (bsup o g) = bsup o (λ a h, f (g a h)) :=
-induction_on o $ λ α r _ g h,
-by { resetI, rw [←sup_eq_bsup' r, H.sup _ (type_ne_zero_iff_nonempty.1 h), ←sup_eq_bsup' r]; refl }
+induction_on o $ λ α r _ g h, begin
+  resetI,
+  haveI := type_ne_zero_iff_nonempty.1 h,
+  rw [←sup_eq_bsup' r, H.sup, ←sup_eq_bsup' r];
+  refl
+end
 
 theorem lt_bsup_of_ne_bsup {o : ordinal} {f : Π a < o, ordinal} :
   (∀ i h, f i h ≠ o.bsup f) ↔ ∀ i h, f i h < o.bsup f :=
@@ -1227,7 +1184,11 @@ end
 theorem lt_bsup_of_limit {o : ordinal} {f : Π a < o, ordinal}
   (hf : ∀ {a a'} (ha : a < o) (ha' : a' < o), a < a' → f a ha < f a' ha')
   (ho : ∀ a < o, succ a < o) (i h) : f i h < bsup o f :=
-(hf _ _ $ lt_succ_self i).trans_le (le_bsup f i.succ $ ho _ h)
+(hf _ _ $ lt_succ i).trans_le (le_bsup f (succ i) $ ho _ h)
+
+theorem bsup_succ_of_mono {o : ordinal} {f : Π a < succ o, ordinal}
+  (hf : ∀ {i j} hi hj, i ≤ j → f i hi ≤ f j hj) : bsup _ f = f o (lt_succ o) :=
+le_antisymm (bsup_le $ λ i hi, hf _ _ $ le_of_lt_succ hi) (le_bsup _ _ _)
 
 @[simp] theorem bsup_zero (f : Π a < (0 : ordinal), ordinal) : bsup 0 f = 0 :=
 bsup_eq_zero_iff.2 (λ i hi, (ordinal.not_lt_zero i hi).elim)
@@ -1251,49 +1212,48 @@ theorem bsup_eq_of_brange_eq {o o'} {f : Π a < o, ordinal} {g : Π a < o', ordi
 (bsup_le_of_brange_subset h.le).antisymm (bsup_le_of_brange_subset.{v u w} h.ge)
 
 /-- The least strict upper bound of a family of ordinals. -/
-def lsub {ι} (f : ι → ordinal) : ordinal :=
-sup (ordinal.succ ∘ f)
+def lsub {ι} (f : ι → ordinal) : ordinal := sup (succ ∘ f)
 
-@[simp] theorem sup_eq_lsub {ι} (f : ι → ordinal) : sup (ordinal.succ ∘ f) = lsub f :=
-rfl
+@[simp] theorem sup_eq_lsub {ι} (f : ι → ordinal) : sup (succ ∘ f) = lsub f := rfl
 
 theorem lsub_le_iff {ι} {f : ι → ordinal} {a} : lsub f ≤ a ↔ ∀ i, f i < a :=
-by { convert sup_le_iff, simp only [succ_le] }
+by { convert sup_le_iff, simp only [succ_le_iff] }
 
 theorem lsub_le {ι} {f : ι → ordinal} {a} : (∀ i, f i < a) → lsub f ≤ a :=
 lsub_le_iff.2
 
 theorem lt_lsub {ι} (f : ι → ordinal) (i) : f i < lsub f :=
-succ_le.1 (le_sup _ i)
+succ_le_iff.1 (le_sup _ i)
 
 theorem lt_lsub_iff {ι} {f : ι → ordinal} {a} : a < lsub f ↔ ∃ i, a ≤ f i :=
 by simpa only [not_forall, not_lt, not_le] using not_congr (@lsub_le_iff _ f a)
 
 theorem sup_le_lsub {ι} (f : ι → ordinal) : sup f ≤ lsub f :=
-sup_le $ λ i, le_of_lt (lt_lsub f i)
+sup_le $ λ i, (lt_lsub f i).le
 
 theorem lsub_le_sup_succ {ι} (f : ι → ordinal) : lsub f ≤ succ (sup f) :=
-lsub_le $ λ i, lt_succ.2 (le_sup f i)
+lsub_le $ λ i, lt_succ_iff.2 (le_sup f i)
 
 theorem sup_eq_lsub_or_sup_succ_eq_lsub {ι} (f : ι → ordinal) :
-  sup f = lsub f ∨ (sup f).succ = lsub f :=
+  sup f = lsub f ∨ succ (sup f) = lsub f :=
 begin
   cases eq_or_lt_of_le (sup_le_lsub f),
   { exact or.inl h },
-  { exact or.inr ((succ_le.2 h).antisymm (lsub_le_sup_succ f)) }
+  { exact or.inr ((succ_le_of_lt h).antisymm (lsub_le_sup_succ f)) }
 end
 
-theorem sup_succ_le_lsub {ι} (f : ι → ordinal) : (sup f).succ ≤ lsub f ↔ ∃ i, f i = sup f :=
+theorem sup_succ_le_lsub {ι} (f : ι → ordinal) : succ (sup f) ≤ lsub f ↔ ∃ i, f i = sup f :=
 begin
   refine ⟨λ h, _, _⟩,
   { by_contra' hf,
-    exact ne_of_lt (succ_le.1 h) ((sup_le_lsub f).antisymm (lsub_le (ne_sup_iff_lt_sup.1 hf))) },
+    exact (succ_le_iff.1 h).ne ((sup_le_lsub f).antisymm
+      (lsub_le (ne_sup_iff_lt_sup.1 hf))) },
   rintro ⟨_, hf⟩,
-  rw [succ_le, ←hf],
+  rw [succ_le_iff, ←hf],
   exact lt_lsub _ _
 end
 
-theorem sup_succ_eq_lsub {ι} (f : ι → ordinal) : (sup f).succ = lsub f ↔ ∃ i, f i = sup f :=
+theorem sup_succ_eq_lsub {ι} (f : ι → ordinal) : succ (sup f) = lsub f ↔ ∃ i, f i = sup f :=
 (lsub_le_sup_succ f).le_iff_eq.symm.trans (sup_succ_le_lsub f)
 
 theorem sup_eq_lsub_iff_succ {ι} (f : ι → ordinal) :
@@ -1301,10 +1261,10 @@ theorem sup_eq_lsub_iff_succ {ι} (f : ι → ordinal) :
 begin
   refine ⟨λ h, _, λ hf, le_antisymm (sup_le_lsub f) (lsub_le (λ i, _))⟩,
   { rw ←h,
-    exact λ a, sup_not_succ_of_ne_sup (λ i, ne_of_lt (lsub_le_iff.1 (le_of_eq h.symm) i)) },
+    exact λ a, sup_not_succ_of_ne_sup (λ i, (lsub_le_iff.1 (le_of_eq h.symm) i).ne) },
   by_contra' hle,
   have heq := (sup_succ_eq_lsub f).2 ⟨i, le_antisymm (le_sup _ _) hle⟩,
-  have := hf (sup f) (by { rw ←heq, exact lt_succ_self _ }),
+  have := hf _ (by { rw ←heq, exact lt_succ (sup f) }),
   rw heq at this,
   exact this.false
 end
@@ -1326,10 +1286,10 @@ begin
   exact this.false
 end
 
-@[simp] theorem lsub_const {ι} [hι : nonempty ι] (o : ordinal) : lsub (λ _ : ι, o) = o.succ :=
-sup_const o.succ
+@[simp] theorem lsub_const {ι} [hι : nonempty ι] (o : ordinal) : lsub (λ _ : ι, o) = succ o :=
+sup_const (succ o)
 
-@[simp] theorem lsub_unique {ι} [hι : unique ι] (f : ι → ordinal) : lsub f = (f default).succ :=
+@[simp] theorem lsub_unique {ι} [hι : unique ι] (f : ι → ordinal) : lsub f = succ (f default) :=
 sup_unique _
 
 theorem lsub_le_of_range_subset {ι ι'} {f : ι → ordinal} {g : ι' → ordinal}
@@ -1340,6 +1300,10 @@ theorem lsub_eq_of_range_eq {ι ι'} {f : ι → ordinal} {g : ι' → ordinal}
   (h : set.range f = set.range g) : lsub.{u (max v w)} f = lsub.{v (max u w)} g :=
 (lsub_le_of_range_subset h.le).antisymm (lsub_le_of_range_subset.{v u w} h.ge)
 
+@[simp] theorem lsub_sum {α : Type u} {β : Type v} (f : α ⊕ β → ordinal) : lsub.{(max u v) w} f =
+  max (lsub.{u (max v w)} (λ a, f (sum.inl a))) (lsub.{v (max u w)} (λ b, f (sum.inr b))) :=
+sup_sum _
+
 theorem lsub_not_mem_range {ι} (f : ι → ordinal) : lsub f ∉ set.range f :=
 λ ⟨i, h⟩, h.not_lt (lt_lsub f i)
 
@@ -1359,14 +1323,14 @@ theorem sup_typein_limit {o : ordinal} (ho : ∀ a, a < o → succ a < o) :
 by rw (sup_eq_lsub_iff_succ.{u u} (typein (<))).2; rwa lsub_typein o
 
 @[simp] theorem sup_typein_succ {o : ordinal} :
-  sup.{u u} (typein ((<) : o.succ.out.α → o.succ.out.α → Prop)) = o :=
+  sup.{u u} (typein ((<) : (succ o).out.α → (succ o).out.α → Prop)) = o :=
 begin
-  cases sup_eq_lsub_or_sup_succ_eq_lsub.{u u} (typein ((<) : o.succ.out.α → o.succ.out.α → Prop))
-    with h h,
+  cases sup_eq_lsub_or_sup_succ_eq_lsub.{u u}
+    (typein ((<) : (succ o).out.α → (succ o).out.α → Prop)) with h h,
   { rw sup_eq_lsub_iff_succ at h,
     simp only [lsub_typein] at h,
-    exact (h o (lt_succ_self o)).false.elim },
-  rw [←succ_inj, h],
+    exact (h o (lt_succ o)).false.elim },
+  rw [←succ_eq_succ_iff, h],
   apply lsub_typein
 end
 
@@ -1375,15 +1339,15 @@ end
 
     This is to `lsub` as `bsup` is to `sup`. -/
 def blsub (o : ordinal.{u}) (f : Π a < o, ordinal.{max u v}) : ordinal.{max u v} :=
-o.bsup (λ a ha, (f a ha).succ)
+o.bsup (λ a ha, succ (f a ha))
 
 @[simp] theorem bsup_eq_blsub (o : ordinal) (f : Π a < o, ordinal) :
-  bsup o (λ a ha, (f a ha).succ) = blsub o f :=
+  bsup o (λ a ha, succ (f a ha)) = blsub o f :=
 rfl
 
 theorem lsub_eq_blsub' {ι} (r : ι → ι → Prop) [is_well_order ι r] {o} (ho : type r = o) (f) :
   lsub (family_of_bfamily' r ho f) = blsub o f :=
-sup_eq_bsup' r ho (λ a ha, (f a ha).succ)
+sup_eq_bsup' r ho (λ a ha, succ (f a ha))
 
 theorem lsub_eq_lsub {ι ι' : Type u} (r : ι → ι → Prop) (r' : ι' → ι' → Prop)
   [is_well_order ι r] [is_well_order ι' r'] {o} (ho : type r = o) (ho' : type r' = o)
@@ -1410,7 +1374,7 @@ blsub_eq_lsub' _ _
 by subst ho
 
 theorem blsub_le_iff {o f a} : blsub o f ≤ a ↔ ∀ i h, f i h < a :=
-by { convert bsup_le_iff, apply propext, simp [succ_le] }
+by { convert bsup_le_iff, simp [succ_le_iff] }
 
 theorem blsub_le {o : ordinal} {f : Π b < o, ordinal} {a} : (∀ i h, f i h < a) → blsub o f ≤ a :=
 blsub_le_iff.2
@@ -1422,29 +1386,29 @@ theorem lt_blsub_iff {o f a} : a < blsub o f ↔ ∃ i hi, a ≤ f i hi :=
 by simpa only [not_forall, not_lt, not_le] using not_congr (@blsub_le_iff _ f a)
 
 theorem bsup_le_blsub {o} (f : Π a < o, ordinal) : bsup o f ≤ blsub o f :=
-bsup_le (λ i h, le_of_lt (lt_blsub f i h))
+bsup_le (λ i h, (lt_blsub f i h).le)
 
-theorem blsub_le_bsup_succ {o} (f : Π a < o, ordinal) : blsub o f ≤ (bsup o f).succ :=
-blsub_le (λ i h, lt_succ.2 (le_bsup f i h))
+theorem blsub_le_bsup_succ {o} (f : Π a < o, ordinal) : blsub o f ≤ succ (bsup o f) :=
+blsub_le (λ i h, lt_succ_iff.2 (le_bsup f i h))
 
 theorem bsup_eq_blsub_or_succ_bsup_eq_blsub {o} (f : Π a < o, ordinal) :
   bsup o f = blsub o f ∨ succ (bsup o f) = blsub o f :=
 by { rw [←sup_eq_bsup, ←lsub_eq_blsub], exact sup_eq_lsub_or_sup_succ_eq_lsub _ }
 
 theorem bsup_succ_le_blsub {o} (f : Π a < o, ordinal) :
-  (bsup o f).succ ≤ blsub o f ↔ ∃ i hi, f i hi = bsup o f :=
+  succ (bsup o f) ≤ blsub o f ↔ ∃ i hi, f i hi = bsup o f :=
 begin
   refine ⟨λ h, _, _⟩,
   { by_contra' hf,
-    exact ne_of_lt (succ_le.1 h) (le_antisymm (bsup_le_blsub f)
+    exact ne_of_lt (succ_le_iff.1 h) (le_antisymm (bsup_le_blsub f)
       (blsub_le (lt_bsup_of_ne_bsup.1 hf))) },
   rintro ⟨_, _, hf⟩,
-  rw [succ_le, ←hf],
+  rw [succ_le_iff, ←hf],
   exact lt_blsub _ _ _
 end
 
 theorem bsup_succ_eq_blsub {o} (f : Π a < o, ordinal) :
-  (bsup o f).succ = blsub o f ↔ ∃ i hi, f i hi = bsup o f :=
+  succ (bsup o f) = blsub o f ↔ ∃ i hi, f i hi = bsup o f :=
 (blsub_le_bsup_succ f).le_iff_eq.symm.trans (bsup_succ_le_blsub f)
 
 theorem bsup_eq_blsub_iff_succ {o} (f : Π a < o, ordinal) :
@@ -1456,12 +1420,16 @@ theorem bsup_eq_blsub_iff_lt_bsup {o} (f : Π a < o, ordinal) :
 ⟨λ h i, (by { rw h, apply lt_blsub }), λ h, le_antisymm (bsup_le_blsub f) (blsub_le h)⟩
 
 theorem bsup_eq_blsub_of_lt_succ_limit {o} (ho : is_limit o) {f : Π a < o, ordinal}
-  (hf : ∀ a ha, f a ha < f a.succ (ho.2 a ha)) : bsup o f = blsub o f :=
+  (hf : ∀ a ha, f a ha < f (succ a) (ho.2 a ha)) : bsup o f = blsub o f :=
 begin
   rw bsup_eq_blsub_iff_lt_bsup,
   exact λ i hi, (hf i hi).trans_le (le_bsup f _ _)
 end
 
+theorem blsub_succ_of_mono {o : ordinal} {f : Π a < succ o, ordinal}
+  (hf : ∀ {i j} hi hj, i ≤ j → f i hi ≤ f j hj) : blsub _ f = succ (f o (lt_succ o)) :=
+bsup_succ_of_mono $ λ i j hi hj h, succ_le_succ (hf hi hj h)
+
 @[simp] theorem blsub_eq_zero_iff {o} {f : Π a < o, ordinal} : blsub o f = 0 ↔ o = 0 :=
 by { rw [←lsub_eq_blsub, lsub_eq_zero_iff], exact out_empty_iff_eq_zero }
 
@@ -1477,16 +1445,16 @@ eq_of_forall_ge_iff $ λ o,
 by rw [blsub_le_iff, lsub_le_iff]; exact
   ⟨λ H b, H _ _, λ H i h, by simpa only [typein_enum] using H (enum r i h)⟩
 
-theorem blsub_const {o : ordinal} (ho : o ≠ 0) (a : ordinal) : blsub.{u v} o (λ _ _, a) = a.succ :=
-bsup_const.{u v} ho a.succ
+theorem blsub_const {o : ordinal} (ho : o ≠ 0) (a : ordinal) : blsub.{u v} o (λ _ _, a) = succ a :=
+bsup_const.{u v} ho (succ a)
 
-@[simp] theorem blsub_one (f : Π a < (1 : ordinal), ordinal) : blsub 1 f = (f 0 zero_lt_one).succ :=
+@[simp] theorem blsub_one (f : Π a < (1 : ordinal), ordinal) : blsub 1 f = succ (f 0 zero_lt_one) :=
 bsup_one _
 
 @[simp] theorem blsub_id : ∀ o, blsub.{u u} o (λ x _, x) = o :=
 lsub_typein
 
-theorem bsup_id_limit {o} : (∀ a < o, succ a < o) → bsup.{u u} o (λ x _, x) = o :=
+theorem bsup_id_limit {o : ordinal} : (∀ a < o, succ a < o) → bsup.{u u} o (λ x _, x) = o :=
 sup_typein_limit
 
 @[simp] theorem bsup_id_succ (o) : bsup.{u u} (succ o) (λ x _, x) = o :=
@@ -1520,7 +1488,7 @@ end
 theorem blsub_comp {o o' : ordinal} {f : Π a < o, ordinal}
   (hf : ∀ {i j} (hi) (hj), i ≤ j → f i hi ≤ f j hj) {g : Π a < o', ordinal} (hg : blsub o' g = o) :
   blsub o' (λ a ha, f (g a ha) (by { rw ←hg, apply lt_blsub })) = blsub o f :=
-@bsup_comp o _ (λ a ha, (f a ha).succ) (λ i j _ _ h, succ_le_succ.2 (hf _ _ h)) g hg
+@bsup_comp o _ (λ a ha, succ (f a ha)) (λ i j _ _ h, succ_le_succ_iff.2 (hf _ _ h)) g hg
 
 theorem is_normal.bsup_eq {f} (H : is_normal f) {o : ordinal} (h : is_limit o) :
   bsup.{u} o (λ x _, f x) = f o :=
@@ -1531,12 +1499,12 @@ theorem is_normal.blsub_eq {f} (H : is_normal f) {o : ordinal} (h : is_limit o)
 by { rw [←H.bsup_eq h, bsup_eq_blsub_of_lt_succ_limit h], exact (λ a _, H.1 a) }
 
 theorem is_normal_iff_lt_succ_and_bsup_eq {f} :
-  is_normal f ↔ (∀ a, f a < f a.succ) ∧ ∀ o, is_limit o → bsup o (λ x _, f x) = f o :=
+  is_normal f ↔ (∀ a, f a < f (succ a)) ∧ ∀ o, is_limit o → bsup o (λ x _, f x) = f o :=
 ⟨λ h, ⟨h.1, @is_normal.bsup_eq f h⟩, λ ⟨h₁, h₂⟩, ⟨h₁, λ o ho a,
   (by {rw ←h₂ o ho, exact bsup_le_iff})⟩⟩
 
 theorem is_normal_iff_lt_succ_and_blsub_eq {f} :
-  is_normal f ↔ (∀ a, f a < f a.succ) ∧ ∀ o, is_limit o → blsub o (λ x _, f x) = f o :=
+  is_normal f ↔ (∀ a, f a < f (succ a)) ∧ ∀ o, is_limit o → blsub o (λ x _, f x) = f o :=
 begin
   rw [is_normal_iff_lt_succ_and_bsup_eq, and.congr_right_iff],
   intro h,
@@ -1546,8 +1514,8 @@ begin
   rwa ←bsup_eq_blsub_of_lt_succ_limit ho (λ a _, h a) at *
 end
 
-theorem is_normal.eq_iff_zero_and_succ {f : ordinal.{u} → ordinal.{u}} (hf : is_normal f) {g}
-  (hg : is_normal g) : f = g ↔ (f 0 = g 0 ∧ ∀ a : ordinal, f a = g a → f a.succ = g a.succ) :=
+theorem is_normal.eq_iff_zero_and_succ {f g : ordinal.{u} → ordinal.{u}} (hf : is_normal f)
+  (hg : is_normal g) : f = g ↔ f 0 = g 0 ∧ ∀ a, f a = g a → f (succ a) = g (succ a) :=
 ⟨λ h, by simp [h], λ ⟨h₁, h₂⟩, funext (λ a, begin
   apply a.limit_rec_on,
   assumption',
@@ -1558,6 +1526,20 @@ theorem is_normal.eq_iff_zero_and_succ {f : ordinal.{u} → ordinal.{u}} (hf : i
   exact H b hb
 end)⟩
 
+/-- A two-argument version of `ordinal.blsub`.
+
+We don't develop a full API for this, since it's only used in a handful of existence results. -/
+def blsub₂ (o₁ o₂ : ordinal) (op : Π (a < o₁) (b < o₂), ordinal) : ordinal :=
+lsub (λ x : o₁.out.α × o₂.out.α,
+  op (typein (<) x.1) (typein_lt_self _) (typein (<) x.2) (typein_lt_self _))
+
+theorem lt_blsub₂ {o₁ o₂ : ordinal} (op : Π (a < o₁) (b < o₂), ordinal) {a b : ordinal}
+  (ha : a < o₁) (hb : b < o₂) : op a ha b hb < blsub₂ o₁ o₂ op :=
+begin
+  convert lt_lsub _ (prod.mk (enum (<) a (by rwa type_lt)) (enum (<) b (by rwa type_lt))),
+  simp only [typein_enum]
+end
+
 /-! ### Minimum excluded ordinals -/
 
 /-- The minimum excluded ordinal in a family of ordinals. -/
@@ -1567,6 +1549,10 @@ Inf (set.range f)ᶜ
 theorem mex_not_mem_range {ι : Type u} (f : ι → ordinal.{max u v}) : mex f ∉ set.range f :=
 Inf_mem (nonempty_compl_range f)
 
+theorem le_mex_of_forall {ι : Type u} {f : ι → ordinal.{max u v}} {a : ordinal}
+  (H : ∀ b < a, ∃ i, f i = b) : a ≤ mex f :=
+by { by_contra' h, exact mex_not_mem_range f (H _ h) }
+
 theorem ne_mex {ι} (f : ι → ordinal) : ∀ i, f i ≠ mex f :=
 by simpa using mex_not_mem_range f
 
@@ -1588,13 +1574,13 @@ begin
   exact ne_mex g j hi
 end
 
-theorem mex_lt_ord_succ_mk {ι} (f : ι → ordinal) : mex f < (#ι).succ.ord :=
+theorem mex_lt_ord_succ_mk {ι} (f : ι → ordinal) : mex f < (succ (#ι)).ord :=
 begin
   by_contra' h,
-  apply not_le_of_lt (cardinal.lt_succ_self (#ι)),
+  apply (lt_succ (#ι)).not_le,
   have H := λ a, exists_of_lt_mex ((typein_lt_self a).trans_le h),
-  let g : (#ι).succ.ord.out.α → ι := λ a, classical.some (H a),
-  have hg : function.injective g := λ a b h', begin
+  let g : (succ (#ι)).ord.out.α → ι := λ a, classical.some (H a),
+  have hg : injective g := λ a b h', begin
     have Hf : ∀ x, f (g x) = typein (<) x := λ a, classical.some_spec (H a),
     apply_fun f at h',
     rwa [Hf, Hf, typein_inj] at h'
@@ -1614,6 +1600,10 @@ mex (family_of_bfamily o f)
 theorem bmex_not_mem_brange {o : ordinal} (f : Π a < o, ordinal) : bmex o f ∉ brange o f :=
 by { rw ←range_family_of_bfamily, apply mex_not_mem_range }
 
+theorem le_bmex_of_forall {o : ordinal} (f : Π a < o, ordinal) {a : ordinal}
+  (H : ∀ b < a, ∃ i hi, f i hi = b) : a ≤ bmex o f :=
+by { by_contra' h, exact bmex_not_mem_brange f (H _ h) }
+
 theorem ne_bmex {o : ordinal} (f : Π a < o, ordinal) {i} (hi) : f i hi ≠ bmex o f :=
 begin
   convert ne_mex _ (enum (<) i (by rwa type_lt)),
@@ -1638,25 +1628,26 @@ theorem bmex_monotone {o o' : ordinal} {f : Π a < o, ordinal} {g : Π a < o', o
   (h : brange o f ⊆ brange o' g) : bmex o f ≤ bmex o' g :=
 mex_monotone (by rwa [range_family_of_bfamily, range_family_of_bfamily])
 
-theorem bmex_lt_ord_succ_card {o : ordinal} (f : Π a < o, ordinal) : bmex o f < o.card.succ.ord :=
+theorem bmex_lt_ord_succ_card {o : ordinal} (f : Π a < o, ordinal) :
+  bmex o f < (succ o.card).ord :=
 by { rw ←mk_ordinal_out, exact (mex_lt_ord_succ_mk (family_of_bfamily o f)) }
 
 end ordinal
 
 /-! ### Results about injectivity and surjectivity -/
 
-lemma not_surjective_of_ordinal {α : Type u} (f : α → ordinal.{u}) : ¬ function.surjective f :=
+lemma not_surjective_of_ordinal {α : Type u} (f : α → ordinal.{u}) : ¬ surjective f :=
 λ h, ordinal.lsub_not_mem_range.{u u} f (h _)
 
-lemma not_injective_of_ordinal {α : Type u} (f : ordinal.{u} → α) : ¬ function.injective f :=
+lemma not_injective_of_ordinal {α : Type u} (f : ordinal.{u} → α) : ¬ injective f :=
 λ h, not_surjective_of_ordinal _ (inv_fun_surjective h)
 
 lemma not_surjective_of_ordinal_of_small {α : Type v} [small.{u} α] (f : α → ordinal.{u}) :
-  ¬ function.surjective f :=
+  ¬ surjective f :=
 λ h, not_surjective_of_ordinal _ (h.comp (equiv_shrink _).symm.surjective)
 
 lemma not_injective_of_ordinal_of_small {α : Type v} [small.{u} α] (f : ordinal.{u} → α) :
-  ¬ function.injective f :=
+  ¬ injective f :=
 λ h, not_injective_of_ordinal _ ((equiv_shrink _).injective.comp h)
 
 /-- The type of ordinals in universe `u` is not `small.{u}`. This is the type-theoretic analog of
@@ -1669,17 +1660,18 @@ theorem not_small_ordinal : ¬ small.{u} ordinal.{max u v} :=
 namespace ordinal
 
 section
-variables {S : set ordinal.{u}}
 
 /-- Enumerator function for an unbounded set of ordinals. -/
 def enum_ord (S : set ordinal.{u}) : ordinal → ordinal :=
-wf.fix (λ o f, Inf (S ∩ set.Ici (blsub.{u u} o f)))
+lt_wf.fix (λ o f, Inf (S ∩ set.Ici (blsub.{u u} o f)))
+
+variables {S : set ordinal.{u}}
 
 /-- The equation that characterizes `enum_ord` definitionally. This isn't the nicest expression to
     work with, so consider using `enum_ord_def` instead. -/
 theorem enum_ord_def' (o) :
   enum_ord S o = Inf (S ∩ set.Ici (blsub.{u u} o (λ a _, enum_ord S a))) :=
-wf.fix_eq _ _
+lt_wf.fix_eq _ _
 
 /-- The set in `enum_ord_def'` is nonempty. -/
 theorem enum_ord_def'_nonempty (hS : unbounded (<) S) (a) : (S ∩ set.Ici a).nonempty :=
@@ -1716,7 +1708,7 @@ lemma enum_ord_def_nonempty (hS : unbounded (<) S) {o} :
 @[simp] theorem enum_ord_range {f : ordinal → ordinal} (hf : strict_mono f) :
   enum_ord (range f) = f :=
 funext (λ o, begin
-  apply wf.induction o,
+  apply ordinal.induction o,
   intros a H,
   rw enum_ord_def a,
   have Hfa : f a ∈ range f ∩ {b | ∀ c, c < a → enum_ord (range f) c < b} :=
@@ -1735,16 +1727,16 @@ by { rw ←range_id, exact enum_ord_range strict_mono_id }
 by { rw enum_ord_def, simp [ordinal.not_lt_zero] }
 
 theorem enum_ord_succ_le {a b} (hS : unbounded (<) S) (ha : a ∈ S) (hb : enum_ord S b < a) :
-  enum_ord S b.succ ≤ a :=
+  enum_ord S (succ b) ≤ a :=
 begin
   rw enum_ord_def,
-  exact cInf_le' ⟨ha, λ c hc, ((enum_ord_strict_mono hS).monotone (lt_succ.1 hc)).trans_lt hb⟩
+  exact cInf_le' ⟨ha, λ c hc, ((enum_ord_strict_mono hS).monotone (le_of_lt_succ hc)).trans_lt hb⟩
 end
 
 theorem enum_ord_le_of_subset {S T : set ordinal} (hS : unbounded (<) S) (hST : S ⊆ T) (a) :
   enum_ord T a ≤ enum_ord S a :=
 begin
-  apply wf.induction a,
+  apply ordinal.induction a,
   intros b H,
   rw enum_ord_def,
   exact cInf_le' ⟨hST (enum_ord_mem hS b), λ c h, (H c h).trans_lt (enum_ord_strict_mono hS h)⟩
@@ -1760,8 +1752,8 @@ theorem enum_ord_surjective (hS : unbounded (<) S) : ∀ s ∈ S, ∃ a, enum_or
     exact (enum_ord_strict_mono hS hab).trans_le hb },
   { by_contra' h,
     exact (le_cSup ⟨s, λ a,
-      (wf.self_le_of_strict_mono (enum_ord_strict_mono hS) a).trans⟩
-      (enum_ord_succ_le hS hs h)).not_lt (lt_succ_self _) }
+      (lt_wf.self_le_of_strict_mono (enum_ord_strict_mono hS) a).trans⟩
+      (enum_ord_succ_le hS hs h)).not_lt (lt_succ _) }
 end⟩
 
 /-- An order isomorphism between an unbounded set of ordinals and the ordinals. -/
@@ -1778,534 +1770,69 @@ theorem eq_enum_ord (f : ordinal → ordinal) (hS : unbounded (<) S) :
 begin
   split,
   { rintro ⟨h₁, h₂⟩,
-    rwa [←wf.eq_strict_mono_iff_eq_range h₁ (enum_ord_strict_mono hS), range_enum_ord hS] },
+    rwa [←lt_wf.eq_strict_mono_iff_eq_range h₁ (enum_ord_strict_mono hS), range_enum_ord hS] },
   { rintro rfl,
     exact ⟨enum_ord_strict_mono hS, range_enum_ord hS⟩ }
 end
 
 end
 
-/-! ### Ordinal exponential -/
-
-/-- The ordinal exponential, defined by transfinite recursion. -/
-def opow (a b : ordinal) : ordinal :=
-if a = 0 then 1 - b else
-limit_rec_on b 1 (λ _ IH, IH * a) (λ b _, bsup.{u u} b)
-
-instance : has_pow ordinal ordinal := ⟨opow⟩
-local infixr ^ := @pow ordinal ordinal ordinal.has_pow
-
-theorem zero_opow' (a : ordinal) : 0 ^ a = 1 - a :=
-by simp only [pow, opow, if_pos rfl]
-
-@[simp] theorem zero_opow {a : ordinal} (a0 : a ≠ 0) : 0 ^ a = 0 :=
-by rwa [zero_opow', ordinal.sub_eq_zero_iff_le, one_le_iff_ne_zero]
-
-@[simp] theorem opow_zero (a : ordinal) : a ^ 0 = 1 :=
-by by_cases a = 0; [simp only [pow, opow, if_pos h, sub_zero],
-simp only [pow, opow, if_neg h, limit_rec_on_zero]]
-
-@[simp] theorem opow_succ (a b : ordinal) : a ^ succ b = a ^ b * a :=
-if h : a = 0 then by subst a; simp only [zero_opow (succ_ne_zero _), mul_zero]
-else by simp only [pow, opow, limit_rec_on_succ, if_neg h]
-
-theorem opow_limit {a b : ordinal} (a0 : a ≠ 0) (h : is_limit b) :
-  a ^ b = bsup.{u u} b (λ c _, a ^ c) :=
-by simp only [pow, opow, if_neg a0]; rw limit_rec_on_limit _ _ _ _ h; refl
-
-theorem opow_le_of_limit {a b c : ordinal} (a0 : a ≠ 0) (h : is_limit b) :
-  a ^ b ≤ c ↔ ∀ b' < b, a ^ b' ≤ c :=
-by rw [opow_limit a0 h, bsup_le_iff]
-
-theorem lt_opow_of_limit {a b c : ordinal} (b0 : b ≠ 0) (h : is_limit c) :
-  a < b ^ c ↔ ∃ c' < c, a < b ^ c' :=
-by rw [← not_iff_not, not_exists]; simp only [not_lt, opow_le_of_limit b0 h, exists_prop, not_and]
-
-@[simp] theorem opow_one (a : ordinal) : a ^ 1 = a :=
-by rw [← succ_zero, opow_succ]; simp only [opow_zero, one_mul]
-
-@[simp] theorem one_opow (a : ordinal) : 1 ^ a = 1 :=
-begin
-  apply limit_rec_on a,
-  { simp only [opow_zero] },
-  { intros _ ih, simp only [opow_succ, ih, mul_one] },
-  refine λ b l IH, eq_of_forall_ge_iff (λ c, _),
-  rw [opow_le_of_limit ordinal.one_ne_zero l],
-  exact ⟨λ H, by simpa only [opow_zero] using H 0 l.pos,
-         λ H b' h, by rwa IH _ h⟩,
-end
-
-theorem opow_pos {a : ordinal} (b)
-  (a0 : 0 < a) : 0 < a ^ b :=
-begin
-  have h0 : 0 < a ^ 0, {simp only [opow_zero, zero_lt_one]},
-  apply limit_rec_on b,
-  { exact h0 },
-  { intros b IH, rw [opow_succ],
-    exact mul_pos IH a0 },
-  { exact λ b l _, (lt_opow_of_limit (ordinal.pos_iff_ne_zero.1 a0) l).2
-      ⟨0, l.pos, h0⟩ },
-end
-
-theorem opow_ne_zero {a : ordinal} (b)
-  (a0 : a ≠ 0) : a ^ b ≠ 0 :=
-ordinal.pos_iff_ne_zero.1 $ opow_pos b $ ordinal.pos_iff_ne_zero.2 a0
-
-theorem opow_is_normal {a : ordinal} (h : 1 < a) : is_normal ((^) a) :=
-have a0 : 0 < a, from lt_trans zero_lt_one h,
-⟨λ b, by simpa only [mul_one, opow_succ] using
-  (mul_lt_mul_iff_left (opow_pos b a0)).2 h,
- λ b l c, opow_le_of_limit (ne_of_gt a0) l⟩
-
-theorem opow_lt_opow_iff_right {a b c : ordinal}
-  (a1 : 1 < a) : a ^ b < a ^ c ↔ b < c :=
-(opow_is_normal a1).lt_iff
-
-theorem opow_le_opow_iff_right {a b c : ordinal}
-  (a1 : 1 < a) : a ^ b ≤ a ^ c ↔ b ≤ c :=
-(opow_is_normal a1).le_iff
-
-theorem opow_right_inj {a b c : ordinal}
-  (a1 : 1 < a) : a ^ b = a ^ c ↔ b = c :=
-(opow_is_normal a1).inj
-
-theorem opow_is_limit {a b : ordinal}
-  (a1 : 1 < a) : is_limit b → is_limit (a ^ b) :=
-(opow_is_normal a1).is_limit
-
-theorem opow_is_limit_left {a b : ordinal}
-  (l : is_limit a) (hb : b ≠ 0) : is_limit (a ^ b) :=
-begin
-  rcases zero_or_succ_or_limit b with e|⟨b,rfl⟩|l',
-  { exact absurd e hb },
-  { rw opow_succ,
-    exact mul_is_limit (opow_pos _ l.pos) l },
-  { exact opow_is_limit l.one_lt l' }
-end
-
-theorem opow_le_opow_right {a b c : ordinal}
-  (h₁ : 0 < a) (h₂ : b ≤ c) : a ^ b ≤ a ^ c :=
-begin
-  cases lt_or_eq_of_le (one_le_iff_pos.2 h₁) with h₁ h₁,
-  { exact (opow_le_opow_iff_right h₁).2 h₂ },
-  { subst a, simp only [one_opow] }
-end
-
-theorem opow_le_opow_left {a b : ordinal} (c)
-  (ab : a ≤ b) : a ^ c ≤ b ^ c :=
-begin
-  by_cases a0 : a = 0,
-  { subst a, by_cases c0 : c = 0,
-    { subst c, simp only [opow_zero] },
-    { simp only [zero_opow c0, ordinal.zero_le] } },
-  { apply limit_rec_on c,
-    { simp only [opow_zero] },
-    { intros c IH, simpa only [opow_succ] using mul_le_mul' IH ab },
-    { exact λ c l IH, (opow_le_of_limit a0 l).2
-        (λ b' h, le_trans (IH _ h) (opow_le_opow_right
-          (lt_of_lt_of_le (ordinal.pos_iff_ne_zero.2 a0) ab) (le_of_lt h))) } }
-end
-
-theorem left_le_opow (a : ordinal) {b : ordinal} (b1 : 0 < b) : a ≤ a ^ b :=
-begin
-  nth_rewrite 0 ←opow_one a,
-  cases le_or_gt a 1 with a1 a1,
-  { cases lt_or_eq_of_le a1 with a0 a1,
-    { rw lt_one_iff_zero at a0,
-      rw [a0, zero_opow ordinal.one_ne_zero],
-      exact ordinal.zero_le _ },
-    rw [a1, one_opow, one_opow] },
-  rwa [opow_le_opow_iff_right a1, one_le_iff_pos]
-end
-
-theorem right_le_opow {a : ordinal} (b) (a1 : 1 < a) : b ≤ a ^ b :=
-(opow_is_normal a1).self_le _
-
-theorem opow_lt_opow_left_of_succ {a b c : ordinal}
-  (ab : a < b) : a ^ succ c < b ^ succ c :=
-by rw [opow_succ, opow_succ]; exact
-  (mul_le_mul_right' (opow_le_opow_left _ (le_of_lt ab)) a).trans_lt
-  (mul_lt_mul_of_pos_left ab (opow_pos _ (lt_of_le_of_lt (ordinal.zero_le _) ab)))
-
-theorem opow_add (a b c : ordinal) : a ^ (b + c) = a ^ b * a ^ c :=
-begin
-  by_cases a0 : a = 0,
-  { subst a,
-    by_cases c0 : c = 0, {simp only [c0, add_zero, opow_zero, mul_one]},
-    have : b+c ≠ 0 := ne_of_gt (lt_of_lt_of_le
-      (ordinal.pos_iff_ne_zero.2 c0) (le_add_left _ _)),
-    simp only [zero_opow c0, zero_opow this, mul_zero] },
-  cases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with a1 a1,
-  { subst a1, simp only [one_opow, mul_one] },
-  apply limit_rec_on c,
-  { simp only [add_zero, opow_zero, mul_one] },
-  { intros c IH,
-    rw [add_succ, opow_succ, IH, opow_succ, mul_assoc] },
-  { intros c l IH,
-    refine eq_of_forall_ge_iff (λ d, (((opow_is_normal a1).trans
-      (add_is_normal b)).limit_le l).trans _),
-    simp only [IH] {contextual := tt},
-    exact (((mul_is_normal $ opow_pos b (ordinal.pos_iff_ne_zero.2 a0)).trans
-      (opow_is_normal a1)).limit_le l).symm }
-end
-
-theorem opow_one_add (a b : ordinal) : a ^ (1 + b) = a * a ^ b :=
-by rw [opow_add, opow_one]
-
-theorem opow_dvd_opow (a) {b c : ordinal}
-  (h : b ≤ c) : a ^ b ∣ a ^ c :=
-by { rw [← ordinal.add_sub_cancel_of_le h, opow_add], apply dvd_mul_right }
-
-theorem opow_dvd_opow_iff {a b c : ordinal}
-  (a1 : 1 < a) : a ^ b ∣ a ^ c ↔ b ≤ c :=
-⟨λ h, le_of_not_lt $ λ hn,
-  not_le_of_lt ((opow_lt_opow_iff_right a1).2 hn) $
-   le_of_dvd (opow_ne_zero _ $ one_le_iff_ne_zero.1 $ le_of_lt a1) h,
-opow_dvd_opow _⟩
-
-theorem opow_mul (a b c : ordinal) : a ^ (b * c) = (a ^ b) ^ c :=
-begin
-  by_cases b0 : b = 0, {simp only [b0, zero_mul, opow_zero, one_opow]},
-  by_cases a0 : a = 0,
-  { subst a,
-    by_cases c0 : c = 0, {simp only [c0, mul_zero, opow_zero]},
-    simp only [zero_opow b0, zero_opow c0, zero_opow (mul_ne_zero b0 c0)] },
-  cases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with a1 a1,
-  { subst a1, simp only [one_opow] },
-  apply limit_rec_on c,
-  { simp only [mul_zero, opow_zero] },
-  { intros c IH,
-    rw [mul_succ, opow_add, IH, opow_succ] },
-  { intros c l IH,
-    refine eq_of_forall_ge_iff (λ d, (((opow_is_normal a1).trans
-      (mul_is_normal (ordinal.pos_iff_ne_zero.2 b0))).limit_le l).trans _),
-    simp only [IH] {contextual := tt},
-    exact (opow_le_of_limit (opow_ne_zero _ a0) l).symm }
-end
-
-/-! ### Ordinal logarithm -/
-
-/-- The ordinal logarithm is the solution `u` to the equation `x = b ^ u * v + w` where `v < b` and
-    `w < b ^ u`. -/
-def log (b : ordinal) (x : ordinal) : ordinal :=
-if h : 1 < b then pred (Inf {o | x < b ^ o}) else 0
-
-/-- The set in the definition of `log` is nonempty. -/
-theorem log_nonempty {b x : ordinal} (h : 1 < b) : {o | x < b ^ o}.nonempty :=
-⟨succ x, succ_le.1 (right_le_opow _ h)⟩
-
-@[simp] theorem log_not_one_lt {b : ordinal} (b1 : ¬ 1 < b) (x : ordinal) : log b x = 0 :=
-by simp only [log, dif_neg b1]
-
-theorem log_def {b : ordinal} (b1 : 1 < b) (x : ordinal) : log b x = pred (Inf {o | x < b ^ o}) :=
-by simp only [log, dif_pos b1]
-
-@[simp] theorem log_zero (b : ordinal) : log b 0 = 0 :=
-if b1 : 1 < b then begin
-  rw [log_def b1, ← ordinal.le_zero, pred_le],
-  apply cInf_le',
-  dsimp,
-  rw [succ_zero, opow_one],
-  exact zero_lt_one.trans b1
-end
-else by simp only [log_not_one_lt b1]
-
-theorem succ_log_def {b x : ordinal} (b1 : 1 < b) (x0 : 0 < x) :
-  succ (log b x) = Inf {o | x < b ^ o} :=
-begin
-  let t := Inf {o | x < b ^ o},
-  have : x < b ^ t := Inf_mem (log_nonempty b1),
-  rcases zero_or_succ_or_limit t with h|h|h,
-  { refine (not_lt_of_le (one_le_iff_pos.2 x0) _).elim,
-    simpa only [h, opow_zero] },
-  { rw [show log b x = pred t, from log_def b1 x,
-        succ_pred_iff_is_succ.2 h] },
-  { rcases (lt_opow_of_limit (ne_of_gt $ lt_trans zero_lt_one b1) h).1 this with ⟨a, h₁, h₂⟩,
-    exact (not_le_of_lt h₁).elim ((le_cInf_iff'' (log_nonempty b1)).1 (le_refl t) a h₂) }
-end
-
-theorem lt_opow_succ_log {b : ordinal} (b1 : 1 < b) (x : ordinal) :
-  x < b ^ succ (log b x) :=
-begin
-  cases lt_or_eq_of_le (ordinal.zero_le x) with x0 x0,
-  { rw [succ_log_def b1 x0], exact Inf_mem (log_nonempty b1) },
-  { subst x, apply opow_pos _ (lt_trans zero_lt_one b1) }
-end
-
-theorem opow_log_le (b) {x : ordinal} (x0 : 0 < x) :
-  b ^ log b x ≤ x :=
-begin
-  by_cases b0 : b = 0,
-  { rw [b0, zero_opow'],
-    refine le_trans (sub_le_self _ _) (one_le_iff_pos.2 x0) },
-  cases lt_or_eq_of_le (one_le_iff_ne_zero.2 b0) with b1 b1,
-  { refine le_of_not_lt (λ h, not_le_of_lt (lt_succ_self (log b x)) _),
-    have := @cInf_le' _ _ {o | x < b ^ o} _ h,
-    rwa ← succ_log_def b1 x0 at this },
-  { rw [← b1, one_opow], exact one_le_iff_pos.2 x0 }
-end
-
-theorem le_log {b x c : ordinal} (b1 : 1 < b) (x0 : 0 < x) :
-  c ≤ log b x ↔ b ^ c ≤ x :=
-⟨λ h, le_trans ((opow_le_opow_iff_right b1).2 h) (opow_log_le b x0),
- λ h, le_of_not_lt $ λ hn,
-   not_le_of_lt (lt_opow_succ_log b1 x) $
-   le_trans ((opow_le_opow_iff_right b1).2 (succ_le.2 hn)) h⟩
-
-theorem log_lt {b x c : ordinal} (b1 : 1 < b) (x0 : 0 < x) :
-  log b x < c ↔ x < b ^ c :=
-lt_iff_lt_of_le_iff_le (le_log b1 x0)
-
-theorem log_le_log (b) {x y : ordinal} (xy : x ≤ y) :
-  log b x ≤ log b y :=
-if x0 : x = 0 then by simp only [x0, log_zero, ordinal.zero_le] else
-have x0 : 0 < x, from ordinal.pos_iff_ne_zero.2 x0,
-if b1 : 1 < b then
-  (le_log b1 (lt_of_lt_of_le x0 xy)).2 $ le_trans (opow_log_le _ x0) xy
-else by simp only [log_not_one_lt b1, ordinal.zero_le]
-
-theorem log_le_self (b x : ordinal) : log b x ≤ x :=
-if x0 : x = 0 then by simp only [x0, log_zero, ordinal.zero_le] else
-if b1 : 1 < b then
-  le_trans (right_le_opow _ b1) (opow_log_le b (ordinal.pos_iff_ne_zero.2 x0))
-else by simp only [log_not_one_lt b1, ordinal.zero_le]
-
-@[simp] theorem log_one (b : ordinal) : log b 1 = 0 :=
-if hb : 1 < b then by rwa [←lt_one_iff_zero, log_lt hb zero_lt_one, opow_one]
-else log_not_one_lt hb 1
-
-theorem mod_opow_log_lt_self {b o : ordinal} (b0 : b ≠ 0) (o0 : o ≠ 0) :
-  o % b ^ log b o < o :=
-lt_of_lt_of_le
-  (mod_lt _ $ opow_ne_zero _ b0)
-  (opow_log_le _ $ ordinal.pos_iff_ne_zero.2 o0)
-
-lemma opow_mul_add_pos {b v : ordinal} (hb : 0 < b) (u) (hv : 0 < v) (w) :
-  0 < b ^ u * v + w :=
-(opow_pos u hb).trans_le ((le_mul_left _ hv).trans (le_add_right _ _))
-
-lemma opow_mul_add_lt_opow_mul_succ {b u w : ordinal} (v : ordinal) (hw : w < b ^ u) :
-  b ^ u * v + w < b ^ u * v.succ :=
-by rwa [mul_succ, add_lt_add_iff_left]
-
-lemma opow_mul_add_lt_opow_succ {b u v w : ordinal} (hvb : v < b) (hw : w < b ^ u) :
-  b ^ u * v + w < b ^ u.succ :=
-begin
-  convert (opow_mul_add_lt_opow_mul_succ v hw).trans_le (mul_le_mul_left' (succ_le.2 hvb) _),
-  exact opow_succ b u
-end
-
-theorem log_opow_mul_add {b u v w : ordinal} (hb : 1 < b) (hv : 0 < v) (hvb : v < b)
-  (hw : w < b ^ u) : log b (b ^ u * v + w) = u :=
-begin
-  have hpos := opow_mul_add_pos (zero_lt_one.trans hb) u hv w,
-  by_contra' hne,
-  cases lt_or_gt_of_ne hne with h h,
-  { rw log_lt hb hpos at h,
-    exact not_le_of_lt h ((le_mul_left _ hv).trans (le_add_right _ _)) },
-  { change _ < _ at h,
-    rw [←succ_le, le_log hb hpos] at h,
-    exact (not_lt_of_le h) (opow_mul_add_lt_opow_succ hvb hw) }
-end
-
-@[simp] theorem log_opow {b : ordinal} (hb : 1 < b) (x : ordinal) : log b (b ^ x) = x :=
-begin
-  convert log_opow_mul_add hb zero_lt_one hb (opow_pos x (zero_lt_one.trans hb)),
-  rw [add_zero, mul_one]
-end
-
-theorem add_log_le_log_mul {x y : ordinal} (b : ordinal) (x0 : 0 < x) (y0 : 0 < y) :
-  log b x + log b y ≤ log b (x * y) :=
-begin
-  by_cases hb : 1 < b,
-  { rw [le_log hb (mul_pos x0 y0), opow_add],
-    exact mul_le_mul' (opow_log_le b x0) (opow_log_le b y0) },
-  simp only [log_not_one_lt hb, zero_add]
-end
-
-/-! ### The Cantor normal form -/
-
-/-- Proving properties of ordinals by induction over their Cantor normal form. -/
-@[elab_as_eliminator] noncomputable def CNF_rec {b : ordinal} (b0 : b ≠ 0)
-  {C : ordinal → Sort*} (H0 : C 0) (H : ∀ o, o ≠ 0 → C (o % b ^ log b o) → C o) : ∀ o, C o
-| o :=
-  if o0 : o = 0 then by rwa o0 else
-  have _, from mod_opow_log_lt_self b0 o0,
-  H o o0 (CNF_rec (o % b ^ log b o))
-using_well_founded {dec_tac := `[assumption]}
-
-@[simp] theorem CNF_rec_zero {b} (b0) {C H0 H} : @CNF_rec b b0 C H0 H 0 = H0 :=
-by rw [CNF_rec, dif_pos rfl]; refl
-
-@[simp] theorem CNF_rec_ne_zero {b} (b0) {C H0 H o} (o0) :
-  @CNF_rec b b0 C H0 H o = H o o0 (@CNF_rec b b0 C H0 H _) :=
-by rw [CNF_rec, dif_neg o0]
-
-/-- The Cantor normal form of an ordinal `o` is the list of coefficients and exponents in the
-    base-`b` expansion of `o`.
-
-    `CNF b (b ^ u₁ * v₁ + b ^ u₂ * v₂) = [(u₁, v₁), (u₂, v₂)]` -/
-def CNF (b o : ordinal) : list (ordinal × ordinal) :=
-if b0 : b = 0 then [] else
-CNF_rec b0 [] (λ o o0 IH, (log b o, o / b ^ log b o) :: IH) o
-
-@[simp] theorem zero_CNF (o) : CNF 0 o = [] :=
-dif_pos rfl
-
-@[simp] theorem CNF_zero (b) : CNF b 0 = [] :=
-if b0 : b = 0 then dif_pos b0 else (dif_neg b0).trans $ CNF_rec_zero _
-
-theorem CNF_ne_zero {b o : ordinal} (b0 : b ≠ 0) (o0 : o ≠ 0) :
-  CNF b o = (log b o, o / b ^ log b o) :: CNF b (o % b ^ log b o) :=
-by unfold CNF; rw [dif_neg b0, dif_neg b0, CNF_rec_ne_zero b0 o0]
-
-@[simp] theorem one_CNF {o : ordinal} (o0 : o ≠ 0) : CNF 1 o = [(0, o)] :=
-by rw [CNF_ne_zero ordinal.one_ne_zero o0, log_not_one_lt (lt_irrefl _), opow_zero, mod_one,
-       CNF_zero, div_one]
-
-theorem CNF_foldr {b : ordinal} (b0 : b ≠ 0) (o) :
-  (CNF b o).foldr (λ p r, b ^ p.1 * p.2 + r) 0 = o :=
-CNF_rec b0 (by rw CNF_zero; refl)
-  (λ o o0 IH, by rw [CNF_ne_zero b0 o0, list.foldr_cons, IH, div_add_mod]) o
-
-/-- This theorem exists to factor out commonalities between the proofs of `ordinal.CNF_pairwise` and
-`ordinal.CNF_fst_le_log`. -/
-private theorem CNF_pairwise_aux (b o : ordinal.{u}) :
-  (∀ p : ordinal × ordinal, p ∈ CNF b o → p.1 ≤ log b o) ∧ (CNF b o).pairwise (λ p q, q.1 < p.1) :=
-begin
-  by_cases b0 : b = 0,
-  { simp only [b0, zero_CNF, list.pairwise.nil, and_true], exact λ _, false.elim },
-  cases lt_or_eq_of_le (one_le_iff_ne_zero.2 b0) with b1 b1,
-  { refine CNF_rec b0 _ _ o,
-    { simp only [CNF_zero, list.pairwise.nil, and_true], exact λ _, false.elim },
-    intros o o0 IH, cases IH with IH₁ IH₂,
-    simp only [CNF_ne_zero b0 o0, list.forall_mem_cons, list.pairwise_cons, IH₂, and_true],
-    refine ⟨⟨le_rfl, λ p m, _⟩, λ p m, _⟩,
-    { exact le_trans (IH₁ p m) (log_le_log _ $ le_of_lt $ mod_opow_log_lt_self b0 o0) },
-    { refine lt_of_le_of_lt (IH₁ p m) ((log_lt b1 _).2 _),
-      { rw ordinal.pos_iff_ne_zero, intro e,
-        rw e at m, simpa only [CNF_zero] using m },
-      { exact mod_lt _ (opow_ne_zero _ b0) } } },
-  { by_cases o0 : o = 0,
-    { simp only [o0, CNF_zero, list.pairwise.nil, and_true], exact λ _, false.elim },
-    rw [← b1, one_CNF o0],
-    simp only [list.mem_singleton, log_not_one_lt (lt_irrefl _), forall_eq, le_refl, true_and,
-      list.pairwise_singleton] }
-end
-
-theorem CNF_pairwise (b o : ordinal.{u}) :
-  (CNF b o).pairwise (λ p q : ordinal × ordinal, q.1 < p.1) :=
-(CNF_pairwise_aux _ _).2
-
-theorem CNF_fst_le_log {b o : ordinal.{u}} :
-  ∀ {p : ordinal × ordinal}, p ∈ CNF b o → p.1 ≤ log b o :=
-(CNF_pairwise_aux _ _).1
-
-theorem CNF_fst_le {b o : ordinal.{u}} {p : ordinal × ordinal} (hp : p ∈ CNF b o) : p.1 ≤ o :=
-(CNF_fst_le_log hp).trans (log_le_self _ _)
-
-/-- This theorem exists to factor out commonalities between the proofs of `ordinal.CNF_snd_lt` and
-`ordinal.CNF_lt_snd`. -/
-private theorem CNF_snd_lt_aux {b o : ordinal.{u}} (b1 : 1 < b) :
-  ∀ {p : ordinal × ordinal}, p ∈ CNF b o → p.2 < b ∧ 0 < p.2 :=
-begin
-  have b0 := (zero_lt_one.trans b1).ne',
-  refine CNF_rec b0 (λ _, by { rw CNF_zero, exact false.elim }) (λ o o0 IH, _) o,
-  simp only [CNF_ne_zero b0 o0, list.mem_cons_iff, forall_eq_or_imp, iff_true_intro @IH, and_true],
-  nth_rewrite 1 ←succ_le,
-  rw [div_lt (opow_ne_zero _ b0), ←opow_succ, le_div (opow_ne_zero _ b0), succ_zero, mul_one],
-  refine ⟨lt_opow_succ_log b1 _, opow_log_le _ _⟩,
-  rwa ordinal.pos_iff_ne_zero
-end
-
-theorem CNF_snd_lt {b o : ordinal.{u}} (b1 : 1 < b) {p : ordinal × ordinal} (hp : p ∈ CNF b o) :
-  p.2 < b :=
-(CNF_snd_lt_aux b1 hp).1
-
-theorem CNF_lt_snd {b o : ordinal.{u}} (b1 : 1 < b) {p : ordinal × ordinal} (hp : p ∈ CNF b o) :
-  0 < p.2 :=
-(CNF_snd_lt_aux b1 hp).2
-
-theorem CNF_sorted (b o : ordinal) : ((CNF b o).map prod.fst).sorted (>) :=
-by { rw [list.sorted, list.pairwise_map], exact CNF_pairwise b o }
 
 /-! ### Casting naturals into ordinals, compatibility with operations -/
 
-@[simp] theorem nat_cast_mul {m n : ℕ} : ((m * n : ℕ) : ordinal) = m * n :=
-by induction n with n IH; [simp only [nat.cast_zero, nat.mul_zero, mul_zero],
-  rw [nat.mul_succ, nat.cast_add, IH, nat.cast_succ, mul_add_one]]
+@[simp] theorem one_add_nat_cast (m : ℕ) : 1 + (m : ordinal) = succ m :=
+by { rw [←nat.cast_one, ←nat.cast_add, add_comm], refl }
 
-@[simp] theorem nat_cast_opow {m n : ℕ} : ((pow m n : ℕ) : ordinal) = m ^ n :=
-by induction n with n IH; [simp only [pow_zero, nat.cast_zero, opow_zero, nat.cast_one],
-  rw [pow_succ', nat_cast_mul, IH, nat.cast_succ, ← succ_eq_add_one, opow_succ]]
+@[simp, norm_cast] theorem nat_cast_mul (m : ℕ) : ∀ n : ℕ, ((m * n : ℕ) : ordinal) = m * n
+| 0     := by simp
+| (n+1) := by rw [nat.mul_succ, nat.cast_add, nat_cast_mul, nat.cast_succ, mul_add_one]
 
-@[simp] theorem nat_cast_le {m n : ℕ} : (m : ordinal) ≤ n ↔ m ≤ n :=
-by rw [← cardinal.ord_nat, ← cardinal.ord_nat,
-       cardinal.ord_le_ord, cardinal.nat_cast_le]
+@[simp, norm_cast] theorem nat_cast_le {m n : ℕ} : (m : ordinal) ≤ n ↔ m ≤ n :=
+by rw [←cardinal.ord_nat, ←cardinal.ord_nat, cardinal.ord_le_ord, cardinal.nat_cast_le]
 
-@[simp] theorem nat_cast_lt {m n : ℕ} : (m : ordinal) < n ↔ m < n :=
+@[simp, norm_cast] theorem nat_cast_lt {m n : ℕ} : (m : ordinal) < n ↔ m < n :=
 by simp only [lt_iff_le_not_le, nat_cast_le]
 
-@[simp] theorem nat_cast_inj {m n : ℕ} : (m : ordinal) = n ↔ m = n :=
+@[simp, norm_cast] theorem nat_cast_inj {m n : ℕ} : (m : ordinal) = n ↔ m = n :=
 by simp only [le_antisymm_iff, nat_cast_le]
 
-@[simp] theorem nat_cast_eq_zero {n : ℕ} : (n : ordinal) = 0 ↔ n = 0 :=
+@[simp, norm_cast] theorem nat_cast_eq_zero {n : ℕ} : (n : ordinal) = 0 ↔ n = 0 :=
 @nat_cast_inj n 0
 
 theorem nat_cast_ne_zero {n : ℕ} : (n : ordinal) ≠ 0 ↔ n ≠ 0 :=
 not_congr nat_cast_eq_zero
 
-@[simp] theorem nat_cast_pos {n : ℕ} : (0 : ordinal) < n ↔ 0 < n :=
+@[simp, norm_cast] theorem nat_cast_pos {n : ℕ} : (0 : ordinal) < n ↔ 0 < n :=
 @nat_cast_lt 0 n
 
-@[simp] theorem nat_cast_sub {m n : ℕ} : ((m - n : ℕ) : ordinal) = m - n :=
-(_root_.le_total m n).elim
-  (λ h, by rw [tsub_eq_zero_iff_le.2 h, ordinal.sub_eq_zero_iff_le.2 (nat_cast_le.2 h)]; refl)
-  (λ h, (add_left_cancel n).1 $ by rw [← nat.cast_add,
-     add_tsub_cancel_of_le h, ordinal.add_sub_cancel_of_le (nat_cast_le.2 h)])
-
-@[simp] theorem nat_cast_div {m n : ℕ} : ((m / n : ℕ) : ordinal) = m / n :=
-if n0 : n = 0 then by simp only [n0, nat.div_zero, nat.cast_zero, div_zero] else
-have n0':_, from nat_cast_ne_zero.2 n0,
-le_antisymm
-  (by rw [le_div n0', ← nat_cast_mul, nat_cast_le, mul_comm];
-      apply nat.div_mul_le_self)
-  (by rw [div_le n0', succ, ← nat.cast_succ, ← nat_cast_mul,
-          nat_cast_lt, mul_comm, ← nat.div_lt_iff_lt_mul _ _ (nat.pos_of_ne_zero n0)];
-      apply nat.lt_succ_self)
-
-@[simp] theorem nat_cast_mod {m n : ℕ} : ((m % n : ℕ) : ordinal) = m % n :=
-by rw [← add_left_cancel (n*(m/n)), div_add_mod, ← nat_cast_div, ← nat_cast_mul, ← nat.cast_add,
-       nat.div_add_mod]
-
-@[simp] theorem nat_le_card {o} {n : ℕ} : (n : cardinal) ≤ card o ↔ (n : ordinal) ≤ o :=
-⟨λ h, by rwa [← cardinal.ord_le, cardinal.ord_nat] at h,
- λ h, card_nat n ▸ card_le_card h⟩
-
-@[simp] theorem nat_lt_card {o} {n : ℕ} : (n : cardinal) < card o ↔ (n : ordinal) < o :=
-by rw [← succ_le, ← cardinal.succ_le, ← cardinal.nat_succ, nat_le_card]; refl
-
-@[simp] theorem card_lt_nat {o} {n : ℕ} : card o < n ↔ o < n :=
-lt_iff_lt_of_le_iff_le nat_le_card
-
-@[simp] theorem card_le_nat {o} {n : ℕ} : card o ≤ n ↔ o ≤ n :=
-le_iff_le_iff_lt_iff_lt.2 nat_lt_card
-
-@[simp] theorem card_eq_nat {o} {n : ℕ} : card o = n ↔ o = n :=
-by simp only [le_antisymm_iff, card_le_nat, nat_le_card]
-
-@[simp] theorem type_fin (n : ℕ) : @type (fin n) (<) _ = n :=
-by rw [← card_eq_nat, card_type, mk_fin]
+@[simp, norm_cast] theorem nat_cast_sub (m n : ℕ) : ((m - n : ℕ) : ordinal) = m - n :=
+begin
+  cases le_total m n with h h,
+  { rw [tsub_eq_zero_iff_le.2 h, ordinal.sub_eq_zero_iff_le.2 (nat_cast_le.2 h)],
+    refl },
+  { apply (add_left_cancel n).1,
+    rw [←nat.cast_add, add_tsub_cancel_of_le h, ordinal.add_sub_cancel_of_le (nat_cast_le.2 h)] }
+end
 
-@[simp] theorem lift_nat_cast (n : ℕ) : lift n = n :=
-by induction n with n ih; [simp only [nat.cast_zero, lift_zero],
-  simp only [nat.cast_succ, lift_add, ih, lift_one]]
+@[simp, norm_cast] theorem nat_cast_div (m n : ℕ) : ((m / n : ℕ) : ordinal) = m / n :=
+begin
+  rcases eq_or_ne n 0 with rfl | hn,
+  { simp },
+  { have hn' := nat_cast_ne_zero.2 hn,
+    apply le_antisymm,
+    { rw [le_div hn', ←nat_cast_mul, nat_cast_le, mul_comm],
+      apply nat.div_mul_le_self },
+    { rw [div_le hn', ←add_one_eq_succ, ←nat.cast_succ, ←nat_cast_mul, nat_cast_lt, mul_comm,
+        ←nat.div_lt_iff_lt_mul (nat.pos_of_ne_zero hn)],
+      apply nat.lt_succ_self } }
+end
 
-theorem lift_type_fin (n : ℕ) : lift (@type (fin n) (<) _) = n :=
-by simp only [type_fin, lift_nat_cast]
+@[simp, norm_cast] theorem nat_cast_mod (m n : ℕ) : ((m % n : ℕ) : ordinal) = m % n :=
+by rw [←add_left_cancel, div_add_mod, ←nat_cast_div, ←nat_cast_mul, ←nat.cast_add, nat.div_add_mod]
 
-theorem type_fintype (r : α → α → Prop) [is_well_order α r] [fintype α] : type r = fintype.card α :=
-by rw [← card_eq_nat, card_type, mk_fintype]
+@[simp] theorem lift_nat_cast : ∀ n : ℕ, lift.{u v} n = n
+| 0     := by simp
+| (n+1) := by simp [lift_nat_cast n]
 
 end ordinal
 
@@ -2314,19 +1841,19 @@ end ordinal
 namespace cardinal
 open ordinal
 
-@[simp] theorem ord_omega : ord.{u} omega = ordinal.omega :=
+@[simp] theorem ord_aleph_0 : ord.{u} ℵ₀ = ω :=
 le_antisymm (ord_le.2 $ le_rfl) $
 le_of_forall_lt $ λ o h, begin
   rcases ordinal.lt_lift_iff.1 h with ⟨o, rfl, h'⟩,
-  rw [lt_ord, ← lift_card, ← lift_omega.{0 u},
-      lift_lt, ← typein_enum (<) h'],
-  exact lt_omega_iff_fintype.2 ⟨set.fintype_lt_nat _⟩
+  rw [lt_ord, ←lift_card, lift_lt_aleph_0, ←typein_enum (<) h'],
+  exact lt_aleph_0_iff_fintype.2 ⟨set.fintype_lt_nat _⟩
 end
 
-@[simp] theorem add_one_of_omega_le {c} (h : omega ≤ c) : c + 1 = c :=
-by rw [add_comm, ← card_ord c, ← card_one,
-       ← card_add, one_add_of_omega_le];
-   rwa [← ord_omega, ord_le_ord]
+@[simp] theorem add_one_of_aleph_0_le {c} (h : ℵ₀ ≤ c) : c + 1 = c :=
+begin
+  rw [add_comm, ←card_ord c, ←card_one, ←card_add, one_add_of_omega_le],
+  rwa [←ord_aleph_0, ord_le_ord]
+end
 
 end cardinal
 
@@ -2336,52 +1863,51 @@ theorem lt_add_of_limit {a b c : ordinal.{u}}
   (h : is_limit c) : a < b + c ↔ ∃ c' < c, a < b + c' :=
 by rw [←is_normal.bsup_eq.{u u} (add_is_normal b) h, lt_bsup]
 
-theorem lt_omega {o : ordinal.{u}} : o < omega ↔ ∃ n : ℕ, o = n :=
-by rw [← cardinal.ord_omega, cardinal.lt_ord, lt_omega]; simp only [card_eq_nat]
+theorem lt_omega {o : ordinal} : o < ω ↔ ∃ n : ℕ, o = n :=
+by simp_rw [←cardinal.ord_aleph_0, cardinal.lt_ord, lt_aleph_0, card_eq_nat]
 
-theorem nat_lt_omega (n : ℕ) : (n : ordinal) < omega :=
+theorem nat_lt_omega (n : ℕ) : ↑n < ω :=
 lt_omega.2 ⟨_, rfl⟩
 
-theorem omega_pos : 0 < omega := nat_lt_omega 0
+theorem omega_pos : 0 < ω := nat_lt_omega 0
 
-theorem omega_ne_zero : omega ≠ 0 := ne_of_gt omega_pos
+theorem omega_ne_zero : ω ≠ 0 := omega_pos.ne'
 
-theorem one_lt_omega : 1 < omega := by simpa only [nat.cast_one] using nat_lt_omega 1
+theorem one_lt_omega : 1 < ω := by simpa only [nat.cast_one] using nat_lt_omega 1
 
-theorem omega_is_limit : is_limit omega :=
+theorem omega_is_limit : is_limit ω :=
 ⟨omega_ne_zero, λ o h,
   let ⟨n, e⟩ := lt_omega.1 h in
   by rw [e]; exact nat_lt_omega (n+1)⟩
 
-theorem omega_le {o : ordinal.{u}} : omega ≤ o ↔ ∀ n : ℕ, (n : ordinal) ≤ o :=
-⟨λ h n, le_trans (le_of_lt (nat_lt_omega _)) h,
+theorem omega_le {o : ordinal} : ω ≤ o ↔ ∀ n : ℕ, ↑n ≤ o :=
+⟨λ h n, (nat_lt_omega _).le.trans h,
  λ H, le_of_forall_lt $ λ a h,
    let ⟨n, e⟩ := lt_omega.1 h in
-   by rw [e, ← succ_le]; exact H (n+1)⟩
+   by rw [e, ←succ_le_iff]; exact H (n+1)⟩
 
-@[simp] theorem sup_nat_cast : sup nat.cast = omega :=
+@[simp] theorem sup_nat_cast : sup nat.cast = ω :=
 (sup_le $ λ n, (nat_lt_omega n).le).antisymm $ omega_le.2 $ le_sup _
 
-theorem nat_lt_limit {o} (h : is_limit o) : ∀ n : ℕ, (n : ordinal) < o
+theorem nat_lt_limit {o} (h : is_limit o) : ∀ n : ℕ, ↑n < o
 | 0     := lt_of_le_of_ne (ordinal.zero_le o) h.1.symm
 | (n+1) := h.2 _ (nat_lt_limit n)
 
-theorem omega_le_of_is_limit {o} (h : is_limit o) : omega ≤ o :=
+theorem omega_le_of_is_limit {o} (h : is_limit o) : ω ≤ o :=
 omega_le.2 $ λ n, le_of_lt $ nat_lt_limit h n
 
-theorem is_limit_iff_omega_dvd {a : ordinal} : is_limit a ↔ a ≠ 0 ∧ omega ∣ a :=
+theorem is_limit_iff_omega_dvd {a : ordinal} : is_limit a ↔ a ≠ 0 ∧ ω ∣ a :=
 begin
-  refine ⟨λ l, ⟨l.1, ⟨a / omega, le_antisymm _ (mul_div_le _ _)⟩⟩, λ h, _⟩,
+  refine ⟨λ l, ⟨l.1, ⟨a / ω, le_antisymm _ (mul_div_le _ _)⟩⟩, λ h, _⟩,
   { refine (limit_le l).2 (λ x hx, le_of_lt _),
-    rw [← div_lt omega_ne_zero, ← succ_le, le_div omega_ne_zero,
-        mul_succ, add_le_of_limit omega_is_limit],
+    rw [←div_lt omega_ne_zero, ←succ_le_iff, le_div omega_ne_zero, mul_succ,
+      add_le_of_limit omega_is_limit],
     intros b hb,
     rcases lt_omega.1 hb with ⟨n, rfl⟩,
-    exact le_trans (add_le_add_right (mul_div_le _ _) _)
-      (le_of_lt $ lt_sub.1 $ nat_lt_limit (sub_is_limit l hx) _) },
+    exact (add_le_add_right (mul_div_le _ _) _).trans
+      (lt_sub.1 $ nat_lt_limit (sub_is_limit l hx) _).le },
   { rcases h with ⟨a0, b, rfl⟩,
-    refine mul_is_limit_left omega_is_limit
-      (ordinal.pos_iff_ne_zero.2 $ mt _ a0),
+    refine mul_is_limit_left omega_is_limit (ordinal.pos_iff_ne_zero.2 $ mt _ a0),
     intro e, simp only [e, mul_zero] }
 end
 
@@ -2391,10 +1917,10 @@ theorem add_mul_limit_aux {a b c : ordinal} (ba : b + a = a)
   (a + b) * c = a * c :=
 le_antisymm
   ((mul_le_of_limit l).2 $ λ c' h, begin
-    apply le_trans (mul_le_mul_left' (le_of_lt $ lt_succ_self _) _),
+    apply (mul_le_mul_left' (le_succ c') _).trans,
     rw IH _ h,
-    apply le_trans (add_le_add_left _ _),
-    { rw ← mul_succ, exact mul_le_mul_left' (succ_le.2 $ l.2 _ h) _ },
+    apply (add_le_add_left _ _).trans,
+    { rw ← mul_succ, exact mul_le_mul_left' (succ_le_of_lt $ l.2 _ h) _ },
     { apply_instance },
     { rw ← ba, exact le_add_right _ _ }
   end)
@@ -2427,28 +1953,64 @@ begin
 end
 
 theorem is_normal.apply_omega {f : ordinal.{u} → ordinal.{u}} (hf : is_normal f) :
-  sup.{0 u} (f ∘ nat.cast) = f omega :=
-by rw [←sup_nat_cast, is_normal.sup.{0 u u} hf _ ⟨0⟩]
+  sup.{0 u} (f ∘ nat.cast) = f ω :=
+by rw [←sup_nat_cast, is_normal.sup.{0 u u} hf]
 
-@[simp] theorem sup_add_nat (o : ordinal.{u}) : sup (λ n : ℕ, o + n) = o + omega :=
+@[simp] theorem sup_add_nat (o : ordinal) : sup (λ n : ℕ, o + n) = o + ω :=
 (add_is_normal o).apply_omega
 
-@[simp] theorem sup_mul_nat (o : ordinal) : sup (λ n : ℕ, o * n) = o * omega :=
+@[simp] theorem sup_mul_nat (o : ordinal) : sup (λ n : ℕ, o * n) = o * ω :=
 begin
   rcases eq_zero_or_pos o with rfl | ho,
   { rw zero_mul, exact sup_eq_zero_iff.2 (λ n, zero_mul n) },
   { exact (mul_is_normal ho).apply_omega }
 end
 
-local infixr ^ := @pow ordinal ordinal ordinal.has_pow
-theorem sup_opow_nat {o : ordinal.{u}} (ho : 0 < o) : sup (λ n : ℕ, o ^ n) = o ^ omega :=
-begin
-  rcases lt_or_eq_of_le (one_le_iff_pos.2 ho) with ho₁ | rfl,
-  { exact (opow_is_normal ho₁).apply_omega },
-  { rw one_opow,
-    refine le_antisymm (sup_le (λ n, by rw one_opow)) _,
-    convert le_sup _ 0,
-    rw [nat.cast_zero, opow_zero] }
-end
-
 end ordinal
+
+
+variables {α : Type u} {r : α → α → Prop} {a b : α}
+
+namespace acc
+
+/-- The rank of an element `a` accessible under a relation `r` is defined inductively as the
+smallest ordinal greater than the ranks of all elements below it (i.e. elements `b` such that
+`r b a`). -/
+noncomputable def rank (h : acc r a) : ordinal.{u} :=
+acc.rec_on h $ λ a h ih, ordinal.sup.{u u} $ λ b : {b // r b a}, order.succ $ ih b b.2
+
+lemma rank_eq (h : acc r a) :
+  h.rank = ordinal.sup.{u u} (λ b : {b // r b a}, order.succ (h.inv b.2).rank) :=
+by { change (acc.intro a $ λ _, h.inv).rank = _, refl }
+
+/-- if `r a b` then the rank of `a` is less than the rank of `b`. -/
+lemma rank_lt_of_rel (hb : acc r b) (h : r a b) : (hb.inv h).rank < hb.rank :=
+(order.lt_succ _).trans_le $ by { rw hb.rank_eq, refine le_trans _ (ordinal.le_sup _ ⟨a, h⟩), refl }
+
+end acc
+
+namespace well_founded
+variables (hwf : well_founded r)
+include hwf
+
+/-- The rank of an element `a` under a well-founded relation `r` is defined inductively as the
+smallest ordinal greater than the ranks of all elements below it (i.e. elements `b` such that
+`r b a`). -/
+noncomputable def rank (a : α) : ordinal.{u} := (hwf.apply a).rank
+
+lemma rank_eq : hwf.rank a = ordinal.sup.{u u} (λ b : {b // r b a}, order.succ $ hwf.rank b) :=
+by { rw [rank, acc.rank_eq], refl }
+
+lemma rank_lt_of_rel (h : r a b) : hwf.rank a < hwf.rank b := acc.rank_lt_of_rel _ h
+
+omit hwf
+
+lemma rank_strict_mono [preorder α] [well_founded_lt α] :
+  strict_mono (rank $ @is_well_founded.wf α (<) _) :=
+λ _ _, rank_lt_of_rel _
+
+lemma rank_strict_anti [preorder α] [well_founded_gt α] :
+  strict_anti (rank $ @is_well_founded.wf α (>) _) :=
+λ _ _, rank_lt_of_rel $ @is_well_founded.wf α (>) _
+
+end well_founded
diff --git a/src/set_theory/ordinal/basic.lean b/src/set_theory/ordinal/basic.lean
index e3b09d9dbd9dc..c9ccd28a73e48 100644
--- a/src/set_theory/ordinal/basic.lean
+++ b/src/set_theory/ordinal/basic.lean
@@ -4,25 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Floris van Doorn
 -/
 import data.sum.order
-import order.succ_pred.basic
+import order.initial_seg
 import set_theory.cardinal.basic
 
 /-!
 # Ordinals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Ordinals are defined as equivalences of well-ordered sets under order isomorphism. They are endowed
 with a total order, where an ordinal is smaller than another one if it embeds into it as an
 initial segment (or, equivalently, in any way). This total order is well founded.
 
 ## Main definitions
 
-* `initial_seg r s`: type of order embeddings of `r` into `s` for which the range is an initial
-  segment (i.e., if `b` belongs to the range, then any `b' < b` also belongs to the range).
-  It is denoted by `r ≼i s`.
-* `principal_seg r s`: Type of order embeddings of `r` into `s` for which the range is a principal
-  segment, i.e., an interval of the form `(-∞, top)` for some element `top`. It is denoted by
-  `r ≺i s`.
-
 * `ordinal`: the type of ordinals (in a given universe)
 * `ordinal.type r`: given a well-founded order `r`, this is the corresponding ordinal
 * `ordinal.typein r a`: given a well-founded order `r` on a type `α`, and `a : α`, the ordinal
@@ -36,7 +32,9 @@ initial segment (or, equivalently, in any way). This total order is well founded
   `ordinal.lift.initial_seg`.
   For a version regiserting that it is a principal segment embedding if `u < v`, see
   `ordinal.lift.principal_seg`.
-* `ordinal.omega` is the first infinite ordinal. It is the order type of `ℕ`.
+* `ordinal.omega` or `ω` is the order type of `ℕ`. This definition is universe polymorphic:
+  `ordinal.omega.{u} : ordinal.{u}` (contrast with `ℕ : Type`, which lives in a specific
+  universe). In some cases the universe level has to be given explicitly.
 
 * `o₁ + o₂` is the order on the disjoint union of `o₁` and `o₂` obtained by declaring that
   every element of `o₁` is smaller than every element of `o₂`. The main properties of addition
@@ -44,7 +42,6 @@ initial segment (or, equivalently, in any way). This total order is well founded
   we only introduce it and prove its basic properties to deduce the fact that the order on ordinals
   is total (and well founded).
 * `succ o` is the successor of the ordinal `o`.
-* `ordinal.min`: the minimal element of a nonempty indexed family of ordinals
 * `cardinal.ord c`: when `c` is a cardinal, `ord c` is the smallest ordinal with this cardinality.
   It is the canonical way to represent a cardinal with an ordinal.
 
@@ -53,374 +50,19 @@ A conditionally complete linear order with bot structure is registered on ordina
 for the empty set by convention.
 
 ## Notations
-* `r ≼i s`: the type of initial segment embeddings of `r` into `s`.
-* `r ≺i s`: the type of principal segment embeddings of `r` into `s`.
+
 * `ω` is a notation for the first infinite ordinal in the locale `ordinal`.
 -/
 
 noncomputable theory
 
-open function cardinal set equiv
-open_locale classical cardinal
+open function cardinal set equiv order
+open_locale classical cardinal initial_seg
 
 universes u v w
 variables {α : Type*} {β : Type*} {γ : Type*}
   {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
 
-/-!
-### Initial segments
-
-Order embeddings whose range is an initial segment of `s` (i.e., if `b` belongs to the range, then
-any `b' < b` also belongs to the range). The type of these embeddings from `r` to `s` is called
-`initial_seg r s`, and denoted by `r ≼i s`.
--/
-
-/-- If `r` is a relation on `α` and `s` in a relation on `β`, then `f : r ≼i s` is an order
-embedding whose range is an initial segment. That is, whenever `b < f a` in `β` then `b` is in the
-range of `f`. -/
-@[nolint has_inhabited_instance]
-structure initial_seg {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends r ↪r s :=
-(init : ∀ a b, s b (to_rel_embedding a) → ∃ a', to_rel_embedding a' = b)
-
-local infix ` ≼i `:25 := initial_seg
-
-namespace initial_seg
-
-instance : has_coe (r ≼i s) (r ↪r s) := ⟨initial_seg.to_rel_embedding⟩
-instance : has_coe_to_fun (r ≼i s) (λ _, α → β) := ⟨λ f x, (f : r ↪r s) x⟩
-
-@[simp] theorem coe_fn_mk (f : r ↪r s) (o) :
-  (@initial_seg.mk _ _ r s f o : α → β) = f := rfl
-
-@[simp] theorem coe_fn_to_rel_embedding (f : r ≼i s) : (f.to_rel_embedding : α → β) = f := rfl
-
-@[simp] theorem coe_coe_fn (f : r ≼i s) : ((f : r ↪r s) : α → β) = f := rfl
-
-theorem init' (f : r ≼i s) {a : α} {b : β} : s b (f a) → ∃ a', f a' = b :=
-f.init _ _
-
-theorem init_iff (f : r ≼i s) {a : α} {b : β} : s b (f a) ↔ ∃ a', f a' = b ∧ r a' a :=
-⟨λ h, let ⟨a', e⟩ := f.init' h in ⟨a', e, (f : r ↪r s).map_rel_iff.1 (e.symm ▸ h)⟩,
- λ ⟨a', e, h⟩, e ▸ (f : r ↪r s).map_rel_iff.2 h⟩
-
-/-- An order isomorphism is an initial segment -/
-def of_iso (f : r ≃r s) : r ≼i s :=
-⟨f, λ a b h, ⟨f.symm b, rel_iso.apply_symm_apply f _⟩⟩
-
-/-- The identity function shows that `≼i` is reflexive -/
-@[refl] protected def refl (r : α → α → Prop) : r ≼i r :=
-⟨rel_embedding.refl _, λ a b h, ⟨_, rfl⟩⟩
-
-/-- Composition of functions shows that `≼i` is transitive -/
-@[trans] protected def trans (f : r ≼i s) (g : s ≼i t) : r ≼i t :=
-⟨f.1.trans g.1, λ a c h, begin
-  simp at h ⊢,
-  rcases g.2 _ _ h with ⟨b, rfl⟩, have h := g.1.map_rel_iff.1 h,
-  rcases f.2 _ _ h with ⟨a', rfl⟩, exact ⟨a', rfl⟩
-end⟩
-
-@[simp] theorem refl_apply (x : α) : initial_seg.refl r x = x := rfl
-
-@[simp] theorem trans_apply (f : r ≼i s) (g : s ≼i t) (a : α) : (f.trans g) a = g (f a) := rfl
-
-theorem unique_of_extensional [is_extensional β s] :
-  well_founded r → subsingleton (r ≼i s) | ⟨h⟩ :=
-⟨λ f g, begin
-  suffices : (f : α → β) = g, { cases f, cases g,
-    congr, exact rel_embedding.coe_fn_injective this },
-  funext a, have := h a, induction this with a H IH,
-  refine @is_extensional.ext _ s _ _ _ (λ x, ⟨λ h, _, λ h, _⟩),
-  { rcases f.init_iff.1 h with ⟨y, rfl, h'⟩,
-    rw IH _ h', exact (g : r ↪r s).map_rel_iff.2 h' },
-  { rcases g.init_iff.1 h with ⟨y, rfl, h'⟩,
-    rw ← IH _ h', exact (f : r ↪r s).map_rel_iff.2 h' }
-end⟩
-
-instance [is_well_order β s] : subsingleton (r ≼i s) :=
-⟨λ a, @subsingleton.elim _ (unique_of_extensional
-  (@rel_embedding.well_founded _ _ r s a is_well_order.wf)) a⟩
-
-protected theorem eq [is_well_order β s] (f g : r ≼i s) (a) : f a = g a :=
-by rw subsingleton.elim f g
-
-theorem antisymm.aux [is_well_order α r] (f : r ≼i s) (g : s ≼i r) : left_inverse g f :=
-initial_seg.eq (f.trans g) (initial_seg.refl _)
-
-/-- If we have order embeddings between `α` and `β` whose images are initial segments, and `β`
-is a well-order then `α` and `β` are order-isomorphic. -/
-def antisymm [is_well_order β s] (f : r ≼i s) (g : s ≼i r) : r ≃r s :=
-by haveI := f.to_rel_embedding.is_well_order; exact
-⟨⟨f, g, antisymm.aux f g, antisymm.aux g f⟩, f.map_rel_iff'⟩
-
-@[simp] theorem antisymm_to_fun [is_well_order β s]
-  (f : r ≼i s) (g : s ≼i r) : (antisymm f g : α → β) = f := rfl
-
-@[simp] theorem antisymm_symm [is_well_order α r] [is_well_order β s]
-  (f : r ≼i s) (g : s ≼i r) : (antisymm f g).symm = antisymm g f :=
-rel_iso.coe_fn_injective rfl
-
-theorem eq_or_principal [is_well_order β s] (f : r ≼i s) :
-  surjective f ∨ ∃ b, ∀ x, s x b ↔ ∃ y, f y = x :=
-or_iff_not_imp_right.2 $ λ h b,
-acc.rec_on (is_well_order.wf.apply b : acc s b) $ λ x H IH,
-not_forall_not.1 $ λ hn,
-h ⟨x, λ y, ⟨(IH _), λ ⟨a, e⟩, by rw ← e; exact
-  (trichotomous _ _).resolve_right
-  (not_or (hn a) (λ hl, not_exists.2 hn (f.init' hl)))⟩⟩
-
-/-- Restrict the codomain of an initial segment -/
-def cod_restrict (p : set β) (f : r ≼i s) (H : ∀ a, f a ∈ p) : r ≼i subrel s p :=
-⟨rel_embedding.cod_restrict p f H, λ a ⟨b, m⟩ (h : s b (f a)),
-  let ⟨a', e⟩ := f.init' h in ⟨a', by clear _let_match; subst e; refl⟩⟩
-
-@[simp] theorem cod_restrict_apply (p) (f : r ≼i s) (H a) : cod_restrict p f H a = ⟨f a, H a⟩ := rfl
-
-/-- Initial segment embedding of an order `r` into the disjoint union of `r` and `s`. -/
-def le_add (r : α → α → Prop) (s : β → β → Prop) : r ≼i sum.lex r s :=
-⟨⟨⟨sum.inl, λ _ _, sum.inl.inj⟩, λ a b, sum.lex_inl_inl⟩,
-  λ a b, by cases b; [exact λ _, ⟨_, rfl⟩, exact false.elim ∘ sum.lex_inr_inl]⟩
-
-@[simp] theorem le_add_apply (r : α → α → Prop) (s : β → β → Prop)
-  (a) : le_add r s a = sum.inl a := rfl
-
-end initial_seg
-
-/-!
-### Principal segments
-
-Order embeddings whose range is a principal segment of `s` (i.e., an interval of the form
-`(-∞, top)` for some element `top` of `β`). The type of these embeddings from `r` to `s` is called
-`principal_seg r s`, and denoted by `r ≺i s`. Principal segments are in particular initial
-segments.
--/
-
-/-- If `r` is a relation on `α` and `s` in a relation on `β`, then `f : r ≺i s` is an order
-embedding whose range is an open interval `(-∞, top)` for some element `top` of `β`. Such order
-embeddings are called principal segments -/
-@[nolint has_inhabited_instance]
-structure principal_seg {α β : Type*} (r : α → α → Prop) (s : β → β → Prop) extends r ↪r s :=
-(top : β)
-(down : ∀ b, s b top ↔ ∃ a, to_rel_embedding a = b)
-
-local infix ` ≺i `:25 := principal_seg
-
-namespace principal_seg
-
-instance : has_coe (r ≺i s) (r ↪r s) := ⟨principal_seg.to_rel_embedding⟩
-instance : has_coe_to_fun (r ≺i s) (λ _, α → β) := ⟨λ f, f⟩
-
-@[simp] theorem coe_fn_mk (f : r ↪r s) (t o) :
-  (@principal_seg.mk _ _ r s f t o : α → β) = f := rfl
-
-@[simp] theorem coe_fn_to_rel_embedding (f : r ≺i s) : (f.to_rel_embedding : α → β) = f := rfl
-
-@[simp] theorem coe_coe_fn (f : r ≺i s) : ((f : r ↪r s) : α → β) = f := rfl
-
-theorem down' (f : r ≺i s) {b : β} : s b f.top ↔ ∃ a, f a = b :=
-f.down _
-
-theorem lt_top (f : r ≺i s) (a : α) : s (f a) f.top :=
-f.down'.2 ⟨_, rfl⟩
-
-theorem init [is_trans β s] (f : r ≺i s) {a : α} {b : β} (h : s b (f a)) : ∃ a', f a' = b :=
-f.down'.1 $ trans h $ f.lt_top _
-
-/-- A principal segment is in particular an initial segment. -/
-instance has_coe_initial_seg [is_trans β s] : has_coe (r ≺i s) (r ≼i s) :=
-⟨λ f, ⟨f.to_rel_embedding, λ a b, f.init⟩⟩
-
-theorem coe_coe_fn' [is_trans β s] (f : r ≺i s) : ((f : r ≼i s) : α → β) = f := rfl
-
-theorem init_iff [is_trans β s] (f : r ≺i s) {a : α} {b : β} :
-  s b (f a) ↔ ∃ a', f a' = b ∧ r a' a :=
-@initial_seg.init_iff α β r s f a b
-
-theorem irrefl (r : α → α → Prop) [is_well_order α r] (f : r ≺i r) : false :=
-begin
-  have := f.lt_top f.top,
-  rw [show f f.top = f.top, from
-      initial_seg.eq ↑f (initial_seg.refl r) f.top] at this,
-  exact irrefl _ this
-end
-
-/-- Composition of a principal segment with an initial segment, as a principal segment -/
-def lt_le (f : r ≺i s) (g : s ≼i t) : r ≺i t :=
-⟨@rel_embedding.trans _ _ _ r s t f g, g f.top, λ a,
- by simp only [g.init_iff, f.down', exists_and_distrib_left.symm,
-   exists_swap, rel_embedding.trans_apply, exists_eq_right']; refl⟩
-
-@[simp] theorem lt_le_apply (f : r ≺i s) (g : s ≼i t) (a : α) : (f.lt_le g) a = g (f a) :=
-rel_embedding.trans_apply _ _ _
-
-@[simp] theorem lt_le_top (f : r ≺i s) (g : s ≼i t) : (f.lt_le g).top = g f.top := rfl
-
-/-- Composition of two principal segments as a principal segment -/
-@[trans] protected def trans [is_trans γ t] (f : r ≺i s) (g : s ≺i t) : r ≺i t :=
-lt_le f g
-
-@[simp] theorem trans_apply [is_trans γ t] (f : r ≺i s) (g : s ≺i t) (a : α) :
-  (f.trans g) a = g (f a) :=
-lt_le_apply _ _ _
-
-@[simp] theorem trans_top [is_trans γ t] (f : r ≺i s) (g : s ≺i t) :
-  (f.trans g).top = g f.top := rfl
-
-/-- Composition of an order isomorphism with a principal segment, as a principal segment -/
-def equiv_lt (f : r ≃r s) (g : s ≺i t) : r ≺i t :=
-⟨@rel_embedding.trans _ _ _ r s t f g, g.top, λ c,
- suffices (∃ (a : β), g a = c) ↔ ∃ (a : α), g (f a) = c, by simpa [g.down],
- ⟨λ ⟨b, h⟩, ⟨f.symm b, by simp only [h, rel_iso.apply_symm_apply, rel_iso.coe_coe_fn]⟩,
-  λ ⟨a, h⟩, ⟨f a, h⟩⟩⟩
-
-/-- Composition of a principal segment with an order isomorphism, as a principal segment -/
-def lt_equiv {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
-  (f : principal_seg r s) (g : s ≃r t) : principal_seg r t :=
-⟨@rel_embedding.trans _ _ _ r s t f g, g f.top,
-  begin
-    intro x,
-    rw [← g.apply_symm_apply x, g.map_rel_iff, f.down', exists_congr],
-    intro y, exact ⟨congr_arg g, λ h, g.to_equiv.bijective.1 h⟩
-  end⟩
-
-@[simp] theorem equiv_lt_apply (f : r ≃r s) (g : s ≺i t) (a : α) : (equiv_lt f g) a = g (f a) :=
-rel_embedding.trans_apply _ _ _
-
-@[simp] theorem equiv_lt_top (f : r ≃r s) (g : s ≺i t) : (equiv_lt f g).top = g.top := rfl
-
-/-- Given a well order `s`, there is a most one principal segment embedding of `r` into `s`. -/
-instance [is_well_order β s] : subsingleton (r ≺i s) :=
-⟨λ f g, begin
-  have ef : (f : α → β) = g,
-  { show ((f : r ≼i s) : α → β) = g,
-    rw @subsingleton.elim _ _ (f : r ≼i s) g, refl },
-  have et : f.top = g.top,
-  { refine @is_extensional.ext _ s _ _ _ (λ x, _),
-    simp only [f.down, g.down, ef, coe_fn_to_rel_embedding] },
-  cases f, cases g,
-  have := rel_embedding.coe_fn_injective ef; congr'
-end⟩
-
-theorem top_eq [is_well_order γ t]
-  (e : r ≃r s) (f : r ≺i t) (g : s ≺i t) : f.top = g.top :=
-by rw subsingleton.elim f (principal_seg.equiv_lt e g); refl
-
-lemma top_lt_top {r : α → α → Prop} {s : β → β → Prop} {t : γ → γ → Prop}
-  [is_well_order γ t]
-  (f : principal_seg r s) (g : principal_seg s t) (h : principal_seg r t) : t h.top g.top :=
-by { rw [subsingleton.elim h (f.trans g)], apply principal_seg.lt_top }
-
-/-- Any element of a well order yields a principal segment -/
-def of_element {α : Type*} (r : α → α → Prop) (a : α) : subrel r {b | r b a} ≺i r :=
-⟨subrel.rel_embedding _ _, a, λ b,
-  ⟨λ h, ⟨⟨_, h⟩, rfl⟩, λ ⟨⟨_, h⟩, rfl⟩, h⟩⟩
-
-@[simp] theorem of_element_apply {α : Type*} (r : α → α → Prop) (a : α) (b) :
-  of_element r a b = b.1 := rfl
-
-@[simp] theorem of_element_top {α : Type*} (r : α → α → Prop) (a : α) :
-  (of_element r a).top = a := rfl
-
-/-- Restrict the codomain of a principal segment -/
-def cod_restrict (p : set β) (f : r ≺i s)
-  (H : ∀ a, f a ∈ p) (H₂ : f.top ∈ p) : r ≺i subrel s p :=
-⟨rel_embedding.cod_restrict p f H, ⟨f.top, H₂⟩, λ ⟨b, h⟩,
-  f.down'.trans $ exists_congr $ λ a,
-  show (⟨f a, H a⟩ : p).1 = _ ↔ _, from ⟨subtype.eq, congr_arg _⟩⟩
-
-@[simp]
-theorem cod_restrict_apply (p) (f : r ≺i s) (H H₂ a) : cod_restrict p f H H₂ a = ⟨f a, H a⟩ := rfl
-
-@[simp]
-theorem cod_restrict_top (p) (f : r ≺i s) (H H₂) : (cod_restrict p f H H₂).top = ⟨f.top, H₂⟩ := rfl
-
-end principal_seg
-
-/-! ### Properties of initial and principal segments -/
-
-/-- To an initial segment taking values in a well order, one can associate either a principal
-segment (if the range is not everything, hence one can take as top the minimum of the complement
-of the range) or an order isomorphism (if the range is everything). -/
-def initial_seg.lt_or_eq [is_well_order β s] (f : r ≼i s) :
-  (r ≺i s) ⊕ (r ≃r s) :=
-if h : surjective f then sum.inr (rel_iso.of_surjective f h) else
-have h' : _, from (initial_seg.eq_or_principal f).resolve_left h,
-sum.inl ⟨f, classical.some h', classical.some_spec h'⟩
-
-theorem initial_seg.lt_or_eq_apply_left [is_well_order β s]
-  (f : r ≼i s) (g : r ≺i s) (a : α) : g a = f a :=
-@initial_seg.eq α β r s _ g f a
-
-theorem initial_seg.lt_or_eq_apply_right [is_well_order β s]
-  (f : r ≼i s) (g : r ≃r s) (a : α) : g a = f a :=
-initial_seg.eq (initial_seg.of_iso g) f a
-
-/-- Composition of an initial segment taking values in a well order and a principal segment. -/
-def initial_seg.le_lt [is_well_order β s] [is_trans γ t] (f : r ≼i s) (g : s ≺i t) : r ≺i t :=
-match f.lt_or_eq with
-| sum.inl f' := f'.trans g
-| sum.inr f' := principal_seg.equiv_lt f' g
-end
-
-@[simp] theorem initial_seg.le_lt_apply [is_well_order β s] [is_trans γ t]
-  (f : r ≼i s) (g : s ≺i t) (a : α) : (f.le_lt g) a = g (f a) :=
-begin
-  delta initial_seg.le_lt, cases h : f.lt_or_eq with f' f',
-  { simp only [principal_seg.trans_apply, f.lt_or_eq_apply_left] },
-  { simp only [principal_seg.equiv_lt_apply, f.lt_or_eq_apply_right] }
-end
-
-namespace rel_embedding
-
-/-- Given an order embedding into a well order, collapse the order embedding by filling the
-gaps, to obtain an initial segment. Here, we construct the collapsed order embedding pointwise,
-but the proof of the fact that it is an initial segment will be given in `collapse`. -/
-def collapse_F [is_well_order β s] (f : r ↪r s) : Π a, {b // ¬ s (f a) b} :=
-(rel_embedding.well_founded f $ is_well_order.wf).fix $ λ a IH, begin
-  let S := {b | ∀ a h, s (IH a h).1 b},
-  have : f a ∈ S, from λ a' h, ((trichotomous _ _)
-    .resolve_left $ λ h', (IH a' h).2 $ trans (f.map_rel_iff.2 h) h')
-    .resolve_left $ λ h', (IH a' h).2 $ h' ▸ f.map_rel_iff.2 h,
-  exact ⟨is_well_order.wf.min S ⟨_, this⟩,
-   is_well_order.wf.not_lt_min _ _ this⟩
-end
-
-theorem collapse_F.lt [is_well_order β s] (f : r ↪r s) {a : α}
-   : ∀ {a'}, r a' a → s (collapse_F f a').1 (collapse_F f a).1 :=
-show (collapse_F f a).1 ∈ {b | ∀ a' (h : r a' a), s (collapse_F f a').1 b}, begin
-  unfold collapse_F, rw well_founded.fix_eq,
-  apply well_founded.min_mem _ _
-end
-
-theorem collapse_F.not_lt [is_well_order β s] (f : r ↪r s) (a : α)
-   {b} (h : ∀ a' (h : r a' a), s (collapse_F f a').1 b) : ¬ s b (collapse_F f a).1 :=
-begin
-  unfold collapse_F, rw well_founded.fix_eq,
-  exact well_founded.not_lt_min _ _ _
-    (show b ∈ {b | ∀ a' (h : r a' a), s (collapse_F f a').1 b}, from h)
-end
-
-/-- Construct an initial segment from an order embedding into a well order, by collapsing it
-to fill the gaps. -/
-def collapse [is_well_order β s] (f : r ↪r s) : r ≼i s :=
-by haveI := rel_embedding.is_well_order f; exact
-⟨rel_embedding.of_monotone
-  (λ a, (collapse_F f a).1) (λ a b, collapse_F.lt f),
-λ a b, acc.rec_on (is_well_order.wf.apply b : acc s b) (λ b H IH a h, begin
-  let S := {a | ¬ s (collapse_F f a).1 b},
-  have : S.nonempty := ⟨_, asymm h⟩,
-  existsi (is_well_order.wf : well_founded r).min S this,
-  refine ((@trichotomous _ s _ _ _).resolve_left _).resolve_right _,
-  { exact (is_well_order.wf : well_founded r).min_mem S this },
-  { refine collapse_F.not_lt f _ (λ a' h', _),
-    by_contradiction hn,
-    exact is_well_order.wf.not_lt_min S this hn h' }
-end) a⟩
-
-theorem collapse_apply [is_well_order β s] (f : r ↪r s)
-  (a) : collapse f a = (collapse_F f a).1 := rfl
-
-end rel_embedding
-
 /-! ### Well order on an arbitrary type -/
 
 section well_ordering_thm
@@ -428,7 +70,7 @@ parameter {σ : Type u}
 open function
 
 theorem nonempty_embedding_to_cardinal : nonempty (σ ↪ cardinal.{u}) :=
-embedding.total.resolve_left $ λ ⟨⟨f, hf⟩⟩,
+(embedding.total _ _).resolve_left $ λ ⟨⟨f, hf⟩⟩,
   let g : σ → cardinal.{u} := inv_fun f in
   let ⟨x, (hx : g x = 2 ^ sum g)⟩ := inv_fun_surjective hf (2 ^ sum g) in
   have g x ≤ sum g, from le_sum.{u u} g x,
@@ -444,6 +86,9 @@ def well_ordering_rel : σ → σ → Prop := embedding_to_cardinal ⁻¹'o (<)
 instance well_ordering_rel.is_well_order : is_well_order σ well_ordering_rel :=
 (rel_embedding.preimage _ _).is_well_order
 
+instance is_well_order.subtype_nonempty : nonempty {r // is_well_order σ r} :=
+⟨⟨well_ordering_rel, infer_instance⟩⟩
+
 end well_ordering_thm
 
 /-! ### Definition of ordinals -/
@@ -461,6 +106,8 @@ namespace Well_order
 
 instance : inhabited Well_order := ⟨⟨pempty, _, empty_relation.is_well_order⟩⟩
 
+@[simp] lemma eta (o : Well_order) : mk o.α o.r o.wo = o := by { cases o, refl }
+
 end Well_order
 
 /-- Equivalence relation on well orders on arbitrary types in universe `u`, given by order
@@ -474,42 +121,95 @@ instance ordinal.is_equivalent : setoid Well_order :=
 /-- `ordinal.{u}` is the type of well orders in `Type u`, up to order isomorphism. -/
 def ordinal : Type (u + 1) := quotient ordinal.is_equivalent
 
-instance (o : ordinal) : has_well_founded o.out.α := ⟨o.out.r, o.out.wo.wf⟩
+instance has_well_founded_out (o : ordinal) : has_well_founded o.out.α := ⟨o.out.r, o.out.wo.wf⟩
 
-instance (o : ordinal) : linear_order o.out.α :=
+instance linear_order_out (o : ordinal) : linear_order o.out.α :=
 is_well_order.linear_order o.out.r
 
-instance ordinal.is_well_order_lt (o : ordinal) : is_well_order o.out.α (<) :=
+instance is_well_order_out_lt (o : ordinal) : is_well_order o.out.α (<) :=
 o.out.wo
 
 namespace ordinal
 
+/- ### Basic properties of the order type -/
+
 /-- The order type of a well order is an ordinal. -/
 def type (r : α → α → Prop) [wo : is_well_order α r] : ordinal :=
 ⟦⟨α, r, wo⟩⟧
 
+instance : has_zero ordinal := ⟨type $ @empty_relation pempty⟩
+instance : inhabited ordinal := ⟨0⟩
+instance : has_one ordinal := ⟨type $ @empty_relation punit⟩
+
 /-- The order type of an element inside a well order. For the embedding as a principal segment, see
 `typein.principal_seg`. -/
 def typein (r : α → α → Prop) [is_well_order α r] (a : α) : ordinal :=
 type (subrel r {b | r b a})
 
-theorem type_def (r : α → α → Prop) [wo : is_well_order α r] :
-  @eq ordinal ⟦⟨α, r, wo⟩⟧ (type r) := rfl
+@[simp] theorem type_def' (w : Well_order) : ⟦w⟧ = type w.r :=
+by { cases w, refl }
+
+@[simp] theorem type_def (r) [wo : is_well_order α r] : (⟦⟨α, r, wo⟩⟧ : ordinal) = type r :=
+rfl
 
-@[simp] theorem type_def' (r : α → α → Prop) [is_well_order α r] {wo} :
-  @eq ordinal ⟦⟨α, r, wo⟩⟧ (type r) := rfl
+@[simp] lemma type_out (o : ordinal) : ordinal.type o.out.r = o :=
+by rw [ordinal.type, Well_order.eta, quotient.out_eq]
 
 theorem type_eq {α β} {r : α → α → Prop} {s : β → β → Prop}
-  [is_well_order α r] [is_well_order β s] :
-  type r = type s ↔ nonempty (r ≃r s) := quotient.eq
+  [is_well_order α r] [is_well_order β s] : type r = type s ↔ nonempty (r ≃r s) :=
+quotient.eq
+
+theorem _root_.rel_iso.ordinal_type_eq {α β} {r : α → α → Prop} {s : β → β → Prop}
+  [is_well_order α r] [is_well_order β s] (h : r ≃r s) : type r = type s :=
+type_eq.2 ⟨h⟩
 
 @[simp] theorem type_lt (o : ordinal) : type ((<) : o.out.α → o.out.α → Prop) = o :=
-begin
-  change type o.out.r = _,
-  refine eq.trans _ (quotient.out_eq o),
-  cases quotient.out o,
-  refl
-end
+(type_def' _).symm.trans $ quotient.out_eq o
+
+theorem type_eq_zero_of_empty (r) [is_well_order α r] [is_empty α] : type r = 0 :=
+(rel_iso.rel_iso_of_is_empty r _).ordinal_type_eq
+
+@[simp] theorem type_eq_zero_iff_is_empty [is_well_order α r] : type r = 0 ↔ is_empty α :=
+⟨λ h, let ⟨s⟩ := type_eq.1 h in s.to_equiv.is_empty, @type_eq_zero_of_empty α r _⟩
+
+theorem type_ne_zero_iff_nonempty [is_well_order α r] : type r ≠ 0 ↔ nonempty α := by simp
+
+theorem type_ne_zero_of_nonempty (r) [is_well_order α r] [h : nonempty α] : type r ≠ 0 :=
+type_ne_zero_iff_nonempty.2 h
+
+theorem type_pempty : type (@empty_relation pempty) = 0 := rfl
+theorem type_empty : type (@empty_relation empty) = 0 := type_eq_zero_of_empty _
+
+theorem type_eq_one_of_unique (r) [is_well_order α r] [unique α] : type r = 1 :=
+(rel_iso.rel_iso_of_unique_of_irrefl r _).ordinal_type_eq
+
+@[simp] theorem type_eq_one_iff_unique [is_well_order α r] : type r = 1 ↔ nonempty (unique α) :=
+⟨λ h, let ⟨s⟩ := type_eq.1 h in ⟨s.to_equiv.unique⟩, λ ⟨h⟩, @type_eq_one_of_unique α r _ h⟩
+
+theorem type_punit : type (@empty_relation punit) = 1 := rfl
+theorem type_unit : type (@empty_relation unit) = 1 := rfl
+
+@[simp] theorem out_empty_iff_eq_zero {o : ordinal} : is_empty o.out.α ↔ o = 0 :=
+by rw [←@type_eq_zero_iff_is_empty o.out.α (<), type_lt]
+
+lemma eq_zero_of_out_empty (o : ordinal) [h : is_empty o.out.α] : o = 0 :=
+out_empty_iff_eq_zero.1 h
+
+instance is_empty_out_zero : is_empty (0 : ordinal).out.α := out_empty_iff_eq_zero.2 rfl
+
+@[simp] theorem out_nonempty_iff_ne_zero {o : ordinal} : nonempty o.out.α ↔ o ≠ 0 :=
+by rw [←@type_ne_zero_iff_nonempty o.out.α (<), type_lt]
+
+lemma ne_zero_of_out_nonempty (o : ordinal) [h : nonempty o.out.α] : o ≠ 0 :=
+out_nonempty_iff_ne_zero.1 h
+
+protected lemma one_ne_zero : (1 : ordinal) ≠ 0 := type_ne_zero_of_nonempty _
+
+instance : nontrivial ordinal.{u} := ⟨⟨1, 0, ordinal.one_ne_zero⟩⟩
+
+@[simp] theorem type_preimage {α β : Type u} (r : α → α → Prop) [is_well_order α r] (f : β ≃ α) :
+  type (f ⁻¹'o r) = type r :=
+(rel_iso.preimage f r).ordinal_type_eq
 
 @[elab_as_eliminator] theorem induction_on {C : ordinal → Prop}
   (o : ordinal) (H : ∀ α r [is_well_order α r], by exactI C (type r)) : C o :=
@@ -517,60 +217,79 @@ quot.induction_on o $ λ ⟨α, r, wo⟩, @H α r wo
 
 /-! ### The order on ordinals -/
 
+instance : partial_order ordinal :=
+{ le := λ a b, quotient.lift_on₂ a b (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≼i s)) $
+    λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
+    propext ⟨
+      λ ⟨h⟩, ⟨(initial_seg.of_iso f.symm).trans $
+        h.trans (initial_seg.of_iso g)⟩,
+      λ ⟨h⟩, ⟨(initial_seg.of_iso f).trans $
+        h.trans (initial_seg.of_iso g.symm)⟩⟩,
+  lt := λ a b, quotient.lift_on₂ a b (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≺i s)) $
+    λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
+    by exactI propext ⟨
+      λ ⟨h⟩, ⟨principal_seg.equiv_lt f.symm $
+        h.lt_le (initial_seg.of_iso g)⟩,
+      λ ⟨h⟩, ⟨principal_seg.equiv_lt f $
+        h.lt_le (initial_seg.of_iso g.symm)⟩⟩,
+  le_refl := quot.ind $ by exact λ ⟨α, r, wo⟩, ⟨initial_seg.refl _⟩,
+  le_trans := λ a b c, quotient.induction_on₃ a b c $
+    λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨f⟩ ⟨g⟩, ⟨f.trans g⟩,
+  lt_iff_le_not_le := λ a b, quotient.induction_on₂ a b $
+    λ ⟨α, r, _⟩ ⟨β, s, _⟩, by exactI
+      ⟨λ ⟨f⟩, ⟨⟨f⟩, λ ⟨g⟩, (f.lt_le g).irrefl⟩,
+      λ ⟨⟨f⟩, h⟩, sum.rec_on f.lt_or_eq (λ g, ⟨g⟩)
+      (λ g, (h ⟨initial_seg.of_iso g.symm⟩).elim)⟩,
+  le_antisymm := λ a b,
+    quotient.induction_on₂ a b $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨h₁⟩ ⟨h₂⟩,
+    by exactI quot.sound ⟨initial_seg.antisymm h₁ h₂⟩ }
+
 /-- Ordinal less-equal is defined such that
   well orders `r` and `s` satisfy `type r ≤ type s` if there exists
   a function embedding `r` as an initial segment of `s`. -/
-protected def le (a b : ordinal) : Prop :=
-quotient.lift_on₂ a b (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≼i s)) $
-λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
-propext ⟨
-  λ ⟨h⟩, ⟨(initial_seg.of_iso f.symm).trans $
-    h.trans (initial_seg.of_iso g)⟩,
-  λ ⟨h⟩, ⟨(initial_seg.of_iso f).trans $
-    h.trans (initial_seg.of_iso g.symm)⟩⟩
-
-instance : has_le ordinal := ⟨ordinal.le⟩
-
-theorem type_le {α β} {r : α → α → Prop} {s : β → β → Prop}
+add_decl_doc ordinal.partial_order.le
+
+/-- Ordinal less-than is defined such that
+  well orders `r` and `s` satisfy `type r < type s` if there exists
+  a function embedding `r` as a principal segment of `s`. -/
+add_decl_doc ordinal.partial_order.lt
+
+theorem type_le_iff {α β} {r : α → α → Prop} {s : β → β → Prop}
   [is_well_order α r] [is_well_order β s] :
   type r ≤ type s ↔ nonempty (r ≼i s) := iff.rfl
 
-theorem type_le' {α β} {r : α → α → Prop} {s : β → β → Prop}
+theorem type_le_iff' {α β} {r : α → α → Prop} {s : β → β → Prop}
   [is_well_order α r] [is_well_order β s] : type r ≤ type s ↔ nonempty (r ↪r s) :=
 ⟨λ ⟨f⟩, ⟨f⟩, λ ⟨f⟩, ⟨f.collapse⟩⟩
 
-/-- Ordinal less-than is defined such that
-  well orders `r` and `s` satisfy `type r < type s` if there exists
-  a function embedding `r` as a principal segment of `s`. -/
-def lt (a b : ordinal) : Prop :=
-quotient.lift_on₂ a b (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, nonempty (r ≺i s)) $
-λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
-by exactI propext ⟨
-  λ ⟨h⟩, ⟨principal_seg.equiv_lt f.symm $
-    h.lt_le (initial_seg.of_iso g)⟩,
-  λ ⟨h⟩, ⟨principal_seg.equiv_lt f $
-    h.lt_le (initial_seg.of_iso g.symm)⟩⟩
+theorem _root_.initial_seg.ordinal_type_le {α β} {r : α → α → Prop} {s : β → β → Prop}
+  [is_well_order α r] [is_well_order β s] (h : r ≼i s) : type r ≤ type s := ⟨h⟩
 
-instance : has_lt ordinal := ⟨ordinal.lt⟩
+theorem _root_.rel_embedding.ordinal_type_le {α β} {r : α → α → Prop} {s : β → β → Prop}
+  [is_well_order α r] [is_well_order β s] (h : r ↪r s) : type r ≤ type s := ⟨h.collapse⟩
 
 @[simp] theorem type_lt_iff {α β} {r : α → α → Prop} {s : β → β → Prop}
   [is_well_order α r] [is_well_order β s] :
   type r < type s ↔ nonempty (r ≺i s) := iff.rfl
 
-instance : partial_order ordinal :=
-{ le := (≤),
-  lt := (<),
-  le_refl := quot.ind $ by exact λ ⟨α, r, wo⟩, ⟨initial_seg.refl _⟩,
-  le_trans := λ a b c, quotient.induction_on₃ a b c $
-    λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨f⟩ ⟨g⟩, ⟨f.trans g⟩,
-  lt_iff_le_not_le := λ a b, quotient.induction_on₂ a b $
-    λ ⟨α, r, _⟩ ⟨β, s, _⟩, by exactI
-      ⟨λ ⟨f⟩, ⟨⟨f⟩, λ ⟨g⟩, (f.lt_le g).irrefl _⟩,
-      λ ⟨⟨f⟩, h⟩, sum.rec_on f.lt_or_eq (λ g, ⟨g⟩)
-       (λ g, (h ⟨initial_seg.of_iso g.symm⟩).elim)⟩,
-  le_antisymm := λ x b, show x ≤ b → b ≤ x → x = b, from
-    quotient.induction_on₂ x b $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨h₁⟩ ⟨h₂⟩,
-    by exactI quot.sound ⟨initial_seg.antisymm h₁ h₂⟩ }
+theorem _root_.principal_seg.ordinal_type_lt {α β} {r : α → α → Prop} {s : β → β → Prop}
+  [is_well_order α r] [is_well_order β s] (h : r ≺i s) : type r < type s := ⟨h⟩
+
+protected theorem zero_le (o : ordinal) : 0 ≤ o :=
+induction_on o $ λ α r _, by exactI (initial_seg.of_is_empty _ r).ordinal_type_le
+
+instance : order_bot ordinal := ⟨0, ordinal.zero_le⟩
+
+@[simp] lemma bot_eq_zero : (⊥ : ordinal) = 0 := rfl
+
+@[simp] protected theorem le_zero {o : ordinal} : o ≤ 0 ↔ o = 0 := le_bot_iff
+protected theorem pos_iff_ne_zero {o : ordinal} : 0 < o ↔ o ≠ 0 := bot_lt_iff_ne_bot
+protected theorem not_lt_zero (o : ordinal) : ¬ o < 0 := not_lt_bot
+theorem eq_zero_or_pos : ∀ a : ordinal, a = 0 ∨ 0 < a := eq_bot_or_bot_lt
+
+instance : zero_le_one_class ordinal := ⟨ordinal.zero_le _⟩
+
+instance ne_zero.one : ne_zero (1 : ordinal) := ⟨ordinal.one_ne_zero⟩
 
 /-- Given two ordinals `α ≤ β`, then `initial_seg_out α β` is the initial segment embedding
 of `α` to `β`, as map from a model type for `α` to a model type for `β`. -/
@@ -592,16 +311,6 @@ begin
   cases quotient.out α, cases quotient.out β, exact classical.choice
 end
 
-/-- Given two ordinals `α = β`, then `rel_iso_out α β` is the order isomorphism between two
-model types for `α` and `β`. -/
-def rel_iso_out {α β : ordinal} (h : α = β) :
-  ((<) : α.out.α → α.out.α → Prop) ≃r ((<) : β.out.α → β.out.α → Prop) :=
-begin
-  change α.out.r ≃r β.out.r,
-  rw [←quotient.out_eq α, ←quotient.out_eq β] at h, revert h,
-  cases quotient.out α, cases quotient.out β, exact classical.choice ∘ quotient.exact
-end
-
 theorem typein_lt_type (r : α → α → Prop) [is_well_order α r] (a : α) : typein r a < type r :=
 ⟨principal_seg.of_element _ _⟩
 
@@ -613,7 +322,7 @@ by { simp_rw ←type_lt o, apply typein_lt_type }
   typein s f.top = type r :=
 eq.symm $ quot.sound ⟨rel_iso.of_surjective
   (rel_embedding.cod_restrict _ f f.lt_top)
-  (λ ⟨a, h⟩, by rcases f.down'.1 h with ⟨b, rfl⟩; exact ⟨b, rfl⟩)⟩
+  (λ ⟨a, h⟩, by rcases f.down.1 h with ⟨b, rfl⟩; exact ⟨b, rfl⟩)⟩
 
 @[simp] theorem typein_apply {α β} {r : α → α → Prop} {s : β → β → Prop}
   [is_well_order α r] [is_well_order β s] (f : r ≼i s) (a : α) :
@@ -622,7 +331,7 @@ eq.symm $ quotient.sound ⟨rel_iso.of_surjective
   (rel_embedding.cod_restrict _
     ((subrel.rel_embedding _ _).trans f)
     (λ ⟨x, h⟩, by rw [rel_embedding.trans_apply]; exact f.to_rel_embedding.map_rel_iff.2 h))
-  (λ ⟨y, h⟩, by rcases f.init' h with ⟨a, rfl⟩;
+  (λ ⟨y, h⟩, by rcases f.init h with ⟨a, rfl⟩;
     exact ⟨⟨a, f.to_rel_embedding.map_rel_iff.1 h⟩, subtype.eq $ rel_embedding.trans_apply _ _ _⟩)⟩
 
 @[simp] theorem typein_lt_typein (r : α → α → Prop) [is_well_order α r]
@@ -645,32 +354,33 @@ induction_on o (λ β s _ ⟨f⟩, by exactI ⟨f.top, typein_top _⟩) h
 lemma typein_injective (r : α → α → Prop) [is_well_order α r] : injective (typein r) :=
 injective_of_increasing r (<) (typein r) (λ x y, (typein_lt_typein r).2)
 
-theorem typein_inj (r : α → α → Prop) [is_well_order α r]
+@[simp] theorem typein_inj (r : α → α → Prop) [is_well_order α r]
   {a b} : typein r a = typein r b ↔ a = b :=
-injective.eq_iff (typein_injective r)
+(typein_injective r).eq_iff
+
+/-- Principal segment version of the `typein` function, embedding a well order into
+  ordinals as a principal segment. -/
+def typein.principal_seg (r : α → α → Prop) [is_well_order α r] :
+  r ≺i ((<) : ordinal → ordinal → Prop) :=
+⟨⟨⟨typein r, typein_injective r⟩, λ a b, typein_lt_typein r⟩, type r,
+  λ o, ⟨typein_surj r, λ ⟨a, h⟩, h ▸ typein_lt_type r a⟩⟩
+
+@[simp] theorem typein.principal_seg_coe (r : α → α → Prop) [is_well_order α r] :
+  (typein.principal_seg r : α → ordinal) = typein r := rfl
 
 /-! ### Enumerating elements in a well-order with ordinals. -/
 
 /-- `enum r o h` is the `o`-th element of `α` ordered by `r`.
   That is, `enum` maps an initial segment of the ordinals, those
   less than the order type of `r`, to the elements of `α`. -/
-def enum (r : α → α → Prop) [is_well_order α r] (o) : o < type r → α :=
-quot.rec_on o (λ ⟨β, s, _⟩ h, (classical.choice h).top) $
-λ ⟨β, s, _⟩ ⟨γ, t, _⟩ ⟨h⟩, begin
-  resetI, refine funext (λ (H₂ : type t < type r), _),
-  have H₁ : type s < type r, {rwa type_eq.2 ⟨h⟩},
-  have : ∀ {o e} (H : o < type r), @@eq.rec
-   (λ (o : ordinal), o < type r → α)
-   (λ (h : type s < type r), (classical.choice h).top)
-     e H = (classical.choice H₁).top, {intros, subst e},
-  exact (this H₂).trans (principal_seg.top_eq h
-    (classical.choice H₁) (classical.choice H₂))
-end
+def enum (r : α → α → Prop) [is_well_order α r] (o) (h : o < type r) : α :=
+(typein.principal_seg r).subrel_iso ⟨o, h⟩
 
 theorem enum_type {α β} {r : α → α → Prop} {s : β → β → Prop}
   [is_well_order α r] [is_well_order β s] (f : s ≺i r)
   {h : type s < type r} : enum r (type s) h = f.top :=
-principal_seg.top_eq (rel_iso.refl _) _ _
+(typein.principal_seg r).injective $
+  ((typein.principal_seg r).apply_subrel_iso _).trans (typein_top _).symm
 
 @[simp] theorem enum_typein (r : α → α → Prop) [is_well_order α r] (a : α) :
   enum r (typein r a) (typein_lt_type r a) = a :=
@@ -681,20 +391,6 @@ enum_type (principal_seg.of_element r a)
 let ⟨a, e⟩ := typein_surj r h in
 by clear _let_match; subst e; rw enum_typein
 
-/-- The equivalence between ordinals less than `o` and `o.out.α`. -/
-@[simps] noncomputable def out_equiv_lt (o : ordinal) : {o' : ordinal // o' < o} ≃ o.out.α :=
-{ to_fun := λ ⟨o', h⟩, enum (<) o' (by rwa type_lt),
-  inv_fun := λ x, ⟨typein (<) x, typein_lt_self x⟩,
-  left_inv := λ ⟨o', h⟩, subtype.ext_val (typein_enum _ _),
-  right_inv := λ h, enum_typein _ _ }
-
-/-- A well order `r` is order isomorphic to the set of ordinals strictly smaller than the
-ordinal version of `r`. -/
-def typein_iso (r : α → α → Prop) [is_well_order α r] : r ≃r subrel (<) (< type r) :=
-⟨⟨λ x, ⟨typein r x, typein_lt_type r x⟩, λ x, enum r x.1 x.2, λ y, enum_typein r y,
- λ ⟨y, hy⟩, subtype.eq (typein_enum r hy)⟩,
-  λ a b, (typein_lt_typein r)⟩
-
 theorem enum_lt_enum {r : α → α → Prop} [is_well_order α r]
   {o₁ o₂ : ordinal} (h₁ : o₁ < type r) (h₂ : o₂ < type r) :
   r (enum r o₁ h₁) (enum r o₂ h₂) ↔ o₁ < o₂ :=
@@ -716,97 +412,40 @@ lemma rel_iso_enum {α β : Type u} {r : α → α → Prop} {s : β → β →
   enum s o (by {convert hr using 1, apply quotient.sound, exact ⟨f.symm⟩ }) :=
 rel_iso_enum' _ _ _ _
 
-theorem wf : @well_founded ordinal (<) :=
-⟨λ a, induction_on a $ λ α r wo, by exactI
-suffices ∀ a, acc (<) (typein r a), from
-⟨_, λ o h, let ⟨a, e⟩ := typein_surj r h in e ▸ this a⟩,
-λ a, acc.rec_on (wo.wf.apply a) $ λ x H IH, ⟨_, λ o h, begin
-  rcases typein_surj r (lt_trans h (typein_lt_type r _)) with ⟨b, rfl⟩,
-  exact IH _ ((typein_lt_typein r).1 h)
-end⟩⟩
+theorem lt_wf : @well_founded ordinal (<) :=
+well_founded_iff_well_founded_subrel.mpr $ λ a, induction_on a $ λ α r wo, by exactI
+  rel_hom_class.well_founded (typein.principal_seg r).subrel_iso wo.wf
 
-instance : has_well_founded ordinal := ⟨(<), wf⟩
+instance : has_well_founded ordinal := ⟨(<), lt_wf⟩
 
 /-- Reformulation of well founded induction on ordinals as a lemma that works with the
 `induction` tactic, as in `induction i using ordinal.induction with i IH`. -/
 lemma induction {p : ordinal.{u} → Prop} (i : ordinal.{u})
   (h : ∀ j, (∀ k, k < j → p k) → p j) : p i :=
-ordinal.wf.induction i h
-
-/-- Principal segment version of the `typein` function, embedding a well order into
-  ordinals as a principal segment. -/
-def typein.principal_seg {α : Type u} (r : α → α → Prop) [is_well_order α r] :
-  @principal_seg α ordinal.{u} r (<) :=
-⟨rel_embedding.of_monotone (typein r)
-  (λ a b, (typein_lt_typein r).2), type r, λ b,
-    ⟨λ h, ⟨enum r _ h, typein_enum r h⟩,
-    λ ⟨a, e⟩, e ▸ typein_lt_type _ _⟩⟩
-
-@[simp] theorem typein.principal_seg_coe (r : α → α → Prop) [is_well_order α r] :
-  (typein.principal_seg r : α → ordinal) = typein r := rfl
+lt_wf.induction i h
 
 /-! ### Cardinality of ordinals -/
 
-/-- The cardinal of an ordinal is the cardinal of any
-  set with that order type. -/
-def card (o : ordinal) : cardinal :=
-quot.lift_on o (λ a, #a.α) $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨e⟩, quotient.sound ⟨e.to_equiv⟩
+/-- The cardinal of an ordinal is the cardinality of any type on which a relation with that order
+type is defined. -/
+def card : ordinal → cardinal := quotient.map Well_order.α $ λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨e⟩, ⟨e.to_equiv⟩
 
-@[simp] theorem card_type (r : α → α → Prop) [is_well_order α r] :
-  card (type r) = #α := rfl
+@[simp] theorem card_type (r : α → α → Prop) [is_well_order α r] : card (type r) = #α := rfl
 
-lemma card_typein {r : α → α → Prop} [wo : is_well_order α r] (x : α) :
-  #{y // r y x} = (typein r x).card := rfl
+@[simp] lemma card_typein {r : α → α → Prop} [wo : is_well_order α r] (x : α) :
+  #{y // r y x} = (typein r x).card :=
+rfl
 
 theorem card_le_card {o₁ o₂ : ordinal} : o₁ ≤ o₂ → card o₁ ≤ card o₂ :=
 induction_on o₁ $ λ α r _, induction_on o₂ $ λ β s _ ⟨⟨⟨f, _⟩, _⟩⟩, ⟨f⟩
 
-instance : has_zero ordinal :=
-⟨⟦⟨pempty, empty_relation, by apply_instance⟩⟧⟩
-
-instance : inhabited ordinal := ⟨0⟩
-
-theorem zero_eq_type_empty : 0 = @type empty empty_relation _ :=
-quotient.sound ⟨⟨empty_equiv_pempty.symm, λ _ _, iff.rfl⟩⟩
-
 @[simp] theorem card_zero : card 0 = 0 := rfl
 
-protected theorem zero_le (o : ordinal) : 0 ≤ o :=
-induction_on o $ λ α r _, ⟨⟨⟨embedding.of_is_empty, is_empty_elim⟩, is_empty_elim⟩⟩
-
-@[simp] protected theorem le_zero {o : ordinal} : o ≤ 0 ↔ o = 0 :=
-by simp only [le_antisymm_iff, ordinal.zero_le, and_true]
-
-protected theorem pos_iff_ne_zero {o : ordinal} : 0 < o ↔ o ≠ 0 :=
-by simp only [lt_iff_le_and_ne, ordinal.zero_le, true_and, ne.def, eq_comm]
-
-lemma eq_zero_of_out_empty (o : ordinal) [h : is_empty o.out.α] : o = 0 :=
-begin
-  by_contra ho,
-  replace ho := ordinal.pos_iff_ne_zero.2 ho,
-  rw ←type_lt o at ho,
-  have α := enum (<) 0 ho,
-  exact h.elim α
-end
-
-@[simp] theorem out_empty_iff_eq_zero {o : ordinal} : is_empty o.out.α ↔ o = 0 :=
-begin
-  refine ⟨@eq_zero_of_out_empty o, λ h, ⟨λ i, _⟩⟩,
-  subst o,
-  exact (ordinal.zero_le _).not_lt (typein_lt_self i)
-end
-
-@[simp] theorem out_nonempty_iff_ne_zero {o : ordinal} : nonempty o.out.α ↔ o ≠ 0 :=
-by rw [←not_iff_not, ←not_is_empty_iff, not_not, not_not, out_empty_iff_eq_zero]
-
-instance : is_empty (0 : ordinal).out.α :=
-out_empty_iff_eq_zero.2 rfl
-
-instance : has_one ordinal :=
-⟨⟦⟨punit, empty_relation, by apply_instance⟩⟧⟩
-
-theorem one_eq_type_unit : 1 = @type unit empty_relation _ :=
-quotient.sound ⟨⟨punit_equiv_punit, λ _ _, iff.rfl⟩⟩
+@[simp] theorem card_eq_zero {o} : card o = 0 ↔ o = 0 :=
+⟨induction_on o $ λ α r _ h, begin
+  haveI := cardinal.mk_eq_zero_iff.1 h,
+  apply type_eq_zero_of_empty
+end, λ e, by simp only [e, card_zero]⟩
 
 @[simp] theorem card_one : card 1 = 1 := rfl
 
@@ -816,42 +455,58 @@ quotient.sound ⟨⟨punit_equiv_punit, λ _ _, iff.rfl⟩⟩
   a proper initial segment of `ordinal.{v}` for `v > u`. For the initial segment version,
   see `lift.initial_seg`. -/
 def lift (o : ordinal.{v}) : ordinal.{max v u} :=
-quotient.lift_on o (λ ⟨α, r, wo⟩,
-  @type _ _ (@rel_embedding.is_well_order _ _ (@equiv.ulift.{u} α ⁻¹'o r) r
-    (rel_iso.preimage equiv.ulift.{u} r) wo)) $
-λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨f⟩,
-quot.sound ⟨(rel_iso.preimage equiv.ulift r).trans $
-  f.trans (rel_iso.preimage equiv.ulift s).symm⟩
-
-theorem lift_type {α} (r : α → α → Prop) [is_well_order α r] :
-  ∃ wo', lift (type r) = @type _ (@equiv.ulift.{v} α ⁻¹'o r) wo' :=
-⟨_, rfl⟩
-
-theorem lift_umax : lift.{(max u v) u} = lift.{v u} :=
+quotient.lift_on o (λ w, type $ ulift.down ⁻¹'o w.r) $
+  λ ⟨α, r, _⟩ ⟨β, s, _⟩ ⟨f⟩, quot.sound ⟨(rel_iso.preimage equiv.ulift r).trans $
+    f.trans (rel_iso.preimage equiv.ulift s).symm⟩
+
+@[simp] theorem type_ulift (r : α → α → Prop) [is_well_order α r] :
+  type (ulift.down ⁻¹'o r) = lift.{v} (type r) :=
+rfl
+
+theorem _root_.rel_iso.ordinal_lift_type_eq {α : Type u} {β : Type v}
+  {r : α → α → Prop} {s : β → β → Prop} [is_well_order α r] [is_well_order β s] (f : r ≃r s) :
+  lift.{v} (type r) = lift.{u} (type s) :=
+((rel_iso.preimage equiv.ulift r).trans $
+  f.trans (rel_iso.preimage equiv.ulift s).symm).ordinal_type_eq
+
+@[simp] theorem type_lift_preimage {α : Type u} {β : Type v} (r : α → α → Prop) [is_well_order α r]
+  (f : β ≃ α) : lift.{u} (type (f ⁻¹'o r)) = lift.{v} (type r) :=
+(rel_iso.preimage f r).ordinal_lift_type_eq
+
+/-- `lift.{(max u v) u}` equals `lift.{v u}`. Using `set_option pp.universes true` will make it much
+    easier to understand what's happening when using this lemma. -/
+@[simp] theorem lift_umax : lift.{(max u v) u} = lift.{v u} :=
 funext $ λ a, induction_on a $ λ α r _,
 quotient.sound ⟨(rel_iso.preimage equiv.ulift r).trans (rel_iso.preimage equiv.ulift r).symm⟩
 
-theorem lift_id' (a : ordinal) : lift a = a :=
-induction_on a $ λ α r _,
-quotient.sound ⟨rel_iso.preimage equiv.ulift r⟩
+/-- `lift.{(max v u) u}` equals `lift.{v u}`. Using `set_option pp.universes true` will make it much
+    easier to understand what's happening when using this lemma. -/
+@[simp] theorem lift_umax' : lift.{(max v u) u} = lift.{v u} := lift_umax
 
+/-- An ordinal lifted to a lower or equal universe equals itself. -/
+@[simp] theorem lift_id' (a : ordinal) : lift a = a :=
+induction_on a $ λ α r _, quotient.sound ⟨rel_iso.preimage equiv.ulift r⟩
+
+/-- An ordinal lifted to the same universe equals itself. -/
 @[simp] theorem lift_id : ∀ a, lift.{u u} a = a := lift_id'.{u u}
 
-@[simp]
-theorem lift_lift (a : ordinal) : lift.{w} (lift.{v} a) = lift.{(max v w)} a :=
+/-- An ordinal lifted to the zero universe equals itself. -/
+@[simp] theorem lift_uzero (a : ordinal.{u}) : lift.{0} a = a := lift_id'.{0 u} a
+
+@[simp] theorem lift_lift (a : ordinal) : lift.{w} (lift.{v} a) = lift.{max v w} a :=
 induction_on a $ λ α r _,
 quotient.sound ⟨(rel_iso.preimage equiv.ulift _).trans $
   (rel_iso.preimage equiv.ulift _).trans (rel_iso.preimage equiv.ulift _).symm⟩
 
 theorem lift_type_le {α : Type u} {β : Type v} {r s} [is_well_order α r] [is_well_order β s] :
-  lift.{(max v w)} (type r) ≤ lift.{(max u w)} (type s) ↔ nonempty (r ≼i s) :=
+  lift.{max v w} (type r) ≤ lift.{max u w} (type s) ↔ nonempty (r ≼i s) :=
 ⟨λ ⟨f⟩, ⟨(initial_seg.of_iso (rel_iso.preimage equiv.ulift r).symm).trans $
     f.trans (initial_seg.of_iso (rel_iso.preimage equiv.ulift s))⟩,
  λ ⟨f⟩, ⟨(initial_seg.of_iso (rel_iso.preimage equiv.ulift r)).trans $
     f.trans (initial_seg.of_iso (rel_iso.preimage equiv.ulift s).symm)⟩⟩
 
 theorem lift_type_eq {α : Type u} {β : Type v} {r s} [is_well_order α r] [is_well_order β s] :
-  lift.{(max v w)} (type r) = lift.{(max u w)} (type s) ↔ nonempty (r ≃r s) :=
+  lift.{max v w} (type r) = lift.{max u w} (type s) ↔ nonempty (r ≃r s) :=
 quotient.eq.trans
 ⟨λ ⟨f⟩, ⟨(rel_iso.preimage equiv.ulift r).symm.trans $
     f.trans (rel_iso.preimage equiv.ulift s)⟩,
@@ -859,19 +514,18 @@ quotient.eq.trans
     f.trans (rel_iso.preimage equiv.ulift s).symm⟩⟩
 
 theorem lift_type_lt {α : Type u} {β : Type v} {r s} [is_well_order α r] [is_well_order β s] :
-  lift.{(max v w)} (type r) < lift.{(max u w)} (type s) ↔ nonempty (r ≺i s) :=
-by haveI := @rel_embedding.is_well_order _ _ (@equiv.ulift.{(max v w)} α ⁻¹'o r)
-     r (rel_iso.preimage equiv.ulift.{(max v w)} r) _;
-   haveI := @rel_embedding.is_well_order _ _ (@equiv.ulift.{(max u w)} β ⁻¹'o s)
-     s (rel_iso.preimage equiv.ulift.{(max u w)} s) _; exact
+  lift.{max v w} (type r) < lift.{max u w} (type s) ↔ nonempty (r ≺i s) :=
+by haveI := @rel_embedding.is_well_order _ _ (@equiv.ulift.{max v w} α ⁻¹'o r)
+     r (rel_iso.preimage equiv.ulift.{max v w} r) _;
+   haveI := @rel_embedding.is_well_order _ _ (@equiv.ulift.{max u w} β ⁻¹'o s)
+     s (rel_iso.preimage equiv.ulift.{max u w} s) _; exact
 ⟨λ ⟨f⟩, ⟨(f.equiv_lt (rel_iso.preimage equiv.ulift r).symm).lt_le
     (initial_seg.of_iso (rel_iso.preimage equiv.ulift s))⟩,
  λ ⟨f⟩, ⟨(f.equiv_lt (rel_iso.preimage equiv.ulift r)).lt_le
     (initial_seg.of_iso (rel_iso.preimage equiv.ulift s).symm)⟩⟩
 
 @[simp] theorem lift_le {a b : ordinal} : lift.{u v} a ≤ lift b ↔ a ≤ b :=
-induction_on a $ λ α r _, induction_on b $ λ β s _,
-by rw ← lift_umax; exactI lift_type_le
+induction_on a $ λ α r _, induction_on b $ λ β s _, by { rw ← lift_umax, exactI lift_type_le }
 
 @[simp] theorem lift_inj {a b : ordinal} : lift a = lift b ↔ a = b :=
 by simp only [le_antisymm_iff, lift_le]
@@ -879,19 +533,8 @@ by simp only [le_antisymm_iff, lift_le]
 @[simp] theorem lift_lt {a b : ordinal} : lift a < lift b ↔ a < b :=
 by simp only [lt_iff_le_not_le, lift_le]
 
-@[simp] theorem lift_zero : lift 0 = 0 :=
-quotient.sound ⟨(rel_iso.preimage equiv.ulift _).trans
- ⟨pempty_equiv_pempty, λ a b, iff.rfl⟩⟩
-
-theorem zero_eq_lift_type_empty : 0 = lift.{u} (@type empty empty_relation _) :=
-by rw [← zero_eq_type_empty, lift_zero]
-
-@[simp] theorem lift_one : lift 1 = 1 :=
-quotient.sound ⟨(rel_iso.preimage equiv.ulift _).trans
- ⟨punit_equiv_punit, λ a b, iff.rfl⟩⟩
-
-theorem one_eq_lift_type_unit : 1 = lift.{u} (@type unit empty_relation _) :=
-by rw [← one_eq_type_unit, lift_one]
+@[simp] theorem lift_zero : lift 0 = 0 := type_eq_zero_of_empty _
+@[simp] theorem lift_one : lift 1 = 1 := type_eq_one_of_unique _
 
 @[simp] theorem lift_card (a) : (card a).lift = card (lift a) :=
 induction_on a $ λ α r _, rfl
@@ -939,11 +582,14 @@ def lift.initial_seg : @initial_seg ordinal.{u} ordinal.{max u v} (<) (<) :=
 /-- `ω` is the first infinite ordinal, defined as the order type of `ℕ`. -/
 def omega : ordinal.{u} := lift $ @type ℕ (<) _
 
-localized "notation `ω` := ordinal.omega.{0}" in ordinal
+localized "notation (name := ordinal.omega) `ω` := ordinal.omega" in ordinal
+
+/-- Note that the presence of this lemma makes `simp [omega]` form a loop. -/
+@[simp] theorem type_nat_lt : @type ℕ (<) _ = ω := (lift_id _).symm
 
-theorem card_omega : card omega = cardinal.omega := rfl
+@[simp] theorem card_omega : card ω = ℵ₀ := rfl
 
-@[simp] theorem lift_omega : lift omega = omega := lift_lift _
+@[simp] theorem lift_omega : lift ω = ω := lift_lift _
 
 /-!
 ### Definition and first properties of addition on ordinals
@@ -957,30 +603,15 @@ the addition, together with properties of the other operations, are proved in
 /-- `o₁ + o₂` is the order on the disjoint union of `o₁` and `o₂` obtained by declaring that
   every element of `o₁` is smaller than every element of `o₂`. -/
 instance : has_add ordinal.{u} :=
-⟨λo₁ o₂, quotient.lift_on₂ o₁ o₂
-  (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, ⟦⟨α ⊕ β, sum.lex r s, by exactI sum.lex.is_well_order _ _⟩⟧
-    : Well_order → Well_order → ordinal) $
-λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
-quot.sound ⟨rel_iso.sum_lex_congr f g⟩⟩
+⟨λ o₁ o₂, quotient.lift_on₂ o₁ o₂
+  (λ ⟨α, r, wo⟩ ⟨β, s, wo'⟩, by exactI type (sum.lex r s)) $
+  λ ⟨α₁, r₁, o₁⟩ ⟨α₂, r₂, o₂⟩ ⟨β₁, s₁, p₁⟩ ⟨β₂, s₂, p₂⟩ ⟨f⟩ ⟨g⟩,
+  quot.sound ⟨rel_iso.sum_lex_congr f g⟩⟩
 
-@[simp] theorem card_add (o₁ o₂ : ordinal) : card (o₁ + o₂) = card o₁ + card o₂ :=
-induction_on o₁ $ λ α r _, induction_on o₂ $ λ β s _, rfl
-
-@[simp] theorem card_nat (n : ℕ) : card.{u} n = n :=
-by induction n; [refl, simp only [card_add, card_one, nat.cast_succ, *]]
-
-@[simp] theorem type_add {α β : Type u} (r : α → α → Prop) (s : β → β → Prop)
-  [is_well_order α r] [is_well_order β s] : type r + type s = type (sum.lex r s) := rfl
-
-/-- The ordinal successor is the smallest ordinal larger than `o`.
-  It is defined as `o + 1`. -/
-def succ (o : ordinal) : ordinal := o + 1
-
-theorem succ_eq_add_one (o) : succ o = o + 1 := rfl
-
-instance : add_monoid ordinal.{u} :=
+instance : add_monoid_with_one ordinal.{u} :=
 { add       := (+),
   zero      := 0,
+  one       := 1,
   zero_add  := λ o, induction_on o $ λ α r _, eq.symm $ quotient.sound
     ⟨⟨(empty_sum pempty α).symm, λ a b, sum.lex_inr_inr⟩⟩,
   add_zero  := λ o, induction_on o $ λ α r _, eq.symm $ quotient.sound
@@ -992,7 +623,16 @@ instance : add_monoid ordinal.{u} :=
       simp only [sum_assoc_apply_inl_inl, sum_assoc_apply_inl_inr, sum_assoc_apply_inr,
         sum.lex_inl_inl, sum.lex_inr_inr, sum.lex.sep, sum.lex_inr_inl] end⟩⟩ }
 
-instance has_le.le.add_covariant_class : covariant_class ordinal.{u} ordinal.{u} (+) (≤) :=
+@[simp] theorem card_add (o₁ o₂ : ordinal) : card (o₁ + o₂) = card o₁ + card o₂ :=
+induction_on o₁ $ λ α r _, induction_on o₂ $ λ β s _, rfl
+
+@[simp] theorem type_sum_lex {α β : Type u} (r : α → α → Prop) (s : β → β → Prop)
+  [is_well_order α r] [is_well_order β s] : type (sum.lex r s) = type r + type s := rfl
+
+@[simp] theorem card_nat (n : ℕ) : card.{u} n = n :=
+by induction n; [refl, simp only [card_add, card_one, nat.cast_succ, *]]
+
+instance add_covariant_class_le : covariant_class ordinal.{u} ordinal.{u} (+) (≤) :=
 ⟨λ c a b h, begin
   revert h c, exact (
   induction_on a $ λ α₁ r₁ _, induction_on b $ λ α₂ r₂ _ ⟨⟨⟨f, fo⟩, fi⟩⟩ c,
@@ -1012,19 +652,17 @@ instance has_le.le.add_covariant_class : covariant_class ordinal.{u} ordinal.{u}
     end⟩⟩)
 end⟩
 
-instance has_le.le.add_swap_covariant_class :
-  covariant_class ordinal.{u} ordinal.{u} (function.swap (+)) (≤) :=
+instance add_swap_covariant_class_le : covariant_class ordinal.{u} ordinal.{u} (swap (+)) (≤) :=
 ⟨λ c a b h, begin
   revert h c, exact (
   induction_on a $ λ α₁ r₁ hr₁, induction_on b $ λ α₂ r₂ hr₂ ⟨⟨⟨f, fo⟩, fi⟩⟩ c,
-  induction_on c $ λ β s hs, (@type_le' _ _ _ _
-    (@sum.lex.is_well_order _ _ _ _ hr₁ hs)
-    (@sum.lex.is_well_order _ _ _ _ hr₂ hs)).2
-  ⟨⟨f.sum_map (embedding.refl _), λ a b, begin
+  induction_on c $ λ β s hs, by exactI
+  @rel_embedding.ordinal_type_le _ _ (sum.lex r₁ s) (sum.lex r₂ s) _ _
+  ⟨f.sum_map (embedding.refl _), λ a b, begin
     split; intro H,
     { cases a with a a; cases b with b b; cases H; constructor; [rwa ← fo, assumption] },
     { cases H; constructor; [rwa fo, assumption] }
-  end⟩⟩)
+  end⟩)
 end⟩
 
 theorem le_add_right (a b : ordinal) : a ≤ a + b :=
@@ -1033,22 +671,47 @@ by simpa only [add_zero] using add_le_add_left (ordinal.zero_le b) a
 theorem le_add_left (a b : ordinal) : a ≤ b + a :=
 by simpa only [zero_add] using add_le_add_right (ordinal.zero_le b) a
 
-theorem lt_succ_self (o : ordinal.{u}) : o < succ o :=
-induction_on o $ λ α r _, ⟨⟨⟨⟨λ x, sum.inl x, λ _ _, sum.inl.inj⟩,
-  λ _ _, sum.lex_inl_inl⟩,
-sum.inr punit.star, λ b, sum.rec_on b
-  (λ x, ⟨λ _, ⟨x, rfl⟩, λ _, sum.lex.sep _ _⟩)
-  (λ x, sum.lex_inr_inr.trans ⟨false.elim, λ ⟨x, H⟩, sum.inl_ne_inr H⟩)⟩⟩
+instance : linear_order ordinal :=
+{ le_total     := λ a b,
+    match lt_or_eq_of_le (le_add_left b a), lt_or_eq_of_le (le_add_right a b) with
+    | or.inr h, _ := by rw h; exact or.inl (le_add_right _ _)
+    | _, or.inr h := by rw h; exact or.inr (le_add_left _ _)
+    | or.inl h₁, or.inl h₂ := induction_on a (λ α₁ r₁ _,
+      induction_on b $ λ α₂ r₂ _ ⟨f⟩ ⟨g⟩, begin
+        resetI,
+        rw [← typein_top f, ← typein_top g, le_iff_lt_or_eq,
+            le_iff_lt_or_eq, typein_lt_typein, typein_lt_typein],
+        rcases trichotomous_of (sum.lex r₁ r₂) g.top f.top with h|h|h;
+        [exact or.inl (or.inl h), {left, right, rw h}, exact or.inr (or.inl h)]
+      end) h₁ h₂
+    end,
+  decidable_le := classical.dec_rel _,
+  ..ordinal.partial_order }
 
-theorem succ_ne_self (o : ordinal.{u}) : succ o ≠ o := (lt_succ_self o).ne'
+instance : well_founded_lt ordinal := ⟨lt_wf⟩
+instance : is_well_order ordinal (<) := { }
 
-theorem succ_le {a b : ordinal} : succ a ≤ b ↔ a < b :=
-⟨lt_of_lt_of_le (lt_succ_self _),
+instance : conditionally_complete_linear_order_bot ordinal :=
+is_well_order.conditionally_complete_linear_order_bot _
+
+@[simp] lemma max_zero_left : ∀ a : ordinal, max 0 a = a := max_bot_left
+@[simp] lemma max_zero_right : ∀ a : ordinal, max a 0 = a := max_bot_right
+@[simp] lemma max_eq_zero {a b : ordinal} : max a b = 0 ↔ a = 0 ∧ b = 0 := max_eq_bot
+
+@[simp] theorem Inf_empty : Inf (∅ : set ordinal) = 0 :=
+dif_neg not_nonempty_empty
+
+/- ### Successor order properties -/
+
+private theorem succ_le_iff' {a b : ordinal} : a + 1 ≤ b ↔ a < b :=
+⟨lt_of_lt_of_le (induction_on a $ λ α r _, ⟨⟨⟨⟨λ x, sum.inl x, λ _ _, sum.inl.inj⟩,
+  λ _ _, sum.lex_inl_inl⟩,
+  sum.inr punit.star, λ b, sum.rec_on b
+    (λ x, ⟨λ _, ⟨x, rfl⟩, λ _, sum.lex.sep _ _⟩)
+    (λ x, sum.lex_inr_inr.trans ⟨false.elim, λ ⟨x, H⟩, sum.inl_ne_inr H⟩)⟩⟩),
 induction_on a $ λ α r hr, induction_on b $ λ β s hs ⟨⟨f, t, hf⟩⟩, begin
-  refine ⟨⟨@rel_embedding.of_monotone (α ⊕ punit) β _ _
-    (@sum.lex.is_well_order _ _ _ _ hr _).1.1
-    (@is_asymm_of_is_trans_of_is_irrefl _ _ hs.1.2.2 hs.1.2.1)
-    (sum.rec _ _) (λ a b, _), λ a b, _⟩⟩,
+  haveI := hs,
+  refine ⟨⟨@rel_embedding.of_monotone (α ⊕ punit) β _ _ _ _ (sum.rec _ _) (λ a b, _), λ a b, _⟩⟩,
   { exact f }, { exact λ _, t },
   { rcases a with a|_; rcases b with b|_,
     { simpa only [sum.lex_inl_inl] using f.map_rel_iff.2 },
@@ -1056,36 +719,60 @@ induction_on a $ λ α r hr, induction_on b $ λ β s hs ⟨⟨f, t, hf⟩⟩, b
     { exact false.elim ∘ sum.lex_inr_inl },
     { exact false.elim ∘ sum.lex_inr_inr.1 } },
   { rcases a with a|_,
-    { intro h, have := @principal_seg.init _ _ _ _ hs.1.2.2 ⟨f, t, hf⟩ _ _ h,
+    { intro h, have := @principal_seg.init _ _ _ _ _ ⟨f, t, hf⟩ _ _ h,
       cases this with w h, exact ⟨sum.inl w, h⟩ },
     { intro h, cases (hf b).1 h with w h, exact ⟨sum.inl w, h⟩ } }
 end⟩
 
-theorem le_total (a b : ordinal) : a ≤ b ∨ b ≤ a :=
-match lt_or_eq_of_le (le_add_left b a), lt_or_eq_of_le (le_add_right a b) with
-| or.inr h, _ := by rw h; exact or.inl (le_add_right _ _)
-| _, or.inr h := by rw h; exact or.inr (le_add_left _ _)
-| or.inl h₁, or.inl h₂ := induction_on a (λ α₁ r₁ _,
-  induction_on b $ λ α₂ r₂ _ ⟨f⟩ ⟨g⟩, begin
-    resetI,
-    rw [← typein_top f, ← typein_top g, le_iff_lt_or_eq,
-        le_iff_lt_or_eq, typein_lt_typein, typein_lt_typein],
-    rcases trichotomous_of (sum.lex r₁ r₂) g.top f.top with h|h|h;
-    [exact or.inl (or.inl h), {left, right, rw h}, exact or.inr (or.inl h)]
-  end) h₁ h₂
-end
+instance : no_max_order ordinal := ⟨λ a, ⟨_, succ_le_iff'.1 le_rfl⟩⟩
 
-instance : linear_order ordinal :=
-{ le_total     := le_total,
-  decidable_le := classical.dec_rel _,
-  ..ordinal.partial_order }
+instance : succ_order ordinal.{u} := succ_order.of_succ_le_iff (λ o, o + 1) (λ a b, succ_le_iff')
+
+@[simp] theorem add_one_eq_succ (o : ordinal) : o + 1 = succ o := rfl
+
+@[simp] theorem succ_zero : succ (0 : ordinal) = 1 := zero_add 1
+@[simp] theorem succ_one : succ (1 : ordinal) = 2 := rfl
+
+theorem add_succ (o₁ o₂ : ordinal) : o₁ + succ o₂ = succ (o₁ + o₂) :=
+(add_assoc _ _ _).symm
+
+theorem one_le_iff_pos {o : ordinal} : 1 ≤ o ↔ 0 < o :=
+by rw [← succ_zero, succ_le_iff]
+
+theorem one_le_iff_ne_zero {o : ordinal} : 1 ≤ o ↔ o ≠ 0 :=
+by rw [one_le_iff_pos, ordinal.pos_iff_ne_zero]
+
+theorem succ_pos (o : ordinal) : 0 < succ o := bot_lt_succ o
+theorem succ_ne_zero (o : ordinal) : succ o ≠ 0 := ne_of_gt $ succ_pos o
+theorem lt_one_iff_zero {a : ordinal} : a < 1 ↔ a = 0 := by simpa using @lt_succ_bot_iff _ _ _ a _ _
+theorem le_one_iff {a : ordinal} : a ≤ 1 ↔ a = 0 ∨ a = 1 :=
+by simpa using @le_succ_bot_iff _ _ _ a _
+
+@[simp] theorem card_succ (o : ordinal) : card (succ o) = card o + 1 :=
+by simp only [←add_one_eq_succ, card_add, card_one]
+
+theorem nat_cast_succ (n : ℕ) : ↑n.succ = succ (n : ordinal) := rfl
 
-instance : is_well_order ordinal (<) := ⟨wf⟩
+instance unique_Iio_one : unique (Iio (1 : ordinal)) :=
+{ default := ⟨0, zero_lt_one⟩,
+  uniq := λ a, subtype.ext $ lt_one_iff_zero.1 a.prop }
 
-instance : succ_order ordinal := succ_order.of_succ_le_iff succ (λ _ _, succ_le)
+instance unique_out_one : unique (1 : ordinal).out.α :=
+{ default := enum (<) 0 (by simp),
+  uniq := λ a, begin
+    rw ←enum_typein (<) a,
+    unfold default,
+    congr,
+    rw ←lt_one_iff_zero,
+    apply typein_lt_self
+  end }
 
-theorem lt_succ {a b : ordinal} : a < succ b ↔ a ≤ b :=
-by rw [← not_le, succ_le, not_lt]
+theorem one_out_eq (x : (1 : ordinal).out.α) : x = enum (<) 0 (by simp) := unique.eq_default x
+
+/-! ### Extra properties of typein and enum -/
+
+@[simp] theorem typein_one_out (x : (1 : ordinal).out.α) : typein (<) x = 0 :=
+by rw [one_out_eq x, typein_enum]
 
 @[simp] lemma typein_le_typein (r : α → α → Prop) [is_well_order α r] {x x' : α} :
   typein r x ≤ typein r x' ↔ ¬r x' x :=
@@ -1095,12 +782,12 @@ by rw [←not_lt, typein_lt_typein]
   typein (<) x ≤ typein (<) x' ↔ x ≤ x' :=
 by { rw typein_le_typein, exact not_lt }
 
-lemma enum_le_enum (r : α → α → Prop) [is_well_order α r] {o o' : ordinal}
+@[simp] lemma enum_le_enum (r : α → α → Prop) [is_well_order α r] {o o' : ordinal}
   (ho : o < type r) (ho' : o' < type r) : ¬r (enum r o' ho') (enum r o ho) ↔ o ≤ o' :=
 by rw [←@not_lt _ _ o' o, enum_lt_enum ho']
 
-lemma enum_le_enum' (a : ordinal) {o o' : ordinal} (ho : o < a) (ho' : o' < a) :
-  @enum a.out.α (<) _ o (by rwa type_lt) ≤ @enum a.out.α (<) _ o' (by rwa type_lt) ↔ o ≤ o' :=
+@[simp] lemma enum_le_enum' (a : ordinal) {o o' : ordinal}
+  (ho : o < type (<)) (ho' : o' < type (<)) : enum (<) o ho ≤ @enum a.out.α (<) _ o' ho' ↔ o ≤ o' :=
 by rw [←enum_le_enum (<), ←not_lt]
 
 theorem enum_zero_le {r : α → α → Prop} [is_well_order α r] (h0 : 0 < type r) (a : α) :
@@ -1111,24 +798,27 @@ theorem enum_zero_le' {o : ordinal} (h0 : 0 < o) (a : o.out.α) :
   @enum o.out.α (<) _ 0 (by rwa type_lt) ≤ a :=
 by { rw ←not_lt, apply enum_zero_le }
 
-theorem le_enum_succ {o : ordinal} (a : o.succ.out.α) :
-  a ≤ @enum o.succ.out.α (<) _ o (by { rw type_lt, exact lt_succ_self o }) :=
-begin
-  rw ←enum_typein (<) a,
-  apply (enum_le_enum' o.succ _ _).2,
-  rw ←lt_succ,
-  all_goals { apply typein_lt_self }
-end
+theorem le_enum_succ {o : ordinal} (a : (succ o).out.α) :
+  a ≤ @enum (succ o).out.α (<) _ o (by { rw type_lt, exact lt_succ o }) :=
+by { rw [←enum_typein (<) a, enum_le_enum', ←lt_succ_iff], apply typein_lt_self }
 
-theorem enum_inj {r : α → α → Prop} [is_well_order α r] {o₁ o₂ : ordinal} (h₁ : o₁ < type r)
+@[simp] theorem enum_inj {r : α → α → Prop} [is_well_order α r] {o₁ o₂ : ordinal} (h₁ : o₁ < type r)
   (h₂ : o₂ < type r) : enum r o₁ h₁ = enum r o₂ h₂ ↔ o₁ = o₂ :=
-⟨λ h, begin
-  by_contra hne,
-  cases lt_or_gt_of_ne hne with hlt hlt;
-    apply (is_well_order.is_irrefl r).1,
-    { rwa [←@enum_lt_enum α r _ o₁ o₂ h₁ h₂, h] at hlt },
-    { change _ < _ at hlt, rwa [←@enum_lt_enum α r _ o₂ o₁ h₂ h₁, h] at hlt }
-end, λ h, by simp_rw h⟩
+(typein.principal_seg r).subrel_iso.injective.eq_iff.trans subtype.mk_eq_mk
+
+/-- A well order `r` is order isomorphic to the set of ordinals smaller than `type r`. -/
+@[simps] def enum_iso (r : α → α → Prop) [is_well_order α r] : subrel (<) (< type r) ≃r r :=
+{ to_fun := λ x, enum r x.1 x.2,
+  inv_fun := λ x, ⟨typein r x, typein_lt_type r x⟩,
+  ..(typein.principal_seg r).subrel_iso }
+
+/-- The order isomorphism between ordinals less than `o` and `o.out.α`. -/
+@[simps] noncomputable def enum_iso_out (o : ordinal) : set.Iio o ≃o o.out.α :=
+{ to_fun := λ x, enum (<) x.1 $ by { rw type_lt, exact x.2 },
+  inv_fun := λ x, ⟨typein (<) x, typein_lt_self x⟩,
+  left_inv := λ ⟨o', h⟩, subtype.ext_val (typein_enum _ _),
+  right_inv := λ h, enum_typein _ _,
+  map_rel_iff' := by { rintros ⟨a, _⟩ ⟨b, _⟩, apply enum_le_enum' } }
 
 /-- `o.out.α` is an `order_bot` whenever `0 < o`. -/
 def out_order_bot_of_pos {o : ordinal} (ho : 0 < o) : order_bot o.out.α :=
@@ -1138,12 +828,14 @@ theorem enum_zero_eq_bot {o : ordinal} (ho : 0 < o) :
   enum (<) 0 (by rwa type_lt) = by { haveI H := out_order_bot_of_pos ho, exact ⊥ } :=
 rfl
 
+/-! ### Universal ordinal -/
+
 /-- `univ.{u v}` is the order type of the ordinals of `Type u` as a member
   of `ordinal.{v}` (when `u < v`). It is an inaccessible cardinal. -/
 @[nolint check_univs] -- intended to be used with explicit universe parameters
-def univ : ordinal.{max (u + 1) v} := lift.{v (u+1)} (@type ordinal.{u} (<) _)
+def univ : ordinal.{max (u + 1) v} := lift.{v (u+1)} (@type ordinal (<) _)
 
-theorem univ_id : univ.{u (u+1)} = @type ordinal.{u} (<) _ := lift_id _
+theorem univ_id : univ.{u (u+1)} = @type ordinal (<) _ := lift_id _
 
 @[simp] theorem lift_univ : lift.{w} univ.{u v} = univ.{u (max v w)} := lift_lift _
 
@@ -1174,61 +866,14 @@ def lift.principal_seg : @principal_seg ordinal.{u} ordinal.{max (u+1) v} (<) (<
 end⟩
 
 @[simp] theorem lift.principal_seg_coe :
-  (lift.principal_seg.{u v} : ordinal → ordinal) = lift.{(max (u+1) v)} := rfl
+  (lift.principal_seg.{u v} : ordinal → ordinal) = lift.{max (u+1) v} := rfl
 
 @[simp] theorem lift.principal_seg_top : lift.principal_seg.top = univ := rfl
 
 theorem lift.principal_seg_top' :
-  lift.principal_seg.{u (u+1)}.top = @type ordinal.{u} (<) _ :=
+  lift.principal_seg.{u (u+1)}.top = @type ordinal (<) _ :=
 by simp only [lift.principal_seg_top, univ_id]
 
-/-! ### Minimum -/
-
-/-- The minimal element of a nonempty family of ordinals -/
-def min {ι} (I : nonempty ι) (f : ι → ordinal) : ordinal :=
-wf.min (set.range f) (let ⟨i⟩ := I in ⟨_, set.mem_range_self i⟩)
-
-theorem min_eq {ι} (I) (f : ι → ordinal) : ∃ i, min I f = f i :=
-let ⟨i, e⟩ := wf.min_mem (set.range f) _ in ⟨i, e.symm⟩
-
-theorem min_le {ι I} (f : ι → ordinal) (i) : min I f ≤ f i :=
-le_of_not_gt $ wf.not_lt_min (set.range f) _ (set.mem_range_self i)
-
-theorem le_min {ι I} {f : ι → ordinal} {a} : a ≤ min I f ↔ ∀ i, a ≤ f i :=
-⟨λ h i, le_trans h (min_le _ _),
- λ h, let ⟨i, e⟩ := min_eq I f in e.symm ▸ h i⟩
-
-@[simp] theorem lift_min {ι} (I) (f : ι → ordinal) : lift (min I f) = min I (lift ∘ f) :=
-le_antisymm (le_min.2 $ λ a, lift_le.2 $ min_le _ a) $
-let ⟨i, e⟩ := min_eq I (lift ∘ f) in
-by rw e; exact lift_le.2 (le_min.2 $ λ j, lift_le.1 $
-by have := min_le (lift ∘ f) j; rwa e at this)
-
-instance : conditionally_complete_linear_order_bot ordinal :=
-wf.conditionally_complete_linear_order_with_bot 0 $ le_antisymm (ordinal.zero_le _) $
-  not_lt.1 (wf.not_lt_min set.univ ⟨0, mem_univ _⟩ (mem_univ 0))
-
-@[simp] lemma bot_eq_zero : (⊥ : ordinal) = 0 := rfl
-
-@[simp] lemma max_zero_left : ∀ a : ordinal, max 0 a = a := max_bot_left
-@[simp] lemma max_zero_right : ∀ a : ordinal, max a 0 = a := max_bot_right
-@[simp] lemma max_eq_zero {a b : ordinal} : max a b = 0 ↔ a = 0 ∧ b = 0 := max_eq_bot
-
-protected theorem not_lt_zero (o : ordinal) : ¬ o < 0 :=
-not_lt_bot
-
-theorem eq_zero_or_pos : ∀ a : ordinal, a = 0 ∨ 0 < a :=
-eq_bot_or_bot_lt
-
-instance : no_max_order ordinal :=
-⟨λ a, ⟨a.succ, lt_succ_self a⟩⟩
-
-@[simp] theorem Inf_empty : Inf (∅ : set ordinal) = 0 :=
-begin
-  change dite _ (wf.min ∅) (λ _, 0) = 0,
-  simp only [not_nonempty_empty, not_false_iff, dif_neg]
-end
-
 end ordinal
 
 /-! ### Representing a cardinal with an ordinal -/
@@ -1236,42 +881,33 @@ end ordinal
 namespace cardinal
 open ordinal
 
-@[simp] theorem mk_ordinal_out (o : ordinal.{u}) : #(o.out.α) = o.card :=
-by { convert (ordinal.card_type (<)).symm, exact (ordinal.type_lt o).symm }
+@[simp] theorem mk_ordinal_out (o : ordinal) : #(o.out.α) = o.card :=
+(ordinal.card_type _).symm.trans $ by rw ordinal.type_lt
 
 /-- The ordinal corresponding to a cardinal `c` is the least ordinal
   whose cardinal is `c`. For the order-embedding version, see `ord.order_embedding`. -/
 def ord (c : cardinal) : ordinal :=
+let F := λ α : Type u, ⨅ r : {r // is_well_order α r}, @type α r.1 r.2 in
+quot.lift_on c F
 begin
-  let ι := λ α, {r // is_well_order α r},
-  have : Π α, ι α := λ α, ⟨well_ordering_rel, by apply_instance⟩,
-  let F := λ α, ordinal.min ⟨this _⟩ (λ i:ι α, ⟦⟨α, i.1, i.2⟩⟧),
-  refine quot.lift_on c F _,
   suffices : ∀ {α β}, α ≈ β → F α ≤ F β,
-  from λ α β h, le_antisymm (this h) (this (setoid.symm h)),
-  intros α β h, cases h with f, refine ordinal.le_min.2 (λ i, _),
-  haveI := @rel_embedding.is_well_order _ _
-    (f ⁻¹'o i.1) _ ↑(rel_iso.preimage f i.1) i.2,
-  rw ← show type (f ⁻¹'o i.1) = ⟦⟨β, i.1, i.2⟩⟧, from
-    quot.sound ⟨rel_iso.preimage f i.1⟩,
-  exact ordinal.min_le (λ i:ι α, ⟦⟨α, i.1, i.2⟩⟧) ⟨_, _⟩
+  from λ α β h, (this h).antisymm (this (setoid.symm h)),
+  rintros α β ⟨f⟩,
+  refine le_cinfi_iff'.2 (λ i, _),
+  haveI := @rel_embedding.is_well_order _ _ (f ⁻¹'o i.1) _ ↑(rel_iso.preimage f i.1) i.2,
+  exact (cinfi_le' _ (subtype.mk (⇑f ⁻¹'o i.val)
+    (@rel_embedding.is_well_order _ _  _ _ ↑(rel_iso.preimage f i.1) i.2))).trans_eq
+    (quot.sound ⟨rel_iso.preimage f i.1⟩)
 end
 
-lemma ord_eq_min (α : Type u) : ord (#α) =
-  @ordinal.min {r // is_well_order α r} ⟨⟨well_ordering_rel, by apply_instance⟩⟩
-    (λ i, ⟦⟨α, i.1, i.2⟩⟧) := rfl
+lemma ord_eq_Inf (α : Type u) : ord (#α) = ⨅ r : {r // is_well_order α r}, @type α r.1 r.2 :=
+rfl
 
-theorem ord_eq (α) : ∃ (r : α → α → Prop) [wo : is_well_order α r],
-  ord (#α) = @type α r wo :=
-let ⟨⟨r, wo⟩, h⟩ := @ordinal.min_eq {r // is_well_order α r}
-  ⟨⟨well_ordering_rel, by apply_instance⟩⟩
-  (λ i:{r // is_well_order α r}, ⟦⟨α, i.1, i.2⟩⟧) in
-⟨r, wo, h⟩
+theorem ord_eq (α) : ∃ (r : α → α → Prop) [wo : is_well_order α r], ord (#α) = @type α r wo :=
+let ⟨r, wo⟩ := infi_mem (λ r : {r // is_well_order α r}, @type α r.1 r.2) in ⟨r.1, r.2, wo.symm⟩
 
-theorem ord_le_type (r : α → α → Prop) [is_well_order α r] : ord (#α) ≤ ordinal.type r :=
-@ordinal.min_le {r // is_well_order α r}
-  ⟨⟨well_ordering_rel, by apply_instance⟩⟩
-  (λ i:{r // is_well_order α r}, ⟦⟨α, i.1, i.2⟩⟧) ⟨r, _⟩
+theorem ord_le_type (r : α → α → Prop) [h : is_well_order α r] : ord (#α) ≤ type r :=
+cinfi_le' _ (subtype.mk r h)
 
 theorem ord_le {c o} : ord c ≤ o ↔ c ≤ o.card :=
 induction_on c $ λ α, ordinal.induction_on o $ λ β s _,
@@ -1281,62 +917,58 @@ let ⟨r, _, e⟩ := ord_eq α in begin
   { cases h with f,
     have g := rel_embedding.preimage f s,
     haveI := rel_embedding.is_well_order g,
-    exact le_trans (ord_le_type _) (type_le'.2 ⟨g⟩) }
+    exact le_trans (ord_le_type _) g.ordinal_type_le }
 end
 
-theorem lt_ord {c o} : o < ord c ↔ o.card < c :=
-by rw [← not_le, ← not_le, ord_le]
+theorem gc_ord_card : galois_connection ord card := λ _ _, ord_le
+
+theorem lt_ord {c o} : o < ord c ↔ o.card < c := gc_ord_card.lt_iff_lt
 
 @[simp] theorem card_ord (c) : (ord c).card = c :=
 quotient.induction_on c $ λ α,
 let ⟨r, _, e⟩ := ord_eq α in by simp only [mk_def, e, card_type]
 
-theorem ord_card_le (o : ordinal) : o.card.ord ≤ o :=
-ord_le.2 le_rfl
+/-- Galois coinsertion between `cardinal.ord` and `ordinal.card`. -/
+def gci_ord_card : galois_coinsertion ord card :=
+gc_ord_card.to_galois_coinsertion $ λ c, c.card_ord.le
 
-lemma lt_ord_succ_card (o : ordinal) : o < o.card.succ.ord :=
-by { rw [lt_ord], apply cardinal.lt_succ_self }
+theorem ord_card_le (o : ordinal) : o.card.ord ≤ o := gc_ord_card.l_u_le _
 
-@[simp] theorem ord_le_ord {c₁ c₂} : ord c₁ ≤ ord c₂ ↔ c₁ ≤ c₂ :=
-by simp only [ord_le, card_ord]
+lemma lt_ord_succ_card (o : ordinal) : o < (succ o.card).ord := lt_ord.2 $ lt_succ _
 
-@[simp] theorem ord_lt_ord {c₁ c₂} : ord c₁ < ord c₂ ↔ c₁ < c₂ :=
-by simp only [lt_ord, card_ord]
+@[mono] theorem ord_strict_mono : strict_mono ord := gci_ord_card.strict_mono_l
+@[mono] theorem ord_mono : monotone ord := gc_ord_card.monotone_l
 
-@[simp] theorem ord_zero : ord 0 = 0 :=
-le_antisymm (ord_le.2 $ zero_le _) (ordinal.zero_le _)
+@[simp] theorem ord_le_ord {c₁ c₂} : ord c₁ ≤ ord c₂ ↔ c₁ ≤ c₂ := gci_ord_card.l_le_l_iff
+@[simp] theorem ord_lt_ord {c₁ c₂} : ord c₁ < ord c₂ ↔ c₁ < c₂ := ord_strict_mono.lt_iff_lt
+@[simp] theorem ord_zero : ord 0 = 0 := gc_ord_card.l_bot
 
 @[simp] theorem ord_nat (n : ℕ) : ord n = n :=
-le_antisymm (ord_le.2 $ by simp only [card_nat]) $ begin
+(ord_le.2 (card_nat n).ge).antisymm begin
   induction n with n IH,
   { apply ordinal.zero_le },
-  { exact (@ordinal.succ_le n _).2 (lt_of_le_of_lt IH $
-    ord_lt_ord.2 $ nat_cast_lt.2 (nat.lt_succ_self n)) }
+  { exact succ_le_of_lt (IH.trans_lt $ ord_lt_ord.2 $ nat_cast_lt.2 (nat.lt_succ_self n)) }
 end
 
 @[simp] theorem ord_one : ord 1 = 1 :=
 by simpa using ord_nat 1
 
 @[simp] theorem lift_ord (c) : (ord c).lift = ord (lift c) :=
-eq_of_forall_ge_iff $ λ o, le_iff_le_iff_lt_iff_lt.2 $ begin
-  split; intro h,
-  { rcases ordinal.lt_lift_iff.1 h with ⟨a, e, h⟩,
-    rwa [← e, lt_ord, ← lift_card, lift_lt, ← lt_ord] },
-  { rw lt_ord at h,
-    rcases lift_down' (le_of_lt h) with ⟨o, rfl⟩,
-    rw [← lift_card, lift_lt] at h,
-    rwa [ordinal.lift_lt, lt_ord] }
+begin
+  refine le_antisymm (le_of_forall_lt (λ a ha, _)) _,
+  { rcases ordinal.lt_lift_iff.1 ha with ⟨a, rfl, h⟩,
+    rwa [lt_ord, ← lift_card, lift_lt, ← lt_ord, ← ordinal.lift_lt] },
+  { rw [ord_le, ← lift_card, card_ord] }
 end
 
-lemma mk_ord_out (c : cardinal) : #c.ord.out.α = c :=
-by rw [←card_type (<), type_lt, card_ord]
+lemma mk_ord_out (c : cardinal) : #c.ord.out.α = c := by simp
 
 lemma card_typein_lt (r : α → α → Prop) [is_well_order α r] (x : α)
   (h : ord (#α) = type r) : card (typein r x) < #α :=
-by { rw [←ord_lt_ord, h], refine lt_of_le_of_lt (ord_card_le _) (typein_lt_type r x) }
+by { rw [←lt_ord, h], apply typein_lt_type }
 
 lemma card_typein_out_lt (c : cardinal) (x : c.ord.out.α) : card (typein (<) x) < c :=
-by { convert card_typein_lt (<) x _, rw [mk_ord_out], rw [type_lt, mk_ord_out] }
+by { rw ←lt_ord, apply typein_lt_self }
 
 lemma ord_injective : injective ord :=
 by { intros c c' h, rw [←card_ord c, ←card_ord c', h] }
@@ -1364,7 +996,7 @@ theorem univ_id : univ.{u (u+1)} = #ordinal := lift_id _
 theorem univ_umax : univ.{u (max (u+1) v)} = univ.{u v} := congr_fun lift_umax _
 
 theorem lift_lt_univ (c : cardinal) : lift.{(u+1) u} c < univ.{u (u+1)} :=
-by simpa only [lift.principal_seg_coe, lift_ord, lift_succ, ord_le, succ_le] using le_of_lt
+by simpa only [lift.principal_seg_coe, lift_ord, lift_succ, ord_le, succ_le_iff] using le_of_lt
   (lift.principal_seg.{u (u+1)}.lt_top (succ c).ord)
 
 theorem lift_lt_univ' (c : cardinal) : lift.{(max (u+1) v) u} c < univ.{u v} :=
@@ -1374,7 +1006,7 @@ by simpa only [lift_lift, lift_univ, univ_umax] using
 @[simp] theorem ord_univ : ord univ.{u v} = ordinal.univ.{u v} :=
 le_antisymm (ord_card_le _) $ le_of_forall_lt $ λ o h,
 lt_ord.2 begin
-  rcases lift.principal_seg.{u v}.down'.1
+  rcases lift.principal_seg.{u v}.down.1
     (by simpa only [lift.principal_seg_coe] using h) with ⟨o', rfl⟩,
   simp only [lift.principal_seg_coe], rw [← lift_card],
   apply lift_lt_univ'
@@ -1384,7 +1016,7 @@ theorem lt_univ {c} : c < univ.{u (u+1)} ↔ ∃ c', c = lift.{(u+1) u} c' :=
 ⟨λ h, begin
   have := ord_lt_ord.2 h,
   rw ord_univ at this,
-  cases lift.principal_seg.{u (u+1)}.down'.1
+  cases lift.principal_seg.{u (u+1)}.down.1
     (by simpa only [lift.principal_seg_top]) with o e,
   have := card_ord c,
   rw [← e, lift.principal_seg_coe, ← lift_card] at this,
@@ -1399,13 +1031,12 @@ theorem lt_univ' {c} : c < univ.{u v} ↔ ∃ c', c = lift.{(max (u+1) v) u} c'
 end, λ ⟨c', e⟩, e.symm ▸ lift_lt_univ' _⟩
 
 theorem small_iff_lift_mk_lt_univ {α : Type u} :
-  small.{v} α ↔
-  (cardinal.lift (# α : cardinal.{u}) < univ.{v (max u (v + 1))}) :=
+  small.{v} α ↔ cardinal.lift (#α) < univ.{v (max u (v + 1))} :=
 begin
   rw lt_univ',
   split,
   { rintro ⟨β, e⟩,
-    exact ⟨# β, (lift_mk_eq.{u _ (v + 1)}.2 e)⟩ },
+    exact ⟨#β, lift_mk_eq.{u _ (v + 1)}.2 e⟩ },
   { rintro ⟨c, hc⟩,
     exact ⟨⟨c.out, lift_mk_eq.{u _ (v + 1)}.1 (hc.trans (congr rfl c.mk_out.symm))⟩⟩ }
 end
@@ -1416,4 +1047,25 @@ namespace ordinal
 
 @[simp] theorem card_univ : card univ = cardinal.univ := rfl
 
+@[simp] theorem nat_le_card {o} {n : ℕ} : (n : cardinal) ≤ card o ↔ (n : ordinal) ≤ o :=
+by rw [← cardinal.ord_le, cardinal.ord_nat]
+
+@[simp] theorem nat_lt_card {o} {n : ℕ} : (n : cardinal) < card o ↔ (n : ordinal) < o :=
+by { rw [←succ_le_iff, ←succ_le_iff, ←nat_succ, nat_le_card], refl }
+
+@[simp] theorem card_lt_nat {o} {n : ℕ} : card o < n ↔ o < n :=
+lt_iff_lt_of_le_iff_le nat_le_card
+
+@[simp] theorem card_le_nat {o} {n : ℕ} : card o ≤ n ↔ o ≤ n :=
+le_iff_le_iff_lt_iff_lt.2 nat_lt_card
+
+@[simp] theorem card_eq_nat {o} {n : ℕ} : card o = n ↔ o = n :=
+by simp only [le_antisymm_iff, card_le_nat, nat_le_card]
+
+@[simp] theorem type_fintype (r : α → α → Prop) [is_well_order α r] [fintype α] :
+  type r = fintype.card α :=
+by rw [←card_eq_nat, card_type, mk_fintype]
+
+theorem type_fin (n : ℕ) : @type (fin n) (<) _ = n := by simp
+
 end ordinal
diff --git a/src/set_theory/ordinal/cantor_normal_form.lean b/src/set_theory/ordinal/cantor_normal_form.lean
new file mode 100644
index 0000000000000..987fb56b66212
--- /dev/null
+++ b/src/set_theory/ordinal/cantor_normal_form.lean
@@ -0,0 +1,150 @@
+/-
+Copyright (c) 2018 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+
+import set_theory.ordinal.arithmetic
+import set_theory.ordinal.exponential
+
+/-!
+# Cantor Normal Form
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The Cantor normal form of an ordinal is generally defined as its base `ω` expansion, with its
+non-zero exponents in decreasing order. Here, we more generally define a base `b` expansion
+`ordinal.CNF` in this manner, which is well-behaved for any `b ≥ 2`.
+
+# Implementation notes
+
+We implement `ordinal.CNF` as an association list, where keys are exponents and values are
+coefficients. This is because this structure intrinsically reflects two key properties of the Cantor
+normal form:
+
+- It is ordered.
+- It has finitely many entries.
+
+# Todo
+
+- Add API for the coefficients of the Cantor normal form.
+- Prove the basic results relating the CNF to the arithmetic operations on ordinals.
+-/
+
+noncomputable theory
+
+universe u
+
+open list
+
+namespace ordinal
+
+/-- Inducts on the base `b` expansion of an ordinal. -/
+@[elab_as_eliminator] noncomputable def CNF_rec (b : ordinal)
+  {C : ordinal → Sort*} (H0 : C 0) (H : ∀ o, o ≠ 0 → C (o % b ^ log b o) → C o) : ∀ o, C o
+| o :=
+  if ho : o = 0 then by rwa ho else
+    let hwf := mod_opow_log_lt_self b ho in H o ho (CNF_rec (o % b ^ log b o))
+using_well_founded {dec_tac := `[assumption]}
+
+@[simp] theorem CNF_rec_zero {C : ordinal → Sort*} (b : ordinal)
+  (H0 : C 0) (H : ∀ o, o ≠ 0 → C (o % b ^ log b o) → C o) : @CNF_rec b C H0 H 0 = H0 :=
+by { rw [CNF_rec, dif_pos rfl], refl }
+
+theorem CNF_rec_pos (b : ordinal) {o : ordinal} {C : ordinal → Sort*} (ho : o ≠ 0)
+  (H0 : C 0) (H : ∀ o, o ≠ 0 → C (o % b ^ log b o) → C o) :
+  @CNF_rec b C H0 H o = H o ho (@CNF_rec b C H0 H _) :=
+by rw [CNF_rec, dif_neg ho]
+
+/-- The Cantor normal form of an ordinal `o` is the list of coefficients and exponents in the
+base-`b` expansion of `o`.
+
+We special-case `CNF 0 o = CNF 1 o = [(0, o)]` for `o ≠ 0`.
+
+`CNF b (b ^ u₁ * v₁ + b ^ u₂ * v₂) = [(u₁, v₁), (u₂, v₂)]` -/
+@[pp_nodot] def CNF (b o : ordinal) : list (ordinal × ordinal) :=
+CNF_rec b [] (λ o ho IH, (log b o, o / b ^ log b o) :: IH) o
+
+@[simp] theorem CNF_zero (b : ordinal) : CNF b 0 = [] := CNF_rec_zero b _ _
+
+/-- Recursive definition for the Cantor normal form. -/
+theorem CNF_ne_zero {b o : ordinal} (ho : o ≠ 0) :
+  CNF b o = (log b o, o / b ^ log b o) :: CNF b (o % b ^ log b o) :=
+CNF_rec_pos b ho _ _
+
+theorem zero_CNF {o : ordinal} (ho : o ≠ 0) : CNF 0 o = [⟨0, o⟩] := by simp [CNF_ne_zero ho]
+
+theorem one_CNF {o : ordinal} (ho : o ≠ 0) : CNF 1 o = [⟨0, o⟩] := by simp [CNF_ne_zero ho]
+
+theorem CNF_of_le_one {b o : ordinal} (hb : b ≤ 1) (ho : o ≠ 0) : CNF b o = [⟨0, o⟩] :=
+begin
+  rcases le_one_iff.1 hb with rfl | rfl,
+  { exact zero_CNF ho },
+  { exact one_CNF ho }
+end
+
+theorem CNF_of_lt {b o : ordinal} (ho : o ≠ 0) (hb : o < b) : CNF b o = [⟨0, o⟩] :=
+by simp [CNF_ne_zero ho, log_eq_zero hb]
+
+/-- Evaluating the Cantor normal form of an ordinal returns the ordinal. -/
+theorem CNF_foldr (b o : ordinal) : (CNF b o).foldr (λ p r, b ^ p.1 * p.2 + r) 0 = o :=
+CNF_rec b (by { rw CNF_zero, refl })
+  (λ o ho IH, by rw [CNF_ne_zero ho, foldr_cons, IH, div_add_mod]) o
+
+/-- Every exponent in the Cantor normal form `CNF b o` is less or equal to `log b o`. -/
+theorem CNF_fst_le_log {b o : ordinal.{u}} {x : ordinal × ordinal} :
+  x ∈ CNF b o → x.1 ≤ log b o :=
+begin
+  refine CNF_rec b _ (λ o ho H, _) o,
+  { simp },
+  { rw [CNF_ne_zero ho, mem_cons_iff],
+    rintro (rfl | h),
+    { exact le_rfl },
+    { exact (H h).trans (log_mono_right _ (mod_opow_log_lt_self b ho).le) } }
+end
+
+/-- Every exponent in the Cantor normal form `CNF b o` is less or equal to `o`. -/
+theorem CNF_fst_le {b o : ordinal.{u}} {x : ordinal × ordinal} (h : x ∈ CNF b o) : x.1 ≤ o :=
+(CNF_fst_le_log h).trans $ log_le_self _ _
+
+/-- Every coefficient in a Cantor normal form is positive. -/
+theorem CNF_lt_snd {b o : ordinal.{u}} {x : ordinal × ordinal} : x ∈ CNF b o → 0 < x.2 :=
+begin
+  refine CNF_rec b _ (λ o ho IH, _) o,
+  { simp },
+  { rw CNF_ne_zero ho,
+    rintro (rfl | h),
+    { exact div_opow_log_pos b ho },
+    { exact IH h } }
+end
+
+/-- Every coefficient in the Cantor normal form `CNF b o` is less than `b`. -/
+theorem CNF_snd_lt {b o : ordinal.{u}} (hb : 1 < b) {x : ordinal × ordinal} :
+  x ∈ CNF b o → x.2 < b :=
+begin
+  refine CNF_rec b _ (λ o ho IH, _) o,
+  { simp },
+  { rw CNF_ne_zero ho,
+    rintro (rfl | h),
+    { simpa using div_opow_log_lt o hb },
+    { exact IH h } }
+end
+
+/-- The exponents of the Cantor normal form are decreasing. -/
+theorem CNF_sorted (b o : ordinal) : ((CNF b o).map prod.fst).sorted (>) :=
+begin
+  refine CNF_rec b _ (λ o ho IH, _) o,
+  { simp },
+  { cases le_or_lt b 1 with hb hb,
+    { simp [CNF_of_le_one hb ho] },
+    { cases lt_or_le o b with hob hbo,
+      { simp [CNF_of_lt ho hob] },
+      { rw [CNF_ne_zero ho, list.map_cons, list.sorted_cons],
+        refine ⟨λ a H, _, IH⟩,
+        rw list.mem_map at H,
+        rcases H with ⟨⟨a, a'⟩, H, rfl⟩,
+        exact (CNF_fst_le_log H).trans_lt (log_mod_opow_log_lt_log_self hb ho hbo) } } }
+end
+
+end ordinal
diff --git a/src/set_theory/ordinal/exponential.lean b/src/set_theory/ordinal/exponential.lean
new file mode 100644
index 0000000000000..0b1e2723c625a
--- /dev/null
+++ b/src/set_theory/ordinal/exponential.lean
@@ -0,0 +1,443 @@
+/-
+Copyright (c) 2017 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro, Floris van Doorn, Violeta Hernández Palacios
+-/
+import set_theory.ordinal.arithmetic
+
+/-! # Ordinal exponential
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define the power function and the logarithm function on ordinals. The two are
+related by the lemma `ordinal.opow_le_iff_le_log : (b^c) ≤ x ↔ c ≤ log b x` for nontrivial inputs 
+`b`, `c`.
+-/
+
+noncomputable theory
+
+open function cardinal set equiv order
+open_locale classical cardinal ordinal
+
+universes u v w
+
+namespace ordinal
+
+/-- The ordinal exponential, defined by transfinite recursion. -/
+instance : has_pow ordinal ordinal :=
+⟨λ a b, if a = 0 then 1 - b else limit_rec_on b 1 (λ _ IH, IH * a) (λ b _, bsup.{u u} b)⟩
+
+local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
+
+theorem opow_def (a b : ordinal) :
+  a ^ b = if a = 0 then 1 - b else limit_rec_on b 1 (λ _ IH, IH * a) (λ b _, bsup.{u u} b) :=
+rfl
+
+theorem zero_opow' (a : ordinal) : 0 ^ a = 1 - a :=
+by simp only [opow_def, if_pos rfl]
+
+@[simp] theorem zero_opow {a : ordinal} (a0 : a ≠ 0) : 0 ^ a = 0 :=
+by rwa [zero_opow', ordinal.sub_eq_zero_iff_le, one_le_iff_ne_zero]
+
+@[simp] theorem opow_zero (a : ordinal) : a ^ 0 = 1 :=
+by by_cases a = 0; [simp only [opow_def, if_pos h, sub_zero],
+simp only [opow_def, if_neg h, limit_rec_on_zero]]
+
+@[simp] theorem opow_succ (a b : ordinal) : a ^ succ b = a ^ b * a :=
+if h : a = 0 then by subst a; simp only [zero_opow (succ_ne_zero _), mul_zero]
+else by simp only [opow_def, limit_rec_on_succ, if_neg h]
+
+theorem opow_limit {a b : ordinal} (a0 : a ≠ 0) (h : is_limit b) :
+  a ^ b = bsup.{u u} b (λ c _, a ^ c) :=
+by simp only [opow_def, if_neg a0]; rw limit_rec_on_limit _ _ _ _ h; refl
+
+theorem opow_le_of_limit {a b c : ordinal} (a0 : a ≠ 0) (h : is_limit b) :
+  a ^ b ≤ c ↔ ∀ b' < b, a ^ b' ≤ c :=
+by rw [opow_limit a0 h, bsup_le_iff]
+
+theorem lt_opow_of_limit {a b c : ordinal} (b0 : b ≠ 0) (h : is_limit c) :
+  a < b ^ c ↔ ∃ c' < c, a < b ^ c' :=
+by rw [← not_iff_not, not_exists]; simp only [not_lt, opow_le_of_limit b0 h, exists_prop, not_and]
+
+@[simp] theorem opow_one (a : ordinal) : a ^ 1 = a :=
+by rw [← succ_zero, opow_succ]; simp only [opow_zero, one_mul]
+
+@[simp] theorem one_opow (a : ordinal) : 1 ^ a = 1 :=
+begin
+  apply limit_rec_on a,
+  { simp only [opow_zero] },
+  { intros _ ih, simp only [opow_succ, ih, mul_one] },
+  refine λ b l IH, eq_of_forall_ge_iff (λ c, _),
+  rw [opow_le_of_limit ordinal.one_ne_zero l],
+  exact ⟨λ H, by simpa only [opow_zero] using H 0 l.pos,
+         λ H b' h, by rwa IH _ h⟩,
+end
+
+theorem opow_pos {a : ordinal} (b)
+  (a0 : 0 < a) : 0 < a ^ b :=
+begin
+  have h0 : 0 < a ^ 0, {simp only [opow_zero, zero_lt_one]},
+  apply limit_rec_on b,
+  { exact h0 },
+  { intros b IH, rw [opow_succ],
+    exact mul_pos IH a0 },
+  { exact λ b l _, (lt_opow_of_limit (ordinal.pos_iff_ne_zero.1 a0) l).2
+      ⟨0, l.pos, h0⟩ },
+end
+
+theorem opow_ne_zero {a : ordinal} (b)
+  (a0 : a ≠ 0) : a ^ b ≠ 0 :=
+ordinal.pos_iff_ne_zero.1 $ opow_pos b $ ordinal.pos_iff_ne_zero.2 a0
+
+theorem opow_is_normal {a : ordinal} (h : 1 < a) : is_normal ((^) a) :=
+have a0 : 0 < a, from zero_lt_one.trans h,
+⟨λ b, by simpa only [mul_one, opow_succ] using
+  (mul_lt_mul_iff_left (opow_pos b a0)).2 h,
+ λ b l c, opow_le_of_limit (ne_of_gt a0) l⟩
+
+theorem opow_lt_opow_iff_right {a b c : ordinal}
+  (a1 : 1 < a) : a ^ b < a ^ c ↔ b < c :=
+(opow_is_normal a1).lt_iff
+
+theorem opow_le_opow_iff_right {a b c : ordinal}
+  (a1 : 1 < a) : a ^ b ≤ a ^ c ↔ b ≤ c :=
+(opow_is_normal a1).le_iff
+
+theorem opow_right_inj {a b c : ordinal}
+  (a1 : 1 < a) : a ^ b = a ^ c ↔ b = c :=
+(opow_is_normal a1).inj
+
+theorem opow_is_limit {a b : ordinal}
+  (a1 : 1 < a) : is_limit b → is_limit (a ^ b) :=
+(opow_is_normal a1).is_limit
+
+theorem opow_is_limit_left {a b : ordinal}
+  (l : is_limit a) (hb : b ≠ 0) : is_limit (a ^ b) :=
+begin
+  rcases zero_or_succ_or_limit b with e|⟨b,rfl⟩|l',
+  { exact absurd e hb },
+  { rw opow_succ,
+    exact mul_is_limit (opow_pos _ l.pos) l },
+  { exact opow_is_limit l.one_lt l' }
+end
+
+theorem opow_le_opow_right {a b c : ordinal}
+  (h₁ : 0 < a) (h₂ : b ≤ c) : a ^ b ≤ a ^ c :=
+begin
+  cases lt_or_eq_of_le (one_le_iff_pos.2 h₁) with h₁ h₁,
+  { exact (opow_le_opow_iff_right h₁).2 h₂ },
+  { subst a, simp only [one_opow] }
+end
+
+theorem opow_le_opow_left {a b : ordinal} (c)
+  (ab : a ≤ b) : a ^ c ≤ b ^ c :=
+begin
+  by_cases a0 : a = 0,
+  { subst a, by_cases c0 : c = 0,
+    { subst c, simp only [opow_zero] },
+    { simp only [zero_opow c0, ordinal.zero_le] } },
+  { apply limit_rec_on c,
+    { simp only [opow_zero] },
+    { intros c IH, simpa only [opow_succ] using mul_le_mul' IH ab },
+    { exact λ c l IH, (opow_le_of_limit a0 l).2
+        (λ b' h, (IH _ h).trans (opow_le_opow_right
+          ((ordinal.pos_iff_ne_zero.2 a0).trans_le ab) h.le)) } }
+end
+
+theorem left_le_opow (a : ordinal) {b : ordinal} (b1 : 0 < b) : a ≤ a ^ b :=
+begin
+  nth_rewrite 0 ←opow_one a,
+  cases le_or_gt a 1 with a1 a1,
+  { cases lt_or_eq_of_le a1 with a0 a1,
+    { rw lt_one_iff_zero at a0,
+      rw [a0, zero_opow ordinal.one_ne_zero],
+      exact ordinal.zero_le _ },
+    rw [a1, one_opow, one_opow] },
+  rwa [opow_le_opow_iff_right a1, one_le_iff_pos]
+end
+
+theorem right_le_opow {a : ordinal} (b) (a1 : 1 < a) : b ≤ a ^ b :=
+(opow_is_normal a1).self_le _
+
+theorem opow_lt_opow_left_of_succ {a b c : ordinal}
+  (ab : a < b) : a ^ succ c < b ^ succ c :=
+by { rw [opow_succ, opow_succ], exact
+  (mul_le_mul_right' (opow_le_opow_left c ab.le) a).trans_lt
+  (mul_lt_mul_of_pos_left ab (opow_pos c ((ordinal.zero_le a).trans_lt ab))) }
+
+theorem opow_add (a b c : ordinal) : a ^ (b + c) = a ^ b * a ^ c :=
+begin
+  rcases eq_or_ne a 0 with rfl | a0,
+  { rcases eq_or_ne c 0 with rfl | c0, { simp },
+    have : b + c ≠ 0 := ((ordinal.pos_iff_ne_zero.2 c0).trans_le (le_add_left _ _)).ne',
+    simp only [zero_opow c0, zero_opow this, mul_zero] },
+  rcases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with rfl | a1,
+  { simp only [one_opow, mul_one] },
+  apply limit_rec_on c,
+  { simp },
+  { intros c IH,
+    rw [add_succ, opow_succ, IH, opow_succ, mul_assoc] },
+  { intros c l IH,
+    refine eq_of_forall_ge_iff (λ d, (((opow_is_normal a1).trans
+      (add_is_normal b)).limit_le l).trans _),
+    dsimp only [function.comp],
+    simp only [IH] {contextual := tt},
+    exact (((mul_is_normal $ opow_pos b (ordinal.pos_iff_ne_zero.2 a0)).trans
+      (opow_is_normal a1)).limit_le l).symm }
+end
+
+theorem opow_one_add (a b : ordinal) : a ^ (1 + b) = a * a ^ b :=
+by rw [opow_add, opow_one]
+
+theorem opow_dvd_opow (a) {b c : ordinal} (h : b ≤ c) : a ^ b ∣ a ^ c :=
+⟨a ^ (c - b), by rw [←opow_add, ordinal.add_sub_cancel_of_le h] ⟩
+
+theorem opow_dvd_opow_iff {a b c : ordinal} (a1 : 1 < a) : a ^ b ∣ a ^ c ↔ b ≤ c :=
+⟨λ h, le_of_not_lt $ λ hn,
+  not_le_of_lt ((opow_lt_opow_iff_right a1).2 hn) $
+    le_of_dvd (opow_ne_zero _ $ one_le_iff_ne_zero.1 $ a1.le) h,
+opow_dvd_opow _⟩
+
+theorem opow_mul (a b c : ordinal) : a ^ (b * c) = (a ^ b) ^ c :=
+begin
+  by_cases b0 : b = 0, {simp only [b0, zero_mul, opow_zero, one_opow]},
+  by_cases a0 : a = 0,
+  { subst a,
+    by_cases c0 : c = 0, {simp only [c0, mul_zero, opow_zero]},
+    simp only [zero_opow b0, zero_opow c0, zero_opow (mul_ne_zero b0 c0)] },
+  cases eq_or_lt_of_le (one_le_iff_ne_zero.2 a0) with a1 a1,
+  { subst a1, simp only [one_opow] },
+  apply limit_rec_on c,
+  { simp only [mul_zero, opow_zero] },
+  { intros c IH,
+    rw [mul_succ, opow_add, IH, opow_succ] },
+  { intros c l IH,
+    refine eq_of_forall_ge_iff (λ d, (((opow_is_normal a1).trans
+      (mul_is_normal (ordinal.pos_iff_ne_zero.2 b0))).limit_le l).trans _),
+    dsimp only [function.comp],
+    simp only [IH] {contextual := tt},
+    exact (opow_le_of_limit (opow_ne_zero _ a0) l).symm }
+end
+
+/-! ### Ordinal logarithm -/
+
+/-- The ordinal logarithm is the solution `u` to the equation `x = b ^ u * v + w` where `v < b` and
+    `w < b ^ u`. -/
+@[pp_nodot] def log (b : ordinal) (x : ordinal) : ordinal :=
+if h : 1 < b then pred (Inf {o | x < b ^ o}) else 0
+
+/-- The set in the definition of `log` is nonempty. -/
+theorem log_nonempty {b x : ordinal} (h : 1 < b) : {o | x < b ^ o}.nonempty :=
+⟨_, succ_le_iff.1 (right_le_opow _ h)⟩
+
+theorem log_def {b : ordinal} (h : 1 < b) (x : ordinal) : log b x = pred (Inf {o | x < b ^ o}) :=
+by simp only [log, dif_pos h]
+
+theorem log_of_not_one_lt_left {b : ordinal} (h : ¬ 1 < b) (x : ordinal) : log b x = 0 :=
+by simp only [log, dif_neg h]
+
+theorem log_of_left_le_one {b : ordinal} (h : b ≤ 1) : ∀ x, log b x = 0 :=
+log_of_not_one_lt_left h.not_lt
+
+@[simp] lemma log_zero_left : ∀ b, log 0 b = 0 :=
+log_of_left_le_one zero_le_one
+
+@[simp] theorem log_zero_right (b : ordinal) : log b 0 = 0 :=
+if b1 : 1 < b then begin
+  rw [log_def b1, ← ordinal.le_zero, pred_le],
+  apply cInf_le',
+  dsimp,
+  rw [succ_zero, opow_one],
+  exact zero_lt_one.trans b1
+end
+else by simp only [log_of_not_one_lt_left b1]
+
+@[simp] theorem log_one_left : ∀ b, log 1 b = 0 :=
+log_of_left_le_one le_rfl
+
+theorem succ_log_def {b x : ordinal} (hb : 1 < b) (hx : x ≠ 0) :
+  succ (log b x) = Inf {o | x < b ^ o} :=
+begin
+  let t := Inf {o | x < b ^ o},
+  have : x < b ^ t := Inf_mem (log_nonempty hb),
+  rcases zero_or_succ_or_limit t with h|h|h,
+  { refine ((one_le_iff_ne_zero.2 hx).not_lt _).elim,
+    simpa only [h, opow_zero] },
+  { rw [show log b x = pred t, from log_def hb x,
+        succ_pred_iff_is_succ.2 h] },
+  { rcases (lt_opow_of_limit (zero_lt_one.trans hb).ne' h).1 this with ⟨a, h₁, h₂⟩,
+    exact h₁.not_le.elim ((le_cInf_iff'' (log_nonempty hb)).1 le_rfl a h₂) }
+end
+
+theorem lt_opow_succ_log_self {b : ordinal} (hb : 1 < b) (x : ordinal) : x < b ^ succ (log b x) :=
+begin
+  rcases eq_or_ne x 0 with rfl | hx,
+  { apply opow_pos _ (zero_lt_one.trans hb) },
+  { rw succ_log_def hb hx,
+    exact Inf_mem (log_nonempty hb) }
+end
+
+theorem opow_log_le_self (b) {x : ordinal} (hx : x ≠ 0) : b ^ log b x ≤ x :=
+begin
+  rcases eq_or_ne b 0 with rfl | b0,
+  { rw zero_opow',
+    refine (sub_le_self _ _).trans (one_le_iff_ne_zero.2 hx) },
+  rcases lt_or_eq_of_le (one_le_iff_ne_zero.2 b0) with hb | rfl,
+  { refine le_of_not_lt (λ h, (lt_succ (log b x)).not_le _),
+    have := @cInf_le' _ _ {o | x < b ^ o} _ h,
+    rwa ←succ_log_def hb hx at this },
+  { rwa [one_opow, one_le_iff_ne_zero] }
+end
+
+/-- `opow b` and `log b` (almost) form a Galois connection. -/
+theorem opow_le_iff_le_log {b x c : ordinal} (hb : 1 < b) (hx : x ≠ 0) : b ^ c ≤ x ↔ c ≤ log b x :=
+⟨λ h, le_of_not_lt $ λ hn,
+   (lt_opow_succ_log_self hb x).not_le $
+   ((opow_le_opow_iff_right hb).2 (succ_le_of_lt hn)).trans h,
+λ h, ((opow_le_opow_iff_right hb).2 h).trans (opow_log_le_self b hx)⟩
+
+theorem lt_opow_iff_log_lt {b x c : ordinal} (hb : 1 < b) (hx : x ≠ 0) : x < b ^ c ↔ log b x < c :=
+lt_iff_lt_of_le_iff_le (opow_le_iff_le_log hb hx)
+
+theorem log_pos {b o : ordinal} (hb : 1 < b) (ho : o ≠ 0) (hbo : b ≤ o) : 0 < log b o :=
+by rwa [←succ_le_iff, succ_zero, ←opow_le_iff_le_log hb ho, opow_one]
+
+theorem log_eq_zero {b o : ordinal} (hbo : o < b) : log b o = 0 :=
+begin
+  rcases eq_or_ne o 0 with rfl | ho,
+  { exact log_zero_right b },
+  cases le_or_lt b 1 with hb hb,
+  { rcases le_one_iff.1 hb with rfl | rfl,
+    { exact log_zero_left o },
+    { exact log_one_left o } },
+  { rwa [←ordinal.le_zero, ←lt_succ_iff, succ_zero, ←lt_opow_iff_log_lt hb ho, opow_one] }
+end
+
+@[mono] theorem log_mono_right (b) {x y : ordinal} (xy : x ≤ y) : log b x ≤ log b y :=
+if hx : x = 0 then by simp only [hx, log_zero_right, ordinal.zero_le] else
+if hb : 1 < b then
+  (opow_le_iff_le_log hb (lt_of_lt_of_le (ordinal.pos_iff_ne_zero.2 hx) xy).ne').1 $
+    (opow_log_le_self _ hx).trans xy
+else by simp only [log_of_not_one_lt_left hb, ordinal.zero_le]
+
+theorem log_le_self (b x : ordinal) : log b x ≤ x :=
+if hx : x = 0 then by simp only [hx, log_zero_right, ordinal.zero_le] else
+if hb : 1 < b then (right_le_opow _ hb).trans (opow_log_le_self b hx)
+else by simp only [log_of_not_one_lt_left hb, ordinal.zero_le]
+
+@[simp] theorem log_one_right (b : ordinal) : log b 1 = 0 :=
+if hb : 1 < b then log_eq_zero hb else log_of_not_one_lt_left hb 1
+
+theorem mod_opow_log_lt_self (b : ordinal) {o : ordinal} (ho : o ≠ 0) : o % b ^ log b o < o :=
+begin
+  rcases eq_or_ne b 0 with rfl | hb,
+  { simpa using ordinal.pos_iff_ne_zero.2 ho },
+  { exact (mod_lt _ $ opow_ne_zero _ hb).trans_le (opow_log_le_self _ ho) }
+end
+
+theorem log_mod_opow_log_lt_log_self {b o : ordinal} (hb : 1 < b) (ho : o ≠ 0) (hbo : b ≤ o) :
+  log b (o % b ^ log b o) < log b o :=
+begin
+  cases eq_or_ne (o % b ^ log b o) 0,
+  { rw [h, log_zero_right],
+    apply log_pos hb ho hbo },
+  { rw [←succ_le_iff, succ_log_def hb h],
+    apply cInf_le',
+    apply mod_lt,
+    rw ←ordinal.pos_iff_ne_zero,
+    exact opow_pos _ (zero_lt_one.trans hb) }
+end
+
+lemma opow_mul_add_pos {b v : ordinal} (hb : b ≠ 0) (u) (hv : v ≠ 0) (w) : 0 < b ^ u * v + w :=
+(opow_pos u $ ordinal.pos_iff_ne_zero.2 hb).trans_le $
+  (le_mul_left _ $ ordinal.pos_iff_ne_zero.2 hv).trans $ le_add_right _ _
+
+lemma opow_mul_add_lt_opow_mul_succ {b u w : ordinal} (v : ordinal) (hw : w < b ^ u) :
+  b ^ u * v + w < b ^ u * (succ v) :=
+by rwa [mul_succ, add_lt_add_iff_left]
+
+lemma opow_mul_add_lt_opow_succ {b u v w : ordinal} (hvb : v < b) (hw : w < b ^ u) :
+  b ^ u * v + w < b ^ (succ u) :=
+begin
+  convert (opow_mul_add_lt_opow_mul_succ v hw).trans_le (mul_le_mul_left' (succ_le_of_lt hvb) _),
+  exact opow_succ b u
+end
+
+theorem log_opow_mul_add {b u v w : ordinal} (hb : 1 < b) (hv : v ≠ 0) (hvb : v < b)
+  (hw : w < b ^ u) : log b (b ^ u * v + w) = u :=
+begin
+  have hne' := (opow_mul_add_pos (zero_lt_one.trans hb).ne' u hv w).ne',
+  by_contra' hne,
+  cases lt_or_gt_of_ne hne with h h,
+  { rw ←lt_opow_iff_log_lt hb hne' at h,
+    exact h.not_le ((le_mul_left _ (ordinal.pos_iff_ne_zero.2 hv)).trans (le_add_right _ _)) },
+  { change _ < _ at h,
+    rw [←succ_le_iff, ←opow_le_iff_le_log hb hne'] at h,
+    exact (not_lt_of_le h) (opow_mul_add_lt_opow_succ hvb hw) }
+end
+
+theorem log_opow {b : ordinal} (hb : 1 < b) (x : ordinal) : log b (b ^ x) = x :=
+begin
+  convert log_opow_mul_add hb zero_ne_one.symm hb (opow_pos x (zero_lt_one.trans hb)),
+  rw [add_zero, mul_one]
+end
+
+theorem div_opow_log_pos (b : ordinal) {o : ordinal} (ho : o ≠ 0) : 0 < o / b ^ log b o :=
+begin
+  rcases eq_zero_or_pos b with (rfl | hb),
+  { simpa using ordinal.pos_iff_ne_zero.2 ho },
+  { rw div_pos (opow_ne_zero _ hb.ne'),
+    exact opow_log_le_self b ho }
+end
+
+theorem div_opow_log_lt {b : ordinal} (o : ordinal) (hb : 1 < b) : o / b ^ log b o < b :=
+begin
+  rw [div_lt (opow_pos _ (zero_lt_one.trans hb)).ne', ←opow_succ],
+  exact lt_opow_succ_log_self hb o
+end
+
+theorem add_log_le_log_mul {x y : ordinal} (b : ordinal) (hx : x ≠ 0) (hy : y ≠ 0) :
+  log b x + log b y ≤ log b (x * y) :=
+begin
+  by_cases hb : 1 < b,
+  { rw [←opow_le_iff_le_log hb (mul_ne_zero hx hy), opow_add],
+    exact mul_le_mul' (opow_log_le_self b hx) (opow_log_le_self b hy) },
+  simp only [log_of_not_one_lt_left hb, zero_add]
+end
+
+/-! ### Interaction with `nat.cast` -/
+
+@[simp, norm_cast] theorem nat_cast_opow (m : ℕ) : ∀ n : ℕ, ((pow m n : ℕ) : ordinal) = m ^ n
+| 0     := by simp
+| (n+1) := by rw [pow_succ', nat_cast_mul, nat_cast_opow, nat.cast_succ, add_one_eq_succ, opow_succ]
+
+local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
+theorem sup_opow_nat {o : ordinal} (ho : 0 < o) : sup (λ n : ℕ, o ^ n) = o ^ ω :=
+begin
+  rcases lt_or_eq_of_le (one_le_iff_pos.2 ho) with ho₁ | rfl,
+  { exact (opow_is_normal ho₁).apply_omega },
+  { rw one_opow,
+    refine le_antisymm (sup_le (λ n, by rw one_opow)) _,
+    convert le_sup _ 0,
+    rw [nat.cast_zero, opow_zero] }
+end
+
+end ordinal
+
+namespace tactic
+open ordinal positivity
+
+/-- Extension for the `positivity` tactic: `ordinal.opow` takes positive values on positive inputs.
+-/
+@[positivity]
+meta def positivity_opow : expr → tactic strictness
+| `(@has_pow.pow _ _ %%inst %%a %%b) := do
+  strictness_a ← core a,
+  match strictness_a with
+  | positive p := positive <$> mk_app ``opow_pos [b, p]
+  | _ := failed -- We already know that `0 ≤ x` for all `x : ordinal`
+  end
+| _ := failed
+
+end tactic
diff --git a/src/set_theory/ordinal/fixed_point.lean b/src/set_theory/ordinal/fixed_point.lean
index d5e81eb1092fb..819ed03bcdace 100644
--- a/src/set_theory/ordinal/fixed_point.lean
+++ b/src/set_theory/ordinal/fixed_point.lean
@@ -5,10 +5,14 @@ Authors: Violeta Hernández Palacios, Mario Carneiro
 -/
 
 import set_theory.ordinal.arithmetic
+import set_theory.ordinal.exponential
 
 /-!
 # Fixed points of normal functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We prove various statements about the fixed points of normal ordinal functions. We state them in
 three forms: as statements about type-indexed families of normal functions, as statements about
 ordinal-indexed families of normal functions, and as statements about a single normal function. For
@@ -29,7 +33,7 @@ noncomputable theory
 
 universes u v
 
-open function
+open function order
 
 namespace ordinal
 
@@ -40,6 +44,9 @@ variables {ι : Type u} {f : ι → ordinal.{max u v} → ordinal.{max u v}}
 
 /-- The next common fixed point, at least `a`, for a family of normal functions.
 
+This is defined for any family of functions, as the supremum of all values reachable by applying
+finitely many functions in the family to `a`.
+
 `ordinal.nfp_family_fp` shows this is a fixed point, `ordinal.le_nfp_family` shows it's at
 least `a`, and `ordinal.nfp_family_le_fp` shows this is the least ordinal with these properties. -/
 def nfp_family (f : ι → ordinal → ordinal) (a) : ordinal :=
@@ -74,7 +81,7 @@ let ⟨l, hl⟩ := lt_nfp_family.1 hb in lt_sup.2 ⟨i :: l, (H i).strict_mono h
 
 theorem apply_lt_nfp_family_iff [nonempty ι] (H : ∀ i, is_normal (f i)) {a b} :
   (∀ i, f i b < nfp_family f a) ↔ b < nfp_family f a :=
-⟨λ h, lt_nfp_family.2 $ let ⟨l, hl⟩ := lt_sup.1 (h (classical.arbitrary ι)) in
+⟨λ h, lt_nfp_family.2 $ let ⟨l, hl⟩ := lt_sup.1 $ h $ classical.arbitrary ι in
   ⟨l, ((H _).self_le b).trans_lt hl⟩, apply_lt_nfp_family H⟩
 
 theorem nfp_family_le_apply [nonempty ι] (H : ∀ i, is_normal (f i)) {a b} :
@@ -85,7 +92,7 @@ theorem nfp_family_le_fp (H : ∀ i, monotone (f i)) {a b} (ab : a ≤ b) (h : 
   nfp_family f a ≤ b :=
 sup_le $ λ l, begin
   by_cases hι : is_empty ι,
-  { rwa @unique.eq_default _ (@list.unique_of_is_empty ι hι) l },
+  { resetI, rwa unique.eq_default l },
   { haveI := not_is_empty_iff.1 hι,
     induction l with i l IH generalizing a, {exact ab},
     exact (H i (IH ab)).trans (h i) }
@@ -113,10 +120,11 @@ end
 
 theorem nfp_family_eq_self {f : ι → ordinal → ordinal} {a} (h : ∀ i, f i a = a) :
   nfp_family f a = a :=
-le_antisymm (sup_le (λ l, (by rw list.foldr_fixed' h l))) (le_nfp_family f a)
+le_antisymm (sup_le $ λ l, by rw list.foldr_fixed' h l) $ le_nfp_family f a
 
 /-- A generalization of the fixed point lemma for normal functions: any family of normal functions
     has an unbounded set of common fixed points. -/
+-- Todo: This is actually a special case of the fact the intersection of club sets is a club set.
 theorem fp_family_unbounded (H : ∀ i, is_normal (f i)) :
   (⋂ i, function.fixed_points (f i)).unbounded (<) :=
 λ a, ⟨_, λ s ⟨i, hi⟩, begin
@@ -124,7 +132,10 @@ theorem fp_family_unbounded (H : ∀ i, is_normal (f i)) :
   exact nfp_family_fp (H i) a
 end, (le_nfp_family f a).not_lt⟩
 
-/-- The derivative of a family of normal functions is the sequence of their common fixed points. -/
+/-- The derivative of a family of normal functions is the sequence of their common fixed points.
+
+This is defined for all functions such that `ordinal.deriv_family_zero`,
+`ordinal.deriv_family_succ`, and `ordinal.deriv_family_limit` are satisfied. -/
 def deriv_family (f : ι → ordinal → ordinal) (o : ordinal) : ordinal :=
 limit_rec_on o (nfp_family f 0)
   (λ a IH, nfp_family f (succ IH))
@@ -143,7 +154,7 @@ theorem deriv_family_limit (f : ι → ordinal → ordinal) {o} : is_limit o →
 limit_rec_on_limit _ _ _ _
 
 theorem deriv_family_is_normal (f : ι → ordinal → ordinal) : is_normal (deriv_family f) :=
-⟨λ o, by rw [deriv_family_succ, ← succ_le]; apply le_nfp_family,
+⟨λ o, by rw [deriv_family_succ, ← succ_le_iff]; apply le_nfp_family,
  λ o l a, by rw [deriv_family_limit _ l, bsup_le_iff]⟩
 
 theorem deriv_family_fp {i} (H : is_normal (f i)) (o : ordinal.{max u v}) :
@@ -170,16 +181,17 @@ theorem le_iff_deriv_family (H : ∀ i, is_normal (f i)) {a} :
   { cases le_or_lt a (deriv_family f o), {exact IH h},
     refine ⟨succ o, le_antisymm _ h₁⟩,
     rw deriv_family_succ,
-    exact nfp_family_le_fp (λ i, (H i).monotone) (succ_le.2 h) ha },
+    exact nfp_family_le_fp (λ i, (H i).monotone) (succ_le_of_lt h) ha },
   { cases eq_or_lt_of_le h₁, {exact ⟨_, h.symm⟩},
     rw [deriv_family_limit _ l, ← not_le, bsup_le_iff, not_ball] at h,
     exact let ⟨o', h, hl⟩ := h in IH o' h (le_of_not_le hl) }
-end, λ ⟨o, e⟩ i, e ▸ le_of_eq (deriv_family_fp (H i) _)⟩
+end, λ ⟨o, e⟩ i, e ▸ (deriv_family_fp (H i) _).le⟩
 
 theorem fp_iff_deriv_family (H : ∀ i, is_normal (f i)) {a} :
   (∀ i, f i a = a) ↔ ∃ o, deriv_family f o = a :=
 iff.trans ⟨λ h i, le_of_eq (h i), λ h i, (H i).le_iff_eq.1 (h i)⟩ (le_iff_deriv_family H)
 
+/-- For a family of normal functions, `ordinal.deriv_family` enumerates the common fixed points. -/
 theorem deriv_family_eq_enum_ord (H : ∀ i, is_normal (f i)) :
   deriv_family f = enum_ord (⋂ i, function.fixed_points (f i)) :=
 begin
@@ -202,6 +214,8 @@ section
 variables {o : ordinal.{u}} {f : Π b < o, ordinal.{max u v} → ordinal.{max u v}}
 
 /-- The next common fixed point, at least `a`, for a family of normal functions indexed by ordinals.
+
+This is defined as `ordinal.nfp_family` of the type-indexed family associated to `f`.
 -/
 def nfp_bfamily (o : ordinal) (f : Π b < o, ordinal → ordinal) : ordinal → ordinal :=
 nfp_family (family_of_bfamily o f)
@@ -233,20 +247,25 @@ sup_le
 theorem nfp_bfamily_monotone (hf : ∀ i hi, monotone (f i hi)) : monotone (nfp_bfamily o f) :=
 nfp_family_monotone (λ i, hf _ _)
 
-theorem apply_lt_nfp_bfamily (ho : o ≠ 0) (H : ∀ i hi, is_normal (f i hi)) {a b} :
-  (∀ i hi, f i hi b < nfp_bfamily o f a) ↔ b < nfp_bfamily o f a :=
+theorem apply_lt_nfp_bfamily (H : ∀ i hi, is_normal (f i hi)) {a b} (hb : b < nfp_bfamily o f a)
+  (i hi) : f i hi b < nfp_bfamily o f a :=
 begin
-  unfold nfp_bfamily,
-  rw ←@apply_lt_nfp_family_iff _ (family_of_bfamily o f) (out_nonempty_iff_ne_zero.2 ho)
-    (λ i, H _ _),
-  refine ⟨λ h i, h _ (typein_lt_self i), λ h i hio, _⟩,
   rw ←family_of_bfamily_enum o f,
-  apply h
+  apply apply_lt_nfp_family _ hb,
+  exact λ _, H _ _
 end
 
+theorem apply_lt_nfp_bfamily_iff (ho : o ≠ 0) (H : ∀ i hi, is_normal (f i hi)) {a b} :
+  (∀ i hi, f i hi b < nfp_bfamily o f a) ↔ b < nfp_bfamily o f a :=
+⟨λ h, begin
+  haveI := out_nonempty_iff_ne_zero.2 ho,
+  refine (apply_lt_nfp_family_iff _).1 (λ _, h _ _),
+  exact λ _, H _ _,
+end, apply_lt_nfp_bfamily H⟩
+
 theorem nfp_bfamily_le_apply (ho : o ≠ 0) (H : ∀ i hi, is_normal (f i hi)) {a b} :
   (∃ i hi, nfp_bfamily o f a ≤ f i hi b) ↔ nfp_bfamily o f a ≤ b :=
-by { rw ←not_iff_not, push_neg, convert apply_lt_nfp_bfamily ho H, simp only [not_le] }
+by { rw ←not_iff_not, push_neg, convert apply_lt_nfp_bfamily_iff ho H, simp only [not_le] }
 
 theorem nfp_bfamily_le_fp (H : ∀ i hi, monotone (f i hi)) {a b} (ab : a ≤ b)
   (h : ∀ i hi, f i hi b ≤ b) : nfp_bfamily o f a ≤ b :=
@@ -262,8 +281,8 @@ begin
   refine ⟨λ h, _, λ h i hi, _⟩,
   { have ho' : 0 < o := ordinal.pos_iff_ne_zero.2 ho,
     exact ((H 0 ho').self_le b).trans (h 0 ho') },
-  rw ←nfp_bfamily_fp (H i hi),
-  exact (H i hi).monotone h
+  { rw ←nfp_bfamily_fp (H i hi),
+    exact (H i hi).monotone h }
 end
 
 theorem nfp_bfamily_eq_self {a} (h : ∀ i hi, f i hi a = a) : nfp_bfamily o f a = a :=
@@ -276,7 +295,9 @@ theorem fp_bfamily_unbounded (H : ∀ i hi, is_normal (f i hi)) :
 λ a, ⟨_, by { rw set.mem_Inter₂, exact λ i hi, nfp_bfamily_fp (H i hi) _ },
   (le_nfp_bfamily f a).not_lt⟩
 
-/-- The derivative of a family of normal functions is the sequence of their common fixed points. -/
+/-- The derivative of a family of normal functions is the sequence of their common fixed points.
+
+This is defined as `ordinal.deriv_family` of the type-indexed family associated to `f`. -/
 def deriv_bfamily (o : ordinal) (f : Π b < o, ordinal → ordinal) : ordinal → ordinal :=
 deriv_family (family_of_bfamily o f)
 
@@ -300,7 +321,7 @@ begin
   { refine ⟨λ h i, h _ _, λ h i hi, _⟩,
     rw ←family_of_bfamily_enum o f,
     apply h },
-  exact λ _, H _ _
+  { exact λ _, H _ _ }
 end
 
 theorem fp_iff_deriv_bfamily (H : ∀ i hi, is_normal (f i hi)) {a} :
@@ -312,6 +333,7 @@ begin
   exact h i hi
 end
 
+/-- For a family of normal functions, `ordinal.deriv_bfamily` enumerates the common fixed points. -/
 theorem deriv_bfamily_eq_enum_ord (H : ∀ i hi, is_normal (f i hi)) :
   deriv_bfamily o f = enum_ord (⋂ i hi, function.fixed_points (f i hi)) :=
 begin
@@ -331,7 +353,8 @@ section
 variable {f : ordinal.{u} → ordinal.{u}}
 
 /-- The next fixed point function, the least fixed point of the normal function `f`, at least `a`.
--/
+
+This is defined as `ordinal.nfp_family` applied to a family consisting only of `f`. -/
 def nfp (f : ordinal → ordinal) : ordinal → ordinal :=
 nfp_family (λ _ : unit, f)
 
@@ -344,7 +367,7 @@ begin
   refine funext (λ a, le_antisymm _ (sup_le (λ l, _))),
   { rw sup_le_iff,
     intro n,
-    rw [←list.length_repeat unit.star n, ←list.foldr_const f a],
+    rw [←list.length_replicate n unit.star, ←list.foldr_const f a],
     apply le_sup },
   { rw list.foldr_const f a l,
     exact le_sup _ _ },
@@ -362,8 +385,7 @@ by { rw ←sup_iterate_eq_nfp, exact lt_sup }
 theorem nfp_le_iff {a b} : nfp f a ≤ b ↔ ∀ n, (f^[n]) a ≤ b :=
 by { rw ←sup_iterate_eq_nfp, exact sup_le_iff }
 
-theorem nfp_le {a b} : (∀ n, (f^[n]) a ≤ b) → nfp f a ≤ b :=
-nfp_le_iff.2
+theorem nfp_le {a b} : (∀ n, (f^[n]) a ≤ b) → nfp f a ≤ b := nfp_le_iff.2
 
 @[simp] theorem nfp_id : nfp id = id :=
 funext (λ a, begin
@@ -403,7 +425,9 @@ fixed points. -/
 theorem fp_unbounded (H : is_normal f) : (function.fixed_points f).unbounded (<) :=
 by { convert fp_family_unbounded (λ _ : unit, H), exact (set.Inter_const _).symm }
 
-/-- The derivative of a normal function `f` is the sequence of fixed points of `f`. -/
+/-- The derivative of a normal function `f` is the sequence of fixed points of `f`.
+
+This is defined as `ordinal.deriv_family` applied to a trivial family consisting only of `f`. -/
 def deriv (f : ordinal → ordinal) : ordinal → ordinal :=
 deriv_family (λ _ : unit, f)
 
@@ -423,7 +447,7 @@ theorem deriv_is_normal (f) : is_normal (deriv f) :=
 deriv_family_is_normal _
 
 theorem deriv_id_of_nfp_id {f : ordinal → ordinal} (h : nfp f = id) : deriv f = id :=
-((deriv_is_normal _).eq_iff_zero_and_succ is_normal.refl).2 (by simp [h, succ_inj])
+((deriv_is_normal _).eq_iff_zero_and_succ is_normal.refl).2 (by simp [h])
 
 theorem is_normal.deriv_fp {f} (H : is_normal f) : ∀ o, f (deriv f o) = deriv f o :=
 @deriv_family_fp unit (λ _, f) unit.star H
@@ -438,11 +462,12 @@ end
 theorem is_normal.fp_iff_deriv {f} (H : is_normal f) {a} : f a = a ↔ ∃ o, deriv f o = a :=
 by rw [←H.le_iff_eq, H.le_iff_deriv]
 
+/-- `ordinal.deriv` enumerates the fixed points of a normal function. -/
 theorem deriv_eq_enum_ord (H : is_normal f) : deriv f = enum_ord (function.fixed_points f) :=
 by { convert deriv_family_eq_enum_ord (λ _ : unit, H), exact (set.Inter_const _).symm }
 
 theorem deriv_eq_id_of_nfp_eq_id {f : ordinal → ordinal} (h : nfp f = id) : deriv f = id :=
-(is_normal.eq_iff_zero_and_succ (deriv_is_normal _) is_normal.refl).2 (by simp [h, succ_inj])
+(is_normal.eq_iff_zero_and_succ (deriv_is_normal _) is_normal.refl).2 $ by simp [h]
 
 end
 
@@ -490,13 +515,12 @@ begin
   { rw [deriv_zero, add_zero],
     exact nfp_add_zero a },
   { rw [deriv_succ, h, add_succ],
-    exact nfp_eq_self (add_eq_right_iff_mul_omega_le.2 ((le_add_right _ _).trans
-      (lt_succ_self _).le)) }
+    exact nfp_eq_self (add_eq_right_iff_mul_omega_le.2 ((le_add_right _ _).trans (le_succ _))) }
 end
 
 /-! ### Fixed points of multiplication -/
 
-local infixr ^ := @pow ordinal ordinal ordinal.has_pow
+local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
 @[simp] theorem nfp_mul_one {a : ordinal} (ha : 0 < a) : nfp ((*) a) 1 = a ^ omega :=
 begin
   rw [←sup_iterate_eq_nfp, ←sup_opow_nat],
@@ -561,7 +585,7 @@ end
 theorem mul_eq_right_iff_opow_omega_dvd {a b : ordinal} : a * b = b ↔ a ^ omega ∣ b :=
 begin
   cases eq_zero_or_pos a with ha ha,
-  { rw [ha, zero_mul, zero_opow omega_ne_zero, zero_dvd],
+  { rw [ha, zero_mul, zero_opow omega_ne_zero, zero_dvd_iff],
     exact eq_comm },
   refine ⟨λ hab, _, λ h, _⟩,
   { rw dvd_iff_mod_eq_zero,
@@ -579,7 +603,7 @@ theorem mul_le_right_iff_opow_omega_dvd {a b : ordinal} (ha : 0 < a) : a * b ≤
 by { rw ←mul_eq_right_iff_opow_omega_dvd, exact (mul_is_normal ha).le_iff_eq }
 
 theorem nfp_mul_opow_omega_add {a c : ordinal} (b) (ha : 0 < a) (hc : 0 < c) (hca : c ≤ a ^ omega) :
-  nfp ((*) a) (a ^ omega * b + c) = a ^ omega.{u} * b.succ :=
+  nfp ((*) a) (a ^ omega * b + c) = a ^ omega.{u} * (succ b) :=
 begin
   apply le_antisymm,
   { apply nfp_le_fp (mul_is_normal ha).monotone,
@@ -594,7 +618,7 @@ begin
     rw hd at this,
     have := (add_lt_add_left hc (a ^ omega * b)).trans_le this,
     rw [add_zero, mul_lt_mul_iff_left (opow_pos omega ha)] at this,
-    rwa succ_le }
+    rwa succ_le_iff }
 end
 
 theorem deriv_mul_eq_opow_omega_mul {a : ordinal.{u}} (ha : 0 < a) (b) :
diff --git a/src/set_theory/ordinal/natural_ops.lean b/src/set_theory/ordinal/natural_ops.lean
new file mode 100644
index 0000000000000..38f6a566ec06e
--- /dev/null
+++ b/src/set_theory/ordinal/natural_ops.lean
@@ -0,0 +1,644 @@
+/-
+Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Violeta Hernández Palacios
+-/
+
+import set_theory.ordinal.arithmetic
+import tactic.abel
+
+/-!
+# Natural operations on ordinals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The goal of this file is to define natural addition and multiplication on ordinals, also known as
+the Hessenberg sum and product, and provide a basic API. The natural addition of two ordinals
+`a ♯ b` is recursively defined as the least ordinal greater than `a' ♯ b` and `a ♯ b'` for `a' < a`
+and `b' < b`. The natural multiplication `a ⨳ b` is likewise recursively defined as the least
+ordinal such that `a ⨳ b ♯ a' ⨳ b'` is greater than `a' ⨳ b ♯ a ⨳ b'` for any `a' < a` and
+`b' < b`.
+
+These operations form a rich algebraic structure: they're commutative, associative, preserve order,
+have the usual `0` and `1` from ordinals, and distribute over one another.
+
+Moreover, these operations are the addition and multiplication of ordinals when viewed as
+combinatorial `game`s. This makes them particularly useful for game theory.
+
+Finally, both operations admit simple, intuitive descriptions in terms of the Cantor normal form.
+The natural addition of two ordinals corresponds to adding their Cantor normal forms as if they were
+polynomials in `ω`. Likewise, their natural multiplication corresponds to multiplying the Cantor
+normal forms as polynomials.
+
+# Implementation notes
+
+Given the rich algebraic structure of these two operations, we choose to create a type synonym
+`nat_ordinal`, where we provide the appropriate instances. However, to avoid casting back and forth
+between both types, we attempt to prove and state most results on `ordinal`.
+
+# Todo
+
+- Prove the characterizations of natural addition and multiplication in terms of the Cantor normal
+  form.
+-/
+
+universes u v
+
+open function order
+
+noncomputable theory
+
+/-! ### Basic casts between `ordinal` and `nat_ordinal` -/
+
+/-- A type synonym for ordinals with natural addition and multiplication. -/
+@[derive [has_zero, inhabited, has_one, linear_order, succ_order, has_well_founded]]
+def nat_ordinal : Type* := ordinal
+
+/-- The identity function between `ordinal` and `nat_ordinal`. -/
+@[pattern] def ordinal.to_nat_ordinal : ordinal ≃o nat_ordinal := order_iso.refl _
+
+/-- The identity function between `nat_ordinal` and `ordinal`. -/
+@[pattern] def nat_ordinal.to_ordinal : nat_ordinal ≃o ordinal := order_iso.refl _
+
+namespace nat_ordinal
+
+open ordinal
+
+variables {a b c : nat_ordinal.{u}}
+
+@[simp] theorem to_ordinal_symm_eq : nat_ordinal.to_ordinal.symm = ordinal.to_nat_ordinal := rfl
+@[simp] theorem to_ordinal_to_nat_ordinal (a : nat_ordinal) : a.to_ordinal.to_nat_ordinal = a := rfl
+
+theorem lt_wf : @well_founded nat_ordinal (<) := ordinal.lt_wf
+instance : well_founded_lt nat_ordinal := ordinal.well_founded_lt
+instance : is_well_order nat_ordinal (<) := ordinal.has_lt.lt.is_well_order
+
+@[simp] theorem to_ordinal_zero : to_ordinal 0 = 0 := rfl
+@[simp] theorem to_ordinal_one : to_ordinal 1 = 1 := rfl
+
+@[simp] theorem to_ordinal_eq_zero (a) : to_ordinal a = 0 ↔ a = 0 := iff.rfl
+@[simp] theorem to_ordinal_eq_one (a) : to_ordinal a = 1 ↔ a = 1 := iff.rfl
+
+@[simp] theorem to_ordinal_max : (max a b).to_ordinal = max a.to_ordinal b.to_ordinal := rfl
+@[simp] theorem to_ordinal_min : (min a b).to_ordinal = min a.to_ordinal b.to_ordinal := rfl
+
+theorem succ_def (a : nat_ordinal) : succ a = (a.to_ordinal + 1).to_nat_ordinal := rfl
+
+/-- A recursor for `nat_ordinal`. Use as `induction x using nat_ordinal.rec`. -/
+protected def rec {β : nat_ordinal → Sort*} (h : Π a, β (to_nat_ordinal a)) : Π a, β a :=
+λ a, h a.to_ordinal
+
+/-- `ordinal.induction` but for `nat_ordinal`. -/
+theorem induction {p : nat_ordinal → Prop} : ∀ i (h : ∀ j, (∀ k, k < j → p k) → p j), p i :=
+ordinal.induction
+
+end nat_ordinal
+
+namespace ordinal
+
+@[simp] theorem to_nat_ordinal_symm_eq : to_nat_ordinal.symm = nat_ordinal.to_ordinal := rfl
+@[simp] theorem to_nat_ordinal_to_ordinal (a : ordinal) : a.to_nat_ordinal.to_ordinal = a := rfl
+
+@[simp] theorem to_nat_ordinal_zero : to_nat_ordinal 0 = 0 := rfl
+@[simp] theorem to_nat_ordinal_one : to_nat_ordinal 1 = 1 := rfl
+
+@[simp] theorem to_nat_ordinal_eq_zero (a) : to_nat_ordinal a = 0 ↔ a = 0 := iff.rfl
+@[simp] theorem to_nat_ordinal_eq_one (a) : to_nat_ordinal a = 1 ↔ a = 1 := iff.rfl
+
+@[simp] theorem to_nat_ordinal_max (a b : ordinal) :
+  to_nat_ordinal (max a b) = max a.to_nat_ordinal b.to_nat_ordinal := rfl
+@[simp] theorem to_nat_ordinal_min (a b : ordinal) :
+  (linear_order.min a b).to_nat_ordinal = linear_order.min a.to_nat_ordinal b.to_nat_ordinal := rfl
+
+/-! We place the definitions of `nadd` and `nmul` before actually developing their API, as this
+guarantees we only need to open the `natural_ops` locale once. -/
+
+/-- Natural addition on ordinals `a ♯ b`, also known as the Hessenberg sum, is recursively defined
+as the least ordinal greater than `a' ♯ b` and `a ♯ b'` for all `a' < a` and `b' < b`. In contrast
+to normal ordinal addition, it is commutative.
+
+Natural addition can equivalently be characterized as the ordinal resulting from adding up
+corresponding coefficients in the Cantor normal forms of `a` and `b`. -/
+noncomputable def nadd : ordinal → ordinal → ordinal
+| a b := max
+  (blsub.{u u} a $ λ a' h, nadd a' b)
+  (blsub.{u u} b $ λ b' h, nadd a b')
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+localized "infix (name := ordinal.nadd) ` ♯ `:65 := ordinal.nadd" in natural_ops
+
+/-- Natural multiplication on ordinals `a ⨳ b`, also known as the Hessenberg product, is recursively
+defined as the least ordinal such that `a ⨳ b + a' ⨳ b'` is greater than `a' ⨳ b + a ⨳ b'` for all
+`a' < a` and `b < b'`. In contrast to normal ordinal multiplication, it is commutative and
+distributive (over natural addition).
+
+Natural multiplication can equivalently be characterized as the ordinal resulting from multiplying
+the Cantor normal forms of `a` and `b` as if they were polynomials in `ω`. Addition of exponents is
+done via natural addition. -/
+noncomputable def nmul : ordinal.{u} → ordinal.{u} → ordinal.{u}
+| a b := Inf {c | ∀ (a' < a) (b' < b), nmul a' b ♯ nmul a b' < c ♯ nmul a' b'}
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+localized "infix ` ⨳ `:70 := ordinal.nmul" in natural_ops
+
+end ordinal
+
+open_locale natural_ops
+
+/-! ### Natural addition -/
+
+namespace ordinal
+
+variables {a b c : ordinal.{u}}
+
+theorem nadd_def (a b : ordinal) : a ♯ b = max
+  (blsub.{u u} a $ λ a' h, a' ♯ b)
+  (blsub.{u u} b $ λ b' h, a ♯ b') :=
+by rw nadd
+
+theorem lt_nadd_iff : a < b ♯ c ↔ (∃ b' < b, a ≤ b' ♯ c) ∨ ∃ c' < c, a ≤ b ♯ c' :=
+by { rw nadd_def, simp [lt_blsub_iff] }
+
+theorem nadd_le_iff : b ♯ c ≤ a ↔ (∀ b' < b, b' ♯ c < a) ∧ ∀ c' < c, b ♯ c' < a :=
+by { rw nadd_def, simp [blsub_le_iff] }
+
+theorem nadd_lt_nadd_left (h : b < c) (a) : a ♯ b < a ♯ c :=
+lt_nadd_iff.2 (or.inr ⟨b, h, le_rfl⟩)
+
+theorem nadd_lt_nadd_right (h : b < c) (a) : b ♯ a < c ♯ a :=
+lt_nadd_iff.2 (or.inl ⟨b, h, le_rfl⟩)
+
+theorem nadd_le_nadd_left (h : b ≤ c) (a) : a ♯ b ≤ a ♯ c :=
+begin
+  rcases lt_or_eq_of_le h with h | rfl,
+  { exact (nadd_lt_nadd_left h a).le },
+  { exact le_rfl }
+end
+
+theorem nadd_le_nadd_right (h : b ≤ c) (a) : b ♯ a ≤ c ♯ a :=
+begin
+  rcases lt_or_eq_of_le h with h | rfl,
+  { exact (nadd_lt_nadd_right h a).le },
+  { exact le_rfl }
+end
+
+variables (a b)
+
+theorem nadd_comm : ∀ a b, a ♯ b = b ♯ a
+| a b := begin
+  rw [nadd_def, nadd_def, max_comm],
+  congr; ext c hc;
+  apply nadd_comm
+end
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+theorem blsub_nadd_of_mono {f : Π c < a ♯ b, ordinal.{max u v}}
+  (hf : ∀ {i j} hi hj, i ≤ j → f i hi ≤ f j hj) : blsub _ f = max
+  (blsub.{u v} a (λ a' ha', f (a' ♯ b) $ nadd_lt_nadd_right ha' b))
+  (blsub.{u v} b (λ b' hb', f (a ♯ b') $ nadd_lt_nadd_left hb' a)) :=
+begin
+  apply (blsub_le_iff.2 (λ i h, _)).antisymm (max_le _ _),
+  { rcases lt_nadd_iff.1 h with ⟨a', ha', hi⟩ | ⟨b', hb', hi⟩,
+    { exact lt_max_of_lt_left ((hf h (nadd_lt_nadd_right ha' b) hi).trans_lt (lt_blsub _ _ _)) },
+    { exact lt_max_of_lt_right ((hf h (nadd_lt_nadd_left hb' a) hi).trans_lt (lt_blsub _ _ _)) } },
+  all_goals
+  { apply blsub_le_of_brange_subset.{u u v},
+    rintro c ⟨d, hd, rfl⟩,
+    apply mem_brange_self }
+end
+
+theorem nadd_assoc : ∀ a b c, a ♯ b ♯ c = a ♯ (b ♯ c)
+| a b c := begin
+  rw [nadd_def a (b ♯ c), nadd_def, blsub_nadd_of_mono, blsub_nadd_of_mono, max_assoc],
+  { congr; ext d hd;
+    apply nadd_assoc },
+  { exact λ i j _ _ h, nadd_le_nadd_left h a },
+  { exact λ i j _ _ h, nadd_le_nadd_right h c }
+end
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+@[simp] theorem nadd_zero : a ♯ 0 = a :=
+begin
+  induction a using ordinal.induction with a IH,
+  rw [nadd_def, blsub_zero, max_zero_right],
+  convert blsub_id a,
+  ext b hb,
+  exact IH _ hb
+end
+
+@[simp] theorem zero_nadd : 0 ♯ a = a :=
+by rw [nadd_comm, nadd_zero]
+
+@[simp] theorem nadd_one : a ♯ 1 = succ a :=
+begin
+  induction a using ordinal.induction with a IH,
+  rw [nadd_def, blsub_one, nadd_zero, max_eq_right_iff, blsub_le_iff],
+  intros i hi,
+  rwa [IH i hi, succ_lt_succ_iff]
+end
+
+@[simp] theorem one_nadd : 1 ♯ a = succ a :=
+by rw [nadd_comm, nadd_one]
+
+theorem nadd_succ : a ♯ succ b = succ (a ♯ b) :=
+by rw [←nadd_one (a ♯ b), nadd_assoc, nadd_one]
+
+theorem succ_nadd : succ a ♯ b = succ (a ♯ b) :=
+by rw [←one_nadd (a ♯ b), ←nadd_assoc, one_nadd]
+
+@[simp] theorem nadd_nat (n : ℕ) : a ♯ n = a + n :=
+begin
+  induction n with n hn,
+  { simp },
+  { rw [nat.cast_succ, add_one_eq_succ, nadd_succ, add_succ, hn] }
+end
+
+@[simp] theorem nat_nadd (n : ℕ) : ↑n ♯ a = a + n :=
+by rw [nadd_comm, nadd_nat]
+
+theorem add_le_nadd : a + b ≤ a ♯ b :=
+begin
+  apply b.limit_rec_on,
+  { simp },
+  { intros c h,
+    rwa [add_succ, nadd_succ, succ_le_succ_iff] },
+  { intros c hc H,
+    rw [←is_normal.blsub_eq.{u u} (add_is_normal a) hc, blsub_le_iff],
+    exact λ i hi, (H i hi).trans_lt (nadd_lt_nadd_left hi a) }
+end
+
+end ordinal
+
+namespace nat_ordinal
+
+open ordinal
+
+instance : has_add nat_ordinal := ⟨nadd⟩
+
+instance add_covariant_class_lt :
+  covariant_class nat_ordinal.{u} nat_ordinal.{u} (+) (<) :=
+⟨λ a b c h, nadd_lt_nadd_left h a⟩
+
+instance add_covariant_class_le :
+  covariant_class nat_ordinal.{u} nat_ordinal.{u} (+) (≤) :=
+⟨λ a b c h, nadd_le_nadd_left h a⟩
+
+instance add_contravariant_class_le :
+  contravariant_class nat_ordinal.{u} nat_ordinal.{u} (+) (≤) :=
+⟨λ a b c h, by { by_contra' h', exact h.not_lt (add_lt_add_left h' a) }⟩
+
+instance : ordered_cancel_add_comm_monoid nat_ordinal :=
+{ add := (+),
+  add_assoc := nadd_assoc,
+  add_le_add_left := λ a b, add_le_add_left,
+  le_of_add_le_add_left := λ a b c, le_of_add_le_add_left,
+  zero := 0,
+  zero_add := zero_nadd,
+  add_zero := nadd_zero,
+  add_comm := nadd_comm,
+  ..nat_ordinal.linear_order }
+
+instance : add_monoid_with_one nat_ordinal := add_monoid_with_one.unary
+
+@[simp] theorem add_one_eq_succ : ∀ a : nat_ordinal, a + 1 = succ a := nadd_one
+
+@[simp] theorem to_ordinal_cast_nat (n : ℕ) : to_ordinal n = n :=
+begin
+  induction n with n hn,
+  { refl },
+  { change to_ordinal n ♯ 1 = n + 1,
+    rw hn, exact nadd_one n }
+end
+
+end nat_ordinal
+
+namespace ordinal
+
+theorem nadd_eq_add (a b : ordinal) : a ♯ b = (a.to_nat_ordinal + b.to_nat_ordinal).to_ordinal :=
+rfl
+
+@[simp] theorem to_nat_ordinal_cast_nat (n : ℕ) : to_nat_ordinal n = n :=
+by { rw ←nat_ordinal.to_ordinal_cast_nat n, refl }
+
+theorem lt_of_nadd_lt_nadd_left : ∀ {a b c}, a ♯ b < a ♯ c → b < c :=
+@lt_of_add_lt_add_left nat_ordinal _ _ _
+theorem lt_of_nadd_lt_nadd_right : ∀ {a b c}, b ♯ a < c ♯ a → b < c :=
+@_root_.lt_of_add_lt_add_right nat_ordinal _ _ _
+theorem le_of_nadd_le_nadd_left : ∀ {a b c}, a ♯ b ≤ a ♯ c → b ≤ c :=
+@le_of_add_le_add_left nat_ordinal _ _ _
+theorem le_of_nadd_le_nadd_right : ∀ {a b c}, b ♯ a ≤ c ♯ a → b ≤ c :=
+@le_of_add_le_add_right nat_ordinal _ _ _
+
+theorem nadd_lt_nadd_iff_left : ∀ a {b c}, a ♯ b < a ♯ c ↔ b < c :=
+@add_lt_add_iff_left nat_ordinal _ _ _ _
+theorem nadd_lt_nadd_iff_right : ∀ a {b c}, b ♯ a < c ♯ a ↔ b < c :=
+@add_lt_add_iff_right nat_ordinal _ _ _ _
+theorem nadd_le_nadd_iff_left : ∀ a {b c}, a ♯ b ≤ a ♯ c ↔ b ≤ c :=
+@add_le_add_iff_left nat_ordinal _ _ _ _
+theorem nadd_le_nadd_iff_right : ∀ a {b c}, b ♯ a ≤ c ♯ a ↔ b ≤ c :=
+@_root_.add_le_add_iff_right nat_ordinal _ _ _ _
+
+theorem nadd_le_nadd : ∀ {a b c d}, a ≤ b → c ≤ d → a ♯ c ≤ b ♯ d :=
+@add_le_add nat_ordinal _ _ _ _
+theorem nadd_lt_nadd : ∀ {a b c d}, a < b → c < d → a ♯ c < b ♯ d :=
+@add_lt_add nat_ordinal _ _ _ _
+
+theorem nadd_lt_nadd_of_lt_of_le : ∀ {a b c d}, a < b → c ≤ d → a ♯ c < b ♯ d :=
+@add_lt_add_of_lt_of_le nat_ordinal _ _ _ _
+theorem nadd_lt_nadd_of_le_of_lt : ∀ {a b c d}, a ≤ b → c < d → a ♯ c < b ♯ d :=
+@add_lt_add_of_le_of_lt nat_ordinal _ _ _ _
+
+theorem nadd_left_cancel : ∀ {a b c}, a ♯ b = a ♯ c → b = c :=
+@_root_.add_left_cancel nat_ordinal _ _
+theorem nadd_right_cancel : ∀ {a b c}, a ♯ b = c ♯ b → a = c :=
+@_root_.add_right_cancel nat_ordinal _ _
+theorem nadd_left_cancel_iff : ∀ {a b c}, a ♯ b = a ♯ c ↔ b = c :=
+@add_left_cancel_iff nat_ordinal _ _
+theorem nadd_right_cancel_iff : ∀ {a b c}, b ♯ a = c ♯ a ↔ b = c :=
+@add_right_cancel_iff nat_ordinal _ _
+
+theorem le_nadd_self {a b} : a ≤ b ♯ a :=
+by simpa using nadd_le_nadd_right (ordinal.zero_le b) a
+theorem le_nadd_left {a b c} (h : a ≤ c) : a ≤ b ♯ c :=
+le_nadd_self.trans (nadd_le_nadd_left h b)
+theorem le_self_nadd {a b} : a ≤ a ♯ b :=
+by simpa using nadd_le_nadd_left (ordinal.zero_le b) a
+theorem le_nadd_right {a b c} (h : a ≤ b) : a ≤ b ♯ c :=
+le_self_nadd.trans (nadd_le_nadd_right h c)
+
+theorem nadd_left_comm : ∀ a b c, a ♯ (b ♯ c) = b ♯ (a ♯ c) :=
+@add_left_comm nat_ordinal _
+theorem nadd_right_comm : ∀ a b c, a ♯ b ♯ c = a ♯ c ♯ b :=
+@add_right_comm nat_ordinal _
+
+/-! ### Natural multiplication -/
+
+variables {a b c d : ordinal.{u}}
+
+theorem nmul_def (a b : ordinal) :
+  a ⨳ b = Inf {c | ∀ (a' < a) (b' < b), a' ⨳ b ♯ a ⨳ b' < c ♯ a' ⨳ b'} :=
+by rw nmul
+
+/-- The set in the definition of `nmul` is nonempty. -/
+theorem nmul_nonempty (a b : ordinal.{u}) :
+  {c : ordinal.{u} | ∀ (a' < a) (b' < b), a' ⨳ b ♯ a ⨳ b' < c ♯ a' ⨳ b'}.nonempty :=
+⟨_, λ a' ha b' hb, (lt_blsub₂.{u u u} _ ha hb).trans_le le_self_nadd⟩
+
+theorem nmul_nadd_lt {a' b' : ordinal} (ha : a' < a) (hb : b' < b) :
+  a' ⨳ b ♯ a ⨳ b' < a ⨳ b ♯ a' ⨳ b' :=
+by { rw nmul_def a b, exact Inf_mem (nmul_nonempty a b) a' ha b' hb }
+
+theorem nmul_nadd_le {a' b' : ordinal} (ha : a' ≤ a) (hb : b' ≤ b) :
+  a' ⨳ b ♯ a ⨳ b' ≤ a ⨳ b ♯ a' ⨳ b' :=
+begin
+  rcases lt_or_eq_of_le ha with ha | rfl,
+  { rcases lt_or_eq_of_le hb with hb | rfl,
+    { exact (nmul_nadd_lt ha hb).le },
+    { rw nadd_comm } },
+  { exact le_rfl }
+end
+
+theorem lt_nmul_iff : c < a ⨳ b ↔ ∃ (a' < a) (b' < b), c ♯ a' ⨳ b' ≤ a' ⨳ b ♯ a ⨳ b' :=
+begin
+  refine ⟨λ h, _, _⟩,
+  { rw nmul at h,
+    simpa using not_mem_of_lt_cInf h ⟨0, λ _ _, bot_le⟩ },
+  { rintros ⟨a', ha, b', hb, h⟩,
+    have := h.trans_lt (nmul_nadd_lt ha hb),
+    rwa nadd_lt_nadd_iff_right at this }
+end
+
+theorem nmul_le_iff : a ⨳ b ≤ c ↔ ∀ (a' < a) (b' < b), a' ⨳ b ♯ a ⨳ b' < c ♯ a' ⨳ b' :=
+by { rw ←not_iff_not, simp [lt_nmul_iff] }
+
+theorem nmul_comm : ∀ (a b), a ⨳ b = b ⨳ a
+| a b := begin
+  rw [nmul, nmul],
+  congr, ext x, split;
+  intros H c hc d hd,
+  { rw [nadd_comm, ←nmul_comm, ←nmul_comm a, ←nmul_comm d],
+    exact H _ hd _ hc },
+  { rw [nadd_comm, nmul_comm, nmul_comm c, nmul_comm c],
+    exact H _ hd _ hc }
+end
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+@[simp] theorem nmul_zero (a) : a ⨳ 0 = 0 :=
+by { rw [←ordinal.le_zero, nmul_le_iff], exact λ  _ _ a ha, (ordinal.not_lt_zero a ha).elim }
+
+@[simp] theorem zero_nmul (a) : 0 ⨳ a = 0 :=
+by rw [nmul_comm, nmul_zero]
+
+@[simp] theorem nmul_one : ∀ a, a ⨳ 1 = a
+| a := begin
+  rw nmul,
+  simp only [lt_one_iff_zero, forall_eq, nmul_zero, nadd_zero],
+  convert cInf_Ici,
+  ext b,
+  refine ⟨λ H, le_of_forall_lt (λ c hc, _), λ ha c hc, _⟩,
+  { simpa only [nmul_one] using H c hc },
+  { simpa only [nmul_one] using hc.trans_le ha }
+end
+using_well_founded { dec_tac := `[assumption] }
+
+@[simp] theorem one_nmul (a) : 1 ⨳ a = a :=
+by rw [nmul_comm, nmul_one]
+
+theorem nmul_lt_nmul_of_pos_left (h₁ : a < b) (h₂ : 0 < c) : c ⨳ a < c ⨳ b :=
+lt_nmul_iff.2 ⟨0, h₂, a, h₁, by simp⟩
+
+theorem nmul_lt_nmul_of_pos_right (h₁ : a < b) (h₂ : 0 < c) : a ⨳ c < b ⨳ c :=
+lt_nmul_iff.2 ⟨a, h₁, 0, h₂, by simp⟩
+
+theorem nmul_le_nmul_of_nonneg_left (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c ⨳ a ≤ c ⨳ b :=
+begin
+  rcases lt_or_eq_of_le h₁ with h₁|rfl;
+  rcases lt_or_eq_of_le h₂ with h₂|rfl,
+  { exact (nmul_lt_nmul_of_pos_left h₁ h₂).le },
+  all_goals { simp }
+end
+
+theorem nmul_le_nmul_of_nonneg_right (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a ⨳ c ≤ b ⨳ c :=
+begin
+  rw [nmul_comm, nmul_comm b],
+  exact nmul_le_nmul_of_nonneg_left h₁ h₂
+end
+
+theorem nmul_nadd : ∀ (a b c), a ⨳ (b ♯ c) = a ⨳ b ♯ a ⨳ c
+| a b c := begin
+  apply le_antisymm (nmul_le_iff.2 $ λ a' ha d hd, _) (nadd_le_iff.2 ⟨λ d hd, _, λ d hd, _⟩),
+  { rw nmul_nadd,
+    rcases lt_nadd_iff.1 hd with ⟨b', hb, hd⟩ | ⟨c', hc, hd⟩,
+    { have := nadd_lt_nadd_of_lt_of_le (nmul_nadd_lt ha hb) (nmul_nadd_le ha.le hd),
+      rw [nmul_nadd, nmul_nadd] at this,
+      simp only [nadd_assoc] at this,
+      rwa [nadd_left_comm, nadd_left_comm _ (a ⨳ b'), nadd_left_comm (a ⨳ b), nadd_lt_nadd_iff_left,
+        nadd_left_comm (a' ⨳ b), nadd_left_comm (a ⨳ b), nadd_lt_nadd_iff_left, ←nadd_assoc,
+        ←nadd_assoc] at this },
+    { have := nadd_lt_nadd_of_le_of_lt (nmul_nadd_le ha.le hd) (nmul_nadd_lt ha hc),
+      rw [nmul_nadd, nmul_nadd] at this,
+      simp only [nadd_assoc] at this,
+      rwa [nadd_left_comm, nadd_comm (a ⨳ c), nadd_left_comm (a' ⨳ d), nadd_left_comm (a ⨳ c'),
+        nadd_left_comm (a ⨳ b), nadd_lt_nadd_iff_left, nadd_comm (a' ⨳ c), nadd_left_comm (a ⨳ d),
+        nadd_left_comm (a' ⨳ b), nadd_left_comm (a ⨳ b), nadd_lt_nadd_iff_left, nadd_comm (a ⨳ d),
+        nadd_comm (a' ⨳ d), ←nadd_assoc, ←nadd_assoc] at this } },
+  { rcases lt_nmul_iff.1 hd with ⟨a', ha, b', hb, hd⟩,
+    have := nadd_lt_nadd_of_le_of_lt hd (nmul_nadd_lt ha (nadd_lt_nadd_right hb c)),
+    rw [nmul_nadd, nmul_nadd, nmul_nadd a'] at this,
+    simp only [nadd_assoc] at this,
+    rwa [nadd_left_comm (a' ⨳ b'), nadd_left_comm, nadd_lt_nadd_iff_left, nadd_left_comm,
+      nadd_left_comm _ (a' ⨳ b'), nadd_left_comm (a ⨳ b'), nadd_lt_nadd_iff_left,
+      nadd_left_comm (a' ⨳ c), nadd_left_comm, nadd_lt_nadd_iff_left, nadd_left_comm,
+      nadd_comm _ (a' ⨳ c), nadd_lt_nadd_iff_left] at this },
+  { rcases lt_nmul_iff.1 hd with ⟨a', ha, c', hc, hd⟩,
+    have := nadd_lt_nadd_of_lt_of_le (nmul_nadd_lt ha (nadd_lt_nadd_left hc b)) hd,
+    rw [nmul_nadd, nmul_nadd, nmul_nadd a'] at this,
+    simp only [nadd_assoc] at this,
+    rwa [nadd_left_comm _ (a' ⨳ b), nadd_lt_nadd_iff_left, nadd_left_comm (a' ⨳ c'),
+      nadd_left_comm _ (a' ⨳ c), nadd_lt_nadd_iff_left, nadd_left_comm,
+      nadd_comm (a' ⨳ c'), nadd_left_comm _ (a ⨳ c'), nadd_lt_nadd_iff_left,
+      nadd_comm _ (a' ⨳ c'), nadd_comm _ (a' ⨳ c'), nadd_left_comm,
+      nadd_lt_nadd_iff_left] at this }
+end
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+theorem nadd_nmul (a b c) : (a ♯ b) ⨳ c = a ⨳ c ♯ b ⨳ c :=
+by rw [nmul_comm, nmul_nadd, nmul_comm, nmul_comm c]
+
+theorem nmul_nadd_lt₃ {a' b' c' : ordinal} (ha : a' < a) (hb : b' < b) (hc : c' < c) :
+  a' ⨳ b ⨳ c ♯ a ⨳ b' ⨳ c ♯ a ⨳ b ⨳ c' ♯ a' ⨳ b' ⨳ c' <
+  a ⨳ b ⨳ c ♯ a' ⨳ b' ⨳ c ♯ a' ⨳ b ⨳ c' ♯ a ⨳ b' ⨳ c' :=
+by simpa only [nadd_nmul, ←nadd_assoc] using nmul_nadd_lt (nmul_nadd_lt ha hb) hc
+
+theorem nmul_nadd_le₃ {a' b' c' : ordinal} (ha : a' ≤ a) (hb : b' ≤ b) (hc : c' ≤ c) :
+  a' ⨳ b ⨳ c ♯ a ⨳ b' ⨳ c ♯ a ⨳ b ⨳ c' ♯ a' ⨳ b' ⨳ c' ≤
+  a ⨳ b ⨳ c ♯ a' ⨳ b' ⨳ c ♯ a' ⨳ b ⨳ c' ♯ a ⨳ b' ⨳ c' :=
+by simpa only [nadd_nmul, ←nadd_assoc] using nmul_nadd_le (nmul_nadd_le ha hb) hc
+
+theorem nmul_nadd_lt₃' {a' b' c' : ordinal} (ha : a' < a) (hb : b' < b) (hc : c' < c) :
+  a' ⨳ (b ⨳ c) ♯ a ⨳ (b' ⨳ c) ♯ a ⨳ (b ⨳ c') ♯ a' ⨳ (b' ⨳ c') <
+  a ⨳ (b ⨳ c) ♯ a' ⨳ (b' ⨳ c) ♯ a' ⨳ (b ⨳ c') ♯ a ⨳ (b' ⨳ c') :=
+begin
+  simp only [nmul_comm _ (_ ⨳ _)],
+  convert nmul_nadd_lt₃ hb hc ha using 1;
+  { simp only [nadd_eq_add, nat_ordinal.to_ordinal_to_nat_ordinal], abel }
+end
+
+theorem nmul_nadd_le₃' {a' b' c' : ordinal} (ha : a' ≤ a) (hb : b' ≤ b) (hc : c' ≤ c) :
+  a' ⨳ (b ⨳ c) ♯ a ⨳ (b' ⨳ c) ♯ a ⨳ (b ⨳ c') ♯ a' ⨳ (b' ⨳ c') ≤
+  a ⨳ (b ⨳ c) ♯ a' ⨳ (b' ⨳ c) ♯ a' ⨳ (b ⨳ c') ♯ a ⨳ (b' ⨳ c') :=
+begin
+  simp only [nmul_comm _ (_ ⨳ _)],
+  convert nmul_nadd_le₃ hb hc ha using 1;
+  { simp only [nadd_eq_add, nat_ordinal.to_ordinal_to_nat_ordinal], abel }
+end
+
+theorem lt_nmul_iff₃ : d < a ⨳ b ⨳ c ↔ ∃ (a' < a) (b' < b) (c' < c),
+  d ♯ a' ⨳ b' ⨳ c ♯ a' ⨳ b ⨳ c' ♯ a ⨳ b' ⨳ c' ≤
+  a' ⨳ b ⨳ c ♯ a ⨳ b' ⨳ c ♯ a ⨳ b ⨳ c' ♯ a' ⨳ b' ⨳ c' :=
+begin
+  refine ⟨λ h, _, _⟩,
+  { rcases lt_nmul_iff.1 h with ⟨e, he, c', hc, H₁⟩,
+    rcases lt_nmul_iff.1 he with ⟨a', ha, b', hb, H₂⟩,
+    refine ⟨a', ha, b', hb, c', hc, _⟩,
+    have := nadd_le_nadd H₁ (nmul_nadd_le H₂ hc.le),
+    simp only [nadd_nmul, nadd_assoc] at this,
+    rw [nadd_left_comm, nadd_left_comm d, nadd_left_comm, nadd_le_nadd_iff_left,
+      nadd_left_comm (a ⨳ b' ⨳ c), nadd_left_comm (a' ⨳ b ⨳ c), nadd_left_comm (a ⨳ b ⨳ c'),
+      nadd_le_nadd_iff_left, nadd_left_comm (a ⨳ b ⨳ c'), nadd_left_comm (a ⨳ b ⨳ c')] at this,
+    simpa only [nadd_assoc] },
+  { rintro ⟨a', ha, b', hb, c', hc, h⟩,
+    have := h.trans_lt (nmul_nadd_lt₃ ha hb hc),
+    repeat { rwa nadd_lt_nadd_iff_right at this } }
+end
+
+theorem nmul_le_iff₃ : a ⨳ b ⨳ c ≤ d ↔ ∀ (a' < a) (b' < b) (c' < c),
+  a' ⨳ b ⨳ c ♯ a ⨳ b' ⨳ c ♯ a ⨳ b ⨳ c' ♯ a' ⨳ b' ⨳ c' <
+  d ♯ a' ⨳ b' ⨳ c ♯ a' ⨳ b ⨳ c' ♯ a ⨳ b' ⨳ c' :=
+by { rw ←not_iff_not, simp [lt_nmul_iff₃] }
+
+theorem lt_nmul_iff₃' : d < a ⨳ (b ⨳ c) ↔ ∃ (a' < a) (b' < b) (c' < c),
+  d ♯ a' ⨳ (b' ⨳ c) ♯ a' ⨳ (b ⨳ c') ♯ a ⨳ (b' ⨳ c') ≤
+  a' ⨳ (b ⨳ c) ♯ a ⨳ (b' ⨳ c) ♯ a ⨳ (b ⨳ c') ♯ a' ⨳ (b' ⨳ c') :=
+begin
+  simp only [nmul_comm _ (_ ⨳ _), lt_nmul_iff₃, nadd_eq_add, nat_ordinal.to_ordinal_to_nat_ordinal],
+  split; rintro ⟨b', hb, c', hc, a', ha, h⟩,
+  { use [a', ha, b', hb, c', hc], convert h using 1; abel },
+  { use [c', hc, a', ha, b', hb], convert h using 1; abel }
+end
+
+theorem nmul_le_iff₃' : a ⨳ (b ⨳ c) ≤ d ↔ ∀ (a' < a) (b' < b) (c' < c),
+  a' ⨳ (b ⨳ c) ♯ a ⨳ (b' ⨳ c) ♯ a ⨳ (b ⨳ c') ♯ a' ⨳ (b' ⨳ c') <
+  d ♯ a' ⨳ (b' ⨳ c) ♯ a' ⨳ (b ⨳ c') ♯ a ⨳ (b' ⨳ c') :=
+by { rw ←not_iff_not, simp [lt_nmul_iff₃'] }
+
+theorem nmul_assoc : ∀ a b c, a ⨳ b ⨳ c = a ⨳ (b ⨳ c)
+| a b c := begin
+  apply le_antisymm,
+  { rw nmul_le_iff₃,
+    intros a' ha b' hb c' hc,
+    repeat { rw nmul_assoc },
+    exact nmul_nadd_lt₃' ha hb hc },
+  { rw nmul_le_iff₃',
+    intros a' ha b' hb c' hc,
+    repeat { rw ←nmul_assoc },
+    exact nmul_nadd_lt₃ ha hb hc },
+end
+using_well_founded { dec_tac := `[solve_by_elim [psigma.lex.left, psigma.lex.right]] }
+
+end ordinal
+
+open ordinal
+
+instance : has_mul nat_ordinal := ⟨nmul⟩
+
+instance : ordered_comm_semiring nat_ordinal :=
+{ mul := (*),
+  left_distrib := nmul_nadd,
+  right_distrib := nadd_nmul,
+  zero_mul := zero_nmul,
+  mul_zero := nmul_zero,
+  mul_assoc := nmul_assoc,
+  one := 1,
+  one_mul := one_nmul,
+  mul_one := nmul_one,
+  mul_comm := nmul_comm,
+  zero_le_one := @zero_le_one ordinal _ _ _ _,
+  mul_le_mul_of_nonneg_left := λ a b c, nmul_le_nmul_of_nonneg_left,
+  mul_le_mul_of_nonneg_right := λ a b c, nmul_le_nmul_of_nonneg_right,
+  ..nat_ordinal.ordered_cancel_add_comm_monoid,
+  ..nat_ordinal.linear_order }
+
+namespace ordinal
+
+theorem nmul_eq_mul (a b) : a ⨳ b = (a.to_nat_ordinal * b.to_nat_ordinal).to_ordinal := rfl
+
+theorem nmul_nadd_one : ∀ a b, a ⨳ (b ♯ 1) = a ⨳ b ♯ a := @mul_add_one nat_ordinal _ _ _
+theorem nadd_one_nmul : ∀ a b, (a ♯ 1) ⨳ b = a ⨳ b ♯ b := @add_one_mul nat_ordinal _ _ _
+theorem nmul_succ (a b) : a ⨳ succ b = a ⨳ b ♯ a := by rw [←nadd_one, nmul_nadd_one]
+theorem succ_nmul (a b) : succ a ⨳ b = a ⨳ b ♯ b := by rw [←nadd_one, nadd_one_nmul]
+theorem nmul_add_one : ∀ a b, a ⨳ (b + 1) = a ⨳ b ♯ a := nmul_succ
+theorem add_one_nmul : ∀ a b, (a + 1) ⨳ b = a ⨳ b ♯ b := succ_nmul
+
+end ordinal
+
+namespace nat_ordinal
+
+open ordinal
+
+theorem mul_le_nmul (a b : ordinal.{u}) : a * b ≤ a ⨳ b :=
+begin
+  apply b.limit_rec_on,
+  { simp },
+  { intros c h,
+    rw [mul_succ, nmul_succ],
+    exact (add_le_nadd _ a).trans (nadd_le_nadd_right h a) },
+  { intros c hc H,
+    rcases eq_zero_or_pos a with rfl | ha,
+    { simp },
+    { rw [←is_normal.blsub_eq.{u u} (mul_is_normal ha) hc, blsub_le_iff],
+      exact λ i hi, (H i hi).trans_lt (nmul_lt_nmul_of_pos_left hi ha) } }
+end
+
+end nat_ordinal
diff --git a/src/set_theory/ordinal/notation.lean b/src/set_theory/ordinal/notation.lean
index ffe759818abeb..606e136c196b7 100644
--- a/src/set_theory/ordinal/notation.lean
+++ b/src/set_theory/ordinal/notation.lean
@@ -9,6 +9,9 @@ import set_theory.ordinal.principal
 /-!
 # Ordinal notation
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Constructive ordinal arithmetic for ordinals below `ε₀`.
 
 We define a type `onote`, with constructors `0 : onote` and `onote.oadd e n a` representing
@@ -21,7 +24,7 @@ Various operations (addition, subtraction, multiplication, power function)
 are defined on `onote` and `nonote`.
 -/
 
-open ordinal
+open ordinal order
 open_locale ordinal -- get notation for `ω`
 
 /-- Recursive definition of an ordinal notation. `zero` denotes the
@@ -130,7 +133,7 @@ theorem eq_of_cmp_eq : ∀ {o₁ o₂}, cmp o₁ o₂ = ordering.eq → o₁ = o
   simp
 end
 
-theorem zero_lt_one : (0 : onote) < 1 :=
+protected theorem zero_lt_one : (0 : onote) < 1 :=
 by rw [lt_def, repr, repr_one]; exact zero_lt_one
 
 /-- `NF_below o b` says that `o` is a normal form ordinal notation
@@ -176,7 +179,7 @@ theorem NF.snd {e n a} (h : NF (oadd e n a)) : NF a :=
 
 theorem NF.oadd {e a} (h₁ : NF e) (n)
   (h₂ : NF_below a (repr e)) : NF (oadd e n a) :=
-⟨⟨_, NF_below.oadd h₁ h₂ (ordinal.lt_succ_self _)⟩⟩
+⟨⟨_, NF_below.oadd h₁ h₂ (lt_succ _)⟩⟩
 
 instance NF.oadd_zero (e n) [h : NF e] : NF (oadd e n 0) :=
 h.oadd _ NF_below.zero
@@ -199,9 +202,9 @@ begin
   { rw repr,
     apply ((add_lt_add_iff_left _).2 IH).trans_le,
     rw ← mul_succ,
-    apply (mul_le_mul_left' (ordinal.succ_le.2 (nat_lt_omega _)) _).trans,
+    apply (mul_le_mul_left' (succ_le_of_lt (nat_lt_omega _)) _).trans,
     rw ← opow_succ,
-    exact opow_le_opow_right omega_pos (ordinal.succ_le.2 h₃) }
+    exact opow_le_opow_right omega_pos (succ_le_of_lt h₃) }
 end
 
 theorem NF_below.mono {o b₁ b₂} (bb : b₁ ≤ b₂) (h : NF_below o b₁) : NF_below o b₂ :=
@@ -221,7 +224,7 @@ theorem NF.below_of_lt' : ∀ {o b}, repr o < ω ^ b → NF o → NF_below o b
 
 theorem NF_below_of_nat : ∀ n, NF_below (of_nat n) 1
 | 0            := NF_below.zero
-| (nat.succ n) := NF_below.oadd NF.zero NF_below.zero ordinal.zero_lt_one
+| (nat.succ n) := NF_below.oadd NF.zero NF_below.zero zero_lt_one
 
 instance NF_of_nat (n) : NF (of_nat n) := ⟨⟨_, NF_below_of_nat n⟩⟩
 
@@ -237,8 +240,7 @@ begin
   simp [lt_def],
   refine lt_of_lt_of_le ((add_lt_add_iff_left _).2 h₁.snd'.repr_lt)
     (le_trans _ (le_add_right _ _)),
-  rwa [← mul_succ, mul_le_mul_iff_left (opow_pos _ omega_pos),
-       ordinal.succ_le, nat_cast_lt]
+  rwa [← mul_succ, mul_le_mul_iff_left (opow_pos _ omega_pos), succ_le_iff, nat_cast_lt]
 end
 
 theorem oadd_lt_oadd_3 {e n a₁ a₂} (h : a₁ < a₂) :
@@ -368,7 +370,7 @@ theorem add_NF_below {b} : ∀ {o₁ o₂}, NF_below o₁ b → NF_below o₂ b
 end
 
 instance add_NF (o₁ o₂) : ∀ [NF o₁] [NF o₂], NF (o₁ + o₂)
-| ⟨⟨b₁, h₁⟩⟩ ⟨⟨b₂, h₂⟩⟩ := ⟨(b₁.le_total b₂).elim
+| ⟨⟨b₁, h₁⟩⟩ ⟨⟨b₂, h₂⟩⟩ := ⟨(le_total b₁ b₂).elim
   (λ h, ⟨b₂, add_NF_below (h₁.mono h) h₂⟩)
   (λ h, ⟨b₁, add_NF_below h₁ (h₂.mono h)⟩)⟩
 
@@ -389,7 +391,7 @@ instance add_NF (o₁ o₂) : ∀ [NF o₁] [NF o₂], NF (o₁ + o₂)
     { simpa using (mul_le_mul_iff_left $
         opow_pos (repr e') omega_pos).2 (nat_cast_le.2 n'.pos) } },
   { change e = e' at ee, substI e',
-    rw [← add_assoc, ← ordinal.mul_add, ← nat.cast_add] }
+    rw [← add_assoc, ← mul_add, ← nat.cast_add] }
 end
 
 theorem sub_NF_below : ∀ {o₁ o₂ b}, NF_below o₁ b → NF o₂ → NF_below (o₁ - o₂) b
@@ -429,13 +431,13 @@ instance sub_NF (o₁ o₂) : ∀ [NF o₁] [NF o₂], NF (o₁ - o₂)
   { change e₁ = e₂ at ee, substI e₂, unfold sub._match_1,
     cases mn : (n₁:ℕ) - n₂; dsimp only [sub._match_2],
     { by_cases en : n₁ = n₂,
-      { simp [en], rwa [add_sub_add_cancel] },
+      { simpa [en] },
       { simp [en, -repr],
         exact (ordinal.sub_eq_zero_iff_le.2 $ le_of_lt $ oadd_lt_oadd_2 h₁ $
           lt_of_le_of_ne (tsub_eq_zero_iff_le.1 mn) (mt pnat.eq en)).symm } },
     { simp [nat.succ_pnat, -nat.cast_succ],
       rw [(tsub_eq_iff_eq_add_of_le $ le_of_lt $ nat.lt_of_sub_eq_succ mn).1 mn,
-          add_comm, nat.cast_add, ordinal.mul_add, add_assoc, add_sub_add_cancel],
+          add_comm, nat.cast_add, mul_add, add_assoc, add_sub_add_cancel],
       refine (ordinal.sub_eq_of_add_eq $ add_absorp h₂.snd'.repr_lt $
         le_trans _ (le_add_right _ _)).symm,
       simpa using mul_le_mul_left' (nat_cast_le.2 $ nat.succ_pos _) _ } },
@@ -453,8 +455,11 @@ def mul : onote → onote → onote
 
 instance : has_mul onote := ⟨mul⟩
 
-@[simp] theorem zero_mul (o : onote) : 0 * o = 0 := by cases o; refl
-@[simp] theorem mul_zero (o : onote) : o * 0 = 0 := by cases o; refl
+instance : mul_zero_class onote :=
+{ mul := (*),
+  zero := 0,
+  zero_mul := λ o, by cases o; refl,
+  mul_zero := λ o, by cases o; refl }
 
 theorem oadd_mul (e₁ n₁ a₁ e₂ n₂ a₂) : oadd e₁ n₁ a₁ * oadd e₂ n₂ a₂ =
   if e₂ = 0 then oadd e₁ (n₁ * n₂) a₁ else
@@ -481,8 +486,8 @@ instance mul_NF : ∀ o₁ o₂ [NF o₁] [NF o₂], NF (o₁ * o₂)
   ⟨⟨_, oadd_mul_NF_below hb₁ hb₂⟩⟩
 
 @[simp] theorem repr_mul : ∀ o₁ o₂ [NF o₁] [NF o₂], repr (o₁ * o₂) = repr o₁ * repr o₂
-| 0               o               h₁ h₂ := by cases o; exact (ordinal.zero_mul _).symm
-| (oadd e₁ n₁ a₁) 0               h₁ h₂ := (ordinal.mul_zero _).symm
+| 0               o               h₁ h₂ := by cases o; exact (zero_mul _).symm
+| (oadd e₁ n₁ a₁) 0               h₁ h₂ := (mul_zero _).symm
 | (oadd e₁ n₁ a₁) (oadd e₂ n₂ a₂) h₁ h₂ := begin
   have IH : repr (mul _ _) = _ := @repr_mul _ _ h₁ h₂.snd,
   conv {to_lhs, simp [(*)]},
@@ -493,9 +498,9 @@ instance mul_NF : ∀ o₁ o₂ [NF o₁] [NF o₂], NF (o₁ * o₂)
   by_cases e0 : e₂ = 0; simp [e0, mul],
   { cases nat.exists_eq_succ_of_ne_zero n₂.ne_zero with x xe,
     simp [h₂.zero_of_zero e0, xe, -nat.cast_succ],
-    rw [← nat_cast_succ x, add_mul_succ _ ao, mul_assoc] },
+    rw [nat_cast_succ x, add_mul_succ _ ao, mul_assoc] },
   { haveI := h₁.fst, haveI := h₂.fst,
-    simp [IH, repr_add, opow_add, ordinal.mul_add],
+    simp [IH, repr_add, opow_add, mul_add],
     rw ← mul_assoc, congr' 2,
     have := mt repr_inj.1 e0,
     rw [add_mul_limit ao (opow_is_limit_left omega_is_limit this),
@@ -580,7 +585,7 @@ theorem NF_repr_split' : ∀ {o o' m} [NF o], split' o = (o', m) → NF o' ∧ r
     cases NF_repr_split' h' with IH₁ IH₂,
     simp [IH₂, split'],
     intros, substs o' m,
-    have : ω ^ repr e = ω ^ (1 : ordinal.{0}) * ω ^ (repr e - 1),
+    have : (ω : ordinal.{0}) ^ repr e = ω ^ (1 : ordinal.{0}) * ω ^ (repr e - 1),
     { have := mt repr_inj.1 e0,
       rw [← opow_add, ordinal.add_sub_cancel_of_le (one_le_iff_ne_zero.2 this)] },
     refine ⟨NF.oadd (by apply_instance) _ _, _⟩,
@@ -588,7 +593,7 @@ theorem NF_repr_split' : ∀ {o o' m} [NF o], split' o = (o', m) → NF o' ∧ r
       refine IH₁.below_of_lt' ((mul_lt_mul_iff_left omega_pos).1 $
         lt_of_le_of_lt (le_add_right _ m') _),
       rw [← this, ← IH₂], exact h.snd'.repr_lt },
-    { rw this, simp [ordinal.mul_add, mul_assoc, add_assoc] } }
+    { rw this, simp [mul_add, mul_assoc, add_assoc] } }
 end
 
 theorem scale_eq_mul (x) [NF x] : ∀ o [NF o], scale x o = oadd x 1 0 * o
@@ -660,18 +665,18 @@ begin
       { simp [pow, opow, *, - npow_eq_pow], apply_instance } } },
   { simp [pow, opow, e₁, e₂, split_eq_scale_split' e₂],
     have := na.fst,
-    cases k with k; simp [succ_eq_add_one, opow]; resetI; apply_instance }
+    cases k with k; simp [opow]; resetI; apply_instance }
 end
 
 theorem scale_opow_aux (e a0 a : onote) [NF e] [NF a0] [NF a] :
   ∀ k m, repr (opow_aux e a0 a k m) = ω ^ repr e * repr (opow_aux 0 a0 a k m)
 | 0     m := by cases m; simp [opow_aux]
-| (k+1) m := by by_cases m = 0; simp [h, opow_aux,
-  ordinal.mul_add, opow_add, mul_assoc, scale_opow_aux]
+| (k+1) m := by by_cases m = 0; simp [h, opow_aux, mul_add, opow_add, mul_assoc, scale_opow_aux]
 
-theorem repr_opow_aux₁ {e a} [Ne : NF e] [Na : NF a] {a' : ordinal}
-  (e0 : repr e ≠ 0) (h : a' < ω ^ repr e) (aa : repr a = a') (n : ℕ+) :
-  (ω ^ repr e * (n:ℕ) + a') ^ ω = (ω ^ repr e) ^ ω :=
+theorem repr_opow_aux₁ {e a} [Ne : NF e] [Na : NF a] {a' : ordinal} (e0 : repr e ≠ 0)
+  (h : a' < (ω : ordinal.{0}) ^ repr e) (aa : repr a = a') (n : ℕ+) :
+  ((ω : ordinal.{0}) ^ repr e * (n:ℕ) + a') ^ (ω : ordinal.{0}) =
+  (ω ^ repr e) ^ (ω : ordinal.{0}) :=
 begin
   subst aa,
   have No := Ne.oadd n (Na.below_of_lt' h),
@@ -679,21 +684,21 @@ begin
   refine le_antisymm _ (opow_le_opow_left _ this),
   apply (opow_le_of_limit ((opow_pos _ omega_pos).trans_le this).ne' omega_is_limit).2,
   intros b l,
-  have := (No.below_of_lt (lt_succ_self _)).repr_lt, unfold repr at this,
+  have := (No.below_of_lt (lt_succ _)).repr_lt, unfold repr at this,
   apply (opow_le_opow_left b $ this.le).trans,
   rw [← opow_mul, ← opow_mul],
   apply opow_le_opow_right omega_pos,
   cases le_or_lt ω (repr e) with h h,
-  { apply (mul_le_mul_left' (lt_succ_self _).le _).trans,
-    rw [succ, add_mul_succ _ (one_add_of_omega_le h), ← succ,
-        succ_le, mul_lt_mul_iff_left (ordinal.pos_iff_ne_zero.2 e0)],
+  { apply (mul_le_mul_left' (le_succ b) _).trans,
+    rw [←add_one_eq_succ, add_mul_succ _ (one_add_of_omega_le h), add_one_eq_succ,
+        succ_le_iff, mul_lt_mul_iff_left (ordinal.pos_iff_ne_zero.2 e0)],
     exact omega_is_limit.2 _ l },
   { apply (principal_mul_omega (omega_is_limit.2 _ h) l).le.trans,
     simpa using mul_le_mul_right' (one_le_iff_ne_zero.2 e0) ω }
 end
 
 section
-local infixr ^ := @pow ordinal.{0} ordinal ordinal.has_pow
+local infixr (name := ordinal.pow) ^ := @pow ordinal.{0} ordinal ordinal.has_pow
 
 theorem repr_opow_aux₂ {a0 a'} [N0 : NF a0] [Na' : NF a'] (m : ℕ)
   (d : ω ∣ repr a')
@@ -720,7 +725,7 @@ begin
     { simp [k0],
       refine lt_of_lt_of_le _ (opow_le_opow_right omega_pos (one_le_iff_ne_zero.2 e0)),
       cases m with m; simp [k0, R, opow_aux, omega_pos],
-      rw [← nat.cast_succ], apply nat_lt_omega },
+      rw [←add_one_eq_succ, ←nat.cast_succ], apply nat_lt_omega },
     { rw opow_mul, exact IH.1 k0 } },
   refine ⟨λ_, _, _⟩,
   { rw [RR, ← opow_mul _ _ (succ k.succ)],
@@ -733,16 +738,16 @@ begin
       refine mul_lt_omega_opow rr0 this (nat_lt_omega _),
       simpa using (add_lt_add_iff_left (repr a0)).2 e0 },
     { refine lt_of_lt_of_le Rl (opow_le_opow_right omega_pos $
-        mul_le_mul_left' (succ_le_succ.2 (nat_cast_le.2 (le_of_lt k.lt_succ_self))) _) } },
+        mul_le_mul_left' (succ_le_succ_iff.2 (nat_cast_le.2 (le_of_lt k.lt_succ_self))) _) } },
   calc
         ω0 ^ k.succ * α' + R'
       = ω0 ^ succ k * α' + (ω0 ^ k * α' * m + R) : by rw [nat_cast_succ, RR, ← mul_assoc]
   ... = (ω0 ^ k * α' + R) * α' + (ω0 ^ k * α' + R) * m : _
-  ... = (α' + m) ^ succ k.succ : by rw [← ordinal.mul_add, ← nat_cast_succ, opow_succ, IH.2],
+  ... = (α' + m) ^ succ k.succ : by rw [← mul_add, nat_cast_succ, opow_succ, IH.2],
   congr' 1,
   { have αd : ω ∣ α' := dvd_add (dvd_mul_of_dvd_left
       (by simpa using opow_dvd_opow ω (one_le_iff_ne_zero.2 e0)) _) d,
-    rw [ordinal.mul_add (ω0 ^ k), add_assoc, ← mul_assoc, ← opow_succ,
+    rw [mul_add (ω0 ^ k), add_assoc, ← mul_assoc, ← opow_succ,
         add_mul_limit _ (is_limit_iff_omega_dvd.2 ⟨ne_of_gt α0, αd⟩), mul_assoc,
         @mul_omega_dvd n (nat_cast_pos.2 n.pos) (nat_lt_omega _) _ αd],
     apply @add_absorp _ (repr a0 * succ k),
@@ -753,7 +758,7 @@ begin
       rw opow_mul, simpa [-opow_succ] } },
   { cases m,
     { have : R = 0, {cases k; simp [R, opow_aux]}, simp [this] },
-    { rw [← nat_cast_succ, add_mul_succ],
+    { rw [nat_cast_succ, add_mul_succ],
       apply add_absorp Rl,
       rw [opow_mul, opow_succ],
       apply mul_le_mul_left',
@@ -784,13 +789,198 @@ begin
     simp [opow_def, opow, e₁, r₁, split_eq_scale_split' e₂],
     cases k with k; resetI,
     { simp [opow, r₂, opow_mul, repr_opow_aux₁ a00 al aa, add_assoc] },
-    { simp [succ_eq_add_one, opow, r₂, opow_add, opow_mul, mul_assoc, add_assoc],
+    { simp [opow, r₂, opow_add, opow_mul, mul_assoc, add_assoc],
       rw [repr_opow_aux₁ a00 al aa, scale_opow_aux], simp [opow_mul],
-      rw [← ordinal.mul_add, ← add_assoc (ω ^ repr a0 * (n:ℕ))], congr' 1,
+      rw [← mul_add, ← add_assoc ((ω : ordinal.{0}) ^ repr a0 * (n:ℕ))], congr' 1,
       rw [← opow_succ],
       exact (repr_opow_aux₂ _ ad a00 al _ _).2 } }
 end
 
+/-- Given an ordinal, returns `inl none` for `0`, `inl (some a)` for `a+1`, and
+  `inr f` for a limit ordinal `a`, where `f i` is a sequence converging to `a`. -/
+def fundamental_sequence : onote → option onote ⊕ (ℕ → onote)
+| zero := sum.inl none
+| (oadd a m b) :=
+  match fundamental_sequence b with
+  | sum.inr f := sum.inr (λ i, oadd a m (f i))
+  | sum.inl (some b') := sum.inl (some (oadd a m b'))
+  | sum.inl none := match fundamental_sequence a, m.nat_pred with
+    | sum.inl none, 0 := sum.inl (some zero)
+    | sum.inl none, m+1 := sum.inl (some (oadd zero m.succ_pnat zero))
+    | sum.inl (some a'), 0 := sum.inr (λ i, oadd a' i.succ_pnat zero)
+    | sum.inl (some a'), m+1 := sum.inr (λ i, oadd a m.succ_pnat (oadd a' i.succ_pnat zero))
+    | sum.inr f, 0 := sum.inr (λ i, oadd (f i) 1 zero)
+    | sum.inr f, m+1 := sum.inr (λ i, oadd a m.succ_pnat (oadd (f i) 1 zero))
+    end
+  end
+
+private theorem exists_lt_add {α} [hα : nonempty α] {o : ordinal} {f : α → ordinal}
+  (H : ∀ ⦃a⦄, a < o → ∃ i, a < f i) {b : ordinal} ⦃a⦄ (h : a < b + o) : ∃ i, a < b + f i :=
+begin
+  cases lt_or_le a b with h h',
+  { obtain ⟨i⟩ := id hα, exact ⟨i, h.trans_le (le_add_right _ _)⟩ },
+  { rw [← ordinal.add_sub_cancel_of_le h', add_lt_add_iff_left] at h,
+    refine (H h).imp (λ i H, _),
+    rwa [← ordinal.add_sub_cancel_of_le h', add_lt_add_iff_left] }
+end
+
+private theorem exists_lt_mul_omega' {o : ordinal} ⦃a⦄ (h : a < o * ω) : ∃ i : ℕ, a < o * ↑i + o :=
+begin
+  obtain ⟨i, hi, h'⟩ := (lt_mul_of_limit omega_is_limit).1 h,
+  obtain ⟨i, rfl⟩ := lt_omega.1 hi,
+  exact ⟨i, h'.trans_le (le_add_right _ _)⟩
+end
+
+local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
+private theorem exists_lt_omega_opow' {α} {o b : ordinal}
+  (hb : 1 < b) (ho : o.is_limit) {f : α → ordinal}
+  (H : ∀ ⦃a⦄, a < o → ∃ i, a < f i) ⦃a⦄ (h : a < b ^ o) : ∃ i, a < b ^ f i :=
+begin
+  obtain ⟨d, hd, h'⟩ := (lt_opow_of_limit (zero_lt_one.trans hb).ne' ho).1 h,
+  exact (H hd).imp (λ i hi, h'.trans $ (opow_lt_opow_iff_right hb).2 hi)
+end
+
+/-- The property satisfied by `fundamental_sequence o`:
+  * `inl none` means `o = 0`
+  * `inl (some a)` means `o = succ a`
+  * `inr f` means `o` is a limit ordinal and `f` is a
+    strictly increasing sequence which converges to `o` -/
+def fundamental_sequence_prop (o : onote) : option onote ⊕ (ℕ → onote) → Prop
+| (sum.inl none) := o = 0
+| (sum.inl (some a)) := o.repr = succ a.repr ∧ (o.NF → a.NF)
+| (sum.inr f) := o.repr.is_limit ∧
+  (∀ i, f i < f (i + 1) ∧ f i < o ∧ (o.NF → (f i).NF)) ∧
+  (∀ a, a < o.repr → ∃ i, a < (f i).repr)
+
+theorem fundamental_sequence_has_prop (o) : fundamental_sequence_prop o (fundamental_sequence o) :=
+begin
+  induction o with a m b iha ihb, {exact rfl},
+  rw [fundamental_sequence],
+  rcases e : b.fundamental_sequence with ⟨_|b'⟩|f;
+    simp only [fundamental_sequence, fundamental_sequence_prop];
+    rw [e, fundamental_sequence_prop] at ihb,
+  { rcases e : a.fundamental_sequence with ⟨_|a'⟩|f; cases e' : m.nat_pred with m';
+      simp only [fundamental_sequence, fundamental_sequence_prop];
+      rw [e, fundamental_sequence_prop] at iha;
+      try { rw show m = 1,
+        { have := pnat.nat_pred_add_one m, rw [e'] at this, exact pnat.coe_inj.1 this.symm } };
+      try { rw show m = m'.succ.succ_pnat,
+        { rw [← e', ← pnat.coe_inj, nat.succ_pnat_coe, ← nat.add_one, pnat.nat_pred_add_one] } };
+      simp only [repr, iha, ihb, opow_lt_opow_iff_right one_lt_omega,
+        add_lt_add_iff_left, add_zero, coe_coe, eq_self_iff_true, lt_add_iff_pos_right,
+        lt_def, mul_one, nat.cast_zero, nat.cast_succ, nat.succ_pnat_coe, opow_succ,
+        opow_zero, mul_add_one, pnat.one_coe, succ_zero, true_and, _root_.zero_add,
+        zero_def],
+    { apply_instance },
+    { exact ⟨rfl, infer_instance⟩ },
+    { have := opow_pos _ omega_pos,
+      refine ⟨mul_is_limit this omega_is_limit,
+        λ i, ⟨this, _, λ H, @NF.oadd_zero _ _ (iha.2 H.fst)⟩, exists_lt_mul_omega'⟩,
+      rw [← mul_succ, ← nat_cast_succ, ordinal.mul_lt_mul_iff_left this],
+      apply nat_lt_omega },
+    { have := opow_pos _ omega_pos,
+      refine ⟨
+        add_is_limit _ (mul_is_limit this omega_is_limit), λ i, ⟨this, _, _⟩,
+        exists_lt_add exists_lt_mul_omega'⟩,
+      { rw [← mul_succ, ← nat_cast_succ, ordinal.mul_lt_mul_iff_left this],
+        apply nat_lt_omega },
+      { refine λ H, H.fst.oadd _ (NF.below_of_lt' _ (@NF.oadd_zero _ _ (iha.2 H.fst))),
+        rw [repr, repr, add_zero, iha.1, opow_succ, ordinal.mul_lt_mul_iff_left this],
+        apply nat_lt_omega } },
+    { rcases iha with ⟨h1, h2, h3⟩,
+      refine ⟨opow_is_limit one_lt_omega h1, λ i, _, exists_lt_omega_opow' one_lt_omega h1 h3⟩,
+      obtain ⟨h4, h5, h6⟩ := h2 i, exact ⟨h4, h5, λ H, @NF.oadd_zero _ _ (h6 H.fst)⟩ },
+    { rcases iha with ⟨h1, h2, h3⟩,
+      refine ⟨add_is_limit _ (opow_is_limit one_lt_omega h1), λ i, _,
+        exists_lt_add (exists_lt_omega_opow' one_lt_omega h1 h3)⟩,
+      obtain ⟨h4, h5, h6⟩ := h2 i,
+      refine ⟨h4, h5, λ H, H.fst.oadd _ (NF.below_of_lt' _ (@NF.oadd_zero _ _ (h6 H.fst)))⟩,
+      rwa [repr, repr, add_zero, coe_coe, pnat.one_coe, nat.cast_one, mul_one,
+        opow_lt_opow_iff_right one_lt_omega] } },
+  { refine ⟨by rw [repr, ihb.1, add_succ, repr],
+      λ H, H.fst.oadd _ (NF.below_of_lt' _ (ihb.2 H.snd))⟩,
+    have := H.snd'.repr_lt, rw ihb.1 at this,
+    exact (lt_succ _).trans this },
+  { rcases ihb with ⟨h1, h2, h3⟩,
+    simp only [repr],
+    exact ⟨ordinal.add_is_limit _ h1,
+      λ i, ⟨oadd_lt_oadd_3 (h2 i).1, oadd_lt_oadd_3 (h2 i).2.1, λ H, H.fst.oadd _
+        (NF.below_of_lt' (lt_trans (h2 i).2.1 H.snd'.repr_lt) ((h2 i).2.2 H.snd))⟩,
+      exists_lt_add h3⟩ }
+end
+
+/-- The fast growing hierarchy for ordinal notations `< ε₀`. This is a sequence of
+functions `ℕ → ℕ` indexed by ordinals, with the definition:
+* `f_0(n) = n + 1`
+* `f_(α+1)(n) = f_α^[n](n)`
+* `f_α(n) = f_(α[n])(n)` where `α` is a limit ordinal
+   and `α[i]` is the fundamental sequence converging to `α` -/
+def fast_growing : onote → ℕ → ℕ
+| o :=
+  match fundamental_sequence o, fundamental_sequence_has_prop o with
+  | sum.inl none, _ := nat.succ
+  | sum.inl (some a), h :=
+    have a < o, { rw [lt_def, h.1], apply lt_succ },
+    λ i, (fast_growing a)^[i] i
+  | sum.inr f, h := λ i, have f i < o, from (h.2.1 i).2.1, fast_growing (f i) i
+  end
+using_well_founded
+{ rel_tac := λ _ _, `[exact ⟨_, inv_image.wf repr ordinal.lt_wf⟩],
+  dec_tac := `[assumption] }
+
+theorem fast_growing_def
+  {o : onote} {x} (e : fundamental_sequence o = x) :
+    fast_growing o =
+    fast_growing._match_1 o
+      (λ a _ _, a.fast_growing)
+      (λ f _ i _, (f i).fast_growing i)
+      x (e ▸ fundamental_sequence_has_prop _) :=
+by { subst x, rw [fast_growing] }
+
+theorem fast_growing_zero' (o : onote) (h : fundamental_sequence o = sum.inl none) :
+  fast_growing o = nat.succ := by { rw [fast_growing_def h], refl }
+theorem fast_growing_succ (o) {a} (h : fundamental_sequence o = sum.inl (some a)) :
+  fast_growing o = λ i, ((fast_growing a)^[i] i) := by { rw [fast_growing_def h], refl }
+theorem fast_growing_limit (o) {f} (h : fundamental_sequence o = sum.inr f) :
+  fast_growing o = λ i, fast_growing (f i) i := by { rw [fast_growing_def h], refl }
+
+@[simp] theorem fast_growing_zero : fast_growing 0 = nat.succ := fast_growing_zero' _ rfl
+
+@[simp] theorem fast_growing_one : fast_growing 1 = (λ n, 2 * n) :=
+begin
+  rw [@fast_growing_succ 1 0 rfl], funext i, rw [two_mul, fast_growing_zero],
+  suffices : ∀ a b, nat.succ^[a] b = b + a, from this _ _,
+  intros a b, induction a; simp [*, function.iterate_succ', nat.add_succ],
+end
+
+section
+local infixr (name := pow) ^ := pow
+@[simp] theorem fast_growing_two : fast_growing 2 = (λ n, 2 ^ n * n) :=
+begin
+  rw [@fast_growing_succ 2 1 rfl], funext i, rw [fast_growing_one],
+  suffices : ∀ a b, (λ (n : ℕ), 2 * n)^[a] b = 2 ^ a * b, from this _ _,
+  intros a b, induction a; simp [*, function.iterate_succ', pow_succ, mul_assoc],
+end
+end
+
+/-- We can extend the fast growing hierarchy one more step to `ε₀` itself,
+  using `ω^(ω^...^ω^0)` as the fundamental sequence converging to `ε₀` (which is not an `onote`).
+  Extending the fast growing hierarchy beyond this requires a definition of fundamental sequence
+  for larger ordinals. -/
+def fast_growing_ε₀ (i : ℕ) : ℕ := fast_growing ((λ a, a.oadd 1 0)^[i] 0) i
+
+theorem fast_growing_ε₀_zero : fast_growing_ε₀ 0 = 1 := by simp [fast_growing_ε₀]
+
+theorem fast_growing_ε₀_one : fast_growing_ε₀ 1 = 2 :=
+by simp [fast_growing_ε₀, show oadd 0 1 0 = 1, from rfl]
+
+theorem fast_growing_ε₀_two : fast_growing_ε₀ 2 = 2048 :=
+by norm_num [fast_growing_ε₀,
+  show oadd 0 1 0 = 1, from rfl,
+  @fast_growing_limit (oadd 1 1 0) _ rfl,
+  show oadd 0 (2:nat).succ_pnat 0 = 3, from rfl,
+  @fast_growing_succ 3 2 rfl]
+
 end onote
 
 /-- The type of normal ordinal notations. (It would have been
@@ -832,8 +1022,9 @@ instance : preorder nonote :=
 instance : has_zero nonote := ⟨⟨0, NF.zero⟩⟩
 instance : inhabited nonote := ⟨0⟩
 
-theorem wf : @well_founded nonote (<) := inv_image.wf repr ordinal.wf
-instance : has_well_founded nonote := ⟨(<), wf⟩
+theorem lt_wf : @well_founded nonote (<) := inv_image.wf repr ordinal.lt_wf
+instance : well_founded_lt nonote := ⟨lt_wf⟩
+instance : has_well_founded nonote := ⟨(<), lt_wf⟩
 
 /-- Convert a natural number to an ordinal notation -/
 def of_nat (n : ℕ) : nonote := ⟨of_nat n, ⟨⟨_, NF_below_of_nat _⟩⟩⟩
@@ -851,8 +1042,7 @@ theorem cmp_compares : ∀ a b : nonote, (cmp a b).compares a b
 end
 
 instance : linear_order nonote := linear_order_of_compares cmp cmp_compares
-
-instance : is_well_order nonote (<) := ⟨wf⟩
+instance : is_well_order nonote (<) := { }
 
 /-- Asserts that `repr a < ω ^ repr b`. Used in `nonote.rec_on` -/
 def below (a b : nonote) : Prop := NF_below a.1 (repr b)
@@ -893,7 +1083,7 @@ onote.repr_mul a.1 b.1
 /-- Exponentiation of ordinal notations -/
 def opow (x y : nonote) := mk (x.1.opow y.1)
 
-theorem repr_opow (a b) : repr (opow a b) = (repr a).opow (repr b) :=
+theorem repr_opow (a b) : repr (opow a b) = repr a ^ repr b :=
 onote.repr_opow a.1 b.1
 
 end nonote
diff --git a/src/set_theory/ordinal/principal.lean b/src/set_theory/ordinal/principal.lean
index 456ee103d9fd9..ce63acccbfca8 100644
--- a/src/set_theory/ordinal/principal.lean
+++ b/src/set_theory/ordinal/principal.lean
@@ -9,6 +9,9 @@ import set_theory.ordinal.fixed_point
 /-!
 ### Principal ordinals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define principal or indecomposable ordinals, and we prove the standard properties about them.
 
 ### Main definitions and results
@@ -29,8 +32,10 @@ universe u
 
 noncomputable theory
 
+open order
+
 namespace ordinal
-local infixr ^ := @pow ordinal ordinal ordinal.has_pow
+local infixr (name := ordinal.pow) ^ := @pow ordinal ordinal ordinal.has_pow
 
 /-! ### Principal ordinals -/
 
@@ -80,31 +85,21 @@ nfp_le $ λ n, (ho.iterate_lt hao n).le
 
 /-! ### Principal ordinals are unbounded -/
 
-/-- The least strict upper bound of `op` applied to all pairs of ordinals less than `o`. This is
-essentially a two-argument version of `ordinal.blsub`. -/
-def blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) : ordinal :=
-lsub (λ x : o.out.α × o.out.α, op (typein (<) x.1) (typein (<) x.2))
-
-theorem lt_blsub₂ (op : ordinal → ordinal → ordinal) {o : ordinal} {a b : ordinal} (ha : a < o)
-  (hb : b < o) : op a b < blsub₂ op o :=
-begin
-  convert lt_lsub _ (prod.mk (enum (<) a (by rwa type_lt)) (enum (<) b (by rwa type_lt))),
-  simp only [typein_enum]
-end
-
 theorem principal_nfp_blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) :
-  principal op (nfp (blsub₂.{u u} op) o) :=
+  principal op (nfp (λ o', blsub₂.{u u u} o' o' (λ a _ b _, op a b)) o) :=
 λ a b ha hb, begin
   rw lt_nfp at *,
   cases ha with m hm,
   cases hb with n hn,
-  cases le_total ((blsub₂.{u u} op)^[m] o) ((blsub₂.{u u} op)^[n] o) with h h,
+  cases le_total
+    ((λ o', blsub₂.{u u u} o' o' (λ a _ b _, op a b))^[m] o)
+    ((λ o', blsub₂.{u u u} o' o' (λ a _ b _, op a b))^[n] o) with h h,
   { use n + 1,
     rw function.iterate_succ',
-    exact lt_blsub₂ op (hm.trans_le h) hn },
+    exact lt_blsub₂ _ (hm.trans_le h) hn },
   { use m + 1,
     rw function.iterate_succ',
-    exact lt_blsub₂ op hm (hn.trans_le h) },
+    exact lt_blsub₂ _ hm (hn.trans_le h) }
 end
 
 theorem unbounded_principal (op : ordinal → ordinal → ordinal) :
@@ -128,12 +123,12 @@ theorem principal_add_is_limit {o : ordinal} (ho₁ : 1 < o) (ho : principal (+)
 begin
   refine ⟨λ ho₀, _, λ a hao, _⟩,
   { rw ho₀ at ho₁,
-    exact not_lt_of_gt ordinal.zero_lt_one ho₁ },
+    exact not_lt_of_gt zero_lt_one ho₁ },
   { cases eq_or_ne a 0 with ha ha,
     { rw [ha, succ_zero],
       exact ho₁ },
     { refine lt_of_le_of_lt _ (ho hao hao),
-      rwa [succ_eq_add_one, add_le_add_iff_left, one_le_iff_ne_zero] } }
+      rwa [←add_one_eq_succ, add_le_add_iff_left, one_le_iff_ne_zero] } }
 end
 
 theorem principal_add_iff_add_left_eq_self {o : ordinal} :
@@ -185,7 +180,7 @@ theorem add_omega_opow {a b : ordinal} (h : a < omega ^ b) : a + omega ^ b = ome
 begin
   refine le_antisymm _ (le_add_left _ _),
   revert h, refine limit_rec_on b (λ h, _) (λ b _ h, _) (λ b l IH h, _),
-  { rw [opow_zero, ← succ_zero, lt_succ, ordinal.le_zero] at h,
+  { rw [opow_zero, ← succ_zero, lt_succ_iff, ordinal.le_zero] at h,
     rw [h, zero_add] },
   { rw opow_succ at h,
     rcases (lt_mul_of_limit omega_is_limit).1 h with ⟨x, xo, ax⟩,
@@ -209,10 +204,10 @@ begin
   { simp only [principal_zero, or.inl] },
   { rw [principal_add_iff_add_left_eq_self],
     simp only [ho, false_or],
-    refine ⟨λ H, ⟨_, ((lt_or_eq_of_le (opow_log_le _ (ordinal.pos_iff_ne_zero.2 ho)))
+    refine ⟨λ H, ⟨_, ((lt_or_eq_of_le (opow_log_le_self _ ho))
         .resolve_left $ λ h, _).symm⟩, λ ⟨b, e⟩, e.symm ▸ λ a, add_omega_opow⟩,
     have := H _ h,
-    have := lt_opow_succ_log one_lt_omega o,
+    have := lt_opow_succ_log_self one_lt_omega o,
     rw [opow_succ, lt_mul_of_limit omega_is_limit] at this,
     rcases this with ⟨a, ao, h'⟩,
     rcases lt_omega.1 ao with ⟨n, rfl⟩, clear ao,
@@ -245,14 +240,14 @@ begin
   { rcases eq_zero_or_pos b with rfl | hb₁',
     { rw mul_zero,
       exact principal_zero },
-    { rw [← succ_le,succ_zero] at hb₁',
+    { rw [← succ_le_iff, succ_zero] at hb₁',
       intros c d hc hd,
       rw lt_mul_of_limit (principal_add_is_limit (lt_of_le_of_ne hb₁' hb₁.symm) hb) at *,
       { rcases hc with ⟨x, hx, hx'⟩,
         rcases hd with ⟨y, hy, hy'⟩,
         use [x + y, hb hx hy],
         rw mul_add,
-        exact add_lt_add hx' hy' },
+        exact left.add_lt_add hx' hy' },
       assumption' } }
 end
 
@@ -263,8 +258,8 @@ by { rw principal_one_iff, exact zero_mul _ }
 
 theorem principal_mul_two : principal (*) 2 :=
 λ a b ha hb, begin
-  have h₂ : (1 : ordinal).succ = 2 := rfl,
-  rw [←h₂, ordinal.lt_succ] at *,
+  have h₂ : succ (1 : ordinal) = 2 := rfl,
+  rw [←h₂, lt_succ_iff] at *,
   convert mul_le_mul' ha hb,
   exact (mul_one 1).symm
 end
@@ -272,8 +267,8 @@ end
 theorem principal_mul_of_le_two {o : ordinal} (ho : o ≤ 2) : principal (*) o :=
 begin
   rcases lt_or_eq_of_le ho with ho | rfl,
-  { have h₂ : (1 : ordinal).succ = 2 := rfl,
-    rw [←h₂, ordinal.lt_succ] at ho,
+  { have h₂ : succ (1 : ordinal) = 2 := rfl,
+    rw [←h₂, lt_succ_iff] at ho,
     rcases lt_or_eq_of_le ho with ho | rfl,
     { rw lt_one_iff_zero.1 ho,
       exact principal_zero },
@@ -286,7 +281,7 @@ theorem principal_add_of_principal_mul {o : ordinal} (ho : principal (*) o) (ho
 begin
   cases lt_or_gt_of_ne ho₂ with ho₁ ho₂,
   { change o < succ 1 at ho₁,
-    rw lt_succ at ho₁,
+    rw lt_succ_iff at ho₁,
     exact principal_add_of_le_one ho₁ },
   { refine λ a b hao hbo, lt_of_le_of_lt _ (ho (max_lt hao hbo) ho₂),
     rw mul_two,
@@ -296,7 +291,7 @@ end
 theorem principal_mul_is_limit {o : ordinal.{u}} (ho₂ : 2 < o) (ho : principal (*) o) :
   o.is_limit :=
 principal_add_is_limit
-  ((ordinal.lt_succ_self 1).trans ho₂)
+  ((lt_succ 1).trans ho₂)
   (principal_add_of_principal_mul ho (ne_of_gt ho₂))
 
 theorem principal_mul_iff_mul_left_eq {o : ordinal} :
@@ -307,8 +302,8 @@ begin
     { convert one_mul o,
       apply le_antisymm,
       { have : a < succ 1 := hao.trans_le ho,
-        rwa lt_succ at this },
-      { rwa [←succ_le, succ_zero] at ha₀ } },
+        rwa lt_succ_iff at this },
+      { rwa [←succ_le_iff, succ_zero] at ha₀ } },
     { exact op_eq_self_of_principal hao (mul_is_normal ha₀) h (principal_mul_is_limit ho h) } },
   { rcases eq_or_ne a 0 with rfl | ha, { rwa zero_mul },
     rw ←ordinal.pos_iff_ne_zero at ha,
@@ -376,7 +371,7 @@ begin
     rcases principal_add_iff_zero_or_omega_opow.1
       (principal_add_of_principal_mul_opow one_lt_omega ho) with rfl | ⟨b, rfl⟩,
     { rw opow_zero at ho₂,
-      exact ((lt_succ_self 1).not_le ho₂.le).elim },
+      exact ((lt_succ 1).not_le ho₂.le).elim },
     exact or.inr ⟨b, rfl⟩ },
   { rintro (ho₂ | ⟨a, rfl⟩),
     { exact principal_mul_of_le_two ho₂ },
@@ -387,22 +382,22 @@ theorem mul_omega_dvd {a : ordinal}
   (a0 : 0 < a) (ha : a < omega) : ∀ {b}, omega ∣ b → a * b = b
 | _ ⟨b, rfl⟩ := by rw [← mul_assoc, mul_omega a0 ha]
 
-theorem mul_eq_opow_log_succ {a b : ordinal.{u}} (ha : 0 < a) (hb : principal (*) b) (hb₂ : 2 < b) :
-  a * b = b ^ (log b a).succ :=
+theorem mul_eq_opow_log_succ {a b : ordinal.{u}} (ha : a ≠ 0) (hb : principal (*) b) (hb₂ : 2 < b) :
+  a * b = b ^ succ (log b a) :=
 begin
   apply le_antisymm,
   { have hbl := principal_mul_is_limit hb₂ hb,
-    rw [←is_normal.bsup_eq.{u u} (mul_is_normal ha) hbl, bsup_le_iff],
+    rw [←is_normal.bsup_eq.{u u} (mul_is_normal (ordinal.pos_iff_ne_zero.2 ha)) hbl, bsup_le_iff],
     intros c hcb,
-    have hb₁ : 1 < b := (lt_succ_self 1).trans hb₂,
+    have hb₁ : 1 < b := (lt_succ 1).trans hb₂,
     have hbo₀ : b ^ b.log a ≠ 0 := ordinal.pos_iff_ne_zero.1 (opow_pos _ (zero_lt_one.trans hb₁)),
     apply le_trans (mul_le_mul_right' (le_of_lt (lt_mul_succ_div a hbo₀)) c),
     rw [mul_assoc, opow_succ],
     refine mul_le_mul_left' (le_of_lt (hb (hbl.2 _ _) hcb)) _,
     rw [div_lt hbo₀, ←opow_succ],
-    exact lt_opow_succ_log hb₁ _ },
+    exact lt_opow_succ_log_self hb₁ _ },
   { rw opow_succ,
-    exact mul_le_mul_right' (opow_log_le b ha) b }
+    exact mul_le_mul_right' (opow_log_le_self b ha) b }
 end
 
 /-! #### Exponential principal ordinals -/
diff --git a/src/set_theory/ordinal/topology.lean b/src/set_theory/ordinal/topology.lean
index e3d157dfc5444..329858582a348 100644
--- a/src/set_theory/ordinal/topology.lean
+++ b/src/set_theory/ordinal/topology.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Violeta Hernández Palacios
 -/
 import set_theory.ordinal.arithmetic
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 ### Topology of ordinals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We prove some miscellaneous results involving the order topology of ordinals.
 
 ### Main results
@@ -25,43 +28,44 @@ noncomputable theory
 
 universes u v
 
-open cardinal
+open cardinal order
 
 namespace ordinal
 
+variables {s : set ordinal.{u}} {a : ordinal.{u}}
+
 instance : topological_space ordinal.{u} :=
 preorder.topology ordinal.{u}
 
 instance : order_topology ordinal.{u} :=
 ⟨rfl⟩
 
-theorem is_open_singleton_iff {o : ordinal} : is_open ({o} : set ordinal) ↔ ¬ is_limit o :=
+theorem is_open_singleton_iff : is_open ({a} : set ordinal) ↔ ¬ is_limit a :=
 begin
-  refine ⟨λ h ho, _, λ ho, _⟩,
-  { obtain ⟨a, b, hab, hab'⟩ := (mem_nhds_iff_exists_Ioo_subset'
-      ⟨0, ordinal.pos_iff_ne_zero.2 ho.1⟩ ⟨_, lt_succ_self o⟩).1 (h.mem_nhds rfl),
-    have hao := ho.2 a hab.1,
-    exact hao.ne (hab' ⟨lt_succ_self a, hao.trans hab.2⟩) },
-  { rcases zero_or_succ_or_limit o with rfl | ⟨a, ha⟩ | ho',
+  refine ⟨λ h ha, _, λ ha, _⟩,
+  { obtain ⟨b, c, hbc, hbc'⟩ := (mem_nhds_iff_exists_Ioo_subset'
+      ⟨0, ordinal.pos_iff_ne_zero.2 ha.1⟩ ⟨_, lt_succ a⟩).1 (h.mem_nhds rfl),
+    have hba := ha.2 b hbc.1,
+    exact hba.ne (hbc' ⟨lt_succ b, hba.trans hbc.2⟩) },
+  { rcases zero_or_succ_or_limit a with rfl | ⟨b, hb⟩ | ha',
     { convert is_open_gt' (1 : ordinal),
       ext,
       exact ordinal.lt_one_iff_zero.symm },
-    { convert @is_open_Ioo _ _ _ _ a (o + 1),
-      ext b,
-      refine ⟨λ hb, _, _⟩,
-      { rw set.mem_singleton_iff.1 hb,
-        refine ⟨_, lt_succ_self o⟩,
-        rw ha,
-        exact lt_succ_self a },
-      { rintro ⟨hb, hb'⟩,
-        apply le_antisymm (lt_succ.1 hb'),
-        rw ha,
-        exact ordinal.succ_le.2 hb } },
-    { exact (ho ho').elim } }
+    { convert @is_open_Ioo _ _ _ _ b (a + 1),
+      ext c,
+      refine ⟨λ hc, _, _⟩,
+      { rw set.mem_singleton_iff.1 hc,
+        refine ⟨_, lt_succ a⟩,
+        rw hb,
+        exact lt_succ b },
+      { rintro ⟨hc, hc'⟩,
+        apply le_antisymm (le_of_lt_succ hc'),
+        rw hb,
+        exact succ_le_of_lt hc } },
+    { exact (ha ha').elim } }
 end
 
-theorem is_open_iff (s : set ordinal) :
-  is_open s ↔ (∀ o ∈ s, is_limit o → ∃ a < o, set.Ioo a o ⊆ s) :=
+theorem is_open_iff : is_open s ↔ ∀ o ∈ s, is_limit o → ∃ a < o, set.Ioo a o ⊆ s :=
 begin
   classical,
   refine ⟨_, λ h, _⟩,
@@ -95,7 +99,7 @@ begin
     ext o,
     refine ⟨λ ho, set.mem_Union.2 ⟨⟨o, ho⟩, _⟩, _⟩,
     { split_ifs with ho',
-      { refine ⟨_, lt_succ_self o⟩,
+      { refine ⟨_, lt_succ o⟩,
         cases classical.some_spec (h o ho ho') with H,
         exact H },
       { exact set.mem_singleton o } },
@@ -104,20 +108,19 @@ begin
       split_ifs at ht with ha;
       subst ht,
       { cases classical.some_spec (h a.val a.prop ha) with H has,
-        rcases lt_or_eq_of_le (lt_succ.1 hoa.2) with hoa' | rfl,
+        rcases lt_or_eq_of_le (le_of_lt_succ hoa.2) with hoa' | rfl,
         { exact has ⟨hoa.1, hoa'⟩ },
         { exact a.prop } },
       { convert a.prop } } }
 end
 
-theorem mem_closure_iff_sup {s : set ordinal.{u}} {a : ordinal.{u}} :
-  a ∈ closure s ↔ ∃ {ι : Type u} [nonempty ι] (f : ι → ordinal.{u}),
+theorem mem_closure_iff_sup : a ∈ closure s ↔ ∃ {ι : Type u} [nonempty ι] (f : ι → ordinal),
   (∀ i, f i ∈ s) ∧ sup.{u u} f = a :=
 begin
   refine mem_closure_iff.trans ⟨λ h, _, _⟩,
   { by_cases has : a ∈ s,
     { exact ⟨punit, by apply_instance, λ _, a, λ _, has, sup_const a⟩ },
-    { have H := λ b (hba : b < a), h _ (@is_open_Ioo _ _ _ _ b (a + 1)) ⟨hba, lt_succ_self a⟩,
+    { have H := λ b (hba : b < a), h _ (@is_open_Ioo _ _ _ _ b (a + 1)) ⟨hba, lt_succ a⟩,
       let f : a.out.α → ordinal := λ i, classical.some (H (typein (<) i) (typein_lt_self i)),
       have hf : ∀ i, f i ∈ set.Ioo (typein (<) i) (a + 1) ∩ s :=
         λ i, classical.some_spec (H _ _),
@@ -126,10 +129,10 @@ begin
         rw set.mem_singleton_iff.1 hb at *,
         exact (has hb').elim },
       refine ⟨_, out_nonempty_iff_ne_zero.2 (ordinal.pos_iff_ne_zero.1 ha₀), f,
-        λ i, (hf i).2, le_antisymm (sup_le (λ i, lt_succ.1 (hf i).1.2)) _⟩,
+        λ i, (hf i).2, le_antisymm (sup_le (λ i, le_of_lt_succ (hf i).1.2)) _⟩,
       by_contra' h,
       cases H _ h with b hb,
-      rcases eq_or_lt_of_le (lt_succ.1 hb.1.2) with rfl | hba,
+      rcases eq_or_lt_of_le (le_of_lt_succ hb.1.2) with rfl | hba,
       { exact has hb.2 },
       { have : b < f (enum (<) b (by rwa type_lt)) := begin
           have := (hf (enum (<) b (by rwa type_lt))).1.1,
@@ -143,19 +146,19 @@ begin
       use [0, hat],
       convert hf i,
       exact (sup_eq_zero_iff.1 ha₀ i).symm },
-    rcases (mem_nhds_iff_exists_Ioo_subset' ⟨0, ha₀⟩ ⟨_, lt_succ_self _⟩).1 (ht.mem_nhds hat) with
+    rcases (mem_nhds_iff_exists_Ioo_subset' ⟨0, ha₀⟩ ⟨_, lt_succ _⟩).1 (ht.mem_nhds hat) with
       ⟨b, c, ⟨hab, hac⟩, hbct⟩,
     cases lt_sup.1 hab with i hi,
     exact ⟨_, hbct ⟨hi, (le_sup.{u u} f i).trans_lt hac⟩, hf i⟩ }
 end
 
-theorem mem_closed_iff_sup {s : set ordinal.{u}} {a : ordinal.{u}} (hs : is_closed s) :
-  a ∈ s ↔ ∃ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal.{u}),
+theorem mem_closed_iff_sup (hs : is_closed s) :
+  a ∈ s ↔ ∃ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal),
   (∀ i, f i ∈ s) ∧ sup.{u u} f = a :=
 by rw [←mem_closure_iff_sup, hs.closure_eq]
 
-theorem mem_closure_iff_bsup {s : set ordinal.{u}} {a : ordinal.{u}} :
-  a ∈ closure s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal.{u}),
+theorem mem_closure_iff_bsup :
+  a ∈ closure s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
   (∀ i hi, f i hi ∈ s) ∧ bsup.{u u} o f = a :=
 mem_closure_iff_sup.trans ⟨
   λ ⟨ι, ⟨i⟩, f, hf, ha⟩, ⟨_, λ h, (type_eq_zero_iff_is_empty.1 h).elim i, bfamily_of_family f,
@@ -163,13 +166,13 @@ mem_closure_iff_sup.trans ⟨
   λ ⟨o, ho, f, hf, ha⟩, ⟨_, out_nonempty_iff_ne_zero.2 ho, family_of_bfamily o f,
     λ i, hf _ _, by rwa sup_eq_bsup⟩⟩
 
-theorem mem_closed_iff_bsup {s : set ordinal.{u}} {a : ordinal.{u}} (hs : is_closed s) :
-  a ∈ s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal.{u}),
+theorem mem_closed_iff_bsup (hs : is_closed s) :
+  a ∈ s ↔ ∃ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
   (∀ i hi, f i hi ∈ s) ∧ bsup.{u u} o f = a :=
 by rw [←mem_closure_iff_bsup, hs.closure_eq]
 
-theorem is_closed_iff_sup {s : set ordinal.{u}} :
-  is_closed s ↔ ∀ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal.{u}),
+theorem is_closed_iff_sup :
+  is_closed s ↔ ∀ {ι : Type u} (hι : nonempty ι) (f : ι → ordinal),
   (∀ i, f i ∈ s) → sup.{u u} f ∈ s :=
 begin
   use λ hs ι hι f hf, (mem_closed_iff_sup hs).2 ⟨ι, hι, f, hf, rfl⟩,
@@ -179,8 +182,8 @@ begin
   exact h hι f hf
 end
 
-theorem is_closed_iff_bsup {s : set ordinal.{u}} :
-  is_closed s ↔ ∀ {o : ordinal.{u}} (ho : o ≠ 0) (f : Π a < o, ordinal.{u}),
+theorem is_closed_iff_bsup :
+  is_closed s ↔ ∀ {o : ordinal} (ho : o ≠ 0) (f : Π a < o, ordinal),
   (∀ i hi, f i hi ∈ s) → bsup.{u u} o f ∈ s :=
 begin
   rw is_closed_iff_sup,
@@ -191,21 +194,20 @@ begin
     exact λ i hi, hf _ }
 end
 
-theorem is_limit_of_mem_frontier {s : set ordinal} {o : ordinal} (ho : o ∈ frontier s) :
-  is_limit o :=
+theorem is_limit_of_mem_frontier (ha : a ∈ frontier s) : is_limit a :=
 begin
-  simp only [frontier_eq_closure_inter_closure, set.mem_inter_iff, mem_closure_iff] at ho,
+  simp only [frontier_eq_closure_inter_closure, set.mem_inter_iff, mem_closure_iff] at ha,
   by_contra h,
   rw ←is_open_singleton_iff at h,
-  rcases ho.1 _ h rfl with ⟨a, ha, ha'⟩,
-  rcases ho.2 _ h rfl with ⟨b, hb, hb'⟩,
+  rcases ha.1 _ h rfl with ⟨b, hb, hb'⟩,
+  rcases ha.2 _ h rfl with ⟨c, hc, hc'⟩,
   rw set.mem_singleton_iff at *,
-  subst ha, subst hb,
-  exact hb' ha'
+  subst hb, subst hc,
+  exact hc' hb'
 end
 
 theorem is_normal_iff_strict_mono_and_continuous (f : ordinal.{u} → ordinal.{u}) :
-  is_normal f ↔ (strict_mono f ∧ continuous f) :=
+  is_normal f ↔ strict_mono f ∧ continuous f :=
 begin
   refine ⟨λ h, ⟨h.strict_mono, _⟩, _⟩,
   { rw continuous_def,
@@ -226,27 +228,27 @@ begin
       λ i, h _ (typein_lt_self i), sup_typein_limit ho.2⟩ }
 end
 
-theorem enum_ord_is_normal_iff_is_closed {S : set ordinal.{u}} (hS : S.unbounded (<)) :
-  is_normal (enum_ord S) ↔ is_closed S :=
+theorem enum_ord_is_normal_iff_is_closed (hs : s.unbounded (<)) :
+  is_normal (enum_ord s) ↔ is_closed s :=
 begin
-  have HS := enum_ord_strict_mono hS,
+  have Hs := enum_ord_strict_mono hs,
   refine ⟨λ h, is_closed_iff_sup.2 (λ ι hι f hf, _),
-    λ h, (is_normal_iff_strict_mono_limit _).2 ⟨HS, λ a ha o H, _⟩⟩,
-  { let g : ι → ordinal.{u} := λ i, (enum_ord_order_iso hS).symm ⟨_, hf i⟩,
-    suffices : enum_ord S (sup.{u u} g) = sup.{u u} f,
-    { rw ←this, exact enum_ord_mem hS _ },
-    rw is_normal.sup.{u u u} h g hι,
+    λ h, (is_normal_iff_strict_mono_limit _).2 ⟨Hs, λ a ha o H, _⟩⟩,
+  { let g : ι → ordinal.{u} := λ i, (enum_ord_order_iso hs).symm ⟨_, hf i⟩,
+    suffices : enum_ord s (sup.{u u} g) = sup.{u u} f,
+    { rw ←this, exact enum_ord_mem hs _ },
+    rw @is_normal.sup.{u u u} _ h ι g hι,
     congr, ext,
-    change ((enum_ord_order_iso hS) _).val = f x,
+    change ((enum_ord_order_iso hs) _).val = f x,
     rw order_iso.apply_symm_apply },
   { rw is_closed_iff_bsup at h,
-    suffices : enum_ord S a ≤ bsup.{u u} a (λ b < a, enum_ord S b), from this.trans (bsup_le H),
-    cases enum_ord_surjective hS _ (h ha.1 (λ b hb, enum_ord S b) (λ b hb, enum_ord_mem hS b))
+    suffices : enum_ord s a ≤ bsup.{u u} a (λ b < a, enum_ord s b), from this.trans (bsup_le H),
+    cases enum_ord_surjective hs _ (h ha.1 (λ b hb, enum_ord s b) (λ b hb, enum_ord_mem hs b))
       with b hb,
     rw ←hb,
-    apply HS.monotone,
+    apply Hs.monotone,
     by_contra' hba,
-    apply (HS (lt_succ_self b)).not_le,
+    apply (Hs (lt_succ b)).not_le,
     rw hb,
     exact le_bsup.{u u} _ _ (ha.2 _ hba) }
 end
diff --git a/src/set_theory/surreal/basic.lean b/src/set_theory/surreal/basic.lean
index 8a2e6482a5bf2..fe2df6135ac01 100644
--- a/src/set_theory/surreal/basic.lean
+++ b/src/set_theory/surreal/basic.lean
@@ -3,11 +3,16 @@ Copyright (c) 2019 Mario Carneiro. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro, Scott Morrison
 -/
-import set_theory.game.pgame
+
+import algebra.order.hom.monoid
+import set_theory.game.ordinal
 
 /-!
 # Surreal numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The basic theory of surreal numbers, built on top of the theory of combinatorial (pre-)games.
 
 A pregame is `numeric` if all the Left options are strictly smaller than all the Right options, and
@@ -21,28 +26,38 @@ In fact, the surreals form a complete ordered field, containing a copy of the re
 besides!) but we do not yet have a complete development.
 
 ## Order properties
-Surreal numbers inherit the relations `≤` and `<` from games, and these relations satisfy the axioms
-of a partial order (recall that `x < y ↔ x ≤ y ∧ ¬ y ≤ x` did not hold for games).
+
+Surreal numbers inherit the relations `≤` and `<` from games (`surreal.has_le` and
+`surreal.has_lt`), and these relations satisfy the axioms of a partial order.
 
 ## Algebraic operations
+
 We show that the surreals form a linear ordered commutative group.
 
 One can also map all the ordinals into the surreals!
 
 ### Multiplication of surreal numbers
-The definition of multiplication for surreal numbers is surprisingly difficult and is currently
+
+The proof that multiplication lifts to surreal numbers is surprisingly difficult and is currently
 missing in the library. A sample proof can be found in Theorem 3.8 in the second reference below.
 The difficulty lies in the length of the proof and the number of theorems that need to proven
 simultaneously. This will make for a fun and challenging project.
 
+The branch `surreal_mul` contains some progress on this proof.
+
+### Todo
+
+- Define the field structure on the surreals.
+
 ## References
+
 * [Conway, *On numbers and games*][conway2001]
 * [Schleicher, Stoll, *An introduction to Conway's games and numbers*][schleicher_stoll]
 -/
 
 universes u
 
-local infix ` ≈ ` := pgame.equiv
+open_locale pgame
 
 namespace pgame
 
@@ -50,21 +65,29 @@ namespace pgame
 and all the elements of L and R are also numeric. -/
 def numeric : pgame → Prop
 | ⟨l, r, L, R⟩ :=
-  (∀ i j, L i < R j) ∧ (∀ i, numeric (L i)) ∧ (∀ i, numeric (R i))
+  (∀ i j, L i < R j) ∧ (∀ i, numeric (L i)) ∧ (∀ j, numeric (R j))
 
-lemma numeric_def (x : pgame) : numeric x ↔ (∀ i j, x.move_left i < x.move_right j) ∧
-  (∀ i, numeric (x.move_left i)) ∧ (∀ i, numeric (x.move_right i)) :=
+lemma numeric_def {x : pgame} : numeric x ↔ (∀ i j, x.move_left i < x.move_right j) ∧
+  (∀ i, numeric (x.move_left i)) ∧ (∀ j, numeric (x.move_right j)) :=
 by { cases x, refl }
 
-lemma numeric.left_lt_right {x : pgame} (o : numeric x) (i : x.left_moves) (j : x.right_moves) :
+namespace numeric
+
+lemma mk {x : pgame} (h₁ : ∀ i j, x.move_left i < x.move_right j)
+  (h₂ : ∀ i, numeric (x.move_left i)) (h₃ : ∀ j, numeric (x.move_right j)) : numeric x :=
+numeric_def.2 ⟨h₁, h₂, h₃⟩
+
+lemma left_lt_right {x : pgame} (o : numeric x) (i : x.left_moves) (j : x.right_moves) :
   x.move_left i < x.move_right j :=
-by { cases x with xl xr xL xR, exact o.1 i j }
-lemma numeric.move_left {x : pgame} (o : numeric x) (i : x.left_moves) :
+by { cases x, exact o.1 i j }
+lemma move_left {x : pgame} (o : numeric x) (i : x.left_moves) :
   numeric (x.move_left i) :=
-by { cases x with xl xr xL xR, exact o.2.1 i }
-lemma numeric.move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
+by { cases x, exact o.2.1 i }
+lemma move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
   numeric (x.move_right j) :=
-by { cases x with xl xr xL xR, exact o.2.2 j }
+by { cases x, exact o.2.2 j }
+
+end numeric
 
 @[elab_as_eliminator]
 theorem numeric_rec {C : pgame → Prop}
@@ -75,99 +98,121 @@ theorem numeric_rec {C : pgame → Prop}
 | ⟨l, r, L, R⟩ ⟨h, hl, hr⟩ :=
   H _ _ _ _ h hl hr (λ i, numeric_rec _ (hl i)) (λ i, numeric_rec _ (hr i))
 
-theorem lt_asymm {x y : pgame} (ox : numeric x) (oy : numeric y) : x < y → ¬ y < x :=
+theorem relabelling.numeric_imp {x y : pgame} (r : x ≡r y) (ox : numeric x) : numeric y :=
+begin
+  induction x using pgame.move_rec_on with x IHl IHr generalizing y,
+  apply numeric.mk (λ i j, _) (λ i, _) (λ j, _),
+  { rw ←lt_congr (r.move_left_symm i).equiv (r.move_right_symm j).equiv,
+    apply ox.left_lt_right },
+  { exact IHl _ (ox.move_left _) (r.move_left_symm i) },
+  { exact IHr _ (ox.move_right _) (r.move_right_symm j) }
+end
+
+/-- Relabellings preserve being numeric. -/
+theorem relabelling.numeric_congr {x y : pgame} (r : x ≡r y) : numeric x ↔ numeric y :=
+⟨r.numeric_imp, r.symm.numeric_imp⟩
+
+theorem lf_asymm {x y : pgame} (ox : numeric x) (oy : numeric y) : x ⧏ y → ¬ y ⧏ x :=
 begin
   refine numeric_rec (λ xl xr xL xR hx oxl oxr IHxl IHxr, _) x ox y oy,
   refine numeric_rec (λ yl yr yL yR hy oyl oyr IHyl IHyr, _),
-  rw [mk_lt_mk, mk_lt_mk], rintro (⟨i, h₁⟩ | ⟨j, h₁⟩) (⟨i, h₂⟩ | ⟨j, h₂⟩),
-  { exact IHxl _ _ (oyl _) (lt_of_le_mk h₁) (lt_of_le_mk h₂) },
-  { exact not_lt.2 (le_trans h₂ h₁) (hy _ _) },
-  { exact not_lt.2 (le_trans h₁ h₂) (hx _ _) },
-  { exact IHxr _ _ (oyr _) (lt_of_mk_le h₁) (lt_of_mk_le h₂) },
+  rw [mk_lf_mk, mk_lf_mk], rintro (⟨i, h₁⟩ | ⟨j, h₁⟩) (⟨i, h₂⟩ | ⟨j, h₂⟩),
+  { exact IHxl _ _ (oyl _) (h₁.move_left_lf _) (h₂.move_left_lf _) },
+  { exact (le_trans h₂ h₁).not_gf (lf_of_lt (hy _ _)) },
+  { exact (le_trans h₁ h₂).not_gf (lf_of_lt (hx _ _)) },
+  { exact IHxr _ _ (oyr _) (h₁.lf_move_right _) (h₂.lf_move_right _) },
 end
 
-theorem le_of_lt {x y : pgame} (ox : numeric x) (oy : numeric y) (h : x < y) : x ≤ y :=
-not_lt.1 (lt_asymm ox oy h)
+theorem le_of_lf {x y : pgame} (h : x ⧏ y) (ox : numeric x) (oy : numeric y) : x ≤ y :=
+not_lf.1 (lf_asymm ox oy h)
 
-/-- `<` is transitive when both sides of the left inequality are numeric -/
-theorem lt_trans {x y z : pgame} (ox : numeric x) (oy : numeric y) (h₁ : x < y)
-  (h₂ : y < z) : x < z :=
-lt_of_le_of_lt (le_of_lt ox oy h₁) h₂
+alias le_of_lf ← lf.le
 
-/-- `<` is transitive when both sides of the right inequality are numeric -/
-theorem lt_trans' {x y z : pgame} (oy : numeric y) (oz : numeric z) (h₁ : x < y)
-  (h₂ : y < z) : x < z :=
-lt_of_lt_of_le h₁ (le_of_lt oy oz h₂)
+theorem lt_of_lf {x y : pgame} (h : x ⧏ y) (ox : numeric x) (oy : numeric y) : x < y :=
+(lt_or_fuzzy_of_lf h).resolve_right (not_fuzzy_of_le (h.le ox oy))
 
-/-- On numeric pre-games, `<` and `≤` satisfy the axioms of a partial order (even though they
-don't on all pre-games). -/
-theorem lt_iff_le_not_le {x y : pgame} (ox : numeric x) (oy : numeric y) :
-  x < y ↔ x ≤ y ∧ ¬ y ≤ x :=
-⟨λ h, ⟨le_of_lt ox oy h, not_le.2 h⟩, λ h, not_le.1 h.2⟩
+alias lt_of_lf ← lf.lt
 
-theorem numeric_zero : numeric 0 :=
-⟨by rintros ⟨⟩ ⟨⟩, ⟨by rintros ⟨⟩, by rintros ⟨⟩⟩⟩
-theorem numeric_one : numeric 1 :=
-⟨by rintros ⟨⟩ ⟨⟩, ⟨λ x, numeric_zero, by rintros ⟨⟩⟩⟩
+theorem lf_iff_lt {x y : pgame} (ox : numeric x) (oy : numeric y) : x ⧏ y ↔ x < y :=
+⟨λ h, h.lt ox oy, lf_of_lt⟩
 
-theorem numeric.neg : Π {x : pgame} (o : numeric x), numeric (-x)
-| ⟨l, r, L, R⟩ o := ⟨λ j i, lt_iff_neg_gt.1 (o.1 i j), λ j, (o.2.2 j).neg, λ i, (o.2.1 i).neg⟩
+/-- Definition of `x ≤ y` on numeric pre-games, in terms of `<` -/
+theorem le_iff_forall_lt {x y : pgame} (ox : x.numeric) (oy : y.numeric) :
+  x ≤ y ↔ (∀ i, x.move_left i < y) ∧ ∀ j, x < y.move_right j :=
+begin
+  refine le_iff_forall_lf.trans (and_congr _ _);
+  refine forall_congr (λ i, lf_iff_lt _ _);
+  apply_rules [numeric.move_left, numeric.move_right]
+end
 
-/-- For the `<` version, see `pgame.move_left_lt`. -/
-theorem numeric.move_left_le {x : pgame} (o : numeric x) (i : x.left_moves) :
-  x.move_left i ≤ x :=
-le_of_lt (o.move_left i) o (pgame.move_left_lt i)
+/-- Definition of `x < y` on numeric pre-games, in terms of `≤` -/
+theorem lt_iff_exists_le {x y : pgame} (ox : x.numeric) (oy : y.numeric) :
+  x < y ↔ (∃ i, x ≤ y.move_left i) ∨ ∃ j, x.move_right j ≤ y :=
+by rw [←lf_iff_lt ox oy, lf_iff_exists_le]
 
-/-- For the `<` version, see `pgame.lt_move_right`. -/
-theorem numeric.le_move_right {x : pgame} (o : numeric x) (j : x.right_moves) :
-  x ≤ x.move_right j :=
-le_of_lt o (o.move_right j) (pgame.lt_move_right j)
+theorem lt_of_exists_le {x y : pgame} (ox : x.numeric) (oy : y.numeric) :
+  ((∃ i, x ≤ y.move_left i) ∨ ∃ j, x.move_right j ≤ y) → x < y :=
+(lt_iff_exists_le ox oy).2
 
-theorem add_lt_add
-  {w x y z : pgame.{u}} (oy : numeric y) (oz : numeric z)
-  (hwx : w < x) (hyz : y < z) : w + y < x + z :=
+/-- The definition of `x < y` on numeric pre-games, in terms of `<` two moves later. -/
+theorem lt_def {x y : pgame} (ox : x.numeric) (oy : y.numeric) : x < y ↔
+  (∃ i, (∀ i', x.move_left i' < y.move_left i)  ∧ ∀ j, x < (y.move_left i).move_right j) ∨
+   ∃ j, (∀ i, (x.move_right j).move_left i < y) ∧ ∀ j', x.move_right j < y.move_right j' :=
 begin
-  rw lt_def_le at *,
-  rcases hwx with ⟨ix, hix⟩|⟨jw, hjw⟩;
-  rcases hyz with ⟨iz, hiz⟩|⟨jy, hjy⟩,
-  { left,
-    use (left_moves_add x z).symm (sum.inl ix),
-    simp only [add_move_left_inl],
-    calc w + y ≤ move_left x ix + y : add_le_add_right hix _
-            ... ≤ move_left x ix + move_left z iz : add_le_add_left hiz _
-            ... ≤ move_left x ix + z : add_le_add_left (oz.move_left_le iz) _ },
-  { left,
-    use (left_moves_add x z).symm (sum.inl ix),
-    simp only [add_move_left_inl],
-    calc w + y ≤ move_left x ix + y : add_le_add_right hix _
-            ... ≤ move_left x ix + move_right y jy : add_le_add_left (oy.le_move_right jy) _
-            ... ≤ move_left x ix + z : add_le_add_left hjy _ },
-  { right,
-    use (right_moves_add w y).symm (sum.inl jw),
-    simp only [add_move_right_inl],
-    calc move_right w jw + y ≤ x + y : add_le_add_right hjw _
-            ... ≤ x + move_left z iz : add_le_add_left hiz _
-            ... ≤ x + z : add_le_add_left (oz.move_left_le iz) _ },
-  { right,
-    use (right_moves_add w y).symm (sum.inl jw),
-    simp only [add_move_right_inl],
-    calc move_right w jw + y ≤ x + y : add_le_add_right hjw _
-            ... ≤ x + move_right y jy : add_le_add_left (oy.le_move_right jy) _
-            ... ≤ x + z : add_le_add_left hjy _ },
+  rw [←lf_iff_lt ox oy, lf_def],
+  refine or_congr _ _;
+    refine exists_congr (λ x_1, _);
+    refine and_congr _ _;
+    refine (forall_congr $ λ i, lf_iff_lt _ _);
+    apply_rules [numeric.move_left, numeric.move_right]
 end
 
-theorem numeric.add : Π {x y : pgame} (ox : numeric x) (oy : numeric y), numeric (x + y)
+theorem not_fuzzy {x y : pgame} (ox : numeric x) (oy : numeric y) : ¬ fuzzy x y :=
+λ h, not_lf.2 ((lf_of_fuzzy h).le ox oy) h.2
+
+theorem lt_or_equiv_or_gt {x y : pgame} (ox : numeric x) (oy : numeric y) : x < y ∨ x ≈ y ∨ y < x :=
+(lf_or_equiv_or_gf x y).imp (λ h, h.lt ox oy) $ or.imp_right $ λ h, h.lt oy ox
+
+theorem numeric_of_is_empty (x : pgame) [is_empty x.left_moves] [is_empty x.right_moves] :
+  numeric x :=
+numeric.mk is_empty_elim is_empty_elim is_empty_elim
+
+theorem numeric_of_is_empty_left_moves (x : pgame) [is_empty x.left_moves] :
+  (∀ j, numeric (x.move_right j)) → numeric x :=
+numeric.mk is_empty_elim is_empty_elim
+
+theorem numeric_of_is_empty_right_moves (x : pgame) [is_empty x.right_moves]
+  (H : ∀ i, numeric (x.move_left i)) : numeric x :=
+numeric.mk (λ _, is_empty_elim) H is_empty_elim
+
+theorem numeric_zero : numeric 0 := numeric_of_is_empty 0
+theorem numeric_one : numeric 1 := numeric_of_is_empty_right_moves 1 $ λ _, numeric_zero
+
+theorem numeric.neg : Π {x : pgame} (o : numeric x), numeric (-x)
+| ⟨l, r, L, R⟩ o := ⟨λ j i, neg_lt_neg_iff.2 (o.1 i j), λ j, (o.2.2 j).neg, λ i, (o.2.1 i).neg⟩
+
+namespace numeric
+
+theorem move_left_lt {x : pgame} (o : numeric x) (i) : x.move_left i < x :=
+(move_left_lf i).lt (o.move_left i) o
+theorem move_left_le {x : pgame} (o : numeric x) (i) : x.move_left i ≤ x :=
+(o.move_left_lt i).le
+
+theorem lt_move_right {x : pgame} (o : numeric x) (j) : x < x.move_right j :=
+(lf_move_right j).lt o (o.move_right j)
+theorem le_move_right {x : pgame} (o : numeric x) (j) : x ≤ x.move_right j :=
+(o.lt_move_right j).le
+
+theorem add : Π {x y : pgame} (ox : numeric x) (oy : numeric y), numeric (x + y)
 | ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ox oy :=
 ⟨begin
    rintros (ix|iy) (jx|jy),
-   { show xL ix + ⟨yl, yr, yL, yR⟩ < xR jx + ⟨yl, yr, yL, yR⟩,
-     exact add_lt_add_right (ox.1 ix jx) _ },
-   { show xL ix + ⟨yl, yr, yL, yR⟩ < ⟨xl, xr, xL, xR⟩ + yR jy,
-     exact add_lt_add oy (oy.move_right jy) (pgame.lt_mk ix) (pgame.mk_lt jy), },
-   { -- show ⟨xl, xr, xL, xR⟩ + yL iy < xR jx + ⟨yl, yr, yL, yR⟩, -- fails?
-     exact add_lt_add (oy.move_left iy) oy (pgame.mk_lt jx) (pgame.lt_mk iy), },
-   { -- show ⟨xl, xr, xL, xR⟩ + yL iy < ⟨xl, xr, xL, xR⟩ + yR jy, -- fails?
-     exact @add_lt_add_left pgame _ _ _ _ _ (oy.1 iy jy) ⟨xl, xr, xL, xR⟩ }
+   { exact add_lt_add_right (ox.1 ix jx) _ },
+   { exact (add_lf_add_of_lf_of_le (lf_mk _ _ ix) (oy.le_move_right jy)).lt
+     ((ox.move_left ix).add oy) (ox.add (oy.move_right jy)) },
+   { exact (add_lf_add_of_lf_of_le (mk_lf _ _ jx) (oy.move_left_le iy)).lt
+      (ox.add (oy.move_left iy)) ((ox.move_right jx).add oy) },
+   { exact add_lt_add_left (oy.1 iy jy) ⟨xl, xr, xL, xR⟩ }
  end,
  begin
    split,
@@ -180,81 +225,39 @@ theorem numeric.add : Π {x y : pgame} (ox : numeric x) (oy : numeric y), numeri
  end⟩
 using_well_founded { dec_tac := pgame_wf_tac }
 
-lemma numeric.sub {x y : pgame} (ox : numeric x) (oy : numeric y) : numeric (x - y) := ox.add oy.neg
+lemma sub {x y : pgame} (ox : numeric x) (oy : numeric y) : numeric (x - y) := ox.add oy.neg
+
+end numeric
 
 /-- Pre-games defined by natural numbers are numeric. -/
 theorem numeric_nat : Π (n : ℕ), numeric n
 | 0 := numeric_zero
 | (n + 1) := (numeric_nat n).add numeric_one
 
-/-- The pre-game `half` is numeric. -/
-theorem numeric_half : numeric half :=
+/-- Ordinal games are numeric. -/
+theorem numeric_to_pgame (o : ordinal) : o.to_pgame.numeric :=
 begin
-  split,
-  { rintros ⟨ ⟩ ⟨ ⟩,
-    exact zero_lt_one },
-  split; rintro ⟨ ⟩,
-  { exact numeric_zero },
-  { exact numeric_one }
-end
-
-theorem half_add_half_equiv_one : half + half ≈ 1 :=
-begin
-  split; rw le_def; split,
-  { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩),
-    { right,
-      use (sum.inr punit.star),
-      calc ((half + half).move_left (sum.inl punit.star)).move_right (sum.inr punit.star)
-          = (half.move_left punit.star + half).move_right (sum.inr punit.star) : by fsplit
-      ... = (0 + half).move_right (sum.inr punit.star) : by fsplit
-      ... ≈ 1 : zero_add_equiv 1
-      ... ≤ 1 : pgame.le_refl 1 },
-    { right,
-      use (sum.inl punit.star),
-      calc ((half + half).move_left (sum.inr punit.star)).move_right (sum.inl punit.star)
-          = (half + half.move_left punit.star).move_right (sum.inl punit.star) : by fsplit
-      ... = (half + 0).move_right (sum.inl punit.star) : by fsplit
-      ... ≈ 1 : add_zero_equiv 1
-      ... ≤ 1 : pgame.le_refl 1 } },
-  { rintro ⟨ ⟩ },
-  { rintro ⟨ ⟩,
-    left,
-    use (sum.inl punit.star),
-    calc 0 ≤ half : le_of_lt numeric_zero numeric_half pgame.zero_lt_half
-    ... ≈ 0 + half : (zero_add_equiv half).symm
-    ... = (half + half).move_left (sum.inl punit.star) : by fsplit },
-  { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩); left,
-    { exact ⟨sum.inr punit.star, le_of_le_of_equiv (pgame.le_refl _) (add_zero_equiv _).symm⟩ },
-    { exact ⟨sum.inl punit.star, le_of_le_of_equiv (pgame.le_refl _) (zero_add_equiv _).symm⟩ } }
+  induction o using ordinal.induction with o IH,
+  apply numeric_of_is_empty_right_moves,
+  simpa using λ i, IH _ (ordinal.to_left_moves_to_pgame_symm_lt i)
 end
 
 end pgame
 
-/-- The equivalence on numeric pre-games. -/
-def surreal.equiv (x y : {x // pgame.numeric x}) : Prop := x.1.equiv y.1
-
-instance surreal.setoid : setoid {x // pgame.numeric x} :=
-⟨λ x y, x.1.equiv y.1,
- λ x, pgame.equiv_refl _,
- λ x y, pgame.equiv_symm,
- λ x y z, pgame.equiv_trans⟩
+open pgame
 
 /-- The type of surreal numbers. These are the numeric pre-games quotiented
 by the equivalence relation `x ≈ y ↔ x ≤ y ∧ y ≤ x`. In the quotient,
 the order becomes a total order. -/
-def surreal := quotient surreal.setoid
+def surreal := quotient (subtype.setoid numeric)
 
 namespace surreal
-open pgame
 
 /-- Construct a surreal number from a numeric pre-game. -/
-def mk (x : pgame) (h : x.numeric) : surreal := quotient.mk ⟨x, h⟩
-
-instance : has_zero surreal :=
-{ zero := ⟦⟨0, numeric_zero⟩⟧ }
-instance : has_one surreal :=
-{ one := ⟦⟨1, numeric_one⟩⟧ }
+def mk (x : pgame) (h : x.numeric) : surreal := ⟦⟨x, h⟩⟧
 
+instance : has_zero surreal := ⟨mk 0 numeric_zero⟩
+instance : has_one surreal := ⟨mk 1 numeric_one⟩
 instance : inhabited surreal := ⟨0⟩
 
 /-- Lift an equivalence-respecting function on pre-games to surreals. -/
@@ -266,8 +269,8 @@ quotient.lift (λ x : {x // numeric x}, f x.1 x.2) (λ x y, H x.2 y.2)
 def lift₂ {α} (f : ∀ x y, numeric x → numeric y → α)
   (H : ∀ {x₁ y₁ x₂ y₂} (ox₁ : numeric x₁) (oy₁ : numeric y₁) (ox₂ : numeric x₂) (oy₂ : numeric y₂),
     x₁.equiv x₂ → y₁.equiv y₂ → f x₁ y₁ ox₁ oy₁ = f x₂ y₂ ox₂ oy₂) : surreal → surreal → α :=
-lift (λ x ox, lift (λ y oy, f x y ox oy) (λ y₁ y₂ oy₁ oy₂ h, H _ _ _ _ (equiv_refl _) h))
-  (λ x₁ x₂ ox₁ ox₂ h, funext $ quotient.ind $ by exact λ ⟨y, oy⟩, H _ _ _ _ h (equiv_refl _))
+lift (λ x ox, lift (λ y oy, f x y ox oy) (λ y₁ y₂ oy₁ oy₂, H _ _ _ _ equiv_rfl))
+  (λ x₁ x₂ ox₁ ox₂ h, funext $ quotient.ind $ by exact λ ⟨y, oy⟩, H _ _ _ _ h equiv_rfl)
 
 instance : has_le surreal :=
 ⟨lift₂ (λ x y _ _, x ≤ y) (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, propext (le_congr hx hy))⟩
@@ -280,41 +283,89 @@ the sum of `x = {xL | xR}` and `y = {yL | yR}` is `{xL + y, x + yL | xR + y, x +
 instance : has_add surreal  :=
 ⟨surreal.lift₂
   (λ (x y : pgame) (ox) (oy), ⟦⟨x + y, ox.add oy⟩⟧)
-  (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, quotient.sound (pgame.add_congr hx hy))⟩
+  (λ x₁ y₁ x₂ y₂ _ _ _ _ hx hy, quotient.sound (add_congr hx hy))⟩
 
 /-- Negation for surreal numbers is inherited from pre-game negation:
 the negation of `{L | R}` is `{-R | -L}`. -/
 instance : has_neg surreal  :=
 ⟨surreal.lift
   (λ x ox, ⟦⟨-x, ox.neg⟩⟧)
-  (λ _ _ _ _ a, quotient.sound (pgame.neg_congr a))⟩
+  (λ _ _ _ _ a, quotient.sound (neg_equiv_neg_iff.2 a))⟩
 
 instance : ordered_add_comm_group surreal :=
 { add               := (+),
   add_assoc         := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, exact quotient.sound add_assoc_equiv },
   zero              := 0,
-  zero_add          := by { rintros ⟨_⟩, exact quotient.sound (pgame.zero_add_equiv a) },
-  add_zero          := by { rintros ⟨_⟩, exact quotient.sound (pgame.add_zero_equiv a) },
+  zero_add          := by { rintros ⟨_⟩, exact quotient.sound (zero_add_equiv a) },
+  add_zero          := by { rintros ⟨_⟩, exact quotient.sound (add_zero_equiv a) },
   neg               := has_neg.neg,
-  add_left_neg      := by { rintros ⟨_⟩, exact quotient.sound (pgame.add_left_neg_equiv a) },
-  add_comm          := by { rintros ⟨_⟩ ⟨_⟩, exact quotient.sound pgame.add_comm_equiv },
+  add_left_neg      := by { rintros ⟨_⟩, exact quotient.sound (add_left_neg_equiv a) },
+  add_comm          := by { rintros ⟨_⟩ ⟨_⟩, exact quotient.sound add_comm_equiv },
   le                := (≤),
   lt                := (<),
-  le_refl           := by { rintros ⟨_⟩, refl },
-  le_trans          := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, exact pgame.le_trans },
-  lt_iff_le_not_le  := by { rintros ⟨_, ox⟩ ⟨_, oy⟩, exact pgame.lt_iff_le_not_le ox oy },
+  le_refl           := by { rintros ⟨_⟩, apply @le_rfl pgame },
+  le_trans          := by { rintros ⟨_⟩ ⟨_⟩ ⟨_⟩, apply @le_trans pgame },
+  lt_iff_le_not_le  := by { rintros ⟨_, ox⟩ ⟨_, oy⟩, apply @lt_iff_le_not_le pgame },
   le_antisymm       := by { rintros ⟨_⟩ ⟨_⟩ h₁ h₂, exact quotient.sound ⟨h₁, h₂⟩ },
   add_le_add_left   := by { rintros ⟨_⟩ ⟨_⟩ hx ⟨_⟩, exact @add_le_add_left pgame _ _ _ _ _ hx _ } }
 
 noncomputable instance : linear_ordered_add_comm_group surreal :=
 { le_total := by rintro ⟨⟨x, ox⟩⟩ ⟨⟨y, oy⟩⟩; classical; exact
-    or_iff_not_imp_left.2 (λ h, le_of_lt oy ox (pgame.not_le.1 h)),
+    or_iff_not_imp_left.2 (λ h, (pgame.not_le.1 h).le oy ox),
   decidable_le := classical.dec_rel _,
   ..surreal.ordered_add_comm_group }
 
--- We conclude with some ideas for further work on surreals; these would make fun projects.
+instance : add_monoid_with_one surreal := add_monoid_with_one.unary
+
+/-- Casts a `surreal` number into a `game`. -/
+def to_game : surreal →+o game :=
+{ to_fun := lift (λ x _, ⟦x⟧) (λ x y ox oy, quot.sound),
+  map_zero' := rfl,
+  map_add' := by { rintros ⟨_, _⟩ ⟨_, _⟩, refl },
+  monotone' := by { rintros ⟨_, _⟩ ⟨_, _⟩, exact id } }
 
--- TODO define the inclusion of groups `surreal → game`
--- TODO define the field structure on the surreals
+theorem zero_to_game : to_game 0 = 0 := rfl
+@[simp] theorem one_to_game : to_game 1 = 1 := rfl
+@[simp] theorem nat_to_game : ∀ n : ℕ, to_game n = n := map_nat_cast' _ one_to_game
+
+theorem upper_bound_numeric {ι : Type u} {f : ι → pgame.{u}} (H : ∀ i, (f i).numeric) :
+  (upper_bound f).numeric :=
+numeric_of_is_empty_right_moves _ $ λ i, (H _).move_left _
+
+theorem lower_bound_numeric {ι : Type u} {f : ι → pgame.{u}} (H : ∀ i, (f i).numeric) :
+  (lower_bound f).numeric :=
+numeric_of_is_empty_left_moves _ $ λ i, (H _).move_right _
+
+/-- A small set `s` of surreals is bounded above. -/
+lemma bdd_above_of_small (s : set surreal.{u}) [small.{u} s] : bdd_above s :=
+begin
+  let g := subtype.val ∘ quotient.out ∘ subtype.val ∘ (equiv_shrink s).symm,
+  refine ⟨mk (upper_bound g) (upper_bound_numeric $ λ i, subtype.prop _), λ i hi, _⟩,
+  rw ←quotient.out_eq i,
+  show i.out.1 ≤ _,
+  simpa [g] using le_upper_bound g (equiv_shrink s ⟨i, hi⟩)
+end
+
+/-- A small set `s` of surreals is bounded below. -/
+lemma bdd_below_of_small (s : set surreal.{u}) [small.{u} s] : bdd_below s :=
+begin
+  let g := subtype.val ∘ quotient.out ∘ subtype.val ∘ (equiv_shrink s).symm,
+  refine ⟨mk (lower_bound g) (lower_bound_numeric $ λ i, subtype.prop _), λ i hi, _⟩,
+  rw ←quotient.out_eq i,
+  show _ ≤ i.out.1,
+  simpa [g] using lower_bound_le g (equiv_shrink s ⟨i, hi⟩)
+end
 
 end surreal
+
+open surreal
+
+namespace ordinal
+
+/-- Converts an ordinal into the corresponding surreal. -/
+noncomputable def to_surreal : ordinal ↪o surreal :=
+{ to_fun := λ o, mk _ (numeric_to_pgame o),
+  inj' := λ a b h, to_pgame_equiv_iff.1 (quotient.exact h),
+  map_rel_iff' := @to_pgame_le_iff }
+
+end ordinal
diff --git a/src/set_theory/surreal/dyadic.lean b/src/set_theory/surreal/dyadic.lean
index d41f8e1dbc31a..0f666a31e2705 100644
--- a/src/set_theory/surreal/dyadic.lean
+++ b/src/set_theory/surreal/dyadic.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Apurva Nakade
 -/
 import algebra.algebra.basic
-import ring_theory.localization.away
+import set_theory.game.birthday
 import set_theory.surreal.basic
+import ring_theory.localization.basic
 
 /-!
 # Dyadic numbers
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 Dyadic numbers are obtained by localizing ℤ away from 2. They are the initial object in the category
 of rings with no 2-torsion.
 
@@ -25,119 +29,118 @@ rational numbers to construct an ordered field embedding of ℝ into `surreal`.
 
 universes u
 
-local infix ` ≈ ` := pgame.equiv
+local infix (name := pgame.equiv) ` ≈ ` := pgame.equiv
 
 namespace pgame
 
 /-- For a natural number `n`, the pre-game `pow_half (n + 1)` is recursively defined as
-`{ 0 | pow_half n }`. These are the explicit expressions of powers of `half`. By definition, we have
- `pow_half 0 = 0` and `pow_half 1 = half` and we prove later on that
-`pow_half (n + 1) + pow_half (n + 1) ≈ pow_half n`.-/
+`{0 | pow_half n}`. These are the explicit expressions of powers of `1 / 2`. By definition, we have
+`pow_half 0 = 1` and `pow_half 1 ≈ 1 / 2` and we prove later on that
+`pow_half (n + 1) + pow_half (n + 1) ≈ pow_half n`. -/
 def pow_half : ℕ → pgame
-| 0       := mk punit pempty 0 pempty.elim
-| (n + 1) := mk punit punit 0 (λ _, pow_half n)
+| 0       := 1
+| (n + 1) := ⟨punit, punit, 0, λ _, pow_half n⟩
 
-@[simp] lemma pow_half_left_moves {n} : (pow_half n).left_moves = punit :=
-by cases n; refl
+@[simp] lemma pow_half_zero : pow_half 0 = 1 := rfl
 
-@[simp] lemma pow_half_right_moves {n} : (pow_half (n + 1)).right_moves = punit :=
-rfl
+lemma pow_half_left_moves (n) : (pow_half n).left_moves = punit := by cases n; refl
+lemma pow_half_zero_right_moves : (pow_half 0).right_moves = pempty := rfl
+lemma pow_half_succ_right_moves (n) : (pow_half (n + 1)).right_moves = punit := rfl
 
-@[simp] lemma pow_half_move_left {n i} : (pow_half n).move_left i = 0 :=
+@[simp] lemma pow_half_move_left (n i) : (pow_half n).move_left i = 0 :=
 by cases n; cases i; refl
-
-@[simp] lemma pow_half_move_right {n i} : (pow_half (n + 1)).move_right i = pow_half n :=
+@[simp] lemma pow_half_succ_move_right (n i) : (pow_half (n + 1)).move_right i = pow_half n :=
 rfl
 
-lemma pow_half_move_left' (n) :
-  (pow_half n).move_left (equiv.cast (pow_half_left_moves.symm) punit.star) = 0 :=
-by simp only [eq_self_iff_true, pow_half_move_left]
+instance unique_pow_half_left_moves (n) : unique (pow_half n).left_moves :=
+by cases n; exact punit.unique
+instance is_empty_pow_half_zero_right_moves : is_empty (pow_half 0).right_moves :=
+pempty.is_empty
+instance unique_pow_half_succ_right_moves (n) : unique (pow_half (n + 1)).right_moves :=
+punit.unique
 
-lemma pow_half_move_right' (n) :
-  (pow_half (n + 1)).move_right (equiv.cast (pow_half_right_moves.symm) punit.star) = pow_half n :=
-by simp only [pow_half_move_right, eq_self_iff_true]
+@[simp] theorem birthday_half : birthday (pow_half 1) = 2 :=
+by { rw birthday_def, dsimp, simpa using order.le_succ (1 : ordinal) }
 
 /-- For all natural numbers `n`, the pre-games `pow_half n` are numeric. -/
-theorem numeric_pow_half {n} : (pow_half n).numeric :=
+theorem numeric_pow_half (n) : (pow_half n).numeric :=
 begin
   induction n with n hn,
   { exact numeric_one },
   { split,
-    { rintro ⟨ ⟩ ⟨ ⟩,
-      dsimp only [pi.zero_apply],
-      rw ← pow_half_move_left' n,
-      apply pgame.move_left_lt },
+    { simpa using hn.move_left_lt default },
     { exact ⟨λ _, numeric_zero, λ _, hn⟩ } }
 end
 
-theorem pow_half_succ_lt_pow_half {n : ℕ} : pow_half (n + 1) < pow_half n :=
-pgame.lt_move_right punit.star
+theorem pow_half_succ_lt_pow_half (n : ℕ) : pow_half (n + 1) < pow_half n :=
+(numeric_pow_half (n + 1)).lt_move_right default
+
+theorem pow_half_succ_le_pow_half (n : ℕ) : pow_half (n + 1) ≤ pow_half n :=
+(pow_half_succ_lt_pow_half n).le
+
+theorem pow_half_le_one (n : ℕ) : pow_half n ≤ 1 :=
+begin
+  induction n with n hn,
+  { exact le_rfl },
+  { exact (pow_half_succ_le_pow_half n).trans hn }
+end
 
-theorem pow_half_succ_le_pow_half {n : ℕ} : pow_half (n + 1) ≤ pow_half n :=
-le_of_lt numeric_pow_half numeric_pow_half pow_half_succ_lt_pow_half
+theorem pow_half_succ_lt_one (n : ℕ) : pow_half (n + 1) < 1 :=
+(pow_half_succ_lt_pow_half n).trans_le $ pow_half_le_one n
 
-theorem zero_lt_pow_half {n : ℕ} : 0 < pow_half n :=
-by cases n; rw lt_def_le; use ⟨punit.star, pgame.le_refl 0⟩
+theorem pow_half_pos (n : ℕ) : 0 < pow_half n :=
+by { rw [←lf_iff_lt numeric_zero (numeric_pow_half n), zero_lf_le], simp }
 
-theorem zero_le_pow_half {n : ℕ} : 0 ≤ pow_half n :=
-le_of_lt numeric_zero numeric_pow_half zero_lt_pow_half
+theorem zero_le_pow_half (n : ℕ) : 0 ≤ pow_half n :=
+(pow_half_pos n).le
 
-theorem add_pow_half_succ_self_eq_pow_half {n} : pow_half (n + 1) + pow_half (n + 1) ≈ pow_half n :=
+theorem add_pow_half_succ_self_eq_pow_half (n) : pow_half (n + 1) + pow_half (n + 1) ≈ pow_half n :=
 begin
-  induction n with n hn,
-  { exact half_add_half_equiv_one },
-  { split; rw le_def_lt; split,
-    { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩),
-      { calc 0 + pow_half (n.succ + 1) ≈ pow_half (n.succ + 1) : zero_add_equiv _
-                                   ... < pow_half n.succ       : pow_half_succ_lt_pow_half },
-      { calc pow_half (n.succ + 1) + 0 ≈ pow_half (n.succ + 1) : add_zero_equiv _
-                                   ... < pow_half n.succ       : pow_half_succ_lt_pow_half } },
-    { rintro ⟨ ⟩,
-      rw lt_def_le,
-      right,
-      use sum.inl punit.star,
-      calc pow_half (n.succ) + pow_half (n.succ + 1)
-          ≤ pow_half (n.succ) + pow_half (n.succ) : add_le_add_left pow_half_succ_le_pow_half _
-      ... ≈ pow_half n                            : hn },
-    { rintro ⟨ ⟩,
-      calc 0 ≈ 0 + 0                                        : (add_zero_equiv _).symm
-        ... ≤ pow_half (n.succ + 1) + 0                     : add_le_add_right zero_le_pow_half _
-        ... < pow_half (n.succ + 1) + pow_half (n.succ + 1) : add_lt_add_left zero_lt_pow_half _ },
-    { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩),
-      { calc pow_half n.succ
-            ≈ pow_half n.succ + 0                        : (add_zero_equiv _).symm
-        ... < pow_half (n.succ) + pow_half (n.succ + 1)  : add_lt_add_left zero_lt_pow_half _ },
-      { calc pow_half n.succ
-            ≈ 0 + pow_half n.succ                        : (zero_add_equiv _).symm
-        ... < pow_half (n.succ + 1) + pow_half (n.succ)  : add_lt_add_right zero_lt_pow_half _ } } }
+  induction n using nat.strong_induction_on with n hn,
+  { split; rw le_iff_forall_lf; split,
+    { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩); apply lf_of_lt,
+      { calc 0 + pow_half n.succ ≈ pow_half n.succ : zero_add_equiv _
+                             ... < pow_half n      : pow_half_succ_lt_pow_half n },
+      { calc pow_half n.succ + 0 ≈ pow_half n.succ : add_zero_equiv _
+                             ... < pow_half n      : pow_half_succ_lt_pow_half n } },
+    { cases n, { rintro ⟨ ⟩ },
+      rintro ⟨ ⟩,
+      apply lf_of_move_right_le,
+      swap, exact sum.inl default,
+      calc  pow_half n.succ + pow_half (n.succ + 1)
+          ≤ pow_half n.succ + pow_half n.succ : add_le_add_left (pow_half_succ_le_pow_half _) _
+      ... ≈ pow_half n                        : hn _ (nat.lt_succ_self n) },
+    { simp only [pow_half_move_left, forall_const],
+      apply lf_of_lt,
+      calc 0 ≈ 0 + 0                            : (add_zero_equiv 0).symm
+        ... ≤ pow_half n.succ + 0               : add_le_add_right (zero_le_pow_half _) _
+        ... < pow_half n.succ + pow_half n.succ : add_lt_add_left (pow_half_pos _) _ },
+    { rintro (⟨⟨ ⟩⟩ | ⟨⟨ ⟩⟩); apply lf_of_lt,
+      { calc pow_half n
+            ≈ pow_half n + 0               : (add_zero_equiv _).symm
+        ... < pow_half n + pow_half n.succ : add_lt_add_left (pow_half_pos _) _ },
+      { calc pow_half n
+            ≈ 0 + pow_half n               : (zero_add_equiv _).symm
+        ... < pow_half n.succ + pow_half n : add_lt_add_right (pow_half_pos _) _  } } }
 end
 
+theorem half_add_half_equiv_one : pow_half 1 + pow_half 1 ≈ 1 :=
+add_pow_half_succ_self_eq_pow_half 0
+
 end pgame
 
 namespace surreal
 open pgame
 
-/-- The surreal number `half`. -/
-def half : surreal := ⟦⟨pgame.half, pgame.numeric_half⟩⟧
-
 /-- Powers of the surreal number `half`. -/
-def pow_half (n : ℕ) : surreal := ⟦⟨pgame.pow_half n, pgame.numeric_pow_half⟩⟧
+def pow_half (n : ℕ) : surreal := ⟦⟨pgame.pow_half n, pgame.numeric_pow_half n⟩⟧
 
 @[simp] lemma pow_half_zero : pow_half 0 = 1 := rfl
 
-@[simp] lemma pow_half_one : pow_half 1 = half := rfl
+@[simp] lemma double_pow_half_succ_eq_pow_half (n : ℕ) : 2 • pow_half n.succ = pow_half n :=
+by { rw two_nsmul, exact quotient.sound (pgame.add_pow_half_succ_self_eq_pow_half n) }
 
-@[simp] theorem add_half_self_eq_one : half + half = 1 :=
-quotient.sound pgame.half_add_half_equiv_one
-
-lemma double_pow_half_succ_eq_pow_half (n : ℕ) : 2 • pow_half n.succ = pow_half n :=
-begin
-  rw two_nsmul,
-  apply quotient.sound,
-  exact pgame.add_pow_half_succ_self_eq_pow_half,
-end
-
-lemma nsmul_pow_two_pow_half (n : ℕ) : 2 ^ n • pow_half n = 1 :=
+@[simp] lemma nsmul_pow_two_pow_half (n : ℕ) : 2 ^ n • pow_half n = 1 :=
 begin
   induction n with n hn,
   { simp only [nsmul_one, pow_half_zero, nat.cast_one, pow_zero] },
@@ -145,14 +148,14 @@ begin
         mul_comm, pow_succ] }
 end
 
-lemma nsmul_pow_two_pow_half' (n k : ℕ) : 2 ^ n • pow_half (n + k) = pow_half k :=
+@[simp] lemma nsmul_pow_two_pow_half' (n k : ℕ) : 2 ^ n • pow_half (n + k) = pow_half k :=
 begin
   induction k with k hk,
   { simp only [add_zero, surreal.nsmul_pow_two_pow_half, nat.nat_zero_eq_zero, eq_self_iff_true,
                surreal.pow_half_zero] },
   { rw [← double_pow_half_succ_eq_pow_half (n + k), ← double_pow_half_succ_eq_pow_half k,
         smul_algebra_smul_comm] at hk,
-    rwa ← (zsmul_eq_zsmul_iff' two_ne_zero) }
+    rwa ← zsmul_eq_zsmul_iff' two_ne_zero }
 end
 
 lemma zsmul_pow_two_pow_half (m : ℤ) (n k : ℕ) :
@@ -161,7 +164,7 @@ begin
   rw mul_zsmul,
   congr,
   norm_cast,
-  exact nsmul_pow_two_pow_half' n k,
+  exact nsmul_pow_two_pow_half' n k
 end
 
 lemma dyadic_aux {m₁ m₂ : ℤ} {y₁ y₂ : ℕ} (h₂ : m₁ * (2 ^ y₁) = m₂ * (2 ^ y₂)) :
@@ -169,13 +172,14 @@ lemma dyadic_aux {m₁ m₂ : ℤ} {y₁ y₂ : ℕ} (h₂ : m₁ * (2 ^ y₁) =
 begin
   revert m₁ m₂,
   wlog h : y₁ ≤ y₂,
+  { intros m₁ m₂ aux, exact (this (le_of_not_le h) aux.symm).symm },
   intros m₁ m₂ h₂,
   obtain ⟨c, rfl⟩ := le_iff_exists_add.mp h,
   rw [add_comm, pow_add, ← mul_assoc, mul_eq_mul_right_iff] at h₂,
   cases h₂,
   { rw [h₂, add_comm, zsmul_pow_two_pow_half m₂ c y₁] },
   { have := nat.one_le_pow y₁ 2 nat.succ_pos',
-    linarith },
+    norm_cast at h₂, linarith },
 end
 
 /-- The additive monoid morphism `dyadic_map` sends ⟦⟨m, 2^n⟩⟧ to m • half ^ n. -/
@@ -185,7 +189,7 @@ def dyadic_map : localization.away (2 : ℤ) →+ surreal :=
   begin
     intros m₁ m₂ n₁ n₂ h₁,
     obtain ⟨⟨n₃, y₃, hn₃⟩, h₂⟩ := localization.r_iff_exists.mp h₁,
-    simp only [subtype.coe_mk, mul_eq_mul_right_iff] at h₂,
+    simp only [subtype.coe_mk, mul_eq_mul_left_iff] at h₂,
     cases h₂,
     { simp only,
       obtain ⟨a₁, ha₁⟩ := n₁.prop,
@@ -195,8 +199,8 @@ def dyadic_map : localization.away (2 : ℤ) →+ surreal :=
       have h₂ : 1 < (2 : ℤ).nat_abs, from one_lt_two,
       rw [hn₁, hn₂, submonoid.log_pow_int_eq_self h₂, submonoid.log_pow_int_eq_self h₂],
       apply dyadic_aux,
-      rwa [ha₁, ha₂] },
-    { have := nat.one_le_pow y₃ 2 nat.succ_pos',
+      rwa [ha₁, ha₂, mul_comm, mul_comm m₂] },
+    { have : (1 : ℤ) ≤ 2 ^ y₃ := by exact_mod_cast nat.one_le_pow y₃ 2 nat.succ_pos',
       linarith }
     end,
   map_zero' := localization.lift_on_zero _ _,
@@ -218,10 +222,7 @@ def dyadic_map : localization.away (2 : ℤ) →+ surreal :=
 @[simp] lemma dyadic_map_apply (m : ℤ) (p : submonoid.powers (2 : ℤ)) :
   dyadic_map (is_localization.mk' (localization (submonoid.powers 2)) m p) =
   m • pow_half (submonoid.log p) :=
-begin
-  rw ← localization.mk_eq_mk',
-  refl,
-end
+by { rw ← localization.mk_eq_mk', refl }
 
 @[simp] lemma dyadic_map_apply_pow (m : ℤ) (n : ℕ) :
   dyadic_map (is_localization.mk' (localization (submonoid.powers 2)) m (submonoid.pow 2 n)) =
diff --git a/src/set_theory/zfc.lean b/src/set_theory/zfc.lean
deleted file mode 100644
index 66acff2680d8a..0000000000000
--- a/src/set_theory/zfc.lean
+++ /dev/null
@@ -1,802 +0,0 @@
-/-
-Copyright (c) 2018 Mario Carneiro. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Mario Carneiro
--/
-import data.set.basic
-
-/-!
-# A model of ZFC
-
-In this file, we model Zermelo-Fraenkel set theory (+ Choice) using Lean's underlying type theory.
-We do this in four main steps:
-* Define pre-sets inductively.
-* Define extensional equivalence on pre-sets and give it a `setoid` instance.
-* Define ZFC sets by quotienting pre-sets by extensional equivalence.
-* Define classes as sets of ZFC sets.
-Then the rest is usual set theory.
-
-## The model
-
-* `pSet`: Pre-set. A pre-set is inductively defined by its indexing type and its members, which are
-  themselves pre-sets.
-* `Set`: ZFC set. Defined as `pSet` quotiented by `pSet.equiv`, the extensional equivalence.
-* `Class`: Class. Defined as `set Set`.
-* `Set.choice`: Axiom of choice. Proved from Lean's axiom of choice.
-
-## Other definitions
-
-* `arity α n`: `n`-ary function `α → α → ... → α`. Defined inductively.
-* `arity.const a n`: `n`-ary constant function equal to `a`.
-* `pSet.type`: Underlying type of a pre-set.
-* `pSet.func`: Underlying family of pre-sets of a pre-set.
-* `pSet.equiv`: Extensional equivalence of pre-sets. Defined inductively.
-* `pSet.omega`, `Set.omega`: The von Neumann ordinal `ω` as a `pSet`, as a `Set`.
-* `pSet.arity.equiv`: Extensional equivalence of `n`-ary `pSet`-valued functions. Extension of
-  `pSet.equiv`.
-* `pSet.resp`: Collection of `n`-ary `pSet`-valued functions that respect extensional equivalence.
-* `pSet.eval`: Turns a `pSet`-valued function that respect extensional equivalence into a
-  `Set`-valued function.
-* `classical.all_definable`: All functions are classically definable.
-* `Set.is_func` : Predicate that a ZFC set is a subset of `x × y` that can be considered as a ZFC
-  function `x → y`. That is, each member of `x` is related by the ZFC set to exactly one member of
-  `y`.
-* `Set.funs`: ZFC set of ZFC functions `x → y`.
-* `Class.iota`: Definite description operator.
-
-## Notes
-
-To avoid confusion between the Lean `set` and the ZFC `Set`, docstrings in this file refer to them
-respectively as "`set`" and "ZFC set".
-
-## TODO
-
-Prove `Set.map_definable_aux` computably.
--/
-
-universes u v
-
-/-- The type of `n`-ary functions `α → α → ... → α`. -/
-def arity (α : Type u) : ℕ → Type u
-| 0     := α
-| (n+1) := α → arity n
-
-namespace arity
-
-/-- Constant `n`-ary function with value `a`. -/
-def const {α : Type u} (a : α) : ∀ n, arity α n
-| 0     := a
-| (n+1) := λ _, const n
-
-instance arity.inhabited {α n} [inhabited α] : inhabited (arity α n) :=
-⟨const default _⟩
-
-end arity
-
-/-- The type of pre-sets in universe `u`. A pre-set
-  is a family of pre-sets indexed by a type in `Type u`.
-  The ZFC universe is defined as a quotient of this
-  to ensure extensionality. -/
-inductive pSet : Type (u+1)
-| mk (α : Type u) (A : α → pSet) : pSet
-
-namespace pSet
-
-/-- The underlying type of a pre-set -/
-@[nolint has_inhabited_instance] def type : pSet → Type u
-| ⟨α, A⟩ := α
-
-/-- The underlying pre-set family of a pre-set -/
-def func : Π (x : pSet), x.type → pSet
-| ⟨α, A⟩ := A
-
-theorem mk_type_func : Π (x : pSet), mk x.type x.func = x
-| ⟨α, A⟩ := rfl
-
-/-- Two pre-sets are extensionally equivalent if every element of the first family is extensionally
-equivalent to some element of the second family and vice-versa. -/
-def equiv (x y : pSet) : Prop :=
-pSet.rec (λ α z m ⟨β, B⟩, (∀ a, ∃ b, m a (B b)) ∧ (∀ b, ∃ a, m a (B b))) x y
-
-theorem equiv.refl (x) : equiv x x :=
-pSet.rec_on x $ λ α A IH, ⟨λ a, ⟨a, IH a⟩, λ a, ⟨a, IH a⟩⟩
-
-theorem equiv.rfl : ∀ {x}, equiv x x := equiv.refl
-
-theorem equiv.euc {x} : Π {y z}, equiv x y → equiv z y → equiv x z :=
-pSet.rec_on x $ λ α A IH y, pSet.cases_on y $ λ β B ⟨γ, Γ⟩ ⟨αβ, βα⟩ ⟨γβ, βγ⟩,
-⟨λ a, let ⟨b, ab⟩ := αβ a, ⟨c, bc⟩ := βγ b in ⟨c, IH a ab bc⟩,
-  λ c, let ⟨b, cb⟩ := γβ c, ⟨a, ba⟩ := βα b in ⟨a, IH a ba cb⟩⟩
-
-theorem equiv.symm {x y} : equiv x y → equiv y x :=
-(equiv.refl y).euc
-
-theorem equiv.trans {x y z} (h1 : equiv x y) (h2 : equiv y z) : equiv x z :=
-h1.euc h2.symm
-
-instance setoid : setoid pSet :=
-⟨pSet.equiv, equiv.refl, λ x y, equiv.symm, λ x y z, equiv.trans⟩
-
-/-- A pre-set is a subset of another pre-set if every element of the first family is extensionally
-equivalent to some element of the second family.-/
-protected def subset : pSet → pSet → Prop
-| ⟨α, A⟩ ⟨β, B⟩ := ∀ a, ∃ b, equiv (A a) (B b)
-
-instance : has_subset pSet := ⟨pSet.subset⟩
-
-theorem equiv.ext : Π (x y : pSet), equiv x y ↔ (x ⊆ y ∧ y ⊆ x)
-| ⟨α, A⟩ ⟨β, B⟩ :=
-  ⟨λ ⟨αβ, βα⟩, ⟨αβ, λ b, let ⟨a, h⟩ := βα b in ⟨a, equiv.symm h⟩⟩,
-    λ ⟨αβ, βα⟩, ⟨αβ, λ b, let ⟨a, h⟩ := βα b in ⟨a, equiv.symm h⟩⟩⟩
-
-theorem subset.congr_left : Π {x y z : pSet}, equiv x y → (x ⊆ z ↔ y ⊆ z)
-| ⟨α, A⟩ ⟨β, B⟩ ⟨γ, Γ⟩ ⟨αβ, βα⟩ :=
-  ⟨λ αγ b, let ⟨a, ba⟩ := βα b, ⟨c, ac⟩ := αγ a in ⟨c, (equiv.symm ba).trans ac⟩,
-    λ βγ a, let ⟨b, ab⟩ := αβ a, ⟨c, bc⟩ := βγ b in ⟨c, equiv.trans ab bc⟩⟩
-
-theorem subset.congr_right : Π {x y z : pSet}, equiv x y → (z ⊆ x ↔ z ⊆ y)
-| ⟨α, A⟩ ⟨β, B⟩ ⟨γ, Γ⟩ ⟨αβ, βα⟩ :=
-  ⟨λ γα c, let ⟨a, ca⟩ := γα c, ⟨b, ab⟩ := αβ a in ⟨b, ca.trans ab⟩,
-    λ γβ c, let ⟨b, cb⟩ := γβ c, ⟨a, ab⟩ := βα b in ⟨a, cb.trans (equiv.symm ab)⟩⟩
-
-/-- `x ∈ y` as pre-sets if `x` is extensionally equivalent to a member of the family `y`. -/
-def mem : pSet → pSet → Prop
-| x ⟨β, B⟩ := ∃ b, equiv x (B b)
-instance : has_mem pSet.{u} pSet.{u} := ⟨mem⟩
-
-theorem mem.mk {α: Type u} (A : α → pSet) (a : α) : A a ∈ mk α A :=
-⟨a, equiv.refl (A a)⟩
-
-theorem mem.ext : Π {x y : pSet.{u}}, (∀ w : pSet.{u}, w ∈ x ↔ w ∈ y) → equiv x y
-| ⟨α, A⟩ ⟨β, B⟩ h := ⟨λ a, (h (A a)).1 (mem.mk A a),
-    λ b, let ⟨a, ha⟩ := (h (B b)).2 (mem.mk B b) in ⟨a, ha.symm⟩⟩
-
-theorem mem.congr_right : Π {x y : pSet.{u}}, equiv x y → (∀ {w : pSet.{u}}, w ∈ x ↔ w ∈ y)
-| ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩ w :=
-  ⟨λ ⟨a, ha⟩, let ⟨b, hb⟩ := αβ a in ⟨b, ha.trans hb⟩,
-    λ ⟨b, hb⟩, let ⟨a, ha⟩ := βα b in ⟨a, hb.euc ha⟩⟩
-
-theorem equiv_iff_mem {x y : pSet.{u}} : equiv x y ↔ (∀ {w : pSet.{u}}, w ∈ x ↔ w ∈ y) :=
-⟨mem.congr_right, match x, y with
-| ⟨α, A⟩, ⟨β, B⟩, h := ⟨λ a, h.1 (mem.mk A a), λ b,
-  let ⟨a, h⟩ := h.2 (mem.mk B b) in ⟨a, h.symm⟩⟩
-end⟩
-
-theorem mem.congr_left : Π {x y : pSet.{u}}, equiv x y → (∀ {w : pSet.{u}}, x ∈ w ↔ y ∈ w)
-| x y h ⟨α, A⟩ := ⟨λ ⟨a, ha⟩, ⟨a, h.symm.trans ha⟩, λ ⟨a, ha⟩, ⟨a, h.trans ha⟩⟩
-
-/-- Convert a pre-set to a `set` of pre-sets. -/
-def to_set (u : pSet.{u}) : set pSet.{u} := {x | x ∈ u}
-
-/-- Two pre-sets are equivalent iff they have the same members. -/
-theorem equiv.eq {x y : pSet} : equiv x y ↔ to_set x = to_set y :=
-equiv_iff_mem.trans set.ext_iff.symm
-
-instance : has_coe pSet (set pSet) := ⟨to_set⟩
-
-/-- The empty pre-set -/
-protected def empty : pSet := ⟨ulift empty, λ e, match e with end⟩
-
-instance : has_emptyc pSet := ⟨pSet.empty⟩
-
-instance : inhabited pSet := ⟨∅⟩
-
-theorem mem_empty (x : pSet.{u}) : x ∉ (∅ : pSet.{u}) := λ e, match e with end
-
-/-- Insert an element into a pre-set -/
-protected def insert : pSet → pSet → pSet
-| u ⟨α, A⟩ := ⟨option α, λ o, option.rec u A o⟩
-
-instance : has_insert pSet pSet := ⟨pSet.insert⟩
-
-instance : has_singleton pSet pSet := ⟨λ s, insert s ∅⟩
-
-instance : is_lawful_singleton pSet pSet := ⟨λ _, rfl⟩
-
-/-- The n-th von Neumann ordinal -/
-def of_nat : ℕ → pSet
-| 0     := ∅
-| (n+1) := pSet.insert (of_nat n) (of_nat n)
-
-/-- The von Neumann ordinal ω -/
-def omega : pSet := ⟨ulift ℕ, λ n, of_nat n.down⟩
-
-/-- The pre-set separation operation `{x ∈ a | p x}` -/
-protected def sep (p : set pSet) : pSet → pSet
-| ⟨α, A⟩ := ⟨{a // p (A a)}, λ x, A x.1⟩
-
-instance : has_sep pSet pSet := ⟨pSet.sep⟩
-
-/-- The pre-set powerset operator -/
-def powerset : pSet → pSet
-| ⟨α, A⟩ := ⟨set α, λ p, ⟨{a // p a}, λ x, A x.1⟩⟩
-
-theorem mem_powerset : Π {x y : pSet}, y ∈ powerset x ↔ y ⊆ x
-| ⟨α, A⟩ ⟨β, B⟩ := ⟨λ ⟨p, e⟩, (subset.congr_left e).2 $ λ ⟨a, pa⟩, ⟨a, equiv.refl (A a)⟩,
-  λ βα, ⟨{a | ∃ b, equiv (B b) (A a)}, λ b, let ⟨a, ba⟩ := βα b in ⟨⟨a, b, ba⟩, ba⟩,
-    λ ⟨a, b, ba⟩, ⟨b, ba⟩⟩⟩
-
-/-- The pre-set union operator -/
-def Union : pSet → pSet
-| ⟨α, A⟩ := ⟨Σx, (A x).type, λ ⟨x, y⟩, (A x).func y⟩
-
-theorem mem_Union : Π {x y : pSet.{u}}, y ∈ Union x ↔ ∃ z : pSet.{u}, ∃ _ : z ∈ x, y ∈ z
-| ⟨α, A⟩ y :=
-  ⟨λ ⟨⟨a, c⟩, (e : equiv y ((A a).func c))⟩,
-    have func (A a) c ∈ mk (A a).type (A a).func, from mem.mk (A a).func c,
-    ⟨_, mem.mk _ _, (mem.congr_left e).2 (by rwa mk_type_func at this)⟩,
-  λ ⟨⟨β, B⟩, ⟨a, (e : equiv (mk β B) (A a))⟩, ⟨b, yb⟩⟩,
-    by { rw ←(mk_type_func (A a)) at e, exact
-    let ⟨βt, tβ⟩ := e, ⟨c, bc⟩ := βt b in ⟨⟨a, c⟩, yb.trans bc⟩ }⟩
-
-/-- The image of a function from pre-sets to pre-sets. -/
-def image (f : pSet.{u} → pSet.{u}) : pSet.{u} → pSet
-| ⟨α, A⟩ := ⟨α, λ a, f (A a)⟩
-
-theorem mem_image {f : pSet.{u} → pSet.{u}} (H : ∀ {x y}, equiv x y → equiv (f x) (f y)) :
-  Π {x y : pSet.{u}}, y ∈ image f x ↔ ∃ z ∈ x, equiv y (f z)
-| ⟨α, A⟩ y := ⟨λ ⟨a, ya⟩, ⟨A a, mem.mk A a, ya⟩, λ ⟨z, ⟨a, za⟩, yz⟩, ⟨a, yz.trans (H za)⟩⟩
-
-/-- Universe lift operation -/
-protected def lift : pSet.{u} → pSet.{max u v}
-| ⟨α, A⟩ := ⟨ulift α, λ ⟨x⟩, lift (A x)⟩
-
-/-- Embedding of one universe in another -/
-@[nolint check_univs] -- intended to be used with explicit universe parameters
-def embed : pSet.{max (u+1) v} := ⟨ulift.{v u+1} pSet, λ ⟨x⟩, pSet.lift.{u (max (u+1) v)} x⟩
-
-theorem lift_mem_embed : Π (x : pSet.{u}), pSet.lift.{u (max (u+1) v)} x ∈ embed.{u v} :=
-λ x, ⟨⟨x⟩, equiv.rfl⟩
-
-/-- Function equivalence is defined so that `f ~ g` iff `∀ x y, x ~ y → f x ~ g y`. This extends to
-equivalence of `n`-ary functions. -/
-def arity.equiv : Π {n}, arity pSet.{u} n → arity pSet.{u} n → Prop
-| 0     a b := equiv a b
-| (n+1) a b := ∀ x y, equiv x y → arity.equiv (a x) (b y)
-
-lemma arity.equiv_const {a : pSet.{u}} : ∀ n, arity.equiv (arity.const a n) (arity.const a n)
-| 0 := equiv.rfl
-| (n+1) := λ x y h, arity.equiv_const _
-
-/-- `resp n` is the collection of n-ary functions on `pSet` that respect
-  equivalence, i.e. when the inputs are equivalent the output is as well. -/
-def resp (n) := {x : arity pSet.{u} n // arity.equiv x x}
-
-instance resp.inhabited {n} : inhabited (resp n) :=
-⟨⟨arity.const default _, arity.equiv_const _⟩⟩
-
-/-- The `n`-ary image of a `(n + 1)`-ary function respecting equivalence as a function respecting
-equivalence. -/
-def resp.f {n} (f : resp (n+1)) (x : pSet) : resp n :=
-⟨f.1 x, f.2 _ _ $ equiv.refl x⟩
-
-/-- Function equivalence for functions respecting equivalence. See `pSet.arity.equiv`. -/
-def resp.equiv {n} (a b : resp n) : Prop := arity.equiv a.1 b.1
-
-theorem resp.refl {n} (a : resp n) : resp.equiv a a := a.2
-
-theorem resp.euc : Π {n} {a b c : resp n}, resp.equiv a b → resp.equiv c b → resp.equiv a c
-| 0     a b c hab hcb := hab.euc hcb
-| (n+1) a b c hab hcb := λ x y h,
-  @resp.euc n (a.f x) (b.f y) (c.f y) (hab _ _ h) (hcb _ _ $ equiv.refl y)
-
-instance resp.setoid {n} : setoid (resp n) :=
-⟨resp.equiv, resp.refl, λ x y h, resp.euc (resp.refl y) h,
-  λ x y z h1 h2, resp.euc h1 $ resp.euc (resp.refl z) h2⟩
-
-end pSet
-
-/-- The ZFC universe of sets consists of the type of pre-sets,
-  quotiented by extensional equivalence. -/
-def Set : Type (u+1) := quotient pSet.setoid.{u}
-
-namespace pSet
-
-namespace resp
-
-/-- Helper function for `pSet.eval`. -/
-def eval_aux : Π {n}, {f : resp n → arity Set.{u} n // ∀ (a b : resp n), resp.equiv a b → f a = f b}
-| 0     := ⟨λ a, ⟦a.1⟧, λ a b h, quotient.sound h⟩
-| (n+1) := let F : resp (n + 1) → arity Set (n + 1) := λ a, @quotient.lift _ _ pSet.setoid
-    (λ x, eval_aux.1 (a.f x)) (λ b c h, eval_aux.2 _ _ (a.2 _ _ h)) in
-  ⟨F, λ b c h, funext $ @quotient.ind _ _ (λ q, F b q = F c q) $ λ z,
-  eval_aux.2 (resp.f b z) (resp.f c z) (h _ _ (equiv.refl z))⟩
-
-/-- An equivalence-respecting function yields an n-ary ZFC set function. -/
-def eval (n) : resp n → arity Set.{u} n := eval_aux.1
-
-theorem eval_val {n f x} : (@eval (n+1) f : Set → arity Set n) ⟦x⟧ = eval n (resp.f f x) := rfl
-
-end resp
-
-/-- A set function is "definable" if it is the image of some n-ary pre-set
-  function. This isn't exactly definability, but is useful as a sufficient
-  condition for functions that have a computable image. -/
-class inductive definable (n) : arity Set.{u} n → Type (u+1)
-| mk (f) : definable (resp.eval _ f)
-attribute [instance] definable.mk
-
-/-- The evaluation of a function respecting equivalence is definable, by that same function. -/
-def definable.eq_mk {n} (f) : Π {s : arity Set.{u} n} (H : resp.eval _ f = s), definable n s
-| ._ rfl := ⟨f⟩
-
-/-- Turns a definable function into a function that respects equivalence. -/
-def definable.resp {n} : Π (s : arity Set.{u} n) [definable n s], resp n
-| ._ ⟨f⟩ := f
-
-theorem definable.eq {n} :
-  Π (s : arity Set.{u} n) [H : definable n s], (@definable.resp n s H).eval _ = s
-| ._ ⟨f⟩ := rfl
-
-end pSet
-
-namespace classical
-open pSet
-
-/-- All functions are classically definable. -/
-noncomputable def all_definable : Π {n} (F : arity Set.{u} n), definable n F
-| 0     F := let p := @quotient.exists_rep pSet _ F in
-              definable.eq_mk ⟨some p, equiv.rfl⟩ (some_spec p)
-| (n+1) (F : arity Set.{u} (n + 1)) := begin
-    have I := λ x, (all_definable (F x)),
-    refine definable.eq_mk ⟨λ x : pSet, (@definable.resp _ _ (I ⟦x⟧)).1, _⟩ _,
-    { dsimp [arity.equiv],
-      introsI x y h,
-      rw @quotient.sound pSet _ _ _ h,
-      exact (definable.resp (F ⟦y⟧)).2 },
-    refine funext (λ q, quotient.induction_on q $ λ x, _),
-    simp_rw [resp.eval_val, resp.f, subtype.val_eq_coe, subtype.coe_eta],
-    exact @definable.eq _ (F ⟦x⟧) (I ⟦x⟧),
-  end
-
-end classical
-
-namespace Set
-open pSet
-
-/-- Turns a pre-set into a ZFC set. -/
-def mk : pSet → Set := quotient.mk
-
-@[simp] theorem mk_eq (x : pSet) : @eq Set ⟦x⟧ (mk x) := rfl
-
-@[simp] lemma eval_mk {n f x} :
-  (@resp.eval (n+1) f : Set → arity Set n) (mk x) = resp.eval n (resp.f f x) :=
-rfl
-
-/-- The membership relation for ZFC sets is inherited from the membership relation for pre-sets. -/
-def mem : Set → Set → Prop :=
-quotient.lift₂ pSet.mem
-  (λ x y x' y' hx hy, propext ((mem.congr_left hx).trans (mem.congr_right hy)))
-
-instance : has_mem Set Set := ⟨mem⟩
-
-/-- Convert a ZFC set into a `set` of ZFC sets -/
-def to_set (u : Set.{u}) : set Set.{u} := {x | x ∈ u}
-
-/-- `x ⊆ y` as ZFC sets means that all members of `x` are members of `y`. -/
-protected def subset (x y : Set.{u}) :=
-∀ ⦃z⦄, z ∈ x → z ∈ y
-
-instance has_subset : has_subset Set :=
-⟨Set.subset⟩
-
-lemma subset_def {x y : Set.{u}} : x ⊆ y ↔ ∀ ⦃z⦄, z ∈ x → z ∈ y := iff.rfl
-
-theorem subset_iff : Π (x y : pSet), mk x ⊆ mk y ↔ x ⊆ y
-| ⟨α, A⟩ ⟨β, B⟩ := ⟨λ h a, @h ⟦A a⟧ (mem.mk A a),
-  λ h z, quotient.induction_on z (λ z ⟨a, za⟩, let ⟨b, ab⟩ := h a in ⟨b, za.trans ab⟩)⟩
-
-theorem ext {x y : Set.{u}} : (∀ z : Set.{u}, z ∈ x ↔ z ∈ y) → x = y :=
-quotient.induction_on₂ x y (λ u v h, quotient.sound (mem.ext (λ w, h ⟦w⟧)))
-
-theorem ext_iff {x y : Set.{u}} : (∀ z : Set.{u}, z ∈ x ↔ z ∈ y) ↔ x = y :=
-⟨ext, λ h, by simp [h]⟩
-
-/-- The empty ZFC set -/
-def empty : Set := mk ∅
-instance : has_emptyc Set := ⟨empty⟩
-instance : inhabited Set := ⟨∅⟩
-
-@[simp] theorem mem_empty (x) : x ∉ (∅ : Set.{u}) :=
-quotient.induction_on x pSet.mem_empty
-
-theorem eq_empty (x : Set.{u}) : x = ∅ ↔ ∀ y : Set.{u}, y ∉ x :=
-⟨λ h y, (h.symm ▸ mem_empty y),
-λ h, ext (λ y, ⟨λ yx, absurd yx (h y), λ y0, absurd y0 (mem_empty _)⟩)⟩
-
-/-- `insert x y` is the set `{x} ∪ y` -/
-protected def insert : Set → Set → Set :=
-resp.eval 2 ⟨pSet.insert, λ u v uv ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
-  ⟨λ o, match o with
-   | some a := let ⟨b, hb⟩ := αβ a in ⟨some b, hb⟩
-   | none := ⟨none, uv⟩
-   end, λ o, match o with
-   | some b := let ⟨a, ha⟩ := βα b in ⟨some a, ha⟩
-   | none := ⟨none, uv⟩
-   end⟩⟩
-
-instance : has_insert Set Set := ⟨Set.insert⟩
-
-instance : has_singleton Set Set := ⟨λ x, insert x ∅⟩
-
-instance : is_lawful_singleton Set Set := ⟨λ x, rfl⟩
-
-@[simp] theorem mem_insert {x y z : Set.{u}} : x ∈ insert y z ↔ x = y ∨ x ∈ z :=
-quotient.induction_on₃ x y z
- (λ x y ⟨α, A⟩, show x ∈ pSet.mk (option α) (λ o, option.rec y A o) ↔
-    mk x = mk y ∨ x ∈ pSet.mk α A, from
-  ⟨λ m, match m with
-  | ⟨some a, ha⟩ := or.inr ⟨a, ha⟩
-  | ⟨none, h⟩ := or.inl (quotient.sound h)
-  end, λ m, match m with
-  | or.inr ⟨a, ha⟩ := ⟨some a, ha⟩
-  | or.inl h := ⟨none, quotient.exact h⟩
-  end⟩)
-
-@[simp] theorem mem_singleton {x y : Set.{u}} : x ∈ @singleton Set.{u} Set.{u} _ y ↔ x = y :=
-iff.trans mem_insert ⟨λ o, or.rec (λ h, h) (λ n, absurd n (mem_empty _)) o, or.inl⟩
-
-@[simp] theorem mem_pair {x y z : Set.{u}} : x ∈ ({y, z} : Set) ↔ x = y ∨ x = z :=
-iff.trans mem_insert $ or_congr iff.rfl mem_singleton
-
-/-- `omega` is the first infinite von Neumann ordinal -/
-def omega : Set := mk omega
-
-@[simp] theorem omega_zero : ∅ ∈ omega :=
-⟨⟨0⟩, equiv.rfl⟩
-
-@[simp] theorem omega_succ {n} : n ∈ omega.{u} → insert n n ∈ omega.{u} :=
-quotient.induction_on n (λ x ⟨⟨n⟩, h⟩, ⟨⟨n+1⟩,
-  have Set.insert ⟦x⟧ ⟦x⟧ = Set.insert ⟦of_nat n⟧ ⟦of_nat n⟧, by rw (@quotient.sound pSet _ _ _ h),
-  quotient.exact this⟩)
-
-/-- `{x ∈ a | p x}` is the set of elements in `a` satisfying `p` -/
-protected def sep (p : Set → Prop) : Set → Set :=
-resp.eval 1 ⟨pSet.sep (λ y, p ⟦y⟧), λ ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
-  ⟨λ ⟨a, pa⟩, let ⟨b, hb⟩ := αβ a in ⟨⟨b, by rwa ←(@quotient.sound pSet _ _ _ hb)⟩, hb⟩,
-   λ ⟨b, pb⟩, let ⟨a, ha⟩ := βα b in ⟨⟨a, by rwa (@quotient.sound pSet _ _ _ ha)⟩, ha⟩⟩⟩
-
-instance : has_sep Set Set := ⟨Set.sep⟩
-
-@[simp] theorem mem_sep {p : Set.{u} → Prop} {x y : Set.{u}} : y ∈ {y ∈ x | p y} ↔ y ∈ x ∧ p y :=
-quotient.induction_on₂ x y (λ ⟨α, A⟩ y,
-  ⟨λ ⟨⟨a, pa⟩, h⟩, ⟨⟨a, h⟩, by { rw (@quotient.sound pSet _ _ _ h), exact pa }⟩,
-  λ ⟨⟨a, h⟩, pa⟩, ⟨⟨a, by { rw ←(@quotient.sound pSet _ _ _ h), exact pa }⟩, h⟩⟩)
-
-/-- The powerset operation, the collection of subsets of a ZFC set -/
-def powerset : Set → Set :=
-resp.eval 1 ⟨powerset, λ ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
-  ⟨λ p, ⟨{b | ∃ a, p a ∧ equiv (A a) (B b)},
-    λ ⟨a, pa⟩, let ⟨b, ab⟩ := αβ a in ⟨⟨b, a, pa, ab⟩, ab⟩,
-    λ ⟨b, a, pa, ab⟩, ⟨⟨a, pa⟩, ab⟩⟩,
-   λ q, ⟨{a | ∃ b, q b ∧ equiv (A a) (B b)},
-    λ ⟨a, b, qb, ab⟩, ⟨⟨b, qb⟩, ab⟩,
-    λ ⟨b, qb⟩, let ⟨a, ab⟩ := βα b in ⟨⟨a, b, qb, ab⟩, ab⟩⟩⟩⟩
-
-@[simp] theorem mem_powerset {x y : Set.{u}} : y ∈ powerset x ↔ y ⊆ x :=
-quotient.induction_on₂ x y ( λ ⟨α, A⟩ ⟨β, B⟩,
-  show (⟨β, B⟩ : pSet.{u}) ∈ (pSet.powerset.{u} ⟨α, A⟩) ↔ _,
-    by simp [mem_powerset, subset_iff])
-
-theorem Union_lem {α β : Type u} (A : α → pSet) (B : β → pSet) (αβ : ∀ a, ∃ b, equiv (A a) (B b)) :
-  ∀ a, ∃ b, (equiv ((Union ⟨α, A⟩).func a) ((Union ⟨β, B⟩).func b))
-| ⟨a, c⟩ := let ⟨b, hb⟩ := αβ a in
-  begin
-    induction ea : A a with γ Γ,
-    induction eb : B b with δ Δ,
-    rw [ea, eb] at hb,
-    cases hb with γδ δγ,
-    exact
-    let c : type (A a) := c, ⟨d, hd⟩ := γδ (by rwa ea at c) in
-    have pSet.equiv ((A a).func c) ((B b).func (eq.rec d (eq.symm eb))), from
-    match A a, B b, ea, eb, c, d, hd with ._, ._, rfl, rfl, x, y, hd := hd end,
-    ⟨⟨b, eq.rec d (eq.symm eb)⟩, this⟩
-  end
-
-/-- The union operator, the collection of elements of elements of a ZFC set -/
-def Union : Set → Set :=
-resp.eval 1 ⟨pSet.Union, λ ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
-  ⟨Union_lem A B αβ, λ a, exists.elim (Union_lem B A (λ b,
-    exists.elim (βα b) (λ c hc, ⟨c, pSet.equiv.symm hc⟩)) a) (λ b hb, ⟨b, pSet.equiv.symm hb⟩)⟩⟩
-
-notation `⋃` := Union
-
-@[simp] theorem mem_Union {x y : Set.{u}} : y ∈ Union x ↔ ∃ z ∈ x, y ∈ z :=
-quotient.induction_on₂ x y (λ x y, iff.trans mem_Union
-  ⟨λ ⟨z, h⟩, ⟨⟦z⟧, h⟩, λ ⟨z, h⟩, quotient.induction_on z (λ z h, ⟨z, h⟩) h⟩)
-
-@[simp] theorem Union_singleton {x : Set.{u}} : Union {x} = x :=
-ext $ λ y, by simp_rw [mem_Union, exists_prop, mem_singleton, exists_eq_left]
-
-theorem singleton_inj {x y : Set.{u}} (H : ({x} : Set) = {y}) : x = y :=
-let this := congr_arg Union H in by rwa [Union_singleton, Union_singleton] at this
-
-/-- The binary union operation -/
-protected def union (x y : Set.{u}) : Set.{u} := ⋃ {x, y}
-
-/-- The binary intersection operation -/
-protected def inter (x y : Set.{u}) : Set.{u} := {z ∈ x | z ∈ y}
-
-/-- The set difference operation -/
-protected def diff (x y : Set.{u}) : Set.{u} := {z ∈ x | z ∉ y}
-
-instance : has_union Set := ⟨Set.union⟩
-instance : has_inter Set := ⟨Set.inter⟩
-instance : has_sdiff Set := ⟨Set.diff⟩
-
-@[simp] theorem mem_union {x y z : Set.{u}} : z ∈ x ∪ y ↔ z ∈ x ∨ z ∈ y :=
-iff.trans mem_Union
- ⟨λ ⟨w, wxy, zw⟩, match mem_pair.1 wxy with
-  | or.inl wx := or.inl (by rwa ←wx)
-  | or.inr wy := or.inr (by rwa ←wy)
-  end, λ zxy, match zxy with
-  | or.inl zx := ⟨x, mem_pair.2 (or.inl rfl), zx⟩
-  | or.inr zy := ⟨y, mem_pair.2 (or.inr rfl), zy⟩
-  end⟩
-
-@[simp] theorem mem_inter {x y z : Set.{u}} : z ∈ x ∩ y ↔ z ∈ x ∧ z ∈ y :=
-@@mem_sep (λ z : Set.{u}, z ∈ y)
-
-@[simp] theorem mem_diff {x y z : Set.{u}} : z ∈ x \ y ↔ z ∈ x ∧ z ∉ y :=
-@@mem_sep (λ z : Set.{u}, z ∉ y)
-
-theorem induction_on {p : Set → Prop} (x) (h : ∀ x, (∀ y ∈ x, p y) → p x) : p x :=
-quotient.induction_on x $ λ u, pSet.rec_on u $ λ α A IH, h _ $ λ y,
-show @has_mem.mem _ _ Set.has_mem y ⟦⟨α, A⟩⟧ → p y, from
-quotient.induction_on y (λ v ⟨a, ha⟩, by { rw (@quotient.sound pSet _ _ _ ha), exact IH a })
-
-theorem regularity (x : Set.{u}) (h : x ≠ ∅) : ∃ y ∈ x, x ∩ y = ∅ :=
-classical.by_contradiction $ λ ne, h $ (eq_empty x).2 $ λ y,
-induction_on y $ λ z (IH : ∀ w : Set.{u}, w ∈ z → w ∉ x), show z ∉ x, from λ zx,
-ne ⟨z, zx, (eq_empty _).2 (λ w wxz, let ⟨wx, wz⟩ := mem_inter.1 wxz in IH w wz wx)⟩
-
-/-- The image of a (definable) ZFC set function -/
-def image (f : Set → Set) [H : definable 1 f] : Set → Set :=
-let r := @definable.resp 1 f _ in
-resp.eval 1 ⟨image r.1, λ x y e, mem.ext $ λ z,
-  iff.trans (mem_image r.2) $ iff.trans (by exact
-   ⟨λ ⟨w, h1, h2⟩, ⟨w, (mem.congr_right e).1 h1, h2⟩,
-    λ ⟨w, h1, h2⟩, ⟨w, (mem.congr_right e).2 h1, h2⟩⟩) $
-  iff.symm (mem_image r.2)⟩
-
-theorem image.mk :
-  Π (f : Set.{u} → Set.{u}) [H : definable 1 f] (x) {y} (h : y ∈ x), f y ∈ @image f H x
-| ._ ⟨F⟩ x y := quotient.induction_on₂ x y $ λ ⟨α, A⟩ y ⟨a, ya⟩, ⟨a, F.2 _ _ ya⟩
-
-@[simp] theorem mem_image : Π {f : Set.{u} → Set.{u}} [H : definable 1 f] {x y : Set.{u}},
-  y ∈ @image f H x ↔ ∃ z ∈ x, f z = y
-| ._ ⟨F⟩ x y := quotient.induction_on₂ x y $ λ ⟨α, A⟩ y,
-  ⟨λ ⟨a, ya⟩, ⟨⟦A a⟧, mem.mk A a, eq.symm $ quotient.sound ya⟩,
-  λ ⟨z, hz, e⟩, e ▸ image.mk _ _ hz⟩
-
-/-- Kuratowski ordered pair -/
-def pair (x y : Set.{u}) : Set.{u} := {{x}, {x, y}}
-
-/-- A subset of pairs `{(a, b) ∈ x × y | p a b}` -/
-def pair_sep (p : Set.{u} → Set.{u} → Prop) (x y : Set.{u}) : Set.{u} :=
-{z ∈ powerset (powerset (x ∪ y)) | ∃ a ∈ x, ∃ b ∈ y, z = pair a b ∧ p a b}
-
-@[simp] theorem mem_pair_sep {p} {x y z : Set.{u}} :
-  z ∈ pair_sep p x y ↔ ∃ a ∈ x, ∃ b ∈ y, z = pair a b ∧ p a b :=
-begin
-  refine mem_sep.trans ⟨and.right, λ e, ⟨_, e⟩⟩,
-  rcases e with ⟨a, ax, b, bY, rfl, pab⟩,
-  simp only [mem_powerset, subset_def, mem_union, pair, mem_pair],
-  rintros u (rfl|rfl) v; simp only [mem_singleton, mem_pair],
-  { rintro rfl, exact or.inl ax },
-  { rintro (rfl|rfl); [left, right]; assumption }
-end
-
-theorem pair_inj {x y x' y' : Set.{u}} (H : pair x y = pair x' y') : x = x' ∧ y = y' :=
-begin
-  have ae := ext_iff.2 H,
-  simp only [pair, mem_pair] at ae,
-  obtain rfl : x = x',
-  { cases (ae {x}).1 (by simp) with h h,
-    { exact singleton_inj h },
-    { have m : x' ∈ ({x} : Set),
-      { simp [h] },
-      rw mem_singleton.mp m } },
-  have he : x = y → y = y',
-  { rintro rfl,
-    cases (ae {x, y'}).2 (by simp only [eq_self_iff_true, or_true]) with xy'x xy'xx,
-    { rw [eq_comm, ←mem_singleton, ←xy'x, mem_pair],
-      exact or.inr rfl },
-    { simpa [eq_comm] using (ext_iff.2 xy'xx y').1 (by simp) } },
-  obtain xyx | xyy' := (ae {x, y}).1 (by simp),
-  { obtain rfl := mem_singleton.mp ((ext_iff.2 xyx y).1 $ by simp),
-    simp [he rfl] },
-  { obtain rfl | yy' := mem_pair.mp ((ext_iff.2 xyy' y).1 $ by simp),
-    { simp [he rfl] },
-    { simp [yy'] } }
-end
-
-/-- The cartesian product, `{(a, b) | a ∈ x, b ∈ y}` -/
-def prod : Set.{u} → Set.{u} → Set.{u} := pair_sep (λ a b, true)
-
-@[simp] theorem mem_prod {x y z : Set.{u}} : z ∈ prod x y ↔ ∃ a ∈ x, ∃ b ∈ y, z = pair a b :=
-by simp [prod]
-
-@[simp] theorem pair_mem_prod {x y a b : Set.{u}} : pair a b ∈ prod x y ↔ a ∈ x ∧ b ∈ y :=
-⟨λ h, let ⟨a', a'x, b', b'y, e⟩ := mem_prod.1 h in
-  match a', b', pair_inj e, a'x, b'y with ._, ._, ⟨rfl, rfl⟩, ax, bY := ⟨ax, bY⟩ end,
-λ ⟨ax, bY⟩, mem_prod.2 ⟨a, ax, b, bY, rfl⟩⟩
-
-/-- `is_func x y f` is the assertion that `f` is a subset of `x × y` which relates to each element
-of `x` a unique element of `y`, so that we can consider `f`as a ZFC function `x → y`. -/
-def is_func (x y f : Set.{u}) : Prop :=
-f ⊆ prod x y ∧ ∀ z : Set.{u}, z ∈ x → ∃! w, pair z w ∈ f
-
-/-- `funs x y` is `y ^ x`, the set of all set functions `x → y` -/
-def funs (x y : Set.{u}) : Set.{u} :=
-{f ∈ powerset (prod x y) | is_func x y f}
-
-@[simp] theorem mem_funs {x y f : Set.{u}} : f ∈ funs x y ↔ is_func x y f :=
-by simp [funs, is_func]
-
--- TODO(Mario): Prove this computably
-noncomputable instance map_definable_aux (f : Set → Set) [H : definable 1 f] :
-  definable 1 (λ y, pair y (f y)) :=
-@classical.all_definable 1 _
-
-/-- Graph of a function: `map f x` is the ZFC function which maps `a ∈ x` to `f a` -/
-noncomputable def map (f : Set → Set) [H : definable 1 f] : Set → Set :=
-image (λ y, pair y (f y))
-
-@[simp] theorem mem_map {f : Set → Set} [H : definable 1 f] {x y : Set} :
-  y ∈ map f x ↔ ∃ z ∈ x, pair z (f z) = y :=
-mem_image
-
-theorem map_unique {f : Set.{u} → Set.{u}} [H : definable 1 f] {x z : Set.{u}} (zx : z ∈ x) :
-  ∃! w, pair z w ∈ map f x :=
-⟨f z, image.mk _ _ zx, λ y yx, let ⟨w, wx, we⟩ := mem_image.1 yx, ⟨wz, fy⟩ := pair_inj we in
-  by rw[←fy, wz]⟩
-
-@[simp] theorem map_is_func {f : Set → Set} [H : definable 1 f] {x y : Set} :
-  is_func x y (map f x) ↔ ∀ z ∈ x, f z ∈ y :=
-⟨λ ⟨ss, h⟩ z zx, let ⟨t, t1, t2⟩ := h z zx in
-  (t2 (f z) (image.mk _ _ zx)).symm ▸ (pair_mem_prod.1 (ss t1)).right,
-λ h, ⟨λ y yx, let ⟨z, zx, ze⟩ := mem_image.1 yx in ze ▸ pair_mem_prod.2 ⟨zx, h z zx⟩,
-     λ z, map_unique⟩⟩
-
-end Set
-
-/-- The collection of all classes. A class is defined as a `set` of ZFC sets. -/
-def Class := set Set
-
-namespace Class
-
-instance : has_subset Class     := ⟨set.subset⟩
-instance : has_sep Set Class    := ⟨set.sep⟩
-instance : has_emptyc Class     := ⟨λ a, false⟩
-instance : inhabited Class      := ⟨∅⟩
-instance : has_insert Set Class := ⟨set.insert⟩
-instance : has_union Class      := ⟨set.union⟩
-instance : has_inter Class      := ⟨set.inter⟩
-instance : has_neg Class        := ⟨set.compl⟩
-instance : has_sdiff Class      := ⟨set.diff⟩
-
-/-- Coerce a ZFC set into a class -/
-def of_Set (x : Set.{u}) : Class.{u} := {y | y ∈ x}
-instance : has_coe Set Class := ⟨of_Set⟩
-
-/-- The universal class -/
-def univ : Class := set.univ
-
-/-- Assert that `A` is a ZFC set satisfying `p` -/
-def to_Set (p : Set.{u} → Prop) (A : Class.{u}) : Prop := ∃ x, ↑x = A ∧ p x
-
-/-- `A ∈ B` if `A` is a ZFC set which is a member of `B` -/
-protected def mem (A B : Class.{u}) : Prop := to_Set.{u} B A
-instance : has_mem Class Class := ⟨Class.mem⟩
-
-theorem mem_univ {A : Class.{u}} : A ∈ univ.{u} ↔ ∃ x : Set.{u}, ↑x = A :=
-exists_congr $ λ x, and_true _
-
-/-- Convert a conglomerate (a collection of classes) into a class -/
-def Cong_to_Class (x : set Class.{u}) : Class.{u} := {y | ↑y ∈ x}
-
-/-- Convert a class into a conglomerate (a collection of classes) -/
-def Class_to_Cong (x : Class.{u}) : set Class.{u} := {y | y ∈ x}
-
-/-- The power class of a class is the class of all subclasses that are ZFC sets -/
-def powerset (x : Class) : Class := Cong_to_Class (set.powerset x)
-
-/-- The union of a class is the class of all members of ZFC sets in the class -/
-def Union (x : Class) : Class := set.sUnion (Class_to_Cong x)
-notation `⋃` := Union
-
-theorem of_Set.inj {x y : Set.{u}} (h : (x : Class.{u}) = y) : x = y :=
-Set.ext $ λ z, by { change (x : Class.{u}) z ↔ (y : Class.{u}) z, rw h }
-
-@[simp] theorem to_Set_of_Set (p : Set.{u} → Prop) (x : Set.{u}) : to_Set p x ↔ p x :=
-⟨λ ⟨y, yx, py⟩, by rwa of_Set.inj yx at py, λ px, ⟨x, rfl, px⟩⟩
-
-@[simp] theorem mem_hom_left (x : Set.{u}) (A : Class.{u}) : (x : Class.{u}) ∈ A ↔ A x :=
-to_Set_of_Set _ _
-
-@[simp] theorem mem_hom_right (x y : Set.{u}) : (y : Class.{u}) x ↔ x ∈ y := iff.rfl
-
-@[simp] theorem subset_hom (x y : Set.{u}) : (x : Class.{u}) ⊆ y ↔ x ⊆ y := iff.rfl
-
-@[simp] theorem sep_hom (p : Set.{u} → Prop) (x : Set.{u}) :
-  (↑{y ∈ x | p y} : Class.{u}) = {y ∈ x | p y} :=
-set.ext $ λ y, Set.mem_sep
-
-@[simp] theorem empty_hom : ↑(∅ : Set.{u}) = (∅ : Class.{u}) :=
-set.ext $ λ y, (iff_false _).2 (Set.mem_empty y)
-
-@[simp] theorem insert_hom (x y : Set.{u}) : (@insert Set.{u} Class.{u} _ x y) = ↑(insert x y) :=
-set.ext $ λ z, iff.symm Set.mem_insert
-
-@[simp] theorem union_hom (x y : Set.{u}) : (x : Class.{u}) ∪ y = (x ∪ y : Set.{u}) :=
-set.ext $ λ z, iff.symm Set.mem_union
-
-@[simp] theorem inter_hom (x y : Set.{u}) : (x : Class.{u}) ∩ y = (x ∩ y : Set.{u}) :=
-set.ext $ λ z, iff.symm Set.mem_inter
-
-@[simp] theorem diff_hom (x y : Set.{u}) : (x : Class.{u}) \ y = (x \ y : Set.{u}) :=
-set.ext $ λ z, iff.symm Set.mem_diff
-
-@[simp] theorem powerset_hom (x : Set.{u}) : powerset.{u} x = Set.powerset x :=
-set.ext $ λ z, iff.symm Set.mem_powerset
-
-@[simp] theorem Union_hom (x : Set.{u}) : Union.{u} x = Set.Union x :=
-set.ext $ λ z, by { refine iff.trans _ Set.mem_Union.symm, exact
-⟨λ ⟨._, ⟨a, rfl, ax⟩, za⟩, ⟨a, ax, za⟩, λ ⟨a, ax, za⟩, ⟨_, ⟨a, rfl, ax⟩, za⟩⟩ }
-
-/-- The definite description operator, which is `{x}` if `{a | p a} = {x}` and `∅` otherwise. -/
-def iota (p : Set → Prop) : Class := Union {x | ∀ y, p y ↔ y = x}
-
-theorem iota_val (p : Set → Prop) (x : Set) (H : ∀ y, p y ↔ y = x) : iota p = ↑x :=
-set.ext $ λ y, ⟨λ ⟨._, ⟨x', rfl, h⟩, yx'⟩, by rwa ←((H x').1 $ (h x').2 rfl),
-  λ yx, ⟨_, ⟨x, rfl, H⟩, yx⟩⟩
-
-/-- Unlike the other set constructors, the `iota` definite descriptor
-  is a set for any set input, but not constructively so, so there is no
-  associated `(Set → Prop) → Set` function. -/
-theorem iota_ex (p) : iota.{u} p ∈ univ.{u} :=
-mem_univ.2 $ or.elim (classical.em $ ∃ x, ∀ y, p y ↔ y = x)
- (λ ⟨x, h⟩, ⟨x, eq.symm $ iota_val p x h⟩)
- (λ hn, ⟨∅, set.ext (λ z, empty_hom.symm ▸ ⟨false.rec _, λ ⟨._, ⟨x, rfl, H⟩, zA⟩, hn ⟨x, H⟩⟩)⟩)
-
-/-- Function value -/
-def fval (F A : Class.{u}) : Class.{u} := iota (λ y, to_Set (λ x, F (Set.pair x y)) A)
-infixl `′`:100 := fval
-
-theorem fval_ex (F A : Class.{u}) : F ′ A ∈ univ.{u} := iota_ex _
-
-end Class
-
-namespace Set
-
-@[simp] theorem map_fval {f : Set.{u} → Set.{u}} [H : pSet.definable 1 f]
-  {x y : Set.{u}} (h : y ∈ x) :
-  (Set.map f x ′ y : Class.{u}) = f y :=
-Class.iota_val _ _ (λ z, by { rw [Class.to_Set_of_Set, Class.mem_hom_right, mem_map], exact
-  ⟨λ ⟨w, wz, pr⟩, let ⟨wy, fw⟩ := Set.pair_inj pr in by rw[←fw, wy],
-  λ e, by { subst e, exact ⟨_, h, rfl⟩ }⟩ })
-
-variables (x : Set.{u}) (h : ∅ ∉ x)
-
-/-- A choice function on the class of nonempty ZFC sets. -/
-noncomputable def choice : Set :=
-@map (λ y, classical.epsilon (λ z, z ∈ y)) (classical.all_definable _) x
-
-include h
-theorem choice_mem_aux (y : Set.{u}) (yx : y ∈ x) : classical.epsilon (λ z : Set.{u}, z ∈ y) ∈ y :=
-@classical.epsilon_spec _ (λ z : Set.{u}, z ∈ y) $ classical.by_contradiction $ λ n, h $
-by rwa ←((eq_empty y).2 $ λ z zx, n ⟨z, zx⟩)
-
-theorem choice_is_func : is_func x (Union x) (choice x) :=
-(@map_is_func _ (classical.all_definable _) _ _).2 $
-  λ y yx, mem_Union.2 ⟨y, yx, choice_mem_aux x h y yx⟩
-
-theorem choice_mem (y : Set.{u}) (yx : y ∈ x) : (choice x ′ y : Class.{u}) ∈ (y : Class.{u}) :=
-begin
-  delta choice,
-  rw [map_fval yx, Class.mem_hom_left, Class.mem_hom_right],
-  exact choice_mem_aux x h y yx
-end
-
-end Set
diff --git a/src/set_theory/zfc/basic.lean b/src/set_theory/zfc/basic.lean
new file mode 100644
index 0000000000000..78ba1fc1517e3
--- /dev/null
+++ b/src/set_theory/zfc/basic.lean
@@ -0,0 +1,1200 @@
+/-
+Copyright (c) 2018 Mario Carneiro. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro
+-/
+import data.set.lattice
+import logic.small.basic
+import order.well_founded
+
+/-!
+# A model of ZFC
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we model Zermelo-Fraenkel set theory (+ Choice) using Lean's underlying type theory.
+We do this in four main steps:
+* Define pre-sets inductively.
+* Define extensional equivalence on pre-sets and give it a `setoid` instance.
+* Define ZFC sets by quotienting pre-sets by extensional equivalence.
+* Define classes as sets of ZFC sets.
+Then the rest is usual set theory.
+
+## The model
+
+* `pSet`: Pre-set. A pre-set is inductively defined by its indexing type and its members, which are
+  themselves pre-sets.
+* `Set`: ZFC set. Defined as `pSet` quotiented by `pSet.equiv`, the extensional equivalence.
+* `Class`: Class. Defined as `set Set`.
+* `Set.choice`: Axiom of choice. Proved from Lean's axiom of choice.
+
+## Other definitions
+
+* `arity α n`: `n`-ary function `α → α → ... → α`. Defined inductively.
+* `arity.const a n`: `n`-ary constant function equal to `a`.
+* `pSet.type`: Underlying type of a pre-set.
+* `pSet.func`: Underlying family of pre-sets of a pre-set.
+* `pSet.equiv`: Extensional equivalence of pre-sets. Defined inductively.
+* `pSet.omega`, `Set.omega`: The von Neumann ordinal `ω` as a `pSet`, as a `Set`.
+* `pSet.arity.equiv`: Extensional equivalence of `n`-ary `pSet`-valued functions. Extension of
+  `pSet.equiv`.
+* `pSet.resp`: Collection of `n`-ary `pSet`-valued functions that respect extensional equivalence.
+* `pSet.eval`: Turns a `pSet`-valued function that respect extensional equivalence into a
+  `Set`-valued function.
+* `classical.all_definable`: All functions are classically definable.
+* `Set.is_func` : Predicate that a ZFC set is a subset of `x × y` that can be considered as a ZFC
+  function `x → y`. That is, each member of `x` is related by the ZFC set to exactly one member of
+  `y`.
+* `Set.funs`: ZFC set of ZFC functions `x → y`.
+* `Set.hereditarily p x`: Predicate that every set in the transitive closure of `x` has property
+  `p`.
+* `Class.iota`: Definite description operator.
+
+## Notes
+
+To avoid confusion between the Lean `set` and the ZFC `Set`, docstrings in this file refer to them
+respectively as "`set`" and "ZFC set".
+
+## TODO
+
+Prove `Set.map_definable_aux` computably.
+-/
+
+universes u v
+
+/-- The type of `n`-ary functions `α → α → ... → α`. -/
+def arity (α : Type u) : ℕ → Type u
+| 0     := α
+| (n+1) := α → arity n
+
+@[simp] theorem arity_zero (α : Type u) : arity α 0 = α := rfl
+@[simp] theorem arity_succ (α : Type u) (n : ℕ) : arity α n.succ = (α → arity α n) := rfl
+
+namespace arity
+
+/-- Constant `n`-ary function with value `a`. -/
+def const {α : Type u} (a : α) : ∀ n, arity α n
+| 0     := a
+| (n+1) := λ _, const n
+
+@[simp] theorem const_zero {α : Type u} (a : α) : const a 0 = a := rfl
+@[simp] theorem const_succ {α : Type u} (a : α) (n : ℕ) : const a n.succ = λ _, const a n := rfl
+theorem const_succ_apply {α : Type u} (a : α) (n : ℕ) (x : α) : const a n.succ x = const a n := rfl
+
+instance arity.inhabited {α n} [inhabited α] : inhabited (arity α n) := ⟨const default _⟩
+
+end arity
+
+/-- The type of pre-sets in universe `u`. A pre-set
+  is a family of pre-sets indexed by a type in `Type u`.
+  The ZFC universe is defined as a quotient of this
+  to ensure extensionality. -/
+inductive pSet : Type (u+1)
+| mk (α : Type u) (A : α → pSet) : pSet
+
+namespace pSet
+
+/-- The underlying type of a pre-set -/
+def type : pSet → Type u
+| ⟨α, A⟩ := α
+
+/-- The underlying pre-set family of a pre-set -/
+def func : Π (x : pSet), x.type → pSet
+| ⟨α, A⟩ := A
+
+@[simp] theorem mk_type (α A) : type ⟨α, A⟩ = α := rfl
+@[simp] theorem mk_func (α A) : func ⟨α, A⟩ = A := rfl
+
+@[simp] theorem eta : Π (x : pSet), mk x.type x.func = x
+| ⟨α, A⟩ := rfl
+
+/-- Two pre-sets are extensionally equivalent if every element of the first family is extensionally
+equivalent to some element of the second family and vice-versa. -/
+def equiv (x y : pSet) : Prop :=
+pSet.rec (λ α z m ⟨β, B⟩, (∀ a, ∃ b, m a (B b)) ∧ (∀ b, ∃ a, m a (B b))) x y
+
+theorem equiv_iff : Π {x y : pSet}, equiv x y ↔
+  (∀ i, ∃ j, equiv (x.func i) (y.func j)) ∧ (∀ j, ∃ i, equiv (x.func i) (y.func j))
+| ⟨α, A⟩ ⟨β, B⟩ := iff.rfl
+
+theorem equiv.exists_left {x y : pSet} (h : equiv x y) : ∀ i, ∃ j, equiv (x.func i) (y.func j) :=
+(equiv_iff.1 h).1
+
+theorem equiv.exists_right {x y : pSet} (h : equiv x y) : ∀ j, ∃ i, equiv (x.func i) (y.func j) :=
+(equiv_iff.1 h).2
+
+@[refl] protected theorem equiv.refl (x) : equiv x x :=
+pSet.rec_on x $ λ α A IH, ⟨λ a, ⟨a, IH a⟩, λ a, ⟨a, IH a⟩⟩
+
+protected theorem equiv.rfl : ∀ {x}, equiv x x := equiv.refl
+
+protected theorem equiv.euc {x} : Π {y z}, equiv x y → equiv z y → equiv x z :=
+pSet.rec_on x $ λ α A IH y, pSet.cases_on y $ λ β B ⟨γ, Γ⟩ ⟨αβ, βα⟩ ⟨γβ, βγ⟩,
+⟨λ a, let ⟨b, ab⟩ := αβ a, ⟨c, bc⟩ := βγ b in ⟨c, IH a ab bc⟩,
+  λ c, let ⟨b, cb⟩ := γβ c, ⟨a, ba⟩ := βα b in ⟨a, IH a ba cb⟩⟩
+
+@[symm] protected theorem equiv.symm {x y} : equiv x y → equiv y x :=
+(equiv.refl y).euc
+
+protected theorem equiv.comm {x y} : equiv x y ↔ equiv y x :=
+⟨equiv.symm, equiv.symm⟩
+
+@[trans] protected theorem equiv.trans {x y z} (h1 : equiv x y) (h2 : equiv y z) : equiv x z :=
+h1.euc h2.symm
+
+protected theorem equiv_of_is_empty (x y : pSet) [is_empty x.type] [is_empty y.type] : equiv x y :=
+equiv_iff.2 $ by simp
+
+instance setoid : setoid pSet :=
+⟨pSet.equiv, equiv.refl, λ x y, equiv.symm, λ x y z, equiv.trans⟩
+
+/-- A pre-set is a subset of another pre-set if every element of the first family is extensionally
+equivalent to some element of the second family.-/
+protected def subset (x y : pSet) : Prop := ∀ a, ∃ b, equiv (x.func a) (y.func b)
+
+instance : has_subset pSet := ⟨pSet.subset⟩
+
+instance : is_refl pSet (⊆) := ⟨λ x a, ⟨a, equiv.refl _⟩⟩
+
+instance : is_trans pSet (⊆) :=
+⟨λ x y z hxy hyz a, begin
+  cases hxy a with b hb,
+  cases hyz b with c hc,
+  exact ⟨c, hb.trans hc⟩
+end⟩
+
+theorem equiv.ext : Π (x y : pSet), equiv x y ↔ (x ⊆ y ∧ y ⊆ x)
+| ⟨α, A⟩ ⟨β, B⟩ :=
+  ⟨λ ⟨αβ, βα⟩, ⟨αβ, λ b, let ⟨a, h⟩ := βα b in ⟨a, equiv.symm h⟩⟩,
+    λ ⟨αβ, βα⟩, ⟨αβ, λ b, let ⟨a, h⟩ := βα b in ⟨a, equiv.symm h⟩⟩⟩
+
+theorem subset.congr_left : Π {x y z : pSet}, equiv x y → (x ⊆ z ↔ y ⊆ z)
+| ⟨α, A⟩ ⟨β, B⟩ ⟨γ, Γ⟩ ⟨αβ, βα⟩ :=
+  ⟨λ αγ b, let ⟨a, ba⟩ := βα b, ⟨c, ac⟩ := αγ a in ⟨c, (equiv.symm ba).trans ac⟩,
+    λ βγ a, let ⟨b, ab⟩ := αβ a, ⟨c, bc⟩ := βγ b in ⟨c, equiv.trans ab bc⟩⟩
+
+theorem subset.congr_right : Π {x y z : pSet}, equiv x y → (z ⊆ x ↔ z ⊆ y)
+| ⟨α, A⟩ ⟨β, B⟩ ⟨γ, Γ⟩ ⟨αβ, βα⟩ :=
+  ⟨λ γα c, let ⟨a, ca⟩ := γα c, ⟨b, ab⟩ := αβ a in ⟨b, ca.trans ab⟩,
+    λ γβ c, let ⟨b, cb⟩ := γβ c, ⟨a, ab⟩ := βα b in ⟨a, cb.trans (equiv.symm ab)⟩⟩
+
+/-- `x ∈ y` as pre-sets if `x` is extensionally equivalent to a member of the family `y`. -/
+protected def mem (x y : pSet.{u}) : Prop := ∃ b, equiv x (y.func b)
+
+instance : has_mem pSet pSet := ⟨pSet.mem⟩
+
+theorem mem.mk {α : Type u} (A : α → pSet) (a : α) : A a ∈ mk α A :=
+⟨a, equiv.refl (A a)⟩
+
+theorem func_mem (x : pSet) (i : x.type) : x.func i ∈ x :=
+by { cases x, apply mem.mk }
+
+theorem mem.ext : Π {x y : pSet.{u}}, (∀ w : pSet.{u}, w ∈ x ↔ w ∈ y) → equiv x y
+| ⟨α, A⟩ ⟨β, B⟩ h := ⟨λ a, (h (A a)).1 (mem.mk A a),
+    λ b, let ⟨a, ha⟩ := (h (B b)).2 (mem.mk B b) in ⟨a, ha.symm⟩⟩
+
+theorem mem.congr_right : Π {x y : pSet.{u}}, equiv x y → (∀ {w : pSet.{u}}, w ∈ x ↔ w ∈ y)
+| ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩ w :=
+  ⟨λ ⟨a, ha⟩, let ⟨b, hb⟩ := αβ a in ⟨b, ha.trans hb⟩,
+    λ ⟨b, hb⟩, let ⟨a, ha⟩ := βα b in ⟨a, hb.euc ha⟩⟩
+
+theorem equiv_iff_mem {x y : pSet.{u}} : equiv x y ↔ (∀ {w : pSet.{u}}, w ∈ x ↔ w ∈ y) :=
+⟨mem.congr_right, match x, y with
+| ⟨α, A⟩, ⟨β, B⟩, h := ⟨λ a, h.1 (mem.mk A a), λ b,
+  let ⟨a, h⟩ := h.2 (mem.mk B b) in ⟨a, h.symm⟩⟩
+end⟩
+
+theorem mem.congr_left : Π {x y : pSet.{u}}, equiv x y → (∀ {w : pSet.{u}}, x ∈ w ↔ y ∈ w)
+| x y h ⟨α, A⟩ := ⟨λ ⟨a, ha⟩, ⟨a, h.symm.trans ha⟩, λ ⟨a, ha⟩, ⟨a, h.trans ha⟩⟩
+
+private theorem mem_wf_aux : Π {x y : pSet.{u}}, equiv x y → acc (∈) y
+| ⟨α, A⟩ ⟨β, B⟩ H := ⟨_, begin
+  rintros ⟨γ, C⟩ ⟨b, hc⟩,
+  cases H.exists_right b with a ha,
+  have H := ha.trans hc.symm,
+  rw mk_func at H,
+  exact mem_wf_aux H
+end⟩
+
+theorem mem_wf : @well_founded pSet (∈) := ⟨λ x, mem_wf_aux $ equiv.refl x⟩
+
+instance : has_well_founded pSet := ⟨_, mem_wf⟩
+instance : is_asymm pSet (∈) := mem_wf.is_asymm
+
+theorem mem_asymm {x y : pSet} : x ∈ y → y ∉ x := asymm
+theorem mem_irrefl (x : pSet) : x ∉ x := irrefl x
+
+/-- Convert a pre-set to a `set` of pre-sets. -/
+def to_set (u : pSet.{u}) : set pSet.{u} := {x | x ∈ u}
+
+@[simp] theorem mem_to_set (a u : pSet.{u}) : a ∈ u.to_set ↔ a ∈ u := iff.rfl
+
+/-- A nonempty set is one that contains some element. -/
+protected def nonempty (u : pSet) : Prop := u.to_set.nonempty
+
+theorem nonempty_def (u : pSet) : u.nonempty ↔ ∃ x, x ∈ u := iff.rfl
+
+theorem nonempty_of_mem {x u : pSet} (h : x ∈ u) : u.nonempty := ⟨x, h⟩
+
+@[simp] theorem nonempty_to_set_iff {u : pSet} : u.to_set.nonempty ↔ u.nonempty := iff.rfl
+
+theorem nonempty_type_iff_nonempty {x : pSet} : nonempty x.type ↔ pSet.nonempty x :=
+⟨λ ⟨i⟩, ⟨_, func_mem _ i⟩, λ ⟨i, j, h⟩, ⟨j⟩⟩
+
+theorem nonempty_of_nonempty_type (x : pSet) [h : nonempty x.type] : pSet.nonempty x :=
+nonempty_type_iff_nonempty.1 h
+
+/-- Two pre-sets are equivalent iff they have the same members. -/
+theorem equiv.eq {x y : pSet} : equiv x y ↔ to_set x = to_set y :=
+equiv_iff_mem.trans set.ext_iff.symm
+
+instance : has_coe pSet (set pSet) := ⟨to_set⟩
+
+/-- The empty pre-set -/
+protected def empty : pSet := ⟨_, pempty.elim⟩
+
+instance : has_emptyc pSet := ⟨pSet.empty⟩
+
+instance : inhabited pSet := ⟨∅⟩
+
+instance : is_empty (type (∅)) := pempty.is_empty
+
+@[simp] theorem not_mem_empty (x : pSet.{u}) : x ∉ (∅ : pSet.{u}) := is_empty.exists_iff.1
+
+@[simp] theorem to_set_empty : to_set ∅ = ∅ := by simp [to_set]
+
+@[simp] theorem empty_subset (x : pSet.{u}) : (∅ : pSet) ⊆ x := λ x, x.elim
+
+@[simp] theorem not_nonempty_empty : ¬ pSet.nonempty ∅ := by simp [pSet.nonempty]
+
+protected theorem equiv_empty (x : pSet) [is_empty x.type] : equiv x ∅ :=
+pSet.equiv_of_is_empty x _
+
+/-- Insert an element into a pre-set -/
+protected def insert (x y : pSet) : pSet := ⟨option y.type, λ o, option.rec x y.func o⟩
+
+instance : has_insert pSet pSet := ⟨pSet.insert⟩
+
+instance : has_singleton pSet pSet := ⟨λ s, insert s ∅⟩
+
+instance : is_lawful_singleton pSet pSet := ⟨λ _, rfl⟩
+
+instance (x y : pSet) : inhabited (insert x y).type := option.inhabited _
+
+/-- The n-th von Neumann ordinal -/
+def of_nat : ℕ → pSet
+| 0     := ∅
+| (n+1) := insert (of_nat n) (of_nat n)
+
+/-- The von Neumann ordinal ω -/
+def omega : pSet := ⟨ulift ℕ, λ n, of_nat n.down⟩
+
+/-- The pre-set separation operation `{x ∈ a | p x}` -/
+protected def sep (p : pSet → Prop) (x : pSet) : pSet := ⟨{a // p (x.func a)}, λ y, x.func y.1⟩
+
+instance : has_sep pSet pSet := ⟨pSet.sep⟩
+
+/-- The pre-set powerset operator -/
+def powerset (x : pSet) : pSet := ⟨set x.type, λ p, ⟨{a // p a}, λ y, x.func y.1⟩⟩
+
+@[simp] theorem mem_powerset : Π {x y : pSet}, y ∈ powerset x ↔ y ⊆ x
+| ⟨α, A⟩ ⟨β, B⟩ := ⟨λ ⟨p, e⟩, (subset.congr_left e).2 $ λ ⟨a, pa⟩, ⟨a, equiv.refl (A a)⟩,
+  λ βα, ⟨{a | ∃ b, equiv (B b) (A a)}, λ b, let ⟨a, ba⟩ := βα b in ⟨⟨a, b, ba⟩, ba⟩,
+    λ ⟨a, b, ba⟩, ⟨b, ba⟩⟩⟩
+
+/-- The pre-set union operator -/
+def sUnion (a : pSet) : pSet := ⟨Σ x, (a.func x).type, λ ⟨x, y⟩, (a.func x).func y⟩
+
+prefix (name := pSet.sUnion) `⋃₀ `:110 := pSet.sUnion
+
+@[simp] theorem mem_sUnion : Π {x y : pSet.{u}}, y ∈ ⋃₀ x ↔ ∃ z ∈ x, y ∈ z
+| ⟨α, A⟩ y :=
+  ⟨λ ⟨⟨a, c⟩, (e : equiv y ((A a).func c))⟩,
+    have func (A a) c ∈ mk (A a).type (A a).func, from mem.mk (A a).func c,
+    ⟨_, mem.mk _ _, (mem.congr_left e).2 (by rwa eta at this)⟩,
+  λ ⟨⟨β, B⟩, ⟨a, (e : equiv (mk β B) (A a))⟩, ⟨b, yb⟩⟩,
+    by { rw ←(eta (A a)) at e, exact
+    let ⟨βt, tβ⟩ := e, ⟨c, bc⟩ := βt b in ⟨⟨a, c⟩, yb.trans bc⟩ }⟩
+
+@[simp] theorem to_set_sUnion (x : pSet.{u}) : (⋃₀ x).to_set = ⋃₀ (to_set '' x.to_set) :=
+by { ext, simp }
+
+/-- The image of a function from pre-sets to pre-sets. -/
+def image (f : pSet.{u} → pSet.{u}) (x : pSet.{u}) : pSet := ⟨x.type, f ∘ x.func⟩
+
+theorem mem_image {f : pSet.{u} → pSet.{u}} (H : ∀ {x y}, equiv x y → equiv (f x) (f y)) :
+  Π {x y : pSet.{u}}, y ∈ image f x ↔ ∃ z ∈ x, equiv y (f z)
+| ⟨α, A⟩ y := ⟨λ ⟨a, ya⟩, ⟨A a, mem.mk A a, ya⟩, λ ⟨z, ⟨a, za⟩, yz⟩, ⟨a, yz.trans (H za)⟩⟩
+
+/-- Universe lift operation -/
+protected def lift : pSet.{u} → pSet.{max u v}
+| ⟨α, A⟩ := ⟨ulift α, λ ⟨x⟩, lift (A x)⟩
+
+/-- Embedding of one universe in another -/
+@[nolint check_univs] -- intended to be used with explicit universe parameters
+def embed : pSet.{max (u+1) v} := ⟨ulift.{v u+1} pSet, λ ⟨x⟩, pSet.lift.{u (max (u+1) v)} x⟩
+
+theorem lift_mem_embed : Π (x : pSet.{u}), pSet.lift.{u (max (u+1) v)} x ∈ embed.{u v} :=
+λ x, ⟨⟨x⟩, equiv.rfl⟩
+
+/-- Function equivalence is defined so that `f ~ g` iff `∀ x y, x ~ y → f x ~ g y`. This extends to
+equivalence of `n`-ary functions. -/
+def arity.equiv : Π {n}, arity pSet.{u} n → arity pSet.{u} n → Prop
+| 0     a b := equiv a b
+| (n+1) a b := ∀ x y, equiv x y → arity.equiv (a x) (b y)
+
+lemma arity.equiv_const {a : pSet.{u}} : ∀ n, arity.equiv (arity.const a n) (arity.const a n)
+| 0     := equiv.rfl
+| (n+1) := λ x y h, arity.equiv_const _
+
+/-- `resp n` is the collection of n-ary functions on `pSet` that respect
+  equivalence, i.e. when the inputs are equivalent the output is as well. -/
+def resp (n) := {x : arity pSet.{u} n // arity.equiv x x}
+
+instance resp.inhabited {n} : inhabited (resp n) :=
+⟨⟨arity.const default _, arity.equiv_const _⟩⟩
+
+/-- The `n`-ary image of a `(n + 1)`-ary function respecting equivalence as a function respecting
+equivalence. -/
+def resp.f {n} (f : resp (n+1)) (x : pSet) : resp n :=
+⟨f.1 x, f.2 _ _ $ equiv.refl x⟩
+
+/-- Function equivalence for functions respecting equivalence. See `pSet.arity.equiv`. -/
+def resp.equiv {n} (a b : resp n) : Prop := arity.equiv a.1 b.1
+
+protected theorem resp.equiv.refl {n} (a : resp n) : resp.equiv a a := a.2
+
+protected theorem resp.equiv.euc : Π {n} {a b c : resp n},
+  resp.equiv a b → resp.equiv c b → resp.equiv a c
+| 0     a b c hab hcb := equiv.euc hab hcb
+| (n+1) a b c hab hcb := λ x y h,
+  @resp.equiv.euc n (a.f x) (b.f y) (c.f y) (hab _ _ h) (hcb _ _ $ equiv.refl y)
+
+protected theorem resp.equiv.symm {n} {a b : resp n} : resp.equiv a b → resp.equiv b a :=
+(resp.equiv.refl b).euc
+
+protected theorem resp.equiv.trans {n} {x y z : resp n}
+  (h1 : resp.equiv x y) (h2 : resp.equiv y z) : resp.equiv x z :=
+h1.euc h2.symm
+
+instance resp.setoid {n} : setoid (resp n) :=
+⟨resp.equiv, resp.equiv.refl, λ x y, resp.equiv.symm, λ x y z, resp.equiv.trans⟩
+
+end pSet
+
+/-- The ZFC universe of sets consists of the type of pre-sets,
+  quotiented by extensional equivalence. -/
+def Set : Type (u+1) := quotient pSet.setoid.{u}
+
+namespace pSet
+
+namespace resp
+
+/-- Helper function for `pSet.eval`. -/
+def eval_aux : Π {n}, {f : resp n → arity Set.{u} n // ∀ (a b : resp n), resp.equiv a b → f a = f b}
+| 0     := ⟨λ a, ⟦a.1⟧, λ a b h, quotient.sound h⟩
+| (n+1) := let F : resp (n + 1) → arity Set (n + 1) := λ a, @quotient.lift _ _ pSet.setoid
+    (λ x, eval_aux.1 (a.f x)) (λ b c h, eval_aux.2 _ _ (a.2 _ _ h)) in
+  ⟨F, λ b c h, funext $ @quotient.ind _ _ (λ q, F b q = F c q) $ λ z,
+  eval_aux.2 (resp.f b z) (resp.f c z) (h _ _ (pSet.equiv.refl z))⟩
+
+/-- An equivalence-respecting function yields an n-ary ZFC set function. -/
+def eval (n) : resp n → arity Set.{u} n := eval_aux.1
+
+theorem eval_val {n f x} : (@eval (n+1) f : Set → arity Set n) ⟦x⟧ = eval n (resp.f f x) := rfl
+
+end resp
+
+/-- A set function is "definable" if it is the image of some n-ary pre-set
+  function. This isn't exactly definability, but is useful as a sufficient
+  condition for functions that have a computable image. -/
+class inductive definable (n) : arity Set.{u} n → Type (u+1)
+| mk (f) : definable (resp.eval n f)
+
+attribute [instance] definable.mk
+
+/-- The evaluation of a function respecting equivalence is definable, by that same function. -/
+def definable.eq_mk {n} (f) : Π {s : arity Set.{u} n} (H : resp.eval _ f = s), definable n s
+| ._ rfl := ⟨f⟩
+
+/-- Turns a definable function into a function that respects equivalence. -/
+def definable.resp {n} : Π (s : arity Set.{u} n) [definable n s], resp n
+| ._ ⟨f⟩ := f
+
+theorem definable.eq {n} :
+  Π (s : arity Set.{u} n) [H : definable n s], (@definable.resp n s H).eval _ = s
+| ._ ⟨f⟩ := rfl
+
+end pSet
+
+namespace classical
+open pSet
+
+/-- All functions are classically definable. -/
+noncomputable def all_definable : Π {n} (F : arity Set.{u} n), definable n F
+| 0     F := let p := @quotient.exists_rep pSet _ F in
+              definable.eq_mk ⟨some p, equiv.rfl⟩ (some_spec p)
+| (n+1) (F : arity Set.{u} (n + 1)) := begin
+    have I := λ x, (all_definable (F x)),
+    refine definable.eq_mk ⟨λ x : pSet, (@definable.resp _ _ (I ⟦x⟧)).1, _⟩ _,
+    { dsimp [arity.equiv],
+      introsI x y h,
+      rw @quotient.sound pSet _ _ _ h,
+      exact (definable.resp (F ⟦y⟧)).2 },
+    refine funext (λ q, quotient.induction_on q $ λ x, _),
+    simp_rw [resp.eval_val, resp.f, subtype.val_eq_coe, subtype.coe_eta],
+    exact @definable.eq _ (F ⟦x⟧) (I ⟦x⟧),
+  end
+
+end classical
+
+namespace Set
+open pSet
+
+/-- Turns a pre-set into a ZFC set. -/
+def mk : pSet → Set := quotient.mk
+
+@[simp] theorem mk_eq (x : pSet) : @eq Set ⟦x⟧ (mk x) := rfl
+@[simp] theorem mk_out : ∀ x : Set, mk x.out = x := quotient.out_eq
+theorem eq {x y : pSet} : mk x = mk y ↔ equiv x y := quotient.eq
+theorem sound {x y : pSet} (h : pSet.equiv x y) : mk x = mk y := quotient.sound h
+theorem exact {x y : pSet} : mk x = mk y → pSet.equiv x y := quotient.exact
+
+@[simp] lemma eval_mk {n f x} :
+  (@resp.eval (n+1) f : Set → arity Set n) (mk x) = resp.eval n (resp.f f x) :=
+rfl
+
+/-- The membership relation for ZFC sets is inherited from the membership relation for pre-sets. -/
+protected def mem : Set → Set → Prop :=
+quotient.lift₂ pSet.mem
+  (λ x y x' y' hx hy, propext ((mem.congr_left hx).trans (mem.congr_right hy)))
+
+instance : has_mem Set Set := ⟨Set.mem⟩
+
+@[simp] theorem mk_mem_iff {x y : pSet} : mk x ∈ mk y ↔ x ∈ y := iff.rfl
+
+/-- Convert a ZFC set into a `set` of ZFC sets -/
+def to_set (u : Set.{u}) : set Set.{u} := {x | x ∈ u}
+
+@[simp] theorem mem_to_set (a u : Set.{u}) : a ∈ u.to_set ↔ a ∈ u := iff.rfl
+
+instance small_to_set (x : Set.{u}) : small.{u} x.to_set :=
+quotient.induction_on x $ λ a, begin
+  let f : a.type → (mk a).to_set := λ i, ⟨mk $ a.func i, func_mem a i⟩,
+  suffices : function.surjective f,
+  { exact small_of_surjective this },
+  rintro ⟨y, hb⟩,
+  induction y using quotient.induction_on,
+  cases hb with i h,
+  exact ⟨i, subtype.coe_injective (quotient.sound h.symm)⟩
+end
+
+/-- A nonempty set is one that contains some element. -/
+protected def nonempty (u : Set) : Prop := u.to_set.nonempty
+
+theorem nonempty_def (u : Set) : u.nonempty ↔ ∃ x, x ∈ u := iff.rfl
+
+theorem nonempty_of_mem {x u : Set} (h : x ∈ u) : u.nonempty := ⟨x, h⟩
+
+@[simp] theorem nonempty_to_set_iff {u : Set} : u.to_set.nonempty ↔ u.nonempty := iff.rfl
+
+/-- `x ⊆ y` as ZFC sets means that all members of `x` are members of `y`. -/
+protected def subset (x y : Set.{u}) :=
+∀ ⦃z⦄, z ∈ x → z ∈ y
+
+instance has_subset : has_subset Set :=
+⟨Set.subset⟩
+
+lemma subset_def {x y : Set.{u}} : x ⊆ y ↔ ∀ ⦃z⦄, z ∈ x → z ∈ y := iff.rfl
+
+instance : is_refl Set (⊆) := ⟨λ x a, id⟩
+instance : is_trans Set (⊆) := ⟨λ x y z hxy hyz a ha, hyz (hxy ha)⟩
+
+@[simp] theorem subset_iff : Π {x y : pSet}, mk x ⊆ mk y ↔ x ⊆ y
+| ⟨α, A⟩ ⟨β, B⟩ := ⟨λ h a, @h ⟦A a⟧ (mem.mk A a),
+  λ h z, quotient.induction_on z (λ z ⟨a, za⟩, let ⟨b, ab⟩ := h a in ⟨b, za.trans ab⟩)⟩
+
+@[simp] theorem to_set_subset_iff {x y : Set} : x.to_set ⊆ y.to_set ↔ x ⊆ y :=
+by simp [subset_def, set.subset_def]
+
+@[ext] theorem ext {x y : Set.{u}} : (∀ z : Set.{u}, z ∈ x ↔ z ∈ y) → x = y :=
+quotient.induction_on₂ x y (λ u v h, quotient.sound (mem.ext (λ w, h ⟦w⟧)))
+
+theorem ext_iff {x y : Set.{u}} : x = y ↔ (∀ z : Set.{u}, z ∈ x ↔ z ∈ y) :=
+⟨λ h, by simp [h], ext⟩
+
+theorem to_set_injective : function.injective to_set := λ x y h, ext $ set.ext_iff.1 h
+
+@[simp] theorem to_set_inj {x y : Set} : x.to_set = y.to_set ↔ x = y :=
+to_set_injective.eq_iff
+
+instance : is_antisymm Set (⊆) := ⟨λ a b hab hba, ext $ λ c, ⟨@hab c, @hba c⟩⟩
+
+/-- The empty ZFC set -/
+protected def empty : Set := mk ∅
+instance : has_emptyc Set := ⟨Set.empty⟩
+instance : inhabited Set := ⟨∅⟩
+
+@[simp] theorem not_mem_empty (x) : x ∉ (∅ : Set.{u}) :=
+quotient.induction_on x pSet.not_mem_empty
+
+@[simp] theorem to_set_empty : to_set ∅ = ∅ := by simp [to_set]
+
+@[simp] theorem empty_subset (x : Set.{u}) : (∅ : Set) ⊆ x :=
+quotient.induction_on x $ λ y, subset_iff.2 $ pSet.empty_subset y
+
+@[simp] theorem not_nonempty_empty : ¬ Set.nonempty ∅ := by simp [Set.nonempty]
+
+@[simp] theorem nonempty_mk_iff {x : pSet} : (mk x).nonempty ↔ x.nonempty :=
+begin
+  refine ⟨_, λ ⟨a, h⟩, ⟨mk a, h⟩⟩,
+  rintro ⟨a, h⟩,
+  induction a using quotient.induction_on,
+  exact ⟨a, h⟩
+end
+
+theorem eq_empty (x : Set.{u}) : x = ∅ ↔ ∀ y : Set.{u}, y ∉ x := by { rw ext_iff, simp }
+
+theorem eq_empty_or_nonempty (u : Set) : u = ∅ ∨ u.nonempty :=
+by { rw [eq_empty, ←not_exists], apply em' }
+
+/-- `insert x y` is the set `{x} ∪ y` -/
+protected def insert : Set → Set → Set :=
+resp.eval 2 ⟨pSet.insert, λ u v uv ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
+  ⟨λ o, match o with
+   | some a := let ⟨b, hb⟩ := αβ a in ⟨some b, hb⟩
+   | none := ⟨none, uv⟩
+   end, λ o, match o with
+   | some b := let ⟨a, ha⟩ := βα b in ⟨some a, ha⟩
+   | none := ⟨none, uv⟩
+   end⟩⟩
+
+instance : has_insert Set Set := ⟨Set.insert⟩
+
+instance : has_singleton Set Set := ⟨λ x, insert x ∅⟩
+
+instance : is_lawful_singleton Set Set := ⟨λ x, rfl⟩
+
+@[simp] theorem mem_insert_iff {x y z : Set.{u}} : x ∈ insert y z ↔ x = y ∨ x ∈ z :=
+quotient.induction_on₃ x y z
+ (λ x y ⟨α, A⟩, show x ∈ pSet.mk (option α) (λ o, option.rec y A o) ↔
+    mk x = mk y ∨ x ∈ pSet.mk α A, from
+  ⟨λ m, match m with
+  | ⟨some a, ha⟩ := or.inr ⟨a, ha⟩
+  | ⟨none, h⟩ := or.inl (quotient.sound h)
+  end, λ m, match m with
+  | or.inr ⟨a, ha⟩ := ⟨some a, ha⟩
+  | or.inl h := ⟨none, quotient.exact h⟩
+  end⟩)
+
+theorem mem_insert (x y : Set) : x ∈ insert x y := mem_insert_iff.2 $ or.inl rfl
+theorem mem_insert_of_mem {y z : Set} (x) (h : z ∈ y): z ∈ insert x y := mem_insert_iff.2 $ or.inr h
+
+@[simp] theorem to_set_insert (x y : Set) : (insert x y).to_set = insert x y.to_set :=
+by { ext, simp }
+
+@[simp] theorem mem_singleton {x y : Set.{u}} : x ∈ @singleton Set.{u} Set.{u} _ y ↔ x = y :=
+iff.trans mem_insert_iff ⟨λ o, or.rec (λ h, h) (λ n, absurd n (not_mem_empty _)) o, or.inl⟩
+
+@[simp] theorem to_set_singleton (x : Set) : ({x} : Set).to_set = {x} :=
+by { ext, simp }
+
+theorem insert_nonempty (u v : Set) : (insert u v).nonempty := ⟨u, mem_insert u v⟩
+
+theorem singleton_nonempty (u : Set) : Set.nonempty {u} := insert_nonempty u ∅
+
+@[simp] theorem mem_pair {x y z : Set.{u}} : x ∈ ({y, z} : Set) ↔ x = y ∨ x = z :=
+iff.trans mem_insert_iff $ or_congr iff.rfl mem_singleton
+
+/-- `omega` is the first infinite von Neumann ordinal -/
+def omega : Set := mk omega
+
+@[simp] theorem omega_zero : ∅ ∈ omega :=
+⟨⟨0⟩, equiv.rfl⟩
+
+@[simp] theorem omega_succ {n} : n ∈ omega.{u} → insert n n ∈ omega.{u} :=
+quotient.induction_on n (λ x ⟨⟨n⟩, h⟩, ⟨⟨n+1⟩, Set.exact $
+  show insert (mk x) (mk x) = insert (mk $ of_nat n) (mk $ of_nat n), { rw Set.sound h, refl } ⟩)
+
+/-- `{x ∈ a | p x}` is the set of elements in `a` satisfying `p` -/
+protected def sep (p : Set → Prop) : Set → Set :=
+resp.eval 1 ⟨pSet.sep (λ y, p (mk y)), λ ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
+  ⟨λ ⟨a, pa⟩, let ⟨b, hb⟩ := αβ a in ⟨⟨b, by rwa [mk_func, ←Set.sound hb]⟩, hb⟩,
+   λ ⟨b, pb⟩, let ⟨a, ha⟩ := βα b in ⟨⟨a, by rwa [mk_func, Set.sound ha]⟩, ha⟩⟩⟩
+
+instance : has_sep Set Set := ⟨Set.sep⟩
+
+@[simp] theorem mem_sep {p : Set.{u} → Prop} {x y : Set.{u}} : y ∈ {y ∈ x | p y} ↔ y ∈ x ∧ p y :=
+quotient.induction_on₂ x y (λ ⟨α, A⟩ y,
+  ⟨λ ⟨⟨a, pa⟩, h⟩, ⟨⟨a, h⟩, by rwa (@quotient.sound pSet _ _ _ h)⟩,
+  λ ⟨⟨a, h⟩, pa⟩, ⟨⟨a, by { rw mk_func at h, rwa [mk_func, ←Set.sound h] }⟩, h⟩⟩)
+
+@[simp] theorem to_set_sep (a : Set) (p : Set → Prop) :
+  {x ∈ a | p x}.to_set = {x ∈ a.to_set | p x} :=
+by { ext, simp }
+
+/-- The powerset operation, the collection of subsets of a ZFC set -/
+def powerset : Set → Set :=
+resp.eval 1 ⟨powerset, λ ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
+  ⟨λ p, ⟨{b | ∃ a, p a ∧ equiv (A a) (B b)},
+    λ ⟨a, pa⟩, let ⟨b, ab⟩ := αβ a in ⟨⟨b, a, pa, ab⟩, ab⟩,
+    λ ⟨b, a, pa, ab⟩, ⟨⟨a, pa⟩, ab⟩⟩,
+   λ q, ⟨{a | ∃ b, q b ∧ equiv (A a) (B b)},
+    λ ⟨a, b, qb, ab⟩, ⟨⟨b, qb⟩, ab⟩,
+    λ ⟨b, qb⟩, let ⟨a, ab⟩ := βα b in ⟨⟨a, b, qb, ab⟩, ab⟩⟩⟩⟩
+
+@[simp] theorem mem_powerset {x y : Set.{u}} : y ∈ powerset x ↔ y ⊆ x :=
+quotient.induction_on₂ x y ( λ ⟨α, A⟩ ⟨β, B⟩,
+  show (⟨β, B⟩ : pSet.{u}) ∈ (pSet.powerset.{u} ⟨α, A⟩) ↔ _,
+    by simp [mem_powerset, subset_iff])
+
+theorem sUnion_lem {α β : Type u} (A : α → pSet) (B : β → pSet) (αβ : ∀ a, ∃ b, equiv (A a) (B b)) :
+  ∀ a, ∃ b, (equiv ((sUnion ⟨α, A⟩).func a) ((sUnion ⟨β, B⟩).func b))
+| ⟨a, c⟩ := let ⟨b, hb⟩ := αβ a in
+  begin
+    induction ea : A a with γ Γ,
+    induction eb : B b with δ Δ,
+    rw [ea, eb] at hb,
+    cases hb with γδ δγ,
+    exact
+    let c : type (A a) := c, ⟨d, hd⟩ := γδ (by rwa ea at c) in
+    have pSet.equiv ((A a).func c) ((B b).func (eq.rec d (eq.symm eb))), from
+    match A a, B b, ea, eb, c, d, hd with ._, ._, rfl, rfl, x, y, hd := hd end,
+    ⟨⟨b, by { rw mk_func, exact eq.rec d (eq.symm eb) }⟩, this⟩
+  end
+
+/-- The union operator, the collection of elements of elements of a ZFC set -/
+def sUnion : Set → Set :=
+resp.eval 1 ⟨pSet.sUnion, λ ⟨α, A⟩ ⟨β, B⟩ ⟨αβ, βα⟩,
+  ⟨sUnion_lem A B αβ, λ a, exists.elim (sUnion_lem B A (λ b,
+    exists.elim (βα b) (λ c hc, ⟨c, pSet.equiv.symm hc⟩)) a) (λ b hb, ⟨b, pSet.equiv.symm hb⟩)⟩⟩
+
+prefix (name := Set.sUnion) `⋃₀ `:110 := Set.sUnion
+
+/-- The intersection operator, the collection of elements in all of the elements of a ZFC set. We
+special-case `⋂₀ ∅ = ∅`. -/
+noncomputable def sInter (x : Set) : Set :=
+by { classical, exact dite x.nonempty (λ h, {y ∈ h.some | ∀ z ∈ x, y ∈ z}) (λ _, ∅) }
+
+prefix (name := Set.sInter) `⋂₀ `:110 := Set.sInter
+
+@[simp] theorem mem_sUnion {x y : Set.{u}} : y ∈ ⋃₀ x ↔ ∃ z ∈ x, y ∈ z :=
+quotient.induction_on₂ x y (λ x y, iff.trans mem_sUnion
+  ⟨λ ⟨z, h⟩, ⟨⟦z⟧, h⟩, λ ⟨z, h⟩, quotient.induction_on z (λ z h, ⟨z, h⟩) h⟩)
+
+theorem mem_sInter {x y : Set} (h : x.nonempty) : y ∈ ⋂₀ x ↔ ∀ z ∈ x, y ∈ z :=
+begin
+  rw [sInter, dif_pos h],
+  simp only [mem_to_set, mem_sep, and_iff_right_iff_imp],
+  exact λ H, H _ h.some_mem
+end
+
+@[simp] theorem sUnion_empty : ⋃₀ (∅ : Set) = ∅ := by { ext, simp }
+@[simp] theorem sInter_empty : ⋂₀ (∅ : Set) = ∅ := dif_neg $ by simp
+
+theorem mem_of_mem_sInter {x y z : Set} (hy : y ∈ ⋂₀ x) (hz : z ∈ x) : y ∈ z :=
+begin
+  rcases eq_empty_or_nonempty x with rfl | hx,
+  { exact (not_mem_empty z hz).elim },
+  { exact (mem_sInter hx).1 hy z hz }
+end
+
+theorem mem_sUnion_of_mem {x y z : Set} (hy : y ∈ z) (hz : z ∈ x) : y ∈ ⋃₀ x :=
+mem_sUnion.2 ⟨z, hz, hy⟩
+
+theorem not_mem_sInter_of_not_mem {x y z : Set} (hy : ¬ y ∈ z) (hz : z ∈ x) : ¬ y ∈ ⋂₀ x :=
+λ hx, hy $ mem_of_mem_sInter hx hz
+
+@[simp] theorem sUnion_singleton {x : Set.{u}} : ⋃₀ ({x} : Set) = x :=
+ext $ λ y, by simp_rw [mem_sUnion, exists_prop, mem_singleton, exists_eq_left]
+
+@[simp] theorem sInter_singleton {x : Set.{u}} : ⋂₀ ({x} : Set) = x :=
+ext $ λ y, by simp_rw [mem_sInter (singleton_nonempty x), mem_singleton, forall_eq]
+
+@[simp] theorem to_set_sUnion (x : Set.{u}) : (⋃₀ x).to_set = ⋃₀ (to_set '' x.to_set) :=
+by { ext, simp }
+
+theorem to_set_sInter {x : Set.{u}} (h : x.nonempty) : (⋂₀ x).to_set = ⋂₀ (to_set '' x.to_set) :=
+by { ext, simp [mem_sInter h] }
+
+theorem singleton_injective : function.injective (@singleton Set Set _) :=
+λ x y H, let this := congr_arg sUnion H in by rwa [sUnion_singleton, sUnion_singleton] at this
+
+@[simp] theorem singleton_inj {x y : Set} : ({x} : Set) = {y} ↔ x = y := singleton_injective.eq_iff
+
+/-- The binary union operation -/
+protected def union (x y : Set.{u}) : Set.{u} := ⋃₀ {x, y}
+
+/-- The binary intersection operation -/
+protected def inter (x y : Set.{u}) : Set.{u} := {z ∈ x | z ∈ y}
+
+/-- The set difference operation -/
+protected def diff (x y : Set.{u}) : Set.{u} := {z ∈ x | z ∉ y}
+
+instance : has_union Set := ⟨Set.union⟩
+instance : has_inter Set := ⟨Set.inter⟩
+instance : has_sdiff Set := ⟨Set.diff⟩
+
+@[simp] theorem to_set_union (x y : Set.{u}) : (x ∪ y).to_set = x.to_set ∪ y.to_set :=
+by { unfold has_union.union, rw Set.union, simp }
+
+@[simp] theorem to_set_inter (x y : Set.{u}) : (x ∩ y).to_set = x.to_set ∩ y.to_set :=
+by { unfold has_inter.inter, rw Set.inter, ext, simp }
+
+@[simp] theorem to_set_sdiff (x y : Set.{u}) : (x \ y).to_set = x.to_set \ y.to_set :=
+by { change {z ∈ x | z ∉ y}.to_set = _, ext, simp }
+
+@[simp] theorem mem_union {x y z : Set.{u}} : z ∈ x ∪ y ↔ z ∈ x ∨ z ∈ y :=
+by { rw ←mem_to_set, simp }
+
+@[simp] theorem mem_inter {x y z : Set.{u}} : z ∈ x ∩ y ↔ z ∈ x ∧ z ∈ y :=
+@@mem_sep (λ z : Set.{u}, z ∈ y)
+
+@[simp] theorem mem_diff {x y z : Set.{u}} : z ∈ x \ y ↔ z ∈ x ∧ z ∉ y :=
+@@mem_sep (λ z : Set.{u}, z ∉ y)
+
+@[simp] theorem sUnion_pair {x y : Set.{u}} : ⋃₀ ({x, y} : Set.{u}) = x ∪ y :=
+begin
+  ext,
+  simp_rw [mem_union, mem_sUnion, mem_pair],
+  split,
+  { rintro ⟨w, (rfl | rfl), hw⟩,
+    { exact or.inl hw },
+    { exact or.inr hw } },
+  { rintro (hz | hz),
+    { exact ⟨x, or.inl rfl, hz⟩ },
+    { exact ⟨y, or.inr rfl, hz⟩ } }
+end
+
+theorem mem_wf : @well_founded Set (∈) :=
+well_founded_lift₂_iff.mpr pSet.mem_wf
+
+/-- Induction on the `∈` relation. -/
+@[elab_as_eliminator]
+theorem induction_on {p : Set → Prop} (x) (h : ∀ x, (∀ y ∈ x, p y) → p x) : p x :=
+mem_wf.induction x h
+
+instance : has_well_founded Set := ⟨_, mem_wf⟩
+
+instance : is_asymm Set (∈) := mem_wf.is_asymm
+
+theorem mem_asymm {x y : Set} : x ∈ y → y ∉ x := asymm
+theorem mem_irrefl (x : Set) : x ∉ x := irrefl x
+
+theorem regularity (x : Set.{u}) (h : x ≠ ∅) : ∃ y ∈ x, x ∩ y = ∅ :=
+classical.by_contradiction $ λ ne, h $ (eq_empty x).2 $ λ y,
+induction_on y $ λ z (IH : ∀ w : Set.{u}, w ∈ z → w ∉ x), show z ∉ x, from λ zx,
+ne ⟨z, zx, (eq_empty _).2 (λ w wxz, let ⟨wx, wz⟩ := mem_inter.1 wxz in IH w wz wx)⟩
+
+/-- The image of a (definable) ZFC set function -/
+def image (f : Set → Set) [H : definable 1 f] : Set → Set :=
+let r := @definable.resp 1 f _ in
+resp.eval 1 ⟨image r.1, λ x y e, mem.ext $ λ z,
+  iff.trans (mem_image r.2) $ iff.trans (by exact
+   ⟨λ ⟨w, h1, h2⟩, ⟨w, (mem.congr_right e).1 h1, h2⟩,
+    λ ⟨w, h1, h2⟩, ⟨w, (mem.congr_right e).2 h1, h2⟩⟩) $
+  iff.symm (mem_image r.2)⟩
+
+theorem image.mk :
+  Π (f : Set.{u} → Set.{u}) [H : definable 1 f] (x) {y} (h : y ∈ x), f y ∈ @image f H x
+| ._ ⟨F⟩ x y := quotient.induction_on₂ x y $ λ ⟨α, A⟩ y ⟨a, ya⟩, ⟨a, F.2 _ _ ya⟩
+
+@[simp] theorem mem_image : Π {f : Set.{u} → Set.{u}} [H : definable 1 f] {x y : Set.{u}},
+  y ∈ @image f H x ↔ ∃ z ∈ x, f z = y
+| ._ ⟨F⟩ x y := quotient.induction_on₂ x y $ λ ⟨α, A⟩ y,
+  ⟨λ ⟨a, ya⟩, ⟨⟦A a⟧, mem.mk A a, eq.symm $ quotient.sound ya⟩,
+  λ ⟨z, hz, e⟩, e ▸ image.mk _ _ hz⟩
+
+@[simp] theorem to_set_image (f : Set → Set) [H : definable 1 f] (x : Set) :
+  (image f x).to_set = f '' x.to_set :=
+by { ext, simp }
+
+/-- The range of an indexed family of sets. The universes allow for a more general index type
+  without manual use of `ulift`. -/
+noncomputable def range {α : Type u} (f : α → Set.{max u v}) : Set.{max u v} :=
+⟦⟨ulift α, quotient.out ∘ f ∘ ulift.down⟩⟧
+
+@[simp] theorem mem_range {α : Type u} {f : α → Set.{max u v}} {x : Set.{max u v}} :
+  x ∈ range f ↔ x ∈ set.range f :=
+quotient.induction_on x (λ y, begin
+  split,
+  { rintro ⟨z, hz⟩,
+    exact ⟨z.down, quotient.eq_mk_iff_out.2 hz.symm⟩ },
+  { rintro ⟨z, hz⟩,
+    use z,
+    simpa [hz] using pSet.equiv.symm (quotient.mk_out y) }
+end)
+
+@[simp] theorem to_set_range {α : Type u} (f : α → Set.{max u v}) :
+  (range f).to_set = set.range f :=
+by { ext, simp }
+
+/-- Kuratowski ordered pair -/
+def pair (x y : Set.{u}) : Set.{u} := {{x}, {x, y}}
+
+@[simp] theorem to_set_pair (x y : Set.{u}) : (pair x y).to_set = {{x}, {x, y}} := by simp [pair]
+
+/-- A subset of pairs `{(a, b) ∈ x × y | p a b}` -/
+def pair_sep (p : Set.{u} → Set.{u} → Prop) (x y : Set.{u}) : Set.{u} :=
+{z ∈ powerset (powerset (x ∪ y)) | ∃ a ∈ x, ∃ b ∈ y, z = pair a b ∧ p a b}
+
+@[simp] theorem mem_pair_sep {p} {x y z : Set.{u}} :
+  z ∈ pair_sep p x y ↔ ∃ a ∈ x, ∃ b ∈ y, z = pair a b ∧ p a b :=
+begin
+  refine mem_sep.trans ⟨and.right, λ e, ⟨_, e⟩⟩,
+  rcases e with ⟨a, ax, b, bY, rfl, pab⟩,
+  simp only [mem_powerset, subset_def, mem_union, pair, mem_pair],
+  rintros u (rfl|rfl) v; simp only [mem_singleton, mem_pair],
+  { rintro rfl, exact or.inl ax },
+  { rintro (rfl|rfl); [left, right]; assumption }
+end
+
+theorem pair_injective : function.injective2 pair :=
+λ x x' y y' H, begin
+  have ae := ext_iff.1 H,
+  simp only [pair, mem_pair] at ae,
+  obtain rfl : x = x',
+  { cases (ae {x}).1 (by simp) with h h,
+    { exact singleton_injective h },
+    { have m : x' ∈ ({x} : Set),
+      { simp [h] },
+      rw mem_singleton.mp m } },
+  have he : x = y → y = y',
+  { rintro rfl,
+    cases (ae {x, y'}).2 (by simp only [eq_self_iff_true, or_true]) with xy'x xy'xx,
+    { rw [eq_comm, ←mem_singleton, ←xy'x, mem_pair],
+      exact or.inr rfl },
+    { simpa [eq_comm] using (ext_iff.1 xy'xx y').1 (by simp) } },
+  obtain xyx | xyy' := (ae {x, y}).1 (by simp),
+  { obtain rfl := mem_singleton.mp ((ext_iff.1 xyx y).1 $ by simp),
+    simp [he rfl] },
+  { obtain rfl | yy' := mem_pair.mp ((ext_iff.1 xyy' y).1 $ by simp),
+    { simp [he rfl] },
+    { simp [yy'] } }
+end
+
+@[simp] theorem pair_inj {x y x' y' : Set} : pair x y = pair x' y' ↔ x = x' ∧ y = y' :=
+pair_injective.eq_iff
+
+/-- The cartesian product, `{(a, b) | a ∈ x, b ∈ y}` -/
+def prod : Set.{u} → Set.{u} → Set.{u} := pair_sep (λ a b, true)
+
+@[simp] theorem mem_prod {x y z : Set.{u}} : z ∈ prod x y ↔ ∃ a ∈ x, ∃ b ∈ y, z = pair a b :=
+by simp [prod]
+
+@[simp] theorem pair_mem_prod {x y a b : Set.{u}} : pair a b ∈ prod x y ↔ a ∈ x ∧ b ∈ y :=
+⟨λ h, let ⟨a', a'x, b', b'y, e⟩ := mem_prod.1 h in
+  match a', b', pair_injective e, a'x, b'y with ._, ._, ⟨rfl, rfl⟩, ax, bY := ⟨ax, bY⟩ end,
+λ ⟨ax, bY⟩, mem_prod.2 ⟨a, ax, b, bY, rfl⟩⟩
+
+/-- `is_func x y f` is the assertion that `f` is a subset of `x × y` which relates to each element
+of `x` a unique element of `y`, so that we can consider `f`as a ZFC function `x → y`. -/
+def is_func (x y f : Set.{u}) : Prop :=
+f ⊆ prod x y ∧ ∀ z : Set.{u}, z ∈ x → ∃! w, pair z w ∈ f
+
+/-- `funs x y` is `y ^ x`, the set of all set functions `x → y` -/
+def funs (x y : Set.{u}) : Set.{u} :=
+{f ∈ powerset (prod x y) | is_func x y f}
+
+@[simp] theorem mem_funs {x y f : Set.{u}} : f ∈ funs x y ↔ is_func x y f :=
+by simp [funs, is_func]
+
+-- TODO(Mario): Prove this computably
+noncomputable instance map_definable_aux (f : Set → Set) [H : definable 1 f] :
+  definable 1 (λ y, pair y (f y)) :=
+@classical.all_definable 1 _
+
+/-- Graph of a function: `map f x` is the ZFC function which maps `a ∈ x` to `f a` -/
+noncomputable def map (f : Set → Set) [H : definable 1 f] : Set → Set :=
+image (λ y, pair y (f y))
+
+@[simp] theorem mem_map {f : Set → Set} [H : definable 1 f] {x y : Set} :
+  y ∈ map f x ↔ ∃ z ∈ x, pair z (f z) = y :=
+mem_image
+
+theorem map_unique {f : Set.{u} → Set.{u}} [H : definable 1 f] {x z : Set.{u}} (zx : z ∈ x) :
+  ∃! w, pair z w ∈ map f x :=
+⟨f z, image.mk _ _ zx, λ y yx, let ⟨w, wx, we⟩ := mem_image.1 yx, ⟨wz, fy⟩ := pair_injective we in
+  by rw[←fy, wz]⟩
+
+@[simp] theorem map_is_func {f : Set → Set} [H : definable 1 f] {x y : Set} :
+  is_func x y (map f x) ↔ ∀ z ∈ x, f z ∈ y :=
+⟨λ ⟨ss, h⟩ z zx, let ⟨t, t1, t2⟩ := h z zx in
+  (t2 (f z) (image.mk _ _ zx)).symm ▸ (pair_mem_prod.1 (ss t1)).right,
+λ h, ⟨λ y yx, let ⟨z, zx, ze⟩ := mem_image.1 yx in ze ▸ pair_mem_prod.2 ⟨zx, h z zx⟩,
+     λ z, map_unique⟩⟩
+
+/-- Given a predicate `p` on ZFC sets. `hereditarily p x` means that `x` has property `p` and the
+members of `x` are all `hereditarily p`. -/
+def hereditarily (p : Set → Prop) : Set → Prop
+| x := p x ∧ ∀ y ∈ x, hereditarily y
+using_well_founded { dec_tac := `[assumption] }
+
+section hereditarily
+
+variables {p : Set.{u} → Prop} {x y : Set.{u}}
+
+lemma hereditarily_iff :
+  hereditarily p x ↔ p x ∧ ∀ y ∈ x, hereditarily p y :=
+by rw [← hereditarily]
+
+alias hereditarily_iff ↔ hereditarily.def _
+
+lemma hereditarily.self (h : x.hereditarily p) : p x := h.def.1
+lemma hereditarily.mem (h : x.hereditarily p) (hy : y ∈ x) : y.hereditarily p := h.def.2 _ hy
+
+lemma hereditarily.empty : hereditarily p x → p ∅ :=
+begin
+  apply x.induction_on,
+  intros y IH h,
+  rcases Set.eq_empty_or_nonempty y with (rfl|⟨a, ha⟩),
+  { exact h.self },
+  { exact IH a ha (h.mem ha) }
+end
+
+end hereditarily
+
+end Set
+
+/-- The collection of all classes.
+
+We define `Class` as `set Set`, as this allows us to get many instances automatically. However, in
+practice, we treat it as (the definitionally equal) `Set → Prop`. This means, the preferred way to
+state that `x : Set` belongs to `A : Class` is to write `A x`. -/
+@[derive [has_subset, has_sep Set, has_emptyc, inhabited, has_insert Set, has_union, has_inter,
+  has_compl, has_sdiff]]
+def Class := set Set
+
+namespace Class
+
+@[ext] theorem ext {x y : Class.{u}} : (∀ z : Set.{u}, x z ↔ y z) → x = y := set.ext
+
+theorem ext_iff {x y : Class.{u}} : x = y ↔ ∀ z, x z ↔ y z := set.ext_iff
+
+/-- Coerce a ZFC set into a class -/
+def of_Set (x : Set.{u}) : Class.{u} := {y | y ∈ x}
+instance : has_coe Set Class := ⟨of_Set⟩
+
+/-- The universal class -/
+def univ : Class := set.univ
+
+/-- Assert that `A` is a ZFC set satisfying `B` -/
+def to_Set (B : Class.{u}) (A : Class.{u}) : Prop := ∃ x, ↑x = A ∧ B x
+
+/-- `A ∈ B` if `A` is a ZFC set which satisfies `B` -/
+protected def mem (A B : Class.{u}) : Prop := to_Set.{u} B A
+instance : has_mem Class Class := ⟨Class.mem⟩
+
+theorem mem_def (A B : Class.{u}) : A ∈ B ↔ ∃ x, ↑x = A ∧ B x := iff.rfl
+
+@[simp] theorem not_mem_empty (x : Class.{u}) : x ∉ (∅ : Class.{u}) := λ ⟨_, _, h⟩, h
+
+@[simp] theorem not_empty_hom (x : Set.{u}) : ¬ (∅ : Class.{u}) x := id
+
+@[simp] theorem mem_univ {A : Class.{u}} : A ∈ univ.{u} ↔ ∃ x : Set.{u}, ↑x = A :=
+exists_congr $ λ x, and_true _
+
+@[simp] theorem mem_univ_hom (x : Set.{u}) : univ.{u} x := trivial
+
+theorem eq_univ_iff_forall {A : Class.{u}} : A = univ ↔ ∀ x : Set, A x := set.eq_univ_iff_forall
+theorem eq_univ_of_forall {A : Class.{u}} : (∀ x : Set, A x) → A = univ := set.eq_univ_of_forall
+
+theorem mem_wf : @well_founded Class.{u} (∈) :=
+⟨begin
+  have H : ∀ x : Set.{u}, @acc Class.{u} (∈) ↑x,
+  { refine λ a, Set.induction_on a (λ x IH, ⟨x, _⟩),
+    rintros A ⟨z, rfl, hz⟩,
+    exact IH z hz },
+  { refine λ A, ⟨A, _⟩,
+    rintros B ⟨x, rfl, hx⟩,
+    exact H x }
+end⟩
+
+instance : has_well_founded Class := ⟨_, mem_wf⟩
+instance : is_asymm Class (∈) := mem_wf.is_asymm
+
+theorem mem_asymm {x y : Class} : x ∈ y → y ∉ x := asymm
+theorem mem_irrefl (x : Class) : x ∉ x := irrefl x
+
+/-- **There is no universal set.**
+
+This is stated as `univ ∉ univ`, meaning that `univ` (the class of all sets) is proper (does not
+belong to the class of all sets). -/
+theorem univ_not_mem_univ : univ ∉ univ := mem_irrefl _
+
+/-- Convert a conglomerate (a collection of classes) into a class -/
+def Cong_to_Class (x : set Class.{u}) : Class.{u} := {y | ↑y ∈ x}
+
+@[simp] theorem Cong_to_Class_empty : Cong_to_Class ∅ = ∅ :=
+by { ext, simp [Cong_to_Class] }
+
+/-- Convert a class into a conglomerate (a collection of classes) -/
+def Class_to_Cong (x : Class.{u}) : set Class.{u} := {y | y ∈ x}
+
+@[simp] theorem Class_to_Cong_empty : Class_to_Cong ∅ = ∅ :=
+by { ext, simp [Class_to_Cong] }
+
+/-- The power class of a class is the class of all subclasses that are ZFC sets -/
+def powerset (x : Class) : Class := Cong_to_Class (set.powerset x)
+
+/-- The union of a class is the class of all members of ZFC sets in the class -/
+def sUnion (x : Class) : Class := ⋃₀ (Class_to_Cong x)
+
+prefix (name := Class.sUnion) `⋃₀ `:110 := Class.sUnion
+
+/-- The intersection of a class is the class of all members of ZFC sets in the class -/
+def sInter (x : Class) : Class := ⋂₀ Class_to_Cong x
+
+prefix (name := Class.sInter) `⋂₀ `:110 := Class.sInter
+
+theorem of_Set.inj {x y : Set.{u}} (h : (x : Class.{u}) = y) : x = y :=
+Set.ext $ λ z, by { change (x : Class.{u}) z ↔ (y : Class.{u}) z, rw h }
+
+@[simp] theorem to_Set_of_Set (A : Class.{u}) (x : Set.{u}) : to_Set A x ↔ A x :=
+⟨λ ⟨y, yx, py⟩, by rwa of_Set.inj yx at py, λ px, ⟨x, rfl, px⟩⟩
+
+@[simp, norm_cast] theorem coe_mem {x : Set.{u}} {A : Class.{u}} : (x : Class.{u}) ∈ A ↔ A x :=
+to_Set_of_Set _ _
+
+@[simp] theorem coe_apply {x y : Set.{u}} : (y : Class.{u}) x ↔ x ∈ y := iff.rfl
+
+@[simp, norm_cast] theorem coe_subset (x y : Set.{u}) : (x : Class.{u}) ⊆ y ↔ x ⊆ y := iff.rfl
+
+@[simp, norm_cast] theorem coe_sep (p : Class.{u}) (x : Set.{u}) :
+  (↑{y ∈ x | p y} : Class.{u}) = {y ∈ x | p y} :=
+ext $ λ y, Set.mem_sep
+
+@[simp, norm_cast] theorem coe_empty : ↑(∅ : Set.{u}) = (∅ : Class.{u}) :=
+ext $ λ y, (iff_false _).2 $ Set.not_mem_empty y
+
+@[simp, norm_cast] theorem coe_insert (x y : Set.{u}) :
+  ↑(insert x y) = @insert Set.{u} Class.{u} _ x y :=
+ext $ λ z, Set.mem_insert_iff
+
+@[simp, norm_cast] theorem coe_union (x y : Set.{u}) : ↑(x ∪ y) = (x : Class.{u}) ∪ y :=
+ext $ λ z, Set.mem_union
+
+@[simp, norm_cast] theorem coe_inter (x y : Set.{u}) : ↑(x ∩ y) = (x : Class.{u}) ∩ y :=
+ext $ λ z, Set.mem_inter
+
+@[simp, norm_cast] theorem coe_diff (x y : Set.{u}) : ↑(x \ y) = (x : Class.{u}) \ y :=
+ext $ λ z, Set.mem_diff
+
+@[simp, norm_cast] theorem coe_powerset (x : Set.{u}) : ↑x.powerset = powerset.{u} x :=
+ext $ λ z, Set.mem_powerset
+
+@[simp] theorem powerset_apply {A : Class.{u}} {x : Set.{u}} : powerset A x ↔ ↑x ⊆ A := iff.rfl
+
+@[simp] theorem sUnion_apply {x : Class} {y : Set} : (⋃₀ x) y ↔ ∃ z : Set, x z ∧ y ∈ z :=
+begin
+  split,
+  { rintro ⟨-, ⟨z, rfl, hxz⟩, hyz⟩,
+    exact ⟨z, hxz, hyz⟩ },
+  { exact λ ⟨z, hxz, hyz⟩, ⟨_, coe_mem.2 hxz, hyz⟩ }
+end
+
+@[simp, norm_cast] theorem coe_sUnion (x : Set.{u}) : ↑(⋃₀ x) = ⋃₀ (x : Class.{u}) :=
+ext $ λ y, Set.mem_sUnion.trans (sUnion_apply.trans $ by simp_rw [coe_apply, exists_prop]).symm
+
+@[simp] theorem mem_sUnion {x y : Class.{u}} : y ∈ ⋃₀ x ↔ ∃ z, z ∈ x ∧ y ∈ z :=
+begin
+  split,
+  { rintro ⟨w, rfl, z, hzx, hwz⟩,
+    exact ⟨z, hzx, coe_mem.2 hwz⟩ },
+  { rintro ⟨w, hwx, z, rfl, hwz⟩,
+    exact ⟨z, rfl, w, hwx, hwz⟩ }
+end
+
+@[simp] theorem sInter_apply {x : Class.{u}} {y : Set.{u}} :
+  (⋂₀ x) y ↔ ∀ z : Set.{u}, x z → y ∈ z :=
+begin
+  refine ⟨λ hxy z hxz, hxy _ ⟨z, rfl, hxz⟩, _⟩,
+  rintro H - ⟨z, rfl, hxz⟩,
+  exact H _ hxz
+end
+
+@[simp, norm_cast] theorem coe_sInter {x : Set.{u}} (h : x.nonempty) :
+  ↑(⋂₀ x) = ⋂₀ (x : Class.{u}) :=
+set.ext $ λ y, (Set.mem_sInter h).trans sInter_apply.symm
+
+theorem mem_of_mem_sInter {x y z : Class} (hy : y ∈ ⋂₀ x) (hz : z ∈ x) : y ∈ z :=
+by { obtain ⟨w, rfl, hw⟩ := hy, exact coe_mem.2 (hw z hz) }
+
+theorem mem_sInter {x y : Class.{u}} (h : x.nonempty) : y ∈ ⋂₀ x ↔ ∀ z, z ∈ x → y ∈ z :=
+begin
+  refine ⟨λ hy z, mem_of_mem_sInter hy, λ H, _⟩,
+  simp_rw [mem_def, sInter_apply],
+  obtain ⟨z, hz⟩ := h,
+  obtain ⟨y, rfl, hzy⟩ := H z (coe_mem.2 hz),
+  refine ⟨y, rfl, λ w hxw, _⟩,
+  simpa only [coe_mem, coe_apply] using H w (coe_mem.2 hxw),
+end
+
+@[simp] theorem sUnion_empty : ⋃₀ (∅ : Class.{u}) = ∅ := by { ext, simp }
+@[simp] theorem sInter_empty : ⋂₀ (∅ : Class.{u}) = univ := by { ext, simp [sInter, ←univ] }
+
+/-- An induction principle for sets. If every subset of a class is a member, then the class is
+  universal. -/
+theorem eq_univ_of_powerset_subset {A : Class} (hA : powerset A ⊆ A) : A = univ :=
+eq_univ_of_forall begin
+  by_contra' hnA,
+  exact well_founded.min_mem Set.mem_wf _ hnA (hA $ λ x hx, not_not.1 $
+    λ hB, well_founded.not_lt_min Set.mem_wf _ hnA hB $ coe_apply.1 hx)
+end
+
+/-- The definite description operator, which is `{x}` if `{y | A y} = {x}` and `∅` otherwise. -/
+def iota (A : Class) : Class := ⋃₀ {x | ∀ y, A y ↔ y = x}
+
+theorem iota_val (A : Class) (x : Set) (H : ∀ y, A y ↔ y = x) : iota A = ↑x :=
+ext $ λ y, ⟨λ ⟨._, ⟨x', rfl, h⟩, yx'⟩, by rwa ←((H x').1 $ (h x').2 rfl),
+  λ yx, ⟨_, ⟨x, rfl, H⟩, yx⟩⟩
+
+/-- Unlike the other set constructors, the `iota` definite descriptor
+  is a set for any set input, but not constructively so, so there is no
+  associated `Class → Set` function. -/
+theorem iota_ex (A) : iota.{u} A ∈ univ.{u} :=
+mem_univ.2 $ or.elim (classical.em $ ∃ x, ∀ y, A y ↔ y = x)
+ (λ ⟨x, h⟩, ⟨x, eq.symm $ iota_val A x h⟩)
+ (λ hn, ⟨∅, ext (λ z, coe_empty.symm ▸ ⟨false.rec _, λ ⟨._, ⟨x, rfl, H⟩, zA⟩, hn ⟨x, H⟩⟩)⟩)
+
+/-- Function value -/
+def fval (F A : Class.{u}) : Class.{u} := iota (λ y, to_Set (λ x, F (Set.pair x y)) A)
+infixl ` ′ `:100 := fval
+
+theorem fval_ex (F A : Class.{u}) : F ′ A ∈ univ.{u} := iota_ex _
+
+end Class
+
+namespace Set
+
+@[simp] theorem map_fval {f : Set.{u} → Set.{u}} [H : pSet.definable 1 f]
+  {x y : Set.{u}} (h : y ∈ x) :
+  (Set.map f x ′ y : Class.{u}) = f y :=
+Class.iota_val _ _ (λ z, by { rw [Class.to_Set_of_Set, Class.coe_apply, mem_map], exact
+  ⟨λ ⟨w, wz, pr⟩, let ⟨wy, fw⟩ := Set.pair_injective pr in by rw[←fw, wy],
+  λ e, by { subst e, exact ⟨_, h, rfl⟩ }⟩ })
+
+variables (x : Set.{u}) (h : ∅ ∉ x)
+
+/-- A choice function on the class of nonempty ZFC sets. -/
+noncomputable def choice : Set :=
+@map (λ y, classical.epsilon (λ z, z ∈ y)) (classical.all_definable _) x
+
+include h
+theorem choice_mem_aux (y : Set.{u}) (yx : y ∈ x) : classical.epsilon (λ z : Set.{u}, z ∈ y) ∈ y :=
+@classical.epsilon_spec _ (λ z : Set.{u}, z ∈ y) $ classical.by_contradiction $ λ n, h $
+by rwa ←((eq_empty y).2 $ λ z zx, n ⟨z, zx⟩)
+
+theorem choice_is_func : is_func x (⋃₀ x) (choice x) :=
+(@map_is_func _ (classical.all_definable _) _ _).2 $
+  λ y yx, mem_sUnion.2 ⟨y, yx, choice_mem_aux x h y yx⟩
+
+theorem choice_mem (y : Set.{u}) (yx : y ∈ x) : (choice x ′ y : Class.{u}) ∈ (y : Class.{u}) :=
+begin
+  delta choice,
+  rw [map_fval yx, Class.coe_mem, Class.coe_apply],
+  exact choice_mem_aux x h y yx
+end
+
+end Set
diff --git a/src/set_theory/zfc/ordinal.lean b/src/set_theory/zfc/ordinal.lean
new file mode 100644
index 0000000000000..0a3080e266bb9
--- /dev/null
+++ b/src/set_theory/zfc/ordinal.lean
@@ -0,0 +1,90 @@
+/-
+Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Violeta Hernández Palacios
+-/
+
+import set_theory.zfc.basic
+
+/-!
+# Von Neumann ordinals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file works towards the development of von Neumann ordinals, i.e. transitive sets, well-ordered
+under `∈`. We currently only have an initial development of transitive sets.
+
+Further development can be found on the branch `von_neumann_v2`.
+
+## Definitions
+
+- `Set.is_transitive` means that every element of a set is a subset.
+
+## Todo
+
+- Define von Neumann ordinals.
+- Define the basic arithmetic operations on ordinals from a purely set-theoretic perspective.
+- Prove the equivalences between these definitions and those provided in
+  `set_theory/ordinal/arithmetic.lean`.
+-/
+
+universe u
+
+variables {x y z : Set.{u}}
+
+namespace Set
+
+/-- A transitive set is one where every element is a subset. -/
+def is_transitive (x : Set) : Prop := ∀ y ∈ x, y ⊆ x
+
+@[simp] theorem empty_is_transitive : is_transitive ∅ := λ y hy, (not_mem_empty y hy).elim
+
+theorem is_transitive.subset_of_mem (h : x.is_transitive) : y ∈ x → y ⊆ x := h y
+
+theorem is_transitive_iff_mem_trans : z.is_transitive ↔ ∀ {x y : Set}, x ∈ y → y ∈ z → x ∈ z :=
+⟨λ h x y hx hy, h.subset_of_mem hy hx, λ H x hx y hy, H hy hx⟩
+
+alias is_transitive_iff_mem_trans ↔ is_transitive.mem_trans _
+
+protected theorem is_transitive.inter (hx : x.is_transitive) (hy : y.is_transitive) :
+  (x ∩ y).is_transitive :=
+λ z hz w hw, by { rw mem_inter at hz ⊢, exact ⟨hx.mem_trans hw hz.1, hy.mem_trans hw hz.2⟩ }
+
+protected theorem is_transitive.sUnion (h : x.is_transitive) : (⋃₀ x).is_transitive :=
+λ y hy z hz, begin
+  rcases mem_sUnion.1 hy with ⟨w, hw, hw'⟩,
+  exact mem_sUnion_of_mem hz (h.mem_trans hw' hw)
+end
+
+theorem is_transitive.sUnion' (H : ∀ y ∈ x, is_transitive y) : (⋃₀ x).is_transitive :=
+λ y hy z hz, begin
+  rcases mem_sUnion.1 hy with ⟨w, hw, hw'⟩,
+  exact mem_sUnion_of_mem ((H w hw).mem_trans hz hw') hw
+end
+
+protected theorem is_transitive.union (hx : x.is_transitive) (hy : y.is_transitive) :
+  (x ∪ y).is_transitive :=
+begin
+  rw ←sUnion_pair,
+  apply is_transitive.sUnion' (λ z, _),
+  rw mem_pair,
+  rintro (rfl | rfl),
+  assumption'
+end
+
+protected theorem is_transitive.powerset (h : x.is_transitive) : (powerset x).is_transitive :=
+λ y hy z hz, by { rw mem_powerset at ⊢ hy, exact h.subset_of_mem (hy hz) }
+
+theorem is_transitive_iff_sUnion_subset : x.is_transitive ↔ ⋃₀ x ⊆ x :=
+⟨λ h y hy, by { rcases mem_sUnion.1 hy with ⟨z, hz, hz'⟩, exact h.mem_trans hz' hz },
+  λ H y hy z hz, H $ mem_sUnion_of_mem hz hy⟩
+
+alias is_transitive_iff_sUnion_subset ↔ is_transitive.sUnion_subset _
+
+theorem is_transitive_iff_subset_powerset : x.is_transitive ↔ x ⊆ powerset x :=
+⟨λ h y hy, mem_powerset.2 $ h.subset_of_mem hy, λ H y hy z hz, mem_powerset.1 (H hy) hz⟩
+
+alias is_transitive_iff_subset_powerset ↔ is_transitive.subset_powerset _
+
+end Set
diff --git a/src/tactic/abel.lean b/src/tactic/abel.lean
index 61d7cb6b7c917..a7fb931bd1e6e 100644
--- a/src/tactic/abel.lean
+++ b/src/tactic/abel.lean
@@ -181,7 +181,7 @@ by simp [h₂.symm, h₁.symm, termg]; ac_refl
 
 meta def eval_neg (c : context) : normal_expr → tactic (normal_expr × expr)
 | (zero e) := do
-  p ← c.mk_app ``neg_zero ``add_group [],
+  p ← c.mk_app ``neg_zero ``neg_zero_class [],
   return (zero' c, p)
 | (nterm e n x a) := do
   (n', h₁) ← mk_app ``has_neg.neg [n.1] >>= norm_num.eval_field,
@@ -189,6 +189,10 @@ meta def eval_neg (c : context) : normal_expr → tactic (normal_expr × expr)
   return (term' c (n', -n.2) x a',
     c.app ``term_neg c.inst [n.1, x, a, n', a', h₁, h₂])
 
+def nat_smul_inst {α} [add_comm_monoid α] : has_smul ℕ α := by apply_instance
+def nat_smul_instg {α} [add_comm_group α] : has_smul ℕ α := by apply_instance
+def int_smul_instg {α} [add_comm_group α] : has_smul ℤ α := by apply_instance
+
 def smul {α} [add_comm_monoid α] (n : ℕ) (x : α) : α := n • x
 def smulg {α} [add_comm_group α] (n : ℤ) (x : α) : α := n • x
 
@@ -227,8 +231,7 @@ meta def eval_atom (c : context) (e : expr) : tactic (normal_expr × expr) :=
 do n1 ← c.int_to_expr 1,
    return (term' c (n1, 1) e (zero' c), c.iapp ``term_atom [e])
 
-lemma unfold_sub {α} [add_group α] (a b c : α)
-  (h : a + -b = c) : a - b = c :=
+lemma unfold_sub {α} [subtraction_monoid α] (a b c : α) (h : a + -b = c) : a - b = c :=
 by rw [sub_eq_add_neg, h]
 
 theorem unfold_smul {α} [add_comm_monoid α] (n) (x y : α)
@@ -295,7 +298,7 @@ meta def eval (c : context) : expr → tactic (normal_expr × expr)
   e₂' ← mk_app ``has_neg.neg [e₂],
   e ← mk_app ``has_add.add [e₁, e₂'],
   (e', p) ← eval e,
-  p' ← c.mk_app ``unfold_sub ``add_group [e₁, e₂, e', p],
+  p' ← c.mk_app ``unfold_sub ``subtraction_monoid [e₁, e₂, e', p],
   return (e', p')
 | `(- %%e) := do
   (e₁, p₁) ← eval e,
@@ -310,10 +313,18 @@ meta def eval (c : context) : expr → tactic (normal_expr × expr)
   guardb c.is_group,
   (e', p) ← eval $ c.iapp ``smul [e₁, e₂],
   return (e', c.app ``unfold_zsmul c.inst [e₁, e₂, e', p])
-| e@`(@has_scalar.smul nat _ add_monoid.has_scalar_nat %%e₁ %%e₂) :=
-  eval_smul' c eval ff e e₁ e₂
-| e@`(@has_scalar.smul int _ sub_neg_monoid.has_scalar_int %%e₁ %%e₂) :=
-  eval_smul' c eval tt e e₁ e₂
+| e@`(@has_smul.smul nat %%α %%inst %%e₁ %%e₂) := do
+  let inst' := c.iapp ``nat_smul_inst [],
+  mcond (succeeds (is_def_eq inst inst'))
+    (eval_smul' c eval ff e e₁ e₂)
+    (eval_atom c e)
+| e@`(@has_smul.smul int %%α %%inst %%e₁ %%e₂) := do
+  -- if we're not a group there's no canonical instance available
+  tt ← pure c.is_group | eval_atom c e,
+  let inst' := c.app ``int_smul_instg c.inst [],
+  mcond (succeeds (is_def_eq inst inst'))
+    (eval_smul' c eval tt e e₁ e₂)
+    (eval_atom c e)
 | e@`(smul %%e₁ %%e₂) := eval_smul' c eval ff e e₁ e₂
 | e@`(smulg %%e₁ %%e₂) := eval_smul' c eval tt e e₁ e₂
 | e@`(@has_zero.zero _ _) := mcond (succeeds (is_def_eq e c.α0))
diff --git a/src/tactic/alias.lean b/src/tactic/alias.lean
index a4fe87f82de47..26cecb414a268 100644
--- a/src/tactic/alias.lean
+++ b/src/tactic/alias.lean
@@ -49,9 +49,9 @@ namespace tactic.alias
 /-- An alias can be in one of three forms -/
 @[derive has_reflect]
 meta inductive target
-| plain : name -> target
-| forward : name -> target
-| backwards : name -> target
+| plain : name → target
+| forward : name → target
+| backwards : name → target
 
 /-- The name underlying an alias target -/
 meta def target.to_name : target → name
@@ -61,14 +61,16 @@ meta def target.to_name : target → name
 
 /-- The docstring for an alias. Used by `alias` _and_ by `to_additive` -/
 meta def target.to_string : target → string
-| (target.plain n) := sformat!"**Alias** of {n}`."
-| (target.forward n) := sformat!"**Alias** of the forward direction of {n}`."
-| (target.backwards n) := sformat!"**Alias** of the reverse direction of {n}`."
+| (target.plain n) := sformat!"**Alias** of `{n}`."
+| (target.forward n) := sformat!"**Alias** of the forward direction of `{n}`."
+| (target.backwards n) := sformat!"**Alias** of the reverse direction of `{n}`."
 
+/-- An auxiliary attribute which is placed on definitions created by the `alias` command. -/
 @[user_attribute] meta def alias_attr : user_attribute unit target :=
 { name := `alias, descr := "This definition is an alias of another.", parser := failed }
 
-meta def alias_direct (d : declaration) (al : name) : tactic unit :=
+/-- The core tactic which handles `alias d ← al`. Creates an alias `al` for declaration `d`. -/
+meta def alias_direct (doc : option string) (d : declaration) (al : name) : tactic unit :=
 do updateex_env $ λ env,
   env.add (match d.to_definition with
   | declaration.defn n ls t _ _ _ :=
@@ -80,25 +82,34 @@ do updateex_env $ λ env,
   end),
   let target := target.plain d.to_name,
   alias_attr.set al target tt,
-  add_doc_string al target.to_string
+  add_doc_string al (doc.get_or_else target.to_string)
 
+/-- Given a proof of `Π x y z, a ↔ b`, produces a proof of `Π x y z, a → b` or `Π x y z, b → a`
+(depending on whether `iffmp` is `iff.mp` or `iff.mpr`). The variable `f` supplies the proof,
+under the specified number of binders. -/
 meta def mk_iff_mp_app (iffmp : name) : expr → (ℕ → expr) → tactic expr
 | (expr.pi n bi e t) f := expr.lam n bi e <$> mk_iff_mp_app t (λ n, f (n+1) (expr.var n))
 | `(%%a ↔ %%b) f := pure $ @expr.const tt iffmp [] a b (f 0)
 | _ f := fail "Target theorem must have the form `Π x y z, a ↔ b`"
 
-meta def alias_iff (d : declaration) (al : name) (is_forward : bool) : tactic unit :=
-(if al = `_ then skip else get_decl al >> skip) <|> do
-  let ls := d.univ_params,
-  let t := d.type,
-  let target := if is_forward then target.forward d.to_name else target.backwards d.to_name,
-  let iffmp := if is_forward then `iff.mp else `iff.mpr,
-  v ← mk_iff_mp_app iffmp t (λ_, expr.const d.to_name (level.param <$> ls)),
-  t' ← infer_type v,
-  updateex_env $ λ env, env.add (declaration.thm al ls t' $ task.pure v),
-  alias_attr.set al target tt,
-  add_doc_string al target.to_string
-
+/-- The core tactic which handles `alias d ↔ al _` or `alias d ↔ _ al`. `ns` is the current
+namespace, and `is_forward` is true if this is the forward implication (the first form). -/
+meta def alias_iff (doc : option string)
+  (d : declaration) (ns al : name) (is_forward : bool) : tactic unit :=
+if al = `_ then skip else
+  let al := ns.append_namespace al in
+  (get_decl al >> skip) <|> do
+    let ls := d.univ_params,
+    let t := d.type,
+    let target := if is_forward then target.forward d.to_name else target.backwards d.to_name,
+    let iffmp := if is_forward then `iff.mp else `iff.mpr,
+    v ← mk_iff_mp_app iffmp t (λ_, expr.const d.to_name (level.param <$> ls)),
+    t' ← infer_type v,
+    updateex_env $ λ env, env.add (declaration.thm al ls t' $ task.pure v),
+    alias_attr.set al target tt,
+    add_doc_string al (doc.get_or_else target.to_string)
+
+/-- Get the default names for left/right to be used by `alias d ↔ ..`. -/
 meta def make_left_right : name → tactic (name × name)
 | (name.mk_string s p) := do
   let buf : char_buffer := s.to_char_buffer,
@@ -151,20 +162,20 @@ input theorem has the form `A_iff_B` or `A_iff_B_left` etc.
 do old ← ident,
   d ← (do old ← resolve_constant old, get_decl old) <|>
     fail ("declaration " ++ to_string old ++ " not found"),
-  let doc := λ (al : name) (inf : string), meta_info.doc_string.get_or_else $
-    sformat!"**Alias** of {inf}`{old}`.",
+  ns ← get_current_namespace,
+  let doc := meta_info.doc_string,
   do
   { tk "←" <|> tk "<-",
     aliases ← many ident,
-    ↑(aliases.mmap' $ λ al, alias_direct d al) } <|>
+    ↑(aliases.mmap' $ λ al, alias_direct doc d (ns.append_namespace al)) } <|>
   do
   { tk "↔" <|> tk "<->",
     (left, right) ←
       mcond ((tk ".." >> pure tt) <|> pure ff)
         (make_left_right old <|> fail "invalid name for automatic name generation")
         (prod.mk <$> types.ident_ <*> types.ident_),
-    alias_iff d left tt,
-    alias_iff d right ff }
+    alias_iff doc d ns left tt,
+    alias_iff doc d ns right ff }
 
 add_tactic_doc
 { name                     := "alias",
@@ -172,10 +183,8 @@ add_tactic_doc
   decl_names               := [`tactic.alias.alias_cmd],
   tags                     := ["renaming"] }
 
-meta def get_lambda_body : expr → expr
-| (expr.lam _ _ _ b) := get_lambda_body b
-| a                  := a
-
+/-- Given a definition, look up the definition that it is an alias of.
+Returns `none` if this defintion is not an alias. -/
 meta def get_alias_target (n : name) : tactic (option target) :=
 do tt ← has_attribute' `alias n | pure none,
    v ← alias_attr.get_param n,
diff --git a/src/tactic/apply_fun.lean b/src/tactic/apply_fun.lean
index 997834e350b36..5df0cc10a3a27 100644
--- a/src/tactic/apply_fun.lean
+++ b/src/tactic/apply_fun.lean
@@ -14,7 +14,7 @@ this fact is passed as the optional argument `mono_lem`, or the `mono` tactic ca
 -/
 meta def apply_fun_to_hyp (e : pexpr) (mono_lem : option pexpr) (hyp : expr) : tactic unit :=
 do
-{ t ← infer_type hyp,
+{ t ← infer_type hyp >>= instantiate_mvars,
   prf ← match t with
   | `(%%l = %%r) := do
       ltp ← infer_type l,
diff --git a/src/tactic/assert_exists.lean b/src/tactic/assert_exists.lean
new file mode 100644
index 0000000000000..3d120fe89243a
--- /dev/null
+++ b/src/tactic/assert_exists.lean
@@ -0,0 +1,156 @@
+/-
+Copyright (c) 2022 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Scott Morrison
+-/
+import tactic.core
+import tactic.lint.basic
+
+/-!
+# User commands for assert the (non-)existence of declaration or instances.
+
+These commands are used to enforce the independence of different parts of mathlib.
+
+## Implementation notes
+
+This file provides two linters that verify that things we assert do not _yet_ exist do _eventually_
+exist. This works by creating declarations of the form:
+
+* ``assert_not_exists._checked. : name := `foo`` for `assert_not_exists foo`
+* `assert_no_instance._checked. := t` for `assert_instance t`
+
+These declarations are then picked up by the linter and analyzed accordingly.
+The `_` in the `_checked` prefix should hide them from doc-gen.
+-/
+
+section
+setup_tactic_parser
+open tactic
+
+/--
+`assert_exists n` is a user command that asserts that a declaration named `n` exists
+in the current import scope.
+
+Be careful to use names (e.g. `rat`) rather than notations (e.g. `ℚ`).
+-/
+@[user_command]
+meta def assert_exists (_ : parse $ tk "assert_exists")  : lean.parser unit :=
+do decl ← ident,
+   d ← get_decl decl,
+   return ()
+
+/--
+`assert_not_exists n` is a user command that asserts that a declaration named `n` *does not exist*
+in the current import scope.
+
+Be careful to use names (e.g. `rat`) rather than notations (e.g. `ℚ`).
+
+It may be used (sparingly!) in mathlib to enforce plans that certain files
+are independent of each other.
+
+If you encounter an error on an `assert_not_exists` command while developing mathlib,
+it is probably because you have introduced new import dependencies to a file.
+
+In this case, you should refactor your work
+(for example by creating new files rather than adding imports to existing files).
+You should *not* delete the `assert_not_exists` statement without careful discussion ahead of time.
+-/
+@[user_command]
+meta def assert_not_exists (_ : parse $ tk "assert_not_exists")  : lean.parser unit :=
+do
+  decl ← ident,
+  ff ← succeeds (get_decl decl) |
+  fail format!"Declaration {decl} is not allowed to exist in this file.",
+  n ← tactic.mk_fresh_name,
+  let marker := (`assert_not_exists._checked).append (decl.append n),
+  add_decl
+    (declaration.defn marker [] `(name) `(decl) default tt),
+  pure ()
+
+/-- A linter for checking that the declarations marked `assert_not_exists` eventually exist. -/
+meta def assert_not_exists.linter : linter :=
+{ test := λ d, (do
+    let n := d.to_name,
+    tt ← pure ((`assert_not_exists._checked).is_prefix_of n) | pure none,
+    declaration.defn _ _ `(name) val _ _ ← pure d,
+    n ← tactic.eval_expr name val,
+    tt ← succeeds (get_decl n) | pure (some (format!"`{n}` does not ever exist").to_string),
+    pure none),
+  auto_decls := tt,
+  no_errors_found := "All `assert_not_exists` declarations eventually exist.",
+  errors_found :=
+    "The following declarations used in `assert_not_exists` never exist; perhaps there is a typo.",
+  is_fast := tt }
+
+/--
+`assert_instance e` is a user command that asserts that an instance `e` is available
+in the current import scope.
+
+Example usage:
+```
+assert_instance semiring ℕ
+```
+-/
+@[user_command]
+meta def assert_instance (_ : parse $ tk "assert_instance")  : lean.parser unit :=
+do q ← texpr,
+   e ← i_to_expr q,
+   mk_instance e,
+   return ()
+
+/--
+`assert_no_instance e` is a user command that asserts that an instance `e` *is not available*
+in the current import scope.
+
+It may be used (sparingly!) in mathlib to enforce plans that certain files
+are independent of each other.
+
+If you encounter an error on an `assert_no_instance` command while developing mathlib,
+it is probably because you have introduced new import dependencies to a file.
+
+In this case, you should refactor your work
+(for example by creating new files rather than adding imports to existing files).
+You should *not* delete the `assert_no_instance` statement without careful discussion ahead of time.
+
+Example usage:
+```
+assert_no_instance linear_ordered_field ℚ
+```
+-/
+@[user_command]
+meta def assert_no_instance (_ : parse $ tk "assert_no_instance")  : lean.parser unit :=
+do
+  q ← texpr,
+  e ← i_to_expr q,
+  i ← try_core (mk_instance e),
+  match i with
+  | none := do
+      n ← tactic.mk_fresh_name,
+      e_str ← to_string <$> pp e,
+      let marker := ((`assert_no_instance._checked).mk_string e_str).append n,
+      et ← infer_type e,
+      tt ← succeeds (get_decl marker) |
+      add_decl
+          (declaration.defn marker [] et e default tt),
+      pure ()
+  | some i :=
+   (fail!"Instance `{i} : {e}` is not allowed to be found in this file." : tactic unit)
+  end
+
+/-- A linter for checking that the declarations marked `assert_no_instance` eventually exist. -/
+meta def assert_no_instance.linter : linter :=
+{ test := λ d, (do
+    let n := d.to_name,
+    tt ← pure ((`assert_no_instance._checked).is_prefix_of n) | pure none,
+    declaration.defn _ _ _ val _ _ ← pure d,
+    tt ← succeeds (tactic.mk_instance val)
+      | (some ∘ format.to_string) <$> pformat!"No instance of `{val}`",
+    pure none),
+  auto_decls := tt,
+  no_errors_found := "All `assert_no_instance` instances eventually exist.",
+  errors_found :=
+    "The following typeclass instances used in `assert_no_instance` never exist; perhaps they " ++
+    "are missing?",
+  is_fast := ff }
+
+end
diff --git a/src/tactic/auto_cases.lean b/src/tactic/auto_cases.lean
index 04801a9ca70a8..95adf9b9aa6b3 100644
--- a/src/tactic/auto_cases.lean
+++ b/src/tactic/auto_cases.lean
@@ -49,9 +49,10 @@ meta def find_tac : expr → option auto_cases_tac
 end auto_cases
 
 /-- Applies `cases` or `induction` on the local_hypothesis `hyp : expr`. -/
-meta def auto_cases_at (hyp : expr) : tactic string :=
+meta def auto_cases_at (find : expr → option auto_cases.auto_cases_tac) (hyp : expr) :
+  tactic string :=
 do t ← infer_type hyp >>= whnf,
-   match auto_cases.find_tac t with
+   match find t with
    | some atac := do
      atac.tac hyp,
      pp ← pp hyp,
@@ -61,9 +62,9 @@ do t ← infer_type hyp >>= whnf,
 
 /-- Applies `cases` or `induction` on certain hypotheses. -/
 @[hint_tactic]
-meta def auto_cases : tactic string :=
+meta def auto_cases (find := tactic.auto_cases.find_tac) : tactic string :=
 do l ← local_context,
-   results ← successes $ l.reverse.map auto_cases_at,
+   results ← successes $ l.reverse.map (auto_cases_at find),
    when (results.empty) $
      fail "`auto_cases` did not find any hypotheses to apply `cases` or `induction` to",
    return (string.intercalate ", " results)
diff --git a/src/tactic/basic.lean b/src/tactic/basic.lean
index 1b6797a857051..acc625666cec6 100644
--- a/src/tactic/basic.lean
+++ b/src/tactic/basic.lean
@@ -20,6 +20,7 @@ import tactic.mk_iff_of_inductive_prop
 import tactic.norm_cast
 import tactic.obviously
 import tactic.pretty_cases
+import tactic.print_sorry
 import tactic.protected
 import tactic.push_neg
 import tactic.replacer
diff --git a/src/tactic/cache.lean b/src/tactic/cache.lean
index 1ef055b95646f..36592828335f5 100644
--- a/src/tactic/cache.lean
+++ b/src/tactic/cache.lean
@@ -48,8 +48,8 @@ by its variant `haveI` described below.
 
 * `substI`: like `subst`, but can also substitute in type-class arguments
 
-* `haveI`/`letI`: `have`/`let` followed by `resetI`. Used to add typeclasses
-  to the context so that they can be used in typeclass inference.
+* `haveI`/`letI`/`rsufficesI`: `have`/`let`/`rsuffices` followed by `resetI`. Used
+  to add typeclasses to the context so that they can be used in typeclass inference.
 
 * `exactI`: `resetI` followed by `exact`. Like `exact`, but uses all
   variables in the context for typeclass inference.
diff --git a/src/tactic/cancel_denoms.lean b/src/tactic/cancel_denoms.lean
index 49104f6be4201..5b241ad0d12e4 100644
--- a/src/tactic/cancel_denoms.lean
+++ b/src/tactic/cancel_denoms.lean
@@ -32,12 +32,11 @@ namespace cancel_factors
 
 lemma mul_subst {α} [comm_ring α] {n1 n2 k e1 e2 t1 t2 : α} (h1 : n1 * e1 = t1) (h2 : n2 * e2 = t2)
      (h3 : n1*n2 = k) : k * (e1 * e2) = t1 * t2 :=
-have h3 : n1 * n2 = k, from h3,
 by rw [←h3, mul_comm n1, mul_assoc n2, ←mul_assoc n1, h1, ←mul_assoc n2, mul_comm n2, mul_assoc, h2]
 
 lemma div_subst {α} [field α] {n1 n2 k e1 e2 t1 : α} (h1 : n1 * e1 = t1) (h2 : n2 / e2 = 1)
    (h3 : n1*n2 = k) : k * (e1 / e2) = t1 :=
-by rw [←h3, mul_assoc, mul_div_comm, h2, ←mul_assoc, h1, mul_comm, one_mul]
+by rw [←h3, mul_assoc, mul_div_left_comm, h2, ←mul_assoc, h1, mul_comm, one_mul]
 
 lemma cancel_factors_eq_div {α} [field α] {n e e' : α} (h : n*e = e') (h2 : n ≠ 0) :
   e = e' / n :=
diff --git a/src/tactic/choose.lean b/src/tactic/choose.lean
index 0a87a5f4483db..afa4ba3be5b49 100644
--- a/src/tactic/choose.lean
+++ b/src/tactic/choose.lean
@@ -129,7 +129,7 @@ setup_tactic_parser
 /-- `choose a b h h' using hyp` takes an hypothesis `hyp` of the form
 `∀ (x : X) (y : Y), ∃ (a : A) (b : B), P x y a b ∧ Q x y a b`
 for some `P Q : X → Y → A → B → Prop` and outputs
-into context a function `a : X → Y → A`, `b : X → Y → B` and two assumptions:
+into context two functions `a : X → Y → A`, `b : X → Y → B` and two assumptions:
 `h : ∀ (x : X) (y : Y), P x y (a x y) (b x y)` and
 `h' : ∀ (x : X) (y : Y), Q x y (a x y) (b x y)`. It also works with dependent versions.
 
diff --git a/src/tactic/compute_degree.lean b/src/tactic/compute_degree.lean
new file mode 100644
index 0000000000000..f6c9afef1a0d7
--- /dev/null
+++ b/src/tactic/compute_degree.lean
@@ -0,0 +1,186 @@
+/-
+Copyright (c) 2022 Damiano Testa. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Damiano Testa
+-/
+import data.polynomial.degree.lemmas
+
+/-! # `compute_degree_le` a tactic for computing degrees of polynomials
+
+This file defines the tactic `compute_degree_le`.
+
+Using `compute_degree_le` when the goal is of the form `f.nat_degree ≤ d`, tries to solve the goal.
+It may leave side-goals, in case it is not entirely successful.
+
+See the doc-string for more details.
+
+##  Future work
+
+* Deal with goals of the form `f.(nat_)degree = d` (PR #14040 does exactly this).
+* Add better functionality to deal with exponents that are not necessarily closed natural numbers.
+* Add support for proving goals of the from `f.(nat_)degree ≠ 0`.
+* Make sure that `degree` and `nat_degree` are equally supported.
+
+##  Implementation details
+
+We start with a goal of the form `f.(nat_)degree ≤ d`.  Recurse into `f` breaking apart sums,
+products and powers.  Take care of numerals, `C a, X (^ n), monomial a n` separately. -/
+
+namespace tactic
+namespace compute_degree
+open expr polynomial
+
+/--  `guess_degree e` assumes that `e` is an expression in a polynomial ring, and makes an attempt
+at guessing the `nat_degree` of `e`.  Heuristics for `guess_degree`:
+* `0, 1, C a`,      guess `0`,
+* `polynomial.X`,   guess `1`,
+*  `bit0/1 f, -f`,  guess `guess_degree f`,
+* `f + g, f - g`,   guess `max (guess_degree f) (guess_degree g)`,
+* `f * g`,          guess `guess_degree f + guess_degree g`,
+* `f ^ n`,          guess `guess_degree f * n`,
+* `monomial n r`,   guess `n`,
+* `f` not as above, guess `f.nat_degree`.
+
+The guessed degree should coincide with the behaviour of `resolve_sum_step`:
+`resolve_sum_step` cannot solve a goal `f.nat_degree ≤ d` if `guess_degree f < d`.
+ -/
+meta def guess_degree : expr → tactic expr
+| `(has_zero.zero)           := pure `(0)
+| `(has_one.one)             := pure `(0)
+| `(- %%f)                   := guess_degree f
+| (app `(⇑C) x)              := pure `(0)
+| `(X)                       := pure `(1)
+| `(bit0 %%a)                := guess_degree a
+| `(bit1 %%a)                := guess_degree a
+| `(%%a + %%b)               := do [da, db] ← [a, b].mmap guess_degree,
+                                pure $ expr.mk_app `(max : ℕ → ℕ → ℕ) [da, db]
+| `(%%a - %%b)               := do [da, db] ← [a, b].mmap guess_degree,
+                                pure $ expr.mk_app `(max : ℕ → ℕ → ℕ) [da, db]
+| `(%%a * %%b)               := do [da, db] ← [a, b].mmap guess_degree,
+                                pure $ expr.mk_app `((+) : ℕ → ℕ → ℕ) [da, db]
+| `(%%a ^ %%b)               := do da ← guess_degree a,
+                                pure $ expr.mk_app `((*) : ℕ → ℕ → ℕ) [da, b]
+| (app `(⇑(monomial %%n)) x) := pure n
+| e                          := do `(@polynomial %%R %%inst) ← infer_type e,
+                                pe ← to_expr ``(@nat_degree %%R %%inst) tt ff,
+                                pure $ expr.mk_app pe [e]
+
+/-- `resolve_sum_step` assumes that the current goal is of the form `f.nat_degree ≤ d`, failing
+otherwise.  It tries to make progress on the goal by progressing into `f` if `f` is
+* a sum, difference, opposite, product, or a power;
+* a monomial;
+* `C a`;
+* `0, 1` or `bit0 a, bit1 a` (to deal with numerals).
+
+The side-goals produced by `resolve_sum_step` are either again of the same shape `f'.nat_degree ≤ d`
+or of the form `m ≤ n`, where `m n : ℕ`.
+
+If `d` is less than `guess_degree f`, this tactic will create unsolvable goals.
+-/
+meta def resolve_sum_step : tactic unit := do
+t ← target >>= instantiate_mvars,
+`(nat_degree %%tl ≤ %%tr) ← whnf t reducible | fail!("Goal is not of the form `f.nat_degree ≤ d`"),
+match tl with
+| `(%%tl1 + %%tl2) := refine ``((nat_degree_add_le_iff_left _ _ _).mpr _)
+| `(%%tl1 - %%tl2) := refine ``((nat_degree_sub_le_iff_left _).mpr _)
+| `(%%tl1 * %%tl2) := do [d1, d2] ← [tl1, tl2].mmap guess_degree,
+  refine ``(nat_degree_mul_le.trans $ (add_le_add _ _).trans (_ : %%d1 + %%d2 ≤ %%tr))
+| `(- %%f)         := refine ``((nat_degree_neg _).le.trans _)
+| `(X ^ %%n)       := refine ``((nat_degree_X_pow_le %%n).trans _)
+| (app `(⇑(@monomial %%R %%inst %%n)) x) := refine ``((nat_degree_monomial_le %%x).trans _)
+| (app `(⇑C) x)    := refine ``((nat_degree_C %%x).le.trans (nat.zero_le %%tr))
+| `(X)             := refine ``(nat_degree_X_le.trans _)
+| `(has_zero.zero) := refine ``(nat_degree_zero.le.trans (nat.zero_le _))
+| `(has_one.one)   := refine ``(nat_degree_one.le.trans (nat.zero_le _))
+| `(bit0 %%a)      := refine ``((nat_degree_bit0 %%a).trans _)
+| `(bit1 %%a)      := refine ``((nat_degree_bit1 %%a).trans _)
+| `(%%tl1 ^ %%n)   := do
+    refine ``(nat_degree_pow_le.trans _),
+    refine ``(dite (%%n = 0) (λ (n0 : %%n = 0), (by simp only [n0, zero_mul, zero_le])) _),
+    n0 ← get_unused_name "n0" >>= intro,
+    refine ``((mul_comm _ _).le.trans ((nat.le_div_iff_mul_le' (nat.pos_of_ne_zero %%n0)).mp _)),
+    lem1 ← to_expr ``(nat.mul_div_cancel _ (nat.pos_of_ne_zero %%n0)) tt ff,
+    lem2 ← to_expr ``(nat.div_self (nat.pos_of_ne_zero %%n0)) tt ff,
+    focus1 (refine ``((%%n0 rfl).elim) <|> rewrite_target lem1 <|> rewrite_target lem2) <|> skip
+| e                := fail!"'{e}' is not supported"
+end
+
+/--  `norm_assum` simply tries `norm_num` and `assumption`.
+It is used to try to discharge as many as possible of the side-goals of `compute_degree_le`.
+Several side-goals are of the form `m ≤ n`, for natural numbers `m, n` or of the form `c ≠ 0`,
+with `c` a coefficient of the polynomial `f` in question. -/
+meta def norm_assum : tactic unit :=
+try `[ norm_num ] >> try assumption
+
+/--  `eval_guessing n e` takes a natural number `n` and an expression `e` and gives an
+estimate for the evaluation of `eval_expr' ℕ e`.  It is tailor made for estimating degrees of
+polynomials.
+
+It decomposes `e` recursively as a sequence of additions, multiplications and `max`.
+On the atoms of the process, `eval_guessing` tries to use `eval_expr' ℕ`, resorting to using
+`n` if `eval_expr' ℕ` fails.
+
+For use with degree of polynomials, we mostly use `n = 0`. -/
+meta def eval_guessing (n : ℕ) : expr → tactic ℕ
+| `(%%a + %%b)   := (+) <$> eval_guessing a <*> eval_guessing b
+| `(%%a * %%b)   := (*) <$> eval_guessing a <*> eval_guessing b
+| `(max %%a %%b) := max <$> eval_guessing a <*> eval_guessing b
+| e              := eval_expr' ℕ e <|> pure n
+
+/--  A general description of `compute_degree_le_aux` is in the doc-string of `compute_degree`.
+The difference between the two is that `compute_degree_le_aux` makes no effort to close side-goals,
+nor fails if the goal does not change. -/
+meta def compute_degree_le_aux : tactic unit := do
+try $ refine ``(degree_le_nat_degree.trans (with_bot.coe_le_coe.mpr _)),
+`(nat_degree %%tl ≤ %%tr) ← target |
+  fail "Goal is not of the form\n`f.nat_degree ≤ d` or `f.degree ≤ d`",
+expected_deg ← guess_degree tl >>= eval_guessing 0,
+deg_bound ← eval_expr' ℕ tr <|> pure expected_deg,
+if deg_bound < expected_deg
+then fail sformat!"the given polynomial has a term of expected degree\nat least '{expected_deg}'"
+else repeat $ resolve_sum_step
+
+end compute_degree
+
+namespace interactive
+open compute_degree polynomial
+
+/--  `compute_degree_le` tries to solve a goal of the form `f.nat_degree ≤ d` or `f.degree ≤ d`,
+where `f : R[X]` and `d : ℕ` or `d : with_bot ℕ`.
+
+If the given degree `d` is smaller than the one that the tactic computes,
+then the tactic suggests the degree that it computed.
+
+Examples:
+
+```lean
+open polynomial
+open_locale polynomial
+
+variables {R : Type*} [semiring R] {a b c d e : R}
+
+example {F} [ring F] {a : F} {n : ℕ} (h : n ≤ 10) :
+  nat_degree (X ^ n + C a * X ^ 10 : F[X]) ≤ 10 :=
+by compute_degree_le
+
+example : nat_degree (7 * X : R[X]) ≤ 1 :=
+by compute_degree_le
+
+example {p : R[X]} {n : ℕ} {p0 : p.nat_degree = 0} :
+ (p ^ n).nat_degree ≤ 0 :=
+by compute_degree_le
+```
+-/
+meta def compute_degree_le : tactic unit :=
+focus1 $ do check_target_changes compute_degree_le_aux,
+  try $ any_goals' norm_assum
+
+add_tactic_doc
+{ name := "compute_degree_le",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.compute_degree_le],
+  tags := ["arithmetic", "finishing"] }
+
+end interactive
+
+end tactic
diff --git a/src/tactic/congr.lean b/src/tactic/congr.lean
index 37d5efe57eaef..128b24d53e494 100644
--- a/src/tactic/congr.lean
+++ b/src/tactic/congr.lean
@@ -224,7 +224,10 @@ begin
 -- ⊢ a + d + e + f + c + g + b ≤ N
 end
 ```
--/
+
+##  Related tactic: `move_add`
+In the case in which the expression to be changed is a sum of terms, tactic
+`tactive.interactive.move_add` can also be useful. -/
 meta def ac_change (r : parse texpr) (n : parse (tk "using" *> small_nat)?) : tactic unit :=
 convert_to r n; try ac_refl
 
diff --git a/src/tactic/congrm.lean b/src/tactic/congrm.lean
new file mode 100644
index 0000000000000..d62c6cdecc3d6
--- /dev/null
+++ b/src/tactic/congrm.lean
@@ -0,0 +1,200 @@
+/-
+Copyright (c) 2022 Damiano Testa. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Gabriel Ebner, Damiano Testa
+-/
+import tactic.interactive
+
+/-! `congrm`: `congr` with pattern-matching
+
+`congrm e` gives to the use the functionality of using `congr` with an expression `e` "guiding"
+`congr` through the matching.  This allows more flexibility than `congr' n`, which enters uniformly
+through `n` iterations.  Instead, we can guide the matching deeper on some parts of the expression
+and stop earlier on other parts.
+
+##  Implementation notes
+
+###  Function underscores
+
+See the doc-string to `tactic.interactive.congrm` for more details.  Here we describe how to add
+more "function underscores".
+
+The pattern for generating a function underscore is to define a "generic" `n`-ary function, for some
+number `n`.  You can take a look at `tactic.congrm_fun_1, ..., tactic.congrm_fun_4`.
+These implement the "function underscores" `_₁, ..., _₄`.  If you want a different arity for your
+function, simply
+introduce
+```lean
+@[nolint unused_arguments]
+def congrm_fun_n {α₁ … αₙ ρ} {r : ρ} : α₁ → ⋯ → aₙ → ρ := λ _ … _, r
+notation `_ₙ` := congrm_fun_n
+```
+_Warning:_ `convert_to_explicit` checks that the first 18 characters in the name of `_ₙ` are
+identical to `tactic.congrm_fun_` to perform its job.  Thus, if you want to implement
+"function underscores" with different arity, either make sure that their names begin with
+`tactic.congrm_fun_` or you should change `convert_to_explicit` accordingly.
+-/
+
+namespace tactic
+
+/--  A generic function with one argument.  It is the "function underscore" input to `congrm`. -/
+@[nolint unused_arguments]
+def congrm_fun_1 {α ρ} {r : ρ} : α → ρ := λ _, r
+notation `_₁` := congrm_fun_1
+
+/--  A generic function with two arguments.  It is the "function underscore" input to `congrm`. -/
+@[nolint unused_arguments]
+def congrm_fun_2 {α β ρ} {r : ρ} : α → β → ρ := λ _ _, r
+notation `_₂` := congrm_fun_2
+
+/--  A generic function with three arguments.  It is the "function underscore" input to `congrm`. -/
+@[nolint unused_arguments]
+def congrm_fun_3 {α β γ ρ} {r : ρ} : α → β → γ → ρ := λ _ _ _, r
+notation `_₃` := congrm_fun_3
+
+/--  A generic function with four arguments.  It is the "function underscore" input to `congrm`. -/
+@[nolint unused_arguments]
+def congrm_fun_4 {α β γ δ ρ} {r : ρ} : α → β → γ → δ → ρ := λ _ _ _ _, r
+notation `_₄` := congrm_fun_4
+
+/--  Replaces a "function underscore" input to `congrm` into the correct expression,
+read off from the left-hand-side of the target expression. -/
+meta def convert_to_explicit (pat lhs : expr) : tactic expr :=
+if pat.get_app_fn.const_name.to_string.starts_with "tactic.congrm_fun_"
+then
+  pat.list_explicit_args >>= lhs.replace_explicit_args
+else
+  return pat
+
+/--
+For each element of `list congr_arg_kind` that is `eq`, add a pair `(g, pat)` to the
+final list.  Otherwise, discard an appropriate number of initial terms from each list
+(possibly none from the first) and repeat.
+
+`pat` is the given pattern-piece at the appropriate location, extracted from the last `list expr`.
+It appears to be the list of arguments of a function application.
+
+`g` is possibly the proof of an equality?  It is extracted from the first `list expr`.
+-/
+private meta def extract_subgoals : list expr → list congr_arg_kind → list expr →
+  tactic (list (expr × expr))
+| (_ :: _ :: g :: prf_args) (congr_arg_kind.eq :: kinds)             (pat :: pat_args) :=
+  (λ rest, (g, pat) :: rest) <$> extract_subgoals prf_args kinds pat_args
+| (_ :: prf_args)           (congr_arg_kind.fixed :: kinds)          (_ :: pat_args) :=
+  extract_subgoals prf_args kinds pat_args
+| prf_args                  (congr_arg_kind.fixed_no_param :: kinds) (_ :: pat_args) :=
+  extract_subgoals prf_args kinds pat_args
+| (_ :: _ :: prf_args)      (congr_arg_kind.cast :: kinds)           (_ :: pat_args) :=
+  extract_subgoals prf_args kinds pat_args
+| _ _ [] := pure []
+| _ _ _ := fail "unsupported congr lemma"
+
+/--
+`equate_with_pattern_core pat` solves a single goal of the form `lhs = rhs`
+(assuming that `lhs` and `rhs` are unifiable with `pat`)
+by applying congruence lemmas until `pat` is a metavariable.
+Returns the list of metavariables for the new subgoals at the leafs.
+Calls `set_goals []` at the end.
+-/
+meta def equate_with_pattern_core : expr → tactic (list expr) | pat :=
+(applyc ``subsingleton.elim >> pure []) <|>
+(applyc ``rfl >> pure []) <|>
+if pat.is_mvar || pat.get_delayed_abstraction_locals.is_some then do
+  try $ applyc ``_root_.propext,
+  get_goals <* set_goals []
+else match pat with
+| expr.app _ _ := do
+  `(%%lhs = %%_) ← target,
+  pat ← convert_to_explicit pat lhs,
+  cl ← mk_specialized_congr_lemma pat,
+  H_congr_lemma ← assertv `H_congr_lemma cl.type cl.proof,
+  [prf] ← get_goals,
+  apply H_congr_lemma <|> fail "could not apply congr_lemma",
+  all_goals' $ try $ clear H_congr_lemma,  -- given the `set_goals []` that follows, is this needed?
+  set_goals [],
+  prf ← instantiate_mvars prf,
+  subgoals ← extract_subgoals prf.get_app_args cl.arg_kinds pat.get_app_args,
+  subgoals ← subgoals.mmap (λ ⟨subgoal, subpat⟩, do
+    set_goals [subgoal],
+    equate_with_pattern_core subpat),
+  pure subgoals.join
+| expr.lam _ _ _ body := do
+  applyc ``_root_.funext,
+  x ← intro pat.binding_name,
+  equate_with_pattern_core $ body.instantiate_var x
+| expr.pi _ _ _ codomain := do
+  applyc ``_root_.pi_congr,
+  x ← intro pat.binding_name,
+  equate_with_pattern_core $ codomain.instantiate_var x
+| _ := do
+  pat ← pp pat,
+  fail $ to_fmt "unsupported pattern:\n" ++ pat
+end
+
+/--
+`equate_with_pattern pat` solves a single goal of the form `lhs = rhs`
+(assuming that `lhs` and `rhs` are unifiable with `pat`)
+by applying congruence lemmas until `pat` is a metavariable.
+The subgoals for the leafs are prepended to the goals.
+-/
+meta def equate_with_pattern (pat : expr) : tactic unit := do
+congr_subgoals ← solve1 (equate_with_pattern_core pat),
+gs ← get_goals,
+set_goals $ congr_subgoals ++ gs
+
+end tactic
+
+namespace tactic.interactive
+open tactic interactive
+setup_tactic_parser
+
+/--
+Assume that the goal is of the form `lhs = rhs` or `lhs ↔ rhs`.
+`congrm e` takes an expression `e` containing placeholders `_` and scans `e, lhs, rhs` in parallel.
+
+It matches both `lhs` and `rhs` to the pattern `e`, and produces one goal for each placeholder,
+stating that the corresponding subexpressions in `lhs` and `rhs` are equal.
+
+Examples:
+```lean
+example {a b c d : ℕ} :
+  nat.pred a.succ * (d + (c + a.pred)) = nat.pred b.succ * (b + (c + d.pred)) :=
+begin
+  congrm nat.pred (nat.succ _) * (_ + _),
+/-  Goals left:
+⊢ a = b
+⊢ d = b
+⊢ c + a.pred = c + d.pred
+-/
+  sorry,
+  sorry,
+  sorry,
+end
+
+example {a b : ℕ} (h : a = b) : (λ y : ℕ, ∀ z, a + a = z) = (λ x, ∀ z, b + a = z) :=
+begin
+  congrm λ x, ∀ w, _ + a = w,
+  -- produces one goal for the underscore: ⊢ a = b
+  exact h,
+end
+```
+
+The tactic also allows for "function underscores", denoted by `_₁, ..., _₄`.  The index denotes
+the number of explicit arguments of the function to be matched.
+If `e` has a "function underscore" in a location, then the tactic reads off the function `f` that
+appears in `lhs` at the current location, replacing the *explicit* arguments of `f` by the user
+inputs to the "function underscore".  After that, `congrm` continues with its matching.
+-/
+meta def congrm (arg : parse texpr) : tactic unit := do
+try $ applyc ``_root_.eq.to_iff,
+`(@eq %%ty _ _) ← target | fail "congrm: goal must be an equality or iff",
+ta ← to_expr ``((%%arg : %%ty)) tt ff,
+equate_with_pattern ta
+
+add_tactic_doc
+{ name := "congrm",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.congrm],
+  tags := ["congruence"] }
+
+end tactic.interactive
diff --git a/src/tactic/converter/apply_congr.lean b/src/tactic/converter/apply_congr.lean
index 5074c3dd99213..cf77f977cfb2d 100644
--- a/src/tactic/converter/apply_congr.lean
+++ b/src/tactic/converter/apply_congr.lean
@@ -20,7 +20,7 @@ open tactic
 namespace conv.interactive
 open interactive interactive.types lean.parser
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 
 /--
diff --git a/src/tactic/core.lean b/src/tactic/core.lean
index 0d169db89fc70..2364d7bd99a08 100644
--- a/src/tactic/core.lean
+++ b/src/tactic/core.lean
@@ -16,7 +16,7 @@ universe u
 
 attribute [derive [has_reflect, decidable_eq]] tactic.transparency
 
--- Rather than import order.lexicographic here, we can get away with defining the order by hand.
+-- Rather than import data.prod.lex here, we can get away with defining the order by hand.
 instance : has_lt pos :=
 { lt := λ x y, x.line < y.line ∨ x.line = y.line ∧ x.column < y.column }
 
@@ -360,6 +360,33 @@ meta def lambdas : list expr → expr → tactic expr
   pure $ expr.lam pp info t (expr.abstract_local f' uniq)
 | _ f := pure f
 
+/--  Given an expression `f` (likely a binary operation) and a further expression `x`, calling
+`list_binary_operands f x` breaks `x` apart into successions of applications of `f` until this can
+no longer be done and returns a list of the leaves of the process.
+
+This matches `f` up to semireducible unification. In particular, it will match applications of the
+same polymorphic function with different type-class arguments.
+
+E.g., if `i1` and `i2` are both instances of `has_add T` and
+`e := has_add.add T i1 x (has_add.add T i2 y z)`, then ``list_binary_operands `((+) : T → T → T) e``
+returns `[x, y, z]`.
+
+For example:
+```lean
+#eval list_binary_operands `(@has_add.add ℕ _) `(3 + (4 * 5 + 6) + 7 / 3) >>= tactic.trace
+-- [3, 4 * 5, 6, 7 / 3]
+#eval list_binary_operands `(@list.append ℕ) `([1, 2] ++ [3, 4] ++ (1 :: [])) >>= tactic.trace
+-- [[1, 2], [3, 4], [1]]
+```
+-/
+meta def list_binary_operands (f : expr) : expr → tactic (list expr)
+| x@(expr.app (expr.app g a) b) := do
+  some _ ← try_core (unify f g) | pure [x],
+  as ← list_binary_operands a,
+  bs ← list_binary_operands b,
+  pure (as ++ bs)
+| a                      := pure [a]
+
 -- TODO: move to `declaration` namespace in `meta/expr.lean`
 /-- `mk_theorem n ls t e` creates a theorem declaration with name `n`, universe parameters named
 `ls`, type `t`, and body `e`. -/
@@ -378,7 +405,7 @@ do ((), body) ← solve_aux type tac,
 /-- `eval_expr' α e` attempts to evaluate the expression `e` in the type `α`.
 This is a variant of `eval_expr` in core. Due to unexplained behavior in the VM, in rare
 situations the latter will fail but the former will succeed. -/
-meta def eval_expr' (α : Type*) [_inst_1 : reflected α] (e : expr) : tactic α :=
+meta def eval_expr' (α : Type*) [reflected _ α] (e : expr) : tactic α :=
 mk_app ``id [e] >>= eval_expr α
 
 /-- `mk_fresh_name` returns identifiers starting with underscores,
@@ -969,7 +996,7 @@ end
 
 /--
 `apply_list l`, for `l : list (tactic expr)`,
-tries to apply the lemmas generated by the tactics in `l` on the first goal, and
+tries to apply one of the lemmas generated by the tactics in `l` to the first goal, and
 fail if none succeeds.
 -/
 meta def apply_list_expr (opt : apply_cfg) : list (tactic expr) → tactic unit
@@ -982,11 +1009,12 @@ application of `i_to_expr_for_apply` to a declaration with that attribute.
 -/
 meta def resolve_attribute_expr_list (attr_name : name) : tactic (list (tactic expr)) := do
   l ← attribute.get_instances attr_name,
-  list.map i_to_expr_for_apply <$> list.reverse <$> l.mmap resolve_name
+  list.map i_to_expr_for_apply <$> list.reverse
+    <$> l.mmap (λ n, do c ← (mk_const n), return (pexpr.of_expr c))
 
 
 /--`apply_rules args attrs n`: apply the lists of rules `args` (given as pexprs) and `attrs` (given
-as names of attributes) and `the tactic assumption` on the first goal and the resulting subgoals,
+as names of attributes) and the tactic `assumption` on the first goal and the resulting subgoals,
 iteratively, at most `n` times.
 
 Unlike `solve_by_elim`, `apply_rules` does not do any backtracking, and just greedily applies
@@ -1192,6 +1220,17 @@ do r ← decorate_ex "iterate1 failed: tactic did not succeed" t,
    L ← iterate t,
    return (r :: L)
 
+/--  A simple check: `check_target_changes tac` applies tactic `tac` and fails if the main target
+before applying the tactic `tac` unifies with one of the goals produced by the tactic itself.
+Useful to make sure that the tactic `tac` is actually making progress. -/
+meta def check_target_changes (tac : tactic α) : tactic α :=
+focus1 $ do
+  t ← target,
+  x ← tac,
+  gs ← get_goals >>= list.mmap infer_type,
+  (success_if_fail $ gs.mfirst $ unify t) <|> fail "Goal did not change",
+  pure x
+
 /-- Introduces one or more variables and returns the new local constants.
 Fails if `intro` cannot be applied. -/
 meta def intros1 : tactic (list expr) :=
@@ -1340,6 +1379,23 @@ end tactic
 namespace lean.parser
 open tactic interaction_monad
 
+/-- A version of `lean.parser.many` that requires at least `n` items -/
+meta def repeat_at_least {α : Type} (p : lean.parser α) : ℕ → lean.parser (list α)
+| 0 := many p
+| (n + 1) := list.cons <$> p <*> repeat_at_least n
+
+/-- A version of `lean.parser.sep_by` that allows trailing delimiters, but requires at least one
+item. Like `lean.parser.sep_by`, as a result of the `lean.parser` monad not being pure, this is only
+well-behaved if `p` and `s` are backtrackable; which in practice means they must not consume the
+input when they do not have a match. -/
+meta def sep_by_trailing {α : Type} (s : lean.parser unit) (p : lean.parser α) :
+  lean.parser (list α) :=
+do
+  fst ← p,
+  some () ← optional s | pure [fst],
+  some rest ← optional sep_by_trailing | pure [fst],
+  pure (fst :: rest)
+
 /-- `emit_command_here str` behaves as if the string `str` were placed as a user command at the
 current line. -/
 meta def emit_command_here (str : string) : lean.parser string :=
@@ -1376,9 +1432,11 @@ add_tactic_doc
 This function deserves a C++ implementation in core lean, and will fail if it is not called from
 the body of a command (i.e. anywhere else that the `lean.parser` monad can be invoked). -/
 meta def get_current_namespace : lean.parser name :=
-do n ← tactic.mk_user_fresh_name,
+do env ← get_env,
+   n ← tactic.mk_user_fresh_name,
    emit_code_here $ sformat!"def {n} := ()",
    nfull ← tactic.resolve_constant n,
+   set_env env,
    return $ nfull.get_nth_prefix n.components.length
 
 /-- `get_variables` returns a list of existing variable names, along with their types and binder
@@ -1719,11 +1777,18 @@ add_tactic_doc
   tags                     := ["goal information"] }
 
 /-- Makes the declaration `classical.prop_decidable` available to type class inference.
-This asserts that all propositions are decidable, but does not have computational content. -/
-meta def classical : tactic unit :=
-do h ← get_unused_name `_inst,
-   mk_const `classical.prop_decidable >>= note h none,
-   reset_instance_cache
+This asserts that all propositions are decidable, but does not have computational content.
+
+The `aggressive` argument controls whether the instance is added globally, where it has low
+priority, or in the local context, where it has very high priority. -/
+meta def classical (aggressive : bool := ff) : tactic unit :=
+if aggressive then do
+  h ← get_unused_name `_inst,
+  mk_const `classical.prop_decidable >>= note h none,
+  reset_instance_cache
+else do
+  -- Turn on the `prop_decidable` instance. `9` is what we use in the `classical` locale
+  tactic.set_basic_attribute `instance `classical.prop_decidable ff (some 9)
 
 open expr
 
@@ -1909,8 +1974,8 @@ open _root_.lean
 open _root_.lean.parser
 open _root_.interactive _root_.interactive.types
 
-local postfix `?`:9001 := optional
-local postfix *:9001 := many .
+local postfix (name := parser.optional) `?`:9001 := optional
+local postfix (name := parser.many) *:9001 := many .
 "
 
 /-- `finally tac finalizer` runs `tac` first, then runs `finalizer` even if
@@ -2344,38 +2409,6 @@ add_tactic_doc
   decl_names               := [`tactic.import_private_cmd],
   tags                     := ["renaming"] }
 
-/--
-The command `mk_simp_attribute simp_name "description"` creates a simp set with name `simp_name`.
-Lemmas tagged with `@[simp_name]` will be included when `simp with simp_name` is called.
-`mk_simp_attribute simp_name none` will use a default description.
-
-Appending the command with `with attr1 attr2 ...` will include all declarations tagged with
-`attr1`, `attr2`, ... in the new simp set.
-
-This command is preferred to using ``run_cmd mk_simp_attr `simp_name`` since it adds a doc string
-to the attribute that is defined. If you need to create a simp set in a file where this command is
-not available, you should use
-```lean
-run_cmd mk_simp_attr `simp_name
-run_cmd add_doc_string `simp_attr.simp_name "Description of the simp set here"
-```
--/
-@[user_command]
-meta def mk_simp_attribute_cmd (_ : parse $ tk "mk_simp_attribute") : lean.parser unit :=
-do n ← ident,
-   d ← parser.pexpr,
-   d ← to_expr ``(%%d : option string),
-   descr ← eval_expr (option string) d,
-   with_list ← (tk "with" *> many ident) <|> return [],
-   mk_simp_attr n with_list,
-   add_doc_string (name.append `simp_attr n) $ descr.get_or_else $ "simp set for " ++ to_string n
-
-add_tactic_doc
-{ name                     := "mk_simp_attribute",
-  category                 := doc_category.cmd,
-  decl_names               := [`tactic.mk_simp_attribute_cmd],
-  tags                     := ["simplification"] }
-
 /--
 Given a user attribute name `attr_name`, `get_user_attribute_name attr_name` returns
 the name of the declaration that defines this attribute.
@@ -2404,7 +2437,7 @@ then do
   user_attr_nm ← get_user_attribute_name attr_name,
   user_attr_const ← mk_const user_attr_nm,
   tac ← eval_pexpr (tactic unit)
-    ``(user_attribute.set %%user_attr_const %%c_name default %%persistent) <|>
+    ``(user_attribute.set %%user_attr_const %%`(c_name) default %%`(persistent)) <|>
     fail! ("Cannot set attribute @[{attr_name}].\n" ++
       "The corresponding user attribute {user_attr_nm} " ++
       "has a parameter without a default value.\n" ++
diff --git a/src/tactic/default.lean b/src/tactic/default.lean
index 8b57d53d783f7..3ebbb27ebc402 100644
--- a/src/tactic/default.lean
+++ b/src/tactic/default.lean
@@ -37,3 +37,5 @@ import tactic.transport
 import tactic.unfold_cases
 import tactic.field_simp
 import tactic.linear_combination
+import tactic.polyrith
+import tactic.expand_exists
diff --git a/src/tactic/derive_fintype.lean b/src/tactic/derive_fintype.lean
index bffeae606ed1d..96311d442a03d 100644
--- a/src/tactic/derive_fintype.lean
+++ b/src/tactic/derive_fintype.lean
@@ -144,7 +144,7 @@ instance (α enum n) : inhabited (finset_above α enum n) := ⟨finset_above.nil
 /-- This is a finset covering a nontrivial variant (with one or more constructor arguments).
 The property `P` here is `λ a, enum a = n` where `n` is the discriminant for the current
 variant. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def finset_in {α} (P : α → Prop) := {s : finset α // ∀ x ∈ s, P x}
 
 /-- To construct the finset, we use an injective map from the type `Γ`, which will be the
@@ -167,7 +167,8 @@ def finset_above.union {α} {enum : α → ℕ} (n)
   (s : finset_in (λ a, enum a = n)) (t : finset_above α enum (n+1)) : finset_above α enum n :=
 begin
   refine ⟨finset.disj_union s.1 t.1 _, _⟩,
-  { intros a hs ht,
+  { rw finset.disjoint_left,
+    intros a hs ht,
     have := t.2 _ ht, rw s.2 _ hs at this,
     exact nat.not_succ_le_self n this },
   { intros x h', rcases finset.mem_disj_union.1 h' with h' | h',
diff --git a/src/tactic/doc_commands.lean b/src/tactic/doc_commands.lean
index f51df2877e074..3f493a4a83e64 100644
--- a/src/tactic/doc_commands.lean
+++ b/src/tactic/doc_commands.lean
@@ -3,7 +3,6 @@ Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-import tactic.fix_reflect_string
 
 /-!
 # Documentation commands
@@ -33,10 +32,11 @@ information.
 def string.hash (s : string) : ℕ :=
 s.fold 1 (λ h c, (33*h + c.val) % unsigned_sz)
 
-/-- `mk_hashed_name nspace id` hashes the string `id` to a value `i` and returns the name
-`nspace._i` -/
-meta def string.mk_hashed_name (nspace : name) (id : string) : name :=
-nspace <.> ("_" ++ to_string id.hash)
+/-- Get the last component of a name, and convert it to a string. -/
+meta def name.last : name → string
+| (name.mk_string s _)  := s
+| (name.mk_numeral n _) := repr n
+| anonymous             := "[anonymous]"
 
 open tactic
 
@@ -77,16 +77,19 @@ output. -/
 Example: ``mk_reflected_definition `foo 17`` constructs the definition
 declaration corresponding to `def foo : ℕ := 17`
 -/
-meta def mk_reflected_definition (decl_name : name) {type} [reflected type]
-  (body : type) [reflected body] : declaration :=
+meta def mk_reflected_definition (decl_name : name) {type} [reflected _ type]
+  (body : type) [reflected _ body] : declaration :=
 mk_definition decl_name (reflect type).collect_univ_params (reflect type) (reflect body)
 
-/-- If `note_name` and `note` are `pexpr`s representing strings,
-`add_library_note note_name note` adds a declaration of type `string × string` and tags it with
-the `library_note` attribute. -/
+/--
+If `note_name` and `note` are strings, `add_library_note note_name note` adds a declaration named
+`library_note.` with `note` as the docstring and tags it with the `library_note`
+attribute.
+-/
 meta def tactic.add_library_note (note_name note : string) : tactic unit :=
-do let decl_name := note_name.mk_hashed_name `library_note,
-   add_decl $ mk_reflected_definition decl_name (note_name, note),
+do let decl_name := `library_note <.> note_name,
+   add_decl $ mk_reflected_definition decl_name (),
+   add_doc_string decl_name note,
    library_note_attr.set decl_name () tt none
 
 open tactic
@@ -111,7 +114,7 @@ add_library_note note_name doc_string
 Returns a list of pairs `(note_id, note_content)` -/
 meta def tactic.get_library_notes : tactic (list (string × string)) :=
 attribute.get_instances `library_note >>=
-  list.mmap (λ dcl, mk_const dcl >>= eval_expr (string × string))
+  list.mmap (λ dcl, prod.mk dcl.last <$> doc_string dcl)
 
 /-! ### The `add_tactic_doc_entry` command -/
 
@@ -136,42 +139,20 @@ structure tactic_doc_entry :=
 (category : doc_category)
 (decl_names : list _root_.name)
 (tags : list string := [])
-(description : string := "")
 (inherit_description_from : option _root_.name := none)
 
 /-- Turns a `tactic_doc_entry` into a JSON representation. -/
-meta def tactic_doc_entry.to_json (d : tactic_doc_entry) : json :=
+meta def tactic_doc_entry.to_json (d : tactic_doc_entry) (desc : string) : json :=
 json.object [
   ("name", d.name),
   ("category", d.category.to_string),
   ("decl_names", d.decl_names.map (json.of_string ∘ to_string)),
   ("tags", d.tags.map json.of_string),
-  ("description", d.description)
+  ("description", desc)
 ]
 
-meta instance : has_to_string tactic_doc_entry :=
-⟨json.unparse ∘ tactic_doc_entry.to_json⟩
-
-/-- `update_description_from tde inh_id` replaces the `description` field of `tde` with the
-    doc string of the declaration named `inh_id`. -/
-meta def tactic_doc_entry.update_description_from (tde : tactic_doc_entry) (inh_id : name) :
-  tactic tactic_doc_entry :=
-do ds ← doc_string inh_id <|> fail (to_string inh_id ++ " has no doc string"),
-   return { description := ds .. tde }
-
-/--
-`update_description tde` replaces the `description` field of `tde` with:
-
-* the doc string of `tde.inherit_description_from`, if this field has a value
-* the doc string of the entry in `tde.decl_names`, if this field has length 1
-
-If neither of these conditions are met, it returns `tde`. -/
-meta def tactic_doc_entry.update_description (tde : tactic_doc_entry) : tactic tactic_doc_entry :=
-match tde.inherit_description_from, tde.decl_names with
-| some inh_id, _ := tde.update_description_from inh_id
-| none, [inh_id] := tde.update_description_from inh_id
-| none, _ := return tde
-end
+meta instance tactic_doc_entry.has_to_string : has_to_string (tactic_doc_entry × string) :=
+⟨λ ⟨doc, desc⟩, json.unparse (doc.to_json desc)⟩
 
 /-- A user attribute `tactic_doc` for tagging decls of type `tactic_doc_entry`
 for use in doc output -/
@@ -181,26 +162,31 @@ for use in doc output -/
   parser := failed }
 
 /-- Collects everything in the environment tagged with the attribute `tactic_doc`. -/
-meta def tactic.get_tactic_doc_entries : tactic (list tactic_doc_entry) :=
+meta def tactic.get_tactic_doc_entries : tactic (list (tactic_doc_entry × string)) :=
 attribute.get_instances `tactic_doc >>=
-  list.mmap (λ dcl, mk_const dcl >>= eval_expr tactic_doc_entry)
+  list.mmap (λ dcl, prod.mk <$> (mk_const dcl >>= eval_expr tactic_doc_entry) <*> doc_string dcl)
 
 /-- `add_tactic_doc tde` adds a declaration to the environment
 with `tde` as its body and tags it with the `tactic_doc`
 attribute. If `tde.decl_names` has exactly one entry `` `decl`` and
 if `tde.description` is the empty string, `add_tactic_doc` uses the doc
 string of `decl` as the description. -/
-meta def tactic.add_tactic_doc (tde : tactic_doc_entry) : tactic unit :=
-do when (tde.description = "" ∧ tde.inherit_description_from.is_none ∧ tde.decl_names.length ≠ 1) $
-     fail "A tactic doc entry must either:
+meta def tactic.add_tactic_doc (tde : tactic_doc_entry) (doc : option string) : tactic unit :=
+do desc ← doc <|> (do
+    inh_id ← match tde.inherit_description_from, tde.decl_names with
+    | some inh_id, _ := pure inh_id
+    | none, [inh_id] := pure inh_id
+    | none, _ := fail "A tactic doc entry must either:
  1. have a description written as a doc-string for the `add_tactic_doc` invocation, or
  2. have a single declaration in the `decl_names` field, to inherit a description from, or
  3. explicitly indicate the declaration to inherit the description from using
-    `inherit_description_from`.",
-   tde ← if tde.description = "" then tde.update_description else return tde,
-   let decl_name := (tde.name ++ tde.category.to_string).mk_hashed_name `tactic_doc,
-   add_decl $ mk_definition decl_name [] `(tactic_doc_entry) (reflect tde),
-   tactic_doc_entry_attr.set decl_name () tt none
+    `inherit_description_from`."
+    end,
+    doc_string inh_id <|> fail (to_string inh_id ++ " has no doc string")),
+  let decl_name := `tactic_doc <.> tde.category.to_string <.> tde.name,
+  add_decl $ mk_definition decl_name [] `(tactic_doc_entry) (reflect tde),
+  add_doc_string decl_name desc,
+  tactic_doc_entry_attr.set decl_name () tt none
 
 /--
 A command used to add documentation for a tactic, command, hole command, or attribute.
@@ -247,11 +233,7 @@ messages.
   (_ : parse $ tk "add_tactic_doc") : parser unit := do
 pe ← parser.pexpr,
 e ← eval_pexpr tactic_doc_entry pe,
-let e : tactic_doc_entry := match mi.doc_string with
-  | some desc := { description := desc, ..e }
-  | none := e
-  end,
-tactic.add_tactic_doc e .
+tactic.add_tactic_doc e mi.doc_string .
 
 /--
 At various places in mathlib, we leave implementation notes that are referenced from many other
diff --git a/src/tactic/equiv_rw.lean b/src/tactic/equiv_rw.lean
index d23a1d86db529..ca74919c3eecc 100644
--- a/src/tactic/equiv_rw.lean
+++ b/src/tactic/equiv_rw.lean
@@ -3,7 +3,7 @@ Copyright (c) 2019 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import logic.equiv.basic
+import logic.equiv.defs
 import tactic.clear
 import tactic.simp_result
 import tactic.apply
@@ -187,11 +187,6 @@ do
   -- to compress away some `map_equiv equiv.refl` subexpressions.
   prod.fst <$> new_eqv.simp {fail_if_unchanged := ff}
 
-mk_simp_attribute equiv_rw_simp "The simpset `equiv_rw_simp` is used by the tactic `equiv_rw` to
-simplify applications of equivalences and their inverses."
-
-attribute [equiv_rw_simp] equiv.symm_symm equiv.apply_symm_apply equiv.symm_apply_apply
-
 /--
 Attempt to replace the hypothesis with name `x`
 by transporting it along the equivalence in `e : α ≃ β`.
diff --git a/src/tactic/expand_exists.lean b/src/tactic/expand_exists.lean
new file mode 100644
index 0000000000000..9d3a8e62c899b
--- /dev/null
+++ b/src/tactic/expand_exists.lean
@@ -0,0 +1,221 @@
+/-
+Copyright (c) 2022 Ian Wood. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ian Wood
+-/
+import meta.expr
+
+/-!
+# `expand_exists`
+
+`expand_exists` is an attribute which takes a proof that something exists with some property, and
+outputs a value using `classical.some`, and a proof that it has that property using
+`classical.some_spec`. For example:
+
+```lean
+@[expand_exists it it_spec]
+lemma it_exists (n : ℕ) : ∃ m : ℕ, n < m := sorry
+```
+
+produces
+
+```
+def it (n : ℕ) : ℕ := classical.some (it_exists n)
+
+lemma it_spec (n : ℕ) : n < it n := classical.some_spec (it_exists n)
+```
+-/
+
+namespace tactic
+
+open expr
+
+namespace expand_exists
+
+/--
+Data known when parsing pi expressions.
+
+`decl`'s arguments are: is_theorem, name, type, value.
+-/
+meta structure parse_ctx :=
+(original_decl : declaration)
+(decl : bool → name → expr → pexpr → tactic unit)
+(names : list name)
+(pis_depth : ℕ := 0)
+
+/--
+Data known when parsing exists expressions (after parsing pi expressions).
+
+* `with_args` applies pi arguments to a term (eg `id` -> `id #2 #1 #0`).
+* `spec_chain` takes the form of `classical.some_spec^n (it_exists ...)`,
+with `n` the depth of `∃` parsed.
+* `exists_decls` is a list of declarations containing the value(s) of witnesses.
+-/
+meta structure parse_ctx_exists extends parse_ctx :=
+(with_args : expr → expr)
+(spec_chain : pexpr)
+(exists_decls : list name := [])
+
+/--
+Data known when parsing the proposition (after parsing exists and pi expressions).
+
+`project_proof` projects a proof of the full proposition (eg `A ∧ B ∧ C`) to a specific proof (eg
+`B`).
+-/
+meta structure parse_ctx_props extends parse_ctx_exists :=
+(project_proof : pexpr → pexpr := id)
+
+/--
+Replaces free variables with their exists declaration. For example, if:
+
+```lean
+def n_value : ℕ := ... -- generated by `expand_exists`
+```
+
+then this function converts `#0` in `#0 = #0` from `∃ n : ℕ, n = n` to `n_value = n_value`.
+-/
+meta def instantiate_exists_decls (ctx : parse_ctx_exists) (p : expr) : expr :=
+p.instantiate_vars $ ctx.exists_decls.reverse.map (λname,
+  ctx.with_args (const name ctx.original_decl.univ_levels))
+
+/--
+Parses a proposition and creates the associated specification proof. Does not break down the
+proposition further.
+-/
+meta def parse_one_prop (ctx : parse_ctx_props) (p : expr) : tactic unit :=
+do
+  let p : expr := instantiate_exists_decls { ..ctx } p,
+  let val : pexpr := ctx.project_proof ctx.spec_chain,
+  n <- match ctx.names with
+  | [n] := return n
+  | [] := fail "missing name for proposition"
+  | _ := fail "too many names for propositions (are you missing an and?)"
+  end,
+  ctx.decl true n p val
+
+/--
+Parses a proposition and decides if it should be broken down (eg `P ∧ Q` -> `P` and `Q`) depending
+on how many `names` are left. Then creates the associated specification proof(s).
+-/
+meta def parse_props : parse_ctx_props → expr → tactic unit
+| ctx (app (app (const "and" []) p) q) := do
+  match ctx.names with
+  | [n] := parse_one_prop ctx (app (app (const `and []) p) q)
+  | (n :: tail) :=
+    parse_one_prop { names := [n],
+      project_proof := (λ p, (const `and.left []) p) ∘ ctx.project_proof,
+      ..ctx } p
+    >> parse_props { names := tail,
+      project_proof := (λ p, (const `and.right []) p) ∘ ctx.project_proof,
+      ..ctx } q
+  | [] := fail "missing name for proposition"
+  end
+| ctx p := parse_one_prop ctx p
+
+/--
+Parses an `∃ a : α, p a`, and creates an associated definition with a value of `α`. When `p α` is
+not an exists statement, it will call `parse_props`.
+-/
+meta def parse_exists : parse_ctx_exists → expr → tactic unit
+| ctx (app (app (const "Exists" [lvl]) type) (lam var_name bi var_type body)) := do
+  /- TODO: Is this needed, and/or does this create issues? -/
+  (if type = var_type then tactic.skip else tactic.fail "exists types should be equal"),
+  ⟨n, names⟩ <- match ctx.names with
+  | (n :: tail) := return (n, tail)
+  | [] := fail "missing name for exists"
+  end,
+  -- Type may be dependant on earlier arguments.
+  let type := instantiate_exists_decls ctx type,
+  let value : pexpr := (const `classical.some [lvl]) ctx.spec_chain,
+  ctx.decl false n type value,
+
+  let exists_decls := ctx.exists_decls.concat n,
+  let some_spec : pexpr := (const `classical.some_spec [lvl]) ctx.spec_chain,
+  let ctx : parse_ctx_exists := { names := names,
+    spec_chain := some_spec,
+    exists_decls := exists_decls,
+    ..ctx },
+  parse_exists ctx body
+| ctx e := parse_props { ..ctx } e
+
+/--
+Parses a `∀ (a : α), p a`. If `p` is not a pi expression, it will call `parse_exists`
+-/
+meta def parse_pis : parse_ctx → expr → tactic unit
+| ctx (pi n bi ty body) :=
+  -- When making a declaration, wrap in an equivalent pi expression.
+  let decl := (λ is_theorem name type val,
+    ctx.decl is_theorem name (pi n bi ty type) (lam n bi (to_pexpr ty) val)) in
+  parse_pis { decl := decl, pis_depth := ctx.pis_depth + 1, ..ctx } body
+| ctx (app (app (const "Exists" [lvl]) type) p) :=
+  let with_args := (λ (e : expr),
+    (list.range ctx.pis_depth).foldr (λ n (e : expr), e (var n)) e) in
+  parse_exists { with_args := with_args,
+    spec_chain := to_pexpr (
+      with_args $ const ctx.original_decl.to_name ctx.original_decl.univ_levels),
+    ..ctx } (app (app (const "Exists" [lvl]) type) p)
+| ctx e := fail ("unexpected expression " ++ to_string e)
+
+end expand_exists
+
+/--
+From a proof that (a) value(s) exist(s) with certain properties, constructs (an) instance(s)
+satisfying those properties. For instance:
+
+```lean
+@[expand_exists nat_greater nat_greater_spec]
+lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m := ...
+
+#check nat_greater      -- nat_greater : ℕ → ℕ
+#check nat_greater_spec -- nat_greater_spec : ∀ (n : ℕ), n < nat_greater n
+```
+
+It supports multiple witnesses:
+
+```lean
+@[expand_exists nat_greater_m nat_greater_l nat_greater_spec]
+lemma nat_greater_exists (n : ℕ) : ∃ (m l : ℕ), n < m ∧ m < l := ...
+
+#check nat_greater_m      -- nat_greater : ℕ → ℕ
+#check nat_greater_l      -- nat_greater : ℕ → ℕ
+#check nat_greater_spec-- nat_greater_spec : ∀ (n : ℕ),
+  n < nat_greater_m n ∧ nat_greater_m n < nat_greater_l n
+```
+
+It also supports logical conjunctions:
+```lean
+@[expand_exists nat_greater nat_greater_lt nat_greater_nonzero]
+lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m ∧ m ≠ 0 := ...
+
+#check nat_greater         -- nat_greater : ℕ → ℕ
+#check nat_greater_lt      -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n
+#check nat_greater_nonzero -- nat_greater_nonzero : ∀ (n : ℕ), nat_greater n ≠ 0
+```
+Note that without the last argument `nat_greater_nonzero`, `nat_greater_lt` would be:
+```lean
+#check nat_greater_lt -- nat_greater_lt : ∀ (n : ℕ), n < nat_greater n ∧ nat_greater n ≠ 0
+```
+-/
+@[user_attribute]
+meta def expand_exists_attr : user_attribute unit (list name) :=
+{ name := "expand_exists",
+  descr := "From a proof that (a) value(s) exist(s) with certain properties, "
+  ++ "constructs (an) instance(s) satisfying those properties.",
+  parser := lean.parser.many lean.parser.ident,
+  after_set := some $ λ decl prio persistent, do
+    d <- get_decl decl,
+    names <- expand_exists_attr.get_param decl,
+    expand_exists.parse_pis
+    { original_decl := d,
+      decl := λ is_t n ty val, (tactic.to_expr val >>= λ val,
+        tactic.add_decl (if is_t then declaration.thm n d.univ_params ty (pure val)
+          else declaration.defn n d.univ_params ty val default tt)),
+      names := names } d.type }
+
+add_tactic_doc
+{ name := "expand_exists",
+  category := doc_category.attr,
+  decl_names := [`tactic.expand_exists_attr],
+  tags := ["lemma derivation", "environment"] }
+
+end tactic
diff --git a/src/tactic/explode.lean b/src/tactic/explode.lean
index 4708ff310e253..4307de7d5ced6 100644
--- a/src/tactic/explode.lean
+++ b/src/tactic/explode.lean
@@ -65,7 +65,7 @@ meta def entries.head (es : entries) : option entry := es.l.head'
 meta def format_aux : list string → list string → list string → list entry → tactic format
 | (line :: lines) (dep :: deps) (thm :: thms) (en :: es) := do
   fmt ← do
-  { let margin := string.join (list.repeat " │" en.depth),
+  { let margin := string.join (list.replicate en.depth " │"),
     let margin := match en.status with
       | status.sintro := " ├" ++ margin
       | status.intro := " │" ++ margin ++ " ┌"
diff --git a/src/tactic/ext.lean b/src/tactic/ext.lean
index 4701da0e00f6e..f7e422bc6ed89 100644
--- a/src/tactic/ext.lean
+++ b/src/tactic/ext.lean
@@ -296,10 +296,8 @@ meta def extensional_attribute : user_attribute unit (option name) :=
 { name := `ext,
   descr := "lemmas usable by `ext` tactic",
   parser := optional ident,
-  before_unset := some $ λ _ _, pure (),
   after_set := some $ λ n _ b, do
     add ← extensional_attribute.get_param n,
-    unset_attribute `ext n,
     e ← get_env,
     n ← if (e.structure_fields n).is_some
       then derive_struct_ext_lemma n
@@ -447,8 +445,8 @@ do ⟨_, σ⟩ ← state_t.run (ext_core cfg) {patts := xs, fuel := fuel},
    when trace $ tactic.trace $ "Try this: " ++  ", ".intercalate σ.trace_msg,
    pure σ.patts
 
-local postfix `?`:9001 := optional
-local postfix *:9001 := many
+local postfix (name := parser.optional) `?`:9001 := optional
+local postfix (name := parser.many) *:9001 := many
 
 /--
 `ext1 id` selects and apply one extensionality lemma (with attribute
diff --git a/src/tactic/field_simp.lean b/src/tactic/field_simp.lean
index 7255410dc0798..799934c18998d 100644
--- a/src/tactic/field_simp.lean
+++ b/src/tactic/field_simp.lean
@@ -76,6 +76,14 @@ begin
 end
 ```
 
+Moreover, the `field_simp` tactic can also take care of inverses of units in
+a general (commutative) monoid/ring and partial division `/ₚ`, see `algebra.group.units`
+for the definition. Analogue to the case above, the lemma `one_divp` is removed from the simpset
+as this works against the algorithm. If you have objects with a `is_unit x` instance like
+`(x : R) (hx : is_unit x)`, you should lift them with
+`lift x to Rˣ using id hx, rw is_unit.unit_of_coe_units, clear hx`
+before using `field_simp`.
+
 See also the `cancel_denoms` tactic, which tries to do a similar simplification for expressions
 that have numerals in denominators.
 The tactics are not related: `cancel_denoms` will only handle numeric denominators, and will try to
@@ -86,7 +94,8 @@ meta def field_simp (no_dflt : parse only_flag) (hs : parse simp_arg_list)
   (locat : parse location)
   (cfg : simp_config_ext := {discharger := field_simp.ne_zero}) : tactic unit :=
 let attr_names := `field_simps :: attr_names,
-    hs := simp_arg_type.except `one_div :: simp_arg_type.except `mul_eq_zero :: hs in
+    hs := simp_arg_type.except `one_div :: simp_arg_type.except `mul_eq_zero ::
+          simp_arg_type.except `one_divp :: hs in
 propagate_tags (simp_core cfg.to_simp_config cfg.discharger no_dflt hs attr_names locat >> skip)
 
 add_tactic_doc
diff --git a/src/tactic/fin_cases.lean b/src/tactic/fin_cases.lean
index 6e0a575cd81c6..1c08c6aa61db0 100644
--- a/src/tactic/fin_cases.lean
+++ b/src/tactic/fin_cases.lean
@@ -59,7 +59,7 @@ private meta def fin_cases_at_aux : Π (with_list : list expr) (e : expr), tacti
         -- because it's helpful for the `interval_cases` tactic.
         | _ := try $ tactic.interactive.conv (some sn) none $
                to_rhs >> conv.interactive.norm_num
-                 [simp_arg_type.expr ``(max_def), simp_arg_type.expr ``(min_def)]
+                 [simp_arg_type.expr ``(max_def'), simp_arg_type.expr ``(min_def)]
         end,
         s ← get_local sn,
         try `[subst %%s],
@@ -78,8 +78,8 @@ for example, to display nats as `n.succ` instead of `n+1`.
 These should be defeq to and in the same order as the terms in the enumeration of `α`.
 -/
 meta def fin_cases_at (nm : option name) : Π (with_list : option pexpr) (e : expr), tactic unit
-| with_list e :=
-do ty ← try_core $ guard_mem_fin e,
+| with_list e := focus1 $
+  do ty ← try_core $ guard_mem_fin e,
     match ty with
     | none := -- Deal with `x : A`, where `[fintype A]` is available:
       (do
@@ -151,7 +151,7 @@ produces three goals with hypotheses
 -/
 meta def fin_cases :
   parse hyp → parse (tk "with" *> texpr)? → parse (tk "using" *> ident)? → tactic unit
-| none none nm := focus1 $ do
+| none none nm := do
     ctx ← local_context,
     ctx.mfirst (fin_cases_at nm none) <|>
       fail ("No hypothesis of the forms `x ∈ A`, where " ++
@@ -160,7 +160,7 @@ meta def fin_cases :
 | (some n) with_list nm :=
   do
     h ← get_local n,
-    focus1 $ fin_cases_at nm with_list h
+    fin_cases_at nm with_list h
 
 end interactive
 
diff --git a/src/tactic/fix_reflect_string.lean b/src/tactic/fix_reflect_string.lean
deleted file mode 100644
index 2657700a5d25e..0000000000000
--- a/src/tactic/fix_reflect_string.lean
+++ /dev/null
@@ -1,42 +0,0 @@
-/-
-Copyright (c) 2020 Gabriel Ebner. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Gabriel Ebner
--/
-
-/-!
-
-# Workaround for stack overflows with `has_reflect string`
-
-The default `has_reflect string` instance in Lean only work for strings up to
-few thousand characters.  Anything larger than that will trigger a stack overflow because
-the string is represented as a very deeply nested expression:
-https://github.com/leanprover-community/lean/issues/144
-
-This file adds a higher-priority instance for `has_reflect string`, which
-behaves exactly the same for small strings (up to 256 characters). Larger
-strings are carefully converted into a call to `string.join`.
-
--/
-
-/--
-Splits a string into chunks of at most `size` characters.
--/
-meta def string.to_chunks (size : ℕ) : string → opt_param (list string) [] → list string | s acc :=
-if s.length ≤ size then s :: acc else
-string.to_chunks (s.popn_back size) (s.backn size :: acc)
-
-section
-local attribute [semireducible] reflected
-meta instance {α} [has_reflect α] : has_reflect (thunk α) | a :=
-expr.lam `x binder_info.default (reflect unit) (reflect $ a ())
-end
-
-@[priority 2000]
-meta instance : has_reflect string | s :=
-let chunk_size := 256 in
-if s.length ≤ chunk_size then reflect s else
-have ts : list (thunk string), from (s.to_chunks chunk_size).map (λ s _, s),
-have h : s = string.join (ts.map (λ t, t ())), from undefined,
-suffices reflected (string.join $ ts.map (λ t, t ())), by rwa h,
-`(string.join $ list.map _ _)
diff --git a/src/tactic/generalize_proofs.lean b/src/tactic/generalize_proofs.lean
index 205f46294d8a6..1f380aecab555 100644
--- a/src/tactic/generalize_proofs.lean
+++ b/src/tactic/generalize_proofs.lean
@@ -75,7 +75,7 @@ do intros_dep,
   collect_proofs_in t [] (ns, hs),
   intron n <|> (intros $> ())
 
-local postfix *:9001 := many
+local postfix (name := parser.many) *:9001 := many
 
 namespace interactive
 /-- Generalize proofs in the goal, naming them with the provided list.
diff --git a/src/tactic/group.lean b/src/tactic/group.lean
index d1ea8f30697df..e9603a022658f 100644
--- a/src/tactic/group.lean
+++ b/src/tactic/group.lean
@@ -5,10 +5,14 @@ Authors: Patrick Massot
 -/
 import tactic.ring
 import tactic.doc_commands
+import algebra.group.commutator
 
 /-!
 # `group`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Normalizes expressions in the language of groups. The basic idea is to use the simplifier
 to put everything into a product of group powers (`zpow` which takes a group element and an
 integer), then simplify the exponents using the `ring` tactic. The process needs to be repeated
@@ -49,7 +53,7 @@ open tactic.simp_arg_type interactive tactic.group
 
 /-- Auxiliary tactic for the `group` tactic. Calls the simplifier only. -/
 meta def aux_group₁ (locat : loc) : tactic unit :=
-  simp_core {} skip tt [
+simp_core { fail_if_unchanged := ff } skip tt [
   expr ``(commutator_element_def),
   expr ``(mul_one),
   expr ``(one_mul),
@@ -113,7 +117,7 @@ end
 -/
 meta def group (locat : parse location) : tactic unit :=
 do when locat.include_goal `[rw ← mul_inv_eq_one],
-   try (aux_group₁ locat),
+   aux_group₁ locat,
    repeat (aux_group₂ locat ; aux_group₁ locat)
 
 end tactic.interactive
diff --git a/src/tactic/induction.lean b/src/tactic/induction.lean
index 0c3e6d5b12961..c2b6e7cbda8d3 100644
--- a/src/tactic/induction.lean
+++ b/src/tactic/induction.lean
@@ -1173,7 +1173,7 @@ focus1 $ do
   let rec_app : name → pexpr := λ rec_suffix,
     (unchecked_cast expr.mk_app : pexpr → list pexpr → pexpr)
       (pexpr.mk_explicit (const (iname ++ rec_suffix) []))
-      (list.repeat pexpr.mk_placeholder (major_premise_args.length + 1) ++
+      (list.replicate (major_premise_args.length + 1) pexpr.mk_placeholder ++
         [to_pexpr major_premise]),
   let rec_suffix := if generate_ihs then "rec_on" else "cases_on",
   let drec_suffix := if generate_ihs then "drec_on" else "dcases_on",
diff --git a/src/tactic/interactive.lean b/src/tactic/interactive.lean
index 3fa89e69cb0b5..462543ebd069c 100644
--- a/src/tactic/interactive.lean
+++ b/src/tactic/interactive.lean
@@ -186,8 +186,12 @@ add_tactic_doc
   decl_names := [`tactic.interactive.replace],
   tags       := ["context management"] }
 
-/-- Make every proposition in the context decidable. -/
-meta def classical := tactic.classical
+/-- Make every proposition in the context decidable.
+
+`classical!` does this more aggressively, such that even if a decidable instance is already
+available for a specific proposition, the noncomputable one will be used instead. -/
+meta def classical (bang : parse $ (tk "!")?) :=
+tactic.classical bang.is_some
 
 add_tactic_doc
 { name       := "classical",
@@ -511,7 +515,7 @@ attribute from the list `attrs`, as well as the `assumption` tactic on the
 first goal and the resulting subgoals, iteratively, at most `n` times.
 `n` is optional, equal to 50 by default.
 You can pass an `apply_cfg` option argument as `apply_rules hs n opt`.
-(A typical usage would be with `apply_rules hs n { md := reducible })`,
+(A typical usage would be with `apply_rules hs n { md := reducible }`,
 which asks `apply_rules` to not unfold `semireducible` definitions (i.e. most)
 when checking if a lemma matches the goal.)
 
@@ -824,7 +828,7 @@ end
 meta def set (h_simp : parse (tk "!")?) (a : parse ident) (tp : parse ((tk ":") *> texpr)?)
   (_ : parse (tk ":=")) (pv : parse texpr)
   (rev_name : parse opt_dir_with) :=
-do tp ← i_to_expr $ tp.get_or_else pexpr.mk_placeholder,
+do tp ← i_to_expr $ let t := tp.get_or_else pexpr.mk_placeholder in ``(%%t : Sort*),
    pv ← to_expr ``(%%pv : %%tp),
    tp ← instantiate_mvars tp,
    definev a tp pv,
diff --git a/src/tactic/interval_cases.lean b/src/tactic/interval_cases.lean
index 424fb3c2fe9dc..5fd7bfac4410f 100644
--- a/src/tactic/interval_cases.lean
+++ b/src/tactic/interval_cases.lean
@@ -7,6 +7,7 @@ import tactic.fin_cases
 import data.fin.interval -- These imports aren't required to compile this file,
 import data.int.interval -- but they are needed at the use site for the tactic to work
 import data.pnat.interval -- (on values of type fin/int/pnat)
+import data.pnat.basic
 
 /-!
 # Case bash on variables in finite intervals
@@ -46,14 +47,14 @@ return that proof.
 -- We use `expr.to_rat` merely to decide if an `expr` is an explicit number.
 -- It would be more natural to use `expr.to_int`, but that hasn't been implemented.
 meta def gives_upper_bound (n e : expr) : tactic expr :=
-do t ← infer_type e,
+do t ← infer_type e >>= instantiate_mvars,
    match t with
    | `(%%n' < %%b) := do guard (n = n'), b ← b.to_rat, return e
    | `(%%b > %%n') := do guard (n = n'), b ← b.to_rat, return e
    | `(%%n' ≤ %%b) := do
       guard (n = n'),
       b ← b.to_rat,
-      tn ← infer_type n,
+      tn ← infer_type n >>= instantiate_mvars,
       match tn with
       | `(ℕ) := to_expr ``(nat.lt_add_one_iff.mpr %%e)
       | `(ℕ+) := to_expr ``(pnat.lt_add_one_iff.mpr %%e)
@@ -63,7 +64,7 @@ do t ← infer_type e,
    | `(%%b ≥ %%n') := do
       guard (n = n'),
       b ← b.to_rat,
-      tn ← infer_type n,
+      tn ← infer_type n >>= instantiate_mvars,
       match tn with
       | `(ℕ) := to_expr ``(nat.lt_add_one_iff.mpr %%e)
       | `(ℕ+) := to_expr ``(pnat.lt_add_one_iff.mpr %%e)
@@ -79,14 +80,14 @@ for some explicit `b`,
 return that proof.
 -/
 meta def gives_lower_bound (n e : expr) : tactic expr :=
-do t ← infer_type e,
+do t ← infer_type e >>= instantiate_mvars,
    match t with
    | `(%%n' ≥ %%b) := do guard (n = n'), b ← b.to_rat, return e
    | `(%%b ≤ %%n') := do guard (n = n'), b ← b.to_rat, return e
    | `(%%n' > %%b) := do
       guard (n = n'),
       b ← b.to_rat,
-      tn ← infer_type n,
+      tn ← infer_type n >>= instantiate_mvars,
       match tn with
       | `(ℕ) := to_expr ``(nat.add_one_le_iff.mpr %%e)
       | `(ℕ+) := to_expr ``(pnat.add_one_le_iff.mpr %%e)
@@ -96,7 +97,7 @@ do t ← infer_type e,
    | `(%%b < %%n') := do
       guard (n = n'),
       b ← b.to_rat,
-      tn ← infer_type n,
+      tn ← infer_type n >>= instantiate_mvars,
       match tn with
       | `(ℕ) := to_expr ``(nat.add_one_le_iff.mpr %%e)
       | `(ℕ+) := to_expr ``(pnat.add_one_le_iff.mpr %%e)
@@ -206,7 +207,7 @@ setup_tactic_parser
 
 namespace interactive
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 /--
 `interval_cases n` searches for upper and lower bounds on a variable `n`,
diff --git a/src/tactic/lift.lean b/src/tactic/lift.lean
index b17f0c1548ab6..6fa9bdf5ad5e2 100644
--- a/src/tactic/lift.lean
+++ b/src/tactic/lift.lean
@@ -3,7 +3,9 @@ Copyright (c) 2019 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
+
 import tactic.rcases
+
 /-!
 # lift tactic
 
@@ -17,60 +19,44 @@ lift, tactic
 
 /-- A class specifying that you can lift elements from `α` to `β` assuming `cond` is true.
   Used by the tactic `lift`. -/
-class can_lift (α β : Sort*) :=
-(coe : β → α)
-(cond : α → Prop)
+class can_lift (α β : Sort*) (coe : out_param $ β → α) (cond : out_param $ α → Prop) :=
 (prf : ∀(x : α), cond x → ∃(y : β), coe y = x)
 
-
-open tactic
-
-/--
-A user attribute used internally by the `lift` tactic.
-This should not be applied by hand.
--/
-@[user_attribute]
-meta def can_lift_attr : user_attribute (list name) :=
-{ name := "_can_lift",
-  descr := "internal attribute used by the lift tactic",
-  parser := failed,
-  cache_cfg :=
-  { mk_cache := λ _,
-      do { ls ← attribute.get_instances `instance,
-          ls.mfilter $ λ l,
-          do { (_,t) ← mk_const l >>= infer_type >>= open_pis,
-          return $ t.is_app_of `can_lift } },
-    dependencies := [`instance] } }
-
-instance : can_lift ℤ ℕ :=
-⟨coe, λ n, 0 ≤ n, λ n hn, ⟨n.nat_abs, int.nat_abs_of_nonneg hn⟩⟩
+instance : can_lift ℤ ℕ coe ((≤) 0) :=
+⟨λ n hn, ⟨n.nat_abs, int.nat_abs_of_nonneg hn⟩⟩
 
 /-- Enable automatic handling of pi types in `can_lift`. -/
-instance pi.can_lift (ι : Type*) (α : Π i : ι, Type*) (β : Π i : ι, Type*)
-  [Π i : ι, can_lift (α i) (β i)] :
-  can_lift (Π i : ι, α i) (Π i : ι, β i) :=
-{ coe := λ f i, can_lift.coe (f i),
-  cond := λ f, ∀ i, can_lift.cond (β i) (f i),
-  prf := λ f hf, ⟨λ i, classical.some (can_lift.prf (f i) (hf i)), funext $ λ i,
+instance pi.can_lift (ι : Sort*) (α β : ι → Sort*)
+  (coe : Π i, β i → α i) (P : Π i, α i → Prop)
+  [Π i : ι, can_lift (α i) (β i) (coe i) (P i)] :
+  can_lift (Π i : ι, α i) (Π i : ι, β i) (λ f i, coe i (f i)) (λ f, ∀ i, P i (f i)) :=
+{ prf := λ f hf, ⟨λ i, classical.some (can_lift.prf (f i) (hf i)), funext $ λ i,
     classical.some_spec (can_lift.prf (f i) (hf i))⟩ }
 
-instance pi_subtype.can_lift (ι : Type*) (α : Π i : ι, Type*) [ne : Π i, nonempty (α i)]
+lemma subtype.exists_pi_extension {ι : Sort*} {α : ι → Sort*} [ne : Π i, nonempty (α i)]
+  {p : ι → Prop} (f : Π i : subtype p, α i) :
+  ∃ g : Π i : ι, α i, (λ i : subtype p, g i) = f :=
+begin
+  tactic.classical,
+  refine ⟨λ i, if hi : p i then f ⟨i, hi⟩ else classical.choice (ne i), funext _⟩,
+  rintro ⟨i, hi⟩,
+  exact dif_pos hi
+end
+
+instance pi_subtype.can_lift (ι : Sort*) (α : ι → Sort*) [ne : Π i, nonempty (α i)]
   (p : ι → Prop) :
-  can_lift (Π i : subtype p, α i) (Π i, α i) :=
-{ coe := λ f i, f i,
-  cond := λ _, true,
-  prf :=
-    begin
-      classical,
-      refine λ f _, ⟨λ i, if hi : p i then f ⟨i, hi⟩ else classical.choice (ne i), funext _⟩,
-      rintro ⟨i, hi⟩,
-      exact dif_pos hi
-    end }
-
-instance pi_subtype.can_lift' (ι : Type*) (α : Type*) [ne : nonempty α] (p : ι → Prop) :
-  can_lift (subtype p → α) (ι → α) :=
+  can_lift (Π i : subtype p, α i) (Π i, α i) (λ f i, f i) (λ _, true) :=
+{ prf := λ f _, subtype.exists_pi_extension f }
+
+instance pi_subtype.can_lift' (ι : Sort*) (α : Sort*) [ne : nonempty α] (p : ι → Prop) :
+  can_lift (subtype p → α) (ι → α) (λ f i, f i) (λ _, true) :=
 pi_subtype.can_lift ι (λ _, α) p
 
+instance subtype.can_lift {α : Sort*} (p : α → Prop) : can_lift α {x // p x} coe p :=
+{ prf := λ a ha, ⟨⟨a, ha⟩, rfl⟩ }
+
+open tactic
+
 namespace tactic
 
 /--
@@ -80,23 +66,24 @@ Construct the proof of `cond x` in the lift tactic.
 *  `s` and `to_unfold` contain the information of the simp set used to simplify.
 
 If the proof was specified, we check whether it has the correct type.
-If it doesn't have the correct type, we display an error message
-(but first call dsimp on the expression in the message).
+If it doesn't have the correct type, we display an error message.
 
 If the proof was not specified, we create assert it as a local constant.
 (The name of this local constant doesn't matter, since `lift` will remove it from the context.)
 -/
-meta def get_lift_prf (h : option pexpr) (old_tp new_tp inst e : expr)
-  (s : simp_lemmas) (to_unfold : list name) : tactic expr := do
-  expected_prf_ty ← mk_app `can_lift.cond [old_tp, new_tp, inst, e],
-  expected_prf_ty ← s.dsimplify to_unfold expected_prf_ty,
-  if h_some : h.is_some then
-    decorate_error "lift tactic failed." $ i_to_expr ``((%%(option.get h_some) : %%expected_prf_ty))
-  else do
-    prf_nm ← get_unused_name,
-    prf ← assert prf_nm expected_prf_ty,
-    swap,
-    return prf
+meta def get_lift_prf (h : option pexpr) (e P : expr) : tactic (expr × bool) := do
+  let expected_prf_ty := P.app e,
+  expected_prf_ty ← simp_lemmas.mk.dsimplify [] expected_prf_ty {fail_if_unchanged := ff},
+  match h with
+  | some h := do
+      e ← decorate_error "lift tactic failed." (i_to_expr ``((%%h : %%expected_prf_ty))),
+      return (e, tt)
+  | none   := do
+      prf_nm ← get_unused_name,
+      prf ← assert prf_nm expected_prf_ty,
+      swap,
+      return (prf, ff)
+  end
 
 /-- Lift the expression `p` to the type `t`, with proof obligation given by `h`.
   The list `n` is used for the two newly generated names, and to specify whether `h` should
@@ -109,19 +96,21 @@ do
   e ← i_to_expr p,
   old_tp ← infer_type e,
   new_tp ← i_to_expr ``(%%t : Sort*),
-  inst_type ← mk_app ``can_lift [old_tp, new_tp],
+  coe ← i_to_expr (``(%%new_tp → %%old_tp)) >>= mk_meta_var,
+  P ← i_to_expr (``(%%old_tp → Prop)) >>= mk_meta_var,
+  inst_type ← mk_app ``can_lift [old_tp, new_tp, coe, P],
   inst ← mk_instance inst_type <|>
     pformat!"Failed to find a lift from {old_tp} to {new_tp}. Provide an instance of\n  {inst_type}"
     >>= fail,
-  /- make the simp set to get rid of `can_lift` projections -/
-  can_lift_instances ← can_lift_attr.get_cache >>= λ l, l.mmap resolve_name,
-  (s, to_unfold) ← mk_simp_set tt [] $ can_lift_instances.map simp_arg_type.expr,
-  prf_cond ← get_lift_prf h old_tp new_tp inst e s to_unfold,
+  inst ← instantiate_mvars inst,
+  coe ← instantiate_mvars coe,
+  P ← instantiate_mvars P,
+  (prf_cond, b) ← get_lift_prf h e P,
   let prf_nm := if prf_cond.is_local_constant then some prf_cond.local_pp_name else none,
   /- We use mk_mapp to apply `can_lift.prf` to all but one argument, and then just use expr.app
   for the last argument. For some reason we get an error when applying mk_mapp it to all
   arguments. -/
-  prf_ex0 ← mk_mapp `can_lift.prf [old_tp, new_tp, inst, e],
+  prf_ex0 ← mk_mapp `can_lift.prf [old_tp, new_tp, coe, P, inst, e],
   let prf_ex := prf_ex0 prf_cond,
   /- Find the name of the new variable -/
   new_nm ← if n ≠ [] then return n.head
@@ -131,11 +120,10 @@ do
   eq_nm ← if hn : 1 < n.length then return (n.nth_le 1 hn)
     else if e.is_local_constant then return `rfl
     else get_unused_name `h,
-  /- We add the proof of the existential statement to the context and then apply
-  `dsimp` to it, unfolding all `can_lift` instances. -/
+  /- We add the proof of the existential statement to the context -/
   temp_nm ← get_unused_name,
   temp_e ← note temp_nm none prf_ex,
-  dsimp_hyp temp_e s to_unfold {},
+  dsimp_hyp temp_e none [] { fail_if_unchanged := ff },
   /- We case on the existential. We use `rcases` because `eq_nm` could be `rfl`. -/
   rcases none (pexpr.of_expr temp_e) $ rcases_patt.tuple ([new_nm, eq_nm].map rcases_patt.one),
   /- If the lifted variable is not a local constant,
@@ -145,7 +133,8 @@ do
   /- If the proof `prf_cond` is a local constant, remove it from the context,
     unless `n` specifies to keep it. -/
   if h_prf_nm : prf_nm.is_some ∧ n.nth 2 ≠ prf_nm then
-    get_local (option.get h_prf_nm.1) >>= clear else skip
+    get_local (option.get h_prf_nm.1) >>= clear else skip,
+  if b then skip else swap
 
 setup_tactic_parser
 
@@ -168,9 +157,10 @@ Lift an expression to another type.
     (here `P` is some term of type `ℤ → Prop`).
 * The argument `using hn` is optional, the tactic `lift n to ℕ` does the same, but also creates a
   new subgoal that `n ≥ 0` (where `n` is the old variable).
+  This subgoal will be placed at the top of the goal list.
   + So for example the tactic `lift n to ℕ` transforms the goal
     `n : ℤ, h : P n ⊢ n = 3` to two goals
-    `n : ℕ, h : P ↑n ⊢ ↑n = 3` and `n : ℤ, h : P n ⊢ n ≥ 0`.
+    `n : ℤ, h : P n ⊢ n ≥ 0` and `n : ℕ, h : P ↑n ⊢ ↑n = 3`.
 * You can also use `lift n to ℕ using e` where `e` is any expression of type `n ≥ 0`.
 * Use `lift n to ℕ with k` to specify the name of the new variable.
 * Use `lift n to ℕ with k hk` to also specify the name of the equality `↑k = n`. In this case, `n`
diff --git a/src/tactic/linarith/datatypes.lean b/src/tactic/linarith/datatypes.lean
index 0dde18107ad40..52bc606a08fb8 100644
--- a/src/tactic/linarith/datatypes.lean
+++ b/src/tactic/linarith/datatypes.lean
@@ -311,7 +311,7 @@ list comp → ℕ → tactic (rb_map ℕ ℕ)
 meta structure linarith_config : Type :=
 (discharger : tactic unit := `[ring])
 (restrict_type : option Type := none)
-(restrict_type_reflect : reflected restrict_type . tactic.apply_instance)
+(restrict_type_reflect : reflected _ restrict_type . tactic.apply_instance)
 (exfalso : bool := tt)
 (transparency : tactic.transparency := reducible)
 (split_hypotheses : bool := tt)
@@ -369,13 +369,13 @@ Typically `R` and `R'` will be the same, except when `c = 0`, in which case `R'`
 If `c = 1`, `h'` is the same as `h` -- specifically, it does *not* change the type to `1*t R 0`.
 -/
 meta def mk_single_comp_zero_pf (c : ℕ) (h : expr) : tactic (ineq × expr) :=
-do tp ← infer_type h,
+do tp ← infer_type h >>= instantiate_mvars,
   some (iq, e) ← return $ parse_into_comp_and_expr tp,
   if c = 0 then
     do e' ← mk_app ``zero_mul [e], return (ineq.eq, e')
   else if c = 1 then return (iq, h)
   else
-    do tp ← (prod.snd <$> (infer_type h >>= get_rel_sides)) >>= infer_type,
+    do tp ← (prod.snd <$> (infer_type h >>= instantiate_mvars >>= get_rel_sides)) >>= infer_type,
        c ← tp.of_nat c,
        cpos ← to_expr ``(%%c > 0),
        (_, ex) ← solve_aux cpos `[norm_num, done],
diff --git a/src/tactic/linarith/elimination.lean b/src/tactic/linarith/elimination.lean
index 96b02a814a394..40a041081dd33 100644
--- a/src/tactic/linarith/elimination.lean
+++ b/src/tactic/linarith/elimination.lean
@@ -79,18 +79,17 @@ along with information about how this comparison was derived.
 The original expressions fed into `linarith` are each assigned a unique natural number label.
 The *historical set* `pcomp.history` stores the labels of expressions
 that were used in deriving the current `pcomp`.
-Variables are also indexed by natural numbers. The sets `pcomp.effective`, `pcomp.implicit`,
-and `pcomp.vars` contain variable indices.
-* `pcomp.vars` contains the variables that appear in `pcomp.c`. We store them in `pcomp` to
-  avoid recomputing the set, which requires folding over a list. (TODO: is this really needed?)
+Variables are also indexed by natural numbers. The sets `PComp.effective`, `PComp.implicit`,
+and `PComp.vars` contain variable indices.
+* `pcomp.vars` contains the variables that appear in any inequality in the historical set.
 * `pcomp.effective` contains the variables that have been effectively eliminated from `pcomp`.
-  A variable `n` is said to be *effectively eliminated* in `pcomp` if the elimination of `n`
-  produced at least one of the ancestors of `pcomp`.
+  A variable `n` is said to be *effectively eliminated* in `p : pcomp` if the elimination of `n`
+  produced at least one of the ancestors of `p` (or `p` itself).
 * `pcomp.implicit` contains the variables that have been implicitly eliminated from `pcomp`.
-  A variable `n` is said to be *implicitly eliminated* in `pcomp` if it satisfies the following
+  A variable `n` is said to be *implicitly eliminated* in `p` if it satisfies the following
   properties:
-  - There is some `ancestor` of `pcomp` such that `n` appears in `ancestor.vars`.
-  - `n` does not appear in `pcomp.vars`.
+  - `n` appears in some inequality in the historical set (i.e. in `p.vars`).
+  - `n` does not appear in `p.c.vars` (i.e. it has been eliminated).
   - `n` was not effectively eliminated.
 
 We track these sets in order to compute whether the history of a `pcomp` is *minimal*.
@@ -115,8 +114,7 @@ This test is an overapproximation to minimality. It gives necessary but not suff
 If the history of `c` is minimal, then `c.maybe_minimal` is true,
 but `c.maybe_minimal` may also be true for some `c` with minimal history.
 Thus, if `c.maybe_minimal` is false, `c` is known not to be minimal and must be redundant.
-See http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.51.493&rep=rep1&type=pdf p.13
-(Theorem 7).
+See https://doi.org/10.1016/B978-0-444-88771-9.50019-2 (Theorem 13).
 The condition described there considers only implicitly eliminated variables that have been
 officially eliminated from the system. This is not the case for every implicitly eliminated
 variable. Consider eliminating `z` from `{x + y + z < 0, x - y - z < 0}`. The result is the set
@@ -149,20 +147,24 @@ and does not appear in the sum.
 Computing the sum of the two comparisons is easy; the complicated details lie in tracking the
 additional fields of `pcomp`.
 * The historical set `pcomp.history` of `c1 + c2` is the union of the two historical sets.
-* We recompute the variables that appear in `c1 + c2` from the newly created `linexp`,
-  since some may have been implicitly eliminated.
+* `vars` is the union of `c1.vars` and `c2.vars`.
 * The effectively eliminated variables of `c1 + c2` are the union of the two effective sets,
   with `elim_var` inserted.
-* The implicitly eliminated variables of `c1 + c2` are those that appear in at least one of
-  `c1.vars` and `c2.vars` but not in `(c1 + c2).vars`, excluding `elim_var`.
+* The implicitly eliminated variables of `c1 + c2` are those that appear in
+  `vars` but not `c.vars` or `effective`.
+(Note that the description of the implicitly eliminated variables of `c1 + c2` in the algorithm
+described in Section 6 of https://doi.org/10.1016/B978-0-444-88771-9.50019-2 seems to be wrong:
+that says it should be `(c1.implicit.union c2.implicit).sdiff explicit`.
+Since the implicitly eliminated sets start off empty for the assumption,
+this formula would leave them always empty.)
 -/
 meta def pcomp.add (c1 c2 : pcomp) (elim_var : ℕ) : pcomp :=
 let c := c1.c.add c2.c,
     src := c1.src.add c2.src,
     history := c1.history.union c2.history,
-    vars := native.rb_set.of_list c.vars,
+    vars := c1.vars.union c2.vars,
     effective := (c1.effective.union c2.effective).insert elim_var,
-    implicit := ((c1.vars.union c2.vars).sdiff vars).erase elim_var in
+    implicit := (vars.sdiff (rb_set.of_list c.vars)).sdiff effective in
 ⟨c, src, history, effective, implicit, vars⟩
 
 /--
diff --git a/src/tactic/linarith/frontend.lean b/src/tactic/linarith/frontend.lean
index 80feb1ee51be8..f09b0cedc5ca5 100644
--- a/src/tactic/linarith/frontend.lean
+++ b/src/tactic/linarith/frontend.lean
@@ -151,7 +151,7 @@ newly introduced local constant.
 Otherwise returns `none`.
 -/
 meta def apply_contr_lemma : tactic (option (expr × expr)) :=
-do t ← target,
+do t ← target >>= instantiate_mvars,
    match get_contr_lemma_name_and_type t with
    | some (nm, tp) :=
      do refine ((expr.const nm []) pexpr.mk_placeholder), v ← intro1, return $ some (tp, v)
@@ -207,7 +207,7 @@ to only those that are comparisons over the type `restr_type`.
 -/
 meta def filter_hyps_to_type (restr_type : expr) (hyps : list expr) : tactic (list expr) :=
 hyps.mfilter $ λ h, do
-  ht ← infer_type h,
+  ht ← infer_type h >>= instantiate_mvars,
   match get_contr_lemma_name_and_type ht with
   | some (_, htype) := succeeds $ unify htype restr_type
   | none := return ff
@@ -238,7 +238,7 @@ expressions.
 meta def tactic.linarith (reduce_semi : bool) (only_on : bool) (hyps : list pexpr)
   (cfg : linarith_config := {}) : tactic unit :=
 focus1 $
-do t ← target,
+do t ← target >>= instantiate_mvars,
 -- if the target is an equality, we run `linarith` twice, to prove ≤ and ≥.
 if t.is_eq.is_some then
   linarith_trace "target is an equality: splitting" >>
@@ -257,7 +257,7 @@ do hyps ← hyps.mmap $ λ e, i_to_expr e >>= note_anon none,
      else fail "linarith failed: target is not a valid comparison",
    let cfg := cfg.update_reducibility reduce_semi,
    let (pref_type, new_var) :=
-     pref_type_and_new_var_from_tgt.elim (none, none) (λ ⟨a, b⟩, (some a, some b)),
+     pref_type_and_new_var_from_tgt.elim (none, none) (prod.map some some),
    -- set up the list of hypotheses, considering the `only_on` and `restrict_type` options
    hyps ← if only_on then return (new_var.elim [] singleton ++ hyps)
           else (++ hyps) <$> local_context,
diff --git a/src/tactic/linarith/lemmas.lean b/src/tactic/linarith/lemmas.lean
index d14c9a2497a22..c824cdc2eae40 100644
--- a/src/tactic/linarith/lemmas.lean
+++ b/src/tactic/linarith/lemmas.lean
@@ -4,9 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
 
-import algebra.order.ring
-import data.int.basic
-import tactic.norm_num
+import algebra.order.ring.defs
 
 /-!
 # Lemmas for `linarith`
@@ -17,32 +15,7 @@ If you find yourself looking for a theorem here, you might be in the wrong place
 
 namespace linarith
 
-lemma int.coe_nat_bit0 (n : ℕ) : (↑(bit0 n : ℕ) : ℤ) = bit0 (↑n : ℤ) := by simp [bit0]
-lemma int.coe_nat_bit1 (n : ℕ) : (↑(bit1 n : ℕ) : ℤ) = bit1 (↑n : ℤ) := by simp [bit1, bit0]
-lemma int.coe_nat_bit0_mul (n : ℕ) (x : ℕ) : (↑(bit0 n * x) : ℤ) = (↑(bit0 n) : ℤ) * (↑x : ℤ) :=
-by simp
-lemma int.coe_nat_bit1_mul (n : ℕ) (x : ℕ) : (↑(bit1 n * x) : ℤ) = (↑(bit1 n) : ℤ) * (↑x : ℤ) :=
-by simp
-lemma int.coe_nat_one_mul (x : ℕ) : (↑(1 * x) : ℤ) = 1 * (↑x : ℤ) := by simp
-lemma int.coe_nat_zero_mul (x : ℕ) : (↑(0 * x) : ℤ) = 0 * (↑x : ℤ) := by simp
-lemma int.coe_nat_mul_bit0 (n : ℕ) (x : ℕ) : (↑(x * bit0 n) : ℤ) = (↑x : ℤ) * (↑(bit0 n) : ℤ) :=
-by simp
-lemma int.coe_nat_mul_bit1 (n : ℕ) (x : ℕ) : (↑(x * bit1 n) : ℤ) = (↑x : ℤ) * (↑(bit1 n) : ℤ) :=
-by simp
-lemma int.coe_nat_mul_one (x : ℕ) : (↑(x * 1) : ℤ) = (↑x : ℤ) * 1 := by simp
-lemma int.coe_nat_mul_zero (x : ℕ) : (↑(x * 0) : ℤ) = (↑x : ℤ) * 0 := by simp
-
-lemma nat_eq_subst {n1 n2 : ℕ} {z1 z2 : ℤ} (hn : n1 = n2) (h1 : ↑n1 = z1) (h2 : ↑n2 = z2) :
-  z1 = z2 :=
-by simpa [eq.symm h1, eq.symm h2, int.coe_nat_eq_coe_nat_iff]
-
-lemma nat_le_subst {n1 n2 : ℕ} {z1 z2 : ℤ} (hn : n1 ≤ n2) (h1 : ↑n1 = z1) (h2 : ↑n2 = z2) :
-  z1 ≤ z2 :=
-by simpa [eq.symm h1, eq.symm h2, int.coe_nat_le]
-
-lemma nat_lt_subst {n1 n2 : ℕ} {z1 z2 : ℤ} (hn : n1 < n2) (h1 : ↑n1 = z1) (h2 : ↑n2 = z2) :
-  z1 < z2 :=
-by simpa [eq.symm h1, eq.symm h2, int.coe_nat_lt]
+lemma zero_lt_one {α} [ordered_semiring α] [nontrivial α] : (0 : α) < 1 := zero_lt_one
 
 lemma eq_of_eq_of_eq {α} [ordered_semiring α] {a b : α} (ha : a = 0) (hb : b = 0) : a + b = 0 :=
 by simp *
@@ -59,7 +32,7 @@ by simp *
 lemma lt_of_lt_of_eq {α} [ordered_semiring α] {a b : α} (ha : a < 0) (hb : b = 0) : a + b < 0 :=
 by simp *
 
-lemma mul_neg {α} [ordered_ring α] {a b : α} (ha : a < 0) (hb : 0 < b) : b * a < 0 :=
+lemma mul_neg {α} [strict_ordered_ring α] {a b : α} (ha : a < 0) (hb : 0 < b) : b * a < 0 :=
 have (-b)*a > 0, from mul_pos_of_neg_of_neg (neg_neg_of_pos hb) ha,
 neg_of_neg_pos (by simpa)
 
@@ -75,7 +48,6 @@ by simp *
 lemma eq_of_not_lt_of_not_gt {α} [linear_order α] (a b : α) (h1 : ¬ a < b) (h2 : ¬ b < a) : a = b :=
 le_antisymm (le_of_not_gt h2) (le_of_not_gt h1)
 
-
 -- used in the `nlinarith` normalization steps. The `_` argument is for uniformity.
 @[nolint unused_arguments]
 lemma mul_zero_eq {α} {R : α → α → Prop} [semiring α] {a b : α} (_ : R a 0) (h : b = 0) :
diff --git a/src/tactic/linarith/parsing.lean b/src/tactic/linarith/parsing.lean
index c31cdc3b9fcee..f43291cd087ea 100644
--- a/src/tactic/linarith/parsing.lean
+++ b/src/tactic/linarith/parsing.lean
@@ -182,8 +182,8 @@ It also returns the largest variable index that appears in comparisons in `c`.
 -/
 meta def linear_forms_and_max_var (red : transparency) (pfs : list expr) :
   tactic (list comp × ℕ) :=
-do pftps ← pfs.mmap infer_type,
-   (l, _, map) ← to_comp_fold red [] pftps mk_rb_map,
+do pftps ← pfs.mmap (λ e, infer_type e >>= instantiate_mvars),
+   (l, _, map) ← to_comp_fold red []  pftps mk_rb_map,
    return (l, map.size - 1)
 
 
diff --git a/src/tactic/linarith/preprocessing.lean b/src/tactic/linarith/preprocessing.lean
index 9aec977626ee1..ae700421d8eeb 100644
--- a/src/tactic/linarith/preprocessing.lean
+++ b/src/tactic/linarith/preprocessing.lean
@@ -3,11 +3,10 @@ Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-
+import data.prod.lex
+import tactic.cancel_denoms
 import tactic.linarith.datatypes
 import tactic.zify
-import tactic.cancel_denoms
-import order.lexicographic
 
 /-!
 # Linarith preprocessing
@@ -71,7 +70,7 @@ private meta def rearr_comp_aux : expr → expr → tactic expr
 and turns it into a proof of a comparison `_ R 0`, where `R ∈ {=, ≤, <}`.
  -/
 meta def rearr_comp (e : expr) : tactic expr :=
-infer_type e >>= rearr_comp_aux e
+infer_type e >>= instantiate_mvars >>= rearr_comp_aux e
 
 /-- If `e` is of the form `((n : ℕ) : ℤ)`, `is_nat_int_coe e` returns `n : ℕ`. -/
 meta def is_nat_int_coe : expr → option expr
@@ -97,7 +96,7 @@ If `pf` is a proof of a strict inequality `(a : ℤ) < b`,
 and similarly if `pf` proves a negated weak inequality.
 -/
 meta def mk_non_strict_int_pf_of_strict_int_pf (pf : expr) : tactic expr :=
-do tp ← infer_type pf,
+do tp ← infer_type pf >>= instantiate_mvars,
 match tp with
 | `(%%a < %%b) := to_expr ``(int.add_one_le_iff.mpr %%pf)
 | `(%%a > %%b) := to_expr ``(int.add_one_le_iff.mpr %%pf)
@@ -140,7 +139,7 @@ Removes any expressions that are not proofs of inequalities, equalities, or nega
 meta def filter_comparisons : preprocessor :=
 { name := "filter terms that are not proofs of comparisons",
   transform := λ h,
-(do tp ← infer_type h,
+(do tp ← infer_type h >>= instantiate_mvars,
    is_prop tp >>= guardb,
    guardb (filter_comparisons_aux tp),
    return [h])
@@ -153,7 +152,7 @@ For example, a proof of `¬ a < b` will become a proof of `a ≥ b`.
 meta def remove_negations : preprocessor :=
 { name := "replace negations of comparisons",
   transform := λ h,
-do tp ← infer_type h,
+do tp ← infer_type h >>= instantiate_mvars,
 match tp with
 | `(¬ %%p) := singleton <$> rem_neg h p
 | _ := return [h]
@@ -172,9 +171,9 @@ meta def nat_to_int : global_preprocessor :=
 -- we lock the tactic state here because a `simplify` call inside of
 -- `zify_proof` corrupts the tactic state when run under `io.run_tactic`.
 do l ← lock_tactic_state $ l.mmap $ λ h,
-         infer_type h >>= guardb ∘ is_nat_prop >> zify_proof [] h <|> return h,
+      infer_type h >>= instantiate_mvars >>= guardb ∘ is_nat_prop >> zify_proof [] h <|> return h,
    nonnegs ← l.mfoldl (λ (es : expr_set) h, do
-     (a, b) ← infer_type h >>= get_rel_sides,
+     (a, b) ← infer_type h >>= instantiate_mvars >>= get_rel_sides,
      return $ (es.insert_list (get_nat_comps a)).insert_list (get_nat_comps b)) mk_rb_set,
    (++) l <$> nonnegs.to_list.mmap mk_coe_nat_nonneg_prf }
 
@@ -184,7 +183,7 @@ into a proof of `t1 ≤ t2 + 1`. -/
 meta def strengthen_strict_int : preprocessor :=
 { name := "strengthen strict inequalities over int",
   transform := λ h,
-do tp ← infer_type h,
+do tp ← infer_type h >>= instantiate_mvars,
    guardb (is_strict_int_prop tp) >> singleton <$> mk_non_strict_int_pf_of_strict_int_pf h
      <|> return [h] }
 
@@ -214,7 +213,7 @@ it tries to scale `t` to cancel out division by numerals.
 meta def cancel_denoms : preprocessor :=
 { name := "cancel denominators",
   transform := λ pf,
-(do some (_, lhs) ← parse_into_comp_and_expr <$> infer_type pf,
+(do some (_, lhs) ← parse_into_comp_and_expr <$> (infer_type pf >>= instantiate_mvars),
    guardb $ lhs.contains_constant (= `has_div.div),
    singleton <$> normalize_denominators_in_lhs pf lhs)
 <|> return [pf] }
@@ -273,7 +272,7 @@ This produces `2^n` branches when there are `n` such hypotheses in the input.
 -/
 meta def remove_ne_aux : list expr → tactic (list branch) :=
 λ hs,
-(do e ← hs.mfind (λ e : expr, do e ← infer_type e, guard $ e.is_ne.is_some),
+(do e ← hs.mfind (λ e : expr, do e ← infer_type e >>= instantiate_mvars, guard $ e.is_ne.is_some),
     [(_, ng1), (_, ng2)] ← to_expr ``(or.elim (lt_or_gt_of_ne %%e)) >>= apply,
     let do_goal : expr → tactic (list branch) := λ g,
       do set_goals [g],
diff --git a/src/tactic/linarith/verification.lean b/src/tactic/linarith/verification.lean
index 360a6fdf4655c..ea5123b0dd715 100644
--- a/src/tactic/linarith/verification.lean
+++ b/src/tactic/linarith/verification.lean
@@ -86,19 +86,19 @@ meta def mk_lt_zero_pf : list (expr × ℕ) → tactic expr
 
 /-- If `prf` is a proof of `t R s`, `term_of_ineq_prf prf` returns `t`. -/
 meta def term_of_ineq_prf (prf : expr) : tactic expr :=
-prod.fst <$> (infer_type prf >>= get_rel_sides)
+prod.fst <$> (infer_type prf >>= instantiate_mvars >>= get_rel_sides)
 
 /-- If `prf` is a proof of `t R s`, `ineq_prf_tp prf` returns the type of `t`. -/
 meta def ineq_prf_tp (prf : expr) : tactic expr :=
-term_of_ineq_prf prf >>= infer_type
+term_of_ineq_prf prf >>= infer_type >>= instantiate_mvars
 
 /--
 `mk_neg_one_lt_zero_pf tp` returns a proof of `-1 < 0`,
 where the numerals are natively of type `tp`.
 -/
 meta def mk_neg_one_lt_zero_pf (tp : expr) : tactic expr :=
-do zero_lt_one ← mk_mapp `zero_lt_one [tp, none, none],
-   mk_app `neg_neg_of_pos [zero_lt_one]
+do h ← mk_mapp `linarith.zero_lt_one [tp, none, none],
+   mk_app `neg_neg_of_pos [h]
 
 /--
 If `e` is a proof that `t = 0`, `mk_neg_eq_zero_pf e` returns a proof that `-t = 0`.
@@ -120,7 +120,7 @@ proof, it adds a proof of `-t = 0` to the list.
 meta def add_neg_eq_pfs : list expr → tactic (list expr)
 | [] := return []
 | (h::t) :=
-  do some (iq, tp) ← parse_into_comp_and_expr <$> infer_type h,
+  do some (iq, tp) ← parse_into_comp_and_expr <$> (infer_type h >>= instantiate_mvars),
   match iq with
   | ineq.eq := do nep ← mk_neg_eq_zero_pf h, tl ← add_neg_eq_pfs t, return $ h::nep::tl
   | _ := list.cons h <$> add_neg_eq_pfs t
diff --git a/src/tactic/linear_combination.lean b/src/tactic/linear_combination.lean
index daf000dfd527b..48173a2f005a9 100644
--- a/src/tactic/linear_combination.lean
+++ b/src/tactic/linear_combination.lean
@@ -9,10 +9,9 @@ import tactic.ring
 /-!
 
 # linear_combination Tactic
-
 In this file, the `linear_combination` tactic is created.  This tactic, which
-works over `ring`s, attempts to prove the target by creating and applying a
-linear combination of a list of equalities.  This file also includes a
+works over `ring`s, attempts to simplify the target by creating a linear combination
+of a list of equalities and subtracting it from the target.  This file also includes a
 definition for `linear_combination_config`.  A `linear_combination_config`
 object can be passed into the tactic, allowing the user to specify a
 normalization tactic.
@@ -24,8 +23,7 @@ given coefficients.  Then, it subtracts the right side of the weighted sum
 from the left side so that the right side equals 0, and it does the same with
 the target.  Afterwards, it sets the goal to be the equality between the
 lefthand side of the new goal and the lefthand side of the new weighted sum.
-Lastly, it uses a normalization tactic to see if the weighted sum is equal
-to the target.
+Lastly, calls a normalization tactic on this target.
 
 ## References
 
@@ -58,6 +56,8 @@ lemma replace_eq_expr {α} [h : has_zero α] {x y : α} (h1 : x = 0) (h2 : y = x
   y = 0 :=
 by rwa h2
 
+lemma eq_zero_of_sub_eq_zero {α} [add_group α] {x y : α} (h : y = 0) (h2 : x - y = 0) : x = 0 :=
+by rwa [h, sub_zero] at h2
 
 /-! ### Configuration -/
 
@@ -72,7 +72,8 @@ checking if the weighted sum is equivalent to the goal (when `normalize` is `tt`
 -/
 meta structure linear_combination_config : Type :=
 (normalize : bool := tt)
-(normalization_tactic : tactic unit := `[ring1])
+(normalization_tactic : tactic unit := `[ring_nf SOP])
+(exponent : ℕ := 1)
 
 
 /-! ### Part 1: Multiplying Equations by Constants and Adding Them Together -/
@@ -152,27 +153,27 @@ Given that `l_sum1 = r_sum1`, `l_h1 = r_h1`, ..., `l_hn = r_hn`, and given
     equalities added to the base equation holds
 -/
 meta def make_sum_of_hyps_helper (expected_tp : expr) :
-  option (tactic expr) → list name → list pexpr → tactic expr
+  option (tactic expr) → list expr → list pexpr → tactic expr
 | none [] []                                                             :=
   to_expr ``(rfl : (0 : %%expected_tp) = 0)
 | (some tactic_hcombo) [] []                                             :=
   do tactic_hcombo
-| none (h_equality_nam :: h_eqs_names) (coeff :: coeffs)                 :=
+| none (h_equality :: h_eqs_names) (coeff :: coeffs)                 :=
  do
     -- This is the first equality, and we do not have anything to add to it
-    h_equality ← get_local h_equality_nam,
+    -- h_equality ← get_local h_equality_nam,
     `(@eq %%eqtp _ _) ← infer_type h_equality |
-      fail!"{h_equality_nam} is expected to be a proof of an equality",
+      fail!"{h_equality} is expected to be a proof of an equality",
     is_def_eq eqtp expected_tp <|>
-      fail!("{h_equality_nam} is an equality between terms of type {eqtp}, but is expected to be" ++
+      fail!("{h_equality} is an equality between terms of type {eqtp}, but is expected to be" ++
         " between terms of type {expected_tp}"),
     make_sum_of_hyps_helper
       (some (mul_equality_expr h_equality coeff))
       h_eqs_names
       coeffs
-| (some tactic_hcombo) (h_equality_nam :: h_eqs_names) (coeff :: coeffs) :=
+| (some tactic_hcombo) (h_equality :: h_eqs_names) (coeff :: coeffs) :=
   do
-    h_equality ← get_local h_equality_nam,
+    -- h_equality ← get_local h_equality_nam,
     hcombo ← tactic_hcombo,
     -- We want to add this weighted equality to the current equality in
     --   the hypothesis
@@ -199,7 +200,7 @@ Given a list of names referencing equalities and a list of pexprs representing
 * Output: an `expr`, which proves that the weighted sum of the equalities
     holds
 -/
-meta def make_sum_of_hyps (expected_tp : expr) (h_eqs_names : list name) (coeffs : list pexpr) :
+meta def make_sum_of_hyps (expected_tp : expr) (h_eqs_names : list expr) (coeffs : list pexpr) :
   tactic expr :=
 make_sum_of_hyps_helper expected_tp none h_eqs_names coeffs
 
@@ -249,12 +250,12 @@ do
 
 
 /--
-This tactic changes the goal to be that the lefthand side of the target is
-  equal to the lefthand side of the given expression.  For example,
+This tactic changes the goal to be that the lefthand side of the target minus the
+  lefthand side of the given expression is equal to 0.  For example,
   if `hsum_on_left` is `5*x - 5*y = 0`, and the target is `-5*y + 5*x = 0`, this
-  tactic will change the target to be `-5*y + 5*x = 5*x - 5*y`.
+  tactic will change the target to be `-5*y + 5*x - (5*x - 5*y) = 0`.
 
-This tactic only should be used when the target's type an equality whose
+This tactic only should be used when the target's type is an equality whose
   right side is 0.
 
 * Input:
@@ -263,8 +264,19 @@ This tactic only should be used when the target's type an equality whose
 
 * Output: N/A
 -/
-meta def set_goal_to_hleft_eq_tleft (hsum_on_left : expr) : tactic unit :=
-do to_expr ``(replace_eq_expr %%hsum_on_left) >>= apply, skip
+meta def set_goal_to_hleft_sub_tleft (hsum_on_left : expr) : tactic unit :=
+do to_expr ``(eq_zero_of_sub_eq_zero %%hsum_on_left) >>= apply, skip
+
+/--
+If an exponent `n` is provided, changes the goal from `t = 0` to `t^n = 0`.
+* Input:
+  * `exponent : ℕ`, the power to raise the goal by. If `1`, this tactic is a no-op.
+
+* Output: N/A
+-/
+meta def raise_goal_to_power : ℕ → tactic unit
+| 1 := skip
+| n := refine ``(@pow_eq_zero _ _ _ _ %%`(n) _)
 
 /--
 This tactic attempts to prove the goal by normalizing the target if the
@@ -276,7 +288,7 @@ This tactic attempts to prove the goal by normalizing the target if the
 
 * Output: N/A
 -/
-meta def prove_equal_if_desired (config : linear_combination_config) :
+meta def normalize_if_desired (config : linear_combination_config) :
   tactic unit :=
 when config.normalize config.normalization_tactic
 
@@ -284,11 +296,11 @@ when config.normalize config.normalization_tactic
 
 
 /--
-This is a tactic that attempts to prove the target by creating and applying a
-  linear combination of a list of equalities.  (If the `normalize` field of the
+This is a tactic that attempts to simplify the target by creating a linear combination
+  of a list of equalities and subtracting it from the target.
+  (If the `normalize` field of the
   configuration is set to ff, then the tactic will simply set the user up to
-  prove their target using the linear combination instead of attempting to
-  finish the proof.)
+  prove their target using the linear combination instead of normalizing the subtraction.)
 
 Note: The left and right sides of all the equalities should have the same
   ring type, and the coefficients should also have this type.  There must be
@@ -306,89 +318,125 @@ Note: The left and right sides of all the equalities should have the same
 
 * Output: N/A
 -/
-meta def linear_combination (h_eqs_names : list name) (coeffs : list pexpr)
+meta def linear_combination (h_eqs_names : list pexpr) (coeffs : list pexpr)
   (config : linear_combination_config := {}) : tactic unit :=
 do
   `(@eq %%ext _ _) ← target | fail "linear_combination can only be used to prove equality goals",
-  hsum ← make_sum_of_hyps ext h_eqs_names coeffs,
+  h_eqs ← h_eqs_names.mmap to_expr,
+  hsum ← make_sum_of_hyps ext h_eqs coeffs,
   hsum_on_left ← move_to_left_side hsum,
   move_target_to_left_side,
-  set_goal_to_hleft_eq_tleft hsum_on_left,
-  prove_equal_if_desired config
+  raise_goal_to_power config.exponent,
+  set_goal_to_hleft_sub_tleft hsum_on_left,
+  normalize_if_desired config
 
-
-section interactive_mode
-setup_tactic_parser
+/-- `mk_mul [p₀, p₁, ..., pₙ]` produces the pexpr `p₀ * p₁ * ... * pₙ`. -/
+meta def mk_mul : list pexpr → pexpr
+| [] := ``(1)
+| [e] := e
+| (e::es) := ``(%%e * %%(mk_mul es))
 
 /--
-A parser that matches a pair in parentheses (where the first item in the pair
-is an identifier and the second item in the pair is a `pexpr`) or an identifier
-by itself.  If the identifier is by itself, this parser behaves as though it
-was given a `pexpr ` of ``(1) along with the identifier.
-
-* Input: None
-
-* Output: a `lean.parser (name × pexpr)`
+`as_linear_combo neg ms e` is used to parse the argument to `linear_combination`.
+This argument is a sequence of literals `x`, `-x`, or `c*x` combined with `+` or `-`,
+given by the pexpr `e`.
+The `neg` and `ms` arguments are used recursively; called at the top level, its usage should be
+`as_linear_combo ff [] e`.
 -/
-meta def parse_name_pexpr_pair : lean.parser (name × pexpr) :=
-(tk "(" *> prod.mk <$> ident <*> (tk "," *> parser.pexpr 0 <* tk ")")) <|>
-((λ id, (id, ``(1))) <$> ident)
+meta def as_linear_combo : bool → list pexpr → pexpr → list (pexpr × pexpr)
+| neg ms e :=
+  let (head, args) := pexpr.get_app_fn_args e in
+  match head.get_frozen_name, args with
+  | ``has_add.add, [e1, e2] := as_linear_combo neg ms e1 ++ as_linear_combo neg ms e2
+  | ``has_sub.sub, [e1, e2] := as_linear_combo neg ms e1 ++ as_linear_combo (bnot neg) ms e2
+  | ``has_mul.mul, [e1, e2] := as_linear_combo neg (e1::ms) e2
+  | ``has_div.div, [e1, e2] := as_linear_combo neg (``((%%e2)⁻¹)::ms) e1
+  | ``has_neg.neg, [e1] := as_linear_combo (bnot neg) ms e1
+  | _, _ := let m := mk_mul ms in [(e, if neg then ``(-%%m) else m)]
+  end
+
+section interactive_mode
+setup_tactic_parser
 
 /--
-`linear_combination` attempts to prove the target by creating and applying a
-  linear combination of a list of equalities.  The tactic will create a linear
+`linear_combination` attempts to simplify the target by creating a linear combination
+  of a list of equalities and subtracting it from the target.
+  The tactic will create a linear
   combination by adding the equalities together from left to right, so the order
   of the input hypotheses does matter.  If the `normalize` field of the
   configuration is set to false, then the tactic will simply set the user up to
-  prove their target using the linear combination instead of attempting to
-  finish the proof.
+  prove their target using the linear combination instead of normalizing the subtraction.
+
+Users may provide an optional `with { exponent := n }`. This will raise the goal to the power `n`
+  before subtracting the linear combination.
 
 Note: The left and right sides of all the equalities should have the same
   type, and the coefficients should also have this type.  There must be
   instances of `has_mul` and `add_group` for this type.
 
 * Input:
-  * `input` : the pairs of hypotheses and their corresponding coefficients.
-      If no coefficient is given with a hypothesis, then the coefficient for
-      that hypothesis will be set to 1.
-  * `config` : a linear_combination_config, which determines the tactic used
+  * `input` : the linear combination of proofs of equalities, given as a sum/difference
+      of coefficients multiplied by expressions. The coefficients may be arbitrary
+      pre-expressions; if a coefficient is an application of `+` or `-` it should be
+      surrounded by parentheses. The expressions can be arbitrary proof terms proving
+      equalities. Most commonly they are hypothesis names `h1, h2, ...`.
+
+      If a coefficient is omitted, it is taken to be `1`.
+  * `config` : a `linear_combination_config`, which determines the tactic used
       for normalization; by default, this value is the standard configuration
       for a linear_combination_config.  In the standard configuration,
       `normalize` is set to tt (meaning this tactic is set to use
-      normalization), and `normalization_tactic` is set to  `ring1`.
+      normalization), and `normalization_tactic` is set to  `ring_nf SOP`.
 
 Example Usage:
 ```
 example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
   x*y = -2*y + 1 :=
-by linear_combination (h1, 1) (h2, -2)
+by linear_combination 1*h1 - 2*h2
 
 example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
   x*y = -2*y + 1 :=
-by linear_combination h1 (h2, -2)
+by linear_combination h1 - 2*h2
+
+example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
+  x*y = -2*y + 1 :=
+begin
+ linear_combination -2*h2,
+ /- Goal: x * y + x * 2 - 1 = 0 -/
+end
 
 example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
     (hc : x + 2*y + z = 2) :
   -3*x - 3*y - 4*z = 2 :=
-by linear_combination (ha, 1) (hb, -1) (hc, -2)
+by linear_combination ha - hb - 2*hc
 
 example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
   x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
-by linear_combination (h1, x*y) (h2, 2)
+by linear_combination x*y*h1 + 2*h2
 
 example (x y : ℤ) (h1 : x = -3) (h2 : y = 10) :
   2*x = -6 :=
 begin
-  linear_combination (h1, 2) {normalize := ff},
+  linear_combination 2*h1 with {normalize := ff},
   simp,
   norm_cast
 end
+
+example (x y z : ℚ) (h : x = y) (h2 : x * y = 0) : x + y*z = 0 :=
+by linear_combination (-y * z ^ 2 + x) * h + (z ^ 2 + 2 * z + 1) * h2 with { exponent := 2 }
+
+constants (qc : ℚ) (hqc : qc = 2*qc)
+
+example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
+by linear_combination 3 * h a b + hqc
 ```
 -/
 meta def _root_.tactic.interactive.linear_combination
-  (input : parse parse_name_pexpr_pair*)
-  (config : linear_combination_config := {}) : tactic unit :=
-let (h_eqs_names, coeffs) := list.unzip input in
+  (input : parse (as_linear_combo ff [] <$> texpr)?)
+  (_ : parse (tk "with")?)
+  (config : linear_combination_config := {})
+  : tactic unit :=
+let (h_eqs_names, coeffs) := list.unzip (input.get_or_else []) in
 linear_combination h_eqs_names coeffs config
 
 add_tactic_doc
diff --git a/src/tactic/lint/default.lean b/src/tactic/lint/default.lean
index 2db842856f084..9253de92a8512 100644
--- a/src/tactic/lint/default.lean
+++ b/src/tactic/lint/default.lean
@@ -3,7 +3,7 @@ Copyright (c) 2020 Floris van Doorn. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn, Robert Y. Lewis, Gabriel Ebner
 -/
-import algebra.group.to_additive
+import tactic.to_additive
 import tactic.lint.frontend
 import tactic.lint.misc
 import tactic.lint.simp
@@ -19,13 +19,8 @@ attribute.
 
 open tactic
 
-add_tactic_doc
-{ name                     := "linting commands",
-  category                 := doc_category.cmd,
-  decl_names               := [`lint_cmd, `lint_mathlib_cmd, `lint_all_cmd, `list_linters],
-  tags                     := ["linting"],
-  description              :=
-"User commands to spot common mistakes in the code
+/--
+User commands to spot common mistakes in the code
 
 * `#lint`: check all declarations in the current file
 * `#lint_mathlib`: check all declarations in mathlib (so excluding core or other projects,
@@ -40,7 +35,8 @@ The following linters are run by default:
 4. `ge_or_gt` checks whether ≥/> is used in the declaration.
 5. `instance_priority` checks that instances that always apply have priority below default.
 6. `doc_blame` checks for missing doc strings on definitions and constants.
-7.  `has_inhabited_instance` checks whether every type has an associated `inhabited` instance.
+7.  `has_nonempty_instance` checks whether every type has an associated `inhabited`, `unique`
+    or `nonempty` instance.
 8.  `impossible_instance` checks for instances that can never fire.
 9.  `incorrect_type_class_argument` checks for arguments in [square brackets] that are not classes.
 10. `dangerous_instance` checks for instances that generate type-class problems with metavariables.
@@ -92,10 +88,17 @@ or `lint only my_new_check`.
 If you add the attribute `@[linter]` to `linter.my_new_check` it will run by default.
 
 Adding the attribute `@[nolint doc_blame unused_arguments]` to a declaration
-omits it from only the specified linter checks." }
+omits it from only the specified linter checks.
+-/
+add_tactic_doc
+{ name                     := "linting commands",
+  category                 := doc_category.cmd,
+  decl_names               := [`lint_cmd, `lint_mathlib_cmd, `lint_all_cmd, `list_linters],
+  tags                     := ["linting"] }
 
 /-- The default linters used in mathlib CI. -/
 meta def mathlib_linters : list name := by do
 ls ← get_checks tt [] ff,
-let ls := ls.map (λ ⟨n, _⟩, `linter ++ n),
+let ls := ls.map (λ ⟨n, _⟩, `linter ++ n) ++
+  [`assert_not_exists.linter, `assert_no_instance.linter],
 exact (reflect ls)
diff --git a/src/tactic/lint/type_classes.lean b/src/tactic/lint/type_classes.lean
index cd945a06fdc8c..0b0efafc654f0 100644
--- a/src/tactic/lint/type_classes.lean
+++ b/src/tactic/lint/type_classes.lean
@@ -14,7 +14,8 @@ This file defines several linters checking the correct usage of type classes
 and the appropriate definition of instances:
 
  * `instance_priority` ensures that blanket instances have low priority.
- * `has_inhabited_instances` checks that every type has an `inhabited` instance.
+ * `has_nonempty_instances` checks that every type has a `nonempty` instance, an `inhabited`
+   instance, or a `unique` instance.
  * `impossible_instance` checks that there are no instances which can never apply.
  * `incorrect_type_class_argument` checks that only type classes are used in
    instance-implicit arguments.
@@ -84,7 +85,7 @@ exhaustive search to find a commutative group. These instances take a long time
 Other instances will only apply if the goal has a certain shape. For example
 `int.add_group : add_group ℤ` or
 `add_group.prod {α β} [add_group α] [add_group β] : add_group (α × β)`. Usually these instances
-will fail quickly, and when they apply, they are almost the desired instance.
+will fail quickly, and when they apply, they are almost always the desired instance.
 For this reason, we want the instances of the second type (that only apply in specific cases) to
 always have higher priority than the instances of the first type (that always apply).
 See also #1561.
@@ -105,8 +106,10 @@ If you don't know what priority to choose, use priority 100.
 See note [lower instance priority] for instructions to change the priority.",
   auto_decls := tt }
 
-/-- Reports declarations of types that do not have an associated `inhabited` instance. -/
-private meta def has_inhabited_instance (d : declaration) : tactic (option string) := do
+/-- Reports declarations of types that do not have an nonemptiness instance.
+A `nonempty`, `inhabited` or `unique` instance suffices, and we prefer a computable `inhabited`
+or `unique` instance if possible. -/
+private meta def has_nonempty_instance (d : declaration) : tactic (option string) := do
 tt ← pure d.is_trusted | pure none,
 ff ← has_attribute' `reducible d.to_name | pure none,
 ff ← has_attribute' `class d.to_name | pure none,
@@ -116,24 +119,26 @@ if ty = `(Prop) then pure none else do
 `(Sort _) ← whnf ty | pure none,
 insts ← attribute.get_instances `instance,
 insts_tys ← insts.mmap $ λ i, expr.pi_codomain <$> declaration.type <$> get_decl i,
-let inhabited_insts := insts_tys.filter (λ i,
-  i.app_fn.const_name = ``inhabited ∨ i.app_fn.const_name = `unique),
-let inhabited_tys := inhabited_insts.map (λ i, i.app_arg.get_app_fn.const_name),
-if d.to_name ∈ inhabited_tys then
+let nonempty_insts := insts_tys.filter
+  (λ i, i.app_fn.const_name ∈ [``nonempty, ``inhabited, `unique]),
+let nonempty_tys := nonempty_insts.map (λ i, i.app_arg.get_app_fn.const_name),
+if d.to_name ∈ nonempty_tys then
   pure none
 else
-  pure "inhabited instance missing"
+  pure "nonempty/inhabited/unique instance missing"
 
-/-- A linter for missing `inhabited` instances. -/
+/-- A linter for missing `nonempty` instances. -/
 @[linter]
-meta def linter.has_inhabited_instance : linter :=
-{ test := has_inhabited_instance,
+meta def linter.has_nonempty_instance : linter :=
+{ test := has_nonempty_instance,
   auto_decls := ff,
-  no_errors_found := "No types have missing inhabited instances.",
-  errors_found := "TYPES ARE MISSING INHABITED INSTANCES:",
+  no_errors_found := "No types have missing nonempty instances.",
+  errors_found := "TYPES ARE MISSING NONEMPTY INSTANCES.
+The following types should have an associated instance of the class
+`nonempty`, or if computably possible `inhabited` or `unique`:",
   is_fast := ff }
 
-attribute [nolint has_inhabited_instance] pempty
+attribute [nolint has_nonempty_instance] pempty
 
 /-- Checks whether an instance can never be applied. -/
 private meta def impossible_instance (d : declaration) : tactic (option string) := do
@@ -257,7 +262,7 @@ Some instances take quite some time to fail, and we seem to run against the cach
 https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/odd.20repeated.20type.20class.20search
 -/
 @[linter] meta def linter.fails_quickly : linter :=
-{ test := fails_quickly 20000,
+{ test := fails_quickly 30000,
   auto_decls := tt,
   no_errors_found := "No type-class searches timed out.",
   errors_found := "TYPE CLASS SEARCHES TIMED OUT.
@@ -343,7 +348,7 @@ do tt ← is_prop d.type | return none,
   errors_found := "USES OF `inhabited` SHOULD BE REPLACED WITH `nonempty`." }
 
 /-- Checks whether a declaration is `Prop`-valued and takes a `decidable* _`
-hypothesis that is unused lsewhere in the type.
+hypothesis that is unused elsewhere in the type.
 In this case, that hypothesis can be replaced with `classical` in the proof.
 Theorems in the `decidable` namespace are exempt from the check. -/
 private meta def decidable_classical (d : declaration) : tactic (option string) :=
@@ -370,6 +375,27 @@ and non-classical logic. It makes little sense to make all these lemmas classica
 to the list of lemmas which are not checked by the linter `decidable_classical`. -/
 attribute [nolint decidable_classical] dec_em dec_em' not.decidable_imp_symm
 
+/-- Checks whether a declaration is `Prop`-valued and takes a `fintype _`
+hypothesis that is unused elsewhere in the type.
+In this case, that hypothesis can be replaced with `casesI nonempty_fintype _` in the proof. -/
+meta def linter.fintype_finite_fun (d : declaration) : tactic (option string) :=
+do tt ← is_prop d.type | return none,
+   (binders, _) ← get_pi_binders_nondep d.type,
+   let fintype_binders := binders.filter $ λ pr, pr.2.type.is_app_of `fintype,
+   if fintype_binders.length = 0 then return none
+   else (λ s, some $ "The following `fintype` hypotheses should be replaced with
+                      `casesI nonempty_fintype _` in the proof. " ++ s) <$>
+      print_arguments fintype_binders
+
+/-- A linter object for `fintype` vs `finite`. -/
+@[linter] meta def linter.fintype_finite : linter :=
+{ test := linter.fintype_finite_fun,
+  auto_decls := ff,
+  no_errors_found :=
+    "No uses of `fintype` arguments should be replaced with `casesI nonempty_fintype _`.",
+  errors_found :=
+    "USES OF `fintype` SHOULD BE REPLACED WITH `casesI nonempty_fintype _` IN THE PROOF." }
+
 private meta def has_coe_to_fun_linter (d : declaration) : tactic (option string) :=
 retrieve $ do
 tt ← return d.is_trusted | pure none,
diff --git a/src/tactic/local_cache.lean b/src/tactic/local_cache.lean
index aa6f053801c64..5ff10222b7834 100644
--- a/src/tactic/local_cache.lean
+++ b/src/tactic/local_cache.lean
@@ -10,11 +10,11 @@ namespace local_cache
 
 namespace internal
 
-variables {α : Type} [reflected α] [has_reflect α]
+variables {α : Type} [reflected _ α] [has_reflect α]
 
 meta def mk_full_namespace (ns : name) : name := `local_cache ++ ns
 
-meta def save_data (dn : name) (a : α) [reflected a] : tactic unit :=
+meta def save_data (dn : name) (a : α) [reflected _ a] : tactic unit :=
 tactic.add_decl $ mk_definition dn [] (reflect α) (reflect a)
 
 meta def load_data (dn : name) : tactic α :=
@@ -26,7 +26,7 @@ meta def poke_data (dn : name) : tactic bool :=
 do e ← tactic.get_env,
    return (e.get dn).to_bool
 
-meta def run_once_under_name {α : Type} [reflected α] [has_reflect α] (t : tactic α)
+meta def run_once_under_name {α : Type} [reflected _ α] [has_reflect α] (t : tactic α)
   (cache_name : name) : tactic α :=
 do load_data cache_name <|>
    do
@@ -190,7 +190,8 @@ meta def clear (ns : name) (s : cache_scope := block_local) : tactic unit :=
 s.clear ns
 
 /-- Gets the (optionally present) value-in-cache for `ns`. -/
-meta def get (ns : name) (α : Type) [reflected α] [has_reflect α] (s : cache_scope := block_local) :
+meta def get (ns : name) (α : Type) [reflected _ α] [has_reflect α]
+  (s : cache_scope := block_local) :
   tactic (option α) :=
 do dn ← some <$> s.try_get_name ns <|> return none,
    match dn with
@@ -217,7 +218,7 @@ open local_cache local_cache.internal
 
     If `α` is just `unit`, this means we just run `t` once each tactic
     block. -/
-meta def run_once {α : Type} [reflected α] [has_reflect α] (ns : name) (t : tactic α)
+meta def run_once {α : Type} [reflected  _ α] [has_reflect α] (ns : name) (t : tactic α)
   (s : cache_scope := cache_scope.block_local) : tactic α :=
 s.get_name ns >>= run_once_under_name t
 
diff --git a/src/tactic/localized.lean b/src/tactic/localized.lean
index f33bf775deffe..c6d2b77820d26 100644
--- a/src/tactic/localized.lean
+++ b/src/tactic/localized.lean
@@ -64,11 +64,11 @@ locale.
 
 * Declare notation which is localized to a locale using:
 ```lean
-localized "infix ` ⊹ `:60 := my_add" in my.add
+localized "infix (name := my_add) ` ⊹ `:60 := my_add" in my.add
 ```
 
 * After this command it will be available in the same section/namespace/file, just as if you wrote
-  `local infix ` ⊹ `:60 := my_add`
+  `local infix (name := my_add) ` ⊹ `:60 := my_add`
 
 * You can open it in other places. The following command will declare the notation again as local
   notation in that section/namespace/file:
@@ -100,6 +100,20 @@ run_cmd do
 
 * Warning: You have to give full names of all declarations used in localized notation,
   so that the localized notation also works when the appropriate namespaces are not opened.
+
+* Note: In mathlib, you should always provide names for localized notations using the
+  `(name := ...)` parameter. This prevents issues if the localized notation overrides
+  an existing notation when it gets opened.
+
+* Warning: Due to limitations in the implementation, you cannot use `_` in localized notations.
+  (Otherwise `open_locale foo` will fail if `foo` is already opened or partially opened.)
+  Instead, you should use the `hole!` notation as a drop-in replacement. For example:
+```lean
+-- BAD
+-- localized "infix (name := my_add) ` ⊹[` R `] ` := my_add _ R" in foo
+-- GOOD
+localized "infix (name := my_add) ` ⊹[` R `] ` := my_add hole! R" in foo
+```
 -/
 add_tactic_doc
 { name                     := "localized notation",
@@ -111,12 +125,16 @@ add_tactic_doc
 meta def print_localized_commands (ns : list name) : tactic unit :=
 do cmds ← get_localized ns, cmds.mmap' trace
 
+-- This should be used instead of `_` inside localized commands,
+-- because otherwise `open_locale` will fail if some of the notations are already available.
+notation `hole!` := _
+
 -- you can run `open_locale classical` to get the decidability of all propositions, and downgrade
 -- the priority of decidability instances that make Lean run through all the algebraic hierarchy
 -- whenever it wants to solve a decidability question
 localized "attribute [instance, priority 9] classical.prop_decidable" in classical
-localized "attribute [instance, priority 8] eq.decidable decidable_eq_of_decidable_le" in classical
+localized "attribute [instance, priority 8] eq.decidable" in classical
 
 
-localized "postfix `?`:9001 := optional" in parser
-localized "postfix *:9001 := lean.parser.many" in parser
+localized "postfix (name := parser.optional) `?`:9001 := optional" in parser
+localized "postfix (name := parser.many) *:9001 := lean.parser.many" in parser
diff --git a/src/tactic/mk_simp_attribute.lean b/src/tactic/mk_simp_attribute.lean
new file mode 100644
index 0000000000000..2422f9675391a
--- /dev/null
+++ b/src/tactic/mk_simp_attribute.lean
@@ -0,0 +1,119 @@
+/-
+Copyright (c) 2019 Rob Lewis All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Rob Lewis
+-/
+import tactic.doc_commands
+/-!
+# User command to register `simp` attributes
+
+In this file we define a command `mk_simp_attribute` that can be used to register `simp` sets.  We
+also define all `simp` attributes that are used in the library and tag lemmas from Lean core with
+these attributes.
+-/
+
+/-!
+### User command
+-/
+
+section cmd
+
+open interactive lean lean.parser
+
+namespace tactic
+
+/--
+The command `mk_simp_attribute simp_name "description"` creates a simp set with name `simp_name`.
+Lemmas tagged with `@[simp_name]` will be included when `simp with simp_name` is called.
+`mk_simp_attribute simp_name none` will use a default description.
+
+Appending the command with `with attr1 attr2 ...` will include all declarations tagged with
+`attr1`, `attr2`, ... in the new simp set.
+
+This command is preferred to using ``run_cmd mk_simp_attr `simp_name`` since it adds a doc string
+to the attribute that is defined. If you need to create a simp set in a file where this command is
+not available, you should use
+```lean
+run_cmd mk_simp_attr `simp_name
+run_cmd add_doc_string `simp_attr.simp_name "Description of the simp set here"
+```
+-/
+@[user_command]
+meta def mk_simp_attribute_cmd (_ : parse $ tk "mk_simp_attribute") : lean.parser unit :=
+do n ← ident,
+   d ← parser.pexpr,
+   d ← to_expr ``(%%d : option string),
+   descr ← eval_expr (option string) d,
+   with_list ← (tk "with" *> many ident) <|> return [],
+   mk_simp_attr n with_list,
+   add_doc_string (name.append `simp_attr n) $ descr.get_or_else $ "simp set for " ++ to_string n
+
+add_tactic_doc
+{ name                     := "mk_simp_attribute",
+  category                 := doc_category.cmd,
+  decl_names               := [`tactic.mk_simp_attribute_cmd],
+  tags                     := ["simplification"] }
+
+end tactic
+
+end cmd
+
+/-!
+### Attributes
+-/
+
+mk_simp_attribute equiv_rw_simp "The simpset `equiv_rw_simp` is used by the tactic `equiv_rw` to
+simplify applications of equivalences and their inverses."
+
+mk_simp_attribute field_simps "The simpset `field_simps` is used by the tactic `field_simp` to
+reduce an expression in a field to an expression of the form `n / d` where `n` and `d` are
+division-free."
+
+mk_simp_attribute functor_norm "Simp set for functor_norm"
+
+attribute [functor_norm] bind_assoc pure_bind bind_pure
+
+mk_simp_attribute ghost_simps "Simplification rules for ghost equations"
+
+mk_simp_attribute integral_simps "Simp set for integral rules."
+
+mk_simp_attribute is_R_or_C_simps "Simp attribute for lemmas about `is_R_or_C`"
+
+mk_simp_attribute mfld_simps "The simpset `mfld_simps` records several simp lemmas that are
+especially useful in manifolds. It is a subset of the whole set of simp lemmas, but it makes it
+possible to have quicker proofs (when used with `squeeze_simp` or `simp only`) while retaining
+readability.
+
+The typical use case is the following, in a file on manifolds:
+If `simp [foo, bar]` is slow, replace it with `squeeze_simp [foo, bar] with mfld_simps` and paste
+its output. The list of lemmas should be reasonable (contrary to the output of
+`squeeze_simp [foo, bar]` which might contain tens of lemmas), and the outcome should be quick
+enough.
+"
+
+attribute [mfld_simps] id.def function.comp.left_id set.mem_set_of_eq and_true true_and
+  function.comp_app and_self eq_self_iff_true function.comp.right_id not_false_iff true_or or_true
+
+mk_simp_attribute monad_norm none with functor_norm
+
+mk_simp_attribute nontriviality "Simp lemmas for `nontriviality` tactic"
+
+mk_simp_attribute parity_simps "Simp attribute for lemmas about `even`"
+
+mk_simp_attribute push_cast "The `push_cast` simp attribute uses `norm_cast` lemmas
+to move casts toward the leaf nodes of the expression."
+
+mk_simp_attribute split_if_reduction
+  "Simp set for if-then-else statements, used in the `split_ifs` tactic"
+
+attribute [split_if_reduction] if_pos if_neg dif_pos dif_neg if_congr
+
+mk_simp_attribute transport_simps
+"The simpset `transport_simps` is used by the tactic `transport`
+to simplify certain expressions involving application of equivalences,
+and trivial `eq.rec` or `ep.mpr` conversions.
+It's probably best not to adjust it without understanding the algorithm used by `transport`."
+
+attribute [transport_simps] cast_eq
+
+mk_simp_attribute typevec "simp set for the manipulation of typevec and arrow expressions"
diff --git a/src/tactic/monotonicity/basic.lean b/src/tactic/monotonicity/basic.lean
index ac0114880a01f..e38bd0400539f 100644
--- a/src/tactic/monotonicity/basic.lean
+++ b/src/tactic/monotonicity/basic.lean
@@ -3,7 +3,7 @@ Copyright (c) 2019 Simon Hudon. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Simon Hudon
 -/
-import order.bounded_order
+import order.with_bot
 
 namespace tactic.interactive
 open tactic list
diff --git a/src/tactic/monotonicity/interactive.lean b/src/tactic/monotonicity/interactive.lean
index 7d0091697c6eb..fd9ab6624ceb2 100644
--- a/src/tactic/monotonicity/interactive.lean
+++ b/src/tactic/monotonicity/interactive.lean
@@ -16,8 +16,8 @@ open lean lean.parser  interactive
 open interactive.types
 open tactic
 
-local postfix `?`:9001 := optional
-local postfix *:9001 := many
+local postfix (name := parser.optional) `?`:9001 := optional
+local postfix (name := parser.many) *:9001 := many
 
 meta inductive mono_function (elab : bool := tt)
  | non_assoc : expr elab → list (expr elab) → list (expr elab) → mono_function
@@ -99,7 +99,7 @@ return ()
 private meta def match_rule_head  (p : expr)
 : list expr → expr → expr → tactic expr
  | vs e t :=
-(unify t p >> mmap' unify_with_instance vs >> instantiate_mvars e)
+(unify t p >> mmap' unify_with_instance vs.reverse >> instantiate_mvars e)
 <|>
 do (expr.pi _ _ d b) ← return t | failed,
    v ← mk_meta_var d,
diff --git a/src/tactic/monotonicity/lemmas.lean b/src/tactic/monotonicity/lemmas.lean
index 5b98a6c01ba92..4912d311ab8c8 100644
--- a/src/tactic/monotonicity/lemmas.lean
+++ b/src/tactic/monotonicity/lemmas.lean
@@ -3,76 +3,19 @@ Copyright (c) 2019 Simon Hudon. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Simon Hudon
 -/
-import algebra.order.ring
-import data.nat.basic
+import algebra.order.group.abs
+import algebra.order.ring.defs
+import algebra.order.sub.canonical
 import data.set.lattice
-import order.directed
 import tactic.monotonicity.basic
 
 variables {α : Type*}
 
-@[mono]
-lemma mul_mono_nonneg {x y z : α} [ordered_semiring α]
-  (h' : 0 ≤ z)
-  (h : x ≤ y)
-: x * z ≤ y * z :=
-by apply mul_le_mul_of_nonneg_right; assumption
-
-lemma lt_of_mul_lt_mul_neg_right {a b c : α}  [linear_ordered_ring α]
-  (h : a * c < b * c) (hc : c ≤ 0) : b < a :=
-have nhc : -c ≥ 0, from neg_nonneg_of_nonpos hc,
-have h2 : -(b * c) < -(a * c), from neg_lt_neg h,
-have h3 : b * (-c) < a * (-c), from calc
-     b * (-c) = - (b * c)    : by rewrite neg_mul_eq_mul_neg
-          ... < - (a * c)    : h2
-          ... = a * (-c)     : by rewrite neg_mul_eq_mul_neg,
-lt_of_mul_lt_mul_right h3 nhc
-
-@[mono]
-lemma mul_mono_nonpos {x y z : α} [linear_ordered_ring α]
-  (h' : z ≤ 0) (h : y ≤ x) : x * z ≤ y * z :=
-begin
-  classical,
-  by_contradiction h'',
-  revert h,
-  apply not_le_of_lt,
-  apply lt_of_mul_lt_mul_neg_right _ h',
-  apply lt_of_not_ge h''
-end
-
-@[mono]
-lemma nat.sub_mono_left_strict {x y z : ℕ}
-  (h' : z ≤ x)
-  (h : x < y)
-: x - z < y - z :=
-begin
-  have : z ≤ y,
-  { transitivity, assumption, apply le_of_lt h, },
-  apply @nat.lt_of_add_lt_add_left z,
-  rw [add_tsub_cancel_of_le,add_tsub_cancel_of_le];
-    solve_by_elim
-end
-
-@[mono]
-lemma nat.sub_mono_right_strict {x y z : ℕ}
-  (h' : x ≤ z)
-  (h : y < x)
-: z - x < z - y :=
-begin
-  have h'' : y ≤ z,
-  { transitivity, apply le_of_lt h, assumption },
-  apply @nat.lt_of_add_lt_add_right _ x,
-  rw [tsub_add_cancel_of_le h'],
-  apply @lt_of_le_of_lt _ _ _ (z - y + y),
-  rw [tsub_add_cancel_of_le h''],
-  apply nat.add_lt_add_left h
-end
-
 open set
 
 attribute [mono] inter_subset_inter union_subset_union
                  sUnion_mono Union₂_mono sInter_subset_sInter Inter₂_mono
-                 image_subset preimage_mono prod_mono monotone_prod seq_mono
+                 image_subset preimage_mono prod_mono monotone.set_prod seq_mono
                  image2_subset order_embedding.monotone
 attribute [mono] upper_bounds_mono_set lower_bounds_mono_set
                  upper_bounds_mono_mem  lower_bounds_mono_mem
@@ -81,8 +24,11 @@ attribute [mono] upper_bounds_mono_set lower_bounds_mono_set
 
 attribute [mono] add_le_add mul_le_mul neg_le_neg
          mul_lt_mul_of_pos_left mul_lt_mul_of_pos_right
+         mul_le_mul_of_nonneg_left mul_le_mul_of_nonneg_right
+         mul_le_mul_of_nonpos_left mul_le_mul_of_nonpos_right
          imp_imp_imp le_implies_le_of_le_of_le
-         sub_le_sub tsub_le_tsub tsub_le_tsub_right abs_le_abs sup_le_sup
+         tsub_lt_tsub_left_of_le tsub_lt_tsub_right_of_le
+         tsub_le_tsub abs_le_abs sup_le_sup
          inf_le_inf
 attribute [mono left] add_lt_add_of_le_of_lt mul_lt_mul'
 attribute [mono right] add_lt_add_of_lt_of_le mul_lt_mul
diff --git a/src/tactic/move_add.lean b/src/tactic/move_add.lean
new file mode 100644
index 0000000000000..4681554f3d50d
--- /dev/null
+++ b/src/tactic/move_add.lean
@@ -0,0 +1,410 @@
+/-
+Copyright (c) 2022 Arthur Paulino, Damiano Testa. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Arthur Paulino, Damiano Testa
+-/
+import tactic.core
+import algebra.group.basic
+
+/-!
+# `move_add`: a tactic for moving summands
+
+Calling `move_add [a, ← b, c]`, recursively looks inside the goal for expressions involving a sum.
+Whenever it finds one, it moves the summands that unify to `a, b, c`, removing all parentheses.
+
+See the doc-string for `tactic.interactive.move_add` for more information.
+
+##  Implementation notes
+
+This file defines a general `move_op` tactic, intended for reordering terms in an expression
+obtained by repeated applications of a given associative, commutative binary operation.  The
+user decides the final reordering.  Applying `move_op` without specifying the order will simply
+remove all parentheses from the expression.
+The main user-facing tactics are `move_add` and `move_mul`, dealing with addition and
+multiplication, respectively.
+
+In what is below, we talk about `move_add` for definiteness, but everything applies
+to `move_mul` and to the more general `move_op`.
+
+The implementation of `move_add` only moves the terms specified by the user (and rearranges
+parentheses).
+
+Note that the tactic `abel` already implements a very solid heuristic for normalizing terms in an
+additive commutative semigroup and produces expressions in more or less standard form.
+The scope of `move_add` is different: it is designed to make it easy to move individual terms
+around a sum.
+
+##  Future work
+
+* Add support for `neg/div/inv` in additive/multiplicative groups?
+* Currently the tactic has special support for `+` and `*`.  Every other operation is outsourced
+  to `ac_refl` (see the proof of `reorder_hyp`).  Should there be the desire for specialized support
+  of other operations (e.g. `∪, ∩, ⊓, ⊔, ...`), that is the definition to modify, at least in the
+  first instance.
+* Add functionality for moving terms across the two sides of an in/dis/equality.
+  E.g. it might be desirable to have `to_lhs [a]` converting `b + c = a + d` to `- a + b + c = d`.
+* Add a non-recursive version for use in `conv` mode.
+* Revise tests?
+-/
+
+namespace tactic
+
+namespace move_op
+
+/-!
+Throughout this file, `op : pexpr` denotes an arbitrary (binary) operation.  We do not use,
+but implicitly imagine, that this operation is associative, since we extract iterations of
+such operations, with complete disregard of the order in which these iterations arise.
+-/
+
+/--  Given a list `un` of `α`s and a list `bo` of `bool`s, return the sublist of `un`
+consisting of the entries of `un` whose corresponding entry in `bo` is `tt`.
+
+Used for error management: `un` is the list of user inputs, `bo` is the list encoding which input
+is unused (`tt`) and which input is used (`ff`).
+`return_unused` returns the unused user inputs.
+
+If `bo` is shorter than `un`, `return_unused` will include the remainder of `un`.
+-/
+def return_unused {α : Type*} : list α → list bool → list α
+| un [] := un
+| [] bo := []
+| (u::us) (b::bs) := if b then u::return_unused us bs else return_unused us bs
+
+/--  Given a list `lp` of `bool × pexpr` and a list `l_un` of `expr`, scan the elements of `lp` one
+at a time and produce 3 sublists of `l_un`.
+
+If `(tf,pe)` is the first element of `lp`, we look for the first element of `l_un` that unifies with
+`pe.to_expr`.  If no such element exists, then we discard `(tf,pe)` and move along.
+If `eu ∈ l_un` is the first element of `l_un` that unifies with `pe.to_expr`, then we add `eu` as
+the next element of either the first or the second list, depending on the boolean `tf` and we remove
+`eu` from the list `l_un`.  In this case, we continue our scanning with the next element of `lp`,
+replacing `l_un` by `l_un.erase eu`.
+
+Once we exhaust the elements of `lp`, we return the four lists:
+* `l_tt`: the list of elements of `l_un` that came from an element of `lp` whose boolean was `tt`,
+* `l_ff`: the list of elements of `l_un` that came from an element of `lp` whose boolean was `ff`,
+* `l_un`: the un-unified elements of `l_un`,
+* `l_m`: a "mask" list of booleans corresponding to the elements of `lp` that were placed in `l_un`.
+
+The ununified elements of `l_un` get used for error management: they keep track of which user inputs
+are superfluous. -/
+meta def move_left_or_right : list (bool × expr) → list expr → list bool →
+  tactic (list expr × list expr × list expr × list bool)
+| [] l_un l_m      := return ([], [], l_un, l_m)
+| (be::l) l_un l_m := do
+  (ex :: _) ← l_un.mfilter $ λ e', succeeds $ unify be.2 e' |
+    move_left_or_right l l_un (l_m.append [tt]),
+  (l_tt, l_ff, l_un, l_m) ← move_left_or_right l (l_un.erase ex) (l_m.append [ff]),
+  if be.1 then return (ex::l_tt, l_ff, l_un, l_m) else return (l_tt, ex::l_ff, l_un, l_m)
+
+/--  We adapt `move_left_or_right` to our goal:
+1. we convert a list of pairs `bool × pexpr` to a list of pairs `bool × expr`,
+2. we use the extra input `sl : list expr` to perform the unification and sorting step
+   `move_left_or_right`,
+3. we jam the third factor inside the first two.
+-/
+meta def final_sort (lp : list (bool × pexpr)) (sl : list expr) : tactic (list expr × list bool) :=
+do
+  lp_exp : list (bool × expr) ← lp.mmap $ λ x, (do e ← to_expr x.2 tt ff, return (x.1, e)),
+  (l1, l2, l3, is_unused) ← move_left_or_right lp_exp sl [],
+  return (l1 ++ l3 ++ l2, is_unused)
+
+/-- `as_given_op op e` unifies the head term of `e`, which is a ≥2-argument function application,
+with the binary operation `op`, failing if it cannot. -/
+meta def as_given_op (op : pexpr) : expr → tactic expr
+| (expr.app (expr.app F a) b) := do
+    to_expr op tt ff >>= unify F,
+    return F
+| _ := failed
+
+/-- `(e, unused) ← reorder_oper op lp e` converts an expression `e` to a similar looking one.
+The tactic scans the expression `e` looking for subexpressions that begin with the given binary
+operation `op`.  As soon as `reorder_oper` finds one such subexpression,
+* it extracts the "`op`-summands" in the subexpression,
+* it rearranges them according to the rules determined by `lp`,
+* it recurses into each `op`-summand.
+
+The `unused` output is a list of booleans.  It is keeping track of which of the inputs provided
+by `lp` is actually used to perform the rearrangements.  It is useful to report unused inputs.
+
+Here are two examples:
+```lean
+#eval trace $ reorder_oper ``((=)) [(ff,``(2)), (tt,``(7))] `(∀ x y : ℕ, 2 = 0)
+--  (ℕ → ℕ → 0 = 2, [ff, tt])
+-- the input `[(ff,``(2)), (tt,``(7))]` instructs Lean to move `2` to the right and `7`
+-- to the left.  Lean reports that `2` is not unused and `7` is unused as `[ff, tt]`.
+
+#eval trace $ reorder_oper ``((+)) [(ff,``(2)), (tt,``(5))]
+  `(λ (e : ℕ), ∀ (x : ℕ), ∃ (y : ℕ),
+      2 + x * (y + (e + 5)) + y = x + 2 + e → 2 + x = x + 5 + (2 + y))
+/-  `2` moves to the right, `5` moves to the left.  Lean reports that `2, 5` are not unused
+    as `[ff,ff]`
+   (λ (e : ℕ), ∀ (x : ℕ), ∃ (y : ℕ),
+      x * (5 + y + e) + y + 2   = x + e + 2 → x + 2 = 5 + x + y + 2, [ff, ff]) -/
+```
+
+TODO: use `ext_simplify_core` instead of traversing the expression manually
+-/
+meta def reorder_oper (op : pexpr) (lp : list (bool × pexpr)) :
+  expr → tactic (expr × list bool)
+| F'@(expr.app F b) := do
+    is_op ← try_core (as_given_op op F'),
+    match is_op with
+    | some op := do
+        (sort_list, is_unused) ← list_binary_operands op F' >>= final_sort lp,
+        sort_all ← sort_list.mmap (λ e, do
+          (e, lu) ← reorder_oper e,
+          pure (e, [lu, is_unused].transpose.map list.band)),
+        let (recs, list_unused) := sort_all.unzip,
+        recs_0 :: recs_rest ← pure recs | fail!"internal error: cannot have 0 operands",
+        let summed := recs_rest.foldl (λ e f, op.mk_app [e, f]) recs_0,
+        return (summed, list_unused.transpose.map list.band)
+    | none := do
+        [(Fn, unused_F), (bn, unused_b)] ← [F, b].mmap $ reorder_oper,
+        return $ (expr.app Fn bn, [unused_F, unused_b].transpose.map list.band)
+    end
+| (expr.pi na bi e f)           := do
+  [en, fn] ← [e, f].mmap $ reorder_oper,
+  return (expr.pi  na bi en.1 fn.1, [en.2, fn.2].transpose.map list.band)
+| (expr.lam na bi e f)          := do
+  [en, fn] ← [e, f].mmap $ reorder_oper,
+  return (expr.lam na bi en.1 fn.1, [en.2, fn.2].transpose.map list.band)
+| (expr.mvar na pp e)           := do  -- is it really needed to recurse here?
+  en ← reorder_oper e,
+  return (expr.mvar na pp en.1, [en.2].transpose.map list.band)
+| (expr.local_const na pp bi e) := do  -- is it really needed to recurse here?
+  en ← reorder_oper e,
+  return (expr.local_const na pp bi en.1, [en.2].transpose.map list.band)
+| (expr.elet na e f g)          := do
+  [en, fn, gn] ← [e, f, g].mmap $ reorder_oper,
+  return (expr.elet na en.1 fn.1 gn.1, [en.2, fn.2, gn.2].transpose.map list.band)
+| (expr.macro ma le)            := do  -- is it really needed to recurse here?
+  len ← le.mmap $ reorder_oper,
+  let (lee, lb) := len.unzip,
+  return (expr.macro ma lee, lb.transpose.map list.band)
+| e := pure (e, (lp.map (λ _, tt)))
+
+/-- Passes the user input `na` to `reorder_oper` at a single location, that could either be
+`none` (referring to the goal) or `some name` (referring to hypothesis `name`).  Replaces the
+given hypothesis/goal with the rearranged one that `reorder_hyp` receives from `reorder_oper`.
+Returns a pair consisting of a boolean and a further list of booleans.
+The single boolean is `tt` iff the tactic did *not* change the goal on which it was acting.
+The list of booleans records which variable in `ll` has been unified in the application:
+`tt` means that the corresponding variable has *not* been unified.
+
+This definition is useful to streamline error catching. -/
+meta def reorder_hyp (op : pexpr) (lp : list (bool × pexpr)) (na : option name) :
+  tactic (bool × list bool) := do
+(thyp, hyploc) ← match na with
+  | none := do
+      t ← target,
+      return (t, none)
+  | some na := do
+      hl ← get_local na,
+      th ← infer_type hl,
+      return (th, some hl)
+  end,
+(reordered, is_unused) ← reorder_oper op lp thyp,
+unify reordered thyp >> return (tt, is_unused) <|> do
+-- the current `do` block takes place where the reordered expression is not equal to the original
+neq ← mk_app `eq [thyp, reordered],
+nop ← to_expr op tt ff,
+pre ← pp reordered,
+(_, prf) ← solve_aux neq $ match nop with
+  | `(has_add.add) := `[{ simp only [add_comm, add_assoc, add_left_comm]; refl, done }]
+  | `(has_mul.mul) := `[{ simp only [mul_comm, mul_assoc, mul_left_comm]; refl, done }]
+  | _ := ac_refl <|>
+    fail format!("the associative/commutative lemmas used do not suffice to prove that " ++
+      "the initial goal equals:\n\n{pre}\n" ++
+      "Hint: try adding `is_associative` or `is_commutative` instances.\n")
+  end,
+match hyploc with
+| none := replace_target reordered prf
+| some hyploc := replace_hyp hyploc reordered prf >> skip
+end,
+return (ff, is_unused)
+
+section parsing_arguments_for_move_op
+setup_tactic_parser
+
+/-- `move_op_arg` is a single elementary argument that `move_op` takes for the
+variables to be moved.  It is either a `pexpr`, or a `pexpr` preceded by a `←`. -/
+meta def move_op_arg (prec : nat) : parser (bool × pexpr) :=
+prod.mk <$> (option.is_some <$> (tk "<-")?) <*> parser.pexpr prec
+
+/-- `move_pexpr_list_or_texpr` is either a list of `move_op_arg`, possibly empty, or a single
+`move_op_arg`. -/
+meta def move_pexpr_list_or_texpr : parser (list (bool × pexpr)) :=
+list_of (move_op_arg 0) <|> list.ret <$> move_op_arg tac_rbp <|> return []
+
+end parsing_arguments_for_move_op
+
+end move_op
+
+setup_tactic_parser
+open move_op
+
+/--  `move_op args locat op` is the non-interactive version of the main tactics `move_add` and
+`move_mul` of this file.  Given as input `args` (a list of terms of a sequence of operands),
+`locat` (hypotheses or goal where the tactic should act) and `op` (the operation to use),
+`move_op` attempts to perform the rearrangement of the terms determined by `args`.
+
+Currently, the tactic uses only `add/mul_comm, add/mul_assoc, add/mul_left_comm`, so other
+operations will not actually work.
+-/
+meta def move_op (args : parse move_pexpr_list_or_texpr) (locat : parse location) (op : pexpr) :
+  tactic unit := do
+locas ← locat.get_locals,
+tg ← target,
+let locas_with_tg := if locat.include_goal then locas ++ [tg] else locas,
+ner ← locas_with_tg.mmap (λ e, reorder_hyp op args e.local_pp_name <|> reorder_hyp op args none),
+let (unch_tgts, unus_vars) := ner.unzip,
+str_unva ← match
+  (return_unused args (unus_vars.transpose.map list.band)).map (λ e : bool × pexpr, e.2) with
+  | []   := pure []
+  | [pe] := do
+    nm ← to_expr pe tt ff >>= λ ex, pp ex.replace_mvars,
+    return [format!"'{nm}' is an unused variable"]
+  | pes  := do
+    nms ← pes.mmap (λ e, to_expr e tt ff) >>= λ exs, (exs.map expr.replace_mvars).mmap pp,
+    return [format!"'{nms}' are unused variables"]
+  end,
+let str_tgts := match locat with
+  | loc.wildcard := if unch_tgts.band then [format!"nothing changed"] else []
+  | loc.ns names := let linames := return_unused locas unch_tgts in
+      (if none ∈ return_unused names unch_tgts
+        then [format!"Goal did not change"] else []) ++
+      (if linames ≠ [] then [format!"'{linames.reverse}' did not change"] else [])
+  end,
+[] ← pure (str_tgts ++ str_unva) | fail (format.intercalate "\n" (str_tgts ++ str_unva)),
+assumption <|> try (tactic.reflexivity reducible)
+
+namespace interactive
+
+/--
+Calling `move_add [a, ← b, c]`, recursively looks inside the goal for expressions involving a sum.
+Whenever it finds one, it moves the summands that unify to `a, b, c`, removing all parentheses.
+Repetitions are allowed, and are processed following the user-specified ordering.
+The terms preceded by a `←` get placed to the left, the ones without the arrow get placed to the
+right.  Unnamed terms stay in place.  Due to re-parenthesizing, doing `move_add` with no argument
+may change the goal. Also, the *order* in which the terms are provided matters: the tactic reads
+them from left to right.  This is especially important if there are multiple matches for the typed
+terms in the given expressions.
+
+A single call of `move_add` moves terms across different sums in the same expression.
+Here is an example.
+
+```lean
+import tactic.move_add
+
+example {a b c d : ℕ} (h : c = d) : c + b + a = b + a + d :=
+begin
+  move_add [← a, b],  -- Goal: `a + c + b = a + d + b`  -- both sides changed
+  congr,
+  exact h
+end
+
+example {a b c d : ℕ} (h : c = d) : c + b * c + a * c = a * d + d + b * d :=
+begin
+  move_add [_ * c, ← _ * c], -- Goal: `a * c + c + b * c = a * d + d + b * d`
+  -- the first `_ * c` unifies with `b * c` and moves to the right
+  -- the second `_ * c` unifies with `a * c` and moves to the left
+  congr;
+  assumption
+end
+```
+
+The list of expressions that `move_add` takes is optional and a single expression can be passed
+without brackets.  Thus `move_add ← f` and `move_add [← f]` mean the same.
+
+Finally, `move_add` can also target one or more hypotheses.  If `hp₁, hp₂` are in the
+local context, then `move_add [f, ← g] at hp₁ hp₂` performs the rearranging at `hp₁` and `hp₂`.
+As usual, passing `⊢` refers to acting on the goal.
+
+##  Reporting sub-optimal usage
+
+The tactic could fail to prove the reordering.  One potential cause is when there are multiple
+matches for the rearrangements and an earlier rewrite makes a subsequent one fail.  Another
+possibility is that the rearranged expression changes the *Type* of some expression and the
+tactic gets stumped.  Please, report bugs and failures in the Zulip chat!
+
+There are three kinds of unwanted use for `move_add` that result in errors, where the tactic fails
+and flags the unwanted use.
+1. `move_add [vars]? at *` reports globally unused variables and whether *all* goals
+   are unchanged, not *each unchanged goal*.
+2. If a target of `move_add [vars]? at targets` is left unchanged by the tactic, then this will be
+   flagged (unless we are using `at *`).
+3. If a user-provided expression never unifies, then the variable is flagged.
+
+In these cases, the tactic produces an error, reporting unused inputs and unchanged targets as
+appropriate.
+
+For instance, `move_add ← _` always fails reporting an unchanged goal, but never an unused variable.
+
+##  Comparison with existing tactics
+
+* `tactic.interactive.abel`
+  performs a "reduction to normal form" that allows it to close goals involving sums with higher
+  success rate than `move_add`.  If the goal is an equality of two sums that are simply obtained by
+  reparenthesizing and permuting summands, then `move_add [appropriate terms]` can close the goal.
+  Compared to `abel`, `move_add` has the advantage of allowing the user to specify the beginning and
+  the end of the final sum, so that from there the user can continue with the proof.
+
+* `tactic.interactive.ac_change`
+  supports a wide variety of operations.  At the moment, `move_add` works with addition, `move_mul`
+  works with multiplication.  There is the possibility of supporting other operations, using the
+  non-interactive tactic `tactic.move_op`.
+  Still, on several experiments, `move_add` had a much quicker performance than `ac_change`.
+  Also, for `move_add` the user need only specify a few terms: the tactic itself takes care of
+  producing the full rearrangement and proving it "behind the scenes".
+
+###  Remark:
+It is still possible that the same output of `move_add [exprs]` can be achieved by a proper sublist
+of `[exprs]`, even if the tactic does not flag anything.  For instance, giving the full re-ordering
+of the expressions in the target that we want to achieve will not complain that there are unused
+variables, since all the user-provided variables have been matched.  Of course, specifying the order
+of all-but-the-last variable suffices to determine the permutation.  E.g., with a goal of
+`a + b = 0`, applying either one of `move_add [b,a]`, or `move_add a`, or `move_add ← b` has the
+same effect and changes the goal to `b + a = 0`.  These are all valid uses of `move_add`.
+-/
+meta def move_add (args : parse move_pexpr_list_or_texpr) (locat : parse location) :
+  tactic unit :=
+move_op args locat ``((+))
+
+/--  See the doc-string for `tactic.interactive.move_add` and mentally
+replace addition with multiplication throughout. ;-) -/
+meta def move_mul (args : parse move_pexpr_list_or_texpr) (locat : parse location) :
+  tactic unit :=
+move_op args locat ``(has_mul.mul)
+
+/--  `move_oper` behaves like `move_add` except that it also takes an associative, commutative,
+binary operation as input.  The operation must be passed as a list consisting of a single element.
+For instance
+```lean
+example (a b : ℕ) : max a b = max b a :=
+by move_oper [max] [← a, b] at *
+```
+solves the goal.  For more details, see the `move_add` doc-string, replacing `add` with your
+intended operation.
+-/
+meta def move_oper
+  (op : parse pexpr_list) (args : parse move_pexpr_list_or_texpr) (locat : parse location) :
+  tactic unit := do
+[op] ← pure op | fail "only one operation is allowed",
+move_op args locat op
+
+add_tactic_doc
+{ name := "move_add",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.move_add],
+  tags := ["arithmetic"] }
+
+add_tactic_doc
+{ name := "move_mul",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.move_mul],
+  tags := ["arithmetic"] }
+
+end interactive
+end tactic
diff --git a/src/tactic/nontriviality.lean b/src/tactic/nontriviality.lean
new file mode 100644
index 0000000000000..a039590b5a724
--- /dev/null
+++ b/src/tactic/nontriviality.lean
@@ -0,0 +1,126 @@
+/-
+Copyright (c) 2020 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Scott Morrison
+-/
+import logic.nontrivial
+
+
+/-!
+# The `nontriviality` tactic.
+
+-/
+
+namespace tactic
+
+/--
+Tries to generate a `nontrivial α` instance by performing case analysis on
+`subsingleton_or_nontrivial α`,
+attempting to discharge the subsingleton branch using lemmas with `@[nontriviality]` attribute,
+including `subsingleton.le` and `eq_iff_true_of_subsingleton`.
+-/
+meta def nontriviality_by_elim (α : expr) (lems : interactive.parse simp_arg_list) : tactic unit :=
+do
+  alternative ← to_expr ``(subsingleton_or_nontrivial %%α),
+  n ← get_unused_name "_inst",
+  tactic.cases alternative [n, n],
+  (solve1 $ do
+    reset_instance_cache,
+    apply_instance <|>
+      interactive.simp none none ff lems [`nontriviality] (interactive.loc.ns [none])) <|>
+      fail format!"Could not prove goal assuming `subsingleton {α}`",
+  reset_instance_cache
+
+/--
+Tries to generate a `nontrivial α` instance using `nontrivial_of_ne` or `nontrivial_of_lt`
+and local hypotheses.
+-/
+meta def nontriviality_by_assumption (α : expr) : tactic unit :=
+do
+  n ← get_unused_name "_inst",
+  to_expr ``(nontrivial %%α) >>= assert n,
+  apply_instance <|> `[solve_by_elim [nontrivial_of_ne, nontrivial_of_lt]],
+  reset_instance_cache
+
+end tactic
+
+namespace tactic.interactive
+
+open tactic
+
+setup_tactic_parser
+
+/--
+Attempts to generate a `nontrivial α` hypothesis.
+
+The tactic first looks for an instance using `apply_instance`.
+
+If the goal is an (in)equality, the type `α` is inferred from the goal.
+Otherwise, the type needs to be specified in the tactic invocation, as `nontriviality α`.
+
+The `nontriviality` tactic will first look for strict inequalities amongst the hypotheses,
+and use these to derive the `nontrivial` instance directly.
+
+Otherwise, it will perform a case split on `subsingleton α ∨ nontrivial α`, and attempt to discharge
+the `subsingleton` goal using `simp [lemmas] with nontriviality`, where `[lemmas]` is a list of
+additional `simp` lemmas that can be passed to `nontriviality` using the syntax
+`nontriviality α using [lemmas]`.
+
+```
+example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
+begin
+  nontriviality, -- There is now a `nontrivial R` hypothesis available.
+  assumption,
+end
+```
+
+```
+example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
+begin
+  nontriviality, -- There is now a `nontrivial R` hypothesis available.
+  apply mul_comm,
+end
+```
+
+```
+example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : (2 : ℕ) ∣ 4 :=
+begin
+  nontriviality R, -- there is now a `nontrivial R` hypothesis available.
+  dec_trivial
+end
+```
+
+```
+def myeq {α : Type} (a b : α) : Prop := a = b
+
+example {α : Type} (a b : α) (h : a = b) : myeq a b :=
+begin
+  success_if_fail { nontriviality α }, -- Fails
+  nontriviality α using [myeq], -- There is now a `nontrivial α` hypothesis available
+  assumption
+end
+```
+-/
+meta def nontriviality (t : parse texpr?)
+  (lems : parse (tk "using" *> simp_arg_list <|> pure [])) :
+  tactic unit :=
+do
+  α ← match t with
+  | some α := to_expr α
+  | none :=
+    (do t ← mk_mvar, e ← to_expr ``(@eq %%t _ _), target >>= unify e, return t) <|>
+    (do t ← mk_mvar, e ← to_expr ``(@has_le.le %%t _ _ _), target >>= unify e, return t) <|>
+    (do t ← mk_mvar, e ← to_expr ``(@ne %%t _ _), target >>= unify e, return t) <|>
+    (do t ← mk_mvar, e ← to_expr ``(@has_lt.lt %%t _ _ _), target >>= unify e, return t) <|>
+    fail "The goal is not an (in)equality, so you'll need to specify the desired `nontrivial α`
+      instance by invoking `nontriviality α`."
+  end,
+  nontriviality_by_assumption α <|> nontriviality_by_elim α lems
+
+add_tactic_doc
+{ name                     := "nontriviality",
+  category                 := doc_category.tactic,
+  decl_names               := [`tactic.interactive.nontriviality],
+  tags                     := ["logic", "type class"] }
+
+end tactic.interactive
diff --git a/src/tactic/norm_cast.lean b/src/tactic/norm_cast.lean
index 0e243dd6675b8..b0c4fdc0f9409 100644
--- a/src/tactic/norm_cast.lean
+++ b/src/tactic/norm_cast.lean
@@ -61,9 +61,6 @@ when_tracing `norm_cast $ do
 a ← pp a,
 trace ("[norm_cast] " ++ msg ++ a : format)
 
-mk_simp_attribute push_cast "The `push_cast` simp attribute uses `norm_cast` lemmas
-to move casts toward the leaf nodes of the expression."
-
 /--
 `label` is a type used to classify `norm_cast` lemmas.
 * elim lemma:   LHS has 0 head coes and ≥ 1 internal coe
@@ -270,7 +267,7 @@ The `norm_cast` attribute.
     param ← get_label_param norm_cast_attr decl,
     match param with
     | some l :=
-      when (l ≠ elim) $ simp_attr.push_cast.set decl () tt
+      when (l ≠ elim) $ simp_attr.push_cast.set decl () tt prio
     | none := do
       e ← mk_const decl,
       ty ← infer_type e,
@@ -532,7 +529,7 @@ A small variant of `push_cast` suited for non-interactive use.
 -/
 meta def derive_push_cast (extra_lems : list simp_arg_type) (e : expr) : tactic (expr × expr) :=
 do (s, _) ← mk_simp_set tt [`push_cast] extra_lems,
-   (e, prf, _) ← simplify (s.erase [`int.coe_nat_succ]) [] e
+   (e, prf, _) ← simplify (s.erase [`nat.cast_succ]) [] e
                   {fail_if_unchanged := ff} `eq tactic.assumption,
    return (e, prf)
 
@@ -780,17 +777,3 @@ add_tactic_doc
   category   := doc_category.attr,
   decl_names := [``norm_cast.norm_cast_attr],
   tags       := ["coercions", "simplification"] }
-
--- Lemmas defined in core.
-attribute [norm_cast]
-  int.nat_abs_of_nat
-  int.coe_nat_sub
-  int.coe_nat_mul
-  int.coe_nat_zero
-  int.coe_nat_one
-  int.coe_nat_add
-
--- Lemmas about nat.succ need to get a low priority, so that they are tried last.
--- This is because `nat.succ _` matches `1`, `3`, `x+1`, etc.
--- Rewriting would then produce really wrong terms.
-attribute [norm_cast, priority 500] int.coe_nat_succ
diff --git a/src/tactic/norm_fin.lean b/src/tactic/norm_fin.lean
index b2a2013719555..2136b060c2eab 100644
--- a/src/tactic/norm_fin.lean
+++ b/src/tactic/norm_fin.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yakov Pechersky, Mario Carneiro
 -/
 
+import data.fin.basic
 import tactic.norm_num
 
 /-!
@@ -41,7 +42,7 @@ def normalize_fin_lt (n : ℕ) (a : fin n) (b : ℕ) := a.1 = b
 
 theorem normalize_fin_lt.coe {n} {a : fin n} {b : ℕ} (h : normalize_fin_lt n a b) : ↑a = b := h
 
-theorem normalize_fin_iff {n} [fact (0 < n)] {a b} :
+theorem normalize_fin_iff {n : ℕ} [ne_zero n] {a b} :
   normalize_fin n a b ↔ a = fin.of_nat' b :=
 iff.symm (fin.eq_iff_veq _ _)
 
@@ -55,9 +56,10 @@ by rw ← h.coe; exact a.2
 theorem normalize_fin_lt.of {n a b} (h : normalize_fin_lt n a b) : normalize_fin n a b :=
 h.trans $ eq.symm $ nat.mod_eq_of_lt h.lt
 
-theorem normalize_fin.zero (n) : normalize_fin (n+1) 0 0 := by { rw normalize_fin, norm_num }
-theorem normalize_fin_lt.zero (n) : normalize_fin_lt (n+1) 0 0 := refl _
-theorem normalize_fin.one (n) : normalize_fin (n+1) 1 1 := refl _
+theorem normalize_fin.zero (n : ℕ) [ne_zero n] :
+  normalize_fin n 0 0 := by { rw normalize_fin, norm_num }
+theorem normalize_fin_lt.zero (n : ℕ) [ne_zero n] : normalize_fin_lt n 0 0 := refl _
+theorem normalize_fin.one (n : ℕ) [ne_zero n] : normalize_fin n 1 1 := refl _
 theorem normalize_fin.add {n} {a b : fin n} {a' b' c' : ℕ}
   (ha : normalize_fin n a a') (hb : normalize_fin n b b')
   (h : a' + b' = c') : normalize_fin n (a + b) c' :=
@@ -68,8 +70,8 @@ theorem normalize_fin.mul {n} {a b : fin n} {a' b' c' : ℕ}
 by simp only [normalize_fin, ← h] at *; rw [nat.mul_mod, ← ha, ← hb, fin.mul_def]
 theorem normalize_fin.bit0 {n} {a : fin n} {a' : ℕ}
   (h : normalize_fin n a a') : normalize_fin n (bit0 a) (bit0 a') := h.add h rfl
-theorem normalize_fin.bit1 {n} {a : fin (n+1)} {a' : ℕ}
-  (h : normalize_fin (n+1) a a') : normalize_fin (n+1) (bit1 a) (bit1 a') :=
+theorem normalize_fin.bit1 {n : ℕ} [ne_zero n] {a : fin n} {a' : ℕ}
+  (h : normalize_fin n a a') : normalize_fin n (bit1 a) (bit1 a') :=
 h.bit0.add (normalize_fin.one _) rfl
 
 theorem normalize_fin_lt.succ {n} {a : fin n} {a' b : ℕ}
@@ -179,20 +181,20 @@ do ic ← mk_instance_cache `(ℕ), (a, _) ← state_t.run m (ic, none), pure a
 direct expr pattern match because expr pattern matches generate very large terms under the
 hood so going via an intermediate inductive type like this is more efficient. -/
 meta inductive match_fin_result
-| zero (n : expr)            -- `(0 : fin (n+1))`
-| one (n : expr)             -- `(1 : fin (n+1))`
-| add (n a b : expr)         -- `(a + b : fin n)`
-| mul (n a b : expr)         -- `(a * b : fin n)`
-| bit0 (n a : expr)          -- `(bit0 a : fin n)`
-| bit1 (n a : expr)          -- `(bit1 a : fin (n+1))`
-| succ (n a : expr)          -- `(fin.succ a : fin n.succ)`
-| cast_lt (n m i h : expr)   -- `(fin.cast_lt (i : fin m) (h : i.val < n) : fin n)`
-| cast_le (n m h a : expr)   -- `(fin.cast_le (h : n ≤ m) (a : fin n) : fin m)`
-| cast (n m h a : expr)      -- `(fin.cast_le (h : n = m) (a : fin n) : fin m)`
-| cast_add (n m a : expr)    -- `(fin.cast_add m (a : fin n) : fin (n + m))`
-| cast_succ (n a : expr)     -- `(fin.cast_succ (a : fin n) : fin (n + 1))`
-| add_nat (n m a : expr)     -- `(fin.add_nat m (a : fin n) : fin (n + m))`
-| nat_add (n m a : expr)     -- `(fin.nat_add n (a : fin m) : fin (n + m))`
+| zero (n : expr) (n0 : expr)   -- `(0 : fin n)`
+| one (n : expr) (n0 : expr)    -- `(1 : fin n)`
+| add (n a b : expr)            -- `(a + b : fin n)`
+| mul (n a b : expr)            -- `(a * b : fin n)`
+| bit0 (n a : expr)             -- `(bit0 a : fin n)`
+| bit1 (n a : expr) (n0 : expr) -- `(bit1 a : fin n)`
+| succ (n a : expr)             -- `(fin.succ a : fin n.succ)`
+| cast_lt (n m i h : expr)      -- `(fin.cast_lt (i : fin m) (h : i.val < n) : fin n)`
+| cast_le (n m h a : expr)      -- `(fin.cast_le (h : n ≤ m) (a : fin n) : fin m)`
+| cast (n m h a : expr)         -- `(fin.cast_le (h : n = m) (a : fin n) : fin m)`
+| cast_add (n m a : expr)       -- `(fin.cast_add m (a : fin n) : fin (n + m))`
+| cast_succ (n a : expr)        -- `(fin.cast_succ (a : fin n) : fin (n + 1))`
+| add_nat (n m a : expr)        -- `(fin.add_nat m (a : fin n) : fin (n + m))`
+| nat_add (n m a : expr)        -- `(fin.nat_add n (a : fin m) : fin (n + m))`
 
 section
 open match_fin_result
@@ -211,12 +213,12 @@ meta def match_fin_coe_fn (a : expr) : expr → option match_fin_result
 /-- Match a fin expression to a `match_fin_result`, for easier pattern matching in the
 evaluator. -/
 meta def match_fin : expr → option match_fin_result
-| `(@has_zero.zero ._ (@fin.has_zero %%n)) := some (zero n)
-| `(@has_one.one ._ (@fin.has_one %%n)) := some (one n)
+| `(@has_zero.zero ._ (@fin.has_zero_of_ne_zero %%n %%n0)) := some (zero n n0)
+| `(@has_one.one ._ (@fin.has_one_of_ne_zero %%n %%n0)) := some (one n n0)
 | `(@has_add.add (fin %%n) ._ %%a %%b) := some (add n a b)
 | `(@has_mul.mul (fin %%n) ._ %%a %%b) := some (mul n a b)
 | `(@_root_.bit0 (fin %%n) ._ %%a) := some (bit0 n a)
-| `(@_root_.bit1 ._ (@fin.has_one %%n) ._ %%a) := some (bit1 n a)
+| `(@_root_.bit1 ._ (@fin.has_one_of_ne_zero %%n %%n0) ._ %%a) := some (bit1 n a n0)
 | `(@fin.succ %%n %%a) := some (succ n a)
 | `(@fin.cast_lt %%n %%m %%a %%h) := some (cast_lt n m a h)
 | (expr.app `(@coe_fn ._ ._ ._ %%f) a) := match_fin_coe_fn a f
@@ -305,8 +307,8 @@ meta def eval_fin : expr → eval_fin_m (expr × expr)
 | a := do
   m ← match_fin a,
   match m with
-  | match_fin_result.zero n := pure (`(0 : ℕ), `(normalize_fin.zero).mk_app [n])
-  | match_fin_result.one n := pure (`(1 : ℕ), `(normalize_fin.one).mk_app [n])
+  | match_fin_result.zero n n0 := pure (`(0 : ℕ), `(normalize_fin.zero).mk_app [n, n0])
+  | match_fin_result.one n n0 := pure (`(1 : ℕ), `(normalize_fin.one).mk_app [n, n0])
   | match_fin_result.add n a b := do
     (a', pa) ← eval_fin a,
     (b', pb) ← eval_fin b,
@@ -320,9 +322,9 @@ meta def eval_fin : expr → eval_fin_m (expr × expr)
   | match_fin_result.bit0 n a := do
     (a', pa) ← eval_fin a,
     pure (`(@bit0 ℕ _).mk_app [a'], `(@normalize_fin.bit0).mk_app [n, a, a', pa])
-  | match_fin_result.bit1 n a := do
+  | match_fin_result.bit1 n a n0 := do
     (a', pa) ← eval_fin a,
-    pure (`(@bit1 ℕ _ _).mk_app [a'], `(@normalize_fin.bit1).mk_app [n, a, a', pa])
+    pure (`(@bit1 ℕ _ _).mk_app [a'], `(@normalize_fin.bit1).mk_app [n, n0, a, a', pa])
   | match_fin_result.cast m n nm a := do
     (a', pa) ← (eval_fin a).reset,
     pure (a', `(@normalize_fin.cast).mk_app [n, m, nm, a, a', pa])
@@ -396,10 +398,10 @@ meta def mk_fin_numeral (n m : expr) : expr → option (expr × expr)
 | a := match match_numeral a with
   | zero := some (
     expr.app `(@has_zero.zero (fin %%n)) `(@fin.has_zero %%m),
-    expr.app `(normalize_fin.zero) m)
+    `(normalize_fin.zero).mk_app [n, `(@ne_zero.succ %%m)])
   | one := some (
     expr.app `(@has_one.one (fin %%n)) `(@fin.has_one %%m),
-    expr.app `(normalize_fin.one) m)
+    `(normalize_fin.one).mk_app [n, `(@ne_zero.succ %%m)])
   | bit0 a := do
     (a', p) ← mk_fin_numeral a,
     some (`(bit0 %%a' : fin %%n), `(@normalize_fin.bit0).mk_app [n, a', a, p])
@@ -407,7 +409,7 @@ meta def mk_fin_numeral (n m : expr) : expr → option (expr × expr)
     (a', p) ← mk_fin_numeral a,
     some (
       `(@_root_.bit1 (fin %%n)).mk_app [`(@fin.has_one %%m), `(@fin.has_add %%n), a'],
-      `(@normalize_fin.bit1).mk_app [m, a', a, p])
+      `(@normalize_fin.bit1).mk_app [n, `(@ne_zero.succ %%m), a', a, p])
   | _ := none
   end
 end
diff --git a/src/tactic/norm_num.lean b/src/tactic/norm_num.lean
index 66472527140b0..27753225ea3be 100644
--- a/src/tactic/norm_num.lean
+++ b/src/tactic/norm_num.lean
@@ -5,6 +5,7 @@ Authors: Simon Hudon, Mario Carneiro
 -/
 import data.rat.cast
 import data.rat.meta_defs
+import data.int.lemmas
 
 /-!
 # `norm_num`
@@ -249,6 +250,8 @@ meta def prove_mul_nat : instance_cache → expr → expr → tactic (instance_c
 
 end
 
+lemma zero_lt_one [linear_ordered_semiring α] : (0 : α) < 1 := zero_lt_one
+
 section
 open match_numeral_result
 
@@ -256,7 +259,7 @@ open match_numeral_result
 meta def prove_pos_nat (c : instance_cache) : expr → tactic (instance_cache × expr)
 | e :=
   match match_numeral e with
-  | one := c.mk_app ``zero_lt_one' []
+  | one := c.mk_app ``zero_lt_one []
   | bit0 e := do (c, p) ← prove_pos_nat e, c.mk_app ``bit0_pos [e, p]
   | bit1 e := do (c, p) ← prove_pos_nat e, c.mk_app ``bit1_pos' [e, p]
   | _ := failed
@@ -308,7 +311,7 @@ if na.denom = 1 then
 else do
   [_, _, a, b] ← return a.get_app_args,
   (c, b') ← c.of_nat (nd / na.denom),
-  (c, p₀) ← prove_ne_zero c b (rat.of_int na.denom),
+  (c, p₀) ← prove_ne_zero c b na.denom,
   (c, _, p₁) ← prove_mul_nat c b b',
   (c, r, p₂) ← prove_mul_nat c a b',
   (c, p) ← c.mk_app ``clear_denom_div [a, b, b', r, d, p₀, p₁, p₂],
@@ -689,7 +692,7 @@ We may also add coercions to `ℤ` and `ℕ` as well in order to support `char_z
 rings and semirings. -/
 meta def prove_ne : instance_cache → expr → expr → ℚ → ℚ → tactic (instance_cache × expr)
 | ic a b na nb := prove_ne_rat ic a b na nb <|> do
-  cz_inst ← mk_mapp ``char_zero [ic.α, none, none] >>= mk_instance,
+  cz_inst ← mk_mapp ``char_zero [ic.α, none] >>= mk_instance,
   if na.denom = 1 ∧ nb.denom = 1 then
     if na ≥ 0 ∧ nb ≥ 0 then do
       guard (ic.α ≠ `(ℕ)),
@@ -737,7 +740,7 @@ if na.denom = 1 ∧ nb.denom = 1 then
 else do
   let nd := na.denom.lcm nb.denom,
   (ic, d) ← ic.of_nat nd,
-  (ic, p₀) ← prove_ne_zero ic d (rat.of_int nd),
+  (ic, p₀) ← prove_ne_zero ic d nd,
   (ic, a', pa) ← prove_clear_denom ic a d na nd,
   (ic, b', pb) ← prove_clear_denom ic b d nb nd,
   (ic, c', pc) ← prove_clear_denom ic c d nc nd,
@@ -802,7 +805,7 @@ if na.denom = 1 then do
   return (c, d, a, p)
 else do
   [α, _, a, b] ← return a.get_app_args,
-  (c, p₀) ← prove_ne_zero c b (rat.of_int na.denom),
+  (c, p₀) ← prove_ne_zero c b na.denom,
   (c, p) ← c.mk_app ``clear_denom_simple_div [a, b, p₀],
   return (c, b, a, p)
 
@@ -1057,9 +1060,10 @@ meta def prove_zpow (ic zc nc : instance_cache) (a : expr) (na : ℚ) (b : expr)
   match match_sign b with
   | sum.inl b := do
     (zc, nc, b', hb) ← prove_nat_uncast zc nc b,
+    (nc, b0) ← prove_pos nc b',
     (ic, c, h) ← prove_pow a na ic b',
     (ic, c', hc) ← c.to_rat >>= prove_inv ic c,
-    (ic, p) ← ic.mk_app ``zpow_neg [a, b, b', c, c', hb, h, hc],
+    (ic, p) ← ic.mk_app ``zpow_neg [a, b, b', c, c', b0, hb, h, hc],
     pure (ic, zc, nc, c', p)
   | sum.inr ff := do
     (ic, o) ← ic.mk_app ``has_one.one [],
@@ -1074,12 +1078,17 @@ meta def prove_zpow (ic zc nc : instance_cache) (a : expr) (na : ℚ) (b : expr)
 
 /-- Evaluates expressions of the form `a ^ b`, `monoid.npow a b` or `nat.pow a b`. -/
 meta def eval_pow : expr → tactic (expr × expr)
-| `(@has_pow.pow %%α _ %%m %%e₁ %%e₂) := do
+| `(@has_pow.pow %%α %%β %%m %%e₁ %%e₂) := do
   n₁ ← e₁.to_rat,
-  c ← infer_type e₁ >>= mk_instance_cache,
-  match m with
-  | `(@monoid.has_pow %%_ %%_) := prod.snd <$> prove_pow e₁ n₁ c e₂
-  | `(@div_inv_monoid.has_pow %%_ %%_) := do
+  c ← mk_instance_cache α,
+  match β with
+  | `(ℕ) := do
+    (c, m') ← c.mk_app ``monoid.has_pow [],
+    is_def_eq m m',
+    prod.snd <$> prove_pow e₁ n₁ c e₂
+  | `(ℤ) := do
+    (c, m') ← c.mk_app ``div_inv_monoid.has_pow [],
+    is_def_eq m m',
     zc ← mk_instance_cache `(ℤ),
     nc ← mk_instance_cache `(ℕ),
     (prod.snd ∘ prod.snd ∘ prod.snd) <$> prove_zpow c zc nc e₁ n₁ e₂
@@ -1108,6 +1117,12 @@ prod.mk `(false) <$> mk_app ``eq_false_intro [p]
 theorem not_refl_false_intro {α} (a : α) : (a ≠ a) = false :=
 eq_false_intro $ not_not_intro rfl
 
+@[nolint ge_or_gt] -- see Note [nolint_ge]
+theorem gt_intro {α} [has_lt α] (a b : α) (c) (h : a < b = c) : b > a = c := h
+
+@[nolint ge_or_gt] -- see Note [nolint_ge]
+theorem ge_intro {α} [has_le α] (a b : α) (c) (h : a ≤ b = c) : b ≥ a = c := h
+
 /-- Evaluates the inequality operations `=`,`<`,`>`,`≤`,`≥`,`≠` on numerals. -/
 meta def eval_ineq : expr → tactic (expr × expr)
 | `(%%e₁ < %%e₂) := do
@@ -1139,8 +1154,12 @@ meta def eval_ineq : expr → tactic (expr × expr)
   c ← infer_type e₁ >>= mk_instance_cache,
   if n₁ = n₂ then mk_eq_refl e₁ >>= true_intro
   else do (_, p) ← prove_ne c e₁ e₂ n₁ n₂, false_intro p
-| `(%%e₁ > %%e₂) := mk_app ``has_lt.lt [e₂, e₁] >>= eval_ineq
-| `(%%e₁ ≥ %%e₂) := mk_app ``has_le.le [e₂, e₁] >>= eval_ineq
+| `(%%e₁ > %%e₂) := do
+  (e, p) ← mk_app ``has_lt.lt [e₂, e₁] >>= eval_ineq,
+  prod.mk e <$> mk_app ``gt_intro [e₂, e₁, e, p]
+| `(%%e₁ ≥ %%e₂) := do
+  (e, p) ← mk_app ``has_le.le [e₂, e₁] >>= eval_ineq,
+  prod.mk e <$> mk_app ``ge_intro [e₂, e₁, e, p]
 | `(%%e₁ ≠ %%e₂) := do
   n₁ ← e₁.to_rat, n₂ ← e₂.to_rat,
   c ← infer_type e₁ >>= mk_instance_cache,
@@ -1166,69 +1185,6 @@ meta def prove_nat_succ (ic : instance_cache) : expr → tactic (instance_cache
   p ← mk_eq_refl e,
   return (ic, n, e, p)
 
-lemma nat_div (a b q r m : ℕ) (hm : q * b = m) (h : r + m = a) (h₂ : r < b) : a / b = q :=
-by rw [← h, ← hm, nat.add_mul_div_right _ _ (lt_of_le_of_lt (nat.zero_le _) h₂),
-       nat.div_eq_of_lt h₂, zero_add]
-
-lemma int_div (a b q r m : ℤ) (hm : q * b = m) (h : r + m = a) (h₁ : 0 ≤ r) (h₂ : r < b) :
-  a / b = q :=
-by rw [← h, ← hm, int.add_mul_div_right _ _ (ne_of_gt (lt_of_le_of_lt h₁ h₂)),
-       int.div_eq_zero_of_lt h₁ h₂, zero_add]
-
-lemma nat_mod (a b q r m : ℕ) (hm : q * b = m) (h : r + m = a) (h₂ : r < b) : a % b = r :=
-by rw [← h, ← hm, nat.add_mul_mod_self_right, nat.mod_eq_of_lt h₂]
-
-lemma int_mod (a b q r m : ℤ) (hm : q * b = m) (h : r + m = a) (h₁ : 0 ≤ r) (h₂ : r < b) :
-  a % b = r :=
-by rw [← h, ← hm, int.add_mul_mod_self, int.mod_eq_of_lt h₁ h₂]
-
-lemma int_div_neg (a b c' c : ℤ) (h : a / b = c') (h₂ : -c' = c) : a / -b = c :=
-h₂ ▸ h ▸ int.div_neg _ _
-
-lemma int_mod_neg (a b c : ℤ) (h : a % b = c) : a % -b = c :=
-(int.mod_neg _ _).trans h
-
-/-- Given `a`,`b` numerals in `nat` or `int`,
-  * `prove_div_mod ic a b ff` returns `(c, ⊢ a / b = c)`
-  * `prove_div_mod ic a b tt` returns `(c, ⊢ a % b = c)`
--/
-meta def prove_div_mod (ic : instance_cache) :
-  expr → expr → bool → tactic (instance_cache × expr × expr)
-| a b mod :=
-  match match_neg b with
-  | some b := do
-    (ic, c', p) ← prove_div_mod a b mod,
-    if mod then
-      return (ic, c', `(int_mod_neg).mk_app [a, b, c', p])
-    else do
-      (ic, c, p₂) ← prove_neg ic c',
-      return (ic, c, `(int_div_neg).mk_app [a, b, c', c, p, p₂])
-  | none := do
-    nb ← b.to_nat,
-    na ← a.to_int,
-    let nq := na / nb,
-    let nr := na % nb,
-    let nm := nq * nr,
-    (ic, q) ← ic.of_int nq,
-    (ic, r) ← ic.of_int nr,
-    (ic, m, pm) ← prove_mul_rat ic q b (rat.of_int nq) (rat.of_int nb),
-    (ic, p) ← prove_add_rat ic r m a (rat.of_int nr) (rat.of_int nm) (rat.of_int na),
-    (ic, p') ← prove_lt_nat ic r b,
-    if ic.α = `(nat) then
-      if mod then return (ic, r, `(nat_mod).mk_app [a, b, q, r, m, pm, p, p'])
-      else        return (ic, q, `(nat_div).mk_app [a, b, q, r, m, pm, p, p'])
-    else if ic.α = `(int) then do
-      (ic, p₀) ← prove_nonneg ic r,
-      if mod then return (ic, r, `(int_mod).mk_app [a, b, q, r, m, pm, p, p₀, p'])
-      else        return (ic, q, `(int_div).mk_app [a, b, q, r, m, pm, p, p₀, p'])
-    else failed
-  end
-
-theorem dvd_eq_nat (a b c : ℕ) (p) (h₁ : b % a = c) (h₂ : (c = 0) = p) : (a ∣ b) = p :=
-(propext $ by rw [← h₁, nat.dvd_iff_mod_eq_zero]).trans h₂
-theorem dvd_eq_int (a b c : ℤ) (p) (h₁ : b % a = c) (h₂ : (c = 0) = p) : (a ∣ b) = p :=
-(propext $ by rw [← h₁, int.dvd_iff_mod_eq_zero]).trans h₂
-
 theorem int_to_nat_pos (a : ℤ) (b : ℕ) (h : (by haveI := @nat.cast_coe ℤ; exact b : ℤ) = a) :
   a.to_nat = b := by rw ← h; simp
 theorem int_to_nat_neg (a : ℤ) (h : 0 < a) : (-a).to_nat = 0 :=
@@ -1241,30 +1197,14 @@ theorem nat_abs_neg (a : ℤ) (b : ℕ) (h : (by haveI := @nat.cast_coe ℤ; exa
 
 theorem neg_succ_of_nat (a b : ℕ) (c : ℤ) (h₁ : a + 1 = b)
   (h₂ : (by haveI := @nat.cast_coe ℤ; exact b : ℤ) = c) :
-  -[1+ a] = -c := by rw [← h₂, ← h₁, int.nat_cast_eq_coe_nat]; refl
+  -[1+ a] = -c := by rw [← h₂, ← h₁]; refl
 
-/-- Evaluates some extra numeric operations on `nat` and `int`, specifically
-`nat.succ`, `/` and `%`, and `∣` (divisibility). -/
-meta def eval_nat_int_ext : expr → tactic (expr × expr)
+/-- Evaluates `nat.succ`, `int.to_nat`, `int.nat_abs`, `int.neg_succ_of_nat`. -/
+meta def eval_nat_int : expr → tactic (expr × expr)
 | e@`(nat.succ _) := do
   ic ← mk_instance_cache `(ℕ),
   (_, _, ep) ← prove_nat_succ ic e,
   return ep
-| `(%%a / %%b) := do
-  c ← infer_type a >>= mk_instance_cache,
-  prod.snd <$> prove_div_mod c a b ff
-| `(%%a % %%b) := do
-  c ← infer_type a >>= mk_instance_cache,
-  prod.snd <$> prove_div_mod c a b tt
-| `(%%a ∣ %%b) := do
-  α ← infer_type a,
-  ic ← mk_instance_cache α,
-  th ← if α = `(nat) then return (`(dvd_eq_nat):expr) else
-       if α = `(int) then return `(dvd_eq_int) else failed,
-  (ic, c, p₁) ← prove_div_mod ic b a tt,
-  (ic, z) ← ic.mk_app ``has_zero.zero [],
-  (e', p₂) ← mk_app ``eq [c, z] >>= eval_ineq,
-  return (e', th.mk_app [a, b, c, e', p₁, p₂])
 | `(int.to_nat %%a) := do
   n ← a.to_int,
   ic ← mk_instance_cache `(ℤ),
@@ -1321,9 +1261,9 @@ meta def eval_cast : expr → tactic (expr × expr)
       (ic, b) ← ic.of_int n,
       (_, _, _, p) ← prove_int_uncast ic zc b,
       pure (b, p)
-    else if inst.app_arg.is_app_of ``int.cast_coe then do
+    else if inst.app_arg.is_app_of ``rat.cast_coe then do
       n ← a.to_rat,
-      cz_inst ← mk_mapp ``char_zero [α, none, none] >>= mk_instance,
+      cz_inst ← mk_mapp ``char_zero [α, none] >>= mk_instance,
       ic ← mk_instance_cache α,
       qc ← mk_instance_cache `(ℚ),
         (ic, b) ← ic.of_rat n,
@@ -1342,7 +1282,7 @@ meta def eval_cast : expr → tactic (expr × expr)
 
 /-- This version of `derive` does not fail when the input is already a numeral -/
 meta def derive.step (e : expr) : tactic (expr × expr) :=
-eval_field e <|> eval_pow e <|> eval_ineq e <|> eval_cast e <|> eval_nat_int_ext e
+eval_field e <|> eval_pow e <|> eval_ineq e <|> eval_cast e <|> eval_nat_int e
 
 /-- An attribute for adding additional extensions to `norm_num`. To use this attribute, put
 `@[norm_num]` on a tactic of type `expr → tactic (expr × expr)`; the tactic will be called on
@@ -1386,17 +1326,17 @@ additional reduction procedures. -/
 meta def get_step : tactic (expr → tactic (expr × expr)) := norm_num.attr.get_cache
 
 /-- Simplify an expression bottom-up using `step` to simplify the subexpressions. -/
-meta def derive' (step : expr → tactic (expr × expr))
-  : expr → tactic (expr × expr) | e :=
-do e ← instantiate_mvars e,
-   (_, e', pr) ←
-    ext_simplify_core () {} simp_lemmas.mk (λ _, failed) (λ _ _ _ _ _, failed)
-      (λ _ _ _ _ e,
-        do (new_e, pr) ← step e,
-           guard (¬ new_e =ₐ e),
-           return ((), new_e, some pr, tt))
-      `eq e,
-    return (e', pr)
+meta def derive' (step : expr → tactic (expr × expr)) : expr → tactic (expr × expr)
+| e := do
+  e ← instantiate_mvars e,
+  (_, e', pr) ← ext_simplify_core
+    () {} simp_lemmas.mk (λ _, failed) (λ _ _ _ _ _, failed)
+    (λ _ _ _ _ e, do
+      (new_e, pr) ← step e,
+      guard (¬ new_e =ₐ e),
+      pure ((), new_e, some pr, tt))
+    `eq e,
+  pure (e', pr)
 
 /-- Simplify an expression bottom-up using the default `norm_num` set to simplify the
 subexpressions. -/
@@ -1420,9 +1360,12 @@ use `get_step` to get the default `norm_num` set and `derive.step` for the basic
 simplifications. -/
 meta def tactic.norm_num (step : expr → tactic (expr × expr))
   (hs : list simp_arg_type) (l : interactive.loc) : tactic unit :=
-repeat1 $ orelse' (tactic.norm_num1 step l) $
-interactive.simp_core {} (tactic.norm_num1 step (interactive.loc.ns [none]))
-  ff (simp_arg_type.except ``one_div :: hs) [] l >> skip
+do
+  -- Build and discard the simp lemma set, to validate it.
+  mk_simp_set_core ff [] (simp_arg_type.except ``one_div :: hs) tt,
+  repeat1 $ orelse' (tactic.norm_num1 step l) $
+  interactive.simp_core {} (tactic.norm_num1 step (interactive.loc.ns [none]))
+    ff (simp_arg_type.except ``one_div :: hs) [] l >> skip
 
 /-- Carry out similar operations as `tactic.norm_num` but on an `expr` rather than a location.
 Given an expression `e`, returns `(e', ⊢ e = e')`.
@@ -1615,3 +1558,95 @@ add_tactic_doc
   tags                     := ["simplification", "arithmetic", "decision procedure"] }
 
 end tactic
+
+namespace norm_num
+section elementary_number_theory
+
+open tactic
+
+lemma nat_div (a b q r m : ℕ) (hm : q * b = m) (h : r + m = a) (h₂ : r < b) : a / b = q :=
+by rw [← h, ← hm, nat.add_mul_div_right _ _ (lt_of_le_of_lt (nat.zero_le _) h₂),
+       nat.div_eq_of_lt h₂, zero_add]
+
+lemma int_div (a b q r m : ℤ) (hm : q * b = m) (h : r + m = a) (h₁ : 0 ≤ r) (h₂ : r < b) :
+  a / b = q :=
+by rw [← h, ← hm, int.add_mul_div_right _ _ (ne_of_gt (lt_of_le_of_lt h₁ h₂)),
+       int.div_eq_zero_of_lt h₁ h₂, zero_add]
+
+lemma nat_mod (a b q r m : ℕ) (hm : q * b = m) (h : r + m = a) (h₂ : r < b) : a % b = r :=
+by rw [← h, ← hm, nat.add_mul_mod_self_right, nat.mod_eq_of_lt h₂]
+
+lemma int_mod (a b q r m : ℤ) (hm : q * b = m) (h : r + m = a) (h₁ : 0 ≤ r) (h₂ : r < b) :
+  a % b = r :=
+by rw [← h, ← hm, int.add_mul_mod_self, int.mod_eq_of_lt h₁ h₂]
+
+lemma int_div_neg (a b c' c : ℤ) (h : a / b = c') (h₂ : -c' = c) : a / -b = c :=
+h₂ ▸ h ▸ int.div_neg _ _
+
+lemma int_mod_neg (a b c : ℤ) (h : a % b = c) : a % -b = c :=
+(int.mod_neg _ _).trans h
+
+/-- Given `a`,`b` numerals in `nat` or `int`,
+  * `prove_div_mod ic a b ff` returns `(c, ⊢ a / b = c)`
+  * `prove_div_mod ic a b tt` returns `(c, ⊢ a % b = c)`
+-/
+meta def prove_div_mod (ic : instance_cache) :
+  expr → expr → bool → tactic (instance_cache × expr × expr)
+| a b mod :=
+  match match_neg b with
+  | some b := do
+    (ic, c', p) ← prove_div_mod a b mod,
+    if mod then
+      return (ic, c', `(int_mod_neg).mk_app [a, b, c', p])
+    else do
+      (ic, c, p₂) ← prove_neg ic c',
+      return (ic, c, `(int_div_neg).mk_app [a, b, c', c, p, p₂])
+  | none := do
+    nb ← b.to_nat,
+    na ← a.to_int,
+    let nq := na / nb,
+    let nr := na % nb,
+    let nm := nq * nr,
+    (ic, q) ← ic.of_int nq,
+    (ic, r) ← ic.of_int nr,
+    (ic, m, pm) ← prove_mul_rat ic q b nq nb,
+    (ic, a') ← ic.of_rat na, -- ensure `a` is in normal form
+    (ic, p) ← prove_add_rat ic r m a' nr nm na,
+    (ic, p') ← prove_lt_nat ic r b,
+    if ic.α = `(nat) then
+      if mod then return (ic, r, `(nat_mod).mk_app [a, b, q, r, m, pm, p, p'])
+      else        return (ic, q, `(nat_div).mk_app [a, b, q, r, m, pm, p, p'])
+    else if ic.α = `(int) then do
+      (ic, p₀) ← prove_nonneg ic r,
+      if mod then return (ic, r, `(int_mod).mk_app [a, b, q, r, m, pm, p, p₀, p'])
+      else        return (ic, q, `(int_div).mk_app [a, b, q, r, m, pm, p, p₀, p'])
+    else failed
+  end
+
+theorem dvd_eq_nat (a b c : ℕ) (p) (h₁ : b % a = c) (h₂ : (c = 0) = p) : (a ∣ b) = p :=
+(propext $ by rw [← h₁, nat.dvd_iff_mod_eq_zero]).trans h₂
+theorem dvd_eq_int (a b c : ℤ) (p) (h₁ : b % a = c) (h₂ : (c = 0) = p) : (a ∣ b) = p :=
+(propext $ by rw [← h₁, int.dvd_iff_mod_eq_zero]).trans h₂
+
+/-- Evaluates some extra numeric operations on `nat` and `int`, specifically
+`/` and `%`, and `∣` (divisibility). -/
+@[norm_num] meta def eval_nat_int_ext : expr → tactic (expr × expr)
+| `(%%a / %%b) := do
+  c ← infer_type a >>= mk_instance_cache,
+  prod.snd <$> prove_div_mod c a b ff
+| `(%%a % %%b) := do
+  c ← infer_type a >>= mk_instance_cache,
+  prod.snd <$> prove_div_mod c a b tt
+| `(%%a ∣ %%b) := do
+  α ← infer_type a,
+  ic ← mk_instance_cache α,
+  th ← if α = `(nat) then return (`(dvd_eq_nat):expr) else
+       if α = `(int) then return `(dvd_eq_int) else failed,
+  (ic, c, p₁) ← prove_div_mod ic b a tt,
+  (ic, z) ← ic.mk_app ``has_zero.zero [],
+  (e', p₂) ← mk_app ``eq [c, z] >>= eval_ineq,
+  return (e', th.mk_app [a, b, c, e', p₁, p₂])
+| _ := failed
+
+end elementary_number_theory
+end norm_num
diff --git a/src/tactic/norm_swap.lean b/src/tactic/norm_swap.lean
index f6d29ae9991f9..d6dd9aa727c7e 100644
--- a/src/tactic/norm_swap.lean
+++ b/src/tactic/norm_swap.lean
@@ -3,7 +3,7 @@ Copyright (c) 2021 Yakov Pechersky All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yakov Pechersky
 -/
-import logic.equiv.basic
+import logic.equiv.defs
 import tactic.norm_fin
 
 /-!
diff --git a/src/tactic/omega/clause.lean b/src/tactic/omega/clause.lean
index 19d00c572d840..96e6f9469eae7 100644
--- a/src/tactic/omega/clause.lean
+++ b/src/tactic/omega/clause.lean
@@ -8,6 +8,7 @@ Authors: Seul Baek
 Definition of linear constrain clauses.
 -/
 
+import data.list.basic
 import tactic.omega.term
 
 namespace omega
diff --git a/src/tactic/omega/coeffs.lean b/src/tactic/omega/coeffs.lean
index d4a5f10aab454..81fbe2f2848fc 100644
--- a/src/tactic/omega/coeffs.lean
+++ b/src/tactic/omega/coeffs.lean
@@ -111,10 +111,9 @@ lemma val_between_set {a : int} {l n : nat} :
 @[simp] lemma val_set {m : nat} {a : int} :
   val v ([] {m ↦ a}) = a * v m :=
 begin
-  apply val_between_set, apply zero_le,
-  apply lt_of_lt_of_le (lt_add_one _),
-  simp only [length_set, zero_add, le_max_right],
-  apply_instance,
+  apply val_between_set (zero_le _),
+  rw [length_set, zero_add],
+  exact lt_max_of_lt_right (lt_add_one _),
 end
 
 lemma val_between_neg {as : list int} {l : nat} :
diff --git a/src/tactic/omega/eq_elim.lean b/src/tactic/omega/eq_elim.lean
index 1197e348169b0..20bf778edbcfd 100644
--- a/src/tactic/omega/eq_elim.lean
+++ b/src/tactic/omega/eq_elim.lean
@@ -125,7 +125,7 @@ begin
       simp only [term.val, mul_add, add_mul, m, a_n],
       ring },
     cases h4 with c h4,
-    rw [dvd_add_iff_right (dvd_mul_right m c), h4, ← h1],
+    rw [←dvd_add_right (dvd_mul_right m c), h4, ← h1],
     apply dvd_zero },
   apply calc v n
       = -(m * sgm v b as n) + (symmod b m) +
@@ -197,7 +197,7 @@ begin
             apply fun_mono_2,
             { rw coeffs.val_except_eq_val_except
               update_eq_of_ne (get_set_eq_of_ne _) },
-            simp only [m], ring,
+            ring,
           end
   ... = -(m * a_n * sgm v b as n) + (b + a_n * (symmod b m))
         + coeffs.val_except n v (as.map (λ a_i, a_i + a_n * (symmod a_i m))) :
@@ -375,7 +375,7 @@ lemma sat_eq_elim :
       have h3 : 0 = b + coeffs.val v as := h1.left _ (or.inl rfl),
       have h4 : i ∣ coeffs.val v as     := coeffs.dvd_val h2.right,
       have h5 : i ∣ b + coeffs.val v as := by { rw ← h3, apply dvd_zero },
-      rw ← dvd_add_iff_left h4 at h5, apply h2.left h5 },
+      rw dvd_add_left h4 at h5, apply h2.left h5 },
     rw if_neg h2, apply sat_empty
   end
 | (ee.factor i::es) ((b,as)::eqs, les) h1 :=
diff --git a/src/tactic/omega/find_ees.lean b/src/tactic/omega/find_ees.lean
index 9529649b46846..83968c777d898 100644
--- a/src/tactic/omega/find_ees.lean
+++ b/src/tactic/omega/find_ees.lean
@@ -79,7 +79,7 @@ do x ← ((t1 >>= return ∘ some) <|> return none),
    | (some a) := t3 a
    end
 
-local notation t1 `!>>=` t2 `;` t3 := ee_commit t1 t2 t3
+local notation t1 ` !>>= ` t2 `; ` t3 := ee_commit t1 t2 t3
 
 private meta def of_tactic {α : Type} : tactic α → eqelim α := state_t.lift
 
@@ -126,8 +126,8 @@ do (i,n) ← find_min_coeff_core t.snd,
 meta def elim_eq : eqelim unit := do
 t ← head_eq,
 i ← get_gcd t,
-    factor i t !>>= (set_eqs [] >> add_ee (ee.nondiv i)) ;
-λ s, find_min_coeff s !>>= add_ee ee.drop ;
+    factor i t !>>= (set_eqs [] >> add_ee (ee.nondiv i));
+λ s, find_min_coeff s !>>= add_ee ee.drop;
 λ ⟨i, n, u⟩,
 if i = 1
 then do eqs ← get_eqs,
@@ -147,11 +147,11 @@ else let v : term := coeffs_reduce n u.fst u.snd in
 /-- Find and return the sequence of steps for eliminating
     all equality constraints in the current state. -/
 meta def elim_eqs : eqelim (list ee) :=
-elim_eq !>>= get_ees ; λ _, elim_eqs
+elim_eq !>>= get_ees; λ _, elim_eqs
 
 /-- Given a linear constrain clause, return a list of steps for eliminating its equality
 constraints. -/
 meta def find_ees : clause → tactic (list ee)
-| (eqs,les) := run eqs les elim_eqs
+| (eqs, les) := run eqs les elim_eqs
 
 end omega
diff --git a/src/tactic/omega/int/dnf.lean b/src/tactic/omega/int/dnf.lean
index 1c049030aa369..a9c88dda5c1a2 100644
--- a/src/tactic/omega/int/dnf.lean
+++ b/src/tactic/omega/int/dnf.lean
@@ -155,7 +155,7 @@ begin
       rw [list.forall_mem_singleton],
       simp only [val_canonize,
         preterm.val, term.val_sub],
-      rw [le_sub, sub_zero], assumption } },
+      rw [le_sub_comm, sub_zero], assumption } },
   { cases h1 },
   { cases h2 with h2 h2;
     [ {cases (ihp h1.left h2) with c h3},
diff --git a/src/tactic/omega/int/form.lean b/src/tactic/omega/int/form.lean
index 45ea52ad6b193..7f839dcb4438d 100644
--- a/src/tactic/omega/int/form.lean
+++ b/src/tactic/omega/int/form.lean
@@ -30,11 +30,11 @@ inductive preform
 | or  : preform → preform → preform
 | and : preform → preform → preform
 
-localized "notation x ` =* ` y := omega.int.preform.eq x y" in omega.int
-localized "notation x ` ≤* ` y := omega.int.preform.le x y" in omega.int
-localized "notation `¬* ` p   := omega.int.preform.not p" in omega.int
-localized "notation p ` ∨* ` q := omega.int.preform.or p q" in omega.int
-localized "notation p ` ∧* ` q := omega.int.preform.and p q" in omega.int
+localized "notation (name := preform.eq) x ` =* ` y := omega.int.preform.eq x y" in omega.int
+localized "notation (name := preform.le) x ` ≤* ` y := omega.int.preform.le x y" in omega.int
+localized "notation (name := preform.not) `¬* ` p   := omega.int.preform.not p" in omega.int
+localized "notation (name := preform.or) p ` ∨* ` q := omega.int.preform.or p q" in omega.int
+localized "notation (name := preform.and) p ` ∧* ` q := omega.int.preform.and p q" in omega.int
 
 namespace preform
 
diff --git a/src/tactic/omega/int/preterm.lean b/src/tactic/omega/int/preterm.lean
index 1f86ddf74e3f8..5d793e5325c99 100644
--- a/src/tactic/omega/int/preterm.lean
+++ b/src/tactic/omega/int/preterm.lean
@@ -32,9 +32,9 @@ inductive preterm : Type
 | var : int → nat → preterm
 | add : preterm → preterm → preterm
 
-localized "notation `&` k    := omega.int.preterm.cst k" in omega.int
-localized "infix ` ** ` : 300 := omega.int.preterm.var" in omega.int
-localized "notation t `+*` s := omega.int.preterm.add t s" in omega.int
+localized "notation (name := preterm.cst) `&` k := omega.int.preterm.cst k" in omega.int
+localized "infix (name := preterm.var) ` ** `:300 := omega.int.preterm.var" in omega.int
+localized "notation (name := preterm.add) t ` +* ` s := omega.int.preterm.add t s" in omega.int
 
 namespace preterm
 
diff --git a/src/tactic/omega/misc.lean b/src/tactic/omega/misc.lean
index b6ebe964c9c8a..2931b7282e1eb 100644
--- a/src/tactic/omega/misc.lean
+++ b/src/tactic/omega/misc.lean
@@ -31,7 +31,7 @@ lemma pred_mono_2' {c : Prop → Prop → Prop} {a1 a2 b1 b2 : Prop} :
 def update (m : nat) (a : α) (v : nat → α) : nat → α
 | n := if n = m then a else v n
 
-localized "notation v ` ⟨` m ` ↦ ` a `⟩` := omega.update m a v" in omega
+localized "notation (name := omega.update) v ` ⟨`m` ↦ `a`⟩` := omega.update m a v" in omega
 
 lemma update_eq (m : nat) (a : α) (v : nat → α) : (v ⟨m ↦ a⟩) m = a :=
 by simp only [update, if_pos rfl]
diff --git a/src/tactic/omega/nat/dnf.lean b/src/tactic/omega/nat/dnf.lean
index 95e2507509282..ce0ed703a089c 100644
--- a/src/tactic/omega/nat/dnf.lean
+++ b/src/tactic/omega/nat/dnf.lean
@@ -43,7 +43,7 @@ begin
     rw list.forall_mem_singleton,
     simp only [val_canonize (h0.left), val_canonize (h0.right),
       term.val_sub, preform.holds, sub_eq_add_neg] at *,
-    rw [←sub_eq_add_neg, le_sub, sub_zero, int.coe_nat_le],
+    rw [←sub_eq_add_neg, le_sub_comm, sub_zero, int.coe_nat_le],
     assumption },
   { cases h1 },
   { cases h2 with h2 h2;
diff --git a/src/tactic/omega/nat/form.lean b/src/tactic/omega/nat/form.lean
index 9c08991fe0c51..cd4bfb5b6e4f6 100644
--- a/src/tactic/omega/nat/form.lean
+++ b/src/tactic/omega/nat/form.lean
@@ -31,11 +31,11 @@ inductive preform
 | or  : preform → preform → preform
 | and : preform → preform → preform
 
-localized "notation x ` =* ` y := omega.nat.preform.eq x y" in omega.nat
-localized "notation x ` ≤* ` y := omega.nat.preform.le x y" in omega.nat
-localized "notation `¬* ` p    := omega.nat.preform.not p" in omega.nat
-localized "notation p ` ∨* ` q := omega.nat.preform.or p q" in omega.nat
-localized "notation p ` ∧* ` q := omega.nat.preform.and p q" in omega.nat
+localized "notation (name := preform.eq) x ` =* ` y := omega.nat.preform.eq x y" in omega.nat
+localized "notation (name := preform.le) x ` ≤* ` y := omega.nat.preform.le x y" in omega.nat
+localized "notation (name := preform.not) `¬* ` p    := omega.nat.preform.not p" in omega.nat
+localized "notation (name := preform.or) p ` ∨* ` q := omega.nat.preform.or p q" in omega.nat
+localized "notation (name := preform.and) p ` ∧* ` q := omega.nat.preform.and p q" in omega.nat
 
 namespace preform
 
diff --git a/src/tactic/omega/nat/preterm.lean b/src/tactic/omega/nat/preterm.lean
index 2343c6361aded..b55af2eb58577 100644
--- a/src/tactic/omega/nat/preterm.lean
+++ b/src/tactic/omega/nat/preterm.lean
@@ -36,10 +36,10 @@ inductive preterm : Type
 | add : preterm → preterm → preterm
 | sub : preterm → preterm → preterm
 
-localized "notation `&` k := omega.nat.preterm.cst k" in omega.nat
-localized "infix ` ** ` : 300 := omega.nat.preterm.var" in omega.nat
-localized "notation t ` +* ` s := omega.nat.preterm.add t s" in omega.nat
-localized "notation t ` -* ` s := omega.nat.preterm.sub t s" in omega.nat
+localized "notation (name := preterm.cst) `&` k := omega.nat.preterm.cst k" in omega.nat
+localized "infix (name := preterm.var) ` ** `:300 := omega.nat.preterm.var" in omega.nat
+localized "notation (name := preterm.add) t ` +* ` s := omega.nat.preterm.add t s" in omega.nat
+localized "notation (name := preterm.sub) t ` -* ` s := omega.nat.preterm.sub t s" in omega.nat
 
 namespace preterm
 
diff --git a/src/tactic/omega/prove_unsats.lean b/src/tactic/omega/prove_unsats.lean
index 94233a94f6cf7..ca25905d42176 100644
--- a/src/tactic/omega/prove_unsats.lean
+++ b/src/tactic/omega/prove_unsats.lean
@@ -22,13 +22,13 @@ meta def prove_neg : int → tactic expr
 | (int.of_nat _) := failed
 | -[1+ m] := return `(int.neg_succ_lt_zero %%`(m))
 
-lemma forall_mem_repeat_zero_eq_zero (m : nat) :
-  (∀ x ∈ (list.repeat (0 : int) m), x = (0 : int)) :=
-λ x, list.eq_of_mem_repeat
+lemma forall_mem_replicate_zero_eq_zero (m : nat) :
+  (∀ x ∈ (list.replicate m (0 : int)), x = (0 : int)) :=
+λ x, list.eq_of_mem_replicate
 
-/-- Return expr of proof that elements of (repeat 0 is.length) are all 0 -/
+/-- Return expr of proof that elements of (replicate is.length 0) are all 0 -/
 meta def prove_forall_mem_eq_zero (is : list int) : tactic expr :=
-return `(forall_mem_repeat_zero_eq_zero is.length)
+return `(forall_mem_replicate_zero_eq_zero is.length)
 
 /-- Return expr of proof that the combination of linear constraints
     represented by ks and ts is unsatisfiable -/
diff --git a/src/tactic/omega/term.lean b/src/tactic/omega/term.lean
index 3362b50a80f17..8b48371ce4446 100644
--- a/src/tactic/omega/term.lean
+++ b/src/tactic/omega/term.lean
@@ -18,6 +18,8 @@ namespace omega
 @[derive inhabited]
 def term : Type := int × list int
 
+meta instance : has_reflect term := prod.has_reflect _ _
+
 namespace term
 
 /-- Evaluate a term using the valuation v. -/
diff --git a/src/tactic/polyrith.lean b/src/tactic/polyrith.lean
new file mode 100644
index 0000000000000..17c6ad9872e9c
--- /dev/null
+++ b/src/tactic/polyrith.lean
@@ -0,0 +1,600 @@
+/-
+Copyright (c) 2022 Dhruv Bhatia. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Dhruv Bhatia, Eric Wieser
+-/
+import tactic.linear_combination
+import data.buffer.parser.numeral
+import data.json
+
+/-!
+
+# polyrith Tactic
+
+In this file, the `polyrith` tactic is created.  This tactic, which
+works over `field`s, attempts to prove a multivariate polynomial target over said
+field by using multivariable polynomial hypotheses/proof terms over the same field.
+Used as is, the tactic makes use of those hypotheses in the local context that are
+over the same field as the target. However, the user can also specifiy which hypotheses
+from the local context to use, along with proof terms that might not already be in the
+local context. Note: since this tactic uses SageMath via an API call done in Python,
+it can only be used with a working internet connection, and with a local installation of Python.
+
+## Implementation Notes
+
+The tactic `linear_combination` is often used to prove such goals by allowing the user to
+specify a coefficient for each hypothesis. If the target polynomial can be written as a
+linear combination of the hypotheses with the chosen coefficients, then the `linear_combination`
+tactic succeeds. In other words, `linear_combination` is a certificate checker, and it is left
+to the user to find a collection of good coefficients. The `polyrith` tactic automates this
+process using the theory of Groebner bases.
+
+Polyrith does this by first parsing the relevant hypotheses into a form that Python can understand.
+It then calls a Python file that uses the SageMath API to compute the coefficients. These
+coefficients are then sent back to Lean, which parses them into pexprs. The information is then
+given to the `linear_combination` tactic, which completes the process by checking the certificate.
+
+`polyrith` calls an external python script `scripts/polyrith_sage.py`. Because this is not a Lean
+file, changes to this script may not be noticed during Lean compilation if you have already
+generated olean files. If you are modifying this python script, you likely know what you're doing;
+remember to force recompilation of any files that call `polyrith`.
+
+## TODO
+
+* Give Sage more information about the specific ring being used for the coefficients. For now,
+  we always use ℚ (or `QQ` in Sage).
+* Handle `•` terms.
+* Support local Sage installations.
+
+## References
+
+* See the book [*Ideals, Varieties, and Algorithms*][coxlittleOshea1997] by David Cox, John Little,
+  and Donal O'Shea for the background theory on Groebner bases
+* This code was heavily inspired by the code for the tactic `linarith`, which was written by
+  Robert Lewis, who advised me on this project as part of a Computer Science independant study
+  at Brown University.
+
+-/
+
+open tactic native
+
+namespace polyrith
+
+/-! # Poly Datatype -/
+
+/--
+A datatype representing the semantics of multivariable polynomials.
+Each `poly` can be converted into a string.
+-/
+@[derive decidable_eq]
+inductive poly
+| const : ℚ → poly
+| var : ℕ → poly
+| add : poly → poly → poly
+| sub : poly → poly → poly
+| mul : poly → poly → poly
+| pow : poly → ℕ → poly
+| neg : poly → poly
+
+/--
+This converts a poly object into a string representing it. The string
+maintains the semantic structure of the poly object.
+
+The output of this function must be valid Python syntax, and it assumes the variables `varN` from
+`scripts/polyrith.py.`
+-/
+meta def poly.mk_string : poly → string
+| (poly.const z) := to_string z
+| (poly.var n) := "var" ++ to_string n
+| (poly.add p q) := "(" ++ poly.mk_string p ++ " + " ++ poly.mk_string q ++ ")"
+| (poly.sub p q) := "(" ++ poly.mk_string p ++ " - " ++ poly.mk_string q ++ ")"
+| (poly.mul p q) := "(" ++ poly.mk_string p ++ " * " ++ poly.mk_string q ++ ")"
+| (poly.pow p n) := to_string $ format!"({poly.mk_string p} ^ {n})"
+| (poly.neg p) := ("-" ++ poly.mk_string p)
+
+meta instance : has_add poly := ⟨poly.add⟩
+meta instance : has_sub poly := ⟨poly.sub⟩
+meta instance : has_mul poly := ⟨poly.mul⟩
+meta instance : has_pow poly ℕ := ⟨poly.pow⟩
+meta instance : has_neg poly := ⟨poly.neg⟩
+meta instance : has_repr poly := ⟨poly.mk_string⟩
+meta instance : has_to_format poly := ⟨to_fmt ∘ poly.mk_string⟩
+meta instance : inhabited poly := ⟨poly.const 0⟩
+
+
+/-!
+# Parsing algorithms
+
+The following section contains code that can convert an `expr` of type `Prop` into a `poly` object
+(provided that it is an equality)
+-/
+
+/--
+`(vars, p) ← poly_form_of_atom red vars e` is the atomic case for `poly_form_of_expr`.
+If `e` appears with index `k` in `vars`, it returns the singleton sum `p = poly.var k`.
+Otherwise it updates `vars`, adding `e` with index `n`, and returns the singleton `p = poly.var n`.
+-/
+meta def poly_form_of_atom (red : transparency) (vars : list expr) (e : expr) :
+  tactic (list expr × poly) :=
+do
+  index_of_e ← vars.mfoldl_with_index
+    (λ n last e', match last with
+    | none := tactic.try_core $ tactic.is_def_eq e e' red >> return n
+    | some k := return k
+    end) none,
+  return (match index_of_e with
+  | some k := (vars, poly.var k)
+  | none   := (vars.concat e, poly.var vars.length)
+  end)
+
+/--
+`poly_form_of_expr red map e` computes the polynomial form of `e`.
+
+`map` is a lookup map from atomic expressions to variable numbers.
+If a new atomic expression is encountered, it is added to the map with a new number.
+It matches atomic expressions up to reducibility given by `red`.
+
+Because it matches up to definitional equality, this function must be in the `tactic` monad,
+and forces some functions that call it into `tactic` as well.
+-/
+meta def poly_form_of_expr (red : transparency) : list expr → expr → tactic (list expr × poly)
+| m `(%%e1 * %%e2) :=
+   do (m', comp1) ← poly_form_of_expr m e1,
+      (m', comp2) ← poly_form_of_expr m' e2,
+      return (m', comp1 * comp2)
+| m `(%%e1 + %%e2) :=
+   do (m', comp1) ← poly_form_of_expr m e1,
+      (m', comp2) ← poly_form_of_expr m' e2,
+      return (m', comp1 + comp2)
+| m `(%%e1 - %%e2) :=
+   do (m', comp1) ← poly_form_of_expr m e1,
+      (m', comp2) ← poly_form_of_expr m' e2,
+      return (m',  comp1 - comp2)
+| m `(-%%e) :=
+  do (m', comp) ← poly_form_of_expr m e,
+     return (m', - comp)
+| m p@`(@has_pow.pow _ ℕ _ %%e %%n) :=
+  match n.to_nat with
+  | some k :=
+    do (m', comp) ← poly_form_of_expr m e,
+    return (m', comp^k)
+  | none := poly_form_of_atom red m p
+  end
+| m e :=
+  match e.to_rat with
+  | some z := return ⟨m, poly.const z⟩
+  | none := poly_form_of_atom red m e
+  end
+
+
+/-!
+# Un-Parsing algorithms
+
+The following section contains code that can convert an a `poly` object into a `pexpr`.
+-/
+
+
+/--
+This can convert a `poly` into a `pexpr` that would evaluate to a polynomial.
+To do so, it uses a list `m` of expressions, the atomic expressions that appear in the `poly`.
+The index of an expression in this list corresponds to its `poly.var` argument: that is,
+if `e` is the `k`th element of `m`, then it is represented as `poly.var k`.
+
+`poly` objects only contain coefficients from `ℚ`. However, the `poly` object might
+be referring to a polynomial over some other field. As such, the resulting `pexpr` contains
+no typing information.
+-/
+meta def poly.to_pexpr : list expr → poly → tactic pexpr
+| _ (poly.const z) := return z.to_pexpr
+| m (poly.var n) :=
+  do
+    some (e) ← return $ m.nth n | fail! "unknown variable poly.var {n}",
+    return ``(%%e)
+| m (poly.add p q) :=
+  do
+    p_pexpr ← poly.to_pexpr m p,
+    q_pexpr ← poly.to_pexpr m q,
+    return ``(%%p_pexpr + %%q_pexpr)
+| m (poly.sub p q) :=
+  do
+    p_pexpr ← poly.to_pexpr m p,
+    q_pexpr ← poly.to_pexpr m q,
+    if p_pexpr = ``(0) then return ``(- %%q_pexpr) else
+    return ``(%%p_pexpr - %%q_pexpr)
+| m (poly.mul p q) :=
+  do
+    p_pexpr ← poly.to_pexpr m p,
+    q_pexpr ← poly.to_pexpr m q,
+    return ``(%%p_pexpr * %%q_pexpr)
+| m (poly.pow p n) :=
+  do
+    p_pexpr ← poly.to_pexpr m p,
+    return ``(%%p_pexpr ^ %%n.to_pexpr)
+| m (poly.neg p) :=
+  do
+    p_pexpr ← poly.to_pexpr m p,
+    return ``(- %%p_pexpr)
+
+/-!
+# Parsing SageMath output into a poly
+
+The following section contains code that can convert a string of appropriate format into
+a `poly` object. This is used later on to convert the coefficients given by Sage into
+`poly` objects.
+-/
+
+open parser
+
+/--
+A parser object that parses `string`s of the form `"poly.var n"`
+to the appropriate `poly` object representing a variable.
+Here, `n` is a natural number
+-/
+meta def var_parser : parser poly := do
+str "poly.var " >> poly.var <$> parser.nat
+
+/--
+A parser object that parses `string`s of the form `"poly.const r"`
+to the appropriate `poly` object representing a rational coefficient.
+Here, `r` is a rational number
+-/
+meta def const_fraction_parser : parser poly :=
+str "poly.const " >> poly.const <$> parser.rat
+
+/--
+A parser object that parses `string`s of the form `"poly.add p q"`
+to the appropriate `poly` object representing the sum of two `poly`s.
+Here, `p` and `q` are themselves string forms of `poly`s.
+-/
+meta def add_parser (cont : parser poly) : parser poly :=
+str "poly.add " >> poly.add <$> cont <*> (ch ' ' >> cont)
+
+/--
+A parser object that parses `string`s of the form `"poly.sub p q"`
+to the appropriate `poly` object representing the subtraction of two `poly`s.
+Here, `p` and `q` are themselves string forms of `poly`s.
+-/
+meta def sub_parser (cont : parser poly) : parser poly :=
+str "poly.sub " >> poly.sub <$> cont <*> (ch ' ' >> cont)
+
+/--
+A parser object that parses `string`s of the form `"poly.mul p q"`
+to the appropriate `poly` object representing the product of two `poly`s.
+Here, `p` and `q` are themselves string forms of `poly`s.
+-/
+meta def mul_parser (cont : parser poly) : parser poly :=
+str "poly.mul " >> poly.mul <$> cont <*> (ch ' ' >> cont)
+
+/--
+A parser object that parses `string`s of the form `"poly.pow p n"`
+to the appropriate `poly` object representing a `poly` raised to the
+power of a natural number. Here, `p` is the string form of a `poly`
+and `n` is a natural number.
+-/
+meta def pow_parser (cont : parser poly) : parser poly :=
+str "poly.pow " >> poly.pow <$> cont <*> (ch ' ' >> nat)
+
+/--
+A parser object that parses `string`s of the form `"poly.neg p"`
+to the appropriate `poly` object representing the negation of a `poly`.
+Here, `p` is the string form of a `poly`.
+-/
+meta def neg_parser (cont : parser poly) : parser poly :=
+str "poly.neg " >> poly.neg <$> cont
+
+/-- A parser for `poly` that uses an s-essresion style formats such as
+`(poly.add (poly.var 0) (poly.const 1)`. -/
+meta def poly_parser : parser poly :=
+ch '('
+  *> (var_parser <|> const_fraction_parser <|> add_parser poly_parser
+    <|> sub_parser poly_parser <|> mul_parser poly_parser <|> pow_parser poly_parser
+    <|> neg_parser poly_parser)
+  <* ch ')'
+
+meta instance : non_null_json_serializable poly :=
+{ to_json := λ p, json.null,  -- we don't actually need this, but the typeclass asks for it
+  of_json := λ j, do
+    s ← of_json string j,
+    match poly_parser.run_string s with
+    | sum.inl s := exceptional.fail format!"unable to parse polynomial from.\n\n{s}"
+    | sum.inr p := pure p
+    end}
+
+/-- A schema for success messages from the python script -/
+@[derive [non_null_json_serializable, inhabited]]
+structure sage_json_success :=
+(success : {b : bool // b = tt})
+(trace : option string := none)
+(data : option (list poly) := none)
+
+/-- A schema for failure messages from the python script -/
+@[derive [non_null_json_serializable, inhabited]]
+structure sage_json_failure :=
+(success : {b : bool // b = ff})
+(error_name : string)
+(error_value : string)
+
+/-- Parse the json output from `scripts/polyrith.py` into either an error message, a list of `poly`
+objects, or `none` if only trace output was requested. -/
+meta def convert_sage_output (j : json) : tactic (option (list poly)) :=
+do
+  r : sage_json_success ⊕ sage_json_failure ← decorate_ex "internal json error: "
+    -- try the error format first, so that if both fail we get the message from the success parser
+    (sum.inr <$> of_json sage_json_failure j <|> sum.inl <$> of_json sage_json_success j),
+  match r with
+  | sum.inr f :=
+      fail!"polyrith failed to retrieve a solution from Sage! {f.error_name}: {f.error_value}"
+  | sum.inl s := do
+      s.trace.mmap trace,
+      pure s.data
+  end
+
+/-!
+# Parsing context into poly
+
+The following section contains code that collects hypotheses of the appropriate type
+from the context (and from the list of hypotheses and proof terms specified by the user)
+and converts them into `poly` objects.
+-/
+
+/-- Convert an expression of the form `lhs = rhs` into the form `lhs - rhs` -/
+meta def equality_to_left_side : expr → tactic expr
+| `(%%lhs = %%rhs) := to_expr ``(%%lhs - %%rhs)
+| e := fail "expression is not an equality"
+
+/-- `(vars, poly, typ) ← parse_target_to_poly` interprets the current target (an equality over
+some field) into a `poly`. The result is a list of the atomic expressions in the target,
+the `poly` itself, and an `expr` representing the type of the field. -/
+meta def parse_target_to_poly : tactic (list expr × poly × expr) :=
+do
+  e@`(@eq %%R _ _) ← target,
+  left_side ← equality_to_left_side e,
+  (m, p) ← poly_form_of_expr transparency.reducible [] left_side,
+  return (m, p, R)
+
+/-- Filter `l` to the elements which are equalities of type `expt`. -/
+meta def get_equalities_of_type (expt : expr) (l : list expr) : tactic (list expr) :=
+l.mfilter $ λ h_eq, succeeds $ do
+  `(@eq %%R _ _) ← infer_type h_eq,
+  unify expt R
+
+/--
+The purpose of this tactic is to collect all the hypotheses
+and proof terms (specified by the user) that are equalities
+of the same type as the target. It takes in an `expr` representing
+the type, a list of expressions representing the atoms
+(typically this starts as only containing
+information about the target), a `bool` representing whether the
+user used the key word "only", and a `list pexpr` of all the
+hypotheses and proof terms selected by the user.
+
+If the key word "only" is used, it collects together only those
+hypotheses/proof terms selected by the user. If not, they are
+combined with hypotheses from the local context. We throw out
+those hypotheses that are not equalities of the given type,
+and then modify each equality such that everything has been
+moved to the left of the "=" sign.
+
+The tactic returns the names of these hypotheses (as `expr`s),
+a list of atoms updated with information from all these hypotheses,
+and a list of these hypotheses converted into `poly` objects.
+-/
+meta def parse_ctx_to_polys (expt : expr) (m : list expr) (only_on : bool) (hyps : list pexpr) :
+  tactic (list expr × list expr × list poly) :=
+do
+  hyps ← hyps.mmap i_to_expr,
+  hyps ← if only_on then return hyps else (++ hyps) <$> local_context,
+  eq_names ← get_equalities_of_type expt hyps,
+  eqs ← eq_names.mmap infer_type,
+  eqs_to_left ← eqs.mmap equality_to_left_side,
+  -- convert the expressions to polynomials, tracking the variables in `m`
+  (m, poly_list) ← eqs_to_left.mfoldl (λ (s : _ × list poly) new_exp, do
+    { let (m, poly_list) := s,
+      (m', new_poly) ← poly_form_of_expr transparency.reducible m new_exp,
+      return (m', poly_list ++ [new_poly]) })
+    (m, []),
+  return (eq_names, m, poly_list)
+
+/-!
+# Connecting with Python
+
+The following section contains code that allows lean to communicate with a python script.
+-/
+
+/--
+This tactic calls python from the command line with the args in `arg_list`.
+The output printed to the console is returned as a `string`.
+It assumes that `python3` is available on the path.
+-/
+meta def sage_output (arg_list : list string := []) : tactic json :=
+do
+  path ← get_mathlib_dir,
+  let args := [path ++ "../scripts/polyrith_sage.py"] ++ arg_list,
+  s ← unsafe_run_io $ io.cmd { cmd := "python3", args := args},
+  some j ← pure (json.parse s) | fail!"Invalid json: {s}",
+  pure j
+
+/--
+Adds parentheses around additions and subtractions, for printing at
+precedence 65.
+-/
+meta def add_parens : expr → tactic format
+| e@`(_ + _) := pformat!"({e})"
+| e@`(_ - _) := pformat!"({e})"
+| e := pformat!"{e}"
+
+/--
+Given a pair of `expr`s, where one represents the hypothesis/proof term,
+and the other representes the coefficient attached to it, this tactic
+creates a string combining the two in the appropriate format for
+`linear_combination`.
+
+The boolean value returned is `tt` if the format needs to be negated
+to accurately reflect the input expressions.
+The negation is not applied in the format output by this function,
+because it may appear as a negation (if this is the first component)
+or a subtraction.
+-/
+meta def component_to_lc_format : expr × expr → tactic (bool × format)
+| (ex, `(@has_one.one _ _))  := prod.mk ff <$> pformat!"{ex}"
+| (ex, `(@has_one.one _ _ / %%cf))  := do f ← add_parens cf, prod.mk ff <$> pformat!"{ex} / {f}"
+| (ex, `(-%%cf)) := do (neg, fmt) ← component_to_lc_format (ex, cf), return (!neg, fmt)
+| (ex, cf) := do f ← add_parens cf, prod.mk ff <$> pformat!"{f} * {ex}"
+
+private meta def intersperse_ops_aux : list (bool × format) → format
+| [] := ""
+| ((ff, fmt) :: t) := " +" ++ format.soft_break ++ fmt ++ intersperse_ops_aux t
+| ((tt, fmt) :: t) := " -" ++ format.soft_break ++ fmt ++ intersperse_ops_aux t
+
+/--
+Given a `list (bool × format)`, this function uses `+` and `-` to conjoin the
+`format`s in the list. A `format` is negated if its corresponding `bool` is `tt`.
+-/
+meta def intersperse_ops : list (bool × format) → format
+| [] := ""
+| ((ff, fmt)::t) := fmt ++ intersperse_ops_aux t
+| ((tt, fmt)::t) := "-" ++ fmt ++ intersperse_ops_aux t
+
+/-- This tactic repeats the process above for a `list` of pairs of `expr`s.-/
+meta def components_to_lc_format (components : list (expr × expr)) : tactic format :=
+intersperse_ops <$> components.mmap component_to_lc_format
+
+/-!
+# Connecting with Python
+
+The following section contains code that allows lean to communicate with a python script.
+-/
+
+declare_trace polyrith
+
+/--
+The first half of `tactic.polyrith` produces a list of arguments to be sent to Sage.
+-/
+meta def create_args (only_on : bool) (hyps : list pexpr) :
+  tactic (list expr × list expr × expr × list string) := do
+  (m, p, R) ← parse_target_to_poly,
+  (eq_names, m, polys) ← parse_ctx_to_polys R m only_on hyps,
+  let args := [to_string R, to_string m.length,
+    (polys.map poly.mk_string).to_string, p.mk_string],
+  return $ (eq_names, m, R, to_string (is_trace_enabled_for `polyrith) :: args)
+
+/--
+The second half of `tactic.polyrith` processes the output from Sage into
+a call to `linear_combination`.
+-/
+meta def process_output (eq_names : list expr) (m : list expr) (R : expr) (sage_out : json) :
+  tactic format := focus1 $ do
+  some coeffs_as_poly ← convert_sage_output sage_out | fail!"internal error: No output available",
+  coeffs_as_pexpr ← coeffs_as_poly.mmap (poly.to_pexpr m),
+  let eq_names_pexpr := eq_names.map to_pexpr,
+  coeffs_as_expr ← coeffs_as_pexpr.mmap $ λ e, to_expr ``(%%e : %%R),
+  linear_combo.linear_combination eq_names_pexpr coeffs_as_pexpr,
+  let components := (eq_names.zip coeffs_as_expr).filter
+    $ λ pr, bnot $ pr.2.is_app_of `has_zero.zero,
+  expr_string ← components_to_lc_format components,
+  let lc_fmt : format := "linear_combination " ++ format.nest 2 (format.group expr_string),
+  done <|>
+    fail!"polyrith found the following certificate, but it failed to close the goal:\n{lc_fmt}",
+  return $ "linear_combination " ++ format.nest 2 (format.group expr_string)
+
+/-- Tactic for the special case when no hypotheses are available. -/
+meta def no_hypotheses_case : tactic (option format) :=
+(do `[ring], return $ some "ring") <|>
+  fail "polyrith did not find any relevant hypotheses and the goal is not provable by ring"
+
+/-- Tactic for the special case when there are no variables. -/
+meta def no_variables_case : tactic (option format) :=
+(do `[ring], return $ some "ring") <|>
+  fail "polyrith did not find any variables and the goal is not provable by ring"
+
+/--
+This is the main body of the `polyrith` tactic. It takes in the following inputs:
+* `(only_on : bool)` - This represents whether the user used the key word "only"
+* `(hyps : list pexpr)` - the hypotheses/proof terms selecteed by the user
+
+First, the tactic converts the target into a `poly`, and finds out what type it
+is an equality of. (It also fills up a list of `expr`s with its atoms). Then, it
+collects all the relevant hypotheses/proof terms from the context, and from those
+selected by the user, taking into account whether `only_on` is true. (The list of atoms is
+updated accordingly as well).
+
+This information is used to create a list of args that get used in a call to
+the appropriate python file that executes a grobner basis computation. The
+output of this computation is a `string` representing the certificate. This
+string is parsed into a list of `poly` objects that are then converted into
+`pexpr`s (using the updated list of atoms).
+
+the names of the hypotheses, along with the corresponding coefficients are
+given to `linear_combination`. If that tactic succeeds, the user is prompted
+to replace the call to `polyrith` with the appropriate call to
+`linear_combination`.
+
+This returns `none` if this was a "dry run" attempt that does not actually invoke sage.
+-/
+meta def _root_.tactic.polyrith (only_on : bool) (hyps : list pexpr) : tactic (option format) :=
+do
+  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
+  (eq_names, m, R, args) ← create_args only_on hyps,
+  if eq_names.length = 0 then no_hypotheses_case else
+  if m.length = 0 then no_variables_case else do
+  sage_out ← sage_output args,
+  if is_trace_enabled_for `polyrith then do
+    convert_sage_output sage_out,
+    return none
+  else some <$> process_output eq_names m R sage_out
+
+/-! # Interactivity -/
+setup_tactic_parser
+
+/--
+Attempts to prove polynomial equality goals through polynomial arithmetic
+on the hypotheses (and additional proof terms if the user specifies them).
+It proves the goal by generating an appropriate call to the tactic
+`linear_combination`. If this call succeeds, the call to `linear_combination`
+is suggested to the user.
+
+* `polyrith` will use all relevant hypotheses in the local context.
+* `polyrith [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.
+* `polyrith only [h1, h2, h3, t1, t2, t3]` will use only local hypotheses
+  `h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.
+
+Notes:
+* This tactic only works with a working internet connection, since it calls Sage
+  using the SageCell web API at .
+  Many thanks to the Sage team and organization for allowing this use.
+* This tactic assumes that the user has `python3` installed and available on the path.
+  (Test by opening a terminal and executing `python3 --version`.)
+  It also assumes that the `requests` library is installed: `python3 -m pip install requests`.
+
+Examples:
+
+```lean
+example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
+  x*y = -2*y + 1 :=
+by polyrith
+-- Try this: linear_combination h1 - 2 * h2
+
+example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
+by polyrith
+-- Try this: linear_combination (2 * y + x) * hzw
+
+constant scary : ∀ a b : ℚ, a + b = 0
+
+example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0) : a + b + c + d = 0 :=
+by polyrith only [scary c d, h]
+-- Try this: linear_combination scary c d + h
+```
+-/
+meta def _root_.tactic.interactive.polyrith (restr : parse (tk "only")?)
+  (hyps : parse pexpr_list?) : tactic unit :=
+do
+  some f ← tactic.polyrith restr.is_some (hyps.get_or_else []) | skip,
+  trace!"Try this: {f}"
+
+add_tactic_doc
+{ name := "polyrith",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.polyrith],
+  tags := ["arithmetic", "finishing", "decision procedure"] }
+
+end polyrith
diff --git a/src/tactic/positivity.lean b/src/tactic/positivity.lean
new file mode 100644
index 0000000000000..bec4bfd4a8cb8
--- /dev/null
+++ b/src/tactic/positivity.lean
@@ -0,0 +1,775 @@
+/-
+Copyright (c) 2022 Mario Carneiro, Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Mario Carneiro, Heather Macbeth, Yaël Dillies
+-/
+import tactic.norm_num
+import algebra.order.field.power
+import algebra.order.hom.basic
+import data.nat.factorial.basic
+
+/-! # `positivity` tactic
+
+The `positivity` tactic in this file solves goals of the form `0 ≤ x`, `0 < x` and `x ≠ 0`.  The
+tactic works recursively according to the syntax of the expression `x`.  For example, a goal of the
+form `0 ≤ 3 * a ^ 2 + b * c` can be solved either
+* by a hypothesis such as `5 ≤ 3 * a ^ 2 + b * c` which directly implies the nonegativity of
+  `3 * a ^ 2 + b * c`; or,
+* by the application of the lemma `add_nonneg` and the success of the `positivity` tactic on the two
+  sub-expressions `3 * a ^ 2` and `b * c`.
+
+For each supported operation, one must write a small tactic, tagged with the attribute
+`@[positivity]`, which operates only on goals whose leading function application is that operation.
+Typically, this small tactic will run the full `positivity` tactic on one or more of the function's
+arguments (which is where the recursion comes in), and if successful will combine this with an
+appropriate lemma to give positivity of the full expression.
+
+This file contains the core `positivity` logic and the small tactics handling the basic operations:
+`min`, `max`, `+`, `*`, `/`, `⁻¹`, raising to natural powers, and taking absolute values.  Further
+extensions, e.g. to handle `real.sqrt` and norms, can be found in the files of the library which
+introduce these operations.
+
+## Main declarations
+
+* `tactic.norm_num.positivity` tries to prove positivity of an expression by running `norm_num` on
+  it.  This is one of the base cases of the recursion.
+* `tactic.positivity.compare_hyp` tries to prove positivity of an expression by comparing with a
+  provided hypothesis.  If the hypothesis is of the form `a ≤ b` or similar, with `b` matching the
+  expression whose proof of positivity is desired, then it will check whether `a` can be proved
+  positive via `tactic.norm_num.positivity` and if so apply a transitivity lemma.  This is the other
+  base case of the recursion.
+* `tactic.positivity.attr` creates the `positivity` user attribute for tagging the extension
+  tactics handling specific operations, and specifies the behaviour for a single step of the
+  recursion
+* `tactic.positivity.core` collects the list of tactics with the `@[positivity]` attribute and
+  calls the first recursion step as specified in `tactic.positivity.attr`.  Its input is `e : expr`
+  and its output (if it succeeds) is a term of a custom inductive type
+  `tactic.positivity.strictness`, containing an `expr` which is a proof of the
+  strict-positivity/nonnegativity of `e` as well as an indication of whether what could be proved
+  was strict-positivity or nonnegativity
+* `tactic.positivity.order_rel` is a custom inductive type recording whether the goal is
+  `0 ≤ e`/`e ≥ 0`, `0 < e`/`e > 0`, `e ≠ 0` or `0 ≠ e`.
+* `tactic.interactive.positivity` is the user-facing tactic.  It parses the goal and, if it is of
+  one of the forms `0 ≤ e`, `0 < e`, `e > 0`, `e ≥ 0`, `e ≠ 0`, `0 ≠ e`, it sends `e` to
+  `tactic.positivity.core`.
+
+## TODO
+
+Implement extensions for other operations (raising to non-numeral powers, `log`).
+-/
+
+namespace tactic
+
+/-- Inductive type recording either `positive` and an expression (typically a proof of a fact
+`0 < x`) or `nonnegative` and an expression (typically a proof of a fact `0 ≤ x`). -/
+@[derive [decidable_eq]]
+meta inductive positivity.strictness : Type
+| positive : expr → positivity.strictness
+| nonnegative : expr → positivity.strictness
+| nonzero : expr → positivity.strictness
+
+export positivity.strictness (positive nonnegative nonzero)
+
+meta instance : has_to_string strictness :=
+⟨λ s, match s with
+  | positive p := "strictness.positive (" ++ to_string p ++ ")"
+  | nonnegative p := "strictness.nonnegative (" ++ to_string p ++ ")"
+  | nonzero p := "strictness.nonzero (" ++ to_string p ++ ")"
+  end⟩
+
+meta instance : has_to_format strictness := ⟨λ s, to_string s⟩
+
+private lemma lt_of_eq_of_lt'' {α} [preorder α] {b b' a : α} : b = b' → a < b' → a < b :=
+λ h1 h2, lt_of_lt_of_eq h2 h1.symm
+
+/-- First base case of the `positivity` tactic.  We try `norm_num` to prove directly that an
+expression `e` is positive, nonnegative or non-zero. -/
+meta def norm_num.positivity (e : expr) : tactic strictness := do
+  (e', p) ← norm_num.derive e <|> refl_conv e,
+  e'' ← e'.to_rat,
+  typ ← infer_type e',
+  ic ← mk_instance_cache typ,
+  if e'' > 0 then do
+    (ic, p₁) ← norm_num.prove_pos ic e',
+    positive <$> mk_app ``lt_of_eq_of_lt'' [p, p₁]
+  else if e'' = 0 then
+    nonnegative <$> mk_app ``ge_of_eq [p]
+  else do
+    (ic, p₁) ← norm_num.prove_ne_zero' ic e',
+    nonzero <$> to_expr ``(ne_of_eq_of_ne %%p %%p₁)
+
+/-- Second base case of the `positivity` tactic: Any element of a canonically ordered additive
+monoid is nonnegative. -/
+meta def positivity_canon : expr → tactic strictness
+| `(%%a) := nonnegative <$> mk_app ``zero_le [a]
+
+namespace positivity
+
+/-- Inductive type recording whether the goal `positivity` is called on is nonnegativity, positivity
+or different from `0`. -/
+@[derive inhabited]
+inductive order_rel : Type
+| le  : order_rel -- `0 ≤ a`
+| lt  : order_rel -- `0 < a`
+| ne  : order_rel -- `a ≠ 0`
+| ne' : order_rel -- `0 ≠ a`
+
+meta instance : has_to_format order_rel :=
+⟨λ r, match r with
+  | order_rel.le := "order_rel.le"
+  | order_rel.lt := "order_rel.lt"
+  | order_rel.ne := "order_rel.ne"
+  | order_rel.ne' := "order_rel.ne'"
+  end⟩
+
+/-- Given two tactics whose result is `strictness`, report a `strictness`:
+- if at least one gives `positive`, report `positive` and one of the expressions giving a proof of
+  positivity
+- if one reports `nonnegative` and the other reports `nonzero`, report `positive`
+- else if at least one reports `nonnegative`, report `nonnegative` and one of the
+  expressions giving a proof of nonnegativity
+- else if at least one reports `nonzero`, report `nonzero` and one of the expressions giving a proof
+  of nonzeroness
+- if both fail, fail -/
+protected meta def orelse (tac1 tac2 : tactic strictness) : tactic strictness := do
+  res1 ← try_core tac1,
+  match res1 with
+  | none := tac2
+  | some p1@(positive _) := pure p1
+  | some (nonnegative e1) := do
+      res2 ← try_core tac2,
+      match res2 with
+      | some p2@(positive _) := pure p2
+      | some (nonzero e2) := positive <$> mk_app ``lt_of_le_of_ne' [e1, e2]
+      | _ := pure (nonnegative e1)
+      end
+  | some (nonzero e1) := do
+      res2 ← try_core tac2,
+      match res2 with
+      | some p2@(positive _) := pure p2
+      | some (nonnegative e2) := positive <$> mk_app ``lt_of_le_of_ne' [e2, e1]
+      | _ := pure (nonzero e1)
+      end
+  end
+
+localized "infixr ` ≤|≥ `:2 := tactic.positivity.orelse" in positivity
+
+/-- This tactic fails with a message saying that `positivity` couldn't prove anything about `e`
+if we only know that `a` and `b` are positive/nonnegative/nonzero (according to `pa` and `pb`). -/
+meta def positivity_fail {α : Type*} (e a b : expr) (pa pb : strictness) : tactic α :=
+do
+  e' ← pp e,
+  a' ← pp a,
+  b' ← pp b,
+  let f : strictness → format → format := λ p c, match p with
+  | positive _ := "0 < " ++ c
+  | nonnegative _ := "0 ≤ " ++ c
+  | nonzero _ := c ++ " ≠ 0"
+  end,
+  fail (↑"`positivity` can't say anything about `" ++ e' ++ "` knowing only `" ++ f pa a' ++
+    "` and `" ++ f pb b' ++ "`")
+
+/-! ### Core logic of the `positivity` tactic -/
+
+private lemma ne_of_ne_of_eq' {α : Type*} {a b c : α} (ha : a ≠ c) (h : a = b) : b ≠ c := by rwa ←h
+
+/-- Calls `norm_num` on `a` to prove positivity/nonnegativity of `e` assuming `b` is defeq to `e`
+and `p₂ : a ≤ b`. -/
+meta def compare_hyp_le (e a b p₂ : expr) : tactic strictness := do
+  is_def_eq e b,
+  strict_a ← norm_num.positivity a,
+  match strict_a with
+  | positive p₁ := positive <$> mk_app ``lt_of_lt_of_le [p₁, p₂]
+  | nonnegative p₁ := nonnegative <$> mk_app ``le_trans [p₁, p₂]
+  | _ := do
+          e' ← pp e,
+          p₂' ← pp p₂,
+          fail (↑"`norm_num` can't prove nonnegativity of " ++ e' ++ " using " ++ p₂')
+  end
+
+/-- Calls `norm_num` on `a` to prove positivity/nonnegativity of `e` assuming `b` is defeq to `e`
+and `p₂ : a < b`. -/
+meta def compare_hyp_lt (e a b p₂ : expr) : tactic strictness := do
+  is_def_eq e b,
+  strict_a ← norm_num.positivity a,
+  match strict_a with
+  | positive p₁ := positive <$> mk_app ``lt_trans [p₁, p₂]
+  | nonnegative p₁ := positive <$> mk_app ``lt_of_le_of_lt [p₁, p₂]
+  | _ := do
+          e' ← pp e,
+          p₂' ← pp p₂,
+          fail (↑"`norm_num` can't prove positivity of " ++ e' ++ " using " ++ p₂')
+  end
+
+/-- Calls `norm_num` on `a` to prove positivity/nonnegativity/nonzeroness of `e` assuming `b` is
+defeq to `e` and `p₂ : a = b`. -/
+meta def compare_hyp_eq (e a b p₂ : expr) : tactic strictness := do
+  is_def_eq e b,
+  strict_a ← norm_num.positivity a,
+  match strict_a with
+  | positive p₁ := positive <$> mk_app ``lt_of_lt_of_eq [p₁, p₂]
+  | nonnegative p₁ := nonnegative <$> mk_app ``le_of_le_of_eq [p₁, p₂]
+  | nonzero p₁ := nonzero <$> to_expr ``(ne_of_ne_of_eq' %%p₁ %%p₂)
+  end
+
+/-- Calls `norm_num` on `a` to prove nonzeroness of `e` assuming `b` is defeq to `e` and
+`p₂ : b ≠ a`. -/
+meta def compare_hyp_ne (e a b p₂ : expr) : tactic strictness := do
+  is_def_eq e b,
+  (a', p₁) ← norm_num.derive a <|> refl_conv a,
+  a'' ← a'.to_rat,
+  if a'' = 0 then
+    nonzero <$> mk_mapp ``ne_of_ne_of_eq [none, none, none, none, p₂, p₁]
+  else do
+    e' ← pp e,
+    p₂' ← pp p₂,
+    a' ← pp a,
+    fail (↑"`norm_num` can't prove non-zeroness of " ++ e' ++ " using " ++ p₂' ++ " because "
+      ++ a' ++ " is non-zero")
+
+/-- Third base case of the `positivity` tactic.  Prove an expression `e` is
+positive/nonnegative/nonzero by finding a hypothesis of the form `a < e`, `a ≤ e` or `a = e` in
+which `a` can be proved positive/nonnegative/nonzero by `norm_num`. -/
+meta def compare_hyp (e p₂ : expr) : tactic strictness := do
+  p_typ ← infer_type p₂,
+  match p_typ with
+  | `(%%lo ≤ %%hi) := compare_hyp_le e lo hi p₂
+  | `(%%hi ≥ %%lo) := compare_hyp_le e lo hi p₂
+  | `(%%lo < %%hi) := compare_hyp_lt e lo hi p₂
+  | `(%%hi > %%lo) := compare_hyp_lt e lo hi p₂
+  | `(%%lo = %%hi) := compare_hyp_eq e lo hi p₂ <|> do
+                        p₂' ← mk_app ``eq.symm [p₂],
+                        compare_hyp_eq e hi lo p₂'
+  | `(%%hi ≠ %%lo) := compare_hyp_ne e lo hi p₂ <|> do
+                        p₂' ← mk_mapp ``ne.symm [none, none, none, p₂],
+                        compare_hyp_ne e hi lo p₂'
+  | e := do
+             p₂' ← pp p₂,
+             fail (p₂' ++ "is not of the form `a ≤ b`, `a < b`, `a = b` or `a ≠ b`")
+  end
+
+/-- Attribute allowing a user to tag a tactic as an extension for `tactic.interactive.positivity`.
+The main (recursive) step of this tactic is to try successively all the extensions tagged with this
+attribute on the expression at hand, and also to try the two "base case" tactics
+`tactic.norm_num.positivity`, `tactic.positivity.compare_hyp` on the expression at hand. -/
+@[user_attribute]
+meta def attr : user_attribute (expr → tactic strictness) unit :=
+{ name      := `positivity,
+  descr     := "extensions handling particular operations for the `positivity` tactic",
+  cache_cfg :=
+  { mk_cache := λ ns, do
+    { t ← ns.mfoldl
+        (λ (t : expr → tactic strictness) n, do
+          t' ← eval_expr (expr → tactic strictness) (expr.const n []),
+          pure (λ e, t' e ≤|≥ t e))
+        (λ _, failed),
+      pure $ λ e,
+            t e -- run all the extensions on `e`
+        ≤|≥ norm_num.positivity e -- directly try `norm_num` on `e`
+        ≤|≥ positivity_canon e -- try showing nonnegativity from canonicity of the order
+            -- loop over hypotheses and try to compare with `e`
+        ≤|≥ local_context >>= list.foldl (λ tac h, tac ≤|≥ compare_hyp e h)
+              (fail "no applicable positivity extension found") },
+    dependencies := [] } }
+
+/-- Look for a proof of positivity/nonnegativity of an expression `e`; if found, return the proof
+together with a `strictness` stating whether the proof found was for strict positivity
+(`positive p`), nonnegativity (`nonnegative p`), or nonzeroness (`nonzero p`). -/
+meta def core (e : expr) : tactic strictness := do
+  f ← attr.get_cache,
+  f e <|> fail "failed to prove positivity/nonnegativity/nonzeroness"
+
+end positivity
+
+open positivity
+open_locale positivity
+
+namespace interactive
+
+setup_tactic_parser
+
+/-- Tactic solving goals of the form `0 ≤ x`, `0 < x` and `x ≠ 0`.  The tactic works recursively
+according to the syntax of the expression `x`, if the atoms composing the expression all have
+numeric lower bounds which can be proved positive/nonnegative/nonzero by `norm_num`.  This tactic
+either closes the goal or fails.
+
+Examples:
+```
+example {a : ℤ} (ha : 3 < a) : 0 ≤ a ^ 3 + a := by positivity
+
+example {a : ℤ} (ha : 1 < a) : 0 < |(3:ℤ) + a| := by positivity
+
+example {b : ℤ} : 0 ≤ max (-3) (b ^ 2) := by positivity
+```
+-/
+meta def positivity : tactic unit := focus1 $ do
+  t ← target >>= instantiate_mvars,
+  (rel_desired, a) ← match t with
+  | `(0 ≤ %%e) := pure (order_rel.le, e)
+  | `(%%e ≥ 0) := pure (order_rel.le, e)
+  | `(0 < %%e) := pure (order_rel.lt, e)
+  | `(%%e > 0) := pure (order_rel.lt, e)
+  | `(%%e₁ ≠ %%e₂) := do
+                        match e₂ with
+                        | `(has_zero.zero) := pure (order_rel.ne, e₁)
+                        | _ := match e₁ with
+                          | `(has_zero.zero) := pure (order_rel.ne', e₂)
+                          | _ := fail "not a positivity/nonnegativity/nonzeroness goal"
+                          end
+                        end
+  | _ := fail "not a positivity/nonnegativity/nonzeroness goal"
+  end,
+  strictness_proved ← tactic.positivity.core a,
+  match rel_desired, strictness_proved with
+  | order_rel.lt, positive p := pure p
+  | order_rel.lt, nonnegative _ := fail ("failed to prove strict positivity, but it would be " ++
+    "possible to prove nonnegativity if desired")
+  | order_rel.lt, nonzero _ := fail ("failed to prove strict positivity, but it would be " ++
+    "possible to prove nonzeroness if desired")
+  | order_rel.le, positive p := mk_app ``le_of_lt [p]
+  | order_rel.le, nonnegative p := pure p
+  | order_rel.le, nonzero _ := fail ("failed to prove nonnegativity, but it would be " ++
+    "possible to prove nonzeroness if desired")
+  | order_rel.ne, positive p := to_expr ``(ne_of_gt %%p)
+  | order_rel.ne, nonnegative _ := fail ("failed to prove nonzeroness, but it would be " ++
+    "possible to prove nonnegativity if desired")
+  | order_rel.ne, nonzero p := pure p
+  | order_rel.ne', positive p := to_expr ``(ne_of_lt %%p)
+  | order_rel.ne', nonnegative _ := fail ("failed to prove nonzeroness, but it would be " ++
+    "possible to prove nonnegativity if desired")
+  | order_rel.ne', nonzero p := to_expr ``(ne.symm %%p)
+  end >>= tactic.exact
+
+add_tactic_doc
+{ name := "positivity",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.positivity],
+  tags := ["arithmetic", "monotonicity", "finishing"] }
+
+end interactive
+
+variables {ι α R : Type*}
+
+/-! ### `positivity` extensions for particular arithmetic operations -/
+
+section ite
+variables [has_zero α] {p : Prop} [decidable p] {a b : α}
+
+private lemma ite_pos [has_lt α] (ha : 0 < a) (hb : 0 < b) : 0 < ite p a b :=
+by by_cases p; simp [*]
+
+private lemma ite_nonneg [has_le α] (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ ite p a b :=
+by by_cases p; simp [*]
+
+private lemma ite_nonneg_of_pos_of_nonneg [preorder α] (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ ite p a b :=
+ite_nonneg ha.le hb
+
+private lemma ite_nonneg_of_nonneg_of_pos [preorder α] (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ ite p a b :=
+ite_nonneg ha hb.le
+
+private lemma ite_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : ite p a b ≠ 0 := by by_cases p; simp [*]
+
+private lemma ite_ne_zero_of_pos_of_ne_zero [preorder α] (ha : 0 < a) (hb : b ≠ 0) :
+  ite p a b ≠ 0 :=
+ite_ne_zero ha.ne' hb
+
+private lemma ite_ne_zero_of_ne_zero_of_pos [preorder α] (ha : a ≠ 0) (hb : 0 < b) :
+  ite p a b ≠ 0 :=
+ite_ne_zero ha hb.ne'
+
+end ite
+
+/-- Extension for the `positivity` tactic: the `if then else` of two numbers is
+positive/nonnegative/nonzero if both are. -/
+@[positivity]
+meta def positivity_ite : expr → tactic strictness
+| e@`(@ite %%typ %%p %%hp %%a %%b) := do
+  strictness_a ← core a,
+  strictness_b ← core b,
+  match strictness_a, strictness_b with
+  | positive pa, positive pb := positive <$> mk_app ``ite_pos [pa, pb]
+  | positive pa, nonnegative pb := nonnegative <$> mk_app ``ite_nonneg_of_pos_of_nonneg [pa, pb]
+  | nonnegative pa, positive pb := nonnegative <$> mk_app ``ite_nonneg_of_nonneg_of_pos [pa, pb]
+  | nonnegative pa, nonnegative pb := nonnegative <$> mk_app ``ite_nonneg [pa, pb]
+  | positive pa, nonzero pb := nonzero <$> to_expr ``(ite_ne_zero_of_pos_of_ne_zero %%pa %%pb)
+  | nonzero pa, positive pb := nonzero <$> to_expr ``(ite_ne_zero_of_ne_zero_of_pos %%pa %%pb)
+  | nonzero pa, nonzero pb := nonzero <$> to_expr ``(ite_ne_zero %%pa %%pb)
+  | sa@_, sb@ _ := positivity_fail e a b sa sb
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `ite p a b`"
+
+section linear_order
+variables [linear_order R] {a b c : R}
+
+private lemma le_min_of_lt_of_le  (ha : a < b) (hb : a ≤ c) : a ≤ min b c := le_min ha.le hb
+private lemma le_min_of_le_of_lt (ha : a ≤ b) (hb : a < c) : a ≤ min b c := le_min ha hb.le
+private lemma min_ne (ha : a ≠ c) (hb : b ≠ c) : min a b ≠ c :=
+by { rw min_def, split_ifs; assumption }
+private lemma min_ne_of_ne_of_lt (ha : a ≠ c) (hb : c < b) : min a b ≠ c := min_ne ha hb.ne'
+private lemma min_ne_of_lt_of_ne (ha : c < a) (hb : b ≠ c) : min a b ≠ c := min_ne ha.ne' hb
+
+private lemma max_ne (ha : a ≠ c) (hb : b ≠ c) : max a b ≠ c :=
+by { rw max_def, split_ifs; assumption }
+
+end linear_order
+
+/-- Extension for the `positivity` tactic: the `min` of two numbers is nonnegative if both are
+nonnegative, and strictly positive if both are. -/
+@[positivity]
+meta def positivity_min : expr → tactic strictness
+| e@`(min %%a %%b) := do
+  strictness_a ← core a,
+  strictness_b ← core b,
+  match strictness_a, strictness_b with
+  | (positive pa), (positive pb) := positive <$> mk_app ``lt_min [pa, pb]
+  | (positive pa), (nonnegative pb) := nonnegative <$> mk_app ``le_min_of_lt_of_le [pa, pb]
+  | (nonnegative pa), (positive pb)  := nonnegative <$> mk_app ``le_min_of_le_of_lt [pa, pb]
+  | (nonnegative pa), (nonnegative pb)  := nonnegative <$> mk_app ``le_min [pa, pb]
+  | positive pa, nonzero pb := nonzero <$> to_expr ``(min_ne_of_lt_of_ne %%pa %%pb)
+  | nonzero pa, positive pb := nonzero <$> to_expr ``(min_ne_of_ne_of_lt %%pa %%pb)
+  | nonzero pa, nonzero pb := nonzero <$> to_expr ``(min_ne %%pa %%pb)
+  | sa@_, sb@ _ := positivity_fail e a b sa sb
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `min a b`"
+
+/-- Extension for the `positivity` tactic: the `max` of two numbers is nonnegative if at least one
+is nonnegative, strictly positive if at least one is positive, and nonzero if both are nonzero. -/
+@[positivity]
+meta def positivity_max : expr → tactic strictness
+| `(max %%a %%b) := do
+  strictness_a ← try_core (core a),
+  (do
+      match strictness_a with
+      | some (positive pa) := positive <$> mk_mapp ``lt_max_of_lt_left [none, none, none, a, b, pa]
+      | some (nonnegative pa) :=
+          nonnegative <$> mk_mapp ``le_max_of_le_left [none, none, none, a, b, pa]
+      | _ := failed
+        -- If `a ≠ 0`, we might prove `max a b ≠ 0` if `b ≠ 0` but we don't want to evaluate
+        -- `b` before having ruled out `0 < a`, for performance. So we do that in the second branch
+        -- of the `orelse'`.
+      end) ≤|≥
+    (do
+      strictness_b ← core b,
+      match strictness_b with
+      | (positive pb) := positive <$> mk_mapp ``lt_max_of_lt_right [none, none, none, a, b, pb]
+      | (nonnegative pb) :=
+          nonnegative <$> mk_mapp ``le_max_of_le_right [none, none, none, a, b, pb]
+      | nonzero pb := do
+                        nonzero pa ← strictness_a,
+                        nonzero <$> to_expr ``(max_ne %%pa %%pb)
+      end)
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `max a b`"
+
+/-- Extension for the `positivity` tactic: addition is nonnegative if both summands are nonnegative,
+and strictly positive if at least one summand is. -/
+@[positivity]
+meta def positivity_add : expr → tactic strictness
+| e@`(%%a + %%b) := do
+  strictness_a ← core a,
+  strictness_b ← core b,
+  match strictness_a, strictness_b with
+  | (positive pa), (positive pb) := positive <$> mk_app ``add_pos [pa, pb]
+  | (positive pa), (nonnegative pb) := positive <$> mk_app ``lt_add_of_pos_of_le [pa, pb]
+  | (nonnegative pa), (positive pb) := positive <$> mk_app ``lt_add_of_le_of_pos [pa, pb]
+  | (nonnegative pa), (nonnegative pb) := nonnegative <$> mk_app ``add_nonneg [pa, pb]
+  | sa@_, sb@ _ := positivity_fail e a b sa sb
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a + b`"
+
+section ordered_semiring
+variables [ordered_semiring R] {a b : R}
+
+private lemma mul_nonneg_of_pos_of_nonneg (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a * b :=
+mul_nonneg ha.le hb
+
+private lemma mul_nonneg_of_nonneg_of_pos (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a * b :=
+mul_nonneg ha hb.le
+
+private lemma mul_ne_zero_of_pos_of_ne_zero [no_zero_divisors R] (ha : 0 < a) (hb : b ≠ 0) :
+  a * b ≠ 0 :=
+mul_ne_zero ha.ne' hb
+
+private lemma mul_ne_zero_of_ne_zero_of_pos [no_zero_divisors R] (ha : a ≠ 0) (hb : 0 < b) :
+  a * b ≠ 0 :=
+mul_ne_zero ha hb.ne'
+
+end ordered_semiring
+
+/-- Extension for the `positivity` tactic: multiplication is nonnegative/positive/nonzero if both
+multiplicands are. -/
+@[positivity]
+meta def positivity_mul : expr → tactic strictness
+| e@`(%%a * %%b) := do
+  strictness_a ← core a,
+  strictness_b ← core b,
+  match strictness_a, strictness_b with
+  | (positive pa), (positive pb) := positive <$> mk_app ``mul_pos [pa, pb]
+  | (positive pa), (nonnegative pb) := nonnegative <$> mk_app ``mul_nonneg_of_pos_of_nonneg [pa, pb]
+  | (nonnegative pa), (positive pb) := nonnegative <$> mk_app ``mul_nonneg_of_nonneg_of_pos [pa, pb]
+  | (nonnegative pa), (nonnegative pb) := nonnegative <$> mk_app ``mul_nonneg [pa, pb]
+  | positive pa, nonzero pb := nonzero <$> to_expr ``(mul_ne_zero_of_pos_of_ne_zero %%pa %%pb)
+  | nonzero pa, positive pb := nonzero <$> to_expr ``(mul_ne_zero_of_ne_zero_of_pos %%pa %%pb)
+  | nonzero pa, nonzero pb := nonzero <$> to_expr ``(mul_ne_zero %%pa %%pb)
+  | sa@_, sb@ _ := positivity_fail e a b sa sb
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a * b`"
+
+section linear_ordered_semifield
+variables [linear_ordered_semifield R] {a b : R}
+
+private lemma div_nonneg_of_pos_of_nonneg (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a / b :=
+div_nonneg ha.le hb
+
+private lemma div_nonneg_of_nonneg_of_pos (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a / b :=
+div_nonneg ha hb.le
+
+private lemma div_ne_zero_of_pos_of_ne_zero (ha : 0 < a) (hb : b ≠ 0) : a / b ≠ 0 :=
+div_ne_zero ha.ne' hb
+
+private lemma div_ne_zero_of_ne_zero_of_pos (ha : a ≠ 0) (hb : 0 < b) : a / b ≠ 0 :=
+div_ne_zero ha hb.ne'
+
+end linear_ordered_semifield
+
+private lemma int_div_self_pos {a : ℤ} (ha : 0 < a) : 0 < a / a :=
+by { rw int.div_self ha.ne', exact zero_lt_one }
+
+private lemma int_div_nonneg_of_pos_of_nonneg {a b : ℤ} (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a / b :=
+int.div_nonneg ha.le hb
+
+private lemma int_div_nonneg_of_nonneg_of_pos {a b : ℤ} (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a / b :=
+int.div_nonneg ha hb.le
+
+private lemma int_div_nonneg_of_pos_of_pos {a b : ℤ} (ha : 0 < a) (hb : 0 < b) : 0 ≤ a / b :=
+int.div_nonneg ha.le hb.le
+
+/-- Extension for the `positivity` tactic: division is nonnegative if both numerator and denominator
+are nonnegative, and strictly positive if both numerator and denominator are. -/
+@[positivity]
+meta def positivity_div : expr → tactic strictness
+| e@`(@has_div.div ℤ _ %%a %%b) := do
+  strictness_a ← core a,
+  strictness_b ← core b,
+  match strictness_a, strictness_b with
+  | positive pa, positive pb :=
+      if a = b then -- Only attempts to prove `0 < a / a`, otherwise falls back to `0 ≤ a / b`
+        positive <$> mk_app ``int_div_self_pos [pa]
+      else
+       nonnegative <$> mk_app ``int_div_nonneg_of_pos_of_pos [pa, pb]
+  | positive pa, nonnegative pb :=
+    nonnegative <$> mk_app ``int_div_nonneg_of_pos_of_nonneg [pa, pb]
+  | nonnegative pa, positive pb :=
+    nonnegative <$> mk_app ``int_div_nonneg_of_nonneg_of_pos [pa, pb]
+  | nonnegative pa, nonnegative pb := nonnegative <$> mk_app ``int.div_nonneg [pa, pb]
+  | sa@_, sb@ _ := positivity_fail e a b sa sb
+  end
+| e@`(%%a / %%b) := do
+  strictness_a ← core a,
+  strictness_b ← core b,
+  match strictness_a, strictness_b with
+  | positive pa, positive pb := positive <$> mk_app ``div_pos [pa, pb]
+  | positive pa, nonnegative pb := nonnegative <$> mk_app ``div_nonneg_of_pos_of_nonneg [pa, pb]
+  | nonnegative pa, positive pb := nonnegative <$> mk_app ``div_nonneg_of_nonneg_of_pos [pa, pb]
+  | nonnegative pa, nonnegative pb := nonnegative <$> mk_app ``div_nonneg [pa, pb]
+  | positive pa, nonzero pb := nonzero <$> to_expr ``(div_ne_zero_of_pos_of_ne_zero %%pa %%pb)
+  | nonzero pa, positive pb := nonzero <$> to_expr ``(div_ne_zero_of_ne_zero_of_pos %%pa %%pb)
+  | nonzero pa, nonzero pb := nonzero <$> to_expr ``(div_ne_zero %%pa %%pb)
+  | sa@_, sb@ _ := positivity_fail e a b sa sb
+  end
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a / b`"
+
+/-- Extension for the `positivity` tactic: an inverse of a positive number is positive, an inverse
+of a nonnegative number is nonnegative. -/
+@[positivity]
+meta def positivity_inv : expr → tactic strictness
+| `((%%a)⁻¹) := do
+      strictness_a ← core a,
+      match strictness_a with
+      | (positive pa) := positive <$> mk_app ``inv_pos_of_pos [pa]
+      | (nonnegative pa) := nonnegative <$> mk_app ``inv_nonneg_of_nonneg [pa]
+      | nonzero pa := nonzero <$> to_expr ``(inv_ne_zero %%pa)
+      end
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a⁻¹`"
+
+private lemma pow_zero_pos [ordered_semiring R] [nontrivial R] (a : R) : 0 < a ^ 0 :=
+zero_lt_one.trans_le (pow_zero a).ge
+
+private lemma zpow_zero_pos [linear_ordered_semifield R] (a : R) : 0 < a ^ (0 : ℤ) :=
+zero_lt_one.trans_le (zpow_zero a).ge
+
+/-- Extension for the `positivity` tactic: raising a number `a` to a natural/integer power `n` is
+positive if `n = 0` (since `a ^ 0 = 1`) or if `0 < a`, and is nonnegative if `n` is even (squares
+are nonnegative) or if `0 ≤ a`. -/
+@[positivity]
+meta def positivity_pow : expr → tactic strictness
+| e@`(%%a ^ %%n) := do
+  typ ← infer_type n,
+  (do
+    unify typ `(ℕ),
+    if n = `(0) then
+      positive <$> mk_app ``pow_zero_pos [a]
+    else
+      do -- even powers are nonnegative
+      -- Note this is automatically strengthened to `0 < a ^ n` when `a ≠ 0` thanks to the `orelse'`
+        match n with -- TODO: Decision procedure for parity
+        | `(bit0 %% n) := nonnegative <$> mk_app ``pow_bit0_nonneg [a, n]
+        | _ := do
+                  e' ← pp e,
+                  fail (e' ++ "is not an even power so positivity can't prove it's nonnegative")
+        end ≤|≥
+      do -- `a ^ n` is positive if `a` is, and nonnegative if `a` is
+        strictness_a ← core a,
+        match strictness_a with
+        | positive p := positive <$> mk_app ``pow_pos [p, n]
+        | nonnegative p := nonnegative <$> mk_app `pow_nonneg [p, n]
+        | nonzero p := nonzero <$> to_expr ``(pow_ne_zero %%n %%p)
+        end) <|>
+  (do
+    unify typ `(ℤ),
+    if n = `(0 : ℤ) then
+      positive <$> mk_app ``zpow_zero_pos [a]
+    else
+      do -- even powers are nonnegative
+    -- Note this is automatically strengthened to `0 < a ^ n` when `a ≠ 0` thanks to the `orelse'`
+        match n with -- TODO: Decision procedure for parity
+        | `(bit0 %%n) := nonnegative <$> mk_app ``zpow_bit0_nonneg [a, n]
+        | _ := do
+                  e' ← pp e,
+                  fail (e' ++ "is not an even power so positivity can't prove it's nonnegative")
+            end ≤|≥
+      do -- `a ^ n` is positive if `a` is, and nonnegative if `a` is
+        strictness_a ← core a,
+        match strictness_a with
+        | positive p := positive <$> mk_app ``zpow_pos_of_pos [p, n]
+        | nonnegative p := nonnegative <$> mk_app ``zpow_nonneg [p, n]
+        | nonzero p := nonzero <$> to_expr ``(zpow_ne_zero %%n %%p)
+        end)
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `a ^ n`"
+
+/-- Extension for the `positivity` tactic: raising a positive number in a canonically ordered
+semiring gives a positive number. -/
+@[positivity]
+meta def positivity_canon_pow : expr → tactic strictness
+| `(%%r ^ %%n) := do
+    typ_n ← infer_type n,
+    unify typ_n `(ℕ),
+    positive p ← core r,
+    positive <$> mk_app ``canonically_ordered_comm_semiring.pow_pos [p, n]
+    -- The nonzero never happens because of `tactic.positivity_canon`
+| e := pp e >>= fail ∘ format.bracket "The expression `"
+    "` is not of the form `a ^ n` for `a` in a `canonically_ordered_comm_semiring` and `n : ℕ`"
+
+private alias abs_pos ↔ _ abs_pos_of_ne_zero
+
+/-- Extension for the `positivity` tactic: an absolute value is nonnegative, and is strictly
+positive if its input is nonzero. -/
+@[positivity]
+meta def positivity_abs : expr → tactic strictness
+| `(|%%a|) := do
+  (do -- if can prove `0 < a` or `a ≠ 0`, report positivity
+    strict_a ← core a,
+    match strict_a with
+    | positive p := positive <$> mk_app ``abs_pos_of_pos [p]
+    | nonzero p := positive <$> mk_app ``abs_pos_of_ne_zero [p]
+    | _ := failed
+    end) <|>
+  nonnegative <$> mk_app ``abs_nonneg [a] -- else report nonnegativity
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `|a|`"
+
+private lemma int_nat_abs_pos {n : ℤ} (hn : 0 < n) : 0 < n.nat_abs :=
+int.nat_abs_pos_of_ne_zero hn.ne'
+
+/-- Extension for the `positivity` tactic: `int.nat_abs` is positive when its input is.
+
+Since the output type of `int.nat_abs` is `ℕ`, the nonnegative case is handled by the default
+`positivity` tactic.
+-/
+@[positivity]
+meta def positivity_nat_abs : expr → tactic strictness
+| `(int.nat_abs %%a) := do
+    strict_a ← core a,
+    match strict_a with
+    | positive p := positive <$> mk_app ``int_nat_abs_pos [p]
+    | nonzero p := positive <$> mk_app ``int.nat_abs_pos_of_ne_zero [p]
+    | _ := failed
+    end
+| _ := failed
+
+private lemma nat_cast_pos [ordered_semiring α] [nontrivial α] {n : ℕ} : 0 < n → 0 < (n : α) :=
+nat.cast_pos.2
+
+private lemma int_coe_nat_nonneg (n : ℕ) : 0 ≤ (n : ℤ) := n.cast_nonneg
+private lemma int_coe_nat_pos {n : ℕ} : 0 < n → 0 < (n : ℤ) := nat.cast_pos.2
+
+private lemma int_cast_ne_zero [add_group_with_one α] [char_zero α] {n : ℤ} : n ≠ 0 → (n : α) ≠ 0 :=
+int.cast_ne_zero.2
+private lemma int_cast_nonneg [ordered_ring α] {n : ℤ} (hn : 0 ≤ n) : 0 ≤ (n : α) :=
+by { rw ←int.cast_zero, exact int.cast_mono hn }
+private lemma int_cast_pos [ordered_ring α] [nontrivial α] {n : ℤ} : 0 < n → 0 < (n : α) :=
+int.cast_pos.2
+
+private lemma rat_cast_ne_zero [division_ring α] [char_zero α] {q : ℚ} : q ≠ 0 → (q : α) ≠ 0 :=
+rat.cast_ne_zero.2
+private lemma rat_cast_nonneg [linear_ordered_field α] {q : ℚ} : 0 ≤ q → 0 ≤ (q : α) :=
+rat.cast_nonneg.2
+private lemma rat_cast_pos [linear_ordered_field α] {q : ℚ} : 0 < q → 0 < (q : α) := rat.cast_pos.2
+
+/-- Extension for the `positivity` tactic: casts from `ℕ`, `ℤ`, `ℚ`. -/
+@[positivity]
+meta def positivity_coe : expr → tactic strictness
+| `(@coe _ %%typ %%inst %%a) := do
+  -- TODO: Using `match` here might turn out too strict since we really want the instance to *unify*
+  -- with one of the instances below rather than being equal on the nose.
+  -- If this turns out to indeed be a problem, we should figure out the right way to pattern match
+  -- up to defeq rather than equality of expressions.
+  -- See also "Reflexive tactics for algebra, revisited" by Kazuhiko Sakaguchi at ITP 2022.
+  match inst with
+  | `(@coe_to_lift _ _ %%inst) := do
+    strictness_a ← core a,
+    match inst, strictness_a with -- `mk_mapp` is necessary in some places. Why?
+    | `(nat.cast_coe), positive p := positive <$> mk_mapp ``nat_cast_pos [typ, none, none, none, p]
+    | `(nat.cast_coe), _ := nonnegative <$> mk_mapp ``nat.cast_nonneg [typ, none, a]
+    | `(int.cast_coe), positive p := positive <$> mk_mapp ``int_cast_pos [typ, none, none, none, p]
+    | `(int.cast_coe), nonnegative p := nonnegative <$>
+                                          mk_mapp ``int_cast_nonneg [typ, none, none, p]
+    | `(int.cast_coe), nonzero p := nonzero <$>
+                                          mk_mapp ``int_cast_ne_zero [typ, none, none, none, p]
+    | `(rat.cast_coe), positive p := positive <$> mk_mapp ``rat_cast_pos [typ, none, none, p]
+    | `(rat.cast_coe), nonnegative p := nonnegative <$>
+                                          mk_mapp ``rat_cast_nonneg [typ, none, none, p]
+    | `(rat.cast_coe), nonzero p := nonzero <$>
+                                          mk_mapp ``rat_cast_ne_zero [typ, none, none, none, p]
+    | `(@coe_base _ _ int.has_coe), positive p := positive <$> mk_app ``int_coe_nat_pos [p]
+    | `(@coe_base _ _ int.has_coe), _ := nonnegative <$> mk_app ``int_coe_nat_nonneg [a]
+    | _, _ := failed
+    end
+  | _  := failed
+  end
+| _ := failed
+
+/-- Extension for the `positivity` tactic: `nat.succ` is always positive. -/
+@[positivity]
+meta def positivity_succ : expr → tactic strictness
+| `(nat.succ %%a) := positive <$> mk_app `nat.succ_pos [a]
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `nat.succ n`"
+
+/-- Extension for the `positivity` tactic: `nat.factorial` is always positive. -/
+@[positivity]
+meta def positivity_factorial : expr → tactic strictness
+| `(nat.factorial %%a) := positive <$> mk_app ``nat.factorial_pos [a]
+| e := pp e >>= fail ∘ format.bracket "The expression `" "` isn't of the form `n!`"
+
+/-- Extension for the `positivity` tactic: `nat.asc_factorial` is always positive. -/
+@[positivity]
+meta def positivity_asc_factorial : expr → tactic strictness
+| `(nat.asc_factorial %%a %%b) := positive <$> mk_app ``nat.asc_factorial_pos [a, b]
+| e := pp e >>= fail ∘ format.bracket "The expression `"
+         "` isn't of the form `nat.asc_factorial n k`"
+
+/-- Extension for the `positivity` tactic: nonnegative maps take nonnegative values. -/
+@[positivity]
+meta def positivity_map : expr → tactic strictness
+| (expr.app `(⇑%%f) `(%%a)) := nonnegative <$> mk_app ``map_nonneg [f, a]
+| _ := failed
+
+end tactic
diff --git a/src/tactic/print_sorry.lean b/src/tactic/print_sorry.lean
new file mode 100644
index 0000000000000..d2e6421a396a9
--- /dev/null
+++ b/src/tactic/print_sorry.lean
@@ -0,0 +1,115 @@
+/-
+Copyright (c) 2022 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Floris van Doorn
+-/
+import tactic.core
+import data.bool.basic
+
+/-!
+# Print sorry
+
+Adds a command `#print_sorry_in nm` that prints all occurrences of `sorry` in declarations used in
+`nm`, including all intermediate declarations.
+
+Other searches through the environment can be done using `tactic.find_all_exprs`
+-/
+
+
+namespace tactic
+/-- Auxiliary data type for `tactic.find_all_exprs` -/
+meta structure find_all_expr_data :=
+(matching_subexpr : bool) -- this declaration contains a subexpression on which the test passes
+(test_passed : bool) -- the search has found a matching subexpression somewhere
+-- name, contains subexpression directly, direct descendants
+(descendants : list (name × bool × name_set))
+(name_map : name_map bool) -- all data
+(direct_descendants : name_set) -- direct descendants of a declaration
+
+/-- Auxiliary declaration for `tactic.find_all_exprs`.
+
+Traverse all declarations occurring in the declaration with the given name,
+excluding declarations `n` such that `g n` is true (and all their descendants),
+recording the structure of which declaration depends on which,
+and whether `f e` is true on any subexpression `e` of the declaration. -/
+meta def find_all_exprs_aux (env : environment) (f : expr → bool) (g : name → bool) : name →
+  find_all_expr_data → tactic find_all_expr_data
+| n ⟨b₀, b₁, l, ns, desc⟩ :=
+  match ns.find n with -- Skip declarations that we have already handled.
+  | some b := pure ⟨b₀, b || b₁, l, ns, if b then desc.insert n else desc⟩
+  | none := if g n then pure ⟨b₀, b₁, l, ns.insert n ff, desc⟩ else do
+    d ← env.get n,
+    let process (v : expr) : tactic find_all_expr_data :=
+      v.mfold ⟨ff, ff, l, ns, mk_name_set⟩ $ λ e _ p,
+        if f e then pure ⟨tt, tt, p.descendants, p.name_map, p.direct_descendants⟩ else
+        if e.is_constant then find_all_exprs_aux e.const_name p else pure p,
+    ⟨b', b, l, ns, desc'⟩ ← process d.value,
+    pure ⟨b₀, b₁ || b, if b then (n, b', desc')::l else l, ns.insert n b,
+      if b then desc.insert n else desc⟩
+  end
+
+/-- `tactic.find_all_exprs env test exclude nm` searches for all declarations (transitively)
+  occuring in `nm` that contain a subexpression `e` such that `test e` is true.
+  All declarations `n` such that `exclude n` is true (and all their descendants) are ignored. -/
+meta def find_all_exprs (env : environment) (test : expr → bool) (exclude : name → bool)
+  (nm : name) : tactic $ list $ name × bool × name_set := do
+  ⟨_, _, l, _, _⟩ ← find_all_exprs_aux env test exclude nm ⟨ff, ff, [], mk_name_map, mk_name_set⟩,
+  pure l
+
+end tactic
+open tactic
+
+/-- Print all declarations that (transitively) occur in the value of declaration `nm` and depend on
+`sorry`. If `ignore_mathlib` is set true, then all declarations in `mathlib` are
+assumed to be `sorry`-free, which greatly reduces the search space. We could also exclude `core`,
+but this doesn't speed up the search. -/
+meta def print_sorry_in (nm : name) (ignore_mathlib := tt) : tactic unit := do
+  env ← get_env,
+  dir ← get_mathlib_dir,
+  data ← find_all_exprs env (λ e, e.is_sorry.is_some)
+    (if ignore_mathlib then env.is_prefix_of_file dir else λ _, ff) nm,
+  let to_print : list format := data.map $ λ ⟨nm, contains_sorry, desc⟩,
+    let s1 := if contains_sorry then " contains sorry" else "",
+        s2 := if contains_sorry && !desc.empty then " and" else "",
+        s3 := string.join $ (desc.to_list.map to_string).intersperse ", ",
+        s4 := if !desc.empty then format!" depends on {s3}" else "" in
+    format!"{nm}{s1}{s2}{s4}.",
+  trace $ format.join $ to_print.intersperse format.line
+
+setup_tactic_parser
+
+/-- The command
+```
+#print_sorry_in nm
+```
+prints all declarations that (transitively) occur in the value of declaration `nm` and depend on
+`sorry`. This command assumes that no `sorry` occurs in mathlib. To find `sorry` in mathlib, use
+``#eval print_sorry_in `nm ff`` instead.
+Example:
+```
+def foo1 : false := sorry
+def foo2 : false ∧ false := ⟨sorry, foo1⟩
+def foo3 : false := foo2.left
+def foo4 : true := trivial
+def foo5 : true ∧ false := ⟨foo4, foo3⟩
+#print_sorry_in foo5
+```
+prints
+```
+foo5 depends on foo3.
+foo3 depends on foo2.
+foo2 contains sorry and depends on foo1.
+foo1 contains sorry.
+```
+-/
+@[user_command]
+meta def print_sorry_in_cmd (_ : parse $ tk "#print_sorry_in") : parser unit := do
+  nm ← ident,
+  nm ← resolve_name nm,
+  print_sorry_in nm.const_name
+
+add_tactic_doc
+{ name                     := "print_sorry_in",
+  category                 := doc_category.cmd,
+  decl_names               := [`print_sorry_in_cmd],
+  tags                     := ["search", "environment", "debugging"] }
diff --git a/src/tactic/push_neg.lean b/src/tactic/push_neg.lean
index 3d81811a0fc87..1f7110e44b38a 100644
--- a/src/tactic/push_neg.lean
+++ b/src/tactic/push_neg.lean
@@ -2,14 +2,20 @@
 Copyright (c) 2019 Patrick Massot All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Simon Hudon
-
-A tactic pushing negations into an expression
 -/
-
+import tactic.core
 import logic.basic
 
+/-!
+# A tactic pushing negations into an expression
+-/
+
 open tactic expr
 
+/- Enable the option `trace.push_neg.use_distrib` in order to have `¬ (p ∧ q)` normalized to
+`¬ p ∨ ¬ q`, rather than the default `p → ¬ q`. -/
+declare_trace push_neg.use_distrib
+
 namespace push_neg
 section
 
@@ -21,6 +27,7 @@ variable  (s : α → Prop)
 local attribute [instance, priority 10] classical.prop_decidable
 theorem not_not_eq : (¬ ¬ p) = p := propext not_not
 theorem not_and_eq : (¬ (p ∧ q)) = (p → ¬ q) := propext not_and
+theorem not_and_distrib_eq : (¬ (p ∧ q)) = (¬ p ∨ ¬ q) := propext not_and_distrib
 theorem not_or_eq : (¬ (p ∨ q)) = (¬ p ∧ ¬ q) := propext not_or_distrib
 theorem not_forall_eq : (¬ ∀ x, s x) = (∃ x, ¬ s x) := propext not_forall
 theorem not_exists_eq : (¬ ∃ x, s x) = (∀ x, ¬ s x) := propext not_exists
@@ -48,8 +55,13 @@ do e ← whnf_reducible e,
       match ne with
       | `(¬ %%a)      := do pr ← mk_app ``not_not_eq [a],
                             return (some (a, pr))
-      | `(%%a ∧ %%b)  := do pr ← mk_app ``not_and_eq [a, b],
-                            return (some (`((%%a : Prop) → ¬ %%b), pr))
+      | `(%%a ∧ %%b)  := do distrib ← get_bool_option `trace.push_neg.use_distrib ff,
+                            if distrib then do
+                              pr ← mk_app ``not_and_distrib_eq [a, b],
+                              return (some (`(¬ (%%a : Prop) ∨ ¬ %%b), pr))
+                            else do
+                              pr ← mk_app ``not_and_eq [a, b],
+                              return (some (`((%%a : Prop) → ¬ %%b), pr))
       | `(%%a ∨ %%b)  := do pr ← mk_app ``not_or_eq [a, b],
                             return (some (`(¬ %%a ∧ ¬ %%b), pr))
       | `(%%a ≤ %%b)  := do e ← to_expr ``(%%b < %%a),
@@ -114,8 +126,8 @@ end push_neg
 open interactive (parse loc.ns loc.wildcard)
 open interactive.types (location texpr)
 open lean.parser (tk ident many) interactive.loc
-local postfix `?`:9001 := optional
-local postfix *:9001 := many
+local postfix (name := parser.optional) `?`:9001 := optional
+local postfix (name := parser.many) *:9001 := many
 open push_neg
 
 /--
@@ -196,3 +208,56 @@ add_tactic_doc
   category   := doc_category.tactic,
   decl_names := [`tactic.interactive.contrapose],
   tags       := ["logic"] }
+
+
+/-!
+## `#push_neg` command
+A user command to run `push_neg`. Mostly copied from the `#norm_num` and `#simp` commands.
+-/
+
+namespace tactic
+
+open lean.parser
+open interactive.types
+setup_tactic_parser
+
+/--
+The syntax is `#push_neg e`, where `e` is an expression,
+which will print the `push_neg` form of `e`.
+
+`#push_neg` understands local variables, so you can use them to
+introduce parameters.
+-/
+@[user_command] meta def push_neg_cmd (_ : parse $ tk "#push_neg") : lean.parser unit :=
+do
+  e ← texpr,
+
+  /- Synthesize a `tactic_state` including local variables as hypotheses under which
+     `normalize_negations` may be safely called with expected behaviour given the `variables` in the
+     environment. -/
+  (ts, _) ← synthesize_tactic_state_with_variables_as_hyps [e],
+
+  /- Enter the `tactic` monad, *critically* using the synthesized tactic state `ts`. -/
+  result ← lean.parser.of_tactic $ λ _, do
+  { /- Resolve the local variables added by the parser to `e` (when it was parsed) against the local
+       hypotheses added to the `ts : tactic_state` which we are using. -/
+    e ← to_expr e,
+
+    /- Run `push_neg` on the expression. -/
+    (e_neg, _) ← normalize_negations e,
+
+    /- Run a `simp` to change any `¬ a = b` to `a ≠ b`; report the result, or, if the `simp` fails
+    (because no `¬ a = b` appear in the expression), return what `push_neg` gave. -/
+    prod.fst <$> e_neg.simp { eta := ff } failed tt [] [simp_arg_type.expr ``(push_neg.not_eq)]
+    <|> pure e_neg } ts,
+
+  /- Trace the result. -/
+  trace result
+
+add_tactic_doc
+{ name                     := "#push_neg",
+  category                 := doc_category.cmd,
+  decl_names               := [`tactic.push_neg_cmd],
+  tags                     := ["logic"] }
+
+end tactic
diff --git a/src/tactic/qify.lean b/src/tactic/qify.lean
new file mode 100644
index 0000000000000..2f7b8be0dbd17
--- /dev/null
+++ b/src/tactic/qify.lean
@@ -0,0 +1,160 @@
+/-
+Copyright (c) 2022 Jiale Miao. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jiale Miao
+-/
+
+import tactic.norm_cast
+import data.rat.cast
+
+/-!
+# A tactic to shift `ℕ` or `ℤ` goals to `ℚ`
+
+Note that this file is following from `zify`.
+
+Division in `ℕ` and `ℤ` is not always working fine (e.g. (5 : ℕ) / 2 = 2), so it's easier
+to work in `ℚ`, where division and subtraction are well behaved. `qify` can be used to cast goals
+and hypotheses about natural numbers or integers to rational numbers. It makes use of `push_cast`,
+part of the `norm_cast` family, to simplify these goals.
+
+## Implementation notes
+
+`qify` is extensible, using the attribute `@[qify]` to label lemmas used for moving propositions
+from `ℕ` or `ℤ` to `ℚ`.
+`qify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pq (a₁ : ℚ) ... (aₙ : ℚ) ↔ Pn a₁ ... aₙ`.
+For example, `rat.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `qify` lemma.
+
+`qify` is very nearly just `simp only with qify push_cast`. There are a few minor differences:
+* `qify` lemmas are used in the opposite order of the standard simp form.
+  E.g. we will rewrite with `rat.coe_nat_le_coe_nat_iff` from right to left.
+* `qify` should fail if no `qify` lemma applies (i.e. it was unable to shift any proposition to ℚ).
+  However, once this succeeds, it does not necessarily need to rewrite with any `push_cast` rules.
+-/
+
+open tactic
+
+namespace qify
+
+/--
+The `qify` attribute is used by the `qify` tactic. It applies to lemmas that shift propositions
+from `nat` or `int` to `rat`.
+
+`qify` lemmas should have the form `∀ a₁ ... aₙ : ℕ, Pq (a₁ : ℚ) ... (aₙ : ℚ) ↔ Pn a₁ ... aₙ` or
+ `∀ a₁ ... aₙ : ℤ, Pq (a₁ : ℚ) ... (aₙ : ℚ) ↔ Pz a₁ ... aₙ`.
+For example, `rat.coe_nat_le_coe_nat_iff : ∀ (m n : ℕ), ↑m ≤ ↑n ↔ m ≤ n` is a `qify` lemma.
+-/
+@[user_attribute]
+meta def qify_attr : user_attribute simp_lemmas unit :=
+{ name := `qify,
+  descr := "Used to tag lemmas for use in the `qify` tactic",
+  cache_cfg :=
+    { mk_cache :=
+        λ ns, mmap (λ n, do c ← mk_const n, return (c, tt)) ns >>= simp_lemmas.mk.append_with_symm,
+      dependencies := [] } }
+
+/--
+Given an expression `e`, `lift_to_q e` looks for subterms of `e` that are propositions "about"
+natural numbers or integers and change them to propositions about rational numbers.
+
+Returns an expression `e'` and a proof that `e = e'`.
+
+Includes `ge_iff_le` and `gt_iff_lt` in the simp set. These can't be tagged with `qify` as we
+want to use them in the "forward", not "backward", direction.
+-/
+meta def lift_to_q (e : expr) : tactic (expr × expr) :=
+do sl ← qify_attr.get_cache,
+   sl ← sl.add_simp `ge_iff_le, sl ← sl.add_simp `gt_iff_lt,
+   (e', prf, _) ← simplify sl [] e,
+   return (e', prf)
+
+@[qify] lemma rat.coe_nat_le_coe_nat_iff (a b : ℕ) : (a : ℚ) ≤ b ↔ a ≤ b := by simp
+@[qify] lemma rat.coe_nat_lt_coe_nat_iff (a b : ℕ) : (a : ℚ) < b ↔ a < b := by simp
+@[qify] lemma rat.coe_nat_eq_coe_nat_iff (a b : ℕ) : (a : ℚ) = b ↔ a = b := by simp
+@[qify] lemma rat.coe_nat_ne_coe_nat_iff (a b : ℕ) : (a : ℚ) ≠ b ↔ a ≠ b := by simp
+
+@[qify] lemma rat.coe_int_le_coe_int_iff (a b : ℤ) : (a : ℚ) ≤ b ↔ a ≤ b := by simp
+@[qify] lemma rat.coe_int_lt_coe_int_iff (a b : ℤ) : (a : ℚ) < b ↔ a < b := by simp
+@[qify] lemma rat.coe_int_eq_coe_int_iff (a b : ℤ) : (a : ℚ) = b ↔ a = b := by simp
+@[qify] lemma rat.coe_int_ne_coe_int_iff (a b : ℤ) : (a : ℚ) ≠ b ↔ a ≠ b := by simp
+
+end qify
+
+/--
+`qify extra_lems e` is used to shift propositions in `e` from `ℕ` or `ℤ` to `ℚ`.
+This is often useful since `ℚ` has well-behaved division and subtraction.
+
+The list of extra lemmas is used in the `push_cast` step.
+
+Returns an expression `e'` and a proof that `e = e'`.-/
+meta def tactic.qify (extra_lems : list simp_arg_type) : expr → tactic (expr × expr) := λ q,
+do (q1, p1) ← qify.lift_to_q q <|> fail "failed to find an applicable qify lemma",
+   (q2, p2) ← norm_cast.derive_push_cast extra_lems q1,
+   prod.mk q2 <$> mk_eq_trans p1 p2
+
+/--
+A variant of `tactic.qify` that takes `h`, a proof of a proposition about natural numbers
+or integers, and returns a proof of the qified version of that propositon.
+-/
+meta def tactic.qify_proof (extra_lems : list simp_arg_type) (h : expr) : tactic expr :=
+do (_, pf) ← infer_type h >>= tactic.qify extra_lems,
+   mk_eq_mp pf h
+
+section
+
+setup_tactic_parser
+
+/--
+The `qify` tactic is used to shift propositions from `ℕ` or `ℤ` to `ℚ`.
+This is often useful since `ℚ` has well-behaved division and subtraction.
+
+```lean
+example (a b c : ℕ) (x y z : ℤ) (h : ¬ x*y*z < 0) : c < a + 3*b :=
+begin
+  qify,
+  qify at h,
+  /-
+  h : ¬↑x * ↑y * ↑z < 0
+  ⊢ ↑c < ↑a + 3 * ↑b
+  -/
+end
+```
+
+`qify` can be given extra lemmas to use in simplification. This is especially useful in the
+presence of subtraction and division: passing `≤` or `∣` arguments will allow `push_cast`
+to do more work.
+```
+example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : false :=
+begin
+  qify [hab] at h,
+  /- h : ↑a - ↑b < ↑c -/
+end
+```
+
+```
+example (a b c : ℕ) (h : a / b = c) (hab : b ∣ a) : false :=
+begin
+  qify [hab] at h,
+  /- h : ↑a / ↑b = ↑c -/
+end
+```
+
+`qify` makes use of the `@[qify]` attribute to move propositions,
+and the `push_cast` tactic to simplify the `ℚ`-valued expressions.
+-/
+meta def tactic.interactive.qify (sl : parse simp_arg_list) (l : parse location) : tactic unit :=
+do locs ← l.get_locals,
+replace_at (tactic.qify sl) locs l.include_goal >>= guardb
+
+end
+
+add_tactic_doc
+{ name := "qify",
+  category := doc_category.attr,
+  decl_names := [`qify.qify_attr],
+  tags := ["coercions", "transport"] }
+
+add_tactic_doc
+{ name := "qify",
+  category := doc_category.tactic,
+  decl_names := [`tactic.interactive.qify],
+  tags := ["coercions", "transport"] }
diff --git a/src/tactic/rcases.lean b/src/tactic/rcases.lean
index e21a0367df6b7..960a9be7c9806 100644
--- a/src/tactic/rcases.lean
+++ b/src/tactic/rcases.lean
@@ -32,6 +32,8 @@ the input expression). An `rcases` pattern has the following grammar:
   of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
   then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
   and so on.
+* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
+  while leaving the `@` off will only use the patterns on the explicit arguments.
 * An alteration pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
   or a nested disjunction like `a ∨ b ∨ c`.
 
@@ -112,6 +114,7 @@ type with 3 constructors,  `p1 | (p2 | p3)` will act like `p1 | (p2 | p3) | _` i
 meta inductive rcases_patt : Type
 | one : name → rcases_patt
 | clear : rcases_patt
+| explicit : rcases_patt → rcases_patt
 | typed : rcases_patt → pexpr → rcases_patt
 | tuple : listΠ rcases_patt → rcases_patt
 | alts : listΣ rcases_patt → rcases_patt
@@ -125,15 +128,17 @@ meta def name : rcases_patt → option name
 | (one `_) := none
 | (one `rfl) := none
 | (one n) := some n
+| (explicit p) := p.name
 | (typed p _) := p.name
 | (alts [p]) := p.name
 | _ := none
 
 /-- Interpret an rcases pattern as a tuple, where `p` becomes `⟨p⟩`
 if `p` is not already a tuple. -/
-meta def as_tuple : rcases_patt → listΠ rcases_patt
-| (tuple ps) := ps
-| p := [p]
+meta def as_tuple : rcases_patt → bool × listΠ rcases_patt
+| (explicit p) := (tt, (as_tuple p).2)
+| (tuple ps) := (ff, ps)
+| p := (ff, [p])
 
 /-- Interpret an rcases pattern as an alternation, where non-alternations are treated as one
 alternative. -/
@@ -196,6 +201,7 @@ meta def alts₁ : listΣ (listΠ rcases_patt) → rcases_patt
 meta instance has_reflect : has_reflect rcases_patt
 | (one n) := `(_)
 | clear := `(_)
+| (explicit l) := `(explicit).subst (has_reflect l)
 | (typed l e) :=
   (`(typed).subst (has_reflect l)).subst (reflect e)
 | (tuple l) := `(λ l, tuple l).subst $
@@ -209,6 +215,7 @@ or atomic name. -/
 protected meta def format : ∀ bracket : bool, rcases_patt → tactic _root_.format
 | _ (one n) := pure $ to_fmt n
 | _ clear := pure "-"
+| _ (explicit p) := do f ← format tt p, pure $ "@" ++ f
 | _ (tuple []) := pure "⟨⟩"
 | _ (tuple ls) := do
   fs ← ls.mmap $ format ff,
@@ -234,19 +241,42 @@ constructor. The `name` is the name which will be used in the top-level `cases`
 `rcases_patt` is the pattern which the field will be matched against by subsequent `cases`
 tactics. -/
 meta def rcases.process_constructor :
-  nat → listΠ rcases_patt → listΠ name × listΠ rcases_patt
-| 0     ps  := ([], [])
-| 1     []  := ([`_], [default])
-| 1     [p] := ([p.name.get_or_else `_], [p])
+  bool → list binder_info → listΠ rcases_patt → listΠ name × listΠ rcases_patt
+| _        []      ps := ([], [])
+| explicit (bi::l) ps :=
+  if !explicit && (bi ≠ binder_info.default) then
+    let (ns, tl) := rcases.process_constructor explicit l ps in
+    (`_ :: ns, default :: tl)
+  else
+    match l, ps with
+    | [], []  := ([`_], [default])
+    | [], [p] := ([p.name.get_or_else `_], [p])
+    -- The interesting case: we matched the last field against multiple
+    -- patterns, so split off the remaining patterns into a subsequent
+    -- match. This handles matching `α × β × γ` against `⟨a, b, c⟩`.
+    | [],   ps  :=
+      ([`_], [cond explicit (rcases_patt.tuple ps).explicit (rcases_patt.tuple ps)])
+    | l, ps  :=
+      let hd := ps.head, (ns, tl) := rcases.process_constructor explicit l ps.tail in
+      (hd.name.get_or_else `_ :: ns, hd :: tl)
+    end
+
+private meta def get_pi_arity_list_aux : expr → tactic (list binder_info)
+| (expr.pi n bi d b) :=
+  do m     ← mk_fresh_name,
+     let l := expr.local_const m n bi d,
+     new_b ← whnf (expr.instantiate_var b l),
+     r     ← get_pi_arity_list_aux new_b,
+     return (bi :: r)
+| e                  := return []
 
--- The interesting case: we matched the last field against multiple
--- patterns, so split off the remaining patterns into a subsequent
--- match. This handles matching `α × β × γ` against `⟨a, b, c⟩`.
-| 1     ps  := ([`_], [rcases_patt.tuple ps])
+/-- Compute the arity of the given (Pi-)type -/
+meta def get_pi_arity_list (type : expr) : tactic (list binder_info) :=
+whnf type >>= get_pi_arity_list_aux
 
-| (n+1) ps  :=
-  let hd := ps.head, (ns, tl) := rcases.process_constructor n ps.tail in
-  (hd.name.get_or_else `_ :: ns, hd :: tl)
+/-- Compute the arity of the given function -/
+meta def get_arity_list (fn : expr) : tactic (list binder_info) :=
+infer_type fn >>= get_pi_arity_list
 
 /-- Takes a list of constructor names, and an (alternation) list of patterns, and matches each
 pattern against its constructor. It returns the list of names that will be passed to `cases`,
@@ -257,15 +287,15 @@ meta def rcases.process_constructors (params : nat) :
   tactic (dlist name × listΣ (name × listΠ rcases_patt))
 | []      ps := pure (dlist.empty, [])
 | (c::cs) ps := do
-  n ← mk_const c >>= get_arity,
-  let (h, t) := (match cs, ps.tail with
+  l ← mk_const c >>= get_arity_list,
+  let ((explicit, h), t) := (match cs, ps.tail with
   -- We matched the last constructor against multiple patterns,
   -- so split off the remaining constructors. This handles matching
   -- `α ⊕ β ⊕ γ` against `a|b|c`.
-  | [], _::_ := ([rcases_patt.alts ps], [])
+  | [], _::_ := ((ff, [rcases_patt.alts ps]), [])
   | _, _ := (ps.head.as_tuple, ps.tail)
   end : _),
-  let (ns, ps) := rcases.process_constructor (n - params) h,
+  let (ns, ps) := rcases.process_constructor explicit (l.drop params) h,
   (l, r) ← rcases.process_constructors cs t,
   pure (dlist.of_list ns ++ l, (c, ps) :: r)
 
@@ -385,7 +415,14 @@ meta def rcases (h : option name) (p : pexpr) (pat : rcases_patt) : tactic unit
     | none := i_to_expr p
     end,
   if e.is_local_constant then
-    focus1 (rcases_core pat e >>= clear_goals)
+    match pat.name with
+    | some x := do
+      n ← revert e,
+      e ← intro x,
+      intron (n - 1),
+      focus1 (rcases_core pat e >>= clear_goals)
+    | none := focus1 (rcases_core pat e >>= clear_goals)
+    end
   else do
     x ← pat.name.elim mk_fresh_name pure,
     n ← revert_kdependencies e semireducible,
@@ -401,7 +438,7 @@ meta def rcases (h : option name) (p : pexpr) (pat : rcases_patt) : tactic unit
 name the arising new variables and assumptions.
 See the module comment for the syntax of `pat`. -/
 meta def rcases_many (ps : listΠ pexpr) (pat : rcases_patt) : tactic unit := do
-  let (_, pats) := rcases.process_constructor ps.length pat.as_tuple,
+  let (_, pats) := rcases.process_constructor ff (ps.map (λ _, default)) pat.as_tuple.2,
   pes ← (ps.zip pats).mmap (λ ⟨p, pat⟩, do
     let p := match pat with
     | rcases_patt.typed _ ty := ``(%%p : %%ty)
@@ -409,7 +446,14 @@ meta def rcases_many (ps : listΠ pexpr) (pat : rcases_patt) : tactic unit := do
     end,
     e ← i_to_expr p,
     if e.is_local_constant then
-      pure (pat, e)
+      match pat.name with
+      | some x := do
+        n ← revert e,
+        e ← intro x,
+        intron (n - 1),
+        pure (pat, e)
+      | none := pure (pat, e)
+      end
     else do
       x ← pat.name.elim mk_fresh_name pure,
       n ← revert_kdependencies e semireducible,
@@ -444,8 +488,10 @@ then we return `c` because we don't know that a case on `c` would be safe to do.
 meta def rcases_patt.merge : rcases_patt → rcases_patt → rcases_patt
 | (rcases_patt.alts p₁) p₂ := rcases_patt.alts (merge_list rcases_patt.merge p₁ p₂.as_alts)
 | p₁ (rcases_patt.alts p₂) := rcases_patt.alts (merge_list rcases_patt.merge p₁.as_alts p₂)
-| (rcases_patt.tuple p₁) p₂ := rcases_patt.tuple (merge_list rcases_patt.merge p₁ p₂.as_tuple)
-| p₁ (rcases_patt.tuple p₂) := rcases_patt.tuple (merge_list rcases_patt.merge p₁.as_tuple p₂)
+| (rcases_patt.explicit p₁) p₂ := rcases_patt.explicit (p₁.merge p₂)
+| p₁ (rcases_patt.explicit p₂) := rcases_patt.explicit (p₁.merge p₂)
+| (rcases_patt.tuple p₁) p₂ := rcases_patt.tuple (merge_list rcases_patt.merge p₁ p₂.as_tuple.2)
+| p₁ (rcases_patt.tuple p₂) := rcases_patt.tuple (merge_list rcases_patt.merge p₁.as_tuple.2 p₂)
 | (rcases_patt.typed p₁ e) p₂ := rcases_patt.typed (p₁.merge p₂) e
 | p₁ (rcases_patt.typed p₂ e) := rcases_patt.typed (p₁.merge p₂) e
 | (rcases_patt.one `rfl) (rcases_patt.one `rfl) := rcases_patt.one `rfl
@@ -471,26 +517,29 @@ meta def rcases_patt.merge : rcases_patt → rcases_patt → rcases_patt
   `depth` and recording the successful cases. It returns `ps`, and the list of generated subgoals.
 -/
 meta mutual def rcases_hint_core, rcases_hint.process_constructors, rcases_hint.continue
-with rcases_hint_core : ℕ → expr → tactic (rcases_patt × list expr)
-| depth e := do
+  (explicit : bool)
+with rcases_hint_core : bool → ℕ → expr → tactic (option rcases_patt × list expr)
+| force depth e := do
   (t, e) ← get_local_and_type e,
+  tt ← pure (explicit || force || (e.local_binding_info = binder_info.default)) |
+    prod.mk none <$> get_goals,
   t ← whnf t,
   env ← get_env,
   let I := t.get_app_fn.const_name,
   (do guard (I = ``eq),
     subst' e,
-    prod.mk (rcases_patt.one `rfl) <$> get_goals) <|>
+    prod.mk (some (rcases_patt.one `rfl)) <$> get_goals) <|>
   (do
     let c := env.constructors_of I,
     some l ← try_core (guard (depth ≠ 0) >> cases_core e) |
       let n := match e.local_pp_name with name.anonymous := `_ | n := n end in
-      prod.mk (rcases_patt.one n) <$> get_goals,
+      prod.mk (some (rcases_patt.one n)) <$> get_goals,
     gs ← get_goals,
     if gs.empty then
-      pure (rcases_patt.tuple [], [])
+      pure (some (rcases_patt.tuple []), [])
     else do
       (ps, gs') ← rcases_hint.process_constructors (depth - 1) c (gs.zip l),
-      pure (rcases_patt.alts₁ ps, gs'))
+      pure (some (rcases_patt.alts₁ ps), gs'))
 
 with rcases_hint.process_constructors : ℕ → listΣ name →
   list (expr × name × listΠ expr × list (name × expr)) →
@@ -509,11 +558,11 @@ with rcases_hint.process_constructors : ℕ → listΣ name →
 with rcases_hint.continue : ℕ → listΠ expr → tactic (listΠ rcases_patt × list expr)
 | depth [] := prod.mk [] <$> get_goals
 | depth (e :: es) := do
-  (p, gs) ← rcases_hint_core depth e,
+  (p, gs) ← rcases_hint_core ff depth e,
   (ps, gs') ← gs.mfoldl (λ (r : listΠ rcases_patt × list expr) g,
     do (ps, gs') ← set_goals [g] >> rcases_hint.continue depth es,
       pure (merge_list rcases_patt.merge r.1 ps, r.2 ++ gs')) ([], []),
-  pure (p :: ps, gs')
+  pure (match p with none := ps | some p := p :: ps end, gs')
 
 /--
 * `rcases? e` is like `rcases e with ...`, except it generates `...` by matching on everything it
@@ -523,7 +572,10 @@ recursive types like `nat`, which can be cased as many times as you like). -/
 meta def rcases_hint (p : pexpr) (depth : nat) : tactic rcases_patt :=
 do e ← i_to_expr p,
   if e.is_local_constant then
-    focus1 $ do (p, gs) ← rcases_hint_core depth e, set_goals gs, pure p
+    focus1 $ do
+      (p, gs) ← rcases_hint_core ff tt depth e,
+      set_goals gs,
+      pure (p.get_or_else default)
   else do
     x ← mk_fresh_name,
     n ← revert_kdependencies e semireducible,
@@ -533,7 +585,10 @@ do e ← i_to_expr p,
       get_local x >>= tactic.revert,
       pure ()),
     h ← tactic.intro1,
-    focus1 $ do (p, gs) ← rcases_hint_core depth h, set_goals gs, pure p
+    focus1 $ do
+      (p, gs) ← rcases_hint_core ff tt depth h,
+      set_goals gs,
+      pure (p.get_or_else default)
 
 /--
 * `rcases? ⟨e1, e2, e3⟩` is like `rcases ⟨e1, e2, e3⟩ with ...`, except it
@@ -556,7 +611,7 @@ do es ← ps.mmap (λ p, do
         pure ()),
       tactic.intro1),
   focus1 $ do
-    (ps, gs) ← rcases_hint.continue depth es,
+    (ps, gs) ← rcases_hint.continue ff depth es,
     set_goals gs,
     pure ps
 
@@ -568,7 +623,7 @@ recursive types like `nat`, which can be cased as many times as you like). -/
 meta def rintro_hint (depth : nat) : tactic (listΠ rcases_patt) :=
 do l ← intros,
   focus1 $ do
-    (p, gs) ← rcases_hint.continue depth l,
+    (p, gs) ← rcases_hint.continue ff depth l,
     set_goals gs,
     pure p
 
@@ -590,7 +645,7 @@ setup_tactic_parser
 ```lean
 patt ::= patt_med (":" expr)?
 patt_med ::= (patt_hi "|")* patt_hi
-patt_hi ::= id | "rfl" | "_" | "⟨" (patt ",")* patt "⟩" | "(" patt ")"
+patt_hi ::= id | "rfl" | "_" | "@" patt_hi | "⟨" (patt ",")* patt "⟩" | "(" patt ")"
 ```
 -/
 meta mutual def
@@ -599,6 +654,7 @@ with rcases_patt_parse_hi' : parser rcases_patt
 | x := ((brackets "(" ")" rcases_patt_parse') <|>
   (rcases_patt.tuple <$> brackets "⟨" "⟩" (sep_by (tk ",") rcases_patt_parse')) <|>
   (tk "-" $> rcases_patt.clear) <|>
+  (tk "@" *> rcases_patt.explicit <$> rcases_patt_parse_hi') <|>
   (rcases_patt.one <$> ident_)) x
 
 with rcases_patt_parse' : parser rcases_patt
@@ -620,7 +676,7 @@ with rcases_patt_parse_list_rest : rcases_patt → parser (listΣ rcases_patt)
 This means only tuples and identifiers are allowed; alternations and type ascriptions
 require `(...)` instead, which switches to `patt`.
 ```lean
-patt_hi ::= id | "rfl" | "_" | "⟨" (patt ",")* patt "⟩" | "(" patt ")"
+patt_hi ::= id | "rfl" | "_" | "@" patt_hi | "⟨" (patt ",")* patt "⟩" | "(" patt ")"
 ```
 -/
 meta def rcases_patt_parse_hi := with_desc "patt_hi" rcases_patt_parse_hi'
@@ -783,6 +839,8 @@ the input expression). An `rcases` pattern has the following grammar:
   of nested conjunctions or existentials. For example if the active hypothesis is `a ∧ b ∧ c`,
   then the conjunction will be destructured, and `p1` will be matched against `a`, `p2` against `b`
   and so on.
+* A `@` before a tuple pattern as in `@⟨p1, p2, p3⟩` will bind all arguments in the constructor,
+  while leaving the `@` off will only use the patterns on the explicit arguments.
 * An alteration pattern `p1 | p2 | p3`, which matches an inductive type with multiple constructors,
   or a nested disjunction like `a ∨ b ∨ c`.
 
@@ -864,8 +922,6 @@ add_tactic_doc
   tags       := ["induction"],
   inherit_description_from := `tactic.interactive.rintro }
 
-setup_tactic_parser
-
 /-- Parses `patt? (: expr)? (:= expr)?`, the arguments for `obtain`.
  (This is almost the same as `rcases_patt_parse`,
 but it allows the pattern part to be empty.) -/
@@ -931,5 +987,34 @@ add_tactic_doc
   decl_names := [`tactic.interactive.obtain],
   tags       := ["induction"] }
 
+/--
+The `rsuffices` tactic is an alternative version of `suffices`, that allows the usage
+of any syntax that would be valid in an `obtain` block. This tactic just calls `obtain`
+on the expression, and then `rotate 1`.
+-/
+meta def rsuffices (h : parse obtain_parse) : tactic unit :=
+focus1 $ obtain h >> tactic.rotate 1
+
+add_tactic_doc
+{ name       := "rsuffices",
+  category   := doc_category.tactic,
+  decl_names := [`tactic.interactive.rsuffices],
+  tags       := ["induction"] }
+
+/--
+The `rsufficesI` tactic is an instance-cache aware version of `rsuffices`; it resets the instance
+cache on the resulting goals.
+-/
+
+meta def rsufficesI (h : parse obtain_parse) : tactic unit :=
+rsuffices h ; resetI
+
+add_tactic_doc
+{ name       := "rsufficesI",
+  category   := doc_category.tactic,
+  decl_names := [`tactic.interactive.rsufficesI],
+  tags       := ["induction", "type class"] }
+
+
 end interactive
 end tactic
diff --git a/src/tactic/reassoc_axiom.lean b/src/tactic/reassoc_axiom.lean
index 3f07919e3d73f..100b4a130be59 100644
--- a/src/tactic/reassoc_axiom.lean
+++ b/src/tactic/reassoc_axiom.lean
@@ -172,8 +172,6 @@ add_tactic_doc
 
 namespace interactive
 
-setup_tactic_parser
-
 /-- `reassoc h`, for assumption `h : x ≫ y = z`, creates a new assumption
 `h : ∀ {W} (f : Z ⟶ W), x ≫ y ≫ f = z ≫ f`.
 `reassoc! h`, does the same but deletes the initial `h` assumption.
diff --git a/src/tactic/replacer.lean b/src/tactic/replacer.lean
index 4d4d394475367..f5c16ce185cff 100644
--- a/src/tactic/replacer.lean
+++ b/src/tactic/replacer.lean
@@ -14,8 +14,8 @@ meaning is defined incrementally through attributes.
 
 namespace tactic
 
-meta def replacer_core {α : Type} [reflected α]
-  (ntac : name) (eval : ∀ β [reflected β], expr → tactic β) :
+meta def replacer_core {α : Type} [reflected _ α]
+  (ntac : name) (eval : ∀ β [reflected _ β], expr → tactic β) :
   list name → tactic α
 | [] := fail ("no implementation defined for " ++ to_string ntac)
 | (n::ns) := do d ← get_decl n, let t := d.type,
@@ -26,8 +26,8 @@ meta def replacer_core {α : Type} [reflected α]
             return (tac (guard (ns ≠ []) >> some (replacer_core ns))) },
   tac
 
-meta def replacer (ntac : name) {α : Type} [reflected α]
-  (F : Type → Type) (eF : ∀ β, reflected β → reflected (F β))
+meta def replacer (ntac : name) {α : Type} [reflected _ α]
+  (F : Type → Type) (eF : ∀ β, reflected _ β → reflected _ (F β))
   (R : ∀ β, F β → β) : tactic α :=
 attribute.get_instances ntac >>= replacer_core ntac
   (λ β eβ e, R β <$> @eval_expr' (F β) (eF β eβ) e)
@@ -47,7 +47,7 @@ meta def mk_replacer₂ (ntac : name) (v : expr × expr) : expr → nat → opti
     reflect ntac, β, reflect β,
     expr.lam `γ binder_info.default `(Type) v.1,
     expr.lam `γ binder_info.default `(Type) $
-    expr.lam `eγ binder_info.inst_implicit ((`(@reflected Type) : expr) β) v.2,
+    expr.lam `eγ binder_info.inst_implicit ((`(reflected Type) : expr) β) v.2,
     expr.lam `γ binder_info.default `(Type) $
     expr.lam `f binder_info.default v.1 $
     (list.range i).foldr (λ i e', e' (expr.var (i+2))) (expr.var 0)
diff --git a/src/tactic/reserved_notation.lean b/src/tactic/reserved_notation.lean
index ef38b2b65197e..d34358ece4121 100644
--- a/src/tactic/reserved_notation.lean
+++ b/src/tactic/reserved_notation.lean
@@ -58,3 +58,6 @@ reserve infixl ` ⊔ `:68
 
 -- used in `algebra/module/linear_map.lean`
 reserve infix ` ≃ₗ `:25
+
+-- used in `data/matrix/notation.lean`
+reserve notation `!![`
diff --git a/src/tactic/rewrite.lean b/src/tactic/rewrite.lean
index 6fee7e9216cb9..8398ceae981d8 100644
--- a/src/tactic/rewrite.lean
+++ b/src/tactic/rewrite.lean
@@ -204,7 +204,7 @@ It works for any function `f` for which an `is_associative f` instance can be fo
 
 ```
 example {α : Type*} (f : α → α → α) [is_associative α f] (a b c d x : α) :
-  let infix `~` := f in
+  let infix ` ~ ` := f in
   b ~ c = x → (a ~ b ~ c ~ d) = (a ~ x ~ d) :=
 begin
   intro h,
diff --git a/src/tactic/rewrite_search/explain.lean b/src/tactic/rewrite_search/explain.lean
index 3eb86118bfb10..37490a29fe49b 100644
--- a/src/tactic/rewrite_search/explain.lean
+++ b/src/tactic/rewrite_search/explain.lean
@@ -243,7 +243,7 @@ do let rws : list (expr × bool) := list.join $ l.map (λ u, do
 
 /--
 Trace a human-readable explanation in Lean code of a proof generated by rewrite search.
-Emit it as "Try this: " with each successive line of code indented.
+Emit it as `"Try this: "` with each successive line of code indented.
 -/
 meta def explain_search_result (cfg : config) (rules : list (expr × bool)) (proof : expr)
   (units : list proof_unit) : tactic unit :=
diff --git a/src/tactic/rewrite_search/frontend.lean b/src/tactic/rewrite_search/frontend.lean
index a3f8b4b7a9d5c..9c5398a8e1ad1 100644
--- a/src/tactic/rewrite_search/frontend.lean
+++ b/src/tactic/rewrite_search/frontend.lean
@@ -82,6 +82,6 @@ add_tactic_doc
 { name        := "rewrite_search",
   category    := doc_category.tactic,
   decl_names  := [`tactic.interactive.rewrite_search],
-  tags        := ["rewriting", "automation"] }
+  tags        := ["rewriting", "search"] }
 
 end tactic.interactive
diff --git a/src/tactic/ring.lean b/src/tactic/ring.lean
index 82a18559f2a72..4dcb10f74db63 100644
--- a/src/tactic/ring.lean
+++ b/src/tactic/ring.lean
@@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 import tactic.norm_num
+import data.fin.basic
 
 /-!
 # `ring`
@@ -431,6 +432,17 @@ do c ← get_cache,
   return (xadd' c (const α1 1) (e, i) (`(1), 1) (const α0 0),
     c.cs_app ``horner_atom [e])
 
+/-- Evaluate `a` where `a` is an atom. -/
+meta def eval_norm_atom (norm_atom : expr → tactic (expr × expr))
+  (e : expr) : ring_m (horner_expr × expr) :=
+do o ← lift $ try_core (guard (e.get_app_args.length > 0) >> norm_atom e),
+  match o with
+  | none := eval_atom e
+  | some (e', p) := do
+    (e₂, p₂) ← eval_atom e',
+    prod.mk e₂ <$> lift (mk_eq_trans p p₂)
+  end
+
 lemma subst_into_pow {α} [monoid α] (l r tl tr t)
   (prl : (l : α) = tl) (prr : (r : ℕ) = tr) (prt : tl ^ tr = t) : l ^ r = t :=
 by rw [prl, prr, prt]
@@ -445,7 +457,7 @@ by rw [div_eq_mul_inv, h]
 
 /-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
 equality. -/
-meta def eval : expr → ring_m (horner_expr × expr)
+meta def eval (norm_atom : expr → tactic (expr × expr)) : expr → ring_m (horner_expr × expr)
 | `(%%e₁ + %%e₂) := do
   (e₁', p₁) ← eval e₁,
   (e₂', p₂) ← eval e₂,
@@ -460,7 +472,7 @@ meta def eval : expr → ring_m (horner_expr × expr)
       (e', p) ← eval e,
       p' ← ic_lift $ λ ic, ic.mk_app ``unfold_sub [e₁, e₂, e', p],
       return (e', p'))
-    (eval_atom e)
+    (eval_norm_atom norm_atom e)
 | `(- %%e) := do
   (e₁, p₁) ← eval e,
   (e₂, p₂) ← eval_neg e₁,
@@ -475,7 +487,7 @@ meta def eval : expr → ring_m (horner_expr × expr)
 | e@`(has_inv.inv %%_) := (do
     (e', p) ← lift $ norm_num.derive e <|> refl_conv e,
     n ← lift $ e'.to_rat,
-    return (const e' n, p)) <|> eval_atom e
+    return (const e' n, p)) <|> eval_norm_atom norm_atom e
 | e@`(@has_div.div _ %%inst %%e₁ %%e₂) := mcond
   (succeeds (do
     inst' ← ic_lift $ λ ic, ic.mk_app ``div_inv_monoid.to_has_div [],
@@ -486,27 +498,32 @@ meta def eval : expr → ring_m (horner_expr × expr)
     (e', p) ← eval e,
     p' ← ic_lift $ λ ic, ic.mk_app ``unfold_div [e₁, e₂, e', p],
     return (e', p'))
-  (eval_atom e)
-| e@`(@has_pow.pow _ _ %%P %%e₁ %%e₂) := do
-  (e₂', p₂) ← lift $ norm_num.derive e₂ <|> refl_conv e₂,
-  match e₂'.to_nat, P with
-  | some k, `(monoid.has_pow) := do
-    (e₁', p₁) ← eval e₁,
-    (e', p') ← eval_pow e₁' (e₂, k),
-    p ← ic_lift $ λ ic, ic.mk_app ``subst_into_pow [e₁, e₂, e₁', e₂', e', p₁, p₂, p'],
-    return (e', p)
-  | _, _ := eval_atom e
-  end
+  (eval_norm_atom norm_atom e)
+| e@`(@has_pow.pow _ _ %%inst %%e₁ %%e₂) := mcond
+  (succeeds (do
+    inst' ← ic_lift $ λ ic, ic.mk_app ``monoid.has_pow [],
+    lift $ is_def_eq inst inst'))
+  (do
+    (e₂', p₂) ← lift $ norm_num.derive e₂ <|> refl_conv e₂,
+    match e₂'.to_nat with
+    | some k := do
+      (e₁', p₁) ← eval e₁,
+      (e', p') ← eval_pow e₁' (e₂, k),
+      p ← ic_lift $ λ ic, ic.mk_app ``subst_into_pow [e₁, e₂, e₁', e₂', e', p₁, p₂, p'],
+      return (e', p)
+    | _ := eval_norm_atom norm_atom e
+    end)
+  (eval_norm_atom norm_atom e)
 | e := match e.to_nat with
-  | some n := (const e (rat.of_int n)).refl_conv
-  | none := eval_atom e
+  | some n := (const e n).refl_conv
+  | none := eval_norm_atom norm_atom e
   end
 
 /-- Evaluate a ring expression `e` recursively to normal form, together with a proof of
 equality. -/
 meta def eval' (red : transparency) (atoms : ref (buffer expr))
-  (e : expr) : tactic (expr × expr) :=
-ring_m.run' red atoms e $ do (e', p) ← eval e, return (e', p)
+  (norm_atom : expr → tactic (expr × expr)) (e : expr) : tactic (expr × expr) :=
+ring_m.run' red atoms e $ do (e', p) ← eval norm_atom e, return (e', p)
 
 theorem horner_def' {α} [comm_semiring α] (a x n b) : @horner α _ a x n b = x ^ n * a + b :=
 by simp [horner, mul_comm]
@@ -540,10 +557,22 @@ inductive normalize_mode | raw | SOP | horner
 instance : inhabited normalize_mode := ⟨normalize_mode.horner⟩
 
 /-- A `ring`-based normalization simplifier that rewrites ring expressions into the specified mode.
-  See `normalize`. This version takes a list of atoms to persist across multiple calls. -/
+See `normalize`. This version takes a list of atoms to persist across multiple calls.
+
+* `atoms`: a mutable reference containing the atom set from the previous call
+* `red`: the reducibility setting to use when comparing atoms for defeq
+* `mode`: the normalization style (see `normalize_mode`)
+* `recursive`: if true, atoms will be reduced recursively using `normalize'`
+* `e`: the expression to normalize
+* `inner`: This should be set to `ff`. It is used internally to disable normalization
+  at the top level when called from `eval` in order to prevent an infinite loop
+  `eval' -> eval_atom -> normalize' -> eval'` when called on something that can't
+  be simplified like `x`.
+-/
 meta def normalize' (atoms : ref (buffer expr))
-  (red : transparency) (mode := normalize_mode.horner) (e : expr) : tactic (expr × expr) :=
-do
+  (red : transparency) (mode := normalize_mode.horner) (recursive := tt) :
+  expr → opt_param _ ff → tactic (expr × expr)
+| e inner := do
   pow_lemma ← simp_lemmas.mk.add_simp ``pow_one,
   let lemmas := match mode with
   | normalize_mode.SOP :=
@@ -563,10 +592,12 @@ do
       pure (e', pr))
     (λ e, do
       a ← read_ref atoms,
+      let norm_rec := if recursive then λ e, normalize' e tt else λ _, failed,
       (a, e', pr) ← ext_simplify_core a {}
-        simp_lemmas.mk (λ _, failed) (λ a _ _ _ e, do
+        simp_lemmas.mk (λ _, failed) (λ a _ _ p e, do
+          guard (inner → p.is_some),
           write_ref atoms a,
-          (new_e, pr) ← eval' red atoms e,
+          (new_e, pr) ← eval' red atoms norm_rec e,
           (new_e, pr) ← match mode with
           | normalize_mode.raw := λ _, pure (new_e, pr)
           | normalize_mode.horner := trans_conv (λ _, pure (new_e, pr))
@@ -594,9 +625,15 @@ do
     This results in terms like `(3 * x ^ 2 * y + 1) * x + y`.
   * `SOP` means sum of products form, expanding everything to monomials.
     This results in terms like `3 * x ^ 3 * y + x + y`. -/
-meta def normalize (red : transparency) (mode := normalize_mode.horner) (e : expr) :
-  tactic (expr × expr) :=
-using_new_ref mk_buffer $ λ atoms, normalize' atoms red mode e
+meta def normalize (red : transparency) (mode := normalize_mode.horner)
+  (recursive := tt) (e : expr) : tactic (expr × expr) :=
+using_new_ref mk_buffer $ λ atoms, normalize' atoms red mode recursive e
+
+/-- Configuration for `ring_nf`.
+
+  * `recursive`: if true, atoms inside ring expressions will be reduced recursively
+-/
+@[derive inhabited] structure ring_nf_cfg := (recursive := tt)
 
 end ring
 
@@ -613,7 +650,7 @@ meta def ring1 (red : parse (tk "!")?) : tactic unit :=
 let transp := if red.is_some then semireducible else reducible in
 do `(%%e₁ = %%e₂) ← target >>= instantiate_mvars,
   ((e₁', p₁), (e₂', p₂)) ← ring_m.run transp e₁ $
-    prod.mk <$> eval e₁ <*> eval e₂,
+    prod.mk <$> eval (λ _, failed) e₁ <*> eval (λ _, failed) e₂,
   is_def_eq e₁' e₂',
   p ← mk_eq_symm p₂ >>= mk_eq_trans p₁,
   tactic.exact p
@@ -636,12 +673,12 @@ which rewrites all ring expressions into a normal form. When writing a normal fo
 `ring_nf SOP` will use sum-of-products form instead of horner form.
 `ring_nf!` will use a more aggressive reducibility setting to identify atoms.
 -/
-meta def ring_nf (red : parse (tk "!")?) (SOP : parse ring.mode) (loc : parse location) :
-  tactic unit :=
+meta def ring_nf (red : parse (tk "!")?) (SOP : parse ring.mode) (loc : parse location)
+  (cfg : ring_nf_cfg := {}) : tactic unit :=
 do ns ← loc.get_locals,
    let transp := if red.is_some then semireducible else reducible,
    tt ← using_new_ref mk_buffer $ λ atoms,
-     tactic.replace_at (normalize' atoms transp SOP) ns loc.include_goal
+     tactic.replace_at (normalize' atoms transp SOP cfg.recursive) ns loc.include_goal
    | fail "ring_nf failed to simplify",
    when loc.include_goal $ try tactic.reflexivity
 
@@ -677,14 +714,15 @@ open conv interactive
 open tactic tactic.interactive (ring.mode ring1)
 open tactic.ring (normalize normalize_mode.horner)
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 /--
 Normalises expressions in commutative (semi-)rings inside of a `conv` block using the tactic `ring`.
 -/
-meta def ring_nf (red : parse (lean.parser.tk "!")?) (SOP : parse ring.mode) : conv unit :=
+meta def ring_nf (red : parse (lean.parser.tk "!")?) (SOP : parse ring.mode)
+  (cfg : ring.ring_nf_cfg := {}) : conv unit :=
 let transp := if red.is_some then semireducible else reducible in
-replace_lhs (normalize transp SOP)
+replace_lhs (normalize transp SOP cfg.recursive)
 <|> fail "ring_nf failed to simplify"
 
 /--
diff --git a/src/tactic/ring2.lean b/src/tactic/ring2.lean
index e035886136b18..044ea34dd20a9 100644
--- a/src/tactic/ring2.lean
+++ b/src/tactic/ring2.lean
@@ -475,7 +475,7 @@ namespace interactive
 open interactive interactive.types lean.parser
 open tactic.ring2
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 /-- `ring2` solves equations in the language of rings.
 
diff --git a/src/tactic/ring_exp.lean b/src/tactic/ring_exp.lean
index 42f2f55f91f72..8ee73b46356a9 100644
--- a/src/tactic/ring_exp.lean
+++ b/src/tactic/ring_exp.lean
@@ -1003,7 +1003,8 @@ meta def pow_coeff (p_p q_p : expr) (p q : coeff) : ring_exp_m (ex prod) := do
   ctx ← get_context,
   pq' ← mk_pow [p_p, q_p],
   (pq_p, pq_pf) ← lift $ norm_num.eval_pow pq',
-  pure $ ex.coeff ⟨pq_p, pq_p, pq_pf⟩ ⟨p.1 * q.1⟩
+  if q.value.denom ≠ 1 then lift $ fail!"Only integer powers are supported, not {q.value}."
+  else pure $ ex.coeff ⟨pq_p, pq_p, pq_pf⟩ ⟨p.1 ^ q.value.num⟩
 
 /--
 Exponentiate two expressions.
@@ -1408,16 +1409,17 @@ meta def eval : expr → ring_exp_m (ex sum)
   pf ← mk_app_class ``div_pf dri [ps, qs, psqs.pretty, psqs_pf],
   pure (psqs.set_info e pf)) <|> eval_base e
 | e@`(@has_pow.pow _ _ %%hp_instance %%ps %%qs) := do
+  ctx ← get_context,
   ps' ← eval ps,
   qs' ← in_exponent $ eval qs,
   psqs ← pow ps' qs',
   psqs_pf ← psqs.proof_term,
-  (do has_pow_pf ← match hp_instance with
-  | `(monoid.has_pow) := lift $ mk_eq_refl e
-  | _ := lift $ fail "has_pow instance must be nat.has_pow or monoid.has_pow"
-  end,
-  pf ← lift $ mk_eq_trans has_pow_pf psqs_pf,
-  pure $ psqs.set_info e pf) <|> eval_base e
+  (do
+    lift (is_def_eq hp_instance ctx.info_b.hp_instance
+          <|> fail "has_pow instance must be nat.has_pow or monoid.has_pow"),
+    has_pow_pf ← lift $ mk_eq_refl e,
+    pf ← lift $ mk_eq_trans has_pow_pf psqs_pf,
+    pure $ psqs.set_info e pf) <|> eval_base e
 | ps := eval_base ps
 
 /--
@@ -1477,7 +1479,7 @@ end tactic.ring_exp
 namespace tactic.interactive
 open interactive interactive.types lean.parser tactic tactic.ring_exp
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 /--
 Tactic for solving equations of *commutative* (semi)rings,
@@ -1543,7 +1545,7 @@ open conv interactive
 open tactic tactic.interactive (ring_exp_eq)
 open tactic.ring_exp (normalize)
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 /--
 Normalises expressions in commutative (semi-)rings inside of a `conv` block using the tactic
diff --git a/src/tactic/simpa.lean b/src/tactic/simpa.lean
index 2f90df9cf89d1..0d0ab4a381357 100644
--- a/src/tactic/simpa.lean
+++ b/src/tactic/simpa.lean
@@ -12,7 +12,7 @@ namespace tactic
 namespace interactive
 open expr lean.parser
 
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 
 /--
 This is a "finishing" tactic modification of `simp`. It has two forms.
diff --git a/src/tactic/simps.lean b/src/tactic/simps.lean
index 167adf136e985..b66df7fc71e1c 100644
--- a/src/tactic/simps.lean
+++ b/src/tactic/simps.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn
 -/
 import tactic.protected
-import algebra.group.to_additive
+import tactic.to_additive
 
 /-!
 # simps attribute
@@ -560,7 +560,7 @@ meta def simps_get_projection_exprs (e : environment) (tgt : expr)
 /-- Add a lemma with `nm` stating that `lhs = rhs`. `type` is the type of both `lhs` and `rhs`,
   `args` is the list of local constants occurring, and `univs` is the list of universe variables. -/
 meta def simps_add_projection (nm : name) (type lhs rhs : expr) (args : list expr)
-  (univs : list name) (cfg : simps_cfg) : tactic unit := do
+  (univs : list name) (cfg : simps_cfg) : tactic (list name) := do
   when_tracing `simps.debug trace!
     "[simps] > Planning to add the equality\n        > {lhs} = ({rhs} : {type})",
   lvl ← get_univ_level type,
@@ -587,7 +587,8 @@ meta def simps_add_projection (nm : name) (type lhs rhs : expr) (args : list exp
   when (b ∧ `simp ∈ cfg.attrs) (set_basic_attribute `_refl_lemma decl_name tt),
   cfg.attrs.mmap' $ λ nm, set_attribute nm decl_name tt,
   when cfg.add_additive.is_some $
-    to_additive.attr.set decl_name ⟨ff, cfg.trace, cfg.add_additive.iget, none, tt⟩ tt
+    to_additive.attr.set decl_name ⟨ff, cfg.trace, cfg.add_additive.iget, none, tt⟩ tt,
+  pure [decl_name]
 
 /-- Derive lemmas specifying the projections of the declaration.
   If `todo` is non-empty, it will generate exactly the names in `todo`.
@@ -595,7 +596,7 @@ meta def simps_add_projection (nm : name) (type lhs rhs : expr) (args : list exp
   was just used. In that case we need to apply these projections before we continue changing lhs. -/
 meta def simps_add_projections : Π (e : environment) (nm : name)
   (type lhs rhs : expr) (args : list expr) (univs : list name) (must_be_str : bool)
-  (cfg : simps_cfg) (todo : list string) (to_apply : list ℕ), tactic unit
+  (cfg : simps_cfg) (todo : list string) (to_apply : list ℕ), tactic (list name)
 | e nm type lhs rhs args univs must_be_str cfg todo to_apply := do
   -- we don't want to unfold non-reducible definitions (like `set`) to apply more arguments
   when_tracing `simps.debug trace!
@@ -615,18 +616,19 @@ meta def simps_add_projections : Π (e : environment) (nm : name)
   if e.is_structure str ∧ ¬(todo = [] ∧ str ∈ cfg.not_recursive ∧ ¬must_be_str) then do
     [intro] ← return $ e.constructors_of str | fail "unreachable code (3)",
     rhs_whnf ← whnf rhs_ap cfg.rhs_md,
-    (rhs_ap, todo_now) ← -- `todo_now` means that we still have to generate the current simp lemma
+    -- `todo_now` means that we still have to generate the current simp lemma
+    (rhs_ap, todo_now, added_lems_requested) ←
       if ¬ is_constant_of rhs_ap.get_app_fn intro ∧
-        is_constant_of rhs_whnf.get_app_fn intro then
+        is_constant_of rhs_whnf.get_app_fn intro then do
       /- If this was a desired projection, we want to apply it before taking the whnf.
         However, if the current field is an eta-expansion (see below), we first want
         to eta-reduce it and only then construct the projection.
         This makes the flow of this function messy. -/
-      when ("" ∈ todo ∧ to_apply = []) (if cfg.fully_applied then
+      added_lems_requested ← cond ("" ∈ todo ∧ to_apply = []) (if cfg.fully_applied then
         simps_add_projection nm tgt lhs_ap rhs_ap new_args univs cfg else
-        simps_add_projection nm type lhs rhs args univs cfg) >>
-      return (rhs_whnf, ff) else
-      return (rhs_ap, "" ∈ todo ∧ to_apply = []),
+        simps_add_projection nm type lhs rhs args univs cfg) (pure []),
+      return (rhs_whnf, ff, added_lems_requested) else
+      return (rhs_ap, "" ∈ todo ∧ to_apply = [], []),
     if is_constant_of (get_app_fn rhs_ap) intro then do -- if the value is a constructor application
       proj_info ← simps_get_projection_exprs e tgt rhs_ap cfg,
       when_tracing `simps.debug trace!"[simps] > Raw projection information:\n  {proj_info}",
@@ -635,12 +637,12 @@ meta def simps_add_projections : Π (e : environment) (nm : name)
       /- As a special case, we want to automatically generate the current projection if `rhs_ap`
         was an eta-expansion. Also, when this was a desired projection, we need to generate the
         current projection if we haven't done it above. -/
-      when (todo_now ∨ (todo = [] ∧ eta.is_some ∧ to_apply = [])) $
-        if cfg.fully_applied then
+      added_lems_eta ← cond (todo_now ∨ (todo = [] ∧ eta.is_some ∧ to_apply = []))
+        (if cfg.fully_applied then
           simps_add_projection nm tgt lhs_ap rhs_ap new_args univs cfg else
-          simps_add_projection nm type lhs rhs args univs cfg,
+          simps_add_projection nm type lhs rhs args univs cfg) (return []),
       /- If we are in the middle of a composite projection. -/
-      when (to_apply ≠ []) $ do
+      added_lems_custom_proj ← cond (to_apply ≠ []) (do
       { ⟨new_rhs, proj, proj_expr, proj_nrs, is_default, is_prefix⟩ ←
           return $ proj_info.inth to_apply.head,
         new_type ← infer_type new_rhs,
@@ -648,10 +650,11 @@ meta def simps_add_projections : Π (e : environment) (nm : name)
           trace!"[simps] > Applying a custom composite projection. Current lhs:
         >  {lhs_ap}",
         simps_add_projections e nm new_type lhs_ap new_rhs new_args univs ff cfg todo
-          to_apply.tail },
+          to_apply.tail }) (pure []),
+      let all_added_lems := added_lems_requested ++ added_lems_eta ++ added_lems_custom_proj,
       /- We stop if no further projection is specified or if we just reduced an eta-expansion and we
       automatically choose projections -/
-      when ¬(to_apply ≠ [] ∨ todo = [""] ∨ (eta.is_some ∧ todo = [])) $ do
+      cond (¬(to_apply ≠ [] ∨ todo = [""] ∨ (eta.is_some ∧ todo = []))) (do
         let projs : list name := proj_info.map $ λ x, x.snd.name,
         let todo := if to_apply = [] then todo_next else todo,
         -- check whether all elements in `todo` have a projection as prefix
@@ -666,13 +669,13 @@ The known projections are:
 You can also see this information by running
   `initialize_simps_projections? {str}`.
 Note: these projection names might not correspond to the projection names of the structure.",
-        proj_info.mmap_with_index' $
-          λ proj_nr ⟨new_rhs, proj, proj_expr, proj_nrs, is_default, is_prefix⟩, do
+        added_lems_list ← proj_info.mmap_with_index
+          (λ proj_nr ⟨new_rhs, proj, proj_expr, proj_nrs, is_default, is_prefix⟩, do
           new_type ← infer_type new_rhs,
           let new_todo :=
             todo.filter_map $ λ x, x.get_rest ("_" ++ proj.last),
           -- we only continue with this field if it is non-propositional or mentioned in todo
-          when ((is_default ∧ todo = []) ∨ new_todo ≠ []) $ do
+          cond ((is_default ∧ todo = []) ∨ new_todo ≠ []) (do
             let new_lhs := proj_expr.instantiate_lambdas_or_apps [lhs_ap],
             let new_nm := nm.append_to_last proj.last is_prefix,
             let new_cfg := { add_additive := cfg.add_additive.map $
@@ -680,15 +683,17 @@ Note: these projection names might not correspond to the projection names of the
             when_tracing `simps.debug trace!"[simps] > Recursively add projections for:
         >  {new_lhs}",
             simps_add_projections e new_nm new_type new_lhs new_rhs new_args univs
-              ff new_cfg new_todo proj_nrs
+              ff new_cfg new_todo proj_nrs) (pure [])),
+          pure $ all_added_lems ++ added_lems_list.join) (pure all_added_lems)
     -- if I'm about to run into an error, try to set the transparency for `rhs_md` higher.
     else if cfg.rhs_md = transparency.none ∧ (must_be_str ∨ todo_next ≠ [] ∨ to_apply ≠ []) then do
       when cfg.trace trace!
         "[simps] > The given definition is not a constructor application:
         >   {rhs_ap}
         > Retrying with the options {{ rhs_md := semireducible, simp_rhs := tt}.",
-      simps_add_projections e nm type lhs rhs args univs must_be_str
-        { rhs_md := semireducible, simp_rhs := tt, ..cfg} todo to_apply
+      added_lems_recursive ← simps_add_projections e nm type lhs rhs args univs must_be_str
+        { rhs_md := semireducible, simp_rhs := tt, ..cfg} todo to_apply,
+      pure $ added_lems_requested ++ added_lems_recursive
     else do
       when (to_apply ≠ []) $
         fail!"Invalid simp lemma {nm}.
@@ -698,9 +703,10 @@ The given definition is not a constructor application:\n  {rhs_ap}",
       when (todo_next ≠ []) $
         fail!"Invalid simp lemma {nm.append_suffix todo_next.head}.
 The given definition is not a constructor application:\n  {rhs_ap}",
-      if cfg.fully_applied then
+      added_lems_no_constructor ← if cfg.fully_applied then
         simps_add_projection nm tgt lhs_ap rhs_ap new_args univs cfg else
-        simps_add_projection nm type lhs rhs args univs cfg
+        simps_add_projection nm type lhs rhs args univs cfg,
+      pure $ added_lems_requested ++ added_lems_no_constructor
   else do
     when must_be_str $
       fail!"Invalid `simps` attribute. Target {str} is not a structure",
@@ -712,6 +718,15 @@ Projection {(first_todo.split_on '_').tail.head} doesn't exist, because target i
       simps_add_projection nm tgt lhs_ap rhs_ap new_args univs cfg else
       simps_add_projection nm type lhs rhs args univs cfg
 
+/--
+The `@[_simps_aux]` attribute specifies which lemmas are added by `simps`.
+This should not be used manually and it only exists for mathport
+-/
+@[user_attribute] meta def simps_aux : user_attribute unit (list name) :=
+{ name := `_simps_aux,
+  descr := "An attribute specifying the added simps lemmas.",
+  parser := failed }
+
 /-- `simps_tac` derives `simp` lemmas for all (nested) non-Prop projections of the declaration.
   If `todo` is non-empty, it will generate exactly the names in `todo`.
   If `short_nm` is true, the generated names will only use the last projection name.
@@ -730,7 +745,9 @@ meta def simps_tac (nm : name) (cfg : simps_cfg := {}) (todo : list string := []
       trace!"[simps] > @[to_additive] will be added to all generated lemmas.",
     return { add_additive := dict.find nm, ..cfg } } else
     return cfg,
-  simps_add_projections e nm d.type lhs d.value [] d.univ_params tt cfg todo []
+  added_names ← simps_add_projections e nm d.type lhs d.value [] d.univ_params tt cfg todo [],
+  simps_aux.set nm added_names true
+
 
 /-- The parser for the `@[simps]` attribute. -/
 meta def simps_parser : parser (bool × list string × simps_cfg) := do
diff --git a/src/tactic/solve_by_elim.lean b/src/tactic/solve_by_elim.lean
index 64b25d398cc8a..b51b2f5c7490c 100644
--- a/src/tactic/solve_by_elim.lean
+++ b/src/tactic/solve_by_elim.lean
@@ -132,7 +132,7 @@ A helper function for trace messages, prepending '....' depending on the current
 -/
 meta def solve_by_elim_trace (n : ℕ) (f : format) : tactic unit :=
 trace_if_enabled `solve_by_elim
-  (format!"[solve_by_elim {(list.repeat '.' (n+1)).as_string} " ++ f ++ "]")
+  (format!"[solve_by_elim {(list.replicate (n+1) '.').as_string} " ++ f ++ "]")
 
 /-- A helper function to generate trace messages on successful applications. -/
 meta def on_success (g : format) (n : ℕ) (e : expr) : tactic unit :=
@@ -273,13 +273,13 @@ Optional arguments:
   the next one will be attempted.
 -/
 meta def apply_assumption
-  (lemmas : option (list expr) := none)
+  (lemmas : parse pexpr_list?)
   (opt : apply_any_opt := {})
   (tac : tactic unit := skip) : tactic unit :=
 do
   lemmas ← match lemmas with
   | none := local_context
-  | some lemmas := return lemmas
+  | some lemmas := lemmas.mmap to_expr
   end,
   tactic.apply_any lemmas opt tac
 
diff --git a/src/tactic/split_ifs.lean b/src/tactic/split_ifs.lean
index dd06561183e13..e96604ceea6a0 100644
--- a/src/tactic/split_ifs.lean
+++ b/src/tactic/split_ifs.lean
@@ -27,11 +27,6 @@ lctx ← at_.get_locals, lctx ← lctx.mmap infer_type, tgt ← target,
 let es := if at_.include_goal then tgt::lctx else lctx,
 return $ find_if_cond $ es.foldr app default
 
-run_cmd mk_simp_attr `split_if_reduction
-run_cmd add_doc_string `simp_attr.split_if_reduction "Simp set for if-then-else statements"
-
-attribute [split_if_reduction] if_pos if_neg dif_pos dif_neg if_congr
-
 meta def reduce_ifs_at (at_ : loc) : tactic unit := do
 sls ← get_user_simp_lemmas `split_if_reduction,
 let cfg : simp_config := { fail_if_unchanged := ff },
diff --git a/src/tactic/subtype_instance.lean b/src/tactic/subtype_instance.lean
index e8209db65bb77..5160037818792 100644
--- a/src/tactic/subtype_instance.lean
+++ b/src/tactic/subtype_instance.lean
@@ -24,7 +24,7 @@ do
   field ← get_current_field,
   b ← target >>= is_prop,
   if b then  do
-    `[simp [subtype.ext_iff_val], dsimp [set.set_coe_eq_subtype]],
+    `[simp [subtype.ext_iff_val], dsimp [set.coe_eq_subtype]],
     intros,
     applyc field; assumption
   else do
diff --git a/src/tactic/tauto.lean b/src/tactic/tauto.lean
index 006db7de1906f..7bd627e1dec77 100644
--- a/src/tactic/tauto.lean
+++ b/src/tactic/tauto.lean
@@ -22,13 +22,14 @@ do hs ← local_context,
       do h ← get_local h.local_pp_name,
          e ← infer_type h,
          match e with
-         | `(¬ _ = _) := replace h.local_pp_name ``(mt iff.to_eq %%h)
-         | `(_ ≠ _)   := replace h.local_pp_name ``(mt iff.to_eq %%h)
-         | `(_ = _)   := replace h.local_pp_name ``(eq.to_iff %%h)
-         | `(¬ (_ ∧ _))  := replace h.local_pp_name ``(decidable.not_and_distrib'.mp %%h) <|>
-                            replace h.local_pp_name ``(decidable.not_and_distrib.mp %%h)
-         | `(¬ (_ ∨ _))  := replace h.local_pp_name ``(not_or_distrib.mp %%h)
-         | `(¬ ¬ _)      := replace h.local_pp_name ``(decidable.of_not_not %%h)
+         | `(¬ _ = _)   := replace h.local_pp_name ``(mt iff.to_eq %%h)
+         | `(_ ≠ _)     := replace h.local_pp_name ``(mt iff.to_eq %%h)
+         | `(_ = _)     := replace h.local_pp_name ``(eq.to_iff %%h)
+         | `(¬ (_ ∧ _)) := replace h.local_pp_name ``(decidable.not_and_distrib'.mp %%h) <|>
+                           replace h.local_pp_name ``(decidable.not_and_distrib.mp %%h)
+         | `(¬ (_ ∨ _)) := replace h.local_pp_name ``(not_or_distrib.mp %%h)
+         | `(¬ _ ≠ _)   := replace h.local_pp_name ``(decidable.of_not_not %%h)
+         | `(¬ ¬ _)     := replace h.local_pp_name ``(decidable.of_not_not %%h)
          | `(¬ (_ → (_ : Prop))) := replace h.local_pp_name ``(decidable.not_imp.mp %%h)
          | `(¬ (_ ↔ _)) := replace h.local_pp_name ``(decidable.not_iff.mp %%h)
          | `(_ ↔ _) := replace h.local_pp_name ``(decidable.iff_iff_and_or_not_and_not.mp %%h) <|>
@@ -232,12 +233,12 @@ meta def tautology (cfg : tauto_cfg := {}) : tactic unit := focus1 $
              gs' ← get_goals,
              guard (gs ≠ gs') ) in
 
-    do when cfg.classical classical,
+    do when cfg.classical (classical tt),
        using_new_ref (expr_map.mk _) tauto_core;
        repeat (first basic_tauto_tacs); cfg.closer, done
 
 namespace interactive
-local postfix `?`:9001 := optional
+local postfix (name := parser.optional) `?`:9001 := optional
 setup_tactic_parser
 
 /--
diff --git a/src/algebra/group/to_additive.lean b/src/tactic/to_additive.lean
similarity index 97%
rename from src/algebra/group/to_additive.lean
rename to src/tactic/to_additive.lean
index cf17f07b07425..c0aa488aa028c 100644
--- a/src/algebra/group/to_additive.lean
+++ b/src/tactic/to_additive.lean
@@ -219,11 +219,17 @@ meta def tr : bool → list string → list string
 | is_comm ("npow" :: s)               := add_comm_prefix is_comm "nsmul"     :: tr ff s
 | is_comm ("zpow" :: s)               := add_comm_prefix is_comm "zsmul"     :: tr ff s
 | is_comm ("is" :: "square" :: s)     := add_comm_prefix is_comm "even"      :: tr ff s
+| is_comm ("is" :: "scalar" :: "tower" :: s) :=
+   add_comm_prefix is_comm "vadd_assoc_class"   :: tr ff s
+| is_comm ("is" :: "central" :: "scalar" :: s) :=
+   add_comm_prefix is_comm "is_central_vadd"   :: tr ff s
 | is_comm ("is" :: "regular" :: s)    := add_comm_prefix is_comm "is_add_regular"   :: tr ff s
 | is_comm ("is" :: "left" :: "regular" :: s)  :=
   add_comm_prefix is_comm "is_add_left_regular"  :: tr ff s
 | is_comm ("is" :: "right" :: "regular" :: s) :=
   add_comm_prefix is_comm "is_add_right_regular" :: tr ff s
+| is_comm ("division" :: "monoid" :: s) :=
+  "subtraction" :: add_comm_prefix is_comm "monoid" :: tr ff s
 | is_comm ("monoid" :: s)      := ("add_" ++ add_comm_prefix is_comm "monoid")    :: tr ff s
 | is_comm ("submonoid" :: s)   := ("add_" ++ add_comm_prefix is_comm "submonoid") :: tr ff s
 | is_comm ("group" :: s)       := ("add_" ++ add_comm_prefix is_comm "group")     :: tr ff s
@@ -235,6 +241,9 @@ meta def tr : bool → list string → list string
 | is_comm ("unit" :: s)        := ("add_" ++ add_comm_prefix is_comm "unit")      :: tr ff s
 | is_comm ("units" :: s)       := ("add_" ++ add_comm_prefix is_comm "units")     :: tr ff s
 | is_comm ("comm" :: s)        := tr tt s
+| is_comm ("root" :: s)        := add_comm_prefix is_comm "div" :: tr ff s
+| is_comm ("rootable" :: s)    := add_comm_prefix is_comm "divisible" :: tr ff s
+| is_comm ("prods" :: s)       := add_comm_prefix is_comm "sums" :: tr ff s
 | is_comm (x :: s)             := (add_comm_prefix is_comm x :: tr ff s)
 | tt []                        := ["comm"]
 | ff []                        := []
@@ -407,7 +416,7 @@ There are some exceptions to this heuristic:
 * If an identifier has attribute `@[to_additive_ignore_args n1 n2 ...]` then all the arguments in
   positions `n1`, `n2`, ... will not be checked for unapplied identifiers (start counting from 1).
   For example, `cont_mdiff_map` has attribute `@[to_additive_ignore_args 21]`, which means
-  that its 21st argument `(n : with_top ℕ)` can contain `ℕ`
+  that its 21st argument `(n : ℕ∞)` can contain `ℕ`
   (usually in the form `has_top.top ℕ ...`) and still be additivized.
   So `@has_mul.mul (C^∞⟮I, N; I', G⟯) _ f g` will be additivized.
 
diff --git a/src/tactic/transform_decl.lean b/src/tactic/transform_decl.lean
index d76cd58479a3d..8f1296bf7d948 100644
--- a/src/tactic/transform_decl.lean
+++ b/src/tactic/transform_decl.lean
@@ -26,8 +26,8 @@ tactic unit := do
       then do
         user_attr_const ← (get_user_attribute_name attr_name >>= mk_const),
         tac ← eval_pexpr (tactic unit)
-        ``(user_attribute.get_param_untyped %%user_attr_const %%src >>=
-          λ x, user_attribute.set_untyped %%user_attr_const %%tgt x %%p %%prio),
+        ``(user_attribute.get_param_untyped %%user_attr_const %%`(src) >>=
+          λ x, user_attribute.set_untyped %%user_attr_const %%`(tgt) x %%`(p) %%`(prio)),
         tac
       else fail msg
 
diff --git a/src/tactic/transport.lean b/src/tactic/transport.lean
index 2e7ec3dc4a02d..53bdde01db08e 100644
--- a/src/tactic/transport.lean
+++ b/src/tactic/transport.lean
@@ -19,23 +19,6 @@ to a `monoid β`, the new multiplication is definitionally `λ x y, e (e.symm a
 namespace tactic
 open tactic.interactive
 
-mk_simp_attribute transport_simps
-"The simpset `transport_simps` is used by the tactic `transport`
-to simplify certain expressions involving application of equivalences,
-and trivial `eq.rec` or `ep.mpr` conversions.
-It's probably best not to adjust it without understanding the algorithm used by `transport`."
-
-attribute [transport_simps]
-  eq_rec_constant
-  eq_mp_eq_cast
-  cast_eq
-  equiv.to_fun_as_coe
-  equiv.arrow_congr'_apply
-  equiv.symm_apply_apply
-  -- we use `apply_eq_iff_eq_symm_apply` rather than `apply_eq_iff_eq`,
-  -- as many axioms have a constant on the right-hand-side
-  equiv.apply_eq_iff_eq_symm_apply
-
 /--
 Given `s : S α` for some structure `S` depending on a type `α`,
 and an equivalence `e : α ≃ β`,
diff --git a/src/tactic/unify_equations.lean b/src/tactic/unify_equations.lean
index ba29592f4743c..9ac4ad8829a0f 100644
--- a/src/tactic/unify_equations.lean
+++ b/src/tactic/unify_equations.lean
@@ -140,7 +140,7 @@ do
 
     -- Now we generate the actual proof of the target.
     tgt ← target,
-    proof ← mk_mapp inj_name (list.repeat none (inj_arity - 3) ++ [some h, some tgt]),
+    proof ← mk_mapp inj_name (list.replicate (inj_arity - 3) none ++ [some h, some tgt]),
     eapply proof,
     (next, ns) ← intron_with num_equations ns base offset,
 
diff --git a/src/tactic/wlog.lean b/src/tactic/wlog.lean
index 044e2d4c8fbdc..618096020358c 100644
--- a/src/tactic/wlog.lean
+++ b/src/tactic/wlog.lean
@@ -1,242 +1,85 @@
 /-
 Copyright (c) 2018 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl
-
-Without loss of generality tactic.
+Authors: Johannes Hölzl, Mario Carneiro, Johan Commelin, Reid Barton
 -/
-import data.list.perm
-
-open expr
-setup_tactic_parser
 
-namespace tactic
+import tactic.core
+import tactic.dependencies
 
-private meta def update_pp_name : expr → name → expr
-| (local_const n _ bi d) pp := local_const n pp bi d
-| e n := e
+/-!
 
-private meta def elim_or : ℕ → expr → tactic (list expr)
-| 0       h := fail "zero cases"
-| 1       h := return [h]
-| (n + 1) h := do
-  [(_, [hl], []), (_, [hr], [])] ← induction h, -- there should be no dependent terms
-  [gl, gr] ← get_goals,
-  set_goals [gr],
-  hsr ← elim_or n hr,
-  gsr ← get_goals,
-  set_goals (gl :: gsr),
-  return (hl :: hsr)
+# Without loss of generality tactic
 
-private meta def dest_or : expr → tactic (list expr) | e := do
-  `(%%a ∨ %%b) ← whnf e | return [e],
-  lb ← dest_or b,
-  return (a :: lb)
-
-private meta def match_perms (pat : pattern) : expr → tactic (list $ list expr) | t :=
-  (do
-    m ← match_pattern pat t,
-    guard (m.2.all expr.is_local_constant),
-    return [m.2]) <|>
-  (do
-    `(%%l ∨ %%r) ← whnf t,
-    m ← match_pattern pat l,
-    rs ← match_perms r,
-    return (m.2 :: rs))
-
-meta def wlog (vars' : list expr) (h_cases fst_case : expr) (perms : list (list expr)) :
-  tactic unit := do
-  guard h_cases.is_local_constant,
+The tactic `wlog h : P` will add an assumption `h : P` to the main goal,
+and add a new goal that requires showing that the case `h : ¬ P` can be reduced to the case
+where `P` holds (typically by symmetry).
+The new goal will be placed at the top of the goal stack.
 
-  -- reorder s.t. context is Γ ⬝ vars ⬝ cases ⊢ ∀deps, …
-  nr ← revert_lst (vars' ++ [h_cases]),
-  vars ← intron' vars'.length,
-  h_cases ← intro h_cases.local_pp_name,
-
-  cases ← infer_type h_cases,
-  h_fst_case ←
-    mk_local_def h_cases.local_pp_name
-      (fst_case.instantiate_locals $ (vars'.zip vars).map $ λ⟨o, n⟩, (o.local_uniq_name, n)),
-  ((), pr) ← solve_aux cases (repeat $ exact h_fst_case <|> left >> skip),
-
-  t ← target,
-  fixed_vars ← vars.mmap update_type,
-  let t' := (instantiate_local h_cases.local_uniq_name pr t).pis (fixed_vars ++ [h_fst_case]),
-
-  (h, [g]) ← local_proof `this t' (do
-    clear h_cases,
-    vars.mmap clear,
-    intron nr),
-
-  h₀ :: hs ← elim_or perms.length h_cases,
+-/
 
-  solve1 (do
-    exact (h.mk_app $ vars ++ [h₀])),
+namespace tactic
 
-  focus ((hs.zip perms.tail).map $ λ⟨h_case, perm⟩, do
-    let p_v := (vars'.zip vars).map (λ⟨p, v⟩, (p.local_uniq_name, v)),
-    let p := perm.map (λp, p.instantiate_locals p_v),
-    note `this none (h.mk_app $ p ++ [h_case]),
-    clear h,
-    return ()),
-  gs ← get_goals,
-  set_goals (g :: gs)
+/-- A helper function to retrieve the names of the first `n` arguments to a Pi-expression. -/
+meta def take_pi_args : nat → expr → list name
+| (n+1) (expr.pi h _ _ e) := h :: take_pi_args n e
+| _ _ := []
 
 namespace interactive
-open interactive interactive.types expr
-
-private meta def parse_permutations : option (list (list name)) → tactic (list (list expr))
-| none                    := return []
-| (some [])               := return []
-| (some perms@(p₀ :: ps)) := do
-  (guard p₀.nodup <|> fail
-    "No permutation `xs_i` in `using [xs_1, …, xs_n]` should contain the same variable twice."),
-  (guard (perms.all $ λp, p.perm p₀) <|>
-    fail ("The permutations `xs_i` in `using [xs_1, …, xs_n]` must be permutations of the same" ++
-      " variables.")),
-  perms.mmap (λp, p.mmap get_local)
-
-/-- Without loss of generality: reduces to one goal under variables permutations.
-
-Given a goal of the form `g xs`, a predicate `p` over a set of variables, as well as variable
-permutations `xs_i`. Then `wlog` produces goals of the form
-
-The case goal, i.e. the permutation `xs_i` covers all possible cases:
-  `⊢ p xs_0 ∨ ⋯ ∨ p xs_n`
-The main goal, i.e. the goal reduced to `xs_0`:
-  `(h : p xs_0) ⊢ g xs_0`
-The invariant goals, i.e. `g` is invariant under `xs_i`:
-  `(h : p xs_i) (this : g xs_0) ⊢ gs xs_i`
-
-Either the permutation is provided, or a proof of the disjunction is provided to compute the
-permutation. The disjunction need to be in assoc normal form, e.g. `p₀ ∨ (p₁ ∨ p₂)`. In many cases
-the invariant goals can be solved by AC rewriting using `cc` etc.
-
-Example:
-  On a state `(n m : ℕ) ⊢ p n m` the tactic `wlog h : n ≤ m using [n m, m n]` produces the following
-  states:
-    `(n m : ℕ) ⊢ n ≤ m ∨ m ≤ n`
-    `(n m : ℕ) (h : n ≤ m) ⊢ p n m`
-    `(n m : ℕ) (h : m ≤ n) (this : p n m) ⊢ p m n`
-
-`wlog` supports different calling conventions. The name `h` is used to give a name to the introduced
-case hypothesis. If the name is avoided, the default will be `case`.
-
-(1) `wlog : p xs0 using [xs0, …, xsn]`
-  Results in the case goal `p xs0 ∨ ⋯ ∨ ps xsn`, the main goal `(case : p xs0) ⊢ g xs0` and the
-  invariance goals `(case : p xsi) (this : g xs0) ⊢ g xsi`.
-
-(2) `wlog : p xs0 := r using xs0`
-  The expression `r` is a proof of the shape `p xs0 ∨ ⋯ ∨ p xsi`, it is also used to compute the
-  variable permutations.
-
-(3) `wlog := r using xs0`
-  The expression `r` is a proof of the shape `p xs0 ∨ ⋯ ∨ p xsi`, it is also used to compute the
-  variable permutations. This is not as stable as (2), for example `p` cannot be a disjunction.
+setup_tactic_parser
 
-(4) `wlog : R x y using x y` and `wlog : R x y`
-  Produces the case `R x y ∨ R y x`. If `R` is ≤, then the disjunction discharged using linearity.
-  If `using x y` is avoided then `x` and `y` are the last two variables appearing in the
-  expression `R x y`. -/
-meta def wlog
-  (h : parse ident?)
-  (pat : parse (tk ":" *> texpr)?)
-  (cases : parse (tk ":=" *> texpr)?)
-  (perms : parse (tk "using" *> (list_of (ident*) <|> (λx, [x]) <$> ident*))?)
-  (discharger : tactic unit :=
-    (tactic.solve_by_elim <|> tactic.tautology {classical := tt} <|>
-      using_smt (smt_tactic.intros >> smt_tactic.solve_goals))) :
+/-- `wlog h : P` will add an assumption `h : P` to the main goal,
+and add a side goal that requires showing that the case `h : ¬ P` can be reduced to the case
+where `P` holds (typically by symmetry).
+
+The side goal will be at the top of the stack. In this side goal, there will be two assumptions:
+- `h : ¬ P`: the assumption that `P` does not hold
+- `this`: which is the statement that in the old context `P` suffices to prove the goal.
+  By default, the name `this` is used, but the idiom `with H` can be added to specify the name:
+  `wlog h : P with H`.
+
+Typically, it is useful to use the variant `wlog h : P generalizing x y`,
+to revert certain parts of the context before creating the new goal.
+In this way, the wlog-claim `this` can be applied to `x` and `y` in different orders
+(exploiting symmetry, which is the typical use case).
+
+By default, the entire context is reverted. -/
+meta def wlog (H : parse ident) (t : parse (tk ":" *> texpr))
+  (revert : parse ((tk "generalizing" *> ((none <$ tk "*") <|> some <$> ident*)) <|> pure none))
+  (h : parse (tk "with" *> ident)?) :
   tactic unit := do
-perms ← parse_permutations perms,
-(pat, cases_pr, cases_goal, vars, perms) ← (match cases with
-| some r := do
-  vars::_ ← return perms |
-    fail "At least one set of variables expected, i.e. `using x y` or `using [x y, y x]`.",
-  cases_pr ← to_expr r,
-  cases_pr ← (if cases_pr.is_local_constant
-    then return $ match h with some n := update_pp_name cases_pr n | none := cases_pr end
-    else do
-      note (h.get_or_else `case) none cases_pr),
-  cases ← infer_type cases_pr,
-  (pat, perms') ← match pat with
-  | some pat := do
-    pat ← to_expr pat,
-    let vars' := vars.filter $ λv, v.occurs pat,
-    case_pat ← mk_pattern [] vars' pat [] vars',
-    perms' ← match_perms case_pat cases,
-    return (pat, perms')
-  | none := do
-    (p :: ps) ← dest_or cases,
-    let vars' := vars.filter $ λv, v.occurs p,
-    case_pat ← mk_pattern [] vars' p [] vars',
-    perms' ← (p :: ps).mmap (λp, do m ← match_pattern case_pat p, return m.2),
-    return (p, perms')
-  end,
-  let vars_name := vars.map local_uniq_name,
-  guard (perms'.all $ λp, p.all $ λv, v.is_local_constant ∧ v.local_uniq_name ∈ vars_name) <|>
-    fail "Cases contains variables not declared in `using x y z`",
-  perms ← (if perms.length = 1
-    then do
-      return (perms'.map $ λ p,
-        p ++ vars.filter (λ v, p.all (λ v', v'.local_uniq_name ≠ v.local_uniq_name)))
-    else do
-      guard (perms.length = perms'.length) <|>
-        fail "The provided permutation list has a different length then the provided cases.",
-      return perms),
-  return (pat, cases_pr, @none expr, vars, perms)
-
-| none   := do
-  let name_h := h.get_or_else `case,
-  some pat ← return pat | fail "Either specify cases or a pattern with permutations",
-  pat ← to_expr pat,
-  (do
-    [x, y] ← match perms with
-    | []  := return pat.list_local_consts
-    | [l] := return l
-    | _   := failed
+  -- if there is no `with` clause, use `this` as default name
+  let h := h.get_or_else `this,
+  t ← i_to_expr ``(%%t : Sort*),
+  -- compute which constants must be reverted (by default: everything)
+  (num_generalized, goal, rctx) ← retrieve (do
+    assert_core H t, swap,
+    -- use `revert_lst'` to ensure that the order of local constants in the context is preserved
+    num_generalized ← match revert with
+    | none := revert_all
+    | some revert := prod.fst <$> (revert.mmap tactic.get_local >>= revert_lst')
     end,
-    let cases := mk_or_lst
-      [pat, pat.instantiate_locals [(x.local_uniq_name, y), (y.local_uniq_name, x)]],
-    (do
-      `(%%x' ≤ %%y') ← return pat,
-      (cases_pr, []) ← local_proof name_h cases (exact ``(le_total %%x' %%y')),
-      return (pat, cases_pr, none, [x, y], [[x, y], [y, x]]))
-    <|>
-    (do
-      (cases_pr, [g]) ← local_proof name_h cases skip,
-      return (pat, cases_pr, some g, [x, y], [[x, y], [y, x]]))) <|>
-  (do
-    guard (perms.length ≥ 2) <|>
-      fail ("To generate cases at least two permutations are required, i.e. `using [x y, y x]`" ++
-        " or exactly 0 or 2 variables"),
-    (vars :: perms') ← return perms,
-    let names := vars.map local_uniq_name,
-    let cases := mk_or_lst (pat :: perms'.map (λp, pat.instantiate_locals (names.zip p))),
-    (cases_pr, [g]) ← local_proof name_h cases skip,
-    return (pat, cases_pr, some g, vars, perms))
-end),
-let name_fn := if perms.length = 2 then λ _, `invariant else
-  λ i, mk_simple_name ("invariant_" ++ to_string (i + 1)),
-with_enable_tags $ tactic.focus1 $ do
-  t ← get_main_tag,
-  tactic.wlog vars cases_pr pat perms,
-  tactic.focus (set_main_tag (mk_num_name `_case 0 :: `main :: t) ::
-    (list.range (perms.length - 1)).map (λi, do
-      set_main_tag (mk_num_name `_case 0 :: name_fn i :: t),
-      try discharger)),
-  match cases_goal with
-  | some g := do
-    set_tag g (mk_num_name `_case 0 :: `cases :: t),
-    gs ← get_goals,
-    set_goals (g :: gs)
-  | none := skip
-  end
+    goal ← target,
+    ctx ← local_context,
+    return (num_generalized, goal, ctx)),
+  ctx ← local_context,
+  e ← tactic.assert h goal,
+  goal ← target,
+  (take_pi_args num_generalized goal).reverse.mmap' $ λ h,
+    try (tactic.get_local h >>= tactic.clear),
+  intron (num_generalized + 1),
+  -- prove the easy branch of the side goal
+  swap,
+  tactic.by_cases t H,
+  H ← tactic.get_local H,
+  let L := ctx.filter (λ n, n ∉ rctx),
+  tactic.exact $ (e.mk_app L).app H
 
 add_tactic_doc
-{ name := "wlog",
-  category := doc_category.tactic,
-  decl_names := [``wlog],
-  tags := ["logic"] }
+{ name        := "wlog",
+  category    := doc_category.tactic,
+  decl_names  := [`tactic.interactive.wlog],
+  tags        := ["logic"] }
 
 end interactive
 
diff --git a/src/tactic/zify.lean b/src/tactic/zify.lean
index 3c391f29cbd8b..ffd8ab2c14b69 100644
--- a/src/tactic/zify.lean
+++ b/src/tactic/zify.lean
@@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
 
-import data.int.cast            -- used by clients
+import data.int.cast.lemmas           -- used by clients
+import data.int.char_zero
 import tactic.norm_cast
 
 /-!
diff --git a/src/testing/slim_check/functions.lean b/src/testing/slim_check/functions.lean
index f7948278aae72..7249c61434dfe 100644
--- a/src/testing/slim_check/functions.lean
+++ b/src/testing/slim_check/functions.lean
@@ -5,7 +5,7 @@ Authors: Simon Hudon
 -/
 import data.list.sigma
 import data.int.range
-import data.finsupp.basic
+import data.finsupp.defs
 import data.finsupp.to_dfinsupp
 import tactic.pretty_cases
 import testing.slim_check.sampleable
@@ -14,6 +14,9 @@ import testing.slim_check.testable
 /-!
 ## `slim_check`: generators for functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `sampleable` instances for `α → β` functions and
 `ℤ → ℤ` injective functions.
 
@@ -207,7 +210,7 @@ instance pi_pred.sampleable_ext [sampleable_ext (α → bool)] :
 
 @[priority 2000]
 instance pi_uncurry.sampleable_ext
-  [sampleable_ext (α × β → γ)] : sampleable_ext.{(imax (u+1) (v+1) w)} (α → β → γ) :=
+  [sampleable_ext (α × β → γ)] : sampleable_ext.{imax (u+1) (v+1) w} (α → β → γ) :=
 { proxy_repr := proxy_repr (α × β → γ),
   interp := λ m x y, interp (α × β → γ) m (x, y),
   sample := sample (α × β → γ),
diff --git a/src/testing/slim_check/gen.lean b/src/testing/slim_check/gen.lean
index b7c4cd5ab50d8..d0e76abcadf90 100644
--- a/src/testing/slim_check/gen.lean
+++ b/src/testing/slim_check/gen.lean
@@ -5,10 +5,15 @@ Authors: Simon Hudon
 -/
 import control.random
 import control.uliftable
+import data.list.big_operators.lemmas
+import data.list.perm
 
 /-!
 # `gen` Monad
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This monad is used to formulate randomized computations with a parameter
 to specify the desired size of the result.
 
@@ -66,7 +71,7 @@ def choose [bounded_random α] (x y : α) (p : x ≤ y) : gen (x .. y) :=
 
 end rand
 
-open nat (hiding choose)
+open nat
 
 /-- Generate a `nat` example between `x` and `y`. -/
 def choose_nat (x y : ℕ) (p : x ≤ y) : gen (x .. y) :=
diff --git a/src/testing/slim_check/sampleable.lean b/src/testing/slim_check/sampleable.lean
index ce17328b73888..ac9b0ac097fe2 100644
--- a/src/testing/slim_check/sampleable.lean
+++ b/src/testing/slim_check/sampleable.lean
@@ -5,15 +5,18 @@ Authors: Simon Hudon
 -/
 import data.lazy_list.basic
 import data.tree
-import data.int.basic
+import data.pnat.basic
 import control.bifunctor
 import control.ulift
-import tactic.linarith
 import testing.slim_check.gen
+import tactic.linarith
 
 /-!
 # `sampleable` Class
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This class permits the creation samples of a given type
 controlling the size of those values using the `gen` monad`. It also
 helps minimize examples by creating smaller versions of given values.
@@ -281,13 +284,13 @@ well_founded.fix has_well_founded.wf $ λ x f_rec,
      y ← (shrink x).find (λ a, p a),
      f_rec y y.property <|> some y.val .
 
-instance fin.sampleable {n} [fact $ 0 < n] : sampleable (fin n) :=
-sampleable.lift ℕ fin.of_nat' subtype.val $
+instance fin.sampleable {n : ℕ} [ne_zero n] : sampleable (fin n) :=
+sampleable.lift ℕ fin.of_nat' fin.val $
 λ i, (mod_le _ _ : i % n ≤ i)
 
 @[priority 100]
 instance fin.sampleable' {n} : sampleable (fin (succ n)) :=
-sampleable.lift ℕ fin.of_nat subtype.val $
+sampleable.lift ℕ fin.of_nat fin.val $
 λ i, (mod_le _ _ : i % succ n ≤ i)
 
 instance pnat.sampleable : sampleable ℕ+ :=
@@ -371,7 +374,7 @@ begin
   rcases i with ⟨x,⟨y,hy⟩⟩; unfold_wf;
   dsimp [rat.mk_pnat],
   mono*,
-  { rw [← int.coe_nat_le, ← int.abs_eq_nat_abs, ← int.abs_eq_nat_abs],
+  { rw [← int.coe_nat_le, int.coe_nat_abs, int.coe_nat_abs],
     apply int.abs_div_le_abs },
   { change _ - 1 ≤ y-1,
     apply tsub_le_tsub_right,
@@ -413,7 +416,7 @@ begin
   cases k,
   { cases hk },
   have : sizeof xs < sizeof (x :: xs),
-  { unfold_wf, linarith },
+  { unfold_wf },
   cases k,
   { simp only [this, list.drop] },
   { simp only [list.drop],
diff --git a/src/testing/slim_check/testable.lean b/src/testing/slim_check/testable.lean
index 9888738ef57d3..b355cc40c8c98 100644
--- a/src/testing/slim_check/testable.lean
+++ b/src/testing/slim_check/testable.lean
@@ -9,6 +9,9 @@ import testing.slim_check.sampleable
 /-!
 # `testable` Class
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Testable propositions have a procedure that can generate counter-examples
 together with a proof that they invalidate the proposition.
 
diff --git a/src/topology/G_delta.lean b/src/topology/G_delta.lean
index 76a6e6206bae1..e67fa7e8bee47 100644
--- a/src/topology/G_delta.lean
+++ b/src/topology/G_delta.lean
@@ -5,10 +5,14 @@ Authors: Sébastien Gouëzel, Yury Kudryashov
 -/
 import topology.uniform_space.basic
 import topology.separation
+import order.filter.countable_Inter
 
 /-!
 # `Gδ` sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `Gδ` sets and prove their basic properties.
 
 ## Main definitions
@@ -16,11 +20,8 @@ In this file we define `Gδ` sets and prove their basic properties.
 * `is_Gδ`: a set `s` is a `Gδ` set if it can be represented as an intersection
   of countably many open sets;
 
-* `residual`: the filter of residual sets. A set `s` is called *residual* if it includes a dense
-  `Gδ` set. In a Baire space (e.g., in a complete (e)metric space), residual sets form a filter.
-
-  For technical reasons, we define `residual` in any topological space but the definition agrees
-  with the description above only in Baire spaces.
+* `residual`: the σ-filter of residual sets. A set `s` is called *residual* if it includes a
+  countable intersection of dense open sets.
 
 ## Main results
 
@@ -33,7 +34,7 @@ Gδ set, residual set
 -/
 
 noncomputable theory
-open_locale classical topological_space filter uniformity
+open_locale classical topology filter uniformity
 
 open filter encodable set
 
@@ -44,7 +45,7 @@ variable [topological_space α]
 
 /-- A Gδ set is a countable intersection of open sets. -/
 def is_Gδ (s : set α) : Prop :=
-  ∃T : set (set α), (∀t ∈ T, is_open t) ∧ countable T ∧ s = (⋂₀ T)
+  ∃T : set (set α), (∀t ∈ T, is_open t) ∧ T.countable ∧ s = (⋂₀ T)
 
 /-- An open set is a Gδ set. -/
 lemma is_open.is_Gδ {s : set α} (h : is_open s) : is_Gδ s :=
@@ -54,7 +55,7 @@ lemma is_open.is_Gδ {s : set α} (h : is_open s) : is_Gδ s :=
 
 @[simp] lemma is_Gδ_univ : is_Gδ (univ : set α) := is_open_univ.is_Gδ
 
-lemma is_Gδ_bInter_of_open {I : set ι} (hI : countable I) {f : ι → set α}
+lemma is_Gδ_bInter_of_open {I : set ι} (hI : I.countable) {f : ι → set α}
   (hf : ∀i ∈ I, is_open (f i)) : is_Gδ (⋂i∈I, f i) :=
 ⟨f '' I, by rwa ball_image_iff, hI.image _, by rw sInter_image⟩
 
@@ -71,7 +72,7 @@ begin
   simpa [@forall_swap ι] using hTo
 end
 
-lemma is_Gδ_bInter {s : set ι} (hs : countable s) {t : Π i ∈ s, set α}
+lemma is_Gδ_bInter {s : set ι} (hs : s.countable) {t : Π i ∈ s, set α}
   (ht : ∀ i ∈ s, is_Gδ (t i ‹_›)) : is_Gδ (⋂ i ∈ s, t i ‹_›) :=
 begin
   rw [bInter_eq_Inter],
@@ -80,7 +81,7 @@ begin
 end
 
 /-- A countable intersection of Gδ sets is a Gδ set. -/
-lemma is_Gδ_sInter {S : set (set α)} (h : ∀s∈S, is_Gδ s) (hS : countable S) : is_Gδ (⋂₀ S) :=
+lemma is_Gδ_sInter {S : set (set α)} (h : ∀s∈S, is_Gδ s) (hS : S.countable) : is_Gδ (⋂₀ S) :=
 by simpa only [sInter_eq_bInter] using is_Gδ_bInter hS h
 
 lemma is_Gδ.inter {s t : set α} (hs : is_Gδ s) (ht : is_Gδ t) : is_Gδ (s ∩ t) :=
@@ -111,7 +112,7 @@ lemma is_closed.is_Gδ {α} [uniform_space α] [is_countably_generated (𝓤 α)
 begin
   rcases (@uniformity_has_basis_open α _).exists_antitone_subbasis  with ⟨U, hUo, hU, -⟩,
   rw [← hs.closure_eq, ← hU.bInter_bUnion_ball],
-  refine is_Gδ_bInter (countable_encodable _) (λ n hn, is_open.is_Gδ _),
+  refine is_Gδ_bInter (to_countable _) (λ n hn, is_open.is_Gδ _),
   exact is_open_bUnion (λ x hx, uniform_space.is_open_ball _ (hUo _).2)
 end
 
@@ -122,13 +123,13 @@ variable [t1_space α]
 lemma is_Gδ_compl_singleton (a : α) : is_Gδ ({a}ᶜ : set α) :=
 is_open_compl_singleton.is_Gδ
 
-lemma set.countable.is_Gδ_compl {s : set α} (hs : countable s) : is_Gδ sᶜ :=
+lemma set.countable.is_Gδ_compl {s : set α} (hs : s.countable) : is_Gδ sᶜ :=
 begin
   rw [← bUnion_of_singleton s, compl_Union₂],
   exact is_Gδ_bInter hs (λ x _, is_Gδ_compl_singleton x)
 end
 
-lemma set.finite.is_Gδ_compl {s : set α} (hs : finite s) : is_Gδ sᶜ :=
+lemma set.finite.is_Gδ_compl {s : set α} (hs : s.finite) : is_Gδ sᶜ :=
 hs.countable.is_Gδ_compl
 
 lemma set.subsingleton.is_Gδ_compl {s : set α} (hs : s.subsingleton) : is_Gδ sᶜ :=
@@ -145,10 +146,10 @@ lemma is_Gδ_singleton (a : α) : is_Gδ ({a} : set α) :=
 begin
   rcases (nhds_basis_opens a).exists_antitone_subbasis with ⟨U, hU, h_basis⟩,
   rw [← bInter_basis_nhds h_basis.to_has_basis],
-  exact is_Gδ_bInter (countable_encodable _) (λ n hn, (hU n).2.is_Gδ),
+  exact is_Gδ_bInter (to_countable _) (λ n hn, (hU n).2.is_Gδ),
 end
 
-lemma set.finite.is_Gδ {s : set α} (hs : finite s) : is_Gδ s :=
+lemma set.finite.is_Gδ {s : set α} (hs : s.finite) : is_Gδ s :=
 finite.induction_on hs is_Gδ_empty $ λ a s _ _ hs, (is_Gδ_singleton a).union hs
 
 end t1_space
@@ -177,10 +178,34 @@ end
 
 end continuous_at
 
-/-- A set `s` is called *residual* if it includes a dense `Gδ` set. If `α` is a Baire space
-(e.g., a complete metric space), then residual sets form a filter, see `mem_residual`.
+section residual
+
+variable [topological_space α]
 
-For technical reasons we define the filter `residual` in any topological space but in a non-Baire
-space it is not useful because it may contain some non-residual sets. -/
+/-- A set `s` is called *residual* if it includes a countable intersection of dense open sets. -/
+@[derive countable_Inter_filter]
 def residual (α : Type*) [topological_space α] : filter α :=
-⨅ t (ht : is_Gδ t) (ht' : dense t), 𝓟 t
+filter.countable_generate {t | is_open t ∧ dense t}
+
+instance countable_Inter_filter_residual : countable_Inter_filter (residual α) :=
+by rw [residual]; apply_instance
+
+/-- Dense open sets are residual. -/
+lemma residual_of_dense_open {s : set α} (ho : is_open s) (hd : dense s) : s ∈ residual α :=
+countable_generate_sets.basic ⟨ho, hd⟩
+
+/-- Dense Gδ sets are residual. -/
+lemma residual_of_dense_Gδ {s : set α} (ho : is_Gδ s) (hd : dense s) : s ∈ residual α :=
+begin
+  rcases ho with ⟨T, To, Tct, rfl⟩,
+  exact (countable_sInter_mem Tct).mpr (λ t tT, residual_of_dense_open (To t tT)
+    (hd.mono (sInter_subset_of_mem tT))),
+end
+
+/-- A set is residual iff it includes a countable intersection of dense open sets. -/
+lemma mem_residual_iff {s : set α} : s ∈ residual α ↔
+  ∃ (S : set (set α)), (∀ t ∈ S, is_open t) ∧ (∀ t ∈ S, dense t) ∧ S.countable ∧ ⋂₀ S ⊆ s :=
+mem_countable_generate_iff.trans $ by simp_rw
+  [subset_def, mem_set_of, forall_and_distrib, and_assoc]
+
+end residual
diff --git a/src/topology/alexandroff.lean b/src/topology/alexandroff.lean
index 19f3661877107..fc0fae833aaa8 100644
--- a/src/topology/alexandroff.lean
+++ b/src/topology/alexandroff.lean
@@ -3,12 +3,16 @@ Copyright (c) 2021 Yourong Zang. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yourong Zang, Yury Kudryashov
 -/
+import data.fintype.option
 import topology.separation
 import topology.sets.opens
 
 /-!
 # The Alexandroff Compactification
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct the Alexandroff compactification (the one-point compactification) of an arbitrary
 topological space `X` and prove some properties inherited from `X`.
 
@@ -33,7 +37,7 @@ one-point compactification, compactness
 -/
 
 open set filter
-open_locale classical topological_space filter
+open_locale classical topology filter
 
 /-!
 ### Definition and basic properties
@@ -55,7 +59,7 @@ namespace alexandroff
 
 /-- The point at infinity -/
 def infty : alexandroff X := none
-localized "notation `∞` := alexandroff.infty" in alexandroff
+localized "notation (name := alexandroff.infty) `∞` := alexandroff.infty" in alexandroff
 
 instance : has_coe_t X (alexandroff X) := ⟨option.some⟩
 
@@ -102,10 +106,8 @@ lemma ne_infty_iff_exists {x : alexandroff X} :
   x ≠ ∞ ↔ ∃ (y : X), (y : alexandroff X) = x :=
 by induction x using alexandroff.rec; simp
 
-instance : can_lift (alexandroff X) X :=
-{ coe := coe,
-  cond := λ x, x ≠ ∞,
-  prf := λ x, ne_infty_iff_exists.1 }
+instance can_lift : can_lift (alexandroff X) X coe (λ x, x ≠ ∞) :=
+with_top.can_lift
 
 lemma not_mem_range_coe_iff {x : alexandroff X} :
   x ∉ range (coe : X → alexandroff X) ↔ x = ∞ :=
@@ -151,7 +153,7 @@ instance : topological_space (alexandroff X) :=
     suffices : is_open (coe ⁻¹' ⋃₀ S : set X),
     { refine ⟨_, this⟩,
       rintro ⟨s, hsS : s ∈ S, hs : ∞ ∈ s⟩,
-      refine compact_of_is_closed_subset ((ho s hsS).1 hs) this.is_closed_compl _,
+      refine is_compact_of_is_closed_subset ((ho s hsS).1 hs) this.is_closed_compl _,
       exact compl_subset_compl.mpr (preimage_mono $ subset_sUnion_of_mem hsS) },
     rw [preimage_sUnion],
     exact is_open_bUnion (λ s hs, (ho s hs).2)
@@ -325,12 +327,32 @@ lemma dense_embedding_coe [noncompact_space X] :
   dense_embedding (coe : X → alexandroff X) :=
 { dense := dense_range_coe, .. open_embedding_coe }
 
+@[simp] lemma specializes_coe {x y : X} : (x : alexandroff X) ⤳ y ↔ x ⤳ y :=
+open_embedding_coe.to_inducing.specializes_iff
+
+@[simp] lemma inseparable_coe {x y : X} : inseparable (x : alexandroff X) y ↔ inseparable x y :=
+open_embedding_coe.to_inducing.inseparable_iff
+
+lemma not_specializes_infty_coe {x : X} : ¬specializes ∞ (x : alexandroff X) :=
+is_closed_infty.not_specializes rfl (coe_ne_infty x)
+
+lemma not_inseparable_infty_coe {x : X} : ¬inseparable ∞ (x : alexandroff X) :=
+λ h, not_specializes_infty_coe h.specializes
+
+lemma not_inseparable_coe_infty {x : X} : ¬inseparable (x : alexandroff X) ∞ :=
+λ h, not_specializes_infty_coe h.specializes'
+
+lemma inseparable_iff {x y : alexandroff X} :
+  inseparable x y ↔ x = ∞ ∧ y = ∞ ∨ ∃ x' : X, x = x' ∧ ∃ y' : X, y = y' ∧ inseparable x' y' :=
+by induction x using alexandroff.rec; induction y using alexandroff.rec;
+  simp [not_inseparable_infty_coe, not_inseparable_coe_infty, coe_eq_coe]
+
 /-!
 ### Compactness and separation properties
 
 In this section we prove that `alexandroff X` is a compact space; it is a T₀ (resp., T₁) space if
 the original space satisfies the same separation axiom. If the original space is a locally compact
-Hausdorff space, then `alexandroff X` is a normal (hence, regular and Hausdorff) space.
+Hausdorff space, then `alexandroff X` is a normal (hence, T₃ and Hausdorff) space.
 
 Finally, if the original space `X` is *not* compact and is a preconnected space, then
 `alexandroff X` is a connected space.
@@ -338,7 +360,7 @@ Finally, if the original space `X` is *not* compact and is a preconnected space,
 
 /-- For any topological space `X`, its one point compactification is a compact space. -/
 instance : compact_space (alexandroff X) :=
-{ compact_univ :=
+{ is_compact_univ :=
   begin
     have : tendsto (coe : X → alexandroff X) (cocompact X) (𝓝 ∞),
     { rw [nhds_infty_eq],
@@ -351,13 +373,8 @@ instance : compact_space (alexandroff X) :=
 instance [t0_space X] : t0_space (alexandroff X) :=
 begin
   refine ⟨λ x y hxy, _⟩,
-  induction x using alexandroff.rec; induction y using alexandroff.rec,
-  { exact (hxy rfl).elim },
-  { use {∞}ᶜ, simp [is_closed_infty] },
-  { use {∞}ᶜ, simp [is_closed_infty] },
-  { rcases t0_space.t0 x y (mt coe_eq_coe.mpr hxy) with ⟨U, hUo, hU⟩,
-    refine ⟨coe '' U, is_open_image_coe.2 hUo, _⟩,
-    simpa [coe_eq_coe] }
+  rcases inseparable_iff.1 hxy with ⟨rfl, rfl⟩|⟨x, rfl, y, rfl, h⟩,
+  exacts [rfl, congr_arg coe h.eq]
 end
 
 /-- The one point compactification of a `t1_space` space is a `t1_space`. -/
@@ -366,7 +383,7 @@ instance [t1_space X] : t1_space (alexandroff X) :=
   begin
     induction z using alexandroff.rec,
     { exact is_closed_infty },
-    { simp only [← image_singleton, is_closed_image_coe],
+    { rw [← image_singleton, is_closed_image_coe],
       exact ⟨is_closed_singleton, is_compact_singleton⟩ }
   end }
 
@@ -375,19 +392,17 @@ Hausdorff and regular) topological space. -/
 instance [locally_compact_space X] [t2_space X] : normal_space (alexandroff X) :=
 begin
   have key : ∀ z : X,
-    ∃ u v : set (alexandroff X), is_open u ∧ is_open v ∧ ↑z ∈ u ∧ ∞ ∈ v ∧ u ∩ v = ∅,
+    ∃ u v : set (alexandroff X), is_open u ∧ is_open v ∧ ↑z ∈ u ∧ ∞ ∈ v ∧ disjoint u v,
   { intro z,
     rcases exists_open_with_compact_closure z with ⟨u, hu, huy', Hu⟩,
-    refine ⟨coe '' u, (coe '' closure u)ᶜ, is_open_image_coe.2 hu,
+    exact ⟨coe '' u, (coe '' closure u)ᶜ, is_open_image_coe.2 hu,
       is_open_compl_image_coe.2 ⟨is_closed_closure, Hu⟩, mem_image_of_mem _ huy',
-      mem_compl infty_not_mem_image_coe, _⟩,
-    rw [← subset_compl_iff_disjoint, compl_compl],
-    exact image_subset _ subset_closure },
+      mem_compl infty_not_mem_image_coe, (image_subset _ subset_closure).disjoint_compl_right⟩ },
   refine @normal_of_compact_t2 _ _ _ ⟨λ x y hxy, _⟩,
   induction x using alexandroff.rec; induction y using alexandroff.rec,
   { exact (hxy rfl).elim },
   { rcases key y with ⟨u, v, hu, hv, hxu, hyv, huv⟩,
-    exact ⟨v, u, hv, hu, hyv, hxu, (inter_comm u v) ▸ huv⟩ },
+    exact ⟨v, u, hv, hu, hyv, hxu, huv.symm⟩ },
   { exact key x },
   { exact separated_by_open_embedding open_embedding_coe (mt coe_eq_coe.mpr hxy) }
 end
diff --git a/src/topology/algebra/affine.lean b/src/topology/algebra/affine.lean
index c03dd227152cc..6c36789010ae4 100644
--- a/src/topology/algebra/affine.lean
+++ b/src/topology/algebra/affine.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Frédéric Dupuis
 -/
 import linear_algebra.affine_space.affine_map
-import topology.algebra.group
+import topology.algebra.group.basic
 import topology.algebra.mul_action
 
 /-!
 # Topological properties of affine spaces and maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 For now, this contains only a few facts regarding the continuity of affine maps in the special
 case when the point space and vector space are the same.
 
diff --git a/src/topology/algebra/algebra.lean b/src/topology/algebra/algebra.lean
index 297f91aef929c..539fcb7629988 100644
--- a/src/topology/algebra/algebra.lean
+++ b/src/topology/algebra/algebra.lean
@@ -5,11 +5,14 @@ Authors: Scott Morrison
 -/
 import algebra.algebra.subalgebra.basic
 import topology.algebra.module.basic
-import topology.algebra.field
+import ring_theory.adjoin.basic
 
 /-!
 # Topological (sub)algebras
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A topological algebra over a topological semiring `R` is a topological semiring with a compatible
 continuous scalar multiplication by elements of `R`. We reuse typeclass `has_continuous_smul` for
 topological algebras.
@@ -28,11 +31,11 @@ open_locale classical
 universes u v w
 
 section topological_algebra
-variables (R : Type*) [topological_space R] [comm_semiring R]
-variables (A : Type u) [topological_space A]
-variables [semiring A]
+variables (R : Type*) (A : Type u)
+variables [comm_semiring R] [semiring A] [algebra R A]
+variables [topological_space R] [topological_space A] [topological_semiring A]
 
-lemma continuous_algebra_map_iff_smul [algebra R A] [topological_semiring A] :
+lemma continuous_algebra_map_iff_smul :
   continuous (algebra_map R A) ↔ continuous (λ p : R × A, p.1 • p.2) :=
 begin
   refine ⟨λ h, _, λ h, _⟩,
@@ -41,43 +44,56 @@ begin
 end
 
 @[continuity]
-lemma continuous_algebra_map [algebra R A] [topological_semiring A] [has_continuous_smul R A] :
+lemma continuous_algebra_map [has_continuous_smul R A] :
   continuous (algebra_map R A) :=
 (continuous_algebra_map_iff_smul R A).2 continuous_smul
 
-lemma has_continuous_smul_of_algebra_map [algebra R A] [topological_semiring A]
-  (h : continuous (algebra_map R A)) :
+lemma has_continuous_smul_of_algebra_map (h : continuous (algebra_map R A)) :
   has_continuous_smul R A :=
 ⟨(continuous_algebra_map_iff_smul R A).1 h⟩
 
+variables [has_continuous_smul R A]
+
+/-- The inclusion of the base ring in a topological algebra as a continuous linear map. -/
+@[simps]
+def algebra_map_clm : R →L[R] A :=
+{ to_fun := algebra_map R A,
+  cont := continuous_algebra_map R A,
+  .. algebra.linear_map R A }
+
+lemma algebra_map_clm_coe : ⇑(algebra_map_clm R A) = algebra_map R A := rfl
+
+lemma algebra_map_clm_to_linear_map :
+  (algebra_map_clm R A).to_linear_map = algebra.linear_map R A := rfl
+
 end topological_algebra
 
 section topological_algebra
 variables {R : Type*} [comm_semiring R]
 variables {A : Type u} [topological_space A]
-variables [semiring A]
-variables [algebra R A] [topological_semiring A]
+variables [semiring A] [algebra R A]
+
+instance subalgebra.has_continuous_smul [topological_space R] [has_continuous_smul R A]
+  (s : subalgebra R A) :
+  has_continuous_smul R s :=
+s.to_submodule.has_continuous_smul
+
+variables [topological_semiring A]
 
 /-- The closure of a subalgebra in a topological algebra as a subalgebra. -/
 def subalgebra.topological_closure (s : subalgebra R A) : subalgebra R A :=
 { carrier := closure (s : set A),
-  algebra_map_mem' := λ r, s.to_subsemiring.subring_topological_closure (s.algebra_map_mem r),
+  algebra_map_mem' := λ r, s.to_subsemiring.le_topological_closure (s.algebra_map_mem r),
   .. s.to_subsemiring.topological_closure }
 
 @[simp] lemma subalgebra.topological_closure_coe (s : subalgebra R A) :
   (s.topological_closure : set A) = closure (s : set A) :=
 rfl
 
-instance subalgebra.topological_closure_topological_semiring (s : subalgebra R A) :
-  topological_semiring (s.topological_closure) :=
-s.to_subsemiring.topological_closure_topological_semiring
-
-instance subalgebra.topological_closure_topological_algebra
-  [topological_space R] [has_continuous_smul R A] (s : subalgebra R A) :
-  has_continuous_smul R (s.topological_closure) :=
-s.to_submodule.topological_closure_has_continuous_smul
+instance subalgebra.topological_semiring (s : subalgebra R A) : topological_semiring s :=
+s.to_subsemiring.topological_semiring
 
-lemma subalgebra.subalgebra_topological_closure (s : subalgebra R A) :
+lemma subalgebra.le_topological_closure (s : subalgebra R A) :
   s ≤ s.topological_closure :=
 subset_closure
 
@@ -102,11 +118,11 @@ but we don't have those, so we use the clunky approach of talking about
 an algebra homomorphism, and a separate homeomorphism,
 along with a witness that as functions they are the same.
 -/
-lemma subalgebra.topological_closure_comap'_homeomorph
+lemma subalgebra.topological_closure_comap_homeomorph
   (s : subalgebra R A)
   {B : Type*} [topological_space B] [ring B] [topological_ring B] [algebra R B]
   (f : B →ₐ[R] A) (f' : B ≃ₜ A) (w : (f : B → A) = f') :
-  s.topological_closure.comap' f = (s.comap' f).topological_closure :=
+  s.topological_closure.comap f = (s.comap f).topological_closure :=
 begin
   apply set_like.ext',
   simp only [subalgebra.topological_closure_coe],
@@ -136,7 +152,7 @@ def algebra.elemental_algebra (x : A) : subalgebra R A :=
 (algebra.adjoin R ({x} : set A)).topological_closure
 
 lemma algebra.self_mem_elemental_algebra (x : A) : x ∈ algebra.elemental_algebra R x :=
-set_like.le_def.mp (subalgebra.subalgebra_topological_closure (algebra.adjoin R ({x} : set A))) $
+set_like.le_def.mp (subalgebra.le_topological_closure (algebra.adjoin R ({x} : set A))) $
   algebra.self_mem_adjoin_singleton R x
 
 variables {R}
@@ -157,6 +173,6 @@ section division_ring
 instance division_ring.has_continuous_const_smul_rat
   {A} [division_ring A] [topological_space A] [has_continuous_mul A] [char_zero A] :
   has_continuous_const_smul ℚ A :=
-⟨λ r, continuous_const.mul continuous_id⟩
+⟨λ r, by { simpa only [algebra.smul_def] using continuous_const.mul continuous_id }⟩
 
 end division_ring
diff --git a/src/topology/algebra/const_mul_action.lean b/src/topology/algebra/const_mul_action.lean
index 04fb4e45d85d8..cfd7af56a5712 100644
--- a/src/topology/algebra/const_mul_action.lean
+++ b/src/topology/algebra/const_mul_action.lean
@@ -6,9 +6,15 @@ Authors: Alex Kontorovich, Heather Macbeth
 import topology.algebra.constructions
 import topology.homeomorph
 import group_theory.group_action.basic
+import topology.bases
+import topology.support
+
 /-!
 # Monoid actions continuous in the second variable
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define class `has_continuous_const_smul`. We say `has_continuous_const_smul Γ T` if
 `Γ` acts on `T` and for each `γ`, the map `x ↦ γ • x` is continuous. (This differs from
 `has_continuous_smul`, which requires simultaneous continuity in both variables.)
@@ -34,24 +40,28 @@ Hausdorff, discrete group, properly discontinuous, quotient space
 
 -/
 
-open_locale topological_space pointwise
+open_locale topology pointwise
 
-open filter set
+open filter set topological_space
 
 local attribute [instance] mul_action.orbit_rel
 
 /-- Class `has_continuous_const_smul Γ T` says that the scalar multiplication `(•) : Γ → T → T`
 is continuous in the second argument. We use the same class for all kinds of multiplicative
 actions, including (semi)modules and algebras.
--/
-class has_continuous_const_smul (Γ : Type*) (T : Type*) [topological_space T] [has_scalar Γ T]
+
+Note that both `has_continuous_const_smul α α` and `has_continuous_const_smul αᵐᵒᵖ α` are
+weaker versions of `has_continuous_mul α`. -/
+class has_continuous_const_smul (Γ : Type*) (T : Type*) [topological_space T] [has_smul Γ T]
  : Prop :=
 (continuous_const_smul : ∀ γ : Γ, continuous (λ x : T, γ • x))
 
 /-- Class `has_continuous_const_vadd Γ T` says that the additive action `(+ᵥ) : Γ → T → T`
 is continuous in the second argument. We use the same class for all kinds of additive actions,
 including (semi)modules and algebras.
--/
+
+Note that both `has_continuous_const_vadd α α` and `has_continuous_const_vadd αᵐᵒᵖ α` are
+weaker versions of `has_continuous_add α`. -/
 class has_continuous_const_vadd (Γ : Type*) (T : Type*) [topological_space T]
   [has_vadd Γ T] : Prop :=
 (continuous_const_vadd : ∀ γ : Γ, continuous (λ x : T, γ +ᵥ x))
@@ -64,8 +74,8 @@ export has_continuous_const_vadd (continuous_const_vadd)
 
 variables {M α β : Type*}
 
-section has_scalar
-variables [topological_space α] [has_scalar M α] [has_continuous_const_smul M α]
+section has_smul
+variables [topological_space α] [has_smul M α] [has_continuous_const_smul M α]
 
 @[to_additive]
 lemma filter.tendsto.const_smul {f : β → α} {l : filter β} {a : α} (hf : tendsto f l (𝓝 a))
@@ -96,7 +106,9 @@ lemma continuous.const_smul (hg : continuous g) (c : M) :
 (continuous_const_smul _).comp hg
 
 /-- If a scalar is central, then its right action is continuous when its left action is. -/
-instance has_continuous_const_smul.op [has_scalar Mᵐᵒᵖ α] [is_central_scalar M α] :
+@[to_additive "If an additive action is central, then its right action is continuous when its left
+action is."]
+instance has_continuous_const_smul.op [has_smul Mᵐᵒᵖ α] [is_central_scalar M α] :
   has_continuous_const_smul Mᵐᵒᵖ α :=
 ⟨ mul_opposite.rec $ λ c, by simpa only [op_smul_eq_smul] using continuous_const_smul c ⟩
 
@@ -104,17 +116,27 @@ instance has_continuous_const_smul.op [has_scalar Mᵐᵒᵖ α] [is_central_sca
   has_continuous_const_smul M αᵐᵒᵖ :=
 ⟨λ c, mul_opposite.continuous_op.comp $ mul_opposite.continuous_unop.const_smul c⟩
 
+@[to_additive] instance : has_continuous_const_smul M αᵒᵈ := ‹has_continuous_const_smul M α›
+
+@[to_additive] instance order_dual.has_continuous_const_smul' : has_continuous_const_smul Mᵒᵈ α :=
+‹has_continuous_const_smul M α›
+
 @[to_additive]
-instance [has_scalar M β] [has_continuous_const_smul M β] :
+instance [has_smul M β] [has_continuous_const_smul M β] :
   has_continuous_const_smul M (α × β) :=
 ⟨λ _, (continuous_fst.const_smul _).prod_mk (continuous_snd.const_smul _)⟩
 
 @[to_additive]
-instance {ι : Type*} {γ : ι → Type*} [∀ i, topological_space (γ i)] [Π i, has_scalar M (γ i)]
+instance {ι : Type*} {γ : ι → Type*} [∀ i, topological_space (γ i)] [Π i, has_smul M (γ i)]
   [∀ i, has_continuous_const_smul M (γ i)] : has_continuous_const_smul M (Π i, γ i) :=
 ⟨λ _, continuous_pi $ λ i, (continuous_apply i).const_smul _⟩
 
-end has_scalar
+@[to_additive]
+lemma is_compact.smul {α β} [has_smul α β] [topological_space β]
+  [has_continuous_const_smul α β] (a : α) {s : set β}
+  (hs : is_compact s) : is_compact (a • s) := hs.image (continuous_id'.const_smul a)
+
+end has_smul
 
 section monoid
 
@@ -195,6 +217,9 @@ is_closed_map_smul c s hs
 @[to_additive] lemma closure_smul (c : G) (s : set α) : closure (c • s) = c • closure s :=
 ((homeomorph.smul c).image_closure s).symm
 
+@[to_additive] lemma dense.smul (c : G) {s : set α} (hs : dense s) : dense (c • s) :=
+by rw [dense_iff_closure_eq] at ⊢ hs; rw [closure_smul, hs, smul_set_univ]
+
 @[to_additive] lemma interior_smul (c : G) (s : set α) : interior (c • s) = c • interior s :=
 ((homeomorph.smul c).image_interior s).symm
 
@@ -281,6 +306,18 @@ lemma is_closed.smul₀ {𝕜 M : Type*} [division_ring 𝕜] [add_comm_monoid M
   is_closed (c • s) :=
 is_closed_map_smul₀ c s hs
 
+lemma has_compact_mul_support.comp_smul {β : Type*} [has_one β] {f : α → β}
+  (h : has_compact_mul_support f) {c : G₀} (hc : c ≠ 0) :
+  has_compact_mul_support (λ x, f (c • x)) :=
+h.comp_homeomorph (homeomorph.smul_of_ne_zero c hc)
+
+lemma has_compact_support.comp_smul {β : Type*} [has_zero β] {f : α → β}
+  (h : has_compact_support f) {c : G₀} (hc : c ≠ 0) :
+  has_compact_support (λ x, f (c • x)) :=
+h.comp_homeomorph (homeomorph.smul_of_ne_zero c hc)
+
+attribute [to_additive has_compact_support.comp_smul] has_compact_mul_support.comp_smul
+
 end group_with_zero
 
 namespace is_unit
@@ -322,7 +359,7 @@ is properly discontinuous, that is, for any pair of compact sets `K, L` in `T`,
 `γ:Γ` move `K` to have nontrivial intersection with `L`.
 -/
 class properly_discontinuous_smul (Γ : Type*) (T : Type*) [topological_space T]
-  [has_scalar Γ T] : Prop :=
+  [has_smul Γ T] : Prop :=
 (finite_disjoint_inter_image : ∀ {K L : set T}, is_compact K → is_compact L →
   set.finite {γ : Γ | (((•) γ) '' K) ∩ L ≠ ∅ })
 
@@ -339,18 +376,19 @@ attribute [to_additive] properly_discontinuous_smul
 
 variables {Γ : Type*} [group Γ] {T : Type*} [topological_space T] [mul_action Γ T]
 
-/-- A finite group action is always properly discontinuous
--/
-@[priority 100, to_additive] instance fintype.properly_discontinuous_smul [fintype Γ] :
-  properly_discontinuous_smul Γ T :=
-{ finite_disjoint_inter_image := λ _ _ _ _, set.finite.of_fintype _}
+/-- A finite group action is always properly discontinuous. -/
+@[priority 100, to_additive "A finite group action is always properly discontinuous."]
+instance finite.to_properly_discontinuous_smul [finite Γ] : properly_discontinuous_smul Γ T :=
+{ finite_disjoint_inter_image := λ _ _ _ _, set.to_finite _}
 
 export properly_discontinuous_smul (finite_disjoint_inter_image)
 
 export properly_discontinuous_vadd (finite_disjoint_inter_image)
 
-/-- The quotient map by a group action is open. -/
-@[to_additive]
+/-- The quotient map by a group action is open, i.e. the quotient by a group action is an open
+  quotient. -/
+@[to_additive "The quotient map by a group action is open, i.e. the quotient by a group
+action is an open quotient. "]
 lemma is_open_map_quotient_mk_mul [has_continuous_const_smul Γ T] :
   is_open_map (quotient.mk : T → quotient (mul_action.orbit_rel Γ T)) :=
 begin
@@ -360,16 +398,18 @@ begin
 end
 
 /-- The quotient by a discontinuous group action of a locally compact t2 space is t2. -/
-@[priority 100, to_additive] instance t2_space_of_properly_discontinuous_smul_of_t2_space
-  [t2_space T] [locally_compact_space T] [has_continuous_const_smul Γ T]
-  [properly_discontinuous_smul Γ T] : t2_space (quotient (mul_action.orbit_rel Γ T)) :=
+@[priority 100, to_additive "The quotient by a discontinuous group action of a locally compact t2
+space is t2."]
+instance t2_space_of_properly_discontinuous_smul_of_t2_space [t2_space T] [locally_compact_space T]
+  [has_continuous_const_smul Γ T] [properly_discontinuous_smul Γ T] :
+  t2_space (quotient (mul_action.orbit_rel Γ T)) :=
 begin
   set Q := quotient (mul_action.orbit_rel Γ T),
   rw t2_space_iff_nhds,
   let f : T → Q := quotient.mk,
   have f_op : is_open_map f := is_open_map_quotient_mk_mul,
   rintros ⟨x₀⟩ ⟨y₀⟩ (hxy : f x₀ ≠ f y₀),
-  show ∃ (U ∈ 𝓝 (f x₀)) (V ∈ 𝓝 (f y₀)), U ∩ V = ∅,
+  show ∃ (U ∈ 𝓝 (f x₀)) (V ∈ 𝓝 (f y₀)), _,
   have hx₀y₀ : x₀ ≠ y₀ := ne_of_apply_ne _ hxy,
   have hγx₀y₀ : ∀ γ : Γ, γ • x₀ ≠ y₀ := not_exists.mp (mt quotient.sound hxy.symm : _),
   obtain ⟨K₀, L₀, K₀_in, L₀_in, hK₀, hL₀, hK₀L₀⟩ := t2_separation_compact_nhds hx₀y₀,
@@ -385,18 +425,23 @@ begin
     exact (continuous_const_smul _).continuous_at (hu γ) },
   have V_nhds : f '' V₀ ∈ 𝓝 (f y₀),
     from f_op.image_mem_nhds (inter_mem ((bInter_mem bad_Γ_finite).mpr $ λ γ hγ, hv γ) L₀_in),
-  refine ⟨f '' U₀, U_nhds, f '' V₀, V_nhds, _⟩,
-  rw mul_action.image_inter_image_iff,
+  refine ⟨f '' U₀, U_nhds, f '' V₀, V_nhds, mul_action.disjoint_image_image_iff.2 _⟩,
   rintros x ⟨x_in_U₀₀, x_in_K₀⟩ γ,
   by_cases H : γ ∈ bad_Γ_set,
-  { rintros ⟨h, -⟩,
-    exact eq_empty_iff_forall_not_mem.mp (u_v_disjoint γ) (γ • x)
-      ⟨(mem_Inter₂.mp x_in_U₀₀ γ H : _), mem_Inter₂.mp h γ H⟩ },
+  { exact λ h, (u_v_disjoint γ).le_bot ⟨mem_Inter₂.mp x_in_U₀₀ γ H, mem_Inter₂.mp h.1 γ H⟩ },
   { rintros ⟨-, h'⟩,
     simp only [image_smul, not_not, mem_set_of_eq, ne.def] at H,
     exact eq_empty_iff_forall_not_mem.mp H (γ • x) ⟨mem_image_of_mem _ x_in_K₀, h'⟩ },
 end
 
+/-- The quotient of a second countable space by a group action is second countable. -/
+@[to_additive "The quotient of a second countable space by an additive group action is second
+countable."]
+theorem has_continuous_const_smul.second_countable_topology [second_countable_topology T]
+  [has_continuous_const_smul Γ T] :
+  second_countable_topology (quotient (mul_action.orbit_rel Γ T)) :=
+topological_space.quotient.second_countable_topology is_open_map_quotient_mk_mul
+
 section nhds
 
 section mul_action
diff --git a/src/topology/algebra/constructions.lean b/src/topology/algebra/constructions.lean
index d41da27532151..1d4aa52d818f3 100644
--- a/src/topology/algebra/constructions.lean
+++ b/src/topology/algebra/constructions.lean
@@ -8,6 +8,9 @@ import topology.homeomorph
 /-!
 # Topological space structure on the opposite monoid and on the units group
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `topological_space` structure on `Mᵐᵒᵖ`, `Mᵃᵒᵖ`, `Mˣ`, and `add_units M`.
 This file does not import definitions of a topological monoid and/or a continuous multiplicative
 action, so we postpone the proofs of `has_continuous_mul Mᵐᵒᵖ` etc till we have these definitions.
@@ -20,12 +23,14 @@ topological space, opposite monoid, units
 variables {M X : Type*}
 
 open filter
-open_locale topological_space
+open_locale topology
 
 namespace mul_opposite
 
 /-- Put the same topological space structure on the opposite monoid as on the original space. -/
-@[to_additive] instance [topological_space M] : topological_space Mᵐᵒᵖ :=
+@[to_additive "Put the same topological space structure on the opposite monoid as on the original
+space."]
+instance [topological_space M] : topological_space Mᵐᵒᵖ :=
 topological_space.induced (unop : Mᵐᵒᵖ → M) ‹_›
 
 variables [topological_space M]
@@ -34,18 +39,18 @@ variables [topological_space M]
 continuous_induced_dom
 
 @[continuity, to_additive] lemma continuous_op : continuous (op : M → Mᵐᵒᵖ) :=
-continuous_induced_rng continuous_id
-
-@[to_additive] instance [t2_space M] : t2_space Mᵐᵒᵖ :=
-⟨λ x y h, separated_by_continuous mul_opposite.continuous_unop $ unop_injective.ne h⟩
+continuous_induced_rng.2 continuous_id
 
 /-- `mul_opposite.op` as a homeomorphism. -/
-@[to_additive "`add_opposite.op` as a homeomorphism."]
+@[to_additive "`add_opposite.op` as a homeomorphism.", simps]
 def op_homeomorph : M ≃ₜ Mᵐᵒᵖ :=
 { to_equiv := op_equiv,
   continuous_to_fun := continuous_op,
   continuous_inv_fun := continuous_unop }
 
+@[to_additive] instance [t2_space M] : t2_space Mᵐᵒᵖ :=
+op_homeomorph.symm.embedding.t2_space
+
 @[simp, to_additive] lemma map_op_nhds (x : M) : map (op : M → Mᵐᵒᵖ) (𝓝 x) = 𝓝 (op x) :=
 op_homeomorph.map_nhds_eq x
 
@@ -64,11 +69,37 @@ namespace units
 
 open mul_opposite
 
-variables [topological_space M] [monoid M]
+variables [topological_space M] [monoid M] [topological_space X]
 
 /-- The units of a monoid are equipped with a topology, via the embedding into `M × M`. -/
-@[to_additive] instance : topological_space Mˣ :=
-topological_space.induced (embed_product M) prod.topological_space
+@[to_additive "The additive units of a monoid are equipped with a topology, via the embedding into
+`M × M`."]
+instance : topological_space Mˣ := prod.topological_space.induced (embed_product M)
+
+@[to_additive] lemma inducing_embed_product : inducing (embed_product M) := ⟨rfl⟩
+
+@[to_additive] lemma embedding_embed_product : embedding (embed_product M) :=
+⟨inducing_embed_product, embed_product_injective M⟩
+
+@[to_additive] lemma topology_eq_inf :
+  units.topological_space = topological_space.induced (coe : Mˣ → M) ‹_› ⊓
+    topological_space.induced (λ u, ↑u⁻¹ : Mˣ → M) ‹_› :=
+by simp only [inducing_embed_product.1, prod.topological_space, induced_inf,
+  mul_opposite.topological_space, induced_compose]; refl
+
+/-- An auxiliary lemma that can be used to prove that coercion `Mˣ → M` is a topological embedding.
+Use `units.coe_embedding₀`, `units.coe_embedding`, or `to_units_homeomorph` instead. -/
+@[to_additive "An auxiliary lemma that can be used to prove that coercion `add_units M → M` is a
+topological embedding. Use `add_units.coe_embedding` or `to_add_units_homeomorph` instead."]
+lemma embedding_coe_mk {M : Type*} [division_monoid M] [topological_space M]
+  (h : continuous_on has_inv.inv {x : M | is_unit x}) : embedding (coe : Mˣ → M) :=
+begin
+  refine ⟨⟨_⟩, ext⟩,
+  rw [topology_eq_inf, inf_eq_left, ← continuous_iff_le_induced, continuous_iff_continuous_at],
+  intros u s hs,
+  simp only [coe_inv, nhds_induced, filter.mem_map] at hs ⊢,
+  exact ⟨_, mem_inf_principal.1 (h u u.is_unit hs), λ u' hu', hu' u'.is_unit⟩
+end
 
 @[to_additive] lemma continuous_embed_product : continuous (embed_product M) :=
 continuous_induced_dom
@@ -76,4 +107,12 @@ continuous_induced_dom
 @[to_additive] lemma continuous_coe : continuous (coe : Mˣ → M) :=
 (@continuous_embed_product M _ _).fst
 
+@[to_additive] protected lemma continuous_iff {f : X → Mˣ} :
+  continuous f ↔ continuous (coe ∘ f : X → M) ∧ continuous (λ x, ↑(f x)⁻¹ : X → M) :=
+by simp only [inducing_embed_product.continuous_iff, embed_product_apply, (∘), continuous_prod_mk,
+  op_homeomorph.symm.inducing.continuous_iff, op_homeomorph_symm_apply, unop_op]
+
+@[to_additive] lemma continuous_coe_inv : continuous (λ u, ↑u⁻¹ : Mˣ → M) :=
+(units.continuous_iff.1 continuous_id).2
+
 end units
diff --git a/src/topology/algebra/continuous_affine_map.lean b/src/topology/algebra/continuous_affine_map.lean
index 3b560a01d7064..37500de93756f 100644
--- a/src/topology/algebra/continuous_affine_map.lean
+++ b/src/topology/algebra/continuous_affine_map.lean
@@ -10,6 +10,9 @@ import topology.algebra.module.basic
 /-!
 # Continuous affine maps.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines a type of bundled continuous affine maps.
 
 Note that the definition and basic properties established here require minimal assumptions, and do
@@ -45,30 +48,34 @@ variables [add_comm_group W] [module R W] [topological_space Q] [add_torsor W Q]
 
 include V W
 
-/-- see Note [function coercion] -/
-instance : has_coe_to_fun (P →A[R] Q) (λ _, P → Q) := ⟨λ f, f.to_affine_map.to_fun⟩
+instance : has_coe (P →A[R] Q) (P →ᵃ[R] Q) :=
+⟨to_affine_map⟩
+
+lemma to_affine_map_injective {f g : P →A[R] Q} (h : (f : P →ᵃ[R] Q) = (g : P →ᵃ[R] Q)) : f = g :=
+by { cases f, cases g, congr' }
+
+instance : continuous_map_class (P →A[R] Q) P Q :=
+{ coe := λ f, f.to_affine_map,
+  coe_injective' := λ f g h, to_affine_map_injective $ fun_like.coe_injective h,
+  map_continuous := cont }
+
+/-- Helper instance for when there's too many metavariables to apply
+`fun_like.has_coe_to_fun` directly. -/
+instance : has_coe_to_fun (P →A[R] Q) (λ _, P → Q) := fun_like.has_coe_to_fun
 
 lemma to_fun_eq_coe (f : P →A[R] Q) : f.to_fun = ⇑f := rfl
 
-lemma coe_injective :
-  @function.injective (P →A[R] Q) (P → Q) coe_fn :=
-begin
-  rintros ⟨⟨f, ⟨f', hf₁, hf₂⟩, hf₀⟩, hf₁⟩ ⟨⟨g, ⟨g', hg₁, hg₂⟩, hg₀⟩, hg₁⟩ h,
-  have : f = g ∧ f' = g', { simpa only using affine_map.coe_fn_injective h, },
-  congr,
-  exacts [this.1, this.2],
-end
+lemma coe_injective : @function.injective (P →A[R] Q) (P → Q) coe_fn :=
+fun_like.coe_injective
 
 @[ext] lemma ext {f g : P →A[R] Q} (h : ∀ x, f x = g x) : f = g :=
-coe_injective $ funext h
+fun_like.ext _ _ h
 
 lemma ext_iff {f g : P →A[R] Q} : f = g ↔ ∀ x, f x = g x :=
-⟨by { rintro rfl x, refl, }, ext⟩
+fun_like.ext_iff
 
-lemma congr_fun {f g : P →A[R] Q} (h : f = g) (x : P) : f x = g x := h ▸ rfl
-
-instance : has_coe (P →A[R] Q) (P →ᵃ[R] Q) :=
-⟨to_affine_map⟩
+lemma congr_fun {f g : P →A[R] Q} (h : f = g) (x : P) : f x = g x :=
+fun_like.congr_fun h _
 
 /-- Forgetting its algebraic properties, a continuous affine map is a continuous map. -/
 def to_continuous_map (f : P →A[R] Q) : C(P, Q) :=
@@ -92,10 +99,6 @@ rfl
   ((f : C(P, Q)) : P → Q) = f :=
 rfl
 
-lemma to_affine_map_injective {f g : P →A[R] Q}
-  (h : (f : P →ᵃ[R] Q) = (g : P →ᵃ[R] Q)) : f = g :=
-by { ext a, exact affine_map.congr_fun h a, }
-
 lemma to_continuous_map_injective {f g : P →A[R] Q}
   (h : (f : C(P, Q)) = (g : C(P, Q))) : f = g :=
 by { ext a, exact continuous_map.congr_fun h a, }
@@ -167,7 +170,7 @@ section mul_action
 variables [monoid S] [distrib_mul_action S W] [smul_comm_class R S W]
 variables [has_continuous_const_smul S W]
 
-instance : has_scalar S (P →A[R] W) :=
+instance : has_smul S (P →A[R] W) :=
 { smul := λ t f, { cont := f.continuous.const_smul t, .. (t • (f : P →ᵃ[R] W)) } }
 
 @[norm_cast, simp] lemma coe_smul (t : S) (f : P →A[R] W) : ⇑(t • f) = t • f := rfl
diff --git a/src/topology/algebra/continuous_monoid_hom.lean b/src/topology/algebra/continuous_monoid_hom.lean
index d35b9e98677b7..75e8053ff2cac 100644
--- a/src/topology/algebra/continuous_monoid_hom.lean
+++ b/src/topology/algebra/continuous_monoid_hom.lean
@@ -10,60 +10,69 @@ import topology.continuous_function.algebra
 
 # Continuous Monoid Homs
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the space of continuous homomorphisms between two topological groups.
 
 ## Main definitions
 
 * `continuous_monoid_hom A B`: The continuous homomorphisms `A →* B`.
-* `continuous_add_monoid_hom α β`: The continuous additive homomorphisms `α →+ β`.
+* `continuous_add_monoid_hom A B`: The continuous additive homomorphisms `A →+ B`.
 -/
 
 open_locale pointwise
 
 open function
 
-variables {F α β : Type*} (A B C D E : Type*)
-  [monoid A] [monoid B] [monoid C] [monoid D] [comm_group E]
+variables (F A B C D E : Type*) [monoid A] [monoid B] [monoid C] [monoid D] [comm_group E]
   [topological_space A] [topological_space B] [topological_space C] [topological_space D]
   [topological_space E] [topological_group E]
 
-/-- The type of continuous additive monoid homomorphisms from `α` to `β`.
+/-- The type of continuous additive monoid homomorphisms from `A` to `B`.
 
-When possible, instead of parametrizing results over `(f : continuous_add_monoid_hom α β)`,
-you should parametrize over `(F : Type*) [continuous_add_monoid_hom_class F α β] (f : F)`.
+When possible, instead of parametrizing results over `(f : continuous_add_monoid_hom A B)`,
+you should parametrize over `(F : Type*) [continuous_add_monoid_hom_class F A B] (f : F)`.
 
 When you extend this structure, make sure to extend `continuous_add_monoid_hom_class`. -/
 structure continuous_add_monoid_hom (A B : Type*) [add_monoid A] [add_monoid B]
   [topological_space A] [topological_space B] extends A →+ B :=
 (continuous_to_fun : continuous to_fun)
 
-/-- The type of continuous monoid homomorphisms from `α` to `β`.
+/-- The type of continuous monoid homomorphisms from `A` to `B`.
 
-When possible, instead of parametrizing results over `(f : continuous_monoid_hom α β)`,
-you should parametrize over `(F : Type*) [continuous_monoid_hom_class F α β] (f : F)`.
+When possible, instead of parametrizing results over `(f : continuous_monoid_hom A B)`,
+you should parametrize over `(F : Type*) [continuous_monoid_hom_class F A B] (f : F)`.
 
 When you extend this structure, make sure to extend `continuous_add_monoid_hom_class`. -/
 @[to_additive]
 structure continuous_monoid_hom extends A →* B :=
 (continuous_to_fun : continuous to_fun)
 
-/-- `continuous_add_monoid_hom_class F α β` states that `F` is a type of continuous additive monoid
+section
+set_option old_structure_cmd true
+
+/-- `continuous_add_monoid_hom_class F A B` states that `F` is a type of continuous additive monoid
 homomorphisms.
 
 You should also extend this typeclass when you extend `continuous_add_monoid_hom`. -/
-class continuous_add_monoid_hom_class (F α β : Type*) [add_monoid α] [add_monoid β]
-  [topological_space α] [topological_space β] extends add_monoid_hom_class F α β :=
+class continuous_add_monoid_hom_class (A B : Type*) [add_monoid A] [add_monoid B]
+  [topological_space A] [topological_space B] extends add_monoid_hom_class F A B :=
 (map_continuous (f : F) : continuous f)
 
-/-- `continuous_monoid_hom_class F α β` states that `F` is a type of continuous additive monoid
+/-- `continuous_monoid_hom_class F A B` states that `F` is a type of continuous additive monoid
 homomorphisms.
 
 You should also extend this typeclass when you extend `continuous_monoid_hom`. -/
 @[to_additive]
-class continuous_monoid_hom_class (F α β : Type*) [monoid α] [monoid β]
-  [topological_space α] [topological_space β] extends monoid_hom_class F α β :=
+class continuous_monoid_hom_class extends monoid_hom_class F A B :=
 (map_continuous (f : F) : continuous f)
 
+attribute [to_additive continuous_add_monoid_hom_class.to_add_monoid_hom_class]
+  continuous_monoid_hom_class.to_monoid_hom_class
+
+end
+
 /-- Reinterpret a `continuous_monoid_hom` as a `monoid_hom`. -/
 add_decl_doc continuous_monoid_hom.to_monoid_hom
 
@@ -71,16 +80,15 @@ add_decl_doc continuous_monoid_hom.to_monoid_hom
 add_decl_doc continuous_add_monoid_hom.to_add_monoid_hom
 
 @[priority 100, to_additive] -- See note [lower instance priority]
-instance continuous_monoid_hom_class.to_continuous_map_class [monoid α] [monoid β]
-  [topological_space α] [topological_space β] [continuous_monoid_hom_class F α β] :
-  continuous_map_class F α β :=
-{ .. ‹continuous_monoid_hom_class F α β› }
+instance continuous_monoid_hom_class.to_continuous_map_class [continuous_monoid_hom_class F A B] :
+  continuous_map_class F A B :=
+{ .. ‹continuous_monoid_hom_class F A B› }
 
 namespace continuous_monoid_hom
-variables {A B C D E} [monoid α] [monoid β] [topological_space α] [topological_space β]
+variables {A B C D E}
 
 @[to_additive]
-instance : continuous_monoid_hom_class (continuous_monoid_hom α β) α β :=
+instance : continuous_monoid_hom_class (continuous_monoid_hom A B) A B :=
 { coe := λ f, f.to_fun,
   coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
   map_mul := λ f, f.map_mul',
@@ -89,17 +97,18 @@ instance : continuous_monoid_hom_class (continuous_monoid_hom α β) α β :=
 
 /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
 directly. -/
-@[to_additive] instance : has_coe_to_fun (continuous_monoid_hom A B) (λ _, A → B) :=
-fun_like.has_coe_to_fun
+@[to_additive "Helper instance for when there's too many metavariables to apply
+`fun_like.has_coe_to_fun` directly."]
+instance : has_coe_to_fun (continuous_monoid_hom A B) (λ _, A → B) := fun_like.has_coe_to_fun
 
-@[to_additive] lemma ext {f g : continuous_monoid_hom A B} (h : ∀ x, f x = g x) : f = g :=
+@[to_additive, ext] lemma ext {f g : continuous_monoid_hom A B} (h : ∀ x, f x = g x) : f = g :=
 fun_like.ext _ _ h
 
 /-- Reinterpret a `continuous_monoid_hom` as a `continuous_map`. -/
 @[to_additive "Reinterpret a `continuous_add_monoid_hom` as a `continuous_map`."]
-def to_continuous_map (f : continuous_monoid_hom α β) : C(α, β) := { .. f}
+def to_continuous_map (f : continuous_monoid_hom A B) : C(A, B) := { .. f}
 
-@[to_additive] lemma to_continuous_map_injective : injective (to_continuous_map : _ → C(α, β)) :=
+@[to_additive] lemma to_continuous_map_injective : injective (to_continuous_map : _ → C(A, B)) :=
 λ f g h, ext $ by convert fun_like.ext_iff.1 h
 
 /-- Construct a `continuous_monoid_hom` from a `continuous` `monoid_hom`. -/
@@ -170,7 +179,7 @@ mk' mul_monoid_hom continuous_mul
 /-- The continuous homomorphism given by inversion. -/
 @[to_additive "The continuous homomorphism given by negation.", simps]
 def inv : continuous_monoid_hom E E :=
-mk' comm_group.inv_monoid_hom continuous_inv
+mk' inv_monoid_hom continuous_inv
 
 variables {A B C D E}
 
@@ -190,19 +199,21 @@ def coprod (f : continuous_monoid_hom A E) (g : continuous_monoid_hom B E) :
   inv := λ f, (inv E).comp f,
   mul_left_inv := λ f, ext (λ x, mul_left_inv (f x)) }
 
-instance : topological_space (continuous_monoid_hom A B) :=
+@[to_additive] instance : topological_space (continuous_monoid_hom A B) :=
 topological_space.induced to_continuous_map continuous_map.compact_open
 
 variables (A B C D E)
 
-lemma is_inducing : inducing (to_continuous_map : continuous_monoid_hom A B → C(A, B)) := ⟨rfl⟩
+@[to_additive] lemma inducing_to_continuous_map :
+  inducing (to_continuous_map : continuous_monoid_hom A B → C(A, B)) := ⟨rfl⟩
 
-lemma is_embedding : embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
-⟨is_inducing A B, to_continuous_map_injective⟩
+@[to_additive] lemma embedding_to_continuous_map :
+  embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
+⟨inducing_to_continuous_map A B, to_continuous_map_injective⟩
 
-lemma is_closed_embedding [has_continuous_mul B] [t2_space B] :
+@[to_additive] lemma closed_embedding_to_continuous_map [has_continuous_mul B] [t2_space B] :
   closed_embedding (to_continuous_map : continuous_monoid_hom A B → C(A, B)) :=
-⟨is_embedding A B, ⟨begin
+⟨embedding_to_continuous_map A B, ⟨begin
   suffices : (set.range (to_continuous_map : continuous_monoid_hom A B → C(A, B))) =
     ({f | f '' {1} ⊆ {1}ᶜ} ∪ ⋃ (x y) (U V W) (hU : is_open U) (hV : is_open V) (hW : is_open W)
     (h : disjoint (U * V) W), {f | f '' {x} ⊆ U} ∩ {f | f '' {y} ⊆ V} ∩ {f | f '' {x * y} ⊆ W})ᶜ,
@@ -216,7 +227,7 @@ lemma is_closed_embedding [has_continuous_mul B] [t2_space B] :
   refine λ f, ⟨_, _⟩,
   { rintros ⟨f, rfl⟩,
     exact ⟨λ h, h (map_one f), λ x y U V W hU hV hW h ⟨⟨hfU, hfV⟩, hfW⟩,
-      h ⟨set.mul_mem_mul hfU hfV, (congr_arg (∈ W) (map_mul f x y)).mp hfW⟩⟩ },
+      h.le_bot ⟨set.mul_mem_mul hfU hfV, (congr_arg (∈ W) (map_mul f x y)).mp hfW⟩⟩ },
   { rintros ⟨hf1, hf2⟩,
     suffices : ∀ x y, f (x * y) = f x * f y,
     { refine ⟨({ map_one' := of_not_not hf1, map_mul' := this, .. f } : continuous_monoid_hom A B),
@@ -226,23 +237,108 @@ lemma is_closed_embedding [has_continuous_mul B] [t2_space B] :
     obtain ⟨UV, W, hUV, hW, hfUV, hfW, h⟩ := t2_separation hf2.symm,
     have hB := @continuous_mul B _ _ _,
     obtain ⟨U, V, hU, hV, hfU, hfV, h'⟩ := is_open_prod_iff.mp (hUV.preimage hB) (f x) (f y) hfUV,
-    refine ⟨x, y, U, V, W, hU, hV, hW, ((disjoint_iff.mpr h).mono_left _), ⟨hfU, hfV⟩, hfW⟩,
+    refine ⟨x, y, U, V, W, hU, hV, hW, h.mono_left _, ⟨hfU, hfV⟩, hfW⟩,
     rintros _ ⟨x, y, hx : (x, y).1 ∈ U, hy : (x, y).2 ∈ V, rfl⟩,
     exact h' ⟨hx, hy⟩ },
 end⟩⟩
 
 variables {A B C D E}
 
-instance [t2_space B] : t2_space (continuous_monoid_hom A B) :=
-(is_embedding A B).t2_space
+@[to_additive] instance [t2_space B] : t2_space (continuous_monoid_hom A B) :=
+(embedding_to_continuous_map A B).t2_space
 
-instance : topological_group (continuous_monoid_hom A E) :=
-let hi := is_inducing A E, hc := hi.continuous in
+@[to_additive] instance : topological_group (continuous_monoid_hom A E) :=
+let hi := inducing_to_continuous_map A E, hc := hi.continuous in
 { continuous_mul := hi.continuous_iff.mpr (continuous_mul.comp (continuous.prod_map hc hc)),
   continuous_inv := hi.continuous_iff.mpr (continuous_inv.comp hc) }
 
+@[to_additive] lemma continuous_of_continuous_uncurry {A : Type*} [topological_space A]
+  (f : A → continuous_monoid_hom B C) (h : continuous (function.uncurry (λ x y, f x y))) :
+  continuous f :=
+(inducing_to_continuous_map _ _).continuous_iff.mpr
+  (continuous_map.continuous_of_continuous_uncurry _ h)
+
+@[to_additive] lemma continuous_comp [locally_compact_space B] :
+  continuous (λ f : continuous_monoid_hom A B × continuous_monoid_hom B C, f.2.comp f.1) :=
+(inducing_to_continuous_map A C).continuous_iff.2 $ (continuous_map.continuous_comp'.comp
+    ((inducing_to_continuous_map A B).prod_mk (inducing_to_continuous_map B C)).continuous)
+
+@[to_additive] lemma continuous_comp_left (f : continuous_monoid_hom A B) :
+  continuous (λ g : continuous_monoid_hom B C, g.comp f) :=
+(inducing_to_continuous_map A C).continuous_iff.2 $ f.to_continuous_map.continuous_comp_left.comp
+  (inducing_to_continuous_map B C).continuous
+
+@[to_additive] lemma continuous_comp_right (f : continuous_monoid_hom B C) :
+  continuous (λ g : continuous_monoid_hom A B, f.comp g) :=
+(inducing_to_continuous_map A C).continuous_iff.2 $ f.to_continuous_map.continuous_comp.comp
+  (inducing_to_continuous_map A B).continuous
+
+variables (E)
+
+/-- `continuous_monoid_hom _ f` is a functor. -/
+@[to_additive "`continuous_add_monoid_hom _ f` is a functor."]
+def comp_left (f : continuous_monoid_hom A B) :
+  continuous_monoid_hom (continuous_monoid_hom B E) (continuous_monoid_hom A E) :=
+{ to_fun := λ g, g.comp f,
+  map_one' := rfl,
+  map_mul' := λ g h, rfl,
+  continuous_to_fun := f.continuous_comp_left }
+
+variables (A) {E}
+
+/-- `continuous_monoid_hom f _` is a functor. -/
+@[to_additive "`continuous_add_monoid_hom f _` is a functor."]
+def comp_right {B : Type*} [comm_group B] [topological_space B]
+  [topological_group B] (f : continuous_monoid_hom B E) :
+  continuous_monoid_hom (continuous_monoid_hom A B) (continuous_monoid_hom A E) :=
+{ to_fun := λ g, f.comp g,
+  map_one' := ext (λ a, map_one f),
+  map_mul' := λ g h, ext (λ a, map_mul f (g a) (h a)),
+  continuous_to_fun := f.continuous_comp_right }
+
 end continuous_monoid_hom
 
-/-- The Pontryagin dual of `G` is the group of continuous homomorphism `G → circle`. -/
+/-- The Pontryagin dual of `A` is the group of continuous homomorphism `A → circle`. -/
 @[derive [topological_space, t2_space, comm_group, topological_group, inhabited]]
-def pontryagin_dual (G : Type*) [monoid G] [topological_space G] := continuous_monoid_hom G circle
+def pontryagin_dual := continuous_monoid_hom A circle
+
+variables {A B C D E}
+
+namespace pontryagin_dual
+
+open continuous_monoid_hom
+
+noncomputable instance : continuous_monoid_hom_class (pontryagin_dual A) A circle :=
+continuous_monoid_hom.continuous_monoid_hom_class
+
+/-- `pontryagin_dual` is a functor. -/
+noncomputable def map (f : continuous_monoid_hom A B) :
+  continuous_monoid_hom (pontryagin_dual B) (pontryagin_dual A) :=
+f.comp_left circle
+
+@[simp] lemma map_apply (f : continuous_monoid_hom A B) (x : pontryagin_dual B) (y : A) :
+  map f x y = x (f y) :=
+rfl
+
+@[simp] lemma map_one : map (one A B) = one (pontryagin_dual B) (pontryagin_dual A) :=
+ext (λ x, ext (λ y, map_one x))
+
+@[simp] lemma map_comp (g : continuous_monoid_hom B C) (f : continuous_monoid_hom A B) :
+  map (comp g f) = comp (map f) (map g) :=
+ext (λ x, ext (λ y, rfl))
+
+@[simp] lemma map_mul (f g : continuous_monoid_hom A E) : map (f * g) = map f * map g :=
+ext (λ x, ext (λ y, map_mul x (f y) (g y)))
+
+variables (A B C D E)
+
+/-- `continuous_monoid_hom.dual` as a `continuous_monoid_hom`. -/
+noncomputable def map_hom [locally_compact_space E] :
+  continuous_monoid_hom (continuous_monoid_hom A E)
+    (continuous_monoid_hom (pontryagin_dual E) (pontryagin_dual A)) :=
+{ to_fun := map,
+  map_one' := map_one,
+  map_mul' := map_mul,
+  continuous_to_fun := continuous_of_continuous_uncurry _ continuous_comp }
+
+end pontryagin_dual
diff --git a/src/topology/algebra/equicontinuity.lean b/src/topology/algebra/equicontinuity.lean
new file mode 100644
index 0000000000000..8b68b827aa406
--- /dev/null
+++ b/src/topology/algebra/equicontinuity.lean
@@ -0,0 +1,47 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+import topology.algebra.uniform_convergence
+
+/-!
+# Algebra-related equicontinuity criterions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+open function
+open_locale uniform_convergence
+
+@[to_additive] lemma equicontinuous_of_equicontinuous_at_one {ι G M hom : Type*}
+  [topological_space G] [uniform_space M] [group G] [group M] [topological_group G]
+  [uniform_group M] [monoid_hom_class hom G M] (F : ι → hom)
+  (hf : equicontinuous_at (coe_fn ∘ F) (1 : G)) :
+  equicontinuous (coe_fn ∘ F) :=
+begin
+  letI : has_coe_to_fun hom (λ _, G → M) := fun_like.has_coe_to_fun,
+  rw equicontinuous_iff_continuous,
+  rw equicontinuous_at_iff_continuous_at at hf,
+  let φ : G →* (ι → M) :=
+  { to_fun := swap (coe_fn ∘ F),
+    map_one' := by ext; exact map_one _,
+    map_mul' := λ a b, by ext; exact map_mul _ _ _ },
+  exact continuous_of_continuous_at_one φ hf
+end
+
+@[to_additive] lemma uniform_equicontinuous_of_equicontinuous_at_one {ι G M hom : Type*}
+  [uniform_space G] [uniform_space M] [group G] [group M] [uniform_group G] [uniform_group M]
+  [monoid_hom_class hom G M] (F : ι → hom) (hf : equicontinuous_at (coe_fn ∘ F) (1 : G)) :
+  uniform_equicontinuous (coe_fn ∘ F) :=
+begin
+  letI : has_coe_to_fun hom (λ _, G → M) := fun_like.has_coe_to_fun,
+  rw uniform_equicontinuous_iff_uniform_continuous,
+  rw equicontinuous_at_iff_continuous_at at hf,
+  let φ : G →* (ι → M) :=
+  { to_fun := swap (coe_fn ∘ F),
+    map_one' := by ext; exact map_one _,
+    map_mul' := λ a b, by ext; exact map_mul _ _ _ },
+  exact uniform_continuous_of_continuous_at_one φ hf
+end
diff --git a/src/topology/algebra/field.lean b/src/topology/algebra/field.lean
index e31339c795c4b..4ee0e1a7e9de6 100644
--- a/src/topology/algebra/field.lean
+++ b/src/topology/algebra/field.lean
@@ -3,111 +3,71 @@ Copyright (c) 2021 Patrick Massot. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Scott Morrison
 -/
-import topology.algebra.ring
+import topology.algebra.ring.basic
 import topology.algebra.group_with_zero
+import topology.local_extr
+import field_theory.subfield
 
 /-!
 # Topological fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A topological division ring is a topological ring whose inversion function is continuous at every
 non-zero element.
 
 -/
 
 
-namespace topological_ring
-open topological_space function
-variables (R : Type*) [semiring R]
-
-variables  [topological_space R]
-
-/-- The induced topology on units of a topological semiring.
-This is not a global instance since other topologies could be relevant. Instead there is a class
-`induced_units` asserting that something equivalent to this construction holds. -/
-def topological_space_units : topological_space Rˣ := induced (coe : Rˣ → R) ‹_›
-
-/-- Asserts the topology on units is the induced topology.
-
- Note: this is not always the correct topology.
- Another good candidate is the subspace topology of $R \times R$,
- with the units embedded via $u \mapsto (u, u^{-1})$.
- These topologies are not (propositionally) equal in general. -/
-class induced_units [t : topological_space $ Rˣ] : Prop :=
-(top_eq : t = induced (coe : Rˣ → R) ‹_›)
-
-variables [topological_space $ Rˣ]
-
-lemma units_topology_eq [induced_units R] :
-  ‹topological_space Rˣ› = induced (coe : Rˣ → R) ‹_› :=
-induced_units.top_eq
+variables {K : Type*} [division_ring K] [topological_space K]
 
-lemma induced_units.continuous_coe [induced_units R] : continuous (coe : Rˣ → R) :=
-(units_topology_eq R).symm ▸ continuous_induced_dom
+/-- Left-multiplication by a nonzero element of a topological division ring is proper, i.e.,
+inverse images of compact sets are compact. -/
+lemma filter.tendsto_cocompact_mul_left₀ [has_continuous_mul K] {a : K} (ha : a ≠ 0) :
+  filter.tendsto (λ x : K, a * x) (filter.cocompact K) (filter.cocompact K) :=
+filter.tendsto_cocompact_mul_left (inv_mul_cancel ha)
 
-lemma units_embedding [induced_units R] :
-  embedding (coe : Rˣ → R) :=
-{ induced := units_topology_eq R,
-  inj := λ x y h, units.ext h }
+/-- Right-multiplication by a nonzero element of a topological division ring is proper, i.e.,
+inverse images of compact sets are compact. -/
+lemma filter.tendsto_cocompact_mul_right₀ [has_continuous_mul K] {a : K} (ha : a ≠ 0) :
+  filter.tendsto (λ x : K, x * a) (filter.cocompact K) (filter.cocompact K) :=
+filter.tendsto_cocompact_mul_right (mul_inv_cancel ha)
 
-instance top_monoid_units [topological_semiring R] [induced_units R] :
-  has_continuous_mul Rˣ :=
-⟨begin
-  let mulR := (λ (p : R × R), p.1*p.2),
-  let mulRx := (λ (p : Rˣ × Rˣ), p.1*p.2),
-  have key : coe ∘ mulRx = mulR ∘ (λ p, (p.1.val, p.2.val)), from rfl,
-  rw [continuous_iff_le_induced, units_topology_eq R, prod_induced_induced,
-      induced_compose, key, ← induced_compose],
-  apply induced_mono,
-  rw ← continuous_iff_le_induced,
-  exact continuous_mul,
-end⟩
-end topological_ring
-
-variables (K : Type*) [division_ring K] [topological_space K]
+variables (K)
 
 /-- A topological division ring is a division ring with a topology where all operations are
     continuous, including inversion. -/
 class topological_division_ring extends topological_ring K, has_continuous_inv₀ K : Prop
 
-namespace topological_division_ring
-open filter set
-/-!
-In this section, we show that units of a topological division ring endowed with the
-induced topology form a topological group. These are not global instances because
-one could want another topology on units. To turn on this feature, use:
-
-```lean
-local attribute [instance]
-topological_semiring.topological_space_units topological_division_ring.units_top_group
-```
--/
-
-local attribute [instance] topological_ring.topological_space_units
-
-@[priority 100] instance induced_units : topological_ring.induced_units K := ⟨rfl⟩
+section subfield
 
-variables [topological_division_ring K]
+variables {α : Type*} [field α] [topological_space α] [topological_division_ring α]
 
-lemma units_top_group : topological_group Kˣ :=
-{ continuous_inv := begin
-     have : (coe : Kˣ → K) ∘ (λ x, x⁻¹ : Kˣ → Kˣ) =
-            (λ x, x⁻¹ : K → K) ∘ (coe : Kˣ → K), from funext units.coe_inv',
-     rw continuous_iff_continuous_at,
-     intros x,
-     rw [continuous_at, nhds_induced, nhds_induced, tendsto_iff_comap, comap_comm this],
-     apply comap_mono,
-     rw [← tendsto_iff_comap, units.coe_inv'],
-     exact continuous_at_inv₀ x.ne_zero
-   end ,
-  ..topological_ring.top_monoid_units K}
+/-- The (topological-space) closure of a subfield of a topological field is
+itself a subfield. -/
+def subfield.topological_closure (K : subfield α) : subfield α :=
+{ carrier := closure (K : set α),
+  inv_mem' := λ x hx,
+  begin
+    rcases eq_or_ne x 0 with (rfl | h),
+    { rwa [inv_zero] },
+    { rw [← inv_coe_set, ← set.image_inv],
+      exact mem_closure_image (continuous_at_inv₀ h) hx },
+  end,
+  ..K.to_subring.topological_closure, }
 
-local attribute [instance] units_top_group
+lemma subfield.le_topological_closure (s : subfield α) :
+  s ≤ s.topological_closure := subset_closure
 
-lemma continuous_units_inv : continuous (λ x : Kˣ, (↑(x⁻¹) : K)) :=
-(topological_ring.induced_units.continuous_coe K).comp continuous_inv
+lemma subfield.is_closed_topological_closure (s : subfield α) :
+  is_closed (s.topological_closure : set α) := is_closed_closure
 
-end topological_division_ring
+lemma subfield.topological_closure_minimal
+  (s : subfield α) {t : subfield α} (h : s ≤ t) (ht : is_closed (t : set α)) :
+  s.topological_closure ≤ t := closure_minimal h ht
 
+end subfield
 
 section affine_homeomorph
 /-!
@@ -128,3 +88,83 @@ def affine_homeomorph (a b : 𝕜) (h : a ≠ 0) : 𝕜 ≃ₜ 𝕜 :=
   right_inv := λ y, by { simp [mul_div_cancel' _ h], }, }
 
 end affine_homeomorph
+
+section local_extr
+
+variables {α β : Type*} [topological_space α] [linear_ordered_semifield β] {a : α}
+open_locale topology
+
+lemma is_local_min.inv {f : α → β} {a : α} (h1 : is_local_min f a) (h2 : ∀ᶠ z in 𝓝 a, 0 < f z) :
+  is_local_max f⁻¹ a :=
+by filter_upwards [h1, h2] with z h3 h4 using (inv_le_inv h4 h2.self_of_nhds).mpr h3
+
+end local_extr
+
+section preconnected
+/-! Some results about functions on preconnected sets valued in a ring or field with a topology. -/
+
+open set
+variables {α 𝕜 : Type*} {f g : α → 𝕜} {S : set α}
+  [topological_space α] [topological_space 𝕜] [t1_space 𝕜]
+
+/-- If `f` is a function `α → 𝕜` which is continuous on a preconnected set `S`, and
+`f ^ 2 = 1` on `S`, then either `f = 1` on `S`, or `f = -1` on `S`. -/
+lemma is_preconnected.eq_one_or_eq_neg_one_of_sq_eq [ring 𝕜] [no_zero_divisors 𝕜]
+  (hS : is_preconnected S) (hf : continuous_on f S) (hsq : eq_on (f ^ 2) 1 S) :
+  (eq_on f 1 S) ∨ (eq_on f (-1) S) :=
+begin
+  simp_rw [eq_on, pi.one_apply, pi.pow_apply, sq_eq_one_iff] at hsq,
+  -- First deal with crazy case where `S` is empty.
+  by_cases hSe : ∀ (x:α), x ∉ S,
+  { left, intros x hx,
+    exfalso, exact hSe x hx, },
+  push_neg at hSe,
+  choose y hy using hSe,
+  suffices : ∀ (x:α), x ∈ S → f x = f y,
+  { rcases (hsq hy),
+    { left, intros z hz, rw [pi.one_apply z, ←h], exact this z hz, },
+    { right, intros z hz, rw [pi.neg_apply, pi.one_apply, ←h], exact this z hz, } },
+  refine λ x hx, hS.constant_of_maps_to hf (λ z hz, _) hx hy,
+  show f z ∈ ({-1, 1} : set 𝕜),
+  { exact mem_insert_iff.mpr (hsq hz).symm,  },
+  exact discrete_of_t1_of_finite,
+end
+
+/-- If `f, g` are functions `α → 𝕜`, both continuous on a preconnected set `S`, with
+`f ^ 2 = g ^ 2` on `S`, and `g z ≠ 0` all `z ∈ S`, then either `f = g` or `f = -g` on
+`S`. -/
+lemma is_preconnected.eq_or_eq_neg_of_sq_eq [field 𝕜] [has_continuous_inv₀ 𝕜] [has_continuous_mul 𝕜]
+  (hS : is_preconnected S) (hf : continuous_on f S) (hg : continuous_on g S)
+  (hsq : eq_on (f ^ 2) (g ^ 2) S) (hg_ne : ∀ {x:α}, x ∈ S → g x ≠ 0) :
+  (eq_on f g S) ∨ (eq_on f (-g) S) :=
+begin
+  rcases hS.eq_one_or_eq_neg_one_of_sq_eq (hf.div hg (λ z hz, hg_ne hz)) (λ x hx, _) with h | h,
+  { refine or.inl (λ x hx, _),
+    rw ←div_eq_one_iff_eq (hg_ne hx),
+    exact h hx },
+  { refine or.inr (λ x hx, _),
+    specialize h hx,
+    rwa [pi.div_apply, pi.neg_apply, pi.one_apply, div_eq_iff (hg_ne hx), neg_one_mul] at h,  },
+  { rw [pi.one_apply, div_pow, pi.div_apply, hsq hx, div_self],
+    exact pow_ne_zero _ (hg_ne hx) },
+end
+
+/-- If `f, g` are functions `α → 𝕜`, both continuous on a preconnected set `S`, with
+`f ^ 2 = g ^ 2` on `S`, and `g z ≠ 0` all `z ∈ S`, then as soon as `f = g` holds at
+one point of `S` it holds for all points. -/
+lemma is_preconnected.eq_of_sq_eq [field 𝕜] [has_continuous_inv₀ 𝕜] [has_continuous_mul 𝕜]
+  (hS : is_preconnected S) (hf : continuous_on f S) (hg : continuous_on g S)
+  (hsq : eq_on (f ^ 2) (g ^ 2) S) (hg_ne : ∀ {x:α}, x ∈ S → g x ≠ 0)
+  {y : α} (hy : y ∈ S) (hy' : f y = g y) : eq_on f g S :=
+λ x hx, begin
+  rcases hS.eq_or_eq_neg_of_sq_eq hf hg @hsq @hg_ne with h | h,
+  { exact h hx },
+  { rw [h hy, eq_comm, ←sub_eq_zero, sub_eq_add_neg, pi.neg_apply,
+      neg_neg, ←mul_two, mul_eq_zero] at hy',
+    cases hy', -- need to handle case of `char 𝕜 = 2` separately
+    { exfalso, exact hg_ne hy hy' },
+    { rw [h hx, pi.neg_apply, eq_comm, ←sub_eq_zero, sub_eq_add_neg, neg_neg,
+       ←mul_two, hy', mul_zero], } },
+end
+
+end preconnected
diff --git a/src/topology/algebra/filter_basis.lean b/src/topology/algebra/filter_basis.lean
index 9df8133636bf2..8f9664a67dbda 100644
--- a/src/topology/algebra/filter_basis.lean
+++ b/src/topology/algebra/filter_basis.lean
@@ -9,6 +9,9 @@ import topology.algebra.module.basic
 /-!
 # Group and ring filter bases
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A `group_filter_basis` is a `filter_basis` on a group with some properties relating
 the basis to the group structure. The main theorem is that a `group_filter_basis`
 on a group gives a topology on the group which makes it into a topological group
@@ -35,7 +38,7 @@ Given a group `G` and a ring `R`:
 -/
 
 open filter set topological_space function
-open_locale topological_space filter pointwise
+open_locale topology filter pointwise
 
 universe u
 
@@ -67,7 +70,7 @@ attribute [to_additive] group_filter_basis.conj'
 attribute [to_additive] group_filter_basis.to_filter_basis
 
 /-- `group_filter_basis` constructor in the commutative group case. -/
-@[to_additive "`add_group_filter_basis` constructor in the commutative group case."]
+@[to_additive "`add_group_filter_basis` constructor in the additive commutative group case."]
 def group_filter_basis_of_comm {G : Type*} [comm_group G]
   (sets                   : set (set G))
   (nonempty               : sets.nonempty)
@@ -195,9 +198,10 @@ begin
   exact ⟨U, hU, rfl.subset⟩
 end
 
-/-- If a group is endowed with a topological structure coming from
-a group filter basis then it's a topological group. -/
-@[to_additive, priority 100]
+/-- If a group is endowed with a topological structure coming from a group filter basis then it's a
+topological group. -/
+@[to_additive "If a group is endowed with a topological structure coming from a group filter basis
+then it's a topological group.", priority 100] -- See note [lower instance priority]
 instance is_topological_group (B : group_filter_basis G) :
   @topological_group G B.topology _ :=
 begin
@@ -348,6 +352,40 @@ def topology' {R M : Type*} [comm_ring R] {tR : topological_space R}
   [add_comm_group M] [module R M] (B : module_filter_basis R M) : topological_space M :=
   B.to_add_group_filter_basis.topology
 
+/-- A topological add group whith a basis of `𝓝 0` satisfying the axioms of `module_filter_basis`
+is a topological module.
+
+This lemma is mathematically useless because one could obtain such a result by applying
+`module_filter_basis.has_continuous_smul` and use the fact that group topologies are characterized
+by their neighborhoods of 0 to obtain the `has_continuous_smul` on the pre-existing topology.
+
+But it turns out it's just easier to get it as a biproduct of the proof, so this is just a free
+quality-of-life improvement. -/
+lemma _root_.has_continuous_smul.of_basis_zero {ι : Type*} [topological_ring R]
+  [topological_space M] [topological_add_group M] {p : ι → Prop} {b : ι → set M}
+  (h : has_basis (𝓝 0) p b) (hsmul : ∀ {i}, p i → ∃ (V ∈ 𝓝 (0 : R)) j (hj : p j), V • (b j) ⊆ b i)
+  (hsmul_left : ∀ (x₀ : R) {i}, p i → ∃ j (hj : p j), (b j) ⊆ (λ x, x₀ • x) ⁻¹' (b i))
+  (hsmul_right : ∀ (m₀ : M) {i}, p i → ∀ᶠ x in 𝓝 (0 : R), x • m₀ ∈ (b i)) :
+  has_continuous_smul R M :=
+begin
+  apply has_continuous_smul.of_nhds_zero,
+  { rw h.tendsto_right_iff,
+    intros i hi,
+    rcases hsmul hi with ⟨V, V_in, j, hj, hVj⟩,
+    apply mem_of_superset (prod_mem_prod V_in $ h.mem_of_mem hj),
+    rintros ⟨v, w⟩ ⟨v_in : v ∈ V, w_in : w ∈ (b j)⟩,
+    exact hVj (set.smul_mem_smul v_in w_in) },
+  { intro m₀,
+    rw h.tendsto_right_iff,
+    intros i hi,
+    exact hsmul_right m₀ hi },
+  { intro x₀,
+    rw h.tendsto_right_iff,
+    intros i hi,
+    rcases hsmul_left x₀ hi with ⟨j, hj, hji⟩,
+    exact mem_of_superset (h.mem_of_mem hj) hji },
+end
+
 /-- If a module is endowed with a topological structure coming from
 a module filter basis then it's a topological module. -/
 @[priority 100]
@@ -356,24 +394,9 @@ instance has_continuous_smul [topological_ring R] :
 begin
   let B' := B.to_add_group_filter_basis,
   letI := B'.topology,
-  have basis := B'.nhds_zero_has_basis,
   haveI := B'.is_topological_add_group,
-  apply has_continuous_smul.of_nhds_zero,
-  { rw basis.tendsto_right_iff,
-    intros U U_in,
-    rcases B.smul U_in with ⟨V, V_in, W, W_in, H⟩,
-    apply mem_of_superset (prod_mem_prod V_in $ B'.mem_nhds_zero W_in),
-    rintros ⟨v, w⟩ ⟨v_in : v ∈ V, w_in : w ∈ W⟩,
-    exact H (set.smul_mem_smul v_in w_in) },
-  { intro m₀,
-    rw basis.tendsto_right_iff,
-    intros U U_in,
-    exact B.smul_right m₀ U_in },
-  { intro x₀,
-    rw basis.tendsto_right_iff,
-    intros U U_in,
-    rcases B.smul_left x₀ U_in with ⟨V, V_in, hV⟩,
-    exact mem_of_superset (B'.mem_nhds_zero V_in) hV },
+  exact has_continuous_smul.of_basis_zero B'.nhds_zero_has_basis (λ _, B.smul) B.smul_left
+    B.smul_right,
 end
 
 /-- Build a module filter basis from compatible ring and additive group filter bases. -/
diff --git a/src/topology/algebra/group.lean b/src/topology/algebra/group.lean
deleted file mode 100644
index c966322f5f58c..0000000000000
--- a/src/topology/algebra/group.lean
+++ /dev/null
@@ -1,1422 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
--/
-import group_theory.group_action.conj_act
-import group_theory.quotient_group
-import order.filter.pointwise
-import topology.algebra.monoid
-import topology.compact_open
-import topology.sets.compacts
-import topology.algebra.constructions
-
-/-!
-# Topological groups
-
-This file defines the following typeclasses:
-
-* `topological_group`, `topological_add_group`: multiplicative and additive topological groups,
-  i.e., groups with continuous `(*)` and `(⁻¹)` / `(+)` and `(-)`;
-
-* `has_continuous_sub G` means that `G` has a continuous subtraction operation.
-
-There is an instance deducing `has_continuous_sub` from `topological_group` but we use a separate
-typeclass because, e.g., `ℕ` and `ℝ≥0` have continuous subtraction but are not additive groups.
-
-We also define `homeomorph` versions of several `equiv`s: `homeomorph.mul_left`,
-`homeomorph.mul_right`, `homeomorph.inv`, and prove a few facts about neighbourhood filters in
-groups.
-
-## Tags
-
-topological space, group, topological group
--/
-
-open classical set filter topological_space function
-open_locale classical topological_space filter pointwise
-
-universes u v w x
-variables {α : Type u} {β : Type v} {G : Type w} {H : Type x}
-
-section continuous_mul_group
-
-/-!
-### Groups with continuous multiplication
-
-In this section we prove a few statements about groups with continuous `(*)`.
--/
-
-variables [topological_space G] [group G] [has_continuous_mul G]
-
-/-- Multiplication from the left in a topological group as a homeomorphism. -/
-@[to_additive "Addition from the left in a topological additive group as a homeomorphism."]
-protected def homeomorph.mul_left (a : G) : G ≃ₜ G :=
-{ continuous_to_fun  := continuous_const.mul continuous_id,
-  continuous_inv_fun := continuous_const.mul continuous_id,
-  .. equiv.mul_left a }
-
-@[simp, to_additive]
-lemma homeomorph.coe_mul_left (a : G) : ⇑(homeomorph.mul_left a) = (*) a := rfl
-
-@[to_additive]
-lemma homeomorph.mul_left_symm (a : G) : (homeomorph.mul_left a).symm = homeomorph.mul_left a⁻¹ :=
-by { ext, refl }
-
-@[to_additive]
-lemma is_open_map_mul_left (a : G) : is_open_map (λ x, a * x) :=
-(homeomorph.mul_left a).is_open_map
-
-@[to_additive is_open.left_add_coset]
-lemma is_open.left_coset {U : set G} (h : is_open U) (x : G) : is_open (left_coset x U) :=
-is_open_map_mul_left x _ h
-
-@[to_additive]
-lemma is_closed_map_mul_left (a : G) : is_closed_map (λ x, a * x) :=
-(homeomorph.mul_left a).is_closed_map
-
-@[to_additive is_closed.left_add_coset]
-lemma is_closed.left_coset {U : set G} (h : is_closed U) (x : G) : is_closed (left_coset x U) :=
-is_closed_map_mul_left x _ h
-
-/-- Multiplication from the right in a topological group as a homeomorphism. -/
-@[to_additive "Addition from the right in a topological additive group as a homeomorphism."]
-protected def homeomorph.mul_right (a : G) :
-  G ≃ₜ G :=
-{ continuous_to_fun  := continuous_id.mul continuous_const,
-  continuous_inv_fun := continuous_id.mul continuous_const,
-  .. equiv.mul_right a }
-
-@[simp, to_additive]
-lemma homeomorph.coe_mul_right (a : G) : ⇑(homeomorph.mul_right a) = λ g, g * a := rfl
-
-@[to_additive]
-lemma homeomorph.mul_right_symm (a : G) :
-  (homeomorph.mul_right a).symm = homeomorph.mul_right a⁻¹ :=
-by { ext, refl }
-
-@[to_additive]
-lemma is_open_map_mul_right (a : G) : is_open_map (λ x, x * a) :=
-(homeomorph.mul_right a).is_open_map
-
-@[to_additive is_open.right_add_coset]
-lemma is_open.right_coset {U : set G} (h : is_open U) (x : G) : is_open (right_coset U x) :=
-is_open_map_mul_right x _ h
-
-@[to_additive]
-lemma is_closed_map_mul_right (a : G) : is_closed_map (λ x, x * a) :=
-(homeomorph.mul_right a).is_closed_map
-
-@[to_additive is_closed.right_add_coset]
-lemma is_closed.right_coset {U : set G} (h : is_closed U) (x : G) : is_closed (right_coset U x) :=
-is_closed_map_mul_right x _ h
-
-@[to_additive]
-lemma discrete_topology_of_open_singleton_one (h : is_open ({1} : set G)) : discrete_topology G :=
-begin
-  rw ← singletons_open_iff_discrete,
-  intro g,
-  suffices : {g} = (λ (x : G), g⁻¹ * x) ⁻¹' {1},
-  { rw this, exact (continuous_mul_left (g⁻¹)).is_open_preimage _ h, },
-  simp only [mul_one, set.preimage_mul_left_singleton, eq_self_iff_true,
-    inv_inv, set.singleton_eq_singleton_iff],
-end
-
-@[to_additive]
-lemma discrete_topology_iff_open_singleton_one : discrete_topology G ↔ is_open ({1} : set G) :=
-⟨λ h, forall_open_iff_discrete.mpr h {1}, discrete_topology_of_open_singleton_one⟩
-
-end continuous_mul_group
-
-/-!
-### Topological operations on pointwise sums and products
-
-A few results about interior and closure of the pointwise addition/multiplication of sets in groups
-with continuous addition/multiplication. See also `submonoid.top_closure_mul_self_eq` in
-`topology.algebra.monoid`.
--/
-
-section pointwise
-variables [topological_space α] [group α] [has_continuous_mul α] {s t : set α}
-
-@[to_additive]
-lemma is_open.mul_left (ht : is_open t) : is_open (s * t) :=
-begin
-  rw ←Union_mul_left_image,
-  exact is_open_Union (λ a, is_open_Union $ λ ha, is_open_map_mul_left a t ht),
-end
-
-@[to_additive]
-lemma is_open.mul_right (hs : is_open s) : is_open (s * t) :=
-begin
-  rw ←Union_mul_right_image,
-  exact is_open_Union (λ a, is_open_Union $ λ ha, is_open_map_mul_right a s hs),
-end
-
-@[to_additive]
-lemma subset_interior_mul_left : interior s * t ⊆ interior (s * t) :=
-interior_maximal (set.mul_subset_mul_right interior_subset) is_open_interior.mul_right
-
-@[to_additive]
-lemma subset_interior_mul_right : s * interior t ⊆ interior (s * t) :=
-interior_maximal (set.mul_subset_mul_left interior_subset) is_open_interior.mul_left
-
-@[to_additive]
-lemma subset_interior_mul : interior s * interior t ⊆ interior (s * t) :=
-(set.mul_subset_mul_left interior_subset).trans subset_interior_mul_left
-
-end pointwise
-
-/-!
-### `has_continuous_inv` and `has_continuous_neg`
--/
-
-/-- Basic hypothesis to talk about a topological additive group. A topological additive group
-over `M`, for example, is obtained by requiring the instances `add_group M` and
-`has_continuous_add M` and `has_continuous_neg M`. -/
-class has_continuous_neg (G : Type u) [topological_space G] [has_neg G] : Prop :=
-(continuous_neg : continuous (λ a : G, -a))
-
-/-- Basic hypothesis to talk about a topological group. A topological group over `M`, for example,
-is obtained by requiring the instances `group M` and `has_continuous_mul M` and
-`has_continuous_inv M`. -/
-@[to_additive]
-class has_continuous_inv (G : Type u) [topological_space G] [has_inv G] : Prop :=
-(continuous_inv : continuous (λ a : G, a⁻¹))
-
-export has_continuous_inv (continuous_inv)
-export has_continuous_neg (continuous_neg)
-
-section continuous_inv
-
-variables [topological_space G] [has_inv G] [has_continuous_inv G]
-
-@[to_additive]
-lemma continuous_on_inv {s : set G} : continuous_on has_inv.inv s :=
-continuous_inv.continuous_on
-
-@[to_additive]
-lemma continuous_within_at_inv {s : set G} {x : G} : continuous_within_at has_inv.inv s x :=
-continuous_inv.continuous_within_at
-
-@[to_additive]
-lemma continuous_at_inv {x : G} : continuous_at has_inv.inv x :=
-continuous_inv.continuous_at
-
-@[to_additive]
-lemma tendsto_inv (a : G) : tendsto has_inv.inv (𝓝 a) (𝓝 (a⁻¹)) :=
-continuous_at_inv
-
-/-- If a function converges to a value in a multiplicative topological group, then its inverse
-converges to the inverse of this value. For the version in normed fields assuming additionally
-that the limit is nonzero, use `tendsto.inv'`. -/
-@[to_additive]
-lemma filter.tendsto.inv {f : α → G} {l : filter α} {y : G} (h : tendsto f l (𝓝 y)) :
-  tendsto (λ x, (f x)⁻¹) l (𝓝 y⁻¹) :=
-(continuous_inv.tendsto y).comp h
-
-variables [topological_space α] {f : α → G} {s : set α} {x : α}
-
-@[continuity, to_additive]
-lemma continuous.inv (hf : continuous f) : continuous (λx, (f x)⁻¹) :=
-continuous_inv.comp hf
-
-@[to_additive]
-lemma continuous_at.inv (hf : continuous_at f x) : continuous_at (λ x, (f x)⁻¹) x :=
-continuous_at_inv.comp hf
-
-@[to_additive]
-lemma continuous_on.inv (hf : continuous_on f s) : continuous_on (λx, (f x)⁻¹) s :=
-continuous_inv.comp_continuous_on hf
-
-@[to_additive]
-lemma continuous_within_at.inv (hf : continuous_within_at f s x) :
-  continuous_within_at (λ x, (f x)⁻¹) s x :=
-hf.inv
-
-@[to_additive]
-instance [topological_space H] [has_inv H] [has_continuous_inv H] : has_continuous_inv (G × H) :=
-⟨(continuous_inv.comp continuous_fst).prod_mk (continuous_inv.comp continuous_snd)⟩
-
-variable {ι : Type*}
-
-@[to_additive]
-instance pi.has_continuous_inv {C : ι → Type*} [∀ i, topological_space (C i)]
-  [∀ i, has_inv (C i)] [∀ i, has_continuous_inv (C i)] : has_continuous_inv (Π i, C i) :=
-{ continuous_inv := continuous_pi (λ i, continuous.inv (continuous_apply i)) }
-
-/-- A version of `pi.has_continuous_inv` for non-dependent functions. It is needed because sometimes
-Lean fails to use `pi.has_continuous_inv` for non-dependent functions. -/
-@[to_additive "A version of `pi.has_continuous_neg` for non-dependent functions. It is needed
-because sometimes Lean fails to use `pi.has_continuous_neg` for non-dependent functions."]
-instance pi.has_continuous_inv' : has_continuous_inv (ι → G) :=
-pi.has_continuous_inv
-
-@[priority 100, to_additive]
-instance has_continuous_inv_of_discrete_topology [topological_space H]
-  [has_inv H] [discrete_topology H] : has_continuous_inv H :=
-⟨continuous_of_discrete_topology⟩
-
-section pointwise_limits
-
-variables (G₁ G₂ : Type*) [topological_space G₂] [t2_space G₂]
-
-@[to_additive] lemma is_closed_set_of_map_inv [has_inv G₁] [has_inv G₂] [has_continuous_inv G₂] :
-  is_closed {f : G₁ → G₂ | ∀ x, f x⁻¹ = (f x)⁻¹ } :=
-begin
-  simp only [set_of_forall],
-  refine is_closed_Inter (λ i, is_closed_eq (continuous_apply _) (continuous_apply _).inv),
-end
-
-end pointwise_limits
-
-instance additive.has_continuous_neg [h : topological_space H] [has_inv H]
-  [has_continuous_inv H] : @has_continuous_neg (additive H) h _ :=
-{ continuous_neg := @continuous_inv H _ _ _ }
-
-instance multiplicative.has_continuous_inv [h : topological_space H] [has_neg H]
-  [has_continuous_neg H] : @has_continuous_inv (multiplicative H) h _ :=
-{ continuous_inv := @continuous_neg H _ _ _ }
-
-end continuous_inv
-
-@[to_additive]
-lemma is_compact.inv [topological_space G] [has_involutive_inv G] [has_continuous_inv G]
-  {s : set G} (hs : is_compact s) : is_compact (s⁻¹) :=
-by { rw [← image_inv], exact hs.image continuous_inv }
-
-section lattice_ops
-
-variables {ι' : Sort*} [has_inv G] [has_inv H] {ts : set (topological_space G)}
-  (h : Π t ∈ ts, @has_continuous_inv G t _) {ts' : ι' → topological_space G}
-  (h' : Π i, @has_continuous_inv G (ts' i) _) {t₁ t₂ : topological_space G}
-  (h₁ : @has_continuous_inv G t₁ _) (h₂ : @has_continuous_inv G t₂ _)
-  {t : topological_space H} [has_continuous_inv H]
-
-
-@[to_additive] lemma has_continuous_inv_Inf :
-  @has_continuous_inv G (Inf ts) _ :=
-{ continuous_inv := continuous_Inf_rng (λ t ht, continuous_Inf_dom ht
-  (@has_continuous_inv.continuous_inv G t _ (h t ht))) }
-
-include h'
-
-@[to_additive] lemma has_continuous_inv_infi :
-  @has_continuous_inv G (⨅ i, ts' i) _ :=
-by {rw ← Inf_range, exact has_continuous_inv_Inf (set.forall_range_iff.mpr h')}
-
-omit h'
-
-include h₁ h₂
-
-@[to_additive] lemma has_continuous_inv_inf :
-  @has_continuous_inv G (t₁ ⊓ t₂) _ :=
-by {rw inf_eq_infi, refine has_continuous_inv_infi (λ b, _), cases b; assumption}
-
-end lattice_ops
-
-section topological_group
-
-/-!
-### Topological groups
-
-A topological group is a group in which the multiplication and inversion operations are
-continuous. Topological additive groups are defined in the same way. Equivalently, we can require
-that the division operation `λ x y, x * y⁻¹` (resp., subtraction) is continuous.
--/
-
-/-- A topological (additive) group is a group in which the addition and negation operations are
-continuous. -/
-class topological_add_group (G : Type u) [topological_space G] [add_group G]
-  extends has_continuous_add G, has_continuous_neg G : Prop
-
-/-- A topological group is a group in which the multiplication and inversion operations are
-continuous.
-
-When you declare an instance that does not already have a `uniform_space` instance,
-you should also provide an instance of `uniform_space` and `uniform_group` using
-`topological_group.to_uniform_space` and `topological_group_is_uniform`. -/
-@[to_additive]
-class topological_group (G : Type*) [topological_space G] [group G]
-  extends has_continuous_mul G, has_continuous_inv G : Prop
-
-section conj
-
-instance conj_act.units_has_continuous_const_smul {M} [monoid M] [topological_space M]
-  [has_continuous_mul M] :
-  has_continuous_const_smul (conj_act Mˣ) M :=
-⟨λ m, (continuous_const.mul continuous_id).mul continuous_const⟩
-
-/-- we slightly weaken the type class assumptions here so that it will also apply to `ennreal`, but
-we nevertheless leave it in the `topological_group` namespace. -/
-
-variables [topological_space G] [has_inv G] [has_mul G] [has_continuous_mul G]
-
-/-- Conjugation is jointly continuous on `G × G` when both `mul` and `inv` are continuous. -/
-@[to_additive "Conjugation is jointly continuous on `G × G` when both `mul` and `inv` are
-continuous."]
-lemma topological_group.continuous_conj_prod [has_continuous_inv G] :
-  continuous (λ g : G × G, g.fst * g.snd * g.fst⁻¹) :=
-continuous_mul.mul (continuous_inv.comp continuous_fst)
-
-/-- Conjugation by a fixed element is continuous when `mul` is continuous. -/
-@[to_additive "Conjugation by a fixed element is continuous when `add` is continuous."]
-lemma topological_group.continuous_conj (g : G) : continuous (λ (h : G), g * h * g⁻¹) :=
-(continuous_mul_right g⁻¹).comp (continuous_mul_left g)
-
-/-- Conjugation acting on fixed element of the group is continuous when both `mul` and
-`inv` are continuous. -/
-@[to_additive "Conjugation acting on fixed element of the additive group is continuous when both
-  `add` and `neg` are continuous."]
-lemma topological_group.continuous_conj' [has_continuous_inv G]
-  (h : G) : continuous (λ (g : G), g * h * g⁻¹) :=
-(continuous_mul_right h).mul continuous_inv
-
-end conj
-
-variables [topological_space G] [group G] [topological_group G]
-[topological_space α] {f : α → G} {s : set α} {x : α}
-
-section zpow
-
-@[continuity, to_additive]
-lemma continuous_zpow : ∀ z : ℤ, continuous (λ a : G, a ^ z)
-| (int.of_nat n) := by simpa using continuous_pow n
-| -[1+n] := by simpa using (continuous_pow (n + 1)).inv
-
-instance add_group.has_continuous_const_smul_int {A} [add_group A] [topological_space A]
-  [topological_add_group A] : has_continuous_const_smul ℤ A := ⟨continuous_zsmul⟩
-
-instance add_group.has_continuous_smul_int {A} [add_group A] [topological_space A]
-  [topological_add_group A] : has_continuous_smul ℤ A :=
-⟨continuous_uncurry_of_discrete_topology continuous_zsmul⟩
-
-@[continuity, to_additive]
-lemma continuous.zpow {f : α → G} (h : continuous f) (z : ℤ) :
-  continuous (λ b, (f b) ^ z) :=
-(continuous_zpow z).comp h
-
-@[to_additive]
-lemma continuous_on_zpow {s : set G} (z : ℤ) : continuous_on (λ x, x ^ z) s :=
-(continuous_zpow z).continuous_on
-
-@[to_additive]
-lemma continuous_at_zpow (x : G) (z : ℤ) : continuous_at (λ x, x ^ z) x :=
-(continuous_zpow z).continuous_at
-
-@[to_additive]
-lemma filter.tendsto.zpow {α} {l : filter α} {f : α → G} {x : G} (hf : tendsto f l (𝓝 x)) (z : ℤ) :
-  tendsto (λ x, f x ^ z) l (𝓝 (x ^ z)) :=
-(continuous_at_zpow _ _).tendsto.comp hf
-
-@[to_additive]
-lemma continuous_within_at.zpow {f : α → G} {x : α} {s : set α} (hf : continuous_within_at f s x)
-  (z : ℤ) : continuous_within_at (λ x, f x ^ z) s x :=
-hf.zpow z
-
-@[to_additive]
-lemma continuous_at.zpow {f : α → G} {x : α} (hf : continuous_at f x) (z : ℤ) :
-  continuous_at (λ x, f x ^ z) x :=
-hf.zpow z
-
-@[to_additive continuous_on.zsmul]
-lemma continuous_on.zpow {f : α → G} {s : set α} (hf : continuous_on f s) (z : ℤ) :
-  continuous_on (λ x, f x ^ z) s :=
-λ x hx, (hf x hx).zpow z
-
-end zpow
-
-section ordered_comm_group
-
-variables [topological_space H] [ordered_comm_group H] [topological_group H]
-
-@[to_additive] lemma tendsto_inv_nhds_within_Ioi {a : H} :
-  tendsto has_inv.inv (𝓝[>] a) (𝓝[<] (a⁻¹)) :=
-(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
-
-@[to_additive] lemma tendsto_inv_nhds_within_Iio {a : H} :
-  tendsto has_inv.inv (𝓝[<] a) (𝓝[>] (a⁻¹)) :=
-(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
-
-@[to_additive] lemma tendsto_inv_nhds_within_Ioi_inv {a : H} :
-  tendsto has_inv.inv (𝓝[>] (a⁻¹)) (𝓝[<] a) :=
-by simpa only [inv_inv] using @tendsto_inv_nhds_within_Ioi _ _ _ _ (a⁻¹)
-
-@[to_additive] lemma tendsto_inv_nhds_within_Iio_inv {a : H} :
-  tendsto has_inv.inv (𝓝[<] (a⁻¹)) (𝓝[>] a) :=
-by simpa only [inv_inv] using @tendsto_inv_nhds_within_Iio _ _ _ _ (a⁻¹)
-
-@[to_additive] lemma tendsto_inv_nhds_within_Ici {a : H} :
-  tendsto has_inv.inv (𝓝[≥] a) (𝓝[≤] (a⁻¹)) :=
-(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
-
-@[to_additive] lemma tendsto_inv_nhds_within_Iic {a : H} :
-  tendsto has_inv.inv (𝓝[≤] a) (𝓝[≥] (a⁻¹)) :=
-(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
-
-@[to_additive] lemma tendsto_inv_nhds_within_Ici_inv {a : H} :
-  tendsto has_inv.inv (𝓝[≥] (a⁻¹)) (𝓝[≤] a) :=
-by simpa only [inv_inv] using @tendsto_inv_nhds_within_Ici _ _ _ _ (a⁻¹)
-
-@[to_additive] lemma tendsto_inv_nhds_within_Iic_inv {a : H} :
-  tendsto has_inv.inv (𝓝[≤] (a⁻¹)) (𝓝[≥] a) :=
-by simpa only [inv_inv] using @tendsto_inv_nhds_within_Iic _ _ _ _ (a⁻¹)
-
-end ordered_comm_group
-
-@[instance, to_additive]
-instance [topological_space H] [group H] [topological_group H] :
-  topological_group (G × H) :=
-{ continuous_inv := continuous_inv.prod_map continuous_inv }
-
-@[to_additive]
-instance pi.topological_group {C : β → Type*} [∀ b, topological_space (C b)]
-  [∀ b, group (C b)] [∀ b, topological_group (C b)] : topological_group (Π b, C b) :=
-{ continuous_inv := continuous_pi (λ i, (continuous_apply i).inv) }
-
-open mul_opposite
-
-@[to_additive]
-instance [group α] [has_continuous_inv α] : has_continuous_inv αᵐᵒᵖ :=
-{ continuous_inv := continuous_induced_rng $ (@continuous_inv α _ _ _).comp continuous_unop }
-
-/-- If multiplication is continuous in `α`, then it also is in `αᵐᵒᵖ`. -/
-@[to_additive "If addition is continuous in `α`, then it also is in `αᵃᵒᵖ`."]
-instance [group α] [topological_group α] :
-  topological_group αᵐᵒᵖ := { }
-
-variable (G)
-
-/-- Inversion in a topological group as a homeomorphism. -/
-@[to_additive "Negation in a topological group as a homeomorphism."]
-protected def homeomorph.inv : G ≃ₜ G :=
-{ continuous_to_fun  := continuous_inv,
-  continuous_inv_fun := continuous_inv,
-  .. equiv.inv G }
-
-@[to_additive]
-lemma nhds_one_symm : comap has_inv.inv (𝓝 (1 : G)) = 𝓝 (1 : G) :=
-((homeomorph.inv G).comap_nhds_eq _).trans (congr_arg nhds one_inv)
-
-/-- The map `(x, y) ↦ (x, xy)` as a homeomorphism. This is a shear mapping. -/
-@[to_additive "The map `(x, y) ↦ (x, x + y)` as a homeomorphism.
-This is a shear mapping."]
-protected def homeomorph.shear_mul_right : G × G ≃ₜ G × G :=
-{ continuous_to_fun  := continuous_fst.prod_mk continuous_mul,
-  continuous_inv_fun := continuous_fst.prod_mk $ continuous_fst.inv.mul continuous_snd,
-  .. equiv.prod_shear (equiv.refl _) equiv.mul_left }
-
-@[simp, to_additive]
-lemma homeomorph.shear_mul_right_coe :
-  ⇑(homeomorph.shear_mul_right G) = λ z : G × G, (z.1, z.1 * z.2) :=
-rfl
-
-@[simp, to_additive]
-lemma homeomorph.shear_mul_right_symm_coe :
-  ⇑(homeomorph.shear_mul_right G).symm = λ z : G × G, (z.1, z.1⁻¹ * z.2) :=
-rfl
-
-variables {G}
-
-@[to_additive]
-lemma is_open.inv {s : set G} (hs : is_open s) : is_open s⁻¹ := hs.preimage continuous_inv
-
-@[to_additive]
-lemma is_closed.inv {s : set G} (hs : is_closed s) : is_closed s⁻¹ := hs.preimage continuous_inv
-
-@[to_additive]
-lemma inv_closure (s : set G) : (closure s)⁻¹ = closure s⁻¹ :=
-(homeomorph.inv G).preimage_closure s
-
-@[to_additive] lemma is_open.mul_closure {U : set G} (hU : is_open U) (s : set G) :
-  U * closure s = U * s :=
-begin
-  refine subset.antisymm _ (mul_subset_mul subset.rfl subset_closure),
-  rintro _ ⟨a, b, ha, hb, rfl⟩,
-  rw mem_closure_iff at hb,
-  have hbU : b ∈ U⁻¹ * {a * b},
-    from ⟨a⁻¹, a * b, set.inv_mem_inv.2 ha, rfl, inv_mul_cancel_left _ _⟩,
-  rcases hb _ hU.inv.mul_right hbU with ⟨_, ⟨c, d, hc, (rfl : d = _), rfl⟩, hcs⟩,
-  exact ⟨c⁻¹, _, hc, hcs, inv_mul_cancel_left _ _⟩
-end
-
-@[to_additive] lemma is_open.closure_mul {U : set G} (hU : is_open U) (s : set G) :
-  closure s * U = s * U :=
-by rw [← inv_inv (closure s * U), set.mul_inv_rev, inv_closure, hU.inv.mul_closure,
-  set.mul_inv_rev, inv_inv, inv_inv]
-
-namespace subgroup
-
-@[to_additive] instance (S : subgroup G) :
-  topological_group S :=
-{ continuous_inv :=
-  begin
-    rw embedding_subtype_coe.to_inducing.continuous_iff,
-    exact continuous_subtype_coe.inv
-  end,
-  ..S.to_submonoid.has_continuous_mul }
-
-end subgroup
-
-/-- The (topological-space) closure of a subgroup of a space `M` with `has_continuous_mul` is
-itself a subgroup. -/
-@[to_additive "The (topological-space) closure of an additive subgroup of a space `M` with
-`has_continuous_add` is itself an additive subgroup."]
-def subgroup.topological_closure (s : subgroup G) : subgroup G :=
-{ carrier := closure (s : set G),
-  inv_mem' := λ g m, by simpa [←set.mem_inv, inv_closure] using m,
-  ..s.to_submonoid.topological_closure }
-
-@[simp, to_additive] lemma subgroup.topological_closure_coe {s : subgroup G} :
-  (s.topological_closure : set G) = closure s :=
-rfl
-
-@[to_additive]
-instance subgroup.topological_closure_topological_group (s : subgroup G) :
-  topological_group (s.topological_closure) :=
-{ continuous_inv :=
-  begin
-    apply continuous_induced_rng,
-    change continuous (λ p : s.topological_closure, (p : G)⁻¹),
-    continuity,
-  end
-  ..s.to_submonoid.topological_closure_has_continuous_mul}
-
-@[to_additive] lemma subgroup.subgroup_topological_closure (s : subgroup G) :
-  s ≤ s.topological_closure :=
-subset_closure
-
-@[to_additive] lemma subgroup.is_closed_topological_closure (s : subgroup G) :
-  is_closed (s.topological_closure : set G) :=
-by convert is_closed_closure
-
-@[to_additive] lemma subgroup.topological_closure_minimal
-  (s : subgroup G) {t : subgroup G} (h : s ≤ t) (ht : is_closed (t : set G)) :
-  s.topological_closure ≤ t :=
-closure_minimal h ht
-
-@[to_additive] lemma dense_range.topological_closure_map_subgroup [group H] [topological_space H]
-  [topological_group H] {f : G →* H} (hf : continuous f) (hf' : dense_range f) {s : subgroup G}
-  (hs : s.topological_closure = ⊤) :
-  (s.map f).topological_closure = ⊤ :=
-begin
-  rw set_like.ext'_iff at hs ⊢,
-  simp only [subgroup.topological_closure_coe, subgroup.coe_top, ← dense_iff_closure_eq] at hs ⊢,
-  exact hf'.dense_image hf hs
-end
-
-/-- The topological closure of a normal subgroup is normal.-/
-@[to_additive "The topological closure of a normal additive subgroup is normal."]
-lemma subgroup.is_normal_topological_closure {G : Type*} [topological_space G] [group G]
-  [topological_group G] (N : subgroup G) [N.normal] :
-  (subgroup.topological_closure N).normal :=
-{ conj_mem := λ n hn g,
-  begin
-    apply mem_closure_of_continuous (topological_group.continuous_conj g) hn,
-    intros m hm,
-    exact subset_closure (subgroup.normal.conj_mem infer_instance m hm g),
-  end }
-
-@[to_additive] lemma mul_mem_connected_component_one {G : Type*} [topological_space G]
-  [mul_one_class G] [has_continuous_mul G] {g h : G} (hg : g ∈ connected_component (1 : G))
-  (hh : h ∈ connected_component (1 : G)) : g * h ∈ connected_component (1 : G) :=
-begin
-  rw connected_component_eq hg,
-  have hmul: g ∈ connected_component (g*h),
-  { apply continuous.image_connected_component_subset (continuous_mul_left g),
-    rw ← connected_component_eq hh,
-    exact ⟨(1 : G), mem_connected_component, by simp only [mul_one]⟩ },
-  simpa [← connected_component_eq hmul] using (mem_connected_component)
-end
-
-@[to_additive] lemma inv_mem_connected_component_one {G : Type*} [topological_space G] [group G]
-  [topological_group G] {g : G} (hg : g ∈ connected_component (1 : G)) :
-  g⁻¹ ∈ connected_component (1 : G) :=
-begin
-  rw ← one_inv,
-  exact continuous.image_connected_component_subset continuous_inv _
-    ((set.mem_image _ _ _).mp ⟨g, hg, rfl⟩)
-end
-
-/-- The connected component of 1 is a subgroup of `G`. -/
-@[to_additive "The connected component of 0 is a subgroup of `G`."]
-def subgroup.connected_component_of_one (G : Type*) [topological_space G] [group G]
-  [topological_group G] : subgroup G :=
-{ carrier  := connected_component (1 : G),
-  one_mem' := mem_connected_component,
-  mul_mem' := λ g h hg hh, mul_mem_connected_component_one hg hh,
-  inv_mem' := λ g hg, inv_mem_connected_component_one hg }
-
-/-- If a subgroup of a topological group is commutative, then so is its topological closure. -/
-@[to_additive "If a subgroup of an additive topological group is commutative, then so is its
-topological closure."]
-def subgroup.comm_group_topological_closure [t2_space G] (s : subgroup G)
-  (hs : ∀ (x y : s), x * y = y * x) : comm_group s.topological_closure :=
-{ ..s.topological_closure.to_group,
-  ..s.to_submonoid.comm_monoid_topological_closure hs }
-
-@[to_additive exists_nhds_half_neg]
-lemma exists_nhds_split_inv {s : set G} (hs : s ∈ 𝓝 (1 : G)) :
-  ∃ V ∈ 𝓝 (1 : G), ∀ (v ∈ V) (w ∈ V), v / w ∈ s :=
-have ((λp : G × G, p.1 * p.2⁻¹) ⁻¹' s) ∈ 𝓝 ((1, 1) : G × G),
-  from continuous_at_fst.mul continuous_at_snd.inv (by simpa),
-by simpa only [div_eq_mul_inv, nhds_prod_eq, mem_prod_self_iff, prod_subset_iff, mem_preimage]
-  using this
-
-@[to_additive]
-lemma nhds_translation_mul_inv (x : G) : comap (λ y : G, y * x⁻¹) (𝓝 1) = 𝓝 x :=
-((homeomorph.mul_right x⁻¹).comap_nhds_eq 1).trans $ show 𝓝 (1 * x⁻¹⁻¹) = 𝓝 x, by simp
-
-@[simp, to_additive] lemma map_mul_left_nhds (x y : G) : map ((*) x) (𝓝 y) = 𝓝 (x * y) :=
-(homeomorph.mul_left x).map_nhds_eq y
-
-@[to_additive] lemma map_mul_left_nhds_one (x : G) : map ((*) x) (𝓝 1) = 𝓝 x := by simp
-
-@[to_additive]
-lemma topological_group.ext {G : Type*} [group G] {t t' : topological_space G}
-  (tg : @topological_group G t _) (tg' : @topological_group G t' _)
-  (h : @nhds G t 1 = @nhds G t' 1) : t = t' :=
-eq_of_nhds_eq_nhds $ λ x, by
-  rw [← @nhds_translation_mul_inv G t _ _ x , ← @nhds_translation_mul_inv G t' _ _ x , ← h]
-
-@[to_additive]
-lemma topological_group.of_nhds_aux {G : Type*} [group G] [topological_space G]
-  (hinv : tendsto (λ (x : G), x⁻¹) (𝓝 1) (𝓝 1))
-  (hleft : ∀ (x₀ : G), 𝓝 x₀ = map (λ (x : G), x₀ * x) (𝓝 1))
-  (hconj : ∀ (x₀ : G), map (λ (x : G), x₀ * x * x₀⁻¹) (𝓝 1) ≤ 𝓝 1) : continuous (λ x : G, x⁻¹) :=
-begin
-  rw continuous_iff_continuous_at,
-  rintros x₀,
-  have key : (λ x, (x₀*x)⁻¹) = (λ x, x₀⁻¹*x) ∘ (λ x, x₀*x*x₀⁻¹) ∘ (λ x, x⁻¹),
-    by {ext ; simp[mul_assoc] },
-  calc map (λ x, x⁻¹) (𝓝 x₀)
-      = map (λ x, x⁻¹) (map (λ x, x₀*x) $ 𝓝 1) : by rw hleft
-  ... = map (λ x, (x₀*x)⁻¹) (𝓝 1) : by rw filter.map_map
-  ... = map (((λ x, x₀⁻¹*x) ∘ (λ x, x₀*x*x₀⁻¹)) ∘ (λ x, x⁻¹)) (𝓝 1) : by rw key
-  ... = map ((λ x, x₀⁻¹*x) ∘ (λ x, x₀*x*x₀⁻¹)) _ : by rw ← filter.map_map
-  ... ≤ map ((λ x, x₀⁻¹ * x) ∘ λ x, x₀ * x * x₀⁻¹) (𝓝 1) : map_mono hinv
-  ... = map (λ x, x₀⁻¹ * x) (map (λ x, x₀ * x * x₀⁻¹) (𝓝 1)) : filter.map_map
-  ... ≤ map (λ x, x₀⁻¹ * x) (𝓝 1) : map_mono (hconj x₀)
-  ... = 𝓝 x₀⁻¹ : (hleft _).symm
-end
-
-@[to_additive]
-lemma topological_group.of_nhds_one' {G : Type u} [group G] [topological_space G]
-  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
-  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
-  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
-  (hright : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x*x₀) (𝓝 1)) : topological_group G :=
-begin
-  refine { continuous_mul := (has_continuous_mul.of_nhds_one hmul hleft hright).continuous_mul,
-           continuous_inv := topological_group.of_nhds_aux hinv hleft _ },
-  intros x₀,
-  suffices : map (λ (x : G), x₀ * x * x₀⁻¹) (𝓝 1) = 𝓝 1, by simp [this, le_refl],
-  rw [show (λ x, x₀ * x * x₀⁻¹) = (λ x, x₀ * x) ∘ λ x, x*x₀⁻¹, by {ext, simp [mul_assoc] },
-      ← filter.map_map, ← hright, hleft x₀⁻¹, filter.map_map],
-  convert map_id,
-  ext,
-  simp
-end
-
-@[to_additive]
-lemma topological_group.of_nhds_one {G : Type u} [group G] [topological_space G]
-  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
-  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
-  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
-  (hconj : ∀ x₀ : G, tendsto (λ x, x₀*x*x₀⁻¹) (𝓝 1) (𝓝 1)) : topological_group G :=
- { continuous_mul := begin
-    rw continuous_iff_continuous_at,
-    rintros ⟨x₀, y₀⟩,
-    have key : (λ (p : G × G), x₀ * p.1 * (y₀ * p.2)) =
-      ((λ x, x₀*y₀*x) ∘ (uncurry (*)) ∘ (prod.map (λ x, y₀⁻¹*x*y₀) id)),
-      by { ext, simp [uncurry, prod.map, mul_assoc] },
-    specialize hconj y₀⁻¹, rw inv_inv at hconj,
-    calc map (λ (p : G × G), p.1 * p.2) (𝓝 (x₀, y₀))
-        = map (λ (p : G × G), p.1 * p.2) ((𝓝 x₀) ×ᶠ 𝓝 y₀)
-            : by rw nhds_prod_eq
-    ... = map (λ (p : G × G), x₀ * p.1 * (y₀ * p.2)) ((𝓝 1) ×ᶠ (𝓝 1))
-            : by rw [hleft x₀, hleft y₀, prod_map_map_eq, filter.map_map]
-    ... = map (((λ x, x₀*y₀*x) ∘ (uncurry (*))) ∘ (prod.map (λ x, y₀⁻¹*x*y₀) id))((𝓝 1) ×ᶠ (𝓝 1))
-            : by rw key
-    ... = map ((λ x, x₀*y₀*x) ∘ (uncurry (*))) ((map  (λ x, y₀⁻¹*x*y₀) $ 𝓝 1) ×ᶠ (𝓝 1))
-            : by rw [← filter.map_map, ← prod_map_map_eq', map_id]
-    ... ≤ map ((λ x, x₀*y₀*x) ∘ (uncurry (*))) ((𝓝 1) ×ᶠ (𝓝 1))
-            : map_mono (filter.prod_mono hconj $ le_rfl)
-    ... = map (λ x, x₀*y₀*x) (map (uncurry (*)) ((𝓝 1) ×ᶠ (𝓝 1)))   : by rw filter.map_map
-    ... ≤ map (λ x, x₀*y₀*x) (𝓝 1)   : map_mono hmul
-    ... = 𝓝 (x₀*y₀)   : (hleft _).symm
-  end,
-  continuous_inv := topological_group.of_nhds_aux hinv hleft hconj}
-
-@[to_additive]
-lemma topological_group.of_comm_of_nhds_one {G : Type u} [comm_group G] [topological_space G]
-  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
-  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
-  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1)) : topological_group G :=
-topological_group.of_nhds_one hmul hinv hleft (by simpa using tendsto_id)
-
-end topological_group
-
-section quotient_topological_group
-variables [topological_space G] [group G] [topological_group G] (N : subgroup G) (n : N.normal)
-
-@[to_additive]
-instance quotient_group.quotient.topological_space {G : Type*} [group G] [topological_space G]
-  (N : subgroup G) : topological_space (G ⧸ N) :=
-quotient.topological_space
-
-open quotient_group
-
-@[to_additive]
-lemma quotient_group.is_open_map_coe : is_open_map (coe : G → G ⧸ N) :=
-begin
-  intros s s_op,
-  change is_open ((coe : G → G ⧸ N) ⁻¹' (coe '' s)),
-  rw quotient_group.preimage_image_coe N s,
-  exact is_open_Union (λ n, (continuous_mul_right _).is_open_preimage s s_op)
-end
-
-@[to_additive]
-instance topological_group_quotient [N.normal] : topological_group (G ⧸ N) :=
-{ continuous_mul := begin
-    have cont : continuous ((coe : G → G ⧸ N) ∘ (λ (p : G × G), p.fst * p.snd)) :=
-      continuous_quot_mk.comp continuous_mul,
-    have quot : quotient_map (λ p : G × G, ((p.1 : G ⧸ N), (p.2 : G ⧸ N))),
-    { apply is_open_map.to_quotient_map,
-      { exact (quotient_group.is_open_map_coe N).prod (quotient_group.is_open_map_coe N) },
-      { exact continuous_quot_mk.prod_map continuous_quot_mk },
-      { exact (surjective_quot_mk _).prod_map (surjective_quot_mk _) } },
-    exact (quotient_map.continuous_iff quot).2 cont,
-  end,
-  continuous_inv := begin
-    have : continuous ((coe : G → G ⧸ N) ∘ (λ (a : G), a⁻¹)) :=
-      continuous_quot_mk.comp continuous_inv,
-    convert continuous_quotient_lift _ this,
-  end }
-
-end quotient_topological_group
-
-/-- A typeclass saying that `λ p : G × G, p.1 - p.2` is a continuous function. This property
-automatically holds for topological additive groups but it also holds, e.g., for `ℝ≥0`. -/
-class has_continuous_sub (G : Type*) [topological_space G] [has_sub G] : Prop :=
-(continuous_sub : continuous (λ p : G × G, p.1 - p.2))
-
-/-- A typeclass saying that `λ p : G × G, p.1 / p.2` is a continuous function. This property
-automatically holds for topological groups. Lemmas using this class have primes.
-The unprimed version is for `group_with_zero`. -/
-@[to_additive]
-class has_continuous_div (G : Type*) [topological_space G] [has_div G] : Prop :=
-(continuous_div' : continuous (λ p : G × G, p.1 / p.2))
-
-@[priority 100, to_additive] -- see Note [lower instance priority]
-instance topological_group.to_has_continuous_div [topological_space G] [group G]
-  [topological_group G] : has_continuous_div G :=
-⟨by { simp only [div_eq_mul_inv], exact continuous_fst.mul continuous_snd.inv }⟩
-
-export has_continuous_sub (continuous_sub)
-export has_continuous_div (continuous_div')
-
-section has_continuous_div
-
-variables [topological_space G] [has_div G] [has_continuous_div G]
-
-@[to_additive sub]
-lemma filter.tendsto.div' {f g : α → G} {l : filter α} {a b : G} (hf : tendsto f l (𝓝 a))
-  (hg : tendsto g l (𝓝 b)) : tendsto (λ x, f x / g x) l (𝓝 (a / b)) :=
-(continuous_div'.tendsto (a, b)).comp (hf.prod_mk_nhds hg)
-
-@[to_additive const_sub]
-lemma filter.tendsto.const_div' (b : G) {c : G} {f : α → G} {l : filter α}
-  (h : tendsto f l (𝓝 c)) : tendsto (λ k : α, b / f k) l (𝓝 (b / c)) :=
-tendsto_const_nhds.div' h
-
-@[to_additive sub_const]
-lemma filter.tendsto.div_const' (b : G) {c : G} {f : α → G} {l : filter α}
-  (h : tendsto f l (𝓝 c)) : tendsto (λ k : α, f k / b) l (𝓝 (c / b)) :=
-h.div' tendsto_const_nhds
-
-variables [topological_space α] {f g : α → G} {s : set α} {x : α}
-
-@[continuity, to_additive sub] lemma continuous.div' (hf : continuous f) (hg : continuous g) :
-  continuous (λ x, f x / g x) :=
-continuous_div'.comp (hf.prod_mk hg : _)
-
-@[to_additive continuous_sub_left]
-lemma continuous_div_left' (a : G) : continuous (λ b : G, a / b) :=
-continuous_const.div' continuous_id
-
-@[to_additive continuous_sub_right]
-lemma continuous_div_right' (a : G) : continuous (λ b : G, b / a) :=
-continuous_id.div' continuous_const
-
-@[to_additive sub]
-lemma continuous_at.div' {f g : α → G} {x : α} (hf : continuous_at f x) (hg : continuous_at g x) :
-  continuous_at (λx, f x / g x) x :=
-hf.div' hg
-
-@[to_additive sub]
-lemma continuous_within_at.div' (hf : continuous_within_at f s x)
-  (hg : continuous_within_at g s x) :
-  continuous_within_at (λ x, f x / g x) s x :=
-hf.div' hg
-
-@[to_additive sub]
-lemma continuous_on.div' (hf : continuous_on f s) (hg : continuous_on g s) :
-  continuous_on (λx, f x / g x) s :=
-λ x hx, (hf x hx).div' (hg x hx)
-
-end has_continuous_div
-
-section div_in_topological_group
-variables [group G] [topological_space G] [topological_group G]
-
-/-- A version of `homeomorph.mul_left a b⁻¹` that is defeq to `a / b`. -/
-@[to_additive /-" A version of `homeomorph.add_left a (-b)` that is defeq to `a - b`. "-/,
-  simps {simp_rhs := tt}]
-def homeomorph.div_left (x : G) : G ≃ₜ G :=
-{ continuous_to_fun := continuous_const.div' continuous_id,
-  continuous_inv_fun := continuous_inv.mul continuous_const,
-  .. equiv.div_left x }
-
-/-- A version of `homeomorph.mul_right a⁻¹ b` that is defeq to `b / a`. -/
-@[to_additive /-" A version of `homeomorph.add_right (-a) b` that is defeq to `b - a`. "-/,
-  simps {simp_rhs := tt}]
-def homeomorph.div_right (x : G) : G ≃ₜ G :=
-{ continuous_to_fun := continuous_id.div' continuous_const,
-  continuous_inv_fun := continuous_id.mul continuous_const,
-  .. equiv.div_right x }
-
-@[to_additive]
-lemma is_open_map_div_right (a : G) : is_open_map (λ x, x / a) :=
-(homeomorph.div_right a).is_open_map
-
-@[to_additive]
-lemma is_closed_map_div_right (a : G) : is_closed_map (λ x, x / a) :=
-(homeomorph.div_right a).is_closed_map
-
-@[to_additive]
-lemma tendsto_div_nhds_one_iff
-  {α : Type*} {l : filter α} {x : G} {u : α → G} :
-  tendsto (λ n, u n / x) l (𝓝 1) ↔ tendsto u l (𝓝 x) :=
-begin
-  have A : tendsto (λ (n : α), x) l (𝓝 x) := tendsto_const_nhds,
-  exact ⟨λ h, by simpa using h.mul A, λ h, by simpa using h.div' A⟩
-end
-
-end div_in_topological_group
-
-@[to_additive]
-lemma nhds_translation_div [topological_space G] [group G] [topological_group G] (x : G) :
-  comap (λy:G, y / x) (𝓝 1) = 𝓝 x :=
-by simpa only [div_eq_mul_inv] using nhds_translation_mul_inv x
-
-/-- additive group with a neighbourhood around 0.
-Only used to construct a topology and uniform space.
-
-This is currently only available for commutative groups, but it can be extended to
-non-commutative groups too.
--/
-class add_group_with_zero_nhd (G : Type u) extends add_comm_group G :=
-(Z [] : filter G)
-(zero_Z : pure 0 ≤ Z)
-(sub_Z : tendsto (λp:G×G, p.1 - p.2) (Z ×ᶠ Z) Z)
-
-section filter_mul
-
-section
-variables (G) [topological_space G] [group G] [topological_group G]
-
-@[to_additive]
-lemma topological_group.t1_space (h : @is_closed G _ {1}) : t1_space G :=
-⟨assume x, by { convert is_closed_map_mul_right x _ h, simp }⟩
-
-@[to_additive]
-lemma topological_group.regular_space [t1_space G] : regular_space G :=
-⟨assume s a hs ha,
- let f := λ p : G × G, p.1 * (p.2)⁻¹ in
- have hf : continuous f := continuous_fst.mul continuous_snd.inv,
- -- a ∈ -s implies f (a, 1) ∈ -s, and so (a, 1) ∈ f⁻¹' (-s);
- -- and so can find t₁ t₂ open such that a ∈ t₁ × t₂ ⊆ f⁻¹' (-s)
- let ⟨t₁, t₂, ht₁, ht₂, a_mem_t₁, one_mem_t₂, t_subset⟩ :=
-   is_open_prod_iff.1 ((is_open_compl_iff.2 hs).preimage hf) a (1:G) (by simpa [f]) in
- begin
-   use [s * t₂, ht₂.mul_left, λ x hx, ⟨x, 1, hx, one_mem_t₂, mul_one _⟩],
-   rw [nhds_within, inf_principal_eq_bot, mem_nhds_iff],
-   refine ⟨t₁, _, ht₁, a_mem_t₁⟩,
-   rintros x hx ⟨y, z, hy, hz, yz⟩,
-   have : x * z⁻¹ ∈ sᶜ := (prod_subset_iff.1 t_subset) x hx z hz,
-   have : x * z⁻¹ ∈ s, rw ← yz, simpa,
-   contradiction
- end⟩
-
-@[to_additive]
-lemma topological_group.t2_space [t1_space G] : t2_space G :=
-@regular_space.t2_space G _ (topological_group.regular_space G)
-
-variables {G} (S : subgroup G) [subgroup.normal S] [is_closed (S : set G)]
-
-@[to_additive]
-instance subgroup.regular_quotient_of_is_closed
-  (S : subgroup G) [subgroup.normal S] [is_closed (S : set G)] : regular_space (G ⧸ S) :=
-begin
-  suffices : t1_space (G ⧸ S), { exact @topological_group.regular_space _ _ _ _ this, },
-  have hS : is_closed (S : set G) := infer_instance,
-  rw ← quotient_group.ker_mk S at hS,
-  exact topological_group.t1_space (G ⧸ S) ((quotient_map_quotient_mk.is_closed_preimage).mp hS),
-end
-
-end
-
-section
-
-/-! Some results about an open set containing the product of two sets in a topological group. -/
-
-variables [topological_space G] [group G] [topological_group G]
-
-/-- Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of `1`
-  such that `K * V ⊆ U`. -/
-@[to_additive "Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of
-`0` such that `K + V ⊆ U`."]
-lemma compact_open_separated_mul_right {K U : set G} (hK : is_compact K) (hU : is_open U)
-  (hKU : K ⊆ U) : ∃ V ∈ 𝓝 (1 : G), K * V ⊆ U :=
-begin
-  apply hK.induction_on,
-  { exact ⟨univ, by simp⟩ },
-  { rintros s t hst ⟨V, hV, hV'⟩,
-    exact ⟨V, hV, (mul_subset_mul_right hst).trans hV'⟩ },
-  { rintros s t  ⟨V, V_in, hV'⟩ ⟨W, W_in, hW'⟩,
-    use [V ∩ W, inter_mem V_in W_in],
-    rw union_mul,
-    exact union_subset ((mul_subset_mul_left (V.inter_subset_left W)).trans hV')
-                       ((mul_subset_mul_left (V.inter_subset_right W)).trans hW') },
-  { intros x hx,
-    have := tendsto_mul (show U ∈ 𝓝 (x * 1), by simpa using hU.mem_nhds (hKU hx)),
-    rw [nhds_prod_eq, mem_map, mem_prod_iff] at this,
-    rcases this with ⟨t, ht, s, hs, h⟩,
-    rw [← image_subset_iff, image_mul_prod] at h,
-    exact ⟨t, mem_nhds_within_of_mem_nhds ht, s, hs, h⟩ }
-end
-
-open mul_opposite
-
-/-- Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of `1`
-  such that `V * K ⊆ U`. -/
-@[to_additive "Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of
-`0` such that `V + K ⊆ U`."]
-lemma compact_open_separated_mul_left {K U : set G} (hK : is_compact K) (hU : is_open U)
-  (hKU : K ⊆ U) : ∃ V ∈ 𝓝 (1 : G), V * K ⊆ U :=
-begin
-  rcases compact_open_separated_mul_right (hK.image continuous_op) (op_homeomorph.is_open_map U hU)
-    (image_subset op hKU) with ⟨V, (hV : V ∈ 𝓝 (op (1 : G))), hV' : op '' K * V ⊆ op '' U⟩,
-  refine ⟨op ⁻¹' V, continuous_op.continuous_at hV, _⟩,
-  rwa [← image_preimage_eq V op_surjective, ← image_op_mul, image_subset_iff,
-    preimage_image_eq _ op_injective] at hV'
-end
-
-/-- A compact set is covered by finitely many left multiplicative translates of a set
-  with non-empty interior. -/
-@[to_additive "A compact set is covered by finitely many left additive translates of a set
-  with non-empty interior."]
-lemma compact_covered_by_mul_left_translates {K V : set G} (hK : is_compact K)
-  (hV : (interior V).nonempty) : ∃ t : finset G, K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V :=
-begin
-  obtain ⟨t, ht⟩ : ∃ t : finset G, K ⊆ ⋃ x ∈ t, interior (((*) x) ⁻¹' V),
-  { refine hK.elim_finite_subcover (λ x, interior $ ((*) x) ⁻¹' V) (λ x, is_open_interior) _,
-    cases hV with g₀ hg₀,
-    refine λ g hg, mem_Union.2 ⟨g₀ * g⁻¹, _⟩,
-    refine preimage_interior_subset_interior_preimage (continuous_const.mul continuous_id) _,
-    rwa [mem_preimage, inv_mul_cancel_right] },
-  exact ⟨t, subset.trans ht $ Union₂_mono $ λ g hg, interior_subset⟩
-end
-
-/-- Every locally compact separable topological group is σ-compact.
-  Note: this is not true if we drop the topological group hypothesis. -/
-@[priority 100, to_additive separable_locally_compact_add_group.sigma_compact_space]
-instance separable_locally_compact_group.sigma_compact_space
-  [separable_space G] [locally_compact_space G] : sigma_compact_space G :=
-begin
-  obtain ⟨L, hLc, hL1⟩ := exists_compact_mem_nhds (1 : G),
-  refine ⟨⟨λ n, (λ x, x * dense_seq G n) ⁻¹' L, _, _⟩⟩,
-  { intro n, exact (homeomorph.mul_right _).compact_preimage.mpr hLc },
-  { refine Union_eq_univ_iff.2 (λ x, _),
-    obtain ⟨_, ⟨n, rfl⟩, hn⟩ : (range (dense_seq G) ∩ (λ y, x * y) ⁻¹' L).nonempty,
-    { rw [← (homeomorph.mul_left x).apply_symm_apply 1] at hL1,
-      exact (dense_range_dense_seq G).inter_nhds_nonempty
-        ((homeomorph.mul_left x).continuous.continuous_at $ hL1) },
-    exact ⟨n, hn⟩ }
-end
-
-/-- Every separated topological group in which there exists a compact set with nonempty interior
-is locally compact. -/
-@[to_additive] lemma topological_space.positive_compacts.locally_compact_space_of_group
-  [t2_space G] (K : positive_compacts G) :
-  locally_compact_space G :=
-begin
-  refine locally_compact_of_compact_nhds (λ x, _),
-  obtain ⟨y, hy⟩ := K.interior_nonempty,
-  let F := homeomorph.mul_left (x * y⁻¹),
-  refine ⟨F '' K, _, K.compact.image F.continuous⟩,
-  suffices : F.symm ⁻¹' K ∈ 𝓝 x, by { convert this, apply equiv.image_eq_preimage },
-  apply continuous_at.preimage_mem_nhds F.symm.continuous.continuous_at,
-  have : F.symm x = y, by simp [F, homeomorph.mul_left_symm],
-  rw this,
-  exact mem_interior_iff_mem_nhds.1 hy
-end
-
-end
-
-section
-variables [topological_space G] [comm_group G] [topological_group G]
-
-@[to_additive]
-lemma nhds_mul (x y : G) : 𝓝 (x * y) = 𝓝 x * 𝓝 y :=
-filter_eq $ set.ext $ assume s,
-begin
-  rw [← nhds_translation_mul_inv x, ← nhds_translation_mul_inv y, ← nhds_translation_mul_inv (x*y)],
-  split,
-  { rintros ⟨t, ht, ts⟩,
-    rcases exists_nhds_one_split ht with ⟨V, V1, h⟩,
-    refine ⟨(λa, a * x⁻¹) ⁻¹' V, (λa, a * y⁻¹) ⁻¹' V,
-            ⟨V, V1, subset.refl _⟩, ⟨V, V1, subset.refl _⟩, _⟩,
-    rintros a ⟨v, w, v_mem, w_mem, rfl⟩,
-    apply ts,
-    simpa [mul_comm, mul_assoc, mul_left_comm] using h (v * x⁻¹) v_mem (w * y⁻¹) w_mem },
-  { rintros ⟨a, c, ⟨b, hb, ba⟩, ⟨d, hd, dc⟩, ac⟩,
-    refine ⟨b ∩ d, inter_mem hb hd, assume v, _⟩,
-    simp only [preimage_subset_iff, mul_inv_rev, mem_preimage] at *,
-    rintros ⟨vb, vd⟩,
-    refine ac ⟨v * y⁻¹, y, _, _, _⟩,
-    { rw ← mul_assoc _ _ _ at vb, exact ba _ vb },
-    { apply dc y, rw mul_right_inv, exact mem_of_mem_nhds hd },
-    { simp only [inv_mul_cancel_right] } }
-end
-
-/-- On a topological group, `𝓝 : G → filter G` can be promoted to a `mul_hom`. -/
-@[to_additive "On an additive topological group, `𝓝 : G → filter G` can be promoted to an
-`add_hom`.", simps]
-def nhds_mul_hom : G →ₙ* (filter G) :=
-{ to_fun := 𝓝,
-  map_mul' := λ_ _, nhds_mul _ _ }
-
-end
-
-end filter_mul
-
-instance additive.topological_add_group {G} [h : topological_space G]
-  [group G] [topological_group G] : @topological_add_group (additive G) h _ :=
-{ continuous_neg := @continuous_inv G _ _ _ }
-
-instance multiplicative.topological_group {G} [h : topological_space G]
-  [add_group G] [topological_add_group G] : @topological_group (multiplicative G) h _ :=
-{ continuous_inv := @continuous_neg G _ _ _ }
-
-section quotient
-variables [group G] [topological_space G] [topological_group G] {Γ : subgroup G}
-
-@[to_additive]
-instance quotient_group.has_continuous_const_smul : has_continuous_const_smul G (G ⧸ Γ) :=
-{ continuous_const_smul := λ g₀, begin
-    apply continuous_coinduced_dom,
-    change continuous (λ g : G, quotient_group.mk (g₀ * g)),
-    exact continuous_coinduced_rng.comp (continuous_mul_left g₀),
-  end }
-
-@[to_additive]
-lemma quotient_group.continuous_smul₁ (x : G ⧸ Γ) : continuous (λ g : G, g • x) :=
-begin
-  obtain ⟨g₀, rfl⟩ : ∃ g₀, quotient_group.mk g₀ = x,
-  { exact @quotient.exists_rep _ (quotient_group.left_rel Γ) x },
-  change continuous (λ g, quotient_group.mk (g * g₀)),
-  exact continuous_coinduced_rng.comp (continuous_mul_right g₀)
-end
-
-@[to_additive]
-instance quotient_group.has_continuous_smul [locally_compact_space G] :
-  has_continuous_smul G (G ⧸ Γ) :=
-{ continuous_smul := begin
-    let F : G × G ⧸ Γ → G ⧸ Γ := λ p, p.1 • p.2,
-    change continuous F,
-    have H : continuous (F ∘ (λ p : G × G, (p.1, quotient_group.mk p.2))),
-    { change continuous (λ p : G × G, quotient_group.mk (p.1 * p.2)),
-      refine continuous_coinduced_rng.comp continuous_mul },
-    exact quotient_map.continuous_lift_prod_right quotient_map_quotient_mk H,
-  end }
-
-end quotient
-
-namespace units
-
-open mul_opposite (continuous_op continuous_unop)
-
-variables [monoid α] [topological_space α] [has_continuous_mul α] [monoid β] [topological_space β]
-  [has_continuous_mul β]
-
-@[to_additive] instance : topological_group αˣ :=
-{ continuous_inv := continuous_induced_rng ((continuous_unop.comp
-    (@continuous_embed_product α _ _).snd).prod_mk (continuous_op.comp continuous_coe)) }
-
-/-- The topological group isomorphism between the units of a product of two monoids, and the product
-    of the units of each monoid. -/
-def homeomorph.prod_units : homeomorph (α × β)ˣ (αˣ × βˣ) :=
-{ continuous_to_fun  :=
-  begin
-    show continuous (λ i : (α × β)ˣ, (map (monoid_hom.fst α β) i, map (monoid_hom.snd α β) i)),
-    refine continuous.prod_mk _ _,
-    { refine continuous_induced_rng ((continuous_fst.comp units.continuous_coe).prod_mk _),
-      refine mul_opposite.continuous_op.comp (continuous_fst.comp _),
-      simp_rw units.inv_eq_coe_inv,
-      exact units.continuous_coe.comp continuous_inv, },
-    { refine continuous_induced_rng ((continuous_snd.comp units.continuous_coe).prod_mk _),
-      simp_rw units.coe_map_inv,
-      exact continuous_op.comp (continuous_snd.comp (units.continuous_coe.comp continuous_inv)), }
-  end,
-  continuous_inv_fun :=
-  begin
-    refine continuous_induced_rng (continuous.prod_mk _ _),
-    { exact (units.continuous_coe.comp continuous_fst).prod_mk
-        (units.continuous_coe.comp continuous_snd), },
-    { refine continuous_op.comp
-        (units.continuous_coe.comp $ continuous_induced_rng $ continuous.prod_mk _ _),
-      { exact (units.continuous_coe.comp (continuous_inv.comp continuous_fst)).prod_mk
-          (units.continuous_coe.comp (continuous_inv.comp continuous_snd)) },
-      { exact continuous_op.comp ((units.continuous_coe.comp continuous_fst).prod_mk
-            (units.continuous_coe.comp continuous_snd)) }}
-  end,
-  ..mul_equiv.prod_units }
-
-end units
-
-section lattice_ops
-
-variables {ι : Sort*} [group G] [group H] {ts : set (topological_space G)}
-  (h : ∀ t ∈ ts, @topological_group G t _) {ts' : ι → topological_space G}
-  (h' : ∀ i, @topological_group G (ts' i) _) {t₁ t₂ : topological_space G}
-  (h₁ : @topological_group G t₁ _) (h₂ : @topological_group G t₂ _)
-  {t : topological_space H} [topological_group H] {F : Type*}
-  [monoid_hom_class F G H] (f : F)
-
-@[to_additive] lemma topological_group_Inf :
-  @topological_group G (Inf ts) _ :=
-{ continuous_inv := @has_continuous_inv.continuous_inv G (Inf ts) _
-    (@has_continuous_inv_Inf _ _ _
-      (λ t ht, @topological_group.to_has_continuous_inv G t _ (h t ht))),
-  continuous_mul := @has_continuous_mul.continuous_mul G (Inf ts) _
-    (@has_continuous_mul_Inf _ _ _
-      (λ t ht, @topological_group.to_has_continuous_mul G t _ (h t ht))) }
-
-include h'
-
-@[to_additive] lemma topological_group_infi :
-  @topological_group G (⨅ i, ts' i) _ :=
-by {rw ← Inf_range, exact topological_group_Inf (set.forall_range_iff.mpr h')}
-
-omit h'
-
-include h₁ h₂
-
-@[to_additive] lemma topological_group_inf :
-  @topological_group G (t₁ ⊓ t₂) _ :=
-by {rw inf_eq_infi, refine topological_group_infi (λ b, _), cases b; assumption}
-
-omit h₁ h₂
-
-@[to_additive] lemma topological_group_induced :
-  @topological_group G (t.induced f) _ :=
-{ continuous_inv :=
-    begin
-      letI : topological_space G := t.induced f,
-      refine continuous_induced_rng _,
-      simp_rw [function.comp, map_inv],
-      exact continuous_inv.comp (continuous_induced_dom : continuous f)
-    end,
-  continuous_mul := @has_continuous_mul.continuous_mul G (t.induced f) _
-    (@has_continuous_mul_induced G H _ _ t _ _ _ f) }
-
-end lattice_ops
-
-/-!
-### Lattice of group topologies
-We define a type class `group_topology α` which endows a group `α` with a topology such that all
-group operations are continuous.
-
-Group topologies on a fixed group `α` are ordered, by reverse inclusion. They form a complete
-lattice, with `⊥` the discrete topology and `⊤` the indiscrete topology.
-
-Any function `f : α → β` induces `coinduced f : topological_space α → group_topology β`.
-
-The additive version `add_group_topology α` and corresponding results are provided as well.
--/
-
-/-- A group topology on a group `α` is a topology for which multiplication and inversion
-are continuous. -/
-structure group_topology (α : Type u) [group α]
-  extends topological_space α, topological_group α : Type u
-
-/-- An additive group topology on an additive group `α` is a topology for which addition and
-  negation are continuous. -/
-structure add_group_topology (α : Type u) [add_group α]
-  extends topological_space α, topological_add_group α : Type u
-
-attribute [to_additive] group_topology
-
-namespace group_topology
-
-variables [group α]
-
-/-- A version of the global `continuous_mul` suitable for dot notation. -/
-@[to_additive]
-lemma continuous_mul' (g : group_topology α) :
-  by haveI := g.to_topological_space; exact continuous (λ p : α × α, p.1 * p.2) :=
-begin
-  letI := g.to_topological_space,
-  haveI := g.to_topological_group,
-  exact continuous_mul,
-end
-
-/-- A version of the global `continuous_inv` suitable for dot notation. -/
-@[to_additive]
-lemma continuous_inv' (g : group_topology α) :
-  by haveI := g.to_topological_space; exact continuous (has_inv.inv : α → α) :=
-begin
-  letI := g.to_topological_space,
-  haveI := g.to_topological_group,
-  exact continuous_inv,
-end
-
-@[to_additive]
-lemma to_topological_space_injective :
-  function.injective (to_topological_space : group_topology α → topological_space α):=
-λ f g h, by { cases f, cases g, congr' }
-
-@[ext, to_additive]
-lemma ext' {f g : group_topology α} (h : f.is_open = g.is_open) : f = g :=
-to_topological_space_injective $ topological_space_eq h
-
-/-- The ordering on group topologies on the group `γ`.
-  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
-@[to_additive]
-instance : partial_order (group_topology α) :=
-partial_order.lift to_topological_space to_topological_space_injective
-
-@[simp, to_additive] lemma to_topological_space_le {x y : group_topology α} :
-  x.to_topological_space ≤ y.to_topological_space ↔ x ≤ y := iff.rfl
-
-@[to_additive]
-instance : has_top (group_topology α) :=
-⟨{to_topological_space := ⊤,
-  continuous_mul       := continuous_top,
-  continuous_inv       := continuous_top}⟩
-
-@[simp, to_additive] lemma to_topological_space_top :
-  (⊤ : group_topology α).to_topological_space = ⊤ := rfl
-
-@[to_additive]
-instance : has_bot (group_topology α) :=
-⟨{to_topological_space := ⊥,
-  continuous_mul       := by continuity,
-  continuous_inv       := continuous_bot}⟩
-
-@[simp, to_additive] lemma to_topological_space_bot :
-  (⊥ : group_topology α).to_topological_space = ⊥ := rfl
-
-@[to_additive]
-instance : bounded_order (group_topology α) :=
-{ top := ⊤,
-  le_top := λ x, show x.to_topological_space ≤ ⊤, from le_top,
-  bot := ⊥,
-  bot_le := λ x, show ⊥ ≤ x.to_topological_space, from bot_le }
-
-@[to_additive]
-instance : has_inf (group_topology α) :=
-{ inf := λ x y,
-  { to_topological_space := x.to_topological_space ⊓ y.to_topological_space,
-    continuous_mul := continuous_inf_rng
-      (continuous_inf_dom_left₂ x.continuous_mul') (continuous_inf_dom_right₂ y.continuous_mul'),
-    continuous_inv := continuous_inf_rng
-      (continuous_inf_dom_left x.continuous_inv') (continuous_inf_dom_right y.continuous_inv') } }
-
-@[simp, to_additive]
-lemma to_topological_space_inf (x y : group_topology α) :
-  (x ⊓ y).to_topological_space = x.to_topological_space ⊓ y.to_topological_space := rfl
-
-@[to_additive]
-instance : semilattice_inf (group_topology α) :=
-to_topological_space_injective.semilattice_inf _ to_topological_space_inf
-
-@[to_additive]
-instance : inhabited (group_topology α) := ⟨⊤⟩
-
-local notation `cont` := @continuous _ _
-@[to_additive "Infimum of a collection of additive group topologies"]
-instance : has_Inf (group_topology α) :=
-{ Inf := λ S,
-  { to_topological_space := Inf (to_topological_space '' S),
-    continuous_mul       := continuous_Inf_rng begin
-      rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
-      exact continuous_Inf_dom₂
-        (set.mem_image_of_mem to_topological_space haS)
-        (set.mem_image_of_mem to_topological_space haS) continuous_mul,
-    end,
-    continuous_inv       := continuous_Inf_rng begin
-      rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
-      exact continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_inv,
-    end, } }
-
-@[simp, to_additive]
-lemma to_topological_space_Inf (s : set (group_topology α)) :
-  (Inf s).to_topological_space = Inf (to_topological_space '' s) := rfl
-
-@[simp, to_additive]
-lemma to_topological_space_infi {ι} (s : ι → group_topology α) :
-  (⨅ i, s i).to_topological_space = ⨅ i, (s i).to_topological_space :=
-congr_arg Inf (range_comp _ _).symm
-
-/-- Group topologies on `γ` form a complete lattice, with `⊥` the discrete topology and `⊤` the
-indiscrete topology.
-
-The infimum of a collection of group topologies is the topology generated by all their open sets
-(which is a group topology).
-
-The supremum of two group topologies `s` and `t` is the infimum of the family of all group
-topologies contained in the intersection of `s` and `t`. -/
-@[to_additive]
-instance : complete_semilattice_Inf (group_topology α) :=
-{ Inf_le := λ S a haS, to_topological_space_le.1 $ Inf_le ⟨a, haS, rfl⟩,
-  le_Inf :=
-  begin
-    intros S a hab,
-    apply topological_space.complete_lattice.le_Inf,
-    rintros _ ⟨b, hbS, rfl⟩,
-    exact hab b hbS,
-  end,
-  ..group_topology.has_Inf,
-  ..group_topology.partial_order }
-
-@[to_additive]
-instance : complete_lattice (group_topology α) :=
-{ inf := (⊓),
-  top := ⊤,
-  bot := ⊥,
-  ..group_topology.bounded_order,
-  ..group_topology.semilattice_inf,
-  ..complete_lattice_of_complete_semilattice_Inf _ }
-
-/--  Given `f : α → β` and a topology on `α`, the coinduced group topology on `β` is the finest
-topology such that `f` is continuous and `β` is a topological group. -/
-@[to_additive "Given `f : α → β` and a topology on `α`, the coinduced additive group topology on `β`
-is the finest topology such that `f` is continuous and `β` is a topological additive group."]
-def coinduced {α β : Type*} [t : topological_space α] [group β] (f : α → β) :
-  group_topology β :=
-Inf {b : group_topology β | (topological_space.coinduced f t) ≤ b.to_topological_space}
-
-@[to_additive]
-lemma coinduced_continuous {α β : Type*} [t : topological_space α] [group β]
-  (f : α → β) : cont t (coinduced f).to_topological_space f :=
-begin
-  rw continuous_iff_coinduced_le,
-  refine le_Inf _,
-  rintros _ ⟨t', ht', rfl⟩,
-  exact ht',
-end
-
-end group_topology
diff --git a/src/topology/algebra/group/basic.lean b/src/topology/algebra/group/basic.lean
new file mode 100644
index 0000000000000..a9088e29754f0
--- /dev/null
+++ b/src/topology/algebra/group/basic.lean
@@ -0,0 +1,1563 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
+-/
+import group_theory.group_action.conj_act
+import group_theory.group_action.quotient
+import group_theory.quotient_group
+import topology.algebra.monoid
+import topology.algebra.constructions
+
+/-!
+# Topological groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the following typeclasses:
+
+* `topological_group`, `topological_add_group`: multiplicative and additive topological groups,
+  i.e., groups with continuous `(*)` and `(⁻¹)` / `(+)` and `(-)`;
+
+* `has_continuous_sub G` means that `G` has a continuous subtraction operation.
+
+There is an instance deducing `has_continuous_sub` from `topological_group` but we use a separate
+typeclass because, e.g., `ℕ` and `ℝ≥0` have continuous subtraction but are not additive groups.
+
+We also define `homeomorph` versions of several `equiv`s: `homeomorph.mul_left`,
+`homeomorph.mul_right`, `homeomorph.inv`, and prove a few facts about neighbourhood filters in
+groups.
+
+## Tags
+
+topological space, group, topological group
+-/
+
+open classical set filter topological_space function
+open_locale classical topology filter pointwise
+
+universes u v w x
+variables {α : Type u} {β : Type v} {G : Type w} {H : Type x}
+
+section continuous_mul_group
+
+/-!
+### Groups with continuous multiplication
+
+In this section we prove a few statements about groups with continuous `(*)`.
+-/
+
+variables [topological_space G] [group G] [has_continuous_mul G]
+
+/-- Multiplication from the left in a topological group as a homeomorphism. -/
+@[to_additive "Addition from the left in a topological additive group as a homeomorphism."]
+protected def homeomorph.mul_left (a : G) : G ≃ₜ G :=
+{ continuous_to_fun  := continuous_const.mul continuous_id,
+  continuous_inv_fun := continuous_const.mul continuous_id,
+  .. equiv.mul_left a }
+
+@[simp, to_additive]
+lemma homeomorph.coe_mul_left (a : G) : ⇑(homeomorph.mul_left a) = (*) a := rfl
+
+@[to_additive]
+lemma homeomorph.mul_left_symm (a : G) : (homeomorph.mul_left a).symm = homeomorph.mul_left a⁻¹ :=
+by { ext, refl }
+
+@[to_additive]
+lemma is_open_map_mul_left (a : G) : is_open_map (λ x, a * x) :=
+(homeomorph.mul_left a).is_open_map
+
+@[to_additive is_open.left_add_coset]
+lemma is_open.left_coset {U : set G} (h : is_open U) (x : G) : is_open (left_coset x U) :=
+is_open_map_mul_left x _ h
+
+@[to_additive]
+lemma is_closed_map_mul_left (a : G) : is_closed_map (λ x, a * x) :=
+(homeomorph.mul_left a).is_closed_map
+
+@[to_additive is_closed.left_add_coset]
+lemma is_closed.left_coset {U : set G} (h : is_closed U) (x : G) : is_closed (left_coset x U) :=
+is_closed_map_mul_left x _ h
+
+/-- Multiplication from the right in a topological group as a homeomorphism. -/
+@[to_additive "Addition from the right in a topological additive group as a homeomorphism."]
+protected def homeomorph.mul_right (a : G) :
+  G ≃ₜ G :=
+{ continuous_to_fun  := continuous_id.mul continuous_const,
+  continuous_inv_fun := continuous_id.mul continuous_const,
+  .. equiv.mul_right a }
+
+@[simp, to_additive]
+lemma homeomorph.coe_mul_right (a : G) : ⇑(homeomorph.mul_right a) = λ g, g * a := rfl
+
+@[to_additive]
+lemma homeomorph.mul_right_symm (a : G) :
+  (homeomorph.mul_right a).symm = homeomorph.mul_right a⁻¹ :=
+by { ext, refl }
+
+@[to_additive]
+lemma is_open_map_mul_right (a : G) : is_open_map (λ x, x * a) :=
+(homeomorph.mul_right a).is_open_map
+
+@[to_additive is_open.right_add_coset]
+lemma is_open.right_coset {U : set G} (h : is_open U) (x : G) : is_open (right_coset U x) :=
+is_open_map_mul_right x _ h
+
+@[to_additive]
+lemma is_closed_map_mul_right (a : G) : is_closed_map (λ x, x * a) :=
+(homeomorph.mul_right a).is_closed_map
+
+@[to_additive is_closed.right_add_coset]
+lemma is_closed.right_coset {U : set G} (h : is_closed U) (x : G) : is_closed (right_coset U x) :=
+is_closed_map_mul_right x _ h
+
+@[to_additive]
+lemma discrete_topology_of_open_singleton_one (h : is_open ({1} : set G)) : discrete_topology G :=
+begin
+  rw ← singletons_open_iff_discrete,
+  intro g,
+  suffices : {g} = (λ (x : G), g⁻¹ * x) ⁻¹' {1},
+  { rw this, exact (continuous_mul_left (g⁻¹)).is_open_preimage _ h, },
+  simp only [mul_one, set.preimage_mul_left_singleton, eq_self_iff_true,
+    inv_inv, set.singleton_eq_singleton_iff],
+end
+
+@[to_additive]
+lemma discrete_topology_iff_open_singleton_one : discrete_topology G ↔ is_open ({1} : set G) :=
+⟨λ h, forall_open_iff_discrete.mpr h {1}, discrete_topology_of_open_singleton_one⟩
+
+end continuous_mul_group
+
+/-!
+### `has_continuous_inv` and `has_continuous_neg`
+-/
+
+/-- Basic hypothesis to talk about a topological additive group. A topological additive group
+over `M`, for example, is obtained by requiring the instances `add_group M` and
+`has_continuous_add M` and `has_continuous_neg M`. -/
+class has_continuous_neg (G : Type u) [topological_space G] [has_neg G] : Prop :=
+(continuous_neg : continuous (λ a : G, -a))
+
+/-- Basic hypothesis to talk about a topological group. A topological group over `M`, for example,
+is obtained by requiring the instances `group M` and `has_continuous_mul M` and
+`has_continuous_inv M`. -/
+@[to_additive]
+class has_continuous_inv (G : Type u) [topological_space G] [has_inv G] : Prop :=
+(continuous_inv : continuous (λ a : G, a⁻¹))
+
+export has_continuous_inv (continuous_inv)
+export has_continuous_neg (continuous_neg)
+
+section continuous_inv
+
+variables [topological_space G] [has_inv G] [has_continuous_inv G]
+
+@[to_additive]
+lemma continuous_on_inv {s : set G} : continuous_on has_inv.inv s :=
+continuous_inv.continuous_on
+
+@[to_additive]
+lemma continuous_within_at_inv {s : set G} {x : G} : continuous_within_at has_inv.inv s x :=
+continuous_inv.continuous_within_at
+
+@[to_additive]
+lemma continuous_at_inv {x : G} : continuous_at has_inv.inv x :=
+continuous_inv.continuous_at
+
+@[to_additive]
+lemma tendsto_inv (a : G) : tendsto has_inv.inv (𝓝 a) (𝓝 (a⁻¹)) :=
+continuous_at_inv
+
+/-- If a function converges to a value in a multiplicative topological group, then its inverse
+converges to the inverse of this value. For the version in normed fields assuming additionally
+that the limit is nonzero, use `tendsto.inv'`. -/
+@[to_additive "If a function converges to a value in an additive topological group, then its
+negation converges to the negation of this value."]
+lemma filter.tendsto.inv {f : α → G} {l : filter α} {y : G} (h : tendsto f l (𝓝 y)) :
+  tendsto (λ x, (f x)⁻¹) l (𝓝 y⁻¹) :=
+(continuous_inv.tendsto y).comp h
+
+variables [topological_space α] {f : α → G} {s : set α} {x : α}
+
+@[continuity, to_additive]
+lemma continuous.inv (hf : continuous f) : continuous (λx, (f x)⁻¹) :=
+continuous_inv.comp hf
+
+@[to_additive]
+lemma continuous_at.inv (hf : continuous_at f x) : continuous_at (λ x, (f x)⁻¹) x :=
+continuous_at_inv.comp hf
+
+@[to_additive]
+lemma continuous_on.inv (hf : continuous_on f s) : continuous_on (λx, (f x)⁻¹) s :=
+continuous_inv.comp_continuous_on hf
+
+@[to_additive]
+lemma continuous_within_at.inv (hf : continuous_within_at f s x) :
+  continuous_within_at (λ x, (f x)⁻¹) s x :=
+hf.inv
+
+@[to_additive]
+instance [topological_space H] [has_inv H] [has_continuous_inv H] : has_continuous_inv (G × H) :=
+⟨continuous_inv.fst'.prod_mk continuous_inv.snd'⟩
+
+variable {ι : Type*}
+
+@[to_additive]
+instance pi.has_continuous_inv {C : ι → Type*} [∀ i, topological_space (C i)]
+  [∀ i, has_inv (C i)] [∀ i, has_continuous_inv (C i)] : has_continuous_inv (Π i, C i) :=
+{ continuous_inv := continuous_pi (λ i, (continuous_apply i).inv) }
+
+/-- A version of `pi.has_continuous_inv` for non-dependent functions. It is needed because sometimes
+Lean fails to use `pi.has_continuous_inv` for non-dependent functions. -/
+@[to_additive "A version of `pi.has_continuous_neg` for non-dependent functions. It is needed
+because sometimes Lean fails to use `pi.has_continuous_neg` for non-dependent functions."]
+instance pi.has_continuous_inv' : has_continuous_inv (ι → G) :=
+pi.has_continuous_inv
+
+@[priority 100, to_additive]
+instance has_continuous_inv_of_discrete_topology [topological_space H]
+  [has_inv H] [discrete_topology H] : has_continuous_inv H :=
+⟨continuous_of_discrete_topology⟩
+
+section pointwise_limits
+
+variables (G₁ G₂ : Type*) [topological_space G₂] [t2_space G₂]
+
+@[to_additive] lemma is_closed_set_of_map_inv [has_inv G₁] [has_inv G₂] [has_continuous_inv G₂] :
+  is_closed {f : G₁ → G₂ | ∀ x, f x⁻¹ = (f x)⁻¹ } :=
+begin
+  simp only [set_of_forall],
+  refine is_closed_Inter (λ i, is_closed_eq (continuous_apply _) (continuous_apply _).inv),
+end
+
+end pointwise_limits
+
+instance [topological_space H] [has_inv H] [has_continuous_inv H] :
+  has_continuous_neg (additive H) :=
+{ continuous_neg := @continuous_inv H _ _ _ }
+
+instance [topological_space H] [has_neg H] [has_continuous_neg H] :
+  has_continuous_inv (multiplicative H) :=
+{ continuous_inv := @continuous_neg H _ _ _ }
+
+end continuous_inv
+
+section continuous_involutive_inv
+variables [topological_space G] [has_involutive_inv G] [has_continuous_inv G] {s : set G}
+
+@[to_additive] lemma is_compact.inv (hs : is_compact s) : is_compact s⁻¹ :=
+by { rw [← image_inv], exact hs.image continuous_inv }
+
+variables (G)
+
+/-- Inversion in a topological group as a homeomorphism. -/
+@[to_additive "Negation in a topological group as a homeomorphism."]
+protected def homeomorph.inv (G : Type*) [topological_space G] [has_involutive_inv G]
+  [has_continuous_inv G] : G ≃ₜ G :=
+{ continuous_to_fun  := continuous_inv,
+  continuous_inv_fun := continuous_inv,
+  .. equiv.inv G }
+
+@[to_additive] lemma is_open_map_inv : is_open_map (has_inv.inv : G → G) :=
+(homeomorph.inv _).is_open_map
+
+@[to_additive] lemma is_closed_map_inv : is_closed_map (has_inv.inv : G → G) :=
+(homeomorph.inv _).is_closed_map
+
+variables {G}
+
+@[to_additive] lemma is_open.inv (hs : is_open s) : is_open s⁻¹ := hs.preimage continuous_inv
+@[to_additive] lemma is_closed.inv (hs : is_closed s) : is_closed s⁻¹ := hs.preimage continuous_inv
+@[to_additive] lemma inv_closure : ∀ s : set G, (closure s)⁻¹ = closure s⁻¹ :=
+(homeomorph.inv G).preimage_closure
+
+end continuous_involutive_inv
+
+section lattice_ops
+
+variables {ι' : Sort*} [has_inv G]
+
+@[to_additive] lemma has_continuous_inv_Inf {ts : set (topological_space G)}
+  (h : Π t ∈ ts, @has_continuous_inv G t _) :
+  @has_continuous_inv G (Inf ts) _ :=
+{ continuous_inv := continuous_Inf_rng.2 (λ t ht, continuous_Inf_dom ht
+  (@has_continuous_inv.continuous_inv G t _ (h t ht))) }
+
+@[to_additive] lemma has_continuous_inv_infi {ts' : ι' → topological_space G}
+  (h' : Π i, @has_continuous_inv G (ts' i) _) :
+  @has_continuous_inv G (⨅ i, ts' i) _ :=
+by {rw ← Inf_range, exact has_continuous_inv_Inf (set.forall_range_iff.mpr h')}
+
+@[to_additive] lemma has_continuous_inv_inf {t₁ t₂ : topological_space G}
+  (h₁ : @has_continuous_inv G t₁ _) (h₂ : @has_continuous_inv G t₂ _) :
+  @has_continuous_inv G (t₁ ⊓ t₂) _ :=
+by { rw inf_eq_infi, refine has_continuous_inv_infi (λ b, _), cases b; assumption }
+
+end lattice_ops
+
+@[to_additive] lemma inducing.has_continuous_inv {G H : Type*} [has_inv G] [has_inv H]
+  [topological_space G] [topological_space H] [has_continuous_inv H] {f : G → H} (hf : inducing f)
+  (hf_inv : ∀ x, f x⁻¹ = (f x)⁻¹) : has_continuous_inv G :=
+⟨hf.continuous_iff.2 $ by simpa only [(∘), hf_inv] using hf.continuous.inv⟩
+
+section topological_group
+
+/-!
+### Topological groups
+
+A topological group is a group in which the multiplication and inversion operations are
+continuous. Topological additive groups are defined in the same way. Equivalently, we can require
+that the division operation `λ x y, x * y⁻¹` (resp., subtraction) is continuous.
+-/
+
+/-- A topological (additive) group is a group in which the addition and negation operations are
+continuous. -/
+class topological_add_group (G : Type u) [topological_space G] [add_group G]
+  extends has_continuous_add G, has_continuous_neg G : Prop
+
+/-- A topological group is a group in which the multiplication and inversion operations are
+continuous.
+
+When you declare an instance that does not already have a `uniform_space` instance,
+you should also provide an instance of `uniform_space` and `uniform_group` using
+`topological_group.to_uniform_space` and `topological_comm_group_is_uniform`. -/
+@[to_additive]
+class topological_group (G : Type*) [topological_space G] [group G]
+  extends has_continuous_mul G, has_continuous_inv G : Prop
+
+section conj
+
+instance conj_act.units_has_continuous_const_smul {M} [monoid M] [topological_space M]
+  [has_continuous_mul M] :
+  has_continuous_const_smul (conj_act Mˣ) M :=
+⟨λ m, (continuous_const.mul continuous_id).mul continuous_const⟩
+
+/-- we slightly weaken the type class assumptions here so that it will also apply to `ennreal`, but
+we nevertheless leave it in the `topological_group` namespace. -/
+
+variables [topological_space G] [has_inv G] [has_mul G] [has_continuous_mul G]
+
+/-- Conjugation is jointly continuous on `G × G` when both `mul` and `inv` are continuous. -/
+@[to_additive "Conjugation is jointly continuous on `G × G` when both `mul` and `inv` are
+continuous."]
+lemma topological_group.continuous_conj_prod [has_continuous_inv G] :
+  continuous (λ g : G × G, g.fst * g.snd * g.fst⁻¹) :=
+continuous_mul.mul (continuous_inv.comp continuous_fst)
+
+/-- Conjugation by a fixed element is continuous when `mul` is continuous. -/
+@[to_additive "Conjugation by a fixed element is continuous when `add` is continuous."]
+lemma topological_group.continuous_conj (g : G) : continuous (λ (h : G), g * h * g⁻¹) :=
+(continuous_mul_right g⁻¹).comp (continuous_mul_left g)
+
+/-- Conjugation acting on fixed element of the group is continuous when both `mul` and
+`inv` are continuous. -/
+@[to_additive "Conjugation acting on fixed element of the additive group is continuous when both
+  `add` and `neg` are continuous."]
+lemma topological_group.continuous_conj' [has_continuous_inv G]
+  (h : G) : continuous (λ (g : G), g * h * g⁻¹) :=
+(continuous_mul_right h).mul continuous_inv
+
+end conj
+
+variables [topological_space G] [group G] [topological_group G]
+[topological_space α] {f : α → G} {s : set α} {x : α}
+
+section zpow
+
+@[continuity, to_additive]
+lemma continuous_zpow : ∀ z : ℤ, continuous (λ a : G, a ^ z)
+| (int.of_nat n) := by simpa using continuous_pow n
+| -[1+n] := by simpa using (continuous_pow (n + 1)).inv
+
+instance add_group.has_continuous_const_smul_int {A} [add_group A] [topological_space A]
+  [topological_add_group A] : has_continuous_const_smul ℤ A := ⟨continuous_zsmul⟩
+
+instance add_group.has_continuous_smul_int {A} [add_group A] [topological_space A]
+  [topological_add_group A] : has_continuous_smul ℤ A :=
+⟨continuous_uncurry_of_discrete_topology continuous_zsmul⟩
+
+@[continuity, to_additive]
+lemma continuous.zpow {f : α → G} (h : continuous f) (z : ℤ) :
+  continuous (λ b, (f b) ^ z) :=
+(continuous_zpow z).comp h
+
+@[to_additive]
+lemma continuous_on_zpow {s : set G} (z : ℤ) : continuous_on (λ x, x ^ z) s :=
+(continuous_zpow z).continuous_on
+
+@[to_additive]
+lemma continuous_at_zpow (x : G) (z : ℤ) : continuous_at (λ x, x ^ z) x :=
+(continuous_zpow z).continuous_at
+
+@[to_additive]
+lemma filter.tendsto.zpow {α} {l : filter α} {f : α → G} {x : G} (hf : tendsto f l (𝓝 x)) (z : ℤ) :
+  tendsto (λ x, f x ^ z) l (𝓝 (x ^ z)) :=
+(continuous_at_zpow _ _).tendsto.comp hf
+
+@[to_additive]
+lemma continuous_within_at.zpow {f : α → G} {x : α} {s : set α} (hf : continuous_within_at f s x)
+  (z : ℤ) : continuous_within_at (λ x, f x ^ z) s x :=
+hf.zpow z
+
+@[to_additive]
+lemma continuous_at.zpow {f : α → G} {x : α} (hf : continuous_at f x) (z : ℤ) :
+  continuous_at (λ x, f x ^ z) x :=
+hf.zpow z
+
+@[to_additive continuous_on.zsmul]
+lemma continuous_on.zpow {f : α → G} {s : set α} (hf : continuous_on f s) (z : ℤ) :
+  continuous_on (λ x, f x ^ z) s :=
+λ x hx, (hf x hx).zpow z
+
+end zpow
+
+section ordered_comm_group
+
+variables [topological_space H] [ordered_comm_group H] [has_continuous_inv H]
+
+@[to_additive] lemma tendsto_inv_nhds_within_Ioi {a : H} :
+  tendsto has_inv.inv (𝓝[>] a) (𝓝[<] (a⁻¹)) :=
+(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
+
+@[to_additive] lemma tendsto_inv_nhds_within_Iio {a : H} :
+  tendsto has_inv.inv (𝓝[<] a) (𝓝[>] (a⁻¹)) :=
+(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
+
+@[to_additive] lemma tendsto_inv_nhds_within_Ioi_inv {a : H} :
+  tendsto has_inv.inv (𝓝[>] (a⁻¹)) (𝓝[<] a) :=
+by simpa only [inv_inv] using @tendsto_inv_nhds_within_Ioi _ _ _ _ (a⁻¹)
+
+@[to_additive] lemma tendsto_inv_nhds_within_Iio_inv {a : H} :
+  tendsto has_inv.inv (𝓝[<] (a⁻¹)) (𝓝[>] a) :=
+by simpa only [inv_inv] using @tendsto_inv_nhds_within_Iio _ _ _ _ (a⁻¹)
+
+@[to_additive] lemma tendsto_inv_nhds_within_Ici {a : H} :
+  tendsto has_inv.inv (𝓝[≥] a) (𝓝[≤] (a⁻¹)) :=
+(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
+
+@[to_additive] lemma tendsto_inv_nhds_within_Iic {a : H} :
+  tendsto has_inv.inv (𝓝[≤] a) (𝓝[≥] (a⁻¹)) :=
+(continuous_inv.tendsto a).inf $ by simp [tendsto_principal_principal]
+
+@[to_additive] lemma tendsto_inv_nhds_within_Ici_inv {a : H} :
+  tendsto has_inv.inv (𝓝[≥] (a⁻¹)) (𝓝[≤] a) :=
+by simpa only [inv_inv] using @tendsto_inv_nhds_within_Ici _ _ _ _ (a⁻¹)
+
+@[to_additive] lemma tendsto_inv_nhds_within_Iic_inv {a : H} :
+  tendsto has_inv.inv (𝓝[≤] (a⁻¹)) (𝓝[≥] a) :=
+by simpa only [inv_inv] using @tendsto_inv_nhds_within_Iic _ _ _ _ (a⁻¹)
+
+end ordered_comm_group
+
+@[instance, to_additive]
+instance [topological_space H] [group H] [topological_group H] :
+  topological_group (G × H) :=
+{ continuous_inv := continuous_inv.prod_map continuous_inv }
+
+@[to_additive]
+instance pi.topological_group {C : β → Type*} [∀ b, topological_space (C b)]
+  [∀ b, group (C b)] [∀ b, topological_group (C b)] : topological_group (Π b, C b) :=
+{ continuous_inv := continuous_pi (λ i, (continuous_apply i).inv) }
+
+open mul_opposite
+
+@[to_additive]
+instance [has_inv α] [has_continuous_inv α] : has_continuous_inv αᵐᵒᵖ :=
+op_homeomorph.symm.inducing.has_continuous_inv unop_inv
+
+/-- If multiplication is continuous in `α`, then it also is in `αᵐᵒᵖ`. -/
+@[to_additive "If addition is continuous in `α`, then it also is in `αᵃᵒᵖ`."]
+instance [group α] [topological_group α] :
+  topological_group αᵐᵒᵖ := { }
+
+variable (G)
+
+@[to_additive]
+lemma nhds_one_symm : comap has_inv.inv (𝓝 (1 : G)) = 𝓝 (1 : G) :=
+((homeomorph.inv G).comap_nhds_eq _).trans (congr_arg nhds inv_one)
+
+@[to_additive]
+lemma nhds_one_symm' : map has_inv.inv (𝓝 (1 : G)) = 𝓝 (1 : G) :=
+((homeomorph.inv G).map_nhds_eq _).trans (congr_arg nhds inv_one)
+
+@[to_additive]
+lemma inv_mem_nhds_one {S : set G} (hS : S ∈ (𝓝 1 : filter G)) : S⁻¹ ∈ (𝓝 (1 : G)) :=
+by rwa [← nhds_one_symm'] at hS
+
+/-- The map `(x, y) ↦ (x, xy)` as a homeomorphism. This is a shear mapping. -/
+@[to_additive "The map `(x, y) ↦ (x, x + y)` as a homeomorphism.
+This is a shear mapping."]
+protected def homeomorph.shear_mul_right : G × G ≃ₜ G × G :=
+{ continuous_to_fun  := continuous_fst.prod_mk continuous_mul,
+  continuous_inv_fun := continuous_fst.prod_mk $ continuous_fst.inv.mul continuous_snd,
+  .. equiv.prod_shear (equiv.refl _) equiv.mul_left }
+
+@[simp, to_additive]
+lemma homeomorph.shear_mul_right_coe :
+  ⇑(homeomorph.shear_mul_right G) = λ z : G × G, (z.1, z.1 * z.2) :=
+rfl
+
+@[simp, to_additive]
+lemma homeomorph.shear_mul_right_symm_coe :
+  ⇑(homeomorph.shear_mul_right G).symm = λ z : G × G, (z.1, z.1⁻¹ * z.2) :=
+rfl
+
+variables {G}
+
+@[to_additive] protected lemma inducing.topological_group {F : Type*} [group H]
+  [topological_space H] [monoid_hom_class F H G] (f : F) (hf : inducing f) :
+  topological_group H :=
+{ to_has_continuous_mul := hf.has_continuous_mul _,
+  to_has_continuous_inv := hf.has_continuous_inv (map_inv f) }
+
+@[to_additive] protected lemma topological_group_induced {F : Type*} [group H]
+  [monoid_hom_class F H G] (f : F) :
+  @topological_group H (induced f ‹_›) _ :=
+by { letI := induced f ‹_›, exact inducing.topological_group f ⟨rfl⟩  }
+
+namespace subgroup
+
+@[to_additive] instance (S : subgroup G) : topological_group S :=
+inducing.topological_group S.subtype inducing_coe
+
+end subgroup
+
+/-- The (topological-space) closure of a subgroup of a space `M` with `has_continuous_mul` is
+itself a subgroup. -/
+@[to_additive "The (topological-space) closure of an additive subgroup of a space `M` with
+`has_continuous_add` is itself an additive subgroup."]
+def subgroup.topological_closure (s : subgroup G) : subgroup G :=
+{ carrier := closure (s : set G),
+  inv_mem' := λ g m, by simpa [←set.mem_inv, inv_closure] using m,
+  ..s.to_submonoid.topological_closure }
+
+@[simp, to_additive] lemma subgroup.topological_closure_coe {s : subgroup G} :
+  (s.topological_closure : set G) = closure s :=
+rfl
+
+@[to_additive] lemma subgroup.le_topological_closure (s : subgroup G) :
+  s ≤ s.topological_closure :=
+subset_closure
+
+@[to_additive] lemma subgroup.is_closed_topological_closure (s : subgroup G) :
+  is_closed (s.topological_closure : set G) :=
+by convert is_closed_closure
+
+@[to_additive] lemma subgroup.topological_closure_minimal
+  (s : subgroup G) {t : subgroup G} (h : s ≤ t) (ht : is_closed (t : set G)) :
+  s.topological_closure ≤ t :=
+closure_minimal h ht
+
+@[to_additive] lemma dense_range.topological_closure_map_subgroup [group H] [topological_space H]
+  [topological_group H] {f : G →* H} (hf : continuous f) (hf' : dense_range f) {s : subgroup G}
+  (hs : s.topological_closure = ⊤) :
+  (s.map f).topological_closure = ⊤ :=
+begin
+  rw set_like.ext'_iff at hs ⊢,
+  simp only [subgroup.topological_closure_coe, subgroup.coe_top, ← dense_iff_closure_eq] at hs ⊢,
+  exact hf'.dense_image hf hs
+end
+
+/-- The topological closure of a normal subgroup is normal.-/
+@[to_additive "The topological closure of a normal additive subgroup is normal."]
+lemma subgroup.is_normal_topological_closure {G : Type*} [topological_space G] [group G]
+  [topological_group G] (N : subgroup G) [N.normal] :
+  (subgroup.topological_closure N).normal :=
+{ conj_mem := λ n hn g,
+  begin
+    apply map_mem_closure (topological_group.continuous_conj g) hn,
+    exact λ m hm, subgroup.normal.conj_mem infer_instance m hm g
+  end }
+
+@[to_additive] lemma mul_mem_connected_component_one {G : Type*} [topological_space G]
+  [mul_one_class G] [has_continuous_mul G] {g h : G} (hg : g ∈ connected_component (1 : G))
+  (hh : h ∈ connected_component (1 : G)) : g * h ∈ connected_component (1 : G) :=
+begin
+  rw connected_component_eq hg,
+  have hmul: g ∈ connected_component (g*h),
+  { apply continuous.image_connected_component_subset (continuous_mul_left g),
+    rw ← connected_component_eq hh,
+    exact ⟨(1 : G), mem_connected_component, by simp only [mul_one]⟩ },
+  simpa [← connected_component_eq hmul] using (mem_connected_component)
+end
+
+@[to_additive] lemma inv_mem_connected_component_one {G : Type*} [topological_space G] [group G]
+  [topological_group G] {g : G} (hg : g ∈ connected_component (1 : G)) :
+  g⁻¹ ∈ connected_component (1 : G) :=
+begin
+  rw ← inv_one,
+  exact continuous.image_connected_component_subset continuous_inv _
+    ((set.mem_image _ _ _).mp ⟨g, hg, rfl⟩)
+end
+
+/-- The connected component of 1 is a subgroup of `G`. -/
+@[to_additive "The connected component of 0 is a subgroup of `G`."]
+def subgroup.connected_component_of_one (G : Type*) [topological_space G] [group G]
+  [topological_group G] : subgroup G :=
+{ carrier  := connected_component (1 : G),
+  one_mem' := mem_connected_component,
+  mul_mem' := λ g h hg hh, mul_mem_connected_component_one hg hh,
+  inv_mem' := λ g hg, inv_mem_connected_component_one hg }
+
+/-- If a subgroup of a topological group is commutative, then so is its topological closure. -/
+@[to_additive "If a subgroup of an additive topological group is commutative, then so is its
+topological closure."]
+def subgroup.comm_group_topological_closure [t2_space G] (s : subgroup G)
+  (hs : ∀ (x y : s), x * y = y * x) : comm_group s.topological_closure :=
+{ ..s.topological_closure.to_group,
+  ..s.to_submonoid.comm_monoid_topological_closure hs }
+
+@[to_additive exists_nhds_half_neg]
+lemma exists_nhds_split_inv {s : set G} (hs : s ∈ 𝓝 (1 : G)) :
+  ∃ V ∈ 𝓝 (1 : G), ∀ (v ∈ V) (w ∈ V), v / w ∈ s :=
+have ((λp : G × G, p.1 * p.2⁻¹) ⁻¹' s) ∈ 𝓝 ((1, 1) : G × G),
+  from continuous_at_fst.mul continuous_at_snd.inv (by simpa),
+by simpa only [div_eq_mul_inv, nhds_prod_eq, mem_prod_self_iff, prod_subset_iff, mem_preimage]
+  using this
+
+@[to_additive]
+lemma nhds_translation_mul_inv (x : G) : comap (λ y : G, y * x⁻¹) (𝓝 1) = 𝓝 x :=
+((homeomorph.mul_right x⁻¹).comap_nhds_eq 1).trans $ show 𝓝 (1 * x⁻¹⁻¹) = 𝓝 x, by simp
+
+@[simp, to_additive] lemma map_mul_left_nhds (x y : G) : map ((*) x) (𝓝 y) = 𝓝 (x * y) :=
+(homeomorph.mul_left x).map_nhds_eq y
+
+@[to_additive] lemma map_mul_left_nhds_one (x : G) : map ((*) x) (𝓝 1) = 𝓝 x := by simp
+
+@[simp, to_additive] lemma map_mul_right_nhds (x y : G) : map (λ z, z * x) (𝓝 y) = 𝓝 (y * x) :=
+(homeomorph.mul_right x).map_nhds_eq y
+
+@[to_additive] lemma map_mul_right_nhds_one (x : G) : map (λ y, y * x) (𝓝 1) = 𝓝 x := by simp
+
+@[to_additive] lemma filter.has_basis.nhds_of_one {ι : Sort*} {p : ι → Prop} {s : ι → set G}
+  (hb : has_basis (𝓝 1 : filter G) p s) (x : G) : has_basis (𝓝 x) p (λ i, {y | y / x ∈ s i}) :=
+begin
+  rw ← nhds_translation_mul_inv,
+  simp_rw [div_eq_mul_inv],
+  exact hb.comap _
+end
+
+@[to_additive] lemma mem_closure_iff_nhds_one {x : G} {s : set G} :
+  x ∈ closure s ↔ ∀ U ∈ (𝓝 1 : filter G), ∃ y ∈ s, y / x ∈ U  :=
+begin
+  rw mem_closure_iff_nhds_basis ((𝓝 1 : filter G).basis_sets.nhds_of_one x),
+  refl
+end
+
+/-- A monoid homomorphism (a bundled morphism of a type that implements `monoid_hom_class`) from a
+topological group to a topological monoid is continuous provided that it is continuous at one. See
+also `uniform_continuous_of_continuous_at_one`. -/
+@[to_additive "An additive monoid homomorphism (a bundled morphism of a type that implements
+`add_monoid_hom_class`) from an additive topological group to an additive topological monoid is
+continuous provided that it is continuous at zero. See also
+`uniform_continuous_of_continuous_at_zero`."]
+lemma continuous_of_continuous_at_one {M hom : Type*} [mul_one_class M] [topological_space M]
+  [has_continuous_mul M] [monoid_hom_class hom G M] (f : hom) (hf : continuous_at f 1) :
+  continuous f :=
+continuous_iff_continuous_at.2 $ λ x,
+  by simpa only [continuous_at, ← map_mul_left_nhds_one x, tendsto_map'_iff, (∘),
+    map_mul, map_one, mul_one] using hf.tendsto.const_mul (f x)
+
+@[to_additive]
+lemma topological_group.ext {G : Type*} [group G] {t t' : topological_space G}
+  (tg : @topological_group G t _) (tg' : @topological_group G t' _)
+  (h : @nhds G t 1 = @nhds G t' 1) : t = t' :=
+eq_of_nhds_eq_nhds $ λ x, by
+  rw [← @nhds_translation_mul_inv G t _ _ x , ← @nhds_translation_mul_inv G t' _ _ x , ← h]
+
+@[to_additive]
+lemma topological_group.ext_iff {G : Type*} [group G] {t t' : topological_space G}
+  (tg : @topological_group G t _) (tg' : @topological_group G t' _) :
+  t = t' ↔ @nhds G t 1 = @nhds G t' 1 :=
+⟨λ h, h ▸ rfl, tg.ext tg'⟩
+
+@[to_additive]
+lemma has_continuous_inv.of_nhds_one {G : Type*} [group G] [topological_space G]
+  (hinv : tendsto (λ (x : G), x⁻¹) (𝓝 1) (𝓝 1))
+  (hleft : ∀ (x₀ : G), 𝓝 x₀ = map (λ (x : G), x₀ * x) (𝓝 1))
+  (hconj : ∀ (x₀ : G), tendsto (λ (x : G), x₀ * x * x₀⁻¹) (𝓝 1) (𝓝 1)) :
+  has_continuous_inv G :=
+begin
+  refine ⟨continuous_iff_continuous_at.2 $ λ x₀, _⟩,
+  have : tendsto (λ x, x₀⁻¹ * (x₀ * x⁻¹ * x₀⁻¹)) (𝓝 1) (map ((*) x₀⁻¹) (𝓝 1)),
+    from (tendsto_map.comp $ hconj x₀).comp hinv,
+  simpa only [continuous_at, hleft x₀, hleft x₀⁻¹, tendsto_map'_iff, (∘), mul_assoc,
+    mul_inv_rev, inv_mul_cancel_left] using this
+end
+
+@[to_additive]
+lemma topological_group.of_nhds_one' {G : Type u} [group G] [topological_space G]
+  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
+  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
+  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
+  (hright : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x*x₀) (𝓝 1)) : topological_group G :=
+{ to_has_continuous_mul := has_continuous_mul.of_nhds_one hmul hleft hright,
+  to_has_continuous_inv := has_continuous_inv.of_nhds_one hinv hleft $ λ x₀, le_of_eq
+    begin
+      rw [show (λ x, x₀ * x * x₀⁻¹) = (λ x, x * x₀⁻¹) ∘ (λ x, x₀ * x), from rfl, ← map_map,
+        ← hleft, hright, map_map],
+      simp [(∘)]
+    end }
+
+@[to_additive]
+lemma topological_group.of_nhds_one {G : Type u} [group G] [topological_space G]
+  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
+  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
+  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1))
+  (hconj : ∀ x₀ : G, tendsto (λ x, x₀*x*x₀⁻¹) (𝓝 1) (𝓝 1)) : topological_group G :=
+begin
+  refine topological_group.of_nhds_one' hmul hinv hleft (λ x₀, _),
+  replace hconj : ∀ x₀ : G, map (λ x, x₀ * x * x₀⁻¹) (𝓝 1) = 𝓝 1,
+    from λ x₀, map_eq_of_inverse (λ x, x₀⁻¹ * x * x₀⁻¹⁻¹) (by { ext, simp [mul_assoc] })
+      (hconj _) (hconj _),
+  rw [← hconj x₀],
+  simpa [(∘)] using hleft _
+end
+
+@[to_additive]
+lemma topological_group.of_comm_of_nhds_one {G : Type u} [comm_group G] [topological_space G]
+  (hmul : tendsto (uncurry ((*) : G → G → G)) ((𝓝 1) ×ᶠ 𝓝 1) (𝓝 1))
+  (hinv : tendsto (λ x : G, x⁻¹) (𝓝 1) (𝓝 1))
+  (hleft : ∀ x₀ : G, 𝓝 x₀ = map (λ x, x₀*x) (𝓝 1)) : topological_group G :=
+topological_group.of_nhds_one hmul hinv hleft (by simpa using tendsto_id)
+
+end topological_group
+
+section quotient_topological_group
+variables [topological_space G] [group G] [topological_group G] (N : subgroup G) (n : N.normal)
+
+@[to_additive]
+instance quotient_group.quotient.topological_space {G : Type*} [group G] [topological_space G]
+  (N : subgroup G) : topological_space (G ⧸ N) :=
+quotient.topological_space
+
+open quotient_group
+
+@[to_additive]
+lemma quotient_group.is_open_map_coe : is_open_map (coe : G → G ⧸ N) :=
+begin
+  intros s s_op,
+  change is_open ((coe : G → G ⧸ N) ⁻¹' (coe '' s)),
+  rw quotient_group.preimage_image_coe N s,
+  exact is_open_Union (λ n, (continuous_mul_right _).is_open_preimage s s_op)
+end
+
+@[to_additive]
+instance topological_group_quotient [N.normal] : topological_group (G ⧸ N) :=
+{ continuous_mul := begin
+    have cont : continuous ((coe : G → G ⧸ N) ∘ (λ (p : G × G), p.fst * p.snd)) :=
+      continuous_quot_mk.comp continuous_mul,
+    have quot : quotient_map (λ p : G × G, ((p.1 : G ⧸ N), (p.2 : G ⧸ N))),
+    { apply is_open_map.to_quotient_map,
+      { exact (quotient_group.is_open_map_coe N).prod (quotient_group.is_open_map_coe N) },
+      { exact continuous_quot_mk.prod_map continuous_quot_mk },
+      { exact (surjective_quot_mk _).prod_map (surjective_quot_mk _) } },
+    exact (quotient_map.continuous_iff quot).2 cont,
+  end,
+  continuous_inv := by convert (@continuous_inv G _ _ _).quotient_map' _ }
+
+/-- Neighborhoods in the quotient are precisely the map of neighborhoods in the prequotient. -/
+@[to_additive "Neighborhoods in the quotient are precisely the map of neighborhoods in
+the prequotient."]
+lemma quotient_group.nhds_eq (x : G) : 𝓝 (x : G ⧸ N) = map coe (𝓝 x) :=
+le_antisymm ((quotient_group.is_open_map_coe N).nhds_le x) continuous_quot_mk.continuous_at
+
+variables (G) [first_countable_topology G]
+
+/-- Any first countable topological group has an antitone neighborhood basis `u : ℕ → set G` for
+which `(u (n + 1)) ^ 2 ⊆ u n`. The existence of such a neighborhood basis is a key tool for
+`quotient_group.complete_space` -/
+@[to_additive "Any first countable topological additive group has an antitone neighborhood basis
+`u : ℕ → set G` for which `u (n + 1) + u (n + 1) ⊆ u n`. The existence of such a neighborhood basis
+is a key tool for `quotient_add_group.complete_space`"]
+lemma topological_group.exists_antitone_basis_nhds_one :
+  ∃ (u : ℕ → set G), (𝓝 1).has_antitone_basis u ∧ (∀ n, u (n + 1) * u (n + 1) ⊆ u n) :=
+begin
+  rcases (𝓝 (1 : G)).exists_antitone_basis with ⟨u, hu, u_anti⟩,
+  have := ((hu.prod_nhds hu).tendsto_iff hu).mp
+    (by simpa only [mul_one] using continuous_mul.tendsto ((1, 1) : G × G)),
+  simp only [and_self, mem_prod, and_imp, prod.forall, exists_true_left, prod.exists,
+    forall_true_left] at this,
+  have event_mul : ∀ n : ℕ, ∀ᶠ m in at_top, u m * u m ⊆ u n,
+  { intros n,
+    rcases this n with ⟨j, k, h⟩,
+    refine at_top_basis.eventually_iff.mpr ⟨max j k, true.intro, λ m hm, _⟩,
+    rintro - ⟨a, b, ha, hb, rfl⟩,
+    exact h a b (u_anti ((le_max_left _ _).trans hm) ha) (u_anti ((le_max_right _ _).trans hm) hb)},
+  obtain ⟨φ, -, hφ, φ_anti_basis⟩ := has_antitone_basis.subbasis_with_rel ⟨hu, u_anti⟩ event_mul,
+  exact ⟨u ∘ φ, φ_anti_basis, λ n, hφ n.lt_succ_self⟩,
+end
+
+include n
+
+/-- In a first countable topological group `G` with normal subgroup `N`, `1 : G ⧸ N` has a
+countable neighborhood basis. -/
+@[to_additive "In a first countable topological additive group `G` with normal additive subgroup
+`N`, `0 : G ⧸ N` has a countable neighborhood basis."]
+instance quotient_group.nhds_one_is_countably_generated : (𝓝 (1 : G ⧸ N)).is_countably_generated :=
+(quotient_group.nhds_eq N 1).symm ▸ map.is_countably_generated _ _
+
+end quotient_topological_group
+
+/-- A typeclass saying that `λ p : G × G, p.1 - p.2` is a continuous function. This property
+automatically holds for topological additive groups but it also holds, e.g., for `ℝ≥0`. -/
+class has_continuous_sub (G : Type*) [topological_space G] [has_sub G] : Prop :=
+(continuous_sub : continuous (λ p : G × G, p.1 - p.2))
+
+/-- A typeclass saying that `λ p : G × G, p.1 / p.2` is a continuous function. This property
+automatically holds for topological groups. Lemmas using this class have primes.
+The unprimed version is for `group_with_zero`. -/
+@[to_additive]
+class has_continuous_div (G : Type*) [topological_space G] [has_div G] : Prop :=
+(continuous_div' : continuous (λ p : G × G, p.1 / p.2))
+
+@[priority 100, to_additive] -- see Note [lower instance priority]
+instance topological_group.to_has_continuous_div [topological_space G] [group G]
+  [topological_group G] : has_continuous_div G :=
+⟨by { simp only [div_eq_mul_inv], exact continuous_fst.mul continuous_snd.inv }⟩
+
+export has_continuous_sub (continuous_sub)
+export has_continuous_div (continuous_div')
+
+section has_continuous_div
+
+variables [topological_space G] [has_div G] [has_continuous_div G]
+
+@[to_additive sub]
+lemma filter.tendsto.div' {f g : α → G} {l : filter α} {a b : G} (hf : tendsto f l (𝓝 a))
+  (hg : tendsto g l (𝓝 b)) : tendsto (λ x, f x / g x) l (𝓝 (a / b)) :=
+(continuous_div'.tendsto (a, b)).comp (hf.prod_mk_nhds hg)
+
+@[to_additive const_sub]
+lemma filter.tendsto.const_div' (b : G) {c : G} {f : α → G} {l : filter α}
+  (h : tendsto f l (𝓝 c)) : tendsto (λ k : α, b / f k) l (𝓝 (b / c)) :=
+tendsto_const_nhds.div' h
+
+@[to_additive sub_const]
+lemma filter.tendsto.div_const' {c : G} {f : α → G} {l : filter α}
+  (h : tendsto f l (𝓝 c)) (b : G) : tendsto (λ k : α, f k / b) l (𝓝 (c / b)) :=
+h.div' tendsto_const_nhds
+
+variables [topological_space α] {f g : α → G} {s : set α} {x : α}
+
+@[continuity, to_additive sub] lemma continuous.div' (hf : continuous f) (hg : continuous g) :
+  continuous (λ x, f x / g x) :=
+continuous_div'.comp (hf.prod_mk hg : _)
+
+@[to_additive continuous_sub_left]
+lemma continuous_div_left' (a : G) : continuous (λ b : G, a / b) :=
+continuous_const.div' continuous_id
+
+@[to_additive continuous_sub_right]
+lemma continuous_div_right' (a : G) : continuous (λ b : G, b / a) :=
+continuous_id.div' continuous_const
+
+@[to_additive sub]
+lemma continuous_at.div' {f g : α → G} {x : α} (hf : continuous_at f x) (hg : continuous_at g x) :
+  continuous_at (λx, f x / g x) x :=
+hf.div' hg
+
+@[to_additive sub]
+lemma continuous_within_at.div' (hf : continuous_within_at f s x)
+  (hg : continuous_within_at g s x) :
+  continuous_within_at (λ x, f x / g x) s x :=
+hf.div' hg
+
+@[to_additive sub]
+lemma continuous_on.div' (hf : continuous_on f s) (hg : continuous_on g s) :
+  continuous_on (λx, f x / g x) s :=
+λ x hx, (hf x hx).div' (hg x hx)
+
+end has_continuous_div
+
+section div_in_topological_group
+variables [group G] [topological_space G] [topological_group G]
+
+/-- A version of `homeomorph.mul_left a b⁻¹` that is defeq to `a / b`. -/
+@[to_additive /-" A version of `homeomorph.add_left a (-b)` that is defeq to `a - b`. "-/,
+  simps {simp_rhs := tt}]
+def homeomorph.div_left (x : G) : G ≃ₜ G :=
+{ continuous_to_fun := continuous_const.div' continuous_id,
+  continuous_inv_fun := continuous_inv.mul continuous_const,
+  .. equiv.div_left x }
+
+@[to_additive] lemma is_open_map_div_left (a : G) : is_open_map ((/) a) :=
+(homeomorph.div_left _).is_open_map
+
+@[to_additive] lemma is_closed_map_div_left (a : G) : is_closed_map ((/) a) :=
+(homeomorph.div_left _).is_closed_map
+
+/-- A version of `homeomorph.mul_right a⁻¹ b` that is defeq to `b / a`. -/
+@[to_additive /-" A version of `homeomorph.add_right (-a) b` that is defeq to `b - a`. "-/,
+  simps {simp_rhs := tt}]
+def homeomorph.div_right (x : G) : G ≃ₜ G :=
+{ continuous_to_fun := continuous_id.div' continuous_const,
+  continuous_inv_fun := continuous_id.mul continuous_const,
+  .. equiv.div_right x }
+
+@[to_additive]
+lemma is_open_map_div_right (a : G) : is_open_map (λ x, x / a) :=
+(homeomorph.div_right a).is_open_map
+
+@[to_additive]
+lemma is_closed_map_div_right (a : G) : is_closed_map (λ x, x / a) :=
+(homeomorph.div_right a).is_closed_map
+
+@[to_additive]
+lemma tendsto_div_nhds_one_iff
+  {α : Type*} {l : filter α} {x : G} {u : α → G} :
+  tendsto (λ n, u n / x) l (𝓝 1) ↔ tendsto u l (𝓝 x) :=
+begin
+  have A : tendsto (λ (n : α), x) l (𝓝 x) := tendsto_const_nhds,
+  exact ⟨λ h, by simpa using h.mul A, λ h, by simpa using h.div' A⟩
+end
+
+@[to_additive] lemma nhds_translation_div (x : G) : comap (/ x) (𝓝 1) = 𝓝 x :=
+by simpa only [div_eq_mul_inv] using nhds_translation_mul_inv x
+
+end div_in_topological_group
+
+/-!
+### Topological operations on pointwise sums and products
+
+A few results about interior and closure of the pointwise addition/multiplication of sets in groups
+with continuous addition/multiplication. See also `submonoid.top_closure_mul_self_eq` in
+`topology.algebra.monoid`.
+-/
+
+section has_continuous_const_smul
+variables [topological_space β] [group α] [mul_action α β]
+  [has_continuous_const_smul α β] {s : set α} {t : set β}
+
+@[to_additive] lemma is_open.smul_left (ht : is_open t) : is_open (s • t) :=
+by { rw ←bUnion_smul_set, exact is_open_bUnion (λ a _, ht.smul _) }
+
+@[to_additive] lemma subset_interior_smul_right : s • interior t ⊆ interior (s • t) :=
+interior_maximal (set.smul_subset_smul_left interior_subset) is_open_interior.smul_left
+
+@[to_additive] lemma smul_mem_nhds (a : α) {x : β} (ht : t ∈ 𝓝 x) :
+  a • t ∈ 𝓝 (a • x) :=
+begin
+  rcases mem_nhds_iff.1 ht with ⟨u, ut, u_open, hu⟩,
+  exact mem_nhds_iff.2 ⟨a • u, smul_set_mono ut, u_open.smul a, smul_mem_smul_set hu⟩,
+end
+
+variables [topological_space α]
+
+@[to_additive] lemma subset_interior_smul : interior s • interior t ⊆ interior (s • t) :=
+(set.smul_subset_smul_right interior_subset).trans subset_interior_smul_right
+
+end has_continuous_const_smul
+
+section has_continuous_const_smul
+variables [topological_space α] [group α] [has_continuous_const_smul α α] {s t : set α}
+
+@[to_additive] lemma is_open.mul_left : is_open t → is_open (s * t) := is_open.smul_left
+
+@[to_additive] lemma subset_interior_mul_right : s * interior t ⊆ interior (s * t) :=
+subset_interior_smul_right
+
+@[to_additive] lemma subset_interior_mul : interior s * interior t ⊆ interior (s * t) :=
+subset_interior_smul
+
+@[to_additive] lemma singleton_mul_mem_nhds (a : α) {b : α} (h : s ∈ 𝓝 b) :
+  {a} * s ∈ 𝓝 (a * b) :=
+by { have := smul_mem_nhds a h, rwa ← singleton_smul at this }
+
+@[to_additive] lemma singleton_mul_mem_nhds_of_nhds_one (a : α) (h : s ∈ 𝓝 (1 : α)) :
+  {a} * s ∈ 𝓝 a :=
+by simpa only [mul_one] using singleton_mul_mem_nhds a h
+
+end has_continuous_const_smul
+
+section has_continuous_const_smul_op
+variables [topological_space α] [group α] [has_continuous_const_smul αᵐᵒᵖ α] {s t : set α}
+
+@[to_additive] lemma is_open.mul_right (hs : is_open s) : is_open (s * t) :=
+by { rw ←bUnion_op_smul_set, exact is_open_bUnion (λ a _, hs.smul _) }
+
+@[to_additive] lemma subset_interior_mul_left : interior s * t ⊆ interior (s * t) :=
+interior_maximal (set.mul_subset_mul_right interior_subset) is_open_interior.mul_right
+
+@[to_additive] lemma subset_interior_mul' : interior s * interior t ⊆ interior (s * t) :=
+(set.mul_subset_mul_left interior_subset).trans subset_interior_mul_left
+
+@[to_additive] lemma mul_singleton_mem_nhds (a : α) {b : α} (h : s ∈ 𝓝 b) :
+  s * {a} ∈ 𝓝 (b * a) :=
+begin
+  simp only [←bUnion_op_smul_set, mem_singleton_iff, Union_Union_eq_left],
+  exact smul_mem_nhds _ h,
+end
+
+@[to_additive] lemma mul_singleton_mem_nhds_of_nhds_one (a : α) (h : s ∈ 𝓝 (1 : α)) :
+  s * {a} ∈ 𝓝 a :=
+by simpa only [one_mul] using mul_singleton_mem_nhds a h
+
+end has_continuous_const_smul_op
+
+section topological_group
+variables [topological_space α] [group α] [topological_group α] {s t : set α}
+
+@[to_additive] lemma is_open.div_left (ht : is_open t) : is_open (s / t) :=
+by { rw ←Union_div_left_image, exact is_open_bUnion (λ a ha, is_open_map_div_left a t ht) }
+
+@[to_additive] lemma is_open.div_right (hs : is_open s) : is_open (s / t) :=
+by { rw ←Union_div_right_image, exact is_open_bUnion (λ a ha, is_open_map_div_right a s hs) }
+
+@[to_additive] lemma subset_interior_div_left : interior s / t ⊆ interior (s / t) :=
+interior_maximal (div_subset_div_right interior_subset) is_open_interior.div_right
+
+@[to_additive] lemma subset_interior_div_right : s / interior t ⊆ interior (s / t) :=
+interior_maximal (div_subset_div_left interior_subset) is_open_interior.div_left
+
+@[to_additive] lemma subset_interior_div : interior s / interior t ⊆ interior (s / t) :=
+(div_subset_div_left interior_subset).trans subset_interior_div_left
+
+@[to_additive] lemma is_open.mul_closure (hs : is_open s) (t : set α) : s * closure t = s * t :=
+begin
+  refine (mul_subset_iff.2 $ λ a ha b hb, _).antisymm (mul_subset_mul_left subset_closure),
+  rw mem_closure_iff at hb,
+  have hbU : b ∈ s⁻¹ * {a * b} := ⟨a⁻¹, a * b, set.inv_mem_inv.2 ha, rfl, inv_mul_cancel_left _ _⟩,
+  obtain ⟨_, ⟨c, d, hc, (rfl : d = _), rfl⟩, hcs⟩ := hb _ hs.inv.mul_right hbU,
+  exact ⟨c⁻¹, _, hc, hcs, inv_mul_cancel_left _ _⟩,
+end
+
+@[to_additive] lemma is_open.closure_mul (ht : is_open t) (s : set α) : closure s * t = s * t :=
+by rw [←inv_inv (closure s * t), mul_inv_rev, inv_closure, ht.inv.mul_closure, mul_inv_rev, inv_inv,
+  inv_inv]
+
+@[to_additive] lemma is_open.div_closure (hs : is_open s) (t : set α) : s / closure t = s / t :=
+by simp_rw [div_eq_mul_inv, inv_closure, hs.mul_closure]
+
+@[to_additive] lemma is_open.closure_div (ht : is_open t) (s : set α) : closure s / t = s / t :=
+by simp_rw [div_eq_mul_inv, ht.inv.closure_mul]
+
+end topological_group
+
+/-- additive group with a neighbourhood around 0.
+Only used to construct a topology and uniform space.
+
+This is currently only available for commutative groups, but it can be extended to
+non-commutative groups too.
+-/
+class add_group_with_zero_nhd (G : Type u) extends add_comm_group G :=
+(Z [] : filter G)
+(zero_Z : pure 0 ≤ Z)
+(sub_Z : tendsto (λp:G×G, p.1 - p.2) (Z ×ᶠ Z) Z)
+
+section filter_mul
+
+section
+variables (G) [topological_space G] [group G] [has_continuous_mul G]
+
+@[to_additive]
+lemma topological_group.t1_space (h : @is_closed G _ {1}) : t1_space G :=
+⟨assume x, by { convert is_closed_map_mul_right x _ h, simp }⟩
+
+end
+
+section
+variables (G) [topological_space G] [group G] [topological_group G]
+
+@[priority 100, to_additive]
+instance topological_group.regular_space : regular_space G :=
+begin
+  refine regular_space.of_exists_mem_nhds_is_closed_subset (λ a s hs, _),
+  have : tendsto (λ p : G × G, p.1 * p.2) (𝓝 (a, 1)) (𝓝 a),
+    from continuous_mul.tendsto' _ _ (mul_one a),
+  rcases mem_nhds_prod_iff.mp (this hs) with ⟨U, hU, V, hV, hUV⟩,
+  rw [← image_subset_iff, image_prod] at hUV,
+  refine ⟨closure U, mem_of_superset hU subset_closure, is_closed_closure, _⟩,
+  calc closure U ⊆ closure U * interior V : subset_mul_left _ (mem_interior_iff_mem_nhds.2 hV)
+             ... = U * interior V         : is_open_interior.closure_mul U
+             ... ⊆ U * V                  : mul_subset_mul_left interior_subset
+             ... ⊆ s                      : hUV
+end
+
+@[to_additive]
+lemma topological_group.t3_space [t0_space G] : t3_space G := ⟨⟩
+
+@[to_additive]
+lemma topological_group.t2_space [t0_space G] : t2_space G :=
+by { haveI := topological_group.t3_space G, apply_instance }
+
+variables {G} (S : subgroup G) [subgroup.normal S] [is_closed (S : set G)]
+
+@[to_additive]
+instance subgroup.t3_quotient_of_is_closed
+  (S : subgroup G) [subgroup.normal S] [hS : is_closed (S : set G)] : t3_space (G ⧸ S) :=
+begin
+  rw ← quotient_group.ker_mk S at hS,
+  haveI := topological_group.t1_space (G ⧸ S) (quotient_map_quotient_mk.is_closed_preimage.mp hS),
+  exact topological_group.t3_space _,
+end
+
+/-- A subgroup `S` of a topological group `G` acts on `G` properly discontinuously on the left, if
+it is discrete in the sense that `S ∩ K` is finite for all compact `K`. (See also
+`discrete_topology`.) -/
+@[to_additive "A subgroup `S` of an additive topological group `G` acts on `G` properly
+discontinuously on the left, if it is discrete in the sense that `S ∩ K` is finite for all compact
+`K`. (See also `discrete_topology`."]
+lemma subgroup.properly_discontinuous_smul_of_tendsto_cofinite
+  (S : subgroup G) (hS : tendsto S.subtype cofinite (cocompact G)) :
+  properly_discontinuous_smul S G :=
+{ finite_disjoint_inter_image := begin
+    intros K L hK hL,
+    have H : set.finite _ := hS ((hL.prod hK).image continuous_div').compl_mem_cocompact,
+    rw [preimage_compl, compl_compl] at H,
+    convert H,
+    ext x,
+    simpa only [image_smul, mem_image, prod.exists] using set.smul_inter_ne_empty_iff',
+  end }
+
+local attribute [semireducible] mul_opposite
+
+/-- A subgroup `S` of a topological group `G` acts on `G` properly discontinuously on the right, if
+it is discrete in the sense that `S ∩ K` is finite for all compact `K`. (See also
+`discrete_topology`.)
+
+If `G` is Hausdorff, this can be combined with `t2_space_of_properly_discontinuous_smul_of_t2_space`
+to show that the quotient group `G ⧸ S` is Hausdorff. -/
+@[to_additive "A subgroup `S` of an additive topological group `G` acts on `G` properly
+discontinuously on the right, if it is discrete in the sense that `S ∩ K` is finite for all compact
+`K`. (See also `discrete_topology`.)
+
+If `G` is Hausdorff, this can be combined with `t2_space_of_properly_discontinuous_vadd_of_t2_space`
+to show that the quotient group `G ⧸ S` is Hausdorff."]
+lemma subgroup.properly_discontinuous_smul_opposite_of_tendsto_cofinite
+  (S : subgroup G) (hS : tendsto S.subtype cofinite (cocompact G)) :
+  properly_discontinuous_smul S.opposite G :=
+{ finite_disjoint_inter_image := begin
+    intros K L hK hL,
+    have : continuous (λ p : G × G, (p.1⁻¹, p.2)) := continuous_inv.prod_map continuous_id,
+    have H : set.finite _ :=
+      hS ((hK.prod hL).image (continuous_mul.comp this)).compl_mem_cocompact,
+    rw [preimage_compl, compl_compl] at H,
+    convert H,
+    ext x,
+    simpa only [image_smul, mem_image, prod.exists] using set.op_smul_inter_ne_empty_iff,
+  end }
+
+end
+
+section
+
+/-! Some results about an open set containing the product of two sets in a topological group. -/
+
+variables [topological_space G] [mul_one_class G] [has_continuous_mul G]
+
+/-- Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of `1`
+  such that `K * V ⊆ U`. -/
+@[to_additive "Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of
+`0` such that `K + V ⊆ U`."]
+lemma compact_open_separated_mul_right {K U : set G} (hK : is_compact K) (hU : is_open U)
+  (hKU : K ⊆ U) : ∃ V ∈ 𝓝 (1 : G), K * V ⊆ U :=
+begin
+  apply hK.induction_on,
+  { exact ⟨univ, by simp⟩ },
+  { rintros s t hst ⟨V, hV, hV'⟩,
+    exact ⟨V, hV, (mul_subset_mul_right hst).trans hV'⟩ },
+  { rintros s t  ⟨V, V_in, hV'⟩ ⟨W, W_in, hW'⟩,
+    use [V ∩ W, inter_mem V_in W_in],
+    rw union_mul,
+    exact union_subset ((mul_subset_mul_left (V.inter_subset_left W)).trans hV')
+                       ((mul_subset_mul_left (V.inter_subset_right W)).trans hW') },
+  { intros x hx,
+    have := tendsto_mul (show U ∈ 𝓝 (x * 1), by simpa using hU.mem_nhds (hKU hx)),
+    rw [nhds_prod_eq, mem_map, mem_prod_iff] at this,
+    rcases this with ⟨t, ht, s, hs, h⟩,
+    rw [← image_subset_iff, image_mul_prod] at h,
+    exact ⟨t, mem_nhds_within_of_mem_nhds ht, s, hs, h⟩ }
+end
+
+open mul_opposite
+
+/-- Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of `1`
+  such that `V * K ⊆ U`. -/
+@[to_additive "Given a compact set `K` inside an open set `U`, there is a open neighborhood `V` of
+`0` such that `V + K ⊆ U`."]
+lemma compact_open_separated_mul_left {K U : set G} (hK : is_compact K) (hU : is_open U)
+  (hKU : K ⊆ U) : ∃ V ∈ 𝓝 (1 : G), V * K ⊆ U :=
+begin
+  rcases compact_open_separated_mul_right (hK.image continuous_op) (op_homeomorph.is_open_map U hU)
+    (image_subset op hKU) with ⟨V, (hV : V ∈ 𝓝 (op (1 : G))), hV' : op '' K * V ⊆ op '' U⟩,
+  refine ⟨op ⁻¹' V, continuous_op.continuous_at hV, _⟩,
+  rwa [← image_preimage_eq V op_surjective, ← image_op_mul, image_subset_iff,
+    preimage_image_eq _ op_injective] at hV'
+end
+
+end
+
+section
+variables [topological_space G] [group G] [topological_group G]
+
+/-- A compact set is covered by finitely many left multiplicative translates of a set
+  with non-empty interior. -/
+@[to_additive "A compact set is covered by finitely many left additive translates of a set
+  with non-empty interior."]
+lemma compact_covered_by_mul_left_translates {K V : set G} (hK : is_compact K)
+  (hV : (interior V).nonempty) : ∃ t : finset G, K ⊆ ⋃ g ∈ t, (λ h, g * h) ⁻¹' V :=
+begin
+  obtain ⟨t, ht⟩ : ∃ t : finset G, K ⊆ ⋃ x ∈ t, interior (((*) x) ⁻¹' V),
+  { refine hK.elim_finite_subcover (λ x, interior $ ((*) x) ⁻¹' V) (λ x, is_open_interior) _,
+    cases hV with g₀ hg₀,
+    refine λ g hg, mem_Union.2 ⟨g₀ * g⁻¹, _⟩,
+    refine preimage_interior_subset_interior_preimage (continuous_const.mul continuous_id) _,
+    rwa [mem_preimage, inv_mul_cancel_right] },
+  exact ⟨t, subset.trans ht $ Union₂_mono $ λ g hg, interior_subset⟩
+end
+
+/-- Every locally compact separable topological group is σ-compact.
+  Note: this is not true if we drop the topological group hypothesis. -/
+@[priority 100, to_additive separable_locally_compact_add_group.sigma_compact_space "Every locally
+compact separable topological group is σ-compact.
+Note: this is not true if we drop the topological group hypothesis."]
+instance separable_locally_compact_group.sigma_compact_space
+  [separable_space G] [locally_compact_space G] : sigma_compact_space G :=
+begin
+  obtain ⟨L, hLc, hL1⟩ := exists_compact_mem_nhds (1 : G),
+  refine ⟨⟨λ n, (λ x, x * dense_seq G n) ⁻¹' L, _, _⟩⟩,
+  { intro n, exact (homeomorph.mul_right _).is_compact_preimage.mpr hLc },
+  { refine Union_eq_univ_iff.2 (λ x, _),
+    obtain ⟨_, ⟨n, rfl⟩, hn⟩ : (range (dense_seq G) ∩ (λ y, x * y) ⁻¹' L).nonempty,
+    { rw [← (homeomorph.mul_left x).apply_symm_apply 1] at hL1,
+      exact (dense_range_dense_seq G).inter_nhds_nonempty
+        ((homeomorph.mul_left x).continuous.continuous_at $ hL1) },
+    exact ⟨n, hn⟩ }
+end
+
+/-- Given two compact sets in a noncompact topological group, there is a translate of the second
+one that is disjoint from the first one. -/
+@[to_additive "Given two compact sets in a noncompact additive topological group, there is a
+translate of the second one that is disjoint from the first one."]
+lemma exists_disjoint_smul_of_is_compact [noncompact_space G] {K L : set G}
+  (hK : is_compact K) (hL : is_compact L) : ∃ (g : G), disjoint K (g • L) :=
+begin
+  have A : ¬ (K * L⁻¹ = univ), from (hK.mul hL.inv).ne_univ,
+  obtain ⟨g, hg⟩ : ∃ g, g ∉ K * L⁻¹,
+  { contrapose! A, exact eq_univ_iff_forall.2 A },
+  refine ⟨g, _⟩,
+  apply disjoint_left.2 (λ a ha h'a, hg _),
+  rcases h'a with ⟨b, bL, rfl⟩,
+  refine ⟨g * b, b⁻¹, ha, by simpa only [set.mem_inv, inv_inv] using bL, _⟩,
+  simp only [smul_eq_mul, mul_inv_cancel_right]
+end
+
+/-- In a locally compact group, any neighborhood of the identity contains a compact closed
+neighborhood of the identity, even without separation assumptions on the space. -/
+@[to_additive "In a locally compact additive group, any neighborhood of the identity contains a
+compact closed neighborhood of the identity, even without separation assumptions on the space."]
+lemma local_is_compact_is_closed_nhds_of_group [locally_compact_space G]
+  {U : set G} (hU : U ∈ 𝓝 (1 : G)) :
+  ∃ (K : set G), is_compact K ∧ is_closed K ∧ K ⊆ U ∧ (1 : G) ∈ interior K :=
+begin
+  obtain ⟨L, Lint, LU, Lcomp⟩ : ∃ (L : set G) (H : L ∈ 𝓝 (1 : G)), L ⊆ U ∧ is_compact L,
+    from local_compact_nhds hU,
+  obtain ⟨V, Vnhds, hV⟩ : ∃ V ∈ 𝓝 (1 : G), ∀ (v ∈ V) (w ∈ V), v * w ∈ L,
+  { have : ((λ p : G × G, p.1 * p.2) ⁻¹' L) ∈ 𝓝 ((1, 1) : G × G),
+    { refine continuous_at_fst.mul continuous_at_snd _,
+      simpa only [mul_one] using Lint },
+    simpa only [div_eq_mul_inv, nhds_prod_eq, mem_prod_self_iff, prod_subset_iff, mem_preimage] },
+  have VL : closure V ⊆ L, from calc
+    closure V = {(1 : G)} * closure V : by simp only [singleton_mul, one_mul, image_id']
+    ... ⊆ interior V * closure V : mul_subset_mul_right
+      (by simpa only [singleton_subset_iff] using mem_interior_iff_mem_nhds.2 Vnhds)
+    ... = interior V * V : is_open_interior.mul_closure _
+    ... ⊆ V * V : mul_subset_mul_right interior_subset
+    ... ⊆ L : by { rintros x ⟨y, z, yv, zv, rfl⟩, exact hV _ yv _ zv },
+  exact ⟨closure V, is_compact_of_is_closed_subset Lcomp is_closed_closure VL, is_closed_closure,
+    VL.trans LU, interior_mono subset_closure (mem_interior_iff_mem_nhds.2 Vnhds)⟩,
+end
+
+end
+
+section
+variables [topological_space G] [group G] [topological_group G]
+
+@[to_additive] lemma nhds_mul (x y : G) : 𝓝 (x * y) = 𝓝 x * 𝓝 y :=
+calc 𝓝 (x * y) = map ((*) x) (map (λ a, a * y) (𝓝 1 * 𝓝 1)) : by simp
+... = map₂ (λ a b, x * (a * b * y)) (𝓝 1) (𝓝 1) : by rw [← map₂_mul, map_map₂, map_map₂]
+... = map₂ (λ a b, x * a * (b * y)) (𝓝 1) (𝓝 1) : by simp only [mul_assoc]
+... = 𝓝 x * 𝓝 y : by rw [← map_mul_left_nhds_one x, ← map_mul_right_nhds_one y, ← map₂_mul,
+  map₂_map_left, map₂_map_right]
+
+/-- On a topological group, `𝓝 : G → filter G` can be promoted to a `mul_hom`. -/
+@[to_additive "On an additive topological group, `𝓝 : G → filter G` can be promoted to an
+`add_hom`.", simps]
+def nhds_mul_hom : G →ₙ* (filter G) :=
+{ to_fun := 𝓝,
+  map_mul' := λ_ _, nhds_mul _ _ }
+
+end
+
+end filter_mul
+
+instance {G} [topological_space G] [group G] [topological_group G] :
+  topological_add_group (additive G) :=
+{ continuous_neg := @continuous_inv G _ _ _ }
+
+instance {G} [topological_space G] [add_group G] [topological_add_group G] :
+  topological_group (multiplicative G) :=
+{ continuous_inv := @continuous_neg G _ _ _ }
+
+section quotient
+variables [group G] [topological_space G] [has_continuous_mul G] {Γ : subgroup G}
+
+@[to_additive]
+instance quotient_group.has_continuous_const_smul : has_continuous_const_smul G (G ⧸ Γ) :=
+{ continuous_const_smul := λ g,
+    by convert ((@continuous_const _ _ _ _ g).mul continuous_id).quotient_map' _ }
+
+@[to_additive]
+lemma quotient_group.continuous_smul₁ (x : G ⧸ Γ) : continuous (λ g : G, g • x) :=
+begin
+  induction x using quotient_group.induction_on,
+  exact continuous_quotient_mk.comp (continuous_mul_right x)
+end
+
+/-- The quotient of a second countable topological group by a subgroup is second countable. -/
+@[to_additive "The quotient of a second countable additive topological group by a subgroup is second
+countable."]
+instance quotient_group.second_countable_topology [second_countable_topology G] :
+  second_countable_topology (G ⧸ Γ) :=
+has_continuous_const_smul.second_countable_topology
+
+end quotient
+
+/-- If `G` is a group with topological `⁻¹`, then it is homeomorphic to its units. -/
+@[to_additive " If `G` is an additive group with topological negation, then it is homeomorphic to
+its additive units."]
+def to_units_homeomorph [group G] [topological_space G] [has_continuous_inv G] : G ≃ₜ Gˣ :=
+{ to_equiv := to_units.to_equiv,
+  continuous_to_fun := units.continuous_iff.2 ⟨continuous_id, continuous_inv⟩,
+  continuous_inv_fun := units.continuous_coe }
+
+namespace units
+
+open mul_opposite (continuous_op continuous_unop)
+
+variables [monoid α] [topological_space α] [monoid β] [topological_space β]
+
+@[to_additive] instance [has_continuous_mul α] : topological_group αˣ :=
+{ continuous_inv := units.continuous_iff.2 $ ⟨continuous_coe_inv, continuous_coe⟩ }
+
+/-- The topological group isomorphism between the units of a product of two monoids, and the product
+of the units of each monoid. -/
+@[to_additive "The topological group isomorphism between the additive units of a product of two
+additive monoids, and the product of the additive units of each additive monoid."]
+def homeomorph.prod_units : (α × β)ˣ ≃ₜ (αˣ × βˣ) :=
+{ continuous_to_fun  := (continuous_fst.units_map (monoid_hom.fst α β)).prod_mk
+    (continuous_snd.units_map (monoid_hom.snd α β)),
+  continuous_inv_fun := units.continuous_iff.2 ⟨continuous_coe.fst'.prod_mk continuous_coe.snd',
+    continuous_coe_inv.fst'.prod_mk continuous_coe_inv.snd'⟩,
+  to_equiv := mul_equiv.prod_units.to_equiv }
+
+end units
+
+section lattice_ops
+
+variables {ι : Sort*} [group G]
+
+@[to_additive] lemma topological_group_Inf {ts : set (topological_space G)}
+  (h : ∀ t ∈ ts, @topological_group G t _) :
+  @topological_group G (Inf ts) _ :=
+{ to_has_continuous_inv := @has_continuous_inv_Inf _ _ _ $
+    λ t ht, @topological_group.to_has_continuous_inv G t _ $ h t ht,
+  to_has_continuous_mul := @has_continuous_mul_Inf _ _ _ $
+    λ t ht, @topological_group.to_has_continuous_mul G t _ $ h t ht }
+
+@[to_additive] lemma topological_group_infi {ts' : ι → topological_space G}
+  (h' : ∀ i, @topological_group G (ts' i) _) :
+  @topological_group G (⨅ i, ts' i) _ :=
+by { rw ← Inf_range, exact topological_group_Inf (set.forall_range_iff.mpr h') }
+
+@[to_additive] lemma topological_group_inf {t₁ t₂ : topological_space G}
+  (h₁ : @topological_group G t₁ _) (h₂ : @topological_group G t₂ _) :
+  @topological_group G (t₁ ⊓ t₂) _ :=
+by { rw inf_eq_infi, refine topological_group_infi (λ b, _), cases b; assumption }
+
+end lattice_ops
+
+/-!
+### Lattice of group topologies
+
+We define a type class `group_topology α` which endows a group `α` with a topology such that all
+group operations are continuous.
+
+Group topologies on a fixed group `α` are ordered, by reverse inclusion. They form a complete
+lattice, with `⊥` the discrete topology and `⊤` the indiscrete topology.
+
+Any function `f : α → β` induces `coinduced f : topological_space α → group_topology β`.
+
+The additive version `add_group_topology α` and corresponding results are provided as well.
+-/
+
+/-- A group topology on a group `α` is a topology for which multiplication and inversion
+are continuous. -/
+structure group_topology (α : Type u) [group α]
+  extends topological_space α, topological_group α : Type u
+
+/-- An additive group topology on an additive group `α` is a topology for which addition and
+  negation are continuous. -/
+structure add_group_topology (α : Type u) [add_group α]
+  extends topological_space α, topological_add_group α : Type u
+
+attribute [to_additive] group_topology
+
+namespace group_topology
+
+variables [group α]
+
+/-- A version of the global `continuous_mul` suitable for dot notation. -/
+@[to_additive "A version of the global `continuous_add` suitable for dot notation."]
+lemma continuous_mul' (g : group_topology α) :
+  by haveI := g.to_topological_space; exact continuous (λ p : α × α, p.1 * p.2) :=
+begin
+  letI := g.to_topological_space,
+  haveI := g.to_topological_group,
+  exact continuous_mul,
+end
+
+/-- A version of the global `continuous_inv` suitable for dot notation. -/
+@[to_additive "A version of the global `continuous_neg` suitable for dot notation."]
+lemma continuous_inv' (g : group_topology α) :
+  by haveI := g.to_topological_space; exact continuous (has_inv.inv : α → α) :=
+begin
+  letI := g.to_topological_space,
+  haveI := g.to_topological_group,
+  exact continuous_inv,
+end
+
+@[to_additive]
+lemma to_topological_space_injective :
+  function.injective (to_topological_space : group_topology α → topological_space α):=
+λ f g h, by { cases f, cases g, congr' }
+
+@[ext, to_additive]
+lemma ext' {f g : group_topology α} (h : f.is_open = g.is_open) : f = g :=
+to_topological_space_injective $ topological_space_eq h
+
+/-- The ordering on group topologies on the group `γ`. `t ≤ s` if every set open in `s` is also open
+in `t` (`t` is finer than `s`). -/
+@[to_additive "The ordering on group topologies on the group `γ`. `t ≤ s` if every set open in `s`
+is also open in `t` (`t` is finer than `s`)."]
+instance : partial_order (group_topology α) :=
+partial_order.lift to_topological_space to_topological_space_injective
+
+@[simp, to_additive] lemma to_topological_space_le {x y : group_topology α} :
+  x.to_topological_space ≤ y.to_topological_space ↔ x ≤ y := iff.rfl
+
+@[to_additive]
+instance : has_top (group_topology α) :=
+⟨{to_topological_space := ⊤,
+  continuous_mul       := continuous_top,
+  continuous_inv       := continuous_top}⟩
+
+@[simp, to_additive] lemma to_topological_space_top :
+  (⊤ : group_topology α).to_topological_space = ⊤ := rfl
+
+@[to_additive]
+instance : has_bot (group_topology α) :=
+⟨{to_topological_space := ⊥,
+  continuous_mul       := by
+  { letI : topological_space α := ⊥, haveI := discrete_topology_bot α, continuity },
+  continuous_inv       := continuous_bot}⟩
+
+@[simp, to_additive] lemma to_topological_space_bot :
+  (⊥ : group_topology α).to_topological_space = ⊥ := rfl
+
+@[to_additive]
+instance : bounded_order (group_topology α) :=
+{ top := ⊤,
+  le_top := λ x, show x.to_topological_space ≤ ⊤, from le_top,
+  bot := ⊥,
+  bot_le := λ x, show ⊥ ≤ x.to_topological_space, from bot_le }
+
+@[to_additive]
+instance : has_inf (group_topology α) :=
+{ inf := λ x y, ⟨x.1 ⊓ y.1, topological_group_inf x.2 y.2⟩ }
+
+@[simp, to_additive]
+lemma to_topological_space_inf (x y : group_topology α) :
+  (x ⊓ y).to_topological_space = x.to_topological_space ⊓ y.to_topological_space := rfl
+
+@[to_additive]
+instance : semilattice_inf (group_topology α) :=
+to_topological_space_injective.semilattice_inf _ to_topological_space_inf
+
+@[to_additive]
+instance : inhabited (group_topology α) := ⟨⊤⟩
+
+local notation `cont` := @continuous _ _
+
+/-- Infimum of a collection of group topologies. -/
+@[to_additive "Infimum of a collection of additive group topologies"]
+instance : has_Inf (group_topology α) :=
+{ Inf := λ S,
+  ⟨Inf (to_topological_space '' S), topological_group_Inf $ ball_image_iff.2 $ λ t ht, t.2⟩ }
+
+@[simp, to_additive]
+lemma to_topological_space_Inf (s : set (group_topology α)) :
+  (Inf s).to_topological_space = Inf (to_topological_space '' s) := rfl
+
+@[simp, to_additive]
+lemma to_topological_space_infi {ι} (s : ι → group_topology α) :
+  (⨅ i, s i).to_topological_space = ⨅ i, (s i).to_topological_space :=
+congr_arg Inf (range_comp _ _).symm
+
+/-- Group topologies on `γ` form a complete lattice, with `⊥` the discrete topology and `⊤` the
+indiscrete topology.
+
+The infimum of a collection of group topologies is the topology generated by all their open sets
+(which is a group topology).
+
+The supremum of two group topologies `s` and `t` is the infimum of the family of all group
+topologies contained in the intersection of `s` and `t`. -/
+@[to_additive "Group topologies on `γ` form a complete lattice, with `⊥` the discrete topology and
+`⊤` the indiscrete topology.
+
+The infimum of a collection of group topologies is the topology generated by all their open sets
+(which is a group topology).
+
+The supremum of two group topologies `s` and `t` is the infimum of the family of all group
+topologies contained in the intersection of `s` and `t`."]
+instance : complete_semilattice_Inf (group_topology α) :=
+{ Inf_le := λ S a haS, to_topological_space_le.1 $ Inf_le ⟨a, haS, rfl⟩,
+  le_Inf :=
+  begin
+    intros S a hab,
+    apply topological_space.complete_lattice.le_Inf,
+    rintros _ ⟨b, hbS, rfl⟩,
+    exact hab b hbS,
+  end,
+  ..group_topology.has_Inf,
+  ..group_topology.partial_order }
+
+@[to_additive]
+instance : complete_lattice (group_topology α) :=
+{ inf := (⊓),
+  top := ⊤,
+  bot := ⊥,
+  ..group_topology.bounded_order,
+  ..group_topology.semilattice_inf,
+  ..complete_lattice_of_complete_semilattice_Inf _ }
+
+/--  Given `f : α → β` and a topology on `α`, the coinduced group topology on `β` is the finest
+topology such that `f` is continuous and `β` is a topological group. -/
+@[to_additive "Given `f : α → β` and a topology on `α`, the coinduced additive group topology on `β`
+is the finest topology such that `f` is continuous and `β` is a topological additive group."]
+def coinduced {α β : Type*} [t : topological_space α] [group β] (f : α → β) :
+  group_topology β :=
+Inf {b : group_topology β | (topological_space.coinduced f t) ≤ b.to_topological_space}
+
+@[to_additive]
+lemma coinduced_continuous {α β : Type*} [t : topological_space α] [group β]
+  (f : α → β) : cont t (coinduced f).to_topological_space f :=
+begin
+  rw [continuous_Inf_rng],
+  rintros _ ⟨t', ht', rfl⟩,
+  exact continuous_iff_coinduced_le.2 ht'
+end
+
+end group_topology
diff --git a/src/topology/algebra/group/compact.lean b/src/topology/algebra/group/compact.lean
new file mode 100644
index 0000000000000..2e99caa1361a7
--- /dev/null
+++ b/src/topology/algebra/group/compact.lean
@@ -0,0 +1,69 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
+-/
+import topology.algebra.group.basic
+import topology.compact_open
+import topology.sets.compacts
+
+/-!
+# Additional results on topological groups
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Two results on topological groups that have been separated out as they require more substantial
+imports developing either positive compacts or the compact open topology.
+
+-/
+
+open classical set filter topological_space function
+open_locale classical topology filter pointwise
+
+universes u v w x
+variables {α : Type u} {β : Type v} {G : Type w} {H : Type x}
+
+section
+
+/-! Some results about an open set containing the product of two sets in a topological group. -/
+
+variables [topological_space G] [group G] [topological_group G]
+
+/-- Every separated topological group in which there exists a compact set with nonempty interior
+is locally compact. -/
+@[to_additive "Every separated topological group in which there exists a compact set with nonempty
+interior is locally compact."]
+lemma topological_space.positive_compacts.locally_compact_space_of_group
+  [t2_space G] (K : positive_compacts G) :
+  locally_compact_space G :=
+begin
+  refine locally_compact_of_compact_nhds (λ x, _),
+  obtain ⟨y, hy⟩ := K.interior_nonempty,
+  let F := homeomorph.mul_left (x * y⁻¹),
+  refine ⟨F '' K, _, K.is_compact.image F.continuous⟩,
+  suffices : F.symm ⁻¹' K ∈ 𝓝 x, by { convert this, apply equiv.image_eq_preimage },
+  apply continuous_at.preimage_mem_nhds F.symm.continuous.continuous_at,
+  have : F.symm x = y, by simp [F, homeomorph.mul_left_symm],
+  rw this,
+  exact mem_interior_iff_mem_nhds.1 hy
+end
+
+end
+
+section quotient
+variables [group G] [topological_space G] [topological_group G] {Γ : subgroup G}
+
+@[to_additive]
+instance quotient_group.has_continuous_smul [locally_compact_space G] :
+  has_continuous_smul G (G ⧸ Γ) :=
+{ continuous_smul := begin
+    let F : G × G ⧸ Γ → G ⧸ Γ := λ p, p.1 • p.2,
+    change continuous F,
+    have H : continuous (F ∘ (λ p : G × G, (p.1, quotient_group.mk p.2))),
+    { change continuous (λ p : G × G, quotient_group.mk (p.1 * p.2)),
+      refine continuous_coinduced_rng.comp continuous_mul },
+    exact quotient_map.continuous_lift_prod_right quotient_map_quotient_mk H,
+  end }
+
+end quotient
diff --git a/src/topology/algebra/group_completion.lean b/src/topology/algebra/group_completion.lean
index 56870cdb48044..b3d1f4bf1b047 100644
--- a/src/topology/algebra/group_completion.lean
+++ b/src/topology/algebra/group_completion.lean
@@ -3,13 +3,16 @@ Copyright (c) 2018 Patrick Massot. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Johannes Hölzl
 -/
-import algebra.hom.group_instances
 import topology.algebra.uniform_group
+import topology.algebra.uniform_mul_action
 import topology.uniform_space.completion
 
 /-!
 # Completion of topological groups:
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files endows the completion of a topological abelian group with a group structure.
 More precisely the instance `uniform_space.completion.add_group` builds an abelian group structure
 on the completion of an abelian group endowed with a compatible uniform structure.
@@ -30,11 +33,11 @@ the main constructions deal with continuous group morphisms.
 
 noncomputable theory
 
-universes u v
+variables {M R α β : Type*}
 
 section group
 open uniform_space Cauchy filter set
-variables {α : Type u} [uniform_space α]
+variables [uniform_space α]
 
 instance [has_zero α] : has_zero (completion α) := ⟨(0 : α)⟩
 instance [has_neg α] : has_neg (completion α) := ⟨completion.map (λa, -a : α → α)⟩
@@ -46,9 +49,23 @@ lemma uniform_space.completion.coe_zero [has_zero α] : ((0 : α) : completion 
 end group
 
 namespace uniform_space.completion
+open uniform_space
+
+section has_zero
+
+instance [uniform_space α] [monoid_with_zero M] [has_zero α] [mul_action_with_zero M α]
+  [has_uniform_continuous_const_smul M α] :
+  mul_action_with_zero M (completion α) :=
+{ smul := (•),
+  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, mul_action_with_zero.smul_zero r],
+  zero_smul := ext' (continuous_const_smul _) continuous_const $ λ a,
+    by rw [← coe_smul, zero_smul, coe_zero],
+  .. completion.mul_action M α }
+
+end has_zero
+
 section uniform_add_group
-open uniform_space uniform_space.completion
-variables {α : Type*} [uniform_space α] [add_group α] [uniform_add_group α]
+variables [uniform_space α] [add_group α] [uniform_add_group α]
 
 @[norm_cast]
 lemma coe_neg (a : α) : ((- a : α) : completion α) = - a :=
@@ -80,13 +97,30 @@ instance : add_monoid (completion α) :=
           (continuous_snd.comp continuous_snd))))
     (assume a b c, show (a : completion α) + b + c = a + (b + c),
       by repeat { rw_mod_cast add_assoc }),
-  .. completion.has_zero, .. completion.has_neg, ..completion.has_add, .. completion.has_sub }
+  nsmul := (•),
+  nsmul_zero' := λ a, completion.induction_on a (is_closed_eq continuous_map continuous_const)
+    (λ a, by rw [←coe_smul, ←coe_zero, zero_smul]),
+  nsmul_succ' := λ n a, completion.induction_on a
+    (is_closed_eq continuous_map $ continuous_map₂ continuous_id continuous_map)
+    (λ a, by rw_mod_cast succ_nsmul ),
+  .. completion.has_zero, ..completion.has_add, }
 
 instance : sub_neg_monoid (completion α) :=
 { sub_eq_add_neg := λ a b, completion.induction_on₂ a b
     (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
       (continuous_map₂ continuous_fst (completion.continuous_map.comp continuous_snd)))
    (λ a b, by exact_mod_cast congr_arg coe (sub_eq_add_neg a b)),
+  zsmul := (•),
+  zsmul_zero' := λ a, completion.induction_on a (is_closed_eq continuous_map continuous_const)
+    (λ a, by { rw_mod_cast zero_smul, refl} ),
+  zsmul_succ' := λ n a, completion.induction_on a
+    (is_closed_eq continuous_map $ continuous_map₂ continuous_id continuous_map)
+    (λ a, by rw_mod_cast (show int.of_nat n.succ • a = a + int.of_nat n • a,
+                          from sub_neg_monoid.zsmul_succ' n a) ),
+  zsmul_neg' := λ n a, completion.induction_on a
+    (is_closed_eq continuous_map $ completion.continuous_map.comp continuous_map)
+    (λ a, by rw [←coe_smul, ←coe_smul, ←coe_neg, show -[1+ n] • a = -((n.succ : ℤ) • a),
+                                                 from sub_neg_monoid.zsmul_neg' n a]),
   .. completion.add_monoid, .. completion.has_neg, .. completion.has_sub }
 
 instance : add_group (completion α) :=
@@ -98,6 +132,16 @@ instance : add_group (completion α) :=
 instance : uniform_add_group (completion α) :=
 ⟨uniform_continuous_map₂ has_sub.sub⟩
 
+instance {M} [monoid M] [distrib_mul_action M α] [has_uniform_continuous_const_smul M α] :
+  distrib_mul_action M (completion α) :=
+{ smul := (•),
+  smul_add := λ r x y, induction_on₂ x y
+    (is_closed_eq ((continuous_fst.add continuous_snd).const_smul _)
+      ((continuous_fst.const_smul _).add (continuous_snd.const_smul _)))
+    (λ a b, by simp only [← coe_add, ← coe_smul, smul_add]),
+  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, smul_zero r],
+  .. completion.mul_action M α }
+
 /-- The map from a group to its completion as a group hom. -/
 @[simps] def to_compl : α →+ completion α :=
 { to_fun := coe,
@@ -107,23 +151,39 @@ instance : uniform_add_group (completion α) :=
 lemma continuous_to_compl : continuous (to_compl : α → completion α) :=
 continuous_coe α
 
-variables {β : Type v} [uniform_space β] [add_group β] [uniform_add_group β]
+variable (α)
 
-instance {α : Type u} [uniform_space α] [add_comm_group α] [uniform_add_group α] :
-  add_comm_group (completion α) :=
+lemma dense_inducing_to_compl : dense_inducing (to_compl : α → completion α) :=
+dense_inducing_coe
+
+variable {α}
+
+end uniform_add_group
+
+section uniform_add_comm_group
+variables [uniform_space α] [add_comm_group α] [uniform_add_group α]
+
+instance : add_comm_group (completion α) :=
 { add_comm  := assume a b, completion.induction_on₂ a b
     (is_closed_eq (continuous_map₂ continuous_fst continuous_snd)
       (continuous_map₂ continuous_snd continuous_fst))
     (assume x y, by { change ↑x + ↑y = ↑y + ↑x, rw [← coe_add, ← coe_add, add_comm]}),
   .. completion.add_group }
 
-end uniform_add_group
+instance [semiring R] [module R α] [has_uniform_continuous_const_smul R α] :
+  module R (completion α) :=
+{ smul := (•),
+  add_smul := λ a b, ext' (continuous_const_smul _)
+    ((continuous_const_smul _).add (continuous_const_smul _)) $ λ x, by { norm_cast, rw add_smul },
+  .. completion.distrib_mul_action, .. completion.mul_action_with_zero }
+
+end uniform_add_comm_group
 
 end uniform_space.completion
 
 section add_monoid_hom
-variables {α β : Type*} [uniform_space α] [add_group α] [uniform_add_group α]
-                        [uniform_space β] [add_group β] [uniform_add_group β]
+variables [uniform_space α] [add_group α] [uniform_add_group α]
+          [uniform_space β] [add_group β] [uniform_add_group β]
 
 open uniform_space uniform_space.completion
 
diff --git a/src/topology/algebra/group_with_zero.lean b/src/topology/algebra/group_with_zero.lean
index b8f1d99104595..02e40080d1cb3 100644
--- a/src/topology/algebra/group_with_zero.lean
+++ b/src/topology/algebra/group_with_zero.lean
@@ -10,6 +10,9 @@ import topology.homeomorph
 /-!
 # Topological group with zero
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `has_continuous_inv₀` to be a mixin typeclass a type with `has_inv` and
 `has_zero` (e.g., a `group_with_zero`) such that `λ x, x⁻¹` is continuous at all nonzero points. Any
 normed (semi)field has this property. Currently the only example of `has_continuous_inv₀` in
@@ -29,7 +32,7 @@ On a `group_with_zero` with continuous multiplication, we also define left and r
 as homeomorphisms.
 -/
 
-open_locale topological_space filter
+open_locale topology filter
 open filter function
 
 /-!
@@ -48,24 +51,24 @@ section div_const
 variables [group_with_zero G₀] [topological_space G₀] [has_continuous_mul G₀]
   {f : α → G₀} {s : set α} {l : filter α}
 
-lemma filter.tendsto.div_const {x y : G₀} (hf : tendsto f l (𝓝 x)) :
+lemma filter.tendsto.div_const {x : G₀} (hf : tendsto f l (𝓝 x)) (y : G₀) :
   tendsto (λa, f a / y) l (𝓝 (x / y)) :=
 by simpa only [div_eq_mul_inv] using hf.mul tendsto_const_nhds
 
 variables [topological_space α]
 
-lemma continuous_at.div_const {a : α} (hf : continuous_at f a) {y : G₀} :
+lemma continuous_at.div_const {a : α} (hf : continuous_at f a) (y : G₀) :
   continuous_at (λ x, f x / y) a :=
 by simpa only [div_eq_mul_inv] using hf.mul continuous_at_const
 
-lemma continuous_within_at.div_const {a} (hf : continuous_within_at f s a) {y : G₀} :
+lemma continuous_within_at.div_const {a} (hf : continuous_within_at f s a) (y : G₀) :
   continuous_within_at (λ x, f x / y) s a :=
-hf.div_const
+hf.div_const _
 
-lemma continuous_on.div_const (hf : continuous_on f s) {y : G₀} : continuous_on (λ x, f x / y) s :=
+lemma continuous_on.div_const (hf : continuous_on f s) (y : G₀) : continuous_on (λ x, f x / y) s :=
 by simpa only [div_eq_mul_inv] using hf.mul continuous_on_const
 
-@[continuity] lemma continuous.div_const (hf : continuous f) {y : G₀} :
+@[continuity] lemma continuous.div_const (hf : continuous f) (y : G₀) :
   continuous (λ x, f x / y) :=
 by simpa only [div_eq_mul_inv] using hf.mul continuous_const
 
@@ -125,6 +128,12 @@ lemma continuous_on.inv₀ (hf : continuous_on f s) (h0 : ∀ x ∈ s, f x ≠ 0
 
 end inv₀
 
+/-- If `G₀` is a group with zero with topology such that `x ↦ x⁻¹` is continuous at all nonzero
+points. Then the coercion `Mˣ → M` is a topological embedding. -/
+theorem units.embedding_coe₀ [group_with_zero G₀] [topological_space G₀] [has_continuous_inv₀ G₀] :
+  embedding (coe : G₀ˣ → G₀) :=
+units.embedding_coe_mk $ continuous_on_inv₀.mono $ λ x, is_unit.ne_zero
+
 /-!
 ### Continuity of division
 
@@ -142,6 +151,17 @@ lemma filter.tendsto.div {l : filter α} {a b : G₀} (hf : tendsto f l (𝓝 a)
   tendsto (f / g) l (𝓝 (a / b)) :=
 by simpa only [div_eq_mul_inv] using hf.mul (hg.inv₀ hy)
 
+lemma filter.tendsto_mul_iff_of_ne_zero [t1_space G₀]
+  {f g : α → G₀} {l : filter α} {x y : G₀}
+  (hg : tendsto g l (𝓝 y)) (hy : y ≠ 0) :
+  tendsto (λ n, f n * g n) l (𝓝 $ x * y) ↔ tendsto f l (𝓝 x) :=
+begin
+  refine ⟨λ hfg, _, λ hf, hf.mul hg⟩,
+  rw ←mul_div_cancel x hy,
+  refine tendsto.congr' _ (hfg.div hg hy),
+  refine eventually.mp (hg.eventually_ne hy) (eventually_of_forall (λ n hn, mul_div_cancel _ hn)),
+end
+
 variables [topological_space α] [topological_space β] {s : set α} {a : α}
 
 lemma continuous_within_at.div (hf : continuous_within_at f s a) (hg : continuous_within_at g s a)
diff --git a/src/topology/algebra/infinite_sum.lean b/src/topology/algebra/infinite_sum.lean
deleted file mode 100644
index 00071d7fc1c9a..0000000000000
--- a/src/topology/algebra/infinite_sum.lean
+++ /dev/null
@@ -1,1509 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl
--/
-import algebra.big_operators.intervals
-import algebra.big_operators.nat_antidiagonal
-import logic.encodable.lattice
-import topology.algebra.mul_action
-import topology.algebra.order.monotone_convergence
-import topology.instances.real
-
-/-!
-# Infinite sum over a topological monoid
-
-This sum is known as unconditionally convergent, as it sums to the same value under all possible
-permutations. For Euclidean spaces (finite dimensional Banach spaces) this is equivalent to absolute
-convergence.
-
-Note: There are summable sequences which are not unconditionally convergent! The other way holds
-generally, see `has_sum.tendsto_sum_nat`.
-
-## References
-
-* Bourbaki: General Topology (1995), Chapter 3 §5 (Infinite sums in commutative groups)
-
--/
-
-noncomputable theory
-open finset filter function classical
-open_locale topological_space classical big_operators nnreal
-
-variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
-
-section has_sum
-variables [add_comm_monoid α] [topological_space α]
-
-/-- Infinite sum on a topological monoid
-
-The `at_top` filter on `finset β` is the limit of all finite sets towards the entire type. So we sum
-up bigger and bigger sets. This sum operation is invariant under reordering. In particular,
-the function `ℕ → ℝ` sending `n` to `(-1)^n / (n+1)` does not have a
-sum for this definition, but a series which is absolutely convergent will have the correct sum.
-
-This is based on Mario Carneiro's
-[infinite sum `df-tsms` in Metamath](http://us.metamath.org/mpeuni/df-tsms.html).
-
-For the definition or many statements, `α` does not need to be a topological monoid. We only add
-this assumption later, for the lemmas where it is relevant.
--/
-def has_sum (f : β → α) (a : α) : Prop := tendsto (λs:finset β, ∑ b in s, f b) at_top (𝓝 a)
-
-/-- `summable f` means that `f` has some (infinite) sum. Use `tsum` to get the value. -/
-def summable (f : β → α) : Prop := ∃a, has_sum f a
-
-/-- `∑' i, f i` is the sum of `f` it exists, or 0 otherwise -/
-@[irreducible] def tsum {β} (f : β → α) := if h : summable f then classical.some h else 0
-
--- see Note [operator precedence of big operators]
-notation `∑'` binders `, ` r:(scoped:67 f, tsum f) := r
-
-variables {f g : β → α} {a b : α} {s : finset β}
-
-lemma summable.has_sum (ha : summable f) : has_sum f (∑'b, f b) :=
-by simp [ha, tsum]; exact some_spec ha
-
-lemma has_sum.summable (h : has_sum f a) : summable f := ⟨a, h⟩
-
-/-- Constant zero function has sum `0` -/
-lemma has_sum_zero : has_sum (λb, 0 : β → α) 0 :=
-by simp [has_sum, tendsto_const_nhds]
-
-lemma has_sum_empty [is_empty β] : has_sum f 0 :=
-by convert has_sum_zero
-
-lemma summable_zero : summable (λb, 0 : β → α) := has_sum_zero.summable
-
-lemma summable_empty [is_empty β] : summable f := has_sum_empty.summable
-
-lemma tsum_eq_zero_of_not_summable (h : ¬ summable f) : ∑'b, f b = 0 :=
-by simp [tsum, h]
-
-lemma summable_congr (hfg : ∀b, f b = g b) :
-  summable f ↔ summable g :=
-iff_of_eq (congr_arg summable $ funext hfg)
-
-lemma summable.congr (hf : summable f) (hfg : ∀b, f b = g b) :
-  summable g :=
-(summable_congr hfg).mp hf
-
-lemma has_sum.has_sum_of_sum_eq {g : γ → α}
-  (h_eq : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ ∑ x in u', g x = ∑ b in v', f b)
-  (hf : has_sum g a) :
-  has_sum f a :=
-le_trans (map_at_top_finset_sum_le_of_sum_eq h_eq) hf
-
-lemma has_sum_iff_has_sum {g : γ → α}
-  (h₁ : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ ∑ x in u', g x = ∑ b in v', f b)
-  (h₂ : ∀v:finset β, ∃u:finset γ, ∀u', u ⊆ u' → ∃v', v ⊆ v' ∧ ∑ b in v', f b = ∑ x in u', g x) :
-  has_sum f a ↔ has_sum g a :=
-⟨has_sum.has_sum_of_sum_eq h₂, has_sum.has_sum_of_sum_eq h₁⟩
-
-lemma function.injective.has_sum_iff {g : γ → β} (hg : injective g)
-  (hf : ∀ x ∉ set.range g, f x = 0) :
-  has_sum (f ∘ g) a ↔ has_sum f a :=
-by simp only [has_sum, tendsto, hg.map_at_top_finset_sum_eq hf]
-
-lemma function.injective.summable_iff {g : γ → β} (hg : injective g)
-  (hf : ∀ x ∉ set.range g, f x = 0) :
-  summable (f ∘ g) ↔ summable f :=
-exists_congr $ λ _, hg.has_sum_iff hf
-
-lemma has_sum_subtype_iff_of_support_subset {s : set β} (hf : support f ⊆ s) :
-  has_sum (f ∘ coe : s → α) a ↔ has_sum f a :=
-subtype.coe_injective.has_sum_iff $ by simpa using support_subset_iff'.1 hf
-
-lemma has_sum_subtype_iff_indicator {s : set β} :
-  has_sum (f ∘ coe : s → α) a ↔ has_sum (s.indicator f) a :=
-by rw [← set.indicator_range_comp, subtype.range_coe,
-  has_sum_subtype_iff_of_support_subset set.support_indicator_subset]
-
-@[simp] lemma has_sum_subtype_support : has_sum (f ∘ coe : support f → α) a ↔ has_sum f a :=
-has_sum_subtype_iff_of_support_subset $ set.subset.refl _
-
-lemma has_sum_fintype [fintype β] (f : β → α) : has_sum f (∑ b, f b) :=
-order_top.tendsto_at_top_nhds _
-
-protected lemma finset.has_sum (s : finset β) (f : β → α) :
-  has_sum (f ∘ coe : (↑s : set β) → α) (∑ b in s, f b) :=
-by { rw ← sum_attach, exact has_sum_fintype _ }
-
-protected lemma finset.summable (s : finset β) (f : β → α) :
-  summable (f ∘ coe : (↑s : set β) → α) :=
-(s.has_sum f).summable
-
-protected lemma set.finite.summable {s : set β} (hs : s.finite) (f : β → α) :
-  summable (f ∘ coe : s → α) :=
-by convert hs.to_finset.summable f; simp only [hs.coe_to_finset]
-
-/-- If a function `f` vanishes outside of a finite set `s`, then it `has_sum` `∑ b in s, f b`. -/
-lemma has_sum_sum_of_ne_finset_zero (hf : ∀b∉s, f b = 0) : has_sum f (∑ b in s, f b) :=
-(has_sum_subtype_iff_of_support_subset $ support_subset_iff'.2 hf).1 $ s.has_sum f
-
-lemma summable_of_ne_finset_zero (hf : ∀b∉s, f b = 0) : summable f :=
-(has_sum_sum_of_ne_finset_zero hf).summable
-
-lemma has_sum_single {f : β → α} (b : β) (hf : ∀b' ≠ b, f b' = 0) :
-  has_sum f (f b) :=
-suffices has_sum f (∑ b' in {b}, f b'),
-  by simpa using this,
-has_sum_sum_of_ne_finset_zero $ by simpa [hf]
-
-lemma has_sum_ite_eq (b : β) [decidable_pred (= b)] (a : α) :
-  has_sum (λb', if b' = b then a else 0) a :=
-begin
-  convert has_sum_single b _,
-  { exact (if_pos rfl).symm },
-  assume b' hb',
-  exact if_neg hb'
-end
-
-lemma equiv.has_sum_iff (e : γ ≃ β) :
-  has_sum (f ∘ e) a ↔ has_sum f a :=
-e.injective.has_sum_iff $ by simp
-
-lemma function.injective.has_sum_range_iff {g : γ → β} (hg : injective g) :
-  has_sum (λ x : set.range g, f x) a ↔ has_sum (f ∘ g) a :=
-(equiv.of_injective g hg).has_sum_iff.symm
-
-lemma equiv.summable_iff (e : γ ≃ β) :
-  summable (f ∘ e) ↔ summable f :=
-exists_congr $ λ a, e.has_sum_iff
-
-lemma summable.prod_symm {f : β × γ → α} (hf : summable f) : summable (λ p : γ × β, f p.swap) :=
-(equiv.prod_comm γ β).summable_iff.2 hf
-
-lemma equiv.has_sum_iff_of_support {g : γ → α} (e : support f ≃ support g)
-  (he : ∀ x : support f, g (e x) = f x) :
-  has_sum f a ↔ has_sum g a :=
-have (g ∘ coe) ∘ e = f ∘ coe, from funext he,
-by rw [← has_sum_subtype_support, ← this, e.has_sum_iff, has_sum_subtype_support]
-
-lemma has_sum_iff_has_sum_of_ne_zero_bij {g : γ → α} (i : support g → β)
-  (hi : ∀ ⦃x y⦄, i x = i y → (x : γ) = y)
-  (hf : support f ⊆ set.range i) (hfg : ∀ x, f (i x) = g x) :
-  has_sum f a ↔ has_sum g a :=
-iff.symm $ equiv.has_sum_iff_of_support
-  (equiv.of_bijective (λ x, ⟨i x, λ hx, x.coe_prop $ hfg x ▸ hx⟩)
-    ⟨λ x y h, subtype.ext $ hi $ subtype.ext_iff.1 h,
-      λ y, (hf y.coe_prop).imp $ λ x hx, subtype.ext hx⟩)
-  hfg
-
-lemma equiv.summable_iff_of_support {g : γ → α} (e : support f ≃ support g)
-  (he : ∀ x : support f, g (e x) = f x) :
-  summable f ↔ summable g :=
-exists_congr $ λ _, e.has_sum_iff_of_support he
-
-protected lemma has_sum.map [add_comm_monoid γ] [topological_space γ] (hf : has_sum f a)
-  {G} [add_monoid_hom_class G α γ] (g : G) (hg : continuous g) :
-  has_sum (g ∘ f) (g a) :=
-have g ∘ (λs:finset β, ∑ b in s, f b) = (λs:finset β, ∑ b in s, g (f b)),
-  from funext $ map_sum g _,
-show tendsto (λs:finset β, ∑ b in s, g (f b)) at_top (𝓝 (g a)),
-  from this ▸ (hg.tendsto a).comp hf
-
-protected lemma summable.map [add_comm_monoid γ] [topological_space γ] (hf : summable f)
-  {G} [add_monoid_hom_class G α γ] (g : G) (hg : continuous g) :
-  summable (g ∘ f) :=
-(hf.has_sum.map g hg).summable
-
-protected lemma summable.map_iff_of_left_inverse [add_comm_monoid γ] [topological_space γ]
-  {G G'} [add_monoid_hom_class G α γ] [add_monoid_hom_class G' γ α] (g : G) (g' : G')
-  (hg : continuous g) (hg' : continuous g') (hinv : function.left_inverse g' g) :
-  summable (g ∘ f) ↔ summable f :=
-⟨λ h, begin
-  have := h.map _ hg',
-  rwa [←function.comp.assoc, hinv.id] at this,
-end, λ h, h.map _ hg⟩
-
-/-- A special case of `summable.map_iff_of_left_inverse` for convenience -/
-protected lemma summable.map_iff_of_equiv [add_comm_monoid γ] [topological_space γ]
-  {G} [add_equiv_class G α γ] (g : G)
-  (hg : continuous g) (hg' : continuous (add_equiv_class.inv g : γ → α)) :
-  summable (g ∘ f) ↔ summable f :=
-summable.map_iff_of_left_inverse g (g : α ≃+ γ).symm hg hg' (add_equiv_class.left_inv g)
-
-/-- If `f : ℕ → α` has sum `a`, then the partial sums `∑_{i=0}^{n-1} f i` converge to `a`. -/
-lemma has_sum.tendsto_sum_nat {f : ℕ → α} (h : has_sum f a) :
-  tendsto (λn:ℕ, ∑ i in range n, f i) at_top (𝓝 a) :=
-h.comp tendsto_finset_range
-
-lemma has_sum.unique {a₁ a₂ : α} [t2_space α] : has_sum f a₁ → has_sum f a₂ → a₁ = a₂ :=
-tendsto_nhds_unique
-
-lemma summable.has_sum_iff_tendsto_nat [t2_space α] {f : ℕ → α} {a : α} (hf : summable f) :
-  has_sum f a ↔ tendsto (λn:ℕ, ∑ i in range n, f i) at_top (𝓝 a) :=
-begin
-  refine ⟨λ h, h.tendsto_sum_nat, λ h, _⟩,
-  rw tendsto_nhds_unique h hf.has_sum.tendsto_sum_nat,
-  exact hf.has_sum
-end
-
-lemma function.surjective.summable_iff_of_has_sum_iff {α' : Type*} [add_comm_monoid α']
-  [topological_space α'] {e : α' → α} (hes : function.surjective e) {f : β → α} {g : γ → α'}
-  (he : ∀ {a}, has_sum f (e a) ↔ has_sum g a) :
-  summable f ↔ summable g :=
-hes.exists.trans $ exists_congr $ @he
-
-section has_continuous_star
-variables [star_add_monoid α] [has_continuous_star α]
-
-lemma has_sum.star (h : has_sum f a) : has_sum (λ b, star (f b)) (star a) :=
-by simpa only using h.map (star_add_equiv : α ≃+ α) continuous_star
-
-lemma summable.star (hf : summable f) : summable (λ b, star (f b)) :=
-hf.has_sum.star.summable
-
-lemma summable.of_star (hf : summable (λ b, star (f b))) : summable f :=
-by simpa only [star_star] using hf.star
-
-@[simp] lemma summable_star_iff : summable (λ b, star (f b)) ↔ summable f :=
-⟨summable.of_star, summable.star⟩
-
-@[simp] lemma summable_star_iff' : summable (star f) ↔ summable f :=
-summable_star_iff
-
-end has_continuous_star
-
-variable [has_continuous_add α]
-
-lemma has_sum.add (hf : has_sum f a) (hg : has_sum g b) : has_sum (λb, f b + g b) (a + b) :=
-by simp only [has_sum, sum_add_distrib]; exact hf.add hg
-
-lemma summable.add (hf : summable f) (hg : summable g) : summable (λb, f b + g b) :=
-(hf.has_sum.add hg.has_sum).summable
-
-lemma has_sum_sum {f : γ → β → α} {a : γ → α} {s : finset γ} :
-  (∀i∈s, has_sum (f i) (a i)) → has_sum (λb, ∑ i in s, f i b) (∑ i in s, a i) :=
-finset.induction_on s (by simp only [has_sum_zero, sum_empty, forall_true_iff])
-  (by simp only [has_sum.add, sum_insert, mem_insert, forall_eq_or_imp,
-        forall_2_true_iff, not_false_iff, forall_true_iff] {contextual := tt})
-
-lemma summable_sum {f : γ → β → α} {s : finset γ} (hf : ∀i∈s, summable (f i)) :
-  summable (λb, ∑ i in s, f i b) :=
-(has_sum_sum $ assume i hi, (hf i hi).has_sum).summable
-
-lemma has_sum.add_disjoint {s t : set β} (hs : disjoint s t)
-  (ha : has_sum (f ∘ coe : s → α) a) (hb : has_sum (f ∘ coe : t → α) b) :
-  has_sum (f ∘ coe : s ∪ t → α) (a + b) :=
-begin
-  rw has_sum_subtype_iff_indicator at *,
-  rw set.indicator_union_of_disjoint hs,
-  exact ha.add hb
-end
-
-lemma has_sum.add_is_compl {s t : set β} (hs : is_compl s t)
-  (ha : has_sum (f ∘ coe : s → α) a) (hb : has_sum (f ∘ coe : t → α) b) :
-  has_sum f (a + b) :=
-by simpa [← hs.compl_eq]
-  using (has_sum_subtype_iff_indicator.1 ha).add (has_sum_subtype_iff_indicator.1 hb)
-
-lemma has_sum.add_compl {s : set β} (ha : has_sum (f ∘ coe : s → α) a)
-  (hb : has_sum (f ∘ coe : sᶜ → α) b) :
-  has_sum f (a + b) :=
-ha.add_is_compl is_compl_compl hb
-
-lemma summable.add_compl {s : set β} (hs : summable (f ∘ coe : s → α))
-  (hsc : summable (f ∘ coe : sᶜ → α)) :
-  summable f :=
-(hs.has_sum.add_compl hsc.has_sum).summable
-
-lemma has_sum.compl_add {s : set β} (ha : has_sum (f ∘ coe : sᶜ → α) a)
-  (hb : has_sum (f ∘ coe : s → α) b) :
-  has_sum f (a + b) :=
-ha.add_is_compl is_compl_compl.symm hb
-
-lemma has_sum.even_add_odd {f : ℕ → α} (he : has_sum (λ k, f (2 * k)) a)
-  (ho : has_sum (λ k, f (2 * k + 1)) b) :
-  has_sum f (a + b) :=
-begin
-  have := mul_right_injective₀ (@two_ne_zero ℕ _ _),
-  replace he := this.has_sum_range_iff.2 he,
-  replace ho := ((add_left_injective 1).comp this).has_sum_range_iff.2 ho,
-  refine he.add_is_compl _ ho,
-  simpa [(∘)] using nat.is_compl_even_odd
-end
-
-lemma summable.compl_add {s : set β} (hs : summable (f ∘ coe : sᶜ → α))
-  (hsc : summable (f ∘ coe : s → α)) :
-  summable f :=
-(hs.has_sum.compl_add hsc.has_sum).summable
-
-lemma summable.even_add_odd {f : ℕ → α} (he : summable (λ k, f (2 * k)))
-  (ho : summable (λ k, f (2 * k + 1))) :
-  summable f :=
-(he.has_sum.even_add_odd ho.has_sum).summable
-
-lemma has_sum.sigma [regular_space α] {γ : β → Type*} {f : (Σ b:β, γ b) → α} {g : β → α} {a : α}
-  (ha : has_sum f a) (hf : ∀b, has_sum (λc, f ⟨b, c⟩) (g b)) : has_sum g a :=
-begin
-  refine (at_top_basis.tendsto_iff (closed_nhds_basis a)).mpr _,
-  rintros s ⟨hs, hsc⟩,
-  rcases mem_at_top_sets.mp (ha hs) with ⟨u, hu⟩,
-  use [u.image sigma.fst, trivial],
-  intros bs hbs,
-  simp only [set.mem_preimage, ge_iff_le, finset.le_iff_subset] at hu,
-  have : tendsto (λ t : finset (Σ b, γ b), ∑ p in t.filter (λ p, p.1 ∈ bs), f p)
-    at_top (𝓝 $ ∑ b in bs, g b),
-  { simp only [← sigma_preimage_mk, sum_sigma],
-    refine tendsto_finset_sum _ (λ b hb, _),
-    change tendsto (λ t, (λ t, ∑ s in t, f ⟨b, s⟩) (preimage t (sigma.mk b) _)) at_top (𝓝 (g b)),
-    exact tendsto.comp (hf b) (tendsto_finset_preimage_at_top_at_top _) },
-  refine hsc.mem_of_tendsto this (eventually_at_top.2 ⟨u, λ t ht, hu _ (λ x hx, _)⟩),
-  exact mem_filter.2 ⟨ht hx, hbs $ mem_image_of_mem _ hx⟩
-end
-
-/-- If a series `f` on `β × γ` has sum `a` and for each `b` the restriction of `f` to `{b} × γ`
-has sum `g b`, then the series `g` has sum `a`. -/
-lemma has_sum.prod_fiberwise [regular_space α] {f : β × γ → α} {g : β → α} {a : α}
-  (ha : has_sum f a) (hf : ∀b, has_sum (λc, f (b, c)) (g b)) :
-  has_sum g a :=
-has_sum.sigma ((equiv.sigma_equiv_prod β γ).has_sum_iff.2 ha) hf
-
-lemma summable.sigma' [regular_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
-  (ha : summable f) (hf : ∀b, summable (λc, f ⟨b, c⟩)) :
-  summable (λb, ∑'c, f ⟨b, c⟩) :=
-(ha.has_sum.sigma (assume b, (hf b).has_sum)).summable
-
-lemma has_sum.sigma_of_has_sum [regular_space α] {γ : β → Type*} {f : (Σ b:β, γ b) → α} {g : β → α}
-  {a : α} (ha : has_sum g a) (hf : ∀b, has_sum (λc, f ⟨b, c⟩) (g b)) (hf' : summable f) :
-  has_sum f a :=
-by simpa [(hf'.has_sum.sigma hf).unique ha] using hf'.has_sum
-
-end has_sum
-
-section tsum
-variables [add_comm_monoid α] [topological_space α]
-
-lemma tsum_congr_subtype (f : β → α) {s t : set β} (h : s = t) :
-  ∑' (x : s), f x = ∑' (x : t), f x :=
-by rw h
-
-variables [t2_space α] {f g : β → α} {a a₁ a₂ : α}
-
-lemma has_sum.tsum_eq (ha : has_sum f a) : ∑'b, f b = a :=
-(summable.has_sum ⟨a, ha⟩).unique ha
-
-lemma summable.has_sum_iff (h : summable f) : has_sum f a ↔ ∑'b, f b = a :=
-iff.intro has_sum.tsum_eq (assume eq, eq ▸ h.has_sum)
-
-@[simp] lemma tsum_zero : ∑'b:β, (0:α) = 0 := has_sum_zero.tsum_eq
-
-@[simp] lemma tsum_empty [is_empty β] : ∑'b, f b = 0 := has_sum_empty.tsum_eq
-
-lemma tsum_eq_sum {f : β → α} {s : finset β} (hf : ∀b∉s, f b = 0)  :
-  ∑' b, f b = ∑ b in s, f b :=
-(has_sum_sum_of_ne_finset_zero hf).tsum_eq
-
-lemma tsum_congr {α β : Type*} [add_comm_monoid α] [topological_space α]
-  {f g : β → α} (hfg : ∀ b, f b = g b) : ∑' b, f b = ∑' b, g b :=
-congr_arg tsum (funext hfg)
-
-lemma tsum_fintype [fintype β] (f : β → α) : ∑'b, f b = ∑ b, f b :=
-(has_sum_fintype f).tsum_eq
-
-lemma tsum_bool (f : bool → α) : ∑' i : bool, f i = f false + f true :=
-by { rw [tsum_fintype, finset.sum_eq_add]; simp }
-
-@[simp] lemma finset.tsum_subtype (s : finset β) (f : β → α) :
-  ∑' x : {x // x ∈ s}, f x = ∑ x in s, f x :=
-(s.has_sum f).tsum_eq
-
-@[simp] lemma finset.tsum_subtype' (s : finset β) (f : β → α) :
-  ∑' x : (s : set β), f x = ∑ x in s, f x :=
-s.tsum_subtype f
-
-lemma tsum_eq_single {f : β → α} (b : β) (hf : ∀b' ≠ b, f b' = 0)  :
-  ∑'b, f b = f b :=
-(has_sum_single b hf).tsum_eq
-
-@[simp] lemma tsum_ite_eq (b : β) [decidable_pred (= b)] (a : α) :
-  ∑' b', (if b' = b then a else 0) = a :=
-(has_sum_ite_eq b a).tsum_eq
-
-lemma tsum_dite_right (P : Prop) [decidable P] (x : β → ¬ P → α) :
-  ∑' (b : β), (if h : P then (0 : α) else x b h) = if h : P then (0 : α) else ∑' (b : β), x b h :=
-by by_cases hP : P; simp [hP]
-
-lemma tsum_dite_left (P : Prop) [decidable P] (x : β → P → α) :
-  ∑' (b : β), (if h : P then x b h else 0) = if h : P then (∑' (b : β), x b h) else 0 :=
-by by_cases hP : P; simp [hP]
-
-lemma function.surjective.tsum_eq_tsum_of_has_sum_iff_has_sum {α' : Type*} [add_comm_monoid α']
-  [topological_space α'] {e : α' → α} (hes : function.surjective e) (h0 : e 0 = 0)
-  {f : β → α} {g : γ → α'}
-  (h : ∀ {a}, has_sum f (e a) ↔ has_sum g a) :
-  ∑' b, f b = e (∑' c, g c) :=
-by_cases
-  (assume : summable g, (h.mpr this.has_sum).tsum_eq)
-  (assume hg : ¬ summable g,
-    have hf : ¬ summable f, from mt (hes.summable_iff_of_has_sum_iff @h).1 hg,
-    by simp [tsum, hf, hg, h0])
-
-lemma tsum_eq_tsum_of_has_sum_iff_has_sum {f : β → α} {g : γ → α}
-  (h : ∀{a}, has_sum f a ↔ has_sum g a) :
-  ∑'b, f b = ∑'c, g c :=
-surjective_id.tsum_eq_tsum_of_has_sum_iff_has_sum rfl @h
-
-lemma equiv.tsum_eq (j : γ ≃ β) (f : β → α) : ∑'c, f (j c) = ∑'b, f b :=
-tsum_eq_tsum_of_has_sum_iff_has_sum $ λ a, j.has_sum_iff
-
-lemma equiv.tsum_eq_tsum_of_support {f : β → α} {g : γ → α} (e : support f ≃ support g)
-  (he : ∀ x, g (e x) = f x) :
-  (∑' x, f x) = ∑' y, g y :=
-tsum_eq_tsum_of_has_sum_iff_has_sum $ λ _, e.has_sum_iff_of_support he
-
-lemma tsum_eq_tsum_of_ne_zero_bij {g : γ → α} (i : support g → β)
-  (hi : ∀ ⦃x y⦄, i x = i y → (x : γ) = y)
-  (hf : support f ⊆ set.range i) (hfg : ∀ x, f (i x) = g x) :
-  ∑' x, f x  = ∑' y, g y :=
-tsum_eq_tsum_of_has_sum_iff_has_sum $ λ _, has_sum_iff_has_sum_of_ne_zero_bij i hi hf hfg
-
-lemma tsum_subtype (s : set β) (f : β → α) :
-  ∑' x:s, f x = ∑' x, s.indicator f x :=
-tsum_eq_tsum_of_has_sum_iff_has_sum $ λ _, has_sum_subtype_iff_indicator
-
-section has_continuous_add
-variable [has_continuous_add α]
-
-lemma tsum_add (hf : summable f) (hg : summable g) : ∑'b, (f b + g b) = (∑'b, f b) + (∑'b, g b) :=
-(hf.has_sum.add hg.has_sum).tsum_eq
-
-lemma tsum_sum {f : γ → β → α} {s : finset γ} (hf : ∀i∈s, summable (f i)) :
-  ∑'b, ∑ i in s, f i b = ∑ i in s, ∑'b, f i b :=
-(has_sum_sum $ assume i hi, (hf i hi).has_sum).tsum_eq
-
-lemma tsum_sigma' [regular_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
-  (h₁ : ∀b, summable (λc, f ⟨b, c⟩)) (h₂ : summable f) : ∑'p, f p = ∑'b c, f ⟨b, c⟩ :=
-(h₂.has_sum.sigma (assume b, (h₁ b).has_sum)).tsum_eq.symm
-
-lemma tsum_prod' [regular_space α] {f : β × γ → α} (h : summable f)
-  (h₁ : ∀b, summable (λc, f (b, c))) :
-  ∑'p, f p = ∑'b c, f (b, c) :=
-(h.has_sum.prod_fiberwise (assume b, (h₁ b).has_sum)).tsum_eq.symm
-
-lemma tsum_comm' [regular_space α] {f : β → γ → α} (h : summable (function.uncurry f))
-  (h₁ : ∀b, summable (f b)) (h₂ : ∀ c, summable (λ b, f b c)) :
-  ∑' c b, f b c = ∑' b c, f b c :=
-begin
-  erw [← tsum_prod' h h₁, ← tsum_prod' h.prod_symm h₂, ← (equiv.prod_comm β γ).tsum_eq],
-  refl,
-  assumption
-end
-
-end has_continuous_add
-
-section has_continuous_star
-variables [star_add_monoid α] [has_continuous_star α]
-
-lemma tsum_star : star (∑' b, f b) = ∑' b, star (f b) :=
-begin
-  by_cases hf : summable f,
-  { exact hf.has_sum.star.tsum_eq.symm, },
-  { rw [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable (mt summable.of_star hf),
-        star_zero] },
-end
-
-end has_continuous_star
-
-section encodable
-open encodable
-variable [encodable γ]
-
-/-- You can compute a sum over an encodably type by summing over the natural numbers and
-  taking a supremum. This is useful for outer measures. -/
-theorem tsum_supr_decode₂ [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
-  (s : γ → β) : ∑' i : ℕ, m (⨆ b ∈ decode₂ γ i, s b) = ∑' b : γ, m (s b) :=
-begin
-  have H : ∀ n, m (⨆ b ∈ decode₂ γ n, s b) ≠ 0 → (decode₂ γ n).is_some,
-  { intros n h,
-    cases decode₂ γ n with b,
-    { refine (h $ by simp [m0]).elim },
-    { exact rfl } },
-  symmetry, refine tsum_eq_tsum_of_ne_zero_bij (λ a, option.get (H a.1 a.2)) _ _ _,
-  { rintros ⟨m, hm⟩ ⟨n, hn⟩ e,
-    have := mem_decode₂.1 (option.get_mem (H n hn)),
-    rwa [← e, mem_decode₂.1 (option.get_mem (H m hm))] at this },
-  { intros b h,
-    refine ⟨⟨encode b, _⟩, _⟩,
-    { simp only [mem_support, encodek₂] at h ⊢, convert h, simp [set.ext_iff, encodek₂] },
-    { exact option.get_of_mem _ (encodek₂ _) } },
-  { rintros ⟨n, h⟩, dsimp only [subtype.coe_mk],
-    transitivity, swap,
-    rw [show decode₂ γ n = _, from option.get_mem (H n h)],
-    congr, simp [ext_iff, -option.some_get] }
-end
-
-/-- `tsum_supr_decode₂` specialized to the complete lattice of sets. -/
-theorem tsum_Union_decode₂ (m : set β → α) (m0 : m ∅ = 0)
-  (s : γ → set β) : ∑' i, m (⋃ b ∈ decode₂ γ i, s b) = ∑' b, m (s b) :=
-tsum_supr_decode₂ m m0 s
-
-/-! Some properties about measure-like functions.
-  These could also be functions defined on complete sublattices of sets, with the property
-  that they are countably sub-additive.
-  `R` will probably be instantiated with `(≤)` in all applications.
--/
-
-/-- If a function is countably sub-additive then it is sub-additive on encodable types -/
-theorem rel_supr_tsum [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
-  (R : α → α → Prop) (m_supr : ∀(s : ℕ → β), R (m (⨆ i, s i)) ∑' i, m (s i))
-  (s : γ → β) : R (m (⨆ b : γ, s b)) ∑' b : γ, m (s b) :=
-by { rw [← supr_decode₂, ← tsum_supr_decode₂ _ m0 s], exact m_supr _ }
-
-/-- If a function is countably sub-additive then it is sub-additive on finite sets -/
-theorem rel_supr_sum [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
-  (R : α → α → Prop) (m_supr : ∀(s : ℕ → β), R (m (⨆ i, s i)) (∑' i, m (s i)))
-  (s : δ → β) (t : finset δ) :
-  R (m (⨆ d ∈ t, s d)) (∑ d in t, m (s d)) :=
-by { cases t.nonempty_encodable, rw [supr_subtype'], convert rel_supr_tsum m m0 R m_supr _,
-     rw [← finset.tsum_subtype], assumption }
-
-/-- If a function is countably sub-additive then it is binary sub-additive -/
-theorem rel_sup_add [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
-  (R : α → α → Prop) (m_supr : ∀(s : ℕ → β), R (m (⨆ i, s i)) (∑' i, m (s i)))
-  (s₁ s₂ : β) : R (m (s₁ ⊔ s₂)) (m s₁ + m s₂) :=
-begin
-  convert rel_supr_tsum m m0 R m_supr (λ b, cond b s₁ s₂),
-  { simp only [supr_bool_eq, cond] },
-  { rw [tsum_fintype, fintype.sum_bool, cond, cond] }
-end
-
-end encodable
-
-variables [has_continuous_add α]
-
-lemma tsum_add_tsum_compl {s : set β} (hs : summable (f ∘ coe : s → α))
-  (hsc : summable (f ∘ coe : sᶜ → α)) :
-  (∑' x : s, f x) + (∑' x : sᶜ, f x) = ∑' x, f x :=
-(hs.has_sum.add_compl hsc.has_sum).tsum_eq.symm
-
-lemma tsum_union_disjoint {s t : set β} (hd : disjoint s t)
-  (hs : summable (f ∘ coe : s → α)) (ht : summable (f ∘ coe : t → α)) :
-  (∑' x : s ∪ t, f x) = (∑' x : s, f x) + (∑' x : t, f x) :=
-(hs.has_sum.add_disjoint hd ht.has_sum).tsum_eq
-
-lemma tsum_even_add_odd {f : ℕ → α} (he : summable (λ k, f (2 * k)))
-  (ho : summable (λ k, f (2 * k + 1))) :
-  (∑' k, f (2 * k)) + (∑' k, f (2 * k + 1)) = ∑' k, f k :=
-(he.has_sum.even_add_odd ho.has_sum).tsum_eq.symm
-
-end tsum
-
-section prod
-
-variables [add_comm_monoid α] [topological_space α] [add_comm_monoid γ] [topological_space γ]
-
-lemma has_sum.prod_mk {f : β → α} {g : β → γ} {a : α} {b : γ}
-  (hf : has_sum f a) (hg : has_sum g b) :
-  has_sum (λ x, (⟨f x, g x⟩ : α × γ)) ⟨a, b⟩ :=
-by simp [has_sum, ← prod_mk_sum, filter.tendsto.prod_mk_nhds hf hg]
-
-end prod
-
-section pi
-variables {ι : Type*} {π : α → Type*} [∀ x, add_comm_monoid (π x)] [∀ x, topological_space (π x)]
-
-lemma pi.has_sum {f : ι → ∀ x, π x} {g : ∀ x, π x} :
-  has_sum f g ↔ ∀ x, has_sum (λ i, f i x) (g x) :=
-by simp only [has_sum, tendsto_pi_nhds, sum_apply]
-
-lemma pi.summable {f : ι → ∀ x, π x} : summable f ↔ ∀ x, summable (λ i, f i x) :=
-by simp only [summable, pi.has_sum, skolem]
-
-lemma tsum_apply [∀ x, t2_space (π x)] {f : ι → ∀ x, π x}{x : α} (hf : summable f) :
-  (∑' i, f i) x = ∑' i, f i x :=
-(pi.has_sum.mp hf.has_sum x).tsum_eq.symm
-
-end pi
-
-section topological_group
-variables [add_comm_group α] [topological_space α] [topological_add_group α]
-variables {f g : β → α} {a a₁ a₂ : α}
-
--- `by simpa using` speeds up elaboration. Why?
-lemma has_sum.neg (h : has_sum f a) : has_sum (λb, - f b) (- a) :=
-by simpa only using h.map (-add_monoid_hom.id α) continuous_neg
-
-lemma summable.neg (hf : summable f) : summable (λb, - f b) :=
-hf.has_sum.neg.summable
-
-lemma summable.of_neg (hf : summable (λb, - f b)) : summable f :=
-by simpa only [neg_neg] using hf.neg
-
-lemma summable_neg_iff : summable (λ b, - f b) ↔ summable f :=
-⟨summable.of_neg, summable.neg⟩
-
-lemma has_sum.sub (hf : has_sum f a₁) (hg : has_sum g a₂) : has_sum (λb, f b - g b) (a₁ - a₂) :=
-by { simp only [sub_eq_add_neg], exact hf.add hg.neg }
-
-lemma summable.sub (hf : summable f) (hg : summable g) : summable (λb, f b - g b) :=
-(hf.has_sum.sub hg.has_sum).summable
-
-lemma summable.trans_sub (hg : summable g) (hfg : summable (λb, f b - g b)) :
-  summable f :=
-by simpa only [sub_add_cancel] using hfg.add hg
-
-lemma summable_iff_of_summable_sub (hfg : summable (λb, f b - g b)) :
-  summable f ↔ summable g :=
-⟨λ hf, hf.trans_sub $ by simpa only [neg_sub] using hfg.neg, λ hg, hg.trans_sub hfg⟩
-
-lemma has_sum.update (hf : has_sum f a₁) (b : β) [decidable_eq β] (a : α) :
-  has_sum (update f b a) (a - f b + a₁) :=
-begin
-  convert ((has_sum_ite_eq b _).add hf),
-  ext b',
-  by_cases h : b' = b,
-  { rw [h, update_same],
-    simp only [eq_self_iff_true, if_true, sub_add_cancel] },
-  simp only [h, update_noteq, if_false, ne.def, zero_add, not_false_iff],
-end
-
-lemma summable.update (hf : summable f) (b : β) [decidable_eq β] (a : α) :
-  summable (update f b a) :=
-(hf.has_sum.update b a).summable
-
-lemma has_sum.has_sum_compl_iff {s : set β} (hf : has_sum (f ∘ coe : s → α) a₁) :
-  has_sum (f ∘ coe : sᶜ → α) a₂ ↔ has_sum f (a₁ + a₂) :=
-begin
-  refine ⟨λ h, hf.add_compl h, λ h, _⟩,
-  rw [has_sum_subtype_iff_indicator] at hf ⊢,
-  rw [set.indicator_compl],
-  simpa only [add_sub_cancel'] using h.sub hf
-end
-
-lemma has_sum.has_sum_iff_compl {s : set β} (hf : has_sum (f ∘ coe : s → α) a₁) :
-  has_sum f a₂ ↔ has_sum (f ∘ coe : sᶜ → α) (a₂ - a₁) :=
-iff.symm $ hf.has_sum_compl_iff.trans $ by rw [add_sub_cancel'_right]
-
-lemma summable.summable_compl_iff {s : set β} (hf : summable (f ∘ coe : s → α)) :
-  summable (f ∘ coe : sᶜ → α) ↔ summable f :=
-⟨λ ⟨a, ha⟩, (hf.has_sum.has_sum_compl_iff.1 ha).summable,
-  λ ⟨a, ha⟩, (hf.has_sum.has_sum_iff_compl.1 ha).summable⟩
-
-protected lemma finset.has_sum_compl_iff (s : finset β) :
-  has_sum (λ x : {x // x ∉ s}, f x) a ↔ has_sum f (a + ∑ i in s, f i) :=
-(s.has_sum f).has_sum_compl_iff.trans $ by rw [add_comm]
-
-protected lemma finset.has_sum_iff_compl (s : finset β) :
-  has_sum f a ↔ has_sum (λ x : {x // x ∉ s}, f x) (a - ∑ i in s, f i) :=
-(s.has_sum f).has_sum_iff_compl
-
-protected lemma finset.summable_compl_iff (s : finset β) :
-  summable (λ x : {x // x ∉ s}, f x) ↔ summable f :=
-(s.summable f).summable_compl_iff
-
-lemma set.finite.summable_compl_iff {s : set β} (hs : s.finite) :
-  summable (f ∘ coe : sᶜ → α) ↔ summable f :=
-(hs.summable f).summable_compl_iff
-
-lemma has_sum_ite_eq_extract [decidable_eq β] (hf : has_sum f a) (b : β) :
-  has_sum (λ n, ite (n = b) 0 (f n)) (a - f b) :=
-begin
-  convert hf.update b 0 using 1,
-  { ext n, rw function.update_apply, },
-  { rw [sub_add_eq_add_sub, zero_add], },
-end
-
-section tsum
-variables [t2_space α]
-
-lemma tsum_neg : ∑'b, - f b = - ∑'b, f b :=
-begin
-  by_cases hf : summable f,
-  { exact hf.has_sum.neg.tsum_eq, },
-  { simp [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable (mt summable.of_neg hf)] },
-end
-
-lemma tsum_sub (hf : summable f) (hg : summable g) : ∑'b, (f b - g b) = ∑'b, f b - ∑'b, g b :=
-(hf.has_sum.sub hg.has_sum).tsum_eq
-
-lemma sum_add_tsum_compl {s : finset β} (hf : summable f) :
-  (∑ x in s, f x) + (∑' x : (↑s : set β)ᶜ, f x) = ∑' x, f x :=
-((s.has_sum f).add_compl (s.summable_compl_iff.2 hf).has_sum).tsum_eq.symm
-
-/-- Let `f : β → α` be a sequence with summable series and let `b ∈ β` be an index.
-Lemma `tsum_ite_eq_extract` writes `Σ f n` as the sum of `f b` plus the series of the
-remaining terms. -/
-lemma tsum_ite_eq_extract [decidable_eq β] (hf : summable f) (b : β) :
-  ∑' n, f n = f b + ∑' n, ite (n = b) 0 (f n) :=
-begin
-  rw (has_sum_ite_eq_extract hf.has_sum b).tsum_eq,
-  exact (add_sub_cancel'_right _ _).symm,
-end
-
-end tsum
-
-/-!
-### Sums on subtypes
-
-If `s` is a finset of `α`, we show that the summability of `f` in the whole space and on the subtype
-`univ - s` are equivalent, and relate their sums. For a function defined on `ℕ`, we deduce the
-formula `(∑ i in range k, f i) + (∑' i, f (i + k)) = (∑' i, f i)`, in `sum_add_tsum_nat_add`.
--/
-section subtype
-
-lemma has_sum_nat_add_iff {f : ℕ → α} (k : ℕ) {a : α} :
-  has_sum (λ n, f (n + k)) a ↔ has_sum f (a + ∑ i in range k, f i) :=
-begin
-  refine iff.trans _ ((range k).has_sum_compl_iff),
-  rw [← (not_mem_range_equiv k).symm.has_sum_iff],
-  refl
-end
-
-lemma summable_nat_add_iff {f : ℕ → α} (k : ℕ) : summable (λ n, f (n + k)) ↔ summable f :=
-iff.symm $ (equiv.add_right (∑ i in range k, f i)).surjective.summable_iff_of_has_sum_iff $
-  λ a, (has_sum_nat_add_iff k).symm
-
-lemma has_sum_nat_add_iff' {f : ℕ → α} (k : ℕ) {a : α} :
-  has_sum (λ n, f (n + k)) (a - ∑ i in range k, f i) ↔ has_sum f a :=
-by simp [has_sum_nat_add_iff]
-
-lemma sum_add_tsum_nat_add [t2_space α] {f : ℕ → α} (k : ℕ) (h : summable f) :
-  (∑ i in range k, f i) + (∑' i, f (i + k)) = ∑' i, f i :=
-by simpa only [add_comm] using
-  ((has_sum_nat_add_iff k).1 ((summable_nat_add_iff k).2 h).has_sum).unique h.has_sum
-
-lemma tsum_eq_zero_add [t2_space α] {f : ℕ → α} (hf : summable f) :
-  ∑'b, f b = f 0 + ∑'b, f (b + 1) :=
-by simpa only [sum_range_one] using (sum_add_tsum_nat_add 1 hf).symm
-
-/-- For `f : ℕ → α`, then `∑' k, f (k + i)` tends to zero. This does not require a summability
-assumption on `f`, as otherwise all sums are zero. -/
-lemma tendsto_sum_nat_add [t2_space α] (f : ℕ → α) : tendsto (λ i, ∑' k, f (k + i)) at_top (𝓝 0) :=
-begin
-  by_cases hf : summable f,
-  { have h₀ : (λ i, (∑' i, f i) - ∑ j in range i, f j) = λ i, ∑' (k : ℕ), f (k + i),
-    { ext1 i,
-      rw [sub_eq_iff_eq_add, add_comm, sum_add_tsum_nat_add i hf] },
-    have h₁ : tendsto (λ i : ℕ, ∑' i, f i) at_top (𝓝 (∑' i, f i)) := tendsto_const_nhds,
-    simpa only [h₀, sub_self] using tendsto.sub h₁ hf.has_sum.tendsto_sum_nat },
-  { convert tendsto_const_nhds,
-    ext1 i,
-    rw ← summable_nat_add_iff i at hf,
-    { exact tsum_eq_zero_of_not_summable hf },
-    { apply_instance } }
-end
-
-end subtype
-
-end topological_group
-
-section topological_semiring
-variables [non_unital_non_assoc_semiring α] [topological_space α] [topological_semiring α]
-variables {f g : β → α} {a a₁ a₂ : α}
-lemma has_sum.mul_left (a₂) (h : has_sum f a₁) : has_sum (λb, a₂ * f b) (a₂ * a₁) :=
-by simpa only using h.map (add_monoid_hom.mul_left a₂) (continuous_const.mul continuous_id)
-
-lemma has_sum.mul_right (a₂) (hf : has_sum f a₁) : has_sum (λb, f b * a₂) (a₁ * a₂) :=
-by simpa only using hf.map (add_monoid_hom.mul_right a₂) (continuous_id.mul continuous_const)
-
-lemma summable.mul_left (a) (hf : summable f) : summable (λb, a * f b) :=
-(hf.has_sum.mul_left _).summable
-
-lemma summable.mul_right (a) (hf : summable f) : summable (λb, f b * a) :=
-(hf.has_sum.mul_right _).summable
-
-section tsum
-variables [t2_space α]
-
-lemma summable.tsum_mul_left (a) (hf : summable f) : ∑'b, a * f b = a * ∑'b, f b :=
-(hf.has_sum.mul_left _).tsum_eq
-
-lemma summable.tsum_mul_right (a) (hf : summable f) : (∑'b, f b * a) = (∑'b, f b) * a :=
-(hf.has_sum.mul_right _).tsum_eq
-
-lemma commute.tsum_right (a) (h : ∀ b, commute a (f b)) : commute a (∑' b, f b) :=
-if hf : summable f then
-  (hf.tsum_mul_left a).symm.trans ((congr_arg _ $ funext h).trans (hf.tsum_mul_right a))
-else
-  (tsum_eq_zero_of_not_summable hf).symm ▸ commute.zero_right _
-
-lemma commute.tsum_left (a) (h : ∀ b, commute (f b) a) : commute (∑' b, f b) a :=
-(commute.tsum_right _ $ λ b, (h b).symm).symm
-
-end tsum
-
-end topological_semiring
-
-section const_smul
-variables {R : Type*}
-[monoid R]
-[topological_space α] [add_comm_monoid α]
-[distrib_mul_action R α] [has_continuous_const_smul R α]
-{f : β → α}
-
-lemma has_sum.const_smul {a : α} {r : R} (hf : has_sum f a) : has_sum (λ z, r • f z) (r • a) :=
-hf.map (distrib_mul_action.to_add_monoid_hom α r) (continuous_const_smul r)
-
-lemma summable.const_smul {r : R} (hf : summable f) : summable (λ z, r • f z) :=
-hf.has_sum.const_smul.summable
-
-lemma tsum_const_smul [t2_space α] {r : R} (hf : summable f) : ∑' z, r • f z = r • ∑' z, f z :=
-hf.has_sum.const_smul.tsum_eq
-
-end const_smul
-
-section smul_const
-variables {R : Type*}
-[semiring R] [topological_space R]
-[topological_space α] [add_comm_monoid α]
-[module R α] [has_continuous_smul R α]
-{f : β → R}
-
-lemma has_sum.smul_const {a : α} {r : R} (hf : has_sum f r) : has_sum (λ z, f z • a) (r • a) :=
-hf.map ((smul_add_hom R α).flip a) (continuous_id.smul continuous_const)
-
-lemma summable.smul_const {a : α} (hf : summable f) : summable (λ z, f z • a) :=
-hf.has_sum.smul_const.summable
-
-lemma tsum_smul_const [t2_space α] {a : α} (hf : summable f) : ∑' z, f z • a = (∑' z, f z) • a :=
-hf.has_sum.smul_const.tsum_eq
-
-end smul_const
-
-section division_ring
-
-variables [division_ring α] [topological_space α] [topological_ring α]
-{f g : β → α} {a a₁ a₂ : α}
-
-lemma has_sum.div_const (h : has_sum f a) (b : α) : has_sum (λ x, f x / b) (a / b) :=
-by simp only [div_eq_mul_inv, h.mul_right b⁻¹]
-
-lemma summable.div_const (h : summable f) (b : α) : summable (λ x, f x / b) :=
-(h.has_sum.div_const b).summable
-
-lemma has_sum_mul_left_iff (h : a₂ ≠ 0) : has_sum f a₁ ↔ has_sum (λb, a₂ * f b) (a₂ * a₁) :=
-⟨has_sum.mul_left _, λ H, by simpa only [inv_mul_cancel_left₀ h] using H.mul_left a₂⁻¹⟩
-
-lemma has_sum_mul_right_iff (h : a₂ ≠ 0) : has_sum f a₁ ↔ has_sum (λb, f b * a₂) (a₁ * a₂) :=
-⟨has_sum.mul_right _, λ H, by simpa only [mul_inv_cancel_right₀ h] using H.mul_right a₂⁻¹⟩
-
-lemma summable_mul_left_iff (h : a ≠ 0) : summable f ↔ summable (λb, a * f b) :=
-⟨λ H, H.mul_left _, λ H, by simpa only [inv_mul_cancel_left₀ h] using H.mul_left a⁻¹⟩
-
-lemma summable_mul_right_iff (h : a ≠ 0) : summable f ↔ summable (λb, f b * a) :=
-⟨λ H, H.mul_right _, λ H, by simpa only [mul_inv_cancel_right₀ h] using H.mul_right a⁻¹⟩
-
-lemma tsum_mul_left [t2_space α] : (∑' x, a * f x) = a * ∑' x, f x :=
-if hf : summable f then hf.tsum_mul_left a
-else if ha : a = 0 then by simp [ha]
-else by rw [tsum_eq_zero_of_not_summable hf,
-  tsum_eq_zero_of_not_summable (mt (summable_mul_left_iff ha).2 hf), mul_zero]
-
-lemma tsum_mul_right [t2_space α] : (∑' x, f x * a) = (∑' x, f x) * a :=
-if hf : summable f then hf.tsum_mul_right a
-else if ha : a = 0 then by simp [ha]
-else by rw [tsum_eq_zero_of_not_summable hf,
-  tsum_eq_zero_of_not_summable (mt (summable_mul_right_iff ha).2 hf), zero_mul]
-
-end division_ring
-
-section order_topology
-variables [ordered_add_comm_monoid α] [topological_space α] [order_closed_topology α]
-variables {f g : β → α} {a a₁ a₂ : α}
-
-lemma has_sum_le (h : ∀b, f b ≤ g b) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ ≤ a₂ :=
-le_of_tendsto_of_tendsto' hf hg $ assume s, sum_le_sum $ assume b _, h b
-
-@[mono] lemma has_sum_mono (hf : has_sum f a₁) (hg : has_sum g a₂) (h : f ≤ g) : a₁ ≤ a₂ :=
-has_sum_le h hf hg
-
-lemma has_sum_le_of_sum_le (hf : has_sum f a) (h : ∀ s : finset β, ∑ b in s, f b ≤ a₂) :
-  a ≤ a₂ :=
-le_of_tendsto' hf h
-
-lemma le_has_sum_of_le_sum (hf : has_sum f a) (h : ∀ s : finset β, a₂ ≤ ∑ b in s, f b) :
-  a₂ ≤ a :=
-ge_of_tendsto' hf h
-
-lemma has_sum_le_inj {g : γ → α} (i : β → γ) (hi : injective i) (hs : ∀c∉set.range i, 0 ≤ g c)
-  (h : ∀b, f b ≤ g (i b)) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ ≤ a₂ :=
-have has_sum (λc, (partial_inv i c).cases_on' 0 f) a₁,
-begin
-  refine (has_sum_iff_has_sum_of_ne_zero_bij (i ∘ coe) _ _ _).2 hf,
-  { exact assume c₁ c₂ eq, hi eq },
-  { intros c hc,
-    rw [mem_support] at hc,
-    cases eq : partial_inv i c with b; rw eq at hc,
-    { contradiction },
-    { rw [partial_inv_of_injective hi] at eq,
-      exact ⟨⟨b, hc⟩, eq⟩ } },
-  { assume c, simp [partial_inv_left hi, option.cases_on'] }
-end,
-begin
-  refine has_sum_le (assume c, _) this hg,
-  by_cases c ∈ set.range i,
-  { rcases h with ⟨b, rfl⟩,
-    rw [partial_inv_left hi, option.cases_on'],
-    exact h _ },
-  { have : partial_inv i c = none := dif_neg h,
-    rw [this, option.cases_on'],
-    exact hs _ h }
-end
-
-lemma tsum_le_tsum_of_inj {g : γ → α} (i : β → γ) (hi : injective i) (hs : ∀c∉set.range i, 0 ≤ g c)
-  (h : ∀b, f b ≤ g (i b)) (hf : summable f) (hg : summable g) : tsum f ≤ tsum g :=
-has_sum_le_inj i hi hs h hf.has_sum hg.has_sum
-
-lemma sum_le_has_sum (s : finset β) (hs : ∀ b∉s, 0 ≤ f b) (hf : has_sum f a) :
-  ∑ b in s, f b ≤ a :=
-ge_of_tendsto hf (eventually_at_top.2 ⟨s, λ t hst,
-  sum_le_sum_of_subset_of_nonneg hst $ λ b hbt hbs, hs b hbs⟩)
-
-lemma is_lub_has_sum (h : ∀ b, 0 ≤ f b) (hf : has_sum f a) :
-  is_lub (set.range (λ s : finset β, ∑ b in s, f b)) a :=
-is_lub_of_tendsto_at_top (finset.sum_mono_set_of_nonneg h) hf
-
-lemma le_has_sum (hf : has_sum f a) (b : β) (hb : ∀ b' ≠ b, 0 ≤ f b') : f b ≤ a :=
-calc f b = ∑ b in {b}, f b : finset.sum_singleton.symm
-... ≤ a : sum_le_has_sum _ (by { convert hb, simp }) hf
-
-lemma sum_le_tsum {f : β → α} (s : finset β) (hs : ∀ b∉s, 0 ≤ f b) (hf : summable f) :
-  ∑ b in s, f b ≤ ∑' b, f b :=
-sum_le_has_sum s hs hf.has_sum
-
-lemma le_tsum (hf : summable f) (b : β) (hb : ∀ b' ≠ b, 0 ≤ f b') : f b ≤ ∑' b, f b :=
-le_has_sum (summable.has_sum hf) b hb
-
-lemma tsum_le_tsum (h : ∀b, f b ≤ g b) (hf : summable f) (hg : summable g) : ∑'b, f b ≤ ∑'b, g b :=
-has_sum_le h hf.has_sum hg.has_sum
-
-@[mono] lemma tsum_mono (hf : summable f) (hg : summable g) (h : f ≤ g) :
-  ∑' n, f n ≤ ∑' n, g n :=
-tsum_le_tsum h hf hg
-
-lemma tsum_le_of_sum_le (hf : summable f) (h : ∀ s : finset β, ∑ b in s, f b ≤ a₂) :
-  ∑' b, f b ≤ a₂ :=
-has_sum_le_of_sum_le hf.has_sum h
-
-lemma tsum_le_of_sum_le' (ha₂ : 0 ≤ a₂) (h : ∀ s : finset β, ∑ b in s, f b ≤ a₂) :
-  ∑' b, f b ≤ a₂ :=
-begin
-  by_cases hf : summable f,
-  { exact tsum_le_of_sum_le hf h },
-  { rw tsum_eq_zero_of_not_summable hf,
-    exact ha₂ }
-end
-
-lemma has_sum.nonneg (h : ∀ b, 0 ≤ g b) (ha : has_sum g a) : 0 ≤ a :=
-has_sum_le h has_sum_zero ha
-
-lemma has_sum.nonpos (h : ∀ b, g b ≤ 0) (ha : has_sum g a) : a ≤ 0 :=
-has_sum_le h ha has_sum_zero
-
-lemma tsum_nonneg (h : ∀ b, 0 ≤ g b) : 0 ≤ ∑'b, g b :=
-begin
-  by_cases hg : summable g,
-  { exact hg.has_sum.nonneg h },
-  { simp [tsum_eq_zero_of_not_summable hg] }
-end
-
-lemma tsum_nonpos (h : ∀ b, f b ≤ 0) : ∑'b, f b ≤ 0 :=
-begin
-  by_cases hf : summable f,
-  { exact hf.has_sum.nonpos h },
-  { simp [tsum_eq_zero_of_not_summable hf] }
-end
-
-end order_topology
-
-section ordered_topological_group
-
-variables [ordered_add_comm_group α] [topological_space α] [topological_add_group α]
-  [order_closed_topology α] {f g : β → α} {a₁ a₂ : α}
-
-lemma has_sum_lt {i : β} (h : ∀ (b : β), f b ≤ g b) (hi : f i < g i)
-  (hf : has_sum f a₁) (hg : has_sum g a₂) :
-  a₁ < a₂ :=
-have update f i 0 ≤ update g i 0 := update_le_update_iff.mpr ⟨rfl.le, λ i _, h i⟩,
-have 0 - f i + a₁ ≤ 0 - g i + a₂ := has_sum_le this (hf.update i 0) (hg.update i 0),
-by simpa only [zero_sub, add_neg_cancel_left] using add_lt_add_of_lt_of_le hi this
-
-@[mono] lemma has_sum_strict_mono (hf : has_sum f a₁) (hg : has_sum g a₂) (h : f < g) : a₁ < a₂ :=
-let ⟨hle, i, hi⟩ := pi.lt_def.mp h in has_sum_lt hle hi hf hg
-
-lemma tsum_lt_tsum {i : β} (h : ∀ (b : β), f b ≤ g b) (hi : f i < g i)
-  (hf : summable f) (hg : summable g) :
-  ∑' n, f n < ∑' n, g n :=
-has_sum_lt h hi hf.has_sum hg.has_sum
-
-@[mono] lemma tsum_strict_mono (hf : summable f) (hg : summable g) (h : f < g) :
-  ∑' n, f n < ∑' n, g n :=
-let ⟨hle, i, hi⟩ := pi.lt_def.mp h in tsum_lt_tsum hle hi hf hg
-
-lemma tsum_pos (hsum : summable g) (hg : ∀ b, 0 ≤ g b) (i : β) (hi : 0 < g i) :
-  0 < ∑' b, g b :=
-by { rw ← tsum_zero, exact tsum_lt_tsum hg hi summable_zero hsum }
-
-lemma has_sum_zero_iff_of_nonneg (hf : ∀ i, 0 ≤ f i) : has_sum f 0 ↔ f = 0 :=
-begin
-  split,
-  { intros hf',
-    ext i,
-    by_contra hi',
-    have hi : 0 < f i := lt_of_le_of_ne (hf i) (ne.symm hi'),
-    simpa using has_sum_lt hf hi has_sum_zero hf' },
-  { rintros rfl,
-    exact has_sum_zero },
-end
-
-end ordered_topological_group
-
-section canonically_ordered
-variables [canonically_ordered_add_monoid α] [topological_space α] [order_closed_topology α]
-variables {f : β → α} {a : α}
-
-lemma le_has_sum' (hf : has_sum f a) (b : β) : f b ≤ a :=
-le_has_sum hf b $ λ _ _, zero_le _
-
-lemma le_tsum' (hf : summable f) (b : β) : f b ≤ ∑' b, f b :=
-le_tsum hf b $ λ _ _, zero_le _
-
-lemma has_sum_zero_iff : has_sum f 0 ↔ ∀ x, f x = 0 :=
-begin
-  refine ⟨_, λ h, _⟩,
-  { contrapose!,
-    exact λ ⟨x, hx⟩ h, irrefl _ (lt_of_lt_of_le (pos_iff_ne_zero.2 hx) (le_has_sum' h x)) },
-  { convert has_sum_zero,
-    exact funext h }
-end
-
-lemma tsum_eq_zero_iff (hf : summable f) : ∑' i, f i = 0 ↔ ∀ x, f x = 0 :=
-by rw [←has_sum_zero_iff, hf.has_sum_iff]
-
-lemma tsum_ne_zero_iff (hf : summable f) : ∑' i, f i ≠ 0 ↔ ∃ x, f x ≠ 0 :=
-by rw [ne.def, tsum_eq_zero_iff hf, not_forall]
-
-lemma is_lub_has_sum' (hf : has_sum f a) : is_lub (set.range (λ s : finset β, ∑ b in s, f b)) a :=
-is_lub_of_tendsto_at_top (finset.sum_mono_set f) hf
-
-end canonically_ordered
-
-section uniform_group
-
-variables [add_comm_group α] [uniform_space α]
-
-/-- The **Cauchy criterion** for infinite sums, also known as the **Cauchy convergence test** -/
-lemma summable_iff_cauchy_seq_finset [complete_space α] {f : β → α} :
-  summable f ↔ cauchy_seq (λ (s : finset β), ∑ b in s, f b) :=
-cauchy_map_iff_exists_tendsto.symm
-
-variables [uniform_add_group α] {f g : β → α} {a a₁ a₂ : α}
-
-lemma cauchy_seq_finset_iff_vanishing :
-  cauchy_seq (λ (s : finset β), ∑ b in s, f b)
-  ↔ ∀ e ∈ 𝓝 (0:α), (∃s:finset β, ∀t, disjoint t s → ∑ b in t, f b ∈ e) :=
-begin
-  simp only [cauchy_seq, cauchy_map_iff, and_iff_right at_top_ne_bot,
-    prod_at_top_at_top_eq, uniformity_eq_comap_nhds_zero α, tendsto_comap_iff, (∘)],
-  rw [tendsto_at_top'],
-  split,
-  { assume h e he,
-    rcases h e he with ⟨⟨s₁, s₂⟩, h⟩,
-    use [s₁ ∪ s₂],
-    assume t ht,
-    specialize h (s₁ ∪ s₂, (s₁ ∪ s₂) ∪ t) ⟨le_sup_left, le_sup_of_le_left le_sup_right⟩,
-    simpa only [finset.sum_union ht.symm, add_sub_cancel'] using h },
-  { assume h e he,
-    rcases exists_nhds_half_neg he with ⟨d, hd, hde⟩,
-    rcases h d hd with ⟨s, h⟩,
-    use [(s, s)],
-    rintros ⟨t₁, t₂⟩ ⟨ht₁, ht₂⟩,
-    have : ∑ b in t₂, f b - ∑ b in t₁, f b = ∑ b in t₂ \ s, f b - ∑ b in t₁ \ s, f b,
-    { simp only [(finset.sum_sdiff ht₁).symm, (finset.sum_sdiff ht₂).symm,
-        add_sub_add_right_eq_sub] },
-    simp only [this],
-    exact hde _ (h _ finset.sdiff_disjoint) _ (h _ finset.sdiff_disjoint) }
-end
-
-local attribute [instance] topological_add_group.regular_space
-
-/-- The sum over the complement of a finset tends to `0` when the finset grows to cover the whole
-space. This does not need a summability assumption, as otherwise all sums are zero. -/
-lemma tendsto_tsum_compl_at_top_zero [t1_space α] (f : β → α) :
-  tendsto (λ (s : finset β), ∑' b : {x // x ∉ s}, f b) at_top (𝓝 0) :=
-begin
-  by_cases H : summable f,
-  { assume e he,
-    rcases nhds_is_closed he with ⟨o, ho, oe, o_closed⟩,
-    simp only [le_eq_subset, set.mem_preimage, mem_at_top_sets, filter.mem_map, ge_iff_le],
-    obtain ⟨s, hs⟩ : ∃ (s : finset β), ∀ (t : finset β), disjoint t s → ∑ (b : β) in t, f b ∈ o :=
-      cauchy_seq_finset_iff_vanishing.1 (tendsto.cauchy_seq H.has_sum) o ho,
-    refine ⟨s, λ a sa, oe _⟩,
-    have A : summable (λ b : {x // x ∉ a}, f b) := a.summable_compl_iff.2 H,
-    apply is_closed.mem_of_tendsto o_closed A.has_sum (eventually_of_forall (λ b, _)),
-    have : disjoint (finset.image (λ (i : {x // x ∉ a}), (i : β)) b) s,
-    { apply disjoint_left.2 (λ i hi his, _),
-      rcases mem_image.1 hi with ⟨i', hi', rfl⟩,
-      exact i'.2 (sa his), },
-    convert hs _ this using 1,
-    rw sum_image,
-    assume i hi j hj hij,
-    exact subtype.ext hij },
-  { convert tendsto_const_nhds,
-    ext s,
-    apply tsum_eq_zero_of_not_summable,
-    rwa finset.summable_compl_iff }
-end
-
-variable [complete_space α]
-
-lemma summable_iff_vanishing :
-  summable f ↔ ∀ e ∈ 𝓝 (0:α), (∃s:finset β, ∀t, disjoint t s → ∑ b in t, f b ∈ e) :=
-by rw [summable_iff_cauchy_seq_finset, cauchy_seq_finset_iff_vanishing]
-
-/- TODO: generalize to monoid with a uniform continuous subtraction operator: `(a + b) - b = a` -/
-lemma summable.summable_of_eq_zero_or_self (hf : summable f) (h : ∀b, g b = 0 ∨ g b = f b) :
-  summable g :=
-summable_iff_vanishing.2 $
-  assume e he,
-  let ⟨s, hs⟩ := summable_iff_vanishing.1 hf e he in
-  ⟨s, assume t ht,
-    have eq : ∑ b in t.filter (λb, g b = f b), f b = ∑ b in t, g b :=
-      calc ∑ b in t.filter (λb, g b = f b), f b = ∑ b in t.filter (λb, g b = f b), g b :
-          finset.sum_congr rfl (assume b hb, (finset.mem_filter.1 hb).2.symm)
-        ... = ∑ b in t, g b :
-        begin
-          refine finset.sum_subset (finset.filter_subset _ _) _,
-          assume b hbt hb,
-          simp only [(∉), finset.mem_filter, and_iff_right hbt] at hb,
-          exact (h b).resolve_right hb
-        end,
-    eq ▸ hs _ $ finset.disjoint_of_subset_left (finset.filter_subset _ _) ht⟩
-
-protected lemma summable.indicator (hf : summable f) (s : set β) :
-  summable (s.indicator f) :=
-hf.summable_of_eq_zero_or_self $ set.indicator_eq_zero_or_self _ _
-
-lemma summable.comp_injective {i : γ → β} (hf : summable f) (hi : injective i) :
-  summable (f ∘ i) :=
-begin
-  simpa only [set.indicator_range_comp]
-    using (hi.summable_iff _).2 (hf.indicator (set.range i)),
-  exact λ x hx, set.indicator_of_not_mem hx _
-end
-
-lemma summable.subtype (hf : summable f) (s : set β) : summable (f ∘ coe : s → α) :=
-hf.comp_injective subtype.coe_injective
-
-lemma summable_subtype_and_compl {s : set β} :
-  summable (λ x : s, f x) ∧ summable (λ x : sᶜ, f x) ↔ summable f :=
-⟨and_imp.2 summable.add_compl, λ h, ⟨h.subtype s, h.subtype sᶜ⟩⟩
-
-lemma summable.sigma_factor {γ : β → Type*} {f : (Σb:β, γ b) → α}
-  (ha : summable f) (b : β) : summable (λc, f ⟨b, c⟩) :=
-ha.comp_injective sigma_mk_injective
-
-lemma summable.sigma [t1_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
-  (ha : summable f) : summable (λb, ∑'c, f ⟨b, c⟩) :=
-ha.sigma' (λ b, ha.sigma_factor b)
-
-lemma summable.prod_factor {f : β × γ → α} (h : summable f) (b : β) :
-  summable (λ c, f (b, c)) :=
-h.comp_injective $ λ c₁ c₂ h, (prod.ext_iff.1 h).2
-
-lemma tsum_sigma [t1_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
-  (ha : summable f) : ∑'p, f p = ∑'b c, f ⟨b, c⟩ :=
-tsum_sigma' (λ b, ha.sigma_factor b) ha
-
-lemma tsum_prod [t1_space α] {f : β × γ → α} (h : summable f) :
-  ∑'p, f p = ∑'b c, f ⟨b, c⟩ :=
-tsum_prod' h h.prod_factor
-
-lemma tsum_comm [t1_space α] {f : β → γ → α} (h : summable (function.uncurry f)) :
-  ∑' c b, f b c = ∑' b c, f b c :=
-tsum_comm' h h.prod_factor h.prod_symm.prod_factor
-
-end uniform_group
-
-section topological_group
-
-variables {G : Type*} [topological_space G] [add_comm_group G] [topological_add_group G]
-  {f : α → G}
-
-lemma summable.vanishing (hf : summable f) ⦃e : set G⦄ (he : e ∈ 𝓝 (0 : G)) :
-  ∃ s : finset α, ∀ t, disjoint t s → ∑ k in t, f k ∈ e :=
-begin
-  letI : uniform_space G := topological_add_group.to_uniform_space G,
-  letI : uniform_add_group G := topological_add_group_is_uniform,
-  rcases hf with ⟨y, hy⟩,
-  exact cauchy_seq_finset_iff_vanishing.1 hy.cauchy_seq e he
-end
-
-/-- Series divergence test: if `f` is a convergent series, then `f x` tends to zero along
-`cofinite`. -/
-lemma summable.tendsto_cofinite_zero (hf : summable f) : tendsto f cofinite (𝓝 0) :=
-begin
-  intros e he,
-  rw [filter.mem_map],
-  rcases hf.vanishing he with ⟨s, hs⟩,
-  refine s.eventually_cofinite_nmem.mono (λ x hx, _),
-  by simpa using hs {x} (disjoint_singleton_left.2 hx)
-end
-
-lemma summable.tendsto_at_top_zero {f : ℕ → G} (hf : summable f) : tendsto f at_top (𝓝 0) :=
-by { rw ←nat.cofinite_eq_at_top, exact hf.tendsto_cofinite_zero }
-
-lemma summable.tendsto_top_of_pos {α : Type*}
-  [linear_ordered_field α] [topological_space α] [order_topology α] {f : ℕ → α}
-  (hf : summable f⁻¹) (hf' : ∀ n, 0 < f n) : tendsto f at_top at_top :=
-begin
-  rw [show f = f⁻¹⁻¹, by { ext, simp }],
-  apply filter.tendsto.inv_tendsto_zero,
-  apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
-    (summable.tendsto_at_top_zero hf),
-  rw eventually_iff_exists_mem,
-  refine ⟨set.Ioi 0, Ioi_mem_at_top _, λ _ _, _⟩,
-  rw [set.mem_Ioi, inv_eq_one_div, one_div, pi.inv_apply, _root_.inv_pos],
-  exact hf' _,
-end
-
-end topological_group
-
-section linear_order
-
-/-! For infinite sums taking values in a linearly ordered monoid, the existence of a least upper
-bound for the finite sums is a criterion for summability.
-
-This criterion is useful when applied in a linearly ordered monoid which is also a complete or
-conditionally complete linear order, such as `ℝ`, `ℝ≥0`, `ℝ≥0∞`, because it is then easy to check
-the existence of a least upper bound.
--/
-
-lemma has_sum_of_is_lub_of_nonneg [linear_ordered_add_comm_monoid β] [topological_space β]
-  [order_topology β] {f : α → β} (b : β) (h : ∀ b, 0 ≤ f b)
-  (hf : is_lub (set.range (λ s, ∑ a in s, f a)) b) :
-  has_sum f b :=
-tendsto_at_top_is_lub (finset.sum_mono_set_of_nonneg h) hf
-
-lemma has_sum_of_is_lub [canonically_linear_ordered_add_monoid β] [topological_space β]
-   [order_topology β] {f : α → β} (b : β) (hf : is_lub (set.range (λ s, ∑ a in s, f a)) b) :
-  has_sum f b :=
-tendsto_at_top_is_lub (finset.sum_mono_set f) hf
-
-lemma summable_abs_iff [linear_ordered_add_comm_group β] [uniform_space β]
-  [uniform_add_group β] [complete_space β] {f : α → β} :
-  summable (λ x, |f x|) ↔ summable f :=
-have h1 : ∀ x : {x | 0 ≤ f x}, |f x| = f x := λ x, abs_of_nonneg x.2,
-have h2 : ∀ x : {x | 0 ≤ f x}ᶜ, |f x| = -f x := λ x, abs_of_neg (not_le.1 x.2),
-calc summable (λ x, |f x|) ↔
-  summable (λ x : {x | 0 ≤ f x}, |f x|) ∧ summable (λ x : {x | 0 ≤ f x}ᶜ, |f x|) :
-  summable_subtype_and_compl.symm
-... ↔ summable (λ x : {x | 0 ≤ f x}, f x) ∧ summable (λ x : {x | 0 ≤ f x}ᶜ, -f x) :
-  by simp only [h1, h2]
-... ↔ _ : by simp only [summable_neg_iff, summable_subtype_and_compl]
-
-alias summable_abs_iff ↔ summable.of_abs summable.abs
-
-lemma finite_of_summable_const [linear_ordered_add_comm_group β] [archimedean β]
-  [topological_space β] [order_closed_topology β] {b : β} (hb : 0 < b)
-  (hf : summable (λ a : α, b)) :
-  set.finite (set.univ : set α) :=
-begin
-  have H : ∀ s : finset α, s.card • b ≤ ∑' a : α, b,
-  { intros s,
-    simpa using sum_le_has_sum s (λ a ha, hb.le) hf.has_sum },
-  obtain ⟨n, hn⟩ := archimedean.arch (∑' a : α, b) hb,
-  have : ∀ s : finset α, s.card ≤ n,
-  { intros s,
-    simpa [nsmul_le_nsmul_iff hb] using (H s).trans hn },
-  haveI : fintype α := fintype_of_finset_card_le n this,
-  exact set.finite_univ
-end
-
-end linear_order
-
-section cauchy_seq
-open filter
-
-/-- If the extended distance between consecutive points of a sequence is estimated
-by a summable series of `nnreal`s, then the original sequence is a Cauchy sequence. -/
-lemma cauchy_seq_of_edist_le_of_summable [pseudo_emetric_space α] {f : ℕ → α} (d : ℕ → ℝ≥0)
-  (hf : ∀ n, edist (f n) (f n.succ) ≤ d n) (hd : summable d) : cauchy_seq f :=
-begin
-  refine emetric.cauchy_seq_iff_nnreal.2 (λ ε εpos, _),
-  -- Actually we need partial sums of `d` to be a Cauchy sequence
-  replace hd : cauchy_seq (λ (n : ℕ), ∑ x in range n, d x) :=
-    let ⟨_, H⟩ := hd in H.tendsto_sum_nat.cauchy_seq,
-  -- Now we take the same `N` as in one of the definitions of a Cauchy sequence
-  refine (metric.cauchy_seq_iff'.1 hd ε (nnreal.coe_pos.2 εpos)).imp (λ N hN n hn, _),
-  have hsum := hN n hn,
-  -- We simplify the known inequality
-  rw [dist_nndist, nnreal.nndist_eq, ← sum_range_add_sum_Ico _ hn, add_tsub_cancel_left] at hsum,
-  norm_cast at hsum,
-  replace hsum := lt_of_le_of_lt (le_max_left _ _) hsum,
-  rw edist_comm,
-  -- Then use `hf` to simplify the goal to the same form
-  apply lt_of_le_of_lt (edist_le_Ico_sum_of_edist_le hn (λ k _ _, hf k)),
-  assumption_mod_cast
-end
-
-/-- If the distance between consecutive points of a sequence is estimated by a summable series,
-then the original sequence is a Cauchy sequence. -/
-lemma cauchy_seq_of_dist_le_of_summable [pseudo_metric_space α] {f : ℕ → α} (d : ℕ → ℝ)
-  (hf : ∀ n, dist (f n) (f n.succ) ≤ d n) (hd : summable d) : cauchy_seq f :=
-begin
-  refine metric.cauchy_seq_iff'.2 (λε εpos, _),
-  replace hd : cauchy_seq (λ (n : ℕ), ∑ x in range n, d x) :=
-    let ⟨_, H⟩ := hd in H.tendsto_sum_nat.cauchy_seq,
-  refine (metric.cauchy_seq_iff'.1 hd ε εpos).imp (λ N hN n hn, _),
-  have hsum := hN n hn,
-  rw [real.dist_eq, ← sum_Ico_eq_sub _ hn] at hsum,
-  calc dist (f n) (f N) = dist (f N) (f n) : dist_comm _ _
-  ... ≤ ∑ x in Ico N n, d x : dist_le_Ico_sum_of_dist_le hn (λ k _ _, hf k)
-  ... ≤ |∑ x in Ico N n, d x| : le_abs_self _
-  ... < ε : hsum
-end
-
-lemma cauchy_seq_of_summable_dist [pseudo_metric_space α] {f : ℕ → α}
-  (h : summable (λn, dist (f n) (f n.succ))) : cauchy_seq f :=
-cauchy_seq_of_dist_le_of_summable _ (λ _, le_rfl) h
-
-lemma dist_le_tsum_of_dist_le_of_tendsto [pseudo_metric_space α] {f : ℕ → α} (d : ℕ → ℝ)
-  (hf : ∀ n, dist (f n) (f n.succ) ≤ d n) (hd : summable d) {a : α} (ha : tendsto f at_top (𝓝 a))
-  (n : ℕ) :
-  dist (f n) a ≤ ∑' m, d (n + m) :=
-begin
-  refine le_of_tendsto (tendsto_const_nhds.dist ha)
-    (eventually_at_top.2 ⟨n, λ m hnm, _⟩),
-  refine le_trans (dist_le_Ico_sum_of_dist_le hnm (λ k _ _, hf k)) _,
-  rw [sum_Ico_eq_sum_range],
-  refine sum_le_tsum (range _) (λ _ _, le_trans dist_nonneg (hf _)) _,
-  exact hd.comp_injective (add_right_injective n)
-end
-
-lemma dist_le_tsum_of_dist_le_of_tendsto₀ [pseudo_metric_space α] {f : ℕ → α} (d : ℕ → ℝ)
-  (hf : ∀ n, dist (f n) (f n.succ) ≤ d n) (hd : summable d) {a : α} (ha : tendsto f at_top (𝓝 a)) :
-  dist (f 0) a ≤ tsum d :=
-by simpa only [zero_add] using dist_le_tsum_of_dist_le_of_tendsto d hf hd ha 0
-
-lemma dist_le_tsum_dist_of_tendsto [pseudo_metric_space α] {f : ℕ → α}
-  (h : summable (λn, dist (f n) (f n.succ))) {a : α} (ha : tendsto f at_top (𝓝 a)) (n) :
-  dist (f n) a ≤ ∑' m, dist (f (n+m)) (f (n+m).succ) :=
-show dist (f n) a ≤ ∑' m, (λx, dist (f x) (f x.succ)) (n + m), from
-dist_le_tsum_of_dist_le_of_tendsto (λ n, dist (f n) (f n.succ)) (λ _, le_rfl) h ha n
-
-lemma dist_le_tsum_dist_of_tendsto₀ [pseudo_metric_space α] {f : ℕ → α}
-  (h : summable (λn, dist (f n) (f n.succ))) {a : α} (ha : tendsto f at_top (𝓝 a)) :
-  dist (f 0) a ≤ ∑' n, dist (f n) (f n.succ) :=
-by simpa only [zero_add] using dist_le_tsum_dist_of_tendsto h ha 0
-
-end cauchy_seq
-
-/-! ## Multipliying two infinite sums
-
-In this section, we prove various results about `(∑' x : β, f x) * (∑' y : γ, g y)`. Note that we
-always assume that the family `λ x : β × γ, f x.1 * g x.2` is summable, since there is no way to
-deduce this from the summmabilities of `f` and `g` in general, but if you are working in a normed
-space, you may want to use the analogous lemmas in `analysis/normed_space/basic`
-(e.g `tsum_mul_tsum_of_summable_norm`).
-
-We first establish results about arbitrary index types, `β` and `γ`, and then we specialize to
-`β = γ = ℕ` to prove the Cauchy product formula (see `tsum_mul_tsum_eq_tsum_sum_antidiagonal`).
-
-### Arbitrary index types
--/
-
-section tsum_mul_tsum
-
-variables [topological_space α] [regular_space α] [non_unital_non_assoc_semiring α]
-  [topological_semiring α] {f : β → α} {g : γ → α} {s t u : α}
-
-lemma has_sum.mul_eq (hf : has_sum f s) (hg : has_sum g t)
-  (hfg : has_sum (λ (x : β × γ), f x.1 * g x.2) u) :
-  s * t = u :=
-have key₁ : has_sum (λ b, f b * t) (s * t),
-  from hf.mul_right t,
-have this : ∀ b : β, has_sum (λ c : γ, f b * g c) (f b * t),
-  from λ b, hg.mul_left (f b),
-have key₂ : has_sum (λ b, f b * t) u,
-  from has_sum.prod_fiberwise hfg this,
-key₁.unique key₂
-
-lemma has_sum.mul (hf : has_sum f s) (hg : has_sum g t)
-  (hfg : summable (λ (x : β × γ), f x.1 * g x.2)) :
-  has_sum (λ (x : β × γ), f x.1 * g x.2) (s * t) :=
-let ⟨u, hu⟩ := hfg in
-(hf.mul_eq hg hu).symm ▸ hu
-
-/-- Product of two infinites sums indexed by arbitrary types.
-    See also `tsum_mul_tsum_of_summable_norm` if `f` and `g` are abolutely summable. -/
-lemma tsum_mul_tsum (hf : summable f) (hg : summable g)
-  (hfg : summable (λ (x : β × γ), f x.1 * g x.2)) :
-  (∑' x, f x) * (∑' y, g y) = (∑' z : β × γ, f z.1 * g z.2) :=
-hf.has_sum.mul_eq hg.has_sum hfg.has_sum
-
-end tsum_mul_tsum
-
-section cauchy_product
-
-/-! ### `ℕ`-indexed families (Cauchy product)
-
-We prove two versions of the Cauchy product formula. The first one is
-`tsum_mul_tsum_eq_tsum_sum_range`, where the `n`-th term is a sum over `finset.range (n+1)`
-involving `nat` substraction.
-In order to avoid `nat` substraction, we also provide `tsum_mul_tsum_eq_tsum_sum_antidiagonal`,
-where the `n`-th term is a sum over all pairs `(k, l)` such that `k+l=n`, which corresponds to the
-`finset` `finset.nat.antidiagonal n` -/
-
-variables {f : ℕ → α} {g : ℕ → α}
-
-open finset
-
-variables [topological_space α] [non_unital_non_assoc_semiring α]
-
-/- The family `(k, l) : ℕ × ℕ ↦ f k * g l` is summable if and only if the family
-`(n, k, l) : Σ (n : ℕ), nat.antidiagonal n ↦ f k * g l` is summable. -/
-lemma summable_mul_prod_iff_summable_mul_sigma_antidiagonal {f g : ℕ → α} :
-  summable (λ x : ℕ × ℕ, f x.1 * g x.2) ↔
-  summable (λ x : (Σ (n : ℕ), nat.antidiagonal n), f (x.2 : ℕ × ℕ).1 * g (x.2 : ℕ × ℕ).2) :=
-nat.sigma_antidiagonal_equiv_prod.summable_iff.symm
-
-variables [regular_space α] [topological_semiring α]
-
-lemma summable_sum_mul_antidiagonal_of_summable_mul {f g : ℕ → α}
-  (h : summable (λ x : ℕ × ℕ, f x.1 * g x.2)) :
-  summable (λ n, ∑ kl in nat.antidiagonal n, f kl.1 * g kl.2) :=
-begin
-  rw summable_mul_prod_iff_summable_mul_sigma_antidiagonal at h,
-  conv {congr, funext, rw [← finset.sum_finset_coe, ← tsum_fintype]},
-  exact h.sigma' (λ n, (has_sum_fintype _).summable),
-end
-
-/-- The Cauchy product formula for the product of two infinites sums indexed by `ℕ`,
-    expressed by summing on `finset.nat.antidiagonal`.
-    See also `tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm`
-    if `f` and `g` are absolutely summable. -/
-lemma tsum_mul_tsum_eq_tsum_sum_antidiagonal (hf : summable f) (hg : summable g)
-  (hfg : summable (λ (x : ℕ × ℕ), f x.1 * g x.2)) :
-  (∑' n, f n) * (∑' n, g n) = (∑' n, ∑ kl in nat.antidiagonal n, f kl.1 * g kl.2) :=
-begin
-  conv_rhs {congr, funext, rw [← finset.sum_finset_coe, ← tsum_fintype]},
-  rw [tsum_mul_tsum hf hg hfg, ← nat.sigma_antidiagonal_equiv_prod.tsum_eq (_ : ℕ × ℕ → α)],
-  exact tsum_sigma' (λ n, (has_sum_fintype _).summable)
-    (summable_mul_prod_iff_summable_mul_sigma_antidiagonal.mp hfg)
-end
-
-lemma summable_sum_mul_range_of_summable_mul {f g : ℕ → α}
-  (h : summable (λ x : ℕ × ℕ, f x.1 * g x.2)) :
-  summable (λ n, ∑ k in range (n+1), f k * g (n - k)) :=
-begin
-  simp_rw ← nat.sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l),
-  exact summable_sum_mul_antidiagonal_of_summable_mul h
-end
-
-/-- The Cauchy product formula for the product of two infinites sums indexed by `ℕ`,
-    expressed by summing on `finset.range`.
-    See also `tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm`
-    if `f` and `g` are absolutely summable. -/
-lemma tsum_mul_tsum_eq_tsum_sum_range (hf : summable f) (hg : summable g)
-  (hfg : summable (λ (x : ℕ × ℕ), f x.1 * g x.2)) :
-  (∑' n, f n) * (∑' n, g n) = (∑' n, ∑ k in range (n+1), f k * g (n - k)) :=
-begin
-  simp_rw ← nat.sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l),
-  exact tsum_mul_tsum_eq_tsum_sum_antidiagonal hf hg hfg
-end
-
-end cauchy_product
diff --git a/src/topology/algebra/infinite_sum/basic.lean b/src/topology/algebra/infinite_sum/basic.lean
new file mode 100644
index 0000000000000..69334b3838d57
--- /dev/null
+++ b/src/topology/algebra/infinite_sum/basic.lean
@@ -0,0 +1,1399 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import data.nat.parity
+import logic.encodable.lattice
+import topology.algebra.uniform_group
+import topology.algebra.star
+
+/-!
+# Infinite sum over a topological monoid
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This sum is known as unconditionally convergent, as it sums to the same value under all possible
+permutations. For Euclidean spaces (finite dimensional Banach spaces) this is equivalent to absolute
+convergence.
+
+Note: There are summable sequences which are not unconditionally convergent! The other way holds
+generally, see `has_sum.tendsto_sum_nat`.
+
+## References
+
+* Bourbaki: General Topology (1995), Chapter 3 §5 (Infinite sums in commutative groups)
+
+-/
+
+noncomputable theory
+open classical filter finset function
+open_locale big_operators classical topology
+
+variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
+
+section has_sum
+variables [add_comm_monoid α] [topological_space α]
+
+/-- Infinite sum on a topological monoid
+
+The `at_top` filter on `finset β` is the limit of all finite sets towards the entire type. So we sum
+up bigger and bigger sets. This sum operation is invariant under reordering. In particular,
+the function `ℕ → ℝ` sending `n` to `(-1)^n / (n+1)` does not have a
+sum for this definition, but a series which is absolutely convergent will have the correct sum.
+
+This is based on Mario Carneiro's
+[infinite sum `df-tsms` in Metamath](http://us.metamath.org/mpeuni/df-tsms.html).
+
+For the definition or many statements, `α` does not need to be a topological monoid. We only add
+this assumption later, for the lemmas where it is relevant.
+-/
+def has_sum (f : β → α) (a : α) : Prop := tendsto (λs:finset β, ∑ b in s, f b) at_top (𝓝 a)
+
+/-- `summable f` means that `f` has some (infinite) sum. Use `tsum` to get the value. -/
+def summable (f : β → α) : Prop := ∃a, has_sum f a
+
+/-- `∑' i, f i` is the sum of `f` it exists, or 0 otherwise -/
+@[irreducible] def tsum {β} (f : β → α) := if h : summable f then classical.some h else 0
+
+-- see Note [operator precedence of big operators]
+notation `∑'` binders `, ` r:(scoped:67 f, tsum f) := r
+
+variables {f g : β → α} {a b : α} {s : finset β}
+
+lemma summable.has_sum (ha : summable f) : has_sum f (∑'b, f b) :=
+by simp [ha, tsum]; exact some_spec ha
+
+lemma has_sum.summable (h : has_sum f a) : summable f := ⟨a, h⟩
+
+/-- Constant zero function has sum `0` -/
+lemma has_sum_zero : has_sum (λb, 0 : β → α) 0 :=
+by simp [has_sum, tendsto_const_nhds]
+
+lemma has_sum_empty [is_empty β] : has_sum f 0 :=
+by convert has_sum_zero
+
+lemma summable_zero : summable (λb, 0 : β → α) := has_sum_zero.summable
+
+lemma summable_empty [is_empty β] : summable f := has_sum_empty.summable
+
+lemma tsum_eq_zero_of_not_summable (h : ¬ summable f) : ∑'b, f b = 0 :=
+by simp [tsum, h]
+
+lemma summable_congr (hfg : ∀b, f b = g b) :
+  summable f ↔ summable g :=
+iff_of_eq (congr_arg summable $ funext hfg)
+
+lemma summable.congr (hf : summable f) (hfg : ∀b, f b = g b) :
+  summable g :=
+(summable_congr hfg).mp hf
+
+lemma has_sum.has_sum_of_sum_eq {g : γ → α}
+  (h_eq : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ ∑ x in u', g x = ∑ b in v', f b)
+  (hf : has_sum g a) :
+  has_sum f a :=
+le_trans (map_at_top_finset_sum_le_of_sum_eq h_eq) hf
+
+lemma has_sum_iff_has_sum {g : γ → α}
+  (h₁ : ∀u:finset γ, ∃v:finset β, ∀v', v ⊆ v' → ∃u', u ⊆ u' ∧ ∑ x in u', g x = ∑ b in v', f b)
+  (h₂ : ∀v:finset β, ∃u:finset γ, ∀u', u ⊆ u' → ∃v', v ⊆ v' ∧ ∑ b in v', f b = ∑ x in u', g x) :
+  has_sum f a ↔ has_sum g a :=
+⟨has_sum.has_sum_of_sum_eq h₂, has_sum.has_sum_of_sum_eq h₁⟩
+
+lemma function.injective.has_sum_iff {g : γ → β} (hg : injective g)
+  (hf : ∀ x ∉ set.range g, f x = 0) :
+  has_sum (f ∘ g) a ↔ has_sum f a :=
+by simp only [has_sum, tendsto, hg.map_at_top_finset_sum_eq hf]
+
+lemma function.injective.summable_iff {g : γ → β} (hg : injective g)
+  (hf : ∀ x ∉ set.range g, f x = 0) :
+  summable (f ∘ g) ↔ summable f :=
+exists_congr $ λ _, hg.has_sum_iff hf
+
+lemma has_sum_subtype_iff_of_support_subset {s : set β} (hf : support f ⊆ s) :
+  has_sum (f ∘ coe : s → α) a ↔ has_sum f a :=
+subtype.coe_injective.has_sum_iff $ by simpa using support_subset_iff'.1 hf
+
+lemma has_sum_subtype_iff_indicator {s : set β} :
+  has_sum (f ∘ coe : s → α) a ↔ has_sum (s.indicator f) a :=
+by rw [← set.indicator_range_comp, subtype.range_coe,
+  has_sum_subtype_iff_of_support_subset set.support_indicator_subset]
+
+lemma summable_subtype_iff_indicator {s : set β} :
+  summable (f ∘ coe : s → α) ↔ summable (s.indicator f) :=
+exists_congr (λ _, has_sum_subtype_iff_indicator)
+
+@[simp] lemma has_sum_subtype_support : has_sum (f ∘ coe : support f → α) a ↔ has_sum f a :=
+has_sum_subtype_iff_of_support_subset $ set.subset.refl _
+
+lemma has_sum_fintype [fintype β] (f : β → α) : has_sum f (∑ b, f b) :=
+order_top.tendsto_at_top_nhds _
+
+protected lemma finset.has_sum (s : finset β) (f : β → α) :
+  has_sum (f ∘ coe : (↑s : set β) → α) (∑ b in s, f b) :=
+by { rw ← sum_attach, exact has_sum_fintype _ }
+
+protected lemma finset.summable (s : finset β) (f : β → α) :
+  summable (f ∘ coe : (↑s : set β) → α) :=
+(s.has_sum f).summable
+
+protected lemma set.finite.summable {s : set β} (hs : s.finite) (f : β → α) :
+  summable (f ∘ coe : s → α) :=
+by convert hs.to_finset.summable f; simp only [hs.coe_to_finset]
+
+/-- If a function `f` vanishes outside of a finite set `s`, then it `has_sum` `∑ b in s, f b`. -/
+lemma has_sum_sum_of_ne_finset_zero (hf : ∀b∉s, f b = 0) : has_sum f (∑ b in s, f b) :=
+(has_sum_subtype_iff_of_support_subset $ support_subset_iff'.2 hf).1 $ s.has_sum f
+
+lemma summable_of_ne_finset_zero (hf : ∀b∉s, f b = 0) : summable f :=
+(has_sum_sum_of_ne_finset_zero hf).summable
+
+lemma has_sum_single {f : β → α} (b : β) (hf : ∀b' ≠ b, f b' = 0) :
+  has_sum f (f b) :=
+suffices has_sum f (∑ b' in {b}, f b'),
+  by simpa using this,
+has_sum_sum_of_ne_finset_zero $ by simpa [hf]
+
+lemma has_sum_ite_eq (b : β) [decidable_pred (= b)] (a : α) :
+  has_sum (λb', if b' = b then a else 0) a :=
+begin
+  convert has_sum_single b _,
+  { exact (if_pos rfl).symm },
+  assume b' hb',
+  exact if_neg hb'
+end
+
+lemma has_sum_pi_single [decidable_eq β] (b : β) (a : α) :
+  has_sum (pi.single b a) a :=
+show has_sum (λ x, pi.single b a x) a, by simpa only [pi.single_apply] using has_sum_ite_eq b a
+
+lemma equiv.has_sum_iff (e : γ ≃ β) :
+  has_sum (f ∘ e) a ↔ has_sum f a :=
+e.injective.has_sum_iff $ by simp
+
+lemma function.injective.has_sum_range_iff {g : γ → β} (hg : injective g) :
+  has_sum (λ x : set.range g, f x) a ↔ has_sum (f ∘ g) a :=
+(equiv.of_injective g hg).has_sum_iff.symm
+
+lemma equiv.summable_iff (e : γ ≃ β) :
+  summable (f ∘ e) ↔ summable f :=
+exists_congr $ λ a, e.has_sum_iff
+
+lemma summable.prod_symm {f : β × γ → α} (hf : summable f) : summable (λ p : γ × β, f p.swap) :=
+(equiv.prod_comm γ β).summable_iff.2 hf
+
+lemma equiv.has_sum_iff_of_support {g : γ → α} (e : support f ≃ support g)
+  (he : ∀ x : support f, g (e x) = f x) :
+  has_sum f a ↔ has_sum g a :=
+have (g ∘ coe) ∘ e = f ∘ coe, from funext he,
+by rw [← has_sum_subtype_support, ← this, e.has_sum_iff, has_sum_subtype_support]
+
+lemma has_sum_iff_has_sum_of_ne_zero_bij {g : γ → α} (i : support g → β)
+  (hi : ∀ ⦃x y⦄, i x = i y → (x : γ) = y)
+  (hf : support f ⊆ set.range i) (hfg : ∀ x, f (i x) = g x) :
+  has_sum f a ↔ has_sum g a :=
+iff.symm $ equiv.has_sum_iff_of_support
+  (equiv.of_bijective (λ x, ⟨i x, λ hx, x.coe_prop $ hfg x ▸ hx⟩)
+    ⟨λ x y h, subtype.ext $ hi $ subtype.ext_iff.1 h,
+      λ y, (hf y.coe_prop).imp $ λ x hx, subtype.ext hx⟩)
+  hfg
+
+lemma equiv.summable_iff_of_support {g : γ → α} (e : support f ≃ support g)
+  (he : ∀ x : support f, g (e x) = f x) :
+  summable f ↔ summable g :=
+exists_congr $ λ _, e.has_sum_iff_of_support he
+
+protected lemma has_sum.map [add_comm_monoid γ] [topological_space γ] (hf : has_sum f a)
+  {G} [add_monoid_hom_class G α γ] (g : G) (hg : continuous g) :
+  has_sum (g ∘ f) (g a) :=
+have g ∘ (λs:finset β, ∑ b in s, f b) = (λs:finset β, ∑ b in s, g (f b)),
+  from funext $ map_sum g _,
+show tendsto (λs:finset β, ∑ b in s, g (f b)) at_top (𝓝 (g a)),
+  from this ▸ (hg.tendsto a).comp hf
+
+protected lemma summable.map [add_comm_monoid γ] [topological_space γ] (hf : summable f)
+  {G} [add_monoid_hom_class G α γ] (g : G) (hg : continuous g) :
+  summable (g ∘ f) :=
+(hf.has_sum.map g hg).summable
+
+protected lemma summable.map_iff_of_left_inverse [add_comm_monoid γ] [topological_space γ]
+  {G G'} [add_monoid_hom_class G α γ] [add_monoid_hom_class G' γ α] (g : G) (g' : G')
+  (hg : continuous g) (hg' : continuous g') (hinv : function.left_inverse g' g) :
+  summable (g ∘ f) ↔ summable f :=
+⟨λ h, begin
+  have := h.map _ hg',
+  rwa [←function.comp.assoc, hinv.id] at this,
+end, λ h, h.map _ hg⟩
+
+/-- A special case of `summable.map_iff_of_left_inverse` for convenience -/
+protected lemma summable.map_iff_of_equiv [add_comm_monoid γ] [topological_space γ]
+  {G} [add_equiv_class G α γ] (g : G)
+  (hg : continuous g) (hg' : continuous (add_equiv_class.inv g : γ → α)) :
+  summable (g ∘ f) ↔ summable f :=
+summable.map_iff_of_left_inverse g (g : α ≃+ γ).symm hg hg' (add_equiv_class.left_inv g)
+
+/-- If `f : ℕ → α` has sum `a`, then the partial sums `∑_{i=0}^{n-1} f i` converge to `a`. -/
+lemma has_sum.tendsto_sum_nat {f : ℕ → α} (h : has_sum f a) :
+  tendsto (λn:ℕ, ∑ i in range n, f i) at_top (𝓝 a) :=
+h.comp tendsto_finset_range
+
+lemma has_sum.unique {a₁ a₂ : α} [t2_space α] : has_sum f a₁ → has_sum f a₂ → a₁ = a₂ :=
+tendsto_nhds_unique
+
+lemma summable.has_sum_iff_tendsto_nat [t2_space α] {f : ℕ → α} {a : α} (hf : summable f) :
+  has_sum f a ↔ tendsto (λn:ℕ, ∑ i in range n, f i) at_top (𝓝 a) :=
+begin
+  refine ⟨λ h, h.tendsto_sum_nat, λ h, _⟩,
+  rw tendsto_nhds_unique h hf.has_sum.tendsto_sum_nat,
+  exact hf.has_sum
+end
+
+lemma function.surjective.summable_iff_of_has_sum_iff {α' : Type*} [add_comm_monoid α']
+  [topological_space α'] {e : α' → α} (hes : function.surjective e) {f : β → α} {g : γ → α'}
+  (he : ∀ {a}, has_sum f (e a) ↔ has_sum g a) :
+  summable f ↔ summable g :=
+hes.exists.trans $ exists_congr $ @he
+
+variable [has_continuous_add α]
+
+lemma has_sum.add (hf : has_sum f a) (hg : has_sum g b) : has_sum (λb, f b + g b) (a + b) :=
+by simp only [has_sum, sum_add_distrib]; exact hf.add hg
+
+lemma summable.add (hf : summable f) (hg : summable g) : summable (λb, f b + g b) :=
+(hf.has_sum.add hg.has_sum).summable
+
+lemma has_sum_sum {f : γ → β → α} {a : γ → α} {s : finset γ} :
+  (∀i∈s, has_sum (f i) (a i)) → has_sum (λb, ∑ i in s, f i b) (∑ i in s, a i) :=
+finset.induction_on s (by simp only [has_sum_zero, sum_empty, forall_true_iff])
+  (by simp only [has_sum.add, sum_insert, mem_insert, forall_eq_or_imp,
+        forall_2_true_iff, not_false_iff, forall_true_iff] {contextual := tt})
+
+lemma summable_sum {f : γ → β → α} {s : finset γ} (hf : ∀i∈s, summable (f i)) :
+  summable (λb, ∑ i in s, f i b) :=
+(has_sum_sum $ assume i hi, (hf i hi).has_sum).summable
+
+lemma has_sum.add_disjoint {s t : set β} (hs : disjoint s t)
+  (ha : has_sum (f ∘ coe : s → α) a) (hb : has_sum (f ∘ coe : t → α) b) :
+  has_sum (f ∘ coe : s ∪ t → α) (a + b) :=
+begin
+  rw has_sum_subtype_iff_indicator at *,
+  rw set.indicator_union_of_disjoint hs,
+  exact ha.add hb
+end
+
+lemma has_sum_sum_disjoint {ι} (s : finset ι) {t : ι → set β} {a : ι → α}
+  (hs : (s : set ι).pairwise (disjoint on t))
+  (hf : ∀ i ∈ s, has_sum (f ∘ coe : t i → α) (a i)) :
+  has_sum (f ∘ coe : (⋃ i ∈ s, t i) → α) (∑ i in s, a i) :=
+begin
+  simp_rw has_sum_subtype_iff_indicator at *,
+  rw set.indicator_finset_bUnion _ _ hs,
+  exact has_sum_sum hf,
+end
+
+lemma has_sum.add_is_compl {s t : set β} (hs : is_compl s t)
+  (ha : has_sum (f ∘ coe : s → α) a) (hb : has_sum (f ∘ coe : t → α) b) :
+  has_sum f (a + b) :=
+by simpa [← hs.compl_eq]
+  using (has_sum_subtype_iff_indicator.1 ha).add (has_sum_subtype_iff_indicator.1 hb)
+
+lemma has_sum.add_compl {s : set β} (ha : has_sum (f ∘ coe : s → α) a)
+  (hb : has_sum (f ∘ coe : sᶜ → α) b) :
+  has_sum f (a + b) :=
+ha.add_is_compl is_compl_compl hb
+
+lemma summable.add_compl {s : set β} (hs : summable (f ∘ coe : s → α))
+  (hsc : summable (f ∘ coe : sᶜ → α)) :
+  summable f :=
+(hs.has_sum.add_compl hsc.has_sum).summable
+
+lemma has_sum.compl_add {s : set β} (ha : has_sum (f ∘ coe : sᶜ → α) a)
+  (hb : has_sum (f ∘ coe : s → α) b) :
+  has_sum f (a + b) :=
+ha.add_is_compl is_compl_compl.symm hb
+
+lemma has_sum.even_add_odd {f : ℕ → α} (he : has_sum (λ k, f (2 * k)) a)
+  (ho : has_sum (λ k, f (2 * k + 1)) b) :
+  has_sum f (a + b) :=
+begin
+  have := mul_right_injective₀ (two_ne_zero' ℕ),
+  replace he := this.has_sum_range_iff.2 he,
+  replace ho := ((add_left_injective 1).comp this).has_sum_range_iff.2 ho,
+  refine he.add_is_compl _ ho,
+  simpa [(∘)] using nat.is_compl_even_odd
+end
+
+lemma summable.compl_add {s : set β} (hs : summable (f ∘ coe : sᶜ → α))
+  (hsc : summable (f ∘ coe : s → α)) :
+  summable f :=
+(hs.has_sum.compl_add hsc.has_sum).summable
+
+lemma summable.even_add_odd {f : ℕ → α} (he : summable (λ k, f (2 * k)))
+  (ho : summable (λ k, f (2 * k + 1))) :
+  summable f :=
+(he.has_sum.even_add_odd ho.has_sum).summable
+
+lemma has_sum.sigma [regular_space α] {γ : β → Type*} {f : (Σ b:β, γ b) → α} {g : β → α} {a : α}
+  (ha : has_sum f a) (hf : ∀b, has_sum (λc, f ⟨b, c⟩) (g b)) : has_sum g a :=
+begin
+  refine (at_top_basis.tendsto_iff (closed_nhds_basis a)).mpr _,
+  rintros s ⟨hs, hsc⟩,
+  rcases mem_at_top_sets.mp (ha hs) with ⟨u, hu⟩,
+  use [u.image sigma.fst, trivial],
+  intros bs hbs,
+  simp only [set.mem_preimage, ge_iff_le, finset.le_iff_subset] at hu,
+  have : tendsto (λ t : finset (Σ b, γ b), ∑ p in t.filter (λ p, p.1 ∈ bs), f p)
+    at_top (𝓝 $ ∑ b in bs, g b),
+  { simp only [← sigma_preimage_mk, sum_sigma],
+    refine tendsto_finset_sum _ (λ b hb, _),
+    change tendsto (λ t, (λ t, ∑ s in t, f ⟨b, s⟩) (preimage t (sigma.mk b) _)) at_top (𝓝 (g b)),
+    exact tendsto.comp (hf b) (tendsto_finset_preimage_at_top_at_top _) },
+  refine hsc.mem_of_tendsto this (eventually_at_top.2 ⟨u, λ t ht, hu _ (λ x hx, _)⟩),
+  exact mem_filter.2 ⟨ht hx, hbs $ mem_image_of_mem _ hx⟩
+end
+
+/-- If a series `f` on `β × γ` has sum `a` and for each `b` the restriction of `f` to `{b} × γ`
+has sum `g b`, then the series `g` has sum `a`. -/
+lemma has_sum.prod_fiberwise [regular_space α] {f : β × γ → α} {g : β → α} {a : α}
+  (ha : has_sum f a) (hf : ∀b, has_sum (λc, f (b, c)) (g b)) :
+  has_sum g a :=
+has_sum.sigma ((equiv.sigma_equiv_prod β γ).has_sum_iff.2 ha) hf
+
+lemma summable.sigma' [regular_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
+  (ha : summable f) (hf : ∀b, summable (λc, f ⟨b, c⟩)) :
+  summable (λb, ∑'c, f ⟨b, c⟩) :=
+(ha.has_sum.sigma (assume b, (hf b).has_sum)).summable
+
+lemma has_sum.sigma_of_has_sum [t3_space α] {γ : β → Type*} {f : (Σ b:β, γ b) → α} {g : β → α}
+  {a : α} (ha : has_sum g a) (hf : ∀b, has_sum (λc, f ⟨b, c⟩) (g b)) (hf' : summable f) :
+  has_sum f a :=
+by simpa [(hf'.has_sum.sigma hf).unique ha] using hf'.has_sum
+
+/-- Version of `has_sum.update` for `add_comm_monoid` rather than `add_comm_group`.
+Rather than showing that `f.update` has a specific sum in terms of `has_sum`,
+it gives a relationship between the sums of `f` and `f.update` given that both exist. -/
+lemma has_sum.update' {α β : Type*} [topological_space α] [add_comm_monoid α] [t2_space α]
+  [has_continuous_add α] {f : β → α} {a a' : α} (hf : has_sum f a)
+  (b : β) (x : α) (hf' : has_sum (f.update b x) a') : a + x = a' + f b :=
+begin
+  have : ∀ b', f b' + ite (b' = b) x 0 = f.update b x b' + ite (b' = b) (f b) 0,
+  { intro b',
+    split_ifs with hb',
+    { simpa only [function.update_apply, hb', eq_self_iff_true] using add_comm (f b) x },
+    { simp only [function.update_apply, hb', if_false] } },
+  have h := hf.add ((has_sum_ite_eq b x)),
+  simp_rw this at h,
+  exact has_sum.unique h (hf'.add (has_sum_ite_eq b (f b)))
+end
+
+/-- Version of `has_sum_ite_sub_has_sum` for `add_comm_monoid` rather than `add_comm_group`.
+Rather than showing that the `ite` expression has a specific sum in terms of `has_sum`,
+it gives a relationship between the sums of `f` and `ite (n = b) 0 (f n)` given that both exist. -/
+lemma eq_add_of_has_sum_ite {α β : Type*} [topological_space α] [add_comm_monoid α]
+  [t2_space α] [has_continuous_add α] {f : β → α} {a : α} (hf : has_sum f a) (b : β) (a' : α)
+  (hf' : has_sum (λ n, ite (n = b) 0 (f n)) a') : a = a' + f b :=
+begin
+  refine (add_zero a).symm.trans (hf.update' b 0 _),
+  convert hf',
+  exact funext (f.update_apply b 0),
+end
+
+end has_sum
+
+section tsum
+variables [add_comm_monoid α] [topological_space α]
+
+lemma tsum_congr_subtype (f : β → α) {s t : set β} (h : s = t) :
+  ∑' (x : s), f x = ∑' (x : t), f x :=
+by rw h
+
+lemma tsum_zero' (hz : is_closed ({0} : set α)) : ∑' b : β, (0 : α) = 0 :=
+begin
+  classical,
+  rw [tsum, dif_pos summable_zero],
+  suffices : ∀ (x : α), has_sum (λ (b : β), (0 : α)) x → x = 0,
+  { exact this _ (classical.some_spec _) },
+  intros x hx,
+  contrapose! hx,
+  simp only [has_sum, tendsto_nhds, finset.sum_const_zero, filter.mem_at_top_sets, ge_iff_le,
+              finset.le_eq_subset, set.mem_preimage, not_forall, not_exists, exists_prop,
+              exists_and_distrib_right],
+  refine ⟨{0}ᶜ, ⟨is_open_compl_iff.mpr hz, _⟩, λ y, ⟨⟨y, subset_refl _⟩, _⟩⟩,
+  { simpa using hx },
+  { simp }
+end
+
+@[simp] lemma tsum_zero [t1_space α] : ∑' b : β, (0 : α) = 0 := tsum_zero' is_closed_singleton
+
+variables [t2_space α] {f g : β → α} {a a₁ a₂ : α}
+
+lemma has_sum.tsum_eq (ha : has_sum f a) : ∑'b, f b = a :=
+(summable.has_sum ⟨a, ha⟩).unique ha
+
+lemma summable.has_sum_iff (h : summable f) : has_sum f a ↔ ∑'b, f b = a :=
+iff.intro has_sum.tsum_eq (assume eq, eq ▸ h.has_sum)
+
+@[simp] lemma tsum_empty [is_empty β] : ∑'b, f b = 0 := has_sum_empty.tsum_eq
+
+lemma tsum_eq_sum {f : β → α} {s : finset β} (hf : ∀b∉s, f b = 0)  :
+  ∑' b, f b = ∑ b in s, f b :=
+(has_sum_sum_of_ne_finset_zero hf).tsum_eq
+
+lemma sum_eq_tsum_indicator (f : β → α) (s : finset β) :
+  ∑ x in s, f x = ∑' x, set.indicator ↑s f x :=
+have ∀ x ∉ s, set.indicator ↑s f x = 0,
+from λ x hx, set.indicator_apply_eq_zero.2 (λ hx', (hx $ finset.mem_coe.1 hx').elim),
+(finset.sum_congr rfl (λ x hx, (set.indicator_apply_eq_self.2 $
+  λ hx', (hx' $ finset.mem_coe.2 hx).elim).symm)).trans (tsum_eq_sum this).symm
+
+lemma tsum_congr {α β : Type*} [add_comm_monoid α] [topological_space α]
+  {f g : β → α} (hfg : ∀ b, f b = g b) : ∑' b, f b = ∑' b, g b :=
+congr_arg tsum (funext hfg)
+
+lemma tsum_fintype [fintype β] (f : β → α) : ∑'b, f b = ∑ b, f b :=
+(has_sum_fintype f).tsum_eq
+
+lemma tsum_bool (f : bool → α) : ∑' i : bool, f i = f false + f true :=
+by { rw [tsum_fintype, finset.sum_eq_add]; simp }
+
+lemma tsum_eq_single {f : β → α} (b : β) (hf : ∀b' ≠ b, f b' = 0)  :
+  ∑'b, f b = f b :=
+(has_sum_single b hf).tsum_eq
+
+lemma tsum_tsum_eq_single (f : β → γ → α) (b : β) (c : γ) (hfb : ∀ b' ≠ b, f b' c = 0)
+  (hfc : ∀ (b' : β) (c' : γ), c' ≠ c → f b' c' = 0) :
+  ∑' b' c', f b' c' = f b c :=
+calc ∑' b' c', f b' c' = ∑' b', f b' c : tsum_congr $ λ b', tsum_eq_single _ (hfc b')
+... = f b c : tsum_eq_single _ hfb
+
+@[simp] lemma tsum_ite_eq (b : β) [decidable_pred (= b)] (a : α) :
+  ∑' b', (if b' = b then a else 0) = a :=
+(has_sum_ite_eq b a).tsum_eq
+
+@[simp] lemma tsum_pi_single [decidable_eq β] (b : β) (a : α) :
+  ∑' b', pi.single b a b' = a :=
+(has_sum_pi_single b a).tsum_eq
+
+lemma tsum_dite_right (P : Prop) [decidable P] (x : β → ¬ P → α) :
+  ∑' (b : β), (if h : P then (0 : α) else x b h) = if h : P then (0 : α) else ∑' (b : β), x b h :=
+by by_cases hP : P; simp [hP]
+
+lemma tsum_dite_left (P : Prop) [decidable P] (x : β → P → α) :
+  ∑' (b : β), (if h : P then x b h else 0) = if h : P then (∑' (b : β), x b h) else 0 :=
+by by_cases hP : P; simp [hP]
+
+lemma function.surjective.tsum_eq_tsum_of_has_sum_iff_has_sum {α' : Type*} [add_comm_monoid α']
+  [topological_space α'] {e : α' → α} (hes : function.surjective e) (h0 : e 0 = 0)
+  {f : β → α} {g : γ → α'}
+  (h : ∀ {a}, has_sum f (e a) ↔ has_sum g a) :
+  ∑' b, f b = e (∑' c, g c) :=
+by_cases
+  (assume : summable g, (h.mpr this.has_sum).tsum_eq)
+  (assume hg : ¬ summable g,
+    have hf : ¬ summable f, from mt (hes.summable_iff_of_has_sum_iff @h).1 hg,
+    by simp [tsum, hf, hg, h0])
+
+lemma tsum_eq_tsum_of_has_sum_iff_has_sum {f : β → α} {g : γ → α}
+  (h : ∀{a}, has_sum f a ↔ has_sum g a) :
+  ∑'b, f b = ∑'c, g c :=
+surjective_id.tsum_eq_tsum_of_has_sum_iff_has_sum rfl @h
+
+lemma equiv.tsum_eq (j : γ ≃ β) (f : β → α) : ∑'c, f (j c) = ∑'b, f b :=
+tsum_eq_tsum_of_has_sum_iff_has_sum $ λ a, j.has_sum_iff
+
+lemma equiv.tsum_eq_tsum_of_support {f : β → α} {g : γ → α} (e : support f ≃ support g)
+  (he : ∀ x, g (e x) = f x) :
+  (∑' x, f x) = ∑' y, g y :=
+tsum_eq_tsum_of_has_sum_iff_has_sum $ λ _, e.has_sum_iff_of_support he
+
+lemma tsum_eq_tsum_of_ne_zero_bij {g : γ → α} (i : support g → β)
+  (hi : ∀ ⦃x y⦄, i x = i y → (x : γ) = y)
+  (hf : support f ⊆ set.range i) (hfg : ∀ x, f (i x) = g x) :
+  ∑' x, f x  = ∑' y, g y :=
+tsum_eq_tsum_of_has_sum_iff_has_sum $ λ _, has_sum_iff_has_sum_of_ne_zero_bij i hi hf hfg
+
+/-! ### `tsum` on subsets -/
+
+@[simp] lemma finset.tsum_subtype (s : finset β) (f : β → α) :
+  ∑' x : {x // x ∈ s}, f x = ∑ x in s, f x :=
+(s.has_sum f).tsum_eq
+
+@[simp] lemma finset.tsum_subtype' (s : finset β) (f : β → α) :
+  ∑' x : (s : set β), f x = ∑ x in s, f x :=
+s.tsum_subtype f
+
+lemma tsum_subtype (s : set β) (f : β → α) :
+  ∑' x : s, f x = ∑' x, s.indicator f x :=
+tsum_eq_tsum_of_has_sum_iff_has_sum $ λ _, has_sum_subtype_iff_indicator
+
+lemma tsum_subtype_eq_of_support_subset {f : β → α} {s : set β} (hs : support f ⊆ s) :
+  ∑' x : s, f x = ∑' x, f x :=
+tsum_eq_tsum_of_has_sum_iff_has_sum $ λ x, has_sum_subtype_iff_of_support_subset hs
+
+@[simp] lemma tsum_univ (f : β → α) : ∑' x : (set.univ : set β), f x = ∑' x, f x :=
+tsum_subtype_eq_of_support_subset $ set.subset_univ _
+
+@[simp] lemma tsum_singleton (b : β) (f : β → α) :
+  ∑' x : ({b} : set β), f x = f b :=
+begin
+  rw [tsum_subtype, tsum_eq_single b],
+  { simp },
+  { intros b' hb',
+    rw set.indicator_of_not_mem,
+    rwa set.mem_singleton_iff },
+  { apply_instance }
+end
+
+lemma tsum_image {g : γ → β} (f : β → α) {s : set γ} (hg : set.inj_on g s) :
+  ∑' x : g '' s, f x = ∑' x : s, f (g x) :=
+((equiv.set.image_of_inj_on _ _ hg).tsum_eq (λ x, f x)).symm
+
+lemma tsum_range {g : γ → β} (f : β → α) (hg : injective g) :
+  ∑' x : set.range g, f x = ∑' x, f (g x) :=
+by rw [← set.image_univ, tsum_image f (hg.inj_on _), tsum_univ (f ∘ g)]
+
+section has_continuous_add
+variable [has_continuous_add α]
+
+lemma tsum_add (hf : summable f) (hg : summable g) : ∑'b, (f b + g b) = (∑'b, f b) + (∑'b, g b) :=
+(hf.has_sum.add hg.has_sum).tsum_eq
+
+lemma tsum_sum {f : γ → β → α} {s : finset γ} (hf : ∀i∈s, summable (f i)) :
+  ∑'b, ∑ i in s, f i b = ∑ i in s, ∑'b, f i b :=
+(has_sum_sum $ assume i hi, (hf i hi).has_sum).tsum_eq
+
+/-- Version of `tsum_eq_add_tsum_ite` for `add_comm_monoid` rather than `add_comm_group`.
+Requires a different convergence assumption involving `function.update`. -/
+lemma tsum_eq_add_tsum_ite' {f : β → α} (b : β) (hf : summable (f.update b 0)) :
+  ∑' x, f x = f b + ∑' x, ite (x = b) 0 (f x) :=
+calc ∑' x, f x = ∑' x, ((ite (x = b) (f x) 0) + (f.update b 0 x)) :
+    tsum_congr (λ n, by split_ifs; simp [function.update_apply, h])
+  ... = ∑' x, ite (x = b) (f x) 0 + ∑' x, f.update b 0 x :
+    tsum_add ⟨ite (b = b) (f b) 0, has_sum_single b (λ b hb, if_neg hb)⟩ (hf)
+  ... = (ite (b = b) (f b) 0) + ∑' x, f.update b 0 x :
+    by { congr, exact (tsum_eq_single b (λ b' hb', if_neg hb')) }
+  ... = f b + ∑' x, ite (x = b) 0 (f x) :
+    by simp only [function.update, eq_self_iff_true, if_true, eq_rec_constant, dite_eq_ite]
+
+variables [add_comm_monoid δ] [topological_space δ] [t3_space δ] [has_continuous_add δ]
+
+lemma tsum_sigma' {γ : β → Type*} {f : (Σb:β, γ b) → δ} (h₁ : ∀b, summable (λc, f ⟨b, c⟩))
+  (h₂ : summable f) : ∑'p, f p = ∑'b c, f ⟨b, c⟩ :=
+(h₂.has_sum.sigma (assume b, (h₁ b).has_sum)).tsum_eq.symm
+
+lemma tsum_prod' {f : β × γ → δ} (h : summable f) (h₁ : ∀b, summable (λc, f (b, c))) :
+  ∑'p, f p = ∑'b c, f (b, c) :=
+(h.has_sum.prod_fiberwise (assume b, (h₁ b).has_sum)).tsum_eq.symm
+
+lemma tsum_comm' {f : β → γ → δ} (h : summable (function.uncurry f)) (h₁ : ∀b, summable (f b))
+  (h₂ : ∀ c, summable (λ b, f b c)) :
+  ∑' c b, f b c = ∑' b c, f b c :=
+begin
+  erw [← tsum_prod' h h₁, ← tsum_prod' h.prod_symm h₂, ← (equiv.prod_comm γ β).tsum_eq (uncurry f)],
+  refl
+end
+
+end has_continuous_add
+
+open encodable
+
+section encodable
+variable [encodable γ]
+
+/-- You can compute a sum over an encodably type by summing over the natural numbers and
+  taking a supremum. This is useful for outer measures. -/
+theorem tsum_supr_decode₂ [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
+  (s : γ → β) : ∑' i : ℕ, m (⨆ b ∈ decode₂ γ i, s b) = ∑' b : γ, m (s b) :=
+begin
+  have H : ∀ n, m (⨆ b ∈ decode₂ γ n, s b) ≠ 0 → (decode₂ γ n).is_some,
+  { intros n h,
+    cases decode₂ γ n with b,
+    { refine (h $ by simp [m0]).elim },
+    { exact rfl } },
+  symmetry, refine tsum_eq_tsum_of_ne_zero_bij (λ a, option.get (H a.1 a.2)) _ _ _,
+  { rintros ⟨m, hm⟩ ⟨n, hn⟩ e,
+    have := mem_decode₂.1 (option.get_mem (H n hn)),
+    rwa [← e, mem_decode₂.1 (option.get_mem (H m hm))] at this },
+  { intros b h,
+    refine ⟨⟨encode b, _⟩, _⟩,
+    { simp only [mem_support, encodek₂] at h ⊢, convert h, simp [set.ext_iff, encodek₂] },
+    { exact option.get_of_mem _ (encodek₂ _) } },
+  { rintros ⟨n, h⟩, dsimp only [subtype.coe_mk],
+    transitivity, swap,
+    rw [show decode₂ γ n = _, from option.get_mem (H n h)],
+    congr, simp [ext_iff, -option.some_get] }
+end
+
+/-- `tsum_supr_decode₂` specialized to the complete lattice of sets. -/
+theorem tsum_Union_decode₂ (m : set β → α) (m0 : m ∅ = 0)
+  (s : γ → set β) : ∑' i, m (⋃ b ∈ decode₂ γ i, s b) = ∑' b, m (s b) :=
+tsum_supr_decode₂ m m0 s
+
+end encodable
+
+/-! Some properties about measure-like functions.
+  These could also be functions defined on complete sublattices of sets, with the property
+  that they are countably sub-additive.
+  `R` will probably be instantiated with `(≤)` in all applications.
+-/
+
+section countable
+variables [countable γ]
+
+/-- If a function is countably sub-additive then it is sub-additive on countable types -/
+theorem rel_supr_tsum [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
+  (R : α → α → Prop) (m_supr : ∀(s : ℕ → β), R (m (⨆ i, s i)) ∑' i, m (s i))
+  (s : γ → β) : R (m (⨆ b : γ, s b)) ∑' b : γ, m (s b) :=
+by { casesI nonempty_encodable γ, rw [←supr_decode₂, ←tsum_supr_decode₂ _ m0 s], exact m_supr _ }
+
+/-- If a function is countably sub-additive then it is sub-additive on finite sets -/
+theorem rel_supr_sum [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
+  (R : α → α → Prop) (m_supr : ∀(s : ℕ → β), R (m (⨆ i, s i)) (∑' i, m (s i)))
+  (s : δ → β) (t : finset δ) :
+  R (m (⨆ d ∈ t, s d)) (∑ d in t, m (s d)) :=
+by { rw [supr_subtype', ←finset.tsum_subtype], exact rel_supr_tsum m m0 R m_supr _ }
+
+/-- If a function is countably sub-additive then it is binary sub-additive -/
+theorem rel_sup_add [complete_lattice β] (m : β → α) (m0 : m ⊥ = 0)
+  (R : α → α → Prop) (m_supr : ∀(s : ℕ → β), R (m (⨆ i, s i)) (∑' i, m (s i)))
+  (s₁ s₂ : β) : R (m (s₁ ⊔ s₂)) (m s₁ + m s₂) :=
+begin
+  convert rel_supr_tsum m m0 R m_supr (λ b, cond b s₁ s₂),
+  { simp only [supr_bool_eq, cond] },
+  { rw [tsum_fintype, fintype.sum_bool, cond, cond] }
+end
+
+end countable
+
+variables [has_continuous_add α]
+
+lemma tsum_add_tsum_compl {s : set β} (hs : summable (f ∘ coe : s → α))
+  (hsc : summable (f ∘ coe : sᶜ → α)) :
+  (∑' x : s, f x) + (∑' x : sᶜ, f x) = ∑' x, f x :=
+(hs.has_sum.add_compl hsc.has_sum).tsum_eq.symm
+
+lemma tsum_union_disjoint {s t : set β} (hd : disjoint s t)
+  (hs : summable (f ∘ coe : s → α)) (ht : summable (f ∘ coe : t → α)) :
+  (∑' x : s ∪ t, f x) = (∑' x : s, f x) + (∑' x : t, f x) :=
+(hs.has_sum.add_disjoint hd ht.has_sum).tsum_eq
+
+lemma tsum_finset_bUnion_disjoint {ι} {s : finset ι} {t : ι → set β}
+  (hd : (s : set ι).pairwise (disjoint on t))
+  (hf : ∀ i ∈ s, summable (f ∘ coe : t i → α)) :
+  (∑' x : (⋃ i ∈ s, t i), f x) = ∑ i in s, ∑' x : t i, f x :=
+(has_sum_sum_disjoint _ hd (λ i hi, (hf i hi).has_sum)).tsum_eq
+
+lemma tsum_even_add_odd {f : ℕ → α} (he : summable (λ k, f (2 * k)))
+  (ho : summable (λ k, f (2 * k + 1))) :
+  (∑' k, f (2 * k)) + (∑' k, f (2 * k + 1)) = ∑' k, f k :=
+(he.has_sum.even_add_odd ho.has_sum).tsum_eq.symm
+
+end tsum
+
+section topological_group
+variables [add_comm_group α] [topological_space α] [topological_add_group α]
+variables {f g : β → α} {a a₁ a₂ : α}
+
+-- `by simpa using` speeds up elaboration. Why?
+lemma has_sum.neg (h : has_sum f a) : has_sum (λb, - f b) (- a) :=
+by simpa only using h.map (-add_monoid_hom.id α) continuous_neg
+
+lemma summable.neg (hf : summable f) : summable (λb, - f b) :=
+hf.has_sum.neg.summable
+
+lemma summable.of_neg (hf : summable (λb, - f b)) : summable f :=
+by simpa only [neg_neg] using hf.neg
+
+lemma summable_neg_iff : summable (λ b, - f b) ↔ summable f :=
+⟨summable.of_neg, summable.neg⟩
+
+lemma has_sum.sub (hf : has_sum f a₁) (hg : has_sum g a₂) : has_sum (λb, f b - g b) (a₁ - a₂) :=
+by { simp only [sub_eq_add_neg], exact hf.add hg.neg }
+
+lemma summable.sub (hf : summable f) (hg : summable g) : summable (λb, f b - g b) :=
+(hf.has_sum.sub hg.has_sum).summable
+
+lemma summable.trans_sub (hg : summable g) (hfg : summable (λb, f b - g b)) :
+  summable f :=
+by simpa only [sub_add_cancel] using hfg.add hg
+
+lemma summable_iff_of_summable_sub (hfg : summable (λb, f b - g b)) :
+  summable f ↔ summable g :=
+⟨λ hf, hf.trans_sub $ by simpa only [neg_sub] using hfg.neg, λ hg, hg.trans_sub hfg⟩
+
+lemma has_sum.update (hf : has_sum f a₁) (b : β) [decidable_eq β] (a : α) :
+  has_sum (update f b a) (a - f b + a₁) :=
+begin
+  convert ((has_sum_ite_eq b _).add hf),
+  ext b',
+  by_cases h : b' = b,
+  { rw [h, update_same],
+    simp only [eq_self_iff_true, if_true, sub_add_cancel] },
+  simp only [h, update_noteq, if_false, ne.def, zero_add, not_false_iff],
+end
+
+lemma summable.update (hf : summable f) (b : β) [decidable_eq β] (a : α) :
+  summable (update f b a) :=
+(hf.has_sum.update b a).summable
+
+lemma has_sum.has_sum_compl_iff {s : set β} (hf : has_sum (f ∘ coe : s → α) a₁) :
+  has_sum (f ∘ coe : sᶜ → α) a₂ ↔ has_sum f (a₁ + a₂) :=
+begin
+  refine ⟨λ h, hf.add_compl h, λ h, _⟩,
+  rw [has_sum_subtype_iff_indicator] at hf ⊢,
+  rw [set.indicator_compl],
+  simpa only [add_sub_cancel'] using h.sub hf
+end
+
+lemma has_sum.has_sum_iff_compl {s : set β} (hf : has_sum (f ∘ coe : s → α) a₁) :
+  has_sum f a₂ ↔ has_sum (f ∘ coe : sᶜ → α) (a₂ - a₁) :=
+iff.symm $ hf.has_sum_compl_iff.trans $ by rw [add_sub_cancel'_right]
+
+lemma summable.summable_compl_iff {s : set β} (hf : summable (f ∘ coe : s → α)) :
+  summable (f ∘ coe : sᶜ → α) ↔ summable f :=
+⟨λ ⟨a, ha⟩, (hf.has_sum.has_sum_compl_iff.1 ha).summable,
+  λ ⟨a, ha⟩, (hf.has_sum.has_sum_iff_compl.1 ha).summable⟩
+
+protected lemma finset.has_sum_compl_iff (s : finset β) :
+  has_sum (λ x : {x // x ∉ s}, f x) a ↔ has_sum f (a + ∑ i in s, f i) :=
+(s.has_sum f).has_sum_compl_iff.trans $ by rw [add_comm]
+
+protected lemma finset.has_sum_iff_compl (s : finset β) :
+  has_sum f a ↔ has_sum (λ x : {x // x ∉ s}, f x) (a - ∑ i in s, f i) :=
+(s.has_sum f).has_sum_iff_compl
+
+protected lemma finset.summable_compl_iff (s : finset β) :
+  summable (λ x : {x // x ∉ s}, f x) ↔ summable f :=
+(s.summable f).summable_compl_iff
+
+lemma set.finite.summable_compl_iff {s : set β} (hs : s.finite) :
+  summable (f ∘ coe : sᶜ → α) ↔ summable f :=
+(hs.summable f).summable_compl_iff
+
+lemma has_sum_ite_sub_has_sum [decidable_eq β] (hf : has_sum f a) (b : β) :
+  has_sum (λ n, ite (n = b) 0 (f n)) (a - f b) :=
+begin
+  convert hf.update b 0 using 1,
+  { ext n, rw function.update_apply, },
+  { rw [sub_add_eq_add_sub, zero_add], },
+end
+
+section tsum
+variables [t2_space α]
+
+lemma tsum_neg : ∑'b, - f b = - ∑'b, f b :=
+begin
+  by_cases hf : summable f,
+  { exact hf.has_sum.neg.tsum_eq, },
+  { simp [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable (mt summable.of_neg hf)] },
+end
+
+lemma tsum_sub (hf : summable f) (hg : summable g) : ∑'b, (f b - g b) = ∑'b, f b - ∑'b, g b :=
+(hf.has_sum.sub hg.has_sum).tsum_eq
+
+lemma sum_add_tsum_compl {s : finset β} (hf : summable f) :
+  (∑ x in s, f x) + (∑' x : (↑s : set β)ᶜ, f x) = ∑' x, f x :=
+((s.has_sum f).add_compl (s.summable_compl_iff.2 hf).has_sum).tsum_eq.symm
+
+/-- Let `f : β → α` be a sequence with summable series and let `b ∈ β` be an index.
+Lemma `tsum_eq_add_tsum_ite` writes `Σ f n` as the sum of `f b` plus the series of the
+remaining terms. -/
+lemma tsum_eq_add_tsum_ite [decidable_eq β] (hf : summable f) (b : β) :
+  ∑' n, f n = f b + ∑' n, ite (n = b) 0 (f n) :=
+begin
+  rw (has_sum_ite_sub_has_sum hf.has_sum b).tsum_eq,
+  exact (add_sub_cancel'_right _ _).symm,
+end
+
+end tsum
+
+/-!
+### Sums on nat
+
+We show the formula `(∑ i in range k, f i) + (∑' i, f (i + k)) = (∑' i, f i)`, in
+`sum_add_tsum_nat_add`, as well as several results relating sums on `ℕ` and `ℤ`.
+-/
+section nat
+
+lemma has_sum_nat_add_iff {f : ℕ → α} (k : ℕ) {a : α} :
+  has_sum (λ n, f (n + k)) a ↔ has_sum f (a + ∑ i in range k, f i) :=
+begin
+  refine iff.trans _ ((range k).has_sum_compl_iff),
+  rw [← (not_mem_range_equiv k).symm.has_sum_iff],
+  refl
+end
+
+lemma summable_nat_add_iff {f : ℕ → α} (k : ℕ) : summable (λ n, f (n + k)) ↔ summable f :=
+iff.symm $ (equiv.add_right (∑ i in range k, f i)).surjective.summable_iff_of_has_sum_iff $
+  λ a, (has_sum_nat_add_iff k).symm
+
+lemma has_sum_nat_add_iff' {f : ℕ → α} (k : ℕ) {a : α} :
+  has_sum (λ n, f (n + k)) (a - ∑ i in range k, f i) ↔ has_sum f a :=
+by simp [has_sum_nat_add_iff]
+
+lemma sum_add_tsum_nat_add [t2_space α] {f : ℕ → α} (k : ℕ) (h : summable f) :
+  (∑ i in range k, f i) + (∑' i, f (i + k)) = ∑' i, f i :=
+by simpa only [add_comm] using
+  ((has_sum_nat_add_iff k).1 ((summable_nat_add_iff k).2 h).has_sum).unique h.has_sum
+
+lemma tsum_eq_zero_add [t2_space α] {f : ℕ → α} (hf : summable f) :
+  ∑'b, f b = f 0 + ∑'b, f (b + 1) :=
+by simpa only [sum_range_one] using (sum_add_tsum_nat_add 1 hf).symm
+
+/-- For `f : ℕ → α`, then `∑' k, f (k + i)` tends to zero. This does not require a summability
+assumption on `f`, as otherwise all sums are zero. -/
+lemma tendsto_sum_nat_add [t2_space α] (f : ℕ → α) : tendsto (λ i, ∑' k, f (k + i)) at_top (𝓝 0) :=
+begin
+  by_cases hf : summable f,
+  { have h₀ : (λ i, (∑' i, f i) - ∑ j in range i, f j) = λ i, ∑' (k : ℕ), f (k + i),
+    { ext1 i,
+      rw [sub_eq_iff_eq_add, add_comm, sum_add_tsum_nat_add i hf] },
+    have h₁ : tendsto (λ i : ℕ, ∑' i, f i) at_top (𝓝 (∑' i, f i)) := tendsto_const_nhds,
+    simpa only [h₀, sub_self] using tendsto.sub h₁ hf.has_sum.tendsto_sum_nat },
+  { convert tendsto_const_nhds,
+    ext1 i,
+    rw ← summable_nat_add_iff i at hf,
+    { exact tsum_eq_zero_of_not_summable hf },
+    { apply_instance } }
+end
+
+/-- If `f₀, f₁, f₂, ...` and `g₀, g₁, g₂, ...` are both convergent then so is the `ℤ`-indexed
+sequence: `..., g₂, g₁, g₀, f₀, f₁, f₂, ...`. -/
+lemma has_sum.int_rec {b : α} {f g : ℕ → α} (hf : has_sum f a) (hg : has_sum g b) :
+  @has_sum α _ _ _ (@int.rec (λ _, α) f g : ℤ → α) (a + b) :=
+begin
+  -- note this proof works for any two-case inductive
+  have h₁ : injective (coe : ℕ → ℤ) := @int.of_nat.inj,
+  have h₂ : injective int.neg_succ_of_nat := @int.neg_succ_of_nat.inj,
+  have : is_compl (set.range (coe : ℕ → ℤ)) (set.range int.neg_succ_of_nat),
+  { split,
+    { rw disjoint_iff_inf_le,
+      rintros _ ⟨⟨i, rfl⟩, ⟨j, ⟨⟩⟩⟩ },
+    { rw codisjoint_iff_le_sup,
+      rintros (i | j) h,
+      exacts [or.inl ⟨_, rfl⟩, or.inr ⟨_, rfl⟩] } },
+  exact has_sum.add_is_compl this (h₁.has_sum_range_iff.mpr hf) (h₂.has_sum_range_iff.mpr hg),
+end
+
+lemma has_sum.nonneg_add_neg {b : α} {f : ℤ → α}
+  (hnonneg : has_sum (λ n : ℕ, f n) a) (hneg : has_sum (λ (n : ℕ), f (-n.succ)) b) :
+  has_sum f (a + b) :=
+begin
+  simp_rw ← int.neg_succ_of_nat_coe at hneg,
+  convert hnonneg.int_rec hneg using 1,
+  ext (i | j); refl,
+end
+
+lemma has_sum.pos_add_zero_add_neg {b : α} {f : ℤ → α}
+  (hpos : has_sum (λ n:ℕ, f(n + 1)) a) (hneg : has_sum (λ (n : ℕ), f (-n.succ)) b) :
+  has_sum f (a + f 0 + b) :=
+begin
+  have : ∀ g : ℕ → α, has_sum (λ k, g (k + 1)) a → has_sum g (a + g 0),
+  { intros g hg, simpa using (has_sum_nat_add_iff _).mp hg },
+  exact (this (λ n, f n) hpos).nonneg_add_neg hneg,
+end
+
+lemma summable_int_of_summable_nat {f : ℤ → α}
+  (hp : summable (λ n:ℕ, f n)) (hn : summable (λ n:ℕ, f (-n))) : summable f :=
+(has_sum.nonneg_add_neg hp.has_sum $ summable.has_sum $ (summable_nat_add_iff 1).mpr hn).summable
+
+lemma has_sum.sum_nat_of_sum_int {α : Type*} [add_comm_monoid α] [topological_space α]
+  [has_continuous_add α] {a : α} {f : ℤ → α} (hf : has_sum f a) :
+  has_sum (λ n:ℕ, f n + f (-n)) (a + f 0) :=
+begin
+  apply (hf.add (has_sum_ite_eq (0 : ℤ) (f 0))).has_sum_of_sum_eq (λ u, _),
+  refine ⟨u.image int.nat_abs, λ v' hv', _⟩,
+  let u1 := v'.image (λ (x : ℕ), (x : ℤ)),
+  let u2 := v'.image (λ (x : ℕ), - (x : ℤ)),
+  have A : u ⊆ u1 ∪ u2,
+  { assume x hx,
+    simp only [mem_union, mem_image, exists_prop],
+    rcases le_total 0 x with h'x|h'x,
+    { left,
+      refine ⟨int.nat_abs x, hv' _, _⟩,
+      { simp only [mem_image, exists_prop],
+        exact ⟨x, hx, rfl⟩ },
+      { simp only [h'x, int.coe_nat_abs, abs_eq_self] } },
+    { right,
+      refine ⟨int.nat_abs x, hv' _, _⟩,
+      { simp only [mem_image, exists_prop],
+        exact ⟨x, hx, rfl⟩ },
+      { simp only [abs_of_nonpos h'x, int.coe_nat_abs, neg_neg] } } },
+  refine ⟨u1 ∪ u2, A, _⟩,
+  calc ∑ x in u1 ∪ u2, (f x + ite (x = 0) (f 0) 0)
+      = ∑ x in u1 ∪ u2, f x + ∑ x in u1 ∩ u2, f x :
+    begin
+      rw sum_add_distrib,
+      congr' 1,
+      refine (sum_subset_zero_on_sdiff inter_subset_union _ _).symm,
+      { assume x hx,
+        suffices : x ≠ 0, by simp only [this, if_false],
+        rintros rfl,
+        simpa only [mem_sdiff, mem_union, mem_image, neg_eq_zero, or_self, mem_inter, and_self,
+          and_not_self] using hx },
+      { assume x hx,
+        simp only [mem_inter, mem_image, exists_prop] at hx,
+        have : x = 0,
+        { apply le_antisymm,
+          { rcases hx.2 with ⟨a, ha, rfl⟩,
+            simp only [right.neg_nonpos_iff, nat.cast_nonneg] },
+          { rcases hx.1 with ⟨a, ha, rfl⟩,
+            simp only [nat.cast_nonneg] } },
+        simp only [this, eq_self_iff_true, if_true] }
+    end
+  ... = ∑ x in u1, f x + ∑ x in u2, f x : sum_union_inter
+  ... = ∑ b in v', f b + ∑ b in v', f (-b) :
+    by simp only [sum_image, nat.cast_inj, imp_self, implies_true_iff, neg_inj]
+  ... = ∑ b in v', (f b + f (-b)) : sum_add_distrib.symm
+end
+
+end nat
+
+end topological_group
+
+section uniform_group
+
+variables [add_comm_group α] [uniform_space α]
+
+/-- The **Cauchy criterion** for infinite sums, also known as the **Cauchy convergence test** -/
+lemma summable_iff_cauchy_seq_finset [complete_space α] {f : β → α} :
+  summable f ↔ cauchy_seq (λ (s : finset β), ∑ b in s, f b) :=
+cauchy_map_iff_exists_tendsto.symm
+
+variables [uniform_add_group α] {f g : β → α} {a a₁ a₂ : α}
+
+lemma cauchy_seq_finset_iff_vanishing :
+  cauchy_seq (λ (s : finset β), ∑ b in s, f b)
+  ↔ ∀ e ∈ 𝓝 (0:α), (∃s:finset β, ∀t, disjoint t s → ∑ b in t, f b ∈ e) :=
+begin
+  simp only [cauchy_seq, cauchy_map_iff, and_iff_right at_top_ne_bot,
+    prod_at_top_at_top_eq, uniformity_eq_comap_nhds_zero α, tendsto_comap_iff, (∘)],
+  rw [tendsto_at_top'],
+  split,
+  { assume h e he,
+    rcases h e he with ⟨⟨s₁, s₂⟩, h⟩,
+    use [s₁ ∪ s₂],
+    assume t ht,
+    specialize h (s₁ ∪ s₂, (s₁ ∪ s₂) ∪ t) ⟨le_sup_left, le_sup_of_le_left le_sup_right⟩,
+    simpa only [finset.sum_union ht.symm, add_sub_cancel'] using h },
+  { assume h e he,
+    rcases exists_nhds_half_neg he with ⟨d, hd, hde⟩,
+    rcases h d hd with ⟨s, h⟩,
+    use [(s, s)],
+    rintros ⟨t₁, t₂⟩ ⟨ht₁, ht₂⟩,
+    have : ∑ b in t₂, f b - ∑ b in t₁, f b = ∑ b in t₂ \ s, f b - ∑ b in t₁ \ s, f b,
+    { simp only [(finset.sum_sdiff ht₁).symm, (finset.sum_sdiff ht₂).symm,
+        add_sub_add_right_eq_sub] },
+    simp only [this],
+    exact hde _ (h _ finset.sdiff_disjoint) _ (h _ finset.sdiff_disjoint) }
+end
+
+/-- The sum over the complement of a finset tends to `0` when the finset grows to cover the whole
+space. This does not need a summability assumption, as otherwise all sums are zero. -/
+lemma tendsto_tsum_compl_at_top_zero (f : β → α) :
+  tendsto (λ (s : finset β), ∑' b : {x // x ∉ s}, f b) at_top (𝓝 0) :=
+begin
+  by_cases H : summable f,
+  { assume e he,
+    rcases exists_mem_nhds_is_closed_subset he with ⟨o, ho, o_closed, oe⟩,
+    simp only [le_eq_subset, set.mem_preimage, mem_at_top_sets, filter.mem_map, ge_iff_le],
+    obtain ⟨s, hs⟩ : ∃ (s : finset β), ∀ (t : finset β), disjoint t s → ∑ (b : β) in t, f b ∈ o :=
+      cauchy_seq_finset_iff_vanishing.1 (tendsto.cauchy_seq H.has_sum) o ho,
+    refine ⟨s, λ a sa, oe _⟩,
+    have A : summable (λ b : {x // x ∉ a}, f b) := a.summable_compl_iff.2 H,
+    apply is_closed.mem_of_tendsto o_closed A.has_sum (eventually_of_forall (λ b, _)),
+    have : disjoint (finset.image (λ (i : {x // x ∉ a}), (i : β)) b) s,
+    { apply disjoint_left.2 (λ i hi his, _),
+      rcases mem_image.1 hi with ⟨i', hi', rfl⟩,
+      exact i'.2 (sa his), },
+    convert hs _ this using 1,
+    rw sum_image,
+    assume i hi j hj hij,
+    exact subtype.ext hij },
+  { convert tendsto_const_nhds,
+    ext s,
+    apply tsum_eq_zero_of_not_summable,
+    rwa finset.summable_compl_iff }
+end
+
+variable [complete_space α]
+
+lemma summable_iff_vanishing :
+  summable f ↔ ∀ e ∈ 𝓝 (0:α), (∃s:finset β, ∀t, disjoint t s → ∑ b in t, f b ∈ e) :=
+by rw [summable_iff_cauchy_seq_finset, cauchy_seq_finset_iff_vanishing]
+
+/- TODO: generalize to monoid with a uniform continuous subtraction operator: `(a + b) - b = a` -/
+lemma summable.summable_of_eq_zero_or_self (hf : summable f) (h : ∀b, g b = 0 ∨ g b = f b) :
+  summable g :=
+summable_iff_vanishing.2 $
+  assume e he,
+  let ⟨s, hs⟩ := summable_iff_vanishing.1 hf e he in
+  ⟨s, assume t ht,
+    have eq : ∑ b in t.filter (λb, g b = f b), f b = ∑ b in t, g b :=
+      calc ∑ b in t.filter (λb, g b = f b), f b = ∑ b in t.filter (λb, g b = f b), g b :
+          finset.sum_congr rfl (assume b hb, (finset.mem_filter.1 hb).2.symm)
+        ... = ∑ b in t, g b :
+        begin
+          refine finset.sum_subset (finset.filter_subset _ _) _,
+          assume b hbt hb,
+          simp only [(∉), finset.mem_filter, and_iff_right hbt] at hb,
+          exact (h b).resolve_right hb
+        end,
+    eq ▸ hs _ $ finset.disjoint_of_subset_left (finset.filter_subset _ _) ht⟩
+
+protected lemma summable.indicator (hf : summable f) (s : set β) :
+  summable (s.indicator f) :=
+hf.summable_of_eq_zero_or_self $ set.indicator_eq_zero_or_self _ _
+
+lemma summable.comp_injective {i : γ → β} (hf : summable f) (hi : injective i) :
+  summable (f ∘ i) :=
+begin
+  simpa only [set.indicator_range_comp]
+    using (hi.summable_iff _).2 (hf.indicator (set.range i)),
+  exact λ x hx, set.indicator_of_not_mem hx _
+end
+
+lemma summable.subtype (hf : summable f) (s : set β) : summable (f ∘ coe : s → α) :=
+hf.comp_injective subtype.coe_injective
+
+lemma summable_subtype_and_compl {s : set β} :
+  summable (λ x : s, f x) ∧ summable (λ x : sᶜ, f x) ↔ summable f :=
+⟨and_imp.2 summable.add_compl, λ h, ⟨h.subtype s, h.subtype sᶜ⟩⟩
+
+lemma summable.sigma_factor {γ : β → Type*} {f : (Σb:β, γ b) → α}
+  (ha : summable f) (b : β) : summable (λc, f ⟨b, c⟩) :=
+ha.comp_injective sigma_mk_injective
+
+lemma summable.sigma {γ : β → Type*} {f : (Σb:β, γ b) → α}
+  (ha : summable f) : summable (λb, ∑'c, f ⟨b, c⟩) :=
+ha.sigma' (λ b, ha.sigma_factor b)
+
+lemma summable.prod_factor {f : β × γ → α} (h : summable f) (b : β) :
+  summable (λ c, f (b, c)) :=
+h.comp_injective $ λ c₁ c₂ h, (prod.ext_iff.1 h).2
+
+section loc_instances
+-- enable inferring a T3-topological space from a topological group
+local attribute [instance] topological_add_group.t3_space
+-- disable getting a T0-space from a T3-space as this causes loops
+local attribute [-instance] t3_space.to_t0_space
+
+lemma tsum_sigma [t0_space α] {γ : β → Type*} {f : (Σb:β, γ b) → α}
+  (ha : summable f) : ∑'p, f p = ∑'b c, f ⟨b, c⟩ :=
+tsum_sigma' (λ b, ha.sigma_factor b) ha
+
+lemma tsum_prod [t0_space α] {f : β × γ → α} (h : summable f) :
+  ∑'p, f p = ∑'b c, f ⟨b, c⟩ :=
+tsum_prod' h h.prod_factor
+
+lemma tsum_comm [t0_space α] {f : β → γ → α} (h : summable (function.uncurry f)) :
+  ∑' c b, f b c = ∑' b c, f b c :=
+tsum_comm' h h.prod_factor h.prod_symm.prod_factor
+
+end loc_instances
+
+lemma tsum_subtype_add_tsum_subtype_compl [t2_space α] {f : β → α} (hf : summable f) (s : set β) :
+  ∑' x : s, f x + ∑' x : sᶜ, f x = ∑' x, f x :=
+((hf.subtype s).has_sum.add_compl (hf.subtype {x | x ∉ s}).has_sum).unique hf.has_sum
+
+lemma sum_add_tsum_subtype_compl [t2_space α] {f : β → α} (hf : summable f) (s : finset β) :
+  ∑ x in s, f x + ∑' x : {x // x ∉ s}, f x = ∑' x, f x :=
+begin
+  rw ← tsum_subtype_add_tsum_subtype_compl hf s,
+  simp only [finset.tsum_subtype', add_right_inj],
+  refl,
+end
+
+end uniform_group
+
+section topological_group
+
+variables {G : Type*} [topological_space G] [add_comm_group G] [topological_add_group G]
+  {f : α → G}
+
+lemma summable.vanishing (hf : summable f) ⦃e : set G⦄ (he : e ∈ 𝓝 (0 : G)) :
+  ∃ s : finset α, ∀ t, disjoint t s → ∑ k in t, f k ∈ e :=
+begin
+  letI : uniform_space G := topological_add_group.to_uniform_space G,
+  letI : uniform_add_group G := topological_add_comm_group_is_uniform,
+  rcases hf with ⟨y, hy⟩,
+  exact cauchy_seq_finset_iff_vanishing.1 hy.cauchy_seq e he
+end
+
+/-- Series divergence test: if `f` is a convergent series, then `f x` tends to zero along
+`cofinite`. -/
+lemma summable.tendsto_cofinite_zero (hf : summable f) : tendsto f cofinite (𝓝 0) :=
+begin
+  intros e he,
+  rw [filter.mem_map],
+  rcases hf.vanishing he with ⟨s, hs⟩,
+  refine s.eventually_cofinite_nmem.mono (λ x hx, _),
+  by simpa using hs {x} (disjoint_singleton_left.2 hx)
+end
+
+lemma summable.tendsto_at_top_zero {f : ℕ → G} (hf : summable f) : tendsto f at_top (𝓝 0) :=
+by { rw ←nat.cofinite_eq_at_top, exact hf.tendsto_cofinite_zero }
+
+end topological_group
+
+section const_smul
+variables [monoid γ] [topological_space α] [add_comm_monoid α] [distrib_mul_action γ α]
+  [has_continuous_const_smul γ α] {f : β → α}
+
+lemma has_sum.const_smul {a : α} (b : γ) (hf : has_sum f a) : has_sum (λ i, b • f i) (b • a) :=
+hf.map (distrib_mul_action.to_add_monoid_hom α _) $ continuous_const_smul _
+
+lemma summable.const_smul (b : γ) (hf : summable f) : summable (λ i, b • f i) :=
+(hf.has_sum.const_smul _).summable
+
+/-- Infinite sums commute with scalar multiplication. Version for scalars living in a `monoid`, but
+  requiring a summability hypothesis. -/
+lemma tsum_const_smul [t2_space α] (b : γ) (hf : summable f) : ∑' i, b • f i = b • ∑' i, f i :=
+(hf.has_sum.const_smul _).tsum_eq
+
+/-- Infinite sums commute with scalar multiplication. Version for scalars living in a `group`, but
+  not requiring any summability hypothesis. -/
+lemma tsum_const_smul' {γ : Type*} [group γ] [distrib_mul_action γ α]
+  [has_continuous_const_smul γ α] [t2_space α] (g : γ) :
+  ∑' (i : β), g • f i = g • ∑' (i : β), f i :=
+begin
+  by_cases hf : summable f,
+  { exact tsum_const_smul _ hf, },
+  rw tsum_eq_zero_of_not_summable hf,
+  simp only [smul_zero],
+  let mul_g : α ≃+ α := distrib_mul_action.to_add_equiv α g,
+  apply tsum_eq_zero_of_not_summable,
+  change ¬ summable (mul_g ∘ f),
+  rwa summable.map_iff_of_equiv mul_g; apply continuous_const_smul,
+end
+
+/-- Infinite sums commute with scalar multiplication. Version for scalars living in a
+  `division_ring`; no summability hypothesis. This could be made to work for a
+  `[group_with_zero γ]` if there was such a thing as `distrib_mul_action_with_zero`. -/
+lemma tsum_const_smul'' {γ : Type*} [division_ring γ] [module γ α] [has_continuous_const_smul γ α]
+  [t2_space α] (g : γ) :
+  ∑' (i : β), g • f i = g • ∑' (i : β), f i :=
+begin
+  by_cases hf : summable f,
+  { exact tsum_const_smul _ hf, },
+  rw tsum_eq_zero_of_not_summable hf,
+  simp only [smul_zero],
+  by_cases hg : g = 0,
+  { simp [hg], },
+  let mul_g : α ≃+ α := distrib_mul_action.to_add_equiv₀ α g hg,
+  apply tsum_eq_zero_of_not_summable,
+  change ¬ summable (mul_g ∘ f),
+  rwa summable.map_iff_of_equiv mul_g; apply continuous_const_smul,
+end
+
+end const_smul
+
+/-! ### Product and pi types -/
+
+section prod
+variables [add_comm_monoid α] [topological_space α] [add_comm_monoid γ] [topological_space γ]
+
+lemma has_sum.prod_mk {f : β → α} {g : β → γ} {a : α} {b : γ}
+  (hf : has_sum f a) (hg : has_sum g b) :
+  has_sum (λ x, (⟨f x, g x⟩ : α × γ)) ⟨a, b⟩ :=
+by simp [has_sum, ← prod_mk_sum, filter.tendsto.prod_mk_nhds hf hg]
+
+end prod
+
+section pi
+variables {ι : Type*} {π : α → Type*} [∀ x, add_comm_monoid (π x)] [∀ x, topological_space (π x)]
+
+lemma pi.has_sum {f : ι → ∀ x, π x} {g : ∀ x, π x} :
+  has_sum f g ↔ ∀ x, has_sum (λ i, f i x) (g x) :=
+by simp only [has_sum, tendsto_pi_nhds, sum_apply]
+
+lemma pi.summable {f : ι → ∀ x, π x} : summable f ↔ ∀ x, summable (λ i, f i x) :=
+by simp only [summable, pi.has_sum, skolem]
+
+lemma tsum_apply [∀ x, t2_space (π x)] {f : ι → ∀ x, π x}{x : α} (hf : summable f) :
+  (∑' i, f i) x = ∑' i, f i x :=
+(pi.has_sum.mp hf.has_sum x).tsum_eq.symm
+
+end pi
+
+/-! ### Multiplicative opposite -/
+
+section mul_opposite
+open mul_opposite
+variables [add_comm_monoid α] [topological_space α] {f : β → α} {a : α}
+
+lemma has_sum.op (hf : has_sum f a) : has_sum (λ a, op (f a)) (op a) :=
+(hf.map (@op_add_equiv α _) continuous_op : _)
+
+lemma summable.op (hf : summable f) : summable (op ∘ f) := hf.has_sum.op.summable
+
+lemma has_sum.unop {f : β → αᵐᵒᵖ} {a : αᵐᵒᵖ} (hf : has_sum f a) :
+  has_sum (λ a, unop (f a)) (unop a) :=
+(hf.map (@op_add_equiv α _).symm continuous_unop : _)
+
+lemma summable.unop {f : β → αᵐᵒᵖ} (hf : summable f) : summable (unop ∘ f) :=
+hf.has_sum.unop.summable
+
+@[simp] lemma has_sum_op : has_sum (λ a, op (f a)) (op a) ↔ has_sum f a :=
+⟨has_sum.unop, has_sum.op⟩
+
+@[simp] lemma has_sum_unop {f : β → αᵐᵒᵖ} {a : αᵐᵒᵖ} :
+  has_sum (λ a, unop (f a)) (unop a) ↔ has_sum f a :=
+⟨has_sum.op, has_sum.unop⟩
+
+@[simp] lemma summable_op : summable (λ a, op (f a)) ↔ summable f := ⟨summable.unop, summable.op⟩
+
+@[simp] lemma summable_unop {f : β → αᵐᵒᵖ} : summable (λ a, unop (f a)) ↔ summable f :=
+⟨summable.op, summable.unop⟩
+
+variables [t2_space α]
+
+lemma tsum_op : ∑' x, mul_opposite.op (f x) = mul_opposite.op (∑' x, f x) :=
+begin
+  by_cases h : summable f,
+  { exact h.has_sum.op.tsum_eq },
+  { have ho := summable_op.not.mpr h,
+    rw [tsum_eq_zero_of_not_summable h, tsum_eq_zero_of_not_summable ho, mul_opposite.op_zero] }
+end
+
+lemma tsum_unop {f : β → αᵐᵒᵖ} : ∑' x, mul_opposite.unop (f x) = mul_opposite.unop (∑' x, f x) :=
+mul_opposite.op_injective tsum_op.symm
+
+end mul_opposite
+
+/-! ### Interaction with the star -/
+
+section has_continuous_star
+variables [add_comm_monoid α] [topological_space α] [star_add_monoid α] [has_continuous_star α]
+  {f : β → α} {a : α}
+
+lemma has_sum.star (h : has_sum f a) : has_sum (λ b, star (f b)) (star a) :=
+by simpa only using h.map (star_add_equiv : α ≃+ α) continuous_star
+
+lemma summable.star (hf : summable f) : summable (λ b, star (f b)) :=
+hf.has_sum.star.summable
+
+lemma summable.of_star (hf : summable (λ b, star (f b))) : summable f :=
+by simpa only [star_star] using hf.star
+
+@[simp] lemma summable_star_iff : summable (λ b, star (f b)) ↔ summable f :=
+⟨summable.of_star, summable.star⟩
+
+@[simp] lemma summable_star_iff' : summable (star f) ↔ summable f := summable_star_iff
+
+variables [t2_space α]
+
+lemma tsum_star : star (∑' b, f b) = ∑' b, star (f b) :=
+begin
+  by_cases hf : summable f,
+  { exact hf.has_sum.star.tsum_eq.symm, },
+  { rw [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable (mt summable.of_star hf),
+        star_zero] },
+end
+
+end has_continuous_star
+
+section automorphize
+
+variables {M : Type*} [topological_space M] [add_comm_monoid M] [t2_space M] {R : Type*}
+  [division_ring R] [module R M] [has_continuous_const_smul R M]
+
+/-- Given a group `α` acting on a type `β`, and a function `f : β → M`, we "automorphize" `f` to a
+  function `β ⧸ α → M` by summing over `α` orbits, `b ↦ ∑' (a : α), f(a • b)`. -/
+@[to_additive "Given an additive group `α` acting on a type `β`, and a function `f : β → M`,
+  we automorphize `f` to a function `β ⧸ α → M` by summing over `α` orbits,
+  `b ↦ ∑' (a : α), f(a • b)`."]
+def mul_action.automorphize [group α] [mul_action α β] (f : β → M) :
+  quotient (mul_action.orbit_rel α β) → M :=
+@quotient.lift _ _ (mul_action.orbit_rel α β) (λ b, ∑' (a : α), f(a • b))
+begin
+  rintros b₁ b₂ ⟨a, (rfl : a • b₂ = b₁)⟩,
+  simpa [mul_smul] using (equiv.mul_right a).tsum_eq (λ a', f (a' • b₂)),
+end
+
+/-- Automorphization of a function into an `R`-`module` distributes, that is, commutes with the 
+  `R`-scalar multiplication. -/
+lemma mul_action.automorphize_smul_left [group α] [mul_action α β]  (f : β → M)
+  (g : quotient (mul_action.orbit_rel α β) → R) :
+  mul_action.automorphize ((g ∘ quotient.mk') • f)
+    = g • (mul_action.automorphize f : quotient (mul_action.orbit_rel α β) → M) :=
+begin
+  ext x,
+  apply quotient.induction_on' x,
+  intro b,
+  simp only [mul_action.automorphize, pi.smul_apply', function.comp_app],
+  set π : β → quotient (mul_action.orbit_rel α β) := quotient.mk',
+  have H₁ : ∀ a : α, π (a • b) = π b,
+  { intro a,
+    rw quotient.eq_rel,
+    fconstructor,
+    exact a,
+    simp, },
+  change ∑' a : α, g (π (a • b)) • f (a • b) = g (π b) • ∑' a : α, f (a • b),
+  simp_rw [H₁],
+  exact tsum_const_smul'' _,
+end
+
+/-- Automorphization of a function into an `R`-`module` distributes, that is, commutes with the 
+  `R`-scalar multiplication. -/
+lemma add_action.automorphize_smul_left [add_group α] [add_action α β]  (f : β → M)
+  (g : quotient (add_action.orbit_rel α β) → R) :
+  add_action.automorphize ((g ∘ quotient.mk') • f)
+    = g • (add_action.automorphize f : quotient (add_action.orbit_rel α β) → M) :=
+begin
+  ext x,
+  apply quotient.induction_on' x,
+  intro b,
+  simp only [add_action.automorphize, pi.smul_apply', function.comp_app],
+  set π : β → quotient (add_action.orbit_rel α β) := quotient.mk',
+  have H₁ : ∀ a : α, π (a +ᵥ b) = π b,
+  { intro a,
+    rw quotient.eq_rel,
+    fconstructor,
+    exact a,
+    simp, },
+  change ∑' a : α, g (π (a +ᵥ b)) • f (a +ᵥ b) = g (π b) • ∑' a : α, f (a +ᵥ b),
+  simp_rw [H₁],
+  exact tsum_const_smul'' _,
+end
+
+attribute [to_additive mul_action.automorphize_smul_left] add_action.automorphize_smul_left
+
+section
+
+variables {G : Type*} [group G] {Γ : subgroup G}
+
+/-- Given a subgroup `Γ` of a group `G`, and a function `f : G → M`, we "automorphize" `f` to a
+  function `G ⧸ Γ → M` by summing over `Γ` orbits, `g ↦ ∑' (γ : Γ), f(γ • g)`. -/
+@[to_additive "Given a subgroup `Γ` of an additive group `G`, and a function `f : G → M`, we
+  automorphize `f` to a function `G ⧸ Γ → M` by summing over `Γ` orbits,
+  `g ↦ ∑' (γ : Γ), f(γ • g)`."]
+def quotient_group.automorphize  (f : G → M) : G ⧸ Γ → M := mul_action.automorphize f
+
+/-- Automorphization of a function into an `R`-`module` distributes, that is, commutes with the 
+  `R`-scalar multiplication. -/
+lemma quotient_group.automorphize_smul_left (f : G → M) (g : G ⧸ Γ → R) :
+  quotient_group.automorphize ((g ∘ quotient.mk') • f)
+    = g • (quotient_group.automorphize f : G ⧸ Γ → M) :=
+mul_action.automorphize_smul_left f g
+
+end
+
+section
+
+variables {G : Type*} [add_group G] {Γ : add_subgroup G}
+
+/-- Automorphization of a function into an `R`-`module` distributes, that is, commutes with the `R`
+  -scalar multiplication. -/
+lemma quotient_add_group.automorphize_smul_left (f : G → M) (g : G ⧸ Γ → R) :
+  quotient_add_group.automorphize ((g ∘ quotient.mk') • f)
+    = g • (quotient_add_group.automorphize f : G ⧸ Γ → M) :=
+add_action.automorphize_smul_left f g
+
+end
+
+attribute [to_additive quotient_group.automorphize_smul_left]
+  quotient_add_group.automorphize_smul_left
+
+end automorphize
diff --git a/src/topology/algebra/infinite_sum/module.lean b/src/topology/algebra/infinite_sum/module.lean
new file mode 100644
index 0000000000000..ad9f0b35f7f74
--- /dev/null
+++ b/src/topology/algebra/infinite_sum/module.lean
@@ -0,0 +1,90 @@
+/-
+Copyright (c) 2020 Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Heather Macbeth, Yury Kudryashov, Frédéric Dupuis
+-/
+import topology.algebra.infinite_sum.basic
+import topology.algebra.module.basic
+
+/-! # Infinite sums in topological vector spaces 
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.-/
+
+variables {ι R R₂ M M₂ : Type*}
+
+section smul_const
+variables [semiring R] [topological_space R] [topological_space M] [add_comm_monoid M] [module R M]
+  [has_continuous_smul R M] {f : ι → R}
+
+lemma has_sum.smul_const {r : R} (hf : has_sum f r) (a : M) : has_sum (λ z, f z • a) (r • a) :=
+hf.map ((smul_add_hom R M).flip a) (continuous_id.smul continuous_const)
+
+lemma summable.smul_const (hf : summable f) (a : M) : summable (λ z, f z • a) :=
+(hf.has_sum.smul_const _).summable
+
+lemma tsum_smul_const [t2_space M] (hf : summable f) (a : M) : ∑' z, f z • a = (∑' z, f z) • a :=
+(hf.has_sum.smul_const _).tsum_eq
+
+end smul_const
+
+section has_sum
+
+-- Results in this section hold for continuous additive monoid homomorphisms or equivalences but we
+-- don't have bundled continuous additive homomorphisms.
+
+variables [semiring R] [semiring R₂] [add_comm_monoid M] [module R M]
+  [add_comm_monoid M₂] [module R₂ M₂] [topological_space M] [topological_space M₂]
+  {σ : R →+* R₂} {σ' : R₂ →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
+
+/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
+protected lemma continuous_linear_map.has_sum {f : ι → M} (φ : M →SL[σ] M₂) {x : M}
+  (hf : has_sum f x) :
+  has_sum (λ (b:ι), φ (f b)) (φ x) :=
+by simpa only using hf.map φ.to_linear_map.to_add_monoid_hom φ.continuous
+
+alias continuous_linear_map.has_sum ← has_sum.mapL
+
+protected lemma continuous_linear_map.summable {f : ι → M} (φ : M →SL[σ] M₂) (hf : summable f) :
+  summable (λ b:ι, φ (f b)) :=
+(hf.has_sum.mapL φ).summable
+
+alias continuous_linear_map.summable ← summable.mapL
+
+protected lemma continuous_linear_map.map_tsum [t2_space M₂] {f : ι → M}
+  (φ : M →SL[σ] M₂) (hf : summable f) : φ (∑' z, f z) = ∑' z, φ (f z) :=
+(hf.has_sum.mapL φ).tsum_eq.symm
+
+include σ'
+/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
+protected lemma continuous_linear_equiv.has_sum {f : ι → M} (e : M ≃SL[σ] M₂) {y : M₂} :
+  has_sum (λ (b:ι), e (f b)) y ↔ has_sum f (e.symm y) :=
+⟨λ h, by simpa only [e.symm.coe_coe, e.symm_apply_apply] using h.mapL (e.symm : M₂ →SL[σ'] M),
+  λ h, by simpa only [e.coe_coe, e.apply_symm_apply] using (e : M →SL[σ] M₂).has_sum h⟩
+
+/-- Applying a continuous linear map commutes with taking an (infinite) sum. -/
+protected lemma continuous_linear_equiv.has_sum' {f : ι → M} (e : M ≃SL[σ] M₂) {x : M} :
+  has_sum (λ (b:ι), e (f b)) (e x) ↔ has_sum f x :=
+by rw [e.has_sum, continuous_linear_equiv.symm_apply_apply]
+
+protected lemma continuous_linear_equiv.summable {f : ι → M} (e : M ≃SL[σ] M₂) :
+  summable (λ b:ι, e (f b)) ↔ summable f :=
+⟨λ hf, (e.has_sum.1 hf.has_sum).summable, (e : M →SL[σ] M₂).summable⟩
+
+
+lemma continuous_linear_equiv.tsum_eq_iff [t2_space M] [t2_space M₂] {f : ι → M}
+  (e : M ≃SL[σ] M₂) {y : M₂} : ∑' z, e (f z) = y ↔ ∑' z, f z = e.symm y :=
+begin
+  by_cases hf : summable f,
+  { exact ⟨λ h, (e.has_sum.mp ((e.summable.mpr hf).has_sum_iff.mpr h)).tsum_eq,
+      λ h, (e.has_sum.mpr (hf.has_sum_iff.mpr h)).tsum_eq⟩ },
+  { have hf' : ¬summable (λ z, e (f z)) := λ h, hf (e.summable.mp h),
+    rw [tsum_eq_zero_of_not_summable hf, tsum_eq_zero_of_not_summable hf'],
+    exact ⟨by { rintro rfl, simp }, λ H, by simpa using (congr_arg (λ z, e z) H)⟩ }
+end
+
+protected lemma continuous_linear_equiv.map_tsum [t2_space M] [t2_space M₂] {f : ι → M}
+  (e : M ≃SL[σ] M₂) : e (∑' z, f z) = ∑' z, e (f z) :=
+by { refine symm (e.tsum_eq_iff.mpr _), rw e.symm_apply_apply _ }
+
+end has_sum
diff --git a/src/topology/algebra/infinite_sum/order.lean b/src/topology/algebra/infinite_sum/order.lean
new file mode 100644
index 0000000000000..24371cd77237c
--- /dev/null
+++ b/src/topology/algebra/infinite_sum/order.lean
@@ -0,0 +1,265 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import algebra.order.archimedean
+import topology.algebra.infinite_sum.basic
+import topology.algebra.order.field
+import topology.algebra.order.monotone_convergence
+
+/-!
+# Infinite sum in an order
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides lemmas about the interaction of infinite sums and order operations.
+-/
+
+open finset filter function
+open_locale big_operators classical
+
+variables {ι κ α : Type*}
+
+section preorder
+variables [preorder α] [add_comm_monoid α] [topological_space α] [order_closed_topology α]
+  [t2_space α] {f : ℕ → α} {c : α}
+
+lemma tsum_le_of_sum_range_le (hf : summable f) (h : ∀ n, ∑ i in range n, f i ≤ c) :
+  ∑' n, f n ≤ c :=
+let ⟨l, hl⟩ := hf in hl.tsum_eq.symm ▸ le_of_tendsto' hl.tendsto_sum_nat h
+
+end preorder
+
+section ordered_add_comm_monoid
+variables [ordered_add_comm_monoid α] [topological_space α] [order_closed_topology α] {f g : ι → α}
+  {a a₁ a₂ : α}
+
+lemma has_sum_le (h : ∀ i, f i ≤ g i) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ ≤ a₂ :=
+le_of_tendsto_of_tendsto' hf hg $ λ s, sum_le_sum $ λ i _, h i
+
+@[mono] lemma has_sum_mono (hf : has_sum f a₁) (hg : has_sum g a₂) (h : f ≤ g) : a₁ ≤ a₂ :=
+has_sum_le h hf hg
+
+lemma has_sum_le_of_sum_le (hf : has_sum f a) (h : ∀ s, ∑ i in s, f i ≤ a₂) : a ≤ a₂ :=
+le_of_tendsto' hf h
+
+lemma le_has_sum_of_le_sum (hf : has_sum f a) (h : ∀ s, a₂ ≤ ∑ i in s, f i) : a₂ ≤ a :=
+ge_of_tendsto' hf h
+
+lemma has_sum_le_inj {g : κ → α} (e : ι → κ) (he : injective e) (hs : ∀ c ∉ set.range e, 0 ≤ g c)
+  (h : ∀ i, f i ≤ g (e i)) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ ≤ a₂ :=
+have has_sum (λ c, (partial_inv e c).cases_on' 0 f) a₁,
+begin
+  refine (has_sum_iff_has_sum_of_ne_zero_bij (e ∘ coe) (λ c₁ c₂ hc, he hc) (λ c hc, _) _).2 hf,
+  { rw mem_support at hc,
+    cases eq : partial_inv e c with i; rw eq at hc,
+    { contradiction },
+    { rw [partial_inv_of_injective he] at eq,
+      exact ⟨⟨i, hc⟩, eq⟩ } },
+  { rintro c,
+    simp [partial_inv_left he, option.cases_on'] }
+end,
+begin
+  refine has_sum_le (λ c, _) this hg,
+  obtain ⟨i, rfl⟩ | h := em (c ∈ set.range e),
+  { rw [partial_inv_left he, option.cases_on'],
+    exact h _ },
+  { have : partial_inv e c = none := dif_neg h,
+    rw [this, option.cases_on'],
+    exact hs _ h }
+end
+
+lemma tsum_le_tsum_of_inj {g : κ → α} (e : ι → κ) (he : injective e)
+  (hs : ∀ c ∉ set.range e, 0 ≤ g c) (h : ∀ i, f i ≤ g (e i)) (hf : summable f) (hg : summable g) :
+  tsum f ≤ tsum g :=
+has_sum_le_inj _ he hs h hf.has_sum hg.has_sum
+
+lemma sum_le_has_sum (s : finset ι) (hs : ∀ i ∉ s, 0 ≤ f i) (hf : has_sum f a) :
+  ∑ i in s, f i ≤ a :=
+ge_of_tendsto hf (eventually_at_top.2 ⟨s, λ t hst,
+  sum_le_sum_of_subset_of_nonneg hst $ λ i hbt hbs, hs i hbs⟩)
+
+lemma is_lub_has_sum (h : ∀ i, 0 ≤ f i) (hf : has_sum f a) :
+  is_lub (set.range $ λ s, ∑ i in s, f i) a :=
+is_lub_of_tendsto_at_top (finset.sum_mono_set_of_nonneg h) hf
+
+lemma le_has_sum (hf : has_sum f a) (i : ι) (hb : ∀ b' ≠ i, 0 ≤ f b') : f i ≤ a :=
+calc f i = ∑ i in {i}, f i : finset.sum_singleton.symm
+... ≤ a : sum_le_has_sum _ (by { convert hb, simp }) hf
+
+lemma sum_le_tsum {f : ι → α} (s : finset ι) (hs : ∀ i ∉ s, 0 ≤ f i) (hf : summable f) :
+  ∑ i in s, f i ≤ ∑' i, f i :=
+sum_le_has_sum s hs hf.has_sum
+
+lemma le_tsum (hf : summable f) (i : ι) (hb : ∀ b' ≠ i, 0 ≤ f b') : f i ≤ ∑' i, f i :=
+le_has_sum (summable.has_sum hf) i hb
+
+lemma tsum_le_tsum (h : ∀ i, f i ≤ g i) (hf : summable f) (hg : summable g) :
+  ∑' i, f i ≤ ∑' i, g i :=
+has_sum_le h hf.has_sum hg.has_sum
+
+@[mono] lemma tsum_mono (hf : summable f) (hg : summable g) (h : f ≤ g) :
+  ∑' n, f n ≤ ∑' n, g n :=
+tsum_le_tsum h hf hg
+
+lemma tsum_le_of_sum_le (hf : summable f) (h : ∀ s, ∑ i in s, f i ≤ a₂) : ∑' i, f i ≤ a₂ :=
+has_sum_le_of_sum_le hf.has_sum h
+
+lemma tsum_le_of_sum_le' (ha₂ : 0 ≤ a₂) (h : ∀ s, ∑ i in s, f i ≤ a₂) : ∑' i, f i ≤ a₂ :=
+begin
+  by_cases hf : summable f,
+  { exact tsum_le_of_sum_le hf h },
+  { rw tsum_eq_zero_of_not_summable hf,
+    exact ha₂ }
+end
+
+lemma has_sum.nonneg (h : ∀ i, 0 ≤ g i) (ha : has_sum g a) : 0 ≤ a := has_sum_le h has_sum_zero ha
+lemma has_sum.nonpos (h : ∀ i, g i ≤ 0) (ha : has_sum g a) : a ≤ 0 := has_sum_le h ha has_sum_zero
+
+lemma tsum_nonneg (h : ∀ i, 0 ≤ g i) : 0 ≤ ∑' i, g i :=
+begin
+  by_cases hg : summable g,
+  { exact hg.has_sum.nonneg h },
+  { simp [tsum_eq_zero_of_not_summable hg] }
+end
+
+lemma tsum_nonpos (h : ∀ i, f i ≤ 0) : ∑' i, f i ≤ 0 :=
+begin
+  by_cases hf : summable f,
+  { exact hf.has_sum.nonpos h },
+  { simp [tsum_eq_zero_of_not_summable hf] }
+end
+
+end ordered_add_comm_monoid
+
+section ordered_add_comm_group
+variables [ordered_add_comm_group α] [topological_space α] [topological_add_group α]
+  [order_closed_topology α] {f g : ι → α} {a₁ a₂ : α} {i : ι}
+
+lemma has_sum_lt (h : f ≤ g) (hi : f i < g i) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ < a₂ :=
+have update f i 0 ≤ update g i 0 := update_le_update_iff.mpr ⟨rfl.le, λ i _, h i⟩,
+have 0 - f i + a₁ ≤ 0 - g i + a₂ := has_sum_le this (hf.update i 0) (hg.update i 0),
+by simpa only [zero_sub, add_neg_cancel_left] using add_lt_add_of_lt_of_le hi this
+
+@[mono] lemma has_sum_strict_mono (hf : has_sum f a₁) (hg : has_sum g a₂) (h : f < g) : a₁ < a₂ :=
+let ⟨hle, i, hi⟩ := pi.lt_def.mp h in has_sum_lt hle hi hf hg
+
+lemma tsum_lt_tsum (h : f ≤ g) (hi : f i < g i) (hf : summable f) (hg : summable g) :
+  ∑' n, f n < ∑' n, g n :=
+has_sum_lt h hi hf.has_sum hg.has_sum
+
+@[mono] lemma tsum_strict_mono (hf : summable f) (hg : summable g) (h : f < g) :
+  ∑' n, f n < ∑' n, g n :=
+let ⟨hle, i, hi⟩ := pi.lt_def.mp h in tsum_lt_tsum hle hi hf hg
+
+lemma tsum_pos (hsum : summable g) (hg : ∀ i, 0 ≤ g i) (i : ι) (hi : 0 < g i) : 0 < ∑' i, g i :=
+by { rw ←tsum_zero, exact tsum_lt_tsum hg hi summable_zero hsum }
+
+lemma has_sum_zero_iff_of_nonneg (hf : ∀ i, 0 ≤ f i) : has_sum f 0 ↔ f = 0 :=
+begin
+  refine ⟨λ hf', _, _⟩,
+  { ext i,
+    refine (hf i).eq_of_not_gt (λ hi, _),
+    simpa using has_sum_lt hf hi has_sum_zero hf' },
+  { rintro rfl,
+    exact has_sum_zero }
+end
+
+end ordered_add_comm_group
+
+section canonically_ordered_add_monoid
+variables [canonically_ordered_add_monoid α] [topological_space α] [order_closed_topology α]
+  {f : ι → α} {a : α}
+
+lemma le_has_sum' (hf : has_sum f a) (i : ι) : f i ≤ a := le_has_sum hf i $ λ _ _, zero_le _
+
+lemma le_tsum' (hf : summable f) (i : ι) : f i ≤ ∑' i, f i := le_tsum hf i $ λ _ _, zero_le _
+
+lemma has_sum_zero_iff : has_sum f 0 ↔ ∀ x, f x = 0 :=
+begin
+  refine ⟨_, λ h, _⟩,
+  { contrapose!,
+    exact λ ⟨x, hx⟩ h, hx (nonpos_iff_eq_zero.1$ le_has_sum' h x) },
+  { convert has_sum_zero,
+    exact funext h }
+end
+
+lemma tsum_eq_zero_iff (hf : summable f) : ∑' i, f i = 0 ↔ ∀ x, f x = 0 :=
+by rw [←has_sum_zero_iff, hf.has_sum_iff]
+
+lemma tsum_ne_zero_iff (hf : summable f) : ∑' i, f i ≠ 0 ↔ ∃ x, f x ≠ 0 :=
+by rw [ne.def, tsum_eq_zero_iff hf, not_forall]
+
+lemma is_lub_has_sum' (hf : has_sum f a) : is_lub (set.range $ λ s, ∑ i in s, f i) a :=
+is_lub_of_tendsto_at_top (finset.sum_mono_set f) hf
+
+end canonically_ordered_add_monoid
+
+section linear_order
+
+/-!
+For infinite sums taking values in a linearly ordered monoid, the existence of a least upper
+bound for the finite sums is a criterion for summability.
+
+This criterion is useful when applied in a linearly ordered monoid which is also a complete or
+conditionally complete linear order, such as `ℝ`, `ℝ≥0`, `ℝ≥0∞`, because it is then easy to check
+the existence of a least upper bound.
+-/
+
+lemma has_sum_of_is_lub_of_nonneg [linear_ordered_add_comm_monoid α] [topological_space α]
+  [order_topology α] {f : ι → α} (i : α) (h : ∀ i, 0 ≤ f i)
+  (hf : is_lub (set.range $ λ s, ∑ i in s, f i) i) :
+  has_sum f i :=
+tendsto_at_top_is_lub (finset.sum_mono_set_of_nonneg h) hf
+
+lemma has_sum_of_is_lub [canonically_linear_ordered_add_monoid α] [topological_space α]
+   [order_topology α] {f : ι → α} (b : α) (hf : is_lub (set.range $ λ s, ∑ i in s, f i) b) :
+  has_sum f b :=
+tendsto_at_top_is_lub (finset.sum_mono_set f) hf
+
+lemma summable_abs_iff [linear_ordered_add_comm_group α] [uniform_space α] [uniform_add_group α]
+  [complete_space α] {f : ι → α} :
+  summable (λ x, |f x|) ↔ summable f :=
+have h1 : ∀ x : {x | 0 ≤ f x}, |f x| = f x := λ x, abs_of_nonneg x.2,
+have h2 : ∀ x : {x | 0 ≤ f x}ᶜ, |f x| = -f x := λ x, abs_of_neg (not_le.1 x.2),
+calc summable (λ x, |f x|) ↔
+  summable (λ x : {x | 0 ≤ f x}, |f x|) ∧ summable (λ x : {x | 0 ≤ f x}ᶜ, |f x|) :
+  summable_subtype_and_compl.symm
+... ↔ summable (λ x : {x | 0 ≤ f x}, f x) ∧ summable (λ x : {x | 0 ≤ f x}ᶜ, -f x) :
+  by simp only [h1, h2]
+... ↔ _ : by simp only [summable_neg_iff, summable_subtype_and_compl]
+
+alias summable_abs_iff ↔ summable.of_abs summable.abs
+
+--TODO: Change the conclusion to `finite ι`
+lemma finite_of_summable_const [linear_ordered_add_comm_group α] [topological_space α]
+  [archimedean α] [order_closed_topology α] {b : α} (hb : 0 < b) (hf : summable (λ i : ι, b)) :
+  (set.univ : set ι).finite :=
+begin
+  have H : ∀ s : finset ι, s.card • b ≤ ∑' i : ι, b,
+  { intros s,
+    simpa using sum_le_has_sum s (λ a ha, hb.le) hf.has_sum },
+  obtain ⟨n, hn⟩ := archimedean.arch (∑' i : ι, b) hb,
+  have : ∀ s : finset ι, s.card ≤ n,
+  { intros s,
+    simpa [nsmul_le_nsmul_iff hb] using (H s).trans hn },
+  haveI : fintype ι := fintype_of_finset_card_le n this,
+  exact set.finite_univ
+end
+
+end linear_order
+
+lemma summable.tendsto_top_of_pos [linear_ordered_field α] [topological_space α] [order_topology α]
+  {f : ℕ → α} (hf : summable f⁻¹) (hf' : ∀ n, 0 < f n) : tendsto f at_top at_top :=
+begin
+  rw ←inv_inv f,
+  apply filter.tendsto.inv_tendsto_zero,
+  apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+    (summable.tendsto_at_top_zero hf),
+  rw eventually_iff_exists_mem,
+  refine ⟨set.Ioi 0, Ioi_mem_at_top _, λ _ _, _⟩,
+  rw [set.mem_Ioi, inv_eq_one_div, one_div, pi.inv_apply, _root_.inv_pos],
+  exact hf' _,
+end
diff --git a/src/topology/algebra/infinite_sum/real.lean b/src/topology/algebra/infinite_sum/real.lean
new file mode 100644
index 0000000000000..3db37b9ec6770
--- /dev/null
+++ b/src/topology/algebra/infinite_sum/real.lean
@@ -0,0 +1,94 @@
+/-
+Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel, Yury Kudryashov
+-/
+import algebra.big_operators.intervals
+import topology.algebra.infinite_sum.order
+import topology.instances.real
+
+/-!
+# Infinite sum in the reals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides lemmas about Cauchy sequences in terms of infinite sums.
+-/
+
+open filter finset
+open_locale big_operators nnreal topology
+
+variables {α : Type*}
+
+/-- If the extended distance between consecutive points of a sequence is estimated
+by a summable series of `nnreal`s, then the original sequence is a Cauchy sequence. -/
+lemma cauchy_seq_of_edist_le_of_summable [pseudo_emetric_space α] {f : ℕ → α} (d : ℕ → ℝ≥0)
+  (hf : ∀ n, edist (f n) (f n.succ) ≤ d n) (hd : summable d) : cauchy_seq f :=
+begin
+  refine emetric.cauchy_seq_iff_nnreal.2 (λ ε εpos, _),
+  -- Actually we need partial sums of `d` to be a Cauchy sequence
+  replace hd : cauchy_seq (λ (n : ℕ), ∑ x in range n, d x) :=
+    let ⟨_, H⟩ := hd in H.tendsto_sum_nat.cauchy_seq,
+  -- Now we take the same `N` as in one of the definitions of a Cauchy sequence
+  refine (metric.cauchy_seq_iff'.1 hd ε (nnreal.coe_pos.2 εpos)).imp (λ N hN n hn, _),
+  have hsum := hN n hn,
+  -- We simplify the known inequality
+  rw [dist_nndist, nnreal.nndist_eq, ← sum_range_add_sum_Ico _ hn, add_tsub_cancel_left] at hsum,
+  norm_cast at hsum,
+  replace hsum := lt_of_le_of_lt (le_max_left _ _) hsum,
+  rw edist_comm,
+  -- Then use `hf` to simplify the goal to the same form
+  apply lt_of_le_of_lt (edist_le_Ico_sum_of_edist_le hn (λ k _ _, hf k)),
+  assumption_mod_cast
+end
+
+variables [pseudo_metric_space α] {f : ℕ → α} {a : α}
+
+/-- If the distance between consecutive points of a sequence is estimated by a summable series,
+then the original sequence is a Cauchy sequence. -/
+lemma cauchy_seq_of_dist_le_of_summable (d : ℕ → ℝ) (hf : ∀ n, dist (f n) (f n.succ) ≤ d n)
+  (hd : summable d) : cauchy_seq f :=
+begin
+  refine metric.cauchy_seq_iff'.2 (λε εpos, _),
+  replace hd : cauchy_seq (λ (n : ℕ), ∑ x in range n, d x) :=
+    let ⟨_, H⟩ := hd in H.tendsto_sum_nat.cauchy_seq,
+  refine (metric.cauchy_seq_iff'.1 hd ε εpos).imp (λ N hN n hn, _),
+  have hsum := hN n hn,
+  rw [real.dist_eq, ← sum_Ico_eq_sub _ hn] at hsum,
+  calc dist (f n) (f N) = dist (f N) (f n) : dist_comm _ _
+  ... ≤ ∑ x in Ico N n, d x : dist_le_Ico_sum_of_dist_le hn (λ k _ _, hf k)
+  ... ≤ |∑ x in Ico N n, d x| : le_abs_self _
+  ... < ε : hsum
+end
+
+lemma cauchy_seq_of_summable_dist (h : summable (λ n, dist (f n) (f n.succ))) : cauchy_seq f :=
+cauchy_seq_of_dist_le_of_summable _ (λ _, le_rfl) h
+
+lemma dist_le_tsum_of_dist_le_of_tendsto (d : ℕ → ℝ) (hf : ∀ n, dist (f n) (f n.succ) ≤ d n)
+  (hd : summable d) {a : α} (ha : tendsto f at_top (𝓝 a)) (n : ℕ) :
+  dist (f n) a ≤ ∑' m, d (n + m) :=
+begin
+  refine le_of_tendsto (tendsto_const_nhds.dist ha)
+    (eventually_at_top.2 ⟨n, λ m hnm, _⟩),
+  refine le_trans (dist_le_Ico_sum_of_dist_le hnm (λ k _ _, hf k)) _,
+  rw [sum_Ico_eq_sum_range],
+  refine sum_le_tsum (range _) (λ _ _, le_trans dist_nonneg (hf _)) _,
+  exact hd.comp_injective (add_right_injective n)
+end
+
+lemma dist_le_tsum_of_dist_le_of_tendsto₀ (d : ℕ → ℝ) (hf : ∀ n, dist (f n) (f n.succ) ≤ d n)
+  (hd : summable d) (ha : tendsto f at_top (𝓝 a)) :
+  dist (f 0) a ≤ tsum d :=
+by simpa only [zero_add] using dist_le_tsum_of_dist_le_of_tendsto d hf hd ha 0
+
+lemma dist_le_tsum_dist_of_tendsto (h : summable (λ n, dist (f n) (f n.succ)))
+  (ha : tendsto f at_top (𝓝 a)) (n) :
+  dist (f n) a ≤ ∑' m, dist (f (n + m)) (f (n + m).succ) :=
+show dist (f n) a ≤ ∑' m, (λx, dist (f x) (f x.succ)) (n + m), from
+dist_le_tsum_of_dist_le_of_tendsto (λ n, dist (f n) (f n.succ)) (λ _, le_rfl) h ha n
+
+lemma dist_le_tsum_dist_of_tendsto₀ (h : summable (λ n, dist (f n) (f n.succ)))
+  (ha : tendsto f at_top (𝓝 a)) :
+  dist (f 0) a ≤ ∑' n, dist (f n) (f n.succ) :=
+by simpa only [zero_add] using dist_le_tsum_dist_of_tendsto h ha 0
diff --git a/src/topology/algebra/infinite_sum/ring.lean b/src/topology/algebra/infinite_sum/ring.lean
new file mode 100644
index 0000000000000..c742df54a2015
--- /dev/null
+++ b/src/topology/algebra/infinite_sum/ring.lean
@@ -0,0 +1,221 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl
+-/
+import algebra.big_operators.nat_antidiagonal
+import topology.algebra.infinite_sum.basic
+import topology.algebra.ring.basic
+
+/-!
+# Infinite sum in a ring
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file provides lemmas about the interaction between infinite sums and multiplication.
+
+## Main results
+
+* `tsum_mul_tsum_eq_tsum_sum_antidiagonal`: Cauchy product formula
+-/
+
+open filter finset function
+open_locale big_operators classical
+
+variables {ι κ R α : Type*}
+
+section non_unital_non_assoc_semiring
+variables [non_unital_non_assoc_semiring α] [topological_space α] [topological_semiring α]
+  {f g : ι → α} {a a₁ a₂ : α}
+
+lemma has_sum.mul_left (a₂) (h : has_sum f a₁) : has_sum (λ i, a₂ * f i) (a₂ * a₁) :=
+by simpa only using h.map (add_monoid_hom.mul_left a₂) (continuous_const.mul continuous_id)
+
+lemma has_sum.mul_right (a₂) (hf : has_sum f a₁) : has_sum (λ i, f i * a₂) (a₁ * a₂) :=
+by simpa only using hf.map (add_monoid_hom.mul_right a₂) (continuous_id.mul continuous_const)
+
+lemma summable.mul_left (a) (hf : summable f) : summable (λ i, a * f i) :=
+(hf.has_sum.mul_left _).summable
+
+lemma summable.mul_right (a) (hf : summable f) : summable (λ i, f i * a) :=
+(hf.has_sum.mul_right _).summable
+
+section tsum
+variables [t2_space α]
+
+lemma summable.tsum_mul_left (a) (hf : summable f) : ∑' i, a * f i = a * ∑' i, f i :=
+(hf.has_sum.mul_left _).tsum_eq
+
+lemma summable.tsum_mul_right (a) (hf : summable f) : ∑' i, f i * a = (∑' i, f i) * a :=
+(hf.has_sum.mul_right _).tsum_eq
+
+lemma commute.tsum_right (a) (h : ∀ i, commute a (f i)) : commute a (∑' i, f i) :=
+if hf : summable f then
+  (hf.tsum_mul_left a).symm.trans ((congr_arg _ $ funext h).trans (hf.tsum_mul_right a))
+else
+  (tsum_eq_zero_of_not_summable hf).symm ▸ commute.zero_right _
+
+lemma commute.tsum_left (a) (h : ∀ i, commute (f i) a) : commute (∑' i, f i) a :=
+(commute.tsum_right _ $ λ i, (h i).symm).symm
+
+end tsum
+end non_unital_non_assoc_semiring
+
+section division_semiring
+variables [division_semiring α] [topological_space α] [topological_semiring α] {f g : ι → α}
+  {a a₁ a₂ : α}
+
+lemma has_sum.div_const (h : has_sum f a) (b : α) : has_sum (λ i, f i / b) (a / b) :=
+by simp only [div_eq_mul_inv, h.mul_right b⁻¹]
+
+lemma summable.div_const (h : summable f) (b : α) : summable (λ i, f i / b) :=
+(h.has_sum.div_const _).summable
+
+lemma has_sum_mul_left_iff (h : a₂ ≠ 0) : has_sum (λ i, a₂ * f i) (a₂ * a₁) ↔ has_sum f a₁ :=
+⟨λ H, by simpa only [inv_mul_cancel_left₀ h] using H.mul_left a₂⁻¹, has_sum.mul_left _⟩
+
+lemma has_sum_mul_right_iff (h : a₂ ≠ 0) : has_sum (λ i, f i * a₂) (a₁ * a₂) ↔ has_sum f a₁ :=
+⟨λ H, by simpa only [mul_inv_cancel_right₀ h] using H.mul_right a₂⁻¹, has_sum.mul_right _⟩
+
+lemma has_sum_div_const_iff (h : a₂ ≠ 0) : has_sum (λ i, f i / a₂) (a₁ / a₂) ↔ has_sum f a₁ :=
+by simpa only [div_eq_mul_inv] using has_sum_mul_right_iff (inv_ne_zero h)
+
+lemma summable_mul_left_iff (h : a ≠ 0) : summable (λ i, a * f i) ↔ summable f :=
+⟨λ H, by simpa only [inv_mul_cancel_left₀ h] using H.mul_left a⁻¹, λ H, H.mul_left _⟩
+
+lemma summable_mul_right_iff (h : a ≠ 0) : summable (λ i, f i * a) ↔ summable f :=
+⟨λ H, by simpa only [mul_inv_cancel_right₀ h] using H.mul_right a⁻¹, λ H, H.mul_right _⟩
+
+lemma summable_div_const_iff (h : a ≠ 0) : summable (λ i, f i / a) ↔ summable f :=
+by simpa only [div_eq_mul_inv] using summable_mul_right_iff (inv_ne_zero h)
+
+lemma tsum_mul_left [t2_space α] : (∑' x, a * f x) = a * ∑' x, f x :=
+if hf : summable f then hf.tsum_mul_left a
+else if ha : a = 0 then by simp [ha]
+else by rw [tsum_eq_zero_of_not_summable hf,
+  tsum_eq_zero_of_not_summable (mt (summable_mul_left_iff ha).mp hf), mul_zero]
+
+lemma tsum_mul_right [t2_space α] : (∑' x, f x * a) = (∑' x, f x) * a :=
+if hf : summable f then hf.tsum_mul_right a
+else if ha : a = 0 then by simp [ha]
+else by rw [tsum_eq_zero_of_not_summable hf,
+  tsum_eq_zero_of_not_summable (mt (summable_mul_right_iff ha).mp hf), zero_mul]
+
+lemma tsum_div_const [t2_space α] : (∑' x, f x / a) = (∑' x, f x) / a :=
+by simpa only [div_eq_mul_inv] using tsum_mul_right
+
+end division_semiring
+
+/-!
+### Multipliying two infinite sums
+
+In this section, we prove various results about `(∑' x : ι, f x) * (∑' y : κ, g y)`. Note that we
+always assume that the family `λ x : ι × κ, f x.1 * g x.2` is summable, since there is no way to
+deduce this from the summmabilities of `f` and `g` in general, but if you are working in a normed
+space, you may want to use the analogous lemmas in `analysis/normed_space/basic`
+(e.g `tsum_mul_tsum_of_summable_norm`).
+
+We first establish results about arbitrary index types, `ι` and `κ`, and then we specialize to
+`ι = κ = ℕ` to prove the Cauchy product formula (see `tsum_mul_tsum_eq_tsum_sum_antidiagonal`).
+
+#### Arbitrary index types
+-/
+
+section tsum_mul_tsum
+variables [topological_space α] [t3_space α] [non_unital_non_assoc_semiring α]
+  [topological_semiring α] {f : ι → α} {g : κ → α} {s t u : α}
+
+lemma has_sum.mul_eq (hf : has_sum f s) (hg : has_sum g t)
+  (hfg : has_sum (λ (x : ι × κ), f x.1 * g x.2) u) :
+  s * t = u :=
+have key₁ : has_sum (λ i, f i * t) (s * t),
+  from hf.mul_right t,
+have this : ∀ i : ι, has_sum (λ c : κ, f i * g c) (f i * t),
+  from λ i, hg.mul_left (f i),
+have key₂ : has_sum (λ i, f i * t) u,
+  from has_sum.prod_fiberwise hfg this,
+key₁.unique key₂
+
+lemma has_sum.mul (hf : has_sum f s) (hg : has_sum g t)
+  (hfg : summable (λ (x : ι × κ), f x.1 * g x.2)) :
+  has_sum (λ (x : ι × κ), f x.1 * g x.2) (s * t) :=
+let ⟨u, hu⟩ := hfg in
+(hf.mul_eq hg hu).symm ▸ hu
+
+/-- Product of two infinites sums indexed by arbitrary types.
+    See also `tsum_mul_tsum_of_summable_norm` if `f` and `g` are abolutely summable. -/
+lemma tsum_mul_tsum (hf : summable f) (hg : summable g)
+  (hfg : summable (λ (x : ι × κ), f x.1 * g x.2)) :
+  (∑' x, f x) * (∑' y, g y) = (∑' z : ι × κ, f z.1 * g z.2) :=
+hf.has_sum.mul_eq hg.has_sum hfg.has_sum
+
+end tsum_mul_tsum
+
+/-!
+#### `ℕ`-indexed families (Cauchy product)
+
+We prove two versions of the Cauchy product formula. The first one is
+`tsum_mul_tsum_eq_tsum_sum_range`, where the `n`-th term is a sum over `finset.range (n+1)`
+involving `nat` subtraction.
+In order to avoid `nat` subtraction, we also provide `tsum_mul_tsum_eq_tsum_sum_antidiagonal`,
+where the `n`-th term is a sum over all pairs `(k, l)` such that `k+l=n`, which corresponds to the
+`finset` `finset.nat.antidiagonal n`
+-/
+
+section cauchy_product
+variables [topological_space α] [non_unital_non_assoc_semiring α] {f g : ℕ → α}
+
+/- The family `(k, l) : ℕ × ℕ ↦ f k * g l` is summable if and only if the family
+`(n, k, l) : Σ (n : ℕ), nat.antidiagonal n ↦ f k * g l` is summable. -/
+lemma summable_mul_prod_iff_summable_mul_sigma_antidiagonal :
+  summable (λ x : ℕ × ℕ, f x.1 * g x.2) ↔
+    summable (λ x : (Σ (n : ℕ), nat.antidiagonal n), f (x.2 : ℕ × ℕ).1 * g (x.2 : ℕ × ℕ).2) :=
+nat.sigma_antidiagonal_equiv_prod.summable_iff.symm
+
+variables [t3_space α] [topological_semiring α]
+
+lemma summable_sum_mul_antidiagonal_of_summable_mul (h : summable (λ x : ℕ × ℕ, f x.1 * g x.2)) :
+  summable (λ n, ∑ kl in nat.antidiagonal n, f kl.1 * g kl.2) :=
+begin
+  rw summable_mul_prod_iff_summable_mul_sigma_antidiagonal at h,
+  conv {congr, funext, rw [← finset.sum_finset_coe, ← tsum_fintype]},
+  exact h.sigma' (λ n, (has_sum_fintype _).summable),
+end
+
+/-- The **Cauchy product formula** for the product of two infinites sums indexed by `ℕ`, expressed
+by summing on `finset.nat.antidiagonal`.
+
+See also `tsum_mul_tsum_eq_tsum_sum_antidiagonal_of_summable_norm` if `f` and `g` are absolutely
+summable. -/
+lemma tsum_mul_tsum_eq_tsum_sum_antidiagonal (hf : summable f) (hg : summable g)
+  (hfg : summable (λ (x : ℕ × ℕ), f x.1 * g x.2)) :
+  (∑' n, f n) * (∑' n, g n) = (∑' n, ∑ kl in nat.antidiagonal n, f kl.1 * g kl.2) :=
+begin
+  conv_rhs {congr, funext, rw [← finset.sum_finset_coe, ← tsum_fintype]},
+  rw [tsum_mul_tsum hf hg hfg, ← nat.sigma_antidiagonal_equiv_prod.tsum_eq (_ : ℕ × ℕ → α)],
+  exact tsum_sigma' (λ n, (has_sum_fintype _).summable)
+    (summable_mul_prod_iff_summable_mul_sigma_antidiagonal.mp hfg)
+end
+
+lemma summable_sum_mul_range_of_summable_mul (h : summable (λ x : ℕ × ℕ, f x.1 * g x.2)) :
+  summable (λ n, ∑ k in range (n+1), f k * g (n - k)) :=
+begin
+  simp_rw ← nat.sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l),
+  exact summable_sum_mul_antidiagonal_of_summable_mul h
+end
+
+/-- The **Cauchy product formula** for the product of two infinites sums indexed by `ℕ`, expressed
+by summing on `finset.range`.
+
+See also `tsum_mul_tsum_eq_tsum_sum_range_of_summable_norm` if `f` and `g` are absolutely summable.
+-/
+lemma tsum_mul_tsum_eq_tsum_sum_range (hf : summable f) (hg : summable g)
+  (hfg : summable (λ (x : ℕ × ℕ), f x.1 * g x.2)) :
+  (∑' n, f n) * (∑' n, g n) = ∑' n, ∑ k in range (n + 1), f k * g (n - k) :=
+begin
+  simp_rw ← nat.sum_antidiagonal_eq_sum_range_succ (λ k l, f k * g l),
+  exact tsum_mul_tsum_eq_tsum_sum_antidiagonal hf hg hfg
+end
+
+end cauchy_product
diff --git a/src/topology/algebra/localization.lean b/src/topology/algebra/localization.lean
index 5f93bac5c3e1e..28cf23992b53b 100644
--- a/src/topology/algebra/localization.lean
+++ b/src/topology/algebra/localization.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: María Inés de Frutos-Fernández
 -/
 import ring_theory.localization.basic
-import topology.algebra.ring
+import topology.algebra.ring.basic
 
 /-!
 
 # Localization of topological rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The topological localization of a topological commutative ring `R` at a submonoid `M` is the ring
 `localization M`  endowed with the final ring topology of the natural homomorphism sending `x : R`
 to the equivalence class of `(x, 1)` in the localization of `R` at a `M`.
diff --git a/src/topology/algebra/module/basic.lean b/src/topology/algebra/module/basic.lean
index 361cc657498cd..f7d3e1befccef 100644
--- a/src/topology/algebra/module/basic.lean
+++ b/src/topology/algebra/module/basic.lean
@@ -4,18 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jan-David Salchow, Sébastien Gouëzel, Jean Lo, Yury Kudryashov, Frédéric Dupuis,
   Heather Macbeth
 -/
-import topology.algebra.ring
+import topology.algebra.ring.basic
 import topology.algebra.mul_action
 import topology.algebra.uniform_group
+import topology.continuous_function.basic
 import topology.uniform_space.uniform_embedding
 import algebra.algebra.basic
 import linear_algebra.projection
 import linear_algebra.pi
-import linear_algebra.determinant
 
 /-!
 # Theory of topological modules and continuous linear maps.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We use the class `has_continuous_smul` for topological (semi) modules and topological vector spaces.
 
 In this file we define continuous (semi-)linear maps, as semilinear maps between topological
@@ -26,8 +29,8 @@ Plain linear maps are denoted by `M →L[R] M₂` and star-linear maps by `M →
 The corresponding notation for equivalences is `M ≃SL[σ] M₂`, `M ≃L[R] M₂` and `M ≃L⋆[R] M₂`.
 -/
 
-open filter
-open_locale topological_space big_operators filter
+open filter linear_map (ker range)
+open_locale topology big_operators filter
 
 universes u v w u'
 
@@ -83,7 +86,7 @@ variables {R : Type*} {M : Type*}
 
 /-- If `M` is a topological module over `R` and `0` is a limit of invertible elements of `R`, then
 `⊤` is the only submodule of `M` with a nonempty interior.
-This is the case, e.g., if `R` is a nondiscrete normed field. -/
+This is the case, e.g., if `R` is a nontrivially normed field. -/
 lemma submodule.eq_top_of_nonempty_interior'
   [ne_bot (𝓝[{x : R | is_unit x}] 0)]
   (s : submodule R M) (hs : (interior (s:set M)).nonempty) :
@@ -104,7 +107,7 @@ end
 
 variables (R M)
 
-/-- Let `R` be a topological ring such that zero is not an isolated point (e.g., a nondiscrete
+/-- Let `R` be a topological ring such that zero is not an isolated point (e.g., a nontrivially
 normed field, see `normed_field.punctured_nhds_ne_bot`). Let `M` be a nontrivial module over `R`
 such that `c • x = 0` implies `c = 0 ∨ x = 0`. Then `M` has no isolated points. We formulate this
 using `ne_bot (𝓝[≠] x)`.
@@ -139,7 +142,7 @@ lemma has_continuous_smul_induced :
 { continuous_smul :=
     begin
       letI : topological_space M₁ := t.induced f,
-      refine continuous_induced_rng _,
+      refine continuous_induced_rng.2 _,
       simp_rw [function.comp, f.map_smul],
       refine continuous_fst.smul (continuous_induced_dom.comp continuous_snd)
     end }
@@ -173,13 +176,12 @@ variables {R : Type u} {M : Type v}
 [module R M] [has_continuous_smul R M]
 
 lemma submodule.closure_smul_self_subset (s : submodule R M) :
-  (λ p : R × M, p.1 • p.2) '' ((set.univ : set R) ×ˢ closure (s : set M))
-  ⊆ closure (s : set M) :=
+  (λ p : R × M, p.1 • p.2) '' (set.univ ×ˢ closure s) ⊆ closure s :=
 calc
-(λ p : R × M, p.1 • p.2) '' ((set.univ : set R) ×ˢ closure (s : set M))
-    = (λ p : R × M, p.1 • p.2) '' (closure ((set.univ : set R) ×ˢ (s : set M))) :
+(λ p : R × M, p.1 • p.2) '' (set.univ ×ˢ closure s)
+    = (λ p : R × M, p.1 • p.2) '' closure (set.univ ×ˢ s) :
   by simp [closure_prod_eq]
-... ⊆ closure ((λ p : R × M, p.1 • p.2) '' ((set.univ : set R) ×ˢ (s : set M))) :
+... ⊆ closure ((λ p : R × M, p.1 • p.2) '' (set.univ ×ˢ s)) :
   image_closure_subset_closure_image continuous_smul
 ... = closure s : begin
   congr,
@@ -190,10 +192,8 @@ calc
 end
 
 lemma submodule.closure_smul_self_eq (s : submodule R M) :
-  (λ p : R × M, p.1 • p.2) '' ((set.univ : set R) ×ˢ closure (s : set M))
-  = closure (s : set M) :=
-set.subset.antisymm s.closure_smul_self_subset
-  (λ x hx, ⟨⟨1, x⟩, ⟨set.mem_univ _, hx⟩, one_smul R _⟩)
+  (λ p : R × M, p.1 • p.2) '' (set.univ ×ˢ closure s) = closure s :=
+s.closure_smul_self_subset.antisymm $ λ x hx, ⟨⟨1, x⟩, ⟨set.mem_univ _, hx⟩, one_smul R _⟩
 
 variables [has_continuous_add M]
 
@@ -208,17 +208,7 @@ def submodule.topological_closure (s : submodule R M) : submodule R M :=
   (s.topological_closure : set M) = closure (s : set M) :=
 rfl
 
-instance submodule.topological_closure_has_continuous_smul (s : submodule R M) :
-  has_continuous_smul R (s.topological_closure) :=
-{ continuous_smul :=
-  begin
-    apply continuous_induced_rng,
-    change continuous (λ p : R × s.topological_closure, p.1 • (p.2 : M)),
-    continuity,
-  end,
-  ..s.to_add_submonoid.topological_closure_has_continuous_add }
-
-lemma submodule.submodule_topological_closure (s : submodule R M) :
+lemma submodule.le_topological_closure (s : submodule R M) :
   s ≤ s.topological_closure :=
 subset_closure
 
@@ -233,11 +223,54 @@ closure_minimal h ht
 
 lemma submodule.topological_closure_mono {s : submodule R M} {t : submodule R M} (h : s ≤ t) :
   s.topological_closure ≤ t.topological_closure :=
-s.topological_closure_minimal (h.trans t.submodule_topological_closure)
+s.topological_closure_minimal (h.trans t.le_topological_closure)
   t.is_closed_topological_closure
 
+/-- The topological closure of a closed submodule `s` is equal to `s`. -/
+lemma is_closed.submodule_topological_closure_eq {s : submodule R M} (hs : is_closed (s : set M)) :
+  s.topological_closure = s :=
+le_antisymm (s.topological_closure_minimal rfl.le hs) s.le_topological_closure
+
+/-- A subspace is dense iff its topological closure is the entire space. -/
+lemma submodule.dense_iff_topological_closure_eq_top {s : submodule R M} :
+  dense (s : set M) ↔ s.topological_closure = ⊤ :=
+by { rw [←set_like.coe_set_eq, dense_iff_closure_eq], simp }
+
+instance {M' : Type*} [add_comm_monoid M'] [module R M'] [uniform_space M']
+  [has_continuous_add M'] [has_continuous_smul R M'] [complete_space M'] (U : submodule R M') :
+  complete_space U.topological_closure :=
+is_closed_closure.complete_space_coe
+
+/-- A maximal proper subspace of a topological module (i.e a `submodule` satisfying `is_coatom`)
+is either closed or dense. -/
+lemma submodule.is_closed_or_dense_of_is_coatom (s : submodule R M) (hs : is_coatom s) :
+  is_closed (s : set M) ∨ dense (s : set M) :=
+(hs.le_iff.mp s.le_topological_closure).swap.imp (is_closed_of_closure_subset ∘ eq.le)
+  submodule.dense_iff_topological_closure_eq_top.mpr
+
 end closure
 
+section pi
+
+lemma linear_map.continuous_on_pi {ι : Type*} {R : Type*} {M : Type*} [finite ι] [semiring R]
+  [topological_space R] [add_comm_monoid M] [module R M] [topological_space M]
+  [has_continuous_add M] [has_continuous_smul R M] (f : (ι → R) →ₗ[R] M) :
+  continuous f :=
+begin
+  casesI nonempty_fintype ι,
+  classical,
+  -- for the proof, write `f` in the standard basis, and use that each coordinate is a continuous
+  -- function.
+  have : (f : (ι → R) → M) =
+         (λx, ∑ i : ι, x i • (f (λ j, if i = j then 1 else 0))),
+    by { ext x, exact f.pi_apply_eq_sum_univ x },
+  rw this,
+  refine continuous_finset_sum _ (λi hi, _),
+  exact (continuous_apply i).smul continuous_const
+end
+
+end pi
+
 /-- Continuous linear maps between modules. We only put the type classes that are necessary for the
 definition, although in applications `M` and `M₂` will be topological modules over the topological
 ring `R`. -/
@@ -253,10 +286,37 @@ notation M ` →SL[`:25 σ `] ` M₂ := continuous_linear_map σ M M₂
 notation M ` →L[`:25 R `] ` M₂ := continuous_linear_map (ring_hom.id R) M M₂
 notation M ` →L⋆[`:25 R `] ` M₂ := continuous_linear_map (star_ring_end R) M M₂
 
+set_option old_structure_cmd true
+
+/-- `continuous_semilinear_map_class F σ M M₂` asserts `F` is a type of bundled continuous
+`σ`-semilinear maps `M → M₂`.  See also `continuous_linear_map_class F R M M₂` for the case where
+`σ` is the identity map on `R`.  A map `f` between an `R`-module and an `S`-module over a ring
+homomorphism `σ : R →+* S` is semilinear if it satisfies the two properties `f (x + y) = f x + f y`
+and `f (c • x) = (σ c) • f x`. -/
+class continuous_semilinear_map_class (F : Type*) {R S : out_param Type*} [semiring R] [semiring S]
+  (σ : out_param $ R →+* S) (M : out_param Type*) [topological_space M] [add_comm_monoid M]
+  (M₂ : out_param Type*) [topological_space M₂] [add_comm_monoid M₂] [module R M] [module S M₂]
+  extends semilinear_map_class F σ M M₂, continuous_map_class F M M₂
+
+-- `σ`, `R` and `S` become metavariables, but they are all outparams so it's OK
+attribute [nolint dangerous_instance] continuous_semilinear_map_class.to_continuous_map_class
+
+/-- `continuous_linear_map_class F R M M₂` asserts `F` is a type of bundled continuous
+`R`-linear maps `M → M₂`.  This is an abbreviation for
+`continuous_semilinear_map_class F (ring_hom.id R) M M₂`.  -/
+abbreviation continuous_linear_map_class (F : Type*)
+  (R : out_param Type*) [semiring R]
+  (M : out_param Type*) [topological_space M] [add_comm_monoid M]
+  (M₂ : out_param Type*) [topological_space M₂] [add_comm_monoid M₂]
+  [module R M] [module R M₂] :=
+continuous_semilinear_map_class F (ring_hom.id R) M M₂
+
+set_option old_structure_cmd false
+
 /-- Continuous linear equivalences between modules. We only put the type classes that are necessary
 for the definition, although in applications `M` and `M₂` will be topological modules over the
 topological semiring `R`. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure continuous_linear_equiv
   {R : Type*} {S : Type*} [semiring R] [semiring S] (σ : R →+* S)
   {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
@@ -271,6 +331,54 @@ notation M ` ≃SL[`:50 σ `] ` M₂ := continuous_linear_equiv σ M M₂
 notation M ` ≃L[`:50 R `] ` M₂ := continuous_linear_equiv (ring_hom.id R) M M₂
 notation M ` ≃L⋆[`:50 R `] ` M₂ := continuous_linear_equiv (star_ring_end R) M M₂
 
+set_option old_structure_cmd true
+/-- `continuous_semilinear_equiv_class F σ M M₂` asserts `F` is a type of bundled continuous
+`σ`-semilinear equivs `M → M₂`.  See also `continuous_linear_equiv_class F R M M₂` for the case
+where `σ` is the identity map on `R`.  A map `f` between an `R`-module and an `S`-module over a ring
+homomorphism `σ : R →+* S` is semilinear if it satisfies the two properties `f (x + y) = f x + f y`
+and `f (c • x) = (σ c) • f x`. -/
+class continuous_semilinear_equiv_class (F : Type*)
+  {R : out_param Type*} {S : out_param Type*} [semiring R] [semiring S] (σ : out_param $ R →+* S)
+  {σ' : out_param $ S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
+  (M : out_param Type*) [topological_space M] [add_comm_monoid M]
+  (M₂ : out_param Type*) [topological_space M₂] [add_comm_monoid M₂]
+  [module R M] [module S M₂]
+  extends semilinear_equiv_class F σ M M₂ :=
+(map_continuous  : ∀ (f : F), continuous f . tactic.interactive.continuity')
+(inv_continuous : ∀ (f : F), continuous (inv f) . tactic.interactive.continuity')
+
+/-- `continuous_linear_equiv_class F σ M M₂` asserts `F` is a type of bundled continuous
+`R`-linear equivs `M → M₂`. This is an abbreviation for
+`continuous_semilinear_equiv_class F (ring_hom.id) M M₂`. -/
+abbreviation continuous_linear_equiv_class (F : Type*)
+  (R : out_param Type*) [semiring R]
+  (M : out_param Type*) [topological_space M] [add_comm_monoid M]
+  (M₂ : out_param Type*) [topological_space M₂] [add_comm_monoid M₂]
+  [module R M] [module R M₂] :=
+continuous_semilinear_equiv_class F (ring_hom.id R) M M₂
+
+set_option old_structure_cmd false
+
+namespace continuous_semilinear_equiv_class
+variables (F : Type*)
+  {R : Type*} {S : Type*} [semiring R] [semiring S] (σ : R →+* S)
+  {σ' : S →+* R} [ring_hom_inv_pair σ σ'] [ring_hom_inv_pair σ' σ]
+  (M : Type*) [topological_space M] [add_comm_monoid M]
+  (M₂ : Type*) [topological_space M₂] [add_comm_monoid M₂]
+  [module R M] [module S M₂]
+
+include σ'
+-- `σ'` becomes a metavariable, but it's OK since it's an outparam
+@[priority 100, nolint dangerous_instance]
+instance [s: continuous_semilinear_equiv_class F σ M M₂] :
+  continuous_semilinear_map_class F σ M M₂ :=
+{ coe := (coe : F → M → M₂),
+  coe_injective' := @fun_like.coe_injective F _ _ _,
+  ..s }
+omit σ'
+
+end continuous_semilinear_equiv_class
+
 section pointwise_limits
 
 variables
@@ -345,11 +453,12 @@ instance : has_coe (M₁ →SL[σ₁₂] M₂) (M₁ →ₛₗ[σ₁₂] M₂) :
 theorem coe_injective : function.injective (coe : (M₁ →SL[σ₁₂] M₂) → (M₁ →ₛₗ[σ₁₂] M₂)) :=
 by { intros f g H, cases f, cases g, congr' }
 
-instance : add_monoid_hom_class (M₁ →SL[σ₁₂] M₂) M₁ M₂ :=
+instance : continuous_semilinear_map_class (M₁ →SL[σ₁₂] M₂) σ₁₂ M₁ M₂ :=
 { coe := λ f, f.to_fun,
   coe_injective' := λ f g h, coe_injective (fun_like.coe_injective h),
   map_add := λ f, map_add f.to_linear_map,
-  map_zero := λ f, linear_map.map_zero f }
+  map_continuous := λ f, f.2,
+  map_smulₛₗ := λ f, f.to_linear_map.map_smul' }
 
 /-- Coerce continuous linear maps to functions. -/
 -- see Note [function coercion]
@@ -396,18 +505,25 @@ protected def copy (f : M₁ →SL[σ₁₂] M₂) (f' : M₁ → M₂) (h : f'
 { to_linear_map := f.to_linear_map.copy f' h,
   cont := show continuous f', from h.symm ▸ f.continuous }
 
+@[simp]
+lemma coe_copy (f : M₁ →SL[σ₁₂] M₂) (f' : M₁ → M₂) (h : f' = ⇑f) : ⇑(f.copy f' h) = f' := rfl
+
+lemma copy_eq (f : M₁ →SL[σ₁₂] M₂) (f' : M₁ → M₂) (h : f' = ⇑f) : f.copy f' h = f := fun_like.ext' h
+
 -- make some straightforward lemmas available to `simp`.
 protected lemma map_zero (f : M₁ →SL[σ₁₂] M₂) : f (0 : M₁) = 0 := map_zero f
 protected lemma map_add (f : M₁ →SL[σ₁₂] M₂) (x y : M₁) : f (x + y) = f x + f y := map_add f x y
-@[simp] lemma map_smulₛₗ (f : M₁ →SL[σ₁₂] M₂) (c : R₁) (x : M₁) :
+@[simp]
+protected lemma map_smulₛₗ (f : M₁ →SL[σ₁₂] M₂) (c : R₁) (x : M₁) :
   f (c • x) = (σ₁₂ c) • f x := (to_linear_map _).map_smulₛₗ _ _
 
-@[simp] lemma map_smul [module R₁ M₂] (f : M₁ →L[R₁] M₂)(c : R₁) (x : M₁) : f (c • x) = c • f x :=
-by simp only [ring_hom.id_apply, map_smulₛₗ]
+@[simp]
+protected lemma map_smul [module R₁ M₂] (f : M₁ →L[R₁] M₂)(c : R₁) (x : M₁) : f (c • x) = c • f x :=
+by simp only [ring_hom.id_apply, continuous_linear_map.map_smulₛₗ]
 
 @[simp, priority 900]
-lemma map_smul_of_tower {R S : Type*} [semiring S] [has_scalar R M₁]
-  [module S M₁] [has_scalar R M₂] [module S M₂]
+lemma map_smul_of_tower {R S : Type*} [semiring S] [has_smul R M₁]
+  [module S M₁] [has_smul R M₂] [module S M₂]
   [linear_map.compatible_smul M₁ M₂ R S] (f : M₁ →L[S] M₂) (c : R) (x : M₁) :
   f (c • x) = c • f x :=
 linear_map.compatible_smul.map_smul f c x
@@ -475,7 +591,7 @@ lemma smul_apply (c : S₂) (f : M₁ →SL[σ₁₂] M₂) (x : M₁) : (c •
 lemma coe_smul (c : S₂) (f : M₁ →SL[σ₁₂] M₂) : (↑(c • f) : M₁ →ₛₗ[σ₁₂] M₂) = c • f := rfl
 @[simp, norm_cast] lemma coe_smul' (c : S₂) (f : M₁ →SL[σ₁₂] M₂) : ⇑(c • f) = c • f := rfl
 
-instance [has_scalar S₂ T₂] [is_scalar_tower S₂ T₂ M₂] : is_scalar_tower S₂ T₂ (M₁ →SL[σ₁₂] M₂) :=
+instance [has_smul S₂ T₂] [is_scalar_tower S₂ T₂ M₂] : is_scalar_tower S₂ T₂ (M₁ →SL[σ₁₂] M₂) :=
 ⟨λ a b f, ext $ λ x, smul_assoc a b (f x)⟩
 
 instance [smul_comm_class S₂ T₂ M₂] : smul_comm_class S₂ T₂ (M₁ →SL[σ₁₂] M₂) :=
@@ -620,6 +736,59 @@ lemma mul_def (f g : M₁ →L[R₁] M₁) : f * g = f.comp g := rfl
 
 lemma mul_apply (f g : M₁ →L[R₁] M₁) (x : M₁) : (f * g) x = f (g x) := rfl
 
+instance : monoid_with_zero (M₁ →L[R₁] M₁) :=
+{ mul := (*),
+  one := 1,
+  zero := 0,
+  mul_zero := λ f, ext $ λ _, map_zero f,
+  zero_mul := λ _, ext $ λ _, rfl,
+  mul_one := λ _, ext $ λ _, rfl,
+  one_mul := λ _, ext $ λ _, rfl,
+  mul_assoc := λ _ _ _, ext $ λ _, rfl, }
+
+instance [has_continuous_add M₁] : semiring (M₁ →L[R₁] M₁) :=
+{ mul := (*),
+  one := 1,
+  left_distrib := λ f g h, ext $ λ x, map_add f (g x) (h x),
+  right_distrib := λ _ _ _, ext $ λ _, linear_map.add_apply _ _ _,
+  ..continuous_linear_map.monoid_with_zero,
+  ..continuous_linear_map.add_comm_monoid }
+
+/-- `continuous_linear_map.to_linear_map` as a `ring_hom`.-/
+@[simps]
+def to_linear_map_ring_hom [has_continuous_add M₁] : (M₁ →L[R₁] M₁) →+* (M₁ →ₗ[R₁] M₁) :=
+{ to_fun := to_linear_map,
+  map_zero' := rfl,
+  map_one' := rfl,
+  map_add' := λ _ _, rfl,
+  map_mul' := λ _ _, rfl }
+
+section apply_action
+variables [has_continuous_add M₁]
+
+/-- The tautological action by `M₁ →L[R₁] M₁` on `M`.
+
+This generalizes `function.End.apply_mul_action`. -/
+instance apply_module : module (M₁ →L[R₁] M₁) M₁ :=
+module.comp_hom _ to_linear_map_ring_hom
+
+@[simp] protected lemma smul_def (f : M₁ →L[R₁] M₁) (a : M₁) : f • a = f a := rfl
+
+/-- `continuous_linear_map.apply_module` is faithful. -/
+instance apply_has_faithful_smul : has_faithful_smul (M₁ →L[R₁] M₁) M₁ :=
+⟨λ _ _, continuous_linear_map.ext⟩
+
+instance apply_smul_comm_class : smul_comm_class R₁ (M₁ →L[R₁] M₁) M₁ :=
+{ smul_comm := λ r e m, (e.map_smul r m).symm }
+
+instance apply_smul_comm_class' : smul_comm_class (M₁ →L[R₁] M₁) R₁ M₁ :=
+{ smul_comm := continuous_linear_map.map_smul }
+
+instance : has_continuous_const_smul (M₁ →L[R₁] M₁) M₁ :=
+⟨continuous_linear_map.continuous⟩
+
+end apply_action
+
 /-- The cartesian product of two bounded linear maps, as a bounded linear map. -/
 protected def prod [module R₁ M₂] [module R₁ M₃] (f₁ : M₁ →L[R₁] M₂) (f₂ : M₁ →L[R₁] M₃) :
   M₁ →L[R₁] (M₂ × M₃) :=
@@ -647,6 +816,8 @@ def inr [module R₁ M₂] : M₂ →L[R₁] M₁ × M₂ := (0 : M₂ →L[R₁
 
 end
 
+variables {F : Type*}
+
 @[simp] lemma inl_apply [module R₁ M₂] (x : M₁) : inl R₁ M₁ M₂ x = (x, 0) := rfl
 @[simp] lemma inr_apply [module R₁ M₂] (x : M₂) : inr R₁ M₁ M₂ x = (0, x) := rfl
 
@@ -655,52 +826,29 @@ end
 @[simp, norm_cast] lemma coe_inr [module R₁ M₂] :
   (inr R₁ M₁ M₂ : M₂ →ₗ[R₁] M₁ × M₂) = linear_map.inr R₁ M₁ M₂ := rfl
 
-/-- Kernel of a continuous linear map. -/
-def ker (f : M₁ →SL[σ₁₂] M₂) : submodule R₁ M₁ := (f : M₁ →ₛₗ[σ₁₂] M₂).ker
-
-@[norm_cast] lemma ker_coe (f : M₁ →SL[σ₁₂] M₂) : (f : M₁ →ₛₗ[σ₁₂] M₂).ker = f.ker := rfl
-
-@[simp] lemma mem_ker {f : M₁ →SL[σ₁₂] M₂} {x} : x ∈ f.ker ↔ f x = 0 := linear_map.mem_ker
-
-lemma is_closed_ker [t1_space M₂] (f : M₁ →SL[σ₁₂] M₂) : is_closed (f.ker : set M₁) :=
-continuous_iff_is_closed.1 f.cont _ is_closed_singleton
-
-@[simp] lemma apply_ker (f : M₁ →SL[σ₁₂] M₂) (x : f.ker) : f x = 0 := mem_ker.1 x.2
+lemma is_closed_ker [t1_space M₂] [continuous_semilinear_map_class F σ₁₂ M₁ M₂]
+  (f : F) : is_closed (ker f : set M₁) :=
+continuous_iff_is_closed.1 (map_continuous f) _ is_closed_singleton
 
 lemma is_complete_ker {M' : Type*} [uniform_space M'] [complete_space M'] [add_comm_monoid M']
-  [module R₁ M'] [t1_space M₂] (f : M' →SL[σ₁₂] M₂) :
-  is_complete (f.ker : set M') :=
-f.is_closed_ker.is_complete
+  [module R₁ M'] [t1_space M₂] [continuous_semilinear_map_class F σ₁₂ M' M₂]
+  (f : F) : is_complete (ker f : set M') :=
+(is_closed_ker f).is_complete
 
+@[priority 100]
 instance complete_space_ker {M' : Type*} [uniform_space M'] [complete_space M'] [add_comm_monoid M']
-  [module R₁ M'] [t1_space M₂] (f : M' →SL[σ₁₂] M₂) :
-  complete_space f.ker :=
-f.is_closed_ker.complete_space_coe
+  [module R₁ M'] [t1_space M₂] [continuous_semilinear_map_class F σ₁₂ M' M₂]
+  (f : F) : complete_space (ker f) :=
+(is_closed_ker f).complete_space_coe
 
 @[simp] lemma ker_prod [module R₁ M₂] [module R₁ M₃] (f : M₁ →L[R₁] M₂) (g : M₁ →L[R₁] M₃) :
   ker (f.prod g) = ker f ⊓ ker g :=
 linear_map.ker_prod f g
 
-/-- Range of a continuous linear map. -/
-def range [ring_hom_surjective σ₁₂] (f : M₁ →SL[σ₁₂] M₂) : submodule R₂ M₂ :=
-(f : M₁ →ₛₗ[σ₁₂] M₂).range
-
-lemma range_coe [ring_hom_surjective σ₁₂] (f : M₁ →SL[σ₁₂] M₂) : (f.range : set M₂) = set.range f :=
-linear_map.range_coe _
-lemma mem_range [ring_hom_surjective σ₁₂] {f : M₁ →SL[σ₁₂] M₂} {y} : y ∈ f.range ↔ ∃ x, f x = y :=
-linear_map.mem_range
-
-lemma mem_range_self [ring_hom_surjective σ₁₂] (f : M₁ →SL[σ₁₂] M₂) (x : M₁) : f x ∈ f.range :=
-mem_range.2 ⟨x, rfl⟩
-
-lemma range_prod_le [module R₁ M₂] [module R₁ M₃] (f : M₁ →L[R₁] M₂) (g : M₁ →L[R₁] M₃) :
-  range (f.prod g) ≤ (range f).prod (range g) :=
-(f : M₁ →ₗ[R₁] M₂).range_prod_le g
-
 /-- Restrict codomain of a continuous linear map. -/
 def cod_restrict (f : M₁ →SL[σ₁₂] M₂) (p : submodule R₂ M₂) (h : ∀ x, f x ∈ p) :
   M₁ →SL[σ₁₂] p :=
-{ cont := continuous_subtype_mk h f.continuous,
+{ cont := f.continuous.subtype_mk _,
   to_linear_map := (f : M₁ →ₛₗ[σ₁₂] M₂).cod_restrict p h}
 
 @[norm_cast] lemma coe_cod_restrict (f : M₁ →SL[σ₁₂] M₂) (p : submodule R₂ M₂) (h : ∀ x, f x ∈ p) :
@@ -716,19 +864,31 @@ rfl
   ker (f.cod_restrict p h) = ker f :=
 (f : M₁ →ₛₗ[σ₁₂] M₂).ker_cod_restrict p h
 
-/-- Embedding of a submodule into the ambient space as a continuous linear map. -/
-def subtype_val (p : submodule R₁ M₁) : p →L[R₁] M₁ :=
+/-- `submodule.subtype` as a `continuous_linear_map`. -/
+def _root_.submodule.subtypeL (p : submodule R₁ M₁) : p →L[R₁] M₁ :=
 { cont := continuous_subtype_val,
   to_linear_map := p.subtype }
 
-@[simp, norm_cast] lemma coe_subtype_val (p : submodule R₁ M₁) :
-  (subtype_val p : p →ₗ[R₁] M₁) = p.subtype :=
+@[simp, norm_cast] lemma _root_.submodule.coe_subtypeL (p : submodule R₁ M₁) :
+  (p.subtypeL : p →ₗ[R₁] M₁) = p.subtype :=
+rfl
+
+@[simp] lemma _root_.submodule.coe_subtypeL' (p : submodule R₁ M₁) :
+  ⇑p.subtypeL = p.subtype :=
 rfl
 
-@[simp, norm_cast] lemma subtype_val_apply (p : submodule R₁ M₁) (x : p) :
-  (subtype_val p : p → M₁) x = x :=
+@[simp, norm_cast] lemma _root_.submodule.subtypeL_apply (p : submodule R₁ M₁) (x : p) :
+  p.subtypeL x = x :=
 rfl
 
+@[simp] lemma _root_.submodule.range_subtypeL (p : submodule R₁ M₁) :
+  range p.subtypeL = p :=
+submodule.range_subtype _
+
+@[simp] lemma _root_.submodule.ker_subtypeL (p : submodule R₁ M₁) :
+  ker p.subtypeL = ⊥ :=
+submodule.ker_subtype _
+
 variables (R₁ M₁ M₂)
 
 /-- `prod.fst` as a `continuous_linear_map`. -/
@@ -792,9 +952,22 @@ rfl
 
 lemma range_coprod [module R₁ M₂] [module R₁ M₃] [has_continuous_add M₃] (f₁ : M₁ →L[R₁] M₃)
   (f₂ : M₂ →L[R₁] M₃) :
-  (f₁.coprod f₂).range = f₁.range ⊔ f₂.range :=
+  range (f₁.coprod f₂) = range f₁ ⊔ range f₂ :=
 linear_map.range_coprod _ _
 
+lemma comp_fst_add_comp_snd [module R₁ M₂] [module R₁ M₃] [has_continuous_add M₃]
+  (f : M₁ →L[R₁] M₃) (g : M₂ →L[R₁] M₃) :
+  f.comp (continuous_linear_map.fst R₁ M₁ M₂) +
+  g.comp (continuous_linear_map.snd R₁ M₁ M₂) =
+  f.coprod g :=
+rfl
+
+
+lemma coprod_inl_inr [has_continuous_add M₁] [has_continuous_add M'₁] :
+  (continuous_linear_map.inl R₁ M₁ M'₁).coprod (continuous_linear_map.inr R₁ M₁ M'₁) =
+  continuous_linear_map.id R₁ (M₁ × M'₁) :=
+by { apply coe_injective, apply linear_map.coprod_inl_inr }
+
 section
 
 variables {R S : Type*} [semiring R] [semiring S] [module R M₁] [module R M₂] [module R S]
@@ -814,27 +987,6 @@ rfl
 
 end
 
-section pointwise
-open_locale pointwise
-
-@[simp] lemma image_smul_setₛₗ (f : M₁ →SL[σ₁₂] M₂) (c : R₁) (s : set M₁) :
-  f '' (c • s) = (σ₁₂ c) • f '' s :=
-f.to_linear_map.image_smul_setₛₗ c s
-
-lemma image_smul_set (fₗ : M₁ →L[R₁] M'₁) (c : R₁) (s : set M₁) :
-  fₗ '' (c • s) = c • fₗ '' s :=
-fₗ.to_linear_map.image_smul_set c s
-
-lemma preimage_smul_setₛₗ (f : M₁ →SL[σ₁₂] M₂) {c : R₁} (hc : is_unit c) (s : set M₂) :
-  f ⁻¹' (σ₁₂ c • s) = c • f ⁻¹' s :=
-f.to_linear_map.preimage_smul_setₛₗ hc s
-
-lemma preimage_smul_set (fₗ : M₁ →L[R₁] M'₁) {c : R₁} (hc : is_unit c) (s : set M'₁) :
-  fₗ ⁻¹' (c • s) = c • fₗ ⁻¹' s :=
-fₗ.to_linear_map.preimage_smul_set hc s
-
-end pointwise
-
 variables [module R₁ M₂] [topological_space R₁] [has_continuous_smul R₁ M₂]
 
 @[simp]
@@ -851,6 +1003,37 @@ lemma smul_right_comp [has_continuous_mul R₁] {x : M₂} {c : R₁} :
     smul_right (1 : R₁ →L[R₁] R₁) (c • x) :=
 by { ext, simp [mul_smul] }
 
+section to_span_singleton
+variables (R₁)
+variables [has_continuous_smul R₁ M₁]
+
+/-- Given an element `x` of a topological space `M` over a semiring `R`, the natural continuous
+linear map from `R` to `M` by taking multiples of `x`.-/
+def to_span_singleton (x : M₁) : R₁ →L[R₁] M₁ :=
+{ to_linear_map := linear_map.to_span_singleton R₁ M₁ x,
+  cont := continuous_id.smul continuous_const }
+
+lemma to_span_singleton_apply (x : M₁) (r : R₁) : to_span_singleton R₁ x r = r • x :=
+rfl
+
+lemma to_span_singleton_add [has_continuous_add M₁] (x y : M₁) :
+  to_span_singleton R₁ (x + y) = to_span_singleton R₁ x + to_span_singleton R₁ y :=
+by { ext1, simp [to_span_singleton_apply], }
+
+lemma to_span_singleton_smul' {α} [monoid α] [distrib_mul_action α M₁]
+  [has_continuous_const_smul α M₁]
+  [smul_comm_class R₁ α M₁] (c : α) (x : M₁) :
+  to_span_singleton R₁ (c • x) = c • to_span_singleton R₁ x :=
+by { ext1, rw [to_span_singleton_apply, smul_apply, to_span_singleton_apply, smul_comm], }
+
+/-- A special case of `to_span_singleton_smul'` for when `R` is commutative. -/
+lemma to_span_singleton_smul (R) {M₁} [comm_semiring R] [add_comm_monoid M₁] [module R M₁]
+  [topological_space R] [topological_space M₁] [has_continuous_smul R M₁] (c : R) (x : M₁) :
+  to_span_singleton R (c • x) = c • to_span_singleton R x :=
+to_span_singleton_smul' R c x
+
+end to_span_singleton
+
 end semiring
 
 section pi
@@ -890,7 +1073,8 @@ def proj (i : ι) : (Πi, φ i) →L[R] φ i :=
 lemma proj_pi (f : Πi, M₂ →L[R] φ i) (i : ι) : (proj i).comp (pi f) = f i :=
 ext $ assume c, rfl
 
-lemma infi_ker_proj : (⨅i, ker (proj i) : submodule R (Πi, φ i)) = ⊥ :=
+lemma infi_ker_proj : (⨅i, ker (proj i : (Πi, φ i) →L[R] φ i) :
+  submodule R (Πi, φ i)) = ⊥ :=
 linear_map.infi_ker_proj
 
 variables (R φ)
@@ -899,29 +1083,31 @@ variables (R φ)
 of `φ` is linearly equivalent to the product over `I`. -/
 def infi_ker_proj_equiv {I J : set ι} [decidable_pred (λi, i ∈ I)]
   (hd : disjoint I J) (hu : set.univ ⊆ I ∪ J) :
-  (⨅i ∈ J, ker (proj i) : submodule R (Πi, φ i)) ≃L[R] (Πi:I, φ i) :=
-⟨ linear_map.infi_ker_proj_equiv R φ hd hu,
-  continuous_pi (λ i, begin
-    have := @continuous_subtype_coe _ _ (λ x, x ∈ (⨅i ∈ J, ker (proj i) : submodule R (Πi, φ i))),
+  (⨅i ∈ J, ker (proj i : (Πi, φ i) →L[R] φ i) :
+    submodule R (Πi, φ i)) ≃L[R] (Πi:I, φ i) :=
+{ to_linear_equiv := linear_map.infi_ker_proj_equiv R φ hd hu,
+  continuous_to_fun := continuous_pi (λ i, begin
+    have := @continuous_subtype_coe _ _
+      (λ x, x ∈ (⨅i ∈ J, ker (proj i :  (Πi, φ i) →L[R] φ i) : submodule R (Πi, φ i))),
     have := continuous.comp (by exact continuous_apply i) this,
     exact this
   end),
-  continuous_subtype_mk _ (continuous_pi (λ i, begin
+  continuous_inv_fun := continuous.subtype_mk (continuous_pi (λ i, begin
     dsimp, split_ifs; [apply continuous_apply, exact continuous_zero]
-  end)) ⟩
+  end)) _ }
 
 end pi
 
 section ring
 
 variables
-{R : Type*} [ring R] {R₂ : Type*} [ring R₂]
+{R : Type*} [ring R] {R₂ : Type*} [ring R₂] {R₃ : Type*} [ring R₃]
 {M : Type*} [topological_space M] [add_comm_group M]
 {M₂ : Type*} [topological_space M₂] [add_comm_group M₂]
 {M₃ : Type*} [topological_space M₃] [add_comm_group M₃]
 {M₄ : Type*} [topological_space M₄] [add_comm_group M₄]
-[module R M] [module R₂ M₂]
-{σ₁₂ : R →+* R₂}
+[module R M] [module R₂ M₂] [module R₃ M₃]
+{σ₁₂ : R →+* R₂} {σ₂₃ : R₂ →+* R₃} {σ₁₃ : R →+* R₃}
 
 section
 
@@ -934,18 +1120,19 @@ end
 section
 variables [module R M₂] [module R M₃] [module R M₄]
 
-lemma range_prod_eq {f : M →L[R] M₂} {g : M →L[R] M₃} (h : ker f ⊔ ker g = ⊤) :
+lemma range_prod_eq {f : M →L[R] M₂} {g : M →L[R] M₃}
+  (h : ker f ⊔ ker g = ⊤) :
   range (f.prod g) = (range f).prod (range g) :=
 linear_map.range_prod_eq h
 
 lemma ker_prod_ker_le_ker_coprod [has_continuous_add M₃]
   (f : M →L[R] M₃) (g : M₂ →L[R] M₃) :
-  (ker f).prod (ker g) ≤ ker (f.coprod g) :=
+  (linear_map.ker f).prod (linear_map.ker g) ≤ linear_map.ker (f.coprod g) :=
 linear_map.ker_prod_ker_le_ker_coprod f.to_linear_map g.to_linear_map
 
 lemma ker_coprod_of_disjoint_range [has_continuous_add M₃]
-  (f : M →L[R] M₃) (g : M₂ →L[R] M₃) (hd : disjoint f.range g.range) :
-  ker (f.coprod g) = (ker f).prod (ker g) :=
+  (f : M →L[R] M₃) (g : M₂ →L[R] M₃) (hd : disjoint (range f) (range g)) :
+  linear_map.ker (f.coprod g) = (linear_map.ker f).prod (linear_map.ker g) :=
 linear_map.ker_coprod_of_disjoint_range f.to_linear_map g.to_linear_map hd
 end
 
@@ -981,14 +1168,30 @@ lemma sub_apply (f g : M →SL[σ₁₂] M₂) (x : M) : (f - g) x = f x - g x :
 
 end
 
+@[simp] lemma comp_neg [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [topological_add_group M₂]
+  [topological_add_group M₃] (g : M₂ →SL[σ₂₃] M₃) (f : M →SL[σ₁₂] M₂) :
+  g.comp (-f) = -g.comp f :=
+by { ext, simp }
+
+@[simp] lemma neg_comp [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [topological_add_group M₃]
+  (g : M₂ →SL[σ₂₃] M₃) (f : M →SL[σ₁₂] M₂) :
+  (-g).comp f = -g.comp f :=
+by { ext, simp }
+
+@[simp] lemma comp_sub [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [topological_add_group M₂]
+  [topological_add_group M₃] (g : M₂ →SL[σ₂₃] M₃) (f₁ f₂ : M →SL[σ₁₂] M₂) :
+  g.comp (f₁ - f₂) = g.comp f₁ - g.comp f₂ :=
+by { ext, simp }
+
+@[simp] lemma sub_comp [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [topological_add_group M₃]
+  (g₁ g₂ : M₂ →SL[σ₂₃] M₃) (f : M →SL[σ₁₂] M₂) :
+  (g₁ - g₂).comp f = g₁.comp f - g₂.comp f :=
+by { ext, simp }
+
 instance [topological_add_group M] : ring (M →L[R] M) :=
 { mul := (*),
   one := 1,
-  mul_one := λ _, ext $ λ _, rfl,
-  one_mul := λ _, ext $ λ _, rfl,
-  mul_assoc := λ _ _ _, ext $ λ _, rfl,
-  left_distrib := λ f g h, ext $ λ x, map_add f (g x) (h x),
-  right_distrib := λ _ _ _, ext $ λ _, linear_map.add_apply _ _ _,
+  ..continuous_linear_map.semiring,
   ..continuous_linear_map.add_comm_group }
 
 lemma smul_right_one_pow [topological_space R] [topological_ring R] (c : R) (n : ℕ) :
@@ -1006,8 +1209,8 @@ variables {σ₂₁ : R₂ →+* R} [ring_hom_inv_pair σ₁₂ σ₂₁]
 `proj_ker_of_right_inverse f₁ f₂ h` is the projection `M →L[R] f₁.ker` along `f₂.range`. -/
 def proj_ker_of_right_inverse [topological_add_group M] (f₁ : M →SL[σ₁₂] M₂) (f₂ : M₂ →SL[σ₂₁] M)
   (h : function.right_inverse f₂ f₁) :
-  M →L[R] f₁.ker :=
-(id R M - f₂.comp f₁).cod_restrict f₁.ker $ λ x, by simp [h (f₁ x)]
+  M →L[R] (linear_map.ker f₁) :=
+(id R M - f₂.comp f₁).cod_restrict (linear_map.ker f₁) $ λ x, by simp [h (f₁ x)]
 
 @[simp] lemma coe_proj_ker_of_right_inverse_apply [topological_add_group M]
   (f₁ : M →SL[σ₁₂] M₂) (f₂ : M₂ →SL[σ₂₁] M) (h : function.right_inverse f₂ f₁) (x : M) :
@@ -1015,8 +1218,8 @@ def proj_ker_of_right_inverse [topological_add_group M] (f₁ : M →SL[σ₁₂
 rfl
 
 @[simp] lemma proj_ker_of_right_inverse_apply_idem [topological_add_group M]
-  (f₁ : M →SL[σ₁₂] M₂) (f₂ : M₂ →SL[σ₂₁] M) (h : function.right_inverse f₂ f₁) (x : f₁.ker) :
-  f₁.proj_ker_of_right_inverse f₂ h x = x :=
+  (f₁ : M →SL[σ₁₂] M₂) (f₂ : M₂ →SL[σ₂₁] M) (h : function.right_inverse f₂ f₁)
+  (x : linear_map.ker f₁) : f₁.proj_ker_of_right_inverse f₂ h x = x :=
 subtype.ext_iff_val.2 $ by simp
 
 @[simp] lemma proj_ker_of_right_inverse_comp_inv [topological_add_group M]
@@ -1073,7 +1276,8 @@ include σ₁₃
   [has_continuous_const_smul R₂ M₂] [has_continuous_const_smul R₃ M₃]
   (h : M₂ →SL[σ₂₃] M₃) (c : R₂) (f : M →SL[σ₁₂] M₂) :
   h.comp (c • f) = (σ₂₃ c) • (h.comp f) :=
-by { ext x, simp only [coe_smul', coe_comp', function.comp_app, pi.smul_apply, map_smulₛₗ] }
+by { ext x, simp only [coe_smul', coe_comp', function.comp_app, pi.smul_apply,
+                      continuous_linear_map.map_smulₛₗ] }
 omit σ₁₃
 
 instance [has_continuous_add M₂] : distrib_mul_action S₃ (M →SL[σ₁₂] M₂) :=
@@ -1152,10 +1356,10 @@ end smul
 
 section smul_rightₗ
 
-variables {R S T M M₂ : Type*} [ring R] [ring S] [ring T] [module R S]
-  [add_comm_group M₂] [module R M₂] [module S M₂] [is_scalar_tower R S M₂]
+variables {R S T M M₂ : Type*} [semiring R] [semiring S] [semiring T] [module R S]
+  [add_comm_monoid M₂] [module R M₂] [module S M₂] [is_scalar_tower R S M₂]
   [topological_space S] [topological_space M₂] [has_continuous_smul S M₂]
-  [topological_space M] [add_comm_group M] [module R M] [topological_add_group M₂]
+  [topological_space M] [add_comm_monoid M] [module R M] [has_continuous_add M₂]
   [module T M₂] [has_continuous_const_smul T M₂]
   [smul_comm_class R T M₂] [smul_comm_class S T M₂]
 
@@ -1173,12 +1377,6 @@ end smul_rightₗ
 
 section comm_ring
 
-/-- The determinant of a continuous linear map, mainly as a convenience device to be able to
-write `A.det` instead of `(A : M →ₗ[R] M).det`. -/
-@[reducible] noncomputable def det {R : Type*} [comm_ring R]
-  {M : Type*} [topological_space M] [add_comm_group M] [module R M] (A : M →L[R] M) : R :=
-linear_map.det (A : M →ₗ[R] M)
-
 variables
 {R : Type*} [comm_ring R]
 {M : Type*} [topological_space M] [add_comm_group M]
@@ -1272,6 +1470,18 @@ def to_continuous_linear_map (e : M₁ ≃SL[σ₁₂] M₂) : M₁ →SL[σ₁
 /-- Coerce continuous linear equivs to continuous linear maps. -/
 instance : has_coe (M₁ ≃SL[σ₁₂] M₂) (M₁ →SL[σ₁₂] M₂) := ⟨to_continuous_linear_map⟩
 
+instance : continuous_semilinear_equiv_class (M₁ ≃SL[σ₁₂] M₂) σ₁₂ M₁ M₂ :=
+{ coe := λ f, f,
+  inv := λ f, f.inv_fun,
+  coe_injective' := λ f g h₁ h₂, by { cases f with f' _, cases g with g' _,  cases f', cases g',
+                                      congr' },
+  left_inv := λ f, f.left_inv,
+  right_inv := λ f, f.right_inv,
+  map_add := λ f, f.map_add',
+  map_smulₛₗ := λ f, f.map_smul',
+  map_continuous := continuous_to_fun,
+  inv_continuous := continuous_inv_fun }
+
 /-- Coerce continuous linear equivs to maps. -/
 -- see Note [function coercion]
 instance : has_coe_to_fun (M₁ ≃SL[σ₁₂] M₂) (λ _, M₁ → M₂) := ⟨λ f, f⟩
@@ -1436,12 +1646,17 @@ def prod [module R₁ M₂] [module R₁ M₃] [module R₁ M₄] (e : M₁ ≃L
   (e.prod e' : (M₁ × M₃) →L[R₁] (M₂ × M₄)) = (e : M₁ →L[R₁] M₂).prod_map (e' : M₃ →L[R₁] M₄) :=
 rfl
 
+lemma prod_symm [module R₁ M₂] [module R₁ M₃] [module R₁ M₄]
+  (e : M₁ ≃L[R₁] M₂) (e' : M₃ ≃L[R₁] M₄) :
+  (e.prod e').symm = e.symm.prod e'.symm :=
+rfl
+
 include σ₂₁
-theorem bijective (e : M₁ ≃SL[σ₁₂] M₂) : function.bijective e :=
+protected theorem bijective (e : M₁ ≃SL[σ₁₂] M₂) : function.bijective e :=
 e.to_linear_equiv.to_equiv.bijective
-theorem injective (e : M₁ ≃SL[σ₁₂] M₂) : function.injective e :=
+protected theorem injective (e : M₁ ≃SL[σ₁₂] M₂) : function.injective e :=
 e.to_linear_equiv.to_equiv.injective
-theorem surjective (e : M₁ ≃SL[σ₁₂] M₂) : function.surjective e :=
+protected theorem surjective (e : M₁ ≃SL[σ₁₂] M₂) : function.surjective e :=
 e.to_linear_equiv.to_equiv.surjective
 
 include σ₃₂ σ₃₁ σ₁₃
@@ -1563,29 +1778,6 @@ rfl
 rfl
 omit σ₂₁
 
-section pointwise
-open_locale pointwise
-include σ₂₁
-
-@[simp] lemma image_smul_setₛₗ (e : M₁ ≃SL[σ₁₂] M₂) (c : R₁) (s : set M₁) :
-  e '' (c • s) = (σ₁₂ c) • e '' s :=
-e.to_linear_equiv.image_smul_setₛₗ c s
-
-@[simp] lemma preimage_smul_setₛₗ (e : M₁ ≃SL[σ₁₂] M₂) (c : R₂) (s : set M₂) :
-  e ⁻¹' (c • s) = σ₂₁ c • e ⁻¹' s :=
-e.to_linear_equiv.preimage_smul_setₛₗ c s
-omit σ₂₁
-
-@[simp] lemma image_smul_set (e : M₁ ≃L[R₁] M'₁) (c : R₁) (s : set M₁) :
-  e '' (c • s) = c • e '' s :=
-e.to_linear_equiv.image_smul_set c s
-
-@[simp] lemma preimage_smul_set (e : M₁ ≃L[R₁] M'₁) (c : R₁) (s : set M'₁) :
-  e ⁻¹' (c • s) = c • e ⁻¹' s :=
-e.to_linear_equiv.preimage_smul_set c s
-
-end pointwise
-
 variable (M₁)
 
 /-- The continuous linear equivalences from `M` to itself form a group under composition. -/
@@ -1604,6 +1796,14 @@ variables {M₁} {R₄ : Type*} [semiring R₄] [module R₄ M₄]
   [ring_hom_comp_triple σ₂₁ σ₁₄ σ₂₄] [ring_hom_comp_triple σ₂₄ σ₄₃ σ₂₃]
   [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄]
 
+/-- The continuous linear equivalence between `ulift M₁` and `M₁`. -/
+def ulift : ulift M₁ ≃L[R₁] M₁ :=
+{ map_add' := λ x y, rfl,
+  map_smul' := λ c x, rfl,
+  continuous_to_fun := continuous_ulift_down,
+  continuous_inv_fun := continuous_ulift_up,
+  .. equiv.ulift }
+
 include σ₂₁ σ₃₄ σ₂₃ σ₂₄ σ₁₃
 
 /-- A pair of continuous (semi)linear equivalences generates an equivalence between the spaces of
@@ -1733,14 +1933,15 @@ end
 
 variables [module R M₂] [topological_add_group M]
 
-open _root_.continuous_linear_map (id fst snd subtype_val mem_ker)
+open _root_.continuous_linear_map (id fst snd)
+open _root_.linear_map (mem_ker)
 
 /-- A pair of continuous linear maps such that `f₁ ∘ f₂ = id` generates a continuous
 linear equivalence `e` between `M` and `M₂ × f₁.ker` such that `(e x).2 = x` for `x ∈ f₁.ker`,
 `(e x).1 = f₁ x`, and `(e (f₂ y)).2 = 0`. The map is given by `e x = (f₁ x, x - f₂ (f₁ x))`. -/
 def equiv_of_right_inverse (f₁ : M →L[R] M₂) (f₂ : M₂ →L[R] M) (h : function.right_inverse f₂ f₁) :
-  M ≃L[R] M₂ × f₁.ker :=
-equiv_of_inverse (f₁.prod (f₁.proj_ker_of_right_inverse f₂ h)) (f₂.coprod (subtype_val f₁.ker))
+  M ≃L[R] M₂ × ker f₁:=
+equiv_of_inverse (f₁.prod (f₁.proj_ker_of_right_inverse f₂ h)) (f₂.coprod (ker f₁).subtypeL)
   (λ x, by simp)
   (λ ⟨x, y⟩, by simp [h x])
 
@@ -1753,7 +1954,7 @@ equiv_of_inverse (f₁.prod (f₁.proj_ker_of_right_inverse f₂ h)) (f₂.copro
   ((equiv_of_right_inverse f₁ f₂ h x).2 : M) = x - f₂ (f₁ x) := rfl
 
 @[simp] lemma equiv_of_right_inverse_symm_apply (f₁ : M →L[R] M₂) (f₂ : M₂ →L[R] M)
-  (h : function.right_inverse f₂ f₁) (y : M₂ × f₁.ker) :
+  (h : function.right_inverse f₂ f₁) (y : M₂ × ker f₁) :
   (equiv_of_right_inverse f₁ f₂ h).symm y = f₂ y.1 + y.2 := rfl
 
 end ring
@@ -1789,11 +1990,6 @@ def fin_two_arrow : (fin 2 → M) ≃L[R] M × M :=
 
 end
 
-@[simp] lemma det_coe_symm {R : Type*} [field R]
-  {M : Type*} [topological_space M] [add_comm_group M] [module R M] (A : M ≃L[R] M) :
-  (A.symm : M →L[R] M).det = (A : M →L[R] M).det ⁻¹ :=
-linear_equiv.det_coe_symm A.to_linear_equiv
-
 end continuous_linear_equiv
 
 namespace continuous_linear_map
@@ -1891,14 +2087,14 @@ def closed_complemented (p : submodule R M) : Prop := ∃ f : M →L[R] p, ∀ x
 lemma closed_complemented.has_closed_complement {p : submodule R M} [t1_space p]
   (h : closed_complemented p) :
   ∃ (q : submodule R M) (hq : is_closed (q : set M)), is_compl p q :=
-exists.elim h $ λ f hf, ⟨f.ker, f.is_closed_ker, linear_map.is_compl_of_proj hf⟩
+exists.elim h $ λ f hf, ⟨ker f, f.is_closed_ker, linear_map.is_compl_of_proj hf⟩
 
 protected lemma closed_complemented.is_closed [topological_add_group M] [t1_space M]
   {p : submodule R M} (h : closed_complemented p) :
   is_closed (p : set M) :=
 begin
   rcases h with ⟨f, hf⟩,
-  have : ker (id R M - (subtype_val p).comp f) = p := linear_map.ker_id_sub_eq_of_proj hf,
+  have : ker (id R M - p.subtypeL.comp f) = p := linear_map.ker_id_sub_eq_of_proj hf,
   exact this ▸ (is_closed_ker _)
 end
 
@@ -1915,7 +2111,7 @@ lemma continuous_linear_map.closed_complemented_ker_of_right_inverse {R : Type*}
   {M₂ : Type*} [topological_space M₂] [add_comm_group M₂] [module R M] [module R M₂]
   [topological_add_group M] (f₁ : M →L[R] M₂) (f₂ : M₂ →L[R] M)
   (h : function.right_inverse f₂ f₁) :
-  f₁.ker.closed_complemented :=
+  (ker f₁).closed_complemented :=
 ⟨f₁.proj_ker_of_right_inverse f₂ h, f₁.proj_ker_of_right_inverse_apply_idem f₂ h⟩
 
 section quotient
@@ -1946,11 +2142,11 @@ begin
   exact continuous_quot_mk.comp continuous_smul
 end
 
-instance regular_quotient_of_is_closed [topological_add_group M] [is_closed (S : set M)] :
-  regular_space (M ⧸ S) :=
+instance t3_quotient_of_is_closed [topological_add_group M] [is_closed (S : set M)] :
+  t3_space (M ⧸ S) :=
 begin
   letI : is_closed (S.to_add_subgroup : set M) := ‹_›,
-  exact S.to_add_subgroup.regular_quotient_of_is_closed
+  exact S.to_add_subgroup.t3_quotient_of_is_closed
 end
 
 end submodule
diff --git a/src/topology/algebra/module/character_space.lean b/src/topology/algebra/module/character_space.lean
index 52af6ec0680fb..8de7b152729af 100644
--- a/src/topology/algebra/module/character_space.lean
+++ b/src/topology/algebra/module/character_space.lean
@@ -6,10 +6,14 @@ Authors: Frédéric Dupuis
 
 import topology.algebra.module.weak_dual
 import algebra.algebra.spectrum
+import topology.continuous_function.algebra
 
 /-!
 # Character space of a topological algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The character space of a topological algebra is the subset of elements of the weak dual that
 are also algebra homomorphisms. This space is used in the Gelfand transform, which gives an
 isomorphism between a commutative C⋆-algebra and continuous functions on the character space
@@ -25,11 +29,6 @@ corresponding to any element. We also provide `to_clm` which provides the elemen
 continuous linear map. (Even though `weak_dual 𝕜 A` is a type copy of `A →L[𝕜] 𝕜`, this is
 often more convenient.)
 
-## TODO
-
-* Prove that the character space is a compact subset of the weak dual. This requires the
-  Banach-Alaoglu theorem.
-
 ## Tags
 
 character space, Gelfand transform, functional calculus
@@ -55,29 +54,61 @@ variables [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜
   [has_continuous_const_smul 𝕜 𝕜] [non_unital_non_assoc_semiring A] [topological_space A]
   [module 𝕜 A]
 
-lemma coe_apply (φ : character_space 𝕜 A) (x : A) : (φ : weak_dual 𝕜 A) x = φ x := rfl
+@[simp, norm_cast, protected]
+lemma coe_coe (φ : character_space 𝕜 A) : ⇑(φ : weak_dual 𝕜 A) = φ := rfl
+
+/-- Elements of the character space are continuous linear maps. -/
+instance : continuous_linear_map_class (character_space 𝕜 A) 𝕜 A 𝕜 :=
+{ coe := λ φ, (φ : A → 𝕜),
+  coe_injective' := λ φ ψ h, by { ext, exact congr_fun h x },
+  map_smulₛₗ := λ φ, (φ : weak_dual 𝕜 A).map_smul,
+  map_add := λ φ, (φ : weak_dual 𝕜 A).map_add,
+  map_continuous := λ φ, (φ : weak_dual 𝕜 A).cont }
+
+@[ext] lemma ext {φ ψ : character_space 𝕜 A} (h : ∀ x, φ x = ψ x) : φ = ψ := fun_like.ext _ _ h
 
 /-- An element of the character space, as a continuous linear map. -/
 def to_clm (φ : character_space 𝕜 A) : A →L[𝕜] 𝕜 := (φ : weak_dual 𝕜 A)
 
-lemma to_clm_apply (φ : character_space 𝕜 A) (x : A) : φ x = to_clm φ x := rfl
+@[simp] lemma coe_to_clm (φ : character_space 𝕜 A) : ⇑(to_clm φ) = φ := rfl
+
+/-- Elements of the character space are non-unital algebra homomorphisms. -/
+instance : non_unital_alg_hom_class (character_space 𝕜 A) 𝕜 A 𝕜 :=
+{ map_smul := λ φ, map_smul φ,
+  map_zero := λ φ, map_zero φ,
+  map_mul := λ φ, φ.prop.2,
+  .. character_space.continuous_linear_map_class }
 
 /-- An element of the character space, as an non-unital algebra homomorphism. -/
-@[simps] def to_non_unital_alg_hom (φ : character_space 𝕜 A) : A →ₙₐ[𝕜] 𝕜 :=
+def to_non_unital_alg_hom (φ : character_space 𝕜 A) : A →ₙₐ[𝕜] 𝕜 :=
 { to_fun := (φ : A → 𝕜),
-  map_mul' := φ.prop.2,
-  map_smul' := (to_clm φ).map_smul,
-  map_zero' := continuous_linear_map.map_zero _,
-  map_add' := continuous_linear_map.map_add _ }
-
-lemma map_zero (φ : character_space 𝕜 A) : φ 0 = 0 := (to_non_unital_alg_hom φ).map_zero
-lemma map_add (φ : character_space 𝕜 A) (x y : A) : φ (x + y) = φ x + φ y :=
-  (to_non_unital_alg_hom φ).map_add _ _
-lemma map_smul (φ : character_space 𝕜 A) (r : 𝕜) (x : A) : φ (r • x) = r • (φ x) :=
-  (to_clm φ).map_smul _ _
-lemma map_mul (φ : character_space 𝕜 A) (x y : A) : φ (x * y) = φ x * φ y :=
-  (to_non_unital_alg_hom φ).map_mul _ _
-lemma continuous (φ : character_space 𝕜 A) : continuous φ := (to_clm φ).continuous
+  map_mul' := map_mul φ,
+  map_smul' := map_smul φ,
+  map_zero' := map_zero φ,
+  map_add' := map_add φ }
+
+@[simp]
+lemma coe_to_non_unital_alg_hom (φ : character_space 𝕜 A) : ⇑(to_non_unital_alg_hom φ) = φ := rfl
+
+instance [subsingleton A] : is_empty (character_space 𝕜 A) :=
+⟨λ φ, φ.prop.1 $ continuous_linear_map.ext (λ x, by simp only [subsingleton.elim x 0, map_zero])⟩
+
+variables (𝕜 A)
+
+lemma union_zero :
+  character_space 𝕜 A ∪ {0} = {φ : weak_dual 𝕜 A | ∀ (x y : A), φ (x * y) = (φ x) * (φ y)} :=
+le_antisymm
+  (by { rintros φ (hφ | h₀), { exact hφ.2 }, { exact λ x y, by simp [set.eq_of_mem_singleton h₀] }})
+  (λ φ hφ, or.elim (em $ φ = 0) (λ h₀, or.inr h₀) (λ h₀, or.inl ⟨h₀, hφ⟩))
+
+/-- The `character_space 𝕜 A` along with `0` is always a closed set in `weak_dual 𝕜 A`. -/
+lemma union_zero_is_closed [t2_space 𝕜] [has_continuous_mul 𝕜] :
+  is_closed (character_space 𝕜 A ∪ {0}) :=
+begin
+  simp only [union_zero, set.set_of_forall],
+  exact is_closed_Inter (λ x, is_closed_Inter $ λ y, is_closed_eq (eval_continuous _) $
+    (eval_continuous _).mul (eval_continuous _))
+end
 
 end non_unital_non_assoc_semiring
 
@@ -86,27 +117,50 @@ section unital
 variables [comm_ring 𝕜] [no_zero_divisors 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
   [has_continuous_const_smul 𝕜 𝕜] [topological_space A] [semiring A] [algebra 𝕜 A]
 
-lemma map_one (φ : character_space 𝕜 A) : φ 1 = 1 :=
+/-- In a unital algebra, elements of the character space are algebra homomorphisms. -/
+instance : alg_hom_class (character_space 𝕜 A) 𝕜 A 𝕜 :=
+have map_one' : ∀ φ : character_space 𝕜 A, φ 1 = 1 := λ φ,
 begin
   have h₁ : (φ 1) * (1 - φ 1) = 0 := by rw [mul_sub, sub_eq_zero, mul_one, ←map_mul φ, one_mul],
-  rcases mul_eq_zero.mp h₁ with h₂|h₂,
-  { exfalso,
-    apply φ.prop.1,
-    ext,
-    rw [continuous_linear_map.zero_apply, ←one_mul x, coe_apply, map_mul φ, h₂, zero_mul] },
-  { rw [sub_eq_zero] at h₂,
-    exact h₂.symm },
-end
+  rcases mul_eq_zero.mp h₁ with h₂ | h₂,
+  { have : ∀ a, φ (a * 1) = 0 := λ a, by simp only [map_mul φ, h₂, mul_zero],
+    exact false.elim (φ.prop.1 $ continuous_linear_map.ext $ by simpa only [mul_one] using this) },
+  { exact (sub_eq_zero.mp h₂).symm },
+end,
+{ map_one := map_one',
+  commutes := λ φ r,
+  begin
+  { rw [algebra.algebra_map_eq_smul_one, algebra.id.map_eq_id, ring_hom.id_apply],
+    change ((φ : weak_dual 𝕜 A) : A →L[𝕜] 𝕜) (r • 1) = r,
+    rw [map_smul, algebra.id.smul_eq_mul, character_space.coe_coe, map_one' φ, mul_one] },
+  end,
+  .. character_space.non_unital_alg_hom_class }
 
-/-- An element of the character space, as an algebra homomorphism. -/
+/-- An element of the character space of a unital algebra, as an algebra homomorphism. -/
 @[simps] def to_alg_hom (φ : character_space 𝕜 A) : A →ₐ[𝕜] 𝕜 :=
 { map_one' := map_one φ,
-  commutes' := λ r, by
-  { rw [algebra.algebra_map_eq_smul_one, algebra.id.map_eq_id, ring_hom.id_apply],
-    change ((φ : weak_dual 𝕜 A) : A →L[𝕜] 𝕜) (r • 1) = r,
-    rw [continuous_linear_map.map_smul, algebra.id.smul_eq_mul, coe_apply, map_one φ, mul_one] },
+  commutes' := alg_hom_class.commutes φ,
   ..to_non_unital_alg_hom φ }
 
+lemma eq_set_map_one_map_mul [nontrivial 𝕜] : character_space 𝕜 A =
+  {φ : weak_dual 𝕜 A | (φ 1 = 1) ∧ (∀ (x y : A), φ (x * y) = (φ x) * (φ y))} :=
+begin
+  ext x,
+  refine ⟨λ h, ⟨map_one (⟨x, h⟩ : character_space 𝕜 A), h.2⟩, λ h, ⟨_, h.2⟩⟩,
+  rintro rfl,
+  simpa using h.1,
+end
+
+/-- under suitable mild assumptions on `𝕜`, the character space is a closed set in
+`weak_dual 𝕜 A`. -/
+protected lemma is_closed [nontrivial 𝕜] [t2_space 𝕜] [has_continuous_mul 𝕜] :
+  is_closed (character_space 𝕜 A) :=
+begin
+  rw [eq_set_map_one_map_mul, set.set_of_and],
+  refine is_closed.inter (is_closed_eq (eval_continuous _) continuous_const) _,
+  simpa only [(union_zero 𝕜 A).symm] using union_zero_is_closed _ _,
+end
+
 end unital
 
 section ring
@@ -115,10 +169,54 @@ variables [comm_ring 𝕜] [no_zero_divisors 𝕜] [topological_space 𝕜] [has
   [has_continuous_const_smul 𝕜 𝕜] [topological_space A] [ring A] [algebra 𝕜 A]
 
 lemma apply_mem_spectrum [nontrivial 𝕜] (φ : character_space 𝕜 A) (a : A) : φ a ∈ spectrum 𝕜 a :=
-(to_alg_hom φ).apply_mem_spectrum a
+alg_hom.apply_mem_spectrum φ a
+
+lemma ext_ker {φ ψ : character_space 𝕜 A} (h : ring_hom.ker φ = ring_hom.ker ψ) : φ = ψ :=
+begin
+  ext,
+  have : x - algebra_map 𝕜 A (ψ x) ∈ ring_hom.ker φ,
+  { simpa only [h, ring_hom.mem_ker, map_sub, alg_hom_class.commutes] using sub_self (ψ x) },
+  { rwa [ring_hom.mem_ker, map_sub, alg_hom_class.commutes, sub_eq_zero] at this, }
+end
 
 end ring
 
 end character_space
 
+section kernel
+
+variables [field 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜] [has_continuous_const_smul 𝕜 𝕜]
+variables [ring A] [topological_space A] [algebra 𝕜 A]
+
+/-- The `ring_hom.ker` of `φ : character_space 𝕜 A` is maximal. -/
+instance ker_is_maximal (φ : character_space 𝕜 A) : (ring_hom.ker φ).is_maximal :=
+ring_hom.ker_is_maximal_of_surjective φ $ λ z, ⟨algebra_map 𝕜 A z,
+  by simp only [alg_hom_class.commutes, algebra.id.map_eq_id, ring_hom.id_apply]⟩
+
+end kernel
+
+section gelfand_transform
+
+open continuous_map
+
+variables (𝕜 A) [comm_ring 𝕜] [no_zero_divisors 𝕜] [topological_space 𝕜]
+  [topological_ring 𝕜] [topological_space A] [semiring A] [algebra 𝕜 A]
+
+/-- The **Gelfand transform** is an algebra homomorphism (over `𝕜`) from a topological `𝕜`-algebra
+`A` into the `𝕜`-algebra of continuous `𝕜`-valued functions on the `character_space 𝕜 A`.
+The character space itself consists of all algebra homomorphisms from `A` to `𝕜`.  -/
+@[simps] def gelfand_transform : A →ₐ[𝕜] C(character_space 𝕜 A, 𝕜) :=
+{ to_fun := λ a,
+  { to_fun := λ φ, φ a,
+    continuous_to_fun := (eval_continuous a).comp continuous_induced_dom },
+    map_one' := by {ext, simp only [coe_mk, coe_one, pi.one_apply, map_one a] },
+    map_mul' := λ a b, by {ext, simp only [map_mul, coe_mk, coe_mul, pi.mul_apply] },
+    map_zero' := by {ext, simp only [map_zero, coe_mk, coe_mul, coe_zero, pi.zero_apply], },
+    map_add' :=  λ a b, by {ext, simp only [map_add, coe_mk, coe_add, pi.add_apply] },
+    commutes' := λ k, by {ext, simp only [alg_hom_class.commutes, algebra.id.map_eq_id,
+      ring_hom.id_apply, coe_mk, algebra_map_apply, algebra.id.smul_eq_mul, mul_one] } }
+
+end gelfand_transform
+
+
 end weak_dual
diff --git a/src/topology/algebra/module/determinant.lean b/src/topology/algebra/module/determinant.lean
new file mode 100644
index 0000000000000..4613a6f35a2c7
--- /dev/null
+++ b/src/topology/algebra/module/determinant.lean
@@ -0,0 +1,34 @@
+/-
+Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jan-David Salchow, Sébastien Gouëzel, Jean Lo, Yury Kudryashov, Frédéric Dupuis,
+  Heather Macbeth
+-/
+import topology.algebra.module.basic
+import linear_algebra.determinant
+
+/-!
+# The determinant of a continuous linear map.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+namespace continuous_linear_map
+
+/-- The determinant of a continuous linear map, mainly as a convenience device to be able to
+write `A.det` instead of `(A : M →ₗ[R] M).det`. -/
+@[reducible] noncomputable def det {R : Type*} [comm_ring R]
+  {M : Type*} [topological_space M] [add_comm_group M] [module R M] (A : M →L[R] M) : R :=
+linear_map.det (A : M →ₗ[R] M)
+
+end continuous_linear_map
+
+namespace continuous_linear_equiv
+
+@[simp] lemma det_coe_symm {R : Type*} [field R]
+  {M : Type*} [topological_space M] [add_comm_group M] [module R M] (A : M ≃L[R] M) :
+  (A.symm : M →L[R] M).det = (A : M →L[R] M).det ⁻¹ :=
+linear_equiv.det_coe_symm A.to_linear_equiv
+
+end continuous_linear_equiv
diff --git a/src/topology/algebra/module/finite_dimension.lean b/src/topology/algebra/module/finite_dimension.lean
new file mode 100644
index 0000000000000..fe65f4c3628e8
--- /dev/null
+++ b/src/topology/algebra/module/finite_dimension.lean
@@ -0,0 +1,466 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel, Anatole Dedecker
+-/
+import analysis.locally_convex.balanced_core_hull
+import linear_algebra.free_module.finite.matrix
+import topology.algebra.module.simple
+import topology.algebra.module.determinant
+
+/-!
+# Finite dimensional topological vector spaces over complete fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `𝕜` be a complete nontrivially normed field, and `E` a topological vector space (TVS) over
+`𝕜` (i.e we have `[add_comm_group E] [module 𝕜 E] [topological_space E] [topological_add_group E]`
+and `[has_continuous_smul 𝕜 E]`).
+
+If `E` is finite dimensional and Hausdorff, then all linear maps from `E` to any other TVS are
+continuous.
+
+When `E` is a normed space, this gets us the equivalence of norms in finite dimension.
+
+## Main results :
+
+* `linear_map.continuous_iff_is_closed_ker` : a linear form is continuous if and only if its kernel
+  is closed.
+* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional Hausdorff
+  space over a complete field is continuous.
+
+## TODO
+
+Generalize more of `analysis/normed_space/finite_dimension` to general TVSs.
+
+## Implementation detail
+
+The main result from which everything follows is the fact that, if `ξ : ι → E` is a finite basis,
+then `ξ.equiv_fun : E →ₗ (ι → 𝕜)` is continuous. However, for technical reasons, it is easier to
+prove this when `ι` and `E` live ine the same universe. So we start by doing that as a private
+lemma, then we deduce `linear_map.continuous_of_finite_dimensional` from it, and then the general
+result follows as `continuous_equiv_fun_basis`.
+
+-/
+
+universes u v w x
+
+noncomputable theory
+
+open set finite_dimensional topological_space filter
+open_locale big_operators
+
+section field
+
+variables {𝕜 E F : Type*} [field 𝕜] [topological_space 𝕜] [add_comm_group E] [module 𝕜 E]
+  [topological_space E] [add_comm_group F] [module 𝕜 F] [topological_space F]
+  [topological_add_group F] [has_continuous_smul 𝕜 F]
+
+/-- The space of continuous linear maps between finite-dimensional spaces is finite-dimensional. -/
+instance [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] :
+  finite_dimensional 𝕜 (E →L[𝕜] F) :=
+finite_dimensional.of_injective
+  (continuous_linear_map.coe_lm 𝕜 : (E →L[𝕜] F) →ₗ[𝕜] (E →ₗ[𝕜] F))
+  continuous_linear_map.coe_injective
+
+end field
+
+section normed_field
+
+variables {𝕜 : Type u} [hnorm : nontrivially_normed_field 𝕜]
+  {E : Type v} [add_comm_group E] [module 𝕜 E] [topological_space E]
+  [topological_add_group E] [has_continuous_smul 𝕜 E]
+  {F : Type w} [add_comm_group F] [module 𝕜 F] [topological_space F]
+  [topological_add_group F] [has_continuous_smul 𝕜 F]
+  {F' : Type x} [add_comm_group F'] [module 𝕜 F'] [topological_space F']
+  [topological_add_group F'] [has_continuous_smul 𝕜 F']
+
+include hnorm
+
+/-- If `𝕜` is a nontrivially normed field, any T2 topology on `𝕜` which makes it a topological
+vector space over itself (with the norm topology) is *equal* to the norm topology. -/
+lemma unique_topology_of_t2 {t : topological_space 𝕜}
+  (h₁ : @topological_add_group 𝕜 t _)
+  (h₂ : @has_continuous_smul 𝕜 𝕜 _ hnorm.to_uniform_space.to_topological_space t)
+  (h₃ : @t2_space 𝕜 t) :
+  t = hnorm.to_uniform_space.to_topological_space :=
+begin
+  -- Let `𝓣₀` denote the topology on `𝕜` induced by the norm, and `𝓣` be any T2 vector
+  -- topology on `𝕜`. To show that `𝓣₀ = 𝓣`, it suffices to show that they have the same
+  -- neighborhoods of 0.
+  refine topological_add_group.ext h₁ infer_instance (le_antisymm _ _),
+  { -- To show `𝓣 ≤ 𝓣₀`, we have to show that closed balls are `𝓣`-neighborhoods of 0.
+    rw metric.nhds_basis_closed_ball.ge_iff,
+    -- Let `ε > 0`. Since `𝕜` is nontrivially normed, we have `0 < ‖ξ₀‖ < ε` for some `ξ₀ : 𝕜`.
+    intros ε hε,
+    rcases normed_field.exists_norm_lt 𝕜 hε with ⟨ξ₀, hξ₀, hξ₀ε⟩,
+    -- Since `ξ₀ ≠ 0` and `𝓣` is T2, we know that `{ξ₀}ᶜ` is a `𝓣`-neighborhood of 0.
+    have : {ξ₀}ᶜ ∈ @nhds 𝕜 t 0 :=
+      is_open.mem_nhds is_open_compl_singleton (ne.symm $ norm_ne_zero_iff.mp hξ₀.ne.symm),
+    -- Thus, its balanced core `𝓑` is too. Let's show that the closed ball of radius `ε` contains
+    -- `𝓑`, which will imply that the closed ball is indeed a `𝓣`-neighborhood of 0.
+    have : balanced_core 𝕜 {ξ₀}ᶜ ∈ @nhds 𝕜 t 0 := balanced_core_mem_nhds_zero this,
+    refine mem_of_superset this (λ ξ hξ, _),
+    -- Let `ξ ∈ 𝓑`. We want to show `‖ξ‖ < ε`. If `ξ = 0`, this is trivial.
+    by_cases hξ0 : ξ = 0,
+    { rw hξ0,
+      exact metric.mem_closed_ball_self hε.le },
+    { rw [mem_closed_ball_zero_iff],
+      -- Now suppose `ξ ≠ 0`. By contradiction, let's assume `ε < ‖ξ‖`, and show that
+      -- `ξ₀ ∈ 𝓑 ⊆ {ξ₀}ᶜ`, which is a contradiction.
+      by_contra' h,
+      suffices : (ξ₀ * ξ⁻¹) • ξ ∈ balanced_core 𝕜 {ξ₀}ᶜ,
+      { rw [smul_eq_mul 𝕜, mul_assoc, inv_mul_cancel hξ0, mul_one] at this,
+        exact not_mem_compl_iff.mpr (mem_singleton ξ₀) ((balanced_core_subset _) this) },
+      -- For that, we use that `𝓑` is balanced : since `‖ξ₀‖ < ε < ‖ξ‖`, we have `‖ξ₀ / ξ‖ ≤ 1`,
+      -- hence `ξ₀ = (ξ₀ / ξ) • ξ ∈ 𝓑` because `ξ ∈ 𝓑`.
+      refine (balanced_core_balanced _).smul_mem _ hξ,
+      rw [norm_mul, norm_inv, mul_inv_le_iff (norm_pos_iff.mpr hξ0), mul_one],
+      exact (hξ₀ε.trans h).le } },
+  { -- Finally, to show `𝓣₀ ≤ 𝓣`, we simply argue that `id = (λ x, x • 1)` is continuous from
+    -- `(𝕜, 𝓣₀)` to `(𝕜, 𝓣)` because `(•) : (𝕜, 𝓣₀) × (𝕜, 𝓣) → (𝕜, 𝓣)` is continuous.
+    calc (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0)
+        = map id (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0) : map_id.symm
+    ... = map (λ x, id x • 1) (@nhds 𝕜 hnorm.to_uniform_space.to_topological_space 0) :
+        by conv_rhs {congr, funext, rw [smul_eq_mul, mul_one]}; refl
+    ... ≤ (@nhds 𝕜 t ((0 : 𝕜) • 1)) :
+        @tendsto.smul_const _ _ _ hnorm.to_uniform_space.to_topological_space t _ _ _ _ _
+          tendsto_id (1 : 𝕜)
+    ... = (@nhds 𝕜 t 0) : by rw zero_smul }
+end
+
+/-- Any linear form on a topological vector space over a nontrivially normed field is continuous if
+    its kernel is closed. -/
+lemma linear_map.continuous_of_is_closed_ker (l : E →ₗ[𝕜] 𝕜) (hl : is_closed (l.ker : set E)) :
+  continuous l :=
+begin
+  -- `l` is either constant or surjective. If it is constant, the result is trivial.
+  by_cases H : finrank 𝕜 l.range = 0,
+  { rw [finrank_eq_zero, linear_map.range_eq_bot] at H,
+    rw H,
+    exact continuous_zero },
+  { -- In the case where `l` is surjective, we factor it as `φ : (E ⧸ l.ker) ≃ₗ[𝕜] 𝕜`. Note that
+    -- `E ⧸ l.ker` is T2 since `l.ker` is closed.
+    have : finrank 𝕜 l.range = 1,
+      from le_antisymm (finrank_self 𝕜 ▸ l.range.finrank_le) (zero_lt_iff.mpr H),
+    have hi : function.injective (l.ker.liftq l (le_refl _)),
+    { rw [← linear_map.ker_eq_bot],
+      exact submodule.ker_liftq_eq_bot _ _ _ (le_refl _) },
+    have hs : function.surjective (l.ker.liftq l (le_refl _)),
+    { rw [← linear_map.range_eq_top, submodule.range_liftq],
+      exact eq_top_of_finrank_eq ((finrank_self 𝕜).symm ▸ this) },
+    let φ : (E ⧸ l.ker) ≃ₗ[𝕜] 𝕜 := linear_equiv.of_bijective (l.ker.liftq l (le_refl _)) ⟨hi, hs⟩,
+    have hlφ : (l : E → 𝕜) = φ ∘ l.ker.mkq,
+      by ext; refl,
+    -- Since the quotient map `E →ₗ[𝕜] (E ⧸ l.ker)` is continuous, the continuity of `l` will follow
+    -- form the continuity of `φ`.
+    suffices : continuous φ.to_equiv,
+    { rw hlφ,
+      exact this.comp continuous_quot_mk },
+    -- The pullback by `φ.symm` of the quotient topology is a T2 topology on `𝕜`, because `φ.symm`
+    -- is injective. Since `φ.symm` is linear, it is also a vector space topology.
+    -- Hence, we know that it is equal to the topology induced by the norm.
+    have : induced φ.to_equiv.symm infer_instance = hnorm.to_uniform_space.to_topological_space,
+    { refine unique_topology_of_t2 (topological_add_group_induced φ.symm.to_linear_map)
+        (has_continuous_smul_induced φ.symm.to_linear_map) _,
+      rw t2_space_iff,
+      exact λ x y hxy, @separated_by_continuous _ _ (induced _ _) _ _ _
+        continuous_induced_dom _ _ (φ.to_equiv.symm.injective.ne hxy) },
+    -- Finally, the pullback by `φ.symm` is exactly the pushforward by `φ`, so we have to prove
+    -- that `φ` is continuous when `𝕜` is endowed with the pushforward by `φ` of the quotient
+    -- topology, which is trivial by definition of the pushforward.
+    rw [this.symm, equiv.induced_symm],
+    exact continuous_coinduced_rng }
+end
+
+/-- Any linear form on a topological vector space over a nontrivially normed field is continuous if
+    and only if its kernel is closed. -/
+lemma linear_map.continuous_iff_is_closed_ker (l : E →ₗ[𝕜] 𝕜) :
+  continuous l ↔ is_closed (l.ker : set E) :=
+⟨λ h, is_closed_singleton.preimage h, l.continuous_of_is_closed_ker⟩
+
+/-- Over a nontrivially normed field, any linear form which is nonzero on a nonempty open set is
+    automatically continuous. -/
+lemma linear_map.continuous_of_nonzero_on_open (l : E →ₗ[𝕜] 𝕜) (s : set E) (hs₁ : is_open s)
+  (hs₂ : s.nonempty) (hs₃ : ∀ x ∈ s, l x ≠ 0) : continuous l :=
+begin
+  refine l.continuous_of_is_closed_ker (l.is_closed_or_dense_ker.resolve_right $ λ hl, _),
+  rcases hs₂ with ⟨x, hx⟩,
+  have : x ∈ interior (l.ker : set E)ᶜ,
+  { rw mem_interior_iff_mem_nhds,
+    exact mem_of_superset (hs₁.mem_nhds hx) hs₃ },
+  rwa hl.interior_compl at this
+end
+
+variables [complete_space 𝕜]
+
+/-- This version imposes `ι` and `E` to live in the same universe, so you should instead use
+`continuous_equiv_fun_basis` which gives the same result without universe restrictions. -/
+private lemma continuous_equiv_fun_basis_aux [ht2 : t2_space E] {ι : Type v} [fintype ι]
+  (ξ : basis ι 𝕜 E) : continuous ξ.equiv_fun :=
+begin
+  letI : uniform_space E := topological_add_group.to_uniform_space E,
+  letI : uniform_add_group E := topological_add_comm_group_is_uniform,
+  letI : separated_space E := separated_iff_t2.mpr ht2,
+  unfreezingI { induction hn : fintype.card ι with n IH generalizing ι E },
+  { rw fintype.card_eq_zero_iff at hn,
+    exact continuous_of_const (λ x y, funext hn.elim) },
+  { haveI : finite_dimensional 𝕜 E := of_fintype_basis ξ,
+    -- first step: thanks to the induction hypothesis, any n-dimensional subspace is equivalent
+    -- to a standard space of dimension n, hence it is complete and therefore closed.
+    have H₁ : ∀s : submodule 𝕜 E, finrank 𝕜 s = n → is_closed (s : set E),
+    { assume s s_dim,
+      letI : uniform_add_group s := s.to_add_subgroup.uniform_add_group,
+      let b := basis.of_vector_space 𝕜 s,
+      have U : uniform_embedding b.equiv_fun.symm.to_equiv,
+      { have : fintype.card (basis.of_vector_space_index 𝕜 s) = n,
+          by { rw ← s_dim, exact (finrank_eq_card_basis b).symm },
+        have : continuous b.equiv_fun := IH b this,
+        exact b.equiv_fun.symm.uniform_embedding b.equiv_fun.symm.to_linear_map.continuous_on_pi
+          this },
+      have : is_complete (s : set E),
+        from complete_space_coe_iff_is_complete.1 ((complete_space_congr U).1 (by apply_instance)),
+      exact this.is_closed },
+    -- second step: any linear form is continuous, as its kernel is closed by the first step
+    have H₂ : ∀f : E →ₗ[𝕜] 𝕜, continuous f,
+    { assume f,
+      by_cases H : finrank 𝕜 f.range = 0,
+      { rw [finrank_eq_zero, linear_map.range_eq_bot] at H,
+        rw H,
+        exact continuous_zero },
+      { have : finrank 𝕜 f.ker = n,
+        { have Z := f.finrank_range_add_finrank_ker,
+          rw [finrank_eq_card_basis ξ, hn] at Z,
+          have : finrank 𝕜 f.range = 1,
+            from le_antisymm (finrank_self 𝕜 ▸ f.range.finrank_le) (zero_lt_iff.mpr H),
+          rw [this, add_comm, nat.add_one] at Z,
+          exact nat.succ.inj Z },
+        have : is_closed (f.ker : set E),
+          from H₁ _ this,
+        exact linear_map.continuous_of_is_closed_ker f this } },
+    rw continuous_pi_iff,
+    intros i,
+    change continuous (ξ.coord i),
+    exact H₂ (ξ.coord i) },
+end
+
+/-- Any linear map on a finite dimensional space over a complete field is continuous. -/
+theorem linear_map.continuous_of_finite_dimensional [t2_space E] [finite_dimensional 𝕜 E]
+  (f : E →ₗ[𝕜] F') :
+  continuous f :=
+begin
+  -- for the proof, go to a model vector space `b → 𝕜` thanks to `continuous_equiv_fun_basis`, and
+  -- argue that all linear maps there are continuous.
+  let b := basis.of_vector_space 𝕜 E,
+  have A : continuous b.equiv_fun :=
+    continuous_equiv_fun_basis_aux b,
+  have B : continuous (f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E)) :=
+    linear_map.continuous_on_pi _,
+  have : continuous ((f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E))
+                      ∘ b.equiv_fun) := B.comp A,
+  convert this,
+  ext x,
+  dsimp,
+  rw [basis.equiv_fun_symm_apply, basis.sum_repr]
+end
+
+instance linear_map.continuous_linear_map_class_of_finite_dimensional
+  [t2_space E] [finite_dimensional 𝕜 E] :
+  continuous_linear_map_class (E →ₗ[𝕜] F') 𝕜 E F' :=
+{ map_continuous := λ f, f.continuous_of_finite_dimensional,
+  ..linear_map.semilinear_map_class }
+
+/-- In finite dimensions over a non-discrete complete normed field, the canonical identification
+(in terms of a basis) with `𝕜^n` (endowed with the product topology) is continuous.
+This is the key fact wich makes all linear maps from a T2 finite dimensional TVS over such a field
+continuous (see `linear_map.continuous_of_finite_dimensional`), which in turn implies that all
+norms are equivalent in finite dimensions. -/
+theorem continuous_equiv_fun_basis [t2_space E] {ι : Type*} [fintype ι] (ξ : basis ι 𝕜 E) :
+  continuous ξ.equiv_fun :=
+begin
+  haveI : finite_dimensional 𝕜 E := of_fintype_basis ξ,
+  exact ξ.equiv_fun.to_linear_map.continuous_of_finite_dimensional
+end
+
+namespace linear_map
+
+variables [t2_space E] [finite_dimensional 𝕜 E]
+
+/-- The continuous linear map induced by a linear map on a finite dimensional space -/
+def to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F' :=
+{ to_fun := λ f, ⟨f, f.continuous_of_finite_dimensional⟩,
+  inv_fun := coe,
+  map_add' := λ f g, rfl,
+  map_smul' := λ c f, rfl,
+  left_inv := λ f, rfl,
+  right_inv := λ f, continuous_linear_map.coe_injective rfl }
+
+@[simp] lemma coe_to_continuous_linear_map' (f : E →ₗ[𝕜] F') :
+  ⇑f.to_continuous_linear_map = f := rfl
+
+@[simp] lemma coe_to_continuous_linear_map (f : E →ₗ[𝕜] F') :
+  (f.to_continuous_linear_map : E →ₗ[𝕜] F') = f := rfl
+
+@[simp] lemma coe_to_continuous_linear_map_symm :
+  ⇑(to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F').symm = coe := rfl
+
+@[simp] lemma det_to_continuous_linear_map (f : E →ₗ[𝕜] E) :
+  f.to_continuous_linear_map.det = f.det :=
+rfl
+
+@[simp] lemma ker_to_continuous_linear_map (f : E →ₗ[𝕜] F') :
+  ker f.to_continuous_linear_map = ker f :=
+rfl
+
+@[simp] lemma range_to_continuous_linear_map (f : E →ₗ[𝕜] F') :
+  range f.to_continuous_linear_map = range f :=
+rfl
+
+/-- A surjective linear map `f` with finite dimensional codomain is an open map. -/
+lemma is_open_map_of_finite_dimensional (f : F →ₗ[𝕜] E) (hf : function.surjective f) :
+  is_open_map f :=
+begin
+  rcases f.exists_right_inverse_of_surjective (linear_map.range_eq_top.2 hf) with ⟨g, hg⟩,
+  refine is_open_map.of_sections (λ x, ⟨λ y, g (y - f x) + x, _, _, λ y, _⟩),
+  { exact ((g.continuous_of_finite_dimensional.comp $ continuous_id.sub continuous_const).add
+      continuous_const).continuous_at },
+  { rw [sub_self, map_zero, zero_add] },
+  { simp only [map_sub, map_add, ← comp_apply f g, hg, id_apply, sub_add_cancel] }
+end
+
+instance can_lift_continuous_linear_map : can_lift (E →ₗ[𝕜] F) (E →L[𝕜] F) coe (λ _, true) :=
+⟨λ f _, ⟨f.to_continuous_linear_map, rfl⟩⟩
+
+end linear_map
+
+section
+
+variables [t2_space E] [t2_space F] [finite_dimensional 𝕜 E]
+
+namespace linear_equiv
+
+/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional
+space. -/
+def to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) : E ≃L[𝕜] F :=
+{ continuous_to_fun := e.to_linear_map.continuous_of_finite_dimensional,
+  continuous_inv_fun := begin
+    haveI : finite_dimensional 𝕜 F := e.finite_dimensional,
+    exact e.symm.to_linear_map.continuous_of_finite_dimensional
+  end,
+  ..e }
+
+@[simp] lemma coe_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) :
+  (e.to_continuous_linear_equiv : E →ₗ[𝕜] F) = e := rfl
+
+@[simp] lemma coe_to_continuous_linear_equiv' (e : E ≃ₗ[𝕜] F) :
+  (e.to_continuous_linear_equiv : E → F) = e := rfl
+
+@[simp] lemma coe_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) :
+  (e.to_continuous_linear_equiv.symm : F →ₗ[𝕜] E) = e.symm := rfl
+
+@[simp] lemma coe_to_continuous_linear_equiv_symm' (e : E ≃ₗ[𝕜] F) :
+  (e.to_continuous_linear_equiv.symm : F → E) = e.symm := rfl
+
+@[simp] lemma to_linear_equiv_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) :
+  e.to_continuous_linear_equiv.to_linear_equiv = e :=
+by { ext x, refl }
+
+@[simp] lemma to_linear_equiv_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) :
+  e.to_continuous_linear_equiv.symm.to_linear_equiv = e.symm :=
+by { ext x, refl }
+
+instance can_lift_continuous_linear_equiv :
+  can_lift (E ≃ₗ[𝕜] F) (E ≃L[𝕜] F) continuous_linear_equiv.to_linear_equiv (λ _, true) :=
+⟨λ f _, ⟨_, f.to_linear_equiv_to_continuous_linear_equiv⟩⟩
+
+end linear_equiv
+
+variable [finite_dimensional 𝕜 F]
+
+/-- Two finite-dimensional topological vector spaces over a complete normed field are continuously
+linearly equivalent if they have the same (finite) dimension. -/
+theorem finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq
+  (cond : finrank 𝕜 E = finrank 𝕜 F) : nonempty (E ≃L[𝕜] F) :=
+(nonempty_linear_equiv_of_finrank_eq cond).map linear_equiv.to_continuous_linear_equiv
+
+/-- Two finite-dimensional topological vector spaces over a complete normed field are continuously
+linearly equivalent if and only if they have the same (finite) dimension. -/
+theorem finite_dimensional.nonempty_continuous_linear_equiv_iff_finrank_eq :
+   nonempty (E ≃L[𝕜] F) ↔ finrank 𝕜 E = finrank 𝕜 F :=
+⟨ λ ⟨h⟩, h.to_linear_equiv.finrank_eq,
+  λ h, finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq h ⟩
+
+/-- A continuous linear equivalence between two finite-dimensional topological vector spaces over a
+complete normed field of the same (finite) dimension. -/
+def continuous_linear_equiv.of_finrank_eq
+  (cond : finrank 𝕜 E = finrank 𝕜 F) : E ≃L[𝕜] F :=
+(linear_equiv.of_finrank_eq E F cond).to_continuous_linear_equiv
+
+end
+
+namespace basis
+
+variables {ι : Type*} [fintype ι] [t2_space E]
+
+/-- Construct a continuous linear map given the value at a finite basis. -/
+def constrL (v : basis ι 𝕜 E) (f : ι → F) :
+  E →L[𝕜] F :=
+by haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis v;
+  exact (v.constr 𝕜 f).to_continuous_linear_map
+
+@[simp, norm_cast] lemma coe_constrL (v : basis ι 𝕜 E) (f : ι → F) :
+  (v.constrL f : E →ₗ[𝕜] F) = v.constr 𝕜 f := rfl
+
+/-- The continuous linear equivalence between a vector space over `𝕜` with a finite basis and
+functions from its basis indexing type to `𝕜`. -/
+def equiv_funL (v : basis ι 𝕜 E) : E ≃L[𝕜] (ι → 𝕜) :=
+{ continuous_to_fun := begin
+    haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis v,
+    exact v.equiv_fun.to_linear_map.continuous_of_finite_dimensional,
+  end,
+  continuous_inv_fun := begin
+    change continuous v.equiv_fun.symm.to_fun,
+    exact v.equiv_fun.symm.to_linear_map.continuous_of_finite_dimensional,
+  end,
+  ..v.equiv_fun }
+
+@[simp] lemma constrL_apply (v : basis ι 𝕜 E) (f : ι → F) (e : E) :
+  (v.constrL f) e = ∑ i, (v.equiv_fun e i) • f i :=
+v.constr_apply_fintype 𝕜 _ _
+
+@[simp] lemma constrL_basis (v : basis ι 𝕜 E) (f : ι → F) (i : ι) :
+  (v.constrL f) (v i) = f i :=
+v.constr_basis 𝕜 _ _
+
+end basis
+
+namespace continuous_linear_map
+
+variables [t2_space E] [finite_dimensional 𝕜 E]
+
+/-- Builds a continuous linear equivalence from a continuous linear map on a finite-dimensional
+vector space whose determinant is nonzero. -/
+def to_continuous_linear_equiv_of_det_ne_zero
+  (f : E →L[𝕜] E) (hf : f.det ≠ 0) : E ≃L[𝕜] E :=
+((f : E →ₗ[𝕜] E).equiv_of_det_ne_zero hf).to_continuous_linear_equiv
+
+@[simp] lemma coe_to_continuous_linear_equiv_of_det_ne_zero (f : E →L[𝕜] E) (hf : f.det ≠ 0) :
+  (f.to_continuous_linear_equiv_of_det_ne_zero hf : E →L[𝕜] E) = f :=
+by { ext x, refl }
+
+@[simp] lemma to_continuous_linear_equiv_of_det_ne_zero_apply
+  (f : E →L[𝕜] E) (hf : f.det ≠ 0) (x : E) :
+  f.to_continuous_linear_equiv_of_det_ne_zero hf x = f x :=
+rfl
+
+lemma _root_.matrix.to_lin_fin_two_prod_to_continuous_linear_map (a b c d : 𝕜) :
+  (matrix.to_lin (basis.fin_two_prod 𝕜) (basis.fin_two_prod 𝕜)
+      !![a, b; c, d]).to_continuous_linear_map =
+  (a • continuous_linear_map.fst 𝕜 𝕜 𝕜 + b • continuous_linear_map.snd 𝕜 𝕜 𝕜).prod
+  (c • continuous_linear_map.fst 𝕜 𝕜 𝕜 + d • continuous_linear_map.snd 𝕜 𝕜 𝕜) :=
+continuous_linear_map.ext $ matrix.to_lin_fin_two_prod_apply _ _ _ _
+
+end continuous_linear_map
+
+end normed_field
diff --git a/src/topology/algebra/module/linear_pmap.lean b/src/topology/algebra/module/linear_pmap.lean
new file mode 100644
index 0000000000000..b36ab7fbcd01d
--- /dev/null
+++ b/src/topology/algebra/module/linear_pmap.lean
@@ -0,0 +1,186 @@
+/-
+Copyright (c) 2022 Moritz Doll. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Moritz Doll
+-/
+
+import linear_algebra.linear_pmap
+import topology.algebra.module.basic
+
+/-!
+# Partially defined linear operators over topological vector spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define basic notions of partially defined linear operators, which we call unbounded operators
+for short.
+In this file we prove all elementary properties of unbounded operators that do not assume that the
+underlying spaces are normed.
+
+## Main definitions
+
+* `linear_pmap.is_closed`: An unbounded operator is closed iff its graph is closed.
+* `linear_pmap.is_closable`: An unbounded operator is closable iff the closure of its graph is a
+  graph.
+* `linear_pmap.closure`: For a closable unbounded operator `f : linear_pmap R E F` the closure is
+  the smallest closed extension of `f`. If `f` is not closable, then `f.closure` is defined as `f`.
+* `linear_pmap.has_core`: a submodule contained in the domain is a core if restricting to the core
+  does not lose information about the unbounded operator.
+
+## Main statements
+
+* `linear_pmap.closable_iff_exists_closed_extension`: an unbounded operator is closable iff it has a
+  closed extension.
+* `linear_pmap.closable.exists_unique`: there exists a unique closure
+* `linear_pmap.closure_has_core`: the domain of `f` is a core of its closure
+
+## References
+
+* [J. Weidmann, *Linear Operators in Hilbert Spaces*][weidmann_linear]
+
+## Tags
+
+Unbounded operators, closed operators
+-/
+
+
+open_locale topology
+
+variables {R E F : Type*}
+
+variables [comm_ring R] [add_comm_group E] [add_comm_group F]
+variables [module R E] [module R F]
+variables [topological_space E] [topological_space F]
+
+namespace linear_pmap
+
+/-! ### Closed and closable operators -/
+
+/-- An unbounded operator is closed iff its graph is closed. -/
+def is_closed (f : E →ₗ.[R] F) : Prop :=
+is_closed (f.graph : set (E × F))
+
+variables [has_continuous_add E] [has_continuous_add F]
+variables [topological_space R] [has_continuous_smul R E] [has_continuous_smul R F]
+
+/-- An unbounded operator is closable iff the closure of its graph is a graph. -/
+def is_closable (f : E →ₗ.[R] F) : Prop :=
+∃ (f' : linear_pmap R E F), f.graph.topological_closure = f'.graph
+
+/-- A closed operator is trivially closable. -/
+lemma is_closed.is_closable {f : E →ₗ.[R] F} (hf : f.is_closed) : f.is_closable :=
+⟨f, hf.submodule_topological_closure_eq⟩
+
+/-- If `g` has a closable extension `f`, then `g` itself is closable. -/
+lemma is_closable.le_is_closable {f g : E →ₗ.[R] F} (hf : f.is_closable) (hfg : g ≤ f) :
+  g.is_closable :=
+begin
+  cases hf with f' hf,
+  have : g.graph.topological_closure ≤ f'.graph :=
+  by { rw ←hf, exact submodule.topological_closure_mono (le_graph_of_le hfg) },
+  refine ⟨g.graph.topological_closure.to_linear_pmap _, _⟩,
+  { intros x hx hx',
+    cases x,
+    exact f'.graph_fst_eq_zero_snd (this hx) hx' },
+  rw [submodule.to_linear_pmap_graph_eq],
+end
+
+/-- The closure is unique. -/
+lemma is_closable.exists_unique {f : E →ₗ.[R] F} (hf : f.is_closable) :
+  ∃! (f' : E →ₗ.[R] F), f.graph.topological_closure = f'.graph :=
+begin
+  refine exists_unique_of_exists_of_unique hf (λ _ _ hy₁ hy₂, eq_of_eq_graph _),
+  rw [←hy₁, ←hy₂],
+end
+
+open_locale classical
+
+/-- If `f` is closable, then `f.closure` is the closure. Otherwise it is defined
+as `f.closure = f`. -/
+noncomputable
+def closure (f : E →ₗ.[R] F) : E →ₗ.[R] F :=
+if hf : f.is_closable then hf.some else f
+
+lemma closure_def {f : E →ₗ.[R] F} (hf : f.is_closable) :
+  f.closure = hf.some :=
+by simp [closure, hf]
+
+lemma closure_def' {f : E →ₗ.[R] F} (hf : ¬f.is_closable) :
+  f.closure = f :=
+by simp [closure, hf]
+
+/-- The closure (as a submodule) of the graph is equal to the graph of the closure
+  (as a `linear_pmap`). -/
+lemma is_closable.graph_closure_eq_closure_graph {f : E →ₗ.[R] F} (hf : f.is_closable) :
+  f.graph.topological_closure = f.closure.graph :=
+begin
+  rw closure_def hf,
+  exact hf.some_spec,
+end
+
+/-- A `linear_pmap` is contained in its closure. -/
+lemma le_closure (f : E →ₗ.[R] F) : f ≤ f.closure :=
+begin
+  by_cases hf : f.is_closable,
+  { refine le_of_le_graph _,
+    rw ←hf.graph_closure_eq_closure_graph,
+    exact (graph f).le_topological_closure },
+  rw closure_def' hf,
+end
+
+lemma is_closable.closure_mono {f g : E →ₗ.[R] F} (hg : g.is_closable) (h : f ≤ g) :
+  f.closure ≤ g.closure :=
+begin
+  refine le_of_le_graph _,
+  rw ←(hg.le_is_closable h).graph_closure_eq_closure_graph,
+  rw ←hg.graph_closure_eq_closure_graph,
+  exact submodule.topological_closure_mono (le_graph_of_le h),
+end
+
+/-- If `f` is closable, then the closure is closed. -/
+lemma is_closable.closure_is_closed {f : E →ₗ.[R] F} (hf : f.is_closable) :
+  f.closure.is_closed :=
+begin
+  rw [is_closed, ←hf.graph_closure_eq_closure_graph],
+  exact f.graph.is_closed_topological_closure,
+end
+
+/-- If `f` is closable, then the closure is closable. -/
+lemma is_closable.closure_is_closable {f : E →ₗ.[R] F} (hf : f.is_closable) :
+  f.closure.is_closable :=
+hf.closure_is_closed.is_closable
+
+lemma is_closable_iff_exists_closed_extension {f : E →ₗ.[R] F} : f.is_closable ↔
+  ∃ (g : E →ₗ.[R] F) (hg : g.is_closed), f ≤ g :=
+⟨λ h, ⟨f.closure, h.closure_is_closed, f.le_closure⟩, λ ⟨_, hg, h⟩, hg.is_closable.le_is_closable h⟩
+
+/-! ### The core of a linear operator -/
+
+/-- A submodule `S` is a core of `f` if the closure of the restriction of `f` to `S` is again `f`.-/
+structure has_core (f : E →ₗ.[R] F) (S : submodule R E) : Prop :=
+(le_domain : S ≤ f.domain)
+(closure_eq : (f.dom_restrict S).closure = f)
+
+lemma has_core_def {f : E →ₗ.[R] F} {S : submodule R E} (h : f.has_core S) :
+(f.dom_restrict S).closure = f := h.2
+
+/-- For every unbounded operator `f` the submodule `f.domain` is a core of its closure.
+
+Note that we don't require that `f` is closable, due to the definition of the closure. -/
+lemma closure_has_core (f : E →ₗ.[R] F) : f.closure.has_core f.domain :=
+begin
+  refine ⟨f.le_closure.1, _⟩,
+  congr,
+  ext,
+  { simp only [dom_restrict_domain, submodule.mem_inf, and_iff_left_iff_imp],
+    intro hx,
+    exact f.le_closure.1 hx },
+  intros x y hxy,
+  let z : f.closure.domain := ⟨y.1, f.le_closure.1 y.2⟩,
+  have hyz : (y : E) = z := by simp,
+  rw f.le_closure.2 hyz,
+  exact dom_restrict_apply (hxy.trans hyz),
+end
+
+end linear_pmap
diff --git a/src/topology/algebra/module/locally_convex.lean b/src/topology/algebra/module/locally_convex.lean
index 5c4d97312a853..4536bd26514be 100644
--- a/src/topology/algebra/module/locally_convex.lean
+++ b/src/topology/algebra/module/locally_convex.lean
@@ -7,6 +7,9 @@ import analysis.convex.topology
 /-!
 # Locally convex topological modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A `locally_convex_space` is a topological semimodule over an ordered semiring in which any point
 admits a neighborhood basis made of convex sets, or equivalently, in which convex neighborhoods of
 a point form a neighborhood basis at that point.
@@ -24,13 +27,12 @@ In a module, this is equivalent to `0` satisfying such properties.
 
 - define a structure `locally_convex_filter_basis`, extending `module_filter_basis`, for filter
   bases generating a locally convex topology
-- show that any locally convex topology is generated by a family of seminorms
 
 -/
 
-open topological_space filter
+open topological_space filter set
 
-open_locale topological_space
+open_locale topology pointwise
 
 section semimodule
 
@@ -47,8 +49,8 @@ lemma locally_convex_space_iff :
   ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id :=
 ⟨@locally_convex_space.convex_basis _ _ _ _ _ _, locally_convex_space.mk⟩
 
-lemma locally_convex_space.of_bases {ι : Type*} (b : E → ι → set E) (p : ι → Prop)
-  (hbasis : ∀ x : E, (𝓝 x).has_basis p (b x)) (hconvex : ∀ x i, p i → convex 𝕜 (b x i)) :
+lemma locally_convex_space.of_bases {ι : Type*} (b : E → ι → set E) (p : E → ι → Prop)
+  (hbasis : ∀ x : E, (𝓝 x).has_basis (p x) (b x)) (hconvex : ∀ x i, p x i → convex 𝕜 (b x i)) :
   locally_convex_space 𝕜 E :=
 ⟨λ x, (hbasis x).to_has_basis
   (λ i hi, ⟨b x i, ⟨⟨(hbasis x).mem_of_mem hi, hconvex x i hi⟩, le_refl (b x i)⟩⟩)
@@ -74,7 +76,7 @@ lemma locally_convex_space.of_basis_zero {ι : Type*} (b : ι → set E) (p : ι
   (hbasis : (𝓝 0).has_basis p b) (hconvex : ∀ i, p i → convex 𝕜 (b i)) :
   locally_convex_space 𝕜 E :=
 begin
-  refine locally_convex_space.of_bases 𝕜 E (λ (x : E) (i : ι), ((+) x) '' b i) p (λ x, _)
+  refine locally_convex_space.of_bases 𝕜 E (λ (x : E) (i : ι), ((+) x) '' b i) (λ _, p) (λ x, _)
     (λ x i hi, (hconvex i hi).translate x),
   rw ← map_add_left_nhds_zero,
   exact hbasis.map _
@@ -91,4 +93,105 @@ lemma locally_convex_space_iff_exists_convex_subset_zero :
   ∀ U ∈ (𝓝 0 : filter E), ∃ S ∈ (𝓝 0 : filter E), convex 𝕜 S ∧ S ⊆ U :=
 (locally_convex_space_iff_zero 𝕜 E).trans has_basis_self
 
+-- see Note [lower instance priority]
+@[priority 100] instance locally_convex_space.to_locally_connected_space [module ℝ E]
+  [has_continuous_smul ℝ E] [locally_convex_space ℝ E] :
+  locally_connected_space E :=
+locally_connected_space_of_connected_bases _ _
+  (λ x, @locally_convex_space.convex_basis ℝ _ _ _ _ _ _ x)
+  (λ x s hs, hs.2.is_preconnected)
+
 end module
+
+section linear_ordered_field
+
+variables (𝕜 E : Type*) [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E]
+  [topological_space E] [topological_add_group E] [has_continuous_const_smul 𝕜 E]
+
+lemma locally_convex_space.convex_open_basis_zero [locally_convex_space 𝕜 E] :
+  (𝓝 0 : filter E).has_basis (λ s, (0 : E) ∈ s ∧ is_open s ∧ convex 𝕜 s) id :=
+(locally_convex_space.convex_basis_zero 𝕜 E).to_has_basis
+  (λ s hs, ⟨interior s, ⟨mem_interior_iff_mem_nhds.mpr hs.1, is_open_interior,
+    hs.2.interior⟩, interior_subset⟩)
+  (λ s hs, ⟨s, ⟨hs.2.1.mem_nhds hs.1, hs.2.2⟩, subset_rfl⟩)
+
+variables {𝕜 E}
+
+/-- In a locally convex space, if `s`, `t` are disjoint convex sets, `s` is compact and `t` is
+closed, then we can find open disjoint convex sets containing them. -/
+lemma disjoint.exists_open_convexes [locally_convex_space 𝕜 E] {s t : set E} (disj : disjoint s t)
+  (hs₁ : convex 𝕜 s) (hs₂ : is_compact s) (ht₁ : convex 𝕜 t) (ht₂ : is_closed t) :
+  ∃ u v, is_open u ∧ is_open v ∧ convex 𝕜 u ∧ convex 𝕜 v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v :=
+begin
+  letI : uniform_space E := topological_add_group.to_uniform_space E,
+  haveI : uniform_add_group E := topological_add_comm_group_is_uniform,
+  have := (locally_convex_space.convex_open_basis_zero 𝕜 E).comap (λ x : E × E, x.2 - x.1),
+  rw ← uniformity_eq_comap_nhds_zero at this,
+  rcases disj.exists_uniform_thickening_of_basis this hs₂ ht₂
+    with ⟨V, ⟨hV0, hVopen, hVconvex⟩, hV⟩,
+  refine ⟨s + V, t + V, hVopen.add_left, hVopen.add_left, hs₁.add hVconvex, ht₁.add hVconvex,
+    subset_add_left _ hV0, subset_add_left _ hV0, _⟩,
+  simp_rw [←Union_add_left_image, image_add_left],
+  simp_rw [uniform_space.ball, ←preimage_comp, sub_eq_neg_add] at hV,
+  exact hV
+end
+
+end linear_ordered_field
+
+section lattice_ops
+
+variables {ι : Sort*} {𝕜 E F : Type*} [ordered_semiring 𝕜] [add_comm_monoid E]
+  [module 𝕜 E] [add_comm_monoid F] [module 𝕜 F]
+
+lemma locally_convex_space_Inf {ts : set (topological_space E)}
+  (h : ∀ t ∈ ts, @locally_convex_space 𝕜 E  _ _ _ t) :
+  @locally_convex_space 𝕜 E _ _ _ (Inf ts) :=
+begin
+  letI : topological_space E := Inf ts,
+  refine locally_convex_space.of_bases 𝕜 E
+    (λ x, λ If : set ts × (ts → set E), ⋂ i ∈ If.1, If.2 i)
+    (λ x, λ If : set ts × (ts → set E), If.1.finite ∧ ∀ i ∈ If.1,
+      ((If.2 i) ∈ @nhds _ ↑i x ∧ convex 𝕜 (If.2 i)))
+    (λ x, _) (λ x If hif, convex_Inter $ λ i, convex_Inter $ λ hi, (hif.2 i hi).2),
+  rw [nhds_Inf, ← infi_subtype''],
+  exact has_basis_infi' (λ i : ts, (@locally_convex_space_iff 𝕜 E _ _ _ ↑i).mp (h ↑i i.2) x),
+end
+
+lemma locally_convex_space_infi {ts' : ι → topological_space E}
+  (h' : ∀ i, @locally_convex_space 𝕜 E  _ _ _ (ts' i)) :
+  @locally_convex_space 𝕜 E _ _ _ (⨅ i, ts' i) :=
+begin
+  refine locally_convex_space_Inf _,
+  rwa forall_range_iff
+end
+
+lemma locally_convex_space_inf {t₁ t₂ : topological_space E}
+  (h₁ : @locally_convex_space 𝕜 E _ _ _ t₁) (h₂ : @locally_convex_space 𝕜 E _ _ _ t₂) :
+  @locally_convex_space 𝕜 E _ _ _ (t₁ ⊓ t₂) :=
+by {rw inf_eq_infi, refine locally_convex_space_infi (λ b, _), cases b; assumption}
+
+lemma locally_convex_space_induced {t : topological_space F} [locally_convex_space 𝕜 F]
+  (f : E →ₗ[𝕜] F) :
+  @locally_convex_space 𝕜 E _ _ _ (t.induced f) :=
+begin
+  letI : topological_space E := t.induced f,
+  refine locally_convex_space.of_bases 𝕜 E (λ x, preimage f)
+    (λ x, λ (s : set F), s ∈ 𝓝 (f x) ∧ convex 𝕜 s) (λ x, _)
+    (λ x s ⟨_, hs⟩, hs.linear_preimage f),
+  rw nhds_induced,
+  exact (locally_convex_space.convex_basis $ f x).comap f
+end
+
+instance {ι : Type*} {X : ι → Type*} [Π i, add_comm_monoid (X i)] [Π i, topological_space (X i)]
+  [Π i, module 𝕜 (X i)] [Π i, locally_convex_space 𝕜 (X i)] :
+  locally_convex_space 𝕜 (Π i, X i) :=
+locally_convex_space_infi (λ i, locally_convex_space_induced (linear_map.proj i))
+
+instance [topological_space E] [topological_space F] [locally_convex_space 𝕜 E]
+  [locally_convex_space 𝕜 F] :
+  locally_convex_space 𝕜 (E × F) :=
+locally_convex_space_inf
+  (locally_convex_space_induced (linear_map.fst _ _ _))
+  (locally_convex_space_induced (linear_map.snd _ _ _))
+
+end lattice_ops
diff --git a/src/topology/algebra/module/multilinear.lean b/src/topology/algebra/module/multilinear.lean
index de11e05b4035e..ef1fead7e6fc3 100644
--- a/src/topology/algebra/module/multilinear.lean
+++ b/src/topology/algebra/module/multilinear.lean
@@ -9,6 +9,9 @@ import linear_algebra.multilinear.basic
 /-!
 # Continuous multilinear maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define continuous multilinear maps as maps from `Π(i : ι), M₁ i` to `M₂` which are multilinear
 and continuous, by extending the space of multilinear maps with a continuity assumption.
 Here, `M₁ i` and `M₂` are modules over a ring `R`, and `ι` is an arbitrary type, and all these
@@ -36,14 +39,14 @@ open_locale big_operators
 
 universes u v w w₁ w₁' w₂ w₃ w₄
 variables {R : Type u} {ι : Type v} {n : ℕ} {M : fin n.succ → Type w} {M₁ : ι → Type w₁}
-  {M₁' : ι → Type w₁'} {M₂ : Type w₂} {M₃ : Type w₃} {M₄ : Type w₄} [decidable_eq ι]
+  {M₁' : ι → Type w₁'} {M₂ : Type w₂} {M₃ : Type w₃} {M₄ : Type w₄}
 
 /-- Continuous multilinear maps over the ring `R`, from `Πi, M₁ i` to `M₂` where `M₁ i` and `M₂`
 are modules over `R` with a topological structure. In applications, there will be compatibility
 conditions between the algebraic and the topological structures, but this is not needed for the
 definition. -/
 structure continuous_multilinear_map (R : Type u) {ι : Type v} (M₁ : ι → Type w₁) (M₂ : Type w₂)
-  [decidable_eq ι] [semiring R] [∀i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
+  [semiring R] [∀i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
   [∀i, module R (M₁ i)] [module R M₂] [∀i, topological_space (M₁ i)] [topological_space M₂]
   extends multilinear_map R M₁ M₂ :=
 (cont : continuous to_fun)
@@ -63,26 +66,42 @@ variables [semiring R]
   [topological_space M₂] [topological_space M₃] [topological_space M₄]
 (f f' : continuous_multilinear_map R M₁ M₂)
 
+theorem to_multilinear_map_injective :
+  function.injective (continuous_multilinear_map.to_multilinear_map :
+    continuous_multilinear_map R M₁ M₂ → multilinear_map R M₁ M₂)
+| ⟨f, hf⟩ ⟨g, hg⟩ rfl := rfl
+
+instance continuous_map_class :
+  continuous_map_class (continuous_multilinear_map R M₁ M₂) (Π i, M₁ i) M₂ :=
+{ coe := λ f, f.to_fun,
+  coe_injective' := λ f g h, to_multilinear_map_injective $ multilinear_map.coe_injective h,
+  map_continuous := continuous_multilinear_map.cont }
+
 instance : has_coe_to_fun (continuous_multilinear_map R M₁ M₂) (λ _, (Π i, M₁ i) → M₂) :=
-⟨λ f, f.to_fun⟩
+⟨λ f, f⟩
+
+/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
+  because it is a composition of multiple projections. -/
+def simps.apply (L₁ : continuous_multilinear_map R M₁ M₂) (v : Π i, M₁ i) : M₂ := L₁ v
+
+initialize_simps_projections continuous_multilinear_map
+  (-to_multilinear_map, to_multilinear_map_to_fun → apply)
 
 @[continuity] lemma coe_continuous : continuous (f : (Π i, M₁ i) → M₂) := f.cont
 
 @[simp] lemma coe_coe : (f.to_multilinear_map : (Π i, M₁ i) → M₂) = f := rfl
 
-theorem to_multilinear_map_inj :
-  function.injective (continuous_multilinear_map.to_multilinear_map :
-    continuous_multilinear_map R M₁ M₂ → multilinear_map R M₁ M₂)
-| ⟨f, hf⟩ ⟨g, hg⟩ rfl := rfl
-
 @[ext] theorem ext {f f' : continuous_multilinear_map R M₁ M₂} (H : ∀ x, f x = f' x) : f = f' :=
-to_multilinear_map_inj $ multilinear_map.ext H
+fun_like.ext _ _ H
+
+theorem ext_iff {f f' : continuous_multilinear_map R M₁ M₂} : f = f' ↔ ∀ x, f x = f' x :=
+by rw [← to_multilinear_map_injective.eq_iff, multilinear_map.ext_iff]; refl
 
-@[simp] lemma map_add (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
+@[simp] lemma map_add [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
   f (update m i (x + y)) = f (update m i x) + f (update m i y) :=
 f.map_add' m i x y
 
-@[simp] lemma map_smul (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i) :
+@[simp] lemma map_smul [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (c : R) (x : M₁ i) :
   f (update m i (c • x)) = c • f (update m i x) :=
 f.map_smul' m i c x
 
@@ -102,14 +121,14 @@ instance : inhabited (continuous_multilinear_map R M₁ M₂) := ⟨0⟩
 @[simp] lemma to_multilinear_map_zero :
   (0 : continuous_multilinear_map R M₁ M₂).to_multilinear_map = 0 :=
 rfl
-section has_scalar
+section has_smul
 
 variables {R' R'' A : Type*} [monoid R'] [monoid R''] [semiring A]
   [Π i, module A (M₁ i)] [module A M₂]
   [distrib_mul_action R' M₂] [has_continuous_const_smul R' M₂] [smul_comm_class A R' M₂]
   [distrib_mul_action R'' M₂] [has_continuous_const_smul R'' M₂] [smul_comm_class A R'' M₂]
 
-instance : has_scalar R' (continuous_multilinear_map A M₁ M₂) :=
+instance : has_smul R' (continuous_multilinear_map A M₁ M₂) :=
 ⟨λ c f, { cont := f.cont.const_smul c, .. c • f.to_multilinear_map }⟩
 
 @[simp] lemma smul_apply (f : continuous_multilinear_map A M₁ M₂) (c : R') (m : Πi, M₁ i) :
@@ -123,7 +142,7 @@ instance [smul_comm_class R' R'' M₂] :
   smul_comm_class R' R'' (continuous_multilinear_map A M₁ M₂) :=
 ⟨λ c₁ c₂ f, ext $ λ x, smul_comm _ _ _⟩
 
-instance [has_scalar R' R''] [is_scalar_tower R' R'' M₂] :
+instance [has_smul R' R''] [is_scalar_tower R' R'' M₂] :
   is_scalar_tower R' R'' (continuous_multilinear_map A M₁ M₂) :=
 ⟨λ c₁ c₂ f, ext $ λ x, smul_assoc _ _ _⟩
 
@@ -132,9 +151,9 @@ instance [distrib_mul_action R'ᵐᵒᵖ M₂] [is_central_scalar R' M₂] :
 ⟨λ c₁ f, ext $ λ x, op_smul_eq_smul _ _⟩
 
 instance : mul_action R' (continuous_multilinear_map A M₁ M₂) :=
-function.injective.mul_action to_multilinear_map to_multilinear_map_inj (λ _ _, rfl)
+function.injective.mul_action to_multilinear_map to_multilinear_map_injective (λ _ _, rfl)
 
-end has_scalar
+end has_smul
 
 section has_continuous_add
 variable [has_continuous_add M₂]
@@ -149,7 +168,7 @@ instance : has_add (continuous_multilinear_map R M₁ M₂) :=
 rfl
 
 instance add_comm_monoid : add_comm_monoid (continuous_multilinear_map R M₁ M₂) :=
-to_multilinear_map_inj.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)
+to_multilinear_map_injective.add_comm_monoid _ rfl (λ _ _, rfl) (λ _ _, rfl)
 
 /-- Evaluation of a `continuous_multilinear_map` at a vector as an `add_monoid_hom`. -/
 def apply_add_hom (m : Π i, M₁ i) : continuous_multilinear_map R M₁ M₂ →+ M₂ :=
@@ -164,7 +183,7 @@ end has_continuous_add
 /-- If `f` is a continuous multilinear map, then `f.to_continuous_linear_map m i` is the continuous
 linear map obtained by fixing all coordinates but `i` equal to those of `m`, and varying the
 `i`-th coordinate. -/
-def to_continuous_linear_map (m : Πi, M₁ i) (i : ι) : M₁ i →L[R] M₂ :=
+def to_continuous_linear_map [decidable_eq ι] (m : Πi, M₁ i) (i : ι) : M₁ i →L[R] M₂ :=
 { cont := f.cont.comp (continuous_const.update i continuous_id),
   .. f.to_multilinear_map.to_linear_map m i }
 
@@ -198,6 +217,32 @@ lemma pi_apply {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)]
   pi f m j = f j m :=
 rfl
 
+/-- Restrict the codomain of a continuous multilinear map to a submodule. -/
+@[simps to_multilinear_map apply_coe]
+def cod_restrict (f : continuous_multilinear_map R M₁ M₂) (p : submodule R M₂) (h : ∀ v, f v ∈ p) :
+  continuous_multilinear_map R M₁ p :=
+⟨f.1.cod_restrict p h, f.cont.subtype_mk _⟩
+
+section
+variables (R M₂)
+
+/-- The evaluation map from `ι → M₂` to `M₂` is multilinear at a given `i` when `ι` is subsingleton.
+-/
+@[simps to_multilinear_map apply]
+def of_subsingleton [subsingleton ι] (i' : ι) : continuous_multilinear_map R (λ _ : ι, M₂) M₂ :=
+{ to_multilinear_map := multilinear_map.of_subsingleton R _ i',
+  cont := continuous_apply _ }
+
+variables (M₁) {M₂}
+
+/-- The constant map is multilinear when `ι` is empty. -/
+@[simps to_multilinear_map apply]
+def const_of_is_empty [is_empty ι] (m : M₂) : continuous_multilinear_map R M₁ M₂ :=
+{ to_multilinear_map := multilinear_map.const_of_is_empty R _ m,
+  cont := continuous_const }
+
+end
+
 /-- If `g` is continuous multilinear and `f` is a collection of continuous linear maps,
 then `g (f₁ m₁, ..., fₙ mₙ)` is again a continuous multilinear map, that we call
 `g.comp_continuous_linear_map f`. -/
@@ -226,7 +271,6 @@ def _root_.continuous_linear_map.comp_continuous_multilinear_map
   (g : M₂ → M₃) ∘ (f : (Πi, M₁ i) → M₂) :=
 by { ext m, refl }
 
-
 /-- `continuous_multilinear_map.pi` as an `equiv`. -/
 @[simps]
 def pi_equiv {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)]
@@ -238,6 +282,25 @@ def pi_equiv {ι' : Type*} {M' : ι' → Type*} [Π i, add_comm_monoid (M' i)]
   left_inv := λ f, by { ext, refl },
   right_inv := λ f, by { ext, refl } }
 
+/-- An equivalence of the index set defines an equivalence between the spaces of continuous
+multilinear maps. This is the forward map of this equivalence. -/
+@[simps to_multilinear_map apply]
+def dom_dom_congr {ι' : Type*} (e : ι ≃ ι') (f : continuous_multilinear_map R (λ _ : ι, M₂) M₃) :
+  continuous_multilinear_map R (λ _ : ι', M₂) M₃ :=
+{ to_multilinear_map := f.dom_dom_congr e,
+  cont := f.cont.comp $ continuous_pi $ λ _, continuous_apply _ }
+
+/-- An equivalence of the index set defines an equivalence between the spaces of continuous
+multilinear maps. In case of normed spaces, this is a linear isometric equivalence, see
+`continuous.multilinear_map.dom_dom_congrₗᵢ`. -/
+@[simps]
+def dom_dom_congr_equiv {ι' : Type*} (e : ι ≃ ι') :
+  continuous_multilinear_map R (λ _ : ι, M₂) M₃ ≃ continuous_multilinear_map R (λ _ : ι', M₂) M₃ :=
+{ to_fun := dom_dom_congr e,
+  inv_fun := dom_dom_congr e.symm,
+  left_inv := λ _, ext $ λ _, by simp,
+  right_inv := λ _, ext $ λ _, by simp }
+
 /-- In the specific case of continuous multilinear maps on spaces indexed by `fin (n+1)`, where one
 can build an element of `Π(i : fin (n+1)), M i` using `cons`, one can express directly the
 additivity of a multilinear map along the first variable. -/
@@ -253,13 +316,13 @@ lemma cons_smul
   f (cons (c • x) m) = c • f (cons x m) :=
 f.to_multilinear_map.cons_smul m c x
 
-lemma map_piecewise_add (m m' : Πi, M₁ i) (t : finset ι) :
+lemma map_piecewise_add [decidable_eq ι] (m m' : Πi, M₁ i) (t : finset ι) :
   f (t.piecewise (m + m') m') = ∑ s in t.powerset, f (s.piecewise m m') :=
 f.to_multilinear_map.map_piecewise_add _ _ _
 
 /-- Additivity of a continuous multilinear map along all coordinates at the same time,
 writing `f (m + m')` as the sum  of `f (s.piecewise m m')` over all sets `s`. -/
-lemma map_add_univ [fintype ι] (m m' : Πi, M₁ i) :
+lemma map_add_univ [decidable_eq ι] [fintype ι] (m m' : Πi, M₁ i) :
   f (m + m') = ∑ s : finset ι, f (s.piecewise m m') :=
 f.to_multilinear_map.map_add_univ _ _
 
@@ -274,14 +337,14 @@ sum of `f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions wit
 `r n ∈ Aₙ`. This follows from multilinearity by expanding successively with respect to each
 coordinate. -/
 
-lemma map_sum_finset  :
+lemma map_sum_finset [decidable_eq ι] :
   f (λ i, ∑ j in A i, g i j) = ∑ r in pi_finset A, f (λ i, g i (r i)) :=
 f.to_multilinear_map.map_sum_finset _ _
 
 /-- If `f` is continuous multilinear, then `f (Σ_{j₁} g₁ j₁, ..., Σ_{jₙ} gₙ jₙ)` is the sum of
 `f (g₁ (r 1), ..., gₙ (r n))` where `r` ranges over all functions `r`. This follows from
 multilinearity by expanding successively with respect to each coordinate. -/
-lemma map_sum [∀ i, fintype (α i)] :
+lemma map_sum [decidable_eq ι] [∀ i, fintype (α i)] :
   f (λ i, ∑ j, g i j) = ∑ r : Π i, α i, f (λ i, g i (r i)) :=
 f.to_multilinear_map.map_sum _
 
@@ -289,7 +352,7 @@ end apply_sum
 
 section restrict_scalar
 
-variables (R) {A : Type*} [semiring A] [has_scalar R A] [Π (i : ι), module A (M₁ i)]
+variables (R) {A : Type*} [semiring A] [has_smul R A] [Π (i : ι), module A (M₁ i)]
   [module A M₂] [∀ i, is_scalar_tower R A (M₁ i)] [is_scalar_tower R A M₂]
 
 /-- Reinterpret an `A`-multilinear map as an `R`-multilinear map, if `A` is an algebra over `R`
@@ -312,7 +375,7 @@ variables [ring R] [∀i, add_comm_group (M₁ i)] [add_comm_group M₂]
 [∀i, module R (M₁ i)] [module R M₂] [∀i, topological_space (M₁ i)] [topological_space M₂]
 (f f' : continuous_multilinear_map R M₁ M₂)
 
-@[simp] lemma map_sub (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
+@[simp] lemma map_sub [decidable_eq ι] (m : Πi, M₁ i) (i : ι) (x y : M₁ i) :
   f (update m i (x - y)) = f (update m i x) - f (update m i y) :=
 f.to_multilinear_map.map_sub _ _ _ _
 
@@ -330,7 +393,7 @@ instance : has_sub (continuous_multilinear_map R M₁ M₂) :=
 @[simp] lemma sub_apply (m : Πi, M₁ i) : (f - f') m = f m - f' m := rfl
 
 instance : add_comm_group (continuous_multilinear_map R M₁ M₂) :=
-to_multilinear_map_inj.add_comm_group _
+to_multilinear_map_injective.add_comm_group _
   rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)
 
 end topological_add_group
@@ -345,7 +408,7 @@ variables [comm_semiring R]
 [∀i, topological_space (M₁ i)] [topological_space M₂]
 (f : continuous_multilinear_map R M₁ M₂)
 
-lemma map_piecewise_smul (c : ι → R) (m : Πi, M₁ i) (s : finset ι) :
+lemma map_piecewise_smul [decidable_eq ι] (c : ι → R) (m : Πi, M₁ i) (s : finset ι) :
   f (s.piecewise (λ i, c i • m i) m) = (∏ i in s, c i) • f m :=
 f.to_multilinear_map.map_piecewise_smul _ _ _
 
@@ -369,7 +432,7 @@ variables {R' R'' A : Type*} [monoid R'] [monoid R''] [semiring A]
 instance [has_continuous_add M₂] : distrib_mul_action R' (continuous_multilinear_map A M₁ M₂) :=
 function.injective.distrib_mul_action
   ⟨to_multilinear_map, to_multilinear_map_zero, to_multilinear_map_add⟩
-  to_multilinear_map_inj (λ _ _, rfl)
+  to_multilinear_map_injective (λ _ _, rfl)
 
 end distrib_mul_action
 
@@ -385,7 +448,7 @@ variables {R' A : Type*} [semiring R'] [semiring A]
 pointwise addition and scalar multiplication. -/
 instance : module R' (continuous_multilinear_map A M₁ M₂) :=
 function.injective.module _ ⟨to_multilinear_map, to_multilinear_map_zero, to_multilinear_map_add⟩
-  to_multilinear_map_inj (λ _ _, rfl)
+  to_multilinear_map_injective (λ _ _, rfl)
 
 /-- Linear map version of the map `to_multilinear_map` associating to a continuous multilinear map
 the corresponding multilinear map. -/
@@ -453,4 +516,18 @@ rfl
 
 end algebra
 
+section smul_right
+
+variables [comm_semiring R] [Π i, add_comm_monoid (M₁ i)] [add_comm_monoid M₂]
+  [Π i, module R (M₁ i)] [module R M₂] [topological_space R] [Π i, topological_space (M₁ i)]
+  [topological_space M₂] [has_continuous_smul R M₂] (f : continuous_multilinear_map R M₁ R) (z : M₂)
+
+/-- Given a continuous `R`-multilinear map `f` taking values in `R`, `f.smul_right z` is the
+continuous multilinear map sending `m` to `f m • z`. -/
+@[simps to_multilinear_map apply] def smul_right : continuous_multilinear_map R M₁ M₂ :=
+{ to_multilinear_map := f.to_multilinear_map.smul_right z,
+  cont := f.cont.smul continuous_const }
+
+end smul_right
+
 end continuous_multilinear_map
diff --git a/src/topology/algebra/module/simple.lean b/src/topology/algebra/module/simple.lean
new file mode 100644
index 0000000000000..ad8dcaef9771e
--- /dev/null
+++ b/src/topology/algebra/module/simple.lean
@@ -0,0 +1,38 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+import ring_theory.simple_module
+import topology.algebra.module.basic
+
+/-!
+# The kernel of a linear function is closed or dense
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove (`linear_map.is_closed_or_dense_ker`) that the kernel of a linear function `f
+: M →ₗ[R] N` is either closed or dense in `M` provided that `N` is a simple module over `R`. This
+applies, e.g., to the case when `R = N` is a division ring.
+-/
+
+universes u v w
+
+variables {R : Type u} {M : Type v} {N : Type w}
+  [ring R] [topological_space R]
+  [topological_space M] [add_comm_group M] [add_comm_group N]
+  [module R M] [has_continuous_smul R M] [module R N]
+  [has_continuous_add M] [is_simple_module R N]
+
+/-- The kernel of a linear map taking values in a simple module over the base ring is closed or
+dense. Applies, e.g., to the case when `R = N` is a division ring. -/
+lemma linear_map.is_closed_or_dense_ker (l : M →ₗ[R] N) :
+  is_closed (l.ker : set M) ∨ dense (l.ker : set M) :=
+begin
+  rcases l.surjective_or_eq_zero with (hl|rfl),
+  { exact l.ker.is_closed_or_dense_of_is_coatom (linear_map.is_coatom_ker_of_surjective hl) },
+  { rw linear_map.ker_zero,
+    left,
+    exact is_closed_univ },
+end
diff --git a/src/topology/algebra/module/star.lean b/src/topology/algebra/module/star.lean
new file mode 100644
index 0000000000000..859462c2b60ab
--- /dev/null
+++ b/src/topology/algebra/module/star.lean
@@ -0,0 +1,88 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser, Frédéric Dupuis
+-/
+import algebra.star.module
+import topology.algebra.module.basic
+import topology.algebra.star
+
+/-!
+# The star operation, bundled as a continuous star-linear equiv
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+/-- If `A` is a topological module over a commutative `R` with compatible actions,
+then `star` is a continuous semilinear equivalence. -/
+@[simps]
+def starL (R : Type*) {A : Type*}
+  [comm_semiring R] [star_ring R] [add_comm_monoid A] [star_add_monoid A] [module R A]
+  [star_module R A] [topological_space A] [has_continuous_star A] :
+    A ≃L⋆[R] A :=
+{ to_linear_equiv := star_linear_equiv R,
+  continuous_to_fun := continuous_star,
+  continuous_inv_fun := continuous_star }
+
+-- TODO: this could be replaced with something like `(starL R).restrict_scalarsₛₗ h` if we
+-- implemented the idea in
+-- https://leanprover.zulipchat.com/#narrow/stream/217875-Is-there-code-for-X.3F/topic/Star-semilinear.20maps.20are.20semilinear.20when.20star.20is.20trivial/near/359557835
+/-- If `A` is a topological module over a commutative `R` with trivial star and compatible actions,
+then `star` is a continuous linear equivalence. -/
+@[simps]
+def starL' (R : Type*) {A : Type*}
+  [comm_semiring R] [star_ring R] [has_trivial_star R] [add_comm_monoid A] [star_add_monoid A]
+  [module R A] [star_module R A] [topological_space A] [has_continuous_star A] :
+    A ≃L[R] A :=
+(starL R : A ≃L⋆[R] A).trans
+  ({ map_smul' := λ r a, by simp [star_ring_end_apply],
+    continuous_to_fun := continuous_id,
+    continuous_inv_fun := continuous_id,
+    ..add_equiv.refl A, } : A ≃L⋆[R] A)
+
+variables (R : Type*) (A : Type*)
+  [semiring R] [star_semigroup R] [has_trivial_star R]
+  [add_comm_group A] [module R A] [star_add_monoid A] [star_module R A]
+  [invertible (2 : R)]
+  [topological_space A]
+
+lemma continuous_self_adjoint_part [has_continuous_add A] [has_continuous_star A]
+  [has_continuous_const_smul R A] :
+  continuous (@self_adjoint_part R A _ _ _ _ _ _ _ _) :=
+((continuous_const_smul _).comp $ continuous_id.add continuous_star).subtype_mk _
+
+lemma continuous_skew_adjoint_part [has_continuous_sub A] [has_continuous_star A]
+  [has_continuous_const_smul R A] :
+  continuous (@skew_adjoint_part R A _ _ _ _ _ _ _ _) :=
+((continuous_const_smul _).comp $ continuous_id.sub continuous_star).subtype_mk _
+
+lemma continuous_decompose_prod_adjoint [topological_add_group A] [has_continuous_star A]
+  [has_continuous_const_smul R A] :
+  continuous (@star_module.decompose_prod_adjoint R A _ _ _ _ _ _ _ _) :=
+(continuous_self_adjoint_part R A).prod_mk (continuous_skew_adjoint_part R A)
+
+lemma continuous_decompose_prod_adjoint_symm [topological_add_group A] :
+  continuous (@star_module.decompose_prod_adjoint R A _ _ _ _ _ _ _ _).symm :=
+(continuous_subtype_coe.comp continuous_fst).add (continuous_subtype_coe.comp continuous_snd)
+
+/-- The self-adjoint part of an element of a star module, as a continuous linear map. -/
+@[simps] def self_adjoint_partL [has_continuous_add A] [has_continuous_star A]
+  [has_continuous_const_smul R A] : A →L[R] self_adjoint A :=
+{ to_linear_map := self_adjoint_part R,
+  cont := continuous_self_adjoint_part _ _ }
+
+/-- The skew-adjoint part of an element of a star module, as a continuous linear map. -/
+@[simps] def skew_adjoint_partL [has_continuous_sub A] [has_continuous_star A]
+  [has_continuous_const_smul R A] : A →L[R] skew_adjoint A :=
+{ to_linear_map := skew_adjoint_part R,
+  cont := continuous_skew_adjoint_part _ _ }
+
+/-- The decomposition of elements of a star module into their self- and skew-adjoint parts,
+as a continuous linear equivalence. -/
+@[simps] def star_module.decompose_prod_adjointL [topological_add_group A] [has_continuous_star A]
+  [has_continuous_const_smul R A] :
+  A ≃L[R] self_adjoint A × skew_adjoint A :=
+{ to_linear_equiv := star_module.decompose_prod_adjoint R A,
+  continuous_to_fun := continuous_decompose_prod_adjoint _ _,
+  continuous_inv_fun := continuous_decompose_prod_adjoint_symm _ _ }
diff --git a/src/topology/algebra/module/strong_topology.lean b/src/topology/algebra/module/strong_topology.lean
new file mode 100644
index 0000000000000..78e2334d92150
--- /dev/null
+++ b/src/topology/algebra/module/strong_topology.lean
@@ -0,0 +1,338 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+import topology.algebra.uniform_convergence
+
+/-!
+# Strong topologies on the space of continuous linear maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we define the strong topologies on `E →L[𝕜] F` associated with a family
+`𝔖 : set (set E)` to be the topology of uniform convergence on the elements of `𝔖` (also called
+the topology of `𝔖`-convergence).
+
+The lemma `uniform_on_fun.has_continuous_smul_of_image_bounded` tells us that this is a
+vector space topology if the continuous linear image of any element of `𝔖` is bounded (in the sense
+of `bornology.is_vonN_bounded`).
+
+We then declare an instance for the case where `𝔖` is exactly the set of all bounded subsets of
+`E`, giving us the so-called "topology of uniform convergence on bounded sets" (or "topology of
+bounded convergence"), which coincides with the operator norm topology in the case of
+`normed_space`s.
+
+Other useful examples include the weak-* topology (when `𝔖` is the set of finite sets or the set
+of singletons) and the topology of compact convergence (when `𝔖` is the set of relatively compact
+sets).
+
+## Main definitions
+
+* `continuous_linear_map.strong_topology` is the topology mentioned above for an arbitrary `𝔖`.
+* `continuous_linear_map.topological_space` is the topology of bounded convergence. This is
+  declared as an instance.
+
+## Main statements
+
+* `continuous_linear_map.strong_topology.topological_add_group` and
+  `continuous_linear_map.strong_topology.has_continuous_smul` show that the strong topology
+  makes `E →L[𝕜] F` a topological vector space, with the assumptions on `𝔖` mentioned above.
+* `continuous_linear_map.topological_add_group` and
+  `continuous_linear_map.has_continuous_smul` register these facts as instances for the special
+  case of bounded convergence.
+
+## References
+
+* [N. Bourbaki, *Topological Vector Spaces*][bourbaki1987]
+
+## TODO
+
+* add a type alias for continuous linear maps with the topology of `𝔖`-convergence?
+
+## Tags
+
+uniform convergence, bounded convergence
+-/
+
+open_locale topology uniform_convergence
+
+namespace continuous_linear_map
+
+section general
+
+variables {𝕜₁ 𝕜₂ : Type*} [normed_field 𝕜₁] [normed_field 𝕜₂] (σ : 𝕜₁ →+* 𝕜₂)
+  {E E' F F' : Type*} [add_comm_group E] [module 𝕜₁ E] [add_comm_group E'] [module ℝ E']
+  [add_comm_group F] [module 𝕜₂ F] [add_comm_group F'] [module ℝ F']
+  [topological_space E] [topological_space E'] (F)
+
+/-- Given `E` and `F` two topological vector spaces and `𝔖 : set (set E)`, then
+`strong_topology σ F 𝔖` is the "topology of uniform convergence on the elements of `𝔖`" on
+`E →L[𝕜] F`.
+
+If the continuous linear image of any element of `𝔖` is bounded, this makes `E →L[𝕜] F` a
+topological vector space. -/
+def strong_topology [topological_space F] [topological_add_group F]
+  (𝔖 : set (set E)) : topological_space (E →SL[σ] F) :=
+(@uniform_on_fun.topological_space E F
+  (topological_add_group.to_uniform_space F) 𝔖).induced coe_fn
+
+/-- The uniform structure associated with `continuous_linear_map.strong_topology`. We make sure
+that this has nice definitional properties. -/
+def strong_uniformity [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) : uniform_space (E →SL[σ] F) :=
+@uniform_space.replace_topology _ (strong_topology σ F 𝔖)
+  ((uniform_on_fun.uniform_space E F 𝔖).comap coe_fn)
+  (by rw [strong_topology, uniform_add_group.to_uniform_space_eq]; refl)
+
+@[simp] lemma strong_uniformity_topology_eq [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) :
+  (strong_uniformity σ F 𝔖).to_topological_space = strong_topology σ F 𝔖 :=
+rfl
+
+lemma strong_uniformity.uniform_embedding_coe_fn [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) :
+  @uniform_embedding (E →SL[σ] F) (E →ᵤ[𝔖] F) (strong_uniformity σ F 𝔖)
+  (uniform_on_fun.uniform_space E F 𝔖) coe_fn :=
+begin
+  letI : uniform_space (E →SL[σ] F) := strong_uniformity σ F 𝔖,
+  exact ⟨⟨rfl⟩, fun_like.coe_injective⟩
+end
+
+lemma strong_topology.embedding_coe_fn [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) :
+  @embedding (E →SL[σ] F) (E →ᵤ[𝔖] F) (strong_topology σ F 𝔖)
+  (uniform_on_fun.topological_space E F 𝔖)
+  (uniform_on_fun.of_fun 𝔖 ∘ coe_fn) :=
+@uniform_embedding.embedding _ _ (_root_.id _) _ _
+  (strong_uniformity.uniform_embedding_coe_fn _ _ _)
+
+lemma strong_uniformity.uniform_add_group [uniform_space F] [uniform_add_group F]
+  (𝔖 : set (set E)) : @uniform_add_group (E →SL[σ] F) (strong_uniformity σ F 𝔖) _ :=
+begin
+  letI : uniform_space (E →SL[σ] F) := strong_uniformity σ F 𝔖,
+  rw [strong_uniformity, uniform_space.replace_topology_eq],
+  let φ : (E →SL[σ] F) →+ E →ᵤ[𝔖] F := ⟨(coe_fn : (E →SL[σ] F) → E →ᵤ F), rfl, λ _ _, rfl⟩,
+  exact uniform_add_group_comap φ
+end
+
+lemma strong_topology.topological_add_group [topological_space F] [topological_add_group F]
+  (𝔖 : set (set E)) : @topological_add_group (E →SL[σ] F) (strong_topology σ F 𝔖) _ :=
+begin
+  letI : uniform_space F := topological_add_group.to_uniform_space F,
+  haveI : uniform_add_group F := topological_add_comm_group_is_uniform,
+  letI : uniform_space (E →SL[σ] F) := strong_uniformity σ F 𝔖,
+  haveI : uniform_add_group (E →SL[σ] F) := strong_uniformity.uniform_add_group σ F 𝔖,
+  apply_instance
+end
+
+lemma strong_topology.t2_space [topological_space F] [topological_add_group F] [t2_space F]
+  (𝔖 : set (set E)) (h𝔖 : ⋃₀ 𝔖 = set.univ) : @t2_space (E →SL[σ] F) (strong_topology σ F 𝔖) :=
+begin
+  letI : uniform_space F := topological_add_group.to_uniform_space F,
+  haveI : uniform_add_group F := topological_add_comm_group_is_uniform,
+  letI : topological_space (E →SL[σ] F) := strong_topology σ F 𝔖,
+  haveI : t2_space (E →ᵤ[𝔖] F) := uniform_on_fun.t2_space_of_covering h𝔖,
+  exact (strong_topology.embedding_coe_fn σ F 𝔖).t2_space
+end
+
+lemma strong_topology.has_continuous_smul [ring_hom_surjective σ] [ring_hom_isometric σ]
+  [topological_space F] [topological_add_group F] [has_continuous_smul 𝕜₂ F] (𝔖 : set (set E))
+  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) (h𝔖₃ : ∀ S ∈ 𝔖, bornology.is_vonN_bounded 𝕜₁ S) :
+  @has_continuous_smul 𝕜₂ (E →SL[σ] F) _ _ (strong_topology σ F 𝔖) :=
+begin
+  letI : uniform_space F := topological_add_group.to_uniform_space F,
+  haveI : uniform_add_group F := topological_add_comm_group_is_uniform,
+  letI : topological_space (E →SL[σ] F) := strong_topology σ F 𝔖,
+  let φ : (E →SL[σ] F) →ₗ[𝕜₂] E →ᵤ[𝔖] F :=
+    ⟨(coe_fn : (E →SL[σ] F) → E → F), λ _ _, rfl, λ _ _, rfl⟩,
+  exact uniform_on_fun.has_continuous_smul_induced_of_image_bounded 𝕜₂ E F (E →SL[σ] F)
+    h𝔖₁ h𝔖₂ φ ⟨rfl⟩ (λ u s hs, (h𝔖₃ s hs).image u)
+end
+
+lemma strong_topology.has_basis_nhds_zero_of_basis [topological_space F] [topological_add_group F]
+  {ι : Type*} (𝔖 : set (set E)) (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) {p : ι → Prop}
+  {b : ι → set F} (h : (𝓝 0 : filter F).has_basis p b) :
+  (@nhds (E →SL[σ] F) (strong_topology σ F 𝔖) 0).has_basis
+    (λ Si : set E × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
+    (λ Si, {f : E →SL[σ] F | ∀ x ∈ Si.1, f x ∈ b Si.2}) :=
+begin
+  letI : uniform_space F := topological_add_group.to_uniform_space F,
+  haveI : uniform_add_group F := topological_add_comm_group_is_uniform,
+  rw nhds_induced,
+  exact (uniform_on_fun.has_basis_nhds_zero_of_basis 𝔖 h𝔖₁ h𝔖₂ h).comap coe_fn
+end
+
+lemma strong_topology.has_basis_nhds_zero [topological_space F] [topological_add_group F]
+  (𝔖 : set (set E)) (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) :
+  (@nhds (E →SL[σ] F) (strong_topology σ F 𝔖) 0).has_basis
+    (λ SV : set E × set F, SV.1 ∈ 𝔖 ∧ SV.2 ∈ (𝓝 0 : filter F))
+    (λ SV, {f : E →SL[σ] F | ∀ x ∈ SV.1, f x ∈ SV.2}) :=
+strong_topology.has_basis_nhds_zero_of_basis σ F 𝔖 h𝔖₁ h𝔖₂ (𝓝 0).basis_sets
+
+end general
+
+section bounded_sets
+
+variables {𝕜₁ 𝕜₂ 𝕜₃ : Type*} [normed_field 𝕜₁] [normed_field 𝕜₂] [normed_field 𝕜₃]
+  {σ : 𝕜₁ →+* 𝕜₂} {τ : 𝕜₂ →+* 𝕜₃} {ρ : 𝕜₁ →+* 𝕜₃} [ring_hom_comp_triple σ τ ρ]
+  {E E' F F' G : Type*}
+  [add_comm_group E] [module 𝕜₁ E] [add_comm_group E'] [module ℝ E']
+  [add_comm_group F] [module 𝕜₂ F] [add_comm_group F'] [module ℝ F']
+  [add_comm_group G] [module 𝕜₃ G]
+  [topological_space E]
+
+/-- The topology of bounded convergence on `E →L[𝕜] F`. This coincides with the topology induced by
+the operator norm when `E` and `F` are normed spaces. -/
+instance [topological_space F] [topological_add_group F] : topological_space (E →SL[σ] F) :=
+strong_topology σ F {S | bornology.is_vonN_bounded 𝕜₁ S}
+
+instance [topological_space F] [topological_add_group F] : topological_add_group (E →SL[σ] F) :=
+strong_topology.topological_add_group σ F _
+
+instance [ring_hom_surjective σ] [ring_hom_isometric σ] [topological_space F]
+  [topological_add_group F] [has_continuous_smul 𝕜₂ F] :
+  has_continuous_smul 𝕜₂ (E →SL[σ] F) :=
+strong_topology.has_continuous_smul σ F {S | bornology.is_vonN_bounded 𝕜₁ S}
+  ⟨∅, bornology.is_vonN_bounded_empty 𝕜₁ E⟩
+  (directed_on_of_sup_mem $ λ _ _, bornology.is_vonN_bounded.union)
+  (λ s hs, hs)
+
+instance [uniform_space F] [uniform_add_group F] : uniform_space (E →SL[σ] F) :=
+strong_uniformity σ F {S | bornology.is_vonN_bounded 𝕜₁ S}
+
+instance [uniform_space F] [uniform_add_group F] : uniform_add_group (E →SL[σ] F) :=
+strong_uniformity.uniform_add_group σ F _
+
+instance [topological_space F] [topological_add_group F] [has_continuous_smul 𝕜₁ E] [t2_space F] :
+  t2_space (E →SL[σ] F) :=
+strong_topology.t2_space σ F _ (set.eq_univ_of_forall $ λ x,
+  set.mem_sUnion_of_mem (set.mem_singleton x) (bornology.is_vonN_bounded_singleton x))
+
+protected lemma has_basis_nhds_zero_of_basis [topological_space F]
+  [topological_add_group F] {ι : Type*} {p : ι → Prop} {b : ι → set F}
+  (h : (𝓝 0 : filter F).has_basis p b) :
+  (𝓝 (0 : E →SL[σ] F)).has_basis
+    (λ Si : set E × ι, bornology.is_vonN_bounded 𝕜₁ Si.1 ∧ p Si.2)
+    (λ Si, {f : E →SL[σ] F | ∀ x ∈ Si.1, f x ∈ b Si.2}) :=
+strong_topology.has_basis_nhds_zero_of_basis σ F
+  {S | bornology.is_vonN_bounded 𝕜₁ S} ⟨∅, bornology.is_vonN_bounded_empty 𝕜₁ E⟩
+  (directed_on_of_sup_mem $ λ _ _, bornology.is_vonN_bounded.union) h
+
+protected lemma has_basis_nhds_zero [topological_space F]
+  [topological_add_group F] :
+  (𝓝 (0 : E →SL[σ] F)).has_basis
+    (λ SV : set E × set F, bornology.is_vonN_bounded 𝕜₁ SV.1 ∧ SV.2 ∈ (𝓝 0 : filter F))
+    (λ SV, {f : E →SL[σ] F | ∀ x ∈ SV.1, f x ∈ SV.2}) :=
+continuous_linear_map.has_basis_nhds_zero_of_basis (𝓝 0).basis_sets
+
+variables (G) [topological_space F] [topological_space G]
+
+/-- Pre-composition by a *fixed* continuous linear map as a continuous linear map.
+Note that in non-normed space it is not always true that composition is continuous
+in both variables, so we have to fix one of them. -/
+@[simps] def precomp [topological_add_group G] [has_continuous_const_smul 𝕜₃ G]
+  [ring_hom_surjective σ] [ring_hom_isometric σ] (L : E →SL[σ] F) :
+  (F →SL[τ] G) →L[𝕜₃] (E →SL[ρ] G) :=
+{ to_fun := λ f, f.comp L,
+  map_add' := λ f g, add_comp f g L,
+  map_smul' := λ a f, smul_comp a f L,
+  cont :=
+  begin
+    letI : uniform_space G := topological_add_group.to_uniform_space G,
+    haveI : uniform_add_group G := topological_add_comm_group_is_uniform,
+    rw (strong_topology.embedding_coe_fn _ _ _).continuous_iff,
+    refine (uniform_on_fun.precomp_uniform_continuous _).continuous.comp
+      (strong_topology.embedding_coe_fn _ _ _).continuous,
+    exact λ S hS, hS.image L,
+  end }
+
+variables (E) {G}
+
+/-- Post-composition by a *fixed* continuous linear map as a continuous linear map.
+Note that in non-normed space it is not always true that composition is continuous
+in both variables, so we have to fix one of them. -/
+@[simps] def postcomp [topological_add_group F] [topological_add_group G]
+  [has_continuous_const_smul 𝕜₃ G] [has_continuous_const_smul 𝕜₂ F] (L : F →SL[τ] G) :
+  (E →SL[σ] F) →SL[τ] (E →SL[ρ] G) :=
+{ to_fun := λ f, L.comp f,
+  map_add' := comp_add L,
+  map_smul' := comp_smulₛₗ L,
+  cont :=
+  begin
+    letI : uniform_space G := topological_add_group.to_uniform_space G,
+    haveI : uniform_add_group G := topological_add_comm_group_is_uniform,
+    letI : uniform_space F := topological_add_group.to_uniform_space F,
+    haveI : uniform_add_group F := topological_add_comm_group_is_uniform,
+    rw (strong_topology.embedding_coe_fn _ _ _).continuous_iff,
+    exact (uniform_on_fun.postcomp_uniform_continuous L.uniform_continuous).continuous.comp
+      (strong_topology.embedding_coe_fn _ _ _).continuous
+  end }
+
+end bounded_sets
+
+end continuous_linear_map
+
+open continuous_linear_map
+
+namespace continuous_linear_equiv
+
+section semilinear
+
+variables {𝕜 : Type*} {𝕜₂ : Type*} {𝕜₃ : Type*} {𝕜₄ : Type*}
+  {E : Type*} {F : Type*} {G : Type*} {H : Type*}
+  [add_comm_group E] [add_comm_group F] [add_comm_group G] [add_comm_group H]
+  [nontrivially_normed_field 𝕜] [nontrivially_normed_field 𝕜₂] [nontrivially_normed_field 𝕜₃]
+    [nontrivially_normed_field 𝕜₄]
+  [module 𝕜 E] [module 𝕜₂ F] [module 𝕜₃ G] [module 𝕜₄ H]
+  [topological_space E] [topological_space F] [topological_space G] [topological_space H]
+  [topological_add_group G] [topological_add_group H]
+  [has_continuous_const_smul 𝕜₃ G] [has_continuous_const_smul 𝕜₄ H]
+  {σ₁₂ : 𝕜 →+* 𝕜₂} {σ₂₁ : 𝕜₂ →+* 𝕜} {σ₂₃ : 𝕜₂ →+* 𝕜₃} {σ₁₃ : 𝕜 →+* 𝕜₃} {σ₃₄ : 𝕜₃ →+* 𝕜₄}
+    {σ₄₃ : 𝕜₄ →+* 𝕜₃} {σ₂₄ : 𝕜₂ →+* 𝕜₄} {σ₁₄ : 𝕜 →+* 𝕜₄}
+  [ring_hom_inv_pair σ₁₂ σ₂₁] [ring_hom_inv_pair σ₂₁ σ₁₂] [ring_hom_inv_pair σ₃₄ σ₄₃]
+    [ring_hom_inv_pair σ₄₃ σ₃₄]
+  [ring_hom_comp_triple σ₂₁ σ₁₄ σ₂₄] [ring_hom_comp_triple σ₂₄ σ₄₃ σ₂₃]
+    [ring_hom_comp_triple σ₁₂ σ₂₃ σ₁₃] [ring_hom_comp_triple σ₁₃ σ₃₄ σ₁₄]
+    [ring_hom_comp_triple σ₂₃ σ₃₄ σ₂₄] [ring_hom_comp_triple σ₁₂ σ₂₄ σ₁₄]
+  [ring_hom_isometric σ₁₂] [ring_hom_isometric σ₂₁]
+
+include σ₁₄ σ₂₄ σ₁₃ σ₃₄ σ₂₁ σ₂₃
+
+/-- A pair of continuous (semi)linear equivalences generates a (semi)linear equivalence between the
+spaces of continuous (semi)linear maps. -/
+@[simps] def arrow_congrSL (e₁₂ : E ≃SL[σ₁₂] F) (e₄₃ : H ≃SL[σ₄₃] G) :
+  (E →SL[σ₁₄] H) ≃SL[σ₄₃] (F →SL[σ₂₃] G) :=
+{ -- given explicitly to help `simps`
+  to_fun := λ L, (e₄₃ : H →SL[σ₄₃] G).comp (L.comp (e₁₂.symm : F →SL[σ₂₁] E)),
+  -- given explicitly to help `simps`
+  inv_fun := λ L, (e₄₃.symm : G →SL[σ₃₄] H).comp (L.comp (e₁₂ : E →SL[σ₁₂] F)),
+  map_add' := λ f g, by rw [add_comp, comp_add],
+  map_smul' := λ t f, by rw [smul_comp, comp_smulₛₗ],
+  continuous_to_fun :=
+    ((postcomp F e₄₃.to_continuous_linear_map).comp
+      (precomp H e₁₂.symm.to_continuous_linear_map)).continuous,
+  continuous_inv_fun :=
+    ((precomp H e₁₂.to_continuous_linear_map).comp
+      (postcomp F e₄₃.symm.to_continuous_linear_map)).continuous,
+  .. e₁₂.arrow_congr_equiv e₄₃, }
+
+end semilinear
+
+section linear
+variables {𝕜 : Type*} {E : Type*} {F : Type*} {G : Type*} {H : Type*}
+  [add_comm_group E] [add_comm_group F] [add_comm_group G] [add_comm_group H]
+  [nontrivially_normed_field 𝕜] [module 𝕜 E] [module 𝕜 F] [module 𝕜 G] [module 𝕜 H]
+  [topological_space E] [topological_space F] [topological_space G] [topological_space H]
+  [topological_add_group G] [topological_add_group H]
+  [has_continuous_const_smul 𝕜 G] [has_continuous_const_smul 𝕜 H]
+
+/-- A pair of continuous linear equivalences generates an continuous linear equivalence between
+the spaces of continuous linear maps. -/
+def arrow_congr (e₁ : E ≃L[𝕜] F) (e₂ : H ≃L[𝕜] G) : (E →L[𝕜] H) ≃L[𝕜] (F →L[𝕜] G) :=
+e₁.arrow_congrSL e₂
+
+end linear
+
+end continuous_linear_equiv
diff --git a/src/topology/algebra/module/weak_dual.lean b/src/topology/algebra/module/weak_dual.lean
index ba75f3f954916..0b4822cf8b21c 100644
--- a/src/topology/algebra/module/weak_dual.lean
+++ b/src/topology/algebra/module/weak_dual.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kalle Kytölä, Moritz Doll
 -/
 import topology.algebra.module.basic
+import linear_algebra.bilinear_map
 
 /-!
 # Weak dual topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the weak topology given two vector spaces `E` and `F` over a commutative semiring
 `𝕜` and a bilinear form `B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜`. The weak topology on `E` is the coarsest topology
 such that for all `y : F` every map `λ x, B x y` is continuous.
@@ -60,7 +64,7 @@ weak-star, weak dual, duality
 
 noncomputable theory
 open filter
-open_locale topological_space
+open_locale topology
 
 variables {α 𝕜 𝕝 R E F M : Type*}
 
@@ -68,7 +72,7 @@ section weak_topology
 
 /-- The space `E` equipped with the weak topology induced by the bilinear form `B`. -/
 @[derive [add_comm_monoid, module 𝕜],
-nolint has_inhabited_instance unused_arguments]
+nolint has_nonempty_instance unused_arguments]
 def weak_bilin [comm_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] [add_comm_monoid F]
   [module 𝕜 F] (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) := E
 
@@ -83,7 +87,7 @@ instance module' [comm_semiring 𝕜] [comm_semiring 𝕝] [add_comm_group E] [m
   module 𝕝 (weak_bilin B) := m
 
 instance [comm_semiring 𝕜] [comm_semiring 𝕝] [add_comm_group E] [module 𝕜 E]
-  [add_comm_group F] [module 𝕜 F] [has_scalar 𝕝 𝕜] [module 𝕝 E] [s : is_scalar_tower 𝕝 𝕜 E]
+  [add_comm_group F] [module 𝕜 F] [has_smul 𝕝 𝕜] [module 𝕝 E] [s : is_scalar_tower 𝕝 𝕜 E]
   (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜) : is_scalar_tower 𝕝 𝕜 (weak_bilin B) := s
 
 section semiring
@@ -96,6 +100,7 @@ variables (B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜)
 instance : topological_space (weak_bilin B) :=
 topological_space.induced (λ x y, B x y) Pi.topological_space
 
+/-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is continuous. -/
 lemma coe_fn_continuous : continuous (λ (x : weak_bilin B) y, B x y) :=
 continuous_induced_dom
 
@@ -104,7 +109,7 @@ lemma eval_continuous (y : F) : continuous (λ x : weak_bilin B, B x y) :=
 
 lemma continuous_of_continuous_eval [topological_space α] {g : α → weak_bilin B}
   (h : ∀ y, continuous (λ a, B (g a) y)) : continuous g :=
-continuous_induced_rng (continuous_pi_iff.mpr h)
+continuous_induced_rng.2 (continuous_pi_iff.mpr h)
 
 /-- The coercion `(λ x y, B x y) : E → (F → 𝕜)` is an embedding. -/
 lemma embedding {B : E →ₗ[𝕜] F →ₗ[𝕜] 𝕜} (hB : function.injective B) :
@@ -118,7 +123,7 @@ by rw [← tendsto_pi_nhds, embedding.tendsto_nhds_iff (embedding hB)]
 /-- Addition in `weak_space B` is continuous. -/
 instance [has_continuous_add 𝕜] : has_continuous_add (weak_bilin B) :=
 begin
-  refine ⟨continuous_induced_rng _⟩,
+  refine ⟨continuous_induced_rng.2 _⟩,
   refine cast (congr_arg _ _) (((coe_fn_continuous B).comp continuous_fst).add
     ((coe_fn_continuous B).comp continuous_snd)),
   ext,
@@ -128,7 +133,7 @@ end
 /-- Scalar multiplication by `𝕜` on `weak_bilin B` is continuous. -/
 instance [has_continuous_smul 𝕜 𝕜] : has_continuous_smul 𝕜 (weak_bilin B) :=
 begin
-  refine ⟨continuous_induced_rng _⟩,
+  refine ⟨continuous_induced_rng.2 _⟩,
   refine cast (congr_arg _ _) (continuous_fst.smul ((coe_fn_continuous B).comp continuous_snd)),
   ext,
   simp only [function.comp_app, pi.smul_apply, linear_map.map_smulₛₗ, ring_hom.id_apply,
@@ -149,7 +154,7 @@ continuous. -/
 instance [has_continuous_add 𝕜] : topological_add_group (weak_bilin B) :=
 { to_has_continuous_add := by apply_instance,
   continuous_neg := begin
-    refine continuous_induced_rng (continuous_pi_iff.mpr (λ y, _)),
+    refine continuous_induced_rng.2 (continuous_pi_iff.mpr (λ y, _)),
     refine cast (congr_arg _ _) (eval_continuous B (-y)),
     ext,
     simp only [map_neg, function.comp_app, linear_map.neg_apply],
@@ -186,8 +191,9 @@ namespace weak_dual
 
 instance : inhabited (weak_dual 𝕜 E) := continuous_linear_map.inhabited
 
-instance weak_dual.add_monoid_hom_class : add_monoid_hom_class (weak_dual 𝕜 E) E 𝕜 :=
-continuous_linear_map.add_monoid_hom_class
+instance weak_dual.continuous_linear_map_class :
+  continuous_linear_map_class (weak_dual 𝕜 E) 𝕜 E 𝕜 :=
+continuous_linear_map.continuous_semilinear_map_class
 
 /-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
 directly. -/
@@ -216,14 +222,14 @@ continuous_linear_map.module
 
 instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
   [has_continuous_const_smul M 𝕜] : has_continuous_const_smul M (weak_dual 𝕜 E) :=
-⟨λ m, continuous_induced_rng $ (weak_bilin.coe_fn_continuous (top_dual_pairing 𝕜 E)).const_smul m⟩
+⟨λ m, continuous_induced_rng.2 $ (weak_bilin.coe_fn_continuous (top_dual_pairing 𝕜 E)).const_smul m⟩
 
 /-- If a monoid `M` distributively continuously acts on `𝕜` and this action commutes with
 multiplication on `𝕜`, then it continuously acts on `weak_dual 𝕜 E`. -/
 instance (M) [monoid M] [distrib_mul_action M 𝕜] [smul_comm_class 𝕜 M 𝕜]
   [topological_space M] [has_continuous_smul M 𝕜] :
   has_continuous_smul M (weak_dual 𝕜 E) :=
-⟨continuous_induced_rng $ continuous_fst.smul ((weak_bilin.coe_fn_continuous
+⟨continuous_induced_rng.2 $ continuous_fst.smul ((weak_bilin.coe_fn_continuous
                           (top_dual_pairing 𝕜 E)).comp continuous_snd)⟩
 
 lemma coe_fn_continuous : continuous (λ (x : weak_dual 𝕜 E) y, x y) :=
@@ -234,18 +240,38 @@ continuous_pi_iff.mp coe_fn_continuous y
 
 lemma continuous_of_continuous_eval [topological_space α] {g : α → weak_dual 𝕜 E}
   (h : ∀ y, continuous (λ a, (g a) y)) : continuous g :=
-continuous_induced_rng (continuous_pi_iff.mpr h)
+continuous_induced_rng.2 (continuous_pi_iff.mpr h)
+
+instance [t2_space 𝕜] : t2_space (weak_dual 𝕜 E) :=
+embedding.t2_space $ weak_bilin.embedding $
+  show function.injective (top_dual_pairing 𝕜 E), from continuous_linear_map.coe_injective
 
 end weak_dual
 
 /-- The weak topology is the topology coarsest topology on `E` such that all
 functionals `λ x, top_dual_pairing 𝕜 E v x` are continuous. -/
 @[derive [add_comm_monoid, module 𝕜, topological_space, has_continuous_add],
-nolint has_inhabited_instance]
+nolint has_nonempty_instance]
 def weak_space (𝕜 E) [comm_semiring 𝕜] [topological_space 𝕜] [has_continuous_add 𝕜]
   [has_continuous_const_smul 𝕜 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E] :=
 weak_bilin (top_dual_pairing 𝕜 E).flip
 
+namespace weak_space
+
+variables {𝕜 E F} [add_comm_monoid F] [module 𝕜 F] [topological_space F]
+
+/-- A continuous linear map from `E` to `F` is still continuous when `E` and `F` are equipped with
+their weak topologies. -/
+def map (f : E →L[𝕜] F) :
+  weak_space 𝕜 E →L[𝕜] weak_space 𝕜 F :=
+{ cont := weak_bilin.continuous_of_continuous_eval _ (λ l, weak_bilin.eval_continuous _ (l ∘L f)),
+  ..f }
+
+lemma map_apply (f : E →L[𝕜] F) (x : E) : weak_space.map f x = f x := rfl
+@[simp] lemma coe_map (f : E →L[𝕜] F) : (weak_space.map f : E → F) = f := rfl
+
+end weak_space
+
 theorem tendsto_iff_forall_eval_tendsto_top_dual_pairing
   {l : filter α} {f : α → weak_dual 𝕜 E} {x : weak_dual 𝕜 E} :
   tendsto f l (𝓝 x) ↔
diff --git a/src/topology/algebra/monoid.lean b/src/topology/algebra/monoid.lean
index 78f98109e832e..305780ebd3702 100644
--- a/src/topology/algebra/monoid.lean
+++ b/src/topology/algebra/monoid.lean
@@ -4,12 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
 import algebra.big_operators.finprod
-import data.set.pointwise
+import order.filter.pointwise
 import topology.algebra.mul_action
+import algebra.big_operators.pi
+import topology.continuous_function.basic
 
 /-!
 # Theory of topological monoids
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define mixin classes `has_continuous_mul` and `has_continuous_add`. While in many
 applications the underlying type is a monoid (multiplicative or additive), we do not require this in
 the definitions.
@@ -17,7 +22,7 @@ the definitions.
 
 universes u v
 open classical set filter topological_space
-open_locale classical topological_space big_operators pointwise
+open_locale classical topology big_operators pointwise
 
 variables {ι α X M N : Type*} [topological_space X]
 
@@ -27,13 +32,19 @@ lemma continuous_one [topological_space M] [has_one M] : continuous (1 : X → M
 
 /-- Basic hypothesis to talk about a topological additive monoid or a topological additive
 semigroup. A topological additive monoid over `M`, for example, is obtained by requiring both the
-instances `add_monoid M` and `has_continuous_add M`. -/
+instances `add_monoid M` and `has_continuous_add M`.
+
+Continuity in only the left/right argument can be stated using
+`has_continuous_const_vadd α α`/`has_continuous_const_vadd αᵐᵒᵖ α`. -/
 class has_continuous_add (M : Type u) [topological_space M] [has_add M] : Prop :=
 (continuous_add : continuous (λ p : M × M, p.1 + p.2))
 
 /-- Basic hypothesis to talk about a topological monoid or a topological semigroup.
 A topological monoid over `M`, for example, is obtained by requiring both the instances `monoid M`
-and `has_continuous_mul M`. -/
+and `has_continuous_mul M`.
+
+Continuity in only the left/right argument can be stated using
+`has_continuous_const_smul α α`/`has_continuous_const_smul αᵐᵒᵖ α`. -/
 @[to_additive]
 class has_continuous_mul (M : Type u) [topological_space M] [has_mul M] : Prop :=
 (continuous_mul : continuous (λ p : M × M, p.1 * p.2))
@@ -42,14 +53,20 @@ section has_continuous_mul
 
 variables [topological_space M] [has_mul M] [has_continuous_mul M]
 
+@[to_additive] instance : has_continuous_mul Mᵒᵈ := ‹has_continuous_mul M›
+
 @[to_additive]
 lemma continuous_mul : continuous (λp:M×M, p.1 * p.2) :=
 has_continuous_mul.continuous_mul
 
 @[to_additive]
-instance has_continuous_mul.has_continuous_smul :
-  has_continuous_smul M M :=
-⟨continuous_mul⟩
+instance has_continuous_mul.to_has_continuous_smul : has_continuous_smul M M := ⟨continuous_mul⟩
+
+@[to_additive]
+instance has_continuous_mul.to_has_continuous_smul_op : has_continuous_smul Mᵐᵒᵖ M :=
+⟨show continuous ((λ p : M × M, p.1 * p.2) ∘ prod.swap ∘ prod.map mul_opposite.unop id), from
+  continuous_mul.comp $ continuous_swap.comp $ continuous.prod_map mul_opposite.continuous_unop
+    continuous_id⟩
 
 @[continuity, to_additive]
 lemma continuous.mul {f g : X → M} (hf : continuous f) (hg : continuous g) :
@@ -90,6 +107,55 @@ lemma filter.tendsto.mul_const (b : M) {c : M} {f : α → M} {l : filter α}
   (h : tendsto (λ (k:α), f k) l (𝓝 c)) : tendsto (λ (k:α), f k * b) l (𝓝 (c * b)) :=
 h.mul tendsto_const_nhds
 
+@[to_additive] lemma le_nhds_mul (a b : M) : 𝓝 a * 𝓝 b ≤ 𝓝 (a * b) :=
+by { rw [← map₂_mul, ← map_uncurry_prod, ← nhds_prod_eq], exact continuous_mul.tendsto _ }
+
+@[simp, to_additive] lemma nhds_one_mul_nhds {M} [mul_one_class M] [topological_space M]
+  [has_continuous_mul M] (a : M) : 𝓝 (1 : M) * 𝓝 a = 𝓝 a :=
+((le_nhds_mul _ _).trans_eq $ congr_arg _ (one_mul a)).antisymm $
+  le_mul_of_one_le_left' $ pure_le_nhds 1
+
+@[simp, to_additive] lemma nhds_mul_nhds_one {M} [mul_one_class M] [topological_space M]
+  [has_continuous_mul M] (a : M) : 𝓝 a * 𝓝 1 = 𝓝 a :=
+((le_nhds_mul _ _).trans_eq $ congr_arg _ (mul_one a)).antisymm $
+  le_mul_of_one_le_right' $ pure_le_nhds 1
+
+section tendsto_nhds
+
+variables {𝕜 : Type*}
+  [preorder 𝕜] [has_zero 𝕜] [has_mul 𝕜] [topological_space 𝕜] [has_continuous_mul 𝕜]
+  {l : filter α} {f : α → 𝕜} {b c : 𝕜} (hb : 0 < b)
+
+lemma filter.tendsto_nhds_within_Ioi.const_mul [pos_mul_strict_mono 𝕜] [pos_mul_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[>] c)) :
+  tendsto (λ a, b * f a) l (𝓝[>] (b * c)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).const_mul b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_left hb).mpr)
+
+lemma filter.tendsto_nhds_within_Iio.const_mul [pos_mul_strict_mono 𝕜] [pos_mul_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[<] c)) :
+  tendsto (λ a, b * f a) l (𝓝[<] (b * c)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).const_mul b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_left hb).mpr)
+
+lemma filter.tendsto_nhds_within_Ioi.mul_const [mul_pos_strict_mono 𝕜] [mul_pos_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[>] c)) :
+  tendsto (λ a, f a * b) l (𝓝[>] (c * b)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).mul_const b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_right hb).mpr)
+
+lemma filter.tendsto_nhds_within_Iio.mul_const [mul_pos_strict_mono 𝕜] [mul_pos_reflect_lt 𝕜]
+  (h : tendsto f l (𝓝[<] c)) :
+  tendsto (λ a, f a * b) l (𝓝[<] (c * b)) :=
+tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
+  ((tendsto_nhds_of_tendsto_nhds_within h).mul_const b) $
+  (tendsto_nhds_within_iff.mp h).2.mono (λ j, (mul_lt_mul_right hb).mpr)
+
+end tendsto_nhds
+
 /-- Construct a unit from limits of units and their inverses. -/
 @[to_additive filter.tendsto.add_units "Construct an additive unit from limits of additive units
 and their negatives.", simps]
@@ -98,8 +164,8 @@ def filter.tendsto.units [topological_space N] [monoid N] [has_continuous_mul N]
   (h₁ : tendsto (λ x, ↑(f x)) l (𝓝 r₁)) (h₂ : tendsto (λ x, ↑(f x)⁻¹) l (𝓝 r₂)) : Nˣ :=
 { val := r₁,
   inv := r₂,
-  val_inv := tendsto_nhds_unique (by simpa using h₁.mul h₂) tendsto_const_nhds,
-  inv_val := tendsto_nhds_unique (by simpa using h₂.mul h₁) tendsto_const_nhds }
+  val_inv := by { symmetry, simpa using h₁.mul h₂ },
+  inv_val := by { symmetry, simpa using h₂.mul h₁ } }
 
 @[to_additive]
 lemma continuous_at.mul {f g : X → M} {x : X} (hf : continuous_at f x) (hg : continuous_at g x) :
@@ -114,14 +180,13 @@ hf.mul hg
 
 @[to_additive]
 instance [topological_space N] [has_mul N] [has_continuous_mul N] : has_continuous_mul (M × N) :=
-⟨((continuous_fst.comp continuous_fst).mul (continuous_fst.comp continuous_snd)).prod_mk
- ((continuous_snd.comp continuous_fst).mul (continuous_snd.comp continuous_snd))⟩
+⟨(continuous_fst.fst'.mul continuous_fst.snd').prod_mk
+  (continuous_snd.fst'.mul continuous_snd.snd')⟩
 
 @[to_additive]
 instance pi.has_continuous_mul {C : ι → Type*} [∀ i, topological_space (C i)]
   [∀ i, has_mul (C i)] [∀ i, has_continuous_mul (C i)] : has_continuous_mul (Π i, C i) :=
-{ continuous_mul := continuous_pi (λ i, continuous.mul
-    ((continuous_apply i).comp continuous_fst) ((continuous_apply i).comp continuous_snd)) }
+{ continuous_mul := continuous_pi (λ i, (continuous_apply i).fst'.mul (continuous_apply i).snd') }
 
 /-- A version of `pi.has_continuous_mul` for non-dependent functions. It is needed because sometimes
 Lean fails to use `pi.has_continuous_mul` for non-dependent functions. -/
@@ -222,18 +287,27 @@ is_closed_of_closure_subset $ λ f hf, ⟨monoid_hom_of_mem_closure_range_coe f
 
 end pointwise_limits
 
-namespace submonoid
+@[to_additive] lemma inducing.has_continuous_mul {M N F : Type*} [has_mul M] [has_mul N]
+  [mul_hom_class F M N] [topological_space M] [topological_space N] [has_continuous_mul N]
+  (f : F) (hf : inducing f) :
+  has_continuous_mul M :=
+⟨hf.continuous_iff.2 $ by simpa only [(∘), map_mul f]
+  using (hf.continuous.fst'.mul hf.continuous.snd')⟩
+
+@[to_additive] lemma has_continuous_mul_induced {M N F : Type*} [has_mul M] [has_mul N]
+  [mul_hom_class F M N] [topological_space N] [has_continuous_mul N] (f : F) :
+  @has_continuous_mul M (induced f ‹_›) _ :=
+by { letI := induced f ‹_›, exact inducing.has_continuous_mul f ⟨rfl⟩ }
 
-@[to_additive] instance [topological_space α] [monoid α] [has_continuous_mul α] (S : submonoid α) :
+@[to_additive] instance subsemigroup.has_continuous_mul [topological_space M] [semigroup M]
+  [has_continuous_mul M] (S : subsemigroup M) :
   has_continuous_mul S :=
-{ continuous_mul :=
-  begin
-    rw embedding_subtype_coe.to_inducing.continuous_iff,
-    exact (continuous_subtype_coe.comp continuous_fst).mul
-      (continuous_subtype_coe.comp continuous_snd)
-  end }
+inducing.has_continuous_mul (⟨coe, λ _ _, rfl⟩ : mul_hom S M) ⟨rfl⟩
 
-end submonoid
+@[to_additive] instance submonoid.has_continuous_mul [topological_space M] [monoid M]
+  [has_continuous_mul M] (S : submonoid M) :
+  has_continuous_mul S :=
+S.to_subsemigroup.has_continuous_mul
 
 section has_continuous_mul
 
@@ -241,17 +315,13 @@ variables [topological_space M] [monoid M] [has_continuous_mul M]
 
 @[to_additive]
 lemma submonoid.top_closure_mul_self_subset (s : submonoid M) :
-  (closure (s : set M)) * closure (s : set M) ⊆ closure (s : set M) :=
-calc
-(closure (s : set M)) * closure (s : set M)
-    = (λ p : M × M, p.1 * p.2) '' (closure ((s : set M) ×ˢ (s : set M))) : by simp [closure_prod_eq]
-... ⊆ closure ((λ p : M × M, p.1 * p.2) '' ((s : set M) ×ˢ (s : set M))) :
-  image_closure_subset_closure_image continuous_mul
-... = closure s : by simp [s.coe_mul_self_eq]
+  closure (s : set M) * closure s ⊆ closure s :=
+image2_subset_iff.2 $ λ x hx y hy, map_mem_closure₂ continuous_mul hx hy $
+  λ a ha b hb, s.mul_mem ha hb
 
 @[to_additive]
 lemma submonoid.top_closure_mul_self_eq (s : submonoid M) :
-  (closure (s : set M)) * closure (s : set M) = closure (s : set M) :=
+  closure (s : set M) * closure s = closure s :=
 subset.antisymm
   s.top_closure_mul_self_subset
   (λ x hx, ⟨x, 1, hx, subset_closure s.one_mem, mul_one _⟩)
@@ -266,17 +336,7 @@ def submonoid.topological_closure (s : submonoid M) : submonoid M :=
   mul_mem' := λ a b ha hb, s.top_closure_mul_self_subset ⟨a, b, ha, hb, rfl⟩ }
 
 @[to_additive]
-instance submonoid.topological_closure_has_continuous_mul (s : submonoid M) :
-  has_continuous_mul (s.topological_closure) :=
-{ continuous_mul :=
-  begin
-    apply continuous_induced_rng,
-    change continuous (λ p : s.topological_closure × s.topological_closure, (p.1 : M) * (p.2 : M)),
-    continuity,
-  end }
-
-@[to_additive]
-lemma submonoid.submonoid_topological_closure (s : submonoid M) :
+lemma submonoid.le_topological_closure (s : submonoid M) :
   s ≤ s.topological_closure :=
 subset_closure
 
@@ -297,25 +357,10 @@ topological closure."]
 def submonoid.comm_monoid_topological_closure [t2_space M] (s : submonoid M)
   (hs : ∀ (x y : s), x * y = y * x) : comm_monoid s.topological_closure :=
 { mul_comm :=
-  begin
-    intros a b,
-    have h₁ : (s.topological_closure : set M) = closure s := rfl,
-    let f₁ := λ (x : M × M), x.1 * x.2,
-    let f₂ := λ (x : M × M), x.2 * x.1,
-    let S : set (M × M) := (s : set M) ×ˢ (s : set M),
-    have h₃ : set.eq_on f₁ f₂ (closure S),
-    { refine set.eq_on.closure _ continuous_mul (by continuity),
-      intros x hx,
-      rw [set.mem_prod] at hx,
-      rcases hx with ⟨hx₁, hx₂⟩,
-      change ((⟨x.1, hx₁⟩ : s) : M) * (⟨x.2, hx₂⟩ : s) = (⟨x.2, hx₂⟩ : s) * (⟨x.1, hx₁⟩ : s),
-      exact_mod_cast hs _ _ },
-    ext,
-    change f₁ ⟨a, b⟩ = f₂ ⟨a, b⟩,
-    refine h₃ _,
-    rw [closure_prod_eq, set.mem_prod],
-    exact ⟨by simp [←h₁], by simp [←h₁]⟩
-  end,
+    have ∀ (x ∈ s) (y ∈ s), x * y = y * x,
+      from λ x hx y hy, congr_arg subtype.val (hs ⟨x, hx⟩ ⟨y, hy⟩),
+    λ ⟨x, hx⟩ ⟨y, hy⟩, subtype.ext $
+      eq_on_closure₂ this continuous_mul (continuous_snd.mul continuous_fst) x hx y hy,
   ..s.topological_closure.to_monoid }
 
 @[to_additive exists_open_nhds_zero_half]
@@ -374,11 +419,24 @@ lemma tendsto_list_prod {f : ι → α → M} {x : filter α} {a : ι → M} :
 
 @[to_additive]
 lemma continuous_list_prod {f : ι → X → M} (l : list ι)
-  (h : ∀i∈l, continuous (f i)) :
-  continuous (λa, (l.map (λi, f i a)).prod) :=
+  (h : ∀ i ∈ l, continuous (f i)) :
+  continuous (λ a, (l.map (λ i, f i a)).prod) :=
 continuous_iff_continuous_at.2 $ assume x, tendsto_list_prod l $ assume c hc,
   continuous_iff_continuous_at.1 (h c hc) x
 
+@[to_additive]
+lemma continuous_on_list_prod {f : ι → X → M} (l : list ι) {t : set X}
+  (h : ∀ i ∈ l, continuous_on (f i) t) :
+  continuous_on (λ a, (l.map (λ i, f i a)).prod) t :=
+begin
+  intros x hx,
+  rw continuous_within_at_iff_continuous_at_restrict _ hx,
+  refine tendsto_list_prod _ (λ i hi, _),
+  specialize h i hi x hx,
+  rw continuous_within_at_iff_continuous_at_restrict _ hx at h,
+  exact h,
+end
+
 @[continuity, to_additive]
 lemma continuous_pow : ∀ n : ℕ, continuous (λ a : M, a ^ n)
 | 0 := by simpa using continuous_const
@@ -424,12 +482,35 @@ lemma continuous_on.pow {f : X → M} {s : set X} (hf : continuous_on f s) (n :
   continuous_on (λ x, f x ^ n) s :=
 λ x hx, (hf x hx).pow n
 
+/-- Left-multiplication by a left-invertible element of a topological monoid is proper, i.e.,
+inverse images of compact sets are compact. -/
+lemma filter.tendsto_cocompact_mul_left {a b : M} (ha : b * a = 1) :
+  filter.tendsto (λ x : M, a * x) (filter.cocompact M) (filter.cocompact M) :=
+begin
+  refine filter.tendsto.of_tendsto_comp _ (filter.comap_cocompact_le (continuous_mul_left b)),
+  convert filter.tendsto_id,
+  ext x,
+  simp [ha],
+end
+
+/-- Right-multiplication by a right-invertible element of a topological monoid is proper, i.e.,
+inverse images of compact sets are compact. -/
+lemma filter.tendsto_cocompact_mul_right {a b : M} (ha : a * b = 1) :
+  filter.tendsto (λ x : M, x * a) (filter.cocompact M) (filter.cocompact M) :=
+begin
+  refine filter.tendsto.of_tendsto_comp _ (filter.comap_cocompact_le (continuous_mul_right b)),
+  convert filter.tendsto_id,
+  ext x,
+  simp [ha],
+end
+
 /-- If `R` acts on `A` via `A`, then continuous multiplication implies continuous scalar
 multiplication by constants.
 
 Notably, this instances applies when `R = A`, or when `[algebra R A]` is available. -/
-@[priority 100]
-instance is_scalar_tower.has_continuous_const_smul {R A : Type*} [monoid A] [has_scalar R A]
+@[priority 100, to_additive  "If `R` acts on `A` via `A`, then continuous addition implies
+continuous affine addition by constants."]
+instance is_scalar_tower.has_continuous_const_smul {R A : Type*} [monoid A] [has_smul R A]
   [is_scalar_tower R A A] [topological_space A] [has_continuous_mul A] :
   has_continuous_const_smul R A :=
 { continuous_const_smul := λ q, begin
@@ -441,8 +522,11 @@ instance is_scalar_tower.has_continuous_const_smul {R A : Type*} [monoid A] [has
 implies continuous scalar multiplication by constants.
 
 Notably, this instances applies when `R = Aᵐᵒᵖ` -/
-@[priority 100]
-instance smul_comm_class.has_continuous_const_smul {R A : Type*} [monoid A] [has_scalar R A]
+@[priority 100, to_additive "If the action of `R` on `A` commutes with left-addition, then
+continuous addition implies continuous affine addition by constants.
+
+Notably, this instances applies when `R = Aᵃᵒᵖ`. "]
+instance smul_comm_class.has_continuous_const_smul {R A : Type*} [monoid A] [has_smul R A]
   [smul_comm_class R A A] [topological_space A] [has_continuous_mul A] :
   has_continuous_const_smul R A :=
 { continuous_const_smul := λ q, begin
@@ -457,9 +541,7 @@ namespace mul_opposite
 /-- If multiplication is continuous in `α`, then it also is in `αᵐᵒᵖ`. -/
 @[to_additive "If addition is continuous in `α`, then it also is in `αᵃᵒᵖ`."]
 instance [topological_space α] [has_mul α] [has_continuous_mul α] : has_continuous_mul αᵐᵒᵖ :=
-⟨ let h₁ := @continuous_mul α _ _ _ in
-  let h₂ : continuous (λ p : α × α, _) := continuous_snd.prod_mk continuous_fst in
-  continuous_induced_rng $ (h₁.comp h₂).comp (continuous_unop.prod_map continuous_unop) ⟩
+⟨continuous_op.comp (continuous_unop.snd'.mul continuous_unop.fst')⟩
 
 end mul_opposite
 
@@ -479,12 +561,14 @@ of the monoid, with respect to the induced topology, is continuous.
 
 Negation is also continuous, but we register this in a later file, `topology.algebra.group`, because
 the predicate `has_continuous_neg` has not yet been defined."]
-instance : has_continuous_mul αˣ :=
-⟨ let h := @continuous_mul (α × αᵐᵒᵖ) _ _ _ in
-  continuous_induced_rng $ h.comp $ continuous_embed_product.prod_map continuous_embed_product ⟩
+instance : has_continuous_mul αˣ := inducing_embed_product.has_continuous_mul (embed_product α)
 
 end units
 
+@[to_additive] lemma continuous.units_map [monoid M] [monoid N] [topological_space M]
+  [topological_space N] (f : M →* N) (hf : continuous f) : continuous (units.map f) :=
+units.continuous_iff.2 ⟨hf.comp units.continuous_coe, hf.comp units.continuous_coe_inv⟩
+
 section
 
 variables [topological_space M] [comm_monoid M]
@@ -509,14 +593,34 @@ tendsto_multiset_prod _
 
 @[continuity, to_additive]
 lemma continuous_multiset_prod {f : ι → X → M} (s : multiset ι) :
-  (∀i ∈ s, continuous (f i)) → continuous (λ a, (s.map (λ i, f i a)).prod) :=
+  (∀ i ∈ s, continuous (f i)) → continuous (λ a, (s.map (λ i, f i a)).prod) :=
 by { rcases s with ⟨l⟩, simpa using continuous_list_prod l }
 
+@[to_additive]
+lemma continuous_on_multiset_prod {f : ι → X → M} (s : multiset ι) {t : set X} :
+  (∀i ∈ s, continuous_on (f i) t) → continuous_on (λ a, (s.map (λ i, f i a)).prod) t :=
+by { rcases s with ⟨l⟩, simpa using continuous_on_list_prod l }
+
 @[continuity, to_additive]
 lemma continuous_finset_prod {f : ι → X → M} (s : finset ι) :
-  (∀ i ∈ s, continuous (f i)) → continuous (λa, ∏ i in s, f i a) :=
+  (∀ i ∈ s, continuous (f i)) → continuous (λ a, ∏ i in s, f i a) :=
 continuous_multiset_prod _
 
+@[to_additive]
+lemma continuous_on_finset_prod {f : ι → X → M} (s : finset ι) {t : set X} :
+  (∀ i ∈ s, continuous_on (f i) t) → continuous_on (λ a, ∏ i in s, f i a) t :=
+continuous_on_multiset_prod _
+
+@[to_additive] lemma eventually_eq_prod {X M : Type*} [comm_monoid M]
+  {s : finset ι} {l : filter X} {f g : ι → X → M} (hs : ∀ i ∈ s, f i =ᶠ[l] g i) :
+  ∏ i in s, f i =ᶠ[l] ∏ i in s, g i :=
+begin
+  replace hs: ∀ᶠ x in l, ∀ i ∈ s, f i x = g i x,
+  { rwa eventually_all_finset },
+  filter_upwards [hs] with x hx,
+  simp only [finset.prod_apply, finset.prod_congr rfl hx],
+end
+
 open function
 
 @[to_additive]
@@ -556,53 +660,52 @@ end
 
 end
 
-instance additive.has_continuous_add {M} [h : topological_space M] [has_mul M]
-  [has_continuous_mul M] : @has_continuous_add (additive M) h _ :=
+instance [topological_space M] [has_mul M] [has_continuous_mul M] :
+  has_continuous_add (additive M) :=
 { continuous_add := @continuous_mul M _ _ _ }
 
-instance multiplicative.has_continuous_mul {M} [h : topological_space M] [has_add M]
-  [has_continuous_add M] : @has_continuous_mul (multiplicative M) h _ :=
+instance [topological_space M] [has_add M] [has_continuous_add M] :
+  has_continuous_mul (multiplicative M) :=
 { continuous_mul := @continuous_add M _ _ _ }
 
 section lattice_ops
 
-variables {ι' : Sort*} [has_mul M] [has_mul N] {ts : set (topological_space M)}
-  (h : Π t ∈ ts, @has_continuous_mul M t _) {ts' : ι' → topological_space M}
-  (h' : Π i, @has_continuous_mul M (ts' i) _) {t₁ t₂ : topological_space M}
-  (h₁ : @has_continuous_mul M t₁ _) (h₂ : @has_continuous_mul M t₂ _)
-  {t : topological_space N} [has_continuous_mul N] {F : Type*}
-  [mul_hom_class F M N] (f : F)
+variables {ι' : Sort*} [has_mul M]
 
-@[to_additive] lemma has_continuous_mul_Inf :
+@[to_additive] lemma has_continuous_mul_Inf {ts : set (topological_space M)}
+  (h : Π t ∈ ts, @has_continuous_mul M t _) :
   @has_continuous_mul M (Inf ts) _ :=
-{ continuous_mul := continuous_Inf_rng (λ t ht, continuous_Inf_dom₂ ht ht
+{ continuous_mul := continuous_Inf_rng.2 (λ t ht, continuous_Inf_dom₂ ht ht
   (@has_continuous_mul.continuous_mul M t _ (h t ht))) }
 
-include h'
+@[to_additive] lemma has_continuous_mul_infi {ts : ι' → topological_space M}
+  (h' : Π i, @has_continuous_mul M (ts i) _) :
+  @has_continuous_mul M (⨅ i, ts i) _ :=
+by { rw ← Inf_range, exact has_continuous_mul_Inf (set.forall_range_iff.mpr h') }
+
+@[to_additive] lemma has_continuous_mul_inf {t₁ t₂ : topological_space M}
+  (h₁ : @has_continuous_mul M t₁ _) (h₂ : @has_continuous_mul M t₂ _) :
+  @has_continuous_mul M (t₁ ⊓ t₂) _ :=
+by { rw inf_eq_infi, refine has_continuous_mul_infi (λ b, _), cases b; assumption }
 
-@[to_additive] lemma has_continuous_mul_infi :
-  @has_continuous_mul M (⨅ i, ts' i) _ :=
-by {rw ← Inf_range, exact has_continuous_mul_Inf (set.forall_range_iff.mpr h')}
+end lattice_ops
 
-omit h'
+namespace continuous_map
 
-include h₁ h₂
+variables [has_mul X] [has_continuous_mul X]
 
-@[to_additive] lemma has_continuous_mul_inf :
-  @has_continuous_mul M (t₁ ⊓ t₂) _ :=
-by {rw inf_eq_infi, refine has_continuous_mul_infi (λ b, _), cases b; assumption}
+/-- The continuous map `λ y, y * x` -/
+@[to_additive "The continuous map `λ y, y + x"]
+protected def mul_right (x : X) : C(X, X) := mk _ (continuous_mul_right x)
 
-omit h₁ h₂
+@[simp, to_additive]
+lemma coe_mul_right (x : X) : ⇑(continuous_map.mul_right x) = λ y, y * x := rfl
 
-@[to_additive] lemma has_continuous_mul_induced :
-  @has_continuous_mul M (t.induced f) _ :=
-{ continuous_mul :=
-    begin
-      letI : topological_space M := t.induced f,
-      refine continuous_induced_rng _,
-      simp_rw [function.comp, map_mul],
-      change continuous ((λ p : N × N, p.1 * p.2) ∘ (prod.map f f)),
-      exact continuous_mul.comp (continuous_induced_dom.prod_map continuous_induced_dom),
-    end }
+/-- The continuous map `λ y, x * y` -/
+@[to_additive "The continuous map `λ y, x + y"]
+protected def mul_left (x : X) : C(X, X) := mk _ (continuous_mul_left x)
 
-end lattice_ops
+@[simp, to_additive]
+lemma coe_mul_left (x : X) : ⇑(continuous_map.mul_left x) = λ y, x * y := rfl
+
+end continuous_map
diff --git a/src/topology/algebra/mul_action.lean b/src/topology/algebra/mul_action.lean
index 4f250aa67ba1a..95c3c5e9da58a 100644
--- a/src/topology/algebra/mul_action.lean
+++ b/src/topology/algebra/mul_action.lean
@@ -3,14 +3,17 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
+import algebra.add_torsor
 import topology.algebra.constructions
 import group_theory.group_action.prod
-import group_theory.group_action.basic
 import topology.algebra.const_mul_action
 
 /-!
 # Continuous monoid action
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define class `has_continuous_smul`. We say `has_continuous_smul M X` if `M` acts on
 `X` and the map `(c, x) ↦ c • x` is continuous on `M × X`. We reuse this class for topological
 (semi)modules, vector spaces and algebras.
@@ -33,13 +36,13 @@ Besides homeomorphisms mentioned above, in this file we provide lemmas like `con
 or `filter.tendsto.smul` that provide dot-syntax access to `continuous_smul`.
 -/
 
-open_locale topological_space pointwise
+open_locale topology pointwise
 open filter
 
 /-- Class `has_continuous_smul M X` says that the scalar multiplication `(•) : M → X → X`
 is continuous in both arguments. We use the same class for all kinds of multiplicative actions,
 including (semi)modules and algebras. -/
-class has_continuous_smul (M X : Type*) [has_scalar M X]
+class has_continuous_smul (M X : Type*) [has_smul M X]
   [topological_space M] [topological_space X] : Prop :=
 (continuous_smul : continuous (λp : M × X, p.1 • p.2))
 
@@ -60,9 +63,9 @@ section main
 
 variables {M X Y α : Type*} [topological_space M] [topological_space X] [topological_space Y]
 
-section has_scalar
+section has_smul
 
-variables [has_scalar M X] [has_continuous_smul M X]
+variables [has_smul M X] [has_continuous_smul M X]
 
 @[priority 100, to_additive] instance has_continuous_smul.has_continuous_const_smul :
   has_continuous_const_smul M X :=
@@ -103,8 +106,10 @@ lemma continuous.smul (hf : continuous f) (hg : continuous g) :
   continuous (λ x, f x • g x) :=
 continuous_smul.comp (hf.prod_mk hg)
 
-/-- If a scalar is central, then its right action is continuous when its left action is. -/
-instance has_continuous_smul.op [has_scalar Mᵐᵒᵖ X] [is_central_scalar M X] :
+/-- If a scalar action is central, then its right action is continuous when its left action is. -/
+@[to_additive "If an additive action is central, then its right action is continuous when its left
+action is."]
+instance has_continuous_smul.op [has_smul Mᵐᵒᵖ X] [is_central_scalar M X] :
   has_continuous_smul Mᵐᵒᵖ X :=
 ⟨ suffices continuous (λ p : M × X, mul_opposite.op p.fst • p.snd),
   from this.comp (mul_opposite.continuous_unop.prod_map continuous_id),
@@ -114,7 +119,7 @@ instance has_continuous_smul.op [has_scalar Mᵐᵒᵖ X] [is_central_scalar M X
 ⟨mul_opposite.continuous_op.comp $ continuous_smul.comp $
   continuous_id.prod_map mul_opposite.continuous_unop⟩
 
-end has_scalar
+end has_smul
 
 section monoid
 
@@ -128,7 +133,7 @@ variables [monoid M] [mul_action M X] [has_continuous_smul M X]
 end monoid
 
 @[to_additive]
-instance [has_scalar M X] [has_scalar M Y] [has_continuous_smul M X]
+instance [has_smul M X] [has_smul M Y] [has_continuous_smul M X]
   [has_continuous_smul M Y] :
   has_continuous_smul M (X × Y) :=
 ⟨(continuous_fst.smul (continuous_fst.comp continuous_snd)).prod_mk
@@ -136,7 +141,7 @@ instance [has_scalar M X] [has_scalar M Y] [has_continuous_smul M X]
 
 @[to_additive]
 instance {ι : Type*} {γ : ι → Type*}
-  [∀ i, topological_space (γ i)] [Π i, has_scalar M (γ i)] [∀ i, has_continuous_smul M (γ i)] :
+  [∀ i, topological_space (γ i)] [Π i, has_smul M (γ i)] [∀ i, has_continuous_smul M (γ i)] :
   has_continuous_smul M (Π i, γ i) :=
 ⟨continuous_pi $ λ i,
   (continuous_fst.smul continuous_snd).comp $
@@ -146,7 +151,7 @@ end main
 
 section lattice_ops
 
-variables {ι : Sort*} {M X : Type*} [topological_space M] [has_scalar M X]
+variables {ι : Sort*} {M X : Type*} [topological_space M] [has_smul M X]
 
 @[to_additive] lemma has_continuous_smul_Inf {ts : set (topological_space X)}
   (h : Π t ∈ ts, @has_continuous_smul M X _ _ t) :
@@ -154,7 +159,7 @@ variables {ι : Sort*} {M X : Type*} [topological_space M] [has_scalar M X]
 { continuous_smul :=
   begin
     rw ← @Inf_singleton _ _ ‹topological_space M›,
-    exact continuous_Inf_rng (λ t ht, continuous_Inf_dom₂ (eq.refl _) ht
+    exact continuous_Inf_rng.2 (λ t ht, continuous_Inf_dom₂ (eq.refl _) ht
       (@has_continuous_smul.continuous_smul _ _ _ _ t (h t ht)))
   end }
 
@@ -169,3 +174,22 @@ has_continuous_smul_Inf $ set.forall_range_iff.mpr h
 by { rw inf_eq_infi, refine has_continuous_smul_infi (λ b, _), cases b; assumption }
 
 end lattice_ops
+
+section add_torsor
+
+variables (G : Type*) (P : Type*) [add_group G] [add_torsor G P] [topological_space G]
+variables [preconnected_space G] [topological_space P] [has_continuous_vadd G P]
+include G
+
+/-- An `add_torsor` for a connected space is a connected space. This is not an instance because
+it loops for a group as a torsor over itself. -/
+protected lemma add_torsor.connected_space : connected_space P :=
+{ is_preconnected_univ :=
+    begin
+      convert is_preconnected_univ.image ((equiv.vadd_const (classical.arbitrary P)) : G → P)
+                                         (continuous_id.vadd continuous_const).continuous_on,
+      rw [set.image_univ, equiv.range_eq_univ]
+    end,
+  to_nonempty := infer_instance }
+
+end add_torsor
diff --git a/src/topology/algebra/nonarchimedean/adic_topology.lean b/src/topology/algebra/nonarchimedean/adic_topology.lean
index 946715c55fb31..3190120464aac 100644
--- a/src/topology/algebra/nonarchimedean/adic_topology.lean
+++ b/src/topology/algebra/nonarchimedean/adic_topology.lean
@@ -6,10 +6,15 @@ Authors: Patrick Massot
 
 import ring_theory.ideal.operations
 import topology.algebra.nonarchimedean.bases
+import topology.uniform_space.completion
 import topology.algebra.uniform_ring
+
 /-!
 # Adic topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a commutative ring `R` and an ideal `I` in `R`, this file constructs the unique
 topology on `R` which is compatible with the ring structure and such that a set is a neighborhood
 of zero if and only if it contains a power of `I`. This topology is non-archimedean: every
@@ -43,7 +48,7 @@ to make sure it is definitionally equal to the `I`-topology on `R` seen as a `R`
 variables {R : Type*} [comm_ring R]
 
 open set topological_add_group submodule filter
-open_locale topological_space pointwise
+open_locale topology pointwise
 
 namespace ideal
 
@@ -219,7 +224,7 @@ variables (R) [with_ideal R]
 topological_add_group.to_uniform_space R
 
 @[priority 100] instance : uniform_add_group R :=
-topological_add_group_is_uniform
+topological_add_comm_group_is_uniform
 
 /-- The adic topology on a `R` module coming from the ideal `with_ideal.I`.
 This cannot be an instance because `R` cannot be inferred from `M`. -/
diff --git a/src/topology/algebra/nonarchimedean/bases.lean b/src/topology/algebra/nonarchimedean/bases.lean
index a9e14f0b5c526..29401a6db5294 100644
--- a/src/topology/algebra/nonarchimedean/bases.lean
+++ b/src/topology/algebra/nonarchimedean/bases.lean
@@ -6,11 +6,14 @@ Authors: Patrick Massot
 
 import topology.algebra.nonarchimedean.basic
 import topology.algebra.filter_basis
-import algebra.module.submodule_pointwise
+import algebra.module.submodule.pointwise
 
 /-!
 # Neighborhood bases for non-archimedean rings and modules
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files contains special families of filter bases on rings and modules that give rise to
 non-archimedean topologies.
 
@@ -28,7 +31,7 @@ sub-modules in a commutative algebra. This important example gives rises to the
 -/
 
 open set filter function lattice add_group_with_zero_nhd
-open_locale topological_space filter pointwise
+open_locale topology filter pointwise
 
 /-- A family of additive subgroups on a ring `A` is a subgroups basis if it satisfies some
 axioms ensuring there is a topology on `A` which is compatible with the ring structure and
diff --git a/src/topology/algebra/nonarchimedean/basic.lean b/src/topology/algebra/nonarchimedean/basic.lean
index 8ba60f2a088a7..8f6d94f28a25a 100644
--- a/src/topology/algebra/nonarchimedean/basic.lean
+++ b/src/topology/algebra/nonarchimedean/basic.lean
@@ -5,11 +5,14 @@ Authors: Kevin Buzzard, Johan Commelin, Ashwin Iyengar, Patrick Massot
 -/
 import group_theory.subgroup.basic
 import topology.algebra.open_subgroup
-import topology.algebra.ring
+import topology.algebra.ring.basic
 
 /-!
 # Nonarchimedean Topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we set up the theory of nonarchimedean topological groups and rings.
 
 A nonarchimedean group is a topological group whose topology admits a basis of
@@ -57,9 +60,9 @@ variables {G : Type*} [group G] [topological_space G] [nonarchimedean_group G]
 variables {H : Type*} [group H] [topological_space H] [topological_group H]
 variables {K : Type*} [group K] [topological_space K] [nonarchimedean_group K]
 
-/-- If a topological group embeds into a nonarchimedean group, then it
-  is nonarchimedean. -/
-@[to_additive nonarchimedean_add_group.nonarchimedean_of_emb]
+/-- If a topological group embeds into a nonarchimedean group, then it is nonarchimedean. -/
+@[to_additive nonarchimedean_add_group.nonarchimedean_of_emb "If a topological group embeds into a
+nonarchimedean group, then it is nonarchimedean."]
 lemma nonarchimedean_of_emb (f : G →* H) (emb : open_embedding f) : nonarchimedean_group H :=
 { is_nonarchimedean := λ U hU, have h₁ : (f ⁻¹' U) ∈ nhds (1 : G), from
     by {apply emb.continuous.tendsto, rwa f.map_one},
@@ -68,8 +71,10 @@ lemma nonarchimedean_of_emb (f : G →* H) (emb : open_embedding f) : nonarchime
       set.image_subset_iff.2 hV⟩ }
 
 /-- An open neighborhood of the identity in the cartesian product of two nonarchimedean groups
-  contains the cartesian product of an open neighborhood in each group. -/
-@[to_additive nonarchimedean_add_group.prod_subset]
+contains the cartesian product of an open neighborhood in each group. -/
+@[to_additive nonarchimedean_add_group.prod_subset "An open neighborhood of the identity in the
+cartesian product of two nonarchimedean groups contains the cartesian product of an open
+neighborhood in each group."]
 lemma prod_subset {U} (hU : U ∈ nhds (1 : G × K)) :
   ∃ (V : open_subgroup G) (W : open_subgroup K), (V : set G) ×ˢ (W : set K) ⊆ U :=
 begin
@@ -84,15 +89,17 @@ begin
 end
 
 /-- An open neighborhood of the identity in the cartesian square of a nonarchimedean group
-  contains the cartesian square of an open neighborhood in the group. -/
-@[to_additive nonarchimedean_add_group.prod_self_subset]
+contains the cartesian square of an open neighborhood in the group. -/
+@[to_additive nonarchimedean_add_group.prod_self_subset "An open neighborhood of the identity in the
+cartesian square of a nonarchimedean group contains the cartesian square of an open neighborhood in
+the group."]
 lemma prod_self_subset {U} (hU : U ∈ nhds (1 : G × G)) :
   ∃ (V : open_subgroup G), (V : set G) ×ˢ (V : set G) ⊆ U :=
 let ⟨V, W, h⟩ := prod_subset hU in
   ⟨V ⊓ W, by {refine set.subset.trans (set.prod_mono _ _) ‹_›; simp}⟩
 
 /-- The cartesian product of two nonarchimedean groups is nonarchimedean. -/
-@[to_additive]
+@[to_additive "The cartesian product of two nonarchimedean groups is nonarchimedean."]
 instance : nonarchimedean_group (G × K) :=
 { is_nonarchimedean := λ U hU, let ⟨V, W, h⟩ := prod_subset hU in ⟨V.prod W, ‹_›⟩ }
 
@@ -123,14 +130,13 @@ lemma mul_subset (U : open_add_subgroup R) :
   ∃ V : open_add_subgroup R, (V : set R) * V ⊆ U :=
 let ⟨V, H⟩ := prod_self_subset (is_open.mem_nhds (is_open.preimage continuous_mul U.is_open)
   begin
-    simpa only [set.mem_preimage, open_add_subgroup.mem_coe, prod.snd_zero, mul_zero]
-      using U.zero_mem,
+    simpa only [set.mem_preimage, set_like.mem_coe, prod.snd_zero, mul_zero] using U.zero_mem,
   end) in
 begin
   use V,
   rintros v ⟨a, b, ha, hb, hv⟩,
   have hy := H (set.mk_mem_prod ha hb),
-  simp only [set.mem_preimage, open_add_subgroup.mem_coe] at hy,
+  simp only [set.mem_preimage, set_like.mem_coe] at hy,
   rwa hv at hy
 end
 
diff --git a/src/topology/algebra/open_subgroup.lean b/src/topology/algebra/open_subgroup.lean
index 145f6a278c965..35d5a9753cca5 100644
--- a/src/topology/algebra/open_subgroup.lean
+++ b/src/topology/algebra/open_subgroup.lean
@@ -3,12 +3,15 @@ Copyright (c) 2019 Johan Commelin All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
-import topology.algebra.ring
-import topology.algebra.filter_basis
+import ring_theory.ideal.basic
+import topology.algebra.ring.basic
 import topology.sets.opens
 /-!
 # Open subgroups of a topological groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files builds the lattice `open_subgroup G` of open subgroups in a topological group `G`,
 and its additive version `open_add_subgroup`.  This lattice has a top element, the subgroup of all
 elements, but no bottom element in general. The trivial subgroup which is the natural candidate
@@ -30,7 +33,7 @@ Note that this notion is especially relevant in a non-archimedean context, for i
 -/
 
 open topological_space
-open_locale topological_space
+open_locale topology
 
 /-- The type of open subgroups of a topological additive group. -/
 @[ancestor add_subgroup]
@@ -55,44 +58,39 @@ variables {G : Type*} [group G] [topological_space G]
 variables {U V : open_subgroup G} {g : G}
 
 @[to_additive]
-instance has_coe_set : has_coe_t (open_subgroup G) (set G) := ⟨λ U, U.1⟩
+instance has_coe_subgroup : has_coe_t (open_subgroup G) (subgroup G) := ⟨to_subgroup⟩
 
 @[to_additive]
-instance : has_mem G (open_subgroup G) := ⟨λ g U, g ∈ (U : set G)⟩
+lemma coe_subgroup_injective : injective (coe : open_subgroup G → subgroup G)
+| ⟨_, _⟩ ⟨_, _⟩ rfl := rfl
 
 @[to_additive]
-instance has_coe_subgroup : has_coe_t (open_subgroup G) (subgroup G) := ⟨to_subgroup⟩
+instance : set_like (open_subgroup G) G :=
+{ coe := λ U, U.1,
+  coe_injective' := λ _ _ h, coe_subgroup_injective $ set_like.ext' h }
+
+@[to_additive]
+instance : subgroup_class (open_subgroup G) G :=
+{ mul_mem := λ U _ _, U.mul_mem',
+  one_mem := λ U, U.one_mem',
+  inv_mem := λ U _, U.inv_mem' }
 
 @[to_additive]
 instance has_coe_opens : has_coe_t (open_subgroup G) (opens G) := ⟨λ U, ⟨U, U.is_open'⟩⟩
 
-@[simp, norm_cast, to_additive] lemma mem_coe : g ∈ (U : set G) ↔ g ∈ U := iff.rfl
+@[simp, norm_cast, to_additive] lemma coe_coe_opens : ((U : opens G) : set G) = U := rfl
+@[simp, norm_cast, to_additive] lemma coe_coe_subgroup : ((U : subgroup G) : set G) = U := rfl
 @[simp, norm_cast, to_additive] lemma mem_coe_opens : g ∈ (U : opens G) ↔ g ∈ U := iff.rfl
 @[simp, norm_cast, to_additive]
 lemma mem_coe_subgroup : g ∈ (U : subgroup G) ↔ g ∈ U := iff.rfl
 
-@[to_additive] lemma coe_injective : injective (coe : open_subgroup G → set G) :=
-by { rintros ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨h⟩, congr, }
-
 @[ext, to_additive]
-lemma ext (h : ∀ x, x ∈ U ↔ x ∈ V) : (U = V) := coe_injective $ set.ext h
-
-@[to_additive]
-lemma ext_iff : (U = V) ↔ (∀ x, x ∈ U ↔ x ∈ V) := ⟨λ h x, h ▸ iff.rfl, ext⟩
+lemma ext (h : ∀ x, x ∈ U ↔ x ∈ V) : (U = V) := set_like.ext h
 
 variable (U)
 @[to_additive]
 protected lemma is_open : is_open (U : set G) := U.is_open'
 
-@[to_additive]
-protected lemma one_mem : (1 : G) ∈ U := U.one_mem'
-
-@[to_additive]
-protected lemma inv_mem {g : G} (h : g ∈ U) : g⁻¹ ∈ U := U.inv_mem' h
-
-@[to_additive]
-protected lemma mul_mem {g₁ g₂ : G} (h₁ : g₁ ∈ U) (h₂ : g₂ ∈ U) : g₁ * g₂ ∈ U := U.mul_mem' h₁ h₂
-
 @[to_additive]
 lemma mem_nhds_one : (U : set G) ∈ 𝓝 (1 : G) :=
 is_open.mem_nhds U.is_open U.one_mem
@@ -101,6 +99,15 @@ variable {U}
 @[to_additive]
 instance : has_top (open_subgroup G) := ⟨{ is_open' := is_open_univ, .. (⊤ : subgroup G) }⟩
 
+@[simp, to_additive] lemma mem_top (x : G) : x ∈ (⊤ : open_subgroup G) := trivial
+@[simp, norm_cast, to_additive] lemma coe_top : ((⊤ : open_subgroup G) : set G) = set.univ := rfl
+
+@[simp, norm_cast, to_additive]
+lemma coe_subgroup_top : ((⊤ : open_subgroup G) : subgroup G) = ⊤ := rfl
+
+@[simp, norm_cast, to_additive]
+lemma coe_opens_top : ((⊤ : open_subgroup G) : opens G) = ⊤ := rfl
+
 @[to_additive]
 instance : inhabited (open_subgroup G) := ⟨⊤⟩
 
@@ -109,51 +116,60 @@ lemma is_closed [has_continuous_mul G] (U : open_subgroup G) : is_closed (U : se
 begin
   apply is_open_compl_iff.1,
   refine is_open_iff_forall_mem_open.2 (λ x hx, ⟨(λ y, y * x⁻¹) ⁻¹' U, _, _, _⟩),
-  { intros u hux,
-    simp only [set.mem_preimage, set.mem_compl_iff, mem_coe] at hux hx ⊢,
-    refine mt (λ hu, _) hx,
+  { refine λ u hux hu, hx _,
+    simp only [set.mem_preimage, set_like.mem_coe] at hux hu ⊢,
     convert U.mul_mem (U.inv_mem hux) hu,
     simp },
   { exact U.is_open.preimage (continuous_mul_right _) },
-  { simp [U.one_mem] }
+  { simp [one_mem] }
 end
 
+@[to_additive]
+lemma is_clopen [has_continuous_mul G] (U : open_subgroup G) : is_clopen (U : set G) :=
+⟨U.is_open, U.is_closed⟩
+
 section
 variables {H : Type*} [group H] [topological_space H]
 
 /-- The product of two open subgroups as an open subgroup of the product group. -/
 @[to_additive "The product of two open subgroups as an open subgroup of the product group."]
 def prod (U : open_subgroup G) (V : open_subgroup H) : open_subgroup (G × H) :=
-{ carrier := (U : set G) ×ˢ (V : set H),
-  is_open' := U.is_open.prod V.is_open,
+{ is_open' := U.is_open.prod V.is_open,
   .. (U : subgroup G).prod (V : subgroup H) }
 
+@[simp, norm_cast, to_additive] lemma coe_prod (U : open_subgroup G) (V : open_subgroup H) :
+  (U.prod V : set (G × H)) = U ×ˢ V :=
+rfl
+
+@[simp, norm_cast, to_additive]
+lemma coe_subgroup_prod (U : open_subgroup G) (V : open_subgroup H) :
+  (U.prod V : subgroup (G × H)) = (U : subgroup G).prod V :=
+rfl
+
 end
 
 @[to_additive]
-instance : partial_order (open_subgroup G) :=
-{ le := λ U V, ∀ ⦃x⦄, x ∈ U → x ∈ V,
-  .. partial_order.lift (coe : open_subgroup G → set G) coe_injective }
+instance : has_inf (open_subgroup G) :=
+⟨λ U V, ⟨U ⊓ V, U.is_open.inter V.is_open⟩⟩
+
+@[simp, norm_cast, to_additive] lemma coe_inf : (↑(U ⊓ V) : set G) = (U : set G) ∩ V := rfl
+@[simp, norm_cast, to_additive] lemma coe_subgroup_inf : (↑(U ⊓ V) : subgroup G) = ↑U ⊓ ↑V := rfl
+@[simp, norm_cast, to_additive] lemma coe_opens_inf : (↑(U ⊓ V) : opens G) = ↑U ⊓ ↑V := rfl
+@[simp, to_additive] lemma mem_inf {x} : x ∈ U ⊓ V ↔ x ∈ U ∧ x ∈ V := iff.rfl
 
 @[to_additive]
 instance : semilattice_inf (open_subgroup G) :=
-{ inf := λ U V, { is_open' := is_open.inter U.is_open V.is_open, .. (U : subgroup G) ⊓ V },
-  inf_le_left := λ U V, set.inter_subset_left _ _,
-  inf_le_right := λ U V, set.inter_subset_right _ _,
-  le_inf := λ U V W hV hW, set.subset_inter hV hW,
-  ..open_subgroup.partial_order }
+{ .. set_like.partial_order,
+  .. set_like.coe_injective.semilattice_inf (coe : open_subgroup G → set G) (λ _ _, rfl) }
 
 @[to_additive]
 instance : order_top (open_subgroup G) :=
 { top := ⊤,
   le_top := λ U, set.subset_univ _ }
 
-@[simp, norm_cast, to_additive] lemma coe_inf : (↑(U ⊓ V) : set G) = (U : set G) ∩ V := rfl
-
-@[simp, norm_cast, to_additive] lemma coe_subset : (U : set G) ⊆ V ↔ U ≤ V := iff.rfl
-
 @[simp, norm_cast, to_additive] lemma coe_subgroup_le :
-(U : subgroup G) ≤ (V : subgroup G) ↔ U ≤ V := iff.rfl
+  (U : subgroup G) ≤ (V : subgroup G) ↔ U ≤ V :=
+iff.rfl
 
 variables {N : Type*} [group N] [topological_space N]
 
@@ -161,15 +177,18 @@ variables {N : Type*} [group N] [topological_space N]
   is an `open_subgroup`. -/
 @[to_additive "The preimage of an `open_add_subgroup` along a continuous `add_monoid` homomorphism
 is an `open_add_subgroup`."]
-def comap (f : G →* N)
-  (hf : continuous f) (H : open_subgroup N) : open_subgroup G :=
+def comap (f : G →* N) (hf : continuous f) (H : open_subgroup N) : open_subgroup G :=
 { is_open' := H.is_open.preimage hf,
   .. (H : subgroup N).comap f }
 
-@[simp, to_additive]
+@[simp, norm_cast, to_additive]
 lemma coe_comap (H : open_subgroup N) (f : G →* N) (hf : continuous f) :
   (H.comap f hf : set G) = f ⁻¹' H := rfl
 
+@[simp, norm_cast, to_additive]
+lemma coe_subgroup_comap (H : open_subgroup N) (f : G →* N) (hf : continuous f) :
+  (H.comap f hf : subgroup G) = (H : subgroup N).comap f := rfl
+
 @[simp, to_additive]
 lemma mem_comap {H : open_subgroup N} {f : G →* N} {hf : continuous f} {x : G} :
   x ∈ H.comap f hf ↔ f x ∈ H := iff.rfl
@@ -190,45 +209,30 @@ variables {G : Type*} [group G] [topological_space G] [has_continuous_mul G] (H
 lemma is_open_of_mem_nhds {g : G} (hg : (H : set G) ∈ 𝓝 g) :
   is_open (H : set G) :=
 begin
-  simp only [is_open_iff_mem_nhds, set_like.mem_coe] at hg ⊢,
-  intros x hx,
-  have : filter.tendsto (λ y, y * (x⁻¹ * g)) (𝓝 x) (𝓝 $ x * (x⁻¹ * g)) :=
-    (continuous_id.mul continuous_const).tendsto _,
-  rw [mul_inv_cancel_left] at this,
-  have := filter.mem_map'.1 (this hg),
-  replace hg : g ∈ H := set_like.mem_coe.1 (mem_of_mem_nhds hg),
-  simp only [set_like.mem_coe, H.mul_mem_cancel_right (H.mul_mem (H.inv_mem hx) hg)] at this,
-  exact this
+  refine is_open_iff_mem_nhds.2 (λ x hx, _),
+  have hg' : g ∈ H := set_like.mem_coe.1 (mem_of_mem_nhds hg),
+  have : filter.tendsto (λ y, y * (x⁻¹ * g)) (𝓝 x) (𝓝 g) :=
+    (continuous_id.mul continuous_const).tendsto' _ _ (mul_inv_cancel_left _ _),
+  simpa only [set_like.mem_coe, filter.mem_map',
+    H.mul_mem_cancel_right (H.mul_mem (H.inv_mem hx) hg')] using this hg,
 end
 
 @[to_additive]
-lemma is_open_of_open_subgroup {U : open_subgroup G} (h : U.1 ≤ H) :
+lemma is_open_mono {H₁ H₂ : subgroup G} (h : H₁ ≤ H₂) (h₁ : is_open (H₁ : set G)) :
+  is_open (H₂ : set G) :=
+is_open_of_mem_nhds _ $ filter.mem_of_superset (h₁.mem_nhds $ one_mem H₁) h
+
+@[to_additive]
+lemma is_open_of_open_subgroup {U : open_subgroup G} (h : ↑U ≤ H) :
   is_open (H : set G) :=
-H.is_open_of_mem_nhds (filter.mem_of_superset U.mem_nhds_one h)
+is_open_mono h U.is_open
 
 /-- If a subgroup of a topological group has `1` in its interior, then it is open. -/
 @[to_additive "If a subgroup of an additive topological group has `0` in its interior, then it is
 open."]
-lemma is_open_of_one_mem_interior {G : Type*} [group G] [topological_space G]
-  [topological_group G] {H : subgroup G} (h_1_int : (1 : G) ∈ interior (H : set G)) :
+lemma is_open_of_one_mem_interior (h_1_int : (1 : G) ∈ interior (H : set G)) :
   is_open (H : set G) :=
-begin
-  have h : 𝓝 1 ≤ filter.principal (H : set G) :=
-    nhds_le_of_le h_1_int (is_open_interior) (filter.principal_mono.2 interior_subset),
-  rw is_open_iff_nhds,
-  intros g hg,
-  rw (show 𝓝 g = filter.map ⇑(homeomorph.mul_left g) (𝓝 1), by simp),
-  convert filter.map_mono h,
-  simp only [homeomorph.coe_mul_left, filter.map_principal, set.image_mul_left,
-  filter.principal_eq_iff_eq],
-  ext,
-  simp [H.mul_mem_cancel_left (H.inv_mem hg)],
-end
-
-@[to_additive]
-lemma is_open_mono {H₁ H₂ : subgroup G} (h : H₁ ≤ H₂) (h₁ : is_open (H₁ : set G)) :
-  is_open (H₂ : set G) :=
-@is_open_of_open_subgroup _ _ _ _ H₂ { is_open' := h₁, .. H₁ } h
+is_open_of_mem_nhds H $ mem_interior_iff_mem_nhds.1 h_1_int
 
 end subgroup
 
@@ -237,20 +241,16 @@ namespace open_subgroup
 variables {G : Type*} [group G] [topological_space G] [has_continuous_mul G]
 
 @[to_additive]
-instance : semilattice_sup (open_subgroup G) :=
-{ sup := λ U V,
-  { is_open' := show is_open (((U : subgroup G) ⊔ V : subgroup G) : set G),
-    from subgroup.is_open_mono le_sup_left U.is_open,
-    .. ((U : subgroup G) ⊔ V) },
-  le_sup_left := λ U V, coe_subgroup_le.1 le_sup_left,
-  le_sup_right := λ U V, coe_subgroup_le.1 le_sup_right,
-  sup_le := λ U V W hU hV, coe_subgroup_le.1 (sup_le hU hV),
-  ..open_subgroup.semilattice_inf }
+instance : has_sup (open_subgroup G) :=
+⟨λ U V, ⟨U ⊔ V, subgroup.is_open_mono (le_sup_left : U.1 ≤ U ⊔ V) U.is_open⟩⟩
+
+@[simp, norm_cast, to_additive]
+lemma coe_subgroup_sup (U V : open_subgroup G) : (↑(U ⊔ V) : subgroup G) = ↑U ⊔ ↑V := rfl
 
 @[to_additive]
 instance : lattice (open_subgroup G) :=
-{ ..open_subgroup.semilattice_sup, ..open_subgroup.semilattice_inf }
-
+{ .. open_subgroup.semilattice_inf,
+  .. coe_subgroup_injective.semilattice_sup (coe : open_subgroup G → subgroup G) (λ _ _, rfl) }
 
 end open_subgroup
 
diff --git a/src/topology/algebra/order/archimedean.lean b/src/topology/algebra/order/archimedean.lean
new file mode 100644
index 0000000000000..33cdf711c7c15
--- /dev/null
+++ b/src/topology/algebra/order/archimedean.lean
@@ -0,0 +1,25 @@
+/-
+Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury G. Kudryashov
+-/
+import topology.order.basic
+import algebra.order.archimedean
+
+/-!
+# Rational numbers are dense in a linear ordered archimedean field
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that coercion from `ℚ` to a linear ordered archimedean field has dense range.
+This lemma is in a separate file because `topology.order.basic` does not import
+`algebra.order.archimedean`.
+-/
+
+variables {𝕜 : Type*} [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜]
+  [archimedean 𝕜]
+
+/-- Rational numbers are dense in a linear ordered archimedean field. -/
+lemma rat.dense_range_cast : dense_range (coe : ℚ → 𝕜) :=
+dense_of_exists_between $ λ a b h, set.exists_range_iff.2 $ exists_rat_btwn h
diff --git a/src/topology/algebra/order/basic.lean b/src/topology/algebra/order/basic.lean
deleted file mode 100644
index 5894f7a29336b..0000000000000
--- a/src/topology/algebra/order/basic.lean
+++ /dev/null
@@ -1,2766 +0,0 @@
-/-
-Copyright (c) 2017 Johannes Hölzl. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
--/
-import algebra.group_with_zero.power
-import data.set.intervals.pi
-import order.filter.interval
-import topology.algebra.group
-import tactic.linarith
-import tactic.tfae
-
-/-!
-# Theory of topology on ordered spaces
-
-## Main definitions
-
-The order topology on an ordered space is the topology generated by all open intervals (or
-equivalently by those of the form `(-∞, a)` and `(b, +∞)`). We define it as `preorder.topology α`.
-However, we do *not* register it as an instance (as many existing ordered types already have
-topologies, which would be equal but not definitionally equal to `preorder.topology α`). Instead,
-we introduce a class `order_topology α` (which is a `Prop`, also known as a mixin) saying that on
-the type `α` having already a topological space structure and a preorder structure, the topological
-structure is equal to the order topology.
-
-We also introduce another (mixin) class `order_closed_topology α` saying that the set of points
-`(x, y)` with `x ≤ y` is closed in the product space. This is automatically satisfied on a linear
-order with the order topology.
-
-We prove many basic properties of such topologies.
-
-## Main statements
-
-This file contains the proofs of the following facts. For exact requirements
-(`order_closed_topology` vs `order_topology`, `preorder` vs `partial_order` vs `linear_order` etc)
-see their statements.
-
-### Open / closed sets
-
-* `is_open_lt` : if `f` and `g` are continuous functions, then `{x | f x < g x}` is open;
-* `is_open_Iio`, `is_open_Ioi`, `is_open_Ioo` : open intervals are open;
-* `is_closed_le` : if `f` and `g` are continuous functions, then `{x | f x ≤ g x}` is closed;
-* `is_closed_Iic`, `is_closed_Ici`, `is_closed_Icc` : closed intervals are closed;
-* `frontier_le_subset_eq`, `frontier_lt_subset_eq` : frontiers of both `{x | f x ≤ g x}`
-  and `{x | f x < g x}` are included by `{x | f x = g x}`;
-* `exists_Ioc_subset_of_mem_nhds`, `exists_Ico_subset_of_mem_nhds` : if `x < y`, then any
-  neighborhood of `x` includes an interval `[x, z)` for some `z ∈ (x, y]`, and any neighborhood
-  of `y` includes an interval `(z, y]` for some `z ∈ [x, y)`.
-
-### Convergence and inequalities
-
-* `le_of_tendsto_of_tendsto` : if `f` converges to `a`, `g` converges to `b`, and eventually
-  `f x ≤ g x`, then `a ≤ b`
-* `le_of_tendsto`, `ge_of_tendsto` : if `f` converges to `a` and eventually `f x ≤ b`
-  (resp., `b ≤ f x`), then `a ≤ b` (resp., `b ≤ a); we also provide primed versions
-  that assume the inequalities to hold for all `x`.
-
-### Min, max, `Sup` and `Inf`
-
-* `continuous.min`, `continuous.max`: pointwise `min`/`max` of two continuous functions is
-  continuous.
-* `tendsto.min`, `tendsto.max` : if `f` tends to `a` and `g` tends to `b`, then their pointwise
-  `min`/`max` tend to `min a b` and `max a b`, respectively.
-* `tendsto_of_tendsto_of_tendsto_of_le_of_le` : theorem known as squeeze theorem,
-  sandwich theorem, theorem of Carabinieri, and two policemen (and a drunk) theorem; if `g` and `h`
-  both converge to `a`, and eventually `g x ≤ f x ≤ h x`, then `f` converges to `a`.
-
-## Implementation notes
-
-We do _not_ register the order topology as an instance on a preorder (or even on a linear order).
-Indeed, on many such spaces, a topology has already been constructed in a different way (think
-of the discrete spaces `ℕ` or `ℤ`, or `ℝ` that could inherit a topology as the completion of `ℚ`),
-and is in general not defeq to the one generated by the intervals. We make it available as a
-definition `preorder.topology α` though, that can be registered as an instance when necessary, or
-for specific types.
--/
-
-open classical set filter topological_space
-open function
-open order_dual (to_dual of_dual)
-open_locale topological_space classical filter
-
-universes u v w
-variables {α : Type u} {β : Type v} {γ : Type w}
-
-/-- A topology on a set which is both a topological space and a preorder is _order-closed_ if the
-set of points `(x, y)` with `x ≤ y` is closed in the product space. We introduce this as a mixin.
-This property is satisfied for the order topology on a linear order, but it can be satisfied more
-generally, and suffices to derive many interesting properties relating order and topology. -/
-class order_closed_topology (α : Type*) [topological_space α] [preorder α] : Prop :=
-(is_closed_le' : is_closed {p:α×α | p.1 ≤ p.2})
-
-instance : Π [topological_space α], topological_space αᵒᵈ := id
-
-instance [topological_space α] [h : first_countable_topology α] : first_countable_topology αᵒᵈ := h
-
-instance [topological_space α] [h : second_countable_topology α] : second_countable_topology αᵒᵈ :=
-h
-
-@[to_additive]
-instance [topological_space α] [has_mul α] [h : has_continuous_mul α] : has_continuous_mul αᵒᵈ := h
-
-lemma dense.order_dual [topological_space α] {s : set α} (hs : dense s) :
-  dense (order_dual.of_dual ⁻¹' s) := hs
-
-section order_closed_topology
-
-section preorder
-variables [topological_space α] [preorder α] [t : order_closed_topology α]
-include t
-
-namespace subtype
-
-instance {p : α → Prop} : order_closed_topology (subtype p) :=
-have this : continuous (λ (p : (subtype p) × (subtype p)), ((p.fst : α), (p.snd : α))) :=
-  (continuous_subtype_coe.comp continuous_fst).prod_mk
-  (continuous_subtype_coe.comp continuous_snd),
-order_closed_topology.mk (t.is_closed_le'.preimage this)
-
-end subtype
-
-lemma is_closed_le_prod : is_closed {p : α × α | p.1 ≤ p.2} :=
-t.is_closed_le'
-
-lemma is_closed_le [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
-  is_closed {b | f b ≤ g b} :=
-continuous_iff_is_closed.mp (hf.prod_mk hg) _ is_closed_le_prod
-
-lemma is_closed_le' (a : α) : is_closed {b | b ≤ a} :=
-is_closed_le continuous_id continuous_const
-
-lemma is_closed_Iic {a : α} : is_closed (Iic a) :=
-is_closed_le' a
-
-lemma is_closed_ge' (a : α) : is_closed {b | a ≤ b} :=
-is_closed_le continuous_const continuous_id
-
-lemma is_closed_Ici {a : α} : is_closed (Ici a) :=
-is_closed_ge' a
-
-instance : order_closed_topology αᵒᵈ :=
-⟨(@order_closed_topology.is_closed_le' α _ _ _).preimage continuous_swap⟩
-
-lemma is_closed_Icc {a b : α} : is_closed (Icc a b) :=
-is_closed.inter is_closed_Ici is_closed_Iic
-
-@[simp] lemma closure_Icc (a b : α) : closure (Icc a b) = Icc a b :=
-is_closed_Icc.closure_eq
-
-@[simp] lemma closure_Iic (a : α) : closure (Iic a) = Iic a :=
-is_closed_Iic.closure_eq
-
-@[simp] lemma closure_Ici (a : α) : closure (Ici a) = Ici a :=
-is_closed_Ici.closure_eq
-
-lemma le_of_tendsto_of_tendsto {f g : β → α} {b : filter β} {a₁ a₂ : α} [ne_bot b]
-  (hf : tendsto f b (𝓝 a₁)) (hg : tendsto g b (𝓝 a₂)) (h : f ≤ᶠ[b] g) :
-  a₁ ≤ a₂ :=
-have tendsto (λb, (f b, g b)) b (𝓝 (a₁, a₂)),
-  by rw [nhds_prod_eq]; exact hf.prod_mk hg,
-show (a₁, a₂) ∈ {p:α×α | p.1 ≤ p.2},
-  from t.is_closed_le'.mem_of_tendsto this h
-
-alias le_of_tendsto_of_tendsto ← tendsto_le_of_eventually_le
-
-lemma le_of_tendsto_of_tendsto' {f g : β → α} {b : filter β} {a₁ a₂ : α} [ne_bot b]
-  (hf : tendsto f b (𝓝 a₁)) (hg : tendsto g b (𝓝 a₂)) (h : ∀ x, f x ≤ g x) :
-  a₁ ≤ a₂ :=
-le_of_tendsto_of_tendsto hf hg (eventually_of_forall h)
-
-lemma le_of_tendsto {f : β → α} {a b : α} {x : filter β}
-  [ne_bot x] (lim : tendsto f x (𝓝 a)) (h : ∀ᶠ c in x, f c ≤ b) : a ≤ b :=
-le_of_tendsto_of_tendsto lim tendsto_const_nhds h
-
-lemma le_of_tendsto' {f : β → α} {a b : α} {x : filter β}
-  [ne_bot x] (lim : tendsto f x (𝓝 a)) (h : ∀ c, f c ≤ b) : a ≤ b :=
-le_of_tendsto lim (eventually_of_forall h)
-
-lemma ge_of_tendsto {f : β → α} {a b : α} {x : filter β} [ne_bot x]
-  (lim : tendsto f x (𝓝 a)) (h : ∀ᶠ c in x, b ≤ f c) : b ≤ a :=
-le_of_tendsto_of_tendsto tendsto_const_nhds lim h
-
-lemma ge_of_tendsto' {f : β → α} {a b : α} {x : filter β} [ne_bot x]
-  (lim : tendsto f x (𝓝 a)) (h : ∀ c, b ≤ f c) : b ≤ a :=
-ge_of_tendsto lim (eventually_of_forall h)
-
-@[simp]
-lemma closure_le_eq [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
-  closure {b | f b ≤ g b} = {b | f b ≤ g b} :=
-(is_closed_le hf hg).closure_eq
-
-lemma closure_lt_subset_le [topological_space β] {f g : β → α} (hf : continuous f)
-  (hg : continuous g) :
-  closure {b | f b < g b} ⊆ {b | f b ≤ g b} :=
-closure_minimal (λ x, le_of_lt) $ is_closed_le hf hg
-
-lemma continuous_within_at.closure_le [topological_space β]
- {f g : β → α} {s : set β} {x : β} (hx : x ∈ closure s)
- (hf : continuous_within_at f s x)
- (hg : continuous_within_at g s x)
- (h : ∀ y ∈ s, f y ≤ g y) : f x ≤ g x :=
-show (f x, g x) ∈ {p : α × α | p.1 ≤ p.2},
-from order_closed_topology.is_closed_le'.closure_subset ((hf.prod hg).mem_closure hx h)
-
-/-- If `s` is a closed set and two functions `f` and `g` are continuous on `s`,
-then the set `{x ∈ s | f x ≤ g x}` is a closed set. -/
-lemma is_closed.is_closed_le [topological_space β] {f g : β → α} {s : set β} (hs : is_closed s)
-  (hf : continuous_on f s) (hg : continuous_on g s) :
-  is_closed {x ∈ s | f x ≤ g x} :=
-(hf.prod hg).preimage_closed_of_closed hs order_closed_topology.is_closed_le'
-
-lemma le_on_closure [topological_space β] {f g : β → α} {s : set β} (h : ∀ x ∈ s, f x ≤ g x)
-  (hf : continuous_on f (closure s)) (hg : continuous_on g (closure s)) ⦃x⦄ (hx : x ∈ closure s) :
-  f x ≤ g x :=
-have s ⊆ {y ∈ closure s | f y ≤ g y}, from λ y hy, ⟨subset_closure hy, h y hy⟩,
-(closure_minimal this (is_closed_closure.is_closed_le hf hg) hx).2
-
-lemma is_closed.epigraph [topological_space β] {f : β → α} {s : set β}
-  (hs : is_closed s) (hf : continuous_on f s) :
-  is_closed {p : β × α | p.1 ∈ s ∧ f p.1 ≤ p.2} :=
-(hs.preimage continuous_fst).is_closed_le (hf.comp continuous_on_fst subset.rfl) continuous_on_snd
-
-lemma is_closed.hypograph [topological_space β] {f : β → α} {s : set β}
-  (hs : is_closed s) (hf : continuous_on f s) :
-  is_closed {p : β × α | p.1 ∈ s ∧ p.2 ≤ f p.1} :=
-(hs.preimage continuous_fst).is_closed_le continuous_on_snd (hf.comp continuous_on_fst subset.rfl)
-
-omit t
-
-lemma nhds_within_Ici_ne_bot {a b : α} (H₂ : a ≤ b) :
-  ne_bot (𝓝[Ici a] b) :=
-nhds_within_ne_bot_of_mem H₂
-
-@[instance] lemma nhds_within_Ici_self_ne_bot (a : α) :
-  ne_bot (𝓝[≥] a) :=
-nhds_within_Ici_ne_bot (le_refl a)
-
-lemma nhds_within_Iic_ne_bot {a b : α} (H : a ≤ b) :
-  ne_bot (𝓝[Iic b] a) :=
-nhds_within_ne_bot_of_mem H
-
-@[instance] lemma nhds_within_Iic_self_ne_bot (a : α) :
-  ne_bot (𝓝[≤] a) :=
-nhds_within_Iic_ne_bot (le_refl a)
-
-end preorder
-
-section partial_order
-variables [topological_space α] [partial_order α] [t : order_closed_topology α]
-include t
-
-private lemma is_closed_eq_aux : is_closed {p : α × α | p.1 = p.2} :=
-by simp only [le_antisymm_iff];
-   exact is_closed.inter t.is_closed_le' (is_closed_le continuous_snd continuous_fst)
-
-@[priority 90] -- see Note [lower instance priority]
-instance order_closed_topology.to_t2_space : t2_space α :=
-{ t2 :=
-  have is_open {p : α × α | p.1 ≠ p.2} := is_closed_eq_aux.is_open_compl,
-  assume a b h,
-  let ⟨u, v, hu, hv, ha, hb, h⟩ := is_open_prod_iff.mp this a b h in
-  ⟨u, v, hu, hv, ha, hb,
-    set.eq_empty_iff_forall_not_mem.2 $ assume a ⟨h₁, h₂⟩,
-    have a ≠ a, from @h (a, a) ⟨h₁, h₂⟩,
-    this rfl⟩ }
-
-end partial_order
-
-section linear_order
-variables [topological_space α] [linear_order α] [order_closed_topology α]
-
-lemma is_open_lt_prod : is_open {p : α × α | p.1 < p.2} :=
-by { simp_rw [← is_closed_compl_iff, compl_set_of, not_lt],
-     exact is_closed_le continuous_snd continuous_fst }
-
-lemma is_open_lt [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
-  is_open {b | f b < g b} :=
-by simp [lt_iff_not_ge, -not_le]; exact (is_closed_le hg hf).is_open_compl
-
-variables {a b : α}
-
-lemma is_open_Iio : is_open (Iio a) :=
-is_open_lt continuous_id continuous_const
-
-lemma is_open_Ioi : is_open (Ioi a) :=
-is_open_lt continuous_const continuous_id
-
-lemma is_open_Ioo : is_open (Ioo a b) :=
-is_open.inter is_open_Ioi is_open_Iio
-
-@[simp] lemma interior_Ioi : interior (Ioi a) = Ioi a :=
-is_open_Ioi.interior_eq
-
-@[simp] lemma interior_Iio : interior (Iio a) = Iio a :=
-is_open_Iio.interior_eq
-
-@[simp] lemma interior_Ioo : interior (Ioo a b) = Ioo a b :=
-is_open_Ioo.interior_eq
-
-lemma Ioo_subset_closure_interior : Ioo a b ⊆ closure (interior (Ioo a b)) :=
-by simp only [interior_Ioo, subset_closure]
-
-lemma Iio_mem_nhds {a b : α} (h : a < b) : Iio b ∈ 𝓝 a :=
-is_open.mem_nhds is_open_Iio h
-
-lemma Ioi_mem_nhds {a b : α} (h : a < b) : Ioi a ∈ 𝓝 b :=
-is_open.mem_nhds is_open_Ioi h
-
-lemma Iic_mem_nhds {a b : α} (h : a < b) : Iic b ∈ 𝓝 a :=
-mem_of_superset (Iio_mem_nhds h) Iio_subset_Iic_self
-
-lemma Ici_mem_nhds {a b : α} (h : a < b) : Ici a ∈ 𝓝 b :=
-mem_of_superset (Ioi_mem_nhds h) Ioi_subset_Ici_self
-
-lemma Ioo_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Ioo a b ∈ 𝓝 x :=
-is_open.mem_nhds is_open_Ioo ⟨ha, hb⟩
-
-lemma Ioc_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Ioc a b ∈ 𝓝 x :=
-mem_of_superset (Ioo_mem_nhds ha hb) Ioo_subset_Ioc_self
-
-lemma Ico_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Ico a b ∈ 𝓝 x :=
-mem_of_superset (Ioo_mem_nhds ha hb) Ioo_subset_Ico_self
-
-lemma Icc_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Icc a b ∈ 𝓝 x :=
-mem_of_superset (Ioo_mem_nhds ha hb) Ioo_subset_Icc_self
-
-lemma eventually_lt_of_tendsto_lt {l : filter γ} {f : γ → α} {u v : α} (hv : v < u)
-  (h : filter.tendsto f l (𝓝 v)) : ∀ᶠ a in l, f a < u :=
-tendsto_nhds.1 h (< u) is_open_Iio hv
-
-lemma eventually_gt_of_tendsto_gt {l : filter γ} {f : γ → α} {u v : α} (hv : u < v)
-  (h : filter.tendsto f l (𝓝 v)) : ∀ᶠ a in l, u < f a :=
-tendsto_nhds.1 h (> u) is_open_Ioi hv
-
-lemma eventually_le_of_tendsto_lt {l : filter γ} {f : γ → α} {u v : α} (hv : v < u)
-  (h : tendsto f l (𝓝 v)) : ∀ᶠ a in l, f a ≤ u :=
-(eventually_lt_of_tendsto_lt hv h).mono (λ v, le_of_lt)
-
-lemma eventually_ge_of_tendsto_gt {l : filter γ} {f : γ → α} {u v : α} (hv : u < v)
-  (h : tendsto f l (𝓝 v)) : ∀ᶠ a in l, u ≤ f a :=
-(eventually_gt_of_tendsto_gt hv h).mono (λ v, le_of_lt)
-
-variables [topological_space γ]
-/-!
-### Neighborhoods to the left and to the right on an `order_closed_topology`
-
-Limits to the left and to the right of real functions are defined in terms of neighborhoods to
-the left and to the right, either open or closed, i.e., members of `𝓝[>] a` and
-`𝓝[≥] a` on the right, and similarly on the left. Here we simply prove that all
-right-neighborhoods of a point are equal, and we'll prove later other useful characterizations which
-require the stronger hypothesis `order_topology α` -/
-
-/-!
-#### Right neighborhoods, point excluded
--/
-
-lemma Ioo_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
-  Ioo a c ∈ 𝓝[>] b :=
-mem_nhds_within.2 ⟨Iio c, is_open_Iio, H.2,
-  by rw [inter_comm, Ioi_inter_Iio]; exact Ioo_subset_Ioo_left H.1⟩
-
-lemma Ioc_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
-  Ioc a c ∈ 𝓝[>] b :=
-mem_of_superset (Ioo_mem_nhds_within_Ioi H) Ioo_subset_Ioc_self
-
-lemma Ico_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
-  Ico a c ∈ 𝓝[>] b :=
-mem_of_superset (Ioo_mem_nhds_within_Ioi H) Ioo_subset_Ico_self
-
-lemma Icc_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
-  Icc a c ∈ 𝓝[>] b :=
-mem_of_superset (Ioo_mem_nhds_within_Ioi H) Ioo_subset_Icc_self
-
-@[simp] lemma nhds_within_Ioc_eq_nhds_within_Ioi {a b : α} (h : a < b) :
-  𝓝[Ioc a b] a = 𝓝[>] a :=
-le_antisymm (nhds_within_mono _ Ioc_subset_Ioi_self) $
-  nhds_within_le_of_mem $ Ioc_mem_nhds_within_Ioi $ left_mem_Ico.2 h
-
-@[simp] lemma nhds_within_Ioo_eq_nhds_within_Ioi {a b : α} (h : a < b) :
-  𝓝[Ioo a b] a = 𝓝[>] a :=
-le_antisymm (nhds_within_mono _ Ioo_subset_Ioi_self) $
-  nhds_within_le_of_mem $ Ioo_mem_nhds_within_Ioi $ left_mem_Ico.2 h
-
-@[simp]
-lemma continuous_within_at_Ioc_iff_Ioi [topological_space β] {a b : α} {f : α → β} (h : a < b) :
-  continuous_within_at f (Ioc a b) a ↔ continuous_within_at f (Ioi a) a :=
-by simp only [continuous_within_at, nhds_within_Ioc_eq_nhds_within_Ioi h]
-
-@[simp]
-lemma continuous_within_at_Ioo_iff_Ioi [topological_space β] {a b : α} {f : α → β} (h : a < b) :
-  continuous_within_at f (Ioo a b) a ↔ continuous_within_at f (Ioi a) a :=
-by simp only [continuous_within_at, nhds_within_Ioo_eq_nhds_within_Ioi h]
-
-/-!
-#### Left neighborhoods, point excluded
--/
-
-lemma Ioo_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
-  Ioo a c ∈ 𝓝[<] b :=
-by simpa only [dual_Ioo] using Ioo_mem_nhds_within_Ioi
-  (show to_dual b ∈ Ico (to_dual c) (to_dual a), from H.symm)
-
-lemma Ico_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
-  Ico a c ∈ 𝓝[<] b :=
-mem_of_superset (Ioo_mem_nhds_within_Iio H) Ioo_subset_Ico_self
-
-lemma Ioc_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
-  Ioc a c ∈ 𝓝[<] b :=
-mem_of_superset (Ioo_mem_nhds_within_Iio H) Ioo_subset_Ioc_self
-
-lemma Icc_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
-  Icc a c ∈ 𝓝[<] b :=
-mem_of_superset (Ioo_mem_nhds_within_Iio H) Ioo_subset_Icc_self
-
-@[simp] lemma nhds_within_Ico_eq_nhds_within_Iio {a b : α} (h : a < b) :
-  𝓝[Ico a b] b = 𝓝[<] b :=
-by simpa only [dual_Ioc] using nhds_within_Ioc_eq_nhds_within_Ioi h.dual
-
-@[simp] lemma nhds_within_Ioo_eq_nhds_within_Iio {a b : α} (h : a < b) :
-  𝓝[Ioo a b] b = 𝓝[<] b :=
-by simpa only [dual_Ioo] using nhds_within_Ioo_eq_nhds_within_Ioi h.dual
-
-@[simp] lemma continuous_within_at_Ico_iff_Iio {a b : α} {f : α → γ} (h : a < b) :
-  continuous_within_at f (Ico a b) b ↔ continuous_within_at f (Iio b) b :=
-by simp only [continuous_within_at, nhds_within_Ico_eq_nhds_within_Iio h]
-
-@[simp] lemma continuous_within_at_Ioo_iff_Iio {a b : α} {f : α → γ} (h : a < b) :
-  continuous_within_at f (Ioo a b) b ↔ continuous_within_at f (Iio b) b :=
-by simp only [continuous_within_at, nhds_within_Ioo_eq_nhds_within_Iio h]
-
-/-!
-#### Right neighborhoods, point included
--/
-
-lemma Ioo_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ioo a c) :
-  Ioo a c ∈ 𝓝[≥] b :=
-mem_nhds_within_of_mem_nhds $ is_open.mem_nhds is_open_Ioo H
-
-lemma Ioc_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ioo a c) :
-  Ioc a c ∈ 𝓝[≥] b :=
-mem_of_superset (Ioo_mem_nhds_within_Ici H) Ioo_subset_Ioc_self
-
-lemma Ico_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ico a c) :
-  Ico a c ∈ 𝓝[≥] b :=
-mem_nhds_within.2 ⟨Iio c, is_open_Iio, H.2,
-  by simp only [inter_comm, Ici_inter_Iio, Ico_subset_Ico_left H.1]⟩
-
-lemma Icc_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ico a c) :
-  Icc a c ∈ 𝓝[≥] b :=
-mem_of_superset (Ico_mem_nhds_within_Ici H) Ico_subset_Icc_self
-
-@[simp] lemma nhds_within_Icc_eq_nhds_within_Ici {a b : α} (h : a < b) :
-  𝓝[Icc a b] a = 𝓝[≥] a :=
-le_antisymm (nhds_within_mono _ Icc_subset_Ici_self) $
-  nhds_within_le_of_mem $ Icc_mem_nhds_within_Ici $ left_mem_Ico.2 h
-
-@[simp] lemma nhds_within_Ico_eq_nhds_within_Ici {a b : α} (h : a < b) :
-  𝓝[Ico a b] a = 𝓝[≥] a :=
-le_antisymm (nhds_within_mono _ (λ x, and.left)) $
-  nhds_within_le_of_mem $ Ico_mem_nhds_within_Ici $ left_mem_Ico.2 h
-
-@[simp]
-lemma continuous_within_at_Icc_iff_Ici [topological_space β] {a b : α} {f : α → β} (h : a < b) :
-  continuous_within_at f (Icc a b) a ↔ continuous_within_at f (Ici a) a :=
-by simp only [continuous_within_at, nhds_within_Icc_eq_nhds_within_Ici h]
-
-@[simp]
-lemma continuous_within_at_Ico_iff_Ici [topological_space β] {a b : α} {f : α → β} (h : a < b) :
-  continuous_within_at f (Ico a b) a ↔ continuous_within_at f (Ici a) a :=
-by simp only [continuous_within_at, nhds_within_Ico_eq_nhds_within_Ici h]
-
-/-!
-#### Left neighborhoods, point included
--/
-
-lemma Ioo_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioo a c) :
-  Ioo a c ∈ 𝓝[≤] b :=
-mem_nhds_within_of_mem_nhds $ is_open.mem_nhds is_open_Ioo H
-
-lemma Ico_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioo a c) :
-  Ico a c ∈ 𝓝[≤] b :=
-mem_of_superset (Ioo_mem_nhds_within_Iic H) Ioo_subset_Ico_self
-
-lemma Ioc_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioc a c) :
-  Ioc a c ∈ 𝓝[≤] b :=
-by simpa only [dual_Ico] using Ico_mem_nhds_within_Ici
-  (show to_dual b ∈ Ico (to_dual c) (to_dual a), from H.symm)
-
-lemma Icc_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioc a c) :
-  Icc a c ∈ 𝓝[≤] b :=
-mem_of_superset (Ioc_mem_nhds_within_Iic H) Ioc_subset_Icc_self
-
-@[simp] lemma nhds_within_Icc_eq_nhds_within_Iic {a b : α} (h : a < b) :
-  𝓝[Icc a b] b = 𝓝[≤] b :=
-by simpa only [dual_Icc] using nhds_within_Icc_eq_nhds_within_Ici h.dual
-
-@[simp] lemma nhds_within_Ioc_eq_nhds_within_Iic {a b : α} (h : a < b) :
-  𝓝[Ioc a b] b = 𝓝[≤] b :=
-by simpa only [dual_Ico] using nhds_within_Ico_eq_nhds_within_Ici h.dual
-
-@[simp]
-lemma continuous_within_at_Icc_iff_Iic [topological_space β] {a b : α} {f : α → β} (h : a < b) :
-  continuous_within_at f (Icc a b) b ↔ continuous_within_at f (Iic b) b :=
-by simp only [continuous_within_at, nhds_within_Icc_eq_nhds_within_Iic h]
-
-@[simp]
-lemma continuous_within_at_Ioc_iff_Iic [topological_space β] {a b : α} {f : α → β} (h : a < b) :
-  continuous_within_at f (Ioc a b) b ↔ continuous_within_at f (Iic b) b :=
-by simp only [continuous_within_at, nhds_within_Ioc_eq_nhds_within_Iic h]
-
-end linear_order
-
-section linear_order
-variables [topological_space α] [linear_order α] [order_closed_topology α] {f g : β → α}
-
-section
-variables [topological_space β]
-
-lemma lt_subset_interior_le (hf : continuous f) (hg : continuous g) :
-  {b | f b < g b} ⊆ interior {b | f b ≤ g b} :=
-interior_maximal (λ p, le_of_lt) $ is_open_lt hf hg
-
-lemma frontier_le_subset_eq (hf : continuous f) (hg : continuous g) :
-  frontier {b | f b ≤ g b} ⊆ {b | f b = g b} :=
-begin
-  rw [frontier_eq_closure_inter_closure, closure_le_eq hf hg],
-  rintros b ⟨hb₁, hb₂⟩,
-  refine le_antisymm hb₁ (closure_lt_subset_le hg hf _),
-  convert hb₂ using 2, simp only [not_le.symm], refl
-end
-
-lemma frontier_Iic_subset (a : α) : frontier (Iic a) ⊆ {a} :=
-frontier_le_subset_eq (@continuous_id α _) continuous_const
-
-lemma frontier_Ici_subset (a : α) : frontier (Ici a) ⊆ {a} := @frontier_Iic_subset αᵒᵈ _ _ _ _
-
-lemma frontier_lt_subset_eq (hf : continuous f) (hg : continuous g) :
-  frontier {b | f b < g b} ⊆ {b | f b = g b} :=
-by rw ← frontier_compl;
-   convert frontier_le_subset_eq hg hf; simp [ext_iff, eq_comm]
-
-lemma continuous_if_le [topological_space γ] [Π x, decidable (f x ≤ g x)]
-  {f' g' : β → γ} (hf : continuous f) (hg : continuous g)
-  (hf' : continuous_on f' {x | f x ≤ g x}) (hg' : continuous_on g' {x | g x ≤ f x})
-  (hfg : ∀ x, f x = g x → f' x = g' x) :
-  continuous (λ x, if f x ≤ g x then f' x else g' x) :=
-begin
-  refine continuous_if (λ a ha, hfg _ (frontier_le_subset_eq hf hg ha)) _ (hg'.mono _),
-  { rwa [(is_closed_le hf hg).closure_eq] },
-  { simp only [not_le], exact closure_lt_subset_le hg hf }
-end
-
-lemma continuous.if_le [topological_space γ] [Π x, decidable (f x ≤ g x)] {f' g' : β → γ}
-  (hf' : continuous f') (hg' : continuous g') (hf : continuous f) (hg : continuous g)
-  (hfg : ∀ x, f x = g x → f' x = g' x) :
-  continuous (λ x, if f x ≤ g x then f' x else g' x) :=
-continuous_if_le hf hg hf'.continuous_on hg'.continuous_on hfg
-
-lemma tendsto.eventually_lt {l : filter γ} {f g : γ → α} {y z : α}
-  (hf : tendsto f l (𝓝 y)) (hg : tendsto g l (𝓝 z)) (hyz : y < z) : ∀ᶠ x in l, f x < g x :=
-begin
-  by_cases h : y ⋖ z,
-  { filter_upwards [hf (Iio_mem_nhds hyz), hg (Ioi_mem_nhds hyz)],
-    rw [h.Iio_eq],
-    exact λ x hfx hgx, lt_of_le_of_lt hfx hgx },
-  { obtain ⟨w, hyw, hwz⟩ := (not_covby_iff hyz).mp h,
-    filter_upwards [hf (Iio_mem_nhds hyw), hg (Ioi_mem_nhds hwz)],
-    exact λ x, lt_trans },
-end
-
-lemma continuous_at.eventually_lt {x₀ : β} (hf : continuous_at f x₀)
-  (hg : continuous_at g x₀) (hfg : f x₀ < g x₀) : ∀ᶠ x in 𝓝 x₀, f x < g x :=
-tendsto.eventually_lt hf hg hfg
-
-@[continuity] lemma continuous.min (hf : continuous f) (hg : continuous g) :
-  continuous (λb, min (f b) (g b)) :=
-by { simp only [min_def], exact hf.if_le hg hf hg (λ x, id) }
-
-@[continuity] lemma continuous.max (hf : continuous f) (hg : continuous g) :
-  continuous (λb, max (f b) (g b)) :=
-@continuous.min αᵒᵈ _ _ _ _ _ _ _ hf hg
-
-end
-
-lemma continuous_min : continuous (λ p : α × α, min p.1 p.2) := continuous_fst.min continuous_snd
-
-lemma continuous_max : continuous (λ p : α × α, max p.1 p.2) := continuous_fst.max continuous_snd
-
-lemma filter.tendsto.max {b : filter β} {a₁ a₂ : α} (hf : tendsto f b (𝓝 a₁))
-  (hg : tendsto g b (𝓝 a₂)) :
-  tendsto (λb, max (f b) (g b)) b (𝓝 (max a₁ a₂)) :=
-(continuous_max.tendsto (a₁, a₂)).comp (hf.prod_mk_nhds hg)
-
-lemma filter.tendsto.min {b : filter β} {a₁ a₂ : α} (hf : tendsto f b (𝓝 a₁))
-  (hg : tendsto g b (𝓝 a₂)) :
-  tendsto (λb, min (f b) (g b)) b (𝓝 (min a₁ a₂)) :=
-(continuous_min.tendsto (a₁, a₂)).comp (hf.prod_mk_nhds hg)
-
-lemma dense.exists_lt [no_min_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, y < x :=
-hs.exists_mem_open is_open_Iio (exists_lt x)
-
-lemma dense.exists_gt [no_max_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, x < y :=
-hs.order_dual.exists_lt x
-
-lemma dense.exists_le [no_min_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, y ≤ x :=
-(hs.exists_lt x).imp $ λ y hy, ⟨hy.fst, hy.snd.le⟩
-
-lemma dense.exists_ge [no_max_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, x ≤ y :=
-hs.order_dual.exists_le x
-
-lemma dense.exists_le' {s : set α} (hs : dense s) (hbot : ∀ x, is_bot x → x ∈ s) (x : α) :
-  ∃ y ∈ s, y ≤ x :=
-begin
-  by_cases hx : is_bot x,
-  { exact ⟨x, hbot x hx, le_rfl⟩ },
-  { simp only [is_bot, not_forall, not_le] at hx,
-    rcases hs.exists_mem_open is_open_Iio hx with ⟨y, hys, hy : y < x⟩,
-    exact ⟨y, hys, hy.le⟩ }
-end
-
-lemma dense.exists_ge' {s : set α} (hs : dense s) (htop : ∀ x, is_top x → x ∈ s) (x : α) :
-  ∃ y ∈ s, x ≤ y :=
-hs.order_dual.exists_le' htop x
-
-lemma dense.exists_between [densely_ordered α] {s : set α} (hs : dense s) {x y : α} (h : x < y) :
-  ∃ z ∈ s, z ∈ Ioo x y :=
-hs.exists_mem_open is_open_Ioo (nonempty_Ioo.2 h)
-
-variables [nonempty α] [topological_space β]
-
-/-- A compact set is bounded below -/
-lemma is_compact.bdd_below {s : set α} (hs : is_compact s) : bdd_below s :=
-begin
-  by_contra H,
-  rcases hs.elim_finite_subcover_image (λ x (_ : x ∈ s), @is_open_Ioi _ _ _ _ x) _
-    with ⟨t, st, ft, ht⟩,
-  { refine H (ft.bdd_below.imp $ λ C hC y hy, _),
-    rcases mem_Union₂.1 (ht hy) with ⟨x, hx, xy⟩,
-    exact le_trans (hC hx) (le_of_lt xy) },
-  { refine λ x hx, mem_Union₂.2 (not_imp_comm.1 _ H),
-    exact λ h, ⟨x, λ y hy, le_of_not_lt (h.imp $ λ ys, ⟨_, hy, ys⟩)⟩ }
-end
-
-/-- A compact set is bounded above -/
-lemma is_compact.bdd_above {s : set α} (hs : is_compact s) : bdd_above s :=
-@is_compact.bdd_below αᵒᵈ _ _ _ _ _ hs
-
-/-- A continuous function is bounded below on a compact set. -/
-lemma is_compact.bdd_below_image {f : β → α} {K : set β}
-  (hK : is_compact K) (hf : continuous_on f K) : bdd_below (f '' K) :=
-(hK.image_of_continuous_on hf).bdd_below
-
-/-- A continuous function is bounded above on a compact set. -/
-lemma is_compact.bdd_above_image {f : β → α} {K : set β}
-  (hK : is_compact K) (hf : continuous_on f K) : bdd_above (f '' K) :=
-@is_compact.bdd_below_image αᵒᵈ _ _ _ _ _ _ _ _ hK hf
-
-/-- A continuous function with compact support is bounded below. -/
-@[to_additive /-" A continuous function with compact support is bounded below. "-/]
-lemma continuous.bdd_below_range_of_has_compact_mul_support [has_one α] {f : β → α}
-  (hf : continuous f) (h : has_compact_mul_support f) : bdd_below (range f) :=
-(h.is_compact_range hf).bdd_below
-
-/-- A continuous function with compact support is bounded above. -/
-@[to_additive /-" A continuous function with compact support is bounded above. "-/]
-lemma continuous.bdd_above_range_of_has_compact_mul_support [has_one α]
-  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
-  bdd_above (range f) :=
-@continuous.bdd_below_range_of_has_compact_mul_support αᵒᵈ _ _ _ _ _ _ _ _ hf h
-
-end linear_order
-
-end order_closed_topology
-
-instance [preorder α] [topological_space α] [order_closed_topology α]
-  [preorder β] [topological_space β] [order_closed_topology β] :
-  order_closed_topology (α × β) :=
-⟨(is_closed_le (continuous_fst.comp continuous_fst) (continuous_fst.comp continuous_snd)).inter
-  (is_closed_le (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd))⟩
-
-instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
-  [Π i, order_closed_topology (α i)] : order_closed_topology (Π i, α i) :=
-begin
-  constructor,
-  simp only [pi.le_def, set_of_forall],
-  exact is_closed_Inter (λ i, is_closed_le ((continuous_apply i).comp continuous_fst)
-    ((continuous_apply i).comp continuous_snd))
-end
-
-instance pi.order_closed_topology' [preorder β] [topological_space β]
-  [order_closed_topology β] : order_closed_topology (α → β) :=
-pi.order_closed_topology
-
-/-- The order topology on an ordered type is the topology generated by open intervals. We register
-it on a preorder, but it is mostly interesting in linear orders, where it is also order-closed.
-We define it as a mixin. If you want to introduce the order topology on a preorder, use
-`preorder.topology`. -/
-class order_topology (α : Type*) [t : topological_space α] [preorder α] : Prop :=
-(topology_eq_generate_intervals : t = generate_from {s | ∃a, s = Ioi a ∨ s = Iio a})
-
-/-- (Order) topology on a partial order `α` generated by the subbase of open intervals
-`(a, ∞) = { x ∣ a < x }, (-∞ , b) = {x ∣ x < b}` for all `a, b` in `α`. We do not register it as an
-instance as many ordered sets are already endowed with the same topology, most often in a non-defeq
-way though. Register as a local instance when necessary. -/
-def preorder.topology (α : Type*) [preorder α] : topological_space α :=
-generate_from {s : set α | ∃ (a : α), s = {b : α | a < b} ∨ s = {b : α | b < a}}
-
-section order_topology
-
-instance {α : Type*} [topological_space α] [partial_order α] [order_topology α] :
-  order_topology αᵒᵈ :=
-⟨by convert @order_topology.topology_eq_generate_intervals α _ _ _;
-  conv in (_ ∨ _) { rw or.comm }; refl⟩
-
-section partial_order
-variables [topological_space α] [partial_order α] [t : order_topology α]
-include t
-
-lemma is_open_iff_generate_intervals {s : set α} :
-  is_open s ↔ generate_open {s | ∃a, s = Ioi a ∨ s = Iio a} s :=
-by rw [t.topology_eq_generate_intervals]; refl
-
-lemma is_open_lt' (a : α) : is_open {b:α | a < b} :=
-by rw [@is_open_iff_generate_intervals α _ _ t]; exact generate_open.basic _ ⟨a, or.inl rfl⟩
-
-lemma is_open_gt' (a : α) : is_open {b:α | b < a} :=
-by rw [@is_open_iff_generate_intervals α _ _ t]; exact generate_open.basic _ ⟨a, or.inr rfl⟩
-
-lemma lt_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 b, a < x :=
-is_open.mem_nhds (is_open_lt' _) h
-
-lemma le_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 b, a ≤ x :=
-(𝓝 b).sets_of_superset (lt_mem_nhds h) $ assume b hb, le_of_lt hb
-
-lemma gt_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 a, x < b :=
-is_open.mem_nhds (is_open_gt' _) h
-
-lemma ge_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 a, x ≤ b :=
-(𝓝 a).sets_of_superset (gt_mem_nhds h) $ assume b hb, le_of_lt hb
-
-lemma nhds_eq_order (a : α) :
-  𝓝 a = (⨅b ∈ Iio a, 𝓟 (Ioi b)) ⊓ (⨅b ∈ Ioi a, 𝓟 (Iio b)) :=
-by rw [t.topology_eq_generate_intervals, nhds_generate_from];
-from le_antisymm
-  (le_inf
-    (le_infi₂ $ assume b hb, infi_le_of_le {c : α | b < c} $ infi_le _ ⟨hb, b, or.inl rfl⟩)
-    (le_infi₂ $ assume b hb, infi_le_of_le {c : α | c < b} $ infi_le _ ⟨hb, b, or.inr rfl⟩))
-  (le_infi $ assume s, le_infi $ assume ⟨ha, b, hs⟩,
-    match s, ha, hs with
-    | _, h, (or.inl rfl) := inf_le_of_left_le $ infi_le_of_le b $ infi_le _ h
-    | _, h, (or.inr rfl) := inf_le_of_right_le $ infi_le_of_le b $ infi_le _ h
-    end)
-
-lemma tendsto_order {f : β → α} {a : α} {x : filter β} :
-  tendsto f x (𝓝 a) ↔ (∀ a' < a, ∀ᶠ b in x, a' < f b) ∧ (∀ a' > a, ∀ᶠ b in x, f b < a') :=
-by simp [nhds_eq_order a, tendsto_inf, tendsto_infi, tendsto_principal]
-
-instance tendsto_Icc_class_nhds (a : α) : tendsto_Ixx_class Icc (𝓝 a) (𝓝 a) :=
-begin
-  simp only [nhds_eq_order, infi_subtype'],
-  refine ((has_basis_infi_principal_finite _).inf
-    (has_basis_infi_principal_finite _)).tendsto_Ixx_class (λ s hs, _),
-  refine ((ord_connected_bInter _).inter (ord_connected_bInter _)).out; intros _ _,
-  exacts [ord_connected_Ioi, ord_connected_Iio]
-end
-
-instance tendsto_Ico_class_nhds (a : α) : tendsto_Ixx_class Ico (𝓝 a) (𝓝 a) :=
-tendsto_Ixx_class_of_subset (λ _ _, Ico_subset_Icc_self)
-
-instance tendsto_Ioc_class_nhds (a : α) : tendsto_Ixx_class Ioc (𝓝 a) (𝓝 a) :=
-tendsto_Ixx_class_of_subset (λ _ _, Ioc_subset_Icc_self)
-
-instance tendsto_Ioo_class_nhds (a : α) : tendsto_Ixx_class Ioo (𝓝 a) (𝓝 a) :=
-tendsto_Ixx_class_of_subset (λ _ _, Ioo_subset_Icc_self)
-
-/-- Also known as squeeze or sandwich theorem. This version assumes that inequalities hold
-eventually for the filter. -/
-lemma tendsto_of_tendsto_of_tendsto_of_le_of_le' {f g h : β → α} {b : filter β} {a : α}
-  (hg : tendsto g b (𝓝 a)) (hh : tendsto h b (𝓝 a))
-  (hgf : ∀ᶠ b in b, g b ≤ f b) (hfh : ∀ᶠ b in b, f b ≤ h b) :
-  tendsto f b (𝓝 a) :=
-tendsto_order.2
-  ⟨assume a' h',
-    have ∀ᶠ b in b, a' < g b, from (tendsto_order.1 hg).left a' h',
-    by filter_upwards [this, hgf] with _ using lt_of_lt_of_le,
-    assume a' h',
-    have ∀ᶠ b in b, h b < a', from (tendsto_order.1 hh).right a' h',
-    by filter_upwards [this, hfh] with a h₁ h₂ using lt_of_le_of_lt h₂ h₁⟩
-
-/-- Also known as squeeze or sandwich theorem. This version assumes that inequalities hold
-everywhere. -/
-lemma tendsto_of_tendsto_of_tendsto_of_le_of_le {f g h : β → α} {b : filter β} {a : α}
-  (hg : tendsto g b (𝓝 a)) (hh : tendsto h b (𝓝 a)) (hgf : g ≤ f) (hfh : f ≤ h) :
-  tendsto f b (𝓝 a) :=
-tendsto_of_tendsto_of_tendsto_of_le_of_le' hg hh
-  (eventually_of_forall hgf) (eventually_of_forall hfh)
-
-lemma nhds_order_unbounded {a : α} (hu : ∃u, a < u) (hl : ∃l, l < a) :
-  𝓝 a = (⨅l (h₂ : l < a) u (h₂ : a < u), 𝓟 (Ioo l u)) :=
-have ∃ u, u ∈ Ioi a, from hu, have ∃ l, l ∈ Iio a, from hl,
-by { simp only [nhds_eq_order, inf_binfi, binfi_inf, *, inf_principal, Ioi_inter_Iio], refl }
-
-lemma tendsto_order_unbounded {f : β → α} {a : α} {x : filter β}
-  (hu : ∃u, a < u) (hl : ∃l, l < a) (h : ∀l u, l < a → a < u → ∀ᶠ b in x, l < f b ∧ f b < u) :
-  tendsto f x (𝓝 a) :=
-by rw [nhds_order_unbounded hu hl];
-from (tendsto_infi.2 $ assume l, tendsto_infi.2 $ assume hl,
-  tendsto_infi.2 $ assume u, tendsto_infi.2 $ assume hu, tendsto_principal.2 $ h l u hl hu)
-
-end partial_order
-
-instance tendsto_Ixx_nhds_within {α : Type*} [preorder α] [topological_space α]
-  (a : α) {s t : set α} {Ixx}
-  [tendsto_Ixx_class Ixx (𝓝 a) (𝓝 a)] [tendsto_Ixx_class Ixx (𝓟 s) (𝓟 t)]:
-  tendsto_Ixx_class Ixx (𝓝[s] a) (𝓝[t] a) :=
-filter.tendsto_Ixx_class_inf
-
-instance tendsto_Icc_class_nhds_pi {ι : Type*} {α : ι → Type*}
-  [Π i, partial_order (α i)] [Π i, topological_space (α i)] [∀ i, order_topology (α i)]
-  (f : Π i, α i) :
-  tendsto_Ixx_class Icc (𝓝 f) (𝓝 f) :=
-begin
-  constructor,
-  conv in ((𝓝 f).small_sets) { rw [nhds_pi, filter.pi] },
-  simp only [small_sets_infi, small_sets_comap, tendsto_infi, tendsto_lift', (∘), mem_powerset_iff],
-  intros i s hs,
-  have : tendsto (λ g : Π i, α i, g i) (𝓝 f) (𝓝 (f i)) := ((continuous_apply i).tendsto f),
-  refine (tendsto_lift'.1 ((this.comp tendsto_fst).Icc (this.comp tendsto_snd)) s hs).mono _,
-  exact λ p hp g hg, hp ⟨hg.1 _, hg.2 _⟩
-end
-
-theorem induced_order_topology' {α : Type u} {β : Type v}
-  [partial_order α] [ta : topological_space β] [partial_order β] [order_topology β]
-  (f : α → β) (hf : ∀ {x y}, f x < f y ↔ x < y)
-  (H₁ : ∀ {a x}, x < f a → ∃ b < a, x ≤ f b)
-  (H₂ : ∀ {a x}, f a < x → ∃ b > a, f b ≤ x) :
-  @order_topology _ (induced f ta) _ :=
-begin
-  letI := induced f ta,
-  refine ⟨eq_of_nhds_eq_nhds (λ a, _)⟩,
-  rw [nhds_induced, nhds_generate_from, nhds_eq_order (f a)],
-  apply le_antisymm,
-  { refine le_infi (λ s, le_infi $ λ hs, le_principal_iff.2 _),
-    rcases hs with ⟨ab, b, rfl|rfl⟩,
-    { exact mem_comap.2 ⟨{x | f b < x},
-        mem_inf_of_left $ mem_infi_of_mem _ $ mem_infi_of_mem (hf.2 ab) $ mem_principal_self _,
-        λ x, hf.1⟩ },
-    { exact mem_comap.2 ⟨{x | x < f b},
-        mem_inf_of_right $ mem_infi_of_mem _ $ mem_infi_of_mem (hf.2 ab) $ mem_principal_self _,
-        λ x, hf.1⟩ } },
-  { rw [← map_le_iff_le_comap],
-    refine le_inf _ _; refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _); simp,
-    { rcases H₁ h with ⟨b, ab, xb⟩,
-      refine mem_infi_of_mem _ (mem_infi_of_mem ⟨ab, b, or.inl rfl⟩ (mem_principal.2 _)),
-      exact λ c hc, lt_of_le_of_lt xb (hf.2 hc) },
-    { rcases H₂ h with ⟨b, ab, xb⟩,
-      refine mem_infi_of_mem _ (mem_infi_of_mem ⟨ab, b, or.inr rfl⟩ (mem_principal.2 _)),
-      exact λ c hc, lt_of_lt_of_le (hf.2 hc) xb } },
-end
-
-theorem induced_order_topology {α : Type u} {β : Type v}
-  [partial_order α] [ta : topological_space β] [partial_order β] [order_topology β]
-  (f : α → β) (hf : ∀ {x y}, f x < f y ↔ x < y)
-  (H : ∀ {x y}, x < y → ∃ a, x < f a ∧ f a < y) :
-  @order_topology _ (induced f ta) _ :=
-induced_order_topology' f @hf
-  (λ a x xa, let ⟨b, xb, ba⟩ := H xa in ⟨b, hf.1 ba, le_of_lt xb⟩)
-  (λ a x ax, let ⟨b, ab, bx⟩ := H ax in ⟨b, hf.1 ab, le_of_lt bx⟩)
-
-/-- On an `ord_connected` subset of a linear order, the order topology for the restriction of the
-order is the same as the restriction to the subset of the order topology. -/
-instance order_topology_of_ord_connected {α : Type u}
-  [ta : topological_space α] [linear_order α] [order_topology α]
-  {t : set α} [ht : ord_connected t] :
-  order_topology t :=
-begin
-  letI := induced (coe : t → α) ta,
-  refine ⟨eq_of_nhds_eq_nhds (λ a, _)⟩,
-  rw [nhds_induced, nhds_generate_from, nhds_eq_order (a : α)],
-  apply le_antisymm,
-  { refine le_infi (λ s, le_infi $ λ hs, le_principal_iff.2 _),
-    rcases hs with ⟨ab, b, rfl|rfl⟩,
-    { refine ⟨Ioi b, _, λ _, id⟩,
-      refine mem_inf_of_left (mem_infi_of_mem b _),
-      exact mem_infi_of_mem ab (mem_principal_self (Ioi ↑b)) },
-    { refine ⟨Iio b, _, λ _, id⟩,
-      refine mem_inf_of_right (mem_infi_of_mem b _),
-      exact mem_infi_of_mem ab (mem_principal_self (Iio b)) } },
-  { rw [← map_le_iff_le_comap],
-    refine le_inf _ _,
-    { refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _),
-      by_cases hx : x ∈ t,
-      { refine mem_infi_of_mem (Ioi ⟨x, hx⟩) (mem_infi_of_mem ⟨h, ⟨⟨x, hx⟩, or.inl rfl⟩⟩ _),
-        exact λ _, id },
-      simp only [set_coe.exists, mem_set_of_eq, mem_map'],
-      convert univ_sets _,
-      suffices hx' : ∀ (y : t), ↑y ∈ Ioi x,
-      { simp [hx'] },
-      intros y,
-      revert hx,
-      contrapose!,
-      -- here we use the `ord_connected` hypothesis
-      exact λ hx, ht.out y.2 a.2 ⟨le_of_not_gt hx, le_of_lt h⟩ },
-    { refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _),
-      by_cases hx : x ∈ t,
-      { refine mem_infi_of_mem (Iio ⟨x, hx⟩) (mem_infi_of_mem ⟨h, ⟨⟨x, hx⟩, or.inr rfl⟩⟩ _),
-        exact λ _, id },
-      simp only [set_coe.exists, mem_set_of_eq, mem_map'],
-      convert univ_sets _,
-      suffices hx' : ∀ (y : t), ↑y ∈ Iio x,
-      { simp [hx'] },
-      intros y,
-      revert hx,
-      contrapose!,
-      -- here we use the `ord_connected` hypothesis
-      exact λ hx, ht.out a.2 y.2 ⟨le_of_lt h, le_of_not_gt hx⟩ } }
-end
-
-lemma nhds_top_order [topological_space α] [partial_order α] [order_top α] [order_topology α] :
-  𝓝 (⊤:α) = (⨅l (h₂ : l < ⊤), 𝓟 (Ioi l)) :=
-by simp [nhds_eq_order (⊤:α)]
-
-lemma nhds_bot_order [topological_space α] [partial_order α] [order_bot α] [order_topology α] :
-  𝓝 (⊥:α) = (⨅l (h₂ : ⊥ < l), 𝓟 (Iio l)) :=
-by simp [nhds_eq_order (⊥:α)]
-
-lemma nhds_top_basis [topological_space α] [linear_order α] [order_top α] [order_topology α]
-  [nontrivial α] :
-  (𝓝 ⊤).has_basis (λ a : α, a < ⊤) (λ a : α, Ioi a) :=
-⟨ begin
-    simp only [nhds_top_order],
-    refine @filter.mem_binfi_of_directed α α (λ a, 𝓟 (Ioi a)) (λ a, a < ⊤) _ _,
-    { rintros a (ha : a < ⊤) b (hb : b < ⊤),
-      use a ⊔ b,
-      simp only [filter.le_principal_iff, ge_iff_le, order.preimage],
-      exact ⟨sup_lt_iff.mpr ⟨ha, hb⟩, Ioi_subset_Ioi le_sup_left, Ioi_subset_Ioi le_sup_right⟩ },
-    { obtain ⟨a, ha⟩ : ∃ a : α, a ≠ ⊤ := exists_ne ⊤,
-      exact ⟨a, lt_top_iff_ne_top.mpr ha⟩ }
-  end ⟩
-
-lemma nhds_bot_basis [topological_space α] [linear_order α] [order_bot α] [order_topology α]
-  [nontrivial α] :
-  (𝓝 ⊥).has_basis (λ a : α, ⊥ < a) (λ a : α, Iio a) :=
-@nhds_top_basis αᵒᵈ _ _ _ _ _
-
-lemma nhds_top_basis_Ici [topological_space α] [linear_order α] [order_top α] [order_topology α]
-  [nontrivial α] [densely_ordered α] :
-  (𝓝 ⊤).has_basis (λ a : α, a < ⊤) Ici :=
-nhds_top_basis.to_has_basis
-  (λ a ha, let ⟨b, hab, hb⟩ := exists_between ha in ⟨b, hb, Ici_subset_Ioi.mpr hab⟩)
-  (λ a ha, ⟨a, ha, Ioi_subset_Ici_self⟩)
-
-lemma nhds_bot_basis_Iic [topological_space α] [linear_order α] [order_bot α] [order_topology α]
-  [nontrivial α] [densely_ordered α] :
-  (𝓝 ⊥).has_basis (λ a : α, ⊥ < a) Iic :=
-@nhds_top_basis_Ici αᵒᵈ _ _ _ _ _ _
-
-lemma tendsto_nhds_top_mono [topological_space β] [partial_order β] [order_top β] [order_topology β]
-  {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊤)) (hg : f ≤ᶠ[l] g) :
-  tendsto g l (𝓝 ⊤) :=
-begin
-  simp only [nhds_top_order, tendsto_infi, tendsto_principal] at hf ⊢,
-  intros x hx,
-  filter_upwards [hf x hx, hg] with _ using lt_of_lt_of_le,
-end
-
-lemma tendsto_nhds_bot_mono [topological_space β] [partial_order β] [order_bot β] [order_topology β]
-  {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊥)) (hg : g ≤ᶠ[l] f) :
-  tendsto g l (𝓝 ⊥) :=
-@tendsto_nhds_top_mono α βᵒᵈ _ _ _ _ _ _ _ hf hg
-
-lemma tendsto_nhds_top_mono' [topological_space β] [partial_order β] [order_top β]
-  [order_topology β] {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊤)) (hg : f ≤ g) :
-  tendsto g l (𝓝 ⊤) :=
-tendsto_nhds_top_mono hf (eventually_of_forall hg)
-
-lemma tendsto_nhds_bot_mono' [topological_space β] [partial_order β] [order_bot β]
-  [order_topology β] {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊥)) (hg : g ≤ f) :
-  tendsto g l (𝓝 ⊥) :=
-tendsto_nhds_bot_mono hf (eventually_of_forall hg)
-
-section linear_order
-
-variables [topological_space α] [linear_order α] [order_topology α]
-
-lemma exists_Ioc_subset_of_mem_nhds' {a : α} {s : set α} (hs : s ∈ 𝓝 a) {l : α} (hl : l < a) :
-  ∃ l' ∈ Ico l a, Ioc l' a ⊆ s :=
-begin
-  rw [nhds_eq_order a] at hs,
-  rcases hs with ⟨t₁, ht₁, t₂, ht₂, rfl⟩,
-  -- First we show that `t₂` includes `(-∞, a]`, so it suffices to show `(l', ∞) ⊆ t₁`
-  suffices : ∃ l' ∈ Ico l a, Ioi l' ⊆ t₁,
-  { have A : 𝓟 (Iic a) ≤ ⨅ b ∈ Ioi a, 𝓟 (Iio b),
-      from (le_infi $ λ b, le_infi $ λ hb, principal_mono.2 $ Iic_subset_Iio.2 hb),
-    have B : t₁ ∩ Iic a ⊆ t₁ ∩ t₂,
-      from inter_subset_inter_right _ (A ht₂),
-    from this.imp (λ l', Exists.imp $ λ hl' hl x hx, B ⟨hl hx.1, hx.2⟩) },
-  clear ht₂ t₂,
-  -- Now we find `l` such that `(l', ∞) ⊆ t₁`
-  rw [mem_binfi_of_directed] at ht₁,
-  { rcases ht₁ with ⟨b, hb, hb'⟩,
-    exact ⟨max b l, ⟨le_max_right _ _, max_lt hb hl⟩,
-      λ x hx, hb' $ Ioi_subset_Ioi (le_max_left _ _) hx⟩ },
-  { intros b hb b' hb', simp only [mem_Iio] at hb hb',
-    use [max b b', max_lt hb hb'],
-    simp [le_refl] },
-  exact ⟨l, hl⟩
-end
-
-lemma exists_Ico_subset_of_mem_nhds' {a : α} {s : set α} (hs : s ∈ 𝓝 a) {u : α} (hu : a < u) :
-  ∃ u' ∈ Ioc a u, Ico a u' ⊆ s :=
-by simpa only [order_dual.exists, exists_prop, dual_Ico, dual_Ioc]
-    using exists_Ioc_subset_of_mem_nhds' (show of_dual ⁻¹' s ∈ 𝓝 (to_dual a), from hs) hu.dual
-
-lemma exists_Ioc_subset_of_mem_nhds {a : α} {s : set α} (hs : s ∈ 𝓝 a) (h : ∃ l, l < a) :
-  ∃ l < a, Ioc l a ⊆ s :=
-let ⟨l', hl'⟩ := h in let ⟨l, hl⟩ := exists_Ioc_subset_of_mem_nhds' hs hl' in ⟨l, hl.fst.2, hl.snd⟩
-
-lemma exists_Ico_subset_of_mem_nhds {a : α} {s : set α} (hs : s ∈ 𝓝 a) (h : ∃ u, a < u) :
-  ∃ u (_ : a < u), Ico a u ⊆ s :=
-let ⟨l', hl'⟩ := h in let ⟨l, hl⟩ := exists_Ico_subset_of_mem_nhds' hs hl' in ⟨l, hl.fst.1, hl.snd⟩
-
-lemma is_open.exists_Ioo_subset [nontrivial α] {s : set α} (hs : is_open s) (h : s.nonempty) :
-  ∃ a b, a < b ∧ Ioo a b ⊆ s :=
-begin
-  obtain ⟨x, hx⟩ : ∃ x, x ∈ s := h,
-  obtain ⟨y, hy⟩ : ∃ y, y ≠ x := exists_ne x,
-  rcases lt_trichotomy x y with H|rfl|H,
-  { obtain ⟨u, xu, hu⟩ : ∃ (u : α) (hu : x < u), Ico x u ⊆ s :=
-      exists_Ico_subset_of_mem_nhds (hs.mem_nhds hx) ⟨y, H⟩,
-    exact ⟨x, u, xu, Ioo_subset_Ico_self.trans hu⟩ },
-  { exact (hy rfl).elim },
-  { obtain ⟨l, lx, hl⟩ : ∃ (l : α) (hl : l < x), Ioc l x ⊆ s :=
-      exists_Ioc_subset_of_mem_nhds (hs.mem_nhds hx) ⟨y, H⟩,
-    exact ⟨l, x, lx, Ioo_subset_Ioc_self.trans hl⟩ }
-end
-
-lemma order_separated {a₁ a₂ : α} (h : a₁ < a₂) :
-  ∃u v : set α, is_open u ∧ is_open v ∧ a₁ ∈ u ∧ a₂ ∈ v ∧ (∀b₁∈u, ∀b₂∈v, b₁ < b₂) :=
-match dense_or_discrete a₁ a₂ with
-| or.inl ⟨a, ha₁, ha₂⟩ := ⟨{a' | a' < a}, {a' | a < a'}, is_open_gt' a, is_open_lt' a, ha₁, ha₂,
-    assume b₁ h₁ b₂ h₂, lt_trans h₁ h₂⟩
-| or.inr ⟨h₁, h₂⟩ := ⟨{a | a < a₂}, {a | a₁ < a}, is_open_gt' a₂, is_open_lt' a₁, h, h,
-    assume b₁ hb₁ b₂ hb₂,
-    calc b₁ ≤ a₁ : h₂ _ hb₁
-      ... < a₂ : h
-      ... ≤ b₂ : h₁ _ hb₂⟩
-end
-
-@[priority 100] -- see Note [lower instance priority]
-instance order_topology.to_order_closed_topology : order_closed_topology α :=
-{ is_closed_le' :=
-    is_open_compl_iff.1 $ is_open_prod_iff.mpr $ assume a₁ a₂ (h : ¬ a₁ ≤ a₂),
-      have h : a₂ < a₁, from lt_of_not_ge h,
-      let ⟨u, v, hu, hv, ha₁, ha₂, h⟩ := order_separated h in
-      ⟨v, u, hv, hu, ha₂, ha₁, assume ⟨b₁, b₂⟩ ⟨h₁, h₂⟩, not_le_of_gt $ h b₂ h₂ b₁ h₁⟩ }
-
-lemma order_topology.t2_space : t2_space α := by apply_instance
-
-@[priority 100] -- see Note [lower instance priority]
-instance order_topology.regular_space : regular_space α :=
-{ regular := assume s a hs ha,
-    have hs' : sᶜ ∈ 𝓝 a, from is_open.mem_nhds hs.is_open_compl ha,
-    have ∃t:set α, is_open t ∧ (∀l∈ s, l < a → l ∈ t) ∧ 𝓝[t] a = ⊥,
-      from by_cases
-        (assume h : ∃l, l < a,
-          let ⟨l, hl, h⟩ := exists_Ioc_subset_of_mem_nhds hs' h in
-          match dense_or_discrete l a with
-          | or.inl ⟨b, hb₁, hb₂⟩ := ⟨{a | a < b}, is_open_gt' _,
-              assume c hcs hca, show c < b,
-                from lt_of_not_ge $ assume hbc, h ⟨lt_of_lt_of_le hb₁ hbc, le_of_lt hca⟩ hcs,
-              inf_principal_eq_bot.2 $ (𝓝 a).sets_of_superset ((is_open_lt' _).mem_nhds hb₂) $
-                assume x (hx : b < x), show ¬ x < b, from not_lt.2 $ le_of_lt hx⟩
-          | or.inr ⟨h₁, h₂⟩ := ⟨{a' | a' < a}, is_open_gt' _, assume b hbs hba, hba,
-              inf_principal_eq_bot.2 $ (𝓝 a).sets_of_superset ((is_open_lt' _).mem_nhds hl) $
-                assume x (hx : l < x), show ¬ x < a, from not_lt.2 $ h₁ _ hx⟩
-          end)
-        (assume : ¬ ∃l, l < a, ⟨∅, is_open_empty, assume l _ hl, (this ⟨l, hl⟩).elim,
-          nhds_within_empty _⟩),
-    let ⟨t₁, ht₁o, ht₁s, ht₁a⟩ := this in
-    have ∃t:set α, is_open t ∧ (∀u∈ s, u>a → u ∈ t) ∧ 𝓝[t] a = ⊥,
-      from by_cases
-        (assume h : ∃u, u > a,
-          let ⟨u, hu, h⟩ := exists_Ico_subset_of_mem_nhds hs' h in
-          match dense_or_discrete a u with
-          | or.inl ⟨b, hb₁, hb₂⟩ := ⟨{a | b < a}, is_open_lt' _,
-              assume c hcs hca, show c > b,
-                from lt_of_not_ge $ assume hbc, h ⟨le_of_lt hca, lt_of_le_of_lt hbc hb₂⟩ hcs,
-              inf_principal_eq_bot.2 $ (𝓝 a).sets_of_superset ((is_open_gt' _).mem_nhds hb₁) $
-                assume x (hx : b > x), show ¬ x > b, from not_lt.2 $ le_of_lt hx⟩
-          | or.inr ⟨h₁, h₂⟩ := ⟨{a' | a' > a}, is_open_lt' _, assume b hbs hba, hba,
-              inf_principal_eq_bot.2 $ (𝓝 a).sets_of_superset ((is_open_gt' _).mem_nhds hu) $
-                assume x (hx : u > x), show ¬ x > a, from not_lt.2 $ h₂ _ hx⟩
-          end)
-        (assume : ¬ ∃u, u > a, ⟨∅, is_open_empty, assume l _ hl, (this ⟨l, hl⟩).elim,
-          nhds_within_empty _⟩),
-    let ⟨t₂, ht₂o, ht₂s, ht₂a⟩ := this in
-    ⟨t₁ ∪ t₂, is_open.union ht₁o ht₂o,
-      assume x hx,
-      have x ≠ a, from assume eq, ha $ eq ▸ hx,
-      (ne_iff_lt_or_gt.mp this).imp (ht₁s _ hx) (ht₂s _ hx),
-      by rw [nhds_within_union, ht₁a, ht₂a, bot_sup_eq]⟩,
-  ..order_topology.t2_space }
-
-/-- A set is a neighborhood of `a` if and only if it contains an interval `(l, u)` containing `a`,
-provided `a` is neither a bottom element nor a top element. -/
-lemma mem_nhds_iff_exists_Ioo_subset' {a : α} {s : set α} (hl : ∃ l, l < a) (hu : ∃ u, a < u) :
-  s ∈ 𝓝 a ↔ ∃l u, a ∈ Ioo l u ∧ Ioo l u ⊆ s :=
-begin
-  split,
-  { assume h,
-    rcases exists_Ico_subset_of_mem_nhds h hu with ⟨u, au, hu⟩,
-    rcases exists_Ioc_subset_of_mem_nhds h hl with ⟨l, la, hl⟩,
-    refine ⟨l, u, ⟨la, au⟩, λx hx, _⟩,
-    cases le_total a x with hax hax,
-    { exact hu ⟨hax, hx.2⟩ },
-    { exact hl ⟨hx.1, hax⟩ } },
-  { rintros ⟨l, u, ha, h⟩,
-    apply mem_of_superset (is_open.mem_nhds is_open_Ioo ha) h }
-end
-
-/-- A set is a neighborhood of `a` if and only if it contains an interval `(l, u)` containing `a`.
--/
-lemma mem_nhds_iff_exists_Ioo_subset [no_max_order α] [no_min_order α] {a : α} {s : set α} :
-  s ∈ 𝓝 a ↔ ∃l u, a ∈ Ioo l u ∧ Ioo l u ⊆ s :=
-mem_nhds_iff_exists_Ioo_subset' (exists_lt a) (exists_gt a)
-
-lemma nhds_basis_Ioo' {a : α} (hl : ∃ l, l < a) (hu : ∃ u, a < u) :
-  (𝓝 a).has_basis (λ b : α × α, b.1 < a ∧ a < b.2) (λ b, Ioo b.1 b.2) :=
-⟨λ s, (mem_nhds_iff_exists_Ioo_subset' hl hu).trans $ by simp⟩
-
-lemma nhds_basis_Ioo [no_max_order α] [no_min_order α] (a : α) :
-  (𝓝 a).has_basis (λ b : α × α, b.1 < a ∧ a < b.2) (λ b, Ioo b.1 b.2) :=
-nhds_basis_Ioo' (exists_lt a) (exists_gt a)
-
-lemma filter.eventually.exists_Ioo_subset [no_max_order α] [no_min_order α] {a : α} {p : α → Prop}
-  (hp : ∀ᶠ x in 𝓝 a, p x) :
-  ∃ l u, a ∈ Ioo l u ∧ Ioo l u ⊆ {x | p x} :=
-mem_nhds_iff_exists_Ioo_subset.1 hp
-
-section pi
-
-/-!
-### Intervals in `Π i, π i` belong to `𝓝 x`
-
-For each lemma `pi_Ixx_mem_nhds` we add a non-dependent version `pi_Ixx_mem_nhds'` because
-sometimes Lean fails to unify different instances while trying to apply the dependent version to,
-e.g., `ι → ℝ`.
--/
-
-variables {ι : Type*} {π : ι → Type*} [fintype ι] [Π i, linear_order (π i)]
-  [Π i, topological_space (π i)] [∀ i, order_topology (π i)] {a b x : Π i, π i} {a' b' x' : ι → α}
-
-lemma pi_Iic_mem_nhds (ha : ∀ i, x i < a i) : Iic a ∈ 𝓝 x :=
-pi_univ_Iic a ▸ set_pi_mem_nhds (finite.of_fintype _) (λ i _, Iic_mem_nhds (ha _))
-
-lemma pi_Iic_mem_nhds' (ha : ∀ i, x' i < a' i) : Iic a' ∈ 𝓝 x' :=
-pi_Iic_mem_nhds ha
-
-lemma pi_Ici_mem_nhds (ha : ∀ i, a i < x i) : Ici a ∈ 𝓝 x :=
-pi_univ_Ici a ▸ set_pi_mem_nhds (finite.of_fintype _) (λ i _, Ici_mem_nhds (ha _))
-
-lemma pi_Ici_mem_nhds' (ha : ∀ i, a' i < x' i) : Ici a' ∈ 𝓝 x' :=
-pi_Ici_mem_nhds ha
-
-lemma pi_Icc_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Icc a b ∈ 𝓝 x :=
-pi_univ_Icc a b ▸ set_pi_mem_nhds (finite.of_fintype _) (λ i _, Icc_mem_nhds (ha _) (hb _))
-
-lemma pi_Icc_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Icc a' b' ∈ 𝓝 x' :=
-pi_Icc_mem_nhds ha hb
-
-variables [nonempty ι]
-
-lemma pi_Iio_mem_nhds (ha : ∀ i, x i < a i) : Iio a ∈ 𝓝 x :=
-begin
-  refine mem_of_superset (set_pi_mem_nhds (finite.of_fintype _) (λ i _, _))
-    (pi_univ_Iio_subset a),
-  exact Iio_mem_nhds (ha i)
-end
-
-lemma pi_Iio_mem_nhds' (ha : ∀ i, x' i < a' i) : Iio a' ∈ 𝓝 x' :=
-pi_Iio_mem_nhds ha
-
-lemma pi_Ioi_mem_nhds (ha : ∀ i, a i < x i) : Ioi a ∈ 𝓝 x :=
-@pi_Iio_mem_nhds ι (λ i, (π i)ᵒᵈ) _ _ _ _ _ _ _ ha
-
-lemma pi_Ioi_mem_nhds' (ha : ∀ i, a' i < x' i) : Ioi a' ∈ 𝓝 x' :=
-pi_Ioi_mem_nhds ha
-
-lemma pi_Ioc_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Ioc a b ∈ 𝓝 x :=
-begin
-  refine mem_of_superset (set_pi_mem_nhds (finite.of_fintype _) (λ i _, _))
-    (pi_univ_Ioc_subset a b),
-  exact Ioc_mem_nhds (ha i) (hb i)
-end
-
-lemma pi_Ioc_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Ioc a' b' ∈ 𝓝 x' :=
-pi_Ioc_mem_nhds ha hb
-
-lemma pi_Ico_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Ico a b ∈ 𝓝 x :=
-begin
-  refine mem_of_superset (set_pi_mem_nhds (finite.of_fintype _) (λ i _, _))
-    (pi_univ_Ico_subset a b),
-  exact Ico_mem_nhds (ha i) (hb i)
-end
-
-lemma pi_Ico_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Ico a' b' ∈ 𝓝 x' :=
-pi_Ico_mem_nhds ha hb
-
-lemma pi_Ioo_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Ioo a b ∈ 𝓝 x :=
-begin
-  refine mem_of_superset (set_pi_mem_nhds (finite.of_fintype _) (λ i _, _))
-    (pi_univ_Ioo_subset a b),
-  exact Ioo_mem_nhds (ha i) (hb i)
-end
-
-lemma pi_Ioo_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Ioo a' b' ∈ 𝓝 x' :=
-pi_Ioo_mem_nhds ha hb
-
-end pi
-
-lemma disjoint_nhds_at_top [no_max_order α] (x : α) :
-  disjoint (𝓝 x) at_top :=
-begin
-  rcases exists_gt x with ⟨y, hy : x < y⟩,
-  refine disjoint_of_disjoint_of_mem _ (Iio_mem_nhds hy) (mem_at_top y),
-  exact disjoint_left.mpr (λ z, not_le.2)
-end
-
-@[simp] lemma inf_nhds_at_top [no_max_order α] (x : α) :
-  𝓝 x ⊓ at_top = ⊥ :=
-disjoint_iff.1 (disjoint_nhds_at_top x)
-
-lemma disjoint_nhds_at_bot [no_min_order α] (x : α) : disjoint (𝓝 x) at_bot :=
-@disjoint_nhds_at_top αᵒᵈ _ _ _ _ x
-
-@[simp] lemma inf_nhds_at_bot [no_min_order α] (x : α) : 𝓝 x ⊓ at_bot = ⊥ :=
-@inf_nhds_at_top αᵒᵈ _ _ _ _ x
-
-lemma not_tendsto_nhds_of_tendsto_at_top [no_max_order α]
-  {F : filter β} [ne_bot F] {f : β → α} (hf : tendsto f F at_top) (x : α) :
-  ¬ tendsto f F (𝓝 x) :=
-hf.not_tendsto (disjoint_nhds_at_top x).symm
-
-lemma not_tendsto_at_top_of_tendsto_nhds [no_max_order α]
-  {F : filter β} [ne_bot F] {f : β → α} {x : α} (hf : tendsto f F (𝓝 x)) :
-  ¬  tendsto f F at_top :=
-hf.not_tendsto (disjoint_nhds_at_top x)
-
-lemma not_tendsto_nhds_of_tendsto_at_bot [no_min_order α]
-  {F : filter β} [ne_bot F] {f : β → α} (hf : tendsto f F at_bot) (x : α) :
-  ¬ tendsto f F (𝓝 x) :=
-hf.not_tendsto (disjoint_nhds_at_bot x).symm
-
-lemma not_tendsto_at_bot_of_tendsto_nhds [no_min_order α]
-  {F : filter β} [ne_bot F] {f : β → α} {x : α} (hf : tendsto f F (𝓝 x)) :
-  ¬ tendsto f F at_bot :=
-hf.not_tendsto (disjoint_nhds_at_bot x)
-
-/-!
-### Neighborhoods to the left and to the right on an `order_topology`
-
-We've seen some properties of left and right neighborhood of a point in an `order_closed_topology`.
-In an `order_topology`, such neighborhoods can be characterized as the sets containing suitable
-intervals to the right or to the left of `a`. We give now these characterizations. -/
-
--- NB: If you extend the list, append to the end please to avoid breaking the API
-/-- The following statements are equivalent:
-
-0. `s` is a neighborhood of `a` within `(a, +∞)`
-1. `s` is a neighborhood of `a` within `(a, b]`
-2. `s` is a neighborhood of `a` within `(a, b)`
-3. `s` includes `(a, u)` for some `u ∈ (a, b]`
-4. `s` includes `(a, u)` for some `u > a` -/
-lemma tfae_mem_nhds_within_Ioi {a b : α} (hab : a < b) (s : set α) :
-  tfae [s ∈ 𝓝[>] a, -- 0 : `s` is a neighborhood of `a` within `(a, +∞)`
-    s ∈ 𝓝[Ioc a b] a,   -- 1 : `s` is a neighborhood of `a` within `(a, b]`
-    s ∈ 𝓝[Ioo a b] a,   -- 2 : `s` is a neighborhood of `a` within `(a, b)`
-    ∃ u ∈ Ioc a b, Ioo a u ⊆ s,    -- 3 : `s` includes `(a, u)` for some `u ∈ (a, b]`
-    ∃ u ∈ Ioi a, Ioo a u ⊆ s] :=   -- 4 : `s` includes `(a, u)` for some `u > a`
-begin
-  tfae_have : 1 ↔ 2, by rw [nhds_within_Ioc_eq_nhds_within_Ioi hab],
-  tfae_have : 1 ↔ 3, by rw [nhds_within_Ioo_eq_nhds_within_Ioi hab],
-  tfae_have : 4 → 5, from λ ⟨u, umem, hu⟩, ⟨u, umem.1, hu⟩,
-  tfae_have : 5 → 1,
-  { rintros ⟨u, hau, hu⟩,
-    exact mem_of_superset (Ioo_mem_nhds_within_Ioi ⟨le_refl a, hau⟩) hu },
-  tfae_have : 1 → 4,
-  { assume h,
-    rcases mem_nhds_within_iff_exists_mem_nhds_inter.1 h with ⟨v, va, hv⟩,
-    rcases exists_Ico_subset_of_mem_nhds' va hab with ⟨u, au, hu⟩,
-    refine ⟨u, au, λx hx, _⟩,
-    refine hv ⟨hu ⟨le_of_lt hx.1, hx.2⟩, _⟩,
-    exact hx.1 },
-  tfae_finish
-end
-
-lemma mem_nhds_within_Ioi_iff_exists_mem_Ioc_Ioo_subset {a u' : α} {s : set α} (hu' : a < u') :
-  s ∈ 𝓝[>] a ↔ ∃u ∈ Ioc a u', Ioo a u ⊆ s :=
-(tfae_mem_nhds_within_Ioi hu' s).out 0 3
-
-/-- A set is a neighborhood of `a` within `(a, +∞)` if and only if it contains an interval `(a, u)`
-with `a < u < u'`, provided `a` is not a top element. -/
-lemma mem_nhds_within_Ioi_iff_exists_Ioo_subset' {a u' : α} {s : set α} (hu' : a < u') :
-  s ∈ 𝓝[>] a ↔ ∃u ∈ Ioi a, Ioo a u ⊆ s :=
-(tfae_mem_nhds_within_Ioi hu' s).out 0 4
-
-/-- A set is a neighborhood of `a` within `(a, +∞)` if and only if it contains an interval `(a, u)`
-with `a < u`. -/
-lemma mem_nhds_within_Ioi_iff_exists_Ioo_subset [no_max_order α] {a : α} {s : set α} :
-  s ∈ 𝓝[>] a ↔ ∃u ∈ Ioi a, Ioo a u ⊆ s :=
-let ⟨u', hu'⟩ := exists_gt a in mem_nhds_within_Ioi_iff_exists_Ioo_subset' hu'
-
-/-- A set is a neighborhood of `a` within `(a, +∞)` if and only if it contains an interval `(a, u]`
-with `a < u`. -/
-lemma mem_nhds_within_Ioi_iff_exists_Ioc_subset [no_max_order α] [densely_ordered α]
-  {a : α} {s : set α} : s ∈ 𝓝[>] a ↔ ∃u ∈ Ioi a, Ioc a u ⊆ s :=
-begin
-  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset,
-  split,
-  { rintros ⟨u, au, as⟩,
-    rcases exists_between au with ⟨v, hv⟩,
-    exact ⟨v, hv.1, λx hx, as ⟨hx.1, lt_of_le_of_lt hx.2 hv.2⟩⟩ },
-  { rintros ⟨u, au, as⟩,
-    exact ⟨u, au, subset.trans Ioo_subset_Ioc_self as⟩ }
-end
-
-/-- The following statements are equivalent:
-
-0. `s` is a neighborhood of `b` within `(-∞, b)`
-1. `s` is a neighborhood of `b` within `[a, b)`
-2. `s` is a neighborhood of `b` within `(a, b)`
-3. `s` includes `(l, b)` for some `l ∈ [a, b)`
-4. `s` includes `(l, b)` for some `l < b` -/
-lemma tfae_mem_nhds_within_Iio {a b : α} (h : a < b) (s : set α) :
-  tfae [s ∈ 𝓝[<] b, -- 0 : `s` is a neighborhood of `b` within `(-∞, b)`
-    s ∈ 𝓝[Ico a b] b,   -- 1 : `s` is a neighborhood of `b` within `[a, b)`
-    s ∈ 𝓝[Ioo a b] b,   -- 2 : `s` is a neighborhood of `b` within `(a, b)`
-    ∃ l ∈ Ico a b, Ioo l b ⊆ s,    -- 3 : `s` includes `(l, b)` for some `l ∈ [a, b)`
-    ∃ l ∈ Iio b, Ioo l b ⊆ s] :=   -- 4 : `s` includes `(l, b)` for some `l < b`
-by simpa only [exists_prop, order_dual.exists, dual_Ioi, dual_Ioc, dual_Ioo]
-    using tfae_mem_nhds_within_Ioi h.dual (of_dual ⁻¹' s)
-
-lemma mem_nhds_within_Iio_iff_exists_mem_Ico_Ioo_subset {a l' : α} {s : set α} (hl' : l' < a) :
-  s ∈ 𝓝[<] a ↔ ∃l ∈ Ico l' a, Ioo l a ⊆ s :=
-(tfae_mem_nhds_within_Iio hl' s).out 0 3
-
-/-- A set is a neighborhood of `a` within `(-∞, a)` if and only if it contains an interval `(l, a)`
-with `l < a`, provided `a` is not a bottom element. -/
-lemma mem_nhds_within_Iio_iff_exists_Ioo_subset' {a l' : α} {s : set α} (hl' : l' < a) :
-  s ∈ 𝓝[<] a ↔ ∃l ∈ Iio a, Ioo l a ⊆ s :=
-(tfae_mem_nhds_within_Iio hl' s).out 0 4
-
-/-- A set is a neighborhood of `a` within `(-∞, a)` if and only if it contains an interval `(l, a)`
-with `l < a`. -/
-lemma mem_nhds_within_Iio_iff_exists_Ioo_subset [no_min_order α] {a : α} {s : set α} :
-  s ∈ 𝓝[<] a ↔ ∃l ∈ Iio a, Ioo l a ⊆ s :=
-let ⟨l', hl'⟩ := exists_lt a in mem_nhds_within_Iio_iff_exists_Ioo_subset' hl'
-
-/-- A set is a neighborhood of `a` within `(-∞, a)` if and only if it contains an interval `[l, a)`
-with `l < a`. -/
-lemma mem_nhds_within_Iio_iff_exists_Ico_subset [no_min_order α] [densely_ordered α]
-  {a : α} {s : set α} : s ∈ 𝓝[<] a ↔ ∃l ∈ Iio a, Ico l a ⊆ s :=
-begin
-  have : of_dual ⁻¹' s ∈ 𝓝[>] (to_dual a) ↔ _ :=
-    mem_nhds_within_Ioi_iff_exists_Ioc_subset,
-  simpa only [order_dual.exists, exists_prop, dual_Ioc] using this,
-end
-
-/-- The following statements are equivalent:
-
-0. `s` is a neighborhood of `a` within `[a, +∞)`
-1. `s` is a neighborhood of `a` within `[a, b]`
-2. `s` is a neighborhood of `a` within `[a, b)`
-3. `s` includes `[a, u)` for some `u ∈ (a, b]`
-4. `s` includes `[a, u)` for some `u > a` -/
-lemma tfae_mem_nhds_within_Ici {a b : α} (hab : a < b) (s : set α) :
-  tfae [s ∈ 𝓝[≥] a, -- 0 : `s` is a neighborhood of `a` within `[a, +∞)`
-    s ∈ 𝓝[Icc a b] a,   -- 1 : `s` is a neighborhood of `a` within `[a, b]`
-    s ∈ 𝓝[Ico a b] a,   -- 2 : `s` is a neighborhood of `a` within `[a, b)`
-    ∃ u ∈ Ioc a b, Ico a u ⊆ s,    -- 3 : `s` includes `[a, u)` for some `u ∈ (a, b]`
-    ∃ u ∈ Ioi a, Ico a u ⊆ s] :=   -- 4 : `s` includes `[a, u)` for some `u > a`
-begin
-  tfae_have : 1 ↔ 2, by rw [nhds_within_Icc_eq_nhds_within_Ici hab],
-  tfae_have : 1 ↔ 3, by rw [nhds_within_Ico_eq_nhds_within_Ici hab],
-  tfae_have : 4 → 5, from λ ⟨u, umem, hu⟩, ⟨u, umem.1, hu⟩,
-  tfae_have : 5 → 1,
-  { rintros ⟨u, hau, hu⟩,
-    exact mem_of_superset (Ico_mem_nhds_within_Ici ⟨le_refl a, hau⟩) hu },
-  tfae_have : 1 → 4,
-  { assume h,
-    rcases mem_nhds_within_iff_exists_mem_nhds_inter.1 h with ⟨v, va, hv⟩,
-    rcases exists_Ico_subset_of_mem_nhds' va hab with ⟨u, au, hu⟩,
-    refine ⟨u, au, λx hx, _⟩,
-    refine hv ⟨hu ⟨hx.1, hx.2⟩, _⟩,
-    exact hx.1 },
-  tfae_finish
-end
-
-lemma mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset {a u' : α} {s : set α} (hu' : a < u') :
-  s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioc a u', Ico a u ⊆ s :=
-(tfae_mem_nhds_within_Ici hu' s).out 0 3 (by norm_num) (by norm_num)
-
-/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u)`
-with `a < u < u'`, provided `a` is not a top element. -/
-lemma mem_nhds_within_Ici_iff_exists_Ico_subset' {a u' : α} {s : set α} (hu' : a < u') :
-  s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioi a, Ico a u ⊆ s :=
-(tfae_mem_nhds_within_Ici hu' s).out 0 4 (by norm_num) (by norm_num)
-
-/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u)`
-with `a < u`. -/
-lemma mem_nhds_within_Ici_iff_exists_Ico_subset [no_max_order α] {a : α} {s : set α} :
-  s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioi a, Ico a u ⊆ s :=
-let ⟨u', hu'⟩ := exists_gt a in mem_nhds_within_Ici_iff_exists_Ico_subset' hu'
-
-/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u]`
-with `a < u`. -/
-lemma mem_nhds_within_Ici_iff_exists_Icc_subset' [no_max_order α] [densely_ordered α]
-  {a : α} {s : set α} : s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioi a, Icc a u ⊆ s :=
-begin
-  rw mem_nhds_within_Ici_iff_exists_Ico_subset,
-  split,
-  { rintros ⟨u, au, as⟩,
-    rcases exists_between au with ⟨v, hv⟩,
-    exact ⟨v, hv.1, λx hx, as ⟨hx.1, lt_of_le_of_lt hx.2 hv.2⟩⟩ },
-  { rintros ⟨u, au, as⟩,
-    exact ⟨u, au, subset.trans Ico_subset_Icc_self as⟩ }
-end
-
-/-- The following statements are equivalent:
-
-0. `s` is a neighborhood of `b` within `(-∞, b]`
-1. `s` is a neighborhood of `b` within `[a, b]`
-2. `s` is a neighborhood of `b` within `(a, b]`
-3. `s` includes `(l, b]` for some `l ∈ [a, b)`
-4. `s` includes `(l, b]` for some `l < b` -/
-lemma tfae_mem_nhds_within_Iic {a b : α} (h : a < b) (s : set α) :
-  tfae [s ∈ 𝓝[≤] b, -- 0 : `s` is a neighborhood of `b` within `(-∞, b]`
-    s ∈ 𝓝[Icc a b] b,   -- 1 : `s` is a neighborhood of `b` within `[a, b]`
-    s ∈ 𝓝[Ioc a b] b,   -- 2 : `s` is a neighborhood of `b` within `(a, b]`
-    ∃ l ∈ Ico a b, Ioc l b ⊆ s,    -- 3 : `s` includes `(l, b]` for some `l ∈ [a, b)`
-    ∃ l ∈ Iio b, Ioc l b ⊆ s] :=   -- 4 : `s` includes `(l, b]` for some `l < b`
-by simpa only [exists_prop, order_dual.exists, dual_Ici, dual_Ioc, dual_Icc, dual_Ico]
-    using tfae_mem_nhds_within_Ici h.dual (of_dual ⁻¹' s)
-
-lemma mem_nhds_within_Iic_iff_exists_mem_Ico_Ioc_subset {a l' : α} {s : set α} (hl' : l' < a) :
-  s ∈ 𝓝[≤] a ↔ ∃l ∈ Ico l' a, Ioc l a ⊆ s :=
-(tfae_mem_nhds_within_Iic hl' s).out 0 3 (by norm_num) (by norm_num)
-
-/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `(l, a]`
-with `l < a`, provided `a` is not a bottom element. -/
-lemma mem_nhds_within_Iic_iff_exists_Ioc_subset' {a l' : α} {s : set α} (hl' : l' < a) :
-  s ∈ 𝓝[≤] a ↔ ∃l ∈ Iio a, Ioc l a ⊆ s :=
-(tfae_mem_nhds_within_Iic hl' s).out 0 4 (by norm_num) (by norm_num)
-
-/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `(l, a]`
-with `l < a`. -/
-lemma mem_nhds_within_Iic_iff_exists_Ioc_subset [no_min_order α] {a : α} {s : set α} :
-  s ∈ 𝓝[≤] a ↔ ∃l ∈ Iio a, Ioc l a ⊆ s :=
-let ⟨l', hl'⟩ := exists_lt a in mem_nhds_within_Iic_iff_exists_Ioc_subset' hl'
-
-/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `[l, a]`
-with `l < a`. -/
-lemma mem_nhds_within_Iic_iff_exists_Icc_subset' [no_min_order α] [densely_ordered α]
-  {a : α} {s : set α} : s ∈ 𝓝[≤] a ↔ ∃l ∈ Iio a, Icc l a ⊆ s :=
-begin
-  convert @mem_nhds_within_Ici_iff_exists_Icc_subset' αᵒᵈ _ _ _ _ _ _ _,
-  simp_rw (show ∀ u : αᵒᵈ, @Icc αᵒᵈ _ a u = @Icc α _ u a, from λ u, dual_Icc),
-  refl,
-end
-
-/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u]`
-with `a < u`. -/
-lemma mem_nhds_within_Ici_iff_exists_Icc_subset [no_max_order α] [densely_ordered α]
-  {a : α} {s : set α} : s ∈ 𝓝[≥] a ↔ ∃u, a < u ∧ Icc a u ⊆ s :=
-begin
-  rw mem_nhds_within_Ici_iff_exists_Ico_subset,
-  split,
-  { rintros ⟨u, au, as⟩,
-    rcases exists_between au with ⟨v, hv⟩,
-    exact ⟨v, hv.1, λx hx, as ⟨hx.1, lt_of_le_of_lt hx.2 hv.2⟩⟩ },
-  { rintros ⟨u, au, as⟩,
-    exact ⟨u, au, subset.trans Ico_subset_Icc_self as⟩ }
-end
-
-/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `[l, a]`
-with `l < a`. -/
-lemma mem_nhds_within_Iic_iff_exists_Icc_subset [no_min_order α] [densely_ordered α]
-  {a : α} {s : set α} : s ∈ 𝓝[≤] a ↔ ∃l, l < a ∧ Icc l a ⊆ s :=
-begin
-  rw mem_nhds_within_Iic_iff_exists_Ioc_subset,
-  split,
-  { rintros ⟨l, la, as⟩,
-    rcases exists_between la with ⟨v, hv⟩,
-    refine ⟨v, hv.2, λx hx, as ⟨lt_of_lt_of_le hv.1 hx.1, hx.2⟩⟩, },
-  { rintros ⟨l, la, as⟩,
-    exact ⟨l, la, subset.trans Ioc_subset_Icc_self as⟩ }
-end
-
-end linear_order
-
-section linear_ordered_add_comm_group
-variables [topological_space α] [linear_ordered_add_comm_group α] [order_topology α]
-variables {l : filter β} {f g : β → α}
-
-lemma nhds_eq_infi_abs_sub (a : α) : 𝓝 a = (⨅r>0, 𝓟 {b | |a - b| < r}) :=
-begin
-  simp only [le_antisymm_iff, nhds_eq_order, le_inf_iff, le_infi_iff, le_principal_iff, mem_Ioi,
-    mem_Iio, abs_sub_lt_iff, @sub_lt_iff_lt_add _ _ _ _ _ _ a, @sub_lt _ _ _ _ a, set_of_and],
-  refine ⟨_, _, _⟩,
-  { intros ε ε0,
-    exact inter_mem_inf
-      (mem_infi_of_mem (a - ε) $ mem_infi_of_mem (sub_lt_self a ε0) (mem_principal_self _))
-      (mem_infi_of_mem (ε + a) $ mem_infi_of_mem (by simpa) (mem_principal_self _)) },
-  { intros b hb,
-    exact mem_infi_of_mem (a - b) (mem_infi_of_mem (sub_pos.2 hb) (by simp [Ioi])) },
-  { intros b hb,
-    exact mem_infi_of_mem (b - a) (mem_infi_of_mem (sub_pos.2 hb) (by simp [Iio])) }
-end
-
-lemma order_topology_of_nhds_abs {α : Type*} [topological_space α] [linear_ordered_add_comm_group α]
-  (h_nhds : ∀a:α, 𝓝 a = (⨅r>0, 𝓟 {b | |a - b| < r})) : order_topology α :=
-begin
-  refine ⟨eq_of_nhds_eq_nhds $ λ a, _⟩,
-  rw [h_nhds],
-  letI := preorder.topology α, letI : order_topology α := ⟨rfl⟩,
-  exact (nhds_eq_infi_abs_sub a).symm
-end
-
-lemma linear_ordered_add_comm_group.tendsto_nhds {x : filter β} {a : α} :
-  tendsto f x (𝓝 a) ↔ ∀ ε > (0 : α), ∀ᶠ b in x, |f b - a| < ε :=
-by simp [nhds_eq_infi_abs_sub, abs_sub_comm a]
-
-lemma eventually_abs_sub_lt (a : α) {ε : α} (hε : 0 < ε) : ∀ᶠ x in 𝓝 a, |x - a| < ε :=
-(nhds_eq_infi_abs_sub a).symm ▸ mem_infi_of_mem ε
-  (mem_infi_of_mem hε $ by simp only [abs_sub_comm, mem_principal_self])
-
-@[priority 100] -- see Note [lower instance priority]
-instance linear_ordered_add_comm_group.topological_add_group : topological_add_group α :=
-{ continuous_add :=
-    begin
-      refine continuous_iff_continuous_at.2 _,
-      rintro ⟨a, b⟩,
-      refine linear_ordered_add_comm_group.tendsto_nhds.2 (λ ε ε0, _),
-      rcases dense_or_discrete 0 ε with (⟨δ, δ0, δε⟩|⟨h₁, h₂⟩),
-      { -- If there exists `δ ∈ (0, ε)`, then we choose `δ`-nhd of `a` and `(ε-δ)`-nhd of `b`
-        filter_upwards [prod_is_open.mem_nhds (eventually_abs_sub_lt a δ0)
-          (eventually_abs_sub_lt b (sub_pos.2 δε))],
-        rintros ⟨x, y⟩ ⟨hx : |x - a| < δ, hy : |y - b| < ε - δ⟩,
-        rw [add_sub_comm],
-        calc |x - a + (y - b)| ≤ |x - a| + |y - b| : abs_add _ _
-        ... < δ + (ε - δ) : add_lt_add hx hy
-        ... = ε : add_sub_cancel'_right _ _ },
-      { -- Otherewise `ε`-nhd of each point `a` is `{a}`
-        have hε : ∀ {x y}, |x - y| < ε → x = y,
-        { intros x y h,
-          simpa [sub_eq_zero] using h₂ _ h },
-        filter_upwards [prod_is_open.mem_nhds (eventually_abs_sub_lt a ε0)
-          (eventually_abs_sub_lt b ε0)],
-        rintros ⟨x, y⟩ ⟨hx : |x - a| < ε, hy : |y - b| < ε⟩,
-        simpa [hε hx, hε hy] }
-    end,
-  continuous_neg := continuous_iff_continuous_at.2 $ λ a,
-    linear_ordered_add_comm_group.tendsto_nhds.2 $ λ ε ε0,
-      (eventually_abs_sub_lt a ε0).mono $ λ x hx, by rwa [neg_sub_neg, abs_sub_comm] }
-
-@[continuity]
-lemma continuous_abs : continuous (abs : α → α) := continuous_id.max continuous_neg
-
-lemma filter.tendsto.abs {f : β → α} {a : α} {l : filter β} (h : tendsto f l (𝓝 a)) :
-  tendsto (λ x, |f x|) l (𝓝 (|a|)) :=
-(continuous_abs.tendsto _).comp h
-
-lemma tendsto_zero_iff_abs_tendsto_zero (f : β → α) {l : filter β} :
-  tendsto f l (𝓝 0) ↔ tendsto (abs ∘ f) l (𝓝 0) :=
-begin
-  refine ⟨λ h, (abs_zero : |(0 : α)| = 0) ▸ h.abs, λ h, _⟩,
-  have : tendsto (λ a, -|f a|) l (𝓝 0) := (neg_zero : -(0 : α) = 0) ▸ h.neg,
-  exact tendsto_of_tendsto_of_tendsto_of_le_of_le this h
-    (λ x, neg_abs_le_self $ f x) (λ x, le_abs_self $ f x),
-end
-
-lemma nhds_basis_Ioo_pos [no_min_order α] [no_max_order α] (a : α) :
-  (𝓝 a).has_basis (λ ε : α, (0 : α) < ε) (λ ε, Ioo (a-ε) (a+ε)) :=
-⟨begin
-  refine λ t, (nhds_basis_Ioo a).mem_iff.trans ⟨_, _⟩,
-  { rintros ⟨⟨l, u⟩, ⟨hl : l < a, hu : a < u⟩, h' : Ioo l u ⊆ t⟩,
-    refine ⟨min (a-l) (u-a), by apply lt_min; rwa sub_pos, _⟩,
-    rintros x ⟨hx, hx'⟩,
-    apply h',
-    rw [sub_lt, lt_min_iff, sub_lt_sub_iff_left] at hx,
-    rw [← sub_lt_iff_lt_add', lt_min_iff, sub_lt_sub_iff_right] at hx',
-    exact ⟨hx.1, hx'.2⟩ },
-  { rintros ⟨ε, ε_pos, h⟩,
-    exact ⟨(a-ε, a+ε), by simp [ε_pos], h⟩ },
-end⟩
-
-lemma nhds_basis_abs_sub_lt [no_min_order α] [no_max_order α] (a : α) :
-  (𝓝 a).has_basis (λ ε : α, (0 : α) < ε) (λ ε, {b | |b - a| < ε}) :=
-begin
-  convert nhds_basis_Ioo_pos a,
-  { ext ε,
-    change |x - a| < ε ↔ a - ε < x ∧ x < a + ε,
-    simp [abs_lt, sub_lt_iff_lt_add, add_comm ε a, add_comm x ε] }
-end
-
-variable (α)
-
-lemma nhds_basis_zero_abs_sub_lt [no_min_order α] [no_max_order α] :
-  (𝓝 (0 : α)).has_basis (λ ε : α, (0 : α) < ε) (λ ε, {b | |b| < ε}) :=
-by simpa using nhds_basis_abs_sub_lt (0 : α)
-
-variable {α}
-
-/-- If `a` is positive we can form a basis from only nonnegative `Ioo` intervals -/
-lemma nhds_basis_Ioo_pos_of_pos [no_min_order α] [no_max_order α]
-  {a : α} (ha : 0 < a) :
-  (𝓝 a).has_basis (λ ε : α, (0 : α) < ε ∧ ε ≤ a) (λ ε, Ioo (a-ε) (a+ε)) :=
-⟨ λ t, (nhds_basis_Ioo_pos a).mem_iff.trans
-  ⟨λ h, let ⟨i, hi, hit⟩ := h in
-    ⟨min i a, ⟨lt_min hi ha, min_le_right i a⟩, trans (Ioo_subset_Ioo
-    (sub_le_sub_left (min_le_left i a) a) (add_le_add_left (min_le_left i a) a)) hit⟩,
-  λ h, let ⟨i, hi, hit⟩ := h in ⟨i, hi.1, hit⟩ ⟩ ⟩
-
-section
-
-variables [topological_space β] {b : β} {a : α} {s : set β}
-
-lemma continuous.abs (h : continuous f) : continuous (λ x, |f x|) := continuous_abs.comp h
-
-lemma continuous_at.abs (h : continuous_at f b) : continuous_at (λ x, |f x|) b := h.abs
-
-lemma continuous_within_at.abs (h : continuous_within_at f s b) :
-  continuous_within_at (λ x, |f x|) s b := h.abs
-
-lemma continuous_on.abs (h : continuous_on f s) : continuous_on (λ x, |f x|) s :=
-λ x hx, (h x hx).abs
-
-lemma tendsto_abs_nhds_within_zero : tendsto (abs : α → α) (𝓝[≠] 0) (𝓝[>] 0) :=
-(continuous_abs.tendsto' (0 : α) 0 abs_zero).inf $ tendsto_principal_principal.2 $ λ x, abs_pos.2
-
-end
-
-/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to `C`
-and `g` tends to `at_top` then `f + g` tends to `at_top`. -/
-lemma filter.tendsto.add_at_top {C : α} (hf : tendsto f l (𝓝 C)) (hg : tendsto g l at_top) :
-  tendsto (λ x, f x + g x) l at_top :=
-begin
-  nontriviality α,
-  obtain ⟨C', hC'⟩ : ∃ C', C' < C := exists_lt C,
-  refine tendsto_at_top_add_left_of_le' _ C' _ hg,
-  exact (hf.eventually (lt_mem_nhds hC')).mono (λ x, le_of_lt)
-end
-
-/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to `C`
-and `g` tends to `at_bot` then `f + g` tends to `at_bot`. -/
-lemma filter.tendsto.add_at_bot {C : α} (hf : tendsto f l (𝓝 C)) (hg : tendsto g l at_bot) :
-  tendsto (λ x, f x + g x) l at_bot :=
-@filter.tendsto.add_at_top αᵒᵈ _ _ _ _ _ _ _ _ hf hg
-
-/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to
-`at_top` and `g` tends to `C` then `f + g` tends to `at_top`. -/
-lemma filter.tendsto.at_top_add {C : α} (hf : tendsto f l at_top) (hg : tendsto g l (𝓝 C)) :
-  tendsto (λ x, f x + g x) l at_top :=
-by { conv in (_ + _) { rw add_comm }, exact hg.add_at_top hf }
-
-/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to
-`at_bot` and `g` tends to `C` then `f + g` tends to `at_bot`. -/
-lemma filter.tendsto.at_bot_add {C : α} (hf : tendsto f l at_bot) (hg : tendsto g l (𝓝 C)) :
-  tendsto (λ x, f x + g x) l at_bot :=
-by { conv in (_ + _) { rw add_comm }, exact hg.add_at_bot hf }
-
-end linear_ordered_add_comm_group
-
-section linear_ordered_field
-variables [linear_ordered_field α] [topological_space α] [order_topology α]
-variables {l : filter β} {f g : β → α}
-
-section continuous_mul
-
-lemma mul_tendsto_nhds_zero_right (x : α) :
-  tendsto (uncurry ((*) : α → α → α)) (𝓝 0 ×ᶠ 𝓝 x) $ 𝓝 0 :=
-begin
-  have hx : 0 < 2 * (1 + |x|) := (mul_pos (zero_lt_two) $
-    lt_of_lt_of_le zero_lt_one $ le_add_of_le_of_nonneg le_rfl (abs_nonneg x)),
-  rw ((nhds_basis_zero_abs_sub_lt α).prod $ nhds_basis_abs_sub_lt x).tendsto_iff
-     (nhds_basis_zero_abs_sub_lt α),
-  refine λ ε ε_pos, ⟨(ε/(2 * (1 + |x|)), 1), ⟨div_pos ε_pos hx, zero_lt_one⟩, _⟩,
-  suffices : ∀ (a b : α), |a| < ε / (2 * (1 + |x|)) → |b - x| < 1 → |a| * |b| < ε,
-  by simpa only [and_imp, prod.forall, mem_prod, ← abs_mul],
-  intros a b h h',
-  refine lt_of_le_of_lt (mul_le_mul_of_nonneg_left _ (abs_nonneg a)) ((lt_div_iff hx).1 h),
-  calc |b| = |(b - x) + x| : by rw sub_add_cancel b x
-    ... ≤ |b - x| + |x| : abs_add (b - x) x
-    ... ≤ 1 + |x| : add_le_add_right (le_of_lt h') (|x|)
-    ... ≤ 2 * (1 + |x|) : by linarith,
-end
-
-lemma mul_tendsto_nhds_zero_left (x : α) :
-  tendsto (uncurry ((*) : α → α → α)) (𝓝 x ×ᶠ 𝓝 0) $ 𝓝 0 :=
-begin
-  intros s hs,
-  have := mul_tendsto_nhds_zero_right x hs,
-  rw [filter.mem_map, mem_prod_iff] at this ⊢,
-  obtain ⟨U, hU, V, hV, h⟩ := this,
-  exact ⟨V, hV, U, hU, λ y hy, ((mul_comm y.2 y.1) ▸
-    h (⟨hy.2, hy.1⟩ : (prod.mk y.2 y.1) ∈ U ×ˢ V) : y.1 * y.2 ∈ s)⟩,
-end
-
-lemma nhds_eq_map_mul_left_nhds_one {x₀ : α} (hx₀ : x₀ ≠ 0) :
-  𝓝 x₀ = map (λ x, x₀*x) (𝓝 1) :=
-begin
-  have hx₀' : 0 < |x₀| := abs_pos.2 hx₀,
-  refine filter.ext (λ t, _),
-  simp only [exists_prop, set_of_subset_set_of, (nhds_basis_abs_sub_lt x₀).mem_iff,
-    (nhds_basis_abs_sub_lt (1 : α)).mem_iff, filter.mem_map'],
-  refine ⟨λ h, _, λ h, _⟩,
-  { obtain ⟨i, hi, hit⟩ := h,
-    refine ⟨i / (|x₀|), div_pos hi (abs_pos.2 hx₀), λ x hx, hit _⟩,
-    calc |x₀ * x - x₀| = |x₀ * (x - 1)| : congr_arg abs (by ring_nf)
-      ... = |x₀| * |x - 1| : abs_mul x₀ (x - 1)
-      ... < |x₀| * (i / |x₀|) : mul_lt_mul' le_rfl hx (abs_nonneg (x - 1)) (abs_pos.2 hx₀)
-      ... = |x₀| * i / |x₀| : by ring
-      ... = i : mul_div_cancel_left i (λ h, hx₀ (abs_eq_zero.1 h)) },
-  { obtain ⟨i, hi, hit⟩ := h,
-    refine ⟨i * |x₀|, mul_pos hi (abs_pos.2 hx₀), λ x hx, _⟩,
-    have : |x / x₀ - 1| < i,
-    calc |x / x₀ - 1| = |x / x₀ - x₀ / x₀| : (by rw div_self hx₀)
-    ... = |(x - x₀) / x₀| : congr_arg abs (sub_div x x₀ x₀).symm
-    ... = |x - x₀| / |x₀| : abs_div (x - x₀) x₀
-    ... < i * |x₀| / |x₀| : div_lt_div hx le_rfl
-      (mul_nonneg (le_of_lt hi) (abs_nonneg x₀)) (abs_pos.2 hx₀)
-    ... = i : by rw [← mul_div_assoc', div_self (ne_of_lt $ abs_pos.2 hx₀).symm, mul_one],
-    specialize hit (x / x₀) this,
-    rwa [mul_div_assoc', mul_div_cancel_left x hx₀] at hit }
-end
-
-lemma nhds_eq_map_mul_right_nhds_one {x₀ : α} (hx₀ : x₀ ≠ 0) :
-  𝓝 x₀ = map (λ x, x*x₀) (𝓝 1) :=
-by simp_rw [mul_comm _ x₀, nhds_eq_map_mul_left_nhds_one hx₀]
-
-lemma mul_tendsto_nhds_one_nhds_one :
-  tendsto (uncurry ((*) : α → α → α)) (𝓝 1 ×ᶠ 𝓝 1) $ 𝓝 1 :=
-begin
-  rw ((nhds_basis_Ioo_pos (1 : α)).prod $ nhds_basis_Ioo_pos (1 : α)).tendsto_iff
-     (nhds_basis_Ioo_pos_of_pos (zero_lt_one : (0 : α) < 1)),
-  intros ε hε,
-  have hε' : 0 ≤ 1 - ε / 4 := by linarith,
-  have ε_pos : 0 < ε / 4 := by linarith,
-  have ε_pos' : 0 < ε / 2 := by linarith,
-  simp only [and_imp, prod.forall, mem_Ioo, function.uncurry_apply_pair, mem_prod, prod.exists],
-  refine ⟨ε/4, ε/4, ⟨ε_pos, ε_pos⟩, λ a b ha ha' hb hb', _⟩,
-  have ha0 : 0 ≤ a := le_trans hε' (le_of_lt ha),
-  have hb0 : 0 ≤ b := le_trans hε' (le_of_lt hb),
-  refine ⟨lt_of_le_of_lt _ (mul_lt_mul'' ha hb hε' hε'),
-    lt_of_lt_of_le (mul_lt_mul'' ha' hb' ha0 hb0) _⟩,
-  { calc 1 - ε = 1 - ε / 2 - ε/2 : by ring_nf
-    ... ≤ 1 - ε/2 - ε/2 + (ε/2)*(ε/2) : le_add_of_nonneg_right (le_of_lt (mul_pos ε_pos' ε_pos'))
-    ... = (1 - ε/2) * (1 - ε/2) : by ring_nf
-    ... ≤ (1 - ε/4) * (1 - ε/4) : mul_le_mul (by linarith) (by linarith) (by linarith) hε' },
-  { calc (1 + ε/4) * (1 + ε/4) = 1 + ε/2 + (ε/4)*(ε/4) : by ring_nf
-    ... = 1 + ε/2 + (ε * ε) / 16 : by ring_nf
-    ... ≤ 1 + ε/2 + ε/2 : add_le_add_left (div_le_div (le_of_lt hε.1) (le_trans
-      ((mul_le_mul_left hε.1).2 hε.2) (le_of_eq $ mul_one ε)) zero_lt_two (by linarith)) (1 + ε/2)
-    ... ≤ 1 + ε : by ring_nf }
-end
-
-@[priority 100]
-instance linear_ordered_field.has_continuous_mul : has_continuous_mul α :=
-⟨begin
-  rw continuous_iff_continuous_at,
-  rintro ⟨x₀, y₀⟩,
-  by_cases hx₀ : x₀ = 0,
-  { rw [hx₀, continuous_at, zero_mul, nhds_prod_eq],
-    exact mul_tendsto_nhds_zero_right y₀ },
-  by_cases hy₀ : y₀ = 0,
-  { rw [hy₀, continuous_at, mul_zero, nhds_prod_eq],
-    exact mul_tendsto_nhds_zero_left x₀ },
-  have hxy : x₀ * y₀ ≠ 0 := mul_ne_zero hx₀ hy₀,
-  have key : (λ p : α × α, x₀ * p.1 * (p.2 * y₀)) = ((λ x, x₀*x) ∘ (λ x, x*y₀)) ∘ (uncurry (*)),
-  { ext p, simp [uncurry, mul_assoc] },
-  have key₂ : (λ x, x₀*x) ∘ (λ x, y₀*x) = λ x, (x₀ *y₀)*x,
-  { ext x, simp },
-  calc map (uncurry (*)) (𝓝 (x₀, y₀))
-      = map (uncurry (*)) (𝓝 x₀ ×ᶠ 𝓝 y₀) : by rw nhds_prod_eq
-  ... = map (λ (p : α × α), x₀ * p.1 * (p.2 * y₀)) ((𝓝 1) ×ᶠ (𝓝 1))
-          : by rw [uncurry, nhds_eq_map_mul_left_nhds_one hx₀, nhds_eq_map_mul_right_nhds_one hy₀,
-                    prod_map_map_eq, filter.map_map]
-  ... = map ((λ x, x₀ * x) ∘ λ x, x * y₀) (map (uncurry (*)) (𝓝 1 ×ᶠ 𝓝 1))
-          : by rw [key, ← filter.map_map]
-  ... ≤ map ((λ (x : α), x₀ * x) ∘ λ x, x * y₀) (𝓝 1) : map_mono (mul_tendsto_nhds_one_nhds_one)
-  ... = 𝓝 (x₀*y₀) : by rw [← filter.map_map, ← nhds_eq_map_mul_right_nhds_one hy₀,
-    nhds_eq_map_mul_left_nhds_one hy₀, filter.map_map, key₂, ← nhds_eq_map_mul_left_nhds_one hxy],
-end⟩
-
-end continuous_mul
-
-/-- In a linearly ordered field with the order topology, if `f` tends to `at_top` and `g` tends to
-a positive constant `C` then `f * g` tends to `at_top`. -/
-lemma filter.tendsto.at_top_mul {C : α} (hC : 0 < C) (hf : tendsto f l at_top)
-  (hg : tendsto g l (𝓝 C)) :
-  tendsto (λ x, (f x * g x)) l at_top :=
-begin
-  refine tendsto_at_top_mono' _ _ (hf.at_top_mul_const (half_pos hC)),
-  filter_upwards [hg.eventually (lt_mem_nhds (half_lt_self hC)),
-    hf.eventually (eventually_ge_at_top 0)] with x hg hf using mul_le_mul_of_nonneg_left hg.le hf,
-end
-
-/-- In a linearly ordered field with the order topology, if `f` tends to a positive constant `C` and
-`g` tends to `at_top` then `f * g` tends to `at_top`. -/
-lemma filter.tendsto.mul_at_top {C : α} (hC : 0 < C) (hf : tendsto f l (𝓝 C))
-  (hg : tendsto g l at_top) :
-  tendsto (λ x, (f x * g x)) l at_top :=
-by simpa only [mul_comm] using hg.at_top_mul hC hf
-
-/-- In a linearly ordered field with the order topology, if `f` tends to `at_top` and `g` tends to
-a negative constant `C` then `f * g` tends to `at_bot`. -/
-lemma filter.tendsto.at_top_mul_neg {C : α} (hC : C < 0) (hf : tendsto f l at_top)
-  (hg : tendsto g l (𝓝 C)) :
-  tendsto (λ x, (f x * g x)) l at_bot :=
-by simpa only [(∘), neg_mul_eq_mul_neg, neg_neg]
-  using tendsto_neg_at_top_at_bot.comp (hf.at_top_mul (neg_pos.2 hC) hg.neg)
-
-/-- In a linearly ordered field with the order topology, if `f` tends to a negative constant `C` and
-`g` tends to `at_top` then `f * g` tends to `at_bot`. -/
-lemma filter.tendsto.neg_mul_at_top {C : α} (hC : C < 0) (hf : tendsto f l (𝓝 C))
-  (hg : tendsto g l at_top) :
-  tendsto (λ x, (f x * g x)) l at_bot :=
-by simpa only [mul_comm] using hg.at_top_mul_neg hC hf
-
-/-- In a linearly ordered field with the order topology, if `f` tends to `at_bot` and `g` tends to
-a positive constant `C` then `f * g` tends to `at_bot`. -/
-lemma filter.tendsto.at_bot_mul {C : α} (hC : 0 < C) (hf : tendsto f l at_bot)
-  (hg : tendsto g l (𝓝 C)) :
-  tendsto (λ x, (f x * g x)) l at_bot :=
-by simpa [(∘)]
-  using tendsto_neg_at_top_at_bot.comp ((tendsto_neg_at_bot_at_top.comp hf).at_top_mul hC hg)
-
-/-- In a linearly ordered field with the order topology, if `f` tends to `at_bot` and `g` tends to
-a negative constant `C` then `f * g` tends to `at_top`. -/
-lemma filter.tendsto.at_bot_mul_neg {C : α} (hC : C < 0) (hf : tendsto f l at_bot)
-  (hg : tendsto g l (𝓝 C)) :
-  tendsto (λ x, (f x * g x)) l at_top :=
-by simpa [(∘)]
-  using tendsto_neg_at_bot_at_top.comp ((tendsto_neg_at_bot_at_top.comp hf).at_top_mul_neg hC hg)
-
-/-- In a linearly ordered field with the order topology, if `f` tends to a positive constant `C` and
-`g` tends to `at_bot` then `f * g` tends to `at_bot`. -/
-lemma filter.tendsto.mul_at_bot {C : α} (hC : 0 < C) (hf : tendsto f l (𝓝 C))
-  (hg : tendsto g l at_bot) :
-  tendsto (λ x, (f x * g x)) l at_bot :=
-by simpa only [mul_comm] using hg.at_bot_mul hC hf
-
-/-- In a linearly ordered field with the order topology, if `f` tends to a negative constant `C` and
-`g` tends to `at_bot` then `f * g` tends to `at_top`. -/
-lemma filter.tendsto.neg_mul_at_bot {C : α} (hC : C < 0) (hf : tendsto f l (𝓝 C))
-  (hg : tendsto g l at_bot) :
-  tendsto (λ x, (f x * g x)) l at_top :=
-by simpa only [mul_comm] using hg.at_bot_mul_neg hC hf
-
-/-- The function `x ↦ x⁻¹` tends to `+∞` on the right of `0`. -/
-lemma tendsto_inv_zero_at_top : tendsto (λx:α, x⁻¹) (𝓝[>] (0:α)) at_top :=
-begin
-  refine (at_top_basis' 1).tendsto_right_iff.2 (λ b hb, _),
-  have hb' : 0 < b := zero_lt_one.trans_le hb,
-  filter_upwards [Ioc_mem_nhds_within_Ioi ⟨le_rfl, inv_pos.2 hb'⟩]
-    with x hx using (le_inv hx.1 hb').1 hx.2,
-end
-
-/-- The function `r ↦ r⁻¹` tends to `0` on the right as `r → +∞`. -/
-lemma tendsto_inv_at_top_zero' : tendsto (λr:α, r⁻¹) at_top (𝓝[>] (0:α)) :=
-begin
-  refine (has_basis.tendsto_iff at_top_basis ⟨λ s, mem_nhds_within_Ioi_iff_exists_Ioc_subset⟩).2 _,
-  refine λ b hb, ⟨b⁻¹, trivial, λ x hx, _⟩,
-  have : 0 < x := lt_of_lt_of_le (inv_pos.2 hb) hx,
-  exact ⟨inv_pos.2 this, (inv_le this hb).2 hx⟩
-end
-
-lemma tendsto_inv_at_top_zero : tendsto (λr:α, r⁻¹) at_top (𝓝 0) :=
-tendsto_inv_at_top_zero'.mono_right inf_le_left
-
-lemma filter.tendsto.div_at_top [has_continuous_mul α] {f g : β → α} {l : filter β} {a : α}
-  (h : tendsto f l (𝓝 a)) (hg : tendsto g l at_top) : tendsto (λ x, f x / g x) l (𝓝 0) :=
-by { simp only [div_eq_mul_inv], exact mul_zero a ▸ h.mul (tendsto_inv_at_top_zero.comp hg) }
-
-lemma filter.tendsto.inv_tendsto_at_top (h : tendsto f l at_top) : tendsto (f⁻¹) l (𝓝 0) :=
-tendsto_inv_at_top_zero.comp h
-
-lemma filter.tendsto.inv_tendsto_zero (h : tendsto f l (𝓝[>] 0)) :
-  tendsto (f⁻¹) l at_top :=
-tendsto_inv_zero_at_top.comp h
-
-/-- The function `x^(-n)` tends to `0` at `+∞` for any positive natural `n`.
-A version for positive real powers exists as `tendsto_rpow_neg_at_top`. -/
-lemma tendsto_pow_neg_at_top {n : ℕ} (hn : 1 ≤ n) : tendsto (λ x : α, x ^ (-(n:ℤ))) at_top (𝓝 0) :=
-tendsto.congr (λ x, (zpow_neg₀ x n).symm)
-  (filter.tendsto.inv_tendsto_at_top (by simpa [zpow_coe_nat] using tendsto_pow_at_top hn))
-
-lemma tendsto_zpow_at_top_zero {n : ℤ} (hn : n < 0) :
-  tendsto (λ x : α, x^n) at_top (𝓝 0) :=
-begin
-  have : 1 ≤ -n := le_neg.mp (int.le_of_lt_add_one (hn.trans_le (neg_add_self 1).symm.le)),
-  apply tendsto.congr (show ∀ x : α, x^-(-n) = x^n, by simp),
-  lift -n to ℕ using le_of_lt (neg_pos.mpr hn) with N,
-  exact tendsto_pow_neg_at_top (by exact_mod_cast this)
-end
-
-lemma tendsto_const_mul_zpow_at_top_zero {n : ℤ} {c : α} (hn : n < 0) :
-  tendsto (λ x, c * x ^ n) at_top (𝓝 0) :=
-(mul_zero c) ▸ (filter.tendsto.const_mul c (tendsto_zpow_at_top_zero hn))
-
-lemma tendsto_const_mul_pow_nhds_iff {n : ℕ} {c d : α} (hc : c ≠ 0) :
-  tendsto (λ x : α, c * x ^ n) at_top (𝓝 d) ↔ n = 0 ∧ c = d :=
-begin
-  refine ⟨λ h, _, λ h, _⟩,
-  { have hn : n = 0,
-    { by_contradiction hn,
-      have hn : 1 ≤ n := nat.succ_le_iff.2 (lt_of_le_of_ne (zero_le _) (ne.symm hn)),
-      by_cases hc' : 0 < c,
-      { have := (tendsto_const_mul_pow_at_top_iff c n).2 ⟨hn, hc'⟩,
-        exact not_tendsto_nhds_of_tendsto_at_top this d h },
-      { have := (tendsto_neg_const_mul_pow_at_top_iff c n).2 ⟨hn, lt_of_le_of_ne (not_lt.1 hc') hc⟩,
-        exact not_tendsto_nhds_of_tendsto_at_bot this d h } },
-    have : (λ x : α, c * x ^ n) = (λ x : α, c), by simp [hn],
-    rw [this, tendsto_const_nhds_iff] at h,
-    exact ⟨hn, h⟩ },
-  { obtain ⟨hn, hcd⟩ := h,
-    simpa [hn, hcd] using tendsto_const_nhds }
-end
-
-lemma tendsto_const_mul_zpow_at_top_zero_iff {n : ℤ} {c d : α} (hc : c ≠ 0) :
-  tendsto (λ x : α, c * x ^ n) at_top (𝓝 d) ↔
-    (n = 0 ∧ c = d) ∨ (n < 0 ∧ d = 0) :=
-begin
-  refine ⟨λ h, _, λ h, _⟩,
-  { by_cases hn : 0 ≤ n,
-    { lift n to ℕ using hn,
-      simp only [zpow_coe_nat] at h,
-      rw [tendsto_const_mul_pow_nhds_iff hc, ← int.coe_nat_eq_zero] at h,
-      exact or.inl h },
-    { rw not_le at hn,
-      refine or.inr ⟨hn, tendsto_nhds_unique h (tendsto_const_mul_zpow_at_top_zero hn)⟩ } },
-  { cases h,
-    { simp only [h.left, h.right, zpow_zero, mul_one],
-      exact tendsto_const_nhds },
-    { exact h.2.symm ▸ tendsto_const_mul_zpow_at_top_zero h.1} }
-end
-
-end linear_ordered_field
-
-lemma preimage_neg [add_group α] : preimage (has_neg.neg : α → α) = image (has_neg.neg : α → α) :=
-(image_eq_preimage_of_inverse neg_neg neg_neg).symm
-
-lemma filter.map_neg_eq_comap_neg [add_group α] :
-  map (has_neg.neg : α → α) = comap (has_neg.neg : α → α) :=
-funext $ assume f, map_eq_comap_of_inverse (funext neg_neg) (funext neg_neg)
-
-section order_topology
-
-variables [topological_space α] [topological_space β]
-  [linear_order α] [linear_order β] [order_topology α] [order_topology β]
-
-lemma is_lub.frequently_mem {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
-  ∃ᶠ x in 𝓝[≤] a, x ∈ s :=
-begin
-  rcases hs with ⟨a', ha'⟩,
-  intro h,
-  rcases (ha.1 ha').eq_or_lt with (rfl|ha'a),
-  { exact h.self_of_nhds_within le_rfl ha' },
-  { rcases (mem_nhds_within_Iic_iff_exists_Ioc_subset' ha'a).1 h
-      with ⟨b, hba, hb⟩,
-    rcases ha.exists_between hba with ⟨b', hb's, hb'⟩,
-    exact hb hb' hb's },
-end
-
-lemma is_lub.frequently_nhds_mem {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
-  ∃ᶠ x in 𝓝 a, x ∈ s :=
-(ha.frequently_mem hs).filter_mono inf_le_left
-
-lemma is_glb.frequently_mem {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty) :
-  ∃ᶠ x in 𝓝[≥] a, x ∈ s :=
-@is_lub.frequently_mem αᵒᵈ _ _ _ _ _ ha hs
-
-lemma is_glb.frequently_nhds_mem {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty) :
-  ∃ᶠ x in 𝓝 a, x ∈ s :=
-(ha.frequently_mem hs).filter_mono inf_le_left
-
-lemma is_lub.mem_closure {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
-  a ∈ closure s :=
-(ha.frequently_nhds_mem hs).mem_closure
-
-lemma is_glb.mem_closure {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty) :
-  a ∈ closure s :=
-(ha.frequently_nhds_mem hs).mem_closure
-
-lemma is_lub.nhds_within_ne_bot {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
-  ne_bot (𝓝[s] a) :=
-mem_closure_iff_nhds_within_ne_bot.1 (ha.mem_closure hs)
-
-lemma is_glb.nhds_within_ne_bot : ∀ {a : α} {s : set α}, is_glb s a → s.nonempty →
-  ne_bot (𝓝[s] a) :=
-@is_lub.nhds_within_ne_bot αᵒᵈ _ _ _
-
-lemma is_lub_of_mem_nhds {s : set α} {a : α} {f : filter α}
-  (hsa : a ∈ upper_bounds s) (hsf : s ∈ f) [ne_bot (f ⊓ 𝓝 a)] : is_lub s a :=
-⟨hsa, assume b hb,
-  not_lt.1 $ assume hba,
-  have s ∩ {a | b < a} ∈ f ⊓ 𝓝 a,
-    from inter_mem_inf hsf (is_open.mem_nhds (is_open_lt' _) hba),
-  let ⟨x, ⟨hxs, hxb⟩⟩ := filter.nonempty_of_mem this in
-  have b < b, from lt_of_lt_of_le hxb $ hb hxs,
-  lt_irrefl b this⟩
-
-lemma is_lub_of_mem_closure {s : set α} {a : α} (hsa : a ∈ upper_bounds s) (hsf : a ∈ closure s) :
-  is_lub s a :=
-begin
-  rw [mem_closure_iff_cluster_pt, cluster_pt, inf_comm] at hsf,
-  haveI : (𝓟 s ⊓ 𝓝 a).ne_bot := hsf,
-  exact is_lub_of_mem_nhds hsa (mem_principal_self s),
-end
-
-lemma is_glb_of_mem_nhds : ∀ {s : set α} {a : α} {f : filter α},
-  a ∈ lower_bounds s → s ∈ f → ne_bot (f ⊓ 𝓝 a) → is_glb s a :=
-@is_lub_of_mem_nhds αᵒᵈ _ _ _
-
-lemma is_glb_of_mem_closure {s : set α} {a : α} (hsa : a ∈ lower_bounds s) (hsf : a ∈ closure s) :
-  is_glb s a :=
-@is_lub_of_mem_closure αᵒᵈ _ _ _ s a hsa hsf
-
-lemma is_lub.mem_upper_bounds_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
-  (hf : monotone_on f s) (ha : is_lub s a)
-  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ upper_bounds (f '' s) :=
-begin
-  rintro _ ⟨x, hx, rfl⟩,
-  replace ha := ha.inter_Ici_of_mem hx,
-  haveI := ha.nhds_within_ne_bot ⟨x, hx, le_rfl⟩,
-  refine ge_of_tendsto (hb.mono_left (nhds_within_mono _ (inter_subset_left s (Ici x)))) _,
-  exact mem_of_superset self_mem_nhds_within (λ y hy, hf hx hy.1 hy.2)
-end
-
--- For a version of this theorem in which the convergence considered on the domain `α` is as `x : α`
--- tends to infinity, rather than tending to a point `x` in `α`, see `is_lub_of_tendsto_at_top`
-lemma is_lub.is_lub_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
-  (hf : monotone_on f s) (ha : is_lub s a) (hs : s.nonempty)
-  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : is_lub (f '' s) b :=
-begin
-  haveI := ha.nhds_within_ne_bot hs,
-  exact ⟨ha.mem_upper_bounds_of_tendsto hf hb, λ b' hb', le_of_tendsto hb
-    (mem_of_superset self_mem_nhds_within $ λ x hx, hb' $ mem_image_of_mem _ hx)⟩
-end
-
-lemma is_glb.mem_lower_bounds_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
-  (hf : monotone_on f s) (ha : is_glb s a)
-  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ lower_bounds (f '' s) :=
-@is_lub.mem_upper_bounds_of_tendsto αᵒᵈ γᵒᵈ _ _ _ _ _ _ _ _ _ _ hf.dual ha hb
-
--- For a version of this theorem in which the convergence considered on the domain `α` is as
--- `x : α` tends to negative infinity, rather than tending to a point `x` in `α`, see
--- `is_glb_of_tendsto_at_bot`
-lemma is_glb.is_glb_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
-  (hf : monotone_on f s) : is_glb s a → s.nonempty →
-  tendsto f (𝓝[s] a) (𝓝 b) → is_glb (f '' s) b :=
-@is_lub.is_lub_of_tendsto αᵒᵈ γᵒᵈ _ _ _ _ _ _ f s a b hf.dual
-
-lemma is_lub.mem_lower_bounds_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
-  (hf : antitone_on f s) (ha : is_lub s a)
-  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ lower_bounds (f '' s) :=
-@is_lub.mem_upper_bounds_of_tendsto α γᵒᵈ _ _ _ _ _ _ _ _ _ _ hf ha hb
-
-lemma is_lub.is_glb_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] : ∀ {f : α → γ} {s : set α} {a : α} {b : γ},
-  (antitone_on f s) → is_lub s a → s.nonempty →
-  tendsto f (𝓝[s] a) (𝓝 b) → is_glb (f '' s) b :=
-@is_lub.is_lub_of_tendsto α γᵒᵈ _ _ _ _ _ _
-
-lemma is_glb.mem_upper_bounds_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
-  (hf : antitone_on f s) (ha : is_glb s a)
-  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ upper_bounds (f '' s) :=
-@is_glb.mem_lower_bounds_of_tendsto α γᵒᵈ _ _ _ _ _ _ _ _ _ _ hf ha hb
-
-lemma is_glb.is_lub_of_tendsto [preorder γ] [topological_space γ]
-  [order_closed_topology γ] : ∀ {f : α → γ} {s : set α} {a : α} {b : γ},
-  (antitone_on f s) → is_glb s a → s.nonempty →
-  tendsto f (𝓝[s] a) (𝓝 b) → is_lub (f '' s) b :=
-@is_glb.is_glb_of_tendsto α γᵒᵈ _ _ _ _ _ _
-
-lemma is_lub.mem_of_is_closed {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty)
-  (sc : is_closed s) : a ∈ s :=
-sc.closure_subset $ ha.mem_closure hs
-
-alias is_lub.mem_of_is_closed ← is_closed.is_lub_mem
-
-lemma is_glb.mem_of_is_closed {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty)
-  (sc : is_closed s) : a ∈ s :=
-sc.closure_subset $ ha.mem_closure hs
-
-alias is_glb.mem_of_is_closed ← is_closed.is_glb_mem
-
-/-!
-### Existence of sequences tending to Inf or Sup of a given set
--/
-
-lemma is_lub.exists_seq_strict_mono_tendsto_of_not_mem {t : set α} {x : α}
-  [is_countably_generated (𝓝 x)] (htx : is_lub t x) (not_mem : x ∉ t) (ht : t.nonempty) :
-  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n < x) ∧ tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
-begin
-  rcases ht with ⟨l, hl⟩,
-  have hl : l < x,
-   from (htx.1 hl).eq_or_lt.resolve_left (λ h,  (not_mem $ h ▸ hl).elim),
-  obtain ⟨s, hs⟩ : ∃ s : ℕ → set α, (𝓝 x).has_basis (λ (_x : ℕ), true) s :=
-    let ⟨s, hs⟩ := (𝓝 x).exists_antitone_basis in ⟨s, hs.to_has_basis⟩,
-  have : ∀ n k, k < x → ∃ y, Icc y x ⊆ s n ∧ k < y ∧ y < x ∧ y ∈ t,
-  { assume n k hk,
-    obtain ⟨L, hL, h⟩ : ∃ (L : α) (hL : L ∈ Ico k x), Ioc L x ⊆ s n :=
-      exists_Ioc_subset_of_mem_nhds' (hs.mem_of_mem trivial) hk,
-    obtain ⟨y, hy⟩ : ∃ (y : α), L < y ∧ y < x ∧ y ∈ t,
-    { rcases htx.exists_between' not_mem hL.2 with ⟨y, yt, hy⟩,
-      refine ⟨y, hy.1, hy.2, yt⟩ },
-    exact ⟨y, λ z hz, h ⟨hy.1.trans_le hz.1, hz.2⟩, hL.1.trans_lt hy.1, hy.2⟩ },
-  choose! f hf using this,
-  let u : ℕ → α := λ n, nat.rec_on n (f 0 l) (λ n h, f n.succ h),
-  have I : ∀ n, u n < x,
-  { assume n,
-    induction n with n IH,
-    { exact (hf 0 l hl).2.2.1 },
-    { exact (hf n.succ _ IH).2.2.1 } },
-  have S : strict_mono u := strict_mono_nat_of_lt_succ (λ n, (hf n.succ _ (I n)).2.1),
-  refine ⟨u, S, I, hs.tendsto_right_iff.2 (λ n _, _), (λ n, _)⟩,
-  { simp only [ge_iff_le, eventually_at_top],
-    refine ⟨n, λ p hp, _⟩,
-    have up : u p ∈ Icc (u n) x := ⟨S.monotone hp, (I p).le⟩,
-    have : Icc (u n) x ⊆ s n,
-      by { cases n, { exact (hf 0 l hl).1 }, { exact (hf n.succ (u n) (I n)).1 } },
-    exact this up },
-  { cases n,
-    { exact (hf 0 l hl).2.2.2 },
-    { exact (hf n.succ _ (I n)).2.2.2 } }
-end
-
-lemma is_lub.exists_seq_monotone_tendsto {t : set α} {x : α} [is_countably_generated (𝓝 x)]
-  (htx : is_lub t x) (ht : t.nonempty) :
-  ∃ u : ℕ → α, monotone u ∧ (∀ n, u n ≤ x) ∧ tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
-begin
-  by_cases h : x ∈ t,
-  { exact ⟨λ n, x, monotone_const, λ n, le_rfl, tendsto_const_nhds, λ n, h⟩ },
-  { rcases htx.exists_seq_strict_mono_tendsto_of_not_mem h ht  with ⟨u, hu⟩,
-    exact ⟨u, hu.1.monotone, λ n, (hu.2.1 n).le, hu.2.2⟩ }
-end
-
-lemma exists_seq_strict_mono_tendsto' {α : Type*} [linear_order α] [topological_space α]
-  [densely_ordered α] [order_topology α]
-  [first_countable_topology α] {x y : α} (hy : y < x) :
-  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n ∈ Ioo y x) ∧ tendsto u at_top (𝓝 x) :=
-begin
-  have hx : x ∉ Ioo y x := λ h, (lt_irrefl x h.2).elim,
-  have ht : set.nonempty (Ioo y x) := nonempty_Ioo.2 hy,
-  rcases (is_lub_Ioo hy).exists_seq_strict_mono_tendsto_of_not_mem hx ht with ⟨u, hu⟩,
-  exact ⟨u, hu.1, hu.2.2.symm⟩
-end
-
-lemma exists_seq_strict_mono_tendsto [densely_ordered α] [no_min_order α]
-  [first_countable_topology α] (x : α) :
-  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n < x) ∧ tendsto u at_top (𝓝 x) :=
-begin
-  obtain ⟨y, hy⟩ : ∃ y, y < x := exists_lt x,
-  rcases exists_seq_strict_mono_tendsto' hy with ⟨u, hu_mono, hu_mem, hux⟩,
-  exact ⟨u, hu_mono, λ n, (hu_mem n).2, hux⟩
-end
-
-lemma exists_seq_tendsto_Sup {α : Type*} [conditionally_complete_linear_order α]
-  [topological_space α] [order_topology α] [first_countable_topology α]
-  {S : set α} (hS : S.nonempty) (hS' : bdd_above S) :
-  ∃ (u : ℕ → α), monotone u ∧ tendsto u at_top (𝓝 (Sup S)) ∧ (∀ n, u n ∈ S) :=
-begin
-  rcases (is_lub_cSup hS hS').exists_seq_monotone_tendsto hS with ⟨u, hu⟩,
-  exact ⟨u, hu.1, hu.2.2⟩,
-end
-
-lemma is_glb.exists_seq_strict_anti_tendsto_of_not_mem {t : set α} {x : α}
-  [is_countably_generated (𝓝 x)] (htx : is_glb t x) (not_mem : x ∉ t) (ht : t.nonempty) :
-  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, x < u n) ∧
-                        tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
-@is_lub.exists_seq_strict_mono_tendsto_of_not_mem αᵒᵈ _ _ _ t x _ htx not_mem ht
-
-lemma is_glb.exists_seq_antitone_tendsto {t : set α} {x : α} [is_countably_generated (𝓝 x)]
-  (htx : is_glb t x) (ht : t.nonempty) :
-  ∃ u : ℕ → α, antitone u ∧ (∀ n, x ≤ u n) ∧
-                        tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
-@is_lub.exists_seq_monotone_tendsto αᵒᵈ _ _ _ t x _ htx ht
-
-lemma exists_seq_strict_anti_tendsto' [densely_ordered α]
-  [first_countable_topology α] {x y : α} (hy : x < y) :
-  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, u n ∈ Ioo x y) ∧ tendsto u at_top (𝓝 x) :=
-by simpa only [dual_Ioo] using exists_seq_strict_mono_tendsto' (order_dual.to_dual_lt_to_dual.2 hy)
-
-lemma exists_seq_strict_anti_tendsto [densely_ordered α] [no_max_order α]
-  [first_countable_topology α] (x : α) :
-  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, x < u n) ∧ tendsto u at_top (𝓝 x) :=
-@exists_seq_strict_mono_tendsto αᵒᵈ _ _ _ _ _ _ x
-
-lemma exists_seq_strict_anti_strict_mono_tendsto [densely_ordered α] [first_countable_topology α]
-  {x y : α} (h : x < y) :
-  ∃ (u v : ℕ → α), strict_anti u ∧ strict_mono v ∧ (∀ k, u k ∈ Ioo x y) ∧ (∀ l, v l ∈ Ioo x y) ∧
-    (∀ k l, u k < v l) ∧ tendsto u at_top (𝓝 x) ∧ tendsto v at_top (𝓝 y) :=
-begin
-  rcases exists_seq_strict_anti_tendsto' h with ⟨u, hu_anti, hu_mem, hux⟩,
-  rcases exists_seq_strict_mono_tendsto' (hu_mem 0).2 with ⟨v, hv_mono, hv_mem, hvy⟩,
-  exact ⟨u, v, hu_anti, hv_mono, hu_mem, λ l, ⟨(hu_mem 0).1.trans (hv_mem l).1, (hv_mem l).2⟩,
-    λ k l, (hu_anti.antitone (zero_le k)).trans_lt (hv_mem l).1, hux, hvy⟩
-end
-
-lemma exists_seq_tendsto_Inf {α : Type*} [conditionally_complete_linear_order α]
-  [topological_space α] [order_topology α] [first_countable_topology α]
-  {S : set α} (hS : S.nonempty) (hS' : bdd_below S) :
-  ∃ (u : ℕ → α), antitone u ∧ tendsto u at_top (𝓝 (Inf S)) ∧ (∀ n, u n ∈ S) :=
-@exists_seq_tendsto_Sup αᵒᵈ _ _ _ _ S hS hS'
-
-end order_topology
-
-section densely_ordered
-
-variables [topological_space α] [linear_order α] [order_topology α] [densely_ordered α]
-{a b : α} {s : set α}
-
-/-- The closure of the interval `(a, +∞)` is the closed interval `[a, +∞)`, unless `a` is a top
-element. -/
-lemma closure_Ioi' {a : α} (h : (Ioi a).nonempty) :
-  closure (Ioi a) = Ici a :=
-begin
-  apply subset.antisymm,
-  { exact closure_minimal Ioi_subset_Ici_self is_closed_Ici },
-  { rw [← diff_subset_closure_iff, Ici_diff_Ioi_same, singleton_subset_iff],
-    exact is_glb_Ioi.mem_closure h }
-end
-
-/-- The closure of the interval `(a, +∞)` is the closed interval `[a, +∞)`. -/
-@[simp] lemma closure_Ioi (a : α) [no_max_order α] :
-  closure (Ioi a) = Ici a :=
-closure_Ioi' nonempty_Ioi
-
-/-- The closure of the interval `(-∞, a)` is the closed interval `(-∞, a]`, unless `a` is a bottom
-element. -/
-lemma closure_Iio' (h : (Iio a).nonempty) : closure (Iio a) = Iic a := @closure_Ioi' αᵒᵈ _ _ _ _ _ h
-
-/-- The closure of the interval `(-∞, a)` is the interval `(-∞, a]`. -/
-@[simp] lemma closure_Iio (a : α) [no_min_order α] :
-  closure (Iio a) = Iic a :=
-closure_Iio' nonempty_Iio
-
-/-- The closure of the open interval `(a, b)` is the closed interval `[a, b]`. -/
-@[simp] lemma closure_Ioo {a b : α} (hab : a ≠ b) :
-  closure (Ioo a b) = Icc a b :=
-begin
-  apply subset.antisymm,
-  { exact closure_minimal Ioo_subset_Icc_self is_closed_Icc },
-  { cases hab.lt_or_lt with hab hab,
-    { rw [← diff_subset_closure_iff, Icc_diff_Ioo_same hab.le],
-      have hab' : (Ioo a b).nonempty, from nonempty_Ioo.2 hab,
-      simp only [insert_subset, singleton_subset_iff],
-      exact ⟨(is_glb_Ioo hab).mem_closure hab', (is_lub_Ioo hab).mem_closure hab'⟩ },
-    { rw Icc_eq_empty_of_lt hab, exact empty_subset _ } }
-end
-
-/-- The closure of the interval `(a, b]` is the closed interval `[a, b]`. -/
-@[simp] lemma closure_Ioc {a b : α} (hab : a ≠ b) :
-  closure (Ioc a b) = Icc a b :=
-begin
-  apply subset.antisymm,
-  { exact closure_minimal Ioc_subset_Icc_self is_closed_Icc },
-  { apply subset.trans _ (closure_mono Ioo_subset_Ioc_self),
-    rw closure_Ioo hab }
-end
-
-/-- The closure of the interval `[a, b)` is the closed interval `[a, b]`. -/
-@[simp] lemma closure_Ico {a b : α} (hab : a ≠ b) :
-  closure (Ico a b) = Icc a b :=
-begin
-  apply subset.antisymm,
-  { exact closure_minimal Ico_subset_Icc_self is_closed_Icc },
-  { apply subset.trans _ (closure_mono Ioo_subset_Ico_self),
-    rw closure_Ioo hab }
-end
-
-@[simp] lemma interior_Ici' {a : α} (ha : (Iio a).nonempty) : interior (Ici a) = Ioi a :=
-by rw [← compl_Iio, interior_compl, closure_Iio' ha, compl_Iic]
-
-lemma interior_Ici [no_min_order α] {a : α} : interior (Ici a) = Ioi a :=
-interior_Ici' nonempty_Iio
-
-@[simp] lemma interior_Iic' {a : α} (ha : (Ioi a).nonempty) : interior (Iic a) = Iio a :=
-@interior_Ici' αᵒᵈ _ _ _ _ _ ha
-
-lemma interior_Iic [no_max_order α] {a : α} : interior (Iic a) = Iio a :=
-interior_Iic' nonempty_Ioi
-
-@[simp] lemma interior_Icc [no_min_order α] [no_max_order α] {a b : α}:
-  interior (Icc a b) = Ioo a b :=
-by rw [← Ici_inter_Iic, interior_inter, interior_Ici, interior_Iic, Ioi_inter_Iio]
-
-@[simp] lemma interior_Ico [no_min_order α] {a b : α} : interior (Ico a b) = Ioo a b :=
-by rw [← Ici_inter_Iio, interior_inter, interior_Ici, interior_Iio, Ioi_inter_Iio]
-
-@[simp] lemma interior_Ioc [no_max_order α] {a b : α} : interior (Ioc a b) = Ioo a b :=
-by rw [← Ioi_inter_Iic, interior_inter, interior_Ioi, interior_Iic, Ioi_inter_Iio]
-
-lemma closure_interior_Icc {a b : α} (h : a ≠ b) : closure (interior (Icc a b)) = Icc a b :=
-(closure_minimal interior_subset is_closed_Icc).antisymm $
-calc Icc a b = closure (Ioo a b) : (closure_Ioo h).symm
-... ⊆ closure (interior (Icc a b)) : closure_mono (interior_maximal Ioo_subset_Icc_self is_open_Ioo)
-
-lemma Ioc_subset_closure_interior (a b : α) : Ioc a b ⊆ closure (interior (Ioc a b)) :=
-begin
-  rcases eq_or_ne a b with rfl|h,
-  { simp },
-  { calc Ioc a b ⊆ Icc a b : Ioc_subset_Icc_self
-    ... = closure (Ioo a b) : (closure_Ioo h).symm
-    ... ⊆ closure (interior (Ioc a b)) :
-      closure_mono (interior_maximal Ioo_subset_Ioc_self is_open_Ioo) }
-end
-
-lemma Ico_subset_closure_interior (a b : α) : Ico a b ⊆ closure (interior (Ico a b)) :=
-by simpa only [dual_Ioc]
-  using Ioc_subset_closure_interior (order_dual.to_dual b) (order_dual.to_dual a)
-
-@[simp] lemma frontier_Ici' {a : α} (ha : (Iio a).nonempty) : frontier (Ici a) = {a} :=
-by simp [frontier, ha]
-
-lemma frontier_Ici [no_min_order α] {a : α} : frontier (Ici a) = {a} :=
-frontier_Ici' nonempty_Iio
-
-@[simp] lemma frontier_Iic' {a : α} (ha : (Ioi a).nonempty) : frontier (Iic a) = {a} :=
-by simp [frontier, ha]
-
-lemma frontier_Iic [no_max_order α] {a : α} : frontier (Iic a) = {a} :=
-frontier_Iic' nonempty_Ioi
-
-@[simp] lemma frontier_Ioi' {a : α} (ha : (Ioi a).nonempty) : frontier (Ioi a) = {a} :=
-by simp [frontier, closure_Ioi' ha, Iic_diff_Iio, Icc_self]
-
-lemma frontier_Ioi [no_max_order α] {a : α} : frontier (Ioi a) = {a} :=
-frontier_Ioi' nonempty_Ioi
-
-@[simp] lemma frontier_Iio' {a : α} (ha : (Iio a).nonempty) : frontier (Iio a) = {a} :=
-by simp [frontier, closure_Iio' ha, Iic_diff_Iio, Icc_self]
-
-lemma frontier_Iio [no_min_order α] {a : α} : frontier (Iio a) = {a} :=
-frontier_Iio' nonempty_Iio
-
-@[simp] lemma frontier_Icc [no_min_order α] [no_max_order α] {a b : α} (h : a < b) :
-  frontier (Icc a b) = {a, b} :=
-by simp [frontier, le_of_lt h, Icc_diff_Ioo_same]
-
-@[simp] lemma frontier_Ioo {a b : α} (h : a < b) : frontier (Ioo a b) = {a, b} :=
-by rw [frontier, closure_Ioo h.ne, interior_Ioo, Icc_diff_Ioo_same h.le]
-
-@[simp] lemma frontier_Ico [no_min_order α] {a b : α} (h : a < b) : frontier (Ico a b) = {a, b} :=
-by rw [frontier, closure_Ico h.ne, interior_Ico, Icc_diff_Ioo_same h.le]
-
-@[simp] lemma frontier_Ioc [no_max_order α] {a b : α} (h : a < b) : frontier (Ioc a b) = {a, b} :=
-by rw [frontier, closure_Ioc h.ne, interior_Ioc, Icc_diff_Ioo_same h.le]
-
-lemma nhds_within_Ioi_ne_bot' {a b : α} (H₁ : (Ioi a).nonempty) (H₂ : a ≤ b) :
-  ne_bot (𝓝[Ioi a] b) :=
-mem_closure_iff_nhds_within_ne_bot.1 $ by rwa [closure_Ioi' H₁]
-
-lemma nhds_within_Ioi_ne_bot [no_max_order α] {a b : α} (H : a ≤ b) :
-  ne_bot (𝓝[Ioi a] b) :=
-nhds_within_Ioi_ne_bot' nonempty_Ioi H
-
-lemma nhds_within_Ioi_self_ne_bot' {a : α} (H : (Ioi a).nonempty) :
-  ne_bot (𝓝[>] a) :=
-nhds_within_Ioi_ne_bot' H (le_refl a)
-
-@[instance]
-lemma nhds_within_Ioi_self_ne_bot [no_max_order α] (a : α) :
-  ne_bot (𝓝[>] a) :=
-nhds_within_Ioi_ne_bot (le_refl a)
-
-lemma filter.eventually.exists_gt [no_max_order α] {a : α} {p : α → Prop} (h : ∀ᶠ x in 𝓝 a, p x) :
-  ∃ b > a, p b :=
-by simpa only [exists_prop, gt_iff_lt, and_comm]
-  using ((h.filter_mono (@nhds_within_le_nhds _ _ a (Ioi a))).and self_mem_nhds_within).exists
-
-lemma nhds_within_Iio_ne_bot' {b c : α} (H₁ : (Iio c).nonempty) (H₂ : b ≤ c) :
-  ne_bot (𝓝[Iio c] b) :=
-mem_closure_iff_nhds_within_ne_bot.1 $ by rwa closure_Iio' H₁
-
-lemma nhds_within_Iio_ne_bot [no_min_order α] {a b : α} (H : a ≤ b) :
-  ne_bot (𝓝[Iio b] a) :=
-nhds_within_Iio_ne_bot' nonempty_Iio H
-
-lemma nhds_within_Iio_self_ne_bot' {b : α} (H : (Iio b).nonempty) :
-  ne_bot (𝓝[<] b) :=
-nhds_within_Iio_ne_bot' H (le_refl b)
-
-@[instance]
-lemma nhds_within_Iio_self_ne_bot [no_min_order α] (a : α) :
-  ne_bot (𝓝[<] a) :=
-nhds_within_Iio_ne_bot (le_refl a)
-
-lemma filter.eventually.exists_lt [no_min_order α] {a : α} {p : α → Prop} (h : ∀ᶠ x in 𝓝 a, p x) :
-  ∃ b < a, p b :=
-@filter.eventually.exists_gt αᵒᵈ _ _ _ _ _ _ _ h
-
-lemma right_nhds_within_Ico_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ico a b] b) :=
-(is_lub_Ico H).nhds_within_ne_bot (nonempty_Ico.2 H)
-
-lemma left_nhds_within_Ioc_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ioc a b] a) :=
-(is_glb_Ioc H).nhds_within_ne_bot (nonempty_Ioc.2 H)
-
-lemma left_nhds_within_Ioo_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ioo a b] a) :=
-(is_glb_Ioo H).nhds_within_ne_bot (nonempty_Ioo.2 H)
-
-lemma right_nhds_within_Ioo_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ioo a b] b) :=
-(is_lub_Ioo H).nhds_within_ne_bot (nonempty_Ioo.2 H)
-
-lemma comap_coe_nhds_within_Iio_of_Ioo_subset (hb : s ⊆ Iio b)
-  (hs : s.nonempty → ∃ a < b, Ioo a b ⊆ s) :
-  comap (coe : s → α) (𝓝[<] b) = at_top :=
-begin
-  nontriviality,
-  haveI : nonempty s := nontrivial_iff_nonempty.1 ‹_›,
-  rcases hs (nonempty_subtype.1 ‹_›) with ⟨a, h, hs⟩,
-  ext u, split,
-  { rintros ⟨t, ht, hts⟩,
-    obtain ⟨x, ⟨hxa : a ≤ x, hxb : x < b⟩, hxt : Ioo x b ⊆ t⟩ :=
-      (mem_nhds_within_Iio_iff_exists_mem_Ico_Ioo_subset h).mp ht,
-    obtain ⟨y, hxy, hyb⟩ := exists_between hxb,
-    refine mem_of_superset (mem_at_top ⟨y, hs ⟨hxa.trans_lt hxy, hyb⟩⟩) _,
-    rintros ⟨z, hzs⟩ (hyz : y ≤ z),
-    refine hts (hxt ⟨hxy.trans_le _, hb _⟩); assumption },
-  { intros hu,
-    obtain ⟨x : s, hx : ∀ z, x ≤ z → z ∈ u⟩ := mem_at_top_sets.1 hu,
-    exact ⟨Ioo x b, Ioo_mem_nhds_within_Iio (right_mem_Ioc.2 $ hb x.2), λ z hz, hx _ hz.1.le⟩ }
-end
-
-lemma comap_coe_nhds_within_Ioi_of_Ioo_subset (ha : s ⊆ Ioi a)
-  (hs : s.nonempty → ∃ b > a, Ioo a b ⊆ s) :
-  comap (coe : s → α) (𝓝[>] a) = at_bot :=
-comap_coe_nhds_within_Iio_of_Ioo_subset
-  (show of_dual ⁻¹' s ⊆ Iio (to_dual a), from ha)
-  (λ h, by simpa only [order_dual.exists, dual_Ioo] using hs h)
-
-lemma map_coe_at_top_of_Ioo_subset (hb : s ⊆ Iio b)
-  (hs : ∀ a' < b, ∃ a < b, Ioo a b ⊆ s) :
-  map (coe : s → α) at_top = 𝓝[<] b :=
-begin
-  rcases eq_empty_or_nonempty (Iio b) with (hb'|⟨a, ha⟩),
-  { rw [filter_eq_bot_of_is_empty at_top, filter.map_bot, hb', nhds_within_empty],
-    exact ⟨λ x, hb'.subset (hb x.2)⟩ },
-  { rw [← comap_coe_nhds_within_Iio_of_Ioo_subset hb (λ _, hs a ha), map_comap_of_mem],
-    rw subtype.range_coe,
-    exact (mem_nhds_within_Iio_iff_exists_Ioo_subset' ha).2 (hs a ha) },
-end
-
-lemma map_coe_at_bot_of_Ioo_subset (ha : s ⊆ Ioi a)
-  (hs : ∀ b' > a, ∃ b > a, Ioo a b ⊆ s) :
-  map (coe : s → α) at_bot = (𝓝[>] a) :=
-begin
-  -- the elaborator gets stuck without `(... : _)`
-  refine (map_coe_at_top_of_Ioo_subset
-    (show of_dual ⁻¹' s ⊆ Iio (to_dual a), from ha) (λ b' hb', _) : _),
-  simpa only [order_dual.exists, dual_Ioo] using hs b' hb',
-end
-
-/-- The `at_top` filter for an open interval `Ioo a b` comes from the left-neighbourhoods filter at
-the right endpoint in the ambient order. -/
-lemma comap_coe_Ioo_nhds_within_Iio (a b : α) :
-  comap (coe : Ioo a b → α) (𝓝[<] b) = at_top :=
-comap_coe_nhds_within_Iio_of_Ioo_subset Ioo_subset_Iio_self $
-  λ h, ⟨a, nonempty_Ioo.1 h, subset.refl _⟩
-
-/-- The `at_bot` filter for an open interval `Ioo a b` comes from the right-neighbourhoods filter at
-the left endpoint in the ambient order. -/
-lemma comap_coe_Ioo_nhds_within_Ioi (a b : α) :
-  comap (coe : Ioo a b → α) (𝓝[>] a) = at_bot :=
-comap_coe_nhds_within_Ioi_of_Ioo_subset Ioo_subset_Ioi_self $
-  λ h, ⟨b, nonempty_Ioo.1 h, subset.refl _⟩
-
-lemma comap_coe_Ioi_nhds_within_Ioi (a : α) : comap (coe : Ioi a → α) (𝓝[>] a) = at_bot :=
-comap_coe_nhds_within_Ioi_of_Ioo_subset (subset.refl _) $
-  λ ⟨x, hx⟩, ⟨x, hx, Ioo_subset_Ioi_self⟩
-
-lemma comap_coe_Iio_nhds_within_Iio (a : α) :
-  comap (coe : Iio a → α) (𝓝[<] a) = at_top :=
-@comap_coe_Ioi_nhds_within_Ioi αᵒᵈ _ _ _ _ a
-
-@[simp] lemma map_coe_Ioo_at_top {a b : α} (h : a < b) :
-  map (coe : Ioo a b → α) at_top = 𝓝[<] b :=
-map_coe_at_top_of_Ioo_subset Ioo_subset_Iio_self $ λ _ _, ⟨_, h, subset.refl _⟩
-
-@[simp] lemma map_coe_Ioo_at_bot {a b : α} (h : a < b) :
-  map (coe : Ioo a b → α) at_bot = 𝓝[>] a :=
-map_coe_at_bot_of_Ioo_subset Ioo_subset_Ioi_self $ λ _ _, ⟨_, h, subset.refl _⟩
-
-@[simp] lemma map_coe_Ioi_at_bot (a : α) :
-  map (coe : Ioi a → α) at_bot = 𝓝[>] a :=
-map_coe_at_bot_of_Ioo_subset (subset.refl _) $ λ b hb, ⟨b, hb, Ioo_subset_Ioi_self⟩
-
-@[simp] lemma map_coe_Iio_at_top (a : α) :
-  map (coe : Iio a → α) at_top = 𝓝[<] a :=
-@map_coe_Ioi_at_bot αᵒᵈ _ _ _ _ _
-
-variables {l : filter β} {f : α → β}
-
-@[simp] lemma tendsto_comp_coe_Ioo_at_top (h : a < b) :
-  tendsto (λ x : Ioo a b, f x) at_top l ↔ tendsto f (𝓝[<] b) l :=
-by rw [← map_coe_Ioo_at_top h, tendsto_map'_iff]
-
-@[simp] lemma tendsto_comp_coe_Ioo_at_bot (h : a < b) :
-  tendsto (λ x : Ioo a b, f x) at_bot l ↔ tendsto f (𝓝[>] a) l :=
-by rw [← map_coe_Ioo_at_bot h, tendsto_map'_iff]
-
-@[simp] lemma tendsto_comp_coe_Ioi_at_bot :
-  tendsto (λ x : Ioi a, f x) at_bot l ↔ tendsto f (𝓝[>] a) l :=
-by rw [← map_coe_Ioi_at_bot, tendsto_map'_iff]
-
-@[simp] lemma tendsto_comp_coe_Iio_at_top :
-  tendsto (λ x : Iio a, f x) at_top l ↔ tendsto f (𝓝[<] a) l :=
-by rw [← map_coe_Iio_at_top, tendsto_map'_iff]
-
-@[simp] lemma tendsto_Ioo_at_top {f : β → Ioo a b} :
-  tendsto f l at_top ↔ tendsto (λ x, (f x : α)) l (𝓝[<] b) :=
-by rw [← comap_coe_Ioo_nhds_within_Iio, tendsto_comap_iff]
-
-@[simp] lemma tendsto_Ioo_at_bot {f : β → Ioo a b} :
-  tendsto f l at_bot ↔ tendsto (λ x, (f x : α)) l (𝓝[>] a) :=
-by rw [← comap_coe_Ioo_nhds_within_Ioi, tendsto_comap_iff]
-
-@[simp] lemma tendsto_Ioi_at_bot {f : β → Ioi a} :
-  tendsto f l at_bot ↔ tendsto (λ x, (f x : α)) l (𝓝[>] a) :=
-by rw [← comap_coe_Ioi_nhds_within_Ioi, tendsto_comap_iff]
-
-@[simp] lemma tendsto_Iio_at_top {f : β → Iio a} :
-  tendsto f l at_top ↔ tendsto (λ x, (f x : α)) l (𝓝[<] a) :=
-by rw [← comap_coe_Iio_nhds_within_Iio, tendsto_comap_iff]
-
-lemma dense_iff_forall_lt_exists_mem [nontrivial α] {s : set α} :
-  dense s ↔ ∀ a b, a < b → ∃ c ∈ s, a < c ∧ c < b :=
-begin
-  split,
-  { assume h a b hab,
-    obtain ⟨c, ⟨hc, cs⟩⟩ : ((Ioo a b) ∩ s).nonempty :=
-      dense_iff_inter_open.1 h (Ioo a b) is_open_Ioo (nonempty_Ioo.2 hab),
-    exact ⟨c, cs, hc⟩ },
-  { assume h,
-    apply dense_iff_inter_open.2 (λ U U_open U_nonempty, _),
-    obtain ⟨a, b, hab, H⟩ : ∃ (a b : α), a < b ∧ Ioo a b ⊆ U := U_open.exists_Ioo_subset U_nonempty,
-    obtain ⟨x, xs, hx⟩ : ∃ (x : α) (H : x ∈ s), a < x ∧ x < b := h a b hab,
-    exact ⟨x, ⟨H hx, xs⟩⟩ }
-end
-
-instance (x : α) [nontrivial α] : ne_bot (𝓝[≠] x) :=
-begin
-  apply forall_mem_nonempty_iff_ne_bot.1 (λ s hs, _),
-  obtain ⟨u, u_open, xu, us⟩ : ∃ (u : set α), is_open u ∧ x ∈ u ∧ u ∩ {x}ᶜ ⊆ s :=
-    mem_nhds_within.1 hs,
-  obtain ⟨a, b, a_lt_b, hab⟩ : ∃ (a b : α), a < b ∧ Ioo a b ⊆ u := u_open.exists_Ioo_subset ⟨x, xu⟩,
-  obtain ⟨y, hy⟩ : ∃ y, a < y ∧ y < b := exists_between a_lt_b,
-  rcases ne_or_eq x y with xy|rfl,
-  { exact ⟨y, us ⟨hab hy, xy.symm⟩⟩ },
-  obtain ⟨z, hz⟩ : ∃ z, a < z ∧ z < x := exists_between hy.1,
-  exact ⟨z, us ⟨hab ⟨hz.1, hz.2.trans hy.2⟩, hz.2.ne⟩⟩,
-end
-
-/-- Let `s` be a dense set in a nontrivial dense linear order `α`. If `s` is a
-separable space (e.g., if `α` has a second countable topology), then there exists a countable
-dense subset `t ⊆ s` such that `t` does not contain bottom/top elements of `α`. -/
-lemma dense.exists_countable_dense_subset_no_bot_top [nontrivial α]
-  {s : set α} [separable_space s] (hs : dense s) :
-  ∃ t ⊆ s, countable t ∧ dense t ∧ (∀ x, is_bot x → x ∉ t) ∧ (∀ x, is_top x → x ∉ t) :=
-begin
-  rcases hs.exists_countable_dense_subset with ⟨t, hts, htc, htd⟩,
-  refine ⟨t \ ({x | is_bot x} ∪ {x | is_top x}), _, _, _, _, _⟩,
-  { exact (diff_subset _ _).trans hts },
-  { exact htc.mono (diff_subset _ _) },
-  { exact htd.diff_finite ((subsingleton_is_bot α).finite.union (subsingleton_is_top α).finite) },
-  { assume x hx, simp [hx] },
-  { assume x hx, simp [hx] }
-end
-
-variable (α)
-/-- If `α` is a nontrivial separable dense linear order, then there exists a
-countable dense set `s : set α` that contains neither top nor bottom elements of `α`.
-For a dense set containing both bot and top elements, see
-`exists_countable_dense_bot_top`. -/
-lemma exists_countable_dense_no_bot_top [separable_space α] [nontrivial α] :
-  ∃ s : set α, countable s ∧ dense s ∧ (∀ x, is_bot x → x ∉ s) ∧ (∀ x, is_top x → x ∉ s) :=
-by simpa using dense_univ.exists_countable_dense_subset_no_bot_top
-
-end densely_ordered
-
-section complete_linear_order
-
-variables [complete_linear_order α] [topological_space α] [order_topology α]
-  [complete_linear_order β] [topological_space β] [order_topology β] [nonempty γ]
-
-lemma Sup_mem_closure {α : Type u} [topological_space α] [complete_linear_order α]
-  [order_topology α] {s : set α} (hs : s.nonempty) :
-  Sup s ∈ closure s :=
-(is_lub_Sup s).mem_closure hs
-
-lemma Inf_mem_closure {α : Type u} [topological_space α] [complete_linear_order α]
-  [order_topology α] {s : set α} (hs : s.nonempty) :
-  Inf s ∈ closure s :=
-(is_glb_Inf s).mem_closure hs
-
-lemma is_closed.Sup_mem {α : Type u} [topological_space α] [complete_linear_order α]
-  [order_topology α] {s : set α} (hs : s.nonempty) (hc : is_closed s) :
-  Sup s ∈ s :=
-(is_lub_Sup s).mem_of_is_closed hs hc
-
-lemma is_closed.Inf_mem {α : Type u} [topological_space α] [complete_linear_order α]
-  [order_topology α] {s : set α} (hs : s.nonempty) (hc : is_closed s) :
-  Inf s ∈ s :=
-(is_glb_Inf s).mem_of_is_closed hs hc
-
-/-- A monotone function continuous at the supremum of a nonempty set sends this supremum to
-the supremum of the image of this set. -/
-lemma map_Sup_of_continuous_at_of_monotone' {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
-  (Mf : monotone f) (hs : s.nonempty) :
-  f (Sup s) = Sup (f '' s) :=
---This is a particular case of the more general is_lub.is_lub_of_tendsto
-((is_lub_Sup _).is_lub_of_tendsto (λ x hx y hy xy, Mf xy) hs $
-  Cf.mono_left inf_le_left).Sup_eq.symm
-
-/-- A monotone function `s` sending `bot` to `bot` and continuous at the supremum of a set sends
-this supremum to the supremum of the image of this set. -/
-lemma map_Sup_of_continuous_at_of_monotone {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
-  (Mf : monotone f) (fbot : f ⊥ = ⊥) :
-  f (Sup s) = Sup (f '' s) :=
-begin
-  cases s.eq_empty_or_nonempty with h h,
-  { simp [h, fbot] },
-  { exact map_Sup_of_continuous_at_of_monotone' Cf Mf h }
-end
-
-/-- A monotone function continuous at the indexed supremum over a nonempty `Sort` sends this indexed
-supremum to the indexed supremum of the composition. -/
-lemma map_supr_of_continuous_at_of_monotone' {ι : Sort*} [nonempty ι] {f : α → β} {g : ι → α}
-  (Cf : continuous_at f (supr g)) (Mf : monotone f) :
-  f (⨆ i, g i) = ⨆ i, f (g i) :=
-by rw [supr, map_Sup_of_continuous_at_of_monotone' Cf Mf (range_nonempty g), ← range_comp, supr]
-
-/-- If a monotone function sending `bot` to `bot` is continuous at the indexed supremum over
-a `Sort`, then it sends this indexed supremum to the indexed supremum of the composition. -/
-lemma map_supr_of_continuous_at_of_monotone {ι : Sort*} {f : α → β} {g : ι → α}
-  (Cf : continuous_at f (supr g)) (Mf : monotone f) (fbot : f ⊥ = ⊥) :
-  f (⨆ i, g i) = ⨆ i, f (g i) :=
-by rw [supr, map_Sup_of_continuous_at_of_monotone Cf Mf fbot, ← range_comp, supr]
-
-/-- A monotone function continuous at the infimum of a nonempty set sends this infimum to
-the infimum of the image of this set. -/
-lemma map_Inf_of_continuous_at_of_monotone' {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
-  (Mf : monotone f) (hs : s.nonempty) :
-  f (Inf s) = Inf (f '' s) :=
-@map_Sup_of_continuous_at_of_monotone' αᵒᵈ βᵒᵈ _ _ _ _ _ _ f s Cf Mf.dual hs
-
-/-- A monotone function `s` sending `top` to `top` and continuous at the infimum of a set sends
-this infimum to the infimum of the image of this set. -/
-lemma map_Inf_of_continuous_at_of_monotone {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
-  (Mf : monotone f) (ftop : f ⊤ = ⊤) :
-  f (Inf s) = Inf (f '' s) :=
-@map_Sup_of_continuous_at_of_monotone αᵒᵈ βᵒᵈ _ _ _ _ _ _ f s Cf Mf.dual ftop
-
-/-- A monotone function continuous at the indexed infimum over a nonempty `Sort` sends this indexed
-infimum to the indexed infimum of the composition. -/
-lemma map_infi_of_continuous_at_of_monotone' {ι : Sort*} [nonempty ι] {f : α → β} {g : ι → α}
-  (Cf : continuous_at f (infi g)) (Mf : monotone f) :
-  f (⨅ i, g i) = ⨅ i, f (g i) :=
-@map_supr_of_continuous_at_of_monotone' αᵒᵈ βᵒᵈ _ _ _ _ _ _ ι _ f g Cf Mf.dual
-
-/-- If a monotone function sending `top` to `top` is continuous at the indexed infimum over
-a `Sort`, then it sends this indexed infimum to the indexed infimum of the composition. -/
-lemma map_infi_of_continuous_at_of_monotone {ι : Sort*} {f : α → β} {g : ι → α}
-  (Cf : continuous_at f (infi g)) (Mf : monotone f) (ftop : f ⊤ = ⊤) :
-  f (infi g) = infi (f ∘ g) :=
-@map_supr_of_continuous_at_of_monotone αᵒᵈ βᵒᵈ _ _ _ _ _ _ ι f g Cf Mf.dual ftop
-
-end complete_linear_order
-
-section conditionally_complete_linear_order
-
-variables [conditionally_complete_linear_order α] [topological_space α] [order_topology α]
-  [conditionally_complete_linear_order β] [topological_space β] [order_topology β] [nonempty γ]
-
-lemma cSup_mem_closure {s : set α} (hs : s.nonempty) (B : bdd_above s) : Sup s ∈ closure s :=
-(is_lub_cSup hs B).mem_closure hs
-
-lemma cInf_mem_closure {s : set α} (hs : s.nonempty) (B : bdd_below s) : Inf s ∈ closure s :=
-(is_glb_cInf hs B).mem_closure hs
-
-lemma is_closed.cSup_mem {s : set α} (hc : is_closed s) (hs : s.nonempty) (B : bdd_above s) :
-  Sup s ∈ s :=
-(is_lub_cSup hs B).mem_of_is_closed hs hc
-
-lemma is_closed.cInf_mem {s : set α} (hc : is_closed s) (hs : s.nonempty) (B : bdd_below s) :
-  Inf s ∈ s :=
-(is_glb_cInf hs B).mem_of_is_closed hs hc
-
-/-- If a monotone function is continuous at the supremum of a nonempty bounded above set `s`,
-then it sends this supremum to the supremum of the image of `s`. -/
-lemma map_cSup_of_continuous_at_of_monotone {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
-  (Mf : monotone f) (ne : s.nonempty) (H : bdd_above s) :
-  f (Sup s) = Sup (f '' s) :=
-begin
-  refine ((is_lub_cSup (ne.image f) (Mf.map_bdd_above H)).unique _).symm,
-  refine (is_lub_cSup ne H).is_lub_of_tendsto (λx hx y hy xy, Mf xy)  ne _,
-  exact Cf.mono_left inf_le_left
-end
-
-/-- If a monotone function is continuous at the indexed supremum of a bounded function on
-a nonempty `Sort`, then it sends this supremum to the supremum of the composition. -/
-lemma map_csupr_of_continuous_at_of_monotone {f : α → β} {g : γ → α}
-  (Cf : continuous_at f (⨆ i, g i)) (Mf : monotone f) (H : bdd_above (range g)) :
-  f (⨆ i, g i) = ⨆ i, f (g i) :=
-by rw [supr, map_cSup_of_continuous_at_of_monotone Cf Mf (range_nonempty _) H, ← range_comp, supr]
-
-/-- If a monotone function is continuous at the infimum of a nonempty bounded below set `s`,
-then it sends this infimum to the infimum of the image of `s`. -/
-lemma map_cInf_of_continuous_at_of_monotone {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
-  (Mf : monotone f) (ne : s.nonempty) (H : bdd_below s) :
-  f (Inf s) = Inf (f '' s) :=
-@map_cSup_of_continuous_at_of_monotone αᵒᵈ βᵒᵈ _ _ _ _ _ _ f s Cf Mf.dual ne H
-
-/-- A continuous monotone function sends indexed infimum to indexed infimum in conditionally
-complete linear order, under a boundedness assumption. -/
-lemma map_cinfi_of_continuous_at_of_monotone {f : α → β} {g : γ → α}
-  (Cf : continuous_at f (⨅ i, g i)) (Mf : monotone f) (H : bdd_below (range g)) :
-  f (⨅ i, g i) = ⨅ i, f (g i) :=
-@map_csupr_of_continuous_at_of_monotone αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ _ Cf Mf.dual H
-
-/-- A monotone map has a limit to the left of any point `x`, equal to `Sup (f '' (Iio x))`. -/
-lemma monotone.tendsto_nhds_within_Iio
-  {α : Type*} [linear_order α] [topological_space α] [order_topology α]
-  {f : α → β} (Mf : monotone f) (x : α) :
-  tendsto f (𝓝[<] x) (𝓝 (Sup (f '' (Iio x)))) :=
-begin
-  rcases eq_empty_or_nonempty (Iio x) with h|h, { simp [h] },
-  refine tendsto_order.2 ⟨λ l hl, _, λ m hm, _⟩,
-  { obtain ⟨z, zx, lz⟩ : ∃ (a : α), a < x ∧ l < f a,
-      by simpa only [mem_image, exists_prop, exists_exists_and_eq_and]
-        using exists_lt_of_lt_cSup (nonempty_image_iff.2 h) hl,
-    exact (mem_nhds_within_Iio_iff_exists_Ioo_subset' zx).2
-      ⟨z, zx, λ y hy, lz.trans_le (Mf (hy.1.le))⟩ },
-  { filter_upwards [self_mem_nhds_within] with _ hy,
-    apply lt_of_le_of_lt _ hm,
-    exact le_cSup (Mf.map_bdd_above bdd_above_Iio) (mem_image_of_mem _ hy), },
-end
-
-/-- A monotone map has a limit to the right of any point `x`, equal to `Inf (f '' (Ioi x))`. -/
-lemma monotone.tendsto_nhds_within_Ioi
-  {α : Type*} [linear_order α] [topological_space α] [order_topology α]
-  {f : α → β} (Mf : monotone f) (x : α) :
-  tendsto f (𝓝[>] x) (𝓝 (Inf (f '' (Ioi x)))) :=
-@monotone.tendsto_nhds_within_Iio βᵒᵈ _ _ _ αᵒᵈ _ _ _ f Mf.dual x
-
-end conditionally_complete_linear_order
-
-end order_topology
diff --git a/src/topology/algebra/order/compact.lean b/src/topology/algebra/order/compact.lean
index 469fa59f229be..0eedd6364138d 100644
--- a/src/topology/algebra/order/compact.lean
+++ b/src/topology/algebra/order/compact.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Yury Kudryashov
 -/
 import topology.algebra.order.intermediate_value
+import topology.local_extr
 
 /-!
 # Compactness of a closed interval
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that a closed interval in a conditionally complete linear ordered type with
 order topology (or a product of such types) is compact.
 
@@ -24,7 +28,7 @@ compact, extreme value theorem
 -/
 
 open filter order_dual topological_space function set
-open_locale filter topological_space
+open_locale filter topology
 
 /-!
 ### Compactness of a closed interval
@@ -107,8 +111,8 @@ instance {α β : Type*} [preorder α] [topological_space α] [compact_Icc_space
 ⟨λ a b, (Icc_prod_eq a b).symm ▸ is_compact_Icc.prod is_compact_Icc⟩
 
 /-- An unordered closed interval is compact. -/
-lemma is_compact_interval {α : Type*} [linear_order α] [topological_space α] [compact_Icc_space α]
-  {a b : α} : is_compact (interval a b) :=
+lemma is_compact_uIcc {α : Type*} [linear_order α] [topological_space α] [compact_Icc_space α]
+  {a b : α} : is_compact (uIcc a b) :=
 is_compact_Icc
 
 /-- A complete linear order is a compact space.
@@ -132,80 +136,39 @@ is_compact_iff_compact_space.mp is_compact_Icc
 end
 
 /-!
-### Min and max elements of a compact set
+### Extreme value theorem
 -/
 
-variables {α β γ : Type*} [conditionally_complete_linear_order α] [topological_space α]
-  [order_topology α] [topological_space β] [topological_space γ]
-
-lemma is_compact.Inf_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
-  Inf s ∈ s :=
-hs.is_closed.cInf_mem ne_s hs.bdd_below
-
-lemma is_compact.Sup_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) : Sup s ∈ s :=
-@is_compact.Inf_mem αᵒᵈ _ _ _ _ hs ne_s
-
-lemma is_compact.is_glb_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
-  is_glb s (Inf s) :=
-is_glb_cInf ne_s hs.bdd_below
-
-lemma is_compact.is_lub_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
-  is_lub s (Sup s) :=
-@is_compact.is_glb_Inf αᵒᵈ _ _ _ _ hs ne_s
-
-lemma is_compact.is_least_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
-  is_least s (Inf s) :=
-⟨hs.Inf_mem ne_s, (hs.is_glb_Inf ne_s).1⟩
+section linear_order
 
-lemma is_compact.is_greatest_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
-  is_greatest s (Sup s) :=
-@is_compact.is_least_Inf αᵒᵈ _ _ _ _ hs ne_s
+variables {α β γ : Type*} [linear_order α] [topological_space α]
+  [order_closed_topology α] [topological_space β] [topological_space γ]
 
 lemma is_compact.exists_is_least {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
   ∃ x, is_least s x :=
-⟨_, hs.is_least_Inf ne_s⟩
+begin
+  haveI : nonempty s := ne_s.to_subtype,
+  suffices : (s ∩ ⋂ x ∈ s, Iic x).nonempty,
+    from ⟨this.some, this.some_spec.1, mem_Inter₂.mp this.some_spec.2⟩,
+  rw bInter_eq_Inter,
+  by_contra H,
+  rw not_nonempty_iff_eq_empty at H,
+  rcases hs.elim_directed_family_closed (λ x : s, Iic ↑x) (λ x, is_closed_Iic) H
+    ((is_total.directed coe).mono_comp _ (λ _ _, Iic_subset_Iic.mpr)) with ⟨x, hx⟩,
+  exact not_nonempty_iff_eq_empty.mpr hx ⟨x, x.2, le_rfl⟩
+end
 
 lemma is_compact.exists_is_greatest {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
   ∃ x, is_greatest s x :=
-⟨_, hs.is_greatest_Sup ne_s⟩
+@is_compact.exists_is_least αᵒᵈ _ _ _ _ hs ne_s
 
 lemma is_compact.exists_is_glb {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
   ∃ x ∈ s, is_glb s x :=
-⟨_, hs.Inf_mem ne_s, hs.is_glb_Inf ne_s⟩
+exists_imp_exists (λ x (hx : is_least s x), ⟨hx.1, hx.is_glb⟩) (hs.exists_is_least ne_s)
 
 lemma is_compact.exists_is_lub {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
   ∃ x ∈ s, is_lub s x :=
-⟨_, hs.Sup_mem ne_s, hs.is_lub_Sup ne_s⟩
-
-lemma is_compact.exists_Inf_image_eq_and_le {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
-  {f : β → α} (hf : continuous_on f s) :
-  ∃ x ∈ s, Inf (f '' s) = f x ∧ ∀ y ∈ s, f x ≤ f y :=
-let ⟨x, hxs, hx⟩ := (hs.image_of_continuous_on hf).Inf_mem (ne_s.image f)
-in ⟨x, hxs, hx.symm, λ y hy,
-  hx.trans_le $ cInf_le (hs.image_of_continuous_on hf).bdd_below $ mem_image_of_mem f hy⟩
-
-lemma is_compact.exists_Sup_image_eq_and_ge {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
-  {f : β → α} (hf : continuous_on f s) :
-  ∃ x ∈ s, Sup (f '' s) = f x ∧ ∀ y ∈ s, f y ≤ f x :=
-@is_compact.exists_Inf_image_eq_and_le αᵒᵈ _ _ _ _ _ _ hs ne_s _ hf
-
-lemma is_compact.exists_Inf_image_eq {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
-  {f : β → α} (hf : continuous_on f s) :
-  ∃ x ∈ s,  Inf (f '' s) = f x :=
-let ⟨x, hxs, hx, _⟩ := hs.exists_Inf_image_eq_and_le ne_s hf in ⟨x, hxs, hx⟩
-
-lemma is_compact.exists_Sup_image_eq :
-  ∀ {s : set β}, is_compact s → s.nonempty → ∀ {f : β → α}, continuous_on f s →
-  ∃ x ∈ s, Sup (f '' s) = f x :=
-@is_compact.exists_Inf_image_eq αᵒᵈ _ _ _ _ _
-
-lemma eq_Icc_of_connected_compact {s : set α} (h₁ : is_connected s) (h₂ : is_compact s) :
-  s = Icc (Inf s) (Sup s) :=
-eq_Icc_cInf_cSup_of_connected_bdd_closed h₁ h₂.bdd_below h₂.bdd_above h₂.is_closed
-
-/-!
-### Extreme value theorem
--/
+@is_compact.exists_is_glb αᵒᵈ _ _ _ _ hs ne_s
 
 /-- The **extreme value theorem**: a continuous function realizes its minimum on a compact set. -/
 lemma is_compact.exists_forall_le {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
@@ -232,7 +195,7 @@ begin
   rcases (has_basis_cocompact.inf_principal _).eventually_iff.1 hc with ⟨K, hK, hKf⟩,
   have hsub : insert x₀ (K ∩ s) ⊆ s, from insert_subset.2 ⟨h₀, inter_subset_right _ _⟩,
   obtain ⟨x, hx, hxf⟩ : ∃ x ∈ insert x₀ (K ∩ s), ∀ y ∈ insert x₀ (K ∩ s), f x ≤ f y :=
-    ((hK.inter_right hsc).insert x₀).exists_forall_le (nonempty_insert _ _) (hf.mono hsub),
+    ((hK.inter_right hsc).insert x₀).exists_forall_le (insert_nonempty _ _) (hf.mono hsub),
   refine ⟨x, hsub hx, λ y hy, _⟩,
   by_cases hyK : y ∈ K,
   exacts [hxf _ (or.inr ⟨hyK, hy⟩), (hxf _ (or.inl rfl)).trans (hKf ⟨hyK, hy⟩)]
@@ -273,6 +236,68 @@ lemma continuous.exists_forall_ge [nonempty β] {f : β → α}
   ∃ x, ∀ y, f y ≤ f x :=
 @continuous.exists_forall_le αᵒᵈ _ _ _ _ _ _ _ hf hlim
 
+/-- A continuous function with compact support has a global minimum. -/
+@[to_additive "A continuous function with compact support has a global minimum."]
+lemma continuous.exists_forall_le_of_has_compact_mul_support [nonempty β] [has_one α]
+  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
+  ∃ (x : β), ∀ (y : β), f x ≤ f y :=
+begin
+  obtain ⟨_, ⟨x, rfl⟩, hx⟩ := (h.is_compact_range hf).exists_is_least (range_nonempty _),
+  rw [mem_lower_bounds, forall_range_iff] at hx,
+  exact ⟨x, hx⟩,
+end
+
+/-- A continuous function with compact support has a global maximum. -/
+@[to_additive "A continuous function with compact support has a global maximum."]
+lemma continuous.exists_forall_ge_of_has_compact_mul_support [nonempty β] [has_one α]
+  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
+  ∃ (x : β), ∀ (y : β), f y ≤ f x :=
+@continuous.exists_forall_le_of_has_compact_mul_support αᵒᵈ _ _ _ _ _ _ _ _ hf h
+
+/-- A compact set is bounded below -/
+lemma is_compact.bdd_below [nonempty α] {s : set α} (hs : is_compact s) : bdd_below s :=
+begin
+  cases s.eq_empty_or_nonempty,
+  { rw h,
+    exact bdd_below_empty },
+  { obtain ⟨a, ha, has⟩ := hs.exists_is_least h,
+    exact ⟨a, has⟩ },
+end
+
+/-- A compact set is bounded above -/
+lemma is_compact.bdd_above [nonempty α] {s : set α} (hs : is_compact s) : bdd_above s :=
+@is_compact.bdd_below αᵒᵈ _ _ _ _ _ hs
+
+/-- A continuous function is bounded below on a compact set. -/
+lemma is_compact.bdd_below_image [nonempty α] {f : β → α} {K : set β}
+  (hK : is_compact K) (hf : continuous_on f K) : bdd_below (f '' K) :=
+(hK.image_of_continuous_on hf).bdd_below
+
+/-- A continuous function is bounded above on a compact set. -/
+lemma is_compact.bdd_above_image [nonempty α] {f : β → α} {K : set β}
+  (hK : is_compact K) (hf : continuous_on f K) : bdd_above (f '' K) :=
+@is_compact.bdd_below_image αᵒᵈ _ _ _ _ _ _ _ _ hK hf
+
+/-- A continuous function with compact support is bounded below. -/
+@[to_additive /-" A continuous function with compact support is bounded below. "-/]
+lemma continuous.bdd_below_range_of_has_compact_mul_support [has_one α] {f : β → α}
+  (hf : continuous f) (h : has_compact_mul_support f) : bdd_below (range f) :=
+(h.is_compact_range hf).bdd_below
+
+/-- A continuous function with compact support is bounded above. -/
+@[to_additive /-" A continuous function with compact support is bounded above. "-/]
+lemma continuous.bdd_above_range_of_has_compact_mul_support [has_one α]
+  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
+  bdd_above (range f) :=
+@continuous.bdd_below_range_of_has_compact_mul_support αᵒᵈ _ _ _ _ _ _ _ hf h
+
+end linear_order
+
+section conditionally_complete_linear_order
+
+variables {α β γ : Type*} [conditionally_complete_linear_order α] [topological_space α]
+  [order_closed_topology α] [topological_space β] [topological_space γ]
+
 lemma is_compact.Sup_lt_iff_of_continuous {f : β → α}
   {K : set β} (hK : is_compact K) (h0K : K.nonempty) (hf : continuous_on f K) (y : α) :
   Sup (f '' K) < y ↔ ∀ x ∈ K, f x < y :=
@@ -290,23 +315,71 @@ lemma is_compact.lt_Inf_iff_of_continuous {α β : Type*}
   y < Inf (f '' K) ↔ ∀ x ∈ K, y < f x :=
 @is_compact.Sup_lt_iff_of_continuous αᵒᵈ β _ _ _ _ _ _ hK h0K hf y
 
-/-- A continuous function with compact support has a global minimum. -/
-@[to_additive]
-lemma _root_.continuous.exists_forall_le_of_has_compact_mul_support [nonempty β] [has_one α]
-  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
-  ∃ (x : β), ∀ (y : β), f x ≤ f y :=
-begin
-  obtain ⟨_, ⟨x, rfl⟩, hx⟩ := (h.is_compact_range hf).exists_is_least (range_nonempty _),
-  rw [mem_lower_bounds, forall_range_iff] at hx,
-  exact ⟨x, hx⟩,
-end
+end conditionally_complete_linear_order
 
-/-- A continuous function with compact support has a global maximum. -/
-@[to_additive]
-lemma continuous.exists_forall_ge_of_has_compact_mul_support [nonempty β] [has_one α]
-  {f : β → α} (hf : continuous f) (h : has_compact_mul_support f) :
-  ∃ (x : β), ∀ (y : β), f y ≤ f x :=
-@continuous.exists_forall_le_of_has_compact_mul_support αᵒᵈ _ _ _ _ _ _ _ _ hf h
+/-!
+### Min and max elements of a compact set
+-/
+
+section order_closed_topology
+
+variables {α β γ : Type*} [conditionally_complete_linear_order α] [topological_space α]
+  [order_closed_topology α] [topological_space β] [topological_space γ]
+
+lemma is_compact.Inf_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
+  Inf s ∈ s :=
+let ⟨a, ha⟩ := hs.exists_is_least ne_s in
+ha.Inf_mem
+
+lemma is_compact.Sup_mem {s : set α} (hs : is_compact s) (ne_s : s.nonempty) : Sup s ∈ s :=
+@is_compact.Inf_mem αᵒᵈ _ _ _ _ hs ne_s
+
+lemma is_compact.is_glb_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
+  is_glb s (Inf s) :=
+is_glb_cInf ne_s hs.bdd_below
+
+lemma is_compact.is_lub_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
+  is_lub s (Sup s) :=
+@is_compact.is_glb_Inf αᵒᵈ _ _ _ _ hs ne_s
+
+lemma is_compact.is_least_Inf {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
+  is_least s (Inf s) :=
+⟨hs.Inf_mem ne_s, (hs.is_glb_Inf ne_s).1⟩
+
+lemma is_compact.is_greatest_Sup {s : set α} (hs : is_compact s) (ne_s : s.nonempty) :
+  is_greatest s (Sup s) :=
+@is_compact.is_least_Inf αᵒᵈ _ _ _ _ hs ne_s
+
+lemma is_compact.exists_Inf_image_eq_and_le {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
+  {f : β → α} (hf : continuous_on f s) :
+  ∃ x ∈ s, Inf (f '' s) = f x ∧ ∀ y ∈ s, f x ≤ f y :=
+let ⟨x, hxs, hx⟩ := (hs.image_of_continuous_on hf).Inf_mem (ne_s.image f)
+in ⟨x, hxs, hx.symm, λ y hy,
+  hx.trans_le $ cInf_le (hs.image_of_continuous_on hf).bdd_below $ mem_image_of_mem f hy⟩
+
+lemma is_compact.exists_Sup_image_eq_and_ge {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
+  {f : β → α} (hf : continuous_on f s) :
+  ∃ x ∈ s, Sup (f '' s) = f x ∧ ∀ y ∈ s, f y ≤ f x :=
+@is_compact.exists_Inf_image_eq_and_le αᵒᵈ _ _ _ _ _ _ hs ne_s _ hf
+
+lemma is_compact.exists_Inf_image_eq {s : set β} (hs : is_compact s) (ne_s : s.nonempty)
+  {f : β → α} (hf : continuous_on f s) :
+  ∃ x ∈ s,  Inf (f '' s) = f x :=
+let ⟨x, hxs, hx, _⟩ := hs.exists_Inf_image_eq_and_le ne_s hf in ⟨x, hxs, hx⟩
+
+lemma is_compact.exists_Sup_image_eq :
+  ∀ {s : set β}, is_compact s → s.nonempty → ∀ {f : β → α}, continuous_on f s →
+  ∃ x ∈ s, Sup (f '' s) = f x :=
+@is_compact.exists_Inf_image_eq αᵒᵈ _ _ _ _ _
+
+end order_closed_topology
+
+variables {α β γ : Type*} [conditionally_complete_linear_order α] [topological_space α]
+  [order_topology α] [topological_space β] [topological_space γ]
+
+lemma eq_Icc_of_connected_compact {s : set α} (h₁ : is_connected s) (h₂ : is_compact s) :
+  s = Icc (Inf s) (Sup s) :=
+eq_Icc_cInf_cSup_of_connected_bdd_closed h₁ h₂.bdd_below h₂.bdd_above h₂.is_closed
 
 lemma is_compact.continuous_Sup {f : γ → β → α}
   {K : set β} (hK : is_compact K) (hf : continuous ↿f) :
@@ -355,19 +428,19 @@ lemma image_Icc (hab : a ≤ b) (h : continuous_on f $ Icc a b) :
 eq_Icc_of_connected_compact ⟨(nonempty_Icc.2 hab).image f, is_preconnected_Icc.image f h⟩
   (is_compact_Icc.image_of_continuous_on h)
 
-lemma image_interval_eq_Icc (h : continuous_on f $ [a, b]) :
+lemma image_uIcc_eq_Icc (h : continuous_on f $ [a, b]) :
   f '' [a, b] = Icc (Inf (f '' [a, b])) (Sup (f '' [a, b])) :=
 begin
   cases le_total a b with h2 h2,
-  { simp_rw [interval_of_le h2] at h ⊢, exact h.image_Icc h2 },
-  { simp_rw [interval_of_ge h2] at h ⊢, exact h.image_Icc h2 },
+  { simp_rw [uIcc_of_le h2] at h ⊢, exact h.image_Icc h2 },
+  { simp_rw [uIcc_of_ge h2] at h ⊢, exact h.image_Icc h2 },
 end
 
-lemma image_interval (h : continuous_on f $ [a, b]) :
+lemma image_uIcc (h : continuous_on f $ [a, b]) :
   f '' [a, b] = [Inf (f '' [a, b]), Sup (f '' [a, b])] :=
 begin
-  refine h.image_interval_eq_Icc.trans (interval_of_le _).symm,
-  refine cInf_le_cSup _ _ (nonempty_interval.image _); rw h.image_interval_eq_Icc,
+  refine h.image_uIcc_eq_Icc.trans (uIcc_of_le _).symm,
+  refine cInf_le_cSup _ _ (nonempty_uIcc.image _); rw h.image_uIcc_eq_Icc,
   exacts [bdd_below_Icc, bdd_above_Icc]
 end
 
@@ -388,3 +461,24 @@ begin
 end
 
 end continuous_on
+
+lemma is_compact.exists_local_min_on_mem_subset {f : β → α} {s t : set β} {z : β}
+  (ht : is_compact t) (hf : continuous_on f t) (hz : z ∈ t) (hfz : ∀ z' ∈ t \ s, f z < f z') :
+  ∃ x ∈ s, is_local_min_on f t x :=
+begin
+  obtain ⟨x, hx, hfx⟩ : ∃ x ∈ t, ∀ y ∈ t, f x ≤ f y := ht.exists_forall_le ⟨z, hz⟩ hf,
+  have key : ∀ ⦃y⦄, y ∈ t → (∀ z' ∈ t \ s, f y < f z') → y ∈ s := λ y hy hfy,
+    by { by_contra; simpa using ((hfy y ((mem_diff y).mpr ⟨hy,h⟩))) },
+  have h1 : ∀ z' ∈ t \ s, f x < f z' := λ z' hz', (hfx z hz).trans_lt (hfz z' hz'),
+  have h2 : x ∈ s := key hx h1,
+  refine ⟨x, h2, eventually_nhds_within_of_forall hfx⟩
+end
+
+lemma is_compact.exists_local_min_mem_open {f : β → α} {s t : set β} {z : β} (ht : is_compact t)
+  (hst : s ⊆ t) (hf : continuous_on f t) (hz : z ∈ t) (hfz : ∀ z' ∈ t \ s, f z < f z')
+  (hs : is_open s) :
+  ∃ x ∈ s, is_local_min f x :=
+begin
+  obtain ⟨x, hx, hfx⟩ := ht.exists_local_min_on_mem_subset hf hz hfz,
+  exact ⟨x, hx, hfx.is_local_min (filter.mem_of_superset (hs.mem_nhds hx) hst)⟩
+end
diff --git a/src/topology/algebra/order/extend_from.lean b/src/topology/algebra/order/extend_from.lean
index 9578d72199b64..d18d2ddd35355 100644
--- a/src/topology/algebra/order/extend_from.lean
+++ b/src/topology/algebra/order/extend_from.lean
@@ -3,15 +3,18 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.extend_from
 
 /-!
 # Lemmas about `extend_from` in an order topology.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 open filter set topological_space
-open_locale topological_space classical
+open_locale topology classical
 
 universes u v
 variables {α : Type u} {β : Type v}
diff --git a/src/topology/algebra/order/extr_closure.lean b/src/topology/algebra/order/extr_closure.lean
index 834214a96ff60..89204e085b21e 100644
--- a/src/topology/algebra/order/extr_closure.lean
+++ b/src/topology/algebra/order/extr_closure.lean
@@ -4,18 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import topology.local_extr
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Maximum/minimum on the closure of a set
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove several versions of the following statement: if `f : X → Y` has a (local or
 not) maximum (or minimum) on a set `s` at a point `a` and is continuous on the closure of `s`, then
 `f` has an extremum of the same type on `closure s` at `a`.
 -/
 
 open filter set
-open_locale topological_space
+open_locale topology
 
 variables {X Y : Type*} [topological_space X] [topological_space Y] [preorder Y]
   [order_closed_topology Y] {f g : X → Y} {s : set X} {a : X}
diff --git a/src/topology/algebra/order/field.lean b/src/topology/algebra/order/field.lean
new file mode 100644
index 0000000000000..18f586ba07760
--- /dev/null
+++ b/src/topology/algebra/order/field.lean
@@ -0,0 +1,351 @@
+/-
+Copyright (c) 2022 Benjamin Davidson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Benjamin Davidson, Devon Tuma, Eric Rodriguez, Oliver Nash
+-/
+
+import tactic.positivity
+import tactic.linarith
+import topology.algebra.order.group
+import topology.algebra.field
+
+/-!
+# Topologies on linear ordered fields
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+
+open set filter topological_space
+open function
+open order_dual (to_dual of_dual)
+open_locale topology classical filter
+
+variables {α β : Type*}
+variables [linear_ordered_field α] [topological_space α] [order_topology α]
+variables {l : filter β} {f g : β → α}
+
+section continuous_mul
+
+lemma mul_tendsto_nhds_zero_right (x : α) :
+  tendsto (uncurry ((*) : α → α → α)) (𝓝 0 ×ᶠ 𝓝 x) $ 𝓝 0 :=
+begin
+  have hx : 0 < 2 * (1 + |x|) := by positivity,
+  rw ((nhds_basis_zero_abs_sub_lt α).prod $ nhds_basis_abs_sub_lt x).tendsto_iff
+     (nhds_basis_zero_abs_sub_lt α),
+  refine λ ε ε_pos, ⟨(ε/(2 * (1 + |x|)), 1), ⟨div_pos ε_pos hx, zero_lt_one⟩, _⟩,
+  suffices : ∀ (a b : α), |a| < ε / (2 * (1 + |x|)) → |b - x| < 1 → |a| * |b| < ε,
+  by simpa only [and_imp, prod.forall, mem_prod, ← abs_mul],
+  intros a b h h',
+  refine lt_of_le_of_lt (mul_le_mul_of_nonneg_left _ (abs_nonneg a)) ((lt_div_iff hx).1 h),
+  calc |b| = |(b - x) + x| : by rw sub_add_cancel b x
+    ... ≤ |b - x| + |x| : abs_add (b - x) x
+    ... ≤ 2 * (1 + |x|) : by linarith,
+end
+
+lemma mul_tendsto_nhds_zero_left (x : α) :
+  tendsto (uncurry ((*) : α → α → α)) (𝓝 x ×ᶠ 𝓝 0) $ 𝓝 0 :=
+begin
+  intros s hs,
+  have := mul_tendsto_nhds_zero_right x hs,
+  rw [filter.mem_map, mem_prod_iff] at this ⊢,
+  obtain ⟨U, hU, V, hV, h⟩ := this,
+  exact ⟨V, hV, U, hU, λ y hy, ((mul_comm y.2 y.1) ▸
+    h (⟨hy.2, hy.1⟩ : (prod.mk y.2 y.1) ∈ U ×ˢ V) : y.1 * y.2 ∈ s)⟩,
+end
+
+lemma nhds_eq_map_mul_left_nhds_one {x₀ : α} (hx₀ : x₀ ≠ 0) :
+  𝓝 x₀ = map (λ x, x₀*x) (𝓝 1) :=
+begin
+  have hx₀' : 0 < |x₀| := abs_pos.2 hx₀,
+  refine filter.ext (λ t, _),
+  simp only [exists_prop, set_of_subset_set_of, (nhds_basis_abs_sub_lt x₀).mem_iff,
+    (nhds_basis_abs_sub_lt (1 : α)).mem_iff, filter.mem_map'],
+  refine ⟨λ h, _, λ h, _⟩,
+  { obtain ⟨i, hi, hit⟩ := h,
+    refine ⟨i / (|x₀|), div_pos hi (abs_pos.2 hx₀), λ x hx, hit _⟩,
+    calc |x₀ * x - x₀| = |x₀ * (x - 1)| : congr_arg abs (by ring_nf)
+      ... = |x₀| * |x - 1| : abs_mul x₀ (x - 1)
+      ... < |x₀| * (i / |x₀|) : mul_lt_mul' le_rfl hx (by positivity) (abs_pos.2 hx₀)
+      ... = |x₀| * i / |x₀| : by ring
+      ... = i : mul_div_cancel_left i (λ h, hx₀ (abs_eq_zero.1 h)) },
+  { obtain ⟨i, hi, hit⟩ := h,
+    refine ⟨i * |x₀|, mul_pos hi (abs_pos.2 hx₀), λ x hx, _⟩,
+    have : |x / x₀ - 1| < i,
+    calc |x / x₀ - 1| = |x / x₀ - x₀ / x₀| : (by rw div_self hx₀)
+    ... = |(x - x₀) / x₀| : congr_arg abs (sub_div x x₀ x₀).symm
+    ... = |x - x₀| / |x₀| : abs_div (x - x₀) x₀
+    ... < i * |x₀| / |x₀| : div_lt_div_of_lt (abs_pos.2 hx₀) hx
+    ... = i : by rw [← mul_div_assoc', div_self (ne_of_lt $ abs_pos.2 hx₀).symm, mul_one],
+    specialize hit (x / x₀) this,
+    rwa [mul_div_assoc', mul_div_cancel_left x hx₀] at hit }
+end
+
+lemma nhds_eq_map_mul_right_nhds_one {x₀ : α} (hx₀ : x₀ ≠ 0) :
+  𝓝 x₀ = map (λ x, x*x₀) (𝓝 1) :=
+by simp_rw [mul_comm _ x₀, nhds_eq_map_mul_left_nhds_one hx₀]
+
+lemma mul_tendsto_nhds_one_nhds_one :
+  tendsto (uncurry ((*) : α → α → α)) (𝓝 1 ×ᶠ 𝓝 1) $ 𝓝 1 :=
+begin
+  rw ((nhds_basis_Ioo_pos (1 : α)).prod $ nhds_basis_Ioo_pos (1 : α)).tendsto_iff
+     (nhds_basis_Ioo_pos_of_pos (zero_lt_one : (0 : α) < 1)),
+  intros ε hε,
+  have hε' : 0 ≤ 1 - ε / 4 := by linarith,
+  have ε_pos : 0 < ε / 4 := by linarith,
+  have ε_pos' : 0 < ε / 2 := by linarith,
+  simp only [and_imp, prod.forall, mem_Ioo, function.uncurry_apply_pair, mem_prod, prod.exists],
+  refine ⟨ε/4, ε/4, ⟨ε_pos, ε_pos⟩, λ a b ha ha' hb hb', _⟩,
+  have ha0 : 0 ≤ a := le_trans hε' (le_of_lt ha),
+  have hb0 : 0 ≤ b := le_trans hε' (le_of_lt hb),
+  refine ⟨lt_of_le_of_lt _ (mul_lt_mul'' ha hb hε' hε'),
+    lt_of_lt_of_le (mul_lt_mul'' ha' hb' ha0 hb0) _⟩,
+  { calc 1 - ε = 1 - ε / 2 - ε/2 : by ring_nf
+    ... ≤ 1 - ε/2 - ε/2 + (ε/2)*(ε/2) : le_add_of_nonneg_right (by positivity)
+    ... = (1 - ε/2) * (1 - ε/2) : by ring_nf
+    ... ≤ (1 - ε/4) * (1 - ε/4) : mul_le_mul (by linarith) (by linarith) (by linarith) hε' },
+  { calc (1 + ε/4) * (1 + ε/4) = 1 + ε/2 + (ε/4)*(ε/4) : by ring_nf
+    ... = 1 + ε/2 + (ε * ε) / 16 : by ring_nf
+    ... ≤ 1 + ε/2 + ε/2 : add_le_add_left (div_le_div (le_of_lt hε.1) (le_trans
+      ((mul_le_mul_left hε.1).2 hε.2) (le_of_eq $ mul_one ε)) zero_lt_two (by linarith)) (1 + ε/2)
+    ... ≤ 1 + ε : by ring_nf }
+end
+
+@[priority 100] -- see Note [lower instance priority]
+instance linear_ordered_field.has_continuous_mul : has_continuous_mul α :=
+⟨begin
+  rw continuous_iff_continuous_at,
+  rintro ⟨x₀, y₀⟩,
+  by_cases hx₀ : x₀ = 0,
+  { rw [hx₀, continuous_at, zero_mul, nhds_prod_eq],
+    exact mul_tendsto_nhds_zero_right y₀ },
+  by_cases hy₀ : y₀ = 0,
+  { rw [hy₀, continuous_at, mul_zero, nhds_prod_eq],
+    exact mul_tendsto_nhds_zero_left x₀ },
+  have hxy : x₀ * y₀ ≠ 0 := mul_ne_zero hx₀ hy₀,
+  have key : (λ p : α × α, x₀ * p.1 * (p.2 * y₀)) = ((λ x, x₀*x) ∘ (λ x, x*y₀)) ∘ (uncurry (*)),
+  { ext p, simp [uncurry, mul_assoc] },
+  have key₂ : (λ x, x₀*x) ∘ (λ x, y₀*x) = λ x, (x₀ *y₀)*x,
+  { ext x, simp },
+  calc map (uncurry (*)) (𝓝 (x₀, y₀))
+      = map (uncurry (*)) (𝓝 x₀ ×ᶠ 𝓝 y₀) : by rw nhds_prod_eq
+  ... = map (λ (p : α × α), x₀ * p.1 * (p.2 * y₀)) ((𝓝 1) ×ᶠ (𝓝 1))
+          : by rw [uncurry, nhds_eq_map_mul_left_nhds_one hx₀, nhds_eq_map_mul_right_nhds_one hy₀,
+                    prod_map_map_eq, filter.map_map]
+  ... = map ((λ x, x₀ * x) ∘ λ x, x * y₀) (map (uncurry (*)) (𝓝 1 ×ᶠ 𝓝 1))
+          : by rw [key, ← filter.map_map]
+  ... ≤ map ((λ (x : α), x₀ * x) ∘ λ x, x * y₀) (𝓝 1) : map_mono (mul_tendsto_nhds_one_nhds_one)
+  ... = 𝓝 (x₀*y₀) : by rw [← filter.map_map, ← nhds_eq_map_mul_right_nhds_one hy₀,
+    nhds_eq_map_mul_left_nhds_one hy₀, filter.map_map, key₂, ← nhds_eq_map_mul_left_nhds_one hxy],
+end⟩
+
+end continuous_mul
+
+/-- In a linearly ordered field with the order topology, if `f` tends to `at_top` and `g` tends to
+a positive constant `C` then `f * g` tends to `at_top`. -/
+lemma filter.tendsto.at_top_mul {C : α} (hC : 0 < C) (hf : tendsto f l at_top)
+  (hg : tendsto g l (𝓝 C)) :
+  tendsto (λ x, (f x * g x)) l at_top :=
+begin
+  refine tendsto_at_top_mono' _ _ (hf.at_top_mul_const (half_pos hC)),
+  filter_upwards [hg.eventually (lt_mem_nhds (half_lt_self hC)),
+    hf.eventually (eventually_ge_at_top 0)] with x hg hf using mul_le_mul_of_nonneg_left hg.le hf,
+end
+
+/-- In a linearly ordered field with the order topology, if `f` tends to a positive constant `C` and
+`g` tends to `at_top` then `f * g` tends to `at_top`. -/
+lemma filter.tendsto.mul_at_top {C : α} (hC : 0 < C) (hf : tendsto f l (𝓝 C))
+  (hg : tendsto g l at_top) :
+  tendsto (λ x, (f x * g x)) l at_top :=
+by simpa only [mul_comm] using hg.at_top_mul hC hf
+
+/-- In a linearly ordered field with the order topology, if `f` tends to `at_top` and `g` tends to
+a negative constant `C` then `f * g` tends to `at_bot`. -/
+lemma filter.tendsto.at_top_mul_neg {C : α} (hC : C < 0) (hf : tendsto f l at_top)
+  (hg : tendsto g l (𝓝 C)) :
+  tendsto (λ x, (f x * g x)) l at_bot :=
+by simpa only [(∘), neg_mul_eq_mul_neg, neg_neg]
+  using tendsto_neg_at_top_at_bot.comp (hf.at_top_mul (neg_pos.2 hC) hg.neg)
+
+/-- In a linearly ordered field with the order topology, if `f` tends to a negative constant `C` and
+`g` tends to `at_top` then `f * g` tends to `at_bot`. -/
+lemma filter.tendsto.neg_mul_at_top {C : α} (hC : C < 0) (hf : tendsto f l (𝓝 C))
+  (hg : tendsto g l at_top) :
+  tendsto (λ x, (f x * g x)) l at_bot :=
+by simpa only [mul_comm] using hg.at_top_mul_neg hC hf
+
+/-- In a linearly ordered field with the order topology, if `f` tends to `at_bot` and `g` tends to
+a positive constant `C` then `f * g` tends to `at_bot`. -/
+lemma filter.tendsto.at_bot_mul {C : α} (hC : 0 < C) (hf : tendsto f l at_bot)
+  (hg : tendsto g l (𝓝 C)) :
+  tendsto (λ x, (f x * g x)) l at_bot :=
+by simpa [(∘)]
+  using tendsto_neg_at_top_at_bot.comp ((tendsto_neg_at_bot_at_top.comp hf).at_top_mul hC hg)
+
+/-- In a linearly ordered field with the order topology, if `f` tends to `at_bot` and `g` tends to
+a negative constant `C` then `f * g` tends to `at_top`. -/
+lemma filter.tendsto.at_bot_mul_neg {C : α} (hC : C < 0) (hf : tendsto f l at_bot)
+  (hg : tendsto g l (𝓝 C)) :
+  tendsto (λ x, (f x * g x)) l at_top :=
+by simpa [(∘)]
+  using tendsto_neg_at_bot_at_top.comp ((tendsto_neg_at_bot_at_top.comp hf).at_top_mul_neg hC hg)
+
+/-- In a linearly ordered field with the order topology, if `f` tends to a positive constant `C` and
+`g` tends to `at_bot` then `f * g` tends to `at_bot`. -/
+lemma filter.tendsto.mul_at_bot {C : α} (hC : 0 < C) (hf : tendsto f l (𝓝 C))
+  (hg : tendsto g l at_bot) :
+  tendsto (λ x, (f x * g x)) l at_bot :=
+by simpa only [mul_comm] using hg.at_bot_mul hC hf
+
+/-- In a linearly ordered field with the order topology, if `f` tends to a negative constant `C` and
+`g` tends to `at_bot` then `f * g` tends to `at_top`. -/
+lemma filter.tendsto.neg_mul_at_bot {C : α} (hC : C < 0) (hf : tendsto f l (𝓝 C))
+  (hg : tendsto g l at_bot) :
+  tendsto (λ x, (f x * g x)) l at_top :=
+by simpa only [mul_comm] using hg.at_bot_mul_neg hC hf
+
+/-- The function `x ↦ x⁻¹` tends to `+∞` on the right of `0`. -/
+lemma tendsto_inv_zero_at_top : tendsto (λx:α, x⁻¹) (𝓝[>] (0:α)) at_top :=
+begin
+  refine (at_top_basis' 1).tendsto_right_iff.2 (λ b hb, _),
+  have hb' : 0 < b := by positivity,
+  filter_upwards [Ioc_mem_nhds_within_Ioi ⟨le_rfl, inv_pos.2 hb'⟩]
+    with x hx using (le_inv hx.1 hb').1 hx.2,
+end
+
+/-- The function `r ↦ r⁻¹` tends to `0` on the right as `r → +∞`. -/
+lemma tendsto_inv_at_top_zero' : tendsto (λr:α, r⁻¹) at_top (𝓝[>] (0:α)) :=
+begin
+  refine (has_basis.tendsto_iff at_top_basis ⟨λ s, mem_nhds_within_Ioi_iff_exists_Ioc_subset⟩).2 _,
+  refine λ b hb, ⟨b⁻¹, trivial, λ x hx, _⟩,
+  have : 0 < x := lt_of_lt_of_le (inv_pos.2 hb) hx,
+  exact ⟨inv_pos.2 this, (inv_le this hb).2 hx⟩
+end
+
+lemma tendsto_inv_at_top_zero : tendsto (λr:α, r⁻¹) at_top (𝓝 0) :=
+tendsto_inv_at_top_zero'.mono_right inf_le_left
+
+lemma filter.tendsto.div_at_top [has_continuous_mul α] {f g : β → α} {l : filter β} {a : α}
+  (h : tendsto f l (𝓝 a)) (hg : tendsto g l at_top) : tendsto (λ x, f x / g x) l (𝓝 0) :=
+by { simp only [div_eq_mul_inv], exact mul_zero a ▸ h.mul (tendsto_inv_at_top_zero.comp hg) }
+
+lemma filter.tendsto.inv_tendsto_at_top (h : tendsto f l at_top) : tendsto (f⁻¹) l (𝓝 0) :=
+tendsto_inv_at_top_zero.comp h
+
+lemma filter.tendsto.inv_tendsto_zero (h : tendsto f l (𝓝[>] 0)) :
+  tendsto (f⁻¹) l at_top :=
+tendsto_inv_zero_at_top.comp h
+
+/-- The function `x^(-n)` tends to `0` at `+∞` for any positive natural `n`.
+A version for positive real powers exists as `tendsto_rpow_neg_at_top`. -/
+lemma tendsto_pow_neg_at_top {n : ℕ} (hn : n ≠ 0) : tendsto (λ x : α, x ^ (-(n:ℤ))) at_top (𝓝 0) :=
+by simpa only [zpow_neg, zpow_coe_nat] using (@tendsto_pow_at_top α _ _ hn).inv_tendsto_at_top
+
+lemma tendsto_zpow_at_top_zero {n : ℤ} (hn : n < 0) :
+  tendsto (λ x : α, x^n) at_top (𝓝 0) :=
+begin
+  lift -n to ℕ using le_of_lt (neg_pos.mpr hn) with N,
+  rw [← neg_pos, ← h, nat.cast_pos] at hn,
+  simpa only [h, neg_neg] using tendsto_pow_neg_at_top hn.ne'
+end
+
+lemma tendsto_const_mul_zpow_at_top_zero {n : ℤ} {c : α} (hn : n < 0) :
+  tendsto (λ x, c * x ^ n) at_top (𝓝 0) :=
+(mul_zero c) ▸ (filter.tendsto.const_mul c (tendsto_zpow_at_top_zero hn))
+
+lemma tendsto_const_mul_pow_nhds_iff' {n : ℕ} {c d : α} :
+  tendsto (λ x : α, c * x ^ n) at_top (𝓝 d) ↔ (c = 0 ∨ n = 0) ∧ c = d :=
+begin
+  rcases eq_or_ne n 0 with (rfl|hn),
+  { simp [tendsto_const_nhds_iff] },
+  rcases lt_trichotomy c 0 with hc|rfl|hc,
+  { have := tendsto_const_mul_pow_at_bot_iff.2 ⟨hn, hc⟩,
+    simp [not_tendsto_nhds_of_tendsto_at_bot this, hc.ne, hn] },
+  { simp [tendsto_const_nhds_iff] },
+  { have := tendsto_const_mul_pow_at_top_iff.2 ⟨hn, hc⟩,
+    simp [not_tendsto_nhds_of_tendsto_at_top this, hc.ne', hn] }
+end
+
+lemma tendsto_const_mul_pow_nhds_iff {n : ℕ} {c d : α} (hc : c ≠ 0) :
+  tendsto (λ x : α, c * x ^ n) at_top (𝓝 d) ↔ n = 0 ∧ c = d :=
+by simp [tendsto_const_mul_pow_nhds_iff', hc]
+
+lemma tendsto_const_mul_zpow_at_top_nhds_iff {n : ℤ} {c d : α} (hc : c ≠ 0) :
+  tendsto (λ x : α, c * x ^ n) at_top (𝓝 d) ↔ (n = 0 ∧ c = d) ∨ (n < 0 ∧ d = 0) :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { by_cases hn : 0 ≤ n,
+    { lift n to ℕ using hn,
+      simp only [zpow_coe_nat] at h,
+      rw [tendsto_const_mul_pow_nhds_iff hc, ← int.coe_nat_eq_zero] at h,
+      exact or.inl h },
+    { rw not_le at hn,
+      refine or.inr ⟨hn, tendsto_nhds_unique h (tendsto_const_mul_zpow_at_top_zero hn)⟩ } },
+  { cases h,
+    { simp only [h.left, h.right, zpow_zero, mul_one],
+      exact tendsto_const_nhds },
+    { exact h.2.symm ▸ tendsto_const_mul_zpow_at_top_zero h.1} }
+end
+
+-- TODO: With a different proof, this could be possibly generalised to only require a
+-- `linear_ordered_semifield` instance, which would also remove the need for the
+-- `nnreal` instance of `has_continuous_inv₀`.
+@[priority 100] -- see Note [lower instance priority]
+instance linear_ordered_field.to_topological_division_ring : topological_division_ring α :=
+{ continuous_at_inv₀ :=
+  begin
+    suffices : ∀ {x : α}, 0 < x → continuous_at has_inv.inv x,
+    { intros x hx,
+      cases hx.symm.lt_or_lt,
+      { exact this h },
+      convert (this $ neg_pos.mpr h).neg.comp continuous_neg.continuous_at,
+      ext,
+      simp [neg_inv] },
+    intros t ht,
+    rw [continuous_at,
+        (nhds_basis_Ioo_pos t).tendsto_iff $ nhds_basis_Ioo_pos_of_pos $ inv_pos.2 ht],
+    rintros ε ⟨hε : ε > 0, hεt : ε ≤ t⁻¹⟩,
+    refine ⟨min (t ^ 2 * ε / 2) (t / 2), by positivity, λ x h, _⟩,
+    have hx : t / 2 < x,
+    { rw [set.mem_Ioo, sub_lt_comm, lt_min_iff] at h,
+      nlinarith },
+    have hx' : 0 < x := (half_pos ht).trans hx,
+    have aux : 0 < 2 / t ^ 2 := by positivity,
+    rw [set.mem_Ioo, ←sub_lt_iff_lt_add', sub_lt_comm, ←abs_sub_lt_iff] at h ⊢,
+    rw [inv_sub_inv ht.ne' hx'.ne', abs_div, div_eq_mul_inv],
+    suffices : |t * x|⁻¹ < 2 / t ^ 2,
+    { rw [←abs_neg, neg_sub],
+      refine (mul_lt_mul'' h this (by positivity) (by positivity)).trans_le _,
+      rw [mul_comm, mul_min_of_nonneg _ _ aux.le],
+      apply min_le_of_left_le,
+      rw [←mul_div, ←mul_assoc, div_mul_cancel _ (sq_pos_of_pos ht).ne',
+          mul_div_cancel' ε two_ne_zero] },
+    refine inv_lt_of_inv_lt aux _,
+    rw [inv_div, abs_of_pos $ mul_pos ht hx', sq, ←mul_div_assoc'],
+    exact mul_lt_mul_of_pos_left hx ht
+  end }
+
+lemma nhds_within_pos_comap_mul_left {x : α} (hx : 0 < x) :
+  comap (λ ε, x * ε) (𝓝[>] 0) = 𝓝[>] 0 :=
+begin
+  suffices : ∀ {x : α} (hx : 0 < x), 𝓝[>] 0 ≤ comap (λ ε, x * ε) (𝓝[>] 0),
+  { refine le_antisymm _ (this hx),
+    have hr : 𝓝[>] (0 : α) = ((𝓝[>] (0 : α)).comap (λ ε, x⁻¹ * ε)).comap (λ ε, x * ε),
+    { simp [comap_comap, inv_mul_cancel hx.ne.symm, comap_id, one_mul_eq_id], },
+    conv_rhs { rw hr, },
+    rw comap_le_comap_iff (by convert univ_mem; exact (mul_left_surjective₀ hx.ne.symm).range_eq),
+    exact this (inv_pos.mpr hx), },
+  intros x hx,
+  convert nhds_within_le_comap (continuous_mul_left x).continuous_within_at,
+  { exact (mul_zero _).symm, },
+  { rw image_const_mul_Ioi_zero hx, },
+end
+
+lemma eventually_nhds_within_pos_mul_left {x : α} (hx : 0 < x)
+  {p : α → Prop} (h : ∀ᶠ ε in 𝓝[>] 0, p ε) : ∀ᶠ ε in 𝓝[>] 0, p (x * ε) :=
+begin
+  convert h.comap (λ ε, x * ε),
+  exact (nhds_within_pos_comap_mul_left hx).symm,
+end
diff --git a/src/topology/algebra/order/filter.lean b/src/topology/algebra/order/filter.lean
new file mode 100644
index 0000000000000..92213dd2b724e
--- /dev/null
+++ b/src/topology/algebra/order/filter.lean
@@ -0,0 +1,39 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.order.basic
+import topology.filter
+
+/-!
+# Topology on filters of a space with order topology
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that `𝓝 (f x)` tends to `𝓝 filter.at_top` provided that `f` tends to
+`filter.at_top`, and similarly for `filter.at_bot`.
+-/
+
+open_locale topology
+
+namespace filter
+
+variables {α X : Type*} [topological_space X] [partial_order X] [order_topology X]
+
+protected lemma tendsto_nhds_at_top [no_max_order X] : tendsto 𝓝 (at_top : filter X) (𝓝 at_top) :=
+filter.tendsto_nhds_at_top_iff.2 $ λ x, (eventually_gt_at_top x).mono $ λ y, le_mem_nhds
+
+protected lemma tendsto_nhds_at_bot [no_min_order X] : tendsto 𝓝 (at_bot : filter X) (𝓝 at_bot) :=
+@filter.tendsto_nhds_at_top Xᵒᵈ _ _ _ _
+
+lemma tendsto.nhds_at_top [no_max_order X] {f : α → X} {l : filter α} (h : tendsto f l at_top) :
+  tendsto (𝓝 ∘ f) l (𝓝 at_top) :=
+filter.tendsto_nhds_at_top.comp h
+
+lemma tendsto.nhds_at_bot [no_min_order X] {f : α → X} {l : filter α} (h : tendsto f l at_bot) :
+  tendsto (𝓝 ∘ f) l (𝓝 at_bot) :=
+@tendsto.nhds_at_top α Xᵒᵈ _ _ _ _ _ _ h
+
+end filter
diff --git a/src/topology/algebra/order/floor.lean b/src/topology/algebra/order/floor.lean
index 2d23ea9abdb7a..45197af099ff3 100644
--- a/src/topology/algebra/order/floor.lean
+++ b/src/topology/algebra/order/floor.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anatole Dedecker
 -/
 import algebra.order.floor
-import topology.algebra.order.basic
+import topology.algebra.order.group
 
 /-!
 # Topological facts about `int.floor`, `int.ceil` and `int.fract`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file proves statements about limits and continuity of functions involving `floor`, `ceil` and
 `fract`.
 
@@ -24,21 +27,23 @@ This file proves statements about limits and continuity of functions involving `
 -/
 
 open filter function int set
-open_locale topological_space
+open_locale topology
 
 variables {α β γ : Type*} [linear_ordered_ring α] [floor_ring α]
 
 lemma tendsto_floor_at_top : tendsto (floor : α → ℤ) at_top at_top :=
-floor_mono.tendsto_at_top_at_top $ λ b, ⟨(b + 1 : ℤ), by { rw floor_coe, exact (lt_add_one _).le }⟩
+floor_mono.tendsto_at_top_at_top $ λ b, ⟨(b + 1 : ℤ),
+  by { rw floor_int_cast, exact (lt_add_one _).le }⟩
 
 lemma tendsto_floor_at_bot : tendsto (floor : α → ℤ) at_bot at_bot :=
-floor_mono.tendsto_at_bot_at_bot $ λ b, ⟨b, (floor_coe _).le⟩
+floor_mono.tendsto_at_bot_at_bot $ λ b, ⟨b, (floor_int_cast _).le⟩
 
 lemma tendsto_ceil_at_top : tendsto (ceil : α → ℤ) at_top at_top :=
-ceil_mono.tendsto_at_top_at_top $ λ b, ⟨b, (ceil_coe _).ge⟩
+ceil_mono.tendsto_at_top_at_top $ λ b, ⟨b, (ceil_int_cast _).ge⟩
 
 lemma tendsto_ceil_at_bot : tendsto (ceil : α → ℤ) at_bot at_bot :=
-ceil_mono.tendsto_at_bot_at_bot $ λ b, ⟨(b - 1 : ℤ), by { rw ceil_coe, exact (sub_one_lt _).le }⟩
+ceil_mono.tendsto_at_bot_at_bot $ λ b, ⟨(b - 1 : ℤ),
+  by { rw ceil_int_cast, exact (sub_one_lt _).le }⟩
 
 variables [topological_space α]
 
@@ -52,7 +57,7 @@ lemma tendsto_floor_right' [order_closed_topology α] (n : ℤ) :
   tendsto (λ x, floor x : α → α) (𝓝[≥] n) (𝓝 n) :=
 begin
   rw ← nhds_within_Ico_eq_nhds_within_Ici (lt_add_one (n : α)),
-  simpa only [floor_coe] using
+  simpa only [floor_int_cast] using
     (continuous_on_floor n _ (left_mem_Ico.mpr $ lt_add_one (_ : α))).tendsto
 end
 
@@ -60,7 +65,7 @@ lemma tendsto_ceil_left' [order_closed_topology α] (n : ℤ) :
   tendsto (λ x, ceil x : α → α) (𝓝[≤] n) (𝓝 n) :=
 begin
   rw ← nhds_within_Ioc_eq_nhds_within_Iic (sub_one_lt (n : α)),
-  simpa only [ceil_coe] using
+  simpa only [ceil_int_cast] using
     (continuous_on_ceil _ _ (right_mem_Ioc.mpr $ sub_one_lt (_ : α))).tendsto
 end
 
@@ -154,11 +159,11 @@ tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
 
 local notation `I` := (Icc 0 1 : set α)
 
-variables [order_topology α] [topological_add_group α] [topological_space β] [topological_space γ]
+variables [order_topology α] [topological_space β] [topological_space γ]
 
 /-- Do not use this, use `continuous_on.comp_fract` instead. -/
 lemma continuous_on.comp_fract' {f : β → α → γ}
-  (h : continuous_on (uncurry f) $ (univ : set β) ×ˢ I) (hf : ∀ s, f s 0 = f s 1) :
+  (h : continuous_on (uncurry f) $ univ ×ˢ I) (hf : ∀ s, f s 0 = f s 1) :
   continuous (λ st : β × α, f st.1 $ fract st.2) :=
 begin
   change continuous ((uncurry f) ∘ (prod.map id (fract))),
@@ -167,27 +172,27 @@ begin
   by_cases ht : t = floor t,
   { rw ht,
     rw ← continuous_within_at_univ,
-    have : (univ : set (β × α)) ⊆ ((univ : set β) ×ˢ Iio ↑⌊t⌋) ∪ ((univ : set β) ×ˢ Ici ↑⌊t⌋),
+    have : (univ : set (β × α)) ⊆ (univ ×ˢ Iio ↑⌊t⌋) ∪ (univ ×ˢ Ici ↑⌊t⌋),
     { rintros p -,
       rw ← prod_union,
       exact ⟨trivial, lt_or_le p.2 _⟩ },
     refine continuous_within_at.mono _ this,
     refine continuous_within_at.union _ _,
-    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
+    { simp only [continuous_within_at, fract_int_cast, nhds_within_prod_eq,
                   nhds_within_univ, id.def, comp_app, prod.map_mk],
       have : (uncurry f) (s, 0) = (uncurry f) (s, (1 : α)),
         by simp [uncurry, hf],
       rw this,
-      refine (h _ ⟨true.intro, by exact_mod_cast right_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
+      refine (h _ ⟨⟨⟩, by exact_mod_cast right_mem_Icc.2 (zero_le_one' α)⟩).tendsto.comp _,
       rw [nhds_within_prod_eq, nhds_within_univ],
-      rw nhds_within_Icc_eq_nhds_within_Iic (@zero_lt_one α _ _),
+      rw nhds_within_Icc_eq_nhds_within_Iic (zero_lt_one' α),
       exact tendsto_id.prod_map
         (tendsto_nhds_within_mono_right Iio_subset_Iic_self $ tendsto_fract_left _) },
-    { simp only [continuous_within_at, fract_coe, nhds_within_prod_eq,
+    { simp only [continuous_within_at, fract_int_cast, nhds_within_prod_eq,
                   nhds_within_univ, id.def, comp_app, prod.map_mk],
-      refine (h _ ⟨true.intro, by exact_mod_cast left_mem_Icc.mpr zero_le_one⟩).tendsto.comp _,
+      refine (h _ ⟨⟨⟩, by exact_mod_cast left_mem_Icc.2 (zero_le_one' α)⟩).tendsto.comp _,
       rw [nhds_within_prod_eq, nhds_within_univ,
-        nhds_within_Icc_eq_nhds_within_Ici (@zero_lt_one α _ _)],
+        nhds_within_Icc_eq_nhds_within_Ici (zero_lt_one' α)],
       exact tendsto_id.prod_map (tendsto_fract_right _) } },
   { have : t ∈ Ioo (floor t : α) ((floor t : α) + 1),
       from ⟨lt_of_le_of_ne (floor_le t) (ne.symm ht), lt_floor_add_one _⟩,
@@ -203,7 +208,7 @@ end
 lemma continuous_on.comp_fract
   {s : β → α}
   {f : β → α → γ}
-  (h : continuous_on (uncurry f) $ (univ : set β) ×ˢ (Icc 0 1 : set α))
+  (h : continuous_on (uncurry f) $ univ ×ˢ Icc 0 1)
   (hs : continuous s)
   (hf : ∀ s, f s 0 = f s 1) :
   continuous (λ x : β, f x $ int.fract (s x)) :=
diff --git a/src/topology/algebra/order/group.lean b/src/topology/algebra/order/group.lean
new file mode 100644
index 0000000000000..c4aac1da2e3f1
--- /dev/null
+++ b/src/topology/algebra/order/group.lean
@@ -0,0 +1,83 @@
+/-
+Copyright (c) 2020 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.order.basic
+import topology.algebra.group.basic
+
+/-!
+# Topology on a linear ordered additive commutative group
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that a linear ordered additive commutative group with order topology is a
+topological group. We also prove continuity of `abs : G → G` and provide convenience lemmas like
+`continuous_at.abs`.
+-/
+
+open set filter
+open_locale topology filter
+
+variables {α G : Type*} [topological_space G] [linear_ordered_add_comm_group G] [order_topology G]
+variables {l : filter α} {f g : α → G}
+
+@[priority 100] -- see Note [lower instance priority]
+instance linear_ordered_add_comm_group.topological_add_group : topological_add_group G :=
+{ continuous_add :=
+    begin
+      refine continuous_iff_continuous_at.2 _,
+      rintro ⟨a, b⟩,
+      refine linear_ordered_add_comm_group.tendsto_nhds.2 (λ ε ε0, _),
+      rcases dense_or_discrete 0 ε with (⟨δ, δ0, δε⟩|⟨h₁, h₂⟩),
+      { -- If there exists `δ ∈ (0, ε)`, then we choose `δ`-nhd of `a` and `(ε-δ)`-nhd of `b`
+        filter_upwards [(eventually_abs_sub_lt a δ0).prod_nhds
+          (eventually_abs_sub_lt b (sub_pos.2 δε))],
+        rintros ⟨x, y⟩ ⟨hx : |x - a| < δ, hy : |y - b| < ε - δ⟩,
+        rw [add_sub_add_comm],
+        calc |x - a + (y - b)| ≤ |x - a| + |y - b| : abs_add _ _
+        ... < δ + (ε - δ) : add_lt_add hx hy
+        ... = ε : add_sub_cancel'_right _ _ },
+      { -- Otherwise `ε`-nhd of each point `a` is `{a}`
+        have hε : ∀ {x y}, |x - y| < ε → x = y,
+        { intros x y h,
+          simpa [sub_eq_zero] using h₂ _ h },
+        filter_upwards [(eventually_abs_sub_lt a ε0).prod_nhds (eventually_abs_sub_lt b ε0)],
+        rintros ⟨x, y⟩ ⟨hx : |x - a| < ε, hy : |y - b| < ε⟩,
+        simpa [hε hx, hε hy] }
+    end,
+  continuous_neg := continuous_iff_continuous_at.2 $ λ a,
+    linear_ordered_add_comm_group.tendsto_nhds.2 $ λ ε ε0,
+      (eventually_abs_sub_lt a ε0).mono $ λ x hx, by rwa [neg_sub_neg, abs_sub_comm] }
+
+@[continuity]
+lemma continuous_abs : continuous (abs : G → G) := continuous_id.max continuous_neg
+
+protected lemma filter.tendsto.abs {a : G} (h : tendsto f l (𝓝 a)) :
+  tendsto (λ x, |f x|) l (𝓝 (|a|)) :=
+(continuous_abs.tendsto _).comp h
+
+lemma tendsto_zero_iff_abs_tendsto_zero (f : α → G) :
+  tendsto f l (𝓝 0) ↔ tendsto (abs ∘ f) l (𝓝 0) :=
+begin
+  refine ⟨λ h, (abs_zero : |(0 : G)| = 0) ▸ h.abs, λ h, _⟩,
+  have : tendsto (λ a, -|f a|) l (𝓝 0) := (neg_zero : -(0 : G) = 0) ▸ h.neg,
+  exact tendsto_of_tendsto_of_tendsto_of_le_of_le this h
+    (λ x, neg_abs_le_self $ f x) (λ x, le_abs_self $ f x),
+end
+
+variables [topological_space α] {a : α} {s : set α}
+
+protected lemma continuous.abs (h : continuous f) : continuous (λ x, |f x|) := continuous_abs.comp h
+
+protected lemma continuous_at.abs (h : continuous_at f a) : continuous_at (λ x, |f x|) a := h.abs
+
+protected lemma continuous_within_at.abs (h : continuous_within_at f s a) :
+  continuous_within_at (λ x, |f x|) s a := h.abs
+
+protected lemma continuous_on.abs (h : continuous_on f s) : continuous_on (λ x, |f x|) s :=
+λ x hx, (h x hx).abs
+
+lemma tendsto_abs_nhds_within_zero : tendsto (abs : G → G) (𝓝[≠] 0) (𝓝[>] 0) :=
+(continuous_abs.tendsto' (0 : G) 0 abs_zero).inf $ tendsto_principal_principal.2 $ λ x, abs_pos.2
diff --git a/src/topology/algebra/order/intermediate_value.lean b/src/topology/algebra/order/intermediate_value.lean
index 83e6f74b73028..5e8cce657972d 100644
--- a/src/topology/algebra/order/intermediate_value.lean
+++ b/src/topology/algebra/order/intermediate_value.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Alistair Tucker
 -/
 import order.complete_lattice_intervals
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Intermediate Value Theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the Intermediate Value Theorem: if `f : α → β` is a function defined on a
 connected set `s` that takes both values `≤ a` and values `≥ a` on `s`, then it is equal to `a` at
 some point of `s`. We also prove that intervals in a dense conditionally complete order are
@@ -37,7 +40,7 @@ intermediate value theorem, connected space, connected set
 -/
 
 open filter order_dual topological_space function set
-open_locale topological_space filter
+open_locale topology filter
 
 universes u v w
 
@@ -386,12 +389,10 @@ begin
   exact (nhds_within_Ioi_self_ne_bot' ⟨b, hxab.2⟩).nonempty_of_mem this
 end
 
-/-- A closed interval in a densely ordered conditionally complete linear order is preconnected. -/
-lemma is_preconnected_Icc : is_preconnected (Icc a b) :=
-is_preconnected_closed_iff.2
+lemma is_preconnected_Icc_aux (x y : α) (s t : set α) (hxy : x ≤ y)
+  (hs : is_closed s) (ht : is_closed t) (hab : Icc a b ⊆ s ∪ t)
+  (hx : x ∈ Icc a b ∩ s) (hy : y ∈ Icc a b ∩ t) : (Icc a b ∩ (s ∩ t)).nonempty :=
 begin
-  rintros s t hs ht hab ⟨x, hx⟩ ⟨y, hy⟩,
-  wlog hxy : x ≤ y := le_total x y using [x y s t, y x t s],
   have xyab : Icc x y ⊆ Icc a b := Icc_subset_Icc hx.1.1 hy.1.2,
   by_contradiction hst,
   suffices : Icc x y ⊆ s,
@@ -407,12 +408,25 @@ begin
   exact λ w ⟨wt, wzy⟩, (this wzy).elim id (λ h, (wt h).elim)
 end
 
-lemma is_preconnected_interval : is_preconnected (interval a b) := is_preconnected_Icc
+/-- A closed interval in a densely ordered conditionally complete linear order is preconnected. -/
+lemma is_preconnected_Icc : is_preconnected (Icc a b) :=
+is_preconnected_closed_iff.2
+begin
+  rintros s t hs ht hab ⟨x, hx⟩ ⟨y, hy⟩,
+  -- This used to use `wlog`, but it was causing timeouts.
+  cases le_total x y,
+  { exact is_preconnected_Icc_aux x y s t h hs ht hab hx hy, },
+  { rw inter_comm s t,
+    rw union_comm s t at hab,
+    exact is_preconnected_Icc_aux y x t s h ht hs hab hy hx, },
+end
+
+lemma is_preconnected_uIcc : is_preconnected (uIcc a b) := is_preconnected_Icc
 
 lemma set.ord_connected.is_preconnected {s : set α} (h : s.ord_connected) :
   is_preconnected s :=
-is_preconnected_of_forall_pair $ λ x hx y hy, ⟨interval x y, h.interval_subset hx hy,
-  left_mem_interval, right_mem_interval, is_preconnected_interval⟩
+is_preconnected_of_forall_pair $ λ x hx y hy, ⟨uIcc x y, h.uIcc_subset hx hy,
+  left_mem_uIcc, right_mem_uIcc, is_preconnected_uIcc⟩
 
 lemma is_preconnected_iff_ord_connected {s : set α} :
   is_preconnected s ↔ ord_connected s :=
@@ -426,6 +440,28 @@ lemma is_preconnected_Ioo : is_preconnected (Ioo a b) := ord_connected_Ioo.is_pr
 lemma is_preconnected_Ioc : is_preconnected (Ioc a b) := ord_connected_Ioc.is_preconnected
 lemma is_preconnected_Ico : is_preconnected (Ico a b) := ord_connected_Ico.is_preconnected
 
+lemma is_connected_Ici : is_connected (Ici a) := ⟨nonempty_Ici, is_preconnected_Ici⟩
+
+lemma is_connected_Iic : is_connected (Iic a) := ⟨nonempty_Iic, is_preconnected_Iic⟩
+
+lemma is_connected_Ioi [no_max_order α] : is_connected (Ioi a) :=
+⟨nonempty_Ioi, is_preconnected_Ioi⟩
+
+lemma is_connected_Iio [no_min_order α] : is_connected (Iio a) :=
+⟨nonempty_Iio, is_preconnected_Iio⟩
+
+lemma is_connected_Icc (h : a ≤ b) : is_connected (Icc a b) :=
+⟨nonempty_Icc.2 h, is_preconnected_Icc⟩
+
+lemma is_connected_Ioo (h : a < b) : is_connected (Ioo a b) :=
+⟨nonempty_Ioo.2 h, is_preconnected_Ioo⟩
+
+lemma is_connected_Ioc (h : a < b) : is_connected (Ioc a b) :=
+⟨nonempty_Ioc.2 h, is_preconnected_Ioc⟩
+
+lemma is_connected_Ico (h : a < b) : is_connected (Ico a b) :=
+⟨nonempty_Ico.2 h, is_preconnected_Ico⟩
+
 @[priority 100]
 instance ordered_connected_space : preconnected_space α :=
 ⟨ord_connected_univ.is_preconnected⟩
@@ -471,9 +507,9 @@ lemma intermediate_value_Icc' {a b : α} (hab : a ≤ b) {f : α → δ} (hf : c
 is_preconnected_Icc.intermediate_value (right_mem_Icc.2 hab) (left_mem_Icc.2 hab) hf
 
 /-- **Intermediate Value Theorem** for continuous functions on closed intervals, unordered case. -/
-lemma intermediate_value_interval {a b : α} {f : α → δ} (hf : continuous_on f (interval a b)) :
-  interval (f a) (f b) ⊆ f '' interval a b :=
-by cases le_total (f a) (f b); simp [*, is_preconnected_interval.intermediate_value]
+lemma intermediate_value_uIcc {a b : α} {f : α → δ} (hf : continuous_on f (uIcc a b)) :
+  uIcc (f a) (f b) ⊆ f '' uIcc a b :=
+by cases le_total (f a) (f b); simp [*, is_preconnected_uIcc.intermediate_value]
 
 lemma intermediate_value_Ico {a b : α} (hab : a ≤ b) {f : α → δ} (hf : continuous_on f (Icc a b)) :
   Ico (f a) (f b) ⊆ f '' (Ico a b) :=
@@ -530,9 +566,9 @@ hs.is_preconnected.intermediate_value ha hb hf
 
 /-- **Intermediate value theorem**: if `f` is continuous on an order-connected set `s` and `a`,
 `b` are two points of this set, then `f` sends `s` to a superset of `[f x, f y]`. -/
-lemma continuous_on.surj_on_interval {s : set α} [hs : ord_connected s] {f : α → δ}
+lemma continuous_on.surj_on_uIcc {s : set α} [hs : ord_connected s] {f : α → δ}
   (hf : continuous_on f s) {a b : α} (ha : a ∈ s) (hb : b ∈ s) :
-  surj_on f s (interval (f a) (f b)) :=
+  surj_on f s (uIcc (f a) (f b)) :=
 by cases le_total (f a) (f b) with hab hab; simp [hf.surj_on_Icc, *]
 
 /-- A continuous function which tendsto `at_top` `at_top` and to `at_bot` `at_bot` is surjective. -/
diff --git a/src/topology/algebra/order/left_right.lean b/src/topology/algebra/order/left_right.lean
index 21e4190f327e4..2b43409de367c 100644
--- a/src/topology/algebra/order/left_right.lean
+++ b/src/topology/algebra/order/left_right.lean
@@ -8,6 +8,9 @@ import topology.continuous_on
 /-!
 # Left and right continuity
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove a few lemmas about left and right continuous functions:
 
 * `continuous_within_at_Ioi_iff_Ici`: two definitions of right continuity
@@ -23,7 +26,7 @@ left continuous, right continuous
 -/
 
 open set filter
-open_locale topological_space
+open_locale topology
 
 section partial_order
 
@@ -37,8 +40,18 @@ lemma continuous_within_at_Iio_iff_Iic {a : α} {f : α → β} :
   continuous_within_at f (Iio a) a ↔ continuous_within_at f (Iic a) a :=
 @continuous_within_at_Ioi_iff_Ici αᵒᵈ _ ‹topological_space α› _ _ _ f
 
+lemma nhds_left'_le_nhds_ne (a : α) :
+  𝓝[<] a ≤ 𝓝[≠] a :=
+nhds_within_mono a (λ y hy, ne_of_lt hy)
+
+lemma nhds_right'_le_nhds_ne (a : α) :
+  𝓝[>] a ≤ 𝓝[≠] a :=
+nhds_within_mono a (λ y hy, ne_of_gt hy)
+
 end partial_order
 
+section topological_space
+
 variables {α β : Type*} [topological_space α] [linear_order α] [topological_space β]
 
 lemma nhds_left_sup_nhds_right (a : α) :
@@ -53,6 +66,10 @@ lemma nhds_left_sup_nhds_right' (a : α) :
   𝓝[≤] a ⊔ 𝓝[>] a = 𝓝 a :=
 by rw [← nhds_within_union, Iic_union_Ioi, nhds_within_univ]
 
+lemma nhds_left'_sup_nhds_right' (a : α) :
+  𝓝[<] a ⊔ 𝓝[>] a = 𝓝[≠] a :=
+by rw [← nhds_within_union, Iio_union_Ioi]
+
 lemma continuous_at_iff_continuous_left_right {a : α} {f : α → β} :
   continuous_at f a ↔ continuous_within_at f (Iic a) a ∧ continuous_within_at f (Ici a) a :=
 by simp only [continuous_within_at, continuous_at, ← tendsto_sup, nhds_left_sup_nhds_right]
@@ -61,3 +78,5 @@ lemma continuous_at_iff_continuous_left'_right' {a : α} {f : α → β} :
   continuous_at f a ↔ continuous_within_at f (Iio a) a ∧ continuous_within_at f (Ioi a) a :=
 by rw [continuous_within_at_Ioi_iff_Ici, continuous_within_at_Iio_iff_Iic,
   continuous_at_iff_continuous_left_right]
+
+end topological_space
diff --git a/src/topology/algebra/order/left_right_lim.lean b/src/topology/algebra/order/left_right_lim.lean
new file mode 100644
index 0000000000000..17a1b5487f5af
--- /dev/null
+++ b/src/topology/algebra/order/left_right_lim.lean
@@ -0,0 +1,365 @@
+/-
+Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import topology.order.basic
+import topology.algebra.order.left_right
+
+/-!
+# Left and right limits
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the (strict) left and right limits of a function.
+
+* `left_lim f x` is the strict left limit of `f` at `x` (using `f x` as a garbage value if `x`
+  is isolated to its left).
+* `right_lim f x` is the strict right limit of `f` at `x` (using `f x` as a garbage value if `x`
+  is isolated to its right).
+
+We develop a comprehensive API for monotone functions. Notably,
+
+* `monotone.continuous_at_iff_left_lim_eq_right_lim` states that a monotone function is continuous
+  at a point if and only if its left and right limits coincide.
+* `monotone.countable_not_continuous_at` asserts that a monotone function taking values in a
+  second-countable space has at most countably many discontinuity points.
+
+We also port the API to antitone functions.
+
+## TODO
+
+Prove corresponding stronger results for strict_mono and strict_anti functions.
+-/
+
+open set filter
+open_locale topology
+
+section
+
+variables {α β : Type*} [linear_order α] [topological_space β]
+
+/-- Let `f : α → β` be a function from a linear order `α` to a topological_space `β`, and
+let `a : α`. The limit strictly to the left of `f` at `a`, denoted with `left_lim f a`, is defined
+by using the order topology on `α`. If `a` is isolated to its left or the function has no left
+limit, we use `f a` instead to guarantee a good behavior in most cases. -/
+@[irreducible] noncomputable def function.left_lim (f : α → β) (a : α) : β :=
+begin
+  classical,
+  haveI : nonempty β := ⟨f a⟩,
+  letI : topological_space α := preorder.topology α,
+  exact if (𝓝[<] a = ⊥) ∨ ¬(∃ y, tendsto f (𝓝[<] a) (𝓝 y)) then f a
+    else lim (𝓝[<] a) f
+end
+
+/-- Let `f : α → β` be a function from a linear order `α` to a topological_space `β`, and
+let `a : α`. The limit strictly to the right of `f` at `a`, denoted with `right_lim f a`, is defined
+by using the order topology on `α`. If `a` is isolated to its right or the function has no right
+limit, , we use `f a` instead to guarantee a good behavior in most cases. -/
+noncomputable def function.right_lim (f : α → β) (a : α) : β :=
+@function.left_lim αᵒᵈ β  _ _ f a
+
+open function
+
+lemma left_lim_eq_of_tendsto
+  [hα : topological_space α] [h'α : order_topology α] [t2_space β]
+  {f : α → β} {a : α} {y : β} (h : 𝓝[<] a ≠ ⊥) (h' : tendsto f (𝓝[<] a) (𝓝 y)) :
+  left_lim f a = y :=
+begin
+  have h'' : ∃ y, tendsto f (𝓝[<] a) (𝓝 y) := ⟨y, h'⟩,
+  rw [h'α.topology_eq_generate_intervals] at h h' h'',
+  simp only [left_lim, h, h'', not_true, or_self, if_false],
+  haveI := ne_bot_iff.2 h,
+  exact h'.lim_eq,
+end
+
+lemma left_lim_eq_of_eq_bot [hα : topological_space α] [h'α : order_topology α]
+  (f : α → β) {a : α} (h : 𝓝[<] a = ⊥) :
+  left_lim f a = f a :=
+begin
+  rw [h'α.topology_eq_generate_intervals] at h,
+  simp [left_lim, ite_eq_left_iff, h],
+end
+
+end
+
+open function
+
+namespace monotone
+
+variables {α β : Type*} [linear_order α] [conditionally_complete_linear_order β]
+[topological_space β] [order_topology β] {f : α → β} (hf : monotone f) {x y : α}
+include hf
+
+lemma left_lim_eq_Sup [topological_space α] [order_topology α] (h : 𝓝[<] x ≠ ⊥) :
+  left_lim f x = Sup (f '' (Iio x)) :=
+left_lim_eq_of_tendsto h (hf.tendsto_nhds_within_Iio x)
+
+lemma left_lim_le (h : x ≤ y) : left_lim f x ≤ f y :=
+begin
+  letI : topological_space α := preorder.topology α,
+  haveI : order_topology α := ⟨rfl⟩,
+  rcases eq_or_ne (𝓝[<] x) ⊥ with h'|h',
+  { simpa [left_lim, h'] using hf h },
+  haveI A : ne_bot (𝓝[<] x) := ne_bot_iff.2 h',
+  rw left_lim_eq_Sup hf h',
+  refine cSup_le _ _,
+  { simp only [nonempty_image_iff],
+    exact (forall_mem_nonempty_iff_ne_bot.2 A) _ self_mem_nhds_within },
+  { simp only [mem_image, mem_Iio, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂],
+    assume z hz,
+    exact hf (hz.le.trans h) },
+end
+
+lemma le_left_lim (h : x < y) : f x ≤ left_lim f y :=
+begin
+  letI : topological_space α := preorder.topology α,
+  haveI : order_topology α := ⟨rfl⟩,
+  rcases eq_or_ne (𝓝[<] y) ⊥ with h'|h',
+  { rw left_lim_eq_of_eq_bot _ h', exact hf h.le },
+  rw left_lim_eq_Sup hf h',
+  refine le_cSup ⟨f y, _⟩ (mem_image_of_mem _ h),
+  simp only [upper_bounds, mem_image, mem_Iio, forall_exists_index, and_imp,
+    forall_apply_eq_imp_iff₂, mem_set_of_eq],
+  assume z hz,
+  exact hf hz.le
+end
+
+@[mono] protected lemma left_lim : monotone (left_lim f) :=
+begin
+  assume x y h,
+  rcases eq_or_lt_of_le h with rfl|hxy,
+  { exact le_rfl },
+  { exact (hf.left_lim_le le_rfl).trans (hf.le_left_lim hxy) }
+end
+
+lemma le_right_lim (h : x ≤ y) : f x ≤ right_lim f y :=
+hf.dual.left_lim_le h
+
+lemma right_lim_le (h : x < y) : right_lim f x ≤ f y :=
+hf.dual.le_left_lim h
+
+@[mono] protected lemma right_lim : monotone (right_lim f) :=
+λ x y h, hf.dual.left_lim h
+
+lemma left_lim_le_right_lim (h : x ≤ y) : left_lim f x ≤ right_lim f y :=
+(hf.left_lim_le le_rfl).trans (hf.le_right_lim h)
+
+lemma right_lim_le_left_lim (h : x < y) : right_lim f x ≤ left_lim f y :=
+begin
+  letI : topological_space α := preorder.topology α,
+  haveI : order_topology α := ⟨rfl⟩,
+  rcases eq_or_ne (𝓝[<] y) ⊥ with h'|h',
+  { simp [left_lim, h'],
+    exact right_lim_le hf h },
+  obtain ⟨a, ⟨xa, ay⟩⟩ : (Ioo x y).nonempty :=
+    forall_mem_nonempty_iff_ne_bot.2 (ne_bot_iff.2 h') (Ioo x y)
+      (Ioo_mem_nhds_within_Iio ⟨h, le_refl _⟩),
+  calc right_lim f x ≤ f a : hf.right_lim_le xa
+  ... ≤ left_lim f y : hf.le_left_lim ay
+end
+
+variables [topological_space α] [order_topology α]
+
+lemma tendsto_left_lim (x : α) : tendsto f (𝓝[<] x) (𝓝 (left_lim f x)) :=
+begin
+  rcases eq_or_ne (𝓝[<] x) ⊥ with h'|h',
+  { simp [h'] },
+  rw left_lim_eq_Sup hf h',
+  exact hf.tendsto_nhds_within_Iio x
+end
+
+lemma tendsto_left_lim_within (x : α) : tendsto f (𝓝[<] x) (𝓝[≤] (left_lim f x)) :=
+begin
+  apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within f (hf.tendsto_left_lim x),
+  filter_upwards [self_mem_nhds_within] with y hy using hf.le_left_lim hy,
+end
+
+lemma tendsto_right_lim (x : α) :
+  tendsto f (𝓝[>] x) (𝓝 (right_lim f x)) :=
+hf.dual.tendsto_left_lim x
+
+lemma tendsto_right_lim_within (x : α) :
+  tendsto f (𝓝[>] x) (𝓝[≥] (right_lim f x)) :=
+hf.dual.tendsto_left_lim_within x
+
+/-- A monotone function is continuous to the left at a point if and only if its left limit
+coincides with the value of the function. -/
+lemma continuous_within_at_Iio_iff_left_lim_eq  :
+  continuous_within_at f (Iio x) x ↔ left_lim f x = f x :=
+begin
+  rcases eq_or_ne (𝓝[<] x) ⊥ with h'|h',
+  { simp [left_lim_eq_of_eq_bot f h', continuous_within_at, h'] },
+  haveI : (𝓝[Iio x] x).ne_bot := ne_bot_iff.2 h',
+  refine ⟨λ h, tendsto_nhds_unique (hf.tendsto_left_lim x) h.tendsto, λ h, _⟩,
+  have := hf.tendsto_left_lim x,
+  rwa h at this,
+end
+
+/-- A monotone function is continuous to the right at a point if and only if its right limit
+coincides with the value of the function. -/
+lemma continuous_within_at_Ioi_iff_right_lim_eq :
+  continuous_within_at f (Ioi x) x ↔ right_lim f x = f x :=
+hf.dual.continuous_within_at_Iio_iff_left_lim_eq
+
+/-- A monotone function is continuous at a point if and only if its left and right limits
+coincide. -/
+lemma continuous_at_iff_left_lim_eq_right_lim :
+  continuous_at f x ↔ left_lim f x = right_lim f x :=
+begin
+  refine ⟨λ h, _, λ h, _⟩,
+  { have A : left_lim f x = f x,
+      from (hf.continuous_within_at_Iio_iff_left_lim_eq).1 h.continuous_within_at,
+    have B : right_lim f x = f x,
+      from (hf.continuous_within_at_Ioi_iff_right_lim_eq).1 h.continuous_within_at,
+    exact A.trans B.symm },
+  { have h' : left_lim f x = f x,
+    { apply le_antisymm (left_lim_le hf (le_refl _)),
+      rw h,
+      exact le_right_lim hf (le_refl _) },
+    refine continuous_at_iff_continuous_left'_right'.2 ⟨_, _⟩,
+    { exact hf.continuous_within_at_Iio_iff_left_lim_eq.2 h' },
+    { rw h at h',
+      exact hf.continuous_within_at_Ioi_iff_right_lim_eq.2 h' } },
+end
+
+/-- In a second countable space, the set of points where a monotone function is not right-continuous
+is at most countable. Superseded by `countable_not_continuous_at` which gives the two-sided
+version. -/
+lemma countable_not_continuous_within_at_Ioi [topological_space.second_countable_topology β] :
+  set.countable {x | ¬(continuous_within_at f (Ioi x) x)} :=
+begin
+  /- If `f` is not continuous on the right at `x`, there is an interval `(f x, z x)` which is not
+  reached by `f`. This gives a family of disjoint open intervals in `β`. Such a family can only
+  be countable as `β` is second-countable. -/
+  nontriviality α,
+  let s := {x | ¬(continuous_within_at f (Ioi x) x)},
+  have : ∀ x, x ∈ s → ∃ z, f x < z ∧ ∀ y, x < y → z ≤ f y,
+  { rintros x (hx : ¬(continuous_within_at f (Ioi x) x)),
+    contrapose! hx,
+    refine tendsto_order.2 ⟨λ m hm, _, λ u hu, _⟩,
+    { filter_upwards [self_mem_nhds_within] with y hy using hm.trans_le (hf (le_of_lt hy)) },
+    rcases hx u hu with ⟨v, xv, fvu⟩,
+    have : Ioo x v ∈ 𝓝[>] x, from Ioo_mem_nhds_within_Ioi ⟨le_refl _, xv⟩,
+    filter_upwards [this] with y hy,
+    apply (hf hy.2.le).trans_lt fvu },
+  -- choose `z x` such that `f` does not take the values in `(f x, z x)`.
+  choose! z hz using this,
+  have I : inj_on f s,
+  { apply strict_mono_on.inj_on,
+    assume x hx y hy hxy,
+    calc f x < z x : (hz x hx).1
+    ... ≤ f y : (hz x hx).2 y hxy },
+  -- show that `f s` is countable by arguing that a disjoint family of disjoint open intervals
+  -- (the intervals `(f x, z x)`) is at most countable.
+  have fs_count : (f '' s).countable,
+  { have A : (f '' s).pairwise_disjoint (λ x, Ioo x (z (inv_fun_on f s x))),
+    { rintros _ ⟨u, us, rfl⟩ _ ⟨v, vs, rfl⟩ huv,
+      wlog hle : u ≤ v generalizing u v,
+      { exact (this v vs u us huv.symm (le_of_not_le hle)).symm },
+      have hlt : u < v, from hle.lt_of_ne (ne_of_apply_ne _ huv),
+      apply disjoint_iff_forall_ne.2,
+      rintros a ha b hb rfl,
+      simp only [I.left_inv_on_inv_fun_on us, I.left_inv_on_inv_fun_on vs] at ha hb,
+      exact lt_irrefl _ ((ha.2.trans_le ((hz u us).2 v hlt)).trans hb.1) },
+    apply set.pairwise_disjoint.countable_of_Ioo A,
+    rintros _ ⟨y, ys, rfl⟩,
+    simpa only [I.left_inv_on_inv_fun_on ys] using (hz y ys).1 },
+  exact maps_to.countable_of_inj_on (maps_to_image f s) I fs_count,
+end
+
+/-- In a second countable space, the set of points where a monotone function is not left-continuous
+is at most countable. Superseded by `countable_not_continuous_at` which gives the two-sided
+version. -/
+lemma countable_not_continuous_within_at_Iio [topological_space.second_countable_topology β] :
+  set.countable {x | ¬(continuous_within_at f (Iio x) x)} :=
+hf.dual.countable_not_continuous_within_at_Ioi
+
+/-- In a second countable space, the set of points where a monotone function is not continuous
+is at most countable. -/
+lemma countable_not_continuous_at [topological_space.second_countable_topology β] :
+  set.countable {x | ¬(continuous_at f x)} :=
+begin
+  apply (hf.countable_not_continuous_within_at_Ioi.union
+         hf.countable_not_continuous_within_at_Iio).mono _,
+  refine compl_subset_compl.1 _,
+  simp only [compl_union],
+  rintros x ⟨hx, h'x⟩,
+  simp only [mem_set_of_eq, not_not, mem_compl_iff] at hx h'x ⊢,
+  exact continuous_at_iff_continuous_left'_right'.2 ⟨h'x, hx⟩
+end
+
+end monotone
+
+namespace antitone
+
+variables {α β : Type*} [linear_order α] [conditionally_complete_linear_order β]
+[topological_space β] [order_topology β] {f : α → β} (hf : antitone f) {x y : α}
+include hf
+
+lemma le_left_lim (h : x ≤ y) : f y ≤ left_lim f x :=
+hf.dual_right.left_lim_le h
+
+lemma left_lim_le (h : x < y) : left_lim f y ≤ f x :=
+hf.dual_right.le_left_lim h
+
+@[mono] protected lemma left_lim : antitone (left_lim f) :=
+hf.dual_right.left_lim
+
+lemma right_lim_le (h : x ≤ y) : right_lim f y ≤ f x :=
+hf.dual_right.le_right_lim h
+
+lemma le_right_lim (h : x < y) : f y ≤ right_lim f x :=
+hf.dual_right.right_lim_le h
+
+@[mono] protected lemma right_lim : antitone (right_lim f) :=
+hf.dual_right.right_lim
+
+lemma right_lim_le_left_lim (h : x ≤ y) : right_lim f y ≤ left_lim f x :=
+hf.dual_right.left_lim_le_right_lim h
+
+lemma left_lim_le_right_lim (h : x < y) : left_lim f y ≤ right_lim f x :=
+hf.dual_right.right_lim_le_left_lim h
+
+variables [topological_space α] [order_topology α]
+
+lemma tendsto_left_lim (x : α) : tendsto f (𝓝[<] x) (𝓝 (left_lim f x)) :=
+hf.dual_right.tendsto_left_lim x
+
+lemma tendsto_left_lim_within (x : α) : tendsto f (𝓝[<] x) (𝓝[≥] (left_lim f x)) :=
+hf.dual_right.tendsto_left_lim_within x
+
+lemma tendsto_right_lim (x : α) :
+  tendsto f (𝓝[>] x) (𝓝 (right_lim f x)) :=
+hf.dual_right.tendsto_right_lim x
+
+lemma tendsto_right_lim_within (x : α) :
+  tendsto f (𝓝[>] x) (𝓝[≤] (right_lim f x)) :=
+hf.dual_right.tendsto_right_lim_within x
+
+/-- An antitone function is continuous to the left at a point if and only if its left limit
+coincides with the value of the function. -/
+lemma continuous_within_at_Iio_iff_left_lim_eq  :
+  continuous_within_at f (Iio x) x ↔ left_lim f x = f x :=
+hf.dual_right.continuous_within_at_Iio_iff_left_lim_eq
+
+/-- An antitone function is continuous to the right at a point if and only if its right limit
+coincides with the value of the function. -/
+lemma continuous_within_at_Ioi_iff_right_lim_eq :
+  continuous_within_at f (Ioi x) x ↔ right_lim f x = f x :=
+hf.dual_right.continuous_within_at_Ioi_iff_right_lim_eq
+
+/-- An antitone function is continuous at a point if and only if its left and right limits
+coincide. -/
+lemma continuous_at_iff_left_lim_eq_right_lim :
+  continuous_at f x ↔ left_lim f x = right_lim f x :=
+hf.dual_right.continuous_at_iff_left_lim_eq_right_lim
+
+/-- In a second countable space, the set of points where an antitone function is not continuous
+is at most countable. -/
+lemma countable_not_continuous_at [topological_space.second_countable_topology β] :
+  set.countable {x | ¬(continuous_at f x)} :=
+hf.dual_right.countable_not_continuous_at
+
+end antitone
diff --git a/src/topology/algebra/order/liminf_limsup.lean b/src/topology/algebra/order/liminf_limsup.lean
index 30d7484a0e540..74946971a14e3 100644
--- a/src/topology/algebra/order/liminf_limsup.lean
+++ b/src/topology/algebra/order/liminf_limsup.lean
@@ -1,90 +1,170 @@
 /-
 Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
+Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov, Yaël Dillies
 -/
+import algebra.big_operators.intervals
+import algebra.big_operators.order
+import algebra.indicator_function
 import order.liminf_limsup
-import topology.algebra.order.basic
+import order.filter.archimedean
+import order.filter.countable_Inter
+import topology.order.basic
 
 /-!
 # Lemmas about liminf and limsup in an order topology.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main declarations
+
+* `bounded_le_nhds_class`: Typeclass stating that neighborhoods are eventually bounded above.
+* `bounded_ge_nhds_class`: Typeclass stating that neighborhoods are eventually bounded below.
+
+## Implementation notes
+
+The same lemmas are true in `ℝ`, `ℝ × ℝ`, `ι → ℝ`, `euclidean_space ι ℝ`. To avoid code
+duplication, we provide an ad hoc axiomatisation of the properties we need.
 -/
 
-open filter
-open_locale topological_space classical
+open filter topological_space
+open_locale topology classical
 
 universes u v
-variables {α : Type u} {β : Type v}
+variables {ι α β R S : Type*} {π : ι → Type*}
 
-section liminf_limsup
+/-- Ad hoc typeclass stating that neighborhoods are eventually bounded above. -/
+class bounded_le_nhds_class (α : Type*) [preorder α] [topological_space α] : Prop :=
+(is_bounded_le_nhds (a : α) : (𝓝 a).is_bounded (≤))
+
+/-- Ad hoc typeclass stating that neighborhoods are eventually bounded below. -/
+class bounded_ge_nhds_class (α : Type*) [preorder α] [topological_space α] : Prop :=
+(is_bounded_ge_nhds (a : α) : (𝓝 a).is_bounded (≥))
+
+section preorder
+variables [preorder α] [preorder β] [topological_space α] [topological_space β]
 
-section order_closed_topology
-variables [semilattice_sup α] [topological_space α] [order_topology α]
+section bounded_le_nhds_class
+variables [bounded_le_nhds_class α] [bounded_le_nhds_class β] {f : filter ι} {u : ι → α} {a : α}
 
 lemma is_bounded_le_nhds (a : α) : (𝓝 a).is_bounded (≤) :=
-match forall_le_or_exists_lt_sup a with
-| or.inl h := ⟨a, eventually_of_forall h⟩
-| or.inr ⟨b, hb⟩ := ⟨b, ge_mem_nhds hb⟩
-end
+bounded_le_nhds_class.is_bounded_le_nhds _
 
-lemma filter.tendsto.is_bounded_under_le {f : filter β} {u : β → α} {a : α}
-  (h : tendsto u f (𝓝 a)) : f.is_bounded_under (≤) u :=
+lemma filter.tendsto.is_bounded_under_le (h : tendsto u f (𝓝 a)) :
+  f.is_bounded_under (≤) u :=
 (is_bounded_le_nhds a).mono h
 
-lemma filter.tendsto.bdd_above_range_of_cofinite {u : β → α} {a : α}
+lemma filter.tendsto.bdd_above_range_of_cofinite [is_directed α (≤)]
   (h : tendsto u cofinite (𝓝 a)) : bdd_above (set.range u) :=
 h.is_bounded_under_le.bdd_above_range_of_cofinite
 
-lemma filter.tendsto.bdd_above_range {u : ℕ → α} {a : α}
-  (h : tendsto u at_top (𝓝 a)) : bdd_above (set.range u) :=
+lemma filter.tendsto.bdd_above_range [is_directed α (≤)] {u : ℕ → α} (h : tendsto u at_top (𝓝 a)) :
+  bdd_above (set.range u) :=
 h.is_bounded_under_le.bdd_above_range
 
 lemma is_cobounded_ge_nhds (a : α) : (𝓝 a).is_cobounded (≥) :=
 (is_bounded_le_nhds a).is_cobounded_flip
 
-lemma filter.tendsto.is_cobounded_under_ge {f : filter β} {u : β → α} {a : α}
-  [ne_bot f] (h : tendsto u f (𝓝 a)) : f.is_cobounded_under (≥) u :=
+lemma filter.tendsto.is_cobounded_under_ge [ne_bot f] (h : tendsto u f (𝓝 a)) :
+  f.is_cobounded_under (≥) u :=
 h.is_bounded_under_le.is_cobounded_flip
 
-end order_closed_topology
+instance : bounded_ge_nhds_class αᵒᵈ := ⟨@is_bounded_le_nhds α _ _ _⟩
+
+instance : bounded_le_nhds_class (α × β) :=
+begin
+  refine ⟨λ x, _⟩,
+  obtain ⟨a, ha⟩ := is_bounded_le_nhds x.1,
+  obtain ⟨b, hb⟩ := is_bounded_le_nhds x.2,
+  rw [←@prod.mk.eta _ _ x, nhds_prod_eq],
+  exact ⟨(a, b), ha.prod_mk hb⟩,
+end
+
+instance [finite ι] [Π i, preorder (π i)] [Π i, topological_space (π i)]
+  [Π i, bounded_le_nhds_class (π i)] : bounded_le_nhds_class (Π i, π i) :=
+begin
+  refine ⟨λ x, _⟩,
+  rw nhds_pi,
+  choose f hf using λ i, is_bounded_le_nhds (x i),
+  exact ⟨f, eventually_pi hf⟩,
+end
+
+end bounded_le_nhds_class
 
-section order_closed_topology
-variables [semilattice_inf α] [topological_space α] [order_topology α]
+section bounded_ge_nhds_class
+variables [bounded_ge_nhds_class α] [bounded_ge_nhds_class β] {f : filter ι} {u : ι → α} {a : α}
 
-lemma is_bounded_ge_nhds (a : α) : (𝓝 a).is_bounded (≥) := @is_bounded_le_nhds αᵒᵈ _ _ _ a
+lemma is_bounded_ge_nhds (a : α) : (𝓝 a).is_bounded (≥) :=
+bounded_ge_nhds_class.is_bounded_ge_nhds _
 
-lemma filter.tendsto.is_bounded_under_ge {f : filter β} {u : β → α} {a : α}
-  (h : tendsto u f (𝓝 a)) : f.is_bounded_under (≥) u :=
+lemma filter.tendsto.is_bounded_under_ge (h : tendsto u f (𝓝 a)) :
+  f.is_bounded_under (≥) u :=
 (is_bounded_ge_nhds a).mono h
 
-lemma filter.tendsto.bdd_below_range_of_cofinite {u : β → α} {a : α}
+lemma filter.tendsto.bdd_below_range_of_cofinite [is_directed α (≥)]
   (h : tendsto u cofinite (𝓝 a)) : bdd_below (set.range u) :=
 h.is_bounded_under_ge.bdd_below_range_of_cofinite
 
-lemma filter.tendsto.bdd_below_range {u : ℕ → α} {a : α}
-  (h : tendsto u at_top (𝓝 a)) : bdd_below (set.range u) :=
+lemma filter.tendsto.bdd_below_range [is_directed α (≥)] {u : ℕ → α} (h : tendsto u at_top (𝓝 a)) :
+  bdd_below (set.range u) :=
 h.is_bounded_under_ge.bdd_below_range
 
 lemma is_cobounded_le_nhds (a : α) : (𝓝 a).is_cobounded (≤) :=
 (is_bounded_ge_nhds a).is_cobounded_flip
 
-lemma filter.tendsto.is_cobounded_under_le {f : filter β} {u : β → α} {a : α}
-  [ne_bot f] (h : tendsto u f (𝓝 a)) : f.is_cobounded_under (≤) u :=
+lemma filter.tendsto.is_cobounded_under_le [ne_bot f] (h : tendsto u f (𝓝 a)) :
+  f.is_cobounded_under (≤) u :=
 h.is_bounded_under_ge.is_cobounded_flip
 
-end order_closed_topology
+instance : bounded_le_nhds_class αᵒᵈ := ⟨@is_bounded_ge_nhds α _ _ _⟩
 
-section conditionally_complete_linear_order
-variables [conditionally_complete_linear_order α]
+instance : bounded_ge_nhds_class (α × β) :=
+begin
+  refine ⟨λ x, _⟩,
+  obtain ⟨a, ha⟩ := is_bounded_ge_nhds x.1,
+  obtain ⟨b, hb⟩ := is_bounded_ge_nhds x.2,
+  rw [←@prod.mk.eta _ _ x, nhds_prod_eq],
+  exact ⟨(a, b), ha.prod_mk hb⟩,
+end
+
+instance [finite ι] [Π i, preorder (π i)] [Π i, topological_space (π i)]
+  [Π i, bounded_ge_nhds_class (π i)] : bounded_ge_nhds_class (Π i, π i) :=
+begin
+  refine ⟨λ x, _⟩,
+  rw nhds_pi,
+  choose f hf using λ i, is_bounded_ge_nhds (x i),
+  exact ⟨f, eventually_pi hf⟩,
+end
+
+end bounded_ge_nhds_class
 
-theorem lt_mem_sets_of_Limsup_lt {f : filter α} {b} (h : f.is_bounded (≤)) (l : f.Limsup < b) :
-  ∀ᶠ a in f, a < b :=
-let ⟨c, (h : ∀ᶠ a in f, a ≤ c), hcb⟩ := exists_lt_of_cInf_lt h l in
-mem_of_superset h $ assume a hac, lt_of_le_of_lt hac hcb
+@[priority 100] -- See note [lower instance priority]
+instance order_top.to_bounded_le_nhds_class [order_top α] : bounded_le_nhds_class α :=
+⟨λ a, is_bounded_le_of_top⟩
 
-theorem gt_mem_sets_of_Liminf_gt : ∀ {f : filter α} {b}, f.is_bounded (≥) → b < f.Liminf →
-  ∀ᶠ a in f, b < a :=
-@lt_mem_sets_of_Limsup_lt αᵒᵈ _
+@[priority 100] -- See note [lower instance priority]
+instance order_bot.to_bounded_ge_nhds_class [order_bot α] : bounded_ge_nhds_class α :=
+⟨λ a, is_bounded_ge_of_bot⟩
+
+@[priority 100] -- See note [lower instance priority]
+instance order_topology.to_bounded_le_nhds_class [is_directed α (≤)] [order_topology α] :
+  bounded_le_nhds_class α :=
+⟨λ a, (is_top_or_exists_gt a).elim (λ h, ⟨a, eventually_of_forall h⟩) $ Exists.imp $ λ b,
+  ge_mem_nhds⟩
+
+@[priority 100] -- See note [lower instance priority]
+instance order_topology.to_bounded_ge_nhds_class [is_directed α (≥)] [order_topology α] :
+  bounded_ge_nhds_class α :=
+⟨λ a, (is_bot_or_exists_lt a).elim (λ h, ⟨a, eventually_of_forall h⟩) $ Exists.imp $ λ b,
+  le_mem_nhds⟩
+
+end preorder
+
+section liminf_limsup
+
+section conditionally_complete_linear_order
+variables [conditionally_complete_linear_order α]
 
 variables [topological_space α] [order_topology α]
 
@@ -127,18 +207,18 @@ theorem Limsup_eq_of_le_nhds : ∀ {f : filter α} {a : α} [ne_bot f], f ≤ 
 
 /-- If a function has a limit, then its limsup coincides with its limit. -/
 theorem filter.tendsto.limsup_eq {f : filter β} {u : β → α} {a : α} [ne_bot f]
-  (h : tendsto u f (𝓝 a)) : limsup f u = a :=
+  (h : tendsto u f (𝓝 a)) : limsup u f = a :=
 Limsup_eq_of_le_nhds h
 
 /-- If a function has a limit, then its liminf coincides with its limit. -/
 theorem filter.tendsto.liminf_eq {f : filter β} {u : β → α} {a : α} [ne_bot f]
-  (h : tendsto u f (𝓝 a)) : liminf f u = a :=
+  (h : tendsto u f (𝓝 a)) : liminf u f = a :=
 Liminf_eq_of_le_nhds h
 
 /-- If the liminf and the limsup of a function coincide, then the limit of the function
 exists and has the same value -/
 theorem tendsto_of_liminf_eq_limsup {f : filter β} {u : β → α} {a : α}
-  (hinf : liminf f u = a) (hsup : limsup f u = a)
+  (hinf : liminf u f = a) (hsup : limsup u f = a)
   (h : f.is_bounded_under (≤) u . is_bounded_default)
   (h' : f.is_bounded_under (≥) u . is_bounded_default) :
   tendsto u f (𝓝 a) :=
@@ -147,7 +227,7 @@ le_nhds_of_Limsup_eq_Liminf h h' hsup hinf
 /-- If a number `a` is less than or equal to the `liminf` of a function `f` at some filter
 and is greater than or equal to the `limsup` of `f`, then `f` tends to `a` along this filter. -/
 theorem tendsto_of_le_liminf_of_limsup_le {f : filter β} {u : β → α} {a : α}
-  (hinf : a ≤ liminf f u) (hsup : limsup f u ≤ a)
+  (hinf : a ≤ liminf u f) (hsup : limsup u f ≤ a)
   (h : f.is_bounded_under (≤) u . is_bounded_default)
   (h' : f.is_bounded_under (≥) u . is_bounded_default) :
   tendsto u f (𝓝 a) :=
@@ -169,7 +249,7 @@ lemma tendsto_of_no_upcrossings [densely_ordered α]
 begin
   by_cases hbot : f = ⊥, { rw hbot, exact ⟨Inf ∅, tendsto_bot⟩ },
   haveI : ne_bot f := ⟨hbot⟩,
-  refine ⟨limsup f u, _⟩,
+  refine ⟨limsup u f, _⟩,
   apply tendsto_of_le_liminf_of_limsup_le _ le_rfl h h',
   by_contra' hlt,
   obtain ⟨a, ⟨⟨la, au⟩, as⟩⟩ : ∃ a, (f.liminf u < a ∧ a < f.limsup u) ∧ a ∈ s :=
@@ -185,6 +265,268 @@ begin
   exact H a as b bs ab ⟨A, B⟩,
 end
 
+variables [first_countable_topology α] {f : filter β} [countable_Inter_filter f] {u : β → α}
+
+lemma eventually_le_limsup (hf : is_bounded_under (≤) f u . is_bounded_default) :
+  ∀ᶠ b in f, u b ≤ f.limsup u :=
+begin
+  obtain ha | ha := is_top_or_exists_gt (f.limsup u),
+  { exact eventually_of_forall (λ _, ha _) },
+  by_cases H : is_glb (set.Ioi (f.limsup u)) (f.limsup u),
+  { obtain ⟨u, -, -, hua, hu⟩ := H.exists_seq_antitone_tendsto ha,
+    have := λ n, eventually_lt_of_limsup_lt (hu n) hf,
+    exact (eventually_countable_forall.2 this).mono
+      (λ b hb, ge_of_tendsto hua $ eventually_of_forall $ λ n, (hb _).le) },
+  { obtain ⟨x, hx, xa⟩ : ∃ x, (∀ ⦃b⦄, f.limsup u < b → x ≤ b) ∧ f.limsup u < x,
+    { simp only [is_glb, is_greatest, lower_bounds, upper_bounds, set.mem_Ioi, set.mem_set_of_eq,
+        not_and, not_forall, not_le, exists_prop] at H,
+      exact H (λ x hx, le_of_lt hx) },
+    filter_upwards [eventually_lt_of_limsup_lt xa hf] with y hy,
+    contrapose! hy,
+    exact hx hy }
+end
+
+lemma eventually_liminf_le (hf : is_bounded_under (≥) f u . is_bounded_default) :
+  ∀ᶠ b in f, f.liminf u ≤ u b :=
+@eventually_le_limsup αᵒᵈ _ _ _ _ _ _ _ _ hf
+
 end conditionally_complete_linear_order
 
+section complete_linear_order
+variables [complete_linear_order α] [topological_space α] [first_countable_topology α]
+  [order_topology α] {f : filter β} [countable_Inter_filter f] {u : β → α}
+
+@[simp] lemma limsup_eq_bot : f.limsup u = ⊥ ↔ u =ᶠ[f] ⊥ :=
+⟨λ h, (eventually_le.trans eventually_le_limsup $ eventually_of_forall $ λ _, h.le).mono $ λ x hx,
+  le_antisymm hx bot_le, λ h, by { rw limsup_congr h, exact limsup_const_bot }⟩
+
+@[simp] lemma liminf_eq_top : f.liminf u = ⊤ ↔ u =ᶠ[f] ⊤ := @limsup_eq_bot αᵒᵈ _ _ _ _ _ _ _ _
+
+end complete_linear_order
+
 end liminf_limsup
+
+section monotone
+
+variables {F : filter ι} [ne_bot F]
+  [complete_linear_order R] [topological_space R] [order_topology R]
+  [complete_linear_order S] [topological_space S] [order_topology S]
+
+/-- An antitone function between complete linear ordered spaces sends a `filter.Limsup`
+to the `filter.liminf` of the image if it is continuous at the `Limsup`. -/
+lemma antitone.map_Limsup_of_continuous_at {F : filter R} [ne_bot F]
+  {f : R → S} (f_decr : antitone f) (f_cont : continuous_at f (F.Limsup)) :
+  f (F.Limsup) = F.liminf f :=
+begin
+  apply le_antisymm,
+  { have A : {a : R | ∀ᶠ (n : R) in F, n ≤ a}.nonempty, from ⟨⊤, by simp⟩,
+    rw [Limsup, (f_decr.map_Inf_of_continuous_at' f_cont A)],
+    apply le_of_forall_lt,
+    assume c hc,
+    simp only [liminf, Liminf, lt_Sup_iff, eventually_map, set.mem_set_of_eq, exists_prop,
+      set.mem_image, exists_exists_and_eq_and] at hc ⊢,
+    rcases hc with ⟨d, hd, h'd⟩,
+    refine ⟨f d, _, h'd⟩,
+    filter_upwards [hd] with x hx using f_decr hx },
+  { rcases eq_or_lt_of_le (bot_le : ⊥ ≤ F.Limsup) with h|Limsup_ne_bot,
+    { rw ← h,
+      apply liminf_le_of_frequently_le,
+      apply frequently_of_forall,
+      assume x,
+      exact f_decr bot_le },
+    by_cases h' : ∃ c, c < F.Limsup ∧ set.Ioo c F.Limsup = ∅,
+    { rcases h' with ⟨c, c_lt, hc⟩,
+      have B : ∃ᶠ n in F, F.Limsup ≤ n,
+      { apply (frequently_lt_of_lt_Limsup (by is_bounded_default) c_lt).mono,
+        assume x hx,
+        by_contra',
+        have : (set.Ioo c F.Limsup).nonempty := ⟨x, ⟨hx, this⟩⟩,
+        simpa [hc] },
+      apply liminf_le_of_frequently_le,
+      exact B.mono (λ x hx, f_decr hx) },
+    by_contra' H,
+    obtain ⟨l, l_lt, h'l⟩ : ∃ l < F.Limsup, set.Ioc l F.Limsup ⊆ {x : R | f x < F.liminf f},
+      from exists_Ioc_subset_of_mem_nhds ((tendsto_order.1 f_cont.tendsto).2 _ H)
+        ⟨⊥, Limsup_ne_bot⟩,
+    obtain ⟨m, l_m, m_lt⟩  : (set.Ioo l F.Limsup).nonempty,
+    { contrapose! h',
+      refine ⟨l, l_lt, by rwa set.not_nonempty_iff_eq_empty at h'⟩ },
+    have B : F.liminf f ≤ f m,
+    { apply liminf_le_of_frequently_le,
+      apply (frequently_lt_of_lt_Limsup (by is_bounded_default) m_lt).mono,
+      assume x hx,
+      exact f_decr hx.le },
+    have I : f m < F.liminf f := h'l ⟨l_m, m_lt.le⟩,
+    exact lt_irrefl _ (B.trans_lt I) }
+end
+
+/-- A continuous antitone function between complete linear ordered spaces sends a `filter.limsup`
+to the `filter.liminf` of the images. -/
+lemma antitone.map_limsup_of_continuous_at
+  {f : R → S} (f_decr : antitone f) (a : ι → R) (f_cont : continuous_at f (F.limsup a)) :
+  f (F.limsup a) = F.liminf (f ∘ a) :=
+f_decr.map_Limsup_of_continuous_at f_cont
+
+/-- An antitone function between complete linear ordered spaces sends a `filter.Liminf`
+to the `filter.limsup` of the image if it is continuous at the `Liminf`. -/
+lemma antitone.map_Liminf_of_continuous_at {F : filter R} [ne_bot F]
+  {f : R → S} (f_decr : antitone f) (f_cont : continuous_at f (F.Liminf)) :
+  f (F.Liminf) = F.limsup f :=
+@antitone.map_Limsup_of_continuous_at
+  (order_dual R) (order_dual S) _ _ _ _ _ _ _ _ f f_decr.dual f_cont
+
+/-- A continuous antitone function between complete linear ordered spaces sends a `filter.liminf`
+to the `filter.limsup` of the images. -/
+lemma antitone.map_liminf_of_continuous_at
+  {f : R → S} (f_decr : antitone f) (a : ι → R) (f_cont : continuous_at f (F.liminf a)) :
+  f (F.liminf a) = F.limsup (f ∘ a) :=
+f_decr.map_Liminf_of_continuous_at f_cont
+
+/-- A monotone function between complete linear ordered spaces sends a `filter.Limsup`
+to the `filter.limsup` of the image if it is continuous at the `Limsup`. -/
+lemma monotone.map_Limsup_of_continuous_at {F : filter R} [ne_bot F]
+  {f : R → S} (f_incr : monotone f) (f_cont : continuous_at f (F.Limsup)) :
+  f (F.Limsup) = F.limsup f :=
+@antitone.map_Limsup_of_continuous_at R (order_dual S) _ _ _ _ _ _ _ _ f f_incr f_cont
+
+/-- A continuous monotone function between complete linear ordered spaces sends a `filter.limsup`
+to the `filter.limsup` of the images. -/
+lemma monotone.map_limsup_of_continuous_at
+  {f : R → S} (f_incr : monotone f) (a : ι → R) (f_cont : continuous_at f (F.limsup a)) :
+  f (F.limsup a) = F.limsup (f ∘ a) :=
+f_incr.map_Limsup_of_continuous_at f_cont
+
+/-- A monotone function between complete linear ordered spaces sends a `filter.Liminf`
+to the `filter.liminf` of the image if it is continuous at the `Liminf`. -/
+lemma monotone.map_Liminf_of_continuous_at {F : filter R} [ne_bot F]
+  {f : R → S} (f_incr : monotone f) (f_cont : continuous_at f (F.Liminf)) :
+  f (F.Liminf) = F.liminf f :=
+@antitone.map_Liminf_of_continuous_at R (order_dual S) _ _ _ _ _ _ _ _ f f_incr f_cont
+
+/-- A continuous monotone function between complete linear ordered spaces sends a `filter.liminf`
+to the `filter.liminf` of the images. -/
+lemma monotone.map_liminf_of_continuous_at
+  {f : R → S} (f_incr : monotone f) (a : ι → R) (f_cont : continuous_at f (F.liminf a)) :
+  f (F.liminf a) = F.liminf (f ∘ a) :=
+f_incr.map_Liminf_of_continuous_at f_cont
+
+end monotone
+
+section infi_and_supr
+
+open_locale topology
+
+open filter set
+
+variables [complete_linear_order R] [topological_space R] [order_topology R]
+
+lemma infi_eq_of_forall_le_of_tendsto {x : R} {as : ι → R}
+  (x_le : ∀ i, x ≤ as i) {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⨅ i, as i) = x :=
+begin
+  refine infi_eq_of_forall_ge_of_forall_gt_exists_lt (λ i, x_le i) _,
+  apply λ w x_lt_w, ‹filter.ne_bot F›.nonempty_of_mem (eventually_lt_of_tendsto_lt x_lt_w as_lim),
+end
+
+lemma supr_eq_of_forall_le_of_tendsto {x : R} {as : ι → R}
+  (le_x : ∀ i, as i ≤ x) {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⨆ i, as i) = x :=
+@infi_eq_of_forall_le_of_tendsto ι (order_dual R) _ _ _ x as le_x F _ as_lim
+
+lemma Union_Ici_eq_Ioi_of_lt_of_tendsto (x : R) {as : ι → R} (x_lt : ∀ i, x < as i)
+  {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⋃ (i : ι), Ici (as i)) = Ioi x :=
+begin
+  have obs : x ∉ range as,
+  { intro maybe_x_is,
+    rcases mem_range.mp maybe_x_is with ⟨i, hi⟩,
+    simpa only [hi, lt_self_iff_false] using x_lt i, } ,
+  rw ← infi_eq_of_forall_le_of_tendsto (λ i, (x_lt i).le) as_lim at *,
+  exact Union_Ici_eq_Ioi_infi obs,
+end
+
+lemma Union_Iic_eq_Iio_of_lt_of_tendsto (x : R) {as : ι → R} (lt_x : ∀ i, as i < x)
+  {F : filter ι} [filter.ne_bot F] (as_lim : filter.tendsto as F (𝓝 x)) :
+  (⋃ (i : ι), Iic (as i)) = Iio x :=
+@Union_Ici_eq_Ioi_of_lt_of_tendsto ι Rᵒᵈ _ _ _ _ _ lt_x F _ as_lim
+
+end infi_and_supr
+
+section indicator
+
+open_locale big_operators
+
+lemma limsup_eq_tendsto_sum_indicator_nat_at_top (s : ℕ → set α) :
+  limsup s at_top =
+    {ω | tendsto (λ n, ∑ k in finset.range n, (s (k + 1)).indicator (1 : α → ℕ) ω) at_top at_top} :=
+begin
+  ext ω,
+  simp only [limsup_eq_infi_supr_of_nat, ge_iff_le, set.supr_eq_Union,
+      set.infi_eq_Inter, set.mem_Inter, set.mem_Union, exists_prop],
+  split,
+  { intro hω,
+    refine tendsto_at_top_at_top_of_monotone' (λ n m hnm, finset.sum_mono_set_of_nonneg
+      (λ i, set.indicator_nonneg (λ _ _, zero_le_one) _) (finset.range_mono hnm)) _,
+    rintro ⟨i, h⟩,
+    simp only [mem_upper_bounds, set.mem_range, forall_exists_index, forall_apply_eq_imp_iff'] at h,
+    induction i with k hk,
+    { obtain ⟨j, hj₁, hj₂⟩ := hω 1,
+      refine not_lt.2 (h $ j + 1) (lt_of_le_of_lt
+        (finset.sum_const_zero.symm : 0 = ∑ k in finset.range (j + 1), 0).le _),
+      refine finset.sum_lt_sum (λ m _, set.indicator_nonneg (λ _ _, zero_le_one) _)
+        ⟨j - 1, finset.mem_range.2 (lt_of_le_of_lt (nat.sub_le _ _) j.lt_succ_self), _⟩,
+      rw [nat.sub_add_cancel hj₁, set.indicator_of_mem hj₂],
+      exact zero_lt_one },
+    { rw imp_false at hk,
+      push_neg at hk,
+      obtain ⟨i, hi⟩ := hk,
+      obtain ⟨j, hj₁, hj₂⟩ := hω (i + 1),
+      replace hi : ∑ k in finset.range i, (s (k + 1)).indicator 1 ω = k + 1 := le_antisymm (h i) hi,
+      refine not_lt.2 (h $ j + 1) _,
+      rw [← finset.sum_range_add_sum_Ico _ (i.le_succ.trans (hj₁.trans j.le_succ)), hi],
+      refine lt_add_of_pos_right _ _,
+      rw (finset.sum_const_zero.symm : 0 = ∑ k in finset.Ico i (j + 1), 0),
+      refine finset.sum_lt_sum (λ m _, set.indicator_nonneg (λ _ _, zero_le_one) _)
+        ⟨j - 1, finset.mem_Ico.2
+        ⟨(nat.le_sub_iff_right (le_trans ((le_add_iff_nonneg_left _).2 zero_le') hj₁)).2 hj₁,
+          lt_of_le_of_lt (nat.sub_le _ _) j.lt_succ_self⟩, _⟩,
+      rw [nat.sub_add_cancel (le_trans ((le_add_iff_nonneg_left _).2 zero_le') hj₁),
+        set.indicator_of_mem hj₂],
+      exact zero_lt_one } },
+  { rintro hω i,
+    rw [set.mem_set_of_eq, tendsto_at_top_at_top] at hω,
+    by_contra hcon,
+    push_neg at hcon,
+    obtain ⟨j, h⟩ := hω (i + 1),
+    have : ∑ k in finset.range j, (s (k + 1)).indicator 1 ω ≤ i,
+    { have hle : ∀ j ≤ i, ∑ k in finset.range j, (s (k + 1)).indicator 1 ω ≤ i,
+      { refine λ j hij, (finset.sum_le_card_nsmul _ _ _ _ : _ ≤ (finset.range j).card • 1).trans _,
+        { exact λ m hm, set.indicator_apply_le' (λ _, le_rfl) (λ _, zero_le_one) },
+        { simpa only [finset.card_range, smul_eq_mul, mul_one] } },
+      by_cases hij : j < i,
+      { exact hle _ hij.le },
+      { rw ← finset.sum_range_add_sum_Ico _ (not_lt.1 hij),
+        suffices : ∑ k in finset.Ico i j, (s (k + 1)).indicator 1 ω = 0,
+        { rw [this, add_zero],
+          exact hle _ le_rfl },
+        rw finset.sum_eq_zero (λ m hm, _),
+        exact set.indicator_of_not_mem (hcon _ $ (finset.mem_Ico.1 hm).1.trans m.le_succ) _ } },
+    exact not_le.2 (lt_of_lt_of_le i.lt_succ_self $ h _ le_rfl) this }
+end
+
+lemma limsup_eq_tendsto_sum_indicator_at_top
+  (R : Type*) [strict_ordered_semiring R] [archimedean R] (s : ℕ → set α) :
+  limsup s at_top =
+    {ω | tendsto (λ n, ∑ k in finset.range n, (s (k + 1)).indicator (1 : α → R) ω) at_top at_top} :=
+begin
+  rw limsup_eq_tendsto_sum_indicator_nat_at_top s,
+  ext ω,
+  simp only [set.mem_set_of_eq],
+  rw (_ : (λ n, ∑ k in finset.range n, (s (k + 1)).indicator (1 : α → R) ω) =
+    (λ n, ↑(∑ k in finset.range n, (s (k + 1)).indicator (1 : α → ℕ) ω))),
+  { exact tendsto_coe_nat_at_top_iff.symm },
+  { ext n,
+    simp only [set.indicator, pi.one_apply, finset.sum_boole, nat.cast_id] }
+end
+
+end indicator
diff --git a/src/topology/algebra/order/monotone_continuity.lean b/src/topology/algebra/order/monotone_continuity.lean
index 957caae659ca6..4671266286a4d 100644
--- a/src/topology/algebra/order/monotone_continuity.lean
+++ b/src/topology/algebra/order/monotone_continuity.lean
@@ -3,12 +3,15 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov, Heather Macbeth
 -/
-import topology.algebra.order.basic
-import topology.algebra.order.left_right
+import topology.order.basic
+import topology.homeomorph
 
 /-!
 # Continuity of monotone functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the following fact: if `f` is a monotone function on a neighborhood of `a`
 and the image of this neighborhood is a neighborhood of `f a`, then `f` is continuous at `a`, see
 `continuous_at_of_monotone_on_of_image_mem_nhds`, as well as several similar facts.
@@ -21,7 +24,7 @@ continuous, monotone
 -/
 
 open set filter
-open_locale topological_space
+open_locale topology
 
 section linear_order
 variables {α β : Type*} [linear_order α] [topological_space α] [order_topology α]
diff --git a/src/topology/algebra/order/monotone_convergence.lean b/src/topology/algebra/order/monotone_convergence.lean
index fa813e949b10c..aae01923dbf9f 100644
--- a/src/topology/algebra/order/monotone_convergence.lean
+++ b/src/topology/algebra/order/monotone_convergence.lean
@@ -3,11 +3,14 @@ Copyright (c) 2021 Heather Macbeth. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Heather Macbeth, Yury Kudryashov
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Bounded monotone sequences converge
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove a few theorems of the form “if the range of a monotone function `f : ι → α`
 admits a least upper bound `a`, then `f x` tends to `a` as `x → ∞`”, as well as version of this
 statement for (conditionally) complete lattices that use `⨆ x, f x` instead of `is_lub`.
@@ -26,7 +29,7 @@ monotone convergence
 -/
 
 open filter set function
-open_locale filter topological_space classical
+open_locale filter topology classical
 
 variables {α β : Type*}
 
diff --git a/src/topology/algebra/order/proj_Icc.lean b/src/topology/algebra/order/proj_Icc.lean
index 85437ec1d3ed1..0885475c3d961 100644
--- a/src/topology/algebra/order/proj_Icc.lean
+++ b/src/topology/algebra/order/proj_Icc.lean
@@ -4,17 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov, Patrick Massot
 -/
 import data.set.intervals.proj_Icc
-import topology.algebra.order.basic
+import topology.order.basic
 
 /-!
 # Projection onto a closed interval
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that the projection `set.proj_Icc f a b h` is a quotient map, and use it
 to show that `Icc_extend h f` is continuous if and only if `f` is continuous.
 -/
 
 open set filter
-open_locale filter topological_space
+open_locale filter topology
 
 variables {α β γ : Type*} [linear_order α] [topological_space γ] {a b c : α} {h : a ≤ b}
 
@@ -28,7 +31,7 @@ variables [topological_space α] [order_topology α] [topological_space β]
 
 @[continuity]
 lemma continuous_proj_Icc : continuous (proj_Icc a b h) :=
-continuous_subtype_mk _ $ continuous_const.max $ continuous_const.min continuous_id
+(continuous_const.max $ continuous_const.min continuous_id).subtype_mk _
 
 lemma quotient_map_proj_Icc : quotient_map (proj_Icc a b h) :=
 quotient_map_iff.2 ⟨proj_Icc_surjective h, λ s,
diff --git a/src/topology/algebra/order/t5.lean b/src/topology/algebra/order/t5.lean
new file mode 100644
index 0000000000000..14ac6d4ad9c25
--- /dev/null
+++ b/src/topology/algebra/order/t5.lean
@@ -0,0 +1,95 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.order.basic
+import data.set.intervals.ord_connected_component
+
+/-!
+# Linear order is a completely normal Hausdorff topological space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that a linear order with order topology is a completely normal Hausdorff
+topological space.
+-/
+
+open filter set function order_dual
+open_locale topology filter interval
+
+variables {X : Type*} [linear_order X] [topological_space X] [order_topology X]
+  {a b c : X} {s t : set X}
+
+namespace set
+
+@[simp] lemma ord_connected_component_mem_nhds :
+  ord_connected_component s a ∈ 𝓝 a ↔ s ∈ 𝓝 a :=
+begin
+  refine ⟨λ h, mem_of_superset h ord_connected_component_subset, λ h, _⟩,
+  rcases exists_Icc_mem_subset_of_mem_nhds h with ⟨b, c, ha, ha', hs⟩,
+  exact mem_of_superset ha' (subset_ord_connected_component ha hs)
+end
+
+lemma compl_section_ord_separating_set_mem_nhds_within_Ici (hd : disjoint s (closure t))
+  (ha : a ∈ s) :
+  (ord_connected_section $ ord_separating_set s t)ᶜ ∈ 𝓝[≥] a :=
+begin
+  have hmem : tᶜ ∈ 𝓝[≥] a,
+  { refine mem_nhds_within_of_mem_nhds _,
+    rw [← mem_interior_iff_mem_nhds, interior_compl],
+    exact disjoint_left.1 hd ha },
+  rcases exists_Icc_mem_subset_of_mem_nhds_within_Ici hmem with ⟨b, hab, hmem', hsub⟩,
+  by_cases H : disjoint (Icc a b) (ord_connected_section $ ord_separating_set s t),
+  { exact mem_of_superset hmem' (disjoint_left.1 H) },
+  { simp only [set.disjoint_left, not_forall, not_not] at H,
+    rcases H with ⟨c, ⟨hac, hcb⟩, hc⟩,
+    have hsub' : Icc a b ⊆ ord_connected_component tᶜ a,
+      from subset_ord_connected_component (left_mem_Icc.2 hab) hsub,
+    replace hac : a < c := hac.lt_of_ne (ne.symm $ ne_of_mem_of_not_mem hc $ disjoint_left.1
+      (disjoint_left_ord_separating_set.mono_right ord_connected_section_subset) ha),
+    refine mem_of_superset (Ico_mem_nhds_within_Ici (left_mem_Ico.2 hac)) (λ x hx hx', _),
+    refine hx.2.ne (eq_of_mem_ord_connected_section_of_uIcc_subset hx' hc _),
+    refine subset_inter (subset_Union₂_of_subset a ha _) _,
+    { exact ord_connected.uIcc_subset infer_instance (hsub' ⟨hx.1, hx.2.le.trans hcb⟩)
+        (hsub' ⟨hac.le, hcb⟩) },
+    { rcases mem_Union₂.1 (ord_connected_section_subset hx').2 with ⟨y, hyt, hxy⟩,
+      refine subset_Union₂_of_subset y hyt (ord_connected.uIcc_subset infer_instance hxy _),
+      refine subset_ord_connected_component left_mem_uIcc hxy _,
+      suffices : c < y,
+      { rw [uIcc_of_ge (hx.2.trans this).le],
+        exact ⟨hx.2.le, this.le⟩ },
+      refine lt_of_not_le (λ hyc, _),
+      have hya : y < a, from not_le.1 (λ hay, hsub ⟨hay, hyc.trans hcb⟩ hyt),
+      exact hxy (Icc_subset_uIcc ⟨hya.le, hx.1⟩) ha } }
+end
+
+lemma compl_section_ord_separating_set_mem_nhds_within_Iic (hd : disjoint s (closure t))
+  (ha : a ∈ s) : (ord_connected_section $ ord_separating_set s t)ᶜ ∈ 𝓝[≤] a :=
+have hd' : disjoint (of_dual ⁻¹' s) (closure $ of_dual ⁻¹' t) := hd,
+have ha' : to_dual a ∈ of_dual ⁻¹' s := ha,
+by simpa only [dual_ord_separating_set, dual_ord_connected_section]
+  using compl_section_ord_separating_set_mem_nhds_within_Ici hd' ha'
+
+lemma compl_section_ord_separating_set_mem_nhds (hd : disjoint s (closure t)) (ha : a ∈ s) :
+  (ord_connected_section $ ord_separating_set s t)ᶜ ∈ 𝓝 a :=
+begin
+  rw [← nhds_left_sup_nhds_right, mem_sup],
+  exact ⟨compl_section_ord_separating_set_mem_nhds_within_Iic hd ha,
+    compl_section_ord_separating_set_mem_nhds_within_Ici hd ha⟩
+end
+
+lemma ord_t5_nhd_mem_nhds_set (hd : disjoint s (closure t)) : ord_t5_nhd s t ∈ 𝓝ˢ s :=
+bUnion_mem_nhds_set $ λ x hx, ord_connected_component_mem_nhds.2 $
+  inter_mem (by { rw [← mem_interior_iff_mem_nhds, interior_compl], exact disjoint_left.1 hd hx })
+    (compl_section_ord_separating_set_mem_nhds hd hx)
+
+end set
+
+open set
+
+/-- A linear order with order topology is a completely normal Hausdorff topological space. -/
+@[priority 100] instance order_topology.t5_space : t5_space X :=
+⟨λ s t h₁ h₂, filter.disjoint_iff.2 ⟨ord_t5_nhd s t, ord_t5_nhd_mem_nhds_set h₂, ord_t5_nhd t s,
+  ord_t5_nhd_mem_nhds_set h₁.symm, disjoint_ord_t5_nhd⟩⟩
diff --git a/src/topology/algebra/order/upper_lower.lean b/src/topology/algebra/order/upper_lower.lean
new file mode 100644
index 0000000000000..c1286acac2cdc
--- /dev/null
+++ b/src/topology/algebra/order/upper_lower.lean
@@ -0,0 +1,122 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import algebra.order.upper_lower
+import topology.algebra.group.basic
+import topology.order.basic
+
+/-!
+# Topological facts about upper/lower/order-connected sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The topological closure and interior of an upper/lower/order-connected set is an
+upper/lower/order-connected set (with the notable exception of the closure of an order-connected
+set).
+
+## Implementation notes
+
+The same lemmas are true in the additive/multiplicative worlds. To avoid code duplication, we
+provide `has_upper_lower_closure`, an ad hoc axiomatisation of the properties we need.
+-/
+
+open function set
+open_locale pointwise
+
+/-- Ad hoc class stating that the closure of an upper set is an upper set. This is used to state
+lemmas that do not mention algebraic operations for both the additive and multiplicative versions
+simultaneously. If you find a satisfying replacement for this typeclass, please remove it! -/
+class has_upper_lower_closure (α : Type*) [topological_space α] [preorder α] : Prop :=
+(is_upper_set_closure : ∀ s : set α, is_upper_set s → is_upper_set (closure s))
+(is_lower_set_closure : ∀ s : set α, is_lower_set s → is_lower_set (closure s))
+(is_open_upper_closure : ∀ s : set α, is_open s → is_open (upper_closure s : set α))
+(is_open_lower_closure : ∀ s : set α, is_open s → is_open (lower_closure s : set α))
+
+variables {α : Type*} [topological_space α]
+
+@[to_additive, priority 100] -- See note [lower instance priority]
+instance ordered_comm_group.to_has_upper_lower_closure [ordered_comm_group α]
+  [has_continuous_const_smul α α] : has_upper_lower_closure α :=
+{ is_upper_set_closure := λ s h x y hxy hx, closure_mono (h.smul_subset $ one_le_div'.2 hxy) $
+    by { rw closure_smul, exact ⟨x, hx, div_mul_cancel' _ _⟩ },
+  is_lower_set_closure := λ s h x y hxy hx, closure_mono (h.smul_subset $ div_le_one'.2 hxy) $
+    by { rw closure_smul, exact ⟨x, hx, div_mul_cancel' _ _⟩ },
+  is_open_upper_closure := λ s hs, by { rw [←mul_one s, ←mul_upper_closure], exact hs.mul_right },
+  is_open_lower_closure := λ s hs, by { rw [←mul_one s, ←mul_lower_closure], exact hs.mul_right } }
+
+variables [preorder α]
+
+section order_closed_topology
+variables [order_closed_topology α] {s : set α}
+
+@[simp] lemma upper_bounds_closure (s : set α) :
+  upper_bounds (closure s : set α) = upper_bounds s :=
+ext $ λ a, by simp_rw [mem_upper_bounds_iff_subset_Iic, is_closed_Iic.closure_subset_iff]
+
+@[simp] lemma lower_bounds_closure (s : set α) :
+  lower_bounds (closure s : set α) = lower_bounds s :=
+ext $ λ a, by simp_rw [mem_lower_bounds_iff_subset_Ici, is_closed_Ici.closure_subset_iff]
+
+@[simp] lemma bdd_above_closure : bdd_above (closure s) ↔ bdd_above s :=
+by simp_rw [bdd_above, upper_bounds_closure]
+
+@[simp] lemma bdd_below_closure : bdd_below (closure s) ↔ bdd_below s :=
+by simp_rw [bdd_below, lower_bounds_closure]
+
+alias bdd_above_closure ↔ bdd_above.of_closure bdd_above.closure
+alias bdd_below_closure ↔ bdd_below.of_closure bdd_below.closure
+
+attribute [protected] bdd_above.closure bdd_below.closure
+
+end order_closed_topology
+
+variables [has_upper_lower_closure α] {s : set α}
+
+protected lemma is_upper_set.closure : is_upper_set s → is_upper_set (closure s) :=
+has_upper_lower_closure.is_upper_set_closure _
+
+protected lemma is_lower_set.closure : is_lower_set s → is_lower_set (closure s) :=
+has_upper_lower_closure.is_lower_set_closure _
+
+protected lemma is_open.upper_closure : is_open s → is_open (upper_closure s : set α) :=
+has_upper_lower_closure.is_open_upper_closure _
+
+protected lemma is_open.lower_closure : is_open s → is_open (lower_closure s : set α) :=
+has_upper_lower_closure.is_open_lower_closure _
+
+instance : has_upper_lower_closure αᵒᵈ :=
+{ is_upper_set_closure := @is_lower_set.closure α _ _ _,
+  is_lower_set_closure := @is_upper_set.closure α _ _ _,
+  is_open_upper_closure := @is_open.lower_closure α _ _ _,
+  is_open_lower_closure := @is_open.upper_closure α _ _ _ }
+
+/-
+Note: `s.ord_connected` does not imply `(closure s).ord_connected`, as we can see by taking
+`s := Ioo 0 1 × Ioo 1 2 ∪ Ioo 2 3 × Ioo 0 1` because then
+`closure s = Icc 0 1 × Icc 1 2 ∪ Icc 2 3 × Icc 0 1` is not order-connected as
+`(1, 1) ∈ closure s`, `(2, 1) ∈ closure s` but `Icc (1, 1) (2, 1) ⊈ closure s`.
+
+`s` looks like
+```
+xxooooo
+xxooooo
+oooooxx
+oooooxx
+```
+-/
+
+protected lemma is_upper_set.interior (h : is_upper_set s) : is_upper_set (interior s) :=
+by { rw [←is_lower_set_compl, ←closure_compl], exact h.compl.closure }
+
+protected lemma is_lower_set.interior (h : is_lower_set s) : is_lower_set (interior s) :=
+h.to_dual.interior
+
+protected lemma set.ord_connected.interior (h : s.ord_connected) : (interior s).ord_connected :=
+begin
+  rw [←h.upper_closure_inter_lower_closure, interior_inter],
+  exact (upper_closure s).upper.interior.ord_connected.inter
+    (lower_closure s).lower.interior.ord_connected,
+end
diff --git a/src/topology/algebra/polynomial.lean b/src/topology/algebra/polynomial.lean
index 6e546ece1fd33..41202aaff5cda 100644
--- a/src/topology/algebra/polynomial.lean
+++ b/src/topology/algebra/polynomial.lean
@@ -3,13 +3,18 @@ Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-import analysis.normed_space.basic
 import data.polynomial.algebra_map
 import data.polynomial.inductions
+import data.polynomial.splits
+import ring_theory.polynomial.vieta
+import analysis.normed.field.basic
 
 /-!
 # Polynomials and limits
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the following lemmas.
 
 * `polynomial.continuous_eval₂: `polynomial.eval₂` defines a continuous function.
@@ -19,8 +24,8 @@ In this file we prove the following lemmas.
 * `polynomial.continuous`:  `polynomial.eval` defines a continuous functions;
   we also prove convenience lemmas `polynomial.continuous_at`, `polynomial.continuous_within_at`,
   `polynomial.continuous_on`.
-* `polynomial.tendsto_norm_at_top`: `λ x, ∥polynomial.eval (z x) p∥` tends to infinity provided that
-  `λ x, ∥z x∥` tends to infinity and `0 < degree p`;
+* `polynomial.tendsto_norm_at_top`: `λ x, ‖polynomial.eval (z x) p‖` tends to infinity provided that
+  `λ x, ‖z x‖` tends to infinity and `0 < degree p`;
 * `polynomial.tendsto_abv_eval₂_at_top`, `polynomial.tendsto_abv_at_top`,
   `polynomial.tendsto_abv_aeval_at_top`: a few versions of the previous statement for
   `is_absolute_value abv` instead of norm.
@@ -44,7 +49,7 @@ variables {R S : Type*} [semiring R] [topological_space R] [topological_semiring
 protected lemma continuous_eval₂ [semiring S] (p : S[X]) (f : S →+* R) :
   continuous (λ x, p.eval₂ f x) :=
 begin
-  dsimp only [eval₂_eq_sum, finsupp.sum],
+  simp only [eval₂_eq_sum, finsupp.sum],
   exact continuous_finset_sum _ (λ c hc, continuous_const.mul (continuous_pow _))
 end
 
@@ -119,14 +124,84 @@ tendsto_abv_eval₂_at_top _ abv p hd h₀ hz
 variables {α R : Type*} [normed_ring R] [is_absolute_value (norm : R → ℝ)]
 
 lemma tendsto_norm_at_top (p : R[X]) (h : 0 < degree p) {l : filter α} {z : α → R}
-  (hz : tendsto (λ x, ∥z x∥) l at_top) :
-  tendsto (λ x, ∥p.eval (z x)∥) l at_top :=
+  (hz : tendsto (λ x, ‖z x‖) l at_top) :
+  tendsto (λ x, ‖p.eval (z x)‖) l at_top :=
 p.tendsto_abv_at_top norm h hz
 
 lemma exists_forall_norm_le [proper_space R] (p : R[X]) :
-  ∃ x, ∀ y, ∥p.eval x∥ ≤ ∥p.eval y∥ :=
+  ∃ x, ∀ y, ‖p.eval x‖ ≤ ‖p.eval y‖ :=
 if hp0 : 0 < degree p
 then p.continuous.norm.exists_forall_le $ p.tendsto_norm_at_top hp0 tendsto_norm_cocompact_at_top
 else ⟨p.coeff 0, by rw [eq_C_of_degree_le_zero (le_of_not_gt hp0)]; simp⟩
 
+section roots
+
+open_locale polynomial nnreal
+
+variables {F K : Type*} [comm_ring F] [normed_field K]
+
+open multiset
+
+lemma eq_one_of_roots_le {p : F[X]} {f : F →+* K} {B : ℝ} (hB : B < 0)
+  (h1 : p.monic) (h2 : splits f p) (h3 : ∀ z ∈ (map f p).roots, ‖z‖ ≤ B) :
+  p = 1 :=
+h1.nat_degree_eq_zero_iff_eq_one.mp begin
+  contrapose !hB,
+  rw [← h1.nat_degree_map f, nat_degree_eq_card_roots' h2] at hB,
+  obtain ⟨z, hz⟩ := card_pos_iff_exists_mem.mp (zero_lt_iff.mpr hB),
+  exact le_trans (norm_nonneg _) (h3 z hz),
+end
+
+lemma coeff_le_of_roots_le {p : F[X]} {f : F →+* K} {B : ℝ} (i : ℕ)
+  (h1 : p.monic) (h2 : splits f p) (h3 : ∀ z ∈ (map f p).roots, ‖z‖ ≤ B) :
+  ‖ (map f p).coeff i ‖ ≤ B^(p.nat_degree - i) * p.nat_degree.choose i  :=
+begin
+  obtain hB | hB := lt_or_le B 0,
+  { rw [eq_one_of_roots_le hB h1 h2 h3, polynomial.map_one,
+      nat_degree_one, zero_tsub, pow_zero, one_mul, coeff_one],
+    split_ifs; norm_num [h] },
+  rw ← h1.nat_degree_map f,
+  obtain hi | hi := lt_or_le (map f p).nat_degree i,
+  { rw [coeff_eq_zero_of_nat_degree_lt hi, norm_zero], positivity },
+  rw [coeff_eq_esymm_roots_of_splits ((splits_id_iff_splits f).2 h2) hi,
+    (h1.map _).leading_coeff, one_mul, norm_mul, norm_pow, norm_neg, norm_one, one_pow, one_mul],
+  apply ((norm_multiset_sum_le _).trans $ sum_le_card_nsmul _ _ $ λ r hr, _).trans,
+  { rw [multiset.map_map, card_map, card_powerset_len,
+      ←nat_degree_eq_card_roots' h2, nat.choose_symm hi, mul_comm, nsmul_eq_mul] },
+  simp_rw multiset.mem_map at hr,
+  obtain ⟨_, ⟨s, hs, rfl⟩, rfl⟩ := hr,
+  rw mem_powerset_len at hs,
+  lift B to ℝ≥0 using hB,
+  rw [←coe_nnnorm, ←nnreal.coe_pow, nnreal.coe_le_coe,
+    ←nnnorm_hom_apply, ←monoid_hom.coe_coe, monoid_hom.map_multiset_prod],
+  refine (prod_le_pow_card _ B $ λ x hx, _).trans_eq (by rw [card_map, hs.2]),
+  obtain ⟨z, hz, rfl⟩ := multiset.mem_map.1 hx,
+  exact h3 z (mem_of_le hs.1 hz),
+end
+
+/-- The coefficients of the monic polynomials of bounded degree with bounded roots are
+uniformely bounded. -/
+lemma coeff_bdd_of_roots_le {B : ℝ} {d : ℕ} (f : F →+* K) {p : F[X]}
+  (h1 : p.monic) (h2 : splits f p) (h3 : p.nat_degree ≤ d) (h4 : ∀ z ∈ (map f p).roots, ‖z‖ ≤ B)
+  (i : ℕ) : ‖(map f p).coeff i‖ ≤ (max B 1) ^ d * d.choose (d / 2) :=
+begin
+  obtain hB | hB := le_or_lt 0 B,
+  { apply (coeff_le_of_roots_le i h1 h2 h4).trans,
+    calc
+    _   ≤ (max B 1) ^ (p.nat_degree - i) * (p.nat_degree.choose i)
+      : mul_le_mul_of_nonneg_right (pow_le_pow_of_le_left hB (le_max_left _ _) _) _
+    ... ≤ (max B 1) ^ d * (p.nat_degree.choose i)
+      : mul_le_mul_of_nonneg_right ((pow_mono (le_max_right _ _)) (le_trans (nat.sub_le _ _) h3)) _
+    ... ≤ (max B 1) ^ d * d.choose (d / 2)
+      : mul_le_mul_of_nonneg_left (nat.cast_le.mpr ((i.choose_mono h3).trans
+        (i.choose_le_middle d))) _,
+    all_goals { positivity, }},
+  { rw [eq_one_of_roots_le hB h1 h2 h4, polynomial.map_one, coeff_one],
+    refine trans _ (one_le_mul_of_one_le_of_one_le (one_le_pow_of_one_le (le_max_right B 1) d) _),
+    { split_ifs; norm_num, },
+    { exact_mod_cast nat.succ_le_iff.mpr (nat.choose_pos (d.div_le_self 2)), }},
+end
+
+end roots
+
 end polynomial
diff --git a/src/topology/algebra/ring.lean b/src/topology/algebra/ring.lean
deleted file mode 100644
index 2829810509d71..0000000000000
--- a/src/topology/algebra/ring.lean
+++ /dev/null
@@ -1,480 +0,0 @@
-/-
-Copyright (c) 2018 Patrick Massot. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Patrick Massot, Johannes Hölzl
--/
-import algebra.ring.prod
-import ring_theory.ideal.quotient
-import ring_theory.subring.basic
-import topology.algebra.group
-
-/-!
-
-# Topological (semi)rings
-
-A topological (semi)ring is a (semi)ring equipped with a topology such that all operations are
-continuous. Besides this definition, this file proves that the topological closure of a subring
-(resp. an ideal) is a subring (resp. an ideal) and defines products and quotients
-of topological (semi)rings.
-
-## Main Results
-
-- `subring.topological_closure`/`subsemiring.topological_closure`: the topological closure of a
-  `subring`/`subsemiring` is itself a `sub(semi)ring`.
-- `prod.topological_semiring`/`prod.topological_ring`: The product of two topological
-  (semi)rings.
-- `pi.topological_semiring`/`pi.topological_ring`: The arbitrary product of topological
-  (semi)rings.
-- `ideal.closure`: The closure of an ideal is an ideal.
-- `topological_ring_quotient`: The quotient of a topological semiring by an ideal is a
-  topological ring.
-
--/
-
-open classical set filter topological_space function
-open_locale classical topological_space filter
-
-section topological_semiring
-variables (α : Type*)
-
-/-- a topological semiring is a semiring `R` where addition and multiplication are continuous.
-We allow for non-unital and non-associative semirings as well.
-
-The `topological_semiring` class should *only* be instantiated in the presence of a
-`non_unital_non_assoc_semiring` instance; if there is an instance of `non_unital_non_assoc_ring`,
-then `topological_ring` should be used. Note: in the presence of `non_assoc_ring`, these classes are
-mathematically equivalent (see `topological_semiring.has_continuous_neg_of_mul` or
-`topological_semiring.to_topological_ring`).  -/
-class topological_semiring [topological_space α] [non_unital_non_assoc_semiring α]
-  extends has_continuous_add α, has_continuous_mul α : Prop
-
-/-- A topological ring is a ring `R` where addition, multiplication and negation are continuous.
-
-If `R` is a (unital) ring, then continuity of negation can be derived from continuity of
-multiplication as it is multiplication with `-1`. (See
-`topological_semiring.has_continuous_neg_of_mul` and
-`topological_semiring.to_topological_add_group`) -/
-class topological_ring [topological_space α] [non_unital_non_assoc_ring α]
-  extends topological_semiring α, has_continuous_neg α : Prop
-
-variables {α}
-
-/-- If `R` is a ring with a continuous multiplication, then negation is continuous as well since it
-is just multiplication with `-1`. -/
-lemma topological_semiring.has_continuous_neg_of_mul [topological_space α] [non_assoc_ring α]
-  [has_continuous_mul α] : has_continuous_neg α :=
-{ continuous_neg :=
-  by simpa using (continuous_const.mul continuous_id : continuous (λ x : α, (-1) * x)) }
-
-/-- If `R` is a ring which is a topological semiring, then it is automatically a topological
-ring. This exists so that one can place a topological ring structure on `R` without explicitly
-proving `continuous_neg`. -/
-lemma topological_semiring.to_topological_ring [topological_space α] [non_assoc_ring α]
-  (h : topological_semiring α) : topological_ring α :=
-{ ..h,
-  ..(by { haveI := h.to_has_continuous_mul,
-          exact topological_semiring.has_continuous_neg_of_mul } : has_continuous_neg α) }
-
-@[priority 100] -- See note [lower instance priority]
-instance topological_ring.to_topological_add_group [non_unital_non_assoc_ring α]
-  [topological_space α] [topological_ring α] : topological_add_group α :=
-{ ..topological_ring.to_topological_semiring.to_has_continuous_add,
-  ..topological_ring.to_has_continuous_neg }
-
-@[priority 50]
-instance discrete_topology.topological_semiring [topological_space α]
-  [non_unital_non_assoc_semiring α] [discrete_topology α] : topological_semiring α := ⟨⟩
-
-@[priority 50]
-instance discrete_topology.topological_ring [topological_space α]
-  [non_unital_non_assoc_ring α] [discrete_topology α] : topological_ring α := ⟨⟩
-
-section
-variables [topological_space α] [semiring α] [topological_semiring α]
-namespace subsemiring
-
-instance (S : subsemiring α) :
-  topological_semiring S :=
-{ ..S.to_submonoid.has_continuous_mul,
-  ..S.to_add_submonoid.has_continuous_add }
-
-end subsemiring
-
-/-- The (topological-space) closure of a subsemiring of a topological semiring is
-itself a subsemiring. -/
-def subsemiring.topological_closure (s : subsemiring α) : subsemiring α :=
-{ carrier := closure (s : set α),
-  ..(s.to_submonoid.topological_closure),
-  ..(s.to_add_submonoid.topological_closure ) }
-
-@[simp] lemma subsemiring.topological_closure_coe (s : subsemiring α) :
-  (s.topological_closure : set α) = closure (s : set α) :=
-rfl
-
-instance subsemiring.topological_closure_topological_semiring (s : subsemiring α) :
-  topological_semiring (s.topological_closure) :=
-{ ..s.to_add_submonoid.topological_closure_has_continuous_add,
-  ..s.to_submonoid.topological_closure_has_continuous_mul }
-
-lemma subsemiring.subring_topological_closure (s : subsemiring α) :
-  s ≤ s.topological_closure :=
-subset_closure
-
-lemma subsemiring.is_closed_topological_closure (s : subsemiring α) :
-  is_closed (s.topological_closure : set α) :=
-by convert is_closed_closure
-
-lemma subsemiring.topological_closure_minimal
-  (s : subsemiring α) {t : subsemiring α} (h : s ≤ t) (ht : is_closed (t : set α)) :
-  s.topological_closure ≤ t :=
-closure_minimal h ht
-
-/-- If a subsemiring of a topological semiring is commutative, then so is its
-topological closure. -/
-def subsemiring.comm_semiring_topological_closure [t2_space α] (s : subsemiring α)
-  (hs : ∀ (x y : s), x * y = y * x) : comm_semiring s.topological_closure :=
-{ ..s.topological_closure.to_semiring,
-  ..s.to_submonoid.comm_monoid_topological_closure hs }
-end
-
-section
-variables {β : Type*} [topological_space α] [topological_space β]
-
-/-- The product topology on the cartesian product of two topological semirings
-  makes the product into a topological semiring. -/
-instance [non_unital_non_assoc_semiring α] [non_unital_non_assoc_semiring β]
-  [topological_semiring α] [topological_semiring β] : topological_semiring (α × β) := {}
-
-/-- The product topology on the cartesian product of two topological rings
-  makes the product into a topological ring. -/
-instance [non_unital_non_assoc_ring α] [non_unital_non_assoc_ring β]
-  [topological_ring α] [topological_ring β] : topological_ring (α × β) := {}
-
-end
-
-instance {β : Type*} {C : β → Type*} [∀ b, topological_space (C b)]
-  [Π b, non_unital_non_assoc_semiring (C b)]
-  [Π b, topological_semiring (C b)] : topological_semiring (Π b, C b) := {}
-
-instance {β : Type*} {C : β → Type*} [∀ b, topological_space (C b)]
-  [Π b, non_unital_non_assoc_ring (C b)]
-  [Π b, topological_ring (C b)] : topological_ring (Π b, C b) := {}
-
-section mul_opposite
-open mul_opposite
-
-instance [non_unital_non_assoc_semiring α] [topological_space α] [has_continuous_add α] :
-  has_continuous_add αᵐᵒᵖ :=
-{ continuous_add := continuous_induced_rng $ (@continuous_add α _ _ _).comp
-  (continuous_unop.prod_map continuous_unop) }
-
-instance [non_unital_non_assoc_semiring α] [topological_space α] [topological_semiring α] :
-  topological_semiring αᵐᵒᵖ := {}
-
-instance [non_unital_non_assoc_ring α] [topological_space α] [has_continuous_neg α] :
-  has_continuous_neg αᵐᵒᵖ :=
-{ continuous_neg := continuous_induced_rng $ (@continuous_neg α _ _ _).comp continuous_unop }
-
-instance [non_unital_non_assoc_ring α] [topological_space α] [topological_ring α] :
-  topological_ring αᵐᵒᵖ := {}
-
-end mul_opposite
-
-section add_opposite
-open add_opposite
-
-instance [non_unital_non_assoc_semiring α] [topological_space α] [has_continuous_mul α] :
-  has_continuous_mul αᵃᵒᵖ :=
-{ continuous_mul := by convert
-  (continuous_op.comp $ (@continuous_mul α _ _ _).comp $ continuous_unop.prod_map continuous_unop) }
-
-instance [non_unital_non_assoc_semiring α] [topological_space α] [topological_semiring α] :
-  topological_semiring αᵃᵒᵖ := {}
-
-instance [non_unital_non_assoc_ring α] [topological_space α] [topological_ring α] :
-  topological_ring αᵃᵒᵖ := {}
-
-end add_opposite
-
-
-section
-variables {R : Type*} [non_unital_non_assoc_ring R] [topological_space R]
-
-lemma topological_ring.of_add_group_of_nhds_zero [topological_add_group R]
-  (hmul : tendsto (uncurry ((*) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) $ 𝓝 0)
-  (hmul_left : ∀ (x₀ : R), tendsto (λ x : R, x₀ * x) (𝓝 0) $ 𝓝 0)
-  (hmul_right : ∀ (x₀ : R), tendsto (λ x : R, x * x₀) (𝓝 0) $ 𝓝 0) : topological_ring R :=
-begin
-  refine {..‹topological_add_group R›, ..},
-  have hleft : ∀ x₀ : R, 𝓝 x₀ = map (λ x, x₀ + x) (𝓝 0), by simp,
-  have hadd : tendsto (uncurry ((+) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) (𝓝 0),
-  { rw ← nhds_prod_eq,
-    convert continuous_add.tendsto ((0 : R), (0 : R)),
-    rw zero_add },
-  rw continuous_iff_continuous_at,
-  rintro ⟨x₀, y₀⟩,
-  rw [continuous_at, nhds_prod_eq, hleft x₀, hleft y₀, hleft (x₀*y₀), filter.prod_map_map_eq,
-      tendsto_map'_iff],
-  suffices :
-    tendsto ((λ (x : R), x + x₀ * y₀) ∘ (λ (p : R × R), p.1 + p.2) ∘
-              (λ (p : R × R), (p.1*y₀ + x₀*p.2, p.1*p.2)))
-            ((𝓝 0) ×ᶠ (𝓝 0)) (map (λ (x : R), x + x₀ * y₀) $ 𝓝 0),
-  { convert this using 1,
-    { ext, simp only [comp_app, mul_add, add_mul], abel },
-    { simp only [add_comm] } },
-  refine tendsto_map.comp (hadd.comp (tendsto.prod_mk _ hmul)),
-  exact hadd.comp (((hmul_right y₀).comp tendsto_fst).prod_mk ((hmul_left  x₀).comp tendsto_snd))
-end
-
-lemma topological_ring.of_nhds_zero
-  (hadd : tendsto (uncurry ((+) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) $ 𝓝 0)
-  (hneg : tendsto (λ x, -x : R → R) (𝓝 0) (𝓝 0))
-  (hmul : tendsto (uncurry ((*) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) $ 𝓝 0)
-  (hmul_left : ∀ (x₀ : R), tendsto (λ x : R, x₀ * x) (𝓝 0) $ 𝓝 0)
-  (hmul_right : ∀ (x₀ : R), tendsto (λ x : R, x * x₀) (𝓝 0) $ 𝓝 0)
-  (hleft : ∀ x₀ : R, 𝓝 x₀ = map (λ x, x₀ + x) (𝓝 0)) : topological_ring R :=
-begin
-  haveI := topological_add_group.of_comm_of_nhds_zero hadd hneg hleft,
-  exact topological_ring.of_add_group_of_nhds_zero hmul hmul_left hmul_right
-end
-
-end
-
-variables {α} [topological_space α]
-
-section
-variables [non_unital_non_assoc_ring α] [topological_ring α]
-
-/-- In a topological semiring, the left-multiplication `add_monoid_hom` is continuous. -/
-lemma mul_left_continuous (x : α) : continuous (add_monoid_hom.mul_left x) :=
-continuous_const.mul continuous_id
-
-/-- In a topological semiring, the right-multiplication `add_monoid_hom` is continuous. -/
-lemma mul_right_continuous (x : α) : continuous (add_monoid_hom.mul_right x) :=
-continuous_id.mul continuous_const
-
-end
-
-variables [ring α] [topological_ring α]
-
-namespace subring
-
-instance (S : subring α) :
-  topological_ring S :=
-topological_semiring.to_topological_ring S.to_subsemiring.topological_semiring
-
-end subring
-
-/-- The (topological-space) closure of a subring of a topological ring is
-itself a subring. -/
-def subring.topological_closure (S : subring α) : subring α :=
-{ carrier := closure (S : set α),
-  ..S.to_submonoid.topological_closure,
-  ..S.to_add_subgroup.topological_closure }
-
-instance subring.topological_closure_topological_ring (s : subring α) :
-  topological_ring (s.topological_closure) :=
-{ ..s.to_add_subgroup.topological_closure_topological_add_group,
-  ..s.to_submonoid.topological_closure_has_continuous_mul }
-
-lemma subring.subring_topological_closure (s : subring α) :
-  s ≤ s.topological_closure := subset_closure
-
-lemma subring.is_closed_topological_closure (s : subring α) :
-  is_closed (s.topological_closure : set α) := by convert is_closed_closure
-
-lemma subring.topological_closure_minimal
-  (s : subring α) {t : subring α} (h : s ≤ t) (ht : is_closed (t : set α)) :
-  s.topological_closure ≤ t := closure_minimal h ht
-
-/-- If a subring of a topological ring is commutative, then so is its topological closure. -/
-def subring.comm_ring_topological_closure [t2_space α] (s : subring α)
-  (hs : ∀ (x y : s), x * y = y * x) : comm_ring s.topological_closure :=
-{ ..s.topological_closure.to_ring,
-  ..s.to_submonoid.comm_monoid_topological_closure hs }
-
-end topological_semiring
-
-section topological_comm_ring
-variables {α : Type*} [topological_space α] [comm_ring α] [topological_ring α]
-
-/-- The closure of an ideal in a topological ring as an ideal. -/
-def ideal.closure (S : ideal α) : ideal α :=
-{ carrier   := closure S,
-  smul_mem' := λ c x hx, map_mem_closure (mul_left_continuous _) hx $ λ a, S.mul_mem_left c,
-  ..(add_submonoid.topological_closure S.to_add_submonoid) }
-
-@[simp] lemma ideal.coe_closure (S : ideal α) : (S.closure : set α) = closure S := rfl
-
-end topological_comm_ring
-
-section topological_ring
-variables {α : Type*} [topological_space α] [comm_ring α] (N : ideal α)
-open ideal.quotient
-
-instance topological_ring_quotient_topology : topological_space (α ⧸ N) :=
-show topological_space (quotient _), by apply_instance
-
--- note for the reader: in the following, `mk` is `ideal.quotient.mk`, the canonical map `R → R/I`.
-
-variable [topological_ring α]
-
-lemma quotient_ring.is_open_map_coe : is_open_map (mk N) :=
-begin
-  intros s s_op,
-  change is_open (mk N ⁻¹' (mk N '' s)),
-  rw quotient_ring_saturate,
-  exact is_open_Union (λ ⟨n, _⟩, is_open_map_add_left n s s_op)
-end
-
-lemma quotient_ring.quotient_map_coe_coe : quotient_map (λ p : α × α, (mk N p.1, mk N p.2)) :=
-is_open_map.to_quotient_map
-((quotient_ring.is_open_map_coe N).prod (quotient_ring.is_open_map_coe N))
-((continuous_quot_mk.comp continuous_fst).prod_mk (continuous_quot_mk.comp continuous_snd))
-(by rintro ⟨⟨x⟩, ⟨y⟩⟩; exact ⟨(x, y), rfl⟩)
-
-instance topological_ring_quotient : topological_ring (α ⧸ N) :=
-topological_semiring.to_topological_ring
-{ continuous_add :=
-    have cont : continuous (mk N ∘ (λ (p : α × α), p.fst + p.snd)) :=
-      continuous_quot_mk.comp continuous_add,
-    (quotient_map.continuous_iff (quotient_ring.quotient_map_coe_coe N)).mpr cont,
-  continuous_mul :=
-    have cont : continuous (mk N ∘ (λ (p : α × α), p.fst * p.snd)) :=
-      continuous_quot_mk.comp continuous_mul,
-    (quotient_map.continuous_iff (quotient_ring.quotient_map_coe_coe N)).mpr cont }
-
-end topological_ring
-
-/-!
-### Lattice of ring topologies
-We define a type class `ring_topology α` which endows a ring `α` with a topology such that all ring
-operations are continuous.
-
-Ring topologies on a fixed ring `α` are ordered, by reverse inclusion. They form a complete lattice,
-with `⊥` the discrete topology and `⊤` the indiscrete topology.
-
-Any function `f : α → β` induces `coinduced f : topological_space α → ring_topology β`. -/
-
-universes u v
-
-/-- A ring topology on a ring `α` is a topology for which addition, negation and multiplication
-are continuous. -/
-@[ext]
-structure ring_topology (α : Type u) [ring α]
-  extends topological_space α, topological_ring α : Type u
-
-namespace ring_topology
-variables {α : Type*} [ring α]
-
-instance inhabited {α : Type u} [ring α] : inhabited (ring_topology α) :=
-⟨{to_topological_space := ⊤,
-  continuous_add       := continuous_top,
-  continuous_mul       := continuous_top,
-  continuous_neg       := continuous_top}⟩
-
-@[ext]
-lemma ext' {f g : ring_topology α} (h : f.is_open = g.is_open) : f = g :=
-by { ext, rw h }
-
-/-- The ordering on ring topologies on the ring `α`.
-  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
-instance : partial_order (ring_topology α) :=
-partial_order.lift ring_topology.to_topological_space $ ext
-
-local notation `cont` := @continuous _ _
-
-private def def_Inf (S : set (ring_topology α)) : ring_topology α :=
-let Inf_S' := Inf (to_topological_space '' S) in
-{ to_topological_space := Inf_S',
-  continuous_add       :=
-  begin
-    apply continuous_Inf_rng,
-    rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
-    have h := continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_id,
-    have h_continuous_id := @continuous.prod_map _ _ _ _ t t Inf_S' Inf_S' _ _ h h,
-    exact @continuous.comp _ _ _ (id _) (id _) t _ _ continuous_add h_continuous_id,
-  end,
-  continuous_mul       :=
-  begin
-    apply continuous_Inf_rng,
-    rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
-    have h := continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_id,
-    have h_continuous_id := @continuous.prod_map _ _ _ _ t t Inf_S' Inf_S' _ _ h h,
-    exact @continuous.comp _ _ _ (id _) (id _) t _ _ continuous_mul h_continuous_id,
-  end,
-  continuous_neg       :=
-  begin
-    apply continuous_Inf_rng,
-    rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
-    have h := continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_id,
-    exact @continuous.comp _ _ _ (id _) (id _) t _ _ continuous_neg h,
-  end }
-
-/-- Ring topologies on `α` form a complete lattice, with `⊥` the discrete topology and `⊤` the
-indiscrete topology.
-
-The infimum of a collection of ring topologies is the topology generated by all their open sets
-(which is a ring topology).
-
-The supremum of two ring topologies `s` and `t` is the infimum of the family of all ring topologies
-contained in the intersection of `s` and `t`. -/
-instance : complete_semilattice_Inf (ring_topology α) :=
-{ Inf    := def_Inf,
-  Inf_le := λ S a haS, by { apply topological_space.complete_lattice.Inf_le, use [a, ⟨ haS, rfl⟩] },
-  le_Inf :=
-  begin
-    intros S a hab,
-    apply topological_space.complete_lattice.le_Inf,
-    rintros _ ⟨b, hbS, rfl⟩,
-    exact hab b hbS,
-  end,
-  ..ring_topology.partial_order }
-
-instance : complete_lattice (ring_topology α) :=
-complete_lattice_of_complete_semilattice_Inf _
-
-/--  Given `f : α → β` and a topology on `α`, the coinduced ring topology on `β` is the finest
-topology such that `f` is continuous and `β` is a topological ring. -/
-def coinduced {α β : Type*} [t : topological_space α] [ring β] (f : α → β) :
-  ring_topology β :=
-Inf {b : ring_topology β | (topological_space.coinduced f t) ≤ b.to_topological_space}
-
-lemma coinduced_continuous {α β : Type*} [t : topological_space α] [ring β] (f : α → β) :
-  cont t (coinduced f).to_topological_space f :=
-begin
-  rw continuous_iff_coinduced_le,
-  refine le_Inf _,
-  rintros _ ⟨t', ht', rfl⟩,
-  exact ht',
-end
-
-/-- The forgetful functor from ring topologies on `a` to additive group topologies on `a`. -/
-def to_add_group_topology (t : ring_topology α) : add_group_topology α :=
-{ to_topological_space     := t.to_topological_space,
-  to_topological_add_group := @topological_ring.to_topological_add_group _ _ t.to_topological_space
-    t.to_topological_ring }
-
-/-- The order embedding from ring topologies on `a` to additive group topologies on `a`. -/
-def to_add_group_topology.order_embedding : order_embedding (ring_topology α)
-  (add_group_topology α) :=
-{ to_fun       := λ t, t.to_add_group_topology,
-  inj'         :=
-  begin
-    intros t₁ t₂ h_eq,
-    dsimp only at h_eq,
-    ext,
-    have h_t₁ : t₁.to_topological_space = t₁.to_add_group_topology.to_topological_space := rfl,
-    rw [h_t₁, h_eq],
-    refl,
-  end,
-  map_rel_iff' :=
-  begin
-    intros t₁ t₂,
-    rw [embedding.coe_fn_mk],
-    have h_le : t₁ ≤ t₂ ↔ t₁.to_topological_space ≤ t₂.to_topological_space := by refl,
-    rw h_le,
-    refl,
-  end }
-
-end ring_topology
diff --git a/src/topology/algebra/ring/basic.lean b/src/topology/algebra/ring/basic.lean
new file mode 100644
index 0000000000000..c3aa31b2889f2
--- /dev/null
+++ b/src/topology/algebra/ring/basic.lean
@@ -0,0 +1,416 @@
+/-
+Copyright (c) 2018 Patrick Massot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Johannes Hölzl
+-/
+import algebra.ring.prod
+import ring_theory.subring.basic
+import topology.algebra.group.basic
+
+/-!
+
+# Topological (semi)rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A topological (semi)ring is a (semi)ring equipped with a topology such that all operations are
+continuous. Besides this definition, this file proves that the topological closure of a subring
+(resp. an ideal) is a subring (resp. an ideal) and defines products and quotients
+of topological (semi)rings.
+
+## Main Results
+
+- `subring.topological_closure`/`subsemiring.topological_closure`: the topological closure of a
+  `subring`/`subsemiring` is itself a `sub(semi)ring`.
+- `prod.topological_semiring`/`prod.topological_ring`: The product of two topological
+  (semi)rings.
+- `pi.topological_semiring`/`pi.topological_ring`: The arbitrary product of topological
+  (semi)rings.
+
+-/
+
+open classical set filter topological_space function
+open_locale classical topology filter
+
+section topological_semiring
+variables (α : Type*)
+
+/-- a topological semiring is a semiring `R` where addition and multiplication are continuous.
+We allow for non-unital and non-associative semirings as well.
+
+The `topological_semiring` class should *only* be instantiated in the presence of a
+`non_unital_non_assoc_semiring` instance; if there is an instance of `non_unital_non_assoc_ring`,
+then `topological_ring` should be used. Note: in the presence of `non_assoc_ring`, these classes are
+mathematically equivalent (see `topological_semiring.has_continuous_neg_of_mul` or
+`topological_semiring.to_topological_ring`).  -/
+class topological_semiring [topological_space α] [non_unital_non_assoc_semiring α]
+  extends has_continuous_add α, has_continuous_mul α : Prop
+
+/-- A topological ring is a ring `R` where addition, multiplication and negation are continuous.
+
+If `R` is a (unital) ring, then continuity of negation can be derived from continuity of
+multiplication as it is multiplication with `-1`. (See
+`topological_semiring.has_continuous_neg_of_mul` and
+`topological_semiring.to_topological_add_group`) -/
+class topological_ring [topological_space α] [non_unital_non_assoc_ring α]
+  extends topological_semiring α, has_continuous_neg α : Prop
+
+variables {α}
+
+/-- If `R` is a ring with a continuous multiplication, then negation is continuous as well since it
+is just multiplication with `-1`. -/
+lemma topological_semiring.has_continuous_neg_of_mul [topological_space α] [non_assoc_ring α]
+  [has_continuous_mul α] : has_continuous_neg α :=
+{ continuous_neg :=
+  by simpa using (continuous_const.mul continuous_id : continuous (λ x : α, (-1) * x)) }
+
+/-- If `R` is a ring which is a topological semiring, then it is automatically a topological
+ring. This exists so that one can place a topological ring structure on `R` without explicitly
+proving `continuous_neg`. -/
+lemma topological_semiring.to_topological_ring [topological_space α] [non_assoc_ring α]
+  (h : topological_semiring α) : topological_ring α :=
+{ ..h,
+  ..(by { haveI := h.to_has_continuous_mul,
+          exact topological_semiring.has_continuous_neg_of_mul } : has_continuous_neg α) }
+
+@[priority 100] -- See note [lower instance priority]
+instance topological_ring.to_topological_add_group [non_unital_non_assoc_ring α]
+  [topological_space α] [topological_ring α] : topological_add_group α :=
+{ ..topological_ring.to_topological_semiring.to_has_continuous_add,
+  ..topological_ring.to_has_continuous_neg }
+
+@[priority 50]
+instance discrete_topology.topological_semiring [topological_space α]
+  [non_unital_non_assoc_semiring α] [discrete_topology α] : topological_semiring α := ⟨⟩
+
+@[priority 50]
+instance discrete_topology.topological_ring [topological_space α]
+  [non_unital_non_assoc_ring α] [discrete_topology α] : topological_ring α := ⟨⟩
+
+section
+variables [topological_space α] [semiring α] [topological_semiring α]
+namespace subsemiring
+
+instance (S : subsemiring α) :
+  topological_semiring S :=
+{ ..S.to_submonoid.has_continuous_mul,
+  ..S.to_add_submonoid.has_continuous_add }
+
+end subsemiring
+
+/-- The (topological-space) closure of a subsemiring of a topological semiring is
+itself a subsemiring. -/
+def subsemiring.topological_closure (s : subsemiring α) : subsemiring α :=
+{ carrier := closure (s : set α),
+  ..(s.to_submonoid.topological_closure),
+  ..(s.to_add_submonoid.topological_closure ) }
+
+@[simp] lemma subsemiring.topological_closure_coe (s : subsemiring α) :
+  (s.topological_closure : set α) = closure (s : set α) :=
+rfl
+
+lemma subsemiring.le_topological_closure (s : subsemiring α) :
+  s ≤ s.topological_closure :=
+subset_closure
+
+lemma subsemiring.is_closed_topological_closure (s : subsemiring α) :
+  is_closed (s.topological_closure : set α) :=
+by convert is_closed_closure
+
+lemma subsemiring.topological_closure_minimal
+  (s : subsemiring α) {t : subsemiring α} (h : s ≤ t) (ht : is_closed (t : set α)) :
+  s.topological_closure ≤ t :=
+closure_minimal h ht
+
+/-- If a subsemiring of a topological semiring is commutative, then so is its
+topological closure. -/
+def subsemiring.comm_semiring_topological_closure [t2_space α] (s : subsemiring α)
+  (hs : ∀ (x y : s), x * y = y * x) : comm_semiring s.topological_closure :=
+{ ..s.topological_closure.to_semiring,
+  ..s.to_submonoid.comm_monoid_topological_closure hs }
+end
+
+section
+variables {β : Type*} [topological_space α] [topological_space β]
+
+/-- The product topology on the cartesian product of two topological semirings
+  makes the product into a topological semiring. -/
+instance [non_unital_non_assoc_semiring α] [non_unital_non_assoc_semiring β]
+  [topological_semiring α] [topological_semiring β] : topological_semiring (α × β) := {}
+
+/-- The product topology on the cartesian product of two topological rings
+  makes the product into a topological ring. -/
+instance [non_unital_non_assoc_ring α] [non_unital_non_assoc_ring β]
+  [topological_ring α] [topological_ring β] : topological_ring (α × β) := {}
+
+end
+
+instance {β : Type*} {C : β → Type*} [∀ b, topological_space (C b)]
+  [Π b, non_unital_non_assoc_semiring (C b)]
+  [Π b, topological_semiring (C b)] : topological_semiring (Π b, C b) := {}
+
+instance {β : Type*} {C : β → Type*} [∀ b, topological_space (C b)]
+  [Π b, non_unital_non_assoc_ring (C b)]
+  [Π b, topological_ring (C b)] : topological_ring (Π b, C b) := {}
+
+section mul_opposite
+open mul_opposite
+
+instance [non_unital_non_assoc_semiring α] [topological_space α] [has_continuous_add α] :
+  has_continuous_add αᵐᵒᵖ :=
+{ continuous_add := continuous_induced_rng.2 $ (@continuous_add α _ _ _).comp
+  (continuous_unop.prod_map continuous_unop) }
+
+instance [non_unital_non_assoc_semiring α] [topological_space α] [topological_semiring α] :
+  topological_semiring αᵐᵒᵖ := {}
+
+instance [non_unital_non_assoc_ring α] [topological_space α] [has_continuous_neg α] :
+  has_continuous_neg αᵐᵒᵖ :=
+{ continuous_neg := continuous_induced_rng.2 $ (@continuous_neg α _ _ _).comp continuous_unop }
+
+instance [non_unital_non_assoc_ring α] [topological_space α] [topological_ring α] :
+  topological_ring αᵐᵒᵖ := {}
+
+end mul_opposite
+
+section add_opposite
+open add_opposite
+
+instance [non_unital_non_assoc_semiring α] [topological_space α] [has_continuous_mul α] :
+  has_continuous_mul αᵃᵒᵖ :=
+{ continuous_mul := by convert
+  (continuous_op.comp $ (@continuous_mul α _ _ _).comp $ continuous_unop.prod_map continuous_unop) }
+
+instance [non_unital_non_assoc_semiring α] [topological_space α] [topological_semiring α] :
+  topological_semiring αᵃᵒᵖ := {}
+
+instance [non_unital_non_assoc_ring α] [topological_space α] [topological_ring α] :
+  topological_ring αᵃᵒᵖ := {}
+
+end add_opposite
+
+
+section
+variables {R : Type*} [non_unital_non_assoc_ring R] [topological_space R]
+
+lemma topological_ring.of_add_group_of_nhds_zero [topological_add_group R]
+  (hmul : tendsto (uncurry ((*) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) $ 𝓝 0)
+  (hmul_left : ∀ (x₀ : R), tendsto (λ x : R, x₀ * x) (𝓝 0) $ 𝓝 0)
+  (hmul_right : ∀ (x₀ : R), tendsto (λ x : R, x * x₀) (𝓝 0) $ 𝓝 0) : topological_ring R :=
+begin
+  refine {..‹topological_add_group R›, ..},
+  have hleft : ∀ x₀ : R, 𝓝 x₀ = map (λ x, x₀ + x) (𝓝 0), by simp,
+  have hadd : tendsto (uncurry ((+) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) (𝓝 0),
+  { rw ← nhds_prod_eq,
+    convert continuous_add.tendsto ((0 : R), (0 : R)),
+    rw zero_add },
+  rw continuous_iff_continuous_at,
+  rintro ⟨x₀, y₀⟩,
+  rw [continuous_at, nhds_prod_eq, hleft x₀, hleft y₀, hleft (x₀*y₀), filter.prod_map_map_eq,
+      tendsto_map'_iff],
+  suffices :
+    tendsto ((λ (x : R), x + x₀ * y₀) ∘ (λ (p : R × R), p.1 + p.2) ∘
+              (λ (p : R × R), (p.1*y₀ + x₀*p.2, p.1*p.2)))
+            ((𝓝 0) ×ᶠ (𝓝 0)) (map (λ (x : R), x + x₀ * y₀) $ 𝓝 0),
+  { convert this using 1,
+    { ext, simp only [comp_app, mul_add, add_mul], abel },
+    { simp only [add_comm] } },
+  refine tendsto_map.comp (hadd.comp (tendsto.prod_mk _ hmul)),
+  exact hadd.comp (((hmul_right y₀).comp tendsto_fst).prod_mk ((hmul_left  x₀).comp tendsto_snd))
+end
+
+lemma topological_ring.of_nhds_zero
+  (hadd : tendsto (uncurry ((+) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) $ 𝓝 0)
+  (hneg : tendsto (λ x, -x : R → R) (𝓝 0) (𝓝 0))
+  (hmul : tendsto (uncurry ((*) : R → R → R)) ((𝓝 0) ×ᶠ (𝓝 0)) $ 𝓝 0)
+  (hmul_left : ∀ (x₀ : R), tendsto (λ x : R, x₀ * x) (𝓝 0) $ 𝓝 0)
+  (hmul_right : ∀ (x₀ : R), tendsto (λ x : R, x * x₀) (𝓝 0) $ 𝓝 0)
+  (hleft : ∀ x₀ : R, 𝓝 x₀ = map (λ x, x₀ + x) (𝓝 0)) : topological_ring R :=
+begin
+  haveI := topological_add_group.of_comm_of_nhds_zero hadd hneg hleft,
+  exact topological_ring.of_add_group_of_nhds_zero hmul hmul_left hmul_right
+end
+
+end
+
+variables {α} [topological_space α]
+
+section
+variables [non_unital_non_assoc_ring α] [topological_ring α]
+
+/-- In a topological semiring, the left-multiplication `add_monoid_hom` is continuous. -/
+lemma mul_left_continuous (x : α) : continuous (add_monoid_hom.mul_left x) :=
+continuous_const.mul continuous_id
+
+/-- In a topological semiring, the right-multiplication `add_monoid_hom` is continuous. -/
+lemma mul_right_continuous (x : α) : continuous (add_monoid_hom.mul_right x) :=
+continuous_id.mul continuous_const
+
+end
+
+variables [ring α] [topological_ring α]
+
+namespace subring
+
+instance (S : subring α) :
+  topological_ring S :=
+topological_semiring.to_topological_ring S.to_subsemiring.topological_semiring
+
+end subring
+
+/-- The (topological-space) closure of a subring of a topological ring is
+itself a subring. -/
+def subring.topological_closure (S : subring α) : subring α :=
+{ carrier := closure (S : set α),
+  ..S.to_submonoid.topological_closure,
+  ..S.to_add_subgroup.topological_closure }
+
+lemma subring.le_topological_closure (s : subring α) :
+  s ≤ s.topological_closure := subset_closure
+
+lemma subring.is_closed_topological_closure (s : subring α) :
+  is_closed (s.topological_closure : set α) := by convert is_closed_closure
+
+lemma subring.topological_closure_minimal
+  (s : subring α) {t : subring α} (h : s ≤ t) (ht : is_closed (t : set α)) :
+  s.topological_closure ≤ t := closure_minimal h ht
+
+/-- If a subring of a topological ring is commutative, then so is its topological closure. -/
+def subring.comm_ring_topological_closure [t2_space α] (s : subring α)
+  (hs : ∀ (x y : s), x * y = y * x) : comm_ring s.topological_closure :=
+{ ..s.topological_closure.to_ring,
+  ..s.to_submonoid.comm_monoid_topological_closure hs }
+
+end topological_semiring
+
+/-!
+### Lattice of ring topologies
+We define a type class `ring_topology α` which endows a ring `α` with a topology such that all ring
+operations are continuous.
+
+Ring topologies on a fixed ring `α` are ordered, by reverse inclusion. They form a complete lattice,
+with `⊥` the discrete topology and `⊤` the indiscrete topology.
+
+Any function `f : α → β` induces `coinduced f : topological_space α → ring_topology β`. -/
+
+universes u v
+
+/-- A ring topology on a ring `α` is a topology for which addition, negation and multiplication
+are continuous. -/
+@[ext]
+structure ring_topology (α : Type u) [ring α]
+  extends topological_space α, topological_ring α : Type u
+
+namespace ring_topology
+variables {α : Type*} [ring α]
+
+instance inhabited {α : Type u} [ring α] : inhabited (ring_topology α) :=
+⟨{to_topological_space := ⊤,
+  continuous_add       := continuous_top,
+  continuous_mul       := continuous_top,
+  continuous_neg       := continuous_top}⟩
+
+@[ext]
+lemma ext' {f g : ring_topology α} (h : f.is_open = g.is_open) : f = g :=
+by { ext : 2, exact h }
+
+/-- The ordering on ring topologies on the ring `α`.
+  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
+instance : partial_order (ring_topology α) :=
+partial_order.lift ring_topology.to_topological_space $ ext
+
+local notation `cont` := @continuous _ _
+
+private def def_Inf (S : set (ring_topology α)) : ring_topology α :=
+let Inf_S' := Inf (to_topological_space '' S) in
+{ to_topological_space := Inf_S',
+  continuous_add       :=
+  begin
+    apply continuous_Inf_rng.2,
+    rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
+    have h := continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_id,
+    have h_continuous_id := @continuous.prod_map _ _ _ _ t t Inf_S' Inf_S' _ _ h h,
+    exact @continuous.comp _ _ _ (id _) (id _) t _ _ continuous_add h_continuous_id,
+  end,
+  continuous_mul       :=
+  begin
+    apply continuous_Inf_rng.2,
+    rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
+    have h := continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_id,
+    have h_continuous_id := @continuous.prod_map _ _ _ _ t t Inf_S' Inf_S' _ _ h h,
+    exact @continuous.comp _ _ _ (id _) (id _) t _ _ continuous_mul h_continuous_id,
+  end,
+  continuous_neg       :=
+  begin
+    apply continuous_Inf_rng.2,
+    rintros _ ⟨⟨t, tr⟩, haS, rfl⟩, resetI,
+    have h := continuous_Inf_dom (set.mem_image_of_mem to_topological_space haS) continuous_id,
+    exact @continuous.comp _ _ _ (id _) (id _) t _ _ continuous_neg h,
+  end }
+
+/-- Ring topologies on `α` form a complete lattice, with `⊥` the discrete topology and `⊤` the
+indiscrete topology.
+
+The infimum of a collection of ring topologies is the topology generated by all their open sets
+(which is a ring topology).
+
+The supremum of two ring topologies `s` and `t` is the infimum of the family of all ring topologies
+contained in the intersection of `s` and `t`. -/
+instance : complete_semilattice_Inf (ring_topology α) :=
+{ Inf    := def_Inf,
+  Inf_le := λ S a haS, by { apply topological_space.complete_lattice.Inf_le, use [a, ⟨ haS, rfl⟩] },
+  le_Inf :=
+  begin
+    intros S a hab,
+    apply topological_space.complete_lattice.le_Inf,
+    rintros _ ⟨b, hbS, rfl⟩,
+    exact hab b hbS,
+  end,
+  ..ring_topology.partial_order }
+
+instance : complete_lattice (ring_topology α) :=
+complete_lattice_of_complete_semilattice_Inf _
+
+/--  Given `f : α → β` and a topology on `α`, the coinduced ring topology on `β` is the finest
+topology such that `f` is continuous and `β` is a topological ring. -/
+def coinduced {α β : Type*} [t : topological_space α] [ring β] (f : α → β) :
+  ring_topology β :=
+Inf {b : ring_topology β | (topological_space.coinduced f t) ≤ b.to_topological_space}
+
+lemma coinduced_continuous {α β : Type*} [t : topological_space α] [ring β] (f : α → β) :
+  cont t (coinduced f).to_topological_space f :=
+begin
+  rw continuous_iff_coinduced_le,
+  refine le_Inf _,
+  rintros _ ⟨t', ht', rfl⟩,
+  exact ht',
+end
+
+/-- The forgetful functor from ring topologies on `a` to additive group topologies on `a`. -/
+def to_add_group_topology (t : ring_topology α) : add_group_topology α :=
+{ to_topological_space     := t.to_topological_space,
+  to_topological_add_group := @topological_ring.to_topological_add_group _ _ t.to_topological_space
+    t.to_topological_ring }
+
+/-- The order embedding from ring topologies on `a` to additive group topologies on `a`. -/
+def to_add_group_topology.order_embedding : order_embedding (ring_topology α)
+  (add_group_topology α) :=
+order_embedding.of_map_le_iff to_add_group_topology $ λ _ _, iff.rfl
+
+end ring_topology
+
+section absolute_value
+
+/-- Construct an absolute value on a semiring `T` from an absolute value on a semiring `R`
+and an injective ring homomorphism `f : T →+* R` -/
+def absolute_value.comp {R S T : Type*} [semiring T] [semiring R] [ordered_semiring S]
+  (v : absolute_value R S) {f : T →+* R} (hf : function.injective f)  :
+  absolute_value T S :=
+{ to_fun := v ∘ f,
+  map_mul' := by simp only [function.comp_app, map_mul, eq_self_iff_true, forall_const],
+  nonneg' := by simp only [v.nonneg, forall_const],
+  eq_zero' := by simp only [map_eq_zero_iff f hf, v.eq_zero, forall_const, iff_self],
+  add_le' := by simp only [function.comp_app, map_add, v.add_le, forall_const], }
+
+end absolute_value
diff --git a/src/topology/algebra/ring/ideal.lean b/src/topology/algebra/ring/ideal.lean
new file mode 100644
index 0000000000000..a39462b874272
--- /dev/null
+++ b/src/topology/algebra/ring/ideal.lean
@@ -0,0 +1,72 @@
+/-
+Copyright (c) 2018 Patrick Massot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot
+-/
+import topology.algebra.ring.basic
+import ring_theory.ideal.quotient
+/-!
+# Ideals and quotients of topological rings
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define `ideal.closure` to be the topological closure of an ideal in a topological
+ring. We also define a `topological_space` structure on the quotient of a topological ring by an
+ideal and prove that the quotient is a topological ring.
+-/
+
+section ring
+variables {R : Type*} [topological_space R] [ring R] [topological_ring R]
+
+/-- The closure of an ideal in a topological ring as an ideal. -/
+protected def ideal.closure (I : ideal R) : ideal R :=
+{ carrier   := closure I,
+  smul_mem' := λ c x hx, map_mem_closure (mul_left_continuous _) hx $ λ a, I.mul_mem_left c,
+  ..(add_submonoid.topological_closure I.to_add_submonoid) }
+
+@[simp] lemma ideal.coe_closure (I : ideal R) : (I.closure : set R) = closure I := rfl
+
+@[simp] lemma ideal.closure_eq_of_is_closed (I : ideal R) [hI : is_closed (I : set R)] :
+  I.closure = I :=
+set_like.ext' hI.closure_eq
+
+end ring
+
+section comm_ring
+variables {R : Type*} [topological_space R] [comm_ring R] (N : ideal R)
+open ideal.quotient
+
+instance topological_ring_quotient_topology : topological_space (R ⧸ N) :=
+quotient.topological_space
+
+-- note for the reader: in the following, `mk` is `ideal.quotient.mk`, the canonical map `R → R/I`.
+
+variable [topological_ring R]
+
+lemma quotient_ring.is_open_map_coe : is_open_map (mk N) :=
+begin
+  intros s s_op,
+  change is_open (mk N ⁻¹' (mk N '' s)),
+  rw quotient_ring_saturate,
+  exact is_open_Union (λ ⟨n, _⟩, is_open_map_add_left n s s_op)
+end
+
+lemma quotient_ring.quotient_map_coe_coe : quotient_map (λ p : R × R, (mk N p.1, mk N p.2)) :=
+is_open_map.to_quotient_map
+((quotient_ring.is_open_map_coe N).prod (quotient_ring.is_open_map_coe N))
+((continuous_quot_mk.comp continuous_fst).prod_mk (continuous_quot_mk.comp continuous_snd))
+(by rintro ⟨⟨x⟩, ⟨y⟩⟩; exact ⟨(x, y), rfl⟩)
+
+instance topological_ring_quotient : topological_ring (R ⧸ N) :=
+topological_semiring.to_topological_ring
+{ continuous_add :=
+    have cont : continuous (mk N ∘ (λ (p : R × R), p.fst + p.snd)) :=
+      continuous_quot_mk.comp continuous_add,
+    (quotient_map.continuous_iff (quotient_ring.quotient_map_coe_coe N)).mpr cont,
+  continuous_mul :=
+    have cont : continuous (mk N ∘ (λ (p : R × R), p.fst * p.snd)) :=
+      continuous_quot_mk.comp continuous_mul,
+    (quotient_map.continuous_iff (quotient_ring.quotient_map_coe_coe N)).mpr cont }
+
+end comm_ring
diff --git a/src/topology/algebra/semigroup.lean b/src/topology/algebra/semigroup.lean
index 6a4a57e05d025..c5ebed196f392 100644
--- a/src/topology/algebra/semigroup.lean
+++ b/src/topology/algebra/semigroup.lean
@@ -8,6 +8,9 @@ import topology.separation
 /-!
 # Idempotents in topological semigroups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file provides a sufficient condition for a semigroup `M` to contain an idempotent (i.e. an
 element `m` such that `m * m = m `), namely that `M` is a nonempty compact Hausdorff space where
 right-multiplication by constants is continuous.
@@ -25,50 +28,43 @@ lemma exists_idempotent_of_compact_t2_of_continuous_mul_left {M} [nonempty M] [s
 begin
 /- We apply Zorn's lemma to the poset of nonempty closed subsemigroups of `M`. It will turn out that
 any minimal element is `{m}` for an idempotent `m : M`. -/
-  let S : set (set M) := { N : set M | is_closed N ∧ N.nonempty ∧ ∀ m m' ∈ N, m * m' ∈ N },
-  suffices : ∃ N ∈ S, ∀ N' ∈ S, N' ⊆ N → N' = N,
-  { rcases this with ⟨N, ⟨N_closed, ⟨m, hm⟩, N_mul⟩, N_minimal⟩,
-    use m,
+  let S : set (set M) := {N | is_closed N ∧ N.nonempty ∧ ∀ m m' ∈ N, m * m' ∈ N},
+  rsuffices ⟨N, ⟨N_closed, ⟨m, hm⟩, N_mul⟩, N_minimal⟩ : ∃ N ∈ S, ∀ N' ∈ S, N' ⊆ N → N' = N,
+  { use m,
 /- We now have an element `m : M` of a minimal subsemigroup `N`, and want to show `m + m = m`.
 We first show that every element of `N` is of the form `m' + m`.-/
     have scaling_eq_self : (* m) '' N = N,
     { apply N_minimal,
-      { refine ⟨(continuous_mul_left m).is_closed_map _ N_closed,
-          ⟨_, ⟨m, hm, rfl⟩⟩, _⟩,
+      { refine ⟨(continuous_mul_left m).is_closed_map _ N_closed, ⟨_, ⟨m, hm, rfl⟩⟩, _⟩,
         rintros _ ⟨m'', hm'', rfl⟩ _ ⟨m', hm', rfl⟩,
-        refine ⟨m'' * m * m', N_mul _ (N_mul _ hm'' _ hm) _ hm', mul_assoc _ _ _⟩, },
+        refine ⟨m'' * m * m', N_mul _ (N_mul _ hm'' _ hm) _ hm', mul_assoc _ _ _⟩ },
       { rintros _ ⟨m', hm', rfl⟩,
-        exact N_mul _ hm' _ hm, }, },
+        exact N_mul _ hm' _ hm } },
 /- In particular, this means that `m' * m = m` for some `m'`. We now use minimality again to show
-that this holds for _all_ `m' ∈ N`. -/
-    have absorbing_eq_self : N ∩ { m' | m' * m = m} = N,
+that this holds for all `m' ∈ N`. -/
+    have absorbing_eq_self : N ∩ {m' | m' * m = m} = N,
     { apply N_minimal,
       { refine ⟨N_closed.inter ((t1_space.t1 m).preimage (continuous_mul_left m)), _, _⟩,
-        { rw ←scaling_eq_self at hm, exact hm },
+        { rwa ←scaling_eq_self at hm },
         { rintros m'' ⟨mem'', eq'' : _ = m⟩ m' ⟨mem', eq' : _ = m⟩,
           refine ⟨N_mul _ mem'' _ mem', _⟩,
-          rw [set.mem_set_of_eq, mul_assoc, eq', eq''], }, },
-      apply set.inter_subset_left, },
+          rw [set.mem_set_of_eq, mul_assoc, eq', eq''] } },
+      apply set.inter_subset_left },
 /- Thus `m * m = m` as desired. -/
     rw ←absorbing_eq_self at hm,
-    exact hm.2, },
-  apply zorn_superset,
-  intros c hcs hc,
-  refine ⟨⋂₀ c, ⟨is_closed_sInter $ λ t ht, (hcs ht).1, _, _⟩, _⟩,
+    exact hm.2 },
+  refine zorn_superset _ (λ c hcs hc, _),
+  refine ⟨⋂₀ c, ⟨is_closed_sInter $ λ t ht, (hcs ht).1, _, λ m hm m' hm', _⟩,
+    λ s hs, set.sInter_subset_of_mem hs⟩,
   { obtain rfl | hcnemp := c.eq_empty_or_nonempty,
-    { rw set.sInter_empty, apply set.univ_nonempty, },
-    convert @is_compact.nonempty_Inter_of_directed_nonempty_compact_closed _ _ _
-      (c.nonempty_coe_sort.mpr hcnemp) (coe : c → set M) _ _ _ _,
+    { rw set.sInter_empty, apply set.univ_nonempty },
+    convert @is_compact.nonempty_Inter_of_directed_nonempty_compact_closed _ _ _ hcnemp.coe_sort
+      (coe : c → set M) _ _ _ _,
     { simp only [subtype.range_coe_subtype, set.set_of_mem_eq] } ,
     { refine directed_on.directed_coe (is_chain.directed_on hc.symm) },
-    { intro i, exact (hcs i.property).2.1, },
-    { intro i, exact (hcs i.property).1.is_compact, },
-    { intro i, exact (hcs i.property).1, }, },
-  { intros m hm m' hm',
-    rw set.mem_sInter,
-    intros t ht,
-    exact (hcs ht).2.2 m (set.mem_sInter.mp hm t ht) m' (set.mem_sInter.mp hm' t ht) },
-  { intros s hs, exact set.sInter_subset_of_mem hs, },
+    exacts [λ i, (hcs i.prop).2.1, λ i, (hcs i.prop).1.is_compact, λ i, (hcs i.prop).1] },
+  { rw set.mem_sInter,
+    exact λ t ht, (hcs ht).2.2 m (set.mem_sInter.mp hm t ht) m' (set.mem_sInter.mp hm' t ht) },
 end
 
 /-- A version of `exists_idempotent_of_compact_t2_of_continuous_mul_left` where the idempotent lies
@@ -81,14 +77,14 @@ lemma exists_idempotent_in_compact_subsemigroup {M} [semigroup M] [topological_s
   (s : set M) (snemp : s.nonempty) (s_compact : is_compact s) (s_add : ∀ x y ∈ s, x * y ∈ s) :
   ∃ m ∈ s, m * m = m :=
 begin
-  let M' := { m // m ∈ s },
+  let M' := {m // m ∈ s},
   letI : semigroup M' :=
     { mul       := λ p q, ⟨p.1 * q.1, s_add _ p.2 _ q.2⟩,
       mul_assoc := λ p q r, subtype.eq (mul_assoc _ _ _) },
   haveI : compact_space M' := is_compact_iff_compact_space.mp s_compact,
   haveI : nonempty M' := nonempty_subtype.mpr snemp,
-  have : ∀ p : M', continuous (* p) := λ p, continuous_subtype_mk _
-    ((continuous_mul_left p.1).comp continuous_subtype_val),
+  have : ∀ p : M', continuous (* p) := λ p,
+    ((continuous_mul_left p.1).comp continuous_subtype_val).subtype_mk _,
   obtain ⟨⟨m, hm⟩, idem⟩ := exists_idempotent_of_compact_t2_of_continuous_mul_left this,
-  exact ⟨m, hm, subtype.ext_iff.mp idem⟩,
+  exact ⟨m, hm, subtype.ext_iff.mp idem⟩
 end
diff --git a/src/topology/algebra/star.lean b/src/topology/algebra/star.lean
index f8717f9ed951c..d05c702d09460 100644
--- a/src/topology/algebra/star.lean
+++ b/src/topology/algebra/star.lean
@@ -5,17 +5,21 @@ Authors: Eric Wieser
 -/
 import algebra.star.pi
 import algebra.star.prod
-import topology.algebra.group
+import topology.algebra.constructions
+import topology.continuous_function.basic
 
 /-!
 # Continuity of `star`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the `has_continuous_star` typeclass, along with instances on `pi`, `prod`,
 `mul_opposite`, and `units`.
 -/
 
 
-open_locale filter topological_space
+open_locale filter topology
 open filter
 
 universes u
@@ -64,6 +68,9 @@ lemma continuous_within_at.star (hf : continuous_within_at f s x) :
   continuous_within_at (λ x, star (f x)) s x :=
 hf.star
 
+/-- The star operation bundled as a continuous map. -/
+@[simps] def star_continuous_map : C(R, R) := ⟨star, continuous_star⟩
+
 end continuity
 
 section instances
@@ -81,6 +88,6 @@ instance [has_star R] [topological_space R] [has_continuous_star R] : has_contin
 
 instance [monoid R] [star_semigroup R] [topological_space R] [has_continuous_star R] :
   has_continuous_star Rˣ :=
-⟨continuous_induced_rng units.continuous_embed_product.star⟩
+⟨continuous_induced_rng.2 units.continuous_embed_product.star⟩
 
 end instances
diff --git a/src/topology/algebra/star_subalgebra.lean b/src/topology/algebra/star_subalgebra.lean
new file mode 100644
index 0000000000000..241c1da3132bd
--- /dev/null
+++ b/src/topology/algebra/star_subalgebra.lean
@@ -0,0 +1,212 @@
+/-
+Copyright (c) 2022 Jireh Loreaux. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jireh Loreaux
+-/
+import algebra.star.subalgebra
+import topology.algebra.algebra
+import topology.algebra.star
+
+/-!
+# Topological star (sub)algebras
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A topological star algebra over a topological semiring `R` is a topological semiring with a
+compatible continuous scalar multiplication by elements of `R` and a continuous star operation.
+We reuse typeclass `has_continuous_smul` for topological algebras.
+
+## Results
+
+This is just a minimal stub for now!
+
+The topological closure of a star subalgebra is still a star subalgebra,
+which as a star algebra is a topological star algebra.
+-/
+
+open classical set topological_space
+open_locale classical
+
+namespace star_subalgebra
+
+section topological_star_algebra
+variables {R A B : Type*} [comm_semiring R] [star_ring R]
+variables [topological_space A] [semiring A] [algebra R A] [star_ring A] [star_module R A]
+
+instance [topological_space R] [has_continuous_smul R A] (s : star_subalgebra R A) :
+  has_continuous_smul R s :=
+s.to_subalgebra.has_continuous_smul
+
+instance [topological_semiring A] (s : star_subalgebra R A) : topological_semiring s :=
+s.to_subalgebra.topological_semiring
+
+/-- The `star_subalgebra.inclusion` of a star subalgebra is an `embedding`. -/
+lemma embedding_inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂) :
+  embedding (inclusion h) :=
+{ induced := eq.symm induced_compose,
+  inj := subtype.map_injective h function.injective_id }
+
+/-- The `star_subalgebra.inclusion` of a closed star subalgebra is a `closed_embedding`. -/
+lemma closed_embedding_inclusion {S₁ S₂ : star_subalgebra R A} (h : S₁ ≤ S₂)
+  (hS₁ : is_closed (S₁ : set A)) :
+  closed_embedding (inclusion h) :=
+{ closed_range := is_closed_induced_iff.2
+    ⟨S₁, hS₁, by { convert (set.range_subtype_map id _).symm, rw set.image_id, refl }⟩,
+  .. embedding_inclusion h }
+
+variables [topological_semiring A] [has_continuous_star A]
+variables [topological_space B] [semiring B] [algebra R B] [star_ring B
+]
+/-- The closure of a star subalgebra in a topological star algebra as a star subalgebra. -/
+def topological_closure (s : star_subalgebra R A) :
+  star_subalgebra R A :=
+{ carrier := closure (s : set A),
+  star_mem' := λ a ha, map_mem_closure continuous_star ha (λ x, (star_mem : x ∈ s → star x ∈ s)),
+  .. s.to_subalgebra.topological_closure }
+
+@[simp] lemma topological_closure_coe (s : star_subalgebra R A) :
+  (s.topological_closure : set A) = closure (s : set A) :=
+rfl
+
+lemma le_topological_closure (s : star_subalgebra R A) : s ≤ s.topological_closure :=
+subset_closure
+
+lemma is_closed_topological_closure (s : star_subalgebra R A) :
+  is_closed (s.topological_closure : set A) :=
+is_closed_closure
+
+instance {A : Type*} [uniform_space A] [complete_space A] [semiring A] [star_ring A]
+  [topological_semiring A] [has_continuous_star A] [algebra R A] [star_module R A]
+  {S : star_subalgebra R A} : complete_space S.topological_closure :=
+is_closed_closure.complete_space_coe
+
+lemma topological_closure_minimal {s t : star_subalgebra R A} (h : s ≤ t)
+  (ht : is_closed (t : set A)) : s.topological_closure ≤ t :=
+closure_minimal h ht
+
+lemma topological_closure_mono : monotone (topological_closure : _ → star_subalgebra R A) :=
+λ S₁ S₂ h, topological_closure_minimal (h.trans $ le_topological_closure S₂)
+  (is_closed_topological_closure S₂)
+
+/-- If a star subalgebra of a topological star algebra is commutative, then so is its topological
+closure. See note [reducible non-instances]. -/
+@[reducible]
+def comm_semiring_topological_closure [t2_space A] (s : star_subalgebra R A)
+  (hs : ∀ (x y : s), x * y = y * x) : comm_semiring s.topological_closure :=
+s.to_subalgebra.comm_semiring_topological_closure hs
+
+/-- If a star subalgebra of a topological star algebra is commutative, then so is its topological
+closure. See note [reducible non-instances]. -/
+@[reducible]
+def comm_ring_topological_closure {R A} [comm_ring R] [star_ring R] [topological_space A] [ring A]
+  [algebra R A] [star_ring A] [star_module R A] [topological_ring A] [has_continuous_star A]
+  [t2_space A] (s : star_subalgebra R A) (hs : ∀ (x y : s), x * y = y * x) :
+  comm_ring s.topological_closure :=
+s.to_subalgebra.comm_ring_topological_closure hs
+
+/-- Continuous `star_alg_hom`s from the the topological closure of a `star_subalgebra` whose
+compositions with the `star_subalgebra.inclusion` map agree are, in fact, equal. -/
+lemma _root_.star_alg_hom.ext_topological_closure [t2_space B] {S : star_subalgebra R A}
+  {φ ψ : S.topological_closure →⋆ₐ[R] B} (hφ : continuous φ) (hψ : continuous ψ)
+  (h : φ.comp (inclusion (le_topological_closure S))
+    = ψ.comp (inclusion (le_topological_closure S))) :
+  φ = ψ :=
+begin
+  rw fun_like.ext'_iff,
+  have : dense (set.range $ inclusion (le_topological_closure S)),
+  { refine embedding_subtype_coe.to_inducing.dense_iff.2 (λ x, _),
+    convert (show ↑x ∈ closure (S : set A), from x.prop),
+    rw ←set.range_comp,
+    exact set.ext (λ y, ⟨by { rintro ⟨y, rfl⟩, exact y.prop }, λ hy, ⟨⟨y, hy⟩, rfl⟩⟩), },
+  refine continuous.ext_on this hφ hψ _,
+  rintro _ ⟨x, rfl⟩,
+  simpa only using fun_like.congr_fun h x,
+end
+
+lemma _root_.star_alg_hom_class.ext_topological_closure [t2_space B] {F : Type*}
+  {S : star_subalgebra R A} [star_alg_hom_class F R S.topological_closure B] {φ ψ : F}
+  (hφ : continuous φ) (hψ : continuous ψ)
+  (h : ∀ x : S, φ ((inclusion (le_topological_closure S) x))
+    = ψ ((inclusion (le_topological_closure S)) x)) :
+  φ = ψ :=
+begin
+  have : (φ : S.topological_closure →⋆ₐ[R] B) = (ψ : S.topological_closure →⋆ₐ[R] B),
+  { refine star_alg_hom.ext_topological_closure hφ hψ (star_alg_hom.ext _);
+    simpa only [star_alg_hom.coe_comp, star_alg_hom.coe_coe] using h },
+  simpa only [fun_like.ext'_iff, star_alg_hom.coe_coe],
+end
+
+end topological_star_algebra
+
+end star_subalgebra
+
+section elemental
+
+open star_subalgebra
+
+variables (R : Type*) {A B : Type*} [comm_semiring R] [star_ring R]
+variables [topological_space A] [semiring A] [star_ring A] [topological_semiring A]
+variables [has_continuous_star A] [algebra R A] [star_module R A]
+variables [topological_space B] [semiring B] [star_ring B] [algebra R B]
+
+/-- The topological closure of the subalgebra generated by a single element. -/
+def elemental_star_algebra (x : A) : star_subalgebra R A :=
+(adjoin R ({x} : set A)).topological_closure
+
+namespace elemental_star_algebra
+
+lemma self_mem (x : A) : x ∈ elemental_star_algebra R x :=
+set_like.le_def.mp (le_topological_closure _) (self_mem_adjoin_singleton R x)
+
+lemma star_self_mem (x : A) : star x ∈ elemental_star_algebra R x :=
+star_mem $ self_mem R x
+
+/-- The `elemental_star_algebra` generated by a normal element is commutative. -/
+instance [t2_space A] {x : A} [is_star_normal x] : comm_semiring (elemental_star_algebra R x) :=
+star_subalgebra.comm_semiring_topological_closure _ mul_comm
+
+/-- The `elemental_star_algebra` generated by a normal element is commutative. -/
+instance {R A} [comm_ring R] [star_ring R] [topological_space A] [ring A] [algebra R A]
+  [star_ring A] [star_module R A] [topological_ring A] [has_continuous_star A] [t2_space A]
+  {x : A} [is_star_normal x] : comm_ring (elemental_star_algebra R x) :=
+star_subalgebra.comm_ring_topological_closure _ mul_comm
+
+protected lemma is_closed (x : A) : is_closed (elemental_star_algebra R x : set A) :=
+is_closed_closure
+
+instance {A : Type*} [uniform_space A] [complete_space A] [semiring A] [star_ring A]
+  [topological_semiring A] [has_continuous_star A] [algebra R A] [star_module R A] (x : A) :
+  complete_space (elemental_star_algebra R x) :=
+is_closed_closure.complete_space_coe
+
+lemma le_of_is_closed_of_mem {S : star_subalgebra R A} (hS : is_closed (S : set A)) {x : A}
+  (hx : x ∈ S) : elemental_star_algebra R x ≤ S :=
+topological_closure_minimal (adjoin_le $ set.singleton_subset_iff.2 hx) hS
+
+/-- The coercion from an elemental algebra to the full algebra as a `closed_embedding`. -/
+lemma closed_embedding_coe (x : A) : closed_embedding (coe : elemental_star_algebra R x → A) :=
+{ induced := rfl,
+  inj := subtype.coe_injective,
+  closed_range :=
+  begin
+    convert elemental_star_algebra.is_closed R x,
+    exact set.ext (λ y, ⟨by {rintro ⟨y, rfl⟩, exact y.prop}, λ hy, ⟨⟨y, hy⟩, rfl⟩⟩),
+  end }
+
+lemma star_alg_hom_class_ext [t2_space B] {F : Type*} {a : A}
+  [star_alg_hom_class F R (elemental_star_algebra R a) B] {φ ψ : F} (hφ : continuous φ)
+  (hψ : continuous ψ) (h : φ ⟨a, self_mem R a⟩ = ψ ⟨a, self_mem R a⟩) :
+  φ = ψ :=
+begin
+  refine star_alg_hom_class.ext_topological_closure hφ hψ (λ x, adjoin_induction' x _ _ _ _ _),
+  exacts [λ y hy, by simpa only [set.mem_singleton_iff.mp hy] using h,
+    λ r, by simp only [alg_hom_class.commutes],
+    λ x y hx hy, by simp only [map_add, hx, hy],
+    λ x y hx hy, by simp only [map_mul, hx, hy],
+    λ x hx, by simp only [map_star, hx]],
+end
+
+end elemental_star_algebra
+
+end elemental
diff --git a/src/topology/algebra/uniform_convergence.lean b/src/topology/algebra/uniform_convergence.lean
new file mode 100644
index 0000000000000..ada5314adc63d
--- /dev/null
+++ b/src/topology/algebra/uniform_convergence.lean
@@ -0,0 +1,231 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+import topology.uniform_space.uniform_convergence_topology
+import analysis.locally_convex.bounded
+import topology.algebra.filter_basis
+
+/-!
+# Algebraic facts about the topology of uniform convergence
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains algebraic compatibility results about the uniform structure of uniform
+convergence / `𝔖`-convergence. They will mostly be useful for defining strong topologies on the
+space of continuous linear maps between two topological vector spaces.
+
+## Main statements
+
+* `uniform_fun.uniform_group` : if `G` is a uniform group, then `α →ᵤ G` a uniform group
+* `uniform_on_fun.uniform_group` : if `G` is a uniform group, then for any `𝔖 : set (set α)`,
+  `α →ᵤ[𝔖] G` a uniform group.
+* `uniform_on_fun.has_continuous_smul_of_image_bounded` : let `E` be a TVS, `𝔖 : set (set α)` and
+  `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any `S ∈ 𝔖` by any `u ∈ H` is bounded (in the
+  sense of `bornology.is_vonN_bounded`), then `H`, equipped with the topology induced from
+  `α →ᵤ[𝔖] E`, is a TVS.
+
+## Implementation notes
+
+Like in `topology/uniform_space/uniform_convergence_topology`, we use the type aliases
+`uniform_fun` (denoted `α →ᵤ β`) and `uniform_on_fun` (denoted `α →ᵤ[𝔖] β`) for functions from `α`
+to `β` endowed with the structures of uniform convergence and `𝔖`-convergence.
+
+## TODO
+
+* `uniform_on_fun.has_continuous_smul_of_image_bounded` unnecessarily asks for `𝔖` to be
+  nonempty and directed. This will be easy to solve once we know that replacing `𝔖` by its
+  ***noncovering*** bornology (i.e ***not*** what `bornology` currently refers to in mathlib)
+  doesn't change the topology.
+
+## References
+
+* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]
+* [N. Bourbaki, *Topological Vector Spaces*][bourbaki1987]
+
+## Tags
+
+uniform convergence, strong dual
+
+-/
+
+open filter
+open_locale topology pointwise uniform_convergence
+
+section algebraic_instances
+
+variables {α β ι R : Type*} {𝔖 : set $ set α}
+
+@[to_additive] instance [monoid β] : monoid (α →ᵤ β) := pi.monoid
+@[to_additive] instance [monoid β] : monoid (α →ᵤ[𝔖] β) := pi.monoid
+
+@[to_additive] instance [comm_monoid β] : comm_monoid (α →ᵤ β) := pi.comm_monoid
+@[to_additive] instance [comm_monoid β] : comm_monoid (α →ᵤ[𝔖] β) := pi.comm_monoid
+
+@[to_additive] instance [group β] : group (α →ᵤ β) := pi.group
+@[to_additive] instance [group β] : group (α →ᵤ[𝔖] β) := pi.group
+
+@[to_additive] instance [comm_group β] : comm_group (α →ᵤ β) := pi.comm_group
+@[to_additive] instance [comm_group β] : comm_group (α →ᵤ[𝔖] β) := pi.comm_group
+
+instance [semiring R] [add_comm_monoid β] [module R β] : module R (α →ᵤ β) := pi.module _ _ _
+instance [semiring R] [add_comm_monoid β] [module R β] : module R (α →ᵤ[𝔖] β) := pi.module _ _ _
+
+end algebraic_instances
+
+section group
+
+variables {α G ι : Type*} [group G] {𝔖 : set $ set α} [uniform_space G] [uniform_group G]
+
+/-- If `G` is a uniform group, then `α →ᵤ G` is a uniform group as well. -/
+@[to_additive "If `G` is a uniform additive group, then `α →ᵤ G` is a uniform additive group
+as well."]
+instance : uniform_group (α →ᵤ G) :=
+-- Since `(/) : G × G → G` is uniformly continuous,
+-- `uniform_fun.postcomp_uniform_continuous` tells us that
+-- `((/) ∘ —) : (α →ᵤ G × G) → (α →ᵤ G)` is uniformly continuous too. By precomposing with
+-- `uniform_fun.uniform_equiv_prod_arrow`, this gives that
+-- `(/) : (α →ᵤ G) × (α →ᵤ G) → (α →ᵤ G)` is also uniformly continuous
+⟨(uniform_fun.postcomp_uniform_continuous uniform_continuous_div).comp
+  uniform_fun.uniform_equiv_prod_arrow.symm.uniform_continuous⟩
+
+@[to_additive]
+protected lemma uniform_fun.has_basis_nhds_one_of_basis {p : ι → Prop}
+  {b : ι → set G} (h : (𝓝 1 : filter G).has_basis p b) :
+  (𝓝 1 : filter (α →ᵤ G)).has_basis p
+    (λ i, {f : α →ᵤ G | ∀ x, f x ∈ b i}) :=
+begin
+  have := h.comap (λ p : G × G, p.2 / p.1),
+  rw ← uniformity_eq_comap_nhds_one at this,
+  convert uniform_fun.has_basis_nhds_of_basis α _ 1 this,
+  ext i f,
+  simp [uniform_fun.gen]
+end
+
+@[to_additive]
+protected lemma uniform_fun.has_basis_nhds_one :
+  (𝓝 1 : filter (α →ᵤ G)).has_basis
+    (λ V : set G, V ∈ (𝓝 1 : filter G))
+    (λ V, {f : α → G | ∀ x, f x ∈ V}) :=
+uniform_fun.has_basis_nhds_one_of_basis (basis_sets _)
+
+/-- Let `𝔖 : set (set α)`. If `G` is a uniform group, then `α →ᵤ[𝔖] G` is a uniform group as
+well. -/
+@[to_additive "Let `𝔖 : set (set α)`. If `G` is a uniform additive group, then `α →ᵤ[𝔖] G` is a
+uniform additive group as well. "]
+instance : uniform_group (α →ᵤ[𝔖] G) :=
+-- Since `(/) : G × G → G` is uniformly continuous,
+-- `uniform_on_fun.postcomp_uniform_continuous` tells us that
+-- `((/) ∘ —) : (α →ᵤ[𝔖] G × G) → (α →ᵤ[𝔖] G)` is uniformly continuous too. By precomposing with
+-- `uniform_on_fun.uniform_equiv_prod_arrow`, this gives that
+-- `(/) : (α →ᵤ[𝔖] G) × (α →ᵤ[𝔖] G) → (α →ᵤ[𝔖] G)` is also uniformly continuous
+⟨(uniform_on_fun.postcomp_uniform_continuous uniform_continuous_div).comp
+  uniform_on_fun.uniform_equiv_prod_arrow.symm.uniform_continuous⟩
+
+@[to_additive]
+protected lemma uniform_on_fun.has_basis_nhds_one_of_basis (𝔖 : set $ set α)
+  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) {p : ι → Prop}
+  {b : ι → set G} (h : (𝓝 1 : filter G).has_basis p b) :
+  (𝓝 1 : filter (α →ᵤ[𝔖] G)).has_basis
+    (λ Si : set α × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
+    (λ Si, {f : α →ᵤ[𝔖] G | ∀ x ∈ Si.1, f x ∈ b Si.2}) :=
+begin
+  have := h.comap (λ p : G × G, p.1 / p.2),
+  rw ← uniformity_eq_comap_nhds_one_swapped at this,
+  convert uniform_on_fun.has_basis_nhds_of_basis α _ 𝔖 1 h𝔖₁ h𝔖₂ this,
+  ext i f,
+  simp [uniform_on_fun.gen]
+end
+
+@[to_additive]
+protected lemma uniform_on_fun.has_basis_nhds_one (𝔖 : set $ set α)
+  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) :
+  (𝓝 1 : filter (α →ᵤ[𝔖] G)).has_basis
+    (λ SV : set α × set G, SV.1 ∈ 𝔖 ∧ SV.2 ∈ (𝓝 1 : filter G))
+    (λ SV, {f : α →ᵤ[𝔖] G | ∀ x ∈ SV.1, f x ∈ SV.2}) :=
+uniform_on_fun.has_basis_nhds_one_of_basis 𝔖 h𝔖₁ h𝔖₂ (basis_sets _)
+
+end group
+
+section module
+
+variables (𝕜 α E H : Type*) {hom : Type*} [normed_field 𝕜] [add_comm_group H] [module 𝕜 H]
+  [add_comm_group E] [module 𝕜 E] [topological_space H] [uniform_space E] [uniform_add_group E]
+  [has_continuous_smul 𝕜 E] {𝔖 : set $ set α} [linear_map_class hom 𝕜 H (α →ᵤ[𝔖] E)]
+
+/-- Let `E` be a TVS, `𝔖 : set (set α)` and `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any
+`S ∈ 𝔖` by any `u ∈ H` is bounded (in the sense of `bornology.is_vonN_bounded`), then `H`,
+equipped with the topology of `𝔖`-convergence, is a TVS.
+
+For convenience, we don't literally ask for `H : submodule (α →ᵤ[𝔖] E)`. Instead, we prove the
+result for any vector space `H` equipped with a linear inducing to `α →ᵤ[𝔖] E`, which is often
+easier to use. We also state the `submodule` version as
+`uniform_on_fun.has_continuous_smul_submodule_of_image_bounded`. -/
+lemma uniform_on_fun.has_continuous_smul_induced_of_image_bounded
+  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖)
+  (φ : hom) (hφ : inducing φ)
+  (h : ∀ u : H, ∀ s ∈ 𝔖, bornology.is_vonN_bounded 𝕜 ((φ u : α → E) '' s)) :
+  has_continuous_smul 𝕜 H :=
+begin
+  haveI : topological_add_group H,
+  { rw hφ.induced,
+    exact topological_add_group_induced φ },
+  have : (𝓝 0 : filter H).has_basis _ _,
+  { rw [hφ.induced, nhds_induced, map_zero],
+    exact ((uniform_on_fun.has_basis_nhds_zero 𝔖 h𝔖₁ h𝔖₂).comap φ) },
+  refine has_continuous_smul.of_basis_zero this _ _ _,
+  { rintros ⟨S, V⟩ ⟨hS, hV⟩,
+    have : tendsto (λ kx : (𝕜 × E), kx.1 • kx.2) (𝓝 (0, 0)) (𝓝 $ (0 : 𝕜) • 0) :=
+      continuous_smul.tendsto (0 : 𝕜 × E),
+    rw [zero_smul, nhds_prod_eq] at this,
+    have := this hV,
+    rw [mem_map, mem_prod_iff] at this,
+    rcases this with ⟨U, hU, W, hW, hUW⟩,
+    refine ⟨U, hU, ⟨S, W⟩, ⟨hS, hW⟩, _⟩,
+    rw set.smul_subset_iff,
+    intros a ha u hu x hx,
+    rw smul_hom_class.map_smul,
+    exact hUW (⟨ha, hu x hx⟩ : (a, φ u x) ∈ U ×ˢ W) },
+  { rintros a ⟨S, V⟩ ⟨hS, hV⟩,
+    have : tendsto (λ x : E, a • x) (𝓝 0) (𝓝 $ a • 0) := tendsto_id.const_smul a,
+    rw [smul_zero] at this,
+    refine ⟨⟨S, ((•) a) ⁻¹' V⟩, ⟨hS, this hV⟩, λ f hf x hx, _⟩,
+    rw [smul_hom_class.map_smul],
+    exact hf x hx },
+  { rintros u ⟨S, V⟩ ⟨hS, hV⟩,
+    rcases h u S hS hV with ⟨r, hrpos, hr⟩,
+    rw metric.eventually_nhds_iff_ball,
+    refine ⟨r⁻¹, inv_pos.mpr hrpos, λ a ha x hx, _⟩,
+    by_cases ha0 : a = 0,
+    { rw ha0,
+      simp [mem_of_mem_nhds hV] },
+    { rw mem_ball_zero_iff at ha,
+      rw [smul_hom_class.map_smul, pi.smul_apply],
+      have : φ u x ∈ a⁻¹ • V,
+      { have ha0 : 0<‖a‖ := norm_pos_iff.mpr ha0,
+        refine (hr a⁻¹ _) (set.mem_image_of_mem (φ u) hx),
+        rw [norm_inv, le_inv hrpos ha0],
+        exact ha.le },
+      rwa set.mem_inv_smul_set_iff₀ ha0 at this } }
+end
+
+/-- Let `E` be a TVS, `𝔖 : set (set α)` and `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any
+`S ∈ 𝔖` by any `u ∈ H` is bounded (in the sense of `bornology.is_vonN_bounded`), then `H`,
+equipped with the topology of `𝔖`-convergence, is a TVS.
+
+If you have a hard time using this lemma, try the one above instead. -/
+lemma uniform_on_fun.has_continuous_smul_submodule_of_image_bounded
+  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) (H : submodule 𝕜 (α →ᵤ[𝔖] E))
+  (h : ∀ u ∈ H, ∀ s ∈ 𝔖, bornology.is_vonN_bounded 𝕜 (u '' s)) :
+  @has_continuous_smul 𝕜 H _ _
+  ((uniform_on_fun.topological_space α E 𝔖).induced (coe : H → α →ᵤ[𝔖] E)) :=
+begin
+  haveI : topological_add_group H := topological_add_group_induced
+    (linear_map.id.dom_restrict H : H →ₗ[𝕜] α → E),
+  exact uniform_on_fun.has_continuous_smul_induced_of_image_bounded 𝕜 α E H h𝔖₁ h𝔖₂
+    (linear_map.id.dom_restrict H : H →ₗ[𝕜] α → E) inducing_coe (λ ⟨u, hu⟩, h u hu)
+end
+
+end module
diff --git a/src/topology/algebra/uniform_field.lean b/src/topology/algebra/uniform_field.lean
index 93501d651d081..c074b36ce0502 100644
--- a/src/topology/algebra/uniform_field.lean
+++ b/src/topology/algebra/uniform_field.lean
@@ -5,10 +5,14 @@ Authors: Patrick Massot
 -/
 import topology.algebra.uniform_ring
 import topology.algebra.field
+import field_theory.subfield
 
 /-!
 # Completion of topological fields
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The goal of this file is to prove the main part of Proposition 7 of Bourbaki GT III 6.8 :
 
 The completion `hat K` of a Hausdorff topological field is a field if the image under
@@ -26,14 +30,14 @@ zero which is an ideal. Hence it's either zero (and the field is separated) or t
 which implies one is sent to zero and the completion ring is trivial.
 
 The main definition is `completable_top_field` which packages the assumptions as a Prop-valued
-type class and the main results are the instances `field_completion` and
-`topological_division_ring_completion`.
+type class and the main results are the instances `uniform_space.completion.field` and
+`uniform_space.completion.topological_division_ring`.
 -/
 
 
 noncomputable theory
 
-open_locale classical uniformity topological_space
+open_locale classical uniformity topology
 
 open set uniform_space uniform_space.completion filter
 
@@ -41,10 +45,6 @@ variables (K : Type*) [field K]  [uniform_space K]
 
 local notation `hat` := completion
 
-@[priority 100]
-instance [separated_space K] : nontrivial (hat K) :=
-⟨⟨0, 1, λ h, zero_ne_one $ (uniform_embedding_coe K).inj h⟩⟩
-
 /--
 A topological field is completable if it is separated and the image under
 the mapping x ↦ x⁻¹ of every Cauchy filter (with respect to the additive uniform structure)
@@ -55,6 +55,13 @@ a field.
 class completable_top_field extends separated_space K : Prop :=
 (nice : ∀ F : filter K, cauchy F → 𝓝 0 ⊓ F = ⊥ → cauchy (map (λ x, x⁻¹) F))
 
+namespace uniform_space
+namespace completion
+
+@[priority 100]
+instance [separated_space K] : nontrivial (hat K) :=
+⟨⟨0, 1, λ h, zero_ne_one $ (uniform_embedding_coe K).inj h⟩⟩
+
 variables {K}
 
 /-- extension of inversion to the completion of a field. -/
@@ -63,7 +70,7 @@ def hat_inv : hat K → hat K := dense_inducing_coe.extend (λ x : K, (coe x⁻
 lemma continuous_hat_inv [completable_top_field K] {x : hat K} (h : x ≠ 0) :
   continuous_at hat_inv x :=
 begin
-  haveI : regular_space (hat K) := completion.regular_space K,
+  haveI : t3_space (hat K) := completion.t3_space K,
   refine dense_inducing_coe.continuous_at_extend _,
   apply mem_of_superset (compl_singleton_mem_nhds h),
   intros y y_ne,
@@ -79,7 +86,7 @@ begin
   { have eq_bot : 𝓝 (0 : hat K) ⊓ 𝓝 y = ⊥,
     { by_contradiction h,
       exact y_ne (eq_of_nhds_ne_bot $ ne_bot_iff.mpr h).symm },
-    erw [dense_inducing_coe.nhds_eq_comap (0 : K), ← comap_inf,  eq_bot],
+    erw [dense_inducing_coe.nhds_eq_comap (0 : K), ← filter.comap_inf, eq_bot],
     exact comap_bot },
 end
 
@@ -87,7 +94,7 @@ end
 The value of `hat_inv` at zero is not really specified, although it's probably zero.
 Here we explicitly enforce the `inv_zero` axiom.
 -/
-instance completion.has_inv : has_inv (hat K) := ⟨λ x, if x = 0 then 0 else hat_inv x⟩
+instance : has_inv (hat K) := ⟨λ x, if x = 0 then 0 else hat_inv x⟩
 
 variables [topological_division_ring K]
 
@@ -140,13 +147,12 @@ begin
     dsimp [c, f],
     rw hat_inv_extends z_ne,
     norm_cast,
-    rw mul_inv_cancel z_ne,
-    norm_cast },
+    rw mul_inv_cancel z_ne, },
   replace fxclo := closure_mono this fxclo,
   rwa [closure_singleton, mem_singleton_iff] at fxclo
 end
 
-instance field_completion : field (hat K) :=
+instance : field (hat K) :=
 { exists_pair_ne := ⟨0, 1, λ h, zero_ne_one ((uniform_embedding_coe K).inj h)⟩,
   mul_inv_cancel := λ x x_ne, by { dsimp [has_inv.inv],
                                    simp [if_neg x_ne, mul_hat_inv_cancel x_ne], },
@@ -154,7 +160,7 @@ instance field_completion : field (hat K) :=
   ..completion.has_inv,
   ..(by apply_instance : comm_ring (hat K)) }
 
-instance topological_division_ring_completion : topological_division_ring (hat K) :=
+instance : topological_division_ring (hat K) :=
 { continuous_at_inv₀ := begin
     intros x x_ne,
     have : {y | hat_inv y = y⁻¹ } ∈ 𝓝 x,
@@ -167,3 +173,36 @@ instance topological_division_ring_completion : topological_division_ring (hat K
     exact continuous_at.congr (continuous_hat_inv x_ne) this
   end,
   ..completion.top_ring_compl }
+
+end completion
+end uniform_space
+
+variables (L : Type*) [field L]  [uniform_space L] [completable_top_field L]
+
+instance subfield.completable_top_field (K : subfield L) : completable_top_field K :=
+{ nice := begin
+    intros F F_cau inf_F,
+    let i : K →+* L := K.subtype,
+    have hi : uniform_inducing i, from uniform_embedding_subtype_coe.to_uniform_inducing,
+    rw ← hi.cauchy_map_iff at F_cau ⊢,
+    rw [map_comm (show (i ∘ λ x, x⁻¹) = (λ x, x⁻¹) ∘ i, by {ext, refl})],
+    apply completable_top_field.nice _ F_cau,
+    rw [← filter.push_pull', ← map_zero i, ← hi.inducing.nhds_eq_comap, inf_F, filter.map_bot]
+  end,
+  ..subtype.separated_space (K : set L) }
+
+@[priority 100]
+instance completable_top_field_of_complete (L : Type*) [field L]
+  [uniform_space L] [topological_division_ring L] [separated_space L] [complete_space L] :
+  completable_top_field L :=
+{ nice := λ F cau_F hF, begin
+    haveI : ne_bot F := cau_F.1,
+    rcases complete_space.complete cau_F with ⟨x, hx⟩,
+    have hx' : x ≠ 0,
+    { rintro rfl,
+      rw inf_eq_right.mpr hx at hF,
+      exact cau_F.1.ne hF },
+    exact filter.tendsto.cauchy_map (calc map (λ x, x⁻¹) F ≤ map (λ x, x⁻¹) (𝓝 x) : map_mono hx
+                                                       ... ≤ 𝓝 (x⁻¹) : continuous_at_inv₀ hx')
+  end,
+  ..‹separated_space L›}
diff --git a/src/topology/algebra/uniform_filter_basis.lean b/src/topology/algebra/uniform_filter_basis.lean
index 3fd209f25f003..58df1cd45c0b8 100644
--- a/src/topology/algebra/uniform_filter_basis.lean
+++ b/src/topology/algebra/uniform_filter_basis.lean
@@ -10,6 +10,9 @@ import topology.algebra.uniform_group
 /-!
 # Uniform properties of neighborhood bases in topological algebra
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files contains properties of filter bases on algebraic structures that also require the theory
 of uniform spaces.
 
@@ -32,7 +35,7 @@ protected def uniform_space : uniform_space G :=
 /-- The uniform space structure associated to an abelian group filter basis via the associated
 topological abelian group structure is compatible with its group structure. -/
 protected lemma uniform_add_group : @uniform_add_group G B.uniform_space _:=
-@topological_add_group_is_uniform G _ B.topology B.is_topological_add_group
+@topological_add_comm_group_is_uniform G _ B.topology B.is_topological_add_group
 
 lemma cauchy_iff {F : filter G} :
   @cauchy G B.uniform_space F ↔ F.ne_bot ∧ ∀ U ∈ B, ∃ M ∈ F, ∀ x y ∈ M, y - x ∈ U :=
diff --git a/src/topology/algebra/uniform_group.lean b/src/topology/algebra/uniform_group.lean
index 04eb3f27aad2b..21a79fd562407 100644
--- a/src/topology/algebra/uniform_group.lean
+++ b/src/topology/algebra/uniform_group.lean
@@ -6,12 +6,16 @@ Authors: Patrick Massot, Johannes Hölzl
 import topology.uniform_space.uniform_convergence
 import topology.uniform_space.uniform_embedding
 import topology.uniform_space.complete_separated
-import topology.algebra.group
+import topology.uniform_space.compact
+import topology.algebra.group.basic
 import tactic.abel
 
 /-!
 # Uniform structure on topological groups
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines uniform groups and its additive counterpart. These typeclasses should be
 preferred over using `[topological_space α] [topological_group α]` since every topological
 group naturally induces a uniform structure.
@@ -22,14 +26,18 @@ group naturally induces a uniform structure.
 
 ## Main results
 
-* `topological_add_group.to_uniform_space` and `topological_add_group_is_uniform` can be used to
-  construct a canonical uniformity for a topological add group.
+* `topological_add_group.to_uniform_space` and `topological_add_comm_group_is_uniform` can be used
+  to construct a canonical uniformity for a topological add group.
 
 * extension of ℤ-bilinear maps to complete groups (useful for ring completions)
+
+* `quotient_group.complete_space` and `quotient_add_group.complete_space` guarantee that quotients
+  of first countable topological groups by normal subgroups are themselves complete. In particular,
+  the quotient of a Banach space by a subspace is complete.
 -/
 
 noncomputable theory
-open_locale classical uniformity topological_space filter pointwise
+open_locale classical uniformity topology filter pointwise
 
 section uniform_group
 open filter set
@@ -79,6 +87,26 @@ by simp * at *
 @[to_additive] lemma uniform_continuous_mul : uniform_continuous (λp:α×α, p.1 * p.2) :=
 uniform_continuous_fst.mul uniform_continuous_snd
 
+@[to_additive uniform_continuous.const_nsmul]
+lemma uniform_continuous.pow_const [uniform_space β] {f : β → α}
+  (hf : uniform_continuous f) : ∀ n : ℕ, uniform_continuous (λ x, f x ^ n)
+| 0 := by { simp_rw pow_zero, exact uniform_continuous_const }
+| (n + 1) := by { simp_rw pow_succ, exact hf.mul (uniform_continuous.pow_const n) }
+
+@[to_additive uniform_continuous_const_nsmul] lemma uniform_continuous_pow_const (n : ℕ) :
+  uniform_continuous (λx:α, x ^ n) :=
+uniform_continuous_id.pow_const n
+
+@[to_additive uniform_continuous.const_zsmul]
+lemma uniform_continuous.zpow_const [uniform_space β] {f : β → α}
+  (hf : uniform_continuous f) : ∀ n : ℤ, uniform_continuous (λ x, f x ^ n)
+| (n : ℕ) := by { simp_rw zpow_coe_nat, exact hf.pow_const _, }
+| -[1+ n] := by { simp_rw zpow_neg_succ_of_nat, exact (hf.pow_const _).inv }
+
+@[to_additive uniform_continuous_const_zsmul] lemma uniform_continuous_zpow_const (n : ℤ) :
+  uniform_continuous (λx:α, x ^ n) :=
+uniform_continuous_id.zpow_const n
+
 @[priority 10, to_additive]
 instance uniform_group.to_topological_group : topological_group α :=
 { continuous_mul := uniform_continuous_mul.continuous,
@@ -125,6 +153,41 @@ namespace subgroup
 
 end subgroup
 
+section lattice_ops
+
+variables [group β]
+
+@[to_additive] lemma uniform_group_Inf {us : set (uniform_space β)}
+  (h : ∀ u ∈ us, @uniform_group β u _) :
+  @uniform_group β (Inf us) _ :=
+{ uniform_continuous_div := uniform_continuous_Inf_rng (λ u hu, uniform_continuous_Inf_dom₂ hu hu
+  (@uniform_group.uniform_continuous_div β u _ (h u hu))) }
+
+@[to_additive] lemma uniform_group_infi {ι : Sort*} {us' : ι → uniform_space β}
+  (h' : ∀ i, @uniform_group β (us' i) _) :
+  @uniform_group β (⨅ i, us' i) _ :=
+by {rw ← Inf_range, exact uniform_group_Inf (set.forall_range_iff.mpr h')}
+
+@[to_additive] lemma uniform_group_inf {u₁ u₂ : uniform_space β}
+  (h₁ : @uniform_group β u₁ _) (h₂ : @uniform_group β u₂ _) :
+  @uniform_group β (u₁ ⊓ u₂) _ :=
+by {rw inf_eq_infi, refine uniform_group_infi (λ b, _), cases b; assumption}
+
+@[to_additive] lemma uniform_group_comap {γ : Type*} [group γ] {u : uniform_space γ}
+  [uniform_group γ] {F : Type*} [monoid_hom_class F β γ] (f : F) :
+  @uniform_group β (u.comap f) _ :=
+{ uniform_continuous_div :=
+    begin
+      letI : uniform_space β := u.comap f,
+      refine uniform_continuous_comap' _,
+      simp_rw [function.comp, map_div],
+      change uniform_continuous ((λ p : γ × γ, p.1 / p.2) ∘ (prod.map f f)),
+      exact uniform_continuous_div.comp
+        (uniform_continuous_comap.prod_map uniform_continuous_comap),
+    end }
+
+end lattice_ops
+
 section
 variables (α)
 
@@ -149,6 +212,25 @@ end
   𝓤 α = comap (λx:α×α, x.1 / x.2) (𝓝 (1:α)) :=
 by { rw [← comap_swap_uniformity, uniformity_eq_comap_nhds_one, comap_comap, (∘)], refl }
 
+@[to_additive] lemma uniform_group.ext {G : Type*} [group G] {u v : uniform_space G}
+  (hu : @uniform_group G u _) (hv : @uniform_group G v _)
+  (h : @nhds _ u.to_topological_space 1 = @nhds _ v.to_topological_space 1) :
+  u = v :=
+uniform_space_eq $
+  by rw [@uniformity_eq_comap_nhds_one _ u _ hu, @uniformity_eq_comap_nhds_one _ v _ hv, h]
+
+@[to_additive] lemma uniform_group.ext_iff {G : Type*} [group G] {u v : uniform_space G}
+  (hu : @uniform_group G u _) (hv : @uniform_group G v _) :
+  u = v ↔ @nhds _ u.to_topological_space 1 = @nhds _ v.to_topological_space 1 :=
+⟨λ h, h ▸ rfl, hu.ext hv⟩
+
+variables {α}
+
+@[to_additive] theorem uniform_group.uniformity_countably_generated
+  [(𝓝 (1 : α)).is_countably_generated] :
+  (𝓤 α).is_countably_generated :=
+by { rw uniformity_eq_comap_nhds_one, exact filter.comap.is_countably_generated _ _ }
+
 open mul_opposite
 
 @[to_additive]
@@ -205,7 +287,13 @@ begin
   exact tendsto.comp h tendsto_comap
 end
 
-@[to_additive] lemma uniform_continuous_of_continuous_at_one {hom : Type*}
+/-- A group homomorphism (a bundled morphism of a type that implements `monoid_hom_class`) between
+two uniform groups is uniformly continuous provided that it is continuous at one. See also
+`continuous_of_continuous_at_one`. -/
+@[to_additive "An additive group homomorphism (a bundled morphism of a type that implements
+`add_monoid_hom_class`) between two uniform additive groups is uniformly continuous provided that it
+is continuous at zero. See also `continuous_of_continuous_at_zero`."]
+lemma uniform_continuous_of_continuous_at_one {hom : Type*}
   [uniform_space β] [group β] [uniform_group β] [monoid_hom_class hom α β]
   (f : hom) (hf : continuous_at f 1) :
   uniform_continuous f :=
@@ -260,14 +348,65 @@ uniform_continuous_inv.comp_cauchy_seq h
 (𝓝 (1 : α)).basis_sets.uniformity_of_nhds_one_inv_mul_swapped.totally_bounded_iff.trans $
   by simp [← preimage_smul_inv, preimage]
 
+section uniform_convergence
+variables {ι : Type*} {l : filter ι} {l' : filter β} {f f' : ι → β → α} {g g' : β → α} {s : set β}
+
+@[to_additive] lemma tendsto_uniformly_on_filter.mul (hf : tendsto_uniformly_on_filter f g l l')
+  (hf' : tendsto_uniformly_on_filter f' g' l l') :
+  tendsto_uniformly_on_filter (f * f') (g * g') l l' :=
+λ u hu, ((uniform_continuous_mul.comp_tendsto_uniformly_on_filter
+  (hf.prod hf')) u hu).diag_of_prod_left
+
+@[to_additive] lemma tendsto_uniformly_on_filter.div (hf : tendsto_uniformly_on_filter f g l l')
+  (hf' : tendsto_uniformly_on_filter f' g' l l') :
+  tendsto_uniformly_on_filter (f / f') (g / g') l l' :=
+λ u hu, ((uniform_continuous_div.comp_tendsto_uniformly_on_filter
+  (hf.prod hf')) u hu).diag_of_prod_left
+
+@[to_additive] lemma tendsto_uniformly_on.mul (hf : tendsto_uniformly_on f g l s)
+  (hf' : tendsto_uniformly_on f' g' l s) : tendsto_uniformly_on (f * f') (g * g') l s :=
+λ u hu, ((uniform_continuous_mul.comp_tendsto_uniformly_on (hf.prod hf')) u hu).diag_of_prod
+
+@[to_additive] lemma tendsto_uniformly_on.div (hf : tendsto_uniformly_on f g l s)
+  (hf' : tendsto_uniformly_on f' g' l s) : tendsto_uniformly_on (f / f') (g / g') l s :=
+λ u hu, ((uniform_continuous_div.comp_tendsto_uniformly_on (hf.prod hf')) u hu).diag_of_prod
+
+@[to_additive] lemma tendsto_uniformly.mul (hf : tendsto_uniformly f g l)
+  (hf' : tendsto_uniformly f' g' l) : tendsto_uniformly (f * f') (g * g') l :=
+λ u hu, ((uniform_continuous_mul.comp_tendsto_uniformly (hf.prod hf')) u hu).diag_of_prod
+
+@[to_additive] lemma tendsto_uniformly.div (hf : tendsto_uniformly f g l)
+  (hf' : tendsto_uniformly f' g' l) : tendsto_uniformly (f / f') (g / g') l :=
+λ u hu, ((uniform_continuous_div.comp_tendsto_uniformly (hf.prod hf')) u hu).diag_of_prod
+
+@[to_additive] lemma uniform_cauchy_seq_on.mul (hf : uniform_cauchy_seq_on f l s)
+  (hf' : uniform_cauchy_seq_on f' l s) : uniform_cauchy_seq_on (f * f') l s :=
+λ u hu, by simpa using ((uniform_continuous_mul.comp_uniform_cauchy_seq_on (hf.prod' hf')) u hu)
+
+@[to_additive] lemma uniform_cauchy_seq_on.div (hf : uniform_cauchy_seq_on f l s)
+  (hf' : uniform_cauchy_seq_on f' l s) : uniform_cauchy_seq_on (f / f') l s :=
+λ u hu, by simpa using ((uniform_continuous_div.comp_uniform_cauchy_seq_on (hf.prod' hf')) u hu)
+
+end uniform_convergence
 end uniform_group
 
-section topological_comm_group
+section topological_group
 open filter
-variables (G : Type*) [comm_group G] [topological_space G] [topological_group G]
+variables (G : Type*) [group G] [topological_space G] [topological_group G]
+
+/-- The right uniformity on a topological group (as opposed to the left uniformity).
+
+Warning: in general the right and left uniformities do not coincide and so one does not obtain a
+`uniform_group` structure. Two important special cases where they _do_ coincide are for
+commutative groups (see `topological_comm_group_is_uniform`) and for compact groups (see
+`topological_group_is_uniform_of_compact_space`). -/
+@[to_additive "The right uniformity on a topological additive group (as opposed to the left
+uniformity).
 
-/-- The right uniformity on a topological group. -/
-@[to_additive "The right uniformity on a topological group"]
+Warning: in general the right and left uniformities do not coincide and so one does not obtain a
+`uniform_add_group` structure. Two important special cases where they _do_ coincide are for
+commutative additive groups (see `topological_add_comm_group_is_uniform`) and for compact
+additive groups (see `topological_add_comm_group_is_uniform_of_compact_space`)."]
 def topological_group.to_uniform_space : uniform_space G :=
 { uniformity          := comap (λp:G×G, p.2 / p.1) (𝓝 1),
   refl                :=
@@ -294,10 +433,10 @@ def topological_group.to_uniform_space : uniform_space G :=
       begin
         intros p p_comp_rel,
         rcases p_comp_rel with ⟨z, ⟨Hz1, Hz2⟩⟩,
-        simpa [sub_eq_add_neg, add_comm, add_left_comm] using V_sum _ Hz1 _ Hz2
+        simpa using V_sum _ Hz2 _ Hz1,
       end,
       exact set.subset.trans comp_rel_sub U_sub },
-    { exact monotone_comp_rel monotone_id monotone_id }
+    { exact monotone_id.comp_rel monotone_id }
   end,
   is_open_uniformity  :=
   begin
@@ -314,8 +453,35 @@ def topological_group.to_uniform_space : uniform_space G :=
     { rintros h x hx, exact @h (a, x) hx rfl }
   end }
 
+local attribute [instance] topological_group.to_uniform_space
+
+@[to_additive] lemma uniformity_eq_comap_nhds_one' :
+  𝓤 G = comap (λp:G×G, p.2 / p.1) (𝓝 (1 : G)) := rfl
+
+@[to_additive] lemma topological_group_is_uniform_of_compact_space
+  [compact_space G] : uniform_group G :=
+⟨begin
+  apply compact_space.uniform_continuous_of_continuous,
+  exact continuous_div',
+end⟩
+
 variables {G}
 
+@[to_additive] instance subgroup.is_closed_of_discrete [t2_space G]
+  {H : subgroup G} [discrete_topology H] : is_closed (H : set G) :=
+begin
+  obtain ⟨V, V_in, VH⟩ : ∃ (V : set G) (hV : V ∈ 𝓝 (1 : G)), V ∩ (H : set G) = {1},
+    from nhds_inter_eq_singleton_of_mem_discrete H.one_mem,
+  haveI : separated_space G := separated_iff_t2.mpr ‹_›,
+  have : (λ p : G × G, p.2 / p.1) ⁻¹' V ∈ 𝓤 G, from preimage_mem_comap V_in,
+  apply is_closed_of_spaced_out this,
+  intros h h_in h' h'_in,
+  contrapose!,
+  rintro (hyp : h' / h ∈ V),
+  have : h'/h ∈ ({1} : set G) := VH ▸ set.mem_inter hyp (H.div_mem h'_in h_in),
+  exact (eq_of_div_eq_one this).symm
+end
+
 @[to_additive] lemma topological_group.tendsto_uniformly_iff
   {ι α : Type*} (F : ι → α → G) (f : α → G) (p : filter ι) :
   @tendsto_uniformly α G ι (topological_group.to_uniform_space G) F f p
@@ -344,7 +510,7 @@ variables {G}
 ⟨λ h u hu, h _ ⟨u, hu, λ _, id⟩, λ h v ⟨u, hu, hv⟩ x, exists_imp_exists (by exact λ a,
   exists_imp_exists (λ ha hp, mem_of_superset hp (λ i hi a ha, hv (by exact hi a ha)))) ∘ h u hu x⟩
 
-end topological_comm_group
+end topological_group
 
 section topological_comm_group
 universes u v w x
@@ -355,11 +521,8 @@ variables (G : Type*) [comm_group G] [topological_space G] [topological_group G]
 section
 local attribute [instance] topological_group.to_uniform_space
 
-@[to_additive] lemma uniformity_eq_comap_nhds_one' :
-  𝓤 G = comap (λp:G×G, p.2 / p.1) (𝓝 (1 : G)) := rfl
-
 variable {G}
-@[to_additive] lemma topological_group_is_uniform : uniform_group G :=
+@[to_additive] lemma topological_comm_group_is_uniform : uniform_group G :=
 have tendsto
     ((λp:(G×G), p.1 / p.2) ∘ (λp:(G×G)×(G×G), (p.1.2 / p.1.1, p.2.2 / p.2.1)))
     (comap (λp:(G×G)×(G×G), (p.1.2 / p.1.1, p.2.2 / p.2.1)) ((𝓝 1).prod (𝓝 1)))
@@ -377,13 +540,13 @@ open set
 @[to_additive] lemma topological_group.t2_space_iff_one_closed :
   t2_space G ↔ is_closed ({1} : set G) :=
 begin
-  haveI : uniform_group G := topological_group_is_uniform,
+  haveI : uniform_group G := topological_comm_group_is_uniform,
   rw [← separated_iff_t2, separated_space_iff, ← closure_eq_iff_is_closed],
   split; intro h,
   { apply subset.antisymm,
     { intros x x_in,
       have := group_separation_rel x 1,
-      rw div_one' at this,
+      rw div_one at this,
       rw [← this, h] at x_in,
       change x = 1 at x_in,
       simp [x_in] },
@@ -413,23 +576,22 @@ end
 end
 
 @[to_additive] lemma uniform_group.to_uniform_space_eq {G : Type*} [u : uniform_space G]
-  [comm_group G] [uniform_group G] : topological_group.to_uniform_space G = u :=
+  [group G] [uniform_group G] : topological_group.to_uniform_space G = u :=
 begin
   ext : 1,
-  show @uniformity G (topological_group.to_uniform_space G) = 𝓤 G,
   rw [uniformity_eq_comap_nhds_one' G, uniformity_eq_comap_nhds_one G]
 end
 
 end topological_comm_group
 
-open comm_group filter set function
+open filter set function
 
 section
 variables {α : Type*} {β : Type*} {hom : Type*}
-variables [topological_space α] [comm_group α] [topological_group α]
+variables [topological_space α] [group α] [topological_group α]
 
 -- β is a dense subgroup of α, inclusion is denoted by e
-variables [topological_space β] [comm_group β]
+variables [topological_space β] [group β]
 variables [monoid_hom_class hom β α] {e : hom} (de : dense_inducing e)
 include de
 
@@ -601,3 +763,118 @@ begin
       apply h ; tauto } }
 end
 end dense_inducing
+
+section complete_quotient
+
+universe u
+open topological_space classical
+
+/-- The quotient `G ⧸ N` of a complete first countable topological group `G` by a normal subgroup
+is itself complete. [N. Bourbaki, *General Topology*, IX.3.1 Proposition 4][bourbaki1966b]
+
+Because a topological group is not equipped with a `uniform_space` instance by default, we must
+explicitly provide it in order to consider completeness. See `quotient_group.complete_space` for a
+version in which `G` is already equipped with a uniform structure. -/
+@[to_additive "The quotient `G ⧸ N` of a complete first countable topological additive group
+`G` by a normal additive subgroup is itself complete. Consequently, quotients of Banach spaces by
+subspaces are complete. [N. Bourbaki, *General Topology*, IX.3.1 Proposition 4][bourbaki1966b]
+
+Because an additive topological group is not equipped with a `uniform_space` instance by default,
+we must explicitly provide it in order to consider completeness. See
+`quotient_add_group.complete_space` for a version in which `G` is already equipped with a uniform
+structure."]
+instance quotient_group.complete_space' (G : Type u) [group G] [topological_space G]
+  [topological_group G] [first_countable_topology G] (N : subgroup G) [N.normal]
+  [@complete_space G (topological_group.to_uniform_space G)] :
+  @complete_space (G ⧸ N) (topological_group.to_uniform_space (G ⧸ N)) :=
+begin
+  /- Since `G ⧸ N` is a topological group it is a uniform space, and since `G` is first countable
+  the uniformities of both `G` and `G ⧸ N` are countably generated. Moreover, we may choose a
+  sequential antitone neighborhood basis `u` for `𝓝 (1 : G)` so that `(u (n + 1)) ^ 2 ⊆ u n`, and
+  this descends to an antitone neighborhood basis `v` for `𝓝 (1 : G ⧸ N)`. Since `𝓤 (G ⧸ N)` is
+  countably generated, it suffices to show any Cauchy sequence `x` converges. -/
+  letI : uniform_space (G ⧸ N) := topological_group.to_uniform_space (G ⧸ N),
+  letI : uniform_space G := topological_group.to_uniform_space G,
+  haveI : (𝓤 (G ⧸ N)).is_countably_generated := comap.is_countably_generated _ _,
+  obtain ⟨u, hu, u_mul⟩ := topological_group.exists_antitone_basis_nhds_one G,
+  obtain ⟨hv, v_anti⟩ := @has_antitone_basis.map _ _ _ _ _ _ (coe : G → G ⧸ N) hu,
+  rw [←quotient_group.nhds_eq N 1, quotient_group.coe_one] at hv,
+  refine uniform_space.complete_of_cauchy_seq_tendsto (λ x hx, _),
+  /- Given `n : ℕ`, for sufficiently large `a b : ℕ`, given any lift of `x b`, we can find a lift
+  of `x a` such that the quotient of the lifts lies in `u n`. -/
+  have key₀ : ∀ i j : ℕ, ∃ M : ℕ,
+    j < M ∧ ∀ a b : ℕ, M ≤ a → M ≤ b → ∀ g : G, x b = g → ∃ g' : G, g / g' ∈ u i ∧ x a = g',
+  { have h𝓤GN : (𝓤 (G ⧸ N)).has_basis (λ _, true) (λ i, {x | x.snd / x.fst ∈ coe '' u i}),
+    { simpa [uniformity_eq_comap_nhds_one'] using hv.comap _ },
+    simp only [h𝓤GN.cauchy_seq_iff, ge_iff_le, mem_set_of_eq, forall_true_left, mem_image] at hx,
+    intros i j,
+    rcases hx i with ⟨M, hM⟩,
+    refine ⟨max j M + 1, (le_max_left _ _).trans_lt (lt_add_one _), λ a b ha hb g hg, _⟩,
+    obtain ⟨y, y_mem, hy⟩ := hM a (((le_max_right j _).trans (lt_add_one _).le).trans ha) b
+      (((le_max_right j _).trans (lt_add_one _).le).trans hb),
+    refine ⟨y⁻¹ * g,
+      by simpa only [div_eq_mul_inv, mul_inv_rev, inv_inv, mul_inv_cancel_left] using y_mem, _⟩,
+    rw [quotient_group.coe_mul, quotient_group.coe_inv, hy, hg, inv_div, div_mul_cancel'], },
+  /- Inductively construct a subsequence `φ : ℕ → ℕ` using `key₀` so that if `a b : ℕ` exceed
+  `φ (n + 1)`, then we may find lifts whose quotients lie within `u n`. -/
+  set φ : ℕ → ℕ := λ n, nat.rec_on n (some $ key₀ 0 0) (λ k yk, some $ key₀ (k + 1) yk),
+  have hφ : ∀ n : ℕ, φ n < φ (n + 1) ∧ ∀ a b : ℕ, φ (n + 1) ≤ a → φ (n + 1) ≤ b →
+    (∀ g : G, x b = g → ∃ g' : G, g / g' ∈ u (n + 1) ∧ x a = g'),
+    from λ n, some_spec (key₀ (n + 1) (φ n)),
+  /- Inductively construct a sequence `x' n : G` of lifts of `x (φ (n + 1))` such that quotients of
+  successive terms lie in `x' n / x' (n + 1) ∈ u (n + 1)`. We actually need the proofs that each
+  term is a lift to construct the next term, so we use a Σ-type. -/
+  set x' : Π n, psigma (λ g : G, x (φ (n + 1)) = g) :=
+    λ n, nat.rec_on n
+      ⟨some (quotient_group.mk_surjective (x (φ 1))),
+       (some_spec (quotient_group.mk_surjective (x (φ 1)))).symm⟩
+      (λ k hk, ⟨some $ (hφ k).2 _ _ (hφ (k + 1)).1.le le_rfl hk.fst hk.snd,
+          (some_spec $ (hφ k).2 _ _ (hφ (k + 1)).1.le le_rfl hk.fst hk.snd).2⟩),
+  have hx' : ∀ n : ℕ, (x' n).fst / (x' (n + 1)).fst ∈ u (n + 1) :=
+    λ n, (some_spec $ (hφ n).2 _ _ (hφ (n + 1)).1.le le_rfl (x' n).fst (x' n).snd).1,
+  /- The sequence `x'` is Cauchy. This is where we exploit the condition on `u`. The key idea
+  is to show by decreasing induction that `x' m / x' n ∈ u m` if `m ≤ n`. -/
+  have x'_cauchy : cauchy_seq (λ n, (x' n).fst),
+  { have h𝓤G : (𝓤 G).has_basis (λ _, true) (λ i, {x | x.snd / x.fst ∈ u i}),
+    { simpa [uniformity_eq_comap_nhds_one'] using hu.to_has_basis.comap _ },
+    simp only [h𝓤G.cauchy_seq_iff', ge_iff_le, mem_set_of_eq, forall_true_left],
+    exact λ m, ⟨m, λ n hmn, nat.decreasing_induction'
+      (λ k hkn hkm hk, u_mul k ⟨_, _, hx' k, hk, div_mul_div_cancel' _ _ _⟩)
+      hmn (by simpa only [div_self'] using mem_of_mem_nhds (hu.mem _))⟩ },
+  /- Since `G` is complete, `x'` converges to some `x₀`, and so the image of this sequence under
+  the quotient map converges to `↑x₀`. The image of `x'` is a convergent subsequence of `x`, and
+  since `x` is Cauchy, this implies it converges. -/
+  rcases cauchy_seq_tendsto_of_complete x'_cauchy with ⟨x₀, hx₀⟩,
+  refine ⟨↑x₀, tendsto_nhds_of_cauchy_seq_of_subseq hx
+    (strict_mono_nat_of_lt_succ $ λ n, (hφ (n + 1)).1).tendsto_at_top _⟩,
+  convert ((continuous_coinduced_rng : continuous (coe : G → G ⧸ N)).tendsto x₀).comp hx₀,
+  exact funext (λ n, (x' n).snd),
+end
+
+/-- The quotient `G ⧸ N` of a complete first countable uniform group `G` by a normal subgroup
+is itself complete. In constrast to `quotient_group.complete_space'`, in this version `G` is
+already equipped with a uniform structure.
+[N. Bourbaki, *General Topology*, IX.3.1 Proposition 4][bourbaki1966b]
+
+Even though `G` is equipped with a uniform structure, the quotient `G ⧸ N` does not inherit a
+uniform structure, so it is still provided manually via `topological_group.to_uniform_space`.
+In the most common use cases, this coincides (definitionally) with the uniform structure on the
+quotient obtained via other means.  -/
+@[to_additive "The quotient `G ⧸ N` of a complete first countable uniform additive group
+`G` by a normal additive subgroup is itself complete. Consequently, quotients of Banach spaces by
+subspaces are complete. In constrast to `quotient_add_group.complete_space'`, in this version
+`G` is already equipped with a uniform structure.
+[N. Bourbaki, *General Topology*, IX.3.1 Proposition 4][bourbaki1966b]
+
+Even though `G` is equipped with a uniform structure, the quotient `G ⧸ N` does not inherit a
+uniform structure, so it is still provided manually via `topological_add_group.to_uniform_space`.
+In the most common use case ─ quotients of normed additive commutative groups by subgroups ─
+significant care was taken so that the uniform structure inherent in that setting coincides
+(definitionally) with the uniform structure provided here."]
+instance quotient_group.complete_space (G : Type u) [group G] [us : uniform_space G]
+  [uniform_group G] [first_countable_topology G] (N : subgroup G) [N.normal]
+  [hG : complete_space G] : @complete_space (G ⧸ N) (topological_group.to_uniform_space (G ⧸ N)) :=
+by { unfreezingI { rw ←@uniform_group.to_uniform_space_eq _ us _ _ at hG }, apply_instance }
+
+
+end complete_quotient
diff --git a/src/topology/algebra/uniform_mul_action.lean b/src/topology/algebra/uniform_mul_action.lean
index 6ea1087b57641..55eefec7ba245 100644
--- a/src/topology/algebra/uniform_mul_action.lean
+++ b/src/topology/algebra/uniform_mul_action.lean
@@ -3,15 +3,25 @@ Copyright (c) 2022 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import topology.algebra.group_completion
+import topology.algebra.uniform_group
+import topology.uniform_space.completion
 
 /-!
 # Multiplicative action on the completion of a uniform space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define typeclasses `has_uniform_continuous_const_vadd` and
 `has_uniform_continuous_const_smul` and prove that a multiplicative action on `X` with uniformly
-continuous `(•) c` can be extended to a multiplicative action on `uniform_space.completion X`. We
-also provide similar instances `distrib_mul_action`, `mul_action_with_zero`, and `module`.
+continuous `(•) c` can be extended to a multiplicative action on `uniform_space.completion X`.
+
+In later files once the additive group structure is set up, we provide
+* `uniform_space.completion.distrib_mul_action`
+* `uniform_space.completion.mul_action_with_zero`
+* `uniform_space.completion.module`
+
+TODO: Generalise the results here from the concrete `completion` to any `abstract_completion`.
 -/
 
 universes u v w x y z
@@ -22,20 +32,47 @@ variables (R : Type u) (M : Type v) (N : Type w) (X : Type x) (Y : Type y)
   [uniform_space X] [uniform_space Y]
 
 /-- An additive action such that for all `c`, the map `λ x, c +ᵥ x` is uniformly continuous. -/
-class has_uniform_continuous_const_vadd [uniform_space X] [has_vadd M X] : Prop :=
+class has_uniform_continuous_const_vadd [has_vadd M X] : Prop :=
 (uniform_continuous_const_vadd : ∀ (c : M), uniform_continuous ((+ᵥ) c : X → X))
 
 /-- A multiplicative action such that for all `c`, the map `λ x, c • x` is uniformly continuous. -/
 @[to_additive]
-class has_uniform_continuous_const_smul [uniform_space X] [has_scalar M X] : Prop :=
+class has_uniform_continuous_const_smul [has_smul M X] : Prop :=
 (uniform_continuous_const_smul : ∀ (c : M), uniform_continuous ((•) c : X → X))
 
 export has_uniform_continuous_const_vadd (uniform_continuous_const_vadd)
   has_uniform_continuous_const_smul (uniform_continuous_const_smul)
 
-section has_scalar
+instance add_monoid.has_uniform_continuous_const_smul_nat [add_group X] [uniform_add_group X] :
+  has_uniform_continuous_const_smul ℕ X :=
+⟨uniform_continuous_const_nsmul⟩
+
+instance add_group.has_uniform_continuous_const_smul_int [add_group X] [uniform_add_group X] :
+  has_uniform_continuous_const_smul ℤ X :=
+⟨uniform_continuous_const_zsmul⟩
+
+/-- A `distrib_mul_action` that is continuous on a uniform group is uniformly continuous.
+This can't be an instance due to it forming a loop with
+`has_uniform_continuous_const_smul.to_has_continuous_const_smul` -/
+lemma has_uniform_continuous_const_smul_of_continuous_const_smul [monoid R] [add_comm_group M]
+  [distrib_mul_action R M] [uniform_space M] [uniform_add_group M] [has_continuous_const_smul R M] :
+  has_uniform_continuous_const_smul R M :=
+⟨λ r, uniform_continuous_of_continuous_at_zero (distrib_mul_action.to_add_monoid_hom M r)
+  (continuous.continuous_at (continuous_const_smul r))⟩
 
-variable [has_scalar M X]
+/-- The action of `semiring.to_module` is uniformly continuous. -/
+instance ring.has_uniform_continuous_const_smul [ring R] [uniform_space R]
+  [uniform_add_group R] [has_continuous_mul R] : has_uniform_continuous_const_smul R R :=
+has_uniform_continuous_const_smul_of_continuous_const_smul _ _
+
+/-- The action of `semiring.to_opposite_module` is uniformly continuous. -/
+instance ring.has_uniform_continuous_const_op_smul [ring R] [uniform_space R]
+  [uniform_add_group R] [has_continuous_mul R] : has_uniform_continuous_const_smul Rᵐᵒᵖ R :=
+has_uniform_continuous_const_smul_of_continuous_const_smul _ _
+
+section has_smul
+
+variable [has_smul M X]
 
 @[priority 100, to_additive]
 instance has_uniform_continuous_const_smul.to_has_continuous_const_smul
@@ -49,9 +86,11 @@ variables {M X Y}
   uniform_continuous (c • f) :=
 (uniform_continuous_const_smul c).comp hf
 
-/-- If a scalar is central, then its right action is uniform continuous when its left action is. -/
-@[priority 100]
-instance has_uniform_continuous_const_smul.op [has_scalar Mᵐᵒᵖ X] [is_central_scalar M X]
+/-- If a scalar action is central, then its right action is uniform continuous when its left action
+is. -/
+@[priority 100, to_additive "If an additive action is central, then its right action is uniform
+continuous when its left action,is."]
+instance has_uniform_continuous_const_smul.op [has_smul Mᵐᵒᵖ X] [is_central_scalar M X]
   [has_uniform_continuous_const_smul M X] : has_uniform_continuous_const_smul Mᵐᵒᵖ X :=
 ⟨mul_opposite.rec $ λ c, begin
   change uniform_continuous (λ m, mul_opposite.op c • m),
@@ -63,7 +102,7 @@ end⟩
   [has_uniform_continuous_const_smul M X] : has_uniform_continuous_const_smul M Xᵐᵒᵖ :=
 ⟨λ c, mul_opposite.uniform_continuous_op.comp $ mul_opposite.uniform_continuous_unop.const_smul c⟩
 
-end has_scalar
+end has_smul
 
 @[to_additive] instance uniform_group.to_has_uniform_continuous_const_smul
   {G : Type u} [group G] [uniform_space G] [uniform_group G] :
@@ -74,17 +113,43 @@ namespace uniform_space
 
 namespace completion
 
-section has_scalar
+section has_smul
 
-variable [has_scalar M X]
+variable [has_smul M X]
 
-@[to_additive has_vadd] instance : has_scalar M (completion X) :=
+@[to_additive] instance : has_smul M (completion X) :=
 ⟨λ c, completion.map ((•) c)⟩
 
+@[to_additive] lemma smul_def (c : M) (x : completion X) : c • x = completion.map ((•) c) x := rfl
+
 @[to_additive] instance : has_uniform_continuous_const_smul M (completion X) :=
 ⟨λ c, uniform_continuous_map⟩
 
-instance [has_scalar Mᵐᵒᵖ X] [is_central_scalar M X] : is_central_scalar M (completion X) :=
+@[to_additive] instance [has_smul N X] [has_smul M N]
+  [has_uniform_continuous_const_smul M X] [has_uniform_continuous_const_smul N X]
+  [is_scalar_tower M N X] : is_scalar_tower M N (completion X) :=
+⟨λ m n x, begin
+  have : _ = (_ : completion X → completion X) :=
+    map_comp (uniform_continuous_const_smul m) (uniform_continuous_const_smul n),
+  refine eq.trans _ (congr_fun this.symm x),
+  exact congr_arg (λ f, completion.map f x) (by exact funext (smul_assoc _ _)),
+end⟩
+
+@[to_additive] instance [has_smul N X] [smul_comm_class M N X]
+  [has_uniform_continuous_const_smul M X] [has_uniform_continuous_const_smul N X] :
+  smul_comm_class M N (completion X) :=
+⟨λ m n x, begin
+  have hmn : m • n • x =
+    (( completion.map (has_smul.smul m)) ∘ (completion.map (has_smul.smul n))) x := rfl,
+  have hnm : n • m • x =
+    (( completion.map (has_smul.smul n)) ∘ (completion.map (has_smul.smul m))) x := rfl,
+  rw [hmn, hnm, map_comp, map_comp],
+  exact congr_arg (λ f, completion.map f x) (by exact funext (smul_comm _ _)),
+  repeat{ exact uniform_continuous_const_smul _},
+ end⟩
+
+@[to_additive]
+instance [has_smul Mᵐᵒᵖ X] [is_central_scalar M X] : is_central_scalar M (completion X) :=
 ⟨λ c a, congr_arg (λ f, completion.map f a) $ by exact funext (op_smul_eq_smul c)⟩
 
 variables {M X} [has_uniform_continuous_const_smul M X]
@@ -93,7 +158,7 @@ variables {M X} [has_uniform_continuous_const_smul M X]
 lemma coe_smul (c : M) (x : X) : ↑(c • x) = (c • x : completion X) :=
 (map_coe (uniform_continuous_const_smul c) x).symm
 
-end has_scalar
+end has_smul
 
 @[to_additive] instance [monoid M] [mul_action M X] [has_uniform_continuous_const_smul M X] :
   mul_action M (completion X) :=
@@ -102,33 +167,6 @@ end has_scalar
   mul_smul := λ x y, ext' (continuous_const_smul _) ((continuous_const_smul _).const_smul _) $
     λ a, by simp only [← coe_smul, mul_smul] }
 
-instance [monoid_with_zero M] [has_zero X] [mul_action_with_zero M X]
-  [has_uniform_continuous_const_smul M X] :
-  mul_action_with_zero M (completion X) :=
-{ smul := (•),
-  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, mul_action_with_zero.smul_zero r],
-  zero_smul := ext' (continuous_const_smul _) continuous_const $ λ a,
-    by rw [← coe_smul, zero_smul, coe_zero],
-  .. completion.mul_action M X }
-
-instance [monoid M] [add_group N] [distrib_mul_action M N] [uniform_space N]
-  [uniform_add_group N] [has_uniform_continuous_const_smul M N] :
-  distrib_mul_action M (completion N) :=
-{ smul := (•),
-  smul_add := λ r x y, induction_on₂ x y
-    (is_closed_eq ((continuous_fst.add continuous_snd).const_smul _)
-      ((continuous_fst.const_smul _).add (continuous_snd.const_smul _)))
-    (λ a b, by simp only [← coe_add, ← coe_smul, smul_add]),
-  smul_zero := λ r, by rw [← coe_zero, ← coe_smul, smul_zero r],
-  .. completion.mul_action M N }
-
-instance [semiring R] [add_comm_group M] [module R M] [uniform_space M] [uniform_add_group M]
-  [has_uniform_continuous_const_smul R M] : module R (completion M) :=
-{ smul := (•),
-  add_smul := λ a b, ext' (continuous_const_smul _)
-    ((continuous_const_smul _).add (continuous_const_smul _)) $ λ x, by { norm_cast, rw add_smul },
-  .. completion.distrib_mul_action R M, .. completion.mul_action_with_zero R M }
-
 end completion
 
 end uniform_space
diff --git a/src/topology/algebra/uniform_ring.lean b/src/topology/algebra/uniform_ring.lean
index 680104806aed5..7d8bbd1c1196b 100644
--- a/src/topology/algebra/uniform_ring.lean
+++ b/src/topology/algebra/uniform_ring.lean
@@ -3,16 +3,22 @@ Copyright (c) 2018 Patrick Massot. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Johannes Hölzl
 -/
+import algebra.algebra.basic
 import topology.algebra.group_completion
-import topology.algebra.ring
+import topology.algebra.ring.ideal
 
 /-!
 # Completion of topological rings:
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files endows the completion of a topological ring with a ring structure.
 More precisely the instance `uniform_space.completion.ring` builds a ring structure
 on the completion of a ring endowed with a compatible uniform structure in the sense of
 `uniform_add_group`. There is also a commutative version when the original ring is commutative.
+Moreover, if a topological ring is an algebra over a commutative semiring, then so is its
+`uniform_space.completion`.
 
 The last part of the file builds a ring structure on the biggest separated quotient of a ring.
 
@@ -25,6 +31,8 @@ the main constructions deal with continuous ring morphisms.
   to a complete separated group `S` to `completion R`.
 * `uniform_space.completion.map_ring_hom` : promotes a continuous ring morphism
   from `R` to `S` into a continuous ring morphism from `completion R` to `completion S`.
+
+TODO: Generalise the results here from the concrete `completion` to any `abstract_completion`.
 -/
 open classical set filter topological_space add_comm_group
 open_locale classical
@@ -98,6 +106,7 @@ instance : ring (completion α) :=
         (continuous.mul continuous_fst (continuous_snd.comp continuous_snd))
         (continuous.mul (continuous_fst.comp continuous_snd) (continuous_snd.comp continuous_snd))))
     (assume a b c, by rw [← coe_add, ← coe_mul, ← coe_mul, ← coe_mul, ←coe_add, add_mul]),
+  .. add_monoid_with_one.unary,
   ..completion.add_comm_group, ..completion.has_mul α, ..completion.has_one α }
 
 /-- The map from a uniform ring to its completion, as a ring homomorphism. -/
@@ -141,6 +150,33 @@ instance top_ring_compl : topological_ring (completion α) :=
 def map_ring_hom (hf : continuous f) : completion α →+* completion β :=
 extension_hom (coe_ring_hom.comp f) (continuous_coe_ring_hom.comp  hf)
 
+section algebra
+variables (A : Type*) [ring A] [uniform_space A] [uniform_add_group A] [topological_ring A]
+  (R : Type*) [comm_semiring R] [algebra R A] [has_uniform_continuous_const_smul R A]
+
+@[simp] lemma map_smul_eq_mul_coe (r : R) :
+  completion.map ((•) r) = (*) (algebra_map R A r : completion A) :=
+begin
+  ext x,
+  refine completion.induction_on x _ (λ a, _),
+  { exact is_closed_eq (completion.continuous_map) (continuous_mul_left _) },
+  { rw [map_coe (uniform_continuous_const_smul r) a, algebra.smul_def, coe_mul] },
+end
+
+instance : algebra R (completion A) :=
+{ commutes' := λ r x, completion.induction_on x
+    (is_closed_eq (continuous_mul_left _) (continuous_mul_right _)) $ λ a,
+      by simpa only [coe_mul] using congr_arg (coe : A → completion A) (algebra.commutes r a),
+  smul_def' := λ r x, congr_fun (map_smul_eq_mul_coe A R r) x,
+  ..((uniform_space.completion.coe_ring_hom : A →+* completion A).comp (algebra_map R A)) }
+
+lemma algebra_map_def (r : R) :
+  algebra_map R (completion A) r = (algebra_map R A r : completion A) :=
+rfl
+
+end algebra
+
+section comm_ring
 variables (R : Type*) [comm_ring R] [uniform_space R] [uniform_add_group R] [topological_ring R]
 
 instance : comm_ring (completion R) :=
@@ -150,8 +186,13 @@ instance : comm_ring (completion R) :=
       (assume a b, by rw [← coe_mul, ← coe_mul, mul_comm]),
  ..completion.ring }
 
-end uniform_space.completion
+ /-- A shortcut instance for the common case -/
+instance algebra' : algebra R (completion R) :=
+by apply_instance
 
+end comm_ring
+
+end uniform_space.completion
 
 namespace uniform_space
 variables {α : Type*}
@@ -188,3 +229,40 @@ begin
 end
 
 end uniform_space
+
+section uniform_extension
+
+variables {α : Type*} [uniform_space α] [semiring α]
+variables {β : Type*} [uniform_space β] [semiring β] [topological_semiring β]
+variables {γ : Type*} [uniform_space γ] [semiring γ] [topological_semiring γ]
+variables [t2_space γ] [complete_space γ]
+
+/-- The dense inducing extension as a ring homomorphism. -/
+noncomputable def dense_inducing.extend_ring_hom {i : α →+* β} {f : α →+* γ}
+  (ue : uniform_inducing i) (dr : dense_range i) (hf : uniform_continuous f):
+  β →+* γ :=
+  { to_fun := (ue.dense_inducing dr).extend f,
+    map_one' := by { convert dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous 1,
+      exacts [i.map_one.symm, f.map_one.symm], },
+    map_zero' := by { convert dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous 0,
+      exacts [i.map_zero.symm, f.map_zero.symm], },
+    map_add' :=
+    begin
+      have h := (uniform_continuous_uniformly_extend ue dr hf).continuous,
+      refine λ x y, dense_range.induction_on₂ dr _ (λ a b, _) x y,
+      { exact is_closed_eq (continuous.comp h continuous_add)
+        ((h.comp continuous_fst).add (h.comp continuous_snd)), },
+      { simp_rw [← i.map_add, dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous _,
+          ← f.map_add], },
+    end,
+    map_mul' :=
+    begin
+      have h := (uniform_continuous_uniformly_extend ue dr hf).continuous,
+      refine λ x y, dense_range.induction_on₂ dr _ (λ a b, _) x y,
+      { exact is_closed_eq (continuous.comp h continuous_mul)
+        ((h.comp continuous_fst).mul (h.comp continuous_snd)), },
+      { simp_rw [← i.map_mul, dense_inducing.extend_eq (ue.dense_inducing dr) hf.continuous _,
+          ← f.map_mul], },
+    end, }
+
+end uniform_extension
diff --git a/src/topology/algebra/valuation.lean b/src/topology/algebra/valuation.lean
index ee3fdd9f7cba4..a89243493d4c3 100644
--- a/src/topology/algebra/valuation.lean
+++ b/src/topology/algebra/valuation.lean
@@ -11,12 +11,15 @@ import ring_theory.valuation.basic
 /-!
 # The topology on a valued ring
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define the non archimedean topology induced by a valuation on a ring.
 The main definition is a `valued` type class which equips a ring with a valuation taking
 values in a group with zero. Other instances are then deduced from this.
 -/
 
-open_locale classical topological_space uniformity
+open_locale classical topology uniformity
 open set valuation
 noncomputable theory
 
@@ -102,7 +105,7 @@ structure. -/
 def mk' (v : valuation R Γ₀) : valued R Γ₀ :=
 { v := v,
   to_uniform_space := @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _,
-  to_uniform_add_group := @topological_add_group_is_uniform _ _ v.subgroups_basis.topology _,
+  to_uniform_add_group := @topological_add_comm_group_is_uniform _ _ v.subgroups_basis.topology _,
   is_topological_valuation :=
   begin
     letI := @topological_add_group.to_uniform_space R _ v.subgroups_basis.topology _,
diff --git a/src/topology/algebra/valued_field.lean b/src/topology/algebra/valued_field.lean
index f7623214b6efb..5d61bc738ed66 100644
--- a/src/topology/algebra/valued_field.lean
+++ b/src/topology/algebra/valued_field.lean
@@ -11,6 +11,9 @@ import topology.algebra.uniform_field
 /-!
 # Valued fields and their completions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we study the topology of a field `K` endowed with a valuation (in our application
 to adic spaces, `K` will be the valuation field associated to some valuation on a ring, defined in
 valuation.basic).
@@ -29,7 +32,7 @@ Then we extend the valuation given on `K` to a valuation on `hat K`.
 -/
 
 open filter set
-open_locale topological_space
+open_locale topology
 
 section division_ring
 
@@ -67,9 +70,9 @@ begin
   calc
     v (x⁻¹ - y⁻¹) = v (x⁻¹ * (y - x) * y⁻¹) : by rw decomp
     ... = (v x⁻¹) * (v $ y - x) * (v y⁻¹) : by repeat { rw valuation.map_mul }
-    ... = (v x)⁻¹ * (v $ y - x) * (v y)⁻¹ : by rw [v.map_inv, v.map_inv]
+    ... = (v x)⁻¹ * (v $ y - x) * (v y)⁻¹ : by rw [map_inv₀, map_inv₀]
     ... = (v $ y - x) * ((v y) * (v y))⁻¹ : by
-      { rw [mul_assoc, mul_comm, key, mul_assoc, mul_inv_rev₀] }
+      { rw [mul_assoc, mul_comm, key, mul_assoc, mul_inv_rev] }
     ... = (v $ y - x) * ((v y) * (v y))⁻¹ : rfl
     ... = (v $ x - y) * ((v y) * (v y))⁻¹ : by rw valuation.map_sub_swap
     ... < γ : hyp1',
@@ -114,26 +117,21 @@ begin
 end
 
 section
-local attribute [instance] linear_ordered_comm_group_with_zero.topological_space
 
+open_locale with_zero_topology
 open valued
 
 lemma valued.continuous_valuation [valued K Γ₀] : continuous (v : K → Γ₀) :=
 begin
   rw continuous_iff_continuous_at,
   intro x,
-  classical,
-  by_cases h : x = 0,
-  { rw h,
-    change tendsto _ _ (𝓝 (v (0 : K))),
-    erw valuation.map_zero,
-    rw linear_ordered_comm_group_with_zero.tendsto_zero,
-    intro γ,
-    rw valued.mem_nhds_zero,
-    use [γ, set.subset.refl _] },
-  { change tendsto _ _ _,
-    have v_ne : (v x : Γ₀) ≠ 0, from (valuation.ne_zero_iff _).mpr h,
-    rw linear_ordered_comm_group_with_zero.tendsto_of_ne_zero v_ne,
+  rcases eq_or_ne x 0 with rfl|h,
+  { rw [continuous_at, map_zero, with_zero_topology.tendsto_zero],
+    intros γ hγ,
+    rw [filter.eventually, valued.mem_nhds_zero],
+    use [units.mk0 γ hγ, subset.rfl] },
+  { have v_ne : (v x : Γ₀) ≠ 0, from (valuation.ne_zero_iff _).mpr h,
+    rw [continuous_at, with_zero_topology.tendsto_of_ne_zero v_ne],
     apply valued.loc_const v_ne },
 end
 end
@@ -198,7 +196,7 @@ instance completable : completable_top_field K :=
   end,
   ..valued_ring.separated }
 
-local attribute [instance] linear_ordered_comm_group_with_zero.topological_space
+open_locale with_zero_topology
 
 /-- The extension of the valuation of a valued field to the completion of the field. -/
 noncomputable def extension : hat K → Γ₀ :=
@@ -208,13 +206,10 @@ lemma continuous_extension : continuous (valued.extension : hat K → Γ₀) :=
  begin
   refine completion.dense_inducing_coe.continuous_extend _,
   intro x₀,
-  by_cases h : x₀ = coe 0,
+  rcases eq_or_ne x₀ 0 with rfl|h,
   { refine ⟨0, _⟩,
-    erw [h, ← completion.dense_inducing_coe.to_inducing.nhds_eq_comap]; try { apply_instance },
-    rw linear_ordered_comm_group_with_zero.tendsto_zero,
-    intro γ₀,
-    rw valued.mem_nhds,
-    exact ⟨γ₀, by simp⟩ },
+    erw [← completion.dense_inducing_coe.to_inducing.nhds_eq_comap],
+    exact valued.continuous_valuation.tendsto' 0 0 (map_zero v) },
   { have preimage_one : v ⁻¹' {(1 : Γ₀)} ∈ 𝓝 (1 : K),
     { have : (v (1 : K) : Γ₀) ≠ 0, { rw valuation.map_one, exact zero_ne_one.symm },
       convert valued.loc_const this,
@@ -263,27 +258,24 @@ lemma continuous_extension : continuous (valued.extension : hat K → Γ₀) :=
     rcases this with ⟨z₀, y₀, y₀_in, hz₀, z₀_ne⟩,
     have vz₀_ne: (v z₀ : Γ₀) ≠ 0 := by rwa valuation.ne_zero_iff,
     refine ⟨v z₀, _⟩,
-    rw [linear_ordered_comm_group_with_zero.tendsto_of_ne_zero vz₀_ne, mem_comap],
-    use [(λ x, x*x₀) '' V', nhds_right],
-    intros x x_in,
-    rcases mem_preimage.1 x_in with ⟨y, y_in, hy⟩, clear x_in,
-    change y*x₀ = coe x at hy,
-    have : (v (x*z₀⁻¹) : Γ₀) = 1,
+    rw [with_zero_topology.tendsto_of_ne_zero vz₀_ne, eventually_comap],
+    filter_upwards [nhds_right] with x x_in a ha,
+    rcases x_in with ⟨y, y_in, rfl⟩,
+    have : (v (a * z₀⁻¹) : Γ₀) = 1,
     { apply hV,
       have : ((z₀⁻¹ : K) : hat K) = z₀⁻¹,
-      from ring_hom.map_inv (completion.coe_ring_hom : K →+* hat K) z₀,
-      rw [completion.coe_mul, this, ← hy, hz₀, mul_inv₀, mul_comm y₀⁻¹, ← mul_assoc, mul_assoc y,
+      from map_inv₀ (completion.coe_ring_hom : K →+* hat K) z₀,
+      rw [completion.coe_mul, this, ha, hz₀, mul_inv, mul_comm y₀⁻¹, ← mul_assoc, mul_assoc y,
           mul_inv_cancel h, mul_one],
       solve_by_elim },
-    calc v x = v (x*z₀⁻¹*z₀) : by rw [mul_assoc, inv_mul_cancel z₀_ne, mul_one]
-         ... = v (x*z₀⁻¹)*v z₀ : valuation.map_mul _ _ _
+    calc v a = v (a * z₀⁻¹ * z₀) : by rw [mul_assoc, inv_mul_cancel z₀_ne, mul_one]
+         ... = v (a * z₀⁻¹) * v z₀ : valuation.map_mul _ _ _
          ... = v z₀ : by rw [this, one_mul]  },
 end
 
 @[simp, norm_cast]
 lemma extension_extends (x : K) : extension (x : hat K) = v x :=
 begin
-  haveI : t2_space Γ₀ := regular_space.t2_space _,
   refine completion.dense_inducing_coe.extend_eq_of_tendsto _,
   rw ← completion.dense_inducing_coe.nhds_eq_comap,
   exact valued.continuous_valuation.continuous_at,
@@ -337,7 +329,7 @@ begin
     { exact this h, }, },
   intros h,
   have hγ₀ : extension ⁻¹' {γ₀} ∈ 𝓝 x := continuous_extension.continuous_at.preimage_mem_nhds
-    (linear_ordered_comm_group_with_zero.singleton_mem_nhds_of_ne_zero h),
+    (with_zero_topology.singleton_mem_nhds_of_ne_zero h),
   rw mem_closure_iff_nhds',
   refine ⟨λ hx, _, λ hx s hs, _⟩,
   { obtain ⟨⟨-, y, hy₁ : v y < (γ : Γ₀), rfl⟩, hy₂⟩ := hx _ hγ₀,
@@ -360,4 +352,7 @@ noncomputable instance valued_completion : valued (hat K) Γ₀ :=
     exact (has_basis_nhds_zero K Γ₀).has_basis_of_dense_inducing completion.dense_inducing_coe,
   end }
 
+@[simp, norm_cast] lemma valued_completion_apply (x : K) : valued.v (x : hat K) = v x :=
+extension_extends x
+
 end valued
diff --git a/src/topology/algebra/with_zero_topology.lean b/src/topology/algebra/with_zero_topology.lean
index a7589975c91ae..4c793959b3aad 100644
--- a/src/topology/algebra/with_zero_topology.lean
+++ b/src/topology/algebra/with_zero_topology.lean
@@ -4,21 +4,23 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot
 -/
 import algebra.order.with_zero
-import topology.algebra.order.basic
+import topology.algebra.order.field
 
 /-!
 # The topology on linearly ordered commutative groups with zero
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Let `Γ₀` be a linearly ordered commutative group to which we have adjoined a zero element.
 Then `Γ₀` may naturally be endowed with a topology that turns `Γ₀` into a topological monoid.
 Neighborhoods of zero are sets containing `{γ | γ < γ₀}` for some invertible element `γ₀`
 and every invertible element is open.
 In particular the topology is the following:
 "a subset `U ⊆ Γ₀` is open if `0 ∉ U` or if there is an invertible
-`γ₀ ∈ Γ₀ such that {γ | γ < γ₀} ⊆ U`", but this fact is not proven here since the neighborhoods
-description is what is actually useful.
+`γ₀ ∈ Γ₀` such that `{γ | γ < γ₀} ⊆ U`", see `linear_ordered_comm_group_with_zero.is_open_iff`.
 
-We prove this topology is ordered and regular (in addition to be compatible with the monoid
+We prove this topology is ordered and T₃ (in addition to be compatible with the monoid
 structure).
 
 All this is useful to extend a valuation to a completion. This is an abstract version of how the
@@ -26,260 +28,167 @@ absolute value (resp. `p`-adic absolute value) on `ℚ` is extended to `ℝ` (re
 
 ## Implementation notes
 
-This topology is not defined as an instance since it may not be the desired topology on
-a linearly ordered commutative group with zero. You can locally activate this topology using
-`local attribute [instance] linear_ordered_comm_group_with_zero.topological_space`
-All other instances will (`ordered_topology`, `regular_space`, `has_continuous_mul`) then follow.
-
+This topology is not defined as a global instance since it may not be the desired topology on a
+linearly ordered commutative group with zero. You can locally activate this topology using
+`open_locale with_zero_topology`.
 -/
 
-open_locale topological_space
-open topological_space filter set
-
-namespace linear_ordered_comm_group_with_zero
+open_locale topology filter
+open topological_space filter set function
 
-variables (Γ₀ : Type*) [linear_ordered_comm_group_with_zero Γ₀]
+namespace with_zero_topology
 
-/-- The neighbourhoods around γ ∈ Γ₀, used in the definition of the topology on Γ₀.
-These neighbourhoods are defined as follows:
-A set s is a neighbourhood of 0 if there is an invertible γ₀ ∈ Γ₀ such that {γ | γ < γ₀} ⊆ s.
-If γ ≠ 0, then every set that contains γ is a neighbourhood of γ. -/
-def nhds_fun (x : Γ₀) : filter Γ₀ :=
-if x = 0 then ⨅ (γ₀ : Γ₀ˣ), principal {γ | γ < γ₀} else pure x
+variables {α Γ₀ : Type*} [linear_ordered_comm_group_with_zero Γ₀] {γ γ₁ γ₂ : Γ₀} {l : filter α}
+  {f : α → Γ₀}
 
 /-- The topology on a linearly ordered commutative group with a zero element adjoined.
 A subset U is open if 0 ∉ U or if there is an invertible element γ₀ such that {γ | γ < γ₀} ⊆ U. -/
 protected def topological_space : topological_space Γ₀ :=
-topological_space.mk_of_nhds (nhds_fun Γ₀)
+topological_space.mk_of_nhds $ update pure 0 $ ⨅ γ ≠ 0, 𝓟 (Iio γ)
 
-local attribute [instance] linear_ordered_comm_group_with_zero.topological_space
+localized "attribute [instance] with_zero_topology.topological_space" in with_zero_topology
 
-/-- The neighbourhoods {γ | γ < γ₀} of 0 form a directed set indexed by the invertible
-elements γ₀. -/
-lemma directed_lt : directed (≥) (λ γ₀ : Γ₀ˣ, principal {γ : Γ₀ | γ < γ₀}) :=
-begin
-  intros γ₁ γ₂,
-  use linear_order.min γ₁ γ₂ ; dsimp only,
-  split ; rw [ge_iff_le, principal_mono] ; intros x x_in,
-  { calc x < ↑(linear_order.min γ₁ γ₂) : x_in
-        ... ≤ γ₁ : min_le_left γ₁ γ₂ },
-  { calc x < ↑(linear_order.min γ₁ γ₂) : x_in
-        ... ≤ γ₂ : min_le_right γ₁ γ₂ }
-end
+lemma nhds_eq_update : (𝓝 : Γ₀ → filter Γ₀) = update pure 0 (⨅ γ ≠ 0, 𝓟 (Iio γ)) :=
+funext $ nhds_mk_of_nhds_single $ le_infi₂ $ λ γ h₀, le_principal_iff.2 $ zero_lt_iff.2 h₀
 
--- We need two auxilliary lemmas to show that nhds_fun accurately describes the neighbourhoods
--- coming from the topology (that is defined in terms of nhds_fun).
+/-!
+### Neighbourhoods of zero
+-/
 
-/-- At all points of a linearly ordered commutative group with a zero element adjoined,
-the pure filter is smaller than the filter given by nhds_fun. -/
-lemma pure_le_nhds_fun : pure ≤ nhds_fun Γ₀ :=
-λ x, by { by_cases hx : x = 0; simp [hx, nhds_fun] }
+lemma nhds_zero : 𝓝 (0 : Γ₀) = ⨅ γ ≠ 0, 𝓟 (Iio γ) := by rw [nhds_eq_update, update_same]
 
-/-- For every point Γ₀, and every “neighbourhood” s of it (described by nhds_fun), there is a
-smaller “neighbourhood” t ⊆ s, such that s is a “neighbourhood“ of all the points in t. -/
-lemma nhds_fun_ok (x : Γ₀) {s} (s_in : s ∈ nhds_fun Γ₀ x) :
-  (∃ t ∈ nhds_fun Γ₀ x, t ⊆ s ∧ ∀ y ∈ t, s ∈ nhds_fun Γ₀ y) :=
+/-- In a linearly ordered group with zero element adjoined, `U` is a neighbourhood of `0` if and
+only if there exists a nonzero element `γ₀` such that `Iio γ₀ ⊆ U`. -/
+lemma has_basis_nhds_zero : (𝓝 (0 : Γ₀)).has_basis (λ γ : Γ₀, γ ≠ 0) Iio :=
 begin
-  by_cases hx : x = 0,
-  { simp only [hx, nhds_fun, exists_prop, if_true, eq_self_iff_true] at s_in ⊢,
-    cases (mem_infi_of_directed (directed_lt Γ₀) _).mp s_in with γ₀ h,
-    use {γ : Γ₀ | γ < γ₀},
-    rw mem_principal at h,
-    split,
-    { apply mem_infi_of_mem γ₀,
-      rw mem_principal },
-    { refine ⟨h, λ y y_in, _⟩,
-      by_cases hy : y = 0,
-      { simp only [hy, if_true, eq_self_iff_true],
-        apply mem_infi_of_mem γ₀,
-        rwa mem_principal },
-      { simp [hy, h y_in] } } },
-  { simp only [hx, nhds_fun, exists_prop, if_false, mem_pure] at s_in ⊢,
-    refine ⟨{x}, mem_singleton _, singleton_subset_iff.2 s_in, λ y y_in, _⟩,
-    simpa [mem_singleton_iff.mp y_in, hx] }
+  rw [nhds_zero],
+  refine has_basis_binfi_principal _ ⟨1, one_ne_zero⟩,
+  exact directed_on_iff_directed.2 (directed_of_inf $ λ a b hab, Iio_subset_Iio hab)
 end
 
-variables  {Γ₀}
+lemma Iio_mem_nhds_zero (hγ : γ ≠ 0) : Iio γ ∈ 𝓝 (0 : Γ₀) := has_basis_nhds_zero.mem_of_mem hγ
 
-/-- The neighbourhood filter of an invertible element consists of all sets containing that
-element. -/
-lemma nhds_coe_units (γ : Γ₀ˣ) : 𝓝 (γ : Γ₀) = pure (γ : Γ₀) :=
-calc 𝓝 (γ : Γ₀) = nhds_fun Γ₀ γ : nhds_mk_of_nhds (nhds_fun Γ₀) γ (pure_le_nhds_fun Γ₀)
-                                                   (nhds_fun_ok Γ₀)
-              ... = pure (γ : Γ₀) : if_neg γ.ne_zero
+/-- If `γ` is an invertible element of a linearly ordered group with zero element adjoined, then
+`Iio (γ : Γ₀)` is a neighbourhood of `0`. -/
+lemma nhds_zero_of_units (γ : Γ₀ˣ) : Iio ↑γ ∈ 𝓝 (0 : Γ₀) := Iio_mem_nhds_zero γ.ne_zero
+
+lemma tendsto_zero : tendsto f l (𝓝 (0 : Γ₀)) ↔ ∀ γ₀ ≠ 0, ∀ᶠ x in l, f x < γ₀ := by simp [nhds_zero]
+
+/-!
+### Neighbourhoods of non-zero elements
+-/
 
 /-- The neighbourhood filter of a nonzero element consists of all sets containing that
 element. -/
-@[simp] lemma nhds_of_ne_zero (γ : Γ₀) (h : γ ≠ 0) :
-  𝓝 γ = pure γ :=
-nhds_coe_units (units.mk0 _ h)
-
-/-- If γ is an invertible element of a linearly ordered group with zero element adjoined,
-then {γ} is a neighbourhood of γ. -/
-lemma singleton_nhds_of_units (γ : Γ₀ˣ) : ({γ} : set Γ₀) ∈ 𝓝 (γ : Γ₀) :=
-by simp
-
-/-- If γ is a nonzero element of a linearly ordered group with zero element adjoined,
-then {γ} is a neighbourhood of γ. -/
-lemma singleton_nhds_of_ne_zero (γ : Γ₀) (h : γ ≠ 0) : ({γ} : set Γ₀) ∈ 𝓝 (γ : Γ₀) :=
-by simp [h]
-
-/-- If U is a neighbourhood of 0 in a linearly ordered group with zero element adjoined,
-then there exists an invertible element γ₀ such that {γ | γ < γ₀} ⊆ U. -/
-lemma has_basis_nhds_zero :
-  has_basis (𝓝 (0 : Γ₀)) (λ _, true) (λ γ₀ : Γ₀ˣ, {γ : Γ₀ | γ < γ₀}) :=
-⟨begin
-  intro U,
-  rw nhds_mk_of_nhds (nhds_fun Γ₀) 0 (pure_le_nhds_fun Γ₀) (nhds_fun_ok Γ₀),
-  simp only [nhds_fun, if_true, eq_self_iff_true, exists_true_left],
-  simp_rw [mem_infi_of_directed (directed_lt Γ₀), mem_principal]
-end⟩
+@[simp] lemma nhds_of_ne_zero {γ : Γ₀} (h₀ : γ ≠ 0) : 𝓝 γ = pure γ :=
+by rw [nhds_eq_update, update_noteq h₀]
 
-/-- If γ is an invertible element of a linearly ordered group with zero element adjoined,
-then {x | x < γ} is a neighbourhood of 0. -/
-lemma nhds_zero_of_units (γ : Γ₀ˣ) : {x : Γ₀ | x < γ} ∈ 𝓝 (0 : Γ₀) :=
-by { rw has_basis_nhds_zero.mem_iff, use γ, simp }
+/-- The neighbourhood filter of an invertible element consists of all sets containing that
+element. -/
+lemma nhds_coe_units (γ : Γ₀ˣ) : 𝓝 (γ : Γ₀) = pure (γ : Γ₀) := nhds_of_ne_zero γ.ne_zero
+
+/-- If `γ` is an invertible element of a linearly ordered group with zero element adjoined, then
+`{γ}` is a neighbourhood of `γ`. -/
+lemma singleton_mem_nhds_of_units (γ : Γ₀ˣ) : ({γ} : set Γ₀) ∈ 𝓝 (γ : Γ₀) := by simp
 
-lemma tendsto_zero {α : Type*} {F : filter α} {f : α → Γ₀} :
-  tendsto f F (𝓝 (0 : Γ₀)) ↔ ∀ γ₀ : Γ₀ˣ, { x : α | f x < γ₀ } ∈ F :=
-by simpa using has_basis_nhds_zero.tendsto_right_iff
+/-- If `γ` is a nonzero element of a linearly ordered group with zero element adjoined, then `{γ}`
+is a neighbourhood of `γ`. -/
+lemma singleton_mem_nhds_of_ne_zero (h : γ ≠ 0) : ({γ} : set Γ₀) ∈ 𝓝 (γ : Γ₀) := by simp [h]
 
-/-- If γ is a nonzero element of a linearly ordered group with zero element adjoined,
-then {x | x < γ} is a neighbourhood of 0. -/
-lemma nhds_zero_of_ne_zero (γ : Γ₀) (h : γ ≠ 0) : {x : Γ₀ | x < γ} ∈ 𝓝 (0 : Γ₀) :=
-nhds_zero_of_units (units.mk0 _ h)
+lemma has_basis_nhds_of_ne_zero {x : Γ₀} (h : x ≠ 0) :
+  has_basis (𝓝 x) (λ i : unit, true) (λ i, {x}) :=
+by { rw [nhds_of_ne_zero h], exact has_basis_pure _ }
 
 lemma has_basis_nhds_units (γ : Γ₀ˣ) :
   has_basis (𝓝 (γ : Γ₀)) (λ i : unit, true) (λ i, {γ}) :=
-begin
-  rw nhds_of_ne_zero _ γ.ne_zero,
-  exact has_basis_pure γ
-end
+has_basis_nhds_of_ne_zero γ.ne_zero
 
-lemma has_basis_nhds_of_ne_zero {x : Γ₀} (h : x ≠ 0) :
-  has_basis (𝓝 x) (λ i : unit, true) (λ i, {x}) :=
-has_basis_nhds_units (units.mk0 x h)
+lemma tendsto_of_ne_zero {γ : Γ₀} (h : γ ≠ 0) : tendsto f l (𝓝 γ) ↔ ∀ᶠ x in l, f x = γ :=
+by rw [nhds_of_ne_zero h, tendsto_pure]
 
-lemma singleton_mem_nhds_of_ne_zero {x : Γ₀} (h : x ≠ 0) : {x} ∈ 𝓝 x :=
-begin
-  apply (has_basis_nhds_of_ne_zero h).mem_of_mem true.intro,
-  exact unit.star,
-end
+lemma tendsto_units {γ₀ : Γ₀ˣ} : tendsto f l (𝓝 (γ₀ : Γ₀)) ↔ ∀ᶠ x in l, f x = γ₀ :=
+tendsto_of_ne_zero γ₀.ne_zero
+
+lemma Iio_mem_nhds (h : γ₁ < γ₂) : Iio γ₂ ∈ 𝓝 γ₁ :=
+by rcases eq_or_ne γ₁ 0 with rfl|h₀; simp [*, h.ne', Iio_mem_nhds_zero]
+
+/-!
+### Open/closed sets
+-/
 
-lemma tendsto_units {α : Type*} {F : filter α} {f : α → Γ₀} {γ₀ : Γ₀ˣ} :
-  tendsto f F (𝓝 (γ₀ : Γ₀)) ↔ { x : α | f x = γ₀ } ∈ F :=
+lemma is_open_iff {s : set Γ₀} : is_open s ↔ (0 : Γ₀) ∉ s ∨ ∃ γ ≠ 0, Iio γ ⊆ s :=
 begin
-  rw (has_basis_nhds_units γ₀).tendsto_right_iff,
-  simpa
+  rw [is_open_iff_mem_nhds, ← and_forall_ne (0 : Γ₀)],
+  simp [nhds_of_ne_zero, imp_iff_not_or, has_basis_nhds_zero.mem_iff] { contextual := tt }
 end
 
-lemma tendsto_of_ne_zero {α : Type*} {F : filter α} {f : α → Γ₀} {γ : Γ₀} (h : γ ≠ 0) :
-  tendsto f F (𝓝 γ) ↔ { x : α | f x = γ } ∈ F :=
-@tendsto_units _ _ _ F f (units.mk0 γ h)
+lemma is_closed_iff {s : set Γ₀} : is_closed s ↔ (0 : Γ₀) ∈ s ∨ ∃ γ ≠ 0, s ⊆ Ici γ :=
+by simp only [← is_open_compl_iff, is_open_iff, mem_compl_iff, not_not, ← compl_Ici,
+  compl_subset_compl]
 
-variable (Γ₀)
+lemma is_open_Iio {a : Γ₀} : is_open (Iio a) :=
+is_open_iff.mpr $ imp_iff_not_or.mp $ λ ha, ⟨a, ne_of_gt ha, subset.rfl⟩
 
-/-- The topology on a linearly ordered group with zero element adjoined
-is compatible with the order structure. -/
-@[priority 100]
-instance ordered_topology : order_closed_topology Γ₀ :=
+/-!
+### Instances
+-/
+
+/-- The topology on a linearly ordered group with zero element adjoined is compatible with the order
+structure: the set `{p : Γ₀ × Γ₀ | p.1 ≤ p.2}` is closed. -/
+protected lemma order_closed_topology : order_closed_topology Γ₀ :=
 { is_closed_le' :=
   begin
-    rw ← is_open_compl_iff,
-    show is_open {p : Γ₀ × Γ₀ | ¬p.fst ≤ p.snd},
-    simp only [not_le],
-    rw is_open_iff_mem_nhds,
-    rintros ⟨a,b⟩ hab,
-    change b < a at hab,
-    have ha : a ≠ 0 := ne_zero_of_lt hab,
-    rw [nhds_prod_eq, mem_prod_iff],
-    by_cases hb : b = 0,
-    { subst b,
-      use [{a}, singleton_nhds_of_ne_zero _ ha, {x : Γ₀ | x < a}, nhds_zero_of_ne_zero _ ha],
-      intros p p_in,
-      cases mem_prod.1 p_in with h1 h2,
-      rw mem_singleton_iff at h1,
-      change p.2 < p.1,
-      rwa h1 },
-    { use [{a}, singleton_nhds_of_ne_zero _ ha, {b}, singleton_nhds_of_ne_zero _ hb],
-      intros p p_in,
-      cases mem_prod.1 p_in with h1 h2,
-      rw mem_singleton_iff at h1 h2,
-      change p.2 < p.1,
-      rwa [h1, h2] }
+    simp only [← is_open_compl_iff, compl_set_of, not_le, is_open_iff_mem_nhds],
+    rintros ⟨a, b⟩ (hab : b < a),
+    rw [nhds_prod_eq, nhds_of_ne_zero (zero_le'.trans_lt hab).ne', pure_prod],
+    exact Iio_mem_nhds hab
   end }
 
-/-- The topology on a linearly ordered group with zero element adjoined is T₃ (aka regular). -/
-@[priority 100]
-instance regular_space : regular_space Γ₀ :=
-begin
-  haveI : t1_space Γ₀ := t2_space.t1_space,
-  split,
-  intros s x s_closed x_not_in_s,
-  by_cases hx : x = 0,
-  { refine ⟨s, _, subset.rfl, _⟩,
-    { subst x,
-      rw is_open_iff_mem_nhds,
-      intros y hy,
-      by_cases hy' : y = 0, { subst y, contradiction },
-      simpa [hy'] },
-    { erw inf_eq_bot_iff,
-      use sᶜ,
-      simp only [exists_prop, mem_principal],
-      exact ⟨s_closed.compl_mem_nhds x_not_in_s, ⟨s, subset.refl s, by simp⟩⟩ } },
-  { simp only [nhds_within, inf_eq_bot_iff, exists_prop, mem_principal],
-    exact ⟨{x}ᶜ, is_open_compl_iff.mpr is_closed_singleton, by rwa subset_compl_singleton_iff,
-           {x}, singleton_nhds_of_ne_zero x hx, {x}ᶜ, by simp [subset.refl]⟩ }
-end
+localized "attribute [instance] with_zero_topology.order_closed_topology" in with_zero_topology
+
+/-- The topology on a linearly ordered group with zero element adjoined is T₃. -/
+lemma t3_space : t3_space Γ₀ :=
+{ to_regular_space := regular_space.of_lift'_closure $ λ γ,
+    begin
+      rcases ne_or_eq γ 0 with h₀|rfl,
+      { rw [nhds_of_ne_zero h₀, lift'_pure (monotone_closure Γ₀), closure_singleton,
+          principal_singleton] },
+      { exact has_basis_nhds_zero.lift'_closure_eq_self
+        (λ x hx, is_closed_iff.2 $ or.inl $ zero_lt_iff.2 hx) },
+    end }
+
+localized "attribute [instance] with_zero_topology.t3_space" in with_zero_topology
 
 /-- The topology on a linearly ordered group with zero element adjoined makes it a topological
 monoid. -/
-@[priority 100]
-instance : has_continuous_mul Γ₀ :=
+protected lemma has_continuous_mul : has_continuous_mul Γ₀ :=
 ⟨begin
-  have common : ∀ y ≠ (0 : Γ₀), continuous_at (λ (p : Γ₀ × Γ₀), p.fst * p.snd) (0, y),
-  { intros y hy,
-    set γ := units.mk0 y hy,
-    suffices : tendsto (λ (p : Γ₀ × Γ₀), p.fst * p.snd) ((𝓝 0).prod (𝓝 γ)) (𝓝 0),
-    by simpa [continuous_at, nhds_prod_eq],
-    suffices : ∀ (γ' : Γ₀ˣ), ∃ (γ''  : Γ₀ˣ), ∀ (a b : Γ₀), a < γ'' → b = y → a * b < γ',
-    { rw (has_basis_nhds_zero.prod $ has_basis_nhds_units γ).tendsto_iff has_basis_nhds_zero,
-      simpa },
-    intros γ',
-    use γ⁻¹*γ',
-    rintros a b ha hb,
-    rw [hb, mul_comm],
-    rw [units.coe_mul] at ha,
-    simpa using inv_mul_lt_of_lt_mul₀ ha },
   rw continuous_iff_continuous_at,
   rintros ⟨x, y⟩,
-  by_cases hx : x = 0; by_cases hy : y = 0,
-  { suffices : tendsto (λ (p : Γ₀ × Γ₀), p.fst * p.snd) (𝓝 (0, 0)) (𝓝 0),
-    by simpa [hx, hy, continuous_at],
-    suffices : ∀ (γ : Γ₀ˣ), ∃ (γ' : Γ₀ˣ), ∀ (a b : Γ₀), a < γ' → b < γ' → a * b < γ,
-    by simpa [nhds_prod_eq, has_basis_nhds_zero.prod_self.tendsto_iff has_basis_nhds_zero],
-    intros γ,
-    rcases exists_square_le γ with ⟨γ', h⟩,
-    use γ',
-    intros a b ha hb,
-    calc a*b < γ'*γ' : mul_lt_mul₀ ha hb
-    ... ≤ γ : by exact_mod_cast h },
-  { rw hx,
-    exact common y hy },
-  { rw hy,
-    have : (λ (p : Γ₀ × Γ₀), p.fst * p.snd) =
-           (λ (p : Γ₀ × Γ₀), p.fst * p.snd) ∘ (λ p : Γ₀ × Γ₀, (p.2, p.1)),
-    by { ext, rw [mul_comm] },
-    rw this,
-    apply continuous_at.comp _ continuous_swap.continuous_at,
-    exact common x hx },
-  { change tendsto _ _ _,
-    rw [nhds_prod_eq],
-    rw ((has_basis_nhds_of_ne_zero hx).prod (has_basis_nhds_of_ne_zero hy)).tendsto_iff
-       (has_basis_nhds_of_ne_zero $ mul_ne_zero hx hy),
-    suffices : ∀ (a b : Γ₀), a = x → b = y → a * b = x * y, by simpa,
-    rintros a b rfl rfl,
-    refl },
+  wlog hle : x ≤ y generalizing x y,
+  { have := tendsto.comp (this y x (le_of_not_le hle)) (continuous_swap.tendsto (x,y)),
+    simpa only [mul_comm, function.comp, prod.swap], },
+  rcases eq_or_ne x 0 with rfl|hx; [rcases eq_or_ne y 0 with rfl|hy, skip],
+  { rw [continuous_at, zero_mul],
+    refine ((has_basis_nhds_zero.prod_nhds has_basis_nhds_zero).tendsto_iff has_basis_nhds_zero).2
+      (λ γ hγ, ⟨(γ, 1), ⟨hγ, one_ne_zero⟩, _⟩),
+    rintro ⟨x, y⟩ ⟨hx : x < γ, hy : y < 1⟩,
+    exact (mul_lt_mul₀ hx hy).trans_eq (mul_one γ) },
+  { rw [continuous_at, zero_mul, nhds_prod_eq, nhds_of_ne_zero hy, prod_pure, tendsto_map'_iff],
+    refine (has_basis_nhds_zero.tendsto_iff has_basis_nhds_zero).2 (λ γ hγ, _),
+    refine ⟨γ / y, div_ne_zero hγ hy, λ x hx, _⟩,
+    calc x * y < γ / y * y : mul_lt_right₀ _ hx hy
+           ... = γ         : div_mul_cancel _ hy },
+  { have hy : y ≠ 0, from ((zero_lt_iff.mpr hx).trans_le hle).ne',
+    rw [continuous_at, nhds_prod_eq, nhds_of_ne_zero hx, nhds_of_ne_zero hy, prod_pure_pure],
+    exact pure_le_nhds (x * y) }
 end⟩
 
-end linear_ordered_comm_group_with_zero
+localized "attribute [instance] with_zero_topology.has_continuous_mul" in with_zero_topology
+
+protected lemma has_continuous_inv₀ : has_continuous_inv₀ Γ₀ :=
+⟨λ γ h, by { rw [continuous_at, nhds_of_ne_zero h], exact pure_le_nhds γ⁻¹ }⟩
+
+localized "attribute [instance] with_zero_topology.has_continuous_inv₀" in with_zero_topology
+
+end with_zero_topology
diff --git a/src/topology/bases.lean b/src/topology/bases.lean
index 7c83edd7206ab..81f4a211ad817 100644
--- a/src/topology/bases.lean
+++ b/src/topology/bases.lean
@@ -9,6 +9,9 @@ import topology.continuous_on
 /-!
 # Bases of topologies. Countability axioms.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A topological basis on a topological space `t` is a collection of sets,
 such that all open sets can be generated as unions of these sets, without the need to take
 finite intersections of them. This file introduces a framework for dealing with these collections,
@@ -46,7 +49,7 @@ More fine grained instances for `first_countable_topology`, `separable_space`, `
 -/
 
 open set filter function
-open_locale topological_space filter
+open_locale topology filter
 noncomputable theory
 
 namespace topological_space
@@ -63,28 +66,45 @@ structure is_topological_basis (s : set (set α)) : Prop :=
 (sUnion_eq : (⋃₀ s) = univ)
 (eq_generate_from : t = generate_from s)
 
-/-- If a family of sets `s` generates the topology, then nonempty intersections of finite
+lemma is_topological_basis.insert_empty {s : set (set α)} (h : is_topological_basis s) :
+  is_topological_basis (insert ∅ s) :=
+begin
+  refine ⟨_, by rw [sUnion_insert, empty_union, h.sUnion_eq], _⟩,
+  { rintro t₁ (rfl|h₁) t₂ (rfl|h₂) x ⟨hx₁, hx₂⟩, {cases hx₁}, {cases hx₁}, {cases hx₂},
+    obtain ⟨t₃, h₃, hs⟩ := h.exists_subset_inter _ h₁ _ h₂ x ⟨hx₁, hx₂⟩,
+    exact ⟨t₃, or.inr h₃, hs⟩ },
+  { rw h.eq_generate_from,
+    refine le_antisymm (le_generate_from $ λ t, _) (generate_from_anti $ subset_insert ∅ s),
+    rintro (rfl|ht), { convert is_open_empty }, { exact generate_open.basic t ht } },
+end
+
+lemma is_topological_basis.diff_empty {s : set (set α)} (h : is_topological_basis s) :
+  is_topological_basis (s \ {∅}) :=
+begin
+  refine ⟨_, by rw [sUnion_diff_singleton_empty, h.sUnion_eq], _⟩,
+  { rintro t₁ ⟨h₁, -⟩ t₂ ⟨h₂, -⟩ x hx,
+    obtain ⟨t₃, h₃, hs⟩ := h.exists_subset_inter _ h₁ _ h₂ x hx,
+    exact ⟨t₃, ⟨h₃, nonempty.ne_empty ⟨x, hs.1⟩⟩, hs⟩ },
+  { rw h.eq_generate_from,
+    refine le_antisymm (generate_from_anti $ diff_subset s _) (le_generate_from $ λ t ht, _),
+    obtain rfl|he := eq_or_ne t ∅, { convert is_open_empty },
+    exact generate_open.basic t ⟨ht, he⟩ },
+end
+
+/-- If a family of sets `s` generates the topology, then intersections of finite
 subcollections of `s` form a topological basis. -/
 lemma is_topological_basis_of_subbasis {s : set (set α)} (hs : t = generate_from s) :
-  is_topological_basis ((λ f, ⋂₀ f) '' {f : set (set α) | finite f ∧ f ⊆ s ∧ (⋂₀ f).nonempty}) :=
+  is_topological_basis ((λ f, ⋂₀ f) '' {f : set (set α) | f.finite ∧ f ⊆ s}) :=
 begin
-  refine ⟨_, _, _⟩,
-  { rintro _ ⟨t₁, ⟨hft₁, ht₁b, ht₁⟩, rfl⟩ _ ⟨t₂, ⟨hft₂, ht₂b, ht₂⟩, rfl⟩ x h,
-    have : ⋂₀ (t₁ ∪ t₂) = ⋂₀ t₁ ∩ ⋂₀ t₂ := sInter_union t₁ t₂,
-    exact ⟨_, ⟨t₁ ∪ t₂, ⟨hft₁.union hft₂, union_subset ht₁b ht₂b, this.symm ▸ ⟨x, h⟩⟩, this⟩, h,
-      subset.rfl⟩ },
+  refine ⟨_, _, hs.trans (le_antisymm (le_generate_from _) $ generate_from_anti $ λ t ht, _)⟩,
+  { rintro _ ⟨t₁, ⟨hft₁, ht₁b⟩, rfl⟩ _ ⟨t₂, ⟨hft₂, ht₂b⟩, rfl⟩ x h,
+    exact ⟨_, ⟨_, ⟨hft₁.union hft₂, union_subset ht₁b ht₂b⟩, sInter_union t₁ t₂⟩, h, subset.rfl⟩ },
   { rw [sUnion_image, Union₂_eq_univ_iff],
-    intro x, have : x ∈ ⋂₀ ∅, { rw sInter_empty, exact mem_univ x },
-    exact ⟨∅, ⟨finite_empty, empty_subset _, x, this⟩, this⟩ },
-  { rw hs,
-    apply le_antisymm; apply le_generate_from,
-    { rintro _ ⟨t, ⟨hft, htb, ht⟩, rfl⟩,
-      exact @is_open_sInter _ (generate_from s) _ hft (λ s hs, generate_open.basic _ $ htb hs) },
-    { intros t ht,
-      rcases t.eq_empty_or_nonempty with rfl|hne, { apply @is_open_empty _ _ },
-      rw ← sInter_singleton t at hne ⊢,
-      exact generate_open.basic _ ⟨{t}, ⟨finite_singleton t, singleton_subset_iff.2 ht, hne⟩,
-        rfl⟩ } }
+    exact λ x, ⟨∅, ⟨finite_empty, empty_subset _⟩, sInter_empty.substr $ mem_univ x⟩ },
+  { rintro _ ⟨t, ⟨hft, htb⟩, rfl⟩, apply is_open_sInter,
+    exacts [hft, λ s hs, generate_open.basic _ $ htb hs] },
+  { rw ← sInter_singleton t,
+    exact ⟨{t}, ⟨finite_singleton t, singleton_subset_iff.2 ht⟩, rfl⟩ },
 end
 
 /-- If a family of open sets `s` is such that every open neighbourhood contains some
@@ -156,6 +176,11 @@ lemma is_topological_basis.open_eq_sUnion {B : set (set α)}
   ∃ S ⊆ B, u = ⋃₀ S :=
 ⟨{s ∈ B | s ⊆ u}, λ s h, h.1, hB.open_eq_sUnion' ou⟩
 
+lemma is_topological_basis.open_iff_eq_sUnion {B : set (set α)}
+  (hB : is_topological_basis B) {u : set α} :
+  is_open u ↔ ∃ S ⊆ B, u = ⋃₀ S :=
+⟨hB.open_eq_sUnion, λ ⟨S, hSB, hu⟩, hu.symm ▸ is_open_sUnion (λ s hs, hB.is_open (hSB hs))⟩
+
 lemma is_topological_basis.open_eq_Union {B : set (set α)}
   (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
   ∃ (β : Type u) (f : β → set α), u = (⋃ i, f i) ∧ ∀ i, f i ∈ B :=
@@ -261,10 +286,10 @@ the latter should be used as a typeclass argument in theorems because Lean can a
 `separable_space` from `second_countable_topology` but it can't deduce `second_countable_topology`
 and `emetric_space`. -/
 class separable_space : Prop :=
-(exists_countable_dense : ∃s:set α, countable s ∧ dense s)
+(exists_countable_dense : ∃s:set α, s.countable ∧ dense s)
 
 lemma exists_countable_dense [separable_space α] :
-  ∃ s : set α, countable s ∧ dense s :=
+  ∃ s : set α, s.countable ∧ dense s :=
 separable_space.exists_countable_dense
 
 /-- A nonempty separable space admits a sequence with dense range. Instead of running `cases` on the
@@ -275,7 +300,7 @@ If `α` might be empty, then `exists_countable_dense` is the main way to use sep
 lemma exists_dense_seq [separable_space α] [nonempty α] : ∃ u : ℕ → α, dense_range u :=
 begin
   obtain ⟨s : set α, hs, s_dense⟩ := exists_countable_dense α,
-  cases countable_iff_exists_surjective.mp hs with u hu,
+  cases set.countable_iff_exists_subset_range.mp hs with u hu,
   exact ⟨u, s_dense.mono hu⟩,
 end
 
@@ -291,10 +316,10 @@ def dense_seq [separable_space α] [nonempty α] : ℕ → α := classical.some
 variable {α}
 
 @[priority 100]
-instance encodable.to_separable_space [encodable α] : separable_space α :=
-{ exists_countable_dense := ⟨set.univ, set.countable_encodable set.univ, dense_univ⟩ }
+instance countable.to_separable_space [countable α] : separable_space α :=
+{ exists_countable_dense := ⟨set.univ, set.countable_univ, dense_univ⟩ }
 
-lemma separable_space_of_dense_range {ι : Type*} [encodable ι] (u : ι → α) (hu : dense_range u) :
+lemma separable_space_of_dense_range {ι : Type*} [countable ι] (u : ι → α) (hu : dense_range u) :
   separable_space α :=
 ⟨⟨range u, countable_range u, hu⟩⟩
 
@@ -302,7 +327,7 @@ lemma separable_space_of_dense_range {ι : Type*} [encodable ι] (u : ι → α)
 lemma _root_.set.pairwise_disjoint.countable_of_is_open [separable_space α] {ι : Type*}
   {s : ι → set α} {a : set ι} (h : a.pairwise_disjoint s) (ha : ∀ i ∈ a, is_open (s i))
   (h'a : ∀ i ∈ a, (s i).nonempty) :
-  countable a :=
+  a.countable :=
 begin
   rcases exists_countable_dense α with ⟨u, ⟨u_encodable⟩, u_dense⟩,
   have : ∀ i : a, ∃ y, y ∈ s i ∩ u :=
@@ -310,7 +335,8 @@ begin
   choose f hfs hfu using this,
   lift f to a → u using hfu,
   have f_inj : injective f,
-  { refine injective_iff_pairwise_ne.mpr ((h.subtype _ _).mono $ λ i j hij hfij, hij ⟨hfs i, _⟩),
+  { refine injective_iff_pairwise_ne.mpr
+      ((h.subtype _ _).mono $ λ i j hij hfij, hij.le_bot ⟨hfs i, _⟩),
     simp only [congr_arg coe hfij, hfs j] },
   exact ⟨@encodable.of_inj _ _ u_encodable f f_inj⟩
 end
@@ -319,7 +345,7 @@ end
 lemma _root_.set.pairwise_disjoint.countable_of_nonempty_interior [separable_space α] {ι : Type*}
   {s : ι → set α} {a : set ι} (h : a.pairwise_disjoint s)
   (ha : ∀ i ∈ a, (interior (s i)).nonempty) :
-  countable a :=
+  a.countable :=
 (h.mono $ λ i, interior_subset).countable_of_is_open (λ i hi, is_open_interior) ha
 
 /-- A set `s` in a topological space is separable if it is contained in the closure of a
@@ -327,7 +353,7 @@ countable set `c`. Beware that this definition does not require that `c` is cont
 express the latter, use `separable_space s` or `is_separable (univ : set s))`. In metric spaces,
 the two definitions are equivalent, see `topological_space.is_separable.separable_space`. -/
 def is_separable (s : set α) :=
-∃ c : set α, countable c ∧ s ⊆ closure c
+∃ c : set α, c.countable ∧ s ⊆ closure c
 
 lemma is_separable.mono {s u : set α} (hs : is_separable s) (hu : u ⊆ s) :
   is_separable u :=
@@ -352,7 +378,7 @@ begin
   exact ⟨c, c_count, by simpa using closure_mono hs⟩,
 end
 
-lemma is_separable_Union {ι : Type*} [encodable ι] {s : ι → set α} (hs : ∀ i, is_separable (s i)) :
+lemma is_separable_Union {ι : Type*} [countable ι] {s : ι → set α} (hs : ∀ i, is_separable (s i)) :
   is_separable (⋃ i, s i) :=
 begin
   choose c hc h'c using hs,
@@ -360,10 +386,10 @@ begin
   exact (h'c i).trans (closure_mono (subset_Union _ i))
 end
 
-lemma _root_.set.countable.is_separable {s : set α} (hs : countable s) : is_separable s :=
+lemma _root_.set.countable.is_separable {s : set α} (hs : s.countable) : is_separable s :=
 ⟨s, hs, subset_closure⟩
 
-lemma _root_.set.finite.is_separable {s : set α} (hs : finite s) : is_separable s :=
+lemma _root_.set.finite.is_separable {s : set α} (hs : s.finite) : is_separable s :=
 hs.countable.is_separable
 
 lemma is_separable_univ_iff :
@@ -466,7 +492,7 @@ let ⟨s, s_cnt, s_dense⟩ := exists_countable_dense α in
 
 lemma dense.exists_countable_dense_subset {α : Type*} [topological_space α]
   {s : set α} [separable_space s] (hs : dense s) :
-  ∃ t ⊆ s, countable t ∧ dense t :=
+  ∃ t ⊆ s, t.countable ∧ dense t :=
 let ⟨t, htc, htd⟩ := exists_countable_dense s
 in ⟨coe '' t, image_subset_iff.2 $ λ x _, mem_preimage.2 $ subtype.coe_prop _, htc.image coe,
   hs.dense_range_coe.dense_image continuous_subtype_val htd⟩
@@ -478,7 +504,7 @@ to `s`. For a dense subset containing neither bot nor top elements, see
 `dense.exists_countable_dense_subset_no_bot_top`. -/
 lemma dense.exists_countable_dense_subset_bot_top {α : Type*} [topological_space α]
   [partial_order α] {s : set α} [separable_space s] (hs : dense s) :
-  ∃ t ⊆ s, countable t ∧ dense t ∧ (∀ x, is_bot x → x ∈ s → x ∈ t) ∧
+  ∃ t ⊆ s, t.countable ∧ dense t ∧ (∀ x, is_bot x → x ∈ s → x ∈ t) ∧
     (∀ x, is_top x → x ∈ s → x ∈ t) :=
 begin
   rcases hs.exists_countable_dense_subset with ⟨t, hts, htc, htd⟩,
@@ -491,8 +517,7 @@ end
 
 instance separable_space_univ {α : Type*} [topological_space α] [separable_space α] :
   separable_space (univ : set α) :=
-(equiv.set.univ α).symm.surjective.dense_range.separable_space
-  (continuous_subtype_mk _ continuous_id)
+(equiv.set.univ α).symm.surjective.dense_range.separable_space (continuous_id.subtype_mk _)
 
 /-- If `α` is a separable topological space with a partial order, then there exists a countable
 dense set `s : set α` that contains those of both bottom and top elements of `α` that actually
@@ -500,7 +525,7 @@ exist. For a dense set containing neither bot nor top elements, see
 `exists_countable_dense_no_bot_top`. -/
 lemma exists_countable_dense_bot_top (α : Type*) [topological_space α] [separable_space α]
   [partial_order α] :
-  ∃ s : set α, countable s ∧ dense s ∧ (∀ x, is_bot x → x ∈ s) ∧ (∀ x, is_top x → x ∈ s) :=
+  ∃ s : set α, s.countable ∧ dense s ∧ (∀ x, is_bot x → x ∈ s) ∧ (∀ x, is_top x → x ∈ s) :=
 by simpa using dense_univ.exists_countable_dense_subset_bot_top
 
 namespace topological_space
@@ -530,6 +555,20 @@ end first_countable_topology
 
 variables {α}
 
+instance {β} [topological_space β] [first_countable_topology α] [first_countable_topology β] :
+  first_countable_topology (α × β) :=
+⟨λ ⟨x, y⟩, by { rw nhds_prod_eq, apply_instance }⟩
+
+section pi
+
+omit t
+
+instance {ι : Type*} {π : ι → Type*} [countable ι] [Π i, topological_space (π i)]
+  [∀ i, first_countable_topology (π i)] : first_countable_topology (Π i, π i) :=
+⟨λ f, by { rw nhds_pi, apply_instance }⟩
+
+end pi
+
 instance is_countably_generated_nhds_within (x : α) [is_countably_generated (𝓝 x)] (s : set α) :
   is_countably_generated (𝓝[s] x) :=
 inf.is_countably_generated _ _
@@ -539,32 +578,30 @@ variable (α)
 /-- A second-countable space is one with a countable basis. -/
 class second_countable_topology : Prop :=
 (is_open_generated_countable [] :
-  ∃ b : set (set α), countable b ∧ t = topological_space.generate_from b)
+  ∃ b : set (set α), b.countable ∧ t = topological_space.generate_from b)
 
 variable {α}
 
 protected lemma is_topological_basis.second_countable_topology
-  {b : set (set α)} (hb : is_topological_basis b) (hc : countable b) :
+  {b : set (set α)} (hb : is_topological_basis b) (hc : b.countable) :
   second_countable_topology α :=
 ⟨⟨b, hc, hb.eq_generate_from⟩⟩
 
 variable (α)
 
 lemma exists_countable_basis [second_countable_topology α] :
-  ∃b:set (set α), countable b ∧ ∅ ∉ b ∧ is_topological_basis b :=
-let ⟨b, hb₁, hb₂⟩ := second_countable_topology.is_open_generated_countable α in
-let b' := (λs, ⋂₀ s) '' {s:set (set α) | finite s ∧ s ⊆ b ∧ (⋂₀ s).nonempty} in
-⟨b',
-  ((countable_set_of_finite_subset hb₁).mono
-    (by { simp only [← and_assoc], apply inter_subset_left })).image _,
-  assume ⟨s, ⟨_, _, hn⟩, hp⟩, absurd hn (not_nonempty_iff_eq_empty.2 hp),
-  is_topological_basis_of_subbasis hb₂⟩
+  ∃ b : set (set α), b.countable ∧ ∅ ∉ b ∧ is_topological_basis b :=
+begin
+  obtain ⟨b, hb₁, hb₂⟩ := second_countable_topology.is_open_generated_countable α,
+  refine ⟨_, _, not_mem_diff_of_mem _, (is_topological_basis_of_subbasis hb₂).diff_empty⟩,
+  exacts [((countable_set_of_finite_subset hb₁).image _).mono (diff_subset _ _), rfl],
+end
 
 /-- A countable topological basis of `α`. -/
 def countable_basis [second_countable_topology α] : set (set α) :=
 (exists_countable_basis α).some
 
-lemma countable_countable_basis [second_countable_topology α] : countable (countable_basis α) :=
+lemma countable_countable_basis [second_countable_topology α] : (countable_basis α).countable :=
 (exists_countable_basis α).some_spec.1
 
 instance encodable_countable_basis [second_countable_topology α] :
@@ -590,7 +627,7 @@ lemma is_open_of_mem_countable_basis [second_countable_topology α] {s : set α}
 
 lemma nonempty_of_mem_countable_basis [second_countable_topology α] {s : set α}
   (hs : s ∈ countable_basis α) : s.nonempty :=
-ne_empty_iff_nonempty.1 $ ne_of_mem_of_not_mem hs $ empty_nmem_countable_basis α
+nonempty_iff_ne_empty.2 $ ne_of_mem_of_not_mem hs $ empty_nmem_countable_basis α
 
 variable (α)
 
@@ -622,19 +659,19 @@ instance {β : Type*} [topological_space β]
 ((is_basis_countable_basis α).prod (is_basis_countable_basis β)).second_countable_topology $
   (countable_countable_basis α).image2 (countable_countable_basis β) _
 
-instance second_countable_topology_encodable {ι : Type*} {π : ι → Type*}
-  [encodable ι] [t : ∀a, topological_space (π a)] [∀a, second_countable_topology (π a)] :
+instance {ι : Type*} {π : ι → Type*}
+  [countable ι] [t : ∀a, topological_space (π a)] [∀a, second_countable_topology (π a)] :
   second_countable_topology (∀a, π a) :=
 begin
   have : t = (λa, generate_from (countable_basis (π a))),
     from funext (assume a, (is_basis_countable_basis (π a)).eq_generate_from),
   rw [this, pi_generate_from_eq],
   constructor, refine ⟨_, _, rfl⟩,
-  have : countable {T : set (Π i, π i) | ∃ (I : finset ι) (s : Π i : I, set (π i)),
+  have : set.countable {T : set (Π i, π i) | ∃ (I : finset ι) (s : Π i : I, set (π i)),
     (∀ i, s i ∈ countable_basis (π i)) ∧ T = {f | ∀ i : I, f i ∈ s i}},
   { simp only [set_of_exists, ← exists_prop],
     refine countable_Union (λ I, countable.bUnion _ (λ _ _, countable_singleton _)),
-    change countable {s : Π i : I, set (π i) | ∀ i, s i ∈ countable_basis (π i)},
+    change set.countable {s : Π i : I, set (π i) | ∀ i, s i ∈ countable_basis (π i)},
     exact countable_pi (λ i, countable_countable_basis _) },
   convert this using 1, ext1 T, split,
   { rintro ⟨s, I, hs, rfl⟩,
@@ -645,11 +682,6 @@ begin
     exact ⟨s, I, λ i hi, hs ⟨i, hi⟩, set.ext $ λ f, subtype.forall⟩ }
 end
 
-instance second_countable_topology_fintype {ι : Type*} {π : ι → Type*}
-  [fintype ι] [t : ∀a, topological_space (π a)] [∀a, second_countable_topology (π a)] :
-  second_countable_topology (∀a, π a) :=
-by { letI := fintype.to_encodable ι, exact topological_space.second_countable_topology_encodable }
-
 @[priority 100] -- see Note [lower instance priority]
 instance second_countable_topology.to_separable_space
   [second_countable_topology α] : separable_space α :=
@@ -677,7 +709,7 @@ end
 is equal to the union of countably many of those sets. -/
 lemma is_open_Union_countable [second_countable_topology α]
   {ι} (s : ι → set α) (H : ∀ i, is_open (s i)) :
-  ∃ T : set ι, countable T ∧ (⋃ i ∈ T, s i) = ⋃ i, s i :=
+  ∃ T : set ι, T.countable ∧ (⋃ i ∈ T, s i) = ⋃ i, s i :=
 begin
   let B := {b ∈ countable_basis α | ∃ i, b ⊆ s i},
   choose f hf using λ b : B, b.2.2,
@@ -690,7 +722,7 @@ end
 
 lemma is_open_sUnion_countable [second_countable_topology α]
   (S : set (set α)) (H : ∀ s ∈ S, is_open s) :
-  ∃ T : set (set α), countable T ∧ T ⊆ S ∧ ⋃₀ T = ⋃₀ S :=
+  ∃ T : set (set α), T.countable ∧ T ⊆ S ∧ ⋃₀ T = ⋃₀ S :=
 let ⟨T, cT, hT⟩ := is_open_Union_countable (λ s:S, s.1) (λ s, H s.1 s.2) in
 ⟨subtype.val '' T, cT.image _,
   image_subset_iff.2 $ λ ⟨x, xs⟩ xt, xs,
@@ -700,7 +732,7 @@ let ⟨T, cT, hT⟩ := is_open_Union_countable (λ s:S, s.1) (λ s, H s.1 s.2) i
 point `x` to a neighborhood of `x`, then for some countable set `s`, the neighborhoods `f x`,
 `x ∈ s`, cover the whole space. -/
 lemma countable_cover_nhds [second_countable_topology α] {f : α → set α}
-  (hf : ∀ x, f x ∈ 𝓝 x) : ∃ s : set α, countable s ∧ (⋃ x ∈ s, f x) = univ :=
+  (hf : ∀ x, f x ∈ 𝓝 x) : ∃ s : set α, s.countable ∧ (⋃ x ∈ s, f x) = univ :=
 begin
   rcases is_open_Union_countable (λ x, interior (f x)) (λ x, is_open_interior) with ⟨s, hsc, hsU⟩,
   suffices : (⋃ x ∈ s, interior (f x)) = univ,
@@ -710,7 +742,7 @@ begin
 end
 
 lemma countable_cover_nhds_within [second_countable_topology α] {f : α → set α} {s : set α}
-  (hf : ∀ x ∈ s, f x ∈ 𝓝[s] x) : ∃ t ⊆ s, countable t ∧ s ⊆ (⋃ x ∈ t, f x) :=
+  (hf : ∀ x ∈ s, f x ∈ 𝓝[s] x) : ∃ t ⊆ s, t.countable ∧ s ⊆ (⋃ x ∈ t, f x) :=
 begin
   have : ∀ x : s, coe ⁻¹' (f x) ∈ 𝓝 x, from λ x, preimage_coe_mem_nhds_subtype.2 (hf x x.2),
   rcases countable_cover_nhds this with ⟨t, htc, htU⟩,
@@ -744,12 +776,12 @@ begin
 end
 
 /-- A countable disjoint union of second countable spaces is second countable. -/
-instance [encodable ι] [∀ i, second_countable_topology (E i)] :
+instance [countable ι] [∀ i, second_countable_topology (E i)] :
   second_countable_topology (Σ i, E i) :=
 begin
   let b := (⋃ (i : ι), (λ u, ((sigma.mk i) '' u : set (Σ i, E i))) '' (countable_basis (E i))),
   have A : is_topological_basis b := is_topological_basis.sigma (λ i, is_basis_countable_basis  _),
-  have B : countable b := countable_Union (λ i, countable.image (countable_countable_basis _) _),
+  have B : b.countable := countable_Union (λ i, countable.image (countable_countable_basis _) _),
   exact A.second_countable_topology B,
 end
 
@@ -794,13 +826,63 @@ instance [second_countable_topology α] [second_countable_topology β] :
 begin
   let b := (λ u, sum.inl '' u) '' (countable_basis α) ∪ (λ u, sum.inr '' u) '' (countable_basis β),
   have A : is_topological_basis b := (is_basis_countable_basis α).sum (is_basis_countable_basis β),
-  have B : countable b := (countable.image (countable_countable_basis _) _).union
+  have B : b.countable := (countable.image (countable_countable_basis _) _).union
     (countable.image (countable_countable_basis _) _),
   exact A.second_countable_topology B,
 end
 
 end sum
 
+section quotient
+
+variables {X : Type*} [topological_space X] {Y : Type*} [topological_space Y] {π : X → Y}
+omit t
+
+/-- The image of a topological basis under an open quotient map is a topological basis. -/
+lemma is_topological_basis.quotient_map {V : set (set X)} (hV : is_topological_basis V)
+  (h' : quotient_map π) (h : is_open_map π) :
+  is_topological_basis (set.image π '' V) :=
+begin
+  apply is_topological_basis_of_open_of_nhds,
+  { rintros - ⟨U, U_in_V, rfl⟩,
+    apply h U (hV.is_open U_in_V), },
+  { intros y U y_in_U U_open,
+    obtain ⟨x, rfl⟩ := h'.surjective y,
+    let W := π ⁻¹' U,
+    have x_in_W : x ∈ W := y_in_U,
+    have W_open : is_open W := U_open.preimage h'.continuous,
+    obtain ⟨Z, Z_in_V, x_in_Z, Z_in_W⟩ := hV.exists_subset_of_mem_open x_in_W W_open,
+    have πZ_in_U : π '' Z ⊆ U := (set.image_subset _ Z_in_W).trans (image_preimage_subset π U),
+    exact ⟨π '' Z, ⟨Z, Z_in_V, rfl⟩, ⟨x, x_in_Z, rfl⟩, πZ_in_U⟩, },
+end
+
+/-- A second countable space is mapped by an open quotient map to a second countable space. -/
+lemma quotient_map.second_countable_topology [second_countable_topology X] (h' : quotient_map π)
+  (h : is_open_map π) :
+  second_countable_topology Y :=
+{ is_open_generated_countable :=
+  begin
+    obtain ⟨V, V_countable, V_no_empty, V_generates⟩ := exists_countable_basis X,
+    exact ⟨set.image π '' V, V_countable.image (set.image π),
+      (V_generates.quotient_map h' h).eq_generate_from⟩,
+  end }
+
+variables {S : setoid X}
+
+/-- The image of a topological basis "downstairs" in an open quotient is a topological basis. -/
+lemma is_topological_basis.quotient {V : set (set X)}
+  (hV : is_topological_basis V) (h : is_open_map (quotient.mk : X → quotient S)) :
+  is_topological_basis (set.image (quotient.mk : X → quotient S) '' V) :=
+hV.quotient_map quotient_map_quotient_mk h
+
+/-- An open quotient of a second countable space is second countable. -/
+lemma quotient.second_countable_topology [second_countable_topology X]
+  (h : is_open_map (quotient.mk : X → quotient S)) :
+  second_countable_topology (quotient S) :=
+quotient_map_quotient_mk.second_countable_topology h
+
+end quotient
+
 end topological_space
 
 open topological_space
diff --git a/src/topology/basic.lean b/src/topology/basic.lean
index a79e1aa7f925d..591b548277ee2 100644
--- a/src/topology/basic.lean
+++ b/src/topology/basic.lean
@@ -4,21 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Jeremy Avigad
 -/
 import order.filter.ultrafilter
-import order.filter.partial
 import algebra.support
+import order.filter.lift
 
 /-!
 # Basic theory of topological spaces.
 
-The main definition is the type class `topological space α` which endows a type `α` with a topology.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The main definition is the type class `topological_space α` which endows a type `α` with a topology.
 Then `set α` gets predicates `is_open`, `is_closed` and functions `interior`, `closure` and
-`frontier`. Each point `x` of `α` gets a neighborhood filter `𝓝 x`. A filter `F` on `α` has
+`frontier`. Each point `x` of `α` gets a neighborhood filter `𝓝 x`. A filter `F` on `α` has
 `x` as a cluster point if `cluster_pt x F : 𝓝 x ⊓ F ≠ ⊥`. A map `f : ι → α` clusters at `x`
 along `F : filter ι` if `map_cluster_pt x F f : cluster_pt x (map f F)`. In particular
 the notion of cluster point of a sequence `u` is `map_cluster_pt x at_top u`.
 
-This file also defines locally finite families of subsets of `α`.
-
 For topological spaces `α` and `β`, a function `f : α → β` and a point `a : α`,
 `continuous_at f a` means `f` is continuous at `a`, and global continuity is
 `continuous f`. There is also a version of continuity `pcontinuous` for
@@ -57,18 +58,16 @@ open_locale classical filter
 universes u v w
 
 /-!
-### Topological spaces
+### Topological spaces
 -/
 
 /-- A topology on `α`. -/
-@[protect_proj] structure topological_space (α : Type u) :=
+@[protect_proj] class topological_space (α : Type u) :=
 (is_open        : set α → Prop)
 (is_open_univ   : is_open univ)
 (is_open_inter  : ∀s t, is_open s → is_open t → is_open (s ∩ t))
 (is_open_sUnion : ∀s, (∀t∈s, is_open t) → is_open (⋃₀ s))
 
-attribute [class] topological_space
-
 /-- A constructor for topologies by specifying the closed sets,
 and showing that they satisfy the appropriate conditions. -/
 def topological_space.of_closed {α : Type u} (T : set (set α))
@@ -76,42 +75,45 @@ def topological_space.of_closed {α : Type u} (T : set (set α))
   topological_space α :=
 { is_open := λ X, Xᶜ ∈ T,
   is_open_univ := by simp [empty_mem],
-  is_open_inter := λ s t hs ht, by simpa [set.compl_inter] using union_mem sᶜ hs tᶜ ht,
+  is_open_inter := λ s t hs ht, by simpa only [compl_inter] using union_mem sᶜ hs tᶜ ht,
   is_open_sUnion := λ s hs,
-    by rw set.compl_sUnion; exact sInter_mem (set.compl '' s)
+    by rw set.compl_sUnion; exact sInter_mem (compl '' s)
     (λ z ⟨y, hy, hz⟩, by simpa [hz.symm] using hs y hy) }
 
 section topological_space
 
-variables {α : Type u} {β : Type v} {ι : Sort w} {a : α} {s s₁ s₂ : set α} {p p₁ p₂ : α → Prop}
+variables {α : Type u} {β : Type v} {ι : Sort w} {a : α} {s s₁ s₂ t : set α} {p p₁ p₂ : α → Prop}
+
+/-- `is_open s` means that `s` is open in the ambient topological space on `α` -/
+def is_open [topological_space α] (s : set α) : Prop := @topological_space.is_open _ ‹_› s
+
+localized "notation (name := is_open_of) `is_open[` t `]` := @is_open hole! t" in topology
+
+lemma is_open_mk {p h₁ h₂ h₃} {s : set α} : is_open[⟨p, h₁, h₂, h₃⟩] s ↔ p s := iff.rfl
 
 @[ext]
-lemma topological_space_eq : ∀ {f g : topological_space α}, f.is_open = g.is_open → f = g
-| ⟨a, _, _, _⟩ ⟨b, _, _, _⟩ rfl := rfl
+lemma topological_space_eq {f g : topological_space α} (h : is_open[f] = is_open[g]) : f = g :=
+by unfreezingI { cases f, cases g, congr, exact h }
 
 section
-variables [t : topological_space α]
-include t
-
-/-- `is_open s` means that `s` is open in the ambient topological space on `α` -/
-def is_open (s : set α) : Prop := topological_space.is_open t s
+variables [topological_space α]
 
 @[simp]
-lemma is_open_univ : is_open (univ : set α) := topological_space.is_open_univ t
+lemma is_open_univ : is_open (univ : set α) := topological_space.is_open_univ
 
 lemma is_open.inter (h₁ : is_open s₁) (h₂ : is_open s₂) : is_open (s₁ ∩ s₂) :=
-topological_space.is_open_inter t s₁ s₂ h₁ h₂
+topological_space.is_open_inter s₁ s₂ h₁ h₂
 
 lemma is_open_sUnion {s : set (set α)} (h : ∀t ∈ s, is_open t) : is_open (⋃₀ s) :=
-topological_space.is_open_sUnion t s h
+topological_space.is_open_sUnion s h
 
 end
 
 lemma topological_space_eq_iff {t t' : topological_space α} :
-  t = t' ↔ ∀ s, @is_open α t s ↔ @is_open α t' s :=
+  t = t' ↔ ∀ s, is_open[t] s ↔ is_open[t'] s :=
 ⟨λ h s, h ▸ iff.rfl, λ h, by { ext, exact h _ }⟩
 
-lemma is_open_fold {s : set α} {t : topological_space α} : t.is_open s = @is_open α t s :=
+lemma is_open_fold {s : set α} {t : topological_space α} : t.is_open s = is_open[t] s :=
 rfl
 
 variables [topological_space α]
@@ -129,26 +131,24 @@ by rw union_eq_Union; exact is_open_Union (bool.forall_bool.2 ⟨h₂, h₁⟩)
 @[simp] lemma is_open_empty : is_open (∅ : set α) :=
 by rw ← sUnion_empty; exact is_open_sUnion (assume a, false.elim)
 
-lemma is_open_sInter {s : set (set α)} (hs : finite s) : (∀t ∈ s, is_open t) → is_open (⋂₀ s) :=
+lemma is_open_sInter {s : set (set α)} (hs : s.finite) : (∀t ∈ s, is_open t) → is_open (⋂₀ s) :=
 finite.induction_on hs (λ _, by rw sInter_empty; exact is_open_univ) $
 λ a s has hs ih h, by rw sInter_insert; exact
 is_open.inter (h _ $ mem_insert _ _) (ih $ λ t, h t ∘ mem_insert_of_mem _)
 
-lemma is_open_bInter {s : set β} {f : β → set α} (hs : finite s) :
+lemma is_open_bInter {s : set β} {f : β → set α} (hs : s.finite) :
   (∀i∈s, is_open (f i)) → is_open (⋂i∈s, f i) :=
 finite.induction_on hs
   (λ _, by rw bInter_empty; exact is_open_univ)
   (λ a s has hs ih h, by rw bInter_insert; exact
     is_open.inter (h a (mem_insert _ _)) (ih (λ i hi, h i (mem_insert_of_mem _ hi))))
 
-lemma is_open_Inter [fintype β] {s : β → set α}
-  (h : ∀ i, is_open (s i)) : is_open (⋂ i, s i) :=
-suffices is_open (⋂ (i : β) (hi : i ∈ @univ β), s i), by simpa,
-is_open_bInter finite_univ (λ i _, h i)
+lemma is_open_Inter [finite ι] {s : ι → set α} (h : ∀ i, is_open (s i)) : is_open (⋂ i, s i) :=
+is_open_sInter (finite_range _) (forall_range_iff.2 h)
 
-lemma is_open_Inter_prop {p : Prop} {s : p → set α}
-  (h : ∀ h : p, is_open (s h)) : is_open (Inter s) :=
-by by_cases p; simp *
+lemma is_open_bInter_finset {s : finset β} {f : β → set α} (h : ∀ i ∈ s, is_open (f i)) :
+  is_open (⋂ i ∈ s, f i) :=
+is_open_bInter (to_finite _) h
 
 lemma is_open_const {p : Prop} : is_open {a : α | p} :=
 by_cases
@@ -162,6 +162,8 @@ is_open.inter
 class is_closed (s : set α) : Prop :=
 (is_open_compl : is_open sᶜ)
 
+localized "notation (name := is_closed_of) `is_closed[` t `]` := @is_closed hole! t" in topology
+
 @[simp] lemma is_open_compl_iff {s : set α} : is_open sᶜ ↔ is_closed s :=
 ⟨λ h, ⟨h⟩, λ h, h.is_open_compl⟩
 
@@ -199,22 +201,16 @@ by { rw [← is_open_compl_iff] at *, rw compl_inter, exact is_open.union h₁ h
 lemma is_closed.sdiff {s t : set α} (h₁ : is_closed s) (h₂ : is_open t) : is_closed (s \ t) :=
 is_closed.inter h₁ (is_closed_compl_iff.mpr h₂)
 
-lemma is_closed_bUnion {s : set β} {f : β → set α} (hs : finite s) :
+lemma is_closed_bUnion {s : set β} {f : β → set α} (hs : s.finite) :
   (∀i∈s, is_closed (f i)) → is_closed (⋃i∈s, f i) :=
 finite.induction_on hs
   (λ _, by rw bUnion_empty; exact is_closed_empty)
   (λ a s has hs ih h, by rw bUnion_insert; exact
     is_closed.union (h a (mem_insert _ _)) (ih (λ i hi, h i (mem_insert_of_mem _ hi))))
 
-lemma is_closed_Union [fintype β] {s : β → set α}
-  (h : ∀ i, is_closed (s i)) : is_closed (Union s) :=
-suffices is_closed (⋃ (i : β) (hi : i ∈ @univ β), s i),
-  by convert this; simp [set.ext_iff],
-is_closed_bUnion finite_univ (λ i _, h i)
-
-lemma is_closed_Union_prop {p : Prop} {s : p → set α}
-  (h : ∀ h : p, is_closed (s h)) : is_closed (Union s) :=
-by by_cases p; simp *
+lemma is_closed_Union [finite ι] {s : ι → set α} (h : ∀ i, is_closed (s i)) :
+  is_closed (⋃ i, s i) :=
+by { simp only [← is_open_compl_iff, compl_Union] at *, exact is_open_Inter h }
 
 lemma is_closed_imp {p q : α → Prop} (hp : is_open {x | p x})
   (hq : is_closed {x | q x}) : is_closed {x | p x → q x} :=
@@ -233,7 +229,7 @@ def interior (s : set α) : set α := ⋃₀ {t | is_open t ∧ t ⊆ s}
 
 lemma mem_interior {s : set α} {x : α} :
   x ∈ interior s ↔ ∃ t ⊆ s, is_open t ∧ x ∈ t :=
-by simp only [interior, mem_set_of_eq, exists_prop, and_assoc, and.left_comm]
+by simp only [interior, mem_sUnion, mem_set_of_eq, exists_prop, and_assoc, and.left_comm]
 
 @[simp] lemma is_open_interior {s : set α} : is_open (interior s) :=
 is_open_sUnion $ assume t ⟨h₁, h₂⟩, h₁
@@ -247,13 +243,13 @@ subset_sUnion_of_mem ⟨h₂, h₁⟩
 lemma is_open.interior_eq {s : set α} (h : is_open s) : interior s = s :=
 subset.antisymm interior_subset (interior_maximal (subset.refl s) h)
 
-lemma interior_eq_iff_open {s : set α} : interior s = s ↔ is_open s :=
+lemma interior_eq_iff_is_open {s : set α} : interior s = s ↔ is_open s :=
 ⟨assume h, h ▸ is_open_interior, is_open.interior_eq⟩
 
-lemma subset_interior_iff_open {s : set α} : s ⊆ interior s ↔ is_open s :=
-by simp only [interior_eq_iff_open.symm, subset.antisymm_iff, interior_subset, true_and]
+lemma subset_interior_iff_is_open {s : set α} : s ⊆ interior s ↔ is_open s :=
+by simp only [interior_eq_iff_is_open.symm, subset.antisymm_iff, interior_subset, true_and]
 
-lemma subset_interior_iff_subset_of_open {s t : set α} (h₁ : is_open s) :
+lemma is_open.subset_interior_iff {s t : set α} (h₁ : is_open s) :
   s ⊆ interior t ↔ s ⊆ t :=
 ⟨assume h, subset.trans h interior_subset, assume h₂, interior_maximal h₂ h₁⟩
 
@@ -291,9 +287,9 @@ begin
   simp [h₂],
 end
 
-@[simp] lemma interior_Inter_of_fintype {ι : Type*} [fintype ι] (f : ι → set α) :
+@[simp] lemma interior_Inter {ι : Type*} [finite ι] (f : ι → set α) :
   interior (⋂ i, f i) = ⋂ i, interior (f i) :=
-by { convert finset.univ.interior_Inter f; simp, }
+by { casesI nonempty_fintype ι, convert finset.univ.interior_Inter f; simp }
 
 lemma interior_union_is_closed_of_interior_empty {s t : set α} (h₁ : is_closed s)
   (h₂ : interior t = ∅) :
@@ -304,7 +300,7 @@ have interior (s ∪ t) ⊆ s, from
     have u \ s ⊆ t,
       from assume x ⟨h₁, h₂⟩, or.resolve_left (hu₂ h₁) h₂,
     have u \ s ⊆ interior t,
-      by rwa subset_interior_iff_subset_of_open (is_open.sdiff hu₁ h₁),
+      by rwa (is_open.sdiff hu₁ h₁).subset_interior_iff,
     have u \ s ⊆ ∅,
       by rwa h₂ at this,
     this ⟨hx₁, hx₂⟩,
@@ -313,7 +309,7 @@ subset.antisymm
   (interior_mono $ subset_union_left _ _)
 
 lemma is_open_iff_forall_mem_open : is_open s ↔ ∀ x ∈ s, ∃ t ⊆ s, is_open t ∧ x ∈ t :=
-by rw ← subset_interior_iff_open; simp only [subset_def, mem_interior]
+by rw ← subset_interior_iff_is_open; simp only [subset_def, mem_interior]
 
 lemma interior_Inter_subset (s : ι → set α) : interior (⋂ i, s i) ⊆ ⋂ i, interior (s i) :=
 subset_Inter $ λ i, interior_mono $ Inter_subset _ _
@@ -347,8 +343,7 @@ sInter_subset_of_mem ⟨h₂, h₁⟩
 
 lemma disjoint.closure_left {s t : set α} (hd : disjoint s t) (ht : is_open t) :
   disjoint (closure s) t :=
-disjoint_compl_left.mono_left $ closure_minimal (disjoint_iff_subset_compl_right.1 hd)
-  ht.is_closed_compl
+disjoint_compl_left.mono_left $ closure_minimal hd.subset_compl_right ht.is_closed_compl
 
 lemma disjoint.closure_right {s t : set α} (hd : disjoint s t) (hs : is_open s) :
   disjoint s (closure t) :=
@@ -364,9 +359,9 @@ lemma is_closed.closure_subset_iff {s t : set α} (h₁ : is_closed t) :
   closure s ⊆ t ↔ s ⊆ t :=
 ⟨subset.trans subset_closure, assume h, closure_minimal h h₁⟩
 
-lemma is_closed.mem_iff_closure_subset {α : Type*} [topological_space α] {U : set α}
-  (hU : is_closed U) {x : α} : x ∈ U ↔ closure ({x} : set α) ⊆ U :=
-(hU.closure_subset_iff.trans set.singleton_subset_iff).symm
+lemma is_closed.mem_iff_closure_subset {s : set α} (hs : is_closed s) {x : α} :
+  x ∈ s ↔ closure ({x} : set α) ⊆ s :=
+(hs.closure_subset_iff.trans set.singleton_subset_iff).symm
 
 @[mono] lemma closure_mono {s t : set α} (h : s ⊆ t) : closure s ⊆ closure t :=
 closure_minimal (subset.trans h subset_closure) is_closed_closure
@@ -398,7 +393,7 @@ is_closed_empty.closure_eq
 ⟨subset_eq_empty subset_closure, λ h, h.symm ▸ closure_empty⟩
 
 @[simp] lemma closure_nonempty_iff {s : set α} : (closure s).nonempty ↔ s.nonempty :=
-by simp only [← ne_empty_iff_nonempty, ne.def, closure_empty_iff]
+by simp only [nonempty_iff_ne_empty, ne.def, closure_empty_iff]
 
 alias closure_nonempty_iff ↔ set.nonempty.of_closure set.nonempty.closure
 
@@ -423,9 +418,9 @@ begin
   simp [h₂],
 end
 
-@[simp] lemma closure_Union_of_fintype {ι : Type*} [fintype ι] (f : ι → set α) :
+@[simp] lemma closure_Union {ι : Type*} [finite ι] (f : ι → set α) :
   closure (⋃ i, f i) = ⋃ i, closure (f i) :=
-by { convert finset.univ.closure_bUnion f; simp, }
+by { casesI nonempty_fintype ι, convert finset.univ.closure_bUnion f; simp }
 
 lemma interior_subset_closure {s : set α} : interior s ⊆ closure s :=
 subset.trans interior_subset subset_closure
@@ -450,6 +445,29 @@ theorem mem_closure_iff {s : set α} {a : α} :
 λ H c ⟨h₁, h₂⟩, classical.by_contradiction $ λ nc,
   let ⟨x, hc, hs⟩ := (H _ h₁.is_open_compl nc) in hc (h₂ hs)⟩
 
+lemma closure_inter_open_nonempty_iff {s t : set α} (h : is_open t) :
+  (closure s ∩ t).nonempty ↔ (s ∩ t).nonempty :=
+⟨λ ⟨x, hxcs, hxt⟩, inter_comm t s ▸ mem_closure_iff.1 hxcs t h hxt,
+  λ h, h.mono $ inf_le_inf_right t subset_closure⟩
+
+lemma filter.le_lift'_closure (l : filter α) : l ≤ l.lift' closure :=
+le_lift'.2 $ λ s hs, mem_of_superset hs subset_closure
+
+lemma filter.has_basis.lift'_closure {l : filter α} {p : ι → Prop} {s : ι → set α}
+  (h : l.has_basis p s) :
+  (l.lift' closure).has_basis p (λ i, closure (s i)) :=
+h.lift' (monotone_closure α)
+
+lemma filter.has_basis.lift'_closure_eq_self {l : filter α} {p : ι → Prop} {s : ι → set α}
+  (h : l.has_basis p s) (hc : ∀ i, p i → is_closed (s i)) :
+  l.lift' closure = l :=
+le_antisymm (h.ge_iff.2 $ λ i hi, (hc i hi).closure_eq ▸ mem_lift' (h.mem_of_mem hi))
+  l.le_lift'_closure
+
+@[simp] lemma filter.lift'_closure_eq_bot {l : filter α} : l.lift' closure = ⊥ ↔ l = ⊥ :=
+⟨λ h, bot_unique $ h ▸ l.le_lift'_closure,
+  λ h, h.symm ▸ by rw [lift'_bot (monotone_closure _), closure_empty, principal_empty]⟩
+
 /-- A set is dense in a topological space if every point belongs to its closure. -/
 def dense (s : set α) : Prop := ∀ x, x ∈ closure s
 
@@ -523,6 +541,15 @@ end
 /-- The frontier of a set is the set of points between the closure and interior. -/
 def frontier (s : set α) : set α := closure s \ interior s
 
+@[simp] lemma closure_diff_interior (s : set α) : closure s \ interior s = frontier s := rfl
+
+@[simp] lemma closure_diff_frontier (s : set α) : closure s \ frontier s = interior s :=
+by rw [frontier, diff_diff_right_self, inter_eq_self_of_subset_right interior_subset_closure]
+
+@[simp] lemma self_diff_frontier (s : set α) : s \ frontier s = interior s :=
+by rw [frontier, diff_diff_right, diff_eq_empty.2 subset_closure,
+  inter_eq_self_of_subset_right interior_subset, empty_union]
+
 lemma frontier_eq_closure_inter_closure {s : set α} :
   frontier s = closure s ∩ closure sᶜ :=
 by rw [closure_compl, frontier, diff_eq]
@@ -591,14 +618,12 @@ lemma closure_eq_interior_union_frontier (s : set α) : closure s = interior s 
 lemma closure_eq_self_union_frontier (s : set α) : closure s = s ∪ frontier s :=
 (union_diff_cancel' interior_subset subset_closure).symm
 
-lemma is_open.inter_frontier_eq_empty_of_disjoint {s t : set α} (ht : is_open t)
-  (hd : disjoint s t) :
-  t ∩ frontier s = ∅ :=
-begin
-  rw [inter_comm, ← subset_compl_iff_disjoint],
-  exact subset.trans frontier_subset_closure (closure_minimal (λ _, disjoint_left.1 hd)
-    (is_closed_compl_iff.2 ht))
-end
+lemma disjoint.frontier_left (ht : is_open t) (hd : disjoint s t) : disjoint (frontier s) t :=
+subset_compl_iff_disjoint_right.1 $ frontier_subset_closure.trans $ closure_minimal
+  (disjoint_left.1 hd) $ is_closed_compl_iff.2 ht
+
+lemma disjoint.frontier_right (hs : is_open s) (hd : disjoint s t) : disjoint s (frontier t) :=
+(hd.symm.frontier_left hs).symm
 
 lemma frontier_eq_inter_compl_interior {s : set α} :
   frontier s = (interior s)ᶜ ∩ (interior (sᶜ))ᶜ :=
@@ -612,7 +637,7 @@ begin
 end
 
 /-!
-### Neighborhoods
+### Neighborhoods
 -/
 
 /-- A set is called a neighborhood of `a` if it contains an open set around `a`. The set of all
@@ -620,24 +645,27 @@ neighborhoods of `a` forms a filter, the neighborhood filter at `a`, is here def
 infimum over the principal filters of all open sets containing `a`. -/
 @[irreducible] def nhds (a : α) : filter α := (⨅ s ∈ {s : set α | a ∈ s ∧ is_open s}, 𝓟 s)
 
-localized "notation `𝓝` := nhds" in topological_space
+localized "notation (name := nhds) `𝓝` := nhds" in topology
 
 /-- The "neighborhood within" filter. Elements of `𝓝[s] a` are sets containing the
 intersection of `s` and a neighborhood of `a`. -/
 def nhds_within (a : α) (s : set α) : filter α := 𝓝 a ⊓ 𝓟 s
 
-localized "notation `𝓝[` s `] ` x:100 := nhds_within x s" in topological_space
-localized "notation `𝓝[≠] ` x:100 := nhds_within x {x}ᶜ" in topological_space
-localized "notation `𝓝[≥] ` x:100 := nhds_within x (set.Ici x)" in topological_space
-localized "notation `𝓝[≤] ` x:100 := nhds_within x (set.Iic x)" in topological_space
-localized "notation `𝓝[>] ` x:100 := nhds_within x (set.Ioi x)" in topological_space
-localized "notation `𝓝[<] ` x:100 := nhds_within x (set.Iio x)" in topological_space
+localized "notation (name := nhds_within) `𝓝[` s `] ` x:100 := nhds_within x s" in topology
+localized "notation (name := nhds_within.ne) `𝓝[≠] ` x:100 := nhds_within x {x}ᶜ" in topology
+localized "notation (name := nhds_within.ge) `𝓝[≥] ` x:100 := nhds_within x (set.Ici x)" in topology
+localized "notation (name := nhds_within.le) `𝓝[≤] ` x:100 := nhds_within x (set.Iic x)" in topology
+localized "notation (name := nhds_within.gt) `𝓝[>] ` x:100 := nhds_within x (set.Ioi x)" in topology
+localized "notation (name := nhds_within.lt) `𝓝[<] ` x:100 := nhds_within x (set.Iio x)" in topology
 
 lemma nhds_def (a : α) : 𝓝 a = (⨅ s ∈ {s : set α | a ∈ s ∧ is_open s}, 𝓟 s) := by rw nhds
 
+lemma nhds_def' (a : α) : 𝓝 a = ⨅ (s : set α) (hs : is_open s) (ha : a ∈ s), 𝓟 s :=
+by simp only [nhds_def, mem_set_of_eq, and_comm (a ∈ _), infi_and]
+
 /-- The open sets containing `a` are a basis for the neighborhood filter. See `nhds_basis_opens'`
 for a variant using open neighborhoods instead. -/
-lemma nhds_basis_opens (a : α) : (𝓝 a).has_basis (λ s : set α, a ∈ s ∧ is_open s) (λ x, x) :=
+lemma nhds_basis_opens (a : α) : (𝓝 a).has_basis (λ s : set α, a ∈ s ∧ is_open s) (λ s, s) :=
 begin
   rw nhds_def,
   exact has_basis_binfi_principal
@@ -646,6 +674,10 @@ begin
     ⟨univ, ⟨mem_univ a, is_open_univ⟩⟩
 end
 
+lemma nhds_basis_closeds (a : α) : (𝓝 a).has_basis (λ s : set α, a ∉ s ∧ is_closed s) compl :=
+⟨λ t, (nhds_basis_opens a).mem_iff.trans $ compl_surjective.exists.trans $
+  by simp only [is_open_compl_iff, mem_compl_iff]⟩
+
 /-- A filter lies below the neighborhood filter at `a` iff it contains every open set around `a`. -/
 lemma le_nhds_iff {f a} : f ≤ 𝓝 a ↔ ∀ s : set α, a ∈ s → is_open s → s ∈ f :=
 by simp [nhds_def]
@@ -698,11 +730,7 @@ lemma nhds_basis_opens' (a : α) : (𝓝 a).has_basis (λ s : set α, s ∈ 𝓝
 begin
   convert nhds_basis_opens a,
   ext s,
-  split,
-  { rintros ⟨s_in, s_op⟩,
-    exact ⟨mem_of_mem_nhds s_in, s_op⟩ },
-  { rintros ⟨a_in, s_op⟩,
-    exact ⟨is_open.mem_nhds s_op a_in, s_op⟩ },
+  exact and.congr_left_iff.2 is_open.mem_nhds_iff
 end
 
 /-- If `U` is a neighborhood of each point of a set `s` then it is a neighborhood of `s`:
@@ -711,11 +739,8 @@ lemma exists_open_set_nhds {s U : set α} (h : ∀ x ∈ s, U ∈ 𝓝 x) :
   ∃ V : set α, s ⊆ V ∧ is_open V ∧ V ⊆ U :=
 begin
   have := λ x hx, (nhds_basis_opens x).mem_iff.1 (h x hx),
-  choose! Z hZ hZ' using this,
-  refine ⟨⋃ x ∈ s, Z x, λ x hx, mem_bUnion hx (hZ x hx).1, is_open_Union _, Union₂_subset hZ'⟩,
-  intro x,
-  by_cases hx : x ∈ s ; simp [hx],
-  exact (hZ x hx).2,
+  choose! Z hZ hZU using this, choose hZmem hZo using hZ,
+  exact ⟨⋃ x ∈ s, Z x, λ x hx, mem_bUnion hx (hZmem x hx), is_open_bUnion hZo, Union₂_subset hZU⟩
 end
 
 /-- If `U` is a neighborhood of each point of a set `s` then it is a neighborhood of s:
@@ -735,6 +760,14 @@ eventually_nhds_iff.2 ⟨t, λ x hx, eventually_nhds_iff.2 ⟨t, htp, hto, hx⟩
   (∀ᶠ y in 𝓝 a, ∀ᶠ x in 𝓝 y, p x) ↔ ∀ᶠ x in 𝓝 a, p x :=
 ⟨λ h, h.self_of_nhds, λ h, h.eventually_nhds⟩
 
+@[simp] lemma frequently_frequently_nhds {p : α → Prop} {a : α} :
+  (∃ᶠ y in 𝓝 a, ∃ᶠ x in 𝓝 y, p x) ↔ (∃ᶠ x in 𝓝 a, p x) :=
+begin
+  rw ← not_iff_not,
+  simp_rw not_frequently,
+  exact eventually_eventually_nhds,
+end
+
 @[simp] lemma eventually_mem_nhds {s : set α} {a : α} :
   (∀ᶠ x in 𝓝 a, s ∈ 𝓝 x) ↔ s ∈ 𝓝 a :=
 eventually_eventually_nhds
@@ -773,26 +806,15 @@ theorem all_mem_nhds_filter (x : α) (f : set α → set β) (hf : ∀ s t, s 
   (∀ s ∈ 𝓝 x, f s ∈ l) ↔ (∀ s, is_open s → x ∈ s → f s ∈ l) :=
 all_mem_nhds _ _ (λ s t ssubt h, mem_of_superset h (hf s t ssubt))
 
-theorem rtendsto_nhds {r : rel β α} {l : filter β} {a : α} :
-  rtendsto r l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → r.core s ∈ l) :=
-all_mem_nhds_filter _ _ (λ s t, id) _
-
-theorem rtendsto'_nhds {r : rel β α} {l : filter β} {a : α} :
-  rtendsto' r l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → r.preimage s ∈ l) :=
-by { rw [rtendsto'_def], apply all_mem_nhds_filter, apply rel.preimage_mono }
-
-theorem ptendsto_nhds {f : β →. α} {l : filter β} {a : α} :
-  ptendsto f l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → f.core s ∈ l) :=
-rtendsto_nhds
-
-theorem ptendsto'_nhds {f : β →. α} {l : filter β} {a : α} :
-  ptendsto' f l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → f.preimage s ∈ l) :=
-rtendsto'_nhds
-
 theorem tendsto_nhds {f : β → α} {l : filter β} {a : α} :
   tendsto f l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → f ⁻¹' s ∈ l) :=
 all_mem_nhds_filter _ _ (λ s t h, preimage_mono h) _
 
+lemma tendsto_at_top_nhds [nonempty β] [semilattice_sup β] {f : β → α} {a : α} :
+  (tendsto f at_top (𝓝 a)) ↔ ∀ U : set α, a ∈ U → is_open U → ∃ N, ∀ n, N ≤ n → f n ∈ U :=
+(at_top_basis.tendsto_iff (nhds_basis_opens a)).trans $
+  by simp only [and_imp, exists_prop, true_and, mem_Ici, ge_iff_le]
+
 lemma tendsto_const_nhds {a : α} {f : filter β} : tendsto (λb:β, a) f (𝓝 a) :=
 tendsto_nhds.mpr $ assume s hs ha, univ_mem' $ assume _, ha
 
@@ -825,8 +847,9 @@ In this section we define [cluster points](https://en.wikipedia.org/wiki/Limit_p
 (also known as limit points and accumulation points) of a filter and of a sequence.
 -/
 
-/-- A point `x` is a cluster point of a filter `F` if 𝓝 x ⊓ F ≠ ⊥. Also known as
-an accumulation point or a limit point. -/
+/-- A point `x` is a cluster point of a filter `F` if `𝓝 x ⊓ F ≠ ⊥`. Also known as
+an accumulation point or a limit point, but beware that terminology varies. This
+is *not* the same as asking `𝓝[≠] x ⊓ F ≠ ⊥`. See `mem_closure_iff_cluster_pt` in particular. -/
 def cluster_pt (x : α) (F : filter α) : Prop := ne_bot (𝓝 x ⊓ F)
 
 lemma cluster_pt.ne_bot {x : α} {F : filter α} (h : cluster_pt x F) : ne_bot (𝓝 x ⊓ F) := h
@@ -842,7 +865,7 @@ lemma cluster_pt_iff {x : α} {F : filter α} :
 inf_ne_bot_iff
 
 /-- `x` is a cluster point of a set `s` if every neighbourhood of `x` meets `s` on a nonempty
-set. -/
+set. See also `mem_closure_iff_cluster_pt`. -/
 lemma cluster_pt_principal_iff {x : α} {s : set α} :
   cluster_pt x (𝓟 s) ↔ ∀ U ∈ 𝓝 x, (U ∩ s).nonempty :=
 inf_principal_ne_bot_iff
@@ -896,6 +919,33 @@ begin
   exact ne_bot_of_le this
 end
 
+/--A point `x` is an accumulation point of a filter `F` if `𝓝[≠] x ⊓ F ≠ ⊥`.-/
+def acc_pt (x : α) (F : filter α) : Prop := ne_bot (𝓝[≠] x ⊓ F)
+
+lemma acc_iff_cluster (x : α) (F : filter α) : acc_pt x F ↔ cluster_pt x (𝓟 {x}ᶜ ⊓ F) :=
+by rw [acc_pt, nhds_within, cluster_pt, inf_assoc]
+
+/-- `x` is an accumulation point of a set `C` iff it is a cluster point of `C ∖ {x}`.-/
+lemma acc_principal_iff_cluster (x : α) (C : set α) :
+  acc_pt x (𝓟 C) ↔ cluster_pt x (𝓟(C \ {x})) :=
+by rw [acc_iff_cluster, inf_principal, inter_comm]; refl
+
+/-- `x` is an accumulation point of a set `C` iff every neighborhood
+of `x` contains a point of `C` other than `x`. -/
+lemma acc_pt_iff_nhds (x : α) (C : set α) : acc_pt x (𝓟 C) ↔ ∀ U ∈ 𝓝 x, ∃ y ∈ U ∩ C, y ≠ x :=
+by simp [acc_principal_iff_cluster, cluster_pt_principal_iff, set.nonempty, exists_prop,
+  and_assoc, and_comm (¬ _ = x)]
+
+/-- `x` is an accumulation point of a set `C` iff
+there are points near `x` in `C` and different from `x`.-/
+lemma acc_pt_iff_frequently (x : α) (C : set α) : acc_pt x (𝓟 C) ↔ ∃ᶠ y in 𝓝 x, y ≠ x ∧ y ∈ C :=
+by simp [acc_principal_iff_cluster, cluster_pt_principal_iff_frequently, and_comm]
+
+/-- If `x` is an accumulation point of `F` and `F ≤ G`, then
+`x` is an accumulation point of `D. -/
+lemma acc_pt.mono {x : α} {F G : filter α} (h : acc_pt x F) (hFG : F ≤ G) : acc_pt x G :=
+⟨ne_bot_of_le_ne_bot h.ne (inf_le_inf_left _ hFG)⟩
+
 /-!
 ### Interior, closure and frontier in terms of neighborhoods
 -/
@@ -927,17 +977,21 @@ lemma subset_interior_iff_nhds {s V : set α} : s ⊆ interior V ↔ ∀ x ∈ s
 show (∀ x, x ∈ s →  x ∈ _) ↔ _, by simp_rw mem_interior_iff_mem_nhds
 
 lemma is_open_iff_nhds {s : set α} : is_open s ↔ ∀a∈s, 𝓝 a ≤ 𝓟 s :=
-calc is_open s ↔ s ⊆ interior s : subset_interior_iff_open.symm
+calc is_open s ↔ s ⊆ interior s : subset_interior_iff_is_open.symm
   ... ↔ (∀a∈s, 𝓝 a ≤ 𝓟 s) : by rw [interior_eq_nhds]; refl
 
 lemma is_open_iff_mem_nhds {s : set α} : is_open s ↔ ∀a∈s, s ∈ 𝓝 a :=
 is_open_iff_nhds.trans $ forall_congr $ λ _, imp_congr_right $ λ _, le_principal_iff
 
+/-- A set `s` is open iff for every point `x` in `s` and every `y` close to `x`, `y` is in `s`. -/
+lemma is_open_iff_eventually {s : set α} : is_open s ↔ ∀ x, x ∈ s → ∀ᶠ y in 𝓝 x, y ∈ s :=
+is_open_iff_mem_nhds
+
 theorem is_open_iff_ultrafilter {s : set α} :
   is_open s ↔ (∀ (x ∈ s) (l : ultrafilter α), ↑l ≤ 𝓝 x → s ∈ l) :=
 by simp_rw [is_open_iff_mem_nhds, ← mem_iff_ultrafilter]
 
-lemma is_open_singleton_iff_nhds_eq_pure {α : Type*} [topological_space α] (a : α) :
+lemma is_open_singleton_iff_nhds_eq_pure (a : α) :
   is_open ({a} : set α) ↔ 𝓝 a = pure a :=
 begin
   split,
@@ -949,12 +1003,26 @@ begin
     simp [is_open_iff_nhds, h] }
 end
 
+lemma is_open_singleton_iff_punctured_nhds {α : Type*} [topological_space α] (a : α) :
+  is_open ({a} : set α) ↔ (𝓝[≠] a) = ⊥ :=
+by rw [is_open_singleton_iff_nhds_eq_pure, nhds_within, ← mem_iff_inf_principal_compl,
+        ← le_pure_iff, nhds_ne_bot.le_pure_iff]
+
 lemma mem_closure_iff_frequently {s : set α} {a : α} : a ∈ closure s ↔ ∃ᶠ x in 𝓝 a, x ∈ s :=
 by rw [filter.frequently, filter.eventually, ← mem_interior_iff_mem_nhds,
   closure_eq_compl_interior_compl]; refl
 
 alias mem_closure_iff_frequently ↔ _ filter.frequently.mem_closure
 
+/-- A set `s` is closed iff for every point `x`, if there is a point `y` close to `x` that belongs
+to `s` then `x` is in `s`. -/
+lemma is_closed_iff_frequently {s : set α} : is_closed s ↔ ∀ x, (∃ᶠ y in 𝓝 x, y ∈ s) → x ∈ s :=
+begin
+  rw ← closure_subset_iff_is_closed,
+  apply forall_congr (λ x, _),
+  rw mem_closure_iff_frequently
+end
+
 /-- The set of cluster points of a filter is closed. In particular, the set of limit points
 of a sequence is closed. -/
 lemma is_closed_set_of_cluster_pt {f : filter α} : is_closed {x | cluster_pt x f} :=
@@ -995,6 +1063,9 @@ space. -/
   interior {x} = (∅ : set α) :=
 interior_eq_empty_iff_dense_compl.2 (dense_compl_singleton x)
 
+lemma not_is_open_singleton (x : α) [ne_bot (𝓝[≠] x)] : ¬ is_open ({x} : set α) :=
+dense_compl_singleton_iff_not_open.1 (dense_compl_singleton x)
+
 lemma closure_eq_cluster_pts {s : set α} : closure s = {a | cluster_pt a (𝓟 s)} :=
 set.ext $ λ x, mem_closure_iff_cluster_pt
 
@@ -1004,11 +1075,13 @@ mem_closure_iff_cluster_pt.trans cluster_pt_principal_iff
 
 theorem mem_closure_iff_nhds' {s : set α} {a : α} :
   a ∈ closure s ↔ ∀ t ∈ 𝓝 a, ∃ y : s, ↑y ∈ t :=
-by simp only [mem_closure_iff_nhds, set.nonempty_inter_iff_exists_right]
+by simp only [mem_closure_iff_nhds, set.inter_nonempty_iff_exists_right,
+              set_coe.exists, subtype.coe_mk]
 
 theorem mem_closure_iff_comap_ne_bot {A : set α} {x : α} :
   x ∈ closure A ↔ ne_bot (comap (coe : A → α) (𝓝 x)) :=
-by simp_rw [mem_closure_iff_nhds, comap_ne_bot_iff, set.nonempty_inter_iff_exists_right]
+by simp_rw [mem_closure_iff_nhds, comap_ne_bot_iff, set.inter_nonempty_iff_exists_right,
+            set_coe.exists, subtype.coe_mk]
 
 theorem mem_closure_iff_nhds_basis' {a : α} {p : ι → Prop} {s : ι → set α} (h : (𝓝 a).has_basis p s)
   {t : set α} :
@@ -1020,7 +1093,7 @@ theorem mem_closure_iff_nhds_basis {a : α} {p : ι → Prop} {s : ι → set α
   {t : set α} :
   a ∈ closure t ↔ ∀ i, p i → ∃ y ∈ t, y ∈ s i :=
 (mem_closure_iff_nhds_basis' h).trans $
-  by simp only [set.nonempty, mem_inter_eq, exists_prop, and_comm]
+  by simp only [set.nonempty, mem_inter_iff, exists_prop, and_comm]
 
 /-- `x` belongs to the closure of `s` if and only if some ultrafilter
   supported on `s` converges to `x`. -/
@@ -1035,21 +1108,26 @@ calc is_closed s ↔ closure s ⊆ s : closure_subset_iff_is_closed.symm
 lemma is_closed_iff_nhds {s : set α} : is_closed s ↔ ∀ x, (∀ U ∈ 𝓝 x, (U ∩ s).nonempty) → x ∈ s :=
 by simp_rw [is_closed_iff_cluster_pt, cluster_pt, inf_principal_ne_bot_iff]
 
-lemma closure_inter_open {s t : set α} (h : is_open s) : s ∩ closure t ⊆ closure (s ∩ t) :=
-begin
-  rintro a ⟨hs, ht⟩,
-  have : s ∈ 𝓝 a := is_open.mem_nhds h hs,
-  rw mem_closure_iff_nhds_ne_bot at ht ⊢,
-  rwa [← inf_principal, ← inf_assoc, inf_eq_left.2 (le_principal_iff.2 this)],
-end
+lemma is_closed.interior_union_left {s t : set α} (h : is_closed s) :
+  interior (s ∪ t) ⊆ s ∪ interior t :=
+λ a ⟨u, ⟨⟨hu₁, hu₂⟩, ha⟩⟩, (classical.em (a ∈ s)).imp_right $ λ h, mem_interior.mpr
+  ⟨u ∩ sᶜ, λ x hx, (hu₂ hx.1).resolve_left hx.2, is_open.inter hu₁ is_closed.is_open_compl, ⟨ha, h⟩⟩
 
-lemma closure_inter_open' {s t : set α} (h : is_open t) : closure s ∩ t ⊆ closure (s ∩ t) :=
-by simpa only [inter_comm] using closure_inter_open h
+lemma is_closed.interior_union_right {s t : set α} (h : is_closed t) :
+  interior (s ∪ t) ⊆ interior s ∪ t :=
+by simpa only [union_comm] using h.interior_union_left
+
+lemma is_open.inter_closure {s t : set α} (h : is_open s) : s ∩ closure t ⊆ closure (s ∩ t) :=
+compl_subset_compl.mp $ by simpa only [← interior_compl, compl_inter]
+  using is_closed.interior_union_left h.is_closed_compl
+
+lemma is_open.closure_inter {s t : set α} (h : is_open t) : closure s ∩ t ⊆ closure (s ∩ t) :=
+by simpa only [inter_comm] using h.inter_closure
 
 lemma dense.open_subset_closure_inter {s t : set α} (hs : dense s) (ht : is_open t) :
   t ⊆ closure (t ∩ s) :=
 calc t = t ∩ closure s   : by rw [hs.closure_eq, inter_univ]
-   ... ⊆ closure (t ∩ s) : closure_inter_open ht
+   ... ⊆ closure (t ∩ s) : ht.inter_closure
 
 lemma mem_closure_of_mem_closure_union {s₁ s₂ : set α} {x : α} (h : x ∈ closure (s₁ ∪ s₂))
   (h₁ : s₁ᶜ ∈ 𝓝 x) : x ∈ closure s₂ :=
@@ -1065,7 +1143,7 @@ end
 /-- The intersection of an open dense set with a dense set is a dense set. -/
 lemma dense.inter_of_open_left {s t : set α} (hs : dense s) (ht : dense t) (hso : is_open s) :
   dense (s ∩ t) :=
-λ x, (closure_minimal (closure_inter_open hso) is_closed_closure) $
+λ x, (closure_minimal hso.inter_closure is_closed_closure) $
   by simp [hs.closure_eq, ht.closure_eq]
 
 /-- The intersection of a dense set with an open dense set is a dense set. -/
@@ -1080,7 +1158,7 @@ let ⟨U, hsub, ho, hx⟩ := mem_nhds_iff.1 ht in
 
 lemma closure_diff {s t : set α} : closure s \ closure t ⊆ closure (s \ t) :=
 calc closure s \ closure t = (closure t)ᶜ ∩ closure s : by simp only [diff_eq, inter_comm]
-  ... ⊆ closure ((closure t)ᶜ ∩ s) : closure_inter_open $ is_open_compl_iff.mpr $ is_closed_closure
+  ... ⊆ closure ((closure t)ᶜ ∩ s) : (is_open_compl_iff.mpr $ is_closed_closure).inter_closure
   ... = closure (s \ closure t) : by simp only [diff_eq, inter_comm]
   ... ⊆ closure (s \ t) : closure_mono $ diff_subset_diff (subset.refl s) subset_closure
 
@@ -1096,9 +1174,13 @@ lemma is_closed.mem_of_tendsto {f : β → α} {b : filter β} {a : α} {s : set
   [ne_bot b] (hs : is_closed s) (hf : tendsto f b (𝓝 a)) (h : ∀ᶠ x in b, f x ∈ s) : a ∈ s :=
 hs.mem_of_frequently_of_tendsto h.frequently hf
 
+lemma mem_closure_of_frequently_of_tendsto {f : β → α} {b : filter β} {a : α} {s : set α}
+  (h : ∃ᶠ x in b, f x ∈ s) (hf : tendsto f b (𝓝 a)) : a ∈ closure s :=
+filter.frequently.mem_closure $ hf.frequently h
+
 lemma mem_closure_of_tendsto {f : β → α} {b : filter β} {a : α} {s : set α}
   [ne_bot b] (hf : tendsto f b (𝓝 a)) (h : ∀ᶠ x in b, f x ∈ s) : a ∈ closure s :=
-is_closed_closure.mem_of_tendsto hf $ h.mono (preimage_mono subset_closure)
+mem_closure_of_frequently_of_tendsto h.frequently hf
 
 /-- Suppose that `f` sends the complement to `s` to a single point `a`, and `l` is some filter.
 Then `f` tends to `a` along `l` restricted to `s` if and only if it tends to `a` along `l`. -/
@@ -1160,69 +1242,6 @@ le_nhds_Lim h
 
 end lim
 
-/-!
-### Locally finite families
--/
-
-/- locally finite family [General Topology (Bourbaki, 1995)] -/
-section locally_finite
-
-/-- A family of sets in `set α` is locally finite if at every point `x:α`,
-  there is a neighborhood of `x` which meets only finitely many sets in the family -/
-def locally_finite (f : β → set α) :=
-∀x:α, ∃t ∈ 𝓝 x, finite {i | (f i ∩ t).nonempty }
-
-lemma locally_finite.point_finite {f : β → set α} (hf : locally_finite f) (x : α) :
-  finite {b | x ∈ f b} :=
-let ⟨t, hxt, ht⟩ := hf x in ht.subset $ λ b hb, ⟨x, hb, mem_of_mem_nhds hxt⟩
-
-lemma locally_finite_of_fintype [fintype β] (f : β → set α) : locally_finite f :=
-assume x, ⟨univ, univ_mem, finite.of_fintype _⟩
-
-lemma locally_finite.subset
-  {f₁ f₂ : β → set α} (hf₂ : locally_finite f₂) (hf : ∀b, f₁ b ⊆ f₂ b) : locally_finite f₁ :=
-assume a,
-let ⟨t, ht₁, ht₂⟩ := hf₂ a in
-⟨t, ht₁, ht₂.subset $ assume i hi, hi.mono $ inter_subset_inter (hf i) $ subset.refl _⟩
-
-lemma locally_finite.comp_injective {ι} {f : β → set α} {g : ι → β} (hf : locally_finite f)
-  (hg : function.injective g) : locally_finite (f ∘ g) :=
-λ x, let ⟨t, htx, htf⟩ := hf x in ⟨t, htx, htf.preimage (hg.inj_on _)⟩
-
-lemma locally_finite.closure {f : β → set α} (hf : locally_finite f) :
-  locally_finite (λ i, closure (f i)) :=
-begin
-  intro x,
-  rcases hf x with ⟨s, hsx, hsf⟩,
-  refine ⟨interior s, interior_mem_nhds.2 hsx, hsf.subset $ λ i hi, _⟩,
-  exact (hi.mono (closure_inter_open' is_open_interior)).of_closure.mono
-    (inter_subset_inter_right _ interior_subset)
-end
-
-lemma locally_finite.is_closed_Union {f : β → set α}
-  (h₁ : locally_finite f) (h₂ : ∀i, is_closed (f i)) : is_closed (⋃i, f i) :=
-begin
-  simp only [← is_open_compl_iff, compl_Union, is_open_iff_mem_nhds, mem_Inter],
-  intros a ha,
-  replace ha : ∀ i, (f i)ᶜ ∈ 𝓝 a := λ i, (h₂ i).is_open_compl.mem_nhds (ha i),
-  rcases h₁ a with ⟨t, h_nhds, h_fin⟩,
-  have : t ∩ (⋂ i ∈ {i | (f i ∩ t).nonempty}, (f i)ᶜ) ∈ 𝓝 a,
-    from inter_mem h_nhds ((bInter_mem h_fin).2 (λ i _, ha i)),
-  filter_upwards [this],
-  simp only [mem_inter_eq, mem_Inter],
-  rintros b ⟨hbt, hn⟩ i hfb,
-  exact hn i ⟨b, hfb, hbt⟩ hfb,
-end
-
-lemma locally_finite.closure_Union {f : β → set α} (h : locally_finite f) :
-  closure (⋃ i, f i) = ⋃ i, closure (f i) :=
-subset.antisymm
-  (closure_minimal (Union_mono $ λ _, subset_closure) $
-    h.closure.is_closed_Union $ λ _, is_closed_closure)
-  (Union_subset $ λ i, closure_mono $ subset_Union _ _)
-
-end locally_finite
-
 end topological_space
 
 /-!
@@ -1232,7 +1251,7 @@ end topological_space
 section continuous
 variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
 variables [topological_space α] [topological_space β] [topological_space γ]
-open_locale topological_space
+open_locale topology
 
 /-- A function between topological spaces is continuous if the preimage
   of every open set is open. Registered as a structure to make sure it is not unfolded by Lean. -/
@@ -1274,7 +1293,7 @@ h ht
 
 lemma eventually_eq_zero_nhds {M₀} [has_zero M₀] {a : α} {f : α → M₀} :
   f =ᶠ[𝓝 a] 0 ↔ a ∉ closure (function.support f) :=
-by rw [← mem_compl_eq, ← interior_compl, mem_interior_iff_mem_nhds, function.compl_support]; refl
+by rw [← mem_compl_iff, ← interior_compl, mem_interior_iff_mem_nhds, function.compl_support]; refl
 
 lemma cluster_pt.map {x : α} {la : filter α} {lb : filter β} (H : cluster_pt x la)
   {f : α → β} (hfc : continuous_at f x) (hf : tendsto f la lb) :
@@ -1301,6 +1320,12 @@ lemma continuous_at.comp {g : β → γ} {f : α → β} {x : α}
   continuous_at (g ∘ f) x :=
 hg.comp hf
 
+/-- See note [comp_of_eq lemmas] -/
+lemma continuous_at.comp_of_eq {g : β → γ} {f : α → β} {x : α} {y : β}
+  (hg : continuous_at g y) (hf : continuous_at f x) (hy : f x = y) :
+  continuous_at (g ∘ f) x :=
+by { subst hy, exact hg.comp hf }
+
 lemma continuous.tendsto {f : α → β} (hf : continuous f) (x) :
   tendsto f (𝓝 x) (𝓝 (f x)) :=
 ((nhds_basis_opens x).tendsto_iff $ nhds_basis_opens $ f x).2 $
@@ -1361,16 +1386,8 @@ continuous_iff_is_closed.mp hf s h
 
 lemma mem_closure_image {f : α → β} {x : α} {s : set α} (hf : continuous_at f x)
   (hx : x ∈ closure s) : f x ∈ closure (f '' s) :=
-begin
-  rw [mem_closure_iff_nhds_ne_bot] at hx ⊢,
-  rw ← bot_lt_iff_ne_bot,
-  haveI : ne_bot _ := ⟨hx⟩,
-  calc
-    ⊥   < map f (𝓝 x ⊓ principal s) : bot_lt_iff_ne_bot.mpr ne_bot.ne'
-    ... ≤ (map f $ 𝓝 x) ⊓ (map f $ principal s) : map_inf_le
-    ... = (map f $ 𝓝 x) ⊓ (principal $ f '' s) : by rw map_principal
-    ... ≤ 𝓝 (f x) ⊓ (principal $ f '' s) : inf_le_inf hf le_rfl
-end
+mem_closure_of_frequently_of_tendsto
+  ((mem_closure_iff_frequently.1 hx).mono (λ x, mem_image_of_mem _)) hf
 
 lemma continuous_at_iff_ultrafilter {f : α → β} {x} : continuous_at f x ↔
   ∀ g : ultrafilter α, ↑g ≤ 𝓝 x → tendsto f g (𝓝 (f x)) :=
@@ -1393,38 +1410,6 @@ lemma continuous.frontier_preimage_subset
   frontier (f ⁻¹' t) ⊆ f ⁻¹' (frontier t) :=
 diff_subset_diff (hf.closure_preimage_subset t) (preimage_interior_subset_interior_preimage hf)
 
-/-! ### Continuity and partial functions -/
-
-/-- Continuity of a partial function -/
-def pcontinuous (f : α →. β) := ∀ s, is_open s → is_open (f.preimage s)
-
-lemma open_dom_of_pcontinuous {f : α →. β} (h : pcontinuous f) : is_open f.dom :=
-by rw [←pfun.preimage_univ]; exact h _ is_open_univ
-
-lemma pcontinuous_iff' {f : α →. β} :
-  pcontinuous f ↔ ∀ {x y} (h : y ∈ f x), ptendsto' f (𝓝 x) (𝓝 y) :=
-begin
-  split,
-  { intros h x y h',
-    simp only [ptendsto'_def, mem_nhds_iff],
-    rintros s ⟨t, tsubs, opent, yt⟩,
-    exact ⟨f.preimage t, pfun.preimage_mono _ tsubs, h _ opent, ⟨y, yt, h'⟩⟩ },
-  intros hf s os,
-  rw is_open_iff_nhds,
-  rintros x ⟨y, ys, fxy⟩ t,
-  rw [mem_principal],
-  assume h : f.preimage s ⊆ t,
-  change t ∈ 𝓝 x,
-  apply mem_of_superset _ h,
-  have h' : ∀ s ∈ 𝓝 y, f.preimage s ∈ 𝓝 x,
-  { intros s hs,
-     have : ptendsto' f (𝓝 x) (𝓝 y) := hf fxy,
-     rw ptendsto'_def at this,
-     exact this s hs },
-  show f.preimage s ∈ 𝓝 x,
-  apply h', rw mem_nhds_iff, exact ⟨s, set.subset.refl _, os, ys⟩
-end
-
 /-- If a continuous map `f` maps `s` to `t`, then it maps `closure s` to `closure t`. -/
 lemma set.maps_to.closure {s : set α} {t : set β} {f : α → β} (h : maps_to f s t)
   (hc : continuous f) : maps_to f (closure s) (closure t) :=
@@ -1442,8 +1427,13 @@ lemma closure_subset_preimage_closure_image {f : α → β} {s : set α} (h : co
 by { rw ← set.image_subset_iff, exact image_closure_subset_closure_image h }
 
 lemma map_mem_closure {s : set α} {t : set β} {f : α → β} {a : α}
-  (hf : continuous f) (ha : a ∈ closure s) (ht : ∀a∈s, f a ∈ t) : f a ∈ closure t :=
-set.maps_to.closure ht hf ha
+  (hf : continuous f) (ha : a ∈ closure s) (ht : maps_to f s t) : f a ∈ closure t :=
+ht.closure hf ha
+
+/-- If a continuous map `f` maps `s` to a closed set `t`, then it maps `closure s` to `t`. -/
+lemma set.maps_to.closure_left {s : set α} {t : set β} {f : α → β} (h : maps_to f s t)
+  (hc : continuous f) (ht : is_closed t) : maps_to f (closure s) t :=
+ht.closure_eq ▸ h.closure hc
 
 /-!
 ### Function with dense range
@@ -1461,6 +1451,9 @@ variables {f}
 lemma function.surjective.dense_range (hf : function.surjective f) : dense_range f :=
 λ x, by simp [hf.range_eq]
 
+lemma dense_range_id : dense_range (id : α → α) :=
+function.surjective.dense_range function.surjective_id
+
 lemma dense_range_iff_closure_range : dense_range f ↔ closure (range f) = univ :=
 dense_iff_closure_eq
 
@@ -1517,13 +1510,9 @@ lemma dense_range.exists_mem_open (hf : dense_range f) {s : set β} (ho : is_ope
 exists_range_iff.1 $ hf.exists_mem_open ho hs
 
 lemma dense_range.mem_nhds {f : κ → β} (h : dense_range f) {b : β} {U : set β}
-  (U_in : U ∈ nhds b) : ∃ a, f a ∈ U :=
-begin
-  rcases (mem_closure_iff_nhds.mp
-    ((dense_range_iff_closure_range.mp h).symm ▸ mem_univ b : b ∈ closure (range f)) U U_in)
-    with ⟨_, h, a, rfl⟩,
-  exact ⟨a, h⟩
-end
+  (U_in : U ∈ 𝓝 b) : ∃ a, f a ∈ U :=
+let ⟨a, ha⟩ := h.exists_mem_open is_open_interior ⟨b, mem_interior_iff_mem_nhds.2 U_in⟩
+in ⟨a, interior_subset ha⟩
 
 end dense_range
 
@@ -1546,7 +1535,7 @@ However, lemmas with this conclusion are not nice to use in practice because
 1. They confuse the elaborator. The following two examples fail, because of limitations in the
   elaboration process.
   ```
-  variables {M : Type*} [has_mul M] [topological_space M] [has_continuous_mul M]
+  variables {M : Type*} [has_add M] [topological_space M] [has_continuous_add M]
   example : continuous (λ x : M, x + x) :=
   continuous_add.comp _
 
@@ -1624,3 +1613,31 @@ With `continuous_at` you can be even more precise about what to prove in case of
 see e.g. `continuous_at.comp_div_cases`.
 -/
 library_note "continuity lemma statement"
+
+/--
+Lean's elaborator has trouble elaborating applications of lemmas that state that the composition of
+two functions satisfy some property at a point, like `continuous_at.comp` / `cont_diff_at.comp` and
+`cont_mdiff_within_at.comp`. The reason is that a lemma like this looks like
+`continuous_at g (f x) → continuous_at f x → continuous_at (g ∘ f) x`.
+Since Lean's elaborator elaborates the arguments from left-to-right, when you write `hg.comp hf`,
+the elaborator will try to figure out *both* `f` and `g` from the type of `hg`. It tries to figure
+out `f` just from the point where `g` is continuous. For example, if `hg : continuous_at g (a, x)`
+then the elaborator will assign `f` to the function `prod.mk a`, since in that case `f x = (a, x)`.
+This is undesirable in most cases where `f` is not a variable. There are some ways to work around
+this, for example by giving `f` explicitly, or to force Lean to elaborate `hf` before elaborating
+`hg`, but this is annoying.
+Another better solution is to reformulate composition lemmas to have the following shape
+`continuous_at g y → continuous_at f x → f x = y → continuous_at (g ∘ f) x`.
+This is even useful if the proof of `f x = y` is `rfl`.
+The reason that this works better is because the type of `hg` doesn't mention `f`.
+Only after elaborating the two `continuous_at` arguments, Lean will try to unify `f x` with `y`,
+which is often easy after having chosen the correct functions for `f` and `g`.
+Here is an example that shows the difference:
+```
+example {x₀ : α} (f : α → α → β) (hf : continuous_at (function.uncurry f) (x₀, x₀)) :
+  continuous_at (λ x => f x x) x₀ :=
+-- hf.comp x (continuous_at_id.prod continuous_at_id) -- type mismatch
+-- hf.comp_of_eq (continuous_at_id.prod continuous_at_id) rfl -- works
+```
+-/
+library_note "comp_of_eq lemmas"
diff --git a/src/topology/bornology/basic.lean b/src/topology/bornology/basic.lean
index c3aeef4234909..6d518439fe531 100644
--- a/src/topology/bornology/basic.lean
+++ b/src/topology/bornology/basic.lean
@@ -8,6 +8,9 @@ import order.filter.cofinite
 /-!
 # Basic theory of bornology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We develop the basic theory of bornologies. Instead of axiomatizing bounded sets and defining
 bornologies in terms of those, we recognize that the cobounded sets form a filter and define a
 bornology as a filter of cobounded sets which contains the cofinite filter.  This allows us to make
@@ -104,8 +107,8 @@ by rw [is_bounded_def, is_cobounded_def, compl_compl]
 
 @[simp] lemma is_cobounded_compl_iff : is_cobounded sᶜ ↔ is_bounded s := iff.rfl
 
-alias is_bounded_compl_iff ↔ bornology.is_bounded.of_compl bornology.is_cobounded.compl
-alias is_cobounded_compl_iff ↔ bornology.is_cobounded.of_compl bornology.is_bounded.compl
+alias is_bounded_compl_iff ↔ is_bounded.of_compl is_cobounded.compl
+alias is_cobounded_compl_iff ↔ is_cobounded.of_compl is_bounded.compl
 
 @[simp] lemma is_bounded_empty : is_bounded (∅ : set α) :=
 by { rw [is_bounded_def, compl_empty], exact univ_mem}
@@ -168,7 +171,7 @@ by rw [is_bounded_def, ←filter.mem_sets, of_bounded_cobounded_sets, set.mem_se
 
 variables [bornology α]
 
-lemma is_cobounded_bInter {s : set ι} {f : ι → set α} (hs : finite s) :
+lemma is_cobounded_bInter {s : set ι} {f : ι → set α} (hs : s.finite) :
   is_cobounded (⋂ i ∈ s, f i) ↔ ∀ i ∈ s, is_cobounded (f i) :=
 bInter_mem hs
 
@@ -176,15 +179,15 @@ bInter_mem hs
   is_cobounded (⋂ i ∈ s, f i) ↔ ∀ i ∈ s, is_cobounded (f i) :=
 bInter_finset_mem s
 
-@[simp] lemma is_cobounded_Inter [fintype ι] {f : ι → set α} :
+@[simp] lemma is_cobounded_Inter [finite ι] {f : ι → set α} :
   is_cobounded (⋂ i, f i) ↔ ∀ i, is_cobounded (f i) :=
 Inter_mem
 
-lemma is_cobounded_sInter {S : set (set α)} (hs : finite S) :
+lemma is_cobounded_sInter {S : set (set α)} (hs : S.finite) :
   is_cobounded (⋂₀ S) ↔ ∀ s ∈ S, is_cobounded s :=
 sInter_mem hs
 
-lemma is_bounded_bUnion {s : set ι} {f : ι → set α} (hs : finite s) :
+lemma is_bounded_bUnion {s : set ι} {f : ι → set α} (hs : s.finite) :
   is_bounded (⋃ i ∈ s, f i) ↔ ∀ i ∈ s, is_bounded (f i) :=
 by simp only [← is_cobounded_compl_iff, compl_Union, is_cobounded_bInter hs]
 
@@ -192,11 +195,11 @@ lemma is_bounded_bUnion_finset (s : finset ι) {f : ι → set α} :
   is_bounded (⋃ i ∈ s, f i) ↔ ∀ i ∈ s, is_bounded (f i) :=
 is_bounded_bUnion s.finite_to_set
 
-lemma is_bounded_sUnion {S : set (set α)} (hs : finite S) :
+lemma is_bounded_sUnion {S : set (set α)} (hs : S.finite) :
   is_bounded (⋃₀ S) ↔ (∀ s ∈ S, is_bounded s) :=
 by rw [sUnion_eq_bUnion, is_bounded_bUnion hs]
 
-@[simp] lemma is_bounded_Union [fintype ι] {s : ι → set α} :
+@[simp] lemma is_bounded_Union [finite ι] {s : ι → set α} :
   is_bounded (⋃ i, s i) ↔ ∀ i, is_bounded (s i) :=
 by rw [← sUnion_range, is_bounded_sUnion (finite_range s), forall_range_iff]
 
diff --git a/src/topology/bornology/constructions.lean b/src/topology/bornology/constructions.lean
index 1886ce80562f2..3b9212fa47b0f 100644
--- a/src/topology/bornology/constructions.lean
+++ b/src/topology/bornology/constructions.lean
@@ -8,6 +8,9 @@ import topology.bornology.basic
 /-!
 # Bornology structure on products and subtypes
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `bornology` and `bounded_space` instances on `α × β`, `Π i, π i`, and
 `{x // p x}`. We also prove basic lemmas about `bornology.cobounded` and `bornology.is_bounded`
 on these types.
@@ -100,7 +103,7 @@ begin
   by_cases hne : ∃ i, S i = ∅,
   { simp [hne, univ_pi_eq_empty_iff.2 hne] },
   { simp only [hne, false_or],
-    simp only [not_exists, ← ne.def, ne_empty_iff_nonempty, ← univ_pi_nonempty_iff] at hne,
+    simp only [not_exists, ← ne.def, ←nonempty_iff_ne_empty, ← univ_pi_nonempty_iff] at hne,
     exact is_bounded_pi_of_nonempty hne }
 end
 
@@ -145,3 +148,23 @@ alias bounded_space_coe_set_iff ↔ _ bornology.is_bounded.bounded_space_coe
 
 instance [bounded_space α] {p : α → Prop} : bounded_space (subtype p) :=
 (is_bounded.all {x | p x}).bounded_space_subtype
+
+/-!
+### `additive`, `multiplicative`
+
+The bornology on those type synonyms is inherited without change.
+-/
+
+instance : bornology (additive α) := ‹bornology α›
+instance : bornology (multiplicative α) := ‹bornology α›
+instance [bounded_space α] : bounded_space (additive α) := ‹bounded_space α›
+instance [bounded_space α] : bounded_space (multiplicative α) := ‹bounded_space α›
+
+/-!
+### Order dual
+
+The bornology on this type synonym is inherited without change.
+-/
+
+instance : bornology αᵒᵈ := ‹bornology α›
+instance [bounded_space α] : bounded_space αᵒᵈ := ‹bounded_space α›
diff --git a/src/topology/bornology/hom.lean b/src/topology/bornology/hom.lean
index aeca18629976d..021cac114f084 100644
--- a/src/topology/bornology/hom.lean
+++ b/src/topology/bornology/hom.lean
@@ -8,6 +8,9 @@ import topology.bornology.basic
 /-!
 # Locally bounded maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines locally bounded maps between bornologies.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -31,6 +34,9 @@ structure locally_bounded_map (α β : Type*) [bornology α] [bornology β] :=
 (to_fun : α → β)
 (comap_cobounded_le' : (cobounded β).comap to_fun ≤ cobounded α)
 
+section
+set_option old_structure_cmd true
+
 /-- `locally_bounded_map_class F α β` states that `F` is a type of bounded maps.
 
 You should extend this class when you extend `locally_bounded_map`. -/
@@ -39,6 +45,8 @@ class locally_bounded_map_class (F : Type*) (α β : out_param $ Type*) [bornolo
   extends fun_like F α (λ _, β) :=
 (comap_cobounded_le (f : F) : (cobounded β).comap f ≤ cobounded α)
 
+end
+
 export locally_bounded_map_class (comap_cobounded_le)
 
 lemma is_bounded.image [bornology α] [bornology β] [locally_bounded_map_class F α β] {f : F}
@@ -72,6 +80,13 @@ protected def copy (f : locally_bounded_map α β) (f' : α → β) (h : f' = f)
   locally_bounded_map α β :=
 ⟨f', h.symm ▸ f.comap_cobounded_le'⟩
 
+@[simp] lemma coe_copy (f : locally_bounded_map α β) (f' : α → β) (h : f' = f) :
+  ⇑(f.copy f' h) = f' :=
+rfl
+
+lemma copy_eq (f : locally_bounded_map α β) (f' : α → β) (h : f' = f) : f.copy f' h = f :=
+fun_like.ext' h
+
 /-- Construct a `locally_bounded_map` from the fact that the function maps bounded sets to bounded
 sets. -/
 def of_map_bounded (f : α → β) (h) : locally_bounded_map α β := ⟨f, comap_cobounded_le_iff.2 h⟩
diff --git a/src/topology/category/Born.lean b/src/topology/category/Born.lean
index a2b432df926fd..fbc84ec041044 100644
--- a/src/topology/category/Born.lean
+++ b/src/topology/category/Born.lean
@@ -9,6 +9,9 @@ import topology.bornology.hom
 /-!
 # The category of bornologies
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This defines `Born`, the category of bornologies.
 -/
 
diff --git a/src/topology/category/CompHaus/basic.lean b/src/topology/category/CompHaus/basic.lean
new file mode 100644
index 0000000000000..ebb5dd0d43957
--- /dev/null
+++ b/src/topology/category/CompHaus/basic.lean
@@ -0,0 +1,251 @@
+/-
+Copyright (c) 2020 Adam Topaz. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Adam Topaz, Bhavik Mehta
+-/
+
+import category_theory.adjunction.reflective
+import topology.stone_cech
+import category_theory.monad.limits
+import topology.urysohns_lemma
+import topology.category.Top.limits.basic
+
+/-!
+# The category of Compact Hausdorff Spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We construct the category of compact Hausdorff spaces.
+The type of compact Hausdorff spaces is denoted `CompHaus`, and it is endowed with a category
+instance making it a full subcategory of `Top`.
+The fully faithful functor `CompHaus ⥤ Top` is denoted `CompHaus_to_Top`.
+
+**Note:** The file `topology/category/Compactum.lean` provides the equivalence between `Compactum`,
+which is defined as the category of algebras for the ultrafilter monad, and `CompHaus`.
+`Compactum_to_CompHaus` is the functor from `Compactum` to `CompHaus` which is proven to be an
+equivalence of categories in `Compactum_to_CompHaus.is_equivalence`.
+See `topology/category/Compactum.lean` for a more detailed discussion where these definitions are
+introduced.
+
+-/
+
+universes v u
+
+open category_theory
+
+/-- The type of Compact Hausdorff topological spaces. -/
+structure CompHaus :=
+(to_Top : Top)
+[is_compact : compact_space to_Top]
+[is_hausdorff : t2_space to_Top]
+
+namespace CompHaus
+
+instance : inhabited CompHaus := ⟨{to_Top := { α := pempty }}⟩
+
+instance : has_coe_to_sort CompHaus Type* := ⟨λ X, X.to_Top⟩
+instance {X : CompHaus} : compact_space X := X.is_compact
+instance {X : CompHaus} : t2_space X := X.is_hausdorff
+
+instance category : category CompHaus := induced_category.category to_Top
+
+instance concrete_category : concrete_category CompHaus :=
+induced_category.concrete_category _
+
+@[simp]
+lemma coe_to_Top {X : CompHaus} : (X.to_Top : Type*) = X :=
+rfl
+
+variables (X : Type*) [topological_space X] [compact_space X] [t2_space X]
+
+/-- A constructor for objects of the category `CompHaus`,
+taking a type, and bundling the compact Hausdorff topology
+found by typeclass inference. -/
+def of : CompHaus :=
+{ to_Top := Top.of X,
+  is_compact := ‹_›,
+  is_hausdorff := ‹_› }
+
+@[simp] lemma coe_of : (CompHaus.of X : Type _) = X := rfl
+
+/-- Any continuous function on compact Hausdorff spaces is a closed map. -/
+lemma is_closed_map {X Y : CompHaus.{u}} (f : X ⟶ Y) : is_closed_map f :=
+λ C hC, (hC.is_compact.image f.continuous).is_closed
+
+/-- Any continuous bijection of compact Hausdorff spaces is an isomorphism. -/
+lemma is_iso_of_bijective {X Y : CompHaus.{u}} (f : X ⟶ Y) (bij : function.bijective f) :
+  is_iso f :=
+begin
+  let E := equiv.of_bijective _ bij,
+  have hE : continuous E.symm,
+  { rw continuous_iff_is_closed,
+    intros S hS,
+    rw ← E.image_eq_preimage,
+    exact is_closed_map f S hS },
+  refine ⟨⟨⟨E.symm, hE⟩, _, _⟩⟩,
+  { ext x,
+    apply E.symm_apply_apply },
+  { ext x,
+    apply E.apply_symm_apply }
+end
+
+/-- Any continuous bijection of compact Hausdorff spaces induces an isomorphism. -/
+noncomputable
+def iso_of_bijective {X Y : CompHaus.{u}} (f : X ⟶ Y) (bij : function.bijective f) : X ≅ Y :=
+by letI := is_iso_of_bijective _ bij; exact as_iso f
+
+end CompHaus
+
+/-- The fully faithful embedding of `CompHaus` in `Top`. -/
+@[simps {rhs_md := semireducible}, derive [full, faithful]]
+def CompHaus_to_Top : CompHaus.{u} ⥤ Top.{u} := induced_functor _
+
+instance CompHaus.forget_reflects_isomorphisms : reflects_isomorphisms (forget CompHaus.{u}) :=
+⟨by introsI A B f hf; exact CompHaus.is_iso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩
+
+/--
+(Implementation) The object part of the compactification functor from topological spaces to
+compact Hausdorff spaces.
+-/
+@[simps]
+def StoneCech_obj (X : Top) : CompHaus := CompHaus.of (stone_cech X)
+
+/--
+(Implementation) The bijection of homsets to establish the reflective adjunction of compact
+Hausdorff spaces in topological spaces.
+-/
+noncomputable def stone_cech_equivalence (X : Top.{u}) (Y : CompHaus.{u}) :
+  (StoneCech_obj X ⟶ Y) ≃ (X ⟶ CompHaus_to_Top.obj Y) :=
+{ to_fun := λ f,
+  { to_fun := f ∘ stone_cech_unit,
+    continuous_to_fun := f.2.comp (@continuous_stone_cech_unit X _) },
+  inv_fun := λ f,
+  { to_fun := stone_cech_extend f.2,
+    continuous_to_fun := continuous_stone_cech_extend f.2 },
+  left_inv :=
+  begin
+    rintro ⟨f : stone_cech X ⟶ Y, hf : continuous f⟩,
+    ext (x : stone_cech X),
+    refine congr_fun _ x,
+    apply continuous.ext_on dense_range_stone_cech_unit (continuous_stone_cech_extend _) hf,
+    rintro _ ⟨y, rfl⟩,
+    apply congr_fun (stone_cech_extend_extends (hf.comp _)) y,
+  end,
+  right_inv :=
+  begin
+    rintro ⟨f : (X : Type*) ⟶ Y, hf : continuous f⟩,
+    ext,
+    exact congr_fun (stone_cech_extend_extends hf) _,
+  end }
+
+/--
+The Stone-Cech compactification functor from topological spaces to compact Hausdorff spaces,
+left adjoint to the inclusion functor.
+-/
+noncomputable def Top_to_CompHaus : Top.{u} ⥤ CompHaus.{u} :=
+adjunction.left_adjoint_of_equiv stone_cech_equivalence.{u} (λ _ _ _ _ _, rfl)
+
+lemma Top_to_CompHaus_obj (X : Top) : ↥(Top_to_CompHaus.obj X) = stone_cech X :=
+rfl
+
+/--
+The category of compact Hausdorff spaces is reflective in the category of topological spaces.
+-/
+noncomputable instance CompHaus_to_Top.reflective : reflective CompHaus_to_Top :=
+{ to_is_right_adjoint := ⟨Top_to_CompHaus, adjunction.adjunction_of_equiv_left _ _⟩ }
+
+noncomputable instance CompHaus_to_Top.creates_limits : creates_limits CompHaus_to_Top :=
+monadic_creates_limits _
+
+instance CompHaus.has_limits : limits.has_limits CompHaus :=
+has_limits_of_has_limits_creates_limits CompHaus_to_Top
+
+instance CompHaus.has_colimits : limits.has_colimits CompHaus :=
+has_colimits_of_reflective CompHaus_to_Top
+
+namespace CompHaus
+
+/-- An explicit limit cone for a functor `F : J ⥤ CompHaus`, defined in terms of
+`Top.limit_cone`. -/
+def limit_cone {J : Type v} [small_category J] (F : J ⥤ CompHaus.{max v u}) :
+  limits.cone F :=
+{ X :=
+  { to_Top := (Top.limit_cone (F ⋙ CompHaus_to_Top)).X,
+    is_compact := begin
+      show compact_space ↥{u : Π j, (F.obj j) | ∀ {i j : J} (f : i ⟶ j), (F.map f) (u i) = u j},
+      rw ← is_compact_iff_compact_space,
+      apply is_closed.is_compact,
+      have : {u : Π j, F.obj j | ∀ {i j : J} (f : i ⟶ j), F.map f (u i) = u j} =
+        ⋂ (i j : J) (f : i ⟶ j), {u | F.map f (u i) = u j},
+      { ext1, simp only [set.mem_Inter, set.mem_set_of_eq], },
+      rw this,
+      apply is_closed_Inter, intros i,
+      apply is_closed_Inter, intros j,
+      apply is_closed_Inter, intros f,
+      apply is_closed_eq,
+      { exact (continuous_map.continuous (F.map f)).comp (continuous_apply i), },
+      { exact continuous_apply j, }
+    end,
+    is_hausdorff :=
+      show t2_space ↥{u : Π j, (F.obj j) | ∀ {i j : J} (f : i ⟶ j), (F.map f) (u i) = u j},
+      from infer_instance },
+  π :=
+  { app := λ j, (Top.limit_cone (F ⋙ CompHaus_to_Top)).π.app j,
+    naturality' := by { intros _ _ _, ext ⟨x, hx⟩,
+      simp only [comp_apply, functor.const_obj_map, id_apply], exact (hx f).symm, } } }
+
+/-- The limit cone `CompHaus.limit_cone F` is indeed a limit cone. -/
+def limit_cone_is_limit {J : Type v} [small_category J] (F : J ⥤ CompHaus.{max v u}) :
+  limits.is_limit (limit_cone F) :=
+{ lift := λ S,
+    (Top.limit_cone_is_limit (F ⋙ CompHaus_to_Top)).lift (CompHaus_to_Top.map_cone S),
+  uniq' := λ S m h, (Top.limit_cone_is_limit _).uniq (CompHaus_to_Top.map_cone S) _ h }
+
+lemma epi_iff_surjective {X Y : CompHaus.{u}} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
+begin
+  split,
+  { contrapose!,
+    rintros ⟨y, hy⟩ hf,
+    let C := set.range f,
+    have hC : is_closed C := (is_compact_range f.continuous).is_closed,
+    let D := {y},
+    have hD : is_closed D := is_closed_singleton,
+    have hCD : disjoint C D,
+    { rw set.disjoint_singleton_right, rintro ⟨y', hy'⟩, exact hy y' hy' },
+    haveI : normal_space ↥(Y.to_Top) := normal_of_compact_t2,
+    obtain ⟨φ, hφ0, hφ1, hφ01⟩ := exists_continuous_zero_one_of_closed hC hD hCD,
+    haveI : compact_space (ulift.{u} $ set.Icc (0:ℝ) 1) := homeomorph.ulift.symm.compact_space,
+    haveI : t2_space (ulift.{u} $ set.Icc (0:ℝ) 1) := homeomorph.ulift.symm.t2_space,
+    let Z := of (ulift.{u} $ set.Icc (0:ℝ) 1),
+    let g : Y ⟶ Z := ⟨λ y', ⟨⟨φ y', hφ01 y'⟩⟩,
+      continuous_ulift_up.comp (φ.continuous.subtype_mk (λ y', hφ01 y'))⟩,
+    let h : Y ⟶ Z := ⟨λ _, ⟨⟨0, set.left_mem_Icc.mpr zero_le_one⟩⟩, continuous_const⟩,
+    have H : h = g,
+    { rw ← cancel_epi f,
+      ext x, dsimp,
+      simp only [comp_apply, continuous_map.coe_mk, subtype.coe_mk, hφ0 (set.mem_range_self x),
+        pi.zero_apply], },
+    apply_fun (λ e, (e y).down) at H,
+    dsimp at H,
+    simp only [subtype.mk_eq_mk, hφ1 (set.mem_singleton y), pi.one_apply] at H,
+    exact zero_ne_one H, },
+  { rw ← category_theory.epi_iff_surjective,
+    apply (forget CompHaus).epi_of_epi_map }
+end
+
+lemma mono_iff_injective {X Y : CompHaus.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
+begin
+  split,
+  { introsI hf x₁ x₂ h,
+    let g₁ : of punit ⟶ X := ⟨λ _, x₁, continuous_const⟩,
+    let g₂ : of punit ⟶ X := ⟨λ _, x₂, continuous_const⟩,
+    have : g₁ ≫ f = g₂ ≫ f, by { ext, exact h },
+    rw cancel_mono at this,
+    apply_fun (λ e, e punit.star) at this,
+    exact this },
+  { rw ← category_theory.mono_iff_injective,
+    apply (forget CompHaus).mono_of_mono_map }
+end
+
+end CompHaus
diff --git a/src/topology/category/CompHaus/default.lean b/src/topology/category/CompHaus/default.lean
deleted file mode 100644
index fc416fd442b02..0000000000000
--- a/src/topology/category/CompHaus/default.lean
+++ /dev/null
@@ -1,248 +0,0 @@
-/-
-Copyright (c) 2020 Adam Topaz. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Adam Topaz, Bhavik Mehta
--/
-
-import category_theory.adjunction.reflective
-import topology.category.Top
-import topology.stone_cech
-import category_theory.monad.limits
-import topology.urysohns_lemma
-
-/-!
-# The category of Compact Hausdorff Spaces
-
-We construct the category of compact Hausdorff spaces.
-The type of compact Hausdorff spaces is denoted `CompHaus`, and it is endowed with a category
-instance making it a full subcategory of `Top`.
-The fully faithful functor `CompHaus ⥤ Top` is denoted `CompHaus_to_Top`.
-
-**Note:** The file `topology/category/Compactum.lean` provides the equivalence between `Compactum`,
-which is defined as the category of algebras for the ultrafilter monad, and `CompHaus`.
-`Compactum_to_CompHaus` is the functor from `Compactum` to `CompHaus` which is proven to be an
-equivalence of categories in `Compactum_to_CompHaus.is_equivalence`.
-See `topology/category/Compactum.lean` for a more detailed discussion where these definitions are
-introduced.
-
--/
-
-universe u
-
-open category_theory
-
-/-- The type of Compact Hausdorff topological spaces. -/
-structure CompHaus :=
-(to_Top : Top)
-[is_compact : compact_space to_Top]
-[is_hausdorff : t2_space to_Top]
-
-namespace CompHaus
-
-instance : inhabited CompHaus := ⟨{to_Top := { α := pempty }}⟩
-
-instance : has_coe_to_sort CompHaus Type* := ⟨λ X, X.to_Top⟩
-instance {X : CompHaus} : compact_space X := X.is_compact
-instance {X : CompHaus} : t2_space X := X.is_hausdorff
-
-instance category : category CompHaus := induced_category.category to_Top
-
-instance concrete_category : concrete_category CompHaus :=
-induced_category.concrete_category _
-
-@[simp]
-lemma coe_to_Top {X : CompHaus} : (X.to_Top : Type*) = X :=
-rfl
-
-variables (X : Type*) [topological_space X] [compact_space X] [t2_space X]
-
-/-- A constructor for objects of the category `CompHaus`,
-taking a type, and bundling the compact Hausdorff topology
-found by typeclass inference. -/
-def of : CompHaus :=
-{ to_Top := Top.of X,
-  is_compact := ‹_›,
-  is_hausdorff := ‹_› }
-
-@[simp] lemma coe_of : (CompHaus.of X : Type _) = X := rfl
-
-/-- Any continuous function on compact Hausdorff spaces is a closed map. -/
-lemma is_closed_map {X Y : CompHaus.{u}} (f : X ⟶ Y) : is_closed_map f :=
-λ C hC, (hC.is_compact.image f.continuous).is_closed
-
-/-- Any continuous bijection of compact Hausdorff spaces is an isomorphism. -/
-lemma is_iso_of_bijective {X Y : CompHaus.{u}} (f : X ⟶ Y) (bij : function.bijective f) :
-  is_iso f :=
-begin
-  let E := equiv.of_bijective _ bij,
-  have hE : continuous E.symm,
-  { rw continuous_iff_is_closed,
-    intros S hS,
-    rw ← E.image_eq_preimage,
-    exact is_closed_map f S hS },
-  refine ⟨⟨⟨E.symm, hE⟩, _, _⟩⟩,
-  { ext x,
-    apply E.symm_apply_apply },
-  { ext x,
-    apply E.apply_symm_apply }
-end
-
-/-- Any continuous bijection of compact Hausdorff spaces induces an isomorphism. -/
-noncomputable
-def iso_of_bijective {X Y : CompHaus.{u}} (f : X ⟶ Y) (bij : function.bijective f) : X ≅ Y :=
-by letI := is_iso_of_bijective _ bij; exact as_iso f
-
-end CompHaus
-
-/-- The fully faithful embedding of `CompHaus` in `Top`. -/
-@[simps {rhs_md := semireducible}, derive [full, faithful]]
-def CompHaus_to_Top : CompHaus.{u} ⥤ Top.{u} := induced_functor _
-
-instance CompHaus.forget_reflects_isomorphisms : reflects_isomorphisms (forget CompHaus.{u}) :=
-⟨by introsI A B f hf; exact CompHaus.is_iso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩
-
-/--
-(Implementation) The object part of the compactification functor from topological spaces to
-compact Hausdorff spaces.
--/
-@[simps]
-def StoneCech_obj (X : Top) : CompHaus := CompHaus.of (stone_cech X)
-
-/--
-(Implementation) The bijection of homsets to establish the reflective adjunction of compact
-Hausdorff spaces in topological spaces.
--/
-noncomputable def stone_cech_equivalence (X : Top.{u}) (Y : CompHaus.{u}) :
-  (StoneCech_obj X ⟶ Y) ≃ (X ⟶ CompHaus_to_Top.obj Y) :=
-{ to_fun := λ f,
-  { to_fun := f ∘ stone_cech_unit,
-    continuous_to_fun := f.2.comp (@continuous_stone_cech_unit X _) },
-  inv_fun := λ f,
-  { to_fun := stone_cech_extend f.2,
-    continuous_to_fun := continuous_stone_cech_extend f.2 },
-  left_inv :=
-  begin
-    rintro ⟨f : stone_cech X ⟶ Y, hf : continuous f⟩,
-    ext (x : stone_cech X),
-    refine congr_fun _ x,
-    apply continuous.ext_on dense_range_stone_cech_unit (continuous_stone_cech_extend _) hf,
-    rintro _ ⟨y, rfl⟩,
-    apply congr_fun (stone_cech_extend_extends (hf.comp _)) y,
-  end,
-  right_inv :=
-  begin
-    rintro ⟨f : (X : Type*) ⟶ Y, hf : continuous f⟩,
-    ext,
-    exact congr_fun (stone_cech_extend_extends hf) _,
-  end }
-
-/--
-The Stone-Cech compactification functor from topological spaces to compact Hausdorff spaces,
-left adjoint to the inclusion functor.
--/
-noncomputable def Top_to_CompHaus : Top.{u} ⥤ CompHaus.{u} :=
-adjunction.left_adjoint_of_equiv stone_cech_equivalence.{u} (λ _ _ _ _ _, rfl)
-
-lemma Top_to_CompHaus_obj (X : Top) : ↥(Top_to_CompHaus.obj X) = stone_cech X :=
-rfl
-
-/--
-The category of compact Hausdorff spaces is reflective in the category of topological spaces.
--/
-noncomputable instance CompHaus_to_Top.reflective : reflective CompHaus_to_Top :=
-{ to_is_right_adjoint := ⟨Top_to_CompHaus, adjunction.adjunction_of_equiv_left _ _⟩ }
-
-noncomputable instance CompHaus_to_Top.creates_limits : creates_limits CompHaus_to_Top :=
-monadic_creates_limits _
-
-instance CompHaus.has_limits : limits.has_limits CompHaus :=
-has_limits_of_has_limits_creates_limits CompHaus_to_Top
-
-instance CompHaus.has_colimits : limits.has_colimits CompHaus :=
-has_colimits_of_reflective CompHaus_to_Top
-
-namespace CompHaus
-
-/-- An explicit limit cone for a functor `F : J ⥤ CompHaus`, defined in terms of
-`Top.limit_cone`. -/
-def limit_cone {J : Type u} [small_category J] (F : J ⥤ CompHaus.{u}) :
-  limits.cone F :=
-{ X :=
-  { to_Top := (Top.limit_cone (F ⋙ CompHaus_to_Top)).X,
-    is_compact := begin
-      show compact_space ↥{u : Π j, (F.obj j) | ∀ {i j : J} (f : i ⟶ j), (F.map f) (u i) = u j},
-      rw ← is_compact_iff_compact_space,
-      apply is_closed.is_compact,
-      have : {u : Π j, F.obj j | ∀ {i j : J} (f : i ⟶ j), F.map f (u i) = u j} =
-        ⋂ (i j : J) (f : i ⟶ j), {u | F.map f (u i) = u j},
-      { ext1, simp only [set.mem_Inter, set.mem_set_of_eq], },
-      rw this,
-      apply is_closed_Inter, intros i,
-      apply is_closed_Inter, intros j,
-      apply is_closed_Inter, intros f,
-      apply is_closed_eq,
-      { exact (continuous_map.continuous (F.map f)).comp (continuous_apply i), },
-      { exact continuous_apply j, }
-    end,
-    is_hausdorff :=
-      show t2_space ↥{u : Π j, (F.obj j) | ∀ {i j : J} (f : i ⟶ j), (F.map f) (u i) = u j},
-      from infer_instance },
-  π :=
-  { app := λ j, (Top.limit_cone (F ⋙ CompHaus_to_Top)).π.app j,
-    naturality' := by { intros _ _ _, ext ⟨x, hx⟩,
-      simp only [comp_apply, functor.const.obj_map, id_apply], exact (hx f).symm, } } }
-
-/-- The limit cone `CompHaus.limit_cone F` is indeed a limit cone. -/
-def limit_cone_is_limit {J : Type u} [small_category J] (F : J ⥤ CompHaus.{u}) :
-  limits.is_limit (limit_cone F) :=
-{ lift := λ S,
-    (Top.limit_cone_is_limit (F ⋙ CompHaus_to_Top)).lift (CompHaus_to_Top.map_cone S),
-  uniq' := λ S m h, (Top.limit_cone_is_limit _).uniq (CompHaus_to_Top.map_cone S) _ h }
-
-lemma epi_iff_surjective {X Y : CompHaus.{u}} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
-begin
-  split,
-  { contrapose!,
-    rintros ⟨y, hy⟩ hf,
-    let C := set.range f,
-    have hC : is_closed C := (is_compact_range f.continuous).is_closed,
-    let D := {y},
-    have hD : is_closed D := is_closed_singleton,
-    have hCD : disjoint C D,
-    { rw set.disjoint_singleton_right, rintro ⟨y', hy'⟩, exact hy y' hy' },
-    haveI : normal_space ↥(Y.to_Top) := normal_of_compact_t2,
-    obtain ⟨φ, hφ0, hφ1, hφ01⟩ := exists_continuous_zero_one_of_closed hC hD hCD,
-    haveI : compact_space (ulift.{u} $ set.Icc (0:ℝ) 1) := homeomorph.ulift.symm.compact_space,
-    haveI : t2_space (ulift.{u} $ set.Icc (0:ℝ) 1) := homeomorph.ulift.symm.t2_space,
-    let Z := of (ulift.{u} $ set.Icc (0:ℝ) 1),
-    let g : Y ⟶ Z := ⟨λ y', ⟨⟨φ y', hφ01 y'⟩⟩,
-      continuous_ulift_up.comp (continuous_subtype_mk (λ y', hφ01 y') φ.continuous)⟩,
-    let h : Y ⟶ Z := ⟨λ _, ⟨⟨0, set.left_mem_Icc.mpr zero_le_one⟩⟩, continuous_const⟩,
-    have H : h = g,
-    { rw ← cancel_epi f,
-      ext x, dsimp,
-      simp only [comp_apply, continuous_map.coe_mk, subtype.coe_mk, hφ0 (set.mem_range_self x),
-        pi.zero_apply], },
-    apply_fun (λ e, (e y).down) at H,
-    dsimp at H,
-    simp only [subtype.mk_eq_mk, hφ1 (set.mem_singleton y), pi.one_apply] at H,
-    exact zero_ne_one H, },
-  { rw ← category_theory.epi_iff_surjective,
-    apply faithful_reflects_epi (forget CompHaus) },
-end
-
-lemma mono_iff_injective {X Y : CompHaus.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
-begin
-  split,
-  { introsI hf x₁ x₂ h,
-    let g₁ : of punit ⟶ X := ⟨λ _, x₁, continuous_of_discrete_topology⟩,
-    let g₂ : of punit ⟶ X := ⟨λ _, x₂, continuous_of_discrete_topology⟩,
-    have : g₁ ≫ f = g₂ ≫ f, by { ext, exact h },
-    rw cancel_mono at this,
-    apply_fun (λ e, e punit.star) at this,
-    exact this },
-  { rw ← category_theory.mono_iff_injective,
-    apply faithful_reflects_mono (forget CompHaus) }
-end
-
-end CompHaus
diff --git a/src/topology/category/CompHaus/projective.lean b/src/topology/category/CompHaus/projective.lean
index 6ff261e92f42c..7a9b880053992 100644
--- a/src/topology/category/CompHaus/projective.lean
+++ b/src/topology/category/CompHaus/projective.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 
-import topology.category.CompHaus
+import topology.category.CompHaus.basic
 import topology.stone_cech
 import category_theory.preadditive.projective
 
 /-!
 # CompHaus has enough projectives
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we show that `CompHaus` has enough projectives.
 
 ## Main results
diff --git a/src/topology/category/Compactum.lean b/src/topology/category/Compactum.lean
index 68850283ad17d..b0a26f2fed396 100644
--- a/src/topology/category/Compactum.lean
+++ b/src/topology/category/Compactum.lean
@@ -7,14 +7,17 @@ Authors: Adam Topaz
 import category_theory.monad.types
 import category_theory.monad.limits
 import category_theory.equivalence
-import topology.category.CompHaus
-import topology.category.Profinite
+import topology.category.CompHaus.basic
+import topology.category.Profinite.basic
 import data.set.constructions
 
 /-!
 
 # Compacta and Compact Hausdorff Spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Recall that, given a monad `M` on `Type*`, an *algebra* for `M` consists of the following data:
 - A type `X : Type*`
 - A "structure" map `M X → X`.
@@ -72,7 +75,7 @@ We also add wrappers around structures which already exist. Here are the main on
 
 universe u
 open category_theory filter ultrafilter topological_space category_theory.limits has_finite_inter
-open_locale classical topological_space
+open_locale classical topology
 
 local notation `β` := of_type_monad ultrafilter
 
diff --git a/src/topology/category/Locale.lean b/src/topology/category/Locale.lean
index 85a3223a11f35..2bfa9589c3744 100644
--- a/src/topology/category/Locale.lean
+++ b/src/topology/category/Locale.lean
@@ -3,11 +3,14 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import order.category.Frame
+import order.category.Frm
 
 /-!
 # The category of locales
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines `Locale`, the category of locales. This is the opposite of the category of frames.
 -/
 
@@ -16,7 +19,7 @@ universes u
 open category_theory opposite order topological_space
 
 /-- The category of locales. -/
-@[derive large_category] def Locale := Frameᵒᵖ
+@[derive large_category] def Locale := Frmᵒᵖ
 
 namespace Locale
 
@@ -24,7 +27,7 @@ instance : has_coe_to_sort Locale Type* := ⟨λ X, X.unop⟩
 instance (X : Locale) : frame X := X.unop.str
 
 /-- Construct a bundled `Locale` from a `frame`. -/
-def of (α : Type*) [frame α] : Locale := op $ Frame.of α
+def of (α : Type*) [frame α] : Locale := op $ Frm.of α
 
 @[simp] lemma coe_of (α : Type*) [frame α] : ↥(of α) = α := rfl
 
diff --git a/src/topology/category/Profinite/as_limit.lean b/src/topology/category/Profinite/as_limit.lean
index f7d2da181c805..9796c77c7ab6c 100644
--- a/src/topology/category/Profinite/as_limit.lean
+++ b/src/topology/category/Profinite/as_limit.lean
@@ -3,12 +3,15 @@ Copyright (c) 2021 Adam Topaz. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Calle Sönne, Adam Topaz
 -/
-import topology.category.Profinite
+import topology.category.Profinite.basic
 import topology.discrete_quotient
 
 /-!
 # Profinite sets as limits of finite sets.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We show that any profinite set is isomorphic to the limit of its
 discrete (hence finite) quotients.
 
@@ -40,7 +43,7 @@ variables (X : Profinite.{u})
 
 /-- The functor `discrete_quotient X ⥤ Fintype` whose limit is isomorphic to `X`. -/
 def fintype_diagram : discrete_quotient X ⥤ Fintype :=
-{ obj := λ S, Fintype.of S,
+{ obj := λ S, by haveI := fintype.of_finite S; exact Fintype.of S,
   map := λ S T f, discrete_quotient.of_le f.le }
 
 /-- An abbreviation for `X.fintype_diagram ⋙ Fintype_to_Profinite`. -/
@@ -56,9 +59,8 @@ instance is_iso_as_limit_cone_lift :
   is_iso ((limit_cone_is_limit X.diagram).lift X.as_limit_cone) :=
 is_iso_of_bijective _
 begin
-  refine ⟨λ a b, _, λ a, _⟩,
-  { intro h,
-    refine discrete_quotient.eq_of_proj_eq (λ S, _),
+  refine ⟨λ a b h, _, λ a, _⟩,
+  { refine discrete_quotient.eq_of_forall_proj_eq (λ S, _),
     apply_fun (λ f : (limit_cone X.diagram).X, f.val S) at h,
     exact h },
   { obtain ⟨b, hb⟩ := discrete_quotient.exists_of_compat
diff --git a/src/topology/category/Profinite/basic.lean b/src/topology/category/Profinite/basic.lean
new file mode 100644
index 0000000000000..8f71fdef069dc
--- /dev/null
+++ b/src/topology/category/Profinite/basic.lean
@@ -0,0 +1,301 @@
+/-
+Copyright (c) 2020 Kevin Buzzard. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Kevin Buzzard, Calle Sönne
+-/
+
+import topology.category.CompHaus.basic
+import topology.connected
+import topology.subset_properties
+import topology.locally_constant.basic
+import category_theory.adjunction.reflective
+import category_theory.monad.limits
+import category_theory.Fintype
+
+/-!
+# The category of Profinite Types
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We construct the category of profinite topological spaces,
+often called profinite sets -- perhaps they could be called
+profinite types in Lean.
+
+The type of profinite topological spaces is called `Profinite`. It has a category
+instance and is a fully faithful subcategory of `Top`. The fully faithful functor
+is called `Profinite_to_Top`.
+
+## Implementation notes
+
+A profinite type is defined to be a topological space which is
+compact, Hausdorff and totally disconnected.
+
+## TODO
+
+0. Link to category of projective limits of finite discrete sets.
+1. finite coproducts
+2. Clausen/Scholze topology on the category `Profinite`.
+
+## Tags
+
+profinite
+
+-/
+
+universe u
+
+open category_theory
+open_locale topology
+
+/-- The type of profinite topological spaces. -/
+structure Profinite :=
+(to_CompHaus : CompHaus)
+[is_totally_disconnected : totally_disconnected_space to_CompHaus]
+
+namespace Profinite
+
+/--
+Construct a term of `Profinite` from a type endowed with the structure of a
+compact, Hausdorff and totally disconnected topological space.
+-/
+def of (X : Type*) [topological_space X] [compact_space X] [t2_space X]
+  [totally_disconnected_space X] : Profinite := ⟨⟨⟨X⟩⟩⟩
+
+instance : inhabited Profinite := ⟨Profinite.of pempty⟩
+
+instance category : category Profinite := induced_category.category to_CompHaus
+instance concrete_category : concrete_category Profinite := induced_category.concrete_category _
+instance has_forget₂ : has_forget₂ Profinite Top := induced_category.has_forget₂ _
+
+instance : has_coe_to_sort Profinite Type* := ⟨λ X, X.to_CompHaus⟩
+instance {X : Profinite} : totally_disconnected_space X := X.is_totally_disconnected
+
+-- We check that we automatically infer that Profinite sets are compact and Hausdorff.
+example {X : Profinite} : compact_space X := infer_instance
+example {X : Profinite} : t2_space X := infer_instance
+
+@[simp]
+lemma coe_to_CompHaus {X : Profinite} : (X.to_CompHaus : Type*) = X :=
+rfl
+
+@[simp] lemma coe_id (X : Profinite) : (𝟙 X : X → X) = id := rfl
+
+@[simp] lemma coe_comp {X Y Z : Profinite} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g : X → Z) = g ∘ f := rfl
+
+end Profinite
+
+/-- The fully faithful embedding of `Profinite` in `CompHaus`. -/
+@[simps, derive [full, faithful]]
+def Profinite_to_CompHaus : Profinite ⥤ CompHaus := induced_functor _
+
+/-- The fully faithful embedding of `Profinite` in `Top`. This is definitionally the same as the
+obvious composite. -/
+@[simps, derive [full, faithful]]
+def Profinite.to_Top : Profinite ⥤ Top := forget₂ _ _
+
+@[simp] lemma Profinite.to_CompHaus_to_Top :
+  Profinite_to_CompHaus ⋙ CompHaus_to_Top = Profinite.to_Top :=
+rfl
+
+section Profinite
+
+/--
+(Implementation) The object part of the connected_components functor from compact Hausdorff spaces
+to Profinite spaces, given by quotienting a space by its connected components.
+See: https://stacks.math.columbia.edu/tag/0900
+-/
+-- Without explicit universe annotations here, Lean introduces two universe variables and
+-- unhelpfully defines a function `CompHaus.{max u₁ u₂} → Profinite.{max u₁ u₂}`.
+def CompHaus.to_Profinite_obj (X : CompHaus.{u}) : Profinite.{u} :=
+{ to_CompHaus :=
+  { to_Top := Top.of (connected_components X),
+    is_compact := quotient.compact_space,
+    is_hausdorff := connected_components.t2 },
+  is_totally_disconnected := connected_components.totally_disconnected_space }
+
+/--
+(Implementation) The bijection of homsets to establish the reflective adjunction of Profinite
+spaces in compact Hausdorff spaces.
+-/
+def Profinite.to_CompHaus_equivalence (X : CompHaus.{u}) (Y : Profinite.{u}) :
+  (CompHaus.to_Profinite_obj X ⟶ Y) ≃ (X ⟶ Profinite_to_CompHaus.obj Y) :=
+{ to_fun := λ f, f.comp ⟨quotient.mk', continuous_quotient_mk⟩,
+  inv_fun := λ g,
+    { to_fun := continuous.connected_components_lift g.2,
+      continuous_to_fun := continuous.connected_components_lift_continuous g.2},
+  left_inv := λ f, continuous_map.ext $ connected_components.surjective_coe.forall.2 $ λ a, rfl,
+  right_inv := λ f, continuous_map.ext $ λ x, rfl }
+
+/--
+The connected_components functor from compact Hausdorff spaces to profinite spaces,
+left adjoint to the inclusion functor.
+-/
+def CompHaus.to_Profinite : CompHaus ⥤ Profinite :=
+adjunction.left_adjoint_of_equiv Profinite.to_CompHaus_equivalence (λ _ _ _ _ _, rfl)
+
+lemma CompHaus.to_Profinite_obj' (X : CompHaus) :
+  ↥(CompHaus.to_Profinite.obj X) = connected_components X := rfl
+
+/-- Finite types are given the discrete topology. -/
+def Fintype.bot_topology (A : Fintype) : topological_space A := ⊥
+
+section discrete_topology
+
+local attribute [instance] Fintype.bot_topology
+
+local attribute [instance]
+lemma Fintype.discrete_topology (A : Fintype) : discrete_topology A := ⟨rfl⟩
+
+/-- The natural functor from `Fintype` to `Profinite`, endowing a finite type with the
+discrete topology. -/
+@[simps] def Fintype.to_Profinite : Fintype ⥤ Profinite :=
+{ obj := λ A, Profinite.of A,
+  map := λ _ _ f, ⟨f⟩ }
+
+end discrete_topology
+
+end Profinite
+
+namespace Profinite
+
+-- TODO the following construction of limits could be generalised
+-- to allow diagrams in lower universes.
+
+/-- An explicit limit cone for a functor `F : J ⥤ Profinite`, defined in terms of
+`Top.limit_cone`. -/
+def limit_cone {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
+  limits.cone F :=
+{ X :=
+  { to_CompHaus := (CompHaus.limit_cone.{u u} (F ⋙ Profinite_to_CompHaus)).X,
+    is_totally_disconnected :=
+    begin
+      change totally_disconnected_space ↥{u : Π (j : J), (F.obj j) | _},
+      exact subtype.totally_disconnected_space,
+    end },
+  π := { app := (CompHaus.limit_cone.{u u} (F ⋙ Profinite_to_CompHaus)).π.app } }
+
+/-- The limit cone `Profinite.limit_cone F` is indeed a limit cone. -/
+def limit_cone_is_limit {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
+  limits.is_limit (limit_cone F) :=
+{ lift := λ S, (CompHaus.limit_cone_is_limit.{u u} (F ⋙ Profinite_to_CompHaus)).lift
+    (Profinite_to_CompHaus.map_cone S),
+  uniq' := λ S m h,
+    (CompHaus.limit_cone_is_limit.{u u} _).uniq (Profinite_to_CompHaus.map_cone S) _ h }
+
+/-- The adjunction between CompHaus.to_Profinite and Profinite.to_CompHaus -/
+def to_Profinite_adj_to_CompHaus : CompHaus.to_Profinite ⊣ Profinite_to_CompHaus :=
+adjunction.adjunction_of_equiv_left _ _
+
+/-- The category of profinite sets is reflective in the category of compact hausdroff spaces -/
+instance to_CompHaus.reflective : reflective Profinite_to_CompHaus :=
+{ to_is_right_adjoint := ⟨CompHaus.to_Profinite, Profinite.to_Profinite_adj_to_CompHaus⟩ }
+
+noncomputable
+instance to_CompHaus.creates_limits : creates_limits Profinite_to_CompHaus :=
+monadic_creates_limits _
+
+noncomputable
+instance to_Top.reflective : reflective Profinite.to_Top :=
+reflective.comp Profinite_to_CompHaus CompHaus_to_Top
+
+noncomputable
+instance to_Top.creates_limits : creates_limits Profinite.to_Top :=
+monadic_creates_limits _
+
+instance has_limits : limits.has_limits Profinite :=
+has_limits_of_has_limits_creates_limits Profinite.to_Top
+
+instance has_colimits : limits.has_colimits Profinite :=
+has_colimits_of_reflective Profinite_to_CompHaus
+
+noncomputable
+instance forget_preserves_limits : limits.preserves_limits (forget Profinite) :=
+by apply limits.comp_preserves_limits Profinite.to_Top (forget Top)
+
+variables {X Y : Profinite.{u}} (f : X ⟶ Y)
+
+/-- Any morphism of profinite spaces is a closed map. -/
+lemma is_closed_map : is_closed_map f :=
+CompHaus.is_closed_map _
+
+/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
+lemma is_iso_of_bijective (bij : function.bijective f) : is_iso f :=
+begin
+  haveI := CompHaus.is_iso_of_bijective (Profinite_to_CompHaus.map f) bij,
+  exact is_iso_of_fully_faithful Profinite_to_CompHaus _
+end
+
+/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
+noncomputable def iso_of_bijective (bij : function.bijective f) : X ≅ Y :=
+by letI := Profinite.is_iso_of_bijective f bij; exact as_iso f
+
+instance forget_reflects_isomorphisms : reflects_isomorphisms (forget Profinite) :=
+⟨by introsI A B f hf; exact Profinite.is_iso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩
+
+/-- Construct an isomorphism from a homeomorphism. -/
+@[simps hom inv] def iso_of_homeo (f : X ≃ₜ Y) : X ≅ Y :=
+{ hom := ⟨f, f.continuous⟩,
+  inv := ⟨f.symm, f.symm.continuous⟩,
+  hom_inv_id' := by { ext x, exact f.symm_apply_apply x },
+  inv_hom_id' := by { ext x, exact f.apply_symm_apply x } }
+
+/-- Construct a homeomorphism from an isomorphism. -/
+@[simps] def homeo_of_iso (f : X ≅ Y) : X ≃ₜ Y :=
+{ to_fun := f.hom,
+  inv_fun := f.inv,
+  left_inv := λ x, by { change (f.hom ≫ f.inv) x = x, rw [iso.hom_inv_id, coe_id, id.def] },
+  right_inv := λ x, by { change (f.inv ≫ f.hom) x = x, rw [iso.inv_hom_id, coe_id, id.def] },
+  continuous_to_fun := f.hom.continuous,
+  continuous_inv_fun := f.inv.continuous }
+
+/-- The equivalence between isomorphisms in `Profinite` and homeomorphisms
+of topological spaces. -/
+@[simps] def iso_equiv_homeo : (X ≅ Y) ≃ (X ≃ₜ Y) :=
+{ to_fun := homeo_of_iso,
+  inv_fun := iso_of_homeo,
+  left_inv := λ f, by { ext, refl },
+  right_inv := λ f, by { ext, refl } }
+
+lemma epi_iff_surjective {X Y : Profinite.{u}} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
+begin
+  split,
+  { contrapose!,
+    rintros ⟨y, hy⟩ hf, resetI,
+    let C := set.range f,
+    have hC : is_closed C := (is_compact_range f.continuous).is_closed,
+    let U := Cᶜ,
+    have hyU : y ∈ U,
+    { refine set.mem_compl _, rintro ⟨y', hy'⟩, exact hy y' hy' },
+    have hUy : U ∈ 𝓝 y := hC.compl_mem_nhds hyU,
+    obtain ⟨V, hV, hyV, hVU⟩ := is_topological_basis_clopen.mem_nhds_iff.mp hUy,
+    classical,
+    let Z := of (ulift.{u} $ fin 2),
+    let g : Y ⟶ Z := ⟨(locally_constant.of_clopen hV).map ulift.up, locally_constant.continuous _⟩,
+    let h : Y ⟶ Z := ⟨λ _, ⟨1⟩, continuous_const⟩,
+    have H : h = g,
+    { rw ← cancel_epi f,
+      ext x, dsimp [locally_constant.of_clopen],
+      rw if_neg, { refl },
+      refine mt (λ α, hVU α) _,
+      simp only [set.mem_range_self, not_true, not_false_iff, set.mem_compl_iff], },
+    apply_fun (λ e, (e y).down) at H,
+    dsimp [locally_constant.of_clopen] at H,
+    rw if_pos hyV at H,
+    exact top_ne_bot H },
+  { rw ← category_theory.epi_iff_surjective,
+    apply (forget Profinite).epi_of_epi_map }
+end
+
+lemma mono_iff_injective {X Y : Profinite.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
+begin
+  split,
+  { intro h,
+    haveI : limits.preserves_limits Profinite_to_CompHaus := infer_instance,
+    haveI : mono (Profinite_to_CompHaus.map f) := infer_instance,
+    rwa ← CompHaus.mono_iff_injective },
+  { rw ← category_theory.mono_iff_injective,
+    apply (forget Profinite).mono_of_mono_map }
+end
+
+end Profinite
diff --git a/src/topology/category/Profinite/cofiltered_limit.lean b/src/topology/category/Profinite/cofiltered_limit.lean
index a816a4a13c585..0e36712aa5c79 100644
--- a/src/topology/category/Profinite/cofiltered_limit.lean
+++ b/src/topology/category/Profinite/cofiltered_limit.lean
@@ -3,13 +3,18 @@ Copyright (c) 2021 Adam Topaz. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Adam Topaz
 -/
-import topology.category.Profinite
+import topology.category.Profinite.basic
 import topology.locally_constant.basic
 import topology.discrete_quotient
+import topology.category.Top.limits.cofiltered
+import topology.category.Top.limits.konig
 
 /-!
 # Cofiltered limits of profinite sets.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file contains some theorems about cofiltered limits of profinite sets.
 
 ## Main Results
@@ -42,7 +47,7 @@ theorem exists_clopen_of_cofiltered {U : set C.X} (hU : is_clopen U) :
 begin
   -- First, we have the topological basis of the cofiltered limit obtained by pulling back
   -- clopen sets from the factors in the limit. By continuity, all such sets are again clopen.
-  have hB := Top.is_topological_basis_cofiltered_limit
+  have hB := Top.is_topological_basis_cofiltered_limit.{u}
     (F ⋙ Profinite.to_Top)
     (Profinite.to_Top.map_cone C)
     (is_limit_of_preserves _ hC)
@@ -90,7 +95,7 @@ begin
     if hs : s ∈ G then F.map (f s hs) ⁻¹' (V s) else set.univ,
   -- Conclude, using the `j0` and the clopen set of `F.obj j0` obtained above.
   refine ⟨j0, ⋃ (s : S) (hs : s ∈ G), W s, _, _⟩,
-  { apply is_clopen_bUnion,
+  { apply is_clopen_bUnion_finset,
     intros s hs,
     dsimp only [W],
     rw dif_pos hs,
@@ -127,10 +132,11 @@ begin
   rw [locally_constant.of_clopen_fiber_zero hV, ← h],
 end
 
-theorem exists_locally_constant_fintype_aux {α : Type*} [fintype α] (f : locally_constant C.X α) :
+theorem exists_locally_constant_finite_aux {α : Type*} [finite α] (f : locally_constant C.X α) :
   ∃ (j : J) (g : locally_constant (F.obj j) (α → fin 2)),
     f.map (λ a b, if a = b then (0 : fin 2) else 1) = g.comap (C.π.app _) :=
 begin
+  casesI nonempty_fintype α,
   let ι : α → α → fin 2 := λ x y, if x = y then 0 else 1,
   let ff := (f.map ι).flip,
   have hff := λ (a : α), exists_locally_constant_fin_two _ hC (ff a),
@@ -164,12 +170,12 @@ begin
   all_goals { continuity },
 end
 
-theorem exists_locally_constant_fintype_nonempty {α : Type*} [fintype α] [nonempty α]
+theorem exists_locally_constant_finite_nonempty {α : Type*} [finite α] [nonempty α]
   (f : locally_constant C.X α) :
   ∃ (j : J) (g : locally_constant (F.obj j) α), f = g.comap (C.π.app _) :=
 begin
   inhabit α,
-  obtain ⟨j,gg,h⟩ := exists_locally_constant_fintype_aux _ hC f,
+  obtain ⟨j,gg,h⟩ := exists_locally_constant_finite_aux _ hC f,
   let ι : α → α → fin 2 := λ a b, if a = b then 0 else 1,
   let σ : (α → fin 2) → α := λ f, if h : ∃ (a : α), ι a = f then h.some else arbitrary _,
   refine ⟨j, gg.map σ, _⟩,
@@ -220,10 +226,10 @@ begin
     suffices : nonempty C.X, from is_empty.false (S.proj this.some),
     let D := Profinite.to_Top.map_cone C,
     have hD : is_limit D := is_limit_of_preserves Profinite.to_Top hC,
-    have CD := (hD.cone_point_unique_up_to_iso (Top.limit_cone_is_limit _)).inv,
+    have CD := (hD.cone_point_unique_up_to_iso (Top.limit_cone_is_limit.{u} _)).inv,
     exact cond.map CD },
   { let f' : locally_constant C.X S := ⟨S.proj, S.proj_is_locally_constant⟩,
-    obtain ⟨j, g', hj⟩ := exists_locally_constant_fintype_nonempty _ hC f',
+    obtain ⟨j, g', hj⟩ := exists_locally_constant_finite_nonempty _ hC f',
     refine ⟨j, ⟨ff ∘ g', g'.is_locally_constant.comp _⟩,_⟩,
     ext1 t,
     apply_fun (λ e, e t) at hj,
diff --git a/src/topology/category/Profinite/default.lean b/src/topology/category/Profinite/default.lean
deleted file mode 100644
index 33669f7141d69..0000000000000
--- a/src/topology/category/Profinite/default.lean
+++ /dev/null
@@ -1,294 +0,0 @@
-/-
-Copyright (c) 2020 Kevin Buzzard. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Kevin Buzzard, Calle Sönne
--/
-
-import topology.category.CompHaus
-import topology.connected
-import topology.subset_properties
-import topology.locally_constant.basic
-import category_theory.adjunction.reflective
-import category_theory.monad.limits
-import category_theory.limits.constructions.epi_mono
-import category_theory.Fintype
-
-/-!
-# The category of Profinite Types
-
-We construct the category of profinite topological spaces,
-often called profinite sets -- perhaps they could be called
-profinite types in Lean.
-
-The type of profinite topological spaces is called `Profinite`. It has a category
-instance and is a fully faithful subcategory of `Top`. The fully faithful functor
-is called `Profinite_to_Top`.
-
-## Implementation notes
-
-A profinite type is defined to be a topological space which is
-compact, Hausdorff and totally disconnected.
-
-## TODO
-
-0. Link to category of projective limits of finite discrete sets.
-1. finite coproducts
-2. Clausen/Scholze topology on the category `Profinite`.
-
-## Tags
-
-profinite
-
--/
-
-universe u
-
-open category_theory
-
-/-- The type of profinite topological spaces. -/
-structure Profinite :=
-(to_CompHaus : CompHaus)
-[is_totally_disconnected : totally_disconnected_space to_CompHaus]
-
-namespace Profinite
-
-/--
-Construct a term of `Profinite` from a type endowed with the structure of a
-compact, Hausdorff and totally disconnected topological space.
--/
-def of (X : Type*) [topological_space X] [compact_space X] [t2_space X]
-  [totally_disconnected_space X] : Profinite := ⟨⟨⟨X⟩⟩⟩
-
-instance : inhabited Profinite := ⟨Profinite.of pempty⟩
-
-instance category : category Profinite := induced_category.category to_CompHaus
-instance concrete_category : concrete_category Profinite := induced_category.concrete_category _
-instance has_forget₂ : has_forget₂ Profinite Top := induced_category.has_forget₂ _
-
-instance : has_coe_to_sort Profinite Type* := ⟨λ X, X.to_CompHaus⟩
-instance {X : Profinite} : totally_disconnected_space X := X.is_totally_disconnected
-
--- We check that we automatically infer that Profinite sets are compact and Hausdorff.
-example {X : Profinite} : compact_space X := infer_instance
-example {X : Profinite} : t2_space X := infer_instance
-
-@[simp]
-lemma coe_to_CompHaus {X : Profinite} : (X.to_CompHaus : Type*) = X :=
-rfl
-
-@[simp] lemma coe_id (X : Profinite) : (𝟙 X : X → X) = id := rfl
-
-@[simp] lemma coe_comp {X Y Z : Profinite} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g : X → Z) = g ∘ f := rfl
-
-end Profinite
-
-/-- The fully faithful embedding of `Profinite` in `CompHaus`. -/
-@[simps, derive [full, faithful]]
-def Profinite_to_CompHaus : Profinite ⥤ CompHaus := induced_functor _
-
-/-- The fully faithful embedding of `Profinite` in `Top`. This is definitionally the same as the
-obvious composite. -/
-@[simps, derive [full, faithful]]
-def Profinite.to_Top : Profinite ⥤ Top := forget₂ _ _
-
-@[simp] lemma Profinite.to_CompHaus_to_Top :
-  Profinite_to_CompHaus ⋙ CompHaus_to_Top = Profinite.to_Top :=
-rfl
-
-section Profinite
-
-/--
-(Implementation) The object part of the connected_components functor from compact Hausdorff spaces
-to Profinite spaces, given by quotienting a space by its connected components.
-See: https://stacks.math.columbia.edu/tag/0900
--/
--- Without explicit universe annotations here, Lean introduces two universe variables and
--- unhelpfully defines a function `CompHaus.{max u₁ u₂} → Profinite.{max u₁ u₂}`.
-def CompHaus.to_Profinite_obj (X : CompHaus.{u}) : Profinite.{u} :=
-{ to_CompHaus :=
-  { to_Top := Top.of (connected_components X),
-    is_compact := quotient.compact_space,
-    is_hausdorff := connected_components.t2 },
-  is_totally_disconnected := connected_components.totally_disconnected_space }
-
-/--
-(Implementation) The bijection of homsets to establish the reflective adjunction of Profinite
-spaces in compact Hausdorff spaces.
--/
-def Profinite.to_CompHaus_equivalence (X : CompHaus.{u}) (Y : Profinite.{u}) :
-  (CompHaus.to_Profinite_obj X ⟶ Y) ≃ (X ⟶ Profinite_to_CompHaus.obj Y) :=
-{ to_fun := λ f, f.comp ⟨quotient.mk', continuous_quotient_mk⟩,
-  inv_fun := λ g,
-    { to_fun := continuous.connected_components_lift g.2,
-      continuous_to_fun := continuous.connected_components_lift_continuous g.2},
-  left_inv := λ f, continuous_map.ext $ connected_components.surjective_coe.forall.2 $ λ a, rfl,
-  right_inv := λ f, continuous_map.ext $ λ x, rfl }
-
-/--
-The connected_components functor from compact Hausdorff spaces to profinite spaces,
-left adjoint to the inclusion functor.
--/
-def CompHaus.to_Profinite : CompHaus ⥤ Profinite :=
-adjunction.left_adjoint_of_equiv Profinite.to_CompHaus_equivalence (λ _ _ _ _ _, rfl)
-
-lemma CompHaus.to_Profinite_obj' (X : CompHaus) :
-  ↥(CompHaus.to_Profinite.obj X) = connected_components X := rfl
-
-/-- Finite types are given the discrete topology. -/
-def Fintype.discrete_topology (A : Fintype) : topological_space A := ⊥
-
-section discrete_topology
-
-local attribute [instance] Fintype.discrete_topology
-
-/-- The natural functor from `Fintype` to `Profinite`, endowing a finite type with the
-discrete topology. -/
-@[simps] def Fintype.to_Profinite : Fintype ⥤ Profinite :=
-{ obj := λ A, Profinite.of A,
-  map := λ _ _ f, ⟨f⟩ }
-
-end discrete_topology
-
-end Profinite
-
-namespace Profinite
-
-/-- An explicit limit cone for a functor `F : J ⥤ Profinite`, defined in terms of
-`Top.limit_cone`. -/
-def limit_cone {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
-  limits.cone F :=
-{ X :=
-  { to_CompHaus := (CompHaus.limit_cone (F ⋙ Profinite_to_CompHaus)).X,
-    is_totally_disconnected :=
-    begin
-      change totally_disconnected_space ↥{u : Π (j : J), (F.obj j) | _},
-      exact subtype.totally_disconnected_space,
-    end },
-  π := { app := (CompHaus.limit_cone (F ⋙ Profinite_to_CompHaus)).π.app } }
-
-/-- The limit cone `Profinite.limit_cone F` is indeed a limit cone. -/
-def limit_cone_is_limit {J : Type u} [small_category J] (F : J ⥤ Profinite.{u}) :
-  limits.is_limit (limit_cone F) :=
-{ lift := λ S, (CompHaus.limit_cone_is_limit (F ⋙ Profinite_to_CompHaus)).lift
-    (Profinite_to_CompHaus.map_cone S),
-  uniq' := λ S m h,
-    (CompHaus.limit_cone_is_limit _).uniq (Profinite_to_CompHaus.map_cone S) _ h }
-
-/-- The adjunction between CompHaus.to_Profinite and Profinite.to_CompHaus -/
-def to_Profinite_adj_to_CompHaus : CompHaus.to_Profinite ⊣ Profinite_to_CompHaus :=
-adjunction.adjunction_of_equiv_left _ _
-
-/-- The category of profinite sets is reflective in the category of compact hausdroff spaces -/
-instance to_CompHaus.reflective : reflective Profinite_to_CompHaus :=
-{ to_is_right_adjoint := ⟨CompHaus.to_Profinite, Profinite.to_Profinite_adj_to_CompHaus⟩ }
-
-noncomputable
-instance to_CompHaus.creates_limits : creates_limits Profinite_to_CompHaus :=
-monadic_creates_limits _
-
-noncomputable
-instance to_Top.reflective : reflective Profinite.to_Top :=
-reflective.comp Profinite_to_CompHaus CompHaus_to_Top
-
-noncomputable
-instance to_Top.creates_limits : creates_limits Profinite.to_Top :=
-monadic_creates_limits _
-
-instance has_limits : limits.has_limits Profinite :=
-has_limits_of_has_limits_creates_limits Profinite.to_Top
-
-instance has_colimits : limits.has_colimits Profinite :=
-has_colimits_of_reflective Profinite_to_CompHaus
-
-noncomputable
-instance forget_preserves_limits : limits.preserves_limits (forget Profinite) :=
-by apply limits.comp_preserves_limits Profinite.to_Top (forget Top)
-
-variables {X Y : Profinite.{u}} (f : X ⟶ Y)
-
-/-- Any morphism of profinite spaces is a closed map. -/
-lemma is_closed_map : is_closed_map f :=
-CompHaus.is_closed_map _
-
-/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
-lemma is_iso_of_bijective (bij : function.bijective f) : is_iso f :=
-begin
-  haveI := CompHaus.is_iso_of_bijective (Profinite_to_CompHaus.map f) bij,
-  exact is_iso_of_fully_faithful Profinite_to_CompHaus _
-end
-
-/-- Any continuous bijection of profinite spaces induces an isomorphism. -/
-noncomputable def iso_of_bijective (bij : function.bijective f) : X ≅ Y :=
-by letI := Profinite.is_iso_of_bijective f bij; exact as_iso f
-
-instance forget_reflects_isomorphisms : reflects_isomorphisms (forget Profinite) :=
-⟨by introsI A B f hf; exact Profinite.is_iso_of_bijective _ ((is_iso_iff_bijective f).mp hf)⟩
-
-/-- Construct an isomorphism from a homeomorphism. -/
-@[simps hom inv] def iso_of_homeo (f : X ≃ₜ Y) : X ≅ Y :=
-{ hom := ⟨f, f.continuous⟩,
-  inv := ⟨f.symm, f.symm.continuous⟩,
-  hom_inv_id' := by { ext x, exact f.symm_apply_apply x },
-  inv_hom_id' := by { ext x, exact f.apply_symm_apply x } }
-
-/-- Construct a homeomorphism from an isomorphism. -/
-@[simps] def homeo_of_iso (f : X ≅ Y) : X ≃ₜ Y :=
-{ to_fun := f.hom,
-  inv_fun := f.inv,
-  left_inv := λ x, by { change (f.hom ≫ f.inv) x = x, rw [iso.hom_inv_id, coe_id, id.def] },
-  right_inv := λ x, by { change (f.inv ≫ f.hom) x = x, rw [iso.inv_hom_id, coe_id, id.def] },
-  continuous_to_fun := f.hom.continuous,
-  continuous_inv_fun := f.inv.continuous }
-
-/-- The equivalence between isomorphisms in `Profinite` and homeomorphisms
-of topological spaces. -/
-@[simps] def iso_equiv_homeo : (X ≅ Y) ≃ (X ≃ₜ Y) :=
-{ to_fun := homeo_of_iso,
-  inv_fun := iso_of_homeo,
-  left_inv := λ f, by { ext, refl },
-  right_inv := λ f, by { ext, refl } }
-
-lemma epi_iff_surjective {X Y : Profinite.{u}} (f : X ⟶ Y) : epi f ↔ function.surjective f :=
-begin
-  split,
-  { contrapose!,
-    rintros ⟨y, hy⟩ hf,
-    let C := set.range f,
-    have hC : is_closed C := (is_compact_range f.continuous).is_closed,
-    let U := Cᶜ,
-    have hU : is_open U := is_open_compl_iff.mpr hC,
-    have hyU : y ∈ U,
-    { refine set.mem_compl _, rintro ⟨y', hy'⟩, exact hy y' hy' },
-    have hUy : U ∈ nhds y := hU.mem_nhds hyU,
-    obtain ⟨V, hV, hyV, hVU⟩ := is_topological_basis_clopen.mem_nhds_iff.mp hUy,
-    classical,
-    letI : topological_space (ulift.{u} $ fin 2) := ⊥,
-    let Z := of (ulift.{u} $ fin 2),
-    let g : Y ⟶ Z := ⟨(locally_constant.of_clopen hV).map ulift.up, locally_constant.continuous _⟩,
-    let h : Y ⟶ Z := ⟨λ _, ⟨1⟩, continuous_const⟩,
-    have H : h = g,
-    { rw ← cancel_epi f,
-      ext x, dsimp [locally_constant.of_clopen],
-      rw if_neg, { refl },
-      refine mt (λ α, hVU α) _,
-      simp only [set.mem_range_self, not_true, not_false_iff, set.mem_compl_eq], },
-    apply_fun (λ e, (e y).down) at H,
-    dsimp [locally_constant.of_clopen] at H,
-    rw if_pos hyV at H,
-    exact top_ne_bot H },
-  { rw ← category_theory.epi_iff_surjective,
-    apply faithful_reflects_epi (forget Profinite) },
-end
-
-lemma mono_iff_injective {X Y : Profinite.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
-begin
-  split,
-  { intro h,
-    haveI : limits.preserves_limits Profinite_to_CompHaus := infer_instance,
-    haveI : mono (Profinite_to_CompHaus.map f) := infer_instance,
-    rwa ← CompHaus.mono_iff_injective },
-  { rw ← category_theory.mono_iff_injective,
-    apply faithful_reflects_mono (forget Profinite) }
-end
-
-end Profinite
diff --git a/src/topology/category/Profinite/projective.lean b/src/topology/category/Profinite/projective.lean
index 14f214691686e..64b5bef31b325 100644
--- a/src/topology/category/Profinite/projective.lean
+++ b/src/topology/category/Profinite/projective.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
 
-import topology.category.Profinite
+import topology.category.Profinite.basic
 import topology.stone_cech
 import category_theory.preadditive.projective
 
 /-!
 # Profinite sets have enough projectives
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we show that `Profinite` has enough projectives.
 
 ## Main results
diff --git a/src/topology/category/Top/adjunctions.lean b/src/topology/category/Top/adjunctions.lean
index 62a4711da14c7..5083d17585d7c 100644
--- a/src/topology/category/Top/adjunctions.lean
+++ b/src/topology/category/Top/adjunctions.lean
@@ -9,6 +9,9 @@ import category_theory.adjunction.basic
 /-!
 # Adjunctions regarding the category of topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file shows that the forgetful functor from topological spaces to types has a left and right
 adjoint, given by `Top.discrete`, resp. `Top.trivial`, the functors which equip a type with the
 discrete, resp. trivial, topology.
@@ -38,5 +41,6 @@ adjunction.mk_of_unit_counit
   counit := { app := λ X, id } }
 
 instance : is_right_adjoint (forget Top.{u}) := ⟨_, adj₁⟩
+instance : is_left_adjoint (forget Top.{u}) := ⟨_, adj₂⟩
 
 end Top
diff --git a/src/topology/category/Top/basic.lean b/src/topology/category/Top/basic.lean
index 59a22e0dd3533..f212483491efe 100644
--- a/src/topology/category/Top/basic.lean
+++ b/src/topology/category/Top/basic.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot, Scott Morrison, Mario Carneiro
 -/
 import category_theory.concrete_category.bundled_hom
+import category_theory.elementwise
 import topology.continuous_function.basic
 
 /-!
 # Category instance for topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We introduce the bundled category `Top` of topological spaces together with the functors `discrete`
 and `trivial` from the category of types to `Top` which equip a type with the corresponding
 discrete, resp. trivial, topology. For a proof that these functors are left, resp. right adjoint
@@ -54,6 +58,8 @@ def discrete : Type u ⥤ Top.{u} :=
 { obj := λ X, ⟨X, ⊥⟩,
   map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_bot } }
 
+instance {X : Type u} : discrete_topology (discrete.obj X) := ⟨rfl⟩
+
 /-- The trivial topology on any type. -/
 def trivial : Type u ⥤ Top.{u} :=
 { obj := λ X, ⟨X, ⊤⟩,
@@ -82,7 +88,7 @@ by { ext, refl }
 @[simp]
 lemma open_embedding_iff_comp_is_iso {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] :
   open_embedding (f ≫ g) ↔ open_embedding f :=
-open_embedding_iff_open_embedding_compose f (Top.homeo_of_iso (as_iso g)).open_embedding
+(Top.homeo_of_iso (as_iso g)).open_embedding.of_comp_iff f
 
 @[simp]
 lemma open_embedding_iff_is_iso_comp {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] :
diff --git a/src/topology/category/Top/default.lean b/src/topology/category/Top/default.lean
deleted file mode 100644
index 9e7a0f40fe13c..0000000000000
--- a/src/topology/category/Top/default.lean
+++ /dev/null
@@ -1,3 +0,0 @@
-import topology.category.Top.limits
-import topology.category.Top.epi_mono
-import topology.category.Top.open_nhds
diff --git a/src/topology/category/Top/epi_mono.lean b/src/topology/category/Top/epi_mono.lean
index c99937ab9c3bc..2ac9b10b9a059 100644
--- a/src/topology/category/Top/epi_mono.lean
+++ b/src/topology/category/Top/epi_mono.lean
@@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Reid Barton
 -/
 import topology.category.Top.adjunctions
-import category_theory.epi_mono
 
 /-!
 # Epi- and monomorphisms in `Top`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file shows that a continuous function is an epimorphism in the category of topological spaces
 if and only if it is surjective, and that a continuous function is a monomorphism in the category of
 topological spaces if and only if it is injective.
@@ -26,8 +28,8 @@ begin
   suffices : epi f ↔ epi ((forget Top).map f),
   { rw [this, category_theory.epi_iff_surjective], refl },
   split,
-  { apply left_adjoint_preserves_epi adj₂ },
-  { apply faithful_reflects_epi }
+  { introI, apply_instance },
+  { apply functor.epi_of_epi_map }
 end
 
 lemma mono_iff_injective {X Y : Top.{u}} (f : X ⟶ Y) : mono f ↔ function.injective f :=
@@ -35,8 +37,8 @@ begin
   suffices : mono f ↔ mono ((forget Top).map f),
   { rw [this, category_theory.mono_iff_injective], refl },
   split,
-  { apply right_adjoint_preserves_mono adj₁ },
-  { apply faithful_reflects_mono }
+  { introI, apply_instance },
+  { apply functor.mono_of_mono_map }
 end
 
 end Top
diff --git a/src/topology/category/Top/limits.lean b/src/topology/category/Top/limits.lean
deleted file mode 100644
index f9a03edff86c2..0000000000000
--- a/src/topology/category/Top/limits.lean
+++ /dev/null
@@ -1,996 +0,0 @@
-/-
-Copyright (c) 2017 Scott Morrison. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Patrick Massot, Scott Morrison, Mario Carneiro, Andrew Yang
--/
-import topology.category.Top.epi_mono
-import category_theory.limits.preserves.limits
-import category_theory.category.ulift
-import category_theory.limits.shapes.types
-import category_theory.limits.concrete_category
-
-/-!
-# The category of topological spaces has all limits and colimits
-
-Further, these limits and colimits are preserved by the forgetful functor --- that is, the
-underlying types are just the limits in the category of types.
--/
-
-open topological_space
-open category_theory
-open category_theory.limits
-open opposite
-
-universes u v w
-
-noncomputable theory
-
-namespace Top
-
-variables {J : Type u} [small_category J]
-
-local notation `forget` := forget Top
-
-/--
-A choice of limit cone for a functor `F : J ⥤ Top`.
-Generally you should just use `limit.cone F`, unless you need the actual definition
-(which is in terms of `types.limit_cone`).
--/
-def limit_cone (F : J ⥤ Top.{u}) : cone F :=
-{ X := Top.of {u : Π j : J, F.obj j | ∀ {i j : J} (f : i ⟶ j), F.map f (u i) = u j},
-  π :=
-  { app := λ j,
-    { to_fun := λ u, u.val j,
-      continuous_to_fun := show continuous ((λ u : Π j : J, F.obj j, u j) ∘ subtype.val),
-        by continuity } } }
-
-/--
-A choice of limit cone for a functor `F : J ⥤ Top` whose topology is defined as an
-infimum of topologies infimum.
-Generally you should just use `limit.cone F`, unless you need the actual definition
-(which is in terms of `types.limit_cone`).
--/
-def limit_cone_infi (F : J ⥤ Top.{u}) : cone F :=
-{ X := ⟨(types.limit_cone (F ⋙ forget)).X, ⨅j,
-        (F.obj j).str.induced ((types.limit_cone (F ⋙ forget)).π.app j)⟩,
-  π :=
-  { app := λ j, ⟨(types.limit_cone (F ⋙ forget)).π.app j,
-                 continuous_iff_le_induced.mpr (infi_le _ _)⟩,
-    naturality' := λ j j' f, continuous_map.coe_injective
-      ((types.limit_cone (F ⋙ forget)).π.naturality f) } }
-
-/--
-The chosen cone `Top.limit_cone F` for a functor `F : J ⥤ Top` is a limit cone.
-Generally you should just use `limit.is_limit F`, unless you need the actual definition
-(which is in terms of `types.limit_cone_is_limit`).
--/
-def limit_cone_is_limit (F : J ⥤ Top.{u}) : is_limit (limit_cone F) :=
-{ lift := λ S, { to_fun := λ x, ⟨λ j, S.π.app _ x, λ i j f, by { dsimp, erw ← S.w f, refl }⟩ },
-  uniq' := λ S m h, by { ext : 3, simpa [← h] } }
-
-/--
-The chosen cone `Top.limit_cone_infi F` for a functor `F : J ⥤ Top` is a limit cone.
-Generally you should just use `limit.is_limit F`, unless you need the actual definition
-(which is in terms of `types.limit_cone_is_limit`).
--/
-def limit_cone_infi_is_limit (F : J ⥤ Top.{u}) : is_limit (limit_cone_infi F) :=
-by { refine is_limit.of_faithful forget (types.limit_cone_is_limit _) (λ s, ⟨_, _⟩) (λ s, rfl),
-     exact continuous_iff_coinduced_le.mpr (le_infi $ λ j,
-       coinduced_le_iff_le_induced.mp $ (continuous_iff_coinduced_le.mp (s.π.app j).continuous :
-         _) ) }
-
-instance Top_has_limits : has_limits.{u} Top.{u} :=
-{ has_limits_of_shape := λ J 𝒥, by exactI
-  { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } }
-
-instance forget_preserves_limits : preserves_limits (forget : Top.{u} ⥤ Type u) :=
-{ preserves_limits_of_shape := λ J 𝒥,
-  { preserves_limit := λ F,
-    by exactI preserves_limit_of_preserves_limit_cone
-      (limit_cone_is_limit F) (types.limit_cone_is_limit (F ⋙ forget)) } }
-
-/--
-A choice of colimit cocone for a functor `F : J ⥤ Top`.
-Generally you should just use `colimit.coone F`, unless you need the actual definition
-(which is in terms of `types.colimit_cocone`).
--/
-def colimit_cocone (F : J ⥤ Top.{u}) : cocone F :=
-{ X := ⟨(types.colimit_cocone (F ⋙ forget)).X, ⨆ j,
-        (F.obj j).str.coinduced ((types.colimit_cocone (F ⋙ forget)).ι.app j)⟩,
-  ι :=
-  { app := λ j, ⟨(types.colimit_cocone (F ⋙ forget)).ι.app j,
-                 continuous_iff_coinduced_le.mpr (le_supr _ j)⟩,
-    naturality' := λ j j' f, continuous_map.coe_injective
-      ((types.colimit_cocone (F ⋙ forget)).ι.naturality f) } }
-
-/--
-The chosen cocone `Top.colimit_cocone F` for a functor `F : J ⥤ Top` is a colimit cocone.
-Generally you should just use `colimit.is_colimit F`, unless you need the actual definition
-(which is in terms of `types.colimit_cocone_is_colimit`).
--/
-def colimit_cocone_is_colimit (F : J ⥤ Top.{u}) : is_colimit (colimit_cocone F) :=
-by { refine is_colimit.of_faithful forget (types.colimit_cocone_is_colimit _) (λ s, ⟨_, _⟩)
-       (λ s, rfl),
-     exact continuous_iff_le_induced.mpr (supr_le $ λ j,
-       coinduced_le_iff_le_induced.mp $ (continuous_iff_coinduced_le.mp (s.ι.app j).continuous :
-         _) ) }
-
-instance Top_has_colimits : has_colimits.{u} Top.{u} :=
-{ has_colimits_of_shape := λ J 𝒥, by exactI
-  { has_colimit := λ F, has_colimit.mk { cocone := colimit_cocone F, is_colimit :=
-    colimit_cocone_is_colimit F } } }
-
-instance forget_preserves_colimits : preserves_colimits (forget : Top.{u} ⥤ Type u) :=
-{ preserves_colimits_of_shape := λ J 𝒥,
-  { preserves_colimit := λ F,
-    by exactI preserves_colimit_of_preserves_colimit_cocone
-      (colimit_cocone_is_colimit F) (types.colimit_cocone_is_colimit (F ⋙ forget)) } }
-
-/-- The projection from the product as a bundled continous map. -/
-abbreviation pi_π {ι : Type u} (α : ι → Top.{u}) (i : ι) : Top.of (Π i, α i) ⟶ α i :=
-⟨λ f, f i, continuous_apply i⟩
-
-/-- The explicit fan of a family of topological spaces given by the pi type. -/
-@[simps X π_app]
-def pi_fan {ι : Type u} (α : ι → Top.{u}) : fan α :=
-fan.mk (Top.of (Π i, α i)) (pi_π α)
-
-/-- The constructed fan is indeed a limit -/
-def pi_fan_is_limit {ι : Type u} (α : ι → Top.{u}) : is_limit (pi_fan α) :=
-{ lift := λ S, { to_fun := λ s i, S.π.app i s },
-  uniq' := by { intros S m h, ext x i, simp [← h i] } }
-
-/--
-The product is homeomorphic to the product of the underlying spaces,
-equipped with the product topology.
--/
-def pi_iso_pi {ι : Type u} (α : ι → Top.{u}) : ∏ α ≅ Top.of (Π i, α i) :=
-(limit.is_limit _).cone_point_unique_up_to_iso (pi_fan_is_limit α)
-
-@[simp, reassoc]
-lemma pi_iso_pi_inv_π {ι : Type u} (α : ι → Top) (i : ι) :
-  (pi_iso_pi α).inv ≫ pi.π α i = pi_π α i :=
-by simp [pi_iso_pi]
-
-@[simp]
-lemma pi_iso_pi_inv_π_apply {ι : Type u} (α : ι → Top.{u}) (i : ι) (x : Π i, α i) :
-  (pi.π α i : _) ((pi_iso_pi α).inv x) = x i :=
-concrete_category.congr_hom (pi_iso_pi_inv_π α i) x
-
-@[simp]
-lemma pi_iso_pi_hom_apply {ι : Type u} (α : ι → Top.{u}) (i : ι) (x : ∏ α) :
-  (pi_iso_pi α).hom x i = (pi.π α i : _) x :=
-begin
-  have := pi_iso_pi_inv_π α i,
-  rw iso.inv_comp_eq at this,
-  exact concrete_category.congr_hom this x
-end
-
-/-- The inclusion to the coproduct as a bundled continous map. -/
-abbreviation sigma_ι {ι : Type u} (α : ι → Top.{u}) (i : ι) : α i ⟶ Top.of (Σ i, α i) :=
-⟨sigma.mk i⟩
-
-/-- The explicit cofan of a family of topological spaces given by the sigma type. -/
-@[simps X ι_app]
-def sigma_cofan {ι : Type u} (α : ι → Top.{u}) : cofan α :=
-cofan.mk (Top.of (Σ i, α i)) (sigma_ι α)
-
-/-- The constructed cofan is indeed a colimit -/
-def sigma_cofan_is_colimit {ι : Type u} (α : ι → Top.{u}) : is_colimit (sigma_cofan α) :=
-{ desc := λ S, { to_fun := λ s, S.ι.app s.1 s.2,
-    continuous_to_fun := by { continuity, dsimp only, continuity } },
-  uniq' := by { intros S m h,  ext ⟨i, x⟩, simp [← h i] } }
-
-/--
-The coproduct is homeomorphic to the disjoint union of the topological spaces.
--/
-def sigma_iso_sigma {ι : Type u} (α : ι → Top.{u}) : ∐ α ≅ Top.of (Σ i, α i) :=
-(colimit.is_colimit _).cocone_point_unique_up_to_iso (sigma_cofan_is_colimit α)
-
-@[simp, reassoc]
-lemma sigma_iso_sigma_hom_ι {ι : Type u} (α : ι → Top) (i : ι) :
-  sigma.ι α i ≫ (sigma_iso_sigma α).hom = sigma_ι α i :=
-by simp [sigma_iso_sigma]
-
-@[simp]
-lemma sigma_iso_sigma_hom_ι_apply {ι : Type u} (α : ι → Top) (i : ι) (x : α i) :
-  (sigma_iso_sigma α).hom ((sigma.ι α i : _) x) = sigma.mk i x :=
-concrete_category.congr_hom (sigma_iso_sigma_hom_ι α i) x
-
-@[simp]
-lemma sigma_iso_sigma_inv_apply {ι : Type u} (α : ι → Top) (i : ι) (x : α i) :
-  (sigma_iso_sigma α).inv ⟨i, x⟩ = (sigma.ι α i : _) x :=
-by { rw [← sigma_iso_sigma_hom_ι_apply, ← comp_app], simp, }
-
-lemma induced_of_is_limit {F : J ⥤ Top.{u}} (C : cone F) (hC : is_limit C) :
-  C.X.topological_space = ⨅ j, (F.obj j).topological_space.induced (C.π.app j) :=
-begin
-  let homeo := homeo_of_iso (hC.cone_point_unique_up_to_iso (limit_cone_infi_is_limit F)),
-  refine homeo.inducing.induced.trans _,
-  change induced homeo (⨅ (j : J), _) = _,
-  simpa [induced_infi, induced_compose],
-end
-
-lemma limit_topology (F : J ⥤ Top.{u}) :
-  (limit F).topological_space = ⨅ j, (F.obj j).topological_space.induced (limit.π F j) :=
-induced_of_is_limit _ (limit.is_limit F)
-
-section prod
-
-/-- The first projection from the product. -/
-abbreviation prod_fst {X Y : Top.{u}} : Top.of (X × Y) ⟶ X := ⟨prod.fst⟩
-
-/-- The second projection from the product. -/
-abbreviation prod_snd {X Y : Top.{u}} : Top.of (X × Y) ⟶ Y := ⟨prod.snd⟩
-
-/-- The explicit binary cofan of `X, Y` given by `X × Y`. -/
-def prod_binary_fan (X Y : Top.{u}) : binary_fan X Y :=
-binary_fan.mk prod_fst prod_snd
-
-/-- The constructed binary fan is indeed a limit -/
-def prod_binary_fan_is_limit (X Y : Top.{u}) : is_limit (prod_binary_fan X Y) :=
-{ lift := λ (S : binary_fan X Y), { to_fun := λ s, (S.fst s, S.snd s) },
-  fac' := begin
-    rintros S (_|_),
-    tidy
-  end,
-  uniq' := begin
-    intros S m h,
-    ext x,
-    { specialize h walking_pair.left,
-      apply_fun (λ e, (e x)) at h,
-      exact h },
-     { specialize h walking_pair.right,
-      apply_fun (λ e, (e x)) at h,
-      exact h },
-  end }
-
-/--
-The homeomorphism between `X ⨯ Y` and the set-theoretic product of `X` and `Y`,
-equipped with the product topology.
--/
-def prod_iso_prod (X Y : Top.{u}) : X ⨯ Y ≅ Top.of (X × Y) :=
-(limit.is_limit _).cone_point_unique_up_to_iso (prod_binary_fan_is_limit X Y)
-
-@[simp, reassoc] lemma prod_iso_prod_hom_fst (X Y : Top.{u}) :
-  (prod_iso_prod X Y).hom ≫ prod_fst = limits.prod.fst :=
-by simpa [← iso.eq_inv_comp, prod_iso_prod]
-
-@[simp, reassoc] lemma prod_iso_prod_hom_snd (X Y : Top.{u}) :
-  (prod_iso_prod X Y).hom ≫ prod_snd = limits.prod.snd :=
-by simpa [← iso.eq_inv_comp, prod_iso_prod]
-
-@[simp] lemma prod_iso_prod_hom_apply {X Y : Top.{u}} (x : X ⨯ Y) :
-  (prod_iso_prod X Y).hom x =
-    ((limits.prod.fst : X ⨯ Y ⟶ _) x, (limits.prod.snd : X ⨯ Y ⟶ _) x) :=
-begin
-  ext,
-  { exact concrete_category.congr_hom (prod_iso_prod_hom_fst X Y) x },
-  { exact concrete_category.congr_hom (prod_iso_prod_hom_snd X Y) x }
-end
-
-@[simp, reassoc, elementwise] lemma prod_iso_prod_inv_fst (X Y : Top.{u}) :
-  (prod_iso_prod X Y).inv ≫ limits.prod.fst = prod_fst :=
-by simp [iso.inv_comp_eq]
-
-@[simp, reassoc, elementwise] lemma prod_iso_prod_inv_snd (X Y : Top.{u}) :
-  (prod_iso_prod X Y).inv ≫ limits.prod.snd = prod_snd :=
-by simp [iso.inv_comp_eq]
-
-lemma prod_topology {X Y : Top} :
-  (X ⨯ Y).topological_space =
-    induced (limits.prod.fst : X ⨯ Y ⟶ _) X.topological_space ⊓
-      induced (limits.prod.snd : X ⨯ Y ⟶ _) Y.topological_space :=
-begin
-  let homeo := homeo_of_iso (prod_iso_prod X Y),
-  refine homeo.inducing.induced.trans _,
-  change induced homeo (_ ⊓ _) = _,
-  simpa [induced_compose]
-end
-
-lemma range_prod_map {W X Y Z : Top.{u}} (f : W ⟶ Y) (g : X ⟶ Z) :
-  set.range (limits.prod.map f g) =
-    (limits.prod.fst : Y ⨯ Z ⟶ _) ⁻¹' (set.range f) ∩
-      (limits.prod.snd : Y ⨯ Z ⟶ _) ⁻¹' (set.range g) :=
-begin
-  ext,
-  split,
-  { rintros ⟨y, rfl⟩,
-    simp only [set.mem_preimage, set.mem_range, set.mem_inter_eq, ←comp_apply],
-    simp only [limits.prod.map_fst, limits.prod.map_snd,
-      exists_apply_eq_apply, comp_apply, and_self] },
-  { rintros ⟨⟨x₁, hx₁⟩, ⟨x₂, hx₂⟩⟩,
-    use (prod_iso_prod W X).inv (x₁, x₂),
-    apply concrete.limit_ext,
-    rintro ⟨⟩,
-    { simp only [← comp_apply, category.assoc], erw limits.prod.map_fst, simp [hx₁] },
-    { simp only [← comp_apply, category.assoc], erw limits.prod.map_snd, simp [hx₂] } }
-end
-
-lemma inducing_prod_map {W X Y Z : Top} {f : W ⟶ X} {g : Y ⟶ Z}
-  (hf : inducing f) (hg : inducing g) : inducing (limits.prod.map f g) :=
-begin
-  constructor,
-  simp only [prod_topology, induced_compose, ←coe_comp, limits.prod.map_fst, limits.prod.map_snd,
-    induced_inf],
-  simp only [coe_comp],
-  rw [← @induced_compose _ _ _ _ _ f, ← @induced_compose _ _ _ _ _ g, ← hf.induced, ← hg.induced]
-end
-
-lemma embedding_prod_map {W X Y Z : Top} {f : W ⟶ X} {g : Y ⟶ Z}
-  (hf : embedding f) (hg : embedding g) : embedding (limits.prod.map f g) :=
-⟨inducing_prod_map hf.to_inducing hg.to_inducing,
-begin
-  haveI := (Top.mono_iff_injective _).mpr hf.inj,
-  haveI := (Top.mono_iff_injective _).mpr hg.inj,
-  exact (Top.mono_iff_injective _).mp infer_instance
-end⟩
-
-end prod
-
-section pullback
-
-variables {X Y Z : Top.{u}}
-
-/-- The first projection from the pullback. -/
-abbreviation pullback_fst (f : X ⟶ Z) (g : Y ⟶ Z) : Top.of { p : X × Y // f p.1 = g p.2 } ⟶ X :=
-⟨prod.fst ∘ subtype.val⟩
-
-/-- The second projection from the pullback. -/
-abbreviation pullback_snd (f : X ⟶ Z) (g : Y ⟶ Z) : Top.of { p : X × Y // f p.1 = g p.2 } ⟶ Y :=
-⟨prod.snd ∘ subtype.val⟩
-
-/-- The explicit pullback cone of `X, Y` given by `{ p : X × Y // f p.1 = g p.2 }`. -/
-def pullback_cone (f : X ⟶ Z) (g : Y ⟶ Z) : pullback_cone f g :=
-pullback_cone.mk (pullback_fst f g) (pullback_snd f g) (by { ext ⟨x, h⟩, simp [h] })
-
-/-- The constructed cone is a limit. -/
-def pullback_cone_is_limit (f : X ⟶ Z) (g : Y ⟶ Z) :
-  is_limit (pullback_cone f g) := pullback_cone.is_limit_aux' _
-begin
-  intro s,
-  split, swap,
-  exact { to_fun := λ x, ⟨⟨s.fst x, s.snd x⟩,
-    by simpa using concrete_category.congr_hom s.condition x⟩ },
-  refine ⟨_,_,_⟩,
-  { ext, delta pullback_cone, simp },
-  { ext, delta pullback_cone, simp },
-  { intros m h₁ h₂,
-    ext x,
-    { simpa using concrete_category.congr_hom h₁ x },
-    { simpa using concrete_category.congr_hom h₂ x } }
-end
-
-/-- The pullback of two maps can be identified as a subspace of `X × Y`. -/
-def pullback_iso_prod_subtype (f : X ⟶ Z) (g : Y ⟶ Z) :
-  pullback f g ≅ Top.of { p : X × Y // f p.1 = g p.2 } :=
-(limit.is_limit _).cone_point_unique_up_to_iso (pullback_cone_is_limit f g)
-
-@[simp, reassoc] lemma pullback_iso_prod_subtype_inv_fst (f : X ⟶ Z) (g : Y ⟶ Z) :
-  (pullback_iso_prod_subtype f g).inv ≫ pullback.fst = pullback_fst f g :=
-by simpa [pullback_iso_prod_subtype]
-
-@[simp] lemma pullback_iso_prod_subtype_inv_fst_apply (f : X ⟶ Z) (g : Y ⟶ Z)
-  (x : { p : X × Y // f p.1 = g p.2 }) :
-  (pullback.fst : pullback f g ⟶ _) ((pullback_iso_prod_subtype f g).inv x) = (x : X × Y).fst :=
-concrete_category.congr_hom (pullback_iso_prod_subtype_inv_fst f g) x
-
-@[simp, reassoc] lemma pullback_iso_prod_subtype_inv_snd (f : X ⟶ Z) (g : Y ⟶ Z) :
-  (pullback_iso_prod_subtype f g).inv ≫ pullback.snd = pullback_snd f g :=
-by simpa [pullback_iso_prod_subtype]
-
-@[simp] lemma pullback_iso_prod_subtype_inv_snd_apply (f : X ⟶ Z) (g : Y ⟶ Z)
-  (x : { p : X × Y // f p.1 = g p.2 }) :
-  (pullback.snd : pullback f g ⟶ _) ((pullback_iso_prod_subtype f g).inv x) = (x : X × Y).snd :=
-concrete_category.congr_hom (pullback_iso_prod_subtype_inv_snd f g) x
-
-lemma pullback_iso_prod_subtype_hom_fst (f : X ⟶ Z) (g : Y ⟶ Z) :
-  (pullback_iso_prod_subtype f g).hom ≫ pullback_fst f g = pullback.fst :=
-by rw [←iso.eq_inv_comp, pullback_iso_prod_subtype_inv_fst]
-
-lemma pullback_iso_prod_subtype_hom_snd (f : X ⟶ Z) (g : Y ⟶ Z) :
-  (pullback_iso_prod_subtype f g).hom ≫ pullback_snd f g = pullback.snd :=
-by rw [←iso.eq_inv_comp, pullback_iso_prod_subtype_inv_snd]
-
-@[simp] lemma pullback_iso_prod_subtype_hom_apply {f : X ⟶ Z} {g : Y ⟶ Z}
-  (x : pullback f g) : (pullback_iso_prod_subtype f g).hom x =
-    ⟨⟨(pullback.fst : pullback f g ⟶ _) x, (pullback.snd : pullback f g ⟶ _) x⟩,
-      by simpa using concrete_category.congr_hom pullback.condition x⟩ :=
-begin
-  ext,
-  exacts [concrete_category.congr_hom (pullback_iso_prod_subtype_hom_fst f g) x,
-    concrete_category.congr_hom (pullback_iso_prod_subtype_hom_snd f g) x]
-end
-
-lemma pullback_topology {X Y Z : Top.{u}} (f : X ⟶ Z) (g : Y ⟶ Z) :
-  (pullback f g).topological_space =
-    induced (pullback.fst : pullback f g ⟶ _) X.topological_space ⊓
-      induced (pullback.snd : pullback f g ⟶ _) Y.topological_space :=
-begin
-  let homeo := homeo_of_iso (pullback_iso_prod_subtype f g),
-  refine homeo.inducing.induced.trans _,
-  change induced homeo (induced _ (_ ⊓ _)) = _,
-  simpa [induced_compose]
-end
-
-lemma range_pullback_to_prod {X Y Z : Top} (f : X ⟶ Z) (g : Y ⟶ Z) :
-  set.range (prod.lift pullback.fst pullback.snd : pullback f g ⟶ X ⨯ Y) =
-  { x | (limits.prod.fst ≫ f) x = (limits.prod.snd ≫ g) x } :=
-begin
-  ext x,
-  split,
-  { rintros ⟨y, rfl⟩,
-    simp only [←comp_apply, set.mem_set_of_eq],
-    congr' 1,
-    simp [pullback.condition] },
-  { intro h,
-    use (pullback_iso_prod_subtype f g).inv ⟨⟨_, _⟩, h⟩,
-    apply concrete.limit_ext,
-    rintro ⟨⟩; simp }
-end
-
-lemma inducing_pullback_to_prod {X Y Z : Top} (f : X ⟶ Z) (g : Y ⟶ Z) :
-  inducing ⇑(prod.lift pullback.fst pullback.snd : pullback f g ⟶ X ⨯ Y) :=
-⟨by simp [prod_topology, pullback_topology, induced_compose, ←coe_comp]⟩
-
-lemma embedding_pullback_to_prod {X Y Z : Top} (f : X ⟶ Z) (g : Y ⟶ Z) :
-  embedding ⇑(prod.lift pullback.fst pullback.snd : pullback f g ⟶ X ⨯ Y) :=
-⟨inducing_pullback_to_prod f g, (Top.mono_iff_injective _).mp infer_instance⟩
-
-/-- If the map `S ⟶ T` is mono, then there is a description of the image of `W ×ₛ X ⟶ Y ×ₜ Z`. -/
-lemma range_pullback_map {W X Y Z S T : Top} (f₁ : W ⟶ S) (f₂ : X ⟶ S)
-  (g₁ : Y ⟶ T) (g₂ : Z ⟶ T) (i₁ : W ⟶ Y) (i₂ : X ⟶ Z) (i₃ : S ⟶ T) [H₃ : mono i₃]
-  (eq₁ : f₁ ≫ i₃ = i₁ ≫ g₁) (eq₂ : f₂ ≫ i₃ = i₂ ≫ g₂) :
-  set.range (pullback.map f₁ f₂ g₁ g₂ i₁ i₂ i₃ eq₁ eq₂) =
-    (pullback.fst : pullback g₁ g₂ ⟶ _) ⁻¹' (set.range i₁) ∩
-      (pullback.snd : pullback g₁ g₂ ⟶ _) ⁻¹' (set.range i₂) :=
-begin
-  ext,
-  split,
-  { rintro ⟨y, rfl⟩, simp, },
-  rintros ⟨⟨x₁, hx₁⟩, ⟨x₂, hx₂⟩⟩,
-  have : f₁ x₁ = f₂ x₂,
-  { apply (Top.mono_iff_injective _).mp H₃,
-    simp only [←comp_apply, eq₁, eq₂],
-    simp only [comp_apply, hx₁, hx₂],
-    simp only [←comp_apply, pullback.condition] },
-  use (pullback_iso_prod_subtype f₁ f₂).inv ⟨⟨x₁, x₂⟩, this⟩,
-  apply concrete.limit_ext,
-  rintros (_|_|_),
-  { simp only [Top.comp_app, limit.lift_π_apply, category.assoc, pullback_cone.mk_π_app_one,
-      hx₁, pullback_iso_prod_subtype_inv_fst_apply, subtype.coe_mk],
-    simp only [← comp_apply],
-    congr,
-    apply limit.w _ walking_cospan.hom.inl },
-  { simp [hx₁] },
-  { simp [hx₂] },
-end
-
-lemma pullback_fst_range {X Y S : Top} (f : X ⟶ S) (g : Y ⟶ S) :
-  set.range (pullback.fst : pullback f g ⟶ _) = { x : X | ∃ y : Y, f x = g y} :=
-begin
-  ext x,
-  split,
-  { rintro ⟨y, rfl⟩,
-    use (pullback.snd : pullback f g ⟶ _) y,
-    exact concrete_category.congr_hom pullback.condition y },
-  { rintro ⟨y, eq⟩,
-    use (Top.pullback_iso_prod_subtype f g).inv ⟨⟨x, y⟩, eq⟩,
-    simp },
-end
-
-lemma pullback_snd_range {X Y S : Top} (f : X ⟶ S) (g : Y ⟶ S) :
-  set.range (pullback.snd : pullback f g ⟶ _) = { y : Y | ∃ x : X, f x = g y} :=
-begin
-  ext y,
-  split,
-  { rintro ⟨x, rfl⟩,
-    use (pullback.fst : pullback f g ⟶ _) x,
-    exact concrete_category.congr_hom pullback.condition x },
-  { rintro ⟨x, eq⟩,
-    use (Top.pullback_iso_prod_subtype f g).inv ⟨⟨x, y⟩, eq⟩,
-    simp },
-end
-
-/--
-If there is a diagram where the morphisms `W ⟶ Y` and `X ⟶ Z` are embeddings,
-then the induced morphism `W ×ₛ X ⟶ Y ×ₜ Z` is also an embedding.
-
-  W  ⟶  Y
-    ↘      ↘
-      S  ⟶  T
-    ↗      ↗
-  X  ⟶  Z
--/
-lemma pullback_map_embedding_of_embeddings {W X Y Z S T : Top}
-  (f₁ : W ⟶ S) (f₂ : X ⟶ S) (g₁ : Y ⟶ T) (g₂ : Z ⟶ T) {i₁ : W ⟶ Y} {i₂ : X ⟶ Z}
-  (H₁ : embedding i₁) (H₂ : embedding i₂) (i₃ : S ⟶ T)
-  (eq₁ : f₁ ≫ i₃ = i₁ ≫ g₁) (eq₂ : f₂ ≫ i₃ = i₂ ≫ g₂) :
-  embedding (pullback.map f₁ f₂ g₁ g₂ i₁ i₂ i₃ eq₁ eq₂) :=
-begin
-  refine embedding_of_embedding_compose (continuous_map.continuous_to_fun _)
-    (show continuous (prod.lift pullback.fst pullback.snd : pullback g₁ g₂ ⟶ Y ⨯ Z), from
-      continuous_map.continuous_to_fun _) _,
-  suffices : embedding
-    (prod.lift pullback.fst pullback.snd ≫ limits.prod.map i₁ i₂ : pullback f₁ f₂ ⟶ _),
-  { simpa [←coe_comp] using this },
-  rw coe_comp,
-  refine embedding.comp (embedding_prod_map H₁ H₂)
-    (embedding_pullback_to_prod _ _)
-end
-
-/--
-If there is a diagram where the morphisms `W ⟶ Y` and `X ⟶ Z` are open embeddings, and `S ⟶ T`
-is mono, then the induced morphism `W ×ₛ X ⟶ Y ×ₜ Z` is also an open embedding.
-  W  ⟶  Y
-    ↘      ↘
-      S  ⟶  T
-    ↗       ↗
-  X  ⟶  Z
--/
-lemma pullback_map_open_embedding_of_open_embeddings {W X Y Z S T : Top}
-  (f₁ : W ⟶ S) (f₂ : X ⟶ S) (g₁ : Y ⟶ T) (g₂ : Z ⟶ T) {i₁ : W ⟶ Y} {i₂ : X ⟶ Z}
-  (H₁ : open_embedding i₁) (H₂ : open_embedding i₂) (i₃ : S ⟶ T) [H₃ : mono i₃]
-  (eq₁ : f₁ ≫ i₃ = i₁ ≫ g₁) (eq₂ : f₂ ≫ i₃ = i₂ ≫ g₂) :
-  open_embedding (pullback.map f₁ f₂ g₁ g₂ i₁ i₂ i₃ eq₁ eq₂) :=
-begin
-  split,
-  { apply pullback_map_embedding_of_embeddings
-      f₁ f₂ g₁ g₂ H₁.to_embedding H₂.to_embedding i₃ eq₁ eq₂ },
-  { rw range_pullback_map,
-    apply is_open.inter; apply continuous.is_open_preimage,
-    continuity,
-    exacts [H₁.open_range, H₂.open_range] }
-end
-
-lemma snd_embedding_of_left_embedding {X Y S : Top}
-  {f : X ⟶ S} (H : embedding f) (g : Y ⟶ S) :
-  embedding ⇑(pullback.snd : pullback f g ⟶ Y) :=
-begin
-  convert (homeo_of_iso (as_iso (pullback.snd : pullback (𝟙 S) g ⟶ _))).embedding.comp
-    (pullback_map_embedding_of_embeddings f g (𝟙 _) g H
-      (homeo_of_iso (iso.refl _)).embedding (𝟙 _) rfl (by simp)),
-  erw ←coe_comp,
-  simp
-end
-
-lemma fst_embedding_of_right_embedding {X Y S : Top}
-  (f : X ⟶ S) {g : Y ⟶ S} (H : embedding g) :
-  embedding ⇑(pullback.fst : pullback f g ⟶ X) :=
-begin
-  convert (homeo_of_iso (as_iso (pullback.fst : pullback f (𝟙 S) ⟶ _))).embedding.comp
-    (pullback_map_embedding_of_embeddings f g f (𝟙 _)
-      (homeo_of_iso (iso.refl _)).embedding H (𝟙 _) rfl (by simp)),
-  erw ←coe_comp,
-  simp
-end
-
-lemma embedding_of_pullback_embeddings {X Y S : Top}
-  {f : X ⟶ S} {g : Y ⟶ S} (H₁ : embedding f) (H₂ : embedding g) :
-  embedding (limit.π (cospan f g) walking_cospan.one) :=
-begin
-  convert H₂.comp (snd_embedding_of_left_embedding H₁ g),
-  erw ←coe_comp,
-  congr,
-  exact (limit.w _ walking_cospan.hom.inr).symm
-end
-
-lemma snd_open_embedding_of_left_open_embedding {X Y S : Top}
-  {f : X ⟶ S} (H : open_embedding f) (g : Y ⟶ S) :
-  open_embedding ⇑(pullback.snd : pullback f g ⟶ Y) :=
-begin
-  convert (homeo_of_iso (as_iso (pullback.snd : pullback (𝟙 S) g ⟶ _))).open_embedding.comp
-    (pullback_map_open_embedding_of_open_embeddings f g (𝟙 _) g H
-      (homeo_of_iso (iso.refl _)).open_embedding (𝟙 _) rfl (by simp)),
-  erw ←coe_comp,
-  simp
-end
-
-lemma fst_open_embedding_of_right_open_embedding {X Y S : Top}
-  (f : X ⟶ S) {g : Y ⟶ S} (H : open_embedding g) :
-  open_embedding ⇑(pullback.fst : pullback f g ⟶ X) :=
-begin
-  convert (homeo_of_iso (as_iso (pullback.fst : pullback f (𝟙 S) ⟶ _))).open_embedding.comp
-    (pullback_map_open_embedding_of_open_embeddings f g f (𝟙 _)
-      (homeo_of_iso (iso.refl _)).open_embedding H (𝟙 _) rfl (by simp)),
-  erw ←coe_comp,
-  simp
-end
-
-/-- If `X ⟶ S`, `Y ⟶ S` are open embeddings, then so is `X ×ₛ Y ⟶ S`. -/
-lemma open_embedding_of_pullback_open_embeddings {X Y S : Top}
-  {f : X ⟶ S} {g : Y ⟶ S} (H₁ : open_embedding f) (H₂ : open_embedding g) :
-  open_embedding (limit.π (cospan f g) walking_cospan.one) :=
-begin
-  convert H₂.comp (snd_open_embedding_of_left_open_embedding H₁ g),
-  erw ←coe_comp,
-  congr,
-  exact (limit.w _ walking_cospan.hom.inr).symm
-end
-
-lemma fst_iso_of_right_embedding_range_subset {X Y S : Top} (f : X ⟶ S) {g : Y ⟶ S}
-  (hg : embedding g) (H : set.range f ⊆ set.range g) : is_iso (pullback.fst : pullback f g ⟶ X) :=
-begin
-  let : (pullback f g : Top) ≃ₜ X :=
-    (homeomorph.of_embedding _ (fst_embedding_of_right_embedding f hg)).trans
-    { to_fun := coe,
-      inv_fun := (λ x, ⟨x,
-        by { rw pullback_fst_range, exact ⟨_, (H (set.mem_range_self x)).some_spec.symm⟩ }⟩),
-      left_inv := λ ⟨_,_⟩, rfl,
-      right_inv := λ x, rfl },
-  convert is_iso.of_iso (iso_of_homeo this),
-  ext,
-  refl
-end
-
-lemma snd_iso_of_left_embedding_range_subset {X Y S : Top} {f : X ⟶ S} (hf : embedding f)
-  (g : Y ⟶ S) (H : set.range g ⊆ set.range f) : is_iso (pullback.snd : pullback f g ⟶ Y) :=
-begin
-  let : (pullback f g : Top) ≃ₜ Y :=
-    (homeomorph.of_embedding _ (snd_embedding_of_left_embedding hf g)).trans
-    { to_fun := coe,
-      inv_fun := (λ x, ⟨x,
-        by { rw pullback_snd_range, exact ⟨_, (H (set.mem_range_self x)).some_spec⟩ }⟩),
-      left_inv := λ ⟨_,_⟩, rfl,
-      right_inv := λ x, rfl },
-  convert is_iso.of_iso (iso_of_homeo this),
-  ext,
-  refl
-end
-
-lemma pullback_snd_image_fst_preimage (f : X ⟶ Z) (g : Y ⟶ Z) (U : set X) :
-  (pullback.snd : pullback f g ⟶ _) '' ((pullback.fst : pullback f g ⟶ _) ⁻¹' U) =
-    g ⁻¹' (f '' U) :=
-begin
-  ext x,
-  split,
-  { rintros ⟨y, hy, rfl⟩,
-    exact ⟨(pullback.fst : pullback f g ⟶ _) y, hy,
-    concrete_category.congr_hom pullback.condition y⟩ },
-  { rintros ⟨y, hy, eq⟩,
-    exact ⟨(Top.pullback_iso_prod_subtype f g).inv ⟨⟨_,_⟩, eq⟩, by simpa, by simp⟩ },
-end
-
-lemma pullback_fst_image_snd_preimage (f : X ⟶ Z) (g : Y ⟶ Z) (U : set Y) :
-  (pullback.fst : pullback f g ⟶ _) '' ((pullback.snd : pullback f g ⟶ _) ⁻¹' U) =
-    f ⁻¹' (g '' U) :=
-begin
-  ext x,
-  split,
-  { rintros ⟨y, hy, rfl⟩,
-    exact ⟨(pullback.snd : pullback f g ⟶ _) y, hy,
-    (concrete_category.congr_hom pullback.condition y).symm⟩ },
-  { rintros ⟨y, hy, eq⟩,
-    exact ⟨(Top.pullback_iso_prod_subtype f g).inv ⟨⟨_,_⟩,eq.symm⟩, by simpa, by simp⟩ },
-end
-
-end pullback
-
---TODO: Add analogous constructions for `coprod` and `pushout`.
-
-lemma coinduced_of_is_colimit {F : J ⥤ Top.{u}} (c : cocone F) (hc : is_colimit c) :
-  c.X.topological_space = ⨆ j, (F.obj j).topological_space.coinduced (c.ι.app j) :=
-begin
-  let homeo := homeo_of_iso (hc.cocone_point_unique_up_to_iso (colimit_cocone_is_colimit F)),
-  ext,
-  refine homeo.symm.is_open_preimage.symm.trans (iff.trans _ is_open_supr_iff.symm),
-  exact is_open_supr_iff
-end
-
-lemma colimit_topology (F : J ⥤ Top.{u}) :
-  (colimit F).topological_space = ⨆ j, (F.obj j).topological_space.coinduced (colimit.ι F j) :=
-coinduced_of_is_colimit _ (colimit.is_colimit F)
-
-lemma colimit_is_open_iff (F : J ⥤ Top.{u}) (U : set ((colimit F : _) : Type u)) :
-  is_open U ↔ ∀ j, is_open (colimit.ι F j ⁻¹' U) :=
-begin
-  conv_lhs { rw colimit_topology F },
-  exact is_open_supr_iff
-end
-
-lemma coequalizer_is_open_iff (F : walking_parallel_pair.{u} ⥤ Top.{u})
-  (U : set ((colimit F : _) : Type u)) :
-  is_open U ↔ is_open (colimit.ι F walking_parallel_pair.one ⁻¹' U) :=
-begin
-  rw colimit_is_open_iff,
-  split,
-  { intro H, exact H _ },
-  { intros H j,
-    cases j,
-    { rw ←colimit.w F walking_parallel_pair_hom.left,
-      exact (F.map walking_parallel_pair_hom.left).continuous_to_fun.is_open_preimage _ H },
-    { exact H } }
-end
-
-end Top
-
-namespace Top
-
-section cofiltered_limit
-
-variables {J : Type u} [small_category J] [is_cofiltered J] (F : J ⥤ Top.{u})
-  (C : cone F) (hC : is_limit C)
-
-include hC
-
-/--
-Given a *compatible* collection of topological bases for the factors in a cofiltered limit
-which contain `set.univ` and are closed under intersections, the induced *naive* collection
-of sets in the limit is, in fact, a topological basis.
--/
-theorem is_topological_basis_cofiltered_limit
-  (T : Π j, set (set (F.obj j))) (hT : ∀ j, is_topological_basis (T j))
-  (univ : ∀ (i : J), set.univ ∈ T i)
-  (inter : ∀ i (U1 U2 : set (F.obj i)), U1 ∈ T i → U2 ∈ T i → U1 ∩ U2 ∈ T i)
-  (compat : ∀ (i j : J) (f : i ⟶ j) (V : set (F.obj j)) (hV : V ∈ T j), (F.map f) ⁻¹' V ∈ T i) :
-  is_topological_basis { U : set C.X | ∃ j (V : set (F.obj j)), V ∈ T j ∧ U = C.π.app j ⁻¹' V } :=
-begin
-  classical,
-  -- The limit cone for `F` whose topology is defined as an infimum.
-  let D := limit_cone_infi F,
-  -- The isomorphism between the cone point of `C` and the cone point of `D`.
-  let E : C.X ≅ D.X := hC.cone_point_unique_up_to_iso (limit_cone_infi_is_limit _),
-  have hE : inducing E.hom := (Top.homeo_of_iso E).inducing,
-  -- Reduce to the assertion of the theorem with `D` instead of `C`.
-  suffices : is_topological_basis
-    { U : set D.X | ∃ j (V : set (F.obj j)), V ∈ T j ∧ U = D.π.app j ⁻¹' V },
-  { convert this.inducing hE,
-    ext U0,
-    split,
-    { rintro ⟨j, V, hV, rfl⟩,
-      refine ⟨D.π.app j ⁻¹' V, ⟨j, V, hV, rfl⟩, rfl⟩ },
-    { rintro ⟨W, ⟨j, V, hV, rfl⟩, rfl⟩,
-      refine ⟨j, V, hV, rfl⟩ } },
-  -- Using `D`, we can apply the characterization of the topological basis of a
-  -- topology defined as an infimum...
-  convert is_topological_basis_infi hT (λ j (x : D.X), D.π.app j x),
-  ext U0,
-  split,
-  { rintros  ⟨j, V, hV, rfl⟩,
-    let U : Π i, set (F.obj i) := λ i, if h : i = j then (by {rw h, exact V}) else set.univ,
-    refine ⟨U,{j},_,_⟩,
-    { rintro i h,
-      rw finset.mem_singleton at h,
-      dsimp [U],
-      rw dif_pos h,
-      subst h,
-      exact hV },
-    { dsimp [U],
-      simp } },
-  { rintros ⟨U, G, h1, h2⟩,
-    obtain ⟨j, hj⟩ := is_cofiltered.inf_objs_exists G,
-    let g : ∀ e (he : e ∈ G), j ⟶ e := λ _ he, (hj he).some,
-    let Vs : J → set (F.obj j) := λ e, if h : e ∈ G then F.map (g e h) ⁻¹' (U e) else set.univ,
-    let V : set (F.obj j) := ⋂ (e : J) (he : e ∈ G), Vs e,
-    refine ⟨j, V, _, _⟩,
-    { -- An intermediate claim used to apply induction along `G : finset J` later on.
-      have : ∀ (S : set (set (F.obj j))) (E : finset J) (P : J → set (F.obj j))
-        (univ : set.univ ∈ S)
-        (inter : ∀ A B : set (F.obj j), A ∈ S → B ∈ S → A ∩ B ∈ S)
-        (cond : ∀ (e : J) (he : e ∈ E), P e ∈ S), (⋂ e (he : e ∈ E), P e) ∈ S,
-      { intros S E,
-        apply E.induction_on,
-        { intros P he hh,
-          simpa },
-        { intros a E ha hh1 hh2 hh3 hh4 hh5,
-          rw finset.set_bInter_insert,
-          refine hh4 _ _ (hh5 _ (finset.mem_insert_self _ _)) (hh1 _ hh3 hh4 _),
-          intros e he,
-          exact hh5 e (finset.mem_insert_of_mem he) } },
-      -- use the intermediate claim to finish off the goal using `univ` and `inter`.
-      refine this _ _ _ (univ _) (inter _) _,
-      intros e he,
-      dsimp [Vs],
-      rw dif_pos he,
-      exact compat j e (g e he) (U e) (h1 e he), },
-    { -- conclude...
-      rw h2,
-      dsimp [V],
-      rw set.preimage_Inter,
-      congr' 1,
-      ext1 e,
-      rw set.preimage_Inter,
-      congr' 1,
-      ext1 he,
-      dsimp [Vs],
-      rw [dif_pos he, ← set.preimage_comp],
-      congr' 1,
-      change _ = ⇑(D.π.app j ≫ F.map (g e he)),
-      rw D.w } }
-end
-
-end cofiltered_limit
-
-section topological_konig
-
-/-!
-## Topological Kőnig's lemma
-
-A topological version of Kőnig's lemma is that the inverse limit of nonempty compact Hausdorff
-spaces is nonempty.  (Note: this can be generalized further to inverse limits of nonempty compact
-T0 spaces, where all the maps are closed maps; see [Stone1979] --- however there is an erratum
-for Theorem 4 that the element in the inverse limit can have cofinally many components that are
-not closed points.)
-
-We give this in a more general form, which is that cofiltered limits
-of nonempty compact Hausdorff spaces are nonempty
-(`nonempty_limit_cone_of_compact_t2_cofiltered_system`).
-
-This also applies to inverse limits, where `{J : Type u} [preorder J] [is_directed J (≤)]` and
-`F : Jᵒᵖ ⥤ Top`.
-
-The theorem is specialized to nonempty finite types (which are compact Hausdorff with the
-discrete topology) in `nonempty_sections_of_fintype_cofiltered_system` and
-`nonempty_sections_of_fintype_inverse_system`.
-
-(See  for the Set version.)
--/
-
-variables {J : Type u} [small_category J]
-variables (F : J ⥤ Top.{u})
-
-private abbreviation finite_diagram_arrow {J : Type u} [small_category J] (G : finset J) :=
-Σ' (X Y : J) (mX : X ∈ G) (mY : Y ∈ G), X ⟶ Y
-private abbreviation finite_diagram (J : Type u) [small_category J] :=
-Σ (G : finset J), finset (finite_diagram_arrow G)
-
-/--
-Partial sections of a cofiltered limit are sections when restricted to
-a finite subset of objects and morphisms of `J`.
--/
-def partial_sections {J : Type u} [small_category J] (F : J ⥤ Top.{u})
-  {G : finset J} (H : finset (finite_diagram_arrow G)) : set (Π j, F.obj j) :=
-{ u | ∀ {f : finite_diagram_arrow G} (hf : f ∈ H), F.map f.2.2.2.2 (u f.1) = u f.2.1 }
-
-lemma partial_sections.nonempty [is_cofiltered J] [h : Π (j : J), nonempty (F.obj j)]
-  {G : finset J} (H : finset (finite_diagram_arrow G)) :
-  (partial_sections F H).nonempty :=
-begin
-  classical,
-  use λ (j : J), if hj : j ∈ G
-                 then F.map (is_cofiltered.inf_to G H hj) (h (is_cofiltered.inf G H)).some
-                 else (h _).some,
-  rintros ⟨X, Y, hX, hY, f⟩ hf,
-  dsimp only,
-  rwa [dif_pos hX, dif_pos hY, ←comp_app, ←F.map_comp,
-       @is_cofiltered.inf_to_commutes _ _ _ G H],
-end
-
-lemma partial_sections.directed :
-  directed superset (λ (G : finite_diagram J), partial_sections F G.2) :=
-begin
-  classical,
-  intros A B,
-  let ιA : finite_diagram_arrow A.1 → finite_diagram_arrow (A.1 ⊔ B.1) :=
-    λ f, ⟨f.1, f.2.1, finset.mem_union_left _ f.2.2.1, finset.mem_union_left _ f.2.2.2.1,
-          f.2.2.2.2⟩,
-  let ιB : finite_diagram_arrow B.1 → finite_diagram_arrow (A.1 ⊔ B.1) :=
-    λ f, ⟨f.1, f.2.1, finset.mem_union_right _ f.2.2.1, finset.mem_union_right _ f.2.2.2.1,
-          f.2.2.2.2⟩,
-  refine ⟨⟨A.1 ⊔ B.1, A.2.image ιA ⊔ B.2.image ιB⟩, _, _⟩,
-  { rintro u hu f hf,
-    have : ιA f ∈ A.2.image ιA ⊔ B.2.image ιB,
-    { apply finset.mem_union_left,
-      rw finset.mem_image,
-      refine ⟨f, hf, rfl⟩ },
-    exact hu this },
-  { rintro u hu f hf,
-    have : ιB f ∈ A.2.image ιA ⊔ B.2.image ιB,
-    { apply finset.mem_union_right,
-      rw finset.mem_image,
-      refine ⟨f, hf, rfl⟩ },
-    exact hu this }
-end
-
-lemma partial_sections.closed [Π (j : J), t2_space (F.obj j)]
-  {G : finset J} (H : finset (finite_diagram_arrow G)) :
-  is_closed (partial_sections F H) :=
-begin
-  have : partial_sections F H =
-    ⋂ {f : finite_diagram_arrow G} (hf : f ∈ H), { u | F.map f.2.2.2.2 (u f.1) = u f.2.1 },
-  { ext1,
-    simp only [set.mem_Inter, set.mem_set_of_eq],
-    refl, },
-  rw this,
-  apply is_closed_bInter,
-  intros f hf,
-  apply is_closed_eq,
-  continuity,
-end
-
-/--
-Cofiltered limits of nonempty compact Hausdorff spaces are nonempty topological spaces.
---/
-lemma nonempty_limit_cone_of_compact_t2_cofiltered_system
-  [is_cofiltered J]
-  [Π (j : J), nonempty (F.obj j)]
-  [Π (j : J), compact_space (F.obj j)]
-  [Π (j : J), t2_space (F.obj j)] :
-  nonempty (Top.limit_cone F).X :=
-begin
-  classical,
-  obtain ⟨u, hu⟩ := is_compact.nonempty_Inter_of_directed_nonempty_compact_closed
-    (λ G, partial_sections F _)
-    (partial_sections.directed F)
-    (λ G, partial_sections.nonempty F _)
-    (λ G, is_closed.is_compact (partial_sections.closed F _))
-    (λ G, partial_sections.closed F _),
-  use u,
-  intros X Y f,
-  let G : finite_diagram J :=
-    ⟨{X, Y},
-     {⟨X, Y,
-      by simp only [true_or, eq_self_iff_true, finset.mem_insert],
-      by simp only [eq_self_iff_true, or_true, finset.mem_insert, finset.mem_singleton],
-      f⟩}⟩,
-  exact hu _ ⟨G, rfl⟩ (finset.mem_singleton_self _),
-end
-
-end topological_konig
-
-end Top
-
-section fintype_konig
-
-/-- This bootstraps `nonempty_sections_of_fintype_inverse_system`. In this version,
-the `F` functor is between categories of the same universe, and it is an easy
-corollary to `Top.nonempty_limit_cone_of_compact_t2_inverse_system`. -/
-lemma nonempty_sections_of_fintype_cofiltered_system.init
-  {J : Type u} [small_category J] [is_cofiltered J] (F : J ⥤ Type u)
-  [hf : Π (j : J), fintype (F.obj j)] [hne : Π (j : J), nonempty (F.obj j)] :
-  F.sections.nonempty :=
-begin
-  let F' : J ⥤ Top := F ⋙ Top.discrete,
-  haveI : Π (j : J), fintype (F'.obj j) := hf,
-  haveI : Π (j : J), nonempty (F'.obj j) := hne,
-  obtain ⟨⟨u, hu⟩⟩ := Top.nonempty_limit_cone_of_compact_t2_cofiltered_system F',
-  exact ⟨u, λ _ _ f, hu f⟩,
-end
-
-/-- The cofiltered limit of nonempty finite types is nonempty.
-
-See `nonempty_sections_of_fintype_inverse_system` for a specialization to inverse limits. -/
-theorem nonempty_sections_of_fintype_cofiltered_system
-  {J : Type u} [category.{w} J] [is_cofiltered J] (F : J ⥤ Type v)
-  [Π (j : J), fintype (F.obj j)] [Π (j : J), nonempty (F.obj j)] :
-  F.sections.nonempty :=
-begin
-  -- Step 1: lift everything to the `max u v w` universe.
-  let J' : Type (max w v u) := as_small.{max w v} J,
-  let down : J' ⥤ J := as_small.down,
-  let F' : J' ⥤ Type (max u v w) := down ⋙ F ⋙ ulift_functor.{(max u w) v},
-  haveI : ∀ i, nonempty (F'.obj i) := λ i, ⟨⟨classical.arbitrary (F.obj (down.obj i))⟩⟩,
-  haveI : ∀ i, fintype (F'.obj i) := λ i, fintype.of_equiv (F.obj (down.obj i)) equiv.ulift.symm,
-  -- Step 2: apply the bootstrap theorem
-  obtain ⟨u, hu⟩ := nonempty_sections_of_fintype_cofiltered_system.init F',
-  -- Step 3: interpret the results
-  use λ j, (u ⟨j⟩).down,
-  intros j j' f,
-  have h := @hu (⟨j⟩ : J') (⟨j'⟩ : J') (ulift.up f),
-  simp only [as_small.down, functor.comp_map, ulift_functor_map, functor.op_map] at h,
-  simp_rw [←h],
-  refl,
-end
-
-/-- The inverse limit of nonempty finite types is nonempty.
-
-See `nonempty_sections_of_fintype_cofiltered_system` for a generalization to cofiltered limits.
-That version applies in almost all cases, and the only difference is that this version
-allows `J` to be empty.
-
-This may be regarded as a generalization of Kőnig's lemma.
-To specialize: given a locally finite connected graph, take `Jᵒᵖ` to be `ℕ` and
-`F j` to be length-`j` paths that start from an arbitrary fixed vertex.
-Elements of `F.sections` can be read off as infinite rays in the graph. -/
-theorem nonempty_sections_of_fintype_inverse_system
-  {J : Type u} [preorder J] [is_directed J (≤)] (F : Jᵒᵖ ⥤ Type v)
-  [Π (j : Jᵒᵖ), fintype (F.obj j)] [Π (j : Jᵒᵖ), nonempty (F.obj j)] :
-  F.sections.nonempty :=
-begin
-  casesI is_empty_or_nonempty J,
-  { haveI : is_empty Jᵒᵖ := ⟨λ j, is_empty_elim j.unop⟩,  -- TODO: this should be a global instance
-    exact ⟨is_empty_elim, is_empty_elim⟩, },
-  { exact nonempty_sections_of_fintype_cofiltered_system _, },
-end
-
-end fintype_konig
diff --git a/src/topology/category/Top/limits/basic.lean b/src/topology/category/Top/limits/basic.lean
new file mode 100644
index 0000000000000..9b7985310f6da
--- /dev/null
+++ b/src/topology/category/Top/limits/basic.lean
@@ -0,0 +1,165 @@
+/-
+Copyright (c) 2017 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Scott Morrison, Mario Carneiro, Andrew Yang
+-/
+import topology.category.Top.basic
+import category_theory.limits.concrete_category
+
+/-!
+# The category of topological spaces has all limits and colimits
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Further, these limits and colimits are preserved by the forgetful functor --- that is, the
+underlying types are just the limits in the category of types.
+-/
+
+open topological_space
+open category_theory
+open category_theory.limits
+open opposite
+
+universes u v w
+
+noncomputable theory
+
+namespace Top
+
+variables {J : Type v} [small_category J]
+
+local notation `forget` := forget Top
+
+/--
+A choice of limit cone for a functor `F : J ⥤ Top`.
+Generally you should just use `limit.cone F`, unless you need the actual definition
+(which is in terms of `types.limit_cone`).
+-/
+def limit_cone (F : J ⥤ Top.{max v u}) : cone F :=
+{ X := Top.of {u : Π j : J, F.obj j | ∀ {i j : J} (f : i ⟶ j), F.map f (u i) = u j},
+  π :=
+  { app := λ j,
+    { to_fun := λ u, u.val j,
+      continuous_to_fun := show continuous ((λ u : Π j : J, F.obj j, u j) ∘ subtype.val),
+        by continuity } } }
+
+/--
+A choice of limit cone for a functor `F : J ⥤ Top` whose topology is defined as an
+infimum of topologies infimum.
+Generally you should just use `limit.cone F`, unless you need the actual definition
+(which is in terms of `types.limit_cone`).
+-/
+def limit_cone_infi (F : J ⥤ Top.{max v u}) : cone F :=
+{ X := ⟨(types.limit_cone (F ⋙ forget)).X, ⨅j,
+        (F.obj j).str.induced ((types.limit_cone (F ⋙ forget)).π.app j)⟩,
+  π :=
+  { app := λ j, ⟨(types.limit_cone (F ⋙ forget)).π.app j,
+                 continuous_iff_le_induced.mpr (infi_le _ _)⟩,
+    naturality' := λ j j' f, continuous_map.coe_injective
+      ((types.limit_cone (F ⋙ forget)).π.naturality f) } }
+
+/--
+The chosen cone `Top.limit_cone F` for a functor `F : J ⥤ Top` is a limit cone.
+Generally you should just use `limit.is_limit F`, unless you need the actual definition
+(which is in terms of `types.limit_cone_is_limit`).
+-/
+def limit_cone_is_limit (F : J ⥤ Top.{max v u}) : is_limit (limit_cone F) :=
+{ lift := λ S, { to_fun := λ x, ⟨λ j, S.π.app _ x, λ i j f, by { dsimp, erw ← S.w f, refl }⟩ },
+  uniq' := λ S m h, by { ext : 3, simpa [← h] } }
+
+/--
+The chosen cone `Top.limit_cone_infi F` for a functor `F : J ⥤ Top` is a limit cone.
+Generally you should just use `limit.is_limit F`, unless you need the actual definition
+(which is in terms of `types.limit_cone_is_limit`).
+-/
+def limit_cone_infi_is_limit (F : J ⥤ Top.{max v u}) : is_limit (limit_cone_infi F) :=
+by { refine is_limit.of_faithful forget (types.limit_cone_is_limit _) (λ s, ⟨_, _⟩) (λ s, rfl),
+     exact continuous_iff_coinduced_le.mpr (le_infi $ λ j,
+       coinduced_le_iff_le_induced.mp $ (continuous_iff_coinduced_le.mp (s.π.app j).continuous :
+         _) ) }
+
+instance Top_has_limits_of_size : has_limits_of_size.{v} Top.{max v u} :=
+{ has_limits_of_shape := λ J 𝒥, by exactI
+  { has_limit := λ F, has_limit.mk { cone := limit_cone F, is_limit := limit_cone_is_limit F } } }
+
+instance Top_has_limits : has_limits Top.{u} := Top.Top_has_limits_of_size.{u u}
+
+instance forget_preserves_limits_of_size :
+  preserves_limits_of_size.{v v} (forget : Top.{max v u} ⥤ Type (max v u)) :=
+{ preserves_limits_of_shape := λ J 𝒥,
+  { preserves_limit := λ F,
+    by exactI preserves_limit_of_preserves_limit_cone
+      (limit_cone_is_limit F) (types.limit_cone_is_limit (F ⋙ forget)) } }
+
+instance forget_preserves_limits : preserves_limits (forget : Top.{u} ⥤ Type u) :=
+Top.forget_preserves_limits_of_size.{u u}
+
+/--
+A choice of colimit cocone for a functor `F : J ⥤ Top`.
+Generally you should just use `colimit.coone F`, unless you need the actual definition
+(which is in terms of `types.colimit_cocone`).
+-/
+def colimit_cocone (F : J ⥤ Top.{max v u}) : cocone F :=
+{ X := ⟨(types.colimit_cocone (F ⋙ forget)).X, ⨆ j,
+        (F.obj j).str.coinduced ((types.colimit_cocone (F ⋙ forget)).ι.app j)⟩,
+  ι :=
+  { app := λ j, ⟨(types.colimit_cocone (F ⋙ forget)).ι.app j,
+                 continuous_iff_coinduced_le.mpr (le_supr _ j)⟩,
+    naturality' := λ j j' f, continuous_map.coe_injective
+      ((types.colimit_cocone (F ⋙ forget)).ι.naturality f) } }
+
+/--
+The chosen cocone `Top.colimit_cocone F` for a functor `F : J ⥤ Top` is a colimit cocone.
+Generally you should just use `colimit.is_colimit F`, unless you need the actual definition
+(which is in terms of `types.colimit_cocone_is_colimit`).
+-/
+def colimit_cocone_is_colimit (F : J ⥤ Top.{max v u}) : is_colimit (colimit_cocone F) :=
+by { refine is_colimit.of_faithful forget (types.colimit_cocone_is_colimit _) (λ s, ⟨_, _⟩)
+       (λ s, rfl),
+     exact continuous_iff_le_induced.mpr (supr_le $ λ j,
+       coinduced_le_iff_le_induced.mp $ (continuous_iff_coinduced_le.mp (s.ι.app j).continuous :
+         _) ) }
+
+instance Top_has_colimits_of_size : has_colimits_of_size.{v} Top.{max v u} :=
+{ has_colimits_of_shape := λ J 𝒥, by exactI
+  { has_colimit := λ F, has_colimit.mk { cocone := colimit_cocone F, is_colimit :=
+    colimit_cocone_is_colimit F } } }
+
+instance Top_has_colimits : has_colimits Top.{u} := Top.Top_has_colimits_of_size.{u u}
+
+instance forget_preserves_colimits_of_size :
+  preserves_colimits_of_size.{v v} (forget : Top.{max v u} ⥤ Type (max v u)) :=
+{ preserves_colimits_of_shape := λ J 𝒥,
+  { preserves_colimit := λ F,
+    by exactI preserves_colimit_of_preserves_colimit_cocone
+      (colimit_cocone_is_colimit F) (types.colimit_cocone_is_colimit (F ⋙ forget)) } }
+
+instance forget_preserves_colimits : preserves_colimits (forget : Top.{u} ⥤ Type u) :=
+Top.forget_preserves_colimits_of_size.{u u}
+
+/-- The terminal object of `Top` is `punit`. -/
+def is_terminal_punit : is_terminal (Top.of punit.{u+1}) :=
+begin
+  haveI : ∀ X, unique (X ⟶ Top.of punit.{u+1}) :=
+    λ X, ⟨⟨⟨λ x, punit.star, by continuity⟩⟩, λ f, by ext⟩,
+  exact limits.is_terminal.of_unique _,
+end
+
+/-- The terminal object of `Top` is `punit`. -/
+def terminal_iso_punit : ⊤_ Top.{u} ≅ Top.of punit :=
+terminal_is_terminal.unique_up_to_iso is_terminal_punit
+
+/-- The initial object of `Top` is `pempty`. -/
+def is_initial_pempty : is_initial (Top.of pempty.{u+1}) :=
+begin
+  haveI : ∀ X, unique (Top.of pempty.{u+1} ⟶ X) :=
+    λ X, ⟨⟨⟨λ x, x.elim, by continuity⟩⟩, λ f, by ext ⟨⟩⟩,
+  exact limits.is_initial.of_unique _,
+end
+
+/-- The initial object of `Top` is `pempty`. -/
+def initial_iso_pempty : ⊥_ Top.{u} ≅ Top.of pempty :=
+initial_is_initial.unique_up_to_iso is_initial_pempty
+
+end Top
diff --git a/src/topology/category/Top/limits/cofiltered.lean b/src/topology/category/Top/limits/cofiltered.lean
new file mode 100644
index 0000000000000..549bfcbcc81a3
--- /dev/null
+++ b/src/topology/category/Top/limits/cofiltered.lean
@@ -0,0 +1,124 @@
+/-
+Copyright (c) 2017 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Scott Morrison, Mario Carneiro, Andrew Yang
+-/
+import topology.category.Top.limits.basic
+
+/-!
+# Cofiltered limits in Top.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Given a *compatible* collection of topological bases for the factors in a cofiltered limit
+which contain `set.univ` and are closed under intersections, the induced *naive* collection
+of sets in the limit is, in fact, a topological basis.
+-/
+
+open topological_space
+open category_theory
+open category_theory.limits
+
+universes u v w
+
+noncomputable theory
+
+namespace Top
+
+section cofiltered_limit
+
+variables {J : Type v} [small_category J] [is_cofiltered J] (F : J ⥤ Top.{max v u})
+  (C : cone F) (hC : is_limit C)
+
+include hC
+
+/--
+Given a *compatible* collection of topological bases for the factors in a cofiltered limit
+which contain `set.univ` and are closed under intersections, the induced *naive* collection
+of sets in the limit is, in fact, a topological basis.
+-/
+theorem is_topological_basis_cofiltered_limit
+  (T : Π j, set (set (F.obj j))) (hT : ∀ j, is_topological_basis (T j))
+  (univ : ∀ (i : J), set.univ ∈ T i)
+  (inter : ∀ i (U1 U2 : set (F.obj i)), U1 ∈ T i → U2 ∈ T i → U1 ∩ U2 ∈ T i)
+  (compat : ∀ (i j : J) (f : i ⟶ j) (V : set (F.obj j)) (hV : V ∈ T j), (F.map f) ⁻¹' V ∈ T i) :
+  is_topological_basis { U : set C.X | ∃ j (V : set (F.obj j)), V ∈ T j ∧ U = C.π.app j ⁻¹' V } :=
+begin
+  classical,
+  -- The limit cone for `F` whose topology is defined as an infimum.
+  let D := limit_cone_infi F,
+  -- The isomorphism between the cone point of `C` and the cone point of `D`.
+  let E : C.X ≅ D.X := hC.cone_point_unique_up_to_iso (limit_cone_infi_is_limit _),
+  have hE : inducing E.hom := (Top.homeo_of_iso E).inducing,
+  -- Reduce to the assertion of the theorem with `D` instead of `C`.
+  suffices : is_topological_basis
+    { U : set D.X | ∃ j (V : set (F.obj j)), V ∈ T j ∧ U = D.π.app j ⁻¹' V },
+  { convert this.inducing hE,
+    ext U0,
+    split,
+    { rintro ⟨j, V, hV, rfl⟩,
+      refine ⟨D.π.app j ⁻¹' V, ⟨j, V, hV, rfl⟩, rfl⟩ },
+    { rintro ⟨W, ⟨j, V, hV, rfl⟩, rfl⟩,
+      refine ⟨j, V, hV, rfl⟩ } },
+  -- Using `D`, we can apply the characterization of the topological basis of a
+  -- topology defined as an infimum...
+  convert is_topological_basis_infi hT (λ j (x : D.X), D.π.app j x),
+  ext U0,
+  split,
+  { rintros  ⟨j, V, hV, rfl⟩,
+    let U : Π i, set (F.obj i) := λ i, if h : i = j then (by {rw h, exact V}) else set.univ,
+    refine ⟨U,{j},_,_⟩,
+    { rintro i h,
+      rw finset.mem_singleton at h,
+      dsimp [U],
+      rw dif_pos h,
+      subst h,
+      exact hV },
+    { dsimp [U],
+      simp } },
+  { rintros ⟨U, G, h1, h2⟩,
+    obtain ⟨j, hj⟩ := is_cofiltered.inf_objs_exists G,
+    let g : ∀ e (he : e ∈ G), j ⟶ e := λ _ he, (hj he).some,
+    let Vs : J → set (F.obj j) := λ e, if h : e ∈ G then F.map (g e h) ⁻¹' (U e) else set.univ,
+    let V : set (F.obj j) := ⋂ (e : J) (he : e ∈ G), Vs e,
+    refine ⟨j, V, _, _⟩,
+    { -- An intermediate claim used to apply induction along `G : finset J` later on.
+      have : ∀ (S : set (set (F.obj j))) (E : finset J) (P : J → set (F.obj j))
+        (univ : set.univ ∈ S)
+        (inter : ∀ A B : set (F.obj j), A ∈ S → B ∈ S → A ∩ B ∈ S)
+        (cond : ∀ (e : J) (he : e ∈ E), P e ∈ S), (⋂ e (he : e ∈ E), P e) ∈ S,
+      { intros S E,
+        apply E.induction_on,
+        { intros P he hh,
+          simpa },
+        { intros a E ha hh1 hh2 hh3 hh4 hh5,
+          rw finset.set_bInter_insert,
+          refine hh4 _ _ (hh5 _ (finset.mem_insert_self _ _)) (hh1 _ hh3 hh4 _),
+          intros e he,
+          exact hh5 e (finset.mem_insert_of_mem he) } },
+      -- use the intermediate claim to finish off the goal using `univ` and `inter`.
+      refine this _ _ _ (univ _) (inter _) _,
+      intros e he,
+      dsimp [Vs],
+      rw dif_pos he,
+      exact compat j e (g e he) (U e) (h1 e he), },
+    { -- conclude...
+      rw h2,
+      dsimp [V],
+      rw set.preimage_Inter,
+      congr' 1,
+      ext1 e,
+      rw set.preimage_Inter,
+      congr' 1,
+      ext1 he,
+      dsimp [Vs],
+      rw [dif_pos he, ← set.preimage_comp],
+      congr' 1,
+      change _ = ⇑(D.π.app j ≫ F.map (g e he)),
+      rw D.w } }
+end
+
+end cofiltered_limit
+
+end Top
diff --git a/src/topology/category/Top/limits/konig.lean b/src/topology/category/Top/limits/konig.lean
new file mode 100644
index 0000000000000..992e9c8e6ed50
--- /dev/null
+++ b/src/topology/category/Top/limits/konig.lean
@@ -0,0 +1,150 @@
+/-
+Copyright (c) 2017 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Scott Morrison, Mario Carneiro, Andrew Yang
+-/
+import topology.category.Top.limits.basic
+
+/-!
+# Topological Kőnig's lemma
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A topological version of Kőnig's lemma is that the inverse limit of nonempty compact Hausdorff
+spaces is nonempty.  (Note: this can be generalized further to inverse limits of nonempty compact
+T0 spaces, where all the maps are closed maps; see [Stone1979] --- however there is an erratum
+for Theorem 4 that the element in the inverse limit can have cofinally many components that are
+not closed points.)
+
+We give this in a more general form, which is that cofiltered limits
+of nonempty compact Hausdorff spaces are nonempty
+(`nonempty_limit_cone_of_compact_t2_cofiltered_system`).
+
+This also applies to inverse limits, where `{J : Type u} [preorder J] [is_directed J (≤)]` and
+`F : Jᵒᵖ ⥤ Top`.
+
+The theorem is specialized to nonempty finite types (which are compact Hausdorff with the
+discrete topology) in lemmas `nonempty_sections_of_finite_cofiltered_system` and
+`nonempty_sections_of_finite_inverse_system` in the file `category_theory.cofiltered_system`.
+
+(See  for the Set version.)
+-/
+
+open category_theory
+open category_theory.limits
+
+universes u v w
+
+noncomputable theory
+
+namespace Top
+
+section topological_konig
+
+variables {J : Type u} [small_category J]
+variables (F : J ⥤ Top.{u})
+
+private abbreviation finite_diagram_arrow {J : Type u} [small_category J] (G : finset J) :=
+Σ' (X Y : J) (mX : X ∈ G) (mY : Y ∈ G), X ⟶ Y
+private abbreviation finite_diagram (J : Type u) [small_category J] :=
+Σ (G : finset J), finset (finite_diagram_arrow G)
+
+/--
+Partial sections of a cofiltered limit are sections when restricted to
+a finite subset of objects and morphisms of `J`.
+-/
+def partial_sections {J : Type u} [small_category J] (F : J ⥤ Top.{u})
+  {G : finset J} (H : finset (finite_diagram_arrow G)) : set (Π j, F.obj j) :=
+{ u | ∀ {f : finite_diagram_arrow G} (hf : f ∈ H), F.map f.2.2.2.2 (u f.1) = u f.2.1 }
+
+lemma partial_sections.nonempty [is_cofiltered_or_empty J] [h : Π (j : J), nonempty (F.obj j)]
+  {G : finset J} (H : finset (finite_diagram_arrow G)) :
+  (partial_sections F H).nonempty :=
+begin
+  classical,
+  casesI is_empty_or_nonempty J,
+  { exact ⟨is_empty_elim, λ j, is_empty.elim' infer_instance j.1⟩ },
+  haveI : is_cofiltered J := ⟨⟩,
+  use λ (j : J), if hj : j ∈ G
+                 then F.map (is_cofiltered.inf_to G H hj) (h (is_cofiltered.inf G H)).some
+                 else (h _).some,
+  rintros ⟨X, Y, hX, hY, f⟩ hf,
+  dsimp only,
+  rwa [dif_pos hX, dif_pos hY, ←comp_app, ←F.map_comp,
+       @is_cofiltered.inf_to_commutes _ _ _ G H],
+end
+
+lemma partial_sections.directed :
+  directed superset (λ (G : finite_diagram J), partial_sections F G.2) :=
+begin
+  classical,
+  intros A B,
+  let ιA : finite_diagram_arrow A.1 → finite_diagram_arrow (A.1 ⊔ B.1) :=
+    λ f, ⟨f.1, f.2.1, finset.mem_union_left _ f.2.2.1, finset.mem_union_left _ f.2.2.2.1,
+          f.2.2.2.2⟩,
+  let ιB : finite_diagram_arrow B.1 → finite_diagram_arrow (A.1 ⊔ B.1) :=
+    λ f, ⟨f.1, f.2.1, finset.mem_union_right _ f.2.2.1, finset.mem_union_right _ f.2.2.2.1,
+          f.2.2.2.2⟩,
+  refine ⟨⟨A.1 ⊔ B.1, A.2.image ιA ⊔ B.2.image ιB⟩, _, _⟩,
+  { rintro u hu f hf,
+    have : ιA f ∈ A.2.image ιA ⊔ B.2.image ιB,
+    { apply finset.mem_union_left,
+      rw finset.mem_image,
+      refine ⟨f, hf, rfl⟩ },
+    exact hu this },
+  { rintro u hu f hf,
+    have : ιB f ∈ A.2.image ιA ⊔ B.2.image ιB,
+    { apply finset.mem_union_right,
+      rw finset.mem_image,
+      refine ⟨f, hf, rfl⟩ },
+    exact hu this }
+end
+
+lemma partial_sections.closed [Π (j : J), t2_space (F.obj j)]
+  {G : finset J} (H : finset (finite_diagram_arrow G)) :
+  is_closed (partial_sections F H) :=
+begin
+  have : partial_sections F H =
+    ⋂ {f : finite_diagram_arrow G} (hf : f ∈ H), { u | F.map f.2.2.2.2 (u f.1) = u f.2.1 },
+  { ext1,
+    simp only [set.mem_Inter, set.mem_set_of_eq],
+    refl, },
+  rw this,
+  apply is_closed_bInter,
+  intros f hf,
+  apply is_closed_eq,
+  continuity,
+end
+
+/--
+Cofiltered limits of nonempty compact Hausdorff spaces are nonempty topological spaces.
+-/
+lemma nonempty_limit_cone_of_compact_t2_cofiltered_system
+  [is_cofiltered_or_empty J]
+  [Π (j : J), nonempty (F.obj j)]
+  [Π (j : J), compact_space (F.obj j)]
+  [Π (j : J), t2_space (F.obj j)] :
+  nonempty (Top.limit_cone.{u} F).X :=
+begin
+  classical,
+  obtain ⟨u, hu⟩ := is_compact.nonempty_Inter_of_directed_nonempty_compact_closed
+    (λ G, partial_sections F _)
+    (partial_sections.directed F)
+    (λ G, partial_sections.nonempty F _)
+    (λ G, is_closed.is_compact (partial_sections.closed F _))
+    (λ G, partial_sections.closed F _),
+  use u,
+  intros X Y f,
+  let G : finite_diagram J :=
+    ⟨{X, Y},
+     {⟨X, Y,
+      by simp only [true_or, eq_self_iff_true, finset.mem_insert],
+      by simp only [eq_self_iff_true, or_true, finset.mem_insert, finset.mem_singleton],
+      f⟩}⟩,
+  exact hu _ ⟨G, rfl⟩ (finset.mem_singleton_self _),
+end
+
+end topological_konig
+
+end Top
diff --git a/src/topology/category/Top/limits/products.lean b/src/topology/category/Top/limits/products.lean
new file mode 100644
index 0000000000000..cee1c228483cb
--- /dev/null
+++ b/src/topology/category/Top/limits/products.lean
@@ -0,0 +1,314 @@
+/-
+Copyright (c) 2017 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Scott Morrison, Mario Carneiro, Andrew Yang
+-/
+import topology.category.Top.epi_mono
+import topology.category.Top.limits.basic
+
+/-!
+# Products and coproducts in the category of topological spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+open topological_space
+open category_theory
+open category_theory.limits
+
+universes u v w
+
+noncomputable theory
+
+namespace Top
+
+variables {J : Type v} [small_category J]
+
+/-- The projection from the product as a bundled continous map. -/
+abbreviation pi_π {ι : Type v} (α : ι → Top.{max v u}) (i : ι) : Top.of (Π i, α i) ⟶ α i :=
+⟨λ f, f i, continuous_apply i⟩
+
+/-- The explicit fan of a family of topological spaces given by the pi type. -/
+@[simps X π_app]
+def pi_fan {ι : Type v} (α : ι → Top.{max v u}) : fan α :=
+fan.mk (Top.of (Π i, α i)) (pi_π α)
+
+/-- The constructed fan is indeed a limit -/
+def pi_fan_is_limit {ι : Type v} (α : ι → Top.{max v u}) : is_limit (pi_fan α) :=
+{ lift := λ S, { to_fun := λ s i, S.π.app ⟨i⟩ s },
+  uniq' := by { intros S m h, ext x i, simp [← h ⟨i⟩] },
+  fac' := λ s j, by { cases j, tidy, }, }
+
+/--
+The product is homeomorphic to the product of the underlying spaces,
+equipped with the product topology.
+-/
+def pi_iso_pi {ι : Type v} (α : ι → Top.{max v u}) : ∏ α ≅ Top.of (Π i, α i) :=
+(limit.is_limit _).cone_point_unique_up_to_iso (pi_fan_is_limit α)
+
+@[simp, reassoc]
+lemma pi_iso_pi_inv_π {ι : Type v} (α : ι → Top.{max v u}) (i : ι) :
+  (pi_iso_pi α).inv ≫ pi.π α i = pi_π α i :=
+by simp [pi_iso_pi]
+
+@[simp]
+lemma pi_iso_pi_inv_π_apply {ι : Type v} (α : ι → Top.{max v u}) (i : ι) (x : Π i, α i) :
+  (pi.π α i : _) ((pi_iso_pi α).inv x) = x i :=
+concrete_category.congr_hom (pi_iso_pi_inv_π α i) x
+
+@[simp]
+lemma pi_iso_pi_hom_apply {ι : Type v} (α : ι → Top.{max v u}) (i : ι) (x : ∏ α) :
+  (pi_iso_pi α).hom x i = (pi.π α i : _) x :=
+begin
+  have := pi_iso_pi_inv_π α i,
+  rw iso.inv_comp_eq at this,
+  exact concrete_category.congr_hom this x
+end
+
+/-- The inclusion to the coproduct as a bundled continous map. -/
+abbreviation sigma_ι {ι : Type v} (α : ι → Top.{max v u}) (i : ι) : α i ⟶ Top.of (Σ i, α i) :=
+⟨sigma.mk i⟩
+
+/-- The explicit cofan of a family of topological spaces given by the sigma type. -/
+@[simps X ι_app]
+def sigma_cofan {ι : Type v} (α : ι → Top.{max v u}) : cofan α :=
+cofan.mk (Top.of (Σ i, α i)) (sigma_ι α)
+
+/-- The constructed cofan is indeed a colimit -/
+def sigma_cofan_is_colimit {ι : Type v} (α : ι → Top.{max v u}) : is_colimit (sigma_cofan α) :=
+{ desc := λ S, { to_fun := λ s, S.ι.app ⟨s.1⟩ s.2,
+    continuous_to_fun := continuous_sigma $ λ i, map_continuous (S.ι.app ⟨i⟩) },
+  uniq' := by { intros S m h,  ext ⟨i, x⟩, simp [← h ⟨i⟩] },
+  fac' := λ s j, by { cases j, tidy, }, }
+
+/--
+The coproduct is homeomorphic to the disjoint union of the topological spaces.
+-/
+def sigma_iso_sigma {ι : Type v} (α : ι → Top.{max v u}) : ∐ α ≅ Top.of (Σ i, α i) :=
+(colimit.is_colimit _).cocone_point_unique_up_to_iso (sigma_cofan_is_colimit α)
+
+@[simp, reassoc]
+lemma sigma_iso_sigma_hom_ι {ι : Type v} (α : ι → Top.{max v u}) (i : ι) :
+  sigma.ι α i ≫ (sigma_iso_sigma α).hom = sigma_ι α i :=
+by simp [sigma_iso_sigma]
+
+@[simp]
+lemma sigma_iso_sigma_hom_ι_apply {ι : Type v} (α : ι → Top.{max v u}) (i : ι) (x : α i) :
+  (sigma_iso_sigma α).hom ((sigma.ι α i : _) x) = sigma.mk i x :=
+concrete_category.congr_hom (sigma_iso_sigma_hom_ι α i) x
+
+@[simp]
+lemma sigma_iso_sigma_inv_apply {ι : Type v} (α : ι → Top.{max v u}) (i : ι) (x : α i) :
+  (sigma_iso_sigma α).inv ⟨i, x⟩ = (sigma.ι α i : _) x :=
+by { rw [← sigma_iso_sigma_hom_ι_apply, ← comp_app], simp, }
+
+lemma induced_of_is_limit {F : J ⥤ Top.{max v u}} (C : cone F) (hC : is_limit C) :
+  C.X.topological_space = ⨅ j, (F.obj j).topological_space.induced (C.π.app j) :=
+begin
+  let homeo := homeo_of_iso (hC.cone_point_unique_up_to_iso (limit_cone_infi_is_limit F)),
+  refine homeo.inducing.induced.trans _,
+  change induced homeo (⨅ (j : J), _) = _,
+  simpa [induced_infi, induced_compose],
+end
+
+lemma limit_topology (F : J ⥤ Top.{max v u}) :
+  (limit F).topological_space = ⨅ j, (F.obj j).topological_space.induced (limit.π F j) :=
+induced_of_is_limit _ (limit.is_limit F)
+
+section prod
+
+/-- The first projection from the product. -/
+abbreviation prod_fst {X Y : Top.{u}} : Top.of (X × Y) ⟶ X := ⟨prod.fst⟩
+
+/-- The second projection from the product. -/
+abbreviation prod_snd {X Y : Top.{u}} : Top.of (X × Y) ⟶ Y := ⟨prod.snd⟩
+
+/-- The explicit binary cofan of `X, Y` given by `X × Y`. -/
+def prod_binary_fan (X Y : Top.{u}) : binary_fan X Y :=
+binary_fan.mk prod_fst prod_snd
+
+/-- The constructed binary fan is indeed a limit -/
+def prod_binary_fan_is_limit (X Y : Top.{u}) : is_limit (prod_binary_fan X Y) :=
+{ lift := λ (S : binary_fan X Y), { to_fun := λ s, (S.fst s, S.snd s) },
+  fac' := begin
+    rintros S (_|_),
+    tidy
+  end,
+  uniq' := begin
+    intros S m h,
+    ext x,
+    { specialize h ⟨walking_pair.left⟩,
+      apply_fun (λ e, (e x)) at h,
+      exact h },
+     { specialize h ⟨walking_pair.right⟩,
+      apply_fun (λ e, (e x)) at h,
+      exact h },
+  end }
+
+/--
+The homeomorphism between `X ⨯ Y` and the set-theoretic product of `X` and `Y`,
+equipped with the product topology.
+-/
+def prod_iso_prod (X Y : Top.{u}) : X ⨯ Y ≅ Top.of (X × Y) :=
+(limit.is_limit _).cone_point_unique_up_to_iso (prod_binary_fan_is_limit X Y)
+
+@[simp, reassoc] lemma prod_iso_prod_hom_fst (X Y : Top.{u}) :
+  (prod_iso_prod X Y).hom ≫ prod_fst = limits.prod.fst :=
+by simpa [← iso.eq_inv_comp, prod_iso_prod]
+
+@[simp, reassoc] lemma prod_iso_prod_hom_snd (X Y : Top.{u}) :
+  (prod_iso_prod X Y).hom ≫ prod_snd = limits.prod.snd :=
+by simpa [← iso.eq_inv_comp, prod_iso_prod]
+
+@[simp] lemma prod_iso_prod_hom_apply {X Y : Top.{u}} (x : X ⨯ Y) :
+  (prod_iso_prod X Y).hom x =
+    ((limits.prod.fst : X ⨯ Y ⟶ _) x, (limits.prod.snd : X ⨯ Y ⟶ _) x) :=
+begin
+  ext,
+  { exact concrete_category.congr_hom (prod_iso_prod_hom_fst X Y) x },
+  { exact concrete_category.congr_hom (prod_iso_prod_hom_snd X Y) x }
+end
+
+@[simp, reassoc, elementwise] lemma prod_iso_prod_inv_fst (X Y : Top.{u}) :
+  (prod_iso_prod X Y).inv ≫ limits.prod.fst = prod_fst :=
+by simp [iso.inv_comp_eq]
+
+@[simp, reassoc, elementwise] lemma prod_iso_prod_inv_snd (X Y : Top.{u}) :
+  (prod_iso_prod X Y).inv ≫ limits.prod.snd = prod_snd :=
+by simp [iso.inv_comp_eq]
+
+lemma prod_topology {X Y : Top} :
+  (X ⨯ Y).topological_space =
+    induced (limits.prod.fst : X ⨯ Y ⟶ _) X.topological_space ⊓
+      induced (limits.prod.snd : X ⨯ Y ⟶ _) Y.topological_space :=
+begin
+  let homeo := homeo_of_iso (prod_iso_prod X Y),
+  refine homeo.inducing.induced.trans _,
+  change induced homeo (_ ⊓ _) = _,
+  simpa [induced_compose]
+end
+
+lemma range_prod_map {W X Y Z : Top.{u}} (f : W ⟶ Y) (g : X ⟶ Z) :
+  set.range (limits.prod.map f g) =
+    (limits.prod.fst : Y ⨯ Z ⟶ _) ⁻¹' (set.range f) ∩
+      (limits.prod.snd : Y ⨯ Z ⟶ _) ⁻¹' (set.range g) :=
+begin
+  ext,
+  split,
+  { rintros ⟨y, rfl⟩,
+    simp only [set.mem_preimage, set.mem_range, set.mem_inter_iff, ←comp_apply],
+    simp only [limits.prod.map_fst, limits.prod.map_snd,
+      exists_apply_eq_apply, comp_apply, and_self] },
+  { rintros ⟨⟨x₁, hx₁⟩, ⟨x₂, hx₂⟩⟩,
+    use (prod_iso_prod W X).inv (x₁, x₂),
+    apply concrete.limit_ext,
+    rintro ⟨⟨⟩⟩,
+    { simp only [← comp_apply, category.assoc], erw limits.prod.map_fst, simp [hx₁] },
+    { simp only [← comp_apply, category.assoc], erw limits.prod.map_snd, simp [hx₂] } }
+end
+
+lemma inducing_prod_map {W X Y Z : Top} {f : W ⟶ X} {g : Y ⟶ Z}
+  (hf : inducing f) (hg : inducing g) : inducing (limits.prod.map f g) :=
+begin
+  constructor,
+  simp only [prod_topology, induced_compose, ←coe_comp, limits.prod.map_fst, limits.prod.map_snd,
+    induced_inf],
+  simp only [coe_comp],
+  rw [← @induced_compose _ _ _ _ _ f, ← @induced_compose _ _ _ _ _ g, ← hf.induced, ← hg.induced]
+end
+
+lemma embedding_prod_map {W X Y Z : Top} {f : W ⟶ X} {g : Y ⟶ Z}
+  (hf : embedding f) (hg : embedding g) : embedding (limits.prod.map f g) :=
+⟨inducing_prod_map hf.to_inducing hg.to_inducing,
+begin
+  haveI := (Top.mono_iff_injective _).mpr hf.inj,
+  haveI := (Top.mono_iff_injective _).mpr hg.inj,
+  exact (Top.mono_iff_injective _).mp infer_instance
+end⟩
+
+end prod
+
+
+/-- The binary coproduct cofan in `Top`. -/
+protected
+def binary_cofan (X Y : Top.{u}) : binary_cofan X Y :=
+binary_cofan.mk (⟨sum.inl⟩ : X ⟶ Top.of (X ⊕ Y)) ⟨sum.inr⟩
+
+/-- The constructed binary coproduct cofan in `Top` is the coproduct. -/
+def binary_cofan_is_colimit (X Y : Top.{u}) : is_colimit (Top.binary_cofan X Y) :=
+begin
+  refine limits.binary_cofan.is_colimit_mk (λ s, ⟨sum.elim s.inl s.inr⟩) _ _ _,
+  { intro s, ext, refl },
+  { intro s, ext, refl },
+  { intros s m h₁ h₂, ext (x|x),
+    exacts [(concrete_category.congr_hom h₁ x : _), (concrete_category.congr_hom h₂ x : _)] },
+end
+
+lemma binary_cofan_is_colimit_iff {X Y : Top} (c : binary_cofan X Y) :
+  nonempty (is_colimit c) ↔
+    open_embedding c.inl ∧ open_embedding c.inr ∧ is_compl (set.range c.inl) (set.range c.inr) :=
+begin
+  classical,
+  split,
+  { rintro ⟨h⟩,
+    rw [← show _ = c.inl, from h.comp_cocone_point_unique_up_to_iso_inv
+      (binary_cofan_is_colimit X Y) ⟨walking_pair.left⟩,
+      ← show _ = c.inr, from h.comp_cocone_point_unique_up_to_iso_inv
+      (binary_cofan_is_colimit X Y) ⟨walking_pair.right⟩],
+    dsimp,
+    refine
+    ⟨(homeo_of_iso $ h.cocone_point_unique_up_to_iso (binary_cofan_is_colimit X Y)).symm
+      .open_embedding.comp open_embedding_inl, (homeo_of_iso $ h.cocone_point_unique_up_to_iso
+        (binary_cofan_is_colimit X Y)).symm.open_embedding.comp open_embedding_inr, _⟩,
+    erw [set.range_comp, ← eq_compl_iff_is_compl, set.range_comp _ sum.inr, ← set.image_compl_eq
+      (homeo_of_iso $ h.cocone_point_unique_up_to_iso (binary_cofan_is_colimit X Y))
+      .symm.bijective],
+    congr' 1,
+    exact set.compl_range_inr.symm },
+  { rintros ⟨h₁, h₂, h₃⟩,
+    have : ∀ x, x ∈ set.range c.inl ∨ x ∈ set.range c.inr,
+    { rw [eq_compl_iff_is_compl.mpr h₃.symm], exact λ _, or_not },
+    refine ⟨binary_cofan.is_colimit.mk _ _ _ _ _⟩,
+    { intros T f g,
+      refine continuous_map.mk _ _,
+      { exact λ x, if h : x ∈ set.range c.inl
+        then f ((equiv.of_injective _ h₁.inj).symm ⟨x, h⟩)
+        else g ((equiv.of_injective _ h₂.inj).symm ⟨x, (this x).resolve_left h⟩) },
+      rw continuous_iff_continuous_at,
+      intro x,
+      by_cases x ∈ set.range c.inl,
+      { revert h x,
+      apply (is_open.continuous_on_iff _).mp,
+      { rw continuous_on_iff_continuous_restrict,
+        convert_to continuous (f ∘ (homeomorph.of_embedding _ h₁.to_embedding).symm),
+        { ext ⟨x, hx⟩, exact dif_pos hx },
+        continuity },
+      { exact h₁.open_range } },
+    { revert h x,
+      apply (is_open.continuous_on_iff _).mp,
+      { rw continuous_on_iff_continuous_restrict,
+        have : ∀ a, a ∉ set.range c.inl → a ∈ set.range c.inr,
+        { rintros a (h : a ∈ (set.range c.inl)ᶜ), rwa eq_compl_iff_is_compl.mpr h₃.symm },
+        convert_to continuous
+          (g ∘ (homeomorph.of_embedding _ h₂.to_embedding).symm ∘ subtype.map _ this),
+        { ext ⟨x, hx⟩, exact dif_neg hx },
+        continuity,
+        rw embedding_subtype_coe.to_inducing.continuous_iff,
+        exact continuous_subtype_coe },
+      { change is_open (set.range c.inl)ᶜ, rw ← eq_compl_iff_is_compl.mpr h₃.symm,
+        exact h₂.open_range } } },
+    { intros T f g, ext x, refine (dif_pos _).trans _, { exact ⟨x, rfl⟩ },
+        { rw equiv.of_injective_symm_apply } },
+    { intros T f g, ext x, refine (dif_neg _).trans _,
+      { rintro ⟨y, e⟩, have : c.inr x ∈ set.range c.inl ⊓ set.range c.inr := ⟨⟨_, e⟩, ⟨_, rfl⟩⟩,
+        rwa disjoint_iff.mp h₃.1 at this },
+      { exact congr_arg g (equiv.of_injective_symm_apply _ _) } },
+    { rintro T _ _ m rfl rfl, ext x, change m x = dite _ _ _,
+      split_ifs; exact congr_arg _ (equiv.apply_of_injective_symm _ ⟨_, _⟩).symm } }
+end
+
+--TODO: Add analogous constructions for `pushout`.
+
+end Top
diff --git a/src/topology/category/Top/limits/pullbacks.lean b/src/topology/category/Top/limits/pullbacks.lean
new file mode 100644
index 0000000000000..8e0d847277388
--- /dev/null
+++ b/src/topology/category/Top/limits/pullbacks.lean
@@ -0,0 +1,403 @@
+/-
+Copyright (c) 2017 Scott Morrison. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Scott Morrison, Mario Carneiro, Andrew Yang
+-/
+import topology.category.Top.limits.products
+import category_theory.concrete_category.elementwise
+
+/-!
+# Pullbacks in the category of topological spaces.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+-/
+
+open topological_space
+open category_theory
+open category_theory.limits
+
+universes u v w
+
+noncomputable theory
+
+namespace Top
+
+variables {J : Type v} [small_category J]
+
+section pullback
+
+variables {X Y Z : Top.{u}}
+
+/-- The first projection from the pullback. -/
+abbreviation pullback_fst (f : X ⟶ Z) (g : Y ⟶ Z) : Top.of { p : X × Y // f p.1 = g p.2 } ⟶ X :=
+⟨prod.fst ∘ subtype.val⟩
+
+/-- The second projection from the pullback. -/
+abbreviation pullback_snd (f : X ⟶ Z) (g : Y ⟶ Z) : Top.of { p : X × Y // f p.1 = g p.2 } ⟶ Y :=
+⟨prod.snd ∘ subtype.val⟩
+
+/-- The explicit pullback cone of `X, Y` given by `{ p : X × Y // f p.1 = g p.2 }`. -/
+def pullback_cone (f : X ⟶ Z) (g : Y ⟶ Z) : pullback_cone f g :=
+pullback_cone.mk (pullback_fst f g) (pullback_snd f g) (by { ext ⟨x, h⟩, simp [h] })
+
+/-- The constructed cone is a limit. -/
+def pullback_cone_is_limit (f : X ⟶ Z) (g : Y ⟶ Z) :
+  is_limit (pullback_cone f g) := pullback_cone.is_limit_aux' _
+begin
+  intro s,
+  split, swap,
+  exact { to_fun := λ x, ⟨⟨s.fst x, s.snd x⟩,
+    by simpa using concrete_category.congr_hom s.condition x⟩ },
+  refine ⟨_,_,_⟩,
+  { ext, delta pullback_cone, simp },
+  { ext, delta pullback_cone, simp },
+  { intros m h₁ h₂,
+    ext x,
+    { simpa using concrete_category.congr_hom h₁ x },
+    { simpa using concrete_category.congr_hom h₂ x } }
+end
+
+/-- The pullback of two maps can be identified as a subspace of `X × Y`. -/
+def pullback_iso_prod_subtype (f : X ⟶ Z) (g : Y ⟶ Z) :
+  pullback f g ≅ Top.of { p : X × Y // f p.1 = g p.2 } :=
+(limit.is_limit _).cone_point_unique_up_to_iso (pullback_cone_is_limit f g)
+
+@[simp, reassoc] lemma pullback_iso_prod_subtype_inv_fst (f : X ⟶ Z) (g : Y ⟶ Z) :
+  (pullback_iso_prod_subtype f g).inv ≫ pullback.fst = pullback_fst f g :=
+by simpa [pullback_iso_prod_subtype]
+
+@[simp] lemma pullback_iso_prod_subtype_inv_fst_apply (f : X ⟶ Z) (g : Y ⟶ Z)
+  (x : { p : X × Y // f p.1 = g p.2 }) :
+  (pullback.fst : pullback f g ⟶ _) ((pullback_iso_prod_subtype f g).inv x) = (x : X × Y).fst :=
+concrete_category.congr_hom (pullback_iso_prod_subtype_inv_fst f g) x
+
+@[simp, reassoc] lemma pullback_iso_prod_subtype_inv_snd (f : X ⟶ Z) (g : Y ⟶ Z) :
+  (pullback_iso_prod_subtype f g).inv ≫ pullback.snd = pullback_snd f g :=
+by simpa [pullback_iso_prod_subtype]
+
+@[simp] lemma pullback_iso_prod_subtype_inv_snd_apply (f : X ⟶ Z) (g : Y ⟶ Z)
+  (x : { p : X × Y // f p.1 = g p.2 }) :
+  (pullback.snd : pullback f g ⟶ _) ((pullback_iso_prod_subtype f g).inv x) = (x : X × Y).snd :=
+concrete_category.congr_hom (pullback_iso_prod_subtype_inv_snd f g) x
+
+lemma pullback_iso_prod_subtype_hom_fst (f : X ⟶ Z) (g : Y ⟶ Z) :
+  (pullback_iso_prod_subtype f g).hom ≫ pullback_fst f g = pullback.fst :=
+by rw [←iso.eq_inv_comp, pullback_iso_prod_subtype_inv_fst]
+
+lemma pullback_iso_prod_subtype_hom_snd (f : X ⟶ Z) (g : Y ⟶ Z) :
+  (pullback_iso_prod_subtype f g).hom ≫ pullback_snd f g = pullback.snd :=
+by rw [←iso.eq_inv_comp, pullback_iso_prod_subtype_inv_snd]
+
+@[simp] lemma pullback_iso_prod_subtype_hom_apply {f : X ⟶ Z} {g : Y ⟶ Z}
+  (x : pullback f g) : (pullback_iso_prod_subtype f g).hom x =
+    ⟨⟨(pullback.fst : pullback f g ⟶ _) x, (pullback.snd : pullback f g ⟶ _) x⟩,
+      by simpa using concrete_category.congr_hom pullback.condition x⟩ :=
+begin
+  ext,
+  exacts [concrete_category.congr_hom (pullback_iso_prod_subtype_hom_fst f g) x,
+    concrete_category.congr_hom (pullback_iso_prod_subtype_hom_snd f g) x]
+end
+
+lemma pullback_topology {X Y Z : Top.{u}} (f : X ⟶ Z) (g : Y ⟶ Z) :
+  (pullback f g).topological_space =
+    induced (pullback.fst : pullback f g ⟶ _) X.topological_space ⊓
+      induced (pullback.snd : pullback f g ⟶ _) Y.topological_space :=
+begin
+  let homeo := homeo_of_iso (pullback_iso_prod_subtype f g),
+  refine homeo.inducing.induced.trans _,
+  change induced homeo (induced _ (_ ⊓ _)) = _,
+  simpa [induced_compose]
+end
+
+lemma range_pullback_to_prod {X Y Z : Top} (f : X ⟶ Z) (g : Y ⟶ Z) :
+  set.range (prod.lift pullback.fst pullback.snd : pullback f g ⟶ X ⨯ Y) =
+  { x | (limits.prod.fst ≫ f) x = (limits.prod.snd ≫ g) x } :=
+begin
+  ext x,
+  split,
+  { rintros ⟨y, rfl⟩,
+    simp only [←comp_apply, set.mem_set_of_eq],
+    congr' 1,
+    simp [pullback.condition] },
+  { intro h,
+    use (pullback_iso_prod_subtype f g).inv ⟨⟨_, _⟩, h⟩,
+    apply concrete.limit_ext,
+    rintro ⟨⟨⟩⟩; simp, }
+end
+
+lemma inducing_pullback_to_prod {X Y Z : Top} (f : X ⟶ Z) (g : Y ⟶ Z) :
+  inducing ⇑(prod.lift pullback.fst pullback.snd : pullback f g ⟶ X ⨯ Y) :=
+⟨by simp [prod_topology, pullback_topology, induced_compose, ←coe_comp]⟩
+
+lemma embedding_pullback_to_prod {X Y Z : Top} (f : X ⟶ Z) (g : Y ⟶ Z) :
+  embedding ⇑(prod.lift pullback.fst pullback.snd : pullback f g ⟶ X ⨯ Y) :=
+⟨inducing_pullback_to_prod f g, (Top.mono_iff_injective _).mp infer_instance⟩
+
+/-- If the map `S ⟶ T` is mono, then there is a description of the image of `W ×ₛ X ⟶ Y ×ₜ Z`. -/
+lemma range_pullback_map {W X Y Z S T : Top} (f₁ : W ⟶ S) (f₂ : X ⟶ S)
+  (g₁ : Y ⟶ T) (g₂ : Z ⟶ T) (i₁ : W ⟶ Y) (i₂ : X ⟶ Z) (i₃ : S ⟶ T) [H₃ : mono i₃]
+  (eq₁ : f₁ ≫ i₃ = i₁ ≫ g₁) (eq₂ : f₂ ≫ i₃ = i₂ ≫ g₂) :
+  set.range (pullback.map f₁ f₂ g₁ g₂ i₁ i₂ i₃ eq₁ eq₂) =
+    (pullback.fst : pullback g₁ g₂ ⟶ _) ⁻¹' (set.range i₁) ∩
+      (pullback.snd : pullback g₁ g₂ ⟶ _) ⁻¹' (set.range i₂) :=
+begin
+  ext,
+  split,
+  { rintro ⟨y, rfl⟩, simp, },
+  rintros ⟨⟨x₁, hx₁⟩, ⟨x₂, hx₂⟩⟩,
+  have : f₁ x₁ = f₂ x₂,
+  { apply (Top.mono_iff_injective _).mp H₃,
+    simp only [←comp_apply, eq₁, eq₂],
+    simp only [comp_apply, hx₁, hx₂],
+    simp only [←comp_apply, pullback.condition] },
+  use (pullback_iso_prod_subtype f₁ f₂).inv ⟨⟨x₁, x₂⟩, this⟩,
+  apply concrete.limit_ext,
+  rintros (_|_|_),
+  { simp only [Top.comp_app, limit.lift_π_apply, category.assoc, pullback_cone.mk_π_app_one,
+      hx₁, pullback_iso_prod_subtype_inv_fst_apply, subtype.coe_mk],
+    simp only [← comp_apply],
+    congr,
+    apply limit.w _ walking_cospan.hom.inl },
+  { simp [hx₁] },
+  { simp [hx₂] },
+end
+
+lemma pullback_fst_range {X Y S : Top} (f : X ⟶ S) (g : Y ⟶ S) :
+  set.range (pullback.fst : pullback f g ⟶ _) = { x : X | ∃ y : Y, f x = g y} :=
+begin
+  ext x,
+  split,
+  { rintro ⟨y, rfl⟩,
+    use (pullback.snd : pullback f g ⟶ _) y,
+    exact concrete_category.congr_hom pullback.condition y },
+  { rintro ⟨y, eq⟩,
+    use (Top.pullback_iso_prod_subtype f g).inv ⟨⟨x, y⟩, eq⟩,
+    simp },
+end
+
+lemma pullback_snd_range {X Y S : Top} (f : X ⟶ S) (g : Y ⟶ S) :
+  set.range (pullback.snd : pullback f g ⟶ _) = { y : Y | ∃ x : X, f x = g y} :=
+begin
+  ext y,
+  split,
+  { rintro ⟨x, rfl⟩,
+    use (pullback.fst : pullback f g ⟶ _) x,
+    exact concrete_category.congr_hom pullback.condition x },
+  { rintro ⟨x, eq⟩,
+    use (Top.pullback_iso_prod_subtype f g).inv ⟨⟨x, y⟩, eq⟩,
+    simp },
+end
+
+/--
+If there is a diagram where the morphisms `W ⟶ Y` and `X ⟶ Z` are embeddings,
+then the induced morphism `W ×ₛ X ⟶ Y ×ₜ Z` is also an embedding.
+
+  W  ⟶  Y
+    ↘      ↘
+      S  ⟶  T
+    ↗      ↗
+  X  ⟶  Z
+-/
+lemma pullback_map_embedding_of_embeddings {W X Y Z S T : Top}
+  (f₁ : W ⟶ S) (f₂ : X ⟶ S) (g₁ : Y ⟶ T) (g₂ : Z ⟶ T) {i₁ : W ⟶ Y} {i₂ : X ⟶ Z}
+  (H₁ : embedding i₁) (H₂ : embedding i₂) (i₃ : S ⟶ T)
+  (eq₁ : f₁ ≫ i₃ = i₁ ≫ g₁) (eq₂ : f₂ ≫ i₃ = i₂ ≫ g₂) :
+  embedding (pullback.map f₁ f₂ g₁ g₂ i₁ i₂ i₃ eq₁ eq₂) :=
+begin
+  refine embedding_of_embedding_compose (continuous_map.continuous_to_fun _)
+    (show continuous (prod.lift pullback.fst pullback.snd : pullback g₁ g₂ ⟶ Y ⨯ Z), from
+      continuous_map.continuous_to_fun _) _,
+  suffices : embedding
+    (prod.lift pullback.fst pullback.snd ≫ limits.prod.map i₁ i₂ : pullback f₁ f₂ ⟶ _),
+  { simpa [←coe_comp] using this },
+  rw coe_comp,
+  refine embedding.comp (embedding_prod_map H₁ H₂)
+    (embedding_pullback_to_prod _ _)
+end
+
+/--
+If there is a diagram where the morphisms `W ⟶ Y` and `X ⟶ Z` are open embeddings, and `S ⟶ T`
+is mono, then the induced morphism `W ×ₛ X ⟶ Y ×ₜ Z` is also an open embedding.
+  W  ⟶  Y
+    ↘      ↘
+      S  ⟶  T
+    ↗       ↗
+  X  ⟶  Z
+-/
+lemma pullback_map_open_embedding_of_open_embeddings {W X Y Z S T : Top}
+  (f₁ : W ⟶ S) (f₂ : X ⟶ S) (g₁ : Y ⟶ T) (g₂ : Z ⟶ T) {i₁ : W ⟶ Y} {i₂ : X ⟶ Z}
+  (H₁ : open_embedding i₁) (H₂ : open_embedding i₂) (i₃ : S ⟶ T) [H₃ : mono i₃]
+  (eq₁ : f₁ ≫ i₃ = i₁ ≫ g₁) (eq₂ : f₂ ≫ i₃ = i₂ ≫ g₂) :
+  open_embedding (pullback.map f₁ f₂ g₁ g₂ i₁ i₂ i₃ eq₁ eq₂) :=
+begin
+  split,
+  { apply pullback_map_embedding_of_embeddings
+      f₁ f₂ g₁ g₂ H₁.to_embedding H₂.to_embedding i₃ eq₁ eq₂ },
+  { rw range_pullback_map,
+    apply is_open.inter; apply continuous.is_open_preimage,
+    continuity,
+    exacts [H₁.open_range, H₂.open_range] }
+end
+
+lemma snd_embedding_of_left_embedding {X Y S : Top}
+  {f : X ⟶ S} (H : embedding f) (g : Y ⟶ S) :
+  embedding ⇑(pullback.snd : pullback f g ⟶ Y) :=
+begin
+  convert (homeo_of_iso (as_iso (pullback.snd : pullback (𝟙 S) g ⟶ _))).embedding.comp
+    (pullback_map_embedding_of_embeddings f g (𝟙 _) g H
+      (homeo_of_iso (iso.refl _)).embedding (𝟙 _) rfl (by simp)),
+  erw ←coe_comp,
+  simp
+end
+
+lemma fst_embedding_of_right_embedding {X Y S : Top}
+  (f : X ⟶ S) {g : Y ⟶ S} (H : embedding g) :
+  embedding ⇑(pullback.fst : pullback f g ⟶ X) :=
+begin
+  convert (homeo_of_iso (as_iso (pullback.fst : pullback f (𝟙 S) ⟶ _))).embedding.comp
+    (pullback_map_embedding_of_embeddings f g f (𝟙 _)
+      (homeo_of_iso (iso.refl _)).embedding H (𝟙 _) rfl (by simp)),
+  erw ←coe_comp,
+  simp
+end
+
+lemma embedding_of_pullback_embeddings {X Y S : Top}
+  {f : X ⟶ S} {g : Y ⟶ S} (H₁ : embedding f) (H₂ : embedding g) :
+  embedding (limit.π (cospan f g) walking_cospan.one) :=
+begin
+  convert H₂.comp (snd_embedding_of_left_embedding H₁ g),
+  erw ←coe_comp,
+  congr,
+  exact (limit.w _ walking_cospan.hom.inr).symm
+end
+
+lemma snd_open_embedding_of_left_open_embedding {X Y S : Top}
+  {f : X ⟶ S} (H : open_embedding f) (g : Y ⟶ S) :
+  open_embedding ⇑(pullback.snd : pullback f g ⟶ Y) :=
+begin
+  convert (homeo_of_iso (as_iso (pullback.snd : pullback (𝟙 S) g ⟶ _))).open_embedding.comp
+    (pullback_map_open_embedding_of_open_embeddings f g (𝟙 _) g H
+      (homeo_of_iso (iso.refl _)).open_embedding (𝟙 _) rfl (by simp)),
+  erw ←coe_comp,
+  simp
+end
+
+lemma fst_open_embedding_of_right_open_embedding {X Y S : Top}
+  (f : X ⟶ S) {g : Y ⟶ S} (H : open_embedding g) :
+  open_embedding ⇑(pullback.fst : pullback f g ⟶ X) :=
+begin
+  convert (homeo_of_iso (as_iso (pullback.fst : pullback f (𝟙 S) ⟶ _))).open_embedding.comp
+    (pullback_map_open_embedding_of_open_embeddings f g f (𝟙 _)
+      (homeo_of_iso (iso.refl _)).open_embedding H (𝟙 _) rfl (by simp)),
+  erw ←coe_comp,
+  simp
+end
+
+/-- If `X ⟶ S`, `Y ⟶ S` are open embeddings, then so is `X ×ₛ Y ⟶ S`. -/
+lemma open_embedding_of_pullback_open_embeddings {X Y S : Top}
+  {f : X ⟶ S} {g : Y ⟶ S} (H₁ : open_embedding f) (H₂ : open_embedding g) :
+  open_embedding (limit.π (cospan f g) walking_cospan.one) :=
+begin
+  convert H₂.comp (snd_open_embedding_of_left_open_embedding H₁ g),
+  erw ←coe_comp,
+  congr,
+  exact (limit.w _ walking_cospan.hom.inr).symm
+end
+
+lemma fst_iso_of_right_embedding_range_subset {X Y S : Top} (f : X ⟶ S) {g : Y ⟶ S}
+  (hg : embedding g) (H : set.range f ⊆ set.range g) : is_iso (pullback.fst : pullback f g ⟶ X) :=
+begin
+  let : (pullback f g : Top) ≃ₜ X :=
+    (homeomorph.of_embedding _ (fst_embedding_of_right_embedding f hg)).trans
+    { to_fun := coe,
+      inv_fun := (λ x, ⟨x,
+        by { rw pullback_fst_range, exact ⟨_, (H (set.mem_range_self x)).some_spec.symm⟩ }⟩),
+      left_inv := λ ⟨_,_⟩, rfl,
+      right_inv := λ x, rfl },
+  convert is_iso.of_iso (iso_of_homeo this),
+  ext,
+  refl
+end
+
+lemma snd_iso_of_left_embedding_range_subset {X Y S : Top} {f : X ⟶ S} (hf : embedding f)
+  (g : Y ⟶ S) (H : set.range g ⊆ set.range f) : is_iso (pullback.snd : pullback f g ⟶ Y) :=
+begin
+  let : (pullback f g : Top) ≃ₜ Y :=
+    (homeomorph.of_embedding _ (snd_embedding_of_left_embedding hf g)).trans
+    { to_fun := coe,
+      inv_fun := (λ x, ⟨x,
+        by { rw pullback_snd_range, exact ⟨_, (H (set.mem_range_self x)).some_spec⟩ }⟩),
+      left_inv := λ ⟨_,_⟩, rfl,
+      right_inv := λ x, rfl },
+  convert is_iso.of_iso (iso_of_homeo this),
+  ext,
+  refl
+end
+
+lemma pullback_snd_image_fst_preimage (f : X ⟶ Z) (g : Y ⟶ Z) (U : set X) :
+  (pullback.snd : pullback f g ⟶ _) '' ((pullback.fst : pullback f g ⟶ _) ⁻¹' U) =
+    g ⁻¹' (f '' U) :=
+begin
+  ext x,
+  split,
+  { rintros ⟨y, hy, rfl⟩,
+    exact ⟨(pullback.fst : pullback f g ⟶ _) y, hy,
+    concrete_category.congr_hom pullback.condition y⟩ },
+  { rintros ⟨y, hy, eq⟩,
+    exact ⟨(Top.pullback_iso_prod_subtype f g).inv ⟨⟨_,_⟩, eq⟩, by simpa, by simp⟩ },
+end
+
+lemma pullback_fst_image_snd_preimage (f : X ⟶ Z) (g : Y ⟶ Z) (U : set Y) :
+  (pullback.fst : pullback f g ⟶ _) '' ((pullback.snd : pullback f g ⟶ _) ⁻¹' U) =
+    f ⁻¹' (g '' U) :=
+begin
+  ext x,
+  split,
+  { rintros ⟨y, hy, rfl⟩,
+    exact ⟨(pullback.snd : pullback f g ⟶ _) y, hy,
+    (concrete_category.congr_hom pullback.condition y).symm⟩ },
+  { rintros ⟨y, hy, eq⟩,
+    exact ⟨(Top.pullback_iso_prod_subtype f g).inv ⟨⟨_,_⟩,eq.symm⟩, by simpa, by simp⟩ },
+end
+
+end pullback
+
+
+
+lemma coinduced_of_is_colimit {F : J ⥤ Top.{max v u}} (c : cocone F) (hc : is_colimit c) :
+  c.X.topological_space = ⨆ j, (F.obj j).topological_space.coinduced (c.ι.app j) :=
+begin
+  let homeo := homeo_of_iso (hc.cocone_point_unique_up_to_iso (colimit_cocone_is_colimit F)),
+  ext,
+  refine homeo.symm.is_open_preimage.symm.trans (iff.trans _ is_open_supr_iff.symm),
+  exact is_open_supr_iff
+end
+
+lemma colimit_topology (F : J ⥤ Top.{max v u}) :
+  (colimit F).topological_space = ⨆ j, (F.obj j).topological_space.coinduced (colimit.ι F j) :=
+coinduced_of_is_colimit _ (colimit.is_colimit F)
+
+lemma colimit_is_open_iff (F : J ⥤ Top.{max v u}) (U : set ((colimit F : _) : Type (max v u))) :
+  is_open U ↔ ∀ j, is_open (colimit.ι F j ⁻¹' U) :=
+begin
+  conv_lhs { rw colimit_topology F },
+  exact is_open_supr_iff
+end
+
+lemma coequalizer_is_open_iff (F : walking_parallel_pair ⥤ Top.{u})
+  (U : set ((colimit F : _) : Type u)) :
+  is_open U ↔ is_open (colimit.ι F walking_parallel_pair.one ⁻¹' U) :=
+begin
+  rw colimit_is_open_iff.{u},
+  split,
+  { intro H, exact H _ },
+  { intros H j,
+    cases j,
+    { rw ←colimit.w F walking_parallel_pair_hom.left,
+      exact (F.map walking_parallel_pair_hom.left).continuous_to_fun.is_open_preimage _ H },
+    { exact H } }
+end
+
+end Top
diff --git a/src/topology/category/Top/open_nhds.lean b/src/topology/category/Top/open_nhds.lean
index 5fad2e3daddcc..e18f068a37e7a 100644
--- a/src/topology/category/Top/open_nhds.lean
+++ b/src/topology/category/Top/open_nhds.lean
@@ -8,6 +8,9 @@ import topology.category.Top.opens
 /-!
 # The category of open neighborhoods of a point
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given an object `X` of the category `Top` of topological spaces and a point `x : X`, this file
 builds the type `open_nhds x` of open neighborhoods of `x` in `X` and endows it with the partial
 order given by inclusion and the corresponding category structure (as a full subcategory of the
@@ -35,7 +38,7 @@ variables {X Y : Top.{u}} (f : X ⟶ Y)
 namespace topological_space
 
 /-- The type of open neighbourhoods of a point `x` in a (bundled) topological space. -/
-def open_nhds (x : X) := { U : opens X // x ∈ U }
+def open_nhds (x : X) := full_subcategory (λ (U : opens X), x ∈ U)
 
 namespace open_nhds
 
@@ -43,7 +46,7 @@ instance (x : X) : partial_order (open_nhds x) :=
 { le := λ U V, U.1 ≤ V.1,
   le_refl := λ _, le_rfl,
   le_trans := λ _ _ _, le_trans,
-  le_antisymm := λ _ _ i j, subtype.eq $ le_antisymm i j }
+  le_antisymm := λ _ _ i j, full_subcategory.ext _ _ $ le_antisymm i j }
 
 instance (x : X) : lattice (open_nhds x) :=
 { inf := λ U V, ⟨U.1 ⊓ V.1, ⟨U.2, V.2⟩⟩,
@@ -91,8 +94,9 @@ full_subcategory_inclusion _
 lemma open_embedding {x : X} (U : open_nhds x) : open_embedding (U.1.inclusion) :=
 U.1.open_embedding
 
+/-- The preimage functor from neighborhoods of `f x` to neighborhoods of `x`. -/
 def map (x : X) : open_nhds (f x) ⥤ open_nhds x :=
-{ obj := λ U, ⟨(opens.map f).obj U.1, by tidy⟩,
+{ obj := λ U, ⟨(opens.map f).obj U.1, U.2⟩,
   map := λ U V i, (opens.map f).map i }
 
 @[simp] lemma map_obj (x : X) (U) (q) : (map f x).obj ⟨U, q⟩ = ⟨(opens.map f).obj U, by tidy⟩ :=
diff --git a/src/topology/category/Top/opens.lean b/src/topology/category/Top/opens.lean
index 2e2bd928bf36b..c0ea142fc31a2 100644
--- a/src/topology/category/Top/opens.lean
+++ b/src/topology/category/Top/opens.lean
@@ -11,6 +11,9 @@ import topology.sets.opens
 /-!
 # The category of open sets in a topological space.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `to_Top : opens X ⥤ Top` and
 `map (f : X ⟶ Y) : opens Y ⥤ opens X`, given by taking preimages of open sets.
 
@@ -98,7 +101,7 @@ The functor from open sets in `X` to `Top`,
 realising each open set as a topological space itself.
 -/
 def to_Top (X : Top.{u}) : opens X ⥤ Top :=
-{ obj := λ U, ⟨U.val, infer_instance⟩,
+{ obj := λ U, ⟨U, infer_instance⟩,
   map := λ U V i, ⟨λ x, ⟨x.1, i.le x.2⟩,
     (embedding.continuous_iff embedding_subtype_coe).2 continuous_induced_dom⟩ }
 
@@ -110,7 +113,7 @@ rfl
 /--
 The inclusion map from an open subset to the whole space, as a morphism in `Top`.
 -/
-@[simps]
+@[simps { fully_applied := ff }]
 def inclusion {X : Top.{u}} (U : opens X) : (to_Top X).obj U ⟶ X :=
 { to_fun := _,
   continuous_to_fun := continuous_subtype_coe }
@@ -128,9 +131,13 @@ def inclusion_top_iso (X : Top.{u}) : (to_Top X).obj ⊤ ≅ X :=
 /-- `opens.map f` gives the functor from open sets in Y to open set in X,
     given by taking preimages under f. -/
 def map (f : X ⟶ Y) : opens Y ⥤ opens X :=
-{ obj := λ U, ⟨ f ⁻¹' U.val, U.property.preimage f.continuous ⟩,
+{ obj := λ U, ⟨ f ⁻¹' U, U.is_open.preimage f.continuous ⟩,
   map := λ U V i, ⟨ ⟨ λ x h, i.le h ⟩ ⟩ }.
 
+lemma map_coe (f : X ⟶ Y) (U : opens Y) :
+  ↑((map f).obj U) = f ⁻¹' U :=
+rfl
+
 @[simp] lemma map_obj (f : X ⟶ Y) (U) (p) :
   (map f).obj ⟨U, p⟩ = ⟨f ⁻¹' U, p.preimage f.continuous⟩ := rfl
 
@@ -174,7 +181,7 @@ rfl
 lemma map_supr (f : X ⟶ Y) {ι : Type*} (U : ι → opens Y) :
   (map f).obj (supr U) = supr ((map f).obj ∘ U) :=
 begin
-  apply subtype.eq, rw [supr_def, supr_def, map_obj],
+  ext1, rw [supr_def, supr_def, map_obj],
   dsimp, rw set.preimage_Union, refl,
 end
 
@@ -231,7 +238,10 @@ rfl
      eq_to_hom (congr_fun (congr_arg functor.obj (congr_arg map h.symm)) U) :=
 rfl
 
-/-- A homeomorphism of spaces gives an equivalence of categories of open sets. -/
+/-- A homeomorphism of spaces gives an equivalence of categories of open sets.
+
+TODO: define `order_iso.equivalence`, use it.
+-/
 @[simps] def map_map_iso {X Y : Top.{u}} (H : X ≅ Y) : opens Y ≌ opens X :=
 { functor := map H.hom,
   inverse := map H.inv,
@@ -294,4 +304,29 @@ begin
   iterate 2 {apply inclusion_top_functor.obj_eq},
 end
 
+lemma functor_obj_map_obj {X Y : Top} {f : X ⟶ Y} (hf : is_open_map f) (U : opens Y) :
+  hf.functor.obj ((opens.map f).obj U) = hf.functor.obj ⊤ ⊓ U :=
+begin
+  ext, split,
+  { rintros ⟨x, hx, rfl⟩, exact ⟨⟨x, trivial, rfl⟩, hx⟩ },
+  { rintros ⟨⟨x, -, rfl⟩, hx⟩, exact ⟨x, hx, rfl⟩ }
+end
+
+@[simp] lemma functor_map_eq_inf {X : Top} (U V : opens X) :
+  U.open_embedding.is_open_map.functor.obj ((opens.map U.inclusion).obj V) = V ⊓ U :=
+by { ext1, refine set.image_preimage_eq_inter_range.trans _, simpa }
+
+lemma map_functor_eq' {X U : Top} (f : U ⟶ X) (hf : _root_.open_embedding f) (V) :
+  ((opens.map f).obj $ hf.is_open_map.functor.obj V) = V :=
+opens.ext $ set.preimage_image_eq _ hf.inj
+
+@[simp] lemma map_functor_eq {X : Top} {U : opens X} (V : opens U) :
+  ((opens.map U.inclusion).obj $ U.open_embedding.is_open_map.functor.obj V) = V :=
+topological_space.opens.map_functor_eq' _ U.open_embedding V
+
+@[simp] lemma adjunction_counit_map_functor {X : Top} {U : opens X} (V : opens U) :
+  U.open_embedding.is_open_map.adjunction.counit.app (U.open_embedding.is_open_map.functor.obj V)
+    = eq_to_hom (by { conv_rhs { rw ← V.map_functor_eq }, refl }) :=
+by ext
+
 end topological_space.opens
diff --git a/src/topology/category/TopCommRing.lean b/src/topology/category/TopCommRing.lean
index edddbbd6b5fd4..a1545ad6343de 100644
--- a/src/topology/category/TopCommRing.lean
+++ b/src/topology/category/TopCommRing.lean
@@ -5,11 +5,14 @@ Authors: Scott Morrison
 -/
 import algebra.category.Ring.basic
 import topology.category.Top.basic
-import topology.algebra.ring
+import topology.algebra.ring.basic
 
 /-!
 # Category of topological commutative rings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We introduce the category `TopCommRing` of topological commutative rings together with the relevant
 forgetful functors to topological spaces and commutative rings.
 -/
diff --git a/src/topology/category/UniformSpace.lean b/src/topology/category/UniformSpace.lean
index 4b5f920cf466f..226cd56608165 100644
--- a/src/topology/category/UniformSpace.lean
+++ b/src/topology/category/UniformSpace.lean
@@ -6,13 +6,15 @@ Authors: Reid Barton, Patrick Massot, Scott Morrison
 import category_theory.adjunction.reflective
 import category_theory.concrete_category.unbundled_hom
 import category_theory.monad.limits
-import category_theory.limits.has_limits
 import topology.category.Top.basic
 import topology.uniform_space.completion
 
 /-!
 # The category of uniform spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct the category of uniform spaces, show that the complete separated uniform spaces
 form a reflective subcategory, and hence possess all limits that uniform spaces do.
 
diff --git a/src/topology/compact_open.lean b/src/topology/compact_open.lean
index f050c6a023060..78fd62cddd93d 100644
--- a/src/topology/compact_open.lean
+++ b/src/topology/compact_open.lean
@@ -12,6 +12,9 @@ import topology.maps
 /-!
 # The compact-open topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define the compact-open topology on the set of continuous maps between two
 topological spaces.
 
@@ -34,7 +37,7 @@ compact-open, curry, function space
 -/
 
 open set
-open_locale topological_space
+open_locale topology
 
 namespace continuous_map
 
@@ -59,6 +62,9 @@ set.ext (λ f, subset_inter_iff)
   compact_open.gen (s ∪ t) u = compact_open.gen s u ∩ compact_open.gen t u :=
 set.ext (λ f, (iff_of_eq (congr_arg (⊆ u) (image_union f s t))).trans union_subset_iff)
 
+lemma gen_empty_right {s : set α} (h : s.nonempty) : compact_open.gen s (∅ : set β) = ∅ :=
+eq_empty_of_forall_not_mem $ λ f, (h.image _).not_subset_empty
+
 -- The compact-open topology on the space of continuous maps α → β.
 instance compact_open : topological_space C(α, β) :=
 topological_space.generate_from
@@ -85,6 +91,43 @@ lemma continuous_comp : continuous (continuous_map.comp g : C(α, β) → C(α,
 continuous_generated_from $ assume m ⟨s, hs, u, hu, hm⟩,
   by rw [hm, preimage_gen g hs hu]; exact continuous_map.is_open_gen hs (hu.preimage g.2)
 
+variable (f : C(α, β))
+
+private lemma image_gen {s : set α} (hs : is_compact s) {u : set γ} (hu : is_open u) :
+  (λ g : C(β, γ), g.comp f) ⁻¹' compact_open.gen s u = compact_open.gen (f '' s) u :=
+begin
+  ext ⟨g, _⟩,
+  change g ∘ f '' s ⊆ u ↔ g '' (f '' s) ⊆ u,
+  rw set.image_comp,
+end
+
+/-- C(-, γ) is a functor. -/
+lemma continuous_comp_left : continuous (λ g, g.comp f : C(β, γ) → C(α, γ)) :=
+continuous_generated_from $ assume m ⟨s, hs, u, hu, hm⟩,
+  by { rw [hm, image_gen f hs hu], exact continuous_map.is_open_gen (hs.image f.2) hu }
+
+/-- Composition is a continuous map from `C(α, β) × C(β, γ)` to `C(α, γ)`, provided that `β` is
+  locally compact. This is Prop. 9 of Chap. X, §3, №. 4 of Bourbaki's *Topologie Générale*. -/
+lemma continuous_comp' [locally_compact_space β] :
+  continuous (λ x : C(α, β) × C(β, γ), x.2.comp x.1) :=
+continuous_generated_from begin
+  rintros M ⟨K, hK, U, hU, rfl⟩,
+  conv { congr, rw [compact_open.gen, preimage_set_of_eq],
+    congr, funext, rw [coe_comp, image_comp, image_subset_iff] },
+  rw is_open_iff_forall_mem_open,
+  rintros ⟨φ₀, ψ₀⟩ H,
+  obtain ⟨L, hL, hKL, hLU⟩ := exists_compact_between (hK.image φ₀.2) (hU.preimage ψ₀.2) H,
+  use {φ : C(α, β) | φ '' K ⊆ interior L} ×ˢ {ψ : C(β, γ) | ψ '' L ⊆ U},
+  use λ ⟨φ, ψ⟩ ⟨hφ, hψ⟩, subset_trans hφ (interior_subset.trans $ image_subset_iff.mp hψ),
+  use (continuous_map.is_open_gen hK is_open_interior).prod (continuous_map.is_open_gen hL hU),
+  exact mem_prod.mpr ⟨hKL, image_subset_iff.mpr hLU⟩,
+end
+
+lemma continuous.comp' {X : Type*} [topological_space X] [locally_compact_space β]
+  {f : X → C(α, β)} {g : X → C(β, γ)} (hf : continuous f) (hg : continuous g) :
+  continuous (λ x, (g x).comp (f x)) :=
+continuous_comp'.comp (hf.prod_mk hg : continuous $ λ x, (f x, g x))
+
 end functorial
 
 section ev
@@ -129,10 +172,8 @@ instance [t2_space β] : t2_space C(α, β) :=
       is_compact_singleton hu, continuous_map.is_open_gen is_compact_singleton hv, _, _, _⟩,
     { rwa [compact_open.gen, mem_set_of_eq, image_singleton, singleton_subset_iff] },
     { rwa [compact_open.gen, mem_set_of_eq, image_singleton, singleton_subset_iff] },
-    { rw [←continuous_map.gen_inter, huv],
-      refine subset_empty_iff.mp (λ f, _),
-      rw [compact_open.gen, mem_set_of_eq, image_singleton, singleton_subset_iff],
-      exact id },
+    { rw [disjoint_iff_inter_eq_empty, ←gen_inter, huv.inter_eq,
+        gen_empty_right (singleton_nonempty _)] }
   end ⟩
 
 end ev
@@ -144,7 +185,7 @@ lemma compact_open_le_induced (s : set α) :
   ≤ topological_space.induced (continuous_map.restrict s) continuous_map.compact_open :=
 begin
   simp only [induced_generate_from_eq, continuous_map.compact_open],
-  apply generate_from_mono,
+  apply topological_space.generate_from_anti,
   rintros b ⟨a, ⟨c, hc, u, hu, rfl⟩, rfl⟩,
   refine ⟨coe '' c, hc.image continuous_subtype_coe, u, hu, _⟩,
   ext f,
@@ -164,7 +205,7 @@ begin
   { refine le_infi₂ _,
     exact λ s hs, compact_open_le_induced s },
   simp only [← generate_from_Union, induced_generate_from_eq, continuous_map.compact_open],
-  apply generate_from_mono,
+  apply topological_space.generate_from_anti,
   rintros _ ⟨s, hs, u, hu, rfl⟩,
   rw mem_Union₂,
   refine ⟨s, hs, _, ⟨univ, is_compact_iff_is_compact_univ.mp hs, u, hu, rfl⟩, _⟩,
@@ -304,7 +345,7 @@ continuous_eval'.comp $ f.continuous.prod_map continuous_id
 /-- The uncurried form of a continuous map `α → C(β, γ)` as a continuous map `α × β → γ` (if `β` is
     locally compact). If `α` is also locally compact, then this is a homeomorphism between the two
     function spaces, see `homeomorph.curry`. -/
-def uncurry [locally_compact_space β] (f : C(α, C(β, γ))) : C(α × β, γ) :=
+@[simps] def uncurry [locally_compact_space β] (f : C(α, C(β, γ))) : C(α × β, γ) :=
 ⟨_, continuous_uncurry_of_continuous f⟩
 
 /-- The uncurrying process is a continuous map between function spaces. -/
diff --git a/src/topology/connected.lean b/src/topology/connected.lean
index ef642ef23ac0b..7aab256b6b436 100644
--- a/src/topology/connected.lean
+++ b/src/topology/connected.lean
@@ -3,15 +3,17 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
 -/
-import data.int.succ_pred
-import data.nat.succ_pred
-import order.partial_sups
+import data.set.bool_indicator
 import order.succ_pred.relation
 import topology.subset_properties
+import tactic.congrm
 
 /-!
 # Connected subsets of topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define connected subsets of a topological spaces and various other properties and
 classes related to connectivity.
 
@@ -41,7 +43,7 @@ https://ncatlab.org/nlab/show/too+simple+to+be+simple#relationship_to_biased_def
 -/
 
 open set function topological_space relation
-open_locale classical topological_space
+open_locale classical topology
 
 universes u v
 variables {α : Type u} {β : Type v} {ι : Type*} {π : ι → Type*} [topological_space α]
@@ -92,7 +94,9 @@ theorem is_preconnected_of_forall {s : set α} (x : α)
 begin
   rintros u v hu hv hs ⟨z, zs, zu⟩ ⟨y, ys, yv⟩,
   have xs : x ∈ s, by { rcases H y ys with ⟨t, ts, xt, yt, ht⟩, exact ts xt },
-  wlog xu : x ∈ u := hs xs using [u v y z, v u z y],
+  wlog xu : x ∈ u,
+  { rw inter_comm u v, rw union_comm at hs,
+    exact this x H v u hv hu hs y ys yv z zs zu xs ((hs xs).resolve_right xu), },
   rcases H y ys with ⟨t, ts, xt, yt, ht⟩,
   have := ht u v hu hv(subset.trans ts hs) ⟨x, xt, xu⟩ ⟨y, yt, yv⟩,
   exact this.imp (λ z hz, ⟨ts hz.1, hz.2⟩)
@@ -329,26 +333,23 @@ theorem is_preconnected_closed_iff {s : set α} :
     (s ∩ t).nonempty → (s ∩ t').nonempty → (s ∩ (t ∩ t')).nonempty :=
 ⟨begin
   rintros h t t' ht ht' htt' ⟨x, xs, xt⟩ ⟨y, ys, yt'⟩,
-  by_contradiction h',
-  rw [← ne_empty_iff_nonempty, ne.def, not_not, ← subset_compl_iff_disjoint, compl_inter] at h',
-  have xt' : x ∉ t', from (h' xs).elim (absurd xt) id,
-  have yt : y ∉ t, from (h' ys).elim id (absurd yt'),
-  have := ne_empty_iff_nonempty.2 (h tᶜ t'ᶜ (is_open_compl_iff.2 ht)
-    (is_open_compl_iff.2 ht') h' ⟨y, ys, yt⟩ ⟨x, xs, xt'⟩),
-  rw [ne.def, ← compl_union, ← subset_compl_iff_disjoint, compl_compl] at this,
-  contradiction
+  rw [←not_disjoint_iff_nonempty_inter, ←subset_compl_iff_disjoint_right, compl_inter],
+  intros h',
+  have xt' : x ∉ t', from (h' xs).resolve_left (absurd xt),
+  have yt : y ∉ t, from (h' ys).resolve_right (absurd yt'),
+  have := h _ _ ht.is_open_compl ht'.is_open_compl h' ⟨y, ys, yt⟩ ⟨x, xs, xt'⟩,
+  rw ←compl_union at this,
+  exact this.ne_empty htt'.disjoint_compl_right.inter_eq,
 end,
 begin
   rintros h u v hu hv huv ⟨x, xs, xu⟩ ⟨y, ys, yv⟩,
-  by_contradiction h',
-  rw [← ne_empty_iff_nonempty, ne.def, not_not,
-    ← subset_compl_iff_disjoint, compl_inter] at h',
+  rw [←not_disjoint_iff_nonempty_inter, ←subset_compl_iff_disjoint_right, compl_inter],
+  intros h',
   have xv : x ∉ v, from (h' xs).elim (absurd xu) id,
   have yu : y ∉ u, from (h' ys).elim id (absurd yv),
-  have := ne_empty_iff_nonempty.2 (h uᶜ vᶜ (is_closed_compl_iff.2 hu)
-    (is_closed_compl_iff.2 hv) h' ⟨y, ys, yu⟩ ⟨x, xs, xv⟩),
-  rw [ne.def, ← compl_union, ← subset_compl_iff_disjoint, compl_compl] at this,
-  contradiction
+  have := h _ _ hu.is_closed_compl hv.is_closed_compl h' ⟨y, ys, yu⟩ ⟨x, xs, xv⟩,
+  rw ←compl_union at this,
+  exact this.ne_empty huv.disjoint_compl_right.inter_eq,
 end⟩
 
 lemma inducing.is_preconnected_image [topological_space β] {s : set α} {f : α → β}
@@ -443,6 +444,22 @@ lemma is_preconnected.subset_right_of_subset_union (hu : is_open u) (hv : is_ope
   s ⊆ v :=
 hs.subset_left_of_subset_union hv hu huv.symm (union_comm u v ▸ hsuv) hsv
 
+/-- If a preconnected set `s` intersects an open set `u`, and limit points of `u` inside `s` are
+contained in `u`, then the whole set `s` is contained in `u`. -/
+lemma is_preconnected.subset_of_closure_inter_subset (hs : is_preconnected s)
+  (hu : is_open u) (h'u : (s ∩ u).nonempty) (h : closure u ∩ s ⊆ u) : s ⊆ u :=
+begin
+  have A : s ⊆ u ∪ (closure u)ᶜ,
+  { assume x hx,
+    by_cases xu : x ∈ u,
+    { exact or.inl xu },
+    { right,
+      assume h'x,
+      exact xu (h (mem_inter h'x hx)) } },
+  apply hs.subset_left_of_subset_union hu is_closed_closure.is_open_compl _ A h'u,
+  exact disjoint_compl_right.mono_right (compl_subset_compl.2 subset_closure),
+end
+
 theorem is_preconnected.prod [topological_space β] {s : set α} {t : set β}
   (hs : is_preconnected s) (ht : is_preconnected t) :
   is_preconnected (s ×ˢ t) :=
@@ -533,19 +550,19 @@ lemma sum.is_connected_iff [topological_space β] {s : set (α ⊕ β)} :
     (∃ t, is_connected t ∧ s = sum.inl '' t) ∨ ∃ t, is_connected t ∧ s = sum.inr '' t :=
 begin
   refine ⟨λ hs, _, _⟩,
-  { let u : set (α ⊕ β):= range sum.inl,
+  { let u : set (α ⊕ β) := range sum.inl,
     let v : set (α ⊕ β) := range sum.inr,
     have hu : is_open u, exact is_open_range_inl,
     obtain ⟨x | x, hx⟩ := hs.nonempty,
-    { have h := is_preconnected.subset_left_of_subset_union
+    { have h : s ⊆ range sum.inl := is_preconnected.subset_left_of_subset_union
         is_open_range_inl is_open_range_inr is_compl_range_inl_range_inr.disjoint
-        (show s ⊆ range sum.inl ∪ range sum.inr, by simp) ⟨sum.inl x, hx, x, rfl⟩ hs.2,
+        (by simp) ⟨sum.inl x, hx, x, rfl⟩ hs.2,
       refine or.inl ⟨sum.inl ⁻¹' s, _, _⟩,
       { exact hs.preimage_of_open_map sum.inl_injective open_embedding_inl.is_open_map h },
       { exact (set.image_preimage_eq_of_subset h).symm } },
-    { have h := is_preconnected.subset_right_of_subset_union
+    { have h : s ⊆ range sum.inr := is_preconnected.subset_right_of_subset_union
         is_open_range_inl is_open_range_inr is_compl_range_inl_range_inr.disjoint
-        (show s ⊆ range sum.inl ∪ range sum.inr, by simp) ⟨sum.inr x, hx, x, rfl⟩ hs.2,
+        (by simp) ⟨sum.inr x, hx, x, rfl⟩ hs.2,
       refine or.inr ⟨sum.inr ⁻¹' s, _, _⟩,
       { exact hs.preimage_of_open_map sum.inr_injective open_embedding_inr.is_open_map h },
       { exact (set.image_preimage_eq_of_subset h).symm } } },
@@ -574,26 +591,85 @@ that contains this point. -/
 def connected_component (x : α) : set α :=
 ⋃₀ { s : set α | is_preconnected s ∧ x ∈ s }
 
-/-- The connected component of a point inside a set. -/
-def connected_component_in (F : set α) (x : F) : set α := coe '' (connected_component x)
+/-- Given a set `F` in a topological space `α` and a point `x : α`, the connected
+component of `x` in `F` is the connected component of `x` in the subtype `F` seen as
+a set in `α`. This definition does not make sense if `x` is not in `F` so we return the
+empty set in this case. -/
+def connected_component_in (F : set α) (x : α) : set α :=
+if h : x ∈ F then coe '' (connected_component (⟨x, h⟩ : F)) else ∅
+
+lemma connected_component_in_eq_image {F : set α} {x : α} (h : x ∈ F) :
+  connected_component_in F x = coe '' (connected_component (⟨x, h⟩ : F)) :=
+dif_pos h
+
+lemma connected_component_in_eq_empty {F : set α} {x : α} (h : x ∉ F) :
+  connected_component_in F x = ∅ :=
+dif_neg h
 
 theorem mem_connected_component {x : α} : x ∈ connected_component x :=
 mem_sUnion_of_mem (mem_singleton x) ⟨is_connected_singleton.is_preconnected, mem_singleton x⟩
 
+theorem mem_connected_component_in {x : α} {F : set α} (hx : x ∈ F) :
+  x ∈ connected_component_in F x :=
+by simp [connected_component_in_eq_image hx, mem_connected_component, hx]
+
+theorem connected_component_nonempty {x : α} :
+  (connected_component x).nonempty :=
+⟨x, mem_connected_component⟩
+
+theorem connected_component_in_nonempty_iff {x : α} {F : set α} :
+  (connected_component_in F x).nonempty ↔ x ∈ F :=
+by { rw [connected_component_in], split_ifs; simp [connected_component_nonempty, h] }
+
+theorem connected_component_in_subset (F : set α) (x : α) :
+  connected_component_in F x ⊆ F :=
+by { rw [connected_component_in], split_ifs; simp }
+
 theorem is_preconnected_connected_component {x : α} : is_preconnected (connected_component x) :=
 is_preconnected_sUnion x _ (λ _, and.right) (λ _, and.left)
 
+lemma is_preconnected_connected_component_in {x : α} {F : set α} :
+  is_preconnected (connected_component_in F x) :=
+begin
+  rw [connected_component_in], split_ifs,
+  { exact embedding_subtype_coe.to_inducing.is_preconnected_image.mpr
+      is_preconnected_connected_component },
+  { exact is_preconnected_empty },
+end
+
 theorem is_connected_connected_component {x : α} : is_connected (connected_component x) :=
 ⟨⟨x, mem_connected_component⟩, is_preconnected_connected_component⟩
 
+lemma is_connected_connected_component_in_iff {x : α} {F : set α} :
+  is_connected (connected_component_in F x) ↔ x ∈ F :=
+by simp_rw [← connected_component_in_nonempty_iff, is_connected,
+  is_preconnected_connected_component_in, and_true]
+
 theorem is_preconnected.subset_connected_component {x : α} {s : set α}
   (H1 : is_preconnected s) (H2 : x ∈ s) : s ⊆ connected_component x :=
 λ z hz, mem_sUnion_of_mem hz ⟨H1, H2⟩
 
+lemma is_preconnected.subset_connected_component_in {x : α} {F : set α} (hs : is_preconnected s)
+  (hxs : x ∈ s) (hsF : s ⊆ F) : s ⊆ connected_component_in F x :=
+begin
+  have : is_preconnected ((coe : F → α) ⁻¹' s),
+  { refine embedding_subtype_coe.to_inducing.is_preconnected_image.mp _,
+    rwa [subtype.image_preimage_coe, inter_eq_left_iff_subset.mpr hsF] },
+  have h2xs : (⟨x, hsF hxs⟩ : F) ∈ coe ⁻¹' s := by { rw [mem_preimage], exact hxs },
+  have := this.subset_connected_component h2xs,
+  rw [connected_component_in_eq_image (hsF hxs)],
+  refine subset.trans _ (image_subset _ this),
+  rw [subtype.image_preimage_coe, inter_eq_left_iff_subset.mpr hsF]
+end
+
 theorem is_connected.subset_connected_component {x : α} {s : set α}
   (H1 : is_connected s) (H2 : x ∈ s) : s ⊆ connected_component x :=
 H1.2.subset_connected_component H2
 
+lemma is_preconnected.connected_component_in {x : α} {F : set α} (h : is_preconnected F)
+  (hx : x ∈ F) : connected_component_in F x = F :=
+(connected_component_in_subset F x).antisymm (h.subset_connected_component_in hx subset_rfl)
+
 theorem connected_component_eq {x y : α} (h : y ∈ connected_component x) :
   connected_component x = connected_component y :=
 eq_of_subset_of_subset
@@ -602,6 +678,27 @@ eq_of_subset_of_subset
     (set.mem_of_mem_of_subset mem_connected_component
       (is_connected_connected_component.subset_connected_component h)))
 
+theorem connected_component_eq_iff_mem {x y : α} :
+  connected_component x = connected_component y ↔ x ∈ connected_component y :=
+⟨λ h, h ▸ mem_connected_component, λ h, (connected_component_eq h).symm⟩
+
+lemma connected_component_in_eq {x y : α} {F : set α} (h : y ∈ connected_component_in F x) :
+  connected_component_in F x = connected_component_in F y :=
+begin
+  have hx : x ∈ F := connected_component_in_nonempty_iff.mp ⟨y, h⟩,
+  simp_rw [connected_component_in_eq_image hx] at h ⊢,
+  obtain ⟨⟨y, hy⟩, h2y, rfl⟩ := h,
+  simp_rw [subtype.coe_mk, connected_component_in_eq_image hy, connected_component_eq h2y]
+end
+
+theorem connected_component_in_univ (x : α) :
+  connected_component_in univ x = connected_component x :=
+subset_antisymm
+  (is_preconnected_connected_component_in.subset_connected_component $
+    mem_connected_component_in trivial)
+  (is_preconnected_connected_component.subset_connected_component_in mem_connected_component $
+    subset_univ _)
+
 lemma connected_component_disjoint {x y : α} (h : connected_component x ≠ connected_component y) :
   disjoint (connected_component x) (connected_component y) :=
 set.disjoint_left.2 (λ a h1 h2, h
@@ -609,10 +706,9 @@ set.disjoint_left.2 (λ a h1 h2, h
 
 theorem is_closed_connected_component {x : α} :
   is_closed (connected_component x) :=
-closure_eq_iff_is_closed.1 $ subset.antisymm
-  (is_connected_connected_component.closure.subset_connected_component
-    (subset_closure mem_connected_component))
-  subset_closure
+closure_subset_iff_is_closed.1 $
+  is_connected_connected_component.closure.subset_connected_component $
+    subset_closure mem_connected_component
 
 lemma continuous.image_connected_component_subset [topological_space β] {f : α → β}
   (h : continuous f) (a : α) : f '' connected_component a ⊆ connected_component (f a) :=
@@ -628,6 +724,18 @@ theorem irreducible_component_subset_connected_component {x : α} :
 is_irreducible_irreducible_component.is_connected.subset_connected_component
   mem_irreducible_component
 
+@[mono]
+lemma connected_component_in_mono (x : α) {F G : set α} (h : F ⊆ G) :
+  connected_component_in F x ⊆ connected_component_in G x :=
+begin
+  by_cases hx : x ∈ F,
+  { rw [connected_component_in_eq_image hx, connected_component_in_eq_image (h hx),
+        ← show (coe : G → α) ∘ inclusion h = coe, by ext ; refl, image_comp],
+    exact image_subset coe ((continuous_inclusion h).image_connected_component_subset ⟨x, hx⟩) },
+  { rw connected_component_in_eq_empty hx,
+    exact set.empty_subset _ },
+end
+
 /-- A preconnected space is one where there is no non-trivial open partition. -/
 class preconnected_space (α : Type u) [topological_space α] : Prop :=
 (is_preconnected_univ : is_preconnected (univ : set α))
@@ -660,7 +768,7 @@ lemma connected_space_iff_connected_component :
   connected_space α ↔ ∃ x : α, connected_component x = univ :=
 begin
   split,
-  { rintros ⟨h, ⟨x⟩⟩,
+  { rintro ⟨⟨x⟩⟩,
     exactI ⟨x, eq_univ_of_univ_subset $
       is_preconnected_univ.subset_connected_component (mem_univ x)⟩ },
   { rintros ⟨x, h⟩,
@@ -720,13 +828,13 @@ theorem is_clopen_iff [preconnected_space α] {s : set α} : is_clopen s ↔ s =
   have h1 : s ≠ ∅ ∧ sᶜ ≠ ∅, from ⟨mt or.inl h,
     mt (λ h2, or.inr $ (by rw [← compl_compl s, h2, compl_empty] : s = univ)) h⟩,
   let ⟨_, h2, h3⟩ := nonempty_inter hs.1 hs.2.is_open_compl (union_compl_self s)
-    (ne_empty_iff_nonempty.1 h1.1) (ne_empty_iff_nonempty.1 h1.2) in
+    (nonempty_iff_ne_empty.2 h1.1) (nonempty_iff_ne_empty.2 h1.2) in
   h3 h2,
 by rintro (rfl | rfl); [exact is_clopen_empty, exact is_clopen_univ]⟩
 
-lemma eq_univ_of_nonempty_clopen [preconnected_space α] {s : set α}
-  (h : s.nonempty) (h' : is_clopen s) : s = univ :=
-by { rw is_clopen_iff at h', exact h'.resolve_left h.ne_empty }
+lemma is_clopen.eq_univ [preconnected_space α] {s : set α} (h' : is_clopen s) (h : s.nonempty) :
+  s = univ :=
+(is_clopen_iff.mp h').resolve_left h.ne_empty
 
 lemma frontier_eq_empty_iff [preconnected_space α] {s : set α} :
   frontier s = ∅ ↔ s = ∅ ∨ s = univ :=
@@ -734,7 +842,7 @@ is_clopen_iff_frontier_eq_empty.symm.trans is_clopen_iff
 
 lemma nonempty_frontier_iff [preconnected_space α] {s : set α} :
   (frontier s).nonempty ↔ s.nonempty ∧ s ≠ univ :=
-by simp only [← ne_empty_iff_nonempty, ne.def, frontier_eq_empty_iff, not_or_distrib]
+by simp only [nonempty_iff_ne_empty, ne.def, frontier_eq_empty_iff, not_or_distrib]
 
 lemma subtype.preconnected_space {s : set α} (h : is_preconnected s) :
   preconnected_space s :=
@@ -770,18 +878,18 @@ begin
   { intros u v hu hv hs huv,
     specialize h u v hu hv hs,
     contrapose! huv,
-    rw ne_empty_iff_nonempty,
+    rw ←nonempty_iff_ne_empty,
     simp [not_subset] at huv,
     rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
     have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
     have hyu : y ∈ u := or_iff_not_imp_right.mp (hs hys) hyv,
     exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
   { intros u v hu hv hs hsu hsv,
-    rw ← ne_empty_iff_nonempty,
+    rw nonempty_iff_ne_empty,
     intro H,
     specialize h u v hu hv hs H,
     contrapose H,
-    apply ne_empty_iff_nonempty.mpr,
+    apply nonempty.ne_empty,
     cases h,
     { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
     { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
@@ -821,7 +929,7 @@ begin
         { contradiction },
         { exact ⟨x, hxs, hxu, hxv⟩ } } } },
   { split,
-    { rw ← ne_empty_iff_nonempty,
+    { rw nonempty_iff_ne_empty,
       by_contradiction hs, subst hs,
       simpa using h ∅ _ _ _; simp },
     intros u v hu hv hs hsuv,
@@ -829,7 +937,7 @@ begin
     { rw [finset.mem_insert, finset.mem_singleton] at ht,
       rcases ht with rfl|rfl; tauto },
     { intros t₁ t₂ ht₁ ht₂ hst,
-      rw ← ne_empty_iff_nonempty at hst,
+      rw nonempty_iff_ne_empty at hst,
       rw [finset.mem_insert, finset.mem_singleton] at ht₁ ht₂,
       rcases ht₁ with rfl|rfl; rcases ht₂ with rfl|rfl,
       all_goals { refl <|> contradiction <|> skip },
@@ -869,7 +977,7 @@ begin
     rw is_preconnected_closed_iff at h,
     specialize h u v hu hv hs,
     contrapose! huv,
-    rw ne_empty_iff_nonempty,
+    rw ←nonempty_iff_ne_empty,
     simp [not_subset] at huv,
     rcases huv with ⟨⟨x, hxs, hxu⟩, ⟨y, hys, hyv⟩⟩,
     have hxv : x ∈ v := or_iff_not_imp_left.mp (hs hxs) hxu,
@@ -877,11 +985,11 @@ begin
     exact h ⟨y, hys, hyu⟩ ⟨x, hxs, hxv⟩ },
   { rw is_preconnected_closed_iff,
     intros u v hu hv hs hsu hsv,
-    rw ← ne_empty_iff_nonempty,
+    rw nonempty_iff_ne_empty,
     intro H,
     specialize h u v hu hv hs H,
     contrapose H,
-    apply ne_empty_iff_nonempty.mpr,
+    apply nonempty.ne_empty,
     cases h,
     { rcases hsv with ⟨x, hxs, hxv⟩, exact ⟨x, hxs, ⟨h hxs, hxv⟩⟩ },
     { rcases hsu with ⟨x, hxs, hxu⟩, exact ⟨x, hxs, ⟨hxu, h hxs⟩⟩ } }
@@ -892,14 +1000,13 @@ for every cover by two closed sets that are disjoint,
 it is contained in one of the two covering sets. -/
 theorem is_preconnected_iff_subset_of_fully_disjoint_closed {s : set α} (hs : is_closed s) :
   is_preconnected s ↔
-  ∀ (u v : set α) (hu : is_closed u) (hv : is_closed v) (hss : s ⊆ u ∪ v) (huv : u ∩ v = ∅),
+  ∀ (u v : set α) (hu : is_closed u) (hv : is_closed v) (hss : s ⊆ u ∪ v) (huv : disjoint u v),
   s ⊆ u ∨ s ⊆ v :=
 begin
   split,
   { intros h u v hu hv hss huv,
     apply is_preconnected_iff_subset_of_disjoint_closed.1 h u v hu hv hss,
-    rw huv,
-    exact inter_empty s },
+    rw [huv.inter_eq, inter_empty] },
   intro H,
   rw is_preconnected_iff_subset_of_disjoint_closed,
   intros u v hu hv hss huv,
@@ -908,10 +1015,8 @@ begin
   simp only [subset.refl, and_true] at H1,
   apply H1 (is_closed.inter hu hs) (is_closed.inter hv hs),
   { rw ←inter_distrib_right,
-    apply subset_inter_iff.2,
-    exact ⟨hss, subset.refl s⟩ },
-  { rw [inter_comm v s, inter_assoc, ←inter_assoc s, inter_self s,
-        inter_comm, inter_assoc, inter_comm v u, huv] }
+    exact subset_inter hss subset.rfl },
+  { rwa [disjoint_iff_inter_eq_empty, ←inter_inter_distrib_right, inter_comm] }
 end
 
 lemma is_clopen.connected_component_subset {x} (hs : is_clopen s) (hx : x ∈ s) :
@@ -965,8 +1070,7 @@ begin
   { intros t' ht',
     apply is_preconnected_iff_subset_of_disjoint_closed.1 (connected_fibers t').2 u v hu hv,
     { exact subset.trans (hf.preimage_subset_preimage_iff.2 (singleton_subset_iff.2 ht')) huv },
-    rw uv_disj,
-    exact inter_empty _ },
+    rw [uv_disj.inter_eq, inter_empty] },
 
   have T₁_u : f ⁻¹' T₁ = (f ⁻¹' connected_component t) ∩ u,
   { apply eq_of_subset_of_subset,
@@ -980,9 +1084,7 @@ begin
     dsimp only,
     cases fiber_decomp (f a) (mem_preimage.1 hat),
     { exact h },
-    { exfalso,
-      rw ←not_nonempty_iff_eq_empty at uv_disj,
-      exact uv_disj (nonempty_of_mem (mem_inter hau (h rfl))) } },
+    { cases (nonempty_of_mem $ mem_inter hau $ h rfl).not_disjoint uv_disj } },
   -- This proof is exactly the same as the above (modulo some symmetry)
   have T₂_v : f ⁻¹' T₂ = (f ⁻¹' connected_component t) ∩ v,
   { apply eq_of_subset_of_subset,
@@ -995,9 +1097,7 @@ begin
     { exact mem_preimage.1 hat },
     dsimp only,
     cases fiber_decomp (f a) (mem_preimage.1 hat),
-    { exfalso,
-      rw ←not_nonempty_iff_eq_empty at uv_disj,
-      exact uv_disj (nonempty_of_mem (mem_inter (h rfl) hav)) },
+    { cases (nonempty_of_mem (mem_inter (h rfl) hav)).not_disjoint uv_disj },
     { exact h } },
 
   -- Now we show T₁, T₂ are closed, cover connected_component t and are disjoint.
@@ -1011,18 +1111,10 @@ begin
     { left, exact ⟨ht', htu⟩ },
     right, exact ⟨ht', htv⟩ },
 
-  have T_disjoint : T₁ ∩ T₂ = ∅,
-  { rw ←image_preimage_eq (T₁ ∩ T₂) hf,
-    suffices : f ⁻¹' (T₁ ∩ T₂) = ∅,
-    { rw this, exact image_empty _ },
-    rw [preimage_inter, T₁_u, T₂_v],
-    rw inter_comm at uv_disj,
-    conv
-    { congr,
-      rw [inter_assoc],
-      congr, skip,
-      rw [←inter_assoc, inter_comm, ←inter_assoc, uv_disj, empty_inter], },
-    exact inter_empty _ },
+  have T_disjoint : disjoint T₁ T₂,
+  { refine disjoint.of_preimage hf _,
+    rw [T₁_u, T₂_v, disjoint_iff_inter_eq_empty, ←inter_inter_distrib_left, uv_disj.inter_eq,
+      inter_empty] },
 
   -- Now we do cases on whether (connected_component t) is a subset of T₁ or T₂ to show
   -- that the preimage is a subset of u or v.
@@ -1054,6 +1146,125 @@ by rw [← hf.preimage_connected_component h_fibers, image_preimage_eq _ hf.surj
 
 end preconnected
 
+section locally_connected_space
+
+/-- A topological space is **locally connected** if each neighborhood filter admits a basis
+of connected *open* sets. Note that it is equivalent to each point having a basis of connected
+(non necessarily open) sets but in a non-trivial way, so we choose this definition and prove the
+equivalence later in `locally_connected_space_iff_connected_basis`. -/
+class locally_connected_space (α : Type*) [topological_space α] : Prop :=
+(open_connected_basis : ∀ x, (𝓝 x).has_basis (λ s : set α, is_open s ∧ x ∈ s ∧ is_connected s) id)
+
+lemma locally_connected_space_iff_open_connected_basis : locally_connected_space α ↔
+  ∀ x, (𝓝 x).has_basis (λ s : set α, is_open s ∧ x ∈ s ∧ is_connected s) id :=
+⟨@locally_connected_space.open_connected_basis _ _, locally_connected_space.mk⟩
+
+lemma locally_connected_space_iff_open_connected_subsets :
+  locally_connected_space α ↔ ∀ (x : α) (U ∈ 𝓝 x), ∃ V ⊆ U, is_open V ∧ x ∈ V ∧ is_connected V :=
+begin
+  rw locally_connected_space_iff_open_connected_basis,
+  congrm ∀ x, (_ : Prop),
+  split,
+  { intros h U hU,
+    rcases h.mem_iff.mp hU with ⟨V, hV, hVU⟩,
+    exact ⟨V, hVU, hV⟩ },
+  { exact λ h, ⟨λ U, ⟨λ hU, let ⟨V, hVU, hV⟩ := h U hU in ⟨V, hV, hVU⟩,
+                λ ⟨V, ⟨hV, hxV, _⟩, hVU⟩, mem_nhds_iff.mpr ⟨V, hVU, hV, hxV⟩⟩⟩ }
+end
+
+/-- A space with discrete topology is a locally connected space. -/
+@[priority 100]
+instance discrete_topology.to_locally_connected_space (α) [topological_space α]
+  [discrete_topology α] : locally_connected_space α :=
+locally_connected_space_iff_open_connected_subsets.2 $ λ x _U hU,
+  ⟨{x}, singleton_subset_iff.2 $ mem_of_mem_nhds hU, is_open_discrete _, mem_singleton _,
+    is_connected_singleton⟩
+
+lemma connected_component_in_mem_nhds [locally_connected_space α] {F : set α} {x : α}
+  (h : F ∈ 𝓝 x) :
+  connected_component_in F x ∈ 𝓝 x :=
+begin
+  rw (locally_connected_space.open_connected_basis x).mem_iff at h,
+  rcases h with ⟨s, ⟨h1s, hxs, h2s⟩, hsF⟩,
+  exact mem_nhds_iff.mpr ⟨s, h2s.is_preconnected.subset_connected_component_in hxs hsF, h1s, hxs⟩
+end
+
+lemma is_open.connected_component_in [locally_connected_space α] {F : set α} {x : α}
+  (hF : is_open F) :
+  is_open (connected_component_in F x) :=
+begin
+  rw [is_open_iff_mem_nhds],
+  intros y hy,
+  rw [connected_component_in_eq hy],
+  exact connected_component_in_mem_nhds (is_open_iff_mem_nhds.mp hF y $
+    connected_component_in_subset F x hy)
+end
+
+lemma is_open_connected_component [locally_connected_space α] {x : α} :
+  is_open (connected_component x) :=
+begin
+  rw ← connected_component_in_univ,
+  exact is_open_univ.connected_component_in
+end
+
+lemma is_clopen_connected_component [locally_connected_space α] {x : α} :
+  is_clopen (connected_component x) :=
+⟨is_open_connected_component, is_closed_connected_component⟩
+
+lemma locally_connected_space_iff_connected_component_in_open :
+  locally_connected_space α ↔ ∀ F : set α, is_open F → ∀ x ∈ F,
+  is_open (connected_component_in F x) :=
+begin
+  split,
+  { introI h,
+    exact λ F hF x _, hF.connected_component_in },
+  { intro h,
+    rw locally_connected_space_iff_open_connected_subsets,
+    refine (λ x U hU, ⟨connected_component_in (interior U) x,
+      (connected_component_in_subset _ _).trans interior_subset, h _ is_open_interior x _,
+      mem_connected_component_in _, is_connected_connected_component_in_iff.mpr _⟩);
+    exact (mem_interior_iff_mem_nhds.mpr hU) }
+end
+
+lemma locally_connected_space_iff_connected_subsets :
+  locally_connected_space α ↔ ∀ (x : α) (U ∈ 𝓝 x), ∃ V ∈ 𝓝 x, is_preconnected V ∧ V ⊆ U :=
+begin
+  split,
+  { rw locally_connected_space_iff_open_connected_subsets,
+    intros h x U hxU,
+    rcases h x U hxU with ⟨V, hVU, hV₁, hxV, hV₂⟩,
+    exact ⟨V, hV₁.mem_nhds hxV, hV₂.is_preconnected, hVU⟩ },
+  { rw locally_connected_space_iff_connected_component_in_open,
+    refine λ h U hU x hxU, is_open_iff_mem_nhds.mpr (λ y hy, _),
+    rw connected_component_in_eq hy,
+    rcases h y U (hU.mem_nhds $ (connected_component_in_subset _ _) hy) with ⟨V, hVy, hV, hVU⟩,
+    exact filter.mem_of_superset hVy
+      (hV.subset_connected_component_in (mem_of_mem_nhds hVy) hVU) }
+end
+
+lemma locally_connected_space_iff_connected_basis :
+  locally_connected_space α ↔
+  ∀ x, (𝓝 x).has_basis (λ s : set α, s ∈ 𝓝 x ∧ is_preconnected s) id :=
+begin
+  rw locally_connected_space_iff_connected_subsets,
+  congrm ∀ x, (_ : Prop),
+  exact filter.has_basis_self.symm
+end
+
+lemma locally_connected_space_of_connected_bases {ι : Type*} (b : α → ι → set α) (p : α → ι → Prop)
+  (hbasis : ∀ x, (𝓝 x).has_basis (p x) (b x))
+  (hconnected : ∀ x i, p x i → is_preconnected (b x i)) :
+  locally_connected_space α :=
+begin
+  rw locally_connected_space_iff_connected_basis,
+  exact λ x, (hbasis x).to_has_basis
+    (λ i hi, ⟨b x i, ⟨(hbasis x).mem_of_mem hi, hconnected x i hi⟩, subset_rfl⟩)
+    (λ s hs, ⟨(hbasis x).index s hs.1,
+      ⟨(hbasis x).property_index hs.1, (hbasis x).set_index_subset hs.1⟩⟩)
+end
+
+end locally_connected_space
+
 section totally_disconnected
 
 /-- A set `s` is called totally disconnected if every subset `t ⊆ s` which is preconnected is
@@ -1065,7 +1276,7 @@ theorem is_totally_disconnected_empty : is_totally_disconnected (∅ : set α) :
 λ _ ht _ _ x_in _ _, (ht x_in).elim
 
 theorem is_totally_disconnected_singleton {x} : is_totally_disconnected ({x} : set α) :=
-λ _ ht _, subsingleton.mono subsingleton_singleton ht
+λ _ ht _, subsingleton_singleton.anti ht
 
 /-- A space is totally disconnected if all of its connected components are singletons. -/
 class totally_disconnected_space (α : Type u) [topological_space α] : Prop :=
@@ -1141,7 +1352,7 @@ begin
   intros s s_sub hs,
   rcases eq_empty_or_nonempty s with rfl | ⟨x, x_in⟩,
   { exact subsingleton_empty },
-  { exact (h x).mono (hs.subset_connected_component x_in) }
+  { exact (h x).anti (hs.subset_connected_component x_in) }
 end
 
 /-- A space is totally disconnected iff its connected components are singletons. -/
@@ -1154,6 +1365,10 @@ begin
   exact mem_connected_component
 end
 
+@[simp] theorem connected_component_eq_singleton [totally_disconnected_space α] (x : α) :
+  connected_component x = {x} :=
+totally_disconnected_space_iff_connected_component_singleton.1 ‹_› x
+
 /-- The image of a connected component in a totally disconnected space is a singleton. -/
 @[simp] lemma continuous.image_connected_component_eq_singleton {β : Type*} [topological_space β]
   [totally_disconnected_space β] {f : α → β} (h : continuous f) (a : α) :
@@ -1187,7 +1402,7 @@ section totally_separated
 by two disjoint open sets covering `s`. -/
 def is_totally_separated (s : set α) : Prop :=
 ∀ x ∈ s, ∀ y ∈ s, x ≠ y → ∃ u v : set α, is_open u ∧ is_open v ∧
-  x ∈ u ∧ y ∈ v ∧ s ⊆ u ∪ v ∧ u ∩ v = ∅
+  x ∈ u ∧ y ∈ v ∧ s ⊆ u ∪ v ∧ disjoint u v
 
 theorem is_totally_separated_empty : is_totally_separated (∅ : set α) :=
 λ x, false.elim
@@ -1201,12 +1416,10 @@ begin
   intros t hts ht x x_in y y_in,
   by_contra h,
   obtain ⟨u : set α, v : set α, hu : is_open u, hv : is_open v,
-          hxu : x ∈ u, hyv : y ∈ v, hs : s ⊆ u ∪ v, huv : u ∩ v = ∅⟩ :=
+          hxu : x ∈ u, hyv : y ∈ v, hs : s ⊆ u ∪ v, huv⟩ :=
     H x (hts x_in) y (hts y_in) h,
-  have : (t ∩ u).nonempty → (t ∩ v).nonempty → (t ∩ (u ∩ v)).nonempty :=
-    ht _ _ hu hv (subset.trans hts hs),
-  obtain ⟨z, hz : z ∈ t ∩ (u ∩ v)⟩ := this ⟨x, x_in, hxu⟩ ⟨y, y_in, hyv⟩,
-  simpa [huv] using hz
+  refine (ht _ _ hu hv (hts.trans hs) ⟨x, x_in, hxu⟩ ⟨y, y_in, hyv⟩).ne_empty _,
+  rw [huv.inter_eq, inter_empty],
 end
 
 alias is_totally_disconnected_of_is_totally_separated ← is_totally_separated.is_totally_disconnected
@@ -1235,7 +1448,7 @@ begin
     totally_separated_space.is_totally_separated_univ α x (set.mem_univ x) y (set.mem_univ y) hxy,
   have clopen_U := is_clopen_inter_of_disjoint_cover_clopen (is_clopen_univ) f hU hV disj,
   rw univ_inter _ at clopen_U,
-  rw [←set.subset_compl_iff_disjoint, subset_compl_comm] at disj,
+  rw [←set.subset_compl_iff_disjoint_right, subset_compl_comm] at disj,
   exact ⟨U, clopen_U, Ux, disj Vy⟩,
 end
 
@@ -1266,7 +1479,7 @@ not_congr coe_eq_coe
 
 lemma coe_eq_coe' {x y : α} :
   (x : connected_components α) = y ↔ x ∈ connected_component y :=
-coe_eq_coe.trans ⟨λ h, h ▸ mem_connected_component, λ h, (connected_component_eq h).symm⟩
+coe_eq_coe.trans connected_component_eq_iff_mem
 
 instance [inhabited α] : inhabited (connected_components α) := ⟨↑(default : α)⟩
 
@@ -1301,7 +1514,7 @@ def continuous.connected_components_lift (h : continuous f) :
 
 @[continuity] lemma continuous.connected_components_lift_continuous (h : continuous f) :
   continuous h.connected_components_lift :=
-continuous_quotient_lift_on' h.image_eq_of_connected_component_eq h
+h.quotient_lift_on' h.image_eq_of_connected_component_eq
 
 @[simp] lemma continuous.connected_components_lift_apply_coe (h : continuous f) (x : α) :
   h.connected_components_lift x = f x := rfl
@@ -1353,3 +1566,55 @@ lemma continuous.connected_components_map_continuous {β : Type*} [topological_s
 continuous.connected_components_lift_continuous (continuous_quotient_mk.comp h)
 
 end connected_component_setoid
+
+/-- A preconnected set `s` has the property that every map to a
+discrete space that is continuous on `s` is constant on `s` -/
+lemma is_preconnected.constant {Y : Type*} [topological_space Y] [discrete_topology Y]
+  {s : set α} (hs : is_preconnected s) {f : α → Y} (hf : continuous_on f s)
+  {x y : α} (hx : x ∈ s) (hy : y ∈ s) : f x = f y :=
+(hs.image f hf).subsingleton (mem_image_of_mem f hx) (mem_image_of_mem f hy)
+
+/-- If every map to `bool` (a discrete two-element space), that is
+continuous on a set `s`, is constant on s, then s is preconnected -/
+lemma is_preconnected_of_forall_constant {s : set α}
+  (hs : ∀ f : α → bool, continuous_on f s → ∀ x ∈ s, ∀ y ∈ s, f x = f y) : is_preconnected s :=
+begin
+  unfold is_preconnected,
+  by_contra',
+  rcases this with ⟨u, v, u_op, v_op, hsuv, ⟨x, x_in_s, x_in_u⟩, ⟨y, y_in_s, y_in_v⟩, H⟩,
+  rw [not_nonempty_iff_eq_empty] at H,
+  have hy : y ∉ u,
+    from λ y_in_u, eq_empty_iff_forall_not_mem.mp H y ⟨y_in_s, ⟨y_in_u, y_in_v⟩⟩,
+  have : continuous_on u.bool_indicator s,
+  { apply (continuous_on_indicator_iff_clopen _ _).mpr ⟨_, _⟩,
+    { exact continuous_subtype_coe.is_open_preimage u u_op },
+    { rw preimage_subtype_coe_eq_compl hsuv H,
+      exact (continuous_subtype_coe.is_open_preimage v v_op).is_closed_compl } },
+  simpa [(u.mem_iff_bool_indicator _).mp x_in_u, (u.not_mem_iff_bool_indicator _).mp hy] using
+    hs _ this x x_in_s y y_in_s
+end
+
+/-- A `preconnected_space` version of `is_preconnected.constant` -/
+lemma preconnected_space.constant {Y : Type*} [topological_space Y] [discrete_topology Y]
+  (hp : preconnected_space α) {f : α → Y} (hf : continuous f) {x y : α} : f x = f y :=
+is_preconnected.constant hp.is_preconnected_univ (continuous.continuous_on hf) trivial trivial
+
+/-- A `preconnected_space` version of `is_preconnected_of_forall_constant` -/
+lemma preconnected_space_of_forall_constant (hs : ∀ f : α → bool, continuous f → ∀ x y, f x = f y) :
+  preconnected_space α :=
+⟨is_preconnected_of_forall_constant
+  (λ f hf x hx y hy, hs f (continuous_iff_continuous_on_univ.mpr hf) x y)⟩
+
+/-- Refinement of `is_preconnected.constant` only assuming the map factors through a
+discrete subset of the target. -/
+lemma is_preconnected.constant_of_maps_to [topological_space β]
+  {S : set α} (hS : is_preconnected S) {T : set β} [discrete_topology T] {f : α → β}
+  (hc : continuous_on f S) (hTm : maps_to f S T)
+  {x y : α} (hx : x ∈ S) (hy : y ∈ S) : f x = f y :=
+begin
+  let F : S → T := (λ x:S, ⟨f x.val, hTm x.property⟩),
+  suffices : F ⟨x, hx⟩ = F ⟨y, hy⟩,
+  { rw ←subtype.coe_inj at this, exact this },
+  exact (is_preconnected_iff_preconnected_space.mp hS).constant
+    (continuous_induced_rng.mpr $ continuous_on_iff_continuous_restrict.mp hc)
+end
diff --git a/src/topology/constructions.lean b/src/topology/constructions.lean
index 12f3bc9a2658f..381b14ffe7d47 100644
--- a/src/topology/constructions.lean
+++ b/src/topology/constructions.lean
@@ -5,11 +5,13 @@ Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
 -/
 import topology.maps
 import order.filter.pi
-import data.fin.tuple
 
 /-!
 # Constructions of new topological spaces from old ones
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file constructs products, sums, subtypes and quotients of topological spaces
 and sets up their basic theory, such as criteria for maps into or out of these
 constructions to be continuous; descriptions of the open sets, neighborhood filters,
@@ -33,8 +35,8 @@ product, sum, disjoint union, subspace, quotient space
 
 noncomputable theory
 
-open topological_space set filter
-open_locale classical topological_space filter
+open topological_space set filter function
+open_locale classical topology filter
 
 universes u v
 variables {α : Type u} {β : Type v} {γ δ ε ζ : Type*}
@@ -66,6 +68,73 @@ instance Pi.topological_space {β : α → Type v} [t₂ : Πa, topological_spac
 instance ulift.topological_space [t : topological_space α] : topological_space (ulift.{v u} α) :=
 t.induced ulift.down
 
+/-!
+### `additive`, `multiplicative`
+
+The topology on those type synonyms is inherited without change.
+-/
+
+section
+variables [topological_space α]
+
+open additive multiplicative
+
+instance : topological_space (additive α) := ‹topological_space α›
+instance : topological_space (multiplicative α) := ‹topological_space α›
+instance [discrete_topology α] : discrete_topology (additive α) := ‹discrete_topology α›
+instance [discrete_topology α] : discrete_topology (multiplicative α) := ‹discrete_topology α›
+
+lemma continuous_of_mul : continuous (of_mul : α → additive α) := continuous_id
+lemma continuous_to_mul : continuous (to_mul : additive α → α) := continuous_id
+lemma continuous_of_add : continuous (of_add : α → multiplicative α) := continuous_id
+lemma continuous_to_add : continuous (to_add : multiplicative α → α) := continuous_id
+
+lemma is_open_map_of_mul : is_open_map (of_mul : α → additive α) := is_open_map.id
+lemma is_open_map_to_mul : is_open_map (to_mul : additive α → α) := is_open_map.id
+lemma is_open_map_of_add : is_open_map (of_add : α → multiplicative α) := is_open_map.id
+lemma is_open_map_to_add : is_open_map (to_add : multiplicative α → α) := is_open_map.id
+
+lemma is_closed_map_of_mul : is_closed_map (of_mul : α → additive α) := is_closed_map.id
+lemma is_closed_map_to_mul : is_closed_map (to_mul : additive α → α) := is_closed_map.id
+lemma is_closed_map_of_add : is_closed_map (of_add : α → multiplicative α) := is_closed_map.id
+lemma is_closed_map_to_add : is_closed_map (to_add : multiplicative α → α) := is_closed_map.id
+
+lemma nhds_of_mul (a : α) : 𝓝 (of_mul a) = map of_mul (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_of_add (a : α) : 𝓝 (of_add a) = map of_add (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_to_mul (a : additive α) : 𝓝 (to_mul a) = map to_mul (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_to_add (a : multiplicative α) : 𝓝 (to_add a) = map to_add (𝓝 a) :=
+by { unfold nhds, refl, }
+
+end
+
+/-!
+### Order dual
+
+The topology on this type synonym is inherited without change.
+-/
+
+section
+variables [topological_space α]
+
+open order_dual
+
+instance : topological_space αᵒᵈ := ‹topological_space α›
+instance [discrete_topology α] : discrete_topology (αᵒᵈ) := ‹discrete_topology α›
+
+lemma continuous_to_dual : continuous (to_dual : α → αᵒᵈ) := continuous_id
+lemma continuous_of_dual : continuous (of_dual : αᵒᵈ → α) := continuous_id
+
+lemma is_open_map_to_dual : is_open_map (to_dual : α → αᵒᵈ) := is_open_map.id
+lemma is_open_map_of_dual : is_open_map (of_dual : αᵒᵈ → α) := is_open_map.id
+
+lemma is_closed_map_to_dual : is_closed_map (to_dual : α → αᵒᵈ) := is_closed_map.id
+lemma is_closed_map_of_dual : is_closed_map (of_dual : αᵒᵈ → α) := is_closed_map.id
+
+lemma nhds_to_dual (a : α) : 𝓝 (to_dual a) = map to_dual (𝓝 a) := by { unfold nhds, refl, }
+lemma nhds_of_dual (a : α) : 𝓝 (of_dual a) = map of_dual (𝓝 a) := by { unfold nhds, refl, }
+
+end
+
 lemma quotient.preimage_mem_nhds [topological_space α] [s : setoid α]
   {V : set $ quotient s} {a : α} (hs : V ∈ 𝓝 (quotient.mk a)) : quotient.mk ⁻¹' V ∈ 𝓝 a :=
 preimage_nhds_coinduced hs
@@ -109,6 +178,23 @@ theorem nhds_subtype (s : set α) (a : {x // x ∈ s}) :
   𝓝 a = comap coe (𝓝 (a : α)) :=
 nhds_induced coe a
 
+lemma nhds_within_subtype_eq_bot_iff {s t : set α} {x : s} :
+  𝓝[(coe : s → α) ⁻¹' t] x = ⊥ ↔ 𝓝[t] (x : α) ⊓ 𝓟 s = ⊥ :=
+by rw [inf_principal_eq_bot_iff_comap, nhds_within, nhds_within, comap_inf, comap_principal,
+       nhds_induced]
+
+lemma nhds_ne_subtype_eq_bot_iff {S : set α} {x : S} : 𝓝[{x}ᶜ] x = ⊥ ↔ 𝓝[{x}ᶜ] (x : α) ⊓ 𝓟 S = ⊥ :=
+by rw [← nhds_within_subtype_eq_bot_iff, preimage_compl, ← image_singleton,
+       subtype.coe_injective.preimage_image ]
+
+lemma nhds_ne_subtype_ne_bot_iff {S : set α} {x : S} :
+  (𝓝[{x}ᶜ] x).ne_bot ↔ (𝓝[{x}ᶜ] (x : α) ⊓ 𝓟 S).ne_bot :=
+by rw [ne_bot_iff, ne_bot_iff, not_iff_not, nhds_ne_subtype_eq_bot_iff]
+
+lemma discrete_topology_subtype_iff {S : set α} :
+  discrete_topology S ↔ ∀ x ∈ S, 𝓝[≠] x ⊓ 𝓟 S = ⊥ :=
+by simp_rw [discrete_topology_iff_nhds_ne, set_coe.forall', nhds_ne_subtype_eq_bot_iff]
+
 end topα
 
 /-- A type synonym equiped with the topology whose open sets are the empty set and the sets with
@@ -126,26 +212,22 @@ instance : topological_space (cofinite_topology α) :=
 { is_open := λ s, s.nonempty → set.finite sᶜ,
   is_open_univ := by simp,
   is_open_inter := λ s t, begin
-    classical,
     rintros hs ht ⟨x, hxs, hxt⟩,
-    haveI := set.finite.fintype (hs ⟨x, hxs⟩),
-    haveI := set.finite.fintype (ht ⟨x, hxt⟩),
     rw compl_inter,
-    exact set.finite.intro (sᶜ.fintype_union tᶜ),
+    exact (hs ⟨x, hxs⟩).union (ht ⟨x, hxt⟩),
   end,
   is_open_sUnion := begin
     rintros s h ⟨x, t, hts, hzt⟩,
     rw set.compl_sUnion,
-    apply set.finite.sInter _ (h t hts ⟨x, hzt⟩),
-    simp [hts]
-    end }
+    exact set.finite.sInter (mem_image_of_mem _ hts) (h t hts ⟨x, hzt⟩),
+  end }
 
 lemma is_open_iff {s : set (cofinite_topology α)} :
   is_open s ↔ (s.nonempty → (sᶜ).finite) := iff.rfl
 
 lemma is_open_iff' {s : set (cofinite_topology α)} :
   is_open s ↔ (s = ∅ ∨ (sᶜ).finite) :=
-by simp only [is_open_iff, ← ne_empty_iff_nonempty, or_iff_not_imp_left]
+by simp only [is_open_iff, nonempty_iff_ne_empty, or_iff_not_imp_left]
 
 lemma is_closed_iff {s : set (cofinite_topology α)} :
   is_closed s ↔ s = univ ∨ s.finite :=
@@ -234,7 +316,11 @@ hf.comp continuous_at_snd
 
 @[continuity] lemma continuous.prod_mk {f : γ → α} {g : γ → β}
   (hf : continuous f) (hg : continuous g) : continuous (λx, (f x, g x)) :=
-continuous_inf_rng (continuous_induced_rng hf) (continuous_induced_rng hg)
+continuous_inf_rng.2 ⟨continuous_induced_rng.2 hf, continuous_induced_rng.2 hg⟩
+
+@[simp] lemma continuous_prod_mk {f : α → β} {g : α → γ} :
+  continuous (λ x, (f x, g x)) ↔ continuous f ∧ continuous g :=
+⟨λ h, ⟨h.fst, h.snd⟩, λ h, h.1.prod_mk h.2⟩
 
 @[continuity] lemma continuous.prod.mk (a : α) : continuous (λ b : β, (a, b)) :=
 continuous_const.prod_mk continuous_id'
@@ -317,15 +403,15 @@ lemma continuous_swap : continuous (prod.swap : α × β → β × α) :=
 continuous_snd.prod_mk continuous_fst
 
 lemma continuous_uncurry_left {f : α → β → γ} (a : α)
-  (h : continuous (function.uncurry f)) : continuous (f a) :=
-show continuous (function.uncurry f ∘ (λ b, (a, b))), from h.comp (by continuity)
+  (h : continuous (uncurry f)) : continuous (f a) :=
+show continuous (uncurry f ∘ (λ b, (a, b))), from h.comp (by continuity)
 
 lemma continuous_uncurry_right {f : α → β → γ} (b : β)
-  (h : continuous (function.uncurry f)) : continuous (λ a, f a b) :=
-show continuous (function.uncurry f ∘ (λ a, (a, b))), from h.comp (by continuity)
+  (h : continuous (uncurry f)) : continuous (λ a, f a b) :=
+show continuous (uncurry f ∘ (λ a, (a, b))), from h.comp (by continuity)
 
 lemma continuous_curry {g : α × β → γ} (a : α)
-  (h : continuous g) : continuous (function.curry g a) :=
+  (h : continuous g) : continuous (curry g a) :=
 show continuous (g ∘ (λ b, (a, b))), from h.comp (by continuity)
 
 lemma is_open.prod {s : set α} {t : set β} (hs : is_open s) (ht : is_open t) :
@@ -338,7 +424,7 @@ by rw [filter.prod, prod.topological_space, nhds_inf, nhds_induced, nhds_induced
 /-- If a function `f x y` is such that `y ↦ f x y` is continuous for all `x`, and `x` lives in a
 discrete space, then `f` is continuous. -/
 lemma continuous_uncurry_of_discrete_topology [discrete_topology α]
-  {f : α → β → γ} (hf : ∀ a, continuous (f a)) : continuous (function.uncurry f) :=
+  {f : α → β → γ} (hf : ∀ a, continuous (f a)) : continuous (uncurry f) :=
 begin
   apply continuous_iff_continuous_at.2,
   rintros ⟨a, x⟩,
@@ -382,17 +468,22 @@ lemma filter.has_basis.prod_nhds' {ιa ιb : Type*} {pa : ιa → Prop} {pb : ι
 by { cases ab, exact ha.prod_nhds hb }
 
 instance [discrete_topology α] [discrete_topology β] : discrete_topology (α × β) :=
-⟨eq_of_nhds_eq_nhds $ assume ⟨a, b⟩,
-  by rw [nhds_prod_eq, nhds_discrete α, nhds_discrete β, nhds_bot, filter.prod_pure_pure]⟩
+discrete_topology_iff_nhds.2 $ λ ⟨a, b⟩,
+  by rw [nhds_prod_eq, nhds_discrete α, nhds_discrete β, filter.prod_pure_pure]
 
 lemma prod_mem_nhds_iff {s : set α} {t : set β} {a : α} {b : β} :
   s ×ˢ t ∈ 𝓝 (a, b) ↔ s ∈ 𝓝 a ∧ t ∈ 𝓝 b :=
 by rw [nhds_prod_eq, prod_mem_prod_iff]
 
-lemma prod_is_open.mem_nhds {s : set α} {t : set β} {a : α} {b : β}
+lemma prod_mem_nhds {s : set α} {t : set β} {a : α} {b : β}
   (ha : s ∈ 𝓝 a) (hb : t ∈ 𝓝 b) : s ×ˢ t ∈ 𝓝 (a, b) :=
 prod_mem_nhds_iff.2 ⟨ha, hb⟩
 
+lemma filter.eventually.prod_nhds {p : α → Prop} {q : β → Prop} {a : α} {b : β}
+  (ha : ∀ᶠ x in 𝓝 a, p x) (hb : ∀ᶠ y in 𝓝 b, q y) :
+  ∀ᶠ z : α × β in 𝓝 (a, b), p z.1 ∧ q z.2 :=
+prod_mem_nhds ha hb
+
 lemma nhds_swap (a : α) (b : β) : 𝓝 (a, b) = (𝓝 (b, a)).map prod.swap :=
 by rw [nhds_prod_eq, filter.prod_comm, nhds_prod_eq]; refl
 
@@ -468,10 +559,10 @@ lemma prod_induced_induced {α γ : Type*} (f : α → β) (g : γ → δ) :
 by simp_rw [prod.topological_space, induced_inf, induced_compose]
 
 lemma continuous_uncurry_of_discrete_topology_left [discrete_topology α]
-  {f : α → β → γ} (h : ∀ a, continuous (f a)) : continuous (function.uncurry f) :=
+  {f : α → β → γ} (h : ∀ a, continuous (f a)) : continuous (uncurry f) :=
 continuous_iff_continuous_at.2 $ λ ⟨a, b⟩,
   by simp only [continuous_at, nhds_prod_eq, nhds_discrete α, pure_prod, tendsto_map'_iff, (∘),
-    function.uncurry, (h a).tendsto]
+    uncurry, (h a).tendsto]
 
 /-- Given a neighborhood `s` of `(x, x)`, then `(x, x)` has a square open neighborhood
   that is a subset of `s`. -/
@@ -522,7 +613,7 @@ empty -/
 lemma is_open_prod_iff' {s : set α} {t : set β} :
   is_open (s ×ˢ t) ↔ (is_open s ∧ is_open t) ∨ (s = ∅) ∨ (t = ∅) :=
 begin
-  cases (s ×ˢ t : set _).eq_empty_or_nonempty with h h,
+  cases (s ×ˢ t).eq_empty_or_nonempty with h h,
   { simp [h, prod_eq_empty_iff.1 h] },
   { have st : s.nonempty ∧ t.nonempty, from prod_nonempty_iff.1 h,
     split,
@@ -555,20 +646,20 @@ lemma frontier_prod_eq (s : set α) (t : set β) :
 by simp only [frontier, closure_prod_eq, interior_prod_eq, prod_diff_prod]
 
 @[simp] lemma frontier_prod_univ_eq (s : set α) :
-  frontier (s ×ˢ (univ : set β)) = frontier s ×ˢ (univ : set β) :=
+  frontier (s ×ˢ (univ : set β)) = frontier s ×ˢ univ :=
 by simp [frontier_prod_eq]
 
 @[simp] lemma frontier_univ_prod_eq (s : set β) :
-  frontier ((univ : set α) ×ˢ s) = (univ : set α) ×ˢ (frontier s) :=
+  frontier ((univ : set α) ×ˢ s) = univ ×ˢ frontier s :=
 by simp [frontier_prod_eq]
 
-lemma map_mem_closure2 {s : set α} {t : set β} {u : set γ} {f : α → β → γ} {a : α} {b : β}
-  (hf : continuous (λp:α×β, f p.1 p.2)) (ha : a ∈ closure s) (hb : b ∈ closure t)
-  (hu : ∀a b, a ∈ s → b ∈ t → f a b ∈ u) :
+lemma map_mem_closure₂ {f : α → β → γ} {a : α} {b : β} {s : set α} {t : set β} {u : set γ}
+  (hf : continuous (uncurry f)) (ha : a ∈ closure s) (hb : b ∈ closure t)
+  (h : ∀ (a ∈ s) (b ∈ t), f a b ∈ u) :
   f a b ∈ closure u :=
-have (a, b) ∈ closure (s ×ˢ t), by rw [closure_prod_eq]; from ⟨ha, hb⟩,
-show (λp:α×β, f p.1 p.2) (a, b) ∈ closure u, from
-  map_mem_closure hf this $ assume ⟨a, b⟩ ⟨ha, hb⟩, hu a b ha hb
+have H₁ : (a, b) ∈ closure (s ×ˢ t), by simpa only [closure_prod_eq] using mk_mem_prod ha hb,
+have H₂ : maps_to (uncurry f) (s ×ˢ t) u, from forall_prod_set.2 h,
+H₂.closure hf H₁
 
 lemma is_closed.prod {s₁ : set α} {s₂ : set β} (h₁ : is_closed s₁) (h₂ : is_closed s₂) :
   is_closed (s₁ ×ˢ s₂) :=
@@ -589,6 +680,14 @@ lemma inducing.prod_mk {f : α → β} {g : γ → δ} (hf : inducing f) (hg : i
 ⟨by rw [prod.topological_space, prod.topological_space, hf.induced, hg.induced,
          induced_compose, induced_compose, induced_inf, induced_compose, induced_compose]⟩
 
+@[simp] lemma inducing_const_prod {a : α} {f : β → γ} : inducing (λ x, (a, f x)) ↔ inducing f :=
+by simp_rw [inducing_iff, prod.topological_space, induced_inf, induced_compose, function.comp,
+    induced_const, top_inf_eq]
+
+@[simp] lemma inducing_prod_const {b : β} {f : α → γ} : inducing (λ x, (f x, b)) ↔ inducing f :=
+by simp_rw [inducing_iff, prod.topological_space, induced_inf, induced_compose, function.comp,
+    induced_const, inf_top_eq]
+
 lemma embedding.prod_mk {f : α → β} {g : γ → δ} (hf : embedding f) (hg : embedding g) :
   embedding (λx:α×γ, (f x.1, g x.2)) :=
 { inj := assume ⟨x₁, x₂⟩ ⟨y₁, y₂⟩, by simp; exact assume h₁ h₂, ⟨hf.inj h₁, hg.inj h₂⟩,
@@ -600,7 +699,7 @@ begin
   rw [is_open_map_iff_nhds_le],
   rintros ⟨a, b⟩,
   rw [nhds_prod_eq, nhds_prod_eq, ← filter.prod_map_map_eq],
-  exact filter.prod_mono (is_open_map_iff_nhds_le.1 hf a) (is_open_map_iff_nhds_le.1 hg b)
+  exact filter.prod_mono (hf.nhds_le a) (hg.nhds_le b)
 end
 
 protected lemma open_embedding.prod {f : α → β} {g : γ → δ}
@@ -615,7 +714,7 @@ end prod
 
 section sum
 open sum
-variables [topological_space α] [topological_space β] [topological_space γ]
+variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
 
 @[continuity] lemma continuous_inl : continuous (@inl α β) :=
 continuous_sup_rng_left continuous_coinduced_rng
@@ -623,66 +722,29 @@ continuous_sup_rng_left continuous_coinduced_rng
 @[continuity] lemma continuous_inr : continuous (@inr α β) :=
 continuous_sup_rng_right continuous_coinduced_rng
 
-@[continuity] lemma continuous_sum_rec {f : α → γ} {g : β → γ}
-  (hf : continuous f) (hg : continuous g) : @continuous (α ⊕ β) γ _ _ (@sum.rec α β (λ_, γ) f g) :=
-begin
-  apply continuous_sup_dom;
-  rw continuous_def at hf hg ⊢;
-  assumption
-end
-
 lemma is_open_sum_iff {s : set (α ⊕ β)} :
   is_open s ↔ is_open (inl ⁻¹' s) ∧ is_open (inr ⁻¹' s) :=
 iff.rfl
 
-lemma is_open_map_sum {f : α ⊕ β → γ}
-  (h₁ : is_open_map (λ a, f (inl a))) (h₂ : is_open_map (λ b, f (inr b))) :
-  is_open_map f :=
-begin
-  intros u hu,
-  rw is_open_sum_iff at hu,
-  cases hu with hu₁ hu₂,
-  have : u = inl '' (inl ⁻¹' u) ∪ inr '' (inr ⁻¹' u),
-  { ext (_|_); simp },
-  rw [this, set.image_union, set.image_image, set.image_image],
-  exact is_open.union (h₁ _ hu₁) (h₂ _ hu₂)
-end
+lemma is_open_map_inl : is_open_map (@inl α β) :=
+λ u hu, by simpa [is_open_sum_iff, preimage_image_eq u sum.inl_injective]
 
-lemma embedding_inl : embedding (@inl α β) :=
-{ induced := begin
-    unfold sum.topological_space,
-    apply le_antisymm,
-    { rw ← coinduced_le_iff_le_induced, exact le_sup_left },
-    { intros u hu, existsi (inl '' u),
-      change
-        (is_open (inl ⁻¹' (@inl α β '' u)) ∧
-         is_open (inr ⁻¹' (@inl α β '' u))) ∧
-        inl ⁻¹' (inl '' u) = u,
-      rw [preimage_image_eq u sum.inl_injective, preimage_inr_image_inl],
-      exact ⟨⟨hu, is_open_empty⟩, rfl⟩ }
-  end,
-  inj := λ _ _, inl.inj_iff.mp }
-
-lemma embedding_inr : embedding (@inr α β) :=
-{ induced := begin
-    unfold sum.topological_space,
-    apply le_antisymm,
-    { rw ← coinduced_le_iff_le_induced, exact le_sup_right },
-    { intros u hu, existsi (inr '' u),
-      change
-        (is_open (inl ⁻¹' (@inr α β '' u)) ∧
-         is_open (inr ⁻¹' (@inr α β '' u))) ∧
-        inr ⁻¹' (inr '' u) = u,
-      rw [preimage_inl_image_inr, preimage_image_eq u sum.inr_injective],
-      exact ⟨⟨is_open_empty, hu⟩, rfl⟩ }
-  end,
-  inj := λ _ _, inr.inj_iff.mp }
+lemma is_open_map_inr : is_open_map (@inr α β) :=
+λ u hu, by simpa [is_open_sum_iff, preimage_image_eq u sum.inr_injective]
+
+lemma open_embedding_inl : open_embedding (@inl α β) :=
+open_embedding_of_continuous_injective_open continuous_inl inl_injective is_open_map_inl
+
+lemma open_embedding_inr : open_embedding (@inr α β) :=
+open_embedding_of_continuous_injective_open continuous_inr inr_injective is_open_map_inr
+
+lemma embedding_inl : embedding (@inl α β) := open_embedding_inl.1
+
+lemma embedding_inr : embedding (@inr α β) := open_embedding_inr.1
 
-lemma is_open_range_inl : is_open (range (inl : α → α ⊕ β)) :=
-is_open_sum_iff.2 $ by simp
+lemma is_open_range_inl : is_open (range (inl : α → α ⊕ β)) := open_embedding_inl.2
 
-lemma is_open_range_inr : is_open (range (inr : β → α ⊕ β)) :=
-is_open_sum_iff.2 $ by simp
+lemma is_open_range_inr : is_open (range (inr : β → α ⊕ β)) := open_embedding_inr.2
 
 lemma is_closed_range_inl : is_closed (range (inl : α → α ⊕ β)) :=
 by { rw [← is_open_compl_iff, compl_range_inl], exact is_open_range_inr }
@@ -690,21 +752,49 @@ by { rw [← is_open_compl_iff, compl_range_inl], exact is_open_range_inr }
 lemma is_closed_range_inr : is_closed (range (inr : β → α ⊕ β)) :=
 by { rw [← is_open_compl_iff, compl_range_inr], exact is_open_range_inl }
 
-lemma open_embedding_inl : open_embedding (inl : α → α ⊕ β) :=
-{ open_range := is_open_range_inl,
-  .. embedding_inl }
-
-lemma open_embedding_inr : open_embedding (inr : β → α ⊕ β) :=
-{ open_range := is_open_range_inr,
-  .. embedding_inr }
-
 lemma closed_embedding_inl : closed_embedding (inl : α → α ⊕ β) :=
-{ closed_range := is_closed_range_inl,
-  .. embedding_inl }
+⟨embedding_inl, is_closed_range_inl⟩
 
 lemma closed_embedding_inr : closed_embedding (inr : β → α ⊕ β) :=
-{ closed_range := is_closed_range_inr,
-  .. embedding_inr }
+⟨embedding_inr, is_closed_range_inr⟩
+
+lemma nhds_inl (x : α) : 𝓝 (inl x : α ⊕ β) = map inl (𝓝 x) :=
+(open_embedding_inl.map_nhds_eq _).symm
+
+lemma nhds_inr (x : β) : 𝓝 (inr x : α ⊕ β) = map inr (𝓝 x) :=
+(open_embedding_inr.map_nhds_eq _).symm
+
+theorem continuous_sum_dom {f : α ⊕ β → γ} :
+    continuous f ↔ continuous (f ∘ sum.inl) ∧ continuous (f ∘ sum.inr) :=
+by simp only [continuous_sup_dom, continuous_coinduced_dom]
+
+lemma continuous_sum_elim {f : α → γ} {g : β → γ} :
+  continuous (sum.elim f g) ↔ continuous f ∧ continuous g :=
+continuous_sum_dom
+
+@[continuity] lemma continuous.sum_elim {f : α → γ} {g : β → γ}
+  (hf : continuous f) (hg : continuous g) : continuous (sum.elim f g) :=
+continuous_sum_elim.2 ⟨hf, hg⟩
+
+@[simp] lemma continuous_sum_map {f : α → β} {g : γ → δ} :
+  continuous (sum.map f g) ↔ continuous f ∧ continuous g :=
+continuous_sum_elim.trans $ embedding_inl.continuous_iff.symm.and embedding_inr.continuous_iff.symm
+
+@[continuity] lemma continuous.sum_map {f : α → β} {g : γ → δ} (hf : continuous f)
+  (hg : continuous g) : continuous (sum.map f g) :=
+continuous_sum_map.2 ⟨hf, hg⟩
+
+lemma is_open_map_sum {f : α ⊕ β → γ} :
+  is_open_map f ↔ is_open_map (λ a, f (inl a)) ∧ is_open_map (λ b, f (inr b)) :=
+by simp only [is_open_map_iff_nhds_le, sum.forall, nhds_inl, nhds_inr, filter.map_map]
+
+@[simp] lemma is_open_map_sum_elim {f : α → γ} {g : β → γ} :
+  is_open_map (sum.elim f g) ↔ is_open_map f ∧ is_open_map g :=
+by simp only [is_open_map_sum, elim_inl, elim_inr]
+
+lemma is_open_map.sum_elim {f : α → γ} {g : β → γ} (hf : is_open_map f) (hg : is_open_map g) :
+  is_open_map (sum.elim f g) :=
+is_open_map_sum_elim.2 ⟨hf, hg⟩
 
 end sum
 
@@ -753,17 +843,24 @@ lemma is_closed.closed_embedding_subtype_coe {s : set α} (hs : is_closed s) :
   inj := subtype.coe_injective,
   closed_range := (subtype.range_coe : range coe = s).symm ▸ hs }
 
-@[continuity] lemma continuous_subtype_mk {f : β → α}
-  (hp : ∀x, p (f x)) (h : continuous f) : continuous (λx, (⟨f x, hp x⟩ : subtype p)) :=
-continuous_induced_rng h
+@[continuity] lemma continuous.subtype_mk {f : β → α} (h : continuous f)
+  (hp : ∀x, p (f x)) : continuous (λx, (⟨f x, hp x⟩ : subtype p)) :=
+continuous_induced_rng.2 h
+
+lemma continuous.subtype_map {f : α → β} (h : continuous f) {q : β → Prop}
+  (hpq : ∀ x, p x → q (f x)) : continuous (subtype.map f hpq) :=
+(h.comp continuous_subtype_coe).subtype_mk _
 
 lemma continuous_inclusion {s t : set α} (h : s ⊆ t) : continuous (inclusion h) :=
-continuous_subtype_mk _ continuous_subtype_coe
+continuous_id.subtype_map h
 
 lemma continuous_at_subtype_coe {p : α → Prop} {a : subtype p} :
   continuous_at (coe : subtype p → α) a :=
 continuous_iff_continuous_at.mp continuous_subtype_coe _
 
+lemma subtype.dense_iff {s : set α} {t : set s} : dense t ↔ s ⊆ closure (coe '' t) :=
+by { rw [inducing_coe.dense_iff, set_coe.forall], refl }
+
 lemma map_nhds_subtype_coe_eq {a : α} (ha : p a) (h : {a | p a} ∈ 𝓝 a) :
   map (coe : subtype p → α) (𝓝 ⟨a, ha⟩) = 𝓝 a :=
 map_nhds_induced_of_mem $ by simpa only [subtype.coe_mk, subtype.range_coe] using h
@@ -776,49 +873,26 @@ lemma tendsto_subtype_rng {β : Type*} {p : α → Prop} {b : filter β} {f : β
   ∀{a:subtype p}, tendsto f b (𝓝 a) ↔ tendsto (λx, (f x : α)) b (𝓝 (a : α))
 | ⟨a, ha⟩ := by rw [nhds_subtype_eq_comap, tendsto_comap_iff, subtype.coe_mk]
 
-lemma continuous_subtype_nhds_cover {ι : Sort*} {f : α → β} {c : ι → α → Prop}
-  (c_cover : ∀x:α, ∃i, {x | c i x} ∈ 𝓝 x)
-  (f_cont  : ∀i, continuous (λ(x : subtype (c i)), f x)) :
-  continuous f :=
-continuous_iff_continuous_at.mpr $ assume x,
-  let ⟨i, (c_sets : {x | c i x} ∈ 𝓝 x)⟩ := c_cover x in
-  let x' : subtype (c i) := ⟨x, mem_of_mem_nhds c_sets⟩ in
-  calc map f (𝓝 x) = map f (map coe (𝓝 x')) :
-      congr_arg (map f) (map_nhds_subtype_coe_eq _ $ c_sets).symm
-    ... = map (λx:subtype (c i), f x) (𝓝 x') : rfl
-    ... ≤ 𝓝 (f x) : continuous_iff_continuous_at.mp (f_cont i) x'
-
-lemma continuous_subtype_is_closed_cover {ι : Sort*} {f : α → β} (c : ι → α → Prop)
-  (h_lf : locally_finite (λi, {x | c i x}))
-  (h_is_closed : ∀i, is_closed {x | c i x})
-  (h_cover : ∀x, ∃i, c i x)
-  (f_cont  : ∀i, continuous (λ(x : subtype (c i)), f x)) :
-  continuous f :=
-continuous_iff_is_closed.mpr $
-  assume s hs,
-  have ∀i, is_closed ((coe : {x | c i x} → α) '' (f ∘ coe ⁻¹' s)),
-    from assume i,
-    (closed_embedding_subtype_coe (h_is_closed _)).is_closed_map _ (hs.preimage (f_cont i)),
-  have is_closed (⋃i, (coe : {x | c i x} → α) '' (f ∘ coe ⁻¹' s)),
-    from locally_finite.is_closed_Union
-      (h_lf.subset $ assume i x ⟨⟨x', hx'⟩, _, heq⟩, heq ▸ hx')
-      this,
-  have f ⁻¹' s = (⋃i, (coe : {x | c i x} → α) '' (f ∘ coe ⁻¹' s)),
-  begin
-    apply set.ext,
-    have : ∀ (x : α), f x ∈ s ↔ ∃ (i : ι), c i x ∧ f x ∈ s :=
-      λ x, ⟨λ hx, let ⟨i, hi⟩ := h_cover x in ⟨i, hi, hx⟩,
-            λ ⟨i, hi, hx⟩, hx⟩,
-    simpa [and.comm, @and.left_comm (c _ _), ← exists_and_distrib_right],
-  end,
-  by rwa [this]
-
 lemma closure_subtype {x : {a // p a}} {s : set {a // p a}}:
   x ∈ closure s ↔ (x : α) ∈ closure ((coe : _ → α) '' s) :=
 closure_induced
 
+lemma continuous_at_cod_restrict_iff {f : α → β} {t : set β} (h1 : ∀ x, f x ∈ t) {x : α} :
+  continuous_at (cod_restrict f t h1) x ↔ continuous_at f x :=
+by simp_rw [inducing_coe.continuous_at_iff, function.comp, coe_cod_restrict_apply]
+
+alias continuous_at_cod_restrict_iff ↔ _ continuous_at.cod_restrict
+
+lemma continuous_at.restrict {f : α → β} {s : set α} {t : set β} (h1 : maps_to f s t) {x : s}
+  (h2 : continuous_at f x) : continuous_at (h1.restrict f s t) x :=
+(h2.comp continuous_at_subtype_coe).cod_restrict _
+
+lemma continuous_at.restrict_preimage {f : α → β} {s : set β} {x : f ⁻¹' s}
+  (h : continuous_at f x) : continuous_at (s.restrict_preimage f) x :=
+h.restrict _
+
 @[continuity] lemma continuous.cod_restrict {f : α → β} {s : set β} (hf : continuous f)
-  (hs : ∀ a, f a ∈ s) : continuous (s.cod_restrict f hs) := continuous_subtype_mk hs hf
+  (hs : ∀ a, f a ∈ s) : continuous (s.cod_restrict f hs) := hf.subtype_mk hs
 
 lemma inducing.cod_restrict {e : α → β} (he : inducing e) {s : set β} (hs : ∀ x, e x ∈ s) :
   inducing (cod_restrict e s hs) :=
@@ -828,6 +902,16 @@ lemma embedding.cod_restrict {e : α → β} (he : embedding e) (s : set β) (hs
   embedding (cod_restrict e s hs) :=
 embedding_of_embedding_compose (he.continuous.cod_restrict hs) continuous_subtype_coe he
 
+lemma embedding_inclusion {s t : set α} (h : s ⊆ t) : embedding (set.inclusion h) :=
+embedding_subtype_coe.cod_restrict _ _
+
+/-- Let `s, t ⊆ X` be two subsets of a topological space `X`.  If `t ⊆ s` and the topology induced
+by `X`on `s` is discrete, then also the topology induces on `t` is discrete.  -/
+lemma discrete_topology.of_subset {X : Type*} [topological_space X] {s t : set X}
+  (ds : discrete_topology s) (ts : t ⊆ s) :
+  discrete_topology t :=
+(embedding_inclusion ts).discrete_topology
+
 end subtype
 
 section quotient
@@ -842,7 +926,7 @@ continuous_coinduced_rng
 
 @[continuity] lemma continuous_quot_lift {f : α → β} (hr : ∀ a b, r a b → f a = f b)
   (h : continuous f) : continuous (quot.lift f hr : quot r → β) :=
-continuous_coinduced_dom h
+continuous_coinduced_dom.2 h
 
 lemma quotient_map_quotient_mk : quotient_map (@quotient.mk α s) :=
 quotient_map_quot_mk
@@ -850,133 +934,176 @@ quotient_map_quot_mk
 lemma continuous_quotient_mk : continuous (@quotient.mk α s) :=
 continuous_coinduced_rng
 
-lemma continuous_quotient_lift {f : α → β} (hs : ∀ a b, a ≈ b → f a = f b)
-  (h : continuous f) : continuous (quotient.lift f hs : quotient s → β) :=
-continuous_coinduced_dom h
+lemma continuous.quotient_lift {f : α → β} (h : continuous f) (hs : ∀ a b, a ≈ b → f a = f b) :
+  continuous (quotient.lift f hs : quotient s → β) :=
+continuous_coinduced_dom.2 h
 
-lemma continuous_quotient_lift_on' {f : α → β} (hs : ∀ a b, a ≈ b → f a = f b)
-  (h : continuous f) : continuous (λ x, quotient.lift_on' x f hs : quotient s → β) :=
-continuous_coinduced_dom h
+lemma continuous.quotient_lift_on' {f : α → β} (h : continuous f)
+  (hs : ∀ a b, @setoid.r _ s a b → f a = f b) :
+  continuous (λ x, quotient.lift_on' x f hs : quotient s → β) :=
+h.quotient_lift hs
+
+lemma continuous.quotient_map' {t : setoid β} {f : α → β} (hf : continuous f)
+  (H : (s.r ⇒ t.r) f f) : continuous (quotient.map' f H) :=
+(continuous_quotient_mk.comp hf).quotient_lift _
 
 end quotient
 
 section pi
-variables {ι : Type*} {π : ι → Type*}
+variables {ι : Type*} {π : ι → Type*} {κ : Type*}
+  [topological_space α] [∀i, topological_space (π i)] {f : α → Πi:ι, π i}
 
-@[continuity]
-lemma continuous_pi [topological_space α] [∀i, topological_space (π i)] {f : α → Πi:ι, π i}
-  (h : ∀i, continuous (λa, f a i)) : continuous f :=
-continuous_infi_rng $ assume i, continuous_induced_rng $ h i
+lemma continuous_pi_iff : continuous f ↔ ∀ i, continuous (λ a, f a i) :=
+by simp only [continuous_infi_rng, continuous_induced_rng]
 
-@[continuity]
-lemma continuous_apply [∀i, topological_space (π i)] (i : ι) :
-  continuous (λp:Πi, π i, p i) :=
+@[continuity] lemma continuous_pi (h : ∀ i, continuous (λ a, f a i)) : continuous f :=
+continuous_pi_iff.2 h
+
+@[continuity] lemma continuous_apply (i : ι) : continuous (λp:Πi, π i, p i) :=
 continuous_infi_dom continuous_induced_dom
 
 @[continuity]
-lemma continuous_apply_apply {κ : Type*} {ρ : κ → ι → Type*}
-  [∀ j i, topological_space (ρ j i)] (j : κ) (i : ι) :
-  continuous (λ p : (Π j, Π i, ρ j i), p j i) :=
+lemma continuous_apply_apply {ρ : κ → ι → Type*} [∀ j i, topological_space (ρ j i)]
+  (j : κ) (i : ι) : continuous (λ p : (Π j, Π i, ρ j i), p j i) :=
 (continuous_apply i).comp (continuous_apply j)
 
-lemma continuous_at_apply [∀i, topological_space (π i)] (i : ι) (x : Π i, π i) :
-  continuous_at (λ p : Π i, π i, p i) x :=
+lemma continuous_at_apply (i : ι) (x : Π i, π i) : continuous_at (λ p : Π i, π i, p i) x :=
 (continuous_apply i).continuous_at
 
-lemma filter.tendsto.apply [∀i, topological_space (π i)] {l : filter α} {f : α → Π i, π i}
+lemma filter.tendsto.apply {l : filter β} {f : β → Π i, π i}
   {x : Π i, π i} (h : tendsto f l (𝓝 x)) (i : ι) :
   tendsto (λ a, f a i) l (𝓝 $ x i) :=
 (continuous_at_apply i _).tendsto.comp h
 
-lemma continuous_pi_iff [topological_space α] [∀ i, topological_space (π i)] {f : α → Π i, π i} :
-  continuous f ↔ ∀ i, continuous (λ y, f y i) :=
-iff.intro (λ h i, (continuous_apply i).comp h) continuous_pi
-
-lemma nhds_pi [t : ∀i, topological_space (π i)] {a : Πi, π i} :
-  𝓝 a = pi (λ i, 𝓝 (a i)) :=
-calc 𝓝 a = (⨅i, @nhds _ (@topological_space.induced _ _ (λx:Πi, π i, x i) (t i)) a) : nhds_infi
-  ... = (⨅i, comap (λx, x i) (𝓝 (a i))) : by simp [nhds_induced]
+lemma nhds_pi {a : Πi, π i} : 𝓝 a = pi (λ i, 𝓝 (a i)) :=
+by simp only [nhds_infi, nhds_induced, filter.pi]
 
-lemma tendsto_pi_nhds [t : ∀i, topological_space (π i)] {f : α → Πi, π i} {g : Πi, π i}
-  {u : filter α} :
+lemma tendsto_pi_nhds {f : β → Πi, π i} {g : Πi, π i} {u : filter β} :
   tendsto f u (𝓝 g) ↔ ∀ x, tendsto (λ i, f i x) u (𝓝 (g x)) :=
 by rw [nhds_pi, filter.tendsto_pi]
 
-lemma continuous_at_pi [∀ i, topological_space (π i)] [topological_space α] {f : α → Π i, π i}
-  {x : α} :
+lemma continuous_at_pi {f : α → Π i, π i} {x : α} :
   continuous_at f x ↔ ∀ i, continuous_at (λ y, f y i) x :=
 tendsto_pi_nhds
 
-lemma filter.tendsto.update [∀i, topological_space (π i)] [decidable_eq ι]
-  {l : filter α} {f : α → Π i, π i} {x : Π i, π i} (hf : tendsto f l (𝓝 x)) (i : ι)
-  {g : α → π i} {xi : π i} (hg : tendsto g l (𝓝 xi)) :
-  tendsto (λ a, function.update (f a) i (g a)) l (𝓝 $ function.update x i xi) :=
+lemma filter.tendsto.update [decidable_eq ι]
+  {l : filter β} {f : β → Π i, π i} {x : Π i, π i} (hf : tendsto f l (𝓝 x)) (i : ι)
+  {g : β → π i} {xi : π i} (hg : tendsto g l (𝓝 xi)) :
+  tendsto (λ a, update (f a) i (g a)) l (𝓝 $ update x i xi) :=
 tendsto_pi_nhds.2 $ λ j, by { rcases em (j = i) with rfl|hj; simp [*, hf.apply] }
 
-lemma continuous_at.update [∀i, topological_space (π i)] [topological_space α] [decidable_eq ι]
-  {f : α → Π i, π i} {a : α} (hf : continuous_at f a) (i : ι) {g : α → π i}
+lemma continuous_at.update [decidable_eq ι] {a : α} (hf : continuous_at f a) (i : ι) {g : α → π i}
   (hg : continuous_at g a) :
-  continuous_at (λ a, function.update (f a) i (g a)) a :=
+  continuous_at (λ a, update (f a) i (g a)) a :=
 hf.update i hg
 
-lemma continuous.update [∀i, topological_space (π i)] [topological_space α] [decidable_eq ι]
-  {f : α → Π i, π i} (hf : continuous f) (i : ι) {g : α → π i} (hg : continuous g) :
-  continuous (λ a, function.update (f a) i (g a)) :=
+lemma continuous.update [decidable_eq ι] (hf : continuous f) (i : ι) {g : α → π i}
+  (hg : continuous g) :
+  continuous (λ a, update (f a) i (g a)) :=
 continuous_iff_continuous_at.2 $ λ x, hf.continuous_at.update i hg.continuous_at
 
 /-- `function.update f i x` is continuous in `(f, x)`. -/
-@[continuity] lemma continuous_update [∀i, topological_space (π i)] [decidable_eq ι] (i : ι) :
-  continuous (λ f : (Π j, π j) × π i, function.update f.1 i f.2) :=
+@[continuity] lemma continuous_update [decidable_eq ι] (i : ι) :
+  continuous (λ f : (Π j, π j) × π i, update f.1 i f.2) :=
 continuous_fst.update i continuous_snd
 
+/-- `pi.mul_single i x` is continuous in `x`. -/
+@[continuity, to_additive "`pi.single i x` is continuous in `x`."]
+lemma continuous_mul_single [Π i, has_one (π i)] [decidable_eq ι] (i : ι) :
+  continuous (λ x, (pi.mul_single i x : Π i, π i)) :=
+continuous_const.update _ continuous_id
+
 lemma filter.tendsto.fin_insert_nth {n} {π : fin (n + 1) → Type*} [Π i, topological_space (π i)]
-  (i : fin (n + 1)) {f : α → π i} {l : filter α} {x : π i} (hf : tendsto f l (𝓝 x))
-  {g : α → Π j : fin n, π (i.succ_above j)} {y : Π j, π (i.succ_above j)} (hg : tendsto g l (𝓝 y)) :
+  (i : fin (n + 1)) {f : β → π i} {l : filter β} {x : π i} (hf : tendsto f l (𝓝 x))
+  {g : β → Π j : fin n, π (i.succ_above j)} {y : Π j, π (i.succ_above j)} (hg : tendsto g l (𝓝 y)) :
   tendsto (λ a, i.insert_nth (f a) (g a)) l (𝓝 $ i.insert_nth x y) :=
 tendsto_pi_nhds.2 (λ j, fin.succ_above_cases i (by simpa) (by simpa using tendsto_pi_nhds.1 hg) j)
 
 lemma continuous_at.fin_insert_nth {n} {π : fin (n + 1) → Type*} [Π i, topological_space (π i)]
-  [topological_space α] (i : fin (n + 1)) {f : α → π i} {a : α} (hf : continuous_at f a)
+  (i : fin (n + 1)) {f : α → π i} {a : α} (hf : continuous_at f a)
   {g : α → Π j : fin n, π (i.succ_above j)} (hg : continuous_at g a) :
   continuous_at (λ a, i.insert_nth (f a) (g a)) a :=
 hf.fin_insert_nth i hg
 
 lemma continuous.fin_insert_nth {n} {π : fin (n + 1) → Type*} [Π i, topological_space (π i)]
-  [topological_space α] (i : fin (n + 1)) {f : α → π i} (hf : continuous f)
+  (i : fin (n + 1)) {f : α → π i} (hf : continuous f)
   {g : α → Π j : fin n, π (i.succ_above j)} (hg : continuous g) :
   continuous (λ a, i.insert_nth (f a) (g a)) :=
 continuous_iff_continuous_at.2 $ λ a, hf.continuous_at.fin_insert_nth i hg.continuous_at
 
-lemma is_open_set_pi [∀a, topological_space (π a)] {i : set ι} {s : Πa, set (π a)}
-  (hi : finite i) (hs : ∀a∈i, is_open (s a)) : is_open (pi i s) :=
+lemma is_open_set_pi {i : set ι} {s : Πa, set (π a)} (hi : i.finite) (hs : ∀a∈i, is_open (s a)) :
+  is_open (pi i s) :=
 by rw [pi_def]; exact (is_open_bInter hi $ assume a ha, (hs _ ha).preimage (continuous_apply _))
 
-lemma is_closed_set_pi [∀a, topological_space (π a)] {i : set ι} {s : Πa, set (π a)}
-  (hs : ∀a∈i, is_closed (s a)) : is_closed (pi i s) :=
+lemma is_open_pi_iff {s : set (Π a, π a)} :
+  is_open s ↔
+  (∀ f, f ∈ s → ∃ (I : finset ι) (u : Π a, set (π a)),
+    (∀ a, a ∈ I → is_open (u a) ∧ f a ∈ u a) ∧ (I : set ι).pi u ⊆ s) :=
+begin
+  rw is_open_iff_nhds,
+  simp_rw [le_principal_iff, nhds_pi, filter.mem_pi', mem_nhds_iff, exists_prop],
+  refine ball_congr (λ a h, ⟨_, _⟩),
+  { rintros ⟨I, t, ⟨h1, h2⟩⟩,
+    refine ⟨I, λ a, eval a '' ((I : set ι).pi (λ a, (h1 a).some)), (λ i hi, _), _⟩,
+    { simp_rw set.eval_image_pi (finset.mem_coe.mpr hi)
+        (pi_nonempty_iff.mpr (λ i, ⟨_, λ _, (h1 i).some_spec.2.2⟩)),
+      exact (h1 i).some_spec.2, },
+    { refine subset.trans
+        (set.pi_mono (λ i hi, (set.eval_image_pi_subset hi).trans (h1 i).some_spec.1)) h2, }},
+  { rintros ⟨I, t, ⟨h1, h2⟩⟩,
+    refine ⟨I, λ a, ite (a ∈ I) (t a) (set.univ), (λ i, _), _⟩,
+    { by_cases hi : i ∈ I,
+      { use t i,
+        rw if_pos hi,
+        exact ⟨subset.rfl, (h1 i) hi⟩, },
+      { use set.univ,
+        rw if_neg hi,
+        exact ⟨subset.rfl, is_open_univ, mem_univ _⟩, }},
+    { rw ← set.univ_pi_ite,
+      simp only [ ← ite_and, ← finset.mem_coe, and_self, set.univ_pi_ite, h2], }}
+end
+
+lemma is_open_pi_iff' [finite ι]  {s : set (Π a, π a)} :
+  is_open s ↔
+  (∀ f, f ∈ s → ∃ (u : Π a, set (π a)), (∀ a, is_open (u a) ∧ f a ∈ u a) ∧ set.univ.pi u ⊆ s) :=
+begin
+  casesI nonempty_fintype ι,
+  rw is_open_iff_nhds,
+  simp_rw [le_principal_iff, nhds_pi, filter.mem_pi', mem_nhds_iff, exists_prop],
+  refine ball_congr (λ a h, ⟨_, _⟩),
+  { rintros ⟨I, t, ⟨h1, h2⟩⟩,
+    refine ⟨λ i, (h1 i).some, ⟨λ i, (h1 i).some_spec.2,
+        (set.pi_mono (λ i _, (h1 i).some_spec.1)).trans (subset.trans _ h2)⟩⟩,
+    rw ← set.pi_inter_compl (I : set ι),
+    exact inter_subset_left _ _, },
+  { exact λ ⟨u, ⟨h1, _⟩⟩, ⟨finset.univ, u, ⟨λ i, ⟨u i, ⟨rfl.subset, h1 i⟩⟩,
+      by rwa finset.coe_univ⟩⟩, }
+end
+
+lemma is_closed_set_pi {i : set ι} {s : Πa, set (π a)} (hs : ∀a∈i, is_closed (s a)) :
+  is_closed (pi i s) :=
 by rw [pi_def];
   exact (is_closed_Inter $ λ a, is_closed_Inter $ λ ha, (hs _ ha).preimage (continuous_apply _))
 
-lemma mem_nhds_of_pi_mem_nhds {ι : Type*} {α : ι → Type*} [Π (i : ι), topological_space (α i)]
-  {I : set ι} {s : Π i, set (α i)} (a : Π i, α i) (hs : I.pi s ∈ 𝓝 a) {i : ι} (hi : i ∈ I) :
+lemma mem_nhds_of_pi_mem_nhds {I : set ι} {s : Π i, set (π i)} (a : Π i, π i) (hs : I.pi s ∈ 𝓝 a)
+  {i : ι} (hi : i ∈ I) :
   s i ∈ 𝓝 (a i) :=
 by { rw nhds_pi at hs, exact mem_of_pi_mem_pi hs hi }
 
-lemma set_pi_mem_nhds [Π a, topological_space (π a)] {i : set ι} {s : Π a, set (π a)}
-  {x : Π a, π a} (hi : finite i) (hs : ∀ a ∈ i, s a ∈ 𝓝 (x a)) :
+lemma set_pi_mem_nhds {i : set ι} {s : Π a, set (π a)}
+  {x : Π a, π a} (hi : i.finite) (hs : ∀ a ∈ i, s a ∈ 𝓝 (x a)) :
   pi i s ∈ 𝓝 x :=
 by { rw [pi_def, bInter_mem hi], exact λ a ha, (continuous_apply a).continuous_at (hs a ha) }
 
-lemma set_pi_mem_nhds_iff {α : ι → Type*} [Π (i : ι), topological_space (α i)]
-  {I : set ι} (hI : I.finite) {s : Π i, set (α i)} (a : Π i, α i) :
+lemma set_pi_mem_nhds_iff {I : set ι} (hI : I.finite) {s : Π i, set (π i)} (a : Π i, π i) :
   I.pi s ∈ 𝓝 a ↔ ∀ (i : ι), i ∈ I → s i ∈ 𝓝 (a i) :=
 by { rw [nhds_pi, pi_mem_pi_iff hI], apply_instance }
 
-lemma interior_pi_set {α : ι → Type*} [Π i, topological_space (α i)]
-  {I : set ι} (hI : I.finite) {s : Π i, set (α i)} :
+lemma interior_pi_set {I : set ι} (hI : I.finite) {s : Π i, set (π i)} :
   interior (pi I s) = I.pi (λ i, interior (s i)) :=
 by { ext a, simp only [set.mem_pi, mem_interior_iff_mem_nhds, set_pi_mem_nhds_iff hI] }
 
-lemma exists_finset_piecewise_mem_of_mem_nhds [decidable_eq ι] [Π i, topological_space (π i)]
+lemma exists_finset_piecewise_mem_of_mem_nhds [decidable_eq ι]
   {s : set (Π a, π a)} {x : Π a, π a} (hs : s ∈ 𝓝 x) (y : Π a, π a) :
   ∃ I : finset ι, I.piecewise x y ∈ s :=
 begin
@@ -986,37 +1113,39 @@ begin
   simpa [finset.mem_coe.1 hi] using mem_of_mem_nhds (htx i)
 end
 
-lemma pi_eq_generate_from [∀a, topological_space (π a)] :
+lemma pi_eq_generate_from :
   Pi.topological_space =
   generate_from {g | ∃(s:Πa, set (π a)) (i : finset ι), (∀a∈i, is_open (s a)) ∧ g = pi ↑i s} :=
 le_antisymm
   (le_generate_from $ assume g ⟨s, i, hi, eq⟩, eq.symm ▸ is_open_set_pi (finset.finite_to_set _) hi)
   (le_infi $ assume a s ⟨t, ht, s_eq⟩, generate_open.basic _ $
-    ⟨function.update (λa, univ) a t, {a}, by simpa using ht, s_eq ▸ by ext f; simp [set.pi]⟩)
+    ⟨update (λa, univ) a t, {a}, by simpa using ht, s_eq ▸ by ext f; simp [set.pi]⟩)
 
-lemma pi_generate_from_eq {g : Πa, set (set (π a))} :
+lemma pi_generate_from_eq {π : ι → Type*} {g : Πa, set (set (π a))} :
   @Pi.topological_space ι π (λa, generate_from (g a)) =
   generate_from {t | ∃(s:Πa, set (π a)) (i : finset ι), (∀a∈i, s a ∈ g a) ∧ t = pi ↑i s} :=
 let G := {t | ∃(s:Πa, set (π a)) (i : finset ι), (∀a∈i, s a ∈ g a) ∧ t = pi ↑i s} in
 begin
   rw [pi_eq_generate_from],
-  refine le_antisymm (generate_from_mono _) (le_generate_from _),
+  refine le_antisymm (generate_from_anti _) (le_generate_from _),
   exact assume s ⟨t, i, ht, eq⟩, ⟨t, i, assume a ha, generate_open.basic _ (ht a ha), eq⟩,
   { rintros s ⟨t, i, hi, rfl⟩,
     rw [pi_def],
     apply is_open_bInter (finset.finite_to_set _),
     assume a ha, show ((generate_from G).coinduced (λf:Πa, π a, f a)).is_open (t a),
     refine le_generate_from _ _ (hi a ha),
-    exact assume s hs, generate_open.basic _ ⟨function.update (λa, univ) a s, {a}, by simp [hs]⟩ }
+    exact assume s hs, generate_open.basic _ ⟨update (λa, univ) a s, {a}, by simp [hs]⟩ }
 end
 
-lemma pi_generate_from_eq_fintype {g : Πa, set (set (π a))} [fintype ι] (hg : ∀a, ⋃₀ g a = univ) :
+lemma pi_generate_from_eq_finite {π : ι → Type*} {g : Πa, set (set (π a))} [finite ι]
+  (hg : ∀a, ⋃₀ g a = univ) :
   @Pi.topological_space ι π (λa, generate_from (g a)) =
   generate_from {t | ∃(s:Πa, set (π a)), (∀a, s a ∈ g a) ∧ t = pi univ s} :=
 begin
+  casesI nonempty_fintype ι,
   rw [pi_generate_from_eq],
-  refine le_antisymm (generate_from_mono _) (le_generate_from _),
-  exact assume s ⟨t, ht, eq⟩, ⟨t, finset.univ, by simp [ht, eq]⟩,
+  refine le_antisymm (generate_from_anti _) (le_generate_from _),
+  { rintro s ⟨t, ht, rfl⟩, exact ⟨t, finset.univ, by simp [ht]⟩ },
   { rintros s ⟨t, i, ht, rfl⟩,
     apply is_open_iff_forall_mem_open.2 _,
     assume f hf,
@@ -1035,7 +1164,7 @@ endowed with a family of maps `f i : X → π i` for every `i : ι`, hence induc
 map `g : X → Π i, π i`. This lemma shows that infimum of the topologies on `X` induced by
 the `f i` as `i : ι` varies is simply the topology on `X` induced by `g : X → Π i, π i`
 where `Π i, π i` is endowed with the usual product topology. -/
-lemma inducing_infi_to_pi {X : Type*} [∀ i, topological_space (π i)] (f : Π i, X → π i) :
+lemma inducing_infi_to_pi {X : Type*} (f : Π i, X → π i) :
   @inducing X (Π i, π i) (⨅ i, induced (f i) infer_instance) _ (λ x i, f i x) :=
 begin
   constructor,
@@ -1045,21 +1174,22 @@ begin
   erw induced_compose,
 end
 
-variables [fintype ι] [∀ i, topological_space (π i)] [∀ i, discrete_topology (π i)]
+variables [finite ι] [∀ i, discrete_topology (π i)]
 
 /-- A finite product of discrete spaces is discrete. -/
 instance Pi.discrete_topology : discrete_topology (Π i, π i) :=
 singletons_open_iff_discrete.mp (λ x,
 begin
   rw show {x} = ⋂ i, {y : Π i, π i | y i = x i},
-  { ext, simp only [function.funext_iff, set.mem_singleton_iff, set.mem_Inter, set.mem_set_of_eq] },
+  { ext, simp only [funext_iff, set.mem_singleton_iff, set.mem_Inter, set.mem_set_of_eq] },
   exact is_open_Inter (λ i, (continuous_apply i).is_open_preimage {x i} (is_open_discrete {x i}))
 end)
 
 end pi
 
 section sigma
-variables {ι : Type*} {σ : ι → Type*} [Π i, topological_space (σ i)]
+variables {ι κ : Type*} {σ : ι → Type*} {τ : κ → Type*}
+  [Π i, topological_space (σ i)] [Π k, topological_space (τ k)] [topological_space α]
 
 @[continuity]
 lemma continuous_sigma_mk {i : ι} : continuous (@sigma.mk ι σ i) :=
@@ -1076,13 +1206,10 @@ begin
   intros s hs,
   rw is_open_sigma_iff,
   intro j,
-  rcases eq_or_ne i j with (rfl|hne),
+  rcases eq_or_ne j i with (rfl|hne),
   { rwa set.preimage_image_eq _ sigma_mk_injective },
-  { convert is_open_empty,
-    apply set.eq_empty_of_subset_empty,
-    rintro x ⟨y, _, hy⟩,
-    have : i = j, by cc,
-    contradiction }
+  { rw [preimage_image_sigma_mk_of_ne hne],
+    exact is_open_empty }
 end
 
 lemma is_open_range_sigma_mk {i : ι} : is_open (set.range (@sigma.mk ι σ i)) :=
@@ -1093,17 +1220,14 @@ begin
   intros s hs,
   rw is_closed_sigma_iff,
   intro j,
-  rcases eq_or_ne i j with (rfl|hne),
+  rcases eq_or_ne j i with (rfl|hne),
   { rwa set.preimage_image_eq _ sigma_mk_injective },
-  { convert is_closed_empty,
-    apply set.eq_empty_of_subset_empty,
-    rintro x ⟨y, _, hy⟩,
-    have : i = j, by cc,
-    contradiction }
+  { rw [preimage_image_sigma_mk_of_ne hne],
+    exact is_closed_empty }
 end
 
-lemma is_closed_sigma_mk {i : ι} : is_closed (set.range (@sigma.mk ι σ i)) :=
-by { rw ←set.image_univ, exact is_closed_map_sigma_mk _ is_closed_univ }
+lemma is_closed_range_sigma_mk {i : ι} : is_closed (set.range (@sigma.mk ι σ i)) :=
+is_closed_map_sigma_mk.closed_range
 
 lemma open_embedding_sigma_mk {i : ι} : open_embedding (@sigma.mk ι σ i) :=
 open_embedding_of_continuous_injective_open
@@ -1116,6 +1240,15 @@ closed_embedding_of_continuous_injective_closed
 lemma embedding_sigma_mk {i : ι} : embedding (@sigma.mk ι σ i) :=
 closed_embedding_sigma_mk.1
 
+lemma sigma.nhds_mk (i : ι) (x : σ i) : 𝓝 (⟨i, x⟩ : sigma σ) = map (sigma.mk i) (𝓝 x) :=
+(open_embedding_sigma_mk.map_nhds_eq x).symm
+
+lemma sigma.nhds_eq (x : sigma σ) : 𝓝 x = map (sigma.mk x.1) (𝓝 x.2) :=
+by { cases x, apply sigma.nhds_mk }
+
+lemma comap_sigma_mk_nhds (i : ι) (x : σ i) : comap (sigma.mk i) (𝓝 ⟨i, x⟩) = 𝓝 x :=
+(embedding_sigma_mk.to_inducing.nhds_eq_comap _).symm
+
 lemma is_open_sigma_fst_preimage (s : set ι) :  is_open (sigma.fst ⁻¹' s : set (Σ a, σ a)) :=
 begin
   rw [← bUnion_of_singleton s, preimage_Union₂],
@@ -1123,65 +1256,47 @@ begin
   exact is_open_bUnion (λ _ _, is_open_range_sigma_mk)
 end
 
+/-- A map out of a sum type is continuous iff its restriction to each summand is. -/
+@[simp] lemma continuous_sigma_iff {f : sigma σ → α} :
+  continuous f ↔ ∀ i, continuous (λ a, f ⟨i, a⟩) :=
+by simp only [continuous_supr_dom, continuous_coinduced_dom]
+
 /-- A map out of a sum type is continuous if its restriction to each summand is. -/
-@[continuity]
-lemma continuous_sigma [topological_space β] {f : sigma σ → β}
-  (h : ∀ i, continuous (λ a, f ⟨i, a⟩)) : continuous f :=
-continuous_supr_dom (λ i, continuous_coinduced_dom (h i))
+@[continuity] lemma continuous_sigma {f : sigma σ → α} (hf : ∀ i, continuous (λ a, f ⟨i, a⟩)) :
+  continuous f :=
+continuous_sigma_iff.2 hf
 
-@[continuity]
-lemma continuous_sigma_map {κ : Type*} {τ : κ → Type*} [Π k, topological_space (τ k)]
-  {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)} (hf : ∀ i, continuous (f₂ i)) :
+@[simp] lemma continuous_sigma_map {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)} :
+  continuous (sigma.map f₁ f₂) ↔ ∀ i, continuous (f₂ i) :=
+continuous_sigma_iff.trans $ by simp only [sigma.map, embedding_sigma_mk.continuous_iff]
+
+@[continuity] lemma continuous.sigma_map {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)}
+  (hf : ∀ i, continuous (f₂ i)) :
   continuous (sigma.map f₁ f₂) :=
-continuous_sigma $ λ i,
-  show continuous (λ a, sigma.mk (f₁ i) (f₂ i a)),
-  from continuous_sigma_mk.comp (hf i)
+continuous_sigma_map.2 hf
 
-lemma is_open_map_sigma [topological_space β] {f : sigma σ → β}
-  (h : ∀ i, is_open_map (λ a, f ⟨i, a⟩)) : is_open_map f :=
-begin
-  intros s hs,
-  rw is_open_sigma_iff at hs,
-  rw [← Union_image_preimage_sigma_mk_eq_self s, image_Union],
-  apply is_open_Union,
-  intro i,
-  rw [image_image],
-  exact h i _ (hs i)
-end
+lemma is_open_map_sigma {f : sigma σ → α} : is_open_map f ↔ ∀ i, is_open_map (λ a, f ⟨i, a⟩) :=
+by simp only [is_open_map_iff_nhds_le, sigma.forall, sigma.nhds_eq, map_map]
 
-/-- The sum of embeddings is an embedding. -/
-lemma embedding_sigma_map {τ : ι → Type*} [Π i, topological_space (τ i)]
-  {f : Π i, σ i → τ i} (hf : ∀ i, embedding (f i)) : embedding (sigma.map id f) :=
-begin
-  refine ⟨⟨_⟩, function.injective_id.sigma_map (λ i, (hf i).inj)⟩,
-  refine le_antisymm
-    (continuous_iff_le_induced.mp (continuous_sigma_map (λ i, (hf i).continuous))) _,
-  intros s hs,
-  replace hs := is_open_sigma_iff.mp hs,
-  have : ∀ i, ∃ t, is_open t ∧ f i ⁻¹' t = sigma.mk i ⁻¹' s,
-  { intro i,
-    apply is_open_induced_iff.mp,
-    convert hs i,
-    exact (hf i).induced.symm },
-  choose t ht using this,
-  apply is_open_induced_iff.mpr,
-  refine ⟨⋃ i, sigma.mk i '' t i, is_open_Union (λ i, is_open_map_sigma_mk _ (ht i).1), _⟩,
-  ext ⟨i, x⟩,
-  change (sigma.mk i (f i x) ∈ ⋃ (i : ι), sigma.mk i '' t i) ↔ x ∈ sigma.mk i ⁻¹' s,
-  rw [←(ht i).2, mem_Union],
-  split,
-  { rintro ⟨j, hj⟩,
-    rw mem_image at hj,
-    rcases hj with ⟨y, hy₁, hy₂⟩,
-    rcases sigma.mk.inj_iff.mp hy₂ with ⟨rfl, hy⟩,
-    replace hy := eq_of_heq hy,
-    subst y,
-    exact hy₁ },
-  { intro hx,
-    use i,
-    rw mem_image,
-    exact ⟨f i x, hx, rfl⟩ }
-end
+lemma is_open_map_sigma_map {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)} :
+  is_open_map (sigma.map f₁ f₂) ↔ ∀ i, is_open_map (f₂ i) :=
+is_open_map_sigma.trans $ forall_congr $
+  λ i, (@open_embedding_sigma_mk _ _ _ (f₁ i)).is_open_map_iff.symm
+
+lemma inducing_sigma_map {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)} (h₁ : injective f₁) :
+  inducing (sigma.map f₁ f₂) ↔ ∀ i, inducing (f₂ i) :=
+by simp only [inducing_iff_nhds, sigma.forall, sigma.nhds_mk, sigma.map, ← map_sigma_mk_comap h₁,
+  map_inj sigma_mk_injective]
+
+lemma embedding_sigma_map {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)} (h : injective f₁) :
+  embedding (sigma.map f₁ f₂) ↔ ∀ i, embedding (f₂ i) :=
+by simp only [embedding_iff, injective.sigma_map, inducing_sigma_map h, forall_and_distrib,
+  h.sigma_map_iff]
+
+lemma open_embedding_sigma_map {f₁ : ι → κ} {f₂ : Π i, σ i → τ (f₁ i)} (h : injective f₁) :
+  open_embedding (sigma.map f₁ f₂) ↔ ∀ i, open_embedding (f₂ i) :=
+by simp only [open_embedding_iff_embedding_open, is_open_map_sigma_map, embedding_sigma_map h,
+  forall_and_distrib]
 
 end sigma
 
@@ -1193,25 +1308,17 @@ continuous_induced_dom
 
 @[continuity] lemma continuous_ulift_up [topological_space α] :
   continuous (ulift.up : α → ulift.{v u} α) :=
-continuous_induced_rng continuous_id
+continuous_induced_rng.2 continuous_id
 
-end ulift
+lemma embedding_ulift_down [topological_space α] :
+  embedding (ulift.down : ulift.{v u} α → α) :=
+⟨⟨rfl⟩, ulift.down_injective⟩
 
-lemma mem_closure_of_continuous [topological_space α] [topological_space β]
-  {f : α → β} {a : α} {s : set α} {t : set β}
-  (hf : continuous f) (ha : a ∈ closure s) (h : maps_to f s (closure t)) :
-  f a ∈ closure t :=
-calc f a ∈ f '' closure s : mem_image_of_mem _ ha
-  ... ⊆ closure (f '' s) : image_closure_subset_closure_image hf
-  ... ⊆ closure t : closure_minimal h.image_subset is_closed_closure
-
-lemma mem_closure_of_continuous2 [topological_space α] [topological_space β] [topological_space γ]
-  {f : α → β → γ} {a : α} {b : β} {s : set α} {t : set β} {u : set γ}
-  (hf : continuous (λp:α×β, f p.1 p.2)) (ha : a ∈ closure s) (hb : b ∈ closure t)
-  (h : ∀a∈s, ∀b∈t, f a b ∈ closure u) :
-  f a b ∈ closure u :=
-have (a,b) ∈ closure (s ×ˢ t),
-  by simp [closure_prod_eq, ha, hb],
-show f (a, b).1 (a, b).2 ∈ closure u,
-  from @mem_closure_of_continuous (α×β) _ _ _ (λp:α×β, f p.1 p.2) (a,b) _ u hf this $
-    assume ⟨p₁, p₂⟩ ⟨h₁, h₂⟩, h p₁ h₁ p₂ h₂
+lemma ulift.closed_embedding_down [topological_space α] :
+  closed_embedding (ulift.down : ulift.{v u} α → α) :=
+⟨embedding_ulift_down, by simp only [ulift.down_surjective.range_eq, is_closed_univ]⟩
+
+instance [topological_space α] [discrete_topology α] : discrete_topology (ulift α) :=
+embedding_ulift_down.discrete_topology
+
+end ulift
diff --git a/src/topology/continuous_function/algebra.lean b/src/topology/continuous_function/algebra.lean
index 982300e5bfeba..f60f007b21629 100644
--- a/src/topology/continuous_function/algebra.lean
+++ b/src/topology/continuous_function/algebra.lean
@@ -3,16 +3,24 @@ Copyright (c) 2019 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison, Nicolò Cavalleri
 -/
+import algebra.algebra.pi
+import algebra.periodic
+import algebra.algebra.subalgebra.basic
+import algebra.star.star_alg_hom
+import tactic.field_simp
 import topology.algebra.module.basic
-import topology.continuous_function.ordered
+import topology.algebra.infinite_sum.basic
+import topology.algebra.star
 import topology.algebra.uniform_group
+import topology.continuous_function.ordered
 import topology.uniform_space.compact_convergence
-import algebra.algebra.subalgebra.basic
-import tactic.field_simp
 
 /-!
 # Algebraic structures over continuous functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define instances of algebraic structures over the type `continuous_map α β`
 (denoted `C(α, β)`) of **bundled** continuous maps from `α` to `β`. For example, `C(α, β)`
 is a group when `β` is a group, a ring when `β` is a ring, etc.
@@ -41,6 +49,8 @@ namespace continuous_map
 variables {α : Type*} {β : Type*} {γ : Type*}
 variables [topological_space α] [topological_space β] [topological_space γ]
 
+/- ### "mul" and "add" -/
+
 @[to_additive]
 instance has_mul [has_mul β] [has_continuous_mul β] : has_mul C(α, β) :=
 ⟨λ f g, ⟨f * g, continuous_mul.comp (f.continuous.prod_mk g.continuous : _)⟩⟩
@@ -48,20 +58,46 @@ instance has_mul [has_mul β] [has_continuous_mul β] : has_mul C(α, β) :=
 @[simp, norm_cast, to_additive]
 lemma coe_mul [has_mul β] [has_continuous_mul β] (f g : C(α, β)) : ⇑(f * g) = f * g := rfl
 
+@[simp, to_additive]
+lemma mul_apply [has_mul β] [has_continuous_mul β] (f g : C(α, β)) (x : α) :
+  (f * g) x = f x * g x := rfl
+
 @[simp, to_additive] lemma mul_comp [has_mul γ] [has_continuous_mul γ]
   (f₁ f₂ : C(β, γ)) (g : C(α, β)) :
   (f₁ * f₂).comp g = f₁.comp g * f₂.comp g :=
 rfl
 
-@[to_additive]
-instance [has_one β] : has_one C(α, β) := ⟨const α 1⟩
+/- ### "one" -/
 
-@[simp, norm_cast, to_additive]
-lemma coe_one [has_one β]  : ⇑(1 : C(α, β)) = 1 := rfl
+@[to_additive] instance [has_one β] : has_one C(α, β) := ⟨const α 1⟩
+
+@[simp, norm_cast, to_additive] lemma coe_one [has_one β]  : ⇑(1 : C(α, β)) = 1 := rfl
+
+@[simp, to_additive] lemma one_apply [has_one β] (x : α) : (1 : C(α, β)) x = 1 := rfl
 
 @[simp, to_additive] lemma one_comp [has_one γ] (g : C(α, β)) : (1 : C(β, γ)).comp g = 1 := rfl
 
-instance has_nsmul [add_monoid β] [has_continuous_add β] : has_scalar ℕ C(α, β) :=
+/- ### "nat_cast" -/
+
+instance [has_nat_cast β] : has_nat_cast C(α, β) := ⟨λ n, continuous_map.const _ n⟩
+
+@[simp, norm_cast] lemma coe_nat_cast [has_nat_cast β] (n : ℕ) : ((n : C(α, β)) : α → β) = n := rfl
+
+@[simp] lemma nat_cast_apply [has_nat_cast β] (n : ℕ) (x : α) : (n : C(α, β)) x = n := rfl
+
+/- ### "int_cast" -/
+
+instance [has_int_cast β] : has_int_cast C(α, β) :=
+⟨λ n, continuous_map.const _ n⟩
+
+@[simp, norm_cast]
+lemma coe_int_cast [has_int_cast β] (n : ℤ) : ((n : C(α, β)) : α → β) = n := rfl
+
+@[simp] lemma int_cast_apply [has_int_cast β] (n : ℤ) (x : α) : (n : C(α, β)) x = n := rfl
+
+/- ### "nsmul" and "pow" -/
+
+instance has_nsmul [add_monoid β] [has_continuous_add β] : has_smul ℕ C(α, β) :=
 ⟨λ n f, ⟨n • f, f.continuous.nsmul n⟩⟩
 
 @[to_additive]
@@ -72,8 +108,14 @@ instance has_pow [monoid β] [has_continuous_mul β] : has_pow C(α, β) ℕ :=
 lemma coe_pow [monoid β] [has_continuous_mul β] (f : C(α, β)) (n : ℕ) :
   ⇑(f ^ n) = f ^ n := rfl
 
--- don't make `coe_nsmul` simp as the linter complains it's redundant WRT `coe_smul`
-attribute [simp] coe_pow
+@[to_additive] lemma pow_apply [monoid β] [has_continuous_mul β]
+  (f : C(α, β)) (n : ℕ) (x : α) :
+  (f ^ n) x = f x ^ n :=
+rfl
+
+-- don't make auto-generated `coe_nsmul` and `nsmul_apply` simp, as the linter complains they're
+-- redundant WRT `coe_smul`
+attribute [simp] coe_pow pow_apply
 
 @[to_additive] lemma pow_comp [monoid γ] [has_continuous_mul γ]
   (f : C(β, γ)) (n : ℕ) (g : C(α, β)) :
@@ -83,6 +125,8 @@ rfl
 -- don't make `nsmul_comp` simp as the linter complains it's redundant WRT `smul_comp`
 attribute [simp] pow_comp
 
+/- ### "inv" and "neg" -/
+
 @[to_additive]
 instance [group β] [topological_group β] : has_inv C(α, β) :=
 { inv := λ f, ⟨f⁻¹, f.continuous.inv⟩ }
@@ -92,10 +136,16 @@ lemma coe_inv [group β] [topological_group β] (f : C(α, β)) :
   ⇑(f⁻¹) = f⁻¹ :=
 rfl
 
+@[simp, to_additive] lemma inv_apply [group β] [topological_group β] (f : C(α, β)) (x : α) :
+  f⁻¹ x = (f x)⁻¹ :=
+rfl
+
 @[simp, to_additive] lemma inv_comp [group γ] [topological_group γ] (f : C(β, γ)) (g : C(α, β)) :
   (f⁻¹).comp g = (f.comp g)⁻¹ :=
 rfl
 
+/- ### "div" and "sub" -/
+
 @[to_additive]
 instance [has_div β] [has_continuous_div β] : has_div C(α, β) :=
 { div := λ f g, ⟨f / g, f.continuous.div' g.continuous⟩ }
@@ -104,12 +154,18 @@ instance [has_div β] [has_continuous_div β] : has_div C(α, β) :=
 lemma coe_div [has_div β] [has_continuous_div β] (f g : C(α, β)) : ⇑(f / g) = f / g :=
 rfl
 
+@[simp, to_additive] lemma div_apply [has_div β] [has_continuous_div β] (f g : C(α, β)) (x : α) :
+  (f / g) x = f x / g x :=
+rfl
+
 @[simp, to_additive] lemma div_comp [has_div γ] [has_continuous_div γ]
   (f g : C(β, γ)) (h : C(α, β)) :
   (f / g).comp h = (f.comp h) / (g.comp h) :=
 rfl
 
-instance has_zsmul [add_group β] [topological_add_group β] : has_scalar ℤ C(α, β) :=
+/- ### "zpow" and "zsmul" -/
+
+instance has_zsmul [add_group β] [topological_add_group β] : has_smul ℤ C(α, β) :=
 { smul := λ z f, ⟨z • f, f.continuous.zsmul z⟩ }
 
 @[to_additive]
@@ -122,8 +178,14 @@ lemma coe_zpow [group β] [topological_group β] (f : C(α, β)) (z : ℤ) :
   ⇑(f ^ z) = f ^ z :=
 rfl
 
--- don't make `coe_zsmul` simp as the linter complains it's redundant WRT `coe_smul`
-attribute [simp] coe_zpow
+@[to_additive] lemma zpow_apply [group β] [topological_group β]
+  (f : C(α, β)) (z : ℤ) (x : α) :
+  (f ^ z) x = f x ^ z :=
+rfl
+
+-- don't make auto-generated `coe_zsmul` and `zsmul_apply` simp as the linter complains they're
+-- redundant WRT `coe_smul`
+attribute [simp] coe_zpow zpow_apply
 
 @[to_additive]
 lemma zpow_comp [group γ] [topological_group γ] (f : C(β, γ)) (z : ℤ) (g : C(α, β)) :
@@ -149,11 +211,10 @@ section subtype
 /-- The `submonoid` of continuous maps `α → β`. -/
 @[to_additive "The `add_submonoid` of continuous maps `α → β`. "]
 def continuous_submonoid (α : Type*) (β : Type*) [topological_space α] [topological_space β]
-  [monoid β] [has_continuous_mul β] : submonoid (α → β) :=
+  [mul_one_class β] [has_continuous_mul β] : submonoid (α → β) :=
 { carrier := { f : α → β | continuous f },
   one_mem' := @continuous_const _ _ _ _ 1,
-  mul_mem' := λ f g fc gc, continuous.comp
-    has_continuous_mul.continuous_mul (continuous.prod_mk fc gc : _) }
+  mul_mem' := λ f g fc gc, fc.mul gc }
 
 /-- The subgroup of continuous maps `α → β`. -/
 @[to_additive "The `add_subgroup` of continuous maps `α → β`. "]
@@ -166,51 +227,43 @@ end subtype
 
 namespace continuous_map
 
+variables {α β : Type*} [topological_space α] [topological_space β]
+
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [semigroup β] [has_continuous_mul β] : semigroup C(α, β) :=
+instance [semigroup β] [has_continuous_mul β] : semigroup C(α, β) :=
 coe_injective.semigroup _ coe_mul
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [comm_semigroup β] [has_continuous_mul β] : comm_semigroup C(α, β) :=
+instance [comm_semigroup β] [has_continuous_mul β] : comm_semigroup C(α, β) :=
 coe_injective.comm_semigroup _ coe_mul
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [mul_one_class β] [has_continuous_mul β] : mul_one_class C(α, β) :=
+instance [mul_one_class β] [has_continuous_mul β] : mul_one_class C(α, β) :=
 coe_injective.mul_one_class _ coe_one coe_mul
 
-instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [mul_zero_class β] [has_continuous_mul β] : mul_zero_class C(α, β) :=
+instance [mul_zero_class β] [has_continuous_mul β] : mul_zero_class C(α, β) :=
 coe_injective.mul_zero_class _ coe_zero coe_mul
 
-instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [semigroup_with_zero β] [has_continuous_mul β] : semigroup_with_zero C(α, β) :=
+instance [semigroup_with_zero β] [has_continuous_mul β] : semigroup_with_zero C(α, β) :=
 coe_injective.semigroup_with_zero _ coe_zero coe_mul
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [monoid β] [has_continuous_mul β] : monoid C(α, β) :=
+instance [monoid β] [has_continuous_mul β] : monoid C(α, β) :=
 coe_injective.monoid _ coe_one coe_mul coe_pow
 
-instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [monoid_with_zero β] [has_continuous_mul β] : monoid_with_zero C(α, β) :=
+instance [monoid_with_zero β] [has_continuous_mul β] : monoid_with_zero C(α, β) :=
 coe_injective.monoid_with_zero _ coe_zero coe_one coe_mul coe_pow
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [comm_monoid β] [has_continuous_mul β] : comm_monoid C(α, β) :=
+instance [comm_monoid β] [has_continuous_mul β] : comm_monoid C(α, β) :=
 coe_injective.comm_monoid _ coe_one coe_mul coe_pow
 
-instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [comm_monoid_with_zero β] [has_continuous_mul β] : comm_monoid_with_zero C(α, β) :=
+instance [comm_monoid_with_zero β] [has_continuous_mul β] : comm_monoid_with_zero C(α, β) :=
 coe_injective.comm_monoid_with_zero _ coe_zero coe_one coe_mul coe_pow
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α]
-  [locally_compact_space α] [topological_space β]
-  [has_mul β] [has_continuous_mul β] : has_continuous_mul C(α, β) :=
+instance [locally_compact_space α] [has_mul β] [has_continuous_mul β] :
+  has_continuous_mul C(α, β) :=
 ⟨begin
   refine continuous_of_continuous_uncurry _ _,
   have h1 : continuous (λ x : (C(α, β) × C(α, β)) × α, x.fst.fst x.snd) :=
@@ -223,73 +276,94 @@ end⟩
 /-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
 @[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
   simps]
-def coe_fn_monoid_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [monoid β] [has_continuous_mul β] : C(α, β) →* (α → β) :=
+def coe_fn_monoid_hom [monoid β] [has_continuous_mul β] : C(α, β) →* (α → β) :=
 { to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }
 
+variables (α)
+
 /-- Composition on the left by a (continuous) homomorphism of topological monoids, as a
 `monoid_hom`. Similar to `monoid_hom.comp_left`. -/
 @[to_additive "Composition on the left by a (continuous) homomorphism of topological `add_monoid`s,
 as an `add_monoid_hom`. Similar to `add_monoid_hom.comp_left`.", simps]
-protected def _root_.monoid_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
-  [topological_space α] [topological_space β] [monoid β] [has_continuous_mul β]
+protected def _root_.monoid_hom.comp_left_continuous
+  {γ : Type*} [monoid β] [has_continuous_mul β]
   [topological_space γ] [monoid γ] [has_continuous_mul γ] (g : β →* γ) (hg : continuous g)  :
   C(α, β) →* C(α, γ) :=
 { to_fun := λ f, (⟨g, hg⟩ : C(β, γ)).comp f,
   map_one' := ext $ λ x, g.map_one,
   map_mul' := λ f₁ f₂, ext $ λ x, g.map_mul _ _ }
 
+variables {α}
+
 /-- Composition on the right as a `monoid_hom`. Similar to `monoid_hom.comp_hom'`. -/
 @[to_additive "Composition on the right as an `add_monoid_hom`. Similar to
 `add_monoid_hom.comp_hom'`.", simps]
-def comp_monoid_hom' {α : Type*} {β : Type*} {γ : Type*}
-  [topological_space α] [topological_space β] [topological_space γ]
+def comp_monoid_hom' {γ : Type*} [topological_space γ]
   [mul_one_class γ] [has_continuous_mul γ] (g : C(α, β)) : C(β, γ) →* C(α, γ) :=
 { to_fun := λ f, f.comp g, map_one' := one_comp g, map_mul' := λ f₁ f₂, mul_comp f₁ f₂ g }
 
 open_locale big_operators
-@[simp, to_additive] lemma coe_prod {α : Type*} {β : Type*} [comm_monoid β]
-  [topological_space α] [topological_space β] [has_continuous_mul β]
+@[simp, to_additive] lemma coe_prod [comm_monoid β] [has_continuous_mul β]
   {ι : Type*} (s : finset ι) (f : ι → C(α, β)) :
   ⇑(∏ i in s, f i) = (∏ i in s, (f i : α → β)) :=
 (coe_fn_monoid_hom : C(α, β) →* _).map_prod f s
 
 @[to_additive]
-lemma prod_apply {α : Type*} {β : Type*} [comm_monoid β]
-  [topological_space α] [topological_space β] [has_continuous_mul β]
+lemma prod_apply [comm_monoid β] [has_continuous_mul β]
   {ι : Type*} (s : finset ι) (f : ι → C(α, β)) (a : α) :
   (∏ i in s, f i) a = (∏ i in s, f i a) :=
 by simp
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [group β] [topological_group β] : group C(α, β) :=
+instance [group β] [topological_group β] : group C(α, β) :=
 coe_injective.group _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow
 
 @[to_additive]
-instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [comm_group β] [topological_group β] : comm_group C(α, β) :=
+instance [comm_group β] [topological_group β] : comm_group C(α, β) :=
 coe_injective.comm_group _ coe_one coe_mul coe_inv coe_div coe_pow coe_zpow
 
-@[to_additive] instance {α : Type*} {β : Type*} [topological_space α]
-  [topological_space β] [comm_group β] [topological_group β] : topological_group C(α, β) :=
+@[to_additive] instance [comm_group β] [topological_group β] : topological_group C(α, β) :=
 { continuous_mul := by
   { letI : uniform_space β := topological_group.to_uniform_space β,
-    have : uniform_group β := topological_group_is_uniform,
+    have : uniform_group β := topological_comm_group_is_uniform,
     rw continuous_iff_continuous_at,
     rintros ⟨f, g⟩,
     rw [continuous_at, tendsto_iff_forall_compact_tendsto_uniformly_on, nhds_prod_eq],
-    exactI λ K hK, ((tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).prod
-      (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK)).comp'
-      uniform_continuous_mul },
+    exactI λ K hK, uniform_continuous_mul.comp_tendsto_uniformly_on
+      ((tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).prod
+      (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK)), },
   continuous_inv := by
   { letI : uniform_space β := topological_group.to_uniform_space β,
-    have : uniform_group β := topological_group_is_uniform,
+    have : uniform_group β := topological_comm_group_is_uniform,
     rw continuous_iff_continuous_at,
     intro f,
     rw [continuous_at, tendsto_iff_forall_compact_tendsto_uniformly_on],
-    exactI λ K hK, (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).comp'
-      uniform_continuous_inv } }
+    exactI λ K hK, uniform_continuous_inv.comp_tendsto_uniformly_on
+      (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK), } }
+
+-- TODO: rewrite the next three lemmas for products and deduce sum case via `to_additive`, once
+-- definition of `tprod` is in place
+
+/-- If `α` is locally compact, and an infinite sum of functions in `C(α, β)`
+converges to `g` (for the compact-open topology), then the pointwise sum converges to `g x` for
+all `x ∈ α`. -/
+lemma has_sum_apply {γ : Type*} [locally_compact_space α] [add_comm_monoid β] [has_continuous_add β]
+  {f : γ → C(α, β)} {g : C(α, β)} (hf : has_sum f g) (x : α) :
+  has_sum (λ i : γ, f i x) (g x) :=
+begin
+  let evₓ : add_monoid_hom C(α, β) β := (pi.eval_add_monoid_hom _ x).comp coe_fn_add_monoid_hom,
+  exact hf.map evₓ (continuous_map.continuous_eval_const' x),
+end
+
+lemma summable_apply [locally_compact_space α] [add_comm_monoid β] [has_continuous_add β]
+  {γ : Type*} {f : γ → C(α, β)} (hf : summable f) (x : α) :
+  summable (λ i : γ, f i x) :=
+(has_sum_apply hf.has_sum x).summable
+
+lemma tsum_apply [locally_compact_space α] [t2_space β] [add_comm_monoid β] [has_continuous_add β]
+  {γ : Type*} {f : γ → C(α, β)} (hf : summable f) (x : α) :
+  (∑' (i:γ), f i x) = (∑' (i:γ), f i) x :=
+(has_sum_apply hf.has_sum x).tsum_eq
 
 end continuous_map
 
@@ -308,7 +382,7 @@ section subtype
 
 /-- The subsemiring of continuous maps `α → β`. -/
 def continuous_subsemiring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
-  [semiring R] [topological_semiring R] : subsemiring (α → R) :=
+  [non_assoc_semiring R] [topological_semiring R] : subsemiring (α → R) :=
 { ..continuous_add_submonoid α R,
   ..continuous_submonoid α R }
 
@@ -332,14 +406,19 @@ instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   non_unital_semiring C(α, β) :=
 coe_injective.non_unital_semiring _ coe_zero coe_add coe_mul coe_nsmul
 
+instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
+  [add_monoid_with_one β] [has_continuous_add β] :
+  add_monoid_with_one C(α, β) :=
+coe_injective.add_monoid_with_one _ coe_zero coe_one coe_add coe_nsmul coe_nat_cast
+
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [non_assoc_semiring β] [topological_semiring β] :
   non_assoc_semiring C(α, β) :=
-coe_injective.non_assoc_semiring _ coe_zero coe_one coe_add coe_mul coe_nsmul
+coe_injective.non_assoc_semiring _ coe_zero coe_one coe_add coe_mul coe_nsmul coe_nat_cast
 
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [semiring β] [topological_semiring β] : semiring C(α, β) :=
-coe_injective.semiring _ coe_zero coe_one coe_add coe_mul coe_nsmul coe_pow
+coe_injective.semiring _ coe_zero coe_one coe_add coe_mul coe_nsmul coe_pow coe_nat_cast
 
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [non_unital_non_assoc_ring β] [topological_ring β] : non_unital_non_assoc_ring C(α, β) :=
@@ -353,10 +432,12 @@ coe_injective.non_unital_ring _ coe_zero coe_add coe_mul coe_neg coe_sub coe_nsm
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [non_assoc_ring β] [topological_ring β] : non_assoc_ring C(α, β) :=
 coe_injective.non_assoc_ring _ coe_zero coe_one coe_add coe_mul coe_neg coe_sub coe_nsmul coe_zsmul
+  coe_nat_cast coe_int_cast
 
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [ring β] [topological_ring β] : ring C(α, β) :=
 coe_injective.ring _ coe_zero coe_one coe_add coe_mul coe_neg coe_sub coe_nsmul coe_zsmul coe_pow
+  coe_nat_cast coe_int_cast
 
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [non_unital_comm_semiring β] [topological_semiring β] : non_unital_comm_semiring C(α, β) :=
@@ -364,7 +445,7 @@ coe_injective.non_unital_comm_semiring _ coe_zero coe_add coe_mul coe_nsmul
 
 instance {α : Type*} {β : Type*} [topological_space α]
   [topological_space β] [comm_semiring β] [topological_semiring β] : comm_semiring C(α, β) :=
-coe_injective.comm_semiring _ coe_zero coe_one coe_add coe_mul coe_nsmul coe_pow
+coe_injective.comm_semiring _ coe_zero coe_one coe_add coe_mul coe_nsmul coe_pow coe_nat_cast
 
 instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
   [non_unital_comm_ring β] [topological_ring β] : non_unital_comm_ring C(α, β) :=
@@ -373,7 +454,7 @@ coe_injective.non_unital_comm_ring _ coe_zero coe_add coe_mul coe_neg coe_sub co
 instance {α : Type*} {β : Type*} [topological_space α]
   [topological_space β] [comm_ring β] [topological_ring β] : comm_ring C(α, β) :=
 coe_injective.comm_ring _ coe_zero coe_one coe_add coe_mul coe_neg coe_sub coe_nsmul coe_zsmul
-  coe_pow
+  coe_pow coe_nat_cast coe_int_cast
 
 /-- Composition on the left by a (continuous) homomorphism of topological semirings, as a
 `ring_hom`.  Similar to `ring_hom.comp_left`. -/
@@ -387,7 +468,7 @@ coe_injective.comm_ring _ coe_zero coe_one coe_add coe_mul coe_neg coe_sub coe_n
 /-- Coercion to a function as a `ring_hom`. -/
 @[simps]
 def coe_fn_ring_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
-  [ring β] [topological_ring β] : C(α, β) →+* (α → β) :=
+  [semiring β] [topological_semiring β] : C(α, β) →+* (α → β) :=
 { to_fun := coe_fn,
   ..(coe_fn_monoid_hom : C(α, β) →* _),
   ..(coe_fn_add_monoid_hom : C(α, β) →+ _) }
@@ -429,16 +510,16 @@ variables {α β : Type*} [topological_space α] [topological_space β]
   {M₂ : Type*} [topological_space M₂]
 
 @[to_additive continuous_map.has_vadd]
-instance [has_scalar R M] [has_continuous_const_smul R M] : has_scalar R C(α, M) :=
+instance [has_smul R M] [has_continuous_const_smul R M] : has_smul R C(α, M) :=
 ⟨λ r f, ⟨r • f, f.continuous.const_smul r⟩⟩
 
 @[to_additive]
-instance [locally_compact_space α] [has_scalar R M] [has_continuous_const_smul R M] :
+instance [locally_compact_space α] [has_smul R M] [has_continuous_const_smul R M] :
   has_continuous_const_smul R C(α, M) :=
 ⟨λ γ, continuous_of_continuous_uncurry _ (continuous_eval'.const_smul γ)⟩
 
 @[to_additive]
-instance [locally_compact_space α] [topological_space R] [has_scalar R M]
+instance [locally_compact_space α] [topological_space R] [has_smul R M]
   [has_continuous_smul R M] : has_continuous_smul R C(α, M) :=
 ⟨begin
   refine continuous_of_continuous_uncurry _ _,
@@ -447,32 +528,32 @@ instance [locally_compact_space α] [topological_space R] [has_scalar R M]
   exact (continuous_fst.comp continuous_fst).smul h,
 end⟩
 
-@[simp, to_additive, norm_cast]
-lemma coe_smul [has_scalar R M] [has_continuous_const_smul R M]
+@[simp, norm_cast, to_additive]
+lemma coe_smul [has_smul R M] [has_continuous_const_smul R M]
   (c : R) (f : C(α, M)) : ⇑(c • f) = c • f := rfl
 
 @[to_additive]
-lemma smul_apply [has_scalar R M] [has_continuous_const_smul R M]
+lemma smul_apply [has_smul R M] [has_continuous_const_smul R M]
   (c : R) (f : C(α, M)) (a : α) : (c • f) a = c • (f a) :=
 rfl
 
-@[simp, to_additive] lemma smul_comp [has_scalar R M] [has_continuous_const_smul R M]
+@[simp, to_additive] lemma smul_comp [has_smul R M] [has_continuous_const_smul R M]
   (r : R) (f : C(β, M)) (g : C(α, β)) :
   (r • f).comp g = r • (f.comp g) :=
 rfl
 
 @[to_additive]
-instance [has_scalar R M] [has_continuous_const_smul R M]
-  [has_scalar R₁ M] [has_continuous_const_smul R₁ M]
+instance [has_smul R M] [has_continuous_const_smul R M]
+  [has_smul R₁ M] [has_continuous_const_smul R₁ M]
   [smul_comm_class R R₁ M] : smul_comm_class R R₁ C(α, M) :=
 { smul_comm := λ _ _ _, ext $ λ _, smul_comm _ _ _ }
 
-instance [has_scalar R M] [has_continuous_const_smul R M]
-  [has_scalar R₁ M] [has_continuous_const_smul R₁ M]
-  [has_scalar R R₁] [is_scalar_tower R R₁ M] : is_scalar_tower R R₁ C(α, M) :=
+instance [has_smul R M] [has_continuous_const_smul R M]
+  [has_smul R₁ M] [has_continuous_const_smul R₁ M]
+  [has_smul R R₁] [is_scalar_tower R R₁ M] : is_scalar_tower R R₁ C(α, M) :=
 { smul_assoc := λ _ _ _, ext $ λ _, smul_assoc _ _ _ }
 
-instance [has_scalar R M] [has_scalar Rᵐᵒᵖ M] [has_continuous_const_smul R M]
+instance [has_smul R M] [has_smul Rᵐᵒᵖ M] [has_continuous_const_smul R M]
   [is_central_scalar R M] : is_central_scalar R C(α, M) :=
 { op_smul_eq_smul := λ _ _, ext $ λ _, op_smul_eq_smul _ _ }
 
@@ -556,8 +637,6 @@ def continuous_map.C : R →+* C(α, A) :=
 @[simp] lemma continuous_map.C_apply (r : R) (a : α) : continuous_map.C r a = algebra_map R A r :=
 rfl
 
-variables [has_continuous_const_smul R A] [has_continuous_const_smul R A₂]
-
 instance continuous_map.algebra : algebra R C(α, A) :=
 { to_ring_hom := continuous_map.C,
   commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
@@ -573,16 +652,28 @@ variables (R)
 { commutes' := λ c, continuous_map.ext $ λ _, g.commutes' _,
   .. g.to_ring_hom.comp_left_continuous α hg }
 
+variables (A)
+
+/--
+Precomposition of functions into a normed ring by a continuous map is an algebra homomorphism.
+-/
+@[simps] def continuous_map.comp_right_alg_hom {α β : Type*} [topological_space α]
+  [topological_space β] (f : C(α, β)) : C(β, A) →ₐ[R] C(α, A) :=
+{ to_fun := λ g, g.comp f,
+  map_zero' := by { ext, refl, },
+  map_add' := λ g₁ g₂, by { ext, refl, },
+  map_one' := by { ext, refl, },
+  map_mul' := λ g₁ g₂, by { ext, refl, },
+  commutes' := λ r, by { ext, refl, }, }
+
+variables {A}
+
 /-- Coercion to a function as an `alg_hom`. -/
 @[simps]
 def continuous_map.coe_fn_alg_hom : C(α, A) →ₐ[R] (α → A) :=
 { to_fun := coe_fn,
   commutes' := λ r, rfl,
-  -- `..(continuous_map.coe_fn_ring_hom : C(α, A) →+* _)` times out for some reason
-  map_zero' := continuous_map.coe_zero,
-  map_one' := continuous_map.coe_one,
-  map_add' := continuous_map.coe_add,
-  map_mul' := continuous_map.coe_mul }
+  ..(continuous_map.coe_fn_ring_hom : C(α, A) →+* _) }
 
 variables {R}
 
@@ -622,7 +713,7 @@ writing it this way avoids having to deal with casts inside the set.
 where the functions would be continuous functions vanishing at infinity.)
 -/
 def set.separates_points_strongly (s : set C(α, 𝕜)) : Prop :=
-∀ (v : α → 𝕜) (x y : α), ∃ f : s, (f x : 𝕜) = v x ∧ f y = v y
+∀ (v : α → 𝕜) (x y : α), ∃ f ∈ s, (f x : 𝕜) = v x ∧ f y = v y
 
 variables [field 𝕜] [topological_ring 𝕜]
 
@@ -639,49 +730,33 @@ lemma subalgebra.separates_points.strongly {s : subalgebra 𝕜 C(α, 𝕜)} (h
 begin
   by_cases n : x = y,
   { subst n,
-    use ((v x) • 1 : C(α, 𝕜)),
-    { apply s.smul_mem,
-      apply s.one_mem, },
-    { simp [coe_fn_coe_base'] }, },
-  obtain ⟨f, ⟨f, ⟨m, rfl⟩⟩, w⟩ := h n,
-  replace w : f x - f y ≠ 0 := sub_ne_zero_of_ne w,
+    refine ⟨_, ((v x) • 1 : s).prop, mul_one _, mul_one _⟩ },
+  obtain ⟨_, ⟨f, hf, rfl⟩, hxy⟩ := h n,
+  replace hxy : f x - f y ≠ 0 := sub_ne_zero_of_ne hxy,
   let a := v x,
   let b := v y,
-  let f' := ((b - a) * (f x - f y)⁻¹) • (continuous_map.C (f x) - f) + continuous_map.C a,
-  refine ⟨⟨f', _⟩, _, _⟩,
-  { simp only [f', set_like.mem_coe, subalgebra.mem_to_submodule],
-    -- TODO should there be a tactic for this?
-    -- We could add an attribute `@[subobject_mem]`, and a tactic
-    -- ``def subobject_mem := `[solve_by_elim with subobject_mem { max_depth := 10 }]``
-    solve_by_elim
-      [subalgebra.add_mem, subalgebra.smul_mem, subalgebra.sub_mem, subalgebra.algebra_map_mem]
-      { max_depth := 6 }, },
-  { simp [f', coe_fn_coe_base'], },
-  { simp [f', coe_fn_coe_base', inv_mul_cancel_right₀ w], },
+  let f' : s := ((b - a) * (f x - f y)⁻¹) • (algebra_map _ _ (f x) - ⟨f, hf⟩) + algebra_map _ _ a,
+  refine ⟨f', f'.prop, _, _⟩,
+  { simp [f'], },
+  { simp [f', inv_mul_cancel_right₀ hxy], },
 end
 
 end continuous_map
 
--- TODO[gh-6025]: make this an instance once safe to do so
-lemma continuous_map.subsingleton_subalgebra (α : Type*) [topological_space α]
+instance continuous_map.subsingleton_subalgebra (α : Type*) [topological_space α]
   (R : Type*) [comm_semiring R] [topological_space R] [topological_semiring R]
   [subsingleton α] : subsingleton (subalgebra R C(α, R)) :=
-begin
-  fsplit,
-  intros s₁ s₂,
-  by_cases n : nonempty α,
-  { obtain ⟨x⟩ := n,
+⟨λ s₁ s₂, begin
+  casesI is_empty_or_nonempty α,
+  { haveI : subsingleton C(α, R) := fun_like.coe_injective.subsingleton,
+    exact subsingleton.elim _ _ },
+  { inhabit α,
     ext f,
-    have h : f = algebra_map R C(α, R) (f x),
+    have h : f = algebra_map R C(α, R) (f default),
     { ext x', simp only [mul_one, algebra.id.smul_eq_mul, algebra_map_apply], congr, },
     rw h,
     simp only [subalgebra.algebra_map_mem], },
-  { ext f,
-    have h : f = 0,
-    { ext x', exact false.elim (n ⟨x'⟩), },
-    subst h,
-    simp only [subalgebra.zero_mem], },
-end
+end⟩
 
 end algebra_structure
 
@@ -695,15 +770,15 @@ is naturally a module over the ring of continuous functions from `α` to `R`. -/
 
 namespace continuous_map
 
-instance has_scalar' {α : Type*} [topological_space α]
+instance has_smul' {α : Type*} [topological_space α]
   {R : Type*} [semiring R] [topological_space R]
   {M : Type*} [topological_space M] [add_comm_monoid M]
   [module R M] [has_continuous_smul R M] :
-  has_scalar C(α, R) C(α, M) :=
+  has_smul C(α, R) C(α, M) :=
 ⟨λ f g, ⟨λ x, (f x) • (g x), (continuous.smul f.2 g.2)⟩⟩
 
 instance module' {α : Type*} [topological_space α]
-  (R : Type*) [ring R] [topological_space R] [topological_ring R]
+  (R : Type*) [semiring R] [topological_space R] [topological_semiring R]
   (M : Type*) [topological_space M] [add_comm_monoid M] [has_continuous_add M]
   [module R M] [has_continuous_smul R M] :
   module C(α, R) C(α, M) :=
@@ -756,4 +831,130 @@ ext (λ x, by simpa [mul_add] using @max_eq_half_add_add_abs_sub _ _ (f x) (g x)
 
 end lattice
 
+/-!
+### Star structure
+
+If `β` has a continuous star operation, we put a star structure on `C(α, β)` by using the
+star operation pointwise.
+
+If `β` is a ⋆-ring, then `C(α, β)` inherits a ⋆-ring structure.
+
+If `β` is a ⋆-ring and a ⋆-module over `R`, then the space of continuous functions from `α` to `β`
+is a ⋆-module over `R`.
+
+-/
+
+section star_structure
+variables {R α β : Type*}
+variables [topological_space α] [topological_space β]
+
+section has_star
+variables [has_star β] [has_continuous_star β]
+
+instance : has_star C(α, β) :=
+{ star := λ f, star_continuous_map.comp f }
+
+@[simp] lemma coe_star (f : C(α, β)) : ⇑(star f) = star f := rfl
+
+@[simp] lemma star_apply (f : C(α, β)) (x : α) : star f x = star (f x) := rfl
+
+end has_star
+
+instance [has_involutive_star β] [has_continuous_star β] : has_involutive_star C(α, β) :=
+{ star_involutive := λ f, ext $ λ x, star_star _ }
+
+instance [add_monoid β] [has_continuous_add β] [star_add_monoid β] [has_continuous_star β] :
+  star_add_monoid C(α, β) :=
+{ star_add := λ f g, ext $ λ x, star_add _ _ }
+
+instance [semigroup β] [has_continuous_mul β] [star_semigroup β] [has_continuous_star β] :
+  star_semigroup C(α, β) :=
+{ star_mul := λ f g, ext $ λ x, star_mul _ _ }
+
+instance [non_unital_semiring β] [topological_semiring β] [star_ring β] [has_continuous_star β] :
+  star_ring C(α, β) :=
+{ ..continuous_map.star_add_monoid }
+
+instance [has_star R] [has_star β] [has_smul R β] [star_module R β]
+  [has_continuous_star β] [has_continuous_const_smul R β] :
+  star_module R C(α, β) :=
+{ star_smul := λ k f, ext $ λ x, star_smul _ _ }
+
+end star_structure
+
+variables {X Y Z : Type*} [topological_space X] [topological_space Y] [topological_space Z]
+variables (𝕜 : Type*) [comm_semiring 𝕜]
+variables (A : Type*) [topological_space A] [semiring A] [topological_semiring A] [star_ring A]
+variables [has_continuous_star A] [algebra 𝕜 A]
+
+/-- The functorial map taking `f : C(X, Y)` to `C(Y, A) →⋆ₐ[𝕜] C(X, A)` given by pre-composition
+with the continuous function `f`. See `continuous_map.comp_monoid_hom'` and
+`continuous_map.comp_add_monoid_hom'`, `continuous_map.comp_right_alg_hom` for bundlings of
+pre-composition into a `monoid_hom`, an `add_monoid_hom` and an `alg_hom`, respectively, under
+suitable assumptions on `A`. -/
+@[simps] def comp_star_alg_hom' (f : C(X, Y)) : C(Y, A) →⋆ₐ[𝕜] C(X, A) :=
+{ to_fun := λ g, g.comp f,
+  map_one' := one_comp _,
+  map_mul' := λ _ _, rfl,
+  map_zero' := zero_comp _,
+  map_add' := λ _ _, rfl,
+  commutes' := λ _, rfl,
+  map_star' := λ _, rfl }
+
+/-- `continuous_map.comp_star_alg_hom'` sends the identity continuous map to the identity
+`star_alg_hom` -/
+lemma comp_star_alg_hom'_id :
+  comp_star_alg_hom' 𝕜 A (continuous_map.id X) = star_alg_hom.id 𝕜 C(X, A) :=
+star_alg_hom.ext $ λ _, continuous_map.ext $ λ _, rfl
+
+/-- `continuous_map.comp_star_alg_hom` is functorial. -/
+lemma comp_star_alg_hom'_comp (g : C(Y, Z)) (f : C(X, Y)) :
+  comp_star_alg_hom' 𝕜 A (g.comp f) = (comp_star_alg_hom' 𝕜 A f).comp (comp_star_alg_hom' 𝕜 A g) :=
+star_alg_hom.ext $ λ _, continuous_map.ext $ λ _, rfl
+
+section periodicity
+
+/-! ### Summing translates of a function -/
+
+/-- Summing the translates of `f` by `ℤ • p` gives a map which is periodic with period `p`.
+(This is true without any convergence conditions, since if the sum doesn't converge it is taken to
+be the zero map, which is periodic.) -/
+lemma periodic_tsum_comp_add_zsmul [locally_compact_space X] [add_comm_group X]
+  [topological_add_group X] [add_comm_monoid Y] [has_continuous_add Y] [t2_space Y]
+  (f : C(X, Y)) (p : X) :
+  function.periodic ⇑(∑' (n : ℤ), f.comp (continuous_map.add_right (n • p))) p :=
+begin
+  intro x,
+  by_cases h : summable (λ n : ℤ, f.comp (continuous_map.add_right (n • p))),
+  { convert congr_arg (λ f : C(X, Y), f x) ((equiv.add_right (1 : ℤ)).tsum_eq _) using 1,
+    simp_rw [←tsum_apply h, ←tsum_apply ((equiv.add_right (1 : ℤ)).summable_iff.mpr h),
+      equiv.coe_add_right, comp_apply, coe_add_right, add_one_zsmul, add_comm (_ • p) p,
+      ←add_assoc] },
+  { rw tsum_eq_zero_of_not_summable h,
+    simp only [coe_zero, pi.zero_apply] }
+end
+
+end periodicity
+
 end continuous_map
+
+namespace homeomorph
+
+variables {X Y : Type*} [topological_space X] [topological_space Y]
+variables (𝕜 : Type*) [comm_semiring 𝕜]
+variables (A : Type*) [topological_space A] [semiring A] [topological_semiring A] [star_ring A]
+variables [has_continuous_star A] [algebra 𝕜 A]
+
+/-- `continuous_map.comp_star_alg_hom'` as a `star_alg_equiv` when the continuous map `f` is
+actually a homeomorphism. -/
+@[simps] def comp_star_alg_equiv' (f : X ≃ₜ Y) : C(Y, A) ≃⋆ₐ[𝕜] C(X, A) :=
+{ to_fun := (f : C(X, Y)).comp_star_alg_hom' 𝕜 A,
+  inv_fun := (f.symm : C(Y, X)).comp_star_alg_hom' 𝕜 A,
+  left_inv := λ g, by simp only [continuous_map.comp_star_alg_hom'_apply, continuous_map.comp_assoc,
+    to_continuous_map_comp_symm, continuous_map.comp_id],
+  right_inv := λ g, by simp only [continuous_map.comp_star_alg_hom'_apply,
+    continuous_map.comp_assoc, symm_comp_to_continuous_map, continuous_map.comp_id],
+  map_smul' := λ k a, map_smul (f.to_continuous_map.comp_star_alg_hom' 𝕜 A) k a,
+  .. (f.to_continuous_map.comp_star_alg_hom' 𝕜 A) }
+
+end homeomorph
diff --git a/src/topology/continuous_function/basic.lean b/src/topology/continuous_function/basic.lean
index b59207029b70a..fffbb5263bd4c 100644
--- a/src/topology/continuous_function/basic.lean
+++ b/src/topology/continuous_function/basic.lean
@@ -10,6 +10,9 @@ import topology.homeomorph
 /-!
 # Continuous bundled maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the type `continuous_map` of continuous bundled maps.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -31,6 +34,8 @@ structure continuous_map (α β : Type*) [topological_space α] [topological_spa
 
 notation `C(` α `, ` β `)` := continuous_map α β
 
+section
+set_option old_structure_cmd true
 /-- `continuous_map_class F α β` states that `F` is a type of continuous maps.
 
 You should extend this class when you extend `continuous_map`. -/
@@ -39,6 +44,8 @@ class continuous_map_class (F : Type*) (α β : out_param $ Type*) [topological_
   extends fun_like F α (λ _, β) :=
 (map_continuous (f : F) : continuous f)
 
+end
+
 export continuous_map_class (map_continuous)
 
 attribute [continuity] map_continuous
@@ -73,6 +80,12 @@ instance : has_coe_to_fun (C(α, β)) (λ _, α → β) := fun_like.has_coe_to_f
 
 @[simp] lemma to_fun_eq_coe {f : C(α, β)} : f.to_fun = (f : α → β) := rfl
 
+-- this must come after the coe_to_fun definition
+initialize_simps_projections continuous_map (to_fun → apply)
+
+@[protected, simp, norm_cast]
+lemma coe_coe {F : Type*} [continuous_map_class F α β] (f : F) : ⇑(f : C(α, β)) = f := rfl
+
 @[ext] lemma ext {f g : C(α, β)} (h : ∀ a, f a = g a) : f = g := fun_like.ext _ _ h
 
 /-- Copy of a `continuous_map` with a new `to_fun` equal to the old one. Useful to fix definitional
@@ -81,6 +94,9 @@ protected def copy (f : C(α, β)) (f' : α → β) (h : f' = f) : C(α, β) :=
 { to_fun := f',
   continuous_to_fun := h.symm ▸ f.continuous_to_fun }
 
+@[simp] lemma coe_copy (f : C(α, β)) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : C(α, β)) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables {α β} {f g : C(α, β)}
 
 /-- Deprecated. Use `map_continuous` instead. -/
@@ -96,15 +112,14 @@ protected lemma congr_fun {f g : C(α, β)} (H : f = g) (x : α) : f x = g x :=
 /-- Deprecated. Use `fun_like.congr_arg` instead. -/
 protected lemma congr_arg (f : C(α, β)) {x y : α} (h : x = y) : f x = f y := h ▸ rfl
 
-instance [inhabited β] : inhabited C(α, β) :=
-⟨{ to_fun := λ _, default, }⟩
-
 lemma coe_injective : @function.injective (C(α, β)) (α → β) coe_fn :=
 λ f g h, by cases f; cases g; congr'
 
 @[simp] lemma coe_mk (f : α → β) (h : continuous f) :
   ⇑(⟨f, h⟩ : C(α, β)) = f := rfl
 
+lemma map_specializes (f : C(α, β)) {x y : α} (h : x ⤳ y) : f x ⤳ f y := h.map f.2
+
 section
 variables (α β)
 
@@ -130,6 +145,9 @@ def const (b : β) : C(α, β) := ⟨const α b⟩
 
 @[simp] lemma coe_const (b : β) : ⇑(const α b) = function.const α b := rfl
 
+instance [inhabited β] : inhabited C(α, β) :=
+⟨const α default⟩
+
 variables {α}
 
 @[simp] lemma id_apply (a : α) : continuous_map.id α a = a := rfl
@@ -173,7 +191,7 @@ def prod_mk (f : C(α, β₁)) (g : C(α, β₂)) :
   continuous_to_fun := continuous.prod_mk f.continuous g.continuous }
 
 /-- Given two continuous maps `f` and `g`, this is the continuous map `(x, y) ↦ (f x, g y)`. -/
-def prod_map (f : C(α₁, α₂)) (g : C(β₁, β₂)) :
+@[simps] def prod_map (f : C(α₁, α₂)) (g : C(β₁, β₂)) :
   C(α₁ × β₁, α₂ × β₂) :=
 { to_fun := prod.map f g,
   continuous_to_fun := continuous.prod_map f.continuous g.continuous }
@@ -206,6 +224,17 @@ def restrict (f : C(α, β)) : C(s, β) := ⟨f ∘ coe⟩
 
 @[simp] lemma coe_restrict (f : C(α, β)) : ⇑(f.restrict s) = f ∘ coe := rfl
 
+@[simp] lemma restrict_apply (f : C(α, β)) (s : set α) (x : s) : f.restrict s x = f x := rfl
+
+@[simp] lemma restrict_apply_mk (f : C(α, β)) (s : set α) (x : α) (hx : x ∈ s) :
+  f.restrict s ⟨x, hx⟩ = f x :=
+rfl
+
+/-- The restriction of a continuous map to the preimage of a set. -/
+@[simps]
+def restrict_preimage (f : C(α, β)) (s : set β) : C(f ⁻¹' s, s) :=
+⟨s.restrict_preimage f, continuous_iff_continuous_at.mpr $ λ x, f.2.continuous_at.restrict_preimage⟩
+
 end restrict
 
 section gluing
@@ -229,11 +258,9 @@ begin
     rw set.mem_Union,
     obtain ⟨i, hi⟩ := hS x,
     exact ⟨i, mem_of_mem_nhds hi⟩ },
-  refine ⟨set.lift_cover S (λ i, φ i) hφ H, continuous_subtype_nhds_cover hS _⟩,
-  intros i,
-  convert (φ i).continuous,
-  ext x,
-  exact set.lift_cover_coe x,
+  refine ⟨set.lift_cover S (λ i, φ i) hφ H, continuous_of_cover_nhds hS $ λ i, _⟩,
+  rw [continuous_on_iff_continuous_restrict],
+  simpa only [set.restrict, set.lift_cover_coe] using (φ i).continuous
 end
 
 variables {S φ hφ hS}
@@ -281,9 +308,31 @@ end gluing
 
 end continuous_map
 
-/--
-The forward direction of a homeomorphism, as a bundled continuous map.
--/
+namespace homeomorph
+variables {α β γ : Type*} [topological_space α] [topological_space β] [topological_space γ]
+variables (f : α ≃ₜ β) (g : β ≃ₜ γ)
+
+/-- The forward direction of a homeomorphism, as a bundled continuous map. -/
 @[simps]
-def homeomorph.to_continuous_map {α β : Type*} [topological_space α] [topological_space β]
-  (e : α ≃ₜ β) : C(α, β) := ⟨e⟩
+def to_continuous_map (e : α ≃ₜ β) : C(α, β) := ⟨e⟩
+
+/--`homeomorph.to_continuous_map` as a coercion. -/
+instance : has_coe (α ≃ₜ β) C(α, β) := ⟨homeomorph.to_continuous_map⟩
+
+lemma to_continuous_map_as_coe : f.to_continuous_map = f := rfl
+
+@[simp] lemma coe_refl : (homeomorph.refl α : C(α, α)) = continuous_map.id α := rfl
+
+@[simp] lemma coe_trans : (f.trans g : C(α, γ)) = (g : C(β, γ)).comp f := rfl
+
+/-- Left inverse to a continuous map from a homeomorphism, mirroring `equiv.symm_comp_self`. -/
+@[simp] lemma symm_comp_to_continuous_map :
+  (f.symm : C(β, α)).comp (f : C(α, β)) = continuous_map.id α :=
+by rw [← coe_trans, self_trans_symm, coe_refl]
+
+/-- Right inverse to a continuous map from a homeomorphism, mirroring `equiv.self_comp_symm`. -/
+@[simp] lemma to_continuous_map_comp_symm :
+  (f : C(α, β)).comp (f.symm : C(β, α)) = continuous_map.id β :=
+by rw [← coe_trans, symm_trans_self, coe_refl]
+
+end homeomorph
diff --git a/src/topology/continuous_function/bounded.lean b/src/topology/continuous_function/bounded.lean
index 7ecf9de616238..3563a0c5729c6 100644
--- a/src/topology/continuous_function/bounded.lean
+++ b/src/topology/continuous_function/bounded.lean
@@ -3,22 +3,26 @@ Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel, Mario Carneiro, Yury Kudryashov, Heather Macbeth
 -/
-import analysis.normed_space.lattice_ordered_group
+import analysis.normed.order.lattice
 import analysis.normed_space.operator_norm
 import analysis.normed_space.star.basic
 import data.real.sqrt
 import topology.continuous_function.algebra
+import topology.metric_space.equicontinuity
 
 /-!
 # Bounded continuous functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The type of bounded continuous functions taking values in a metric space, with
 the uniform distance.
 
 -/
 
 noncomputable theory
-open_locale topological_space classical nnreal
+open_locale topology classical nnreal uniformity uniform_convergence
 
 open set filter metric function
 
@@ -37,7 +41,11 @@ structure bounded_continuous_function (α : Type u) (β : Type v)
   Type (max u v) :=
 (map_bounded' : ∃ C, ∀ x y, dist (to_fun x) (to_fun y) ≤ C)
 
-localized "infixr ` →ᵇ `:25 := bounded_continuous_function" in bounded_continuous_function
+localized "infixr (name := bounded_continuous_function)
+  ` →ᵇ `:25 := bounded_continuous_function" in bounded_continuous_function
+
+section
+set_option old_structure_cmd true
 
 /-- `bounded_continuous_map_class F α β` states that `F` is a type of bounded continuous maps.
 
@@ -46,6 +54,8 @@ class bounded_continuous_map_class (F α β : Type*) [topological_space α] [pse
   extends continuous_map_class F α β :=
 (map_bounded (f : F) : ∃ C, ∀ x y, dist (f x) (f y) ≤ C)
 
+end
+
 export bounded_continuous_map_class (map_bounded)
 
 namespace bounded_continuous_function
@@ -146,7 +156,7 @@ lemma dist_lt_of_nonempty_compact [nonempty α] [compact_space α]
 begin
   have c : continuous (λ x, dist (f x) (g x)), { continuity, },
   obtain ⟨x, -, le⟩ :=
-    is_compact.exists_forall_ge compact_univ set.univ_nonempty (continuous.continuous_on c),
+    is_compact.exists_forall_ge is_compact_univ set.univ_nonempty (continuous.continuous_on c),
   exact lt_of_le_of_lt (dist_le_iff_of_nonempty.mpr (λ y, le y trivial)) (w x),
 end
 
@@ -220,6 +230,20 @@ iff.intro
     λ n hn, lt_of_le_of_lt ((dist_le (half_pos ε_pos).le).mpr $
     λ x, dist_comm (f x) (F n x) ▸ le_of_lt (hn x)) (half_lt_self ε_pos)))
 
+/-- The topology on `α →ᵇ β` is exactly the topology induced by the natural map to `α →ᵤ β`. -/
+lemma inducing_coe_fn : inducing (uniform_fun.of_fun ∘ coe_fn : (α →ᵇ β) → (α →ᵤ β)) :=
+begin
+  rw inducing_iff_nhds,
+  refine λ f, eq_of_forall_le_iff (λ l, _),
+  rw [← tendsto_iff_comap, ← tendsto_id', tendsto_iff_tendsto_uniformly,
+      uniform_fun.tendsto_iff_tendsto_uniformly],
+  refl
+end
+
+-- TODO: upgrade to a `uniform_embedding`
+lemma embedding_coe_fn : embedding (uniform_fun.of_fun ∘ coe_fn : (α →ᵇ β) → (α →ᵤ β)) :=
+⟨inducing_coe_fn, λ f g h, ext $ λ x, congr_fun h x⟩
+
 variables (α) {β}
 
 /-- Constant as a continuous bounded function. -/
@@ -287,11 +311,17 @@ begin
 end
 
 /-- Composition of a bounded continuous function and a continuous function. -/
-@[simps { fully_applied := ff }]
 def comp_continuous {δ : Type*} [topological_space δ] (f : α →ᵇ β) (g : C(δ, α)) : δ →ᵇ β :=
 { to_continuous_map := f.1.comp g,
   map_bounded' := f.map_bounded'.imp (λ C hC x y, hC _ _) }
 
+@[simp] lemma coe_comp_continuous {δ : Type*} [topological_space δ] (f : α →ᵇ β) (g : C(δ, α)) :
+  coe_fn (f.comp_continuous g) = f ∘ g := rfl
+
+@[simp] lemma comp_continuous_apply {δ : Type*} [topological_space δ]
+  (f : α →ᵇ β) (g : C(δ, α)) (x : δ) : f.comp_continuous g x = f (g x) :=
+rfl
+
 lemma lipschitz_comp_continuous {δ : Type*} [topological_space δ] (g : C(δ, α)) :
   lipschitz_with 1 (λ f : α →ᵇ β, f.comp_continuous g) :=
 lipschitz_with.mk_one $ λ f₁ f₂, (dist_le dist_nonneg).2 $ λ x, dist_coe_le_dist (g x)
@@ -301,10 +331,13 @@ lemma continuous_comp_continuous {δ : Type*} [topological_space δ] (g : C(δ,
 (lipschitz_comp_continuous g).continuous
 
 /-- Restrict a bounded continuous function to a set. -/
-@[simps apply { fully_applied := ff }]
 def restrict (f : α →ᵇ β) (s : set α) : s →ᵇ β :=
 f.comp_continuous $ (continuous_map.id _).restrict s
 
+@[simp] lemma coe_restrict (f : α →ᵇ β) (s : set α) : coe_fn (f.restrict s) = f ∘ coe := rfl
+
+@[simp] lemma restrict_apply (f : α →ᵇ β) (s : set α) (x : s) : f.restrict s x = f x := rfl
+
 /-- Composition (in the target) of a bounded continuous function with a Lipschitz map again
 gives a bounded continuous function -/
 def comp (G : β → γ) {C : ℝ≥0} (H : lipschitz_with C G)
@@ -336,7 +369,7 @@ lemma continuous_comp {G : β → γ} {C : ℝ≥0} (H : lipschitz_with C G) :
 
 /-- Restriction (in the target) of a bounded continuous function taking values in a subset -/
 def cod_restrict (s : set β) (f : α →ᵇ β) (H : ∀x, f x ∈ s) : α →ᵇ s :=
-⟨⟨s.cod_restrict f H, continuous_subtype_mk _ f.continuous⟩, f.bounded⟩
+⟨⟨s.cod_restrict f H, f.continuous.subtype_mk _⟩, f.bounded⟩
 
 section extend
 
@@ -355,7 +388,7 @@ def extend (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) : δ →ᵇ β
 
 @[simp] lemma extend_apply (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) (x : α) :
   extend f g h (f x) = g x :=
-extend_apply f.injective _ _ _
+f.injective.extend_apply _ _ _
 
 @[simp] lemma extend_comp (f : α ↪ δ) (g : α →ᵇ β) (h : δ →ᵇ β) : extend f g h ∘ f = g :=
 extend_comp f.injective _ _
@@ -392,7 +425,7 @@ end
 
 lemma isometry_extend (f : α ↪ δ) (h : δ →ᵇ β) :
   isometry (λ g : α →ᵇ β, extend f g h) :=
-isometry_emetric_iff_metric.2 $ λ g₁ g₂, by simp [dist_nonneg]
+isometry.of_dist_eq $ λ g₁ g₂, by simp [dist_nonneg]
 
 end extend
 
@@ -411,11 +444,11 @@ and several useful variations around it. -/
 theorem arzela_ascoli₁ [compact_space β]
   (A : set (α →ᵇ β))
   (closed : is_closed A)
-  (H : ∀ (x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε) :
+  (H : equicontinuous (coe_fn : A → α → β)) :
   is_compact A :=
 begin
-  refine compact_of_totally_bounded_is_closed _ closed,
+  simp_rw [equicontinuous, metric.equicontinuous_at_iff_pair] at H,
+  refine is_compact_of_totally_bounded_is_closed _ closed,
   refine totally_bounded_of_finite_discretization (λ ε ε0, _),
   rcases exists_between ε0 with ⟨ε₁, ε₁0, εε₁⟩,
   let ε₂ := ε₁/2/2,
@@ -431,16 +464,16 @@ begin
     f ∈ A → dist (f y) (f z) < ε₂ := λ x,
       let ⟨U, nhdsU, hU⟩ := H x _ ε₂0,
           ⟨V, VU, openV, xV⟩ := _root_.mem_nhds_iff.1 nhdsU in
-      ⟨V, xV, openV, λy hy z hz f hf, hU y (VU hy) z (VU hz) f hf⟩,
+      ⟨V, xV, openV, λy hy z hz f hf, hU y (VU hy) z (VU hz) ⟨f, hf⟩⟩,
   choose U hU using this,
   /- For all x, the set hU x is an open set containing x on which the elements of A
   fluctuate by at most ε₂.
   We extract finitely many of these sets that cover the whole space, by compactness -/
-  rcases compact_univ.elim_finite_subcover_image
+  rcases is_compact_univ.elim_finite_subcover_image
     (λx _, (hU x).2.1) (λx hx, mem_bUnion (mem_univ _) (hU x).1)
     with ⟨tα, _, ⟨_⟩, htα⟩,
   /- tα : set α, htα : univ ⊆ ⋃x ∈ tα, U x -/
-  rcases @finite_cover_balls_of_compact β _ _ compact_univ _ ε₂0
+  rcases @finite_cover_balls_of_compact β _ _ is_compact_univ _ ε₂0
     with ⟨tβ, _, ⟨_⟩, htβ⟩, resetI,
   /- tβ : set β, htβ : univ ⊆ ⋃y ∈ tβ, ball y ε₂ -/
   /- Associate to every point `y` in the space a nearby point `F y` in tβ -/
@@ -475,21 +508,19 @@ theorem arzela_ascoli₂
   (A : set (α →ᵇ β))
   (closed : is_closed A)
   (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
-  (H : ∀(x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε) :
+  (H : equicontinuous (coe_fn : A → α → β)) :
   is_compact A :=
 /- This version is deduced from the previous one by restricting to the compact type in the target,
 using compactness there and then lifting everything to the original space. -/
 begin
   have M : lipschitz_with 1 coe := lipschitz_with.subtype_coe s,
   let F : (α →ᵇ s) → α →ᵇ β := comp coe M,
-  refine compact_of_is_closed_subset
+  refine is_compact_of_is_closed_subset
     ((_ : is_compact (F ⁻¹' A)).image (continuous_comp M)) closed (λ f hf, _),
   { haveI : compact_space s := is_compact_iff_compact_space.1 hs,
-    refine arzela_ascoli₁ _ (continuous_iff_is_closed.1 (continuous_comp M) _ closed)
-      (λ x ε ε0, bex.imp_right (λ U U_nhds hU y hy z hz f hf, _) (H x ε ε0)),
-    calc dist (f y) (f z) = dist (F f y) (F f z) : rfl
-                        ... < ε : hU y hy z hz (F f) hf },
+    refine arzela_ascoli₁ _ (continuous_iff_is_closed.1 (continuous_comp M) _ closed) _,
+    rw uniform_embedding_subtype_coe.to_uniform_inducing.equicontinuous_iff,
+    exact H.comp (A.restrict_preimage F) },
   { let g := cod_restrict s f (λx, in_s f x hf),
     rw [show f = F g, by ext; refl] at hf ⊢,
     exact ⟨g, hf, rfl⟩ }
@@ -501,8 +532,7 @@ theorem arzela_ascoli [t2_space β]
   (s : set β) (hs : is_compact s)
   (A : set (α →ᵇ β))
   (in_s : ∀(f : α →ᵇ β) (x : α), f ∈ A → f x ∈ s)
-  (H : ∀(x:α) (ε > 0), ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε) :
+  (H : equicontinuous (coe_fn : A → α → β)) :
   is_compact (closure A) :=
 /- This version is deduced from the previous one by checking that the closure of A, in
 addition to being closed, still satisfies the properties of compact range and equicontinuity -/
@@ -510,42 +540,7 @@ arzela_ascoli₂ s hs (closure A) is_closed_closure
   (λ f x hf, (mem_of_closed' hs.is_closed).2 $ λ ε ε0,
     let ⟨g, gA, dist_fg⟩ := metric.mem_closure_iff.1 hf ε ε0 in
     ⟨g x, in_s g x gA, lt_of_le_of_lt (dist_coe_le_dist _) dist_fg⟩)
-  (λ x ε ε0, show ∃ U ∈ 𝓝 x,
-      ∀ y z ∈ U, ∀ (f : α →ᵇ β), f ∈ closure A → dist (f y) (f z) < ε,
-    begin
-      refine bex.imp_right (λ U U_set hU y hy z hz f hf, _) (H x (ε/2) (half_pos ε0)),
-      rcases metric.mem_closure_iff.1 hf (ε/2/2) (half_pos (half_pos ε0)) with ⟨g, gA, dist_fg⟩,
-      replace dist_fg := λ x, lt_of_le_of_lt (dist_coe_le_dist x) dist_fg,
-      calc dist (f y) (f z) ≤ dist (f y) (g y) + dist (f z) (g z) + dist (g y) (g z) :
-        dist_triangle4_right _ _ _ _
-          ... < ε/2/2 + ε/2/2 + ε/2 :
-            add_lt_add (add_lt_add (dist_fg y) (dist_fg z)) (hU y hy z hz g gA)
-          ... = ε : by rw [add_halves, add_halves]
-    end)
-
-/- To apply the previous theorems, one needs to check the equicontinuity. An important
-instance is when the source space is a metric space, and there is a fixed modulus of continuity
-for all the functions in the set A -/
-
-lemma equicontinuous_of_continuity_modulus {α : Type u} [pseudo_metric_space α]
-  (b : ℝ → ℝ) (b_lim : tendsto b (𝓝 0) (𝓝 0))
-  (A : set (α →ᵇ β))
-  (H : ∀(x y:α) (f : α →ᵇ β), f ∈ A → dist (f x) (f y) ≤ b (dist x y))
-  (x:α) (ε : ℝ) (ε0 : 0 < ε) : ∃U ∈ 𝓝 x, ∀ (y z ∈ U) (f : α →ᵇ β),
-    f ∈ A → dist (f y) (f z) < ε :=
-begin
-  rcases tendsto_nhds_nhds.1 b_lim ε ε0 with ⟨δ, δ0, hδ⟩,
-  refine ⟨ball x (δ/2), ball_mem_nhds x (half_pos δ0), λ y hy z hz f hf, _⟩,
-  have : dist y z < δ := calc
-    dist y z ≤ dist y x + dist z x : dist_triangle_right _ _ _
-    ... < δ/2 + δ/2 : add_lt_add hy hz
-    ... = δ : add_halves _,
-  calc
-    dist (f y) (f z) ≤ b (dist y z) : H y z f hf
-    ... ≤ |b (dist y z)| : le_abs_self _
-    ... = dist (b (dist y z)) 0 : by simp [real.dist_eq]
-    ... < ε : hδ (by simpa [real.dist_eq] using this),
-end
+  (H.closure' continuous_coe)
 
 end arzela_ascoli
 
@@ -612,7 +607,7 @@ lemma add_comp_continuous [topological_space γ] (h : C(γ, α)) :
 | 0 := by rw [nsmul_rec, zero_smul, coe_zero]
 | (n + 1) := by rw [nsmul_rec, succ_nsmul, coe_add, coe_nsmul_rec]
 
-instance has_nat_scalar : has_scalar ℕ (α →ᵇ β) :=
+instance has_nat_scalar : has_smul ℕ (α →ᵇ β) :=
 { smul := λ n f,
   { to_continuous_map := n • f.to_continuous_map,
     map_bounded' := by simpa [coe_nsmul_rec] using (nsmul_rec n f).map_bounded' } }
@@ -635,7 +630,8 @@ instance : has_lipschitz_add (α →ᵇ β) :=
     apply max_le_max; exact dist_coe_le_dist x,
   end⟩ }
 
-/-- Coercion of a `normed_group_hom` is an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn` -/
+/-- Coercion of a `normed_add_group_hom` is an `add_monoid_hom`. Similar to
+`add_monoid_hom.coe_fn`. -/
 @[simps] def coe_fn_add_hom : (α →ᵇ β) →+ (α → β) :=
 { to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add }
 
@@ -670,27 +666,27 @@ by simp
 
 end comm_has_lipschitz_add
 
-section normed_group
+section normed_add_comm_group
 /- In this section, if β is a normed group, then we show that the space of bounded
 continuous functions from α to β inherits a normed group structure, by using
 pointwise operations and checking that they are compatible with the uniform distance. -/
 
-variables [topological_space α] [semi_normed_group β]
+variables [topological_space α] [seminormed_add_comm_group β]
 variables (f g : α →ᵇ β) {x : α} {C : ℝ}
 
 instance : has_norm (α →ᵇ β) := ⟨λu, dist u 0⟩
 
-lemma norm_def : ∥f∥ = dist f 0 := rfl
+lemma norm_def : ‖f‖ = dist f 0 := rfl
 
-/-- The norm of a bounded continuous function is the supremum of `∥f x∥`.
+/-- The norm of a bounded continuous function is the supremum of `‖f x‖`.
 We use `Inf` to ensure that the definition works if `α` has no elements. -/
 lemma norm_eq (f : α →ᵇ β) :
-  ∥f∥ = Inf {C : ℝ | 0 ≤ C ∧ ∀ (x : α), ∥f x∥ ≤ C} :=
+  ‖f‖ = Inf {C : ℝ | 0 ≤ C ∧ ∀ (x : α), ‖f x‖ ≤ C} :=
 by simp [norm_def, bounded_continuous_function.dist_eq]
 
-/-- When the domain is non-empty, we do not need the `0 ≤ C` condition in the formula for ∥f∥ as an
+/-- When the domain is non-empty, we do not need the `0 ≤ C` condition in the formula for ‖f‖ as an
 `Inf`. -/
-lemma norm_eq_of_nonempty [h : nonempty α] : ∥f∥ = Inf {C : ℝ | ∀ (x : α), ∥f x∥ ≤ C} :=
+lemma norm_eq_of_nonempty [h : nonempty α] : ‖f‖ = Inf {C : ℝ | ∀ (x : α), ‖f x‖ ≤ C} :=
 begin
   unfreezingI { obtain ⟨a⟩ := h, },
   rw norm_eq,
@@ -700,45 +696,45 @@ begin
   exact λ h', le_trans (norm_nonneg (f a)) (h' a),
 end
 
-@[simp] lemma norm_eq_zero_of_empty [h : is_empty α] : ∥f∥ = 0 :=
+@[simp] lemma norm_eq_zero_of_empty [h : is_empty α] : ‖f‖ = 0 :=
 dist_zero_of_empty
 
-lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ := calc
-  ∥f x∥ = dist (f x) ((0 : α →ᵇ β) x) : by simp [dist_zero_right]
-  ... ≤ ∥f∥ : dist_coe_le_dist _
+lemma norm_coe_le_norm (x : α) : ‖f x‖ ≤ ‖f‖ := calc
+  ‖f x‖ = dist (f x) ((0 : α →ᵇ β) x) : by simp [dist_zero_right]
+  ... ≤ ‖f‖ : dist_coe_le_dist _
 
-lemma dist_le_two_norm' {f : γ → β} {C : ℝ} (hC : ∀ x, ∥f x∥ ≤ C) (x y : γ) :
+lemma dist_le_two_norm' {f : γ → β} {C : ℝ} (hC : ∀ x, ‖f x‖ ≤ C) (x y : γ) :
   dist (f x) (f y) ≤ 2 * C :=
-calc dist (f x) (f y) ≤ ∥f x∥ + ∥f y∥ : dist_le_norm_add_norm _ _
+calc dist (f x) (f y) ≤ ‖f x‖ + ‖f y‖ : dist_le_norm_add_norm _ _
                   ... ≤ C + C         : add_le_add (hC x) (hC y)
                   ... = 2 * C         : (two_mul _).symm
 
 /-- Distance between the images of any two points is at most twice the norm of the function. -/
-lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ∥f∥ :=
+lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ‖f‖ :=
 dist_le_two_norm' f.norm_coe_le_norm x y
 
 variable {f}
 
 /-- The norm of a function is controlled by the supremum of the pointwise norms -/
-lemma norm_le (C0 : (0 : ℝ) ≤ C) : ∥f∥ ≤ C ↔ ∀x:α, ∥f x∥ ≤ C :=
+lemma norm_le (C0 : (0 : ℝ) ≤ C) : ‖f‖ ≤ C ↔ ∀x:α, ‖f x‖ ≤ C :=
 by simpa using @dist_le _ _ _ _ f 0 _ C0
 
 lemma norm_le_of_nonempty [nonempty α]
-  {f : α →ᵇ β} {M : ℝ} : ∥f∥ ≤ M ↔ ∀ x, ∥f x∥ ≤ M :=
+  {f : α →ᵇ β} {M : ℝ} : ‖f‖ ≤ M ↔ ∀ x, ‖f x‖ ≤ M :=
 begin
   simp_rw [norm_def, ←dist_zero_right],
   exact dist_le_iff_of_nonempty,
 end
 
 lemma norm_lt_iff_of_compact [compact_space α]
-  {f : α →ᵇ β} {M : ℝ} (M0 : 0 < M) : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
+  {f : α →ᵇ β} {M : ℝ} (M0 : 0 < M) : ‖f‖ < M ↔ ∀ x, ‖f x‖ < M :=
 begin
   simp_rw [norm_def, ←dist_zero_right],
   exact dist_lt_iff_of_compact M0,
 end
 
 lemma norm_lt_iff_of_nonempty_compact [nonempty α] [compact_space α]
-  {f : α →ᵇ β} {M : ℝ} : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
+  {f : α →ᵇ β} {M : ℝ} : ‖f‖ < M ↔ ∀ x, ‖f x‖ < M :=
 begin
   simp_rw [norm_def, ←dist_zero_right],
   exact dist_lt_iff_of_nonempty_compact,
@@ -746,65 +742,69 @@ end
 
 variable (f)
 
-/-- Norm of `const α b` is less than or equal to `∥b∥`. If `α` is nonempty,
-then it is equal to `∥b∥`. -/
-lemma norm_const_le (b : β) : ∥const α b∥ ≤ ∥b∥ :=
+/-- Norm of `const α b` is less than or equal to `‖b‖`. If `α` is nonempty,
+then it is equal to `‖b‖`. -/
+lemma norm_const_le (b : β) : ‖const α b‖ ≤ ‖b‖ :=
 (norm_le (norm_nonneg b)).2 $ λ x, le_rfl
 
-@[simp] lemma norm_const_eq [h : nonempty α] (b : β) : ∥const α b∥ = ∥b∥ :=
+@[simp] lemma norm_const_eq [h : nonempty α] (b : β) : ‖const α b‖ = ‖b‖ :=
 le_antisymm (norm_const_le b) $ h.elim $ λ x, (const α b).norm_coe_le_norm x
 
 /-- Constructing a bounded continuous function from a uniformly bounded continuous
 function taking values in a normed group. -/
-def of_normed_group {α : Type u} {β : Type v} [topological_space α] [semi_normed_group β]
-  (f : α → β) (Hf : continuous f) (C : ℝ) (H : ∀x, ∥f x∥ ≤ C) : α →ᵇ β :=
+def of_normed_add_comm_group {α : Type u} {β : Type v} [topological_space α]
+  [seminormed_add_comm_group β] (f : α → β) (Hf : continuous f) (C : ℝ) (H : ∀x, ‖f x‖ ≤ C) :
+  α →ᵇ β :=
 ⟨⟨λn, f n, Hf⟩, ⟨_, dist_le_two_norm' H⟩⟩
 
-@[simp] lemma coe_of_normed_group
-  {α : Type u} {β : Type v} [topological_space α] [semi_normed_group β]
-  (f : α → β) (Hf : continuous f) (C : ℝ) (H : ∀x, ∥f x∥ ≤ C) :
-  (of_normed_group f Hf C H : α → β) = f := rfl
+@[simp] lemma coe_of_normed_add_comm_group
+  {α : Type u} {β : Type v} [topological_space α] [seminormed_add_comm_group β]
+  (f : α → β) (Hf : continuous f) (C : ℝ) (H : ∀x, ‖f x‖ ≤ C) :
+  (of_normed_add_comm_group f Hf C H : α → β) = f := rfl
 
-lemma norm_of_normed_group_le {f : α → β} (hfc : continuous f) {C : ℝ} (hC : 0 ≤ C)
-  (hfC : ∀ x, ∥f x∥ ≤ C) : ∥of_normed_group f hfc C hfC∥ ≤ C :=
+lemma norm_of_normed_add_comm_group_le {f : α → β} (hfc : continuous f) {C : ℝ} (hC : 0 ≤ C)
+  (hfC : ∀ x, ‖f x‖ ≤ C) : ‖of_normed_add_comm_group f hfc C hfC‖ ≤ C :=
 (norm_le hC).2 hfC
 
 /-- Constructing a bounded continuous function from a uniformly bounded
 function on a discrete space, taking values in a normed group -/
-def of_normed_group_discrete {α : Type u} {β : Type v}
-  [topological_space α] [discrete_topology α] [semi_normed_group β]
+def of_normed_add_comm_group_discrete {α : Type u} {β : Type v}
+  [topological_space α] [discrete_topology α] [seminormed_add_comm_group β]
   (f : α  → β) (C : ℝ) (H : ∀x, norm (f x) ≤ C) : α →ᵇ β :=
-of_normed_group f continuous_of_discrete_topology C H
+of_normed_add_comm_group f continuous_of_discrete_topology C H
 
-@[simp] lemma coe_of_normed_group_discrete
-  {α : Type u} {β : Type v} [topological_space α] [discrete_topology α] [semi_normed_group β]
-  (f : α → β) (C : ℝ) (H : ∀x, ∥f x∥ ≤ C) :
-  (of_normed_group_discrete f C H : α → β) = f := rfl
+@[simp] lemma coe_of_normed_add_comm_group_discrete {α : Type u} {β : Type v} [topological_space α]
+  [discrete_topology α] [seminormed_add_comm_group β] (f : α → β) (C : ℝ) (H : ∀x, ‖f x‖ ≤ C) :
+  (of_normed_add_comm_group_discrete f C H : α → β) = f := rfl
 
-/-- Taking the pointwise norm of a bounded continuous function with values in a `semi_normed_group`,
-yields a bounded continuous function with values in ℝ. -/
+/-- Taking the pointwise norm of a bounded continuous function with values in a
+`seminormed_add_comm_group` yields a bounded continuous function with values in ℝ. -/
 def norm_comp : α →ᵇ ℝ :=
 f.comp norm lipschitz_with_one_norm
 
 @[simp] lemma coe_norm_comp : (f.norm_comp : α → ℝ) = norm ∘ f := rfl
 
-@[simp] lemma norm_norm_comp : ∥f.norm_comp∥ = ∥f∥ :=
+@[simp] lemma norm_norm_comp : ‖f.norm_comp‖ = ‖f‖ :=
 by simp only [norm_eq, coe_norm_comp, norm_norm]
 
 lemma bdd_above_range_norm_comp : bdd_above $ set.range $ norm ∘ f :=
 (real.bounded_iff_bdd_below_bdd_above.mp $ @bounded_range _ _ _ _ f.norm_comp).2
 
-lemma norm_eq_supr_norm : ∥f∥ = ⨆ x : α, ∥f x∥ :=
+lemma norm_eq_supr_norm : ‖f‖ = ⨆ x : α, ‖f x‖ :=
 by simp_rw [norm_def, dist_eq_supr, coe_zero, pi.zero_apply, dist_zero_right]
 
+/-- If `‖(1 : β)‖ = 1`, then `‖(1 : α →ᵇ β)‖ = 1` if `α` is nonempty. -/
+instance [nonempty α] [has_one β] [norm_one_class β] : norm_one_class (α →ᵇ β) :=
+{ norm_one := by simp only [norm_eq_supr_norm, coe_one, pi.one_apply, norm_one, csupr_const] }
+
 /-- The pointwise opposite of a bounded continuous function is again bounded continuous. -/
 instance : has_neg (α →ᵇ β) :=
-⟨λf, of_normed_group (-f) f.continuous.neg ∥f∥ $ λ x,
+⟨λf, of_normed_add_comm_group (-f) f.continuous.neg ‖f‖ $ λ x,
   trans_rel_right _ (norm_neg _) (f.norm_coe_le_norm x)⟩
 
 /-- The pointwise difference of two bounded continuous functions is again bounded continuous. -/
 instance : has_sub (α →ᵇ β) :=
-⟨λf g, of_normed_group (f - g) (f.continuous.sub g.continuous) (∥f∥ + ∥g∥) $ λ x,
+⟨λf g, of_normed_add_comm_group (f - g) (f.continuous.sub g.continuous) (‖f‖ + ‖g‖) $ λ x,
   by { simp only [sub_eq_add_neg],
        exact le_trans (norm_add_le _ _) (add_le_add (f.norm_coe_le_norm x) $
          trans_rel_right _ (norm_neg _) (g.norm_coe_le_norm x)) }⟩
@@ -825,7 +825,7 @@ lemma sub_apply : (f - g) x = f x - g x := rfl
 | (int.of_nat n) := by rw [zsmul_rec, int.of_nat_eq_coe, coe_nsmul_rec, coe_nat_zsmul]
 | -[1+ n] := by rw [zsmul_rec, zsmul_neg_succ_of_nat, coe_neg, coe_nsmul_rec]
 
-instance has_int_scalar : has_scalar ℤ (α →ᵇ β) :=
+instance has_int_scalar : has_smul ℤ (α →ᵇ β) :=
 { smul := λ n f,
   { to_continuous_map := n • f.to_continuous_map,
     map_bounded' := by simpa using (zsmul_rec n f).map_bounded' } }
@@ -837,43 +837,43 @@ instance : add_comm_group (α →ᵇ β) :=
 fun_like.coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, coe_nsmul _ _)
   (λ _ _, coe_zsmul _ _)
 
-instance : semi_normed_group (α →ᵇ β) :=
+instance : seminormed_add_comm_group (α →ᵇ β) :=
 { dist_eq := λ f g, by simp only [norm_eq, dist_eq, dist_eq_norm, sub_apply] }
 
-instance {α β} [topological_space α] [normed_group β] : normed_group (α →ᵇ β) :=
-{ ..bounded_continuous_function.semi_normed_group }
+instance {α β} [topological_space α] [normed_add_comm_group β] : normed_add_comm_group (α →ᵇ β) :=
+{ ..bounded_continuous_function.seminormed_add_comm_group }
 
-lemma nnnorm_def : ∥f∥₊ = nndist f 0 := rfl
+lemma nnnorm_def : ‖f‖₊ = nndist f 0 := rfl
 
-lemma nnnorm_coe_le_nnnorm (x : α) : ∥f x∥₊ ≤ ∥f∥₊ := norm_coe_le_norm _ _
+lemma nnnorm_coe_le_nnnorm (x : α) : ‖f x‖₊ ≤ ‖f‖₊ := norm_coe_le_norm _ _
 
-lemma nndist_le_two_nnnorm (x y : α) : nndist (f x) (f y) ≤ 2 * ∥f∥₊ := dist_le_two_norm _ _ _
+lemma nndist_le_two_nnnorm (x y : α) : nndist (f x) (f y) ≤ 2 * ‖f‖₊ := dist_le_two_norm _ _ _
 
 /-- The nnnorm of a function is controlled by the supremum of the pointwise nnnorms -/
-lemma nnnorm_le (C : ℝ≥0) : ∥f∥₊ ≤ C ↔ ∀x:α, ∥f x∥₊ ≤ C :=
+lemma nnnorm_le (C : ℝ≥0) : ‖f‖₊ ≤ C ↔ ∀x:α, ‖f x‖₊ ≤ C :=
 norm_le C.prop
 
-lemma nnnorm_const_le (b : β) : ∥const α b∥₊ ≤ ∥b∥₊ :=
+lemma nnnorm_const_le (b : β) : ‖const α b‖₊ ≤ ‖b‖₊ :=
 norm_const_le _
 
-@[simp] lemma nnnorm_const_eq [h : nonempty α] (b : β) : ∥const α b∥₊ = ∥b∥₊ :=
+@[simp] lemma nnnorm_const_eq [h : nonempty α] (b : β) : ‖const α b‖₊ = ‖b‖₊ :=
 subtype.ext $ norm_const_eq _
 
-lemma nnnorm_eq_supr_nnnorm : ∥f∥₊ = ⨆ x : α, ∥f x∥₊ :=
+lemma nnnorm_eq_supr_nnnorm : ‖f‖₊ = ⨆ x : α, ‖f x‖₊ :=
 subtype.ext $ (norm_eq_supr_norm f).trans $ by simp_rw [nnreal.coe_supr, coe_nnnorm]
 
-lemma abs_diff_coe_le_dist : ∥f x - g x∥ ≤ dist f g :=
+lemma abs_diff_coe_le_dist : ‖f x - g x‖ ≤ dist f g :=
 by { rw dist_eq_norm, exact (f - g).norm_coe_le_norm x }
 
 lemma coe_le_coe_add_dist {f g : α →ᵇ ℝ} : f x ≤ g x + dist f g :=
 sub_le_iff_le_add'.1 $ (abs_le.1 $ @dist_coe_le_dist _ _ _ _ f g x).2
 
 lemma norm_comp_continuous_le [topological_space γ] (f : α →ᵇ β) (g : C(γ, α)) :
-  ∥f.comp_continuous g∥ ≤ ∥f∥ :=
+  ‖f.comp_continuous g‖ ≤ ‖f‖ :=
 ((lipschitz_comp_continuous g).dist_le_mul f 0).trans $
   by rw [nnreal.coe_one, one_mul, dist_zero_right]
 
-end normed_group
+end normed_add_comm_group
 
 section has_bounded_smul
 /-!
@@ -887,10 +887,10 @@ using pointwise operations and checking that they are compatible with the unifor
 
 variables {𝕜 : Type*} [pseudo_metric_space 𝕜] [topological_space α] [pseudo_metric_space β]
 
-section has_scalar
-variables [has_zero 𝕜] [has_zero β] [has_scalar 𝕜 β] [has_bounded_smul 𝕜 β]
+section has_smul
+variables [has_zero 𝕜] [has_zero β] [has_smul 𝕜 β] [has_bounded_smul 𝕜 β]
 
-instance : has_scalar 𝕜 (α →ᵇ β) :=
+instance : has_smul 𝕜 (α →ᵇ β) :=
 { smul := λ c f,
   { to_continuous_map := c • f.to_continuous_map,
     map_bounded' := let ⟨b, hb⟩ := f.bounded in ⟨dist c 0 * b, λ x y, begin
@@ -902,7 +902,7 @@ instance : has_scalar 𝕜 (α →ᵇ β) :=
 @[simp] lemma coe_smul (c : 𝕜) (f : α →ᵇ β) : ⇑(c • f) = λ x, c • (f x) := rfl
 lemma smul_apply (c : 𝕜) (f : α →ᵇ β) (x : α) : (c • f) x = c • f x := rfl
 
-instance [has_scalar 𝕜ᵐᵒᵖ β] [is_central_scalar 𝕜 β] : is_central_scalar 𝕜 (α →ᵇ β) :=
+instance [has_smul 𝕜ᵐᵒᵖ β] [is_central_scalar 𝕜 β] : is_central_scalar 𝕜 (α →ᵇ β) :=
 { op_smul_eq_smul := λ _ _, ext $ λ _, op_smul_eq_smul _ _ }
 
 instance : has_bounded_smul 𝕜 (α →ᵇ β) :=
@@ -920,7 +920,7 @@ instance : has_bounded_smul 𝕜 (α →ᵇ β) :=
     simp
   end }
 
-end has_scalar
+end has_smul
 
 section mul_action
 variables [monoid_with_zero 𝕜] [has_zero β] [mul_action 𝕜 β] [has_bounded_smul 𝕜 β]
@@ -979,16 +979,16 @@ continuous functions from `α` to `β` inherits a normed space structure, by usi
 pointwise operations and checking that they are compatible with the uniform distance. -/
 
 variables {𝕜 : Type*}
-variables [topological_space α] [semi_normed_group β]
+variables [topological_space α] [seminormed_add_comm_group β]
 variables {f g : α →ᵇ β} {x : α} {C : ℝ}
 
 instance [normed_field 𝕜] [normed_space 𝕜 β] : normed_space 𝕜 (α →ᵇ β) := ⟨λ c f, begin
-  refine norm_of_normed_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _,
+  refine norm_of_normed_add_comm_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _,
   exact (λ x, trans_rel_right _ (norm_smul _ _)
     (mul_le_mul_of_nonneg_left (f.norm_coe_le_norm _) (norm_nonneg _))) end⟩
 
-variables [nondiscrete_normed_field 𝕜] [normed_space 𝕜 β]
-variables [semi_normed_group γ] [normed_space 𝕜 γ]
+variables [nontrivially_normed_field 𝕜] [normed_space 𝕜 β]
+variables [seminormed_add_comm_group γ] [normed_space 𝕜 γ]
 
 variables (α)
 -- TODO does this work in the `has_bounded_smul` setting, too?
@@ -1000,15 +1000,15 @@ Upgraded version of `continuous_linear_map.comp_left_continuous`, similar to
 protected def _root_.continuous_linear_map.comp_left_continuous_bounded (g : β →L[𝕜] γ) :
   (α →ᵇ β) →L[𝕜] (α →ᵇ γ) :=
 linear_map.mk_continuous
-  { to_fun := λ f, of_normed_group
+  { to_fun := λ f, of_normed_add_comm_group
       (g ∘ f)
       (g.continuous.comp f.continuous)
-      (∥g∥ * ∥f∥)
+      (‖g‖ * ‖f‖)
       (λ x, (g.le_op_norm_of_le (f.norm_coe_le_norm x))),
     map_add' := λ f g, by ext; simp,
     map_smul' := λ c f, by ext; simp }
-  ∥g∥
-  (λ f, norm_of_normed_group_le _ (mul_nonneg (norm_nonneg g) (norm_nonneg f)) _)
+  ‖g‖
+  (λ f, norm_of_normed_add_comm_group_le _ (mul_nonneg (norm_nonneg g) (norm_nonneg f)) _)
 
 @[simp] lemma _root_.continuous_linear_map.comp_left_continuous_bounded_apply (g : β →L[𝕜] γ)
   (f : α →ᵇ β) (x : α) :
@@ -1033,7 +1033,7 @@ section semi_normed
 variables [non_unital_semi_normed_ring R]
 
 instance : has_mul (α →ᵇ R) :=
-{ mul := λ f g, of_normed_group (f * g) (f.continuous.mul g.continuous) (∥f∥ * ∥g∥) $ λ x,
+{ mul := λ f g, of_normed_add_comm_group (f * g) (f.continuous.mul g.continuous) (‖f‖ * ‖g‖) $ λ x,
     le_trans (norm_mul_le (f x) (g x)) $
       mul_le_mul (f.norm_coe_le_norm x) (g.norm_coe_le_norm x) (norm_nonneg _) (norm_nonneg _) }
 
@@ -1045,14 +1045,15 @@ fun_like.coe_injective.non_unital_ring _ coe_zero coe_add coe_mul coe_neg coe_su
   (λ _ _, coe_nsmul _ _) (λ _ _, coe_zsmul _ _)
 
 instance : non_unital_semi_normed_ring (α →ᵇ R) :=
-{ norm_mul := λ f g, norm_of_normed_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _,
-  .. bounded_continuous_function.semi_normed_group }
+{ norm_mul := λ f g, norm_of_normed_add_comm_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _))
+    _,
+  .. bounded_continuous_function.seminormed_add_comm_group }
 
 end semi_normed
 
 instance [non_unital_normed_ring R] : non_unital_normed_ring (α →ᵇ R) :=
 { .. bounded_continuous_function.non_unital_semi_normed_ring,
-  .. bounded_continuous_function.normed_group }
+  .. bounded_continuous_function.normed_add_comm_group }
 
 end non_unital
 
@@ -1072,11 +1073,23 @@ instance has_nat_pow : has_pow (α →ᵇ R) ℕ :=
 @[simp] lemma coe_pow (n : ℕ) (f : α →ᵇ R) : ⇑(f ^ n) = f ^ n := rfl
 @[simp] lemma pow_apply (n : ℕ) (f : α →ᵇ R) (v : α) : (f ^ n) v = f v ^ n := rfl
 
+instance : has_nat_cast (α →ᵇ R) :=
+⟨λ n, bounded_continuous_function.const _ n⟩
+
+@[simp, norm_cast] lemma coe_nat_cast (n : ℕ) : ((n : α →ᵇ R) : α → R) = n := rfl
+
+instance : has_int_cast (α →ᵇ R) :=
+⟨λ n, bounded_continuous_function.const _ n⟩
+
+@[simp, norm_cast] lemma coe_int_cast (n : ℤ) : ((n : α →ᵇ R) : α → R) = n := rfl
+
 instance : ring (α →ᵇ R) :=
 fun_like.coe_injective.ring _ coe_zero coe_one coe_add coe_mul coe_neg coe_sub
   (λ _ _, coe_nsmul _ _)
   (λ _ _, coe_zsmul _ _)
   (λ _ _, coe_pow _ _)
+  coe_nat_cast
+  coe_int_cast
 
 instance : semi_normed_ring (α →ᵇ R) :=
 { ..bounded_continuous_function.non_unital_semi_normed_ring }
@@ -1103,10 +1116,10 @@ instance [semi_normed_comm_ring R] : comm_ring (α →ᵇ R) :=
   .. bounded_continuous_function.ring }
 
 instance [semi_normed_comm_ring R] : semi_normed_comm_ring (α →ᵇ R) :=
-{ .. bounded_continuous_function.comm_ring, .. bounded_continuous_function.semi_normed_group }
+{ ..bounded_continuous_function.comm_ring, ..bounded_continuous_function.seminormed_add_comm_group }
 
 instance [normed_comm_ring R] : normed_comm_ring (α →ᵇ R) :=
-{ .. bounded_continuous_function.comm_ring, .. bounded_continuous_function.normed_group }
+{ .. bounded_continuous_function.comm_ring, .. bounded_continuous_function.normed_add_comm_group }
 
 end normed_comm_ring
 
@@ -1119,7 +1132,7 @@ continuous functions from `α` to `γ` inherits a normed algebra structure, by u
 pointwise operations and checking that they are compatible with the uniform distance. -/
 
 variables {𝕜 : Type*} [normed_field 𝕜]
-variables [topological_space α] [semi_normed_group β] [normed_space 𝕜 β]
+variables [topological_space α] [seminormed_add_comm_group β] [normed_space 𝕜 β]
 variables [normed_ring γ] [normed_algebra 𝕜 γ]
 variables {f g : α →ᵇ γ} {x : α} {c : 𝕜}
 
@@ -1152,11 +1165,11 @@ If `β` is a normed `𝕜`-space, then we show that the space of bounded continu
 functions from `α` to `β` is naturally a module over the algebra of bounded continuous
 functions from `α` to `𝕜`. -/
 
-instance has_scalar' : has_scalar (α →ᵇ 𝕜) (α →ᵇ β) :=
-⟨λ (f : α →ᵇ 𝕜) (g : α →ᵇ β), of_normed_group (λ x, (f x) • (g x))
-(f.continuous.smul g.continuous) (∥f∥ * ∥g∥) (λ x, calc
-  ∥f x • g x∥ ≤ ∥f x∥ * ∥g x∥ : normed_space.norm_smul_le _ _
-  ... ≤ ∥f∥ * ∥g∥ : mul_le_mul (f.norm_coe_le_norm _) (g.norm_coe_le_norm _) (norm_nonneg _)
+instance has_smul' : has_smul (α →ᵇ 𝕜) (α →ᵇ β) :=
+⟨λ (f : α →ᵇ 𝕜) (g : α →ᵇ β), of_normed_add_comm_group (λ x, (f x) • (g x))
+(f.continuous.smul g.continuous) (‖f‖ * ‖g‖) (λ x, calc
+  ‖f x • g x‖ ≤ ‖f x‖ * ‖g x‖ : norm_smul_le _ _
+  ... ≤ ‖f‖ * ‖g‖ : mul_le_mul (f.norm_coe_le_norm _) (g.norm_coe_le_norm _) (norm_nonneg _)
     (norm_nonneg _)) ⟩
 
 instance module' : module (α →ᵇ 𝕜) (α →ᵇ β) :=
@@ -1167,8 +1180,8 @@ module.of_core $
   mul_smul := λ c₁ c₂ f, ext $ λ x, mul_smul _ _ _,
   one_smul := λ f, ext $ λ x, one_smul 𝕜 (f x) }
 
-lemma norm_smul_le (f : α →ᵇ 𝕜) (g : α →ᵇ β) : ∥f • g∥ ≤ ∥f∥ * ∥g∥ :=
-norm_of_normed_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _
+lemma norm_smul_le (f : α →ᵇ 𝕜) (g : α →ᵇ β) : ‖f • g‖ ≤ ‖f‖ * ‖g‖ :=
+norm_of_normed_add_comm_group_le _ (mul_nonneg (norm_nonneg _) (norm_nonneg _)) _
 
 /- TODO: When `normed_module` has been added to `normed_space.basic`, the above facts
 show that the space of bounded continuous functions from `α` to `β` is naturally a normed
@@ -1202,14 +1215,14 @@ In summary, if `β` is a C⋆-algebra over `𝕜`, then so is  `α →ᵇ β`; n
 completeness is guaranteed when `β` is complete (see
 `bounded_continuous_function.complete`). -/
 
-section normed_group
+section normed_add_comm_group
 
-variables {𝕜 : Type*} [normed_field 𝕜] [star_ring 𝕜]
-variables [topological_space α] [semi_normed_group β] [star_add_monoid β] [normed_star_group β]
+variables {𝕜 : Type*} [normed_field 𝕜] [star_ring 𝕜] [topological_space α]
+  [seminormed_add_comm_group β] [star_add_monoid β] [normed_star_group β]
 variables [normed_space 𝕜 β] [star_module 𝕜 β]
 
 instance : star_add_monoid (α →ᵇ β) :=
-{ star            := λ f, f.comp star star_normed_group_hom.lipschitz,
+{ star            := λ f, f.comp star star_normed_add_group_hom.lipschitz,
   star_involutive := λ f, ext $ λ x, star_star (f x),
   star_add        := λ f g, ext $ λ x, star_add (f x) (g x) }
 
@@ -1225,7 +1238,7 @@ instance : normed_star_group (α →ᵇ β) :=
 instance : star_module 𝕜 (α →ᵇ β) :=
 { star_smul := λ k f, ext $ λ x, star_smul k (f x) }
 
-end normed_group
+end normed_add_comm_group
 
 section cstar_ring
 
@@ -1275,7 +1288,7 @@ instance : semilattice_inf (α →ᵇ β) :=
       obtain ⟨C₁, hf⟩ := f.bounded,
       obtain ⟨C₂, hg⟩ := g.bounded,
       refine ⟨C₁ + C₂, λ x y, _⟩,
-      simp_rw normed_group.dist_eq at hf hg ⊢,
+      simp_rw normed_add_comm_group.dist_eq at hf hg ⊢,
       exact (norm_inf_sub_inf_le_add_norm _ _ _ _).trans (add_le_add (hf _ _) (hg _ _)),
     end },
   inf_le_left := λ f g, continuous_map.le_def.mpr (λ _, inf_le_left),
@@ -1292,7 +1305,7 @@ instance : semilattice_sup (α →ᵇ β) :=
       obtain ⟨C₁, hf⟩ := f.bounded,
       obtain ⟨C₂, hg⟩ := g.bounded,
       refine ⟨C₁ + C₂, λ x y, _⟩,
-      simp_rw normed_group.dist_eq at hf hg ⊢,
+      simp_rw normed_add_comm_group.dist_eq at hf hg ⊢,
       exact (norm_sup_sub_sup_le_add_norm _ _ _ _).trans (add_le_add (hf _ _) (hg _ _)),
     end },
   le_sup_left := λ f g, continuous_map.le_def.mpr (λ _, le_sup_left),
@@ -1318,12 +1331,45 @@ instance : normed_lattice_add_comm_group (α →ᵇ β) :=
   solid :=
   begin
     intros f g h,
-    have i1: ∀ t, ∥f t∥ ≤ ∥g t∥ := λ t, solid (h t),
+    have i1: ∀ t, ‖f t‖ ≤ ‖g t‖ := λ t, has_solid_norm.solid (h t),
     rw norm_le (norm_nonneg _),
     exact λ t, (i1 t).trans (norm_coe_le_norm g t),
   end,
-  ..bounded_continuous_function.lattice, }
+  ..bounded_continuous_function.lattice, ..bounded_continuous_function.seminormed_add_comm_group }
 
 end normed_lattice_ordered_group
 
+section nonnegative_part
+
+variables [topological_space α]
+
+/-- The nonnegative part of a bounded continuous `ℝ`-valued function as a bounded
+continuous `ℝ≥0`-valued function. -/
+def nnreal_part (f : α →ᵇ ℝ) : α →ᵇ ℝ≥0 :=
+bounded_continuous_function.comp _
+  (show lipschitz_with 1 real.to_nnreal, from lipschitz_with_pos) f
+
+@[simp] lemma nnreal_part_coe_fun_eq (f : α →ᵇ ℝ) : ⇑(f.nnreal_part) = real.to_nnreal ∘ ⇑f := rfl
+
+/-- The absolute value of a bounded continuous `ℝ`-valued function as a bounded
+continuous `ℝ≥0`-valued function. -/
+def nnnorm (f : α →ᵇ ℝ) : α →ᵇ ℝ≥0 :=
+bounded_continuous_function.comp _
+  (show lipschitz_with 1 (λ (x : ℝ), ‖x‖₊), from lipschitz_with_one_norm) f
+
+@[simp] lemma nnnorm_coe_fun_eq (f : α →ᵇ ℝ) : ⇑(f.nnnorm) = has_nnnorm.nnnorm ∘ ⇑f := rfl
+
+/-- Decompose a bounded continuous function to its positive and negative parts. -/
+lemma self_eq_nnreal_part_sub_nnreal_part_neg (f : α →ᵇ ℝ) :
+  ⇑f = coe ∘ f.nnreal_part - coe ∘ (-f).nnreal_part :=
+by { funext x, dsimp, simp only [max_zero_sub_max_neg_zero_eq_self], }
+
+/-- Express the absolute value of a bounded continuous function in terms of its
+positive and negative parts. -/
+lemma abs_self_eq_nnreal_part_add_nnreal_part_neg (f : α →ᵇ ℝ) :
+  abs ∘ ⇑f = coe ∘ f.nnreal_part + coe ∘ (-f).nnreal_part :=
+by { funext x, dsimp, simp only [max_zero_add_max_neg_zero_eq_abs_self], }
+
+end nonnegative_part
+
 end bounded_continuous_function
diff --git a/src/topology/continuous_function/cocompact_map.lean b/src/topology/continuous_function/cocompact_map.lean
index 5ed716fb37a9b..7b5b64c25d702 100644
--- a/src/topology/continuous_function/cocompact_map.lean
+++ b/src/topology/continuous_function/cocompact_map.lean
@@ -8,6 +8,9 @@ import topology.continuous_function.basic
 /-!
 # Cocompact continuous maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The type of *cocompact continuous maps* are those which tend to the cocompact filter on the
 codomain along the cocompact filter on the domain. When the domain and codomain are Hausdorff, this
 is equivalent to many other conditions, including that preimages of compact sets are compact. -/
@@ -22,11 +25,17 @@ open filter set
 tends to the cocompact filter along the cocompact filter. Functions for which preimages of compact
 sets are compact always satisfy this property, and the converse holds for cocompact continuous maps
 when the codomain is Hausdorff (see `cocompact_map.tendsto_of_forall_preimage` and
-`cocompact_map.compact_preimage`) -/
+`cocompact_map.is_compact_preimage`).
+
+Cocompact maps thus generalise proper maps, with which they correspond when the codomain is
+Hausdorff. -/
 structure cocompact_map (α : Type u) (β : Type v) [topological_space α] [topological_space β]
   extends continuous_map α β : Type (max u v) :=
 (cocompact_tendsto' : tendsto to_fun (cocompact α) (cocompact β))
 
+section
+set_option old_structure_cmd true
+
 /-- `cocompact_map_class F α β` states that `F` is a type of cocompact continuous maps.
 
 You should also extend this typeclass when you extend `cocompact_map`. -/
@@ -34,6 +43,8 @@ class cocompact_map_class (F : Type*) (α β : out_param $ Type*) [topological_s
   [topological_space β] extends continuous_map_class F α β :=
 (cocompact_tendsto (f : F) : tendsto f (cocompact α) (cocompact β))
 
+end
+
 namespace cocompact_map_class
 
 variables {F α β : Type*} [topological_space α] [topological_space β]
@@ -73,6 +84,11 @@ protected def copy (f : cocompact_map α β) (f' : α → β) (h : f' = f) : coc
   continuous_to_fun := by {rw h, exact f.continuous_to_fun},
   cocompact_tendsto' := by { simp_rw h, exact f.cocompact_tendsto' } }
 
+@[simp]
+lemma coe_copy (f : cocompact_map α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+
+lemma copy_eq (f : cocompact_map α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 @[simp] lemma coe_mk (f : C(α, β)) (h : tendsto f (cocompact α) (cocompact β)) :
   ⇑(⟨f, h⟩ : cocompact_map α β) = f := rfl
 
@@ -111,16 +127,28 @@ lemma tendsto_of_forall_preimage {f : α → β} (h : ∀ s, is_compact s → is
 
 /-- If the codomain is Hausdorff, preimages of compact sets are compact under a cocompact
 continuous map. -/
-lemma compact_preimage [t2_space β] (f : cocompact_map α β) ⦃s : set β⦄ (hs : is_compact s) :
+lemma is_compact_preimage [t2_space β] (f : cocompact_map α β) ⦃s : set β⦄ (hs : is_compact s) :
   is_compact (f ⁻¹' s) :=
 begin
   obtain ⟨t, ht, hts⟩ := mem_cocompact'.mp (by simpa only [preimage_image_preimage, preimage_compl]
     using mem_map.mp (cocompact_tendsto f $ mem_cocompact.mpr ⟨s, hs, compl_subset_compl.mpr
     (image_preimage_subset f _)⟩)),
-  exact compact_of_is_closed_subset ht (hs.is_closed.preimage $ map_continuous f)
+  exact is_compact_of_is_closed_subset ht (hs.is_closed.preimage $ map_continuous f)
     (by simpa using hts),
 end
 
 end basics
 
 end cocompact_map
+
+/-- A homemomorphism is a cocompact map. -/
+@[simps] def homeomorph.to_cocompact_map
+  {α β : Type*} [topological_space α] [topological_space β] (f : α ≃ₜ β) : cocompact_map α β :=
+{ to_fun := f,
+  continuous_to_fun := f.continuous,
+  cocompact_tendsto' :=
+  begin
+    refine cocompact_map.tendsto_of_forall_preimage (λ K hK, _),
+    erw K.preimage_equiv_eq_image_symm,
+    exact hK.image f.symm.continuous,
+  end }
diff --git a/src/topology/continuous_function/compact.lean b/src/topology/continuous_function/compact.lean
index 30844763f0d4d..fbf02f9ec680b 100644
--- a/src/topology/continuous_function/compact.lean
+++ b/src/topology/continuous_function/compact.lean
@@ -4,13 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 import topology.continuous_function.bounded
-import topology.uniform_space.compact_separated
+import topology.uniform_space.compact
 import topology.compact_open
 import topology.sets.compacts
 
 /-!
 # Continuous functions on a compact space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Continuous functions `C(α, β)` from a compact space `α` to a metric space `β`
 are automatically bounded, and so acquire various structures inherited from `α →ᵇ β`.
 
@@ -24,7 +27,7 @@ you should restate it here. You can also use
 -/
 
 noncomputable theory
-open_locale topological_space classical nnreal bounded_continuous_function big_operators
+open_locale topology classical nnreal bounded_continuous_function big_operators
 
 open set filter metric
 
@@ -32,7 +35,8 @@ open bounded_continuous_function
 
 namespace continuous_map
 
-variables {α β E : Type*} [topological_space α] [compact_space α] [metric_space β] [normed_group E]
+variables {α β E : Type*} [topological_space α] [compact_space α] [metric_space β]
+  [normed_add_comm_group E]
 
 section
 
@@ -44,7 +48,8 @@ equivalent to `C(α, β)`.
 -/
 @[simps { fully_applied := ff }]
 def equiv_bounded_of_compact : C(α, β) ≃ (α →ᵇ β) :=
-⟨mk_of_compact, to_continuous_map, λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩
+⟨mk_of_compact, bounded_continuous_function.to_continuous_map,
+ λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩
 
 lemma uniform_inducing_equiv_bounded_of_compact :
   uniform_inducing (equiv_bounded_of_compact α β) :=
@@ -53,8 +58,9 @@ begin
   simp only [has_basis_compact_convergence_uniformity.mem_iff, uniformity_basis_dist_le.mem_iff],
   exact λ s, ⟨λ ⟨⟨a, b⟩, ⟨ha, ⟨ε, hε, hb⟩⟩, hs⟩, ⟨{p | ∀ x, (p.1 x, p.2 x) ∈ b},
     ⟨ε, hε, λ _ h x, hb (by exact (dist_le hε.le).mp h x)⟩, λ f g h, hs (by exact λ x hx, h x)⟩,
-    λ ⟨t, ⟨ε, hε, ht⟩, hs⟩, ⟨⟨set.univ, {p | dist p.1 p.2 ≤ ε}⟩, ⟨compact_univ, ⟨ε, hε, λ _ h, h⟩⟩,
-    λ ⟨f, g⟩ h, hs _ _ (ht (by exact (dist_le hε.le).mpr (λ x, h x (mem_univ x))))⟩⟩,
+    λ ⟨t, ⟨ε, hε, ht⟩, hs⟩, ⟨⟨set.univ, {p | dist p.1 p.2 ≤ ε}⟩,
+      ⟨is_compact_univ, ⟨ε, hε, λ _ h, h⟩⟩,
+      λ ⟨f, g⟩ h, hs _ _ (ht (by exact (dist_le hε.le).mpr (λ x, h x (mem_univ x))))⟩⟩,
 end
 
 lemma uniform_embedding_equiv_bounded_of_compact :
@@ -80,7 +86,7 @@ When `α` is compact, and `β` is a metric space, the bounded continuous maps `
 isometric to `C(α, β)`.
 -/
 @[simps to_equiv apply symm_apply { fully_applied := ff }]
-def isometric_bounded_of_compact :
+def isometry_equiv_bounded_of_compact :
   C(α, β) ≃ᵢ (α →ᵇ β) :=
 { isometry_to_fun := λ x y, rfl,
   to_equiv := equiv_bounded_of_compact α β }
@@ -124,11 +130,11 @@ by simp only [← dist_mk_of_compact, dist_lt_iff_of_compact C0, mk_of_compact_a
 end
 
 instance [complete_space β] : complete_space (C(α, β)) :=
-(isometric_bounded_of_compact α β).complete_space
+(isometry_equiv_bounded_of_compact α β).complete_space
 
 /-- See also `continuous_map.continuous_eval'` -/
 @[continuity] lemma continuous_eval : continuous (λ p : C(α, β) × α, p.1 p.2) :=
-continuous_eval.comp ((isometric_bounded_of_compact α β).continuous.prod_map continuous_id)
+continuous_eval.comp ((isometry_equiv_bounded_of_compact α β).continuous.prod_map continuous_id)
 
 /-- See also `continuous_map.continuous_eval_const` -/
 @[continuity] lemma continuous_eval_const (x : α) : continuous (λ f : C(α, β), f x) :=
@@ -144,54 +150,70 @@ instance : has_norm C(α, E) :=
 { norm := λ x, dist x 0 }
 
 @[simp] lemma _root_.bounded_continuous_function.norm_mk_of_compact (f : C(α, E)) :
-  ∥mk_of_compact f∥ = ∥f∥ := rfl
+  ‖mk_of_compact f‖ = ‖f‖ := rfl
 
 @[simp] lemma _root_.bounded_continuous_function.norm_to_continuous_map_eq (f : α →ᵇ E) :
-  ∥f.to_continuous_map∥ = ∥f∥ :=
+  ‖f.to_continuous_map‖ = ‖f‖ :=
 rfl
 
 open bounded_continuous_function
 
-instance : normed_group C(α, E) :=
+instance : normed_add_comm_group C(α, E) :=
 { dist_eq := λ x y, by
-    rw [← norm_mk_of_compact, ← dist_mk_of_compact, dist_eq_norm, mk_of_compact_sub] }
+    rw [← norm_mk_of_compact, ← dist_mk_of_compact, dist_eq_norm, mk_of_compact_sub],
+  dist := dist, norm := norm, .. continuous_map.metric_space _ _, .. continuous_map.add_comm_group }
+
+instance [nonempty α] [has_one E] [norm_one_class E] : norm_one_class C(α, E) :=
+{ norm_one := by simp only [←norm_mk_of_compact, mk_of_compact_one, norm_one] }
 
 section
 variables (f : C(α, E))
 -- The corresponding lemmas for `bounded_continuous_function` are stated with `{f}`,
 -- and so can not be used in dot notation.
 
-lemma norm_coe_le_norm (x : α) : ∥f x∥ ≤ ∥f∥ :=
+lemma norm_coe_le_norm (x : α) : ‖f x‖ ≤ ‖f‖ :=
 (mk_of_compact f).norm_coe_le_norm x
 
 /-- Distance between the images of any two points is at most twice the norm of the function. -/
-lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ∥f∥ :=
+lemma dist_le_two_norm (x y : α) : dist (f x) (f y) ≤ 2 * ‖f‖ :=
 (mk_of_compact f).dist_le_two_norm x y
 
 /-- The norm of a function is controlled by the supremum of the pointwise norms -/
-lemma norm_le {C : ℝ} (C0 : (0 : ℝ) ≤ C) : ∥f∥ ≤ C ↔ ∀x:α, ∥f x∥ ≤ C :=
+lemma norm_le {C : ℝ} (C0 : (0 : ℝ) ≤ C) : ‖f‖ ≤ C ↔ ∀x:α, ‖f x‖ ≤ C :=
 @bounded_continuous_function.norm_le _ _ _ _
   (mk_of_compact f) _ C0
 
-lemma norm_le_of_nonempty [nonempty α] {M : ℝ} : ∥f∥ ≤ M ↔ ∀ x, ∥f x∥ ≤ M :=
+lemma norm_le_of_nonempty [nonempty α] {M : ℝ} : ‖f‖ ≤ M ↔ ∀ x, ‖f x‖ ≤ M :=
 @bounded_continuous_function.norm_le_of_nonempty _ _ _ _ _ (mk_of_compact f) _
 
-lemma norm_lt_iff {M : ℝ} (M0 : 0 < M) : ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
+lemma norm_lt_iff {M : ℝ} (M0 : 0 < M) : ‖f‖ < M ↔ ∀ x, ‖f x‖ < M :=
 @bounded_continuous_function.norm_lt_iff_of_compact _ _ _ _ _ (mk_of_compact f) _ M0
 
+theorem nnnorm_lt_iff {M : ℝ≥0} (M0 : 0 < M) : ‖f‖₊ < M ↔ ∀ (x : α), ‖f x‖₊ < M :=
+f.norm_lt_iff M0
+
 lemma norm_lt_iff_of_nonempty [nonempty α] {M : ℝ} :
-  ∥f∥ < M ↔ ∀ x, ∥f x∥ < M :=
+  ‖f‖ < M ↔ ∀ x, ‖f x‖ < M :=
 @bounded_continuous_function.norm_lt_iff_of_nonempty_compact _ _ _ _ _ _ (mk_of_compact f) _
 
-lemma apply_le_norm (f : C(α, ℝ)) (x : α) : f x ≤ ∥f∥ :=
+lemma nnnorm_lt_iff_of_nonempty [nonempty α] {M : ℝ≥0} :
+  ‖f‖₊ < M ↔ ∀ x, ‖f x‖₊ < M :=
+f.norm_lt_iff_of_nonempty
+
+lemma apply_le_norm (f : C(α, ℝ)) (x : α) : f x ≤ ‖f‖ :=
 le_trans (le_abs.mpr (or.inl (le_refl (f x)))) (f.norm_coe_le_norm x)
 
-lemma neg_norm_le_apply (f : C(α, ℝ)) (x : α) : -∥f∥ ≤ f x :=
+lemma neg_norm_le_apply (f : C(α, ℝ)) (x : α) : -‖f‖ ≤ f x :=
 le_trans (neg_le_neg (f.norm_coe_le_norm x)) (neg_le.mp (neg_le_abs_self (f x)))
 
-lemma norm_eq_supr_norm : ∥f∥ = ⨆ x : α, ∥f x∥ :=
+lemma norm_eq_supr_norm : ‖f‖ = ⨆ x : α, ‖f x‖ :=
 (mk_of_compact f).norm_eq_supr_norm
 
+lemma norm_restrict_mono_set {X : Type*} [topological_space X]
+  (f : C(X, E)) {K L : topological_space.compacts X} (hKL : K ≤ L) :
+  ‖f.restrict K‖ ≤ ‖f.restrict L‖ :=
+(norm_le _ (norm_nonneg _)).mpr (λ x, norm_coe_le_norm (f.restrict L) $ set.inclusion hKL x)
+
 end
 
 section
@@ -199,7 +221,8 @@ variables {R : Type*} [normed_ring R]
 
 instance : normed_ring C(α,R) :=
 { norm_mul := λ f g, norm_mul_le (mk_of_compact f) (mk_of_compact g),
-  ..(infer_instance : normed_group C(α,R)) }
+  ..(infer_instance : normed_add_comm_group C(α,R)),
+  .. continuous_map.ring }
 
 end
 
@@ -207,7 +230,7 @@ section
 variables {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 E]
 
 instance : normed_space 𝕜 C(α,E) :=
-{ norm_smul_le := λ c f, le_of_eq (norm_smul c (mk_of_compact f)) }
+{ norm_smul_le := λ c f, (norm_smul_le c (mk_of_compact f) : _) }
 
 section
 variables (α 𝕜 E)
@@ -223,6 +246,13 @@ def linear_isometry_bounded_of_compact :
   norm_map' := λ f, rfl,
   .. add_equiv_bounded_of_compact α E }
 
+variables {α E} -- to match bounded_continuous_function.eval_clm
+
+/-- The evaluation at a point, as a continuous linear map from `C(α, 𝕜)` to `𝕜`. -/
+def eval_clm (x : α) : C(α, E) →L[𝕜] E :=
+  (eval_clm 𝕜 x).comp
+  ((linear_isometry_bounded_of_compact α E 𝕜).to_linear_isometry).to_continuous_linear_map
+
 end
 
 -- this lemma and the next are the analogues of those autogenerated by `@[simps]` for
@@ -237,8 +267,9 @@ rfl
 
 
 @[simp]
-lemma linear_isometry_bounded_of_compact_to_isometric :
-  (linear_isometry_bounded_of_compact α E 𝕜).to_isometric = (isometric_bounded_of_compact α E) :=
+lemma linear_isometry_bounded_of_compact_to_isometry_equiv :
+  (linear_isometry_bounded_of_compact α E 𝕜).to_isometry_equiv =
+    (isometry_equiv_bounded_of_compact α E) :=
 rfl
 
 @[simp]
@@ -304,8 +335,8 @@ end continuous_map
 
 section comp_left
 variables (X : Type*) {𝕜 β γ : Type*} [topological_space X] [compact_space X]
-  [nondiscrete_normed_field 𝕜]
-variables [normed_group β] [normed_space 𝕜 β] [normed_group γ] [normed_space 𝕜 γ]
+  [nontrivially_normed_field 𝕜]
+variables [normed_add_comm_group β] [normed_space 𝕜 β] [normed_add_comm_group γ] [normed_space 𝕜 γ]
 
 open continuous_map
 
@@ -348,8 +379,8 @@ section comp_right
 /--
 Precomposition by a continuous map is itself a continuous map between spaces of continuous maps.
 -/
-def comp_right_continuous_map {X Y : Type*} (T : Type*)
-  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
+def comp_right_continuous_map {X Y : Type*} (T : Type*) [topological_space X] [compact_space X]
+  [topological_space Y] [compact_space Y] [metric_space T]
   (f : C(X, Y)) : C(C(Y, T), C(X, T)) :=
 { to_fun := λ g, g.comp f,
   continuous_to_fun :=
@@ -361,8 +392,8 @@ def comp_right_continuous_map {X Y : Type*} (T : Type*)
     { exact λ x, h (f x), },
   end }
 
-@[simp] lemma comp_right_continuous_map_apply {X Y : Type*} (T : Type*)
-  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
+@[simp] lemma comp_right_continuous_map_apply {X Y : Type*} (T : Type*) [topological_space X]
+  [compact_space X] [topological_space Y] [compact_space Y] [metric_space T]
   (f : C(X, Y)) (g : C(Y, T)) :
   (comp_right_continuous_map T f) g = g.comp f :=
 rfl
@@ -370,52 +401,36 @@ rfl
 /--
 Precomposition by a homeomorphism is itself a homeomorphism between spaces of continuous maps.
 -/
-def comp_right_homeomorph {X Y : Type*} (T : Type*)
-  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [normed_group T]
+def comp_right_homeomorph {X Y : Type*} (T : Type*) [topological_space X] [compact_space X]
+  [topological_space Y] [compact_space Y] [metric_space T]
   (f : X ≃ₜ Y) : C(Y, T) ≃ₜ C(X, T) :=
 { to_fun := comp_right_continuous_map T f.to_continuous_map,
   inv_fun := comp_right_continuous_map T f.symm.to_continuous_map,
-  left_inv := by tidy,
-  right_inv := by tidy, }
+  left_inv := λ g, ext $ λ _, congr_arg g (f.apply_symm_apply _),
+  right_inv := λ g, ext $ λ _, congr_arg g (f.symm_apply_apply _) }
 
-/--
-Precomposition of functions into a normed ring by continuous map is an algebra homomorphism.
--/
-def comp_right_alg_hom {X Y : Type*} (R : Type*)
-  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) :
-  C(Y, R) →ₐ[R] C(X, R) :=
-{ to_fun := λ g, g.comp f,
-  map_zero' := by { ext, simp, },
-  map_add' := λ g₁ g₂, by { ext, simp, },
-  map_one' := by { ext, simp, },
-  map_mul' := λ g₁ g₂, by { ext, simp, },
-  commutes' := λ r, by { ext, simp, }, }
-
-@[simp] lemma comp_right_alg_hom_apply {X Y : Type*} (R : Type*)
-  [topological_space X] [topological_space Y] [normed_comm_ring R] (f : C(X, Y)) (g : C(Y, R)) :
-  (comp_right_alg_hom R f) g = g.comp f :=
-rfl
-
-lemma comp_right_alg_hom_continuous {X Y : Type*} (R : Type*)
-  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y]
-  [normed_comm_ring R] (f : C(X, Y)) :
-  continuous (comp_right_alg_hom R f) :=
-begin
-  change continuous (comp_right_continuous_map R f),
-  continuity,
-end
+lemma comp_right_alg_hom_continuous {X Y : Type*} (R A : Type*)
+  [topological_space X] [compact_space X] [topological_space Y] [compact_space Y] [comm_semiring R]
+  [semiring A] [metric_space A] [topological_semiring A] [algebra R A] (f : C(X, Y)) :
+  continuous (comp_right_alg_hom R A f) :=
+map_continuous (comp_right_continuous_map A f)
 
 end comp_right
 
-section weierstrass
+section local_normal_convergence
+/-! ### Local normal convergence
+
+A sum of continuous functions (on a locally compact space) is "locally normally convergent" if the
+sum of its sup-norms on any compact subset is summable. This implies convergence in the topology
+of `C(X, E)` (i.e. locally uniform convergence). -/
 
 open topological_space
 
 variables {X : Type*} [topological_space X] [t2_space X] [locally_compact_space X]
-variables {E : Type*} [normed_group E] [complete_space E]
+variables {E : Type*} [normed_add_comm_group E] [complete_space E]
 
 lemma summable_of_locally_summable_norm {ι : Type*} {F : ι → C(X, E)}
-  (hF : ∀ K : compacts X, summable (λ i, ∥(F i).restrict K∥)) :
+  (hF : ∀ K : compacts X, summable (λ i, ‖(F i).restrict K‖)) :
   summable F :=
 begin
   refine (continuous_map.exists_tendsto_compact_open_iff_forall _).2 (λ K hK, _),
@@ -425,6 +440,55 @@ begin
   simpa only [has_sum, A] using summable_of_summable_norm (hF K)
 end
 
-end weierstrass
+end local_normal_convergence
+
+/-!
+### Star structures
+
+In this section, if `β` is a normed ⋆-group, then so is the space of
+continuous functions from `α` to `β`, by using the star operation pointwise.
+
+Furthermore, if `α` is compact and `β` is a C⋆-ring, then `C(α, β)` is a C⋆-ring.  -/
+
+section normed_space
+
+variables {α : Type*} {β : Type*}
+variables [topological_space α] [normed_add_comm_group β] [star_add_monoid β] [normed_star_group β]
+
+lemma _root_.bounded_continuous_function.mk_of_compact_star [compact_space α] (f : C(α, β)) :
+  mk_of_compact (star f) = star (mk_of_compact f) := rfl
+
+instance [compact_space α] : normed_star_group C(α, β) :=
+{ norm_star := λ f, by rw [←bounded_continuous_function.norm_mk_of_compact,
+                          bounded_continuous_function.mk_of_compact_star, norm_star,
+                          bounded_continuous_function.norm_mk_of_compact] }
+
+end normed_space
+
+section cstar_ring
+
+variables {α : Type*} {β : Type*}
+variables [topological_space α] [normed_ring β] [star_ring β]
+
+instance [compact_space α] [cstar_ring β] : cstar_ring C(α, β) :=
+{ norm_star_mul_self :=
+  begin
+    intros f,
+    refine le_antisymm _ _,
+    { rw [←sq, continuous_map.norm_le _ (sq_nonneg _)],
+      intro x,
+      simp only [continuous_map.coe_mul, coe_star, pi.mul_apply, pi.star_apply,
+                 cstar_ring.norm_star_mul_self, ←sq],
+      refine sq_le_sq' _ _,
+      { linarith [norm_nonneg (f x), norm_nonneg f] },
+      { exact continuous_map.norm_coe_le_norm f x }, },
+    { rw [←sq, ←real.le_sqrt (norm_nonneg _) (norm_nonneg _),
+          continuous_map.norm_le _ (real.sqrt_nonneg _)],
+      intro x,
+      rw [real.le_sqrt (norm_nonneg _) (norm_nonneg _), sq, ←cstar_ring.norm_star_mul_self],
+      exact continuous_map.norm_coe_le_norm (star f * f) x },
+  end }
+
+end cstar_ring
 
 end continuous_map
diff --git a/src/topology/continuous_function/ideals.lean b/src/topology/continuous_function/ideals.lean
new file mode 100644
index 0000000000000..7341809a0f644
--- /dev/null
+++ b/src/topology/continuous_function/ideals.lean
@@ -0,0 +1,422 @@
+/-
+Copyright (c) 2022 Jireh Loreaux. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jireh Loreaux
+-/
+
+import topology.algebra.algebra
+import topology.continuous_function.compact
+import topology.urysohns_lemma
+import data.is_R_or_C.basic
+import analysis.normed_space.units
+import topology.algebra.module.character_space
+
+/-!
+# Ideals of continuous functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+For a topological semiring `R` and a topological space `X` there is a Galois connection between
+`ideal C(X, R)` and `set X` given by sending each `I : ideal C(X, R)` to
+`{x : X | ∀ f ∈ I, f x = 0}ᶜ` and mapping `s : set X` to the ideal with carrier
+`{f : C(X, R) | ∀ x ∈ sᶜ, f x = 0}`, and we call these maps `continuous_map.set_of_ideal` and
+`continuous_map.ideal_of_set`. As long as `R` is Hausdorff, `continuous_map.set_of_ideal I` is open,
+and if, in addition, `X` is locally compact, then `continuous_map.set_of_ideal s` is closed.
+
+When `R = 𝕜` with `is_R_or_C 𝕜` and `X` is compact Hausdorff, then this Galois connection can be
+improved to a true Galois correspondence (i.e., order isomorphism) between the type `opens X` and
+the subtype of closed ideals of `C(X, 𝕜)`. Because we do not have a bundled type of closed ideals,
+we simply register this as a Galois insertion between `ideal C(X, 𝕜)` and `opens X`, which is
+`continuous_map.ideal_opens_gi`. Consequently, the maximal ideals of `C(X, 𝕜)` are precisely those
+ideals corresponding to (complements of) singletons in `X`.
+
+In addition, when `X` is locally compact and `𝕜` is a nontrivial topological integral domain, then
+there is a natural continuous map from `X` to `character_space 𝕜 C(X, 𝕜)` given by point evaluation,
+which is herein called `weak_dual.character_space.continuous_map_eval`. Again, when `X` is compact
+Hausdorff and `is_R_or_C 𝕜`, more can be obtained. In particular, in that context this map is
+bijective, and since the domain is compact and the codomain is Hausdorff, it is a homeomorphism,
+herein called `weak_dual.character_space.homeo_eval`.
+
+## Main definitions
+
+* `continuous_map.ideal_of_set`: ideal of functions which vanish on the complement of a set.
+* `continuous_map.set_of_ideal`: complement of the set on which all functions in the ideal vanish.
+* `continuous_map.opens_of_ideal`: `continuous_map.set_of_ideal` as a term of `opens X`.
+* `continuous_map.ideal_opens_gi`: The Galois insertion `continuous_map.opens_of_ideal` and
+  `λ s, continuous_map.ideal_of_set ↑s`.
+* `weak_dual.character_space.continuous_map_eval`: the natural continuous map from a locally compact
+  topological space `X` to the `character_space 𝕜 C(X, 𝕜)` which sends `x : X` to point evaluation
+  at `x`, with modest hypothesis on `𝕜`.
+* `weak_dual.character_space.homeo_eval`: this is `weak_dual.character_space.continuous_map_eval`
+  upgraded to a homeomorphism when `X` is compact Hausdorff and `is_R_or_C 𝕜`.
+
+## Main statements
+
+* `continuous_map.ideal_of_set_of_ideal_eq_closure`: when `X` is compact Hausdorff and
+  `is_R_or_C 𝕜`, `ideal_of_set 𝕜 (set_of_ideal I) = I.closure` for any ideal `I : ideal C(X, 𝕜)`.
+* `continuous_map.set_of_ideal_of_set_eq_interior`: when `X` is compact Hausdorff and `is_R_or_C 𝕜`,
+  `set_of_ideal (ideal_of_set 𝕜 s) = interior s` for any `s : set X`.
+* `continuous_map.ideal_is_maximal_iff`: when `X` is compact Hausdorff and `is_R_or_C 𝕜`, a closed
+  ideal of `C(X, 𝕜)` is maximal if and only if it is `ideal_of_set 𝕜 {x}ᶜ` for some `x : X`.
+
+## Implementation details
+
+Because there does not currently exist a bundled type of closed ideals, we don't provide the actual
+order isomorphism described above, and instead we only consider the Galois insertion
+`continuous_map.ideal_opens_gi`.
+
+## Tags
+
+ideal, continuous function, compact, Hausdorff
+-/
+
+
+open_locale nnreal
+
+namespace continuous_map
+
+open topological_space
+
+section topological_ring
+
+variables {X R : Type*} [topological_space X] [semiring R]
+variables [topological_space R] [topological_semiring R]
+
+variable (R)
+
+/-- Given a topological ring `R` and `s : set X`, construct the ideal in `C(X, R)` of functions
+which vanish on the complement of `s`. -/
+def ideal_of_set (s : set X) : ideal C(X, R) :=
+{ carrier := {f : C(X, R) | ∀ x ∈ sᶜ, f x = 0},
+  add_mem' := λ f g hf hg x hx, by simp only [hf x hx, hg x hx, coe_add, pi.add_apply, add_zero],
+  zero_mem' := λ _ _, rfl,
+  smul_mem' := λ c f hf x hx, mul_zero (c x) ▸ congr_arg (λ y, c x * y) (hf x hx), }
+
+lemma ideal_of_set_closed [locally_compact_space X] [t2_space R] (s : set X) :
+  is_closed (ideal_of_set R s : set C(X, R) ) :=
+begin
+  simp only [ideal_of_set, submodule.coe_set_mk, set.set_of_forall],
+  exact is_closed_Inter (λ x, is_closed_Inter $
+    λ hx, is_closed_eq (continuous_eval_const' x) continuous_const),
+end
+
+variable {R}
+
+lemma mem_ideal_of_set {s : set X} {f : C(X, R)} :
+  f ∈ ideal_of_set R s ↔ ∀ ⦃x : X⦄, x ∈ sᶜ → f x = 0 := iff.rfl
+
+lemma not_mem_ideal_of_set {s : set X} {f : C(X, R)} :
+  f ∉ ideal_of_set R s ↔ ∃ x ∈ sᶜ, f x ≠ 0 :=
+by { simp_rw [mem_ideal_of_set, exists_prop], push_neg }
+
+/-- Given an ideal `I` of `C(X, R)`, construct the set of points for which every function in the
+ideal vanishes on the complement. -/
+def set_of_ideal (I : ideal C(X, R)) : set X :=
+{x : X | ∀ f ∈ I, (f : C(X, R)) x = 0}ᶜ
+
+lemma not_mem_set_of_ideal {I : ideal C(X, R)} {x : X} :
+  x ∉ set_of_ideal I ↔ ∀ ⦃f : C(X, R)⦄, f ∈ I → f x = 0 :=
+by rw [←set.mem_compl_iff, set_of_ideal, compl_compl, set.mem_set_of]
+
+lemma mem_set_of_ideal {I : ideal C(X, R)} {x : X} :
+  x ∈ set_of_ideal I ↔ ∃ f ∈ I, (f : C(X, R)) x ≠ 0 :=
+by { simp_rw [set_of_ideal, set.mem_compl_iff, set.mem_set_of, exists_prop], push_neg }
+
+lemma set_of_ideal_open [t2_space R] (I : ideal C(X, R)) : is_open (set_of_ideal I) :=
+begin
+  simp only [set_of_ideal, set.set_of_forall, is_open_compl_iff],
+  exact is_closed_Inter (λ f, is_closed_Inter $
+    λ hf, is_closed_eq (map_continuous f) continuous_const)
+end
+
+/-- The open set `set_of_ideal I` realized as a term of `opens X`. -/
+@[simps] def opens_of_ideal [t2_space R] (I : ideal C(X, R)) : opens X :=
+⟨set_of_ideal I, set_of_ideal_open I⟩
+
+@[simp] lemma set_of_top_eq_univ [nontrivial R] : (set_of_ideal (⊤ : ideal C(X, R))) = set.univ :=
+set.univ_subset_iff.mp $ λ x hx, mem_set_of_ideal.mpr ⟨1, submodule.mem_top, one_ne_zero⟩
+
+@[simp] lemma ideal_of_empty_eq_bot : (ideal_of_set R (∅ : set X)) = ⊥ :=
+ideal.ext (λ f, by simpa only [mem_ideal_of_set, set.compl_empty, set.mem_univ, forall_true_left,
+  ideal.mem_bot, fun_like.ext_iff] using iff.rfl)
+
+@[simp] lemma mem_ideal_of_set_compl_singleton (x : X) (f : C(X, R)) :
+  f ∈ ideal_of_set R ({x}ᶜ : set X) ↔ f x = 0 :=
+by simp only [mem_ideal_of_set, compl_compl, set.mem_singleton_iff, forall_eq]
+
+variables (X R)
+lemma ideal_gc : galois_connection (set_of_ideal : ideal C(X, R) → set X) (ideal_of_set R) :=
+begin
+  refine λ I s, ⟨λ h f hf, _, λ h x hx, _⟩,
+  { by_contra h',
+    rcases not_mem_ideal_of_set.mp h' with ⟨x, hx, hfx⟩,
+    exact hfx (not_mem_set_of_ideal.mp (mt (@h x) hx) hf) },
+  { obtain ⟨f, hf, hfx⟩ := mem_set_of_ideal.mp hx,
+    by_contra hx',
+    exact not_mem_ideal_of_set.mpr ⟨x, hx', hfx⟩ (h hf) },
+end
+
+end topological_ring
+
+section is_R_or_C
+open is_R_or_C
+
+variables {X 𝕜 : Type*} [is_R_or_C 𝕜] [topological_space X]
+
+/-- An auxiliary lemma used in the proof of `ideal_of_set_of_ideal_eq_closure` which may be useful
+on its own. -/
+lemma exists_mul_le_one_eq_on_ge (f : C(X, ℝ≥0)) {c : ℝ≥0} (hc : 0 < c) :
+  ∃ g : C(X, ℝ≥0), (∀ x : X, (g * f) x ≤ 1) ∧ {x : X | c ≤ f x}.eq_on (g * f) 1 :=
+⟨{ to_fun := (f ⊔ (const X c))⁻¹,
+   continuous_to_fun := ((map_continuous f).sup $ map_continuous _).inv₀
+     (λ _, (hc.trans_le le_sup_right).ne')},
+ λ x, (inv_mul_le_iff (hc.trans_le le_sup_right)).mpr ((mul_one (f x ⊔ c)).symm ▸ le_sup_left),
+ λ x hx, by simpa only [coe_const, coe_mk, pi.mul_apply, pi.inv_apply, pi.sup_apply,
+   function.const_apply, pi.one_apply, sup_eq_left.mpr (set.mem_set_of.mp hx)]
+   using inv_mul_cancel (hc.trans_le hx).ne'⟩
+
+variables [compact_space X] [t2_space X]
+
+@[simp] lemma ideal_of_set_of_ideal_eq_closure (I : ideal C(X, 𝕜)) :
+  ideal_of_set 𝕜 (set_of_ideal I) = I.closure :=
+begin
+  /- Since `ideal_of_set 𝕜 (set_of_ideal I)` is closed and contains `I`, it contains `I.closure`.
+  For the reverse inclusion, given `f ∈ ideal_of_set 𝕜 (set_of_ideal I)` and `(ε : ℝ≥0) > 0` it
+  suffices to show that `f` is within `ε` of `I`.-/
+  refine le_antisymm (λ f hf, metric.mem_closure_iff.mpr (λ ε hε, _))
+    ((ideal_of_set_closed 𝕜 $ set_of_ideal I).closure_subset_iff.mpr $
+    λ f hf x hx, not_mem_set_of_ideal.mp hx hf),
+  lift ε to ℝ≥0 using hε.lt.le,
+  replace hε := (show (0 : ℝ≥0) < ε, from hε),
+  simp_rw dist_nndist,
+  norm_cast,
+  -- Let `t := {x : X | ε / 2 ≤ ‖f x‖₊}}` which is closed and disjoint from `set_of_ideal I`.
+  set t := {x : X | ε / 2 ≤ ‖f x‖₊},
+  have ht : is_closed t := is_closed_le continuous_const (map_continuous f).nnnorm,
+  have htI : disjoint t (set_of_ideal I)ᶜ,
+  { refine set.subset_compl_iff_disjoint_left.mp (λ x hx, _),
+    simpa only [t, set.mem_set_of, set.mem_compl_iff, not_le]
+      using (nnnorm_eq_zero.mpr (mem_ideal_of_set.mp hf hx)).trans_lt (half_pos hε), },
+  /- It suffices to produce `g : C(X, ℝ≥0)` which takes values in `[0,1]` and is constantly `1` on
+  `t` such that when composed with the natural embedding of `ℝ≥0` into `𝕜` lies in the ideal `I`.
+  Indeed, then `‖f - f * ↑g‖ ≤ ‖f * (1 - ↑g)‖ ≤ ⨆ ‖f * (1 - ↑g) x‖`. When `x ∉ t`, `‖f x‖ < ε / 2`
+  and `‖(1 - ↑g) x‖ ≤ 1`, and when `x ∈ t`, `(1 - ↑g) x = 0`, and clearly `f * ↑g ∈ I`. -/
+  suffices : ∃ g : C(X, ℝ≥0),
+    (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g ∈ I ∧ (∀ x, g x ≤ 1) ∧ t.eq_on g 1,
+  { obtain ⟨g, hgI, hg, hgt⟩ := this,
+    refine ⟨f * (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g, I.mul_mem_left f hgI, _⟩,
+    rw nndist_eq_nnnorm,
+    refine (nnnorm_lt_iff _ hε).2 (λ x, _),
+    simp only [coe_sub, coe_mul, pi.sub_apply, pi.mul_apply],
+    by_cases hx : x ∈ t,
+    { simpa only [hgt hx, comp_apply, pi.one_apply, continuous_map.coe_coe, algebra_map_clm_apply,
+        map_one, mul_one, sub_self, nnnorm_zero] using hε, },
+    { refine lt_of_le_of_lt _ (half_lt_self hε),
+      have := calc ‖((1 - (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g) x : 𝕜)‖₊
+            = ‖1 - algebra_map ℝ≥0 𝕜 (g x)‖₊
+            : by simp only [coe_sub, coe_one, coe_comp, continuous_map.coe_coe, pi.sub_apply,
+                pi.one_apply, function.comp_app, algebra_map_clm_apply]
+        ... = ‖algebra_map ℝ≥0 𝕜 (1 - g x)‖₊
+            : by simp only [algebra.algebra_map_eq_smul_one, nnreal.smul_def, nnreal.coe_sub (hg x),
+                sub_smul, nonneg.coe_one, one_smul]
+        ... ≤ 1 : (nnnorm_algebra_map_nnreal 𝕜 (1 - g x)).trans_le tsub_le_self,
+      calc ‖f x - f x * (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g x‖₊
+          = ‖f x * (1 - (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g) x‖₊
+          : by simp only [mul_sub, coe_sub, coe_one, pi.sub_apply, pi.one_apply, mul_one]
+      ... ≤ (ε / 2) * ‖(1 - (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g) x‖₊
+          : (nnnorm_mul_le _ _).trans (mul_le_mul_right'
+              (not_le.mp $ show ¬ ε / 2 ≤ ‖f x‖₊, from hx).le _)
+      ... ≤ ε / 2 : by simpa only [mul_one] using mul_le_mul_left' this _, } },
+  /- There is some `g' : C(X, ℝ≥0)` which is strictly positive on `t` such that the composition
+  `↑g` with the natural embedding of `ℝ≥0` into `𝕜` lies in `I`. This follows from compactness of
+  `t` and that we can do it in any neighborhood of a point `x ∈ t`. Indeed, since `x ∈ t`, then
+  `fₓ x ≠ 0` for some `fₓ ∈ I` and so `λ y, ‖(star fₓ * fₓ) y‖₊` is strictly posiive in a
+  neighborhood of `y`. Moreover, `(‖(star fₓ * fₓ) y‖₊ : 𝕜) = (star fₓ * fₓ) y`, so composition of
+  this map with the natural embedding is just `star fₓ * fₓ ∈ I`. -/
+  have : ∃ g' : C(X, ℝ≥0), (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g' ∈ I ∧ (∀ x ∈ t, 0 < g' x),
+  { refine @is_compact.induction_on _ _ _ ht.is_compact (λ s, ∃ g' : C(X, ℝ≥0),
+      (algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g' ∈ I ∧ (∀ x ∈ s, 0 < g' x)) _ _ _ _,
+    { refine ⟨0, _, λ x hx, false.elim hx⟩,
+      convert I.zero_mem,
+      ext,
+      simp only [coe_zero, pi.zero_apply, continuous_map.coe_coe, continuous_map.coe_comp,
+        map_zero, pi.comp_zero] },
+    { rintro s₁ s₂ hs ⟨g, hI, hgt⟩, exact ⟨g, hI, λ x hx, hgt x (hs hx)⟩, },
+    { rintro s₁ s₂ ⟨g₁, hI₁, hgt₁⟩ ⟨g₂, hI₂, hgt₂⟩,
+      refine ⟨g₁ + g₂, _, λ x hx, _⟩,
+      { convert I.add_mem hI₁ hI₂,
+        ext y,
+        simp only [coe_add, pi.add_apply, map_add, coe_comp, function.comp_app,
+          continuous_map.coe_coe]},
+      { rcases hx with (hx | hx),
+        simpa only [zero_add] using add_lt_add_of_lt_of_le (hgt₁ x hx) zero_le',
+        simpa only [zero_add] using add_lt_add_of_le_of_lt zero_le' (hgt₂ x hx), } },
+    { intros x hx,
+      replace hx := htI.subset_compl_right hx,
+      rw [compl_compl, mem_set_of_ideal] at hx,
+      obtain ⟨g, hI, hgx⟩ := hx,
+      have := (map_continuous g).continuous_at.eventually_ne hgx,
+      refine ⟨{y : X | g y ≠ 0} ∩ t, mem_nhds_within_iff_exists_mem_nhds_inter.mpr
+        ⟨_, this, set.subset.rfl⟩, ⟨⟨λ x, ‖g x‖₊ ^ 2, (map_continuous g).nnnorm.pow 2⟩, _,
+        λ x hx, pow_pos (norm_pos_iff.mpr hx.1) 2⟩⟩,
+      convert I.mul_mem_left (star g) hI,
+      ext,
+      simp only [comp_apply, coe_mk, algebra_map_clm_coe, map_pow, coe_mul, coe_star,
+        pi.mul_apply, pi.star_apply, star_def, continuous_map.coe_coe],
+      simpa only [norm_sq_eq_def', is_R_or_C.conj_mul, of_real_pow], }, },
+  /- Get the function `g'` which is guaranteed to exist above. By the extreme value theorem and
+  compactness of `t`, there is some `0 < c` such that `c ≤ g' x` for all `x ∈ t`. Then by
+  `main_lemma_aux` there is some `g` for which `g * g'` is the desired function. -/
+  obtain ⟨g', hI', hgt'⟩ := this,
+  obtain (⟨c, hc, hgc'⟩ : ∃ c (hc : 0 < c), ∀ y : X, y ∈ t → c ≤ g' y) :=
+  t.eq_empty_or_nonempty.elim (λ ht', ⟨1, zero_lt_one, λ y hy, false.elim (by rwa ht' at hy)⟩)
+    (λ ht', let ⟨x, hx, hx'⟩ := ht.is_compact.exists_forall_le ht' (map_continuous g').continuous_on
+      in ⟨g' x, hgt' x hx, hx'⟩),
+  obtain ⟨g, hg, hgc⟩ := exists_mul_le_one_eq_on_ge g' hc,
+  refine ⟨g * g', _, hg, hgc.mono hgc'⟩,
+  convert I.mul_mem_left ((algebra_map_clm ℝ≥0 𝕜 : C(ℝ≥0, 𝕜)).comp g) hI',
+  ext,
+  simp only [algebra_map_clm_coe, continuous_map.coe_coe, comp_apply, coe_mul, pi.mul_apply,
+    map_mul],
+end
+
+lemma ideal_of_set_of_ideal_is_closed {I : ideal C(X, 𝕜)}
+  (hI : is_closed (I : set C(X, 𝕜))) : ideal_of_set 𝕜 (set_of_ideal I) = I :=
+(ideal_of_set_of_ideal_eq_closure I).trans (ideal.ext $ set.ext_iff.mp hI.closure_eq)
+
+variable (𝕜)
+
+@[simp] lemma set_of_ideal_of_set_eq_interior (s : set X) :
+  set_of_ideal (ideal_of_set 𝕜 s) = interior s:=
+begin
+  refine set.subset.antisymm ((set_of_ideal_open (ideal_of_set 𝕜 s)).subset_interior_iff.mpr
+    (λ x hx, let ⟨f, hf, hfx⟩ := mem_set_of_ideal.mp hx
+    in set.not_mem_compl_iff.mp (mt (@hf x) hfx))) (λ x hx, _),
+  /- If `x ∉ closure sᶜ`, we must produce `f : C(X, 𝕜)` which is zero on `sᶜ` and `f x ≠ 0`. -/
+  rw [←compl_compl (interior s), ←closure_compl] at hx,
+  simp_rw [mem_set_of_ideal, mem_ideal_of_set],
+  haveI : normal_space X := normal_of_compact_t2,
+  /- Apply Urysohn's lemma to get `g : C(X, ℝ)` which is zero on `sᶜ` and `g x ≠ 0`, then compose
+  with the natural embedding `ℝ ↪ 𝕜` to produce the desired `f`. -/
+  obtain ⟨g, hgs, (hgx : set.eq_on g 1 {x}), -⟩ := exists_continuous_zero_one_of_closed
+    is_closed_closure is_closed_singleton (set.disjoint_singleton_right.mpr hx),
+  exact ⟨⟨λ x, g x, continuous_of_real.comp (map_continuous g)⟩,
+    by simpa only [coe_mk, of_real_eq_zero] using λ x hx, hgs (subset_closure hx),
+    by simpa only [coe_mk, hgx (set.mem_singleton x), pi.one_apply, is_R_or_C.of_real_one]
+      using one_ne_zero⟩,
+end
+
+lemma set_of_ideal_of_set_of_is_open {s : set X} (hs : is_open s) :
+  set_of_ideal (ideal_of_set 𝕜 s) = s :=
+(set_of_ideal_of_set_eq_interior 𝕜 s).trans hs.interior_eq
+
+variable (X)
+
+/-- The Galois insertion `continuous_map.opens_of_ideal : ideal C(X, 𝕜) → opens X` and
+`λ s, continuous_map.ideal_of_set ↑s`. -/
+@[simps] def ideal_opens_gi :
+  galois_insertion (opens_of_ideal : ideal C(X, 𝕜) → opens X) (λ s, ideal_of_set 𝕜 s) :=
+{ choice := λ I hI, opens_of_ideal I.closure,
+  gc := λ I s, ideal_gc X 𝕜 I s,
+  le_l_u := λ s, (set_of_ideal_of_set_of_is_open 𝕜 s.is_open).ge,
+  choice_eq := λ I hI, congr_arg _ $ ideal.ext (set.ext_iff.mp (is_closed_of_closure_subset $
+    (ideal_of_set_of_ideal_eq_closure I ▸ hI : I.closure ≤ I)).closure_eq) }
+
+variables {X}
+
+lemma ideal_of_set_is_maximal_iff (s : opens X) :
+  (ideal_of_set 𝕜 (s : set X)).is_maximal ↔ is_coatom s :=
+begin
+  rw ideal.is_maximal_def,
+  refine (ideal_opens_gi X 𝕜).is_coatom_iff  (λ I hI, _) s,
+  rw ←ideal.is_maximal_def at hI,
+  resetI,
+  exact ideal_of_set_of_ideal_is_closed infer_instance,
+end
+
+lemma ideal_of_compl_singleton_is_maximal (x : X) : (ideal_of_set 𝕜 ({x}ᶜ : set X)).is_maximal :=
+(ideal_of_set_is_maximal_iff 𝕜 (closeds.singleton x).compl).mpr  $ opens.is_coatom_iff.mpr ⟨x, rfl⟩
+
+variables {𝕜}
+
+lemma set_of_ideal_eq_compl_singleton (I : ideal C(X, 𝕜)) [hI : I.is_maximal] :
+  ∃ x : X, set_of_ideal I = {x}ᶜ :=
+begin
+  have h : (ideal_of_set 𝕜 (set_of_ideal I)).is_maximal, from
+    (ideal_of_set_of_ideal_is_closed (infer_instance : is_closed (I : set C(X, 𝕜)))).symm ▸ hI,
+  obtain ⟨x, hx⟩ := opens.is_coatom_iff.1 ((ideal_of_set_is_maximal_iff 𝕜 (opens_of_ideal I)).1 h),
+  exact ⟨x, congr_arg coe hx⟩,
+end
+
+lemma ideal_is_maximal_iff (I : ideal C(X, 𝕜)) [hI : is_closed (I : set C(X, 𝕜))] :
+  I.is_maximal ↔ ∃ x : X, ideal_of_set 𝕜 {x}ᶜ = I :=
+begin
+  refine ⟨_, λ h, let ⟨x, hx⟩ := h in hx ▸ ideal_of_compl_singleton_is_maximal 𝕜 x⟩,
+  introI hI',
+  obtain ⟨x, hx⟩ := set_of_ideal_eq_compl_singleton I,
+  exact ⟨x, by simpa only [ideal_of_set_of_ideal_eq_closure, ideal.closure_eq_of_is_closed]
+    using congr_arg (ideal_of_set 𝕜) hx.symm⟩,
+end
+
+end is_R_or_C
+
+end continuous_map
+
+namespace weak_dual
+namespace character_space
+
+open function continuous_map
+
+variables (X 𝕜 : Type*) [topological_space X]
+
+section continuous_map_eval
+
+variables [locally_compact_space X] [comm_ring 𝕜] [topological_space 𝕜] [topological_ring 𝕜]
+variables [nontrivial 𝕜] [no_zero_divisors 𝕜]
+
+/-- The natural continuous map from a locally compact topological space `X` to the
+`character_space 𝕜 C(X, 𝕜)` which sends `x : X` to point evaluation at `x`. -/
+def continuous_map_eval :
+  C(X, character_space 𝕜 C(X, 𝕜)) :=
+{ to_fun := λ x, ⟨{ to_fun := λ f, f x, map_add' := λ f g, rfl, map_smul' := λ z f, rfl,
+                    cont := continuous_eval_const' x },
+                  by { rw character_space.eq_set_map_one_map_mul, exact ⟨rfl, λ f g, rfl⟩ }⟩,
+  continuous_to_fun := continuous.subtype_mk (continuous_of_continuous_eval map_continuous) _ }
+
+@[simp] lemma continuous_map_eval_apply_apply (x : X) (f : C(X, 𝕜)) :
+  continuous_map_eval X 𝕜 x f = f x := rfl
+
+end continuous_map_eval
+
+variables [compact_space X] [t2_space X] [is_R_or_C 𝕜]
+
+lemma continuous_map_eval_bijective : bijective (continuous_map_eval X 𝕜) :=
+begin
+  refine ⟨λ x y hxy, _, λ φ, _⟩,
+  { contrapose! hxy,
+    haveI := @normal_of_compact_t2 X _ _ _,
+    rcases exists_continuous_zero_one_of_closed (is_closed_singleton : _root_.is_closed {x})
+      (is_closed_singleton : _root_.is_closed {y}) (set.disjoint_singleton.mpr hxy)
+      with ⟨f, fx, fy, -⟩,
+    rw [←ne.def, fun_like.ne_iff],
+    use (⟨coe, is_R_or_C.continuous_of_real⟩ : C(ℝ, 𝕜)).comp f,
+    simpa only [continuous_map_eval_apply_apply, continuous_map.comp_apply, coe_mk, ne.def,
+      is_R_or_C.of_real_inj] using ((fx (set.mem_singleton x)).symm ▸
+      (fy (set.mem_singleton y)).symm ▸ zero_ne_one : f x ≠ f y) },
+  { obtain ⟨x, hx⟩ := (ideal_is_maximal_iff (ring_hom.ker φ)).mp infer_instance,
+    refine ⟨x, ext_ker $ ideal.ext $ λ f, _⟩,
+    simpa only [ring_hom.mem_ker, continuous_map_eval_apply_apply,
+      mem_ideal_of_set_compl_singleton, ring_hom.mem_ker] using set_like.ext_iff.mp hx f }
+end
+
+/-- This is the natural homeomorphism between a compact Hausdorff space `X` and the
+`character_space 𝕜 C(X, 𝕜)`. -/
+noncomputable def homeo_eval : X ≃ₜ character_space 𝕜 C(X, 𝕜) :=
+@continuous.homeo_of_equiv_compact_to_t2 _ _ _ _ _ _
+  { to_fun := (continuous_map_eval X 𝕜),
+    .. equiv.of_bijective _ (continuous_map_eval_bijective X 𝕜) }
+  (map_continuous (continuous_map_eval X 𝕜))
+
+end character_space
+end weak_dual
diff --git a/src/topology/continuous_function/locally_constant.lean b/src/topology/continuous_function/locally_constant.lean
index 6c77ca5939f66..215538f00f006 100644
--- a/src/topology/continuous_function/locally_constant.lean
+++ b/src/topology/continuous_function/locally_constant.lean
@@ -10,6 +10,9 @@ import topology.continuous_function.algebra
 /-!
 # The algebra morphism from locally constant functions to continuous functions.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 -/
 
 namespace locally_constant
diff --git a/src/topology/continuous_function/ordered.lean b/src/topology/continuous_function/ordered.lean
index ce6e88b9f1c1a..7bbf9121a9ebe 100644
--- a/src/topology/continuous_function/ordered.lean
+++ b/src/topology/continuous_function/ordered.lean
@@ -5,11 +5,15 @@ Authors: Scott Morrison, Shing Tak Lam
 -/
 
 import topology.algebra.order.proj_Icc
+import topology.algebra.order.group
 import topology.continuous_function.basic
 
 /-!
 # Bundled continuous maps into orders, with order-compatible topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 -/
 
 variables {α : Type*} {β : Type*} {γ : Type*}
diff --git a/src/topology/continuous_function/polynomial.lean b/src/topology/continuous_function/polynomial.lean
index 56cfe2d422548..a9c7142e3f834 100644
--- a/src/topology/continuous_function/polynomial.lean
+++ b/src/topology/continuous_function/polynomial.lean
@@ -5,12 +5,14 @@ Authors: Scott Morrison
 -/
 import topology.algebra.polynomial
 import topology.continuous_function.algebra
-import topology.continuous_function.compact
 import topology.unit_interval
 
 /-!
 # Constructions relating polynomial functions and continuous functions.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 * `polynomial.to_continuous_map_on p X`: for `X : set R`, interprets a polynomial `p`
@@ -61,7 +63,7 @@ variables {α : Type*} [topological_space α]
 begin
   apply polynomial.induction_on' g,
   { intros p q hp hq, simp [hp, hq], },
-  { intros n a, simp [pi.pow_apply f x n], },
+  { intros n a, simp [pi.pow_apply], },
 end
 
 end
@@ -74,7 +76,7 @@ noncomputable theory
 variables [comm_semiring R] [topological_space R] [topological_semiring R]
 
 /--
-The algebra map from `polynomial R` to continuous functions `C(R, R)`.
+The algebra map from `R[X]` to continuous functions `C(R, R)`.
 -/
 @[simps]
 def to_continuous_map_alg_hom : R[X] →ₐ[R] C(R, R) :=
@@ -86,7 +88,7 @@ def to_continuous_map_alg_hom : R[X] →ₐ[R] C(R, R) :=
   commutes' := by { intros, ext, simp [algebra.algebra_map_eq_smul_one], }, }
 
 /--
-The algebra map from `polynomial R` to continuous functions `C(X, R)`, for any subset `X` of `R`.
+The algebra map from `R[X]` to continuous functions `C(X, R)`, for any subset `X` of `R`.
 -/
 @[simps]
 def to_continuous_map_on_alg_hom (X : set R) : R[X] →ₐ[R] C(X, R)  :=
@@ -136,9 +138,9 @@ open continuous_map
 
 /-- The preimage of polynomials on `[0,1]` under the pullback map by `x ↦ (b-a) * x + a`
 is the polynomials on `[a,b]`. -/
-lemma polynomial_functions.comap'_comp_right_alg_hom_Icc_homeo_I (a b : ℝ) (h : a < b) :
-  (polynomial_functions I).comap'
-    (comp_right_alg_hom ℝ (Icc_homeo_I a b h).symm.to_continuous_map) =
+lemma polynomial_functions.comap_comp_right_alg_hom_Icc_homeo_I (a b : ℝ) (h : a < b) :
+  (polynomial_functions I).comap
+    (comp_right_alg_hom ℝ ℝ (Icc_homeo_I a b h).symm.to_continuous_map) =
     polynomial_functions (set.Icc a b) :=
 begin
   ext f,
@@ -155,7 +157,7 @@ begin
         polynomial.eval_X, polynomial.eval_neg, polynomial.eval_C, polynomial.eval_smul,
         smul_eq_mul, polynomial.eval_mul, polynomial.eval_add, polynomial.coe_aeval_eq_eval,
         polynomial.eval_comp, polynomial.to_continuous_map_on_alg_hom_apply,
-        polynomial.to_continuous_map_on_to_fun, polynomial.to_continuous_map_to_fun],
+        polynomial.to_continuous_map_on_apply, polynomial.to_continuous_map_apply],
       convert w ⟨_, _⟩; clear w,
       { -- why does `comm_ring.add` appear here!?
         change x = (Icc_homeo_I a b h).symm ⟨_ + _, _⟩,
diff --git a/src/topology/continuous_function/stone_weierstrass.lean b/src/topology/continuous_function/stone_weierstrass.lean
index 56e6ef79047e5..4d8ecabec58db 100644
--- a/src/topology/continuous_function/stone_weierstrass.lean
+++ b/src/topology/continuous_function/stone_weierstrass.lean
@@ -4,18 +4,21 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison, Heather Macbeth
 -/
 import topology.continuous_function.weierstrass
-import analysis.complex.basic
+import data.is_R_or_C.basic
 
 /-!
 # The Stone-Weierstrass theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
 separates points, then it is dense.
 
 We argue as follows.
 
 * In any subalgebra `A` of `C(X, ℝ)`, if `f ∈ A`, then `abs f ∈ A.topological_closure`.
-  This follows from the Weierstrass approximation theorem on `[-∥f∥, ∥f∥]` by
+  This follows from the Weierstrass approximation theorem on `[-‖f‖, ‖f‖]` by
   approximating `abs` uniformly thereon by polynomials.
 * This ensures that `A.topological_closure` is actually a sublattice:
   if it contains `f` and `g`, then it contains the pointwise supremum `f ⊔ g`
@@ -45,27 +48,28 @@ noncomputable theory
 namespace continuous_map
 
 variables {X : Type*} [topological_space X] [compact_space X]
+open_locale polynomial
 
 /--
-Turn a function `f : C(X, ℝ)` into a continuous map into `set.Icc (-∥f∥) (∥f∥)`,
+Turn a function `f : C(X, ℝ)` into a continuous map into `set.Icc (-‖f‖) (‖f‖)`,
 thereby explicitly attaching bounds.
 -/
-def attach_bound (f : C(X, ℝ)) : C(X, set.Icc (-∥f∥) (∥f∥)) :=
+def attach_bound (f : C(X, ℝ)) : C(X, set.Icc (-‖f‖) (‖f‖)) :=
 { to_fun := λ x, ⟨f x, ⟨neg_norm_le_apply f x, apply_le_norm f x⟩⟩ }
 
 @[simp] lemma attach_bound_apply_coe (f : C(X, ℝ)) (x : X) : ((attach_bound f) x : ℝ) = f x := rfl
 
-lemma polynomial_comp_attach_bound (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : polynomial ℝ) :
-  (g.to_continuous_map_on (set.Icc (-∥f∥) ∥f∥)).comp (f : C(X, ℝ)).attach_bound =
+lemma polynomial_comp_attach_bound (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : ℝ[X]) :
+  (g.to_continuous_map_on (set.Icc (-‖f‖) ‖f‖)).comp (f : C(X, ℝ)).attach_bound =
     polynomial.aeval f g :=
 begin
   ext,
   simp only [continuous_map.coe_comp, function.comp_app,
     continuous_map.attach_bound_apply_coe,
-    polynomial.to_continuous_map_on_to_fun,
+    polynomial.to_continuous_map_on_apply,
     polynomial.aeval_subalgebra_coe,
     polynomial.aeval_continuous_map_apply,
-    polynomial.to_continuous_map_to_fun],
+    polynomial.to_continuous_map_apply],
 end
 
 /--
@@ -73,23 +77,23 @@ Given a continuous function `f` in a subalgebra of `C(X, ℝ)`, postcomposing by
 gives another function in `A`.
 
 This lemma proves something slightly more subtle than this:
-we take `f`, and think of it as a function into the restricted target `set.Icc (-∥f∥) ∥f∥)`,
+we take `f`, and think of it as a function into the restricted target `set.Icc (-‖f‖) ‖f‖)`,
 and then postcompose with a polynomial function on that interval.
 This is in fact the same situation as above, and so also gives a function in `A`.
 -/
-lemma polynomial_comp_attach_bound_mem (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : polynomial ℝ) :
-  (g.to_continuous_map_on (set.Icc (-∥f∥) ∥f∥)).comp (f : C(X, ℝ)).attach_bound ∈ A :=
+lemma polynomial_comp_attach_bound_mem (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : ℝ[X]) :
+  (g.to_continuous_map_on (set.Icc (-‖f‖) ‖f‖)).comp (f : C(X, ℝ)).attach_bound ∈ A :=
 begin
   rw polynomial_comp_attach_bound,
   apply set_like.coe_mem,
 end
 
 theorem comp_attach_bound_mem_closure
-  (A : subalgebra ℝ C(X, ℝ)) (f : A) (p : C(set.Icc (-∥f∥) (∥f∥), ℝ)) :
+  (A : subalgebra ℝ C(X, ℝ)) (f : A) (p : C(set.Icc (-‖f‖) (‖f‖), ℝ)) :
   p.comp (attach_bound f) ∈ A.topological_closure :=
 begin
   -- `p` itself is in the closure of polynomials, by the Weierstrass theorem,
-  have mem_closure : p ∈ (polynomial_functions (set.Icc (-∥f∥) (∥f∥))).topological_closure :=
+  have mem_closure : p ∈ (polynomial_functions (set.Icc (-‖f‖) (‖f‖))).topological_closure :=
     continuous_map_mem_polynomial_functions_closure _ _ p,
   -- and so there are polynomials arbitrarily close.
   have frequently_mem_polynomials := mem_closure_iff_frequently.mp mem_closure,
@@ -109,10 +113,10 @@ end
 theorem abs_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f : A) :
   (f : C(X, ℝ)).abs ∈ A.topological_closure :=
 begin
-  let M := ∥f∥,
+  let M := ‖f‖,
   let f' := attach_bound (f : C(X, ℝ)),
-  let abs : C(set.Icc (-∥f∥) (∥f∥), ℝ) :=
-  { to_fun := λ x : set.Icc (-∥f∥) (∥f∥), |(x : ℝ)| },
+  let abs : C(set.Icc (-‖f‖) (‖f‖), ℝ) :=
+  { to_fun := λ x : set.Icc (-‖f‖) (‖f‖), |(x : ℝ)| },
   change (abs.comp f') ∈ A.topological_closure,
   apply comp_attach_bound_mem_closure,
 end
@@ -123,8 +127,8 @@ begin
   rw inf_eq,
   refine A.topological_closure.smul_mem
     (A.topological_closure.sub_mem
-      (A.topological_closure.add_mem (A.subalgebra_topological_closure f.property)
-          (A.subalgebra_topological_closure g.property)) _) _,
+      (A.topological_closure.add_mem (A.le_topological_closure f.property)
+          (A.le_topological_closure g.property)) _) _,
   exact_mod_cast abs_mem_subalgebra_closure A _,
 end
 
@@ -144,8 +148,8 @@ begin
   rw sup_eq,
   refine A.topological_closure.smul_mem
     (A.topological_closure.add_mem
-      (A.topological_closure.add_mem (A.subalgebra_topological_closure f.property)
-          (A.subalgebra_topological_closure g.property)) _) _,
+      (A.topological_closure.add_mem (A.le_topological_closure f.property)
+          (A.le_topological_closure g.property)) _) _,
   exact_mod_cast abs_mem_subalgebra_closure A _,
 end
 
@@ -159,7 +163,7 @@ begin
   exact h,
 end
 
-open_locale topological_space
+open_locale topology
 
 -- Here's the fun part of Stone-Weierstrass!
 theorem sublattice_closure_eq_top
@@ -189,11 +193,8 @@ begin
   and finally using compactness to produce the desired function `h`
   as a maximum over finitely many `x` of a minimum over finitely many `y` of the `g x y`.
   -/
-  dsimp [set.separates_points_strongly] at sep,
-
-  let g : X → X → L := λ x y, (sep f x y).some,
-  have w₁ : ∀ x y, g x y x = f x := λ x y, (sep f x y).some_spec.1,
-  have w₂ : ∀ x y, g x y y = f y := λ x y, (sep f x y).some_spec.2,
+  dsimp only [set.separates_points_strongly] at sep,
+  choose g hg w₁ w₂ using sep f,
 
   -- For each `x y`, we define `U x y` to be `{z | f z - ε < g x y z}`,
   -- and observe this is a neighbourhood of `y`.
@@ -225,7 +226,7 @@ begin
   -- and `h x x = f x`.
   let h : Π x, L := λ x,
     ⟨(ys x).sup' (ys_nonempty x) (λ y, (g x y : C(X, ℝ))),
-      finset.sup'_mem _ sup_mem _ _ _ (λ y _, (g x y).2)⟩,
+      finset.sup'_mem _ sup_mem _ _ _ (λ y _, hg x y)⟩,
   have lt_h : ∀ x z, f z - ε < h x z,
   { intros x z,
     obtain ⟨y, ym, zm⟩ := set.exists_set_mem_of_union_eq_top _ _ (ys_w x) z,
@@ -233,7 +234,7 @@ begin
     simp only [coe_fn_coe_base', subtype.coe_mk, sup'_coe, finset.sup'_apply, finset.lt_sup'_iff],
     exact ⟨y, ym, zm⟩ },
   have h_eq : ∀ x, h x x = f x,
-  { intro x, simp only [coe_fn_coe_base'] at w₁, simp [coe_fn_coe_base', w₁], },
+  { intro x, simp [coe_fn_coe_base', w₁], },
 
   -- For each `x`, we define `W x` to be `{z | h x z < f z + ε}`,
   let W : Π x, set X := λ x, {z | h x z < f z + ε},
@@ -295,13 +296,13 @@ begin
   apply set_like.ext',
   let L := A.topological_closure,
   have n : set.nonempty (L : set C(X, ℝ)) :=
-    ⟨(1 : C(X, ℝ)), A.subalgebra_topological_closure A.one_mem⟩,
+    ⟨(1 : C(X, ℝ)), A.le_topological_closure A.one_mem⟩,
   convert sublattice_closure_eq_top
     (L : set C(X, ℝ)) n
     (λ f fm g gm, inf_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
     (λ f fm g gm, sup_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
     (subalgebra.separates_points.strongly
-      (subalgebra.separates_points_monotone (A.subalgebra_topological_closure) w)),
+      (subalgebra.separates_points_monotone (A.le_topological_closure) w)),
   { simp, },
 end
 
@@ -330,7 +331,7 @@ every real-valued continuous function on `X` is within any `ε > 0` of some elem
 theorem exists_mem_subalgebra_near_continuous_map_of_separates_points
   (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
   (f : C(X, ℝ)) (ε : ℝ) (pos : 0 < ε) :
-  ∃ (g : A), ∥(g : C(X, ℝ)) - f∥ < ε :=
+  ∃ (g : A), ‖(g : C(X, ℝ)) - f‖ < ε :=
 begin
   have w := mem_closure_iff_frequently.mp
     (continuous_map_mem_subalgebra_closure_of_separates_points A w f),
@@ -350,7 +351,7 @@ every real-valued continuous function on `X` is within any `ε > 0` of some elem
 theorem exists_mem_subalgebra_near_continuous_of_separates_points
   (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
   (f : X → ℝ) (c : continuous f) (ε : ℝ) (pos : 0 < ε) :
-  ∃ (g : A), ∀ x, ∥g x - f x∥ < ε :=
+  ∃ (g : A), ∀ x, ‖g x - f x‖ < ε :=
 begin
   obtain ⟨g, b⟩ := exists_mem_subalgebra_near_continuous_map_of_separates_points A w ⟨f, c⟩ ε pos,
   use g,
@@ -359,71 +360,92 @@ end
 
 end continuous_map
 
-section complex
-open complex
+section is_R_or_C
+open is_R_or_C
 
 -- Redefine `X`, since for the next few lemmas it need not be compact
-variables {X : Type*} [topological_space X]
+variables {𝕜 : Type*} {X : Type*} [is_R_or_C 𝕜] [topological_space X]
 
 namespace continuous_map
 
-/-- A real subalgebra of `C(X, ℂ)` is `conj_invariant`, if it contains all its conjugates. -/
-def conj_invariant_subalgebra (A : subalgebra ℝ C(X, ℂ)) : Prop :=
+/-- A real subalgebra of `C(X, 𝕜)` is `conj_invariant`, if it contains all its conjugates. -/
+def conj_invariant_subalgebra (A : subalgebra ℝ C(X, 𝕜)) : Prop :=
 A.map (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) ≤ A
 
-lemma mem_conj_invariant_subalgebra {A : subalgebra ℝ C(X, ℂ)} (hA : conj_invariant_subalgebra A)
-  {f : C(X, ℂ)} (hf : f ∈ A) :
+lemma mem_conj_invariant_subalgebra {A : subalgebra ℝ C(X, 𝕜)} (hA : conj_invariant_subalgebra A)
+  {f : C(X, 𝕜)} (hf : f ∈ A) :
   (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) f ∈ A :=
 hA ⟨f, hf, rfl⟩
 
+/-- If a set `S` is conjugation-invariant, then its `𝕜`-span is conjugation-invariant. -/
+lemma subalgebra_conj_invariant {S : set C(X, 𝕜)}
+  (hS : ∀ f, f ∈ S → (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) f ∈ S) :
+  conj_invariant_subalgebra ((algebra.adjoin 𝕜 S).restrict_scalars ℝ) :=
+begin
+  rintros _ ⟨f, hf, rfl⟩,
+  change _ ∈ ((algebra.adjoin 𝕜 S).restrict_scalars ℝ),
+  change _ ∈ ((algebra.adjoin 𝕜 S).restrict_scalars ℝ) at hf,
+  rw subalgebra.mem_restrict_scalars at hf ⊢,
+  apply algebra.adjoin_induction hf,
+  { exact λ g hg, algebra.subset_adjoin (hS g hg), },
+  { exact λ c, subalgebra.algebra_map_mem _ (star_ring_end 𝕜 c) },
+  { intros f g hf hg,
+    convert subalgebra.add_mem _ hf hg,
+    exact alg_hom.map_add _ f g },
+  { intros f g hf hg,
+    convert subalgebra.mul_mem _ hf hg,
+    exact alg_hom.map_mul _ f g, }
+end
+
 end continuous_map
 
 open continuous_map
 
-/-- If a conjugation-invariant subalgebra of `C(X, ℂ)` separates points, then the real subalgebra
+/-- If a conjugation-invariant subalgebra of `C(X, 𝕜)` separates points, then the real subalgebra
 of its purely real-valued elements also separates points. -/
-lemma subalgebra.separates_points.complex_to_real {A : subalgebra ℂ C(X, ℂ)}
+lemma subalgebra.separates_points.is_R_or_C_to_real {A : subalgebra 𝕜 C(X, 𝕜)}
   (hA : A.separates_points) (hA' : conj_invariant_subalgebra (A.restrict_scalars ℝ)) :
-  ((A.restrict_scalars ℝ).comap'
+  ((A.restrict_scalars ℝ).comap
     (of_real_am.comp_left_continuous ℝ continuous_of_real)).separates_points :=
 begin
   intros x₁ x₂ hx,
   -- Let `f` in the subalgebra `A` separate the points `x₁`, `x₂`
   obtain ⟨_, ⟨f, hfA, rfl⟩, hf⟩ := hA hx,
-  let F : C(X, ℂ) := f - const _ (f x₂),
+  let F : C(X, 𝕜) := f - const _ (f x₂),
   -- Subtract the constant `f x₂` from `f`; this is still an element of the subalgebra
   have hFA : F ∈ A,
-  { refine A.sub_mem hfA _,
-    convert A.smul_mem A.one_mem (f x₂),
-    ext1,
-    simp },
+  { refine A.sub_mem hfA (@eq.subst _ (∈ A) _ _ _ $ A.smul_mem A.one_mem $ f x₂),
+    ext1, simp only [coe_smul, coe_one, pi.smul_apply,
+      pi.one_apply, algebra.id.smul_eq_mul, mul_one, const_apply] },
   -- Consider now the function `λ x, |f x - f x₂| ^ 2`
-  refine ⟨_, ⟨(⟨complex.norm_sq, continuous_norm_sq⟩ : C(ℂ, ℝ)).comp F, _, rfl⟩, _⟩,
+  refine ⟨_, ⟨(⟨is_R_or_C.norm_sq, continuous_norm_sq⟩ : C(𝕜, ℝ)).comp F, _, rfl⟩, _⟩,
   { -- This is also an element of the subalgebra, and takes only real values
     rw [set_like.mem_coe, subalgebra.mem_comap],
     convert (A.restrict_scalars ℝ).mul_mem (mem_conj_invariant_subalgebra hA' hFA) hFA,
     ext1,
-    exact complex.norm_sq_eq_conj_mul_self },
+    rw [mul_comm],
+    exact (is_R_or_C.mul_conj _).symm },
   { -- And it also separates the points `x₁`, `x₂`
     have : f x₁ - f x₂ ≠ 0 := sub_ne_zero.mpr hf,
-    simpa using this },
+    simpa only [comp_apply, coe_sub, coe_const, pi.sub_apply,
+      coe_mk, sub_self, map_zero, ne.def, norm_sq_eq_zero] using this },
 end
 
 variables [compact_space X]
 
 /--
-The Stone-Weierstrass approximation theorem, complex version,
-that a subalgebra `A` of `C(X, ℂ)`, where `X` is a compact topological space,
+The Stone-Weierstrass approximation theorem, `is_R_or_C` version,
+that a subalgebra `A` of `C(X, 𝕜)`, where `X` is a compact topological space and `is_R_or_C 𝕜`,
 is dense if it is conjugation-invariant and separates points.
 -/
-theorem continuous_map.subalgebra_complex_topological_closure_eq_top_of_separates_points
-  (A : subalgebra ℂ C(X, ℂ)) (hA : A.separates_points)
+theorem continuous_map.subalgebra_is_R_or_C_topological_closure_eq_top_of_separates_points
+  (A : subalgebra 𝕜 C(X, 𝕜)) (hA : A.separates_points)
   (hA' : conj_invariant_subalgebra (A.restrict_scalars ℝ)) :
   A.topological_closure = ⊤ :=
 begin
   rw algebra.eq_top_iff,
-  -- Let `I` be the natural inclusion of `C(X, ℝ)` into `C(X, ℂ)`
-  let I : C(X, ℝ) →ₗ[ℝ] C(X, ℂ) := of_real_clm.comp_left_continuous ℝ X,
+  -- Let `I` be the natural inclusion of `C(X, ℝ)` into `C(X, 𝕜)`
+  let I : C(X, ℝ) →ₗ[ℝ] C(X, 𝕜) := of_real_clm.comp_left_continuous ℝ X,
   -- The main point of the proof is that its range (i.e., every real-valued function) is contained
   -- in the closure of `A`
   have key : I.range ≤ (A.to_submodule.restrict_scalars ℝ).topological_closure,
@@ -433,25 +455,28 @@ begin
     -- By `subalgebra.separates_points.complex_to_real`, this subalgebra also separates points, so
     -- we may apply the real Stone-Weierstrass result to it.
     have SW : A₀.topological_closure = ⊤,
-    { have := subalgebra_topological_closure_eq_top_of_separates_points _ (hA.complex_to_real hA'),
+    { have := subalgebra_topological_closure_eq_top_of_separates_points _
+                (hA.is_R_or_C_to_real hA'),
       exact congr_arg subalgebra.to_submodule this },
     rw [← submodule.map_top, ← SW],
     -- So it suffices to prove that the image under `I` of the closure of `A₀` is contained in the
     -- closure of `A`, which follows by abstract nonsense
-    have h₁ := A₀.topological_closure_map (of_real_clm.comp_left_continuous_compact X),
+    have h₁ := A₀.topological_closure_map ((@of_real_clm 𝕜 _).comp_left_continuous_compact X),
     have h₂ := (A.to_submodule.restrict_scalars ℝ).map_comap_le I,
     exact h₁.trans (submodule.topological_closure_mono h₂) },
-  -- In particular, for a function `f` in `C(X, ℂ)`, the real and imaginary parts of `f` are in the
+  -- In particular, for a function `f` in `C(X, 𝕜)`, the real and imaginary parts of `f` are in the
   -- closure of `A`
   intros f,
-  let f_re : C(X, ℝ) := (⟨complex.re, complex.re_clm.continuous⟩ : C(ℂ, ℝ)).comp f,
-  let f_im : C(X, ℝ) := (⟨complex.im, complex.im_clm.continuous⟩ : C(ℂ, ℝ)).comp f,
+  let f_re : C(X, ℝ) := (⟨is_R_or_C.re, is_R_or_C.re_clm.continuous⟩ : C(𝕜, ℝ)).comp f,
+  let f_im : C(X, ℝ) := (⟨is_R_or_C.im, is_R_or_C.im_clm.continuous⟩ : C(𝕜, ℝ)).comp f,
   have h_f_re : I f_re ∈ A.topological_closure := key ⟨f_re, rfl⟩,
   have h_f_im : I f_im ∈ A.topological_closure := key ⟨f_im, rfl⟩,
-  -- So `f_re + complex.I • f_im` is in the closure of `A`
-  convert A.topological_closure.add_mem h_f_re (A.topological_closure.smul_mem h_f_im complex.I),
+  -- So `f_re + I • f_im` is in the closure of `A`
+  convert A.topological_closure.add_mem h_f_re (A.topological_closure.smul_mem h_f_im is_R_or_C.I),
   -- And this, of course, is just `f`
-  ext; simp [I]
+  ext,
+  apply eq.symm,
+  simp [I, mul_comm is_R_or_C.I _],
 end
 
-end complex
+end is_R_or_C
diff --git a/src/topology/continuous_function/t0_sierpinski.lean b/src/topology/continuous_function/t0_sierpinski.lean
new file mode 100644
index 0000000000000..5c8bf236ec146
--- /dev/null
+++ b/src/topology/continuous_function/t0_sierpinski.lean
@@ -0,0 +1,67 @@
+/-
+Copyright (c) 2022 Ivan Sadofschi Costa. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ivan Sadofschi Costa
+-/
+import topology.order
+import topology.sets.opens
+import topology.continuous_function.basic
+
+/-!
+# Any T0 space embeds in a product of copies of the Sierpinski space.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We consider `Prop` with the Sierpinski topology. If `X` is a topological space, there is a
+continuous map `product_of_mem_opens` from `X` to `opens X → Prop` which is the product of the maps
+`X → Prop` given by `x ↦ x ∈ u`.
+
+The map `product_of_mem_opens` is always inducing. Whenever `X` is T0, `product_of_mem_opens` is
+also injective and therefore an embedding.
+-/
+
+noncomputable theory
+
+namespace topological_space
+
+lemma eq_induced_by_maps_to_sierpinski (X : Type*) [t : topological_space X] :
+  t = ⨅ (u : opens X), sierpinski_space.induced (∈ u) :=
+begin
+  apply le_antisymm,
+  { rw [le_infi_iff],
+    exact λ u, continuous.le_induced (is_open_iff_continuous_mem.mp u.2) },
+  { intros u h,
+    rw ← generate_from_Union_is_open,
+    apply is_open_generate_from_of_mem,
+    simp only [set.mem_Union, set.mem_set_of_eq, is_open_induced_iff],
+    exact ⟨⟨u, h⟩, {true}, is_open_singleton_true, by simp [set.preimage]⟩ },
+end
+
+variables (X : Type*) [topological_space X]
+
+/--
+The continuous map from `X` to the product of copies of the Sierpinski space, (one copy for each
+open subset `u` of `X`). The `u` coordinate of `product_of_mem_opens x` is given by `x ∈ u`.
+-/
+def product_of_mem_opens : C(X, opens X → Prop) :=
+{ to_fun := λ x u, x ∈ u,
+  continuous_to_fun := continuous_pi_iff.2 (λ u, continuous_Prop.2 u.is_open) }
+
+lemma product_of_mem_opens_inducing : inducing (product_of_mem_opens X) :=
+begin
+  convert inducing_infi_to_pi (λ (u : opens X) (x : X), x ∈ u),
+  apply eq_induced_by_maps_to_sierpinski,
+end
+
+lemma product_of_mem_opens_injective [t0_space X] : function.injective (product_of_mem_opens X) :=
+begin
+  intros x1 x2 h,
+  apply inseparable.eq,
+  rw [←inducing.inseparable_iff (product_of_mem_opens_inducing X), h],
+ end
+
+theorem product_of_mem_opens_embedding [t0_space X] : embedding (product_of_mem_opens X) :=
+embedding.mk (product_of_mem_opens_inducing X) (product_of_mem_opens_injective X)
+
+end topological_space
diff --git a/src/topology/continuous_function/units.lean b/src/topology/continuous_function/units.lean
index 5719fe40939aa..bfa4927cff628 100644
--- a/src/topology/continuous_function/units.lean
+++ b/src/topology/continuous_function/units.lean
@@ -3,13 +3,16 @@ Copyright (c) 2022 Jireh Loreaux. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jireh Loreaux
 -/
-import topology.continuous_function.compact
 import analysis.normed_space.units
 import algebra.algebra.spectrum
+import topology.continuous_function.algebra
 
 /-!
 # Units of continuous functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file concerns itself with `C(X, M)ˣ` and `C(X, Mˣ)` when `X` is a topological space
 and `M` has some monoid structure compatible with its topology.
 -/
@@ -35,7 +38,7 @@ def units_lift : C(X, Mˣ) ≃ C(X, M)ˣ :=
   inv_fun := λ f,
   { to_fun := λ x, ⟨f x, f⁻¹ x, continuous_map.congr_fun f.mul_inv x,
                                 continuous_map.congr_fun f.inv_mul x⟩,
-    continuous_to_fun := continuous_induced_rng $ continuous.prod_mk (f : C(X, M)).continuous
+    continuous_to_fun := continuous_induced_rng.2 $ continuous.prod_mk (f : C(X, M)).continuous
       $ mul_opposite.continuous_op.comp (↑f⁻¹ : C(X, M)).continuous },
   left_inv := λ f, by { ext, refl },
   right_inv := λ f, by { ext, refl } }
@@ -49,7 +52,7 @@ variables [normed_ring R] [complete_space R]
 lemma _root_.normed_ring.is_unit_unit_continuous {f : C(X, R)} (h : ∀ x, is_unit (f x)) :
   continuous (λ x, (h x).unit) :=
 begin
-  refine continuous_induced_rng (continuous.prod_mk f.continuous
+  refine continuous_induced_rng.2 (continuous.prod_mk f.continuous
     (mul_opposite.continuous_op.comp (continuous_iff_continuous_at.mpr (λ x, _)))),
   have := normed_ring.inverse_continuous_at (h x).unit,
   simp only [←ring.inverse_unit, is_unit.unit_spec, ←function.comp_apply] at this ⊢,
@@ -63,10 +66,9 @@ noncomputable def units_of_forall_is_unit {f : C(X, R)} (h : ∀ x, is_unit (f x
 { to_fun := λ x, (h x).unit,
   continuous_to_fun :=  normed_ring.is_unit_unit_continuous h }
 
-instance : can_lift C(X, R) C(X, Rˣ) :=
-{ coe := λ f, ⟨λ x, f x, units.continuous_coe.comp f.continuous⟩,
-  cond := λ f, ∀ x, is_unit (f x),
-  prf := λ f h, ⟨units_of_forall_is_unit h, by { ext, refl }⟩ }
+instance can_lift : can_lift C(X, R) C(X, Rˣ)
+  (λ f, ⟨λ x, f x, units.continuous_coe.comp f.continuous⟩) (λ f, ∀ x, is_unit (f x)) :=
+{ prf := λ f h, ⟨units_of_forall_is_unit h, by { ext, refl }⟩ }
 
 lemma is_unit_iff_forall_is_unit (f : C(X, R)) :
   is_unit f ↔ ∀ x, is_unit (f x) :=
diff --git a/src/topology/continuous_function/weierstrass.lean b/src/topology/continuous_function/weierstrass.lean
index 87b9b01092a8f..0f90c5b6c3135 100644
--- a/src/topology/continuous_function/weierstrass.lean
+++ b/src/topology/continuous_function/weierstrass.lean
@@ -9,6 +9,9 @@ import topology.algebra.algebra
 /-!
 # The Weierstrass approximation theorem for continuous functions on `[a,b]`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We've already proved the Weierstrass approximation theorem
 in the sense that we've shown that the Bernstein approximations
 to a continuous function on `[0,1]` converge uniformly.
@@ -58,7 +61,7 @@ begin
   { -- We can pullback continuous functions on `[a,b]` to continuous functions on `[0,1]`,
     -- by precomposing with an affine map.
     let W : C(set.Icc a b, ℝ) →ₐ[ℝ] C(I, ℝ) :=
-      comp_right_alg_hom ℝ (Icc_homeo_I a b h).symm.to_continuous_map,
+      comp_right_alg_hom ℝ ℝ (Icc_homeo_I a b h).symm.to_continuous_map,
     -- This operation is itself a homeomorphism
     -- (with respect to the norm topologies on continuous functions).
     let W' : C(set.Icc a b, ℝ) ≃ₜ C(I, ℝ) := comp_right_homeomorph ℝ (Icc_homeo_I a b h).symm,
@@ -66,19 +69,18 @@ begin
     -- Thus we take the statement of the Weierstrass approximation theorem for `[0,1]`,
     have p := polynomial_functions_closure_eq_top',
     -- and pullback both sides, obtaining an equation between subalgebras of `C([a,b], ℝ)`.
-    apply_fun (λ s, s.comap' W) at p,
+    apply_fun (λ s, s.comap W) at p,
     simp only [algebra.comap_top] at p,
     -- Since the pullback operation is continuous, it commutes with taking `topological_closure`,
-    rw subalgebra.topological_closure_comap'_homeomorph _ W W' w at p,
+    rw subalgebra.topological_closure_comap_homeomorph _ W W' w at p,
     -- and precomposing with an affine map takes polynomial functions to polynomial functions.
-    rw polynomial_functions.comap'_comp_right_alg_hom_Icc_homeo_I at p,
+    rw polynomial_functions.comap_comp_right_alg_hom_Icc_homeo_I at p,
     -- 🎉
     exact p },
   { -- Otherwise, `b ≤ a`, and the interval is a subsingleton,
     -- so all subalgebras are the same anyway.
     haveI : subsingleton (set.Icc a b) := ⟨λ x y, le_antisymm
       ((x.2.2.trans (not_lt.mp h)).trans y.2.1) ((y.2.2.trans (not_lt.mp h)).trans x.2.1)⟩,
-    haveI := (continuous_map.subsingleton_subalgebra (set.Icc a b) ℝ),
     apply subsingleton.elim, }
 end
 
@@ -94,6 +96,8 @@ begin
   simp,
 end
 
+open_locale polynomial
+
 /--
 An alternative statement of Weierstrass' theorem,
 for those who like their epsilons.
@@ -102,7 +106,7 @@ Every real-valued continuous function on `[a,b]` is within any `ε > 0` of some
 -/
 theorem exists_polynomial_near_continuous_map (a b : ℝ) (f : C(set.Icc a b, ℝ))
   (ε : ℝ) (pos : 0 < ε) :
-  ∃ (p : polynomial ℝ), ∥p.to_continuous_map_on _ - f∥ < ε :=
+  ∃ (p : ℝ[X]), ‖p.to_continuous_map_on _ - f‖ < ε :=
 begin
   have w := mem_closure_iff_frequently.mp (continuous_map_mem_polynomial_functions_closure _ _ f),
   rw metric.nhds_basis_ball.frequently_iff at w,
@@ -120,7 +124,7 @@ can be approximated to within any `ε > 0` on `[a,b]` by some polynomial.
 -/
 theorem exists_polynomial_near_of_continuous_on
   (a b : ℝ) (f : ℝ → ℝ) (c : continuous_on f (set.Icc a b)) (ε : ℝ) (pos : 0 < ε) :
-  ∃ (p : polynomial ℝ), ∀ x ∈ set.Icc a b, |p.eval x - f x| < ε :=
+  ∃ (p : ℝ[X]), ∀ x ∈ set.Icc a b, |p.eval x - f x| < ε :=
 begin
   let f' : C(set.Icc a b, ℝ) := ⟨λ x, f x, continuous_on_iff_continuous_restrict.mp c⟩,
   obtain ⟨p, b⟩ := exists_polynomial_near_continuous_map a b f' ε pos,
diff --git a/src/topology/continuous_function/zero_at_infty.lean b/src/topology/continuous_function/zero_at_infty.lean
index 252957f0c6000..60e0bb52fd6df 100644
--- a/src/topology/continuous_function/zero_at_infty.lean
+++ b/src/topology/continuous_function/zero_at_infty.lean
@@ -9,6 +9,9 @@ import topology.continuous_function.cocompact_map
 /-!
 # Continuous functions vanishing at infinity
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The type of continuous functions vanishing at infinity. When the domain is compact
 `C(α, β) ≃ C₀(α, β)` via the identity map. When the codomain is a metric space, every continuous
 map which vanishes at infinity is a bounded continuous function. When the domain is a locally
@@ -24,7 +27,7 @@ universes u v w
 
 variables {F : Type*} {α : Type u} {β : Type v} {γ : Type w} [topological_space α]
 
-open_locale bounded_continuous_function topological_space
+open_locale bounded_continuous_function topology
 open filter metric
 
 /-- `C₀(α, β)` is the type of continuous functions `α → β` which vanish at infinity from a
@@ -39,9 +42,13 @@ structure zero_at_infty_continuous_map (α : Type u) (β : Type v)
   Type (max u v) :=
 (zero_at_infty' : tendsto to_fun (cocompact α) (𝓝 0))
 
-localized "notation [priority 2000] `C₀(` α `, ` β `)` := zero_at_infty_continuous_map α β"
-  in zero_at_infty
-localized "notation α ` →C₀ ` β := zero_at_infty_continuous_map α β" in zero_at_infty
+localized "notation [priority 2000] (name := zero_at_infty_continuous_map)
+  `C₀(` α `, ` β `)` := zero_at_infty_continuous_map α β" in zero_at_infty
+localized "notation (name := zero_at_infty_continuous_map.arrow)
+  α ` →C₀ ` β := zero_at_infty_continuous_map α β" in zero_at_infty
+
+section
+set_option old_structure_cmd true
 
 /-- `zero_at_infty_continuous_map_class F α β` states that `F` is a type of continuous maps which
 vanish at infinity.
@@ -51,6 +58,8 @@ class zero_at_infty_continuous_map_class (F : Type*) (α β : out_param $ Type*)
   [has_zero β] [topological_space β] extends continuous_map_class F α β :=
 (zero_at_infty (f : F) : tendsto f (cocompact α) (𝓝 0))
 
+end
+
 export zero_at_infty_continuous_map_class (zero_at_infty)
 
 namespace zero_at_infty_continuous_map
@@ -84,6 +93,9 @@ protected def copy (f : C₀(α, β)) (f' : α → β) (h : f' = f) : C₀(α, 
   continuous_to_fun := by { rw h, exact f.continuous_to_fun },
   zero_at_infty' := by { simp_rw h, exact f.zero_at_infty' } }
 
+@[simp] lemma coe_copy (f : C₀(α, β)) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : C₀(α, β)) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 lemma eq_of_empty [is_empty α] (f g : C₀(α, β)) : f = g :=
 ext $ is_empty.elim ‹_›
 
@@ -159,7 +171,7 @@ variables [add_monoid β] [has_continuous_add β] (f g : C₀(α, β))
 | 0 := by rw [nsmul_rec, zero_smul, coe_zero]
 | (n + 1) := by rw [nsmul_rec, succ_nsmul, coe_add, coe_nsmul_rec]
 
-instance has_nat_scalar : has_scalar ℕ C₀(α, β) :=
+instance has_nat_scalar : has_smul ℕ C₀(α, β) :=
 ⟨λ n f, ⟨n • f, by simpa [coe_nsmul_rec] using zero_at_infty (nsmul_rec n f)⟩⟩
 
 instance : add_monoid C₀(α, β) :=
@@ -190,7 +202,7 @@ lemma sub_apply : (f - g) x = f x - g x := rfl
 | (int.of_nat n) := by rw [zsmul_rec, int.of_nat_eq_coe, coe_nsmul_rec, coe_nat_zsmul]
 | -[1+ n] := by rw [zsmul_rec, zsmul_neg_succ_of_nat, coe_neg, coe_nsmul_rec]
 
-instance has_int_scalar : has_scalar ℤ C₀(α, β) :=
+instance has_int_scalar : has_smul ℤ C₀(α, β) :=
 ⟨λ n f, ⟨n • f, by simpa using zero_at_infty (zsmul_rec n f)⟩⟩
 
 instance : add_group C₀(α, β) :=
@@ -202,7 +214,7 @@ instance [add_comm_group β] [topological_add_group β] : add_comm_group C₀(α
 fun_like.coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub (λ _ _, rfl) (λ _ _, rfl)
 
 instance [has_zero β] {R : Type*} [has_zero R] [smul_with_zero R β]
-  [has_continuous_const_smul R β] : has_scalar R C₀(α, β) :=
+  [has_continuous_const_smul R β] : has_smul R C₀(α, β) :=
 ⟨λ r f, ⟨r • f, by simpa [smul_zero] using (zero_at_infty f).const_smul r⟩⟩
 
 @[simp] lemma coe_smul [has_zero β] {R : Type*} [has_zero R] [smul_with_zero R β]
@@ -274,9 +286,18 @@ instance {R : Type*} [semiring R] [non_unital_non_assoc_semiring β] [topologica
     rw [←smul_eq_mul, ←smul_eq_mul, smul_comm],
   end }
 
-
 end algebraic_structure
 
+section uniform
+
+variables [uniform_space β] [uniform_space γ] [has_zero γ]
+  [zero_at_infty_continuous_map_class F β γ]
+
+lemma uniform_continuous (f : F) : uniform_continuous (f : β → γ) :=
+(map_continuous f).uniform_continuous_of_tendsto_cocompact (zero_at_infty f)
+
+end uniform
+
 /-! ### Metric structure
 
 When `β` is a metric space, then every element of `C₀(α, β)` is bounded, and so there is a natural
@@ -314,7 +335,8 @@ f.bounded_range.mono $ image_subset_range _ _
 
 @[priority 100]
 instance : bounded_continuous_map_class F α β :=
-{ map_bounded := λ f, zero_at_infty_continuous_map.bounded f }
+{ map_bounded := λ f, zero_at_infty_continuous_map.bounded f,
+  ..‹zero_at_infty_continuous_map_class F α β› }
 
 /-- Construct a bounded continuous function from a continuous function vanishing at infinity. -/
 @[simps]
@@ -382,26 +404,17 @@ field `𝕜` whenever `β` is as well.
 
 section normed_space
 
-variables [normed_group β] {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]
-
-/-- The natural inclusion `to_bcf : C₀(α, β) → (α →ᵇ β)` realized as an additive monoid
-homomorphism. -/
-def to_bcf_add_monoid_hom : C₀(α, β) →+ (α →ᵇ β) :=
-{ to_fun := to_bcf,
-  map_zero' := rfl,
-  map_add' := λ x y, rfl }
-
-@[simp]
-lemma coe_to_bcf_add_monoid_hom (f : C₀(α, β)) : (f.to_bcf_add_monoid_hom : α → β) = f := rfl
+variables [normed_add_comm_group β] {𝕜 : Type*} [normed_field 𝕜] [normed_space 𝕜 β]
 
-noncomputable instance : normed_group C₀(α, β) :=
-normed_group.induced to_bcf_add_monoid_hom (to_bcf_injective α β)
+noncomputable instance : normed_add_comm_group C₀(α, β) :=
+normed_add_comm_group.induced C₀(α, β) (α →ᵇ β) (⟨to_bcf, rfl, λ x y, rfl⟩ : C₀(α, β) →+ (α →ᵇ β))
+  (to_bcf_injective α β)
 
 @[simp]
-lemma norm_to_bcf_eq_norm {f : C₀(α, β)} : ∥f.to_bcf∥ = ∥f∥ := rfl
+lemma norm_to_bcf_eq_norm {f : C₀(α, β)} : ‖f.to_bcf‖ = ‖f‖ := rfl
 
 instance : normed_space 𝕜 C₀(α, β) :=
-{ norm_smul_le := λ k f, (norm_smul k f.to_bcf).le }
+{ norm_smul_le := λ k f, (norm_smul_le k f.to_bcf : _) }
 
 end normed_space
 
@@ -412,7 +425,7 @@ variables [non_unital_normed_ring β]
 noncomputable instance : non_unital_normed_ring C₀(α, β) :=
 { norm_mul := λ f g, norm_mul_le f.to_bcf g.to_bcf,
   ..zero_at_infty_continuous_map.non_unital_ring,
-  ..zero_at_infty_continuous_map.normed_group }
+  ..zero_at_infty_continuous_map.normed_add_comm_group }
 
 end normed_ring
 
@@ -453,7 +466,7 @@ end star
 
 section normed_star
 
-variables [normed_group β] [star_add_monoid β] [normed_star_group β]
+variables [normed_add_comm_group β] [star_add_monoid β] [normed_star_group β]
 
 instance : normed_star_group C₀(α, β) :=
 { norm_star := λ f, (norm_star f.to_bcf : _) }
diff --git a/src/topology/continuous_on.lean b/src/topology/continuous_on.lean
index 4439b2fe39c4d..8cb6fabef4bba 100644
--- a/src/topology/continuous_on.lean
+++ b/src/topology/continuous_on.lean
@@ -8,6 +8,9 @@ import topology.constructions
 /-!
 # Neighborhoods and continuity relative to a subset
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines relative versions
 
 * `nhds_within`           of `nhds`
@@ -27,7 +30,7 @@ equipped with the subspace topology.
 -/
 
 open set filter function
-open_locale topological_space filter
+open_locale topology filter
 
 variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
 variables [topological_space α]
@@ -44,6 +47,14 @@ lemma eventually_nhds_within_iff {a : α} {s : set α} {p : α → Prop} :
   (∀ᶠ x in 𝓝[s] a, p x) ↔ ∀ᶠ x in 𝓝 a, x ∈ s → p x :=
 eventually_inf_principal
 
+lemma frequently_nhds_within_iff {z : α} {s : set α} {p : α → Prop} :
+  (∃ᶠ x in 𝓝[s] z, p x) ↔ (∃ᶠ x in 𝓝 z, p x ∧ x ∈ s) :=
+iff.not (by simp [eventually_nhds_within_iff, not_and'])
+
+lemma mem_closure_ne_iff_frequently_within {z : α} {s : set α} :
+  z ∈ closure (s \ {z}) ↔ ∃ᶠ x in 𝓝[≠] z, x ∈ s :=
+by simp [mem_closure_iff_frequently, frequently_nhds_within_iff]
+
 @[simp] lemma eventually_nhds_within_nhds_within {a : α} {s : set α} {p : α → Prop} :
   (∀ᶠ y in 𝓝[s] a, ∀ᶠ x in 𝓝[s] y, p x) ↔ ∀ᶠ x in 𝓝[s] a, p x :=
 begin
@@ -94,6 +105,20 @@ begin
   exact (nhds a).sets_of_superset ((nhds a).inter_sets Hw h1) hw,
 end
 
+lemma mem_nhds_within_iff_eventually {s t : set α} {x : α} :
+  t ∈ 𝓝[s] x ↔ ∀ᶠ y in 𝓝 x, y ∈ s → y ∈ t :=
+set_eventually_le_iff_mem_inf_principal.symm
+
+lemma mem_nhds_within_iff_eventually_eq {s t : set α} {x : α} :
+  t ∈ 𝓝[s] x ↔ s =ᶠ[𝓝 x] (s ∩ t : set α) :=
+by simp_rw [mem_nhds_within_iff_eventually, eventually_eq_set, mem_inter_iff, iff_self_and]
+
+lemma nhds_within_eq_iff_eventually_eq {s t : set α} {x : α} : 𝓝[s] x = 𝓝[t] x ↔ s =ᶠ[𝓝 x] t :=
+set_eventually_eq_iff_inf_principal.symm
+
+lemma nhds_within_le_iff {s t : set α} {x : α} : 𝓝[s] x ≤ 𝓝[t] x ↔ t ∈ 𝓝[s] x :=
+set_eventually_le_iff_inf_principal_le.symm.trans set_eventually_le_iff_mem_inf_principal
+
 lemma preimage_nhds_within_coinduced' {π : α → β} {s : set β} {t : set α} {a : α}
   (h : a ∈ t) (ht : is_open t)
   (hs : s ∈ @nhds β (topological_space.coinduced (λ x : t, π x) subtype.topological_space) (π a)) :
@@ -117,6 +142,9 @@ mem_inf_of_left h
 theorem self_mem_nhds_within {a : α} {s : set α} : s ∈ 𝓝[s] a :=
 mem_inf_of_right (mem_principal_self s)
 
+theorem eventually_mem_nhds_within {a : α} {s : set α} : ∀ᶠ x in 𝓝[s] a, x ∈ s :=
+self_mem_nhds_within
+
 theorem inter_mem_nhds_within (s : set α) {t : set α} {a : α} (h : t ∈ 𝓝 a) :
   s ∩ t ∈ 𝓝[s] a :=
 inter_mem self_mem_nhds_within (mem_inf_of_left h)
@@ -155,12 +183,7 @@ nhds_within_restrict' s (is_open.mem_nhds h₁ h₀)
 
 theorem nhds_within_le_of_mem {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
   𝓝[t] a ≤ 𝓝[s] a :=
-begin
-  rcases mem_nhds_within.1 h with ⟨u, u_open, au, uts⟩,
-  have : 𝓝[t] a = 𝓝[t ∩ u] a := nhds_within_restrict _ au u_open,
-  rw [this, inter_comm],
-  exact nhds_within_mono _ uts
-end
+nhds_within_le_iff.mpr h
 
 theorem nhds_within_le_nhds {a : α} {s : set α} : 𝓝[s] a ≤ 𝓝 a :=
 by { rw ← nhds_within_univ, apply nhds_within_le_of_mem, exact univ_mem }
@@ -174,9 +197,12 @@ theorem nhds_within_eq_nhds_within {a : α} {s t u : set α}
   𝓝[t] a = 𝓝[u] a :=
 by rw [nhds_within_restrict t h₀ h₁, nhds_within_restrict u h₀ h₁, h₂]
 
+@[simp] theorem nhds_within_eq_nhds {a : α} {s : set α} : 𝓝[s] a = 𝓝 a ↔ s ∈ 𝓝 a :=
+by rw [nhds_within, inf_eq_left, le_principal_iff]
+
 theorem is_open.nhds_within_eq {a : α} {s : set α} (h : is_open s) (ha : a ∈ s) :
   𝓝[s] a = 𝓝 a :=
-inf_eq_left.2 $ le_principal_iff.2 $ is_open.mem_nhds h ha
+nhds_within_eq_nhds.2 $ is_open.mem_nhds h ha
 
 lemma preimage_nhds_within_coinduced {π : α → β} {s : set β} {t : set α} {a : α}
   (h : a ∈ t) (ht : is_open t)
@@ -191,6 +217,18 @@ theorem nhds_within_union (a : α) (s t : set α) :
   𝓝[s ∪ t] a = 𝓝[s] a ⊔ 𝓝[t] a :=
 by { delta nhds_within, rw [←inf_sup_left, sup_principal] }
 
+theorem nhds_within_bUnion {ι} {I : set ι} (hI : I.finite) (s : ι → set α) (a : α) :
+  𝓝[⋃ i ∈ I, s i] a = ⨆ i ∈ I, 𝓝[s i] a :=
+set.finite.induction_on hI (by simp) $ λ t T _ _ hT,
+  by simp only [hT, nhds_within_union, supr_insert, bUnion_insert]
+
+theorem nhds_within_sUnion {S : set (set α)} (hS : S.finite) (a : α) :
+  𝓝[⋃₀ S] a = ⨆ s ∈ S, 𝓝[s] a :=
+by rw [sUnion_eq_bUnion, nhds_within_bUnion hS]
+
+theorem nhds_within_Union {ι} [finite ι] (s : ι → set α) (a : α) : 𝓝[⋃ i, s i] a = ⨆ i, 𝓝[s i] a :=
+by rw [← sUnion_range, nhds_within_sUnion (finite_range s), supr_range]
+
 theorem nhds_within_inter (a : α) (s t : set α) :
   𝓝[s ∩ t] a = 𝓝[s] a ⊓ 𝓝[t] a :=
 by { delta nhds_within, rw [inf_left_comm, inf_assoc, inf_principal, ←inf_assoc, inf_idem] }
@@ -203,6 +241,10 @@ theorem nhds_within_inter_of_mem {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
   𝓝[s ∩ t] a = 𝓝[t] a :=
 by { rw [nhds_within_inter, inf_eq_right], exact nhds_within_le_of_mem h }
 
+theorem nhds_within_inter_of_mem' {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
+  𝓝[t ∩ s] a = 𝓝[t] a :=
+by rw [inter_comm, nhds_within_inter_of_mem h]
+
 @[simp] theorem nhds_within_singleton (a : α) : 𝓝[{a}] a = pure a :=
 by rw [nhds_within, principal_singleton, inf_eq_right.2 (pure_le_nhds a)]
 
@@ -237,13 +279,13 @@ lemma nhds_within_prod {α : Type*} [topological_space α] {β : Type*} [topolog
 by { rw nhds_within_prod_eq, exact prod_mem_prod hu hv, }
 
 lemma nhds_within_pi_eq' {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
-  {I : set ι} (hI : finite I) (s : Π i, set (α i)) (x : Π i, α i) :
+  {I : set ι} (hI : I.finite) (s : Π i, set (α i)) (x : Π i, α i) :
   𝓝[pi I s] x = ⨅ i, comap (λ x, x i) (𝓝 (x i) ⊓ ⨅ (hi : i ∈ I), 𝓟 (s i)) :=
 by simp only [nhds_within, nhds_pi, filter.pi, comap_inf, comap_infi, pi_def, comap_principal,
   ← infi_principal_finite hI, ← infi_inf_eq]
 
 lemma nhds_within_pi_eq {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
-  {I : set ι} (hI : finite I) (s : Π i, set (α i)) (x : Π i, α i) :
+  {I : set ι} (hI : I.finite) (s : Π i, set (α i)) (x : Π i, α i) :
   𝓝[pi I s] x = (⨅ i ∈ I, comap (λ x, x i) (𝓝[s i] (x i))) ⊓
     ⨅ (i ∉ I), comap (λ x, x i) (𝓝 (x i)) :=
 begin
@@ -253,7 +295,7 @@ begin
   simp only [infi_inf_eq]
 end
 
-lemma nhds_within_pi_univ_eq {ι : Type*} {α : ι → Type*} [fintype ι] [Π i, topological_space (α i)]
+lemma nhds_within_pi_univ_eq {ι : Type*} {α : ι → Type*} [finite ι] [Π i, topological_space (α i)]
   (s : Π i, set (α i)) (x : Π i, α i) :
   𝓝[pi univ s] x = ⨅ i, comap (λ x, x i) 𝓝[s i] (x i) :=
 by simpa [nhds_within] using nhds_within_pi_eq finite_univ s x
@@ -300,6 +342,20 @@ theorem tendsto_nhds_within_of_tendsto_nhds {f : α → β} {a : α}
   tendsto f (𝓝[s] a) l :=
 h.mono_left inf_le_left
 
+lemma eventually_mem_of_tendsto_nhds_within {f : β → α} {a : α}
+  {s : set α} {l : filter β} (h : tendsto f l (𝓝[s] a)) :
+  ∀ᶠ i in l, f i ∈ s :=
+begin
+  simp_rw [nhds_within_eq, tendsto_infi, mem_set_of_eq, tendsto_principal, mem_inter_iff,
+    eventually_and] at h,
+  exact (h univ ⟨mem_univ a, is_open_univ⟩).2,
+end
+
+lemma tendsto_nhds_of_tendsto_nhds_within {f : β → α} {a : α}
+  {s : set α} {l : filter β} (h : tendsto f l (𝓝[s] a)) :
+  tendsto f l (𝓝 a) :=
+h.mono_right nhds_within_le_nhds
+
 theorem principal_subtype {α : Type*} (s : set α) (t : set {x // x ∈ s}) :
   𝓟 t = comap coe (𝓟 ((coe : s → α) '' t)) :=
 by rw [comap_principal, set.preimage_image_eq _ subtype.coe_injective]
@@ -357,6 +413,11 @@ lemma tendsto_nhds_within_of_tendsto_nhds_of_eventually_within {a : α} {l : fil
   tendsto f l (𝓝[s] a) :=
 tendsto_inf.2 ⟨h1, tendsto_principal.2 h2⟩
 
+lemma tendsto_nhds_within_iff {a : α} {l : filter β} {s : set α} {f : β → α} :
+  tendsto f l (𝓝[s] a) ↔ tendsto f l (𝓝 a) ∧ ∀ᶠ n in l, f n ∈ s :=
+⟨λ h, ⟨tendsto_nhds_of_tendsto_nhds_within h, eventually_mem_of_tendsto_nhds_within h⟩,
+  λ h, tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _ h.1 h.2⟩
+
 @[simp] lemma tendsto_nhds_within_range {a : α} {l : filter β} {f : β → α} :
   tendsto f l (𝓝[range f] a) ↔ tendsto f l (𝓝 a) :=
 ⟨λ h, h.mono_right inf_le_left, λ h, tendsto_inf.2
@@ -539,6 +600,12 @@ lemma continuous_on.prod_map {f : α → γ} {g : β → δ} {s : set α} {t : s
   continuous_on (prod.map f g) (s ×ˢ t) :=
 λ ⟨x, y⟩ ⟨hx, hy⟩, continuous_within_at.prod_map (hf x hx) (hg y hy)
 
+lemma continuous_of_cover_nhds {ι : Sort*} {f : α → β} {s : ι → set α}
+  (hs : ∀ x : α, ∃ i, s i ∈ 𝓝 x) (hf : ∀ i, continuous_on f (s i)) :
+  continuous f :=
+continuous_iff_continuous_at.mpr $ λ x, let ⟨i, hi⟩ := hs x in
+  by { rw [continuous_at, ← nhds_within_eq_nhds.2 hi], exact hf _ _ (mem_of_mem_nhds hi) }
+
 lemma continuous_on_empty (f : α → β) : continuous_on f ∅ :=
 λ x, false.elim
 
@@ -552,11 +619,11 @@ hs.induction_on (continuous_on_empty f) (continuous_on_singleton f)
 
 theorem nhds_within_le_comap {x : α} {s : set α} {f : α → β} (ctsf : continuous_within_at f s x) :
   𝓝[s] x ≤ comap f (𝓝[f '' s] (f x)) :=
-map_le_iff_le_comap.1 ctsf.tendsto_nhds_within_image
+ctsf.tendsto_nhds_within_image.le_comap
 
-theorem continuous_within_at_iff_ptendsto_res (f : α → β) {x : α} {s : set α} :
-  continuous_within_at f s x ↔ ptendsto (pfun.res f s) (𝓝 x) (𝓝 (f x)) :=
-tendsto_iff_ptendsto _ _ _ _
+@[simp] lemma comap_nhds_within_range {α} (f : α → β) (y : β) :
+  comap f (𝓝[range f] y) = comap f (𝓝 y) :=
+comap_inf_principal_range
 
 lemma continuous_iff_continuous_on_univ {f : α → β} : continuous f ↔ continuous_on f univ :=
 by simp [continuous_iff_continuous_at, continuous_on, continuous_at, continuous_within_at,
@@ -702,6 +769,10 @@ lemma continuous_within_at.continuous_at {f : α → β} {s : set α} {x : α}
   (h : continuous_within_at f s x) (hs : s ∈ 𝓝 x) : continuous_at f x :=
 (continuous_within_at_iff_continuous_at hs).mp h
 
+lemma is_open.continuous_on_iff {f : α → β} {s : set α} (hs : is_open s) :
+  continuous_on f s ↔ ∀ ⦃a⦄, a ∈ s → continuous_at f a :=
+ball_congr $ λ _, continuous_within_at_iff_continuous_at ∘ hs.mem_nhds
+
 lemma continuous_on.continuous_at {f : α → β} {s : set α} {x : α}
   (h : continuous_on f s) (hx : s ∈ 𝓝 x) : continuous_at f x :=
 (h x (mem_of_mem_nhds hx)).continuous_at hx
@@ -1026,10 +1097,15 @@ lemma continuous.if {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
   continuous (λ a, if p a then f a else g a) :=
 continuous_if hp hf.continuous_on hg.continuous_on
 
+lemma continuous_if_const (p : Prop) {f g : α → β} [decidable p]
+  (hf : p → continuous f) (hg : ¬ p → continuous g) :
+  continuous (λ a, if p then f a else g a) :=
+by { split_ifs, exact hf h, exact hg h }
+
 lemma continuous.if_const (p : Prop) {f g : α → β} [decidable p]
   (hf : continuous f) (hg : continuous g) :
   continuous (λ a, if p then f a else g a) :=
-continuous_if (if h : p then by simp [h] else by simp [h]) hf.continuous_on hg.continuous_on
+continuous_if_const p (λ _, hf) (λ _, hg)
 
 lemma continuous_piecewise {s : set α} {f g : α → β} [∀ a, decidable (a ∈ s)]
   (hs : ∀ a ∈ frontier s, f a = g a) (hf : continuous_on f (closure s))
diff --git a/src/topology/covering.lean b/src/topology/covering.lean
new file mode 100644
index 0000000000000..7abc9ef9f9938
--- /dev/null
+++ b/src/topology/covering.lean
@@ -0,0 +1,167 @@
+/-
+Copyright (c) 2022 Thomas Browning. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Thomas Browning
+-/
+import topology.is_locally_homeomorph
+import topology.fiber_bundle.basic
+
+/-!
+# Covering Maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines covering maps.
+
+## Main definitions
+
+* `is_evenly_covered f x I`: A point `x` is evenly coverd by `f : E → X` with fiber `I` if `I` is
+  discrete and there is a `trivialization` of `f` at `x` with fiber `I`.
+* `is_covering_map f`: A function `f : E → X` is a covering map if every point `x` is evenly
+  covered by `f` with fiber `f ⁻¹' {x}`. The fibers `f ⁻¹' {x}` must be discrete, but if `X` is
+  not connected, then the fibers `f ⁻¹' {x}` are not necessarily isomorphic. Also, `f` is not
+  assumed to be surjective, so the fibers are even allowed to be empty.
+-/
+
+open_locale bundle
+
+variables {E X : Type*} [topological_space E] [topological_space X] (f : E → X) (s : set X)
+
+/-- A point `x : X` is evenly covered by `f : E → X` if `x` has an evenly covered neighborhood. -/
+def is_evenly_covered (x : X) (I : Type*) [topological_space I] :=
+discrete_topology I ∧ ∃ t : trivialization I f, x ∈ t.base_set
+
+namespace is_evenly_covered
+
+variables {f}
+
+/-- If `x` is evenly covered by `f`, then we can construct a trivialization of `f` at `x`. -/
+noncomputable def to_trivialization {x : X} {I : Type*} [topological_space I]
+  (h : is_evenly_covered f x I) : trivialization (f ⁻¹' {x}) f :=
+(classical.some h.2).trans_fiber_homeomorph ((classical.some h.2).preimage_singleton_homeomorph
+  (classical.some_spec h.2)).symm
+
+lemma mem_to_trivialization_base_set {x : X} {I : Type*} [topological_space I]
+  (h : is_evenly_covered f x I) : x ∈ h.to_trivialization.base_set :=
+classical.some_spec h.2
+
+lemma to_trivialization_apply {x : E} {I : Type*} [topological_space I]
+  (h : is_evenly_covered f (f x) I) : (h.to_trivialization x).2 = ⟨x, rfl⟩ :=
+let e := classical.some h.2, h := classical.some_spec h.2, he := e.mk_proj_snd' h in
+  subtype.ext ((e.to_local_equiv.eq_symm_apply (e.mem_source.mpr h)
+    (by rwa [he, e.mem_target, e.coe_fst (e.mem_source.mpr h)])).mpr he.symm).symm
+
+protected lemma continuous_at {x : E} {I : Type*} [topological_space I]
+  (h : is_evenly_covered f (f x) I) : continuous_at f x :=
+let e := h.to_trivialization in
+  e.continuous_at_proj (e.mem_source.mpr (mem_to_trivialization_base_set h))
+
+lemma to_is_evenly_covered_preimage {x : X} {I : Type*} [topological_space I]
+  (h : is_evenly_covered f x I) : is_evenly_covered f x (f ⁻¹' {x}) :=
+let ⟨h1, h2⟩ := h in by exactI ⟨((classical.some h2).preimage_singleton_homeomorph
+  (classical.some_spec h2)).embedding.discrete_topology, _, h.mem_to_trivialization_base_set⟩
+
+end is_evenly_covered
+
+/-- A covering map is a continuous function `f : E → X` with discrete fibers such that each point
+  of `X` has an evenly covered neighborhood. -/
+def is_covering_map_on :=
+∀ x ∈ s, is_evenly_covered f x (f ⁻¹' {x})
+
+namespace is_covering_map_on
+
+lemma mk (F : X → Type*) [Π x, topological_space (F x)] [hF : Π x, discrete_topology (F x)]
+  (e : Π x ∈ s, trivialization (F x) f) (h : ∀ (x : X) (hx : x ∈ s), x ∈ (e x hx).base_set) :
+  is_covering_map_on f s :=
+λ x hx, is_evenly_covered.to_is_evenly_covered_preimage ⟨hF x, e x hx, h x hx⟩
+
+variables {f} {s}
+
+protected lemma continuous_at (hf : is_covering_map_on f s) {x : E} (hx : f x ∈ s) :
+  continuous_at f x :=
+(hf (f x) hx).continuous_at
+
+protected lemma continuous_on (hf : is_covering_map_on f s) : continuous_on f (f ⁻¹' s) :=
+continuous_at.continuous_on (λ x, hf.continuous_at)
+
+protected lemma is_locally_homeomorph_on (hf : is_covering_map_on f s) :
+  is_locally_homeomorph_on f (f ⁻¹' s) :=
+begin
+  refine is_locally_homeomorph_on.mk f (f ⁻¹' s) (λ x hx, _),
+  let e := (hf (f x) hx).to_trivialization,
+  have h := (hf (f x) hx).mem_to_trivialization_base_set,
+  let he := e.mem_source.2 h,
+  refine ⟨e.to_local_homeomorph.trans
+  { to_fun := λ p, p.1,
+    inv_fun := λ p, ⟨p, x, rfl⟩,
+    source := e.base_set ×ˢ ({⟨x, rfl⟩} : set (f ⁻¹' {f x})),
+    target := e.base_set,
+    open_source := e.open_base_set.prod (singletons_open_iff_discrete.2 (hf (f x) hx).1 ⟨x, rfl⟩),
+    open_target := e.open_base_set,
+    map_source' := λ p, and.left,
+    map_target' := λ p hp, ⟨hp, rfl⟩,
+    left_inv' := λ p hp, prod.ext rfl hp.2.symm,
+    right_inv' := λ p hp, rfl,
+    continuous_to_fun := continuous_fst.continuous_on,
+    continuous_inv_fun := (continuous_id'.prod_mk continuous_const).continuous_on },
+    ⟨he, by rwa [e.to_local_homeomorph.symm_symm, e.proj_to_fun x he],
+      (hf (f x) hx).to_trivialization_apply⟩, λ p h, (e.proj_to_fun p h.1).symm⟩,
+end
+
+end is_covering_map_on
+
+/-- A covering map is a continuous function `f : E → X` with discrete fibers such that each point
+  of `X` has an evenly covered neighborhood. -/
+def is_covering_map :=
+∀ x, is_evenly_covered f x (f ⁻¹' {x})
+
+variables {f}
+
+lemma is_covering_map_iff_is_covering_map_on_univ :
+  is_covering_map f ↔ is_covering_map_on f set.univ :=
+by simp only [is_covering_map, is_covering_map_on, set.mem_univ, forall_true_left]
+
+protected lemma is_covering_map.is_covering_map_on (hf : is_covering_map f) :
+  is_covering_map_on f set.univ :=
+is_covering_map_iff_is_covering_map_on_univ.mp hf
+
+variables (f)
+
+namespace is_covering_map
+
+lemma mk (F : X → Type*) [Π x, topological_space (F x)] [hF : Π x, discrete_topology (F x)]
+  (e : Π x, trivialization (F x) f) (h : ∀ x, x ∈ (e x).base_set) : is_covering_map f :=
+is_covering_map_iff_is_covering_map_on_univ.mpr
+  (is_covering_map_on.mk f set.univ F (λ x hx, e x) (λ x hx, h x))
+
+variables {f}
+
+protected lemma continuous (hf : is_covering_map f) : continuous f :=
+continuous_iff_continuous_on_univ.mpr hf.is_covering_map_on.continuous_on
+
+protected lemma is_locally_homeomorph (hf : is_covering_map f) : is_locally_homeomorph f :=
+is_locally_homeomorph_iff_is_locally_homeomorph_on_univ.mpr
+  hf.is_covering_map_on.is_locally_homeomorph_on
+
+protected lemma is_open_map (hf : is_covering_map f) : is_open_map f :=
+hf.is_locally_homeomorph.is_open_map
+
+protected lemma quotient_map (hf : is_covering_map f) (hf' : function.surjective f) :
+  quotient_map f :=
+hf.is_open_map.to_quotient_map hf.continuous hf'
+
+end is_covering_map
+
+variables {f}
+
+protected lemma is_fiber_bundle.is_covering_map {F : Type*} [topological_space F]
+  [discrete_topology F] (hf : ∀ x : X, ∃ e : trivialization F f, x ∈ e.base_set) :
+  is_covering_map f :=
+is_covering_map.mk f (λ x, F) (λ x, classical.some (hf x)) (λ x, classical.some_spec (hf x))
+
+protected lemma fiber_bundle.is_covering_map {F : Type*} {E : X → Type*} [topological_space F]
+  [discrete_topology F] [topological_space (bundle.total_space F E)] [Π x, topological_space (E x)]
+  [hf : fiber_bundle F E] : is_covering_map (π F E) :=
+is_fiber_bundle.is_covering_map
+  (λ x, ⟨trivialization_at F E x, mem_base_set_trivialization_at F E x ⟩)
diff --git a/src/topology/dense_embedding.lean b/src/topology/dense_embedding.lean
index acd08bbc565d4..af0d11c6b63c5 100644
--- a/src/topology/dense_embedding.lean
+++ b/src/topology/dense_embedding.lean
@@ -9,14 +9,17 @@ import topology.bases
 /-!
 # Dense embeddings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines three properties of functions:
 
 * `dense_range f`      means `f` has dense image;
-* `dense_inducing i`   means `i` is also `inducing`;
-* `dense_embedding e`  means `e` is also an `embedding`.
+* `dense_inducing i`   means `i` is also `inducing`, namely it induces the topology on its codomain;
+* `dense_embedding e`  means `e` is further an `embedding`, namely it is injective and `inducing`.
 
 The main theorem `continuous_extend` gives a criterion for a function
-`f : X → Z` to a regular (T₃) space Z to extend along a dense embedding
+`f : X → Z` to a T₃ space Z to extend along a dense embedding
 `i : X → Y` to a continuous function `g : Y → Z`. Actually `i` only
 has to be `dense_inducing` (not necessarily injective).
 
@@ -25,7 +28,7 @@ has to be `dense_inducing` (not necessarily injective).
 noncomputable theory
 
 open set filter
-open_locale classical topological_space filter
+open_locale classical topology filter
 
 variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
 
@@ -179,7 +182,7 @@ lemma extend_unique [t2_space γ] {f : α → γ} {g : β → γ} (di : dense_in
   di.extend f = g :=
 funext $ λ b, extend_unique_at di (eventually_of_forall hf) hg.continuous_at
 
-lemma continuous_at_extend [regular_space γ] {b : β} {f : α → γ} (di : dense_inducing i)
+lemma continuous_at_extend [t3_space γ] {b : β} {f : α → γ} (di : dense_inducing i)
   (hf : ∀ᶠ x in 𝓝 b, ∃c, tendsto f (comap i $ 𝓝 x) (𝓝 c)) :
   continuous_at (di.extend f) b :=
 begin
@@ -206,7 +209,7 @@ begin
   tauto,
 end
 
-lemma continuous_extend [regular_space γ] {f : α → γ} (di : dense_inducing i)
+lemma continuous_extend [t3_space γ] {f : α → γ} (di : dense_inducing i)
   (hf : ∀b, ∃c, tendsto f (comap i (𝓝 b)) (𝓝 c)) : continuous (di.extend f) :=
 continuous_iff_continuous_at.mpr $ assume b, di.continuous_at_extend $ univ_mem' hf
 
@@ -282,6 +285,10 @@ de.to_dense_inducing.dense_image
 
 end dense_embedding
 
+lemma dense_embedding_id {α : Type*} [topological_space α] : dense_embedding (id : α → α) :=
+{ dense := dense_range_id,
+  .. embedding_id }
+
 lemma dense.dense_embedding_coe [topological_space α] {s : set α} (hs : dense s) :
   dense_embedding (coe : s → α) :=
 { dense := hs.dense_range_coe,
@@ -338,9 +345,9 @@ lemma dense_range.equalizer (hfd : dense_range f)
 funext $ λ y, hfd.induction_on y (is_closed_eq hg hh) $ congr_fun H
 end
 
--- Bourbaki GT III §3 no.4 Proposition 7 (generalised to any dense-inducing map to a regular space)
+-- Bourbaki GT III §3 no.4 Proposition 7 (generalised to any dense-inducing map to a T₃ space)
 lemma filter.has_basis.has_basis_of_dense_inducing
-  [topological_space α] [topological_space β] [regular_space β]
+  [topological_space α] [topological_space β] [t3_space β]
   {ι : Type*} {s : ι → set α} {p : ι → Prop} {x : α} (h : (𝓝 x).has_basis p s)
   {f : α → β} (hf : dense_inducing f) :
   (𝓝 (f x)).has_basis p $ λ i, closure $ f '' (s i) :=
@@ -348,13 +355,13 @@ begin
   rw filter.has_basis_iff at h ⊢,
   intros T,
   refine ⟨λ hT, _, λ hT, _⟩,
-  { obtain ⟨T', hT₁, hT₂, hT₃⟩ := nhds_is_closed hT,
+  { obtain ⟨T', hT₁, hT₂, hT₃⟩ := exists_mem_nhds_is_closed_subset hT,
     have hT₄ : f⁻¹' T' ∈ 𝓝 x,
     { rw hf.to_inducing.nhds_eq_comap x,
       exact ⟨T', hT₁, subset.rfl⟩, },
     obtain ⟨i, hi, hi'⟩ := (h _).mp hT₄,
     exact ⟨i, hi, (closure_mono (image_subset f hi')).trans (subset.trans (closure_minimal
-      (image_subset_iff.mpr subset.rfl) hT₃) hT₂)⟩, },
+      (image_subset_iff.mpr subset.rfl) hT₂) hT₃)⟩, },
   { obtain ⟨i, hi, hi'⟩ := hT,
     suffices : closure (f '' s i) ∈ 𝓝 (f x), { filter_upwards [this] using hi', },
     replace h := (h (s i)).mpr ⟨i, hi, subset.rfl⟩,
diff --git a/src/topology/discrete_quotient.lean b/src/topology/discrete_quotient.lean
index f7b952645ee47..e1b31901b9b35 100644
--- a/src/topology/discrete_quotient.lean
+++ b/src/topology/discrete_quotient.lean
@@ -11,6 +11,9 @@ import topology.locally_constant.basic
 
 # Discrete quotients of a topological space.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the type of discrete quotients of a topological space,
 denoted `discrete_quotient X`. To avoid quantifying over types, we model such
 quotients as setoids whose equivalence classes are clopen.
@@ -26,22 +29,31 @@ quotients as setoids whose equivalence classes are clopen.
   endowed with a `fintype` instance.
 
 ## Order structure
+
 The type `discrete_quotient X` is endowed with an instance of a `semilattice_inf` with `order_top`.
 The partial ordering `A ≤ B` mathematically means that `B.proj` factors through `A.proj`.
 The top element `⊤` is the trivial quotient, meaning that every element of `X` is collapsed
 to a point. Given `h : A ≤ B`, the map `A → B` is `discrete_quotient.of_le h`.
-Whenever `X` is discrete, the type `discrete_quotient X` is also endowed with an instance of a
-`semilattice_inf` with `order_bot`, where the bot element `⊥` is `X` itself.
 
-Given `f : X → Y` and `h : continuous f`, we define a predicate `le_comap h A B` for
-`A : discrete_quotient X` and `B : discrete_quotient Y`, asserting that `f` descends to `A → B`.
-If `cond : le_comap h A B`, the function `A → B` is obtained by `discrete_quotient.map cond`.
+Whenever `X` is a locally connected space, the type `discrete_quotient X` is also endowed with an
+instance of a `order_bot`, where the bot element `⊥` is given by the `connectedComponentSetoid`,
+i.e., `x ~ y` means that `x` and `y` belong to the same connected component. In particular, if `X`
+is a discrete topological space, then `x ~ y` is equivalent (propositionally, not definitionally) to
+`x = y`.
+
+Given `f : C(X, Y)`, we define a predicate `discrete_quotient.le_comap f A B` for `A :
+discrete_quotient X` and `B : discrete_quotient Y`, asserting that `f` descends to `A → B`.  If
+`cond : discrete_quotient.le_comap h A B`, the function `A → B` is obtained by
+`discrete_quotient.map f cond`.
 
 ## Theorems
+
 The two main results proved in this file are:
-1. `discrete_quotient.eq_of_proj_eq` which states that when `X` is compact, t2 and totally
-  disconnected, any two elements of `X` agree if their projections in `Q` agree for all
+
+1. `discrete_quotient.eq_of_forall_proj_eq` which states that when `X` is compact, T₂, and totally
+  disconnected, any two elements of `X` are equal if their projections in `Q` agree for all
   `Q : discrete_quotient X`.
+
 2. `discrete_quotient.exists_of_compat` which states that when `X` is compact, then any
   system of elements of `Q` as `Q : discrete_quotient X` varies, which is compatible with
   respect to `discrete_quotient.of_le`, must arise from some element of `X`.
@@ -51,328 +63,269 @@ The constructions in this file will be used to show that any profinite space is
 of finite discrete spaces.
 -/
 
-variables (X : Type*) [topological_space X]
+open set function
+variables {α X Y Z : Type*} [topological_space X] [topological_space Y]
+  [topological_space Z]
 
 /-- The type of discrete quotients of a topological space. -/
 @[ext]
-structure discrete_quotient :=
-(rel : X → X → Prop)
-(equiv : equivalence rel)
-(clopen : ∀ x, is_clopen (set_of (rel x)))
+structure discrete_quotient (X : Type*) [topological_space X]  extends setoid X :=
+(is_open_set_of_rel : ∀ x, is_open (set_of (to_setoid.rel x)))
 
 namespace discrete_quotient
 
-variables {X} (S : discrete_quotient X)
+variables (S : discrete_quotient X)
 
 /-- Construct a discrete quotient from a clopen set. -/
 def of_clopen {A : set X} (h : is_clopen A) : discrete_quotient X :=
-{ rel := λ x y, x ∈ A ∧ y ∈ A ∨ x ∉ A ∧ y ∉ A,
-  equiv := ⟨by tauto!, by tauto!, by tauto!⟩,
-  clopen := begin
-    intros x,
-    by_cases hx : x ∈ A,
-    { apply is_clopen.union,
-      { convert h,
-        ext,
-        exact ⟨λ i, i.2, λ i, ⟨hx,i⟩⟩ },
-      { convert is_clopen_empty,
-        tidy } },
-    { apply is_clopen.union,
-      { convert is_clopen_empty,
-        tidy },
-      { convert is_clopen.compl h,
-        ext,
-        exact ⟨λ i, i.2, λ i, ⟨hx, i⟩⟩ } },
-  end }
-
-lemma refl : ∀ x : X, S.rel x x := S.equiv.1
-lemma symm : ∀ x y : X, S.rel x y → S.rel y x := S.equiv.2.1
-lemma trans : ∀ x y z : X, S.rel x y → S.rel y z → S.rel x z := S.equiv.2.2
+{ to_setoid := ⟨λ x y, x ∈ A ↔ y ∈ A, λ _, iff.rfl, λ _ _, iff.symm, λ _ _ _, iff.trans⟩,
+  is_open_set_of_rel := λ x,
+    by by_cases hx : x ∈ A; simp [setoid.rel, hx, h.1, h.2, ← compl_set_of] }
+
+lemma refl : ∀ x, S.rel x x := S.refl'
+lemma symm {x y : X} : S.rel x y → S.rel y x := S.symm'
+lemma trans {x y z} : S.rel x y → S.rel y z → S.rel x z := S.trans'
 
 /-- The setoid whose quotient yields the discrete quotient. -/
-def setoid : setoid X := ⟨S.rel, S.equiv⟩
+add_decl_doc to_setoid
 
 instance : has_coe_to_sort (discrete_quotient X) Type* :=
-⟨λ S, quotient S.setoid⟩
+⟨λ S, quotient S.to_setoid⟩
 
-instance : topological_space S := ⊥
+instance : topological_space S := quotient.topological_space
 
 /-- The projection from `X` to the given discrete quotient. -/
 def proj : X → S := quotient.mk'
 
+lemma fiber_eq (x : X) : S.proj ⁻¹' {S.proj x} = set_of (S.rel x) :=
+set.ext $ λ y, eq_comm.trans quotient.eq'
+
 lemma proj_surjective : function.surjective S.proj := quotient.surjective_quotient_mk'
+lemma proj_quotient_map : quotient_map S.proj := quotient_map_quot_mk
+lemma proj_continuous : continuous S.proj := S.proj_quotient_map.continuous
 
-lemma fiber_eq (x : X) : S.proj ⁻¹' {S.proj x} = set_of (S.rel x) :=
-begin
-  ext1 y,
-  simp only [set.mem_preimage, set.mem_singleton_iff, quotient.eq',
-    discrete_quotient.proj.equations._eqn_1, set.mem_set_of_eq],
-  exact ⟨λ h, S.symm _ _ h, λ h, S.symm _ _ h⟩,
-end
+instance : discrete_topology S :=
+singletons_open_iff_discrete.1 $ S.proj_surjective.forall.2 $ λ x,
+  by { rw [← S.proj_quotient_map.is_open_preimage, fiber_eq], exact S.is_open_set_of_rel _ }
 
 lemma proj_is_locally_constant : is_locally_constant S.proj :=
-begin
-   rw (is_locally_constant.tfae S.proj).out 0 3,
-   intros x,
-   rcases S.proj_surjective x with ⟨x,rfl⟩,
-   simp [fiber_eq, (S.clopen x).1],
-end
+(is_locally_constant.iff_continuous S.proj).2 S.proj_continuous
 
-lemma proj_continuous : continuous S.proj :=
-is_locally_constant.continuous $ proj_is_locally_constant _
+lemma is_clopen_preimage (A : set S) : is_clopen (S.proj ⁻¹' A) :=
+(is_clopen_discrete A).preimage S.proj_continuous
 
-lemma fiber_closed (A : set S) : is_closed (S.proj ⁻¹' A) :=
-is_closed.preimage S.proj_continuous ⟨trivial⟩
+lemma is_open_preimage (A : set S) : is_open (S.proj ⁻¹' A) := (S.is_clopen_preimage A).1
+lemma is_closed_preimage (A : set S) : is_closed (S.proj ⁻¹' A) := (S.is_clopen_preimage A).2
 
-lemma fiber_open (A : set S) : is_open (S.proj ⁻¹' A) :=
-is_open.preimage S.proj_continuous trivial
+theorem is_clopen_set_of_rel (x : X) : is_clopen (set_of (S.rel x)) :=
+by { rw [← fiber_eq], apply is_clopen_preimage }
 
-lemma fiber_clopen (A : set S) : is_clopen (S.proj ⁻¹' A) := ⟨fiber_open _ _, fiber_closed _ _⟩
+instance : has_inf (discrete_quotient X) :=
+⟨λ S₁ S₂, ⟨S₁.1 ⊓ S₂.1, λ x, (S₁.2 x).inter (S₂.2 x)⟩⟩
 
-instance : partial_order (discrete_quotient X) :=
-{ le := λ A B, ∀ x y : X, A.rel x y → B.rel x y,
-  le_refl := λ a, by tauto,
-  le_trans := λ a b c h1 h2, by tauto,
-  le_antisymm := λ a b h1 h2, by { ext, tauto } }
+instance : semilattice_inf (discrete_quotient X) :=
+injective.semilattice_inf to_setoid ext (λ _ _, rfl)
 
 instance : order_top (discrete_quotient X) :=
-{ top := ⟨λ a b, true, ⟨by tauto, by tauto, by tauto⟩, λ _, is_clopen_univ⟩,
+{ top := ⟨⊤, λ _, is_open_univ⟩,
   le_top := λ a, by tauto }
 
-instance : semilattice_inf (discrete_quotient X) :=
-{ inf := λ A B,
-  { rel := λ x y, A.rel x y ∧ B.rel x y,
-    equiv := ⟨λ a, ⟨A.refl _,B.refl _⟩, λ a b h, ⟨A.symm _ _ h.1, B.symm _ _ h.2⟩,
-      λ a b c h1 h2, ⟨A.trans _ _ _ h1.1 h2.1, B.trans _ _ _ h1.2 h2.2⟩⟩,
-    clopen := λ x, is_clopen.inter (A.clopen _) (B.clopen _) },
-  inf_le_left := λ a b, by tauto,
-  inf_le_right := λ a b, by tauto,
-  le_inf := λ a b c h1 h2, by tauto,
-  ..discrete_quotient.partial_order }
-
 instance : inhabited (discrete_quotient X) := ⟨⊤⟩
 
+instance inhabited_quotient [inhabited X] : inhabited S := ⟨S.proj default⟩
+instance [nonempty X] : nonempty S := nonempty.map S.proj ‹_›
+
 section comap
 
-variables {Y : Type*} [topological_space Y] {f : Y → X} (cont : continuous f)
+variables (g : C(Y, Z)) (f : C(X, Y))
 
 /-- Comap a discrete quotient along a continuous map. -/
-def comap : discrete_quotient Y :=
-{ rel := λ a b, S.rel (f a) (f b),
-  equiv := ⟨λ a, S.refl _, λ a b h, S.symm _ _ h, λ a b c h1 h2, S.trans _ _ _ h1 h2⟩,
-  clopen := λ y, ⟨is_open.preimage cont (S.clopen _).1, is_closed.preimage cont (S.clopen _).2⟩ }
+def comap (S : discrete_quotient Y) : discrete_quotient X :=
+{ to_setoid := setoid.comap f S.1,
+  is_open_set_of_rel := λ y, (S.2 _).preimage f.continuous }
 
 @[simp]
-lemma comap_id : S.comap (continuous_id : continuous (id : X → X)) = S := by { ext, refl }
+lemma comap_id : S.comap (continuous_map.id X) = S := by { ext, refl }
 
 @[simp]
-lemma comap_comp {Z : Type*} [topological_space Z] {g : Z → Y} (cont' : continuous g) :
-  S.comap (continuous.comp cont cont') = (S.comap cont).comap cont' := by { ext, refl }
+lemma comap_comp (S : discrete_quotient Z) : S.comap (g.comp f) = (S.comap g).comap f := rfl
 
-lemma comap_mono {A B : discrete_quotient X} (h : A ≤ B) : A.comap cont ≤ B.comap cont :=
+@[mono]
+lemma comap_mono {A B : discrete_quotient Y} (h : A ≤ B) : A.comap f ≤ B.comap f :=
 by tauto
 
 end comap
 
 section of_le
 
+variables {A B C : discrete_quotient X}
+
 /-- The map induced by a refinement of a discrete quotient. -/
-def of_le {A B : discrete_quotient X} (h : A ≤ B) : A → B :=
-λ a, quotient.lift_on' a (λ x, B.proj x) (λ a b i, quotient.sound' (h _ _ i))
+def of_le (h : A ≤ B) : A → B := quotient.map' (λ x, x) h
 
-@[simp]
-lemma of_le_refl {A : discrete_quotient X} : of_le (le_refl A) = id := by { ext ⟨⟩, refl }
+@[simp] lemma of_le_refl : of_le (le_refl A) = id := by { ext ⟨⟩, refl }
 
-lemma of_le_refl_apply {A : discrete_quotient X} (a : A) : of_le (le_refl A) a = a := by simp
+lemma of_le_refl_apply (a : A) : of_le (le_refl A) a = a := by simp
 
-@[simp]
-lemma of_le_comp {A B C : discrete_quotient X} (h1 : A ≤ B) (h2 : B ≤ C) :
-  of_le (le_trans h1 h2) = of_le h2 ∘ of_le h1 := by { ext ⟨⟩, refl }
+@[simp] lemma of_le_of_le (h₁ : A ≤ B) (h₂ : B ≤ C) (x : A) :
+  of_le h₂ (of_le h₁ x) = of_le (h₁.trans h₂) x := by { rcases x with ⟨⟩, refl }
 
-lemma of_le_comp_apply {A B C : discrete_quotient X} (h1 : A ≤ B) (h2 : B ≤ C) (a : A) :
-  of_le (le_trans h1 h2) a = of_le h2 (of_le h1 a) := by simp
+@[simp] lemma of_le_comp_of_le (h₁ : A ≤ B) (h₂ : B ≤ C) :
+  of_le h₂ ∘ of_le h₁ = of_le (le_trans h₁ h₂) :=
+funext $ of_le_of_le _ _
 
-lemma of_le_continuous {A B : discrete_quotient X} (h : A ≤ B) :
-  continuous (of_le h) := continuous_of_discrete_topology
+lemma of_le_continuous (h : A ≤ B) : continuous (of_le h) :=
+continuous_of_discrete_topology
 
-@[simp]
-lemma of_le_proj {A B : discrete_quotient X} (h : A ≤ B) :
-  of_le h ∘ A.proj = B.proj := by { ext, exact quotient.sound' (B.refl _) }
+@[simp] lemma of_le_proj (h : A ≤ B) (x : X) : of_le h (A.proj x) = B.proj x :=
+quotient.sound' (B.refl _)
 
-@[simp]
-lemma of_le_proj_apply {A B : discrete_quotient X} (h : A ≤ B) (x : X) :
-  of_le h (A.proj x) = B.proj x := by { change (of_le h ∘ A.proj) x = _, simp }
+@[simp] lemma of_le_comp_proj (h : A ≤ B) : of_le h ∘ A.proj = B.proj :=
+funext $ of_le_proj _
 
 end of_le
 
-/--
-When X is discrete, there is a `order_bot` instance on `discrete_quotient X`
+/-- When `X` is a locally connected space, there is an `order_bot` instance on
+`discrete_quotient X`. The bottom element is given by `connected_component_setoid X`
 -/
-instance [discrete_topology X] : order_bot (discrete_quotient X) :=
+instance [locally_connected_space X] : order_bot (discrete_quotient X) :=
 { bot :=
-  { rel := (=),
-    equiv := eq_equivalence,
-    clopen := λ x, is_clopen_discrete _ },
-  bot_le := by { rintro S a b (h : a = b), rw h, exact S.refl _ } }
-
-lemma proj_bot_injective [discrete_topology X] :
-  function.injective (⊥ : discrete_quotient X).proj := λ a b h, quotient.exact' h
-
-lemma proj_bot_bijective [discrete_topology X] :
-  function.bijective (⊥ : discrete_quotient X).proj := ⟨proj_bot_injective, proj_surjective _⟩
+  { to_setoid := connected_component_setoid X,
+    is_open_set_of_rel := λ x,
+      begin
+        have : connected_component x = {y | (connected_component_setoid X).rel x y},
+        { ext y,
+          simpa only [connected_component_setoid, ← connected_component_eq_iff_mem] using eq_comm },
+        rw [← this],
+        exact is_open_connected_component
+      end },
+  bot_le := λ S x y (h : connected_component x = connected_component y),
+    (S.is_clopen_set_of_rel x).connected_component_subset (S.refl _) $
+      h.symm ▸ mem_connected_component }
+
+@[simp] theorem proj_bot_eq [locally_connected_space X] {x y : X} :
+  proj ⊥ x = proj ⊥ y ↔ connected_component x = connected_component y :=
+quotient.eq'
+
+theorem proj_bot_inj [discrete_topology X] {x y : X} :
+  proj ⊥ x = proj ⊥ y ↔ x = y := by simp
+
+theorem proj_bot_injective [discrete_topology X] :
+  injective (⊥ : discrete_quotient X).proj := λ _ _, proj_bot_inj.1
+
+theorem proj_bot_bijective [discrete_topology X] :
+  bijective (⊥ : discrete_quotient X).proj :=
+⟨proj_bot_injective, proj_surjective _⟩
 
 section map
 
-variables {Y : Type*} [topological_space Y] {f : Y → X}
-  (cont : continuous f) (A : discrete_quotient Y) (B : discrete_quotient X)
+variables (f : C(X, Y)) (A A' : discrete_quotient X) (B B' : discrete_quotient Y)
 
-/--
-Given `cont : continuous f`, `le_comap cont A B` is defined as `A ≤ B.comap f`.
-Mathematically this means that `f` descends to a morphism `A → B`.
--/
-def le_comap : Prop := A ≤ B.comap cont
+/-- Given `f : C(X, Y)`, `le_comap cont A B` is defined as `A ≤ B.comap f`. Mathematically this
+means that `f` descends to a morphism `A → B`. -/
+def le_comap : Prop := A ≤ B.comap f
+
+theorem le_comap_id : le_comap (continuous_map.id X) A A := λ _ _, id
 
-variables {cont A B}
+variables {A A' B B'} {f} {g : C(Y, Z)} {C : discrete_quotient Z}
 
-lemma le_comap_id (A : discrete_quotient X) : le_comap continuous_id A A := by tauto
+@[simp] theorem le_comap_id_iff : le_comap (continuous_map.id X) A A' ↔ A ≤ A' := iff.rfl
 
-lemma le_comap_comp {Z : Type*} [topological_space Z] {g : Z → Y} {cont' : continuous g}
-  {C : discrete_quotient Z} : le_comap cont' C A → le_comap cont A B →
-  le_comap (continuous.comp cont cont') C B := by tauto
+theorem le_comap.comp :
+  le_comap g B C → le_comap f A B → le_comap (g.comp f) A C := by tauto
 
-lemma le_comap_trans {C : discrete_quotient X} :
-  le_comap cont A B → B ≤ C → le_comap cont A C := λ h1 h2, le_trans h1 $ comap_mono _ h2
+theorem le_comap.mono (h : le_comap f A B) (hA : A' ≤ A) (hB : B ≤ B') : le_comap f A' B' :=
+  hA.trans $ le_trans h $ comap_mono _ hB
 
 /-- Map a discrete quotient along a continuous map. -/
-def map (cond : le_comap cont A B) : A → B := quotient.map' f cond
+def map (f : C(X, Y)) (cond : le_comap f A B) : A → B := quotient.map' f cond
 
-lemma map_continuous (cond : le_comap cont A B) : continuous (map cond) :=
-continuous_of_discrete_topology
+theorem map_continuous (cond : le_comap f A B) : continuous (map f cond) :=
+  continuous_of_discrete_topology
 
-@[simp]
-lemma map_proj (cond : le_comap cont A B) : map cond ∘ A.proj = B.proj ∘ f := rfl
+@[simp] theorem map_comp_proj (cond : le_comap f A B) : map f cond ∘ A.proj = B.proj ∘ f := rfl
 
 @[simp]
-lemma map_proj_apply (cond : le_comap cont A B) (y : Y) : map cond (A.proj y) = B.proj (f y) := rfl
+theorem map_proj (cond : le_comap f A B) (x : X) : map f cond (A.proj x) = B.proj (f x) := rfl
 
-@[simp]
-lemma map_id : map (le_comap_id A) = id := by { ext ⟨⟩, refl }
+@[simp] theorem map_id : map _ (le_comap_id A) = id := by ext ⟨⟩; refl
 
-@[simp]
-lemma map_comp {Z : Type*} [topological_space Z] {g : Z → Y} {cont' : continuous g}
-  {C : discrete_quotient Z} (h1 : le_comap cont' C A) (h2 : le_comap cont A B) :
-  map (le_comap_comp h1 h2) = map h2 ∘ map h1 := by { ext ⟨⟩, refl }
+@[simp] theorem map_comp (h1 : le_comap g B C) (h2 : le_comap f A B) :
+  map (g.comp f) (h1.comp h2) = map g h1 ∘ map f h2 :=
+by { ext ⟨⟩, refl }
 
-@[simp]
-lemma of_le_map {C : discrete_quotient X} (cond : le_comap cont A B) (h : B ≤ C) :
-   map (le_comap_trans cond h) = of_le h ∘ map cond := by { ext ⟨⟩, refl }
+@[simp] theorem of_le_map (cond : le_comap f A B) (h : B ≤ B') (a : A) :
+  of_le h (map f cond a) = map f (cond.mono le_rfl h) a :=
+by { rcases a with ⟨⟩, refl }
 
-@[simp]
-lemma of_le_map_apply {C : discrete_quotient X} (cond : le_comap cont A B) (h : B ≤ C) (a : A) :
-  map (le_comap_trans cond h) a = of_le h (map cond a) := by { rcases a, refl }
+@[simp] theorem of_le_comp_map (cond : le_comap f A B) (h : B ≤ B') :
+  of_le h ∘ map f cond = map f (cond.mono le_rfl h) :=
+funext $ of_le_map cond h
 
-@[simp]
-lemma map_of_le {C : discrete_quotient Y} (cond : le_comap cont A B) (h : C ≤ A) :
-   map (le_trans h cond) = map cond ∘ of_le h := by { ext ⟨⟩, refl }
+@[simp] theorem map_of_le (cond : le_comap f A B) (h : A' ≤ A) (c : A') :
+  map f cond (of_le h c) = map f (cond.mono h le_rfl) c :=
+by { rcases c with ⟨⟩, refl }
 
-@[simp]
-lemma map_of_le_apply {C : discrete_quotient Y} (cond : le_comap cont A B) (h : C ≤ A) (c : C) :
-  map (le_trans h cond) c = map cond (of_le h c) := by { rcases c, refl }
+@[simp] theorem map_comp_of_le (cond : le_comap f A B) (h : A' ≤ A) :
+  map f cond ∘ of_le h =  map f (cond.mono h le_rfl) :=
+funext $ map_of_le cond h
 
 end map
 
-lemma eq_of_proj_eq [t2_space X] [compact_space X] [disc : totally_disconnected_space X]
-  {x y : X} : (∀ Q : discrete_quotient X, Q.proj x = Q.proj y) → x = y :=
+lemma eq_of_forall_proj_eq [t2_space X] [compact_space X] [disc : totally_disconnected_space X]
+  {x y : X} (h : ∀ Q : discrete_quotient X, Q.proj x = Q.proj y) : x = y :=
 begin
-  intro h,
-  change x ∈ ({y} : set X),
-  rw totally_disconnected_space_iff_connected_component_singleton at disc,
-  rw [← disc y, connected_component_eq_Inter_clopen],
-  rintros U ⟨⟨U, hU1, hU2⟩, rfl⟩,
-  replace h : _ ∨ _ := quotient.exact' (h (of_clopen hU1)),
-  tauto,
+  rw [← mem_singleton_iff, ← connected_component_eq_singleton, connected_component_eq_Inter_clopen,
+    mem_Inter],
+  rintro ⟨U, hU1, hU2⟩,
+  exact (quotient.exact' (h (of_clopen hU1))).mpr hU2
 end
 
-lemma fiber_le_of_le {A B : discrete_quotient X} (h : A ≤ B) (a : A) :
-  A.proj ⁻¹' {a} ≤ B.proj ⁻¹' {of_le h a} :=
+lemma fiber_subset_of_le {A B : discrete_quotient X} (h : A ≤ B) (a : A) :
+  A.proj ⁻¹' {a} ⊆ B.proj ⁻¹' {of_le h a} :=
 begin
-  induction a,
-  erw [fiber_eq, fiber_eq],
-  tidy,
+  rcases A.proj_surjective a with ⟨a, rfl⟩,
+  rw [fiber_eq, of_le_proj, fiber_eq],
+  exact λ _ h', h h'
 end
 
 lemma exists_of_compat [compact_space X] (Qs : Π (Q : discrete_quotient X), Q)
   (compat : ∀ (A B : discrete_quotient X) (h : A ≤ B), of_le h (Qs _) = Qs _) :
   ∃ x : X, ∀ Q : discrete_quotient X, Q.proj x = Qs _ :=
 begin
-  obtain ⟨x,hx⟩ := is_compact.nonempty_Inter_of_directed_nonempty_compact_closed
-    (λ (Q : discrete_quotient X), Q.proj ⁻¹' {Qs _}) (λ A B, _) (λ i, _)
-    (λ i,  (fiber_closed _ _).is_compact) (λ i, fiber_closed _ _),
+  obtain ⟨x,hx⟩ : (⋂ Q, proj Q ⁻¹' {Qs Q}).nonempty :=
+    is_compact.nonempty_Inter_of_directed_nonempty_compact_closed
+      (λ (Q : discrete_quotient X), Q.proj ⁻¹' {Qs _}) (directed_of_inf $ λ A B h, _)
+      (λ Q, (singleton_nonempty _).preimage Q.proj_surjective)
+      (λ i,  (is_closed_preimage _ _).is_compact) (λ i, is_closed_preimage _ _),
   { refine ⟨x, λ Q, _⟩,
-    specialize hx _ ⟨Q,rfl⟩,
-    dsimp at hx,
-    rcases proj_surjective _ (Qs Q) with ⟨y,hy⟩,
-    rw ← hy at *,
-    rw fiber_eq at hx,
-    exact quotient.sound' (Q.symm y x hx) },
-  { refine ⟨A ⊓ B, λ a ha, _, λ a ha, _⟩,
-    { dsimp only,
-      erw ← compat (A ⊓ B) A inf_le_left,
-      exact fiber_le_of_le _ _ ha },
-    { dsimp only,
-      erw ← compat (A ⊓ B) B inf_le_right,
-      exact fiber_le_of_le _ _ ha } },
-  { obtain ⟨x,hx⟩ := i.proj_surjective (Qs i),
-    refine ⟨x,_⟩,
-    dsimp only,
-    rw [← hx, fiber_eq],
-    apply i.refl },
+    exact hx _ ⟨Q,rfl⟩ },
+  { rw [← compat _ _ h],
+    exact fiber_subset_of_le _ _ },
 end
 
-noncomputable instance [compact_space X] : fintype S :=
+instance [compact_space X] : finite S :=
 begin
-  have cond : is_compact (⊤ : set X) := compact_univ,
-  rw is_compact_iff_finite_subcover at cond,
-  have h := @cond S (λ s, S.proj ⁻¹' {s}) (λ s, fiber_open _ _)
-    (λ x hx, ⟨S.proj ⁻¹' {S.proj x}, ⟨S.proj x, rfl⟩, rfl⟩),
-  let T := classical.some h,
-  have hT := classical.some_spec h,
-  refine ⟨T,λ s, _⟩,
-  rcases S.proj_surjective s with ⟨x,rfl⟩,
-  rcases hT (by tauto : x ∈ ⊤) with ⟨j, ⟨j,rfl⟩, h1, ⟨hj, rfl⟩, h2⟩,
-  dsimp only at h2,
-  suffices : S.proj x = j, by rwa this,
-  rcases j with ⟨j⟩,
-  apply quotient.sound',
-  erw fiber_eq at h2,
-  exact S.symm _ _ h2
+  have : compact_space S := quotient.compact_space,
+  rwa [← is_compact_univ_iff, is_compact_iff_finite, finite_univ_iff] at this
 end
 
 end discrete_quotient
 
 namespace locally_constant
 
-variables {X} {α : Type*} (f : locally_constant X α)
+variables {X} (f : locally_constant X α)
 
 /-- Any locally constant function induces a discrete quotient. -/
 def discrete_quotient : discrete_quotient X :=
-{ rel := λ a b, f b = f a,
-  equiv := ⟨by tauto, by tauto, λ a b c h1 h2, by rw [h2, h1]⟩,
-  clopen := λ x, f.is_locally_constant.is_clopen_fiber _ }
+{ to_setoid := setoid.comap f ⊥,
+  is_open_set_of_rel := λ x, f.is_locally_constant _ }
 
-/-- The function from the discrete quotient associated to a locally constant function. -/
-def lift : f.discrete_quotient → α := λ a, quotient.lift_on' a f (λ a b h, h.symm)
+/-- The (locally constant) function from the discrete quotient associated to a locally constant
+function. -/
+def lift : locally_constant f.discrete_quotient α :=
+⟨λ a, quotient.lift_on' a f (λ a b, id), λ A, is_open_discrete _⟩
 
-lemma lift_is_locally_constant : _root_.is_locally_constant f.lift := λ A, trivial
-
-/-- A locally constant version of `locally_constant.lift`. -/
-def locally_constant_lift : locally_constant f.discrete_quotient α :=
-⟨f.lift, f.lift_is_locally_constant⟩
-
-@[simp]
-lemma lift_eq_coe : f.lift = f.locally_constant_lift := rfl
-
-@[simp]
-lemma factors : f.locally_constant_lift ∘ f.discrete_quotient.proj = f := by { ext, refl }
+@[simp] lemma lift_comp_proj : f.lift ∘ f.discrete_quotient.proj = f := by { ext, refl }
 
 end locally_constant
diff --git a/src/topology/extend_from.lean b/src/topology/extend_from.lean
index dec8438065b17..5fa21fb42a4d0 100644
--- a/src/topology/extend_from.lean
+++ b/src/topology/extend_from.lean
@@ -8,6 +8,9 @@ import topology.separation
 /-!
 # Extending a function from a subset
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The main definition of this file is `extend_from A f` where `f : X → Y`
 and `A : set X`. This defines a new function `g : X → Y` which maps any
 `x₀ : X` to the limit of `f` as `x` tends to `x₀`, if such a limit exists.
@@ -18,13 +21,13 @@ This is analoguous to the way `dense_inducing.extend` "extends" a function
 The main theorem we prove about this definition is `continuous_on_extend_from`
 which states that, for `extend_from A f` to be continuous on a set `B ⊆ closure A`,
 it suffices that `f` converges within `A` at any point of `B`, provided that
-`f` is a function to a regular space.
+`f` is a function to a T₃ space.
 
 -/
 
 noncomputable theory
 
-open_locale topological_space
+open_locale topology
 open filter set
 
 variables {X Y : Type*} [topological_space X] [topological_space Y]
@@ -52,7 +55,7 @@ lemma extend_from_extends [t2_space Y] {f : X → Y} {A : set X} (hf : continuou
   ∀ x ∈ A, extend_from A f x = f x :=
 λ x x_in, extend_from_eq (subset_closure x_in) (hf x x_in)
 
-/-- If `f` is a function to a regular space `Y` which has a limit within `A` at any
+/-- If `f` is a function to a T₃ space `Y` which has a limit within `A` at any
 point of a set `B ⊆ closure A`, then `extend_from A f` is continuous on `B`. -/
 lemma continuous_on_extend_from [regular_space Y] {f : X → Y} {A B : set X} (hB : B ⊆ closure A)
   (hf : ∀ x ∈ B, ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : continuous_on (extend_from A f) B :=
@@ -77,7 +80,7 @@ begin
   exact V'_closed.mem_of_tendsto limy (mem_of_superset this hV)
 end
 
-/-- If a function `f` to a regular space `Y` has a limit within a
+/-- If a function `f` to a T₃ space `Y` has a limit within a
 dense set `A` for any `x`, then `extend_from A f` is continuous. -/
 lemma continuous_extend_from [regular_space Y] {f : X → Y} {A : set X} (hA : dense A)
   (hf : ∀ x, ∃ y, tendsto f (𝓝[A] x) (𝓝 y)) : continuous (extend_from A f) :=
diff --git a/src/topology/extremally_disconnected.lean b/src/topology/extremally_disconnected.lean
new file mode 100644
index 0000000000000..c5796de9c98d7
--- /dev/null
+++ b/src/topology/extremally_disconnected.lean
@@ -0,0 +1,117 @@
+/-
+Copyright (c) 2021 Johan Commelin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johan Commelin
+-/
+import topology.stone_cech
+
+/-!
+# Extremally disconnected spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+An extremally disconnected topological space is a space in which the closure of every open set is
+open. Such spaces are also called Stonean spaces. They are the projective objects in the category of
+compact Hausdorff spaces.
+
+## Main declarations
+
+* `extremally_disconnected`: Predicate for a space to be extremally disconnected.
+* `compact_t2.projective`: ¨Predicate for a topological space to be a projective object in the
+  category of compact Hausdorff spaces.
+* `compact_t2.projective.extremally_disconnected`: Compact Hausdorff spaces that are
+  projective are extremally disconnected.
+
+# TODO
+
+Prove the converse to `compact_t2.projective.extremally_disconnected`, namely that a compact,
+Hausdorff, extremally disconnected space is a projective object in the category of compact Hausdorff
+spaces.
+
+## References
+
+[Gleason, *Projective topological spaces*][gleason1958]
+-/
+
+noncomputable theory
+
+open set
+open_locale classical
+
+universes u v w
+variables (X : Type u) [topological_space X]
+
+open function
+
+/-- An extremally disconnected topological space is a space
+in which the closure of every open set is open. -/
+class extremally_disconnected : Prop :=
+(open_closure : ∀ U : set X, is_open U → is_open (closure U))
+
+section
+
+include X
+
+/--  The assertion `compact_t2.projective` states that given continuous maps
+`f : X → Z` and `g : Y → Z` with `g` surjective between `t_2`, compact topological spaces,
+there exists a continuous lift `h : X → Y`, such that `f = g ∘ h`. -/
+def compact_t2.projective : Prop :=
+Π {Y Z : Type u} [topological_space Y] [topological_space Z],
+  by exactI Π [compact_space Y] [t2_space Y] [compact_space Z] [t2_space Z],
+  Π {f : X → Z} {g : Y → Z} (hf : continuous f) (hg : continuous g) (g_sur : surjective g),
+  ∃ h : X → Y, continuous h ∧ g ∘ h = f
+
+end
+
+variable {X}
+
+lemma stone_cech.projective [discrete_topology X] : compact_t2.projective (stone_cech X) :=
+begin
+  introsI Y Z _tsY _tsZ _csY _t2Y _csZ _csZ f g hf hg g_sur,
+  let s : Z → Y := λ z, classical.some $ g_sur z,
+  have hs : g ∘ s = id := funext (λ z, classical.some_spec (g_sur z)),
+  let t := s ∘ f ∘ stone_cech_unit,
+  have ht : continuous t := continuous_of_discrete_topology,
+  let h : stone_cech X → Y := stone_cech_extend ht,
+  have hh : continuous h := continuous_stone_cech_extend ht,
+  refine ⟨h, hh, dense_range_stone_cech_unit.equalizer (hg.comp hh) hf _⟩,
+  rw [comp.assoc, stone_cech_extend_extends ht, ← comp.assoc, hs, comp.left_id],
+end
+
+protected lemma compact_t2.projective.extremally_disconnected [compact_space X] [t2_space X]
+  (h : compact_t2.projective X) :
+  extremally_disconnected X :=
+begin
+  refine { open_closure := λ U hU, _ },
+  let Z₁ : set (X × bool) := Uᶜ ×ˢ {tt},
+  let Z₂ : set (X × bool) := closure U ×ˢ {ff},
+  let Z : set (X × bool) := Z₁ ∪ Z₂,
+  have hZ₁₂ : disjoint Z₁ Z₂ := disjoint_left.2 (λ x hx₁ hx₂, by cases hx₁.2.symm.trans hx₂.2),
+  have hZ₁ : is_closed Z₁ := hU.is_closed_compl.prod  (t1_space.t1 _),
+  have hZ₂ : is_closed Z₂ := is_closed_closure.prod (t1_space.t1 ff),
+  have hZ : is_closed Z := hZ₁.union  hZ₂,
+  let f : Z → X := prod.fst ∘ subtype.val,
+  have f_cont : continuous f := continuous_fst.comp continuous_subtype_val,
+  have f_sur : surjective f,
+  { intro x,
+    by_cases hx : x ∈ U,
+    { exact ⟨⟨(x, ff), or.inr ⟨subset_closure hx, set.mem_singleton _⟩⟩, rfl⟩  },
+    { exact ⟨⟨(x, tt), or.inl ⟨hx, set.mem_singleton _⟩⟩, rfl⟩ } },
+  haveI : compact_space Z := is_compact_iff_compact_space.mp hZ.is_compact,
+  obtain ⟨g, hg, g_sec⟩ := h continuous_id f_cont f_sur,
+  let φ := coe ∘ g,
+  have hφ : continuous φ := continuous_subtype_val.comp hg,
+  have hφ₁ : ∀ x, (φ x).1 = x := congr_fun g_sec,
+  suffices : closure U = φ ⁻¹' Z₂,
+  { rw [this, set.preimage_comp, ←is_closed_compl_iff, ←preimage_compl,
+      ←preimage_subtype_coe_eq_compl subset.rfl],
+    { exact hZ₁.preimage hφ },
+    { rw [hZ₁₂.inter_eq, inter_empty] } },
+  refine (closure_minimal _ $ hZ₂.preimage hφ).antisymm (λ x hx, _),
+  { rintro x hx,
+    have : φ x ∈ (Z₁ ∪ Z₂) := (g x).2,
+    simpa [hx, hφ₁] using this },
+  { rw ←hφ₁ x,
+    exact hx.1 }
+end
diff --git a/src/topology/fiber_bundle.lean b/src/topology/fiber_bundle.lean
deleted file mode 100644
index 5ebc7684700b6..0000000000000
--- a/src/topology/fiber_bundle.lean
+++ /dev/null
@@ -1,1194 +0,0 @@
-/-
-Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Sébastien Gouëzel
--/
-import data.bundle
-import topology.algebra.order.basic
-import topology.local_homeomorph
-
-/-!
-# Fiber bundles
-
-A topological fiber bundle with fiber `F` over a base `B` is a space projecting on `B` for which the
-fibers are all homeomorphic to `F`, such that the local situation around each point is a direct
-product. We define a predicate `is_topological_fiber_bundle F p` saying that `p : Z → B` is a
-topological fiber bundle with fiber `F`.
-
-It is in general nontrivial to construct a fiber bundle. A way is to start from the knowledge of
-how changes of local trivializations act on the fiber. From this, one can construct the total space
-of the bundle and its topology by a suitable gluing construction. The main content of this file is
-an implementation of this construction: starting from an object of type
-`topological_fiber_bundle_core` registering the trivialization changes, one gets the corresponding
-fiber bundle and projection.
-
-Similarly we implement the object `topological_fiber_prebundle` which allows to define a topological
-fiber bundle from trivializations given as local equivalences with minimum additional properties.
-
-## Main definitions
-
-### Basic definitions
-
-* `trivialization F p` : structure extending local homeomorphisms, defining a local
-                  trivialization of a topological space `Z` with projection `p` and fiber `F`.
-
-* `is_topological_fiber_bundle F p` : Prop saying that the map `p` between topological spaces is a
-                  fiber bundle with fiber `F`.
-
-* `is_trivial_topological_fiber_bundle F p` : Prop saying that the map `p : Z → B` between
-  topological spaces is a trivial topological fiber bundle, i.e., there exists a homeomorphism
-  `h : Z ≃ₜ B × F` such that `proj x = (h x).1`.
-
-### Operations on bundles
-
-We provide the following operations on `trivialization`s.
-
-* `trivialization.comap`: given a local trivialization `e` of a fiber bundle `p : Z → B`, a
-  continuous map `f : B' → B` and a point `b' : B'` such that `f b' ∈ e.base_set`,
-  `e.comap f hf b' hb'` is a trivialization of the pullback bundle. The pullback bundle
-  (a.k.a., the induced bundle) has total space `{(x, y) : B' × Z | f x = p y}`, and is given by
-  `λ ⟨(x, y), h⟩, x`.
-
-* `is_topological_fiber_bundle.comap`: if `p : Z → B` is a topological fiber bundle, then its
-  pullback along a continuous map `f : B' → B` is a topological fiber bundle as well.
-
-* `trivialization.comp_homeomorph`: given a local trivialization `e` of a fiber bundle
-  `p : Z → B` and a homeomorphism `h : Z' ≃ₜ Z`, returns a local trivialization of the fiber bundle
-  `p ∘ h`.
-
-* `is_topological_fiber_bundle.comp_homeomorph`: if `p : Z → B` is a topological fiber bundle
-  and `h : Z' ≃ₜ Z` is a homeomorphism, then `p ∘ h : Z' → B` is a topological fiber bundle with
-  the same fiber.
-
-### Construction of a bundle from trivializations
-
-* `bundle.total_space E` is a type synonym for `Σ (x : B), E x`, that we can endow with a suitable
-  topology.
-* `topological_fiber_bundle_core ι B F` : structure registering how changes of coordinates act
-  on the fiber `F` above open subsets of `B`, where local trivializations are indexed by `ι`.
-
-Let `Z : topological_fiber_bundle_core ι B F`. Then we define
-
-* `Z.fiber x`     : the fiber above `x`, homeomorphic to `F` (and defeq to `F` as a type).
-* `Z.total_space` : the total space of `Z`, defined as a `Type` as `Σ (b : B), F`, but with a
-  twisted topology coming from the fiber bundle structure. It is (reducibly) the same as
-  `bundle.total_space Z.fiber`.
-* `Z.proj`        : projection from `Z.total_space` to `B`. It is continuous.
-* `Z.local_triv i`: for `i : ι`, bundle trivialization above the set `Z.base_set i`, which is an
-                    open set in `B`.
-
-* `pretrivialization F proj` : trivialization as a local equivalence, mainly used when the
-                                      topology on the total space has not yet been defined.
-* `topological_fiber_prebundle F proj` : structure registering a cover of prebundle trivializations
-  and requiring that the relative transition maps are local homeomorphisms.
-* `topological_fiber_prebundle.total_space_topology a` : natural topology of the total space, making
-  the prebundle into a bundle.
-
-## Implementation notes
-
-A topological fiber bundle with fiber `F` over a base `B` is a family of spaces isomorphic to `F`,
-indexed by `B`, which is locally trivial in the following sense: there is a covering of `B` by open
-sets such that, on each such open set `s`, the bundle is isomorphic to `s × F`.
-
-To construct a fiber bundle formally, the main data is what happens when one changes trivializations
-from `s × F` to `s' × F` on `s ∩ s'`: one should get a family of homeomorphisms of `F`, depending
-continuously on the base point, satisfying basic compatibility conditions (cocycle property).
-Useful classes of bundles can then be specified by requiring that these homeomorphisms of `F`
-belong to some subgroup, preserving some structure (the "structure group of the bundle"): then
-these structures are inherited by the fibers of the bundle.
-
-Given such trivialization change data (encoded below in a structure called
-`topological_fiber_bundle_core`), one can construct the fiber bundle. The intrinsic canonical
-mathematical construction is the following.
-The fiber above `x` is the disjoint union of `F` over all trivializations, modulo the gluing
-identifications: one gets a fiber which is isomorphic to `F`, but non-canonically
-(each choice of one of the trivializations around `x` gives such an isomorphism). Given a
-trivialization over a set `s`, one gets an isomorphism between `s × F` and `proj^{-1} s`, by using
-the identification corresponding to this trivialization. One chooses the topology on the bundle that
-makes all of these into homeomorphisms.
-
-For the practical implementation, it turns out to be more convenient to avoid completely the
-gluing and quotienting construction above, and to declare above each `x` that the fiber is `F`,
-but thinking that it corresponds to the `F` coming from the choice of one trivialization around `x`.
-This has several practical advantages:
-* without any work, one gets a topological space structure on the fiber. And if `F` has more
-structure it is inherited for free by the fiber.
-* In the case of the tangent bundle of manifolds, this implies that on vector spaces the derivative
-(from `F` to `F`) and the manifold derivative (from `tangent_space I x` to `tangent_space I' (f x)`)
-are equal.
-
-A drawback is that some silly constructions will typecheck: in the case of the tangent bundle, one
-can add two vectors in different tangent spaces (as they both are elements of `F` from the point of
-view of Lean). To solve this, one could mark the tangent space as irreducible, but then one would
-lose the identification of the tangent space to `F` with `F`. There is however a big advantage of
-this situation: even if Lean can not check that two basepoints are defeq, it will accept the fact
-that the tangent spaces are the same. For instance, if two maps `f` and `g` are locally inverse to
-each other, one can express that the composition of their derivatives is the identity of
-`tangent_space I x`. One could fear issues as this composition goes from `tangent_space I x` to
-`tangent_space I (g (f x))` (which should be the same, but should not be obvious to Lean
-as it does not know that `g (f x) = x`). As these types are the same to Lean (equal to `F`), there
-are in fact no dependent type difficulties here!
-
-For this construction of a fiber bundle from a `topological_fiber_bundle_core`, we should thus
-choose for each `x` one specific trivialization around it. We include this choice in the definition
-of the `topological_fiber_bundle_core`, as it makes some constructions more
-functorial and it is a nice way to say that the trivializations cover the whole space `B`.
-
-With this definition, the type of the fiber bundle space constructed from the core data is just
-`Σ (b : B), F `, but the topology is not the product one, in general.
-
-We also take the indexing type (indexing all the trivializations) as a parameter to the fiber bundle
-core: it could always be taken as a subtype of all the maps from open subsets of `B` to continuous
-maps of `F`, but in practice it will sometimes be something else. For instance, on a manifold, one
-will use the set of charts as a good parameterization for the trivializations of the tangent bundle.
-Or for the pullback of a `topological_fiber_bundle_core`, the indexing type will be the same as
-for the initial bundle.
-
-## Tags
-Fiber bundle, topological bundle, local trivialization, structure group
--/
-
-variables {ι : Type*} {B : Type*} {F : Type*}
-
-open topological_space filter set
-open_locale topological_space classical
-
-/-! ### General definition of topological fiber bundles -/
-
-section topological_fiber_bundle
-
-variables (F) {Z : Type*} [topological_space B] [topological_space F] {proj : Z → B}
-
-/-- This structure contains the information left for a local trivialization (which is implemented
-below as `trivialization F proj`) if the total space has not been given a topology, but we
-have a topology on both the fiber and the base space. Through the construction
-`topological_fiber_prebundle F proj` it will be possible to promote a
-`pretrivialization F proj` to a `trivialization F proj`. -/
-@[nolint has_inhabited_instance]
-structure topological_fiber_bundle.pretrivialization (proj : Z → B) extends local_equiv Z (B × F) :=
-(open_target   : is_open target)
-(base_set      : set B)
-(open_base_set : is_open base_set)
-(source_eq     : source = proj ⁻¹' base_set)
-(target_eq     : target = base_set ×ˢ (univ : set F))
-(proj_to_fun   : ∀ p ∈ source, (to_fun p).1 = proj p)
-
-open topological_fiber_bundle
-
-namespace topological_fiber_bundle.pretrivialization
-
-instance : has_coe_to_fun (pretrivialization F proj) (λ _, Z → (B × F)) := ⟨λ e, e.to_fun⟩
-
-variables {F} (e : pretrivialization F proj) {x : Z}
-
-@[simp, mfld_simps] lemma coe_coe : ⇑e.to_local_equiv = e := rfl
-@[simp, mfld_simps] lemma coe_fst (ex : x ∈ e.source) : (e x).1 = proj x := e.proj_to_fun x ex
-lemma mem_source : x ∈ e.source ↔ proj x ∈ e.base_set := by rw [e.source_eq, mem_preimage]
-lemma coe_fst' (ex : proj x ∈ e.base_set) : (e x).1 = proj x := e.coe_fst (e.mem_source.2 ex)
-protected lemma eq_on : eq_on (prod.fst ∘ e) proj e.source := λ x hx, e.coe_fst hx
-lemma mk_proj_snd (ex : x ∈ e.source) : (proj x, (e x).2) = e x := prod.ext (e.coe_fst ex).symm rfl
-lemma mk_proj_snd' (ex : proj x ∈ e.base_set) : (proj x, (e x).2) = e x :=
-prod.ext (e.coe_fst' ex).symm rfl
-
-/-- Composition of inverse and coercion from the subtype of the target. -/
-def set_symm : e.target → Z := e.target.restrict e.to_local_equiv.symm
-
-lemma mem_target {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.base_set :=
-by rw [e.target_eq, prod_univ, mem_preimage]
-
-lemma proj_symm_apply {x : B × F} (hx : x ∈ e.target) : proj (e.to_local_equiv.symm x) = x.1 :=
-begin
-  have := (e.coe_fst (e.to_local_equiv.map_target hx)).symm,
-  rwa [← e.coe_coe, e.to_local_equiv.right_inv hx] at this
-end
-
-lemma proj_symm_apply' {b : B} {x : F} (hx : b ∈ e.base_set) :
-  proj (e.to_local_equiv.symm (b, x)) = b :=
-e.proj_symm_apply (e.mem_target.2 hx)
-
-lemma proj_surj_on_base_set [nonempty F] : set.surj_on proj e.source e.base_set :=
-λ b hb, let ⟨y⟩ := ‹nonempty F› in ⟨e.to_local_equiv.symm (b, y),
-  e.to_local_equiv.map_target $ e.mem_target.2 hb, e.proj_symm_apply' hb⟩
-
-lemma apply_symm_apply {x : B × F} (hx : x ∈ e.target) : e (e.to_local_equiv.symm x) = x :=
-e.to_local_equiv.right_inv hx
-
-lemma apply_symm_apply' {b : B} {x : F} (hx : b ∈ e.base_set) :
-  e (e.to_local_equiv.symm (b, x)) = (b, x) :=
-e.apply_symm_apply (e.mem_target.2 hx)
-
-@[simp, mfld_simps] lemma symm_apply_mk_proj {x : Z} (ex : x ∈ e.source) :
-  e.to_local_equiv.symm (proj x, (e x).2) = x :=
-by rw [← e.coe_fst ex, prod.mk.eta, ← e.coe_coe, e.to_local_equiv.left_inv ex]
-
-@[simp, mfld_simps] lemma preimage_symm_proj_base_set :
-  (e.to_local_equiv.symm ⁻¹' (proj ⁻¹' e.base_set)) ∩ e.target  = e.target :=
-begin
-  refine inter_eq_right_iff_subset.mpr (λ x hx, _),
-  simp only [mem_preimage, local_equiv.inv_fun_as_coe, e.proj_symm_apply hx],
-  exact e.mem_target.mp hx,
-end
-
-@[simp, mfld_simps] lemma preimage_symm_proj_inter (s : set B) :
-  (e.to_local_equiv.symm ⁻¹' (proj ⁻¹' s)) ∩ e.base_set ×ˢ (univ : set F) =
-    (s ∩ e.base_set) ×ˢ (univ : set F) :=
-begin
-  ext ⟨x, y⟩,
-  suffices : x ∈ e.base_set → (proj (e.to_local_equiv.symm (x, y)) ∈ s ↔ x ∈ s),
-    by simpa only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ, and.congr_left_iff],
-  intro h,
-  rw [e.proj_symm_apply' h]
-end
-
-lemma symm_trans_symm (e e' : pretrivialization F proj) :
-  (e.to_local_equiv.symm.trans e'.to_local_equiv).symm =
-  e'.to_local_equiv.symm.trans e.to_local_equiv :=
-by rw [local_equiv.trans_symm_eq_symm_trans_symm,local_equiv.symm_symm]
-
-lemma symm_trans_source_eq (e e' : pretrivialization F proj) :
-  (e.to_local_equiv.symm.trans e'.to_local_equiv).source =
-  (e.base_set ∩ e'.base_set) ×ˢ (univ : set F) :=
-by rw [local_equiv.trans_source, e'.source_eq, local_equiv.symm_source, e.target_eq, inter_comm,
-  e.preimage_symm_proj_inter, inter_comm]
-
-lemma symm_trans_target_eq (e e' : pretrivialization F proj) :
-  (e.to_local_equiv.symm.trans e'.to_local_equiv).target =
-  (e.base_set ∩ e'.base_set) ×ˢ (univ : set F) :=
-by rw [← local_equiv.symm_source, symm_trans_symm, symm_trans_source_eq, inter_comm]
-
-end topological_fiber_bundle.pretrivialization
-
-variable [topological_space Z]
-
-/--
-A structure extending local homeomorphisms, defining a local trivialization of a projection
-`proj : Z → B` with fiber `F`, as a local homeomorphism between `Z` and `B × F` defined between two
-sets of the form `proj ⁻¹' base_set` and `base_set × F`, acting trivially on the first coordinate.
--/
-@[nolint has_inhabited_instance]
-structure topological_fiber_bundle.trivialization (proj : Z → B)
-  extends local_homeomorph Z (B × F) :=
-(base_set      : set B)
-(open_base_set : is_open base_set)
-(source_eq     : source = proj ⁻¹' base_set)
-(target_eq     : target = base_set ×ˢ (univ : set F))
-(proj_to_fun   : ∀ p ∈ source, (to_local_homeomorph p).1 = proj p)
-
-open topological_fiber_bundle
-
-namespace topological_fiber_bundle.trivialization
-
-variables {F} (e : trivialization F proj) {x : Z}
-
-/-- Natural identification as a `pretrivialization`. -/
-def to_pretrivialization : topological_fiber_bundle.pretrivialization F proj := { ..e }
-
-instance : has_coe_to_fun (trivialization F proj) (λ _, Z → B × F) := ⟨λ e, e.to_fun⟩
-instance : has_coe (trivialization F proj) (pretrivialization F proj) :=
-⟨to_pretrivialization⟩
-
-@[simp, mfld_simps] lemma coe_coe : ⇑e.to_local_homeomorph = e := rfl
-@[simp, mfld_simps] lemma coe_fst (ex : x ∈ e.source) : (e x).1 = proj x := e.proj_to_fun x ex
-protected lemma eq_on : eq_on (prod.fst ∘ e) proj e.source := λ x hx, e.coe_fst hx
-lemma mem_source : x ∈ e.source ↔ proj x ∈ e.base_set := by rw [e.source_eq, mem_preimage]
-lemma coe_fst' (ex : proj x ∈ e.base_set) : (e x).1 = proj x := e.coe_fst (e.mem_source.2 ex)
-lemma mk_proj_snd (ex : x ∈ e.source) : (proj x, (e x).2) = e x := prod.ext (e.coe_fst ex).symm rfl
-lemma mk_proj_snd' (ex : proj x ∈ e.base_set) : (proj x, (e x).2) = e x :=
-prod.ext (e.coe_fst' ex).symm rfl
-
-lemma source_inter_preimage_target_inter (s : set (B × F)) :
-  e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
-e.to_local_homeomorph.source_inter_preimage_target_inter s
-
-@[simp, mfld_simps] lemma coe_mk (e : local_homeomorph Z (B × F)) (i j k l m) (x : Z) :
-  (trivialization.mk e i j k l m : trivialization F proj) x = e x := rfl
-
-lemma mem_target {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.base_set :=
-e.to_pretrivialization.mem_target
-
-lemma map_target {x : B × F} (hx : x ∈ e.target) : e.to_local_homeomorph.symm x ∈ e.source :=
-e.to_local_homeomorph.map_target hx
-
-lemma proj_symm_apply {x : B × F} (hx : x ∈ e.target) : proj (e.to_local_homeomorph.symm x) = x.1 :=
-e.to_pretrivialization.proj_symm_apply hx
-
-lemma proj_symm_apply' {b : B} {x : F}
-  (hx : b ∈ e.base_set) : proj (e.to_local_homeomorph.symm (b, x)) = b :=
-e.to_pretrivialization.proj_symm_apply' hx
-
-lemma proj_surj_on_base_set [nonempty F] : set.surj_on proj e.source e.base_set :=
-e.to_pretrivialization.proj_surj_on_base_set
-
-lemma apply_symm_apply {x : B × F} (hx : x ∈ e.target) : e (e.to_local_homeomorph.symm x) = x :=
-e.to_local_homeomorph.right_inv hx
-
-lemma apply_symm_apply'
-  {b : B} {x : F} (hx : b ∈ e.base_set) : e (e.to_local_homeomorph.symm (b, x)) = (b, x) :=
-e.to_pretrivialization.apply_symm_apply' hx
-
-@[simp, mfld_simps] lemma symm_apply_mk_proj (ex : x ∈ e.source) :
-  e.to_local_homeomorph.symm (proj x, (e x).2) = x :=
-e.to_pretrivialization.symm_apply_mk_proj ex
-
-lemma symm_trans_source_eq (e e' : trivialization F proj) :
-  (e.to_local_equiv.symm.trans e'.to_local_equiv).source
-  = (e.base_set ∩ e'.base_set) ×ˢ (univ : set F) :=
-pretrivialization.symm_trans_source_eq e.to_pretrivialization e'
-
-lemma symm_trans_target_eq (e e' : trivialization F proj) :
-  (e.to_local_equiv.symm.trans e'.to_local_equiv).target
-  = (e.base_set ∩ e'.base_set) ×ˢ (univ : set F) :=
-pretrivialization.symm_trans_target_eq e.to_pretrivialization e'
-
-lemma coe_fst_eventually_eq_proj (ex : x ∈ e.source) : prod.fst ∘ e =ᶠ[𝓝 x] proj  :=
-mem_nhds_iff.2 ⟨e.source, λ y hy, e.coe_fst hy, e.open_source, ex⟩
-
-lemma coe_fst_eventually_eq_proj' (ex : proj x ∈ e.base_set) : prod.fst ∘ e =ᶠ[𝓝 x] proj :=
-e.coe_fst_eventually_eq_proj (e.mem_source.2 ex)
-
-lemma map_proj_nhds (ex : x ∈ e.source) : map proj (𝓝 x) = 𝓝 (proj x) :=
-by rw [← e.coe_fst ex, ← map_congr (e.coe_fst_eventually_eq_proj ex), ← map_map, ← e.coe_coe,
-  e.to_local_homeomorph.map_nhds_eq ex, map_fst_nhds]
-
-/-- In the domain of a bundle trivialization, the projection is continuous-/
-lemma continuous_at_proj (ex : x ∈ e.source) : continuous_at proj x :=
-(e.map_proj_nhds ex).le
-
-/-- Composition of a `trivialization` and a `homeomorph`. -/
-def comp_homeomorph {Z' : Type*} [topological_space Z'] (h : Z' ≃ₜ Z) :
-  trivialization F (proj ∘ h) :=
-{ to_local_homeomorph := h.to_local_homeomorph.trans e.to_local_homeomorph,
-  base_set := e.base_set,
-  open_base_set := e.open_base_set,
-  source_eq := by simp [e.source_eq, preimage_preimage],
-  target_eq := by simp [e.target_eq],
-  proj_to_fun := λ p hp,
-    have hp : h p ∈ e.source, by simpa using hp,
-    by simp [hp] }
-
-end topological_fiber_bundle.trivialization
-
-/-- A topological fiber bundle with fiber `F` over a base `B` is a space projecting on `B`
-for which the fibers are all homeomorphic to `F`, such that the local situation around each point
-is a direct product. -/
-def is_topological_fiber_bundle (proj : Z → B) : Prop :=
-∀ x : B, ∃e : trivialization F proj, x ∈ e.base_set
-
-/-- A trivial topological fiber bundle with fiber `F` over a base `B` is a space `Z`
-projecting on `B` for which there exists a homeomorphism to `B × F` that sends `proj`
-to `prod.fst`. -/
-def is_trivial_topological_fiber_bundle (proj : Z → B) : Prop :=
-∃ e : Z ≃ₜ (B × F), ∀ x, (e x).1 = proj x
-
-variables {F}
-
-lemma is_trivial_topological_fiber_bundle.is_topological_fiber_bundle
-  (h : is_trivial_topological_fiber_bundle F proj) :
-  is_topological_fiber_bundle F proj :=
-let ⟨e, he⟩ := h in λ x,
-⟨⟨e.to_local_homeomorph, univ, is_open_univ, rfl, univ_prod_univ.symm, λ x _, he x⟩, mem_univ x⟩
-
-lemma is_topological_fiber_bundle.map_proj_nhds (h : is_topological_fiber_bundle F proj) (x : Z) :
-  map proj (𝓝 x) = 𝓝 (proj x) :=
-let ⟨e, ex⟩ := h (proj x) in e.map_proj_nhds $ e.mem_source.2 ex
-
-/-- The projection from a topological fiber bundle to its base is continuous. -/
-lemma is_topological_fiber_bundle.continuous_proj (h : is_topological_fiber_bundle F proj) :
-  continuous proj :=
-continuous_iff_continuous_at.2 $ λ x, (h.map_proj_nhds _).le
-
-/-- The projection from a topological fiber bundle to its base is an open map. -/
-lemma is_topological_fiber_bundle.is_open_map_proj (h : is_topological_fiber_bundle F proj) :
-  is_open_map proj :=
-is_open_map.of_nhds_le $ λ x, (h.map_proj_nhds x).ge
-
-/-- The projection from a topological fiber bundle with a nonempty fiber to its base is a surjective
-map. -/
-lemma is_topological_fiber_bundle.surjective_proj [nonempty F]
-  (h : is_topological_fiber_bundle F proj) :
-  function.surjective proj :=
-λ b, let ⟨e, eb⟩ := h b, ⟨x, _, hx⟩ := e.proj_surj_on_base_set eb in ⟨x, hx⟩
-
-/-- The projection from a topological fiber bundle with a nonempty fiber to its base is a quotient
-map. -/
-lemma is_topological_fiber_bundle.quotient_map_proj [nonempty F]
-  (h : is_topological_fiber_bundle F proj) :
-  quotient_map proj :=
-h.is_open_map_proj.to_quotient_map h.continuous_proj h.surjective_proj
-
-/-- The first projection in a product is a trivial topological fiber bundle. -/
-lemma is_trivial_topological_fiber_bundle_fst :
-  is_trivial_topological_fiber_bundle F (prod.fst : B × F → B) :=
-⟨homeomorph.refl _, λ x, rfl⟩
-
-/-- The first projection in a product is a topological fiber bundle. -/
-lemma is_topological_fiber_bundle_fst : is_topological_fiber_bundle F (prod.fst : B × F → B) :=
-is_trivial_topological_fiber_bundle_fst.is_topological_fiber_bundle
-
-/-- The second projection in a product is a trivial topological fiber bundle. -/
-lemma is_trivial_topological_fiber_bundle_snd :
-  is_trivial_topological_fiber_bundle F (prod.snd : F × B → B) :=
-⟨homeomorph.prod_comm _ _, λ x, rfl⟩
-
-/-- The second projection in a product is a topological fiber bundle. -/
-lemma is_topological_fiber_bundle_snd : is_topological_fiber_bundle F (prod.snd : F × B → B) :=
-is_trivial_topological_fiber_bundle_snd.is_topological_fiber_bundle
-
-lemma is_topological_fiber_bundle.comp_homeomorph {Z' : Type*} [topological_space Z']
-  (e : is_topological_fiber_bundle F proj) (h : Z' ≃ₜ Z) :
-  is_topological_fiber_bundle F (proj ∘ h) :=
-λ x, let ⟨e, he⟩ := e x in
-⟨e.comp_homeomorph h, by simpa [topological_fiber_bundle.trivialization.comp_homeomorph] using he⟩
-
-namespace topological_fiber_bundle.trivialization
-
-/-- If `e` is a `trivialization` of `proj : Z → B` with fiber `F` and `h` is a homeomorphism
-`F ≃ₜ F'`, then `e.trans_fiber_homeomorph h` is the trivialization of `proj` with the fiber `F'`
-that sends `p : Z` to `((e p).1, h (e p).2)`. -/
-def trans_fiber_homeomorph {F' : Type*} [topological_space F']
-  (e : trivialization F proj) (h : F ≃ₜ F') : trivialization F' proj :=
-{ to_local_homeomorph := e.to_local_homeomorph.trans
-    ((homeomorph.refl _).prod_congr h).to_local_homeomorph,
-  base_set := e.base_set,
-  open_base_set := e.open_base_set,
-  source_eq := by simp [e.source_eq],
-  target_eq := by { ext, simp [e.target_eq] },
-  proj_to_fun := λ p hp, have p ∈ e.source, by simpa using hp, by simp [this] }
-
-@[simp] lemma trans_fiber_homeomorph_apply {F' : Type*} [topological_space F']
-  (e : trivialization F proj) (h : F ≃ₜ F') (x : Z) :
-  e.trans_fiber_homeomorph h x = ((e x).1, h (e x).2) :=
-rfl
-
-/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations. See also
-`trivialization.coord_change_homeomorph` for a version bundled as `F ≃ₜ F`. -/
-def coord_change (e₁ e₂ : trivialization F proj) (b : B) (x : F) : F :=
-(e₂ $ e₁.to_local_homeomorph.symm (b, x)).2
-
-lemma mk_coord_change
-  (e₁ e₂ : trivialization F proj) {b : B}
-  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) (x : F) :
-  (b, e₁.coord_change e₂ b x) = e₂ (e₁.to_local_homeomorph.symm (b, x)) :=
-begin
-  refine prod.ext _ rfl,
-  rw [e₂.coe_fst', ← e₁.coe_fst', e₁.apply_symm_apply' h₁],
-  { rwa [e₁.proj_symm_apply' h₁] },
-  { rwa [e₁.proj_symm_apply' h₁] }
-end
-
-lemma coord_change_apply_snd
-  (e₁ e₂ : trivialization F proj) {p : Z}
-  (h : proj p ∈ e₁.base_set) :
-  e₁.coord_change e₂ (proj p) (e₁ p).snd = (e₂ p).snd :=
-by rw [coord_change, e₁.symm_apply_mk_proj (e₁.mem_source.2 h)]
-
-lemma coord_change_same_apply
-  (e : trivialization F proj) {b : B} (h : b ∈ e.base_set) (x : F) :
-  e.coord_change e b x = x :=
-by rw [coord_change, e.apply_symm_apply' h]
-
-lemma coord_change_same
-  (e : trivialization F proj) {b : B} (h : b ∈ e.base_set) :
-  e.coord_change e b = id :=
-funext $ e.coord_change_same_apply h
-
-lemma coord_change_coord_change
-  (e₁ e₂ e₃ : trivialization F proj) {b : B}
-  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) (x : F) :
-  e₂.coord_change e₃ b (e₁.coord_change e₂ b x) = e₁.coord_change e₃ b x :=
-begin
-  rw [coord_change, e₁.mk_coord_change _ h₁ h₂, ← e₂.coe_coe,
-    e₂.to_local_homeomorph.left_inv, coord_change],
-  rwa [e₂.mem_source, e₁.proj_symm_apply' h₁]
-end
-
-lemma continuous_coord_change (e₁ e₂ : trivialization F proj) {b : B}
-  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
-  continuous (e₁.coord_change e₂ b) :=
-begin
-  refine continuous_snd.comp (e₂.to_local_homeomorph.continuous_on.comp_continuous
-    (e₁.to_local_homeomorph.continuous_on_symm.comp_continuous _ _) _),
-  { exact continuous_const.prod_mk continuous_id },
-  { exact λ x, e₁.mem_target.2 h₁ },
-  { intro x,
-    rwa [e₂.mem_source, e₁.proj_symm_apply' h₁] }
-end
-
-/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations,
-as a homeomorphism. -/
-def coord_change_homeomorph
-  (e₁ e₂ : trivialization F proj) {b : B} (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
-  F ≃ₜ F :=
-{ to_fun := e₁.coord_change e₂ b,
-  inv_fun := e₂.coord_change e₁ b,
-  left_inv := λ x, by simp only [*, coord_change_coord_change, coord_change_same_apply],
-  right_inv := λ x, by simp only [*, coord_change_coord_change, coord_change_same_apply],
-  continuous_to_fun := e₁.continuous_coord_change e₂ h₁ h₂,
-  continuous_inv_fun := e₂.continuous_coord_change e₁ h₂ h₁ }
-
-@[simp] lemma coord_change_homeomorph_coe
-  (e₁ e₂ : trivialization F proj) {b : B} (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
-  ⇑(e₁.coord_change_homeomorph e₂ h₁ h₂) = e₁.coord_change e₂ b :=
-rfl
-
-end topological_fiber_bundle.trivialization
-
-section comap
-
-open_locale classical
-
-variables {B' : Type*} [topological_space B']
-
-/-- Given a bundle trivialization of `proj : Z → B` and a continuous map `f : B' → B`,
-construct a bundle trivialization of `φ : {p : B' × Z | f p.1 = proj p.2} → B'`
-given by `φ x = (x : B' × Z).1`. -/
-noncomputable def topological_fiber_bundle.trivialization.comap
-  (e : trivialization F proj) (f : B' → B) (hf : continuous f)
-  (b' : B') (hb' : f b' ∈ e.base_set) :
-  trivialization F (λ x : {p : B' × Z | f p.1 = proj p.2}, (x : B' × Z).1) :=
-{ to_fun := λ p, ((p : B' × Z).1, (e (p : B' × Z).2).2),
-  inv_fun := λ p, if h : f p.1 ∈ e.base_set
-    then ⟨⟨p.1, e.to_local_homeomorph.symm (f p.1, p.2)⟩, by simp [e.proj_symm_apply' h]⟩
-    else ⟨⟨b', e.to_local_homeomorph.symm (f b', p.2)⟩, by simp [e.proj_symm_apply' hb']⟩,
-  source := {p | f (p : B' × Z).1 ∈ e.base_set},
-  target := {p | f p.1 ∈ e.base_set},
-  map_source' := λ p hp, hp,
-  map_target' := λ p (hp : f p.1 ∈ e.base_set), by simp [hp],
-  left_inv' :=
-    begin
-      rintro ⟨⟨b, x⟩, hbx⟩ hb,
-      dsimp at *,
-      have hx : x ∈ e.source, from e.mem_source.2 (hbx ▸ hb),
-      ext; simp *
-    end,
-  right_inv' := λ p (hp : f p.1 ∈ e.base_set), by simp [*, e.apply_symm_apply'],
-  open_source := e.open_base_set.preimage (hf.comp $ continuous_fst.comp continuous_subtype_coe),
-  open_target := e.open_base_set.preimage (hf.comp continuous_fst),
-  continuous_to_fun := ((continuous_fst.comp continuous_subtype_coe).continuous_on).prod $
-    continuous_snd.comp_continuous_on $ e.continuous_to_fun.comp
-      (continuous_snd.comp continuous_subtype_coe).continuous_on $
-      by { rintro ⟨⟨b, x⟩, (hbx : f b = proj x)⟩ (hb : f b ∈ e.base_set),
-           rw hbx at hb,
-           exact e.mem_source.2 hb },
-  continuous_inv_fun :=
-    begin
-      rw [embedding_subtype_coe.continuous_on_iff],
-      suffices : continuous_on (λ p : B' × F, (p.1, e.to_local_homeomorph.symm (f p.1, p.2)))
-        {p : B' × F | f p.1 ∈ e.base_set},
-      { refine this.congr (λ p (hp : f p.1 ∈ e.base_set), _),
-        simp [hp] },
-      { refine continuous_on_fst.prod (e.to_local_homeomorph.symm.continuous_on.comp _ _),
-        { exact ((hf.comp continuous_fst).prod_mk continuous_snd).continuous_on },
-        { exact λ p hp, e.mem_target.2 hp } }
-    end,
-  base_set := f ⁻¹' e.base_set,
-  source_eq := rfl,
-  target_eq := by { ext, simp },
-  open_base_set := e.open_base_set.preimage hf,
-  proj_to_fun := λ _ _, rfl }
-
-/-- If `proj : Z → B` is a topological fiber bundle with fiber `F` and `f : B' → B` is a continuous
-map, then the pullback bundle (a.k.a. induced bundle) is the topological bundle with the total space
-`{(x, y) : B' × Z | f x = proj y}` given by `λ ⟨(x, y), h⟩, x`. -/
-lemma is_topological_fiber_bundle.comap (h : is_topological_fiber_bundle F proj)
-  {f : B' → B} (hf : continuous f) :
-  is_topological_fiber_bundle F (λ x : {p : B' × Z | f p.1 = proj p.2}, (x : B' × Z).1) :=
-λ x, let ⟨e, he⟩ := h (f x) in ⟨e.comap f hf x he, he⟩
-
-end comap
-
-namespace topological_fiber_bundle.trivialization
-
-lemma is_image_preimage_prod (e : trivialization F proj) (s : set B) :
-  e.to_local_homeomorph.is_image (proj ⁻¹' s) (s ×ˢ (univ : set F)) :=
-λ x hx, by simp [e.coe_fst', hx]
-
-/-- Restrict a `trivialization` to an open set in the base. `-/
-def restr_open (e : trivialization F proj) (s : set B)
-  (hs : is_open s) : trivialization F proj :=
-{ to_local_homeomorph := ((e.is_image_preimage_prod s).symm.restr
-    (is_open.inter e.open_target (hs.prod is_open_univ))).symm,
-  base_set := e.base_set ∩ s,
-  open_base_set := is_open.inter e.open_base_set hs,
-  source_eq := by simp [e.source_eq],
-  target_eq := by simp [e.target_eq, prod_univ],
-  proj_to_fun := λ p hp, e.proj_to_fun p hp.1 }
-
-section piecewise
-
-lemma frontier_preimage (e : trivialization F proj) (s : set B) :
-  e.source ∩ frontier (proj ⁻¹' s) = proj ⁻¹' (e.base_set ∩ frontier s) :=
-by rw [← (e.is_image_preimage_prod s).frontier.preimage_eq, frontier_prod_univ_eq,
-  (e.is_image_preimage_prod _).preimage_eq, e.source_eq, preimage_inter]
-
-/-- Given two bundle trivializations `e`, `e'` of `proj : Z → B` and a set `s : set B` such that
-the base sets of `e` and `e'` intersect `frontier s` on the same set and `e p = e' p` whenever
-`proj p ∈ e.base_set ∩ frontier s`, `e.piecewise e' s Hs Heq` is the bundle trivialization over
-`set.ite s e.base_set e'.base_set` that is equal to `e` on `proj ⁻¹ s` and is equal to `e'`
-otherwise. -/
-noncomputable def piecewise (e e' : trivialization F proj) (s : set B)
-  (Hs : e.base_set ∩ frontier s = e'.base_set ∩ frontier s)
-  (Heq : eq_on e e' $ proj ⁻¹' (e.base_set ∩ frontier s)) :
-  trivialization F proj :=
-{ to_local_homeomorph := e.to_local_homeomorph.piecewise e'.to_local_homeomorph
-    (proj ⁻¹' s) (s ×ˢ (univ : set F)) (e.is_image_preimage_prod s) (e'.is_image_preimage_prod s)
-    (by rw [e.frontier_preimage, e'.frontier_preimage, Hs])
-    (by rwa e.frontier_preimage),
-  base_set := s.ite e.base_set e'.base_set,
-  open_base_set := e.open_base_set.ite e'.open_base_set Hs,
-  source_eq := by simp [e.source_eq, e'.source_eq],
-  target_eq := by simp [e.target_eq, e'.target_eq, prod_univ],
-  proj_to_fun := by rintro p (⟨he, hs⟩|⟨he, hs⟩); simp * }
-
-/-- Given two bundle trivializations `e`, `e'` of a topological fiber bundle `proj : Z → B`
-over a linearly ordered base `B` and a point `a ∈ e.base_set ∩ e'.base_set` such that
-`e` equals `e'` on `proj ⁻¹' {a}`, `e.piecewise_le_of_eq e' a He He' Heq` is the bundle
-trivialization over `set.ite (Iic a) e.base_set e'.base_set` that is equal to `e` on points `p`
-such that `proj p ≤ a` and is equal to `e'` otherwise. -/
-noncomputable def piecewise_le_of_eq [linear_order B] [order_topology B]
-  (e e' : trivialization F proj) (a : B) (He : a ∈ e.base_set) (He' : a ∈ e'.base_set)
-  (Heq : ∀ p, proj p = a → e p = e' p) :
-  trivialization F proj :=
-e.piecewise e' (Iic a)
-  (set.ext $ λ x, and.congr_left_iff.2 $ λ hx,
-    by simp [He, He', mem_singleton_iff.1 (frontier_Iic_subset _ hx)])
-  (λ p hp, Heq p $ frontier_Iic_subset _ hp.2)
-
-/-- Given two bundle trivializations `e`, `e'` of a topological fiber bundle `proj : Z → B` over a
-linearly ordered base `B` and a point `a ∈ e.base_set ∩ e'.base_set`, `e.piecewise_le e' a He He'`
-is the bundle trivialization over `set.ite (Iic a) e.base_set e'.base_set` that is equal to `e` on
-points `p` such that `proj p ≤ a` and is equal to `((e' p).1, h (e' p).2)` otherwise, where
-`h = `e'.coord_change_homeomorph e _ _` is the homeomorphism of the fiber such that
-`h (e' p).2 = (e p).2` whenever `e p = a`. -/
-noncomputable def piecewise_le [linear_order B] [order_topology B]
-  (e e' : trivialization F proj) (a : B) (He : a ∈ e.base_set) (He' : a ∈ e'.base_set) :
-  trivialization F proj :=
-e.piecewise_le_of_eq (e'.trans_fiber_homeomorph (e'.coord_change_homeomorph e He' He))
-  a He He' $ by { unfreezingI {rintro p rfl },
-    ext1,
-    { simp [e.coe_fst', e'.coe_fst', *] },
-    { simp [e'.coord_change_apply_snd, *] } }
-
-/-- Given two bundle trivializations `e`, `e'` over disjoint sets, `e.disjoint_union e' H` is the
-bundle trivialization over the union of the base sets that agrees with `e` and `e'` over their
-base sets. -/
-noncomputable def disjoint_union (e e' : trivialization F proj)
-  (H : disjoint e.base_set e'.base_set) :
-  trivialization F proj :=
-{ to_local_homeomorph := e.to_local_homeomorph.disjoint_union e'.to_local_homeomorph
-    (λ x hx, by { rw [e.source_eq, e'.source_eq] at hx, exact H hx })
-    (λ x hx, by { rw [e.target_eq, e'.target_eq] at hx, exact H ⟨hx.1.1, hx.2.1⟩ }),
-  base_set := e.base_set ∪ e'.base_set,
-  open_base_set := is_open.union e.open_base_set e'.open_base_set,
-  source_eq := congr_arg2 (∪) e.source_eq e'.source_eq,
-  target_eq := (congr_arg2 (∪) e.target_eq e'.target_eq).trans union_prod.symm,
-  proj_to_fun :=
-    begin
-      rintro p (hp|hp'),
-      { show (e.source.piecewise e e' p).1 = proj p,
-        rw [piecewise_eq_of_mem, e.coe_fst]; exact hp },
-      { show (e.source.piecewise e e' p).1 = proj p,
-        rw [piecewise_eq_of_not_mem, e'.coe_fst hp'],
-        simp only [e.source_eq, e'.source_eq] at hp' ⊢,
-        exact λ h, H ⟨h, hp'⟩ }
-    end }
-
-/-- If `h` is a topological fiber bundle over a conditionally complete linear order,
-then it is trivial over any closed interval. -/
-lemma _root_.is_topological_fiber_bundle.exists_trivialization_Icc_subset
-  [conditionally_complete_linear_order B] [order_topology B]
-  (h : is_topological_fiber_bundle F proj) (a b : B) :
-  ∃ e : trivialization F proj, Icc a b ⊆ e.base_set :=
-begin
-  classical,
-  obtain ⟨ea, hea⟩ : ∃ ea : trivialization F proj, a ∈ ea.base_set := h a,
-  -- If `a < b`, then `[a, b] = ∅`, and the statement is trivial
-  cases le_or_lt a b with hab hab; [skip, exact ⟨ea, by simp *⟩],
-  /- Let `s` be the set of points `x ∈ [a, b]` such that `proj` is trivializable over `[a, x]`.
-  We need to show that `b ∈ s`. Let `c = Sup s`. We will show that `c ∈ s` and `c = b`. -/
-  set s : set B := {x ∈ Icc a b | ∃ e : trivialization F proj, Icc a x ⊆ e.base_set},
-  have ha : a ∈ s, from ⟨left_mem_Icc.2 hab, ea, by simp [hea]⟩,
-  have sne : s.nonempty := ⟨a, ha⟩,
-  have hsb : b ∈ upper_bounds s, from λ x hx, hx.1.2,
-  have sbd : bdd_above s := ⟨b, hsb⟩,
-  set c := Sup s,
-  have hsc : is_lub s c, from is_lub_cSup sne sbd,
-  have hc : c ∈ Icc a b, from ⟨hsc.1 ha, hsc.2 hsb⟩,
-  obtain ⟨-, ec : trivialization F proj, hec : Icc a c ⊆ ec.base_set⟩ : c ∈ s,
-  { cases hc.1.eq_or_lt with heq hlt, { rwa ← heq },
-    refine ⟨hc, _⟩,
-    /- In order to show that `c ∈ s`, consider a trivialization `ec` of `proj` over a neighborhood
-    of `c`. Its base set includes `(c', c]` for some `c' ∈ [a, c)`. -/
-    rcases h c with ⟨ec, hc⟩,
-    obtain ⟨c', hc', hc'e⟩ : ∃ c' ∈ Ico a c, Ioc c' c ⊆ ec.base_set :=
-      (mem_nhds_within_Iic_iff_exists_mem_Ico_Ioc_subset hlt).1
-        (mem_nhds_within_of_mem_nhds $ is_open.mem_nhds ec.open_base_set hc),
-    /- Since `c' < c = Sup s`, there exists `d ∈ s ∩ (c', c]`. Let `ead` be a trivialization of
-    `proj` over `[a, d]`. Then we can glue `ead` and `ec` into a trivialization over `[a, c]`. -/
-    obtain ⟨d, ⟨hdab, ead, had⟩, hd⟩ : ∃ d ∈ s, d ∈ Ioc c' c := hsc.exists_between hc'.2,
-    refine ⟨ead.piecewise_le ec d (had ⟨hdab.1, le_rfl⟩) (hc'e hd), subset_ite.2 _⟩,
-    refine ⟨λ x hx, had ⟨hx.1.1, hx.2⟩, λ x hx, hc'e ⟨hd.1.trans (not_le.1 hx.2), hx.1.2⟩⟩ },
-  /- So, `c ∈ s`. Let `ec` be a trivialization of `proj` over `[a, c]`.  If `c = b`, then we are
-  done. Otherwise we show that `proj` can be trivialized over a larger interval `[a, d]`,
-  `d ∈ (c, b]`, hence `c` is not an upper bound of `s`. -/
-  cases hc.2.eq_or_lt with heq hlt, { exact ⟨ec, heq ▸ hec⟩ },
-  suffices : ∃ (d ∈ Ioc c b) (e : trivialization F proj), Icc a d ⊆ e.base_set,
-  { rcases this with ⟨d, hdcb, hd⟩,
-    exact ((hsc.1 ⟨⟨hc.1.trans hdcb.1.le, hdcb.2⟩, hd⟩).not_lt hdcb.1).elim },
-  /- Since the base set of `ec` is open, it includes `[c, d)` (hence, `[a, d)`) for some
-  `d ∈ (c, b]`. -/
-  obtain ⟨d, hdcb, hd⟩ : ∃ d ∈ Ioc c b, Ico c d ⊆ ec.base_set :=
-    (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hlt).1
-      (mem_nhds_within_of_mem_nhds $ is_open.mem_nhds ec.open_base_set (hec ⟨hc.1, le_rfl⟩)),
-  have had : Ico a d ⊆ ec.base_set,
-    from subset.trans Ico_subset_Icc_union_Ico (union_subset hec hd),
-  by_cases he : disjoint (Iio d) (Ioi c),
-  { /- If `(c, d) = ∅`, then let `ed` be a trivialization of `proj` over a neighborhood of `d`.
-    Then the disjoint union of `ec` restricted to `(-∞, d)` and `ed` restricted to `(c, ∞)` is
-    a trivialization over `[a, d]`. -/
-    rcases h d with ⟨ed, hed⟩,
-    refine ⟨d, hdcb, (ec.restr_open (Iio d) is_open_Iio).disjoint_union
-      (ed.restr_open (Ioi c) is_open_Ioi) (he.mono (inter_subset_right _ _)
-        (inter_subset_right _ _)), λ x hx, _⟩,
-    rcases hx.2.eq_or_lt with rfl|hxd,
-    exacts [or.inr ⟨hed, hdcb.1⟩, or.inl ⟨had ⟨hx.1, hxd⟩, hxd⟩] },
-  { /- If `(c, d)` is nonempty, then take `d' ∈ (c, d)`. Since the base set of `ec` includes
-    `[a, d)`, it includes `[a, d'] ⊆ [a, d)` as well. -/
-    rw [disjoint_left] at he, push_neg at he, rcases he with ⟨d', hdd' : d' < d, hd'c⟩,
-    exact ⟨d', ⟨hd'c, hdd'.le.trans hdcb.2⟩, ec, subset.trans (Icc_subset_Ico_right hdd') had⟩ }
-end
-
-end piecewise
-
-end topological_fiber_bundle.trivialization
-
-end topological_fiber_bundle
-
-/-! ### Constructing topological fiber bundles -/
-
-namespace bundle
-
-variable (E : B → Type*)
-
-attribute [mfld_simps] proj total_space_mk coe_fst coe_snd_map_apply coe_snd_map_smul
-
-instance [I : topological_space F] : ∀ x : B, topological_space (trivial B F x) := λ x, I
-
-instance [t₁ : topological_space B] [t₂ : topological_space F] :
-  topological_space (total_space (trivial B F)) :=
-topological_space.induced (proj (trivial B F)) t₁ ⊓
-  topological_space.induced (trivial.proj_snd B F) t₂
-
-end bundle
-
-/-- Core data defining a locally trivial topological bundle with fiber `F` over a topological
-space `B`. Note that "bundle" is used in its mathematical sense. This is the (computer science)
-bundled version, i.e., all the relevant data is contained in the following structure. A family of
-local trivializations is indexed by a type `ι`, on open subsets `base_set i` for each `i : ι`.
-Trivialization changes from `i` to `j` are given by continuous maps `coord_change i j` from
-`base_set i ∩ base_set j` to the set of homeomorphisms of `F`, but we express them as maps
-`B → F → F` and require continuity on `(base_set i ∩ base_set j) × F` to avoid the topology on the
-space of continuous maps on `F`. -/
-@[nolint has_inhabited_instance]
-structure topological_fiber_bundle_core (ι : Type*) (B : Type*) [topological_space B]
-  (F : Type*) [topological_space F] :=
-(base_set          : ι → set B)
-(is_open_base_set  : ∀ i, is_open (base_set i))
-(index_at          : B → ι)
-(mem_base_set_at   : ∀ x, x ∈ base_set (index_at x))
-(coord_change      : ι → ι → B → F → F)
-(coord_change_self : ∀ i, ∀ x ∈ base_set i, ∀ v, coord_change i i x v = v)
-(coord_change_continuous : ∀ i j, continuous_on (λp : B × F, coord_change i j p.1 p.2)
-                                               (((base_set i) ∩ (base_set j)) ×ˢ (univ : set F)))
-(coord_change_comp : ∀ i j k, ∀ x ∈ (base_set i) ∩ (base_set j) ∩ (base_set k), ∀ v,
-  (coord_change j k x) (coord_change i j x v) = coord_change i k x v)
-
-namespace topological_fiber_bundle_core
-
-variables [topological_space B] [topological_space F] (Z : topological_fiber_bundle_core ι B F)
-
-include Z
-
-/-- The index set of a topological fiber bundle core, as a convenience function for dot notation -/
-@[nolint unused_arguments has_inhabited_instance]
-def index := ι
-
-/-- The base space of a topological fiber bundle core, as a convenience function for dot notation -/
-@[nolint unused_arguments, reducible]
-def base := B
-
-/-- The fiber of a topological fiber bundle core, as a convenience function for dot notation and
-typeclass inference -/
-@[nolint unused_arguments has_inhabited_instance]
-def fiber (x : B) := F
-
-section fiber_instances
-local attribute [reducible] fiber
-
-instance topological_space_fiber (x : B) : topological_space (Z.fiber x) := by apply_instance
-
-end fiber_instances
-
-/-- The total space of the topological fiber bundle, as a convenience function for dot notation.
-It is by definition equal to `bundle.total_space Z.fiber`, a.k.a. `Σ x, Z.fiber x` but with a
-different name for typeclass inference. -/
-@[nolint unused_arguments, reducible]
-def total_space := bundle.total_space Z.fiber
-
-/-- The projection from the total space of a topological fiber bundle core, on its base. -/
-@[reducible, simp, mfld_simps] def proj : Z.total_space → B := bundle.proj Z.fiber
-
-/-- Local homeomorphism version of the trivialization change. -/
-def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
-{ source      := (Z.base_set i ∩ Z.base_set j) ×ˢ (univ : set F),
-  target      := (Z.base_set i ∩ Z.base_set j) ×ˢ (univ : set F),
-  to_fun      := λp, ⟨p.1, Z.coord_change i j p.1 p.2⟩,
-  inv_fun     := λp, ⟨p.1, Z.coord_change j i p.1 p.2⟩,
-  map_source' := λp hp, by simpa using hp,
-  map_target' := λp hp, by simpa using hp,
-  left_inv'   := begin
-    rintros ⟨x, v⟩ hx,
-    simp only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ] at hx,
-    rw [Z.coord_change_comp, Z.coord_change_self],
-    { exact hx.1 },
-    { simp [hx] }
-  end,
-  right_inv'  := begin
-    rintros ⟨x, v⟩ hx,
-    simp only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ] at hx,
-    rw [Z.coord_change_comp, Z.coord_change_self],
-    { exact hx.2 },
-    { simp [hx] },
-  end,
-  open_source :=
-    (is_open.inter (Z.is_open_base_set i) (Z.is_open_base_set j)).prod is_open_univ,
-  open_target :=
-    (is_open.inter (Z.is_open_base_set i) (Z.is_open_base_set j)).prod is_open_univ,
-  continuous_to_fun  :=
-    continuous_on.prod continuous_fst.continuous_on (Z.coord_change_continuous i j),
-  continuous_inv_fun := by simpa [inter_comm]
-    using continuous_on.prod continuous_fst.continuous_on (Z.coord_change_continuous j i) }
-
-@[simp, mfld_simps] lemma mem_triv_change_source (i j : ι) (p : B × F) :
-  p ∈ (Z.triv_change i j).source ↔ p.1 ∈ Z.base_set i ∩ Z.base_set j :=
-by { erw [mem_prod], simp }
-
-/-- Associate to a trivialization index `i : ι` the corresponding trivialization, i.e., a bijection
-between `proj ⁻¹ (base_set i)` and `base_set i × F`. As the fiber above `x` is `F` but read in the
-chart with index `index_at x`, the trivialization in the fiber above x is by definition the
-coordinate change from i to `index_at x`, so it depends on `x`.
-The local trivialization will ultimately be a local homeomorphism. For now, we only introduce the
-local equiv version, denoted with a prime. In further developments, avoid this auxiliary version,
-and use `Z.local_triv` instead.
--/
-def local_triv_as_local_equiv (i : ι) : local_equiv Z.total_space (B × F) :=
-{ source      := Z.proj ⁻¹' (Z.base_set i),
-  target      := Z.base_set i ×ˢ (univ : set F),
-  inv_fun     := λp, ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩,
-  to_fun      := λp, ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩,
-  map_source' := λp hp,
-    by simpa only [set.mem_preimage, and_true, set.mem_univ, set.prod_mk_mem_set_prod_eq] using hp,
-  map_target' := λp hp,
-    by simpa only [set.mem_preimage, and_true, set.mem_univ, set.mem_prod] using hp,
-  left_inv'   := begin
-    rintros ⟨x, v⟩ hx,
-    change x ∈ Z.base_set i at hx,
-    dsimp only,
-    rw [Z.coord_change_comp, Z.coord_change_self],
-    { exact Z.mem_base_set_at _ },
-    { simp only [hx, mem_inter_eq, and_self, mem_base_set_at] }
-  end,
-  right_inv' := begin
-    rintros ⟨x, v⟩ hx,
-    simp only [prod_mk_mem_set_prod_eq, and_true, mem_univ] at hx,
-    rw [Z.coord_change_comp, Z.coord_change_self],
-    { exact hx },
-    { simp only [hx, mem_inter_eq, and_self, mem_base_set_at] }
-  end }
-
-variable (i : ι)
-
-lemma mem_local_triv_as_local_equiv_source (p : Z.total_space) :
-  p ∈ (Z.local_triv_as_local_equiv i).source ↔ p.1 ∈ Z.base_set i :=
-iff.rfl
-
-lemma mem_local_triv_as_local_equiv_target (p : B × F) :
-  p ∈ (Z.local_triv_as_local_equiv i).target ↔ p.1 ∈ Z.base_set i :=
-by { erw [mem_prod], simp only [and_true, mem_univ] }
-
-lemma local_triv_as_local_equiv_apply (p : Z.total_space) :
-  (Z.local_triv_as_local_equiv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl
-
-/-- The composition of two local trivializations is the trivialization change Z.triv_change i j. -/
-lemma local_triv_as_local_equiv_trans (i j : ι) :
-  (Z.local_triv_as_local_equiv i).symm.trans
-    (Z.local_triv_as_local_equiv j) ≈ (Z.triv_change i j).to_local_equiv :=
-begin
-  split,
-  { ext x, simp only [mem_local_triv_as_local_equiv_target] with mfld_simps, refl, },
-  { rintros ⟨x, v⟩ hx,
-    simp only [triv_change, local_triv_as_local_equiv, local_equiv.symm, true_and, prod.mk.inj_iff,
-      prod_mk_mem_set_prod_eq, local_equiv.trans_source, mem_inter_eq, and_true, mem_preimage, proj,
-      mem_univ, local_equiv.coe_mk, eq_self_iff_true, local_equiv.coe_trans, bundle.proj] at hx ⊢,
-    simp only [Z.coord_change_comp, hx, mem_inter_eq, and_self, mem_base_set_at], }
-end
-
-variable (ι)
-
-/-- Topological structure on the total space of a topological bundle created from core, designed so
-that all the local trivialization are continuous. -/
-instance to_topological_space : topological_space (bundle.total_space Z.fiber) :=
-topological_space.generate_from $ ⋃ (i : ι) (s : set (B × F)) (s_open : is_open s),
-  {(Z.local_triv_as_local_equiv i).source ∩ (Z.local_triv_as_local_equiv i) ⁻¹' s}
-
-variable {ι}
-
-lemma open_source' (i : ι) : is_open (Z.local_triv_as_local_equiv i).source :=
-begin
-  apply topological_space.generate_open.basic,
-  simp only [exists_prop, mem_Union, mem_singleton_iff],
-  refine ⟨i, Z.base_set i ×ˢ (univ : set F), (Z.is_open_base_set i).prod is_open_univ, _⟩,
-  ext p,
-  simp only [local_triv_as_local_equiv_apply, prod_mk_mem_set_prod_eq, mem_inter_eq, and_self,
-    mem_local_triv_as_local_equiv_source, and_true, mem_univ, mem_preimage],
-end
-
-open topological_fiber_bundle
-
-/-- Extended version of the local trivialization of a fiber bundle constructed from core,
-registering additionally in its type that it is a local bundle trivialization. -/
-def local_triv (i : ι) : trivialization F Z.proj :=
-{ base_set      := Z.base_set i,
-  open_base_set := Z.is_open_base_set i,
-  source_eq     := rfl,
-  target_eq     := rfl,
-  proj_to_fun   := λ p hp, by { simp only with mfld_simps, refl },
-  open_source := Z.open_source' i,
-  open_target := (Z.is_open_base_set i).prod is_open_univ,
-  continuous_to_fun := begin
-    rw continuous_on_open_iff (Z.open_source' i),
-    assume s s_open,
-    apply topological_space.generate_open.basic,
-    simp only [exists_prop, mem_Union, mem_singleton_iff],
-    exact ⟨i, s, s_open, rfl⟩
-  end,
-  continuous_inv_fun := begin
-    apply continuous_on_open_of_generate_from ((Z.is_open_base_set i).prod is_open_univ),
-    assume t ht,
-    simp only [exists_prop, mem_Union, mem_singleton_iff] at ht,
-    obtain ⟨j, s, s_open, ts⟩ : ∃ j s, is_open s ∧ t =
-      (local_triv_as_local_equiv Z j).source ∩ (local_triv_as_local_equiv Z j) ⁻¹' s := ht,
-    rw ts,
-    simp only [local_equiv.right_inv, preimage_inter, local_equiv.left_inv],
-    let e := Z.local_triv_as_local_equiv i,
-    let e' := Z.local_triv_as_local_equiv j,
-    let f := e.symm.trans e',
-    have : is_open (f.source ∩ f ⁻¹' s),
-    { rw [(Z.local_triv_as_local_equiv_trans i j).source_inter_preimage_eq],
-      exact (continuous_on_open_iff (Z.triv_change i j).open_source).1
-        ((Z.triv_change i j).continuous_on) _ s_open },
-    convert this using 1,
-    dsimp [local_equiv.trans_source],
-    rw [← preimage_comp, inter_assoc],
-    refl,
-  end,
-  to_local_equiv := Z.local_triv_as_local_equiv i }
-
-/-- A topological fiber bundle constructed from core is indeed a topological fiber bundle. -/
-protected theorem is_topological_fiber_bundle : is_topological_fiber_bundle F Z.proj :=
-λx, ⟨Z.local_triv (Z.index_at x), Z.mem_base_set_at x⟩
-
-/-- The projection on the base of a topological bundle created from core is continuous -/
-lemma continuous_proj : continuous Z.proj :=
-Z.is_topological_fiber_bundle.continuous_proj
-
-/-- The projection on the base of a topological bundle created from core is an open map -/
-lemma is_open_map_proj : is_open_map Z.proj :=
-Z.is_topological_fiber_bundle.is_open_map_proj
-
-/-- Preferred local trivialization of a fiber bundle constructed from core, at a given point, as
-a bundle trivialization -/
-def local_triv_at (b : B) : trivialization F Z.proj :=
-Z.local_triv (Z.index_at b)
-
-@[simp, mfld_simps] lemma local_triv_at_def (b : B) :
-  Z.local_triv (Z.index_at b) = Z.local_triv_at b := rfl
-
-/-- If an element of `F` is invariant under all coordinate changes, then one can define a
-corresponding section of the fiber bundle, which is continuous. This applies in particular to the
-zero section of a vector bundle. Another example (not yet defined) would be the identity
-section of the endomorphism bundle of a vector bundle. -/
-lemma continuous_const_section (v : F)
-  (h : ∀ i j, ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j), Z.coord_change i j x v = v) :
-  continuous (show B → Z.total_space, from λ x, ⟨x, v⟩) :=
-begin
-  apply continuous_iff_continuous_at.2 (λ x, _),
-  have A : Z.base_set (Z.index_at x) ∈ 𝓝 x :=
-    is_open.mem_nhds (Z.is_open_base_set (Z.index_at x)) (Z.mem_base_set_at x),
-  apply ((Z.local_triv_at x).to_local_homeomorph.continuous_at_iff_continuous_at_comp_left _).2,
-  { simp only [(∘)] with mfld_simps,
-    apply continuous_at_id.prod,
-    have : continuous_on (λ (y : B), v) (Z.base_set (Z.index_at x)) := continuous_on_const,
-    apply (this.congr _).continuous_at A,
-    assume y hy,
-    simp only [h, hy, mem_base_set_at] with mfld_simps },
-  { exact A }
-end
-
-@[simp, mfld_simps] lemma local_triv_as_local_equiv_coe :
-  ⇑(Z.local_triv_as_local_equiv i) = Z.local_triv i := rfl
-
-@[simp, mfld_simps] lemma local_triv_as_local_equiv_source :
-  (Z.local_triv_as_local_equiv i).source = (Z.local_triv i).source := rfl
-
-@[simp, mfld_simps] lemma local_triv_as_local_equiv_target :
-  (Z.local_triv_as_local_equiv i).target = (Z.local_triv i).target := rfl
-
-@[simp, mfld_simps] lemma local_triv_as_local_equiv_symm :
-  (Z.local_triv_as_local_equiv i).symm = (Z.local_triv i).to_local_equiv.symm := rfl
-
-@[simp, mfld_simps] lemma base_set_at : Z.base_set i = (Z.local_triv i).base_set := rfl
-
-@[simp, mfld_simps] lemma local_triv_apply (p : Z.total_space) :
-  (Z.local_triv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl
-
-@[simp, mfld_simps] lemma mem_local_triv_source (p : Z.total_space) :
-  p ∈ (Z.local_triv i).source ↔ p.1 ∈ (Z.local_triv i).base_set := iff.rfl
-
-@[simp, mfld_simps] lemma mem_local_triv_target (p : B × F) :
-  p ∈ (Z.local_triv i).target ↔ p.1 ∈ (Z.local_triv i).base_set :=
-trivialization.mem_target _
-
-@[simp, mfld_simps] lemma local_triv_symm_fst (p : B × F) :
-  (Z.local_triv i).to_local_homeomorph.symm p =
-    ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩ := rfl
-
-@[simp, mfld_simps] lemma local_triv_at_apply (b : B) (a : F) :
-  ((Z.local_triv_at b) ⟨b, a⟩) = ⟨b, a⟩ :=
-by { rw [local_triv_at, local_triv_apply, coord_change_self], exact Z.mem_base_set_at b }
-
-@[simp, mfld_simps] lemma mem_local_triv_at_base_set (b : B) :
-  b ∈ (Z.local_triv_at b).base_set :=
-by { rw [local_triv_at, ←base_set_at], exact Z.mem_base_set_at b, }
-
-open bundle
-
-/-- The inclusion of a fiber into the total space is a continuous map. -/
-@[continuity]
-lemma continuous_total_space_mk (b : B) : continuous (λ a, total_space_mk Z.fiber b a) :=
-begin
-  rw [continuous_iff_le_induced, topological_fiber_bundle_core.to_topological_space],
-  apply le_induced_generate_from,
-  simp only [total_space_mk, mem_Union, mem_singleton_iff, local_triv_as_local_equiv_source,
-    local_triv_as_local_equiv_coe],
-  rintros s ⟨i, t, ht, rfl⟩,
-  rw [←((Z.local_triv i).source_inter_preimage_target_inter t), preimage_inter, ←preimage_comp,
-    trivialization.source_eq],
-  apply is_open.inter,
-  { simp only [bundle.proj, proj, ←preimage_comp],
-    by_cases (b ∈ (Z.local_triv i).base_set),
-    { rw preimage_const_of_mem h, exact is_open_univ, },
-    { rw preimage_const_of_not_mem h, exact is_open_empty, }},
-  { simp only [function.comp, local_triv_apply],
-    rw [preimage_inter, preimage_comp],
-    by_cases (b ∈ Z.base_set i),
-    { have hc : continuous (λ (x : Z.fiber b), (Z.coord_change (Z.index_at b) i b) x),
-        from (Z.coord_change_continuous (Z.index_at b) i).comp_continuous
-          (continuous_const.prod_mk continuous_id) (λ x, ⟨⟨Z.mem_base_set_at b, h⟩, mem_univ x⟩),
-      exact (((Z.local_triv i).open_target.inter ht).preimage (continuous.prod.mk b)).preimage hc },
-    { rw [(Z.local_triv i).target_eq, ←base_set_at, mk_preimage_prod_right_eq_empty h,
-        preimage_empty, empty_inter],
-      exact is_open_empty, }}
-end
-
-end topological_fiber_bundle_core
-
-variables (F) {Z : Type*} [topological_space B] [topological_space F] {proj : Z → B}
-
-open topological_fiber_bundle
-
-/-- This structure permits to define a fiber bundle when trivializations are given as local
-equivalences but there is not yet a topology on the total space. The total space is hence given a
-topology in such a way that there is a fiber bundle structure for which the local equivalences
-are also local homeomorphism and hence local trivializations. -/
-@[nolint has_inhabited_instance]
-structure topological_fiber_prebundle (proj : Z → B) :=
-(pretrivialization_atlas : set (pretrivialization F proj))
-(pretrivialization_at : B → pretrivialization F proj)
-(mem_base_pretrivialization_at : ∀ x : B, x ∈ (pretrivialization_at x).base_set)
-(pretrivialization_mem_atlas : ∀ x : B, pretrivialization_at x ∈ pretrivialization_atlas)
-(continuous_triv_change : ∀ e e' ∈ pretrivialization_atlas,
-  continuous_on (e ∘ e'.to_local_equiv.symm) (e'.target ∩ (e'.to_local_equiv.symm ⁻¹' e.source)))
-
-namespace topological_fiber_prebundle
-
-variables {F} (a : topological_fiber_prebundle F proj) {e : pretrivialization F proj}
-
-/-- Topology on the total space that will make the prebundle into a bundle. -/
-def total_space_topology (a : topological_fiber_prebundle F proj) : topological_space Z :=
-⨆ (e : pretrivialization F proj) (he : e ∈ a.pretrivialization_atlas),
-  coinduced e.set_symm (subtype.topological_space)
-
-lemma continuous_symm_of_mem_pretrivialization_atlas (he : e ∈ a.pretrivialization_atlas) :
-  @continuous_on _ _ _ a.total_space_topology
-  e.to_local_equiv.symm e.target :=
-begin
-  refine id (λ z H, id (λ U h, preimage_nhds_within_coinduced' H
-    e.open_target (le_def.1 (nhds_mono _) U h))),
-  exact le_supr₂ e he,
-end
-
-lemma is_open_source (e : pretrivialization F proj) : @is_open _ a.total_space_topology e.source :=
-begin
-  letI := a.total_space_topology,
-  refine is_open_supr_iff.mpr (λ e', _),
-  refine is_open_supr_iff.mpr (λ he', _),
-  refine is_open_coinduced.mpr (is_open_induced_iff.mpr ⟨e.target, e.open_target, _⟩),
-  rw [pretrivialization.set_symm, restrict, e.target_eq,
-    e.source_eq, preimage_comp, subtype.preimage_coe_eq_preimage_coe_iff,
-    e'.target_eq, prod_inter_prod, inter_univ,
-    pretrivialization.preimage_symm_proj_inter],
-end
-
-lemma is_open_target_of_mem_pretrivialization_atlas_inter (e e' : pretrivialization F proj)
-  (he' : e' ∈ a.pretrivialization_atlas) :
-  is_open (e'.to_local_equiv.target ∩ e'.to_local_equiv.symm ⁻¹' e.source) :=
-begin
-  letI := a.total_space_topology,
-  obtain ⟨u, hu1, hu2⟩ := continuous_on_iff'.mp (a.continuous_symm_of_mem_pretrivialization_atlas
-    he') e.source (a.is_open_source e),
-  rw [inter_comm, hu2],
-  exact hu1.inter e'.open_target,
-end
-
-/-- Promotion from a `pretrivialization` to a `trivialization`. -/
-def trivialization_of_mem_pretrivialization_atlas (he : e ∈ a.pretrivialization_atlas) :
-  @trivialization B F Z _ _ a.total_space_topology proj :=
-{ open_source := a.is_open_source e,
-  continuous_to_fun := begin
-    letI := a.total_space_topology,
-    refine continuous_on_iff'.mpr (λ s hs, ⟨e ⁻¹' s ∩ e.source, (is_open_supr_iff.mpr (λ e', _)),
-      by { rw [inter_assoc, inter_self], refl }⟩),
-    refine (is_open_supr_iff.mpr (λ he', _)),
-    rw [is_open_coinduced, is_open_induced_iff],
-    obtain ⟨u, hu1, hu2⟩ := continuous_on_iff'.mp (a.continuous_triv_change _ he _ he') s hs,
-    have hu3 := congr_arg (λ s, (λ x : e'.target, (x : B × F)) ⁻¹' s) hu2,
-    simp only [subtype.coe_preimage_self, preimage_inter, univ_inter] at hu3,
-    refine ⟨u ∩ e'.to_local_equiv.target ∩
-      (e'.to_local_equiv.symm ⁻¹' e.source), _, by
-      { simp only [preimage_inter, inter_univ, subtype.coe_preimage_self, hu3.symm], refl }⟩,
-    rw inter_assoc,
-    exact hu1.inter (a.is_open_target_of_mem_pretrivialization_atlas_inter e e' he'),
-  end,
-  continuous_inv_fun := a.continuous_symm_of_mem_pretrivialization_atlas he,
-  .. e }
-
-lemma is_topological_fiber_bundle :
-  @is_topological_fiber_bundle B F Z _ _ a.total_space_topology proj :=
-λ x, ⟨a.trivialization_of_mem_pretrivialization_atlas (a.pretrivialization_mem_atlas x),
-  a.mem_base_pretrivialization_at x ⟩
-
-lemma continuous_proj : @continuous _ _ a.total_space_topology _ proj :=
-by { letI := a.total_space_topology, exact a.is_topological_fiber_bundle.continuous_proj, }
-
-end topological_fiber_prebundle
diff --git a/src/topology/fiber_bundle/basic.lean b/src/topology/fiber_bundle/basic.lean
new file mode 100644
index 0000000000000..e855d01461f19
--- /dev/null
+++ b/src/topology/fiber_bundle/basic.lean
@@ -0,0 +1,866 @@
+/-
+Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel, Floris van Doorn, Heather Macbeth
+-/
+import topology.fiber_bundle.trivialization
+
+/-!
+# Fiber bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Mathematically, a (topological) fiber bundle with fiber `F` over a base `B` is a space projecting on
+`B` for which the fibers are all homeomorphic to `F`, such that the local situation around each
+point is a direct product.
+
+In our formalism, a fiber bundle is by definition the type
+`bundle.total_space F E` where `E : B → Type*` is a function associating to `x : B` the fiber over
+`x`. This type `bundle.total_space F E` is a type of pairs `(proj : B, snd : E proj)`.
+
+To have a fiber bundle structure on `bundle.total_space F E`, one should
+additionally have the following data:
+
+* `F` should be a topological space;
+* There should be a topology on `bundle.total_space F E`, for which the projection to `B` is
+a fiber bundle with fiber `F` (in particular, each fiber `E x` is homeomorphic to `F`);
+* For each `x`, the fiber `E x` should be a topological space, and the injection
+from `E x` to `bundle.total_space F E` should be an embedding;
+* There should be a distinguished set of bundle trivializations, the "trivialization atlas"
+* There should be a choice of bundle trivialization at each point, which belongs to this atlas.
+
+If all these conditions are satisfied, we register the typeclass `fiber_bundle F E`.
+
+It is in general nontrivial to construct a fiber bundle. A way is to start from the knowledge of
+how changes of local trivializations act on the fiber. From this, one can construct the total space
+of the bundle and its topology by a suitable gluing construction. The main content of this file is
+an implementation of this construction: starting from an object of type
+`fiber_bundle_core` registering the trivialization changes, one gets the corresponding
+fiber bundle and projection.
+
+Similarly we implement the object `fiber_prebundle` which allows to define a topological
+fiber bundle from trivializations given as local equivalences with minimum additional properties.
+
+## Main definitions
+
+### Basic definitions
+
+* `fiber_bundle F E` : Structure saying that `E : B → Type*` is a fiber bundle with fiber `F`.
+
+### Construction of a bundle from trivializations
+
+* `bundle.total_space F E` is the type of pairs `(proj : B, snd : E proj)`. We can use the extra
+  argument `F` to construct topology on the total space.
+* `fiber_bundle_core ι B F` : structure registering how changes of coordinates act
+  on the fiber `F` above open subsets of `B`, where local trivializations are indexed by `ι`.
+
+Let `Z : fiber_bundle_core ι B F`. Then we define
+
+* `Z.fiber x`     : the fiber above `x`, homeomorphic to `F` (and defeq to `F` as a type).
+* `Z.total_space` : the total space of `Z`, defined as a `Type*` as `bundle.total_space F Z.fiber`
+                    with a custom topology.
+* `Z.proj`        : projection from `Z.total_space` to `B`. It is continuous.
+* `Z.local_triv i`: for `i : ι`, bundle trivialization above the set `Z.base_set i`, which is an
+                    open set in `B`.
+
+* `fiber_prebundle F E` : structure registering a cover of prebundle trivializations
+  and requiring that the relative transition maps are local homeomorphisms.
+* `fiber_prebundle.total_space_topology a` : natural topology of the total space, making
+  the prebundle into a bundle.
+
+## Implementation notes
+
+### Data vs mixins
+
+For both fiber and vector bundles, one faces a choice: should the definition state the *existence*
+of local trivializations (a propositional typeclass), or specify a fixed atlas of trivializations (a
+typeclass containing data)?
+
+In their initial mathlib implementations, both fiber and vector bundles were defined
+propositionally. For vector bundles, this turns out to be mathematically wrong: in infinite
+dimension, the transition function between two trivializations is not automatically continuous as a
+map from the base `B` to the endomorphisms `F →L[R] F` of the fiber (considered with the
+operator-norm topology), and so the definition needs to be modified by restricting consideration to
+a family of trivializations (constituting the data) which are all mutually-compatible in this sense.
+The PRs #13052 and #13175 implemented this change.
+
+There is still the choice about whether to hold this data at the level of fiber bundles or of vector
+bundles. As of PR #17505, the data is all held in `fiber_bundle`, with `vector_bundle` a
+(propositional) mixin stating fiberwise-linearity.
+
+This allows bundles to carry instances of typeclasses in which the scalar field, `R`, does not
+appear as a parameter. Notably, we would like a vector bundle over `R` with fiber `F` over base `B`
+to be a `charted_space (B × F)`, with the trivializations providing the charts. This would be a
+dangerous instance for typeclass inference, because `R` does not appear as a parameter in
+`charted_space (B × F)`. But if the data of the trivializations is held in `fiber_bundle`, then a
+fiber bundle with fiber `F` over base `B` can be a `charted_space (B × F)`, and this is safe for
+typeclass inference.
+
+We expect that this choice of definition will also streamline constructions of fiber bundles with
+similar underlying structure (e.g., the same bundle being both a real and complex vector bundle).
+
+### Core construction
+
+A fiber bundle with fiber `F` over a base `B` is a family of spaces isomorphic to `F`,
+indexed by `B`, which is locally trivial in the following sense: there is a covering of `B` by open
+sets such that, on each such open set `s`, the bundle is isomorphic to `s × F`.
+
+To construct a fiber bundle formally, the main data is what happens when one changes trivializations
+from `s × F` to `s' × F` on `s ∩ s'`: one should get a family of homeomorphisms of `F`, depending
+continuously on the base point, satisfying basic compatibility conditions (cocycle property).
+Useful classes of bundles can then be specified by requiring that these homeomorphisms of `F`
+belong to some subgroup, preserving some structure (the "structure group of the bundle"): then
+these structures are inherited by the fibers of the bundle.
+
+Given such trivialization change data (encoded below in a structure called
+`fiber_bundle_core`), one can construct the fiber bundle. The intrinsic canonical
+mathematical construction is the following.
+The fiber above `x` is the disjoint union of `F` over all trivializations, modulo the gluing
+identifications: one gets a fiber which is isomorphic to `F`, but non-canonically
+(each choice of one of the trivializations around `x` gives such an isomorphism). Given a
+trivialization over a set `s`, one gets an isomorphism between `s × F` and `proj^{-1} s`, by using
+the identification corresponding to this trivialization. One chooses the topology on the bundle that
+makes all of these into homeomorphisms.
+
+For the practical implementation, it turns out to be more convenient to avoid completely the
+gluing and quotienting construction above, and to declare above each `x` that the fiber is `F`,
+but thinking that it corresponds to the `F` coming from the choice of one trivialization around `x`.
+This has several practical advantages:
+* without any work, one gets a topological space structure on the fiber. And if `F` has more
+structure it is inherited for free by the fiber.
+* In the case of the tangent bundle of manifolds, this implies that on vector spaces the derivative
+(from `F` to `F`) and the manifold derivative (from `tangent_space I x` to `tangent_space I' (f x)`)
+are equal.
+
+A drawback is that some silly constructions will typecheck: in the case of the tangent bundle, one
+can add two vectors in different tangent spaces (as they both are elements of `F` from the point of
+view of Lean). To solve this, one could mark the tangent space as irreducible, but then one would
+lose the identification of the tangent space to `F` with `F`. There is however a big advantage of
+this situation: even if Lean can not check that two basepoints are defeq, it will accept the fact
+that the tangent spaces are the same. For instance, if two maps `f` and `g` are locally inverse to
+each other, one can express that the composition of their derivatives is the identity of
+`tangent_space I x`. One could fear issues as this composition goes from `tangent_space I x` to
+`tangent_space I (g (f x))` (which should be the same, but should not be obvious to Lean
+as it does not know that `g (f x) = x`). As these types are the same to Lean (equal to `F`), there
+are in fact no dependent type difficulties here!
+
+For this construction of a fiber bundle from a `fiber_bundle_core`, we should thus
+choose for each `x` one specific trivialization around it. We include this choice in the definition
+of the `fiber_bundle_core`, as it makes some constructions more
+functorial and it is a nice way to say that the trivializations cover the whole space `B`.
+
+With this definition, the type of the fiber bundle space constructed from the core data is
+`bundle.total_space F (λ b : B, F)`, but the topology is not the product one, in general.
+
+We also take the indexing type (indexing all the trivializations) as a parameter to the fiber bundle
+core: it could always be taken as a subtype of all the maps from open subsets of `B` to continuous
+maps of `F`, but in practice it will sometimes be something else. For instance, on a manifold, one
+will use the set of charts as a good parameterization for the trivializations of the tangent bundle.
+Or for the pullback of a `fiber_bundle_core`, the indexing type will be the same as
+for the initial bundle.
+
+## Tags
+Fiber bundle, topological bundle, structure group
+-/
+
+variables {ι B F X : Type*} [topological_space X]
+
+open topological_space filter set bundle
+open_locale topology classical bundle
+
+attribute [mfld_simps] total_space.coe_proj total_space.coe_snd coe_snd_map_apply
+  coe_snd_map_smul total_space.mk_cast
+
+/-! ### General definition of fiber bundles -/
+
+section fiber_bundle
+
+variables (F) [topological_space B] [topological_space F] (E : B → Type*)
+  [topological_space (total_space F E)] [∀ b, topological_space (E b)]
+
+/-- A (topological) fiber bundle with fiber `F` over a base `B` is a space projecting on `B`
+for which the fibers are all homeomorphic to `F`, such that the local situation around each point
+is a direct product. -/
+class fiber_bundle :=
+(total_space_mk_inducing [] : ∀ (b : B), inducing (@total_space.mk B F E b))
+(trivialization_atlas [] : set (trivialization F (π F E)))
+(trivialization_at [] : B → trivialization F (π F E))
+(mem_base_set_trivialization_at [] : ∀ b : B, b ∈ (trivialization_at b).base_set)
+(trivialization_mem_atlas [] : ∀ b : B, trivialization_at b ∈ trivialization_atlas)
+
+export fiber_bundle
+
+variables {F E}
+
+/-- Given a type `E` equipped with a fiber bundle structure, this is a `Prop` typeclass
+for trivializations of `E`, expressing that a trivialization is in the designated atlas for the
+bundle.  This is needed because lemmas about the linearity of trivializations or the continuity (as
+functions to `F →L[R] F`, where `F` is the model fiber) of the transition functions are only
+expected to hold for trivializations in the designated atlas. -/
+@[mk_iff]
+class mem_trivialization_atlas [fiber_bundle F E] (e : trivialization F (π F E)) : Prop :=
+(out : e ∈ trivialization_atlas F E)
+
+instance [fiber_bundle F E] (b : B) : mem_trivialization_atlas (trivialization_at F E b) :=
+{ out := trivialization_mem_atlas F E b }
+
+namespace fiber_bundle
+variables (F) {E} [fiber_bundle F E]
+
+lemma map_proj_nhds (x : total_space F E) :
+  map (π F E) (𝓝 x) = 𝓝 x.proj :=
+(trivialization_at F E x.proj).map_proj_nhds $
+  (trivialization_at F E x.proj).mem_source.2 $ mem_base_set_trivialization_at F E x.proj
+
+variables (E)
+
+/-- The projection from a fiber bundle to its base is continuous. -/
+@[continuity] lemma continuous_proj : continuous (π F E) :=
+continuous_iff_continuous_at.2 $ λ x, (map_proj_nhds F x).le
+
+/-- The projection from a fiber bundle to its base is an open map. -/
+lemma is_open_map_proj : is_open_map (π F E) :=
+is_open_map.of_nhds_le $ λ x, (map_proj_nhds F x).ge
+
+/-- The projection from a fiber bundle with a nonempty fiber to its base is a surjective
+map. -/
+lemma surjective_proj [nonempty F] : function.surjective (π F E) :=
+λ b, let ⟨p, _, hpb⟩ :=
+  (trivialization_at F E b).proj_surj_on_base_set (mem_base_set_trivialization_at F E b) in ⟨p, hpb⟩
+
+/-- The projection from a fiber bundle with a nonempty fiber to its base is a quotient
+map. -/
+lemma quotient_map_proj [nonempty F] : quotient_map (π F E) :=
+(is_open_map_proj F E).to_quotient_map (continuous_proj F E) (surjective_proj F E)
+
+lemma continuous_total_space_mk (x : B) : continuous (@total_space.mk B F E x) :=
+(total_space_mk_inducing F E x).continuous
+
+variables {E F}
+
+@[simp, mfld_simps]
+lemma mem_trivialization_at_proj_source {x : total_space F E} :
+  x ∈ (trivialization_at F E x.proj).source :=
+(trivialization.mem_source _).mpr $ mem_base_set_trivialization_at F E x.proj
+
+@[simp, mfld_simps]
+lemma trivialization_at_proj_fst {x : total_space F E} :
+  ((trivialization_at F E x.proj) x).1 = x.proj :=
+trivialization.coe_fst' _ $ mem_base_set_trivialization_at F E x.proj
+
+variable (F)
+open trivialization
+
+/-- Characterization of continuous functions (at a point, within a set) into a fiber bundle. -/
+lemma continuous_within_at_total_space (f : X → total_space F E) {s : set X} {x₀ : X} :
+  continuous_within_at f s x₀ ↔
+  continuous_within_at (λ x, (f x).proj) s x₀ ∧
+  continuous_within_at (λ x, ((trivialization_at F E (f x₀).proj) (f x)).2) s x₀ :=
+begin
+  refine (and_iff_right_iff_imp.2 $ λ hf, _).symm.trans (and_congr_right $ λ hf, _),
+  { refine (continuous_proj F E).continuous_within_at.comp hf (maps_to_image f s) },
+  have h1 : (λ x, (f x).proj) ⁻¹' (trivialization_at F E (f x₀).proj).base_set ∈ 𝓝[s] x₀ :=
+    hf.preimage_mem_nhds_within ((open_base_set _).mem_nhds (mem_base_set_trivialization_at F E _)),
+  have h2 : continuous_within_at (λ x, (trivialization_at F E (f x₀).proj (f x)).1) s x₀,
+  { refine hf.congr_of_eventually_eq (eventually_of_mem h1 $ λ x hx, _) trivialization_at_proj_fst,
+    rw [coe_fst'],
+    exact hx },
+  rw [(trivialization_at F E (f x₀).proj).continuous_within_at_iff_continuous_within_at_comp_left],
+  { simp_rw [continuous_within_at_prod_iff, function.comp, trivialization.coe_coe, h2, true_and] },
+  { apply mem_trivialization_at_proj_source },
+  { rwa [source_eq, preimage_preimage] }
+end
+
+/-- Characterization of continuous functions (at a point) into a fiber bundle. -/
+lemma continuous_at_total_space (f : X → total_space F E) {x₀ : X} :
+  continuous_at f x₀ ↔ continuous_at (λ x, (f x).proj) x₀ ∧
+  continuous_at (λ x, ((trivialization_at F E (f x₀).proj) (f x)).2) x₀ :=
+by { simp_rw [← continuous_within_at_univ], exact continuous_within_at_total_space F f }
+
+end fiber_bundle
+
+variables (F E)
+
+/-- If `E` is a fiber bundle over a conditionally complete linear order,
+then it is trivial over any closed interval. -/
+lemma fiber_bundle.exists_trivialization_Icc_subset
+  [conditionally_complete_linear_order B] [order_topology B] [fiber_bundle F E] (a b : B) :
+  ∃ e : trivialization F (π F E), Icc a b ⊆ e.base_set :=
+begin
+  classical,
+  obtain ⟨ea, hea⟩ : ∃ ea : trivialization F (π F E), a ∈ ea.base_set :=
+    ⟨trivialization_at F E a, mem_base_set_trivialization_at F E a⟩,
+  -- If `a < b`, then `[a, b] = ∅`, and the statement is trivial
+  cases le_or_lt a b with hab hab; [skip, exact ⟨ea, by simp *⟩],
+  /- Let `s` be the set of points `x ∈ [a, b]` such that `E` is trivializable over `[a, x]`.
+  We need to show that `b ∈ s`. Let `c = Sup s`. We will show that `c ∈ s` and `c = b`. -/
+  set s : set B := {x ∈ Icc a b | ∃ e : trivialization F (π F E), Icc a x ⊆ e.base_set},
+  have ha : a ∈ s, from ⟨left_mem_Icc.2 hab, ea, by simp [hea]⟩,
+  have sne : s.nonempty := ⟨a, ha⟩,
+  have hsb : b ∈ upper_bounds s, from λ x hx, hx.1.2,
+  have sbd : bdd_above s := ⟨b, hsb⟩,
+  set c := Sup s,
+  have hsc : is_lub s c, from is_lub_cSup sne sbd,
+  have hc : c ∈ Icc a b, from ⟨hsc.1 ha, hsc.2 hsb⟩,
+  obtain ⟨-, ec : trivialization F (π F E), hec : Icc a c ⊆ ec.base_set⟩ : c ∈ s,
+  { cases hc.1.eq_or_lt with heq hlt, { rwa ← heq },
+    refine ⟨hc, _⟩,
+    /- In order to show that `c ∈ s`, consider a trivialization `ec` of `proj` over a neighborhood
+    of `c`. Its base set includes `(c', c]` for some `c' ∈ [a, c)`. -/
+    obtain ⟨ec, hc⟩ : ∃ ec : trivialization F (π F E), c ∈ ec.base_set :=
+      ⟨trivialization_at F E c, mem_base_set_trivialization_at F E c⟩,
+    obtain ⟨c', hc', hc'e⟩ : ∃ c' ∈ Ico a c, Ioc c' c ⊆ ec.base_set :=
+      (mem_nhds_within_Iic_iff_exists_mem_Ico_Ioc_subset hlt).1
+        (mem_nhds_within_of_mem_nhds $ is_open.mem_nhds ec.open_base_set hc),
+    /- Since `c' < c = Sup s`, there exists `d ∈ s ∩ (c', c]`. Let `ead` be a trivialization of
+    `proj` over `[a, d]`. Then we can glue `ead` and `ec` into a trivialization over `[a, c]`. -/
+    obtain ⟨d, ⟨hdab, ead, had⟩, hd⟩ : ∃ d ∈ s, d ∈ Ioc c' c := hsc.exists_between hc'.2,
+    refine ⟨ead.piecewise_le ec d (had ⟨hdab.1, le_rfl⟩) (hc'e hd), subset_ite.2 _⟩,
+    refine ⟨λ x hx, had ⟨hx.1.1, hx.2⟩, λ x hx, hc'e ⟨hd.1.trans (not_le.1 hx.2), hx.1.2⟩⟩ },
+  /- So, `c ∈ s`. Let `ec` be a trivialization of `proj` over `[a, c]`.  If `c = b`, then we are
+  done. Otherwise we show that `proj` can be trivialized over a larger interval `[a, d]`,
+  `d ∈ (c, b]`, hence `c` is not an upper bound of `s`. -/
+  cases hc.2.eq_or_lt with heq hlt, { exact ⟨ec, heq ▸ hec⟩ },
+  rsuffices ⟨d, hdcb, hd⟩ : ∃ (d ∈ Ioc c b) (e : trivialization F (π F E)), Icc a d ⊆ e.base_set,
+  { exact ((hsc.1 ⟨⟨hc.1.trans hdcb.1.le, hdcb.2⟩, hd⟩).not_lt hdcb.1).elim },
+  /- Since the base set of `ec` is open, it includes `[c, d)` (hence, `[a, d)`) for some
+  `d ∈ (c, b]`. -/
+  obtain ⟨d, hdcb, hd⟩ : ∃ d ∈ Ioc c b, Ico c d ⊆ ec.base_set :=
+    (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hlt).1
+      (mem_nhds_within_of_mem_nhds $ is_open.mem_nhds ec.open_base_set (hec ⟨hc.1, le_rfl⟩)),
+  have had : Ico a d ⊆ ec.base_set,
+    from Ico_subset_Icc_union_Ico.trans (union_subset hec hd),
+  by_cases he : disjoint (Iio d) (Ioi c),
+  { /- If `(c, d) = ∅`, then let `ed` be a trivialization of `proj` over a neighborhood of `d`.
+    Then the disjoint union of `ec` restricted to `(-∞, d)` and `ed` restricted to `(c, ∞)` is
+    a trivialization over `[a, d]`. -/
+    obtain ⟨ed, hed⟩ : ∃ ed : trivialization F (π F E), d ∈ ed.base_set :=
+      ⟨trivialization_at F E d, mem_base_set_trivialization_at F E d⟩,
+    refine ⟨d, hdcb, (ec.restr_open (Iio d) is_open_Iio).disjoint_union
+      (ed.restr_open (Ioi c) is_open_Ioi) (he.mono (inter_subset_right _ _)
+        (inter_subset_right _ _)), λ x hx, _⟩,
+    rcases hx.2.eq_or_lt with rfl|hxd,
+    exacts [or.inr ⟨hed, hdcb.1⟩, or.inl ⟨had ⟨hx.1, hxd⟩, hxd⟩] },
+  { /- If `(c, d)` is nonempty, then take `d' ∈ (c, d)`. Since the base set of `ec` includes
+    `[a, d)`, it includes `[a, d'] ⊆ [a, d)` as well. -/
+    rw [disjoint_left] at he, push_neg at he, rcases he with ⟨d', hdd' : d' < d, hd'c⟩,
+    exact ⟨d', ⟨hd'c, hdd'.le.trans hdcb.2⟩, ec, (Icc_subset_Ico_right hdd').trans had⟩ }
+end
+
+end fiber_bundle
+
+/-! ### Core construction for constructing fiber bundles -/
+
+/-- Core data defining a locally trivial bundle with fiber `F` over a topological
+space `B`. Note that "bundle" is used in its mathematical sense. This is the (computer science)
+bundled version, i.e., all the relevant data is contained in the following structure. A family of
+local trivializations is indexed by a type `ι`, on open subsets `base_set i` for each `i : ι`.
+Trivialization changes from `i` to `j` are given by continuous maps `coord_change i j` from
+`base_set i ∩ base_set j` to the set of homeomorphisms of `F`, but we express them as maps
+`B → F → F` and require continuity on `(base_set i ∩ base_set j) × F` to avoid the topology on the
+space of continuous maps on `F`. -/
+@[nolint has_nonempty_instance]
+structure fiber_bundle_core (ι : Type*) (B : Type*) [topological_space B]
+  (F : Type*) [topological_space F] :=
+(base_set          : ι → set B)
+(is_open_base_set  : ∀ i, is_open (base_set i))
+(index_at          : B → ι)
+(mem_base_set_at   : ∀ x, x ∈ base_set (index_at x))
+(coord_change      : ι → ι → B → F → F)
+(coord_change_self : ∀ i, ∀ x ∈ base_set i, ∀ v, coord_change i i x v = v)
+(continuous_on_coord_change : ∀ i j, continuous_on (λp : B × F, coord_change i j p.1 p.2)
+                                               (((base_set i) ∩ (base_set j)) ×ˢ univ))
+(coord_change_comp : ∀ i j k, ∀ x ∈ (base_set i) ∩ (base_set j) ∩ (base_set k), ∀ v,
+  (coord_change j k x) (coord_change i j x v) = coord_change i k x v)
+
+namespace fiber_bundle_core
+
+variables [topological_space B] [topological_space F] (Z : fiber_bundle_core ι B F)
+
+include Z
+
+/-- The index set of a fiber bundle core, as a convenience function for dot notation -/
+@[nolint unused_arguments has_nonempty_instance]
+def index := ι
+
+/-- The base space of a fiber bundle core, as a convenience function for dot notation -/
+@[nolint unused_arguments, reducible]
+def base := B
+
+/-- The fiber of a fiber bundle core, as a convenience function for dot notation and
+typeclass inference -/
+@[nolint unused_arguments has_nonempty_instance]
+def fiber (x : B) := F
+
+instance topological_space_fiber (x : B) : topological_space (Z.fiber x) :=
+‹topological_space F›
+
+/-- The total space of the fiber bundle, as a convenience function for dot notation.
+It is by definition equal to `bundle.total_space Z.fiber` -/
+@[nolint unused_arguments, reducible]
+def total_space := bundle.total_space F Z.fiber
+
+/-- The projection from the total space of a fiber bundle core, on its base. -/
+@[reducible, simp, mfld_simps] def proj : Z.total_space → B := bundle.total_space.proj
+
+/-- Local homeomorphism version of the trivialization change. -/
+def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
+{ source      := (Z.base_set i ∩ Z.base_set j) ×ˢ univ,
+  target      := (Z.base_set i ∩ Z.base_set j) ×ˢ univ,
+  to_fun      := λp, ⟨p.1, Z.coord_change i j p.1 p.2⟩,
+  inv_fun     := λp, ⟨p.1, Z.coord_change j i p.1 p.2⟩,
+  map_source' := λp hp, by simpa using hp,
+  map_target' := λp hp, by simpa using hp,
+  left_inv'   := begin
+    rintros ⟨x, v⟩ hx,
+    simp only [prod_mk_mem_set_prod_eq, mem_inter_iff, and_true, mem_univ] at hx,
+    rw [Z.coord_change_comp, Z.coord_change_self],
+    { exact hx.1 },
+    { simp [hx] }
+  end,
+  right_inv'  := begin
+    rintros ⟨x, v⟩ hx,
+    simp only [prod_mk_mem_set_prod_eq, mem_inter_iff, and_true, mem_univ] at hx,
+    rw [Z.coord_change_comp, Z.coord_change_self],
+    { exact hx.2 },
+    { simp [hx] },
+  end,
+  open_source :=
+    (is_open.inter (Z.is_open_base_set i) (Z.is_open_base_set j)).prod is_open_univ,
+  open_target :=
+    (is_open.inter (Z.is_open_base_set i) (Z.is_open_base_set j)).prod is_open_univ,
+  continuous_to_fun  :=
+    continuous_on.prod continuous_fst.continuous_on (Z.continuous_on_coord_change i j),
+  continuous_inv_fun := by simpa [inter_comm]
+    using continuous_on.prod continuous_fst.continuous_on (Z.continuous_on_coord_change j i) }
+
+@[simp, mfld_simps] lemma mem_triv_change_source (i j : ι) (p : B × F) :
+  p ∈ (Z.triv_change i j).source ↔ p.1 ∈ Z.base_set i ∩ Z.base_set j :=
+by { erw [mem_prod], simp }
+
+/-- Associate to a trivialization index `i : ι` the corresponding trivialization, i.e., a bijection
+between `proj ⁻¹ (base_set i)` and `base_set i × F`. As the fiber above `x` is `F` but read in the
+chart with index `index_at x`, the trivialization in the fiber above x is by definition the
+coordinate change from i to `index_at x`, so it depends on `x`.
+The local trivialization will ultimately be a local homeomorphism. For now, we only introduce the
+local equiv version, denoted with a prime. In further developments, avoid this auxiliary version,
+and use `Z.local_triv` instead.
+-/
+def local_triv_as_local_equiv (i : ι) : local_equiv Z.total_space (B × F) :=
+{ source      := Z.proj ⁻¹' (Z.base_set i),
+  target      := Z.base_set i ×ˢ univ,
+  inv_fun     := λp, ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩,
+  to_fun      := λp, ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩,
+  map_source' := λp hp,
+    by simpa only [set.mem_preimage, and_true, set.mem_univ, set.prod_mk_mem_set_prod_eq] using hp,
+  map_target' := λp hp,
+    by simpa only [set.mem_preimage, and_true, set.mem_univ, set.mem_prod] using hp,
+  left_inv'   := begin
+    rintros ⟨x, v⟩ hx,
+    change x ∈ Z.base_set i at hx,
+    dsimp only,
+    rw [Z.coord_change_comp, Z.coord_change_self],
+    { exact Z.mem_base_set_at _ },
+    { simp only [hx, mem_inter_iff, and_self, mem_base_set_at] }
+  end,
+  right_inv' := begin
+    rintros ⟨x, v⟩ hx,
+    simp only [prod_mk_mem_set_prod_eq, and_true, mem_univ] at hx,
+    rw [Z.coord_change_comp, Z.coord_change_self],
+    { exact hx },
+    { simp only [hx, mem_inter_iff, and_self, mem_base_set_at] }
+  end }
+
+variable (i : ι)
+
+lemma mem_local_triv_as_local_equiv_source (p : Z.total_space) :
+  p ∈ (Z.local_triv_as_local_equiv i).source ↔ p.1 ∈ Z.base_set i :=
+iff.rfl
+
+lemma mem_local_triv_as_local_equiv_target (p : B × F) :
+  p ∈ (Z.local_triv_as_local_equiv i).target ↔ p.1 ∈ Z.base_set i :=
+by { erw [mem_prod], simp only [and_true, mem_univ] }
+
+lemma local_triv_as_local_equiv_apply (p : Z.total_space) :
+  (Z.local_triv_as_local_equiv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl
+
+/-- The composition of two local trivializations is the trivialization change Z.triv_change i j. -/
+lemma local_triv_as_local_equiv_trans (i j : ι) :
+  (Z.local_triv_as_local_equiv i).symm.trans
+    (Z.local_triv_as_local_equiv j) ≈ (Z.triv_change i j).to_local_equiv :=
+begin
+  split,
+  { ext x, simp only [mem_local_triv_as_local_equiv_target] with mfld_simps, refl, },
+  { rintros ⟨x, v⟩ hx,
+    simp only [triv_change, local_triv_as_local_equiv, local_equiv.symm, true_and, prod.mk.inj_iff,
+      prod_mk_mem_set_prod_eq, local_equiv.trans_source, mem_inter_iff, and_true, mem_preimage,
+      proj, mem_univ, local_equiv.coe_mk, eq_self_iff_true, local_equiv.coe_trans,
+      total_space.proj] at hx ⊢,
+    simp only [Z.coord_change_comp, hx, mem_inter_iff, and_self, mem_base_set_at], }
+end
+
+/-- Topological structure on the total space of a fiber bundle created from core, designed so
+that all the local trivialization are continuous. -/
+instance to_topological_space : topological_space Z.total_space :=
+topological_space.generate_from $ ⋃ (i : ι) (s : set (B × F)) (s_open : is_open s),
+  {(Z.local_triv_as_local_equiv i).source ∩ (Z.local_triv_as_local_equiv i) ⁻¹' s}
+
+variables (b : B) (a : F)
+
+lemma open_source' (i : ι) : is_open (Z.local_triv_as_local_equiv i).source :=
+begin
+  apply topological_space.generate_open.basic,
+  simp only [exists_prop, mem_Union, mem_singleton_iff],
+  refine ⟨i, Z.base_set i ×ˢ univ, (Z.is_open_base_set i).prod is_open_univ, _⟩,
+  ext p,
+  simp only [local_triv_as_local_equiv_apply, prod_mk_mem_set_prod_eq, mem_inter_iff, and_self,
+    mem_local_triv_as_local_equiv_source, and_true, mem_univ, mem_preimage],
+end
+
+/-- Extended version of the local trivialization of a fiber bundle constructed from core,
+registering additionally in its type that it is a local bundle trivialization. -/
+def local_triv (i : ι) : trivialization F Z.proj :=
+{ base_set      := Z.base_set i,
+  open_base_set := Z.is_open_base_set i,
+  source_eq     := rfl,
+  target_eq     := rfl,
+  proj_to_fun   := λ p hp, by { simp only with mfld_simps, refl },
+  open_source := Z.open_source' i,
+  open_target := (Z.is_open_base_set i).prod is_open_univ,
+  continuous_to_fun := begin
+    rw continuous_on_open_iff (Z.open_source' i),
+    assume s s_open,
+    apply topological_space.generate_open.basic,
+    simp only [exists_prop, mem_Union, mem_singleton_iff],
+    exact ⟨i, s, s_open, rfl⟩
+  end,
+  continuous_inv_fun := begin
+    apply continuous_on_open_of_generate_from ((Z.is_open_base_set i).prod is_open_univ),
+    assume t ht,
+    simp only [exists_prop, mem_Union, mem_singleton_iff] at ht,
+    obtain ⟨j, s, s_open, ts⟩ : ∃ j s, is_open s ∧ t =
+      (local_triv_as_local_equiv Z j).source ∩ (local_triv_as_local_equiv Z j) ⁻¹' s := ht,
+    rw ts,
+    simp only [local_equiv.right_inv, preimage_inter, local_equiv.left_inv],
+    let e := Z.local_triv_as_local_equiv i,
+    let e' := Z.local_triv_as_local_equiv j,
+    let f := e.symm.trans e',
+    have : is_open (f.source ∩ f ⁻¹' s),
+    { rw [(Z.local_triv_as_local_equiv_trans i j).source_inter_preimage_eq],
+      exact (continuous_on_open_iff (Z.triv_change i j).open_source).1
+        ((Z.triv_change i j).continuous_on) _ s_open },
+    convert this using 1,
+    dsimp [local_equiv.trans_source],
+    rw [← preimage_comp, inter_assoc],
+    refl,
+  end,
+  to_local_equiv := Z.local_triv_as_local_equiv i }
+
+/-- Preferred local trivialization of a fiber bundle constructed from core, at a given point, as
+a bundle trivialization -/
+def local_triv_at (b : B) : trivialization F (π F Z.fiber) :=
+Z.local_triv (Z.index_at b)
+
+@[simp, mfld_simps] lemma local_triv_at_def (b : B) :
+  Z.local_triv (Z.index_at b) = Z.local_triv_at b := rfl
+
+/-- If an element of `F` is invariant under all coordinate changes, then one can define a
+corresponding section of the fiber bundle, which is continuous. This applies in particular to the
+zero section of a vector bundle. Another example (not yet defined) would be the identity
+section of the endomorphism bundle of a vector bundle. -/
+lemma continuous_const_section (v : F)
+  (h : ∀ i j, ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j), Z.coord_change i j x v = v) :
+  continuous (show B → Z.total_space, from λ x, ⟨x, v⟩) :=
+begin
+  apply continuous_iff_continuous_at.2 (λ x, _),
+  have A : Z.base_set (Z.index_at x) ∈ 𝓝 x :=
+    is_open.mem_nhds (Z.is_open_base_set (Z.index_at x)) (Z.mem_base_set_at x),
+  apply ((Z.local_triv_at x).to_local_homeomorph.continuous_at_iff_continuous_at_comp_left _).2,
+  { simp only [(∘)] with mfld_simps,
+    apply continuous_at_id.prod,
+    have : continuous_on (λ (y : B), v) (Z.base_set (Z.index_at x)) := continuous_on_const,
+    apply (this.congr _).continuous_at A,
+    assume y hy,
+    simp only [h, hy, mem_base_set_at] with mfld_simps },
+  { exact A }
+end
+
+@[simp, mfld_simps] lemma local_triv_as_local_equiv_coe :
+  ⇑(Z.local_triv_as_local_equiv i) = Z.local_triv i := rfl
+
+@[simp, mfld_simps] lemma local_triv_as_local_equiv_source :
+  (Z.local_triv_as_local_equiv i).source = (Z.local_triv i).source := rfl
+
+@[simp, mfld_simps] lemma local_triv_as_local_equiv_target :
+  (Z.local_triv_as_local_equiv i).target = (Z.local_triv i).target := rfl
+
+@[simp, mfld_simps] lemma local_triv_as_local_equiv_symm :
+  (Z.local_triv_as_local_equiv i).symm = (Z.local_triv i).to_local_equiv.symm := rfl
+
+@[simp, mfld_simps] lemma base_set_at : Z.base_set i = (Z.local_triv i).base_set := rfl
+
+@[simp, mfld_simps] lemma local_triv_apply (p : Z.total_space) :
+  (Z.local_triv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl
+
+@[simp, mfld_simps] lemma local_triv_at_apply (p : Z.total_space) :
+  ((Z.local_triv_at p.1) p) = ⟨p.1, p.2⟩ :=
+by { rw [local_triv_at, local_triv_apply, coord_change_self], exact Z.mem_base_set_at p.1 }
+
+@[simp, mfld_simps] lemma local_triv_at_apply_mk (b : B) (a : F) :
+  ((Z.local_triv_at b) ⟨b, a⟩) = ⟨b, a⟩ :=
+Z.local_triv_at_apply _
+
+@[simp, mfld_simps] lemma mem_local_triv_source (p : Z.total_space) :
+  p ∈ (Z.local_triv i).source ↔ p.1 ∈ (Z.local_triv i).base_set := iff.rfl
+
+@[simp, mfld_simps] lemma mem_local_triv_at_source (p : Z.total_space) (b : B) :
+  p ∈ (Z.local_triv_at b).source ↔ p.1 ∈ (Z.local_triv_at b).base_set := iff.rfl
+
+@[simp, mfld_simps] lemma mem_source_at : (⟨b, a⟩ : Z.total_space) ∈ (Z.local_triv_at b).source :=
+by { rw [local_triv_at, mem_local_triv_source], exact Z.mem_base_set_at b }
+
+@[simp, mfld_simps] lemma mem_local_triv_target (p : B × F) :
+  p ∈ (Z.local_triv i).target ↔ p.1 ∈ (Z.local_triv i).base_set :=
+trivialization.mem_target _
+
+@[simp, mfld_simps] lemma mem_local_triv_at_target (p : B × F) (b : B) :
+  p ∈ (Z.local_triv_at b).target ↔ p.1 ∈ (Z.local_triv_at b).base_set :=
+trivialization.mem_target _
+
+@[simp, mfld_simps] lemma local_triv_symm_apply (p : B × F) :
+  (Z.local_triv i).to_local_homeomorph.symm p =
+    ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩ := rfl
+
+@[simp, mfld_simps] lemma mem_local_triv_at_base_set (b : B) :
+  b ∈ (Z.local_triv_at b).base_set :=
+by { rw [local_triv_at, ←base_set_at], exact Z.mem_base_set_at b, }
+
+/-- The inclusion of a fiber into the total space is a continuous map. -/
+@[continuity]
+lemma continuous_total_space_mk (b : B) :
+  continuous (total_space.mk b : Z.fiber b → Z.total_space) :=
+begin
+  rw [continuous_iff_le_induced, fiber_bundle_core.to_topological_space],
+  apply le_induced_generate_from,
+  simp only [mem_Union, mem_singleton_iff, local_triv_as_local_equiv_source,
+    local_triv_as_local_equiv_coe],
+  rintros s ⟨i, t, ht, rfl⟩,
+  rw [←((Z.local_triv i).source_inter_preimage_target_inter t), preimage_inter, ←preimage_comp,
+    trivialization.source_eq],
+  apply is_open.inter,
+  { simp only [total_space.proj, proj, ←preimage_comp],
+    by_cases (b ∈ (Z.local_triv i).base_set),
+    { rw preimage_const_of_mem h, exact is_open_univ, },
+    { rw preimage_const_of_not_mem h, exact is_open_empty, }},
+  { simp only [function.comp, local_triv_apply],
+    rw [preimage_inter, preimage_comp],
+    by_cases (b ∈ Z.base_set i),
+    { have hc : continuous (λ (x : Z.fiber b), (Z.coord_change (Z.index_at b) i b) x),
+        from (Z.continuous_on_coord_change (Z.index_at b) i).comp_continuous
+          (continuous_const.prod_mk continuous_id) (λ x, ⟨⟨Z.mem_base_set_at b, h⟩, mem_univ x⟩),
+      exact (((Z.local_triv i).open_target.inter ht).preimage (continuous.prod.mk b)).preimage hc },
+    { rw [(Z.local_triv i).target_eq, ←base_set_at, mk_preimage_prod_right_eq_empty h,
+        preimage_empty, empty_inter],
+      exact is_open_empty, }}
+end
+
+/-- A fiber bundle constructed from core is indeed a fiber bundle. -/
+instance fiber_bundle : fiber_bundle F Z.fiber :=
+{ total_space_mk_inducing := λ b, ⟨ begin refine le_antisymm _ (λ s h, _),
+    { rw ←continuous_iff_le_induced,
+      exact continuous_total_space_mk Z b, },
+    { refine is_open_induced_iff.mpr ⟨(Z.local_triv_at b).source ∩ (Z.local_triv_at b) ⁻¹'
+        ((Z.local_triv_at b).base_set ×ˢ s), (continuous_on_open_iff
+        (Z.local_triv_at b).open_source).mp (Z.local_triv_at b).continuous_to_fun _
+        ((Z.local_triv_at b).open_base_set.prod h), _⟩,
+      rw [preimage_inter, ←preimage_comp, function.comp],
+      refine ext_iff.mpr (λ a, ⟨λ ha, _, λ ha, ⟨Z.mem_base_set_at b, _⟩⟩),
+      { simp only [mem_prod, mem_preimage, mem_inter_iff, local_triv_at_apply_mk] at ha,
+        exact ha.2.2, },
+      { simp only [mem_prod, mem_preimage, mem_inter_iff, local_triv_at_apply_mk],
+        exact ⟨Z.mem_base_set_at b, ha⟩, } } end⟩,
+  trivialization_atlas := set.range Z.local_triv,
+  trivialization_at := Z.local_triv_at,
+  mem_base_set_trivialization_at := Z.mem_base_set_at,
+  trivialization_mem_atlas := λ b, ⟨Z.index_at b, rfl⟩ }
+
+/-- The projection on the base of a fiber bundle created from core is continuous -/
+lemma continuous_proj : continuous Z.proj := continuous_proj F Z.fiber
+
+/-- The projection on the base of a fiber bundle created from core is an open map -/
+lemma is_open_map_proj : is_open_map Z.proj := is_open_map_proj F Z.fiber
+
+end fiber_bundle_core
+
+/-! ### Prebundle construction for constructing fiber bundles -/
+
+variables (F) (E : B → Type*) [topological_space B] [topological_space F]
+  [Π x, topological_space (E x)]
+
+/-- This structure permits to define a fiber bundle when trivializations are given as local
+equivalences but there is not yet a topology on the total space. The total space is hence given a
+topology in such a way that there is a fiber bundle structure for which the local equivalences
+are also local homeomorphism and hence local trivializations. -/
+@[nolint has_nonempty_instance]
+structure fiber_prebundle :=
+(pretrivialization_atlas : set (pretrivialization F (π F E)))
+(pretrivialization_at : B → pretrivialization F (π F E))
+(mem_base_pretrivialization_at : ∀ x : B, x ∈ (pretrivialization_at x).base_set)
+(pretrivialization_mem_atlas : ∀ x : B, pretrivialization_at x ∈ pretrivialization_atlas)
+(continuous_triv_change : ∀ e e' ∈ pretrivialization_atlas,
+  continuous_on (e ∘ e'.to_local_equiv.symm) (e'.target ∩ (e'.to_local_equiv.symm ⁻¹' e.source)))
+(total_space_mk_inducing : ∀ (b : B), inducing ((pretrivialization_at b) ∘ (total_space.mk b)))
+
+namespace fiber_prebundle
+
+variables {F E} (a : fiber_prebundle F E) {e : pretrivialization F (π F E)}
+
+/-- Topology on the total space that will make the prebundle into a bundle. -/
+def total_space_topology (a : fiber_prebundle F E) : topological_space (total_space F E) :=
+⨆ (e : pretrivialization F (π F E)) (he : e ∈ a.pretrivialization_atlas),
+  coinduced e.set_symm (subtype.topological_space)
+
+lemma continuous_symm_of_mem_pretrivialization_atlas (he : e ∈ a.pretrivialization_atlas) :
+  @continuous_on _ _ _ a.total_space_topology
+  e.to_local_equiv.symm e.target :=
+begin
+  refine id (λ z H, id (λ U h, preimage_nhds_within_coinduced' H
+    e.open_target (le_def.1 (nhds_mono _) U h))),
+  exact le_supr₂ e he,
+end
+
+lemma is_open_source (e : pretrivialization F (π F E)) : is_open[a.total_space_topology] e.source :=
+begin
+  letI := a.total_space_topology,
+  refine is_open_supr_iff.mpr (λ e', _),
+  refine is_open_supr_iff.mpr (λ he', _),
+  refine is_open_coinduced.mpr (is_open_induced_iff.mpr ⟨e.target, e.open_target, _⟩),
+  rw [pretrivialization.set_symm, restrict, e.target_eq,
+    e.source_eq, preimage_comp, subtype.preimage_coe_eq_preimage_coe_iff,
+    e'.target_eq, prod_inter_prod, inter_univ,
+    pretrivialization.preimage_symm_proj_inter],
+end
+
+lemma is_open_target_of_mem_pretrivialization_atlas_inter (e e' : pretrivialization F (π F E))
+  (he' : e' ∈ a.pretrivialization_atlas) :
+  is_open (e'.to_local_equiv.target ∩ e'.to_local_equiv.symm ⁻¹' e.source) :=
+begin
+  letI := a.total_space_topology,
+  obtain ⟨u, hu1, hu2⟩ := continuous_on_iff'.mp (a.continuous_symm_of_mem_pretrivialization_atlas
+    he') e.source (a.is_open_source e),
+  rw [inter_comm, hu2],
+  exact hu1.inter e'.open_target,
+end
+
+/-- Promotion from a `pretrivialization` to a `trivialization`. -/
+def trivialization_of_mem_pretrivialization_atlas (he : e ∈ a.pretrivialization_atlas) :
+  @trivialization B F _ _ _ a.total_space_topology (π F E) :=
+{ open_source := a.is_open_source e,
+  continuous_to_fun := begin
+    letI := a.total_space_topology,
+    refine continuous_on_iff'.mpr (λ s hs, ⟨e ⁻¹' s ∩ e.source, (is_open_supr_iff.mpr (λ e', _)),
+      by { rw [inter_assoc, inter_self], refl }⟩),
+    refine (is_open_supr_iff.mpr (λ he', _)),
+    rw [is_open_coinduced, is_open_induced_iff],
+    obtain ⟨u, hu1, hu2⟩ := continuous_on_iff'.mp (a.continuous_triv_change _ he _ he') s hs,
+    have hu3 := congr_arg (λ s, (λ x : e'.target, (x : B × F)) ⁻¹' s) hu2,
+    simp only [subtype.coe_preimage_self, preimage_inter, univ_inter] at hu3,
+    refine ⟨u ∩ e'.to_local_equiv.target ∩
+      (e'.to_local_equiv.symm ⁻¹' e.source), _, by
+      { simp only [preimage_inter, inter_univ, subtype.coe_preimage_self, hu3.symm], refl }⟩,
+    rw inter_assoc,
+    exact hu1.inter (a.is_open_target_of_mem_pretrivialization_atlas_inter e e' he'),
+  end,
+  continuous_inv_fun := a.continuous_symm_of_mem_pretrivialization_atlas he,
+  .. e }
+
+lemma mem_trivialization_at_source (b : B) (x : E b) :
+  total_space.mk b x ∈ (a.pretrivialization_at b).source :=
+begin
+  simp only [(a.pretrivialization_at b).source_eq, mem_preimage, total_space.proj],
+  exact a.mem_base_pretrivialization_at b,
+end
+
+@[simp] lemma total_space_mk_preimage_source (b : B) :
+  total_space.mk b ⁻¹' (a.pretrivialization_at b).source = univ :=
+begin
+  apply eq_univ_of_univ_subset,
+  rw [(a.pretrivialization_at b).source_eq, ←preimage_comp, function.comp],
+  simp only [total_space.proj],
+  rw preimage_const_of_mem _,
+  exact a.mem_base_pretrivialization_at b,
+end
+
+@[continuity] lemma continuous_total_space_mk (b : B) :
+  @continuous _ _ _ a.total_space_topology (total_space.mk b) :=
+begin
+  letI := a.total_space_topology,
+  let e := a.trivialization_of_mem_pretrivialization_atlas (a.pretrivialization_mem_atlas b),
+  rw e.to_local_homeomorph.continuous_iff_continuous_comp_left
+    (a.total_space_mk_preimage_source b),
+  exact continuous_iff_le_induced.mpr (le_antisymm_iff.mp (a.total_space_mk_inducing b).induced).1,
+end
+
+lemma inducing_total_space_mk_of_inducing_comp (b : B)
+  (h : inducing ((a.pretrivialization_at b) ∘ (total_space.mk b))) :
+  @inducing _ _ _ a.total_space_topology (total_space.mk b) :=
+begin
+  letI := a.total_space_topology,
+  rw ←restrict_comp_cod_restrict (a.mem_trivialization_at_source b) at h,
+  apply inducing.of_cod_restrict (a.mem_trivialization_at_source b),
+  refine inducing_of_inducing_compose _ (continuous_on_iff_continuous_restrict.mp
+    (a.trivialization_of_mem_pretrivialization_atlas
+    (a.pretrivialization_mem_atlas b)).continuous_to_fun) h,
+  exact (a.continuous_total_space_mk b).cod_restrict (a.mem_trivialization_at_source b),
+end
+
+/-- Make a `fiber_bundle` from a `fiber_prebundle`.  Concretely this means
+that, given a `fiber_prebundle` structure for a sigma-type `E` -- which consists of a
+number of "pretrivializations" identifying parts of `E` with product spaces `U × F` -- one
+establishes that for the topology constructed on the sigma-type using
+`fiber_prebundle.total_space_topology`, these "pretrivializations" are actually
+"trivializations" (i.e., homeomorphisms with respect to the constructed topology). -/
+def to_fiber_bundle :
+  @fiber_bundle B F _ _ E a.total_space_topology _ :=
+{ total_space_mk_inducing := λ b, a.inducing_total_space_mk_of_inducing_comp b
+    (a.total_space_mk_inducing b),
+  trivialization_atlas := {e | ∃ e₀ (he₀ : e₀ ∈ a.pretrivialization_atlas),
+    e = a.trivialization_of_mem_pretrivialization_atlas he₀},
+  trivialization_at := λ x, a.trivialization_of_mem_pretrivialization_atlas
+    (a.pretrivialization_mem_atlas x),
+  mem_base_set_trivialization_at := a.mem_base_pretrivialization_at,
+  trivialization_mem_atlas := λ x, ⟨_, a.pretrivialization_mem_atlas x, rfl⟩ }
+
+lemma continuous_proj : @continuous _ _ a.total_space_topology _ (π F E) :=
+begin
+  letI := a.total_space_topology,
+  letI := a.to_fiber_bundle,
+  exact continuous_proj F E,
+end
+
+/-- For a fiber bundle `E` over `B` constructed using the `fiber_prebundle` mechanism,
+continuity of a function `total_space F E → X` on an open set `s` can be checked by precomposing at
+each point with the pretrivialization used for the construction at that point. -/
+lemma continuous_on_of_comp_right {X : Type*} [topological_space X] {f : total_space F E → X}
+  {s : set B} (hs : is_open s)
+  (hf : ∀ b ∈ s, continuous_on (f ∘ (a.pretrivialization_at b).to_local_equiv.symm)
+    ((s ∩ (a.pretrivialization_at b).base_set) ×ˢ (set.univ : set F))) :
+  @continuous_on _ _ a.total_space_topology _ f ((π F E) ⁻¹' s) :=
+begin
+  letI := a.total_space_topology,
+  intros z hz,
+  let e : trivialization F (π F E) :=
+  a.trivialization_of_mem_pretrivialization_atlas (a.pretrivialization_mem_atlas z.proj),
+  refine (e.continuous_at_of_comp_right _
+    ((hf z.proj hz).continuous_at (is_open.mem_nhds _ _))).continuous_within_at,
+  { exact a.mem_base_pretrivialization_at z.proj },
+  { exact ((hs.inter (a.pretrivialization_at z.proj).open_base_set).prod is_open_univ) },
+  refine ⟨_, mem_univ _⟩,
+  rw e.coe_fst,
+  { exact ⟨hz, a.mem_base_pretrivialization_at z.proj⟩ },
+  { rw e.mem_source,
+    exact a.mem_base_pretrivialization_at z.proj },
+end
+
+end fiber_prebundle
diff --git a/src/topology/fiber_bundle/constructions.lean b/src/topology/fiber_bundle/constructions.lean
new file mode 100644
index 0000000000000..a4d859c6166d3
--- /dev/null
+++ b/src/topology/fiber_bundle/constructions.lean
@@ -0,0 +1,369 @@
+/-
+Copyright © 2022 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Sébastien Gouëzel, Heather Macbeth, Floris van Doorn
+-/
+import topology.fiber_bundle.basic
+
+/-!
+# Standard constructions on fiber bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains several standard constructions on fiber bundles:
+
+* `bundle.trivial.fiber_bundle 𝕜 B F`: the trivial fiber bundle with model fiber `F` over the base
+  `B`
+
+* `fiber_bundle.prod`: for fiber bundles `E₁` and `E₂` over a common base, a fiber bundle structure
+  on their fiberwise product `E₁ ×ᵇ E₂` (the notation stands for `λ x, E₁ x × E₂ x`).
+
+* `fiber_bundle.pullback`: for a fiber bundle `E` over `B`, a fiber bundle structure on its
+  pullback `f *ᵖ E` by a map `f : B' → B` (the notation is a type synonym for `E ∘ f`).
+
+## Tags
+
+fiber bundle, fibre bundle, fiberwise product, pullback
+
+-/
+open topological_space filter set bundle
+open_locale topology classical bundle
+
+/-! ### The trivial bundle -/
+
+namespace bundle
+namespace trivial
+
+variables (B : Type*) (F : Type*)
+
+instance [t₁ : topological_space B] [t₂ : topological_space F] :
+  topological_space (total_space F (trivial B F)) :=
+induced total_space.proj t₁ ⊓ induced (total_space.trivial_snd B F) t₂
+
+variables [topological_space B] [topological_space F]
+
+/-- Local trivialization for trivial bundle. -/
+def trivialization : trivialization F (π F (λ _ : B, F)) :=
+{ to_fun := λ x, (x.proj, x.snd),
+  inv_fun := λ y, ⟨y.fst, y.snd⟩,
+  source := univ,
+  target := univ,
+  map_source' := λ x h, mem_univ _,
+  map_target' := λ y h, mem_univ _,
+  left_inv' := λ x h, total_space.ext _ _ rfl heq.rfl,
+  right_inv' := λ x h, prod.ext rfl rfl,
+  open_source := is_open_univ,
+  open_target := is_open_univ,
+  continuous_to_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
+    simp only [prod.topological_space, induced_inf, induced_compose], exact le_rfl, },
+  continuous_inv_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
+    simp only [bundle.total_space.topological_space, induced_inf, induced_compose],
+    exact le_rfl, },
+  base_set := univ,
+  open_base_set := is_open_univ,
+  source_eq := rfl,
+  target_eq := by simp only [univ_prod_univ],
+  proj_to_fun := λ y hy, rfl }
+
+@[simp]
+lemma trivialization_source : (trivialization B F).source = univ := rfl
+
+@[simp]
+lemma trivialization_target : (trivialization B F).target = univ := rfl
+
+/-- Fiber bundle instance on the trivial bundle. -/
+instance fiber_bundle : fiber_bundle F (bundle.trivial B F) :=
+{ trivialization_atlas := {bundle.trivial.trivialization B F},
+  trivialization_at := λ x, bundle.trivial.trivialization B F,
+  mem_base_set_trivialization_at := mem_univ,
+  trivialization_mem_atlas := λ x, mem_singleton _,
+  total_space_mk_inducing := λ b, ⟨begin
+    have : (λ (x : trivial B F b), x) = @id F, by { ext x, refl },
+    simp only [total_space.topological_space, induced_inf, induced_compose, function.comp,
+      induced_const, top_inf_eq, total_space.trivial_snd, id.def, this, induced_id],
+  end⟩ }
+
+lemma eq_trivialization (e : _root_.trivialization F (π F (bundle.trivial B F)))
+  [i : mem_trivialization_atlas e] :
+  e = trivialization B F :=
+i.out
+
+end trivial
+end bundle
+
+/-! ### Fibrewise product of two bundles -/
+
+section prod
+
+variables {B : Type*}
+
+section defs
+variables (F₁ : Type*) (E₁ : B → Type*) (F₂ : Type*) (E₂ : B → Type*)
+variables [topological_space (total_space F₁ E₁)] [topological_space (total_space F₂ E₂)]
+
+/-- Equip the total space of the fiberwise product of two fiber bundles `E₁`, `E₂` with
+the induced topology from the diagonal embedding into `total_space E₁ × total_space E₂`. -/
+instance fiber_bundle.prod.topological_space :
+  topological_space (total_space (F₁ × F₂) (E₁ ×ᵇ E₂)) :=
+topological_space.induced
+  (λ p, ((⟨p.1, p.2.1⟩ : total_space F₁ E₁), (⟨p.1, p.2.2⟩ : total_space F₂ E₂)))
+  (by apply_instance : topological_space (total_space F₁ E₁ × total_space F₂ E₂))
+
+/-- The diagonal map from the total space of the fiberwise product of two fiber bundles
+`E₁`, `E₂` into `total_space E₁ × total_space E₂` is `inducing`. -/
+lemma fiber_bundle.prod.inducing_diag : inducing
+  (λ p, (⟨p.1, p.2.1⟩, ⟨p.1, p.2.2⟩) :
+    total_space (F₁ × F₂) (E₁ ×ᵇ E₂) → total_space F₁ E₁ × total_space F₂ E₂) :=
+⟨rfl⟩
+
+end defs
+
+open fiber_bundle
+
+variables [topological_space B]
+  (F₁ : Type*) [topological_space F₁] (E₁ : B → Type*) [topological_space (total_space F₁ E₁)]
+  (F₂ : Type*) [topological_space F₂] (E₂ : B → Type*) [topological_space (total_space F₂ E₂)]
+
+namespace trivialization
+variables {F₁ E₁ F₂ E₂} (e₁ : trivialization F₁ (π F₁ E₁)) (e₂ : trivialization F₂ (π F₂ E₂))
+
+/-- Given trivializations `e₁`, `e₂` for fiber bundles `E₁`, `E₂` over a base `B`, the forward
+function for the construction `trivialization.prod`, the induced
+trivialization for the fiberwise product of `E₁` and `E₂`. -/
+def prod.to_fun' : total_space (F₁ × F₂) (E₁ ×ᵇ E₂) → B × (F₁ × F₂) :=
+λ p, ⟨p.1, (e₁ ⟨p.1, p.2.1⟩).2, (e₂ ⟨p.1, p.2.2⟩).2⟩
+
+variables {e₁ e₂}
+
+lemma prod.continuous_to_fun :
+  continuous_on (prod.to_fun' e₁ e₂) (π (F₁ × F₂) (E₁ ×ᵇ E₂) ⁻¹' (e₁.base_set ∩ e₂.base_set)) :=
+begin
+  let f₁ : total_space (F₁ × F₂) (E₁ ×ᵇ E₂) → total_space F₁ E₁ × total_space F₂ E₂ :=
+    λ p, ((⟨p.1, p.2.1⟩ : total_space F₁ E₁), (⟨p.1, p.2.2⟩ : total_space F₂ E₂)),
+  let f₂ : total_space F₁ E₁ × total_space F₂ E₂ → (B × F₁) × (B × F₂) := λ p, ⟨e₁ p.1, e₂ p.2⟩,
+  let f₃ : (B × F₁) × (B × F₂) → B × F₁ × F₂ := λ p, ⟨p.1.1, p.1.2, p.2.2⟩,
+  have hf₁ : continuous f₁ := (prod.inducing_diag F₁ E₁ F₂ E₂).continuous,
+  have hf₂ : continuous_on f₂ (e₁.source ×ˢ e₂.source) :=
+    e₁.to_local_homeomorph.continuous_on.prod_map e₂.to_local_homeomorph.continuous_on,
+  have hf₃ : continuous f₃ :=
+    (continuous_fst.comp continuous_fst).prod_mk (continuous_snd.prod_map continuous_snd),
+  refine ((hf₃.comp_continuous_on hf₂).comp hf₁.continuous_on _).congr _,
+  { rw [e₁.source_eq, e₂.source_eq],
+    exact maps_to_preimage _ _ },
+  rintros ⟨b, v₁, v₂⟩ ⟨hb₁, hb₂⟩,
+  simp only [prod.to_fun', prod.mk.inj_iff, eq_self_iff_true, and_true],
+  rw e₁.coe_fst,
+  rw [e₁.source_eq, mem_preimage],
+  exact hb₁,
+end
+
+variables (e₁ e₂) [Π x, has_zero (E₁ x)] [∀ x, has_zero (E₂ x)]
+
+/-- Given trivializations `e₁`, `e₂` for fiber bundles `E₁`, `E₂` over a base `B`, the inverse
+function for the construction `trivialization.prod`, the induced
+trivialization for the fiberwise product of `E₁` and `E₂`. -/
+noncomputable def prod.inv_fun' (p : B × (F₁ × F₂)) : total_space (F₁ × F₂) (E₁ ×ᵇ E₂) :=
+⟨p.1, e₁.symm p.1 p.2.1, e₂.symm p.1 p.2.2⟩
+
+variables {e₁ e₂}
+
+lemma prod.left_inv {x : total_space (F₁ × F₂) (E₁ ×ᵇ E₂)}
+  (h : x ∈ π (F₁ × F₂) (E₁ ×ᵇ E₂) ⁻¹' (e₁.base_set ∩ e₂.base_set)) :
+  prod.inv_fun' e₁ e₂ (prod.to_fun' e₁ e₂ x) = x :=
+begin
+  obtain ⟨x, v₁, v₂⟩ := x,
+  obtain ⟨h₁ : x ∈ e₁.base_set, h₂ : x ∈ e₂.base_set⟩ := h,
+  simp only [prod.to_fun', prod.inv_fun', symm_apply_apply_mk, h₁, h₂,
+    eq_self_iff_true, heq_iff_eq, and_self]
+end
+
+lemma prod.right_inv {x : B × F₁ × F₂}
+  (h : x ∈ (e₁.base_set ∩ e₂.base_set) ×ˢ (univ : set (F₁ × F₂))) :
+  prod.to_fun' e₁ e₂ (prod.inv_fun' e₁ e₂ x) = x :=
+begin
+  obtain ⟨x, w₁, w₂⟩ := x,
+  obtain ⟨⟨h₁ : x ∈ e₁.base_set, h₂ : x ∈ e₂.base_set⟩, -⟩ := h,
+  simp only [prod.to_fun', prod.inv_fun', apply_mk_symm, h₁, h₂]
+end
+
+lemma prod.continuous_inv_fun :
+  continuous_on (prod.inv_fun' e₁ e₂) ((e₁.base_set ∩ e₂.base_set) ×ˢ univ) :=
+begin
+  rw (prod.inducing_diag F₁ E₁ F₂ E₂).continuous_on_iff,
+  have H₁ : continuous (λ p : B × F₁ × F₂, ((p.1, p.2.1), (p.1, p.2.2))) :=
+    (continuous_id.prod_map continuous_fst).prod_mk (continuous_id.prod_map continuous_snd),
+  refine (e₁.continuous_on_symm.prod_map e₂.continuous_on_symm).comp H₁.continuous_on _,
+  exact λ x h, ⟨⟨h.1.1, mem_univ _⟩, ⟨h.1.2, mem_univ _⟩⟩
+end
+
+variables (e₁ e₂)
+
+/-- Given trivializations `e₁`, `e₂` for bundle types `E₁`, `E₂` over a base `B`, the induced
+trivialization for the fiberwise product of `E₁` and `E₂`, whose base set is
+`e₁.base_set ∩ e₂.base_set`. -/
+noncomputable def prod : trivialization (F₁ × F₂) (π (F₁ × F₂) (E₁ ×ᵇ E₂)) :=
+{ to_fun := prod.to_fun' e₁ e₂,
+  inv_fun := prod.inv_fun' e₁ e₂,
+  source := (π (F₁ × F₂) (E₁ ×ᵇ E₂)) ⁻¹' (e₁.base_set ∩ e₂.base_set),
+  target := (e₁.base_set ∩ e₂.base_set) ×ˢ set.univ,
+  map_source' := λ x h, ⟨h, set.mem_univ _⟩,
+  map_target' := λ x h, h.1,
+  left_inv' := λ x, prod.left_inv,
+  right_inv' := λ x, prod.right_inv,
+  open_source := begin
+    convert (e₁.open_source.prod e₂.open_source).preimage
+      (fiber_bundle.prod.inducing_diag F₁ E₁ F₂ E₂).continuous,
+    ext x,
+    simp only [trivialization.source_eq] with mfld_simps,
+  end,
+  open_target := (e₁.open_base_set.inter e₂.open_base_set).prod is_open_univ,
+  continuous_to_fun := prod.continuous_to_fun,
+  continuous_inv_fun := prod.continuous_inv_fun,
+  base_set := e₁.base_set ∩ e₂.base_set,
+  open_base_set := e₁.open_base_set.inter e₂.open_base_set,
+  source_eq := rfl,
+  target_eq := rfl,
+  proj_to_fun := λ x h, rfl }
+
+@[simp] lemma base_set_prod : (prod e₁ e₂).base_set = e₁.base_set ∩ e₂.base_set :=
+rfl
+
+lemma prod_symm_apply (x : B) (w₁ : F₁) (w₂ : F₂) :
+  (prod e₁ e₂).to_local_equiv.symm (x, w₁, w₂) = ⟨x, e₁.symm x w₁, e₂.symm x w₂⟩ :=
+rfl
+
+end trivialization
+
+open trivialization
+
+variables [Π x, has_zero (E₁ x)] [∀ x, has_zero (E₂ x)]
+  [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
+  [fiber_bundle F₁ E₁] [fiber_bundle F₂ E₂]
+
+/-- The product of two fiber bundles is a fiber bundle. -/
+noncomputable instance fiber_bundle.prod : fiber_bundle (F₁ × F₂) (E₁ ×ᵇ E₂) :=
+{ total_space_mk_inducing := λ b,
+  begin
+    rw (prod.inducing_diag F₁ E₁ F₂ E₂).inducing_iff,
+    exact (total_space_mk_inducing F₁ E₁ b).prod_mk (total_space_mk_inducing F₂ E₂ b),
+  end,
+  trivialization_atlas :=
+    {e |  ∃ (e₁ : trivialization F₁ (π F₁ E₁)) (e₂ : trivialization F₂ (π F₂ E₂))
+    [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₂], by exactI
+    e = trivialization.prod e₁ e₂},
+  trivialization_at := λ b, (trivialization_at F₁ E₁ b).prod (trivialization_at F₂ E₂ b),
+  mem_base_set_trivialization_at :=
+    λ b, ⟨mem_base_set_trivialization_at F₁ E₁ b, mem_base_set_trivialization_at F₂ E₂ b⟩,
+  trivialization_mem_atlas := λ b, ⟨trivialization_at F₁ E₁ b, trivialization_at F₂ E₂ b,
+    by apply_instance, by apply_instance, rfl⟩ }
+
+instance {e₁ : trivialization F₁ (π F₁ E₁)} {e₂ : trivialization F₂ (π F₂ E₂)}
+  [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₂] :
+  mem_trivialization_atlas (e₁.prod e₂ : trivialization (F₁ × F₂) (π (F₁ × F₂) (E₁ ×ᵇ E₂))) :=
+{ out := ⟨e₁, e₂, by apply_instance, by apply_instance, rfl⟩ }
+
+end prod
+
+/-! ### Pullbacks of fiber bundles -/
+
+section
+variables {B : Type*} (F : Type*) (E : B → Type*) {B' : Type*} (f : B' → B)
+
+instance [∀ (x : B), topological_space (E x)] : ∀ (x : B'), topological_space ((f *ᵖ E) x) :=
+by delta_instance bundle.pullback
+
+variables [topological_space B'] [topological_space (total_space F E)]
+
+/-- Definition of `pullback.total_space.topological_space`, which we make irreducible. -/
+@[irreducible] def pullback_topology : topological_space (total_space F (f *ᵖ E)) :=
+induced total_space.proj ‹topological_space B'› ⊓
+induced (pullback.lift f) ‹topological_space (total_space F E)›
+
+/-- The topology on the total space of a pullback bundle is the coarsest topology for which both
+the projections to the base and the map to the original bundle are continuous. -/
+instance pullback.total_space.topological_space : topological_space (total_space F (f *ᵖ E)) :=
+pullback_topology F E f
+
+lemma pullback.continuous_proj (f : B' → B) : continuous (π F (f *ᵖ E)) :=
+begin
+  rw [continuous_iff_le_induced, pullback.total_space.topological_space, pullback_topology],
+  exact inf_le_left,
+end
+
+lemma pullback.continuous_lift (f : B' → B) : continuous (@pullback.lift B F E B' f) :=
+begin
+  rw [continuous_iff_le_induced, pullback.total_space.topological_space, pullback_topology],
+  exact inf_le_right,
+end
+
+lemma inducing_pullback_total_space_embedding (f : B' → B) :
+  inducing (@pullback_total_space_embedding B F E B' f) :=
+begin
+  constructor,
+  simp_rw [prod.topological_space, induced_inf, induced_compose,
+    pullback.total_space.topological_space, pullback_topology],
+  refl
+end
+
+section fiber_bundle
+variables (F) [topological_space F] [topological_space B]
+
+lemma pullback.continuous_total_space_mk [∀ x, topological_space (E x)]
+  [fiber_bundle F E] {f : B' → B} {x : B'} :
+  continuous (@total_space.mk _ F (f *ᵖ E) x) :=
+begin
+  simp only [continuous_iff_le_induced, pullback.total_space.topological_space, induced_compose,
+    induced_inf, function.comp, induced_const, top_inf_eq, pullback_topology],
+  exact le_of_eq (fiber_bundle.total_space_mk_inducing F E (f x)).induced,
+end
+
+variables {E F} [∀ b, has_zero (E b)] {K : Type*} [continuous_map_class K B' B]
+
+/-- A fiber bundle trivialization can be pulled back to a trivialization on the pullback bundle. -/
+noncomputable def trivialization.pullback (e : trivialization F (π F E)) (f : K) :
+  trivialization F (π F ((f : B' → B) *ᵖ E)) :=
+{ to_fun := λ z, (z.proj, (e (pullback.lift f z)).2),
+  inv_fun := λ y, @total_space.mk _ _ (f *ᵖ E) y.1 (e.symm (f y.1) y.2),
+  source := pullback.lift f ⁻¹' e.source,
+  base_set := f ⁻¹' e.base_set,
+  target := (f ⁻¹' e.base_set) ×ˢ univ,
+  map_source' := λ x h, by { simp_rw [e.source_eq, mem_preimage, pullback.lift_proj] at h,
+    simp_rw [prod_mk_mem_set_prod_eq, mem_univ, and_true, mem_preimage, h] },
+  map_target' := λ y h, by { rw [mem_prod, mem_preimage] at h,
+    simp_rw [e.source_eq, mem_preimage, pullback.lift_proj, h.1] },
+  left_inv' := λ x h, by { simp_rw [mem_preimage, e.mem_source, pullback.lift_proj] at h,
+    simp_rw [pullback.lift, e.symm_apply_apply_mk h, total_space.eta] },
+  right_inv' := λ x h, by { simp_rw [mem_prod, mem_preimage, mem_univ, and_true] at h,
+    simp_rw [pullback.lift_mk, e.apply_mk_symm h, prod.mk.eta] },
+  open_source := by { simp_rw [e.source_eq, ← preimage_comp], exact ((map_continuous f).comp $
+    pullback.continuous_proj F E f).is_open_preimage _ e.open_base_set },
+  open_target := ((map_continuous f).is_open_preimage _ e.open_base_set).prod is_open_univ,
+  open_base_set := (map_continuous f).is_open_preimage _ e.open_base_set,
+  continuous_to_fun := (pullback.continuous_proj F E f).continuous_on.prod
+    (continuous_snd.comp_continuous_on $
+    e.continuous_on.comp (pullback.continuous_lift F E f).continuous_on subset.rfl),
+  continuous_inv_fun := begin
+    dsimp only,
+    simp_rw [(inducing_pullback_total_space_embedding F E f).continuous_on_iff, function.comp,
+      pullback_total_space_embedding],
+    refine continuous_on_fst.prod (e.continuous_on_symm.comp
+      ((map_continuous f).prod_map continuous_id).continuous_on subset.rfl)
+  end,
+  source_eq := by { dsimp only, rw e.source_eq, refl, },
+  target_eq := rfl,
+  proj_to_fun := λ y h, rfl }
+
+noncomputable instance fiber_bundle.pullback [∀ x, topological_space (E x)]
+  [fiber_bundle F E] (f : K) : fiber_bundle F ((f : B' → B) *ᵖ E) :=
+{ total_space_mk_inducing := λ x, inducing_of_inducing_compose
+    (pullback.continuous_total_space_mk F E) (pullback.continuous_lift F E f)
+    (total_space_mk_inducing F E (f x)),
+  trivialization_atlas :=
+    {ef | ∃ (e : trivialization F (π F E)) [mem_trivialization_atlas e], ef = e.pullback f},
+  trivialization_at := λ x, (trivialization_at F E (f x)).pullback f,
+  mem_base_set_trivialization_at := λ x, mem_base_set_trivialization_at F E (f x),
+  trivialization_mem_atlas := λ x, ⟨trivialization_at F E (f x), by apply_instance, rfl⟩ }
+
+end fiber_bundle
+end
diff --git a/src/topology/fiber_bundle/is_homeomorphic_trivial_bundle.lean b/src/topology/fiber_bundle/is_homeomorphic_trivial_bundle.lean
new file mode 100644
index 0000000000000..90e1cc607c46b
--- /dev/null
+++ b/src/topology/fiber_bundle/is_homeomorphic_trivial_bundle.lean
@@ -0,0 +1,78 @@
+/-
+Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import topology.homeomorph
+
+/-!
+# Maps equivariantly-homeomorphic to projection in a product
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains the definition `is_homeomorphic_trivial_fiber_bundle F p`, a Prop saying that a
+map `p : Z → B` between topological spaces is a "trivial fiber bundle" in the sense that there
+exists a homeomorphism `h : Z ≃ₜ B × F` such that `proj x = (h x).1`.  This is an abstraction which
+is occasionally convenient in showing that a map is open, a quotient map, etc.
+
+This material was formerly linked to the main definition of fiber bundles, but after a series of
+refactors, there is no longer a direct connection.
+-/
+
+variables {B : Type*} (F : Type*) {Z : Type*} [topological_space B] [topological_space F]
+  [topological_space Z]
+
+/-- A trivial fiber bundle with fiber `F` over a base `B` is a space `Z`
+projecting on `B` for which there exists a homeomorphism to `B × F` that sends `proj`
+to `prod.fst`. -/
+def is_homeomorphic_trivial_fiber_bundle (proj : Z → B) : Prop :=
+∃ e : Z ≃ₜ (B × F), ∀ x, (e x).1 = proj x
+
+namespace is_homeomorphic_trivial_fiber_bundle
+variables {F} {proj : Z → B}
+
+protected lemma proj_eq (h : is_homeomorphic_trivial_fiber_bundle F proj) :
+  ∃ e : Z ≃ₜ (B × F), proj = prod.fst ∘ e :=
+⟨h.some, (funext h.some_spec).symm⟩
+
+/-- The projection from a trivial fiber bundle to its base is surjective. -/
+protected lemma surjective_proj [nonempty F] (h : is_homeomorphic_trivial_fiber_bundle F proj) :
+  function.surjective proj :=
+begin
+  obtain ⟨e, rfl⟩ := h.proj_eq,
+  exact prod.fst_surjective.comp e.surjective,
+end
+
+/-- The projection from a trivial fiber bundle to its base is continuous. -/
+protected lemma continuous_proj (h : is_homeomorphic_trivial_fiber_bundle F proj) :
+  continuous proj :=
+begin
+  obtain ⟨e, rfl⟩ := h.proj_eq,
+  exact continuous_fst.comp e.continuous,
+end
+
+/-- The projection from a trivial fiber bundle to its base is open. -/
+protected lemma is_open_map_proj (h : is_homeomorphic_trivial_fiber_bundle F proj) :
+  is_open_map proj :=
+begin
+  obtain ⟨e, rfl⟩ := h.proj_eq,
+  exact is_open_map_fst.comp e.is_open_map,
+end
+
+/-- The projection from a trivial fiber bundle to its base is open. -/
+protected lemma quotient_map_proj [nonempty F] (h : is_homeomorphic_trivial_fiber_bundle F proj) :
+  quotient_map proj :=
+h.is_open_map_proj.to_quotient_map h.continuous_proj h.surjective_proj
+
+end is_homeomorphic_trivial_fiber_bundle
+
+/-- The first projection in a product is a trivial fiber bundle. -/
+lemma is_homeomorphic_trivial_fiber_bundle_fst :
+  is_homeomorphic_trivial_fiber_bundle F (prod.fst : B × F → B) :=
+⟨homeomorph.refl _, λ x, rfl⟩
+
+/-- The second projection in a product is a trivial fiber bundle. -/
+lemma is_homeomorphic_trivial_fiber_bundle_snd :
+  is_homeomorphic_trivial_fiber_bundle F (prod.snd : F × B → B) :=
+⟨homeomorph.prod_comm _ _, λ x, rfl⟩
diff --git a/src/topology/fiber_bundle/trivialization.lean b/src/topology/fiber_bundle/trivialization.lean
new file mode 100644
index 0000000000000..fcde8b14a33e4
--- /dev/null
+++ b/src/topology/fiber_bundle/trivialization.lean
@@ -0,0 +1,662 @@
+/-
+Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sébastien Gouëzel
+-/
+import data.bundle
+import topology.algebra.order.field
+import topology.local_homeomorph
+
+/-!
+# Trivializations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+### Basic definitions
+
+* `trivialization F p` : structure extending local homeomorphisms, defining a local
+                  trivialization of a topological space `Z` with projection `p` and fiber `F`.
+
+* `pretrivialization F proj` : trivialization as a local equivalence, mainly used when the
+                                      topology on the total space has not yet been defined.
+
+### Operations on bundles
+
+We provide the following operations on `trivialization`s.
+
+* `trivialization.comp_homeomorph`: given a local trivialization `e` of a fiber bundle
+  `p : Z → B` and a homeomorphism `h : Z' ≃ₜ Z`, returns a local trivialization of the fiber bundle
+  `p ∘ h`.
+
+## Implementation notes
+
+Previously, in mathlib, there was a structure `topological_vector_bundle.trivialization` which
+extended another structure `topological_fiber_bundle.trivialization` by a linearity hypothesis. As
+of PR #17359, we have changed this to a single structure `trivialization` (no namespace), together
+with a mixin class `trivialization.is_linear`.
+
+This permits all the *data* of a vector bundle to be held at the level of fiber bundles, so that the
+same trivializations can underlie an object's structure as (say) a vector bundle over `ℂ` and as a
+vector bundle over `ℝ`, as well as its structure simply as a fiber bundle.
+
+This might be a little surprising, given the general trend of the library to ever-increased
+bundling.  But in this case the typical motivation for more bundling does not apply: there is no
+algebraic or order structure on the whole type of linear (say) trivializations of a bundle.
+Indeed, since trivializations only have meaning on their base sets (taking junk values outside), the
+type of linear trivializations is not even particularly well-behaved.
+
+-/
+
+open topological_space filter set bundle
+open_locale topology classical bundle
+
+variables {ι : Type*} {B : Type*} {F : Type*} {E : B → Type*}
+variables (F) {Z : Type*} [topological_space B] [topological_space F] {proj : Z → B}
+
+/-- This structure contains the information left for a local trivialization (which is implemented
+below as `trivialization F proj`) if the total space has not been given a topology, but we
+have a topology on both the fiber and the base space. Through the construction
+`topological_fiber_prebundle F proj` it will be possible to promote a
+`pretrivialization F proj` to a `trivialization F proj`. -/
+@[ext, nolint has_nonempty_instance]
+structure pretrivialization (proj : Z → B) extends local_equiv Z (B × F) :=
+(open_target   : is_open target)
+(base_set      : set B)
+(open_base_set : is_open base_set)
+(source_eq     : source = proj ⁻¹' base_set)
+(target_eq     : target = base_set ×ˢ univ)
+(proj_to_fun   : ∀ p ∈ source, (to_fun p).1 = proj p)
+
+namespace pretrivialization
+
+instance : has_coe_to_fun (pretrivialization F proj) (λ _, Z → (B × F)) := ⟨λ e, e.to_fun⟩
+
+variables {F} (e : pretrivialization F proj) {x : Z}
+
+@[simp, mfld_simps] lemma coe_coe : ⇑e.to_local_equiv = e := rfl
+@[simp, mfld_simps] lemma coe_fst (ex : x ∈ e.source) : (e x).1 = proj x := e.proj_to_fun x ex
+lemma mem_source : x ∈ e.source ↔ proj x ∈ e.base_set := by rw [e.source_eq, mem_preimage]
+lemma coe_fst' (ex : proj x ∈ e.base_set) : (e x).1 = proj x := e.coe_fst (e.mem_source.2 ex)
+protected lemma eq_on : eq_on (prod.fst ∘ e) proj e.source := λ x hx, e.coe_fst hx
+lemma mk_proj_snd (ex : x ∈ e.source) : (proj x, (e x).2) = e x := prod.ext (e.coe_fst ex).symm rfl
+lemma mk_proj_snd' (ex : proj x ∈ e.base_set) : (proj x, (e x).2) = e x :=
+prod.ext (e.coe_fst' ex).symm rfl
+
+/-- Composition of inverse and coercion from the subtype of the target. -/
+def set_symm : e.target → Z := e.target.restrict e.to_local_equiv.symm
+
+lemma mem_target {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.base_set :=
+by rw [e.target_eq, prod_univ, mem_preimage]
+
+lemma proj_symm_apply {x : B × F} (hx : x ∈ e.target) : proj (e.to_local_equiv.symm x) = x.1 :=
+begin
+  have := (e.coe_fst (e.to_local_equiv.map_target hx)).symm,
+  rwa [← e.coe_coe, e.to_local_equiv.right_inv hx] at this
+end
+
+lemma proj_symm_apply' {b : B} {x : F} (hx : b ∈ e.base_set) :
+  proj (e.to_local_equiv.symm (b, x)) = b :=
+e.proj_symm_apply (e.mem_target.2 hx)
+
+lemma proj_surj_on_base_set [nonempty F] : set.surj_on proj e.source e.base_set :=
+λ b hb, let ⟨y⟩ := ‹nonempty F› in ⟨e.to_local_equiv.symm (b, y),
+  e.to_local_equiv.map_target $ e.mem_target.2 hb, e.proj_symm_apply' hb⟩
+
+lemma apply_symm_apply {x : B × F} (hx : x ∈ e.target) : e (e.to_local_equiv.symm x) = x :=
+e.to_local_equiv.right_inv hx
+
+lemma apply_symm_apply' {b : B} {x : F} (hx : b ∈ e.base_set) :
+  e (e.to_local_equiv.symm (b, x)) = (b, x) :=
+e.apply_symm_apply (e.mem_target.2 hx)
+
+lemma symm_apply_apply {x : Z} (hx : x ∈ e.source) : e.to_local_equiv.symm (e x) = x :=
+e.to_local_equiv.left_inv hx
+
+@[simp, mfld_simps] lemma symm_apply_mk_proj {x : Z} (ex : x ∈ e.source) :
+  e.to_local_equiv.symm (proj x, (e x).2) = x :=
+by rw [← e.coe_fst ex, prod.mk.eta, ← e.coe_coe, e.to_local_equiv.left_inv ex]
+
+@[simp, mfld_simps] lemma preimage_symm_proj_base_set :
+  (e.to_local_equiv.symm ⁻¹' (proj ⁻¹' e.base_set)) ∩ e.target  = e.target :=
+begin
+  refine inter_eq_right_iff_subset.mpr (λ x hx, _),
+  simp only [mem_preimage, local_equiv.inv_fun_as_coe, e.proj_symm_apply hx],
+  exact e.mem_target.mp hx,
+end
+
+@[simp, mfld_simps] lemma preimage_symm_proj_inter (s : set B) :
+  (e.to_local_equiv.symm ⁻¹' (proj ⁻¹' s)) ∩ e.base_set ×ˢ univ = (s ∩ e.base_set) ×ˢ univ :=
+begin
+  ext ⟨x, y⟩,
+  suffices : x ∈ e.base_set → (proj (e.to_local_equiv.symm (x, y)) ∈ s ↔ x ∈ s),
+    by simpa only [prod_mk_mem_set_prod_eq, mem_inter_iff, and_true, mem_univ, and.congr_left_iff],
+  intro h,
+  rw [e.proj_symm_apply' h]
+end
+
+lemma target_inter_preimage_symm_source_eq (e f : pretrivialization F proj) :
+  f.target ∩ (f.to_local_equiv.symm) ⁻¹' e.source = (e.base_set ∩ f.base_set) ×ˢ univ :=
+by rw [inter_comm, f.target_eq, e.source_eq, f.preimage_symm_proj_inter]
+
+lemma trans_source (e f : pretrivialization F proj) :
+  (f.to_local_equiv.symm.trans e.to_local_equiv).source = (e.base_set ∩ f.base_set) ×ˢ univ :=
+by rw [local_equiv.trans_source, local_equiv.symm_source, e.target_inter_preimage_symm_source_eq]
+
+lemma symm_trans_symm (e e' : pretrivialization F proj) :
+  (e.to_local_equiv.symm.trans e'.to_local_equiv).symm =
+  e'.to_local_equiv.symm.trans e.to_local_equiv :=
+by rw [local_equiv.trans_symm_eq_symm_trans_symm, local_equiv.symm_symm]
+
+lemma symm_trans_source_eq (e e' : pretrivialization F proj) :
+  (e.to_local_equiv.symm.trans e'.to_local_equiv).source = (e.base_set ∩ e'.base_set) ×ˢ univ :=
+by rw [local_equiv.trans_source, e'.source_eq, local_equiv.symm_source, e.target_eq, inter_comm,
+  e.preimage_symm_proj_inter, inter_comm]
+
+lemma symm_trans_target_eq (e e' : pretrivialization F proj) :
+  (e.to_local_equiv.symm.trans e'.to_local_equiv).target = (e.base_set ∩ e'.base_set) ×ˢ univ :=
+by rw [← local_equiv.symm_source, symm_trans_symm, symm_trans_source_eq, inter_comm]
+
+variables {B F} (e' : pretrivialization F (π F E)) {x' : total_space F E} {b : B} {y : E b}
+
+@[simp] theorem coe_mem_source : ↑y ∈ e'.source ↔ b ∈ e'.base_set := e'.mem_source
+
+@[simp, mfld_simps] lemma coe_coe_fst (hb : b ∈ e'.base_set) : (e' y).1 = b :=
+e'.coe_fst (e'.mem_source.2 hb)
+
+lemma mk_mem_target {x : B} {y : F} : (x, y) ∈ e'.target ↔ x ∈ e'.base_set :=
+e'.mem_target
+
+lemma symm_coe_proj {x : B} {y : F} (e' : pretrivialization F (π F E)) (h : x ∈ e'.base_set) :
+  (e'.to_local_equiv.symm (x, y)).1 = x :=
+e'.proj_symm_apply' h
+
+section has_zero
+variables [∀ x, has_zero (E x)]
+
+/-- A fiberwise inverse to `e`. This is the function `F → E b` that induces a local inverse
+`B × F → total_space F E` of `e` on `e.base_set`. It is defined to be `0` outside `e.base_set`. -/
+protected noncomputable def symm (e : pretrivialization F (π F E)) (b : B) (y : F) : E b :=
+if hb : b ∈ e.base_set
+then cast (congr_arg E (e.proj_symm_apply' hb)) (e.to_local_equiv.symm (b, y)).2
+else 0
+
+lemma symm_apply (e : pretrivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : F) :
+  e.symm b y = cast (congr_arg E (e.symm_coe_proj hb)) (e.to_local_equiv.symm (b, y)).2 :=
+dif_pos hb
+
+lemma symm_apply_of_not_mem (e : pretrivialization F (π F E)) {b : B} (hb : b ∉ e.base_set)
+  (y : F) : e.symm b y = 0 :=
+dif_neg hb
+
+lemma coe_symm_of_not_mem (e : pretrivialization F (π F E)) {b : B} (hb : b ∉ e.base_set) :
+  (e.symm b : F → E b) = 0 :=
+funext $ λ y, dif_neg hb
+
+lemma mk_symm (e : pretrivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : F) :
+  total_space.mk b (e.symm b y) = e.to_local_equiv.symm (b, y) :=
+by rw [e.symm_apply hb, total_space.mk_cast, total_space.eta]
+
+lemma symm_proj_apply (e : pretrivialization F (π F E)) (z : total_space F E)
+  (hz : z.proj ∈ e.base_set) : e.symm z.proj (e z).2 = z.2 :=
+by rw [e.symm_apply hz, cast_eq_iff_heq, e.mk_proj_snd' hz,
+  e.symm_apply_apply (e.mem_source.mpr hz)]
+
+lemma symm_apply_apply_mk (e : pretrivialization F (π F E)) {b : B} (hb : b ∈ e.base_set)
+  (y : E b) : e.symm b (e ⟨b, y⟩).2 = y :=
+e.symm_proj_apply ⟨b, y⟩ hb
+
+lemma apply_mk_symm (e : pretrivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : F) :
+  e ⟨b, e.symm b y⟩ = (b, y) :=
+by rw [e.mk_symm hb, e.apply_symm_apply (e.mk_mem_target.mpr hb)]
+
+end has_zero
+
+end pretrivialization
+
+variables [topological_space Z] [topological_space (total_space F E)]
+
+/--
+A structure extending local homeomorphisms, defining a local trivialization of a projection
+`proj : Z → B` with fiber `F`, as a local homeomorphism between `Z` and `B × F` defined between two
+sets of the form `proj ⁻¹' base_set` and `base_set × F`, acting trivially on the first coordinate.
+-/
+@[ext, nolint has_nonempty_instance]
+structure trivialization (proj : Z → B)
+  extends local_homeomorph Z (B × F) :=
+(base_set      : set B)
+(open_base_set : is_open base_set)
+(source_eq     : source = proj ⁻¹' base_set)
+(target_eq     : target = base_set ×ˢ univ)
+(proj_to_fun   : ∀ p ∈ source, (to_local_homeomorph p).1 = proj p)
+
+namespace trivialization
+
+variables {F} (e : trivialization F proj) {x : Z}
+
+/-- Natural identification as a `pretrivialization`. -/
+def to_pretrivialization : pretrivialization F proj := { ..e }
+
+instance : has_coe_to_fun (trivialization F proj) (λ _, Z → B × F) := ⟨λ e, e.to_fun⟩
+instance : has_coe (trivialization F proj) (pretrivialization F proj) :=
+⟨to_pretrivialization⟩
+
+lemma to_pretrivialization_injective :
+  function.injective (λ e : trivialization F proj, e.to_pretrivialization) :=
+by { intros e e', rw [pretrivialization.ext_iff, trivialization.ext_iff,
+  ← local_homeomorph.to_local_equiv_injective.eq_iff], exact id }
+
+@[simp, mfld_simps] lemma coe_coe : ⇑e.to_local_homeomorph = e := rfl
+@[simp, mfld_simps] lemma coe_fst (ex : x ∈ e.source) : (e x).1 = proj x := e.proj_to_fun x ex
+protected lemma eq_on : eq_on (prod.fst ∘ e) proj e.source := λ x hx, e.coe_fst hx
+lemma mem_source : x ∈ e.source ↔ proj x ∈ e.base_set := by rw [e.source_eq, mem_preimage]
+lemma coe_fst' (ex : proj x ∈ e.base_set) : (e x).1 = proj x := e.coe_fst (e.mem_source.2 ex)
+lemma mk_proj_snd (ex : x ∈ e.source) : (proj x, (e x).2) = e x := prod.ext (e.coe_fst ex).symm rfl
+lemma mk_proj_snd' (ex : proj x ∈ e.base_set) : (proj x, (e x).2) = e x :=
+prod.ext (e.coe_fst' ex).symm rfl
+
+lemma source_inter_preimage_target_inter (s : set (B × F)) :
+  e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
+e.to_local_homeomorph.source_inter_preimage_target_inter s
+
+@[simp, mfld_simps] lemma coe_mk (e : local_homeomorph Z (B × F)) (i j k l m) (x : Z) :
+  (trivialization.mk e i j k l m : trivialization F proj) x = e x := rfl
+
+lemma mem_target {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.base_set :=
+e.to_pretrivialization.mem_target
+
+lemma map_target {x : B × F} (hx : x ∈ e.target) : e.to_local_homeomorph.symm x ∈ e.source :=
+e.to_local_homeomorph.map_target hx
+
+lemma proj_symm_apply {x : B × F} (hx : x ∈ e.target) : proj (e.to_local_homeomorph.symm x) = x.1 :=
+e.to_pretrivialization.proj_symm_apply hx
+
+lemma proj_symm_apply' {b : B} {x : F}
+  (hx : b ∈ e.base_set) : proj (e.to_local_homeomorph.symm (b, x)) = b :=
+e.to_pretrivialization.proj_symm_apply' hx
+
+lemma proj_surj_on_base_set [nonempty F] : set.surj_on proj e.source e.base_set :=
+e.to_pretrivialization.proj_surj_on_base_set
+
+lemma apply_symm_apply {x : B × F} (hx : x ∈ e.target) : e (e.to_local_homeomorph.symm x) = x :=
+e.to_local_homeomorph.right_inv hx
+
+lemma apply_symm_apply'
+  {b : B} {x : F} (hx : b ∈ e.base_set) : e (e.to_local_homeomorph.symm (b, x)) = (b, x) :=
+e.to_pretrivialization.apply_symm_apply' hx
+
+@[simp, mfld_simps] lemma symm_apply_mk_proj (ex : x ∈ e.source) :
+  e.to_local_homeomorph.symm (proj x, (e x).2) = x :=
+e.to_pretrivialization.symm_apply_mk_proj ex
+
+lemma symm_trans_source_eq (e e' : trivialization F proj) :
+  (e.to_local_equiv.symm.trans e'.to_local_equiv).source = (e.base_set ∩ e'.base_set) ×ˢ univ :=
+pretrivialization.symm_trans_source_eq e.to_pretrivialization e'
+
+lemma symm_trans_target_eq (e e' : trivialization F proj) :
+  (e.to_local_equiv.symm.trans e'.to_local_equiv).target = (e.base_set ∩ e'.base_set) ×ˢ univ :=
+pretrivialization.symm_trans_target_eq e.to_pretrivialization e'
+
+lemma coe_fst_eventually_eq_proj (ex : x ∈ e.source) : prod.fst ∘ e =ᶠ[𝓝 x] proj  :=
+mem_nhds_iff.2 ⟨e.source, λ y hy, e.coe_fst hy, e.open_source, ex⟩
+
+lemma coe_fst_eventually_eq_proj' (ex : proj x ∈ e.base_set) : prod.fst ∘ e =ᶠ[𝓝 x] proj :=
+e.coe_fst_eventually_eq_proj (e.mem_source.2 ex)
+
+lemma map_proj_nhds (ex : x ∈ e.source) : map proj (𝓝 x) = 𝓝 (proj x) :=
+by rw [← e.coe_fst ex, ← map_congr (e.coe_fst_eventually_eq_proj ex), ← map_map, ← e.coe_coe,
+  e.to_local_homeomorph.map_nhds_eq ex, map_fst_nhds]
+
+lemma preimage_subset_source {s : set B} (hb : s ⊆ e.base_set) : proj ⁻¹' s ⊆ e.source :=
+λ p hp, e.mem_source.mpr (hb hp)
+
+lemma image_preimage_eq_prod_univ {s : set B} (hb : s ⊆ e.base_set) :
+  e '' (proj ⁻¹' s) = s ×ˢ univ :=
+subset.antisymm (image_subset_iff.mpr (λ p hp,
+  ⟨(e.proj_to_fun p (e.preimage_subset_source hb hp)).symm ▸ hp, trivial⟩)) (λ p hp,
+  let hp' : p ∈ e.target := e.mem_target.mpr (hb hp.1) in
+  ⟨e.inv_fun p, mem_preimage.mpr ((e.proj_symm_apply hp').symm ▸ hp.1), e.apply_symm_apply hp'⟩)
+
+/-- The preimage of a subset of the base set is homeomorphic to the product with the fiber. -/
+def preimage_homeomorph {s : set B} (hb : s ⊆ e.base_set) : proj ⁻¹' s ≃ₜ s × F :=
+(e.to_local_homeomorph.homeomorph_of_image_subset_source (e.preimage_subset_source hb)
+  (e.image_preimage_eq_prod_univ hb)).trans
+  ((homeomorph.set.prod s univ).trans ((homeomorph.refl s).prod_congr (homeomorph.set.univ F)))
+
+@[simp] lemma preimage_homeomorph_apply {s : set B} (hb : s ⊆ e.base_set) (p : proj ⁻¹' s) :
+  e.preimage_homeomorph hb p = (⟨proj p, p.2⟩, (e p).2) :=
+prod.ext (subtype.ext (e.proj_to_fun p (e.mem_source.mpr (hb p.2)))) rfl
+
+@[simp] lemma preimage_homeomorph_symm_apply {s : set B} (hb : s ⊆ e.base_set) (p : s × F) :
+  (e.preimage_homeomorph hb).symm p = ⟨e.symm (p.1, p.2), ((e.preimage_homeomorph hb).symm p).2⟩ :=
+rfl
+
+/-- The source is homeomorphic to the product of the base set with the fiber. -/
+def source_homeomorph_base_set_prod : e.source ≃ₜ e.base_set × F :=
+(homeomorph.set_congr e.source_eq).trans (e.preimage_homeomorph subset_rfl)
+
+@[simp] lemma source_homeomorph_base_set_prod_apply (p : e.source) :
+  e.source_homeomorph_base_set_prod p = (⟨proj p, e.mem_source.mp p.2⟩, (e p).2) :=
+e.preimage_homeomorph_apply subset_rfl ⟨p, e.mem_source.mp p.2⟩
+
+@[simp] lemma source_homeomorph_base_set_prod_symm_apply (p : e.base_set × F) :
+  e.source_homeomorph_base_set_prod.symm p =
+    ⟨e.symm (p.1, p.2), (e.source_homeomorph_base_set_prod.symm p).2⟩ :=
+rfl
+
+/-- Each fiber of a trivialization is homeomorphic to the specified fiber. -/
+def preimage_singleton_homeomorph {b : B} (hb : b ∈ e.base_set) : proj ⁻¹' {b} ≃ₜ F :=
+(e.preimage_homeomorph (set.singleton_subset_iff.mpr hb)).trans (((homeomorph.homeomorph_of_unique
+  ({b} : set B) punit).prod_congr (homeomorph.refl F)).trans (homeomorph.punit_prod F))
+
+@[simp] lemma preimage_singleton_homeomorph_apply {b : B} (hb : b ∈ e.base_set)
+  (p : proj ⁻¹' {b}) : e.preimage_singleton_homeomorph hb p = (e p).2 :=
+rfl
+
+@[simp] lemma preimage_singleton_homeomorph_symm_apply {b : B} (hb : b ∈ e.base_set) (p : F) :
+  (e.preimage_singleton_homeomorph hb).symm p =
+    ⟨e.symm (b, p), by rw [mem_preimage, e.proj_symm_apply' hb, mem_singleton_iff]⟩ :=
+rfl
+
+/-- In the domain of a bundle trivialization, the projection is continuous-/
+lemma continuous_at_proj (ex : x ∈ e.source) : continuous_at proj x :=
+(e.map_proj_nhds ex).le
+
+/-- Composition of a `trivialization` and a `homeomorph`. -/
+protected def comp_homeomorph {Z' : Type*} [topological_space Z'] (h : Z' ≃ₜ Z) :
+  trivialization F (proj ∘ h) :=
+{ to_local_homeomorph := h.to_local_homeomorph.trans e.to_local_homeomorph,
+  base_set := e.base_set,
+  open_base_set := e.open_base_set,
+  source_eq := by simp [e.source_eq, preimage_preimage],
+  target_eq := by simp [e.target_eq],
+  proj_to_fun := λ p hp,
+    have hp : h p ∈ e.source, by simpa using hp,
+    by simp [hp] }
+
+/-- Read off the continuity of a function `f : Z → X` at `z : Z` by transferring via a
+trivialization of `Z` containing `z`. -/
+lemma continuous_at_of_comp_right {X : Type*} [topological_space X] {f : Z → X} {z : Z}
+  (e : trivialization F proj) (he : proj z ∈ e.base_set)
+  (hf : continuous_at (f ∘ e.to_local_equiv.symm) (e z)) :
+  continuous_at f z :=
+begin
+  have hez : z ∈ e.to_local_equiv.symm.target,
+  { rw [local_equiv.symm_target, e.mem_source],
+    exact he },
+  rwa [e.to_local_homeomorph.symm.continuous_at_iff_continuous_at_comp_right hez,
+   local_homeomorph.symm_symm]
+end
+
+/-- Read off the continuity of a function `f : X → Z` at `x : X` by transferring via a
+trivialization of `Z` containing `f x`. -/
+lemma continuous_at_of_comp_left {X : Type*} [topological_space X] {f : X → Z} {x : X}
+  (e : trivialization F proj) (hf_proj : continuous_at (proj ∘ f) x) (he : proj (f x) ∈ e.base_set)
+  (hf : continuous_at (e ∘ f) x) :
+  continuous_at f x :=
+begin
+  rw e.to_local_homeomorph.continuous_at_iff_continuous_at_comp_left,
+  { exact hf },
+  rw [e.source_eq, ← preimage_comp],
+  exact hf_proj.preimage_mem_nhds (e.open_base_set.mem_nhds he),
+end
+
+variables {E} (e' : trivialization F (π F E)) {x' : total_space F E} {b : B} {y : E b}
+
+protected lemma continuous_on : continuous_on e' e'.source := e'.continuous_to_fun
+
+lemma coe_mem_source : ↑y ∈ e'.source ↔ b ∈ e'.base_set := e'.mem_source
+
+lemma open_target : is_open e'.target :=
+by { rw e'.target_eq, exact e'.open_base_set.prod is_open_univ }
+
+@[simp, mfld_simps] lemma coe_coe_fst (hb : b ∈ e'.base_set) : (e' y).1 = b :=
+e'.coe_fst (e'.mem_source.2 hb)
+
+lemma mk_mem_target {y : F} : (b, y) ∈ e'.target ↔ b ∈ e'.base_set :=
+e'.to_pretrivialization.mem_target
+
+lemma symm_apply_apply {x : total_space F E} (hx : x ∈ e'.source) :
+  e'.to_local_homeomorph.symm (e' x) = x :=
+e'.to_local_equiv.left_inv hx
+
+@[simp, mfld_simps] lemma symm_coe_proj {x : B} {y : F}
+  (e : trivialization F (π F E)) (h : x ∈ e.base_set) :
+  (e.to_local_homeomorph.symm (x, y)).1 = x := e.proj_symm_apply' h
+
+section has_zero
+variables [∀ x, has_zero (E x)]
+
+/-- A fiberwise inverse to `e'`. The function `F → E x` that induces a local inverse
+`B × F → total_space F E` of `e'` on `e'.base_set`. It is defined to be `0` outside
+`e'.base_set`. -/
+protected noncomputable def symm (e : trivialization F (π F E)) (b : B) (y : F) : E b :=
+e.to_pretrivialization.symm b y
+
+lemma symm_apply (e : trivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : F) :
+  e.symm b y = cast (congr_arg E (e.symm_coe_proj hb)) (e.to_local_homeomorph.symm (b, y)).2 :=
+dif_pos hb
+
+lemma symm_apply_of_not_mem (e : trivialization F (π F E)) {b : B} (hb : b ∉ e.base_set) (y : F) :
+  e.symm b y = 0 :=
+dif_neg hb
+
+lemma mk_symm (e : trivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : F) :
+  total_space.mk b (e.symm b y) = e.to_local_homeomorph.symm (b, y) :=
+e.to_pretrivialization.mk_symm hb y
+
+lemma symm_proj_apply (e : trivialization F (π F E)) (z : total_space F E)
+  (hz : z.proj ∈ e.base_set) : e.symm z.proj (e z).2 = z.2 :=
+e.to_pretrivialization.symm_proj_apply z hz
+
+lemma symm_apply_apply_mk (e : trivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : E b) :
+  e.symm b (e ⟨b, y⟩).2 = y :=
+e.symm_proj_apply ⟨b, y⟩ hb
+
+lemma apply_mk_symm (e : trivialization F (π F E)) {b : B} (hb : b ∈ e.base_set) (y : F) :
+  e ⟨b, e.symm b y⟩ = (b, y) :=
+e.to_pretrivialization.apply_mk_symm hb y
+
+lemma continuous_on_symm (e : trivialization F (π F E)) :
+  continuous_on (λ z : B × F, total_space.mk' F z.1 (e.symm z.1 z.2)) (e.base_set ×ˢ univ) :=
+begin
+  have : ∀ (z : B × F) (hz : z ∈ e.base_set ×ˢ (univ : set F)),
+    total_space.mk z.1 (e.symm z.1 z.2) = e.to_local_homeomorph.symm z,
+  { rintro x ⟨hx : x.1 ∈ e.base_set, _⟩, simp_rw [e.mk_symm hx, prod.mk.eta] },
+  refine continuous_on.congr _ this,
+  rw [← e.target_eq],
+  exact e.to_local_homeomorph.continuous_on_symm
+end
+
+end has_zero
+
+/-- If `e` is a `trivialization` of `proj : Z → B` with fiber `F` and `h` is a homeomorphism
+`F ≃ₜ F'`, then `e.trans_fiber_homeomorph h` is the trivialization of `proj` with the fiber `F'`
+that sends `p : Z` to `((e p).1, h (e p).2)`. -/
+def trans_fiber_homeomorph {F' : Type*} [topological_space F']
+  (e : trivialization F proj) (h : F ≃ₜ F') : trivialization F' proj :=
+{ to_local_homeomorph := e.to_local_homeomorph.trans_homeomorph $ (homeomorph.refl _).prod_congr h,
+  base_set := e.base_set,
+  open_base_set := e.open_base_set,
+  source_eq := e.source_eq,
+  target_eq := by simp [e.target_eq, prod_univ, preimage_preimage],
+  proj_to_fun := e.proj_to_fun }
+
+@[simp] lemma trans_fiber_homeomorph_apply {F' : Type*} [topological_space F']
+  (e : trivialization F proj) (h : F ≃ₜ F') (x : Z) :
+  e.trans_fiber_homeomorph h x = ((e x).1, h (e x).2) :=
+rfl
+
+/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations. See also
+`trivialization.coord_change_homeomorph` for a version bundled as `F ≃ₜ F`. -/
+def coord_change (e₁ e₂ : trivialization F proj) (b : B) (x : F) : F :=
+(e₂ $ e₁.to_local_homeomorph.symm (b, x)).2
+
+lemma mk_coord_change
+  (e₁ e₂ : trivialization F proj) {b : B}
+  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) (x : F) :
+  (b, e₁.coord_change e₂ b x) = e₂ (e₁.to_local_homeomorph.symm (b, x)) :=
+begin
+  refine prod.ext _ rfl,
+  rw [e₂.coe_fst', ← e₁.coe_fst', e₁.apply_symm_apply' h₁],
+  { rwa [e₁.proj_symm_apply' h₁] },
+  { rwa [e₁.proj_symm_apply' h₁] }
+end
+
+lemma coord_change_apply_snd
+  (e₁ e₂ : trivialization F proj) {p : Z}
+  (h : proj p ∈ e₁.base_set) :
+  e₁.coord_change e₂ (proj p) (e₁ p).snd = (e₂ p).snd :=
+by rw [coord_change, e₁.symm_apply_mk_proj (e₁.mem_source.2 h)]
+
+lemma coord_change_same_apply
+  (e : trivialization F proj) {b : B} (h : b ∈ e.base_set) (x : F) :
+  e.coord_change e b x = x :=
+by rw [coord_change, e.apply_symm_apply' h]
+
+lemma coord_change_same
+  (e : trivialization F proj) {b : B} (h : b ∈ e.base_set) :
+  e.coord_change e b = id :=
+funext $ e.coord_change_same_apply h
+
+lemma coord_change_coord_change
+  (e₁ e₂ e₃ : trivialization F proj) {b : B}
+  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) (x : F) :
+  e₂.coord_change e₃ b (e₁.coord_change e₂ b x) = e₁.coord_change e₃ b x :=
+begin
+  rw [coord_change, e₁.mk_coord_change _ h₁ h₂, ← e₂.coe_coe,
+    e₂.to_local_homeomorph.left_inv, coord_change],
+  rwa [e₂.mem_source, e₁.proj_symm_apply' h₁]
+end
+
+lemma continuous_coord_change (e₁ e₂ : trivialization F proj) {b : B}
+  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
+  continuous (e₁.coord_change e₂ b) :=
+begin
+  refine continuous_snd.comp (e₂.to_local_homeomorph.continuous_on.comp_continuous
+    (e₁.to_local_homeomorph.continuous_on_symm.comp_continuous _ _) _),
+  { exact continuous_const.prod_mk continuous_id },
+  { exact λ x, e₁.mem_target.2 h₁ },
+  { intro x,
+    rwa [e₂.mem_source, e₁.proj_symm_apply' h₁] }
+end
+
+/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations,
+as a homeomorphism. -/
+protected def coord_change_homeomorph
+  (e₁ e₂ : trivialization F proj) {b : B} (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
+  F ≃ₜ F :=
+{ to_fun := e₁.coord_change e₂ b,
+  inv_fun := e₂.coord_change e₁ b,
+  left_inv := λ x, by simp only [*, coord_change_coord_change, coord_change_same_apply],
+  right_inv := λ x, by simp only [*, coord_change_coord_change, coord_change_same_apply],
+  continuous_to_fun := e₁.continuous_coord_change e₂ h₁ h₂,
+  continuous_inv_fun := e₂.continuous_coord_change e₁ h₂ h₁ }
+
+@[simp] lemma coord_change_homeomorph_coe
+  (e₁ e₂ : trivialization F proj) {b : B} (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
+  ⇑(e₁.coord_change_homeomorph e₂ h₁ h₂) = e₁.coord_change e₂ b :=
+rfl
+
+variables {F} {B' : Type*} [topological_space B']
+
+lemma is_image_preimage_prod (e : trivialization F proj) (s : set B) :
+  e.to_local_homeomorph.is_image (proj ⁻¹' s) (s ×ˢ univ) :=
+λ x hx, by simp [e.coe_fst', hx]
+
+/-- Restrict a `trivialization` to an open set in the base. `-/
+protected def restr_open (e : trivialization F proj) (s : set B)
+  (hs : is_open s) : trivialization F proj :=
+{ to_local_homeomorph := ((e.is_image_preimage_prod s).symm.restr
+    (is_open.inter e.open_target (hs.prod is_open_univ))).symm,
+  base_set := e.base_set ∩ s,
+  open_base_set := is_open.inter e.open_base_set hs,
+  source_eq := by simp [e.source_eq],
+  target_eq := by simp [e.target_eq, prod_univ],
+  proj_to_fun := λ p hp, e.proj_to_fun p hp.1 }
+
+section piecewise
+
+lemma frontier_preimage (e : trivialization F proj) (s : set B) :
+  e.source ∩ frontier (proj ⁻¹' s) = proj ⁻¹' (e.base_set ∩ frontier s) :=
+by rw [← (e.is_image_preimage_prod s).frontier.preimage_eq, frontier_prod_univ_eq,
+  (e.is_image_preimage_prod _).preimage_eq, e.source_eq, preimage_inter]
+
+/-- Given two bundle trivializations `e`, `e'` of `proj : Z → B` and a set `s : set B` such that
+the base sets of `e` and `e'` intersect `frontier s` on the same set and `e p = e' p` whenever
+`proj p ∈ e.base_set ∩ frontier s`, `e.piecewise e' s Hs Heq` is the bundle trivialization over
+`set.ite s e.base_set e'.base_set` that is equal to `e` on `proj ⁻¹ s` and is equal to `e'`
+otherwise. -/
+noncomputable def piecewise (e e' : trivialization F proj) (s : set B)
+  (Hs : e.base_set ∩ frontier s = e'.base_set ∩ frontier s)
+  (Heq : eq_on e e' $ proj ⁻¹' (e.base_set ∩ frontier s)) :
+  trivialization F proj :=
+{ to_local_homeomorph := e.to_local_homeomorph.piecewise e'.to_local_homeomorph
+    (proj ⁻¹' s) (s ×ˢ univ) (e.is_image_preimage_prod s) (e'.is_image_preimage_prod s)
+    (by rw [e.frontier_preimage, e'.frontier_preimage, Hs])
+    (by rwa e.frontier_preimage),
+  base_set := s.ite e.base_set e'.base_set,
+  open_base_set := e.open_base_set.ite e'.open_base_set Hs,
+  source_eq := by simp [e.source_eq, e'.source_eq],
+  target_eq := by simp [e.target_eq, e'.target_eq, prod_univ],
+  proj_to_fun := by rintro p (⟨he, hs⟩|⟨he, hs⟩); simp * }
+
+/-- Given two bundle trivializations `e`, `e'` of a topological fiber bundle `proj : Z → B`
+over a linearly ordered base `B` and a point `a ∈ e.base_set ∩ e'.base_set` such that
+`e` equals `e'` on `proj ⁻¹' {a}`, `e.piecewise_le_of_eq e' a He He' Heq` is the bundle
+trivialization over `set.ite (Iic a) e.base_set e'.base_set` that is equal to `e` on points `p`
+such that `proj p ≤ a` and is equal to `e'` otherwise. -/
+noncomputable def piecewise_le_of_eq [linear_order B] [order_topology B]
+  (e e' : trivialization F proj) (a : B) (He : a ∈ e.base_set) (He' : a ∈ e'.base_set)
+  (Heq : ∀ p, proj p = a → e p = e' p) :
+  trivialization F proj :=
+e.piecewise e' (Iic a)
+  (set.ext $ λ x, and.congr_left_iff.2 $ λ hx,
+    by simp [He, He', mem_singleton_iff.1 (frontier_Iic_subset _ hx)])
+  (λ p hp, Heq p $ frontier_Iic_subset _ hp.2)
+
+/-- Given two bundle trivializations `e`, `e'` of a topological fiber bundle `proj : Z → B` over a
+linearly ordered base `B` and a point `a ∈ e.base_set ∩ e'.base_set`, `e.piecewise_le e' a He He'`
+is the bundle trivialization over `set.ite (Iic a) e.base_set e'.base_set` that is equal to `e` on
+points `p` such that `proj p ≤ a` and is equal to `((e' p).1, h (e' p).2)` otherwise, where
+`h = `e'.coord_change_homeomorph e _ _` is the homeomorphism of the fiber such that
+`h (e' p).2 = (e p).2` whenever `e p = a`. -/
+noncomputable def piecewise_le [linear_order B] [order_topology B]
+  (e e' : trivialization F proj) (a : B) (He : a ∈ e.base_set) (He' : a ∈ e'.base_set) :
+  trivialization F proj :=
+e.piecewise_le_of_eq (e'.trans_fiber_homeomorph (e'.coord_change_homeomorph e He' He))
+  a He He' $ by { unfreezingI {rintro p rfl },
+    ext1,
+    { simp [e.coe_fst', e'.coe_fst', *] },
+    { simp [e'.coord_change_apply_snd, *] } }
+
+/-- Given two bundle trivializations `e`, `e'` over disjoint sets, `e.disjoint_union e' H` is the
+bundle trivialization over the union of the base sets that agrees with `e` and `e'` over their
+base sets. -/
+noncomputable def disjoint_union (e e' : trivialization F proj)
+  (H : disjoint e.base_set e'.base_set) :
+  trivialization F proj :=
+{ to_local_homeomorph := e.to_local_homeomorph.disjoint_union e'.to_local_homeomorph
+    (by { rw [e.source_eq, e'.source_eq], exact H.preimage _, })
+    (by { rw [e.target_eq, e'.target_eq, disjoint_iff_inf_le],
+          intros x hx, exact H.le_bot ⟨hx.1.1, hx.2.1⟩ }),
+  base_set := e.base_set ∪ e'.base_set,
+  open_base_set := is_open.union e.open_base_set e'.open_base_set,
+  source_eq := congr_arg2 (∪) e.source_eq e'.source_eq,
+  target_eq := (congr_arg2 (∪) e.target_eq e'.target_eq).trans union_prod.symm,
+  proj_to_fun :=
+    begin
+      rintro p (hp|hp'),
+      { show (e.source.piecewise e e' p).1 = proj p,
+        rw [piecewise_eq_of_mem, e.coe_fst]; exact hp },
+      { show (e.source.piecewise e e' p).1 = proj p,
+        rw [piecewise_eq_of_not_mem, e'.coe_fst hp'],
+        simp only [e.source_eq, e'.source_eq] at hp' ⊢,
+        exact λ h, H.le_bot ⟨h, hp'⟩ }
+    end }
+
+end piecewise
+
+end trivialization
diff --git a/src/topology/filter.lean b/src/topology/filter.lean
new file mode 100644
index 0000000000000..2adb2b03378c2
--- /dev/null
+++ b/src/topology/filter.lean
@@ -0,0 +1,191 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import order.filter.lift
+import topology.separation
+import data.set.intervals.monotone
+
+/-!
+# Topology on the set of filters on a type
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file introduce topology on `filter α`. It is generated by the sets
+`set.Iic (𝓟 s) = {l : filter α | s ∈ l}`, `s : set α`. A set `s : set (filter α)` is open if and
+only if it is a union of a family of these basic open sets, see `filter.is_open_iff`.
+
+This topology has the following important properties.
+
+* If `X` is a topological space, then the map `𝓝 : X → filter X` is a topology inducing map.
+
+* In particular, it is a continuous map, so `𝓝 ∘ f` tends to `𝓝 (𝓝 a)` whenever `f` tends to `𝓝 a`.
+
+* If `X` is an ordered topological space with order topology and no max element, then `𝓝 ∘ f` tends
+  to `𝓝 filter.at_top` whenever `f` tends to `filter.at_top`.
+
+* It turns `filter X` into a T₀ space and the order on `filter X` is the dual of the
+  `specialization_order (filter X)`.
+
+## Tags
+
+filter, topological space
+-/
+
+open set filter topological_space
+open_locale filter topology
+
+variables {ι : Sort*} {α β X Y : Type*}
+
+namespace filter
+
+/-- Topology on `filter α` is generated by the sets `set.Iic (𝓟 s) = {l : filter α | s ∈ l}`,
+`s : set α`. A set `s : set (filter α)` is open if and only if it is a union of a family of these
+basic open sets, see `filter.is_open_iff`. -/
+instance : topological_space (filter α) := generate_from $ range $ Iic ∘ 𝓟
+
+lemma is_open_Iic_principal {s : set α} : is_open (Iic (𝓟 s)) :=
+generate_open.basic _ (mem_range_self _)
+
+lemma is_open_set_of_mem {s : set α} : is_open {l : filter α | s ∈ l} :=
+by simpa only [Iic_principal] using is_open_Iic_principal
+
+lemma is_topological_basis_Iic_principal :
+  is_topological_basis (range (Iic ∘ 𝓟 : set α → set (filter α))) :=
+{ exists_subset_inter :=
+    begin
+      rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩ l hl,
+      exact ⟨Iic (𝓟 s) ∩ Iic (𝓟 t), ⟨s ∩ t, by simp⟩, hl, subset.rfl⟩
+    end,
+  sUnion_eq := sUnion_eq_univ_iff.2 $ λ l, ⟨Iic ⊤, ⟨univ, congr_arg Iic principal_univ⟩, le_top⟩,
+  eq_generate_from := rfl }
+
+lemma is_open_iff {s : set (filter α)} :
+  is_open s ↔ ∃ T : set (set α), s = ⋃ t ∈ T, Iic (𝓟 t) :=
+is_topological_basis_Iic_principal.open_iff_eq_sUnion.trans $
+  by simp only [exists_subset_range_iff, sUnion_image]
+
+lemma nhds_eq (l : filter α) : 𝓝 l = l.lift' (Iic ∘ 𝓟) :=
+nhds_generate_from.trans $ by simp only [mem_set_of_eq, and_comm (l ∈ _), infi_and, infi_range,
+  filter.lift', filter.lift, (∘), mem_Iic, le_principal_iff]
+
+lemma nhds_eq' (l : filter α) : 𝓝 l = l.lift' (λ s, {l' | s ∈ l'}) :=
+by simpa only [(∘), Iic_principal] using nhds_eq l
+
+protected lemma tendsto_nhds {la : filter α} {lb : filter β} {f : α → filter β} :
+  tendsto f la (𝓝 lb) ↔ ∀ s ∈ lb, ∀ᶠ a in la, s ∈ f a :=
+by simp only [nhds_eq', tendsto_lift', mem_set_of_eq]
+
+lemma has_basis.nhds {l : filter α} {p : ι → Prop} {s : ι → set α} (h : has_basis l p s) :
+  has_basis (𝓝 l) p (λ i, Iic (𝓟 (s i))) :=
+by { rw nhds_eq, exact h.lift' monotone_principal.Iic }
+
+/-- Neighborhoods of a countably generated filter is a countably generated filter. -/
+instance {l : filter α} [is_countably_generated l] : is_countably_generated (𝓝 l) :=
+let ⟨b, hb⟩ := l.exists_antitone_basis in has_countable_basis.is_countably_generated $
+  ⟨hb.nhds, set.to_countable _⟩
+
+lemma has_basis.nhds' {l : filter α} {p : ι → Prop} {s : ι → set α} (h : has_basis l p s) :
+  has_basis (𝓝 l) p (λ i, {l' | s i ∈ l'}) :=
+by simpa only [Iic_principal] using h.nhds
+
+lemma mem_nhds_iff {l : filter α} {S : set (filter α)} :
+  S ∈ 𝓝 l ↔ ∃ t ∈ l, Iic (𝓟 t) ⊆ S :=
+l.basis_sets.nhds.mem_iff
+
+lemma mem_nhds_iff' {l : filter α} {S : set (filter α)} :
+  S ∈ 𝓝 l ↔ ∃ t ∈ l, ∀ ⦃l' : filter α⦄, t ∈ l' → l' ∈ S :=
+l.basis_sets.nhds'.mem_iff
+
+@[simp] lemma nhds_bot : 𝓝 (⊥ : filter α) = pure ⊥ :=
+by simp [nhds_eq, lift'_bot monotone_principal.Iic]
+
+@[simp] lemma nhds_top : 𝓝 (⊤ : filter α) = ⊤ := by simp [nhds_eq]
+
+@[simp] lemma nhds_principal (s : set α) : 𝓝 (𝓟 s) = 𝓟 (Iic (𝓟 s)) :=
+(has_basis_principal s).nhds.eq_of_same_basis (has_basis_principal _)
+
+@[simp] lemma nhds_pure (x : α) : 𝓝 (pure x : filter α) = 𝓟 {⊥, pure x} :=
+by rw [← principal_singleton, nhds_principal, principal_singleton, Iic_pure]
+
+@[simp] lemma nhds_infi (f : ι → filter α) : 𝓝 (⨅ i, f i) = ⨅ i, 𝓝 (f i) :=
+by { simp only [nhds_eq], apply lift'_infi_of_map_univ; simp }
+
+@[simp] lemma nhds_inf (l₁ l₂ : filter α) : 𝓝 (l₁ ⊓ l₂) = 𝓝 l₁ ⊓ 𝓝 l₂ :=
+by simpa only [infi_bool_eq] using nhds_infi (λ b, cond b l₁ l₂)
+
+lemma monotone_nhds : monotone (𝓝 : filter α → filter (filter α)) :=
+monotone.of_map_inf nhds_inf
+
+lemma Inter_nhds (l : filter α) : ⋂₀ {s | s ∈ 𝓝 l} = Iic l :=
+by simp only [nhds_eq, sInter_lift'_sets monotone_principal.Iic, Iic, le_principal_iff,
+  ← set_of_forall, ← filter.le_def]
+
+@[simp] lemma nhds_mono {l₁ l₂ : filter α} : 𝓝 l₁ ≤ 𝓝 l₂ ↔ l₁ ≤ l₂ :=
+begin
+  refine ⟨λ h, _, λ h, monotone_nhds h⟩,
+  rw [← Iic_subset_Iic, ← Inter_nhds, ← Inter_nhds],
+  exact sInter_subset_sInter h
+end
+
+protected lemma mem_interior {s : set (filter α)} {l : filter α} :
+  l ∈ interior s ↔ ∃ t ∈ l, Iic (𝓟 t) ⊆ s :=
+by rw [mem_interior_iff_mem_nhds, mem_nhds_iff]
+
+protected lemma mem_closure {s : set (filter α)} {l : filter α} :
+  l ∈ closure s ↔ ∀ t ∈ l, ∃ l' ∈ s, t ∈ l' :=
+by simp only [closure_eq_compl_interior_compl, filter.mem_interior, mem_compl_iff, not_exists,
+  not_forall, not_not, exists_prop, not_and, and_comm, subset_def, mem_Iic, le_principal_iff]
+
+@[simp] protected lemma closure_singleton (l : filter α) : closure {l} = Ici l :=
+by { ext l', simp [filter.mem_closure, filter.le_def] }
+
+@[simp] lemma specializes_iff_le {l₁ l₂ : filter α} : l₁ ⤳ l₂ ↔ l₁ ≤ l₂ :=
+by simp only [specializes_iff_closure_subset, filter.closure_singleton, Ici_subset_Ici]
+
+instance : t0_space (filter α) :=
+⟨λ x y h, (specializes_iff_le.1 h.specializes).antisymm (specializes_iff_le.1 h.symm.specializes)⟩
+
+lemma nhds_at_top [preorder α] : 𝓝 at_top = ⨅ x : α, 𝓟 (Iic (𝓟 (Ici x))) :=
+by simp only [at_top, nhds_infi, nhds_principal]
+
+protected lemma tendsto_nhds_at_top_iff [preorder β] {l : filter α} {f : α → filter β} :
+  tendsto f l (𝓝 at_top) ↔ ∀ y, ∀ᶠ a in l, Ici y ∈ f a :=
+by simp only [nhds_at_top, tendsto_infi, tendsto_principal, mem_Iic, le_principal_iff]
+
+lemma nhds_at_bot [preorder α] : 𝓝 at_bot = ⨅ x : α, 𝓟 (Iic (𝓟 (Iic x))) := @nhds_at_top αᵒᵈ _
+
+protected lemma tendsto_nhds_at_bot_iff [preorder β] {l : filter α} {f : α → filter β} :
+  tendsto f l (𝓝 at_bot) ↔ ∀ y, ∀ᶠ a in l, Iic y ∈ f a :=
+@filter.tendsto_nhds_at_top_iff α βᵒᵈ _ _ _
+
+variables [topological_space X]
+
+lemma nhds_nhds (x : X) :
+  𝓝 (𝓝 x) = ⨅ (s : set X) (hs : is_open s) (hx : x ∈ s), 𝓟 (Iic (𝓟 s)) :=
+by simp only [(nhds_basis_opens x).nhds.eq_binfi, infi_and, @infi_comm _ (_ ∈ _)]
+
+lemma inducing_nhds : inducing (𝓝 : X → filter X) :=
+inducing_iff_nhds.2 $ λ x, (nhds_def' _).trans $
+  by simp only [nhds_nhds, comap_infi, comap_principal, Iic_principal, preimage_set_of_eq,
+    ← mem_interior_iff_mem_nhds, set_of_mem_eq, is_open.interior_eq] { contextual := tt }
+
+@[continuity] lemma continuous_nhds : continuous (𝓝 : X → filter X) := inducing_nhds.continuous
+
+protected lemma tendsto.nhds {f : α → X} {l : filter α} {x : X} (h : tendsto f l (𝓝 x)) :
+  tendsto (𝓝 ∘ f) l (𝓝 (𝓝 x)) :=
+(continuous_nhds.tendsto _).comp h
+
+end filter
+
+variables [topological_space X] [topological_space Y] {f : X → Y} {x : X} {s : set X}
+
+lemma continuous_within_at.nhds (h : continuous_within_at f s x) :
+  continuous_within_at (𝓝 ∘ f) s x :=
+h.nhds
+
+lemma continuous_at.nhds (h : continuous_at f x) : continuous_at (𝓝 ∘ f) x := h.nhds
+lemma continuous_on.nhds (h : continuous_on f s) : continuous_on (𝓝 ∘ f) s := λ x hx, (h x hx).nhds
+lemma continuous.nhds (h : continuous f) : continuous (𝓝 ∘ f) := filter.continuous_nhds.comp h
diff --git a/src/topology/gluing.lean b/src/topology/gluing.lean
index dad87c985c9e4..525390c4c3be2 100644
--- a/src/topology/gluing.lean
+++ b/src/topology/gluing.lean
@@ -3,13 +3,17 @@ Copyright (c) 2021 Andrew Yang. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Andrew Yang
 -/
-import topology.category.Top
 import category_theory.glue_data
 import category_theory.concrete_category.elementwise
+import topology.category.Top.limits.pullbacks
+import topology.category.Top.opens
 
 /-!
 # Gluing Topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a family of gluing data (see `category_theory/glue_data`), we can then glue them together.
 
 The construction should be "sealed" and considered as a black box, while only using the API
@@ -77,7 +81,7 @@ that the `U i`'s are open subspaces of the glued space.
 Most of the times it would be easier to use the constructor `Top.glue_data.mk'` where the conditions
 are stated in a less categorical way.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure glue_data extends glue_data Top :=
   (f_open : ∀ i j, open_embedding (f i j))
   (f_mono := λ i j, (Top.mono_iff_injective _).mpr (f_open i j).to_embedding.inj)
@@ -96,8 +100,10 @@ begin
   delta category_theory.glue_data.ι,
   simp_rw ← multicoequalizer.ι_sigma_π 𝖣 .diagram,
   rw ← (homeo_of_iso (multicoequalizer.iso_coequalizer 𝖣 .diagram).symm).is_open_preimage,
-  rw [coequalizer_is_open_iff, colimit_is_open_iff],
-  refl
+  rw [coequalizer_is_open_iff, colimit_is_open_iff.{u}],
+  split,
+  { intros h j, exact h ⟨j⟩, },
+  { intros h j, cases j, exact h j, },
 end
 
 lemma ι_jointly_surjective (x : 𝖣 .glued) : ∃ i (y : D.U i), 𝖣 .ι i y = x :=
@@ -169,20 +175,20 @@ begin
     simp_rw ← multicoequalizer.ι_sigma_π,
     intro h,
     rw ← (show _ = sigma.mk i x,
-      from concrete_category.congr_hom (sigma_iso_sigma D.U).inv_hom_id _),
+      from concrete_category.congr_hom (sigma_iso_sigma.{u} D.U).inv_hom_id _),
     rw ← (show _ = sigma.mk j y,
-      from concrete_category.congr_hom (sigma_iso_sigma D.U).inv_hom_id _),
-    change inv_image D.rel (sigma_iso_sigma D.U).hom _ _,
+      from concrete_category.congr_hom (sigma_iso_sigma.{u} D.U).inv_hom_id _),
+    change inv_image D.rel (sigma_iso_sigma.{u} D.U).hom _ _,
     simp only [Top.sigma_iso_sigma_inv_apply],
     rw ← (inv_image.equivalence _ _ D.rel_equiv).eqv_gen_iff,
     refine eqv_gen.mono _ (D.eqv_gen_of_π_eq h : _),
     rintros _ _ ⟨x⟩,
-    rw ← (show (sigma_iso_sigma _).inv _ = x,
-      from concrete_category.congr_hom (sigma_iso_sigma _).hom_inv_id x),
-    generalize : (sigma_iso_sigma D.V).hom x = x',
+    rw ← (show (sigma_iso_sigma.{u} _).inv _ = x,
+      from concrete_category.congr_hom (sigma_iso_sigma.{u} _).hom_inv_id x),
+    generalize : (sigma_iso_sigma.{u} D.V).hom x = x',
     obtain ⟨⟨i,j⟩,y⟩ := x',
     unfold inv_image multispan_index.fst_sigma_map multispan_index.snd_sigma_map,
-    simp only [opens.inclusion_to_fun, Top.comp_app, sigma_iso_sigma_inv_apply,
+    simp only [opens.inclusion_apply, Top.comp_app, sigma_iso_sigma_inv_apply,
       category_theory.limits.colimit.ι_desc_apply, cofan.mk_ι_app,
       sigma_iso_sigma_hom_ι_apply, continuous_map.to_fun_eq_coe],
     erw [sigma_iso_sigma_hom_ι_apply, sigma_iso_sigma_hom_ι_apply],
@@ -256,7 +262,7 @@ begin
   rw preimage_image_eq_image,
   apply (D.f_open _ _).is_open_map,
   apply (D.t j i ≫ D.f i j).continuous_to_fun.is_open_preimage,
-  exact U.property
+  exact U.is_open
 end
 
 lemma ι_open_embedding (i : D.J) : open_embedding (𝖣 .ι i) :=
@@ -277,7 +283,7 @@ such that
 
 We can then glue the topological spaces `U i` together by identifying `V i j` with `V j i`.
 -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure mk_core :=
 {J : Type u}
 (U : J → Top.{u})
diff --git a/src/topology/hom/open.lean b/src/topology/hom/open.lean
index 67ad4a5d027fd..9225e3976caf1 100644
--- a/src/topology/hom/open.lean
+++ b/src/topology/hom/open.lean
@@ -8,6 +8,9 @@ import topology.continuous_function.basic
 /-!
 # Continuous open maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines bundled continuous open maps.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -33,6 +36,9 @@ structure continuous_open_map (α β : Type*) [topological_space α] [topologica
 
 infixr ` →CO `:25 := continuous_open_map
 
+section
+set_option old_structure_cmd true
+
 /-- `continuous_open_map_class F α β` states that `F` is a type of continuous open maps.
 
 You should extend this class when you extend `continuous_open_map`. -/
@@ -40,6 +46,8 @@ class continuous_open_map_class (F : Type*) (α β : out_param $ Type*) [topolog
   [topological_space β] extends continuous_map_class F α β :=
 (map_open (f : F) : is_open_map f)
 
+end
+
 export continuous_open_map_class (map_open)
 
 instance [topological_space α] [topological_space β] [continuous_open_map_class F α β] :
@@ -70,6 +78,9 @@ definitional equalities. -/
 protected def copy (f : α →CO β) (f' : α → β) (h : f' = f) : α →CO β :=
 ⟨f.to_continuous_map.copy f' $ by exact h, h.symm.subst f.map_open'⟩
 
+@[simp] lemma coe_copy (f : α →CO β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : α →CO β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `continuous_open_map`. -/
diff --git a/src/topology/homeomorph.lean b/src/topology/homeomorph.lean
index eaf7605b21f74..b57762b6e6c4e 100644
--- a/src/topology/homeomorph.lean
+++ b/src/topology/homeomorph.lean
@@ -10,6 +10,9 @@ import topology.support
 /-!
 # Homeomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines homeomorphisms between two topological spaces. They are bijections with both
 directions continuous. We denote homeomorphisms with the notation `≃ₜ`.
 
@@ -27,12 +30,12 @@ directions continuous. We denote homeomorphisms with the notation `≃ₜ`.
 -/
 
 open set filter
-open_locale topological_space
+open_locale topology
 
 variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
 
 /-- Homeomorphism between `α` and `β`, also called topological isomorphism -/
-@[nolint has_inhabited_instance] -- not all spaces are homeomorphic to each other
+@[nolint has_nonempty_instance] -- not all spaces are homeomorphic to each other
 structure homeomorph (α : Type*) (β : Type*) [topological_space α] [topological_space β]
   extends α ≃ β :=
 (continuous_to_fun  : continuous to_fun . tactic.interactive.continuity')
@@ -49,8 +52,6 @@ instance : has_coe_to_fun (α ≃ₜ β) (λ _, α → β) := ⟨λe, e.to_equiv
   ((homeomorph.mk a b c) : α → β) = a :=
 rfl
 
-@[simp] lemma coe_to_equiv (h : α ≃ₜ β) : ⇑h.to_equiv = h := rfl
-
 /-- Inverse of a homeomorphism. -/
 protected def symm (h : α ≃ₜ β) : β ≃ₜ α :=
 { continuous_to_fun  := h.continuous_inv_fun,
@@ -66,12 +67,17 @@ def simps.symm_apply (h : α ≃ₜ β) : β → α := h.symm
 initialize_simps_projections homeomorph
   (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)
 
+@[simp] lemma coe_to_equiv (h : α ≃ₜ β) : ⇑h.to_equiv = h := rfl
+@[simp] lemma coe_symm_to_equiv (h : α ≃ₜ β) : ⇑h.to_equiv.symm = h.symm := rfl
+
 lemma to_equiv_injective : function.injective (to_equiv : α ≃ₜ β → α ≃ β)
 | ⟨e, h₁, h₂⟩ ⟨e', h₁', h₂'⟩ rfl := rfl
 
 @[ext] lemma ext {h h' : α ≃ₜ β} (H : ∀ x, h x = h' x) : h = h' :=
 to_equiv_injective $ equiv.ext H
 
+@[simp] lemma symm_symm (h : α ≃ₜ β) : h.symm.symm = h := ext $ λ _, rfl
+
 /-- Identity map as a homeomorphism. -/
 @[simps apply {fully_applied := ff}]
 protected def refl (α : Type*) [topological_space α] : α ≃ₜ α :=
@@ -105,6 +111,12 @@ h.to_equiv.apply_symm_apply x
 @[simp] lemma symm_apply_apply (h : α ≃ₜ β) (x : α) : h.symm (h x) = x :=
 h.to_equiv.symm_apply_apply x
 
+@[simp] lemma self_trans_symm (h : α ≃ₜ β) : h.trans h.symm = homeomorph.refl α :=
+by { ext, apply symm_apply_apply }
+
+@[simp] lemma symm_trans_self (h : α ≃ₜ β) : h.symm.trans h = homeomorph.refl β :=
+by { ext, apply apply_symm_apply }
+
 protected lemma bijective (h : α ≃ₜ β) : function.bijective h := h.to_equiv.bijective
 protected lemma injective (h : α ≃ₜ β) : function.injective h := h.to_equiv.injective
 protected lemma surjective (h : α ≃ₜ β) : function.surjective h := h.to_equiv.surjective
@@ -159,32 +171,32 @@ protected lemma embedding (h : α ≃ₜ β) : embedding h :=
 
 /-- Homeomorphism given an embedding. -/
 noncomputable def of_embedding (f : α → β) (hf : embedding f) : α ≃ₜ (set.range f) :=
-{ continuous_to_fun := continuous_subtype_mk _ hf.continuous,
+{ continuous_to_fun := hf.continuous.subtype_mk _,
   continuous_inv_fun := by simp [hf.continuous_iff, continuous_subtype_coe],
-  .. equiv.of_injective f hf.inj }
+  to_equiv := equiv.of_injective f hf.inj }
 
 protected lemma second_countable_topology [topological_space.second_countable_topology β]
   (h : α ≃ₜ β) :
   topological_space.second_countable_topology α :=
 h.inducing.second_countable_topology
 
-lemma compact_image {s : set α} (h : α ≃ₜ β) : is_compact (h '' s) ↔ is_compact s :=
+lemma is_compact_image {s : set α} (h : α ≃ₜ β) : is_compact (h '' s) ↔ is_compact s :=
 h.embedding.is_compact_iff_is_compact_image.symm
 
-lemma compact_preimage {s : set β} (h : α ≃ₜ β) : is_compact (h ⁻¹' s) ↔ is_compact s :=
-by rw ← image_symm; exact h.symm.compact_image
+lemma is_compact_preimage {s : set β} (h : α ≃ₜ β) : is_compact (h ⁻¹' s) ↔ is_compact s :=
+by rw ← image_symm; exact h.symm.is_compact_image
 
 @[simp] lemma comap_cocompact (h : α ≃ₜ β) : comap h (cocompact β) = cocompact α :=
 (comap_cocompact_le h.continuous).antisymm $
   (has_basis_cocompact.le_basis_iff (has_basis_cocompact.comap h)).2 $ λ K hK,
-    ⟨h ⁻¹' K, h.compact_preimage.2 hK, subset.rfl⟩
+    ⟨h ⁻¹' K, h.is_compact_preimage.2 hK, subset.rfl⟩
 
 @[simp] lemma map_cocompact (h : α ≃ₜ β) : map h (cocompact α) = cocompact β :=
 by rw [← h.comap_cocompact, map_comap_of_surjective h.surjective]
 
 protected lemma compact_space [compact_space α] (h : α ≃ₜ β) : compact_space β :=
-{ compact_univ := by { rw [← image_univ_of_surjective h.surjective, h.compact_image],
-    apply compact_space.compact_univ } }
+{ is_compact_univ := by { rw [← image_univ_of_surjective h.surjective, h.is_compact_image],
+    apply compact_space.is_compact_univ } }
 
 protected lemma t0_space [t0_space α] (h : α ≃ₜ β) : t0_space β :=
 h.symm.embedding.t0_space
@@ -195,8 +207,8 @@ h.symm.embedding.t1_space
 protected lemma t2_space [t2_space α] (h : α ≃ₜ β) : t2_space β :=
 h.symm.embedding.t2_space
 
-protected lemma regular_space [regular_space α] (h : α ≃ₜ β) : regular_space β :=
-h.symm.embedding.regular_space
+protected lemma t3_space [t3_space α] (h : α ≃ₜ β) : t3_space β :=
+h.symm.embedding.t3_space
 
 protected lemma dense_embedding (h : α ≃ₜ β) : dense_embedding h :=
 { dense   := h.surjective.dense_range,
@@ -242,6 +254,9 @@ by rw [← preimage_symm, preimage_interior]
 lemma preimage_frontier (h : α ≃ₜ β) (s : set β) : h ⁻¹' (frontier s) = frontier (h ⁻¹' s) :=
 h.is_open_map.preimage_frontier_eq_frontier_preimage h.continuous _
 
+lemma image_frontier (h : α ≃ₜ β) (s : set α) : h '' frontier s = frontier (h '' s) :=
+by rw [←preimage_symm, preimage_frontier]
+
 @[to_additive]
 lemma _root_.has_compact_mul_support.comp_homeomorph {M} [has_one M] {f : β → M}
   (hf : has_compact_mul_support f) (φ : α ≃ₜ β) : has_compact_mul_support (f ∘ φ) :=
@@ -315,24 +330,14 @@ end
 
 /-- If two sets are equal, then they are homeomorphic. -/
 def set_congr {s t : set α} (h : s = t) : s ≃ₜ t :=
-{ continuous_to_fun := continuous_subtype_mk _ continuous_subtype_val,
-  continuous_inv_fun := continuous_subtype_mk _ continuous_subtype_val,
+{ continuous_to_fun := continuous_inclusion h.subset,
+  continuous_inv_fun := continuous_inclusion h.symm.subset,
   to_equiv := equiv.set_congr h }
 
 /-- Sum of two homeomorphisms. -/
 def sum_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : α ⊕ γ ≃ₜ β ⊕ δ :=
-{ continuous_to_fun  :=
-  begin
-    convert continuous_sum_rec (continuous_inl.comp h₁.continuous)
-      (continuous_inr.comp h₂.continuous),
-    ext x, cases x; refl,
-  end,
-  continuous_inv_fun :=
-  begin
-    convert continuous_sum_rec (continuous_inl.comp h₁.symm.continuous)
-      (continuous_inr.comp h₂.symm.continuous),
-    ext x, cases x; refl
-  end,
+{ continuous_to_fun  := h₁.continuous.sum_map h₂.continuous,
+  continuous_inv_fun := h₁.symm.continuous.sum_map h₂.symm.continuous,
   to_equiv := h₁.to_equiv.sum_congr h₂.to_equiv }
 
 /-- Product of two homeomorphisms. -/
@@ -382,8 +387,26 @@ def punit_prod : punit × α ≃ₜ α :=
 
 @[simp] lemma coe_punit_prod : ⇑(punit_prod α) = prod.snd := rfl
 
+/-- If both `α` and `β` have a unique element, then `α ≃ₜ β`. -/
+@[simps] def _root_.homeomorph.homeomorph_of_unique [unique α] [unique β] : α ≃ₜ β :=
+{ continuous_to_fun := @continuous_const α β _ _ default,
+  continuous_inv_fun := @continuous_const β α _ _ default,
+  .. equiv.equiv_of_unique α β }
+
 end
 
+/-- If each `β₁ i` is homeomorphic to `β₂ i`, then `Π i, β₁ i` is homeomorphic to `Π i, β₂ i`. -/
+@[simps apply to_equiv] def Pi_congr_right {ι : Type*} {β₁ β₂ : ι → Type*}
+  [Π i, topological_space (β₁ i)] [Π i, topological_space (β₂ i)] (F : Π i, β₁ i ≃ₜ β₂ i) :
+  (Π i, β₁ i) ≃ₜ (Π i, β₂ i) :=
+{ continuous_to_fun := continuous_pi (λ i, (F i).continuous.comp $ continuous_apply i),
+  continuous_inv_fun := continuous_pi (λ i, (F i).symm.continuous.comp $ continuous_apply i),
+  to_equiv := equiv.Pi_congr_right (λ i, (F i).to_equiv) }
+
+@[simp] lemma Pi_congr_right_symm {ι : Type*} {β₁ β₂ : ι → Type*} [Π i, topological_space (β₁ i)]
+  [Π i, topological_space (β₂ i)] (F : Π i, β₁ i ≃ₜ β₂ i) :
+  (Pi_congr_right F).symm = Pi_congr_right (λ i, (F i).symm) := rfl
+
 /-- `ulift α` is homeomorphic to `α`. -/
 def {u v} ulift {α : Type u} [topological_space α] : ulift.{v u} α ≃ₜ α :=
 { continuous_to_fun := continuous_ulift_down,
@@ -394,16 +417,9 @@ section distrib
 
 /-- `(α ⊕ β) × γ` is homeomorphic to `α × γ ⊕ β × γ`. -/
 def sum_prod_distrib : (α ⊕ β) × γ ≃ₜ α × γ ⊕ β × γ :=
-begin
-  refine (homeomorph.homeomorph_of_continuous_open (equiv.sum_prod_distrib α β γ).symm _ _).symm,
-  { convert continuous_sum_rec
-      ((continuous_inl.comp continuous_fst).prod_mk continuous_snd)
-      ((continuous_inr.comp continuous_fst).prod_mk continuous_snd),
-    ext1 x, cases x; refl, },
-  { exact (is_open_map_sum
-    (open_embedding_inl.prod open_embedding_id).is_open_map
-    (open_embedding_inr.prod open_embedding_id).is_open_map) }
-end
+homeomorph.symm $ homeomorph_of_continuous_open (equiv.sum_prod_distrib α β γ).symm
+  ((continuous_inl.prod_map continuous_id).sum_elim (continuous_inr.prod_map continuous_id)) $
+  (is_open_map_inl.prod is_open_map.id).sum_elim (is_open_map_inr.prod is_open_map.id)
 
 /-- `α × (β ⊕ γ)` is homeomorphic to `α × β ⊕ α × γ`. -/
 def prod_sum_distrib : α × (β ⊕ γ) ≃ₜ α × β ⊕ α × γ :=
@@ -415,12 +431,9 @@ variables {ι : Type*} {σ : ι → Type*} [Π i, topological_space (σ i)]
 
 /-- `(Σ i, σ i) × β` is homeomorphic to `Σ i, (σ i × β)`. -/
 def sigma_prod_distrib : ((Σ i, σ i) × β) ≃ₜ (Σ i, (σ i × β)) :=
-homeomorph.symm $
-homeomorph_of_continuous_open (equiv.sigma_prod_distrib σ β).symm
-  (continuous_sigma $ λ i,
-    (continuous_sigma_mk.comp continuous_fst).prod_mk continuous_snd)
-  (is_open_map_sigma $ λ i,
-    (open_embedding_sigma_mk.prod open_embedding_id).is_open_map)
+homeomorph.symm $ homeomorph_of_continuous_open (equiv.sigma_prod_distrib σ β).symm
+  (continuous_sigma $ λ i, continuous_sigma_mk.fst'.prod_mk continuous_snd)
+  (is_open_map_sigma.2 $ λ i, is_open_map_sigma_mk.prod is_open_map.id)
 
 end distrib
 
@@ -445,10 +458,58 @@ def {u} pi_fin_two (α : fin 2 → Type u) [Π i, topological_space (α i)] : (
 /--
 A subset of a topological space is homeomorphic to its image under a homeomorphism.
 -/
-def image (e : α ≃ₜ β) (s : set α) : s ≃ₜ e '' s :=
+@[simps] def image (e : α ≃ₜ β) (s : set α) : s ≃ₜ e '' s :=
 { continuous_to_fun := by continuity!,
   continuous_inv_fun := by continuity!,
-  ..e.to_equiv.image s, }
+  to_equiv := e.to_equiv.image s, }
+
+/-- `set.univ α` is homeomorphic to `α`. -/
+@[simps { fully_applied := ff }]
+def set.univ (α : Type*) [topological_space α] : (univ : set α) ≃ₜ α :=
+{ to_equiv := equiv.set.univ α,
+  continuous_to_fun := continuous_subtype_coe,
+  continuous_inv_fun := continuous_id.subtype_mk _ }
+
+/-- `s ×ˢ t` is homeomorphic to `s × t`. -/
+@[simps] def set.prod (s : set α) (t : set β) : ↥(s ×ˢ t) ≃ₜ s × t :=
+{ to_equiv := equiv.set.prod s t,
+  continuous_to_fun := (continuous_subtype_coe.fst.subtype_mk _).prod_mk
+    (continuous_subtype_coe.snd.subtype_mk _),
+  continuous_inv_fun := (continuous_subtype_coe.fst'.prod_mk
+    continuous_subtype_coe.snd').subtype_mk _ }
+
+section
+
+variable {ι : Type*}
+
+/-- The topological space `Π i, β i` can be split as a product by separating the indices in ι
+  depending on whether they satisfy a predicate p or not.-/
+@[simps] def pi_equiv_pi_subtype_prod (p : ι → Prop) (β : ι → Type*) [Π i, topological_space (β i)]
+  [decidable_pred p] : (Π i, β i) ≃ₜ (Π i : {x // p x}, β i) × Π i : {x // ¬p x}, β i :=
+{ to_equiv := equiv.pi_equiv_pi_subtype_prod p β,
+  continuous_to_fun := by apply continuous.prod_mk; exact continuous_pi (λ j, continuous_apply j),
+  continuous_inv_fun := continuous_pi $ λ j, begin
+    dsimp only [equiv.pi_equiv_pi_subtype_prod], split_ifs,
+    exacts [(continuous_apply _).comp continuous_fst, (continuous_apply _).comp continuous_snd],
+  end }
+
+variables [decidable_eq ι] (i : ι)
+
+/-- A product of topological spaces can be split as the binary product of one of the spaces and
+  the product of all the remaining spaces. -/
+@[simps] def pi_split_at (β : ι → Type*) [Π j, topological_space (β j)] :
+  (Π j, β j) ≃ₜ β i × Π j : {j // j ≠ i}, β j :=
+{ to_equiv := equiv.pi_split_at i β,
+  continuous_to_fun := (continuous_apply i).prod_mk (continuous_pi $ λ j, continuous_apply j),
+  continuous_inv_fun := continuous_pi $ λ j, by { dsimp only [equiv.pi_split_at],
+    split_ifs, subst h, exacts [continuous_fst, (continuous_apply _).comp continuous_snd] } }
+
+variable (β)
+/-- A product of copies of a topological space can be split as the binary product of one copy and
+  the product of all the remaining copies. -/
+@[simps] def fun_split_at : (ι → β) ≃ₜ β × ({j // j ≠ i} → β) := pi_split_at i _
+
+end
 
 end homeomorph
 
diff --git a/src/topology/homotopy/H_spaces.lean b/src/topology/homotopy/H_spaces.lean
new file mode 100644
index 0000000000000..be4fc947d1914
--- /dev/null
+++ b/src/topology/homotopy/H_spaces.lean
@@ -0,0 +1,248 @@
+/-
+Copyright (c) 2022 Filippo A. E. Nuccio Mortarino Majno di Capriglio. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Filippo A. E. Nuccio, Junyan Xu
+-/
+import topology.compact_open
+import topology.homotopy.path
+
+/-!
+# H-spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines H-spaces mainly following the approach proposed by Serre in his paper
+*Homologie singulière des espaces fibrés*. The idea beaneath `H-spaces` is that they are topological
+spaces with a binary operation `⋀ : X → X → X` that is a homotopic-theoretic weakening of an
+operation what would make `X` into a topological monoid. In particular, there exists a "neutral
+element" `e : X` such that `λ x, e ⋀ x` and `λ x, x ⋀ e` are homotopic to the identity on `X`, see
+[the Wikipedia page of H-spaces](https://en.wikipedia.org/wiki/H-space).
+
+Some notable properties of `H-spaces` are
+* Their fundamental group is always abelian (by the same argument for topological groups);
+* Their cohomology ring comes equipped with a structure of a Hopf-algebra;
+* The loop space based at every `x : X` carries a structure of an `H-spaces`.
+
+## Main Results
+
+* Every topological group `G` is an `H-space` using its operation `* : G → G → G` (this is already
+true if `G` has an instance of a `mul_one_class` and `continuous_mul`);
+* Given two `H-spaces` `X` and `Y`, their product is again an `H`-space. We show in an example that
+starting with two topological groups `G, G'`, the `H`-space structure on `G × G'` is definitionally
+equal to the product of `H-space` structures on `G` and `G'`.
+* The loop space based at every `x : X` carries a structure of an `H-spaces`.
+
+## To Do
+* Prove that for every `normed_add_torsor Z` and every `z : Z`, the operation
+`λ x y, midpoint x y` defines a `H-space` structure with `z` as a "neutral element".
+* Prove that `S^0`, `S^1`, `S^3` and `S^7` are the unique spheres that are `H-spaces`, where the
+first three inherit the structure because they are topological groups (they are Lie groups,
+actually), isomorphic to the invertible elements in `ℤ`, in `ℂ` and in the quaternion; and the
+fourth from the fact that `S^7` coincides with the octonions of norm 1 (it is not a group, in
+particular, only has an instance of `mul_one_class`).
+
+## References
+
+* [J.-P. Serre, *Homologie singulière des espaces fibrés. Applications*,
+  Ann. of Math (2) 1951, 54, 425–505][serre1951]
+-/
+
+universes u v
+
+noncomputable theory
+
+open_locale unit_interval
+
+open path continuous_map set.Icc topological_space
+
+/--
+A topological space `X` is an H-space if it behaves like a (potentially non-associative)
+topological group, but where the axioms for a group only hold up to homotopy.
+-/
+class H_space (X : Type u) [topological_space X] :=
+(Hmul : C(X × X, X))
+(e : X)
+(Hmul_e_e : Hmul (e, e) = e)
+(e_Hmul : (Hmul.comp $ (const X e).prod_mk $ continuous_map.id X).homotopy_rel
+  (continuous_map.id X) {e})
+(Hmul_e : (Hmul.comp $ (continuous_map.id X).prod_mk $ const X e).homotopy_rel
+  (continuous_map.id X) {e})
+
+/- We use the notation `⋀`, typeset as \And, to denote the binary operation `Hmul` on a H-space -/
+localized "notation (name := H_space.Hmul) x `⋀` y := H_space.Hmul (x, y) " in H_spaces
+
+instance H_space.prod (X : Type u) (Y : Type v) [topological_space X] [topological_space Y]
+[H_space X] [H_space Y] : H_space (X × Y) :=
+{ Hmul := ⟨λ p, ((p.1.1 ⋀ p.2.1),  p.1.2 ⋀ p.2.2), by continuity⟩,
+  e := (H_space.e, H_space.e),
+  Hmul_e_e := by {simp only [continuous_map.coe_mk, prod.mk.inj_iff],
+    exact ⟨H_space.Hmul_e_e, H_space.Hmul_e_e⟩},
+  e_Hmul :=
+  begin
+    let G : I × (X × Y) → X × Y :=
+      (λ p, (H_space.e_Hmul (p.1, p.2.1), H_space.e_Hmul (p.1, p.2.2))),
+    have hG : continuous G := (continuous.comp H_space.e_Hmul.1.1.2 (continuous_fst.prod_mk
+      (continuous_fst.comp continuous_snd))).prod_mk (continuous.comp H_space.e_Hmul.1.1.2
+      (continuous_fst.prod_mk (continuous_snd.comp continuous_snd))),
+    use ⟨G, hG⟩,
+    { rintros ⟨x, y⟩,
+      exacts prod.mk.inj_iff.mpr ⟨(H_space.e_Hmul).1.2 x, (H_space.e_Hmul).1.2 y⟩ },
+    { rintros ⟨x, y⟩,
+      exact prod.mk.inj_iff.mpr ⟨(H_space.e_Hmul).1.3 x, (H_space.e_Hmul).1.3 y⟩ },
+    { rintros t ⟨x, y⟩ h,
+      replace h := prod.mk.inj_iff.mp (set.mem_singleton_iff.mp h),
+      exact ⟨prod.mk.inj_iff.mpr ⟨homotopy_rel.eq_fst (H_space.e_Hmul) t
+        (set.mem_singleton_iff.mpr h.1),
+        homotopy_rel.eq_fst (H_space.e_Hmul) t (set.mem_singleton_iff.mpr h.2)⟩,
+        prod.mk.inj_iff.mpr ⟨((H_space.e_Hmul).2 t x h.1).2, ((H_space.e_Hmul).2 t y h.2).2⟩⟩ },
+  end,
+  Hmul_e :=
+  begin
+    let G : I × (X × Y) → X × Y :=
+      (λ p, (H_space.Hmul_e (p.1, p.2.1), H_space.Hmul_e (p.1, p.2.2))),
+    have hG : continuous G := (continuous.comp H_space.Hmul_e.1.1.2 (continuous_fst.prod_mk
+      (continuous_fst.comp continuous_snd))).prod_mk (continuous.comp H_space.Hmul_e.1.1.2
+      (continuous_fst.prod_mk (continuous_snd.comp continuous_snd))),
+    use ⟨G, hG⟩,
+    { rintros ⟨x, y⟩,
+      exacts prod.mk.inj_iff.mpr ⟨(H_space.Hmul_e).1.2 x, (H_space.Hmul_e).1.2 y⟩ },
+    { rintros ⟨x, y⟩,
+      exact prod.mk.inj_iff.mpr ⟨(H_space.Hmul_e).1.3 x, (H_space.Hmul_e).1.3 y⟩ },
+    { rintros t ⟨x, y⟩ h,
+      replace h := prod.mk.inj_iff.mp (set.mem_singleton_iff.mp h),
+      exact ⟨prod.mk.inj_iff.mpr ⟨homotopy_rel.eq_fst (H_space.Hmul_e) t
+        (set.mem_singleton_iff.mpr h.1), homotopy_rel.eq_fst (H_space.Hmul_e) t
+        (set.mem_singleton_iff.mpr h.2)⟩, prod.mk.inj_iff.mpr ⟨((H_space.Hmul_e).2 t x h.1).2,
+        ((H_space.Hmul_e).2 t y h.2).2⟩⟩ },
+  end, }
+
+namespace topological_group
+
+/-- The definition `to_H_space` is not an instance because its `@additive` version would
+lead to a diamond since a topological field would inherit two `H_space` structures, one from the
+`mul_one_class` and one from the `add_zero_class`. In the case of a group, we make
+`topological_group.H_space` an instance."-/
+@[to_additive "The definition `to_H_space` is not an instance because it comes together with a
+multiplicative version which would lead to a diamond since a topological field would inherit two
+`H_space` structures, one from the `mul_one_class` and one from the `add_zero_class`. In the case
+of an additive group, we make `topological_group.H_space` an instance."]
+definition to_H_space (M : Type u) [mul_one_class M] [topological_space M]
+  [has_continuous_mul M] : H_space M :=
+{ Hmul := ⟨function.uncurry has_mul.mul, continuous_mul⟩,
+  e := 1,
+  Hmul_e_e := one_mul 1,
+  e_Hmul := (homotopy_rel.refl _ _).cast rfl (by {ext1, apply one_mul}),
+  Hmul_e := (homotopy_rel.refl _ _).cast rfl (by {ext1, apply mul_one}) }
+
+@[priority 600, to_additive] instance H_space (G : Type u)
+  [topological_space G] [group G] [topological_group G] : H_space G := to_H_space G
+
+lemma one_eq_H_space_e {G : Type u} [topological_space G] [group G] [topological_group G] :
+  (1 : G) = H_space.e := rfl
+
+/- In the following example we see that the `H-space` structure on the product of two topological
+groups is definitionally equally to the product `H-space`-structure of the two groups.-/
+
+example {G G' : Type u} [topological_space G] [group G] [topological_group G]
+  [topological_space G'] [group G'] [topological_group G'] :
+  to_H_space (G × G') = H_space.prod G G' := rfl
+
+end topological_group
+
+namespace unit_interval
+
+/-- `Q_right` is analogous to the function `Q` defined on p. 475 of [serre1951] that helps proving
+continuity of `delay_refl_right`.-/
+def Q_right (p : I × I) : I := set.proj_Icc 0 1 zero_le_one (2 * p.1 / (1 + p.2))
+
+lemma continuous_Q_right : continuous Q_right :=
+continuous_proj_Icc.comp $ continuous.div (by continuity) (by continuity)
+  (λ x, (add_pos zero_lt_one).ne')
+
+lemma Q_right_zero_left (θ : I) : Q_right (0, θ) = 0 :=
+set.proj_Icc_of_le_left _ $ by simp only [coe_zero, mul_zero, zero_div]
+
+lemma Q_right_one_left (θ : I) : Q_right (1, θ) = 1 :=
+set.proj_Icc_of_right_le _ $ (le_div_iff $ add_pos zero_lt_one).2 $
+  by { dsimp only, rw [coe_one, one_mul, mul_one], apply add_le_add_left (le_one _) }
+
+lemma Q_right_zero_right (t : I) : (Q_right (t, 0) : ℝ) = if (t : ℝ) ≤ 1 / 2 then 2 * t else 1 :=
+begin
+  simp only [Q_right, coe_zero, add_zero, div_one],
+  split_ifs,
+  { rw set.proj_Icc_of_mem _ ((mul_pos_mem_iff zero_lt_two).2 _), exacts [rfl, ⟨t.2.1, h⟩] },
+  { rw (set.proj_Icc_eq_right _).2, { refl }, { linarith }, { exact zero_lt_one } },
+end
+
+lemma Q_right_one_right (t : I) : Q_right (t, 1) = t :=
+eq.trans (by {rw Q_right, congr, apply mul_div_cancel_left, exact two_ne_zero}) $
+  set.proj_Icc_coe zero_le_one _
+
+end unit_interval
+
+namespace path
+
+open unit_interval
+
+variables {X : Type u} [topological_space X] {x y : X}
+
+/-- This is the function analogous to the one on p. 475 of [serre1951], defining a homotopy from
+the product path `γ ∧ e` to `γ`.-/
+def delay_refl_right (θ : I) (γ : path x y) : path x y :=
+{ to_fun := λ t, γ (Q_right (t, θ)),
+  continuous_to_fun := γ.continuous.comp (continuous_Q_right.comp $ continuous.prod.mk_left θ),
+  source' := by { dsimp only, rw [Q_right_zero_left, γ.source] },
+  target' := by { dsimp only, rw [Q_right_one_left, γ.target] } }
+
+lemma continuous_delay_refl_right : continuous (λ p : I × path x y, delay_refl_right p.1 p.2) :=
+  continuous_uncurry_iff.mp $ (continuous_snd.comp continuous_fst).path_eval $
+  continuous_Q_right.comp $ continuous_snd.prod_mk $ continuous_fst.comp continuous_fst
+
+lemma delay_refl_right_zero (γ : path x y) : delay_refl_right 0 γ = γ.trans (path.refl y) :=
+begin
+  ext t,
+  simp only [delay_refl_right,
+    trans_apply, refl_extend, path.coe_mk, function.comp_app, refl_apply],
+  split_ifs, swap, conv_rhs { rw ← γ.target },
+  all_goals { apply congr_arg γ, ext1, rw Q_right_zero_right },
+  exacts [if_neg h, if_pos h],
+end
+
+lemma delay_refl_right_one (γ : path x y) : delay_refl_right 1 γ = γ :=
+by { ext t, exact congr_arg γ (Q_right_one_right t) }
+
+/-- This is the function on p. 475 of [serre1951], defining a homotopy from a path `γ` to the
+product path `e ∧ γ`.-/
+def delay_refl_left (θ : I) (γ : path x y) : path x y := (delay_refl_right θ γ.symm).symm
+
+lemma continuous_delay_refl_left : continuous (λ p : I × path x y, delay_refl_left p.1 p.2) :=
+path.continuous_symm.comp $ continuous_delay_refl_right.comp $ continuous_fst.prod_mk $
+  path.continuous_symm.comp continuous_snd
+
+lemma delay_refl_left_zero (γ : path x y) : delay_refl_left 0 γ = (path.refl x).trans γ :=
+by simp only [delay_refl_left, delay_refl_right_zero, trans_symm, refl_symm, path.symm_symm]
+
+lemma delay_refl_left_one (γ : path x y) : delay_refl_left 1 γ = γ :=
+by simp only [delay_refl_left, delay_refl_right_one, path.symm_symm]
+
+/--
+The loop space at x carries a structure of a `H-space`. Note that the field `e_Hmul`
+(resp. `Hmul_e`) neither implies nor is implied by `path.homotopy.refl_trans`
+(resp. `path.homotopy.trans_refl`).
+-/
+
+instance (x : X) : H_space (path x x) :=
+{ Hmul := ⟨λ ρ, ρ.1.trans ρ.2, continuous_trans⟩,
+  e := refl x,
+  Hmul_e_e := refl_trans_refl,
+  e_Hmul :=
+  { to_homotopy := ⟨⟨λ p : I × (path x x), delay_refl_left p.1 p.2,
+      continuous_delay_refl_left⟩, delay_refl_left_zero, delay_refl_left_one⟩,
+    prop' := by { rintro t _ (rfl : _ = _), exact ⟨refl_trans_refl.symm, rfl⟩ } },
+  Hmul_e :=
+  { to_homotopy := ⟨⟨λ p : I × (path x x), delay_refl_right p.1 p.2,
+      continuous_delay_refl_right⟩, delay_refl_right_zero, delay_refl_right_one⟩,
+    prop' := by { rintro t _ (rfl : _ = _), exact ⟨refl_trans_refl.symm, rfl⟩ } } }
+
+end path
diff --git a/src/topology/homotopy/basic.lean b/src/topology/homotopy/basic.lean
index e5f049e094584..cf1216c36bf3a 100644
--- a/src/topology/homotopy/basic.lean
+++ b/src/topology/homotopy/basic.lean
@@ -12,6 +12,9 @@ import topology.unit_interval
 /-!
 # Homotopy between functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define a homotopy between two functions `f₀` and `f₁`. First we define
 `continuous_map.homotopy` between the two functions, with no restrictions on the intermediate
 maps. Then, as in the formalisation in HOL-Analysis, we define
@@ -74,6 +77,9 @@ structure homotopy (f₀ f₁ : C(X, Y)) extends C(I × X, Y) :=
 (map_zero_left' : ∀ x, to_fun (0, x) = f₀ x)
 (map_one_left' : ∀ x, to_fun (1, x) = f₁ x)
 
+section
+set_option old_structure_cmd true
+
 /-- `continuous_map.homotopy_like F f₀ f₁` states that `F` is a type of homotopies between `f₀` and
 `f₁`.
 
@@ -83,6 +89,8 @@ class homotopy_like (F : Type*) (f₀ f₁ : out_param $ C(X, Y))
 (map_zero_left (f : F) : ∀ x, f (0, x) = f₀ x)
 (map_one_left (f : F) : ∀ x, f (1, x) = f₁ x)
 
+end
+
 -- `f₀` and `f₁` are `out_param` so this is not dangerous
 attribute [nolint dangerous_instance] homotopy_like.to_continuous_map_class
 
@@ -141,24 +149,24 @@ lemma extend_apply_of_le_zero (F : homotopy f₀ f₁) {t : ℝ} (ht : t ≤ 0)
   F.extend t x = f₀ x :=
 begin
   rw [←F.apply_zero],
-  exact continuous_map.congr_fun (set.Icc_extend_of_le_left (@zero_le_one ℝ _) F.curry ht) x,
+  exact continuous_map.congr_fun (set.Icc_extend_of_le_left (zero_le_one' ℝ) F.curry ht) x,
 end
 
 lemma extend_apply_of_one_le (F : homotopy f₀ f₁) {t : ℝ} (ht : 1 ≤ t) (x : X) :
   F.extend t x = f₁ x :=
 begin
   rw [←F.apply_one],
-  exact continuous_map.congr_fun (set.Icc_extend_of_right_le (@zero_le_one ℝ _) F.curry ht) x,
+  exact continuous_map.congr_fun (set.Icc_extend_of_right_le (zero_le_one' ℝ) F.curry ht) x,
 end
 
 @[simp]
 lemma extend_apply_coe (F : homotopy f₀ f₁) (t : I) (x : X) : F.extend t x = F (t, x) :=
-continuous_map.congr_fun (set.Icc_extend_coe (@zero_le_one ℝ _) F.curry t) x
+continuous_map.congr_fun (set.Icc_extend_coe (zero_le_one' ℝ) F.curry t) x
 
 @[simp]
 lemma extend_apply_of_mem_I (F : homotopy f₀ f₁) {t : ℝ} (ht : t ∈ I) (x : X) :
   F.extend t x = F (⟨t, ht⟩, x) :=
-continuous_map.congr_fun (set.Icc_extend_of_mem (@zero_le_one ℝ _) F.curry ht) x
+continuous_map.congr_fun (set.Icc_extend_of_mem (zero_le_one' ℝ) F.curry ht) x
 
 lemma congr_fun {F G : homotopy f₀ f₁} (h : F = G) (x : I × X) : F x = G x :=
 continuous_map.congr_fun (congr_arg _ h) x
diff --git a/src/topology/homotopy/contractible.lean b/src/topology/homotopy/contractible.lean
index 582d8056a122c..27eac82476317 100644
--- a/src/topology/homotopy/contractible.lean
+++ b/src/topology/homotopy/contractible.lean
@@ -10,6 +10,9 @@ import topology.homotopy.equiv
 /-!
 # Contractible spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define `contractible_space`, a space that is homotopy equivalent to `unit`.
 -/
 
@@ -42,10 +45,8 @@ open_locale continuous_map
 class contractible_space (X : Type*) [topological_space X] : Prop :=
 (hequiv_unit [] : nonempty (X ≃ₕ unit))
 
-
-variables (X : Type*) [topological_space X] [contractible_space X]
-
-lemma id_nullhomotopic : (continuous_map.id X).nullhomotopic :=
+lemma id_nullhomotopic (X : Type*) [topological_space X] [contractible_space X] :
+  (continuous_map.id X).nullhomotopic :=
 begin
   obtain ⟨hv⟩ := contractible_space.hequiv_unit X,
   use hv.inv_fun (),
@@ -64,10 +65,29 @@ begin
   { exact h.symm, }, { convert homotopic.refl (continuous_map.id unit), ext, },
 end
 
+variables {X Y : Type*} [topological_space X] [topological_space Y]
+
+protected lemma continuous_map.homotopy_equiv.contractible_space [contractible_space Y]
+  (e : X ≃ₕ Y) :
+  contractible_space X :=
+⟨(contractible_space.hequiv_unit Y).map e.trans⟩
+
+protected lemma continuous_map.homotopy_equiv.contractible_space_iff (e : X ≃ₕ Y) :
+  contractible_space X ↔ contractible_space Y :=
+⟨by { introI h, exact e.symm.contractible_space }, by { introI h, exact e.contractible_space }⟩
+
+protected lemma homeomorph.contractible_space [contractible_space Y] (e : X ≃ₜ Y) :
+  contractible_space X :=
+e.to_homotopy_equiv.contractible_space
+
+protected lemma homeomorph.contractible_space_iff (e : X ≃ₜ Y) :
+  contractible_space X ↔ contractible_space Y :=
+e.to_homotopy_equiv.contractible_space_iff
+
 namespace contractible_space
 
 @[priority 100]
-instance : path_connected_space X :=
+instance [contractible_space X] : path_connected_space X :=
 begin
   obtain ⟨p, ⟨h⟩⟩ := id_nullhomotopic X,
   have : ∀ x, joined p x := λ x, ⟨(h.eval_at x).symm⟩,
diff --git a/src/topology/homotopy/equiv.lean b/src/topology/homotopy/equiv.lean
index 1e353c25bcae3..c0542004305c3 100644
--- a/src/topology/homotopy/equiv.lean
+++ b/src/topology/homotopy/equiv.lean
@@ -10,6 +10,9 @@ import topology.homotopy.basic
 
 # Homotopy equivalences between topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define homotopy equivalences between topological spaces `X` and `Y` as a pair of
 functions `f : C(X, Y)` and `g : C(Y, X)` such that `f.comp g` and `g.comp f` are both homotopic
 to `id`.
@@ -44,7 +47,8 @@ structure homotopy_equiv (X : Type u) (Y : Type v) [topological_space X] [topolo
 (left_inv : (inv_fun.comp to_fun).homotopic (continuous_map.id X))
 (right_inv : (to_fun.comp inv_fun).homotopic (continuous_map.id Y))
 
-localized "infix ` ≃ₕ `:25 := continuous_map.homotopy_equiv" in continuous_map
+localized "infix (name := continuous_map.homotopy_equiv)
+  ` ≃ₕ `:25 := continuous_map.homotopy_equiv" in continuous_map
 
 namespace homotopy_equiv
 
diff --git a/src/topology/homotopy/homotopy_group.lean b/src/topology/homotopy/homotopy_group.lean
new file mode 100644
index 0000000000000..021f8748bc561
--- /dev/null
+++ b/src/topology/homotopy/homotopy_group.lean
@@ -0,0 +1,469 @@
+/-
+Copyright (c) 2021 Roberto Alvarez. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Roberto Alvarez
+-/
+
+import algebraic_topology.fundamental_groupoid.fundamental_group
+import group_theory.eckmann_hilton
+import logic.equiv.transfer_instance
+import algebra.group.ext
+
+/-!
+# `n`th homotopy group
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the `n`th homotopy group at `x : X`, `π_n X x`, as the equivalence classes
+of functions from the `n`-dimensional cube to the topological space `X`
+that send the boundary to the base point `x`, up to homotopic equivalence.
+Note that such functions are generalized loops `gen_loop (fin n) x`; in particular
+`gen_loop (fin 1) x ≃ path x x`.
+
+We show that `π_0 X x` is equivalent to the path-connected components, and
+that `π_1 X x` is equivalent to the fundamental group at `x`.
+We provide a group instance using path composition and show commutativity when `n > 1`.
+
+## definitions
+
+* `gen_loop N x` is the type of continuous fuctions `I^N → X` that send the boundary to `x`,
+* `homotopy_group.pi n X x` denoted `π_ n X x` is the quotient of `gen_loop (fin n) x` by
+  homotopy relative to the boundary,
+* group instance `group (π_(n+1) X x)`,
+* commutative group instance `comm_group (π_(n+2) X x)`.
+
+TODO:
+* `Ω^M (Ω^N X) ≃ₜ Ω^(M⊕N) X`, and `Ω^M X ≃ₜ Ω^N X` when `M ≃ N`. Similarly for `π_`.
+* Path-induced homomorphisms. Show that `homotopy_group.pi_1_equiv_fundamental_group`
+  is a group isomorphism.
+* Examples with `𝕊^n`: `π_n (𝕊^n) = ℤ`, `π_m (𝕊^n)` trivial for `m < n`.
+* Actions of π_1 on π_n.
+* Lie algebra: `⁅π_(n+1), π_(m+1)⁆` contained in `π_(n+m+1)`.
+
+-/
+
+open_locale unit_interval topology
+open homeomorph
+
+noncomputable theory
+
+localized "notation `I^` N := N → I" in topology
+
+namespace cube
+
+/-- The points in a cube with at least one projection equal to 0 or 1. -/
+def boundary (N : Type*) : set (I^N) := {y | ∃ i, y i = 0 ∨ y i = 1}
+
+variables {N : Type*} [decidable_eq N]
+
+/-- The forward direction of the homeomorphism
+  between the cube $I^N$ and $I × I^{N\setminus\{j\}}$. -/
+@[reducible] def split_at (i : N) : (I^N) ≃ₜ I × I^{j // j ≠ i} := fun_split_at I i
+
+/-- The backward direction of the homeomorphism
+  between the cube $I^N$ and $I × I^{N\setminus\{j\}}$. -/
+@[reducible] def insert_at (i : N) : I × (I^{j // j ≠ i}) ≃ₜ I^N := (fun_split_at I i).symm
+
+lemma insert_at_boundary (i : N) {t₀ : I} {t} (H : (t₀ = 0 ∨ t₀ = 1) ∨ t ∈ boundary {j // j ≠ i}) :
+  insert_at i ⟨t₀, t⟩ ∈ boundary N :=
+begin
+  obtain H | ⟨j, H⟩ := H,
+  { use i, rwa [fun_split_at_symm_apply, dif_pos rfl] },
+  { use j, rwa [fun_split_at_symm_apply, dif_neg j.prop, subtype.coe_eta] },
+end
+
+end cube
+
+variables (N X : Type*) [topological_space X] (x : X)
+
+/-- The space of paths with both endpoints equal to a specified point `x : X`. -/
+@[reducible] def loop_space := path x x
+localized "notation `Ω` := loop_space" in topology
+
+instance loop_space.inhabited : inhabited (path x x) := ⟨path.refl x⟩
+
+/-- The `n`-dimensional generalized loops based at `x` in a space `X` are
+  continuous functions `I^n → X` that sends the boundary to `x`.
+  We allow an arbitrary indexing type `N` in place of `fin n` here. -/
+def gen_loop : set C(I^N, X) := {p | ∀ y ∈ cube.boundary N, p y = x}
+localized "notation `Ω^` := gen_loop" in topology
+
+variables {N X x}
+
+namespace gen_loop
+
+/-- Copy of a `gen_loop` with a new map from the unit cube equal to the old one.
+  Useful to fix definitional equalities. -/
+def copy (f : Ω^N X x) (g : (I^N) → X) (h : g = f) : Ω^N X x :=
+⟨⟨g, h.symm ▸ f.1.2⟩, by { convert f.2, ext1, simp_rw h, refl }⟩
+
+lemma coe_copy (f : Ω^N X x) {g : (I^N) → X} (h : g = f) : ⇑(copy f g h) = g := rfl
+
+lemma copy_eq (f : Ω^N X x) {g : (I^N) → X} (h : g = f) : copy f g h = f :=
+by { ext x, exact congr_fun h x }
+
+lemma boundary (f : Ω^N X x) : ∀ y ∈ cube.boundary N, f y = x := f.2
+
+instance fun_like : fun_like (Ω^N X x) (I^N) (λ _, X) :=
+{ coe := λ f, f.1,
+  coe_injective' := λ ⟨⟨f, _⟩, _⟩ ⟨⟨g, _⟩, _⟩ h, by { congr, exact h } }
+
+@[ext] lemma ext (f g : Ω^N X x) (H : ∀ y, f y = g y) : f = g :=
+fun_like.coe_injective' (funext H)
+
+@[simp] lemma mk_apply (f : C(I^N, X)) (H y) : (⟨f, H⟩ : Ω^N X x) y = f y := rfl
+
+/-- The constant `gen_loop` at `x`. -/
+def const : Ω^N X x := ⟨continuous_map.const _ x, λ _ _, rfl⟩
+
+@[simp] lemma const_apply {t} : (@const N X _ x) t = x := rfl
+
+instance inhabited : inhabited (Ω^N X x) := ⟨const⟩
+
+/-- The "homotopic relative to boundary" relation between `gen_loop`s. -/
+def homotopic (f g : Ω^N X x) : Prop := f.1.homotopic_rel g.1 (cube.boundary N)
+
+namespace homotopic
+
+variables {f g h : Ω^N X x}
+
+@[refl] lemma refl (f : Ω^N X x) : homotopic f f := continuous_map.homotopic_rel.refl _
+
+@[symm] lemma symm (H : homotopic f g) : homotopic g f := H.symm
+
+@[trans] lemma trans (H0 : homotopic f g) (H1 : homotopic g h) : homotopic f h := H0.trans H1
+
+lemma equiv : equivalence (@homotopic N X _ x) :=
+⟨homotopic.refl, λ _ _, homotopic.symm, λ _ _ _, homotopic.trans⟩
+
+instance setoid (N) (x : X) : setoid (Ω^N X x) := ⟨homotopic, equiv⟩
+
+end homotopic
+
+section loop_homeo
+
+variable [decidable_eq N]
+
+/-- Loop from a generalized loop by currying $I^N → X$ into $I → (I^{N\setminus\{j\}} → X)$. -/
+@[simps] def to_loop (i : N) (p : Ω^N X x) : Ω (Ω^{j // j ≠ i} X x) const :=
+{ to_fun := λ t, ⟨(p.val.comp (cube.insert_at i).to_continuous_map).curry t,
+    λ y yH, p.property (cube.insert_at i (t, y)) (cube.insert_at_boundary i $ or.inr yH)⟩,
+  source' := by { ext t, refine p.property (cube.insert_at i (0, t)) ⟨i, or.inl _⟩, simp },
+  target' := by { ext t, refine p.property (cube.insert_at i (1, t)) ⟨i, or.inr _⟩, simp } }
+
+lemma continuous_to_loop (i : N) : continuous (@to_loop N X _ x _ i) :=
+path.continuous_uncurry_iff.1 $ continuous.subtype_mk (continuous_map.continuous_eval'.comp $
+  continuous.prod_map (continuous_map.continuous_curry.comp $
+    (continuous_map.continuous_comp_left _).comp continuous_subtype_coe) continuous_id) _
+
+/-- Generalized loop from a loop by uncurrying $I → (I^{N\setminus\{j\}} → X)$ into $I^N → X$. -/
+@[simps] def from_loop (i : N) (p : Ω (Ω^{j // j ≠ i} X x) const) : Ω^N X x :=
+⟨(continuous_map.comp ⟨coe⟩ p.to_continuous_map).uncurry.comp (cube.split_at i).to_continuous_map,
+begin
+  rintros y ⟨j, Hj⟩,
+  simp only [subtype.val_eq_coe, continuous_map.comp_apply, to_continuous_map_apply,
+    fun_split_at_apply, continuous_map.uncurry_apply, continuous_map.coe_mk,
+    function.uncurry_apply_pair],
+  obtain rfl | Hne := eq_or_ne j i,
+  { cases Hj; simpa only [Hj, p.coe_to_continuous_map, p.source, p.target] },
+  { exact gen_loop.boundary _ _ ⟨⟨j, Hne⟩, Hj⟩ },
+end⟩
+
+lemma continuous_from_loop (i : N) : continuous (@from_loop N X _ x _ i) :=
+((continuous_map.continuous_comp_left _).comp $ continuous_map.continuous_uncurry.comp $
+  (continuous_map.continuous_comp _).comp continuous_induced_dom).subtype_mk _
+
+lemma to_from (i : N) (p : Ω (Ω^{j // j ≠ i} X x) const) : to_loop i (from_loop i p) = p :=
+begin
+  simp_rw [to_loop, from_loop, continuous_map.comp_assoc, to_continuous_map_as_coe,
+    to_continuous_map_comp_symm, continuous_map.comp_id], ext, refl,
+end
+
+/-- The `n+1`-dimensional loops are in bijection with the loops in the space of
+  `n`-dimensional loops with base point `const`.
+  We allow an arbitrary indexing type `N` in place of `fin n` here. -/
+@[simps] def loop_homeo (i : N) : Ω^N X x ≃ₜ Ω (Ω^{j // j ≠ i} X x) const :=
+{ to_fun := to_loop i,
+  inv_fun := from_loop i,
+  left_inv := λ p, by { ext, exact congr_arg p (equiv.apply_symm_apply _ _) },
+  right_inv := to_from i,
+  continuous_to_fun := continuous_to_loop i,
+  continuous_inv_fun := continuous_from_loop i }
+
+lemma to_loop_apply (i : N) {p : Ω^N X x} {t} {tn} :
+  to_loop i p t tn = p (cube.insert_at i ⟨t, tn⟩) := rfl
+
+lemma from_loop_apply (i : N) {p : Ω (Ω^{j // j ≠ i} X x) const} {t : I^N} :
+  from_loop i p t = p (t i) (cube.split_at i t).snd := rfl
+
+/-- Composition with `cube.insert_at` as a continuous map. -/
+@[reducible] def c_comp_insert (i : N) : C(C(I^N, X), C(I × I^{j // j ≠ i}, X)) :=
+⟨λ f, f.comp (cube.insert_at i).to_continuous_map,
+  (cube.insert_at i).to_continuous_map.continuous_comp_left⟩
+
+/-- A homotopy between `n+1`-dimensional loops `p` and `q` constant on the boundary
+  seen as a homotopy between two paths in the space of `n`-dimensional paths. -/
+def homotopy_to (i : N) {p q : Ω^N X x} (H : p.1.homotopy_rel q.1 (cube.boundary N)) :
+  C(I × I, C(I^{j // j ≠ i}, X)) :=
+((⟨_, continuous_map.continuous_curry⟩: C(_,_)).comp $
+  (c_comp_insert i).comp H.to_continuous_map.curry).uncurry
+
+-- Should be generated with `@[simps]` but it times out.
+lemma homotopy_to_apply (i : N) {p q : Ω^N X x} (H : p.1.homotopy_rel q.1 $ cube.boundary N)
+  (t : I × I) (tₙ : I^{j // j ≠ i}) :
+  homotopy_to i H t tₙ = H (t.fst, cube.insert_at i (t.snd, tₙ)) := rfl
+
+lemma homotopic_to (i : N) {p q : Ω^N X x} :
+  homotopic p q → (to_loop i p).homotopic (to_loop i q) :=
+begin
+  refine nonempty.map (λ H, ⟨⟨⟨λ t, ⟨homotopy_to i H t, _⟩, _⟩, _, _⟩, _⟩),
+  { rintros y ⟨i, iH⟩,
+    rw [homotopy_to_apply, H.eq_fst, p.2],
+    all_goals { apply cube.insert_at_boundary, right, exact ⟨i, iH⟩} },
+  { continuity },
+  show ∀ _ _ _, _,
+  { intros t y yH,
+    split; ext; erw homotopy_to_apply,
+    apply H.eq_fst, work_on_goal 2 { apply H.eq_snd },
+    all_goals { use i, rw [fun_split_at_symm_apply, dif_pos rfl], exact yH } },
+  all_goals { intro, ext, erw [homotopy_to_apply, to_loop_apply] },
+  exacts [H.apply_zero _, H.apply_one _],
+end
+
+/-- The converse to `gen_loop.homotopy_to`: a homotopy between two loops in the space of
+  `n`-dimensional loops can be seen as a homotopy between two `n+1`-dimensional paths. -/
+def homotopy_from (i : N) {p q : Ω^N X x}
+  (H : (to_loop i p).homotopy (to_loop i q)) : C(I × I^N, X) :=
+(continuous_map.comp ⟨_, continuous_map.continuous_uncurry⟩
+  (continuous_map.comp ⟨coe⟩ H.to_continuous_map).curry).uncurry.comp $
+    (continuous_map.id I).prod_map (cube.split_at i).to_continuous_map
+
+-- Should be generated with `@[simps]` but it times out.
+lemma homotopy_from_apply (i : N) {p q : Ω^N X x} (H : (to_loop i p).homotopy (to_loop i q))
+  (t : I × I^N) : homotopy_from i H t = H (t.fst, t.snd i) (λ j, t.snd ↑j) := rfl
+
+lemma homotopic_from (i : N) {p q : Ω^N X x} :
+  (to_loop i p).homotopic (to_loop i q) → homotopic p q :=
+begin
+  refine nonempty.map (λ H, ⟨⟨homotopy_from i H, _, _⟩, _⟩),
+  show ∀ _ _ _, _,
+  { rintros t y ⟨j, jH⟩,
+    erw homotopy_from_apply,
+    obtain rfl | h := eq_or_ne j i,
+    { split,
+      { rw H.eq_fst, exacts [congr_arg p (equiv.right_inv _ _), jH] },
+      { rw H.eq_snd, exacts [congr_arg q (equiv.right_inv _ _), jH] } },
+    { rw [p.2 _ ⟨j, jH⟩, q.2 _ ⟨j, jH⟩], split; { apply boundary, exact ⟨⟨j, h⟩, jH⟩ } } },
+  all_goals { intro,
+    convert homotopy_from_apply _ _ _,
+    rw H.apply_zero <|> rw H.apply_one,
+    apply congr_arg p <|> apply congr_arg q,
+    exact (equiv.right_inv _ _).symm },
+end
+
+/-- Concatenation of two `gen_loop`s along the `i`th coordinate. -/
+def trans_at (i : N) (f g : Ω^N X x) : Ω^N X x :=
+copy (from_loop i $ (to_loop i f).trans $ to_loop i g)
+  (λ t, if (t i : ℝ) ≤ 1/2
+    then f (t.update i $ set.proj_Icc 0 1 zero_le_one (2 * t i))
+    else g (t.update i $ set.proj_Icc 0 1 zero_le_one (2 * t i - 1)))
+begin
+  ext1, symmetry,
+  dsimp only [path.trans, from_loop, path.coe_mk, function.comp_app,
+    mk_apply, continuous_map.comp_apply, to_continuous_map_apply, fun_split_at_apply,
+    continuous_map.uncurry_apply, continuous_map.coe_mk, function.uncurry_apply_pair],
+  split_ifs, change f _ = _, swap, change g _ = _,
+  all_goals { congr' 1 }
+end
+
+/-- Reversal of a `gen_loop` along the `i`th coordinate. -/
+def symm_at (i : N) (f : Ω^N X x) : Ω^N X x :=
+copy (from_loop i (to_loop i f).symm)
+  (λ t, f $ λ j, if j = i then σ (t i) else t j) $
+  by { ext1, change _ = f _, congr, ext1, simp }
+
+lemma trans_at_distrib {i j : N} (h : i ≠ j) (a b c d : Ω^N X x) :
+  trans_at i (trans_at j a b) (trans_at j c d) = trans_at j (trans_at i a c) (trans_at i b d) :=
+begin
+  ext, simp_rw [trans_at, coe_copy, function.update_apply, if_neg h, if_neg h.symm],
+  split_ifs; { congr' 1, ext1, simp only [function.update, eq_rec_constant, dite_eq_ite],
+    apply ite_ite_comm, rintro rfl, exact h.symm },
+end
+
+lemma from_loop_trans_to_loop {i : N} {p q : Ω^N X x} :
+  from_loop i ((to_loop i p).trans $ to_loop i q) = trans_at i p q :=
+(copy_eq _ _).symm
+
+lemma from_loop_symm_to_loop {i : N} {p : Ω^N X x} :
+  from_loop i (to_loop i p).symm = symm_at i p := (copy_eq _ _).symm
+
+end loop_homeo
+
+end gen_loop
+
+/-- The `n`th homotopy group at `x` defined as the quotient of `Ω^n x` by the
+  `gen_loop.homotopic` relation. -/
+@[derive inhabited]
+def homotopy_group (N) (X : Type*) [topological_space X] (x : X) : Type* :=
+quotient (gen_loop.homotopic.setoid N x)
+
+variable [decidable_eq N]
+open gen_loop
+/-- Equivalence between the homotopy group of X and the fundamental group of
+  `Ω^{j // j ≠ i} x`. -/
+def homotopy_group_equiv_fundamental_group (i : N) :
+  homotopy_group N X x ≃ fundamental_group (Ω^{j // j ≠ i} X x) const :=
+begin
+  refine equiv.trans _ (category_theory.groupoid.iso_equiv_hom _ _).symm,
+  apply quotient.congr (loop_homeo i).to_equiv,
+  exact λ p q, ⟨homotopic_to i, homotopic_from i⟩,
+end
+
+/-- Homotopy group of finite index. -/
+@[reducible] def homotopy_group.pi (n) (X : Type*) [topological_space X] (x : X) :=
+homotopy_group (fin n) _ x
+localized "notation `π_` := homotopy_group.pi" in topology
+
+/-- The 0-dimensional generalized loops based at `x` are in bijection with `X`. -/
+def gen_loop_homeo_of_is_empty (N x) [is_empty N] : Ω^N X x ≃ₜ X :=
+{ to_fun := λ f, f 0,
+  inv_fun := λ y, ⟨continuous_map.const _ y, λ _ ⟨i, _⟩, is_empty_elim i⟩,
+  left_inv := λ f, by { ext, exact congr_arg f (subsingleton.elim _ _) },
+  right_inv := λ _, rfl,
+  continuous_to_fun :=
+    (continuous_map.continuous_eval_const' (0 : N → I)).comp continuous_induced_dom,
+  continuous_inv_fun := (continuous_map.const'.2).subtype_mk _ }
+
+/-- The homotopy "group" indexed by an empty type is in bijection with
+  the path components of `X`, aka the `zeroth_homotopy`. -/
+def homotopy_group_equiv_zeroth_homotopy_of_is_empty (N x) [is_empty N] :
+  homotopy_group N X x ≃ zeroth_homotopy X :=
+quotient.congr (gen_loop_homeo_of_is_empty N x).to_equiv
+begin
+  -- joined iff homotopic
+  intros, split; rintro ⟨H⟩,
+  exacts
+  [⟨{ to_fun := λ t, H ⟨t, is_empty_elim⟩,
+      source' := (H.apply_zero _).trans (congr_arg a₁ $ subsingleton.elim _ _),
+      target' := (H.apply_one _).trans (congr_arg a₂ $ subsingleton.elim _ _) }⟩,
+   ⟨{ to_fun := λ t0, H t0.fst,
+      map_zero_left' := λ _, by convert H.source,
+      map_one_left' := λ _, by convert H.target,
+      prop' := λ _ _ ⟨i, _⟩, is_empty_elim i }⟩],
+end
+
+/-- The 0th homotopy "group" is in bijection with `zeroth_homotopy`. -/
+def homotopy_group.pi_0_equiv_zeroth_homotopy : π_ 0 X x ≃ zeroth_homotopy X :=
+homotopy_group_equiv_zeroth_homotopy_of_is_empty (fin 0) x
+
+/-- The 1-dimensional generalized loops based at `x` are in bijection with loops at `x`. -/
+@[simps] def gen_loop_equiv_of_unique (N) [unique N] : Ω^N X x ≃ Ω X x :=
+{ to_fun := λ p, path.mk ⟨λ t, p (λ _, t), by continuity⟩
+    (gen_loop.boundary _ (λ _, 0) ⟨default, or.inl rfl⟩)
+    (gen_loop.boundary _ (λ _, 1) ⟨default, or.inr rfl⟩),
+  inv_fun := λ p, ⟨⟨λ c, p (c default), by continuity⟩,
+  begin
+    rintro y ⟨i, iH|iH⟩; cases unique.eq_default i; apply (congr_arg p iH).trans,
+    exacts [p.source, p.target],
+  end⟩,
+  left_inv := λ p, by { ext, exact congr_arg p (eq_const_of_unique y).symm },
+  right_inv := λ p, by { ext, refl } }
+
+/-- The homotopy group at `x` indexed by a singleton is in bijection with the fundamental group,
+  i.e. the loops based at `x` up to homotopy. -/
+/- TODO (?): deducing this from `homotopy_group_equiv_fundamental_group` would require
+  combination of `category_theory.functor.map_Aut` and
+  `fundamental_groupoid.fundamental_groupoid_functor` applied to `gen_loop_homeo_of_is_empty`,
+  with possibly worse defeq. -/
+def homotopy_group_equiv_fundamental_group_of_unique (N) [unique N] :
+  homotopy_group N X x ≃ fundamental_group X x :=
+begin
+  refine equiv.trans _ (category_theory.groupoid.iso_equiv_hom _ _).symm,
+  refine quotient.congr (gen_loop_equiv_of_unique N) _,
+  intros, split; rintros ⟨H⟩,
+  { exact
+    ⟨ { to_fun := λ tx, H (tx.fst, λ _, tx.snd),
+        map_zero_left' := λ _, H.apply_zero _,
+        map_one_left' := λ _, H.apply_one _,
+        prop' := λ t y iH, H.prop' _ _ ⟨default, iH⟩ } ⟩ },
+  refine ⟨⟨⟨⟨λ tx, H (tx.fst, tx.snd default), H.continuous.comp _⟩, λ y, _, λ y, _⟩, _⟩⟩,
+  { exact continuous_fst.prod_mk ((continuous_apply _).comp continuous_snd) },
+  { convert H.apply_zero _, exact eq_const_of_unique y },
+  { convert H.apply_one _, exact eq_const_of_unique y },
+  { rintro t y ⟨i, iH⟩,
+    cases unique.eq_default i, split,
+    { convert H.eq_fst _ _, exacts [eq_const_of_unique y, iH] },
+    { convert H.eq_snd _ _, exacts [eq_const_of_unique y, iH] } },
+end
+
+/-- The first homotopy group at `x` is in bijection with the fundamental group. -/
+def homotopy_group.pi_1_equiv_fundamental_group : π_ 1 X x ≃ fundamental_group X x :=
+homotopy_group_equiv_fundamental_group_of_unique (fin 1)
+
+namespace homotopy_group
+
+/-- Group structure on `homotopy_group N X x` for nonempty `N` (in particular `π_(n+1) X x`). -/
+instance group (N) [decidable_eq N] [nonempty N] : group (homotopy_group N X x) :=
+(homotopy_group_equiv_fundamental_group $ classical.arbitrary N).group
+
+/-- Group structure on `homotopy_group` obtained by pulling back path composition along the
+  `i`th direction. The group structures for two different `i j : N` distribute over each
+  other, and therefore are equal by the Eckmann-Hilton argument. -/
+@[reducible] def aux_group (i : N) : group (homotopy_group N X x) :=
+(homotopy_group_equiv_fundamental_group i).group
+
+lemma is_unital_aux_group (i : N) :
+  eckmann_hilton.is_unital (aux_group i).mul (⟦const⟧ : homotopy_group N X x) :=
+⟨⟨(aux_group i).one_mul⟩, ⟨(aux_group i).mul_one⟩⟩
+
+lemma aux_group_indep (i j : N) : (aux_group i : group (homotopy_group N X x)) = aux_group j :=
+begin
+  by_cases h : i = j, { rw h },
+  refine group.ext (eckmann_hilton.mul (is_unital_aux_group i) (is_unital_aux_group j) _),
+  rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ ⟨d⟩,
+  change quotient.mk _ = _,
+  apply congr_arg quotient.mk,
+  simp only [from_loop_trans_to_loop, trans_at_distrib h,
+    coe_to_equiv, loop_homeo_apply, coe_symm_to_equiv, loop_homeo_symm_apply],
+end
+
+lemma trans_at_indep {i} (j) (f g : Ω^N X x) : ⟦trans_at i f g⟧ = ⟦trans_at j f g⟧ :=
+begin
+  simp_rw ← from_loop_trans_to_loop,
+  have := congr_arg (@group.mul _) (aux_group_indep i j),
+  exact congr_fun₂ this ⟦g⟧ ⟦f⟧,
+end
+
+lemma symm_at_indep {i} (j) (f : Ω^N X x) : ⟦symm_at i f⟧ = ⟦symm_at j f⟧ :=
+begin
+  simp_rw ← from_loop_symm_to_loop,
+  have := congr_arg (@group.inv _) (aux_group_indep i j),
+  exact congr_fun this ⟦f⟧,
+end
+
+/-- Characterization of multiplicative identity -/
+lemma one_def [nonempty N] : (1 : homotopy_group N X x) = ⟦const⟧ := rfl
+
+/-- Characterization of multiplication -/
+lemma mul_spec [nonempty N] {i} {p q : Ω^N X x} :
+  (⟦p⟧ * ⟦q⟧ : homotopy_group N X x) = ⟦trans_at i q p⟧ :=
+by { rw [trans_at_indep _ q, ← from_loop_trans_to_loop], apply quotient.sound, refl }
+
+/-- Characterization of multiplicative inverse -/
+lemma inv_spec [nonempty N] {i} {p : Ω^N X x} : (⟦p⟧⁻¹ : homotopy_group N X x) = ⟦symm_at i p⟧ :=
+by { rw [symm_at_indep _ p, ← from_loop_symm_to_loop], apply quotient.sound, refl }
+
+/-- Multiplication on `homotopy_group N X x` is commutative for nontrivial `N`.
+  In particular, multiplication on `π_(n+2)` is commutative. -/
+instance comm_group [nontrivial N] : comm_group (homotopy_group N X x) :=
+let h := exists_ne (classical.arbitrary N) in
+@eckmann_hilton.comm_group (homotopy_group N X x) _ 1 (is_unital_aux_group h.some) _
+begin
+  rintro ⟨a⟩ ⟨b⟩ ⟨c⟩ ⟨d⟩,
+  apply congr_arg quotient.mk,
+  simp only [from_loop_trans_to_loop, trans_at_distrib h.some_spec,
+    coe_to_equiv, loop_homeo_apply, coe_symm_to_equiv, loop_homeo_symm_apply],
+end
+
+end homotopy_group
diff --git a/src/topology/homotopy/path.lean b/src/topology/homotopy/path.lean
index 9e0a73787fb85..438d71e2d45d3 100644
--- a/src/topology/homotopy/path.lean
+++ b/src/topology/homotopy/path.lean
@@ -11,6 +11,9 @@ import analysis.convex.basic
 /-!
 # Homotopy between paths
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we define a `homotopy` between two `path`s. In addition, we define a relation
 `homotopic` on `path`s, and prove that it is an equivalence relation.
 
diff --git a/src/topology/homotopy/product.lean b/src/topology/homotopy/product.lean
index 06b9d0449ed71..bc5ccd0df73f3 100644
--- a/src/topology/homotopy/product.lean
+++ b/src/topology/homotopy/product.lean
@@ -9,6 +9,9 @@ import topology.homotopy.path
 /-!
 # Product of homotopies
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we introduce definitions for the product of
 homotopies. We show that the products of relative homotopies
 are still relative homotopies. Finally, we specialize to the case
diff --git a/src/topology/inseparable.lean b/src/topology/inseparable.lean
new file mode 100644
index 0000000000000..0d8200d603bbf
--- /dev/null
+++ b/src/topology/inseparable.lean
@@ -0,0 +1,481 @@
+/-
+Copyright (c) 2021 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang, Yury G. Kudryashov
+-/
+import topology.continuous_on
+import data.setoid.basic
+import tactic.tfae
+
+/-!
+# Inseparable points in a topological space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define
+
+* `specializes` (notation: `x ⤳ y`) : a relation saying that `𝓝 x ≤ 𝓝 y`;
+
+* `inseparable`: a relation saying that two points in a topological space have the same
+  neighbourhoods; equivalently, they can't be separated by an open set;
+
+* `inseparable_setoid X`: same relation, as a `setoid`;
+
+* `separation_quotient X`: the quotient of `X` by its `inseparable_setoid`.
+
+We also prove various basic properties of the relation `inseparable`.
+
+## Notations
+
+- `x ⤳ y`: notation for `specializes x y`;
+- `x ~ y` is used as a local notation for `inseparable x y`;
+- `𝓝 x` is the neighbourhoods filter `nhds x` of a point `x`, defined elsewhere.
+
+## Tags
+
+topological space, separation setoid
+-/
+
+open set filter function
+open_locale topology filter
+
+variables {X Y Z α ι : Type*} {π : ι → Type*} [topological_space X] [topological_space Y]
+  [topological_space Z] [∀ i, topological_space (π i)] {x y z : X} {s : set X} {f : X → Y}
+
+/-!
+### `specializes` relation
+-/
+
+/-- `x` specializes to `y` (notation: `x ⤳ y`) if either of the following equivalent properties
+hold:
+
+* `𝓝 x ≤ 𝓝 y`; this property is used as the definition;
+* `pure x ≤ 𝓝 y`; in other words, any neighbourhood of `y` contains `x`;
+* `y ∈ closure {x}`;
+* `closure {y} ⊆ closure {x}`;
+* for any closed set `s` we have `x ∈ s → y ∈ s`;
+* for any open set `s` we have `y ∈ s → x ∈ s`;
+* `y` is a cluster point of the filter `pure x = 𝓟 {x}`.
+
+This relation defines a `preorder` on `X`. If `X` is a T₀ space, then this preorder is a partial
+order. If `X` is a T₁ space, then this partial order is trivial : `x ⤳ y ↔ x = y`. -/
+def specializes (x y : X) : Prop := 𝓝 x ≤ 𝓝 y
+
+infix ` ⤳ `:300 := specializes
+
+/-- A collection of equivalent definitions of `x ⤳ y`. The public API is given by `iff` lemmas
+below. -/
+lemma specializes_tfae (x y : X) :
+  tfae [x ⤳ y,
+    pure x ≤ 𝓝 y,
+    ∀ s : set X, is_open s → y ∈ s → x ∈ s,
+    ∀ s : set X, is_closed s → x ∈ s → y ∈ s,
+    y ∈ closure ({x} : set X),
+    closure ({y} : set X) ⊆ closure {x},
+    cluster_pt y (pure x)] :=
+begin
+  tfae_have : 1 → 2, from (pure_le_nhds _).trans,
+  tfae_have : 2 → 3, from λ h s hso hy, h (hso.mem_nhds hy),
+  tfae_have : 3 → 4, from λ h s hsc hx, of_not_not $ λ hy, h sᶜ hsc.is_open_compl hy hx,
+  tfae_have : 4 → 5, from λ h, h _ is_closed_closure (subset_closure $ mem_singleton _),
+  tfae_have : 6 ↔ 5, from is_closed_closure.closure_subset_iff.trans singleton_subset_iff,
+  tfae_have : 5 ↔ 7, by rw [mem_closure_iff_cluster_pt, principal_singleton],
+  tfae_have : 5 → 1,
+  { refine λ h, (nhds_basis_opens _).ge_iff.2 _,
+    rintro s ⟨hy, ho⟩,
+    rcases mem_closure_iff.1 h s ho hy with ⟨z, hxs, (rfl : z = x)⟩,
+    exact ho.mem_nhds hxs },
+  tfae_finish
+end
+
+lemma specializes_iff_nhds : x ⤳ y ↔ 𝓝 x ≤ 𝓝 y := iff.rfl
+lemma specializes_iff_pure : x ⤳ y ↔ pure x ≤ 𝓝 y := (specializes_tfae x y).out 0 1
+
+alias specializes_iff_nhds ↔ specializes.nhds_le_nhds _
+alias specializes_iff_pure ↔ specializes.pure_le_nhds _
+
+lemma specializes_iff_forall_open : x ⤳ y ↔ ∀ s : set X, is_open s → y ∈ s → x ∈ s :=
+(specializes_tfae x y).out 0 2
+
+lemma specializes.mem_open (h : x ⤳ y) (hs : is_open s) (hy : y ∈ s) : x ∈ s :=
+specializes_iff_forall_open.1 h s hs hy
+
+lemma is_open.not_specializes (hs : is_open s) (hx : x ∉ s) (hy : y ∈ s) : ¬ x ⤳ y :=
+λ h, hx $ h.mem_open hs hy
+
+lemma specializes_iff_forall_closed : x ⤳ y ↔ ∀ s : set X, is_closed s → x ∈ s → y ∈ s :=
+(specializes_tfae x y).out 0 3
+
+lemma specializes.mem_closed (h : x ⤳ y) (hs : is_closed s) (hx : x ∈ s) : y ∈ s :=
+specializes_iff_forall_closed.1 h s hs hx
+
+lemma is_closed.not_specializes (hs : is_closed s) (hx : x ∈ s) (hy : y ∉ s) : ¬ x ⤳ y :=
+λ h, hy $ h.mem_closed hs hx
+
+lemma specializes_iff_mem_closure : x ⤳ y ↔ y ∈ closure ({x} : set X) :=
+(specializes_tfae x y).out 0 4
+
+alias specializes_iff_mem_closure ↔ specializes.mem_closure _
+
+lemma specializes_iff_closure_subset :
+  x ⤳ y ↔ closure ({y} : set X) ⊆ closure {x} :=
+(specializes_tfae x y).out 0 5
+
+alias specializes_iff_closure_subset ↔ specializes.closure_subset _
+
+lemma filter.has_basis.specializes_iff {ι} {p : ι → Prop} {s : ι → set X}
+  (h : (𝓝 y).has_basis p s) :
+  x ⤳ y ↔ ∀ i, p i → x ∈ s i :=
+specializes_iff_pure.trans h.ge_iff
+
+lemma specializes_rfl : x ⤳ x := le_rfl
+
+@[refl] lemma specializes_refl (x : X) : x ⤳ x := specializes_rfl
+
+@[trans] lemma specializes.trans : x ⤳ y → y ⤳ z → x ⤳ z := le_trans
+
+lemma specializes_of_eq (e : x = y) : x ⤳ y := e ▸ specializes_refl x
+
+lemma specializes_of_nhds_within (h₁ : 𝓝[s] x ≤ 𝓝[s] y) (h₂ : x ∈ s) : x ⤳ y :=
+specializes_iff_pure.2 $
+calc pure x ≤ 𝓝[s] x : le_inf (pure_le_nhds _) (le_principal_iff.2 h₂)
+        ... ≤ 𝓝[s] y : h₁
+        ... ≤ 𝓝 y    : inf_le_left
+
+lemma specializes.map_of_continuous_at (h : x ⤳ y) (hy : continuous_at f y) : f x ⤳ f y :=
+specializes_iff_pure.2 $ λ s hs, mem_pure.2 $ mem_preimage.1 $ mem_of_mem_nhds $ hy.mono_left h hs
+
+lemma specializes.map (h : x ⤳ y) (hf : continuous f) : f x ⤳ f y :=
+h.map_of_continuous_at hf.continuous_at
+
+lemma inducing.specializes_iff (hf : inducing f) : f x ⤳ f y ↔ x ⤳ y :=
+by simp only [specializes_iff_mem_closure, hf.closure_eq_preimage_closure_image, image_singleton,
+  mem_preimage]
+
+lemma subtype_specializes_iff {p : X → Prop} (x y : subtype p) : x ⤳ y ↔ (x : X) ⤳ y :=
+inducing_coe.specializes_iff.symm
+
+@[simp] lemma specializes_prod {x₁ x₂ : X} {y₁ y₂ : Y} :
+  (x₁, y₁) ⤳ (x₂, y₂) ↔ x₁ ⤳ x₂ ∧ y₁ ⤳ y₂ :=
+by simp only [specializes, nhds_prod_eq, prod_le_prod]
+
+lemma specializes.prod {x₁ x₂ : X} {y₁ y₂ : Y} (hx : x₁ ⤳ x₂) (hy : y₁ ⤳ y₂) :
+  (x₁, y₁) ⤳ (x₂, y₂) :=
+specializes_prod.2 ⟨hx, hy⟩
+
+@[simp] lemma specializes_pi {f g : Π i, π i} : f ⤳ g ↔ ∀ i, f i ⤳ g i :=
+by simp only [specializes, nhds_pi, pi_le_pi]
+
+lemma not_specializes_iff_exists_open : ¬ x ⤳ y ↔ ∃ (S : set X), is_open S ∧ y ∈ S ∧ x ∉ S :=
+by { rw [specializes_iff_forall_open], push_neg, refl }
+
+lemma not_specializes_iff_exists_closed : ¬ x ⤳ y ↔ ∃ (S : set X), is_closed S ∧ x ∈ S ∧ y ∉ S :=
+by { rw [specializes_iff_forall_closed], push_neg, refl }
+
+variable (X)
+
+/-- Specialization forms a preorder on the topological space. -/
+def specialization_preorder : preorder X :=
+{ le := λ x y, y ⤳ x,
+  lt := λ x y, y ⤳ x ∧ ¬(x ⤳ y),
+  .. preorder.lift (order_dual.to_dual ∘ 𝓝) }
+
+variable {X}
+
+/-- A continuous function is monotone with respect to the specialization preorders on the domain and
+the codomain. -/
+lemma continuous.specialization_monotone (hf : continuous f) :
+  @monotone _ _ (specialization_preorder X) (specialization_preorder Y) f :=
+λ x y h, h.map hf
+
+/-!
+### `inseparable` relation
+-/
+
+/-- Two points `x` and `y` in a topological space are `inseparable` if any of the following
+equivalent properties hold:
+
+- `𝓝 x = 𝓝 y`; we use this property as the definition;
+- for any open set `s`, `x ∈ s ↔ y ∈ s`, see `inseparable_iff_open`;
+- for any closed set `s`, `x ∈ s ↔ y ∈ s`, see `inseparable_iff_closed`;
+- `x ∈ closure {y}` and `y ∈ closure {x}`, see `inseparable_iff_mem_closure`;
+- `closure {x} = closure {y}`, see `inseparable_iff_closure_eq`.
+-/
+def inseparable (x y : X) : Prop := 𝓝 x = 𝓝 y
+
+local infix ` ~ ` := inseparable
+
+lemma inseparable_def : x ~ y ↔ 𝓝 x = 𝓝 y := iff.rfl
+
+lemma inseparable_iff_specializes_and : x ~ y ↔ x ⤳ y ∧ y ⤳ x := le_antisymm_iff
+
+lemma inseparable.specializes (h : x ~ y) : x ⤳ y := h.le
+
+lemma inseparable.specializes' (h : x ~ y) : y ⤳ x := h.ge
+
+lemma specializes.antisymm (h₁ : x ⤳ y) (h₂ : y ⤳ x) : x ~ y := le_antisymm h₁ h₂
+
+lemma inseparable_iff_forall_open : x ~ y ↔ ∀ s : set X, is_open s → (x ∈ s ↔ y ∈ s) :=
+by simp only [inseparable_iff_specializes_and, specializes_iff_forall_open, ← forall_and_distrib,
+  ← iff_def, iff.comm]
+
+lemma not_inseparable_iff_exists_open : ¬(x ~ y) ↔ ∃ s : set X, is_open s ∧ xor (x ∈ s) (y ∈ s) :=
+by simp [inseparable_iff_forall_open, ← xor_iff_not_iff]
+
+lemma inseparable_iff_forall_closed : x ~ y ↔ ∀ s : set X, is_closed s → (x ∈ s ↔ y ∈ s) :=
+by simp only [inseparable_iff_specializes_and, specializes_iff_forall_closed, ← forall_and_distrib,
+  ← iff_def]
+
+lemma inseparable_iff_mem_closure :
+  x ~ y ↔ x ∈ closure ({y} : set X) ∧ y ∈ closure ({x} : set X) :=
+inseparable_iff_specializes_and.trans $ by simp only [specializes_iff_mem_closure, and_comm]
+
+lemma inseparable_iff_closure_eq : x ~ y ↔ closure ({x} : set X) = closure {y} :=
+by simp only [inseparable_iff_specializes_and, specializes_iff_closure_subset,
+  ← subset_antisymm_iff, eq_comm]
+
+lemma inseparable_of_nhds_within_eq (hx : x ∈ s) (hy : y ∈ s) (h : 𝓝[s] x = 𝓝[s] y) : x ~ y :=
+(specializes_of_nhds_within h.le hx).antisymm (specializes_of_nhds_within h.ge hy)
+
+lemma inducing.inseparable_iff (hf : inducing f) : f x ~ f y ↔ x ~ y :=
+by simp only [inseparable_iff_specializes_and, hf.specializes_iff]
+
+lemma subtype_inseparable_iff {p : X → Prop} (x y : subtype p) : x ~ y ↔ (x : X) ~ y :=
+inducing_coe.inseparable_iff.symm
+
+@[simp] lemma inseparable_prod {x₁ x₂ : X} {y₁ y₂ : Y} :
+  (x₁, y₁) ~ (x₂, y₂) ↔ x₁ ~ x₂ ∧ y₁ ~ y₂ :=
+by simp only [inseparable, nhds_prod_eq, prod_inj]
+
+lemma inseparable.prod {x₁ x₂ : X} {y₁ y₂ : Y} (hx : x₁ ~ x₂) (hy : y₁ ~ y₂) :
+  (x₁, y₁) ~ (x₂, y₂) :=
+inseparable_prod.2 ⟨hx, hy⟩
+
+@[simp] lemma inseparable_pi {f g : Π i, π i} : f ~ g ↔ ∀ i, f i ~ g i :=
+by simp only [inseparable, nhds_pi, funext_iff, pi_inj]
+
+namespace inseparable
+
+@[refl] lemma refl (x : X) : x ~ x := eq.refl (𝓝 x)
+
+lemma rfl : x ~ x := refl x
+
+lemma of_eq (e : x = y) : inseparable x y := e ▸ refl x
+
+@[symm] lemma symm (h : x ~ y) : y ~ x := h.symm
+
+@[trans] lemma trans (h₁ : x ~ y) (h₂ : y ~ z) : x ~ z := h₁.trans h₂
+
+lemma nhds_eq (h : x ~ y) : 𝓝 x = 𝓝 y := h
+
+lemma mem_open_iff (h : x ~ y) (hs : is_open s) : x ∈ s ↔ y ∈ s :=
+inseparable_iff_forall_open.1 h s hs
+
+lemma mem_closed_iff (h : x ~ y) (hs : is_closed s) : x ∈ s ↔ y ∈ s :=
+inseparable_iff_forall_closed.1 h s hs
+
+lemma map_of_continuous_at (h : x ~ y) (hx : continuous_at f x) (hy : continuous_at f y) :
+  f x ~ f y :=
+(h.specializes.map_of_continuous_at hy).antisymm (h.specializes'.map_of_continuous_at hx)
+
+lemma map (h : x ~ y) (hf : continuous f) : f x ~ f y :=
+h.map_of_continuous_at hf.continuous_at hf.continuous_at
+
+end inseparable
+
+lemma is_closed.not_inseparable (hs : is_closed s) (hx : x ∈ s) (hy : y ∉ s) : ¬x ~ y :=
+λ h, hy $ (h.mem_closed_iff hs).1 hx
+
+lemma is_open.not_inseparable (hs : is_open s) (hx : x ∈ s) (hy : y ∉ s) : ¬x ~ y :=
+λ h, hy $ (h.mem_open_iff hs).1 hx
+
+/-!
+### Separation quotient
+
+In this section we define the quotient of a topological space by the `inseparable` relation.
+-/
+
+variable (X)
+
+/-- A `setoid` version of `inseparable`, used to define the `separation_quotient`. -/
+def inseparable_setoid : setoid X :=
+{ r := (~),
+  .. setoid.comap 𝓝 ⊥ }
+
+/-- The quotient of a topological space by its `inseparable_setoid`. This quotient is guaranteed to
+be a T₀ space. -/
+@[derive topological_space]
+def separation_quotient := quotient (inseparable_setoid X)
+
+variables {X} {t : set (separation_quotient X)}
+
+namespace separation_quotient
+
+/-- The natural map from a topological space to its separation quotient. -/
+def mk : X → separation_quotient X := quotient.mk'
+
+lemma quotient_map_mk : quotient_map (mk : X → separation_quotient X) :=
+quotient_map_quot_mk
+
+lemma continuous_mk : continuous (mk : X → separation_quotient X) :=
+continuous_quot_mk
+
+@[simp] lemma mk_eq_mk : mk x = mk y ↔ x ~ y := quotient.eq'
+
+lemma surjective_mk : surjective (mk : X → separation_quotient X) :=
+surjective_quot_mk _
+
+@[simp] lemma range_mk : range (mk : X → separation_quotient X) = univ :=
+surjective_mk.range_eq
+
+instance [nonempty X] : nonempty (separation_quotient X) := nonempty.map mk ‹_›
+instance [inhabited X] : inhabited (separation_quotient X) := ⟨mk default⟩
+instance [subsingleton X] : subsingleton (separation_quotient X) := surjective_mk.subsingleton
+
+lemma preimage_image_mk_open (hs : is_open s) : mk ⁻¹' (mk '' s) = s :=
+begin
+  refine subset.antisymm _ (subset_preimage_image _ _),
+  rintro x ⟨y, hys, hxy⟩,
+  exact ((mk_eq_mk.1 hxy).mem_open_iff hs).1 hys
+end
+
+lemma is_open_map_mk : is_open_map (mk : X → separation_quotient X) :=
+λ s hs, quotient_map_mk.is_open_preimage.1 $ by rwa preimage_image_mk_open hs
+
+lemma preimage_image_mk_closed (hs : is_closed s) : mk ⁻¹' (mk '' s) = s :=
+begin
+  refine subset.antisymm _ (subset_preimage_image _ _),
+  rintro x ⟨y, hys, hxy⟩,
+  exact ((mk_eq_mk.1 hxy).mem_closed_iff hs).1 hys
+end
+
+lemma inducing_mk : inducing (mk : X → separation_quotient X) :=
+⟨le_antisymm (continuous_iff_le_induced.1 continuous_mk)
+  (λ s hs, ⟨mk '' s, is_open_map_mk s hs, preimage_image_mk_open hs⟩)⟩
+
+lemma is_closed_map_mk : is_closed_map (mk : X → separation_quotient X) :=
+inducing_mk.is_closed_map $ by { rw [range_mk], exact is_closed_univ }
+
+@[simp] lemma comap_mk_nhds_mk : comap mk (𝓝 (mk x)) = 𝓝 x :=
+(inducing_mk.nhds_eq_comap _).symm
+
+@[simp] lemma comap_mk_nhds_set_image : comap mk (𝓝ˢ (mk '' s)) = 𝓝ˢ s :=
+(inducing_mk.nhds_set_eq_comap _).symm
+
+lemma map_mk_nhds : map mk (𝓝 x) = 𝓝 (mk x) :=
+by rw [← comap_mk_nhds_mk, map_comap_of_surjective surjective_mk]
+
+lemma map_mk_nhds_set : map mk (𝓝ˢ s) = 𝓝ˢ (mk '' s) :=
+by rw [← comap_mk_nhds_set_image, map_comap_of_surjective surjective_mk]
+
+lemma comap_mk_nhds_set : comap mk (𝓝ˢ t) = 𝓝ˢ (mk ⁻¹' t) :=
+by conv_lhs { rw [← image_preimage_eq t surjective_mk, comap_mk_nhds_set_image] }
+
+lemma preimage_mk_closure : mk ⁻¹' (closure t) = closure (mk ⁻¹' t) :=
+is_open_map_mk.preimage_closure_eq_closure_preimage continuous_mk t
+
+lemma preimage_mk_interior : mk ⁻¹' (interior t) = interior (mk ⁻¹' t) :=
+is_open_map_mk.preimage_interior_eq_interior_preimage continuous_mk t
+
+lemma preimage_mk_frontier : mk ⁻¹' (frontier t) = frontier (mk ⁻¹' t) :=
+is_open_map_mk.preimage_frontier_eq_frontier_preimage continuous_mk t
+
+lemma image_mk_closure : mk '' closure s = closure (mk '' s) :=
+(image_closure_subset_closure_image continuous_mk).antisymm $
+  is_closed_map_mk.closure_image_subset _
+
+lemma map_prod_map_mk_nhds (x : X) (y : Y) : map (prod.map mk mk) (𝓝 (x, y)) = 𝓝 (mk x, mk y) :=
+by rw [nhds_prod_eq, ← prod_map_map_eq', map_mk_nhds, map_mk_nhds, nhds_prod_eq]
+
+lemma map_mk_nhds_within_preimage (s : set (separation_quotient X)) (x : X) :
+  map mk (𝓝[mk ⁻¹' s] x) = 𝓝[s] (mk x) :=
+by rw [nhds_within, ← comap_principal, filter.push_pull, nhds_within, map_mk_nhds]
+
+/-- Lift a map `f : X → α` such that `inseparable x y → f x = f y` to a map
+`separation_quotient X → α`. -/
+def lift (f : X → α) (hf : ∀ x y, x ~ y → f x = f y) : separation_quotient X → α :=
+λ x, quotient.lift_on' x f hf
+
+@[simp] lemma lift_mk {f : X → α} (hf : ∀ x y, x ~ y → f x = f y) (x : X) :
+  lift f hf (mk x) = f x := rfl
+
+@[simp] lemma lift_comp_mk {f : X → α} (hf : ∀ x y, x ~ y → f x = f y) : lift f hf ∘ mk = f := rfl
+
+@[simp] lemma tendsto_lift_nhds_mk {f : X → α} {hf : ∀ x y, x ~ y → f x = f y} {x : X}
+  {l : filter α} : tendsto (lift f hf) (𝓝 $ mk x) l ↔ tendsto f (𝓝 x) l :=
+by simp only [← map_mk_nhds, tendsto_map'_iff, lift_comp_mk]
+
+@[simp] lemma tendsto_lift_nhds_within_mk {f : X → α} {hf : ∀ x y, x ~ y → f x = f y} {x : X}
+  {s : set (separation_quotient X)} {l : filter α} :
+  tendsto (lift f hf) (𝓝[s] (mk x)) l ↔ tendsto f (𝓝[mk ⁻¹' s] x) l :=
+by simp only [← map_mk_nhds_within_preimage, tendsto_map'_iff, lift_comp_mk]
+
+@[simp] lemma continuous_at_lift {f : X → Y} {hf : ∀ x y, x ~ y → f x = f y} {x : X} :
+  continuous_at (lift f hf) (mk x) ↔ continuous_at f x :=
+tendsto_lift_nhds_mk
+
+@[simp] lemma continuous_within_at_lift {f : X → Y} {hf : ∀ x y, x ~ y → f x = f y}
+  {s : set (separation_quotient X)} {x : X} :
+  continuous_within_at (lift f hf) s (mk x) ↔ continuous_within_at f (mk ⁻¹' s) x :=
+tendsto_lift_nhds_within_mk
+
+@[simp] lemma continuous_on_lift {f : X → Y} {hf : ∀ x y, x ~ y → f x = f y}
+  {s : set (separation_quotient X)} :
+  continuous_on (lift f hf) s ↔ continuous_on f (mk ⁻¹' s) :=
+by simp only [continuous_on, surjective_mk.forall, continuous_within_at_lift, mem_preimage]
+
+@[simp] lemma continuous_lift {f : X → Y} {hf : ∀ x y, x ~ y → f x = f y} :
+  continuous (lift f hf) ↔ continuous f :=
+by simp only [continuous_iff_continuous_on_univ, continuous_on_lift, preimage_univ]
+
+/-- Lift a map `f : X → Y → α` such that `inseparable a b → inseparable c d → f a c = f b d` to a
+map `separation_quotient X → separation_quotient Y → α`. -/
+def lift₂ (f : X → Y → α) (hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d) :
+  separation_quotient X → separation_quotient Y → α :=
+λ x y, quotient.lift_on₂' x y f hf
+
+@[simp] lemma lift₂_mk {f : X → Y → α} (hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d) (x : X)
+  (y : Y) : lift₂ f hf (mk x) (mk y) = f x y :=
+rfl
+
+@[simp] lemma tendsto_lift₂_nhds {f : X → Y → α} {hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d}
+  {x : X} {y : Y} {l : filter α} :
+  tendsto (uncurry $ lift₂ f hf) (𝓝 (mk x, mk y)) l ↔ tendsto (uncurry f) (𝓝 (x, y)) l :=
+by { rw [← map_prod_map_mk_nhds, tendsto_map'_iff], refl }
+
+@[simp] lemma tendsto_lift₂_nhds_within {f : X → Y → α}
+  {hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d} {x : X} {y : Y}
+  {s : set (separation_quotient X × separation_quotient Y)} {l : filter α} :
+  tendsto (uncurry $ lift₂ f hf) (𝓝[s] (mk x, mk y)) l ↔
+    tendsto (uncurry f) (𝓝[prod.map mk mk ⁻¹' s] (x, y)) l :=
+by { rw [nhds_within, ← map_prod_map_mk_nhds, ← filter.push_pull, comap_principal], refl }
+
+@[simp] lemma continuous_at_lift₂ {f : X → Y → Z} {hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d}
+  {x : X} {y : Y} :
+  continuous_at (uncurry $ lift₂ f hf) (mk x, mk y) ↔ continuous_at (uncurry f) (x, y) :=
+tendsto_lift₂_nhds
+
+@[simp] lemma continuous_within_at_lift₂ {f : X → Y → Z}
+  {hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d}
+  {s : set (separation_quotient X × separation_quotient Y)} {x : X} {y : Y} :
+  continuous_within_at (uncurry $ lift₂ f hf) s (mk x, mk y) ↔
+    continuous_within_at (uncurry f) (prod.map mk mk ⁻¹' s) (x, y) :=
+tendsto_lift₂_nhds_within
+
+@[simp] lemma continuous_on_lift₂ {f : X → Y → Z}
+  {hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d}
+  {s : set (separation_quotient X × separation_quotient Y)} :
+  continuous_on (uncurry $ lift₂ f hf) s ↔ continuous_on (uncurry f) (prod.map mk mk ⁻¹' s) :=
+begin
+  simp_rw [continuous_on, (surjective_mk.prod_map surjective_mk).forall, prod.forall, prod.map,
+    continuous_within_at_lift₂],
+  refl
+end
+
+@[simp] lemma continuous_lift₂ {f : X → Y → Z}
+  {hf : ∀ a b c d, a ~ c → b ~ d → f a b = f c d} :
+  continuous (uncurry $ lift₂ f hf) ↔ continuous (uncurry f) :=
+by simp only [continuous_iff_continuous_on_univ, continuous_on_lift₂, preimage_univ]
+
+end separation_quotient
diff --git a/src/topology/instances/add_circle.lean b/src/topology/instances/add_circle.lean
new file mode 100644
index 0000000000000..88ac997cbf3eb
--- /dev/null
+++ b/src/topology/instances/add_circle.lean
@@ -0,0 +1,560 @@
+/-
+Copyright (c) 2022 Oliver Nash. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Oliver Nash
+-/
+import data.nat.totient
+import algebra.ring.add_aut
+import group_theory.divisible
+import group_theory.order_of_element
+import algebra.order.floor
+import algebra.order.to_interval_mod
+import topology.instances.real
+
+/-!
+# The additive circle
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the additive circle `add_circle p` as the quotient `𝕜 ⧸ (ℤ ∙ p)` for some period `p : 𝕜`.
+
+See also `circle` and `real.angle`.  For the normed group structure on `add_circle`, see
+`add_circle.normed_add_comm_group` in a later file.
+
+## Main definitions and results:
+
+ * `add_circle`: the additive circle `𝕜 ⧸ (ℤ ∙ p)` for some period `p : 𝕜`
+ * `unit_add_circle`: the special case `ℝ ⧸ ℤ`
+ * `add_circle.equiv_add_circle`: the rescaling equivalence `add_circle p ≃+ add_circle q`
+ * `add_circle.equiv_Ico`: the natural equivalence `add_circle p ≃ Ico a (a + p)`
+ * `add_circle.add_order_of_div_of_gcd_eq_one`: rational points have finite order
+ * `add_circle.exists_gcd_eq_one_of_is_of_fin_add_order`: finite-order points are rational
+ * `add_circle.homeo_Icc_quot`: the natural topological equivalence between `add_circle p` and
+   `Icc a (a + p)` with its endpoints identified.
+ * `add_circle.lift_Ico_continuous`: if `f : ℝ → B` is continuous, and `f a = f (a + p)` for
+   some `a`, then there is a continuous function `add_circle p → B` which agrees with `f` on
+   `Icc a (a + p)`.
+
+## Implementation notes:
+
+Although the most important case is `𝕜 = ℝ` we wish to support other types of scalars, such as
+the rational circle `add_circle (1 : ℚ)`, and so we set things up more generally.
+
+## TODO
+
+ * Link with periodicity
+ * Lie group structure
+ * Exponential equivalence to `circle`
+
+-/
+
+noncomputable theory
+
+open add_comm_group set function add_subgroup topological_space
+open_locale topology
+
+variables {𝕜 B : Type*}
+
+section continuity
+
+variables [linear_ordered_add_comm_group 𝕜] [archimedean 𝕜]
+  [topological_space 𝕜] [order_topology 𝕜] {p : 𝕜} (hp : 0 < p) (a x : 𝕜)
+
+lemma continuous_right_to_Ico_mod : continuous_within_at (to_Ico_mod hp a) (Ici x) x :=
+begin
+  intros s h,
+  rw [filter.mem_map, mem_nhds_within_iff_exists_mem_nhds_inter],
+  haveI : nontrivial 𝕜 := ⟨⟨0, p, hp.ne⟩⟩,
+  simp_rw mem_nhds_iff_exists_Ioo_subset at h ⊢,
+  obtain ⟨l, u, hxI, hIs⟩ := h,
+  let d := to_Ico_div hp a x • p,
+  have hd := to_Ico_mod_mem_Ico hp a x,
+  simp_rw [subset_def, mem_inter_iff],
+  refine ⟨_, ⟨l + d, min (a + p) u + d, _, λ x, id⟩, λ y, _⟩;
+    simp_rw [← sub_mem_Ioo_iff_left, mem_Ioo, lt_min_iff],
+  { exact ⟨hxI.1, hd.2, hxI.2⟩ },
+  { rintro ⟨h, h'⟩, apply hIs,
+    rw [← to_Ico_mod_sub_zsmul, (to_Ico_mod_eq_self _).2],
+    exacts [⟨h.1, h.2.2⟩, ⟨hd.1.trans (sub_le_sub_right h' _), h.2.1⟩] },
+end
+
+lemma continuous_left_to_Ioc_mod : continuous_within_at (to_Ioc_mod hp a) (Iic x) x :=
+begin
+  rw (funext (λ y, eq.trans (by rw neg_neg) $ to_Ioc_mod_neg _ _ _) :
+    to_Ioc_mod hp a = (λ x, p - x) ∘ to_Ico_mod hp (-a) ∘ has_neg.neg),
+  exact ((continuous_sub_left _).continuous_at.comp_continuous_within_at $
+    (continuous_right_to_Ico_mod _ _ _).comp continuous_neg.continuous_within_at $ λ y, neg_le_neg),
+end
+
+variables {x} (hx : (x : 𝕜 ⧸ zmultiples p) ≠ a)
+
+lemma to_Ico_mod_eventually_eq_to_Ioc_mod : to_Ico_mod hp a =ᶠ[𝓝 x] to_Ioc_mod hp a :=
+is_open.mem_nhds (by {rw Ico_eq_locus_Ioc_eq_Union_Ioo, exact is_open_Union (λ i, is_open_Ioo)}) $
+  (not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod hp).1 $ not_modeq_iff_ne_mod_zmultiples.2 hx
+
+lemma continuous_at_to_Ico_mod : continuous_at (to_Ico_mod hp a) x :=
+let h := to_Ico_mod_eventually_eq_to_Ioc_mod hp a hx in continuous_at_iff_continuous_left_right.2 $
+  ⟨(continuous_left_to_Ioc_mod hp a x).congr_of_eventually_eq
+    (h.filter_mono nhds_within_le_nhds) h.eq_of_nhds, continuous_right_to_Ico_mod hp a x⟩
+
+lemma continuous_at_to_Ioc_mod : continuous_at (to_Ioc_mod hp a) x :=
+let h := to_Ico_mod_eventually_eq_to_Ioc_mod hp a hx in continuous_at_iff_continuous_left_right.2 $
+  ⟨continuous_left_to_Ioc_mod hp a x, (continuous_right_to_Ico_mod hp a x).congr_of_eventually_eq
+    (h.symm.filter_mono nhds_within_le_nhds) h.symm.eq_of_nhds⟩
+
+end continuity
+
+/-- The "additive circle": `𝕜 ⧸ (ℤ ∙ p)`. See also `circle` and `real.angle`. -/
+@[derive [add_comm_group, topological_space, topological_add_group, inhabited, has_coe_t 𝕜],
+  nolint unused_arguments]
+def add_circle [linear_ordered_add_comm_group 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p : 𝕜) :=
+𝕜 ⧸ zmultiples p
+
+namespace add_circle
+
+section linear_ordered_add_comm_group
+variables [linear_ordered_add_comm_group 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p : 𝕜)
+
+lemma coe_nsmul {n : ℕ} {x : 𝕜} : (↑(n • x) : add_circle p) = n • (x : add_circle p) := rfl
+
+lemma coe_zsmul {n : ℤ} {x : 𝕜} : (↑(n • x) : add_circle p) = n • (x : add_circle p) := rfl
+
+lemma coe_add (x y : 𝕜) : (↑(x + y) : add_circle p) = (x : add_circle p) + (y : add_circle p) := rfl
+
+lemma coe_sub (x y : 𝕜) : (↑(x - y) : add_circle p) = (x : add_circle p) - (y : add_circle p) := rfl
+
+lemma coe_neg {x : 𝕜} : (↑(-x) : add_circle p) = -(x : add_circle p) := rfl
+
+lemma coe_eq_zero_iff {x : 𝕜} : (x : add_circle p) = 0 ↔ ∃ (n : ℤ), n • p = x :=
+by simp [add_subgroup.mem_zmultiples_iff]
+
+lemma coe_eq_zero_of_pos_iff (hp : 0 < p) {x : 𝕜} (hx : 0 < x) :
+  (x : add_circle p) = 0 ↔ ∃ (n : ℕ), n • p = x :=
+begin
+  rw coe_eq_zero_iff,
+  split;
+  rintros ⟨n, rfl⟩,
+  { replace hx : 0 < n,
+    { contrapose! hx,
+      simpa only [←neg_nonneg, ←zsmul_neg, zsmul_neg'] using zsmul_nonneg hp.le (neg_nonneg.2 hx) },
+    exact ⟨n.to_nat, by rw [← coe_nat_zsmul, int.to_nat_of_nonneg hx.le]⟩, },
+  { exact ⟨(n : ℤ), by simp⟩, },
+end
+
+lemma coe_period : (p : add_circle p) = 0 :=
+(quotient_add_group.eq_zero_iff p).2 $ mem_zmultiples p
+
+@[simp] lemma coe_add_period (x : 𝕜) : ((x + p : 𝕜) : add_circle p) = x :=
+by rw [coe_add, ←eq_sub_iff_add_eq', sub_self, coe_period]
+
+@[continuity, nolint unused_arguments] protected lemma continuous_mk' :
+  continuous (quotient_add_group.mk' (zmultiples p) : 𝕜 → add_circle p) :=
+continuous_coinduced_rng
+
+variables [hp : fact (0 < p)]
+include hp
+
+variables (a : 𝕜) [archimedean 𝕜]
+
+instance : circular_order (add_circle p) :=
+quotient_add_group.circular_order
+
+/-- The equivalence between `add_circle p` and the half-open interval `[a, a + p)`, whose inverse
+is the natural quotient map. -/
+def equiv_Ico : add_circle p ≃ Ico a (a + p) := quotient_add_group.equiv_Ico_mod hp.out a
+
+/-- The equivalence between `add_circle p` and the half-open interval `(a, a + p]`, whose inverse
+is the natural quotient map. -/
+def equiv_Ioc : add_circle p ≃ Ioc a (a + p) := quotient_add_group.equiv_Ioc_mod hp.out a
+
+/-- Given a function on `𝕜`, return the unique function on `add_circle p` agreeing with `f` on
+`[a, a + p)`. -/
+def lift_Ico (f : 𝕜 → B) : add_circle p → B := restrict _ f ∘ add_circle.equiv_Ico p a
+
+/-- Given a function on `𝕜`, return the unique function on `add_circle p` agreeing with `f` on
+`(a, a + p]`. -/
+def lift_Ioc (f : 𝕜 → B) : add_circle p → B := restrict _ f ∘ add_circle.equiv_Ioc p a
+
+variables {p a}
+
+lemma coe_eq_coe_iff_of_mem_Ico {x y : 𝕜}
+  (hx : x ∈ Ico a (a + p)) (hy : y ∈ Ico a (a + p)) : (x : add_circle p) = y ↔ x = y :=
+begin
+  refine ⟨λ h, _, by tauto⟩,
+  suffices : (⟨x, hx⟩ : Ico a (a + p)) = ⟨y, hy⟩, by exact subtype.mk.inj this,
+  apply_fun equiv_Ico p a at h,
+  rw [←(equiv_Ico p a).right_inv ⟨x, hx⟩, ←(equiv_Ico p a).right_inv ⟨y, hy⟩],
+  exact h
+end
+
+lemma lift_Ico_coe_apply {f : 𝕜 → B} {x : 𝕜} (hx : x ∈ Ico a (a + p)) : lift_Ico p a f ↑x = f x :=
+begin
+  have : (equiv_Ico p a) x = ⟨x, hx⟩,
+  { rw equiv.apply_eq_iff_eq_symm_apply,
+    refl, },
+  rw [lift_Ico, comp_apply, this],
+  refl,
+end
+
+lemma lift_Ioc_coe_apply {f : 𝕜 → B} {x : 𝕜} (hx : x ∈ Ioc a (a + p)) : lift_Ioc p a f ↑x = f x :=
+begin
+  have : (equiv_Ioc p a) x = ⟨x, hx⟩,
+  { rw equiv.apply_eq_iff_eq_symm_apply,
+    refl, },
+  rw [lift_Ioc, comp_apply, this],
+  refl,
+end
+
+variables (p a)
+
+section continuity
+
+@[continuity] lemma continuous_equiv_Ico_symm : continuous (equiv_Ico p a).symm :=
+continuous_quotient_mk.comp continuous_subtype_coe
+
+@[continuity] lemma continuous_equiv_Ioc_symm : continuous (equiv_Ioc p a).symm :=
+continuous_quotient_mk.comp continuous_subtype_coe
+
+variables {x : add_circle p} (hx : x ≠ a)
+include hx
+
+lemma continuous_at_equiv_Ico : continuous_at (equiv_Ico p a) x :=
+begin
+  induction x using quotient_add_group.induction_on',
+  rw [continuous_at, filter.tendsto, quotient_add_group.nhds_eq, filter.map_map],
+  exact (continuous_at_to_Ico_mod hp.out a hx).cod_restrict _,
+end
+
+lemma continuous_at_equiv_Ioc : continuous_at (equiv_Ioc p a) x :=
+begin
+  induction x using quotient_add_group.induction_on',
+  rw [continuous_at, filter.tendsto, quotient_add_group.nhds_eq, filter.map_map],
+  exact (continuous_at_to_Ioc_mod hp.out a hx).cod_restrict _,
+end
+
+end continuity
+
+/-- The image of the closed-open interval `[a, a + p)` under the quotient map `𝕜 → add_circle p` is
+the entire space. -/
+@[simp] lemma coe_image_Ico_eq : (coe : 𝕜 → add_circle p) '' Ico a (a + p) = univ :=
+by { rw image_eq_range, exact (equiv_Ico p a).symm.range_eq_univ }
+
+/-- The image of the closed-open interval `[a, a + p)` under the quotient map `𝕜 → add_circle p` is
+the entire space. -/
+@[simp] lemma coe_image_Ioc_eq : (coe : 𝕜 → add_circle p) '' Ioc a (a + p) = univ :=
+by { rw image_eq_range, exact (equiv_Ioc p a).symm.range_eq_univ }
+
+/-- The image of the closed interval `[0, p]` under the quotient map `𝕜 → add_circle p` is the
+entire space. -/
+@[simp] lemma coe_image_Icc_eq : (coe : 𝕜 → add_circle p) '' Icc a (a + p) = univ :=
+eq_top_mono (image_subset _ Ico_subset_Icc_self) $ coe_image_Ico_eq _ _
+
+end linear_ordered_add_comm_group
+
+section linear_ordered_field
+variables [linear_ordered_field 𝕜] [topological_space 𝕜] [order_topology 𝕜] (p q : 𝕜)
+
+/-- The rescaling equivalence between additive circles with different periods. -/
+def equiv_add_circle (hp : p ≠ 0) (hq : q ≠ 0) : add_circle p ≃+ add_circle q :=
+quotient_add_group.congr _ _ (add_aut.mul_right $ (units.mk0 p hp)⁻¹ * units.mk0 q hq) $
+  by rw [add_monoid_hom.map_zmultiples, add_monoid_hom.coe_coe, add_aut.mul_right_apply,
+    units.coe_mul, units.coe_mk0, units.coe_inv, units.coe_mk0, mul_inv_cancel_left₀ hp]
+
+@[simp] lemma equiv_add_circle_apply_mk (hp : p ≠ 0) (hq : q ≠ 0) (x : 𝕜) :
+  equiv_add_circle p q hp hq (x : 𝕜) = (x * (p⁻¹ * q) : 𝕜) :=
+rfl
+
+@[simp] lemma equiv_add_circle_symm_apply_mk (hp : p ≠ 0) (hq : q ≠ 0) (x : 𝕜) :
+  (equiv_add_circle p q hp hq).symm (x : 𝕜) = (x * (q⁻¹ * p) : 𝕜) :=
+rfl
+
+variables [hp : fact (0 < p)]
+include hp
+
+section floor_ring
+
+variables [floor_ring 𝕜]
+
+@[simp] lemma coe_equiv_Ico_mk_apply (x : 𝕜) :
+  (equiv_Ico p 0 $ quotient_add_group.mk x : 𝕜) = int.fract (x / p) * p :=
+to_Ico_mod_eq_fract_mul _ x
+
+instance : divisible_by (add_circle p) ℤ :=
+{ div := λ x n, (↑(((n : 𝕜)⁻¹) * (equiv_Ico p 0 x : 𝕜)) : add_circle p),
+  div_zero := λ x,
+    by simp only [algebra_map.coe_zero, quotient_add_group.coe_zero, inv_zero, zero_mul],
+  div_cancel := λ n x hn,
+  begin
+    replace hn : (n : 𝕜) ≠ 0, { norm_cast, assumption, },
+    change n • quotient_add_group.mk' _ ((n : 𝕜)⁻¹ * ↑(equiv_Ico p 0 x)) = x,
+    rw [← map_zsmul, ← smul_mul_assoc, zsmul_eq_mul, mul_inv_cancel hn, one_mul],
+    exact (equiv_Ico p 0).symm_apply_apply x,
+  end, }
+
+end floor_ring
+
+section finite_order_points
+
+variables {p}
+
+lemma add_order_of_period_div {n : ℕ} (h : 0 < n) : add_order_of ((p / n : 𝕜) : add_circle p) = n :=
+begin
+  rw [add_order_of_eq_iff h],
+  replace h : 0 < (n : 𝕜) := nat.cast_pos.2 h,
+  refine ⟨_, λ m hn h0, _⟩; simp only [ne, ← coe_nsmul, nsmul_eq_mul],
+  { rw [mul_div_cancel' _ h.ne', coe_period] },
+  rw coe_eq_zero_of_pos_iff p hp.out (mul_pos (nat.cast_pos.2 h0) $ div_pos hp.out h),
+  rintro ⟨k, hk⟩,
+  rw [mul_div, eq_div_iff h.ne', nsmul_eq_mul, mul_right_comm, ← nat.cast_mul,
+      (mul_left_injective₀ hp.out.ne').eq_iff, nat.cast_inj, mul_comm] at hk,
+  exact (nat.le_of_dvd h0 ⟨_, hk.symm⟩).not_lt hn,
+end
+
+variables (p)
+
+lemma gcd_mul_add_order_of_div_eq {n : ℕ} (m : ℕ) (hn : 0 < n) :
+  m.gcd n * add_order_of (↑(↑m / ↑n * p) : add_circle p) = n :=
+begin
+  rw [mul_comm_div, ← nsmul_eq_mul, coe_nsmul, add_order_of_nsmul''],
+  { rw [add_order_of_period_div hn, nat.gcd_comm, nat.mul_div_cancel'],
+    exacts [n.gcd_dvd_left m, hp] },
+  { rw [← add_order_of_pos_iff, add_order_of_period_div hn], exacts [hn, hp] },
+end
+
+variable {p}
+
+lemma add_order_of_div_of_gcd_eq_one {m n : ℕ} (hn : 0 < n) (h : m.gcd n = 1) :
+  add_order_of (↑(↑m / ↑n * p) : add_circle p) = n :=
+by { convert gcd_mul_add_order_of_div_eq p m hn, rw [h, one_mul] }
+
+lemma add_order_of_div_of_gcd_eq_one' {m : ℤ} {n : ℕ} (hn : 0 < n) (h : m.nat_abs.gcd n = 1) :
+  add_order_of (↑(↑m / ↑n * p) : add_circle p) = n :=
+begin
+  induction m,
+  { simp only [int.of_nat_eq_coe, int.cast_coe_nat, int.nat_abs_of_nat] at h ⊢,
+    exact add_order_of_div_of_gcd_eq_one hn h, },
+  { simp only [int.cast_neg_succ_of_nat, neg_div, neg_mul, coe_neg, order_of_neg],
+    exact add_order_of_div_of_gcd_eq_one hn h, },
+end
+
+lemma add_order_of_coe_rat {q : ℚ} : add_order_of (↑(↑q * p) : add_circle p) = q.denom :=
+begin
+  have : (↑(q.denom : ℤ) : 𝕜) ≠ 0, { norm_cast, exact q.pos.ne.symm, },
+  rw [← @rat.num_denom q, rat.cast_mk_of_ne_zero _ _ this, int.cast_coe_nat, rat.num_denom,
+    add_order_of_div_of_gcd_eq_one' q.pos q.cop],
+  apply_instance,
+end
+
+lemma add_order_of_eq_pos_iff {u : add_circle p} {n : ℕ} (h : 0 < n) :
+  add_order_of u = n ↔ ∃ m < n, m.gcd n = 1 ∧ ↑(↑m / ↑n * p) = u :=
+begin
+  refine ⟨quotient_add_group.induction_on' u (λ k hk, _), _⟩, swap,
+  { rintros ⟨m, h₀, h₁, rfl⟩, exact add_order_of_div_of_gcd_eq_one h h₁ },
+  have h0 := add_order_of_nsmul_eq_zero (k : add_circle p),
+  rw [hk, ← coe_nsmul, coe_eq_zero_iff] at h0,
+  obtain ⟨a, ha⟩ := h0,
+  have h0 : (_ : 𝕜) ≠ 0 := nat.cast_ne_zero.2 h.ne',
+  rw [nsmul_eq_mul, mul_comm, ← div_eq_iff h0, ← a.div_add_mod' n, add_smul, add_div, zsmul_eq_mul,
+    int.cast_mul, int.cast_coe_nat, mul_assoc, ← mul_div, mul_comm _ p, mul_div_cancel p h0] at ha,
+  have han : _ = a % n := int.to_nat_of_nonneg (int.mod_nonneg _ $ by exact_mod_cast h.ne'),
+  have he := _, refine ⟨(a % n).to_nat, _, _, he⟩,
+  { rw [← int.coe_nat_lt, han],
+    exact int.mod_lt_of_pos _ (int.coe_nat_lt.2 h) },
+  { have := (gcd_mul_add_order_of_div_eq p _ h).trans ((congr_arg add_order_of he).trans hk).symm,
+    rw [he, nat.mul_left_eq_self_iff] at this, { exact this }, { rwa hk } },
+  convert congr_arg coe ha using 1,
+  rw [coe_add, ← int.cast_coe_nat, han, zsmul_eq_mul, mul_div_right_comm,
+      eq_comm, add_left_eq_self, ← zsmul_eq_mul, coe_zsmul, coe_period, smul_zero],
+end
+
+lemma exists_gcd_eq_one_of_is_of_fin_add_order {u : add_circle p} (h : is_of_fin_add_order u) :
+  ∃ m : ℕ, m.gcd (add_order_of u) = 1 ∧
+           m < (add_order_of u) ∧
+           ↑(((m : 𝕜) / add_order_of u) * p) = u :=
+let ⟨m, hl, hg, he⟩ := (add_order_of_eq_pos_iff $ add_order_of_pos' h).1 rfl in ⟨m, hg, hl, he⟩
+
+variables (p)
+
+/-- The natural bijection between points of order `n` and natural numbers less than and coprime to
+`n`. The inverse of the map sends `m ↦ (m/n * p : add_circle p)` where `m` is coprime to `n` and
+satisfies `0 ≤ m < n`. -/
+def set_add_order_of_equiv {n : ℕ} (hn : 0 < n) :
+  {u : add_circle p | add_order_of u = n} ≃ {m | m < n ∧ m.gcd n = 1} :=
+equiv.symm $ equiv.of_bijective
+  (λ m, ⟨↑((m : 𝕜) / n * p), add_order_of_div_of_gcd_eq_one hn (m.prop.2)⟩)
+begin
+  refine ⟨λ m₁ m₂ h, subtype.ext _, λ u, _⟩,
+  { simp_rw [subtype.ext_iff, subtype.coe_mk] at h,
+    rw [← sub_eq_zero, ← coe_sub, ← sub_mul, ← sub_div, coe_coe, coe_coe, ← int.cast_coe_nat m₁,
+        ← int.cast_coe_nat m₂, ← int.cast_sub, coe_eq_zero_iff] at h,
+    obtain ⟨m, hm⟩ := h,
+    rw [← mul_div_right_comm, eq_div_iff, mul_comm, ← zsmul_eq_mul, mul_smul_comm, ← nsmul_eq_mul,
+      ← coe_nat_zsmul, smul_smul, (zsmul_strict_mono_left hp.out).injective.eq_iff, mul_comm] at hm,
+    swap, { exact nat.cast_ne_zero.2 hn.ne' },
+    rw [← @nat.cast_inj ℤ, ← sub_eq_zero],
+    refine int.eq_zero_of_abs_lt_dvd ⟨_, hm.symm⟩ (abs_sub_lt_iff.2 ⟨_, _⟩);
+    apply (int.sub_le_self _ $ nat.cast_nonneg _).trans_lt (nat.cast_lt.2 _),
+    exacts [m₁.2.1, m₂.2.1] },
+  obtain ⟨m, hmn, hg, he⟩ := (add_order_of_eq_pos_iff hn).mp u.2,
+  exact ⟨⟨m, hmn, hg⟩, subtype.ext he⟩,
+end
+
+@[simp] lemma card_add_order_of_eq_totient {n : ℕ} :
+  nat.card {u : add_circle p // add_order_of u = n} = n.totient :=
+begin
+  rcases n.eq_zero_or_pos with rfl | hn,
+  { simp only [nat.totient_zero, add_order_of_eq_zero_iff],
+    rcases em (∃ (u : add_circle p), ¬ is_of_fin_add_order u) with ⟨u, hu⟩ | h,
+    { haveI : infinite {u : add_circle p // ¬is_of_fin_add_order u},
+      { erw infinite_coe_iff,
+        exact infinite_not_is_of_fin_add_order hu, },
+      exact nat.card_eq_zero_of_infinite, },
+    { haveI : is_empty {u : add_circle p // ¬is_of_fin_add_order u}, { simpa using h, },
+      exact nat.card_of_is_empty, }, },
+  { rw [← coe_set_of, nat.card_congr (set_add_order_of_equiv p hn),
+      n.totient_eq_card_lt_and_coprime],
+    simp only [nat.gcd_comm], },
+end
+
+lemma finite_set_of_add_order_eq {n : ℕ} (hn : 0 < n) :
+  {u : add_circle p | add_order_of u = n}.finite :=
+finite_coe_iff.mp $ nat.finite_of_card_ne_zero $ by simpa only [coe_set_of,
+  card_add_order_of_eq_totient p] using (nat.totient_pos hn).ne'
+
+end finite_order_points
+
+end linear_ordered_field
+
+variables (p : ℝ)
+
+/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is compact. -/
+instance compact_space [fact (0 < p)] : compact_space $ add_circle p :=
+begin
+  rw [← is_compact_univ_iff, ← coe_image_Icc_eq p 0],
+  exact is_compact_Icc.image (add_circle.continuous_mk' p),
+end
+
+/-- The action on `ℝ` by right multiplication of its the subgroup `zmultiples p` (the multiples of
+`p:ℝ`) is properly discontinuous. -/
+instance : properly_discontinuous_vadd (zmultiples p).opposite ℝ :=
+(zmultiples p).properly_discontinuous_vadd_opposite_of_tendsto_cofinite
+  (add_subgroup.tendsto_zmultiples_subtype_cofinite p)
+
+/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is Hausdorff. -/
+instance : t2_space (add_circle p) := t2_space_of_properly_discontinuous_vadd_of_t2_space
+
+/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is normal. -/
+instance [fact (0 < p)] : normal_space (add_circle p) := normal_of_compact_t2
+
+/-- The "additive circle" `ℝ ⧸ (ℤ ∙ p)` is second-countable. -/
+instance : second_countable_topology (add_circle p) := quotient_add_group.second_countable_topology
+
+end add_circle
+
+local attribute [instance] real.fact_zero_lt_one
+
+/-- The unit circle `ℝ ⧸ ℤ`. -/
+@[derive [compact_space, normal_space, second_countable_topology]]
+abbreviation unit_add_circle := add_circle (1 : ℝ)
+
+section identify_Icc_ends
+/-! This section proves that for any `a`, the natural map from `[a, a + p] ⊂ 𝕜` to `add_circle p`
+gives an identification of `add_circle p`, as a topological space, with the quotient of `[a, a + p]`
+by the equivalence relation identifying the endpoints. -/
+
+namespace add_circle
+
+variables [linear_ordered_add_comm_group 𝕜] [topological_space 𝕜] [order_topology 𝕜]
+(p a : 𝕜) [hp : fact (0 < p)]
+
+include hp
+
+local notation `𝕋` := add_circle p
+
+/-- The relation identifying the endpoints of `Icc a (a + p)`. -/
+inductive endpoint_ident : Icc a (a + p) → Icc a (a + p) → Prop
+| mk : endpoint_ident
+    ⟨a,      left_mem_Icc.mpr $ le_add_of_nonneg_right hp.out.le⟩
+    ⟨a + p, right_mem_Icc.mpr $ le_add_of_nonneg_right hp.out.le⟩
+
+variables [archimedean 𝕜]
+
+/-- The equivalence between `add_circle p` and the quotient of `[a, a + p]` by the relation
+identifying the endpoints. -/
+def equiv_Icc_quot : 𝕋 ≃ quot (endpoint_ident p a) :=
+{ to_fun := λ x, quot.mk _ $ inclusion Ico_subset_Icc_self (equiv_Ico _ _ x),
+  inv_fun := λ x, quot.lift_on x coe $ by { rintro _ _ ⟨_⟩, exact (coe_add_period p a).symm },
+  left_inv := (equiv_Ico p a).symm_apply_apply,
+  right_inv := quot.ind $ by
+  { rintro ⟨x, hx⟩,
+    have := _,
+    rcases ne_or_eq x (a + p) with h | rfl,
+    { revert x, exact this },
+    { rw ← quot.sound endpoint_ident.mk, exact this _ _ (lt_add_of_pos_right a hp.out).ne },
+    intros x hx h,
+    congr, ext1,
+    apply congr_arg subtype.val ((equiv_Ico p a).right_inv ⟨x, hx.1, hx.2.lt_of_ne h⟩) } }
+
+lemma equiv_Icc_quot_comp_mk_eq_to_Ico_mod : equiv_Icc_quot p a ∘ quotient.mk' =
+  λ x, quot.mk _ ⟨to_Ico_mod hp.out a x, Ico_subset_Icc_self $ to_Ico_mod_mem_Ico _ _ x⟩ := rfl
+
+lemma equiv_Icc_quot_comp_mk_eq_to_Ioc_mod : equiv_Icc_quot p a ∘ quotient.mk' =
+  λ x, quot.mk _ ⟨to_Ioc_mod hp.out a x, Ioc_subset_Icc_self $ to_Ioc_mod_mem_Ioc _ _ x⟩ :=
+begin
+  rw equiv_Icc_quot_comp_mk_eq_to_Ico_mod, funext,
+  by_cases a ≡ x [PMOD p],
+  { simp_rw [(modeq_iff_to_Ico_mod_eq_left hp.out).1 h, (modeq_iff_to_Ioc_mod_eq_right hp.out).1 h],
+    exact quot.sound endpoint_ident.mk },
+  { simp_rw (not_modeq_iff_to_Ico_mod_eq_to_Ioc_mod hp.out).1 h }
+end
+
+/-- The natural map from `[a, a + p] ⊂ 𝕜` with endpoints identified to `𝕜 / ℤ • p`, as a
+homeomorphism of topological spaces. -/
+def homeo_Icc_quot : 𝕋 ≃ₜ quot (endpoint_ident p a) :=
+{ to_equiv := equiv_Icc_quot p a,
+  continuous_to_fun := begin
+    simp_rw [quotient_map_quotient_mk.continuous_iff,
+      continuous_iff_continuous_at, continuous_at_iff_continuous_left_right],
+    intro x, split,
+    work_on_goal 1 { erw equiv_Icc_quot_comp_mk_eq_to_Ioc_mod },
+    work_on_goal 2 { erw equiv_Icc_quot_comp_mk_eq_to_Ico_mod },
+    all_goals { apply continuous_quot_mk.continuous_at.comp_continuous_within_at,
+      rw inducing_coe.continuous_within_at_iff },
+    { apply continuous_left_to_Ioc_mod },
+    { apply continuous_right_to_Ico_mod },
+  end,
+  continuous_inv_fun := continuous_quot_lift _
+    ((add_circle.continuous_mk' p).comp continuous_subtype_coe) }
+
+/-! We now show that a continuous function on `[a, a + p]` satisfying `f a = f (a + p)` is the
+pullback of a continuous function on `add_circle p`. -/
+
+variables {p a}
+
+lemma lift_Ico_eq_lift_Icc {f : 𝕜 → B} (h : f a = f (a + p)) : lift_Ico p a f =
+  quot.lift (restrict (Icc a $ a + p) f) (by { rintro _ _ ⟨_⟩, exact h }) ∘ equiv_Icc_quot p a :=
+rfl
+
+lemma lift_Ico_continuous [topological_space B] {f : 𝕜 → B} (hf : f a = f (a + p))
+  (hc : continuous_on f $ Icc a (a + p)) : continuous (lift_Ico p a f) :=
+begin
+  rw lift_Ico_eq_lift_Icc hf,
+  refine continuous.comp _ (homeo_Icc_quot p a).continuous_to_fun,
+  exact continuous_coinduced_dom.mpr (continuous_on_iff_continuous_restrict.mp hc),
+end
+
+section zero_based
+
+lemma lift_Ico_zero_coe_apply {f : 𝕜 → B} {x : 𝕜} (hx : x ∈ Ico 0 p) :
+  lift_Ico p 0 f ↑x = f x := lift_Ico_coe_apply (by rwa zero_add)
+
+lemma lift_Ico_zero_continuous [topological_space B] {f : 𝕜 → B}
+  (hf : f 0 = f p) (hc : continuous_on f $ Icc 0 p) : continuous (lift_Ico p 0 f) :=
+lift_Ico_continuous (by rwa zero_add : f 0 = f (0 + p)) (by rwa zero_add)
+
+end zero_based
+
+end add_circle
+
+end identify_Icc_ends
diff --git a/src/topology/instances/complex.lean b/src/topology/instances/complex.lean
new file mode 100644
index 0000000000000..91ac9ecd0bd55
--- /dev/null
+++ b/src/topology/instances/complex.lean
@@ -0,0 +1,100 @@
+/-
+Copyright (c) 2022 Xavier Roblot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Xavier Roblot
+-/
+
+import analysis.complex.basic
+import field_theory.intermediate_field
+import topology.algebra.uniform_ring
+
+/-!
+# Some results about the topology of ℂ
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+-/
+
+section complex_subfield
+
+open complex set
+
+open_locale complex_conjugate
+
+/-- The only closed subfields of `ℂ` are `ℝ` and `ℂ`. -/
+lemma complex.subfield_eq_of_closed {K : subfield ℂ} (hc : is_closed (K : set ℂ)) :
+  K = of_real.field_range ∨ K = ⊤ :=
+begin
+  suffices : range (coe : ℝ → ℂ) ⊆ K,
+  { rw [range_subset_iff, ← coe_algebra_map] at this,
+    have := (subalgebra.is_simple_order_of_finrank finrank_real_complex).eq_bot_or_eq_top
+      (subfield.to_intermediate_field K this).to_subalgebra,
+    simp_rw ← set_like.coe_set_eq at this ⊢,
+    convert this using 2,
+    simpa only [ring_hom.coe_field_range, algebra.coe_bot, coe_algebra_map], },
+  suffices : range (coe : ℝ → ℂ) ⊆ closure (set.range ((coe : ℝ → ℂ) ∘ (coe : ℚ → ℝ))),
+  { refine subset_trans this _,
+    rw ← is_closed.closure_eq hc,
+    apply closure_mono,
+    rintros _ ⟨_, rfl⟩,
+    simp only [function.comp_app, of_real_rat_cast, set_like.mem_coe, subfield_class.coe_rat_mem] },
+  nth_rewrite 1 range_comp,
+  refine subset_trans _ (image_closure_subset_closure_image continuous_of_real),
+  rw dense_range.closure_range rat.dense_embedding_coe_real.dense,
+  simp only [image_univ],
+end
+
+/-- Let `K` a subfield of `ℂ` and let `ψ : K →+* ℂ` a ring homomorphism. Assume that `ψ` is uniform
+continuous, then `ψ` is either the inclusion map or the composition of the inclusion map with the
+complex conjugation. -/
+lemma complex.uniform_continuous_ring_hom_eq_id_or_conj (K : subfield ℂ) {ψ : K →+* ℂ}
+  (hc : uniform_continuous ψ) : ψ.to_fun = K.subtype ∨ ψ.to_fun = conj ∘ K.subtype :=
+begin
+  letI : topological_division_ring ℂ := topological_division_ring.mk,
+  letI : topological_ring K.topological_closure :=
+      subring.topological_ring K.topological_closure.to_subring,
+  set ι : K → K.topological_closure := subfield.inclusion K.le_topological_closure,
+  have ui : uniform_inducing ι :=
+    ⟨ by { erw [uniformity_subtype, uniformity_subtype, filter.comap_comap], congr, } ⟩,
+  let di := ui.dense_inducing _,
+  { -- extψ : closure(K) →+* ℂ is the extension of ψ : K →+* ℂ
+    let extψ := dense_inducing.extend_ring_hom ui di.dense hc,
+    haveI := (uniform_continuous_uniformly_extend ui di.dense hc).continuous,
+    cases complex.subfield_eq_of_closed (subfield.is_closed_topological_closure K),
+    { left,
+      let j := ring_equiv.subfield_congr h,
+      -- ψ₁ is the continuous ring hom `ℝ →+* ℂ` constructed from `j : closure (K) ≃+* ℝ`
+      -- and `extψ : closure (K) →+* ℂ`
+      let ψ₁ := ring_hom.comp extψ (ring_hom.comp j.symm.to_ring_hom of_real.range_restrict),
+      ext1 x,
+      rsuffices ⟨r, hr⟩ : ∃ r : ℝ, of_real.range_restrict r = j (ι x),
+      { have := ring_hom.congr_fun
+          (ring_hom_eq_of_real_of_continuous (by continuity! : continuous ψ₁)) r,
+        rw [ring_hom.comp_apply, ring_hom.comp_apply, hr, ring_equiv.to_ring_hom_eq_coe] at this,
+        convert this using 1,
+        { exact (dense_inducing.extend_eq di hc.continuous _).symm, },
+        { rw [← of_real.coe_range_restrict, hr], refl, }},
+      obtain ⟨r, hr⟩ := set_like.coe_mem (j (ι x)),
+      exact ⟨r, subtype.ext hr⟩, },
+    { -- ψ₁ is the continuous ring hom `ℂ →+* ℂ` constructed from `closure (K) ≃+* ℂ`
+      -- and `extψ : closure (K) →+* ℂ`
+      let ψ₁ := ring_hom.comp extψ (ring_hom.comp (ring_equiv.subfield_congr h).symm.to_ring_hom
+        (@subfield.top_equiv ℂ _).symm.to_ring_hom),
+      cases ring_hom_eq_id_or_conj_of_continuous (by continuity! : continuous ψ₁) with h h,
+      { left, ext1 z,
+        convert (ring_hom.congr_fun h z) using 1,
+        exact (dense_inducing.extend_eq di hc.continuous z).symm, },
+      { right, ext1 z,
+        convert (ring_hom.congr_fun h z) using 1,
+        exact (dense_inducing.extend_eq di hc.continuous z).symm, }}},
+  { let j : { x // x ∈ closure (id '' {x | (K : set ℂ) x })} → (K.topological_closure : set ℂ) :=
+      λ x, ⟨x, by { convert x.prop, simpa only [id.def, set.image_id'], }⟩,
+    convert dense_range.comp (function.surjective.dense_range _)
+      (dense_embedding.subtype (dense_embedding_id) (K : set ℂ)).dense
+      (by continuity : continuous j),
+    rintros ⟨y, hy⟩,
+    use ⟨y, by { convert hy, simpa only [id.def, set.image_id'], }⟩,
+    simp only [subtype.mk_eq_mk, subtype.coe_mk], }
+end
+
+end complex_subfield
diff --git a/src/topology/instances/discrete.lean b/src/topology/instances/discrete.lean
index d1aa4312ba8d6..fef680bfeb5f6 100644
--- a/src/topology/instances/discrete.lean
+++ b/src/topology/instances/discrete.lean
@@ -5,29 +5,34 @@ Authors: Rémy Degenne
 -/
 
 import order.succ_pred.basic
-import topology.algebra.order.basic
+import topology.order.basic
+import topology.metric_space.metrizable_uniformity
 
 /-!
 # Instances related to the discrete topology
 
-We prove that the discrete topology is a first-countable topology, and is second-countable for an
-encodable type. Also, in linear orders which are also `pred_order` and `succ_order`, the discrete
-topology is the order topology.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We prove that the discrete topology is
+* first-countable,
+* second-countable for an encodable type,
+* equal to the order topology in linear orders which are also `pred_order` and `succ_order`,
+* metrizable.
 
 When importing this file and `data.nat.succ_pred`, the instances `second_countable_topology ℕ`
 and `order_topology ℕ` become available.
 
 -/
 
-open order set topological_space
+open order set topological_space filter
 
 variables {α : Type*} [topological_space α]
 
 @[priority 100]
 instance discrete_topology.first_countable_topology [discrete_topology α] :
   first_countable_topology α :=
-{ nhds_generated_countable :=
-    by { rw nhds_discrete, exact filter.is_countably_generated_pure } }
+{ nhds_generated_countable := by { rw nhds_discrete, exact is_countably_generated_pure } }
 
 @[priority 100]
 instance discrete_topology.second_countable_topology_of_encodable
@@ -41,12 +46,10 @@ begin
     (Union_of_singleton α),
 end
 
-@[priority 100]
-instance discrete_topology.order_topology_of_pred_succ' [h : discrete_topology α] [partial_order α]
+lemma bot_topological_space_eq_generate_from_of_pred_succ_order {α} [partial_order α]
   [pred_order α] [succ_order α] [no_min_order α] [no_max_order α] :
-  order_topology α :=
-⟨begin
-  rw h.eq_bot,
+  (⊥ : topological_space α) = generate_from {s | ∃ a, s = Ioi a ∨ s = Iio a} :=
+begin
   refine (eq_bot_of_singletons_open (λ a, _)).symm,
   have h_singleton_eq_inter : {a} = Iio (succ a) ∩ Ioi (pred a),
   { suffices h_singleton_eq_inter' : {a} = Iic a ∩ Ici a,
@@ -56,14 +59,29 @@ instance discrete_topology.order_topology_of_pred_succ' [h : discrete_topology 
   apply is_open.inter,
   { exact is_open_generate_from_of_mem ⟨succ a, or.inr rfl⟩, },
   { exact is_open_generate_from_of_mem ⟨pred a, or.inl rfl⟩, },
-end⟩
+end
+
+lemma discrete_topology_iff_order_topology_of_pred_succ' [partial_order α]
+  [pred_order α] [succ_order α] [no_min_order α] [no_max_order α] :
+  discrete_topology α ↔ order_topology α :=
+begin
+  refine ⟨λ h, ⟨_⟩, λ h, ⟨_⟩⟩,
+  { rw h.eq_bot,
+    exact bot_topological_space_eq_generate_from_of_pred_succ_order, },
+  { rw h.topology_eq_generate_intervals,
+    exact bot_topological_space_eq_generate_from_of_pred_succ_order.symm, },
+end
 
 @[priority 100]
-instance discrete_topology.order_topology_of_pred_succ [h : discrete_topology α] [linear_order α]
-  [pred_order α] [succ_order α] :
+instance discrete_topology.order_topology_of_pred_succ' [h : discrete_topology α] [partial_order α]
+  [pred_order α] [succ_order α] [no_min_order α] [no_max_order α] :
   order_topology α :=
-⟨begin
-  rw h.eq_bot,
+discrete_topology_iff_order_topology_of_pred_succ'.1 h
+
+lemma linear_order.bot_topological_space_eq_generate_from
+  {α} [linear_order α] [pred_order α] [succ_order α] :
+  (⊥ : topological_space α) = generate_from {s | ∃ a, s = Ioi a ∨ s = Iio a} :=
+begin
   refine (eq_bot_of_singletons_open (λ a, _)).symm,
   have h_singleton_eq_inter : {a} = Iic a ∩ Ici a,
     by rw [inter_comm, Ici_inter_Iic, Icc_self a],
@@ -88,5 +106,29 @@ instance discrete_topology.order_topology_of_pred_succ [h : discrete_topology α
       rw h_singleton_eq_inter,
       apply is_open.inter,
       { exact is_open_generate_from_of_mem ⟨succ a, or.inr rfl⟩ },
-      { exact is_open_generate_from_of_mem ⟨pred a, or.inl rfl⟩ } } }
-end⟩
+      { exact is_open_generate_from_of_mem ⟨pred a, or.inl rfl⟩ } } },
+end
+
+lemma discrete_topology_iff_order_topology_of_pred_succ
+  [linear_order α] [pred_order α] [succ_order α] :
+  discrete_topology α ↔ order_topology α :=
+begin
+  refine ⟨λ h, ⟨_⟩, λ h, ⟨_⟩⟩,
+  { rw h.eq_bot,
+    exact linear_order.bot_topological_space_eq_generate_from, },
+  { rw h.topology_eq_generate_intervals,
+    exact linear_order.bot_topological_space_eq_generate_from.symm, },
+end
+
+@[priority 100]
+instance discrete_topology.order_topology_of_pred_succ [h : discrete_topology α] [linear_order α]
+  [pred_order α] [succ_order α] :
+  order_topology α :=
+discrete_topology_iff_order_topology_of_pred_succ.mp h
+
+@[priority 100]
+instance discrete_topology.metrizable_space [discrete_topology α] : metrizable_space α :=
+begin
+  unfreezingI { obtain rfl := discrete_topology.eq_bot α },
+  exact @uniform_space.metrizable_space α ⊥ (is_countably_generated_principal _) _,
+end
diff --git a/src/topology/instances/ennreal.lean b/src/topology/instances/ennreal.lean
index 389186e1394b0..0fb4fb73cec59 100644
--- a/src/topology/instances/ennreal.lean
+++ b/src/topology/instances/ennreal.lean
@@ -4,16 +4,22 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl
 -/
 import topology.instances.nnreal
-import order.liminf_limsup
+import topology.algebra.order.monotone_continuity
+import topology.algebra.infinite_sum.real
+import topology.algebra.order.liminf_limsup
 import topology.metric_space.lipschitz
+
 /-!
 # Extended non-negative reals
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 noncomputable theory
 
 open classical set filter metric
-open_locale classical topological_space ennreal nnreal big_operators filter
+open_locale classical topology ennreal nnreal big_operators filter
 
 variables {α : Type*} {β : Type*} {γ : Type*}
 
@@ -37,21 +43,7 @@ instance : t2_space ℝ≥0∞ := by apply_instance -- short-circuit type class
 instance : normal_space ℝ≥0∞ := normal_of_compact_t2
 
 instance : second_countable_topology ℝ≥0∞ :=
-⟨⟨⋃q ≥ (0:ℚ), {{a : ℝ≥0∞ | a < real.to_nnreal q}, {a : ℝ≥0∞ | ↑(real.to_nnreal q) < a}},
-  (countable_encodable _).bUnion $ assume a ha, (countable_singleton _).insert _,
-  le_antisymm
-    (le_generate_from $ by simp [or_imp_distrib, is_open_lt', is_open_gt'] {contextual := tt})
-    (le_generate_from $ λ s h, begin
-      rcases h with ⟨a, hs | hs⟩;
-      [ rw show s = ⋃q∈{q:ℚ | 0 ≤ q ∧ a < real.to_nnreal q}, {b | ↑(real.to_nnreal q) < b},
-           from set.ext (assume b, by simp [hs, @ennreal.lt_iff_exists_rat_btwn a b, and_assoc]),
-        rw show s = ⋃q∈{q:ℚ | 0 ≤ q ∧ ↑(real.to_nnreal q) < a}, {b | b < ↑(real.to_nnreal q)},
-           from set.ext (assume b,
-             by simp [hs, @ennreal.lt_iff_exists_rat_btwn b a, and_comm, and_assoc])];
-      { apply is_open_Union, intro q,
-        apply is_open_Union, intro hq,
-        exact generate_open.basic _ (mem_bUnion hq.1 $ by simp) }
-    end)⟩⟩
+order_iso_unit_interval_birational.to_homeomorph.embedding.second_countable_topology
 
 lemma embedding_coe : embedding (coe : ℝ≥0 → ℝ≥0∞) :=
 ⟨⟨begin
@@ -141,7 +133,7 @@ nnreal.tendsto_coe.2 $ tendsto_to_nnreal ha
 /-- The set of finite `ℝ≥0∞` numbers is homeomorphic to `ℝ≥0`. -/
 def ne_top_homeomorph_nnreal : {a | a ≠ ∞} ≃ₜ ℝ≥0 :=
 { continuous_to_fun := continuous_on_iff_continuous_restrict.1 continuous_on_to_nnreal,
-  continuous_inv_fun := continuous_subtype_mk _ continuous_coe,
+  continuous_inv_fun := continuous_coe.subtype_mk _,
   .. ne_top_equiv_nnreal }
 
 /-- The set of finite `ℝ≥0∞` numbers is homeomorphic to `ℝ≥0`. -/
@@ -173,14 +165,17 @@ tendsto_nhds_top_iff_nat.2 h
 
 lemma tendsto_nat_nhds_top : tendsto (λ n : ℕ, ↑n) at_top (𝓝 ∞) :=
 tendsto_nhds_top $ λ n, mem_at_top_sets.2
-  ⟨n+1, λ m hm, ennreal.coe_nat_lt_coe_nat.2 $ nat.lt_of_succ_le hm⟩
+  ⟨n + 1, λ m hm, mem_set_of.2 $ nat.cast_lt.2 $ nat.lt_of_succ_le hm⟩
 
 @[simp, norm_cast] lemma tendsto_coe_nhds_top {f : α → ℝ≥0} {l : filter α} :
   tendsto (λ x, (f x : ℝ≥0∞)) l (𝓝 ∞) ↔ tendsto f l at_top :=
 by rw [tendsto_nhds_top_iff_nnreal, at_top_basis_Ioi.tendsto_right_iff];
   [simp, apply_instance, apply_instance]
 
-lemma nhds_zero : 𝓝 (0 : ℝ≥0∞) = ⨅a ≠ 0, 𝓟 (Iio a) :=
+lemma tendsto_of_real_at_top : tendsto ennreal.of_real at_top (𝓝 ∞) :=
+tendsto_coe_nhds_top.2 tendsto_real_to_nnreal_at_top
+
+lemma nhds_zero : 𝓝 (0 : ℝ≥0∞) = ⨅ a ≠ 0, 𝓟 (Iio a) :=
 nhds_bot_order.trans $ by simp [bot_lt_iff_ne_bot, Iio]
 
 lemma nhds_zero_basis : (𝓝 (0 : ℝ≥0∞)).has_basis (λ a : ℝ≥0∞, 0 < a) (λ a, Iio a) := nhds_bot_basis
@@ -310,12 +305,10 @@ have ht : ∀b:ℝ≥0∞, b ≠ 0 → tendsto (λp:ℝ≥0∞×ℝ≥0∞, p.1
 begin
   refine assume b hb, tendsto_nhds_top_iff_nnreal.2 $ assume n, _,
   rcases lt_iff_exists_nnreal_btwn.1 (pos_iff_ne_zero.2 hb) with ⟨ε, hε, hεb⟩,
-  replace hε : 0 < ε, from coe_pos.1 hε,
-  filter_upwards [prod_is_open.mem_nhds (lt_mem_nhds $ @coe_lt_top (n / ε)) (lt_mem_nhds hεb)],
-  rintros ⟨a₁, a₂⟩ ⟨h₁, h₂⟩,
-  dsimp at h₁ h₂ ⊢,
-  rw [← div_mul_cancel n hε.ne', coe_mul],
-  exact mul_lt_mul h₁ h₂
+  have : ∀ᶠ c : ℝ≥0∞ × ℝ≥0∞ in 𝓝 (∞, b), ↑n / ↑ε < c.1 ∧ ↑ε < c.2,
+    from (lt_mem_nhds $ div_lt_top coe_ne_top hε.ne').prod_nhds (lt_mem_nhds hεb),
+  refine this.mono (λ c hc, _),
+  exact (ennreal.div_mul_cancel hε.ne' coe_ne_top).symm.trans_lt (mul_lt_mul hc.1 hc.2)
 end,
 begin
   cases a, {simp [none_eq_top] at hb, simp [none_eq_top, ht b hb, top_mul, hb] },
@@ -333,6 +326,18 @@ protected lemma tendsto.mul {f : filter α} {ma : α → ℝ≥0∞} {mb : α 
 show tendsto ((λp:ℝ≥0∞×ℝ≥0∞, p.1 * p.2) ∘ (λa, (ma a, mb a))) f (𝓝 (a * b)), from
 tendsto.comp (ennreal.tendsto_mul ha hb) (hma.prod_mk_nhds hmb)
 
+lemma _root_.continuous_on.ennreal_mul [topological_space α] {f g : α → ℝ≥0∞} {s : set α}
+  (hf : continuous_on f s) (hg : continuous_on g s) (h₁ : ∀ x ∈ s, f x ≠ 0 ∨ g x ≠ ∞)
+  (h₂ : ∀ x ∈ s, g x ≠ 0 ∨ f x ≠ ∞) :
+  continuous_on (λ x, f x * g x) s :=
+λ x hx, ennreal.tendsto.mul (hf x hx) (h₁ x hx) (hg x hx) (h₂ x hx)
+
+lemma _root_.continuous.ennreal_mul [topological_space α] {f g : α → ℝ≥0∞} (hf : continuous f)
+  (hg : continuous g) (h₁ : ∀ x, f x ≠ 0 ∨ g x ≠ ∞) (h₂ : ∀ x, g x ≠ 0 ∨ f x ≠ ∞) :
+  continuous (λ x, f x * g x) :=
+continuous_iff_continuous_at.2 $
+  λ x, ennreal.tendsto.mul hf.continuous_at (h₁ x) hg.continuous_at (h₂ x)
+
 protected lemma tendsto.const_mul {f : filter α} {m : α → ℝ≥0∞} {a b : ℝ≥0∞}
   (hm : tendsto m f (𝓝 b)) (hb : b ≠ 0 ∨ a ≠ ⊤) : tendsto (λb, a * m b) f (𝓝 (a * b)) :=
 by_cases
@@ -448,7 +453,7 @@ begin
   have : tendsto (* x) (𝓝[<] 1) (𝓝 (1 * x)) :=
     (ennreal.continuous_at_mul_const (or.inr one_ne_zero)).mono_left inf_le_left,
   rw one_mul at this,
-  haveI : (𝓝[<] (1 : ℝ≥0∞)).ne_bot := nhds_within_Iio_self_ne_bot' ⟨0, ennreal.zero_lt_one⟩,
+  haveI : (𝓝[<] (1 : ℝ≥0∞)).ne_bot := nhds_within_Iio_self_ne_bot' ⟨0, zero_lt_one⟩,
   exact le_of_tendsto this (eventually_nhds_within_iff.2 $ eventually_of_forall h)
 end
 
@@ -464,8 +469,8 @@ begin
     casesI is_empty_or_nonempty ι,
     { rw [infi_of_empty, infi_of_empty, mul_top, if_neg],
       exact mt h0 (not_nonempty_iff.2 ‹_›) },
-    { exact (map_infi_of_continuous_at_of_monotone' (ennreal.continuous_at_const_mul H)
-        ennreal.mul_left_mono).symm } }
+    { exact (ennreal.mul_left_mono.map_infi_of_continuous_at'
+            (ennreal.continuous_at_const_mul H)).symm } }
 end
 
 lemma infi_mul_left {ι} [nonempty ι] {f : ι → ℝ≥0∞} {a : ℝ≥0∞}
@@ -492,20 +497,14 @@ lemma inv_map_supr {ι : Sort*} {x : ι → ℝ≥0∞} :
 order_iso.inv_ennreal.map_supr x
 
 lemma inv_limsup {ι : Sort*} {x : ι → ℝ≥0∞} {l : filter ι} :
-  (l.limsup x)⁻¹ = l.liminf (λ i, (x i)⁻¹) :=
+  (limsup x l)⁻¹ = liminf (λ i, (x i)⁻¹) l :=
 by simp only [limsup_eq_infi_supr, inv_map_infi, inv_map_supr, liminf_eq_supr_infi]
 
 lemma inv_liminf {ι : Sort*} {x : ι → ℝ≥0∞} {l : filter ι} :
-  (l.liminf x)⁻¹ = l.limsup (λ i, (x i)⁻¹) :=
+  (liminf x l)⁻¹ = limsup (λ i, (x i)⁻¹) l :=
 by simp only [limsup_eq_infi_supr, inv_map_infi, inv_map_supr, liminf_eq_supr_infi]
 
-instance : has_continuous_inv ℝ≥0∞ :=
-{ continuous_inv :=
-  continuous_iff_continuous_at.2 $ λ a, tendsto_order.2
-  ⟨λ b hb, by simpa only [ennreal.lt_inv_iff_lt_inv]
-     using gt_mem_nhds (ennreal.lt_inv_iff_lt_inv.1 hb),
-   λ b hb, by simpa only [gt_iff_lt, ennreal.inv_lt_iff_inv_lt]
-     using lt_mem_nhds (ennreal.inv_lt_iff_inv_lt.1 hb)⟩ }
+instance : has_continuous_inv ℝ≥0∞ := ⟨order_iso.inv_ennreal.continuous⟩
 
 @[simp] protected lemma tendsto_inv_iff {f : filter α} {m : α → ℝ≥0∞} {a : ℝ≥0∞} :
   tendsto (λ x, (m x)⁻¹) f (𝓝 a⁻¹) ↔ tendsto m f (𝓝 a) :=
@@ -527,39 +526,56 @@ by { apply tendsto.mul_const hm, simp [ha] }
 protected lemma tendsto_inv_nat_nhds_zero : tendsto (λ n : ℕ, (n : ℝ≥0∞)⁻¹) at_top (𝓝 0) :=
 ennreal.inv_top ▸ ennreal.tendsto_inv_iff.2 tendsto_nat_nhds_top
 
+lemma supr_add {ι : Sort*} {s : ι → ℝ≥0∞} [h : nonempty ι] : supr s + a = ⨆b, s b + a :=
+monotone.map_supr_of_continuous_at' (continuous_at_id.add continuous_at_const) $
+  monotone_id.add monotone_const
+
+lemma bsupr_add' {ι : Sort*} {p : ι → Prop} (h : ∃ i, p i) {f : ι → ℝ≥0∞} :
+  (⨆ i (hi : p i), f i) + a = ⨆ i (hi : p i), f i + a :=
+by { haveI : nonempty {i // p i} := nonempty_subtype.2 h, simp only [supr_subtype', supr_add] }
+
+lemma add_bsupr' {ι : Sort*} {p : ι → Prop} (h : ∃ i, p i) {f : ι → ℝ≥0∞} :
+  a + (⨆ i (hi : p i), f i) = ⨆ i (hi : p i), a + f i :=
+by simp only [add_comm a, bsupr_add' h]
+
 lemma bsupr_add {ι} {s : set ι} (hs : s.nonempty) {f : ι → ℝ≥0∞} :
   (⨆ i ∈ s, f i) + a = ⨆ i ∈ s, f i + a :=
-begin
-  simp only [← Sup_image], symmetry,
-  rw [image_comp (+ a)],
-  refine is_lub.Sup_eq ((is_lub_Sup $ f '' s).is_lub_of_tendsto _ (hs.image _) _),
-  exacts [λ x _ y _ hxy, add_le_add hxy le_rfl,
-    tendsto.add (tendsto_id' inf_le_left) tendsto_const_nhds]
-end
+bsupr_add' hs
+
+lemma add_bsupr {ι} {s : set ι} (hs : s.nonempty) {f : ι → ℝ≥0∞} :
+  a + (⨆ i ∈ s, f i) = ⨆ i ∈ s, a + f i :=
+add_bsupr' hs
 
 lemma Sup_add {s : set ℝ≥0∞} (hs : s.nonempty) : Sup s + a = ⨆b∈s, b + a :=
 by rw [Sup_eq_supr, bsupr_add hs]
 
-lemma supr_add {ι : Sort*} {s : ι → ℝ≥0∞} [h : nonempty ι] : supr s + a = ⨆b, s b + a :=
-let ⟨x⟩ := h in
-calc supr s + a = Sup (range s) + a : by rw Sup_range
-  ... = (⨆b∈range s, b + a) : Sup_add ⟨s x, x, rfl⟩
-  ... = _ : supr_range
-
-lemma add_supr {ι : Sort*} {s : ι → ℝ≥0∞} [h : nonempty ι] : a + supr s = ⨆b, a + s b :=
+lemma add_supr {ι : Sort*} {s : ι → ℝ≥0∞} [nonempty ι] : a + supr s = ⨆b, a + s b :=
 by rw [add_comm, supr_add]; simp [add_comm]
 
+lemma supr_add_supr_le {ι ι' : Sort*} [nonempty ι] [nonempty ι']
+  {f : ι → ℝ≥0∞} {g : ι' → ℝ≥0∞} {a : ℝ≥0∞} (h : ∀ i j, f i + g j ≤ a) :
+  supr f + supr g ≤ a :=
+by simpa only [add_supr, supr_add] using supr₂_le h
+
+lemma bsupr_add_bsupr_le' {ι ι'} {p : ι → Prop} {q : ι' → Prop} (hp : ∃ i, p i) (hq : ∃ j, q j)
+  {f : ι → ℝ≥0∞} {g : ι' → ℝ≥0∞} {a : ℝ≥0∞} (h : ∀ i (hi : p i) j (hj : q j), f i + g j ≤ a) :
+  (⨆ i (hi : p i), f i) + (⨆ j (hj : q j), g j) ≤ a :=
+by { simp_rw [bsupr_add' hp, add_bsupr' hq], exact supr₂_le (λ i hi, supr₂_le (h i hi)) }
+
+lemma bsupr_add_bsupr_le {ι ι'} {s : set ι} {t : set ι'} (hs : s.nonempty) (ht : t.nonempty)
+  {f : ι → ℝ≥0∞} {g : ι' → ℝ≥0∞} {a : ℝ≥0∞} (h : ∀ (i ∈ s) (j ∈ t), f i + g j ≤ a) :
+  (⨆ i ∈ s, f i) + (⨆ j ∈ t, g j) ≤ a :=
+bsupr_add_bsupr_le' hs ht h
+
 lemma supr_add_supr {ι : Sort*} {f g : ι → ℝ≥0∞} (h : ∀i j, ∃k, f i + g j ≤ f k + g k) :
   supr f + supr g = (⨆ a, f a + g a) :=
 begin
-  by_cases hι : nonempty ι,
-  { letI := hι,
-    refine le_antisymm _ (supr_le $ λ a, add_le_add (le_supr _ _) (le_supr _ _)),
-    simpa [add_supr, supr_add] using
-      λ i j:ι, show f i + g j ≤ ⨆ a, f a + g a, from
-      let ⟨k, hk⟩ := h i j in le_supr_of_le k hk },
-  { have : ∀f:ι → ℝ≥0∞, (⨆i, f i) = 0 := λ f, supr_eq_zero.mpr (λ i, (hι ⟨i⟩).elim),
-    rw [this, this, this, zero_add] }
+  casesI is_empty_or_nonempty ι,
+  { simp only [supr_of_empty, bot_eq_zero, zero_add] },
+  { refine le_antisymm _ (supr_le $ λ a, add_le_add (le_supr _ _) (le_supr _ _)),
+    refine supr_add_supr_le (λ i j, _),
+    rcases h i j with ⟨k, hk⟩,
+    exact le_supr_of_le k hk }
 end
 
 lemma supr_add_supr_of_monotone {ι : Sort*} [semilattice_sup ι]
@@ -580,31 +596,32 @@ begin
     exact (finset.sum_le_sum $ assume a ha, hf a h) }
 end
 
-lemma mul_Sup {s : set ℝ≥0∞} {a : ℝ≥0∞} : a * Sup s = ⨆i∈s, a * i :=
+lemma mul_supr {ι : Sort*} {f : ι → ℝ≥0∞} {a : ℝ≥0∞} : a * supr f = ⨆i, a * f i :=
 begin
-  by_cases hs : ∀x∈s, x = (0:ℝ≥0∞),
-  { have h₁ : Sup s = 0 := (bot_unique $ Sup_le $ assume a ha, (hs a ha).symm ▸ le_refl 0),
-    have h₂ : (⨆i ∈ s, a * i) = 0 :=
-      (bot_unique $ supr_le $ assume a, supr_le $ assume ha, by simp [hs a ha]),
-    rw [h₁, h₂, mul_zero] },
-  { simp only [not_forall] at hs,
-    rcases hs with ⟨x, hx, hx0⟩,
-    have s₁ : Sup s ≠ 0 :=
-      pos_iff_ne_zero.1 (lt_of_lt_of_le (pos_iff_ne_zero.2 hx0) (le_Sup hx)),
-    have : Sup ((λb, a * b) '' s) = a * Sup s :=
-      is_lub.Sup_eq ((is_lub_Sup s).is_lub_of_tendsto
-        (assume x _ y _ h, mul_le_mul_left' h _)
-        ⟨x, hx⟩
-        (ennreal.tendsto.const_mul (tendsto_id' inf_le_left) (or.inl s₁))),
-    rw [this.symm, Sup_image] }
+  by_cases hf : ∀ i, f i = 0,
+  { obtain rfl : f = (λ _, 0), from funext hf,
+    simp only [supr_zero_eq_zero, mul_zero] },
+  { refine (monotone_id.const_mul' _).map_supr_of_continuous_at _ (mul_zero a),
+    refine ennreal.tendsto.const_mul tendsto_id (or.inl _),
+    exact mt supr_eq_zero.1 hf }
 end
 
-lemma mul_supr {ι : Sort*} {f : ι → ℝ≥0∞} {a : ℝ≥0∞} : a * supr f = ⨆i, a * f i :=
-by rw [← Sup_range, mul_Sup, supr_range]
+lemma mul_Sup {s : set ℝ≥0∞} {a : ℝ≥0∞} : a * Sup s = ⨆i∈s, a * i :=
+by simp only [Sup_eq_supr, mul_supr]
 
 lemma supr_mul {ι : Sort*} {f : ι → ℝ≥0∞} {a : ℝ≥0∞} : supr f * a = ⨆i, f i * a :=
 by rw [mul_comm, mul_supr]; congr; funext; rw [mul_comm]
 
+lemma smul_supr {ι : Sort*} {R} [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+  (f : ι → ℝ≥0∞) (c : R) :
+  c • (⨆ i, f i) = ⨆ i, c • f i :=
+by simp only [←smul_one_mul c (f _), ←smul_one_mul c (supr _), ennreal.mul_supr]
+
+lemma smul_Sup {R} [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞]
+  (s : set ℝ≥0∞) (c : R) :
+  c • Sup s = ⨆ i ∈ s, c • i :=
+by simp_rw [←smul_one_mul c (Sup _), ennreal.mul_Sup, smul_one_mul]
+
 lemma supr_div {ι : Sort*} {f : ι → ℝ≥0∞} {a : ℝ≥0∞} : supr f / a = ⨆i, f i / a :=
 supr_mul
 
@@ -625,19 +642,88 @@ have Inf ((λb, ↑r - b) '' range b) = ↑r - (⨆i, b i),
   from is_glb.Inf_eq $ is_lub_supr.is_glb_of_tendsto
     (assume x _ y _, tsub_le_tsub (le_refl (r : ℝ≥0∞)))
     (range_nonempty _)
-    (ennreal.tendsto_coe_sub.comp (tendsto_id' inf_le_left)),
+    (ennreal.tendsto_coe_sub.comp (tendsto_id'.2 inf_le_left)),
 by rw [eq, ←this]; simp [Inf_image, infi_range, -mem_range]; exact le_rfl
 
 lemma exists_countable_dense_no_zero_top :
-  ∃ (s : set ℝ≥0∞), countable s ∧ dense s ∧ 0 ∉ s ∧ ∞ ∉ s :=
+  ∃ (s : set ℝ≥0∞), s.countable ∧ dense s ∧ 0 ∉ s ∧ ∞ ∉ s :=
 begin
-  obtain ⟨s, s_count, s_dense, hs⟩ : ∃ s : set ℝ≥0∞, countable s ∧ dense s ∧
+  obtain ⟨s, s_count, s_dense, hs⟩ : ∃ s : set ℝ≥0∞, s.countable ∧ dense s ∧
     (∀ x, is_bot x → x ∉ s) ∧ (∀ x, is_top x → x ∉ s) := exists_countable_dense_no_bot_top ℝ≥0∞,
   exact ⟨s, s_count, s_dense, λ h, hs.1 0 (by simp) h, λ h, hs.2 ∞ (by simp) h⟩,
 end
 
+lemma exists_lt_add_of_lt_add {x y z : ℝ≥0∞} (h : x < y + z) (hy : y ≠ 0) (hz : z ≠ 0) :
+  ∃ y' z', y' < y ∧ z' < z ∧ x < y' + z' :=
+begin
+  haveI : ne_bot (𝓝[<] y) := nhds_within_Iio_self_ne_bot' ⟨0, pos_iff_ne_zero.2 hy⟩,
+  haveI : ne_bot (𝓝[<] z) := nhds_within_Iio_self_ne_bot' ⟨0, pos_iff_ne_zero.2 hz⟩,
+  have A : tendsto (λ (p : ℝ≥0∞ × ℝ≥0∞), p.1 + p.2) ((𝓝[<] y).prod (𝓝[<] z)) (𝓝 (y + z)),
+  { apply tendsto.mono_left _ (filter.prod_mono nhds_within_le_nhds nhds_within_le_nhds),
+    rw ← nhds_prod_eq,
+    exact tendsto_add },
+  rcases (((tendsto_order.1 A).1 x h).and
+    (filter.prod_mem_prod self_mem_nhds_within self_mem_nhds_within)).exists
+    with ⟨⟨y', z'⟩, hx, hy', hz'⟩,
+  exact ⟨y', z', hy', hz', hx⟩,
+end
+
 end topological_space
 
+section liminf
+
+lemma exists_frequently_lt_of_liminf_ne_top
+  {ι : Type*} {l : filter ι} {x : ι → ℝ} (hx : liminf (λ n, ((x n).nnabs : ℝ≥0∞)) l ≠ ∞) :
+  ∃ R, ∃ᶠ n in l, x n < R :=
+begin
+  by_contra h,
+  simp_rw [not_exists, not_frequently, not_lt] at h,
+  refine hx (ennreal.eq_top_of_forall_nnreal_le $ λ r, le_Liminf_of_le (by is_bounded_default) _),
+  simp only [eventually_map, ennreal.coe_le_coe],
+  filter_upwards [h r] with i hi using hi.trans (le_abs_self (x i))
+end
+
+lemma exists_frequently_lt_of_liminf_ne_top'
+  {ι : Type*} {l : filter ι} {x : ι → ℝ} (hx : liminf (λ n, ((x n).nnabs : ℝ≥0∞)) l ≠ ∞) :
+  ∃ R, ∃ᶠ n in l, R < x n :=
+begin
+  by_contra h,
+  simp_rw [not_exists, not_frequently, not_lt] at h,
+  refine hx (ennreal.eq_top_of_forall_nnreal_le $ λ r, le_Liminf_of_le (by is_bounded_default) _),
+  simp only [eventually_map, ennreal.coe_le_coe],
+  filter_upwards [h (-r)] with i hi using (le_neg.1 hi).trans (neg_le_abs_self _),
+end
+
+lemma exists_upcrossings_of_not_bounded_under
+  {ι : Type*} {l : filter ι} {x : ι → ℝ}
+  (hf : liminf (λ i, ((x i).nnabs : ℝ≥0∞)) l ≠ ∞)
+  (hbdd : ¬ is_bounded_under (≤) l (λ i, |x i|)) :
+  ∃ a b : ℚ, a < b ∧ (∃ᶠ i in l, x i < a) ∧ (∃ᶠ i in l, ↑b < x i) :=
+begin
+  rw [is_bounded_under_le_abs, not_and_distrib] at hbdd,
+  obtain hbdd | hbdd := hbdd,
+  { obtain ⟨R, hR⟩ := exists_frequently_lt_of_liminf_ne_top hf,
+    obtain ⟨q, hq⟩ := exists_rat_gt R,
+    refine ⟨q, q + 1, (lt_add_iff_pos_right _).2 zero_lt_one, _, _⟩,
+    { refine λ hcon, hR _,
+      filter_upwards [hcon] with x hx using not_lt.2 (lt_of_lt_of_le hq (not_lt.1 hx)).le },
+    { simp only [is_bounded_under, is_bounded, eventually_map, eventually_at_top,
+        ge_iff_le, not_exists, not_forall, not_le, exists_prop] at hbdd,
+      refine λ hcon, hbdd ↑(q + 1) _,
+      filter_upwards [hcon] with x hx using not_lt.1 hx } },
+  { obtain ⟨R, hR⟩ := exists_frequently_lt_of_liminf_ne_top' hf,
+    obtain ⟨q, hq⟩ := exists_rat_lt R,
+    refine ⟨q - 1, q, (sub_lt_self_iff _).2 zero_lt_one, _, _⟩,
+    { simp only [is_bounded_under, is_bounded, eventually_map, eventually_at_top,
+        ge_iff_le, not_exists, not_forall, not_le, exists_prop] at hbdd,
+      refine λ hcon, hbdd ↑(q - 1) _,
+      filter_upwards [hcon] with x hx using not_lt.1 hx },
+    { refine λ hcon, hR _,
+      filter_upwards [hcon] with x hx using not_lt.2 ((not_lt.1 hx).trans hq.le) } }
+end
+
+end liminf
+
 section tsum
 
 variables {f g : α → ℝ≥0∞}
@@ -689,7 +775,10 @@ protected lemma tsum_sigma' {β : α → Type*} (f : (Σ a, β a) → ℝ≥0∞
   ∑'p:(Σa, β a), f p = ∑'a b, f ⟨a, b⟩ :=
 tsum_sigma' (assume b, ennreal.summable) ennreal.summable
 
-protected lemma tsum_prod {f : α → β → ℝ≥0∞} : ∑'p:α×β, f p.1 p.2 = ∑'a, ∑'b, f a b :=
+protected lemma tsum_prod {f : α → β → ℝ≥0∞} : ∑' p : α × β, f p.1 p.2 = ∑' a b, f a b :=
+tsum_prod' ennreal.summable $ λ _, ennreal.summable
+
+protected lemma tsum_prod' {f : α × β → ℝ≥0∞} : ∑' p : α × β, f p = ∑' a b, f (a, b) :=
 tsum_prod' ennreal.summable $ λ _, ennreal.summable
 
 protected lemma tsum_comm {f : α → β → ℝ≥0∞} : ∑'a, ∑'b, f a b = ∑'b, ∑'a, f a b :=
@@ -716,7 +805,7 @@ protected lemma tsum_eq_supr_nat {f : ℕ → ℝ≥0∞} :
 ennreal.tsum_eq_supr_sum' _ finset.exists_nat_subset_range
 
 protected lemma tsum_eq_liminf_sum_nat {f : ℕ → ℝ≥0∞} :
-  ∑' i, f i = filter.at_top.liminf (λ n, ∑ i in finset.range n, f i) :=
+  ∑' i, f i = liminf (λ n, ∑ i in finset.range n, f i) at_top :=
 begin
   rw [ennreal.tsum_eq_supr_nat, filter.liminf_eq_supr_infi_of_nat],
   congr,
@@ -736,6 +825,14 @@ le_tsum' ennreal.summable a
 protected lemma tsum_eq_top_of_eq_top : (∃ a, f a = ∞) → ∑' a, f a = ∞
 | ⟨a, ha⟩ := top_unique $ ha ▸ ennreal.le_tsum a
 
+protected lemma lt_top_of_tsum_ne_top {a : α → ℝ≥0∞} (tsum_ne_top : ∑' i, a i ≠ ∞) (j : α) :
+  a j < ∞ :=
+begin
+  have key := not_imp_not.mpr ennreal.tsum_eq_top_of_eq_top,
+  simp only [not_exists] at key,
+  exact lt_top_iff_ne_top.mpr (key tsum_ne_top j),
+end
+
 @[simp] protected lemma tsum_top [nonempty α] : ∑' a : α, ∞ = ∞ :=
 let ⟨a⟩ := ‹nonempty α› in ennreal.tsum_eq_top_of_eq_top ⟨a, rfl⟩
 
@@ -770,6 +867,10 @@ has_sum.tsum_eq this
 protected lemma tsum_mul_right : (∑'i, f i * a) = (∑'i, f i) * a :=
 by simp [mul_comm, ennreal.tsum_mul_left]
 
+protected lemma tsum_const_smul {R} [has_smul R ℝ≥0∞] [is_scalar_tower R ℝ≥0∞ ℝ≥0∞] (a : R) :
+  ∑' i, a • f i = a • ∑' i, f i :=
+by simpa only [smul_one_mul] using @ennreal.tsum_mul_left _ (a • 1) _
+
 @[simp] lemma tsum_supr_eq {α : Type*} (a : α) {f : α → ℝ≥0∞} :
   ∑'b:α, (⨆ (h : a = b), f b) = f a :=
 le_antisymm
@@ -857,7 +958,7 @@ lemma tsum_union_le (f : α → ℝ≥0∞) (s t : set α) :
 calc ∑' (x : s ∪ t), f x = ∑' (x : s ∪ (t \ s)), f x :
   by { apply tsum_congr_subtype, rw union_diff_self }
 ... = ∑' (x : s), f x + ∑' (x : t \ s), f x :
-  tsum_union_disjoint disjoint_diff ennreal.summable ennreal.summable
+  tsum_union_disjoint disjoint_sdiff_self_right ennreal.summable ennreal.summable
 ... ≤ ∑' (x : s), f x + ∑' (x : t), f x :
   add_le_add le_rfl (tsum_mono_subtype _ (diff_subset _ _))
 
@@ -883,6 +984,77 @@ begin
   exact tsum_bUnion_le _ _ _
 end
 
+lemma tsum_eq_add_tsum_ite {f : β → ℝ≥0∞} (b : β) : ∑' x, f x = f b + ∑' x, ite (x = b) 0 (f x) :=
+tsum_eq_add_tsum_ite' b ennreal.summable
+
+lemma tsum_add_one_eq_top {f : ℕ → ℝ≥0∞} (hf : ∑' n, f n = ∞) (hf0 : f 0 ≠ ∞) :
+  ∑' n, f (n + 1) = ∞ :=
+begin
+  rw ← tsum_eq_tsum_of_has_sum_iff_has_sum (λ _, (not_mem_range_equiv 1).has_sum_iff),
+  swap, { apply_instance },
+  have h₁ : (∑' b : {n // n ∈ finset.range 1}, f b) + (∑' b : {n // n ∉ finset.range 1}, f b) =
+    ∑' b, f b,
+  { exact tsum_add_tsum_compl ennreal.summable ennreal.summable },
+  rw [finset.tsum_subtype, finset.sum_range_one, hf, ennreal.add_eq_top] at h₁,
+  rw ← h₁.resolve_left hf0,
+  apply tsum_congr,
+  rintro ⟨i, hi⟩,
+  simp only [multiset.mem_range, not_lt] at hi,
+  simp only [tsub_add_cancel_of_le hi, coe_not_mem_range_equiv, function.comp_app, subtype.coe_mk],
+end
+
+/-- A sum of extended nonnegative reals which is finite can have only finitely many terms
+above any positive threshold.-/
+lemma finite_const_le_of_tsum_ne_top {ι : Type*} {a : ι → ℝ≥0∞}
+  (tsum_ne_top : ∑' i, a i ≠ ∞) {ε : ℝ≥0∞} (ε_ne_zero : ε ≠ 0) :
+  {i : ι | ε ≤ a i}.finite :=
+begin
+  by_cases ε_infty : ε = ∞,
+  { rw ε_infty,
+    by_contra maybe_infinite,
+    obtain ⟨j, hj⟩ := set.infinite.nonempty maybe_infinite,
+    exact tsum_ne_top (le_antisymm le_top (le_trans hj (le_tsum' (@ennreal.summable _ a) j))), },
+  have key := (nnreal.summable_coe.mpr
+               (summable_to_nnreal_of_tsum_ne_top tsum_ne_top)).tendsto_cofinite_zero
+               (Iio_mem_nhds (to_real_pos ε_ne_zero ε_infty)),
+  simp only [filter.mem_map, filter.mem_cofinite, preimage] at key,
+  have obs : {i : ι | ↑((a i).to_nnreal) ∈ Iio ε.to_real}ᶜ = {i : ι | ε ≤ a i},
+  { ext i,
+    simpa only [mem_Iio, mem_compl_iff, mem_set_of_eq, not_lt]
+      using to_real_le_to_real ε_infty (ennreal.ne_top_of_tsum_ne_top tsum_ne_top _), },
+  rwa obs at key,
+end
+
+/-- Markov's inequality for `finset.card` and `tsum` in `ℝ≥0∞`. -/
+lemma finset_card_const_le_le_of_tsum_le {ι : Type*} {a : ι → ℝ≥0∞}
+  {c : ℝ≥0∞} (c_ne_top : c ≠ ∞) (tsum_le_c : ∑' i, a i ≤ c)
+  {ε : ℝ≥0∞} (ε_ne_zero : ε ≠ 0) :
+  ∃ hf : {i : ι | ε ≤ a i}.finite, ↑hf.to_finset.card ≤ c / ε :=
+begin
+  by_cases ε = ∞,
+  { have obs : {i : ι | ε ≤ a i} = ∅,
+    { rw eq_empty_iff_forall_not_mem,
+      intros i hi,
+      have oops := (le_trans hi (le_tsum' (@ennreal.summable _ a) i)).trans tsum_le_c,
+      rw h at oops,
+      exact c_ne_top (le_antisymm le_top oops), },
+    simp only [obs, finite_empty, finite.to_finset_empty, finset.card_empty,
+               algebra_map.coe_zero, zero_le', exists_true_left], },
+  have hf : {i : ι | ε ≤ a i}.finite,
+    from ennreal.finite_const_le_of_tsum_ne_top
+          (lt_of_le_of_lt tsum_le_c c_ne_top.lt_top).ne ε_ne_zero,
+  use hf,
+  have at_least : ∀ i ∈ hf.to_finset, ε ≤ a i,
+  { intros i hi,
+    simpa only [finite.mem_to_finset, mem_set_of_eq] using hi, },
+  have partial_sum := @sum_le_tsum _ _ _ _ _ a
+                        hf.to_finset (λ _ _, zero_le') (@ennreal.summable _ a),
+  have lower_bound := finset.sum_le_sum at_least,
+  simp only [finset.sum_const, nsmul_eq_mul] at lower_bound,
+  have key := (ennreal.le_div_iff_mul_le (or.inl ε_ne_zero) (or.inl h)).mpr lower_bound,
+  exact le_trans key (ennreal.div_le_div_right (partial_sum.trans tsum_le_c) _),
+end
+
 end tsum
 
 lemma tendsto_to_real_iff {ι} {fi : filter ι} {f : ι → ℝ≥0∞} (hf : ∀ i, f i ≠ ∞) {x : ℝ≥0∞}
@@ -988,7 +1160,7 @@ end
 
 lemma tsum_le_of_sum_range_le {f : ℕ → ℝ≥0} {c : ℝ≥0}
   (h : ∀ n, ∑ i in finset.range n, f i ≤ c) : ∑' n, f n ≤ c :=
-le_of_tendsto' (has_sum_iff_tendsto_nat.1 (summable_of_sum_range_le h).has_sum) h
+tsum_le_of_sum_range_le (summable_of_sum_range_le h) h
 
 lemma tsum_comp_le_tsum_of_inj {β : Type*} {f : α → ℝ≥0} (hf : summable f)
   {i : β → α} (hi : function.injective i) : ∑' x, f (i x) ≤ ∑' x, f x :=
@@ -1056,21 +1228,26 @@ lemma tsum_pos {g : α → ℝ≥0} (hg : summable g) (i : α) (hi : 0 < g i) :
   0 < ∑' b, g b :=
 by { rw ← tsum_zero, exact tsum_lt_tsum (λ a, zero_le _) hi hg }
 
+lemma tsum_eq_add_tsum_ite {f : α → ℝ≥0} (hf : summable f) (i : α) :
+  ∑' x, f x = f i + ∑' x, ite (x = i) 0 (f x) :=
+begin
+  refine tsum_eq_add_tsum_ite' i (nnreal.summable_of_le (λ i', _) hf),
+  rw [function.update_apply],
+  split_ifs; simp only [zero_le', le_rfl]
+end
+
 end nnreal
 
 namespace ennreal
 
-lemma tsum_to_real_eq
-  {f : α → ℝ≥0∞} (hf : ∀ a, f a ≠ ∞) :
+lemma tsum_to_nnreal_eq {f : α → ℝ≥0∞} (hf : ∀ a, f a ≠ ∞) :
+  (∑' a, f a).to_nnreal = ∑' a, (f a).to_nnreal :=
+(congr_arg ennreal.to_nnreal (tsum_congr $ λ x, (coe_to_nnreal (hf x)).symm)).trans
+  nnreal.tsum_eq_to_nnreal_tsum.symm
+
+lemma tsum_to_real_eq {f : α → ℝ≥0∞} (hf : ∀ a, f a ≠ ∞) :
   (∑' a, f a).to_real = ∑' a, (f a).to_real :=
-begin
-  lift f to α → ℝ≥0 using hf,
-  have : (∑' (a : α), (f a : ℝ≥0∞)).to_real =
-    ((∑' (a : α), (f a : ℝ≥0∞)).to_nnreal : ℝ≥0∞).to_real,
-  { rw [ennreal.coe_to_real], refl },
-  rw [this, ← nnreal.tsum_eq_to_nnreal_tsum, ennreal.coe_to_real],
-  exact nnreal.coe_tsum
-end
+by simp only [ennreal.to_real, tsum_to_nnreal_eq hf, nnreal.coe_tsum]
 
 lemma tendsto_sum_nat_add (f : ℕ → ℝ≥0∞) (hf : ∑' i, f i ≠ ∞) :
   tendsto (λ i, ∑' k, f (k + i)) at_top (𝓝 0) :=
@@ -1081,6 +1258,28 @@ begin
   exact_mod_cast nnreal.tendsto_sum_nat_add f
 end
 
+lemma tsum_le_of_sum_range_le {f : ℕ → ℝ≥0∞} {c : ℝ≥0∞}
+  (h : ∀ n, ∑ i in finset.range n, f i ≤ c) : ∑' n, f n ≤ c :=
+tsum_le_of_sum_range_le ennreal.summable h
+
+lemma has_sum_lt {f g : α → ℝ≥0∞} {sf sg : ℝ≥0∞} {i : α} (h : ∀ (a : α), f a ≤ g a)
+  (hi : f i < g i) (hsf : sf ≠ ⊤) (hf : has_sum f sf) (hg : has_sum g sg) : sf < sg :=
+begin
+  by_cases hsg : sg = ⊤,
+  { exact hsg.symm ▸ lt_of_le_of_ne le_top hsf },
+  { have hg' : ∀ x, g x ≠ ⊤:= ennreal.ne_top_of_tsum_ne_top (hg.tsum_eq.symm ▸ hsg),
+    lift f to α → ℝ≥0 using λ x, ne_of_lt (lt_of_le_of_lt (h x) $ lt_of_le_of_ne le_top (hg' x)),
+    lift g to α → ℝ≥0 using hg',
+    lift sf to ℝ≥0 using hsf,
+    lift sg to ℝ≥0 using hsg,
+    simp only [coe_le_coe, coe_lt_coe] at h hi ⊢,
+    exact nnreal.has_sum_lt h hi (ennreal.has_sum_coe.1 hf) (ennreal.has_sum_coe.1 hg) }
+end
+
+lemma tsum_lt_tsum {f g : α → ℝ≥0∞} {i : α} (hfi : tsum f ≠ ⊤) (h : ∀ (a : α), f a ≤ g a)
+  (hi : f i < g i) : ∑' x, f x < ∑' x, g x :=
+has_sum_lt h hi hfi ennreal.summable.has_sum ennreal.summable.has_sum
+
 end ennreal
 
 lemma tsum_comp_le_tsum_of_inj {β : Type*} {f : α → ℝ} (hf : summable f) (hn : ∀ a, 0 ≤ f a)
@@ -1101,6 +1300,14 @@ begin
   exact nnreal.summable_of_le (λ b, nnreal.coe_le_coe.1 (hgf b)) hf
 end
 
+lemma summable.to_nnreal {f : α → ℝ} (hf : summable f) :
+  summable (λ n, (f n).to_nnreal) :=
+begin
+  apply nnreal.summable_coe.1,
+  refine summable_of_nonneg_of_le (λ n, nnreal.coe_nonneg _) (λ n, _) hf.abs,
+  simp only [le_abs_self, real.coe_to_nnreal', max_le_iff, abs_nonneg, and_self]
+end
+
 /-- A series of non-negative real numbers converges to `r` in the sense of `has_sum` if and only if
 the sequence of partial sum converges to `r`. -/
 lemma has_sum_iff_tendsto_nat_of_nonneg {f : ℕ → ℝ} (hf : ∀i, 0 ≤ f i) (r : ℝ) :
@@ -1145,10 +1352,9 @@ begin
   exact lt_irrefl _ (hn.trans_le (h n)),
 end
 
-lemma tsum_le_of_sum_range_le {f : ℕ → ℝ} {c : ℝ} (hf : ∀ n, 0 ≤ f n)
+lemma real.tsum_le_of_sum_range_le {f : ℕ → ℝ} {c : ℝ} (hf : ∀ n, 0 ≤ f n)
   (h : ∀ n, ∑ i in finset.range n, f i ≤ c) : ∑' n, f n ≤ c :=
-le_of_tendsto' ((has_sum_iff_tendsto_nat_of_nonneg hf _).1
-  (summable_of_sum_range_le hf h).has_sum) h
+tsum_le_of_sum_range_le (summable_of_sum_range_le hf h) h
 
 /-- If a sequence `f` with non-negative terms is dominated by a sequence `g` with summable
 series and at least one term of `f` is strictly smaller than the corresponding term in `g`,
@@ -1236,7 +1442,7 @@ begin
 end⟩
 
 lemma continuous_of_le_add_edist {f : α → ℝ≥0∞} (C : ℝ≥0∞)
-  (hC : C ≠ ⊤) (h : ∀x y, f x ≤ f y + C * edist x y) : continuous f :=
+  (hC : C ≠ ⊤) (h : ∀ x y, f x ≤ f y + C * edist x y) : continuous f :=
 begin
   rcases eq_or_ne C 0 with (rfl|C0),
   { simp only [zero_mul, add_zero] at h,
@@ -1246,7 +1452,7 @@ begin
     { have : f =ᶠ[𝓝 x] (λ _, ∞),
       { filter_upwards [emetric.ball_mem_nhds x ennreal.coe_lt_top],
         refine λ y (hy : edist y x < ⊤), _, rw edist_comm at hy,
-        simpa [hx, hC, hy.ne] using h x y },
+        simpa [hx, ennreal.mul_ne_top hC hy.ne] using h x y },
       exact this.continuous_at },
     { refine (ennreal.tendsto_nhds hx).2 (λ ε (ε0 : 0 < ε), _),
       filter_upwards [emetric.closed_ball_mem_nhds x (ennreal.div_pos_iff.2 ⟨ε0.ne', hC⟩)],
@@ -1297,7 +1503,7 @@ is_closed_le (continuous_id.edist continuous_const) continuous_const
 begin
   refine le_antisymm (diam_le $ λ x hx y hy, _) (diam_mono subset_closure),
   have : edist x y ∈ closure (Iic (diam s)),
-    from  map_mem_closure2 (@continuous_edist α _) hx hy (λ _ _, edist_le_diam_of_mem),
+    from map_mem_closure₂ continuous_edist hx hy (λ x hx y hy, edist_le_diam_of_mem hx hy),
   rwa closure_Iic at this
 end
 
@@ -1372,6 +1578,18 @@ le_antisymm (ediam_Icc a b ▸ diam_mono Ico_subset_Icc_self)
 le_antisymm (ediam_Icc a b ▸ diam_mono Ioc_subset_Icc_self)
   (ediam_Ioo a b ▸ diam_mono Ioo_subset_Ioc_self)
 
+lemma diam_Icc {a b : ℝ} (h : a ≤ b) : metric.diam (Icc a b) = b - a :=
+by simp [metric.diam, ennreal.to_real_of_real, sub_nonneg.2 h]
+
+lemma diam_Ico {a b : ℝ} (h : a ≤ b) : metric.diam (Ico a b) = b - a :=
+by simp [metric.diam, ennreal.to_real_of_real, sub_nonneg.2 h]
+
+lemma diam_Ioc {a b : ℝ} (h : a ≤ b) : metric.diam (Ioc a b) = b - a :=
+by simp [metric.diam, ennreal.to_real_of_real, sub_nonneg.2 h]
+
+lemma diam_Ioo {a b : ℝ} (h : a ≤ b) : metric.diam (Ioo a b) = b - a :=
+by simp [metric.diam, ennreal.to_real_of_real, sub_nonneg.2 h]
+
 end real
 
 /-- If `edist (f n) (f (n+1))` is bounded above by a function `d : ℕ → ℝ≥0∞`,
diff --git a/src/topology/instances/ereal.lean b/src/topology/instances/ereal.lean
index 3148a9199d1ab..6daf580037099 100644
--- a/src/topology/instances/ereal.lean
+++ b/src/topology/instances/ereal.lean
@@ -3,6 +3,7 @@ Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
+import data.rat.encodable
 import data.real.ereal
 import topology.algebra.order.monotone_continuity
 import topology.instances.ennreal
@@ -10,6 +11,9 @@ import topology.instances.ennreal
 /-!
 # Topological structure on `ereal`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We endow `ereal` with the order topology, and prove basic properties of this topology.
 
 ## Main results
@@ -27,7 +31,7 @@ Most proofs are adapted from the corresponding proofs on `ℝ≥0∞`.
 noncomputable theory
 
 open classical set filter metric topological_space
-open_locale classical topological_space ennreal nnreal big_operators filter
+open_locale classical topology ennreal nnreal big_operators filter
 
 variables {α : Type*} [topological_space α]
 
@@ -122,14 +126,14 @@ begin
   exact tendsto_id
 end
 
-lemma continuous_on_to_real : continuous_on ereal.to_real ({⊥, ⊤} : set ereal).compl :=
+lemma continuous_on_to_real : continuous_on ereal.to_real ({⊥, ⊤}ᶜ : set ereal) :=
 λ a ha, continuous_at.continuous_within_at (tendsto_to_real
   (by { simp [not_or_distrib] at ha, exact ha.2 }) (by { simp [not_or_distrib] at ha, exact ha.1 }))
 
 /-- The set of finite `ereal` numbers is homeomorphic to `ℝ`. -/
-def ne_bot_top_homeomorph_real : ({⊥, ⊤} : set ereal).compl ≃ₜ ℝ :=
+def ne_bot_top_homeomorph_real : ({⊥, ⊤}ᶜ : set ereal) ≃ₜ ℝ :=
 { continuous_to_fun := continuous_on_iff_continuous_restrict.1 continuous_on_to_real,
-  continuous_inv_fun := continuous_subtype_mk _ continuous_coe_real_ereal,
+  continuous_inv_fun := continuous_coe_real_ereal.subtype_mk _,
   .. ne_top_bot_equiv_real }
 
 
@@ -254,11 +258,11 @@ by simp only [continuous_at, nhds_coe_coe, ← coe_add, tendsto_map'_iff, (∘),
 lemma continuous_at_add_top_coe (a : ℝ) :
   continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊤, a) :=
 begin
-  simp only [continuous_at, tendsto_nhds_top_iff_real, top_add, nhds_prod_eq],
+  simp only [continuous_at, tendsto_nhds_top_iff_real, top_add_coe, nhds_prod_eq],
   assume r,
   rw eventually_prod_iff,
   refine ⟨λ z, ((r - (a - 1): ℝ) : ereal) < z, Ioi_mem_nhds (coe_lt_top _),
-          λ z, ((a - 1 : ℝ) : ereal) < z, Ioi_mem_nhds (by simp [zero_lt_one]),
+          λ z, ((a - 1 : ℝ) : ereal) < z, Ioi_mem_nhds (by simp [-ereal.coe_sub]),
           λ x hx y hy, _⟩,
   dsimp,
   convert add_lt_add hx hy,
@@ -277,7 +281,7 @@ end
 lemma continuous_at_add_top_top :
   continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊤, ⊤) :=
 begin
-  simp only [continuous_at, tendsto_nhds_top_iff_real, top_add, nhds_prod_eq],
+  simp only [continuous_at, tendsto_nhds_top_iff_real, top_add_top, nhds_prod_eq],
   assume r,
   rw eventually_prod_iff,
   refine ⟨λ z, (r : ereal) < z, Ioi_mem_nhds (coe_lt_top _),
@@ -291,7 +295,7 @@ end
 lemma continuous_at_add_bot_coe (a : ℝ) :
   continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊥, a) :=
 begin
-  simp only [continuous_at, tendsto_nhds_bot_iff_real, nhds_prod_eq, bot_add_coe],
+  simp only [continuous_at, tendsto_nhds_bot_iff_real, nhds_prod_eq, bot_add],
   assume r,
   rw eventually_prod_iff,
   refine ⟨λ z, z < ((r - (a + 1): ℝ) : ereal), Iio_mem_nhds (bot_lt_coe _),
@@ -313,7 +317,7 @@ end
 lemma continuous_at_add_bot_bot :
   continuous_at (λ (p : ereal × ereal), p.1 + p.2) (⊥, ⊥) :=
 begin
-  simp only [continuous_at, tendsto_nhds_bot_iff_real, nhds_prod_eq, bot_add_bot],
+  simp only [continuous_at, tendsto_nhds_bot_iff_real, nhds_prod_eq, bot_add],
   assume r,
   rw eventually_prod_iff,
   refine ⟨λ z, z < r, Iio_mem_nhds (bot_lt_coe _),
diff --git a/src/topology/instances/int.lean b/src/topology/instances/int.lean
index 94ebb57746533..7805d4cb8029c 100644
--- a/src/topology/instances/int.lean
+++ b/src/topology/instances/int.lean
@@ -3,11 +3,15 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
+import data.int.interval
 import topology.metric_space.basic
 import order.filter.archimedean
 /-!
 # Topology on the integers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The structure of a metric space on `ℤ` is introduced in this file, induced from `ℝ`.
 -/
 noncomputable theory
diff --git a/src/topology/instances/irrational.lean b/src/topology/instances/irrational.lean
index 7fcc884c550de..dade2c4757ce0 100644
--- a/src/topology/instances/irrational.lean
+++ b/src/topology/instances/irrational.lean
@@ -4,11 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import data.real.irrational
+import data.rat.encodable
 import topology.metric_space.baire
 
 /-!
 # Topology of irrational numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove the following theorems:
 
 * `is_Gδ_irrational`, `dense_irrational`, `eventually_residual_irrational`: irrational numbers
@@ -28,7 +32,7 @@ irrational, residual
 -/
 
 open set filter metric
-open_locale filter topological_space
+open_locale filter topology
 
 lemma is_Gδ_irrational : is_Gδ {x | irrational x} :=
 (countable_range _).is_Gδ_compl
@@ -82,6 +86,7 @@ lemma eventually_forall_le_dist_cast_div_of_denom_le (hx : irrational x) (n : 
 
 lemma eventually_forall_le_dist_cast_rat_of_denom_le (hx : irrational x) (n : ℕ) :
   ∀ᶠ ε : ℝ in 𝓝 0, ∀ r : ℚ, r.denom ≤ n → ε ≤ dist x r :=
-(hx.eventually_forall_le_dist_cast_div_of_denom_le n).mono $ λ ε H r hr, H r.denom hr r.num
+(hx.eventually_forall_le_dist_cast_div_of_denom_le n).mono $ λ ε H r hr,
+  by simpa only [rat.cast_def] using H r.denom hr r.num
 
 end irrational
diff --git a/src/topology/instances/matrix.lean b/src/topology/instances/matrix.lean
index e6ecbaf2d458a..ad02ee006beb2 100644
--- a/src/topology/instances/matrix.lean
+++ b/src/topology/instances/matrix.lean
@@ -3,14 +3,18 @@ Copyright (c) 2021 Oliver Nash. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Oliver Nash, Eric Wieser
 -/
-import linear_algebra.determinant
-import topology.algebra.infinite_sum
-import topology.algebra.ring
+import topology.algebra.infinite_sum.basic
+import topology.algebra.ring.basic
 import topology.algebra.star
+import linear_algebra.matrix.nonsingular_inverse
+import linear_algebra.matrix.trace
 
 /-!
 # Topological properties of matrices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file is a place to collect topological results about matrices.
 
 ## Main definitions:
@@ -42,14 +46,23 @@ instance [topological_space R] [t2_space R] : t2_space (matrix m n R) := Pi.t2_s
 section continuity
 variables [topological_space X] [topological_space R]
 
-instance [has_scalar α R] [has_continuous_const_smul α R] :
-  has_continuous_const_smul α (matrix n n R) :=
+instance [has_smul α R] [has_continuous_const_smul α R] :
+  has_continuous_const_smul α (matrix m n R) :=
 pi.has_continuous_const_smul
 
-instance [topological_space α] [has_scalar α R] [has_continuous_smul α R] :
-  has_continuous_smul α (matrix n n R) :=
+instance [topological_space α] [has_smul α R] [has_continuous_smul α R] :
+  has_continuous_smul α (matrix m n R) :=
 pi.has_continuous_smul
 
+instance [has_add R] [has_continuous_add R] : has_continuous_add (matrix m n R) :=
+pi.has_continuous_add
+
+instance [has_neg R] [has_continuous_neg R] : has_continuous_neg (matrix m n R) :=
+pi.has_continuous_neg
+
+instance [add_group R] [topological_add_group R] : topological_add_group (matrix m n R) :=
+pi.topological_add_group
+
 /-- To show a function into matrices is continuous it suffices to show the coefficients of the
 resulting matrix are continuous -/
 @[continuity]
@@ -114,11 +127,11 @@ instance [fintype n] [has_mul R] [add_comm_monoid R] [has_continuous_add R]
 
 instance [fintype n] [non_unital_non_assoc_semiring R] [topological_semiring R] :
   topological_semiring (matrix n n R) :=
-{ ..pi.has_continuous_add }
+{}
 
 instance [fintype n] [non_unital_non_assoc_ring R] [topological_ring R] :
   topological_ring (matrix n n R) :=
-{ ..pi.has_continuous_neg, ..pi.has_continuous_add }
+{}
 
 @[continuity]
 lemma continuous.matrix_vec_mul_vec [has_mul R] [has_continuous_mul R]
@@ -141,15 +154,16 @@ lemma continuous.matrix_vec_mul [non_unital_non_assoc_semiring R] [has_continuou
 continuous_pi $ λ i, hA.matrix_dot_product $ continuous_pi $ λ j, hB.matrix_elem _ _
 
 @[continuity]
-lemma continuous.matrix_minor {A : X → matrix l n R} (hA : continuous A) (e₁ : m → l) (e₂ : p → n) :
-  continuous (λ x, (A x).minor e₁ e₂) :=
+lemma continuous.matrix_submatrix
+  {A : X → matrix l n R} (hA : continuous A) (e₁ : m → l) (e₂ : p → n) :
+  continuous (λ x, (A x).submatrix e₁ e₂) :=
 continuous_matrix $ λ i j, hA.matrix_elem _ _
 
 @[continuity]
 lemma continuous.matrix_reindex {A : X → matrix l n R}
   (hA : continuous A) (e₁ : l ≃ m) (e₂ : n ≃ p) :
   continuous (λ x, reindex e₁ e₂ (A x)) :=
-hA.matrix_minor _ _
+hA.matrix_submatrix _ _
 
 @[continuity]
 lemma continuous.matrix_diag {A : X → matrix n n R} (hA : continuous A) :
@@ -236,7 +250,7 @@ lemma continuous.matrix_block_diagonal' [has_zero R] [decidable_eq l]
   {A : X → Π i, matrix (m' i) (n' i) R} (hA : continuous A) :
   continuous (λ x, block_diagonal' (A x)) :=
 continuous_matrix $ λ ⟨i₁, i₂⟩ ⟨j₁, j₂⟩, begin
-  dsimp only [block_diagonal'],
+  dsimp only [block_diagonal'_apply'],
   split_ifs,
   { subst h,
     exact ((continuous_apply i₁).comp hA).matrix_elem i₂ j₂ },
@@ -258,7 +272,7 @@ variables [semiring α] [add_comm_monoid R] [topological_space R] [module α R]
 
 lemma has_sum.matrix_transpose {f : X → matrix m n R} {a : matrix m n R} (hf : has_sum f a) :
   has_sum (λ x, (f x)ᵀ) aᵀ :=
-(hf.map (@matrix.transpose_add_equiv m n R _) continuous_id.matrix_transpose : _)
+(hf.map (matrix.transpose_add_equiv m n R) continuous_id.matrix_transpose : _)
 
 lemma summable.matrix_transpose {f : X → matrix m n R} (hf : summable f) :
   summable (λ x, (f x)ᵀ) :=
@@ -266,7 +280,7 @@ hf.has_sum.matrix_transpose.summable
 
 @[simp] lemma summable_matrix_transpose {f : X → matrix m n R} :
   summable (λ x, (f x)ᵀ) ↔ summable f :=
-(summable.map_iff_of_equiv (@matrix.transpose_add_equiv m n R _)
+(summable.map_iff_of_equiv (matrix.transpose_add_equiv m n R)
     (@continuous_id (matrix m n R) _).matrix_transpose (continuous_id.matrix_transpose) : _)
 
 lemma matrix.transpose_tsum [t2_space R] {f : X → matrix m n R} : (∑' x, f x)ᵀ = ∑' x, (f x)ᵀ :=
@@ -280,7 +294,7 @@ end
 lemma has_sum.matrix_conj_transpose [star_add_monoid R] [has_continuous_star R]
   {f : X → matrix m n R} {a : matrix m n R} (hf : has_sum f a) :
   has_sum (λ x, (f x)ᴴ) aᴴ :=
-(hf.map (@matrix.conj_transpose_add_equiv m n R _ _) continuous_id.matrix_conj_transpose : _)
+(hf.map (matrix.conj_transpose_add_equiv m n R) continuous_id.matrix_conj_transpose : _)
 
 lemma summable.matrix_conj_transpose [star_add_monoid R] [has_continuous_star R]
   {f : X → matrix m n R} (hf : summable f) :
@@ -290,7 +304,7 @@ hf.has_sum.matrix_conj_transpose.summable
 @[simp] lemma summable_matrix_conj_transpose [star_add_monoid R] [has_continuous_star R]
   {f : X → matrix m n R} :
   summable (λ x, (f x)ᴴ) ↔ summable f :=
-(summable.map_iff_of_equiv (@matrix.conj_transpose_add_equiv m n R _ _)
+(summable.map_iff_of_equiv (matrix.conj_transpose_add_equiv m n R)
   (@continuous_id (matrix m n R) _).matrix_conj_transpose (continuous_id.matrix_conj_transpose) : _)
 
 lemma matrix.conj_transpose_tsum [star_add_monoid R] [has_continuous_star R] [t2_space R]
diff --git a/src/topology/instances/nat.lean b/src/topology/instances/nat.lean
index 499dd3a9ccaad..810b3a2302fef 100644
--- a/src/topology/instances/nat.lean
+++ b/src/topology/instances/nat.lean
@@ -7,6 +7,9 @@ import topology.instances.int
 /-!
 # Topology on the natural numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The structure of a metric space on `ℕ` is introduced in this file, induced from `ℝ`.
 -/
 noncomputable theory
diff --git a/src/topology/instances/nnreal.lean b/src/topology/instances/nnreal.lean
index 3c485b4c01b36..ceb03496d65d4 100644
--- a/src/topology/instances/nnreal.lean
+++ b/src/topology/instances/nnreal.lean
@@ -3,12 +3,16 @@ Copyright (c) 2018 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
-import topology.algebra.infinite_sum
-import topology.algebra.group_with_zero
+import topology.algebra.infinite_sum.order
+import topology.algebra.infinite_sum.ring
+import topology.instances.real
 
 /-!
 # Topology on `ℝ≥0`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The natural topology on `ℝ≥0` (the one induced from `ℝ`), and a basic API.
 
 ## Main definitions
@@ -21,7 +25,7 @@ Instances for the following typeclasses are defined:
 * `order_topology ℝ≥0`
 * `has_continuous_sub ℝ≥0`
 * `has_continuous_inv₀ ℝ≥0` (continuity of `x⁻¹` away from `0`)
-* `has_continuous_smul ℝ≥0 ℝ`
+* `has_continuous_smul ℝ≥0 α` (whenever `α` has a continuous `mul_action ℝ α`)
 
 Everything is inherited from the corresponding structures on the reals.
 
@@ -45,7 +49,7 @@ a few of which rely on the fact that subtraction is continuous.
 -/
 noncomputable theory
 open set topological_space metric filter
-open_locale topological_space
+open_locale topology
 
 namespace nnreal
 open_locale nnreal big_operators filter
@@ -53,10 +57,10 @@ open_locale nnreal big_operators filter
 instance : topological_space ℝ≥0 := infer_instance -- short-circuit type class inference
 
 instance : topological_semiring ℝ≥0 :=
-{ continuous_mul := continuous_subtype_mk _ $
-    (continuous_subtype_val.comp continuous_fst).mul (continuous_subtype_val.comp continuous_snd),
-  continuous_add := continuous_subtype_mk _ $
-    (continuous_subtype_val.comp continuous_fst).add (continuous_subtype_val.comp continuous_snd) }
+{ continuous_mul :=
+    (continuous_subtype_val.fst'.mul continuous_subtype_val.snd').subtype_mk _,
+  continuous_add :=
+    (continuous_subtype_val.fst'.add continuous_subtype_val.snd').subtype_mk _ }
 
 instance : second_countable_topology ℝ≥0 :=
 topological_space.subtype.second_countable_topology _ _
@@ -68,11 +72,19 @@ variable {α : Type*}
 open filter finset
 
 lemma _root_.continuous_real_to_nnreal : continuous real.to_nnreal :=
-continuous_subtype_mk _ $ continuous_id.max continuous_const
+(continuous_id.max continuous_const).subtype_mk _
 
 lemma continuous_coe : continuous (coe : ℝ≥0 → ℝ) :=
 continuous_subtype_val
 
+/-- Embedding of `ℝ≥0` to `ℝ` as a bundled continuous map. -/
+@[simps { fully_applied := ff }] def _root_.continuous_map.coe_nnreal_real : C(ℝ≥0, ℝ) :=
+⟨coe, continuous_coe⟩
+
+instance continuous_map.can_lift {X : Type*} [topological_space X] :
+  can_lift C(X, ℝ) C(X, ℝ≥0) continuous_map.coe_nnreal_real.comp (λ f, ∀ x, 0 ≤ f x) :=
+{ prf := λ f hf, ⟨⟨λ x, ⟨f x, hf x⟩, f.2.subtype_mk _⟩, fun_like.ext' rfl⟩ }
+
 @[simp, norm_cast] lemma tendsto_coe {f : filter α} {m : α → ℝ≥0} {x : ℝ≥0} :
   tendsto (λa, (m a : ℝ)) f (𝓝 (x : ℝ)) ↔ tendsto m f (𝓝 x) :=
 tendsto_subtype_rng.symm
@@ -91,10 +103,18 @@ lemma comap_coe_at_top : comap (coe : ℝ≥0 → ℝ) at_top = at_top :=
   tendsto (λ a, (m a : ℝ)) f at_top ↔ tendsto m f at_top :=
 tendsto_Ici_at_top.symm
 
-lemma tendsto_real_to_nnreal {f : filter α} {m : α → ℝ} {x : ℝ} (h : tendsto m f (𝓝 x)) :
+lemma _root_.tendsto_real_to_nnreal {f : filter α} {m : α → ℝ} {x : ℝ} (h : tendsto m f (𝓝 x)) :
   tendsto (λa, real.to_nnreal (m a)) f (𝓝 (real.to_nnreal x)) :=
 (continuous_real_to_nnreal.tendsto _).comp h
 
+lemma _root_.tendsto_real_to_nnreal_at_top : tendsto real.to_nnreal at_top at_top :=
+begin
+  rw ← tendsto_coe_at_top,
+  apply tendsto_id.congr' _,
+  filter_upwards [Ici_mem_at_top (0 : ℝ)] with x hx,
+  simp only [max_eq_left (set.mem_Ici.1 hx), id.def, real.coe_to_nnreal'],
+end
+
 lemma nhds_zero : 𝓝 (0 : ℝ≥0) = ⨅a ≠ 0, 𝓟 (Iio a) :=
 nhds_bot_order.trans $ by simp [bot_lt_iff_ne_bot]
 
@@ -102,17 +122,15 @@ lemma nhds_zero_basis : (𝓝 (0 : ℝ≥0)).has_basis (λ a : ℝ≥0, 0 < a) (
 nhds_bot_basis
 
 instance : has_continuous_sub ℝ≥0 :=
-⟨continuous_subtype_mk _ $
-  ((continuous_coe.comp continuous_fst).sub
-   (continuous_coe.comp continuous_snd)).max continuous_const⟩
+⟨((continuous_coe.fst'.sub continuous_coe.snd').max continuous_const).subtype_mk _⟩
 
 instance : has_continuous_inv₀ ℝ≥0 :=
 ⟨λ x hx, tendsto_coe.1 $ (real.tendsto_inv $ nnreal.coe_ne_zero.2 hx).comp
   continuous_coe.continuous_at⟩
 
-instance : has_continuous_smul ℝ≥0 ℝ :=
-{ continuous_smul := continuous.comp real.continuous_mul $ continuous.prod_mk
-    (continuous.comp continuous_subtype_val continuous_fst) continuous_snd }
+instance [topological_space α] [mul_action ℝ α] [has_continuous_smul ℝ α] :
+  has_continuous_smul ℝ≥0 α :=
+{ continuous_smul := (continuous_induced_dom.comp continuous_fst).smul continuous_snd }
 
 @[norm_cast] lemma has_sum_coe {f : α → ℝ≥0} {r : ℝ≥0} :
   has_sum (λa, (f a : ℝ)) (r : ℝ) ↔ has_sum f r :=
@@ -212,4 +230,11 @@ begin
   exact tendsto_tsum_compl_at_top_zero (λ (a : α), (f a : ℝ))
 end
 
+/-- `x ↦ x ^ n` as an order isomorphism of `ℝ≥0`. -/
+def pow_order_iso (n : ℕ) (hn : n ≠ 0) : ℝ≥0 ≃o ℝ≥0 :=
+strict_mono.order_iso_of_surjective (λ x, x ^ n)
+  (λ x y h, strict_mono_on_pow hn.bot_lt (zero_le x) (zero_le y) h) $
+  (continuous_id.pow _).surjective (tendsto_pow_at_top hn) $
+    by simpa [order_bot.at_bot_eq, pos_iff_ne_zero]
+
 end nnreal
diff --git a/src/topology/instances/rat.lean b/src/topology/instances/rat.lean
index eec32ff7596fa..9e5ed81f1cbfd 100644
--- a/src/topology/instances/rat.lean
+++ b/src/topology/instances/rat.lean
@@ -4,21 +4,25 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
 import topology.metric_space.basic
+import topology.algebra.order.archimedean
 import topology.instances.int
 import topology.instances.nat
 import topology.instances.real
 /-!
 # Topology on the ratonal numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The structure of a metric space on `ℚ` is introduced in this file, induced from `ℝ`.
 -/
-noncomputable theory
 open metric set filter
 
 namespace rat
 
+-- without the `by exact` this is noncomputable
 instance : metric_space ℚ :=
-metric_space.induced coe rat.cast_injective real.metric_space
+metric_space.induced coe (by exact rat.cast_injective) real.metric_space
 
 theorem dist_eq (x y : ℚ) : dist x y = |x - y| := rfl
 
@@ -31,11 +35,7 @@ theorem uniform_embedding_coe_real : uniform_embedding (coe : ℚ → ℝ) :=
 uniform_embedding_comap rat.cast_injective
 
 theorem dense_embedding_coe_real : dense_embedding (coe : ℚ → ℝ) :=
-uniform_embedding_coe_real.dense_embedding $
-λ x, mem_closure_iff_nhds.2 $ λ t ht,
-let ⟨ε,ε0, hε⟩ := metric.mem_nhds_iff.1 ht in
-let ⟨q, h⟩ := exists_rat_near x ε0 in
-⟨_, hε (mem_ball'.2 h), q, rfl⟩
+uniform_embedding_coe_real.dense_embedding rat.dense_range_cast
 
 theorem embedding_coe_real : embedding (coe : ℚ → ℝ) := dense_embedding_coe_real.to_embedding
 
@@ -61,15 +61,17 @@ uniform_embedding_bot_of_pairwise_le_dist zero_lt_one $ by simpa using int.pairw
 lemma int.closed_embedding_coe_rat : closed_embedding (coe : ℤ → ℚ) :=
 closed_embedding_of_pairwise_le_dist zero_lt_one $ by simpa using int.pairwise_one_le_dist
 
+namespace rat
+
 instance : noncompact_space ℚ := int.closed_embedding_coe_rat.noncompact_space
 
 -- TODO(Mario): Find a way to use rat_add_continuous_lemma
-theorem rat.uniform_continuous_add : uniform_continuous (λp : ℚ × ℚ, p.1 + p.2) :=
+theorem uniform_continuous_add : uniform_continuous (λp : ℚ × ℚ, p.1 + p.2) :=
 rat.uniform_embedding_coe_real.to_uniform_inducing.uniform_continuous_iff.2 $
   by simp only [(∘), rat.cast_add]; exact real.uniform_continuous_add.comp
     (rat.uniform_continuous_coe_real.prod_map rat.uniform_continuous_coe_real)
 
-theorem rat.uniform_continuous_neg : uniform_continuous (@has_neg.neg ℚ _) :=
+theorem uniform_continuous_neg : uniform_continuous (@has_neg.neg ℚ _) :=
 metric.uniform_continuous_iff.2 $ λ ε ε0, ⟨_, ε0, λ a b h,
   by rw dist_comm at h; simpa [rat.dist_eq] using h⟩
 
@@ -81,20 +83,20 @@ instance : topological_add_group ℚ := by apply_instance
 instance : order_topology ℚ :=
 induced_order_topology _ (λ x y, rat.cast_lt) (@exists_rat_btwn _ _ _)
 
-lemma rat.uniform_continuous_abs : uniform_continuous (abs : ℚ → ℚ) :=
+lemma uniform_continuous_abs : uniform_continuous (abs : ℚ → ℚ) :=
 metric.uniform_continuous_iff.2 $ λ ε ε0,
   ⟨ε, ε0, λ a b h, lt_of_le_of_lt
     (by simpa [rat.dist_eq] using abs_abs_sub_abs_le_abs_sub _ _) h⟩
 
-lemma rat.continuous_mul : continuous (λp : ℚ × ℚ, p.1 * p.2) :=
+lemma continuous_mul : continuous (λp : ℚ × ℚ, p.1 * p.2) :=
 rat.embedding_coe_real.continuous_iff.2 $ by simp [(∘)]; exact
 real.continuous_mul.comp ((rat.continuous_coe_real.prod_map rat.continuous_coe_real))
 
 instance : topological_ring ℚ :=
 { continuous_mul := rat.continuous_mul, ..rat.topological_add_group }
 
-lemma rat.totally_bounded_Icc (a b : ℚ) : totally_bounded (Icc a b) :=
-begin
-  have := totally_bounded_preimage rat.uniform_embedding_coe_real (totally_bounded_Icc a b),
-  rwa (set.ext (λ q, _) : Icc _ _ = _), simp
-end
+lemma totally_bounded_Icc (a b : ℚ) : totally_bounded (Icc a b) :=
+by simpa only [preimage_cast_Icc]
+  using totally_bounded_preimage rat.uniform_embedding_coe_real (totally_bounded_Icc a b)
+
+end rat
diff --git a/src/topology/instances/rat_lemmas.lean b/src/topology/instances/rat_lemmas.lean
index b8e6c0c7e4373..b20d5f7e8d5a2 100644
--- a/src/topology/instances/rat_lemmas.lean
+++ b/src/topology/instances/rat_lemmas.lean
@@ -10,6 +10,9 @@ import topology.alexandroff
 /-!
 # Additional lemmas about the topology on rational numbers
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The structure of a metric space on `ℚ` (`rat.metric_space`) is introduced elsewhere, induced from
 `ℝ`. In this file we prove some properties of this topological space and its one-point
 compactification.
@@ -27,7 +30,7 @@ compactification.
 -/
 
 open set metric filter topological_space
-open_locale topological_space alexandroff
+open_locale topology alexandroff
 local notation `ℚ∞` := alexandroff ℚ
 
 namespace rat
@@ -79,7 +82,8 @@ instance : totally_disconnected_space ℚ :=
 begin
   refine ⟨λ s hsu hs x hx y hy, _⟩, clear hsu,
   by_contra' H : x ≠ y,
-  wlog hlt : x < y := H.lt_or_lt using [x y, y x],
+  wlog hlt : x < y,
+  { exact this s hs y hy x hx H.symm (H.lt_or_lt.resolve_left hlt) },
   rcases exists_irrational_btwn (rat.cast_lt.2 hlt) with ⟨z, hz, hxz, hzy⟩,
   have := hs.image coe continuous_coe_real.continuous_on,
   rw [is_preconnected_iff_ord_connected] at this,
diff --git a/src/topology/instances/real.lean b/src/topology/instances/real.lean
index 515ecfb0f9c1b..ad071db4779b1 100644
--- a/src/topology/instances/real.lean
+++ b/src/topology/instances/real.lean
@@ -5,21 +5,26 @@ Authors: Johannes Hölzl, Mario Carneiro
 -/
 import topology.metric_space.basic
 import topology.algebra.uniform_group
-import topology.algebra.ring
+import topology.algebra.uniform_mul_action
+import topology.algebra.ring.basic
 import topology.algebra.star
+import topology.algebra.order.field
 import ring_theory.subring.basic
 import group_theory.archimedean
+import algebra.order.group.bounds
 import algebra.periodic
-import order.filter.archimedean
 import topology.instances.int
 
 /-!
 # Topological properties of ℝ
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 noncomputable theory
 open classical filter int metric set topological_space
-open_locale classical topological_space filter uniformity interval
+open_locale classical topology filter uniformity interval
 
 universes u v w
 variables {α : Type u} {β : Type v} {γ : Type w}
@@ -99,16 +104,10 @@ continuous_iff_continuous_at.mpr $ assume ⟨r, hr⟩,
 lemma real.continuous.inv [topological_space α] {f : α → ℝ} (h : ∀a, f a ≠ 0) (hf : continuous f) :
   continuous (λa, (f a)⁻¹) :=
 show continuous ((has_inv.inv ∘ @subtype.val ℝ (λr, r ≠ 0)) ∘ λa, ⟨f a, h a⟩),
-  from real.continuous_inv.comp (continuous_subtype_mk _ hf)
-
-lemma real.uniform_continuous_mul_const {x : ℝ} : uniform_continuous ((*) x) :=
-metric.uniform_continuous_iff.2 $ λ ε ε0, begin
-  cases exists_gt (|x|) with y xy,
-  have y0 := lt_of_le_of_lt (abs_nonneg _) xy,
-  refine ⟨_, div_pos ε0 y0, λ a b h, _⟩,
-  rw [real.dist_eq, ← mul_sub, abs_mul, ← mul_div_cancel' ε (ne_of_gt y0)],
-  exact mul_lt_mul' (le_of_lt xy) h (abs_nonneg _) y0
-end
+  from real.continuous_inv.comp (hf.subtype_mk _)
+
+lemma real.uniform_continuous_const_mul {x : ℝ} : uniform_continuous ((*) x) :=
+uniform_continuous_const_smul x
 
 lemma real.uniform_continuous_mul (s : set (ℝ × ℝ))
   {r₁ r₂ : ℝ} (H : ∀ x ∈ s, |(x : ℝ × ℝ).1| < r₁ ∧ |x.2| < r₂) :
@@ -221,6 +220,52 @@ end periodic
 
 section subgroups
 
+namespace int
+open metric
+
+/-- Under the coercion from `ℤ` to `ℝ`, inverse images of compact sets are finite. -/
+lemma tendsto_coe_cofinite : tendsto (coe : ℤ → ℝ) cofinite (cocompact ℝ) :=
+begin
+  refine tendsto_cocompact_of_tendsto_dist_comp_at_top (0 : ℝ) _,
+  simp only [filter.tendsto_at_top, eventually_cofinite, not_le, ← mem_ball],
+  change ∀ r : ℝ, (coe ⁻¹' (ball (0 : ℝ) r)).finite,
+  simp [real.ball_eq_Ioo, set.finite_Ioo],
+end
+
+/-- For nonzero `a`, the "multiples of `a`" map `zmultiples_hom` from `ℤ` to `ℝ` is discrete, i.e.
+inverse images of compact sets are finite. -/
+lemma tendsto_zmultiples_hom_cofinite {a : ℝ} (ha : a ≠ 0) :
+  tendsto (zmultiples_hom ℝ a) cofinite (cocompact ℝ) :=
+begin
+  convert (tendsto_cocompact_mul_right₀ ha).comp int.tendsto_coe_cofinite,
+  ext n,
+  simp,
+end
+
+end int
+
+namespace add_subgroup
+
+/-- The subgroup "multiples of `a`" (`zmultiples a`) is a discrete subgroup of `ℝ`, i.e. its
+intersection with compact sets is finite. -/
+lemma tendsto_zmultiples_subtype_cofinite (a : ℝ) :
+  tendsto (zmultiples a).subtype cofinite (cocompact ℝ) :=
+begin
+  rcases eq_or_ne a 0 with rfl | ha,
+  { rw add_subgroup.zmultiples_zero_eq_bot,
+    intros K hK,
+    rw [filter.mem_map, mem_cofinite],
+    apply set.to_finite },
+  intros K hK,
+  have H := int.tendsto_zmultiples_hom_cofinite ha hK,
+  simp only [filter.mem_map, mem_cofinite, ← preimage_compl] at ⊢ H,
+  rw [← (zmultiples_hom ℝ a).range_restrict_surjective.image_preimage
+    ((zmultiples a).subtype ⁻¹' Kᶜ), ← preimage_comp, ← add_monoid_hom.coe_comp_range_restrict],
+  exact finite.image _ H,
+end
+
+end add_subgroup
+
 /-- Given a nontrivial subgroup `G ⊆ ℝ`, if `G ∩ ℝ_{>0}` has no minimum then `G` is dense. -/
 lemma real.subgroup_dense_of_no_min {G : add_subgroup ℝ} {g₀ : ℝ} (g₀_in : g₀ ∈ G) (g₀_ne : g₀ ≠ 0)
   (H' : ¬ ∃ a : ℝ, is_least {g : ℝ | g ∈ G ∧ 0 < g} a) :
diff --git a/src/topology/instances/real_vector_space.lean b/src/topology/instances/real_vector_space.lean
index baa8d723b86b6..6f7575e36dc96 100644
--- a/src/topology/instances/real_vector_space.lean
+++ b/src/topology/instances/real_vector_space.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
 import topology.algebra.module.basic
-import topology.instances.real
 import topology.instances.rat
 
 /-!
 # Continuous additive maps are `ℝ`-linear
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove that a continuous map `f : E →+ F` between two topological vector spaces
 over `ℝ` is `ℝ`-linear
 -/
@@ -18,10 +20,8 @@ variables {E : Type*} [add_comm_group E] [module ℝ E] [topological_space E]
   [has_continuous_smul ℝ E] {F : Type*} [add_comm_group F] [module ℝ F]
   [topological_space F] [has_continuous_smul ℝ F] [t2_space F]
 
-namespace add_monoid_hom
-
 /-- A continuous additive map between two vector spaces over `ℝ` is `ℝ`-linear. -/
-lemma map_real_smul (f : E →+ F) (hf : continuous f) (c : ℝ) (x : E) :
+lemma map_real_smul {G} [add_monoid_hom_class G E F] (f : G) (hf : continuous f) (c : ℝ) (x : E) :
   f (c • x) = c • f x :=
 suffices (λ c : ℝ, f (c • x)) = λ c : ℝ, c • f x, from _root_.congr_fun this c,
 rat.dense_embedding_coe_real.dense.equalizer
@@ -29,10 +29,12 @@ rat.dense_embedding_coe_real.dense.equalizer
   (continuous_id.smul continuous_const)
   (funext $ λ r, map_rat_cast_smul f ℝ ℝ r x)
 
+namespace add_monoid_hom
+
 /-- Reinterpret a continuous additive homomorphism between two real vector spaces
 as a continuous real-linear map. -/
 def to_real_linear_map (f : E →+ F) (hf : continuous f) : E →L[ℝ] F :=
-⟨{ to_fun := f, map_add' := f.map_add, map_smul' := f.map_real_smul hf }, hf⟩
+⟨{ to_fun := f, map_add' := f.map_add, map_smul' := map_real_smul f hf }, hf⟩
 
 @[simp] lemma coe_to_real_linear_map (f : E →+ F) (hf : continuous f) :
   ⇑(f.to_real_linear_map hf) = f := rfl
@@ -53,4 +55,4 @@ topological `ℝ`-algebra `A` (e.g. `A = ℂ`) and any topological group that is
 instance real.is_scalar_tower [t2_space E] {A : Type*} [topological_space A]
   [ring A] [algebra ℝ A] [module A E] [has_continuous_smul ℝ A]
   [has_continuous_smul A E] : is_scalar_tower ℝ A E :=
-⟨λ r x y, ((smul_add_hom A E).flip y).map_real_smul (continuous_id.smul continuous_const) r x⟩
+⟨λ r x y, map_real_smul ((smul_add_hom A E).flip y) (continuous_id.smul continuous_const) r x⟩
diff --git a/src/topology/instances/sign.lean b/src/topology/instances/sign.lean
new file mode 100644
index 0000000000000..2ddc6e4e4d487
--- /dev/null
+++ b/src/topology/instances/sign.lean
@@ -0,0 +1,56 @@
+/-
+Copyright (c) 2022 Joseph Myers. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Joseph Myers
+-/
+import data.sign
+import topology.order.basic
+
+/-!
+# Topology on `sign_type`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file gives `sign_type` the discrete topology, and proves continuity results for `sign` in
+an `order_topology`.
+
+-/
+
+instance : topological_space sign_type := ⊥
+instance : discrete_topology sign_type := ⟨rfl⟩
+
+variables {α : Type*} [has_zero α] [topological_space α]
+
+section partial_order
+
+variables [partial_order α] [decidable_rel ((<) : α → α → Prop)] [order_topology α]
+
+lemma continuous_at_sign_of_pos {a : α} (h : 0 < a) : continuous_at sign a :=
+begin
+  refine (continuous_at_const : continuous_at (λ x, (1 : sign_type)) a).congr _,
+  rw [filter.eventually_eq, eventually_nhds_iff],
+  exact ⟨{x | 0 < x}, λ x hx, (sign_pos hx).symm, is_open_lt' 0, h⟩
+end
+
+lemma continuous_at_sign_of_neg {a : α} (h : a < 0) : continuous_at sign a :=
+begin
+  refine (continuous_at_const : continuous_at (λ x, (-1 : sign_type)) a).congr _,
+  rw [filter.eventually_eq, eventually_nhds_iff],
+  exact ⟨{x | x < 0}, λ x hx, (sign_neg hx).symm, is_open_gt' 0, h⟩
+end
+
+end partial_order
+
+section linear_order
+
+variables [linear_order α] [order_topology α]
+
+lemma continuous_at_sign_of_ne_zero {a : α} (h : a ≠ 0) : continuous_at sign a :=
+begin
+  rcases h.lt_or_lt with h_neg|h_pos,
+  { exact continuous_at_sign_of_neg h_neg },
+  { exact continuous_at_sign_of_pos h_pos }
+end
+
+end linear_order
diff --git a/src/topology/instances/triv_sq_zero_ext.lean b/src/topology/instances/triv_sq_zero_ext.lean
new file mode 100644
index 0000000000000..1903be2866457
--- /dev/null
+++ b/src/topology/instances/triv_sq_zero_ext.lean
@@ -0,0 +1,154 @@
+/-
+Copyright (c) 2023 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import algebra.triv_sq_zero_ext
+import topology.algebra.infinite_sum.basic
+import topology.algebra.module.basic
+
+/-!
+# Topology on `triv_sq_zero_ext R M`
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The type `triv_sq_zero_ext R M` inherits the topology from `R × M`.
+
+Note that this is not the topology induced by the seminorm on the dual numbers suggested by
+[this Math.SE answer](https://math.stackexchange.com/a/1056378/1896), which instead induces
+the topology pulled back through the projection map `triv_sq_zero_ext.fst : tsze R M → R`.
+Obviously, that topology is not Hausdorff and using it would result in `exp` converging to more than
+one value.
+
+## Main results
+
+* `triv_sq_zero_ext.topological_ring`: the ring operations are continuous
+
+-/
+
+variables {α S R M : Type*}
+
+local notation `tsze` := triv_sq_zero_ext
+
+namespace triv_sq_zero_ext
+variables [topological_space R] [topological_space M]
+
+instance : topological_space (tsze R M) :=
+topological_space.induced fst ‹_› ⊓ topological_space.induced snd ‹_›
+
+instance [t2_space R] [t2_space M] : t2_space (tsze R M) :=
+prod.t2_space
+
+lemma nhds_def (x : tsze R M) : nhds x = (nhds x.fst).prod (nhds x.snd) :=
+by cases x; exact nhds_prod_eq
+lemma nhds_inl [has_zero M] (x : R) : nhds (inl x : tsze R M) = (nhds x).prod (nhds 0) := nhds_def _
+lemma nhds_inr [has_zero R] (m : M) : nhds (inr m : tsze R M) = (nhds 0).prod (nhds m) := nhds_def _
+
+lemma continuous_fst : continuous (fst : tsze R M → R) := continuous_fst
+lemma continuous_snd : continuous (snd : tsze R M → M) := continuous_snd
+
+lemma continuous_inl [has_zero M] : continuous (inl : R → tsze R M) :=
+continuous_id.prod_mk continuous_const
+lemma continuous_inr [has_zero R] : continuous (inr : M → tsze R M) :=
+continuous_const.prod_mk continuous_id
+
+lemma embedding_inl [has_zero M] : embedding (inl : R → tsze R M) :=
+embedding_of_embedding_compose continuous_inl continuous_fst embedding_id
+lemma embedding_inr [has_zero R] : embedding (inr : M → tsze R M) :=
+embedding_of_embedding_compose continuous_inr continuous_snd embedding_id
+
+variables (R M)
+
+/-- `triv_sq_zero_ext.fst` as a continuous linear map. -/
+@[simps]
+def fst_clm [comm_semiring R] [add_comm_monoid M] [module R M] : tsze R M →L[R] R :=
+{ to_fun := fst,
+  .. continuous_linear_map.fst R R M }
+
+/-- `triv_sq_zero_ext.snd` as a continuous linear map. -/
+@[simps]
+def snd_clm [comm_semiring R] [add_comm_monoid M] [module R M] : tsze R M →L[R] M :=
+{ to_fun := snd,
+  cont := continuous_snd,
+  .. continuous_linear_map.snd R R M }
+
+/-- `triv_sq_zero_ext.inl` as a continuous linear map. -/
+@[simps]
+def inl_clm [comm_semiring R] [add_comm_monoid M] [module R M] : R →L[R] tsze R M :=
+{ to_fun := inl,
+  .. continuous_linear_map.inl R R M }
+
+/-- `triv_sq_zero_ext.inr` as a continuous linear map. -/
+@[simps]
+def inr_clm [comm_semiring R] [add_comm_monoid M] [module R M] : M →L[R] tsze R M :=
+{ to_fun := inr,
+  .. continuous_linear_map.inr R R M }
+
+variables {R M}
+
+instance [has_add R] [has_add M]
+  [has_continuous_add R] [has_continuous_add M] :
+  has_continuous_add (tsze R M) :=
+prod.has_continuous_add
+
+instance [has_mul R] [has_add M] [has_smul R M] [has_smul Rᵐᵒᵖ M]
+  [has_continuous_mul R] [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M]
+  [has_continuous_add M] :
+  has_continuous_mul (tsze R M) :=
+⟨((continuous_fst.comp _root_.continuous_fst).mul (continuous_fst.comp _root_.continuous_snd))
+  .prod_mk $
+    ((continuous_fst.comp _root_.continuous_fst).smul
+     (continuous_snd.comp _root_.continuous_snd)).add
+    ((mul_opposite.continuous_op.comp $ continuous_fst.comp $ _root_.continuous_snd).smul
+     (continuous_snd.comp _root_.continuous_fst))⟩
+
+instance [has_neg R] [has_neg M]
+  [has_continuous_neg R] [has_continuous_neg M] :
+  has_continuous_neg (tsze R M) :=
+prod.has_continuous_neg
+
+/-- This is not an instance due to complaints by the `fails_quickly` linter. At any rate, we only
+really care about the `topological_ring` instance below. -/
+lemma topological_semiring [semiring R] [add_comm_monoid M] [module R M] [module Rᵐᵒᵖ M]
+  [topological_semiring R] [has_continuous_add M]
+  [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] :
+  -- note: lean times out looking for the non_assoc_semiring instance without this hint
+  @topological_semiring (tsze R M) _ (non_assoc_semiring.to_non_unital_non_assoc_semiring _) :=
+{}
+
+instance [ring R] [add_comm_group M] [module R M] [module Rᵐᵒᵖ M]
+  [topological_ring R] [topological_add_group M]
+  [has_continuous_smul R M] [has_continuous_smul Rᵐᵒᵖ M] :
+  topological_ring (tsze R M) :=
+{}
+
+instance [has_smul S R] [has_smul S M]
+  [has_continuous_const_smul S R] [has_continuous_const_smul S M] :
+  has_continuous_const_smul S (tsze R M) :=
+prod.has_continuous_const_smul
+
+instance [topological_space S] [has_smul S R] [has_smul S M]
+  [has_continuous_smul S R] [has_continuous_smul S M] :
+  has_continuous_smul S (tsze R M) :=
+prod.has_continuous_smul
+
+variables (M)
+
+lemma has_sum_inl [add_comm_monoid R] [add_comm_monoid M] {f : α → R} {a : R} (h : has_sum f a) :
+  has_sum (λ x, inl (f x)) (inl a : tsze R M) :=
+h.map (⟨inl, inl_zero _, inl_add _⟩ : R →+ tsze R M) continuous_inl
+
+lemma has_sum_inr [add_comm_monoid R] [add_comm_monoid M] {f : α → M} {a : M} (h : has_sum f a) :
+  has_sum (λ x, inr (f x)) (inr a : tsze R M) :=
+h.map (⟨inr, inr_zero _, inr_add _⟩ : M →+ tsze R M) continuous_inr
+
+lemma has_sum_fst [add_comm_monoid R] [add_comm_monoid M] {f : α → tsze R M} {a : tsze R M}
+  (h : has_sum f a) : has_sum (λ x, fst (f x)) (fst a) :=
+h.map (⟨fst, fst_zero, fst_add⟩ : tsze R M →+ R) continuous_fst
+
+lemma has_sum_snd [add_comm_monoid R] [add_comm_monoid M] {f : α → tsze R M} {a : tsze R M}
+  (h : has_sum f a) : has_sum (λ x, snd (f x)) (snd a) :=
+h.map (⟨snd, snd_zero, snd_add⟩ : tsze R M →+ M) continuous_snd
+
+end triv_sq_zero_ext
diff --git a/src/topology/is_locally_homeomorph.lean b/src/topology/is_locally_homeomorph.lean
index 2c2ff161c0133..75fa4fe4ab8ec 100644
--- a/src/topology/is_locally_homeomorph.lean
+++ b/src/topology/is_locally_homeomorph.lean
@@ -8,6 +8,9 @@ import topology.local_homeomorph
 /-!
 # Local homeomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines local homeomorphisms.
 
 ## Main definitions
@@ -20,26 +23,26 @@ This file defines local homeomorphisms.
   `local_homeomorph`, which is a homeomorphism between specific open subsets.
 -/
 
-open_locale topological_space
+open_locale topology
 
 variables {X Y Z : Type*} [topological_space X] [topological_space Y] [topological_space Z]
-  (g : Y → Z) (f : X →  Y)
+  (g : Y → Z) (f : X →  Y) (s : set X) (t : set Y)
 
-/-- A function `f : X → Y` satisfies `is_locally_homeomorph` if each `x : x` is contained in
-  the source of some `e : local_homeomorph X Y` with `f = e`. -/
-def is_locally_homeomorph :=
-∀ x : X, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ f = e
+/-- A function `f : X → Y` satisfies `is_locally_homeomorph_on f s` if each `x ∈ s` is contained in
+the source of some `e : local_homeomorph X Y` with `f = e`. -/
+def is_locally_homeomorph_on :=
+∀ x ∈ s, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ f = e
 
-namespace is_locally_homeomorph
+namespace is_locally_homeomorph_on
 
-/-- Proves that `f` satisfies `is_locally_homeomorph`. The condition `h` is weaker than definition
-of `is_locally_homeomorph`, since it only requires `e : local_homeomorph X Y` to agree with `f` on
-its source `e.source`, as opposed to on the whole space `X`. -/
-lemma mk (h : ∀ x : X, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ ∀ x, x ∈ e.source → f x = e x) :
-  is_locally_homeomorph f :=
+/-- Proves that `f` satisfies `is_locally_homeomorph_on f s`. The condition `h` is weaker than the
+definition of `is_locally_homeomorph_on f s`, since it only requires `e : local_homeomorph X Y` to
+agree with `f` on its source `e.source`, as opposed to on the whole space `X`. -/
+lemma mk (h : ∀ x ∈ s, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ ∀ y ∈ e.source, f y = e y) :
+  is_locally_homeomorph_on f s :=
 begin
-  intro x,
-  obtain ⟨e, hx, he⟩ := h x,
+  intros x hx,
+  obtain ⟨e, hx, he⟩ := h x hx,
   exact ⟨{ to_fun := f,
     map_source' := λ x hx, by rw he x hx; exact e.map_source' hx,
     left_inv' := λ x hx, by rw he x hx; exact e.left_inv' hx,
@@ -48,27 +51,71 @@ begin
     .. e }, hx, rfl⟩,
 end
 
-variables {g f}
+variables {g f s t}
 
-lemma map_nhds_eq (hf : is_locally_homeomorph f) (x : X) : (𝓝 x).map f = 𝓝 (f x) :=
+lemma map_nhds_eq (hf : is_locally_homeomorph_on f s) {x : X} (hx : x ∈ s) :
+  (𝓝 x).map f = 𝓝 (f x) :=
+let ⟨e, hx, he⟩ := hf x hx in he.symm ▸ e.map_nhds_eq hx
+
+protected lemma continuous_at (hf : is_locally_homeomorph_on f s) {x : X} (hx : x ∈ s) :
+  continuous_at f x :=
+(hf.map_nhds_eq hx).le
+
+protected lemma continuous_on (hf : is_locally_homeomorph_on f s) : continuous_on f s :=
+continuous_at.continuous_on (λ x, hf.continuous_at)
+
+protected lemma comp (hg : is_locally_homeomorph_on g t) (hf : is_locally_homeomorph_on f s)
+  (h : set.maps_to f s t) : is_locally_homeomorph_on (g ∘ f) s :=
 begin
-  obtain ⟨e, hx, rfl⟩ := hf x,
-  exact e.map_nhds_eq hx,
+  intros x hx,
+  obtain ⟨eg, hxg, rfl⟩ := hg (f x) (h hx),
+  obtain ⟨ef, hxf, rfl⟩ := hf x hx,
+  exact ⟨ef.trans eg, ⟨hxf, hxg⟩, rfl⟩,
 end
 
+end is_locally_homeomorph_on
+
+/-- A function `f : X → Y` satisfies `is_locally_homeomorph f` if each `x : x` is contained in
+  the source of some `e : local_homeomorph X Y` with `f = e`. -/
+def is_locally_homeomorph :=
+∀ x : X, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ f = e
+
+variables {f}
+
+lemma is_locally_homeomorph_iff_is_locally_homeomorph_on_univ :
+  is_locally_homeomorph f ↔ is_locally_homeomorph_on f set.univ :=
+by simp only [is_locally_homeomorph, is_locally_homeomorph_on, set.mem_univ, forall_true_left]
+
+protected lemma is_locally_homeomorph.is_locally_homeomorph_on (hf : is_locally_homeomorph f) :
+  is_locally_homeomorph_on f set.univ :=
+is_locally_homeomorph_iff_is_locally_homeomorph_on_univ.mp hf
+
+variables (f)
+
+namespace is_locally_homeomorph
+
+/-- Proves that `f` satisfies `is_locally_homeomorph f`. The condition `h` is weaker than the
+definition of `is_locally_homeomorph f`, since it only requires `e : local_homeomorph X Y` to
+agree with `f` on its source `e.source`, as opposed to on the whole space `X`. -/
+lemma mk (h : ∀ x : X, ∃ e : local_homeomorph X Y, x ∈ e.source ∧ ∀ y ∈ e.source, f y = e y) :
+  is_locally_homeomorph f :=
+is_locally_homeomorph_iff_is_locally_homeomorph_on_univ.mpr
+  (is_locally_homeomorph_on.mk f set.univ (λ x hx, h x))
+
+variables {g f}
+
+lemma map_nhds_eq (hf : is_locally_homeomorph f) (x : X) : (𝓝 x).map f = 𝓝 (f x) :=
+hf.is_locally_homeomorph_on.map_nhds_eq (set.mem_univ x)
+
 protected lemma continuous (hf : is_locally_homeomorph f) : continuous f :=
-continuous_iff_continuous_at.mpr (λ x, le_of_eq (hf.map_nhds_eq x))
+continuous_iff_continuous_on_univ.mpr hf.is_locally_homeomorph_on.continuous_on
 
-lemma is_open_map (hf : is_locally_homeomorph f) : is_open_map f :=
+protected lemma is_open_map (hf : is_locally_homeomorph f) : is_open_map f :=
 is_open_map.of_nhds_le (λ x, ge_of_eq (hf.map_nhds_eq x))
 
 protected lemma comp (hg : is_locally_homeomorph g) (hf : is_locally_homeomorph f) :
   is_locally_homeomorph (g ∘ f) :=
-begin
-  intro x,
-  obtain ⟨eg, hxg, rfl⟩ := hg (f x),
-  obtain ⟨ef, hxf, rfl⟩ := hf x,
-  exact ⟨ef.trans eg, ⟨hxf, hxg⟩, rfl⟩,
-end
+is_locally_homeomorph_iff_is_locally_homeomorph_on_univ.mpr
+  (hg.is_locally_homeomorph_on.comp hf.is_locally_homeomorph_on (set.univ.maps_to_univ f))
 
 end is_locally_homeomorph
diff --git a/src/topology/list.lean b/src/topology/list.lean
index 1569325904374..9c9c61c317aa0 100644
--- a/src/topology/list.lean
+++ b/src/topology/list.lean
@@ -8,9 +8,12 @@ import topology.algebra.monoid
 /-!
 # Topology on lists and vectors
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 -/
 open topological_space set filter
-open_locale topological_space filter
+open_locale topology filter
 
 variables {α : Type*} {β : Type*} [topological_space α] [topological_space β]
 
@@ -34,7 +37,7 @@ begin
         { existsi [], simpa only [list.forall₂_nil_left_iff, exists_eq_left] },
       case list.forall₂.cons : a s as ss ht h ih t hts
       { rcases mem_nhds_iff.1 ht with ⟨u, hut, hu⟩,
-        rcases ih (subset.refl _) with ⟨v, hv, hvss⟩,
+        rcases ih _ subset.rfl with ⟨v, hv, hvss⟩,
         exact ⟨u::v, list.forall₂.cons hu hv,
           subset.trans (set.seq_mono (set.image_subset _ hut) hvss) hts⟩ } },
     rcases this with ⟨v, hv, hvs⟩,
diff --git a/src/topology/local_at_target.lean b/src/topology/local_at_target.lean
new file mode 100644
index 0000000000000..9b8b6f5595f81
--- /dev/null
+++ b/src/topology/local_at_target.lean
@@ -0,0 +1,155 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import topology.sets.opens
+
+/-!
+# Properties of maps that are local at the target.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We show that the following properties of continuous maps are local at the target :
+- `inducing`
+- `embedding`
+- `open_embedding`
+- `closed_embedding`
+
+-/
+
+open topological_space set filter
+open_locale topology filter
+
+variables {α β : Type*} [topological_space α] [topological_space β] {f : α → β}
+variables {s : set β} {ι : Type*} {U : ι → opens β} (hU : supr U = ⊤)
+
+lemma set.restrict_preimage_inducing (s : set β) (h : inducing f) :
+  inducing (s.restrict_preimage f) :=
+begin
+  simp_rw [inducing_coe.inducing_iff, inducing_iff_nhds, restrict_preimage, maps_to.coe_restrict,
+    restrict_eq, ← @filter.comap_comap _ _ _ _ coe f] at h ⊢,
+  intros a,
+  rw [← h, ← inducing_coe.nhds_eq_comap],
+end
+
+alias set.restrict_preimage_inducing ← inducing.restrict_preimage
+
+lemma set.restrict_preimage_embedding (s : set β) (h : embedding f) :
+  embedding (s.restrict_preimage f) :=
+⟨h.1.restrict_preimage s, h.2.restrict_preimage s⟩
+
+alias set.restrict_preimage_embedding ← embedding.restrict_preimage
+
+lemma set.restrict_preimage_open_embedding (s : set β) (h : open_embedding f) :
+  open_embedding (s.restrict_preimage f) :=
+⟨h.1.restrict_preimage s,
+  (s.range_restrict_preimage f).symm ▸ continuous_subtype_coe.is_open_preimage _ h.2⟩
+
+alias set.restrict_preimage_open_embedding ← open_embedding.restrict_preimage
+
+lemma set.restrict_preimage_closed_embedding (s : set β) (h : closed_embedding f) :
+  closed_embedding (s.restrict_preimage f) :=
+⟨h.1.restrict_preimage s,
+  (s.range_restrict_preimage f).symm ▸ inducing_coe.is_closed_preimage _ h.2⟩
+
+alias set.restrict_preimage_closed_embedding ← closed_embedding.restrict_preimage
+
+lemma set.restrict_preimage_is_closed_map (s : set β) (H : is_closed_map f)  :
+  is_closed_map (s.restrict_preimage f) :=
+begin
+  rintros t ⟨u, hu, e⟩,
+  refine ⟨⟨_, (H _ (is_open.is_closed_compl hu)).1, _⟩⟩,
+  rw ← (congr_arg has_compl.compl e).trans (compl_compl t),
+  simp only [set.preimage_compl, compl_inj_iff],
+  ext ⟨x, hx⟩,
+  suffices : (∃ y, y ∉ u ∧ f y = x) ↔ ∃ y, f y ∈ s ∧ y ∉ u ∧ f y = x,
+  { simpa [set.restrict_preimage, ← subtype.coe_inj] },
+  exact ⟨λ ⟨a, b, c⟩, ⟨a, c.symm ▸ hx, b, c⟩, λ ⟨a, _, b, c⟩, ⟨a, b, c⟩⟩
+end
+
+include hU
+
+lemma is_open_iff_inter_of_supr_eq_top (s : set β) :
+  is_open s ↔ ∀ i, is_open (s ∩ U i) :=
+begin
+  split,
+  { exact λ H i, H.inter (U i).2 },
+  { intro H,
+    have : (⋃ i, (U i : set β)) = set.univ := by { convert (congr_arg coe hU), simp },
+    rw [← s.inter_univ, ← this, set.inter_Union],
+    exact is_open_Union H }
+end
+
+lemma is_open_iff_coe_preimage_of_supr_eq_top (s : set β) :
+  is_open s ↔ ∀ i, is_open (coe ⁻¹' s : set (U i)) :=
+begin
+  simp_rw [(U _).2.open_embedding_subtype_coe.open_iff_image_open,
+    set.image_preimage_eq_inter_range, subtype.range_coe],
+  apply is_open_iff_inter_of_supr_eq_top,
+  assumption
+end
+
+lemma is_closed_iff_coe_preimage_of_supr_eq_top (s : set β) :
+  is_closed s ↔ ∀ i, is_closed (coe ⁻¹' s : set (U i)) :=
+by simpa using is_open_iff_coe_preimage_of_supr_eq_top hU sᶜ
+
+lemma is_closed_map_iff_is_closed_map_of_supr_eq_top :
+  is_closed_map f ↔ ∀ i, is_closed_map ((U i).1.restrict_preimage f) :=
+begin
+  refine ⟨λ h i, set.restrict_preimage_is_closed_map _ h, _⟩,
+  rintros H s hs,
+  rw is_closed_iff_coe_preimage_of_supr_eq_top hU,
+  intro i,
+  convert H i _ ⟨⟨_, hs.1, eq_compl_comm.mpr rfl⟩⟩,
+  ext ⟨x, hx⟩,
+  suffices : (∃ y, y ∈ s ∧ f y = x) ↔ ∃ y, f y ∈ U i ∧ y ∈ s ∧ f y = x,
+  { simpa [set.restrict_preimage, ← subtype.coe_inj] },
+  exact ⟨λ ⟨a, b, c⟩, ⟨a, c.symm ▸ hx, b, c⟩, λ ⟨a, _, b, c⟩, ⟨a, b, c⟩⟩
+end
+
+lemma inducing_iff_inducing_of_supr_eq_top (h : continuous f) :
+  inducing f ↔ ∀ i, inducing ((U i).1.restrict_preimage f) :=
+begin
+  simp_rw [inducing_coe.inducing_iff, inducing_iff_nhds, restrict_preimage, maps_to.coe_restrict,
+    restrict_eq, ← @filter.comap_comap _ _ _ _ coe f],
+  split,
+  { intros H i x, rw [← H, ← inducing_coe.nhds_eq_comap] },
+  { intros H x,
+    obtain ⟨i, hi⟩ := opens.mem_supr.mp (show f x ∈ supr U, by { rw hU, triv }),
+    erw ← open_embedding.map_nhds_eq (h.1 _ (U i).2).open_embedding_subtype_coe ⟨x, hi⟩,
+    rw [(H i) ⟨x, hi⟩, filter.subtype_coe_map_comap, function.comp_apply, subtype.coe_mk,
+      inf_eq_left, filter.le_principal_iff],
+    exact filter.preimage_mem_comap ((U i).2.mem_nhds hi) }
+end
+
+lemma embedding_iff_embedding_of_supr_eq_top (h : continuous f) :
+  embedding f ↔ ∀ i, embedding ((U i).1.restrict_preimage f) :=
+begin
+  simp_rw embedding_iff,
+  rw forall_and_distrib,
+  apply and_congr,
+  { apply inducing_iff_inducing_of_supr_eq_top; assumption },
+  { apply set.injective_iff_injective_of_Union_eq_univ, convert (congr_arg coe hU), simp }
+end
+
+lemma open_embedding_iff_open_embedding_of_supr_eq_top (h : continuous f) :
+  open_embedding f ↔ ∀ i, open_embedding ((U i).1.restrict_preimage f) :=
+begin
+  simp_rw open_embedding_iff,
+  rw forall_and_distrib,
+  apply and_congr,
+  { apply embedding_iff_embedding_of_supr_eq_top; assumption },
+  { simp_rw set.range_restrict_preimage, apply is_open_iff_coe_preimage_of_supr_eq_top hU }
+end
+
+lemma closed_embedding_iff_closed_embedding_of_supr_eq_top (h : continuous f) :
+  closed_embedding f ↔ ∀ i, closed_embedding ((U i).1.restrict_preimage f) :=
+begin
+  simp_rw closed_embedding_iff,
+  rw forall_and_distrib,
+  apply and_congr,
+  { apply embedding_iff_embedding_of_supr_eq_top; assumption },
+  { simp_rw set.range_restrict_preimage, apply is_closed_iff_coe_preimage_of_supr_eq_top hU }
+end
diff --git a/src/topology/local_extr.lean b/src/topology/local_extr.lean
index ed73d7aeb1c31..4abf12035b58c 100644
--- a/src/topology/local_extr.lean
+++ b/src/topology/local_extr.lean
@@ -9,6 +9,9 @@ import topology.continuous_on
 /-!
 # Local extrema of functions on topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 This file defines special versions of `is_*_filter f a l`, `*=min/max/extr`,
@@ -36,7 +39,7 @@ universes u v w x
 variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x} [topological_space α]
 
 open set filter
-open_locale topological_space filter
+open_locale topology filter
 
 section preorder
 
diff --git a/src/topology/local_homeomorph.lean b/src/topology/local_homeomorph.lean
index a7a47153169bb..0e632d97b7f51 100644
--- a/src/topology/local_homeomorph.lean
+++ b/src/topology/local_homeomorph.lean
@@ -9,6 +9,9 @@ import topology.sets.opens
 /-!
 # Local homeomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines homeomorphisms between open subsets of topological spaces. An element `e` of
 `local_homeomorph α β` is an extension of `local_equiv α β`, i.e., it is a pair of functions
 `e.to_fun` and `e.inv_fun`, inverse of each other on the sets `e.source` and `e.target`.
@@ -43,13 +46,13 @@ then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or
 -/
 
 open function set filter topological_space (second_countable_topology)
-open_locale topological_space
+open_locale topology
 
 variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
 [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
 
 /-- local homeomorphisms, defined on open subsets of the space -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure local_homeomorph (α : Type*) (β : Type*) [topological_space α] [topological_space β]
   extends local_equiv α β :=
 (open_source        : is_open source)
@@ -57,15 +60,6 @@ structure local_homeomorph (α : Type*) (β : Type*) [topological_space α] [top
 (continuous_to_fun  : continuous_on to_fun source)
 (continuous_inv_fun : continuous_on inv_fun target)
 
-/-- A homeomorphism induces a local homeomorphism on the whole space -/
-def homeomorph.to_local_homeomorph (e : α ≃ₜ β) :
-  local_homeomorph α β :=
-{ open_source        := is_open_univ,
-  open_target        := is_open_univ,
-  continuous_to_fun  := by { erw ← continuous_iff_continuous_on_univ, exact e.continuous_to_fun },
-  continuous_inv_fun := by { erw ← continuous_iff_continuous_on_univ, exact e.continuous_inv_fun },
-  ..e.to_equiv.to_local_equiv }
-
 namespace local_homeomorph
 
 variables (e : local_homeomorph α β) (e' : local_homeomorph β γ)
@@ -100,6 +94,9 @@ lemma continuous_on_symm : continuous_on e.symm e.target := e.continuous_inv_fun
 @[simp, mfld_simps] lemma mk_coe_symm (e : local_equiv α β) (a b c d) :
   ((local_homeomorph.mk e a b c d).symm : β → α) = e.symm := rfl
 
+lemma to_local_equiv_injective : injective (to_local_equiv : local_homeomorph α β → local_equiv α β)
+| ⟨e, h₁, h₂, h₃, h₄⟩ ⟨e', h₁', h₂', h₃', h₄'⟩ rfl := rfl
+
 /- Register a few simp lemmas to make sure that `simp` puts the application of a local
 homeomorphism in its normal form, i.e., in terms of its coercion to a function. -/
 
@@ -123,6 +120,9 @@ e.left_inv' h
 @[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
 e.right_inv' h
 
+lemma eq_symm_apply {x : α} {y : β} (hx : x ∈ e.source) (hy : y ∈ e.target) :
+  x = e.symm y ↔ e x = y := e.to_local_equiv.eq_symm_apply hx hy
+
 protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
 protected lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
 protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
@@ -132,6 +132,16 @@ protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
 protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
 protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on
 
+/-- A homeomorphism induces a local homeomorphism on the whole space -/
+@[simps {simp_rhs := tt, .. mfld_cfg}]
+def _root_.homeomorph.to_local_homeomorph (e : α ≃ₜ β) :
+  local_homeomorph α β :=
+{ open_source        := is_open_univ,
+  open_target        := is_open_univ,
+  continuous_to_fun  := by { erw ← continuous_iff_continuous_on_univ, exact e.continuous_to_fun },
+  continuous_inv_fun := by { erw ← continuous_iff_continuous_on_univ, exact e.continuous_inv_fun },
+  ..e.to_equiv.to_local_equiv }
+
 /-- Replace `to_local_equiv` field to provide better definitional equalities. -/
 def replace_equiv (e : local_homeomorph α β) (e' : local_equiv α β) (h : e.to_local_equiv = e') :
   local_homeomorph α β :=
@@ -213,6 +223,12 @@ lemma source_inter_preimage_target_inter (s : set β) :
   e.source ∩ (e ⁻¹' (e.target ∩ s)) = e.source ∩ (e ⁻¹' s) :=
 e.to_local_equiv.source_inter_preimage_target_inter s
 
+lemma image_source_eq_target (e : local_homeomorph α β) : e '' e.source = e.target :=
+e.to_local_equiv.image_source_eq_target
+
+lemma symm_image_target_eq_source (e : local_homeomorph α β) : e.symm '' e.target = e.source :=
+e.symm.image_source_eq_target
+
 /-- Two local homeomorphisms are equal when they have equal `to_fun`, `inv_fun` and `source`.
 It is not sufficient to have equal `to_fun` and `source`, as this only determines `inv_fun` on
 the target. This would only be true for a weaker notion of equality, arguably the right one,
@@ -222,6 +238,10 @@ protected lemma ext (e' : local_homeomorph α β) (h : ∀x, e x = e' x)
   (hinv : ∀x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' :=
 eq_of_local_equiv_eq (local_equiv.ext h hinv hs)
 
+protected lemma ext_iff {e e' : local_homeomorph α β} : e = e' ↔ (∀ x, e x = e' x) ∧
+  (∀ x, e.symm x = e'.symm x) ∧ e.source = e'.source :=
+⟨by { rintro rfl, exact ⟨λ x, rfl, λ x, rfl, rfl⟩ }, λ h, e.ext e' h.1 h.2.1 h.2.2⟩
+
 @[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
 -- The following lemmas are already simp via local_equiv
 lemma symm_source : e.symm.source = e.target := rfl
@@ -230,7 +250,7 @@ lemma symm_target : e.symm.target = e.source := rfl
 
 /-- A local homeomorphism is continuous at any point of its source -/
 protected lemma continuous_at {x : α} (h : x ∈ e.source) : continuous_at e x :=
-(e.continuous_on x h).continuous_at (is_open.mem_nhds e.open_source h)
+(e.continuous_on x h).continuous_at (e.open_source.mem_nhds h)
 
 /-- A local homeomorphism inverse is continuous at any point of its target -/
 lemma continuous_at_symm {x : β} (h : x ∈ e.target) : continuous_at e.symm x :=
@@ -266,6 +286,50 @@ lemma map_nhds_within_preimage_eq (e : local_homeomorph α β) {x} (hx : x ∈ e
 by rw [e.map_nhds_within_eq hx, e.image_source_inter_eq', e.target_inter_inv_preimage_preimage,
   e.nhds_within_target_inter (e.map_source hx)]
 
+lemma eventually_nhds (e : local_homeomorph α β) {x : α} (p : β → Prop)
+  (hx : x ∈ e.source) : (∀ᶠ y in 𝓝 (e x), p y) ↔ ∀ᶠ x in 𝓝 x, p (e x) :=
+iff.trans (by rw [e.map_nhds_eq hx]) eventually_map
+
+lemma eventually_nhds' (e : local_homeomorph α β) {x : α} (p : α → Prop)
+  (hx : x ∈ e.source) : (∀ᶠ y in 𝓝 (e x), p (e.symm y)) ↔ ∀ᶠ x in 𝓝 x, p x :=
+begin
+  rw [e.eventually_nhds _ hx],
+  refine eventually_congr ((e.eventually_left_inverse hx).mono $ λ y hy, _),
+  rw [hy]
+end
+
+lemma eventually_nhds_within (e : local_homeomorph α β) {x : α} (p : β → Prop) {s : set α}
+  (hx : x ∈ e.source) : (∀ᶠ y in 𝓝[e.symm ⁻¹' s] (e x), p y) ↔ ∀ᶠ x in 𝓝[s] x, p (e x) :=
+begin
+  refine iff.trans _ eventually_map,
+  rw [e.map_nhds_within_eq hx, e.image_source_inter_eq', e.nhds_within_target_inter (e.maps_to hx)]
+end
+
+lemma eventually_nhds_within' (e : local_homeomorph α β) {x : α} (p : α → Prop) {s : set α}
+  (hx : x ∈ e.source) : (∀ᶠ y in 𝓝[e.symm ⁻¹' s] (e x), p (e.symm y)) ↔ ∀ᶠ x in 𝓝[s] x, p x :=
+begin
+  rw [e.eventually_nhds_within _ hx],
+  refine eventually_congr ((eventually_nhds_within_of_eventually_nhds $
+    e.eventually_left_inverse hx).mono $ λ y hy, _),
+  rw [hy]
+end
+
+/-- This lemma is useful in the manifold library in the case that `e` is a chart. It states that
+  locally around `e x` the set `e.symm ⁻¹' s` is the same as the set intersected with the target
+  of `e` and some other neighborhood of `f x` (which will be the source of a chart on `γ`).  -/
+lemma preimage_eventually_eq_target_inter_preimage_inter
+  {e : local_homeomorph α β} {s : set α} {t : set γ} {x : α}
+  {f : α → γ} (hf : continuous_within_at f s x) (hxe : x ∈ e.source) (ht : t ∈ 𝓝 (f x)) :
+  e.symm ⁻¹' s =ᶠ[𝓝 (e x)] (e.target ∩ e.symm ⁻¹' (s ∩ f ⁻¹' t) : set β) :=
+begin
+  rw [eventually_eq_set, e.eventually_nhds _ hxe],
+  filter_upwards [(e.open_source.mem_nhds hxe),
+    mem_nhds_within_iff_eventually.mp (hf.preimage_mem_nhds_within ht)],
+  intros y hy hyu,
+  simp_rw [mem_inter_iff, mem_preimage, mem_inter_iff, e.maps_to hy, true_and, iff_self_and,
+    e.left_inv hy, iff_true_intro hyu]
+end
+
 lemma preimage_open_of_open {s : set β} (hs : is_open s) : is_open (e.source ∩ e ⁻¹' s) :=
 e.continuous_on.preimage_open_of_open e.open_source hs
 
@@ -323,27 +387,23 @@ h.symm.image_eq
 lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
 local_equiv.is_image.iff_preimage_eq
 
-alias iff_preimage_eq ↔ local_homeomorph.is_image.preimage_eq
-  local_homeomorph.is_image.of_preimage_eq
+alias iff_preimage_eq ↔ preimage_eq of_preimage_eq
 
 lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
 symm_iff.symm.trans iff_preimage_eq
 
-alias iff_symm_preimage_eq ↔ local_homeomorph.is_image.symm_preimage_eq
-  local_homeomorph.is_image.of_symm_preimage_eq
+alias iff_symm_preimage_eq ↔ symm_preimage_eq of_symm_preimage_eq
 
 lemma iff_symm_preimage_eq' :
   e.is_image s t ↔ e.target ∩ e.symm ⁻¹' (e.source ∩ s) = e.target ∩ t :=
 by rw [iff_symm_preimage_eq, ← image_source_inter_eq, ← image_source_inter_eq']
 
-alias iff_symm_preimage_eq' ↔ local_homeomorph.is_image.symm_preimage_eq'
-  local_homeomorph.is_image.of_symm_preimage_eq'
+alias iff_symm_preimage_eq' ↔ symm_preimage_eq' of_symm_preimage_eq'
 
 lemma iff_preimage_eq' : e.is_image s t ↔ e.source ∩ e ⁻¹' (e.target ∩ t) = e.source ∩ s :=
 symm_iff.symm.trans iff_symm_preimage_eq'
 
-alias iff_preimage_eq' ↔ local_homeomorph.is_image.preimage_eq'
-  local_homeomorph.is_image.of_preimage_eq'
+alias iff_preimage_eq' ↔ preimage_eq' of_preimage_eq'
 
 lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
 local_equiv.is_image.of_image_eq h
@@ -556,12 +616,12 @@ protected def trans' (h : e.target = e'.source) : local_homeomorph α γ :=
 { open_source       := e.open_source,
   open_target       := e'.open_target,
   continuous_to_fun := begin
-    apply continuous_on.comp e'.continuous_to_fun e.continuous_to_fun,
+    apply e'.continuous_to_fun.comp e.continuous_to_fun,
     rw ← h,
     exact e.to_local_equiv.source_subset_preimage_target
   end,
   continuous_inv_fun := begin
-    apply continuous_on.comp e.continuous_inv_fun e'.continuous_inv_fun,
+    apply e.continuous_inv_fun.comp e'.continuous_inv_fun,
     rw h,
     exact e'.to_local_equiv.target_subset_preimage_source
   end,
@@ -577,6 +637,7 @@ protected def trans : local_homeomorph α γ :=
   (e.trans e').to_local_equiv = e.to_local_equiv.trans e'.to_local_equiv := rfl
 @[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
 @[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl
+lemma trans_apply {x : α} : (e.trans e') x = e' (e x) := rfl
 
 lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
 by cases e; cases e'; refl
@@ -646,6 +707,33 @@ lemma restr_trans (s : set α) :
   (e.restr s).trans e' = (e.trans e').restr s :=
 eq_of_local_equiv_eq $ local_equiv.restr_trans e.to_local_equiv e'.to_local_equiv (interior s)
 
+/-- Postcompose a local homeomorphism with an homeomorphism.
+We modify the source and target to have better definitional behavior. -/
+@[simps {fully_applied := ff}]
+def trans_homeomorph (e' : β ≃ₜ γ) : local_homeomorph α γ :=
+{ to_local_equiv := e.to_local_equiv.trans_equiv e'.to_equiv,
+  open_source := e.open_source,
+  open_target := e.open_target.preimage e'.symm.continuous,
+  continuous_to_fun := e'.continuous.comp_continuous_on e.continuous_on,
+  continuous_inv_fun := e.symm.continuous_on.comp e'.symm.continuous.continuous_on (λ x h, h) }
+
+lemma trans_equiv_eq_trans (e' : β ≃ₜ γ) : e.trans_homeomorph e' = e.trans e'.to_local_homeomorph :=
+to_local_equiv_injective $ local_equiv.trans_equiv_eq_trans _ _
+
+/-- Precompose a local homeomorphism with an homeomorphism.
+We modify the source and target to have better definitional behavior. -/
+@[simps {fully_applied := ff}]
+def _root_.homeomorph.trans_local_homeomorph (e : α ≃ₜ β) : local_homeomorph α γ :=
+{ to_local_equiv := e.to_equiv.trans_local_equiv e'.to_local_equiv,
+  open_source := e'.open_source.preimage e.continuous,
+  open_target := e'.open_target,
+  continuous_to_fun := e'.continuous_on.comp e.continuous.continuous_on (λ x h, h),
+  continuous_inv_fun := e.symm.continuous.comp_continuous_on e'.symm.continuous_on }
+
+lemma _root_.homeomorph.trans_local_homeomorph_eq_trans (e : α ≃ₜ β) :
+  e.trans_local_homeomorph e' = e.to_local_homeomorph.trans e' :=
+to_local_equiv_injective $ equiv.trans_local_equiv_eq_trans _ _
+
 /-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. They
 should really be considered the same local equiv. -/
 def eq_on_source (e e' : local_homeomorph α β) : Prop :=
@@ -698,6 +786,19 @@ lemma eq_on_source.restr {e e' : local_homeomorph α β} (he : e ≈ e') (s : se
   e.restr s ≈ e'.restr s :=
 local_equiv.eq_on_source.restr he _
 
+lemma set.eq_on.restr_eq_on_source {e e' : local_homeomorph α β}
+  (h : eq_on e e' (e.source ∩ e'.source)) :
+  e.restr e'.source ≈ e'.restr e.source :=
+begin
+  split,
+  { rw e'.restr_source' _ e.open_source,
+    rw e.restr_source' _ e'.open_source,
+    exact set.inter_comm _ _ },
+  { rw e.restr_source' _ e'.open_source,
+    refine (eq_on.trans _ h).trans _;
+    simp only with mfld_simps },
+end
+
 /-- Composition of a local homeomorphism and its inverse is equivalent to the restriction of the
 identity to the source -/
 lemma trans_self_symm :
@@ -728,6 +829,11 @@ def prod (e : local_homeomorph α β) (e' : local_homeomorph γ δ) :
   (e.prod e').symm = (e.symm.prod e'.symm) :=
 rfl
 
+@[simp]
+lemma refl_prod_refl {α β : Type*} [topological_space α] [topological_space β] :
+  (local_homeomorph.refl α).prod (local_homeomorph.refl β) = local_homeomorph.refl (α × β) :=
+by { ext1 ⟨x, y⟩, { refl }, { rintro ⟨x, y⟩, refl }, exact univ_prod_univ }
+
 @[simp, mfld_simps] lemma prod_trans
   {η : Type*} {ε : Type*} [topological_space η] [topological_space ε]
   (e : local_homeomorph α β) (f : local_homeomorph β γ)
@@ -736,6 +842,25 @@ rfl
 local_homeomorph.eq_of_local_equiv_eq $
   by dsimp only [trans_to_local_equiv, prod_to_local_equiv]; apply local_equiv.prod_trans
 
+lemma prod_eq_prod_of_nonempty {e₁ e₁' : local_homeomorph α β} {e₂ e₂' : local_homeomorph γ δ}
+  (h : (e₁.prod e₂).source.nonempty) :
+  e₁.prod e₂ = e₁'.prod e₂' ↔ e₁ = e₁' ∧ e₂ = e₂' :=
+begin
+  obtain ⟨⟨x, y⟩, -⟩ := id h,
+  haveI : nonempty α := ⟨x⟩,
+  haveI : nonempty β  := ⟨e₁ x⟩,
+  haveI : nonempty γ := ⟨y⟩,
+  haveI : nonempty δ := ⟨e₂ y⟩,
+  simp_rw [local_homeomorph.ext_iff, prod_apply, prod_symm_apply, prod_source, prod.ext_iff,
+    set.prod_eq_prod_iff_of_nonempty h,
+    forall_and_distrib, prod.forall, forall_const, forall_forall_const, and_assoc, and.left_comm]
+end
+
+lemma prod_eq_prod_of_nonempty' {e₁ e₁' : local_homeomorph α β} {e₂ e₂' : local_homeomorph γ δ}
+  (h : (e₁'.prod e₂').source.nonempty) :
+  e₁.prod e₂ = e₁'.prod e₂' ↔ e₁ = e₁' ∧ e₂ = e₂' :=
+by rw [eq_comm, prod_eq_prod_of_nonempty h, eq_comm, @eq_comm _ e₂']
+
 end prod
 
 section piecewise
@@ -782,7 +907,7 @@ def disjoint_union (e e' : local_homeomorph α β)
   local_homeomorph α β :=
 (e.piecewise e' e.source e.target e.is_image_source_target
   (e'.is_image_source_target_of_disjoint e Hs.symm Ht.symm)
-  (by rw [e.open_source.inter_frontier_eq, e'.open_source.inter_frontier_eq_empty_of_disjoint Hs])
+  (by rw [e.open_source.inter_frontier_eq, (Hs.symm.frontier_right e'.open_source).inter_eq])
   (by { rw e.open_source.inter_frontier_eq, exact eq_on_empty _ _ })).replace_equiv
     (e.to_local_equiv.disjoint_union e'.to_local_equiv Hs Ht)
     (local_equiv.disjoint_union_eq_piecewise _ _ _ _).symm
@@ -843,7 +968,7 @@ lemma continuous_within_at_iff_continuous_within_at_comp_left
   {f : γ → α} {s : set γ} {x : γ} (hx : f x ∈ e.source) (h : f ⁻¹' e.source ∈ 𝓝[s] x) :
   continuous_within_at f s x ↔ continuous_within_at (e ∘ f) s x :=
 begin
-  refine ⟨(e.continuous_at hx).tendsto.comp, λ fe_cont, _⟩,
+  refine ⟨(e.continuous_at hx).comp_continuous_within_at, λ fe_cont, _⟩,
   rw [← continuous_within_at_inter' h] at fe_cont ⊢,
   have : continuous_within_at (e.symm ∘ (e ∘ f)) (s ∩ f ⁻¹' e.source) x,
   { have : continuous_within_at e.symm univ (e (f x))
@@ -881,16 +1006,24 @@ end
 
 end continuity
 
+/-- The homeomorphism obtained by restricting a `local_homeomorph` to a subset of the source. -/
+@[simps] def homeomorph_of_image_subset_source
+  {s : set α} {t : set β} (hs : s ⊆ e.source) (ht : e '' s = t) : s ≃ₜ t :=
+{ to_fun := λ a, ⟨e a, (congr_arg ((∈) (e a)) ht).mp ⟨a, a.2, rfl⟩⟩,
+  inv_fun := λ b, ⟨e.symm b, let ⟨a, ha1, ha2⟩ := (congr_arg ((∈) ↑b) ht).mpr b.2 in
+    ha2 ▸ (e.left_inv (hs ha1)).symm ▸ ha1⟩,
+  left_inv := λ a, subtype.ext (e.left_inv (hs a.2)),
+  right_inv := λ b, let ⟨a, ha1, ha2⟩ := (congr_arg ((∈) ↑b) ht).mpr b.2 in
+    subtype.ext (e.right_inv (ha2 ▸ e.map_source (hs ha1))),
+  continuous_to_fun := (continuous_on_iff_continuous_restrict.mp
+    (e.continuous_on.mono hs)).subtype_mk _,
+  continuous_inv_fun := (continuous_on_iff_continuous_restrict.mp
+    (e.continuous_on_symm.mono (λ b hb, let ⟨a, ha1, ha2⟩ := show b ∈ e '' s, from ht.symm ▸ hb in
+      ha2 ▸ e.map_source (hs ha1)))).subtype_mk _ }
+
 /-- A local homeomrphism defines a homeomorphism between its source and target. -/
 def to_homeomorph_source_target : e.source ≃ₜ e.target :=
-{ to_fun := e.maps_to.restrict _ _ _,
-  inv_fun := e.symm_maps_to.restrict _ _ _,
-  left_inv := λ x, subtype.eq $ e.left_inv x.2,
-  right_inv := λ x, subtype.eq $ e.right_inv x.2,
-  continuous_to_fun := continuous_subtype_mk _ $
-    continuous_on_iff_continuous_restrict.1 e.continuous_on,
-  continuous_inv_fun := continuous_subtype_mk _ $
-    continuous_on_iff_continuous_restrict.1 e.symm.continuous_on }
+e.homeomorph_of_image_subset_source subset_rfl e.image_source_eq_target
 
 lemma second_countable_topology_source [second_countable_topology β]
   (e : local_homeomorph α β) :
@@ -939,10 +1072,6 @@ variables (e : α ≃ₜ β) (e' : β ≃ₜ γ)
 /- Register as simp lemmas that the fields of a local homeomorphism built from a homeomorphism
 correspond to the fields of the original homeomorphism. -/
 
-attribute [simps apply source target {simp_rhs := tt, .. mfld_cfg}] to_local_homeomorph
-
-@[simp, mfld_simps] lemma to_local_homeomorph_coe_symm :
-  (e.to_local_homeomorph.symm : β → α) = e.symm := rfl
 @[simp, mfld_simps] lemma refl_to_local_homeomorph :
   (homeomorph.refl α).to_local_homeomorph = local_homeomorph.refl α := rfl
 @[simp, mfld_simps] lemma symm_to_local_homeomorph :
@@ -1017,6 +1146,17 @@ lemma subtype_restr_def : e.subtype_restr s = s.local_homeomorph_subtype_coe.tra
 @[simp, mfld_simps] lemma subtype_restr_source : (e.subtype_restr s).source = coe ⁻¹' e.source :=
 by simp only [subtype_restr_def] with mfld_simps
 
+variables {s}
+
+lemma map_subtype_source {x : s} (hxe : (x:α) ∈ e.source) : e x ∈ (e.subtype_restr s).target :=
+begin
+  refine ⟨e.map_source hxe, _⟩,
+  rw [s.local_homeomorph_subtype_coe_target, mem_preimage, e.left_inv_on hxe],
+  exact x.prop
+end
+
+variables (s)
+
 /- This lemma characterizes the transition functions of an open subset in terms of the transition
 functions of the original space. -/
 lemma subtype_restr_symm_trans_subtype_restr (f f' : local_homeomorph α β) :
@@ -1038,4 +1178,24 @@ begin
   simp only with mfld_simps,
 end
 
+lemma subtype_restr_symm_eq_on_of_le {U V : opens α} [nonempty U] [nonempty V] (hUV : U ≤ V) :
+  eq_on (e.subtype_restr V).symm (set.inclusion hUV ∘ (e.subtype_restr U).symm)
+    (e.subtype_restr U).target :=
+begin
+  set i := set.inclusion hUV,
+  intros y hy,
+  dsimp [local_homeomorph.subtype_restr_def] at ⊢ hy,
+  have hyV : e.symm y ∈ V.local_homeomorph_subtype_coe.target,
+  { rw opens.local_homeomorph_subtype_coe_target at ⊢ hy,
+    exact hUV hy.2 },
+  refine V.local_homeomorph_subtype_coe.inj_on _ trivial _,
+  { rw ←local_homeomorph.symm_target,
+    apply local_homeomorph.map_source,
+    rw local_homeomorph.symm_source,
+    exact hyV },
+  { rw V.local_homeomorph_subtype_coe.right_inv hyV,
+    show _ = U.local_homeomorph_subtype_coe _,
+    rw U.local_homeomorph_subtype_coe.right_inv hy.2 }
+end
+
 end local_homeomorph
diff --git a/src/topology/locally_constant/algebra.lean b/src/topology/locally_constant/algebra.lean
index e811f342f3805..007c2f047bd8b 100644
--- a/src/topology/locally_constant/algebra.lean
+++ b/src/topology/locally_constant/algebra.lean
@@ -3,12 +3,15 @@ Copyright (c) 2021 Johan Commelin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin
 -/
-import algebra.algebra.basic
+import algebra.algebra.pi
 import topology.locally_constant.basic
 
 /-!
 # Algebraic structure on locally constant functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file puts algebraic structure (`add_group`, etc)
 on the type of locally constant functions.
 
@@ -72,6 +75,29 @@ instance [mul_zero_class Y] : mul_zero_class (locally_constant X Y) :=
 instance [mul_zero_one_class Y] : mul_zero_one_class (locally_constant X Y) :=
 { .. locally_constant.mul_zero_class, .. locally_constant.mul_one_class }
 
+section char_fn
+
+variables (Y) [mul_zero_one_class Y] {U V : set X}
+
+/-- Characteristic functions are locally constant functions taking `x : X` to `1` if `x ∈ U`,
+  where `U` is a clopen set, and `0` otherwise. -/
+noncomputable def char_fn (hU : is_clopen U) : locally_constant X Y := indicator 1 hU
+
+lemma coe_char_fn (hU : is_clopen U) : (char_fn Y hU : X → Y) = set.indicator U 1 :=
+rfl
+
+lemma char_fn_eq_one [nontrivial Y] (x : X) (hU : is_clopen U) :
+  char_fn Y hU x = (1 : Y) ↔ x ∈ U := set.indicator_eq_one_iff_mem _
+
+lemma char_fn_eq_zero [nontrivial Y] (x : X) (hU : is_clopen U) :
+  char_fn Y hU x = (0 : Y) ↔ x ∉ U := set.indicator_eq_zero_iff_not_mem _
+
+lemma char_fn_inj [nontrivial Y] (hU : is_clopen U) (hV : is_clopen V)
+  (h : char_fn Y hU = char_fn Y hV) : U = V :=
+set.indicator_one_inj Y $ coe_inj.mpr h
+
+end char_fn
+
 @[to_additive] instance [has_div Y] : has_div (locally_constant X Y) :=
 { div := λ f g, ⟨f / g, f.is_locally_constant.div g.is_locally_constant⟩ }
 
@@ -97,6 +123,12 @@ instance [semigroup_with_zero Y] : semigroup_with_zero (locally_constant X Y) :=
 { mul := (*),
   .. locally_constant.semigroup, .. locally_constant.mul_one_class }
 
+instance [add_monoid_with_one Y] : add_monoid_with_one (locally_constant X Y) :=
+{ nat_cast := λ n, const X n,
+  nat_cast_zero := by ext; simp [nat.cast],
+  nat_cast_succ := λ _, by ext; simp [nat.cast],
+  .. locally_constant.add_monoid, .. locally_constant.has_one }
+
 @[to_additive] instance [comm_monoid Y] : comm_monoid (locally_constant X Y) :=
 { .. locally_constant.comm_semigroup, .. locally_constant.monoid }
 
@@ -121,7 +153,8 @@ instance [non_unital_semiring Y] : non_unital_semiring (locally_constant X Y) :=
 { .. locally_constant.semigroup, .. locally_constant.non_unital_non_assoc_semiring }
 
 instance [non_assoc_semiring Y] : non_assoc_semiring (locally_constant X Y) :=
-{ .. locally_constant.mul_one_class, .. locally_constant.non_unital_non_assoc_semiring }
+{ .. locally_constant.mul_one_class, .. locally_constant.add_monoid_with_one,
+  .. locally_constant.non_unital_non_assoc_semiring }
 
 /-- The constant-function embedding, as a ring hom.  -/
 @[simps] def const_ring_hom [non_assoc_semiring Y] : Y →+* locally_constant X Y :=
@@ -130,8 +163,7 @@ instance [non_assoc_semiring Y] : non_assoc_semiring (locally_constant X Y) :=
   .. const_add_monoid_hom, }
 
 instance [semiring Y] : semiring (locally_constant X Y) :=
-{ .. locally_constant.add_comm_monoid, .. locally_constant.monoid,
-  .. locally_constant.distrib, .. locally_constant.mul_zero_class }
+{ .. locally_constant.non_assoc_semiring, .. locally_constant.monoid }
 
 instance [non_unital_comm_semiring Y] : non_unital_comm_semiring (locally_constant X Y) :=
 { .. locally_constant.non_unital_semiring, .. locally_constant.comm_semigroup }
@@ -160,14 +192,14 @@ instance [comm_ring Y] : comm_ring (locally_constant X Y) :=
 
 variables {R : Type*}
 
-instance [has_scalar R Y] : has_scalar R (locally_constant X Y) :=
+instance [has_smul R Y] : has_smul R (locally_constant X Y) :=
 { smul := λ r f,
   { to_fun := r • f,
-    is_locally_constant := ((is_locally_constant f).comp ((•) r) : _), } }
+    is_locally_constant := (f.is_locally_constant.comp ((•) r) : _), } }
 
-@[simp] lemma coe_smul [has_scalar R Y] (r : R) (f : locally_constant X Y) : ⇑(r • f) = r • f := rfl
+@[simp] lemma coe_smul [has_smul R Y] (r : R) (f : locally_constant X Y) : ⇑(r • f) = r • f := rfl
 
-lemma smul_apply [has_scalar R Y] (r : R) (f : locally_constant X Y) (x : X) :
+lemma smul_apply [has_smul R Y] (r : R) (f : locally_constant X Y) (x : X) :
   (r • f) x = r • (f x) :=
 rfl
 
diff --git a/src/topology/locally_constant/basic.lean b/src/topology/locally_constant/basic.lean
index 3ce3b11d4c509..3a46a0fce005e 100644
--- a/src/topology/locally_constant/basic.lean
+++ b/src/topology/locally_constant/basic.lean
@@ -5,14 +5,17 @@ Authors: Johan Commelin
 -/
 import topology.subset_properties
 import topology.connected
-import topology.algebra.monoid
 import topology.continuous_function.basic
+import algebra.indicator_function
 import tactic.tfae
 import tactic.fin_cases
 
 /-!
 # Locally constant functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file sets up the theory of locally constant function from a topological space to a type.
 
 ## Main definitions and constructions
@@ -28,7 +31,7 @@ This file sets up the theory of locally constant function from a topological spa
 variables {X Y Z α : Type*} [topological_space X]
 
 open set filter
-open_locale topological_space
+open_locale topology
 
 /-- A function between topological spaces is locally constant if the preimage of any set is open. -/
 def is_locally_constant (f : X → Y) : Prop := ∀ s : set Y, is_open (f ⁻¹' s)
@@ -97,10 +100,6 @@ lemma iff_continuous {_ : topological_space Y} [discrete_topology Y] (f : X →
   is_locally_constant f ↔ continuous f :=
 ⟨is_locally_constant.continuous, λ h s, h.is_open_preimage s (is_open_discrete _)⟩
 
-lemma iff_continuous_bot (f : X → Y) :
-  is_locally_constant f ↔ @continuous X Y _ ⊥ f :=
-iff_continuous f
-
 lemma of_constant (f : X → Y) (h : ∀ x y, f x = f y) :
   is_locally_constant f :=
 (iff_eventually_eq f).2 $ λ x, eventually_of_forall $ λ x', h _ _
@@ -141,6 +140,23 @@ begin
   { simpa only [inter_empty, not_nonempty_empty, inter_compl_self] using hs }
 end
 
+lemma apply_eq_of_preconnected_space [preconnected_space X]
+  {f : X → Y} (hf : is_locally_constant f) (x y : X) :
+  f x = f y :=
+hf.apply_eq_of_is_preconnected is_preconnected_univ trivial trivial
+
+lemma eq_const [preconnected_space X] {f : X → Y} (hf : is_locally_constant f) (x : X) :
+  f = function.const X (f x) :=
+funext $ λ y, hf.apply_eq_of_preconnected_space y x
+
+lemma exists_eq_const [preconnected_space X] [nonempty Y] {f : X → Y} (hf : is_locally_constant f) :
+  ∃ y, f = function.const X y :=
+begin
+  casesI is_empty_or_nonempty X,
+  { exact ⟨classical.arbitrary Y, funext $ h.elim⟩ },
+  { exact ⟨f (classical.arbitrary X), hf.eq_const _⟩ },
+end
+
 lemma iff_is_const [preconnected_space X] {f : X → Y} :
   is_locally_constant f ↔ ∀ x y, f x = f y :=
 ⟨λ h x y, h.apply_eq_of_is_preconnected is_preconnected_univ trivial trivial, of_constant _⟩
@@ -148,8 +164,7 @@ lemma iff_is_const [preconnected_space X] {f : X → Y} :
 lemma range_finite [compact_space X] {f : X → Y} (hf : is_locally_constant f) :
   (set.range f).finite :=
 begin
-  letI : topological_space Y := ⊥,
-  haveI : discrete_topology Y := ⟨rfl⟩,
+  letI : topological_space Y := ⊥, haveI := discrete_topology_bot Y,
   rw @iff_continuous X Y ‹_› ‹_› at hf,
   exact (is_compact_range hf).finite_of_discrete
 end
@@ -185,9 +200,24 @@ begin
   apply h,
 end
 
+lemma of_constant_on_connected_components [locally_connected_space X] {f : X → Y}
+  (h : ∀ x, ∀ y ∈ connected_component x, f y = f x) :
+  is_locally_constant f :=
+begin
+  rw iff_exists_open,
+  exact λ x, ⟨connected_component x, is_open_connected_component, mem_connected_component, h x⟩,
+end
+
+lemma of_constant_on_preconnected_clopens [locally_connected_space X] {f : X → Y}
+  (h : ∀ U : set X, is_preconnected U → is_clopen U → ∀ x ∈ U, ∀ y ∈ U, f y = f x) :
+  is_locally_constant f :=
+of_constant_on_connected_components (λ x, h (connected_component x)
+  is_preconnected_connected_component is_clopen_connected_component x mem_connected_component)
+
 end is_locally_constant
 
 /-- A (bundled) locally constant function from a topological space `X` to a type `Y`. -/
+@[protect_proj]
 structure locally_constant (X Y : Type*) [topological_space X] :=
 (to_fun : X → Y)
 (is_locally_constant : is_locally_constant to_fun)
@@ -262,8 +292,8 @@ def of_clopen {X : Type*} [topological_space X] {U : set X} [∀ x, decidable (x
     fin_cases e,
     { convert hU.1 using 1,
       ext,
-      simp only [nat.one_ne_zero, mem_singleton_iff, fin.one_eq_zero_iff,
-        mem_preimage, ite_eq_left_iff],
+      simp only [mem_singleton_iff, fin.one_eq_zero_iff, mem_preimage, ite_eq_left_iff,
+        nat.succ_succ_ne_one],
       tauto },
     { rw ← is_closed_compl_iff,
       convert hU.2,
@@ -275,8 +305,8 @@ def of_clopen {X : Type*} [topological_space X] {U : set X} [∀ x, decidable (x
   [∀ x, decidable (x ∈ U)] (hU : is_clopen U) : of_clopen hU ⁻¹' ({0} : set (fin 2)) = U :=
 begin
   ext,
-  simp only [of_clopen, nat.one_ne_zero, mem_singleton_iff,
-    fin.one_eq_zero_iff, coe_mk, mem_preimage, ite_eq_left_iff],
+  simp only [of_clopen, mem_singleton_iff, fin.one_eq_zero_iff, coe_mk, mem_preimage,
+    ite_eq_left_iff, nat.succ_succ_ne_one],
   tauto,
 end
 
@@ -284,9 +314,8 @@ end
   [∀ x, decidable (x ∈ U)] (hU : is_clopen U) : of_clopen hU ⁻¹' ({1} : set (fin 2)) = Uᶜ :=
 begin
   ext,
-  simp only [of_clopen, nat.one_ne_zero, mem_singleton_iff, coe_mk,
-    fin.zero_eq_one_iff, mem_preimage, ite_eq_right_iff,
-    mem_compl_eq],
+  simp only [of_clopen, mem_singleton_iff, coe_mk, fin.zero_eq_one_iff, mem_preimage,
+    ite_eq_right_iff, mem_compl_iff, nat.succ_succ_ne_one],
   tauto,
 end
 
@@ -426,4 +455,47 @@ lemma coe_desc {X α β : Type*} [topological_space X] (f : X → α) (g : α 
 
 end desc
 
+section indicator
+variables {R : Type*} [has_one R] {U : set X} (f : locally_constant X R)
+open_locale classical
+
+/-- Given a clopen set `U` and a locally constant function `f`, `locally_constant.mul_indicator`
+  returns the locally constant function that is `f` on `U` and `1` otherwise. -/
+@[to_additive /-" Given a clopen set `U` and a locally constant function `f`,
+  `locally_constant.indicator` returns the locally constant function that is `f` on `U` and `0`
+  otherwise. "-/, simps]
+noncomputable def mul_indicator (hU : is_clopen U) :
+  locally_constant X R :=
+{ to_fun := set.mul_indicator U f,
+  is_locally_constant :=
+    begin
+      rw is_locally_constant.iff_exists_open, rintros x,
+      obtain ⟨V, hV, hx, h'⟩ := (is_locally_constant.iff_exists_open _).1 f.is_locally_constant x,
+      by_cases x ∈ U,
+      { refine ⟨U ∩ V, is_open.inter hU.1 hV, set.mem_inter h hx, _⟩, rintros y hy,
+        rw set.mem_inter_iff at hy, rw [set.mul_indicator_of_mem hy.1, set.mul_indicator_of_mem h],
+        apply h' y hy.2, },
+      { rw ←set.mem_compl_iff at h, refine ⟨Uᶜ, (is_clopen.compl hU).1, h, _⟩,
+        rintros y hy, rw set.mem_compl_iff at h, rw set.mem_compl_iff at hy,
+        simp [h, hy], },
+    end, }
+
+variables (a : X)
+
+@[to_additive]
+theorem mul_indicator_apply_eq_if (hU : is_clopen U) :
+  mul_indicator f hU a = if a ∈ U then f a else 1 :=
+set.mul_indicator_apply U f a
+
+variables {a}
+
+@[to_additive]
+theorem mul_indicator_of_mem (hU : is_clopen U) (h : a ∈ U) : f.mul_indicator hU a = f a :=
+by{ rw mul_indicator_apply, apply set.mul_indicator_of_mem h, }
+
+@[to_additive]
+theorem mul_indicator_of_not_mem (hU : is_clopen U) (h : a ∉ U) : f.mul_indicator hU a = 1 :=
+by{ rw mul_indicator_apply, apply set.mul_indicator_of_not_mem h, }
+
+end indicator
 end locally_constant
diff --git a/src/topology/locally_finite.lean b/src/topology/locally_finite.lean
new file mode 100644
index 0000000000000..5d11f12bb8dba
--- /dev/null
+++ b/src/topology/locally_finite.lean
@@ -0,0 +1,219 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.continuous_on
+import order.filter.small_sets
+
+/-!
+### Locally finite families of sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We say that a family of sets in a topological space is *locally finite* if at every point `x : X`,
+there is a neighborhood of `x` which meets only finitely many sets in the family.
+
+In this file we give the definition and prove basic properties of locally finite families of sets.
+-/
+
+/- locally finite family [General Topology (Bourbaki, 1995)] -/
+
+open set function filter
+open_locale topology filter
+
+universe u
+variables {ι : Type u} {ι' α X Y : Type*} [topological_space X] [topological_space Y]
+  {f g : ι → set X}
+
+/-- A family of sets in `set X` is locally finite if at every point `x : X`,
+there is a neighborhood of `x` which meets only finitely many sets in the family. -/
+def locally_finite (f : ι → set X) :=
+∀ x : X, ∃t ∈ 𝓝 x, {i | (f i ∩ t).nonempty}.finite
+
+lemma locally_finite_of_finite [finite ι] (f : ι → set X) : locally_finite f :=
+assume x, ⟨univ, univ_mem, to_finite _⟩
+
+namespace locally_finite
+
+lemma point_finite (hf : locally_finite f) (x : X) : {b | x ∈ f b}.finite :=
+let ⟨t, hxt, ht⟩ := hf x in ht.subset $ λ b hb, ⟨x, hb, mem_of_mem_nhds hxt⟩
+
+protected lemma subset (hf : locally_finite f) (hg : ∀ i, g i ⊆ f i) : locally_finite g :=
+assume a,
+let ⟨t, ht₁, ht₂⟩ := hf a in
+⟨t, ht₁, ht₂.subset $ assume i hi, hi.mono $ inter_subset_inter (hg i) subset.rfl⟩
+
+lemma comp_inj_on {g : ι' → ι} (hf : locally_finite f)
+  (hg : inj_on g {i | (f (g i)).nonempty}) : locally_finite (f ∘ g) :=
+λ x, let ⟨t, htx, htf⟩ := hf x in ⟨t, htx, htf.preimage $ hg.mono $ λ i hi,
+  hi.out.mono $ inter_subset_left _ _⟩
+
+lemma comp_injective {g : ι' → ι} (hf : locally_finite f) (hg : injective g) :
+  locally_finite (f ∘ g) :=
+hf.comp_inj_on (hg.inj_on _)
+
+lemma _root_.locally_finite_iff_small_sets :
+  locally_finite f ↔ ∀ x, ∀ᶠ s in (𝓝 x).small_sets, {i | (f i ∩ s).nonempty}.finite :=
+forall_congr $ λ x, iff.symm $ eventually_small_sets' $ λ s t hst ht, ht.subset $
+  λ i hi, hi.mono $ inter_subset_inter_right _ hst
+
+protected lemma eventually_small_sets (hf : locally_finite f) (x : X) :
+  ∀ᶠ s in (𝓝 x).small_sets, {i | (f i ∩ s).nonempty}.finite :=
+locally_finite_iff_small_sets.mp hf x
+
+lemma exists_mem_basis {ι' : Sort*} (hf : locally_finite f) {p : ι' → Prop}
+  {s : ι' → set X} {x : X} (hb : (𝓝 x).has_basis p s) :
+  ∃ i (hi : p i), {j | (f j ∩ s i).nonempty}.finite :=
+let ⟨i, hpi, hi⟩ := hb.small_sets.eventually_iff.mp (hf.eventually_small_sets x)
+in ⟨i, hpi, hi subset.rfl⟩
+
+protected theorem nhds_within_Union (hf : locally_finite f) (a : X) :
+  𝓝[⋃ i, f i] a = ⨆ i, 𝓝[f i] a :=
+begin
+  rcases hf a with ⟨U, haU, hfin⟩,
+  refine le_antisymm _ (supr_le $ λ i, nhds_within_mono _ (subset_Union _ _)),
+  calc 𝓝[⋃ i, f i] a = 𝓝[⋃ i, f i ∩ U] a :
+    by rw [← Union_inter, ← nhds_within_inter_of_mem' (nhds_within_le_nhds haU)]
+  ... = 𝓝[⋃ i ∈ {j | (f j ∩ U).nonempty}, (f i ∩ U)] a :
+    by simp only [mem_set_of_eq, Union_nonempty_self]
+  ... = ⨆ i ∈ {j | (f j ∩ U).nonempty}, 𝓝[f i ∩ U] a :
+    nhds_within_bUnion hfin _ _
+  ... ≤ ⨆ i, 𝓝[f i ∩ U] a : supr₂_le_supr _ _
+  ... ≤ ⨆ i, 𝓝[f i] a : supr_mono (λ i, nhds_within_mono _ $ inter_subset_left _ _)
+end
+
+lemma continuous_on_Union' {g : X → Y} (hf : locally_finite f)
+  (hc : ∀ i x, x ∈ closure (f i) → continuous_within_at g (f i) x) :
+  continuous_on g (⋃ i, f i) :=
+begin
+  rintro x -,
+  rw [continuous_within_at, hf.nhds_within_Union, tendsto_supr],
+  intro i,
+  by_cases hx : x ∈ closure (f i),
+  { exact hc i _ hx },
+  { rw [mem_closure_iff_nhds_within_ne_bot, not_ne_bot] at hx,
+    rw [hx],
+    exact tendsto_bot }
+end
+
+lemma continuous_on_Union {g : X → Y} (hf : locally_finite f) (h_cl : ∀ i, is_closed (f i))
+  (h_cont : ∀ i, continuous_on g (f i)) :
+  continuous_on g (⋃ i, f i) :=
+hf.continuous_on_Union' $ λ i x hx, h_cont i x $ (h_cl i).closure_subset hx
+
+protected lemma continuous' {g : X → Y} (hf : locally_finite f) (h_cov : (⋃ i, f i) = univ)
+  (hc : ∀ i x, x ∈ closure (f i) → continuous_within_at g (f i) x) :
+  continuous g :=
+continuous_iff_continuous_on_univ.2 $ h_cov ▸ hf.continuous_on_Union' hc
+
+protected lemma continuous {g : X → Y} (hf : locally_finite f) (h_cov : (⋃ i, f i) = univ)
+  (h_cl : ∀ i, is_closed (f i)) (h_cont : ∀ i, continuous_on g (f i)) :
+  continuous g :=
+continuous_iff_continuous_on_univ.2 $ h_cov ▸ hf.continuous_on_Union h_cl h_cont
+
+protected lemma closure (hf : locally_finite f) : locally_finite (λ i, closure (f i)) :=
+begin
+  intro x,
+  rcases hf x with ⟨s, hsx, hsf⟩,
+  refine ⟨interior s, interior_mem_nhds.2 hsx, hsf.subset $ λ i hi, _⟩,
+  exact (hi.mono is_open_interior.closure_inter).of_closure.mono
+    (inter_subset_inter_right _ interior_subset)
+end
+
+lemma closure_Union (h : locally_finite f) : closure (⋃ i, f i) = ⋃ i, closure (f i) :=
+begin
+  ext x,
+  simp only [mem_closure_iff_nhds_within_ne_bot, h.nhds_within_Union, supr_ne_bot, mem_Union]
+end
+
+lemma is_closed_Union (hf : locally_finite f) (hc : ∀ i, is_closed (f i)) :
+  is_closed (⋃ i, f i) :=
+by simp only [← closure_eq_iff_is_closed, hf.closure_Union, (hc _).closure_eq]
+
+/-- If `f : β → set α` is a locally finite family of closed sets, then for any `x : α`, the
+intersection of the complements to `f i`, `x ∉ f i`, is a neighbourhood of `x`. -/
+lemma Inter_compl_mem_nhds (hf : locally_finite f) (hc : ∀ i, is_closed (f i)) (x : X) :
+  (⋂ i (hi : x ∉ f i), (f i)ᶜ) ∈ 𝓝 x :=
+begin
+  refine is_open.mem_nhds _ (mem_Inter₂.2 $ λ i, id),
+  suffices : is_closed (⋃ i : {i // x ∉ f i}, f i),
+    by rwa [← is_open_compl_iff, compl_Union, Inter_subtype] at this,
+  exact (hf.comp_injective subtype.coe_injective).is_closed_Union (λ i, hc _)
+end
+
+/-- Let `f : ℕ → Π a, β a` be a sequence of (dependent) functions on a topological space. Suppose
+that the family of sets `s n = {x | f (n + 1) x ≠ f n x}` is locally finite. Then there exists a
+function `F : Π a, β a` such that for any `x`, we have `f n x = F x` on the product of an infinite
+interval `[N, +∞)` and a neighbourhood of `x`.
+
+We formulate the conclusion in terms of the product of filter `filter.at_top` and `𝓝 x`. -/
+lemma exists_forall_eventually_eq_prod {π : X → Sort*} {f : ℕ → Π x : X, π x}
+  (hf : locally_finite (λ n, {x | f (n + 1) x ≠ f n x})) :
+  ∃ F : Π x : X, π x, ∀ x, ∀ᶠ p : ℕ × X in at_top ×ᶠ 𝓝 x, f p.1 p.2 = F p.2 :=
+begin
+  choose U hUx hU using hf,
+  choose N hN using λ x, (hU x).bdd_above,
+  replace hN : ∀ x (n > N x) (y ∈ U x), f (n + 1) y = f n y,
+    from λ x n hn y hy, by_contra (λ hne, hn.lt.not_le $ hN x ⟨y, hne, hy⟩),
+  replace hN : ∀ x (n ≥ N x + 1) (y ∈ U x), f n y = f (N x + 1) y,
+    from λ x n hn y hy, nat.le_induction rfl (λ k hle, (hN x _ hle _ hy).trans) n hn,
+  refine ⟨λ x, f (N x + 1) x, λ x, _⟩,
+  filter_upwards [filter.prod_mem_prod (eventually_gt_at_top (N x)) (hUx x)],
+  rintro ⟨n, y⟩ ⟨hn : N x < n, hy : y ∈ U x⟩,
+  calc f n y = f (N x + 1) y : hN _ _ hn _ hy
+  ... = f (max (N x + 1) (N y + 1)) y : (hN _ _ (le_max_left _ _) _ hy).symm
+  ... = f (N y + 1) y : hN _ _ (le_max_right _ _) _ (mem_of_mem_nhds $ hUx y)
+end
+
+/-- Let `f : ℕ → Π a, β a` be a sequence of (dependent) functions on a topological space. Suppose
+that the family of sets `s n = {x | f (n + 1) x ≠ f n x}` is locally finite. Then there exists a
+function `F : Π a, β a` such that for any `x`, for sufficiently large values of `n`, we have
+`f n y = F y` in a neighbourhood of `x`. -/
+lemma exists_forall_eventually_at_top_eventually_eq' {π : X → Sort*}
+  {f : ℕ → Π x : X, π x} (hf : locally_finite (λ n, {x | f (n + 1) x ≠ f n x})) :
+  ∃ F : Π x : X, π x, ∀ x, ∀ᶠ n : ℕ in at_top, ∀ᶠ y : X in 𝓝 x, f n y = F y :=
+hf.exists_forall_eventually_eq_prod.imp $ λ F hF x, (hF x).curry
+
+/-- Let `f : ℕ → α → β` be a sequence of functions on a topological space. Suppose
+that the family of sets `s n = {x | f (n + 1) x ≠ f n x}` is locally finite. Then there exists a
+function `F :  α → β` such that for any `x`, for sufficiently large values of `n`, we have
+`f n =ᶠ[𝓝 x] F`. -/
+lemma exists_forall_eventually_at_top_eventually_eq {f : ℕ → X → α}
+  (hf : locally_finite (λ n, {x | f (n + 1) x ≠ f n x})) :
+  ∃ F : X → α, ∀ x, ∀ᶠ n : ℕ in at_top, f n =ᶠ[𝓝 x] F :=
+hf.exists_forall_eventually_at_top_eventually_eq'
+
+lemma preimage_continuous {g : Y → X} (hf : locally_finite f) (hg : continuous g) :
+  locally_finite (λ i, g ⁻¹' (f i)) :=
+λ x, let ⟨s, hsx, hs⟩ := hf (g x)
+  in ⟨g ⁻¹' s, hg.continuous_at hsx, hs.subset $ λ i ⟨y, hy⟩, ⟨g y, hy⟩⟩
+
+end locally_finite
+
+@[simp] lemma equiv.locally_finite_comp_iff (e : ι' ≃ ι) :
+  locally_finite (f ∘ e) ↔ locally_finite f :=
+⟨λ h, by simpa only [(∘), e.apply_symm_apply] using h.comp_injective e.symm.injective,
+  λ h, h.comp_injective e.injective⟩
+
+lemma locally_finite_sum {f : ι ⊕ ι' → set X} :
+  locally_finite f ↔ locally_finite (f ∘ sum.inl) ∧ locally_finite (f ∘ sum.inr) :=
+by simp only [locally_finite_iff_small_sets, ← forall_and_distrib, ← finite_preimage_inl_and_inr,
+  preimage_set_of_eq, (∘), eventually_and]
+
+lemma locally_finite.sum_elim {g : ι' → set X} (hf : locally_finite f) (hg : locally_finite g) :
+  locally_finite (sum.elim f g) :=
+locally_finite_sum.mpr ⟨hf, hg⟩
+
+lemma locally_finite_option {f : option ι → set X} :
+  locally_finite f ↔ locally_finite (f ∘ some) :=
+begin
+  simp only [← (equiv.option_equiv_sum_punit.{u} ι).symm.locally_finite_comp_iff,
+    locally_finite_sum, locally_finite_of_finite, and_true],
+  refl
+end
+
+lemma locally_finite.option_elim (hf : locally_finite f) (s : set X) :
+  locally_finite (option.elim s f) :=
+locally_finite_option.2 hf
diff --git a/src/topology/maps.lean b/src/topology/maps.lean
index 3dcbb381db248..cbd80ed6314c7 100644
--- a/src/topology/maps.lean
+++ b/src/topology/maps.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
 -/
 import topology.order
+import topology.nhds_set
 
 /-!
 # Specific classes of maps between topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file introduces the following properties of a map `f : X → Y` between topological spaces:
 
 * `is_open_map f` means the image of an open set under `f` is open.
@@ -17,7 +21,7 @@ This file introduces the following properties of a map `f : X → Y` between top
 
 * `inducing f` means the topology on `X` is the one induced via `f` from the topology on `Y`.
   These behave like embeddings except they need not be injective. Instead, points of `X` which
-  are identified by `f` are also indistinguishable in the topology on `X`.
+  are identified by `f` are also inseparable in the topology on `X`.
 * `embedding f` means `f` is inducing and also injective. Equivalently, `f` identifies `X` with
   a subspace of `Y`.
 * `open_embedding f` means `f` is an embedding with open image, so it identifies `X` with an
@@ -41,8 +45,8 @@ open map, closed map, embedding, quotient map, identification map
 
 -/
 
-open set filter
-open_locale topological_space filter
+open set filter function
+open_locale topology filter
 
 variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
 
@@ -51,6 +55,7 @@ section inducing
 /-- A function `f : α → β` between topological spaces is inducing if the topology on `α` is induced
 by the topology on `β` through `f`, meaning that a set `s : set α` is open iff it is the preimage
 under `f` of some open set `t : set β`. -/
+@[mk_iff]
 structure inducing [tα : topological_space α] [tβ : topological_space β] (f : α → β) : Prop :=
 (induced : tα = tβ.induced f)
 
@@ -69,9 +74,16 @@ lemma inducing_of_inducing_compose {f : α → β} {g : β → γ} (hf : continu
     (by rwa ← continuous_iff_le_induced)
     (by { rw [hgf.induced, ← continuous_iff_le_induced], apply hg.comp continuous_induced_dom })⟩
 
+lemma inducing_iff_nhds {f : α → β} : inducing f ↔ ∀ a, 𝓝 a = comap f (𝓝 (f a)) :=
+(inducing_iff _).trans (induced_iff_nhds_eq f)
+
 lemma inducing.nhds_eq_comap {f : α → β} (hf : inducing f) :
   ∀ (a : α), 𝓝 a = comap f (𝓝 $ f a) :=
-(induced_iff_nhds_eq f).1 hf.induced
+inducing_iff_nhds.1 hf
+
+lemma inducing.nhds_set_eq_comap {f : α → β} (hf : inducing f) (s : set α) :
+  𝓝ˢ s = comap f (𝓝ˢ (f '' s)) :=
+by simp only [nhds_set, Sup_image, comap_supr, hf.nhds_eq_comap, supr_image]
 
 lemma inducing.map_nhds_eq {f : α → β} (hf : inducing f) (a : α) :
   (𝓝 a).map f = 𝓝[range f] (f a) :=
@@ -125,31 +137,39 @@ lemma inducing.is_closed_iff' {f : α → β} (hf : inducing f) {s : set α} :
   is_closed s ↔ ∀ x, f x ∈ closure (f '' s) → x ∈ s :=
 by rw [hf.induced, is_closed_induced_iff']
 
+lemma inducing.is_closed_preimage {f : α → β} (h : inducing f) (s : set β) (hs : is_closed s) :
+  is_closed (f ⁻¹' s) :=
+(inducing.is_closed_iff h).mpr ⟨s, hs, rfl⟩
+
 lemma inducing.is_open_iff {f : α → β} (hf : inducing f) {s : set α} :
   is_open s ↔ ∃ t, is_open t ∧ f ⁻¹' t = s :=
 by rw [hf.induced, is_open_induced_iff]
 
+lemma inducing.dense_iff {f : α → β} (hf : inducing f) {s : set α} :
+  dense s ↔ ∀ x, f x ∈ closure (f '' s) :=
+by simp only [dense, hf.closure_eq_preimage_closure_image, mem_preimage]
+
 end inducing
 
 section embedding
 
 /-- A function between topological spaces is an embedding if it is injective,
   and for all `s : set α`, `s` is open iff it is the preimage of an open set. -/
-structure embedding [tα : topological_space α] [tβ : topological_space β] (f : α → β)
+@[mk_iff] structure embedding [tα : topological_space α] [tβ : topological_space β] (f : α → β)
   extends inducing f : Prop :=
-(inj : function.injective f)
+(inj : injective f)
 
 lemma function.injective.embedding_induced [t : topological_space β]
-  {f : α → β} (hf : function.injective f) :
-  @embedding α β (t.induced f) t f :=
+  {f : α → β} (hf : injective f) :
+  @_root_.embedding α β (t.induced f) t f :=
 { induced := rfl,
   inj := hf }
 
 variables [topological_space α] [topological_space β] [topological_space γ]
 
-lemma embedding.mk' (f : α → β) (inj : function.injective f)
-  (induced : ∀a, comap f (𝓝 (f a)) = 𝓝 a) : embedding f :=
-⟨⟨(induced_iff_nhds_eq f).2 (λ a, (induced a).symm)⟩, inj⟩
+lemma embedding.mk' (f : α → β) (inj : injective f)
+  (induced : ∀ a, comap f (𝓝 (f a)) = 𝓝 a) : embedding f :=
+⟨inducing_iff_nhds.2 (λ a, (induced a).symm), inj⟩
 
 lemma embedding_id : embedding (@id α) :=
 ⟨inducing_id, assume a₁ a₂ h, h⟩
@@ -165,7 +185,7 @@ lemma embedding_of_embedding_compose {f : α → β} {g : β → γ} (hf : conti
   inj := assume a₁ a₂ h, hgf.inj $ by simp [h, (∘)] }
 
 protected lemma function.left_inverse.embedding {f : α → β} {g : β → α}
-  (h : function.left_inverse f g) (hf : continuous f) (hg : continuous g) :
+  (h : left_inverse f g) (hf : continuous f) (hg : continuous g) :
   embedding g :=
 embedding_of_embedding_compose hg hf $ h.comp_eq_id.symm ▸ embedding_id
 
@@ -193,18 +213,30 @@ lemma embedding.closure_eq_preimage_closure_image {e : α → β} (he : embeddin
   closure s = e ⁻¹' closure (e '' s) :=
 he.1.closure_eq_preimage_closure_image s
 
+/-- The topology induced under an inclusion `f : X → Y` from the discrete topological space `Y`
+is the discrete topology on `X`. -/
+lemma embedding.discrete_topology {X Y : Type*} [topological_space X] [tY : topological_space Y]
+  [discrete_topology Y] {f : X → Y} (hf : embedding f) : discrete_topology X :=
+discrete_topology_iff_nhds.2 $ λ x, by rw [hf.nhds_eq_comap, nhds_discrete, comap_pure,
+  ← image_singleton, hf.inj.preimage_image, principal_singleton]
+
 end embedding
 
 /-- A function between topological spaces is a quotient map if it is surjective,
   and for all `s : set β`, `s` is open iff its preimage is an open set. -/
 def quotient_map {α : Type*} {β : Type*} [tα : topological_space α] [tβ : topological_space β]
   (f : α → β) : Prop :=
-function.surjective f ∧ tβ = tα.coinduced f
+surjective f ∧ tβ = tα.coinduced f
 
-lemma quotient_map_iff {α β : Type*} [topological_space α] [topological_space β] {f : α → β} :
-  quotient_map f ↔ function.surjective f ∧ ∀ s : set β, is_open s ↔ is_open (f ⁻¹' s) :=
+lemma quotient_map_iff [topological_space α] [topological_space β] {f : α → β} :
+  quotient_map f ↔ surjective f ∧ ∀ s : set β, is_open s ↔ is_open (f ⁻¹' s) :=
 and_congr iff.rfl topological_space_eq_iff
 
+lemma quotient_map_iff_closed [topological_space α] [topological_space β] {f : α → β} :
+  quotient_map f ↔ surjective f ∧ ∀ s : set β, is_closed s ↔ is_closed (f ⁻¹' s) :=
+quotient_map_iff.trans $ iff.rfl.and $ compl_surjective.forall.trans $
+  by simp only [is_open_compl_iff, preimage_compl]
+
 namespace quotient_map
 
 variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
@@ -224,6 +256,10 @@ protected lemma of_quotient_map_compose (hf : continuous f) (hg : continuous g)
     (by { rw [hgf.right, ← continuous_iff_coinduced_le], apply continuous_coinduced_rng.comp hf })
     (by rwa ← continuous_iff_coinduced_le)⟩
 
+lemma of_inverse {g : β → α} (hf : continuous f) (hg : continuous g) (h : left_inverse g f) :
+  quotient_map g :=
+quotient_map.of_quotient_map_compose hf hg $ h.comp_eq_id.symm ▸ quotient_map.id
+
 protected lemma continuous_iff (hf : quotient_map f) :
   continuous g ↔ continuous (g ∘ f) :=
 by rw [continuous_iff_coinduced_le, continuous_iff_coinduced_le, hf.right, coinduced_compose]
@@ -231,7 +267,7 @@ by rw [continuous_iff_coinduced_le, continuous_iff_coinduced_le, hf.right, coind
 protected lemma continuous (hf : quotient_map f) : continuous f :=
 hf.continuous_iff.mp continuous_id
 
-protected lemma surjective (hf : quotient_map f) : function.surjective f := hf.1
+protected lemma surjective (hf : quotient_map f) : surjective f := hf.1
 
 protected lemma is_open_preimage (hf : quotient_map f) {s : set β} :
   is_open (f ⁻¹' s) ↔ is_open s :=
@@ -239,7 +275,7 @@ protected lemma is_open_preimage (hf : quotient_map f) {s : set β} :
 
 protected lemma is_closed_preimage (hf : quotient_map f) {s : set β} :
   is_closed (f ⁻¹' s) ↔ is_closed s :=
-by simp only [← is_open_compl_iff, ← preimage_compl, hf.is_open_preimage]
+((quotient_map_iff_closed.1 hf).2 s).symm
 
 end quotient_map
 
@@ -250,7 +286,6 @@ def is_open_map [topological_space α] [topological_space β] (f : α → β) :=
 
 namespace is_open_map
 variables [topological_space α] [topological_space β] [topological_space γ] {f : α → β}
-open function
 
 protected lemma id : is_open_map (@id α) := assume s hs, by rwa [image_id]
 
@@ -266,6 +301,9 @@ lemma image_mem_nhds (hf : is_open_map f) {x : α} {s : set α} (hx : s ∈ 𝓝
 let ⟨t, hts, ht, hxt⟩ := mem_nhds_iff.1 hx in
 mem_of_superset (is_open.mem_nhds (hf t ht) (mem_image_of_mem _ hxt)) (image_subset _ hts)
 
+lemma range_mem_nhds (hf : is_open_map f) (x : α) : range f ∈ 𝓝 (f x) :=
+hf.is_open_range.mem_nhds $ mem_range_self _
+
 lemma maps_to_interior (hf : is_open_map f) {s : set α} {t : set β} (h : maps_to f s t) :
   maps_to f (interior s) (interior t) :=
 maps_to'.2 $ interior_maximal (h.mono interior_subset subset.rfl).image_subset
@@ -342,7 +380,7 @@ lemma is_open_map_iff_nhds_le [topological_space α] [topological_space β] {f :
 
 lemma is_open_map_iff_interior [topological_space α] [topological_space β] {f : α → β} :
   is_open_map f ↔ ∀ s, f '' (interior s) ⊆ interior (f '' s) :=
-⟨is_open_map.image_interior_subset, λ hs u hu, subset_interior_iff_open.mp $
+⟨is_open_map.image_interior_subset, λ hs u hu, subset_interior_iff_is_open.mp $
   calc f '' u = f '' (interior u) : by rw hu.interior_eq
           ... ⊆ interior (f '' u) : hs u⟩
 
@@ -394,6 +432,11 @@ end
 lemma closed_range {f : α → β} (hf : is_closed_map f) : is_closed (range f) :=
 @image_univ _ _ f ▸ hf _ is_closed_univ
 
+lemma to_quotient_map {f : α → β} (hcl : is_closed_map f) (hcont : continuous f)
+  (hsurj : surjective f) : quotient_map f :=
+quotient_map_iff_closed.2
+  ⟨hsurj, λ s, ⟨λ hs, hs.preimage hcont, λ hs, hsurj.image_preimage s ▸ hcl _ hs⟩⟩
+
 end is_closed_map
 
 lemma inducing.is_closed_map [topological_space α] [topological_space β]
@@ -415,7 +458,8 @@ section open_embedding
 variables [topological_space α] [topological_space β] [topological_space γ]
 
 /-- An open embedding is an embedding with open image. -/
-structure open_embedding (f : α → β) extends embedding f : Prop :=
+@[mk_iff]
+structure open_embedding (f : α → β) extends _root_.embedding f : Prop :=
 (open_range : is_open $ range f)
 
 lemma open_embedding.is_open_map {f : α → β} (hf : open_embedding f) : is_open_map f :=
@@ -452,18 +496,23 @@ lemma open_embedding_of_embedding_open {f : α → β} (h₁ : embedding f)
   (h₂ : is_open_map f) : open_embedding f :=
 ⟨h₁, h₂.is_open_range⟩
 
+lemma open_embedding_iff_embedding_open {f : α → β} :
+  open_embedding f ↔ embedding f ∧ is_open_map f :=
+⟨λ h, ⟨h.1, h.is_open_map⟩, λ h, open_embedding_of_embedding_open h.1 h.2⟩
+
 lemma open_embedding_of_continuous_injective_open {f : α → β} (h₁ : continuous f)
-  (h₂ : function.injective f) (h₃ : is_open_map f) : open_embedding f :=
+  (h₂ : injective f) (h₃ : is_open_map f) : open_embedding f :=
 begin
-  refine open_embedding_of_embedding_open ⟨⟨_⟩, h₂⟩ h₃,
-  apply le_antisymm (continuous_iff_le_induced.mp h₁) _,
-  intro s,
-  change is_open _ → is_open _,
-  rw is_open_induced_iff,
-  refine λ hs, ⟨f '' s, h₃ s hs, _⟩,
-  rw preimage_image_eq _ h₂
+  simp only [open_embedding_iff_embedding_open, embedding_iff, inducing_iff_nhds, *, and_true],
+  exact λ a, le_antisymm (h₁.tendsto _).le_comap
+    (@comap_map _ _ (𝓝 a) _ h₂ ▸ comap_mono (h₃.nhds_le _))
 end
 
+lemma open_embedding_iff_continuous_injective_open {f : α → β} :
+  open_embedding f ↔ continuous f ∧ injective f ∧ is_open_map f :=
+⟨λ h, ⟨h.continuous, h.inj, h.is_open_map⟩,
+  λ h, open_embedding_of_continuous_injective_open h.1 h.2.1 h.2.2⟩
+
 lemma open_embedding_id : open_embedding (@id α) :=
 ⟨embedding_id, is_open_map.id.is_open_range⟩
 
@@ -471,21 +520,19 @@ lemma open_embedding.comp {g : β → γ} {f : α → β}
   (hg : open_embedding g) (hf : open_embedding f) : open_embedding (g ∘ f) :=
 ⟨hg.1.comp hf.1, (hg.is_open_map.comp hf.is_open_map).is_open_range⟩
 
-lemma open_embedding_of_open_embedding_compose {α β γ : Type*} [topological_space α]
-  [topological_space β] [topological_space γ] (f : α → β) {g : β → γ} (hg : open_embedding g)
-    (h : open_embedding (g ∘ f)) : open_embedding f :=
-begin
-  have hf := hg.to_embedding.continuous_iff.mpr h.continuous,
-  split,
-  { exact embedding_of_embedding_compose hf hg.continuous h.to_embedding },
-  { rw [hg.open_iff_image_open, ← set.image_univ, ← set.image_comp, ← h.open_iff_image_open],
-    exact is_open_univ }
-end
+lemma open_embedding.is_open_map_iff {g : β → γ} {f : α → β} (hg : open_embedding g) :
+  is_open_map f ↔ is_open_map (g ∘ f) :=
+by simp only [is_open_map_iff_nhds_le, ← @map_map _ _ _ _ f g, ← hg.map_nhds_eq,
+  map_le_map_iff hg.inj]
+
+lemma open_embedding.of_comp_iff (f : α → β) {g : β → γ} (hg : open_embedding g) :
+  open_embedding (g ∘ f) ↔ open_embedding f :=
+by simp only [open_embedding_iff_continuous_injective_open, ← hg.is_open_map_iff,
+  ← hg.1.continuous_iff, hg.inj.of_comp_iff]
 
-lemma open_embedding_iff_open_embedding_compose {α β γ : Type*} [topological_space α]
-  [topological_space β] [topological_space γ] (f : α → β) {g : β → γ} (hg : open_embedding g) :
-    open_embedding (g ∘ f) ↔ open_embedding f :=
-⟨open_embedding_of_open_embedding_compose f hg, hg.comp⟩
+lemma open_embedding.of_comp (f : α → β) {g : β → γ} (hg : open_embedding g)
+  (h : open_embedding (g ∘ f)) : open_embedding f :=
+(open_embedding.of_comp_iff f hg).1 h
 
 end open_embedding
 
@@ -493,7 +540,8 @@ section closed_embedding
 variables [topological_space α] [topological_space β] [topological_space γ]
 
 /-- A closed embedding is an embedding with closed image. -/
-structure closed_embedding (f : α → β) extends embedding f : Prop :=
+@[mk_iff]
+structure closed_embedding (f : α → β) extends _root_.embedding f : Prop :=
 (closed_range : is_closed $ range f)
 
 variables {f : α → β}
@@ -529,7 +577,7 @@ lemma closed_embedding_of_embedding_closed (h₁ : embedding f)
 ⟨h₁, by convert h₂ univ is_closed_univ; simp⟩
 
 lemma closed_embedding_of_continuous_injective_closed (h₁ : continuous f)
-  (h₂ : function.injective f) (h₃ : is_closed_map f) : closed_embedding f :=
+  (h₂ : injective f) (h₃ : is_closed_map f) : closed_embedding f :=
 begin
   refine closed_embedding_of_embedding_closed ⟨⟨_⟩, h₂⟩ h₃,
   apply le_antisymm (continuous_iff_le_induced.mp h₁) _,
@@ -552,7 +600,7 @@ lemma closed_embedding.comp {g : β → γ} {f : α → β}
 
 lemma closed_embedding.closure_image_eq {f : α → β} (hf : closed_embedding f) (s : set α) :
   closure (f '' s) = f '' closure s :=
-le_antisymm (is_closed_map_iff_closure_image.mp hf.is_closed_map _)
+(hf.is_closed_map.closure_image_subset _).antisymm
   (image_closure_subset_closure_image hf.continuous)
 
 end closed_embedding
diff --git a/src/topology/metric_space/algebra.lean b/src/topology/metric_space/algebra.lean
index a825f59d62905..61447d7fef0d7 100644
--- a/src/topology/metric_space/algebra.lean
+++ b/src/topology/metric_space/algebra.lean
@@ -9,6 +9,9 @@ import topology.metric_space.lipschitz
 /-!
 # Compatibility of algebraic operations with metric space structures
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define mixin typeclasses `has_lipschitz_mul`, `has_lipschitz_add`,
 `has_bounded_smul` expressing compatibility of multiplication, addition and scalar-multiplication
 operations with an underlying metric space structure.  The intended use case is to abstract certain
@@ -77,8 +80,8 @@ instance has_lipschitz_mul.has_continuous_mul : has_continuous_mul β :=
     (lipschitz_with_lipschitz_const_mul_edist ⟨x₂.unop, x₁.unop⟩ ⟨y₂.unop, y₁.unop⟩).trans_eq
       (congr_arg _ $ max_comm _ _)⟩ }
 
--- this instance could be deduced from `normed_group.has_lipschitz_add`, but we prove it separately
--- here so that it is available earlier in the hierarchy
+-- this instance could be deduced from `normed_add_comm_group.has_lipschitz_add`, but we prove it
+-- separately here so that it is available earlier in the hierarchy
 instance real.has_lipschitz_add : has_lipschitz_add ℝ :=
 { lipschitz_add := ⟨2, begin
     rw lipschitz_with_iff_dist_le_mul,
@@ -104,7 +107,7 @@ end has_lipschitz_mul
 
 section has_bounded_smul
 
-variables [has_zero α] [has_zero β] [has_scalar α β]
+variables [has_zero α] [has_zero β] [has_smul α β]
 
 /-- Mixin typeclass on a scalar action of a metric space `α` on a metric space `β` both with
 distinguished points `0`, requiring compatibility of the action in the sense that
@@ -168,7 +171,7 @@ instance nnreal.has_bounded_smul : has_bounded_smul ℝ≥0 ℝ≥0 :=
   dist_pair_smul' := λ x₁ x₂ y, by convert dist_pair_smul (x₁:ℝ) x₂ (y:ℝ) using 1 }
 
 /-- If a scalar is central, then its right action is bounded when its left action is. -/
-instance has_bounded_smul.op [has_scalar αᵐᵒᵖ β] [is_central_scalar α β] :
+instance has_bounded_smul.op [has_smul αᵐᵒᵖ β] [is_central_scalar α β] :
   has_bounded_smul αᵐᵒᵖ β :=
 { dist_smul_pair' := mul_opposite.rec $ λ x y₁ y₂,
     by simpa only [op_smul_eq_smul] using dist_smul_pair x y₁ y₂,
@@ -176,3 +179,12 @@ instance has_bounded_smul.op [has_scalar αᵐᵒᵖ β] [is_central_scalar α 
     by simpa only [op_smul_eq_smul] using dist_pair_smul x₁ x₂ y }
 
 end has_bounded_smul
+
+instance [monoid α] [has_lipschitz_mul α] : has_lipschitz_add (additive α) :=
+⟨@has_lipschitz_mul.lipschitz_mul α _ _ _⟩
+
+instance [add_monoid α] [has_lipschitz_add α] : has_lipschitz_mul (multiplicative α) :=
+⟨@has_lipschitz_add.lipschitz_add α _ _ _⟩
+
+@[to_additive] instance [monoid α] [has_lipschitz_mul α] : has_lipschitz_mul αᵒᵈ :=
+‹has_lipschitz_mul α›
diff --git a/src/topology/metric_space/antilipschitz.lean b/src/topology/metric_space/antilipschitz.lean
index 3713842069136..7974ab7cbf9d0 100644
--- a/src/topology/metric_space/antilipschitz.lean
+++ b/src/topology/metric_space/antilipschitz.lean
@@ -9,6 +9,9 @@ import topology.uniform_space.complete_separated
 /-!
 # Antilipschitz functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We say that a map `f : α → β` between two (extended) metric spaces is
 `antilipschitz_with K`, `K ≥ 0`, if for all `x, y` we have `edist x y ≤ K * edist (f x) (f y)`.
 For a metric space, the latter inequality is equivalent to `dist x y ≤ K * dist (f x) (f y)`.
@@ -23,10 +26,10 @@ we do not have a `posreal` type.
 variables {α : Type*} {β : Type*} {γ : Type*}
 
 open_locale nnreal ennreal uniformity
-open set
+open set filter bornology
 
 /-- We say that `f : α → β` is `antilipschitz_with K` if for any two points `x`, `y` we have
-`K * edist x y ≤ edist (f x) (f y)`. -/
+`edist x y ≤ K * edist (f x) (f y)`. -/
 def antilipschitz_with [pseudo_emetric_space α] [pseudo_emetric_space β] (K : ℝ≥0) (f : α → β) :=
 ∀ x y, edist x y ≤ K * edist (f x) (f y)
 
@@ -189,7 +192,8 @@ namespace antilipschitz_with
 
 open metric
 
-variables [pseudo_metric_space α] [pseudo_metric_space β] {K : ℝ≥0} {f : α → β}
+variables [pseudo_metric_space α] [pseudo_metric_space β] [pseudo_metric_space γ]
+variables {K : ℝ≥0} {f : α → β}
 
 lemma bounded_preimage (hf : antilipschitz_with K f)
   {s : set β} (hs : bounded s) :
@@ -198,6 +202,10 @@ exists.intro (K * diam s) $ λ x hx y hy,
 calc dist x y ≤ K * dist (f x) (f y) : hf.le_mul_dist x y
 ... ≤ K * diam s : mul_le_mul_of_nonneg_left (dist_le_diam_of_mem hs hx hy) K.2
 
+lemma tendsto_cobounded (hf : antilipschitz_with K f) : tendsto f (cobounded α) (cobounded β) :=
+compl_surjective.forall.2 $ λ s (hs : is_bounded s), metric.is_bounded_iff.2 $
+  hf.bounded_preimage $ metric.is_bounded_iff.1 hs
+
 /-- The image of a proper space under an expanding onto map is proper. -/
 protected lemma proper_space {α : Type*} [metric_space α] {K : ℝ≥0} {f : α → β} [proper_space α]
   (hK : antilipschitz_with K f) (f_cont : continuous f) (hf : function.surjective f) :
@@ -207,14 +215,43 @@ begin
   let K := f ⁻¹' (closed_ball x₀ r),
   have A : is_closed K := is_closed_ball.preimage f_cont,
   have B : bounded K := hK.bounded_preimage bounded_closed_ball,
-  have : is_compact K := compact_iff_closed_bounded.2 ⟨A, B⟩,
+  have : is_compact K := is_compact_iff_is_closed_bounded.2 ⟨A, B⟩,
   convert this.image f_cont,
   exact (hf.image_preimage _).symm
 end
 
+lemma bounded_of_image2_left (f : α → β → γ) {K₁ : ℝ≥0}
+  (hf : ∀ b, antilipschitz_with K₁ (λ a, f a b))
+  {s : set α} {t : set β} (hst : bounded (set.image2 f s t)) :
+  bounded s ∨ bounded t :=
+begin
+  contrapose! hst,
+  obtain ⟨b, hb⟩ : t.nonempty := nonempty_of_unbounded hst.2,
+  have : ¬bounded (set.image2 f s {b}),
+  { intro h,
+    apply hst.1,
+    rw set.image2_singleton_right at h,
+    replace h := (hf b).bounded_preimage h,
+    refine h.mono (subset_preimage_image _ _) },
+  exact mt (bounded.mono (image2_subset subset.rfl (singleton_subset_iff.mpr hb))) this,
+end
+
+lemma bounded_of_image2_right {f : α → β → γ} {K₂ : ℝ≥0}
+  (hf : ∀ a, antilipschitz_with K₂ (f a))
+  {s : set α} {t : set β} (hst : bounded (set.image2 f s t)) :
+  bounded s ∨ bounded t :=
+or.symm $ bounded_of_image2_left (flip f) hf $ image2_swap f s t ▸ hst
+
 end antilipschitz_with
 
 lemma lipschitz_with.to_right_inverse [pseudo_emetric_space α] [pseudo_emetric_space β] {K : ℝ≥0}
   {f : α → β} (hf : lipschitz_with K f) {g : β → α} (hg : function.right_inverse g f) :
   antilipschitz_with K g :=
 λ x y, by simpa only [hg _] using hf (g x) (g y)
+
+/-- The preimage of a proper space under a Lipschitz homeomorphism is proper. -/
+@[protected]
+theorem lipschitz_with.proper_space [pseudo_metric_space α] [metric_space β] [proper_space β]
+  {K : ℝ≥0} {f : α ≃ₜ β} (hK : lipschitz_with K f) :
+  proper_space α :=
+(hK.to_right_inverse f.right_inv).proper_space f.symm.continuous f.symm.surjective
diff --git a/src/topology/metric_space/baire.lean b/src/topology/metric_space/baire.lean
index af5c86f4bd8f5..21e4a43a3f940 100644
--- a/src/topology/metric_space/baire.lean
+++ b/src/topology/metric_space/baire.lean
@@ -4,12 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import analysis.specific_limits.basic
-import order.filter.countable_Inter
 import topology.G_delta
+import topology.sets.compacts
 
 /-!
 # Baire theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In a complete metric space, a countable intersection of dense open subsets is dense.
 
 The good concept underlying the theorem is that of a Gδ set, i.e., a countable intersection
@@ -18,30 +21,36 @@ intersection of dense Gδ sets is a dense Gδ set. We prove Baire theorem, givin
 formulations that can be handy. We also prove the important consequence that, if the space is
 covered by a countable union of closed sets, then the union of their interiors is dense.
 
-The names of the theorems do not contain the string "Baire", but are instead built from the form of
-the statement. "Baire" is however in the docstring of all the theorems, to facilitate grep searches.
-
-We also define the filter `residual α` generated by dense `Gδ` sets and prove that this filter
-has the countable intersection property.
+We also prove that in Baire spaces, the `residual` sets are exactly those containing a dense Gδ set.
 -/
 
 noncomputable theory
-open_locale classical topological_space filter ennreal
 
-open filter encodable set
+open_locale classical topology filter ennreal
+
+open filter encodable set topological_space
 
 variables {α : Type*} {β : Type*} {γ : Type*} {ι : Type*}
 
 section Baire_theorem
+
 open emetric ennreal
-variables [pseudo_emetric_space α] [complete_space α]
 
-/-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here when
-the source space is ℕ (and subsumed below by `dense_Inter_of_open` working with any
-encodable source space). -/
-theorem dense_Inter_of_open_nat {f : ℕ → set α} (ho : ∀n, is_open (f n))
-  (hd : ∀n, dense (f n)) : dense (⋂n, f n) :=
+/-- The property `baire_space α` means that the topological space `α` has the Baire property:
+any countable intersection of open dense subsets is dense.
+Formulated here when the source space is ℕ (and subsumed below by `dense_Inter_of_open` working
+with any encodable source space).-/
+class baire_space (α : Type*) [topological_space α] : Prop :=
+(baire_property : ∀ f : ℕ → set α, (∀ n, is_open (f n)) → (∀ n, dense (f n)) → dense (⋂n, f n))
+
+/-- Baire theorems asserts that various topological spaces have the Baire property.
+Two versions of these theorems are given.
+The first states that complete pseudo_emetric spaces are Baire. -/
+@[priority 100]
+instance baire_category_theorem_emetric_complete [pseudo_emetric_space α] [complete_space α] :
+  baire_space α :=
 begin
+  refine ⟨λ f ho hd, _⟩,
   let B : ℕ → ℝ≥0∞ := λn, 1/2^n,
   have Bpos : ∀n, 0 < B n,
   { intro n,
@@ -129,13 +138,59 @@ begin
   show edist y x ≤ ε, from le_trans (yball 0) (min_le_left _ _),
 end
 
+/-- The second theorem states that locally compact spaces are Baire. -/
+@[priority 100]
+instance baire_category_theorem_locally_compact [topological_space α] [t2_space α]
+  [locally_compact_space α] :
+  baire_space α :=
+begin
+  constructor,
+  intros f ho hd,
+  /- To prove that an intersection of open dense subsets is dense, prove that its intersection
+  with any open neighbourhood `U` is dense. Define recursively a decreasing sequence `K` of
+  compact neighbourhoods: start with some compact neighbourhood inside `U`, then at each step,
+  take its interior, intersect with `f n`, then choose a compact neighbourhood inside the
+  intersection.-/
+  apply dense_iff_inter_open.2,
+  intros U U_open U_nonempty,
+  rcases exists_positive_compacts_subset U_open U_nonempty with ⟨K₀, hK₀⟩,
+  have : ∀ n (K : positive_compacts α), ∃ K' : positive_compacts α, ↑K' ⊆ f n ∩ interior K,
+  { refine λ n K, exists_positive_compacts_subset ((ho n).inter is_open_interior) _,
+    rw inter_comm,
+    exact (hd n).inter_open_nonempty _ is_open_interior K.interior_nonempty },
+  choose K_next hK_next,
+  let K : ℕ → positive_compacts α := λ n, nat.rec_on n K₀ K_next,
+  /- This is a decreasing sequence of positive compacts contained in suitable open sets `f n`.-/
+  have hK_decreasing : ∀ (n : ℕ), ↑(K (n + 1)) ⊆ f n ∩ K n,
+    from λ n, (hK_next n (K n)).trans $ inter_subset_inter_right _ interior_subset,
+  /- Prove that ̀`⋂ n : ℕ, K n` is inside `U ∩ ⋂ n : ℕ, (f n)`. -/
+  have hK_subset : (⋂ n, K n : set α) ⊆ U ∩ (⋂ n, f n),
+  { intros x hx,
+    simp only [mem_inter_iff, mem_Inter] at hx ⊢,
+    exact ⟨hK₀ $ hx 0, λ n, (hK_decreasing n (hx (n + 1))).1⟩ },
+  /- Prove that `⋂ n : ℕ, K n` is not empty, as an intersection of a decreasing sequence
+  of nonempty compact subsets.-/
+  have hK_nonempty : (⋂ n, K n : set α).nonempty,
+    from is_compact.nonempty_Inter_of_sequence_nonempty_compact_closed _
+      (λ n, (hK_decreasing n).trans (inter_subset_right _ _))
+      (λ n, (K n).nonempty) (K 0).is_compact (λ n, (K n).is_compact.is_closed),
+  exact hK_nonempty.mono hK_subset
+end
+
+variables [topological_space α] [baire_space α]
+
+/-- Definition of a Baire space. -/
+theorem dense_Inter_of_open_nat {f : ℕ → set α} (ho : ∀ n, is_open (f n)) (hd : ∀ n, dense (f n)) :
+  dense (⋂ n, f n) :=
+baire_space.baire_property f ho hd
+
 /-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with ⋂₀. -/
-theorem dense_sInter_of_open {S : set (set α)} (ho : ∀s∈S, is_open s) (hS : countable S)
+theorem dense_sInter_of_open {S : set (set α)} (ho : ∀s∈S, is_open s) (hS : S.countable)
   (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
 begin
   cases S.eq_empty_or_nonempty with h h,
   { simp [h] },
-  { rcases hS.exists_surjective h with ⟨f, hf⟩,
+  { rcases hS.exists_eq_range h with ⟨f, hf⟩,
     have F : ∀n, f n ∈ S := λn, by rw hf; exact mem_range_self _,
     rw [hf, sInter_range],
     exact dense_Inter_of_open_nat (λn, ho _ (F n)) (λn, hd _ (F n)) }
@@ -144,7 +199,7 @@ end
 /-- Baire theorem: a countable intersection of dense open sets is dense. Formulated here with
 an index set which is a countable set in any type. -/
 theorem dense_bInter_of_open {S : set β} {f : β → set α} (ho : ∀s∈S, is_open (f s))
-  (hS : countable S) (hd : ∀s∈S, dense (f s)) : dense (⋂s∈S, f s) :=
+  (hS : S.countable) (hd : ∀s∈S, dense (f s)) : dense (⋂s∈S, f s) :=
 begin
   rw ← sInter_image,
   apply dense_sInter_of_open,
@@ -165,26 +220,38 @@ begin
   { rwa forall_range_iff }
 end
 
-/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with ⋂₀. -/
-theorem dense_sInter_of_Gδ {S : set (set α)} (ho : ∀s∈S, is_Gδ s) (hS : countable S)
-  (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
+/-- A set is residual (comeagre) if and only if it includes a dense `Gδ` set. -/
+lemma mem_residual {s : set α} :
+  s ∈ residual α ↔ ∃ t ⊆ s, is_Gδ t ∧ dense t :=
+begin
+  split,
+  { rw mem_residual_iff,
+    rintros ⟨S, hSo, hSd, Sct, Ss⟩,
+    refine ⟨_, Ss, ⟨_, λ t ht, hSo _ ht, Sct, rfl⟩, _⟩,
+    exact dense_sInter_of_open hSo Sct hSd, },
+  rintros ⟨t, ts, ho, hd⟩,
+  exact mem_of_superset (residual_of_dense_Gδ ho hd) ts,
+end
+
+/-- A property holds on a residual (comeagre) set if and only if it holds on some dense `Gδ` set. -/
+lemma eventually_residual {p : α → Prop} :
+  (∀ᶠ x in residual α, p x) ↔ ∃ (t : set α), is_Gδ t ∧ dense t ∧ ∀ (x : α), x ∈ t → p x :=
 begin
-  -- the result follows from the result for a countable intersection of dense open sets,
-  -- by rewriting each set as a countable intersection of open sets, which are of course dense.
-  choose T hTo hTc hsT using ho,
-  have : ⋂₀ S = ⋂₀ (⋃ s ∈ S, T s ‹_›), -- := (sInter_bUnion (λs hs, (hT s hs).2.2)).symm,
-    by simp only [sInter_Union, (hsT _ _).symm, ← sInter_eq_bInter],
-  rw this,
-  refine dense_sInter_of_open _ (hS.bUnion hTc) _;
-    simp only [mem_Union]; rintro t ⟨s, hs, tTs⟩,
-  show is_open t, from hTo s hs t tTs,
-  show dense t,
-  { intro x,
-    have := hd s hs x,
-    rw hsT s hs at this,
-    exact closure_mono (sInter_subset_of_mem tTs) this }
+  -- this can probably be improved...
+  convert @mem_residual _ _ _ p,
+  simp_rw [exists_prop, and_comm ((_ : set α) ⊆ p), and_assoc],
+  refl,
 end
 
+lemma dense_of_mem_residual {s : set α} (hs : s ∈ residual α) : dense s :=
+let ⟨t, hts, _, hd⟩ := mem_residual.1 hs in hd.mono hts
+
+/-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with ⋂₀. -/
+theorem dense_sInter_of_Gδ {S : set (set α)} (ho : ∀s∈S, is_Gδ s) (hS : S.countable)
+  (hd : ∀s∈S, dense s) : dense (⋂₀S) :=
+dense_of_mem_residual ((countable_sInter_mem hS).mpr
+  (λ s hs, residual_of_dense_Gδ (ho _ hs) (hd _ hs)))
+
 /-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
 an index set which is an encodable type. -/
 theorem dense_Inter_of_Gδ [encodable β] {f : β → set α} (ho : ∀s, is_Gδ (f s))
@@ -197,7 +264,7 @@ end
 /-- Baire theorem: a countable intersection of dense Gδ sets is dense. Formulated here with
 an index set which is a countable set in any type. -/
 theorem dense_bInter_of_Gδ {S : set β} {f : Π x ∈ S, set α} (ho : ∀s∈S, is_Gδ (f s ‹_›))
-  (hS : countable S) (hd : ∀s∈S, dense (f s ‹_›)) : dense (⋂s∈S, f s ‹_›) :=
+  (hS : S.countable) (hd : ∀s∈S, dense (f s ‹_›)) : dense (⋂s∈S, f s ‹_›) :=
 begin
   rw bInter_eq_Inter,
   haveI := hS.to_encodable,
@@ -213,90 +280,67 @@ begin
   apply dense_Inter_of_Gδ; simp [bool.forall_bool, *]
 end
 
-/-- A property holds on a residual (comeagre) set if and only if it holds on some dense `Gδ` set. -/
-lemma eventually_residual {p : α → Prop} :
-  (∀ᶠ x in residual α, p x) ↔ ∃ (t : set α), is_Gδ t ∧ dense t ∧ ∀ x ∈ t, p x :=
-calc (∀ᶠ x in residual α, p x) ↔
-  ∀ᶠ x in ⨅ (t : set α) (ht : is_Gδ t ∧ dense t), 𝓟 t, p x :
-    by simp only [residual, infi_and]
-... ↔ ∃ (t : set α) (ht : is_Gδ t ∧ dense t), ∀ᶠ x in 𝓟 t, p x : mem_binfi_of_directed
-    (λ t₁ h₁ t₂ h₂, ⟨t₁ ∩ t₂, ⟨h₁.1.inter h₂.1, dense.inter_of_Gδ h₁.1 h₂.1 h₁.2 h₂.2⟩, by simp⟩)
-    ⟨univ, is_Gδ_univ, dense_univ⟩
-... ↔ _ : by simp [and_assoc]
-
-/-- A set is residual (comeagre) if and only if it includes a dense `Gδ` set. -/
-lemma mem_residual {s : set α} : s ∈ residual α ↔ ∃ t ⊆ s, is_Gδ t ∧ dense t :=
-(@eventually_residual α _ _ (λ x, x ∈ s)).trans $ exists_congr $
-λ t, by rw [exists_prop, and_comm (t ⊆ s), subset_def, and_assoc]
+/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
+is dense. Formulated here with `⋃`. -/
+lemma is_Gδ.dense_Union_interior_of_closed [encodable ι] {s : set α} (hs : is_Gδ s)
+  (hd : dense s) {f : ι → set α} (hc : ∀ i, is_closed (f i)) (hU : s ⊆ ⋃ i, f i) :
+  dense (⋃ i, interior (f i)) :=
+begin
+  let g := λ i, (frontier (f i))ᶜ,
+  have hgo : ∀ i, is_open (g i), from λ i, is_closed_frontier.is_open_compl,
+  have hgd : dense (⋂ i, g i),
+  { refine dense_Inter_of_open hgo (λ i x, _),
+    rw [closure_compl, interior_frontier (hc _)],
+    exact id },
+  refine (hd.inter_of_Gδ hs (is_Gδ_Inter_of_open $ λ i, hgo i) hgd).mono _,
+  rintro x ⟨hxs, hxg⟩,
+  rw [mem_Inter] at hxg,
+  rcases mem_Union.1 (hU hxs) with ⟨i, hi⟩,
+  exact mem_Union.2 ⟨i, self_diff_frontier (f i) ▸ ⟨hi, hxg _⟩⟩,
+end
 
-lemma dense_of_mem_residual {s : set α} (hs : s ∈ residual α) : dense s :=
-let ⟨t, hts, _, hd⟩ := mem_residual.1 hs in hd.mono hts
+/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
+is dense. Formulated here with a union over a countable set in any type. -/
+lemma is_Gδ.dense_bUnion_interior_of_closed {t : set ι} {s : set α} (hs : is_Gδ s)
+  (hd : dense s) (ht : t.countable) {f : ι → set α} (hc : ∀ i ∈ t, is_closed (f i))
+  (hU : s ⊆ ⋃ i ∈ t, f i) :
+  dense (⋃ i ∈ t, interior (f i)) :=
+begin
+  haveI := ht.to_encodable,
+  simp only [bUnion_eq_Union, set_coe.forall'] at *,
+  exact hs.dense_Union_interior_of_closed hd hc hU
+end
 
-instance : countable_Inter_filter (residual α) :=
-⟨begin
-  intros S hSc hS,
-  simp only [mem_residual] at *,
-  choose T hTs hT using hS,
-  refine ⟨⋂ s ∈ S, T s ‹_›, _, _, _⟩,
-  { rw [sInter_eq_bInter],
-    exact Inter₂_mono hTs },
-  { exact is_Gδ_bInter hSc (λ s hs, (hT s hs).1) },
-  { exact dense_bInter_of_Gδ (λ s hs, (hT s hs).1) hSc (λ s hs, (hT s hs).2) }
-end⟩
+/-- If a countable family of closed sets cover a dense `Gδ` set, then the union of their interiors
+is dense. Formulated here with `⋃₀`. -/
+lemma is_Gδ.dense_sUnion_interior_of_closed {T : set (set α)} {s : set α} (hs : is_Gδ s)
+  (hd : dense s) (hc : T.countable) (hc' : ∀ t ∈ T, is_closed t) (hU : s ⊆ ⋃₀ T) :
+  dense (⋃ t ∈ T, interior t) :=
+hs.dense_bUnion_interior_of_closed hd hc hc' $ by rwa [← sUnion_eq_bUnion]
 
 /-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
 are dense. Formulated here with an index set which is a countable set in any type. -/
 theorem dense_bUnion_interior_of_closed {S : set β} {f : β → set α} (hc : ∀s∈S, is_closed (f s))
-  (hS : countable S) (hU : (⋃s∈S, f s) = univ) : dense (⋃s∈S, interior (f s)) :=
-begin
-  let g := λs, (frontier (f s))ᶜ,
-  have : dense (⋂s∈S, g s),
-  { refine dense_bInter_of_open (λs hs, _) hS (λs hs, _),
-    show is_open (g s), from is_open_compl_iff.2 is_closed_frontier,
-    show dense (g s),
-    { intro x,
-      simp [interior_frontier (hc s hs)] }},
-  refine this.mono _,
-  show (⋂s∈S, g s) ⊆ (⋃s∈S, interior (f s)),
-  assume x hx,
-  have : x ∈ ⋃s∈S, f s, { have := mem_univ x, rwa ← hU at this },
-  rcases mem_Union₂.1 this with ⟨s, hs, xs⟩,
-  have : x ∈ g s := mem_Inter₂.1 hx s hs,
-  have : x ∈ interior (f s),
-  { have : x ∈ f s \ (frontier (f s)) := mem_inter xs this,
-    simpa [frontier, xs, (hc s hs).closure_eq] using this },
-  exact mem_Union₂.2 ⟨s, ⟨hs, this⟩⟩
-end
+  (hS : S.countable) (hU : (⋃s∈S, f s) = univ) : dense (⋃s∈S, interior (f s)) :=
+is_Gδ_univ.dense_bUnion_interior_of_closed dense_univ hS hc hU.ge
 
 /-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
 are dense. Formulated here with `⋃₀`. -/
 theorem dense_sUnion_interior_of_closed {S : set (set α)} (hc : ∀s∈S, is_closed s)
-  (hS : countable S) (hU : (⋃₀ S) = univ) : dense (⋃s∈S, interior s) :=
-by rw sUnion_eq_bUnion at hU; exact dense_bUnion_interior_of_closed hc hS hU
+  (hS : S.countable) (hU : (⋃₀ S) = univ) : dense (⋃s∈S, interior s) :=
+is_Gδ_univ.dense_sUnion_interior_of_closed dense_univ hS hc hU.ge
 
 /-- Baire theorem: if countably many closed sets cover the whole space, then their interiors
 are dense. Formulated here with an index set which is an encodable type. -/
 theorem dense_Union_interior_of_closed [encodable β] {f : β → set α} (hc : ∀s, is_closed (f s))
   (hU : (⋃s, f s) = univ) : dense (⋃s, interior (f s)) :=
-begin
-  rw ← bUnion_univ,
-  apply dense_bUnion_interior_of_closed,
-  { simp [hc] },
-  { apply countable_encodable },
-  { rwa ← bUnion_univ at hU }
-end
+is_Gδ_univ.dense_Union_interior_of_closed dense_univ hc hU.ge
 
 /-- One of the most useful consequences of Baire theorem: if a countable union of closed sets
 covers the space, then one of the sets has nonempty interior. -/
 theorem nonempty_interior_of_Union_of_closed [nonempty α] [encodable β] {f : β → set α}
   (hc : ∀s, is_closed (f s)) (hU : (⋃s, f s) = univ) :
   ∃s, (interior $ f s).nonempty :=
-begin
-  by_contradiction h,
-  simp only [not_exists, not_nonempty_iff_eq_empty] at h,
-  have := calc ∅ = closure (⋃s, interior (f s)) : by simp [h]
-             ... = univ : (dense_Union_interior_of_closed hc hU).closure_eq,
-  exact univ_nonempty.ne_empty this.symm
-end
+by simpa using (dense_Union_interior_of_closed hc hU).nonempty
 
 end Baire_theorem
diff --git a/src/topology/metric_space/basic.lean b/src/topology/metric_space/basic.lean
index 35a6e65f133cd..76e23c4a7f391 100644
--- a/src/topology/metric_space/basic.lean
+++ b/src/topology/metric_space/basic.lean
@@ -4,15 +4,17 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Jeremy Avigad, Robert Y. Lewis, Johannes Hölzl, Mario Carneiro, Sébastien Gouëzel
 -/
 
-import data.int.interval
+import tactic.positivity
 import topology.algebra.order.compact
 import topology.metric_space.emetric_space
-import topology.bornology.basic
-import topology.uniform_space.complete_separated
+import topology.bornology.constructions
 
 /-!
 # Metric spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines metric spaces. Many definitions and theorems expected
 on metric spaces are already introduced on uniform spaces and topological spaces.
 For example: open and closed sets, compactness, completeness, continuity and uniform continuity
@@ -48,34 +50,12 @@ to `metric_space` at the end.
 metric, pseudo_metric, dist
 -/
 
-open set filter topological_space
+open set filter topological_space bornology
 
-open_locale uniformity topological_space big_operators filter nnreal ennreal
+open_locale uniformity topology big_operators filter nnreal ennreal pointwise
 
 universes u v w
-variables {α : Type u} {β : Type v}
-
-/-- Construct a uniform structure core from a distance function and metric space axioms.
-This is a technical construction that can be immediately used to construct a uniform structure
-from a distance function and metric space axioms but is also useful when discussing
-metrizable topologies, see `pseudo_metric_space.of_metrizable`. -/
-def uniform_space.core_of_dist {α : Type*} (dist : α → α → ℝ)
-  (dist_self : ∀ x : α, dist x x = 0)
-  (dist_comm : ∀ x y : α, dist x y = dist y x)
-  (dist_triangle : ∀ x y z : α, dist x z ≤ dist x y + dist y z) : uniform_space.core α :=
-{ uniformity := (⨅ ε>0, 𝓟 {p:α×α | dist p.1 p.2 < ε}),
-  refl       := le_infi $ assume ε, le_infi $
-    by simp [set.subset_def, id_rel, dist_self, (>)] {contextual := tt},
-  comp       := le_infi $ assume ε, le_infi $ assume h, lift'_le
-    (mem_infi_of_mem (ε / 2) $ mem_infi_of_mem (div_pos h zero_lt_two) (subset.refl _)) $
-    have ∀ (a b c : α), dist a c < ε / 2 → dist c b < ε / 2 → dist a b < ε,
-      from assume a b c hac hcb,
-      calc dist a b ≤ dist a c + dist c b : dist_triangle _ _ _
-        ... < ε / 2 + ε / 2 : add_lt_add hac hcb
-        ... = ε : by rw [div_add_div_same, add_self_div_two],
-    by simpa [comp_rel],
-  symm       := tendsto_infi.2 $ assume ε, tendsto_infi.2 $ assume h,
-    tendsto_infi' ε $ tendsto_infi' h $ tendsto_principal_principal.2 $ by simp [dist_comm] }
+variables {α : Type u} {β : Type v} {X ι : Type*}
 
 /-- Construct a uniform structure from a distance function and metric space axioms -/
 def uniform_space_of_dist
@@ -83,21 +63,22 @@ def uniform_space_of_dist
   (dist_self : ∀ x : α, dist x x = 0)
   (dist_comm : ∀ x y : α, dist x y = dist y x)
   (dist_triangle : ∀ x y z : α, dist x z ≤ dist x y + dist y z) : uniform_space α :=
-uniform_space.of_core (uniform_space.core_of_dist dist dist_self dist_comm dist_triangle)
+uniform_space.of_fun dist dist_self dist_comm dist_triangle $ λ ε ε0,
+  ⟨ε / 2, half_pos ε0, λ x hx y hy, add_halves ε ▸ add_lt_add hx hy⟩
 
 /-- This is an internal lemma used to construct a bornology from a metric in `bornology.of_dist`. -/
 private lemma bounded_iff_aux {α : Type*} (dist : α → α → ℝ)
   (dist_comm : ∀ x y : α, dist x y = dist y x)
   (dist_triangle : ∀ x y z : α, dist x z ≤ dist x y + dist y z)
   (s : set α) (a : α) :
-  (∃ c, ∀ ⦃x y⦄, x ∈ s → y ∈ s → dist x y ≤ c) ↔ (∃ r, ∀ ⦃x⦄, x ∈ s → dist x a ≤ r) :=
+  (∃ c, ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → dist x y ≤ c) ↔ (∃ r, ∀ ⦃x⦄, x ∈ s → dist x a ≤ r) :=
 begin
   split; rintro ⟨C, hC⟩,
   { rcases s.eq_empty_or_nonempty with rfl | ⟨x, hx⟩,
     { exact ⟨0, by simp⟩ },
     { exact ⟨C + dist x a, λ y hy,
              (dist_triangle y x a).trans (add_le_add_right (hC hy hx) _)⟩ } },
-  { exact ⟨C + C, λ x y hx hy,
+  { exact ⟨C + C, λ x hx y hy,
            (dist_triangle x a y).trans (add_le_add (hC hx) (by {rw dist_comm, exact hC hy}))⟩ }
 end
 
@@ -108,9 +89,9 @@ def bornology.of_dist {α : Type*} (dist : α → α → ℝ)
   (dist_triangle : ∀ x y z : α, dist x z ≤ dist x y + dist y z) :
   bornology α :=
 bornology.of_bounded
-  { s : set α | ∃ C, ∀ ⦃x y⦄, x ∈ s → y ∈ s → dist x y ≤ C }
-  ⟨0, λ x y hx, hx.elim⟩
-  (λ s ⟨c, hc⟩ t h, ⟨c, λ x y hx hy, hc (h hx) (h hy)⟩)
+  { s : set α | ∃ C, ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → dist x y ≤ C }
+  ⟨0, λ x hx y, hx.elim⟩
+  (λ s ⟨c, hc⟩ t h, ⟨c, λ x hx y hy, hc (h hx) (h hy)⟩)
   (λ s hs t ht,
     begin
       rcases s.eq_empty_or_nonempty with rfl | ⟨z, hz⟩,
@@ -121,7 +102,7 @@ bornology.of_bounded
           (λ hx', (hr₁ hx').trans (le_max_left _ _))
           (λ hx', (hr₂ hx').trans (le_max_right _ _))⟩ }
     end)
-  (λ z, ⟨0, λ x y hx hy,
+  (λ z, ⟨0, λ x hx y hy,
     by { rw [eq_of_mem_singleton hx, eq_of_mem_singleton hy], exact (dist_self z).le }⟩)
 
 /-- The distance function (given an ambient metric space on `α`), which returns
@@ -141,20 +122,22 @@ private theorem pseudo_metric_space.dist_nonneg' {α} {x y : α} (dist : α →
 have 2 * dist x y ≥ 0,
   from calc 2 * dist x y = dist x y + dist y x : by rw [dist_comm x y, two_mul]
     ... ≥ 0 : by rw ← dist_self x; apply dist_triangle,
-nonneg_of_mul_nonneg_left this zero_lt_two
+nonneg_of_mul_nonneg_right this zero_lt_two
 
 /-- This tactic is used to populate `pseudo_metric_space.edist_dist` when the default `edist` is
 used. -/
 protected meta def pseudo_metric_space.edist_dist_tac : tactic unit :=
 tactic.intros >> `[exact (ennreal.of_real_eq_coe_nnreal _).symm <|> control_laws_tac]
 
-/-- Metric space
+/-- Pseudo metric and Metric spaces
 
-Each metric space induces a canonical `uniform_space` and hence a canonical `topological_space`.
-This is enforced in the type class definition, by extending the `uniform_space` structure. When
-instantiating a `metric_space` structure, the uniformity fields are not necessary, they will be
-filled in by default. In the same way, each metric space induces an emetric space structure.
-It is included in the structure, but filled in by default.
+A pseudo metric space is endowed with a distance for which the requirement `d(x,y)=0 → x = y` might
+not hold. A metric space is a pseudo metric space such that `d(x,y)=0 → x = y`.
+Each pseudo metric space induces a canonical `uniform_space` and hence a canonical
+`topological_space` This is enforced in the type class definition, by extending the `uniform_space`
+structure. When instantiating a `pseudo_metric_space` structure, the uniformity fields are not
+necessary, they will be filled in by default. In the same way, each (pseudo) metric space induces a
+(pseudo) emetric space structure. It is included in the structure, but filled in by default.
 -/
 class pseudo_metric_space (α : Type u) extends has_dist α : Type u :=
 (dist_self : ∀ x : α, dist x x = 0)
@@ -168,7 +151,7 @@ class pseudo_metric_space (α : Type u) extends has_dist α : Type u :=
 (uniformity_dist : 𝓤 α = ⨅ ε>0, 𝓟 {p:α×α | dist p.1 p.2 < ε} . control_laws_tac)
 (to_bornology : bornology α := bornology.of_dist dist dist_self dist_comm dist_triangle)
 (cobounded_sets : (bornology.cobounded α).sets =
-  { s | ∃ C, ∀ ⦃x y⦄, x ∈ sᶜ → y ∈ sᶜ → dist x y ≤ C } . control_laws_tac)
+  { s | ∃ C, ∀ ⦃x⦄, x ∈ sᶜ → ∀ ⦃y⦄, y ∈ sᶜ → dist x y ≤ C } . control_laws_tac)
 
 /-- Two pseudo metric space structures with the same distance function coincide. -/
 @[ext] lemma pseudo_metric_space.ext {α : Type*} {m m' : pseudo_metric_space α}
@@ -192,9 +175,8 @@ end
 
 variables [pseudo_metric_space α]
 
-@[priority 100] -- see Note [lower instance priority]
-instance metric_space.to_uniform_space' : uniform_space α :=
-pseudo_metric_space.to_uniform_space
+attribute [priority 100, instance] pseudo_metric_space.to_uniform_space
+attribute [priority 100, instance] pseudo_metric_space.to_bornology
 
 @[priority 200] -- see Note [lower instance priority]
 instance pseudo_metric_space.to_has_edist : has_edist α := ⟨pseudo_metric_space.edist⟩
@@ -202,36 +184,21 @@ instance pseudo_metric_space.to_has_edist : has_edist α := ⟨pseudo_metric_spa
 /-- Construct a pseudo-metric space structure whose underlying topological space structure
 (definitionally) agrees which a pre-existing topology which is compatible with a given distance
 function. -/
-def pseudo_metric_space.of_metrizable {α : Type*} [topological_space α] (dist : α → α → ℝ)
+def pseudo_metric_space.of_dist_topology {α : Type u} [topological_space α] (dist : α → α → ℝ)
   (dist_self : ∀ x : α, dist x x = 0)
   (dist_comm : ∀ x y : α, dist x y = dist y x)
   (dist_triangle : ∀ x y z : α, dist x z ≤ dist x y + dist y z)
   (H : ∀ s : set α, is_open s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s) :
-pseudo_metric_space α :=
+  pseudo_metric_space α :=
 { dist := dist,
   dist_self := dist_self,
   dist_comm := dist_comm,
   dist_triangle := dist_triangle,
-  to_uniform_space := { is_open_uniformity := begin
-    dsimp only [uniform_space.core_of_dist],
-    intros s,
-    change is_open s ↔ _,
-    rw H s,
-    refine forall₂_congr (λ x x_in, _),
-    erw (has_basis_binfi_principal _ nonempty_Ioi).mem_iff,
-    { refine exists₂_congr (λ ε ε_pos, _),
-      simp only [prod.forall, set_of_subset_set_of],
-      split,
-      { rintros h _ y H rfl,
-        exact h y H },
-      { intros h y hxy,
-        exact h _ _ hxy rfl } },
-    { exact λ r (hr : 0 < r) p (hp : 0 < p), ⟨min r p, lt_min hr hp,
-      λ x (hx : dist _ _ < _), lt_of_lt_of_le hx (min_le_left r p),
-      λ x (hx : dist _ _ < _), lt_of_lt_of_le hx (min_le_right r p)⟩ },
-    { apply_instance }
-    end,
-    ..uniform_space.core_of_dist dist dist_self dist_comm dist_triangle },
+  to_uniform_space :=
+  { is_open_uniformity := λ s, (H s).trans $ forall₂_congr $ λ x _,
+      ((uniform_space.has_basis_of_fun (exists_gt (0 : ℝ))
+        dist _ _ _ _).comap (prod.mk x)).mem_iff.symm.trans mem_comap_prod_mk,
+    to_core := (uniform_space_of_dist dist dist_self dist_comm dist_triangle).to_core },
   uniformity_dist := rfl,
   to_bornology := bornology.of_dist dist dist_self dist_comm dist_triangle,
   cobounded_sets := rfl }
@@ -310,6 +277,17 @@ abs_sub_le_iff.2
 theorem dist_nonneg {x y : α} : 0 ≤ dist x y :=
 pseudo_metric_space.dist_nonneg' dist dist_self dist_comm dist_triangle
 
+section
+open tactic tactic.positivity
+
+/-- Extension for the `positivity` tactic: distances are nonnegative. -/
+@[positivity]
+meta def _root_.tactic.positivity_dist : expr → tactic strictness
+| `(dist %%a %%b) := nonnegative <$> mk_app ``dist_nonneg [a, b]
+| _ := failed
+
+end
+
 @[simp] theorem abs_dist {a b : α} : |dist a b| = dist a b :=
 abs_of_nonneg dist_nonneg
 
@@ -403,7 +381,7 @@ def ball (x : α) (ε : ℝ) : set α := {y | dist y x < ε}
 
 @[simp] theorem mem_ball : y ∈ ball x ε ↔ dist y x < ε := iff.rfl
 
-theorem mem_ball' : y ∈ ball x ε ↔ dist x y < ε := by rw dist_comm; refl
+theorem mem_ball' : y ∈ ball x ε ↔ dist x y < ε := by rw [dist_comm, mem_ball]
 
 theorem pos_of_mem_ball (hy : y ∈ ball x ε) : 0 < ε :=
 dist_nonneg.trans_lt hy
@@ -420,6 +398,16 @@ by rw [← not_nonempty_iff_eq_empty, nonempty_ball, not_lt]
 @[simp] lemma ball_zero : ball x 0 = ∅ :=
 by rw [ball_eq_empty]
 
+/-- If a point belongs to an open ball, then there is a strictly smaller radius whose ball also
+contains it.
+
+See also `exists_lt_subset_ball`. -/
+lemma exists_lt_mem_ball_of_mem_ball (h : x ∈ ball y ε) : ∃ ε' < ε, x ∈ ball y ε' :=
+begin
+  simp only [mem_ball] at h ⊢,
+  exact ⟨(ε + dist x y) / 2, by linarith, by linarith⟩,
+end
+
 lemma ball_eq_ball (ε : ℝ) (x : α) :
   uniform_space.ball x {p | dist p.2 p.1 < ε} = metric.ball x ε := rfl
 
@@ -439,14 +427,24 @@ def closed_ball (x : α) (ε : ℝ) := {y | dist y x ≤ ε}
 
 @[simp] theorem mem_closed_ball : y ∈ closed_ball x ε ↔ dist y x ≤ ε := iff.rfl
 
+theorem mem_closed_ball' : y ∈ closed_ball x ε ↔ dist x y ≤ ε := by rw [dist_comm, mem_closed_ball]
+
 /-- `sphere x ε` is the set of all points `y` with `dist y x = ε` -/
 def sphere (x : α) (ε : ℝ) := {y | dist y x = ε}
 
 @[simp] theorem mem_sphere : y ∈ sphere x ε ↔ dist y x = ε := iff.rfl
 
+theorem mem_sphere' : y ∈ sphere x ε ↔ dist x y = ε := by rw [dist_comm, mem_sphere]
+
 theorem ne_of_mem_sphere (h : y ∈ sphere x ε) (hε : ε ≠ 0) : y ≠ x :=
 by { contrapose! hε, symmetry, simpa [hε] using h  }
 
+theorem nonneg_of_mem_sphere (hy : y ∈ sphere x ε) : 0 ≤ ε :=
+dist_nonneg.trans_eq hy
+
+@[simp] theorem sphere_eq_empty_of_neg (hε : ε < 0) : sphere x ε = ∅ :=
+set.eq_empty_iff_forall_not_mem.mpr $ λ y hy, (nonneg_of_mem_sphere hy).not_lt hε
+
 theorem sphere_eq_empty_of_subsingleton [subsingleton α] (hε : ε ≠ 0) :
   sphere x ε = ∅ :=
 set.eq_empty_iff_forall_not_mem.mpr $ λ y hy, ne_of_mem_sphere hy hε (subsingleton.elim _ _)
@@ -455,9 +453,6 @@ theorem sphere_is_empty_of_subsingleton [subsingleton α] (hε : ε ≠ 0) :
   is_empty (sphere x ε) :=
 by simp only [sphere_eq_empty_of_subsingleton hε, set.has_emptyc.emptyc.is_empty α]
 
-theorem mem_closed_ball' : y ∈ closed_ball x ε ↔ dist x y ≤ ε :=
-by { rw dist_comm, refl }
-
 theorem mem_closed_ball_self (h : 0 ≤ ε) : x ∈ closed_ball x ε :=
 show dist x x ≤ ε, by rw dist_self; assumption
 
@@ -467,6 +462,10 @@ show dist x x ≤ ε, by rw dist_self; assumption
 @[simp] lemma closed_ball_eq_empty : closed_ball x ε = ∅ ↔ ε < 0 :=
 by rw [← not_nonempty_iff_eq_empty, nonempty_closed_ball, not_le]
 
+/-- Closed balls and spheres coincide when the radius is non-positive -/
+theorem closed_ball_eq_sphere_of_nonpos (hε : ε ≤ 0) : closed_ball x ε = sphere x ε :=
+set.ext $ λ _, (hε.trans dist_nonneg).le_iff_eq
+
 theorem ball_subset_closed_ball : ball x ε ⊆ closed_ball x ε :=
 assume y (hy : _ < _), le_of_lt hy
 
@@ -474,7 +473,8 @@ theorem sphere_subset_closed_ball : sphere x ε ⊆ closed_ball x ε :=
 λ y, le_of_eq
 
 lemma closed_ball_disjoint_ball (h : δ + ε ≤ dist x y) : disjoint (closed_ball x δ) (ball y ε) :=
-λ a ha, (h.trans $ dist_triangle_left _ _ _).not_lt $ add_lt_add_of_le_of_lt ha.1 ha.2
+set.disjoint_left.mpr $
+  λ a ha1 ha2, (h.trans $ dist_triangle_left _ _ _).not_lt $ add_lt_add_of_le_of_lt ha1 ha2
 
 lemma ball_disjoint_closed_ball (h : δ + ε ≤ dist x y) : disjoint (ball x δ) (closed_ball y ε) :=
 (closed_ball_disjoint_ball $ by rwa [add_comm, dist_comm]).symm
@@ -484,10 +484,11 @@ lemma ball_disjoint_ball (h : δ + ε ≤ dist x y) : disjoint (ball x δ) (ball
 
 lemma closed_ball_disjoint_closed_ball (h : δ + ε < dist x y) :
   disjoint (closed_ball x δ) (closed_ball y ε) :=
-λ a ha, h.not_le $ (dist_triangle_left _ _ _).trans $ add_le_add ha.1 ha.2
+set.disjoint_left.mpr $
+  λ a ha1 ha2, h.not_le $ (dist_triangle_left _ _ _).trans $ add_le_add ha1 ha2
 
 theorem sphere_disjoint_ball : disjoint (sphere x ε) (ball x ε) :=
-λ y ⟨hy₁, hy₂⟩, absurd hy₁ $ ne_of_lt hy₂
+set.disjoint_left.mpr $ λ y hy₁ hy₂, absurd hy₁ $ ne_of_lt hy₂
 
 @[simp] theorem ball_union_sphere : ball x ε ∪ sphere x ε = closed_ball x ε :=
 set.ext $ λ y, (@le_iff_lt_or_eq ℝ _ _ _).symm
@@ -496,17 +497,26 @@ set.ext $ λ y, (@le_iff_lt_or_eq ℝ _ _ _).symm
 by rw [union_comm, ball_union_sphere]
 
 @[simp] theorem closed_ball_diff_sphere : closed_ball x ε \ sphere x ε = ball x ε :=
-by rw [← ball_union_sphere, set.union_diff_cancel_right sphere_disjoint_ball.symm]
+by rw [← ball_union_sphere, set.union_diff_cancel_right sphere_disjoint_ball.symm.le_bot]
 
 @[simp] theorem closed_ball_diff_ball : closed_ball x ε \ ball x ε = sphere x ε :=
-by rw [← ball_union_sphere, set.union_diff_cancel_left sphere_disjoint_ball.symm]
+by rw [← ball_union_sphere, set.union_diff_cancel_left sphere_disjoint_ball.symm.le_bot]
 
 theorem mem_ball_comm : x ∈ ball y ε ↔ y ∈ ball x ε :=
-by simp [dist_comm]
+by rw [mem_ball', mem_ball]
+
+theorem mem_closed_ball_comm : x ∈ closed_ball y ε ↔ y ∈ closed_ball x ε :=
+by rw [mem_closed_ball', mem_closed_ball]
+
+theorem mem_sphere_comm : x ∈ sphere y ε ↔ y ∈ sphere x ε :=
+by rw [mem_sphere', mem_sphere]
 
 theorem ball_subset_ball (h : ε₁ ≤ ε₂) : ball x ε₁ ⊆ ball x ε₂ :=
 λ y (yx : _ < ε₁), lt_of_lt_of_le yx h
 
+lemma closed_ball_eq_bInter_ball : closed_ball x ε = ⋂ δ > ε, ball x δ :=
+by ext y; rw [mem_closed_ball, ← forall_lt_iff_le', mem_Inter₂]; refl
+
 lemma ball_subset_ball' (h : ε₁ + dist x y ≤ ε₂) : ball x ε₁ ⊆ ball y ε₂ :=
 λ z hz, calc
   dist z y ≤ dist z x + dist x y : dist_triangle _ _ _
@@ -528,6 +538,13 @@ theorem closed_ball_subset_ball (h : ε₁ < ε₂) :
   closed_ball x ε₁ ⊆ ball x ε₂ :=
 λ y (yh : dist y x ≤ ε₁), lt_of_le_of_lt yh h
 
+lemma closed_ball_subset_ball' (h : ε₁ + dist x y < ε₂) :
+  closed_ball x ε₁ ⊆ ball y ε₂ :=
+λ z hz, calc
+  dist z y ≤ dist z x + dist x y : dist_triangle _ _ _
+  ... ≤ ε₁ + dist x y : add_le_add_right hz _
+  ... < ε₂ : h
+
 lemma dist_le_add_of_nonempty_closed_ball_inter_closed_ball
   (h : (closed_ball x ε₁ ∩ closed_ball y ε₂).nonempty) :
   dist x y ≤ ε₁ + ε₂ :=
@@ -593,14 +610,35 @@ begin
   exact h _ hR
 end
 
+theorem is_bounded_iff {s : set α} :
+  is_bounded s ↔ ∃ C : ℝ, ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → dist x y ≤ C :=
+by rw [is_bounded_def, ← filter.mem_sets, (@pseudo_metric_space.cobounded_sets α _).out,
+  mem_set_of_eq, compl_compl]
+
+theorem is_bounded_iff_eventually {s : set α} :
+  is_bounded s ↔ ∀ᶠ C in at_top, ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → dist x y ≤ C :=
+is_bounded_iff.trans ⟨λ ⟨C, h⟩, eventually_at_top.2 ⟨C, λ C' hC' x hx y hy, (h hx hy).trans hC'⟩,
+  eventually.exists⟩
+
+theorem is_bounded_iff_exists_ge {s : set α} (c : ℝ) :
+  is_bounded s ↔ ∃ C, c ≤ C ∧ ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → dist x y ≤ C :=
+⟨λ h, ((eventually_ge_at_top c).and (is_bounded_iff_eventually.1 h)).exists,
+  λ h, is_bounded_iff.2 $ h.imp $ λ _, and.right⟩
+
+theorem is_bounded_iff_nndist {s : set α} :
+  is_bounded s ↔ ∃ C : ℝ≥0, ∀ ⦃x⦄, x ∈ s → ∀ ⦃y⦄, y ∈ s → nndist x y ≤ C :=
+by simp only [is_bounded_iff_exists_ge 0, nnreal.exists, ← nnreal.coe_le_coe, ← dist_nndist,
+  nnreal.coe_mk, exists_prop]
+
+theorem to_uniform_space_eq : ‹pseudo_metric_space α›.to_uniform_space =
+  uniform_space_of_dist dist dist_self dist_comm dist_triangle :=
+uniform_space_eq pseudo_metric_space.uniformity_dist
+
 theorem uniformity_basis_dist :
   (𝓤 α).has_basis (λ ε : ℝ, 0 < ε) (λ ε, {p:α×α | dist p.1 p.2 < ε}) :=
 begin
-  rw ← pseudo_metric_space.uniformity_dist.symm,
-  refine has_basis_binfi_principal _ nonempty_Ioi,
-  exact λ r (hr : 0 < r) p (hp : 0 < p), ⟨min r p, lt_min hr hp,
-     λ x (hx : dist _ _ < _), lt_of_lt_of_le hx (min_le_left r p),
-     λ x (hx : dist _ _ < _), lt_of_lt_of_le hx (min_le_right r p)⟩
+  rw [to_uniform_space_eq],
+  exact uniform_space.has_basis_of_fun (exists_gt _) _ _ _ _ _
 end
 
 /-- Given `f : β → ℝ`, if `f` sends `{i | p i}` to a set of positive numbers
@@ -620,6 +658,11 @@ begin
   { exact λ ⟨i, hi, H⟩, ⟨f i, hf₀ i hi, H⟩ }
 end
 
+theorem uniformity_basis_dist_rat :
+  (𝓤 α).has_basis (λ r : ℚ, 0 < r) (λ r, {p : α × α | dist p.1 p.2 < r}) :=
+metric.mk_uniformity_basis (λ _, rat.cast_pos.2) $ λ ε hε,
+  let ⟨r, hr0, hrε⟩ := exists_rat_btwn hε in ⟨r, rat.cast_pos.1 hr0, hrε.le⟩
+
 theorem uniformity_basis_dist_inv_nat_succ :
   (𝓤 α).has_basis (λ _, true) (λ n:ℕ, {p:α×α | dist p.1 p.2 < 1 / (↑n+1) }) :=
 metric.mk_uniformity_basis (λ n _, div_pos zero_lt_one $ nat.cast_add_one_pos n)
@@ -628,7 +671,8 @@ metric.mk_uniformity_basis (λ n _, div_pos zero_lt_one $ nat.cast_add_one_pos n
 theorem uniformity_basis_dist_inv_nat_pos :
   (𝓤 α).has_basis (λ n:ℕ, 0 0, ∃ ε > 0, ∀ {a b : α}, dist (f a) (f b) < ε → dist a b < δ :=
-uniform_embedding_def'.trans $ and_congr iff.rfl $ and_congr iff.rfl
-⟨λ H δ δ0, let ⟨t, tu, ht⟩ := H _ (dist_mem_uniformity δ0),
-               ⟨ε, ε0, hε⟩ := mem_uniformity_dist.1 tu in
-  ⟨ε, ε0, λ a b h, ht _ _ (hε h)⟩,
- λ H s su, let ⟨δ, δ0, hδ⟩ := mem_uniformity_dist.1 su, ⟨ε, ε0, hε⟩ := H _ δ0 in
-  ⟨_, dist_mem_uniformity ε0, λ a b h, hδ (hε h)⟩⟩
+begin
+  simp only [uniformity_basis_dist.uniform_embedding_iff uniformity_basis_dist, exists_prop],
+  refl
+end
 
 /-- If a map between pseudometric spaces is a uniform embedding then the distance between `f x`
 and `f y` is controlled in terms of the distance between `x` and `y`. -/
@@ -715,7 +757,7 @@ begin
 end
 
 theorem totally_bounded_iff {s : set α} :
-  totally_bounded s ↔ ∀ ε > 0, ∃t : set α, finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
+  totally_bounded s ↔ ∀ ε > 0, ∃t : set α, t.finite ∧ s ⊆ ⋃y∈t, ball y ε :=
 ⟨λ H ε ε0, H _ (dist_mem_uniformity ε0),
  λ H r ru, let ⟨ε, ε0, hε⟩ := mem_uniformity_dist.1 ru,
                ⟨t, ft, h⟩ := H ε ε0 in
@@ -744,13 +786,24 @@ begin
 end
 
 theorem finite_approx_of_totally_bounded {s : set α} (hs : totally_bounded s) :
-  ∀ ε > 0, ∃ t ⊆ s, finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
+  ∀ ε > 0, ∃ t ⊆ s, set.finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
 begin
   intros ε ε_pos,
   rw totally_bounded_iff_subset at hs,
   exact hs _ (dist_mem_uniformity ε_pos),
 end
 
+/-- Expressing uniform convergence using `dist` -/
+lemma tendsto_uniformly_on_filter_iff {ι : Type*}
+  {F : ι → β → α} {f : β → α} {p : filter ι} {p' : filter β} :
+  tendsto_uniformly_on_filter F f p p' ↔
+  ∀ ε > 0, ∀ᶠ (n : ι × β) in (p ×ᶠ p'), dist (f n.snd) (F n.fst n.snd) < ε :=
+begin
+  refine ⟨λ H ε hε, H _ (dist_mem_uniformity hε), λ H u hu, _⟩,
+  rcases mem_uniformity_dist.1 hu with ⟨ε, εpos, hε⟩,
+  refine (H ε εpos).mono (λ n hn, hε hn),
+end
+
 /-- Expressing locally uniform convergence on a set using `dist`. -/
 lemma tendsto_locally_uniformly_on_iff {ι : Type*} [topological_space β]
   {F : ι → β → α} {f : β → α} {p : filter ι} {s : set β} :
@@ -805,6 +858,30 @@ lemma eventually_nhds_iff_ball {p : α → Prop} :
   (∀ᶠ y in 𝓝 x, p y) ↔ ∃ ε>0, ∀ y ∈ ball x ε, p y :=
 mem_nhds_iff
 
+/-- A version of `filter.eventually_prod_iff` where the second filter consists of neighborhoods
+in a pseudo-metric space.-/
+lemma eventually_prod_nhds_iff {f : filter ι} {x₀ : α} {p : ι × α → Prop}:
+  (∀ᶠ x in f ×ᶠ 𝓝 x₀, p x) ↔ ∃ (pa : ι → Prop) (ha : ∀ᶠ i in f, pa i) (ε > 0),
+    ∀ {i}, pa i → ∀ {x}, dist x x₀ < ε → p (i, x) :=
+begin
+  simp_rw [eventually_prod_iff, metric.eventually_nhds_iff],
+  refine exists_congr (λ q, exists_congr $ λ hq, _),
+  split,
+  { rintro ⟨r, ⟨ε, hε, hεr⟩, hp⟩, exact ⟨ε, hε, λ i hi x hx, hp hi $ hεr hx⟩ },
+  { rintro ⟨ε, hε, hp⟩, exact ⟨λ x, dist x x₀ < ε, ⟨ε, hε, λ y, id⟩, @hp⟩ }
+end
+
+/-- A version of `filter.eventually_prod_iff` where the first filter consists of neighborhoods
+in a pseudo-metric space.-/
+lemma eventually_nhds_prod_iff {ι α} [pseudo_metric_space α] {f : filter ι} {x₀ : α}
+  {p : α × ι → Prop}:
+  (∀ᶠ x in 𝓝 x₀ ×ᶠ f, p x) ↔ ∃ (ε > (0 : ℝ)) (pa : ι → Prop) (ha : ∀ᶠ i in f, pa i) ,
+    ∀ {x}, dist x x₀ < ε → ∀ {i}, pa i → p (x, i) :=
+begin
+  rw [eventually_swap_iff, metric.eventually_prod_nhds_iff],
+  split; { rintro ⟨a1, a2, a3, a4, a5⟩, refine ⟨a3, a4, a1, a2, λ b1 b2 b3 b4, a5 b4 b2⟩ }
+end
+
 theorem nhds_basis_closed_ball : (𝓝 x).has_basis (λ ε:ℝ, 0 < ε) (closed_ball x) :=
 nhds_basis_uniformity uniformity_basis_dist_le
 
@@ -1022,12 +1099,16 @@ by { convert metric.emetric_closed_ball ε.2, simp }
 @[simp] lemma metric.emetric_ball_top (x : α) : emetric.ball x ⊤ = univ :=
 eq_univ_of_forall $ λ y, edist_lt_top _ _
 
+lemma metric.inseparable_iff {x y : α} : inseparable x y ↔ dist x y = 0 :=
+by rw [emetric.inseparable_iff, edist_nndist, dist_nndist, ennreal.coe_eq_zero,
+  nnreal.coe_eq_zero]
+
 /-- Build a new pseudometric space from an old one where the bundled uniform structure is provably
 (but typically non-definitionaly) equal to some given uniform structure.
 See Note [forgetful inheritance].
 -/
 def pseudo_metric_space.replace_uniformity {α} [U : uniform_space α] (m : pseudo_metric_space α)
-  (H : @uniformity _ U = @uniformity _ pseudo_emetric_space.to_uniform_space') :
+  (H : 𝓤[U] = 𝓤[pseudo_emetric_space.to_uniform_space]) :
   pseudo_metric_space α :=
 { dist               := @dist _ m.to_has_dist,
   dist_self          := dist_self,
@@ -1039,11 +1120,24 @@ def pseudo_metric_space.replace_uniformity {α} [U : uniform_space α] (m : pseu
   uniformity_dist    := H.trans pseudo_metric_space.uniformity_dist }
 
 lemma pseudo_metric_space.replace_uniformity_eq {α} [U : uniform_space α]
-  (m : pseudo_metric_space α)
-  (H : @uniformity _ U = @uniformity _ pseudo_emetric_space.to_uniform_space') :
+  (m : pseudo_metric_space α) (H : 𝓤[U] = 𝓤[pseudo_emetric_space.to_uniform_space]) :
   m.replace_uniformity H = m :=
 by { ext, refl }
 
+/-- Build a new pseudo metric space from an old one where the bundled topological structure is
+provably (but typically non-definitionaly) equal to some given topological structure.
+See Note [forgetful inheritance].
+-/
+@[reducible] def pseudo_metric_space.replace_topology {γ} [U : topological_space γ]
+  (m : pseudo_metric_space γ) (H : U = m.to_uniform_space.to_topological_space) :
+  pseudo_metric_space γ :=
+@pseudo_metric_space.replace_uniformity γ (m.to_uniform_space.replace_topology H) m rfl
+
+lemma pseudo_metric_space.replace_topology_eq {γ} [U : topological_space γ]
+  (m : pseudo_metric_space γ) (H : U = m.to_uniform_space.to_topological_space) :
+  m.replace_topology H = m :=
+by { ext, refl }
+
 /-- One gets a pseudometric space from an emetric space if the edistance
 is everywhere finite, by pushing the edistance to reals. We set it up so that the edist and the
 uniformity are defeq in the pseudometric space and the pseudoemetric space. In this definition, the
@@ -1065,8 +1159,8 @@ let m : pseudo_metric_space α :=
     { exact edist_triangle _ _ _ },
     { simp [ennreal.add_eq_top, edist_ne_top] }
   end,
-  edist := λx y, edist x y,
-  edist_dist := λx y, by simp [h, ennreal.of_real_to_real, edist_ne_top] } in
+  edist := edist,
+  edist_dist := λ x y, by simp [h, ennreal.of_real_to_real, edist_ne_top] } in
 m.replace_uniformity $ by { rw [uniformity_pseudoedist, metric.uniformity_edist], refl }
 
 /-- One gets a pseudometric space from an emetric space if the edistance
@@ -1077,6 +1171,23 @@ def pseudo_emetric_space.to_pseudo_metric_space {α : Type u} [e : pseudo_emetri
 pseudo_emetric_space.to_pseudo_metric_space_of_dist
   (λx y, ennreal.to_real (edist x y)) h (λx y, rfl)
 
+/-- Build a new pseudometric space from an old one where the bundled bornology structure is provably
+(but typically non-definitionaly) equal to some given bornology structure.
+See Note [forgetful inheritance].
+-/
+def pseudo_metric_space.replace_bornology {α} [B : bornology α] (m : pseudo_metric_space α)
+  (H : ∀ s, @is_bounded _ B s ↔ @is_bounded _ pseudo_metric_space.to_bornology s) :
+  pseudo_metric_space α :=
+{ to_bornology := B,
+  cobounded_sets := set.ext $ compl_surjective.forall.2 $ λ s, (H s).trans $
+    by rw [is_bounded_iff, mem_set_of_eq, compl_compl],
+  .. m }
+
+lemma pseudo_metric_space.replace_bornology_eq {α} [m : pseudo_metric_space α] [B : bornology α]
+  (H : ∀ s, @is_bounded _ B s ↔ @is_bounded _ pseudo_metric_space.to_bornology s) :
+  pseudo_metric_space.replace_bornology _ H = m :=
+by { ext, refl }
+
 /-- A very useful criterion to show that a space is complete is to show that all sequences
 which satisfy a bound of the form `dist (u n) (u m) < B N` for all `n m ≥ N` are
 converging. This is often applied for `B N = 2^{-N}`, i.e., with a very fast convergence to
@@ -1096,7 +1207,7 @@ emetric.complete_of_cauchy_seq_tendsto
 section real
 
 /-- Instantiate the reals as a pseudometric space. -/
-noncomputable instance real.pseudo_metric_space : pseudo_metric_space ℝ :=
+instance real.pseudo_metric_space : pseudo_metric_space ℝ :=
 { dist               := λx y, |x - y|,
   dist_self          := by simp [abs_zero],
   dist_comm          := assume x y, abs_sub_comm _ _,
@@ -1111,22 +1222,22 @@ theorem real.nndist_eq' (x y : ℝ) : nndist x y = real.nnabs (y - x) := nndist_
 theorem real.dist_0_eq_abs (x : ℝ) : dist x 0 = |x| :=
 by simp [real.dist_eq]
 
-theorem real.dist_left_le_of_mem_interval {x y z : ℝ} (h : y ∈ interval x z) :
+theorem real.dist_left_le_of_mem_uIcc {x y z : ℝ} (h : y ∈ uIcc x z) :
   dist x y ≤ dist x z :=
-by simpa only [dist_comm x] using abs_sub_left_of_mem_interval h
+by simpa only [dist_comm x] using abs_sub_left_of_mem_uIcc h
 
-theorem real.dist_right_le_of_mem_interval {x y z : ℝ} (h : y ∈ interval x z) :
+theorem real.dist_right_le_of_mem_uIcc {x y z : ℝ} (h : y ∈ uIcc x z) :
   dist y z ≤ dist x z :=
-by simpa only [dist_comm _ z] using abs_sub_right_of_mem_interval h
+by simpa only [dist_comm _ z] using abs_sub_right_of_mem_uIcc h
 
-theorem real.dist_le_of_mem_interval {x y x' y' : ℝ} (hx : x ∈ interval x' y')
-  (hy : y ∈ interval x' y') : dist x y ≤ dist x' y' :=
-abs_sub_le_of_subinterval $ interval_subset_interval (by rwa interval_swap) (by rwa interval_swap)
+theorem real.dist_le_of_mem_uIcc {x y x' y' : ℝ} (hx : x ∈ uIcc x' y')
+  (hy : y ∈ uIcc x' y') : dist x y ≤ dist x' y' :=
+abs_sub_le_of_uIcc_subset_uIcc $ uIcc_subset_uIcc (by rwa uIcc_comm) (by rwa uIcc_comm)
 
 theorem real.dist_le_of_mem_Icc {x y x' y' : ℝ} (hx : x ∈ Icc x' y') (hy : y ∈ Icc x' y') :
   dist x y ≤ y' - x' :=
 by simpa only [real.dist_eq, abs_of_nonpos (sub_nonpos.2 $ hx.1.trans hx.2), neg_sub]
-  using real.dist_le_of_mem_interval (Icc_subset_interval hx) (Icc_subset_interval hy)
+  using real.dist_le_of_mem_uIcc (Icc_subset_uIcc hx) (Icc_subset_uIcc hy)
 
 theorem real.dist_le_of_mem_Icc_01 {x y : ℝ} (hx : x ∈ Icc (0:ℝ) 1) (hy : y ∈ Icc (0:ℝ) 1) :
   dist x y ≤ 1 :=
@@ -1138,11 +1249,11 @@ order_topology_of_nhds_abs $ λ x,
 
 lemma real.ball_eq_Ioo (x r : ℝ) : ball x r = Ioo (x - r) (x + r) :=
 set.ext $ λ y, by rw [mem_ball, dist_comm, real.dist_eq,
-  abs_sub_lt_iff, mem_Ioo, ← sub_lt_iff_lt_add', sub_lt]
+  abs_sub_lt_iff, mem_Ioo, ← sub_lt_iff_lt_add', sub_lt_comm]
 
 lemma real.closed_ball_eq_Icc {x r : ℝ} : closed_ball x r = Icc (x - r) (x + r) :=
 by ext y; rw [mem_closed_ball, dist_comm, real.dist_eq,
-  abs_sub_le_iff, mem_Icc, ← sub_le_iff_le_add', sub_le]
+  abs_sub_le_iff, mem_Icc, ← sub_le_iff_le_add', sub_le_comm]
 
 theorem real.Ioo_eq_ball (x y : ℝ) : Ioo x y = ball ((x + y) / 2) ((y - x) / 2) :=
 by rw [real.ball_eq_Ioo, ← sub_div, add_comm, ← sub_add,
@@ -1203,7 +1314,7 @@ lemma filter.tendsto.congr_dist {ι : Type*} {f₁ f₂ : ι → α} {p : filter
   tendsto f₂ p (𝓝 a) :=
 h₁.congr_uniformity $ tendsto_uniformity_iff_dist_tendsto_zero.2 h
 
-alias filter.tendsto.congr_dist ←  tendsto_of_tendsto_of_dist
+alias filter.tendsto.congr_dist ← tendsto_of_tendsto_of_dist
 
 lemma tendsto_iff_of_dist {ι : Type*} {f₁ f₂ : ι → α} {p : filter ι} {a : α}
   (h : tendsto (λ x, dist (f₁ x) (f₂ x)) p (𝓝 0)) :
@@ -1238,6 +1349,34 @@ theorem metric.cauchy_seq_iff' {u : β → α} :
   cauchy_seq u ↔ ∀ε>0, ∃N, ∀n≥N, dist (u n) (u N) < ε :=
 uniformity_basis_dist.cauchy_seq_iff'
 
+/-- In a pseudometric space, unifom Cauchy sequences are characterized by the fact that, eventually,
+the distance between all its elements is uniformly, arbitrarily small -/
+@[nolint ge_or_gt] -- see Note [nolint_ge]
+theorem metric.uniform_cauchy_seq_on_iff {γ : Type*}
+  {F : β → γ → α} {s : set γ} :
+  uniform_cauchy_seq_on F at_top s ↔
+    ∀ ε : ℝ, ε > 0 → ∃ (N : β), ∀ m : β, m ≥ N → ∀ n : β, n ≥ N → ∀ x : γ, x ∈ s →
+    dist (F m x) (F n x) < ε :=
+begin
+  split,
+  { intros h ε hε,
+    let u := { a : α × α | dist a.fst a.snd < ε },
+    have hu : u ∈ 𝓤 α := metric.mem_uniformity_dist.mpr ⟨ε, hε, (λ a b, by simp)⟩,
+    rw ←@filter.eventually_at_top_prod_self' _ _ _
+      (λ m, ∀ x : γ, x ∈ s → dist (F m.fst x) (F m.snd x) < ε),
+    specialize h u hu,
+    rw prod_at_top_at_top_eq at h,
+    exact h.mono (λ n h x hx, set.mem_set_of_eq.mp (h x hx)), },
+  { intros h u hu,
+    rcases (metric.mem_uniformity_dist.mp hu) with ⟨ε, hε, hab⟩,
+    rcases h ε hε with ⟨N, hN⟩,
+    rw [prod_at_top_at_top_eq, eventually_at_top],
+    use (N, N),
+    intros b hb x hx,
+    rcases hb with ⟨hbl, hbr⟩,
+    exact hab (hN b.fst hbl.ge b.snd hbr.ge x hx), },
+end
+
 /-- If the distance between `s n` and `s m`, `n ≤ m` is bounded above by `b n`
 and `b` converges to zero, then `s` is a Cauchy sequence.  -/
 lemma cauchy_seq_of_le_tendsto_0' {s : β → α} (b : β → ℝ)
@@ -1261,9 +1400,8 @@ theorem cauchy_seq_bdd {u : ℕ → α} (hu : cauchy_seq u) :
   ∃ R > 0, ∀ m n, dist (u m) (u n) < R :=
 begin
   rcases metric.cauchy_seq_iff'.1 hu 1 zero_lt_one with ⟨N, hN⟩,
-  suffices : ∃ R > 0, ∀ n, dist (u n) (u N) < R,
-  { rcases this with ⟨R, R0, H⟩,
-    exact ⟨_, add_pos R0 R0, λ m n,
+  rsuffices ⟨R, R0, H⟩ : ∃ R > 0, ∀ n, dist (u n) (u N) < R,
+  { exact ⟨_, add_pos R0 R0, λ m n,
       lt_of_le_of_lt (dist_triangle_right _ _ _) (add_lt_add (H m) (H n))⟩ },
   let R := finset.sup (finset.range N) (λ n, nndist (u n) (u N)),
   refine ⟨↑R + 1, add_pos_of_nonneg_of_pos R.2 zero_lt_one, λ n, _⟩,
@@ -1319,16 +1457,18 @@ def pseudo_metric_space.induced {α β} (f : α → β)
   edist              := λ x y, edist (f x) (f y),
   edist_dist         := λ x y, edist_dist _ _,
   to_uniform_space   := uniform_space.comap f m.to_uniform_space,
-  uniformity_dist    := begin
-    apply @uniformity_dist_of_mem_uniformity _ _ _ _ _ (λ x y, dist (f x) (f y)),
-    refine λ s, mem_comap.trans _,
-    split; intro H,
-    { rcases H with ⟨r, ru, rs⟩,
-      rcases mem_uniformity_dist.1 ru with ⟨ε, ε0, hε⟩,
-      refine ⟨ε, ε0, λ a b h, rs (hε _)⟩, exact h },
-    { rcases H with ⟨ε, ε0, hε⟩,
-      exact ⟨_, dist_mem_uniformity ε0, λ ⟨a, b⟩, hε⟩ }
-  end }
+  uniformity_dist    := (uniformity_basis_dist.comap _).eq_binfi,
+  to_bornology       := bornology.induced f,
+  cobounded_sets     := set.ext $ compl_surjective.forall.2 $ λ s,
+    by simp only [compl_mem_comap, filter.mem_sets, ← is_bounded_def, mem_set_of_eq, compl_compl,
+      is_bounded_iff, ball_image_iff] }
+
+/-- Pull back a pseudometric space structure by an inducing map. This is a version of
+`pseudo_metric_space.induced` useful in case if the domain already has a `topological_space`
+structure. -/
+def inducing.comap_pseudo_metric_space {α β} [topological_space α] [pseudo_metric_space β]
+  {f : α → β} (hf : inducing f) : pseudo_metric_space α :=
+(pseudo_metric_space.induced f ‹_›).replace_topology hf.induced
 
 /-- Pull back a pseudometric space structure by a uniform inducing map. This is a version of
 `pseudo_metric_space.induced` useful in case if the domain already has a `uniform_space`
@@ -1357,19 +1497,17 @@ end mul_opposite
 
 section nnreal
 
-noncomputable instance : pseudo_metric_space ℝ≥0 := subtype.pseudo_metric_space
+instance : pseudo_metric_space ℝ≥0 := subtype.pseudo_metric_space
 
 lemma nnreal.dist_eq (a b : ℝ≥0) : dist a b = |(a:ℝ) - b| := rfl
 
 lemma nnreal.nndist_eq (a b : ℝ≥0) :
   nndist a b = max (a - b) (b - a) :=
 begin
-  /- WLOG, `b ≤ a`. `wlog h : b ≤ a` works too but it is much slower because Lean tries to prove one
-  case from the other and fails; `tactic.skip` tells Lean not to try. -/
-  wlog h : b ≤ a := le_total b a using [a b, b a] tactic.skip,
-  { rw [← nnreal.coe_eq, ← dist_nndist, nnreal.dist_eq, tsub_eq_zero_iff_le.2 h,
-      max_eq_left (zero_le $ a - b), ← nnreal.coe_sub h, abs_of_nonneg (a - b).coe_nonneg] },
-  { rwa [nndist_comm, max_comm] }
+  wlog h : b ≤ a,
+  { rw [nndist_comm, max_comm], exact this b a (le_of_not_le h) },
+  rw [← nnreal.coe_eq, ← dist_nndist, nnreal.dist_eq, tsub_eq_zero_iff_le.2 h,
+    max_eq_left (zero_le $ a - b), ← nnreal.coe_sub h, abs_of_nonneg (a - b).coe_nonneg],
 end
 
 @[simp] lemma nnreal.nndist_zero_eq_val (z : ℝ≥0) : nndist 0 z = z :=
@@ -1387,16 +1525,33 @@ end
 
 end nnreal
 
+section ulift
+variables [pseudo_metric_space β]
+
+instance : pseudo_metric_space (ulift β) :=
+pseudo_metric_space.induced ulift.down ‹_›
+
+lemma ulift.dist_eq (x y : ulift β) : dist x y = dist x.down y.down := rfl
+lemma ulift.nndist_eq (x y : ulift β) : nndist x y = nndist x.down y.down := rfl
+
+@[simp] lemma ulift.dist_up_up (x y : β) : dist (ulift.up x) (ulift.up y) = dist x y := rfl
+@[simp] lemma ulift.nndist_up_up (x y : β) : nndist (ulift.up x) (ulift.up y) = nndist x y := rfl
+
+end ulift
+
 section prod
 variables [pseudo_metric_space β]
 
-noncomputable instance prod.pseudo_metric_space_max :
+instance prod.pseudo_metric_space_max :
   pseudo_metric_space (α × β) :=
-pseudo_emetric_space.to_pseudo_metric_space_of_dist
-  (λ x y : α × β, max (dist x.1 y.1) (dist x.2 y.2))
-  (λ x y, (max_lt (edist_lt_top _ _) (edist_lt_top _ _)).ne) $
-  λ x y, by rw [dist_edist, dist_edist, prod.edist_eq,
-    ← ennreal.to_real_max (edist_ne_top _ _) (edist_ne_top _ _)]
+(pseudo_emetric_space.to_pseudo_metric_space_of_dist
+  (λ x y : α × β, dist x.1 y.1 ⊔ dist x.2 y.2)
+  (λ x y, (max_lt (edist_lt_top _ _) (edist_lt_top _ _)).ne)
+  (λ x y, by simp only [sup_eq_max, dist_edist,
+    ← ennreal.to_real_max (edist_ne_top _ _) (edist_ne_top _ _), prod.edist_eq]))
+    .replace_bornology $
+  λ s, by { simp only [← is_bounded_image_fst_and_snd, is_bounded_iff_eventually, ball_image_iff,
+    ← eventually_and, ← forall_and_distrib, ← max_le_iff], refl }
 
 lemma prod.dist_eq {x y : α × β} :
   dist x y = max (dist x.1 y.1) (dist x.2 y.2) := rfl
@@ -1417,6 +1572,20 @@ theorem closed_ball_prod_same (x : α) (y : β) (r : ℝ) :
   closed_ball x r ×ˢ closed_ball y r = closed_ball (x, y) r :=
 ext $ λ z, by simp [prod.dist_eq]
 
+theorem sphere_prod (x : α × β) (r : ℝ) :
+  sphere x r = sphere x.1 r ×ˢ closed_ball x.2 r ∪ closed_ball x.1 r ×ˢ sphere x.2 r :=
+begin
+  obtain hr | rfl | hr := lt_trichotomy r 0,
+  { simp [hr], },
+  { cases x,
+    simp_rw [←closed_ball_eq_sphere_of_nonpos le_rfl, union_self, closed_ball_prod_same] },
+  { ext ⟨x', y'⟩,
+    simp_rw [set.mem_union, set.mem_prod, metric.mem_closed_ball, metric.mem_sphere,
+      prod.dist_eq, max_eq_iff],
+    refine or_congr (and_congr_right _) ((and_comm _ _).trans (and_congr_left _)),
+    all_goals { rintro rfl, refl } },
+end
+
 end prod
 
 theorem uniform_continuous_dist : uniform_continuous (λp:α×α, dist p.1 p.2) :=
@@ -1464,8 +1633,14 @@ lemma tendsto_iff_dist_tendsto_zero {f : β → α} {x : filter β} {a : α} :
   (tendsto f x (𝓝 a)) ↔ (tendsto (λb, dist (f b) a) x (𝓝 0)) :=
 by rw [← nhds_comap_dist a, tendsto_comap_iff]
 
+lemma continuous_iff_continuous_dist [topological_space β] {f : β → α} :
+  continuous f ↔ continuous (λ x : β × β, dist (f x.1) (f x.2)) :=
+⟨λ h, (h.comp continuous_fst).dist (h.comp continuous_snd), λ h, continuous_iff_continuous_at.2 $
+  λ x, tendsto_iff_dist_tendsto_zero.2 $
+    (h.comp (continuous_id.prod_mk continuous_const)).tendsto' _ _ $ dist_self _⟩
+
 lemma uniform_continuous_nndist : uniform_continuous (λp:α×α, nndist p.1 p.2) :=
-uniform_continuous_subtype_mk uniform_continuous_dist _
+uniform_continuous_dist.subtype_mk _
 
 lemma uniform_continuous.nndist [uniform_space β] {f g : β → α} (hf : uniform_continuous f)
   (hg : uniform_continuous g) :
@@ -1496,6 +1671,9 @@ is_closed_eq (continuous_id.dist continuous_const) continuous_const
 @[simp] theorem closure_closed_ball : closure (closed_ball x ε) = closed_ball x ε :=
 is_closed_ball.closure_eq
 
+@[simp] theorem closure_sphere : closure (sphere x ε) = sphere x ε :=
+is_closed_sphere.closure_eq
+
 theorem closure_ball_subset_closed_ball : closure (ball x ε) ⊆ closed_ball x ε :=
 closure_minimal ball_subset_closed_ball is_closed_ball
 
@@ -1534,7 +1712,7 @@ subset.antisymm
 
 lemma dense_iff {s : set α} :
   dense s ↔ ∀ x, ∀ r > 0, (ball x r ∩ s).nonempty :=
-forall_congr $ λ x, by simp only [mem_closure_iff, set.nonempty, exists_prop, mem_inter_eq,
+forall_congr $ λ x, by simp only [mem_closure_iff, set.nonempty, exists_prop, mem_inter_iff,
   mem_ball', and_comm]
 
 lemma dense_range_iff {f : β → α} :
@@ -1549,7 +1727,7 @@ lemma _root_.topological_space.is_separable.separable_space {s : set α} (hs : i
 begin
   classical,
   rcases eq_empty_or_nonempty s with rfl|⟨⟨x₀, x₀s⟩⟩,
-  { haveI : encodable (∅ : set α) := fintype.to_encodable ↥∅, exact encodable.to_separable_space },
+  { apply_instance },
   rcases hs with ⟨c, hc, h'c⟩,
   haveI : encodable c := hc.to_encodable,
   obtain ⟨u, -, u_pos, u_lim⟩ : ∃ (u : ℕ → ℝ), strict_anti u ∧ (∀ (n : ℕ), 0 < u n) ∧
@@ -1616,17 +1794,26 @@ open finset
 variables {π : β → Type*} [fintype β] [∀b, pseudo_metric_space (π b)]
 
 /-- A finite product of pseudometric spaces is a pseudometric space, with the sup distance. -/
-noncomputable instance pseudo_metric_space_pi : pseudo_metric_space (Πb, π b) :=
+instance pseudo_metric_space_pi : pseudo_metric_space (Πb, π b) :=
 begin
   /- we construct the instance from the pseudoemetric space instance to avoid checking again that
   the uniformity is the same as the product uniformity, but we register nevertheless a nice formula
   for the distance -/
-  refine pseudo_emetric_space.to_pseudo_metric_space_of_dist
-    (λf g, ((sup univ (λb, nndist (f b) (g b)) : ℝ≥0) : ℝ)) (λ f g, _) (λ f g, _),
+  refine (pseudo_emetric_space.to_pseudo_metric_space_of_dist
+    (λf g : Π b, π b, ((sup univ (λb, nndist (f b) (g b)) : ℝ≥0) : ℝ))
+    (λ f g, _) (λ f g, _)).replace_bornology (λ s, _),
   show edist f g ≠ ⊤,
     from ne_of_lt ((finset.sup_lt_iff bot_lt_top).2 $ λ b hb, edist_lt_top _ _),
   show ↑(sup univ (λ b, nndist (f b) (g b))) = (sup univ (λ b, edist (f b) (g b))).to_real,
-    by simp only [edist_nndist, ← ennreal.coe_finset_sup, ennreal.coe_to_real]
+    by simp only [edist_nndist, ← ennreal.coe_finset_sup, ennreal.coe_to_real],
+  show (@is_bounded _ pi.bornology s ↔ @is_bounded _ pseudo_metric_space.to_bornology _),
+  { simp only [← is_bounded_def, is_bounded_iff_eventually, ← forall_is_bounded_image_eval_iff,
+      ball_image_iff, ← eventually_all, function.eval_apply, @dist_nndist (π _)],
+    refine eventually_congr ((eventually_ge_at_top 0).mono $ λ C hC, _),
+    lift C to ℝ≥0 using hC,
+    refine ⟨λ H x hx y hy, nnreal.coe_le_coe.2 $ finset.sup_le $ λ b hb, H b x hx y hy,
+      λ H b x hx y hy, nnreal.coe_le_coe.2 _⟩,
+    simpa only using finset.sup_le_iff.1 (nnreal.coe_le_coe.1 $ H hx hy) b (finset.mem_univ b) }
 end
 
 lemma nndist_pi_def (f g : Πb, π b) : nndist f g = sup univ (λb, nndist (f b) (g b)) :=
@@ -1635,21 +1822,29 @@ nnreal.eq rfl
 lemma dist_pi_def (f g : Πb, π b) :
   dist f g = (sup univ (λb, nndist (f b) (g b)) : ℝ≥0) := rfl
 
-@[simp] lemma dist_pi_const [nonempty β] (a b : α) : dist (λ x : β, a) (λ _, b) = dist a b :=
-by simpa only [dist_edist] using congr_arg ennreal.to_real (edist_pi_const a b)
-
-@[simp] lemma nndist_pi_const [nonempty β] (a b : α) :
-  nndist (λ x : β, a) (λ _, b) = nndist a b := nnreal.eq $ dist_pi_const a b
-
 lemma nndist_pi_le_iff {f g : Πb, π b} {r : ℝ≥0} :
   nndist f g ≤ r ↔ ∀b, nndist (f b) (g b) ≤ r :=
 by simp [nndist_pi_def]
 
+lemma nndist_pi_lt_iff {f g : Πb, π b} {r : ℝ≥0} (hr : 0 < r) :
+  nndist f g < r ↔ ∀ b, nndist (f b) (g b) < r :=
+by simp [nndist_pi_def, finset.sup_lt_iff (show ⊥ < r, from hr)]
+
+lemma nndist_pi_eq_iff {f g : Π b, π b} {r : ℝ≥0} (hr : 0 < r) :
+  nndist f g = r ↔ (∃ i, nndist (f i) (g i) = r) ∧ ∀ b, nndist (f b) (g b) ≤ r :=
+begin
+  rw [eq_iff_le_not_lt, nndist_pi_lt_iff hr, nndist_pi_le_iff, not_forall, and_comm],
+  simp_rw [not_lt, and.congr_left_iff, le_antisymm_iff],
+  intro h,
+  refine exists_congr (λ b, _),
+  apply (and_iff_right $ h _).symm,
+end
+
 lemma dist_pi_lt_iff {f g : Πb, π b} {r : ℝ} (hr : 0 < r) :
   dist f g < r ↔ ∀b, dist (f b) (g b) < r :=
 begin
   lift r to ℝ≥0 using hr.le,
-  simp [dist_pi_def, finset.sup_lt_iff (show ⊥ < r, from hr)],
+  exact nndist_pi_lt_iff hr,
 end
 
 lemma dist_pi_le_iff {f g : Πb, π b} {r : ℝ} (hr : 0 ≤ r) :
@@ -1659,6 +1854,34 @@ begin
   exact nndist_pi_le_iff
 end
 
+lemma dist_pi_eq_iff {f g : Πb, π b} {r : ℝ} (hr : 0 < r) :
+  dist f g = r ↔ (∃ i, dist (f i) (g i) = r) ∧ ∀ b, dist (f b) (g b) ≤ r :=
+begin
+  lift r to ℝ≥0 using hr.le,
+  simp_rw [←coe_nndist, nnreal.coe_eq, nndist_pi_eq_iff hr, nnreal.coe_le_coe],
+end
+
+lemma dist_pi_le_iff' [nonempty β] {f g : Π b, π b} {r : ℝ} :
+  dist f g ≤ r ↔ ∀ b, dist (f b) (g b) ≤ r :=
+begin
+  by_cases hr : 0 ≤ r,
+  { exact dist_pi_le_iff hr },
+  { exact iff_of_false (λ h, hr $ dist_nonneg.trans h)
+      (λ h, hr $ dist_nonneg.trans $ h $ classical.arbitrary _) }
+end
+
+lemma dist_pi_const_le (a b : α) : dist (λ _ : β, a) (λ _, b) ≤ dist a b :=
+(dist_pi_le_iff dist_nonneg).2 $ λ _, le_rfl
+
+lemma nndist_pi_const_le (a b : α) : nndist (λ _ : β, a) (λ _, b) ≤ nndist a b :=
+nndist_pi_le_iff.2 $ λ _, le_rfl
+
+@[simp] lemma dist_pi_const [nonempty β] (a b : α) : dist (λ x : β, a) (λ _, b) = dist a b :=
+by simpa only [dist_edist] using congr_arg ennreal.to_real (edist_pi_const a b)
+
+@[simp] lemma nndist_pi_const [nonempty β] (a b : α) :
+  nndist (λ x : β, a) (λ _, b) = nndist a b := nnreal.eq $ dist_pi_const a b
+
 lemma nndist_le_pi_nndist (f g : Πb, π b) (b : β) : nndist (f b) (g b) ≤ nndist f g :=
 by { rw [nndist_pi_def], exact finset.le_sup (finset.mem_univ b) }
 
@@ -1689,6 +1912,25 @@ lemma closed_ball_pi' [nonempty β] (x : Π b, π b) (r : ℝ) :
   closed_ball x r = set.pi univ (λ b, closed_ball (x b) r) :=
 (le_or_lt 0 r).elim (closed_ball_pi x) $ λ hr, by simp [closed_ball_eq_empty.2 hr]
 
+/-- A sphere in a product space is a union of spheres on each component restricted to the closed
+ball. -/
+lemma sphere_pi (x : Πb, π b) {r : ℝ} (h : 0 < r ∨ nonempty β) :
+  sphere x r = (⋃ i : β, function.eval i ⁻¹' sphere (x i) r) ∩ closed_ball x r :=
+begin
+  obtain hr | rfl | hr := lt_trichotomy r 0,
+  { simp [hr], },
+  { rw [closed_ball_eq_sphere_of_nonpos le_rfl, eq_comm, set.inter_eq_right_iff_subset],
+    letI := h.resolve_left (lt_irrefl _),
+    inhabit β,
+    refine subset_Union_of_subset default _,
+    intros x hx,
+    replace hx := hx.le,
+    rw [dist_pi_le_iff le_rfl] at hx,
+    exact le_antisymm (hx default) dist_nonneg },
+  { ext,
+    simp [dist_pi_eq_iff hr,  dist_pi_le_iff hr.le] },
+end
+
 @[simp] lemma fin.nndist_insert_nth_insert_nth {n : ℕ} {α : fin (n + 1) → Type*}
   [Π i, pseudo_metric_space (α i)] (i : fin (n + 1)) (x y : α i) (f g : Π j, α (i.succ_above j)) :
   nndist (i.insert_nth x f) (i.insert_nth y g) = max (nndist x y) (nndist f g) :=
@@ -1702,8 +1944,8 @@ by simp only [dist_nndist, fin.nndist_insert_nth_insert_nth, nnreal.coe_max]
 lemma real.dist_le_of_mem_pi_Icc {x y x' y' : β → ℝ} (hx : x ∈ Icc x' y') (hy : y ∈ Icc x' y') :
   dist x y ≤ dist x' y' :=
 begin
-  refine (dist_pi_le_iff dist_nonneg).2 (λ b, (real.dist_le_of_mem_interval _ _).trans
-    (dist_le_pi_dist _ _ b)); refine Icc_subset_interval _,
+  refine (dist_pi_le_iff dist_nonneg).2 (λ b, (real.dist_le_of_mem_uIcc _ _).trans
+    (dist_le_pi_dist _ _ b)); refine Icc_subset_uIcc _,
   exacts [⟨hx.1 _, hx.2 _⟩, ⟨hy.1 _, hy.2 _⟩]
 end
 
@@ -1715,7 +1957,7 @@ section compact
 positive radius -/
 lemma finite_cover_balls_of_compact {α : Type u} [pseudo_metric_space α] {s : set α}
   (hs : is_compact s) {e : ℝ} (he : 0 < e) :
-  ∃t ⊆ s, finite t ∧ s ⊆ ⋃x∈t, ball x e :=
+  ∃t ⊆ s, set.finite t ∧ s ⊆ ⋃x∈t, ball x e :=
 begin
   apply hs.elim_finite_subcover_image,
   { simp [is_open_ball] },
@@ -1740,7 +1982,8 @@ export proper_space (is_compact_closed_ball)
 /-- In a proper pseudometric space, all spheres are compact. -/
 lemma is_compact_sphere {α : Type*} [pseudo_metric_space α] [proper_space α] (x : α) (r : ℝ) :
   is_compact (sphere x r) :=
-compact_of_is_closed_subset (is_compact_closed_ball x r) is_closed_sphere sphere_subset_closed_ball
+is_compact_of_is_closed_subset (is_compact_closed_ball x r) is_closed_sphere
+sphere_subset_closed_ball
 
 /-- In a proper pseudometric space, any sphere is a `compact_space` when considered as a subtype. -/
 instance {α : Type*} [pseudo_metric_space α] [proper_space α] (x : α) (r : ℝ) :
@@ -1809,11 +2052,21 @@ instance complete_of_proper [proper_space α] : complete_space α :=
     (metric.cauchy_iff.1 hf).2 1 zero_lt_one,
   rcases hf.1.nonempty_of_mem t_fset with ⟨x, xt⟩,
   have : closed_ball x 1 ∈ f := mem_of_superset t_fset (λ y yt, (ht y yt x xt).le),
-  rcases (compact_iff_totally_bounded_complete.1 (is_compact_closed_ball x 1)).2 f hf
+  rcases (is_compact_iff_totally_bounded_is_complete.1 (is_compact_closed_ball x 1)).2 f hf
     (le_principal_iff.2 this) with ⟨y, -, hy⟩,
   exact ⟨y, hy⟩
 end⟩
 
+/-- A binary product of proper spaces is proper. -/
+instance prod_proper_space {α : Type*} {β : Type*} [pseudo_metric_space α] [pseudo_metric_space β]
+  [proper_space α] [proper_space β] :
+  proper_space (α × β) :=
+{ is_compact_closed_ball := begin
+    rintros ⟨x, y⟩ r,
+    rw ← closed_ball_prod_same x y,
+    apply (is_compact_closed_ball x r).prod (is_compact_closed_ball y r),
+  end }
+
 /-- A finite product of proper spaces is proper. -/
 instance pi_proper_space {π : β → Type*} [fintype β] [∀b, pseudo_metric_space (π b)]
   [h : ∀b, proper_space (π b)] : proper_space (Πb, π b) :=
@@ -1834,7 +2087,7 @@ begin
   unfreezingI { rcases eq_empty_or_nonempty s with rfl|hne },
   { exact ⟨r / 2, ⟨half_pos hr, half_lt_self hr⟩, empty_subset _⟩ },
   have : is_compact s,
-    from compact_of_is_closed_subset (is_compact_closed_ball x r) hs
+    from is_compact_of_is_closed_subset (is_compact_closed_ball x r) hs
       (subset.trans h ball_subset_closed_ball),
   obtain ⟨y, hys, hy⟩ : ∃ y ∈ s, s ⊆ closed_ball x (dist y x),
     from this.exists_forall_ge hne (continuous_id.dist continuous_const).continuous_on,
@@ -1870,7 +2123,7 @@ open topological_space
 /-- A pseudometric space is second countable if, for every `ε > 0`, there is a countable set which
 is `ε`-dense. -/
 lemma second_countable_of_almost_dense_set
-  (H : ∀ε > (0 : ℝ), ∃ s : set α, countable s ∧ (∀x, ∃y ∈ s, dist x y ≤ ε)) :
+  (H : ∀ε > (0 : ℝ), ∃ s : set α, s.countable ∧ (∀x, ∃y ∈ s, dist x y ≤ ε)) :
   second_countable_topology α :=
 begin
   refine emetric.second_countable_of_almost_dense_set (λ ε ε0, _),
@@ -1909,9 +2162,22 @@ def bounded (s : set α) : Prop :=
 section bounded
 variables {x : α} {s t : set α} {r : ℝ}
 
+lemma bounded_iff_is_bounded (s : set α) : bounded s ↔ is_bounded s :=
+begin
+  change bounded s ↔ sᶜ ∈ (cobounded α).sets,
+  simp [pseudo_metric_space.cobounded_sets, metric.bounded],
+end
+
 @[simp] lemma bounded_empty : bounded (∅ : set α) :=
 ⟨0, by simp⟩
 
+lemma nonempty_of_unbounded (h : ¬ bounded s) : s.nonempty :=
+begin
+  rw nonempty_iff_ne_empty,
+  rintro rfl,
+  exact h bounded_empty
+end
+
 lemma bounded_iff_mem_bounded : bounded s ↔ ∀ x ∈ s, bounded s :=
 ⟨λ h _ _, h, λ H,
   s.eq_empty_or_nonempty.elim
@@ -1963,10 +2229,9 @@ end
 
 lemma bounded_closure_of_bounded (h : bounded s) : bounded (closure s) :=
 let ⟨C, h⟩ := h in
-⟨C, λ a ha b hb, (is_closed_le' C).closure_subset $ map_mem_closure2 continuous_dist ha hb
-$ ball_mem_comm.mp h⟩
+⟨C, λ a ha b hb, (is_closed_le' C).closure_subset $ map_mem_closure₂ continuous_dist ha hb h⟩
 
-alias bounded_closure_of_bounded ← metric.bounded.closure
+alias bounded_closure_of_bounded ← bounded.closure
 
 @[simp] lemma bounded_closure_iff : bounded (closure s) ↔ bounded s :=
 ⟨λ h, h.mono subset_closure, λ h, h.closure⟩
@@ -1987,7 +2252,7 @@ end
 ⟨λ h, ⟨h.mono (by simp), h.mono (by simp)⟩, λ h, h.1.union h.2⟩
 
 /-- A finite union of bounded sets is bounded -/
-lemma bounded_bUnion {I : set β} {s : β → set α} (H : finite I) :
+lemma bounded_bUnion {I : set β} {s : β → set α} (H : I.finite) :
   bounded (⋃i∈I, s i) ↔ ∀i ∈ I, bounded (s i) :=
 finite.induction_on H (by simp) $ λ x I _ _ IH,
 by simp [or_imp_distrib, forall_and_distrib, IH]
@@ -2018,10 +2283,10 @@ lemma _root_.is_compact.bounded {s : set α} (h : is_compact s) : bounded s :=
 h.totally_bounded.bounded
 
 /-- A finite set is bounded -/
-lemma bounded_of_finite {s : set α} (h : finite s) : bounded s :=
+lemma bounded_of_finite {s : set α} (h : s.finite) : bounded s :=
 h.is_compact.bounded
 
-alias bounded_of_finite ← set.finite.bounded
+alias bounded_of_finite ← _root_.set.finite.bounded
 
 /-- A singleton is bounded -/
 lemma bounded_singleton {x : α} : bounded ({x} : set α) :=
@@ -2059,13 +2324,70 @@ bounded_range_of_tendsto_cofinite_uniformity $
 
 /-- In a compact space, all sets are bounded -/
 lemma bounded_of_compact_space [compact_space α] : bounded s :=
-compact_univ.bounded.mono (subset_univ _)
+is_compact_univ.bounded.mono (subset_univ _)
 
-lemma bounded_range_of_tendsto {α : Type*} [pseudo_metric_space α] (u : ℕ → α) {x : α}
-  (hu : tendsto u at_top (𝓝 x)) :
+lemma bounded_range_of_tendsto (u : ℕ → α) {x : α} (hu : tendsto u at_top (𝓝 x)) :
   bounded (range u) :=
 hu.cauchy_seq.bounded_range
 
+/-- If a function is continuous within a set `s` at every point of a compact set `k`, then it is
+bounded on some open neighborhood of `k` in `s`. -/
+lemma exists_is_open_bounded_image_inter_of_is_compact_of_forall_continuous_within_at
+  [topological_space β] {k s : set β} {f : β → α}
+  (hk : is_compact k) (hf : ∀ x ∈ k, continuous_within_at f s x) :
+  ∃ t, k ⊆ t ∧ is_open t ∧ bounded (f '' (t ∩ s)) :=
+begin
+  apply hk.induction_on,
+  { exact ⟨∅, subset.refl _, is_open_empty,
+      by simp only [image_empty, bounded_empty, empty_inter]⟩ },
+  { rintros s s' hss' ⟨t, s't, t_open, t_bounded⟩,
+    exact ⟨t, hss'.trans s't, t_open, t_bounded⟩ },
+  { rintros s s' ⟨t, st, t_open, t_bounded⟩ ⟨t', s't', t'_open, t'_bounded⟩,
+    refine ⟨t ∪ t', union_subset_union st s't', t_open.union t'_open, _⟩,
+    rw [union_inter_distrib_right, image_union],
+    exact t_bounded.union t'_bounded },
+  { assume x hx,
+    have A : ball (f x) 1 ∈ 𝓝 (f x), from ball_mem_nhds _ zero_lt_one,
+    have B : f ⁻¹' (ball (f x) 1) ∈ 𝓝[s] x, from hf x hx A,
+    obtain ⟨u, u_open, xu, uf⟩ : ∃ (u : set β), is_open u ∧ x ∈ u ∧ u ∩ s ⊆ f ⁻¹' ball (f x) 1,
+      from _root_.mem_nhds_within.1 B,
+    refine ⟨u, _, u, subset.refl _, u_open, _⟩,
+    { apply nhds_within_le_nhds,
+      exact u_open.mem_nhds xu },
+    { apply bounded.mono (image_subset _ uf),
+      exact bounded_ball.mono (image_preimage_subset _ _) } }
+end
+
+/-- If a function is continuous at every point of a compact set `k`, then it is bounded on
+some open neighborhood of `k`. -/
+lemma exists_is_open_bounded_image_of_is_compact_of_forall_continuous_at
+  [topological_space β] {k : set β} {f : β → α}
+  (hk : is_compact k) (hf : ∀ x ∈ k, continuous_at f x) :
+  ∃ t, k ⊆ t ∧ is_open t ∧ bounded (f '' t) :=
+begin
+  simp_rw ← continuous_within_at_univ at hf,
+  simpa only [inter_univ]  using
+    exists_is_open_bounded_image_inter_of_is_compact_of_forall_continuous_within_at hk hf,
+end
+
+/-- If a function is continuous on a set `s` containing a compact set `k`, then it is bounded on
+some open neighborhood of `k` in `s`. -/
+lemma exists_is_open_bounded_image_inter_of_is_compact_of_continuous_on
+  [topological_space β] {k s : set β} {f : β → α}
+  (hk : is_compact k) (hks : k ⊆ s) (hf : continuous_on f s) :
+  ∃ t, k ⊆ t ∧ is_open t ∧ bounded (f '' (t ∩ s)) :=
+exists_is_open_bounded_image_inter_of_is_compact_of_forall_continuous_within_at hk
+  (λ x hx, hf x (hks hx))
+
+/-- If a function is continuous on a neighborhood of a compact set `k`, then it is bounded on
+some open neighborhood of `k`. -/
+lemma exists_is_open_bounded_image_of_is_compact_of_continuous_on
+  [topological_space β] {k s : set β} {f : β → α}
+  (hk : is_compact k) (hs : is_open s) (hks : k ⊆ s) (hf : continuous_on f s) :
+  ∃ t, k ⊆ t ∧ is_open t ∧ bounded (f '' t) :=
+exists_is_open_bounded_image_of_is_compact_of_forall_continuous_at hk
+  (λ x hx, hf.continuous_at (hs.mem_nhds (hks hx)))
+
 /-- The **Heine–Borel theorem**: In a proper space, a closed bounded set is compact. -/
 lemma is_compact_of_is_closed_bounded [proper_space α] (hc : is_closed s) (hb : bounded s) :
   is_compact s :=
@@ -2073,7 +2395,7 @@ begin
   unfreezingI { rcases eq_empty_or_nonempty s with (rfl|⟨x, hx⟩) },
   { exact is_compact_empty },
   { rcases hb.subset_ball x with ⟨r, hr⟩,
-    exact compact_of_is_closed_subset (is_compact_closed_ball x r) hc hr }
+    exact is_compact_of_is_closed_subset (is_compact_closed_ball x r) hc hr }
 end
 
 /-- The **Heine–Borel theorem**: In a proper space, the closure of a bounded set is compact. -/
@@ -2083,7 +2405,7 @@ is_compact_of_is_closed_bounded is_closed_closure h.closure
 
 /-- The **Heine–Borel theorem**:
 In a proper Hausdorff space, a set is compact if and only if it is closed and bounded. -/
-lemma compact_iff_closed_bounded [t2_space α] [proper_space α] :
+lemma is_compact_iff_is_closed_bounded [t2_space α] [proper_space α] :
   is_compact s ↔ is_closed s ∧ bounded s :=
 ⟨λ h, ⟨h.is_closed, h.bounded⟩, λ h, is_compact_of_is_closed_bounded h.1 h.2⟩
 
@@ -2138,6 +2460,8 @@ diam_subsingleton subsingleton_empty
 @[simp] lemma diam_singleton : diam ({x} : set α) = 0 :=
 diam_subsingleton subsingleton_singleton
 
+@[simp, to_additive] lemma diam_one [has_one α] : diam (1 : set α) = 0 := diam_singleton
+
 -- Does not work as a simp-lemma, since {x, y} reduces to (insert y {x})
 lemma diam_pair : diam ({x, y} : set α) = dist x y :=
 by simp only [diam, emetric.diam_pair, dist_edist]
@@ -2299,8 +2623,30 @@ lemma nonempty_Inter_of_nonempty_bInter [complete_space α] {s : ℕ → set α}
 
 end diam
 
+lemma exists_local_min_mem_ball [proper_space α] [topological_space β]
+  [conditionally_complete_linear_order β] [order_topology β]
+  {f : α → β} {a z : α} {r : ℝ} (hf : continuous_on f (closed_ball a r))
+  (hz : z ∈ closed_ball a r) (hf1 : ∀ z' ∈ sphere a r, f z < f z') :
+  ∃ z ∈ ball a r, is_local_min f z :=
+begin
+  simp_rw [← closed_ball_diff_ball] at hf1,
+  exact (is_compact_closed_ball a r).exists_local_min_mem_open ball_subset_closed_ball hf hz hf1
+    is_open_ball,
+end
+
 end metric
 
+namespace tactic
+open positivity
+
+/-- Extension for the `positivity` tactic: the diameter of a set is always nonnegative. -/
+@[positivity]
+meta def positivity_diam : expr → tactic strictness
+| `(metric.diam %%s) := nonnegative <$> mk_app ``metric.diam_nonneg [s]
+| e := pp e >>= fail ∘ format.bracket "The expression " " is not of the form `metric.diam s`"
+
+end tactic
+
 lemma comap_dist_right_at_top_le_cocompact (x : α) : comap (λ y, dist y x) at_top ≤ cocompact α :=
 begin
   refine filter.has_basis_cocompact.ge_iff.2 (λ s hs, mem_comap.2 _),
@@ -2323,20 +2669,6 @@ lemma tendsto_cocompact_of_tendsto_dist_comp_at_top {f : β → α} {l : filter
   (h : tendsto (λ y, dist (f y) x) l at_top) : tendsto f l (cocompact α) :=
 by { refine tendsto.mono_right _ (comap_dist_right_at_top_le_cocompact x), rwa tendsto_comap_iff }
 
-namespace int
-open metric
-
-/-- Under the coercion from `ℤ` to `ℝ`, inverse images of compact sets are finite. -/
-lemma tendsto_coe_cofinite : tendsto (coe : ℤ → ℝ) cofinite (cocompact ℝ) :=
-begin
-  refine tendsto_cocompact_of_tendsto_dist_comp_at_top (0 : ℝ) _,
-  simp only [filter.tendsto_at_top, eventually_cofinite, not_le, ← mem_ball],
-  change ∀ r : ℝ, finite (coe ⁻¹' (ball (0 : ℝ) r)),
-  simp [real.ball_eq_Ioo, set.finite_Ioo],
-end
-
-end int
-
 /-- We now define `metric_space`, extending `pseudo_metric_space`. -/
 class metric_space (α : Type u) extends pseudo_metric_space α : Type u :=
 (eq_of_dist_eq_zero : ∀ {x y : α}, dist x y = 0 → x = y)
@@ -2354,14 +2686,14 @@ end
 /-- Construct a metric space structure whose underlying topological space structure
 (definitionally) agrees which a pre-existing topology which is compatible with a given distance
 function. -/
-def metric_space.of_metrizable {α : Type*} [topological_space α] (dist : α → α → ℝ)
+def metric_space.of_dist_topology {α : Type u} [topological_space α] (dist : α → α → ℝ)
   (dist_self : ∀ x : α, dist x x = 0)
   (dist_comm : ∀ x y : α, dist x y = dist y x)
   (dist_triangle : ∀ x y z : α, dist x z ≤ dist x y + dist y z)
   (H : ∀ s : set α, is_open s ↔ ∀ x ∈ s, ∃ ε > 0, ∀ y, dist x y < ε → y ∈ s)
   (eq_of_dist_eq_zero : ∀ x y : α, dist x y = 0 → x = y) : metric_space α :=
 { eq_of_dist_eq_zero := eq_of_dist_eq_zero,
-  ..pseudo_metric_space.of_metrizable dist dist_self dist_comm dist_triangle H }
+  ..pseudo_metric_space.of_dist_topology dist dist_self dist_comm dist_triangle H }
 
 variables {γ : Type w} [metric_space γ]
 
@@ -2415,51 +2747,35 @@ begin
 end
 
 lemma subsingleton_sphere (x : γ) {r : ℝ} (hr : r ≤ 0) : (sphere x r).subsingleton :=
-(subsingleton_closed_ball x hr).mono sphere_subset_closed_ball
+(subsingleton_closed_ball x hr).anti sphere_subset_closed_ball
+
+@[priority 100] -- see Note [lower instance priority]
+instance _root_.metric_space.to_separated : separated_space γ :=
+separated_def.2 $ λ x y h, eq_of_forall_dist_le $
+  λ ε ε0, le_of_lt (h _ (dist_mem_uniformity ε0))
 
 /-- A map between metric spaces is a uniform embedding if and only if the distance between `f x`
 and `f y` is controlled in terms of the distance between `x` and `y` and conversely. -/
 theorem uniform_embedding_iff' [metric_space β] {f : γ → β} :
   uniform_embedding f ↔
-  (∀ ε > 0, ∃ δ > 0, ∀ {a b : γ}, dist a b < δ → dist (f a) (f b) < ε) ∧
-  (∀ δ > 0, ∃ ε > 0, ∀ {a b : γ}, dist (f a) (f b) < ε → dist a b < δ) :=
+    (∀ ε > 0, ∃ δ > 0, ∀ {a b : γ}, dist a b < δ → dist (f a) (f b) < ε) ∧
+    (∀ δ > 0, ∃ ε > 0, ∀ {a b : γ}, dist (f a) (f b) < ε → dist a b < δ) :=
 begin
-  split,
-  { assume h,
-    exact ⟨uniform_continuous_iff.1 (uniform_embedding_iff.1 h).2.1,
-          (uniform_embedding_iff.1 h).2.2⟩ },
-  { rintros ⟨h₁, h₂⟩,
-    refine uniform_embedding_iff.2 ⟨_, uniform_continuous_iff.2 h₁, h₂⟩,
-    assume x y hxy,
-    have : dist x y ≤ 0,
-    { refine le_of_forall_lt' (λδ δpos, _),
-      rcases h₂ δ δpos with ⟨ε, εpos, hε⟩,
-      have : dist (f x) (f y) < ε, by simpa [hxy],
-      exact hε this },
-    simpa using this }
+  simp only [uniform_embedding_iff_uniform_inducing,
+    uniformity_basis_dist.uniform_inducing_iff uniformity_basis_dist, exists_prop],
+  refl
 end
 
-@[priority 100] -- see Note [lower instance priority]
-instance metric_space.to_separated : separated_space γ :=
-separated_def.2 $ λ x y h, eq_of_forall_dist_le $
-  λ ε ε0, le_of_lt (h _ (dist_mem_uniformity ε0))
-
-/-- If a `pseudo_metric_space` is separated, then it is a `metric_space`. -/
-def of_t2_pseudo_metric_space {α : Type*} [pseudo_metric_space α]
-  (h : separated_space α) : metric_space α :=
-{ eq_of_dist_eq_zero := λ x y hdist,
-  begin
-    refine separated_def.1 h x y (λ s hs, _),
-    obtain ⟨ε, hε, H⟩ := mem_uniformity_dist.1 hs,
-    exact H (show dist x y < ε, by rwa [hdist])
-  end
+/-- If a `pseudo_metric_space` is a T₀ space, then it is a `metric_space`. -/
+def _root_.metric_space.of_t0_pseudo_metric_space (α : Type*) [pseudo_metric_space α] [t0_space α] :
+  metric_space α :=
+{ eq_of_dist_eq_zero := λ x y hdist, inseparable.eq $ metric.inseparable_iff.2 hdist,
   ..‹pseudo_metric_space α› }
 
 /-- A metric space induces an emetric space -/
 @[priority 100] -- see Note [lower instance priority]
-instance metric_space.to_emetric_space : emetric_space γ :=
-{ eq_of_edist_eq_zero := assume x y h, by simpa [edist_dist] using h,
-  ..pseudo_metric_space.to_pseudo_emetric_space, }
+instance _root_.metric_space.to_emetric_space : emetric_space γ :=
+emetric_space.of_t0_pseudo_emetric_space γ
 
 lemma is_closed_of_pairwise_le_dist {s : set γ} {ε : ℝ} (hε : 0 < ε)
   (hs : s.pairwise (λ x y, ε ≤ dist x y)) : is_closed s :=
@@ -2483,13 +2799,13 @@ end metric
 See Note [forgetful inheritance].
 -/
 def metric_space.replace_uniformity {γ} [U : uniform_space γ] (m : metric_space γ)
-  (H : @uniformity _ U = @uniformity _ emetric_space.to_uniform_space') :
+  (H : 𝓤[U] = 𝓤[pseudo_emetric_space.to_uniform_space]) :
   metric_space γ :=
 { eq_of_dist_eq_zero := @eq_of_dist_eq_zero _ _,
   ..pseudo_metric_space.replace_uniformity m.to_pseudo_metric_space H, }
 
 lemma metric_space.replace_uniformity_eq {γ} [U : uniform_space γ] (m : metric_space γ)
-  (H : @uniformity _ U = @uniformity _ emetric_space.to_uniform_space') :
+  (H : 𝓤[U] = 𝓤[pseudo_emetric_space.to_uniform_space]) :
   m.replace_uniformity H = m :=
 by { ext, refl }
 
@@ -2500,12 +2816,7 @@ See Note [forgetful inheritance].
 @[reducible] def metric_space.replace_topology {γ} [U : topological_space γ] (m : metric_space γ)
   (H : U = m.to_pseudo_metric_space.to_uniform_space.to_topological_space) :
   metric_space γ :=
-begin
-  let t := m.to_pseudo_metric_space.to_uniform_space.replace_topology H,
-  letI : uniform_space γ := t,
-  have : @uniformity _ t = @uniformity _ m.to_pseudo_metric_space.to_uniform_space := rfl,
-  exact m.replace_uniformity this
-end
+@metric_space.replace_uniformity γ (m.to_uniform_space.replace_topology H) m rfl
 
 lemma metric_space.replace_topology_eq {γ} [U : topological_space γ] (m : metric_space γ)
   (H : U = m.to_pseudo_metric_space.to_uniform_space.to_topological_space) :
@@ -2522,17 +2833,31 @@ def emetric_space.to_metric_space_of_dist {α : Type u} [e : emetric_space α]
   (edist_ne_top : ∀x y: α, edist x y ≠ ⊤)
   (h : ∀x y, dist x y = ennreal.to_real (edist x y)) :
   metric_space α :=
-{ dist := dist,
-  eq_of_dist_eq_zero := λx y hxy,
-    by simpa [h, ennreal.to_real_eq_zero_iff, edist_ne_top x y] using hxy,
-  ..pseudo_emetric_space.to_pseudo_metric_space_of_dist dist edist_ne_top h, }
+@metric_space.of_t0_pseudo_metric_space α
+  (pseudo_emetric_space.to_pseudo_metric_space_of_dist dist edist_ne_top h) _
 
 /-- One gets a metric space from an emetric space if the edistance
 is everywhere finite, by pushing the edistance to reals. We set it up so that the edist and the
 uniformity are defeq in the metric space and the emetric space. -/
-def emetric_space.to_metric_space {α : Type u} [e : emetric_space α] (h : ∀x y: α, edist x y ≠ ⊤) :
+def emetric_space.to_metric_space {α : Type u} [emetric_space α] (h : ∀ x y : α, edist x y ≠ ⊤) :
+  metric_space α :=
+emetric_space.to_metric_space_of_dist (λx y, ennreal.to_real (edist x y)) h (λ x y, rfl)
+
+/-- Build a new metric space from an old one where the bundled bornology structure is provably
+(but typically non-definitionaly) equal to some given bornology structure.
+See Note [forgetful inheritance].
+-/
+def metric_space.replace_bornology {α} [B : bornology α] (m : metric_space α)
+  (H : ∀ s, @is_bounded _ B s ↔ @is_bounded _ pseudo_metric_space.to_bornology s) :
   metric_space α :=
-emetric_space.to_metric_space_of_dist (λx y, ennreal.to_real (edist x y)) h (λx y, rfl)
+{ to_bornology := B,
+  .. pseudo_metric_space.replace_bornology _ H,
+  .. m }
+
+lemma metric_space.replace_bornology_eq {α} [m : metric_space α] [B : bornology α]
+  (H : ∀ s, @is_bounded _ B s ↔ @is_bounded _ pseudo_metric_space.to_bornology s) :
+  metric_space.replace_bornology _ H = m :=
+by { ext, refl }
 
 /-- Metric space structure pulled back by an injective function. Injectivity is necessary to
 ensure that `dist x y = 0` only if `x = y`. -/
@@ -2565,12 +2890,11 @@ metric_space.induced coe subtype.coe_injective ‹_›
 @[to_additive] instance {α : Type*} [metric_space α] : metric_space (αᵐᵒᵖ) :=
 metric_space.induced mul_opposite.unop mul_opposite.unop_injective ‹_›
 
-local attribute [instance] filter.unique
-
 instance : metric_space empty :=
 { dist := λ _ _, 0,
   dist_self := λ _, rfl,
   dist_comm := λ _ _, rfl,
+  edist := λ _ _, 0,
   eq_of_dist_eq_zero := λ _ _ _, subsingleton.elim _ _,
   dist_triangle := λ _ _ _, show (0:ℝ) ≤ 0 + 0, by rw add_zero,
   to_uniform_space := empty.uniform_space,
@@ -2580,6 +2904,7 @@ instance : metric_space punit.{u + 1} :=
 { dist := λ _ _, 0,
   dist_self := λ _, rfl,
   dist_comm := λ _ _, rfl,
+  edist := λ _ _, 0,
   eq_of_dist_eq_zero := λ _ _ _, subsingleton.elim _ _,
   dist_triangle := λ _ _ _, show (0:ℝ) ≤ 0 + 0, by rw add_zero,
   to_uniform_space := punit.uniform_space,
@@ -2595,7 +2920,7 @@ instance : metric_space punit.{u + 1} :=
 section real
 
 /-- Instantiate the reals as a metric space. -/
-noncomputable instance real.metric_space : metric_space ℝ :=
+instance real.metric_space : metric_space ℝ :=
 { eq_of_dist_eq_zero := λ x y h, by simpa [dist, sub_eq_zero] using h,
   ..real.pseudo_metric_space }
 
@@ -2603,13 +2928,16 @@ end real
 
 section nnreal
 
-noncomputable instance : metric_space ℝ≥0 := subtype.metric_space
+instance : metric_space ℝ≥0 := subtype.metric_space
 
 end nnreal
 
+instance [metric_space β] : metric_space (ulift β) :=
+metric_space.induced ulift.down ulift.down_injective ‹_›
+
 section prod
 
-noncomputable instance prod.metric_space_max [metric_space β] : metric_space (γ × β) :=
+instance prod.metric_space_max [metric_space β] : metric_space (γ × β) :=
 { eq_of_dist_eq_zero := λ x y h, begin
     cases max_le_iff.1 (le_of_eq h) with h₁ h₂,
     exact prod.ext_iff.2 ⟨dist_le_zero.1 h₁, dist_le_zero.1 h₂⟩
@@ -2623,7 +2951,7 @@ open finset
 variables {π : β → Type*} [fintype β] [∀b, metric_space (π b)]
 
 /-- A finite product of metric spaces is a metric space, with the sup distance. -/
-noncomputable instance metric_space_pi : metric_space (Πb, π b) :=
+instance metric_space_pi : metric_space (Πb, π b) :=
   /- we construct the instance from the emetric space instance to avoid checking again that the
   uniformity is the same as the product uniformity, but we register nevertheless a nice formula
   for the distance -/
@@ -2667,60 +2995,91 @@ end metric
 
 section eq_rel
 
-/-- The canonical equivalence relation on a pseudometric space. -/
-def pseudo_metric.dist_setoid (α : Type u) [pseudo_metric_space α] : setoid α :=
-setoid.mk (λx y, dist x y = 0)
-begin
-  unfold equivalence,
-  repeat { split },
-  { exact pseudo_metric_space.dist_self },
-  { assume x y h, rwa pseudo_metric_space.dist_comm },
-  { assume x y z hxy hyz,
-    refine le_antisymm _ dist_nonneg,
-    calc dist x z ≤ dist x y + dist y z : pseudo_metric_space.dist_triangle _ _ _
-         ... = 0 + 0 : by rw [hxy, hyz]
-         ... = 0 : by simp }
-end
-
-local attribute [instance] pseudo_metric.dist_setoid
-
-/-- The canonical quotient of a pseudometric space, identifying points at distance `0`. -/
-@[reducible] definition pseudo_metric_quot (α : Type u) [pseudo_metric_space α] : Type* :=
-quotient (pseudo_metric.dist_setoid α)
-
-instance has_dist_metric_quot {α : Type u} [pseudo_metric_space α] :
-  has_dist (pseudo_metric_quot α) :=
-{ dist := quotient.lift₂ (λp q : α, dist p q)
-begin
-  assume x y x' y' hxx' hyy',
-  have Hxx' : dist x x' = 0 := hxx',
-  have Hyy' : dist y y' = 0 := hyy',
-  have A : dist x y ≤ dist x' y' := calc
-    dist x y ≤ dist x x' + dist x' y : pseudo_metric_space.dist_triangle _ _ _
-    ... = dist x' y : by simp [Hxx']
-    ... ≤ dist x' y' + dist y' y : pseudo_metric_space.dist_triangle _ _ _
-    ... = dist x' y' : by simp [pseudo_metric_space.dist_comm, Hyy'],
-  have B : dist x' y' ≤ dist x y := calc
-    dist x' y' ≤ dist x' x + dist x y' : pseudo_metric_space.dist_triangle _ _ _
-    ... = dist x y' : by simp [pseudo_metric_space.dist_comm, Hxx']
-    ... ≤ dist x y + dist y y' : pseudo_metric_space.dist_triangle _ _ _
-    ... = dist x y : by simp [Hyy'],
-  exact le_antisymm A B
-end }
-
-lemma pseudo_metric_quot_dist_eq {α : Type u} [pseudo_metric_space α] (p q : α) :
-  dist ⟦p⟧ ⟦q⟧ = dist p q := rfl
-
-instance metric_space_quot {α : Type u} [pseudo_metric_space α] :
-  metric_space (pseudo_metric_quot α) :=
-{ dist_self := begin
-    refine quotient.ind (λy, _),
-    exact pseudo_metric_space.dist_self _
-  end,
-  eq_of_dist_eq_zero := λxc yc, by exact quotient.induction_on₂ xc yc (λx y H, quotient.sound H),
-  dist_comm :=
-    λxc yc, quotient.induction_on₂ xc yc (λx y, pseudo_metric_space.dist_comm _ _),
-  dist_triangle :=
-    λxc yc zc, quotient.induction_on₃ xc yc zc (λx y z, pseudo_metric_space.dist_triangle _ _ _) }
+instance {α : Type u} [pseudo_metric_space α] :
+  has_dist (uniform_space.separation_quotient α) :=
+{ dist := λ p q, quotient.lift_on₂' p q dist $ λ x y x' y' hx hy,
+    by rw [dist_edist, dist_edist, ← uniform_space.separation_quotient.edist_mk x,
+      ← uniform_space.separation_quotient.edist_mk x', quot.sound hx, quot.sound hy] }
+
+lemma uniform_space.separation_quotient.dist_mk {α : Type u} [pseudo_metric_space α] (p q : α) :
+  @dist (uniform_space.separation_quotient α) _ (quot.mk _ p) (quot.mk _ q) = dist p q :=
+rfl
+
+instance {α : Type u} [pseudo_metric_space α] :
+  metric_space (uniform_space.separation_quotient α) :=
+emetric_space.to_metric_space_of_dist dist (λ x y, quotient.induction_on₂' x y edist_ne_top) $
+  λ x y, quotient.induction_on₂' x y dist_edist
 
 end eq_rel
+
+/-!
+### `additive`, `multiplicative`
+
+The distance on those type synonyms is inherited without change.
+-/
+
+open additive multiplicative
+
+section
+variables [has_dist X]
+
+instance : has_dist (additive X) := ‹has_dist X›
+instance : has_dist (multiplicative X) := ‹has_dist X›
+
+@[simp] lemma dist_of_mul (a b : X) : dist (of_mul a) (of_mul b) = dist a b := rfl
+@[simp] lemma dist_of_add (a b : X) : dist (of_add a) (of_add b) = dist a b := rfl
+@[simp] lemma dist_to_mul (a b : additive X) : dist (to_mul a) (to_mul b) = dist a b := rfl
+@[simp] lemma dist_to_add (a b : multiplicative X) : dist (to_add a) (to_add b) = dist a b := rfl
+
+end
+
+section
+variables [pseudo_metric_space X]
+
+instance : pseudo_metric_space (additive X) := ‹pseudo_metric_space X›
+instance : pseudo_metric_space (multiplicative X) := ‹pseudo_metric_space X›
+
+@[simp] lemma nndist_of_mul (a b : X) : nndist (of_mul a) (of_mul b) = nndist a b := rfl
+@[simp] lemma nndist_of_add (a b : X) : nndist (of_add a) (of_add b) = nndist a b := rfl
+@[simp] lemma nndist_to_mul (a b : additive X) : nndist (to_mul a) (to_mul b) = nndist a b := rfl
+@[simp] lemma nndist_to_add (a b : multiplicative X) : nndist (to_add a) (to_add b) = nndist a b :=
+rfl
+
+end
+
+instance [metric_space X] : metric_space (additive X) := ‹metric_space X›
+instance [metric_space X] : metric_space (multiplicative X) := ‹metric_space X›
+instance [pseudo_metric_space X] [proper_space X] : proper_space (additive X) := ‹proper_space X›
+instance [pseudo_metric_space X] [proper_space X] : proper_space (multiplicative X) :=
+‹proper_space X›
+
+/-!
+### Order dual
+
+The distance on this type synonym is inherited without change.
+-/
+
+open order_dual
+
+section
+variables [has_dist X]
+
+instance : has_dist Xᵒᵈ := ‹has_dist X›
+
+@[simp] lemma dist_to_dual (a b : X) : dist (to_dual a) (to_dual b) = dist a b := rfl
+@[simp] lemma dist_of_dual (a b : Xᵒᵈ) : dist (of_dual a) (of_dual b) = dist a b := rfl
+
+end
+
+section
+variables [pseudo_metric_space X]
+
+instance : pseudo_metric_space Xᵒᵈ := ‹pseudo_metric_space X›
+
+@[simp] lemma nndist_to_dual (a b : X) : nndist (to_dual a) (to_dual b) = nndist a b := rfl
+@[simp] lemma nndist_of_dual (a b : Xᵒᵈ) : nndist (of_dual a) (of_dual b) = nndist a b := rfl
+
+end
+
+instance [metric_space X] : metric_space Xᵒᵈ := ‹metric_space X›
+instance [pseudo_metric_space X] [proper_space X] : proper_space Xᵒᵈ := ‹proper_space X›
diff --git a/src/topology/metric_space/cantor_scheme.lean b/src/topology/metric_space/cantor_scheme.lean
new file mode 100644
index 0000000000000..eea5317cc3187
--- /dev/null
+++ b/src/topology/metric_space/cantor_scheme.lean
@@ -0,0 +1,198 @@
+/-
+Copyright (c) 2023 Felix Weilacher. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Felix Weilacher
+-/
+import topology.metric_space.pi_nat
+
+/-!
+# (Topological) Schemes and their induced maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In topology, and especially descriptive set theory, one often constructs functions `(ℕ → β) → α`,
+where α is some topological space and β is a discrete space, as an appropriate limit of some map
+`list β → set α`. We call the latter type of map a "`β`-scheme on `α`".
+
+This file develops the basic, abstract theory of these schemes and the functions they induce.
+
+## Main Definitions
+
+* `cantor_scheme.induced_map A` : The aforementioned "limit" of a scheme `A : list β → set α`.
+  This is a partial function from `ℕ → β` to `a`,
+  implemented here as an object of type `Σ s : set (ℕ → β), s → α`.
+  That is, `(induced_map A).1` is the domain and `(induced_map A).2` is the function.
+
+## Implementation Notes
+
+We consider end-appending to be the fundamental way to build lists (say on `β`) inductively,
+as this interacts better with the topology on `ℕ → β`.
+As a result, functions like `list.nth` or `stream.take` do not have their intended meaning
+in this file. See instead `pi_nat.res`.
+
+## References
+
+* [kechris1995] (Chapters 6-7)
+
+## Tags
+
+scheme, cantor scheme, lusin scheme, approximation.
+
+-/
+
+namespace cantor_scheme
+
+open list function filter set pi_nat
+open_locale classical topology
+
+variables {β α : Type*} (A : list β → set α)
+
+/-- From a `β`-scheme on `α` `A`, we define a partial function from `(ℕ → β)` to `α`
+which sends each infinite sequence `x` to an element of the intersection along the
+branch corresponding to `x`, if it exists.
+We call this the map induced by the scheme. -/
+noncomputable def induced_map : Σ s : set (ℕ → β), s → α :=
+⟨λ x, set.nonempty ⋂ n : ℕ, A (res x n), λ x, x.property.some⟩
+
+section topology
+
+/-- A scheme is antitone if each set contains its children. -/
+protected def antitone : Prop := ∀ l : list β, ∀ a : β, A (a :: l) ⊆ A l
+
+/-- A useful strengthening of being antitone is to require that each set contains
+the closure of each of its children. -/
+def closure_antitone [topological_space α] : Prop :=
+∀ l : list β, ∀ a : β, closure (A (a :: l)) ⊆ A l
+
+/-- A scheme is disjoint if the children of each set of pairwise disjoint. -/
+protected def disjoint : Prop :=
+∀ l : list β, _root_.pairwise $ λ a b, disjoint (A (a :: l)) (A (b :: l))
+
+variable {A}
+
+/-- If `x` is in the domain of the induced map of a scheme `A`,
+its image under this map is in each set along the corresponding branch. -/
+lemma map_mem (x : (induced_map A).1) (n : ℕ) :
+  (induced_map A).2 x ∈ A (res x n) :=
+begin
+  have := x.property.some_mem,
+  rw mem_Inter at this,
+  exact this n,
+end
+
+protected lemma closure_antitone.antitone [topological_space α] (hA : closure_antitone A) :
+  cantor_scheme.antitone A :=
+λ l a, subset_closure.trans (hA l a)
+
+protected lemma antitone.closure_antitone [topological_space α] (hanti : cantor_scheme.antitone A)
+  (hclosed : ∀ l, is_closed (A l)) : closure_antitone A :=
+λ l a, (hclosed _).closure_eq.subset.trans (hanti _ _)
+
+/-- A scheme where the children of each set are pairwise disjoint induces an injective map. -/
+theorem disjoint.map_injective (hA : cantor_scheme.disjoint A) : injective (induced_map A).2 :=
+begin
+  rintros ⟨x, hx⟩ ⟨y, hy⟩ hxy,
+  refine subtype.coe_injective (res_injective _),
+  dsimp,
+  ext n : 1,
+  induction n with n ih, { simp },
+  simp only [res_succ],
+  refine ⟨_, ih⟩,
+  contrapose hA,
+  simp only [cantor_scheme.disjoint, _root_.pairwise, ne.def, not_forall, exists_prop],
+  refine ⟨res x n, _, _, hA, _⟩,
+  rw not_disjoint_iff,
+  refine ⟨(induced_map A).2 ⟨x, hx⟩, _, _⟩,
+  { rw ← res_succ,
+    apply map_mem, },
+  rw [hxy, ih, ← res_succ],
+  apply map_mem,
+end
+
+end topology
+
+section metric
+
+variable [pseudo_metric_space α]
+
+variable (A)
+
+/-- A scheme on a metric space has vanishing diameter if diameter approaches 0 along each branch. -/
+def vanishing_diam : Prop :=
+∀ x : ℕ → β, tendsto (λ n : ℕ, emetric.diam (A (res x n))) at_top (𝓝 0)
+
+variable {A}
+
+lemma vanishing_diam.dist_lt (hA : vanishing_diam A) (ε : ℝ) (ε_pos : 0 < ε) (x : ℕ → β) :
+  ∃ n : ℕ, ∀ y z ∈ A (res x n), dist y z < ε :=
+begin
+  specialize hA x,
+  rw ennreal.tendsto_at_top_zero at hA,
+  cases hA (ennreal.of_real (ε / 2))
+    (by { simp only [gt_iff_lt, ennreal.of_real_pos], linarith }) with n hn,
+  use n,
+  intros y hy z hz,
+  rw [← ennreal.of_real_lt_of_real_iff ε_pos, ← edist_dist],
+  apply lt_of_le_of_lt (emetric.edist_le_diam_of_mem hy hz),
+  apply lt_of_le_of_lt (hn _ (le_refl _)),
+  rw ennreal.of_real_lt_of_real_iff ε_pos,
+  linarith,
+end
+
+/-- A scheme with vanishing diameter along each branch induces a continuous map. -/
+theorem vanishing_diam.map_continuous [topological_space β] [discrete_topology β]
+  (hA : vanishing_diam A) : continuous (induced_map A).2 :=
+begin
+  rw metric.continuous_iff',
+  rintros ⟨x, hx⟩ ε ε_pos,
+  cases hA.dist_lt _ ε_pos x with n hn,
+  rw _root_.eventually_nhds_iff,
+  refine ⟨coe ⁻¹' cylinder x n, _, _, by simp⟩,
+  { rintros ⟨y, hy⟩ hyx,
+    rw [mem_preimage, subtype.coe_mk, cylinder_eq_res, mem_set_of] at hyx,
+    apply hn,
+    { rw ← hyx,
+      apply map_mem, },
+    apply map_mem, },
+  apply continuous_subtype_coe.is_open_preimage,
+  apply is_open_cylinder,
+end
+
+/-- A scheme on a complete space with vanishing diameter
+such that each set contains the closure of its children
+induces a total map. -/
+theorem closure_antitone.map_of_vanishing_diam [complete_space α]
+  (hdiam : vanishing_diam A) (hanti : closure_antitone A) (hnonempty : ∀ l, (A l).nonempty) :
+  (induced_map A).1 = univ :=
+begin
+  rw eq_univ_iff_forall,
+  intro x,
+  choose u hu using λ n, hnonempty (res x n),
+  have umem : ∀ n m : ℕ, n ≤ m → u m ∈ A (res x n),
+  { have : antitone (λ n : ℕ, A (res x n)),
+    { refine antitone_nat_of_succ_le _,
+      intro n,
+      apply hanti.antitone, },
+    intros n m hnm,
+    exact this hnm (hu _), },
+  have : cauchy_seq u,
+  { rw metric.cauchy_seq_iff,
+    intros ε ε_pos,
+    cases hdiam.dist_lt _ ε_pos x with n hn,
+    use n,
+    intros m₀ hm₀ m₁ hm₁,
+    apply hn; apply umem; assumption, },
+  cases cauchy_seq_tendsto_of_complete this with y hy,
+  use y,
+  rw mem_Inter,
+  intro n,
+  apply hanti _ (x n),
+  apply mem_closure_of_tendsto hy,
+  rw eventually_at_top,
+  exact ⟨n.succ, umem _⟩,
+end
+
+end metric
+
+end cantor_scheme
diff --git a/src/topology/metric_space/cau_seq_filter.lean b/src/topology/metric_space/cau_seq_filter.lean
index 0fc2cd93982c0..4acfa430161bc 100644
--- a/src/topology/metric_space/cau_seq_filter.lean
+++ b/src/topology/metric_space/cau_seq_filter.lean
@@ -3,11 +3,14 @@ Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis, Sébastien Gouëzel
 -/
-import analysis.normed_space.basic
+import analysis.normed.field.basic
 
 /-!
 # Completeness in terms of `cauchy` filters vs `is_cau_seq` sequences
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we apply `metric.complete_of_cauchy_seq_tendsto` to prove that a `normed_ring`
 is complete in terms of `cauchy` filter if and only if it is complete in terms
 of `cau_seq` Cauchy sequences.
@@ -15,7 +18,7 @@ of `cau_seq` Cauchy sequences.
 
 universes u v
 open set filter
-open_locale topological_space classical
+open_locale topology classical
 
 variable {β : Type v}
 
@@ -41,16 +44,10 @@ variables [normed_field β]
  This section shows that if we have a uniform space generated by an absolute value, topological
  completeness and Cauchy sequence completeness coincide. The problem is that there isn't
  a good notion of "uniform space generated by an absolute value", so right now this is
- specific to norm. Furthermore, norm only instantiates is_absolute_value on normed_field.
+ specific to norm. Furthermore, norm only instantiates is_absolute_value on normed_division_ring.
  This needs to be fixed, since it prevents showing that ℤ_[hp] is complete
 -/
 
-instance normed_field.is_absolute_value : is_absolute_value (norm : β → ℝ) :=
-{ abv_nonneg := norm_nonneg,
-  abv_eq_zero := λ _, norm_eq_zero,
-  abv_add := norm_add_le,
-  abv_mul := norm_mul }
-
 open metric
 
 lemma cauchy_seq.is_cau_seq {f : ℕ → β} (hf : cauchy_seq f) :
diff --git a/src/topology/metric_space/closeds.lean b/src/topology/metric_space/closeds.lean
index 65dce2d63b87b..fa1cdd15b9b8d 100644
--- a/src/topology/metric_space/closeds.lean
+++ b/src/topology/metric_space/closeds.lean
@@ -10,6 +10,9 @@ import topology.sets.compacts
 /-!
 # Closed subsets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the metric and emetric space structure on the types of closed subsets and nonempty
 compact subsets of a metric or emetric space.
 
@@ -23,7 +26,7 @@ always finite in this context.
 -/
 
 noncomputable theory
-open_locale classical topological_space ennreal
+open_locale classical topology ennreal
 
 universe u
 open classical set function topological_space filter
@@ -188,12 +191,13 @@ instance closeds.compact_space [compact_space α] : compact_space (closeds α) :
     i.e., for all ε>0, there is a finite set which is ε-dense.
     start from a set `s` which is ε-dense in α. Then the subsets of `s`
     are finitely many, and ε-dense for the Hausdorff distance. -/
-  refine compact_of_totally_bounded_is_closed (emetric.totally_bounded_iff.2 (λε εpos, _))
+  refine is_compact_of_totally_bounded_is_closed (emetric.totally_bounded_iff.2 (λε εpos, _))
     is_closed_univ,
   rcases exists_between εpos with ⟨δ, δpos, δlt⟩,
   rcases emetric.totally_bounded_iff.1
-    (compact_iff_totally_bounded_complete.1 (@compact_univ α _ _)).1 δ δpos with ⟨s, fs, hs⟩,
-  -- s : set α,  fs : finite s,  hs : univ ⊆ ⋃ (y : α) (H : y ∈ s), eball y δ
+    (is_compact_iff_totally_bounded_is_complete.1 (@is_compact_univ α _ _)).1 δ δpos
+    with ⟨s, fs, hs⟩,
+  -- s : set α,  fs : s.finite,  hs : univ ⊆ ⋃ (y : α) (H : y ∈ s), eball y δ
   -- we first show that any set is well approximated by a subset of `s`.
   have main : ∀ u : set α, ∃v ⊆ s, Hausdorff_edist u v ≤ δ,
   { assume u,
@@ -211,12 +215,13 @@ instance closeds.compact_space [compact_space α] : compact_space (closeds α) :
   let F := {f : closeds α | (f : set α) ⊆ s},
   refine ⟨F, _, λ u _, _⟩,
   -- `F` is finite
-  { apply @finite_of_finite_image _ _ F coe,
-    { exact set_like.coe_injective.inj_on F },
-    { refine fs.finite_subsets.subset (λb, _),
+  { apply @finite.of_finite_image _ _ F coe,
+    { apply fs.finite_subsets.subset (λb, _),
       simp only [and_imp, set.mem_image, set.mem_set_of_eq, exists_imp_distrib],
       assume x hx hx',
-      rwa hx' at hx }},
+      rwa hx' at hx },
+    { exact set_like.coe_injective.inj_on F } },
+
   -- `F` is ε-dense
   { obtain ⟨t0, t0s, Dut0⟩ := main u,
     have : is_closed t0 := (fs.subset t0s).is_compact.is_closed,
@@ -236,7 +241,7 @@ instance nonempty_compacts.emetric_space : emetric_space (nonempty_compacts α)
   edist_triangle      := λs t u, Hausdorff_edist_triangle,
   eq_of_edist_eq_zero := λ s t h, nonempty_compacts.ext $ begin
     have : closure (s : set α) = closure t := Hausdorff_edist_zero_iff_closure_eq_closure.1 h,
-    rwa [s.compact.is_closed.closure_eq, t.compact.is_closed.closure_eq] at this,
+    rwa [s.is_compact.is_closed.closure_eq, t.is_compact.is_closed.closure_eq] at this,
   end }
 
 /-- `nonempty_compacts.to_closeds` is a uniform embedding (as it is an isometry) -/
@@ -253,7 +258,7 @@ begin
   { ext s,
     refine ⟨_, λ h, ⟨⟨⟨s, h.2⟩, h.1⟩, closeds.ext rfl⟩⟩,
     rintro ⟨s, hs, rfl⟩,
-    exact ⟨s.nonempty, s.compact⟩ },
+    exact ⟨s.nonempty, s.is_compact⟩ },
   rw this,
   refine is_closed_of_closure_subset (λs hs, ⟨_, _⟩),
   { -- take a set set t which is nonempty and at a finite distance of s
@@ -261,16 +266,16 @@ begin
     rw edist_comm at Dst,
     -- since `t` is nonempty, so is `s`
     exact nonempty_of_Hausdorff_edist_ne_top ht.1 (ne_of_lt Dst) },
-  { refine compact_iff_totally_bounded_complete.2 ⟨_, s.closed.is_complete⟩,
+  { refine is_compact_iff_totally_bounded_is_complete.2 ⟨_, s.closed.is_complete⟩,
     refine totally_bounded_iff.2 (λε (εpos : 0 < ε), _),
     -- we have to show that s is covered by finitely many eballs of radius ε
     -- pick a nonempty compact set t at distance at most ε/2 of s
     rcases mem_closure_iff.1 hs (ε/2) (ennreal.half_pos εpos.ne') with ⟨t, ht, Dst⟩,
     -- cover this space with finitely many balls of radius ε/2
-    rcases totally_bounded_iff.1 (compact_iff_totally_bounded_complete.1 ht.2).1 (ε/2)
+    rcases totally_bounded_iff.1 (is_compact_iff_totally_bounded_is_complete.1 ht.2).1 (ε/2)
       (ennreal.half_pos εpos.ne') with ⟨u, fu, ut⟩,
     refine ⟨u, ⟨fu, λx hx, _⟩⟩,
-    -- u : set α,  fu : finite u,  ut : t ⊆ ⋃ (y : α) (H : y ∈ u), eball y (ε / 2)
+    -- u : set α,  fu : u.finite,  ut : t ⊆ ⋃ (y : α) (H : y ∈ u), eball y (ε / 2)
     -- then s is covered by the union of the balls centered at u of radius ε
     rcases exists_edist_lt_of_Hausdorff_edist_lt hx Dst with ⟨z, hz, Dxz⟩,
     rcases mem_Union₂.1 (ut hz) with ⟨y, hy, Dzy⟩,
@@ -311,10 +316,10 @@ begin
     approximations in `s` of the centers of these balls give the required finite approximation
     of `t`. -/
     rcases exists_countable_dense α with ⟨s, cs, s_dense⟩,
-    let v0 := {t : set α | finite t ∧ t ⊆ s},
+    let v0 := {t : set α | t.finite ∧ t ⊆ s},
     let v : set (nonempty_compacts α) := {t : nonempty_compacts α | (t : set α) ∈ v0},
     refine  ⟨⟨v, _, _⟩⟩,
-    { have : countable v0, from countable_set_of_finite_subset cs,
+    { have : v0.countable, from countable_set_of_finite_subset cs,
       exact this.preimage set_like.coe_injective },
     { refine λt, mem_closure_iff.2 (λε εpos, _),
       -- t is a compact nonempty set, that we have to approximate uniformly by a a set in `v`.
@@ -329,12 +334,12 @@ begin
       have Fspec : ∀x, F x ∈ s ∧ edist x (F x) < δ/2 := λx, some_spec (Exy x),
 
       -- cover `t` with finitely many balls. Their centers form a set `a`
-      have : totally_bounded (t : set α) := t.compact.totally_bounded,
+      have : totally_bounded (t : set α) := t.is_compact.totally_bounded,
       rcases totally_bounded_iff.1 this (δ/2) δpos' with ⟨a, af, ta⟩,
-      -- a : set α,  af : finite a,  ta : t ⊆ ⋃ (y : α) (H : y ∈ a), eball y (δ / 2)
+      -- a : set α,  af : a.finite,  ta : t ⊆ ⋃ (y : α) (H : y ∈ a), eball y (δ / 2)
       -- replace each center by a nearby approximation in `s`, giving a new set `b`
       let b := F '' a,
-      have : finite b := af.image _,
+      have : b.finite := af.image _,
       have tb : ∀ x ∈ t, ∃ y ∈ b, edist x y < δ,
       { assume x hx,
         rcases mem_Union₂.1 (ta hx) with ⟨z, za, Dxz⟩,
@@ -344,7 +349,7 @@ begin
              ... = δ : ennreal.add_halves _ },
       -- keep only the points in `b` that are close to point in `t`, yielding a new set `c`
       let c := {y ∈ b | ∃ x ∈ t, edist x y < δ},
-      have : finite c := ‹finite b›.subset (λx hx, hx.1),
+      have : c.finite := ‹b.finite›.subset (λx hx, hx.1),
       -- points in `t` are well approximated by points in `c`
       have tc : ∀ x ∈ t, ∃ y ∈ c, edist x y ≤ δ,
       { assume x hx,
@@ -366,17 +371,17 @@ begin
       have hc : c.nonempty,
         from nonempty_of_Hausdorff_edist_ne_top t.nonempty (ne_top_of_lt Dtc),
       -- let `d` be the version of `c` in the type `nonempty_compacts α`
-      let d : nonempty_compacts α := ⟨⟨c, ‹finite c›.is_compact⟩, hc⟩,
+      let d : nonempty_compacts α := ⟨⟨c, ‹c.finite›.is_compact⟩, hc⟩,
       have : c ⊆ s,
       { assume x hx,
         rcases (mem_image _ _ _).1 hx.1 with ⟨y, ⟨ya, yx⟩⟩,
         rw ← yx,
         exact (Fspec y).1 },
-      have : d ∈ v := ⟨‹finite c›, this⟩,
+      have : d ∈ v := ⟨‹c.finite›, this⟩,
       -- we have proved that `d` is a good approximation of `t` as requested
       exact ⟨d, ‹d ∈ v›, Dtc⟩ },
   end,
-  apply uniform_space.second_countable_of_separable,
+  exact uniform_space.second_countable_of_separable (nonempty_compacts α),
 end
 
 end --section
@@ -391,7 +396,7 @@ variables {α : Type u} [metric_space α]
 edistance between two such sets is finite. -/
 instance nonempty_compacts.metric_space : metric_space (nonempty_compacts α) :=
 emetric_space.to_metric_space $ λ x y, Hausdorff_edist_ne_top_of_nonempty_of_bounded
-  x.nonempty y.nonempty x.compact.bounded y.compact.bounded
+  x.nonempty y.nonempty x.is_compact.bounded y.is_compact.bounded
 
 /-- The distance on `nonempty_compacts α` is the Hausdorff distance, by construction -/
 lemma nonempty_compacts.dist_eq {x y : nonempty_compacts α} :
diff --git a/src/topology/metric_space/completion.lean b/src/topology/metric_space/completion.lean
index f9271f26ee2b8..1045b5d7de514 100644
--- a/src/topology/metric_space/completion.lean
+++ b/src/topology/metric_space/completion.lean
@@ -10,6 +10,9 @@ import topology.instances.real
 /-!
 # The completion of a metric space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Completion of uniform spaces are already defined in `topology.uniform_space.completion`. We show
 here that the uniform space completion of a metric space inherits a metric space structure,
 by extending the distance to the completion and checking that it is indeed a distance, and that
@@ -17,7 +20,7 @@ it defines the same uniformity as the already defined uniform structure on the c
 -/
 
 open set filter uniform_space metric
-open_locale filter topological_space uniformity
+open_locale filter topology uniformity
 noncomputable theory
 
 universes u v
@@ -167,12 +170,13 @@ instance : metric_space (completion α) :=
   eq_of_dist_eq_zero := completion.eq_of_dist_eq_zero,
   dist_comm          := completion.dist_comm,
   dist_triangle      := completion.dist_triangle,
+  dist               := dist,
   to_uniform_space   := by apply_instance,
   uniformity_dist    := completion.uniformity_dist }
 
 /-- The embedding of a metric space in its completion is an isometry. -/
 lemma coe_isometry : isometry (coe : α → completion α) :=
-isometry_emetric_iff_metric.2 completion.dist_eq
+isometry.of_dist_eq completion.dist_eq
 
 @[simp] protected lemma edist_eq (x y : α) : edist (x : completion α) y = edist x y :=
 coe_isometry x y
diff --git a/src/topology/metric_space/contracting.lean b/src/topology/metric_space/contracting.lean
index 8daeb4f8b0b6e..daaac22d04149 100644
--- a/src/topology/metric_space/contracting.lean
+++ b/src/topology/metric_space/contracting.lean
@@ -10,6 +10,9 @@ import dynamics.fixed_points.topology
 /-!
 # Contracting maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A Lipschitz continuous self-map with Lipschitz constant `K < 1` is called a *contracting map*.
 In this file we prove the Banach fixed point theorem, some explicit estimates on the rate
 of convergence, and some properties of the map sending a contracting map to its fixed point.
@@ -27,7 +30,7 @@ of convergence, and some properties of the map sending a contracting map to its
 contracting map, fixed point, Banach fixed point theorem
 -/
 
-open_locale nnreal topological_space classical ennreal
+open_locale nnreal topology classical ennreal
 open filter function
 
 variables {α : Type*}
diff --git a/src/topology/metric_space/dilation.lean b/src/topology/metric_space/dilation.lean
new file mode 100644
index 0000000000000..d9b8ecdeb9dc6
--- /dev/null
+++ b/src/topology/metric_space/dilation.lean
@@ -0,0 +1,396 @@
+/-
+Copyright (c) 2022 Hanting Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Dilations of emetric and metric spaces
+Authors: Hanting Zhang
+-/
+import topology.metric_space.antilipschitz
+import data.fun_like.basic
+
+/-!
+# Dilations
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define dilations, i.e., maps between emetric spaces that satisfy
+`edist (f x) (f y) = r * edist x y` for some `r ∉ {0, ∞}`.
+
+The value `r = 0` is not allowed because we want dilations of (e)metric spaces to be automatically
+injective. The value `r = ∞` is not allowed because this way we can define `dilation.ratio f : ℝ≥0`,
+not `dilation.ratio f : ℝ≥0∞`. Also, we do not often need maps sending distinct points to points at
+infinite distance.
+
+## Main defintions
+
+* `dilation.ratio f : ℝ≥0`: the value of `r` in the relation above, defaulting to 1 in the case
+  where it is not well-defined.
+
+## Implementation notes
+
+The type of dilations defined in this file are also referred to as "similarities" or "similitudes"
+by other authors. The name `dilation` was choosen to match the Wikipedia name.
+
+Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
+theory for `pseudo_emetric_space` and we specialize to `pseudo_metric_space` and `metric_space` when
+needed.
+
+## TODO
+
+- Introduce dilation equivs.
+- Refactor the `isometry` API to match the `*_hom_class` API below.
+
+## References
+
+- https://en.wikipedia.org/wiki/Dilation_(metric_space)
+- [Marcel Berger, *Geometry*][berger1987]
+-/
+
+noncomputable theory
+
+open function set
+open_locale topology ennreal nnreal classical
+
+section defs
+
+variables (α : Type*) (β : Type*) [pseudo_emetric_space α] [pseudo_emetric_space β]
+
+/-- A dilation is a map that uniformly scales the edistance between any two points.  -/
+structure dilation :=
+(to_fun : α → β)
+(edist_eq' : ∃ r : ℝ≥0, r ≠ 0 ∧ ∀ x y : α, edist (to_fun x) (to_fun y) = r * edist x y)
+
+/--
+`dilation_class F α β r` states that `F` is a type of `r`-dilations.
+You should extend this typeclass when you extend `dilation`.
+-/
+class dilation_class (F : Type*) (α β : out_param $ Type*)
+  [pseudo_emetric_space α] [pseudo_emetric_space β] extends fun_like F α (λ _, β) :=
+(edist_eq' : ∀ (f : F), ∃ r : ℝ≥0, r ≠ 0 ∧ ∀ (x y : α), edist (f x) (f y) = r * edist x y)
+
+end defs
+
+namespace dilation
+variables {α : Type*} {β : Type*} {γ : Type*} {F : Type*} {G : Type*}
+
+section setup
+variables [pseudo_emetric_space α] [pseudo_emetric_space β]
+
+instance to_dilation_class :
+  dilation_class (dilation α β) α β :=
+{ coe := to_fun,
+  coe_injective' := λ f g h, by { cases f; cases g; congr', },
+  edist_eq' := λ f, edist_eq' f }
+
+instance : has_coe_to_fun (dilation α β) (λ _, α → β) := fun_like.has_coe_to_fun
+
+@[simp] lemma to_fun_eq_coe {f : dilation α β} : f.to_fun = (f : α → β) := rfl
+
+@[simp] lemma coe_mk (f : α → β) (h) : ⇑(⟨f, h⟩ : dilation α β) = f := rfl
+
+lemma congr_fun {f g : dilation α β} (h : f = g) (x : α) : f x = g x := fun_like.congr_fun h x
+lemma congr_arg (f : dilation α β) {x y : α} (h : x = y) : f x = f y := fun_like.congr_arg f h
+
+@[ext] theorem ext {f g : dilation α β} (h : ∀ x, f x = g x) : f = g :=
+fun_like.ext f g h
+
+lemma ext_iff {f g : dilation α β} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff
+
+@[simp] lemma mk_coe (f : dilation α β) (h) : dilation.mk f h = f := ext $ λ _, rfl
+
+/-- Copy of a `dilation` with a new `to_fun` equal to the old one. Useful to fix definitional
+equalities. -/
+@[simps { fully_applied := ff }]
+protected def copy (f : dilation α β) (f' : α → β) (h : f' = ⇑f) : dilation α β :=
+{ to_fun := f',
+  edist_eq' := h.symm ▸ f.edist_eq' }
+
+lemma copy_eq_self (f : dilation α β) {f' : α → β} (h : f' = f) : f.copy f' h = f :=
+fun_like.ext' h
+
+/-- The ratio of a dilation `f`. If the ratio is undefined (i.e., the distance between any two
+points in `α` is either zero or infinity), then we choose one as the ratio. -/
+def ratio [dilation_class F α β] (f : F) : ℝ≥0 :=
+if ∀ x y : α, edist x y = 0 ∨ edist x y = ⊤ then 1 else (dilation_class.edist_eq' f).some
+
+lemma ratio_ne_zero [dilation_class F α β] (f : F) : ratio f ≠ 0 :=
+begin
+  rw ratio, split_ifs,
+  { exact one_ne_zero, },
+  exact (dilation_class.edist_eq' f).some_spec.1,
+end
+
+lemma ratio_pos [dilation_class F α β] (f : F) : 0 < ratio f :=
+(ratio_ne_zero f).bot_lt
+
+@[simp] lemma edist_eq [dilation_class F α β] (f : F) (x y : α) :
+  edist (f x) (f y) = ratio f * edist x y :=
+begin
+  rw ratio, split_ifs with key,
+  { rcases dilation_class.edist_eq' f with ⟨r, hne, hr⟩,
+    replace hr := hr x y,
+    cases key x y,
+    { simp only [hr, h, mul_zero] },
+    { simp [hr, h, hne] } },
+  exact (dilation_class.edist_eq' f).some_spec.2 x y,
+end
+
+@[simp] lemma nndist_eq {α β F : Type*}  [pseudo_metric_space α] [pseudo_metric_space β]
+  [dilation_class F α β] (f : F) (x y : α) : nndist (f x) (f y) = ratio f * nndist x y :=
+by simp only [← ennreal.coe_eq_coe, ← edist_nndist, ennreal.coe_mul, edist_eq]
+
+@[simp] lemma dist_eq {α β F : Type*} [pseudo_metric_space α] [pseudo_metric_space β]
+  [dilation_class F α β] (f : F) (x y : α) : dist (f x) (f y) = ratio f * dist x y :=
+by simp only [dist_nndist, nndist_eq, nnreal.coe_mul]
+
+/-- The `ratio` is equal to the distance ratio for any two points with nonzero finite distance.
+`dist` and `nndist` versions below -/
+lemma ratio_unique [dilation_class F α β] {f : F} {x y : α} {r : ℝ≥0}
+  (h₀ : edist x y ≠ 0) (htop : edist x y ≠ ⊤) (hr : edist (f x) (f y) = r * edist x y) :
+  r = ratio f :=
+by simpa only [hr, ennreal.mul_eq_mul_right h₀ htop, ennreal.coe_eq_coe] using edist_eq f x y
+
+/-- The `ratio` is equal to the distance ratio for any two points
+with nonzero finite distance; `nndist` version -/
+lemma ratio_unique_of_nndist_ne_zero {α β F : Type*} [pseudo_metric_space α] [pseudo_metric_space β]
+  [dilation_class F α β] {f : F} {x y : α} {r : ℝ≥0} (hxy : nndist x y ≠ 0)
+  (hr : nndist (f x) (f y) = r * nndist x y) : r = ratio f :=
+ratio_unique (by rwa [edist_nndist, ennreal.coe_ne_zero]) (edist_ne_top x y)
+  (by rw [edist_nndist, edist_nndist, hr, ennreal.coe_mul])
+
+/-- The `ratio` is equal to the distance ratio for any two points
+with nonzero finite distance; `dist` version -/
+lemma ratio_unique_of_dist_ne_zero {α β} {F : Type*} [pseudo_metric_space α] [pseudo_metric_space β]
+  [dilation_class F α β] {f : F} {x y : α} {r : ℝ≥0}
+  (hxy : dist x y ≠ 0) (hr : dist (f x) (f y) = r * dist x y) :
+  r = ratio f :=
+ratio_unique_of_nndist_ne_zero (nnreal.coe_ne_zero.1 hxy) $ nnreal.eq $
+  by rw [coe_nndist, hr, nnreal.coe_mul, coe_nndist]
+
+/-- Alternative `dilation` constructor when the distance hypothesis is over `nndist` -/
+def mk_of_nndist_eq {α β}
+  [pseudo_metric_space α] [pseudo_metric_space β]
+  (f : α → β) (h : ∃ (r : ℝ≥0), r ≠ 0 ∧ ∀ (x y : α), nndist (f x) (f y) = r * nndist x y) :
+  dilation α β :=
+{ to_fun := f,
+  edist_eq' :=
+  begin
+    rcases h with ⟨r, hne, h⟩,
+    refine ⟨r, hne, λ x y, _⟩,
+    rw [edist_nndist, edist_nndist, ← ennreal.coe_mul, h x y],
+  end }
+
+@[simp] lemma coe_mk_of_nndist_eq {α β}
+  [pseudo_metric_space α] [pseudo_metric_space β]
+  (f : α → β) (h) : ⇑(mk_of_nndist_eq f h : dilation α β) = f := rfl
+
+@[simp] lemma mk_coe_of_nndist_eq {α β}
+  [pseudo_metric_space α] [pseudo_metric_space β]
+  (f : dilation α β) (h) : dilation.mk_of_nndist_eq f h = f :=
+ext $ λ _, rfl
+
+/-- Alternative `dilation` constructor when the distance hypothesis is over `dist` -/
+def mk_of_dist_eq {α β}
+  [pseudo_metric_space α] [pseudo_metric_space β]
+  (f : α → β) (h : ∃ (r : ℝ≥0), r ≠ 0 ∧ ∀ (x y : α), dist (f x) (f y) = r * dist x y) :
+  dilation α β :=
+mk_of_nndist_eq f $ h.imp $ λ r hr,
+  ⟨hr.1, λ x y, nnreal.eq $ by rw [coe_nndist, hr.2, nnreal.coe_mul, coe_nndist]⟩
+
+@[simp] lemma coe_mk_of_dist_eq {α β}
+  [pseudo_metric_space α] [pseudo_metric_space β]
+  (f : α → β) (h) : ⇑(mk_of_dist_eq f h : dilation α β) = f := rfl
+
+@[simp] lemma mk_coe_of_dist_eq {α β}
+  [pseudo_metric_space α] [pseudo_metric_space β]
+  (f : dilation α β) (h) : dilation.mk_of_dist_eq f h = f :=
+ext $ λ _, rfl
+
+end setup
+
+section pseudo_emetric_dilation
+variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
+variables [dilation_class F α β] [dilation_class G β γ]
+variables (f : F) (g : G) {x y z : α}  {s : set α}
+
+lemma lipschitz : lipschitz_with (ratio f) (f : α → β) := λ x y, (edist_eq f x y).le
+
+lemma antilipschitz : antilipschitz_with (ratio f)⁻¹ (f : α → β) :=
+λ x y, have hr : ratio f ≠ 0 := ratio_ne_zero f, by exact_mod_cast
+  (ennreal.mul_le_iff_le_inv (ennreal.coe_ne_zero.2 hr) ennreal.coe_ne_top).1 (edist_eq f x y).ge
+
+/-- A dilation from an emetric space is injective -/
+protected lemma injective {α : Type*} [emetric_space α]  [dilation_class F α β] (f : F) :
+  injective f := (antilipschitz f).injective
+
+/-- The identity is a dilation -/
+protected def id (α) [pseudo_emetric_space α] : dilation α α :=
+{ to_fun := _root_.id,
+  edist_eq' := ⟨1, one_ne_zero, λ x y, by simp only [id.def, ennreal.coe_one, one_mul]⟩ }
+
+instance : inhabited (dilation α α) := ⟨dilation.id α⟩
+
+@[simp, protected] lemma coe_id : ⇑(dilation.id α) = id := rfl
+
+lemma id_ratio : ratio (dilation.id α) = 1 :=
+begin
+  by_cases h : ∀ x y : α, edist x y = 0 ∨ edist x y = ∞,
+  { rw [ratio, if_pos h] },
+  { push_neg at h,
+    rcases h with ⟨x, y, hne⟩,
+    refine (ratio_unique hne.1 hne.2 _).symm,
+    simp }
+end
+
+/-- The composition of dilations is a dilation -/
+def comp (g : dilation β γ) (f : dilation α β) : dilation α γ :=
+{ to_fun := g ∘ f,
+  edist_eq' := ⟨ratio g * ratio f,
+    mul_ne_zero (ratio_ne_zero g) (ratio_ne_zero f),
+    λ x y, by { simp only [edist_eq, ennreal.coe_mul], ring, }⟩ }
+
+lemma comp_assoc {δ : Type*} [pseudo_emetric_space δ]
+  (f : dilation α β) (g : dilation β γ) (h : dilation γ δ) :
+  (h.comp g).comp f = h.comp (g.comp f) := rfl
+
+@[simp] lemma coe_comp (g : dilation β γ) (f : dilation α β) :
+  (g.comp f : α → γ) = g ∘ f := rfl
+
+lemma comp_apply (g : dilation β γ) (f : dilation α β) (x : α) :
+  (g.comp f : α → γ) x = (g (f x)) := rfl
+
+/-- Ratio of the composition `g.comp f` of two dilations is the product of their ratios. We assume
+that the domain `α` of `f` is nontrivial, otherwise `ratio f = ratio (g.comp f) = 1` but `ratio g`
+may have any value. -/
+@[simp] lemma comp_ratio
+  {g : dilation β γ} {f : dilation α β} (hne : ∃ x y : α, edist x y ≠ 0 ∧ edist x y ≠ ⊤) :
+  ratio (g.comp f) = ratio g * ratio f :=
+begin
+  rcases hne with ⟨x, y, hα⟩,
+  have hgf := (edist_eq (g.comp f) x y).symm,
+  simp only [dist_eq, coe_comp, ← mul_assoc, mul_eq_mul_right_iff] at hgf,
+  rw [edist_eq, edist_eq, ← mul_assoc, ennreal.mul_eq_mul_right hα.1 hα.2] at hgf,
+  rwa [← ennreal.coe_eq_coe, ennreal.coe_mul],
+end
+
+@[simp] lemma comp_id (f : dilation α β) : f.comp (dilation.id α) = f := ext $ λ x, rfl
+
+@[simp] lemma id_comp (f : dilation α β) : (dilation.id β).comp f = f := ext $ λ x, rfl
+
+instance : monoid (dilation α α) :=
+{ one := dilation.id α,
+  mul := comp,
+  mul_one := comp_id,
+  one_mul := id_comp,
+  mul_assoc := λ f g h, comp_assoc _ _ _ }
+
+lemma one_def : (1 : dilation α α) = dilation.id α := rfl
+lemma mul_def (f g : dilation α α) : f * g = f.comp g := rfl
+
+@[simp] lemma coe_one : ⇑(1 : dilation α α) = _root_.id := rfl
+@[simp] lemma coe_mul (f g : dilation α α) : ⇑(f * g) = f ∘ g := rfl
+
+lemma cancel_right {g₁ g₂ : dilation β γ} {f : dilation α β} (hf : surjective f) :
+  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
+⟨λ h, dilation.ext $ hf.forall.2 (ext_iff.1 h), λ h, h ▸ rfl⟩
+
+lemma cancel_left {g : dilation β γ} {f₁ f₂ : dilation α β} (hg : injective g) :
+  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
+⟨λ h, dilation.ext $ λ x, hg $ by rw [← comp_apply, h, comp_apply], λ h, h ▸ rfl⟩
+
+/-- A dilation from a metric space is a uniform inducing map -/
+protected theorem uniform_inducing : uniform_inducing (f : α → β) :=
+(antilipschitz f).uniform_inducing (lipschitz f).uniform_continuous
+
+lemma tendsto_nhds_iff {ι : Type*} {g : ι → α} {a : filter ι} {b : α} :
+  filter.tendsto g a (𝓝 b) ↔ filter.tendsto ((f : α → β) ∘ g) a (𝓝 (f b)) :=
+(dilation.uniform_inducing f).inducing.tendsto_nhds_iff
+
+/-- A dilation is continuous. -/
+lemma to_continuous : continuous (f : α → β) :=
+(lipschitz f).continuous
+
+/-- Dilations scale the diameter by `ratio f` in pseudoemetric spaces. -/
+lemma ediam_image (s : set α) :
+  emetric.diam ((f : α → β) '' s) = ratio f * emetric.diam s :=
+begin
+  refine ((lipschitz f).ediam_image_le s).antisymm _,
+  apply ennreal.mul_le_of_le_div',
+  rw [div_eq_mul_inv, mul_comm, ← ennreal.coe_inv],
+  exacts [(antilipschitz f).le_mul_ediam_image s, ratio_ne_zero f],
+end
+
+/-- A dilation scales the diameter of the range by `ratio f`. -/
+lemma ediam_range :
+  emetric.diam (range (f : α → β)) = ratio f * emetric.diam (univ : set α) :=
+by { rw ← image_univ, exact ediam_image f univ }
+
+/-- A dilation maps balls to balls and scales the radius by `ratio f`. -/
+lemma maps_to_emetric_ball (x : α) (r : ℝ≥0∞) :
+  maps_to (f : α → β) (emetric.ball x r) (emetric.ball (f x) (ratio f * r)) :=
+λ y hy, (edist_eq f y x).trans_lt $
+  (ennreal.mul_lt_mul_left (ennreal.coe_ne_zero.2 $ ratio_ne_zero f) ennreal.coe_ne_top).2 hy
+
+/-- A dilation maps closed balls to closed balls and scales the radius by `ratio f`. -/
+lemma maps_to_emetric_closed_ball (x : α) (r' : ℝ≥0∞) :
+  maps_to (f : α → β) (emetric.closed_ball x r') (emetric.closed_ball (f x) (ratio f * r')) :=
+λ y hy, (edist_eq f y x).trans_le $ mul_le_mul_left' hy _
+
+lemma comp_continuous_on_iff {γ} [topological_space γ] {g : γ → α} {s : set γ} :
+  continuous_on ((f : α → β) ∘ g) s ↔ continuous_on g s :=
+(dilation.uniform_inducing f).inducing.continuous_on_iff.symm
+
+lemma comp_continuous_iff {γ} [topological_space γ] {g : γ → α} :
+  continuous ((f : α → β) ∘ g) ↔ continuous g :=
+(dilation.uniform_inducing f).inducing.continuous_iff.symm
+
+end pseudo_emetric_dilation --section
+
+section emetric_dilation
+variables [emetric_space α]
+
+/-- A dilation from a metric space is a uniform embedding -/
+protected theorem uniform_embedding [pseudo_emetric_space β] [dilation_class F α β]
+  (f : F) : uniform_embedding f :=
+(antilipschitz f).uniform_embedding (lipschitz f).uniform_continuous
+
+/-- A dilation from a metric space is an embedding -/
+protected theorem embedding [pseudo_emetric_space β] [dilation_class F α β]
+  (f : F) : embedding (f : α → β) :=
+(dilation.uniform_embedding f).embedding
+
+/-- A dilation from a complete emetric space is a closed embedding -/
+protected theorem closed_embedding [complete_space α] [emetric_space β] [dilation_class F α β]
+  (f : F) : closed_embedding f :=
+(antilipschitz f).closed_embedding (lipschitz f).uniform_continuous
+
+end emetric_dilation --section
+
+section pseudo_metric_dilation
+variables [pseudo_metric_space α] [pseudo_metric_space β] [dilation_class F α β] (f : F)
+
+/-- A dilation scales the diameter by `ratio f` in pseudometric spaces. -/
+lemma diam_image (s : set α) : metric.diam ((f : α → β) '' s) = ratio f * metric.diam s :=
+by { simp [metric.diam, ediam_image, ennreal.to_real_mul], }
+
+lemma diam_range : metric.diam (range (f : α → β)) = ratio f * metric.diam (univ : set α) :=
+by rw [← image_univ, diam_image]
+
+/-- A dilation maps balls to balls and scales the radius by `ratio f`. -/
+lemma maps_to_ball (x : α) (r' : ℝ) :
+  maps_to (f : α → β) (metric.ball x r') (metric.ball (f x) (ratio f * r')) :=
+λ y hy, (dist_eq f y x).trans_lt $ (mul_lt_mul_left $ nnreal.coe_pos.2 $ ratio_pos f).2 hy
+
+/-- A dilation maps spheres to spheres and scales the radius by `ratio f`. -/
+lemma maps_to_sphere (x : α) (r' : ℝ) :
+  maps_to (f : α → β) (metric.sphere x r') (metric.sphere (f x) (ratio f * r')) :=
+λ y hy, metric.mem_sphere.mp hy ▸ dist_eq f y x
+
+/-- A dilation maps closed balls to closed balls and scales the radius by `ratio f`. -/
+lemma maps_to_closed_ball (x : α) (r' : ℝ) :
+  maps_to (f : α → β) (metric.closed_ball x r') (metric.closed_ball (f x) (ratio f * r')) :=
+λ y hy, (dist_eq f y x).trans_le $ mul_le_mul_of_nonneg_left hy (nnreal.coe_nonneg _)
+
+end pseudo_metric_dilation -- section
+
+end dilation
diff --git a/src/topology/metric_space/emetric_paracompact.lean b/src/topology/metric_space/emetric_paracompact.lean
index 801c60c72932c..c1dad1d3d4def 100644
--- a/src/topology/metric_space/emetric_paracompact.lean
+++ b/src/topology/metric_space/emetric_paracompact.lean
@@ -10,6 +10,9 @@ import topology.paracompact
 /-!
 # (Extended) metric spaces are paracompact
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we provide two instances:
 
 * `emetric.paracompact_space`: a `pseudo_emetric_space` is paracompact; formalization is based
@@ -23,7 +26,7 @@ metric space, paracompact space, normal space
 
 variable {α : Type*}
 
-open_locale ennreal topological_space
+open_locale ennreal topology
 open set
 
 namespace emetric
@@ -39,15 +42,15 @@ begin
   have pow_pos : ∀ k : ℕ, (0 : ℝ≥0∞) < 2⁻¹ ^ k,
     from λ k, ennreal.pow_pos (ennreal.inv_pos.2 ennreal.two_ne_top) _,
   have hpow_le : ∀ {m n : ℕ}, m ≤ n → (2⁻¹ : ℝ≥0∞) ^ n ≤ 2⁻¹ ^ m,
-    from λ m n h, ennreal.pow_le_pow_of_le_one (ennreal.inv_le_one.2 ennreal.one_lt_two.le) h,
+    from λ m n h, pow_le_pow_of_le_one' (ennreal.inv_le_one.2 ennreal.one_lt_two.le) h,
   have h2pow : ∀ n : ℕ, 2 * (2⁻¹ : ℝ≥0∞) ^ (n + 1) = 2⁻¹ ^ n,
     by { intro n, simp [pow_succ, ← mul_assoc, ennreal.mul_inv_cancel] },
   -- Consider an open covering `S : set (set α)`
   refine ⟨λ ι s ho hcov, _⟩,
   simp only [Union_eq_univ_iff] at hcov,
   -- choose a well founded order on `S`
-  letI : linear_order ι := linear_order_of_STO' well_ordering_rel,
-  have wf : well_founded ((<) : ι → ι → Prop) := @is_well_order.wf ι well_ordering_rel _,
+  letI : linear_order ι := linear_order_of_STO well_ordering_rel,
+  have wf : well_founded ((<) : ι → ι → Prop) := @is_well_founded.wf ι well_ordering_rel _,
   -- Let `ind x` be the minimal index `s : S` such that `x ∈ s`.
   set ind : α → ι := λ x, wf.min {i : ι | x ∈ s i} (hcov x),
   have mem_ind : ∀ x, x ∈ s (ind x), from λ x, wf.min_mem _ (hcov x),
@@ -99,9 +102,9 @@ begin
     rintro ⟨y, rfl, hsub, -, hyx⟩,
     refine hsub (lt_of_lt_of_le hyx _),
     calc 2⁻¹ ^ n = 1 * 2⁻¹ ^ n : (one_mul _).symm
-    ... ≤ 3 * 2⁻¹ ^ n : ennreal.mul_le_mul _ le_rfl,
+    ... ≤ 3 * 2⁻¹ ^ n : mul_le_mul_right' _ _,
     -- TODO: use `norm_num`
-    have : ((1 : ℕ) : ℝ≥0∞) ≤ (3 : ℕ), from ennreal.coe_nat_le_coe_nat.2 (by norm_num1),
+    have : ((1 : ℕ) : ℝ≥0∞) ≤ (3 : ℕ), from nat.cast_le.2 (by norm_num1),
     exact_mod_cast this },
   -- Let us show the rest of the properties. Since the definition expects a family indexed
   -- by a single parameter, we use `ℕ × ι` as the domain.
@@ -122,7 +125,9 @@ begin
     refine ⟨B, ball_mem_nhds _ (pow_pos _), _⟩,
     -- The sets `D m i`, `m > n + k`, are disjoint with `B`
     have Hgt : ∀ (m ≥ n + k + 1) (i : ι), disjoint (D m i) B,
-    { rintros m hm i y ⟨hym, hyx⟩,
+    { rintros m hm i,
+      rw disjoint_iff_inf_le,
+      rintros y ⟨hym, hyx⟩,
       rcases memD.1 hym with ⟨z, rfl, hzi, H, hz⟩,
       have : z ∉ ball x (2⁻¹ ^ k), from λ hz, H n (by linarith) i (hsub hz), apply this,
       calc edist z x ≤ edist y z + edist y x : edist_triangle_left _ _ _
@@ -133,8 +138,9 @@ begin
     -- For each `m ≤ n + k` there is at most one `j` such that `D m j ∩ B` is nonempty.
     have Hle : ∀ m ≤ n + k, set.subsingleton {j | (D m j ∩ B).nonempty},
     { rintros m hm j₁ ⟨y, hyD, hyB⟩ j₂ ⟨z, hzD, hzB⟩,
-      by_contra h,
-      wlog h : j₁ < j₂ := ne.lt_or_lt h using [j₁ j₂ y z, j₂ j₁ z y],
+      by_contra' h' : j₁ ≠ j₂,
+      wlog h : j₁ < j₂ generalizing j₁ j₂ y z,
+      { exact this z hzD hzB y hyD hyB h'.symm (h'.lt_or_lt.resolve_left h), },
       rcases memD.1 hyD with ⟨y', rfl, hsuby, -, hdisty⟩,
       rcases memD.1 hzD with ⟨z', rfl, -, -, hdistz⟩,
       suffices : edist z' y' < 3 * 2⁻¹ ^ m, from nmem_of_lt_ind h (hsuby this),
@@ -145,14 +151,14 @@ begin
         by apply_rules [ennreal.add_lt_add]
       ... = 2 * (2⁻¹ ^ m + 2⁻¹ ^ (n + k + 1)) : by simp only [two_mul, add_comm]
       ... ≤ 2 * (2⁻¹ ^ m + 2⁻¹ ^ (m + 1)) :
-        ennreal.mul_le_mul le_rfl $ add_le_add le_rfl $ hpow_le (add_le_add hm le_rfl)
+        mul_le_mul' le_rfl $ add_le_add le_rfl $ hpow_le (add_le_add hm le_rfl)
       ... = 3 * 2⁻¹ ^ m : by rw [mul_add, h2pow, bit1, add_mul, one_mul] },
     -- Finally, we glue `Hgt` and `Hle`
-    have : (⋃ (m ≤ n + k) (i ∈ {i : ι | (D m i ∩ B).nonempty}), {(m, i)}).finite,
-      from (finite_le_nat _).bUnion (λ i hi, (Hle i hi).finite.bUnion (λ _ _, finite_singleton _)),
+    have : (⋃ (m ≤ n + k) (i ∈ {i : ι | (D m i ∩ B).nonempty}), {(m, i)}).finite :=
+      (finite_le_nat _).bUnion' (λ i hi, (Hle i hi).finite.bUnion' (λ _ _, finite_singleton _)),
     refine this.subset (λ I hI, _), simp only [mem_Union],
     refine ⟨I.1, _, I.2, hI, prod.mk.eta.symm⟩,
-    exact not_lt.1 (λ hlt, Hgt I.1 hlt I.2 hI.some_spec) }
+    exact not_lt.1 (λ hlt, (Hgt I.1 hlt I.2).le_bot hI.some_spec) }
 end
 
 @[priority 100] -- see Note [lower instance priority]
diff --git a/src/topology/metric_space/emetric_space.lean b/src/topology/metric_space/emetric_space.lean
index 7d68879b558f7..c30cfc396c9a9 100644
--- a/src/topology/metric_space/emetric_space.lean
+++ b/src/topology/metric_space/emetric_space.lean
@@ -12,6 +12,9 @@ import topology.uniform_space.uniform_embedding
 /-!
 # Extended metric spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file is devoted to the definition and study of `emetric_spaces`, i.e., metric
 spaces in which the distance is allowed to take the value ∞. This extended distance is
 called `edist`, and takes values in `ℝ≥0∞`.
@@ -28,52 +31,30 @@ to `emetric_space` at the end.
 -/
 
 open set filter classical
-noncomputable theory
 
-open_locale uniformity topological_space big_operators filter nnreal ennreal
+open_locale uniformity topology big_operators filter nnreal ennreal pointwise
 
 universes u v w
-variables {α : Type u} {β : Type v}
+variables {α : Type u} {β : Type v} {X : Type*}
 
 /-- Characterizing uniformities associated to a (generalized) distance function `D`
 in terms of the elements of the uniformity. -/
 theorem uniformity_dist_of_mem_uniformity [linear_order β] {U : filter (α × α)} (z : β)
   (D : α → α → β) (H : ∀ s, s ∈ U ↔ ∃ε>z, ∀{a b:α}, D a b < ε → (a, b) ∈ s) :
-  U = ⨅ ε>z, 𝓟 {p:α×α | D p.1 p.2 < ε} :=
-le_antisymm
-  (le_infi $ λ ε, le_infi $ λ ε0, le_principal_iff.2 $ (H _).2 ⟨ε, ε0, λ a b, id⟩)
-  (λ r ur, let ⟨ε, ε0, h⟩ := (H _).1 ur in
-    mem_infi_of_mem ε $ mem_infi_of_mem ε0 $ mem_principal.2 $ λ ⟨a, b⟩, h)
+  U = ⨅ ε > z, 𝓟 {p:α×α | D p.1 p.2 < ε} :=
+has_basis.eq_binfi ⟨λ s, by simp only [H, subset_def, prod.forall, mem_set_of]⟩
 
 /-- `has_edist α` means that `α` is equipped with an extended distance. -/
 class has_edist (α : Type*) := (edist : α → α → ℝ≥0∞)
 export has_edist (edist)
 
 /-- Creating a uniform space from an extended distance. -/
-def uniform_space_of_edist
-  (edist : α → α → ℝ≥0∞)
-  (edist_self : ∀ x : α, edist x x = 0)
-  (edist_comm : ∀ x y : α, edist x y = edist y x)
+noncomputable def uniform_space_of_edist (edist : α → α → ℝ≥0∞)
+  (edist_self : ∀ x : α, edist x x = 0) (edist_comm : ∀ x y : α, edist x y = edist y x)
   (edist_triangle : ∀ x y z : α, edist x z ≤ edist x y + edist y z) : uniform_space α :=
-uniform_space.of_core
-{ uniformity := (⨅ ε>0, 𝓟 {p:α×α | edist p.1 p.2 < ε}),
-  refl       := le_infi $ assume ε, le_infi $
-    by simp [set.subset_def, id_rel, edist_self, (>)] {contextual := tt},
-  comp       :=
-    le_infi $ assume ε, le_infi $ assume h,
-    have (2 : ℝ≥0∞) = (2 : ℕ) := by simp,
-    have A : 0 < ε / 2 := ennreal.div_pos_iff.2
-      ⟨ne_of_gt h, by { convert ennreal.nat_ne_top 2 }⟩,
-    lift'_le
-    (mem_infi_of_mem (ε / 2) $ mem_infi_of_mem A (subset.refl _)) $
-    have ∀ (a b c : α), edist a c < ε / 2 → edist c b < ε / 2 → edist a b < ε,
-      from assume a b c hac hcb,
-      calc edist a b ≤ edist a c + edist c b : edist_triangle _ _ _
-        ... < ε / 2 + ε / 2 : ennreal.add_lt_add hac hcb
-        ... = ε : by rw [ennreal.add_halves],
-    by simpa [comp_rel],
-  symm       := tendsto_infi.2 $ assume ε, tendsto_infi.2 $ assume h,
-    tendsto_infi' ε $ tendsto_infi' h $ tendsto_principal_principal.2 $ by simp [edist_comm] }
+uniform_space.of_fun edist edist_self edist_comm edist_triangle $
+  λ ε ε0, ⟨ε / 2, ennreal.half_pos ε0.lt.ne', λ _ h₁ _ h₂,
+      (ennreal.add_lt_add h₁ h₂).trans_eq (ennreal.add_halves _)⟩
 
 -- the uniform structure is embedded in the emetric space structure
 -- to avoid instance diamond issues. See Note [forgetful inheritance].
@@ -99,14 +80,12 @@ class pseudo_emetric_space (α : Type u) extends has_edist α : Type u :=
   uniform_space_of_edist edist edist_self edist_comm edist_triangle)
 (uniformity_edist : 𝓤 α = ⨅ ε>0, 𝓟 {p:α×α | edist p.1 p.2 < ε} . control_laws_tac)
 
+attribute [priority 100, instance] pseudo_emetric_space.to_uniform_space
+
 /- Pseudoemetric spaces are less common than metric spaces. Therefore, we work in a dedicated
 namespace, while notions associated to metric spaces are mostly in the root namespace. -/
 variables [pseudo_emetric_space α]
 
-@[priority 100] -- see Note [lower instance priority]
-instance pseudo_emetric_space.to_uniform_space' : uniform_space α :=
-pseudo_emetric_space.to_uniform_space
-
 export pseudo_emetric_space (edist_self edist_comm edist_triangle)
 
 attribute [simp] edist_self
@@ -118,6 +97,19 @@ by rw edist_comm z; apply edist_triangle
 theorem edist_triangle_right (x y z : α) : edist x y ≤ edist x z + edist y z :=
 by rw edist_comm y; apply edist_triangle
 
+lemma edist_congr_right {x y z : α} (h : edist x y = 0) : edist x z = edist y z :=
+begin
+  apply le_antisymm,
+  { rw [←zero_add (edist y z), ←h],
+    apply edist_triangle, },
+  { rw edist_comm at h,
+    rw [←zero_add (edist x z), ←h],
+    apply edist_triangle, },
+end
+
+lemma edist_congr_left {x y z : α} (h : edist x y = 0) : edist z x = edist z y :=
+by { rw [edist_comm z x, edist_comm z y], apply edist_congr_right h,  }
+
 lemma edist_triangle4 (x y z t : α) :
   edist x t ≤ edist x y + edist y z + edist z t :=
 calc
@@ -165,13 +157,13 @@ theorem uniformity_pseudoedist :
   𝓤 α = ⨅ ε>0, 𝓟 {p:α×α | edist p.1 p.2 < ε} :=
 pseudo_emetric_space.uniformity_edist
 
+theorem uniform_space_edist : ‹pseudo_emetric_space α›.to_uniform_space =
+  uniform_space_of_edist edist edist_self edist_comm edist_triangle :=
+uniform_space_eq uniformity_pseudoedist
+
 theorem uniformity_basis_edist :
   (𝓤 α).has_basis (λ ε : ℝ≥0∞, 0 < ε) (λ ε, {p:α×α | edist p.1 p.2 < ε}) :=
-(@uniformity_pseudoedist α _).symm ▸ has_basis_binfi_principal
-  (λ r hr p hp, ⟨min r p, lt_min hr hp,
-    λ x hx, lt_of_lt_of_le hx (min_le_left _ _),
-    λ x hx, lt_of_lt_of_le hx (min_le_right _ _)⟩)
-  ⟨1, ennreal.zero_lt_one⟩
+(@uniform_space_edist α _).symm ▸ uniform_space.has_basis_of_fun ⟨1, one_pos⟩ _ _ _ _ _
 
 /-- Characterization of the elements of the uniformity in terms of the extended distance -/
 theorem mem_uniformity_edist {s : set (α×α)} :
@@ -234,6 +226,12 @@ emetric.mk_uniformity_basis (λ _, ennreal.coe_pos.2)
   (λ ε ε₀, let ⟨δ, hδ⟩ := ennreal.lt_iff_exists_nnreal_btwn.1 ε₀ in
   ⟨δ, ennreal.coe_pos.1 hδ.1, le_of_lt hδ.2⟩)
 
+theorem uniformity_basis_edist_nnreal_le :
+  (𝓤 α).has_basis (λ ε : ℝ≥0, 0 < ε) (λ ε, {p:α×α | edist p.1 p.2 ≤ ε}) :=
+emetric.mk_uniformity_basis_le (λ _, ennreal.coe_pos.2)
+  (λ ε ε₀, let ⟨δ, hδ⟩ := ennreal.lt_iff_exists_nnreal_btwn.1 ε₀ in
+  ⟨δ, ennreal.coe_pos.1 hδ.1, le_of_lt hδ.2⟩)
+
 theorem uniformity_basis_edist_inv_nat :
   (𝓤 α).has_basis (λ _, true) (λ n:ℕ, {p:α×α | edist p.1 p.2 < (↑n)⁻¹}) :=
 emetric.mk_uniformity_basis
@@ -273,12 +271,10 @@ uniformity_basis_edist.uniform_continuous_iff uniformity_basis_edist
 theorem uniform_embedding_iff [pseudo_emetric_space β] {f : α → β} :
   uniform_embedding f ↔ function.injective f ∧ uniform_continuous f ∧
     ∀ δ > 0, ∃ ε > 0, ∀ {a b : α}, edist (f a) (f b) < ε → edist a b < δ :=
-uniform_embedding_def'.trans $ and_congr iff.rfl $ and_congr iff.rfl
-⟨λ H δ δ0, let ⟨t, tu, ht⟩ := H _ (edist_mem_uniformity δ0),
-               ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 tu in
-  ⟨ε, ε0, λ a b h, ht _ _ (hε h)⟩,
- λ H s su, let ⟨δ, δ0, hδ⟩ := mem_uniformity_edist.1 su, ⟨ε, ε0, hε⟩ := H _ δ0 in
-  ⟨_, edist_mem_uniformity ε0, λ a b h, hδ (hε h)⟩⟩
+begin
+  simp only [uniformity_basis_edist.uniform_embedding_iff uniformity_basis_edist, exists_prop],
+  refl
+end
 
 /-- If a map between pseudoemetric spaces is a uniform embedding then the edistance between `f x`
 and `f y` is controlled in terms of the distance between `x` and `y`. -/
@@ -286,11 +282,7 @@ theorem controlled_of_uniform_embedding [pseudo_emetric_space β] {f : α → β
   uniform_embedding f →
   (∀ ε > 0, ∃ δ > 0, ∀ {a b : α}, edist a b < δ → edist (f a) (f b) < ε) ∧
   (∀ δ > 0, ∃ ε > 0, ∀ {a b : α}, edist (f a) (f b) < ε → edist a b < δ) :=
-begin
-  assume h,
-    exact ⟨uniform_continuous_iff.1 (uniform_embedding_iff.1 h).2.1,
-          (uniform_embedding_iff.1 h).2.2⟩,
-end
+λ h, ⟨uniform_continuous_iff.1 (uniform_embedding_iff.1 h).2.1, (uniform_embedding_iff.1 h).2.2⟩
 
 /-- ε-δ characterization of Cauchy sequences on pseudoemetric spaces -/
 protected lemma cauchy_iff {f : filter α} :
@@ -361,7 +353,7 @@ specified uniformity. See Note [forgetful inheritance] explaining why having def
 the right uniformity is often important.
 -/
 def pseudo_emetric_space.replace_uniformity {α} [U : uniform_space α] (m : pseudo_emetric_space α)
-  (H : @uniformity _ U = @uniformity _ pseudo_emetric_space.to_uniform_space) :
+  (H : 𝓤[U] = 𝓤[pseudo_emetric_space.to_uniform_space]) :
   pseudo_emetric_space α :=
 { edist               := @edist _ m.to_has_edist,
   edist_self          := edist_self,
@@ -378,16 +370,7 @@ def pseudo_emetric_space.induced {α β} (f : α → β)
   edist_comm          := λ x y, edist_comm _ _,
   edist_triangle      := λ x y z, edist_triangle _ _ _,
   to_uniform_space    := uniform_space.comap f m.to_uniform_space,
-  uniformity_edist    := begin
-    apply @uniformity_dist_of_mem_uniformity _ _ _ _ _ (λ x y, edist (f x) (f y)),
-    refine λ s, mem_comap.trans _,
-    split; intro H,
-    { rcases H with ⟨r, ru, rs⟩,
-      rcases mem_uniformity_edist.1 ru with ⟨ε, ε0, hε⟩,
-      refine ⟨ε, ε0, λ a b h, rs (hε _)⟩, exact h },
-    { rcases H with ⟨ε, ε0, hε⟩,
-      exact ⟨_, edist_mem_uniformity ε0, λ ⟨a, b⟩, hε⟩ }
-  end }
+  uniformity_edist    := (uniformity_basis_edist.comap _).eq_binfi }
 
 /-- Pseudoemetric space instance on subsets of pseudoemetric spaces -/
 instance {α : Type*} {p : α → Prop} [pseudo_emetric_space α] : pseudo_emetric_space (subtype p) :=
@@ -409,11 +392,21 @@ pseudo_emetric_space.induced unop ‹_›
 
 end mul_opposite
 
+section ulift
+
+instance : pseudo_emetric_space (ulift α) :=
+pseudo_emetric_space.induced ulift.down ‹_›
+
+lemma ulift.edist_eq (x y : ulift α) : edist x y = edist x.down y.down := rfl
+@[simp] lemma ulift.edist_up_up (x y : α) : edist (ulift.up x) (ulift.up y) = edist x y := rfl
+
+end ulift
+
 /-- The product of two pseudoemetric spaces, with the max distance, is an extended
 pseudometric spaces. We make sure that the uniform structure thus constructed is the one
 corresponding to the product of uniform spaces, to avoid diamond problems. -/
 instance prod.pseudo_emetric_space_max [pseudo_emetric_space β] : pseudo_emetric_space (α × β) :=
-{ edist := λ x y, max (edist x.1 y.1) (edist x.2 y.2),
+{ edist := λ x y, edist x.1 y.1 ⊔ edist x.2 y.2,
   edist_self := λ x, by simp,
   edist_comm := λ x y, by simp [edist_comm],
   edist_triangle := λ x y z, max_le
@@ -465,10 +458,6 @@ instance pseudo_emetric_space_pi [∀b, pseudo_emetric_space (π b)] :
 lemma edist_pi_def [Π b, pseudo_emetric_space (π b)] (f g : Π b, π b) :
   edist f g = finset.sup univ (λb, edist (f b) (g b)) := rfl
 
-@[simp]
-lemma edist_pi_const [nonempty β] (a b : α) :
-  edist (λ x : β, a) (λ _, b) = edist a b := finset.sup_const univ_nonempty (edist a b)
-
 lemma edist_le_pi_edist [Π b, pseudo_emetric_space (π b)] (f g : Π b, π b) (b : β) :
   edist (f b) (g b) ≤ edist f g :=
 finset.le_sup (finset.mem_univ b)
@@ -477,23 +466,33 @@ lemma edist_pi_le_iff [Π b, pseudo_emetric_space (π b)] {f g : Π b, π b} {d
   edist f g ≤ d ↔ ∀ b, edist (f b) (g b) ≤ d :=
 finset.sup_le_iff.trans $ by simp only [finset.mem_univ, forall_const]
 
+lemma edist_pi_const_le (a b : α) : edist (λ _ : β, a) (λ _, b) ≤ edist a b :=
+edist_pi_le_iff.2 $ λ _, le_rfl
+
+@[simp] lemma edist_pi_const [nonempty β] (a b : α) : edist (λ x : β, a) (λ _, b) = edist a b :=
+finset.sup_const univ_nonempty (edist a b)
+
 end pi
 
 namespace emetric
-variables {x y z : α} {ε ε₁ ε₂ : ℝ≥0∞} {s : set α}
+variables {x y z : α} {ε ε₁ ε₂ : ℝ≥0∞} {s t : set α}
 
 /-- `emetric.ball x ε` is the set of all points `y` with `edist y x < ε` -/
 def ball (x : α) (ε : ℝ≥0∞) : set α := {y | edist y x < ε}
 
 @[simp] theorem mem_ball : y ∈ ball x ε ↔ edist y x < ε := iff.rfl
 
-theorem mem_ball' : y ∈ ball x ε ↔ edist x y < ε := by rw edist_comm; refl
+theorem mem_ball' : y ∈ ball x ε ↔ edist x y < ε :=
+by rw [edist_comm, mem_ball]
 
 /-- `emetric.closed_ball x ε` is the set of all points `y` with `edist y x ≤ ε` -/
 def closed_ball (x : α) (ε : ℝ≥0∞) := {y | edist y x ≤ ε}
 
 @[simp] theorem mem_closed_ball : y ∈ closed_ball x ε ↔ edist y x ≤ ε := iff.rfl
 
+theorem mem_closed_ball' : y ∈ closed_ball x ε ↔ edist x y ≤ ε :=
+by rw [edist_comm, mem_closed_ball]
+
 @[simp] theorem closed_ball_top (x : α) : closed_ball x ∞ = univ :=
 eq_univ_of_forall $ λ y, le_top
 
@@ -510,7 +509,10 @@ theorem mem_closed_ball_self : x ∈ closed_ball x ε :=
 show edist x x ≤ ε, by rw edist_self; exact bot_le
 
 theorem mem_ball_comm : x ∈ ball y ε ↔ y ∈ ball x ε :=
-by simp [edist_comm]
+by rw [mem_ball', mem_ball]
+
+theorem mem_closed_ball_comm : x ∈ closed_ball y ε ↔ y ∈ closed_ball x ε :=
+by rw [mem_closed_ball', mem_closed_ball]
 
 theorem ball_subset_ball (h : ε₁ ≤ ε₂) : ball x ε₁ ⊆ ball x ε₂ :=
 λ y (yx : _ < ε₁), lt_of_lt_of_le yx h
@@ -519,10 +521,9 @@ theorem closed_ball_subset_closed_ball (h : ε₁ ≤ ε₂) :
   closed_ball x ε₁ ⊆ closed_ball x ε₂ :=
 λ y (yx : _ ≤ ε₁), le_trans yx h
 
-theorem ball_disjoint (h : ε₁ + ε₂ ≤ edist x y) : ball x ε₁ ∩ ball y ε₂ = ∅ :=
-eq_empty_iff_forall_not_mem.2 $ λ z ⟨h₁, h₂⟩,
-not_lt_of_le (edist_triangle_left x y z)
-  (lt_of_lt_of_le (ennreal.add_lt_add h₁ h₂) h)
+theorem ball_disjoint (h : ε₁ + ε₂ ≤ edist x y) : disjoint (ball x ε₁) (ball y ε₂) :=
+set.disjoint_left.mpr $ λ z h₁ h₂,
+  (edist_triangle_left x y z).not_lt $ (ennreal.add_lt_add h₁ h₂).trans_le h
 
 theorem ball_subset (h : edist x y + ε₁ ≤ ε₂) (h' : edist x y ≠ ∞) : ball x ε₁ ⊆ ball y ε₂ :=
 λ z zx, calc
@@ -543,6 +544,14 @@ eq_empty_iff_forall_not_mem.trans
 ⟨λh, le_bot_iff.1 (le_of_not_gt (λ ε0, h _ (mem_ball_self ε0))),
 λε0 y h, not_lt_of_le (le_of_eq ε0) (pos_of_mem_ball h)⟩
 
+lemma ord_connected_set_of_closed_ball_subset (x : α) (s : set α) :
+  ord_connected {r | closed_ball x r ⊆ s} :=
+⟨λ r₁ hr₁ r₂ hr₂ r hr, (closed_ball_subset_closed_ball hr.2).trans hr₂⟩
+
+lemma ord_connected_set_of_ball_subset (x : α) (s : set α) :
+  ord_connected {r | ball x r ⊆ s} :=
+⟨λ r₁ hr₁ r₂ hr₂ r hr, (ball_subset_ball hr.2).trans hr₂⟩
+
 /-- Relation “two points are at a finite edistance” is an equivalence relation. -/
 def edist_lt_top_setoid : setoid α :=
 { r := λ x y, edist x y < ⊤,
@@ -556,14 +565,45 @@ by rw [emetric.ball_eq_empty_iff]
 theorem nhds_basis_eball : (𝓝 x).has_basis (λ ε:ℝ≥0∞, 0 < ε) (ball x) :=
 nhds_basis_uniformity uniformity_basis_edist
 
+lemma nhds_within_basis_eball : (𝓝[s] x).has_basis (λ ε : ℝ≥0∞, 0 < ε) (λ ε, ball x ε ∩ s) :=
+nhds_within_has_basis nhds_basis_eball s
+
 theorem nhds_basis_closed_eball : (𝓝 x).has_basis (λ ε:ℝ≥0∞, 0 < ε) (closed_ball x) :=
 nhds_basis_uniformity uniformity_basis_edist_le
 
+lemma nhds_within_basis_closed_eball :
+  (𝓝[s] x).has_basis (λ ε : ℝ≥0∞, 0 < ε) (λ ε, closed_ball x ε ∩ s) :=
+nhds_within_has_basis nhds_basis_closed_eball s
+
 theorem nhds_eq : 𝓝 x = (⨅ε>0, 𝓟 (ball x ε)) :=
 nhds_basis_eball.eq_binfi
 
 theorem mem_nhds_iff : s ∈ 𝓝 x ↔ ∃ε>0, ball x ε ⊆ s := nhds_basis_eball.mem_iff
 
+lemma mem_nhds_within_iff : s ∈ 𝓝[t] x ↔ ∃ ε > 0, ball x ε ∩ t ⊆ s :=
+nhds_within_basis_eball.mem_iff
+
+section
+variables [pseudo_emetric_space β] {f : α → β}
+
+lemma tendsto_nhds_within_nhds_within {t : set β} {a b} :
+  tendsto f (𝓝[s] a) (𝓝[t] b) ↔
+    ∀ ε > 0, ∃ δ > 0, ∀ ⦃x⦄, x ∈ s → edist x a < δ → f x ∈ t ∧ edist (f x) b < ε :=
+(nhds_within_basis_eball.tendsto_iff nhds_within_basis_eball).trans $
+  forall₂_congr $ λ ε hε, exists₂_congr $ λ δ hδ,
+  forall_congr $ λ x, by simp; itauto
+
+lemma tendsto_nhds_within_nhds {a b} :
+  tendsto f (𝓝[s] a) (𝓝 b) ↔
+    ∀ ε > 0, ∃ δ > 0, ∀{x:α}, x ∈ s → edist x a < δ → edist (f x) b < ε :=
+by { rw [← nhds_within_univ b, tendsto_nhds_within_nhds_within], simp only [mem_univ, true_and] }
+
+lemma tendsto_nhds_nhds {a b} :
+  tendsto f (𝓝 a) (𝓝 b) ↔ ∀ ε > 0, ∃ δ > 0, ∀ ⦃x⦄, edist x a < δ → edist (f x) b < ε :=
+nhds_basis_eball.tendsto_iff nhds_basis_eball
+
+end
+
 theorem is_open_iff : is_open s ↔ ∀x∈s, ∃ε>0, ball x ε ⊆ s :=
 by simp [is_open_iff_nhds, mem_nhds_iff]
 
@@ -571,8 +611,8 @@ theorem is_open_ball : is_open (ball x ε) :=
 is_open_iff.2 $ λ y, exists_ball_subset_ball
 
 theorem is_closed_ball_top : is_closed (ball x ⊤) :=
-is_open_compl_iff.1 $ is_open_iff.2 $ λ y hy, ⟨⊤, ennreal.coe_lt_top, subset_compl_iff_disjoint.2 $
-  ball_disjoint $ by { rw ennreal.top_add, exact le_of_not_lt hy }⟩
+is_open_compl_iff.1 $ is_open_iff.2 $ λ y hy, ⟨⊤, ennreal.coe_lt_top,
+  (ball_disjoint $ by { rw top_add, exact le_of_not_lt hy }).subset_compl_right⟩
 
 theorem ball_mem_nhds (x : α) {ε : ℝ≥0∞} (ε0 : 0 < ε) : ball x ε ∈ 𝓝 x :=
 is_open_ball.mem_nhds (mem_ball_self ε0)
@@ -603,6 +643,9 @@ theorem tendsto_at_top [nonempty β] [semilattice_sup β] {u : β → α} {a : 
 (at_top_basis.tendsto_iff nhds_basis_eball).trans $
   by simp only [exists_prop, true_and, mem_Ici, mem_ball]
 
+theorem inseparable_iff : inseparable x y ↔ edist x y = 0 :=
+by simp [inseparable_iff_mem_closure, mem_closure_iff, edist_comm, forall_lt_iff_le']
+
 /-- In a pseudoemetric space, Cauchy sequences are characterized by the fact that, eventually,
 the pseudoedistance between its elements is arbitrarily small -/
 @[nolint ge_or_gt] -- see Note [nolint_ge]
@@ -622,14 +665,14 @@ theorem cauchy_seq_iff_nnreal [nonempty β] [semilattice_sup β] {u : β → α}
 uniformity_basis_edist_nnreal.cauchy_seq_iff'
 
 theorem totally_bounded_iff {s : set α} :
-  totally_bounded s ↔ ∀ ε > 0, ∃t : set α, finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
+  totally_bounded s ↔ ∀ ε > 0, ∃t : set α, t.finite ∧ s ⊆ ⋃y∈t, ball y ε :=
 ⟨λ H ε ε0, H _ (edist_mem_uniformity ε0),
  λ H r ru, let ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 ru,
                ⟨t, ft, h⟩ := H ε ε0 in
   ⟨t, ft, h.trans $ Union₂_mono $ λ y yt z, hε⟩⟩
 
 theorem totally_bounded_iff' {s : set α} :
-  totally_bounded s ↔ ∀ ε > 0, ∃t⊆s, finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
+  totally_bounded s ↔ ∀ ε > 0, ∃t⊆s, set.finite t ∧ s ⊆ ⋃y∈t, ball y ε :=
 ⟨λ H ε ε0, (totally_bounded_iff_subset.1 H) _ (edist_mem_uniformity ε0),
  λ H r ru, let ⟨ε, ε0, hε⟩ := mem_uniformity_edist.1 ru,
                ⟨t, _, ft, h⟩ := H ε ε0 in
@@ -640,8 +683,8 @@ section compact
 /-- For a set `s` in a pseudo emetric space, if for every `ε > 0` there exists a countable
 set that is `ε`-dense in `s`, then there exists a countable subset `t ⊆ s` that is dense in `s`. -/
 lemma subset_countable_closure_of_almost_dense_set (s : set α)
-  (hs : ∀ ε > 0, ∃ t : set α, countable t ∧ s ⊆ ⋃ x ∈ t, closed_ball x ε) :
-  ∃ t ⊆ s, (countable t ∧ s ⊆ closure t) :=
+  (hs : ∀ ε > 0, ∃ t : set α, t.countable ∧ s ⊆ ⋃ x ∈ t, closed_ball x ε) :
+  ∃ t ⊆ s, (t.countable ∧ s ⊆ closure t) :=
 begin
   rcases s.eq_empty_or_nonempty with rfl|⟨x₀, hx₀⟩,
   { exact ⟨∅, empty_subset _, countable_empty, empty_subset _⟩ },
@@ -668,7 +711,7 @@ end
 /-- A compact set in a pseudo emetric space is separable, i.e., it is a subset of the closure of a
 countable set.  -/
 lemma subset_countable_closure_of_compact {s : set α} (hs : is_compact s) :
-  ∃ t ⊆ s, (countable t ∧ s ⊆ closure t) :=
+  ∃ t ⊆ s, (t.countable ∧ s ⊆ closure t) :=
 begin
   refine subset_countable_closure_of_almost_dense_set s (λ ε hε, _),
   rcases totally_bounded_iff'.1 hs.totally_bounded ε hε with ⟨t, hts, htf, hst⟩,
@@ -688,6 +731,7 @@ to avoid a loop with `sigma_compact_space_of_locally_compact_second_countable`.
 lemma second_countable_of_sigma_compact [sigma_compact_space α] :
   second_countable_topology α :=
 begin
+
   suffices : separable_space α, by exactI uniform_space.second_countable_of_separable α,
   choose T hTsub hTc hsubT
     using λ n, subset_countable_closure_of_compact (is_compact_compact_covering α n),
@@ -699,7 +743,7 @@ end
 variable {α}
 
 lemma second_countable_of_almost_dense_set
-  (hs : ∀ ε > 0, ∃ t : set α, countable t ∧ (⋃ x ∈ t, closed_ball x ε) = univ) :
+  (hs : ∀ ε > 0, ∃ t : set α, t.countable ∧ (⋃ x ∈ t, closed_ball x ε) = univ) :
   second_countable_topology α :=
 begin
   suffices : separable_space α, by exactI uniform_space.second_countable_of_separable α,
@@ -715,7 +759,7 @@ end second_countable
 section diam
 
 /-- The diameter of a set in a pseudoemetric space, named `emetric.diam` -/
-def diam (s : set α) := ⨆ (x ∈ s) (y ∈ s), edist x y
+noncomputable def diam (s : set α) := ⨆ (x ∈ s) (y ∈ s), edist x y
 
 lemma diam_le_iff {d : ℝ≥0∞} :
   diam s ≤ d ↔ ∀ (x ∈ s) (y ∈ s), edist x y ≤ d :=
@@ -749,6 +793,8 @@ diam_subsingleton subsingleton_empty
 @[simp] lemma diam_singleton : diam ({x} : set α) = 0 :=
 diam_subsingleton subsingleton_singleton
 
+@[simp, to_additive] lemma diam_one [has_one α] : diam (1 : set α) = 0 := diam_singleton
+
 lemma diam_Union_mem_option {ι : Type*} (o : option ι) (s : ι → set α) :
   diam (⋃ i ∈ o, s i) = ⨆ i ∈ o, diam (s i) :=
 by cases o; simp
@@ -822,10 +868,6 @@ class emetric_space (α : Type u) extends pseudo_emetric_space α : Type u :=
 
 variables {γ : Type w} [emetric_space γ]
 
-@[priority 100] -- see Note [lower instance priority]
-instance emetric_space.to_uniform_space' : uniform_space γ :=
-pseudo_emetric_space.to_uniform_space
-
 export emetric_space (eq_of_edist_eq_zero)
 
 /-- Characterize the equality of points by the vanishing of their extended distance -/
@@ -845,43 +887,28 @@ nonpos_iff_eq_zero.trans edist_eq_zero
 theorem eq_of_forall_edist_le {x y : γ} (h : ∀ε > 0, edist x y ≤ ε) : x = y :=
 eq_of_edist_eq_zero (eq_of_le_of_forall_le_of_dense bot_le h)
 
-/-- A map between emetric spaces is a uniform embedding if and only if the edistance between `f x`
-and `f y` is controlled in terms of the distance between `x` and `y` and conversely. -/
-theorem uniform_embedding_iff' [emetric_space β] {f : γ → β} :
-  uniform_embedding f ↔
-  (∀ ε > 0, ∃ δ > 0, ∀ {a b : γ}, edist a b < δ → edist (f a) (f b) < ε) ∧
-  (∀ δ > 0, ∃ ε > 0, ∀ {a b : γ}, edist (f a) (f b) < ε → edist a b < δ) :=
-begin
-  split,
-  { assume h,
-    exact ⟨emetric.uniform_continuous_iff.1 (uniform_embedding_iff.1 h).2.1,
-          (uniform_embedding_iff.1 h).2.2⟩ },
-  { rintros ⟨h₁, h₂⟩,
-    refine uniform_embedding_iff.2 ⟨_, emetric.uniform_continuous_iff.2 h₁, h₂⟩,
-    assume x y hxy,
-    have : edist x y ≤ 0,
-    { refine le_of_forall_lt' (λδ δpos, _),
-      rcases h₂ δ δpos with ⟨ε, εpos, hε⟩,
-      have : edist (f x) (f y) < ε, by simpa [hxy],
-      exact hε this },
-    simpa using this }
-end
-
 /-- An emetric space is separated -/
 @[priority 100] -- see Note [lower instance priority]
 instance to_separated : separated_space γ :=
 separated_def.2 $ λ x y h, eq_of_forall_edist_le $
 λ ε ε0, le_of_lt (h _ (edist_mem_uniformity ε0))
 
-/-- If a  `pseudo_emetric_space` is separated, then it is an `emetric_space`. -/
-def emetric_of_t2_pseudo_emetric_space {α : Type*} [pseudo_emetric_space α]
-  (h : separated_space α) : emetric_space α :=
-{ eq_of_edist_eq_zero := λ x y hdist,
-  begin
-    refine separated_def.1 h x y (λ s hs, _),
-    obtain ⟨ε, hε, H⟩ := mem_uniformity_edist.1 hs,
-    exact H (show edist x y < ε, by rwa [hdist])
-  end
+/-- A map between emetric spaces is a uniform embedding if and only if the edistance between `f x`
+and `f y` is controlled in terms of the distance between `x` and `y` and conversely. -/
+theorem emetric.uniform_embedding_iff' [emetric_space β] {f : γ → β} :
+  uniform_embedding f ↔
+    (∀ ε > 0, ∃ δ > 0, ∀ {a b : γ}, edist a b < δ → edist (f a) (f b) < ε) ∧
+    (∀ δ > 0, ∃ ε > 0, ∀ {a b : γ}, edist (f a) (f b) < ε → edist a b < δ) :=
+begin
+  simp only [uniform_embedding_iff_uniform_inducing,
+    uniformity_basis_edist.uniform_inducing_iff uniformity_basis_edist, exists_prop],
+  refl
+end
+
+/-- If a `pseudo_emetric_space` is a T₀ space, then it is an `emetric_space`. -/
+def emetric_space.of_t0_pseudo_emetric_space (α : Type*) [pseudo_emetric_space α] [t0_space α] :
+  emetric_space α :=
+{ eq_of_edist_eq_zero := λ x y hdist, (emetric.inseparable_iff.2 hdist).eq,
   ..‹pseudo_emetric_space α› }
 
 /-- Auxiliary function to replace the uniformity on an emetric space with
@@ -891,7 +918,7 @@ specified uniformity. See Note [forgetful inheritance] explaining why having def
 the right uniformity is often important.
 -/
 def emetric_space.replace_uniformity {γ} [U : uniform_space γ] (m : emetric_space γ)
-  (H : @uniformity _ U = @uniformity _ pseudo_emetric_space.to_uniform_space) :
+  (H : 𝓤[U] = 𝓤[pseudo_emetric_space.to_uniform_space]) :
   emetric_space γ :=
 { edist               := @edist _ m.to_has_edist,
   edist_self          := edist_self,
@@ -910,16 +937,7 @@ def emetric_space.induced {γ β} (f : γ → β) (hf : function.injective f)
   edist_comm          := λ x y, edist_comm _ _,
   edist_triangle      := λ x y z, edist_triangle _ _ _,
   to_uniform_space    := uniform_space.comap f m.to_uniform_space,
-  uniformity_edist    := begin
-    apply @uniformity_dist_of_mem_uniformity _ _ _ _ _ (λ x y, edist (f x) (f y)),
-    refine λ s, mem_comap.trans _,
-    split; intro H,
-    { rcases H with ⟨r, ru, rs⟩,
-      rcases mem_uniformity_edist.1 ru with ⟨ε, ε0, hε⟩,
-      refine ⟨ε, ε0, λ a b h, rs (hε _)⟩, exact h },
-    { rcases H with ⟨ε, ε0, hε⟩,
-      exact ⟨_, edist_mem_uniformity ε0, λ ⟨a, b⟩, hε⟩ }
-  end }
+  uniformity_edist    := (uniformity_basis_edist.comap _).eq_binfi }
 
 /-- Emetric space instance on subsets of emetric spaces -/
 instance {α : Type*} {p : α → Prop} [emetric_space α] : emetric_space (subtype p) :=
@@ -930,6 +948,9 @@ emetric_space.induced coe subtype.coe_injective ‹_›
 instance {α : Type*} [emetric_space α] : emetric_space αᵐᵒᵖ :=
 emetric_space.induced mul_opposite.unop mul_opposite.unop_injective ‹_›
 
+instance {α : Type*} [emetric_space α] : emetric_space (ulift α) :=
+emetric_space.induced ulift.down ulift.down_injective ‹_›
+
 /-- The product of two emetric spaces, with the max distance, is an extended
 metric spaces. We make sure that the uniform structure thus constructed is the one
 corresponding to the product of uniform spaces, to avoid diamond problems. -/
@@ -971,7 +992,7 @@ namespace emetric
 
 /-- A compact set in an emetric space is separable, i.e., it is the closure of a countable set. -/
 lemma countable_closure_of_compact {s : set γ} (hs : is_compact s) :
-  ∃ t ⊆ s, (countable t ∧ s = closure t) :=
+  ∃ t ⊆ s, (t.countable ∧ s = closure t) :=
 begin
   rcases subset_countable_closure_of_compact hs with ⟨t, hts, htc, hsub⟩,
   exact ⟨t, hts, htc, subset.antisymm hsub (closure_minimal hts hs.is_closed)⟩
@@ -985,13 +1006,87 @@ lemma diam_eq_zero_iff : diam s = 0 ↔ s.subsingleton :=
 ⟨λ h x hx y hy, edist_le_zero.1 $ h ▸ edist_le_diam_of_mem hx hy, diam_subsingleton⟩
 
 lemma diam_pos_iff : 0 < diam s ↔ ∃ (x ∈ s) (y ∈ s), x ≠ y :=
-begin
-  have := not_congr (@diam_eq_zero_iff _ _ s),
-  dunfold set.subsingleton at this,
-  push_neg at this,
-  simpa only [pos_iff_ne_zero, exists_prop] using this
-end
+by simp only [pos_iff_ne_zero, ne.def, diam_eq_zero_iff, set.subsingleton, not_forall]
 
 end diam
 
 end emetric
+
+/-!
+### Separation quotient
+-/
+
+instance [pseudo_emetric_space X] : has_edist (uniform_space.separation_quotient X) :=
+⟨λ x y, quotient.lift_on₂' x y edist $ λ x y x' y' hx hy,
+  calc edist x y = edist x' y : edist_congr_right $
+    emetric.inseparable_iff.1 $ separation_rel_iff_inseparable.1 hx
+  ... = edist x' y' : edist_congr_left $
+    emetric.inseparable_iff.1 $ separation_rel_iff_inseparable.1 hy⟩
+
+@[simp] theorem uniform_space.separation_quotient.edist_mk [pseudo_emetric_space X] (x y : X) :
+  @edist (uniform_space.separation_quotient X) _ (quot.mk _ x) (quot.mk _ y) = edist x y :=
+rfl
+
+instance [pseudo_emetric_space X] : emetric_space (uniform_space.separation_quotient X) :=
+@emetric_space.of_t0_pseudo_emetric_space (uniform_space.separation_quotient X)
+  { edist_self := λ x, quotient.induction_on' x edist_self,
+    edist_comm := λ x y, quotient.induction_on₂' x y edist_comm,
+    edist_triangle := λ x y z, quotient.induction_on₃' x y z edist_triangle,
+    to_uniform_space := infer_instance,
+    uniformity_edist := (uniformity_basis_edist.map _).eq_binfi.trans $ infi_congr $ λ ε,
+      infi_congr $ λ hε, congr_arg 𝓟
+      begin
+        ext ⟨⟨x⟩, ⟨y⟩⟩,
+        refine ⟨_, λ h, ⟨(x, y), h, rfl⟩⟩,
+        rintro ⟨⟨x', y'⟩, h', h⟩,
+        simp only [prod.ext_iff] at h,
+        rwa [← h.1, ← h.2]
+      end } _
+
+/-!
+### `additive`, `multiplicative`
+
+The distance on those type synonyms is inherited without change.
+-/
+
+open additive multiplicative
+
+section
+variables [has_edist X]
+
+instance : has_edist (additive X) := ‹has_edist X›
+instance : has_edist (multiplicative X) := ‹has_edist X›
+
+@[simp] lemma edist_of_mul (a b : X) : edist (of_mul a) (of_mul b) = edist a b := rfl
+@[simp] lemma edist_of_add (a b : X) : edist (of_add a) (of_add b) = edist a b := rfl
+@[simp] lemma edist_to_mul (a b : additive X) : edist (to_mul a) (to_mul b) = edist a b := rfl
+@[simp] lemma edist_to_add (a b : multiplicative X) : edist (to_add a) (to_add b) = edist a b := rfl
+
+end
+
+instance [pseudo_emetric_space X] : pseudo_emetric_space (additive X) := ‹pseudo_emetric_space X›
+instance [pseudo_emetric_space X] : pseudo_emetric_space (multiplicative X) :=
+‹pseudo_emetric_space X›
+instance [emetric_space X] : emetric_space (additive X) := ‹emetric_space X›
+instance [emetric_space X] : emetric_space (multiplicative X) := ‹emetric_space X›
+
+/-!
+### Order dual
+
+The distance on this type synonym is inherited without change.
+-/
+
+open order_dual
+
+section
+variables [has_edist X]
+
+instance : has_edist Xᵒᵈ := ‹has_edist X›
+
+@[simp] lemma edist_to_dual (a b : X) : edist (to_dual a) (to_dual b) = edist a b := rfl
+@[simp] lemma edist_of_dual (a b : Xᵒᵈ) : edist (of_dual a) (of_dual b) = edist a b := rfl
+
+end
+
+instance [pseudo_emetric_space X] : pseudo_emetric_space Xᵒᵈ := ‹pseudo_emetric_space X›
+instance [emetric_space X] : emetric_space Xᵒᵈ := ‹emetric_space X›
diff --git a/src/topology/metric_space/equicontinuity.lean b/src/topology/metric_space/equicontinuity.lean
new file mode 100644
index 0000000000000..c4652f99cab69
--- /dev/null
+++ b/src/topology/metric_space/equicontinuity.lean
@@ -0,0 +1,130 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+
+import topology.metric_space.basic
+import topology.uniform_space.equicontinuity
+/-!
+# Equicontinuity in metric spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This files contains various facts about (uniform) equicontinuity in metric spaces. Most
+importantly, we prove the usual characterization of equicontinuity of `F` at `x₀` in the case of
+(pseudo) metric spaces: `∀ ε > 0, ∃ δ > 0, ∀ x, dist x x₀ < δ → ∀ i, dist (F i x₀) (F i x) < ε`,
+and we prove that functions sharing a common (local or global) continuity modulus are
+(locally or uniformly) equicontinuous.
+
+## Main statements
+
+* `equicontinuous_at_iff`: characterization of equicontinuity for families of functions between
+  (pseudo) metric spaces.
+* `equicontinuous_at_of_continuity_modulus`: convenient way to prove equicontinuity at a point of
+  a family of functions to a (pseudo) metric space by showing that they share a common *local*
+  continuity modulus.
+* `uniform_equicontinuous_of_continuity_modulus`: convenient way to prove uniform equicontinuity
+  of a family of functions to a (pseudo) metric space by showing that they share a common *global*
+  continuity modulus.
+
+## Tags
+
+equicontinuity, continuity modulus
+-/
+
+open filter
+open_locale topology uniformity
+
+variables {α β ι : Type*} [pseudo_metric_space α]
+
+namespace metric
+
+/-- Characterization of equicontinuity for families of functions taking values in a (pseudo) metric
+space. -/
+lemma equicontinuous_at_iff_right {ι : Type*} [topological_space β] {F : ι → β → α} {x₀ : β} :
+  equicontinuous_at F x₀ ↔ ∀ ε > 0, ∀ᶠ x in 𝓝 x₀, ∀ i, dist (F i x₀) (F i x) < ε :=
+uniformity_basis_dist.equicontinuous_at_iff_right
+
+/-- Characterization of equicontinuity for families of functions between (pseudo) metric spaces. -/
+lemma equicontinuous_at_iff {ι : Type*} [pseudo_metric_space β] {F : ι → β → α} {x₀ : β} :
+  equicontinuous_at F x₀ ↔ ∀ ε > 0, ∃ δ > 0, ∀ x, dist x x₀ < δ → ∀ i, dist (F i x₀) (F i x) < ε :=
+nhds_basis_ball.equicontinuous_at_iff uniformity_basis_dist
+
+/-- Reformulation of `equicontinuous_at_iff_pair` for families of functions taking values in a
+(pseudo) metric space. -/
+protected lemma equicontinuous_at_iff_pair {ι : Type*} [topological_space β] {F : ι → β → α}
+  {x₀ : β} :
+  equicontinuous_at F x₀ ↔ ∀ ε > 0, ∃ U ∈ 𝓝 x₀, ∀ (x x' ∈ U), ∀ i, dist (F i x) (F i x') < ε :=
+begin
+  rw equicontinuous_at_iff_pair,
+  split; intros H,
+  { intros ε hε,
+    refine exists_imp_exists (λ V, exists_imp_exists $ λ hV h, _) (H _ (dist_mem_uniformity hε)),
+    exact λ x hx x' hx', h _ hx _ hx' },
+  { intros U hU,
+    rcases mem_uniformity_dist.mp hU with ⟨ε, hε, hεU⟩,
+    refine exists_imp_exists (λ V, exists_imp_exists $ λ hV h, _) (H _ hε),
+    exact λ x hx x' hx' i, hεU (h _ hx _ hx' i) }
+end
+
+/-- Characterization of uniform equicontinuity for families of functions taking values in a
+(pseudo) metric space. -/
+lemma uniform_equicontinuous_iff_right {ι : Type*} [uniform_space β] {F : ι → β → α} :
+  uniform_equicontinuous F ↔
+  ∀ ε > 0, ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, dist (F i xy.1) (F i xy.2) < ε :=
+uniformity_basis_dist.uniform_equicontinuous_iff_right
+
+/-- Characterization of uniform equicontinuity for families of functions between
+(pseudo) metric spaces. -/
+lemma uniform_equicontinuous_iff {ι : Type*} [pseudo_metric_space β] {F : ι → β → α} :
+  uniform_equicontinuous F ↔
+  ∀ ε > 0, ∃ δ > 0, ∀ x y, dist x y < δ → ∀ i, dist (F i x) (F i y) < ε :=
+uniformity_basis_dist.uniform_equicontinuous_iff uniformity_basis_dist
+
+/-- For a family of functions to a (pseudo) metric spaces, a convenient way to prove
+equicontinuity at a point is to show that all of the functions share a common *local* continuity
+modulus. -/
+lemma equicontinuous_at_of_continuity_modulus {ι : Type*} [topological_space β] {x₀ : β}
+  (b : β → ℝ)
+  (b_lim : tendsto b (𝓝 x₀) (𝓝 0))
+  (F : ι → β → α)
+  (H : ∀ᶠ x in 𝓝 x₀, ∀ i, dist (F i x₀) (F i x) ≤ b x) :
+  equicontinuous_at F x₀ :=
+begin
+  rw metric.equicontinuous_at_iff_right,
+  intros ε ε0,
+  filter_upwards [b_lim (Iio_mem_nhds ε0), H] using λ x hx₁ hx₂ i, (hx₂ i).trans_lt hx₁
+end
+
+/-- For a family of functions between (pseudo) metric spaces, a convenient way to prove
+uniform equicontinuity is to show that all of the functions share a common *global* continuity
+modulus. -/
+lemma uniform_equicontinuous_of_continuity_modulus {ι : Type*} [pseudo_metric_space β] (b : ℝ → ℝ)
+  (b_lim : tendsto b (𝓝 0) (𝓝 0))
+  (F : ι → β → α)
+  (H : ∀ (x y : β) i, dist (F i x) (F i y) ≤ b (dist x y)) :
+  uniform_equicontinuous F :=
+begin
+  rw metric.uniform_equicontinuous_iff,
+  intros ε ε0,
+  rcases tendsto_nhds_nhds.1 b_lim ε ε0 with ⟨δ, δ0, hδ⟩,
+  refine ⟨δ, δ0, λ x y hxy i, _⟩,
+  calc
+    dist (F i x) (F i y) ≤ b (dist x y) : H x y i
+    ... ≤ |b (dist x y)| : le_abs_self _
+    ... = dist (b (dist x y)) 0 : by simp [real.dist_eq]
+    ... < ε : hδ (by simpa only [real.dist_eq, tsub_zero, abs_dist] using hxy)
+end
+
+/-- For a family of functions between (pseudo) metric spaces, a convenient way to prove
+equicontinuity is to show that all of the functions share a common *global* continuity modulus. -/
+lemma equicontinuous_of_continuity_modulus {ι : Type*} [pseudo_metric_space β] (b : ℝ → ℝ)
+  (b_lim : tendsto b (𝓝 0) (𝓝 0))
+  (F : ι → β → α)
+  (H : ∀ (x y : β) i, dist (F i x) (F i y) ≤ b (dist x y)) :
+  equicontinuous F :=
+(uniform_equicontinuous_of_continuity_modulus b b_lim F H).equicontinuous
+
+end metric
diff --git a/src/topology/metric_space/gluing.lean b/src/topology/metric_space/gluing.lean
index e369594eef2fb..8f35142bced4f 100644
--- a/src/topology/metric_space/gluing.lean
+++ b/src/topology/metric_space/gluing.lean
@@ -8,6 +8,9 @@ import topology.metric_space.isometry
 /-!
 # Metric space gluing
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Gluing two metric spaces along a common subset. Formally, we are given
 
 ```
@@ -106,7 +109,7 @@ private lemma glue_dist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
     have : (⨅ p, dist z (Φ p) + dist x (Ψ p)) ≤ (⨅ p, dist y (Φ p) + dist x (Ψ p)) + dist y z,
     { have : (⨅ p, dist y (Φ p) + dist x (Ψ p)) + dist y z =
             infi ((λt, t + dist y z) ∘ (λp, dist y (Φ p) + dist x (Ψ p))),
-      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _
+      { refine monotone.map_cinfi_of_continuous_at (continuous_at_id.add continuous_at_const) _
           (B _ _),
         intros x y hx, simpa },
       rw [this, comp],
@@ -124,7 +127,7 @@ private lemma glue_dist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
     have : (⨅ p, dist z (Φ p) + dist x (Ψ p)) ≤ dist x y + ⨅ p, dist z (Φ p) + dist y (Ψ p),
     { have : dist x y + (⨅ p, dist z (Φ p) + dist y (Ψ p)) =
             infi ((λt, dist x y + t) ∘ (λp, dist z (Φ p) + dist y (Ψ p))),
-      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_const.add continuous_at_id) _
+      { refine monotone.map_cinfi_of_continuous_at (continuous_at_const.add continuous_at_id) _
           (B _ _),
         intros x y hx, simpa },
       rw [this, comp],
@@ -142,7 +145,7 @@ private lemma glue_dist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
     have : (⨅ p, dist x (Φ p) + dist z (Ψ p)) ≤ dist x y + ⨅ p, dist y (Φ p) + dist z (Ψ p),
     { have : dist x y + (⨅ p, dist y (Φ p) + dist z (Ψ p)) =
             infi ((λt, dist x y + t) ∘ (λp, dist y (Φ p) + dist z (Ψ p))),
-      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_const.add continuous_at_id) _
+      { refine monotone.map_cinfi_of_continuous_at (continuous_at_const.add continuous_at_id) _
           (B _ _),
         intros x y hx, simpa },
       rw [this, comp],
@@ -160,7 +163,7 @@ private lemma glue_dist_triangle (Φ : Z → X) (Ψ : Z → Y) (ε : ℝ)
     have : (⨅ p, dist x (Φ p) + dist z (Ψ p)) ≤ (⨅ p, dist x (Φ p) + dist y (Ψ p)) + dist y z,
     { have : (⨅ p, dist x (Φ p) + dist y (Ψ p)) + dist y z =
             infi ((λt, t + dist y z) ∘ (λp, dist x (Φ p) + dist y (Ψ p))),
-      { refine map_cinfi_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _
+      { refine monotone.map_cinfi_of_continuous_at (continuous_at_id.add continuous_at_const) _
           (B _ _),
         intros x y hx, simpa },
       rw [this, comp],
@@ -338,11 +341,11 @@ lemma sum.dist_eq {x y : X ⊕ Y} : dist x y = sum.dist x y := rfl
 
 /-- The left injection of a space in a disjoint union is an isometry -/
 lemma isometry_inl : isometry (sum.inl : X → (X ⊕ Y)) :=
-isometry_emetric_iff_metric.2 $ λx y, rfl
+isometry.of_dist_eq $ λ x y, rfl
 
 /-- The right injection of a space in a disjoint union is an isometry -/
 lemma isometry_inr : isometry (sum.inr : Y → (X ⊕ Y)) :=
-isometry_emetric_iff_metric.2 $ λx y, rfl
+isometry.of_dist_eq $ λ x y, rfl
 
 end sum
 
@@ -464,7 +467,7 @@ their respective basepoints, plus the distance 1 between the basepoints.
 Since there is an arbitrary choice in this construction, it is not an instance by default. -/
 protected def metric_space : metric_space (Σ i, E i) :=
 begin
-  refine metric_space.of_metrizable sigma.dist _ _ sigma.dist_triangle
+  refine metric_space.of_dist_topology sigma.dist _ _ sigma.dist_triangle
     sigma.is_open_iff _,
   { rintros ⟨i, x⟩, simp [sigma.dist] },
   { rintros ⟨i, x⟩ ⟨j, y⟩,
@@ -482,12 +485,12 @@ end
 
 local attribute [instance] sigma.metric_space
 
-open_locale topological_space
+open_locale topology
 open filter
 
 /-- The injection of a space in a disjoint union is an isometry -/
 lemma isometry_mk (i : ι) : isometry (sigma.mk i : E i → Σ k, E k) :=
-isometry_emetric_iff_metric.2 (by simp)
+isometry.of_dist_eq (λ x y, by simp)
 
 /-- A disjoint union of complete metric spaces is complete. -/
 protected lemma complete_space [∀ i, complete_space (E i)] : complete_space (Σ i, E i) :=
@@ -514,7 +517,7 @@ variables {X : Type u} {Y : Type v} {Z : Type w}
 variables [nonempty Z] [metric_space Z] [metric_space X] [metric_space Y]
           {Φ : Z → X} {Ψ : Z → Y} {ε : ℝ}
 open _root_.sum (inl inr)
-local attribute [instance] pseudo_metric.dist_setoid
+local attribute [instance] uniform_space.separation_setoid
 
 /-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a pseudo metric space
 structure on `X ⊕ Y` by declaring that `Φ x` and `Ψ x` are at distance `0`. -/
@@ -526,20 +529,15 @@ def glue_premetric (hΦ : isometry Φ) (hΨ : isometry Ψ) : pseudo_metric_space
 
 /-- Given two isometric embeddings `Φ : Z → X` and `Ψ : Z → Y`, we define a
 space  `glue_space hΦ hΨ` by identifying in `X ⊕ Y` the points `Φ x` and `Ψ x`. -/
+@[derive metric_space]
 def glue_space (hΦ : isometry Φ) (hΨ : isometry Ψ) : Type* :=
-@pseudo_metric_quot _ (glue_premetric hΦ hΨ)
-
-instance metric_space_glue_space (hΦ : isometry Φ) (hΨ : isometry Ψ) :
-  metric_space (glue_space hΦ hΨ) :=
-@metric_space_quot _ (glue_premetric hΦ hΨ)
+@uniform_space.separation_quotient _ (glue_premetric hΦ hΨ).to_uniform_space
 
 /-- The canonical map from `X` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
-def to_glue_l (hΦ : isometry Φ) (hΨ : isometry Ψ) (x : X) : glue_space hΦ hΨ :=
-by letI : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ; exact ⟦inl x⟧
+def to_glue_l (hΦ : isometry Φ) (hΨ : isometry Ψ) (x : X) : glue_space hΦ hΨ := quotient.mk' (inl x)
 
 /-- The canonical map from `Y` to the space obtained by gluing isometric subsets in `X` and `Y`. -/
-def to_glue_r (hΦ : isometry Φ) (hΨ : isometry Ψ) (y : Y) : glue_space hΦ hΨ :=
-by letI : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ; exact ⟦inr y⟧
+def to_glue_r (hΦ : isometry Φ) (hΨ : isometry Ψ) (y : Y) : glue_space hΦ hΨ := quotient.mk' (inr y)
 
 instance inhabited_left (hΦ : isometry Φ) (hΨ : isometry Ψ) [inhabited X] :
   inhabited (glue_space hΦ hΨ) :=
@@ -552,17 +550,19 @@ instance inhabited_right (hΦ : isometry Φ) (hΨ : isometry Ψ) [inhabited Y] :
 lemma to_glue_commute (hΦ : isometry Φ) (hΨ : isometry Ψ) :
   (to_glue_l hΦ hΨ) ∘ Φ = (to_glue_r hΦ hΨ) ∘ Ψ :=
 begin
-  letI : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ,
+  letI i : pseudo_metric_space (X ⊕ Y) := glue_premetric hΦ hΨ,
+  letI := i.to_uniform_space,
   funext,
-  simp only [comp, to_glue_l, to_glue_r, quotient.eq],
+  simp only [comp, to_glue_l, to_glue_r],
+  refine uniform_space.separation_quotient.mk_eq_mk.2 (metric.inseparable_iff.2 _),
   exact glue_dist_glued_points Φ Ψ 0 x
 end
 
 lemma to_glue_l_isometry (hΦ : isometry Φ) (hΨ : isometry Ψ) : isometry (to_glue_l hΦ hΨ) :=
-isometry_emetric_iff_metric.2 $ λ_ _, rfl
+isometry.of_dist_eq $ λ_ _, rfl
 
 lemma to_glue_r_isometry (hΦ : isometry Φ) (hΨ : isometry Ψ) : isometry (to_glue_r hΦ hΨ) :=
-isometry_emetric_iff_metric.2 $ λ_ _, rfl
+isometry.of_dist_eq $ λ_ _, rfl
 
 end gluing --section
 
@@ -636,27 +636,22 @@ def inductive_premetric (I : ∀ n, isometry (f n)) :
                 inductive_limit_dist_eq_dist I y z m hy hz]
   end }
 
-local attribute [instance] inductive_premetric pseudo_metric.dist_setoid
+local attribute [instance] inductive_premetric uniform_space.separation_setoid
 
 /-- The type giving the inductive limit in a metric space context. -/
-def inductive_limit (I : ∀ n, isometry (f n)) : Type* :=
-@pseudo_metric_quot _ (inductive_premetric I)
-
-/-- Metric space structure on the inductive limit. -/
-instance metric_space_inductive_limit (I : ∀ n, isometry (f n)) :
-  metric_space (inductive_limit I) :=
-@metric_space_quot _ (inductive_premetric I)
+@[derive metric_space] def inductive_limit (I : ∀ n, isometry (f n)) : Type* :=
+@uniform_space.separation_quotient _ (inductive_premetric I).to_uniform_space
 
 /-- Mapping each `X n` to the inductive limit. -/
 def to_inductive_limit (I : ∀ n, isometry (f n)) (n : ℕ) (x : X n) : metric.inductive_limit I :=
-by letI : pseudo_metric_space (Σ n, X n) := inductive_premetric I; exact ⟦sigma.mk n x⟧
+quotient.mk' (sigma.mk n x)
 
 instance (I : ∀ n, isometry (f n)) [inhabited (X 0)] : inhabited (inductive_limit I) :=
 ⟨to_inductive_limit _ 0 default⟩
 
 /-- The map `to_inductive_limit n` mapping `X n` to the inductive limit is an isometry. -/
 lemma to_inductive_limit_isometry (I : ∀ n, isometry (f n)) (n : ℕ) :
-  isometry (to_inductive_limit I n) := isometry_emetric_iff_metric.2 $ λx y,
+  isometry (to_inductive_limit I n) := isometry.of_dist_eq $ λ x y,
 begin
   change inductive_limit_dist f ⟨n, x⟩ ⟨n, y⟩ = dist x y,
   rw [inductive_limit_dist_eq_dist I ⟨n, x⟩ ⟨n, y⟩ n (le_refl n) (le_refl n),
@@ -667,8 +662,10 @@ end
 lemma to_inductive_limit_commute (I : ∀ n, isometry (f n)) (n : ℕ) :
   (to_inductive_limit I n.succ) ∘ (f n) = to_inductive_limit I n :=
 begin
+  letI := inductive_premetric I,
   funext,
-  simp only [comp, to_inductive_limit, quotient.eq],
+  simp only [comp, to_inductive_limit],
+  refine uniform_space.separation_quotient.mk_eq_mk.2 (metric.inseparable_iff.2 _),
   show inductive_limit_dist f ⟨n.succ, f n x⟩ ⟨n, x⟩ = 0,
   { rw [inductive_limit_dist_eq_dist I ⟨n.succ, f n x⟩ ⟨n, x⟩ n.succ,
         le_rec_on_self, le_rec_on_succ, le_rec_on_self, dist_self],
diff --git a/src/topology/metric_space/gromov_hausdorff.lean b/src/topology/metric_space/gromov_hausdorff.lean
index b55d1b10a459f..f3d546bb9f5dc 100644
--- a/src/topology/metric_space/gromov_hausdorff.lean
+++ b/src/topology/metric_space/gromov_hausdorff.lean
@@ -12,6 +12,9 @@ import topology.metric_space.kuratowski
 /-!
 # Gromov-Hausdorff distance
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines the Gromov-Hausdorff distance on the space of nonempty compact metric spaces
 up to isometry.
 
@@ -40,7 +43,7 @@ i.e., it is complete and second countable. We also prove the Gromov compactness
 -/
 
 noncomputable theory
-open_locale classical topological_space ennreal
+open_locale classical topology ennreal
 
 local notation `ℓ_infty_ℝ`:= lp (λ n : ℕ, ℝ) ∞
 
@@ -67,7 +70,7 @@ private def isometry_rel : nonempty_compacts ℓ_infty_ℝ → nonempty_compacts
 
 /-- This is indeed an equivalence relation -/
 private lemma is_equivalence_isometry_rel : equivalence isometry_rel :=
-⟨λ x, ⟨isometric.refl _⟩, λ x y ⟨e⟩, ⟨e.symm⟩, λ x y z ⟨e⟩ ⟨f⟩, ⟨e.trans f⟩⟩
+⟨λ x, ⟨isometry_equiv.refl _⟩, λ x y ⟨e⟩, ⟨e.symm⟩, λ x y z ⟨e⟩ ⟨f⟩, ⟨e.trans f⟩⟩
 
 /-- setoid instance identifying two isometric nonempty compact subspaces of ℓ^∞(ℝ) -/
 instance isometry_rel.setoid : setoid (nonempty_compacts ℓ_infty_ℝ) :=
@@ -83,7 +86,7 @@ definition to_GH_space (X : Type u) [metric_space X] [compact_space X] [nonempty
 instance : inhabited GH_space := ⟨quot.mk _ ⟨⟨{0}, is_compact_singleton⟩, singleton_nonempty _⟩⟩
 
 /-- A metric space representative of any abstract point in `GH_space` -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def GH_space.rep (p : GH_space) : Type := (quotient.out p : nonempty_compacts ℓ_infty_ℝ)
 
 lemma eq_to_GH_space_iff {X : Type u} [metric_space X] [compact_space X] [nonempty X]
@@ -93,13 +96,13 @@ begin
   simp only [to_GH_space, quotient.eq],
   refine ⟨λ h, _, _⟩,
   { rcases setoid.symm h with ⟨e⟩,
-    have f := (Kuratowski_embedding.isometry X).isometric_on_range.trans e,
+    have f := (Kuratowski_embedding.isometry X).isometry_equiv_on_range.trans e,
     use [λ x, f x, isometry_subtype_coe.comp f.isometry],
     rw [range_comp, f.range_eq_univ, set.image_univ, subtype.range_coe],
     refl },
   { rintros ⟨Ψ, ⟨isomΨ, rangeΨ⟩⟩,
-    have f := ((Kuratowski_embedding.isometry X).isometric_on_range.symm.trans
-               isomΨ.isometric_on_range).symm,
+    have f := ((Kuratowski_embedding.isometry X).isometry_equiv_on_range.symm.trans
+               isomΨ.isometry_equiv_on_range).symm,
     have E : (range Ψ ≃ᵢ nonempty_compacts.Kuratowski_embedding X) =
         (p ≃ᵢ range (Kuratowski_embedding X)),
       by { dunfold nonempty_compacts.Kuratowski_embedding, rw [rangeΨ]; refl },
@@ -127,7 +130,7 @@ end
 
 /-- Two nonempty compact spaces have the same image in `GH_space` if and only if they are
 isometric. -/
-lemma to_GH_space_eq_to_GH_space_iff_isometric {X : Type u} [metric_space X] [compact_space X]
+lemma to_GH_space_eq_to_GH_space_iff_isometry_equiv {X : Type u} [metric_space X] [compact_space X]
   [nonempty X] {Y : Type v} [metric_space Y] [compact_space Y] [nonempty Y] :
   to_GH_space X = to_GH_space Y ↔ nonempty (X ≃ᵢ Y) :=
 ⟨begin
@@ -137,15 +140,15 @@ lemma to_GH_space_eq_to_GH_space_iff_isometric {X : Type u} [metric_space X] [co
              (nonempty_compacts.Kuratowski_embedding Y))
           = ((range (Kuratowski_embedding X)) ≃ᵢ (range (Kuratowski_embedding Y))),
     by { dunfold nonempty_compacts.Kuratowski_embedding, refl },
-  have f := (Kuratowski_embedding.isometry X).isometric_on_range,
-  have g := (Kuratowski_embedding.isometry Y).isometric_on_range.symm,
+  have f := (Kuratowski_embedding.isometry X).isometry_equiv_on_range,
+  have g := (Kuratowski_embedding.isometry Y).isometry_equiv_on_range.symm,
   exact ⟨f.trans $ (cast I e).trans g⟩
 end,
 begin
   rintro ⟨e⟩,
   simp only [to_GH_space, quotient.eq],
-  have f := (Kuratowski_embedding.isometry X).isometric_on_range.symm,
-  have g := (Kuratowski_embedding.isometry Y).isometric_on_range,
+  have f := (Kuratowski_embedding.isometry X).isometry_equiv_on_range.symm,
+  have g := (Kuratowski_embedding.isometry Y).isometry_equiv_on_range,
   have I : ((range (Kuratowski_embedding X)) ≃ᵢ (range (Kuratowski_embedding Y))) =
     ((nonempty_compacts.Kuratowski_embedding X) ≃ᵢ
       (nonempty_compacts.Kuratowski_embedding Y)),
@@ -213,8 +216,12 @@ begin
   have BY : ⟦B⟧ = to_GH_space Y,
   { rw eq_to_GH_space_iff,
     exact ⟨λ x, F (Ψ' x), (Kuratowski_embedding.isometry _).comp IΨ', range_comp _ _⟩ },
-  refine cInf_le ⟨0,
-    begin simp [lower_bounds], assume t _ _ _ _ ht, rw ← ht, exact Hausdorff_dist_nonneg end⟩ _,
+  refine cInf_le ⟨0, _⟩ _,
+  { simp only [lower_bounds, mem_image, mem_prod, mem_set_of_eq, prod.exists, and_imp,
+      forall_exists_index],
+    assume t _ _ _ _ ht,
+    rw ← ht,
+    exact Hausdorff_dist_nonneg },
   apply (mem_image _ _ _).2,
   existsi (⟨A, B⟩ : nonempty_compacts ℓ_infty_ℝ × nonempty_compacts ℓ_infty_ℝ),
   simp [AX, BY],
@@ -249,7 +256,7 @@ begin
         have : Φ xX ∈ ↑p := Φrange.subst (mem_range_self _),
         exact exists_dist_lt_of_Hausdorff_dist_lt this bound
           (Hausdorff_edist_ne_top_of_nonempty_of_bounded p.nonempty q.nonempty
-            p.compact.bounded q.compact.bounded) },
+            p.is_compact.bounded q.is_compact.bounded) },
       rcases this with ⟨y, hy, dy⟩,
       rcases mem_range.1 hy with ⟨z, hzy⟩,
       rw ← hzy at dy,
@@ -288,7 +295,7 @@ begin
             { apply mem_union_right, apply mem_range_self } },
           refine dist_le_diam_of_mem _ (A _) (A _),
           rw [Φrange, Ψrange],
-          exact (p ⊔ q).compact.bounded,
+          exact (p ⊔ q).is_compact.bounded,
         end
         ... ≤ 2 * diam (univ : set X) + 1 + 2 * diam (univ : set Y) : I } },
     let Fb := candidates_b_of_candidates F Fgood,
@@ -300,12 +307,12 @@ begin
       have : f (inl x) ∈ ↑p := Φrange.subst (mem_range_self _),
       rcases exists_dist_lt_of_Hausdorff_dist_lt this hr
         (Hausdorff_edist_ne_top_of_nonempty_of_bounded p.nonempty q.nonempty
-          p.compact.bounded q.compact.bounded)
+          p.is_compact.bounded q.is_compact.bounded)
         with ⟨z, zq, hz⟩,
       have : z ∈ range Ψ, by rwa [← Ψrange] at zq,
       rcases mem_range.1 this with ⟨y, hy⟩,
       calc (⨅ y, Fb (inl x, inr y)) ≤ Fb (inl x, inr y) :
-          cinfi_le (by simpa using HD_below_aux1 0) y
+          cinfi_le (by simpa only [add_zero] using HD_below_aux1 0) y
         ... = dist (Φ x) (Ψ y) : rfl
         ... = dist (f (inl x)) z : by rw hy
         ... ≤ r : le_of_lt hz },
@@ -314,16 +321,16 @@ begin
       have : f (inr y) ∈ ↑q := Ψrange.subst (mem_range_self _),
       rcases exists_dist_lt_of_Hausdorff_dist_lt' this hr
         (Hausdorff_edist_ne_top_of_nonempty_of_bounded p.nonempty q.nonempty
-          p.compact.bounded q.compact.bounded)
+          p.is_compact.bounded q.is_compact.bounded)
         with ⟨z, zq, hz⟩,
       have : z ∈ range Φ, by rwa [← Φrange] at zq,
       rcases mem_range.1 this with ⟨x, hx⟩,
       calc (⨅ x, Fb (inl x, inr y)) ≤ Fb (inl x, inr y) :
-          cinfi_le (by simpa using HD_below_aux2 0) x
+          cinfi_le (by simpa only [add_zero] using HD_below_aux2 0) x
         ... = dist (Φ x) (Ψ y) : rfl
         ... = dist z (f (inr y)) : by rw hx
         ... ≤ r : le_of_lt hz },
-    simp [HD, csupr_le I1, csupr_le I2] },
+    simp only [HD, csupr_le I1, csupr_le I2, max_le_iff, and_self] },
   /- Get the same inequality for any coupling. If the coupling is quite good, the desired
   inequality has been proved above. If it is bad, then the inequality is obvious. -/
   have B : ∀ p q : nonempty_compacts ℓ_infty_ℝ, ⟦p⟧ = to_GH_space X → ⟦q⟧ = to_GH_space Y →
@@ -366,12 +373,15 @@ end
 
 /-- The Gromov-Hausdorff distance defines a genuine distance on the Gromov-Hausdorff space. -/
 instance : metric_space GH_space :=
-{ dist_self := λ x, begin
+{ dist := dist,
+  dist_self := λ x, begin
     rcases exists_rep x with ⟨y, hy⟩,
     refine le_antisymm _ _,
     { apply cInf_le,
       { exact ⟨0, by { rintro b ⟨⟨u, v⟩, ⟨hu, hv⟩, rfl⟩, exact Hausdorff_dist_nonneg } ⟩},
-      { simp, existsi [y, y], simpa } },
+      { simp only [mem_image, mem_prod, mem_set_of_eq, prod.exists],
+        existsi [y, y],
+        simpa only [and_self, Hausdorff_dist_self_zero, eq_self_iff_true, and_true]} },
     { apply le_cInf,
       { exact (nonempty.prod ⟨y, hy⟩ ⟨y, hy⟩).image _ },
       { rintro b ⟨⟨u, v⟩, ⟨hu, hv⟩, rfl⟩, exact Hausdorff_dist_nonneg } },
@@ -382,8 +392,8 @@ instance : metric_space GH_space :=
              ({a | ⟦a⟧ = x} ×ˢ {b | ⟦b⟧ = y})
            = ((λ (p : nonempty_compacts ℓ_infty_ℝ × nonempty_compacts ℓ_infty_ℝ),
                  Hausdorff_dist (p.1 : set ℓ_infty_ℝ) p.2) ∘ prod.swap) ''
-                 ({a | ⟦a⟧ = x} ×ˢ {b | ⟦b⟧ = y}) :=
-      by { congr, funext, simp, rw Hausdorff_dist_comm },
+                 ({a | ⟦a⟧ = x} ×ˢ {b | ⟦b⟧ = y}),
+    { congr, funext, simp only [comp_app, prod.fst_swap, prod.snd_swap], rw Hausdorff_dist_comm },
     simp only [dist, A, image_comp, image_swap_prod],
   end,
   eq_of_dist_eq_zero := λ x y hxy, begin
@@ -401,9 +411,9 @@ instance : metric_space GH_space :=
       { exact Hausdorff_edist_ne_top_of_nonempty_of_bounded (range_nonempty _)
           (range_nonempty _) hΦ.bounded hΨ.bounded } },
     have T : ((range Ψ) ≃ᵢ y.rep) = ((range Φ) ≃ᵢ y.rep), by rw this,
-    have eΨ := cast T Ψisom.isometric_on_range.symm,
-    have e := Φisom.isometric_on_range.trans eΨ,
-    rw [← x.to_GH_space_rep, ← y.to_GH_space_rep, to_GH_space_eq_to_GH_space_iff_isometric],
+    have eΨ := cast T Ψisom.isometry_equiv_on_range.symm,
+    have e := Φisom.isometry_equiv_on_range.trans eΨ,
+    rw [← x.to_GH_space_rep, ← y.to_GH_space_rep, to_GH_space_eq_to_GH_space_iff_isometry_equiv],
     exact ⟨e⟩
   end,
   dist_triangle := λ x y z, begin
@@ -422,7 +432,6 @@ instance : metric_space GH_space :=
     let Ψ : Y → γ2 := optimal_GH_injl Y Z,
     have hΨ : isometry Ψ := isometry_optimal_GH_injl Y Z,
     let γ := glue_space hΦ hΨ,
-    letI : metric_space γ := metric.metric_space_glue_space hΦ hΨ,
     have Comm : (to_glue_l hΦ hΨ) ∘ (optimal_GH_injr X Y) =
       (to_glue_r hΦ hΨ) ∘ (optimal_GH_injl Y Z) := to_glue_commute hΦ hΨ,
     calc dist x z = dist (to_GH_space X) (to_GH_space Z) :
@@ -533,8 +542,8 @@ begin
     glue_metric_approx (λ x:s, (x:X)) (λ x, Φ x) (ε₂/2 + δ) (by linarith) this,
   let Fl := @sum.inl X Y,
   let Fr := @sum.inr X Y,
-  have Il : isometry Fl := isometry_emetric_iff_metric.2 (λ x y, rfl),
-  have Ir : isometry Fr := isometry_emetric_iff_metric.2 (λ x y, rfl),
+  have Il : isometry Fl := isometry.of_dist_eq (λ x y, rfl),
+  have Ir : isometry Fr := isometry.of_dist_eq (λ x y, rfl),
   /- The proof goes as follows : the `GH_dist` is bounded by the Hausdorff distance of the images
   in the coupling, which is bounded (using the triangular inequality) by the sum of the Hausdorff
   distances of `X` and `s` (in the coupling or, equivalently in the original space), of `s` and
@@ -561,7 +570,7 @@ begin
   { rw [← image_univ, Hausdorff_dist_image Il],
     have : 0 ≤ ε₁ := le_trans dist_nonneg Dxs,
     refine Hausdorff_dist_le_of_mem_dist this (λ x hx, hs x)
-      (λ x hx, ⟨x, mem_univ _, by simpa⟩) },
+      (λ x hx, ⟨x, mem_univ _, by simpa only [dist_self]⟩) },
   have : Hausdorff_dist (Fl '' s) (Fr '' (range Φ)) ≤ ε₂/2 + δ,
   { refine Hausdorff_dist_le_of_mem_dist (by linarith) _ _,
     { assume x' hx',
@@ -580,7 +589,8 @@ begin
     rcases exists_mem_of_nonempty Y with ⟨xY, _⟩,
     rcases hs' xY with ⟨xs', Dxs'⟩,
     have : 0 ≤ ε₃ := le_trans dist_nonneg Dxs',
-    refine Hausdorff_dist_le_of_mem_dist this (λ x hx, ⟨x, mem_univ _, by simpa⟩) (λ x _, _),
+    refine Hausdorff_dist_le_of_mem_dist this (λ x hx, ⟨x, mem_univ _, by simpa only [dist_self]⟩)
+      (λ x _, _),
     rcases hs' x with ⟨y, Dy⟩,
     exact ⟨Φ y, mem_range_self _, Dy⟩ },
   linarith
@@ -593,12 +603,13 @@ begin
   refine second_countable_of_countable_discretization (λ δ δpos, _),
   let ε := (2/5) * δ,
   have εpos : 0 < ε := mul_pos (by norm_num) δpos,
-  have : ∀ p:GH_space, ∃ s : set p.rep, finite s ∧ (univ ⊆ (⋃x∈s, ball x ε)) :=
-    λ p, by simpa using finite_cover_balls_of_compact (@compact_univ p.rep _ _) εpos,
+  have : ∀ p:GH_space, ∃ s : set p.rep, s.finite ∧ (univ ⊆ (⋃x∈s, ball x ε)) :=
+    λ p, by simpa only [subset_univ, exists_true_left]
+      using finite_cover_balls_of_compact is_compact_univ εpos,
   -- for each `p`, `s p` is a finite `ε`-dense subset of `p` (or rather the metric space
   -- `p.rep` representing `p`)
   choose s hs using this,
-  have : ∀ p:GH_space, ∀ t:set p.rep, finite t → ∃ n:ℕ, ∃ e:equiv t (fin n), true,
+  have : ∀ p:GH_space, ∀ t:set p.rep, t.finite → ∃ n:ℕ, ∃ e:equiv t (fin n), true,
   { assume p t ht,
     letI : fintype t := finite.fintype ht,
     exact ⟨fintype.card t, fintype.equiv_fin t, trivial⟩ },
@@ -648,9 +659,9 @@ begin
       have C1 : (E p) z = ⟨i, hip⟩ := (E p).apply_symm_apply ⟨i, hip⟩,
       have C2 : fin.cast Npq ⟨i, hip⟩ = ⟨i, hi⟩ := rfl,
       have C3 : (E q).symm ⟨i, hi⟩ = ⟨y, ys⟩,
-        by { rw ihi_eq, exact (E q).symm_apply_apply ⟨y, ys⟩ },
-      have : Φ z = y :=
-        by { simp only [Φ, Ψ], rw [C1, C2, C3], refl },
+      { rw ihi_eq, exact (E q).symm_apply_apply ⟨y, ys⟩ },
+      have : Φ z = y,
+      { simp only [Φ, Ψ], rw [C1, C2, C3], refl },
       rw this,
       exact le_of_lt hy },
     show ∀ x y : s p, |dist x y - dist (Φ x) (Φ y)| ≤ ε,
@@ -664,22 +675,23 @@ begin
       let i : ℕ := E p x,
       have hip : i < N p := ((E p) x).2,
       have hiq : i < N q, by rwa Npq at hip,
-      have i' : i = ((E q) (Ψ x)), by { simp [Ψ] },
+      have i' : i = ((E q) (Ψ x)), by { simp only [equiv.apply_symm_apply, fin.coe_cast] },
       -- introduce `j`, that codes both `y` and `Φ y` in `fin (N p) = fin (N q)`
       let j : ℕ := E p y,
       have hjp : j < N p := ((E p) y).2,
       have hjq : j < N q, by rwa Npq at hjp,
-      have j' : j = ((E q) (Ψ y)).1, by { simp [Ψ] },
+      have j' : j = ((E q) (Ψ y)).1,
+      { simp only [equiv.apply_symm_apply, fin.val_eq_coe, fin.coe_cast] },
       -- Express `dist x y` in terms of `F p`
       have : (F p).2 ((E p) x) ((E p) y) = floor (ε⁻¹ * dist x y),
         by simp only [F, (E p).symm_apply_apply],
       have Ap : (F p).2 ⟨i, hip⟩ ⟨j, hjp⟩ = floor (ε⁻¹ * dist x y),
-        by { rw ← this, congr; apply (fin.ext_iff _ _).2; refl },
+        by { rw ← this, congr; apply fin.ext_iff.2; refl },
       -- Express `dist (Φ x) (Φ y)` in terms of `F q`
       have : (F q).2 ((E q) (Ψ x)) ((E q) (Ψ y)) = floor (ε⁻¹ * dist (Ψ x) (Ψ y)),
         by simp only [F, (E q).symm_apply_apply],
       have Aq : (F q).2 ⟨i, hiq⟩ ⟨j, hjq⟩ = floor (ε⁻¹ * dist (Ψ x) (Ψ y)),
-        by { rw ← this, congr; apply (fin.ext_iff _ _).2; [exact i', exact j'] },
+        by { rw ← this, congr; apply fin.ext_iff.2; [exact i', exact j'] },
       -- use the equality between `F p` and `F q` to deduce that the distances have equal
       -- integer parts
       have : (F p).2 ⟨i, hip⟩ ⟨j, hjp⟩ = (F q).2 ⟨i, hiq⟩ ⟨j, hjq⟩,
@@ -709,7 +721,7 @@ begin
         ... = ε : mul_one _ } },
   calc dist p q = GH_dist p.rep (q.rep) : dist_GH_dist p q
     ... ≤ ε + ε/2 + ε : main
-    ... = δ : by { simp [ε], ring }
+    ... = δ : by { simp only [ε], ring }
 end
 
 /-- Compactness criterion: a closed set of compact metric spaces is compact if the spaces have
@@ -742,15 +754,15 @@ begin
   { assume p,
     by_cases hp : p ∉ t,
     { have : nonempty (equiv (∅ : set p.rep) (fin 0)),
-      { rw ← fintype.card_eq, simp },
+      { rw ← fintype.card_eq, simp only [empty_card', fintype.card_fin] },
       use [∅, 0, bot_le, choice (this)] },
     { rcases hcov _ (set.not_not_mem.1 hp) n with ⟨s, ⟨scard, scover⟩⟩,
-      rcases cardinal.lt_omega.1 (lt_of_le_of_lt scard (cardinal.nat_lt_omega _)) with ⟨N, hN⟩,
+      rcases cardinal.lt_aleph_0.1 (lt_of_le_of_lt scard (cardinal.nat_lt_aleph_0 _)) with ⟨N, hN⟩,
       rw [hN, cardinal.nat_cast_le] at scard,
       have : cardinal.mk s = cardinal.mk (fin N), by rw [hN, cardinal.mk_fin],
       cases quotient.exact this with E,
       use [s, N, scard, E],
-      simp [hp, scover] } },
+      simp only [scover, implies_true_iff] } },
   choose s N hN E hs using this,
   -- Define a function `F` taking values in a finite type and associating to `p` enough data
   -- to reconstruct it up to `ε`, namely the (discretized) distances between elements of `s p`.
@@ -762,7 +774,7 @@ begin
   refine ⟨_, _, (λ p, F p), _⟩, apply_instance,
   -- It remains to show that if `F p = F q`, then `p` and `q` are `ε`-close
   rintros ⟨p, pt⟩ ⟨q, qt⟩ hpq,
-  have Npq : N p = N q := (fin.ext_iff _ _).1 (sigma.mk.inj_iff.1 hpq).1,
+  have Npq : N p = N q := fin.ext_iff.1 (sigma.mk.inj_iff.1 hpq).1,
   let Ψ : s p → s q := λ x, (E q).symm (fin.cast Npq ((E p) x)),
   let Φ : s p → q.rep := λ x, Ψ x,
   have main : GH_dist p.rep (q.rep) ≤ ε + ε/2 + ε,
@@ -807,16 +819,16 @@ begin
       let i : ℕ := E p x,
       have hip : i < N p := ((E p) x).2,
       have hiq : i < N q, by rwa Npq at hip,
-      have i' : i = ((E q) (Ψ x)), by { simp [Ψ] },
+      have i' : i = ((E q) (Ψ x)), by { simp only [equiv.apply_symm_apply, fin.coe_cast] },
       -- introduce `j`, that codes both `y` and `Φ y` in `fin (N p) = fin (N q)`
       let j : ℕ := E p y,
       have hjp : j < N p := ((E p) y).2,
       have hjq : j < N q, by rwa Npq at hjp,
-      have j' : j = ((E q) (Ψ y)), by { simp [Ψ] },
+      have j' : j = ((E q) (Ψ y)), by { simp only [equiv.apply_symm_apply, fin.coe_cast] },
       -- Express `dist x y` in terms of `F p`
       have Ap : ((F p).2 ⟨i, hip⟩ ⟨j, hjp⟩).1 = ⌊ε⁻¹ * dist x y⌋₊ := calc
         ((F p).2 ⟨i, hip⟩ ⟨j, hjp⟩).1 = ((F p).2 ((E p) x) ((E p) y)).1 :
-          by { congr; apply (fin.ext_iff _ _).2; refl }
+          by { congr; apply fin.ext_iff.2; refl }
         ... = min M ⌊ε⁻¹ * dist x y⌋₊ :
           by simp only [F, (E p).symm_apply_apply]
         ... = ⌊ε⁻¹ * dist x y⌋₊ :
@@ -824,13 +836,13 @@ begin
           refine min_eq_right (nat.floor_mono _),
           refine mul_le_mul_of_nonneg_left (le_trans _ (le_max_left _ _)) ((inv_pos.2 εpos).le),
           change dist (x : p.rep) y ≤ C,
-          refine le_trans (dist_le_diam_of_mem compact_univ.bounded (mem_univ _) (mem_univ _)) _,
+          refine le_trans (dist_le_diam_of_mem is_compact_univ.bounded (mem_univ _) (mem_univ _)) _,
           exact hdiam p pt
         end,
       -- Express `dist (Φ x) (Φ y)` in terms of `F q`
       have Aq : ((F q).2 ⟨i, hiq⟩ ⟨j, hjq⟩).1 = ⌊ε⁻¹ * dist (Ψ x) (Ψ y)⌋₊ := calc
         ((F q).2 ⟨i, hiq⟩ ⟨j, hjq⟩).1 = ((F q).2 ((E q) (Ψ x)) ((E q) (Ψ y))).1 :
-          by { congr; apply (fin.ext_iff _ _).2; [exact i', exact j'] }
+          by { congr; apply fin.ext_iff.2; [exact i', exact j'] }
         ... = min M ⌊ε⁻¹ * dist (Ψ x) (Ψ y)⌋₊ :
           by simp only [F, (E q).symm_apply_apply]
         ... = ⌊ε⁻¹ * dist (Ψ x) (Ψ y)⌋₊ :
@@ -838,7 +850,7 @@ begin
           refine min_eq_right (nat.floor_mono _),
           refine mul_le_mul_of_nonneg_left (le_trans _ (le_max_left _ _)) ((inv_pos.2 εpos).le),
           change dist (Ψ x : q.rep) (Ψ y) ≤ C,
-          refine le_trans (dist_le_diam_of_mem compact_univ.bounded (mem_univ _) (mem_univ _)) _,
+          refine le_trans (dist_le_diam_of_mem is_compact_univ.bounded (mem_univ _) (mem_univ _)) _,
           exact hdiam q qt
         end,
       -- use the equality between `F p` and `F q` to deduce that the distances have equal
@@ -877,7 +889,7 @@ begin
         ... = ε : mul_one _ } },
   calc dist p q = GH_dist p.rep (q.rep) : dist_GH_dist p q
     ... ≤ ε + ε/2 + ε : main
-    ... = δ/2 : by { simp [ε], ring }
+    ... = δ/2 : by { simp only [ε, one_div], ring }
     ... < δ : half_lt_self δpos
 end
 
@@ -908,6 +920,8 @@ structure aux_gluing_struct (A : Type) [metric_space A] : Type 1 :=
 (embed  : A → space)
 (isom   : isometry embed)
 
+local attribute [instance] aux_gluing_struct.metric
+
 instance (A : Type) [metric_space A] : inhabited (aux_gluing_struct A) :=
 ⟨{ space := A,
   metric := by apply_instance,
@@ -917,17 +931,13 @@ instance (A : Type) [metric_space A] : inhabited (aux_gluing_struct A) :=
 /-- Auxiliary sequence of metric spaces, containing copies of `X 0`, ..., `X n`, where each
 `X i` is glued to `X (i+1)` in an optimal way. The space at step `n+1` is obtained from the space
 at step `n` by adding `X (n+1)`, glued in an optimal way to the `X n` already sitting there. -/
-def aux_gluing (n : ℕ) : aux_gluing_struct (X n) := nat.rec_on n
-  { space  := X 0,
-    metric := by apply_instance,
-    embed  := id,
-    isom   := λ x y, rfl }
-(λ n Y, by letI : metric_space Y.space := Y.metric; exact
+def aux_gluing (n : ℕ) : aux_gluing_struct (X n) :=
+nat.rec_on n default $ λ n Y,
   { space  := glue_space Y.isom (isometry_optimal_GH_injl (X n) (X (n+1))),
     metric := by apply_instance,
     embed  := (to_glue_r Y.isom (isometry_optimal_GH_injl (X n) (X (n+1))))
               ∘ (optimal_GH_injr (X n) (X (n+1))),
-    isom   := (to_glue_r_isometry _ _).comp (isometry_optimal_GH_injr (X n) (X (n+1))) })
+    isom   := (to_glue_r_isometry _ _).comp (isometry_optimal_GH_injr (X n) (X (n+1))) }
 
 /-- The Gromov-Hausdorff space is complete. -/
 instance : complete_space GH_space :=
@@ -939,20 +949,16 @@ begin
   let X := λ n, (u n).rep,
   -- glue them together successively in an optimal way, getting a sequence of metric spaces `Y n`
   let Y := aux_gluing X,
-  letI : ∀ n, metric_space (Y n).space := λ n, (Y n).metric,
+  -- this equality is true by definition but Lean unfolds some defs in the wrong order
   have E : ∀ n : ℕ,
-    glue_space (Y n).isom (isometry_optimal_GH_injl (X n) (X n.succ)) = (Y n.succ).space :=
-    λ n, by { simp [Y, aux_gluing], refl },
+    glue_space (Y n).isom (isometry_optimal_GH_injl (X n) (X (n + 1))) = (Y (n + 1)).space :=
+    λ n, by { dsimp only [Y, aux_gluing], refl },
   let c := λ n, cast (E n),
-  have ic : ∀ n, isometry (c n) := λ n x y, rfl,
+  have ic : ∀ n, isometry (c n) := λ n x y, by { dsimp only [Y, aux_gluing], exact rfl },
   -- there is a canonical embedding of `Y n` in `Y (n+1)`, by construction
-  let f : Πn, (Y n).space → (Y n.succ).space :=
-    λ n, (c n) ∘ (to_glue_l (aux_gluing X n).isom (isometry_optimal_GH_injl (X n) (X n.succ))),
-  have I : ∀ n, isometry (f n),
-  { assume n,
-    apply isometry.comp,
-    { assume x y, refl },
-    { apply to_glue_l_isometry } },
+  let f : Π n, (Y n).space → (Y (n + 1)).space :=
+    λ n, c n ∘ to_glue_l (Y n).isom (isometry_optimal_GH_injl (X n) (X n.succ)),
+  have I : ∀ n, isometry (f n) := λ n, (ic n).comp (to_glue_l_isometry _ _),
   -- consider the inductive limit `Z0` of the `Y n`, and then its completion `Z`
   let Z0 := metric.inductive_limit I,
   let Z := uniform_space.completion Z0,
@@ -1006,11 +1012,11 @@ begin
   have : ∀ n, (X3 n).to_GH_space = u n,
   { assume n,
     rw [nonempty_compacts.to_GH_space, ← (u n).to_GH_space_rep,
-        to_GH_space_eq_to_GH_space_iff_isometric],
+        to_GH_space_eq_to_GH_space_iff_isometry_equiv],
     constructor,
-    convert (isom n).isometric_on_range.symm, },
+    convert (isom n).isometry_equiv_on_range.symm, },
   -- Finally, we have proved the convergence of `u n`
-  exact ⟨L.to_GH_space, by simpa [this] using M⟩
+  exact ⟨L.to_GH_space, by simpa only [this] using M⟩
 end
 
 end complete--section
diff --git a/src/topology/metric_space/gromov_hausdorff_realized.lean b/src/topology/metric_space/gromov_hausdorff_realized.lean
index f82894ad72d45..d4c8ea3a88b51 100644
--- a/src/topology/metric_space/gromov_hausdorff_realized.lean
+++ b/src/topology/metric_space/gromov_hausdorff_realized.lean
@@ -10,6 +10,9 @@ import topology.continuous_function.bounded
 /-!
 # The Gromov-Hausdorff distance is realized
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file, we construct of a good coupling between nonempty compact metric spaces, minimizing
 their Hausdorff distance. This construction is instrumental to study the Gromov-Hausdorff
 distance between nonempty compact metric spaces.
@@ -30,7 +33,7 @@ space structure on `X ⊕ Y`. The corresponding metric quotient is `optimal_GH_c
 -/
 
 noncomputable theory
-open_locale classical topological_space nnreal
+open_locale classical topology nnreal
 universes u v w
 
 open classical set function topological_space filter metric quotient
@@ -90,14 +93,14 @@ local attribute [instance, priority 10] inhabited_of_nonempty'
 private lemma max_var_bound : dist x y ≤ max_var X Y := calc
   dist x y ≤ diam (univ : set (X ⊕ Y)) :
     dist_le_diam_of_mem bounded_of_compact_space (mem_univ _) (mem_univ _)
-  ... = diam (inl '' (univ : set X) ∪ inr '' (univ : set Y)) :
-    by apply congr_arg; ext x y z; cases x; simp [mem_univ, mem_range_self]
-  ... ≤ diam (inl '' (univ : set X)) + dist (inl default) (inr default) +
-          diam (inr '' (univ : set Y)) :
-    diam_union (mem_image_of_mem _ (mem_univ _)) (mem_image_of_mem _ (mem_univ _))
+  ... = diam (range inl ∪ range inr : set (X ⊕ Y)) :
+    by rw [range_inl_union_range_inr]
+  ... ≤ diam (range inl : set (X ⊕ Y)) + dist (inl default) (inr default) +
+          diam (range inr : set (X ⊕ Y)) :
+    diam_union (mem_range_self _) (mem_range_self _)
   ... = diam (univ : set X) + (dist default default + 1 + dist default default) +
           diam (univ : set Y) :
-    by { rw [isometry_inl.diam_image, isometry_inr.diam_image], refl }
+    by { rw [isometry_inl.diam_range, isometry_inr.diam_range], refl }
   ... = 1 * diam (univ : set X) + 1 + 1 * diam (univ : set Y) : by simp
   ... ≤ 2 * diam (univ : set X) + 1 + 2 * diam (univ : set Y) :
   begin
@@ -244,7 +247,7 @@ begin
                ∩ (⋂x y z, {f : Cb X Y | f (x, z) ≤ f (x, y) + f (y, z)})
                ∩ (⋂x, {f : Cb X Y | f (x, x) = 0})
                ∩ (⋂x y, {f : Cb X Y | f (x, y) ≤ max_var X Y}),
-  { ext, simp only [candidates_b, candidates, mem_inter_eq, mem_Inter, mem_set_of_eq] },
+  { ext, simp only [candidates_b, candidates, mem_inter_iff, mem_Inter, mem_set_of_eq] },
   rw this,
   repeat { apply is_closed.inter _ _
        <|> apply is_closed_Inter _
@@ -258,7 +261,7 @@ begin
 end
 
 /-- Compactness of candidates (in bounded_continuous_functions) follows. -/
-private lemma compact_candidates_b : is_compact (candidates_b X Y) :=
+private lemma is_compact_candidates_b : is_compact (candidates_b X Y) :=
 begin
   refine arzela_ascoli₂ (Icc 0 (max_var X Y)) is_compact_Icc (candidates_b X Y)
   closed_candidates_b _ _,
@@ -269,7 +272,7 @@ begin
     { have : tendsto (λ (t : ℝ), 2 * (max_var X Y : ℝ) * t) (𝓝 0) (𝓝 (2 * max_var X Y * 0)) :=
         tendsto_const_nhds.mul tendsto_id,
       simpa using this },
-    { assume x y f hf,
+    { rintros x y ⟨f, hf⟩,
       exact (candidates_lipschitz hf).dist_le_mul _ _ } }
 end
 
@@ -369,12 +372,12 @@ begin
   -- (here the addition of `dist f g`) preserve infimum and supremum
   have E1 : ∀ x, (⨅ y, g (inl x, inr y)) + dist f g = ⨅ y, g (inl x, inr y) + dist f g,
   { assume x,
-    refine map_cinfi_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _ _,
+    refine monotone.map_cinfi_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
     { assume x y hx, simpa },
     { show bdd_below (range (λ (y : Y), g (inl x, inr y))),
         from ⟨cg, forall_range_iff.2(λi, Hcg _)⟩ } },
   have E2 : (⨆ x, ⨅ y, g (inl x, inr y)) + dist f g = ⨆ x, (⨅ y, g (inl x, inr y)) + dist f g,
-  { refine map_csupr_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _ _,
+  { refine monotone.map_csupr_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
     { assume x y hx, simpa },
     { simpa using HD_bound_aux1 _ 0 } },
   -- deduce the result from the above two steps
@@ -398,12 +401,12 @@ begin
   -- (here the addition of `dist f g`) preserve infimum and supremum
   have E1 : ∀ y, (⨅ x, g (inl x, inr y)) + dist f g = ⨅ x, g (inl x, inr y) + dist f g,
   { assume y,
-    refine map_cinfi_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _ _,
+    refine monotone.map_cinfi_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
     { assume x y hx, simpa },
     { show bdd_below (range (λx:X, g (inl x, inr y))),
         from ⟨cg, forall_range_iff.2 (λi, Hcg _)⟩ } },
   have E2 : (⨆ y, ⨅ x, g (inl x, inr y)) + dist f g = ⨆ y, (⨅ x, g (inl x, inr y)) + dist f g,
-  { refine map_csupr_of_continuous_at_of_monotone (continuous_at_id.add continuous_at_const) _ _,
+  { refine monotone.map_csupr_of_continuous_at (continuous_at_id.add continuous_at_const) _ _,
     { assume x y hx, simpa },
     { simpa using HD_bound_aux2 _ 0 } },
   -- deduce the result from the above two steps
@@ -428,7 +431,7 @@ variables (X : Type u) (Y : Type v) [metric_space X] [compact_space X] [nonempty
 we can finally select a candidate minimizing HD. This will be the candidate realizing the
 optimal coupling. -/
 private lemma exists_minimizer : ∃ f ∈ candidates_b X Y, ∀ g ∈ candidates_b X Y, HD f ≤ HD g :=
-compact_candidates_b.exists_forall_le candidates_b_nonempty HD_continuous.continuous_on
+is_compact_candidates_b.exists_forall_le candidates_b_nonempty HD_continuous.continuous_on
 
 private definition optimal_GH_dist : Cb X Y := classical.some (exists_minimizer X Y)
 
@@ -448,52 +451,33 @@ def premetric_optimal_GH_dist : pseudo_metric_space (X ⊕ Y) :=
   dist_comm := λx y, candidates_symm (optimal_GH_dist_mem_candidates_b X Y),
   dist_triangle := λx y z, candidates_triangle (optimal_GH_dist_mem_candidates_b X Y) }
 
-local attribute [instance] premetric_optimal_GH_dist pseudo_metric.dist_setoid
+local attribute [instance] premetric_optimal_GH_dist
 
 /-- A metric space which realizes the optimal coupling between `X` and `Y` -/
-@[derive metric_space, nolint has_inhabited_instance]
+@[derive metric_space, nolint has_nonempty_instance]
 definition optimal_GH_coupling : Type* :=
-pseudo_metric_quot (X ⊕ Y)
+@uniform_space.separation_quotient (X ⊕ Y) (premetric_optimal_GH_dist X Y).to_uniform_space
 
 /-- Injection of `X` in the optimal coupling between `X` and `Y` -/
-def optimal_GH_injl (x : X) : optimal_GH_coupling X Y := ⟦inl x⟧
+def optimal_GH_injl (x : X) : optimal_GH_coupling X Y := quotient.mk' (inl x)
 
 /-- The injection of `X` in the optimal coupling between `X` and `Y` is an isometry. -/
 lemma isometry_optimal_GH_injl : isometry (optimal_GH_injl X Y) :=
-begin
-  refine isometry_emetric_iff_metric.2 (λx y, _),
-  change dist ⟦inl x⟧ ⟦inl y⟧ = dist x y,
-  exact candidates_dist_inl (optimal_GH_dist_mem_candidates_b X Y) _ _,
-end
+isometry.of_dist_eq $ λ x y, candidates_dist_inl (optimal_GH_dist_mem_candidates_b X Y) _ _
 
 /-- Injection of `Y` in the optimal coupling between `X` and `Y` -/
-def optimal_GH_injr (y : Y) : optimal_GH_coupling X Y := ⟦inr y⟧
+def optimal_GH_injr (y : Y) : optimal_GH_coupling X Y := quotient.mk' (inr y)
 
 /-- The injection of `Y` in the optimal coupling between `X` and `Y` is an isometry. -/
 lemma isometry_optimal_GH_injr : isometry (optimal_GH_injr X Y) :=
-begin
-  refine isometry_emetric_iff_metric.2 (λx y, _),
-  change dist ⟦inr x⟧ ⟦inr y⟧ = dist x y,
-  exact candidates_dist_inr (optimal_GH_dist_mem_candidates_b X Y) _ _,
-end
+isometry.of_dist_eq $ λ x y, candidates_dist_inr (optimal_GH_dist_mem_candidates_b X Y) _ _
 
 /-- The optimal coupling between two compact spaces `X` and `Y` is still a compact space -/
 instance compact_space_optimal_GH_coupling : compact_space (optimal_GH_coupling X Y) :=
 ⟨begin
-  have : (univ : set (optimal_GH_coupling X Y)) =
-           (optimal_GH_injl X Y '' univ) ∪ (optimal_GH_injr X Y '' univ),
-  { refine subset.antisymm (λxc hxc, _) (subset_univ _),
-    rcases quotient.exists_rep xc with ⟨x, hx⟩,
-    cases x; rw ← hx,
-    { have : ⟦inl x⟧ = optimal_GH_injl X Y x := rfl,
-      rw this,
-      exact mem_union_left _ (mem_image_of_mem _ (mem_univ _)) },
-    { have : ⟦inr x⟧ = optimal_GH_injr X Y x := rfl,
-      rw this,
-      exact mem_union_right _ (mem_image_of_mem _ (mem_univ _)) } },
-  rw this,
-  exact (compact_univ.image (isometry_optimal_GH_injl X Y).continuous).union
-    (compact_univ.image (isometry_optimal_GH_injr X Y).continuous)
+  rw [← range_quotient_mk'],
+  exact is_compact_range (continuous_sum_dom.2 ⟨(isometry_optimal_GH_injl X Y).continuous,
+    (isometry_optimal_GH_injr X Y).continuous⟩)
 end⟩
 
 /-- For any candidate `f`, `HD(f)` is larger than or equal to the Hausdorff distance in the
@@ -503,42 +487,31 @@ we need. -/
 lemma Hausdorff_dist_optimal_le_HD {f} (h : f ∈ candidates_b X Y) :
   Hausdorff_dist (range (optimal_GH_injl X Y)) (range (optimal_GH_injr X Y)) ≤ HD f :=
 begin
-  refine le_trans (le_of_forall_le_of_dense (λr hr, _)) (HD_optimal_GH_dist_le X Y f h),
+  refine le_trans (le_of_forall_le_of_dense (λ r hr, _)) (HD_optimal_GH_dist_le X Y f h),
   have A : ∀ x ∈ range (optimal_GH_injl X Y), ∃ y ∈ range (optimal_GH_injr X Y), dist x y ≤ r,
-  { assume x hx,
-    rcases mem_range.1 hx with ⟨z, hz⟩,
-    rw ← hz,
+  { rintro _ ⟨z, rfl⟩,
     have I1 : (⨆ x, ⨅ y, optimal_GH_dist X Y (inl x, inr y)) < r :=
       lt_of_le_of_lt (le_max_left _ _) hr,
     have I2 : (⨅ y, optimal_GH_dist X Y (inl z, inr y)) ≤
         ⨆ x, ⨅ y, optimal_GH_dist X Y (inl x, inr y) :=
       le_cSup (by simpa using HD_bound_aux1 _ 0) (mem_range_self _),
     have I : (⨅ y, optimal_GH_dist X Y (inl z, inr y)) < r := lt_of_le_of_lt I2 I1,
-    rcases exists_lt_of_cInf_lt (range_nonempty _) I with ⟨r', r'range, hr'⟩,
-    rcases mem_range.1 r'range with ⟨z', hz'⟩,
-    existsi [optimal_GH_injr X Y z', mem_range_self _],
-    have : (optimal_GH_dist X Y) (inl z, inr z') ≤ r, by { rw hz', exact le_of_lt hr' },
-    exact this },
+    rcases exists_lt_of_cInf_lt (range_nonempty _) I with ⟨r', ⟨z', rfl⟩, hr'⟩,
+    exact ⟨optimal_GH_injr X Y z', mem_range_self _, le_of_lt hr'⟩ },
   refine Hausdorff_dist_le_of_mem_dist _ A _,
-  { rcases exists_mem_of_nonempty X with ⟨xX, _⟩,
-    have : optimal_GH_injl X Y xX ∈ range (optimal_GH_injl X Y) := mem_range_self _,
-    rcases A _ this with ⟨y, yrange, hy⟩,
+  { inhabit X,
+    rcases A _ (mem_range_self default) with ⟨y, -, hy⟩,
     exact le_trans dist_nonneg hy },
-  { assume y hy,
-    rcases mem_range.1 hy with ⟨z, hz⟩,
-    rw ← hz,
+  { rintro _ ⟨z, rfl⟩,
     have I1 : (⨆ y, ⨅ x, optimal_GH_dist X Y (inl x, inr y)) < r :=
       lt_of_le_of_lt (le_max_right _ _) hr,
     have I2 : (⨅ x, optimal_GH_dist X Y (inl x, inr z)) ≤
         ⨆ y, ⨅ x, optimal_GH_dist X Y (inl x, inr y) :=
       le_cSup (by simpa using HD_bound_aux2 _ 0) (mem_range_self _),
     have I : (⨅ x, optimal_GH_dist X Y (inl x, inr z)) < r := lt_of_le_of_lt I2 I1,
-    rcases exists_lt_of_cInf_lt (range_nonempty _) I with ⟨r', r'range, hr'⟩,
-    rcases mem_range.1 r'range with ⟨z', hz'⟩,
-    existsi [optimal_GH_injl X Y z', mem_range_self _],
-    have : (optimal_GH_dist X Y) (inl z', inr z) ≤ r, by { rw hz', exact le_of_lt hr' },
-    rw dist_comm,
-    exact this }
+    rcases exists_lt_of_cInf_lt (range_nonempty _) I with ⟨r', ⟨z', rfl⟩, hr'⟩,
+    refine ⟨optimal_GH_injl X Y z', mem_range_self _, le_of_lt _⟩,
+    rwa dist_comm }
 end
 
 end consequences
diff --git a/src/topology/metric_space/hausdorff_dimension.lean b/src/topology/metric_space/hausdorff_dimension.lean
index 59f7d7ff3dadf..fbad19511cd6d 100644
--- a/src/topology/metric_space/hausdorff_dimension.lean
+++ b/src/topology/metric_space/hausdorff_dimension.lean
@@ -3,11 +3,15 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
+import analysis.calculus.cont_diff
 import measure_theory.measure.hausdorff
 
 /-!
 # Hausdorff dimension
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Hausdorff dimension of a set `X` in an (extended) metric space is the unique number
 `dimH s : ℝ≥0∞` such that for any `d : ℝ≥0` we have
 
@@ -79,7 +83,7 @@ We use the following notation localized in `measure_theory`. It is defined in
 
 Hausdorff measure, Hausdorff dimension, dimension
 -/
-open_locale measure_theory ennreal nnreal topological_space
+open_locale measure_theory ennreal nnreal topology
 open measure_theory measure_theory.measure set topological_space finite_dimensional filter
 
 variables {ι X Y : Type*} [emetric_space X] [emetric_space Y]
@@ -176,25 +180,25 @@ begin
   exact ennreal.zero_ne_top
 end
 
-@[simp] lemma dimH_bUnion {s : set ι} (hs : countable s) (t : ι → set X) :
+@[simp] lemma dimH_bUnion {s : set ι} (hs : s.countable) (t : ι → set X) :
   dimH (⋃ i ∈ s, t i) = ⨆ i ∈ s, dimH (t i) :=
 begin
   haveI := hs.to_encodable,
   rw [bUnion_eq_Union, dimH_Union, ← supr_subtype'']
 end
 
-@[simp] lemma dimH_sUnion {S : set (set X)} (hS : countable S) : dimH (⋃₀ S) = ⨆ s ∈ S, dimH s :=
+@[simp] lemma dimH_sUnion {S : set (set X)} (hS : S.countable) : dimH (⋃₀ S) = ⨆ s ∈ S, dimH s :=
 by rw [sUnion_eq_bUnion, dimH_bUnion hS]
 
 @[simp] lemma dimH_union (s t : set X) : dimH (s ∪ t) = max (dimH s) (dimH t) :=
 by rw [union_eq_Union, dimH_Union, supr_bool_eq, cond, cond, ennreal.sup_eq_max]
 
-lemma dimH_countable {s : set X} (hs : countable s) : dimH s = 0 :=
+lemma dimH_countable {s : set X} (hs : s.countable) : dimH s = 0 :=
 bUnion_of_singleton s ▸ by simp only [dimH_bUnion hs, dimH_singleton, ennreal.supr_zero_eq_zero]
 
 alias dimH_countable ← set.countable.dimH_zero
 
-lemma dimH_finite {s : set X} (hs : finite s) : dimH s = 0 := hs.countable.dimH_zero
+lemma dimH_finite {s : set X} (hs : s.finite) : dimH s = 0 := hs.countable.dimH_zero
 
 alias dimH_finite ← set.finite.dimH_zero
 
@@ -226,7 +230,7 @@ end
 /-- In an (extended) metric space with second countable topology, the Hausdorff dimension
 of a set `s` is the supremum over `x ∈ s` of the limit superiors of `dimH t` along
 `(𝓝[s] x).small_sets`. -/
-lemma bsupr_limsup_dimH (s : set X) : (⨆ x ∈ s, limsup (𝓝[s] x).small_sets dimH) = dimH s :=
+lemma bsupr_limsup_dimH (s : set X) : (⨆ x ∈ s, limsup dimH (𝓝[s] x).small_sets) = dimH s :=
 begin
   refine le_antisymm (supr₂_le $ λ x hx, _) _,
   { refine Limsup_le_of_le (by apply_auto_param) (eventually_map.2 _),
@@ -241,7 +245,7 @@ end
 /-- In an (extended) metric space with second countable topology, the Hausdorff dimension
 of a set `s` is the supremum over all `x` of the limit superiors of `dimH t` along
 `(𝓝[s] x).small_sets`. -/
-lemma supr_limsup_dimH (s : set X) : (⨆ x, limsup (𝓝[s] x).small_sets dimH) = dimH s :=
+lemma supr_limsup_dimH (s : set X) : (⨆ x, limsup dimH (𝓝[s] x).small_sets) = dimH s :=
 begin
   refine le_antisymm (supr_le $ λ x, _) _,
   { refine Limsup_le_of_le (by apply_auto_param) (eventually_map.2 _),
@@ -345,7 +349,7 @@ lemma dimH_image_le_of_locally_lipschitz_on [second_countable_topology X] {f : X
 begin
   have : ∀ x ∈ s, ∃ (C : ℝ≥0) (t ∈ 𝓝[s] x), holder_on_with C 1 f t,
     by simpa only [holder_on_with_one] using hf,
-  simpa only [ennreal.coe_one, ennreal.div_one]
+  simpa only [ennreal.coe_one, div_one]
     using dimH_image_le_of_locally_holder_on zero_lt_one this
 end
 
@@ -387,7 +391,7 @@ end antilipschitz_with
 lemma isometry.dimH_image (hf : isometry f) (s : set X) : dimH (f '' s) = dimH s :=
 le_antisymm (hf.lipschitz.dimH_image_le _) (hf.antilipschitz.le_dimH_image _)
 
-namespace isometric
+namespace isometry_equiv
 
 @[simp] lemma dimH_image (e : X ≃ᵢ Y) (s : set X) : dimH (e '' s) = dimH s :=
 e.isometry.dimH_image s
@@ -398,12 +402,12 @@ by rw [← e.image_symm, e.symm.dimH_image]
 lemma dimH_univ (e : X ≃ᵢ Y) : dimH (univ : set X) = dimH (univ : set Y) :=
 by rw [← e.dimH_preimage univ, preimage_univ]
 
-end isometric
+end isometry_equiv
 
 namespace continuous_linear_equiv
 
-variables {𝕜 E F : Type*} [nondiscrete_normed_field 𝕜]
-  [normed_group E] [normed_space 𝕜 E] [normed_group F] [normed_space 𝕜 F]
+variables {𝕜 E F : Type*} [nontrivially_normed_field 𝕜]
+  [normed_add_comm_group E] [normed_space 𝕜 E] [normed_add_comm_group F] [normed_space 𝕜 F]
 
 @[simp] lemma dimH_image (e : E ≃L[𝕜] F) (s : set E) : dimH (e '' s) = dimH s :=
 le_antisymm (e.lipschitz.dimH_image_le s) $
@@ -423,7 +427,8 @@ end continuous_linear_equiv
 
 namespace real
 
-variables {E : Type*} [fintype ι] [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+variables {E : Type*} [fintype ι] [normed_add_comm_group E] [normed_space ℝ E]
+  [finite_dimensional ℝ E]
 
 theorem dimH_ball_pi (x : ι → ℝ) {r : ℝ} (hr : 0 < r) :
   dimH (metric.ball x r) = fintype.card ι :=
@@ -435,7 +440,7 @@ begin
     have : μH[fintype.card ι] (metric.ball x r) = ennreal.of_real ((2 * r) ^ fintype.card ι),
       by rw [hausdorff_measure_pi_real, real.volume_pi_ball _ hr],
     refine dimH_of_hausdorff_measure_ne_zero_ne_top _ _; rw [nnreal.coe_nat_cast, this],
-    { simp [pow_pos (mul_pos zero_lt_two hr)] },
+    { simp [pow_pos (mul_pos (zero_lt_two' ℝ) hr)] },
     { exact ennreal.of_real_ne_top } }
 end
 
@@ -478,12 +483,12 @@ by rw [dimH_univ_eq_finrank ℝ, finite_dimensional.finrank_self, nat.cast_one]
 end real
 
 variables {E F : Type*}
-  [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
-  [normed_group F] [normed_space ℝ F]
+  [normed_add_comm_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
+  [normed_add_comm_group F] [normed_space ℝ F]
 
 theorem dense_compl_of_dimH_lt_finrank {s : set E} (hs : dimH s < finrank ℝ E) : dense sᶜ :=
 begin
-  refine λ x, mem_closure_iff_nhds.2 (λ t ht, ne_empty_iff_nonempty.1 $ λ he, hs.not_le _),
+  refine λ x, mem_closure_iff_nhds.2 (λ t ht, nonempty_iff_ne_empty.2 $ λ he, hs.not_le _),
   rw [← diff_eq, diff_eq_empty] at he,
   rw [← real.dimH_of_mem_nhds ht],
   exact dimH_mono he
@@ -531,4 +536,4 @@ in `F`. -/
 lemma cont_diff.dense_compl_range_of_finrank_lt_finrank [finite_dimensional ℝ F] {f : E → F}
   (h : cont_diff ℝ 1 f) (hEF : finrank ℝ E < finrank ℝ F) :
   dense (range f)ᶜ :=
-dense_compl_of_dimH_lt_finrank $ h.dimH_range_le.trans_lt $ ennreal.coe_nat_lt_coe_nat.2 hEF
+dense_compl_of_dimH_lt_finrank $ h.dimH_range_le.trans_lt $ nat.cast_lt.2 hEF
diff --git a/src/topology/metric_space/hausdorff_distance.lean b/src/topology/metric_space/hausdorff_distance.lean
index f402d7a00abca..a8150266b51aa 100644
--- a/src/topology/metric_space/hausdorff_distance.lean
+++ b/src/topology/metric_space/hausdorff_distance.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import analysis.specific_limits.basic
+import topology.metric_space.isometric_smul
 import topology.metric_space.isometry
 import topology.instances.ennreal
 
 /-!
 # Hausdorff distance
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The Hausdorff distance on subsets of a metric (or emetric) space.
 
 Given two subsets `s` and `t` of a metric space, their Hausdorff distance is the smallest `d`
@@ -27,7 +31,7 @@ This files introduces:
 * `cthickening δ s`, the closed thickening by radius `δ` of a set `s` in a pseudo emetric space.
 -/
 noncomputable theory
-open_locale classical nnreal ennreal topological_space
+open_locale classical nnreal ennreal topology pointwise
 universes u v w
 
 open classical set function topological_space filter
@@ -86,6 +90,14 @@ calc (⨅ z ∈ s, edist x z) ≤ ⨅ z ∈ s, edist y z + edist x y :
 lemma inf_edist_le_edist_add_inf_edist : inf_edist x s ≤ edist x y + inf_edist y s :=
 by { rw add_comm, exact inf_edist_le_inf_edist_add_edist }
 
+lemma edist_le_inf_edist_add_ediam (hy : y ∈ s) : edist x y ≤ inf_edist x s + diam s :=
+begin
+  simp_rw [inf_edist, ennreal.infi_add],
+  refine le_infi (λ i, le_infi (λ hi, _)),
+  calc edist x y ≤ edist x i + edist i y : edist_triangle _ _ _
+  ... ≤ edist x i + diam s : add_le_add le_rfl (edist_le_diam_of_mem hi hy)
+end
+
 /-- The edist to a set depends continuously on the point -/
 @[continuity]
 lemma continuous_inf_edist : continuous (λx, inf_edist x s) :=
@@ -122,6 +134,24 @@ begin
   exact h.closure_eq
 end
 
+/-- The infimum edistance of a point to a set is positive if and only if the point is not in the
+closure of the set. -/
+lemma inf_edist_pos_iff_not_mem_closure {x : α} {E : set α} :
+  0 < inf_edist x E ↔ x ∉ closure E :=
+by rw [mem_closure_iff_inf_edist_zero, pos_iff_ne_zero]
+
+lemma inf_edist_closure_pos_iff_not_mem_closure {x : α} {E : set α} :
+  0 < inf_edist x (closure E) ↔ x ∉ closure E :=
+by rw [inf_edist_closure, inf_edist_pos_iff_not_mem_closure]
+
+lemma exists_real_pos_lt_inf_edist_of_not_mem_closure {x : α} {E : set α} (h : x ∉ closure E) :
+  ∃ (ε : ℝ), 0 < ε ∧ ennreal.of_real ε < inf_edist x E :=
+begin
+  rw [← inf_edist_pos_iff_not_mem_closure, ennreal.lt_iff_exists_real_btwn] at h,
+  rcases h with ⟨ε, ⟨_, ⟨ε_pos, ε_lt⟩⟩⟩,
+  exact ⟨ε, ⟨ennreal.of_real_pos.mp ε_pos, ε_lt⟩⟩,
+end
+
 lemma disjoint_closed_ball_of_lt_inf_edist {r : ℝ≥0∞} (h : r < inf_edist x s) :
   disjoint (closed_ball x r) s :=
 begin
@@ -138,10 +168,15 @@ lemma inf_edist_image (hΦ : isometry Φ) :
   inf_edist (Φ x) (Φ '' t) = inf_edist x t :=
 by simp only [inf_edist, infi_image, hΦ.edist_eq]
 
+@[simp, to_additive] lemma inf_edist_smul {M} [has_smul M α] [has_isometric_smul M α]
+  (c : M) (x : α) (s : set α) :
+  inf_edist (c • x) (c • s) = inf_edist x s :=
+inf_edist_image (isometry_smul _ _)
+
 lemma _root_.is_open.exists_Union_is_closed {U : set α} (hU : is_open U) :
   ∃ F : ℕ → set α, (∀ n, is_closed (F n)) ∧ (∀ n, F n ⊆ U) ∧ ((⋃ n, F n) = U) ∧ monotone F :=
 begin
-  obtain ⟨a, a_pos, a_lt_one⟩ : ∃ (a : ℝ≥0∞), 0 < a ∧ a < 1 := exists_between (ennreal.zero_lt_one),
+  obtain ⟨a, a_pos, a_lt_one⟩ : ∃ (a : ℝ≥0∞), 0 < a ∧ a < 1 := exists_between zero_lt_one,
   let F := λ (n : ℕ), (λ x, inf_edist x Uᶜ) ⁻¹' (Ici (a^n)),
   have F_subset : ∀ n, F n ⊆ U,
   { assume n x hx,
@@ -152,7 +187,7 @@ begin
   show monotone F,
   { assume m n hmn x hx,
     simp only [mem_Ici, mem_preimage] at hx ⊢,
-    apply le_trans (ennreal.pow_le_pow_of_le_one a_lt_one.le hmn) hx },
+    apply le_trans (pow_le_pow_of_le_one' a_lt_one.le hmn) hx },
   show (⋃ n, F n) = U,
   { refine subset.antisymm (by simp only [Union_subset_iff, F_subset, forall_const]) (λ x hx, _),
     have : ¬(x ∈ Uᶜ), by simpa using hx,
@@ -174,15 +209,16 @@ begin
   exact ⟨y, ys, le_antisymm (inf_edist_le_edist_of_mem ys) (by rwa le_inf_edist)⟩
 end
 
-lemma exists_pos_forall_le_edist (hs : is_compact s) (hs' : s.nonempty) (ht : is_closed t)
-  (hst : disjoint s t) :
-  ∃ r, 0 < r ∧ ∀ (x ∈ s) (y ∈ t), r ≤ edist x y :=
+lemma exists_pos_forall_lt_edist (hs : is_compact s) (ht : is_closed t) (hst : disjoint s t) :
+  ∃ r : ℝ≥0, 0 < r ∧ ∀ (x ∈ s) (y ∈ t), (r : ℝ≥0∞) < edist x y :=
 begin
+  rcases s.eq_empty_or_nonempty with rfl|hne, { use 1, simp },
   obtain ⟨x, hx, h⟩ : ∃ x ∈ s, ∀ y ∈ s, inf_edist x t ≤ inf_edist y t :=
-    hs.exists_forall_le hs' continuous_inf_edist.continuous_on,
-  refine ⟨inf_edist x t, pos_iff_ne_zero.2 $ λ H, hst ⟨hx, _⟩, λ y hy, le_inf_edist.1 $ h y hy⟩,
-  rw ←ht.closure_eq,
-  exact mem_closure_iff_inf_edist_zero.2 H,
+    hs.exists_forall_le hne continuous_inf_edist.continuous_on,
+  have : 0 < inf_edist x t,
+    from pos_iff_ne_zero.2 (λ H, hst.le_bot ⟨hx, (mem_iff_inf_edist_zero_of_closed ht).mpr H⟩),
+  rcases ennreal.lt_iff_exists_nnreal_btwn.1 this with ⟨r, h₀, hr⟩,
+  exact ⟨r, ennreal.coe_pos.mp h₀, λ y hy z hz, hr.trans_le $ le_inf_edist.1 (h y hy) z hz⟩
 end
 
 end inf_edist --section
@@ -395,6 +431,14 @@ open emetric
 /-- The minimal distance of a point to a set -/
 def inf_dist (x : α) (s : set α) : ℝ := ennreal.to_real (inf_edist x s)
 
+theorem inf_dist_eq_infi : inf_dist x s = ⨅ y : s, dist x y :=
+begin
+  rw [inf_dist, inf_edist, infi_subtype', ennreal.to_real_infi],
+  { simp only [dist_edist],
+    refl },
+  { exact λ _, edist_ne_top _ _ }
+end
+
 /-- the minimal distance is always nonnegative -/
 lemma inf_dist_nonneg : 0 ≤ inf_dist x s := by simp [inf_dist]
 
@@ -465,7 +509,7 @@ disjoint_left.2 $ λ y hy, not_mem_of_dist_lt_inf_dist $
   ... < inf_dist x s : hy
 
 lemma ball_inf_dist_subset_compl : ball x (inf_dist x s) ⊆ sᶜ :=
-disjoint_iff_subset_compl_right.1 disjoint_ball_inf_dist
+disjoint_ball_inf_dist.subset_compl_right
 
 lemma ball_inf_dist_compl_subset : ball x (inf_dist x sᶜ) ⊆ s :=
 ball_inf_dist_subset_compl.trans (compl_compl s).subset
@@ -474,6 +518,17 @@ lemma disjoint_closed_ball_of_lt_inf_dist {r : ℝ} (h : r < inf_dist x s) :
   disjoint (closed_ball x r) s :=
 disjoint_ball_inf_dist.mono_left $ closed_ball_subset_ball h
 
+lemma dist_le_inf_dist_add_diam (hs : bounded s) (hy : y ∈ s) : dist x y ≤ inf_dist x s + diam s :=
+begin
+  have A : inf_edist x s ≠ ∞, from inf_edist_ne_top ⟨y, hy⟩,
+  have B : emetric.diam s ≠ ∞, from hs.ediam_ne_top,
+  rw [inf_dist, diam, ← ennreal.to_real_add A B, dist_edist],
+  apply (ennreal.to_real_le_to_real _ _).2,
+  { exact edist_le_inf_edist_add_ediam hy },
+  { rw edist_dist, exact ennreal.of_real_ne_top },
+  { exact ennreal.add_ne_top.2 ⟨A, B⟩ }
+end
+
 variable (s)
 
 /-- The minimal distance to a set is Lipschitz in point with constant 1 -/
@@ -845,6 +900,23 @@ lemma mem_thickening_iff_exists_edist_lt {δ : ℝ} (E : set α) (x : α) :
   x ∈ thickening δ E ↔ ∃ z ∈ E, edist x z < ennreal.of_real δ :=
 inf_edist_lt_iff
 
+/-- The frontier of the (open) thickening of a set is contained in an `inf_edist` level set. -/
+lemma frontier_thickening_subset (E : set α) {δ : ℝ} :
+  frontier (thickening δ E) ⊆ {x : α | inf_edist x E = ennreal.of_real δ} :=
+frontier_lt_subset_eq continuous_inf_edist continuous_const
+
+lemma frontier_thickening_disjoint (A : set α) :
+  pairwise (disjoint on (λ (r : ℝ), frontier (thickening r A))) :=
+begin
+  refine (pairwise_disjoint_on _).2 (λ r₁ r₂ hr, _),
+  cases le_total r₁ 0 with h₁ h₁,
+  { simp [thickening_of_nonpos h₁] },
+  refine ((disjoint_singleton.2 $ λ h, hr.ne _).preimage _).mono
+    (frontier_thickening_subset _) (frontier_thickening_subset _),
+  apply_fun ennreal.to_real at h,
+  rwa [ennreal.to_real_of_real h₁, ennreal.to_real_of_real (h₁.trans hr.le)] at h
+end
+
 variables {X : Type u} [pseudo_metric_space X]
 
 /-- A point in a metric space belongs to the (open) `δ`-thickening of a subset `E` if and only if
@@ -866,6 +938,9 @@ end
   thickening δ ({x} : set X) = ball x δ :=
 by { ext, simp [mem_thickening_iff] }
 
+lemma ball_subset_thickening {x : X} {E : set X} (hx : x ∈ E) (δ : ℝ) : ball x δ ⊆ thickening δ E :=
+subset.trans (by simp) (thickening_subset_of_subset δ $ singleton_subset_iff.mpr hx)
+
 /-- The (open) `δ`-thickening `thickening δ E` of a subset `E` in a metric space equals the
 union of balls of radius `δ` centered at points of `E`. -/
 lemma thickening_eq_bUnion_ball {δ : ℝ} {E : set X} :
@@ -932,6 +1007,9 @@ by { ext x, simp [mem_closure_iff_inf_edist_zero, cthickening, ennreal.of_real_e
 @[simp] lemma cthickening_zero (E : set α) : cthickening 0 E = closure E :=
 cthickening_of_nonpos le_rfl E
 
+lemma cthickening_max_zero (δ : ℝ) (E : set α) : cthickening (max 0 δ) E = cthickening δ E :=
+by cases le_total δ 0; simp [cthickening_of_nonpos, *]
+
 /-- The closed thickening `cthickening δ E` of a fixed subset `E` is an increasing function of
 the thickening radius `δ`. -/
 lemma cthickening_mono {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
@@ -989,7 +1067,7 @@ end
 
 lemma thickening_subset_interior_cthickening (δ : ℝ) (E : set α) :
   thickening δ E ⊆ interior (cthickening δ E) :=
-(subset_interior_iff_open.mpr (is_open_thickening)).trans
+(subset_interior_iff_is_open.mpr (is_open_thickening)).trans
   (interior_mono (thickening_subset_cthickening δ E))
 
 lemma closure_thickening_subset_cthickening (δ : ℝ) (E : set α) :
@@ -1016,6 +1094,12 @@ lemma self_subset_cthickening {δ : ℝ} (E : set α) :
   E ⊆ cthickening δ E :=
 subset_closure.trans (closure_subset_cthickening δ E)
 
+lemma thickening_mem_nhds_set (E : set α) {δ : ℝ} (hδ : 0 < δ) : thickening δ E ∈ 𝓝ˢ E :=
+is_open_thickening.mem_nhds_set.2 $ self_subset_thickening hδ E
+
+lemma cthickening_mem_nhds_set (E : set α) {δ : ℝ} (hδ : 0 < δ) : cthickening δ E ∈ 𝓝ˢ E :=
+mem_of_superset (thickening_mem_nhds_set E hδ) (thickening_subset_cthickening _ _)
+
 @[simp] lemma thickening_union (δ : ℝ) (s t : set α) :
   thickening δ (s ∪ t) = thickening δ s ∪ thickening δ t :=
 by simp_rw [thickening, inf_edist_union, inf_eq_min, min_lt_iff, set_of_or]
@@ -1028,6 +1112,55 @@ by simp_rw [cthickening, inf_edist_union, inf_eq_min, min_le_iff, set_of_or]
   thickening δ (⋃ i, f i) = ⋃ i, thickening δ (f i) :=
 by simp_rw [thickening, inf_edist_Union, infi_lt_iff, set_of_exists]
 
+lemma ediam_cthickening_le (ε : ℝ≥0) : emetric.diam (cthickening ε s) ≤ emetric.diam s + 2 * ε :=
+begin
+  refine diam_le (λ x hx y hy, ennreal.le_of_forall_pos_le_add $ λ δ hδ _, _),
+  rw [mem_cthickening_iff, ennreal.of_real_coe_nnreal] at hx hy,
+  have hε : (ε : ℝ≥0∞) < ε + ↑(δ / 2) :=
+    ennreal.coe_lt_coe.2 (lt_add_of_pos_right _ $ half_pos hδ),
+  rw [ennreal.coe_div two_ne_zero, ennreal.coe_two] at hε,
+  replace hx := hx.trans_lt hε,
+  replace hy := hy.trans_lt hε,
+  rw inf_edist_lt_iff at hx hy,
+  obtain ⟨x', hx', hxx'⟩ := hx,
+  obtain ⟨y', hy', hyy'⟩ := hy,
+  refine (edist_triangle_right _ _ _).trans ((add_le_add hxx'.le $ (edist_triangle _ _ _).trans $
+    add_le_add hyy'.le $ edist_le_diam_of_mem hy' hx').trans_eq _),
+  -- Now we're done, but `ring` won't do it because we're on `ennreal` :(
+  rw [←add_assoc, ←two_mul, mul_add,
+    ennreal.mul_div_cancel' two_ne_zero ennreal.two_ne_top],
+  abel,
+end
+
+lemma ediam_thickening_le (ε : ℝ≥0) : emetric.diam (thickening ε s) ≤ emetric.diam s + 2 * ε :=
+(emetric.diam_mono $ thickening_subset_cthickening _ _).trans $ ediam_cthickening_le _
+
+lemma diam_cthickening_le {α : Type*} [pseudo_metric_space α] (s : set α) (hε : 0 ≤ ε) :
+  diam (cthickening ε s) ≤ diam s + 2 * ε :=
+begin
+  by_cases hs : bounded (cthickening ε s),
+  { replace hs := hs.mono (self_subset_cthickening _),
+    lift ε to ℝ≥0 using hε,
+    have : (2 : ℝ≥0∞) * ε ≠ ⊤ := by simp [ennreal.mul_eq_top],
+    refine (ennreal.to_real_mono (ennreal.add_ne_top.2 ⟨hs.ediam_ne_top, this⟩) $
+      ediam_cthickening_le ε).trans_eq _,
+    simp [ennreal.to_real_add hs.ediam_ne_top this, diam] },
+  { rw diam_eq_zero_of_unbounded hs,
+    positivity }
+end
+
+lemma diam_thickening_le {α : Type*} [pseudo_metric_space α] (s : set α) (hε : 0 ≤ ε) :
+  diam (thickening ε s) ≤ diam s + 2 * ε :=
+begin
+  by_cases hs : bounded s,
+  { exact (diam_mono (thickening_subset_cthickening _ _) hs.cthickening).trans
+      (diam_cthickening_le _ hε) },
+  obtain rfl | hε := hε.eq_or_lt,
+  { simp [thickening_of_nonpos, diam_nonneg] },
+  { rw diam_eq_zero_of_unbounded (mt (bounded.mono $ self_subset_thickening hε _) hs),
+    positivity }
+end
+
 @[simp] lemma thickening_closure : thickening δ (closure s) = thickening δ s :=
 by simp_rw [thickening, inf_edist_closure]
 
@@ -1040,20 +1173,18 @@ lemma _root_.disjoint.exists_thickenings (hst : disjoint s t) (hs : is_compact s
   (ht : is_closed t) :
   ∃ δ, 0 < δ ∧ disjoint (thickening δ s) (thickening δ t) :=
 begin
-  obtain rfl | hs' := s.eq_empty_or_nonempty,
-  { simp_rw thickening_empty,
-    exact ⟨1, zero_lt_one, empty_disjoint _⟩ },
-  obtain ⟨r, hr, h⟩ := exists_pos_forall_le_edist hs hs' ht hst,
-  refine ⟨(min 1 (r/2)).to_real, to_real_pos (lt_min ennreal.zero_lt_one $ half_pos hr.ne').ne'
-    (min_lt_of_left_lt one_lt_top).ne, _⟩,
+  obtain ⟨r, hr, h⟩ := exists_pos_forall_lt_edist hs ht hst,
+  refine ⟨r / 2, half_pos (nnreal.coe_pos.2 hr), _⟩,
+  rw disjoint_iff_inf_le,
   rintro z ⟨hzs, hzt⟩,
   rw mem_thickening_iff_exists_edist_lt at hzs hzt,
+  rw [← nnreal.coe_two, ← nnreal.coe_div, ennreal.of_real_coe_nnreal] at hzs hzt,
   obtain ⟨x, hx, hzx⟩ := hzs,
   obtain ⟨y, hy, hzy⟩ := hzt,
-  refine (((h _ hx _ hy).trans $ edist_triangle_left _ _ _).trans_lt $
-    ennreal.add_lt_add hzx hzy).not_le _,
-  rw ←two_mul,
-  exact ennreal.mul_le_of_le_div' (of_real_to_real_le.trans $ min_le_right _ _),
+  refine (h x hx y hy).not_le _,
+  calc edist x y ≤ edist z x + edist z y : edist_triangle_left _ _ _
+  ... ≤ ↑(r / 2) + ↑(r / 2) : add_le_add hzx.le hzy.le
+  ... = r : by rw [← ennreal.coe_add, add_halves]
 end
 
 lemma _root_.disjoint.exists_cthickenings (hst : disjoint s t) (hs : is_compact s)
@@ -1065,6 +1196,28 @@ begin
     exact (cthickening_subset_thickening' hδ (half_lt_self hδ) _),
 end
 
+lemma _root_.is_compact.exists_cthickening_subset_open (hs : is_compact s) (ht : is_open t)
+  (hst : s ⊆ t) :
+  ∃ δ, 0 < δ ∧ cthickening δ s ⊆ t :=
+(hst.disjoint_compl_right.exists_cthickenings hs ht.is_closed_compl).imp $ λ δ h,
+  ⟨h.1, disjoint_compl_right_iff_subset.1 $ h.2.mono_right $ self_subset_cthickening _⟩
+
+lemma _root_.is_compact.exists_thickening_subset_open (hs : is_compact s) (ht : is_open t)
+  (hst : s ⊆ t) :
+  ∃ δ, 0 < δ ∧ thickening δ s ⊆ t :=
+let ⟨δ, h₀, hδ⟩ := hs.exists_cthickening_subset_open ht hst
+  in ⟨δ, h₀, (thickening_subset_cthickening _ _).trans hδ⟩
+
+lemma has_basis_nhds_set_thickening {K : set α} (hK : is_compact K) :
+  (𝓝ˢ K).has_basis (λ δ : ℝ, 0 < δ) (λ δ, thickening δ K) :=
+(has_basis_nhds_set K).to_has_basis' (λ U hU, hK.exists_thickening_subset_open hU.1 hU.2) $
+  λ _, thickening_mem_nhds_set K
+
+lemma has_basis_nhds_set_cthickening {K : set α} (hK : is_compact K) :
+  (𝓝ˢ K).has_basis (λ δ : ℝ, 0 < δ) (λ δ, cthickening δ K) :=
+(has_basis_nhds_set K).to_has_basis' (λ U hU, hK.exists_cthickening_subset_open hU.1 hU.2) $
+  λ _, cthickening_mem_nhds_set K
+
 lemma cthickening_eq_Inter_cthickening' {δ : ℝ}
   (s : set ℝ) (hsδ : s ⊆ Ioi δ) (hs : ∀ ε, δ < ε → (s ∩ (Ioc δ ε)).nonempty) (E : set α) :
   cthickening δ E = ⋂ ε ∈ s, cthickening ε E :=
@@ -1110,6 +1263,10 @@ begin
   exact λ _ hε, nonempty_Ioc.mpr hε,
 end
 
+lemma cthickening_eq_Inter_thickening'' (δ : ℝ) (E : set α) :
+  cthickening δ E = ⋂ (ε : ℝ) (h : max 0 δ < ε), thickening ε E :=
+by { rw [←cthickening_max_zero, cthickening_eq_Inter_thickening], exact le_max_left _ _ }
+
 /-- The closure of a set equals the intersection of its closed thickenings of positive radii
 accumulating at zero. -/
 lemma closure_eq_Inter_cthickening' (E : set α)
@@ -1143,29 +1300,10 @@ lemma closure_eq_Inter_thickening (E : set α) :
   closure E = ⋂ (δ : ℝ) (h : 0 < δ), thickening δ E :=
 by { rw ← cthickening_zero, exact cthickening_eq_Inter_thickening rfl.ge E, }
 
-/-- The frontier of the (open) thickening of a set is contained in an `inf_edist` level set. -/
-lemma frontier_thickening_subset (E : set α) {δ : ℝ} (δ_pos : 0 < δ) :
-  frontier (thickening δ E) ⊆ {x : α | inf_edist x E = ennreal.of_real δ} :=
-begin
-  have singleton_preim :
-    {x : α | inf_edist x E = ennreal.of_real δ } = (λ x , inf_edist x E) ⁻¹' {ennreal.of_real δ},
-  { simp only [preimage, mem_singleton_iff] },
-  rw [thickening_eq_preimage_inf_edist, singleton_preim,
-      ← (frontier_Iio' ⟨(0 : ℝ≥0∞), ennreal.of_real_pos.mpr δ_pos⟩)],
-  exact continuous_inf_edist.frontier_preimage_subset (Iio (ennreal.of_real δ)),
-end
-
 /-- The frontier of the closed thickening of a set is contained in an `inf_edist` level set. -/
 lemma frontier_cthickening_subset (E : set α) {δ : ℝ} :
   frontier (cthickening δ E) ⊆ {x : α | inf_edist x E = ennreal.of_real δ} :=
-begin
-  have singleton_preim :
-    {x : α | inf_edist x E = ennreal.of_real δ } = (λ x , inf_edist x E) ⁻¹' {ennreal.of_real δ},
-  { simp only [preimage, mem_singleton_iff] },
-  rw [cthickening_eq_preimage_inf_edist, singleton_preim,
-      ← frontier_Iic' ⟨∞, ennreal.of_real_lt_top⟩],
-  exact continuous_inf_edist.frontier_preimage_subset (Iic (ennreal.of_real δ)),
-end
+frontier_le_subset_eq continuous_inf_edist continuous_const
 
 /-- The closed ball of radius `δ` centered at a point of `E` is included in the closed
 thickening of `E`. -/
@@ -1177,8 +1315,19 @@ begin
   simpa using hx,
 end
 
+lemma cthickening_subset_Union_closed_ball_of_lt
+  {α : Type*} [pseudo_metric_space α] (E : set α) {δ δ' : ℝ} (hδ₀ : 0 < δ') (hδδ' : δ < δ') :
+  cthickening δ E ⊆ ⋃ x ∈ E, closed_ball x δ' :=
+begin
+  refine (cthickening_subset_thickening' hδ₀ hδδ' E).trans (λ x hx, _),
+  obtain ⟨y, hy₁, hy₂⟩ := mem_thickening_iff.mp hx,
+  exact mem_Union₂.mpr ⟨y, hy₁, hy₂.le⟩,
+end
+
 /-- The closed thickening of a compact set `E` is the union of the balls `closed_ball x δ` over
-`x ∈ E`. -/
+`x ∈ E`.
+
+See also `metric.cthickening_eq_bUnion_closed_ball`. -/
 lemma _root_.is_compact.cthickening_eq_bUnion_closed_ball
   {α : Type*} [pseudo_metric_space α] {δ : ℝ} {E : set α} (hE : is_compact E) (hδ : 0 ≤ δ) :
   cthickening δ E = ⋃ x ∈ E, closed_ball x δ :=
@@ -1186,7 +1335,7 @@ begin
   rcases eq_empty_or_nonempty E with rfl|hne,
   { simp only [cthickening_empty, Union_false, Union_empty] },
   refine subset.antisymm (λ x hx, _) (Union₂_subset $ λ x hx, closed_ball_subset_cthickening hx _),
-  obtain ⟨y, yE, hy⟩ : ∃ y ∈ E, emetric.inf_edist x E = edist x y :=
+  obtain ⟨y, yE, hy⟩ : ∃ y ∈ E, inf_edist x E = edist x y :=
     hE.exists_inf_edist_eq_edist hne _,
   have D1 : edist x y ≤ ennreal.of_real δ := (le_of_eq hy.symm).trans hx,
   have D2 : dist x y ≤ δ,
@@ -1195,6 +1344,26 @@ begin
   exact mem_bUnion yE D2,
 end
 
+lemma cthickening_eq_bUnion_closed_ball
+  {α : Type*} [pseudo_metric_space α] [proper_space α] (E : set α) (hδ : 0 ≤ δ) :
+  cthickening δ E = ⋃ x ∈ closure E, closed_ball x δ :=
+begin
+  rcases eq_empty_or_nonempty E with rfl|hne,
+  { simp only [cthickening_empty, Union_false, Union_empty, closure_empty], },
+  rw ← cthickening_closure,
+  refine subset.antisymm (λ x hx, _) (Union₂_subset $ λ x hx, closed_ball_subset_cthickening hx _),
+  obtain ⟨y, yE, hy⟩ : ∃ y ∈ closure E, inf_dist x (closure E) = dist x y :=
+    is_closed_closure.exists_inf_dist_eq_dist (closure_nonempty_iff.mpr hne) x,
+  replace hy : dist x y ≤ δ := (ennreal.of_real_le_of_real_iff hδ).mp
+    (((congr_arg ennreal.of_real hy.symm).le.trans ennreal.of_real_to_real_le).trans hx),
+  exact mem_bUnion yE hy,
+end
+
+lemma _root_.is_closed.cthickening_eq_bUnion_closed_ball
+  {α : Type*} [pseudo_metric_space α] [proper_space α] {E : set α} (hE : is_closed E) (hδ : 0 ≤ δ) :
+  cthickening δ E = ⋃ x ∈ E, closed_ball x δ :=
+by rw [cthickening_eq_bUnion_closed_ball E hδ, hE.closure_eq]
+
 /-- For the equality, see `inf_edist_cthickening`. -/
 lemma inf_edist_le_inf_edist_cthickening_add :
   inf_edist x s ≤ inf_edist x (cthickening δ s) + ennreal.of_real δ :=
@@ -1260,6 +1429,11 @@ begin
   exact λ hx, inf_edist_le_inf_edist_cthickening_add.trans (add_le_add_right hx _),
 end
 
+lemma frontier_cthickening_disjoint (A : set α) :
+  pairwise (disjoint on (λ (r : ℝ≥0), frontier (cthickening r A))) :=
+λ r₁ r₂ hr, ((disjoint_singleton.2 $ by simpa).preimage _).mono (frontier_cthickening_subset _)
+  (frontier_cthickening_subset _)
+
 end cthickening --section
 
 end metric --namespace
diff --git a/src/topology/metric_space/holder.lean b/src/topology/metric_space/holder.lean
index 6a4e9cb72c388..ab2bd573e5f5c 100644
--- a/src/topology/metric_space/holder.lean
+++ b/src/topology/metric_space/holder.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
 import topology.metric_space.lipschitz
-import analysis.special_functions.pow
+import analysis.special_functions.pow.continuity
 
 /-!
 # Hölder continuous functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define Hölder continuity on a set and on the whole space. We also prove some basic
 properties of Hölder continuous functions.
 
@@ -35,7 +38,7 @@ Hölder continuity, Lipschitz continuity
 variables {X Y Z : Type*}
 
 open filter set
-open_locale nnreal ennreal topological_space
+open_locale nnreal ennreal topology
 
 section emetric
 
diff --git a/src/topology/metric_space/infsep.lean b/src/topology/metric_space/infsep.lean
new file mode 100644
index 0000000000000..6d0a3bd0df288
--- /dev/null
+++ b/src/topology/metric_space/infsep.lean
@@ -0,0 +1,481 @@
+/-
+Copyright (c) 2022 Wrenna Robson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Wrenna Robson
+-/
+import topology.metric_space.basic
+
+/-!
+# Infimum separation
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the extended infimum separation of a set. This is approximately dual to the
+diameter of a set, but where the extended diameter of a set is the supremum of the extended distance
+between elements of the set, the extended infimum separation is the infimum of the (extended)
+distance between *distinct* elements in the set.
+
+We also define the infimum separation as the cast of the extended infimum separation to the reals.
+This is the infimum of the distance between distinct elements of the set when in a pseudometric
+space.
+
+All lemmas and definitions are in the `set` namespace to give access to dot notation.
+
+## Main definitions
+* `set.einfsep`: Extended infimum separation of a set.
+* `set.infsep`: Infimum separation of a set (when in a pseudometric space).
+
+!-/
+
+variables {α β : Type*}
+
+namespace set
+
+section einfsep
+open_locale ennreal
+open function
+
+/-- The "extended infimum separation" of a set with an edist function. -/
+noncomputable def einfsep [has_edist α] (s : set α) : ℝ≥0∞ :=
+⨅ (x ∈ s) (y ∈ s) (hxy : x ≠ y), edist x y
+
+section has_edist
+variables [has_edist α] {x y : α} {s t : set α}
+
+lemma le_einfsep_iff {d} : d ≤ s.einfsep ↔ ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ edist x y :=
+by simp_rw [einfsep, le_infi_iff]
+
+theorem einfsep_zero :
+  s.einfsep = 0 ↔ ∀ C (hC : 0 < C), ∃ (x y ∈ s) (hxy : x ≠ y), edist x y < C :=
+by simp_rw [einfsep, ← bot_eq_zero, infi_eq_bot, infi_lt_iff]
+
+theorem einfsep_pos :
+  0 < s.einfsep ↔ ∃ C (hC : 0 < C), ∀ (x y ∈ s) (hxy : x ≠ y), C ≤ edist x y :=
+by { rw [pos_iff_ne_zero, ne.def, einfsep_zero], simp only [not_forall, not_exists, not_lt] }
+
+lemma einfsep_top : s.einfsep = ∞ ↔ ∀ (x y ∈ s) (hxy : x ≠ y), edist x y = ∞ :=
+by simp_rw [einfsep, infi_eq_top]
+
+lemma einfsep_lt_top : s.einfsep < ∞ ↔ ∃ (x y ∈ s) (hxy : x ≠ y), edist x y < ∞ :=
+by simp_rw [einfsep, infi_lt_iff]
+
+lemma einfsep_ne_top : s.einfsep ≠ ∞ ↔ ∃ (x y ∈ s) (hxy : x ≠ y), edist x y ≠ ∞ :=
+by simp_rw [←lt_top_iff_ne_top, einfsep_lt_top]
+
+lemma einfsep_lt_iff {d} : s.einfsep < d ↔ ∃ (x y ∈ s) (h : x ≠ y), edist x y < d :=
+by simp_rw [einfsep, infi_lt_iff]
+
+lemma nontrivial_of_einfsep_lt_top (hs : s.einfsep < ∞) : s.nontrivial :=
+by { rcases einfsep_lt_top.1 hs with ⟨_, hx, _, hy, hxy, _⟩, exact ⟨_, hx, _, hy, hxy⟩ }
+
+lemma nontrivial_of_einfsep_ne_top (hs : s.einfsep ≠ ∞) : s.nontrivial :=
+nontrivial_of_einfsep_lt_top (lt_top_iff_ne_top.mpr hs)
+
+lemma subsingleton.einfsep (hs : s.subsingleton) : s.einfsep = ∞ :=
+by { rw einfsep_top, exact λ _ hx _ hy hxy, (hxy $ hs hx hy).elim }
+
+lemma le_einfsep_image_iff {d} {f : β → α} {s : set β} :
+  d ≤ einfsep (f '' s) ↔ ∀ x y ∈ s, f x ≠ f y → d ≤ edist (f x) (f y) :=
+by simp_rw [le_einfsep_iff, ball_image_iff]
+
+lemma le_edist_of_le_einfsep {d x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y)
+  (hd : d ≤ s.einfsep) : d ≤ edist x y := le_einfsep_iff.1 hd x hx y hy hxy
+
+lemma einfsep_le_edist_of_mem {x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y) :
+  s.einfsep ≤ edist x y := le_edist_of_le_einfsep hx hy hxy le_rfl
+
+lemma einfsep_le_of_mem_of_edist_le {d x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y)
+  (hxy' : edist x y ≤ d) : s.einfsep ≤ d := le_trans (einfsep_le_edist_of_mem hx hy hxy) hxy'
+
+lemma le_einfsep {d} (h : ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ edist x y) :
+  d ≤ s.einfsep := le_einfsep_iff.2 h
+
+@[simp] lemma einfsep_empty : (∅ : set α).einfsep = ∞ := subsingleton_empty.einfsep
+
+@[simp] lemma einfsep_singleton : ({x} : set α).einfsep = ∞ := subsingleton_singleton.einfsep
+
+lemma einfsep_Union_mem_option {ι : Type*} (o : option ι) (s : ι → set α) :
+  (⋃ i ∈ o, s i).einfsep = ⨅ i ∈ o, (s i).einfsep := by cases o; simp
+
+lemma einfsep_anti (hst : s ⊆ t) : t.einfsep ≤ s.einfsep :=
+le_einfsep $ λ x hx y hy, einfsep_le_edist_of_mem (hst hx) (hst hy)
+
+lemma einfsep_insert_le : (insert x s).einfsep ≤ ⨅ (y ∈ s) (hxy : x ≠ y), edist x y :=
+begin
+  simp_rw le_infi_iff,
+  refine λ _ hy hxy, einfsep_le_edist_of_mem (mem_insert _ _) (mem_insert_of_mem _ hy) hxy
+end
+
+lemma le_einfsep_pair : edist x y ⊓ edist y x ≤ ({x, y} : set α).einfsep :=
+begin
+  simp_rw [le_einfsep_iff, inf_le_iff, mem_insert_iff, mem_singleton_iff],
+  rintros a (rfl | rfl) b (rfl | rfl) hab; finish
+end
+
+lemma einfsep_pair_le_left (hxy : x ≠ y) : ({x, y} : set α).einfsep ≤ edist x y :=
+einfsep_le_edist_of_mem (mem_insert _ _) (mem_insert_of_mem _ (mem_singleton _)) hxy
+
+lemma einfsep_pair_le_right (hxy : x ≠ y) : ({x, y} : set α).einfsep ≤ edist y x :=
+by rw pair_comm; exact einfsep_pair_le_left hxy.symm
+
+lemma einfsep_pair_eq_inf (hxy : x ≠ y) : ({x, y} : set α).einfsep = (edist x y) ⊓ (edist y x) :=
+le_antisymm (le_inf (einfsep_pair_le_left hxy) (einfsep_pair_le_right hxy)) le_einfsep_pair
+
+lemma einfsep_eq_infi : s.einfsep = ⨅ d : s.off_diag, (uncurry edist) (d : α × α) :=
+begin
+  refine eq_of_forall_le_iff (λ _, _),
+  simp_rw [le_einfsep_iff, le_infi_iff, imp_forall_iff, set_coe.forall, subtype.coe_mk,
+          mem_off_diag, prod.forall, uncurry_apply_pair, and_imp]
+end
+
+lemma einfsep_of_fintype [decidable_eq α] [fintype s] :
+  s.einfsep = s.off_diag.to_finset.inf (uncurry edist) :=
+begin
+  refine eq_of_forall_le_iff (λ _, _),
+  simp_rw [le_einfsep_iff, imp_forall_iff, finset.le_inf_iff, mem_to_finset, mem_off_diag,
+          prod.forall, uncurry_apply_pair, and_imp]
+end
+
+lemma finite.einfsep (hs : s.finite) :
+  s.einfsep = hs.off_diag.to_finset.inf (uncurry edist) :=
+begin
+  refine eq_of_forall_le_iff (λ _, _),
+  simp_rw [le_einfsep_iff, imp_forall_iff, finset.le_inf_iff, finite.mem_to_finset, mem_off_diag,
+          prod.forall, uncurry_apply_pair, and_imp]
+end
+
+lemma finset.coe_einfsep [decidable_eq α] {s : finset α} :
+  (s : set α).einfsep = s.off_diag.inf (uncurry edist) :=
+by simp_rw [einfsep_of_fintype, ← finset.coe_off_diag, finset.to_finset_coe]
+
+lemma nontrivial.einfsep_exists_of_finite [finite s] (hs : s.nontrivial) :
+  ∃ (x y ∈ s) (hxy : x ≠ y), s.einfsep = edist x y :=
+begin
+  classical,
+  casesI nonempty_fintype s,
+  simp_rw einfsep_of_fintype,
+  rcases @finset.exists_mem_eq_inf _ _ _ _ (s.off_diag.to_finset) (by simpa) (uncurry edist)
+    with ⟨_, hxy, hed⟩,
+  simp_rw mem_to_finset at hxy,
+  refine ⟨w.fst, hxy.1, w.snd, hxy.2.1, hxy.2.2, hed⟩
+end
+
+lemma finite.einfsep_exists_of_nontrivial (hsf : s.finite) (hs : s.nontrivial) :
+  ∃ (x y ∈ s) (hxy : x ≠ y), s.einfsep = edist x y :=
+by { letI := hsf.fintype, exact hs.einfsep_exists_of_finite }
+
+end has_edist
+
+section pseudo_emetric_space
+variables [pseudo_emetric_space α] {x y z : α} {s t : set α}
+
+lemma einfsep_pair (hxy : x ≠ y) : ({x, y} : set α).einfsep = edist x y :=
+begin
+  nth_rewrite 0 [← min_self (edist x y)],
+  convert einfsep_pair_eq_inf hxy using 2,
+  rw edist_comm
+end
+
+lemma einfsep_insert :
+  einfsep (insert x s) = (⨅ (y ∈ s) (hxy : x ≠ y), edist x y) ⊓ (s.einfsep) :=
+begin
+  refine le_antisymm (le_min einfsep_insert_le (einfsep_anti (subset_insert _ _))) _,
+  simp_rw [le_einfsep_iff, inf_le_iff, mem_insert_iff],
+  rintros y (rfl | hy) z (rfl | hz) hyz,
+  { exact false.elim (hyz rfl) },
+  { exact or.inl (infi_le_of_le _ (infi₂_le hz hyz)) },
+  { rw edist_comm, exact or.inl (infi_le_of_le _ (infi₂_le hy hyz.symm)) },
+  { exact or.inr (einfsep_le_edist_of_mem hy hz hyz) }
+end
+
+lemma einfsep_triple (hxy : x ≠ y) (hyz : y ≠ z) (hxz : x ≠ z) :
+  einfsep ({x, y, z} : set α) = edist x y ⊓ edist x z ⊓ edist y z :=
+by simp_rw [einfsep_insert, infi_insert, infi_singleton, einfsep_singleton,
+            inf_top_eq, cinfi_pos hxy, cinfi_pos hyz, cinfi_pos hxz]
+
+lemma le_einfsep_pi_of_le {π : β → Type*} [fintype β] [∀ b, pseudo_emetric_space (π b)]
+  {s : Π (b : β), set (π b)} {c : ℝ≥0∞} (h : ∀ b, c ≤ einfsep (s b) ) :
+  c ≤ einfsep (set.pi univ s) :=
+begin
+  refine le_einfsep (λ x hx y hy hxy, _),
+  rw mem_univ_pi at hx hy,
+  rcases function.ne_iff.mp hxy with ⟨i, hi⟩,
+  exact le_trans (le_einfsep_iff.1 (h i) _ (hx _) _ (hy _) hi) (edist_le_pi_edist _ _ i)
+end
+
+end pseudo_emetric_space
+
+section pseudo_metric_space
+variables [pseudo_metric_space α] {s : set α}
+
+theorem subsingleton_of_einfsep_eq_top (hs : s.einfsep = ∞) : s.subsingleton :=
+begin
+  rw einfsep_top at hs,
+  exact λ _ hx _ hy, of_not_not (λ hxy, edist_ne_top _ _ (hs _ hx _ hy hxy))
+end
+
+theorem einfsep_eq_top_iff : s.einfsep = ∞ ↔ s.subsingleton :=
+⟨subsingleton_of_einfsep_eq_top, subsingleton.einfsep⟩
+
+theorem nontrivial.einfsep_ne_top (hs : s.nontrivial) : s.einfsep ≠ ∞ :=
+by { contrapose! hs, rw not_nontrivial_iff, exact subsingleton_of_einfsep_eq_top hs }
+
+theorem nontrivial.einfsep_lt_top (hs : s.nontrivial) : s.einfsep < ∞ :=
+by { rw lt_top_iff_ne_top, exact hs.einfsep_ne_top }
+
+theorem einfsep_lt_top_iff : s.einfsep < ∞ ↔ s.nontrivial :=
+⟨nontrivial_of_einfsep_lt_top, nontrivial.einfsep_lt_top⟩
+
+theorem einfsep_ne_top_iff : s.einfsep ≠ ∞ ↔ s.nontrivial :=
+⟨nontrivial_of_einfsep_ne_top, nontrivial.einfsep_ne_top⟩
+
+lemma le_einfsep_of_forall_dist_le {d} (h : ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ dist x y) :
+  ennreal.of_real d ≤ s.einfsep :=
+le_einfsep $
+λ x hx y hy hxy, (edist_dist x y).symm ▸ ennreal.of_real_le_of_real (h x hx y hy hxy)
+
+end pseudo_metric_space
+
+section emetric_space
+variables [emetric_space α] {x y z : α} {s t : set α} {C : ℝ≥0∞} {sC : set ℝ≥0∞}
+
+lemma einfsep_pos_of_finite [finite s] : 0 < s.einfsep :=
+begin
+  casesI nonempty_fintype s,
+  by_cases hs : s.nontrivial,
+  { rcases hs.einfsep_exists_of_finite with ⟨x, hx, y, hy, hxy, hxy'⟩,
+    exact hxy'.symm ▸ edist_pos.2 hxy },
+  { rw not_nontrivial_iff at hs,
+    exact hs.einfsep.symm ▸ with_top.zero_lt_top }
+end
+
+lemma relatively_discrete_of_finite [finite s] :
+  ∃ C (hC : 0 < C), ∀ (x y ∈ s) (hxy : x ≠ y), C ≤ edist x y :=
+by { rw ← einfsep_pos, exact einfsep_pos_of_finite }
+
+lemma finite.einfsep_pos (hs : s.finite) : 0 < s.einfsep :=
+by { letI := hs.fintype, exact einfsep_pos_of_finite }
+
+lemma finite.relatively_discrete (hs : s.finite) :
+  ∃ C (hC : 0 < C), ∀ (x y ∈ s) (hxy : x ≠ y), C ≤ edist x y :=
+by { letI := hs.fintype, exact relatively_discrete_of_finite }
+
+end emetric_space
+
+end einfsep
+
+section infsep
+open_locale ennreal
+open set function
+
+/-- The "infimum separation" of a set with an edist function. -/
+noncomputable def infsep [has_edist α] (s : set α) : ℝ := ennreal.to_real (s.einfsep)
+
+section has_edist
+variables [has_edist α] {x y : α} {s : set α}
+
+lemma infsep_zero : s.infsep = 0 ↔ s.einfsep = 0 ∨ s.einfsep = ∞ :=
+by rw [infsep, ennreal.to_real_eq_zero_iff]
+
+lemma infsep_nonneg : 0 ≤ s.infsep := ennreal.to_real_nonneg
+
+lemma infsep_pos : 0 < s.infsep ↔ 0 < s.einfsep ∧ s.einfsep < ∞ :=
+by simp_rw [infsep, ennreal.to_real_pos_iff]
+
+lemma subsingleton.infsep_zero (hs : s.subsingleton) : s.infsep = 0 :=
+by { rw [infsep_zero, hs.einfsep], right, refl }
+
+lemma nontrivial_of_infsep_pos (hs : 0 < s.infsep) : s.nontrivial :=
+by { contrapose hs, rw not_nontrivial_iff at hs, exact hs.infsep_zero ▸ lt_irrefl _ }
+
+lemma infsep_empty : (∅ : set α).infsep = 0 :=
+subsingleton_empty.infsep_zero
+
+lemma infsep_singleton : ({x} : set α).infsep = 0 :=
+subsingleton_singleton.infsep_zero
+
+lemma infsep_pair_le_to_real_inf (hxy : x ≠ y) :
+  ({x, y} : set α).infsep ≤ (edist x y ⊓ edist y x).to_real :=
+by simp_rw [infsep, einfsep_pair_eq_inf hxy]
+
+end has_edist
+
+section pseudo_emetric_space
+variables [pseudo_emetric_space α] {x y : α} {s : set α}
+
+lemma infsep_pair_eq_to_real : ({x, y} : set α).infsep = (edist x y).to_real :=
+begin
+  by_cases hxy : x = y,
+  { rw hxy, simp only [infsep_singleton, pair_eq_singleton, edist_self, ennreal.zero_to_real] },
+  { rw [infsep, einfsep_pair hxy] }
+end
+
+end pseudo_emetric_space
+
+section pseudo_metric_space
+
+variables [pseudo_metric_space α] {x y z: α} {s t : set α}
+
+lemma nontrivial.le_infsep_iff {d} (hs : s.nontrivial) :
+  d ≤ s.infsep ↔ ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ dist x y :=
+by simp_rw [infsep, ← ennreal.of_real_le_iff_le_to_real (hs.einfsep_ne_top), le_einfsep_iff,
+            edist_dist, ennreal.of_real_le_of_real_iff (dist_nonneg)]
+
+lemma nontrivial.infsep_lt_iff {d} (hs : s.nontrivial) :
+  s.infsep < d ↔ ∃ (x y ∈ s) (hxy : x ≠ y), dist x y < d :=
+by { rw ← not_iff_not, push_neg, exact hs.le_infsep_iff }
+
+lemma nontrivial.le_infsep {d} (hs : s.nontrivial) (h : ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ dist x y) :
+  d ≤ s.infsep := hs.le_infsep_iff.2 h
+
+lemma le_edist_of_le_infsep {d x} (hx : x ∈ s) {y} (hy : y ∈ s)
+  (hxy : x ≠ y) (hd : d ≤ s.infsep) : d ≤ dist x y :=
+begin
+  by_cases hs : s.nontrivial,
+  { exact hs.le_infsep_iff.1 hd x hx y hy hxy },
+  { rw not_nontrivial_iff at hs,
+    rw hs.infsep_zero at hd,
+    exact le_trans hd dist_nonneg }
+end
+
+lemma infsep_le_dist_of_mem (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y) : s.infsep ≤ dist x y :=
+le_edist_of_le_infsep hx hy hxy le_rfl
+
+lemma infsep_le_of_mem_of_edist_le {d x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y)
+  (hxy' : dist x y ≤ d) : s.infsep ≤ d := le_trans (infsep_le_dist_of_mem hx hy hxy) hxy'
+
+lemma infsep_pair : ({x, y} : set α).infsep = dist x y :=
+by { rw [infsep_pair_eq_to_real, edist_dist], exact ennreal.to_real_of_real (dist_nonneg) }
+
+lemma infsep_triple (hxy : x ≠ y) (hyz : y ≠ z) (hxz : x ≠ z) :
+  ({x, y, z} : set α).infsep = dist x y ⊓ dist x z ⊓ dist y z :=
+by simp only [infsep, einfsep_triple hxy hyz hxz, ennreal.to_real_inf, edist_ne_top x y,
+             edist_ne_top x z, edist_ne_top y z, dist_edist, ne.def, inf_eq_top_iff,
+             and_self, not_false_iff]
+
+
+lemma nontrivial.infsep_anti (hs : s.nontrivial) (hst : s ⊆ t) : t.infsep ≤ s.infsep :=
+ennreal.to_real_mono hs.einfsep_ne_top (einfsep_anti hst)
+
+lemma infsep_eq_infi [decidable s.nontrivial] :
+  s.infsep = if s.nontrivial then ⨅ d : s.off_diag, (uncurry dist) (d : α × α) else 0 :=
+begin
+  split_ifs with hs,
+  { have hb : bdd_below (uncurry dist '' s.off_diag),
+    { refine ⟨0, λ d h, _⟩,
+      simp_rw [mem_image, prod.exists, uncurry_apply_pair] at h,
+      rcases h with ⟨_, _, _, rfl⟩,
+      exact dist_nonneg },
+    refine eq_of_forall_le_iff (λ _, _),
+    simp_rw [hs.le_infsep_iff, le_cinfi_set_iff (off_diag_nonempty.mpr hs) hb, imp_forall_iff,
+            mem_off_diag, prod.forall, uncurry_apply_pair, and_imp] },
+  { exact ((not_nontrivial_iff).mp hs).infsep_zero }
+end
+
+lemma nontrivial.infsep_eq_infi (hs : s.nontrivial)
+  : s.infsep = ⨅ d : s.off_diag, (uncurry dist) (d : α × α) :=
+by { classical, rw [infsep_eq_infi, if_pos hs] }
+
+lemma infsep_of_fintype [decidable s.nontrivial] [decidable_eq α] [fintype s] :
+  s.infsep = if hs : s.nontrivial then s.off_diag.to_finset.inf' (by simpa) (uncurry dist) else 0 :=
+begin
+  split_ifs with hs,
+  { refine eq_of_forall_le_iff (λ _, _),
+    simp_rw [hs.le_infsep_iff, imp_forall_iff, finset.le_inf'_iff, mem_to_finset, mem_off_diag,
+             prod.forall, uncurry_apply_pair, and_imp] },
+  { rw not_nontrivial_iff at hs, exact hs.infsep_zero }
+end
+
+lemma nontrivial.infsep_of_fintype [decidable_eq α] [fintype s] (hs : s.nontrivial) :
+  s.infsep = s.off_diag.to_finset.inf' (by simpa) (uncurry dist) :=
+by { classical, rw [infsep_of_fintype, dif_pos hs] }
+
+lemma finite.infsep [decidable s.nontrivial] (hsf : s.finite) :
+  s.infsep = if hs : s.nontrivial then hsf.off_diag.to_finset.inf' (by simpa) (uncurry dist)
+  else 0 :=
+begin
+  split_ifs with hs,
+  { refine eq_of_forall_le_iff (λ _, _),
+    simp_rw [hs.le_infsep_iff, imp_forall_iff, finset.le_inf'_iff, finite.mem_to_finset,
+            mem_off_diag, prod.forall, uncurry_apply_pair, and_imp] },
+  { rw not_nontrivial_iff at hs, exact hs.infsep_zero }
+end
+
+lemma finite.infsep_of_nontrivial (hsf : s.finite) (hs : s.nontrivial) :
+  s.infsep = hsf.off_diag.to_finset.inf' (by simpa) (uncurry dist) :=
+  by { classical, simp_rw [hsf.infsep, dif_pos hs] }
+
+lemma _root_.finset.coe_infsep [decidable_eq α] (s : finset α) :
+  (s : set α).infsep = if hs : s.off_diag.nonempty then s.off_diag.inf' hs (uncurry dist)
+                         else 0 :=
+begin
+  have H : (s : set α).nontrivial ↔ s.off_diag.nonempty,
+  by rwa [← set.off_diag_nonempty, ← finset.coe_off_diag, finset.coe_nonempty],
+  split_ifs with hs,
+  { simp_rw [(H.mpr hs).infsep_of_fintype, ← finset.coe_off_diag, finset.to_finset_coe] },
+  { exact ((not_nontrivial_iff).mp (H.mp.mt hs)).infsep_zero }
+end
+
+lemma _root_.finset.coe_infsep_of_off_diag_nonempty [decidable_eq α] {s : finset α}
+  (hs : s.off_diag.nonempty) : (s : set α).infsep = s.off_diag.inf' hs (uncurry dist) :=
+by rw [finset.coe_infsep, dif_pos hs]
+
+lemma _root_.finset.coe_infsep_of_off_diag_empty [decidable_eq α] {s : finset α}
+  (hs : s.off_diag = ∅) : (s : set α).infsep = 0 :=
+by { rw ← finset.not_nonempty_iff_eq_empty at hs, rw [finset.coe_infsep, dif_neg hs] }
+
+lemma nontrivial.infsep_exists_of_finite [finite s] (hs : s.nontrivial) :
+  ∃ (x y ∈ s) (hxy : x ≠ y), s.infsep = dist x y :=
+begin
+  classical,
+  casesI nonempty_fintype s,
+  simp_rw hs.infsep_of_fintype,
+  rcases @finset.exists_mem_eq_inf' _ _ _ (s.off_diag.to_finset) (by simpa) (uncurry dist)
+    with ⟨_, hxy, hed⟩,
+  simp_rw mem_to_finset at hxy,
+  exact ⟨w.fst, hxy.1, w.snd, hxy.2.1, hxy.2.2, hed⟩
+end
+
+lemma finite.infsep_exists_of_nontrivial (hsf : s.finite) (hs : s.nontrivial) :
+  ∃ (x y ∈ s) (hxy : x ≠ y), s.infsep = dist x y :=
+by { letI := hsf.fintype, exact hs.infsep_exists_of_finite }
+
+end pseudo_metric_space
+
+section metric_space
+variables [metric_space α] {s : set α}
+
+lemma infsep_zero_iff_subsingleton_of_finite [finite s] :
+  s.infsep = 0 ↔ s.subsingleton :=
+begin
+  rw [infsep_zero, einfsep_eq_top_iff, or_iff_right_iff_imp],
+  exact λ H, (einfsep_pos_of_finite.ne' H).elim
+end
+
+lemma infsep_pos_iff_nontrivial_of_finite [finite s] :
+  0 < s.infsep ↔ s.nontrivial :=
+begin
+  rw [infsep_pos, einfsep_lt_top_iff, and_iff_right_iff_imp],
+  exact λ _, einfsep_pos_of_finite
+end
+
+lemma finite.infsep_zero_iff_subsingleton (hs : s.finite) :
+  s.infsep = 0 ↔ s.subsingleton :=
+by { letI := hs.fintype, exact infsep_zero_iff_subsingleton_of_finite }
+
+lemma finite.infsep_pos_iff_nontrivial (hs : s.finite) :
+  0 < s.infsep ↔ s.nontrivial :=
+by { letI := hs.fintype, exact infsep_pos_iff_nontrivial_of_finite }
+
+lemma _root_.finset.infsep_zero_iff_subsingleton (s : finset α) :
+  (s : set α).infsep = 0 ↔ (s : set α).subsingleton := infsep_zero_iff_subsingleton_of_finite
+
+lemma _root_.finset.infsep_pos_iff_nontrivial (s : finset α) :
+  0 < (s : set α).infsep ↔ (s : set α).nontrivial := infsep_pos_iff_nontrivial_of_finite
+
+end metric_space
+
+end infsep
+
+end set
diff --git a/src/topology/metric_space/isometric_smul.lean b/src/topology/metric_space/isometric_smul.lean
new file mode 100644
index 0000000000000..7259cf14344de
--- /dev/null
+++ b/src/topology/metric_space/isometric_smul.lean
@@ -0,0 +1,407 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.metric_space.isometry
+
+/-!
+# Group actions by isometries
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define two typeclasses:
+
+- `has_isometric_smul M X` says that `M` multiplicatively acts on a (pseudo extended) metric space
+  `X` by isometries;
+- `has_isometric_vadd` is an additive version of `has_isometric_smul`.
+
+We also prove basic facts about isometric actions and define bundled isometries
+`isometry_equiv.const_mul`, `isometry_equiv.mul_left`, `isometry_equiv.mul_right`,
+`isometry_equiv.div_left`, `isometry_equiv.div_right`, and `isometry_equiv.inv`, as well as their
+additive versions.
+
+If `G` is a group, then `has_isometric_smul G G` means that `G` has a left-invariant metric while
+`has_isometric_smul Gᵐᵒᵖ G` means that `G` has a right-invariant metric. For a commutative group,
+these two notions are equivalent. A group with a right-invariant metric can be also represented as a
+`normed_group`.
+-/
+
+open set
+open_locale ennreal pointwise
+
+universes u v w
+
+variables (M : Type u) (G : Type v) (X : Type w)
+
+/-- An additive action is isometric if each map `x ↦ c +ᵥ x` is an isometry. -/
+class has_isometric_vadd [pseudo_emetric_space X] [has_vadd M X] : Prop :=
+(isometry_vadd [] : ∀ c : M, isometry ((+ᵥ) c : X → X))
+
+/-- A multiplicative action is isometric if each map `x ↦ c • x` is an isometry. -/
+@[to_additive] class has_isometric_smul [pseudo_emetric_space X] [has_smul M X] : Prop :=
+(isometry_smul [] : ∀ c : M, isometry ((•) c : X → X))
+
+export has_isometric_vadd (isometry_vadd) has_isometric_smul (isometry_smul)
+
+@[priority 100, to_additive]
+instance has_isometric_smul.to_has_continuous_const_smul [pseudo_emetric_space X] [has_smul M X]
+  [has_isometric_smul M X] : has_continuous_const_smul M X :=
+⟨λ c, (isometry_smul X c).continuous⟩
+
+@[priority 100, to_additive]
+instance has_isometric_smul.opposite_of_comm [pseudo_emetric_space X] [has_smul M X]
+  [has_smul Mᵐᵒᵖ X] [is_central_scalar M X] [has_isometric_smul M X] :
+  has_isometric_smul Mᵐᵒᵖ X :=
+⟨λ c x y, by simpa only [← op_smul_eq_smul] using (isometry_smul X c.unop x y)⟩
+
+variables {M G X}
+
+section emetric
+
+variables [pseudo_emetric_space X] [group G] [mul_action G X] [has_isometric_smul G X]
+
+@[simp, to_additive] lemma edist_smul_left [has_smul M X] [has_isometric_smul M X]
+  (c : M) (x y : X) :
+  edist (c • x) (c • y) = edist x y :=
+isometry_smul X c x y
+
+@[simp, to_additive] lemma ediam_smul [has_smul M X] [has_isometric_smul M X] (c : M) (s : set X) :
+  emetric.diam (c • s) = emetric.diam s :=
+(isometry_smul _ _).ediam_image s
+
+@[to_additive] lemma isometry_mul_left [has_mul M] [pseudo_emetric_space M]
+  [has_isometric_smul M M] (a : M) : isometry ((*) a) :=
+isometry_smul M a
+
+@[simp, to_additive] lemma edist_mul_left [has_mul M] [pseudo_emetric_space M]
+  [has_isometric_smul M M] (a b c : M) : edist (a * b) (a * c) = edist b c :=
+isometry_mul_left a b c
+
+@[to_additive] lemma isometry_mul_right [has_mul M] [pseudo_emetric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] (a : M) : isometry (λ x, x * a) :=
+isometry_smul M (mul_opposite.op a)
+
+@[simp, to_additive] lemma edist_mul_right [has_mul M] [pseudo_emetric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] (a b c : M) : edist (a * c) (b * c) = edist a b :=
+isometry_mul_right c a b
+
+@[simp, to_additive] lemma edist_div_right [div_inv_monoid M] [pseudo_emetric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] (a b c : M) : edist (a / c) (b / c) = edist a b :=
+by simp only [div_eq_mul_inv, edist_mul_right]
+
+@[simp, to_additive] lemma edist_inv_inv [pseudo_emetric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (a b : G) : edist a⁻¹ b⁻¹ = edist a b :=
+by rw [← edist_mul_left a, ← edist_mul_right _ _ b, mul_right_inv, one_mul,
+  inv_mul_cancel_right, edist_comm]
+
+@[to_additive] lemma isometry_inv [pseudo_emetric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] : isometry (has_inv.inv : G → G) :=
+edist_inv_inv
+
+@[to_additive] lemma edist_inv [pseudo_emetric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (x y : G) : edist x⁻¹ y = edist x y⁻¹ :=
+by rw [← edist_inv_inv, inv_inv]
+
+@[simp, to_additive] lemma edist_div_left [pseudo_emetric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (a b c : G) : edist (a / b) (a / c) = edist b c :=
+by rw [div_eq_mul_inv, div_eq_mul_inv, edist_mul_left, edist_inv_inv]
+
+namespace isometry_equiv
+
+/-- If a group `G` acts on `X` by isometries, then `isometry_equiv.const_smul` is the isometry of
+`X` given by multiplication of a constant element of the group. -/
+@[to_additive "If an additive group `G` acts on `X` by isometries, then `isometry_equiv.const_vadd`
+is the isometry of `X` given by addition of a constant element of the group.", simps to_equiv apply]
+def const_smul (c : G) : X ≃ᵢ X :=
+{ to_equiv := mul_action.to_perm c,
+  isometry_to_fun := isometry_smul X c }
+
+@[simp, to_additive]
+lemma const_smul_symm (c : G) : (const_smul c : X ≃ᵢ X).symm = const_smul c⁻¹ := ext $ λ _, rfl
+
+variables [pseudo_emetric_space G]
+
+/-- Multiplication `y ↦ x * y` as an `isometry_equiv`. -/
+@[to_additive "Addition `y ↦ x + y` as an `isometry_equiv`.", simps apply to_equiv]
+def mul_left [has_isometric_smul G G] (c : G) : G ≃ᵢ G :=
+{ to_equiv := equiv.mul_left c,
+  isometry_to_fun := edist_mul_left c }
+
+@[simp, to_additive] lemma mul_left_symm [has_isometric_smul G G] (x : G) :
+  (mul_left x).symm = isometry_equiv.mul_left x⁻¹ :=
+const_smul_symm x --ext $ λ y, rfl
+
+/-- Multiplication `y ↦ y * x` as an `isometry_equiv`. -/
+@[to_additive "Addition `y ↦ y + x` as an `isometry_equiv`.", simps apply to_equiv]
+def mul_right [has_isometric_smul Gᵐᵒᵖ G] (c : G) : G ≃ᵢ G :=
+{ to_equiv := equiv.mul_right c,
+  isometry_to_fun := λ a b, edist_mul_right a b c }
+
+@[simp, to_additive] lemma mul_right_symm [has_isometric_smul Gᵐᵒᵖ G] (x : G) :
+  (mul_right x).symm = mul_right x⁻¹ :=
+ext $ λ y, rfl
+
+/-- Division `y ↦ y / x` as an `isometry_equiv`. -/
+@[to_additive "Subtraction `y ↦ y - x` as an `isometry_equiv`.", simps apply to_equiv]
+def div_right [has_isometric_smul Gᵐᵒᵖ G] (c : G) : G ≃ᵢ G :=
+{ to_equiv := equiv.div_right c,
+  isometry_to_fun := λ a b, edist_div_right a b c }
+
+@[simp, to_additive] lemma div_right_symm [has_isometric_smul Gᵐᵒᵖ G] (c : G) :
+  (div_right c).symm = mul_right c :=
+ext $ λ y, rfl
+
+variables [has_isometric_smul G G] [has_isometric_smul Gᵐᵒᵖ G]
+
+/-- Division `y ↦ x / y` as an `isometry_equiv`. -/
+@[to_additive "Subtraction `y ↦ x - y` as an `isometry_equiv`.", simps apply symm_apply to_equiv]
+def div_left (c : G) : G ≃ᵢ G :=
+{ to_equiv := equiv.div_left c,
+  isometry_to_fun := edist_div_left c }
+
+variable (G)
+
+/-- Inversion `x ↦ x⁻¹` as an `isometry_equiv`. -/
+@[to_additive "Negation `x ↦ -x` as an `isometry_equiv`.", simps apply to_equiv]
+def inv : G ≃ᵢ G :=
+{ to_equiv := equiv.inv G,
+  isometry_to_fun := edist_inv_inv }
+
+@[simp, to_additive] lemma inv_symm : (inv G).symm = inv G := rfl
+
+end isometry_equiv
+
+namespace emetric
+
+@[simp, to_additive] lemma smul_ball (c : G) (x : X) (r : ℝ≥0∞) :
+  c • ball x r = ball (c • x) r :=
+(isometry_equiv.const_smul c).image_emetric_ball _ _
+
+@[simp, to_additive] lemma preimage_smul_ball (c : G) (x : X) (r : ℝ≥0∞) :
+  ((•) c) ⁻¹' ball x r = ball (c⁻¹ • x) r :=
+by rw [preimage_smul, smul_ball]
+
+@[simp, to_additive] lemma smul_closed_ball (c : G) (x : X) (r : ℝ≥0∞) :
+  c • closed_ball x r = closed_ball (c • x) r :=
+(isometry_equiv.const_smul c).image_emetric_closed_ball _ _
+
+@[simp, to_additive] lemma preimage_smul_closed_ball (c : G) (x : X) (r : ℝ≥0∞) :
+  ((•) c) ⁻¹' closed_ball x r = closed_ball (c⁻¹ • x) r :=
+by rw [preimage_smul, smul_closed_ball]
+
+variables [pseudo_emetric_space G]
+
+@[simp, to_additive]
+lemma preimage_mul_left_ball [has_isometric_smul G G] (a b : G) (r : ℝ≥0∞) :
+  ((*) a) ⁻¹' ball b r = ball (a⁻¹ * b) r :=
+preimage_smul_ball a b r
+
+@[simp, to_additive]
+lemma preimage_mul_right_ball [has_isometric_smul Gᵐᵒᵖ G] (a b : G) (r : ℝ≥0∞) :
+  (λ x, x * a) ⁻¹' ball b r = ball (b / a) r :=
+by { rw div_eq_mul_inv, exact preimage_smul_ball (mul_opposite.op a) b r }
+
+@[simp, to_additive]
+lemma preimage_mul_left_closed_ball [has_isometric_smul G G] (a b : G) (r : ℝ≥0∞) :
+  ((*) a) ⁻¹' closed_ball b r = closed_ball (a⁻¹ * b) r :=
+preimage_smul_closed_ball a b r
+
+@[simp, to_additive]
+lemma preimage_mul_right_closed_ball [has_isometric_smul Gᵐᵒᵖ G] (a b : G) (r : ℝ≥0∞) :
+  (λ x, x * a) ⁻¹' closed_ball b r = closed_ball (b / a) r :=
+by { rw div_eq_mul_inv, exact preimage_smul_closed_ball (mul_opposite.op a) b r }
+
+end emetric
+
+end emetric
+
+@[simp, to_additive]
+lemma dist_smul [pseudo_metric_space X] [has_smul M X] [has_isometric_smul M X]
+  (c : M) (x y : X) : dist (c • x) (c • y) = dist x y :=
+(isometry_smul X c).dist_eq x y
+
+@[simp, to_additive]
+lemma nndist_smul [pseudo_metric_space X] [has_smul M X] [has_isometric_smul M X]
+  (c : M) (x y : X) : nndist (c • x) (c • y) = nndist x y :=
+(isometry_smul X c).nndist_eq x y
+
+@[simp, to_additive]
+lemma diam_smul [pseudo_metric_space X] [has_smul M X] [has_isometric_smul M X]
+  (c : M) (s : set X) : metric.diam (c • s) = metric.diam s :=
+(isometry_smul _ _).diam_image s
+
+@[simp, to_additive]
+lemma dist_mul_left [pseudo_metric_space M] [has_mul M] [has_isometric_smul M M]
+  (a b c : M) : dist (a * b) (a * c) = dist b c :=
+dist_smul a b c
+
+@[simp, to_additive]
+lemma nndist_mul_left [pseudo_metric_space M] [has_mul M] [has_isometric_smul M M]
+  (a b c : M) : nndist (a * b) (a * c) = nndist b c :=
+nndist_smul a b c
+
+@[simp, to_additive] lemma dist_mul_right [has_mul M] [pseudo_metric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] (a b c : M) : dist (a * c) (b * c) = dist a b :=
+dist_smul (mul_opposite.op c) a b
+
+@[simp, to_additive]
+lemma nndist_mul_right [pseudo_metric_space M] [has_mul M] [has_isometric_smul Mᵐᵒᵖ M]
+  (a b c : M) : nndist (a * c) (b * c) = nndist a b :=
+nndist_smul (mul_opposite.op c) a b
+
+@[simp, to_additive] lemma dist_div_right [div_inv_monoid M] [pseudo_metric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] (a b c : M) : dist (a / c) (b / c) = dist a b :=
+by simp only [div_eq_mul_inv, dist_mul_right]
+
+@[simp, to_additive] lemma nndist_div_right [div_inv_monoid M] [pseudo_metric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] (a b c : M) : nndist (a / c) (b / c) = nndist a b :=
+by simp only [div_eq_mul_inv, nndist_mul_right]
+
+@[simp, to_additive]
+lemma dist_inv_inv [group G] [pseudo_metric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (a b : G) : dist a⁻¹ b⁻¹ = dist a b :=
+(isometry_equiv.inv G).dist_eq a b
+
+@[simp, to_additive]
+lemma nndist_inv_inv [group G] [pseudo_metric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (a b : G) : nndist a⁻¹ b⁻¹ = nndist a b :=
+(isometry_equiv.inv G).nndist_eq a b
+
+@[simp, to_additive]
+lemma dist_div_left [group G] [pseudo_metric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (a b c : G) : dist (a / b) (a / c) = dist b c :=
+by simp [div_eq_mul_inv]
+
+@[simp, to_additive]
+lemma nndist_div_left [group G] [pseudo_metric_space G] [has_isometric_smul G G]
+  [has_isometric_smul Gᵐᵒᵖ G] (a b c : G) : nndist (a / b) (a / c) = nndist b c :=
+by simp [div_eq_mul_inv]
+
+namespace metric
+
+variables [pseudo_metric_space X] [group G] [mul_action G X] [has_isometric_smul G X]
+
+@[simp, to_additive] lemma smul_ball (c : G) (x : X) (r : ℝ) :
+  c • ball x r = ball (c • x) r :=
+(isometry_equiv.const_smul c).image_ball _ _
+
+@[simp, to_additive] lemma preimage_smul_ball (c : G) (x : X) (r : ℝ) :
+  ((•) c) ⁻¹' ball x r = ball (c⁻¹ • x) r :=
+by rw [preimage_smul, smul_ball]
+
+@[simp, to_additive] lemma smul_closed_ball (c : G) (x : X) (r : ℝ) :
+  c • closed_ball x r = closed_ball (c • x) r :=
+(isometry_equiv.const_smul c).image_closed_ball _ _
+
+@[simp, to_additive] lemma preimage_smul_closed_ball (c : G) (x : X) (r : ℝ) :
+  ((•) c) ⁻¹' closed_ball x r = closed_ball (c⁻¹ • x) r :=
+by rw [preimage_smul, smul_closed_ball]
+
+@[simp, to_additive] lemma smul_sphere (c : G) (x : X) (r : ℝ) :
+  c • sphere x r = sphere (c • x) r :=
+(isometry_equiv.const_smul c).image_sphere _ _
+
+@[simp, to_additive] lemma preimage_smul_sphere (c : G) (x : X) (r : ℝ) :
+  ((•) c) ⁻¹' sphere x r = sphere (c⁻¹ • x) r :=
+by rw [preimage_smul, smul_sphere]
+
+variables [pseudo_metric_space G]
+
+@[simp, to_additive]
+lemma preimage_mul_left_ball [has_isometric_smul G G] (a b : G) (r : ℝ) :
+  ((*) a) ⁻¹' ball b r = ball (a⁻¹ * b) r :=
+preimage_smul_ball a b r
+
+@[simp, to_additive]
+lemma preimage_mul_right_ball [has_isometric_smul Gᵐᵒᵖ G] (a b : G) (r : ℝ) :
+  (λ x, x * a) ⁻¹' ball b r = ball (b / a) r :=
+by { rw div_eq_mul_inv, exact preimage_smul_ball (mul_opposite.op a) b r }
+
+@[simp, to_additive]
+lemma preimage_mul_left_closed_ball [has_isometric_smul G G] (a b : G) (r : ℝ) :
+  ((*) a) ⁻¹' closed_ball b r = closed_ball (a⁻¹ * b) r :=
+preimage_smul_closed_ball a b r
+
+@[simp, to_additive]
+lemma preimage_mul_right_closed_ball [has_isometric_smul Gᵐᵒᵖ G] (a b : G) (r : ℝ) :
+  (λ x, x * a) ⁻¹' closed_ball b r = closed_ball (b / a) r :=
+by { rw div_eq_mul_inv, exact preimage_smul_closed_ball (mul_opposite.op a) b r }
+
+end metric
+
+section instances
+
+variables {Y : Type*} [pseudo_emetric_space X] [pseudo_emetric_space Y] [has_smul M X]
+  [has_isometric_smul M X]
+
+@[to_additive] instance [has_smul M Y] [has_isometric_smul M Y] :
+  has_isometric_smul M (X × Y) :=
+⟨λ c, (isometry_smul X c).prod_map (isometry_smul Y c)⟩
+
+@[to_additive] instance prod.has_isometric_smul' {N}
+  [has_mul M] [pseudo_emetric_space M] [has_isometric_smul M M]
+  [has_mul N] [pseudo_emetric_space N] [has_isometric_smul N N] :
+  has_isometric_smul (M × N) (M × N) :=
+⟨λ c, (isometry_smul M c.1).prod_map (isometry_smul N c.2)⟩
+
+@[to_additive] instance prod.has_isometric_smul'' {N}
+  [has_mul M] [pseudo_emetric_space M] [has_isometric_smul Mᵐᵒᵖ M]
+  [has_mul N] [pseudo_emetric_space N] [has_isometric_smul Nᵐᵒᵖ N] :
+  has_isometric_smul (M × N)ᵐᵒᵖ (M × N) :=
+⟨λ c, (isometry_mul_right c.unop.1).prod_map (isometry_mul_right c.unop.2)⟩
+
+@[to_additive] instance units.has_isometric_smul [monoid M] : has_isometric_smul Mˣ X :=
+⟨λ c, by convert isometry_smul X (c : M)⟩
+
+@[to_additive] instance : has_isometric_smul M Xᵐᵒᵖ :=
+⟨λ c x y, by simpa only using edist_smul_left c x.unop y.unop⟩
+
+@[to_additive] instance ulift.has_isometric_smul : has_isometric_smul (ulift M) X :=
+⟨λ c, by simpa only using isometry_smul X c.down⟩
+
+@[to_additive] instance ulift.has_isometric_smul' : has_isometric_smul M (ulift X) :=
+⟨λ c x y, by simpa only using edist_smul_left c x.1 y.1⟩
+
+@[to_additive] instance {ι} {X : ι → Type*} [fintype ι] [Π i, has_smul M (X i)]
+  [Π i, pseudo_emetric_space (X i)] [∀ i, has_isometric_smul M (X i)] :
+  has_isometric_smul M (Π i, X i) :=
+⟨λ c, isometry_dcomp (λ i, (•) c) (λ i, isometry_smul (X i) c)⟩
+
+@[to_additive] instance pi.has_isometric_smul' {ι} {M X : ι → Type*} [fintype ι]
+  [Π i, has_smul (M i) (X i)] [Π i, pseudo_emetric_space (X i)]
+  [∀ i, has_isometric_smul (M i) (X i)] :
+  has_isometric_smul (Π i, M i) (Π i, X i) :=
+⟨λ c, isometry_dcomp (λ i, (•) (c i)) (λ i, isometry_smul _ _)⟩
+
+@[to_additive] instance pi.has_isometric_smul'' {ι} {M : ι → Type*} [fintype ι]
+  [Π i, has_mul (M i)] [Π i, pseudo_emetric_space (M i)] [∀ i, has_isometric_smul (M i)ᵐᵒᵖ (M i)] :
+  has_isometric_smul (Π i, M i)ᵐᵒᵖ (Π i, M i) :=
+⟨λ c, isometry_dcomp (λ i (x : M i), x * c.unop i) $ λ i, isometry_mul_right _⟩
+
+instance additive.has_isometric_vadd : has_isometric_vadd (additive M) X :=
+⟨λ c, isometry_smul X c.to_mul⟩
+
+instance additive.has_isometric_vadd' [has_mul M] [pseudo_emetric_space M]
+  [has_isometric_smul M M] : has_isometric_vadd (additive M) (additive M) :=
+⟨λ c x y, edist_smul_left c.to_mul x.to_mul y.to_mul⟩
+
+instance additive.has_isometric_vadd'' [has_mul M] [pseudo_emetric_space M]
+  [has_isometric_smul Mᵐᵒᵖ M] : has_isometric_vadd (additive M)ᵃᵒᵖ (additive M) :=
+⟨λ c x y, edist_smul_left (mul_opposite.op c.unop.to_mul) x.to_mul y.to_mul⟩
+
+instance multiplicative.has_isometric_smul {M X} [has_vadd M X] [pseudo_emetric_space X]
+  [has_isometric_vadd M X]: has_isometric_smul (multiplicative M) X :=
+⟨λ c, isometry_vadd X c.to_add⟩
+
+instance multiplicative.has_isometric_smul' [has_add M] [pseudo_emetric_space M]
+  [has_isometric_vadd M M] : has_isometric_smul (multiplicative M) (multiplicative M) :=
+⟨λ c x y, edist_vadd_left c.to_add x.to_add y.to_add⟩
+
+instance multiplicative.has_isometric_vadd'' [has_add M] [pseudo_emetric_space M]
+  [has_isometric_vadd Mᵃᵒᵖ M] :
+  has_isometric_smul (multiplicative M)ᵐᵒᵖ (multiplicative M) :=
+⟨λ c x y, edist_vadd_left (add_opposite.op c.unop.to_add) x.to_add y.to_add⟩
+
+end instances
diff --git a/src/topology/metric_space/isometry.lean b/src/topology/metric_space/isometry.lean
index c7dd5d2fb9c5d..0836c9fe2fb95 100644
--- a/src/topology/metric_space/isometry.lean
+++ b/src/topology/metric_space/isometry.lean
@@ -9,6 +9,9 @@ import topology.metric_space.antilipschitz
 /-!
 # Isometries
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define isometries, i.e., maps between emetric spaces that preserve
 the edistance (on metric spaces, these are exactly the maps that preserve distances),
 and prove their basic properties. We also introduce isometric bijections.
@@ -20,140 +23,156 @@ theory for `pseudo_metric_space` and we specialize to `metric_space` when needed
 noncomputable theory
 
 universes u v w
-variables {α : Type u} {β : Type v} {γ : Type w}
+variables {ι : Type*} {α : Type u} {β : Type v} {γ : Type w}
 
 open function set
-open_locale topological_space ennreal
+open_locale topology ennreal
 
 /-- An isometry (also known as isometric embedding) is a map preserving the edistance
 between pseudoemetric spaces, or equivalently the distance between pseudometric space.  -/
 def isometry [pseudo_emetric_space α] [pseudo_emetric_space β] (f : α → β) : Prop :=
 ∀x1 x2 : α, edist (f x1) (f x2) = edist x1 x2
 
+/-- On pseudometric spaces, a map is an isometry if and only if it preserves nonnegative
+distances. -/
+lemma isometry_iff_nndist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β} :
+  isometry f ↔ (∀x y, nndist (f x) (f y) = nndist x y) :=
+by simp only [isometry, edist_nndist, ennreal.coe_eq_coe]
+
 /-- On pseudometric spaces, a map is an isometry if and only if it preserves distances. -/
-lemma isometry_emetric_iff_metric [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β} :
+lemma isometry_iff_dist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β} :
   isometry f ↔ (∀x y, dist (f x) (f y) = dist x y) :=
-⟨assume H x y, by simp [dist_edist, H x y],
-assume H x y, by simp [edist_dist, H x y]⟩
-
-/-- An isometry preserves edistances. -/
-theorem isometry.edist_eq [pseudo_emetric_space α] [pseudo_emetric_space β] {f : α → β}
-  (hf : isometry f) (x y : α) : edist (f x) (f y) = edist x y :=
-hf x y
+by simp only [isometry_iff_nndist_eq, ← coe_nndist, nnreal.coe_eq]
 
 /-- An isometry preserves distances. -/
-theorem isometry.dist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
-  (hf : isometry f) (x y : α) : dist (f x) (f y) = dist x y :=
-by rw [dist_edist, dist_edist, hf]
+alias isometry_iff_dist_eq ↔ isometry.dist_eq _
+
+/-- A map that preserves distances is an isometry -/
+alias isometry_iff_dist_eq ↔ _ isometry.of_dist_eq
 
 /-- An isometry preserves non-negative distances. -/
-theorem isometry.nndist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
-  (hf : isometry f) (x y : α) : nndist (f x) (f y) = nndist x y :=
-subtype.ext $ hf.dist_eq x y
+alias isometry_iff_nndist_eq ↔ isometry.nndist_eq _
+
+/-- A map that preserves non-negative distances is an isometry. -/
+alias isometry_iff_nndist_eq ↔ _ isometry.of_nndist_eq
+
+namespace isometry
 
 section pseudo_emetric_isometry
 
 variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
 variables {f : α → β} {x y z : α}  {s : set α}
 
-lemma isometry.lipschitz (h : isometry f) : lipschitz_with 1 f :=
-lipschitz_with.of_edist_le $ λ x y, le_of_eq (h x y)
+/-- An isometry preserves edistances. -/
+theorem edist_eq (hf : isometry f) (x y : α) : edist (f x) (f y) = edist x y := hf x y
 
-lemma isometry.antilipschitz (h : isometry f) : antilipschitz_with 1 f :=
-λ x y, by simp only [h x y, ennreal.coe_one, one_mul, le_refl]
+lemma lipschitz (h : isometry f) : lipschitz_with 1 f :=
+lipschitz_with.of_edist_le $ λ x y, (h x y).le
 
-/-- An isometry from an emetric space is injective -/
-lemma isometry.injective {α : Type u} [emetric_space α] {f : α → β} (h : isometry f) :
-  injective f := h.antilipschitz.injective
+lemma antilipschitz (h : isometry f) : antilipschitz_with 1 f :=
+λ x y, by simp only [h x y, ennreal.coe_one, one_mul, le_refl]
 
 /-- Any map on a subsingleton is an isometry -/
-theorem isometry_subsingleton [subsingleton α] : isometry f :=
+@[nontriviality] theorem _root_.isometry_subsingleton [subsingleton α] : isometry f :=
 λx y, by rw subsingleton.elim x y; simp
 
 /-- The identity is an isometry -/
-lemma isometry_id : isometry (id : α → α) :=
-λx y, rfl
+lemma _root_.isometry_id : isometry (id : α → α) := λ x y, rfl
+
+lemma prod_map {δ} [pseudo_emetric_space δ] {f : α → β} {g : γ → δ} (hf : isometry f)
+  (hg : isometry g) : isometry (prod.map f g) :=
+λ x y, by simp only [prod.edist_eq, hf.edist_eq, hg.edist_eq, prod_map]
+
+lemma _root_.isometry_dcomp {ι} [fintype ι] {α β : ι → Type*} [Π i, pseudo_emetric_space (α i)]
+  [Π i, pseudo_emetric_space (β i)] (f : Π i, α i → β i) (hf : ∀ i, isometry (f i)) :
+  isometry (dcomp f) :=
+λ x y, by simp only [edist_pi_def, (hf _).edist_eq]
 
-/-- The composition of isometries is an isometry -/
-theorem isometry.comp {g : β → γ} {f : α → β} (hg : isometry g) (hf : isometry f) :
-  isometry (g ∘ f) :=
-assume x y, calc
-  edist ((g ∘ f) x) ((g ∘ f) y) = edist (f x) (f y) : hg _ _
-                            ... = edist x y : hf _ _
+/-- The composition of isometries is an isometry. -/
+theorem comp {g : β → γ} {f : α → β} (hg : isometry g) (hf : isometry f) : isometry (g ∘ f) :=
+λ x y, (hg _ _).trans (hf _ _)
+
+/-- An isometry from a metric space is a uniform continuous map -/
+protected theorem uniform_continuous (hf : isometry f) : uniform_continuous f :=
+hf.lipschitz.uniform_continuous
 
 /-- An isometry from a metric space is a uniform inducing map -/
-theorem isometry.uniform_inducing (hf : isometry f) :
-  uniform_inducing f :=
-hf.antilipschitz.uniform_inducing hf.lipschitz.uniform_continuous
+protected theorem uniform_inducing (hf : isometry f) : uniform_inducing f :=
+hf.antilipschitz.uniform_inducing hf.uniform_continuous
 
-lemma isometry.tendsto_nhds_iff {ι : Type*} {f : α → β}
-  {g : ι → α} {a : filter ι} {b : α} (hf : isometry f) :
+lemma tendsto_nhds_iff {ι : Type*} {f : α → β} {g : ι → α} {a : filter ι} {b : α}
+  (hf : isometry f) :
   filter.tendsto g a (𝓝 b) ↔ filter.tendsto (f ∘ g) a (𝓝 (f b)) :=
 hf.uniform_inducing.inducing.tendsto_nhds_iff
 
 /-- An isometry is continuous. -/
-lemma isometry.continuous (hf : isometry f) : continuous f :=
-hf.lipschitz.continuous
+protected lemma continuous (hf : isometry f) : continuous f := hf.lipschitz.continuous
 
 /-- The right inverse of an isometry is an isometry. -/
-lemma isometry.right_inv {f : α → β} {g : β → α} (h : isometry f) (hg : right_inverse g f) :
+lemma right_inv {f : α → β} {g : β → α} (h : isometry f) (hg : right_inverse g f) :
   isometry g :=
 λ x y, by rw [← h, hg _, hg _]
 
+lemma preimage_emetric_closed_ball (h : isometry f) (x : α) (r : ℝ≥0∞) :
+  f ⁻¹' (emetric.closed_ball (f x) r) = emetric.closed_ball x r :=
+by { ext y, simp [h.edist_eq] }
+
+lemma preimage_emetric_ball (h : isometry f) (x : α) (r : ℝ≥0∞) :
+  f ⁻¹' (emetric.ball (f x) r) = emetric.ball x r :=
+by { ext y, simp [h.edist_eq] }
+
 /-- Isometries preserve the diameter in pseudoemetric spaces. -/
-lemma isometry.ediam_image (hf : isometry f) (s : set α) :
-  emetric.diam (f '' s) = emetric.diam s :=
+lemma ediam_image (hf : isometry f) (s : set α) : emetric.diam (f '' s) = emetric.diam s :=
 eq_of_forall_ge_iff $ λ d,
 by simp only [emetric.diam_le_iff, ball_image_iff, hf.edist_eq]
 
-lemma isometry.ediam_range (hf : isometry f) :
-  emetric.diam (range f) = emetric.diam (univ : set α) :=
+lemma ediam_range (hf : isometry f) : emetric.diam (range f) = emetric.diam (univ : set α) :=
 by { rw ← image_univ, exact hf.ediam_image univ }
 
-lemma isometry.maps_to_emetric_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
+lemma maps_to_emetric_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
   maps_to f (emetric.ball x r) (emetric.ball (f x) r) :=
-λ y hy, by rwa [emetric.mem_ball, hf]
+(hf.preimage_emetric_ball x r).ge
 
-lemma isometry.maps_to_emetric_closed_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
+lemma maps_to_emetric_closed_ball (hf : isometry f) (x : α) (r : ℝ≥0∞) :
   maps_to f (emetric.closed_ball x r) (emetric.closed_ball (f x) r) :=
-λ y hy, by rwa [emetric.mem_closed_ball, hf]
+(hf.preimage_emetric_closed_ball x r).ge
 
 /-- The injection from a subtype is an isometry -/
-lemma isometry_subtype_coe {s : set α} : isometry (coe : s → α) :=
+lemma _root_.isometry_subtype_coe {s : set α} : isometry (coe : s → α) :=
 λx y, rfl
 
-lemma isometry.comp_continuous_on_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α}
-  {s : set γ} :
+lemma comp_continuous_on_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α} {s : set γ} :
   continuous_on (f ∘ g) s ↔ continuous_on g s :=
 hf.uniform_inducing.inducing.continuous_on_iff.symm
 
-lemma isometry.comp_continuous_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α} :
+lemma comp_continuous_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α} :
   continuous (f ∘ g) ↔ continuous g :=
 hf.uniform_inducing.inducing.continuous_iff.symm
 
 end pseudo_emetric_isometry --section
 
 section emetric_isometry
-variables [emetric_space α]
+variables [emetric_space α] [pseudo_emetric_space β] {f : α → β}
 
-/-- An isometry from a metric space is a uniform embedding -/
-theorem isometry.uniform_embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
-  uniform_embedding f :=
+/-- An isometry from an emetric space is injective -/
+protected lemma injective (h : isometry f) : injective f := h.antilipschitz.injective
+
+/-- An isometry from an emetric space is a uniform embedding -/
+protected theorem uniform_embedding (hf : isometry f) : uniform_embedding f :=
 hf.antilipschitz.uniform_embedding hf.lipschitz.uniform_continuous
 
-/-- An isometry from a metric space is an embedding -/
-theorem isometry.embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
-  embedding f :=
+/-- An isometry from an emetric space is an embedding -/
+protected theorem embedding (hf : isometry f) : embedding f :=
 hf.uniform_embedding.embedding
 
 /-- An isometry from a complete emetric space is a closed embedding -/
-theorem isometry.closed_embedding [complete_space α] [emetric_space β]
-  {f : α → β} (hf : isometry f) : closed_embedding f :=
+theorem closed_embedding [complete_space α] [emetric_space γ]
+  {f : α → γ} (hf : isometry f) : closed_embedding f :=
 hf.antilipschitz.closed_embedding hf.lipschitz.uniform_continuous
 
 end emetric_isometry --section
 
-namespace isometry
+section pseudo_metric_isometry
 
 variables [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
 
@@ -164,19 +183,37 @@ by rw [metric.diam, metric.diam, hf.ediam_image]
 lemma diam_range (hf : isometry f) : metric.diam (range f) = metric.diam (univ : set α) :=
 by { rw ← image_univ, exact hf.diam_image univ }
 
+lemma preimage_set_of_dist (hf : isometry f) (x : α) (p : ℝ → Prop) :
+  f ⁻¹' {y | p (dist y (f x))} = {y | p (dist y x)} :=
+by { ext y, simp [hf.dist_eq] }
+
+lemma preimage_closed_ball (hf : isometry f) (x : α) (r : ℝ) :
+  f ⁻¹' (metric.closed_ball (f x) r) = metric.closed_ball x r :=
+hf.preimage_set_of_dist x (≤ r)
+
+lemma preimage_ball (hf : isometry f) (x : α) (r : ℝ) :
+  f ⁻¹' (metric.ball (f x) r) = metric.ball x r :=
+hf.preimage_set_of_dist x (< r)
+
+lemma preimage_sphere (hf : isometry f) (x : α) (r : ℝ) :
+  f ⁻¹' (metric.sphere (f x) r) = metric.sphere x r :=
+hf.preimage_set_of_dist x (= r)
+
 lemma maps_to_ball (hf : isometry f) (x : α) (r : ℝ) :
   maps_to f (metric.ball x r) (metric.ball (f x) r) :=
-λ y hy, by rwa [metric.mem_ball, hf.dist_eq]
+(hf.preimage_ball x r).ge
 
 lemma maps_to_sphere (hf : isometry f) (x : α) (r : ℝ) :
   maps_to f (metric.sphere x r) (metric.sphere (f x) r) :=
-λ y hy, by rwa [metric.mem_sphere, hf.dist_eq]
+(hf.preimage_sphere x r).ge
 
 lemma maps_to_closed_ball (hf : isometry f) (x : α) (r : ℝ) :
   maps_to f (metric.closed_ball x r) (metric.closed_ball (f x) r) :=
-λ y hy, by rwa [metric.mem_closed_ball, hf.dist_eq]
+(hf.preimage_closed_ball x r).ge
+
+end pseudo_metric_isometry -- section
 
-end isometry
+end isometry -- namespace
 
 /-- A uniform embedding from a uniform space to a metric space is an isometry with respect to the
 induced metric space structure on the source space. -/
@@ -187,7 +224,7 @@ lemma uniform_embedding.to_isometry {α β} [uniform_space α] [metric_space β]
       (@metric_space.to_pseudo_metric_space α (h.comap_metric_space f)))
     (by apply_instance) f :=
 begin
-  apply isometry_emetric_iff_metric.2,
+  apply isometry.of_dist_eq,
   assume x y,
   refl
 end
@@ -201,20 +238,20 @@ lemma embedding.to_isometry {α β} [topological_space α] [metric_space β] {f
       (@metric_space.to_pseudo_metric_space α (h.comap_metric_space f)))
     (by apply_instance) f :=
 begin
-  apply isometry_emetric_iff_metric.2,
+  apply isometry.of_dist_eq,
   assume x y,
   refl
 end
 
 /-- `α` and `β` are isometric if there is an isometric bijection between them. -/
-@[nolint has_inhabited_instance] -- such a bijection need not exist
-structure isometric (α : Type*) (β : Type*) [pseudo_emetric_space α] [pseudo_emetric_space β]
+@[nolint has_nonempty_instance] -- such a bijection need not exist
+structure isometry_equiv (α β : Type*) [pseudo_emetric_space α] [pseudo_emetric_space β]
   extends α ≃ β :=
 (isometry_to_fun  : isometry to_fun)
 
-infix ` ≃ᵢ `:25 := isometric
+infix ` ≃ᵢ `:25 := isometry_equiv
 
-namespace isometric
+namespace isometry_equiv
 
 section pseudo_emetric_space
 variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
@@ -285,7 +322,7 @@ def simps.apply (h : α ≃ᵢ β) : α → β := h
 /-- See Note [custom simps projection] -/
 def simps.symm_apply (h : α ≃ᵢ β) : β → α := h.symm
 
-initialize_simps_projections isometric
+initialize_simps_projections isometry_equiv
   (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply)
 
 @[simp] lemma symm_symm (h : α ≃ᵢ β) : h.symm.symm = h := to_equiv_inj h.to_equiv.symm_symm
@@ -330,11 +367,11 @@ by rw [← image_symm, ediam_image]
 
 @[simp] lemma preimage_emetric_ball (h : α ≃ᵢ β) (x : β) (r : ℝ≥0∞) :
   h ⁻¹' (emetric.ball x r) = emetric.ball (h.symm x) r :=
-by { ext y, simp [← h.edist_eq] }
+by rw [← h.isometry.preimage_emetric_ball (h.symm x) r, h.apply_symm_apply]
 
 @[simp] lemma preimage_emetric_closed_ball (h : α ≃ᵢ β) (x : β) (r : ℝ≥0∞) :
   h ⁻¹' (emetric.closed_ball x r) = emetric.closed_ball (h.symm x) r :=
-by { ext y, simp [← h.edist_eq] }
+by rw [← h.isometry.preimage_emetric_closed_ball (h.symm x) r, h.apply_symm_apply]
 
 @[simp] lemma image_emetric_ball (h : α ≃ᵢ β) (x : α) (r : ℝ≥0∞) :
   h '' (emetric.ball x r) = emetric.ball (h x) r :=
@@ -369,9 +406,9 @@ h.to_homeomorph.comp_continuous_iff'
 
 /-- The group of isometries. -/
 instance : group (α ≃ᵢ α) :=
-  { one := isometric.refl _,
+  { one := isometry_equiv.refl _,
     mul := λ e₁ e₂, e₂.trans e₁,
-    inv := isometric.symm,
+    inv := isometry_equiv.symm,
     mul_assoc := λ e₁ e₂ e₃, rfl,
     one_mul := λ e, ext $ λ _, rfl,
     mul_one := λ e, ext $ λ _, rfl,
@@ -389,11 +426,26 @@ lemma mul_apply (e₁ e₂ : α ≃ᵢ α) (x : α) : (e₁ * e₂) x = e₁ (e
 
 protected lemma complete_space [complete_space β] (e : α ≃ᵢ β) : complete_space α :=
 complete_space_of_is_complete_univ $ is_complete_of_complete_image e.isometry.uniform_inducing $
-  by rwa [set.image_univ, isometric.range_eq_univ, ← complete_space_iff_is_complete_univ]
+  by rwa [set.image_univ, isometry_equiv.range_eq_univ, ← complete_space_iff_is_complete_univ]
 
 lemma complete_space_iff (e : α ≃ᵢ β) : complete_space α ↔ complete_space β :=
 by { split; introI H, exacts [e.symm.complete_space, e.complete_space] }
 
+variables (ι α)
+
+/-- `equiv.fun_unique` as an `isometry_equiv`. -/
+@[simps]
+def fun_unique [unique ι] [fintype ι] : (ι → α) ≃ᵢ α :=
+{ to_equiv := equiv.fun_unique ι α,
+  isometry_to_fun := λ x hx, by simp [edist_pi_def, finset.univ_unique, finset.sup_singleton] }
+
+/-- `pi_fin_two_equiv` as an `isometry_equiv`. -/
+@[simps]
+def pi_fin_two (α : fin 2 → Type*) [Π i, pseudo_emetric_space (α i)] :
+  (Π i, α i) ≃ᵢ α 0 × α 1 :=
+{ to_equiv := pi_fin_two_equiv α,
+  isometry_to_fun := λ x hx, by simp [edist_pi_def, fin.univ_succ, prod.edist_eq] }
+
 end pseudo_emetric_space
 
 section pseudo_metric_space
@@ -411,15 +463,15 @@ congr_arg ennreal.to_real h.ediam_univ
 
 @[simp] lemma preimage_ball (h : α ≃ᵢ β) (x : β) (r : ℝ) :
   h ⁻¹' (metric.ball x r) = metric.ball (h.symm x) r :=
-by { ext y, simp [← h.dist_eq] }
+by rw [← h.isometry.preimage_ball (h.symm x) r, h.apply_symm_apply]
 
 @[simp] lemma preimage_sphere (h : α ≃ᵢ β) (x : β) (r : ℝ) :
   h ⁻¹' (metric.sphere x r) = metric.sphere (h.symm x) r :=
-by { ext y, simp [← h.dist_eq] }
+by rw [← h.isometry.preimage_sphere (h.symm x) r, h.apply_symm_apply]
 
 @[simp] lemma preimage_closed_ball (h : α ≃ᵢ β) (x : β) (r : ℝ) :
   h ⁻¹' (metric.closed_ball x r) = metric.closed_ball (h.symm x) r :=
-by { ext y, simp [← h.dist_eq] }
+by rw [← h.isometry.preimage_closed_ball (h.symm x) r, h.apply_symm_apply]
 
 @[simp] lemma image_ball (h : α ≃ᵢ β) (x : α) (r : ℝ) :
   h '' (metric.ball x r) = metric.ball (h x) r :=
@@ -435,12 +487,12 @@ by rw [← h.preimage_symm, h.symm.preimage_closed_ball, symm_symm]
 
 end pseudo_metric_space
 
-end isometric
+end isometry_equiv
 
 /-- An isometry induces an isometric isomorphism between the source space and the
 range of the isometry. -/
 @[simps to_equiv apply { simp_rhs := tt }]
-def isometry.isometric_on_range [emetric_space α] [pseudo_emetric_space β] {f : α → β}
+def isometry.isometry_equiv_on_range [emetric_space α] [pseudo_emetric_space β] {f : α → β}
   (h : isometry f) : α ≃ᵢ range f :=
 { isometry_to_fun := λx y, by simpa [subtype.edist_eq] using h x y,
   to_equiv := equiv.of_injective f h.injective }
diff --git a/src/topology/metric_space/kuratowski.lean b/src/topology/metric_space/kuratowski.lean
index b0b5f91c9889c..f5e0eba971407 100644
--- a/src/topology/metric_space/kuratowski.lean
+++ b/src/topology/metric_space/kuratowski.lean
@@ -9,6 +9,9 @@ import topology.sets.compacts
 /-!
 # The Kuratowski embedding
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Any separable metric space can be embedded isometrically in `ℓ^∞(ℝ)`.
 -/
 
@@ -54,7 +57,7 @@ end
 /-- When the reference set is dense, the embedding map is an isometry on its image. -/
 lemma embedding_of_subset_isometry (H : dense_range x) : isometry (embedding_of_subset x) :=
 begin
-  refine isometry_emetric_iff_metric.2 (λa b, _),
+  refine isometry.of_dist_eq (λa b, _),
   refine (embedding_of_subset_dist_le x a b).antisymm (le_of_forall_pos_le_add (λe epos, _)),
   /- First step: find n with dist a (x n) < e -/
   rcases metric.mem_closure_range_iff.1 (H a) (e/2) (half_pos epos) with ⟨n, hn⟩,
@@ -89,9 +92,9 @@ begin
   { /- We construct a map x : ℕ → α with dense image -/
     rcases h with ⟨basepoint⟩,
     haveI : inhabited α := ⟨basepoint⟩,
-    have : ∃s:set α, countable s ∧ dense s := exists_countable_dense α,
+    have : ∃s:set α, s.countable ∧ dense s := exists_countable_dense α,
     rcases this with ⟨S, ⟨S_countable, S_dense⟩⟩,
-    rcases countable_iff_exists_surjective.1 S_countable with ⟨x, x_range⟩,
+    rcases set.countable_iff_exists_subset_range.1 S_countable with ⟨x, x_range⟩,
     /- Use embedding_of_subset to construct the desired isometry -/
     exact ⟨embedding_of_subset x, embedding_of_subset_isometry x (S_dense.mono x_range)⟩ }
 end
@@ -113,5 +116,5 @@ def nonempty_compacts.Kuratowski_embedding (α : Type u) [metric_space α] [comp
   [nonempty α] :
   nonempty_compacts ℓ_infty_ℝ :=
 { carrier := range (Kuratowski_embedding α),
-  compact' := is_compact_range (Kuratowski_embedding.isometry α).continuous,
+  is_compact' := is_compact_range (Kuratowski_embedding.isometry α).continuous,
   nonempty' := range_nonempty _ }
diff --git a/src/topology/metric_space/lipschitz.lean b/src/topology/metric_space/lipschitz.lean
index c7af01efbab01..235c668ff913e 100644
--- a/src/topology/metric_space/lipschitz.lean
+++ b/src/topology/metric_space/lipschitz.lean
@@ -5,13 +5,16 @@ Authors: Rohan Mitta, Kevin Buzzard, Alistair Tucker, Johannes Hölzl, Yury Kudr
 -/
 import logic.function.iterate
 import data.set.intervals.proj_Icc
+import topology.algebra.order.field
 import topology.metric_space.basic
-import category_theory.endomorphism
-import category_theory.types
+import topology.bornology.hom
 
 /-!
 # Lipschitz continuous functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A map `f : α → β` between two (extended) metric spaces is called *Lipschitz continuous*
 with constant `K ≥ 0` if for all `x, y` we have `edist (f x) (f y) ≤ K * edist x y`.
 For a metric space, the latter inequality is equivalent to `dist (f x) (f y) ≤ K * dist x y`.
@@ -40,7 +43,7 @@ argument, and return `lipschitz_with (real.to_nnreal K) f`.
 universes u v w x
 
 open filter function set
-open_locale topological_space nnreal ennreal
+open_locale topology nnreal ennreal
 
 variables {α : Type u} {β : Type v} {γ : Type w} {ι : Type x}
 
@@ -85,6 +88,15 @@ lemma lipschitz_on_with_iff_restrict [pseudo_emetric_space α] [pseudo_emetric_s
   {f : α → β} {s : set α} : lipschitz_on_with K f s ↔ lipschitz_with K (s.restrict f) :=
 by simp only [lipschitz_on_with, lipschitz_with, set_coe.forall', restrict, subtype.edist_eq]
 
+alias lipschitz_on_with_iff_restrict ↔ lipschitz_on_with.to_restrict _
+
+lemma maps_to.lipschitz_on_with_iff_restrict [pseudo_emetric_space α] [pseudo_emetric_space β]
+  {K : ℝ≥0} {f : α → β} {s : set α} {t : set β} (h : maps_to f s t) :
+  lipschitz_on_with K f s ↔ lipschitz_with K (h.restrict f s t) :=
+lipschitz_on_with_iff_restrict
+
+alias maps_to.lipschitz_on_with_iff_restrict ↔ lipschitz_on_with.to_restrict_maps_to _
+
 namespace lipschitz_with
 
 section emetric
@@ -195,10 +207,7 @@ calc edist (f (g x)) (f (g y)) ≤ Kf * edist (g x) (g y) : hf _ _
 lemma comp_lipschitz_on_with {Kf Kg : ℝ≥0} {f : β → γ} {g : α → β} {s : set α}
   (hf : lipschitz_with Kf f) (hg : lipschitz_on_with Kg g s) :
   lipschitz_on_with (Kf * Kg) (f ∘ g) s :=
-assume x hx y hy,
-calc edist (f (g x)) (f (g y)) ≤ Kf * edist (g x) (g y) : hf _ _
-... ≤ Kf * (Kg * edist x y) : ennreal.mul_left_mono (hg hx hy)
-... = (Kf * Kg : ℝ≥0) * edist x y : by rw [← mul_assoc, ennreal.coe_mul]
+lipschitz_on_with_iff_restrict.mpr $ hf.comp hg.to_restrict
 
 protected lemma prod_fst : lipschitz_with 1 (@prod.fst α β) :=
 lipschitz_with.of_edist_le $ assume x y, le_max_left _ _
@@ -215,6 +224,12 @@ begin
   exact max_le_max (hf x y) (hg x y)
 end
 
+protected lemma prod_mk_left (a : α) : lipschitz_with 1 (prod.mk a : β → α × β) :=
+by simpa only [max_eq_right zero_le_one] using (lipschitz_with.const a).prod lipschitz_with.id
+
+protected lemma prod_mk_right (b : β) : lipschitz_with 1 (λ a : α, (a, b)) :=
+by simpa only [max_eq_left zero_le_one] using lipschitz_with.id.prod (lipschitz_with.const b)
+
 protected lemma uncurry {f : α → β → γ} {Kα Kβ : ℝ≥0} (hα : ∀ b, lipschitz_with Kα (λ a, f a b))
   (hβ : ∀ a, lipschitz_with Kβ (f a)) :
   lipschitz_with (Kα + Kβ) (function.uncurry f) :=
@@ -228,7 +243,7 @@ end
 
 protected lemma iterate {f : α → α} (hf : lipschitz_with K f) :
   ∀n, lipschitz_with (K ^ n) (f^[n])
-| 0       := lipschitz_with.id
+| 0       := by simpa only [pow_zero] using lipschitz_with.id
 | (n + 1) := by rw [pow_succ']; exact (iterate n).comp hf
 
 lemma edist_iterate_succ_le_geometric {f : α → α} (hf : lipschitz_with K f) (x n) :
@@ -238,22 +253,22 @@ begin
   simpa only [ennreal.coe_pow] using (hf.iterate n) x (f x)
 end
 
-open category_theory
-
-protected lemma mul {f g : End α} {Kf Kg} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) :
-  lipschitz_with (Kf * Kg) (f * g : End α) :=
+protected lemma mul {f g : function.End α} {Kf Kg} (hf : lipschitz_with Kf f)
+  (hg : lipschitz_with Kg g) :
+  lipschitz_with (Kf * Kg) (f * g : function.End α) :=
 hf.comp hg
 
 /-- The product of a list of Lipschitz continuous endomorphisms is a Lipschitz continuous
 endomorphism. -/
-protected lemma list_prod (f : ι → End α) (K : ι → ℝ≥0) (h : ∀ i, lipschitz_with (K i) (f i)) :
+protected lemma list_prod (f : ι → function.End α) (K : ι → ℝ≥0)
+  (h : ∀ i, lipschitz_with (K i) (f i)) :
   ∀ l : list ι, lipschitz_with (l.map K).prod (l.map f).prod
-| [] := by simp [types_id, lipschitz_with.id]
+| [] := by simpa using lipschitz_with.id
 | (i :: l) := by { simp only [list.map_cons, list.prod_cons], exact (h i).mul (list_prod l) }
 
-protected lemma pow {f : End α} {K} (h : lipschitz_with K f) :
-  ∀ n : ℕ, lipschitz_with (K^n) (f^n : End α)
-| 0       := lipschitz_with.id
+protected lemma pow {f : function.End α} {K} (h : lipschitz_with K f) :
+  ∀ n : ℕ, lipschitz_with (K^n) (f^n : function.End α)
+| 0       := by simpa only [pow_zero] using lipschitz_with.id
 | (n + 1) := by { rw [pow_succ, pow_succ], exact h.mul (pow n) }
 
 end emetric
@@ -320,6 +335,21 @@ lemma maps_to_ball (hf : lipschitz_with K f) (hK : K ≠ 0) (x : α) (r : ℝ) :
   maps_to f (metric.ball x r) (metric.ball (f x) (K * r)) :=
 λ y hy, hf.dist_lt_mul_of_lt hK hy
 
+/-- A Lipschitz continuous map is a locally bounded map. -/
+def to_locally_bounded_map (f : α → β) (hf : lipschitz_with K f) :
+  locally_bounded_map α β :=
+locally_bounded_map.of_map_bounded f $ λ s hs, let ⟨C, hC⟩ := metric.is_bounded_iff.1 hs
+in metric.is_bounded_iff.2 ⟨K * C, ball_image_iff.2 $ λ x hx, ball_image_iff.2 $ λ y hy,
+  hf.dist_le_mul_of_le (hC hx hy)⟩
+
+@[simp] lemma coe_to_locally_bounded_map (hf : lipschitz_with K f) :
+  ⇑(hf.to_locally_bounded_map f) = f :=
+rfl
+
+lemma comap_cobounded_le (hf : lipschitz_with K f) :
+  comap f (bornology.cobounded β) ≤ bornology.cobounded α :=
+(hf.to_locally_bounded_map f).2
+
 lemma bounded_image (hf : lipschitz_with K f) {s : set α} (hs : metric.bounded s) :
   metric.bounded (f '' s) :=
 metric.bounded_iff_ediam_ne_top.2 $ ne_top_of_le_ne_top
@@ -430,6 +460,25 @@ lemma edist_lt_of_edist_lt_div (hf : lipschitz_on_with K f s) {x y : α} (hx : x
 (lipschitz_on_with_iff_restrict.mp hf).edist_lt_of_edist_lt_div $
   show edist (⟨x, hx⟩ : s) ⟨y, hy⟩ < d / K, from hd
 
+protected lemma comp {g : β → γ} {t : set β} {Kg : ℝ≥0} (hg : lipschitz_on_with Kg g t)
+  (hf : lipschitz_on_with K f s) (hmaps : maps_to f s t) :
+  lipschitz_on_with (Kg * K) (g ∘ f) s :=
+lipschitz_on_with_iff_restrict.mpr $ hg.to_restrict.comp (hf.to_restrict_maps_to hmaps)
+
+lemma ediam_image2_le (f : α → β → γ) {K₁ K₂ : ℝ≥0}
+  (s : set α) (t : set β)
+  (hf₁ : ∀ b ∈ t, lipschitz_on_with K₁ (λ a, f a b) s)
+  (hf₂ : ∀ a ∈ s, lipschitz_on_with K₂ (f a) t) :
+  emetric.diam (set.image2 f s t) ≤ ↑K₁ * emetric.diam s + ↑K₂ * emetric.diam t :=
+begin
+  apply emetric.diam_le,
+  rintros _ ⟨a₁, b₁, ha₁, hb₁, rfl⟩ _  ⟨a₂, b₂, ha₂, hb₂, rfl⟩,
+  refine (edist_triangle _ (f a₂ b₁) _).trans _,
+  exact add_le_add
+    ((hf₁ b₁ hb₁ ha₁ ha₂).trans $ ennreal.mul_left_mono $ emetric.edist_le_diam_of_mem ha₁ ha₂)
+    ((hf₂ a₂ ha₂ hb₁ hb₂).trans $ ennreal.mul_left_mono $ emetric.edist_le_diam_of_mem hb₁ hb₂),
+end
+
 end emetric
 
 section metric
@@ -477,6 +526,17 @@ protected lemma iff_le_add_mul {f : α → ℝ} {K : ℝ≥0} :
   lipschitz_on_with K f s ↔ ∀ (x ∈ s) (y ∈ s), f x ≤ f y + K * dist x y :=
 ⟨lipschitz_on_with.le_add_mul, lipschitz_on_with.of_le_add_mul K⟩
 
+lemma bounded_image2 (f : α → β → γ) {K₁ K₂ : ℝ≥0}
+  {s : set α} {t : set β} (hs : metric.bounded s) (ht : metric.bounded t)
+  (hf₁ : ∀ b ∈ t, lipschitz_on_with K₁ (λ a, f a b) s)
+  (hf₂ : ∀ a ∈ s, lipschitz_on_with K₂ (f a) t) :
+  metric.bounded (set.image2 f s t) :=
+metric.bounded_iff_ediam_ne_top.2 $ ne_top_of_le_ne_top
+  (ennreal.add_ne_top.mpr ⟨
+    ennreal.mul_ne_top ennreal.coe_ne_top hs.ediam_ne_top,
+    ennreal.mul_ne_top ennreal.coe_ne_top ht.ediam_ne_top⟩)
+  (ediam_image2_le _ _ _ hf₁ hf₂)
+
 end metric
 
 end lipschitz_on_with
diff --git a/src/topology/metric_space/metric_separated.lean b/src/topology/metric_space/metric_separated.lean
index 633a976644b6e..0fbbc4afab2c8 100644
--- a/src/topology/metric_space/metric_separated.lean
+++ b/src/topology/metric_space/metric_separated.lean
@@ -8,6 +8,9 @@ import topology.metric_space.emetric_space
 /-!
 # Metric separated pairs of sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the predicate `is_metric_separated`. We say that two sets in an (extended)
 metric space are *metric separated* if the (extended) distance between `x ∈ s` and `y ∈ t` is
 bounded from below by a positive constant.
@@ -33,16 +36,17 @@ let ⟨r, r0, hr⟩ := h in ⟨r, r0, λ y hy x hx, edist_comm x y ▸ hr x hx y
 lemma comm : is_metric_separated s t ↔ is_metric_separated t s := ⟨symm, symm⟩
 
 @[simp] lemma empty_left (s : set X) : is_metric_separated ∅ s :=
-⟨1, ennreal.zero_lt_one.ne', λ x, false.elim⟩
+⟨1, one_ne_zero, λ x, false.elim⟩
 
 @[simp] lemma empty_right (s : set X) : is_metric_separated s ∅ :=
 (empty_left s).symm
 
 protected lemma disjoint (h : is_metric_separated s t) : disjoint s t :=
-let ⟨r, r0, hr⟩ := h in λ x hx, r0 $ by simpa using hr x hx.1 x hx.2
+let ⟨r, r0, hr⟩ := h in
+set.disjoint_left.mpr $ λ x hx1 hx2, r0 $ by simpa using hr x hx1 x hx2
 
 lemma subset_compl_right (h : is_metric_separated s t) : s ⊆ tᶜ :=
-λ x hs ht, h.disjoint ⟨hs, ht⟩
+λ x hs ht, h.disjoint.le_bot ⟨hs, ht⟩
 
 @[mono] lemma mono {s' t'} (hs : s ⊆ s') (ht : t ⊆ t') :
   is_metric_separated s' t' → is_metric_separated s t :=
@@ -80,16 +84,16 @@ lemma union_right {t'} (h : is_metric_separated s t) (h' : is_metric_separated s
   is_metric_separated s (t ∪ t') ↔ is_metric_separated s t ∧ is_metric_separated s t' :=
 comm.trans $ union_left_iff.trans $ and_congr comm comm
 
-lemma finite_Union_left_iff {ι : Type*} {I : set ι} (hI : finite I) {s : ι → set X} {t : set X} :
+lemma finite_Union_left_iff {ι : Type*} {I : set ι} (hI : I.finite) {s : ι → set X} {t : set X} :
   is_metric_separated (⋃ i ∈ I, s i) t ↔ ∀ i ∈ I, is_metric_separated (s i) t :=
 begin
   refine finite.induction_on hI (by simp) (λ i I hi _ hI, _),
   rw [bUnion_insert, ball_insert_iff, union_left_iff, hI]
 end
 
-alias finite_Union_left_iff ↔ _ is_metric_separated.finite_Union_left
+alias finite_Union_left_iff ↔ _ finite_Union_left
 
-lemma finite_Union_right_iff {ι : Type*} {I : set ι} (hI : finite I) {s : set X} {t : ι → set X} :
+lemma finite_Union_right_iff {ι : Type*} {I : set ι} (hI : I.finite) {s : set X} {t : ι → set X} :
   is_metric_separated s (⋃ i ∈ I, t i) ↔ ∀ i ∈ I, is_metric_separated s (t i) :=
 by simpa only [@comm _ _ s] using finite_Union_left_iff hI
 
@@ -97,12 +101,12 @@ by simpa only [@comm _ _ s] using finite_Union_left_iff hI
   is_metric_separated (⋃ i ∈ I, s i) t ↔ ∀ i ∈ I, is_metric_separated (s i) t :=
 finite_Union_left_iff I.finite_to_set
 
-alias finset_Union_left_iff ↔ _ is_metric_separated.finset_Union_left
+alias finset_Union_left_iff ↔ _ finset_Union_left
 
 @[simp] lemma finset_Union_right_iff {ι : Type*} {I : finset ι} {s : set X} {t : ι → set X} :
   is_metric_separated s (⋃ i ∈ I, t i) ↔ ∀ i ∈ I, is_metric_separated s (t i) :=
 finite_Union_right_iff I.finite_to_set
 
-alias finset_Union_right_iff ↔ _ is_metric_separated.finset_Union_right
+alias finset_Union_right_iff ↔ _ finset_Union_right
 
 end is_metric_separated
diff --git a/src/topology/metric_space/metrizable.lean b/src/topology/metric_space/metrizable.lean
index f2bd4b19785f8..8a016f62e60c7 100644
--- a/src/topology/metric_space/metrizable.lean
+++ b/src/topology/metric_space/metrizable.lean
@@ -3,77 +3,145 @@ Copyright (c) 2021 Yury Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury Kudryashov
 -/
+import analysis.specific_limits.basic
 import topology.urysohns_lemma
 import topology.continuous_function.bounded
+import topology.uniform_space.cauchy
 
 /-!
-# Metrizability of a normal topological space with second countable topology
+# Metrizability of a T₃ topological space with second countable topology
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
 In this file we define metrizable topological spaces, i.e., topological spaces for which there
 exists a metric space structure that generates the same topology.
 
-We also show that a normal topological space with second countable topology `X` is metrizable.
+We also show that a T₃ topological space with second countable topology `X` is metrizable.
 
 First we prove that `X` can be embedded into `l^∞`, then use this embedding to pull back the metric
 space structure.
 -/
 
 open set filter metric
-open_locale bounded_continuous_function filter topological_space
+open_locale bounded_continuous_function filter topology
 
 namespace topological_space
 
+variables {ι X Y : Type*} {π : ι → Type*} [topological_space X] [topological_space Y]
+  [finite ι] [Π i, topological_space (π i)]
+
+/-- A topological space is *pseudo metrizable* if there exists a pseudo metric space structure
+compatible with the topology. To endow such a space with a compatible distance, use
+`letI : pseudo_metric_space X := topological_space.pseudo_metrizable_space_pseudo_metric X`. -/
+class pseudo_metrizable_space (X : Type*) [t : topological_space X] : Prop :=
+(exists_pseudo_metric : ∃ (m : pseudo_metric_space X), m.to_uniform_space.to_topological_space = t)
+
+@[priority 100]
+instance _root_.pseudo_metric_space.to_pseudo_metrizable_space {X : Type*}
+  [m : pseudo_metric_space X] :
+  pseudo_metrizable_space X :=
+⟨⟨m, rfl⟩⟩
+
+/-- Construct on a metrizable space a metric compatible with the topology. -/
+noncomputable def pseudo_metrizable_space_pseudo_metric
+  (X : Type*) [topological_space X] [h : pseudo_metrizable_space X] :
+  pseudo_metric_space X :=
+h.exists_pseudo_metric.some.replace_topology h.exists_pseudo_metric.some_spec.symm
+
+instance pseudo_metrizable_space_prod [pseudo_metrizable_space X] [pseudo_metrizable_space Y] :
+  pseudo_metrizable_space (X × Y) :=
+begin
+  letI : pseudo_metric_space X := pseudo_metrizable_space_pseudo_metric X,
+  letI : pseudo_metric_space Y := pseudo_metrizable_space_pseudo_metric Y,
+  apply_instance
+end
+
+/-- Given an inducing map of a topological space into a pseudo metrizable space, the source space
+is also pseudo metrizable. -/
+lemma _root_.inducing.pseudo_metrizable_space [pseudo_metrizable_space Y] {f : X → Y}
+  (hf : inducing f) :
+  pseudo_metrizable_space X :=
+begin
+  letI : pseudo_metric_space Y := pseudo_metrizable_space_pseudo_metric Y,
+  exact ⟨⟨hf.comap_pseudo_metric_space, rfl⟩⟩
+end
+
+/-- Every pseudo-metrizable space is first countable. -/
+@[priority 100]
+instance pseudo_metrizable_space.first_countable_topology [h : pseudo_metrizable_space X] :
+  topological_space.first_countable_topology X :=
+begin
+  unfreezingI { rcases h with ⟨_, hm⟩, rw ←hm },
+  exact @uniform_space.first_countable_topology X pseudo_metric_space.to_uniform_space
+    emetric.uniformity.filter.is_countably_generated,
+end
+
+instance pseudo_metrizable_space.subtype [pseudo_metrizable_space X]
+  (s : set X) : pseudo_metrizable_space s :=
+inducing_coe.pseudo_metrizable_space
+
+instance pseudo_metrizable_space_pi [Π i, pseudo_metrizable_space (π i)] :
+  pseudo_metrizable_space (Π i, π i) :=
+by { casesI nonempty_fintype ι, letI := λ i, pseudo_metrizable_space_pseudo_metric (π i),
+  apply_instance }
+
 /-- A topological space is metrizable if there exists a metric space structure compatible with the
 topology. To endow such a space with a compatible distance, use
-`letI : metric_space α := metrizable_space_metric α` -/
-class metrizable_space (α : Type*) [t : topological_space α] : Prop :=
-(exists_metric : ∃ (m : metric_space α), m.to_uniform_space.to_topological_space = t)
+`letI : metric_space X := topological_space.metrizable_space_metric X` -/
+class metrizable_space (X : Type*) [t : topological_space X] : Prop :=
+(exists_metric : ∃ (m : metric_space X), m.to_uniform_space.to_topological_space = t)
 
 @[priority 100]
-instance _root_.metric_space.to_metrizable_space {α : Type*} [m : metric_space α] :
-  metrizable_space α :=
+instance _root_.metric_space.to_metrizable_space {X : Type*} [m : metric_space X] :
+  metrizable_space X :=
 ⟨⟨m, rfl⟩⟩
 
+@[priority 100]
+instance metrizable_space.to_pseudo_metrizable_space [h : metrizable_space X] :
+  pseudo_metrizable_space X :=
+⟨let ⟨m, hm⟩ := h.1 in ⟨m.to_pseudo_metric_space, hm⟩⟩
+
 /-- Construct on a metrizable space a metric compatible with the topology. -/
-noncomputable def metrizable_space_metric
-  (α : Type*) [topological_space α] [h : metrizable_space α] :
-  metric_space α :=
+noncomputable def metrizable_space_metric (X : Type*) [topological_space X]
+  [h : metrizable_space X] :
+  metric_space X :=
 h.exists_metric.some.replace_topology h.exists_metric.some_spec.symm
 
 @[priority 100]
-instance t2_space_of_metrizable_space
-  (α : Type*) [topological_space α] [metrizable_space α] : t2_space α :=
-by { letI : metric_space α := metrizable_space_metric α, apply_instance }
+instance t2_space_of_metrizable_space [metrizable_space X] : t2_space X :=
+by { letI : metric_space X := metrizable_space_metric X, apply_instance }
 
-instance metrizable_space_prod (α : Type*) [topological_space α] [metrizable_space α]
-  (β : Type*) [topological_space β] [metrizable_space β] :
-  metrizable_space (α × β) :=
+instance metrizable_space_prod [metrizable_space X] [metrizable_space Y] :
+  metrizable_space (X × Y) :=
 begin
-  letI : metric_space α := metrizable_space_metric α,
-  letI : metric_space β := metrizable_space_metric β,
+  letI : metric_space X := metrizable_space_metric X,
+  letI : metric_space Y := metrizable_space_metric Y,
   apply_instance
 end
 
-instance metrizable_space.subtype {α : Type*} [topological_space α] [metrizable_space α]
-  (s : set α) : metrizable_space s :=
-by { letI := metrizable_space_metric α, apply_instance }
-
 /-- Given an embedding of a topological space into a metrizable space, the source space is also
 metrizable. -/
-lemma _root_.embedding.metrizable_space {α β : Type*} [topological_space α] [topological_space β]
-  [metrizable_space β] {f : α → β} (hf : embedding f) :
-  metrizable_space α :=
+lemma _root_.embedding.metrizable_space [metrizable_space Y] {f : X → Y} (hf : embedding f) :
+  metrizable_space X :=
 begin
-  letI : metric_space β := metrizable_space_metric β,
+  letI : metric_space Y := metrizable_space_metric Y,
   exact ⟨⟨hf.comap_metric_space f, rfl⟩⟩
 end
 
-variables (X : Type*) [topological_space X] [normal_space X] [second_countable_topology X]
+instance metrizable_space.subtype [metrizable_space X] (s : set X) : metrizable_space s :=
+embedding_subtype_coe.metrizable_space
+
+instance metrizable_space_pi [Π i, metrizable_space (π i)] : metrizable_space (Π i, π i) :=
+by { casesI nonempty_fintype ι, letI := λ i, metrizable_space_metric (π i), apply_instance }
+
+variables (X) [t3_space X] [second_countable_topology X]
 
-/-- A normal topological space with second countable topology can be embedded into `l^∞ = ℕ →ᵇ ℝ`.
+/-- A T₃ topological space with second countable topology can be embedded into `l^∞ = ℕ →ᵇ ℝ`.
 -/
 lemma exists_embedding_l_infty : ∃ f : X → (ℕ →ᵇ ℝ), embedding f :=
 begin
+  haveI : normal_space X := normal_space_of_t3_second_countable X,
   -- Choose a countable basis, and consider the set `s` of pairs of set `(U, V)` such that `U ∈ B`,
   -- `V ∈ B`, and `closure U ⊆ V`.
   rcases exists_countable_basis X with ⟨B, hBc, -, hB⟩,
@@ -83,9 +151,8 @@ begin
   -- We don't have the space of bounded (possibly discontinuous) functions, so we equip `s`
   -- with the discrete topology and deal with `s →ᵇ ℝ` instead.
   letI : topological_space s := ⊥, haveI : discrete_topology s := ⟨rfl⟩,
-  suffices : ∃ f : X → (s →ᵇ ℝ), embedding f,
-  { rcases this with ⟨f, hf⟩,
-    exact ⟨λ x, (f x).extend (encodable.encode' s) 0, (bounded_continuous_function.isometry_extend
+  rsuffices ⟨f, hf⟩ : ∃ f : X → (s →ᵇ ℝ), embedding f,
+  { exact ⟨λ x, (f x).extend (encodable.encode' s) 0, (bounded_continuous_function.isometry_extend
       (encodable.encode' s) (0 : ℕ →ᵇ ℝ)).embedding.comp hf⟩ },
   have hd : ∀ UV : s, disjoint (closure UV.1.1) (UV.1.2ᶜ) :=
     λ UV, disjoint_compl_right.mono_right (compl_subset_compl.2 UV.2.2),
@@ -142,7 +209,7 @@ begin
     `(U, V) ∈ T`. For `(U, V) ∉ T`, the same inequality is true because both `F y (U, V)` and
     `F x (U, V)` belong to the interval `[0, ε (U, V)]`. -/
     refine (nhds_basis_closed_ball.comap _).ge_iff.2 (λ δ δ0, _),
-    have h_fin : finite {UV : s | δ ≤ ε UV}, by simpa only [← not_lt] using hε (gt_mem_nhds δ0),
+    have h_fin : {UV : s | δ ≤ ε UV}.finite, by simpa only [← not_lt] using hε (gt_mem_nhds δ0),
     have : ∀ᶠ y in 𝓝 x, ∀ UV, δ ≤ ε UV → dist (F y UV) (F x UV) ≤ δ,
     { refine (eventually_all_finite h_fin).2 (λ UV hUV, _),
       exact (f UV).continuous.tendsto x (closed_ball_mem_nhds _ δ0) },
@@ -151,11 +218,12 @@ begin
     exacts [hy _ hle, (real.dist_le_of_mem_Icc (hf0ε _ _) (hf0ε _ _)).trans (by rwa sub_zero)] }
 end
 
-/-- A normal topological space with second countable topology `X` is metrizable: there exists a
-metric space structure that generates the same topology. -/
-lemma metrizable_space_of_normal_second_countable : metrizable_space X :=
+/-- *Urysohn's metrization theorem* (Tychonoff's version): a T₃ topological space with second
+countable topology `X` is metrizable, i.e., there exists a metric space structure that generates the
+same topology. -/
+lemma metrizable_space_of_t3_second_countable : metrizable_space X :=
 let ⟨f, hf⟩ := exists_embedding_l_infty X in hf.metrizable_space
 
-instance : metrizable_space ennreal := metrizable_space_of_normal_second_countable ennreal
+instance : metrizable_space ennreal := metrizable_space_of_t3_second_countable ennreal
 
 end topological_space
diff --git a/src/topology/metric_space/metrizable_uniformity.lean b/src/topology/metric_space/metrizable_uniformity.lean
new file mode 100644
index 0000000000000..594f03f511223
--- /dev/null
+++ b/src/topology/metric_space/metrizable_uniformity.lean
@@ -0,0 +1,259 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.metric_space.metrizable
+
+/-!
+# Metrizable uniform spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove that a uniform space with countably generated uniformity filter is
+pseudometrizable: there exists a `pseudo_metric_space` structure that generates the same uniformity.
+The proof follows [Sergey Melikhov, Metrizable uniform spaces][melikhov2011].
+## Main definitions
+
+* `pseudo_metric_space.of_prenndist`: given a function `d : X → X → ℝ≥0` such that `d x x = 0` and
+  `d x y = d y x` for all `x y : X`, constructs the maximal pseudo metric space structure such that
+  `nndist x y ≤ d x y` for all `x y : X`.
+
+* `uniform_space.pseudo_metric_space`: given a uniform space `X` with countably generated `𝓤 X`,
+  constructs a `pseudo_metric_space X` instance that is compatible with the uniform space structure.
+
+* `uniform_space.metric_space`: given a T₀ uniform space `X` with countably generated `𝓤 X`,
+  constructs a `metric_space X` instance that is compatible with the uniform space structure.
+
+## Main statements
+
+* `uniform_space.metrizable_uniformity`: if `X` is a uniform space with countably generated `𝓤 X`,
+  then there exists a `pseudo_metric_space` structure that is compatible with this `uniform_space`
+  structure. Use `uniform_space.pseudo_metric_space` or `uniform_space.metric_space` instead.
+
+* `uniform_space.pseudo_metrizable_space`: a uniform space with countably generated `𝓤 X` is pseudo
+  metrizable.
+
+* `uniform_space.metrizable_space`: a T₀ uniform space with countably generated `𝓤 X` is
+  metrizable. This is not an instance to avoid loops.
+
+## Tags
+
+metrizable space, uniform space
+-/
+
+open set function metric list filter
+open_locale nnreal filter uniformity
+
+variables {X : Type*}
+
+namespace pseudo_metric_space
+
+/-- The maximal pseudo metric space structure on `X` such that `dist x y ≤ d x y` for all `x y`,
+where `d : X → X → ℝ≥0` is a function such that `d x x = 0` and `d x y = d y x` for all `x`, `y`. -/
+noncomputable def of_prenndist (d : X → X → ℝ≥0) (dist_self : ∀ x, d x x = 0)
+  (dist_comm : ∀ x y, d x y = d y x) :
+  pseudo_metric_space X :=
+{ dist := λ x y, ↑(⨅ l : list X, ((x :: l).zip_with d (l ++ [y])).sum : ℝ≥0),
+  dist_self := λ x, (nnreal.coe_eq_zero _).2 $ nonpos_iff_eq_zero.1 $
+    (cinfi_le (order_bot.bdd_below _) []).trans_eq $ by simp [dist_self],
+  dist_comm := λ x y, nnreal.coe_eq.2 $
+    begin
+      refine reverse_surjective.infi_congr _ (λ l, _),
+      rw [← sum_reverse, zip_with_distrib_reverse, reverse_append, reverse_reverse,
+        reverse_singleton, singleton_append, reverse_cons, reverse_reverse,
+        zip_with_comm_of_comm _ dist_comm],
+      simp only [length, length_append]
+    end,
+  dist_triangle := λ x y z,
+    begin
+      rw [← nnreal.coe_add, nnreal.coe_le_coe],
+      refine nnreal.le_infi_add_infi (λ lxy lyz, _),
+      calc (⨅ l, (zip_with d (x :: l) (l ++ [z])).sum) ≤
+        (zip_with d (x :: (lxy ++ y :: lyz)) ((lxy ++ y :: lyz) ++ [z])).sum :
+        cinfi_le (order_bot.bdd_below _) (lxy ++ y :: lyz)
+      ... = (zip_with d (x :: lxy) (lxy ++ [y])).sum + (zip_with d (y :: lyz) (lyz ++ [z])).sum : _,
+      rw [← sum_append, ← zip_with_append, cons_append, ← @singleton_append _ y, append_assoc,
+        append_assoc, append_assoc],
+      rw [length_cons, length_append, length_singleton]
+    end }
+
+lemma dist_of_prenndist (d : X → X → ℝ≥0) (dist_self : ∀ x, d x x = 0)
+  (dist_comm : ∀ x y, d x y = d y x) (x y : X) :
+  @dist X (@pseudo_metric_space.to_has_dist X
+    (pseudo_metric_space.of_prenndist d dist_self dist_comm)) x y =
+    ↑(⨅ l : list X, ((x :: l).zip_with d (l ++ [y])).sum : ℝ≥0) := rfl
+
+lemma dist_of_prenndist_le (d : X → X → ℝ≥0) (dist_self : ∀ x, d x x = 0)
+  (dist_comm : ∀ x y, d x y = d y x) (x y : X) :
+  @dist X (@pseudo_metric_space.to_has_dist X
+    (pseudo_metric_space.of_prenndist d dist_self dist_comm)) x y ≤ d x y :=
+nnreal.coe_le_coe.2 $ (cinfi_le (order_bot.bdd_below _) []).trans_eq $ by simp
+
+/-- Consider a function `d : X → X → ℝ≥0` such that `d x x = 0` and `d x y = d y x` for all `x`,
+`y`. Let `dist` be the largest pseudometric distance such that `dist x y ≤ d x y`, see
+`pseudo_metric_space.of_prenndist`. Suppose that `d` satisfies the following triangle-like
+inequality: `d x₁ x₄ ≤ 2 * max (d x₁ x₂, d x₂ x₃, d x₃ x₄)`. Then `d x y ≤ 2 * dist x y` for all
+`x`, `y`. -/
+lemma le_two_mul_dist_of_prenndist (d : X → X → ℝ≥0) (dist_self : ∀ x, d x x = 0)
+  (dist_comm : ∀ x y, d x y = d y x)
+  (hd : ∀ x₁ x₂ x₃ x₄, d x₁ x₄ ≤ 2 * max (d x₁ x₂) (max (d x₂ x₃) (d x₃ x₄))) (x y : X) :
+  ↑(d x y) ≤ 2 * @dist X (@pseudo_metric_space.to_has_dist X
+    (pseudo_metric_space.of_prenndist d dist_self dist_comm)) x y :=
+begin
+  /- We need to show that `d x y` is at most twice the sum `L` of `d xᵢ xᵢ₊₁` over a path
+  `x₀=x, ..., xₙ=y`. We prove it by induction on the length `n` of the sequence. Find an edge that
+  splits the path into two parts of almost equal length: both `d x₀ x₁ + ... + d xₖ₋₁ xₖ` and
+  `d xₖ₊₁ xₖ₊₂ + ... + d xₙ₋₁ xₙ` are less than or equal to `L / 2`.
+  Then `d x₀ xₖ ≤ L`, `d xₖ xₖ₊₁ ≤ L`, and `d xₖ₊₁ xₙ ≤ L`, thus `d x₀ xₙ ≤ 2 * L`. -/
+  rw [dist_of_prenndist, ← nnreal.coe_two, ← nnreal.coe_mul, nnreal.mul_infi, nnreal.coe_le_coe],
+  refine le_cinfi (λ l, _),
+  have hd₀_trans : transitive (λ x y, d x y = 0),
+  { intros a b c hab hbc,
+    rw ← nonpos_iff_eq_zero,
+    simpa only [*, max_eq_right, mul_zero] using hd a b c c },
+  haveI : is_trans X (λ x y, d x y = 0) := ⟨hd₀_trans⟩,
+  induction hn : length l using nat.strong_induction_on with n ihn generalizing x y l,
+  simp only at ihn, subst n,
+  set L := zip_with d (x :: l) (l ++ [y]),
+  have hL_len : length L = length l + 1, by simp,
+  cases eq_or_ne (d x y) 0 with hd₀ hd₀, { simp only [hd₀, zero_le] },
+  rsuffices ⟨z, z', hxz, hzz', hz'y⟩ : ∃ z z' : X, d x z ≤ L.sum ∧ d z z' ≤ L.sum ∧ d z' y ≤ L.sum,
+  { exact (hd x z z' y).trans (mul_le_mul_left' (max_le hxz (max_le hzz' hz'y)) _) },
+  set s : set ℕ := {m : ℕ | 2 * (take m L).sum ≤ L.sum},
+  have hs₀ : 0 ∈ s, by simp [s],
+  have hsne : s.nonempty, from ⟨0, hs₀⟩,
+  obtain ⟨M, hMl, hMs⟩ : ∃ M ≤ length l, is_greatest s M,
+  { have hs_ub : length l ∈ upper_bounds s,
+    { intros m hm,
+      rw [← not_lt, nat.lt_iff_add_one_le, ← hL_len],
+      intro hLm,
+      rw [mem_set_of_eq, take_all_of_le hLm, two_mul, add_le_iff_nonpos_left, nonpos_iff_eq_zero,
+        sum_eq_zero_iff, ← all₂_iff_forall, all₂_zip_with, ← chain_append_singleton_iff_forall₂]
+        at hm; [skip, by simp],
+      exact hd₀ (hm.rel (mem_append.2 $ or.inr $ mem_singleton_self _)) },
+    have hs_bdd : bdd_above s, from ⟨length l, hs_ub⟩,
+    exact ⟨Sup s, cSup_le hsne hs_ub, ⟨nat.Sup_mem hsne hs_bdd, λ k, le_cSup hs_bdd⟩⟩ },
+  have hM_lt : M < length L, by rwa [hL_len, nat.lt_succ_iff],
+  have hM_ltx : M < length (x :: l), from lt_length_left_of_zip_with hM_lt,
+  have hM_lty : M < length (l ++ [y]), from lt_length_right_of_zip_with hM_lt,
+  refine ⟨(x :: l).nth_le M hM_ltx, (l ++ [y]).nth_le M hM_lty, _, _, _⟩,
+  { cases M, { simp [dist_self] },
+    rw nat.succ_le_iff at hMl,
+    have hMl' : length (take M l) = M, from (length_take _ _).trans (min_eq_left hMl.le),
+    simp only [nth_le],
+    refine (ihn _ hMl _ _ _ hMl').trans _,
+    convert hMs.1.out,
+    rw [zip_with_distrib_take, take, take_succ, nth_append hMl, nth_le_nth hMl,
+      ← option.coe_def, option.to_list_some, take_append_of_le_length hMl.le],
+    refl },
+  { refine single_le_sum (λ x hx, zero_le x) _ (mem_iff_nth_le.2 ⟨M, hM_lt, _⟩),
+    apply nth_le_zip_with },
+  { rcases hMl.eq_or_lt with rfl|hMl,
+    { simp only [nth_le_append_right le_rfl, sub_self, nth_le_singleton, dist_self, zero_le] },
+    rw [nth_le_append _ hMl],
+    have hlen : length (drop (M + 1) l) = length l - (M + 1), from length_drop _ _,
+    have hlen_lt : length l - (M + 1) < length l, from nat.sub_lt_of_pos_le _ _ M.succ_pos hMl,
+    refine (ihn _ hlen_lt _ y _ hlen).trans _,
+    rw [cons_nth_le_drop_succ],
+    have hMs' : L.sum ≤ 2 * (L.take (M + 1)).sum,
+      from not_lt.1 (λ h, (hMs.2 h.le).not_lt M.lt_succ_self),
+    rw [← sum_take_add_sum_drop L (M + 1), two_mul, add_le_add_iff_left,
+      ← add_le_add_iff_right, sum_take_add_sum_drop, ← two_mul] at hMs',
+    convert hMs',
+    rwa [zip_with_distrib_drop, drop, drop_append_of_le_length] }
+end
+
+end pseudo_metric_space
+
+/-- If `X` is a uniform space with countably generated uniformity filter, there exists a
+`pseudo_metric_space` structure compatible with the `uniform_space` structure. Use
+`uniform_space.pseudo_metric_space` or `uniform_space.metric_space` instead. -/
+protected lemma uniform_space.metrizable_uniformity (X : Type*) [uniform_space X]
+  [is_countably_generated (𝓤 X)] :
+  ∃ I : pseudo_metric_space X, I.to_uniform_space = ‹_› :=
+begin
+  /- Choose a fast decreasing antitone basis `U : ℕ → set (X × X)` of the uniformity filter `𝓤 X`.
+  Define `d x y : ℝ≥0` to be `(1 / 2) ^ n`, where `n` is the minimal index of `U n` that separates
+  `x` and `y`: `(x, y) ∉ U n`, or `0` if `x` is not separated from `y`. This function satisfies the
+  assumptions of `pseudo_metric_space.of_prenndist` and
+  `pseudo_metric_space.le_two_mul_dist_of_prenndist`, hence the distance given by the former pseudo
+  metric space structure is Lipschitz equivalent to the `d`. Thus the uniformities generated by
+  `d` and `dist` are equal. Since the former uniformity is equal to `𝓤 X`, the latter is equal to
+  `𝓤 X` as well. -/
+  classical,
+  obtain ⟨U, hU_symm, hU_comp, hB⟩ : ∃ U : ℕ → set (X × X), (∀ n, symmetric_rel (U n)) ∧
+    (∀ ⦃m n⦄, m < n → U n ○ (U n ○ U n) ⊆ U m) ∧ (𝓤 X).has_antitone_basis U,
+  { rcases uniform_space.has_seq_basis X with ⟨V, hB, hV_symm⟩,
+    rcases hB.subbasis_with_rel (λ m, hB.tendsto_small_sets.eventually
+      (eventually_uniformity_iterate_comp_subset (hB.mem m) 2)) with ⟨φ, hφ_mono, hφ_comp, hφB⟩,
+    exact ⟨V ∘ φ, λ n, hV_symm _, hφ_comp, hφB⟩ },
+  letI := uniform_space.separation_setoid X,
+  set d : X → X → ℝ≥0 := λ x y, if h : ∃ n, (x, y) ∉ U n then (1 / 2) ^ nat.find h else 0,
+  have hd₀ : ∀ {x y}, d x y = 0 ↔ x ≈ y,
+  { intros x y, dsimp only [d],
+    refine iff.trans _ hB.to_has_basis.mem_separation_rel.symm,
+    simp only [true_implies_iff],
+    split_ifs with h,
+    { rw [← not_forall] at h, simp [h, pow_eq_zero_iff'] },
+    { simpa only [not_exists, not_not, eq_self_iff_true, true_iff] using h } },
+  have hd_symm : ∀ x y, d x y = d y x,
+  { intros x y, dsimp only [d],
+    simp only [@symmetric_rel.mk_mem_comm _ _ (hU_symm _) x y] },
+  have hr : (1 / 2 : ℝ≥0) ∈ Ioo (0 : ℝ≥0) 1,
+    from ⟨half_pos one_pos, nnreal.half_lt_self one_ne_zero⟩,
+  letI I := pseudo_metric_space.of_prenndist d (λ x, hd₀.2 (setoid.refl _)) hd_symm,
+  have hdist_le : ∀ x y, dist x y ≤ d x y,
+    from pseudo_metric_space.dist_of_prenndist_le _ _ _,
+  have hle_d : ∀ {x y : X} {n : ℕ}, (1 / 2) ^ n ≤ d x y ↔ (x, y) ∉ U n,
+  { intros x y n,
+    simp only [d], split_ifs with h,
+    { rw [(strict_anti_pow hr.1 hr.2).le_iff_le, nat.find_le_iff],
+      exact ⟨λ ⟨m, hmn, hm⟩ hn, hm (hB.antitone hmn hn), λ h, ⟨n, le_rfl, h⟩⟩ },
+    { push_neg at h,
+      simp only [h, not_true, (pow_pos hr.1 _).not_le] } },
+  have hd_le : ∀ x y, ↑(d x y) ≤ 2 * dist x y,
+  { refine pseudo_metric_space.le_two_mul_dist_of_prenndist _ _ _ (λ x₁ x₂ x₃ x₄, _),
+    by_cases H : ∃ n, (x₁, x₄) ∉ U n,
+    { refine (dif_pos H).trans_le _,
+      rw [← nnreal.div_le_iff' two_ne_zero, ← mul_one_div (_ ^ _), ← pow_succ'],
+      simp only [le_max_iff, hle_d, ← not_and_distrib],
+      rintro ⟨h₁₂, h₂₃, h₃₄⟩,
+      refine nat.find_spec H (hU_comp (lt_add_one $ nat.find H) _),
+      exact ⟨x₂, h₁₂, x₃, h₂₃, h₃₄⟩ },
+    { exact (dif_neg H).trans_le (zero_le _) } },
+  refine ⟨I, uniform_space_eq $ (uniformity_basis_dist_pow hr.1 hr.2).ext hB.to_has_basis _ _⟩,
+  { refine λ n hn, ⟨n, hn, λ x hx, (hdist_le _ _).trans_lt _⟩,
+    rwa [← nnreal.coe_pow, nnreal.coe_lt_coe, ← not_le, hle_d, not_not, prod.mk.eta] },
+  { refine λ n hn, ⟨n + 1, trivial, λ x hx, _⟩,
+    rw [mem_set_of_eq] at hx,
+    contrapose! hx,
+    refine le_trans _ ((div_le_iff' (zero_lt_two' ℝ)).2 (hd_le x.1 x.2)),
+    rwa [← nnreal.coe_two, ← nnreal.coe_div, ← nnreal.coe_pow, nnreal.coe_le_coe, pow_succ',
+      mul_one_div, nnreal.div_le_iff two_ne_zero, div_mul_cancel _ (two_ne_zero' ℝ≥0),
+      hle_d, prod.mk.eta] }
+end
+
+/-- A `pseudo_metric_space` instance compatible with a given `uniform_space` structure. -/
+protected noncomputable def uniform_space.pseudo_metric_space (X : Type*) [uniform_space X]
+  [is_countably_generated (𝓤 X)] : pseudo_metric_space X :=
+(uniform_space.metrizable_uniformity X).some.replace_uniformity $
+  congr_arg _ (uniform_space.metrizable_uniformity X).some_spec.symm
+
+/-- A `metric_space` instance compatible with a given `uniform_space` structure. -/
+protected noncomputable def uniform_space.metric_space (X : Type*) [uniform_space X]
+  [is_countably_generated (𝓤 X)] [t0_space X] : metric_space X :=
+@metric_space.of_t0_pseudo_metric_space X (uniform_space.pseudo_metric_space X) _
+
+/-- A uniform space with countably generated `𝓤 X` is pseudo metrizable. -/
+@[priority 100]
+instance uniform_space.pseudo_metrizable_space [uniform_space X] [is_countably_generated (𝓤 X)] :
+  topological_space.pseudo_metrizable_space X :=
+by { letI := uniform_space.pseudo_metric_space X, apply_instance }
+
+/-- A T₀ uniform space with countably generated `𝓤 X` is metrizable. This is not an instance to
+avoid loops. -/
+lemma uniform_space.metrizable_space [uniform_space X] [is_countably_generated (𝓤 X)] [t0_space X] :
+  topological_space.metrizable_space X :=
+by { letI := uniform_space.metric_space X, apply_instance }
diff --git a/src/topology/metric_space/partition_of_unity.lean b/src/topology/metric_space/partition_of_unity.lean
new file mode 100644
index 0000000000000..7088b4bb42ef6
--- /dev/null
+++ b/src/topology/metric_space/partition_of_unity.lean
@@ -0,0 +1,148 @@
+/-
+Copyright (c) 2022 Yury Kudryashov. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yury Kudryashov
+-/
+import topology.metric_space.emetric_paracompact
+import analysis.convex.partition_of_unity
+
+/-!
+# Lemmas about (e)metric spaces that need partition of unity
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+The main lemma in this file (see `metric.exists_continuous_real_forall_closed_ball_subset`) says the
+following. Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets,
+let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
+positive continuous function `δ : C(X, → ℝ)` such that for any `i` and `x ∈ K i`, we have
+`metric.closed_ball x (δ x) ⊆ U i`. We also formulate versions of this lemma for extended metric
+spaces and for different codomains (`ℝ`, `ℝ≥0`, and `ℝ≥0∞`).
+
+We also prove a few auxiliary lemmas to be used later in a proof of the smooth version of this
+lemma.
+
+## Tags
+
+metric space, partition of unity, locally finite
+-/
+
+open_locale topology ennreal big_operators nnreal filter
+open set function filter topological_space
+
+variables {ι X : Type*}
+
+namespace emetric
+
+variables [emetric_space X] {K : ι → set X} {U : ι → set X}
+
+/-- Let `K : ι → set X` be a locally finitie family of closed sets in an emetric space. Let
+`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then for any point
+`x : X`, for sufficiently small `r : ℝ≥0∞` and for `y` sufficiently close to `x`, for all `i`, if
+`y ∈ K i`, then `emetric.closed_ball y r ⊆ U i`. -/
+lemma eventually_nhds_zero_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) (x : X) :
+  ∀ᶠ p : ℝ≥0∞ × X in 𝓝 0 ×ᶠ 𝓝 x, ∀ i, p.2 ∈ K i → closed_ball p.2 p.1 ⊆ U i :=
+begin
+  suffices : ∀ i, x ∈ K i → ∀ᶠ p : ℝ≥0∞ × X in 𝓝 0 ×ᶠ 𝓝 x, closed_ball p.2 p.1 ⊆ U i,
+  { filter_upwards [tendsto_snd (hfin.Inter_compl_mem_nhds hK x),
+      (eventually_all_finite (hfin.point_finite x)).2 this],
+    rintro ⟨r, y⟩ hxy hyU i hi,
+    simp only [mem_Inter₂, mem_compl_iff, not_imp_not, mem_preimage] at hxy,
+    exact hyU _ (hxy _ hi) },
+  intros i hi,
+  rcases nhds_basis_closed_eball.mem_iff.1 ((hU i).mem_nhds $ hKU i hi) with ⟨R, hR₀, hR⟩,
+  rcases ennreal.lt_iff_exists_nnreal_btwn.mp hR₀ with ⟨r, hr₀, hrR⟩,
+  filter_upwards [prod_mem_prod (eventually_lt_nhds hr₀)
+    (closed_ball_mem_nhds x (tsub_pos_iff_lt.2 hrR))] with p hp z hz,
+  apply hR,
+  calc edist z x ≤ edist z p.2 + edist p.2 x : edist_triangle _ _ _
+  ... ≤ p.1 + (R - p.1) : add_le_add hz $ le_trans hp.2 $ tsub_le_tsub_left hp.1.out.le _
+  ... = R : add_tsub_cancel_of_le (lt_trans hp.1 hrR).le,
+end
+
+lemma exists_forall_closed_ball_subset_aux₁ (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) (x : X) :
+  ∃ r : ℝ, ∀ᶠ y in 𝓝 x, r ∈ Ioi (0 : ℝ) ∩
+    ennreal.of_real ⁻¹' ⋂ i (hi : y ∈ K i), {r | closed_ball y r ⊆ U i} :=
+begin
+  have := (ennreal.continuous_of_real.tendsto' 0 0 ennreal.of_real_zero).eventually
+    (eventually_nhds_zero_forall_closed_ball_subset hK hU hKU hfin x).curry,
+  rcases this.exists_gt with ⟨r, hr0, hr⟩,
+  refine ⟨r, hr.mono (λ y hy, ⟨hr0, _⟩)⟩,
+  rwa [mem_preimage, mem_Inter₂]
+end
+
+lemma exists_forall_closed_ball_subset_aux₂ (y : X) :
+  convex ℝ (Ioi (0 : ℝ) ∩ ennreal.of_real ⁻¹' ⋂ i (hi : y ∈ K i), {r | closed_ball y r ⊆ U i}) :=
+(convex_Ioi _).inter $ ord_connected.convex $ ord_connected.preimage_ennreal_of_real $
+  ord_connected_Inter $ λ i, ord_connected_Inter $
+    λ hi, ord_connected_set_of_closed_ball_subset y (U i)
+
+/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
+sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
+exists a positive continuous function `δ : C(X, ℝ)` such that for any `i` and `x ∈ K i`,
+we have `emetric.closed_ball x (ennreal.of_real (δ x)) ⊆ U i`. -/
+lemma exists_continuous_real_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
+  ∃ δ : C(X, ℝ), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (ennreal.of_real $ δ x) ⊆ U i :=
+by simpa only [mem_inter_iff, forall_and_distrib, mem_preimage, mem_Inter, @forall_swap ι X]
+  using exists_continuous_forall_mem_convex_of_local_const exists_forall_closed_ball_subset_aux₂
+    (exists_forall_closed_ball_subset_aux₁ hK hU hKU hfin)
+
+/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
+sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
+exists a positive continuous function `δ : C(X, ℝ≥0)` such that for any `i` and `x ∈ K i`,
+we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
+lemma exists_continuous_nnreal_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
+  ∃ δ : C(X, ℝ≥0), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
+begin
+  rcases exists_continuous_real_forall_closed_ball_subset hK hU hKU hfin with ⟨δ, hδ₀, hδ⟩,
+  lift δ to C(X, ℝ≥0) using λ x, (hδ₀ x).le,
+  refine ⟨δ, hδ₀, λ i x hi, _⟩,
+  simpa only [← ennreal.of_real_coe_nnreal] using hδ i x hi
+end
+
+/-- Let `X` be an extended metric space. Let `K : ι → set X` be a locally finite family of closed
+sets, let `U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there
+exists a positive continuous function `δ : C(X, ℝ≥0∞)` such that for any `i` and `x ∈ K i`,
+we have `emetric.closed_ball x (δ x) ⊆ U i`. -/
+lemma exists_continuous_ennreal_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
+  ∃ δ : C(X, ℝ≥0∞), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
+let ⟨δ, hδ₀, hδ⟩ := exists_continuous_nnreal_forall_closed_ball_subset hK hU hKU hfin
+in ⟨continuous_map.comp ⟨coe, ennreal.continuous_coe⟩ δ, λ x, ennreal.coe_pos.2 (hδ₀ x), hδ⟩
+
+end emetric
+
+namespace metric
+
+variables [metric_space X] {K : ι → set X} {U : ι → set X}
+
+/-- Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets, let
+`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
+positive continuous function `δ : C(X, ℝ≥0)` such that for any `i` and `x ∈ K i`, we have
+`metric.closed_ball x (δ x) ⊆ U i`. -/
+lemma exists_continuous_nnreal_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
+  ∃ δ : C(X, ℝ≥0), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
+begin
+  rcases emetric.exists_continuous_nnreal_forall_closed_ball_subset hK hU hKU hfin
+    with ⟨δ, hδ0, hδ⟩,
+  refine ⟨δ, hδ0, λ i x hx, _⟩,
+  rw [← emetric_closed_ball_nnreal],
+  exact hδ i x hx
+end
+
+/-- Let `X` be a metric space. Let `K : ι → set X` be a locally finite family of closed sets, let
+`U : ι → set X` be a family of open sets such that `K i ⊆ U i` for all `i`. Then there exists a
+positive continuous function `δ : C(X, ℝ)` such that for any `i` and `x ∈ K i`, we have
+`metric.closed_ball x (δ x) ⊆ U i`. -/
+lemma exists_continuous_real_forall_closed_ball_subset (hK : ∀ i, is_closed (K i))
+  (hU : ∀ i, is_open (U i)) (hKU : ∀ i, K i ⊆ U i) (hfin : locally_finite K) :
+  ∃ δ : C(X, ℝ), (∀ x, 0 < δ x) ∧ ∀ i (x ∈ K i), closed_ball x (δ x) ⊆ U i :=
+let ⟨δ, hδ₀, hδ⟩ := exists_continuous_nnreal_forall_closed_ball_subset hK hU hKU hfin
+in ⟨continuous_map.comp ⟨coe, nnreal.continuous_coe⟩ δ, hδ₀, hδ⟩
+
+end metric
diff --git a/src/topology/metric_space/pi_nat.lean b/src/topology/metric_space/pi_nat.lean
index fc54cfe6d20dd..5311742e8272f 100644
--- a/src/topology/metric_space/pi_nat.lean
+++ b/src/topology/metric_space/pi_nat.lean
@@ -9,6 +9,9 @@ import topology.metric_space.hausdorff_distance
 /-!
 # Topological study of spaces `Π (n : ℕ), E n`
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 When `E n` are topological spaces, the space `Π (n : ℕ), E n` is naturally a topological space
 (with the product topology). When `E n` are uniform spaces, it also inherits a uniform structure.
 However, it does not inherit a canonical metric space structure of the `E n`. Nevertheless, one
@@ -49,7 +52,7 @@ in general), and `ι` is countable.
 -/
 
 noncomputable theory
-open_locale classical topological_space filter
+open_locale classical topology filter
 open topological_space set metric filter function
 
 local attribute [simp] pow_le_pow_iff one_lt_two inv_le_inv
@@ -193,6 +196,60 @@ lemma update_mem_cylinder (x : Π n, E n) (n : ℕ) (y : E n) :
   update x n y ∈ cylinder x n :=
 mem_cylinder_iff.2 (λ i hi, by simp [hi.ne])
 
+section res
+
+variable {α : Type*}
+open list
+
+/-- In the case where `E` has constant value `α`,
+the cylinder `cylinder x n` can be identified with the element of `list α`
+consisting of the first `n` entries of `x`. See `cylinder_eq_res`.
+We call this list `res x n`, the restriction of `x` to `n`.-/
+def res (x : ℕ → α) : ℕ → list α
+| 0            := nil
+| (nat.succ n) := x n :: res n
+
+@[simp] lemma res_zero (x : ℕ → α) : res x 0 = @nil α := rfl
+@[simp] lemma res_succ (x : ℕ → α) (n : ℕ) : res x n.succ = x n :: res x n := rfl
+
+@[simp] lemma res_length (x : ℕ → α) (n : ℕ) : (res x n).length = n :=
+by induction n; simp [*]
+
+/-- The restrictions of `x` and `y` to `n` are equal if and only if `x m = y m` for all `m < n`.-/
+lemma res_eq_res {x y : ℕ → α} {n : ℕ} : res x n = res y n ↔ ∀ ⦃m⦄, m < n → x m = y m :=
+begin
+  split; intro h; induction n with n ih, { simp },
+  { intros m hm,
+    rw nat.lt_succ_iff_lt_or_eq at hm,
+    simp only [res_succ] at h,
+    cases hm with hm hm,
+    { exact ih h.2 hm },
+    rw hm,
+    exact h.1, },
+  { simp },
+  simp only [res_succ],
+  refine ⟨h (nat.lt_succ_self _), ih (λ m hm, _)⟩,
+  exact h (hm.trans (nat.lt_succ_self _)),
+end
+
+lemma res_injective : injective (@res α) :=
+begin
+  intros x y h,
+  ext n,
+  apply (res_eq_res).mp _ (nat.lt_succ_self _),
+  rw h,
+end
+
+/-- `cylinder x n` is equal to the set of sequences `y` with the same restriction to `n` as `x`.-/
+theorem cylinder_eq_res (x : ℕ → α) (n : ℕ) : cylinder x n = {y | res y n = res x n} :=
+begin
+  ext y,
+  dsimp [cylinder],
+  rw res_eq_res,
+end
+
+end res
+
 /-!
 ### A distance function on `Π n, E n`
 
@@ -236,7 +293,7 @@ begin
   { simp },
   rcases eq_or_ne y z with rfl|hyz,
   { simp },
-  simp only [dist_eq_of_ne, hxz, hxy, hyz, inv_le_inv, one_div, inv_pow₀, zero_lt_bit0,
+  simp only [dist_eq_of_ne, hxz, hxy, hyz, inv_le_inv, one_div, inv_pow, zero_lt_bit0,
     ne.def, not_false_iff, le_max_iff, zero_lt_one, pow_le_pow_iff, one_lt_two, pow_pos,
     min_le_iff.1 (min_first_diff_le x y z hxz)],
 end
@@ -302,13 +359,18 @@ end
 
 variables (E) [∀ n, topological_space (E n)] [∀ n, discrete_topology (E n)]
 
-lemma is_topological_basis_cylinders  :
+lemma is_open_cylinder (x : Π n, E n) (n : ℕ) : is_open (cylinder x n) :=
+begin
+  rw pi_nat.cylinder_eq_pi,
+  exact is_open_set_pi (finset.range n).finite_to_set (λ a ha, is_open_discrete _),
+end
+
+lemma is_topological_basis_cylinders :
   is_topological_basis {s : set (Π n, E n) | ∃ (x : Π n, E n) (n : ℕ), s = cylinder x n} :=
 begin
   apply is_topological_basis_of_open_of_nhds,
   { rintros u ⟨x, n, rfl⟩,
-    rw cylinder_eq_pi,
-    exact is_open_set_pi (finset.range n).finite_to_set (λ a ha, is_open_discrete _) },
+    apply is_open_cylinder, },
   { assume x u hx u_open,
     obtain ⟨v, ⟨U, F, hUF, rfl⟩, xU, Uu⟩ : ∃ (v : set (Π (i : ℕ), E i))
       (H : v ∈ {S : set (Π (i : ℕ), E i) | ∃ (U : Π (i : ℕ), set (E i)) (F : finset ℕ),
@@ -357,7 +419,7 @@ but it does not take care of a possible uniformity. If the `E n` have a uniform
 there will be two non-defeq uniform structures on `Π n, E n`, the product one and the one coming
 from the metric structure. In this case, use `metric_space_of_discrete_uniformity` instead. -/
 protected def metric_space : metric_space (Π n, E n) :=
-metric_space.of_metrizable dist pi_nat.dist_self pi_nat.dist_comm pi_nat.dist_triangle
+metric_space.of_dist_topology dist pi_nat.dist_self pi_nat.dist_comm pi_nat.dist_triangle
   is_open_iff_dist pi_nat.eq_of_dist_eq_zero
 
 /-- Metric space structure on `Π (n : ℕ), E n` when the spaces `E n` have the discrete uniformity,
@@ -393,7 +455,7 @@ begin
       { simp only [le_infi_iff, le_principal_iff],
         assume n,
         refine mem_infi_of_mem ((1/2)^n) _,
-        refine mem_infi_of_mem (by norm_num) _,
+        refine mem_infi_of_mem (by positivity) _,
         simp only [mem_principal, set_of_subset_set_of, prod.forall],
         assume x y hxy,
         exact apply_eq_of_dist_lt hxy le_rfl }
@@ -669,7 +731,7 @@ begin
   { assume x,
     apply subtype.coe_injective.eq_iff.1,
     simpa only using fs x.val x.property },
-  exact ⟨cod_restrict f s A, B, λ x, ⟨x, B x⟩, continuous_subtype_mk _ f_cont⟩,
+  exact ⟨cod_restrict f s A, B, λ x, ⟨x, B x⟩, f_cont.subtype_mk _⟩,
 end
 
 end pi_nat
@@ -709,6 +771,7 @@ begin
       apply apply_first_diff_ne hne',
       rw [le_zero_iff.1 h],
       apply apply_eq_of_dist_lt _ le_rfl,
+      rw pow_zero,
       exact hxy },
     have hn : first_diff x.1 y.1 = n + 1 := (nat.succ_pred_eq_of_pos diff_pos).symm,
     rw [dist', dist_eq_of_ne hne', hn],
@@ -800,7 +863,7 @@ lemma dist_le_dist_pi_of_dist_lt {x y : Π i, F i} {i : ι} (h : dist x y < (1/2
   dist (x i) (y i) ≤ dist x y :=
 by simpa only [not_le.2 h, false_or] using min_le_iff.1 (min_dist_le_dist_pi x y i)
 
-open_locale big_operators topological_space
+open_locale big_operators topology
 open filter
 
 open_locale nnreal
diff --git a/src/topology/metric_space/polish.lean b/src/topology/metric_space/polish.lean
index b65a2b0d9ef48..e4cc253a4a45e 100644
--- a/src/topology/metric_space/polish.lean
+++ b/src/topology/metric_space/polish.lean
@@ -3,14 +3,17 @@ Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
-import analysis.normed_space.basic
 import topology.metric_space.pi_nat
 import topology.metric_space.isometry
 import topology.metric_space.gluing
+import analysis.normed.field.basic
 
 /-!
 # Polish spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A topological space is Polish if its topology is second-countable and there exists a compatible
 complete metric. This is the class of spaces that is well-behaved with respect to measure theory.
 In this file, we establish the basic properties of Polish spaces.
@@ -44,7 +47,7 @@ with additional properties:
 -/
 
 noncomputable theory
-open_locale classical topological_space filter
+open_locale classical topology filter
 open topological_space set metric filter function
 
 variables {α : Type*} {β : Type*}
@@ -104,10 +107,11 @@ instance t2_space (α : Type*) [topological_space α] [polish_space α] : t2_spa
 by { letI := upgrade_polish_space α, apply_instance }
 
 /-- A countable product of Polish spaces is Polish. -/
-instance pi_countable {ι : Type*} [encodable ι] {E : ι → Type*}
+instance pi_countable {ι : Type*} [countable ι] {E : ι → Type*}
   [∀ i, topological_space (E i)] [∀ i, polish_space (E i)] :
   polish_space (Π i, E i) :=
 begin
+  casesI nonempty_encodable ι,
   letI := λ i, upgrade_polish_space (E i),
   letI : metric_space (Π i, E i) := pi_countable.metric_space,
   apply_instance,
@@ -119,7 +123,7 @@ instance nat_fun [topological_space α] [polish_space α] :
 by apply_instance
 
 /-- A countable disjoint union of Polish spaces is Polish. -/
-instance sigma {ι : Type*} [encodable ι]
+instance sigma {ι : Type*} [countable ι]
   {E : ι → Type*} [∀ n, topological_space (E n)] [∀ n, polish_space (E n)] :
   polish_space (Σ n, E n) :=
 begin
@@ -180,12 +184,12 @@ lemma _root_.is_closed.polish_space {α : Type*} [topological_space α] [polish_
 
 /-- A sequence of type synonyms of a given type `α`, useful in the proof of
 `exists_polish_space_forall_le` to endow each copy with a different topology. -/
-@[nolint unused_arguments has_inhabited_instance]
+@[nolint unused_arguments has_nonempty_instance]
 def aux_copy (α : Type*) {ι : Type*} (i : ι) : Type* := α
 
 /-- Given a Polish space, and countably many finer Polish topologies, there exists another Polish
 topology which is finer than all of them. -/
-lemma exists_polish_space_forall_le {ι : Type*} [encodable ι]
+lemma exists_polish_space_forall_le {ι : Type*} [countable ι]
   [t : topological_space α] [p : polish_space α]
   (m : ι → topological_space α) (hm : ∀ n, m n ≤ t) (h'm : ∀ n, @polish_space α (m n)) :
   ∃ (t' : topological_space α), (∀ n, t' ≤ m n) ∧ (t' ≤ t) ∧ @polish_space α t' :=
@@ -259,7 +263,7 @@ variables [metric_space α] {s : set α}
 
 /-- A type synonym for a subset `s` of a metric space, on which we will construct another metric
 for which it will be complete. -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 def complete_copy {α : Type*} (s : set α) : Type* := s
 
 /-- A distance on a subset `s` of a metric space, designed to make it complete if `s` is open.
@@ -412,7 +416,7 @@ end complete_copy
 this set is open and closed. It turns out that this notion is equivalent to being Borel-measurable,
 but this is nontrivial (see `is_clopenable_iff_measurable_set`). -/
 def is_clopenable [t : topological_space α] (s : set α) : Prop :=
-∃ (t' : topological_space α), t' ≤ t ∧ @polish_space α t' ∧ @is_closed α t' s ∧ @is_open α t' s
+∃ (t' : topological_space α), t' ≤ t ∧ @polish_space α t' ∧ is_closed[t'] s ∧ is_open[t'] s
 
 /-- Given a closed set `s` in a Polish space, one can construct a finer Polish topology for
 which `s` is both open and closed. -/
@@ -449,13 +453,13 @@ begin
       have : sum.inr ⁻¹' (⇑(f.symm) ⁻¹' u) = (coe : t → α) ⁻¹' u,
         by { ext x, simp only [equiv.symm_symm, mem_preimage, equiv.set.sum_compl_apply_inr] },
       rwa this } },
-  { have : @is_closed α t' (g ⁻¹' (range (sum.inl : s → s ⊕ t))),
+  { have : is_closed[t'] (g ⁻¹' (range (sum.inl : s → s ⊕ t))),
     { apply is_closed.preimage,
       { exact @homeomorph.continuous _ _ t' _ g },
       { exact is_closed_range_inl } },
     convert this,
     exact A.symm },
-  { have : @is_open α t' (g ⁻¹' (range (sum.inl : s → s ⊕ t))),
+  { have : is_open[t'] (g ⁻¹' (range (sum.inl : s → s ⊕ t))),
     { apply is_open.preimage,
       { exact @homeomorph.continuous _ _ t' _ g },
       { exact is_open_range_inl } },
@@ -482,14 +486,14 @@ begin
   obtain ⟨t', t'm, -, t'_polish⟩ :
     ∃ (t' : topological_space α), (∀ (n : ℕ), t' ≤ m n) ∧ (t' ≤ t) ∧ @polish_space α t' :=
       exists_polish_space_forall_le m mt m_polish,
-  have A : @is_open α t' (⋃ n, s n),
+  have A : is_open[t'] (⋃ n, s n),
   { apply is_open_Union,
     assume n,
     apply t'm n,
     exact m_open n },
   obtain ⟨t'', t''_le, t''_polish, h1, h2⟩ :
     ∃ (t'' : topological_space α), t'' ≤ t' ∧ @polish_space α t''
-      ∧ @is_closed α t'' (⋃ n, s n) ∧ @is_open α t'' (⋃ n, s n) :=
+      ∧ is_closed[t''] (⋃ n, s n) ∧ is_open[t''] (⋃ n, s n) :=
         @is_open.is_clopenable α t' t'_polish _ A,
   exact ⟨t'', t''_le.trans ((t'm 0).trans (mt 0)), t''_polish, h1, h2⟩,
 end
diff --git a/src/topology/metric_space/shrinking_lemma.lean b/src/topology/metric_space/shrinking_lemma.lean
index 71bbc4c21f794..c0520d2a86de2 100644
--- a/src/topology/metric_space/shrinking_lemma.lean
+++ b/src/topology/metric_space/shrinking_lemma.lean
@@ -10,6 +10,9 @@ import topology.shrinking_lemma
 /-!
 # Shrinking lemma in a proper metric space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove a few versions of the shrinking lemma for coverings by balls in a proper
 (pseudo) metric space.
 
@@ -20,7 +23,7 @@ shrinking lemma, metric space
 
 universes u v
 open set metric
-open_locale topological_space
+open_locale topology
 
 variables {α : Type u} {ι : Type v} [metric_space α] [proper_space α] {c : ι → α}
 variables {x : α} {r : ℝ} {s : set α}
@@ -31,7 +34,7 @@ so that each of the new balls has strictly smaller radius than the old one. This
 that `λ x, ball (c i) (r i)` is a locally finite covering and provides a covering indexed by the
 same type. -/
 lemma exists_subset_Union_ball_radius_lt {r : ι → ℝ} (hs : is_closed s)
-  (uf : ∀ x ∈ s, finite {i | x ∈ ball (c i) (r i)}) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
+  (uf : ∀ x ∈ s, {i | x ∈ ball (c i) (r i)}.finite) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
   ∃ r' : ι → ℝ, s ⊆ (⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i < r i :=
 begin
   rcases exists_subset_Union_closed_subset hs (λ i, @is_open_ball _ _ (c i) (r i)) uf us
@@ -44,7 +47,7 @@ end
 /-- Shrinking lemma for coverings by open balls in a proper metric space. A point-finite open cover
 of a proper metric space by open balls can be shrunk to a new cover by open balls so that each of
 the new balls has strictly smaller radius than the old one. -/
-lemma exists_Union_ball_eq_radius_lt {r : ι → ℝ} (uf : ∀ x, finite {i | x ∈ ball (c i) (r i)})
+lemma exists_Union_ball_eq_radius_lt {r : ι → ℝ} (uf : ∀ x, {i | x ∈ ball (c i) (r i)}.finite)
   (uU : (⋃ i, ball (c i) (r i)) = univ) :
   ∃ r' : ι → ℝ, (⋃ i, ball (c i) (r' i)) = univ ∧ ∀ i, r' i < r i :=
 let ⟨r', hU, hv⟩ := exists_subset_Union_ball_radius_lt is_closed_univ (λ x _, uf x) uU.ge
@@ -54,7 +57,7 @@ in ⟨r', univ_subset_iff.1 hU, hv⟩
 of a closed subset of a proper metric space by nonempty open balls can be shrunk to a new cover by
 nonempty open balls so that each of the new balls has strictly smaller radius than the old one. -/
 lemma exists_subset_Union_ball_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i) (hs : is_closed s)
-  (uf : ∀ x ∈ s, finite {i | x ∈ ball (c i) (r i)}) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
+  (uf : ∀ x ∈ s, {i | x ∈ ball (c i) (r i)}.finite) (us : s ⊆ ⋃ i, ball (c i) (r i)) :
   ∃ r' : ι → ℝ, s ⊆ (⋃ i, ball (c i) (r' i)) ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
 begin
   rcases exists_subset_Union_closed_subset hs (λ i, @is_open_ball _ _ (c i) (r i)) uf us
@@ -68,7 +71,7 @@ end
 of a proper metric space by nonempty open balls can be shrunk to a new cover by nonempty open balls
 so that each of the new balls has strictly smaller radius than the old one. -/
 lemma exists_Union_ball_eq_radius_pos_lt {r : ι → ℝ} (hr : ∀ i, 0 < r i)
-  (uf : ∀ x, finite {i | x ∈ ball (c i) (r i)}) (uU : (⋃ i, ball (c i) (r i)) = univ) :
+  (uf : ∀ x, {i | x ∈ ball (c i) (r i)}.finite) (uU : (⋃ i, ball (c i) (r i)) = univ) :
   ∃ r' : ι → ℝ, (⋃ i, ball (c i) (r' i)) = univ ∧ ∀ i, r' i ∈ Ioo 0 (r i) :=
 let ⟨r', hU, hv⟩ := exists_subset_Union_ball_radius_pos_lt hr is_closed_univ (λ x _, uf x) uU.ge
 in ⟨r', univ_subset_iff.1 hU, hv⟩
diff --git a/src/topology/metric_space/thickened_indicator.lean b/src/topology/metric_space/thickened_indicator.lean
index bc45cf672a098..001701e9833f6 100644
--- a/src/topology/metric_space/thickened_indicator.lean
+++ b/src/topology/metric_space/thickened_indicator.lean
@@ -5,10 +5,14 @@ Authors: Kalle Kytölä
 -/
 import data.real.ennreal
 import topology.continuous_function.bounded
+import topology.metric_space.hausdorff_distance
 
 /-!
 # Thickened indicators
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file is about thickened indicators of sets in (pseudo e)metric spaces. For a decreasing
 sequence of thickening radii tending to 0, the thickened indicators of a closed set form a
 decreasing pointwise converging approximation of the indicator function of the set, where the
@@ -32,7 +36,7 @@ members of the approximating sequence are nonnegative bounded continuous functio
 
 -/
 noncomputable theory
-open_locale classical nnreal ennreal topological_space bounded_continuous_function
+open_locale classical nnreal ennreal topology bounded_continuous_function
 
 open nnreal ennreal set metric emetric filter
 
@@ -98,6 +102,15 @@ lemma thickened_indicator_aux_mono {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (
   thickened_indicator_aux δ₁ E ≤ thickened_indicator_aux δ₂ E :=
 λ _, tsub_le_tsub (@rfl ℝ≥0∞ 1).le (ennreal.div_le_div rfl.le (of_real_le_of_real hle))
 
+lemma indicator_le_thickened_indicator_aux (δ : ℝ) (E : set α) :
+  E.indicator (λ _, (1 : ℝ≥0∞)) ≤ thickened_indicator_aux δ E :=
+begin
+  intro a,
+  by_cases a ∈ E,
+  { simp only [h, indicator_of_mem, thickened_indicator_aux_one δ E h, le_refl], },
+  { simp only [h, indicator_of_not_mem, not_false_iff, zero_le], },
+end
+
 lemma thickened_indicator_aux_subset (δ : ℝ) {E₁ E₂ : set α} (subset : E₁ ⊆ E₂) :
   thickened_indicator_aux δ E₁ ≤ thickened_indicator_aux δ E₂ :=
 λ _, tsub_le_tsub (@rfl ℝ≥0∞ 1).le (ennreal.div_le_div (inf_edist_anti subset) rfl.le)
@@ -123,21 +136,14 @@ begin
     exact tendsto_const_nhds, },
   { rw (show (closure E).indicator (λ _, (1 : ℝ≥0∞)) x = 0,
         by simp only [x_mem_closure, indicator_of_not_mem, not_false_iff]),
-    rw mem_closure_iff_inf_edist_zero at x_mem_closure,
-    obtain ⟨ε, ⟨ε_pos, ε_le⟩⟩ : ∃ (ε : ℝ), 0 < ε ∧ ennreal.of_real ε ≤ inf_edist x E,
-    { by_cases dist_infty : inf_edist x E = ∞,
-      { rw dist_infty,
-        use [1, zero_lt_one, le_top], },
-      { use (inf_edist x E).to_real,
-        exact ⟨(to_real_lt_to_real zero_ne_top dist_infty).mpr (pos_iff_ne_zero.mpr x_mem_closure),
-                of_real_to_real_le⟩, }, },
+    rcases exists_real_pos_lt_inf_edist_of_not_mem_closure x_mem_closure with ⟨ε, ⟨ε_pos, ε_lt⟩⟩,
     rw metric.tendsto_nhds at δseq_lim,
     specialize δseq_lim ε ε_pos,
     simp only [dist_zero_right, real.norm_eq_abs, eventually_at_top, ge_iff_le] at δseq_lim,
     rcases δseq_lim with ⟨N, hN⟩,
     apply @tendsto_at_top_of_eventually_const _ _ _ _ _ _ _ N,
     intros n n_large,
-    have key : x ∉ thickening ε E, by rwa [thickening, mem_set_of_eq, not_lt],
+    have key : x ∉ thickening ε E, by simpa only [thickening, mem_set_of_eq, not_lt] using ε_lt.le,
     refine le_antisymm _ bot_le,
     apply (thickened_indicator_aux_mono (lt_of_abs_lt (hN n n_large)).le E x).trans,
     exact (thickened_indicator_aux_zero ε_pos E key).le, },
@@ -196,6 +202,15 @@ lemma thickened_indicator_zero
   thickened_indicator δ_pos E x = 0 :=
 by rw [thickened_indicator_apply, thickened_indicator_aux_zero δ_pos E x_out, zero_to_nnreal]
 
+lemma indicator_le_thickened_indicator {δ : ℝ} (δ_pos : 0 < δ) (E : set α) :
+  E.indicator (λ _, (1 : ℝ≥0)) ≤ thickened_indicator δ_pos E :=
+begin
+  intro a,
+  by_cases a ∈ E,
+  { simp only [h, indicator_of_mem, thickened_indicator_one δ_pos E h, le_refl], },
+  { simp only [h, indicator_of_not_mem, not_false_iff, zero_le], },
+end
+
 lemma thickened_indicator_mono {δ₁ δ₂ : ℝ}
   (δ₁_pos : 0 < δ₁) (δ₂_pos : 0 < δ₂) (hle : δ₁ ≤ δ₂) (E : set α) :
   ⇑(thickened_indicator δ₁_pos E) ≤ thickened_indicator δ₂_pos E :=
diff --git a/src/topology/nhds_set.lean b/src/topology/nhds_set.lean
index 9a215090a215b..4a48a57b21136 100644
--- a/src/topology/nhds_set.lean
+++ b/src/topology/nhds_set.lean
@@ -7,6 +7,9 @@ import topology.basic
 /-!
 # Neighborhoods of a set
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the filter `𝓝ˢ s` or `nhds_set s` consisting of all neighborhoods of a set
 `s`.
 
@@ -24,19 +27,26 @@ Furthermore, we have the following results:
 -/
 
 open set filter
-open_locale topological_space
+open_locale topology filter
 
-variables {α : Type*} [topological_space α] {s t s₁ s₂ t₁ t₂ : set α} {x : α}
+variables {α β : Type*} [topological_space α] [topological_space β]
+  {s t s₁ s₂ t₁ t₂ : set α} {x : α}
 
 /-- The filter of neighborhoods of a set in a topological space. -/
 def nhds_set (s : set α) : filter α :=
 Sup (nhds '' s)
 
-localized "notation `𝓝ˢ` := nhds_set" in topological_space
+localized "notation (name := nhds_set) `𝓝ˢ` := nhds_set" in topology
+
+lemma nhds_set_diagonal (α) [topological_space (α × α)] : 𝓝ˢ (diagonal α) = ⨆ x, 𝓝 (x, x) :=
+by { rw [nhds_set, ← range_diag, ← range_comp], refl }
 
 lemma mem_nhds_set_iff_forall : s ∈ 𝓝ˢ t ↔ ∀ (x : α), x ∈ t → s ∈ 𝓝 x :=
 by simp_rw [nhds_set, filter.mem_Sup, ball_image_iff]
 
+lemma bUnion_mem_nhds_set {t : α → set α} (h : ∀ x ∈ s, t x ∈ 𝓝 x) : (⋃ x ∈ s, t x) ∈ 𝓝ˢ s :=
+mem_nhds_set_iff_forall.2 $ λ x hx, mem_of_superset (h x hx) (subset_Union₂ x hx)
+
 lemma subset_interior_iff_mem_nhds_set : s ⊆ interior t ↔ t ∈ 𝓝ˢ s :=
 by simp_rw [mem_nhds_set_iff_forall, subset_interior_iff_nhds]
 
@@ -47,7 +57,19 @@ lemma has_basis_nhds_set (s : set α) : (𝓝ˢ s).has_basis (λ U, is_open U 
 ⟨λ t, by simp [mem_nhds_set_iff_exists, and_assoc]⟩
 
 lemma is_open.mem_nhds_set (hU : is_open s) : s ∈ 𝓝ˢ t ↔ t ⊆ s :=
-by rw [← subset_interior_iff_mem_nhds_set, interior_eq_iff_open.mpr hU]
+by rw [← subset_interior_iff_mem_nhds_set, interior_eq_iff_is_open.mpr hU]
+
+lemma principal_le_nhds_set : 𝓟 s ≤ 𝓝ˢ s :=
+λ s hs, (subset_interior_iff_mem_nhds_set.mpr hs).trans interior_subset
+
+@[simp] lemma nhds_set_eq_principal_iff : 𝓝ˢ s = 𝓟 s ↔ is_open s :=
+by rw [← principal_le_nhds_set.le_iff_eq, le_principal_iff, mem_nhds_set_iff_forall,
+  is_open_iff_mem_nhds]
+
+alias nhds_set_eq_principal_iff ↔ _ is_open.nhds_set_eq
+
+@[simp] lemma nhds_set_interior : 𝓝ˢ (interior s) = 𝓟 (interior s) :=
+is_open_interior.nhds_set_eq
 
 @[simp] lemma nhds_set_singleton : 𝓝ˢ {x} = 𝓝 x :=
 by { ext,
@@ -56,20 +78,29 @@ by { ext,
 lemma mem_nhds_set_interior : s ∈ 𝓝ˢ (interior s) :=
 subset_interior_iff_mem_nhds_set.mp subset.rfl
 
-lemma mem_nhds_set_empty : s ∈ 𝓝ˢ (∅ : set α) :=
-subset_interior_iff_mem_nhds_set.mp $ empty_subset _
-
 @[simp] lemma nhds_set_empty : 𝓝ˢ (∅ : set α) = ⊥ :=
-by { ext, simp [mem_nhds_set_empty] }
+by rw [is_open_empty.nhds_set_eq, principal_empty]
+
+lemma mem_nhds_set_empty : s ∈ 𝓝ˢ (∅ : set α) := by simp
 
 @[simp] lemma nhds_set_univ : 𝓝ˢ (univ : set α) = ⊤ :=
-by { ext, rw [← subset_interior_iff_mem_nhds_set, univ_subset_iff, interior_eq_univ, mem_top] }
+by rw [is_open_univ.nhds_set_eq, principal_univ]
 
-lemma monotone_nhds_set : monotone (𝓝ˢ : set α → filter α) :=
-λ s t hst, Sup_le_Sup $ image_subset _ hst
+@[mono] lemma nhds_set_mono (h : s ⊆ t) : 𝓝ˢ s ≤ 𝓝ˢ t :=  Sup_le_Sup $ image_subset _ h
+
+lemma monotone_nhds_set : monotone (𝓝ˢ : set α → filter α) := λ s t, nhds_set_mono
+
+lemma nhds_le_nhds_set (h : x ∈ s) : 𝓝 x ≤ 𝓝ˢ s := le_Sup $ mem_image_of_mem _ h
 
 @[simp] lemma nhds_set_union (s t : set α) : 𝓝ˢ (s ∪ t) = 𝓝ˢ s ⊔ 𝓝ˢ t :=
 by simp only [nhds_set, image_union, Sup_union]
 
 lemma union_mem_nhds_set (h₁ : s₁ ∈ 𝓝ˢ t₁) (h₂ : s₂ ∈ 𝓝ˢ t₂) : s₁ ∪ s₂ ∈ 𝓝ˢ (t₁ ∪ t₂) :=
 by { rw nhds_set_union, exact union_mem_sup h₁ h₂ }
+
+/-- Preimage of a set neighborhood of `t` under a continuous map `f` is a set neighborhood of `s`
+provided that `f` maps `s` to `t`.  -/
+lemma continuous.tendsto_nhds_set {f : α → β} {t : set β} (hf : continuous f)
+  (hst : maps_to f s t) : tendsto f (𝓝ˢ s) (𝓝ˢ t) :=
+((has_basis_nhds_set s).tendsto_iff (has_basis_nhds_set t)).mpr $ λ U hU,
+  ⟨f ⁻¹' U, ⟨hU.1.preimage hf, hst.mono subset.rfl hU.2⟩, λ x, id⟩
diff --git a/src/topology/noetherian_space.lean b/src/topology/noetherian_space.lean
new file mode 100644
index 0000000000000..18d85a615a0f1
--- /dev/null
+++ b/src/topology/noetherian_space.lean
@@ -0,0 +1,227 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import order.compactly_generated
+import topology.sets.closeds
+
+/-!
+# Noetherian space
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A Noetherian space is a topological space that satisfies any of the following equivalent conditions:
+- `well_founded ((>) : opens α → opens α → Prop)`
+- `well_founded ((<) : closeds α → closeds α → Prop)`
+- `∀ s : set α, is_compact s`
+- `∀ s : opens α, is_compact s`
+
+The first is chosen as the definition, and the equivalence is shown in
+`topological_space.noetherian_space_tfae`.
+
+Many examples of noetherian spaces come from algebraic topology. For example, the underlying space
+of a noetherian scheme (e.g., the spectrum of a noetherian ring) is noetherian.
+
+## Main Results
+- `noetherian_space.set`: Every subspace of a noetherian space is noetherian.
+- `noetherian_space.is_compact`: Every subspace of a noetherian space is compact.
+- `noetherian_space_tfae`: Describes the equivalent definitions of noetherian spaces.
+- `noetherian_space.range`: The image of a noetherian space under a continuous map is noetherian.
+- `noetherian_space.Union`: The finite union of noetherian spaces is noetherian.
+- `noetherian_space.discrete`: A noetherian and hausdorff space is discrete.
+- `noetherian_space.exists_finset_irreducible` : Every closed subset of a noetherian space is a
+  finite union of irreducible closed subsets.
+- `noetherian_space.finite_irreducible_components `: The number of irreducible components of a
+  noetherian space is finite.
+
+-/
+
+variables (α β : Type*) [topological_space α] [topological_space β]
+
+namespace topological_space
+
+/-- Type class for noetherian spaces. It is defined to be spaces whose open sets satisfies ACC. -/
+@[mk_iff]
+class noetherian_space : Prop :=
+(well_founded : well_founded ((>) : opens α → opens α → Prop))
+
+lemma noetherian_space_iff_opens :
+  noetherian_space α ↔ ∀ s : opens α, is_compact (s : set α) :=
+begin
+  rw [noetherian_space_iff, complete_lattice.well_founded_iff_is_Sup_finite_compact,
+    complete_lattice.is_Sup_finite_compact_iff_all_elements_compact],
+  exact forall_congr opens.is_compact_element_iff,
+end
+
+@[priority 100]
+instance noetherian_space.compact_space [h : noetherian_space α] : compact_space α :=
+⟨(noetherian_space_iff_opens α).mp h ⊤⟩
+
+variables {α β}
+
+protected lemma noetherian_space.is_compact [noetherian_space α] (s : set α) : is_compact s :=
+begin
+  refine is_compact_iff_finite_subcover.2 (λ ι U hUo hs, _),
+  rcases ((noetherian_space_iff_opens α).mp ‹_›
+    ⟨⋃ i, U i, is_open_Union hUo⟩).elim_finite_subcover U hUo set.subset.rfl with ⟨t, ht⟩,
+  exact ⟨t, hs.trans ht⟩
+end
+
+protected lemma inducing.noetherian_space [noetherian_space α] {i : β → α} (hi : inducing i) :
+  noetherian_space β :=
+(noetherian_space_iff_opens _).2 $ λ s, hi.is_compact_iff.1 (noetherian_space.is_compact _)
+
+instance noetherian_space.set [h : noetherian_space α] (s : set α) : noetherian_space s :=
+inducing_coe.noetherian_space
+
+variable (α)
+
+example (α : Type*) : set α ≃o (set α)ᵒᵈ := by refine order_iso.compl (set α)
+
+lemma noetherian_space_tfae :
+  tfae [noetherian_space α,
+    well_founded (λ s t : closeds α, s < t),
+    ∀ s : set α, is_compact s,
+    ∀ s : opens α, is_compact (s : set α)] :=
+begin
+  tfae_have : 1 ↔ 2,
+  { refine (noetherian_space_iff _).trans (surjective.well_founded_iff opens.compl_bijective.2 _),
+    exact λ s t, (order_iso.compl (set α)).lt_iff_lt.symm },
+  tfae_have : 1 ↔ 4,
+  { exact noetherian_space_iff_opens α },
+  tfae_have : 1 → 3,
+  { exact @noetherian_space.is_compact _ _ },
+  tfae_have : 3 → 4,
+  { exact λ H s, H s },
+  tfae_finish
+end
+
+variables {α β}
+
+instance {α} : noetherian_space (cofinite_topology α) :=
+begin
+  simp only [noetherian_space_iff_opens, is_compact_iff_ultrafilter_le_nhds,
+    cofinite_topology.nhds_eq, ultrafilter.le_sup_iff],
+  intros s f hs,
+  rcases f.le_cofinite_or_eq_pure with hf|⟨a, rfl⟩,
+  { rcases filter.nonempty_of_mem (filter.le_principal_iff.1 hs) with ⟨a, ha⟩,
+    exact ⟨a, ha, or.inr hf⟩ },
+  { exact ⟨a, filter.le_principal_iff.mp hs, or.inl le_rfl⟩ }
+end
+
+lemma noetherian_space_of_surjective [noetherian_space α] (f : α → β)
+  (hf : continuous f) (hf' : function.surjective f) : noetherian_space β :=
+begin
+  rw noetherian_space_iff_opens,
+  intro s,
+  obtain ⟨t, e⟩ := set.image_surjective.mpr hf' s,
+  exact e ▸ (noetherian_space.is_compact t).image hf,
+end
+
+lemma noetherian_space_iff_of_homeomorph (f : α ≃ₜ β) :
+  noetherian_space α ↔ noetherian_space β :=
+⟨λ h, @@noetherian_space_of_surjective _ _ h f f.continuous f.surjective,
+  λ h, @@noetherian_space_of_surjective _ _ h f.symm f.symm.continuous f.symm.surjective⟩
+
+lemma noetherian_space.range [noetherian_space α] (f : α → β) (hf : continuous f) :
+  noetherian_space (set.range f) :=
+noetherian_space_of_surjective (set.cod_restrict f _ set.mem_range_self) (by continuity)
+  (λ ⟨a, b, h⟩, ⟨b, subtype.ext h⟩)
+
+lemma noetherian_space_set_iff (s : set α) :
+  noetherian_space s ↔ ∀ t ⊆ s, is_compact t :=
+begin
+  rw (noetherian_space_tfae s).out 0 2,
+  split,
+  { intros H t ht,
+    have := embedding_subtype_coe.is_compact_iff_is_compact_image.mp (H (coe ⁻¹' t)),
+    simpa [set.inter_eq_left_iff_subset.mpr ht] using this },
+  { intros H t,
+    refine embedding_subtype_coe.is_compact_iff_is_compact_image.mpr (H (coe '' t) _),
+    simp }
+end
+
+@[simp] lemma noetherian_univ_iff :
+  noetherian_space (set.univ : set α) ↔ noetherian_space α :=
+noetherian_space_iff_of_homeomorph (homeomorph.set.univ α)
+
+lemma noetherian_space.Union {ι : Type*} (f : ι → set α) [finite ι]
+  [hf : ∀ i, noetherian_space (f i)] :
+  noetherian_space (⋃ i, f i) :=
+begin
+  casesI nonempty_fintype ι,
+  simp_rw noetherian_space_set_iff at hf ⊢,
+  intros t ht,
+  rw [← set.inter_eq_left_iff_subset.mpr ht, set.inter_Union],
+  exact is_compact_Union (λ i, hf i _ (set.inter_subset_right _ _))
+end
+
+-- This is not an instance since it makes a loop with `t2_space_discrete`.
+lemma noetherian_space.discrete [noetherian_space α] [t2_space α] : discrete_topology α :=
+⟨eq_bot_iff.mpr (λ U _, is_closed_compl_iff.mp (noetherian_space.is_compact _).is_closed)⟩
+
+local attribute [instance] noetherian_space.discrete
+
+/-- Spaces that are both Noetherian and Hausdorff is finite. -/
+lemma noetherian_space.finite [noetherian_space α] [t2_space α] : finite α :=
+begin
+  letI : fintype α :=
+    set.fintype_of_finite_univ (noetherian_space.is_compact set.univ).finite_of_discrete,
+  apply_instance
+end
+
+@[priority 100]
+instance finite.to_noetherian_space [finite α] : noetherian_space α :=
+⟨finite.well_founded_of_trans_of_irrefl _⟩
+
+lemma noetherian_space.exists_finset_irreducible [noetherian_space α] (s : closeds α) :
+  ∃ S : finset (closeds α), (∀ k : S, is_irreducible (k : set α)) ∧ s = S.sup id :=
+begin
+  classical,
+  have := ((noetherian_space_tfae α).out 0 1).mp infer_instance,
+  apply well_founded.induction this s, clear s,
+  intros s H,
+  by_cases h₁ : is_preirreducible s.1,
+  cases h₂ : s.1.eq_empty_or_nonempty,
+  { use ∅, refine ⟨λ k, k.2.elim, _⟩, rw finset.sup_empty, ext1, exact h },
+  { use {s},
+    simp only [coe_coe, finset.sup_singleton, id.def, eq_self_iff_true, and_true],
+    rintro ⟨k, hk⟩,
+    cases finset.mem_singleton.mp hk,
+    exact ⟨h, h₁⟩ },
+  { rw is_preirreducible_iff_closed_union_closed at h₁,
+    push_neg at h₁,
+    obtain ⟨z₁, z₂, hz₁, hz₂, h, hz₁', hz₂'⟩ := h₁,
+    obtain ⟨S₁, hS₁, hS₁'⟩ := H (s ⊓ ⟨z₁, hz₁⟩) (inf_lt_left.2 hz₁'),
+    obtain ⟨S₂, hS₂, hS₂'⟩ := H (s ⊓ ⟨z₂, hz₂⟩) (inf_lt_left.2 hz₂'),
+    refine ⟨S₁ ∪ S₂, λ k, _, _⟩,
+    { cases finset.mem_union.mp k.2 with h' h', exacts [hS₁ ⟨k, h'⟩, hS₂ ⟨k, h'⟩] },
+    { rwa [finset.sup_union, ← hS₁', ← hS₂', ← inf_sup_left, left_eq_inf] } }
+end
+
+lemma noetherian_space.finite_irreducible_components [noetherian_space α] :
+  (irreducible_components α).finite :=
+begin
+  classical,
+  obtain ⟨S, hS₁, hS₂⟩ := noetherian_space.exists_finset_irreducible (⊤ : closeds α),
+  suffices : irreducible_components α ⊆ coe '' (S : set $ closeds α),
+  { exact set.finite.subset ((set.finite.intro infer_instance).image _) this },
+  intros K hK,
+  obtain ⟨z, hz, hz'⟩ : ∃ (z : set α) (H : z ∈ finset.image coe S), K ⊆ z,
+  { convert is_irreducible_iff_sUnion_closed.mp
+      hK.1 (S.image coe) _ _,
+    { simp only [finset.mem_image, exists_prop, forall_exists_index, and_imp],
+      rintro _ z hz rfl,
+      exact z.2 },
+    { exact (set.subset_univ _).trans ((congr_arg coe hS₂).trans $ by simp).subset } },
+  obtain ⟨s, hs, e⟩ := finset.mem_image.mp hz,
+  rw ← e at hz',
+  refine ⟨s, hs, _⟩,
+  symmetry,
+  suffices : K ≤ s, { exact this.antisymm (hK.2 (hS₁ ⟨s, hs⟩) this) },
+  simpa,
+end
+
+end topological_space
diff --git a/src/topology/omega_complete_partial_order.lean b/src/topology/omega_complete_partial_order.lean
index 395258fa71300..785f8bcaf346b 100644
--- a/src/topology/omega_complete_partial_order.lean
+++ b/src/topology/omega_complete_partial_order.lean
@@ -9,6 +9,9 @@ import order.omega_complete_partial_order
 /-!
 # Scott Topological Spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A type of topological spaces whose notion
 of continuity is equivalent to continuity in ωCPOs.
 
@@ -18,7 +21,7 @@ of continuity is equivalent to continuity in ωCPOs.
 
 -/
 
-open omega_complete_partial_order
+open set omega_complete_partial_order
 open_locale classical
 
 universes u
@@ -29,20 +32,18 @@ def is_ωSup {α : Type u} [preorder α] (c : chain α) (x : α) : Prop :=
 (∀ i, c i ≤ x) ∧ (∀ y, (∀ i, c i ≤ y) → x ≤ y)
 
 lemma is_ωSup_iff_is_lub {α : Type u} [preorder α] {c : chain α} {x : α} :
-  is_ωSup c x ↔ is_lub (set.range c) x :=
+  is_ωSup c x ↔ is_lub (range c) x :=
 by simp [is_ωSup, is_lub, is_least, upper_bounds, lower_bounds]
 
 variables (α : Type u) [omega_complete_partial_order α]
-local attribute [irreducible] set
 
 /-- The characteristic function of open sets is monotone and preserves
 the limits of chains. -/
 def is_open (s : set α) : Prop :=
 continuous' (λ x, x ∈ s)
 
-theorem is_open_univ : is_open α set.univ :=
-⟨λ x y h, by simp only [set.mem_univ]; refl',
-  by convert @complete_lattice.top_continuous α Prop _ _; ext; simp ⟩
+theorem is_open_univ : is_open α univ :=
+⟨λ x y h hx, mem_univ _, @complete_lattice.top_continuous α Prop _ _⟩
 
 theorem is_open.inter (s t : set α) : is_open α s → is_open α t → is_open α (s ∩ t) :=
 complete_lattice.inf_continuous'
@@ -52,11 +53,10 @@ begin
   simp only [is_open] at hs ⊢,
   convert complete_lattice.Sup_continuous' (set_of ⁻¹' s) _,
   { ext1 x,
-    simp only [Sup_apply, set.set_of_bijective.surjective.exists, exists_prop, set.mem_preimage,
-      set_coe.exists, supr_Prop_eq, set.mem_set_of_eq, subtype.coe_mk] },
+    simp only [Sup_apply, set_of_bijective.surjective.exists, exists_prop, mem_preimage,
+      set_coe.exists, supr_Prop_eq, mem_set_of_eq, subtype.coe_mk, mem_sUnion] },
   { intros p hp,
-    convert hs (set_of p) (set.mem_preimage.1 hp),
-    simp only [set.mem_set_of_eq] },
+    exact hs (set_of p) (mem_preimage.1 hp) },
 end
 
 end Scott
@@ -90,7 +90,7 @@ begin
   existsi h, rintros c,
   apply eq_of_forall_ge_iff, intro z,
   rw ωSup_le_iff,
-  simp only [ωSup_le_iff, not_below, set.mem_set_of_eq, le_Prop_eq, order_hom.coe_fun_mk,
+  simp only [ωSup_le_iff, not_below, mem_set_of_eq, le_Prop_eq, order_hom.coe_fun_mk,
              chain.map_coe, function.comp_app, exists_imp_distrib, not_forall],
 end
 
@@ -117,16 +117,16 @@ begin
   have h : monotone f,
   { intros x y h,
     cases (hf {x | ¬ x ≤ f y} (not_below_is_open _)) with hf hf', clear hf',
-    specialize hf h, simp only [set.preimage, set_of, (∈), set.mem, le_Prop_eq] at hf,
-    by_contradiction H, apply hf H (le_refl (f y)) },
+    specialize hf h, simp only [preimage, mem_set_of_eq, le_Prop_eq] at hf,
+    by_contradiction H, apply hf H le_rfl },
   existsi h, intro c,
   apply eq_of_forall_ge_iff, intro z,
   specialize (hf _ (not_below_is_open z)),
   cases hf, specialize hf_h c,
-  simp only [not_below, order_hom.coe_fun_mk, eq_iff_iff, set.mem_set_of_eq] at hf_h,
+  simp only [not_below, order_hom.coe_fun_mk, eq_iff_iff, mem_set_of_eq] at hf_h,
   rw [← not_iff_not],
   simp only [ωSup_le_iff, hf_h, ωSup, supr, Sup, complete_lattice.Sup, complete_semilattice_Sup.Sup,
-    exists_prop, set.mem_range, order_hom.coe_fun_mk, chain.map_coe, function.comp_app,
+    exists_prop, mem_range, order_hom.coe_fun_mk, chain.map_coe, function.comp_app,
     eq_iff_iff, not_forall],
   tauto,
 end
diff --git a/src/topology/order.lean b/src/topology/order.lean
index 8ceb8536a921a..23445685a8349 100644
--- a/src/topology/order.lean
+++ b/src/topology/order.lean
@@ -8,6 +8,9 @@ import topology.tactic
 /-!
 # Ordering on topologies and (co)induced topologies
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Topologies on a fixed type `α` are ordered, by reverse inclusion.
 That is, for topologies `t₁` and `t₂` on `α`, we write `t₁ ≤ t₂`
 if every set open in `t₂` is also open in `t₁`.
@@ -41,8 +44,8 @@ finer, coarser, induced topology, coinduced topology
 
 -/
 
-open set filter classical
-open_locale classical topological_space filter
+open function set filter
+open_locale topology filter
 
 universes u v w
 
@@ -64,28 +67,23 @@ def generate_from (g : set (set α)) : topological_space α :=
   is_open_sUnion := generate_open.sUnion }
 
 lemma is_open_generate_from_of_mem {g : set (set α)} {s : set α} (hs : s ∈ g) :
-  @is_open _ (generate_from g) s :=
+  is_open[generate_from g] s :=
 generate_open.basic s hs
 
 lemma nhds_generate_from {g : set (set α)} {a : α} :
   @nhds α (generate_from g) a = (⨅s∈{s | a ∈ s ∧ s ∈ g}, 𝓟 s) :=
-by rw nhds_def; exact le_antisymm
-  (binfi_mono $ λ s ⟨as, sg⟩, ⟨as, generate_open.basic _ sg⟩)
-  (le_infi $ assume s, le_infi $ assume ⟨as, hs⟩,
-    begin
-      revert as, clear_, induction hs,
-      case generate_open.basic : s hs
-      { exact assume as, infi_le_of_le s $ infi_le _ ⟨as, hs⟩ },
-      case generate_open.univ
-      { rw [principal_univ],
-        exact assume _, le_top },
-      case generate_open.inter : s t hs' ht' hs ht
-      { exact assume ⟨has, hat⟩, calc _ ≤ 𝓟 s ⊓ 𝓟 t : le_inf (hs has) (ht hat)
-          ... = _ : inf_principal },
-      case generate_open.sUnion : k hk' hk
-      { exact λ ⟨t, htk, hat⟩, calc _ ≤ 𝓟 t : hk t htk hat
-          ... ≤ _ : le_principal_iff.2 $ subset_sUnion_of_mem htk }
-    end)
+begin
+  rw nhds_def,
+  refine le_antisymm (binfi_mono $ λ s ⟨as, sg⟩, ⟨as, generate_open.basic _ sg⟩) _,
+  refine le_infi₂ (λ s hs, _), cases hs with ha hs,
+  induction hs,
+  case basic : s hs { exact infi₂_le _ ⟨ha, hs⟩ },
+  case univ : { exact le_top.trans_eq principal_univ.symm },
+  case inter : s t hs' ht' hs ht { exact (le_inf (hs ha.1) (ht ha.2)).trans_eq inf_principal },
+  case sUnion : S hS' hS
+  { rcases ha with  ⟨t, htS, hat⟩,
+    exact (hS t htS hat).trans (principal_mono.2 $ subset_sUnion_of_mem htS) }
+end
 
 lemma tendsto_nhds_generate_from {β : Type*} {m : α → β} {f : filter α} {g : set (set β)} {b : β}
   (h : ∀s∈g, b ∈ s → m ⁻¹' s ∈ f) : tendsto m f (@nhds β (generate_from g) b) :=
@@ -101,7 +99,7 @@ protected def mk_of_nhds (n : α → filter α) : topological_space α :=
     mem_of_superset (hs x hx _ hxa) (set.subset_sUnion_of_mem hx) }
 
 lemma nhds_mk_of_nhds (n : α → filter α) (a : α)
-  (h₀ : pure ≤ n) (h₁ : ∀{a s}, s ∈ n a → ∃ t ∈ n a, t ⊆ s ∧ ∀a' ∈ t, s ∈ n a') :
+  (h₀ : pure ≤ n) (h₁ : ∀ a s, s ∈ n a → ∃ t ∈ n a, t ⊆ s ∧ ∀a' ∈ t, s ∈ n a') :
   @nhds α (topological_space.mk_of_nhds n) a = n a :=
 begin
   letI := topological_space.mk_of_nhds n,
@@ -109,13 +107,28 @@ begin
   { have h₀ : {b | s ∈ n b} ⊆ s := assume b hb, mem_pure.1 $ h₀ b hb,
     have h₁ : {b | s ∈ n b} ∈ 𝓝 a,
     { refine is_open.mem_nhds (assume b (hb : s ∈ n b), _) hs,
-      rcases h₁ hb with ⟨t, ht, hts, h⟩,
+      rcases h₁ _ _ hb with ⟨t, ht, hts, h⟩,
       exact mem_of_superset ht h },
     exact mem_of_superset h₁ h₀ },
   { rcases (@mem_nhds_iff α (topological_space.mk_of_nhds n) _ _).1 hs with ⟨t, hts, ht, hat⟩,
     exact (n a).sets_of_superset (ht _ hat) hts },
 end
 
+lemma nhds_mk_of_nhds_single [decidable_eq α] {a₀ : α} {l : filter α} (h : pure a₀ ≤ l) (b : α) :
+  @nhds α (topological_space.mk_of_nhds $ update pure a₀ l) b =
+    (update pure a₀ l : α → filter α) b :=
+begin
+  refine nhds_mk_of_nhds _ _ (le_update_iff.mpr ⟨h, λ _ _, le_rfl⟩) (λ a s hs, _),
+  rcases eq_or_ne a a₀ with rfl|ha,
+  { refine ⟨s, hs, subset.rfl, λ b hb, _⟩,
+    rcases eq_or_ne b a with rfl|hb,
+    { exact hs },
+    { rwa [update_noteq hb] } },
+  { have hs' := hs,
+    rw [update_noteq ha] at hs ⊢,
+    exact ⟨{a}, rfl, singleton_subset_iff.mpr hs, forall_eq.2 hs'⟩ }
+end
+
 lemma nhds_mk_of_nhds_filter_basis (B : α → filter_basis α) (a : α) (h₀ : ∀ x (n ∈ B x), x ∈ n)
   (h₁ : ∀ x (n ∈ B x), ∃ n₁ ∈ B x, n₁ ⊆ n ∧ ∀ x' ∈ n₁, ∃ n₂ ∈ B x', n₂ ⊆ n) :
   @nhds α (topological_space.mk_of_nhds (λ x, (B x).filter)) a = (B a).filter :=
@@ -130,120 +143,116 @@ begin
     exact ⟨n₂, hn₄, hn₅.trans hm₂⟩, },
 end
 
-end topological_space
-
 section lattice
 
-variables {α : Type u} {β : Type v}
+/-- The ordering on topologies on the type `α`. `t ≤ s` if every set open in `s` is also open in `t`
+(`t` is finer than `s`). -/
+instance : partial_order (topological_space α) :=
+{ le := λ s t, ∀ U, is_open[t] U → is_open[s] U,
+  .. partial_order.lift (λ s, order_dual.to_dual (is_open[s])) (λ _ _, topological_space_eq) }
+
+protected lemma le_def {α} {t s : topological_space α} : t ≤ s ↔ is_open[s] ≤ is_open[t] :=
+iff.rfl
 
-/-- The inclusion ordering on topologies on α. We use it to get a complete
-   lattice instance via the Galois insertion method, but the partial order
-   that we will eventually impose on `topological_space α` is the reverse one. -/
-def tmp_order : partial_order (topological_space α) :=
-{ le          := λt s, t.is_open ≤ s.is_open,
-  le_antisymm := assume t s h₁ h₂, topological_space_eq $ le_antisymm h₁ h₂,
-  le_refl     := assume t, le_refl t.is_open,
-  le_trans    := assume a b c h₁ h₂, @le_trans _ _ a.is_open b.is_open c.is_open h₁ h₂ }
-
-local attribute [instance] tmp_order
-
-/- We'll later restate this lemma in terms of the correct order on `topological_space α`. -/
-private lemma generate_from_le_iff_subset_is_open {g : set (set α)} {t : topological_space α} :
-  topological_space.generate_from g ≤ t ↔ g ⊆ {s | t.is_open s} :=
-iff.intro
-  (assume ht s hs, ht _ $ topological_space.generate_open.basic s hs)
-  (assume hg s hs, hs.rec_on (assume v hv, hg hv)
-    t.is_open_univ (assume u v _ _, t.is_open_inter u v) (assume k _, t.is_open_sUnion k))
-
-/-- If `s` equals the collection of open sets in the topology it generates,
-  then `s` defines a topology. -/
-protected def mk_of_closure (s : set (set α))
-  (hs : {u | (topological_space.generate_from s).is_open u} = s) : topological_space α :=
-{ is_open        := λu, u ∈ s,
+lemma le_generate_from_iff_subset_is_open {g : set (set α)} {t : topological_space α} :
+  t ≤ topological_space.generate_from g ↔ g ⊆ {s | is_open[t] s} :=
+⟨λ ht s hs, ht _ $ generate_open.basic s hs, λ hg s hs, hs.rec_on (assume v hv, hg hv)
+  t.is_open_univ (assume u v _ _, t.is_open_inter u v) (assume k _, t.is_open_sUnion k)⟩
+
+/-- If `s` equals the collection of open sets in the topology it generates, then `s` defines a
+topology. -/
+protected def mk_of_closure (s : set (set α)) (hs : {u | generate_open s u} = s) :
+  topological_space α :=
+{ is_open        := λ u, u ∈ s,
   is_open_univ   := hs ▸ topological_space.generate_open.univ,
   is_open_inter  := hs ▸ topological_space.generate_open.inter,
   is_open_sUnion := hs ▸ topological_space.generate_open.sUnion }
 
-lemma mk_of_closure_sets {s : set (set α)}
-  {hs : {u | (topological_space.generate_from s).is_open u} = s} :
-  mk_of_closure s hs = topological_space.generate_from s :=
+lemma mk_of_closure_sets {s : set (set α)} {hs : {u | generate_open s u} = s} :
+  topological_space.mk_of_closure s hs = topological_space.generate_from s :=
 topological_space_eq hs.symm
 
-/-- The Galois insertion between `set (set α)` and `topological_space α` whose lower part
-  sends a collection of subsets of α to the topology they generate, and whose upper part
-  sends a topology to its collection of open subsets. -/
-def gi_generate_from (α : Type*) :
-  galois_insertion topological_space.generate_from (λt:topological_space α, {s | t.is_open s}) :=
-{ gc        := assume g t, generate_from_le_iff_subset_is_open,
-  le_l_u    := assume ts s hs, topological_space.generate_open.basic s hs,
-  choice    := λg hg, mk_of_closure g
-    (subset.antisymm hg $ generate_from_le_iff_subset_is_open.1 $ le_rfl),
+lemma gc_generate_from (α) :
+  galois_connection (λ t : topological_space α, order_dual.to_dual {s | is_open[t] s})
+    (generate_from ∘ order_dual.of_dual) :=
+λ _ _, le_generate_from_iff_subset_is_open.symm
+
+/-- The Galois coinsertion between `topological_space α` and `(set (set α))ᵒᵈ` whose lower part
+  sends a topology to its collection of open subsets, and whose upper part sends a collection of
+  subsets of α to the topology they generate. -/
+def gci_generate_from (α : Type*) :
+  galois_coinsertion (λ t : topological_space α, order_dual.to_dual {s | is_open[t] s})
+    (generate_from ∘ order_dual.of_dual)  :=
+{ gc        := gc_generate_from α,
+  u_l_le    := assume ts s hs, generate_open.basic s hs,
+  choice    := λg hg, topological_space.mk_of_closure g
+    (subset.antisymm hg $ le_generate_from_iff_subset_is_open.1 $ le_rfl),
   choice_eq := assume s hs, mk_of_closure_sets }
 
-lemma generate_from_mono {α} {g₁ g₂ : set (set α)} (h : g₁ ⊆ g₂) :
-  topological_space.generate_from g₁ ≤ topological_space.generate_from g₂ :=
-(gi_generate_from _).gc.monotone_l h
+/-- Topologies on `α` form a complete lattice, with `⊥` the discrete topology
+  and `⊤` the indiscrete topology. The infimum of a collection of topologies
+  is the topology generated by all their open sets, while the supremum is the
+  topology whose open sets are those sets open in every member of the collection. -/
+instance : complete_lattice (topological_space α) :=
+(gci_generate_from α).lift_complete_lattice
+
+@[mono] lemma generate_from_anti {α} {g₁ g₂ : set (set α)} (h : g₁ ⊆ g₂) :
+  generate_from g₂ ≤ generate_from g₁ :=
+(gc_generate_from _).monotone_u h
 
 lemma generate_from_set_of_is_open (t : topological_space α) :
-  topological_space.generate_from {s | t.is_open s} = t :=
-(gi_generate_from α).l_u_eq t
+  generate_from {s | is_open[t] s} = t :=
+(gci_generate_from α).u_l_eq t
 
 lemma left_inverse_generate_from :
-  function.left_inverse topological_space.generate_from
-    (λ t : topological_space α, {s | t.is_open s}) :=
-(gi_generate_from α).left_inverse_l_u
+  left_inverse generate_from (λ t : topological_space α, {s | is_open[t] s}) :=
+(gci_generate_from α).u_l_left_inverse
 
 lemma generate_from_surjective :
-  function.surjective (topological_space.generate_from : set (set α) → topological_space α) :=
-(gi_generate_from α).l_surjective
+  surjective (generate_from : set (set α) → topological_space α) :=
+(gci_generate_from α).u_surjective
 
-lemma set_of_is_open_injective :
-  function.injective (λ t : topological_space α, {s | t.is_open s}) :=
-(gi_generate_from α).u_injective
+lemma set_of_is_open_injective : injective (λ t : topological_space α, {s | is_open[t] s}) :=
+(gci_generate_from α).l_injective
 
-/-- The "temporary" order `tmp_order` on `topological_space α`, i.e. the inclusion order, is a
-complete lattice.  (Note that later `topological_space α` will equipped with the dual order to
-`tmp_order`). -/
-def tmp_complete_lattice {α : Type u} : complete_lattice (topological_space α) :=
-(gi_generate_from α).lift_complete_lattice
+end lattice
 
-instance : has_le (topological_space α) :=
-{ le          := λ t s, s.is_open ≤ t.is_open }
+end topological_space
 
-protected lemma topological_space.le_def {α} {t s : topological_space α} :
-  t ≤ s ↔ s.is_open ≤ t.is_open := iff.rfl
+section lattice
 
-/-- The ordering on topologies on the type `α`.
-  `t ≤ s` if every set open in `s` is also open in `t` (`t` is finer than `s`). -/
-instance : partial_order (topological_space α) :=
-{ le_antisymm := assume t s h₁ h₂, topological_space_eq $ le_antisymm h₂ h₁,
-  le_refl     := assume t, le_refl t.is_open,
-  le_trans    := assume a b c h₁ h₂, topological_space.le_def.mpr (le_trans h₂ h₁),
-  ..topological_space.has_le }
+variables {α : Type u} {β : Type v}
 
-lemma le_generate_from_iff_subset_is_open {g : set (set α)} {t : topological_space α} :
-  t ≤ topological_space.generate_from g ↔ g ⊆ {s | t.is_open s} :=
-generate_from_le_iff_subset_is_open
+lemma is_open.mono {α} {t₁ t₂ : topological_space α} {s : set α} (hs : is_open[t₂] s)
+  (h : t₁ ≤ t₂) : is_open[t₁] s := h s hs
 
-/-- Topologies on `α` form a complete lattice, with `⊥` the discrete topology
-  and `⊤` the indiscrete topology. The infimum of a collection of topologies
-  is the topology generated by all their open sets, while the supremum is the
-  topology whose open sets are those sets open in every member of the collection. -/
-instance : complete_lattice (topological_space α) :=
-@order_dual.complete_lattice _ tmp_complete_lattice
+lemma is_closed.mono {α} {t₁ t₂ : topological_space α} {s : set α} (hs : is_closed[t₂] s)
+  (h : t₁ ≤ t₂) : is_closed[t₁] s :=
+(@is_open_compl_iff α t₁ s).mp $ hs.is_open_compl.mono h
 
 lemma is_open_implies_is_open_iff {a b : topological_space α} :
-  (∀ s, a.is_open s → b.is_open s) ↔ b ≤ a :=
+  (∀ s, is_open[a] s → is_open[b] s) ↔ b ≤ a :=
 iff.rfl
 
+/-- The only open sets in the indiscrete topology are the empty set and the whole space. -/
+lemma topological_space.is_open_top_iff {α} (U : set α) :
+  is_open[⊤] U ↔ U = ∅ ∨ U = univ :=
+⟨λ h, begin
+  induction h with V h _ _ _ _ ih₁ ih₂ _ _ ih,
+  { cases h }, { exact or.inr rfl },
+  { obtain ⟨rfl|rfl, rfl|rfl⟩ := ⟨ih₁, ih₂⟩; simp },
+  { rw [sUnion_eq_empty, or_iff_not_imp_left],
+    intro h, push_neg at h, obtain ⟨U, hU, hne⟩ := h,
+    have := (ih U hU).resolve_left hne, subst this,
+    refine sUnion_eq_univ_iff.2 (λ a, ⟨_, hU, trivial⟩) },
+end, by { rintro (rfl|rfl), exacts [@is_open_empty _ ⊤, @is_open_univ _ ⊤] }⟩
+
 /-- A topological space is discrete if every set is open, that is,
   its topology equals the discrete topology `⊥`. -/
 class discrete_topology (α : Type*) [t : topological_space α] : Prop :=
 (eq_bot [] : t = ⊥)
 
-@[priority 100]
-instance discrete_topology_bot (α : Type*) : @discrete_topology α ⊥ :=
-{ eq_bot := rfl }
+lemma discrete_topology_bot (α : Type*) : @discrete_topology α ⊥ := @discrete_topology.mk α ⊥ rfl
 
 @[simp] lemma is_open_discrete [topological_space α] [discrete_topology α] (s : set α) :
   is_open s :=
@@ -251,22 +260,16 @@ instance discrete_topology_bot (α : Type*) : @discrete_topology α ⊥ :=
 
 @[simp] lemma is_closed_discrete [topological_space α] [discrete_topology α] (s : set α) :
   is_closed s :=
-is_open_compl_iff.1 $ (discrete_topology.eq_bot α).symm ▸ trivial
+is_open_compl_iff.1 $ is_open_discrete _
 
 @[nontriviality]
 lemma continuous_of_discrete_topology [topological_space α] [discrete_topology α]
   [topological_space β] {f : α → β} : continuous f :=
-continuous_def.2 $ λs hs, is_open_discrete _
-
-lemma nhds_bot (α : Type*) : (@nhds α ⊥) = pure :=
-begin
-  refine le_antisymm _ (@pure_le_nhds α ⊥),
-  assume a s hs,
-  exact @is_open.mem_nhds α ⊥ a s trivial hs
-end
+continuous_def.2 $ λ s hs, is_open_discrete _
 
-lemma nhds_discrete (α : Type*) [topological_space α] [discrete_topology α] : (@nhds α _) = pure :=
-(discrete_topology.eq_bot α).symm ▸ nhds_bot α
+@[simp] lemma nhds_discrete (α : Type*) [topological_space α] [discrete_topology α] :
+  (@nhds α _) = pure :=
+le_antisymm (λ _ s hs, (is_open_discrete s).mem_nhds hs) pure_le_nhds
 
 lemma mem_nhds_discrete [topological_space α] [discrete_topology α] {x : α} {s : set α} :
   s ∈ 𝓝 x ↔ x ∈ s :=
@@ -274,8 +277,11 @@ by rw [nhds_discrete, mem_pure]
 
 lemma le_of_nhds_le_nhds {t₁ t₂ : topological_space α} (h : ∀x, @nhds α t₁ x ≤ @nhds α t₂ x) :
   t₁ ≤ t₂ :=
-assume s, show @is_open α t₂ s → @is_open α t₁ s,
-  by { simp only [is_open_iff_nhds, le_principal_iff],  exact assume hs a ha, h _ $ hs _ ha }
+begin
+  intro s,
+  rw [@is_open_iff_mem_nhds _ t₁, @is_open_iff_mem_nhds α t₂],
+  exact λ hs a ha, h _ (hs _ ha)
+end
 
 lemma eq_of_nhds_eq_nhds {t₁ t₂ : topological_space α} (h : ∀x, @nhds α t₁ x = @nhds α t₂ x) :
   t₁ = t₂ :=
@@ -283,17 +289,33 @@ le_antisymm
   (le_of_nhds_le_nhds $ assume x, le_of_eq $ h x)
   (le_of_nhds_le_nhds $ assume x, le_of_eq $ (h x).symm)
 
-lemma eq_bot_of_singletons_open {t : topological_space α} (h : ∀ x, t.is_open {x}) : t = ⊥ :=
+lemma eq_bot_of_singletons_open {t : topological_space α} (h : ∀ x, is_open[t] {x}) : t = ⊥ :=
 bot_unique $ λ s hs, bUnion_of_singleton s ▸ is_open_bUnion (λ x _, h x)
 
 lemma forall_open_iff_discrete {X : Type*} [topological_space X] :
   (∀ s : set X, is_open s) ↔ discrete_topology X :=
-⟨λ h, ⟨by { ext U , show is_open U ↔ true, simp [h U] }⟩, λ a, @is_open_discrete _ _ a⟩
+⟨λ h, ⟨eq_bot_of_singletons_open $ λ _, h _⟩, @is_open_discrete _ _⟩
 
 lemma singletons_open_iff_discrete {X : Type*} [topological_space X] :
   (∀ a : X, is_open ({a} : set X)) ↔ discrete_topology X :=
 ⟨λ h, ⟨eq_bot_of_singletons_open h⟩, λ a _, @is_open_discrete _ _ a _⟩
 
+lemma discrete_topology_iff_singleton_mem_nhds [topological_space α] :
+  discrete_topology α ↔ ∀ x : α, {x} ∈ 𝓝 x :=
+by simp only [← singletons_open_iff_discrete, is_open_iff_mem_nhds, mem_singleton_iff, forall_eq]
+
+/-- This lemma characterizes discrete topological spaces as those whose singletons are
+neighbourhoods. -/
+lemma discrete_topology_iff_nhds [topological_space α] :
+  discrete_topology α ↔ ∀ x : α, 𝓝 x = pure x :=
+by simp only [discrete_topology_iff_singleton_mem_nhds, ← nhds_ne_bot.le_pure_iff,
+  le_pure_iff]
+
+lemma discrete_topology_iff_nhds_ne [topological_space α] :
+  discrete_topology α ↔ ∀ x : α, 𝓝[≠] x = ⊥ :=
+by simp only [discrete_topology_iff_singleton_mem_nhds, nhds_within, inf_principal_eq_bot,
+  compl_compl]
+
 end lattice
 
 section galois_connection
@@ -304,10 +326,10 @@ variables {α : Type*} {β : Type*} {γ : Type*}
   makes `f` continuous. -/
 def topological_space.induced {α : Type u} {β : Type v} (f : α → β) (t : topological_space β) :
   topological_space α :=
-{ is_open        := λs, ∃s', t.is_open s' ∧ f ⁻¹' s' = s,
-  is_open_univ   := ⟨univ, t.is_open_univ, preimage_univ⟩,
+{ is_open        := λs, ∃ s', is_open s' ∧ f ⁻¹' s' = s,
+  is_open_univ   := ⟨univ, is_open_univ, preimage_univ⟩,
   is_open_inter  := by rintro s₁ s₂ ⟨s'₁, hs₁, rfl⟩ ⟨s'₂, hs₂, rfl⟩;
-    exact ⟨s'₁ ∩ s'₂, t.is_open_inter _ _ hs₁ hs₂, preimage_inter⟩,
+    exact ⟨s'₁ ∩ s'₂, hs₁.inter hs₂, preimage_inter⟩,
   is_open_sUnion := assume s h,
   begin
     simp only [classical.skolem] at h,
@@ -319,15 +341,11 @@ def topological_space.induced {α : Type u} {β : Type v} (f : α → β) (t : t
   end }
 
 lemma is_open_induced_iff [t : topological_space β] {s : set α} {f : α → β} :
-  @is_open α (t.induced f) s ↔ (∃t, is_open t ∧ f ⁻¹' t = s) :=
-iff.rfl
-
-lemma is_open_induced_iff' [t : topological_space β] {s : set α} {f : α → β} :
-  (t.induced f).is_open s ↔ (∃t, is_open t ∧ f ⁻¹' t = s) :=
+  is_open[t.induced f] s ↔ (∃t, is_open t ∧ f ⁻¹' t = s) :=
 iff.rfl
 
 lemma is_closed_induced_iff [t : topological_space β] {s : set α} {f : α → β} :
-  @is_closed α (t.induced f) s ↔ (∃t, is_closed t ∧ f ⁻¹' t = s) :=
+  is_closed[t.induced f] s ↔ (∃t, is_closed t ∧ f ⁻¹' t = s) :=
 begin
   simp only [← is_open_compl_iff, is_open_induced_iff],
   exact compl_surjective.exists.trans (by simp only [preimage_compl, compl_inj_iff])
@@ -338,15 +356,13 @@ end
   makes `f` continuous. -/
 def topological_space.coinduced {α : Type u} {β : Type v} (f : α → β) (t : topological_space α) :
   topological_space β :=
-{ is_open        := λs, t.is_open (f ⁻¹' s),
-  is_open_univ   := by rw preimage_univ; exact t.is_open_univ,
-  is_open_inter  := assume s₁ s₂ h₁ h₂, by rw preimage_inter; exact t.is_open_inter _ _ h₁ h₂,
-  is_open_sUnion := assume s h, by rw [preimage_sUnion]; exact (@is_open_Union _ _ t _ $ assume i,
-    show is_open (⋃ (H : i ∈ s), f ⁻¹' i), from
-      @is_open_Union _ _ t _ $ assume hi, h i hi) }
+{ is_open        := λ s, is_open[t] (f ⁻¹' s),
+  is_open_univ   := t.is_open_univ,
+  is_open_inter  := λ _ _ h₁ h₂, h₁.inter h₂,
+  is_open_sUnion := λ s h, by simpa only [preimage_sUnion] using is_open_bUnion h }
 
 lemma is_open_coinduced {t : topological_space α} {s : set β} {f : α → β} :
-  @is_open β (topological_space.coinduced f t) s ↔ is_open (f ⁻¹' s) :=
+  is_open[t.coinduced f] s ↔ is_open (f ⁻¹' s) :=
 iff.rfl
 
 lemma preimage_nhds_coinduced [topological_space α] {π : α → β} {s : set β}
@@ -366,9 +382,7 @@ lemma continuous.coinduced_le (h : @continuous α β t t' f) :
 lemma coinduced_le_iff_le_induced {f : α → β} {tα : topological_space α}
   {tβ : topological_space β} :
   tα.coinduced f ≤ tβ ↔ tα ≤ tβ.induced f :=
-iff.intro
-  (assume h s ⟨t, ht, hst⟩, hst ▸ h _ ht)
-  (assume h s hs, show tα.is_open (f ⁻¹' s), from h _ ⟨s, hs, rfl⟩)
+⟨λ h s ⟨t, ht, hst⟩, hst ▸ h _ ht, λ h s hs, h _ ⟨s, hs, rfl⟩⟩
 
 lemma continuous.le_induced (h : @continuous α β t t' f) :
   t ≤ t'.induced f :=
@@ -431,11 +445,8 @@ begin
   ext t U,
   split,
   { rintros ⟨V, hV, rfl⟩,
-    change t.is_open (e ⁻¹' _),
-    rwa [← preimage_comp, ← equiv.coe_trans, equiv.self_trans_symm] },
-  { intros hU,
-    refine ⟨e ⁻¹' U, hU, _⟩,
-    rw [← preimage_comp, ← equiv.coe_trans, equiv.symm_trans_self, equiv.coe_refl, preimage_id] }
+    rwa [is_open_coinduced, e.preimage_symm_preimage] },
+  { exact λ hU, ⟨e ⁻¹' U, hU, e.symm_preimage_preimage _⟩ }
 end
 
 lemma equiv.coinduced_symm {α β : Type*} (e : α ≃ β) :
@@ -451,7 +462,7 @@ open topological_space
 variables {α : Type u} {β : Type v}
 
 instance inhabited_topological_space {α : Type u} : inhabited (topological_space α) :=
-⟨⊤⟩
+⟨⊥⟩
 
 @[priority 100]
 instance subsingleton.unique_topological_space [subsingleton α] :
@@ -478,9 +489,16 @@ instance : discrete_topology ℕ := ⟨rfl⟩
 instance : topological_space ℤ := ⊥
 instance : discrete_topology ℤ := ⟨rfl⟩
 
+instance {n} : topological_space (fin n) := ⊥
+instance {n} : discrete_topology (fin n) := ⟨rfl⟩
+
 instance sierpinski_space : topological_space Prop :=
 generate_from {{true}}
 
+lemma continuous_empty_function [topological_space α] [topological_space β] [is_empty β]
+  (f : α → β) : continuous f :=
+by { letI := function.is_empty f, exact continuous_of_discrete_topology }
+
 lemma le_generate_from {t : topological_space α} { g : set (set α) } (h : ∀s∈g, is_open s) :
   t ≤ generate_from g :=
 le_generate_from_iff_subset_is_open.2 h
@@ -546,7 +564,7 @@ begin
 end
 
 lemma is_open_singleton_nhds_adjoint {α : Type*} {a b : α} (f : filter α) (hb : b ≠ a) :
-  @is_open α (nhds_adjoint a f) {b} :=
+  is_open[nhds_adjoint a f] {b} :=
 begin
   rw is_open_singleton_iff_nhds_eq_pure,
   exact nhds_adjoint_nhds_of_ne a f hb
@@ -572,7 +590,7 @@ begin
 end
 
 lemma le_nhds_adjoint_iff {α : Type*} (a : α) (f : filter α) (t : topological_space α) :
-  t ≤ nhds_adjoint a f ↔ (@nhds α t a ≤ pure a ⊔ f ∧ ∀ b, b ≠ a → t.is_open {b}) :=
+  t ≤ nhds_adjoint a f ↔ (@nhds α t a ≤ pure a ⊔ f ∧ ∀ b, b ≠ a → is_open[t] {b}) :=
 begin
   change _ ↔ _ ∧ ∀ (b : α), b ≠ a → is_open {b},
   rw [le_nhds_adjoint_iff', and.congr_right_iff],
@@ -591,6 +609,10 @@ lemma nhds_inf {t₁ t₂ : topological_space α} {a : α} :
 
 lemma nhds_top {a : α} : @nhds α ⊤ a = ⊤ := (gc_nhds a).u_top
 
+lemma is_open_sup {t₁ t₂ : topological_space α} {s : set α} :
+  is_open[t₁ ⊔ t₂] s ↔ is_open[t₁] s ∧ is_open[t₂] s :=
+iff.rfl
+
 local notation `cont` := @continuous _ _
 local notation `tspace` := topological_space
 open topological_space
@@ -613,29 +635,16 @@ continuous_iff_coinduced_le.2 $ le_generate_from h
 lemma continuous_induced_dom {t : tspace β} : cont (induced f t) t f :=
 by { rw continuous_def, assume s h, exact ⟨_, h, rfl⟩ }
 
-lemma continuous_induced_rng {g : γ → α} {t₂ : tspace β} {t₁ : tspace γ}
-  (h : cont t₁ t₂ (f ∘ g)) : cont t₁ (induced f t₂) g :=
-begin
-  rw continuous_def,
-  rintros s ⟨t, ht, s_eq⟩,
-  simpa [← s_eq] using continuous_def.1 h t ht,
-end
-
-lemma continuous_induced_rng' [topological_space α] [topological_space β] [topological_space γ]
-  {g : γ → α} (f : α → β) (H : ‹topological_space α› = ‹topological_space β›.induced f)
-  (h : continuous (f ∘ g)) : continuous g :=
-H.symm ▸ continuous_induced_rng h
+lemma continuous_induced_rng {g : γ → α} {t₂ : tspace β} {t₁ : tspace γ} :
+  cont t₁ (induced f t₂) g ↔ cont t₁ t₂ (f ∘ g) :=
+by simp only [continuous_iff_le_induced, induced_compose]
 
 lemma continuous_coinduced_rng {t : tspace α} : cont t (coinduced f t) f :=
 by { rw continuous_def, assume s h, exact h }
 
-lemma continuous_coinduced_dom {g : β → γ} {t₁ : tspace α} {t₂ : tspace γ}
-  (h : cont t₁ t₂ (g ∘ f)) : cont (coinduced f t₁) t₂ g :=
-begin
-  rw continuous_def at h ⊢,
-  assume s hs,
-  exact h _ hs
-end
+lemma continuous_coinduced_dom {g : β → γ} {t₁ : tspace α} {t₂ : tspace γ} :
+  cont (coinduced f t₁) t₂ g ↔ cont t₁ t₂ (g ∘ f) :=
+by simp only [continuous_iff_coinduced_le, coinduced_compose]
 
 lemma continuous_le_dom {t₁ t₂ : tspace α} {t₃ : tspace β}
   (h₁ : t₂ ≤ t₁) (h₂ : cont t₁ t₃ f) : cont t₂ t₃ f :=
@@ -653,13 +662,9 @@ begin
   exact h₂ s (h₁ s h)
 end
 
-lemma continuous_sup_dom {t₁ t₂ : tspace α} {t₃ : tspace β}
-  (h₁ : cont t₁ t₃ f) (h₂ : cont t₂ t₃ f) : cont (t₁ ⊔ t₂) t₃ f :=
-begin
-  rw continuous_def at h₁ h₂ ⊢,
-  assume s h,
-  exact ⟨h₁ s h, h₂ s h⟩
-end
+lemma continuous_sup_dom {t₁ t₂ : tspace α} {t₃ : tspace β} :
+  cont (t₁ ⊔ t₂) t₃ f ↔ cont t₁ t₃ f ∧ cont t₂ t₃ f :=
+by simp only [continuous_iff_le_induced, sup_le_iff]
 
 lemma continuous_sup_rng_left {t₁ : tspace α} {t₃ t₂ : tspace β} :
   cont t₁ t₂ f → cont t₁ (t₂ ⊔ t₃) f :=
@@ -669,27 +674,25 @@ lemma continuous_sup_rng_right {t₁ : tspace α} {t₃ t₂ : tspace β} :
   cont t₁ t₃ f → cont t₁ (t₂ ⊔ t₃) f :=
 continuous_le_rng le_sup_right
 
-lemma continuous_Sup_dom {t₁ : set (tspace α)} {t₂ : tspace β}
-  (h : ∀t∈t₁, cont t t₂ f) : cont (Sup t₁) t₂ f :=
-continuous_iff_le_induced.2 $ Sup_le $ assume t ht, continuous_iff_le_induced.1 $ h t ht
+lemma continuous_Sup_dom {T : set (tspace α)} {t₂ : tspace β} :
+  cont (Sup T) t₂ f ↔ ∀ t ∈ T, cont t t₂ f :=
+by simp only [continuous_iff_le_induced, Sup_le_iff]
 
 lemma continuous_Sup_rng {t₁ : tspace α} {t₂ : set (tspace β)} {t : tspace β}
   (h₁ : t ∈ t₂) (hf : cont t₁ t f) : cont t₁ (Sup t₂) f :=
 continuous_iff_coinduced_le.2 $ le_Sup_of_le h₁ $ continuous_iff_coinduced_le.1 hf
 
-lemma continuous_supr_dom {t₁ : ι → tspace α} {t₂ : tspace β}
-  (h : ∀i, cont (t₁ i) t₂ f) : cont (supr t₁) t₂ f :=
-continuous_Sup_dom $ assume t ⟨i, (t_eq : t₁ i = t)⟩, t_eq ▸ h i
+lemma continuous_supr_dom {t₁ : ι → tspace α} {t₂ : tspace β} :
+  cont (supr t₁) t₂ f ↔  ∀ i, cont (t₁ i) t₂ f :=
+by simp only [continuous_iff_le_induced, supr_le_iff]
 
 lemma continuous_supr_rng {t₁ : tspace α} {t₂ : ι → tspace β} {i : ι}
   (h : cont t₁ (t₂ i) f) : cont t₁ (supr t₂) f :=
 continuous_Sup_rng ⟨i, rfl⟩ h
 
-lemma continuous_inf_rng {t₁ : tspace α} {t₂ t₃ : tspace β}
-  (h₁ : cont t₁ t₂ f) (h₂ : cont t₁ t₃ f) : cont t₁ (t₂ ⊓ t₃) f :=
-continuous_iff_coinduced_le.2 $ le_inf
-  (continuous_iff_coinduced_le.1 h₁)
-  (continuous_iff_coinduced_le.1 h₂)
+lemma continuous_inf_rng {t₁ : tspace α} {t₂ t₃ : tspace β} :
+  cont t₁ (t₂ ⊓ t₃) f ↔ cont t₁ t₂ f ∧ cont t₁ t₃ f :=
+by simp only [continuous_iff_coinduced_le, le_inf_iff]
 
 lemma continuous_inf_dom_left {t₁ t₂ : tspace α} {t₃ : tspace β} :
   cont t₁ t₃ f → cont (t₁ ⊓ t₂) t₃ f :=
@@ -703,17 +706,17 @@ lemma continuous_Inf_dom {t₁ : set (tspace α)} {t₂ : tspace β} {t : tspace
   cont t t₂ f → cont (Inf t₁) t₂ f :=
 continuous_le_dom $ Inf_le h₁
 
-lemma continuous_Inf_rng {t₁ : tspace α} {t₂ : set (tspace β)}
-  (h : ∀t∈t₂, cont t₁ t f) : cont t₁ (Inf t₂) f :=
-continuous_iff_coinduced_le.2 $ le_Inf $ assume b hb, continuous_iff_coinduced_le.1 $ h b hb
+lemma continuous_Inf_rng {t₁ : tspace α} {T : set (tspace β)} :
+  cont t₁ (Inf T) f ↔ ∀ t ∈ T, cont t₁ t f :=
+by simp only [continuous_iff_coinduced_le, le_Inf_iff]
 
 lemma continuous_infi_dom {t₁ : ι → tspace α} {t₂ : tspace β} {i : ι} :
   cont (t₁ i) t₂ f → cont (infi t₁) t₂ f :=
 continuous_le_dom $ infi_le _ _
 
-lemma continuous_infi_rng {t₁ : tspace α} {t₂ : ι → tspace β}
-  (h : ∀i, cont t₁ (t₂ i) f) : cont t₁ (infi t₂) f :=
-continuous_iff_coinduced_le.2 $ le_infi $ assume i, continuous_iff_coinduced_le.1 $ h i
+lemma continuous_infi_rng {t₁ : tspace α} {t₂ : ι → tspace β} :
+  cont t₁ (infi t₂) f ↔ ∀ i, cont t₁ (t₂ i) f :=
+by simp only [continuous_iff_coinduced_le, le_infi_iff]
 
 @[continuity] lemma continuous_bot {t : tspace β} : cont ⊥ t f :=
 continuous_iff_le_induced.2 $ bot_le
@@ -721,12 +724,11 @@ continuous_iff_le_induced.2 $ bot_le
 @[continuity] lemma continuous_top {t : tspace α} : cont t ⊤ f :=
 continuous_iff_coinduced_le.2 $ le_top
 
+lemma continuous_id_iff_le {t t' : tspace α} : cont t t' id ↔ t ≤ t' :=
+@continuous_def _ _ t t' id
+
 lemma continuous_id_of_le {t t' : tspace α} (h : t ≤ t') : cont t t' id :=
-begin
-  rw continuous_def,
-  assume u hu,
-  exact h u hu
-end
+continuous_id_iff_le.2 h
 
 /- 𝓝 in the induced topology -/
 
@@ -750,7 +752,7 @@ tβ = tα.induced f ↔ ∀ b, 𝓝 b = comap f (𝓝 $ f b) :=
 ⟨λ h a, h.symm ▸ nhds_induced f a, λ h, eq_of_nhds_eq_nhds $ λ x, by rw [h, nhds_induced]⟩
 
 theorem map_nhds_induced_of_surjective [T : topological_space α]
-    {f : β → α} (hf : function.surjective f) (a : β) :
+    {f : β → α} (hf : surjective f) (a : β) :
   map f (@nhds β (topological_space.induced f T) a) = 𝓝 (f a) :=
 by rw [nhds_induced, map_comap_of_surjective hf]
 
@@ -762,10 +764,10 @@ variables {α : Type*} {β : Type*}
 variables [t : topological_space β] {f : α → β}
 
 theorem is_open_induced_eq {s : set α} :
-  @is_open _ (induced f t) s ↔ s ∈ preimage f '' {s | is_open s} :=
+  is_open[induced f t] s ↔ s ∈ preimage f '' {s | is_open s} :=
 iff.rfl
 
-theorem is_open_induced {s : set β} (h : is_open s) : (induced f t).is_open (f ⁻¹' s) :=
+theorem is_open_induced {s : set β} (h : is_open s) : is_open[induced f t] (f ⁻¹' s) :=
 ⟨s, h, rfl⟩
 
 lemma map_nhds_induced_eq (a : α) : map f (@nhds α (induced f t) a) = 𝓝[range f] (f a) :=
@@ -780,7 +782,7 @@ lemma closure_induced [t : topological_space β] {f : α → β} {a : α} {s : s
 by simp only [mem_closure_iff_frequently, nhds_induced, frequently_comap, mem_image, and_comm]
 
 lemma is_closed_induced_iff' [t : topological_space β] {f : α → β} {s : set α} :
-  @is_closed α (t.induced f) s ↔ ∀ a, f a ∈ closure (f '' s) → a ∈ s :=
+  is_closed[t.induced f] s ↔ ∀ a, f a ∈ closure (f '' s) → a ∈ s :=
 by simp only [← closure_subset_iff_is_closed, subset_def, closure_induced]
 
 end induced
@@ -789,16 +791,22 @@ section sierpinski
 variables {α : Type*} [topological_space α]
 
 @[simp] lemma is_open_singleton_true : is_open ({true} : set Prop) :=
-topological_space.generate_open.basic _ (by simp)
+topological_space.generate_open.basic _ (mem_singleton _)
+
+@[simp] lemma nhds_true : 𝓝 true = pure true :=
+le_antisymm (le_pure_iff.2 $ is_open_singleton_true.mem_nhds $ mem_singleton _) (pure_le_nhds _)
+
+@[simp] lemma nhds_false : 𝓝 false = ⊤ :=
+topological_space.nhds_generate_from.trans $ by simp [@and.comm (_ ∈ _)]
 
 lemma continuous_Prop {p : α → Prop} : continuous p ↔ is_open {x | p x} :=
 ⟨assume h : continuous p,
   have is_open (p ⁻¹' {true}),
     from is_open_singleton_true.preimage h,
-  by simp [preimage, eq_true] at this; assumption,
+  by simpa [preimage, eq_true_iff] using this,
   assume h : is_open {x | p x},
-  continuous_generated_from $ assume s (hs : s ∈ {{true}}),
-    by simp at hs; simp [hs, preimage, eq_true, h]⟩
+  continuous_generated_from $ assume s (hs : s = {true}),
+    by simp [hs, preimage, eq_true_iff, h]⟩
 
 lemma is_open_iff_continuous_mem {s : set α} : is_open s ↔ continuous (λ x, x ∈ s) :=
 continuous_Prop.symm
@@ -811,62 +819,56 @@ variables {α : Type u} {ι : Sort v}
 lemma generate_from_union (a₁ a₂ : set (set α)) :
   topological_space.generate_from (a₁ ∪ a₂) =
     topological_space.generate_from a₁ ⊓ topological_space.generate_from a₂ :=
-@galois_connection.l_sup _ (topological_space α)ᵒᵈ a₁ a₂ _ _ _ _
-  (λ g t, generate_from_le_iff_subset_is_open)
+(topological_space.gc_generate_from α).u_inf
 
 lemma set_of_is_open_sup (t₁ t₂ : topological_space α) :
-  {s | (t₁ ⊔ t₂).is_open s} = {s | t₁.is_open s} ∩ {s | t₂.is_open s} :=
-@galois_connection.u_inf _ (topological_space α)ᵒᵈ t₁ t₂ _ _ _ _
-  (λ g t, generate_from_le_iff_subset_is_open)
+  {s | is_open[t₁ ⊔ t₂] s} = {s | is_open[t₁] s} ∩ {s | is_open[t₂] s} :=
+rfl
 
 lemma generate_from_Union {f : ι → set (set α)} :
   topological_space.generate_from (⋃ i, f i) = (⨅ i, topological_space.generate_from (f i)) :=
-@galois_connection.l_supr _ (topological_space α)ᵒᵈ _ _ _ _ _
-  (λ g t, generate_from_le_iff_subset_is_open) f
+(topological_space.gc_generate_from α).u_infi
 
 lemma set_of_is_open_supr {t : ι → topological_space α} :
-  {s | (⨆ i, t i).is_open s} = ⋂ i, {s | (t i).is_open s} :=
-@galois_connection.u_infi _ (topological_space α)ᵒᵈ _ _ _ _ _
-  (λ g t, generate_from_le_iff_subset_is_open) t
+  {s | is_open[⨆ i, t i] s} = ⋂ i, {s | is_open[t i] s} :=
+(topological_space.gc_generate_from α).l_supr
 
 lemma generate_from_sUnion {S : set (set (set α))} :
   topological_space.generate_from (⋃₀ S) = (⨅ s ∈ S, topological_space.generate_from s) :=
-@galois_connection.l_Sup _ (topological_space α)ᵒᵈ _ _ _ _
-  (λ g t, generate_from_le_iff_subset_is_open) S
+(topological_space.gc_generate_from α).u_Inf
 
 lemma set_of_is_open_Sup {T : set (topological_space α)} :
-  {s | (Sup T).is_open s} = ⋂ t ∈ T, {s | (t : topological_space α).is_open s} :=
-@galois_connection.u_Inf _ (topological_space α)ᵒᵈ _ _ _ _
-  (λ g t, generate_from_le_iff_subset_is_open) T
+  {s | is_open[Sup T] s} = ⋂ t ∈ T, {s | is_open[t] s} :=
+(topological_space.gc_generate_from α).l_Sup
 
 lemma generate_from_union_is_open (a b : topological_space α) :
-  topological_space.generate_from ({s | a.is_open s} ∪ {s | b.is_open s}) = a ⊓ b :=
-@galois_insertion.l_sup_u _ (topological_space α)ᵒᵈ _ _ _ _ (gi_generate_from α) a b
+  topological_space.generate_from ({s | is_open[a] s} ∪ {s | is_open[b] s}) = a ⊓ b :=
+(topological_space.gci_generate_from α).u_inf_l a b
 
 lemma generate_from_Union_is_open (f : ι → topological_space α) :
-  topological_space.generate_from (⋃ i, {s | (f i).is_open s}) = ⨅ i, (f i) :=
-@galois_insertion.l_supr_u _ (topological_space α)ᵒᵈ _ _ _ _ (gi_generate_from α) _ f
+  topological_space.generate_from (⋃ i, {s | is_open[f i] s}) = ⨅ i, (f i) :=
+(topological_space.gci_generate_from α).u_infi_l f
 
 lemma generate_from_inter (a b : topological_space α) :
-  topological_space.generate_from ({s | a.is_open s} ∩ {s | b.is_open s}) = a ⊔ b :=
-@galois_insertion.l_inf_u _ (topological_space α)ᵒᵈ _ _ _ _ (gi_generate_from α) a b
+  topological_space.generate_from ({s | is_open[a] s} ∩ {s | is_open[b] s}) = a ⊔ b :=
+(topological_space.gci_generate_from α).u_sup_l a b
 
 lemma generate_from_Inter (f : ι → topological_space α) :
-  topological_space.generate_from (⋂ i, {s | (f i).is_open s}) = ⨆ i, (f i) :=
-@galois_insertion.l_infi_u _ (topological_space α)ᵒᵈ _ _ _ _ (gi_generate_from α) _ f
+  topological_space.generate_from (⋂ i, {s | is_open[f i] s}) = ⨆ i, (f i) :=
+(topological_space.gci_generate_from α).u_supr_l f
 
 lemma generate_from_Inter_of_generate_from_eq_self (f : ι → set (set α))
-  (hf : ∀ i, {s | (topological_space.generate_from (f i)).is_open s} = f i) :
+  (hf : ∀ i, {s | is_open[topological_space.generate_from (f i)] s} = f i) :
   topological_space.generate_from (⋂ i, (f i)) = ⨆ i, topological_space.generate_from (f i) :=
-@galois_insertion.l_infi_of_ul_eq_self _ (topological_space α)ᵒᵈ _ _ _ _ (gi_generate_from α) _ f hf
+(topological_space.gci_generate_from α).u_supr_of_lu_eq_self f hf
 
 variables {t : ι → topological_space α}
 
-lemma is_open_supr_iff {s : set α} : @is_open _ (⨆ i, t i) s ↔ ∀ i, @is_open _ (t i) s :=
-show s ∈ set_of (supr t).is_open ↔ s ∈ {x : set α | ∀ (i : ι), (t i).is_open x},
+lemma is_open_supr_iff {s : set α} : is_open[⨆ i, t i] s ↔ ∀ i, is_open[t i] s :=
+show s ∈ set_of (is_open[supr t]) ↔ s ∈ {x : set α | ∀ (i : ι), is_open[t i] x},
 by simp [set_of_is_open_supr]
 
-lemma is_closed_infi_iff {s : set α} : @is_closed _ (⨆ i, t i) s ↔ ∀ i, @is_closed _ (t i) s :=
+lemma is_closed_supr_iff {s : set α} : is_closed[⨆ i, t i] s ↔ ∀ i, is_closed[t i] s :=
 by simp [← is_open_compl_iff, is_open_supr_iff]
 
 end infi
diff --git a/src/topology/order/basic.lean b/src/topology/order/basic.lean
new file mode 100644
index 0000000000000..a17106de53df5
--- /dev/null
+++ b/src/topology/order/basic.lean
@@ -0,0 +1,2606 @@
+/-
+Copyright (c) 2017 Johannes Hölzl. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
+-/
+import data.set.intervals.pi
+import data.set.pointwise.interval
+import order.filter.interval
+import topology.support
+import topology.algebra.order.left_right
+
+/-!
+# Theory of topology on ordered spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definitions
+
+The order topology on an ordered space is the topology generated by all open intervals (or
+equivalently by those of the form `(-∞, a)` and `(b, +∞)`). We define it as `preorder.topology α`.
+However, we do *not* register it as an instance (as many existing ordered types already have
+topologies, which would be equal but not definitionally equal to `preorder.topology α`). Instead,
+we introduce a class `order_topology α` (which is a `Prop`, also known as a mixin) saying that on
+the type `α` having already a topological space structure and a preorder structure, the topological
+structure is equal to the order topology.
+
+We also introduce another (mixin) class `order_closed_topology α` saying that the set of points
+`(x, y)` with `x ≤ y` is closed in the product space. This is automatically satisfied on a linear
+order with the order topology.
+
+We prove many basic properties of such topologies.
+
+## Main statements
+
+This file contains the proofs of the following facts. For exact requirements
+(`order_closed_topology` vs `order_topology`, `preorder` vs `partial_order` vs `linear_order` etc)
+see their statements.
+
+### Open / closed sets
+
+* `is_open_lt` : if `f` and `g` are continuous functions, then `{x | f x < g x}` is open;
+* `is_open_Iio`, `is_open_Ioi`, `is_open_Ioo` : open intervals are open;
+* `is_closed_le` : if `f` and `g` are continuous functions, then `{x | f x ≤ g x}` is closed;
+* `is_closed_Iic`, `is_closed_Ici`, `is_closed_Icc` : closed intervals are closed;
+* `frontier_le_subset_eq`, `frontier_lt_subset_eq` : frontiers of both `{x | f x ≤ g x}`
+  and `{x | f x < g x}` are included by `{x | f x = g x}`;
+* `exists_Ioc_subset_of_mem_nhds`, `exists_Ico_subset_of_mem_nhds` : if `x < y`, then any
+  neighborhood of `x` includes an interval `[x, z)` for some `z ∈ (x, y]`, and any neighborhood
+  of `y` includes an interval `(z, y]` for some `z ∈ [x, y)`.
+
+### Convergence and inequalities
+
+* `le_of_tendsto_of_tendsto` : if `f` converges to `a`, `g` converges to `b`, and eventually
+  `f x ≤ g x`, then `a ≤ b`
+* `le_of_tendsto`, `ge_of_tendsto` : if `f` converges to `a` and eventually `f x ≤ b`
+  (resp., `b ≤ f x`), then `a ≤ b` (resp., `b ≤ a); we also provide primed versions
+  that assume the inequalities to hold for all `x`.
+
+### Min, max, `Sup` and `Inf`
+
+* `continuous.min`, `continuous.max`: pointwise `min`/`max` of two continuous functions is
+  continuous.
+* `tendsto.min`, `tendsto.max` : if `f` tends to `a` and `g` tends to `b`, then their pointwise
+  `min`/`max` tend to `min a b` and `max a b`, respectively.
+* `tendsto_of_tendsto_of_tendsto_of_le_of_le` : theorem known as squeeze theorem,
+  sandwich theorem, theorem of Carabinieri, and two policemen (and a drunk) theorem; if `g` and `h`
+  both converge to `a`, and eventually `g x ≤ f x ≤ h x`, then `f` converges to `a`.
+
+## Implementation notes
+
+We do _not_ register the order topology as an instance on a preorder (or even on a linear order).
+Indeed, on many such spaces, a topology has already been constructed in a different way (think
+of the discrete spaces `ℕ` or `ℤ`, or `ℝ` that could inherit a topology as the completion of `ℚ`),
+and is in general not defeq to the one generated by the intervals. We make it available as a
+definition `preorder.topology α` though, that can be registered as an instance when necessary, or
+for specific types.
+-/
+
+open set filter topological_space
+open function
+open order_dual (to_dual of_dual)
+open_locale topology classical filter
+
+universes u v w
+variables {α : Type u} {β : Type v} {γ : Type w}
+
+/-- A topology on a set which is both a topological space and a preorder is _order-closed_ if the
+set of points `(x, y)` with `x ≤ y` is closed in the product space. We introduce this as a mixin.
+This property is satisfied for the order topology on a linear order, but it can be satisfied more
+generally, and suffices to derive many interesting properties relating order and topology. -/
+class order_closed_topology (α : Type*) [topological_space α] [preorder α] : Prop :=
+(is_closed_le' : is_closed {p : α × α | p.1 ≤ p.2})
+
+instance [topological_space α] [h : first_countable_topology α] : first_countable_topology αᵒᵈ := h
+
+instance [topological_space α] [h : second_countable_topology α] : second_countable_topology αᵒᵈ :=
+h
+
+lemma dense.order_dual [topological_space α] {s : set α} (hs : dense s) :
+  dense (order_dual.of_dual ⁻¹' s) := hs
+
+section order_closed_topology
+
+section preorder
+variables [topological_space α] [preorder α] [t : order_closed_topology α]
+include t
+
+namespace subtype
+
+instance {p : α → Prop} : order_closed_topology (subtype p) :=
+have this : continuous (λ (p : (subtype p) × (subtype p)), ((p.fst : α), (p.snd : α))) :=
+  (continuous_subtype_coe.comp continuous_fst).prod_mk
+  (continuous_subtype_coe.comp continuous_snd),
+order_closed_topology.mk (t.is_closed_le'.preimage this)
+
+end subtype
+
+lemma is_closed_le_prod : is_closed {p : α × α | p.1 ≤ p.2} :=
+t.is_closed_le'
+
+lemma is_closed_le [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
+  is_closed {b | f b ≤ g b} :=
+continuous_iff_is_closed.mp (hf.prod_mk hg) _ is_closed_le_prod
+
+lemma is_closed_le' (a : α) : is_closed {b | b ≤ a} :=
+is_closed_le continuous_id continuous_const
+
+lemma is_closed_Iic {a : α} : is_closed (Iic a) :=
+is_closed_le' a
+
+lemma is_closed_ge' (a : α) : is_closed {b | a ≤ b} :=
+is_closed_le continuous_const continuous_id
+
+lemma is_closed_Ici {a : α} : is_closed (Ici a) :=
+is_closed_ge' a
+
+instance : order_closed_topology αᵒᵈ :=
+⟨(@order_closed_topology.is_closed_le' α _ _ _).preimage continuous_swap⟩
+
+lemma is_closed_Icc {a b : α} : is_closed (Icc a b) :=
+is_closed.inter is_closed_Ici is_closed_Iic
+
+@[simp] lemma closure_Icc (a b : α) : closure (Icc a b) = Icc a b :=
+is_closed_Icc.closure_eq
+
+@[simp] lemma closure_Iic (a : α) : closure (Iic a) = Iic a :=
+is_closed_Iic.closure_eq
+
+@[simp] lemma closure_Ici (a : α) : closure (Ici a) = Ici a :=
+is_closed_Ici.closure_eq
+
+lemma le_of_tendsto_of_tendsto {f g : β → α} {b : filter β} {a₁ a₂ : α} [ne_bot b]
+  (hf : tendsto f b (𝓝 a₁)) (hg : tendsto g b (𝓝 a₂)) (h : f ≤ᶠ[b] g) :
+  a₁ ≤ a₂ :=
+have tendsto (λb, (f b, g b)) b (𝓝 (a₁, a₂)),
+  by rw [nhds_prod_eq]; exact hf.prod_mk hg,
+show (a₁, a₂) ∈ {p:α×α | p.1 ≤ p.2},
+  from t.is_closed_le'.mem_of_tendsto this h
+
+alias le_of_tendsto_of_tendsto ← tendsto_le_of_eventually_le
+
+lemma le_of_tendsto_of_tendsto' {f g : β → α} {b : filter β} {a₁ a₂ : α} [ne_bot b]
+  (hf : tendsto f b (𝓝 a₁)) (hg : tendsto g b (𝓝 a₂)) (h : ∀ x, f x ≤ g x) :
+  a₁ ≤ a₂ :=
+le_of_tendsto_of_tendsto hf hg (eventually_of_forall h)
+
+lemma le_of_tendsto {f : β → α} {a b : α} {x : filter β}
+  [ne_bot x] (lim : tendsto f x (𝓝 a)) (h : ∀ᶠ c in x, f c ≤ b) : a ≤ b :=
+le_of_tendsto_of_tendsto lim tendsto_const_nhds h
+
+lemma le_of_tendsto' {f : β → α} {a b : α} {x : filter β}
+  [ne_bot x] (lim : tendsto f x (𝓝 a)) (h : ∀ c, f c ≤ b) : a ≤ b :=
+le_of_tendsto lim (eventually_of_forall h)
+
+lemma ge_of_tendsto {f : β → α} {a b : α} {x : filter β} [ne_bot x]
+  (lim : tendsto f x (𝓝 a)) (h : ∀ᶠ c in x, b ≤ f c) : b ≤ a :=
+le_of_tendsto_of_tendsto tendsto_const_nhds lim h
+
+lemma ge_of_tendsto' {f : β → α} {a b : α} {x : filter β} [ne_bot x]
+  (lim : tendsto f x (𝓝 a)) (h : ∀ c, b ≤ f c) : b ≤ a :=
+ge_of_tendsto lim (eventually_of_forall h)
+
+@[simp]
+lemma closure_le_eq [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
+  closure {b | f b ≤ g b} = {b | f b ≤ g b} :=
+(is_closed_le hf hg).closure_eq
+
+lemma closure_lt_subset_le [topological_space β] {f g : β → α} (hf : continuous f)
+  (hg : continuous g) :
+  closure {b | f b < g b} ⊆ {b | f b ≤ g b} :=
+closure_minimal (λ x, le_of_lt) $ is_closed_le hf hg
+
+lemma continuous_within_at.closure_le [topological_space β]
+ {f g : β → α} {s : set β} {x : β} (hx : x ∈ closure s)
+ (hf : continuous_within_at f s x)
+ (hg : continuous_within_at g s x)
+ (h : ∀ y ∈ s, f y ≤ g y) : f x ≤ g x :=
+show (f x, g x) ∈ {p : α × α | p.1 ≤ p.2},
+from order_closed_topology.is_closed_le'.closure_subset ((hf.prod hg).mem_closure hx h)
+
+/-- If `s` is a closed set and two functions `f` and `g` are continuous on `s`,
+then the set `{x ∈ s | f x ≤ g x}` is a closed set. -/
+lemma is_closed.is_closed_le [topological_space β] {f g : β → α} {s : set β} (hs : is_closed s)
+  (hf : continuous_on f s) (hg : continuous_on g s) :
+  is_closed {x ∈ s | f x ≤ g x} :=
+(hf.prod hg).preimage_closed_of_closed hs order_closed_topology.is_closed_le'
+
+lemma le_on_closure [topological_space β] {f g : β → α} {s : set β} (h : ∀ x ∈ s, f x ≤ g x)
+  (hf : continuous_on f (closure s)) (hg : continuous_on g (closure s)) ⦃x⦄ (hx : x ∈ closure s) :
+  f x ≤ g x :=
+have s ⊆ {y ∈ closure s | f y ≤ g y}, from λ y hy, ⟨subset_closure hy, h y hy⟩,
+(closure_minimal this (is_closed_closure.is_closed_le hf hg) hx).2
+
+lemma is_closed.epigraph [topological_space β] {f : β → α} {s : set β}
+  (hs : is_closed s) (hf : continuous_on f s) :
+  is_closed {p : β × α | p.1 ∈ s ∧ f p.1 ≤ p.2} :=
+(hs.preimage continuous_fst).is_closed_le (hf.comp continuous_on_fst subset.rfl) continuous_on_snd
+
+lemma is_closed.hypograph [topological_space β] {f : β → α} {s : set β}
+  (hs : is_closed s) (hf : continuous_on f s) :
+  is_closed {p : β × α | p.1 ∈ s ∧ p.2 ≤ f p.1} :=
+(hs.preimage continuous_fst).is_closed_le continuous_on_snd (hf.comp continuous_on_fst subset.rfl)
+
+omit t
+
+lemma nhds_within_Ici_ne_bot {a b : α} (H₂ : a ≤ b) :
+  ne_bot (𝓝[Ici a] b) :=
+nhds_within_ne_bot_of_mem H₂
+
+@[instance] lemma nhds_within_Ici_self_ne_bot (a : α) :
+  ne_bot (𝓝[≥] a) :=
+nhds_within_Ici_ne_bot (le_refl a)
+
+lemma nhds_within_Iic_ne_bot {a b : α} (H : a ≤ b) :
+  ne_bot (𝓝[Iic b] a) :=
+nhds_within_ne_bot_of_mem H
+
+@[instance] lemma nhds_within_Iic_self_ne_bot (a : α) :
+  ne_bot (𝓝[≤] a) :=
+nhds_within_Iic_ne_bot (le_refl a)
+
+end preorder
+
+section partial_order
+variables [topological_space α] [partial_order α] [t : order_closed_topology α]
+include t
+
+@[priority 90] -- see Note [lower instance priority]
+instance order_closed_topology.to_t2_space : t2_space α :=
+t2_iff_is_closed_diagonal.2 $ by simpa only [diagonal, le_antisymm_iff] using
+  t.is_closed_le'.inter (is_closed_le continuous_snd continuous_fst)
+
+end partial_order
+
+section linear_order
+variables [topological_space α] [linear_order α] [order_closed_topology α]
+
+lemma is_open_lt_prod : is_open {p : α × α | p.1 < p.2} :=
+by { simp_rw [← is_closed_compl_iff, compl_set_of, not_lt],
+     exact is_closed_le continuous_snd continuous_fst }
+
+lemma is_open_lt [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
+  is_open {b | f b < g b} :=
+by simp [lt_iff_not_ge, -not_le]; exact (is_closed_le hg hf).is_open_compl
+
+variables {a b : α}
+
+lemma is_open_Iio : is_open (Iio a) :=
+is_open_lt continuous_id continuous_const
+
+lemma is_open_Ioi : is_open (Ioi a) :=
+is_open_lt continuous_const continuous_id
+
+lemma is_open_Ioo : is_open (Ioo a b) :=
+is_open.inter is_open_Ioi is_open_Iio
+
+@[simp] lemma interior_Ioi : interior (Ioi a) = Ioi a :=
+is_open_Ioi.interior_eq
+
+@[simp] lemma interior_Iio : interior (Iio a) = Iio a :=
+is_open_Iio.interior_eq
+
+@[simp] lemma interior_Ioo : interior (Ioo a b) = Ioo a b :=
+is_open_Ioo.interior_eq
+
+lemma Ioo_subset_closure_interior : Ioo a b ⊆ closure (interior (Ioo a b)) :=
+by simp only [interior_Ioo, subset_closure]
+
+lemma Iio_mem_nhds {a b : α} (h : a < b) : Iio b ∈ 𝓝 a :=
+is_open.mem_nhds is_open_Iio h
+
+lemma Ioi_mem_nhds {a b : α} (h : a < b) : Ioi a ∈ 𝓝 b :=
+is_open.mem_nhds is_open_Ioi h
+
+lemma Iic_mem_nhds {a b : α} (h : a < b) : Iic b ∈ 𝓝 a :=
+mem_of_superset (Iio_mem_nhds h) Iio_subset_Iic_self
+
+lemma Ici_mem_nhds {a b : α} (h : a < b) : Ici a ∈ 𝓝 b :=
+mem_of_superset (Ioi_mem_nhds h) Ioi_subset_Ici_self
+
+lemma Ioo_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Ioo a b ∈ 𝓝 x :=
+is_open.mem_nhds is_open_Ioo ⟨ha, hb⟩
+
+lemma Ioc_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Ioc a b ∈ 𝓝 x :=
+mem_of_superset (Ioo_mem_nhds ha hb) Ioo_subset_Ioc_self
+
+lemma Ico_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Ico a b ∈ 𝓝 x :=
+mem_of_superset (Ioo_mem_nhds ha hb) Ioo_subset_Ico_self
+
+lemma Icc_mem_nhds {a b x : α} (ha : a < x) (hb : x < b) : Icc a b ∈ 𝓝 x :=
+mem_of_superset (Ioo_mem_nhds ha hb) Ioo_subset_Icc_self
+
+lemma eventually_lt_of_tendsto_lt {l : filter γ} {f : γ → α} {u v : α} (hv : v < u)
+  (h : filter.tendsto f l (𝓝 v)) : ∀ᶠ a in l, f a < u :=
+tendsto_nhds.1 h (< u) is_open_Iio hv
+
+lemma eventually_gt_of_tendsto_gt {l : filter γ} {f : γ → α} {u v : α} (hv : u < v)
+  (h : filter.tendsto f l (𝓝 v)) : ∀ᶠ a in l, u < f a :=
+tendsto_nhds.1 h (> u) is_open_Ioi hv
+
+lemma eventually_le_of_tendsto_lt {l : filter γ} {f : γ → α} {u v : α} (hv : v < u)
+  (h : tendsto f l (𝓝 v)) : ∀ᶠ a in l, f a ≤ u :=
+(eventually_lt_of_tendsto_lt hv h).mono (λ v, le_of_lt)
+
+lemma eventually_ge_of_tendsto_gt {l : filter γ} {f : γ → α} {u v : α} (hv : u < v)
+  (h : tendsto f l (𝓝 v)) : ∀ᶠ a in l, u ≤ f a :=
+(eventually_gt_of_tendsto_gt hv h).mono (λ v, le_of_lt)
+
+variables [topological_space γ]
+/-!
+### Neighborhoods to the left and to the right on an `order_closed_topology`
+
+Limits to the left and to the right of real functions are defined in terms of neighborhoods to
+the left and to the right, either open or closed, i.e., members of `𝓝[>] a` and
+`𝓝[≥] a` on the right, and similarly on the left. Here we simply prove that all
+right-neighborhoods of a point are equal, and we'll prove later other useful characterizations which
+require the stronger hypothesis `order_topology α` -/
+
+/-!
+#### Right neighborhoods, point excluded
+-/
+
+lemma Ioo_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
+  Ioo a c ∈ 𝓝[>] b :=
+mem_nhds_within.2 ⟨Iio c, is_open_Iio, H.2,
+  by rw [inter_comm, Ioi_inter_Iio]; exact Ioo_subset_Ioo_left H.1⟩
+
+lemma Ioc_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
+  Ioc a c ∈ 𝓝[>] b :=
+mem_of_superset (Ioo_mem_nhds_within_Ioi H) Ioo_subset_Ioc_self
+
+lemma Ico_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
+  Ico a c ∈ 𝓝[>] b :=
+mem_of_superset (Ioo_mem_nhds_within_Ioi H) Ioo_subset_Ico_self
+
+lemma Icc_mem_nhds_within_Ioi {a b c : α} (H : b ∈ Ico a c) :
+  Icc a c ∈ 𝓝[>] b :=
+mem_of_superset (Ioo_mem_nhds_within_Ioi H) Ioo_subset_Icc_self
+
+@[simp] lemma nhds_within_Ioc_eq_nhds_within_Ioi {a b : α} (h : a < b) :
+  𝓝[Ioc a b] a = 𝓝[>] a :=
+le_antisymm (nhds_within_mono _ Ioc_subset_Ioi_self) $
+  nhds_within_le_of_mem $ Ioc_mem_nhds_within_Ioi $ left_mem_Ico.2 h
+
+@[simp] lemma nhds_within_Ioo_eq_nhds_within_Ioi {a b : α} (h : a < b) :
+  𝓝[Ioo a b] a = 𝓝[>] a :=
+le_antisymm (nhds_within_mono _ Ioo_subset_Ioi_self) $
+  nhds_within_le_of_mem $ Ioo_mem_nhds_within_Ioi $ left_mem_Ico.2 h
+
+@[simp]
+lemma continuous_within_at_Ioc_iff_Ioi [topological_space β] {a b : α} {f : α → β} (h : a < b) :
+  continuous_within_at f (Ioc a b) a ↔ continuous_within_at f (Ioi a) a :=
+by simp only [continuous_within_at, nhds_within_Ioc_eq_nhds_within_Ioi h]
+
+@[simp]
+lemma continuous_within_at_Ioo_iff_Ioi [topological_space β] {a b : α} {f : α → β} (h : a < b) :
+  continuous_within_at f (Ioo a b) a ↔ continuous_within_at f (Ioi a) a :=
+by simp only [continuous_within_at, nhds_within_Ioo_eq_nhds_within_Ioi h]
+
+/-!
+#### Left neighborhoods, point excluded
+-/
+
+lemma Ioo_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
+  Ioo a c ∈ 𝓝[<] b :=
+by simpa only [dual_Ioo] using Ioo_mem_nhds_within_Ioi
+  (show to_dual b ∈ Ico (to_dual c) (to_dual a), from H.symm)
+
+lemma Ico_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
+  Ico a c ∈ 𝓝[<] b :=
+mem_of_superset (Ioo_mem_nhds_within_Iio H) Ioo_subset_Ico_self
+
+lemma Ioc_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
+  Ioc a c ∈ 𝓝[<] b :=
+mem_of_superset (Ioo_mem_nhds_within_Iio H) Ioo_subset_Ioc_self
+
+lemma Icc_mem_nhds_within_Iio {a b c : α} (H : b ∈ Ioc a c) :
+  Icc a c ∈ 𝓝[<] b :=
+mem_of_superset (Ioo_mem_nhds_within_Iio H) Ioo_subset_Icc_self
+
+@[simp] lemma nhds_within_Ico_eq_nhds_within_Iio {a b : α} (h : a < b) :
+  𝓝[Ico a b] b = 𝓝[<] b :=
+by simpa only [dual_Ioc] using nhds_within_Ioc_eq_nhds_within_Ioi h.dual
+
+@[simp] lemma nhds_within_Ioo_eq_nhds_within_Iio {a b : α} (h : a < b) :
+  𝓝[Ioo a b] b = 𝓝[<] b :=
+by simpa only [dual_Ioo] using nhds_within_Ioo_eq_nhds_within_Ioi h.dual
+
+@[simp] lemma continuous_within_at_Ico_iff_Iio {a b : α} {f : α → γ} (h : a < b) :
+  continuous_within_at f (Ico a b) b ↔ continuous_within_at f (Iio b) b :=
+by simp only [continuous_within_at, nhds_within_Ico_eq_nhds_within_Iio h]
+
+@[simp] lemma continuous_within_at_Ioo_iff_Iio {a b : α} {f : α → γ} (h : a < b) :
+  continuous_within_at f (Ioo a b) b ↔ continuous_within_at f (Iio b) b :=
+by simp only [continuous_within_at, nhds_within_Ioo_eq_nhds_within_Iio h]
+
+/-!
+#### Right neighborhoods, point included
+-/
+
+lemma Ioo_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ioo a c) :
+  Ioo a c ∈ 𝓝[≥] b :=
+mem_nhds_within_of_mem_nhds $ is_open.mem_nhds is_open_Ioo H
+
+lemma Ioc_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ioo a c) :
+  Ioc a c ∈ 𝓝[≥] b :=
+mem_of_superset (Ioo_mem_nhds_within_Ici H) Ioo_subset_Ioc_self
+
+lemma Ico_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ico a c) :
+  Ico a c ∈ 𝓝[≥] b :=
+mem_nhds_within.2 ⟨Iio c, is_open_Iio, H.2,
+  by simp only [inter_comm, Ici_inter_Iio, Ico_subset_Ico_left H.1]⟩
+
+lemma Icc_mem_nhds_within_Ici {a b c : α} (H : b ∈ Ico a c) :
+  Icc a c ∈ 𝓝[≥] b :=
+mem_of_superset (Ico_mem_nhds_within_Ici H) Ico_subset_Icc_self
+
+@[simp] lemma nhds_within_Icc_eq_nhds_within_Ici {a b : α} (h : a < b) :
+  𝓝[Icc a b] a = 𝓝[≥] a :=
+le_antisymm (nhds_within_mono _ Icc_subset_Ici_self) $
+  nhds_within_le_of_mem $ Icc_mem_nhds_within_Ici $ left_mem_Ico.2 h
+
+@[simp] lemma nhds_within_Ico_eq_nhds_within_Ici {a b : α} (h : a < b) :
+  𝓝[Ico a b] a = 𝓝[≥] a :=
+le_antisymm (nhds_within_mono _ (λ x, and.left)) $
+  nhds_within_le_of_mem $ Ico_mem_nhds_within_Ici $ left_mem_Ico.2 h
+
+@[simp]
+lemma continuous_within_at_Icc_iff_Ici [topological_space β] {a b : α} {f : α → β} (h : a < b) :
+  continuous_within_at f (Icc a b) a ↔ continuous_within_at f (Ici a) a :=
+by simp only [continuous_within_at, nhds_within_Icc_eq_nhds_within_Ici h]
+
+@[simp]
+lemma continuous_within_at_Ico_iff_Ici [topological_space β] {a b : α} {f : α → β} (h : a < b) :
+  continuous_within_at f (Ico a b) a ↔ continuous_within_at f (Ici a) a :=
+by simp only [continuous_within_at, nhds_within_Ico_eq_nhds_within_Ici h]
+
+/-!
+#### Left neighborhoods, point included
+-/
+
+lemma Ioo_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioo a c) :
+  Ioo a c ∈ 𝓝[≤] b :=
+mem_nhds_within_of_mem_nhds $ is_open.mem_nhds is_open_Ioo H
+
+lemma Ico_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioo a c) :
+  Ico a c ∈ 𝓝[≤] b :=
+mem_of_superset (Ioo_mem_nhds_within_Iic H) Ioo_subset_Ico_self
+
+lemma Ioc_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioc a c) :
+  Ioc a c ∈ 𝓝[≤] b :=
+by simpa only [dual_Ico] using Ico_mem_nhds_within_Ici
+  (show to_dual b ∈ Ico (to_dual c) (to_dual a), from H.symm)
+
+lemma Icc_mem_nhds_within_Iic {a b c : α} (H : b ∈ Ioc a c) :
+  Icc a c ∈ 𝓝[≤] b :=
+mem_of_superset (Ioc_mem_nhds_within_Iic H) Ioc_subset_Icc_self
+
+@[simp] lemma nhds_within_Icc_eq_nhds_within_Iic {a b : α} (h : a < b) :
+  𝓝[Icc a b] b = 𝓝[≤] b :=
+by simpa only [dual_Icc] using nhds_within_Icc_eq_nhds_within_Ici h.dual
+
+@[simp] lemma nhds_within_Ioc_eq_nhds_within_Iic {a b : α} (h : a < b) :
+  𝓝[Ioc a b] b = 𝓝[≤] b :=
+by simpa only [dual_Ico] using nhds_within_Ico_eq_nhds_within_Ici h.dual
+
+@[simp]
+lemma continuous_within_at_Icc_iff_Iic [topological_space β] {a b : α} {f : α → β} (h : a < b) :
+  continuous_within_at f (Icc a b) b ↔ continuous_within_at f (Iic b) b :=
+by simp only [continuous_within_at, nhds_within_Icc_eq_nhds_within_Iic h]
+
+@[simp]
+lemma continuous_within_at_Ioc_iff_Iic [topological_space β] {a b : α} {f : α → β} (h : a < b) :
+  continuous_within_at f (Ioc a b) b ↔ continuous_within_at f (Iic b) b :=
+by simp only [continuous_within_at, nhds_within_Ioc_eq_nhds_within_Iic h]
+
+end linear_order
+
+section linear_order
+variables [topological_space α] [linear_order α] [order_closed_topology α] {f g : β → α}
+
+section
+variables [topological_space β]
+
+lemma lt_subset_interior_le (hf : continuous f) (hg : continuous g) :
+  {b | f b < g b} ⊆ interior {b | f b ≤ g b} :=
+interior_maximal (λ p, le_of_lt) $ is_open_lt hf hg
+
+lemma frontier_le_subset_eq (hf : continuous f) (hg : continuous g) :
+  frontier {b | f b ≤ g b} ⊆ {b | f b = g b} :=
+begin
+  rw [frontier_eq_closure_inter_closure, closure_le_eq hf hg],
+  rintros b ⟨hb₁, hb₂⟩,
+  refine le_antisymm hb₁ (closure_lt_subset_le hg hf _),
+  convert hb₂ using 2, simp only [not_le.symm], refl
+end
+
+lemma frontier_Iic_subset (a : α) : frontier (Iic a) ⊆ {a} :=
+frontier_le_subset_eq (@continuous_id α _) continuous_const
+
+lemma frontier_Ici_subset (a : α) : frontier (Ici a) ⊆ {a} := @frontier_Iic_subset αᵒᵈ _ _ _ _
+
+lemma frontier_lt_subset_eq (hf : continuous f) (hg : continuous g) :
+  frontier {b | f b < g b} ⊆ {b | f b = g b} :=
+by rw ← frontier_compl;
+   convert frontier_le_subset_eq hg hf; simp [ext_iff, eq_comm]
+
+lemma continuous_if_le [topological_space γ] [Π x, decidable (f x ≤ g x)]
+  {f' g' : β → γ} (hf : continuous f) (hg : continuous g)
+  (hf' : continuous_on f' {x | f x ≤ g x}) (hg' : continuous_on g' {x | g x ≤ f x})
+  (hfg : ∀ x, f x = g x → f' x = g' x) :
+  continuous (λ x, if f x ≤ g x then f' x else g' x) :=
+begin
+  refine continuous_if (λ a ha, hfg _ (frontier_le_subset_eq hf hg ha)) _ (hg'.mono _),
+  { rwa [(is_closed_le hf hg).closure_eq] },
+  { simp only [not_le], exact closure_lt_subset_le hg hf }
+end
+
+lemma continuous.if_le [topological_space γ] [Π x, decidable (f x ≤ g x)] {f' g' : β → γ}
+  (hf' : continuous f') (hg' : continuous g') (hf : continuous f) (hg : continuous g)
+  (hfg : ∀ x, f x = g x → f' x = g' x) :
+  continuous (λ x, if f x ≤ g x then f' x else g' x) :=
+continuous_if_le hf hg hf'.continuous_on hg'.continuous_on hfg
+
+lemma tendsto.eventually_lt {l : filter γ} {f g : γ → α} {y z : α}
+  (hf : tendsto f l (𝓝 y)) (hg : tendsto g l (𝓝 z)) (hyz : y < z) : ∀ᶠ x in l, f x < g x :=
+begin
+  by_cases h : y ⋖ z,
+  { filter_upwards [hf (Iio_mem_nhds hyz), hg (Ioi_mem_nhds hyz)],
+    rw [h.Iio_eq],
+    exact λ x hfx hgx, lt_of_le_of_lt hfx hgx },
+  { obtain ⟨w, hyw, hwz⟩ := (not_covby_iff hyz).mp h,
+    filter_upwards [hf (Iio_mem_nhds hyw), hg (Ioi_mem_nhds hwz)],
+    exact λ x, lt_trans },
+end
+
+lemma continuous_at.eventually_lt {x₀ : β} (hf : continuous_at f x₀)
+  (hg : continuous_at g x₀) (hfg : f x₀ < g x₀) : ∀ᶠ x in 𝓝 x₀, f x < g x :=
+tendsto.eventually_lt hf hg hfg
+
+@[continuity] lemma continuous.min (hf : continuous f) (hg : continuous g) :
+  continuous (λb, min (f b) (g b)) :=
+by { simp only [min_def], exact hf.if_le hg hf hg (λ x, id) }
+
+@[continuity] lemma continuous.max (hf : continuous f) (hg : continuous g) :
+  continuous (λb, max (f b) (g b)) :=
+@continuous.min αᵒᵈ _ _ _ _ _ _ _ hf hg
+
+end
+
+lemma continuous_min : continuous (λ p : α × α, min p.1 p.2) := continuous_fst.min continuous_snd
+
+lemma continuous_max : continuous (λ p : α × α, max p.1 p.2) := continuous_fst.max continuous_snd
+
+lemma filter.tendsto.max {b : filter β} {a₁ a₂ : α} (hf : tendsto f b (𝓝 a₁))
+  (hg : tendsto g b (𝓝 a₂)) :
+  tendsto (λb, max (f b) (g b)) b (𝓝 (max a₁ a₂)) :=
+(continuous_max.tendsto (a₁, a₂)).comp (hf.prod_mk_nhds hg)
+
+lemma filter.tendsto.min {b : filter β} {a₁ a₂ : α} (hf : tendsto f b (𝓝 a₁))
+  (hg : tendsto g b (𝓝 a₂)) :
+  tendsto (λb, min (f b) (g b)) b (𝓝 (min a₁ a₂)) :=
+(continuous_min.tendsto (a₁, a₂)).comp (hf.prod_mk_nhds hg)
+
+lemma filter.tendsto.max_right {l : filter β} {a : α} (h : tendsto f l (𝓝 a)) :
+  tendsto (λ i, max a (f i)) l (𝓝 a) :=
+by { convert ((continuous_max.comp (@continuous.prod.mk α α _ _ a)).tendsto a).comp h, simp, }
+
+lemma filter.tendsto.max_left {l : filter β} {a : α} (h : tendsto f l (𝓝 a)) :
+  tendsto (λ i, max (f i) a) l (𝓝 a) :=
+by { simp_rw max_comm _ a, exact h.max_right, }
+
+lemma filter.tendsto_nhds_max_right {l : filter β} {a : α} (h : tendsto f l (𝓝[>] a)) :
+  tendsto (λ i, max a (f i)) l (𝓝[>] a) :=
+begin
+  obtain ⟨h₁ : tendsto f l (𝓝 a), h₂ : ∀ᶠ i in l, f i ∈ Ioi a⟩ := tendsto_nhds_within_iff.mp h,
+  exact tendsto_nhds_within_iff.mpr ⟨h₁.max_right, h₂.mono $ λ i hi, lt_max_of_lt_right hi⟩,
+end
+
+lemma filter.tendsto_nhds_max_left {l : filter β} {a : α} (h : tendsto f l (𝓝[>] a)) :
+  tendsto (λ i, max (f i) a) l (𝓝[>] a) :=
+by { simp_rw max_comm _ a, exact filter.tendsto_nhds_max_right h, }
+
+lemma filter.tendsto.min_right {l : filter β} {a : α} (h : tendsto f l (𝓝 a)) :
+  tendsto (λ i, min a (f i)) l (𝓝 a) :=
+@filter.tendsto.max_right αᵒᵈ β _ _ _ f l a h
+
+lemma filter.tendsto.min_left {l : filter β} {a : α} (h : tendsto f l (𝓝 a)) :
+  tendsto (λ i, min (f i) a) l (𝓝 a) :=
+@filter.tendsto.max_left αᵒᵈ β _ _ _ f l a h
+
+lemma filter.tendsto_nhds_min_right {l : filter β} {a : α} (h : tendsto f l (𝓝[<] a)) :
+  tendsto (λ i, min a (f i)) l (𝓝[<] a) :=
+@filter.tendsto_nhds_max_right αᵒᵈ β _ _ _ f l a h
+
+lemma filter.tendsto_nhds_min_left {l : filter β} {a : α} (h : tendsto f l (𝓝[<] a)) :
+  tendsto (λ i, min (f i) a) l (𝓝[<] a) :=
+@filter.tendsto_nhds_max_left αᵒᵈ β _ _ _ f l a h
+
+lemma dense.exists_lt [no_min_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, y < x :=
+hs.exists_mem_open is_open_Iio (exists_lt x)
+
+lemma dense.exists_gt [no_max_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, x < y :=
+hs.order_dual.exists_lt x
+
+lemma dense.exists_le [no_min_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, y ≤ x :=
+(hs.exists_lt x).imp $ λ y hy, ⟨hy.fst, hy.snd.le⟩
+
+lemma dense.exists_ge [no_max_order α] {s : set α} (hs : dense s) (x : α) : ∃ y ∈ s, x ≤ y :=
+hs.order_dual.exists_le x
+
+lemma dense.exists_le' {s : set α} (hs : dense s) (hbot : ∀ x, is_bot x → x ∈ s) (x : α) :
+  ∃ y ∈ s, y ≤ x :=
+begin
+  by_cases hx : is_bot x,
+  { exact ⟨x, hbot x hx, le_rfl⟩ },
+  { simp only [is_bot, not_forall, not_le] at hx,
+    rcases hs.exists_mem_open is_open_Iio hx with ⟨y, hys, hy : y < x⟩,
+    exact ⟨y, hys, hy.le⟩ }
+end
+
+lemma dense.exists_ge' {s : set α} (hs : dense s) (htop : ∀ x, is_top x → x ∈ s) (x : α) :
+  ∃ y ∈ s, x ≤ y :=
+hs.order_dual.exists_le' htop x
+
+lemma dense.exists_between [densely_ordered α] {s : set α} (hs : dense s) {x y : α} (h : x < y) :
+  ∃ z ∈ s, z ∈ Ioo x y :=
+hs.exists_mem_open is_open_Ioo (nonempty_Ioo.2 h)
+
+end linear_order
+
+end order_closed_topology
+
+instance [preorder α] [topological_space α] [order_closed_topology α]
+  [preorder β] [topological_space β] [order_closed_topology β] :
+  order_closed_topology (α × β) :=
+⟨(is_closed_le (continuous_fst.comp continuous_fst) (continuous_fst.comp continuous_snd)).inter
+  (is_closed_le (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd))⟩
+
+instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
+  [Π i, order_closed_topology (α i)] : order_closed_topology (Π i, α i) :=
+begin
+  constructor,
+  simp only [pi.le_def, set_of_forall],
+  exact is_closed_Inter (λ i, is_closed_le ((continuous_apply i).comp continuous_fst)
+    ((continuous_apply i).comp continuous_snd))
+end
+
+instance pi.order_closed_topology' [preorder β] [topological_space β]
+  [order_closed_topology β] : order_closed_topology (α → β) :=
+pi.order_closed_topology
+
+/-- The order topology on an ordered type is the topology generated by open intervals. We register
+it on a preorder, but it is mostly interesting in linear orders, where it is also order-closed.
+We define it as a mixin. If you want to introduce the order topology on a preorder, use
+`preorder.topology`. -/
+class order_topology (α : Type*) [t : topological_space α] [preorder α] : Prop :=
+(topology_eq_generate_intervals : t = generate_from {s | ∃ a, s = Ioi a ∨ s = Iio a})
+
+/-- (Order) topology on a partial order `α` generated by the subbase of open intervals
+`(a, ∞) = { x ∣ a < x }, (-∞ , b) = {x ∣ x < b}` for all `a, b` in `α`. We do not register it as an
+instance as many ordered sets are already endowed with the same topology, most often in a non-defeq
+way though. Register as a local instance when necessary. -/
+def preorder.topology (α : Type*) [preorder α] : topological_space α :=
+generate_from {s : set α | ∃ (a : α), s = {b : α | a < b} ∨ s = {b : α | b < a}}
+
+section order_topology
+
+section preorder
+
+variables [topological_space α] [preorder α] [t : order_topology α]
+include t
+
+instance : order_topology αᵒᵈ :=
+⟨by convert @order_topology.topology_eq_generate_intervals α _ _ _;
+  conv in (_ ∨ _) { rw or.comm }; refl⟩
+
+lemma is_open_iff_generate_intervals {s : set α} :
+  is_open s ↔ generate_open {s | ∃ a, s = Ioi a ∨ s = Iio a} s :=
+by rw [t.topology_eq_generate_intervals]; refl
+
+lemma is_open_lt' (a : α) : is_open {b : α | a < b} :=
+by rw [@is_open_iff_generate_intervals α _ _ t]; exact generate_open.basic _ ⟨a, or.inl rfl⟩
+
+lemma is_open_gt' (a : α) : is_open {b : α | b < a} :=
+by rw [@is_open_iff_generate_intervals α _ _ t]; exact generate_open.basic _ ⟨a, or.inr rfl⟩
+
+lemma lt_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 b, a < x :=
+is_open.mem_nhds (is_open_lt' _) h
+
+lemma le_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 b, a ≤ x :=
+(𝓝 b).sets_of_superset (lt_mem_nhds h) $ assume b hb, le_of_lt hb
+
+lemma gt_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 a, x < b :=
+is_open.mem_nhds (is_open_gt' _) h
+
+lemma ge_mem_nhds {a b : α} (h : a < b) : ∀ᶠ x in 𝓝 a, x ≤ b :=
+(𝓝 a).sets_of_superset (gt_mem_nhds h) $ assume b hb, le_of_lt hb
+
+lemma nhds_eq_order (a : α) :
+  𝓝 a = (⨅ b ∈ Iio a, 𝓟 (Ioi b)) ⊓ (⨅ b ∈ Ioi a, 𝓟 (Iio b)) :=
+by rw [t.topology_eq_generate_intervals, nhds_generate_from];
+from le_antisymm
+  (le_inf
+    (le_infi₂ $ assume b hb, infi_le_of_le {c : α | b < c} $ infi_le _ ⟨hb, b, or.inl rfl⟩)
+    (le_infi₂ $ assume b hb, infi_le_of_le {c : α | c < b} $ infi_le _ ⟨hb, b, or.inr rfl⟩))
+  (le_infi $ assume s, le_infi $ assume ⟨ha, b, hs⟩,
+    match s, ha, hs with
+    | _, h, (or.inl rfl) := inf_le_of_left_le $ infi_le_of_le b $ infi_le _ h
+    | _, h, (or.inr rfl) := inf_le_of_right_le $ infi_le_of_le b $ infi_le _ h
+    end)
+
+lemma tendsto_order {f : β → α} {a : α} {x : filter β} :
+  tendsto f x (𝓝 a) ↔ (∀ a' < a, ∀ᶠ b in x, a' < f b) ∧ (∀ a' > a, ∀ᶠ b in x, f b < a') :=
+by simp [nhds_eq_order a, tendsto_inf, tendsto_infi, tendsto_principal]
+
+instance tendsto_Icc_class_nhds (a : α) : tendsto_Ixx_class Icc (𝓝 a) (𝓝 a) :=
+begin
+  simp only [nhds_eq_order, infi_subtype'],
+  refine ((has_basis_infi_principal_finite _).inf
+    (has_basis_infi_principal_finite _)).tendsto_Ixx_class (λ s hs, _),
+  refine ((ord_connected_bInter _).inter (ord_connected_bInter _)).out; intros _ _,
+  exacts [ord_connected_Ioi, ord_connected_Iio]
+end
+
+instance tendsto_Ico_class_nhds (a : α) : tendsto_Ixx_class Ico (𝓝 a) (𝓝 a) :=
+tendsto_Ixx_class_of_subset (λ _ _, Ico_subset_Icc_self)
+
+instance tendsto_Ioc_class_nhds (a : α) : tendsto_Ixx_class Ioc (𝓝 a) (𝓝 a) :=
+tendsto_Ixx_class_of_subset (λ _ _, Ioc_subset_Icc_self)
+
+instance tendsto_Ioo_class_nhds (a : α) : tendsto_Ixx_class Ioo (𝓝 a) (𝓝 a) :=
+tendsto_Ixx_class_of_subset (λ _ _, Ioo_subset_Icc_self)
+
+/-- **Squeeze theorem** (also known as **sandwich theorem**). This version assumes that inequalities
+hold eventually for the filter. -/
+lemma tendsto_of_tendsto_of_tendsto_of_le_of_le' {f g h : β → α} {b : filter β} {a : α}
+  (hg : tendsto g b (𝓝 a)) (hh : tendsto h b (𝓝 a))
+  (hgf : ∀ᶠ b in b, g b ≤ f b) (hfh : ∀ᶠ b in b, f b ≤ h b) :
+  tendsto f b (𝓝 a) :=
+(hg.Icc hh).of_small_sets $ hgf.and hfh
+
+/-- **Squeeze theorem** (also known as **sandwich theorem**). This version assumes that inequalities
+hold everywhere. -/
+lemma tendsto_of_tendsto_of_tendsto_of_le_of_le {f g h : β → α} {b : filter β} {a : α}
+  (hg : tendsto g b (𝓝 a)) (hh : tendsto h b (𝓝 a)) (hgf : g ≤ f) (hfh : f ≤ h) :
+  tendsto f b (𝓝 a) :=
+tendsto_of_tendsto_of_tendsto_of_le_of_le' hg hh
+  (eventually_of_forall hgf) (eventually_of_forall hfh)
+
+lemma nhds_order_unbounded {a : α} (hu : ∃u, a < u) (hl : ∃l, l < a) :
+  𝓝 a = (⨅l (h₂ : l < a) u (h₂ : a < u), 𝓟 (Ioo l u)) :=
+have ∃ u, u ∈ Ioi a, from hu, have ∃ l, l ∈ Iio a, from hl,
+by { simp only [nhds_eq_order, inf_binfi, binfi_inf, *, inf_principal, Ioi_inter_Iio], refl }
+
+lemma tendsto_order_unbounded {f : β → α} {a : α} {x : filter β}
+  (hu : ∃u, a < u) (hl : ∃l, l < a) (h : ∀l u, l < a → a < u → ∀ᶠ b in x, l < f b ∧ f b < u) :
+  tendsto f x (𝓝 a) :=
+by rw [nhds_order_unbounded hu hl];
+from (tendsto_infi.2 $ assume l, tendsto_infi.2 $ assume hl,
+  tendsto_infi.2 $ assume u, tendsto_infi.2 $ assume hu, tendsto_principal.2 $ h l u hl hu)
+
+end preorder
+
+instance tendsto_Ixx_nhds_within {α : Type*} [preorder α] [topological_space α]
+  (a : α) {s t : set α} {Ixx}
+  [tendsto_Ixx_class Ixx (𝓝 a) (𝓝 a)] [tendsto_Ixx_class Ixx (𝓟 s) (𝓟 t)]:
+  tendsto_Ixx_class Ixx (𝓝[s] a) (𝓝[t] a) :=
+filter.tendsto_Ixx_class_inf
+
+instance tendsto_Icc_class_nhds_pi {ι : Type*} {α : ι → Type*}
+  [Π i, preorder (α i)] [Π i, topological_space (α i)] [∀ i, order_topology (α i)]
+  (f : Π i, α i) :
+  tendsto_Ixx_class Icc (𝓝 f) (𝓝 f) :=
+begin
+  constructor,
+  conv in ((𝓝 f).small_sets) { rw [nhds_pi, filter.pi] },
+  simp only [small_sets_infi, small_sets_comap, tendsto_infi, tendsto_lift', (∘), mem_powerset_iff],
+  intros i s hs,
+  have : tendsto (λ g : Π i, α i, g i) (𝓝 f) (𝓝 (f i)) := ((continuous_apply i).tendsto f),
+  refine (tendsto_lift'.1 ((this.comp tendsto_fst).Icc (this.comp tendsto_snd)) s hs).mono _,
+  exact λ p hp g hg, hp ⟨hg.1 _, hg.2 _⟩
+end
+
+theorem induced_order_topology' {α : Type u} {β : Type v}
+  [preorder α] [ta : topological_space β] [preorder β] [order_topology β]
+  (f : α → β) (hf : ∀ {x y}, f x < f y ↔ x < y)
+  (H₁ : ∀ {a x}, x < f a → ∃ b < a, x ≤ f b)
+  (H₂ : ∀ {a x}, f a < x → ∃ b > a, f b ≤ x) :
+  @order_topology _ (induced f ta) _ :=
+begin
+  letI := induced f ta,
+  refine ⟨eq_of_nhds_eq_nhds (λ a, _)⟩,
+  rw [nhds_induced, nhds_generate_from, nhds_eq_order (f a)],
+  apply le_antisymm,
+  { refine le_infi (λ s, le_infi $ λ hs, le_principal_iff.2 _),
+    rcases hs with ⟨ab, b, rfl|rfl⟩,
+    { exact mem_comap.2 ⟨{x | f b < x},
+        mem_inf_of_left $ mem_infi_of_mem _ $ mem_infi_of_mem (hf.2 ab) $ mem_principal_self _,
+        λ x, hf.1⟩ },
+    { exact mem_comap.2 ⟨{x | x < f b},
+        mem_inf_of_right $ mem_infi_of_mem _ $ mem_infi_of_mem (hf.2 ab) $ mem_principal_self _,
+        λ x, hf.1⟩ } },
+  { rw [← map_le_iff_le_comap],
+    refine le_inf _ _; refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _); simp,
+    { rcases H₁ h with ⟨b, ab, xb⟩,
+      refine mem_infi_of_mem _ (mem_infi_of_mem ⟨ab, b, or.inl rfl⟩ (mem_principal.2 _)),
+      exact λ c hc, lt_of_le_of_lt xb (hf.2 hc) },
+    { rcases H₂ h with ⟨b, ab, xb⟩,
+      refine mem_infi_of_mem _ (mem_infi_of_mem ⟨ab, b, or.inr rfl⟩ (mem_principal.2 _)),
+      exact λ c hc, lt_of_lt_of_le (hf.2 hc) xb } },
+end
+
+theorem induced_order_topology {α : Type u} {β : Type v}
+  [preorder α] [ta : topological_space β] [preorder β] [order_topology β]
+  (f : α → β) (hf : ∀ {x y}, f x < f y ↔ x < y)
+  (H : ∀ {x y}, x < y → ∃ a, x < f a ∧ f a < y) :
+  @order_topology _ (induced f ta) _ :=
+induced_order_topology' f @hf
+  (λ a x xa, let ⟨b, xb, ba⟩ := H xa in ⟨b, hf.1 ba, le_of_lt xb⟩)
+  (λ a x ax, let ⟨b, ab, bx⟩ := H ax in ⟨b, hf.1 ab, le_of_lt bx⟩)
+
+/-- On an `ord_connected` subset of a linear order, the order topology for the restriction of the
+order is the same as the restriction to the subset of the order topology. -/
+instance order_topology_of_ord_connected {α : Type u}
+  [ta : topological_space α] [linear_order α] [order_topology α]
+  {t : set α} [ht : ord_connected t] :
+  order_topology t :=
+begin
+  letI := induced (coe : t → α) ta,
+  refine ⟨eq_of_nhds_eq_nhds (λ a, _)⟩,
+  rw [nhds_induced, nhds_generate_from, nhds_eq_order (a : α)],
+  apply le_antisymm,
+  { refine le_infi (λ s, le_infi $ λ hs, le_principal_iff.2 _),
+    rcases hs with ⟨ab, b, rfl|rfl⟩,
+    { refine ⟨Ioi b, _, λ _, id⟩,
+      refine mem_inf_of_left (mem_infi_of_mem b _),
+      exact mem_infi_of_mem ab (mem_principal_self (Ioi ↑b)) },
+    { refine ⟨Iio b, _, λ _, id⟩,
+      refine mem_inf_of_right (mem_infi_of_mem b _),
+      exact mem_infi_of_mem ab (mem_principal_self (Iio b)) } },
+  { rw [← map_le_iff_le_comap],
+    refine le_inf _ _,
+    { refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _),
+      by_cases hx : x ∈ t,
+      { refine mem_infi_of_mem (Ioi ⟨x, hx⟩) (mem_infi_of_mem ⟨h, ⟨⟨x, hx⟩, or.inl rfl⟩⟩ _),
+        exact λ _, id },
+      simp only [set_coe.exists, mem_set_of_eq, mem_map'],
+      convert univ_sets _,
+      suffices hx' : ∀ (y : t), ↑y ∈ Ioi x,
+      { simp [hx'] },
+      intros y,
+      revert hx,
+      contrapose!,
+      -- here we use the `ord_connected` hypothesis
+      exact λ hx, ht.out y.2 a.2 ⟨le_of_not_gt hx, le_of_lt h⟩ },
+    { refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _),
+      by_cases hx : x ∈ t,
+      { refine mem_infi_of_mem (Iio ⟨x, hx⟩) (mem_infi_of_mem ⟨h, ⟨⟨x, hx⟩, or.inr rfl⟩⟩ _),
+        exact λ _, id },
+      simp only [set_coe.exists, mem_set_of_eq, mem_map'],
+      convert univ_sets _,
+      suffices hx' : ∀ (y : t), ↑y ∈ Iio x,
+      { simp [hx'] },
+      intros y,
+      revert hx,
+      contrapose!,
+      -- here we use the `ord_connected` hypothesis
+      exact λ hx, ht.out a.2 y.2 ⟨le_of_lt h, le_of_not_gt hx⟩ } }
+end
+
+lemma nhds_within_Ici_eq'' [topological_space α] [preorder α] [order_topology α] (a : α) :
+  𝓝[≥] a = (⨅ u (hu : a < u), 𝓟 (Iio u)) ⊓ 𝓟 (Ici a) :=
+begin
+  rw [nhds_within, nhds_eq_order],
+  refine le_antisymm (inf_le_inf_right _ inf_le_right) (le_inf (le_inf _ inf_le_left) inf_le_right),
+  exact inf_le_right.trans (le_infi₂ $ λ l hl, principal_mono.2 $ Ici_subset_Ioi.2 hl)
+end
+
+lemma nhds_within_Iic_eq'' [topological_space α] [preorder α] [order_topology α] (a : α) :
+  𝓝[≤] a = (⨅ l < a, 𝓟 (Ioi l)) ⊓ 𝓟 (Iic a) :=
+nhds_within_Ici_eq'' (to_dual a)
+
+lemma nhds_within_Ici_eq' [topological_space α] [preorder α] [order_topology α] {a : α}
+  (ha : ∃ u, a < u) :
+  𝓝[≥] a = ⨅ u (hu : a < u), 𝓟 (Ico a u) :=
+by simp only [nhds_within_Ici_eq'', binfi_inf ha, inf_principal, Iio_inter_Ici]
+
+lemma nhds_within_Iic_eq' [topological_space α] [preorder α] [order_topology α] {a : α}
+  (ha : ∃ l, l < a) :
+  𝓝[≤] a = ⨅ l < a, 𝓟 (Ioc l a) :=
+by simp only [nhds_within_Iic_eq'', binfi_inf ha, inf_principal, Ioi_inter_Iic]
+
+lemma nhds_within_Ici_basis' [topological_space α] [linear_order α] [order_topology α] {a : α}
+  (ha : ∃ u, a < u) : (𝓝[≥] a).has_basis (λ u, a < u) (λ u, Ico a u) :=
+(nhds_within_Ici_eq' ha).symm ▸ has_basis_binfi_principal (λ b hb c hc,
+  ⟨min b c, lt_min hb hc, Ico_subset_Ico_right (min_le_left _ _),
+    Ico_subset_Ico_right (min_le_right _ _)⟩) ha
+
+lemma nhds_within_Iic_basis' [topological_space α] [linear_order α] [order_topology α] {a : α}
+  (ha : ∃ l, l < a) : (𝓝[≤] a).has_basis (λ l, l < a) (λ l, Ioc l a) :=
+by { convert @nhds_within_Ici_basis' αᵒᵈ _ _ _ (to_dual a) ha,
+     exact funext (λ x, (@dual_Ico _ _ _ _).symm) }
+
+lemma nhds_within_Ici_basis [topological_space α] [linear_order α] [order_topology α]
+  [no_max_order α] (a : α) : (𝓝[≥] a).has_basis (λ u, a < u) (λ u, Ico a u) :=
+nhds_within_Ici_basis' (exists_gt a)
+
+lemma nhds_within_Iic_basis [topological_space α] [linear_order α] [order_topology α]
+  [no_min_order α] (a : α) : (𝓝[≤] a).has_basis (λ l, l < a) (λ l, Ioc l a) :=
+nhds_within_Iic_basis' (exists_lt a)
+
+lemma nhds_top_order [topological_space α] [preorder α] [order_top α] [order_topology α] :
+  𝓝 (⊤:α) = (⨅l (h₂ : l < ⊤), 𝓟 (Ioi l)) :=
+by simp [nhds_eq_order (⊤:α)]
+
+lemma nhds_bot_order [topological_space α] [preorder α] [order_bot α] [order_topology α] :
+  𝓝 (⊥:α) = (⨅l (h₂ : ⊥ < l), 𝓟 (Iio l)) :=
+by simp [nhds_eq_order (⊥:α)]
+
+lemma nhds_top_basis [topological_space α] [linear_order α] [order_top α] [order_topology α]
+  [nontrivial α] :
+  (𝓝 ⊤).has_basis (λ a : α, a < ⊤) (λ a : α, Ioi a) :=
+have ∃ x : α, x < ⊤, from (exists_ne ⊤).imp $ λ x hx, hx.lt_top,
+by simpa only [Iic_top, nhds_within_univ, Ioc_top] using nhds_within_Iic_basis' this
+
+lemma nhds_bot_basis [topological_space α] [linear_order α] [order_bot α] [order_topology α]
+  [nontrivial α] :
+  (𝓝 ⊥).has_basis (λ a : α, ⊥ < a) (λ a : α, Iio a) :=
+@nhds_top_basis αᵒᵈ _ _ _ _ _
+
+lemma nhds_top_basis_Ici [topological_space α] [linear_order α] [order_top α] [order_topology α]
+  [nontrivial α] [densely_ordered α] :
+  (𝓝 ⊤).has_basis (λ a : α, a < ⊤) Ici :=
+nhds_top_basis.to_has_basis
+  (λ a ha, let ⟨b, hab, hb⟩ := exists_between ha in ⟨b, hb, Ici_subset_Ioi.mpr hab⟩)
+  (λ a ha, ⟨a, ha, Ioi_subset_Ici_self⟩)
+
+lemma nhds_bot_basis_Iic [topological_space α] [linear_order α] [order_bot α] [order_topology α]
+  [nontrivial α] [densely_ordered α] :
+  (𝓝 ⊥).has_basis (λ a : α, ⊥ < a) Iic :=
+@nhds_top_basis_Ici αᵒᵈ _ _ _ _ _ _
+
+lemma tendsto_nhds_top_mono [topological_space β] [preorder β] [order_top β] [order_topology β]
+  {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊤)) (hg : f ≤ᶠ[l] g) :
+  tendsto g l (𝓝 ⊤) :=
+begin
+  simp only [nhds_top_order, tendsto_infi, tendsto_principal] at hf ⊢,
+  intros x hx,
+  filter_upwards [hf x hx, hg] with _ using lt_of_lt_of_le,
+end
+
+lemma tendsto_nhds_bot_mono [topological_space β] [preorder β] [order_bot β] [order_topology β]
+  {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊥)) (hg : g ≤ᶠ[l] f) :
+  tendsto g l (𝓝 ⊥) :=
+@tendsto_nhds_top_mono α βᵒᵈ _ _ _ _ _ _ _ hf hg
+
+lemma tendsto_nhds_top_mono' [topological_space β] [preorder β] [order_top β]
+  [order_topology β] {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊤)) (hg : f ≤ g) :
+  tendsto g l (𝓝 ⊤) :=
+tendsto_nhds_top_mono hf (eventually_of_forall hg)
+
+lemma tendsto_nhds_bot_mono' [topological_space β] [preorder β] [order_bot β]
+  [order_topology β] {l : filter α} {f g : α → β} (hf : tendsto f l (𝓝 ⊥)) (hg : g ≤ f) :
+  tendsto g l (𝓝 ⊥) :=
+tendsto_nhds_bot_mono hf (eventually_of_forall hg)
+
+section linear_order
+variables [topological_space α] [linear_order α]
+
+section order_closed_topology
+variables [order_closed_topology α] {a b : α}
+
+lemma eventually_le_nhds (hab : a < b) : ∀ᶠ x in 𝓝 a, x ≤ b :=
+eventually_iff.mpr (mem_nhds_iff.mpr ⟨Iio b, Iio_subset_Iic_self, is_open_Iio, hab⟩)
+
+lemma eventually_lt_nhds (hab : a < b) : ∀ᶠ x in 𝓝 a, x < b :=
+eventually_iff.mpr (mem_nhds_iff.mpr ⟨Iio b, rfl.subset, is_open_Iio, hab⟩)
+
+lemma eventually_ge_nhds (hab : b < a) : ∀ᶠ x in 𝓝 a, b ≤ x :=
+eventually_iff.mpr (mem_nhds_iff.mpr ⟨Ioi b, Ioi_subset_Ici_self, is_open_Ioi, hab⟩)
+
+lemma eventually_gt_nhds (hab : b < a) : ∀ᶠ x in 𝓝 a, b < x :=
+eventually_iff.mpr (mem_nhds_iff.mpr ⟨Ioi b, rfl.subset, is_open_Ioi, hab⟩)
+
+end order_closed_topology
+
+section order_topology
+variables [order_topology α]
+
+lemma order_separated {a₁ a₂ : α} (h : a₁ < a₂) :
+  ∃u v : set α, is_open u ∧ is_open v ∧ a₁ ∈ u ∧ a₂ ∈ v ∧ (∀b₁∈u, ∀b₂∈v, b₁ < b₂) :=
+match dense_or_discrete a₁ a₂ with
+| or.inl ⟨a, ha₁, ha₂⟩ := ⟨{a' | a' < a}, {a' | a < a'}, is_open_gt' a, is_open_lt' a, ha₁, ha₂,
+    assume b₁ h₁ b₂ h₂, lt_trans h₁ h₂⟩
+| or.inr ⟨h₁, h₂⟩ := ⟨{a | a < a₂}, {a | a₁ < a}, is_open_gt' a₂, is_open_lt' a₁, h, h,
+    assume b₁ hb₁ b₂ hb₂,
+    calc b₁ ≤ a₁ : h₂ _ hb₁
+      ... < a₂ : h
+      ... ≤ b₂ : h₁ _ hb₂⟩
+end
+
+@[priority 100] -- see Note [lower instance priority]
+instance order_topology.to_order_closed_topology : order_closed_topology α :=
+{ is_closed_le' :=
+    is_open_compl_iff.1 $ is_open_prod_iff.mpr $ assume a₁ a₂ (h : ¬ a₁ ≤ a₂),
+      have h : a₂ < a₁, from lt_of_not_ge h,
+      let ⟨u, v, hu, hv, ha₁, ha₂, h⟩ := order_separated h in
+      ⟨v, u, hv, hu, ha₂, ha₁, assume ⟨b₁, b₂⟩ ⟨h₁, h₂⟩, not_le_of_gt $ h b₂ h₂ b₁ h₁⟩ }
+
+lemma exists_Ioc_subset_of_mem_nhds {a : α} {s : set α} (hs : s ∈ 𝓝 a) (h : ∃ l, l < a) :
+  ∃ l < a, Ioc l a ⊆ s :=
+(nhds_within_Iic_basis' h).mem_iff.mp (nhds_within_le_nhds hs)
+
+lemma exists_Ioc_subset_of_mem_nhds' {a : α} {s : set α} (hs : s ∈ 𝓝 a) {l : α} (hl : l < a) :
+  ∃ l' ∈ Ico l a, Ioc l' a ⊆ s :=
+let ⟨l', hl'a, hl's⟩ := exists_Ioc_subset_of_mem_nhds hs ⟨l, hl⟩
+in ⟨max l l', ⟨le_max_left _ _, max_lt hl hl'a⟩,
+  (Ioc_subset_Ioc_left $ le_max_right _ _).trans hl's⟩
+
+lemma exists_Ico_subset_of_mem_nhds' {a : α} {s : set α} (hs : s ∈ 𝓝 a) {u : α} (hu : a < u) :
+  ∃ u' ∈ Ioc a u, Ico a u' ⊆ s :=
+by simpa only [order_dual.exists, exists_prop, dual_Ico, dual_Ioc]
+  using exists_Ioc_subset_of_mem_nhds' (show of_dual ⁻¹' s ∈ 𝓝 (to_dual a), from hs) hu.dual
+
+lemma exists_Ico_subset_of_mem_nhds {a : α} {s : set α} (hs : s ∈ 𝓝 a) (h : ∃ u, a < u) :
+  ∃ u (_ : a < u), Ico a u ⊆ s :=
+let ⟨l', hl'⟩ := h, ⟨l, hl⟩ := exists_Ico_subset_of_mem_nhds' hs hl' in ⟨l, hl.fst.1, hl.snd⟩
+
+lemma exists_Icc_mem_subset_of_mem_nhds_within_Ici {a : α} {s : set α} (hs : s ∈ 𝓝[≥] a) :
+  ∃ b (_ : a ≤ b), Icc a b ∈ 𝓝[≥] a ∧ Icc a b ⊆ s :=
+begin
+  rcases (em (is_max a)).imp_right not_is_max_iff.mp with ha|ha,
+  { use a, simpa [ha.Ici_eq] using hs },
+  { rcases (nhds_within_Ici_basis' ha).mem_iff.mp hs with ⟨b, hab, hbs⟩,
+    rcases eq_empty_or_nonempty (Ioo a b) with H|⟨c, hac, hcb⟩,
+    { have : Ico a b = Icc a a,
+      { rw [← Icc_union_Ioo_eq_Ico le_rfl hab, H, union_empty] },
+      exact ⟨a, le_rfl, this ▸ ⟨Ico_mem_nhds_within_Ici $ left_mem_Ico.2 hab, hbs⟩⟩ },
+    { refine ⟨c, hac.le, Icc_mem_nhds_within_Ici $ left_mem_Ico.mpr hac, _⟩,
+      exact (Icc_subset_Ico_right hcb).trans hbs } }
+end
+
+lemma exists_Icc_mem_subset_of_mem_nhds_within_Iic {a : α} {s : set α} (hs : s ∈ 𝓝[≤] a) :
+  ∃ b ≤ a, Icc b a ∈ 𝓝[≤] a ∧ Icc b a ⊆ s :=
+by simpa only [dual_Icc, to_dual.surjective.exists]
+  using @exists_Icc_mem_subset_of_mem_nhds_within_Ici αᵒᵈ _ _ _ (to_dual a) _ hs
+
+lemma exists_Icc_mem_subset_of_mem_nhds {a : α} {s : set α} (hs : s ∈ 𝓝 a) :
+  ∃ b c, a ∈ Icc b c ∧ Icc b c ∈ 𝓝 a ∧ Icc b c ⊆ s :=
+begin
+  rcases exists_Icc_mem_subset_of_mem_nhds_within_Iic (nhds_within_le_nhds hs)
+    with ⟨b, hba, hb_nhds, hbs⟩,
+  rcases exists_Icc_mem_subset_of_mem_nhds_within_Ici (nhds_within_le_nhds hs)
+    with ⟨c, hac, hc_nhds, hcs⟩,
+  refine ⟨b, c, ⟨hba, hac⟩, _⟩,
+  rw [← Icc_union_Icc_eq_Icc hba hac, ← nhds_left_sup_nhds_right],
+  exact ⟨union_mem_sup hb_nhds hc_nhds, union_subset hbs hcs⟩
+end
+
+lemma is_open.exists_Ioo_subset [nontrivial α] {s : set α} (hs : is_open s) (h : s.nonempty) :
+  ∃ a b, a < b ∧ Ioo a b ⊆ s :=
+begin
+  obtain ⟨x, hx⟩ : ∃ x, x ∈ s := h,
+  obtain ⟨y, hy⟩ : ∃ y, y ≠ x := exists_ne x,
+  rcases lt_trichotomy x y with H|rfl|H,
+  { obtain ⟨u, xu, hu⟩ : ∃ (u : α) (hu : x < u), Ico x u ⊆ s :=
+      exists_Ico_subset_of_mem_nhds (hs.mem_nhds hx) ⟨y, H⟩,
+    exact ⟨x, u, xu, Ioo_subset_Ico_self.trans hu⟩ },
+  { exact (hy rfl).elim },
+  { obtain ⟨l, lx, hl⟩ : ∃ (l : α) (hl : l < x), Ioc l x ⊆ s :=
+      exists_Ioc_subset_of_mem_nhds (hs.mem_nhds hx) ⟨y, H⟩,
+    exact ⟨l, x, lx, Ioo_subset_Ioc_self.trans hl⟩ }
+end
+
+lemma dense_of_exists_between [nontrivial α] {s : set α}
+  (h : ∀ ⦃a b⦄, a < b → ∃ c ∈ s, a < c ∧ c < b) : dense s :=
+begin
+  apply dense_iff_inter_open.2 (λ U U_open U_nonempty, _),
+  obtain ⟨a, b, hab, H⟩ : ∃ (a b : α), a < b ∧ Ioo a b ⊆ U := U_open.exists_Ioo_subset U_nonempty,
+  obtain ⟨x, xs, hx⟩ : ∃ (x : α) (H : x ∈ s), a < x ∧ x < b := h hab,
+  exact ⟨x, ⟨H hx, xs⟩⟩
+end
+
+/-- A set in a nontrivial densely linear ordered type is dense in the sense of topology if and only
+if for any `a < b` there exists `c ∈ s`, `a < c < b`. Each implication requires less typeclass
+assumptions. -/
+lemma dense_iff_exists_between [densely_ordered α] [nontrivial α] {s : set α} :
+  dense s ↔ ∀ a b, a < b → ∃ c ∈ s, a < c ∧ c < b :=
+⟨λ h a b hab, h.exists_between hab, dense_of_exists_between⟩
+
+/-- A set is a neighborhood of `a` if and only if it contains an interval `(l, u)` containing `a`,
+provided `a` is neither a bottom element nor a top element. -/
+lemma mem_nhds_iff_exists_Ioo_subset' {a : α} {s : set α} (hl : ∃ l, l < a) (hu : ∃ u, a < u) :
+  s ∈ 𝓝 a ↔ ∃l u, a ∈ Ioo l u ∧ Ioo l u ⊆ s :=
+begin
+  split,
+  { assume h,
+    rcases exists_Ico_subset_of_mem_nhds h hu with ⟨u, au, hu⟩,
+    rcases exists_Ioc_subset_of_mem_nhds h hl with ⟨l, la, hl⟩,
+    exact ⟨l, u, ⟨la, au⟩, Ioc_union_Ico_eq_Ioo la au ▸ union_subset hl hu⟩ },
+  { rintros ⟨l, u, ha, h⟩,
+    apply mem_of_superset (Ioo_mem_nhds ha.1 ha.2) h }
+end
+
+/-- A set is a neighborhood of `a` if and only if it contains an interval `(l, u)` containing `a`.
+-/
+lemma mem_nhds_iff_exists_Ioo_subset [no_max_order α] [no_min_order α] {a : α} {s : set α} :
+  s ∈ 𝓝 a ↔ ∃l u, a ∈ Ioo l u ∧ Ioo l u ⊆ s :=
+mem_nhds_iff_exists_Ioo_subset' (exists_lt a) (exists_gt a)
+
+lemma nhds_basis_Ioo' {a : α} (hl : ∃ l, l < a) (hu : ∃ u, a < u) :
+  (𝓝 a).has_basis (λ b : α × α, b.1 < a ∧ a < b.2) (λ b, Ioo b.1 b.2) :=
+⟨λ s, (mem_nhds_iff_exists_Ioo_subset' hl hu).trans $ by simp⟩
+
+lemma nhds_basis_Ioo [no_max_order α] [no_min_order α] (a : α) :
+  (𝓝 a).has_basis (λ b : α × α, b.1 < a ∧ a < b.2) (λ b, Ioo b.1 b.2) :=
+nhds_basis_Ioo' (exists_lt a) (exists_gt a)
+
+lemma filter.eventually.exists_Ioo_subset [no_max_order α] [no_min_order α] {a : α} {p : α → Prop}
+  (hp : ∀ᶠ x in 𝓝 a, p x) :
+  ∃ l u, a ∈ Ioo l u ∧ Ioo l u ⊆ {x | p x} :=
+mem_nhds_iff_exists_Ioo_subset.1 hp
+
+/-- The set of points which are isolated on the right is countable when the space is
+second-countable. -/
+lemma countable_of_isolated_right [second_countable_topology α] :
+  set.countable {x : α | ∃ y, x < y ∧ Ioo x y = ∅} :=
+begin
+  nontriviality α,
+  let s := {x : α | ∃ y, x < y ∧ Ioo x y = ∅},
+  have : ∀ x ∈ s, ∃ y, x < y ∧ Ioo x y = ∅ := λ x, id,
+  choose! y hy h'y using this,
+  have Hy : ∀ x z, x ∈ s → z < y x → z ≤ x,
+  { assume x z xs hz,
+    have A : Ioo x (y x) = ∅ := h'y _ xs,
+    contrapose! A,
+    exact nonempty.ne_empty ⟨z, A, hz⟩ },
+  suffices H : ∀ (a : set α), is_open a → set.countable {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a},
+  { have : s ⊆ ⋃ (a ∈ countable_basis α), {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a},
+    { assume x hx,
+      rcases (is_basis_countable_basis α).exists_mem_of_ne (hy x hx).ne with ⟨a, ab, xa, ya⟩,
+      simp only [mem_set_of_eq, mem_Union],
+      exact ⟨a, ab, hx, xa, ya⟩ },
+    apply countable.mono this,
+    refine countable.bUnion (countable_countable_basis α) (λ a ha, H _ _),
+    exact is_open_of_mem_countable_basis ha },
+  assume a ha,
+  suffices H : set.countable {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a ∧ ¬(is_bot x)},
+  { have : {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a} ⊆
+      {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a ∧ ¬(is_bot x)} ∪ {x | is_bot x},
+    { assume x hx,
+      by_cases h'x : is_bot x,
+      { simp only [h'x, mem_set_of_eq, mem_union, not_true, and_false, false_or] },
+      { simpa only [h'x, hx.2.1, hx.2.2, mem_set_of_eq, mem_union,
+          not_false_iff, and_true, or_false] using hx.left } },
+    exact countable.mono this (H.union (subsingleton_is_bot α).countable) },
+  let t := {x | x ∈ s ∧ x ∈ a ∧ y x ∉ a ∧ ¬(is_bot x)},
+  have : ∀ x ∈ t, ∃ z < x, Ioc z x ⊆ a,
+  { assume x hx,
+    apply exists_Ioc_subset_of_mem_nhds (ha.mem_nhds hx.2.1),
+    simpa only [is_bot, not_forall, not_le] using hx.right.right.right },
+  choose! z hz h'z using this,
+  have : pairwise_disjoint t (λ x, Ioc (z x) x),
+  { assume x xt x' x't hxx',
+    rcases lt_or_gt_of_ne hxx' with h'|h',
+    { refine disjoint_left.2 (λ u ux ux', xt.2.2.1 _),
+      refine h'z x' x't ⟨ux'.1.trans_le (ux.2.trans (hy x xt.1).le), _⟩,
+      by_contra' H,
+      exact false.elim (lt_irrefl _ ((Hy _ _ xt.1 H).trans_lt h')) },
+    { refine disjoint_left.2 (λ u ux ux', x't.2.2.1 _),
+      refine h'z x xt ⟨ux.1.trans_le (ux'.2.trans (hy x' x't.1).le), _⟩,
+      by_contra' H,
+      exact false.elim (lt_irrefl _ ((Hy _ _ x't.1 H).trans_lt h')) } },
+  refine this.countable_of_is_open (λ x hx, _) (λ x hx, ⟨x, hz x hx, le_rfl⟩),
+  suffices H : Ioc (z x) x = Ioo (z x) (y x),
+  { rw H, exact is_open_Ioo },
+  exact subset.antisymm (Ioc_subset_Ioo_right (hy x hx.1)) (λ u hu, ⟨hu.1, Hy _ _ hx.1 hu.2⟩),
+end
+
+/-- The set of points which are isolated on the left is countable when the space is
+second-countable. -/
+lemma countable_of_isolated_left [second_countable_topology α] :
+  set.countable {x : α | ∃ y, y < x ∧ Ioo y x = ∅} :=
+begin
+  convert @countable_of_isolated_right αᵒᵈ _ _ _ _,
+  have : ∀ (x y : α), Ioo x y = {z | z < y ∧ x < z},
+  { simp_rw [and_comm, Ioo], simp only [eq_self_iff_true, forall_2_true_iff] },
+  simp_rw [this],
+  refl
+end
+
+/-- Consider a disjoint family of intervals `(x, y)` with `x < y` in a second-countable space.
+Then the family is countable.
+This is not a straightforward consequence of second-countability as some of these intervals might be
+empty (but in fact this can happen only for countably many of them). -/
+lemma set.pairwise_disjoint.countable_of_Ioo [second_countable_topology α]
+  {y : α → α} {s : set α} (h : pairwise_disjoint s (λ x, Ioo x (y x))) (h' : ∀ x ∈ s, x < y x) :
+  s.countable :=
+begin
+  let t := {x | x ∈ s ∧ (Ioo x (y x)).nonempty},
+  have t_count : t.countable,
+  { have : t ⊆ s := λ x hx, hx.1,
+    exact (h.subset this).countable_of_is_open (λ x hx, is_open_Ioo) (λ x hx, hx.2) },
+  have : s ⊆ t ∪ {x : α | ∃ x', x < x' ∧ Ioo x x' = ∅},
+  { assume x hx,
+    by_cases h'x : (Ioo x (y x)).nonempty,
+    { exact or.inl ⟨hx, h'x⟩ },
+    { exact or.inr ⟨y x, h' x hx, not_nonempty_iff_eq_empty.1 h'x⟩ } },
+  exact countable.mono this (t_count.union countable_of_isolated_right),
+end
+
+section pi
+
+/-!
+### Intervals in `Π i, π i` belong to `𝓝 x`
+
+For each lemma `pi_Ixx_mem_nhds` we add a non-dependent version `pi_Ixx_mem_nhds'` because
+sometimes Lean fails to unify different instances while trying to apply the dependent version to,
+e.g., `ι → ℝ`.
+-/
+
+variables {ι : Type*} {π : ι → Type*} [finite ι] [Π i, linear_order (π i)]
+  [Π i, topological_space (π i)] [∀ i, order_topology (π i)] {a b x : Π i, π i} {a' b' x' : ι → α}
+
+lemma pi_Iic_mem_nhds (ha : ∀ i, x i < a i) : Iic a ∈ 𝓝 x :=
+pi_univ_Iic a ▸ set_pi_mem_nhds (set.to_finite _) (λ i _, Iic_mem_nhds (ha _))
+
+lemma pi_Iic_mem_nhds' (ha : ∀ i, x' i < a' i) : Iic a' ∈ 𝓝 x' :=
+pi_Iic_mem_nhds ha
+
+lemma pi_Ici_mem_nhds (ha : ∀ i, a i < x i) : Ici a ∈ 𝓝 x :=
+pi_univ_Ici a ▸ set_pi_mem_nhds (set.to_finite _) (λ i _, Ici_mem_nhds (ha _))
+
+lemma pi_Ici_mem_nhds' (ha : ∀ i, a' i < x' i) : Ici a' ∈ 𝓝 x' :=
+pi_Ici_mem_nhds ha
+
+lemma pi_Icc_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Icc a b ∈ 𝓝 x :=
+pi_univ_Icc a b ▸ set_pi_mem_nhds finite_univ (λ i _, Icc_mem_nhds (ha _) (hb _))
+
+lemma pi_Icc_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Icc a' b' ∈ 𝓝 x' :=
+pi_Icc_mem_nhds ha hb
+
+variables [nonempty ι]
+
+lemma pi_Iio_mem_nhds (ha : ∀ i, x i < a i) : Iio a ∈ 𝓝 x :=
+begin
+  refine mem_of_superset (set_pi_mem_nhds (set.to_finite _) (λ i _, _))
+    (pi_univ_Iio_subset a),
+  exact Iio_mem_nhds (ha i)
+end
+
+lemma pi_Iio_mem_nhds' (ha : ∀ i, x' i < a' i) : Iio a' ∈ 𝓝 x' :=
+pi_Iio_mem_nhds ha
+
+lemma pi_Ioi_mem_nhds (ha : ∀ i, a i < x i) : Ioi a ∈ 𝓝 x :=
+@pi_Iio_mem_nhds ι (λ i, (π i)ᵒᵈ) _ _ _ _ _ _ _ ha
+
+lemma pi_Ioi_mem_nhds' (ha : ∀ i, a' i < x' i) : Ioi a' ∈ 𝓝 x' :=
+pi_Ioi_mem_nhds ha
+
+lemma pi_Ioc_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Ioc a b ∈ 𝓝 x :=
+begin
+  refine mem_of_superset (set_pi_mem_nhds (set.to_finite _) (λ i _, _))
+    (pi_univ_Ioc_subset a b),
+  exact Ioc_mem_nhds (ha i) (hb i)
+end
+
+lemma pi_Ioc_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Ioc a' b' ∈ 𝓝 x' :=
+pi_Ioc_mem_nhds ha hb
+
+lemma pi_Ico_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Ico a b ∈ 𝓝 x :=
+begin
+  refine mem_of_superset (set_pi_mem_nhds (set.to_finite _) (λ i _, _))
+    (pi_univ_Ico_subset a b),
+  exact Ico_mem_nhds (ha i) (hb i)
+end
+
+lemma pi_Ico_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Ico a' b' ∈ 𝓝 x' :=
+pi_Ico_mem_nhds ha hb
+
+lemma pi_Ioo_mem_nhds (ha : ∀ i, a i < x i) (hb : ∀ i, x i < b i) : Ioo a b ∈ 𝓝 x :=
+begin
+  refine mem_of_superset (set_pi_mem_nhds (set.to_finite _) (λ i _, _))
+    (pi_univ_Ioo_subset a b),
+  exact Ioo_mem_nhds (ha i) (hb i)
+end
+
+lemma pi_Ioo_mem_nhds' (ha : ∀ i, a' i < x' i) (hb : ∀ i, x' i < b' i) : Ioo a' b' ∈ 𝓝 x' :=
+pi_Ioo_mem_nhds ha hb
+
+end pi
+
+lemma disjoint_nhds_at_top [no_max_order α] (x : α) :
+  disjoint (𝓝 x) at_top :=
+begin
+  rcases exists_gt x with ⟨y, hy : x < y⟩,
+  refine disjoint_of_disjoint_of_mem _ (Iio_mem_nhds hy) (mem_at_top y),
+  exact disjoint_left.mpr (λ z, not_le.2)
+end
+
+@[simp] lemma inf_nhds_at_top [no_max_order α] (x : α) :
+  𝓝 x ⊓ at_top = ⊥ :=
+disjoint_iff.1 (disjoint_nhds_at_top x)
+
+lemma disjoint_nhds_at_bot [no_min_order α] (x : α) : disjoint (𝓝 x) at_bot :=
+@disjoint_nhds_at_top αᵒᵈ _ _ _ _ x
+
+@[simp] lemma inf_nhds_at_bot [no_min_order α] (x : α) : 𝓝 x ⊓ at_bot = ⊥ :=
+@inf_nhds_at_top αᵒᵈ _ _ _ _ x
+
+lemma not_tendsto_nhds_of_tendsto_at_top [no_max_order α]
+  {F : filter β} [ne_bot F] {f : β → α} (hf : tendsto f F at_top) (x : α) :
+  ¬ tendsto f F (𝓝 x) :=
+hf.not_tendsto (disjoint_nhds_at_top x).symm
+
+lemma not_tendsto_at_top_of_tendsto_nhds [no_max_order α]
+  {F : filter β} [ne_bot F] {f : β → α} {x : α} (hf : tendsto f F (𝓝 x)) :
+  ¬  tendsto f F at_top :=
+hf.not_tendsto (disjoint_nhds_at_top x)
+
+lemma not_tendsto_nhds_of_tendsto_at_bot [no_min_order α]
+  {F : filter β} [ne_bot F] {f : β → α} (hf : tendsto f F at_bot) (x : α) :
+  ¬ tendsto f F (𝓝 x) :=
+hf.not_tendsto (disjoint_nhds_at_bot x).symm
+
+lemma not_tendsto_at_bot_of_tendsto_nhds [no_min_order α]
+  {F : filter β} [ne_bot F] {f : β → α} {x : α} (hf : tendsto f F (𝓝 x)) :
+  ¬ tendsto f F at_bot :=
+hf.not_tendsto (disjoint_nhds_at_bot x)
+
+/-!
+### Neighborhoods to the left and to the right on an `order_topology`
+
+We've seen some properties of left and right neighborhood of a point in an `order_closed_topology`.
+In an `order_topology`, such neighborhoods can be characterized as the sets containing suitable
+intervals to the right or to the left of `a`. We give now these characterizations. -/
+
+-- NB: If you extend the list, append to the end please to avoid breaking the API
+/-- The following statements are equivalent:
+
+0. `s` is a neighborhood of `a` within `(a, +∞)`
+1. `s` is a neighborhood of `a` within `(a, b]`
+2. `s` is a neighborhood of `a` within `(a, b)`
+3. `s` includes `(a, u)` for some `u ∈ (a, b]`
+4. `s` includes `(a, u)` for some `u > a` -/
+lemma tfae_mem_nhds_within_Ioi {a b : α} (hab : a < b) (s : set α) :
+  tfae [s ∈ 𝓝[>] a, -- 0 : `s` is a neighborhood of `a` within `(a, +∞)`
+    s ∈ 𝓝[Ioc a b] a,   -- 1 : `s` is a neighborhood of `a` within `(a, b]`
+    s ∈ 𝓝[Ioo a b] a,   -- 2 : `s` is a neighborhood of `a` within `(a, b)`
+    ∃ u ∈ Ioc a b, Ioo a u ⊆ s,    -- 3 : `s` includes `(a, u)` for some `u ∈ (a, b]`
+    ∃ u ∈ Ioi a, Ioo a u ⊆ s] :=   -- 4 : `s` includes `(a, u)` for some `u > a`
+begin
+  tfae_have : 1 ↔ 2, by rw [nhds_within_Ioc_eq_nhds_within_Ioi hab],
+  tfae_have : 1 ↔ 3, by rw [nhds_within_Ioo_eq_nhds_within_Ioi hab],
+  tfae_have : 4 → 5, from λ ⟨u, umem, hu⟩, ⟨u, umem.1, hu⟩,
+  tfae_have : 5 → 1,
+  { rintros ⟨u, hau, hu⟩,
+    exact mem_of_superset (Ioo_mem_nhds_within_Ioi ⟨le_refl a, hau⟩) hu },
+  tfae_have : 1 → 4,
+  { assume h,
+    rcases mem_nhds_within_iff_exists_mem_nhds_inter.1 h with ⟨v, va, hv⟩,
+    rcases exists_Ico_subset_of_mem_nhds' va hab with ⟨u, au, hu⟩,
+    refine ⟨u, au, λx hx, _⟩,
+    refine hv ⟨hu ⟨le_of_lt hx.1, hx.2⟩, _⟩,
+    exact hx.1 },
+  tfae_finish
+end
+
+lemma mem_nhds_within_Ioi_iff_exists_mem_Ioc_Ioo_subset {a u' : α} {s : set α} (hu' : a < u') :
+  s ∈ 𝓝[>] a ↔ ∃u ∈ Ioc a u', Ioo a u ⊆ s :=
+(tfae_mem_nhds_within_Ioi hu' s).out 0 3
+
+/-- A set is a neighborhood of `a` within `(a, +∞)` if and only if it contains an interval `(a, u)`
+with `a < u < u'`, provided `a` is not a top element. -/
+lemma mem_nhds_within_Ioi_iff_exists_Ioo_subset' {a u' : α} {s : set α} (hu' : a < u') :
+  s ∈ 𝓝[>] a ↔ ∃u ∈ Ioi a, Ioo a u ⊆ s :=
+(tfae_mem_nhds_within_Ioi hu' s).out 0 4
+
+/-- A set is a neighborhood of `a` within `(a, +∞)` if and only if it contains an interval `(a, u)`
+with `a < u`. -/
+lemma mem_nhds_within_Ioi_iff_exists_Ioo_subset [no_max_order α] {a : α} {s : set α} :
+  s ∈ 𝓝[>] a ↔ ∃u ∈ Ioi a, Ioo a u ⊆ s :=
+let ⟨u', hu'⟩ := exists_gt a in mem_nhds_within_Ioi_iff_exists_Ioo_subset' hu'
+
+/-- A set is a neighborhood of `a` within `(a, +∞)` if and only if it contains an interval `(a, u]`
+with `a < u`. -/
+lemma mem_nhds_within_Ioi_iff_exists_Ioc_subset [no_max_order α] [densely_ordered α]
+  {a : α} {s : set α} : s ∈ 𝓝[>] a ↔ ∃u ∈ Ioi a, Ioc a u ⊆ s :=
+begin
+  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset,
+  split,
+  { rintros ⟨u, au, as⟩,
+    rcases exists_between au with ⟨v, hv⟩,
+    exact ⟨v, hv.1, λx hx, as ⟨hx.1, lt_of_le_of_lt hx.2 hv.2⟩⟩ },
+  { rintros ⟨u, au, as⟩,
+    exact ⟨u, au, subset.trans Ioo_subset_Ioc_self as⟩ }
+end
+
+/-- The following statements are equivalent:
+
+0. `s` is a neighborhood of `b` within `(-∞, b)`
+1. `s` is a neighborhood of `b` within `[a, b)`
+2. `s` is a neighborhood of `b` within `(a, b)`
+3. `s` includes `(l, b)` for some `l ∈ [a, b)`
+4. `s` includes `(l, b)` for some `l < b` -/
+lemma tfae_mem_nhds_within_Iio {a b : α} (h : a < b) (s : set α) :
+  tfae [s ∈ 𝓝[<] b, -- 0 : `s` is a neighborhood of `b` within `(-∞, b)`
+    s ∈ 𝓝[Ico a b] b,   -- 1 : `s` is a neighborhood of `b` within `[a, b)`
+    s ∈ 𝓝[Ioo a b] b,   -- 2 : `s` is a neighborhood of `b` within `(a, b)`
+    ∃ l ∈ Ico a b, Ioo l b ⊆ s,    -- 3 : `s` includes `(l, b)` for some `l ∈ [a, b)`
+    ∃ l ∈ Iio b, Ioo l b ⊆ s] :=   -- 4 : `s` includes `(l, b)` for some `l < b`
+by simpa only [exists_prop, order_dual.exists, dual_Ioi, dual_Ioc, dual_Ioo]
+    using tfae_mem_nhds_within_Ioi h.dual (of_dual ⁻¹' s)
+
+lemma mem_nhds_within_Iio_iff_exists_mem_Ico_Ioo_subset {a l' : α} {s : set α} (hl' : l' < a) :
+  s ∈ 𝓝[<] a ↔ ∃l ∈ Ico l' a, Ioo l a ⊆ s :=
+(tfae_mem_nhds_within_Iio hl' s).out 0 3
+
+/-- A set is a neighborhood of `a` within `(-∞, a)` if and only if it contains an interval `(l, a)`
+with `l < a`, provided `a` is not a bottom element. -/
+lemma mem_nhds_within_Iio_iff_exists_Ioo_subset' {a l' : α} {s : set α} (hl' : l' < a) :
+  s ∈ 𝓝[<] a ↔ ∃l ∈ Iio a, Ioo l a ⊆ s :=
+(tfae_mem_nhds_within_Iio hl' s).out 0 4
+
+/-- A set is a neighborhood of `a` within `(-∞, a)` if and only if it contains an interval `(l, a)`
+with `l < a`. -/
+lemma mem_nhds_within_Iio_iff_exists_Ioo_subset [no_min_order α] {a : α} {s : set α} :
+  s ∈ 𝓝[<] a ↔ ∃l ∈ Iio a, Ioo l a ⊆ s :=
+let ⟨l', hl'⟩ := exists_lt a in mem_nhds_within_Iio_iff_exists_Ioo_subset' hl'
+
+/-- A set is a neighborhood of `a` within `(-∞, a)` if and only if it contains an interval `[l, a)`
+with `l < a`. -/
+lemma mem_nhds_within_Iio_iff_exists_Ico_subset [no_min_order α] [densely_ordered α]
+  {a : α} {s : set α} : s ∈ 𝓝[<] a ↔ ∃l ∈ Iio a, Ico l a ⊆ s :=
+begin
+  have : of_dual ⁻¹' s ∈ 𝓝[>] (to_dual a) ↔ _ :=
+    mem_nhds_within_Ioi_iff_exists_Ioc_subset,
+  simpa only [order_dual.exists, exists_prop, dual_Ioc] using this,
+end
+
+/-- The following statements are equivalent:
+
+0. `s` is a neighborhood of `a` within `[a, +∞)`
+1. `s` is a neighborhood of `a` within `[a, b]`
+2. `s` is a neighborhood of `a` within `[a, b)`
+3. `s` includes `[a, u)` for some `u ∈ (a, b]`
+4. `s` includes `[a, u)` for some `u > a` -/
+lemma tfae_mem_nhds_within_Ici {a b : α} (hab : a < b) (s : set α) :
+  tfae [s ∈ 𝓝[≥] a, -- 0 : `s` is a neighborhood of `a` within `[a, +∞)`
+    s ∈ 𝓝[Icc a b] a,   -- 1 : `s` is a neighborhood of `a` within `[a, b]`
+    s ∈ 𝓝[Ico a b] a,   -- 2 : `s` is a neighborhood of `a` within `[a, b)`
+    ∃ u ∈ Ioc a b, Ico a u ⊆ s,    -- 3 : `s` includes `[a, u)` for some `u ∈ (a, b]`
+    ∃ u ∈ Ioi a, Ico a u ⊆ s] :=   -- 4 : `s` includes `[a, u)` for some `u > a`
+begin
+  tfae_have : 1 ↔ 2, by rw [nhds_within_Icc_eq_nhds_within_Ici hab],
+  tfae_have : 1 ↔ 3, by rw [nhds_within_Ico_eq_nhds_within_Ici hab],
+  tfae_have : 1 ↔ 5, from (nhds_within_Ici_basis' ⟨b, hab⟩).mem_iff,
+  tfae_have : 4 → 5, from λ ⟨u, umem, hu⟩, ⟨u, umem.1, hu⟩,
+  tfae_have : 5 → 4,
+  { rintro ⟨u, hua, hus⟩,
+    exact ⟨min u b, ⟨lt_min hua hab, min_le_right _ _⟩,
+      (Ico_subset_Ico_right $ min_le_left _ _).trans hus⟩, },
+  tfae_finish
+end
+
+lemma mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset {a u' : α} {s : set α} (hu' : a < u') :
+  s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioc a u', Ico a u ⊆ s :=
+(tfae_mem_nhds_within_Ici hu' s).out 0 3 (by norm_num) (by norm_num)
+
+/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u)`
+with `a < u < u'`, provided `a` is not a top element. -/
+lemma mem_nhds_within_Ici_iff_exists_Ico_subset' {a u' : α} {s : set α} (hu' : a < u') :
+  s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioi a, Ico a u ⊆ s :=
+(tfae_mem_nhds_within_Ici hu' s).out 0 4 (by norm_num) (by norm_num)
+
+/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u)`
+with `a < u`. -/
+lemma mem_nhds_within_Ici_iff_exists_Ico_subset [no_max_order α] {a : α} {s : set α} :
+  s ∈ 𝓝[≥] a ↔ ∃u ∈ Ioi a, Ico a u ⊆ s :=
+let ⟨u', hu'⟩ := exists_gt a in mem_nhds_within_Ici_iff_exists_Ico_subset' hu'
+
+lemma nhds_within_Ici_basis_Ico [no_max_order α] (a : α) :
+  (𝓝[≥] a).has_basis (λ u, a < u) (Ico a) :=
+⟨λ s, mem_nhds_within_Ici_iff_exists_Ico_subset⟩
+
+/-- A set is a neighborhood of `a` within `[a, +∞)` if and only if it contains an interval `[a, u]`
+with `a < u`. -/
+lemma mem_nhds_within_Ici_iff_exists_Icc_subset [no_max_order α] [densely_ordered α]
+  {a : α} {s : set α} : s ∈ 𝓝[≥] a ↔ ∃ u, a < u ∧ Icc a u ⊆ s :=
+begin
+  rw mem_nhds_within_Ici_iff_exists_Ico_subset,
+  split,
+  { rintros ⟨u, au, as⟩,
+    rcases exists_between au with ⟨v, hv⟩,
+    exact ⟨v, hv.1, λx hx, as ⟨hx.1, lt_of_le_of_lt hx.2 hv.2⟩⟩ },
+  { rintros ⟨u, au, as⟩,
+    exact ⟨u, au, subset.trans Ico_subset_Icc_self as⟩ }
+end
+
+/-- The following statements are equivalent:
+
+0. `s` is a neighborhood of `b` within `(-∞, b]`
+1. `s` is a neighborhood of `b` within `[a, b]`
+2. `s` is a neighborhood of `b` within `(a, b]`
+3. `s` includes `(l, b]` for some `l ∈ [a, b)`
+4. `s` includes `(l, b]` for some `l < b` -/
+lemma tfae_mem_nhds_within_Iic {a b : α} (h : a < b) (s : set α) :
+  tfae [s ∈ 𝓝[≤] b, -- 0 : `s` is a neighborhood of `b` within `(-∞, b]`
+    s ∈ 𝓝[Icc a b] b,   -- 1 : `s` is a neighborhood of `b` within `[a, b]`
+    s ∈ 𝓝[Ioc a b] b,   -- 2 : `s` is a neighborhood of `b` within `(a, b]`
+    ∃ l ∈ Ico a b, Ioc l b ⊆ s,    -- 3 : `s` includes `(l, b]` for some `l ∈ [a, b)`
+    ∃ l ∈ Iio b, Ioc l b ⊆ s] :=   -- 4 : `s` includes `(l, b]` for some `l < b`
+by simpa only [exists_prop, order_dual.exists, dual_Ici, dual_Ioc, dual_Icc, dual_Ico]
+    using tfae_mem_nhds_within_Ici h.dual (of_dual ⁻¹' s)
+
+lemma mem_nhds_within_Iic_iff_exists_mem_Ico_Ioc_subset {a l' : α} {s : set α} (hl' : l' < a) :
+  s ∈ 𝓝[≤] a ↔ ∃l ∈ Ico l' a, Ioc l a ⊆ s :=
+(tfae_mem_nhds_within_Iic hl' s).out 0 3 (by norm_num) (by norm_num)
+
+/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `(l, a]`
+with `l < a`, provided `a` is not a bottom element. -/
+lemma mem_nhds_within_Iic_iff_exists_Ioc_subset' {a l' : α} {s : set α} (hl' : l' < a) :
+  s ∈ 𝓝[≤] a ↔ ∃l ∈ Iio a, Ioc l a ⊆ s :=
+(tfae_mem_nhds_within_Iic hl' s).out 0 4 (by norm_num) (by norm_num)
+
+/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `(l, a]`
+with `l < a`. -/
+lemma mem_nhds_within_Iic_iff_exists_Ioc_subset [no_min_order α] {a : α} {s : set α} :
+  s ∈ 𝓝[≤] a ↔ ∃l ∈ Iio a, Ioc l a ⊆ s :=
+let ⟨l', hl'⟩ := exists_lt a in mem_nhds_within_Iic_iff_exists_Ioc_subset' hl'
+
+/-- A set is a neighborhood of `a` within `(-∞, a]` if and only if it contains an interval `[l, a]`
+with `l < a`. -/
+lemma mem_nhds_within_Iic_iff_exists_Icc_subset [no_min_order α] [densely_ordered α]
+  {a : α} {s : set α} : s ∈ 𝓝[≤] a ↔ ∃ l, l < a ∧ Icc l a ⊆ s :=
+begin
+  convert @mem_nhds_within_Ici_iff_exists_Icc_subset αᵒᵈ _ _ _ _ _ _ _,
+  simp_rw (show ∀ u : αᵒᵈ, @Icc αᵒᵈ _ a u = @Icc α _ u a, from λ u, dual_Icc),
+  refl,
+end
+
+end order_topology
+
+end linear_order
+
+section linear_ordered_add_comm_group
+
+variables [topological_space α] [linear_ordered_add_comm_group α] [order_topology α]
+variables {l : filter β} {f g : β → α}
+
+lemma nhds_eq_infi_abs_sub (a : α) : 𝓝 a = (⨅r>0, 𝓟 {b | |a - b| < r}) :=
+begin
+  simp only [le_antisymm_iff, nhds_eq_order, le_inf_iff, le_infi_iff, le_principal_iff, mem_Ioi,
+    mem_Iio, abs_sub_lt_iff, @sub_lt_iff_lt_add _ _ _ _ _ _ a, @sub_lt_comm _ _ _ _ a, set_of_and],
+  refine ⟨_, _, _⟩,
+  { intros ε ε0,
+    exact inter_mem_inf
+      (mem_infi_of_mem (a - ε) $ mem_infi_of_mem (sub_lt_self a ε0) (mem_principal_self _))
+      (mem_infi_of_mem (ε + a) $ mem_infi_of_mem (by simpa) (mem_principal_self _)) },
+  { intros b hb,
+    exact mem_infi_of_mem (a - b) (mem_infi_of_mem (sub_pos.2 hb) (by simp [Ioi])) },
+  { intros b hb,
+    exact mem_infi_of_mem (b - a) (mem_infi_of_mem (sub_pos.2 hb) (by simp [Iio])) }
+end
+
+lemma order_topology_of_nhds_abs {α : Type*} [topological_space α] [linear_ordered_add_comm_group α]
+  (h_nhds : ∀a:α, 𝓝 a = (⨅r>0, 𝓟 {b | |a - b| < r})) : order_topology α :=
+begin
+  refine ⟨eq_of_nhds_eq_nhds $ λ a, _⟩,
+  rw [h_nhds],
+  letI := preorder.topology α, letI : order_topology α := ⟨rfl⟩,
+  exact (nhds_eq_infi_abs_sub a).symm
+end
+
+lemma linear_ordered_add_comm_group.tendsto_nhds {x : filter β} {a : α} :
+  tendsto f x (𝓝 a) ↔ ∀ ε > (0 : α), ∀ᶠ b in x, |f b - a| < ε :=
+by simp [nhds_eq_infi_abs_sub, abs_sub_comm a]
+
+lemma eventually_abs_sub_lt (a : α) {ε : α} (hε : 0 < ε) : ∀ᶠ x in 𝓝 a, |x - a| < ε :=
+(nhds_eq_infi_abs_sub a).symm ▸ mem_infi_of_mem ε
+  (mem_infi_of_mem hε $ by simp only [abs_sub_comm, mem_principal_self])
+
+/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to `C`
+and `g` tends to `at_top` then `f + g` tends to `at_top`. -/
+lemma filter.tendsto.add_at_top {C : α} (hf : tendsto f l (𝓝 C)) (hg : tendsto g l at_top) :
+  tendsto (λ x, f x + g x) l at_top :=
+begin
+  nontriviality α,
+  obtain ⟨C', hC'⟩ : ∃ C', C' < C := exists_lt C,
+  refine tendsto_at_top_add_left_of_le' _ C' _ hg,
+  exact (hf.eventually (lt_mem_nhds hC')).mono (λ x, le_of_lt)
+end
+
+/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to `C`
+and `g` tends to `at_bot` then `f + g` tends to `at_bot`. -/
+lemma filter.tendsto.add_at_bot {C : α} (hf : tendsto f l (𝓝 C)) (hg : tendsto g l at_bot) :
+  tendsto (λ x, f x + g x) l at_bot :=
+@filter.tendsto.add_at_top αᵒᵈ _ _ _ _ _ _ _ _ hf hg
+
+/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to
+`at_top` and `g` tends to `C` then `f + g` tends to `at_top`. -/
+lemma filter.tendsto.at_top_add {C : α} (hf : tendsto f l at_top) (hg : tendsto g l (𝓝 C)) :
+  tendsto (λ x, f x + g x) l at_top :=
+by { conv in (_ + _) { rw add_comm }, exact hg.add_at_top hf }
+
+/-- In a linearly ordered additive commutative group with the order topology, if `f` tends to
+`at_bot` and `g` tends to `C` then `f + g` tends to `at_bot`. -/
+lemma filter.tendsto.at_bot_add {C : α} (hf : tendsto f l at_bot) (hg : tendsto g l (𝓝 C)) :
+  tendsto (λ x, f x + g x) l at_bot :=
+by { conv in (_ + _) { rw add_comm }, exact hg.add_at_bot hf }
+
+lemma nhds_basis_Ioo_pos [no_min_order α] [no_max_order α] (a : α) :
+  (𝓝 a).has_basis (λ ε : α, (0 : α) < ε) (λ ε, Ioo (a-ε) (a+ε)) :=
+⟨begin
+  refine λ t, (nhds_basis_Ioo a).mem_iff.trans ⟨_, _⟩,
+  { rintros ⟨⟨l, u⟩, ⟨hl : l < a, hu : a < u⟩, h' : Ioo l u ⊆ t⟩,
+    refine ⟨min (a-l) (u-a), by apply lt_min; rwa sub_pos, _⟩,
+    rintros x ⟨hx, hx'⟩,
+    apply h',
+    rw [sub_lt_comm, lt_min_iff, sub_lt_sub_iff_left] at hx,
+    rw [← sub_lt_iff_lt_add', lt_min_iff, sub_lt_sub_iff_right] at hx',
+    exact ⟨hx.1, hx'.2⟩ },
+  { rintros ⟨ε, ε_pos, h⟩,
+    exact ⟨(a-ε, a+ε), by simp [ε_pos], h⟩ },
+end⟩
+
+lemma nhds_basis_abs_sub_lt [no_min_order α] [no_max_order α] (a : α) :
+  (𝓝 a).has_basis (λ ε : α, (0 : α) < ε) (λ ε, {b | |b - a| < ε}) :=
+begin
+  convert nhds_basis_Ioo_pos a,
+  { ext ε,
+    change |x - a| < ε ↔ a - ε < x ∧ x < a + ε,
+    simp [abs_lt, sub_lt_iff_lt_add, add_comm ε a, add_comm x ε] }
+end
+
+variable (α)
+
+lemma nhds_basis_zero_abs_sub_lt [no_min_order α] [no_max_order α] :
+  (𝓝 (0 : α)).has_basis (λ ε : α, (0 : α) < ε) (λ ε, {b | |b| < ε}) :=
+by simpa using nhds_basis_abs_sub_lt (0 : α)
+
+variable {α}
+
+/-- If `a` is positive we can form a basis from only nonnegative `Ioo` intervals -/
+lemma nhds_basis_Ioo_pos_of_pos [no_min_order α] [no_max_order α]
+  {a : α} (ha : 0 < a) :
+  (𝓝 a).has_basis (λ ε : α, (0 : α) < ε ∧ ε ≤ a) (λ ε, Ioo (a-ε) (a+ε)) :=
+⟨ λ t, (nhds_basis_Ioo_pos a).mem_iff.trans
+  ⟨λ h, let ⟨i, hi, hit⟩ := h in
+    ⟨min i a, ⟨lt_min hi ha, min_le_right i a⟩, trans (Ioo_subset_Ioo
+    (sub_le_sub_left (min_le_left i a) a) (add_le_add_left (min_le_left i a) a)) hit⟩,
+  λ h, let ⟨i, hi, hit⟩ := h in ⟨i, hi.1, hit⟩ ⟩ ⟩
+
+end linear_ordered_add_comm_group
+
+lemma preimage_neg [add_group α] : preimage (has_neg.neg : α → α) = image (has_neg.neg : α → α) :=
+(image_eq_preimage_of_inverse neg_neg neg_neg).symm
+
+lemma filter.map_neg_eq_comap_neg [add_group α] :
+  map (has_neg.neg : α → α) = comap (has_neg.neg : α → α) :=
+funext $ assume f, map_eq_comap_of_inverse (funext neg_neg) (funext neg_neg)
+
+section order_topology
+
+variables [topological_space α] [topological_space β]
+  [linear_order α] [linear_order β] [order_topology α] [order_topology β]
+
+lemma is_lub.frequently_mem {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
+  ∃ᶠ x in 𝓝[≤] a, x ∈ s :=
+begin
+  rcases hs with ⟨a', ha'⟩,
+  intro h,
+  rcases (ha.1 ha').eq_or_lt with (rfl|ha'a),
+  { exact h.self_of_nhds_within le_rfl ha' },
+  { rcases (mem_nhds_within_Iic_iff_exists_Ioc_subset' ha'a).1 h
+      with ⟨b, hba, hb⟩,
+    rcases ha.exists_between hba with ⟨b', hb's, hb'⟩,
+    exact hb hb' hb's },
+end
+
+lemma is_lub.frequently_nhds_mem {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
+  ∃ᶠ x in 𝓝 a, x ∈ s :=
+(ha.frequently_mem hs).filter_mono inf_le_left
+
+lemma is_glb.frequently_mem {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty) :
+  ∃ᶠ x in 𝓝[≥] a, x ∈ s :=
+@is_lub.frequently_mem αᵒᵈ _ _ _ _ _ ha hs
+
+lemma is_glb.frequently_nhds_mem {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty) :
+  ∃ᶠ x in 𝓝 a, x ∈ s :=
+(ha.frequently_mem hs).filter_mono inf_le_left
+
+lemma is_lub.mem_closure {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
+  a ∈ closure s :=
+(ha.frequently_nhds_mem hs).mem_closure
+
+lemma is_glb.mem_closure {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty) :
+  a ∈ closure s :=
+(ha.frequently_nhds_mem hs).mem_closure
+
+lemma is_lub.nhds_within_ne_bot {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty) :
+  ne_bot (𝓝[s] a) :=
+mem_closure_iff_nhds_within_ne_bot.1 (ha.mem_closure hs)
+
+lemma is_glb.nhds_within_ne_bot : ∀ {a : α} {s : set α}, is_glb s a → s.nonempty →
+  ne_bot (𝓝[s] a) :=
+@is_lub.nhds_within_ne_bot αᵒᵈ _ _ _
+
+lemma is_lub_of_mem_nhds {s : set α} {a : α} {f : filter α}
+  (hsa : a ∈ upper_bounds s) (hsf : s ∈ f) [ne_bot (f ⊓ 𝓝 a)] : is_lub s a :=
+⟨hsa, assume b hb,
+  not_lt.1 $ assume hba,
+  have s ∩ {a | b < a} ∈ f ⊓ 𝓝 a,
+    from inter_mem_inf hsf (is_open.mem_nhds (is_open_lt' _) hba),
+  let ⟨x, ⟨hxs, hxb⟩⟩ := filter.nonempty_of_mem this in
+  have b < b, from lt_of_lt_of_le hxb $ hb hxs,
+  lt_irrefl b this⟩
+
+lemma is_lub_of_mem_closure {s : set α} {a : α} (hsa : a ∈ upper_bounds s) (hsf : a ∈ closure s) :
+  is_lub s a :=
+begin
+  rw [mem_closure_iff_cluster_pt, cluster_pt, inf_comm] at hsf,
+  haveI : (𝓟 s ⊓ 𝓝 a).ne_bot := hsf,
+  exact is_lub_of_mem_nhds hsa (mem_principal_self s),
+end
+
+lemma is_glb_of_mem_nhds : ∀ {s : set α} {a : α} {f : filter α},
+  a ∈ lower_bounds s → s ∈ f → ne_bot (f ⊓ 𝓝 a) → is_glb s a :=
+@is_lub_of_mem_nhds αᵒᵈ _ _ _
+
+lemma is_glb_of_mem_closure {s : set α} {a : α} (hsa : a ∈ lower_bounds s) (hsf : a ∈ closure s) :
+  is_glb s a :=
+@is_lub_of_mem_closure αᵒᵈ _ _ _ s a hsa hsf
+
+lemma is_lub.mem_upper_bounds_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
+  (hf : monotone_on f s) (ha : is_lub s a)
+  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ upper_bounds (f '' s) :=
+begin
+  rintro _ ⟨x, hx, rfl⟩,
+  replace ha := ha.inter_Ici_of_mem hx,
+  haveI := ha.nhds_within_ne_bot ⟨x, hx, le_rfl⟩,
+  refine ge_of_tendsto (hb.mono_left (nhds_within_mono _ (inter_subset_left s (Ici x)))) _,
+  exact mem_of_superset self_mem_nhds_within (λ y hy, hf hx hy.1 hy.2)
+end
+
+-- For a version of this theorem in which the convergence considered on the domain `α` is as `x : α`
+-- tends to infinity, rather than tending to a point `x` in `α`, see `is_lub_of_tendsto_at_top`
+lemma is_lub.is_lub_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
+  (hf : monotone_on f s) (ha : is_lub s a) (hs : s.nonempty)
+  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : is_lub (f '' s) b :=
+begin
+  haveI := ha.nhds_within_ne_bot hs,
+  exact ⟨ha.mem_upper_bounds_of_tendsto hf hb, λ b' hb', le_of_tendsto hb
+    (mem_of_superset self_mem_nhds_within $ λ x hx, hb' $ mem_image_of_mem _ hx)⟩
+end
+
+lemma is_glb.mem_lower_bounds_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
+  (hf : monotone_on f s) (ha : is_glb s a)
+  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ lower_bounds (f '' s) :=
+@is_lub.mem_upper_bounds_of_tendsto αᵒᵈ γᵒᵈ _ _ _ _ _ _ _ _ _ _ hf.dual ha hb
+
+-- For a version of this theorem in which the convergence considered on the domain `α` is as
+-- `x : α` tends to negative infinity, rather than tending to a point `x` in `α`, see
+-- `is_glb_of_tendsto_at_bot`
+lemma is_glb.is_glb_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
+  (hf : monotone_on f s) : is_glb s a → s.nonempty →
+  tendsto f (𝓝[s] a) (𝓝 b) → is_glb (f '' s) b :=
+@is_lub.is_lub_of_tendsto αᵒᵈ γᵒᵈ _ _ _ _ _ _ f s a b hf.dual
+
+lemma is_lub.mem_lower_bounds_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
+  (hf : antitone_on f s) (ha : is_lub s a)
+  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ lower_bounds (f '' s) :=
+@is_lub.mem_upper_bounds_of_tendsto α γᵒᵈ _ _ _ _ _ _ _ _ _ _ hf ha hb
+
+lemma is_lub.is_glb_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] : ∀ {f : α → γ} {s : set α} {a : α} {b : γ},
+  (antitone_on f s) → is_lub s a → s.nonempty →
+  tendsto f (𝓝[s] a) (𝓝 b) → is_glb (f '' s) b :=
+@is_lub.is_lub_of_tendsto α γᵒᵈ _ _ _ _ _ _
+
+lemma is_glb.mem_upper_bounds_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] {f : α → γ} {s : set α} {a : α} {b : γ}
+  (hf : antitone_on f s) (ha : is_glb s a)
+  (hb : tendsto f (𝓝[s] a) (𝓝 b)) : b ∈ upper_bounds (f '' s) :=
+@is_glb.mem_lower_bounds_of_tendsto α γᵒᵈ _ _ _ _ _ _ _ _ _ _ hf ha hb
+
+lemma is_glb.is_lub_of_tendsto [preorder γ] [topological_space γ]
+  [order_closed_topology γ] : ∀ {f : α → γ} {s : set α} {a : α} {b : γ},
+  (antitone_on f s) → is_glb s a → s.nonempty →
+  tendsto f (𝓝[s] a) (𝓝 b) → is_lub (f '' s) b :=
+@is_glb.is_glb_of_tendsto α γᵒᵈ _ _ _ _ _ _
+
+lemma is_lub.mem_of_is_closed {a : α} {s : set α} (ha : is_lub s a) (hs : s.nonempty)
+  (sc : is_closed s) : a ∈ s :=
+sc.closure_subset $ ha.mem_closure hs
+
+alias is_lub.mem_of_is_closed ← is_closed.is_lub_mem
+
+lemma is_glb.mem_of_is_closed {a : α} {s : set α} (ha : is_glb s a) (hs : s.nonempty)
+  (sc : is_closed s) : a ∈ s :=
+sc.closure_subset $ ha.mem_closure hs
+
+alias is_glb.mem_of_is_closed ← is_closed.is_glb_mem
+
+/-!
+### Existence of sequences tending to Inf or Sup of a given set
+-/
+
+lemma is_lub.exists_seq_strict_mono_tendsto_of_not_mem {t : set α} {x : α}
+  [is_countably_generated (𝓝 x)] (htx : is_lub t x) (not_mem : x ∉ t) (ht : t.nonempty) :
+  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n < x) ∧ tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
+begin
+  rcases ht with ⟨l, hl⟩,
+  have hl : l < x,
+   from (htx.1 hl).eq_or_lt.resolve_left (λ h,  (not_mem $ h ▸ hl).elim),
+  obtain ⟨s, hs⟩ : ∃ s : ℕ → set α, (𝓝 x).has_basis (λ (_x : ℕ), true) s :=
+    let ⟨s, hs⟩ := (𝓝 x).exists_antitone_basis in ⟨s, hs.to_has_basis⟩,
+  have : ∀ n k, k < x → ∃ y, Icc y x ⊆ s n ∧ k < y ∧ y < x ∧ y ∈ t,
+  { assume n k hk,
+    obtain ⟨L, hL, h⟩ : ∃ (L : α) (hL : L ∈ Ico k x), Ioc L x ⊆ s n :=
+      exists_Ioc_subset_of_mem_nhds' (hs.mem_of_mem trivial) hk,
+    obtain ⟨y, hy⟩ : ∃ (y : α), L < y ∧ y < x ∧ y ∈ t,
+    { rcases htx.exists_between' not_mem hL.2 with ⟨y, yt, hy⟩,
+      refine ⟨y, hy.1, hy.2, yt⟩ },
+    exact ⟨y, λ z hz, h ⟨hy.1.trans_le hz.1, hz.2⟩, hL.1.trans_lt hy.1, hy.2⟩ },
+  choose! f hf using this,
+  let u : ℕ → α := λ n, nat.rec_on n (f 0 l) (λ n h, f n.succ h),
+  have I : ∀ n, u n < x,
+  { assume n,
+    induction n with n IH,
+    { exact (hf 0 l hl).2.2.1 },
+    { exact (hf n.succ _ IH).2.2.1 } },
+  have S : strict_mono u := strict_mono_nat_of_lt_succ (λ n, (hf n.succ _ (I n)).2.1),
+  refine ⟨u, S, I, hs.tendsto_right_iff.2 (λ n _, _), (λ n, _)⟩,
+  { simp only [ge_iff_le, eventually_at_top],
+    refine ⟨n, λ p hp, _⟩,
+    have up : u p ∈ Icc (u n) x := ⟨S.monotone hp, (I p).le⟩,
+    have : Icc (u n) x ⊆ s n,
+      by { cases n, { exact (hf 0 l hl).1 }, { exact (hf n.succ (u n) (I n)).1 } },
+    exact this up },
+  { cases n,
+    { exact (hf 0 l hl).2.2.2 },
+    { exact (hf n.succ _ (I n)).2.2.2 } }
+end
+
+lemma is_lub.exists_seq_monotone_tendsto {t : set α} {x : α} [is_countably_generated (𝓝 x)]
+  (htx : is_lub t x) (ht : t.nonempty) :
+  ∃ u : ℕ → α, monotone u ∧ (∀ n, u n ≤ x) ∧ tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
+begin
+  by_cases h : x ∈ t,
+  { exact ⟨λ n, x, monotone_const, λ n, le_rfl, tendsto_const_nhds, λ n, h⟩ },
+  { rcases htx.exists_seq_strict_mono_tendsto_of_not_mem h ht  with ⟨u, hu⟩,
+    exact ⟨u, hu.1.monotone, λ n, (hu.2.1 n).le, hu.2.2⟩ }
+end
+
+lemma exists_seq_strict_mono_tendsto' {α : Type*} [linear_order α] [topological_space α]
+  [densely_ordered α] [order_topology α]
+  [first_countable_topology α] {x y : α} (hy : y < x) :
+  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n ∈ Ioo y x) ∧ tendsto u at_top (𝓝 x) :=
+begin
+  have hx : x ∉ Ioo y x := λ h, (lt_irrefl x h.2).elim,
+  have ht : set.nonempty (Ioo y x) := nonempty_Ioo.2 hy,
+  rcases (is_lub_Ioo hy).exists_seq_strict_mono_tendsto_of_not_mem hx ht with ⟨u, hu⟩,
+  exact ⟨u, hu.1, hu.2.2.symm⟩
+end
+
+lemma exists_seq_strict_mono_tendsto [densely_ordered α] [no_min_order α]
+  [first_countable_topology α] (x : α) :
+  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n < x) ∧ tendsto u at_top (𝓝 x) :=
+begin
+  obtain ⟨y, hy⟩ : ∃ y, y < x := exists_lt x,
+  rcases exists_seq_strict_mono_tendsto' hy with ⟨u, hu_mono, hu_mem, hux⟩,
+  exact ⟨u, hu_mono, λ n, (hu_mem n).2, hux⟩
+end
+
+lemma exists_seq_strict_mono_tendsto_nhds_within [densely_ordered α] [no_min_order α]
+  [first_countable_topology α] (x : α) :
+  ∃ u : ℕ → α, strict_mono u ∧ (∀ n, u n < x) ∧ tendsto u at_top (𝓝[<] x) :=
+let ⟨u, hu, hx, h⟩ := exists_seq_strict_mono_tendsto x in ⟨u, hu, hx,
+  tendsto_nhds_within_mono_right (range_subset_iff.2 hx) $ tendsto_nhds_within_range.2 h⟩
+
+lemma exists_seq_tendsto_Sup {α : Type*} [conditionally_complete_linear_order α]
+  [topological_space α] [order_topology α] [first_countable_topology α]
+  {S : set α} (hS : S.nonempty) (hS' : bdd_above S) :
+  ∃ (u : ℕ → α), monotone u ∧ tendsto u at_top (𝓝 (Sup S)) ∧ (∀ n, u n ∈ S) :=
+begin
+  rcases (is_lub_cSup hS hS').exists_seq_monotone_tendsto hS with ⟨u, hu⟩,
+  exact ⟨u, hu.1, hu.2.2⟩,
+end
+
+lemma is_glb.exists_seq_strict_anti_tendsto_of_not_mem {t : set α} {x : α}
+  [is_countably_generated (𝓝 x)] (htx : is_glb t x) (not_mem : x ∉ t) (ht : t.nonempty) :
+  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, x < u n) ∧
+                        tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
+@is_lub.exists_seq_strict_mono_tendsto_of_not_mem αᵒᵈ _ _ _ t x _ htx not_mem ht
+
+lemma is_glb.exists_seq_antitone_tendsto {t : set α} {x : α} [is_countably_generated (𝓝 x)]
+  (htx : is_glb t x) (ht : t.nonempty) :
+  ∃ u : ℕ → α, antitone u ∧ (∀ n, x ≤ u n) ∧
+                        tendsto u at_top (𝓝 x) ∧ (∀ n, u n ∈ t) :=
+@is_lub.exists_seq_monotone_tendsto αᵒᵈ _ _ _ t x _ htx ht
+
+lemma exists_seq_strict_anti_tendsto' [densely_ordered α]
+  [first_countable_topology α] {x y : α} (hy : x < y) :
+  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, u n ∈ Ioo x y) ∧ tendsto u at_top (𝓝 x) :=
+by simpa only [dual_Ioo] using exists_seq_strict_mono_tendsto' (order_dual.to_dual_lt_to_dual.2 hy)
+
+lemma exists_seq_strict_anti_tendsto [densely_ordered α] [no_max_order α]
+  [first_countable_topology α] (x : α) :
+  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, x < u n) ∧ tendsto u at_top (𝓝 x) :=
+@exists_seq_strict_mono_tendsto αᵒᵈ _ _ _ _ _ _ x
+
+lemma exists_seq_strict_anti_tendsto_nhds_within [densely_ordered α] [no_max_order α]
+  [first_countable_topology α] (x : α) :
+  ∃ u : ℕ → α, strict_anti u ∧ (∀ n, x < u n) ∧ tendsto u at_top (𝓝[>] x) :=
+@exists_seq_strict_mono_tendsto_nhds_within αᵒᵈ _ _ _ _ _ _ _
+
+lemma exists_seq_strict_anti_strict_mono_tendsto [densely_ordered α] [first_countable_topology α]
+  {x y : α} (h : x < y) :
+  ∃ (u v : ℕ → α), strict_anti u ∧ strict_mono v ∧ (∀ k, u k ∈ Ioo x y) ∧ (∀ l, v l ∈ Ioo x y) ∧
+    (∀ k l, u k < v l) ∧ tendsto u at_top (𝓝 x) ∧ tendsto v at_top (𝓝 y) :=
+begin
+  rcases exists_seq_strict_anti_tendsto' h with ⟨u, hu_anti, hu_mem, hux⟩,
+  rcases exists_seq_strict_mono_tendsto' (hu_mem 0).2 with ⟨v, hv_mono, hv_mem, hvy⟩,
+  exact ⟨u, v, hu_anti, hv_mono, hu_mem, λ l, ⟨(hu_mem 0).1.trans (hv_mem l).1, (hv_mem l).2⟩,
+    λ k l, (hu_anti.antitone (zero_le k)).trans_lt (hv_mem l).1, hux, hvy⟩
+end
+
+lemma exists_seq_tendsto_Inf {α : Type*} [conditionally_complete_linear_order α]
+  [topological_space α] [order_topology α] [first_countable_topology α]
+  {S : set α} (hS : S.nonempty) (hS' : bdd_below S) :
+  ∃ (u : ℕ → α), antitone u ∧ tendsto u at_top (𝓝 (Inf S)) ∧ (∀ n, u n ∈ S) :=
+@exists_seq_tendsto_Sup αᵒᵈ _ _ _ _ S hS hS'
+
+end order_topology
+
+section densely_ordered
+
+variables [topological_space α] [linear_order α] [order_topology α] [densely_ordered α]
+{a b : α} {s : set α}
+
+/-- The closure of the interval `(a, +∞)` is the closed interval `[a, +∞)`, unless `a` is a top
+element. -/
+lemma closure_Ioi' {a : α} (h : (Ioi a).nonempty) :
+  closure (Ioi a) = Ici a :=
+begin
+  apply subset.antisymm,
+  { exact closure_minimal Ioi_subset_Ici_self is_closed_Ici },
+  { rw [← diff_subset_closure_iff, Ici_diff_Ioi_same, singleton_subset_iff],
+    exact is_glb_Ioi.mem_closure h }
+end
+
+/-- The closure of the interval `(a, +∞)` is the closed interval `[a, +∞)`. -/
+@[simp] lemma closure_Ioi (a : α) [no_max_order α] :
+  closure (Ioi a) = Ici a :=
+closure_Ioi' nonempty_Ioi
+
+/-- The closure of the interval `(-∞, a)` is the closed interval `(-∞, a]`, unless `a` is a bottom
+element. -/
+lemma closure_Iio' (h : (Iio a).nonempty) : closure (Iio a) = Iic a := @closure_Ioi' αᵒᵈ _ _ _ _ _ h
+
+/-- The closure of the interval `(-∞, a)` is the interval `(-∞, a]`. -/
+@[simp] lemma closure_Iio (a : α) [no_min_order α] :
+  closure (Iio a) = Iic a :=
+closure_Iio' nonempty_Iio
+
+/-- The closure of the open interval `(a, b)` is the closed interval `[a, b]`. -/
+@[simp] lemma closure_Ioo {a b : α} (hab : a ≠ b) :
+  closure (Ioo a b) = Icc a b :=
+begin
+  apply subset.antisymm,
+  { exact closure_minimal Ioo_subset_Icc_self is_closed_Icc },
+  { cases hab.lt_or_lt with hab hab,
+    { rw [← diff_subset_closure_iff, Icc_diff_Ioo_same hab.le],
+      have hab' : (Ioo a b).nonempty, from nonempty_Ioo.2 hab,
+      simp only [insert_subset, singleton_subset_iff],
+      exact ⟨(is_glb_Ioo hab).mem_closure hab', (is_lub_Ioo hab).mem_closure hab'⟩ },
+    { rw Icc_eq_empty_of_lt hab, exact empty_subset _ } }
+end
+
+/-- The closure of the interval `(a, b]` is the closed interval `[a, b]`. -/
+@[simp] lemma closure_Ioc {a b : α} (hab : a ≠ b) :
+  closure (Ioc a b) = Icc a b :=
+begin
+  apply subset.antisymm,
+  { exact closure_minimal Ioc_subset_Icc_self is_closed_Icc },
+  { apply subset.trans _ (closure_mono Ioo_subset_Ioc_self),
+    rw closure_Ioo hab }
+end
+
+/-- The closure of the interval `[a, b)` is the closed interval `[a, b]`. -/
+@[simp] lemma closure_Ico {a b : α} (hab : a ≠ b) :
+  closure (Ico a b) = Icc a b :=
+begin
+  apply subset.antisymm,
+  { exact closure_minimal Ico_subset_Icc_self is_closed_Icc },
+  { apply subset.trans _ (closure_mono Ioo_subset_Ico_self),
+    rw closure_Ioo hab }
+end
+
+@[simp] lemma interior_Ici' {a : α} (ha : (Iio a).nonempty) : interior (Ici a) = Ioi a :=
+by rw [← compl_Iio, interior_compl, closure_Iio' ha, compl_Iic]
+
+lemma interior_Ici [no_min_order α] {a : α} : interior (Ici a) = Ioi a :=
+interior_Ici' nonempty_Iio
+
+@[simp] lemma interior_Iic' {a : α} (ha : (Ioi a).nonempty) : interior (Iic a) = Iio a :=
+@interior_Ici' αᵒᵈ _ _ _ _ _ ha
+
+lemma interior_Iic [no_max_order α] {a : α} : interior (Iic a) = Iio a :=
+interior_Iic' nonempty_Ioi
+
+@[simp] lemma interior_Icc [no_min_order α] [no_max_order α] {a b : α}:
+  interior (Icc a b) = Ioo a b :=
+by rw [← Ici_inter_Iic, interior_inter, interior_Ici, interior_Iic, Ioi_inter_Iio]
+
+@[simp] lemma interior_Ico [no_min_order α] {a b : α} : interior (Ico a b) = Ioo a b :=
+by rw [← Ici_inter_Iio, interior_inter, interior_Ici, interior_Iio, Ioi_inter_Iio]
+
+@[simp] lemma interior_Ioc [no_max_order α] {a b : α} : interior (Ioc a b) = Ioo a b :=
+by rw [← Ioi_inter_Iic, interior_inter, interior_Ioi, interior_Iic, Ioi_inter_Iio]
+
+lemma closure_interior_Icc {a b : α} (h : a ≠ b) : closure (interior (Icc a b)) = Icc a b :=
+(closure_minimal interior_subset is_closed_Icc).antisymm $
+calc Icc a b = closure (Ioo a b) : (closure_Ioo h).symm
+... ⊆ closure (interior (Icc a b)) : closure_mono (interior_maximal Ioo_subset_Icc_self is_open_Ioo)
+
+lemma Ioc_subset_closure_interior (a b : α) : Ioc a b ⊆ closure (interior (Ioc a b)) :=
+begin
+  rcases eq_or_ne a b with rfl|h,
+  { simp },
+  { calc Ioc a b ⊆ Icc a b : Ioc_subset_Icc_self
+    ... = closure (Ioo a b) : (closure_Ioo h).symm
+    ... ⊆ closure (interior (Ioc a b)) :
+      closure_mono (interior_maximal Ioo_subset_Ioc_self is_open_Ioo) }
+end
+
+lemma Ico_subset_closure_interior (a b : α) : Ico a b ⊆ closure (interior (Ico a b)) :=
+by simpa only [dual_Ioc]
+  using Ioc_subset_closure_interior (order_dual.to_dual b) (order_dual.to_dual a)
+
+@[simp] lemma frontier_Ici' {a : α} (ha : (Iio a).nonempty) : frontier (Ici a) = {a} :=
+by simp [frontier, ha]
+
+lemma frontier_Ici [no_min_order α] {a : α} : frontier (Ici a) = {a} :=
+frontier_Ici' nonempty_Iio
+
+@[simp] lemma frontier_Iic' {a : α} (ha : (Ioi a).nonempty) : frontier (Iic a) = {a} :=
+by simp [frontier, ha]
+
+lemma frontier_Iic [no_max_order α] {a : α} : frontier (Iic a) = {a} :=
+frontier_Iic' nonempty_Ioi
+
+@[simp] lemma frontier_Ioi' {a : α} (ha : (Ioi a).nonempty) : frontier (Ioi a) = {a} :=
+by simp [frontier, closure_Ioi' ha, Iic_diff_Iio, Icc_self]
+
+lemma frontier_Ioi [no_max_order α] {a : α} : frontier (Ioi a) = {a} :=
+frontier_Ioi' nonempty_Ioi
+
+@[simp] lemma frontier_Iio' {a : α} (ha : (Iio a).nonempty) : frontier (Iio a) = {a} :=
+by simp [frontier, closure_Iio' ha, Iic_diff_Iio, Icc_self]
+
+lemma frontier_Iio [no_min_order α] {a : α} : frontier (Iio a) = {a} :=
+frontier_Iio' nonempty_Iio
+
+@[simp] lemma frontier_Icc [no_min_order α] [no_max_order α] {a b : α} (h : a ≤ b) :
+  frontier (Icc a b) = {a, b} :=
+by simp [frontier, h, Icc_diff_Ioo_same]
+
+@[simp] lemma frontier_Ioo {a b : α} (h : a < b) : frontier (Ioo a b) = {a, b} :=
+by rw [frontier, closure_Ioo h.ne, interior_Ioo, Icc_diff_Ioo_same h.le]
+
+@[simp] lemma frontier_Ico [no_min_order α] {a b : α} (h : a < b) : frontier (Ico a b) = {a, b} :=
+by rw [frontier, closure_Ico h.ne, interior_Ico, Icc_diff_Ioo_same h.le]
+
+@[simp] lemma frontier_Ioc [no_max_order α] {a b : α} (h : a < b) : frontier (Ioc a b) = {a, b} :=
+by rw [frontier, closure_Ioc h.ne, interior_Ioc, Icc_diff_Ioo_same h.le]
+
+lemma nhds_within_Ioi_ne_bot' {a b : α} (H₁ : (Ioi a).nonempty) (H₂ : a ≤ b) :
+  ne_bot (𝓝[Ioi a] b) :=
+mem_closure_iff_nhds_within_ne_bot.1 $ by rwa [closure_Ioi' H₁]
+
+lemma nhds_within_Ioi_ne_bot [no_max_order α] {a b : α} (H : a ≤ b) :
+  ne_bot (𝓝[Ioi a] b) :=
+nhds_within_Ioi_ne_bot' nonempty_Ioi H
+
+lemma nhds_within_Ioi_self_ne_bot' {a : α} (H : (Ioi a).nonempty) :
+  ne_bot (𝓝[>] a) :=
+nhds_within_Ioi_ne_bot' H (le_refl a)
+
+@[instance]
+lemma nhds_within_Ioi_self_ne_bot [no_max_order α] (a : α) :
+  ne_bot (𝓝[>] a) :=
+nhds_within_Ioi_ne_bot (le_refl a)
+
+lemma filter.eventually.exists_gt [no_max_order α] {a : α} {p : α → Prop} (h : ∀ᶠ x in 𝓝 a, p x) :
+  ∃ b > a, p b :=
+by simpa only [exists_prop, gt_iff_lt, and_comm]
+  using ((h.filter_mono (@nhds_within_le_nhds _ _ a (Ioi a))).and self_mem_nhds_within).exists
+
+lemma nhds_within_Iio_ne_bot' {b c : α} (H₁ : (Iio c).nonempty) (H₂ : b ≤ c) :
+  ne_bot (𝓝[Iio c] b) :=
+mem_closure_iff_nhds_within_ne_bot.1 $ by rwa closure_Iio' H₁
+
+lemma nhds_within_Iio_ne_bot [no_min_order α] {a b : α} (H : a ≤ b) :
+  ne_bot (𝓝[Iio b] a) :=
+nhds_within_Iio_ne_bot' nonempty_Iio H
+
+lemma nhds_within_Iio_self_ne_bot' {b : α} (H : (Iio b).nonempty) :
+  ne_bot (𝓝[<] b) :=
+nhds_within_Iio_ne_bot' H (le_refl b)
+
+@[instance]
+lemma nhds_within_Iio_self_ne_bot [no_min_order α] (a : α) :
+  ne_bot (𝓝[<] a) :=
+nhds_within_Iio_ne_bot (le_refl a)
+
+lemma filter.eventually.exists_lt [no_min_order α] {a : α} {p : α → Prop} (h : ∀ᶠ x in 𝓝 a, p x) :
+  ∃ b < a, p b :=
+@filter.eventually.exists_gt αᵒᵈ _ _ _ _ _ _ _ h
+
+lemma right_nhds_within_Ico_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ico a b] b) :=
+(is_lub_Ico H).nhds_within_ne_bot (nonempty_Ico.2 H)
+
+lemma left_nhds_within_Ioc_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ioc a b] a) :=
+(is_glb_Ioc H).nhds_within_ne_bot (nonempty_Ioc.2 H)
+
+lemma left_nhds_within_Ioo_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ioo a b] a) :=
+(is_glb_Ioo H).nhds_within_ne_bot (nonempty_Ioo.2 H)
+
+lemma right_nhds_within_Ioo_ne_bot {a b : α} (H : a < b) : ne_bot (𝓝[Ioo a b] b) :=
+(is_lub_Ioo H).nhds_within_ne_bot (nonempty_Ioo.2 H)
+
+lemma comap_coe_nhds_within_Iio_of_Ioo_subset (hb : s ⊆ Iio b)
+  (hs : s.nonempty → ∃ a < b, Ioo a b ⊆ s) :
+  comap (coe : s → α) (𝓝[<] b) = at_top :=
+begin
+  nontriviality,
+  haveI : nonempty s := nontrivial_iff_nonempty.1 ‹_›,
+  rcases hs (nonempty_subtype.1 ‹_›) with ⟨a, h, hs⟩,
+  ext u, split,
+  { rintros ⟨t, ht, hts⟩,
+    obtain ⟨x, ⟨hxa : a ≤ x, hxb : x < b⟩, hxt : Ioo x b ⊆ t⟩ :=
+      (mem_nhds_within_Iio_iff_exists_mem_Ico_Ioo_subset h).mp ht,
+    obtain ⟨y, hxy, hyb⟩ := exists_between hxb,
+    refine mem_of_superset (mem_at_top ⟨y, hs ⟨hxa.trans_lt hxy, hyb⟩⟩) _,
+    rintros ⟨z, hzs⟩ (hyz : y ≤ z),
+    refine hts (hxt ⟨hxy.trans_le _, hb _⟩); assumption },
+  { intros hu,
+    obtain ⟨x : s, hx : ∀ z, x ≤ z → z ∈ u⟩ := mem_at_top_sets.1 hu,
+    exact ⟨Ioo x b, Ioo_mem_nhds_within_Iio (right_mem_Ioc.2 $ hb x.2), λ z hz, hx _ hz.1.le⟩ }
+end
+
+lemma comap_coe_nhds_within_Ioi_of_Ioo_subset (ha : s ⊆ Ioi a)
+  (hs : s.nonempty → ∃ b > a, Ioo a b ⊆ s) :
+  comap (coe : s → α) (𝓝[>] a) = at_bot :=
+comap_coe_nhds_within_Iio_of_Ioo_subset
+  (show of_dual ⁻¹' s ⊆ Iio (to_dual a), from ha)
+  (λ h, by simpa only [order_dual.exists, dual_Ioo] using hs h)
+
+lemma map_coe_at_top_of_Ioo_subset (hb : s ⊆ Iio b)
+  (hs : ∀ a' < b, ∃ a < b, Ioo a b ⊆ s) :
+  map (coe : s → α) at_top = 𝓝[<] b :=
+begin
+  rcases eq_empty_or_nonempty (Iio b) with (hb'|⟨a, ha⟩),
+  { rw [filter_eq_bot_of_is_empty at_top, filter.map_bot, hb', nhds_within_empty],
+    exact ⟨λ x, hb'.subset (hb x.2)⟩ },
+  { rw [← comap_coe_nhds_within_Iio_of_Ioo_subset hb (λ _, hs a ha), map_comap_of_mem],
+    rw subtype.range_coe,
+    exact (mem_nhds_within_Iio_iff_exists_Ioo_subset' ha).2 (hs a ha) },
+end
+
+lemma map_coe_at_bot_of_Ioo_subset (ha : s ⊆ Ioi a)
+  (hs : ∀ b' > a, ∃ b > a, Ioo a b ⊆ s) :
+  map (coe : s → α) at_bot = (𝓝[>] a) :=
+begin
+  -- the elaborator gets stuck without `(... : _)`
+  refine (map_coe_at_top_of_Ioo_subset
+    (show of_dual ⁻¹' s ⊆ Iio (to_dual a), from ha) (λ b' hb', _) : _),
+  simpa only [order_dual.exists, dual_Ioo] using hs b' hb',
+end
+
+/-- The `at_top` filter for an open interval `Ioo a b` comes from the left-neighbourhoods filter at
+the right endpoint in the ambient order. -/
+lemma comap_coe_Ioo_nhds_within_Iio (a b : α) :
+  comap (coe : Ioo a b → α) (𝓝[<] b) = at_top :=
+comap_coe_nhds_within_Iio_of_Ioo_subset Ioo_subset_Iio_self $
+  λ h, ⟨a, nonempty_Ioo.1 h, subset.refl _⟩
+
+/-- The `at_bot` filter for an open interval `Ioo a b` comes from the right-neighbourhoods filter at
+the left endpoint in the ambient order. -/
+lemma comap_coe_Ioo_nhds_within_Ioi (a b : α) :
+  comap (coe : Ioo a b → α) (𝓝[>] a) = at_bot :=
+comap_coe_nhds_within_Ioi_of_Ioo_subset Ioo_subset_Ioi_self $
+  λ h, ⟨b, nonempty_Ioo.1 h, subset.refl _⟩
+
+lemma comap_coe_Ioi_nhds_within_Ioi (a : α) : comap (coe : Ioi a → α) (𝓝[>] a) = at_bot :=
+comap_coe_nhds_within_Ioi_of_Ioo_subset (subset.refl _) $
+  λ ⟨x, hx⟩, ⟨x, hx, Ioo_subset_Ioi_self⟩
+
+lemma comap_coe_Iio_nhds_within_Iio (a : α) :
+  comap (coe : Iio a → α) (𝓝[<] a) = at_top :=
+@comap_coe_Ioi_nhds_within_Ioi αᵒᵈ _ _ _ _ a
+
+@[simp] lemma map_coe_Ioo_at_top {a b : α} (h : a < b) :
+  map (coe : Ioo a b → α) at_top = 𝓝[<] b :=
+map_coe_at_top_of_Ioo_subset Ioo_subset_Iio_self $ λ _ _, ⟨_, h, subset.refl _⟩
+
+@[simp] lemma map_coe_Ioo_at_bot {a b : α} (h : a < b) :
+  map (coe : Ioo a b → α) at_bot = 𝓝[>] a :=
+map_coe_at_bot_of_Ioo_subset Ioo_subset_Ioi_self $ λ _ _, ⟨_, h, subset.refl _⟩
+
+@[simp] lemma map_coe_Ioi_at_bot (a : α) :
+  map (coe : Ioi a → α) at_bot = 𝓝[>] a :=
+map_coe_at_bot_of_Ioo_subset (subset.refl _) $ λ b hb, ⟨b, hb, Ioo_subset_Ioi_self⟩
+
+@[simp] lemma map_coe_Iio_at_top (a : α) :
+  map (coe : Iio a → α) at_top = 𝓝[<] a :=
+@map_coe_Ioi_at_bot αᵒᵈ _ _ _ _ _
+
+variables {l : filter β} {f : α → β}
+
+@[simp] lemma tendsto_comp_coe_Ioo_at_top (h : a < b) :
+  tendsto (λ x : Ioo a b, f x) at_top l ↔ tendsto f (𝓝[<] b) l :=
+by rw [← map_coe_Ioo_at_top h, tendsto_map'_iff]
+
+@[simp] lemma tendsto_comp_coe_Ioo_at_bot (h : a < b) :
+  tendsto (λ x : Ioo a b, f x) at_bot l ↔ tendsto f (𝓝[>] a) l :=
+by rw [← map_coe_Ioo_at_bot h, tendsto_map'_iff]
+
+@[simp] lemma tendsto_comp_coe_Ioi_at_bot :
+  tendsto (λ x : Ioi a, f x) at_bot l ↔ tendsto f (𝓝[>] a) l :=
+by rw [← map_coe_Ioi_at_bot, tendsto_map'_iff]
+
+@[simp] lemma tendsto_comp_coe_Iio_at_top :
+  tendsto (λ x : Iio a, f x) at_top l ↔ tendsto f (𝓝[<] a) l :=
+by rw [← map_coe_Iio_at_top, tendsto_map'_iff]
+
+@[simp] lemma tendsto_Ioo_at_top {f : β → Ioo a b} :
+  tendsto f l at_top ↔ tendsto (λ x, (f x : α)) l (𝓝[<] b) :=
+by rw [← comap_coe_Ioo_nhds_within_Iio, tendsto_comap_iff]
+
+@[simp] lemma tendsto_Ioo_at_bot {f : β → Ioo a b} :
+  tendsto f l at_bot ↔ tendsto (λ x, (f x : α)) l (𝓝[>] a) :=
+by rw [← comap_coe_Ioo_nhds_within_Ioi, tendsto_comap_iff]
+
+@[simp] lemma tendsto_Ioi_at_bot {f : β → Ioi a} :
+  tendsto f l at_bot ↔ tendsto (λ x, (f x : α)) l (𝓝[>] a) :=
+by rw [← comap_coe_Ioi_nhds_within_Ioi, tendsto_comap_iff]
+
+@[simp] lemma tendsto_Iio_at_top {f : β → Iio a} :
+  tendsto f l at_top ↔ tendsto (λ x, (f x : α)) l (𝓝[<] a) :=
+by rw [← comap_coe_Iio_nhds_within_Iio, tendsto_comap_iff]
+
+instance (x : α) [nontrivial α] : ne_bot (𝓝[≠] x) :=
+begin
+  apply forall_mem_nonempty_iff_ne_bot.1 (λ s hs, _),
+  obtain ⟨u, u_open, xu, us⟩ : ∃ (u : set α), is_open u ∧ x ∈ u ∧ u ∩ {x}ᶜ ⊆ s :=
+    mem_nhds_within.1 hs,
+  obtain ⟨a, b, a_lt_b, hab⟩ : ∃ (a b : α), a < b ∧ Ioo a b ⊆ u := u_open.exists_Ioo_subset ⟨x, xu⟩,
+  obtain ⟨y, hy⟩ : ∃ y, a < y ∧ y < b := exists_between a_lt_b,
+  rcases ne_or_eq x y with xy|rfl,
+  { exact ⟨y, us ⟨hab hy, xy.symm⟩⟩ },
+  obtain ⟨z, hz⟩ : ∃ z, a < z ∧ z < x := exists_between hy.1,
+  exact ⟨z, us ⟨hab ⟨hz.1, hz.2.trans hy.2⟩, hz.2.ne⟩⟩,
+end
+
+/-- Let `s` be a dense set in a nontrivial dense linear order `α`. If `s` is a
+separable space (e.g., if `α` has a second countable topology), then there exists a countable
+dense subset `t ⊆ s` such that `t` does not contain bottom/top elements of `α`. -/
+lemma dense.exists_countable_dense_subset_no_bot_top [nontrivial α]
+  {s : set α} [separable_space s] (hs : dense s) :
+  ∃ t ⊆ s, t.countable ∧ dense t ∧ (∀ x, is_bot x → x ∉ t) ∧ (∀ x, is_top x → x ∉ t) :=
+begin
+  rcases hs.exists_countable_dense_subset with ⟨t, hts, htc, htd⟩,
+  refine ⟨t \ ({x | is_bot x} ∪ {x | is_top x}), _, _, _, _, _⟩,
+  { exact (diff_subset _ _).trans hts },
+  { exact htc.mono (diff_subset _ _) },
+  { exact htd.diff_finite ((subsingleton_is_bot α).finite.union (subsingleton_is_top α).finite) },
+  { assume x hx, simp [hx] },
+  { assume x hx, simp [hx] }
+end
+
+variable (α)
+/-- If `α` is a nontrivial separable dense linear order, then there exists a
+countable dense set `s : set α` that contains neither top nor bottom elements of `α`.
+For a dense set containing both bot and top elements, see
+`exists_countable_dense_bot_top`. -/
+lemma exists_countable_dense_no_bot_top [separable_space α] [nontrivial α] :
+  ∃ s : set α, s.countable ∧ dense s ∧ (∀ x, is_bot x → x ∉ s) ∧ (∀ x, is_top x → x ∉ s) :=
+by simpa using dense_univ.exists_countable_dense_subset_no_bot_top
+
+end densely_ordered
+
+section complete_linear_order
+
+variables [complete_linear_order α] [topological_space α] [order_topology α]
+  [complete_linear_order β] [topological_space β] [order_closed_topology β] [nonempty γ]
+
+lemma Sup_mem_closure {α : Type u} [topological_space α] [complete_linear_order α]
+  [order_topology α] {s : set α} (hs : s.nonempty) :
+  Sup s ∈ closure s :=
+(is_lub_Sup s).mem_closure hs
+
+lemma Inf_mem_closure {α : Type u} [topological_space α] [complete_linear_order α]
+  [order_topology α] {s : set α} (hs : s.nonempty) :
+  Inf s ∈ closure s :=
+(is_glb_Inf s).mem_closure hs
+
+lemma is_closed.Sup_mem {α : Type u} [topological_space α] [complete_linear_order α]
+  [order_topology α] {s : set α} (hs : s.nonempty) (hc : is_closed s) :
+  Sup s ∈ s :=
+(is_lub_Sup s).mem_of_is_closed hs hc
+
+lemma is_closed.Inf_mem {α : Type u} [topological_space α] [complete_linear_order α]
+  [order_topology α] {s : set α} (hs : s.nonempty) (hc : is_closed s) :
+  Inf s ∈ s :=
+(is_glb_Inf s).mem_of_is_closed hs hc
+
+/-- A monotone function continuous at the supremum of a nonempty set sends this supremum to
+the supremum of the image of this set. -/
+lemma monotone.map_Sup_of_continuous_at' {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
+  (Mf : monotone f) (hs : s.nonempty) :
+  f (Sup s) = Sup (f '' s) :=
+--This is a particular case of the more general is_lub.is_lub_of_tendsto
+((is_lub_Sup _).is_lub_of_tendsto (λ x hx y hy xy, Mf xy) hs $
+  Cf.mono_left inf_le_left).Sup_eq.symm
+
+/-- A monotone function `f` sending `bot` to `bot` and continuous at the supremum of a set sends
+this supremum to the supremum of the image of this set. -/
+lemma monotone.map_Sup_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
+  (Mf : monotone f) (fbot : f ⊥ = ⊥) :
+  f (Sup s) = Sup (f '' s) :=
+begin
+  cases s.eq_empty_or_nonempty with h h,
+  { simp [h, fbot] },
+  { exact Mf.map_Sup_of_continuous_at' Cf h }
+end
+
+/-- A monotone function continuous at the indexed supremum over a nonempty `Sort` sends this indexed
+supremum to the indexed supremum of the composition. -/
+lemma monotone.map_supr_of_continuous_at' {ι : Sort*} [nonempty ι] {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (supr g)) (Mf : monotone f) :
+  f (⨆ i, g i) = ⨆ i, f (g i) :=
+by rw [supr, Mf.map_Sup_of_continuous_at' Cf (range_nonempty g), ← range_comp, supr]
+
+/-- If a monotone function sending `bot` to `bot` is continuous at the indexed supremum over
+a `Sort`, then it sends this indexed supremum to the indexed supremum of the composition. -/
+lemma monotone.map_supr_of_continuous_at {ι : Sort*} {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (supr g)) (Mf : monotone f) (fbot : f ⊥ = ⊥) :
+  f (⨆ i, g i) = ⨆ i, f (g i) :=
+by rw [supr, Mf.map_Sup_of_continuous_at Cf fbot, ← range_comp, supr]
+
+/-- A monotone function continuous at the infimum of a nonempty set sends this infimum to
+the infimum of the image of this set. -/
+lemma monotone.map_Inf_of_continuous_at' {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
+  (Mf : monotone f) (hs : s.nonempty) :
+  f (Inf s) = Inf (f '' s) :=
+@monotone.map_Sup_of_continuous_at' αᵒᵈ βᵒᵈ _ _ _ _ _ _ f s Cf Mf.dual hs
+
+/-- A monotone function `f` sending `top` to `top` and continuous at the infimum of a set sends
+this infimum to the infimum of the image of this set. -/
+lemma monotone.map_Inf_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
+  (Mf : monotone f) (ftop : f ⊤ = ⊤) :
+  f (Inf s) = Inf (f '' s) :=
+@monotone.map_Sup_of_continuous_at αᵒᵈ βᵒᵈ _ _ _ _ _ _ f s Cf Mf.dual ftop
+
+/-- A monotone function continuous at the indexed infimum over a nonempty `Sort` sends this indexed
+infimum to the indexed infimum of the composition. -/
+lemma monotone.map_infi_of_continuous_at' {ι : Sort*} [nonempty ι] {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (infi g)) (Mf : monotone f) :
+  f (⨅ i, g i) = ⨅ i, f (g i) :=
+@monotone.map_supr_of_continuous_at' αᵒᵈ βᵒᵈ _ _ _ _ _ _ ι _ f g Cf Mf.dual
+
+/-- If a monotone function sending `top` to `top` is continuous at the indexed infimum over
+a `Sort`, then it sends this indexed infimum to the indexed infimum of the composition. -/
+lemma monotone.map_infi_of_continuous_at {ι : Sort*} {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (infi g)) (Mf : monotone f) (ftop : f ⊤ = ⊤) :
+  f (infi g) = infi (f ∘ g) :=
+@monotone.map_supr_of_continuous_at αᵒᵈ βᵒᵈ _ _ _ _ _ _ ι f g Cf Mf.dual ftop
+
+/-- An antitone function continuous at the supremum of a nonempty set sends this supremum to
+the infimum of the image of this set. -/
+lemma antitone.map_Sup_of_continuous_at' {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
+  (Af : antitone f) (hs : s.nonempty) :
+  f (Sup s) = Inf (f '' s) :=
+monotone.map_Sup_of_continuous_at'
+  (show continuous_at (order_dual.to_dual ∘ f) (Sup s), from Cf) Af hs
+
+/-- An antitone function `f` sending `bot` to `top` and continuous at the supremum of a set sends
+this supremum to the infimum of the image of this set. -/
+lemma antitone.map_Sup_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
+  (Af : antitone f) (fbot : f ⊥ = ⊤) :
+  f (Sup s) = Inf (f '' s) :=
+monotone.map_Sup_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (Sup s), from Cf) Af fbot
+
+/-- An antitone function continuous at the indexed supremum over a nonempty `Sort` sends this
+indexed supremum to the indexed infimum of the composition. -/
+lemma antitone.map_supr_of_continuous_at' {ι : Sort*} [nonempty ι] {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (supr g)) (Af : antitone f) :
+  f (⨆ i, g i) = ⨅ i, f (g i) :=
+monotone.map_supr_of_continuous_at'
+  (show continuous_at (order_dual.to_dual ∘ f) (supr g), from Cf) Af
+
+/-- An antitone function sending `bot` to `top` is continuous at the indexed supremum over
+a `Sort`, then it sends this indexed supremum to the indexed supremum of the composition. -/
+lemma antitone.map_supr_of_continuous_at {ι : Sort*} {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (supr g)) (Af : antitone f) (fbot : f ⊥ = ⊤) :
+  f (⨆ i, g i) = ⨅ i, f (g i) :=
+monotone.map_supr_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (supr g), from Cf) Af fbot
+
+/-- An antitone function continuous at the infimum of a nonempty set sends this infimum to
+the supremum of the image of this set. -/
+lemma antitone.map_Inf_of_continuous_at' {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
+  (Af : antitone f) (hs : s.nonempty) :
+  f (Inf s) = Sup (f '' s) :=
+monotone.map_Inf_of_continuous_at'
+  (show continuous_at (order_dual.to_dual ∘ f) (Inf s), from Cf) Af hs
+
+/-- An antitone function `f` sending `top` to `bot` and continuous at the infimum of a set sends
+this infimum to the supremum of the image of this set. -/
+lemma antitone.map_Inf_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
+  (Af : antitone f) (ftop : f ⊤ = ⊥) :
+  f (Inf s) = Sup (f '' s) :=
+monotone.map_Inf_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (Inf s), from Cf) Af ftop
+
+/-- An antitone function continuous at the indexed infimum over a nonempty `Sort` sends this indexed
+infimum to the indexed supremum of the composition. -/
+lemma antitone.map_infi_of_continuous_at' {ι : Sort*} [nonempty ι] {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (infi g)) (Af : antitone f) :
+  f (⨅ i, g i) = ⨆ i, f (g i) :=
+monotone.map_infi_of_continuous_at'
+  (show continuous_at (order_dual.to_dual ∘ f) (infi g), from Cf) Af
+
+/-- If an antitone function sending `top` to `bot` is continuous at the indexed infimum over
+a `Sort`, then it sends this indexed infimum to the indexed supremum of the composition. -/
+lemma antitone.map_infi_of_continuous_at {ι : Sort*} {f : α → β} {g : ι → α}
+  (Cf : continuous_at f (infi g)) (Af : antitone f) (ftop : f ⊤ = ⊥) :
+  f (infi g) = supr (f ∘ g) :=
+monotone.map_infi_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (infi g), from Cf) Af ftop
+
+end complete_linear_order
+
+section conditionally_complete_linear_order
+
+variables [conditionally_complete_linear_order α] [topological_space α] [order_topology α]
+  [conditionally_complete_linear_order β] [topological_space β] [order_closed_topology β]
+  [nonempty γ]
+
+lemma cSup_mem_closure {s : set α} (hs : s.nonempty) (B : bdd_above s) : Sup s ∈ closure s :=
+(is_lub_cSup hs B).mem_closure hs
+
+lemma cInf_mem_closure {s : set α} (hs : s.nonempty) (B : bdd_below s) : Inf s ∈ closure s :=
+(is_glb_cInf hs B).mem_closure hs
+
+lemma is_closed.cSup_mem {s : set α} (hc : is_closed s) (hs : s.nonempty) (B : bdd_above s) :
+  Sup s ∈ s :=
+(is_lub_cSup hs B).mem_of_is_closed hs hc
+
+lemma is_closed.cInf_mem {s : set α} (hc : is_closed s) (hs : s.nonempty) (B : bdd_below s) :
+  Inf s ∈ s :=
+(is_glb_cInf hs B).mem_of_is_closed hs hc
+
+/-- If a monotone function is continuous at the supremum of a nonempty bounded above set `s`,
+then it sends this supremum to the supremum of the image of `s`. -/
+lemma monotone.map_cSup_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
+  (Mf : monotone f) (ne : s.nonempty) (H : bdd_above s) :
+  f (Sup s) = Sup (f '' s) :=
+begin
+  refine ((is_lub_cSup (ne.image f) (Mf.map_bdd_above H)).unique _).symm,
+  refine (is_lub_cSup ne H).is_lub_of_tendsto (λx hx y hy xy, Mf xy)  ne _,
+  exact Cf.mono_left inf_le_left
+end
+
+/-- If a monotone function is continuous at the indexed supremum of a bounded function on
+a nonempty `Sort`, then it sends this supremum to the supremum of the composition. -/
+lemma monotone.map_csupr_of_continuous_at {f : α → β} {g : γ → α}
+  (Cf : continuous_at f (⨆ i, g i)) (Mf : monotone f) (H : bdd_above (range g)) :
+  f (⨆ i, g i) = ⨆ i, f (g i) :=
+by rw [supr, Mf.map_cSup_of_continuous_at Cf (range_nonempty _) H, ← range_comp, supr]
+
+/-- If a monotone function is continuous at the infimum of a nonempty bounded below set `s`,
+then it sends this infimum to the infimum of the image of `s`. -/
+lemma monotone.map_cInf_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
+  (Mf : monotone f) (ne : s.nonempty) (H : bdd_below s) :
+  f (Inf s) = Inf (f '' s) :=
+@monotone.map_cSup_of_continuous_at αᵒᵈ βᵒᵈ _ _ _ _ _ _ f s Cf Mf.dual ne H
+
+/-- A continuous monotone function sends indexed infimum to indexed infimum in conditionally
+complete linear order, under a boundedness assumption. -/
+lemma monotone.map_cinfi_of_continuous_at {f : α → β} {g : γ → α}
+  (Cf : continuous_at f (⨅ i, g i)) (Mf : monotone f) (H : bdd_below (range g)) :
+  f (⨅ i, g i) = ⨅ i, f (g i) :=
+@monotone.map_csupr_of_continuous_at αᵒᵈ βᵒᵈ _ _ _ _ _ _ _ _ _ _ Cf Mf.dual H
+
+/-- If an antitone function is continuous at the supremum of a nonempty bounded above set `s`,
+then it sends this supremum to the infimum of the image of `s`. -/
+lemma antitone.map_cSup_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Sup s))
+  (Af : antitone f) (ne : s.nonempty) (H : bdd_above s) :
+  f (Sup s) = Inf (f '' s) :=
+monotone.map_cSup_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (Sup s), from Cf) Af ne H
+
+/-- If an antitone function is continuous at the indexed supremum of a bounded function on
+a nonempty `Sort`, then it sends this supremum to the infimum of the composition. -/
+lemma antitone.map_csupr_of_continuous_at {f : α → β} {g : γ → α}
+  (Cf : continuous_at f (⨆ i, g i)) (Af : antitone f) (H : bdd_above (range g)) :
+  f (⨆ i, g i) = ⨅ i, f (g i) :=
+monotone.map_csupr_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (⨆ i, g i), from Cf) Af H
+
+/-- If an antitone function is continuous at the infimum of a nonempty bounded below set `s`,
+then it sends this infimum to the supremum of the image of `s`. -/
+lemma antitone.map_cInf_of_continuous_at {f : α → β} {s : set α} (Cf : continuous_at f (Inf s))
+  (Af : antitone f) (ne : s.nonempty) (H : bdd_below s) :
+  f (Inf s) = Sup (f '' s) :=
+monotone.map_cInf_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (Inf s), from Cf) Af ne H
+
+/-- A continuous antitone function sends indexed infimum to indexed supremum in conditionally
+complete linear order, under a boundedness assumption. -/
+lemma antitone.map_cinfi_of_continuous_at {f : α → β} {g : γ → α}
+  (Cf : continuous_at f (⨅ i, g i)) (Af : antitone f) (H : bdd_below (range g)) :
+  f (⨅ i, g i) = ⨆ i, f (g i) :=
+monotone.map_cinfi_of_continuous_at
+  (show continuous_at (order_dual.to_dual ∘ f) (⨅ i, g i), from Cf) Af H
+
+/-- A monotone map has a limit to the left of any point `x`, equal to `Sup (f '' (Iio x))`. -/
+lemma monotone.tendsto_nhds_within_Iio {α β : Type*}
+  [linear_order α] [topological_space α] [order_topology α]
+  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
+  {f : α → β} (Mf : monotone f) (x : α) :
+  tendsto f (𝓝[<] x) (𝓝 (Sup (f '' (Iio x)))) :=
+begin
+  rcases eq_empty_or_nonempty (Iio x) with h|h, { simp [h] },
+  refine tendsto_order.2 ⟨λ l hl, _, λ m hm, _⟩,
+  { obtain ⟨z, zx, lz⟩ : ∃ (a : α), a < x ∧ l < f a,
+      by simpa only [mem_image, exists_prop, exists_exists_and_eq_and]
+        using exists_lt_of_lt_cSup (nonempty_image_iff.2 h) hl,
+    exact (mem_nhds_within_Iio_iff_exists_Ioo_subset' zx).2
+      ⟨z, zx, λ y hy, lz.trans_le (Mf (hy.1.le))⟩ },
+  { filter_upwards [self_mem_nhds_within] with _ hy,
+    apply lt_of_le_of_lt _ hm,
+    exact le_cSup (Mf.map_bdd_above bdd_above_Iio) (mem_image_of_mem _ hy), },
+end
+
+/-- A monotone map has a limit to the right of any point `x`, equal to `Inf (f '' (Ioi x))`. -/
+lemma monotone.tendsto_nhds_within_Ioi {α β : Type*}
+  [linear_order α] [topological_space α] [order_topology α]
+  [conditionally_complete_linear_order β] [topological_space β] [order_topology β]
+  {f : α → β} (Mf : monotone f) (x : α) :
+  tendsto f (𝓝[>] x) (𝓝 (Inf (f '' (Ioi x)))) :=
+@monotone.tendsto_nhds_within_Iio αᵒᵈ βᵒᵈ _ _ _ _ _ _ f Mf.dual x
+
+end conditionally_complete_linear_order
+
+section nhds_with_pos
+
+section linear_ordered_add_comm_group
+
+variables [linear_order α] [has_zero α] [topological_space α] [order_topology α]
+
+lemma eventually_nhds_within_pos_mem_Ioo {ε : α} (h : 0 < ε) :
+  ∀ᶠ x in 𝓝[>] 0, x ∈ Ioo 0 ε :=
+Ioo_mem_nhds_within_Ioi (left_mem_Ico.2 h)
+
+lemma eventually_nhds_within_pos_mem_Ioc {ε : α} (h : 0 < ε) :
+  ∀ᶠ x in 𝓝[>] 0, x ∈ Ioc 0 ε :=
+Ioc_mem_nhds_within_Ioi (left_mem_Ico.2 h)
+
+end linear_ordered_add_comm_group
+
+end nhds_with_pos
+
+end order_topology
diff --git a/src/topology/order/hom/basic.lean b/src/topology/order/hom/basic.lean
index 885b93478fa7d..b1af0090e7247 100644
--- a/src/topology/order/hom/basic.lean
+++ b/src/topology/order/hom/basic.lean
@@ -9,6 +9,9 @@ import topology.continuous_function.basic
 /-!
 # Continuous order homomorphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines continuous order homomorphisms, that is maps which are both continuous and
 monotone. They are also called Priestley homomorphisms because they are the morphisms of the
 category of Priestley spaces.
@@ -37,6 +40,9 @@ structure continuous_order_hom (α β : Type*) [preorder α] [preorder β] [topo
 
 infixr ` →Co `:25 := continuous_order_hom
 
+section
+set_option old_structure_cmd true
+
 /-- `continuous_order_hom_class F α β` states that `F` is a type of continuous monotone maps.
 
 You should extend this class when you extend `continuous_order_hom`. -/
@@ -45,6 +51,8 @@ class continuous_order_hom_class (F : Type*) (α β : out_param $ Type*) [preord
   extends rel_hom_class F ((≤) : α → α → Prop) ((≤) : β → β → Prop) :=
 (map_continuous (f : F) : continuous f)
 
+end
+
 @[priority 100] -- See note [lower instance priority]
 instance continuous_order_hom_class.to_continuous_map_class [preorder α] [preorder β]
   [topological_space α] [topological_space β] [continuous_order_hom_class F α β] :
@@ -86,6 +94,9 @@ definitional equalities. -/
 protected def copy (f : α →Co β) (f' : α → β) (h : f' = f) : α →Co β :=
 ⟨f.to_order_hom.copy f' $ by exact h, h.symm.subst f.continuous_to_fun⟩
 
+@[simp] lemma coe_copy (f : α →Co β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : α →Co β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `continuous_order_hom`. -/
diff --git a/src/topology/order/hom/esakia.lean b/src/topology/order/hom/esakia.lean
index 067ada35f1621..1ae1c28310069 100644
--- a/src/topology/order/hom/esakia.lean
+++ b/src/topology/order/hom/esakia.lean
@@ -4,12 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
 import order.hom.bounded
-import order.hom.order
 import topology.order.hom.basic
 
 /-!
 # Esakia morphisms
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines pseudo-epimorphisms and Esakia morphisms.
 
 We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
@@ -44,6 +46,9 @@ structure esakia_hom (α β : Type*) [topological_space α] [preorder α] [topol
   [preorder β] extends α →Co β :=
 (exists_map_eq_of_map_le' ⦃a : α⦄ ⦃b : β⦄ : to_fun a ≤ b → ∃ c, a ≤ c ∧ to_fun c = b)
 
+section
+set_option old_structure_cmd true
+
 /-- `pseudo_epimorphism_class F α β` states that `F` is a type of `⊔`-preserving morphisms.
 
 You should extend this class when you extend `pseudo_epimorphism`. -/
@@ -59,18 +64,23 @@ class esakia_hom_class (F : Type*) (α β : out_param $ Type*) [topological_spac
   extends continuous_order_hom_class F α β :=
 (exists_map_eq_of_map_le (f : F) ⦃a : α⦄ ⦃b : β⦄ : f a ≤ b → ∃ c, a ≤ c ∧ f c = b)
 
+end
+
 export pseudo_epimorphism_class (exists_map_eq_of_map_le)
 
 @[priority 100] -- See note [lower instance priority]
 instance pseudo_epimorphism_class.to_top_hom_class [partial_order α] [order_top α] [preorder β]
   [order_top β] [pseudo_epimorphism_class F α β] : top_hom_class F α β :=
-⟨λ f, let ⟨b, h⟩ := exists_map_eq_of_map_le f (@le_top _ _ _ $ f ⊤) in
-  by rw [←top_le_iff.1 h.1, h.2]⟩
+{ map_top := λ f, let ⟨b, h⟩ := exists_map_eq_of_map_le f (@le_top _ _ _ $ f ⊤) in
+                  by rw [←top_le_iff.1 h.1, h.2]
+  .. ‹pseudo_epimorphism_class F α β› }
 
 @[priority 100] -- See note [lower instance priority]
 instance order_iso_class.to_pseudo_epimorphism_class [preorder α] [preorder β]
   [order_iso_class F α β] : pseudo_epimorphism_class F α β :=
-⟨λ f a b h, ⟨equiv_like.inv f b, (le_map_inv_iff f).2 h, equiv_like.right_inv _ _⟩⟩
+{ exists_map_eq_of_map_le :=
+      λ f a b h, ⟨equiv_like.inv f b, (le_map_inv_iff f).2 h, equiv_like.right_inv _ _⟩,
+  .. order_iso_class.to_order_hom_class }
 
 @[priority 100] -- See note [lower instance priority]
 instance esakia_hom_class.to_pseudo_epimorphism_class [topological_space α] [preorder α]
@@ -110,6 +120,14 @@ protected def copy (f : pseudo_epimorphism α β) (f' : α → β) (h : f' = f)
   pseudo_epimorphism α β :=
 ⟨f.to_order_hom.copy f' h, by simpa only [h.symm, to_fun_eq_coe] using f.exists_map_eq_of_map_le'⟩
 
+@[simp] lemma coe_copy (f : pseudo_epimorphism α β) (f' : α → β) (h : f' = f) :
+  ⇑(f.copy f' h) = f' :=
+rfl
+
+lemma copy_eq (f : pseudo_epimorphism α β) (f' : α → β) (h : f' = f) :
+  f.copy f' h = f :=
+fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `pseudo_epimorphism`. -/
@@ -188,6 +206,9 @@ protected def copy (f : esakia_hom α β) (f' : α → β) (h : f' = f) : esakia
 ⟨f.to_continuous_order_hom.copy f' h,
   by simpa only [h.symm, to_fun_eq_coe] using f.exists_map_eq_of_map_le'⟩
 
+@[simp] lemma coe_copy (f : esakia_hom α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : esakia_hom α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as an `esakia_hom`. -/
diff --git a/src/topology/order/lattice.lean b/src/topology/order/lattice.lean
index e42a6d380704e..4c189d437a7a5 100644
--- a/src/topology/order/lattice.lean
+++ b/src/topology/order/lattice.lean
@@ -3,12 +3,15 @@ Copyright (c) 2021 Christopher Hoskin. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Christopher Hoskin
 -/
-import topology.algebra.order.basic
+import topology.order.basic
 import topology.constructions
 
 /-!
 # Topological lattices
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define mixin classes `has_continuous_inf` and `has_continuous_sup`. We define the
 class `topological_lattice` as a topological space and lattice `L` extending `has_continuous_inf`
 and `has_continuous_sup`.
@@ -23,7 +26,7 @@ topological, lattice
 -/
 
 open filter
-open_locale topological_space
+open_locale topology
 
 /--
 Let `L` be a topological space and let `L×L` be equipped with the product topology and let
@@ -63,6 +66,11 @@ instance order_dual.topological_lattice
   (L : Type*) [topological_space L] [lattice L] [topological_lattice L] :
   topological_lattice Lᵒᵈ := {}
 
+@[priority 100] -- see Note [lower instance priority]
+instance linear_order.topological_lattice {L : Type*} [topological_space L] [linear_order L]
+  [order_closed_topology L] : topological_lattice L :=
+{ continuous_inf := continuous_min, continuous_sup := continuous_max }
+
 variables {L : Type*} [topological_space L]
 variables {X : Type*} [topological_space X]
 
diff --git a/src/topology/order/lower_topology.lean b/src/topology/order/lower_topology.lean
new file mode 100644
index 0000000000000..0ed69357c94a1
--- /dev/null
+++ b/src/topology/order/lower_topology.lean
@@ -0,0 +1,235 @@
+/-
+Copyright (c) 2023 Christopher Hoskin. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Christopher Hoskin
+-/
+import topology.homeomorph
+import topology.order.lattice
+import order.hom.complete_lattice
+
+/-!
+# Lower topology
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file introduces the lower topology on a preorder as the topology generated by the complements
+of the closed intervals to infinity.
+
+## Main statements
+
+- `lower_topology.t0_space` - the lower topology on a partial order is T₀
+- `is_topological_basis.is_topological_basis` - the complements of the upper closures of finite
+  subsets form a basis for the lower topology
+- `lower_topology.to_has_continuous_inf` - the inf map is continuous with respect to the lower
+  topology
+
+## Implementation notes
+
+A type synonym `with_lower_topology` is introduced and for a preorder `α`, `with_lower_topology α`
+is made an instance of `topological_space` by the topology generated by the complements of the
+closed intervals to infinity.
+
+We define a mixin class `lower_topology` for the class of types which are both a preorder and a
+topology and where the topology is generated by the complements of the closed intervals to infinity.
+It is shown that `with_lower_topology α` is an instance of `lower_topology`.
+
+## Motivation
+
+The lower topology is used with the `Scott` topology to define the Lawson topology. The restriction
+of the lower topology to the spectrum of a complete lattice coincides with the hull-kernel topology.
+
+## References
+
+* [Gierz et al, *A Compendium of Continuous Lattices*][GierzEtAl1980]
+
+## Tags
+
+lower topology, preorder
+-/
+
+variables (α β : Type*)
+
+open set topological_space
+
+/--
+Type synonym for a preorder equipped with the lower topology
+-/
+def with_lower_topology := α
+
+variables {α β}
+
+namespace with_lower_topology
+
+/-- `to_lower` is the identity function to the `with_lower_topology` of a type.  -/
+@[pattern] def to_lower : α ≃ with_lower_topology α := equiv.refl _
+
+/-- `of_lower` is the identity function from the `with_lower_topology` of a type.  -/
+@[pattern] def of_lower : with_lower_topology α ≃ α := equiv.refl _
+
+@[simp] lemma to_with_lower_topology_symm_eq : (@to_lower α).symm = of_lower := rfl
+@[simp] lemma of_with_lower_topology_symm_eq : (@of_lower α).symm = to_lower := rfl
+@[simp] lemma to_lower_of_lower (a : with_lower_topology α) : to_lower (of_lower a) = a := rfl
+@[simp] lemma of_lower_to_lower (a : α) : of_lower (to_lower a) = a := rfl
+@[simp] lemma to_lower_inj {a b : α} : to_lower a = to_lower b ↔ a = b := iff.rfl
+@[simp] lemma of_lower_inj {a b : with_lower_topology α} : of_lower a = of_lower b ↔ a = b :=
+iff.rfl
+
+/-- A recursor for `with_lower_topology`. Use as `induction x using with_lower_topology.rec`. -/
+protected def rec {β : with_lower_topology α → Sort*}
+  (h : Π a, β (to_lower a)) : Π a, β a := λ a, h (of_lower a)
+
+instance [nonempty α] : nonempty (with_lower_topology α) := ‹nonempty α›
+instance [inhabited α] : inhabited (with_lower_topology α) := ‹inhabited α›
+
+variables [preorder α]
+
+instance : preorder (with_lower_topology α) := ‹preorder α›
+
+instance : topological_space (with_lower_topology α) := generate_from {s | ∃ a, (Ici a)ᶜ = s}
+
+lemma is_open_preimage_of_lower (S : set α) :
+  is_open (with_lower_topology.of_lower ⁻¹' S) ↔
+    (generate_from {s : set α | ∃ (a : α), (Ici a)ᶜ = s}).is_open S := iff.rfl
+
+lemma is_open_def (T : set (with_lower_topology α)) :
+  is_open T ↔ (generate_from {s : set α | ∃ (a : α), (Ici a)ᶜ = s}).is_open
+    (with_lower_topology.to_lower ⁻¹' T) := iff.rfl
+
+end with_lower_topology
+
+/--
+The lower topology is the topology generated by the complements of the closed intervals to infinity.
+-/
+class lower_topology (α : Type*) [t : topological_space α] [preorder α] : Prop :=
+(topology_eq_lower_topology [] : t = generate_from {s | ∃ a, (Ici a)ᶜ = s})
+
+instance [preorder α] : lower_topology (with_lower_topology α) := ⟨rfl⟩
+
+namespace lower_topology
+
+/-- The complements of the upper closures of finite sets are a collection of lower sets
+which form a basis for the lower topology. -/
+def lower_basis (α : Type*) [preorder α] :=
+{s : set α | ∃ t : set α, t.finite ∧ (upper_closure t : set α)ᶜ = s}
+
+section preorder
+variables [preorder α] [topological_space α] [lower_topology α] {s : set α}
+
+/-- If `α` is equipped with the lower topology, then it is homeomorphic to `with_lower_topology α`.
+-/
+def with_lower_topology_homeomorph : with_lower_topology α ≃ₜ α :=
+{ continuous_to_fun := by { convert continuous_id, apply topology_eq_lower_topology },
+  continuous_inv_fun := by { convert ← continuous_id, apply topology_eq_lower_topology },
+  ..with_lower_topology.of_lower }
+
+lemma is_open_iff_generate_Ici_compl : is_open s ↔ generate_open {t | ∃ a, (Ici a)ᶜ = t} s :=
+by rw topology_eq_lower_topology α; refl
+
+/-- Left-closed right-infinite intervals [a, ∞) are closed in the lower topology. -/
+lemma is_closed_Ici (a : α) : is_closed (Ici a) :=
+is_open_compl_iff.1 $ is_open_iff_generate_Ici_compl.2 $ generate_open.basic _ ⟨a, rfl⟩
+
+/-- The upper closure of a finite set is closed in the lower topology. -/
+lemma is_closed_upper_closure (h : s.finite) : is_closed (upper_closure s : set α) :=
+begin
+  simp only [← upper_set.infi_Ici, upper_set.coe_infi],
+  exact is_closed_bUnion h (λ a h₁, is_closed_Ici a),
+end
+
+/-- Every set open in the lower topology is a lower set. -/
+lemma is_lower_set_of_is_open (h : is_open s) : is_lower_set s :=
+begin
+  rw is_open_iff_generate_Ici_compl at h,
+  induction h,
+  case generate_open.basic : u h { obtain ⟨a, rfl⟩ := h, exact (is_upper_set_Ici a).compl },
+  case univ : { exact is_lower_set_univ },
+  case inter : u v hu1 hv1 hu2 hv2 { exact hu2.inter hv2 },
+  case sUnion : _ _ ih { exact is_lower_set_sUnion ih },
+end
+
+lemma is_upper_set_of_is_closed (h : is_closed s) : is_upper_set s :=
+is_lower_set_compl.1 $ is_lower_set_of_is_open h.is_open_compl
+
+/--
+The closure of a singleton `{a}` in the lower topology is the left-closed right-infinite interval
+[a, ∞).
+-/
+@[simp] lemma closure_singleton (a : α) : closure {a} = Ici a :=
+subset_antisymm (closure_minimal (λ b h, h.ge) $ is_closed_Ici a) $
+  (is_upper_set_of_is_closed is_closed_closure).Ici_subset $ subset_closure rfl
+
+protected lemma is_topological_basis :
+  is_topological_basis (lower_basis α) :=
+begin
+  convert is_topological_basis_of_subbasis (topology_eq_lower_topology α),
+  simp_rw [lower_basis, coe_upper_closure, compl_Union],
+  ext s,
+  split,
+  { rintro ⟨F, hF, rfl⟩,
+    refine ⟨(λ a, (Ici a)ᶜ) '' F, ⟨hF.image _, image_subset_iff.2 $ λ _ _, ⟨_, rfl⟩⟩, _⟩,
+    rw sInter_image },
+  { rintro ⟨F, ⟨hF, hs⟩, rfl⟩,
+    haveI := hF.to_subtype,
+    rw [subset_def, subtype.forall'] at hs,
+    choose f hf using hs,
+    exact ⟨_, finite_range f, by simp_rw [bInter_range, hf, sInter_eq_Inter]⟩ }
+end
+
+end preorder
+
+section partial_order
+variables [partial_order α] [topological_space α] [lower_topology α]
+
+/--
+The lower topology on a partial order is T₀.
+-/
+@[priority 90] -- see Note [lower instance priority]
+instance : t0_space α :=
+(t0_space_iff_inseparable α).2 $ λ x y h, Ici_injective $
+  by simpa only [inseparable_iff_closure_eq, closure_singleton] using h
+
+end partial_order
+end lower_topology
+
+instance [preorder α] [topological_space α] [lower_topology α] [order_bot α]
+  [preorder β] [topological_space β] [lower_topology β] [order_bot β] : lower_topology (α × β) :=
+{ topology_eq_lower_topology :=
+  begin
+    refine le_antisymm (le_generate_from _) _,
+    { rintro _ ⟨x, rfl⟩,
+      exact ((lower_topology.is_closed_Ici _).prod $
+        lower_topology.is_closed_Ici _).is_open_compl },
+    rw [(lower_topology.is_topological_basis.prod
+      lower_topology.is_topological_basis).eq_generate_from,
+      le_generate_from_iff_subset_is_open, image2_subset_iff],
+    rintro _ ⟨s, hs, rfl⟩ _ ⟨t, ht, rfl⟩,
+    dsimp,
+    simp_rw [coe_upper_closure, compl_Union, prod_eq, preimage_Inter, preimage_compl],
+    -- Note: `refine` doesn't work here because it tries using `prod.topological_space`.
+    apply (is_open_bInter hs $ λ a _, _).inter (is_open_bInter ht $ λ b _, _),
+    { exact generate_open.basic _ ⟨(a, ⊥), by simp [Ici_prod_eq, prod_univ]⟩ },
+    { exact generate_open.basic _ ⟨(⊥, b), by simp [Ici_prod_eq, univ_prod]⟩ },
+    all_goals { apply_instance },
+  end }
+
+section complete_lattice
+variables [complete_lattice α] [complete_lattice β] [topological_space α] [lower_topology α]
+  [topological_space β] [lower_topology β]
+
+lemma Inf_hom.continuous (f : Inf_hom α β) : continuous f :=
+begin
+  convert continuous_generated_from _,
+  { exact lower_topology.topology_eq_lower_topology β },
+  rintro _ ⟨b, rfl⟩,
+  rw [preimage_compl, is_open_compl_iff],
+  convert lower_topology.is_closed_Ici (Inf $ f ⁻¹' Ici b),
+  refine subset_antisymm (λ a, Inf_le) (λ a ha, le_trans _ $ order_hom_class.mono f ha),
+  simp [map_Inf],
+end
+
+@[priority 90] -- see Note [lower instance priority]
+instance lower_topology.to_has_continuous_inf : has_continuous_inf α :=
+⟨(inf_Inf_hom : Inf_hom (α × α) α).continuous⟩
+
+end complete_lattice
diff --git a/src/topology/order/priestley.lean b/src/topology/order/priestley.lean
index ac900eb4b1d1b..8cbdc51758425 100644
--- a/src/topology/order/priestley.lean
+++ b/src/topology/order/priestley.lean
@@ -3,12 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import order.upper_lower
+import order.upper_lower.basic
 import topology.separation
 
 /-!
 # Priestley spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines Priestley spaces. A Priestley space is an ordered compact topological space such
 that any two distinct points can be separated by a clopen upper set.
 
@@ -68,6 +71,6 @@ end
 @[priority 100] -- See note [lower instance priority]
 instance priestley_space.to_t2_space : t2_space α :=
 ⟨λ x y h, let ⟨U, hU, _, hx, hy⟩ := exists_clopen_upper_or_lower_of_ne h in
-   ⟨U, Uᶜ, hU.is_open, hU.compl.is_open, hx, hy, inter_compl_self _⟩⟩
+   ⟨U, Uᶜ, hU.is_open, hU.compl.is_open, hx, hy, disjoint_compl_right⟩⟩
 
 end partial_order
diff --git a/src/topology/paracompact.lean b/src/topology/paracompact.lean
index 5484ec7d20727..672ffe7f71075 100644
--- a/src/topology/paracompact.lean
+++ b/src/topology/paracompact.lean
@@ -10,6 +10,9 @@ import data.option.basic
 /-!
 # Paracompact topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A topological space `X` is said to be paracompact if every open covering of `X` admits a locally
 finite refinement.
 
@@ -34,7 +37,7 @@ We also prove the following facts.
   the instance graph.
 
 * Every `emetric_space` is a paracompact space, see instance `emetric_space.paracompact_space` in
-  `topology/metric_space/emetric_space`.
+  `topology/metric_space/emetric_paracompact`.
 
 ## TODO
 
@@ -46,7 +49,7 @@ compact space, paracompact space, locally finite covering
 -/
 
 open set filter function
-open_locale filter topological_space
+open_locale filter topology
 
 universes u v
 
@@ -81,7 +84,7 @@ begin
   { simp only [eq_univ_iff_forall, mem_Union],
     exact λ x, ⟨ind (t_inv x), _, rfl, ht_inv _⟩ },
   { refine λ x, ⟨U x, hxU x, ((hU x).image ind).subset _⟩,
-    simp only [subset_def, mem_Union, mem_set_of_eq, set.nonempty, mem_inter_eq],
+    simp only [subset_def, mem_Union, mem_set_of_eq, set.nonempty, mem_inter_iff],
     rintro i ⟨y, ⟨a, rfl, hya⟩, hyU⟩,
     exact mem_image_of_mem _ ⟨y, hya, hyU⟩ },
   { simp only [subset_def, mem_Union],
@@ -95,7 +98,7 @@ lemma precise_refinement_set [paracompact_space X] {s : set X} (hs : is_closed s
   (u : ι → set X) (uo : ∀ i, is_open (u i)) (us : s ⊆ ⋃ i, u i) :
   ∃ v : ι → set X, (∀ i, is_open (v i)) ∧ (s ⊆ ⋃ i, v i) ∧ locally_finite v ∧ (∀ i, v i ⊆ u i) :=
 begin
-  rcases precise_refinement (λ i, option.elim i sᶜ u)
+  rcases precise_refinement (option.elim sᶜ u)
     (option.forall.2 ⟨is_open_compl_iff.2 hs, uo⟩) _ with ⟨v, vo, vc, vf, vu⟩,
   refine ⟨v ∘ some, λ i, vo _, _, vf.comp_injective (option.some_injective _), λ i, vu _⟩,
   { simp only [Union_option, ← compl_subset_iff_union] at vc,
@@ -109,10 +112,10 @@ instance paracompact_of_compact [compact_space X] : paracompact_space X :=
 begin
   -- the proof is trivial: we choose a finite subcover using compactness, and use it
   refine ⟨λ ι s ho hu, _⟩,
-  rcases compact_univ.elim_finite_subcover _ ho hu.ge with ⟨T, hT⟩,
+  rcases is_compact_univ.elim_finite_subcover _ ho hu.ge with ⟨T, hT⟩,
   have := hT, simp only [subset_def, mem_Union] at this,
   choose i hiT hi using λ x, this x (mem_univ x),
-  refine ⟨(T : set ι), λ t, s t, λ t, ho _, _, locally_finite_of_fintype _, λ t, ⟨t, subset.rfl⟩⟩,
+  refine ⟨(T : set ι), λ t, s t, λ t, ho _, _, locally_finite_of_finite _, λ t, ⟨t, subset.rfl⟩⟩,
   simpa only [Union_coe_set, ← univ_subset_iff]
 end
 
@@ -178,7 +181,7 @@ begin
     have : (⋃ k ≤ K'.find x + 2, (range $ sigma.mk k) : set (Σ n, T' n)).finite,
       from (finite_le_nat _).bUnion (λ k hk, finite_range _),
     apply this.subset, rintro ⟨k, c, hc⟩,
-    simp only [mem_Union, mem_set_of_eq, mem_image_eq, subtype.coe_mk],
+    simp only [mem_Union, mem_set_of_eq, mem_image, subtype.coe_mk],
     rintro ⟨x, hxB : x ∈ B c (r k c), hxK⟩,
     refine ⟨k, _, ⟨c, hc⟩, rfl⟩,
     have := (mem_compl_iff _ _).1 (hr k c hxB),
@@ -248,12 +251,11 @@ begin
       hcov', _, disjoint_compl_right.mono le_rfl (compl_le_compl subset_closure)⟩,
     rw [hu'fin.closure_Union, compl_Union, subset_Inter_iff],
     refine λ i x hxt hxu, absurd (htv i hxt) (closure_minimal _ (is_closed_compl_iff.2 $ hv _) hxu),
-    exact λ y hyu hyv, huv i ⟨hsub _ hyu, hyv⟩ },
+    exact λ y hyu hyv, (huv i).le_bot ⟨hsub _ hyu, hyv⟩ },
   /- Now we apply the lemma twice: first to `s` and `t`, then to `t` and each point of `s`. -/
   refine ⟨λ s t hs ht hst, this s t hs ht (λ x hx, _)⟩,
-  rcases this t {x} ht is_closed_singleton (λ y hyt, _) with ⟨v, u, hv, hu, htv, hxu, huv⟩,
+  rcases this t {x} ht is_closed_singleton (λ y hy, _) with ⟨v, u, hv, hu, htv, hxu, huv⟩,
   { exact ⟨u, v, hu, hv, singleton_subset_iff.1 hxu, htv, huv.symm⟩ },
-  { have : x ≠ y, by { rintro rfl, exact hst ⟨hx, hyt⟩ },
-    rcases t2_separation this with ⟨v, u, hv, hu, hxv, hyu, hd⟩,
-    exact ⟨u, v, hu, hv, hyu, singleton_subset_iff.2 hxv, disjoint.symm hd.le⟩ }
+  { simp_rw singleton_subset_iff,
+    exact t2_separation (hst.symm.ne_of_mem hy hx) }
 end
diff --git a/src/topology/partial.lean b/src/topology/partial.lean
new file mode 100644
index 0000000000000..82cbe064b1c9c
--- /dev/null
+++ b/src/topology/partial.lean
@@ -0,0 +1,76 @@
+/-
+Copyright (c) 2018 Jeremy Avigad. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jeremy Avigad
+-/
+import topology.continuous_on
+import order.filter.partial
+
+/-!
+# Partial functions and topological spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we prove properties of `filter.ptendsto` etc in topological spaces. We also introduce
+`pcontinuous`, a version of `continuous` for partially defined functions.
+-/
+
+open filter
+open_locale topology
+
+variables {α β : Type*} [topological_space α]
+
+theorem rtendsto_nhds {r : rel β α} {l : filter β} {a : α} :
+  rtendsto r l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → r.core s ∈ l) :=
+all_mem_nhds_filter _ _ (λ s t, id) _
+
+theorem rtendsto'_nhds {r : rel β α} {l : filter β} {a : α} :
+  rtendsto' r l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → r.preimage s ∈ l) :=
+by { rw [rtendsto'_def], apply all_mem_nhds_filter, apply rel.preimage_mono }
+
+theorem ptendsto_nhds {f : β →. α} {l : filter β} {a : α} :
+  ptendsto f l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → f.core s ∈ l) :=
+rtendsto_nhds
+
+theorem ptendsto'_nhds {f : β →. α} {l : filter β} {a : α} :
+  ptendsto' f l (𝓝 a) ↔ (∀ s, is_open s → a ∈ s → f.preimage s ∈ l) :=
+rtendsto'_nhds
+
+/-! ### Continuity and partial functions -/
+
+variable [topological_space β]
+
+/-- Continuity of a partial function -/
+def pcontinuous (f : α →. β) := ∀ s, is_open s → is_open (f.preimage s)
+
+lemma open_dom_of_pcontinuous {f : α →. β} (h : pcontinuous f) : is_open f.dom :=
+by rw [←pfun.preimage_univ]; exact h _ is_open_univ
+
+lemma pcontinuous_iff' {f : α →. β} :
+  pcontinuous f ↔ ∀ {x y} (h : y ∈ f x), ptendsto' f (𝓝 x) (𝓝 y) :=
+begin
+  split,
+  { intros h x y h',
+    simp only [ptendsto'_def, mem_nhds_iff],
+    rintros s ⟨t, tsubs, opent, yt⟩,
+    exact ⟨f.preimage t, pfun.preimage_mono _ tsubs, h _ opent, ⟨y, yt, h'⟩⟩ },
+  intros hf s os,
+  rw is_open_iff_nhds,
+  rintros x ⟨y, ys, fxy⟩ t,
+  rw [mem_principal],
+  assume h : f.preimage s ⊆ t,
+  change t ∈ 𝓝 x,
+  apply mem_of_superset _ h,
+  have h' : ∀ s ∈ 𝓝 y, f.preimage s ∈ 𝓝 x,
+  { intros s hs,
+     have : ptendsto' f (𝓝 x) (𝓝 y) := hf fxy,
+     rw ptendsto'_def at this,
+     exact this s hs },
+  show f.preimage s ∈ 𝓝 x,
+  apply h', rw mem_nhds_iff, exact ⟨s, set.subset.refl _, os, ys⟩
+end
+
+theorem continuous_within_at_iff_ptendsto_res (f : α → β) {x : α} {s : set α} :
+  continuous_within_at f s x ↔ ptendsto (pfun.res f s) (𝓝 x) (𝓝 (f x)) :=
+tendsto_iff_ptendsto _ _ _ _
diff --git a/src/topology/partition_of_unity.lean b/src/topology/partition_of_unity.lean
index e84f667a35365..a826173c07c43 100644
--- a/src/topology/partition_of_unity.lean
+++ b/src/topology/partition_of_unity.lean
@@ -13,6 +13,9 @@ import topology.urysohns_lemma
 /-!
 # Continuous partition of unity
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define `partition_of_unity (ι X : Type*) [topological_space X] (s : set X := univ)`
 to be a continuous partition of unity on `s` indexed by `ι`. More precisely, `f : partition_of_unity
 ι X s` is a collection of continuous functions `f i : C(X, ℝ)`, `i : ι`, such that
@@ -75,7 +78,7 @@ partition of unity, bump function, Urysohn's lemma, normal space, paracompact sp
 universes u v
 
 open function set filter
-open_locale big_operators topological_space classical
+open_locale big_operators topology classical
 
 noncomputable theory
 
@@ -125,17 +128,28 @@ variables {ι : Type u} {X : Type v} [topological_space X]
 
 namespace partition_of_unity
 
-variables {s : set X} (f : partition_of_unity ι X s)
+variables {E : Type*} [add_comm_monoid E] [smul_with_zero ℝ E] [topological_space E]
+  [has_continuous_smul ℝ E] {s : set X} (f : partition_of_unity ι X s)
 
 instance : has_coe_to_fun (partition_of_unity ι X s) (λ _, ι → C(X, ℝ)) := ⟨to_fun⟩
 
-protected lemma locally_finite : locally_finite (λ i, support (f i)) :=
-f.locally_finite'
+protected lemma locally_finite : locally_finite (λ i, support (f i)) := f.locally_finite'
+
+lemma locally_finite_tsupport : locally_finite (λ i, tsupport (f i)) := f.locally_finite.closure
 
 lemma nonneg (i : ι) (x : X) : 0 ≤ f i x := f.nonneg' i x
 
 lemma sum_eq_one {x : X} (hx : x ∈ s) : ∑ᶠ i, f i x = 1 := f.sum_eq_one' x hx
 
+/-- If `f` is a partition of unity on `s`, then for every `x ∈ s` there exists an index `i` such
+that `0 < f i x`. -/
+lemma exists_pos {x : X} (hx : x ∈ s) : ∃ i, 0 < f i x :=
+begin
+  have H := f.sum_eq_one hx,
+  contrapose! H,
+  simpa only [λ i, (H i).antisymm (f.nonneg i x), finsum_zero] using zero_ne_one
+end
+
 lemma sum_le_one (x : X) : ∑ᶠ i, f i x ≤ 1 := f.sum_le_one' x
 
 lemma sum_nonneg (x : X) : 0 ≤ ∑ᶠ i, f i x := finsum_nonneg $ λ i, f.nonneg i x
@@ -143,6 +157,22 @@ lemma sum_nonneg (x : X) : 0 ≤ ∑ᶠ i, f i x := finsum_nonneg $ λ i, f.nonn
 lemma le_one (i : ι) (x : X) : f i x ≤ 1 :=
 (single_le_finsum i (f.locally_finite.point_finite x) (λ j, f.nonneg j x)).trans (f.sum_le_one x)
 
+/-- If `f` is a partition of unity on `s : set X` and `g : X → E` is continuous at every point of
+the topological support of some `f i`, then `λ x, f i x • g x` is continuous on the whole space. -/
+lemma continuous_smul {g : X → E} {i : ι} (hg : ∀ x ∈ tsupport (f i), continuous_at g x) :
+  continuous (λ x, f i x • g x) :=
+continuous_of_tsupport $ λ x hx, ((f i).continuous_at x).smul $
+  hg x $ tsupport_smul_subset_left _ _ hx
+
+/-- If `f` is a partition of unity on a set `s : set X` and `g : ι → X → E` is a family of functions
+such that each `g i` is continuous at every point of the topological support of `f i`, then the sum
+`λ x, ∑ᶠ i, f i x • g i x` is continuous on the whole space. -/
+lemma continuous_finsum_smul [has_continuous_add E] {g : ι → X → E}
+  (hg : ∀ i (x ∈ tsupport (f i)), continuous_at (g i) x) :
+  continuous (λ x, ∑ᶠ i, f i x • g i x) :=
+continuous_finsum (λ i, f.continuous_smul (hg i)) $
+  f.locally_finite.subset $ λ i, support_smul_subset_left _ _
+
 /-- A partition of unity `f i` is subordinate to a family of sets `U i` indexed by the same type if
 for each `i` the closure of the support of `f i` is a subset of `U i`. -/
 def is_subordinate (U : ι → set X) : Prop :=
@@ -156,6 +186,15 @@ lemma exists_finset_nhd_support_subset {U : ι → set X}
     support (λ i, f i z) ⊆ is :=
 f.locally_finite.exists_finset_nhd_support_subset hso ho x
 
+/-- If `f` is a partition of unity that is subordinate to a family of open sets `U i` and
+`g : ι → X → E` is a family of functions such that each `g i` is continuous on `U i`, then the sum
+`λ x, ∑ᶠ i, f i x • g i x` is a continuous function. -/
+lemma is_subordinate.continuous_finsum_smul [has_continuous_add E] {U : ι → set X}
+  (ho : ∀ i, is_open (U i)) (hf : f.is_subordinate U) {g : ι → X → E}
+  (hg : ∀ i, continuous_on (g i) (U i)) :
+  continuous (λ x, ∑ᶠ i, f i x • g i x) :=
+f.continuous_finsum_smul $ λ i x hx, (hg i).continuous_at $ (ho i).mem_nhds $ hf i hx
+
 end partition_of_unity
 
 namespace bump_covering
@@ -164,11 +203,11 @@ variables {s : set X} (f : bump_covering ι X s)
 
 instance : has_coe_to_fun (bump_covering ι X s) (λ _, ι → C(X, ℝ)) := ⟨to_fun⟩
 
-protected lemma locally_finite : locally_finite (λ i, support (f i)) :=
-f.locally_finite'
+protected lemma locally_finite : locally_finite (λ i, support (f i)) := f.locally_finite'
+
+lemma locally_finite_tsupport : locally_finite (λ i, tsupport (f i)) := f.locally_finite.closure
 
-protected lemma point_finite (x : X) : finite {i | f i x ≠ 0} :=
-f.locally_finite.point_finite x
+protected lemma point_finite (x : X) : {i | f i x ≠ 0}.finite := f.locally_finite.point_finite x
 
 lemma nonneg (i : ι) (x : X) : 0 ≤ f i x := f.nonneg' i x
 
@@ -325,7 +364,7 @@ begin
     exact λ i hi, f.support_to_pou_fun_subset i hi },
   have B : mul_support (λ i, 1 - f i x) ⊆ s,
   { rw [hs, mul_support_one_sub], exact λ i, id },
-  letI : linear_order ι := linear_order_of_STO' well_ordering_rel,
+  letI : linear_order ι := linear_order_of_STO well_ordering_rel,
   rw [finsum_eq_sum_of_support_subset _ A, finprod_eq_prod_of_mul_support_subset _ B,
     finset.prod_one_sub_ordered, sub_sub_cancel],
   refine finset.sum_congr rfl (λ i hi, _),
diff --git a/src/topology/path_connected.lean b/src/topology/path_connected.lean
index 7343b44071407..3e52c69b1f571 100644
--- a/src/topology/path_connected.lean
+++ b/src/topology/path_connected.lean
@@ -4,12 +4,16 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot
 -/
 import topology.algebra.order.proj_Icc
+import topology.compact_open
 import topology.continuous_function.basic
 import topology.unit_interval
 
 /-!
 # Path connectedness
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Main definitions
 
 In the file the unit interval `[0, 1]` in `ℝ` is denoted by `I`, and `X` is a topological space.
@@ -59,7 +63,7 @@ on `(-∞, 0]` and to `y` on `[1, +∞)`.
 -/
 
 noncomputable theory
-open_locale classical topological_space filter unit_interval
+open_locale classical topology filter unit_interval
 open filter set function unit_interval
 
 variables {X Y : Type*} [topological_space X] [topological_space Y] {x y z : X} {ι : Type*}
@@ -67,7 +71,7 @@ variables {X Y : Type*} [topological_space X] [topological_space Y] {x y z : X}
 /-! ### Paths -/
 
 /-- Continuous path connecting two points `x` and `y` in a topological space -/
-@[nolint has_inhabited_instance]
+@[nolint has_nonempty_instance]
 structure path (x y : X) extends C(I, X) :=
 (source' : to_fun 0 = x)
 (target' : to_fun 1 = y)
@@ -138,6 +142,32 @@ begin
   simp
 end
 
+/-! #### Space of paths -/
+
+open continuous_map
+
+instance : has_coe (path x y) C(I, X) := ⟨λ γ, γ.1⟩
+
+/--
+The following instance defines the topology on the path space to be induced from the
+compact-open topology on the space `C(I,X)` of continuous maps from `I` to `X`.
+-/
+instance : topological_space (path x y) :=
+topological_space.induced (coe : _ → C(I, X)) continuous_map.compact_open
+
+lemma continuous_eval : continuous (λ p : path x y × I, p.1 p.2) :=
+continuous_eval'.comp $ continuous_induced_dom.prod_map continuous_id
+
+@[continuity] lemma _root_.continuous.path_eval {Y} [topological_space Y]
+  {f : Y → path x y} {g : Y → I} (hf : continuous f) (hg : continuous g) :
+  continuous (λ y, f y (g y)) := continuous.comp continuous_eval (hf.prod_mk hg)
+
+lemma continuous_uncurry_iff {Y} [topological_space Y] {g : Y → path x y} :
+  continuous ↿g ↔ continuous g :=
+iff.symm $ continuous_induced_rng.trans
+  ⟨λ h, continuous_uncurry_of_continuous ⟨_, h⟩, continuous_of_continuous_uncurry ↑g⟩
+
+
 /-- A continuous map extending a path to `ℝ`, constant before `0` and after `1`. -/
 def extend : ℝ → X := Icc_extend zero_le_one γ
 
@@ -237,7 +267,7 @@ begin
     { linarith [unit_interval.nonneg t, unit_interval.le_one t] },
     norm_num [ht] },
   { refine congr_arg _ (subtype.ext _),
-    norm_num [sub_sub_assoc_swap, mul_sub] },
+    norm_num [sub_sub_eq_add_sub, mul_sub] },
   { refine congr_arg _ (subtype.ext _),
     have h : 2 - 2 * (t : ℝ) - 1 = 1 - 2 * t, by linarith,
     norm_num [mul_sub, h] },
@@ -281,7 +311,7 @@ begin
     { by_cases h : t = 0,
       { use ⟨1/2, ⟨by linarith, by linarith⟩⟩,
         unfold_coes,
-        simp only [h, comp_app, if_true, le_refl, mul_one_div_cancel (@two_ne_zero ℝ _ _)],
+        simp only [h, comp_app, if_true, le_refl, mul_one_div_cancel (two_ne_zero' ℝ)],
         rw γ₁.extend_one,
         rwa [← γ₂.extend_extends, h, γ₂.extend_zero] at hxt },
       { use ⟨(t+1)/2, ⟨by linarith, by linarith⟩⟩,
@@ -346,9 +376,13 @@ lemma symm_continuous_family {X ι : Type*} [topological_space X] [topological_s
   continuous ↿(λ t, (γ t).symm) :=
 h.comp (continuous_id.prod_map continuous_symm)
 
+@[continuity]
+lemma continuous_symm : continuous (symm : path x y → path y x) :=
+continuous_uncurry_iff.mp $ symm_continuous_family _ (continuous_fst.path_eval continuous_snd)
+
 @[continuity]
 lemma continuous_uncurry_extend_of_continuous_family {X ι : Type*} [topological_space X]
-  [topological_space ι] {a b : ι → X}  (γ : Π (t : ι), path (a t) (b t)) (h : continuous ↿γ) :
+  [topological_space ι] {a b : ι → X} (γ : Π (t : ι), path (a t) (b t)) (h : continuous ↿γ) :
   continuous ↿(λ t, (γ t).extend) :=
 h.comp (continuous_id.prod_map continuous_proj_Icc)
 
@@ -369,9 +403,23 @@ begin
     exact h₂'.comp (continuous_id.prod_map $
       (continuous_const.mul continuous_subtype_coe).sub continuous_const) },
   { rintros st hst,
-    simp [hst, mul_inv_cancel (@two_ne_zero ℝ _ _)] }
+    simp [hst, mul_inv_cancel (two_ne_zero' ℝ)] }
+end
+
+@[continuity]
+lemma _root_.continuous.path_trans {f : Y → path x y} {g : Y → path y z} : continuous f →
+  continuous g → continuous (λ t, (f t).trans (g t)) :=
+begin
+  intros hf hg,
+  apply continuous_uncurry_iff.mp,
+  exact trans_continuous_family _ (continuous_uncurry_iff.mpr hf)
+    _ (continuous_uncurry_iff.mpr hg),
 end
 
+@[continuity]
+lemma continuous_trans {x y z : X} : continuous (λ ρ : path x y × path y z, ρ.1.trans ρ.2) :=
+  continuous_fst.path_trans continuous_snd
+
 /-! #### Product of paths -/
 section prod
 variables {a₁ a₂ a₃ : X} {b₁ b₂ b₃ : Y}
@@ -443,7 +491,7 @@ def truncate {X : Type*} [topological_space X] {a b : X}
     ((continuous_subtype_coe.max continuous_const).min continuous_const),
   source' :=
   begin
-    simp only [min_def, max_def],
+    simp only [min_def, max_def'],
     norm_cast,
     split_ifs with h₁ h₂ h₃ h₄,
     { simp [γ.extend_of_le_zero h₁] },
@@ -454,7 +502,7 @@ def truncate {X : Type*} [topological_space X] {a b : X}
   end,
   target' :=
   begin
-    simp only [min_def, max_def],
+    simp only [min_def, max_def'],
     norm_cast,
     split_ifs with h₁ h₂ h₃,
     { simp [γ.extend_of_one_le h₂] },
@@ -507,7 +555,6 @@ begin
   rw cast_coe,
   simp only [truncate, has_coe_to_fun.coe, coe_fn, refl, min_def, max_def],
   split_ifs with h₁ h₂; congr,
-  exact le_antisymm ‹_› ‹_›
 end
 
 @[simp] lemma truncate_zero_zero {X : Type*} [topological_space X] {a b : X} (γ : path a b) :
@@ -555,9 +602,9 @@ begin
   have : range f = univ,
   { rw range_iff_surjective,
     intro t,
-    have h₁ : continuous (Icc_extend (@zero_le_one ℝ _) f),
+    have h₁ : continuous (Icc_extend (zero_le_one' ℝ) f),
     { continuity },
-    have := intermediate_value_Icc (@zero_le_one ℝ _) h₁.continuous_on,
+    have := intermediate_value_Icc (zero_le_one' ℝ) h₁.continuous_on,
     { rw [Icc_extend_left, Icc_extend_right] at this,
       change Icc (f 0) (f 1) ⊆ _ at this,
       rw [hf₀, hf₁] at this,
@@ -799,7 +846,7 @@ begin
     induction n with n hn,
     { use path.refl (p' 0),
       { split,
-        { rintros i hi, rw nat.le_zero_iff.mp hi, exact ⟨0, rfl⟩ },
+        { rintros i hi, rw le_zero_iff.mp hi, exact ⟨0, rfl⟩ },
         { rw range_subset_iff, rintros x, exact hp' 0 le_rfl } } },
     { rcases hn (λ i hi, hp' i $ nat.le_succ_of_le hi) with ⟨γ₀, hγ₀⟩,
       rcases h.joined_in (p' n) (hp' n n.le_succ) (p' $ n+1) (hp' (n+1) $ le_rfl) with ⟨γ₁, hγ₁⟩,
@@ -827,11 +874,10 @@ begin
   simp only [γ.cast_coe],
   refine and.intro hγ.2 _,
   rintros ⟨i, hi⟩,
-  convert hγ.1 i (nat.le_of_lt_succ hi), rw ← hpp' i hi,
-  congr,
-  ext,
-  rw fin.coe_coe_of_lt hi,
-  norm_cast
+  suffices : p ⟨i, hi⟩ = p' i, by convert hγ.1 i (nat.le_of_lt_succ hi),
+  rw ← hpp' i hi,
+  suffices : i = i % n.succ, { congr, assumption },
+  rw nat.mod_eq_of_lt hi,
 end
 
 lemma is_path_connected.exists_path_through_family'
@@ -855,8 +901,6 @@ class path_connected_space (X : Type*) [topological_space X] : Prop :=
 (nonempty : nonempty X)
 (joined : ∀ x y : X, joined x y)
 
-attribute [instance, priority 50] path_connected_space.nonempty
-
 lemma path_connected_space_iff_zeroth_homotopy :
   path_connected_space X ↔ nonempty (zeroth_homotopy X) ∧ subsingleton (zeroth_homotopy X) :=
 begin
@@ -900,6 +944,7 @@ lemma path_connected_space_iff_univ : path_connected_space X ↔ is_path_connect
 begin
   split,
   { introI h,
+    haveI := @path_connected_space.nonempty X _ _,
     inhabit X,
     refine ⟨default, mem_univ _, _⟩,
     simpa using path_connected_space.joined default },
@@ -982,7 +1027,7 @@ begin
   { introI hX,
     rw path_connected_space_iff_eq,
     use (classical.arbitrary X),
-    refine eq_univ_of_nonempty_clopen (by simp) ⟨_, _⟩,
+    refine is_clopen.eq_univ ⟨_, _⟩ (by simp),
     { rw is_open_iff_mem_nhds,
       intros y y_in,
       rcases (path_connected_basis y).ex_mem with ⟨U, ⟨U_in, hU⟩⟩,
diff --git a/src/topology/perfect.lean b/src/topology/perfect.lean
new file mode 100644
index 0000000000000..65a5f51d1df9c
--- /dev/null
+++ b/src/topology/perfect.lean
@@ -0,0 +1,336 @@
+/-
+Copyright (c) 2022 Felix Weilacher. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Felix Weilacher
+-/
+import topology.metric_space.polish
+import topology.metric_space.cantor_scheme
+
+/-!
+# Perfect Sets
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define perfect subsets of a topological space, and prove some basic properties,
+including a version of the Cantor-Bendixson Theorem.
+
+## Main Definitions
+
+* `perfect C`: A set `C` is perfect, meaning it is closed and every point of it
+  is an accumulation point of itself.
+
+## Main Statements
+
+* `perfect.splitting`: A perfect nonempty set contains two disjoint perfect nonempty subsets.
+  The main inductive step in the construction of an embedding from the Cantor space to a
+  perfect nonempty complete metric space.
+* `exists_countable_union_perfect_of_is_closed`: One version of the **Cantor-Bendixson Theorem**:
+  A closed set in a second countable space can be written as the union of a countable set and a
+  perfect set.
+* `perfect.exists_nat_bool_injection`: A perfect nonempty set in a complete metric space
+  admits an embedding from the Cantor space.
+
+## Implementation Notes
+
+We do not require perfect sets to be nonempty.
+
+We define a nonstandard predicate, `preperfect`, which drops the closed-ness requirement
+from the definition of perfect. In T1 spaces, this is equivalent to having a perfect closure,
+see `preperfect_iff_perfect_closure`.
+
+## References
+
+* [kechris1995] (Chapters 6-7)
+
+## Tags
+
+accumulation point, perfect set, cantor-bendixson.
+
+-/
+
+open_locale topology filter
+open topological_space filter set
+
+section basic
+
+variables {α : Type*} [topological_space α] {C : set α}
+
+/-- If `x` is an accumulation point of a set `C` and `U` is a neighborhood of `x`,
+then `x` is an accumulation point of `U ∩ C`. -/
+theorem acc_pt.nhds_inter {x : α} {U : set α} (h_acc : acc_pt x (𝓟 C)) (hU : U ∈ 𝓝 x) :
+  acc_pt x (𝓟 (U ∩ C)) :=
+begin
+  have : 𝓝[≠] x ≤ 𝓟 U,
+  { rw le_principal_iff,
+    exact mem_nhds_within_of_mem_nhds hU, },
+  rw [acc_pt, ← inf_principal, ← inf_assoc, inf_of_le_left this],
+  exact h_acc,
+end
+
+/-- A set `C` is preperfect if all of its points are accumulation points of itself.
+If `C` is nonempty and `α` is a T1 space, this is equivalent to the closure of `C` being perfect.
+See `preperfect_iff_perfect_closure`.-/
+def preperfect (C : set α) : Prop := ∀ x ∈ C, acc_pt x (𝓟 C)
+
+/-- A set `C` is called perfect if it is closed and all of its
+points are accumulation points of itself.
+Note that we do not require `C` to be nonempty.-/
+structure perfect (C : set α) : Prop :=
+(closed : is_closed C)
+(acc : preperfect C)
+
+lemma preperfect_iff_nhds : preperfect C ↔ ∀ x ∈ C, ∀ U ∈ 𝓝 x, ∃ y ∈ U ∩ C, y ≠ x :=
+by simp only [preperfect, acc_pt_iff_nhds]
+
+/-- The intersection of a preperfect set and an open set is preperfect-/
+theorem preperfect.open_inter {U : set α} (hC : preperfect C) (hU : is_open U) :
+  preperfect (U ∩ C) :=
+begin
+  rintros x ⟨xU, xC⟩,
+  apply (hC _ xC).nhds_inter,
+  exact hU.mem_nhds xU,
+end
+
+/-- The closure of a preperfect set is perfect.
+For a converse, see `preperfect_iff_perfect_closure`-/
+theorem preperfect.perfect_closure (hC : preperfect C) : perfect (closure C) :=
+begin
+  split, { exact is_closed_closure },
+  intros x hx,
+  by_cases h : x ∈ C; apply acc_pt.mono _ (principal_mono.mpr subset_closure),
+  { exact hC _ h },
+  have : {x}ᶜ ∩ C = C := by simp [h],
+  rw [acc_pt, nhds_within, inf_assoc, inf_principal, this],
+  rw [closure_eq_cluster_pts] at hx,
+  exact hx,
+end
+
+/-- In a T1 space, being preperfect is equivalent to having perfect closure.-/
+theorem preperfect_iff_perfect_closure [t1_space α] :
+  preperfect C ↔ perfect (closure C) :=
+begin
+  split; intro h, { exact h.perfect_closure },
+  intros x xC,
+  have H : acc_pt x (𝓟 (closure C)) := h.acc _ (subset_closure xC),
+  rw acc_pt_iff_frequently at *,
+  have : ∀ y , y ≠ x ∧ y ∈ closure C → ∃ᶠ z in 𝓝 y, z ≠ x ∧ z ∈ C,
+  { rintros y ⟨hyx, yC⟩,
+    simp only [← mem_compl_singleton_iff, @and_comm _ (_ ∈ C) , ← frequently_nhds_within_iff,
+      hyx.nhds_within_compl_singleton, ← mem_closure_iff_frequently],
+    exact yC, },
+  rw ← frequently_frequently_nhds,
+  exact H.mono this,
+end
+
+theorem perfect.closure_nhds_inter {U : set α} (hC : perfect C) (x : α) (xC : x ∈ C) (xU : x ∈ U)
+  (Uop : is_open U) : perfect (closure (U ∩ C)) ∧ (closure (U ∩ C)).nonempty :=
+begin
+  split,
+  { apply preperfect.perfect_closure,
+    exact (hC.acc).open_inter Uop, },
+  apply nonempty.closure,
+  exact ⟨x, ⟨xU, xC⟩⟩,
+end
+
+/-- Given a perfect nonempty set in a T2.5 space, we can find two disjoint perfect subsets
+This is the main inductive step in the proof of the Cantor-Bendixson Theorem-/
+lemma perfect.splitting [t2_5_space α] (hC : perfect C) (hnonempty : C.nonempty) :
+  ∃ C₀ C₁ : set α, (perfect C₀ ∧ C₀.nonempty ∧ C₀ ⊆ C) ∧
+  (perfect C₁ ∧ C₁.nonempty ∧ C₁ ⊆ C) ∧ disjoint C₀ C₁ :=
+begin
+  cases hnonempty with y yC,
+  obtain ⟨x, xC, hxy⟩ : ∃ x ∈ C, x ≠ y,
+  { have := hC.acc _ yC,
+    rw acc_pt_iff_nhds at this,
+    rcases this univ (univ_mem) with ⟨x, xC, hxy⟩,
+    exact ⟨x, xC.2, hxy⟩, },
+  obtain ⟨U, xU, Uop, V, yV, Vop, hUV⟩ := exists_open_nhds_disjoint_closure hxy,
+  use [closure (U ∩ C), closure (V ∩ C)],
+  split; rw ← and_assoc,
+  { refine ⟨hC.closure_nhds_inter x xC xU Uop, _⟩,
+    rw hC.closed.closure_subset_iff,
+    exact inter_subset_right _ _, },
+  split,
+  { refine ⟨hC.closure_nhds_inter y yC yV Vop, _⟩,
+    rw hC.closed.closure_subset_iff,
+    exact inter_subset_right _ _, },
+  apply disjoint.mono _ _ hUV; apply closure_mono; exact inter_subset_left _ _,
+end
+
+section kernel
+
+/-- The **Cantor-Bendixson Theorem**: Any closed subset of a second countable space
+can be written as the union of a countable set and a perfect set.-/
+theorem exists_countable_union_perfect_of_is_closed [second_countable_topology α]
+  (hclosed : is_closed C) :
+  ∃ V D : set α, (V.countable) ∧ (perfect D) ∧ (C = V ∪ D) :=
+begin
+  obtain ⟨b, bct, bnontrivial, bbasis⟩ := topological_space.exists_countable_basis α,
+  let v := {U ∈ b | (U ∩ C).countable},
+  let V := ⋃ U ∈ v, U,
+  let D := C \ V,
+  have Vct : (V ∩ C).countable,
+  { simp only [Union_inter, mem_sep_iff],
+    apply countable.bUnion,
+    { exact countable.mono (inter_subset_left _ _) bct, },
+    { exact inter_subset_right _ _, }, },
+  refine ⟨V ∩ C, D, Vct, ⟨_, _⟩, _⟩,
+  { refine hclosed.sdiff (is_open_bUnion (λ U, _)),
+    exact λ ⟨Ub, _⟩, is_topological_basis.is_open bbasis Ub, },
+  { rw preperfect_iff_nhds,
+    intros x xD E xE,
+    have : ¬ (E ∩ D).countable,
+    { intro h,
+      obtain ⟨U, hUb, xU, hU⟩ : ∃ U ∈ b, x ∈ U ∧ U ⊆ E,
+      { exact (is_topological_basis.mem_nhds_iff bbasis).mp xE, },
+      have hU_cnt : (U ∩ C).countable,
+      { apply @countable.mono _ _ ((E ∩ D) ∪ (V ∩ C)),
+        { rintros y ⟨yU, yC⟩,
+          by_cases y ∈ V,
+          { exact mem_union_right _ (mem_inter h yC), },
+          { exact mem_union_left _ (mem_inter (hU yU) ⟨yC, h⟩), }, },
+        exact countable.union h Vct, },
+      have : U ∈ v := ⟨hUb, hU_cnt⟩,
+      apply xD.2,
+      exact mem_bUnion this xU, },
+    by_contradiction h,
+    push_neg at h,
+    exact absurd (countable.mono h (set.countable_singleton _)) this, },
+  { rw [inter_comm, inter_union_diff], },
+end
+
+/-- Any uncountable closed set in a second countable space contains a nonempty perfect subset.-/
+theorem exists_perfect_nonempty_of_is_closed_of_not_countable [second_countable_topology α]
+  (hclosed : is_closed C) (hunc : ¬ C.countable) :
+  ∃ D : set α, perfect D ∧ D.nonempty ∧ D ⊆ C :=
+begin
+  rcases exists_countable_union_perfect_of_is_closed hclosed with ⟨V, D, Vct, Dperf, VD⟩,
+  refine ⟨D, ⟨Dperf, _⟩⟩,
+  split,
+  { rw nonempty_iff_ne_empty,
+    by_contradiction,
+    rw [h, union_empty] at VD,
+    rw VD at hunc,
+    contradiction, },
+  rw VD,
+  exact subset_union_right _ _,
+end
+
+end kernel
+end basic
+
+section cantor_inj_metric
+
+open function
+open_locale ennreal
+variables {α : Type*} [metric_space α] {C : set α} (hC : perfect C) {ε : ℝ≥0∞}
+include hC
+
+private lemma perfect.small_diam_aux (ε_pos : 0 < ε) {x : α} (xC : x ∈ C) :
+  let D := closure (emetric.ball x (ε / 2) ∩ C) in
+  perfect D ∧ D.nonempty ∧ D ⊆ C ∧ emetric.diam D ≤ ε :=
+begin
+  have : x ∈ (emetric.ball x (ε / 2)),
+  { apply emetric.mem_ball_self,
+    rw ennreal.div_pos_iff,
+    exact ⟨ne_of_gt ε_pos, by norm_num⟩, },
+  have := hC.closure_nhds_inter x xC this emetric.is_open_ball,
+  refine ⟨this.1, this.2, _, _⟩,
+  { rw is_closed.closure_subset_iff hC.closed,
+    apply inter_subset_right, },
+  rw emetric.diam_closure,
+  apply le_trans (emetric.diam_mono (inter_subset_left _ _)),
+  convert emetric.diam_ball,
+  rw [mul_comm, ennreal.div_mul_cancel]; norm_num,
+end
+
+variable (hnonempty : C.nonempty)
+include hnonempty
+
+/-- A refinement of `perfect.splitting` for metric spaces, where we also control
+the diameter of the new perfect sets. -/
+lemma perfect.small_diam_splitting (ε_pos : 0 < ε) : ∃ C₀ C₁ : set α,
+  (perfect C₀ ∧ C₀.nonempty ∧ C₀ ⊆ C ∧ emetric.diam C₀ ≤ ε) ∧
+  (perfect C₁ ∧ C₁.nonempty ∧ C₁ ⊆ C ∧ emetric.diam C₁ ≤ ε) ∧ disjoint C₀ C₁ :=
+begin
+  rcases hC.splitting hnonempty with ⟨D₀, D₁, ⟨perf0, non0, sub0⟩, ⟨perf1, non1, sub1⟩, hdisj⟩,
+  cases non0 with x₀ hx₀,
+  cases non1 with x₁ hx₁,
+  rcases perf0.small_diam_aux ε_pos hx₀ with ⟨perf0', non0', sub0', diam0⟩,
+  rcases perf1.small_diam_aux ε_pos hx₁ with ⟨perf1', non1', sub1', diam1⟩,
+  refine ⟨closure (emetric.ball x₀ (ε / 2) ∩ D₀), closure (emetric.ball x₁ (ε / 2) ∩ D₁),
+    ⟨perf0', non0', sub0'.trans sub0, diam0⟩, ⟨perf1', non1', sub1'.trans sub1, diam1⟩, _⟩,
+  apply disjoint.mono _ _ hdisj; assumption,
+end
+
+open cantor_scheme
+
+/-- Any nonempty perfect set in a complete metric space admits a continuous injection
+from the cantor space, `ℕ → bool`. -/
+theorem perfect.exists_nat_bool_injection [complete_space α] :
+  ∃ f : (ℕ → bool) → α, (range f) ⊆ C ∧ continuous f ∧ injective f :=
+begin
+  obtain ⟨u, -, upos', hu⟩ := exists_seq_strict_anti_tendsto' (zero_lt_one' ℝ≥0∞),
+  have upos := λ n, (upos' n).1,
+  let P := subtype (λ E : set α, perfect E ∧ E.nonempty),
+  choose C0 C1 h0 h1 hdisj using λ {C : set α} (hC : perfect C) (hnonempty : C.nonempty)
+    {ε : ℝ≥0∞} (hε : 0 < ε), hC.small_diam_splitting hnonempty hε,
+  let DP : list bool → P := λ l,
+  begin
+    induction l with a l ih, { exact ⟨C, ⟨hC, hnonempty⟩⟩ },
+    cases a,
+    { use C0 ih.property.1 ih.property.2 (upos l.length.succ),
+      exact ⟨(h0 _ _ _).1, (h0 _ _ _).2.1⟩, },
+    use C1 ih.property.1 ih.property.2 (upos l.length.succ),
+    exact ⟨(h1 _ _ _).1, (h1 _ _ _).2.1⟩,
+  end,
+  let D : list bool → set α := λ l, (DP l).val,
+  have hanti : closure_antitone D,
+  { refine antitone.closure_antitone _ (λ l, (DP l).property.1.closed),
+    intros l a,
+    cases a,
+    { exact (h0 _ _ _).2.2.1, },
+    exact (h1 _ _ _).2.2.1, },
+  have hdiam : vanishing_diam D,
+  { intro x,
+    apply tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds hu,
+    { simp },
+    rw eventually_at_top,
+    refine ⟨1, λ m (hm : 1 ≤ m), _⟩,
+    rw nat.one_le_iff_ne_zero at hm,
+    rcases nat.exists_eq_succ_of_ne_zero hm with ⟨n, rfl⟩,
+    dsimp,
+    cases (x n),
+    { convert (h0 _ _ _).2.2.2,
+      rw pi_nat.res_length },
+    convert (h1 _ _ _).2.2.2,
+    rw pi_nat.res_length, },
+  have hdisj' : cantor_scheme.disjoint D,
+  { rintros l (a | a) (b | b) hab; try { contradiction },
+    { exact hdisj _ _ _, },
+    exact (hdisj _ _ _).symm, },
+  have hdom : ∀ {x : ℕ → bool}, x ∈ (induced_map D).1 := λ x,
+    by simp [hanti.map_of_vanishing_diam hdiam (λ l, (DP l).property.2)],
+  refine ⟨λ x, (induced_map D).2 ⟨x, hdom⟩, _, _, _⟩,
+  { rintros y ⟨x, rfl⟩,
+    exact map_mem ⟨_, hdom⟩ 0, },
+  { continuity,
+    exact hdiam.map_continuous, },
+  intros x y hxy,
+  simpa only [← subtype.val_inj] using hdisj'.map_injective hxy,
+end
+
+end cantor_inj_metric
+
+/-- Any closed uncountable subset of a Polish space admits a continuous injection
+from the Cantor space `ℕ → bool`.-/
+theorem is_closed.exists_nat_bool_injection_of_not_countable {α : Type*}
+  [topological_space α] [polish_space α] {C : set α} (hC : is_closed C) (hunc : ¬ C.countable) :
+  ∃ f : (ℕ → bool) → α, (range f) ⊆ C ∧ continuous f ∧ function.injective f :=
+begin
+  letI := upgrade_polish_space α,
+  obtain ⟨D, hD, Dnonempty, hDC⟩ := exists_perfect_nonempty_of_is_closed_of_not_countable hC hunc,
+  obtain ⟨f, hfD, hf⟩ := hD.exists_nat_bool_injection Dnonempty,
+  exact ⟨f, hfD.trans hDC, hf⟩,
+end
diff --git a/src/topology/quasi_separated.lean b/src/topology/quasi_separated.lean
new file mode 100644
index 0000000000000..bbd56a645a78d
--- /dev/null
+++ b/src/topology/quasi_separated.lean
@@ -0,0 +1,125 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import topology.subset_properties
+import topology.separation
+import topology.noetherian_space
+
+/-!
+# Quasi-separated spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A topological space is quasi-separated if the intersections of any pairs of compact open subsets
+are still compact.
+Notable examples include spectral spaces, Noetherian spaces, and Hausdorff spaces.
+
+A non-example is the interval `[0, 1]` with doubled origin: the two copies of `[0, 1]` are compact
+open subsets, but their intersection `(0, 1]` is not.
+
+## Main results
+
+- `is_quasi_separated`: A subset `s` of a topological space is quasi-separated if the intersections
+of any pairs of compact open subsets of `s` are still compact.
+- `quasi_separated_space`: A topological space is quasi-separated if the intersections of any pairs
+of compact open subsets are still compact.
+- `quasi_separated_space.of_open_embedding`: If `f : α → β` is an open embedding, and `β` is
+  a quasi-separated space, then so is `α`.
+-/
+
+open topological_space
+
+variables {α β : Type*} [topological_space α] [topological_space β] {f : α → β}
+
+/-- A subset `s` of a topological space is quasi-separated if the intersections of any pairs of
+compact open subsets of `s` are still compact.
+
+Note that this is equivalent to `s` being a `quasi_separated_space` only when `s` is open. -/
+def is_quasi_separated (s : set α) : Prop :=
+∀ (U V : set α), U ⊆ s → is_open U → is_compact U → V ⊆ s →
+  is_open V → is_compact V → is_compact (U ∩ V)
+
+/-- A topological space is quasi-separated if the intersections of any pairs of compact open
+subsets are still compact. -/
+@[mk_iff]
+class quasi_separated_space (α : Type*) [topological_space α] : Prop :=
+(inter_is_compact : ∀ (U V : set α),
+  is_open U → is_compact U → is_open V → is_compact V → is_compact (U ∩ V))
+
+lemma is_quasi_separated_univ_iff {α : Type*} [topological_space α] :
+  is_quasi_separated (set.univ : set α) ↔ quasi_separated_space α :=
+begin
+  rw quasi_separated_space_iff,
+  simp [is_quasi_separated],
+end
+
+lemma is_quasi_separated_univ {α : Type*} [topological_space α] [quasi_separated_space α] :
+  is_quasi_separated (set.univ : set α) :=
+is_quasi_separated_univ_iff.mpr infer_instance
+
+lemma is_quasi_separated.image_of_embedding {s : set α}
+  (H : is_quasi_separated s) (h : embedding f) : is_quasi_separated (f '' s) :=
+begin
+  intros U V hU hU' hU'' hV hV' hV'',
+  convert (H (f ⁻¹' U) (f ⁻¹' V) _ (h.continuous.1 _ hU') _ _ (h.continuous.1 _ hV') _).image
+    h.continuous,
+  { symmetry,
+    rw [← set.preimage_inter, set.image_preimage_eq_inter_range, set.inter_eq_left_iff_subset],
+    exact (set.inter_subset_left _ _).trans (hU.trans (set.image_subset_range _ _)) },
+  { intros x hx, rw ← (h.inj.inj_on _).mem_image_iff (set.subset_univ _) trivial, exact hU hx },
+  { rw h.is_compact_iff_is_compact_image,
+    convert hU'',
+    rw [set.image_preimage_eq_inter_range, set.inter_eq_left_iff_subset],
+    exact hU.trans (set.image_subset_range _ _) },
+  { intros x hx, rw ← (h.inj.inj_on _).mem_image_iff (set.subset_univ _) trivial, exact hV hx },
+  { rw h.is_compact_iff_is_compact_image,
+    convert hV'',
+    rw [set.image_preimage_eq_inter_range, set.inter_eq_left_iff_subset],
+    exact hV.trans (set.image_subset_range _ _) }
+end
+
+lemma open_embedding.is_quasi_separated_iff (h : open_embedding f) {s : set α} :
+  is_quasi_separated s ↔ is_quasi_separated (f '' s) :=
+begin
+  refine ⟨λ hs, hs.image_of_embedding h.to_embedding, _⟩,
+  intros H U V hU hU' hU'' hV hV' hV'',
+  rw [h.to_embedding.is_compact_iff_is_compact_image, set.image_inter h.inj],
+  exact H (f '' U) (f '' V)
+    (set.image_subset _ hU) (h.is_open_map _ hU') (hU''.image h.continuous)
+    (set.image_subset _ hV) (h.is_open_map _ hV') (hV''.image h.continuous)
+end
+
+lemma is_quasi_separated_iff_quasi_separated_space (s : set α) (hs : is_open s) :
+  is_quasi_separated s ↔ quasi_separated_space s :=
+begin
+  rw ← is_quasi_separated_univ_iff,
+  convert hs.open_embedding_subtype_coe.is_quasi_separated_iff.symm; simp
+end
+
+lemma is_quasi_separated.of_subset {s t : set α} (ht : is_quasi_separated t) (h : s ⊆ t) :
+  is_quasi_separated s :=
+begin
+  intros U V hU hU' hU'' hV hV' hV'',
+  exact ht U V (hU.trans h) hU' hU'' (hV.trans h) hV' hV'',
+end
+
+@[priority 100]
+instance t2_space.to_quasi_separated_space [t2_space α] : quasi_separated_space α :=
+⟨λ U V hU hU' hV hV', hU'.inter hV'⟩
+
+@[priority 100]
+instance noetherian_space.to_quasi_separated_space [noetherian_space α] :
+  quasi_separated_space α :=
+⟨λ _ _ _ _ _ _, noetherian_space.is_compact _⟩
+
+lemma is_quasi_separated.of_quasi_separated_space (s : set α) [quasi_separated_space α] :
+  is_quasi_separated s :=
+is_quasi_separated_univ.of_subset (set.subset_univ _)
+
+lemma quasi_separated_space.of_open_embedding (h : open_embedding f) [quasi_separated_space β] :
+  quasi_separated_space α :=
+is_quasi_separated_univ_iff.mp
+  (h.is_quasi_separated_iff.mpr $ is_quasi_separated.of_quasi_separated_space _)
diff --git a/src/topology/semicontinuous.lean b/src/topology/semicontinuous.lean
index bec1d2dd141c2..a00f7b288c64e 100644
--- a/src/topology/semicontinuous.lean
+++ b/src/topology/semicontinuous.lean
@@ -4,13 +4,15 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
 import algebra.indicator_function
-import topology.algebra.group
 import topology.continuous_on
 import topology.instances.ennreal
 
 /-!
 # Semicontinuous maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A function `f` from a topological space `α` to an ordered space `β` is lower semicontinuous at a
 point `x` if, for any `y < f x`, for any `x'` close enough to `x`, one has `f x' > y`. In other
 words, `f` can jump up, but it can not jump down.
@@ -52,8 +54,8 @@ ones for lower semicontinuous functions using `order_dual`.
 
 -/
 
-open_locale topological_space big_operators ennreal
-open set
+open_locale topology big_operators ennreal
+open set function filter
 
 variables {α : Type*} [topological_space α] {β : Type*} [preorder β]
 {f g : α → β} {x : α} {s t : set α} {y z : β}
@@ -226,16 +228,30 @@ end
 
 /-! #### Relationship with continuity -/
 
-theorem lower_semicontinuous_iff_is_open :
+theorem lower_semicontinuous_iff_is_open_preimage :
   lower_semicontinuous f ↔ ∀ y, is_open (f ⁻¹' (Ioi y)) :=
 ⟨λ H y, is_open_iff_mem_nhds.2 (λ x hx, H x y hx), λ H x y y_lt, is_open.mem_nhds (H y) y_lt⟩
 
 lemma lower_semicontinuous.is_open_preimage (hf : lower_semicontinuous f) (y : β) :
   is_open (f ⁻¹' (Ioi y)) :=
-lower_semicontinuous_iff_is_open.1 hf y
+lower_semicontinuous_iff_is_open_preimage.1 hf y
 
 section
-variables {γ : Type*} [linear_order γ] [topological_space γ] [order_topology γ]
+variables {γ : Type*} [linear_order γ]
+
+theorem lower_semicontinuous_iff_is_closed_preimage {f : α → γ} :
+  lower_semicontinuous f ↔ ∀ y, is_closed (f ⁻¹' (Iic y)) :=
+begin
+  rw lower_semicontinuous_iff_is_open_preimage,
+  congrm (∀ y, (_ : Prop)),
+  rw [← is_open_compl_iff, ← preimage_compl, compl_Iic]
+end
+
+lemma lower_semicontinuous.is_closed_preimage {f : α → γ} (hf : lower_semicontinuous f) (y : γ) :
+  is_closed (f ⁻¹' (Iic y)) :=
+lower_semicontinuous_iff_is_closed_preimage.1 hf y
+
+variables [topological_space γ] [order_topology γ]
 
 lemma continuous_within_at.lower_semicontinuous_within_at {f : α → γ}
   (h : continuous_within_at f s x) : lower_semicontinuous_within_at f s x :=
@@ -477,49 +493,78 @@ end
 /-! #### Supremum -/
 
 section
-variables {ι : Sort*} {δ : Type*} [complete_linear_order δ]
+variables {ι : Sort*} {δ δ' : Type*} [complete_linear_order δ]
+  [conditionally_complete_linear_order δ']
 
-lemma lower_semicontinuous_within_at_supr {f : ι → α → δ}
+lemma lower_semicontinuous_within_at_csupr {f : ι → α → δ'}
+  (bdd : ∀ᶠ y in 𝓝[s] x, bdd_above (range $ λ i, f i y))
   (h : ∀ i, lower_semicontinuous_within_at (f i) s x) :
   lower_semicontinuous_within_at (λ x', ⨆ i, f i x') s x :=
 begin
-  assume y hy,
-  rcases lt_supr_iff.1 hy with ⟨i, hi⟩,
-  filter_upwards [h i y hi] with _ hx' using lt_supr_iff.2 ⟨i, hx'⟩,
+  casesI is_empty_or_nonempty ι,
+  { simpa only [supr_of_empty'] using lower_semicontinuous_within_at_const },
+  { assume y hy,
+    rcases exists_lt_of_lt_csupr hy with ⟨i, hi⟩,
+    filter_upwards [h i y hi, bdd] with y hy hy' using hy.trans_le (le_csupr hy' i) }
 end
 
+lemma lower_semicontinuous_within_at_supr {f : ι → α → δ}
+  (h : ∀ i, lower_semicontinuous_within_at (f i) s x) :
+  lower_semicontinuous_within_at (λ x', ⨆ i, f i x') s x :=
+lower_semicontinuous_within_at_csupr (by simp) h
+
 lemma lower_semicontinuous_within_at_bsupr {p : ι → Prop} {f : Π i (h : p i), α → δ}
   (h : ∀ i hi, lower_semicontinuous_within_at (f i hi) s x) :
   lower_semicontinuous_within_at (λ x', ⨆ i hi, f i hi x') s x :=
 lower_semicontinuous_within_at_supr $ λ i, lower_semicontinuous_within_at_supr $ λ hi, h i hi
 
-lemma lower_semicontinuous_at_supr {f : ι → α → δ}
+lemma lower_semicontinuous_at_csupr {f : ι → α → δ'}
+  (bdd : ∀ᶠ y in 𝓝 x, bdd_above (range $ λ i, f i y))
   (h : ∀ i, lower_semicontinuous_at (f i) x) :
   lower_semicontinuous_at (λ x', ⨆ i, f i x') x :=
 begin
   simp_rw [← lower_semicontinuous_within_at_univ_iff] at *,
-  exact lower_semicontinuous_within_at_supr h
+  rw ← nhds_within_univ at bdd,
+  exact lower_semicontinuous_within_at_csupr bdd h
 end
 
+lemma lower_semicontinuous_at_supr {f : ι → α → δ}
+  (h : ∀ i, lower_semicontinuous_at (f i) x) :
+  lower_semicontinuous_at (λ x', ⨆ i, f i x') x :=
+lower_semicontinuous_at_csupr (by simp) h
+
 lemma lower_semicontinuous_at_bsupr {p : ι → Prop} {f : Π i (h : p i), α → δ}
   (h : ∀ i hi, lower_semicontinuous_at (f i hi) x) :
   lower_semicontinuous_at (λ x', ⨆ i hi, f i hi x') x :=
 lower_semicontinuous_at_supr $ λ i, lower_semicontinuous_at_supr $ λ hi, h i hi
 
+lemma lower_semicontinuous_on_csupr {f : ι → α → δ'}
+  (bdd : ∀ x ∈ s, bdd_above (range $ λ i, f i x))
+  (h : ∀ i, lower_semicontinuous_on (f i) s) :
+  lower_semicontinuous_on (λ x', ⨆ i, f i x') s :=
+λ x hx, lower_semicontinuous_within_at_csupr (eventually_nhds_within_of_forall bdd)
+  (λ i, h i x hx)
+
 lemma lower_semicontinuous_on_supr {f : ι → α → δ}
   (h : ∀ i, lower_semicontinuous_on (f i) s) :
   lower_semicontinuous_on (λ x', ⨆ i, f i x') s :=
-λ x hx, lower_semicontinuous_within_at_supr (λ i, h i x hx)
+lower_semicontinuous_on_csupr (by simp) h
 
 lemma lower_semicontinuous_on_bsupr {p : ι → Prop} {f : Π i (h : p i), α → δ}
   (h : ∀ i hi, lower_semicontinuous_on (f i hi) s) :
   lower_semicontinuous_on (λ x', ⨆ i hi, f i hi x') s :=
 lower_semicontinuous_on_supr $ λ i, lower_semicontinuous_on_supr $ λ hi, h i hi
 
+lemma lower_semicontinuous_csupr {f : ι → α → δ'}
+  (bdd : ∀ x, bdd_above (range $ λ i, f i x))
+  (h : ∀ i, lower_semicontinuous (f i)) :
+  lower_semicontinuous (λ x', ⨆ i, f i x') :=
+λ x, lower_semicontinuous_at_csupr (eventually_of_forall bdd) (λ i, h i x)
+
 lemma lower_semicontinuous_supr {f : ι → α → δ}
   (h : ∀ i, lower_semicontinuous (f i)) :
   lower_semicontinuous (λ x', ⨆ i, f i x') :=
-λ x, lower_semicontinuous_at_supr (λ i, h i x)
+lower_semicontinuous_csupr (by simp) h
 
 lemma lower_semicontinuous_bsupr {p : ι → Prop} {f : Π i (h : p i), α → δ}
   (h : ∀ i hi, lower_semicontinuous (f i hi)) :
@@ -665,16 +710,30 @@ end
 
 /-! #### Relationship with continuity -/
 
-theorem upper_semicontinuous_iff_is_open :
+theorem upper_semicontinuous_iff_is_open_preimage :
   upper_semicontinuous f ↔ ∀ y, is_open (f ⁻¹' (Iio y)) :=
 ⟨λ H y, is_open_iff_mem_nhds.2 (λ x hx, H x y hx), λ H x y y_lt, is_open.mem_nhds (H y) y_lt⟩
 
 lemma upper_semicontinuous.is_open_preimage (hf : upper_semicontinuous f) (y : β) :
   is_open (f ⁻¹' (Iio y)) :=
-upper_semicontinuous_iff_is_open.1 hf y
+upper_semicontinuous_iff_is_open_preimage.1 hf y
 
 section
-variables {γ : Type*} [linear_order γ] [topological_space γ] [order_topology γ]
+variables {γ : Type*} [linear_order γ]
+
+theorem upper_semicontinuous_iff_is_closed_preimage {f : α → γ} :
+  upper_semicontinuous f ↔ ∀ y, is_closed (f ⁻¹' (Ici y)) :=
+begin
+  rw upper_semicontinuous_iff_is_open_preimage,
+  congrm (∀ y, (_ : Prop)),
+  rw [← is_open_compl_iff, ← preimage_compl, compl_Ici]
+end
+
+lemma upper_semicontinuous.is_closed_preimage {f : α → γ} (hf : upper_semicontinuous f) (y : γ) :
+  is_closed (f ⁻¹' (Ici y)) :=
+upper_semicontinuous_iff_is_closed_preimage.1 hf y
+
+variables [topological_space γ] [order_topology γ]
 
 lemma continuous_within_at.upper_semicontinuous_within_at {f : α → γ}
   (h : continuous_within_at f s x) : upper_semicontinuous_within_at f s x :=
@@ -846,7 +905,14 @@ end
 /-! #### Infimum -/
 
 section
-variables {ι : Sort*} {δ : Type*} [complete_linear_order δ]
+variables {ι : Sort*} {δ δ' : Type*} [complete_linear_order δ]
+  [conditionally_complete_linear_order δ']
+
+lemma upper_semicontinuous_within_at_cinfi {f : ι → α → δ'}
+  (bdd : ∀ᶠ y in 𝓝[s] x, bdd_below (range $ λ i, f i y))
+  (h : ∀ i, upper_semicontinuous_within_at (f i) s x) :
+  upper_semicontinuous_within_at (λ x', ⨅ i, f i x') s x :=
+@lower_semicontinuous_within_at_csupr α _ x s ι δ'ᵒᵈ _ f bdd h
 
 lemma upper_semicontinuous_within_at_infi {f : ι → α → δ}
   (h : ∀ i, upper_semicontinuous_within_at (f i) s x) :
@@ -858,6 +924,12 @@ lemma upper_semicontinuous_within_at_binfi {p : ι → Prop} {f : Π i (h : p i)
   upper_semicontinuous_within_at (λ x', ⨅ i hi, f i hi x') s x :=
 upper_semicontinuous_within_at_infi $ λ i, upper_semicontinuous_within_at_infi $ λ hi, h i hi
 
+lemma upper_semicontinuous_at_cinfi {f : ι → α → δ'}
+  (bdd : ∀ᶠ y in 𝓝 x, bdd_below (range $ λ i, f i y))
+  (h : ∀ i, upper_semicontinuous_at (f i) x) :
+  upper_semicontinuous_at (λ x', ⨅ i, f i x') x :=
+@lower_semicontinuous_at_csupr α _ x ι δ'ᵒᵈ _ f bdd h
+
 lemma upper_semicontinuous_at_infi {f : ι → α → δ}
   (h : ∀ i, upper_semicontinuous_at (f i) x) :
   upper_semicontinuous_at (λ x', ⨅ i, f i x') x :=
@@ -868,6 +940,12 @@ lemma upper_semicontinuous_at_binfi {p : ι → Prop} {f : Π i (h : p i), α 
   upper_semicontinuous_at (λ x', ⨅ i hi, f i hi x') x :=
 upper_semicontinuous_at_infi $ λ i, upper_semicontinuous_at_infi $ λ hi, h i hi
 
+lemma upper_semicontinuous_on_cinfi {f : ι → α → δ'}
+  (bdd : ∀ x ∈ s, bdd_below (range $ λ i, f i x))
+  (h : ∀ i, upper_semicontinuous_on (f i) s) :
+  upper_semicontinuous_on (λ x', ⨅ i, f i x') s :=
+λ x hx, upper_semicontinuous_within_at_cinfi (eventually_nhds_within_of_forall bdd) (λ i, h i x hx)
+
 lemma upper_semicontinuous_on_infi {f : ι → α → δ}
   (h : ∀ i, upper_semicontinuous_on (f i) s) :
   upper_semicontinuous_on (λ x', ⨅ i, f i x') s :=
@@ -878,6 +956,12 @@ lemma upper_semicontinuous_on_binfi {p : ι → Prop} {f : Π i (h : p i), α 
   upper_semicontinuous_on (λ x', ⨅ i hi, f i hi x') s :=
 upper_semicontinuous_on_infi $ λ i, upper_semicontinuous_on_infi $ λ hi, h i hi
 
+lemma upper_semicontinuous_cinfi {f : ι → α → δ'}
+  (bdd : ∀ x, bdd_below (range $ λ i, f i x))
+  (h : ∀ i, upper_semicontinuous (f i)) :
+  upper_semicontinuous (λ x', ⨅ i, f i x') :=
+λ x, upper_semicontinuous_at_cinfi (eventually_of_forall bdd) (λ i, h i x)
+
 lemma upper_semicontinuous_infi {f : ι → α → δ}
   (h : ∀ i, upper_semicontinuous (f i)) :
   upper_semicontinuous (λ x', ⨅ i, f i x') :=
diff --git a/src/topology/separation.lean b/src/topology/separation.lean
index a92dfb113c69c..c5fc7532ce7e7 100644
--- a/src/topology/separation.lean
+++ b/src/topology/separation.lean
@@ -6,16 +6,21 @@ Authors: Johannes Hölzl, Mario Carneiro
 import topology.subset_properties
 import topology.connected
 import topology.nhds_set
+import topology.inseparable
 
 /-!
 # Separation properties of topological spaces.
 
-This file defines the predicate `separated`, and common separation axioms
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines the predicate `separated_nhds`, and common separation axioms
 (under the Kolmogorov classification).
 
 ## Main definitions
 
-* `separated`: Two `set`s are separated if they are contained in disjoint open sets.
+* `separated_nhds`: Two `set`s are separated by neighbourhoods if they are contained in disjoint
+  open sets.
 * `t0_space`: A T₀/Kolmogorov space is a space where, for every two points `x ≠ y`,
   there is an open set that contains one, but not the other.
 * `t1_space`: A T₁/Fréchet space is a space where every singleton set is closed.
@@ -25,12 +30,12 @@ This file defines the predicate `separated`, and common separation axioms
   there is two disjoint open sets, one containing `x`, and the other `y`.
 * `t2_5_space`: A T₂.₅/Urysohn space is a space where, for every two points `x ≠ y`,
   there is two open sets, one containing `x`, and the other `y`, whose closures are disjoint.
-* `regular_space`: A T₃ space (sometimes referred to as regular, but authors vary on
-  whether this includes T₂; `mathlib` does), is one where given any closed `C` and `x ∉ C`,
+* `t3_space`: A T₃ space, is one where given any closed `C` and `x ∉ C`,
   there is disjoint open sets containing `x` and `C` respectively. In `mathlib`, T₃ implies T₂.₅.
 * `normal_space`: A T₄ space (sometimes referred to as normal, but authors vary on
   whether this includes T₂; `mathlib` does), is one where given two disjoint closed sets,
   we can find two open sets that separate them. In `mathlib`, T₄ implies T₃.
+* `t5_space`: A T₅ space, also known as a *completely normal Hausdorff space*
 
 ## Main results
 
@@ -51,14 +56,15 @@ This file defines the predicate `separated`, and common separation axioms
 * `t2_iff_nhds`: A space is T₂ iff the neighbourhoods of distinct points generate the bottom filter.
 * `t2_iff_is_closed_diagonal`: A space is T₂ iff the `diagonal` of `α` (that is, the set of all
   points of the form `(a, a) : α × α`) is closed under the product topology.
-* `finset_disjoint_finset_opens_of_t2`: Any two disjoint finsets are `separated`.
+* `finset_disjoint_finset_opens_of_t2`: Any two disjoint finsets are `separated_nhds`.
 * Most topological constructions preserve Hausdorffness;
   these results are part of the typeclass inference system (e.g. `embedding.t2_space`)
 * `set.eq_on.closure`: If two functions are equal on some set `s`, they are equal on its closure.
 * `is_compact.is_closed`: All compact sets are closed.
 * `locally_compact_of_compact_nhds`: If every point has a compact neighbourhood,
   then the space is locally compact.
-* `tot_sep_of_zero_dim`: If `α` has a clopen basis, it is a `totally_separated_space`.
+* `totally_separated_space_of_t1_of_basis_clopen`: If `α` has a clopen basis, then
+  it is a `totally_separated_space`.
 * `loc_compact_t2_tot_disc_iff_tot_sep`: A locally compact T₂ space is totally disconnected iff
   it is totally separated.
 
@@ -76,20 +82,13 @@ If the space is also compact:
 * `disjoint_nested_nhds`: Given two points `x ≠ y`, we can find neighbourhoods `x ∈ V₁ ⊆ U₁` and
   `y ∈ V₂ ⊆ U₂`, with the `Vₖ` closed and the `Uₖ` open, such that the `Uₖ` are disjoint.
 
-### Discrete spaces
-
-* `discrete_topology_iff_nhds`: Discrete topological spaces are those whose neighbourhood
-  filters are the `pure` filter (which is the principal filter at a singleton).
-* `induced_bot`/`discrete_topology_induced`: The pullback of the discrete topology
-  under an inclusion is the discrete topology.
-
 ## References
 
 https://en.wikipedia.org/wiki/Separation_axiom
 -/
 
-open set filter topological_space
-open_locale topological_space filter classical
+open function set filter topological_space
+open_locale topology filter classical
 
 universes u v
 variables {α : Type u} {β : Type v} [topological_space α]
@@ -97,104 +96,141 @@ variables {α : Type u} {β : Type v} [topological_space α]
 section separation
 
 /--
-`separated` is a predicate on pairs of sub`set`s of a topological space.  It holds if the two
+`separated_nhds` is a predicate on pairs of sub`set`s of a topological space.  It holds if the two
 sub`set`s are contained in disjoint open sets.
 -/
-def separated : set α → set α → Prop :=
+def separated_nhds : set α → set α → Prop :=
   λ (s t : set α), ∃ U V : (set α), (is_open U) ∧ is_open V ∧
   (s ⊆ U) ∧ (t ⊆ V) ∧ disjoint U V
 
-namespace separated
+lemma separated_nhds_iff_disjoint {s t : set α} :
+  separated_nhds s t ↔ disjoint (𝓝ˢ s) (𝓝ˢ t) :=
+by simp only [(has_basis_nhds_set s).disjoint_iff (has_basis_nhds_set t), separated_nhds,
+  exists_prop, ← exists_and_distrib_left, and.assoc, and.comm, and.left_comm]
+
+namespace separated_nhds
 
-open separated
+variables {s s₁ s₂ t t₁ t₂ u : set α}
 
-@[symm] lemma symm {s t : set α} : separated s t → separated t s :=
+@[symm] lemma symm : separated_nhds s t → separated_nhds t s :=
 λ ⟨U, V, oU, oV, aU, bV, UV⟩, ⟨V, U, oV, oU, bV, aU, disjoint.symm UV⟩
 
-lemma comm (s t : set α) : separated s t ↔ separated t s :=
-⟨symm, symm⟩
+lemma comm (s t : set α) : separated_nhds s t ↔ separated_nhds t s := ⟨symm, symm⟩
 
-lemma preimage [topological_space β] {f : α → β} {s t : set β} (h : separated s t)
-  (hf : continuous f) : separated (f ⁻¹' s) (f ⁻¹' t) :=
+lemma preimage [topological_space β] {f : α → β} {s t : set β} (h : separated_nhds s t)
+  (hf : continuous f) : separated_nhds (f ⁻¹' s) (f ⁻¹' t) :=
 let ⟨U, V, oU, oV, sU, tV, UV⟩ := h in
 ⟨f ⁻¹' U, f ⁻¹' V, oU.preimage hf, oV.preimage hf, preimage_mono sU, preimage_mono tV,
   UV.preimage f⟩
 
-protected lemma disjoint {s t : set α} (h : separated s t) : disjoint s t :=
+protected lemma disjoint (h : separated_nhds s t) : disjoint s t :=
 let ⟨U, V, hU, hV, hsU, htV, hd⟩ := h in hd.mono hsU htV
 
-lemma disjoint_closure_left {s t : set α} (h : separated s t) : disjoint (closure s) t :=
+lemma disjoint_closure_left (h : separated_nhds s t) : disjoint (closure s) t :=
 let ⟨U, V, hU, hV, hsU, htV, hd⟩ := h
 in (hd.closure_left hV).mono (closure_mono hsU) htV
 
-lemma disjoint_closure_right {s t : set α} (h : separated s t) : disjoint s (closure t) :=
+lemma disjoint_closure_right (h : separated_nhds s t) : disjoint s (closure t) :=
 h.symm.disjoint_closure_left.symm
 
-lemma empty_right (a : set α) : separated a ∅ :=
+lemma empty_right (s : set α) : separated_nhds s ∅ :=
 ⟨_, _, is_open_univ, is_open_empty, λ a h, mem_univ a, λ a h, by cases h, disjoint_empty _⟩
 
-lemma empty_left (a : set α) : separated ∅ a :=
+lemma empty_left (s : set α) : separated_nhds ∅ s :=
 (empty_right _).symm
 
-lemma mono {s₁ s₂ t₁ t₂ : set α} (h : separated s₂ t₂) (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) :
-  separated s₁ t₁ :=
+lemma mono (h : separated_nhds s₂ t₂) (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : separated_nhds s₁ t₁ :=
 let ⟨U, V, hU, hV, hsU, htV, hd⟩ := h in ⟨U, V, hU, hV, hs.trans hsU, ht.trans htV, hd⟩
 
-lemma union_left {a b c : set α} : separated a c → separated b c → separated (a ∪ b) c :=
-λ ⟨U, V, oU, oV, aU, bV, UV⟩ ⟨W, X, oW, oX, aW, bX, WX⟩,
-  ⟨U ∪ W, V ∩ X, is_open.union oU oW, is_open.inter oV oX,
-    union_subset_union aU aW, subset_inter bV bX, set.disjoint_union_left.mpr
-    ⟨disjoint_of_subset_right (inter_subset_left _ _) UV,
-      disjoint_of_subset_right (inter_subset_right _ _) WX⟩⟩
+lemma union_left : separated_nhds s u → separated_nhds t u → separated_nhds (s ∪ t) u :=
+by simpa only [separated_nhds_iff_disjoint, nhds_set_union, disjoint_sup_left] using and.intro
 
-lemma union_right {a b c : set α} (ab : separated a b) (ac : separated a c) :
-  separated a (b ∪ c) :=
-(ab.symm.union_left ac.symm).symm
+lemma union_right (ht : separated_nhds s t) (hu : separated_nhds s u) :
+  separated_nhds s (t ∪ u) :=
+(ht.symm.union_left hu.symm).symm
 
-end separated
+end separated_nhds
 
-/-- A T₀ space, also known as a Kolmogorov space, is a topological space
-  where for every pair `x ≠ y`, there is an open set containing one but not the other. -/
+/-- A T₀ space, also known as a Kolmogorov space, is a topological space such that for every pair
+`x ≠ y`, there is an open set containing one but not the other. We formulate the definition in terms
+of the `inseparable` relation.  -/
 class t0_space (α : Type u) [topological_space α] : Prop :=
-(t0 : ∀ x y, x ≠ y → ∃ U:set α, is_open U ∧ (xor (x ∈ U) (y ∈ U)))
+(t0 : ∀ ⦃x y : α⦄, inseparable x y → x = y)
+
+lemma t0_space_iff_inseparable (α : Type u) [topological_space α] :
+  t0_space α ↔ ∀ (x y : α), inseparable x y → x = y :=
+⟨λ ⟨h⟩, h, λ h, ⟨h⟩⟩
+
+lemma t0_space_iff_not_inseparable (α : Type u) [topological_space α] :
+  t0_space α ↔ ∀ (x y : α), x ≠ y → ¬inseparable x y :=
+by simp only [t0_space_iff_inseparable, ne.def, not_imp_not]
+
+lemma inseparable.eq [t0_space α] {x y : α} (h : inseparable x y) : x = y :=
+t0_space.t0 h
+
+protected lemma inducing.injective [topological_space β] [t0_space α] {f : α → β}
+  (hf : inducing f) : injective f :=
+λ x y h, inseparable.eq $ hf.inseparable_iff.1 $ h ▸ inseparable.refl _
+
+protected lemma inducing.embedding [topological_space β] [t0_space α] {f : α → β}
+  (hf : inducing f) : embedding f :=
+⟨hf, hf.injective⟩
+
+lemma embedding_iff_inducing [topological_space β] [t0_space α] {f : α → β} :
+  embedding f ↔ inducing f :=
+⟨embedding.to_inducing, inducing.embedding⟩
+
+lemma t0_space_iff_nhds_injective (α : Type u) [topological_space α] :
+  t0_space α ↔ injective (𝓝 : α → filter α) :=
+t0_space_iff_inseparable α
+
+lemma nhds_injective [t0_space α] : injective (𝓝 : α → filter α) :=
+(t0_space_iff_nhds_injective α).1 ‹_›
+
+lemma inseparable_iff_eq [t0_space α] {x y : α} : inseparable x y ↔ x = y :=
+nhds_injective.eq_iff
 
-lemma t0_space_def (α : Type u) [topological_space α] :
+@[simp] lemma nhds_eq_nhds_iff [t0_space α] {a b : α} : 𝓝 a = 𝓝 b ↔ a = b :=
+nhds_injective.eq_iff
+
+@[simp] lemma inseparable_eq_eq [t0_space α] : inseparable = @eq α :=
+funext₂ $ λ x y, propext inseparable_iff_eq
+
+lemma t0_space_iff_exists_is_open_xor_mem (α : Type u) [topological_space α] :
   t0_space α ↔ ∀ x y, x ≠ y → ∃ U:set α, is_open U ∧ (xor (x ∈ U) (y ∈ U)) :=
-by { split, apply @t0_space.t0, apply t0_space.mk }
+by simp only [t0_space_iff_not_inseparable, xor_iff_not_iff, not_forall, exists_prop,
+  inseparable_iff_forall_open]
 
-/-- Two points are topologically indistinguishable if no open set separates them. -/
-def indistinguishable {α : Type u} [topological_space α] (x y : α) : Prop :=
-∀ (U : set α) (hU : is_open U), x ∈ U ↔ y ∈ U
+lemma exists_is_open_xor_mem [t0_space α] {x y : α} (h : x ≠ y) :
+  ∃ U : set α, is_open U ∧ xor (x ∈ U) (y ∈ U) :=
+(t0_space_iff_exists_is_open_xor_mem α).1 ‹_› x y h
 
-lemma t0_space_iff_distinguishable (α : Type u) [topological_space α] :
-  t0_space α ↔ ∀ (x y : α), x ≠ y → ¬ indistinguishable x y :=
-begin
-  delta indistinguishable,
-  rw t0_space_def,
-  push_neg,
-  simp_rw xor_iff_not_iff,
-end
+/-- Specialization forms a partial order on a t0 topological space. -/
+def specialization_order (α : Type*) [topological_space α] [t0_space α] : partial_order α :=
+{ .. specialization_preorder α,
+  .. partial_order.lift (order_dual.to_dual ∘ 𝓝) nhds_injective }
 
-lemma indistinguishable_iff_closed {α : Type u} [topological_space α] (x y : α) :
-  indistinguishable x y ↔ ∀ (U : set α) (hU : is_closed U), x ∈ U ↔ y ∈ U :=
-⟨λ h U hU, not_iff_not.mp (h _ hU.1), λ h U hU, not_iff_not.mp (h _ (is_closed_compl_iff.mpr hU))⟩
+instance : t0_space (separation_quotient α) :=
+⟨λ x' y', quotient.induction_on₂' x' y' $
+  λ x y h, separation_quotient.mk_eq_mk.2 $ separation_quotient.inducing_mk.inseparable_iff.1 h⟩
 
-lemma indistinguishable_iff_closure {α : Type u} [topological_space α] (x y : α) :
-  indistinguishable x y ↔ x ∈ closure ({y} : set α) ∧ y ∈ closure ({x} : set α) :=
+theorem minimal_nonempty_closed_subsingleton [t0_space α] {s : set α} (hs : is_closed s)
+  (hmin : ∀ t ⊆ s, t.nonempty → is_closed t → t = s) :
+  s.subsingleton :=
 begin
-  rw indistinguishable_iff_closed,
-  exact ⟨λ h, ⟨(h _ is_closed_closure).mpr (subset_closure $ set.mem_singleton y),
-      (h _ is_closed_closure).mp (subset_closure $ set.mem_singleton x)⟩,
-    λ h U hU, ⟨λ hx, (is_closed.closure_subset_iff hU).mpr (set.singleton_subset_iff.mpr hx) h.2,
-      λ hy, (is_closed.closure_subset_iff hU).mpr (set.singleton_subset_iff.mpr hy) h.1⟩⟩
+  refine λ x hx y hy, of_not_not (λ hxy, _),
+  rcases exists_is_open_xor_mem hxy with ⟨U, hUo, hU⟩,
+  wlog h : x ∈ U ∧ y ∉ U,
+  { exact this hmin y hy x hx (ne.symm hxy) U hUo hU.symm (hU.resolve_left h), },
+  cases h with hxU hyU,
+  have : s \ U = s := hmin (s \ U) (diff_subset _ _) ⟨y, hy, hyU⟩ (hs.sdiff hUo),
+  exact (this.symm.subset hx).2 hxU
 end
 
-lemma subtype_indistinguishable_iff {α : Type u} [topological_space α] {U : set α} (x y : U) :
-  indistinguishable x y ↔ indistinguishable (x : α) y :=
-by { simp_rw [indistinguishable_iff_closure, closure_subtype, image_singleton] }
-
-lemma indistinguishable.eq [hα : t0_space α] {x y : α} (h : indistinguishable x y) : x = y :=
-not_imp_not.mp ((t0_space_iff_distinguishable _).mp hα x y) h
+theorem minimal_nonempty_closed_eq_singleton [t0_space α] {s : set α} (hs : is_closed s)
+  (hne : s.nonempty) (hmin : ∀ t ⊆ s, t.nonempty → is_closed t → t = s) :
+  ∃ x, s = {x} :=
+exists_eq_singleton_iff_nonempty_subsingleton.2 ⟨hne, minimal_nonempty_closed_subsingleton hs hmin⟩
 
 /-- Given a closed set `S` in a compact T₀ space,
 there is some `x ∈ S` such that `{x}` is closed. -/
@@ -203,69 +239,53 @@ theorem is_closed.exists_closed_singleton {α : Type*} [topological_space α]
   ∃ (x : α), x ∈ S ∧ is_closed ({x} : set α) :=
 begin
   obtain ⟨V, Vsub, Vne, Vcls, hV⟩ := hS.exists_minimal_nonempty_closed_subset hne,
-  by_cases hnt : ∃ (x y : α) (hx : x ∈ V) (hy : y ∈ V), x ≠ y,
-  { exfalso,
-    obtain ⟨x, y, hx, hy, hne⟩ := hnt,
-    obtain ⟨U, hU, hsep⟩ := t0_space.t0 _ _ hne,
-    have : ∀ (z w : α) (hz : z ∈ V) (hw : w ∈ V) (hz' : z ∈ U) (hw' : ¬ w ∈ U), false,
-    { intros z w hz hw hz' hw',
-      have uvne : (V ∩ Uᶜ).nonempty,
-      { use w, simp only [hw, hw', set.mem_inter_eq, not_false_iff, and_self, set.mem_compl_eq], },
-      specialize hV (V ∩ Uᶜ) (set.inter_subset_left _ _) uvne
-        (is_closed.inter Vcls (is_closed_compl_iff.mpr hU)),
-      have : V ⊆ Uᶜ,
-      { rw ←hV, exact set.inter_subset_right _ _ },
-      exact this hz hz', },
-    cases hsep,
-    { exact this x y hx hy hsep.1 hsep.2 },
-    { exact this y x hy hx hsep.1 hsep.2 } },
-  { push_neg at hnt,
-    obtain ⟨z, hz⟩ := Vne,
-    refine ⟨z, Vsub hz, _⟩,
-    convert Vcls,
-    ext,
-    simp only [set.mem_singleton_iff, set.mem_compl_eq],
-    split,
-    { rintro rfl, exact hz, },
-    { exact λ hx, hnt x z hx hz, }, },
+  rcases minimal_nonempty_closed_eq_singleton Vcls Vne hV with ⟨x, rfl⟩,
+  exact ⟨x, Vsub (mem_singleton x), Vcls⟩
 end
 
-/-- Given an open `finset` `S` in a T₀ space, there is some `x ∈ S` such that `{x}` is open. -/
-theorem exists_open_singleton_of_open_finset [t0_space α] (s : finset α) (sne : s.nonempty)
-  (hso : is_open (s : set α)) :
-  ∃ x ∈ s, is_open ({x} : set α):=
+theorem minimal_nonempty_open_subsingleton [t0_space α] {s : set α} (hs : is_open s)
+  (hmin : ∀ t ⊆ s, t.nonempty → is_open t → t = s) :
+  s.subsingleton :=
 begin
-  induction s using finset.strong_induction_on with s ihs,
-  by_cases hs : set.subsingleton (s : set α),
-  { rcases sne with ⟨x, hx⟩,
-    refine ⟨x, hx, _⟩,
-    have : (s : set α) = {x}, from hs.eq_singleton_of_mem hx,
-    rwa this at hso },
-  { dunfold set.subsingleton at hs,
-    push_neg at hs,
-    rcases hs with ⟨x, hx, y, hy, hxy⟩,
-    rcases t0_space.t0 x y hxy with ⟨U, hU, hxyU⟩,
-    wlog H : x ∈ U ∧ y ∉ U := hxyU using [x y, y x],
-    obtain ⟨z, hzs, hz⟩ : ∃ z ∈ s.filter (λ z, z ∈ U), is_open ({z} : set α),
-    { refine ihs _ (finset.filter_ssubset.2 ⟨y, hy, H.2⟩) ⟨x, finset.mem_filter.2 ⟨hx, H.1⟩⟩ _,
-      rw [finset.coe_filter],
-      exact is_open.inter hso hU },
-    exact ⟨z, (finset.mem_filter.1 hzs).1, hz⟩ }
+  refine λ x hx y hy, of_not_not (λ hxy, _),
+  rcases exists_is_open_xor_mem hxy with ⟨U, hUo, hU⟩,
+  wlog h : x ∈ U ∧ y ∉ U,
+  { exact this hs hmin y hy x hx (ne.symm hxy) U hUo hU.symm (hU.resolve_left h), },
+  cases h with hxU hyU,
+  have : s ∩ U = s := hmin (s ∩ U) (inter_subset_left _ _) ⟨x, hx, hxU⟩ (hs.inter hUo),
+  exact hyU (this.symm.subset hy).2
 end
 
-theorem exists_open_singleton_of_fintype [t0_space α] [f : fintype α] [ha : nonempty α] :
-  ∃ x:α, is_open ({x}:set α) :=
+theorem minimal_nonempty_open_eq_singleton [t0_space α] {s : set α} (hs : is_open s)
+  (hne : s.nonempty) (hmin : ∀ t ⊆ s, t.nonempty → is_open t → t = s) :
+  ∃ x, s = {x} :=
+exists_eq_singleton_iff_nonempty_subsingleton.2 ⟨hne, minimal_nonempty_open_subsingleton hs hmin⟩
+
+/-- Given an open finite set `S` in a T₀ space, there is some `x ∈ S` such that `{x}` is open. -/
+theorem exists_open_singleton_of_open_finite [t0_space α] {s : set α} (hfin : s.finite)
+  (hne : s.nonempty) (ho : is_open s) :
+  ∃ x ∈ s, is_open ({x} : set α) :=
 begin
-  refine ha.elim (λ x, _),
-  have : is_open ((finset.univ : finset α) : set α), { simp },
-  rcases exists_open_singleton_of_open_finset _ ⟨x, finset.mem_univ x⟩ this with ⟨x, _, hx⟩,
-  exact ⟨x, hx⟩
+  lift s to finset α using hfin,
+  induction s using finset.strong_induction_on with s ihs,
+  rcases em (∃ t ⊂ s, t.nonempty ∧ is_open (t : set α)) with ⟨t, hts, htne, hto⟩|ht,
+  { rcases ihs t hts htne hto with ⟨x, hxt, hxo⟩,
+    exact ⟨x, hts.1 hxt, hxo⟩ },
+  { rcases minimal_nonempty_open_eq_singleton ho hne _ with ⟨x, hx⟩,
+    { exact ⟨x, hx.symm ▸ rfl, hx ▸ ho⟩ },
+    refine λ t hts htne hto, of_not_not (λ hts', ht _),
+    lift t to finset α using s.finite_to_set.subset hts,
+    exact ⟨t, ssubset_iff_subset_ne.2 ⟨hts, mt finset.coe_inj.2 hts'⟩, htne, hto⟩ }
 end
 
+theorem exists_open_singleton_of_fintype [t0_space α] [finite α] [nonempty α] :
+  ∃ x : α, is_open ({x} : set α) :=
+let ⟨x, _, h⟩ := exists_open_singleton_of_open_finite (set.to_finite _) univ_nonempty
+  is_open_univ in ⟨x, h⟩
+
 lemma t0_space_of_injective_of_continuous [topological_space β] {f : α → β}
   (hf : function.injective f) (hf' : continuous f) [t0_space β] : t0_space α :=
-⟨λ x y hxy, let ⟨U, hU, hxyU⟩ := t0_space.t0 (f x) (f y) (hf.ne hxy) in
-  ⟨f ⁻¹' U, hU.preimage hf', hxyU⟩⟩
+⟨λ x y h, hf $ (h.map hf').eq⟩
 
 protected lemma embedding.t0_space [topological_space β] [t0_space β] {f : α → β}
   (hf : embedding f) : t0_space α :=
@@ -275,20 +295,30 @@ instance subtype.t0_space [t0_space α] {p : α → Prop} : t0_space (subtype p)
 embedding_subtype_coe.t0_space
 
 theorem t0_space_iff_or_not_mem_closure (α : Type u) [topological_space α] :
-  t0_space α ↔ (∀ a b : α, (a ≠ b) → (a ∉ closure ({b} : set α) ∨ b ∉ closure ({a} : set α))) :=
+  t0_space α ↔ (∀ a b : α, a ≠ b → (a ∉ closure ({b} : set α) ∨ b ∉ closure ({a} : set α))) :=
+by simp only [t0_space_iff_not_inseparable, inseparable_iff_mem_closure, not_and_distrib]
+
+instance [topological_space β] [t0_space α] [t0_space β] : t0_space (α × β) :=
+⟨λ x y h, prod.ext (h.map continuous_fst).eq (h.map continuous_snd).eq⟩
+
+instance {ι : Type*} {π : ι → Type*} [Π i, topological_space (π i)] [Π i, t0_space (π i)] :
+  t0_space (Π i, π i) :=
+⟨λ x y h, funext $ λ i, (h.map (continuous_apply i)).eq⟩
+
+lemma t0_space.of_cover (h : ∀ x y, inseparable x y → ∃ s : set α, x ∈ s ∧ y ∈ s ∧ t0_space s) :
+  t0_space α :=
 begin
-  simp only [← not_and_distrib, t0_space_def, not_and],
-  refine forall₃_congr (λ a b _, ⟨_, λ h, _⟩),
-  { rintro ⟨s, h₁, (⟨h₂, h₃ : b ∈ sᶜ⟩|⟨h₂, h₃ : a ∈ sᶜ⟩)⟩ ha hb; rw ← is_closed_compl_iff at h₁,
-    { exact (is_closed.closure_subset_iff h₁).mpr (set.singleton_subset_iff.mpr h₃) ha h₂ },
-    { exact (is_closed.closure_subset_iff h₁).mpr (set.singleton_subset_iff.mpr h₃) hb h₂ } },
-  { by_cases h' : a ∈ closure ({b} : set α),
-    { exact ⟨(closure {a})ᶜ, is_closed_closure.1,
-        or.inr ⟨h h', not_not.mpr (subset_closure (set.mem_singleton a))⟩⟩ },
-    { exact ⟨(closure {b})ᶜ, is_closed_closure.1,
-        or.inl ⟨h', not_not.mpr (subset_closure (set.mem_singleton b))⟩⟩ } }
+  refine ⟨λ x y hxy, _⟩,
+  rcases h x y hxy with ⟨s, hxs, hys, hs⟩, resetI,
+  lift x to s using hxs, lift y to s using hys,
+  rw ← subtype_inseparable_iff at hxy,
+  exact congr_arg coe hxy.eq
 end
 
+lemma t0_space.of_open_cover (h : ∀ x, ∃ s : set α, x ∈ s ∧ is_open s ∧ t0_space s) : t0_space α :=
+t0_space.of_cover $ λ x y hxy,
+  let ⟨s, hxs, hso, hs⟩ := h x in ⟨s, hxs, (hxy.mem_open_iff hso).1 hxs, hs⟩
+
 /-- A T₁ space, also known as a Fréchet space, is a topological space
   where every singleton set is closed. Equivalently, for every pair
   `x ≠ y`, there is an open set containing `x` and not `y`. -/
@@ -304,6 +334,11 @@ is_closed_singleton.is_open_compl
 lemma is_open_ne [t1_space α] {x : α} : is_open {y | y ≠ x} :=
 is_open_compl_singleton
 
+@[to_additive]
+lemma continuous.is_open_mul_support [t1_space α] [has_one α] [topological_space β]
+  {f : β → α} (hf : continuous f) : is_open (mul_support f) :=
+is_open_ne.preimage hf
+
 lemma ne.nhds_within_compl_singleton [t1_space α] {x y : α} (h : x ≠ y) :
   𝓝[{y}ᶜ] x = 𝓝 x :=
 is_open_ne.nhds_within_eq h
@@ -315,6 +350,17 @@ begin
   exact mem_nhds_within_of_mem_nhds (is_open_ne.mem_nhds h)
 end
 
+lemma is_open_set_of_eventually_nhds_within [t1_space α] {p : α → Prop} :
+  is_open {x | ∀ᶠ y in 𝓝[≠] x, p y} :=
+begin
+  refine is_open_iff_mem_nhds.mpr (λ a ha, _),
+  filter_upwards [eventually_nhds_nhds_within.mpr ha] with b hb,
+  by_cases a = b,
+  { subst h, exact hb },
+  { rw (ne.symm h).nhds_within_compl_singleton at hb,
+    exact hb.filter_mono nhds_within_le_nhds }
+end
+
 protected lemma set.finite.is_closed [t1_space α] {s : set α} (hs : set.finite s) :
   is_closed s :=
 begin
@@ -322,6 +368,14 @@ begin
   exact is_closed_bUnion hs (λ i hi, is_closed_singleton)
 end
 
+lemma topological_space.is_topological_basis.exists_mem_of_ne
+  [t1_space α] {b : set (set α)} (hb : is_topological_basis b) {x y : α} (h : x ≠ y) :
+  ∃ a ∈ b, x ∈ a ∧ y ∉ a :=
+begin
+  rcases hb.is_open_iff.1 is_open_ne x h with ⟨a, ab, xa, ha⟩,
+  exact ⟨a, ab, xa, λ h, ha h rfl⟩,
+end
+
 lemma filter.coclosed_compact_le_cofinite [t1_space α] :
   filter.coclosed_compact α ≤ filter.cofinite :=
 λ s hs, compl_compl s ▸ hs.is_compact.compl_mem_coclosed_compact_of_is_closed hs.is_closed
@@ -345,7 +399,7 @@ begin
   split,
   { rintros ⟨t, ht₁, ht₂, hst⟩,
     rw compl_subset_compl at hst,
-    exact compact_of_is_closed_subset ht₂ is_closed_closure (closure_minimal hst ht₁) },
+    exact is_compact_of_is_closed_subset ht₂ is_closed_closure (closure_minimal hst ht₁) },
   { intros h,
     exact ⟨closure s, is_closed_closure, h, compl_subset_compl.mpr subset_closure⟩ }
 end
@@ -362,7 +416,8 @@ lemma t1_space_tfae (α : Type u) [topological_space α] :
     ∀ ⦃x y : α⦄, x ≠ y → ∃ s ∈ 𝓝 x, y ∉ s,
     ∀ ⦃x y : α⦄, x ≠ y → ∃ (U : set α) (hU : is_open U), x ∈ U ∧ y ∉ U,
     ∀ ⦃x y : α⦄, x ≠ y → disjoint (𝓝 x) (pure y),
-    ∀ ⦃x y : α⦄, x ≠ y → disjoint (pure x) (𝓝 y)] :=
+    ∀ ⦃x y : α⦄, x ≠ y → disjoint (pure x) (𝓝 y),
+    ∀ ⦃x y : α⦄, x ⤳ y → x = y] :=
 begin
   tfae_have : 1 ↔ 2, from ⟨λ h, h.1, λ h, ⟨h⟩⟩,
   tfae_have : 2 ↔ 3, by simp only [is_open_compl_iff],
@@ -383,6 +438,9 @@ begin
     exacts [is_open_empty, compl_compl s ▸ (@set.finite.is_closed _ _ H _ hs).is_open_compl] },
   tfae_have : 4 → 2,
     from λ h x, (cofinite_topology.is_closed_iff.2 $ or.inr (finite_singleton _)).preimage h,
+  tfae_have : 2 ↔ 10,
+  { simp only [← closure_subset_iff_is_closed, specializes_iff_mem_closure, subset_def,
+      mem_singleton_iff, eq_comm] },
   tfae_finish
 end
 
@@ -403,12 +461,30 @@ lemma t1_space_iff_disjoint_pure_nhds : t1_space α ↔ ∀ ⦃x y : α⦄, x 
 lemma t1_space_iff_disjoint_nhds_pure : t1_space α ↔ ∀ ⦃x y : α⦄, x ≠ y → disjoint (𝓝 x) (pure y) :=
 (t1_space_tfae α).out 0 7
 
+lemma t1_space_iff_specializes_imp_eq : t1_space α ↔ ∀ ⦃x y : α⦄, x ⤳ y → x = y :=
+(t1_space_tfae α).out 0 9
+
 lemma disjoint_pure_nhds [t1_space α] {x y : α} (h : x ≠ y) : disjoint (pure x) (𝓝 y) :=
 t1_space_iff_disjoint_pure_nhds.mp ‹_› h
 
 lemma disjoint_nhds_pure [t1_space α] {x y : α} (h : x ≠ y) : disjoint (𝓝 x) (pure y) :=
 t1_space_iff_disjoint_nhds_pure.mp ‹_› h
 
+lemma specializes.eq [t1_space α] {x y : α} (h : x ⤳ y) : x = y :=
+t1_space_iff_specializes_imp_eq.1 ‹_› h
+
+lemma specializes_iff_eq [t1_space α] {x y : α} : x ⤳ y ↔ x = y :=
+⟨specializes.eq, λ h, h ▸ specializes_rfl⟩
+
+@[simp] lemma specializes_eq_eq [t1_space α] : (⤳) = @eq α :=
+funext₂ $ λ x y, propext specializes_iff_eq
+
+@[simp] lemma pure_le_nhds_iff [t1_space α] {a b : α} : pure a ≤ 𝓝 b ↔ a = b :=
+specializes_iff_pure.symm.trans specializes_iff_eq
+
+@[simp] lemma nhds_le_nhds_iff [t1_space α] {a b : α} : 𝓝 a ≤ 𝓝 b ↔ a = b :=
+specializes_iff_eq
+
 instance {α : Type*} : t1_space (cofinite_topology α) :=
 t1_space_iff_continuous_cofinite_of.mpr continuous_id
 
@@ -449,12 +525,7 @@ end
 
 lemma t1_space_of_injective_of_continuous [topological_space β] {f : α → β}
   (hf : function.injective f) (hf' : continuous f) [t1_space β] : t1_space α :=
-{ t1 :=
-  begin
-    intros x,
-    rw [← function.injective.preimage_image hf {x}, image_singleton],
-    exact (t1_space.t1 $ f x).preimage hf'
-  end }
+t1_space_iff_specializes_imp_eq.2 $ λ x y h, hf (h.map hf').eq
 
 protected lemma embedding.t1_space [topological_space β] [t1_space β] {f : α → β}
   (hf : embedding f) : t1_space α :=
@@ -464,9 +535,15 @@ instance subtype.t1_space {α : Type u} [topological_space α] [t1_space α] {p
   t1_space (subtype p) :=
 embedding_subtype_coe.t1_space
 
+instance [topological_space β] [t1_space α] [t1_space β] : t1_space (α × β) :=
+⟨λ ⟨a, b⟩, @singleton_prod_singleton _ _ a b ▸ is_closed_singleton.prod is_closed_singleton⟩
+
+instance {ι : Type*} {π : ι → Type*} [Π i, topological_space (π i)] [Π i, t1_space (π i)] :
+  t1_space (Π i, π i) :=
+⟨λ f, univ_pi_singleton f ▸ is_closed_set_pi (λ i hi, is_closed_singleton)⟩
+
 @[priority 100] -- see Note [lower instance priority]
-instance t1_space.t0_space [t1_space α] : t0_space α :=
-⟨λ x y h, ⟨{z | z ≠ y}, is_open_ne, or.inl ⟨h, not_not_intro rfl⟩⟩⟩
+instance t1_space.t0_space [t1_space α] : t0_space α := ⟨λ x y h, h.specializes.eq⟩
 
 @[simp] lemma compl_singleton_mem_nhds_iff [t1_space α] {x y : α} : {x}ᶜ ∈ 𝓝 y ↔ y ≠ x :=
 is_open_compl_singleton.mem_nhds_iff
@@ -484,12 +561,33 @@ hs.induction_on (by simp) $ λ x, by simp
 
 @[simp] lemma subsingleton_closure [t1_space α] {s : set α} :
   (closure s).subsingleton ↔ s.subsingleton :=
-⟨λ h, h.mono subset_closure, λ h, h.closure⟩
+⟨λ h, h.anti subset_closure, λ h, h.closure⟩
 
 lemma is_closed_map_const {α β} [topological_space α] [topological_space β] [t1_space β] {y : β} :
   is_closed_map (function.const α y) :=
+is_closed_map.of_nonempty $ λ s hs h2s, by simp_rw [h2s.image_const, is_closed_singleton]
+
+lemma nhds_within_insert_of_ne [t1_space α] {x y : α} {s : set α} (hxy : x ≠ y) :
+  𝓝[insert y s] x = 𝓝[s] x :=
 begin
-  apply is_closed_map.of_nonempty, intros s hs h2s, simp_rw [h2s.image_const, is_closed_singleton]
+  refine le_antisymm (λ t ht, _) (nhds_within_mono x $ subset_insert y s),
+  obtain ⟨o, ho, hxo, host⟩ := mem_nhds_within.mp ht,
+  refine mem_nhds_within.mpr ⟨o \ {y}, ho.sdiff is_closed_singleton, ⟨hxo, hxy⟩, _⟩,
+  rw [inter_insert_of_not_mem $ not_mem_diff_of_mem (mem_singleton y)],
+  exact (inter_subset_inter (diff_subset _ _) subset.rfl).trans host
+end
+
+/-- If `t` is a subset of `s`, except for one point,
+then `insert x s` is a neighborhood of `x` within `t`. -/
+lemma insert_mem_nhds_within_of_subset_insert [t1_space α] {x y : α} {s t : set α}
+  (hu : t ⊆ insert y s) :
+  insert x s ∈ 𝓝[t] x :=
+begin
+  rcases eq_or_ne x y with rfl|h,
+  { exact mem_of_superset self_mem_nhds_within hu },
+  refine nhds_within_mono x hu _,
+  rw [nhds_within_insert_of_ne h],
+  exact mem_of_superset self_mem_nhds_within (subset_insert x s)
 end
 
 lemma bInter_basis_nhds [t1_space α] {ι : Sort*} {p : ι → Prop} {s : ι → set α} {x : α}
@@ -502,20 +600,6 @@ begin
   exact ⟨i, hi, λ h, hsub h rfl⟩
 end
 
-@[simp] lemma pure_le_nhds_iff [t1_space α] {a b : α} : pure a ≤ 𝓝 b ↔ a = b :=
-begin
-  refine ⟨λ h, _, λ h, h ▸ pure_le_nhds a⟩,
-  by_contra hab,
-  simpa only [mem_pure, mem_compl_iff, mem_singleton, not_true] using
-    h (compl_singleton_mem_nhds $ ne.symm hab)
-end
-
-@[simp] lemma nhds_le_nhds_iff [t1_space α] {a b : α} : 𝓝 a ≤ 𝓝 b ↔ a = b :=
-⟨λ h, pure_le_nhds_iff.mp $ (pure_le_nhds a).trans h, λ h, h ▸ le_rfl⟩
-
-@[simp] lemma nhds_eq_nhds_iff [t1_space α] {a b : α} : 𝓝 a = 𝓝 b ↔ a = b :=
-⟨λ h, nhds_le_nhds_iff.mp h.le, λ h, h ▸ rfl⟩
-
 @[simp] lemma compl_singleton_mem_nhds_set_iff [t1_space α] {x : α} {s : set α} :
   {x}ᶜ ∈ 𝓝ˢ s ↔ x ∉ s :=
 by rwa [is_open_compl_singleton.mem_nhds_set, subset_compl_singleton_iff]
@@ -539,7 +623,7 @@ lemma injective_nhds_set [t1_space α] : function.injective (𝓝ˢ : set α →
 lemma strict_mono_nhds_set [t1_space α] : strict_mono (𝓝ˢ : set α → filter α) :=
 monotone_nhds_set.strict_mono_of_injective injective_nhds_set
 
-@[simp] lemma nhds_le_nhds_set [t1_space α] {s : set α} {x : α} : 𝓝 x ≤ 𝓝ˢ s ↔ x ∈ s :=
+@[simp] lemma nhds_le_nhds_set_iff [t1_space α] {s : set α} {x : α} : 𝓝 x ≤ 𝓝ˢ s ↔ x ∈ s :=
 by rw [← nhds_set_singleton, nhds_set_le_iff, singleton_subset_iff]
 
 /-- Removing a non-isolated point from a dense set, one still obtains a dense set. -/
@@ -562,7 +646,7 @@ end
 /-- Removing a finite set from a dense set in a space without isolated points, one still
 obtains a dense set. -/
 lemma dense.diff_finite [t1_space α] [∀ (x : α), ne_bot (𝓝[≠] x)]
-  {s : set α} (hs : dense s) {t : set α} (ht : finite t) :
+  {s : set α} (hs : dense s) {t : set α} (ht : t.finite) :
   dense (s \ t) :=
 begin
   convert hs.diff_finset ht.to_finset,
@@ -575,41 +659,79 @@ lemma eq_of_tendsto_nhds [topological_space β] [t1_space β] {f : α → β} {a
   (h : tendsto f (𝓝 a) (𝓝 b)) : f a = b :=
 by_contra $ assume (hfa : f a ≠ b),
 have fact₁ : {f a}ᶜ ∈ 𝓝 b := compl_singleton_mem_nhds hfa.symm,
-have fact₂ : tendsto f (pure a) (𝓝 b) := h.comp (tendsto_id' $ pure_le_nhds a),
+have fact₂ : tendsto f (pure a) (𝓝 b) := h.comp (tendsto_id'.2 $ pure_le_nhds a),
 fact₂ fact₁ (eq.refl $ f a)
 
+lemma filter.tendsto.eventually_ne [topological_space β] [t1_space β] {α : Type*} {g : α → β}
+  {l : filter α} {b₁ b₂ : β} (hg : tendsto g l (𝓝 b₁)) (hb : b₁ ≠ b₂) :
+  ∀ᶠ z in l, g z ≠ b₂ :=
+hg.eventually (is_open_compl_singleton.eventually_mem hb)
+
+lemma continuous_at.eventually_ne [topological_space β] [t1_space β] {g : α → β}
+  {a : α} {b : β} (hg1 : continuous_at g a) (hg2 : g a ≠ b) :
+  ∀ᶠ z in 𝓝 a, g z ≠ b :=
+hg1.tendsto.eventually_ne hg2
+
 /-- To prove a function to a `t1_space` is continuous at some point `a`, it suffices to prove that
 `f` admits *some* limit at `a`. -/
 lemma continuous_at_of_tendsto_nhds [topological_space β] [t1_space β] {f : α → β} {a : α} {b : β}
   (h : tendsto f (𝓝 a) (𝓝 b)) : continuous_at f a :=
 show tendsto f (𝓝 a) (𝓝 $ f a), by rwa eq_of_tendsto_nhds h
 
-lemma tendsto_const_nhds_iff [t1_space α] {l : filter α} [ne_bot l] {c d : α} :
+@[simp] lemma tendsto_const_nhds_iff [t1_space α] {l : filter β} [ne_bot l] {c d : α} :
   tendsto (λ x, c) l (𝓝 d) ↔ c = d :=
 by simp_rw [tendsto, filter.map_const, pure_le_nhds_iff]
 
-/-- If the punctured neighborhoods of a point form a nontrivial filter, then any neighborhood is
-infinite. -/
-lemma infinite_of_mem_nhds {α} [topological_space α] [t1_space α] (x : α) [hx : ne_bot (𝓝[≠] x)]
-  {s : set α} (hs : s ∈ 𝓝 x) : set.infinite s :=
+/-- A point with a finite neighborhood has to be isolated. -/
+lemma is_open_singleton_of_finite_mem_nhds {α : Type*} [topological_space α] [t1_space α]
+  (x : α) {s : set α} (hs : s ∈ 𝓝 x) (hsf : s.finite) : is_open ({x} : set α) :=
 begin
-  intro hsf,
   have A : {x} ⊆ s, by simp only [singleton_subset_iff, mem_of_mem_nhds hs],
   have B : is_closed (s \ {x}) := (hsf.subset (diff_subset _ _)).is_closed,
   have C : (s \ {x})ᶜ ∈ 𝓝 x, from B.is_open_compl.mem_nhds (λ h, h.2 rfl),
   have D : {x} ∈ 𝓝 x, by simpa only [← diff_eq, diff_diff_cancel_left A] using inter_mem hs C,
-  rwa [← mem_interior_iff_mem_nhds, interior_singleton] at D
+  rwa [← mem_interior_iff_mem_nhds, ← singleton_subset_iff, subset_interior_iff_is_open] at D
 end
 
-lemma discrete_of_t1_of_finite {X : Type*} [topological_space X] [t1_space X] [fintype X] :
+/-- If the punctured neighborhoods of a point form a nontrivial filter, then any neighborhood is
+infinite. -/
+lemma infinite_of_mem_nhds {α} [topological_space α] [t1_space α] (x : α) [hx : ne_bot (𝓝[≠] x)]
+  {s : set α} (hs : s ∈ 𝓝 x) : set.infinite s :=
+begin
+  refine λ hsf, hx.1 _,
+  rw [← is_open_singleton_iff_punctured_nhds],
+  exact is_open_singleton_of_finite_mem_nhds x hs hsf
+end
+
+lemma discrete_of_t1_of_finite {X : Type*} [topological_space X] [t1_space X] [finite X] :
   discrete_topology X :=
 begin
   apply singletons_open_iff_discrete.mp,
   intros x,
   rw [← is_closed_compl_iff],
-  exact (finite.of_fintype _).is_closed
+  exact (set.to_finite _).is_closed
+end
+
+lemma preconnected_space.trivial_of_discrete [preconnected_space α] [discrete_topology α] :
+  subsingleton α :=
+begin
+  rw ←not_nontrivial_iff_subsingleton,
+  rintro ⟨x, y, hxy⟩,
+  rw [ne.def, ←mem_singleton_iff, (is_clopen_discrete _).eq_univ $ singleton_nonempty y] at hxy,
+  exact hxy (mem_univ x)
+end
+
+lemma is_preconnected.infinite_of_nontrivial [t1_space α] {s : set α} (h : is_preconnected s)
+  (hs : s.nontrivial) : s.infinite :=
+begin
+  refine mt (λ hf, (subsingleton_coe s).mp _) (not_subsingleton_iff.mpr hs),
+  haveI := @discrete_of_t1_of_finite s _ _ hf.to_subtype,
+  exact @preconnected_space.trivial_of_discrete _ _ (subtype.preconnected_space h) _
 end
 
+lemma connected_space.infinite [connected_space α] [nontrivial α] [t1_space α] : infinite α :=
+infinite_univ_iff.mp $ is_preconnected_univ.infinite_of_nontrivial nontrivial_univ
+
 lemma singleton_mem_nhds_within_of_mem_discrete {s : set α} [discrete_topology s]
   {x : α} (hx : x ∈ s) :
   {x} ∈ 𝓝[s] x :=
@@ -667,195 +789,94 @@ begin
   rw ← induced_compose,
 end
 
-/-- This lemma characterizes discrete topological spaces as those whose singletons are
-neighbourhoods. -/
-lemma discrete_topology_iff_nhds {X : Type*} [topological_space X] :
-  discrete_topology X ↔ (nhds : X → filter X) = pure :=
-begin
-  split,
-  { introI hX,
-    exact nhds_discrete X },
-  { intro h,
-    constructor,
-    apply eq_of_nhds_eq_nhds,
-    simp [h, nhds_bot] }
-end
-
-/-- The topology pulled-back under an inclusion `f : X → Y` from the discrete topology (`⊥`) is the
-discrete topology.
-This version does not assume the choice of a topology on either the source `X`
-nor the target `Y` of the inclusion `f`. -/
-lemma induced_bot {X Y : Type*} {f : X → Y} (hf : function.injective f) :
-  topological_space.induced f ⊥ = ⊥ :=
-eq_of_nhds_eq_nhds (by simp [nhds_induced, ← set.image_singleton, hf.preimage_image, nhds_bot])
-
-/-- The topology induced under an inclusion `f : X → Y` from the discrete topological space `Y`
-is the discrete topology on `X`. -/
-lemma discrete_topology_induced {X Y : Type*} [tY : topological_space Y] [discrete_topology Y]
-  {f : X → Y} (hf : function.injective f) : @discrete_topology X (topological_space.induced f tY) :=
-begin
-  constructor,
-  rw discrete_topology.eq_bot Y,
-  exact induced_bot hf
-end
-
-/-- Let `s, t ⊆ X` be two subsets of a topological space `X`.  If `t ⊆ s` and the topology induced
-by `X`on `s` is discrete, then also the topology induces on `t` is discrete.  -/
-lemma discrete_topology.of_subset {X : Type*} [topological_space X] {s t : set X}
-  (ds : discrete_topology s) (ts : t ⊆ s) :
-  discrete_topology t :=
-begin
-  rw [topological_space.subset_trans ts, ds.eq_bot],
-  exact {eq_bot := induced_bot (set.inclusion_injective ts)}
-end
-
 /-- A T₂ space, also known as a Hausdorff space, is one in which for every
   `x ≠ y` there exists disjoint open sets around `x` and `y`. This is
   the most widely used of the separation axioms. -/
 @[mk_iff] class t2_space (α : Type u) [topological_space α] : Prop :=
-(t2 : ∀ x y, x ≠ y → ∃ u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅)
+(t2 : ∀ x y, x ≠ y → ∃ u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ disjoint u v)
 
 /-- Two different points can be separated by open sets. -/
 lemma t2_separation [t2_space α] {x y : α} (h : x ≠ y) :
-  ∃ u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
+  ∃ u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ disjoint u v :=
 t2_space.t2 x y h
 
-/-- A finite set can be separated by open sets. -/
-lemma t2_separation_finset [t2_space α] (s : finset α) :
-  ∃ f : α → set α, set.pairwise_disjoint ↑s f ∧ ∀ x ∈ s, x ∈ f x ∧ is_open (f x) :=
-finset.induction_on s (by simp) begin
-  rintros t s ht ⟨f, hf, hf'⟩,
-  have hty : ∀ y : s, t ≠ y := by { rintros y rfl, exact ht y.2 },
-  choose u v hu hv htu hxv huv using λ {x} (h : t ≠ x), t2_separation h,
-  refine ⟨λ x, if ht : t = x then ⋂ y : s, u (hty y) else f x ∩ v ht, _, _⟩,
-  { rintros x hx₁ y hy₁ hxy a ⟨hx, hy⟩,
-    rw [finset.mem_coe, finset.mem_insert, eq_comm] at hx₁ hy₁,
-    rcases eq_or_ne t x with rfl | hx₂;
-    rcases eq_or_ne t y with rfl | hy₂,
-    { exact hxy rfl },
-    { simp_rw [dif_pos rfl, mem_Inter] at hx,
-      simp_rw [dif_neg hy₂] at hy,
-      rw [bot_eq_empty, ←huv hy₂],
-      exact ⟨hx ⟨y, hy₁.resolve_left hy₂⟩, hy.2⟩ },
-    { simp_rw [dif_neg hx₂] at hx,
-      simp_rw [dif_pos rfl, mem_Inter] at hy,
-      rw [bot_eq_empty, ←huv hx₂],
-      exact ⟨hy ⟨x, hx₁.resolve_left hx₂⟩, hx.2⟩ },
-    { simp_rw [dif_neg hx₂] at hx,
-      simp_rw [dif_neg hy₂] at hy,
-      exact hf (hx₁.resolve_left hx₂) (hy₁.resolve_left hy₂) hxy ⟨hx.1, hy.1⟩ } },
-  { intros x hx,
-    split_ifs with ht,
-    { refine ⟨mem_Inter.2 (λ y, _), is_open_Inter (λ y, hu (hty y))⟩,
-      rw ←ht,
-      exact htu (hty y) },
-    { have hx := hf' x ((finset.mem_insert.1 hx).resolve_left (ne.symm ht)),
-      exact ⟨⟨hx.1, hxv ht⟩, is_open.inter hx.2 (hv ht)⟩ } }
+lemma t2_space_iff_disjoint_nhds : t2_space α ↔ ∀ x y : α, x ≠ y → disjoint (𝓝 x) (𝓝 y) :=
+begin
+  refine (t2_space_iff α).trans (forall₃_congr $ λ x y hne, _),
+  simp only [(nhds_basis_opens x).disjoint_iff (nhds_basis_opens y), exists_prop,
+    ← exists_and_distrib_left, and.assoc, and_comm, and.left_comm]
+end
+
+@[simp] lemma disjoint_nhds_nhds [t2_space α] {x y : α} : disjoint (𝓝 x) (𝓝 y) ↔ x ≠ y :=
+⟨λ hd he, by simpa [he, nhds_ne_bot.ne] using hd, t2_space_iff_disjoint_nhds.mp ‹_› x y⟩
+
+lemma pairwise_disjoint_nhds [t2_space α] : pairwise (disjoint on (𝓝 : α → filter α)) :=
+λ x y, disjoint_nhds_nhds.2
+
+protected lemma set.pairwise_disjoint_nhds [t2_space α] (s : set α) : s.pairwise_disjoint 𝓝 :=
+pairwise_disjoint_nhds.set_pairwise s
+
+/-- Points of a finite set can be separated by open sets from each other. -/
+lemma set.finite.t2_separation [t2_space α] {s : set α} (hs : s.finite) :
+  ∃ U : α → set α, (∀ x, x ∈ U x ∧ is_open (U x)) ∧ s.pairwise_disjoint U :=
+s.pairwise_disjoint_nhds.exists_mem_filter_basis hs nhds_basis_opens
+
+lemma is_open_set_of_disjoint_nhds_nhds :
+  is_open {p : α × α | disjoint (𝓝 p.1) (𝓝 p.2)} :=
+begin
+  simp only [is_open_iff_mem_nhds, prod.forall, mem_set_of_eq],
+  intros x y h,
+  obtain ⟨U, hU, V, hV, hd⟩ := ((nhds_basis_opens x).disjoint_iff (nhds_basis_opens y)).mp h,
+  exact mem_nhds_prod_iff.mpr ⟨U, hU.2.mem_nhds hU.1, V, hV.2.mem_nhds hV.1,
+    λ ⟨x', y'⟩ ⟨hx', hy'⟩, disjoint_of_disjoint_of_mem hd (hU.2.mem_nhds hx') (hV.2.mem_nhds hy')⟩
 end
 
 @[priority 100] -- see Note [lower instance priority]
 instance t2_space.t1_space [t2_space α] : t1_space α :=
-⟨λ x, is_open_compl_iff.1 $ is_open_iff_forall_mem_open.2 $ λ y hxy,
-let ⟨u, v, hu, hv, hyu, hxv, huv⟩ := t2_separation (mt mem_singleton_of_eq hxy) in
-⟨u, λ z hz1 hz2, (ext_iff.1 huv x).1 ⟨mem_singleton_iff.1 hz2 ▸ hz1, hxv⟩, hu, hyu⟩⟩
-
-lemma eq_of_nhds_ne_bot [ht : t2_space α] {x y : α} (h : ne_bot (𝓝 x ⊓ 𝓝 y)) : x = y :=
-classical.by_contradiction $ assume : x ≠ y,
-let ⟨u, v, hu, hv, hx, hy, huv⟩ := t2_space.t2 x y this in
-absurd huv $ (inf_ne_bot_iff.1 h (is_open.mem_nhds hu hx) (is_open.mem_nhds hv hy)).ne_empty
+t1_space_iff_disjoint_pure_nhds.mpr $ λ x y hne, (disjoint_nhds_nhds.2 hne).mono_left $
+  pure_le_nhds _
 
 /-- A space is T₂ iff the neighbourhoods of distinct points generate the bottom filter. -/
 lemma t2_iff_nhds : t2_space α ↔ ∀ {x y : α}, ne_bot (𝓝 x ⊓ 𝓝 y) → x = y :=
-⟨assume h, by exactI λ x y, eq_of_nhds_ne_bot,
- assume h, ⟨assume x y xy,
-   have 𝓝 x ⊓ 𝓝 y = ⊥ := not_ne_bot.1 $ mt h xy,
-   let ⟨u', hu', v', hv', u'v'⟩ := empty_mem_iff_bot.mpr this,
-       ⟨u, uu', uo, hu⟩ := mem_nhds_iff.mp hu',
-       ⟨v, vv', vo, hv⟩ := mem_nhds_iff.mp hv' in
-   ⟨u, v, uo, vo, hu, hv, by { rw [← subset_empty_iff, u'v'], exact inter_subset_inter uu' vv' }⟩⟩⟩
-
-lemma t2_space_iff_nhds : t2_space α ↔ ∀ {x y : α}, x ≠ y → ∃ (U ∈ 𝓝 x) (V ∈ 𝓝 y), U ∩ V = ∅ :=
-begin
-  split,
-  { rintro ⟨h⟩ x y hxy,
-    rcases h x y hxy with ⟨u, v, u_op, v_op, hx, hy, H⟩,
-    exact ⟨u, u_op.mem_nhds hx, v, v_op.mem_nhds hy, H⟩ },
-  { refine λ h, ⟨λ x y hxy, _⟩,
-    rcases h hxy with ⟨u, u_in, v, v_in, H⟩,
-    rcases mem_nhds_iff.mp u_in with ⟨U, hUu, U_op, hxU⟩,
-    rcases mem_nhds_iff.mp v_in with ⟨V, hVv, V_op, hyV⟩,
-    refine ⟨U, V, U_op, V_op, hxU, hyV, set.eq_empty_of_subset_empty _⟩,
-    rw ← H,
-    exact set.inter_subset_inter hUu hVv }
-end
+by simp only [t2_space_iff_disjoint_nhds, disjoint_iff, ne_bot_iff, ne.def, not_imp_comm]
+
+lemma eq_of_nhds_ne_bot [t2_space α] {x y : α} (h : ne_bot (𝓝 x ⊓ 𝓝 y)) : x = y :=
+t2_iff_nhds.mp ‹_› h
+
+lemma t2_space_iff_nhds : t2_space α ↔ ∀ {x y : α}, x ≠ y → ∃ (U ∈ 𝓝 x) (V ∈ 𝓝 y), disjoint U V :=
+by simp only [t2_space_iff_disjoint_nhds, filter.disjoint_iff]
 
 lemma t2_separation_nhds [t2_space α] {x y : α} (h : x ≠ y) :
-   ∃ u v, u ∈ 𝓝 x ∧ v ∈ 𝓝 y ∧ u ∩ v = ∅ :=
+  ∃ u v, u ∈ 𝓝 x ∧ v ∈ 𝓝 y ∧ disjoint u v :=
 let ⟨u, v, open_u, open_v, x_in, y_in, huv⟩ := t2_separation h in
 ⟨u, v, open_u.mem_nhds x_in, open_v.mem_nhds y_in, huv⟩
 
-lemma t2_separation_compact_nhds [locally_compact_space α]
-  [t2_space α] {x y : α} (h : x ≠ y) :
-  ∃ u v, u ∈ 𝓝 x ∧ v ∈ 𝓝 y ∧ is_compact u ∧ is_compact v ∧ u ∩ v = ∅ :=
-begin
-  obtain ⟨u₀, v₀, u₀_in, v₀_in, hu₀v₀⟩ := t2_separation_nhds h,
-  obtain ⟨K₀, K₀_in, K₀_u₀, hK₀⟩ := local_compact_nhds u₀_in,
-  obtain ⟨L₀, L₀_in, L₀_u₀, hL₀⟩ := local_compact_nhds v₀_in,
-  use [K₀, L₀, K₀_in, L₀_in, hK₀, hL₀],
-  apply set.eq_empty_of_subset_empty,
-  rw ← hu₀v₀,
-  exact set.inter_subset_inter K₀_u₀ L₀_u₀
-end
+lemma t2_separation_compact_nhds [locally_compact_space α] [t2_space α] {x y : α} (h : x ≠ y) :
+  ∃ u v, u ∈ 𝓝 x ∧ v ∈ 𝓝 y ∧ is_compact u ∧ is_compact v ∧ disjoint u v :=
+by simpa only [exists_prop, ← exists_and_distrib_left, and_comm, and.assoc, and.left_comm]
+  using ((compact_basis_nhds x).disjoint_iff (compact_basis_nhds y)).1 (disjoint_nhds_nhds.2 h)
 
 lemma t2_iff_ultrafilter :
   t2_space α ↔ ∀ {x y : α} (f : ultrafilter α), ↑f ≤ 𝓝 x → ↑f ≤ 𝓝 y → x = y :=
 t2_iff_nhds.trans $ by simp only [←exists_ultrafilter_iff, and_imp, le_inf_iff, exists_imp_distrib]
 
-lemma is_closed_diagonal [t2_space α] : is_closed (diagonal α) :=
-begin
-  refine is_closed_iff_cluster_pt.mpr _,
-  rintro ⟨a₁, a₂⟩ h,
-  refine eq_of_nhds_ne_bot ⟨λ this : 𝓝 a₁ ⊓ 𝓝 a₂ = ⊥, h.ne _⟩,
-  obtain ⟨t₁, (ht₁ : t₁ ∈ 𝓝 a₁), t₂, (ht₂ : t₂ ∈ 𝓝 a₂), (h' : t₁ ∩ t₂ = ∅)⟩ :=
-    inf_eq_bot_iff.1 this,
-  rw [inf_principal_eq_bot, nhds_prod_eq],
-  apply mem_of_superset (prod_mem_prod ht₁ ht₂),
-  rintro ⟨x, y⟩ ⟨x_in, y_in⟩ (heq : x = y),
-  rw ← heq at *,
-  have : x ∈ t₁ ∩ t₂ := ⟨x_in, y_in⟩,
-  rwa h' at this
-end
-
 lemma t2_iff_is_closed_diagonal : t2_space α ↔ is_closed (diagonal α) :=
-begin
-  split,
-  { introI h,
-    exact is_closed_diagonal },
-  { intro h,
-    constructor,
-    intros x y hxy,
-    have : (x, y) ∈ (diagonal α)ᶜ, by rwa [mem_compl_iff],
-    obtain ⟨t, t_sub, t_op, xyt⟩ : ∃ t ⊆ (diagonal α)ᶜ, is_open t ∧ (x, y) ∈ t :=
-      is_open_iff_forall_mem_open.mp h.is_open_compl _ this,
-    rcases is_open_prod_iff.mp t_op x y xyt with ⟨U, V, U_op, V_op, xU, yV, H⟩,
-    use [U, V, U_op, V_op, xU, yV],
-    have := subset.trans H t_sub,
-    rw eq_empty_iff_forall_not_mem,
-    rintros z ⟨zU, zV⟩,
-    have : ¬ (z, z) ∈ diagonal α := this (mk_mem_prod zU zV),
-    exact this rfl },
-end
+by simp only [t2_space_iff_disjoint_nhds, ← is_open_compl_iff, is_open_iff_mem_nhds, prod.forall,
+  nhds_prod_eq, compl_diagonal_mem_prod, mem_compl_iff, mem_diagonal_iff]
+
+lemma is_closed_diagonal [t2_space α] : is_closed (diagonal α) :=
+t2_iff_is_closed_diagonal.mp ‹_›
 
 section separated
 
-open separated finset
+open separated_nhds finset
 
 lemma finset_disjoint_finset_opens_of_t2 [t2_space α] :
-  ∀ (s t : finset α), disjoint s t → separated (s : set α) t :=
+  ∀ (s t : finset α), disjoint s t → separated_nhds (s : set α) t :=
 begin
   refine induction_on_union _ (λ a b hi d, (hi d.symm).symm) (λ a d, empty_right a) (λ a b ab, _) _,
   { obtain ⟨U, V, oU, oV, aU, bV, UV⟩ := t2_separation (finset.disjoint_singleton.1 ab),
-    refine ⟨U, V, oU, oV, _, _, set.disjoint_iff_inter_eq_empty.mpr UV⟩;
+    refine ⟨U, V, oU, oV, _, _, UV⟩;
     exact singleton_subset_set_iff.mpr ‹_› },
   { intros a b c ac bc d,
     apply_mod_cast union_left (ac (disjoint_of_subset_left (a.subset_union_left b) d)) (bc _),
@@ -863,7 +884,7 @@ begin
 end
 
 lemma point_disjoint_finset_opens_of_t2 [t2_space α] {x : α} {s : finset α} (h : x ∉ s) :
-  separated ({x} : set α) s :=
+  separated_nhds ({x} : set α) s :=
 by exact_mod_cast finset_disjoint_finset_opens_of_t2 {x} s (finset.disjoint_singleton_left.mpr h)
 
 end separated
@@ -891,15 +912,27 @@ not_not.1 $ λ hne, this (is_closed_diagonal.is_open_compl.mem_nhds hne)
   where for every pair `x ≠ y`, there are two open sets, with the intersection of closures
   empty, one containing `x` and the other `y` . -/
 class t2_5_space (α : Type u) [topological_space α]: Prop :=
-(t2_5 : ∀ x y  (h : x ≠ y), ∃ (U V: set α), is_open U ∧  is_open V ∧
-                                            closure U ∩ closure V = ∅ ∧ x ∈ U ∧ y ∈ V)
+(t2_5 : ∀ ⦃x y : α⦄  (h : x ≠ y), disjoint ((𝓝 x).lift' closure) ((𝓝 y).lift' closure))
+
+@[simp] lemma disjoint_lift'_closure_nhds [t2_5_space α] {x y : α} :
+  disjoint ((𝓝 x).lift' closure) ((𝓝 y).lift' closure) ↔ x ≠ y :=
+⟨λ h hxy, by simpa [hxy, nhds_ne_bot.ne] using h, λ h, t2_5_space.t2_5 h⟩
 
 @[priority 100] -- see Note [lower instance priority]
 instance t2_5_space.t2_space [t2_5_space α] : t2_space α :=
-⟨λ x y hxy,
-  let ⟨U, V, hU, hV, hUV, hh⟩ := t2_5_space.t2_5 x y hxy in
-  ⟨U, V, hU, hV, hh.1, hh.2, subset_eq_empty (powerset_mono.mpr
-    (closure_inter_subset_inter_closure U V) subset_closure) hUV⟩⟩
+t2_space_iff_disjoint_nhds.2 $
+  λ x y hne, (disjoint_lift'_closure_nhds.2 hne).mono (le_lift'_closure _) (le_lift'_closure _)
+
+lemma exists_nhds_disjoint_closure [t2_5_space α] {x y : α} (h : x ≠ y) :
+  ∃ (s ∈ 𝓝 x) (t ∈ 𝓝 y), disjoint (closure s) (closure t) :=
+((𝓝 x).basis_sets.lift'_closure.disjoint_iff (𝓝 y).basis_sets.lift'_closure).1 $
+  disjoint_lift'_closure_nhds.2 h
+
+lemma exists_open_nhds_disjoint_closure [t2_5_space α] {x y : α} (h : x ≠ y) :
+  ∃ u : set α, x ∈ u ∧ is_open u ∧ ∃ v : set α, y ∈ v ∧ is_open v ∧
+    disjoint (closure u) (closure v) :=
+by simpa only [exists_prop, and.assoc] using ((nhds_basis_opens x).lift'_closure.disjoint_iff
+  (nhds_basis_opens y).lift'_closure).1 (disjoint_lift'_closure_nhds.2 h)
 
 section lim
 variables [t2_space α] {f : filter α}
@@ -978,25 +1011,23 @@ Hausdorff spaces:
 -/
 
 @[priority 100] -- see Note [lower instance priority]
-instance t2_space_discrete {α : Type*} [topological_space α] [discrete_topology α] : t2_space α :=
-{ t2 := assume x y hxy, ⟨{x}, {y}, is_open_discrete _, is_open_discrete _, rfl, rfl,
-  eq_empty_iff_forall_not_mem.2 $ by intros z hz;
-    cases eq_of_mem_singleton hz.1; cases eq_of_mem_singleton hz.2; cc⟩ }
+instance discrete_topology.to_t2_space {α : Type*} [topological_space α] [discrete_topology α] :
+  t2_space α :=
+⟨λ x y h, ⟨{x}, {y}, is_open_discrete _, is_open_discrete _, rfl, rfl, disjoint_singleton.2 h⟩⟩
 
 lemma separated_by_continuous {α : Type*} {β : Type*}
   [topological_space α] [topological_space β] [t2_space β]
   {f : α → β} (hf : continuous f) {x y : α} (h : f x ≠ f y) :
-  ∃u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
+  ∃u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ disjoint u v :=
 let ⟨u, v, uo, vo, xu, yv, uv⟩ := t2_separation h in
-⟨f ⁻¹' u, f ⁻¹' v, uo.preimage hf, vo.preimage hf, xu, yv,
-  by rw [←preimage_inter, uv, preimage_empty]⟩
+⟨f ⁻¹' u, f ⁻¹' v, uo.preimage hf, vo.preimage hf, xu, yv, uv.preimage _⟩
 
 lemma separated_by_open_embedding {α β : Type*} [topological_space α] [topological_space β]
   [t2_space α] {f : α → β} (hf : open_embedding f) {x y : α} (h : x ≠ y) :
-  ∃ u v : set β, is_open u ∧ is_open v ∧ f x ∈ u ∧ f y ∈ v ∧ u ∩ v = ∅ :=
+  ∃ u v : set β, is_open u ∧ is_open v ∧ f x ∈ u ∧ f y ∈ v ∧ disjoint u v :=
 let ⟨u, v, uo, vo, xu, yv, uv⟩ := t2_separation h in
 ⟨f '' u, f '' v, hf.is_open_map _ uo, hf.is_open_map _ vo,
-  mem_image_of_mem _ xu, mem_image_of_mem _ yv, by rw [image_inter hf.inj, uv, image_empty]⟩
+  mem_image_of_mem _ xu, mem_image_of_mem _ yv, disjoint_image_of_injective hf.inj uv⟩
 
 instance {α : Type*} {p : α → Prop} [t : topological_space α] [t2_space α] : t2_space (subtype p) :=
 ⟨assume x y h, separated_by_continuous continuous_subtype_val (mt subtype.eq h)⟩
@@ -1020,9 +1051,9 @@ begin
   { replace h : x ≠ y := λ c, (c.subst h) rfl,
     exact separated_by_open_embedding open_embedding_inl h },
   { exact ⟨_, _, is_open_range_inl, is_open_range_inr, ⟨x, rfl⟩, ⟨y, rfl⟩,
-      range_inl_inter_range_inr⟩ },
+      is_compl_range_inl_range_inr.disjoint⟩ },
   { exact ⟨_, _, is_open_range_inr, is_open_range_inl, ⟨x, rfl⟩, ⟨y, rfl⟩,
-      range_inr_inter_range_inl⟩ },
+      is_compl_range_inl_range_inr.disjoint.symm⟩ },
   { replace h : x ≠ y := λ c, (c.subst h) rfl,
     exact separated_by_open_embedding open_embedding_inr h }
 end
@@ -1043,15 +1074,20 @@ begin
   rcases em (i = j) with (rfl|h),
   { replace neq : x ≠ y := λ c, (c.subst neq) rfl,
     exact separated_by_open_embedding open_embedding_sigma_mk neq },
-  { exact ⟨_, _, is_open_range_sigma_mk, is_open_range_sigma_mk, ⟨x, rfl⟩, ⟨y, rfl⟩, by tidy⟩ }
+  { exact ⟨_, _, is_open_range_sigma_mk, is_open_range_sigma_mk, ⟨x, rfl⟩, ⟨y, rfl⟩,
+      set.disjoint_left.mpr $ by tidy⟩ }
 end
 
-variables [topological_space β]
+variables {γ : Type*} [topological_space β] [topological_space γ]
 
 lemma is_closed_eq [t2_space α] {f g : β → α}
   (hf : continuous f) (hg : continuous g) : is_closed {x:β | f x = g x} :=
 continuous_iff_is_closed.mp (hf.prod_mk hg) _ is_closed_diagonal
 
+lemma is_open_ne_fun [t2_space α] {f g : β → α}
+  (hf : continuous f) (hg : continuous g) : is_open {x:β | f x ≠ g x} :=
+is_open_compl_iff.mpr $ is_closed_eq hf hg
+
 /-- If two continuous maps are equal on `s`, then they are equal on the closure of `s`. See also
 `set.eq_on.of_subset_closure` for a more general version. -/
 lemma set.eq_on.closure [t2_space α] {s : set β} {f g : β → α} (h : eq_on f g s)
@@ -1065,6 +1101,22 @@ lemma continuous.ext_on [t2_space α] {s : set β} (hs : dense s) {f g : β →
   f = g :=
 funext $ λ x, h.closure hf hg (hs x)
 
+lemma eq_on_closure₂' [t2_space α] {s : set β} {t : set γ} {f g : β → γ → α}
+  (h : ∀ (x ∈ s) (y ∈ t), f x y = g x y)
+  (hf₁ : ∀ x, continuous (f x)) (hf₂ : ∀ y, continuous (λ x, f x y))
+  (hg₁ : ∀ x, continuous (g x)) (hg₂ : ∀ y, continuous (λ x, g x y)) :
+  ∀ (x ∈ closure s) (y ∈ closure t), f x y = g x y :=
+suffices closure s ⊆ ⋂ y ∈ closure t, {x | f x y = g x y}, by simpa only [subset_def, mem_Inter],
+closure_minimal (λ x hx, mem_Inter₂.2 $ set.eq_on.closure (h x hx) (hf₁ _) (hg₁ _)) $
+  is_closed_bInter $ λ y hy, is_closed_eq (hf₂ _) (hg₂ _)
+
+lemma eq_on_closure₂ [t2_space α] {s : set β} {t : set γ} {f g : β → γ → α}
+  (h : ∀ (x ∈ s) (y ∈ t), f x y = g x y)
+  (hf : continuous (uncurry f)) (hg : continuous (uncurry g)) :
+  ∀ (x ∈ closure s) (y ∈ closure t), f x y = g x y :=
+eq_on_closure₂' h (λ x, continuous_uncurry_left x hf) (λ x, continuous_uncurry_right x hf)
+  (λ y, continuous_uncurry_left y hg) (λ y, continuous_uncurry_right y hg)
+
 /-- If `f x = g x` for all `x ∈ s` and `f`, `g` are continuous on `t`, `s ⊆ t ⊆ closure s`, then
 `f x = g x` for all `x ∈ t`. See also `set.eq_on.closure`. -/
 lemma set.eq_on.of_subset_closure [t2_space α] {s t : set β} {f g : β → α} (h : eq_on f g s)
@@ -1091,31 +1143,18 @@ lemma function.left_inverse.closed_embedding [t2_space α] {f : α → β} {g :
   closed_embedding g :=
 ⟨h.embedding hf hg, h.closed_range hf hg⟩
 
-lemma diagonal_eq_range_diagonal_map {α : Type*} : {p:α×α | p.1 = p.2} = range (λx, (x,x)) :=
-ext $ assume p, iff.intro
-  (assume h, ⟨p.1, prod.ext_iff.2 ⟨rfl, h⟩⟩)
-  (assume ⟨x, hx⟩, show p.1 = p.2, by rw ←hx)
-
-lemma prod_subset_compl_diagonal_iff_disjoint {α : Type*} {s t : set α} :
-  s ×ˢ t ⊆ {p:α×α | p.1 = p.2}ᶜ ↔ s ∩ t = ∅ :=
-by rw [eq_empty_iff_forall_not_mem, subset_compl_comm,
-       diagonal_eq_range_diagonal_map, range_subset_iff]; simp
-
-lemma compact_compact_separated [t2_space α] {s t : set α}
-  (hs : is_compact s) (ht : is_compact t) (hst : s ∩ t = ∅) :
-  ∃u v : set α, is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ u ∩ v = ∅ :=
-by simp only [prod_subset_compl_diagonal_iff_disjoint.symm] at ⊢ hst;
+lemma is_compact_is_compact_separated [t2_space α] {s t : set α}
+  (hs : is_compact s) (ht : is_compact t) (hst : disjoint s t) :
+  separated_nhds s t :=
+by simp only [separated_nhds, prod_subset_compl_diagonal_iff_disjoint.symm] at ⊢ hst;
    exact generalized_tube_lemma hs ht is_closed_diagonal.is_open_compl hst
 
 /-- In a `t2_space`, every compact set is closed. -/
 lemma is_compact.is_closed [t2_space α] {s : set α} (hs : is_compact s) : is_closed s :=
 is_open_compl_iff.1 $ is_open_iff_forall_mem_open.mpr $ assume x hx,
   let ⟨u, v, uo, vo, su, xv, uv⟩ :=
-    compact_compact_separated hs (is_compact_singleton : is_compact {x})
-      (by rwa [inter_comm, ←subset_compl_iff_disjoint, singleton_subset_iff]) in
-  have v ⊆ sᶜ, from
-    subset_compl_comm.mp (subset.trans su (subset_compl_iff_disjoint.mpr uv)),
-⟨v, this, vo, by simpa using xv⟩
+    is_compact_is_compact_separated hs is_compact_singleton (disjoint_singleton_right.2 hx) in
+⟨v, (uv.mono_left $ show s ≤ u, from su).subset_compl_left, vo, by simpa using xv⟩
 
 @[simp] lemma filter.coclosed_compact_eq_cocompact [t2_space α] :
   coclosed_compact α = cocompact α :=
@@ -1129,10 +1168,10 @@ by rw bornology.ext_iff; exact filter.coclosed_compact_eq_cocompact
 `⋂ i, V i` contains some `V i`. This is a version of `exists_subset_nhd_of_compact'` where we
 don't need to assume each `V i` closed because it follows from compactness since `α` is
 assumed to be Hausdorff. -/
-lemma exists_subset_nhd_of_compact [t2_space α] {ι : Type*} [nonempty ι] {V : ι → set α}
+lemma exists_subset_nhds_of_is_compact [t2_space α] {ι : Type*} [nonempty ι] {V : ι → set α}
   (hV : directed (⊇) V) (hV_cpct : ∀ i, is_compact (V i)) {U : set α}
   (hU : ∀ x ∈ ⋂ i, V i, U ∈ 𝓝 x) : ∃ i, V i ⊆ U :=
-exists_subset_nhd_of_compact' hV hV_cpct (λ i, (hV_cpct i).is_closed) hU
+exists_subset_nhds_of_is_compact' hV hV_cpct (λ i, (hV_cpct i).is_closed) hU
 
 lemma compact_exhaustion.is_closed [t2_space α] (K : compact_exhaustion α) (n : ℕ) :
   is_closed (K n) :=
@@ -1142,16 +1181,16 @@ lemma is_compact.inter [t2_space α] {s t : set α} (hs : is_compact s) (ht : is
   is_compact (s ∩ t) :=
 hs.inter_right $ ht.is_closed
 
-lemma compact_closure_of_subset_compact [t2_space α] {s t : set α} (ht : is_compact t) (h : s ⊆ t) :
-  is_compact (closure s) :=
-compact_of_is_closed_subset ht is_closed_closure (closure_minimal h ht.is_closed)
+lemma is_compact_closure_of_subset_compact [t2_space α] {s t : set α}
+  (ht : is_compact t) (h : s ⊆ t) : is_compact (closure s) :=
+is_compact_of_is_closed_subset ht is_closed_closure (closure_minimal h ht.is_closed)
 
 @[simp]
 lemma exists_compact_superset_iff [t2_space α] {s : set α} :
   (∃ K, is_compact K ∧ s ⊆ K) ↔ is_compact (closure s) :=
-⟨λ ⟨K, hK, hsK⟩, compact_closure_of_subset_compact hK hsK, λ h, ⟨closure s, h, subset_closure⟩⟩
+⟨λ ⟨K, hK, hsK⟩, is_compact_closure_of_subset_compact hK hsK, λ h, ⟨closure s, h, subset_closure⟩⟩
 
-lemma image_closure_of_compact [t2_space β]
+lemma image_closure_of_is_compact [t2_space β]
   {s : set α} (hs : is_compact (closure s)) {f : α → β} (hf : continuous_on f (closure s)) :
   f '' closure s = closure (f '' s) :=
 subset.antisymm hf.image_closure $ closure_minimal (image_subset f subset_closure)
@@ -1162,20 +1201,28 @@ lemma is_compact.binary_compact_cover [t2_space α] {K U V : set α} (hK : is_co
   (hU : is_open U) (hV : is_open V) (h2K : K ⊆ U ∪ V) :
   ∃ K₁ K₂ : set α, is_compact K₁ ∧ is_compact K₂ ∧ K₁ ⊆ U ∧ K₂ ⊆ V ∧ K = K₁ ∪ K₂ :=
 begin
-  rcases compact_compact_separated (hK.diff hU) (hK.diff hV)
-    (by rwa [diff_inter_diff, diff_eq_empty]) with ⟨O₁, O₂, h1O₁, h1O₂, h2O₁, h2O₂, hO⟩,
-  refine ⟨_, _, hK.diff h1O₁, hK.diff h1O₂,
-    by rwa [diff_subset_comm], by rwa [diff_subset_comm], by rw [← diff_inter, hO, diff_empty]⟩
+  obtain ⟨O₁, O₂, h1O₁, h1O₂, h2O₁, h2O₂, hO⟩ :=
+    is_compact_is_compact_separated (hK.diff hU) (hK.diff hV)
+    (by rwa [disjoint_iff_inter_eq_empty, diff_inter_diff, diff_eq_empty]),
+  exact ⟨_, _, hK.diff h1O₁, hK.diff h1O₂, by rwa [diff_subset_comm], by rwa [diff_subset_comm],
+    by rw [← diff_inter, hO.inter_eq, diff_empty]⟩
 end
 
-lemma continuous.is_closed_map [compact_space α] [t2_space β] {f : α → β} (h : continuous f) :
-  is_closed_map f :=
+/-- A continuous map from a compact space to a Hausdorff space is a closed map. -/
+protected lemma continuous.is_closed_map [compact_space α] [t2_space β] {f : α → β}
+  (h : continuous f) : is_closed_map f :=
 λ s hs, (hs.is_compact.image h).is_closed
 
+/-- An injective continuous map from a compact space to a Hausdorff space is a closed embedding. -/
 lemma continuous.closed_embedding [compact_space α] [t2_space β] {f : α → β} (h : continuous f)
   (hf : function.injective f) : closed_embedding f :=
 closed_embedding_of_continuous_injective_closed h hf h.is_closed_map
 
+/-- A surjective continuous map from a compact space to a Hausdorff space is a quotient map. -/
+lemma quotient_map.of_surjective_continuous [compact_space α] [t2_space β] {f : α → β}
+  (hsurj : surjective f) (hcont : continuous f) : quotient_map f :=
+hcont.is_closed_map.to_quotient_map hcont hsurj
+
 section
 open finset function
 /-- For every finite open cover `Uᵢ` of a compact set, there exists a compact cover `Kᵢ ⊆ Uᵢ`. -/
@@ -1214,11 +1261,10 @@ lemma locally_compact_of_compact_nhds [t2_space α] (h : ∀ x : α, ∃ s, s 
   -- we may find open sets V, W separating x from K \ U.
   -- Then K \ W is a compact neighborhood of x contained in U.
   let ⟨v, w, vo, wo, xv, kuw, vw⟩ :=
-    compact_compact_separated is_compact_singleton (is_compact.diff kc uo)
-      (by rw [singleton_inter_eq_empty]; exact λ h, h.2 xu) in
+    is_compact_is_compact_separated is_compact_singleton (kc.diff uo)
+      (disjoint_singleton_left.2 $ λ h, h.2 xu) in
   have wn : wᶜ ∈ 𝓝 x, from
-   mem_nhds_iff.mpr
-     ⟨v, subset_compl_iff_disjoint.mpr vw, vo, singleton_subset_iff.mp xv⟩,
+   mem_nhds_iff.mpr ⟨v, vw.subset_compl_right, vo, singleton_subset_iff.mp xv⟩,
   ⟨k \ w,
    filter.inter_mem kx wn,
    subset.trans (diff_subset_comm.mp kuw) un,
@@ -1226,7 +1272,7 @@ lemma locally_compact_of_compact_nhds [t2_space α] (h : ∀ x : α, ∃ s, s 
 
 @[priority 100] -- see Note [lower instance priority]
 instance locally_compact_of_compact [t2_space α] [compact_space α] : locally_compact_space α :=
-locally_compact_of_compact_nhds (assume x, ⟨univ, is_open_univ.mem_nhds trivial, compact_univ⟩)
+locally_compact_of_compact_nhds (assume x, ⟨univ, is_open_univ.mem_nhds trivial, is_compact_univ⟩)
 
 /-- In a locally compact T₂ space, every point has an open neighborhood with compact closure -/
 lemma exists_open_with_compact_closure [locally_compact_space α] [t2_space α] (x : α) :
@@ -1234,7 +1280,7 @@ lemma exists_open_with_compact_closure [locally_compact_space α] [t2_space α]
 begin
   rcases exists_compact_mem_nhds x with ⟨K, hKc, hxK⟩,
   rcases mem_nhds_iff.1 hxK with ⟨t, h1t, h2t, h3t⟩,
-  exact ⟨t, h2t, h3t, compact_closure_of_subset_compact hKc h1t⟩
+  exact ⟨t, h2t, h3t, is_compact_closure_of_subset_compact hKc h1t⟩
 end
 
 /--
@@ -1245,173 +1291,254 @@ lemma exists_open_superset_and_is_compact_closure [locally_compact_space α] [t2
 begin
   rcases exists_compact_superset hK with ⟨K', hK', hKK'⟩,
   refine ⟨interior K', is_open_interior, hKK',
-    compact_closure_of_subset_compact hK' interior_subset⟩,
+    is_compact_closure_of_subset_compact hK' interior_subset⟩,
 end
 
-lemma is_preirreducible_iff_subsingleton [t2_space α] (S : set α) :
-  is_preirreducible S ↔ set.subsingleton S :=
+/--
+In a locally compact T₂ space, given a compact set `K` inside an open set `U`, we can find a
+open set `V` between these sets with compact closure: `K ⊆ V` and the closure of `V` is inside `U`.
+-/
+lemma exists_open_between_and_is_compact_closure [locally_compact_space α] [t2_space α]
+  {K U : set α} (hK : is_compact K) (hU : is_open U) (hKU : K ⊆ U) :
+  ∃ V, is_open V ∧ K ⊆ V ∧ closure V ⊆ U ∧ is_compact (closure V) :=
 begin
-  split,
-  { intros h x hx y hy,
-    by_contradiction e,
-    obtain ⟨U, V, hU, hV, hxU, hyV, h'⟩ := t2_separation e,
-    have := h U V hU hV ⟨x, hx, hxU⟩ ⟨y, hy, hyV⟩,
-    rw [h', inter_empty] at this,
-    exact this.some_spec },
-  { exact set.subsingleton.is_preirreducible }
+  rcases exists_compact_between hK hU hKU with ⟨V, hV, hKV, hVU⟩,
+  exact ⟨interior V, is_open_interior, hKV,
+    (closure_minimal interior_subset hV.is_closed).trans hVU,
+    is_compact_closure_of_subset_compact hV interior_subset⟩,
+end
+
+lemma is_preirreducible_iff_subsingleton [t2_space α] {S : set α} :
+  is_preirreducible S ↔ S.subsingleton :=
+begin
+  refine ⟨λ h x hx y hy, _, set.subsingleton.is_preirreducible⟩,
+  by_contradiction e,
+  obtain ⟨U, V, hU, hV, hxU, hyV, h'⟩ := t2_separation e,
+  exact ((h U V hU hV ⟨x, hx, hxU⟩ ⟨y, hy, hyV⟩).mono $ inter_subset_right _ _).not_disjoint h',
 end
 
-lemma is_irreducible_iff_singleton [t2_space α] (S : set α) :
+alias is_preirreducible_iff_subsingleton ↔ is_preirreducible.subsingleton _
+attribute [protected] is_preirreducible.subsingleton
+
+lemma is_irreducible_iff_singleton [t2_space α] {S : set α} :
   is_irreducible S ↔ ∃ x, S = {x} :=
 by rw [is_irreducible, is_preirreducible_iff_subsingleton,
   exists_eq_singleton_iff_nonempty_subsingleton]
 
-end separation
-
-section regularity
+/-- There does not exist a nontrivial preirreducible T₂ space. -/
+lemma not_preirreducible_nontrivial_t2 (α) [topological_space α] [preirreducible_space α]
+  [nontrivial α] [t2_space α] : false :=
+(preirreducible_space.is_preirreducible_univ α).subsingleton.not_nontrivial nontrivial_univ
 
-/-- A T₃ space, also known as a regular space (although this condition sometimes
-  omits T₂), is one in which for every closed `C` and `x ∉ C`, there exist
-  disjoint open sets containing `x` and `C` respectively. -/
-class regular_space (α : Type u) [topological_space α] extends t0_space α : Prop :=
-(regular : ∀{s:set α} {a}, is_closed s → a ∉ s → ∃t, is_open t ∧ s ⊆ t ∧ 𝓝[t] a = ⊥)
+end separation
 
-@[priority 100] -- see Note [lower instance priority]
-instance regular_space.t1_space [regular_space α] : t1_space α :=
+section regular_space
+
+/-- A topological space is called a *regular space* if for any closed set `s` and `a ∉ s`, there
+exist disjoint open sets `U ⊇ s` and `V ∋ a`. We formulate this condition in terms of `disjoint`ness
+of filters `𝓝ˢ s` and `𝓝 a`. -/
+@[mk_iff] class regular_space (X : Type u) [topological_space X] : Prop :=
+(regular : ∀ {s : set X} {a}, is_closed s → a ∉ s → disjoint (𝓝ˢ s) (𝓝 a))
+
+lemma regular_space_tfae (X : Type u) [topological_space X] :
+  tfae [regular_space X,
+    ∀ (s : set X) (a ∉ closure s), disjoint (𝓝ˢ s) (𝓝 a),
+    ∀ (a : X) (s : set X), disjoint (𝓝ˢ s) (𝓝 a) ↔ a ∉ closure s,
+    ∀ (a : X) (s ∈ 𝓝 a), ∃ t ∈ 𝓝 a, is_closed t ∧ t ⊆ s,
+    ∀ a : X, (𝓝 a).lift' closure ≤ 𝓝 a,
+    ∀ a : X, (𝓝 a).lift' closure = 𝓝 a] :=
 begin
-  rw t1_space_iff_exists_open,
-  intros x y hxy,
-  obtain ⟨U, hU, h⟩ := t0_space.t0 x y hxy,
-  cases h,
-  { exact ⟨U, hU, h⟩ },
-  { obtain ⟨R, hR, hh⟩ := regular_space.regular (is_closed_compl_iff.mpr hU) (not_not.mpr h.1),
-    obtain ⟨V, hV, hhh⟩ := mem_nhds_iff.1 (filter.inf_principal_eq_bot.1 hh.2),
-    exact ⟨R, hR, hh.1 (mem_compl h.2), hV hhh.2⟩ }
+  tfae_have : 1 ↔ 5,
+  { rw [regular_space_iff, (@compl_surjective (set X) _).forall, forall_swap],
+    simp only [is_closed_compl_iff, mem_compl_iff, not_not, @and_comm (_ ∈ _),
+      (nhds_basis_opens _).lift'_closure.le_basis_iff (nhds_basis_opens _), and_imp,
+      (nhds_basis_opens _).disjoint_iff_right, exists_prop, ← subset_interior_iff_mem_nhds_set,
+      interior_compl, compl_subset_compl] },
+  tfae_have : 5 → 6, from λ h a, (h a).antisymm (𝓝 _).le_lift'_closure,
+  tfae_have : 6 → 4,
+  { intros H a s hs,
+    rw [← H] at hs,
+    rcases (𝓝 a).basis_sets.lift'_closure.mem_iff.mp hs with ⟨U, hU, hUs⟩,
+    exact ⟨closure U, mem_of_superset hU subset_closure, is_closed_closure, hUs⟩ },
+  tfae_have : 4 → 2,
+  { intros H s a ha,
+    have ha' : sᶜ ∈ 𝓝 a, by rwa [← mem_interior_iff_mem_nhds, interior_compl],
+    rcases H _ _ ha' with ⟨U, hU, hUc, hUs⟩,
+    refine disjoint_of_disjoint_of_mem disjoint_compl_left _ hU,
+    rwa [← subset_interior_iff_mem_nhds_set, hUc.is_open_compl.interior_eq, subset_compl_comm] },
+  tfae_have : 2 → 3,
+  { refine λ H a s, ⟨λ hd has, mem_closure_iff_nhds_ne_bot.mp has _, H s a⟩,
+    exact (hd.symm.mono_right $ @principal_le_nhds_set _ _ s).eq_bot },
+  tfae_have : 3 → 1, from λ H, ⟨λ s a hs ha, (H _ _).mpr $ hs.closure_eq.symm ▸ ha⟩,
+  tfae_finish
 end
 
-lemma nhds_is_closed [regular_space α] {a : α} {s : set α} (h : s ∈ 𝓝 a) :
-  ∃ t ∈ 𝓝 a, t ⊆ s ∧ is_closed t :=
-let ⟨s', h₁, h₂, h₃⟩ := mem_nhds_iff.mp h in
-have ∃t, is_open t ∧ s'ᶜ ⊆ t ∧ 𝓝[t] a = ⊥,
-  from regular_space.regular h₂.is_closed_compl (not_not_intro h₃),
-let ⟨t, ht₁, ht₂, ht₃⟩ := this in
-⟨tᶜ,
-  mem_of_eq_bot $ by rwa [compl_compl],
-  subset.trans (compl_subset_comm.1 ht₂) h₁,
-  is_closed_compl_iff.mpr ht₁⟩
-
-lemma closed_nhds_basis [regular_space α] (a : α) :
-  (𝓝 a).has_basis (λ s : set α, s ∈ 𝓝 a ∧ is_closed s) id :=
-⟨λ t, ⟨λ t_in, let ⟨s, s_in, h_st, h⟩ := nhds_is_closed t_in in ⟨s, ⟨s_in, h⟩, h_st⟩,
-       λ ⟨s, ⟨s_in, hs⟩, hst⟩, mem_of_superset s_in hst⟩⟩
-
-lemma topological_space.is_topological_basis.exists_closure_subset [regular_space α]
+lemma regular_space.of_lift'_closure (h : ∀ a : α, (𝓝 a).lift' closure = 𝓝 a) : regular_space α :=
+iff.mpr ((regular_space_tfae α).out 0 5) h
+
+lemma regular_space.of_basis {ι : α → Sort*} {p : Π a, ι a → Prop} {s : Π a, ι a → set α}
+  (h₁ : ∀ a, (𝓝 a).has_basis (p a) (s a)) (h₂ : ∀ a i, p a i → is_closed (s a i)) :
+  regular_space α :=
+regular_space.of_lift'_closure $ λ a, (h₁ a).lift'_closure_eq_self (h₂ a)
+
+lemma regular_space.of_exists_mem_nhds_is_closed_subset
+  (h : ∀ (a : α) (s ∈ 𝓝 a), ∃ t ∈ 𝓝 a, is_closed t ∧ t ⊆ s) : regular_space α :=
+iff.mpr ((regular_space_tfae α).out 0 3) h
+
+variables [regular_space α] {a : α} {s : set α}
+
+lemma disjoint_nhds_set_nhds : disjoint (𝓝ˢ s) (𝓝 a) ↔ a ∉ closure s :=
+iff.mp ((regular_space_tfae α).out 0 2) ‹_› _ _
+
+lemma disjoint_nhds_nhds_set : disjoint (𝓝 a) (𝓝ˢ s) ↔ a ∉ closure s :=
+disjoint.comm.trans disjoint_nhds_set_nhds
+
+lemma exists_mem_nhds_is_closed_subset {a : α} {s : set α} (h : s ∈ 𝓝 a) :
+  ∃ t ∈ 𝓝 a, is_closed t ∧ t ⊆ s :=
+iff.mp ((regular_space_tfae α).out 0 3) ‹_› _ _ h
+
+lemma closed_nhds_basis (a : α) : (𝓝 a).has_basis (λ s : set α, s ∈ 𝓝 a ∧ is_closed s) id :=
+has_basis_self.2 (λ _, exists_mem_nhds_is_closed_subset)
+
+lemma lift'_nhds_closure (a : α) : (𝓝 a).lift' closure = 𝓝 a :=
+(closed_nhds_basis a).lift'_closure_eq_self (λ s hs, hs.2)
+
+lemma filter.has_basis.nhds_closure {ι : Sort*} {a : α} {p : ι → Prop} {s : ι → set α}
+  (h : (𝓝 a).has_basis p s) : (𝓝 a).has_basis p (λ i, closure (s i)) :=
+lift'_nhds_closure a ▸ h.lift'_closure
+
+lemma has_basis_nhds_closure (a : α) : (𝓝 a).has_basis (λ s, s ∈ 𝓝 a) closure :=
+(𝓝 a).basis_sets.nhds_closure
+
+lemma has_basis_opens_closure (a : α) : (𝓝 a).has_basis (λ s, a ∈ s ∧ is_open s) closure :=
+(nhds_basis_opens a).nhds_closure
+
+lemma topological_space.is_topological_basis.nhds_basis_closure
+  {B : set (set α)} (hB : topological_space.is_topological_basis B) (a : α) :
+  (𝓝 a).has_basis (λ s : set α, a ∈ s ∧ s ∈ B) closure :=
+by simpa only [and_comm] using hB.nhds_has_basis.nhds_closure
+
+lemma topological_space.is_topological_basis.exists_closure_subset
   {B : set (set α)} (hB : topological_space.is_topological_basis B) {a : α} {s : set α}
   (h : s ∈ 𝓝 a) :
   ∃ t ∈ B, a ∈ t ∧ closure t ⊆ s :=
+by simpa only [exists_prop, and.assoc] using hB.nhds_has_basis.nhds_closure.mem_iff.mp h
+
+lemma disjoint_nhds_nhds_iff_not_specializes {a b : α} :
+  disjoint (𝓝 a) (𝓝 b) ↔ ¬a ⤳ b :=
+by rw [← nhds_set_singleton, disjoint_nhds_set_nhds, specializes_iff_mem_closure]
+
+lemma specializes_comm {a b : α} : a ⤳ b ↔ b ⤳ a :=
+by simp only [← disjoint_nhds_nhds_iff_not_specializes.not_left, disjoint.comm]
+
+alias specializes_comm ↔ specializes.symm _
+
+lemma specializes_iff_inseparable {a b : α} : a ⤳ b ↔ inseparable a b :=
+⟨λ h, h.antisymm h.symm, le_of_eq⟩
+
+lemma is_closed_set_of_specializes : is_closed {p : α × α | p.1 ⤳ p.2} :=
+by simp only [← is_open_compl_iff, compl_set_of, ← disjoint_nhds_nhds_iff_not_specializes,
+  is_open_set_of_disjoint_nhds_nhds]
+
+lemma is_closed_set_of_inseparable : is_closed {p : α × α | inseparable p.1 p.2} :=
+by simp only [← specializes_iff_inseparable, is_closed_set_of_specializes]
+
+protected lemma inducing.regular_space [topological_space β] {f : β → α} (hf : inducing f) :
+  regular_space β :=
+regular_space.of_basis (λ b, by { rw [hf.nhds_eq_comap b], exact (closed_nhds_basis _).comap _ }) $
+  λ b s hs, hs.2.preimage hf.continuous
+
+lemma regular_space_induced (f : β → α) : @regular_space β (induced f ‹_›) :=
+by { letI := induced f ‹_›, exact inducing.regular_space ⟨rfl⟩ }
+
+lemma regular_space_Inf {X} {T : set (topological_space X)} (h : ∀ t ∈ T, @regular_space X t) :
+  @regular_space X (Inf T) :=
 begin
-  rcases nhds_is_closed h with ⟨t, hat, hts, htc⟩,
-  rcases hB.mem_nhds_iff.1 hat with ⟨u, huB, hau, hut⟩,
-  exact ⟨u, huB, hau, (closure_minimal hut htc).trans hts⟩
+  letI := Inf T,
+  have : ∀ a, (𝓝 a).has_basis
+    (λ If : Σ I : set T, I → set X,
+      If.1.finite ∧ ∀ i : If.1, If.2 i ∈ @nhds X i a ∧ is_closed[↑i] (If.2 i))
+    (λ If, ⋂ i : If.1, If.snd i),
+  { intro a,
+    rw [nhds_Inf, ← infi_subtype''],
+    exact has_basis_infi (λ t : T, @closed_nhds_basis X t (h t t.2) a) },
+  refine regular_space.of_basis this (λ a If hIf, is_closed_Inter $ λ i, _),
+  exact (hIf.2 i).2.mono (Inf_le (i : T).2)
 end
 
-lemma topological_space.is_topological_basis.nhds_basis_closure [regular_space α]
-  {B : set (set α)} (hB : topological_space.is_topological_basis B) (a : α) :
-  (𝓝 a).has_basis (λ s : set α, a ∈ s ∧ s ∈ B) closure :=
-⟨λ s, ⟨λ h, let ⟨t, htB, hat, hts⟩ := hB.exists_closure_subset h in ⟨t, ⟨hat, htB⟩, hts⟩,
-  λ ⟨t, ⟨hat, htB⟩, hts⟩, mem_of_superset (hB.mem_nhds htB hat) (subset_closure.trans hts)⟩⟩
+lemma regular_space_infi {ι X} {t : ι → topological_space X} (h : ∀ i, @regular_space X (t i)) :
+  @regular_space X (infi t) :=
+regular_space_Inf $ forall_range_iff.mpr h
 
-protected lemma embedding.regular_space [topological_space β] [regular_space β] {f : α → β}
-  (hf : embedding f) : regular_space α :=
-{ to_t0_space := hf.t0_space,
-  regular :=
-  begin
-    intros s a hs ha,
-    rcases hf.to_inducing.is_closed_iff.1 hs with ⟨s, hs', rfl⟩,
-    rcases regular_space.regular hs' ha with ⟨t, ht, hst, hat⟩,
-    refine ⟨f ⁻¹' t, ht.preimage hf.continuous, preimage_mono hst, _⟩,
-    rw [nhds_within, hf.to_inducing.nhds_eq_comap, ← comap_principal, ← comap_inf,
-        ← nhds_within, hat, comap_bot]
-  end }
+lemma regular_space.inf {X} {t₁ t₂ : topological_space X} (h₁ : @regular_space X t₁)
+  (h₂ : @regular_space X t₂) : @regular_space X (t₁ ⊓ t₂) :=
+by { rw [inf_eq_infi], exact regular_space_infi (bool.forall_bool.2 ⟨h₂, h₁⟩) }
 
-instance subtype.regular_space [regular_space α] {p : α → Prop} : regular_space (subtype p) :=
-embedding_subtype_coe.regular_space
+instance {p : α → Prop} : regular_space (subtype p) :=
+embedding_subtype_coe.to_inducing.regular_space
 
-variable (α)
-@[priority 100] -- see Note [lower instance priority]
-instance regular_space.t2_space [regular_space α] : t2_space α :=
-⟨λ x y hxy,
-let ⟨s, hs, hys, hxs⟩ := regular_space.regular is_closed_singleton
-    (mt mem_singleton_iff.1 hxy),
-  ⟨t, hxt, u, hsu, htu⟩ := empty_mem_iff_bot.2 hxs,
-  ⟨v, hvt, hv, hxv⟩ := mem_nhds_iff.1 hxt in
-⟨v, s, hv, hs, hxv, singleton_subset_iff.1 hys,
-eq_empty_of_subset_empty $ λ z ⟨hzv, hzs⟩, by { rw htu, exact ⟨hvt hzv, hsu hzs⟩ }⟩⟩
+instance [topological_space β] [regular_space β] : regular_space (α × β) :=
+(regular_space_induced prod.fst).inf (regular_space_induced prod.snd)
+
+instance {ι : Type*} {π : ι → Type*} [Π i, topological_space (π i)] [∀ i, regular_space (π i)] :
+  regular_space (Π i, π i) :=
+regular_space_infi $ λ i, regular_space_induced _
+
+end regular_space
+
+section t3
+
+/-- A T₃ space is a T₀ space which is a regular space. Any T₃ space is a T₁ space, a T₂ space, and
+a T₂.₅ space.  -/
+class t3_space (α : Type u) [topological_space α] extends t0_space α, regular_space α : Prop
 
 @[priority 100] -- see Note [lower instance priority]
-instance regular_space.t2_5_space [regular_space α] : t2_5_space α :=
-⟨λ x y hxy,
-let ⟨U, V, hU, hV, hh_1, hh_2, hUV⟩ := t2_space.t2 x y hxy,
-  hxcV := not_not.mpr ((interior_maximal (subset_compl_iff_disjoint.mpr hUV) hU) hh_1),
-  ⟨R, hR, hh⟩ := regular_space.regular is_closed_closure (by rwa closure_eq_compl_interior_compl),
-  ⟨A, hA, hhh⟩ := mem_nhds_iff.1 (filter.inf_principal_eq_bot.1 hh.2) in
-⟨A, V, hhh.1, hV, subset_eq_empty ((closure V).inter_subset_inter_left
-  (subset.trans (closure_minimal hA (is_closed_compl_iff.mpr hR)) (compl_subset_compl.mpr hh.1)))
-  (compl_inter_self (closure V)), hhh.2, hh_2⟩⟩
+instance t3_space.t2_5_space [t3_space α] : t2_5_space α :=
+begin
+  refine ⟨λ x y hne, _⟩,
+  rw [lift'_nhds_closure, lift'_nhds_closure],
+  have aux : x ∉ closure {y} ∨ y ∉ closure {x},
+    from (t0_space_iff_or_not_mem_closure α).mp infer_instance x y hne,
+  wlog H : x ∉ closure ({y} : set α),
+  { refine (this y x hne.symm aux.symm (aux.resolve_left H)).symm },
+  { rwa [← disjoint_nhds_nhds_set, nhds_set_singleton] at H },
+end
 
-variable {α}
+protected lemma embedding.t3_space [topological_space β] [t3_space β] {f : α → β}
+  (hf : embedding f) : t3_space α :=
+{ to_t0_space := hf.t0_space,
+  to_regular_space := hf.to_inducing.regular_space }
+
+instance subtype.t3_space [t3_space α] {p : α → Prop} : t3_space (subtype p) :=
+embedding_subtype_coe.t3_space
+
+instance [topological_space β] [t3_space α] [t3_space β] : t3_space (α × β) := ⟨⟩
+
+instance {ι : Type*} {π : ι → Type*} [Π i, topological_space (π i)] [Π i, t3_space (π i)] :
+  t3_space (Π i, π i) := ⟨⟩
 
 /-- Given two points `x ≠ y`, we can find neighbourhoods `x ∈ V₁ ⊆ U₁` and `y ∈ V₂ ⊆ U₂`,
 with the `Vₖ` closed and the `Uₖ` open, such that the `Uₖ` are disjoint. -/
-lemma disjoint_nested_nhds [regular_space α] {x y : α} (h : x ≠ y) :
+lemma disjoint_nested_nhds [t3_space α] {x y : α} (h : x ≠ y) :
   ∃ (U₁ V₁ ∈ 𝓝 x) (U₂ V₂ ∈ 𝓝 y), is_closed V₁ ∧ is_closed V₂ ∧ is_open U₁ ∧ is_open U₂ ∧
-  V₁ ⊆ U₁ ∧ V₂ ⊆ U₂ ∧ U₁ ∩ U₂ = ∅ :=
+  V₁ ⊆ U₁ ∧ V₂ ⊆ U₂ ∧ disjoint U₁ U₂ :=
 begin
   rcases t2_separation h with ⟨U₁, U₂, U₁_op, U₂_op, x_in, y_in, H⟩,
-  rcases nhds_is_closed (is_open.mem_nhds U₁_op x_in) with ⟨V₁, V₁_in, h₁, V₁_closed⟩,
-  rcases nhds_is_closed (is_open.mem_nhds U₂_op y_in) with ⟨V₂, V₂_in, h₂, V₂_closed⟩,
-  use [U₁, mem_of_superset V₁_in h₁, V₁, V₁_in,
-       U₂, mem_of_superset V₂_in h₂, V₂, V₂_in],
-  tauto
+  rcases exists_mem_nhds_is_closed_subset (U₁_op.mem_nhds x_in) with ⟨V₁, V₁_in, V₁_closed, h₁⟩,
+  rcases exists_mem_nhds_is_closed_subset (U₂_op.mem_nhds y_in) with ⟨V₂, V₂_in, V₂_closed, h₂⟩,
+  exact ⟨U₁, mem_of_superset V₁_in h₁, V₁, V₁_in, U₂, mem_of_superset V₂_in h₂, V₂, V₂_in,
+    V₁_closed, V₂_closed, U₁_op, U₂_op, h₁, h₂, H⟩
 end
 
-/--
-In a locally compact regular space, given a compact set `K` inside an open set `U`, we can find a
-compact set `K'` between these sets: `K` is inside the interior of `K'` and `K' ⊆ U`.
--/
-lemma exists_compact_between [locally_compact_space α] [regular_space α]
-  {K U : set α} (hK : is_compact K) (hU : is_open U) (hKU : K ⊆ U) :
-  ∃ K', is_compact K' ∧ K ⊆ interior K' ∧ K' ⊆ U :=
-begin
-  choose C hxC hCU hC using λ x : K, nhds_is_closed (hU.mem_nhds $ hKU x.2),
-  choose L hL hxL using λ x : K, exists_compact_mem_nhds (x : α),
-  have : K ⊆ ⋃ x, interior (L x) ∩ interior (C x), from
-  λ x hx, mem_Union.mpr ⟨⟨x, hx⟩,
-    ⟨mem_interior_iff_mem_nhds.mpr (hxL _), mem_interior_iff_mem_nhds.mpr (hxC _)⟩⟩,
-  rcases hK.elim_finite_subcover _ _ this with ⟨t, ht⟩,
-  { refine ⟨⋃ x ∈ t, L x ∩ C x, t.compact_bUnion (λ x _, (hL x).inter_right (hC x)), λ x hx, _, _⟩,
-    { obtain ⟨y, hyt, hy : x ∈ interior (L y) ∩ interior (C y)⟩ := mem_Union₂.mp (ht hx),
-      rw [← interior_inter] at hy,
-      refine interior_mono (subset_bUnion_of_mem hyt) hy },
-    { simp_rw [Union_subset_iff], rintro x -, exact (inter_subset_right _ _).trans (hCU _) } },
-  { exact λ _, is_open_interior.inter is_open_interior }
-end
+open separation_quotient
 
-/--
-In a locally compact regular space, given a compact set `K` inside an open set `U`, we can find a
-open set `V` between these sets with compact closure: `K ⊆ V` and the closure of `V` is inside `U`.
--/
-lemma exists_open_between_and_is_compact_closure [locally_compact_space α] [regular_space α]
-  {K U : set α} (hK : is_compact K) (hU : is_open U) (hKU : K ⊆ U) :
-  ∃ V, is_open V ∧ K ⊆ V ∧ closure V ⊆ U ∧ is_compact (closure V) :=
-begin
-  rcases exists_compact_between hK hU hKU with ⟨V, hV, hKV, hVU⟩,
-  refine ⟨interior V, is_open_interior, hKV,
-    (closure_minimal interior_subset hV.is_closed).trans hVU,
-    compact_closure_of_subset_compact hV interior_subset⟩,
-end
+/-- The `separation_quotient` of a regular space is a T₃ space. -/
+instance [regular_space α] : t3_space (separation_quotient α) :=
+{ regular := λ s, surjective_mk.forall.2 $ λ a hs ha,
+    by { rw [← disjoint_comap_iff surjective_mk, comap_mk_nhds_mk, comap_mk_nhds_set],
+         exact regular_space.regular (hs.preimage continuous_mk) ha } }
 
-end regularity
+end t3
 
 section normality
 
@@ -1419,42 +1546,34 @@ section normality
   omits T₂), is one in which for every pair of disjoint closed sets `C` and `D`,
   there exist disjoint open sets containing `C` and `D` respectively. -/
 class normal_space (α : Type u) [topological_space α] extends t1_space α : Prop :=
-(normal : ∀ s t : set α, is_closed s → is_closed t → disjoint s t →
-  ∃ u v, is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v)
+(normal : ∀ s t : set α, is_closed s → is_closed t → disjoint s t → separated_nhds s t)
 
 theorem normal_separation [normal_space α] {s t : set α}
   (H1 : is_closed s) (H2 : is_closed t) (H3 : disjoint s t) :
-  ∃ u v, is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v :=
+  separated_nhds s t :=
 normal_space.normal s t H1 H2 H3
 
 theorem normal_exists_closure_subset [normal_space α] {s t : set α} (hs : is_closed s)
   (ht : is_open t) (hst : s ⊆ t) :
   ∃ u, is_open u ∧ s ⊆ u ∧ closure u ⊆ t :=
 begin
-  have : disjoint s tᶜ, from λ x ⟨hxs, hxt⟩, hxt (hst hxs),
+  have : disjoint s tᶜ, from set.disjoint_left.mpr (λ x hxs hxt, hxt (hst hxs)),
   rcases normal_separation hs (is_closed_compl_iff.2 ht) this
     with ⟨s', t', hs', ht', hss', htt', hs't'⟩,
   refine ⟨s', hs', hss',
     subset.trans (closure_minimal _ (is_closed_compl_iff.2 ht')) (compl_subset_comm.1 htt')⟩,
-  exact λ x hxs hxt, hs't' ⟨hxs, hxt⟩
+  exact λ x hxs hxt, hs't'.le_bot ⟨hxs, hxt⟩
 end
 
 @[priority 100] -- see Note [lower instance priority]
-instance normal_space.regular_space [normal_space α] : regular_space α :=
+instance normal_space.t3_space [normal_space α] : t3_space α :=
 { regular := λ s x hs hxs, let ⟨u, v, hu, hv, hsu, hxv, huv⟩ :=
-    normal_separation hs is_closed_singleton
-      (λ _ ⟨hx, hy⟩, hxs $ mem_of_eq_of_mem (eq_of_mem_singleton hy).symm hx) in
-    ⟨u, hu, hsu, filter.empty_mem_iff_bot.1 $ filter.mem_inf_iff.2
-      ⟨v, is_open.mem_nhds hv (singleton_subset_iff.1 hxv), u, filter.mem_principal_self u,
-       by rwa [eq_comm, inter_comm, ← disjoint_iff_inter_eq_empty]⟩⟩ }
+    normal_separation hs is_closed_singleton (disjoint_singleton_right.mpr hxs) in
+    disjoint_of_disjoint_of_mem huv (hu.mem_nhds_set.2 hsu) (hv.mem_nhds $ hxv rfl) }
 
 -- We can't make this an instance because it could cause an instance loop.
 lemma normal_of_compact_t2 [compact_space α] [t2_space α] : normal_space α :=
-begin
-  refine ⟨assume s t hs ht st, _⟩,
-  simp only [disjoint_iff],
-  exact compact_compact_separated hs.is_compact ht.is_compact st.eq_bot
-end
+⟨λ s t hs ht, is_compact_is_compact_separated hs.is_compact ht.is_compact⟩
 
 protected lemma closed_embedding.normal_space [topological_space β] [normal_space β] {f : α → β}
   (hf : closed_embedding f) : normal_space α :=
@@ -1462,18 +1581,35 @@ protected lemma closed_embedding.normal_space [topological_space β] [normal_spa
   normal :=
   begin
     intros s t hs ht hst,
-    rcases normal_space.normal (f '' s) (f '' t) (hf.is_closed_map s hs) (hf.is_closed_map t ht)
-      (disjoint_image_of_injective hf.inj hst) with ⟨u, v, hu, hv, hsu, htv, huv⟩,
-    rw image_subset_iff at hsu htv,
-    exact ⟨f ⁻¹' u, f ⁻¹' v, hu.preimage hf.continuous, hv.preimage hf.continuous,
-            hsu, htv, huv.preimage f⟩
+    have H : separated_nhds (f '' s) (f '' t),
+      from normal_space.normal (f '' s) (f '' t) (hf.is_closed_map s hs) (hf.is_closed_map t ht)
+        (disjoint_image_of_injective hf.inj hst),
+    exact (H.preimage hf.continuous).mono (subset_preimage_image _ _) (subset_preimage_image _ _)
   end }
 
+namespace separation_quotient
+
+/-- The `separation_quotient` of a normal space is a T₄ space. We don't have separate typeclasses
+for normal spaces (without T₁ assumption) and T₄ spaces, so we use the same class for assumption
+and for conclusion.
+
+One can prove this using a homeomorphism between `α` and `separation_quotient α`. We give an
+alternative proof that works without assuming that `α` is a T₁ space. -/
+instance [normal_space α] : normal_space (separation_quotient α) :=
+{ normal := λ s t hs ht hd, separated_nhds_iff_disjoint.2 $
+    begin
+      rw [← disjoint_comap_iff surjective_mk, comap_mk_nhds_set, comap_mk_nhds_set],
+      exact separated_nhds_iff_disjoint.1 (normal_separation (hs.preimage continuous_mk)
+        (ht.preimage continuous_mk) (hd.preimage mk))
+    end }
+
+end separation_quotient
+
 variable (α)
 
-/-- A regular topological space with second countable topology is a normal space.
+/-- A T₃ topological space with second countable topology is a normal space.
 This lemma is not an instance to avoid a loop. -/
-lemma normal_space_of_regular_second_countable [second_countable_topology α] [regular_space α] :
+lemma normal_space_of_t3_second_countable [second_countable_topology α] [t3_space α] :
   normal_space α :=
 begin
   have key : ∀ {s t : set α}, is_closed t → disjoint s t →
@@ -1507,12 +1643,12 @@ begin
     refine mem_bUnion huU ⟨hxu, _⟩,
     simp only [mem_Union],
     rintro ⟨v, hvV, -, hxv⟩,
-    exact hVd v hvV ⟨hxv, hx⟩ },
+    exact (hVd v hvV).le_bot ⟨hxv, hx⟩ },
   { rcases mem_Union₂.1 (htV hx) with ⟨v, hvV, hxv⟩,
     refine mem_bUnion hvV ⟨hxv, _⟩,
     simp only [mem_Union],
     rintro ⟨u, huU, -, hxu⟩,
-    exact hUd u huU ⟨hxu, hx⟩ },
+    exact (hUd u huU).le_bot ⟨hxu, hx⟩ },
   { simp only [disjoint_left, mem_Union, mem_diff, not_exists, not_and, not_forall, not_not],
     rintro a ⟨u, huU, hau, haV⟩ v hvV hav,
     cases le_total (encodable.encode u) (encodable.encode v) with hle hle,
@@ -1521,6 +1657,58 @@ end
 
 end normality
 
+section completely_normal
+
+/-- A topological space `α` is a *completely normal Hausdorff space* if each subspace `s : set α` is
+a normal Hausdorff space. Equivalently, `α` is a `T₁` space and for any two sets `s`, `t` such that
+`closure s` is disjoint with `t` and `s` is disjoint with `closure t`, there exist disjoint
+neighbourhoods of `s` and `t`. -/
+class t5_space (α : Type u) [topological_space α] extends t1_space α : Prop :=
+(completely_normal : ∀ ⦃s t : set α⦄, disjoint (closure s) t → disjoint s (closure t) →
+  disjoint (𝓝ˢ s) (𝓝ˢ t))
+
+export t5_space (completely_normal)
+
+lemma embedding.t5_space [topological_space β] [t5_space β] {e : α → β} (he : embedding e) :
+  t5_space α :=
+begin
+  haveI := he.t1_space,
+  refine ⟨λ s t hd₁ hd₂, _⟩,
+  simp only [he.to_inducing.nhds_set_eq_comap],
+  refine disjoint_comap (completely_normal _ _),
+  { rwa [← subset_compl_iff_disjoint_left, image_subset_iff, preimage_compl,
+      ← he.closure_eq_preimage_closure_image, subset_compl_iff_disjoint_left] },
+  { rwa [← subset_compl_iff_disjoint_right, image_subset_iff, preimage_compl,
+      ← he.closure_eq_preimage_closure_image, subset_compl_iff_disjoint_right] }
+end
+
+/-- A subspace of a `T₅` space is a `T₅` space. -/
+instance [t5_space α] {p : α → Prop} : t5_space {x // p x} := embedding_subtype_coe.t5_space
+
+/-- A `T₅` space is a `T₄` space. -/
+@[priority 100] -- see Note [lower instance priority]
+instance t5_space.to_normal_space [t5_space α] : normal_space α :=
+⟨λ s t hs ht hd, separated_nhds_iff_disjoint.2 $
+  completely_normal (by rwa [hs.closure_eq]) (by rwa [ht.closure_eq])⟩
+
+open separation_quotient
+
+/-- The `separation_quotient` of a completely normal space is a T₅ space. We don't have separate
+typeclasses for completely normal spaces (without T₁ assumption) and T₅ spaces, so we use the same
+class for assumption and for conclusion.
+
+One can prove this using a homeomorphism between `α` and `separation_quotient α`. We give an
+alternative proof that works without assuming that `α` is a T₁ space. -/
+instance [t5_space α] : t5_space (separation_quotient α) :=
+{ completely_normal := λ s t hd₁ hd₂,
+    begin
+      rw [← disjoint_comap_iff surjective_mk, comap_mk_nhds_set, comap_mk_nhds_set],
+      apply t5_space.completely_normal; rw [← preimage_mk_closure],
+      exacts [hd₁.preimage mk, hd₂.preimage mk]
+    end }
+
+end completely_normal
+
 /-- In a compact t2 space, the connected component of a point equals the intersection of all
 its clopen neighbourhoods. -/
 lemma connected_component_eq_Inter_clopen [t2_space α] [compact_space α] (x : α) :
@@ -1532,30 +1720,27 @@ begin
   -- We do this by showing that any disjoint cover by two closed sets implies
   -- that one of these closed sets must contain our whole thing.
   -- To reduce to the case where the cover is disjoint on all of `α` we need that `s` is closed
-  have hs : @is_closed _ _inst_1 (⋂ (Z : {Z : set α // is_clopen Z ∧ x ∈ Z}), Z) :=
+  have hs : is_closed (⋂ (Z : {Z : set α // is_clopen Z ∧ x ∈ Z}), Z : set α) :=
     is_closed_Inter (λ Z, Z.2.1.2),
   rw (is_preconnected_iff_subset_of_fully_disjoint_closed hs),
-  intros a b ha hb hab ab_empty,
+  intros a b ha hb hab ab_disj,
   haveI := @normal_of_compact_t2 α _ _ _,
   -- Since our space is normal, we get two larger disjoint open sets containing the disjoint
   -- closed sets. If we can show that our intersection is a subset of any of these we can then
   -- "descend" this to show that it is a subset of either a or b.
-  rcases normal_separation ha hb (disjoint_iff.2 ab_empty) with ⟨u, v, hu, hv, hau, hbv, huv⟩,
+  rcases normal_separation ha hb ab_disj with ⟨u, v, hu, hv, hau, hbv, huv⟩,
   -- If we can find a clopen set around x, contained in u ∪ v, we get a disjoint decomposition
   -- Z = Z ∩ u ∪ Z ∩ v of clopen sets. The intersection of all clopen neighbourhoods will then lie
   -- in whichever of u or v x lies in and hence will be a subset of either a or b.
-  suffices : ∃ (Z : set α), is_clopen Z ∧ x ∈ Z ∧ Z ⊆ u ∪ v,
-  { cases this with Z H,
-    rw [disjoint_iff_inter_eq_empty] at huv,
-    have H1 := is_clopen_inter_of_disjoint_cover_clopen H.1 H.2.2 hu hv huv,
+  rsuffices ⟨Z, H⟩ : ∃ (Z : set α), is_clopen Z ∧ x ∈ Z ∧ Z ⊆ u ∪ v,
+  { have H1 := is_clopen_inter_of_disjoint_cover_clopen H.1 H.2.2 hu hv huv,
     rw [union_comm] at H,
-    have H2 := is_clopen_inter_of_disjoint_cover_clopen H.1 H.2.2 hv hu (inter_comm u v ▸ huv),
+    have H2 := is_clopen_inter_of_disjoint_cover_clopen H.1 H.2.2 hv hu huv.symm,
     by_cases (x ∈ u),
     -- The x ∈ u case.
     { left,
       suffices : (⋂ (Z : {Z : set α // is_clopen Z ∧ x ∈ Z}), ↑Z) ⊆ u,
-      { rw ←set.disjoint_iff_inter_eq_empty at huv,
-        replace hab : (⋂ (Z : {Z // is_clopen Z ∧ x ∈ Z}), ↑Z) ≤ a ∪ b := hab,
+      { replace hab : (⋂ (Z : {Z // is_clopen Z ∧ x ∈ Z}), ↑Z) ≤ a ∪ b := hab,
         replace this : (⋂ (Z : {Z // is_clopen Z ∧ x ∈ Z}), ↑Z) ≤ u := this,
         exact disjoint.left_le_of_le_sup_right hab (huv.mono this hbv) },
       { apply subset.trans _ (inter_subset_right Z u),
@@ -1569,49 +1754,39 @@ begin
       { exact h1} },
     right,
     suffices : (⋂ (Z : {Z : set α // is_clopen Z ∧ x ∈ Z}), ↑Z) ⊆ v,
-    { rw [inter_comm, ←set.disjoint_iff_inter_eq_empty] at huv,
-      replace hab : (⋂ (Z : {Z // is_clopen Z ∧ x ∈ Z}), ↑Z) ≤ a ∪ b := hab,
-      replace this : (⋂ (Z : {Z // is_clopen Z ∧ x ∈ Z}), ↑Z) ≤ v := this,
-      exact disjoint.left_le_of_le_sup_left hab (huv.mono this hau) },
+    { replace this : (⋂ (Z : {Z // is_clopen Z ∧ x ∈ Z}), ↑Z) ≤ v := this,
+      exact (huv.symm.mono this hau).left_le_of_le_sup_left hab },
     { apply subset.trans _ (inter_subset_right Z v),
       apply Inter_subset (λ Z : {Z : set α // is_clopen Z ∧ x ∈ Z}, ↑Z)
         ⟨Z ∩ v, H2, mem_inter H.2.1 h1⟩ } },
   -- Now we find the required Z. We utilize the fact that X \ u ∪ v will be compact,
   -- so there must be some finite intersection of clopen neighbourhoods of X disjoint to it,
   -- but a finite intersection of clopen sets is clopen so we let this be our Z.
-  have H1 := ((is_closed_compl_iff.2 (hu.union hv)).is_compact.inter_Inter_nonempty
-    (λ Z : {Z : set α // is_clopen Z ∧ x ∈ Z}, Z) (λ Z, Z.2.1.2)),
-  rw [←not_imp_not, not_forall, not_nonempty_iff_eq_empty, inter_comm] at H1,
-  have huv_union := subset.trans hab (union_subset_union hau hbv),
-  rw [← compl_compl (u ∪ v), subset_compl_iff_disjoint] at huv_union,
-  cases H1 huv_union with Zi H2,
+  have H1 := (hu.union hv).is_closed_compl.is_compact.inter_Inter_nonempty
+    (λ Z : {Z : set α // is_clopen Z ∧ x ∈ Z}, Z) (λ Z, Z.2.1.2),
+  rw [←not_disjoint_iff_nonempty_inter, imp_not_comm, not_forall] at H1,
+  cases H1 (disjoint_compl_left_iff_subset.2 $ hab.trans $ union_subset_union hau hbv) with Zi H2,
   refine ⟨(⋂ (U ∈ Zi), subtype.val U), _, _, _⟩,
-  { exact is_clopen_bInter (λ Z hZ, Z.2.1) },
+  { exact is_clopen_bInter_finset (λ Z hZ, Z.2.1) },
   { exact mem_Inter₂.2 (λ Z hZ, Z.2.2) },
-  { rwa [not_nonempty_iff_eq_empty, inter_comm, ←subset_compl_iff_disjoint, compl_compl] at H2 }
+  { rwa [←disjoint_compl_left_iff_subset, disjoint_iff_inter_eq_empty, ←not_nonempty_iff_eq_empty] }
 end
 
 section profinite
 
-variables [t2_space α]
-
-/-- A Hausdorff space with a clopen basis is totally separated. -/
-lemma tot_sep_of_zero_dim (h : is_topological_basis {s : set α | is_clopen s}) :
+/-- A T1 space with a clopen basis is totally separated. -/
+lemma totally_separated_space_of_t1_of_basis_clopen [t1_space α]
+  (h : is_topological_basis {s : set α | is_clopen s}) :
   totally_separated_space α :=
 begin
   constructor,
   rintros x - y - hxy,
-  obtain ⟨u, v, hu, hv, xu, yv, disj⟩ := t2_separation hxy,
-  obtain ⟨w, hw : is_clopen w, xw, wu⟩ := (is_topological_basis.mem_nhds_iff h).1
-    (is_open.mem_nhds hu xu),
-  refine ⟨w, wᶜ, hw.1, (is_clopen_compl_iff.2 hw).1, xw, _, _, set.inter_compl_self w⟩,
-  { intro h,
-    have : y ∈ u ∩ v := ⟨wu h, yv⟩,
-    rwa disj at this },
-  rw set.union_compl_self,
+  rcases h.mem_nhds_iff.mp (is_open_ne.mem_nhds hxy) with ⟨U, hU, hxU, hyU⟩,
+  exact ⟨U, Uᶜ, hU.is_open, hU.compl.is_open, hxU, λ h, hyU h rfl,
+    (union_compl_self U).superset, disjoint_compl_right⟩
 end
 
-variables [compact_space α]
+variables [t2_space α] [compact_space α]
 
 /-- A compact Hausdorff space is totally disconnected if and only if it is totally separated, this
   is also true for locally compact spaces. -/
@@ -1629,7 +1804,8 @@ begin
     rw [connected_component_eq_Inter_clopen, mem_Inter],
     rintro ⟨w : set α, hw : is_clopen w, hy : y ∈ w⟩,
     by_contra hx,
-    simpa using hyp wᶜ w (is_open_compl_iff.mpr hw.2) hw.1 hx hy },
+    exact hyp wᶜ w hw.2.is_open_compl hw.1 hx hy (@is_compl_compl _ w _).symm.codisjoint.top_le
+      disjoint_compl_left },
   apply totally_separated_space.totally_disconnected_space,
 end
 
@@ -1643,9 +1819,8 @@ lemma nhds_basis_clopen (x : α) : (𝓝 x).has_basis (λ s : set α, x ∈ s 
     rw connected_component_eq_Inter_clopen at this,
     intros hU,
     let N := {Z // is_clopen Z ∧ x ∈ Z},
-    suffices : ∃ Z : N, Z.val ⊆ U,
-    { rcases this with ⟨⟨s, hs, hs'⟩, hs''⟩,
-      exact ⟨s, ⟨hs', hs⟩, hs''⟩ },
+    rsuffices ⟨⟨s, hs, hs'⟩, hs''⟩ : ∃ Z : N, Z.val ⊆ U,
+    { exact ⟨s, ⟨hs', hs⟩, hs''⟩ },
     haveI : nonempty N := ⟨⟨univ, is_clopen_univ, mem_univ x⟩⟩,
     have hNcl : ∀ Z : N, is_closed Z.val := (λ Z, Z.property.1.2),
     have hdir : directed superset (λ Z : N, Z.val),
@@ -1655,7 +1830,7 @@ lemma nhds_basis_clopen (x : α) : (𝓝 x).has_basis (λ s : set α, x ∈ s 
     { intros y y_in,
       erw [this, mem_singleton_iff] at y_in,
       rwa y_in },
-    exact exists_subset_nhd_of_compact_space hdir hNcl h_nhd },
+    exact exists_subset_nhds_of_compact_space hdir hNcl h_nhd },
   { rintro ⟨V, ⟨hxV, V_op, -⟩, hUV : V ⊆ U⟩,
     rw mem_nhds_iff,
     exact ⟨V, hUV, V_op, hxV⟩ }
@@ -1675,8 +1850,8 @@ end
 /-- Every member of an open set in a compact Hausdorff totally disconnected space
   is contained in a clopen set contained in the open set.  -/
 lemma compact_exists_clopen_in_open {x : α} {U : set α} (is_open : is_open U) (memU : x ∈ U) :
-    ∃ (V : set α) (hV : is_clopen V), x ∈ V ∧ V ⊆ U :=
-  (is_topological_basis.mem_nhds_iff is_topological_basis_clopen).1 (is_open.mem_nhds memU)
+  ∃ (V : set α) (hV : is_clopen V), x ∈ V ∧ V ⊆ U :=
+(is_topological_basis.mem_nhds_iff is_topological_basis_clopen).1 (is_open.mem_nhds memU)
 
 end profinite
 
@@ -1730,7 +1905,7 @@ theorem loc_compact_t2_tot_disc_iff_tot_sep :
 begin
   split,
   { introI h,
-    exact tot_sep_of_zero_dim loc_compact_Haus_tot_disc_of_zero_dim, },
+    exact totally_separated_space_of_t1_of_basis_clopen loc_compact_Haus_tot_disc_of_zero_dim },
   apply totally_separated_space.totally_disconnected_space,
 end
 
@@ -1754,10 +1929,10 @@ begin
     swap, { exact λ Z, Z.2.1.2 },
     -- This clopen and its complement will separate the connected components of `a` and `b`
     set U : set α := (⋂ (i : {Z // is_clopen Z ∧ b ∈ Z}) (H : i ∈ fin_a), i),
-    have hU : is_clopen U := is_clopen_bInter (λ i j, i.2.1),
+    have hU : is_clopen U := is_clopen_bInter_finset (λ i j, i.2.1),
     exact ⟨U, coe '' U, hU, ha, subset_Inter₂ (λ Z _, Z.2.1.connected_component_subset Z.2.2),
       (connected_components_preimage_image U).symm ▸ hU.bUnion_connected_component_eq⟩ },
   rw connected_components.quotient_map_coe.is_clopen_preimage at hU,
-  refine ⟨Vᶜ, V, hU.compl.is_open, hU.is_open, _, hb mem_connected_component, compl_inter_self _⟩,
+  refine ⟨Vᶜ, V, hU.compl.is_open, hU.is_open, _, hb mem_connected_component, disjoint_compl_left⟩,
   exact λ h, flip set.nonempty.ne_empty ha ⟨a, mem_connected_component, h⟩,
 end
diff --git a/src/topology/sequences.lean b/src/topology/sequences.lean
index d445e4d4e0e4b..d82cd1eee584e 100644
--- a/src/topology/sequences.lean
+++ b/src/topology/sequences.lean
@@ -1,7 +1,7 @@
 /-
 Copyright (c) 2018 Jan-David Salchow. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Jan-David Salchow, Patrick Massot
+Authors: Jan-David Salchow, Patrick Massot, Yury Kudryashov
 -/
 import topology.subset_properties
 import topology.metric_space.basic
@@ -9,220 +9,273 @@ import topology.metric_space.basic
 /-!
 # Sequences in topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define sequences in topological spaces and show how they are related to
-filters and the topology. In particular, we
-* define the sequential closure of a set and prove that it's contained in the closure,
-* define a type class "sequential_space" in which closure and sequential closure agree,
-* define sequential continuity and show that it coincides with continuity in sequential spaces,
-* provide an instance that shows that every first-countable (and in particular metric) space is
-  a sequential space.
-* define sequential compactness, prove that compactness implies sequential compactness in first
-  countable spaces, and prove they are equivalent for uniform spaces having a countable uniformity
-  basis (in particular metric spaces).
+filters and the topology.
+
+## Main definitions
+
+### Set operation
+* `seq_closure s`: sequential closure of a set, the set of limits of sequences of points of `s`;
+
+### Predicates
+
+* `is_seq_closed s`: predicate saying that a set is sequentially closed, i.e., `seq_closure s ⊆ s`;
+* `seq_continuous f`: predicate saying that a function is sequentially continuous, i.e.,
+  for any sequence `u : ℕ → X` that converges to a point `x`, the sequence `f ∘ u` converges to
+  `f x`;
+* `is_seq_compact s`: predicate saying that a set is sequentially compact, i.e., every sequence
+  taking values in `s` has a converging subsequence.
+
+### Type classes
+
+* `frechet_urysohn_space X`: a typeclass saying that a topological space is a *Fréchet-Urysohn
+  space*, i.e., the sequential closure of any set is equal to its closure.
+* `sequential_space X`: a typeclass saying that a topological space is a *sequential space*, i.e.,
+  any sequentially closed set in this space is closed. This condition is weaker than being a
+  Fréchet-Urysohn space.
+* `seq_compact_space X`: a typeclass saying that a topological space is sequentially compact, i.e.,
+  every sequence in `X` has a converging subsequence.
+
+## Main results
+
+* `seq_closure_subset_closure`: closure of a set includes its sequential closure;
+* `is_closed.is_seq_closed`: a closed set is sequentially closed;
+* `is_seq_closed.seq_closure_eq`: sequential closure of a sequentially closed set `s` is equal
+  to `s`;
+* `seq_closure_eq_closure`: in a Fréchet-Urysohn space, the sequential closure of a set is equal to
+  its closure;
+* `tendsto_nhds_iff_seq_tendsto`, `frechet_urysohn_space.of_seq_tendsto_imp_tendsto`: a topological
+  space is a Fréchet-Urysohn space if and only if sequential convergence implies convergence;
+* `topological_space.first_countable_topology.frechet_urysohn_space`: every topological space with
+  first countable topology is a Fréchet-Urysohn space;
+* `frechet_urysohn_space.to_sequential_space`: every Fréchet-Urysohn space is a sequential space;
+* `is_seq_compact.is_compact`: a sequentially compact set in a uniform space with countably
+  generated uniformity is compact.
+
+## Tags
+
+sequentially closed, sequentially compact, sequential space
 -/
 
-open set filter
-open_locale topological_space
-
-variables {α : Type*} {β : Type*}
+open set function filter topological_space
+open_locale topology filter
 
-local notation f ` ⟶ ` limit := tendsto f at_top (𝓝 limit)
+variables {X Y : Type*}
 
 /-! ### Sequential closures, sequential continuity, and sequential spaces. -/
 section topological_space
-variables [topological_space α] [topological_space β]
-
-/-- A sequence converges in the sence of topological spaces iff the associated statement for filter
-holds. -/
-lemma topological_space.seq_tendsto_iff {x : ℕ → α} {limit : α} :
-  tendsto x at_top (𝓝 limit) ↔
-    ∀ U : set α, limit ∈ U → is_open U → ∃ N, ∀ n ≥ N, (x n) ∈ U :=
-(at_top_basis.tendsto_iff (nhds_basis_opens limit)).trans $
-  by simp only [and_imp, exists_prop, true_and, set.mem_Ici, ge_iff_le, id]
-
-/-- The sequential closure of a subset M ⊆ α of a topological space α is
-the set of all p ∈ α which arise as limit of sequences in M. -/
-def sequential_closure (M : set α) : set α :=
-{p | ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ M) ∧ (x ⟶ p)}
-
-lemma subset_sequential_closure (M : set α) : M ⊆ sequential_closure M :=
-assume p (_ : p ∈ M), show p ∈ sequential_closure M, from
-  ⟨λ n, p, assume n, ‹p ∈ M›, tendsto_const_nhds⟩
-
-/-- A set `s` is sequentially closed if for any converging sequence `x n` of elements of `s`,
-the limit belongs to `s` as well. -/
-def is_seq_closed (s : set α) : Prop := s = sequential_closure s
-
-/-- A convenience lemma for showing that a set is sequentially closed. -/
-lemma is_seq_closed_of_def {A : set α}
-  (h : ∀(x : ℕ → α) (p : α), (∀ n : ℕ, x n ∈ A) → (x ⟶ p) → p ∈ A) : is_seq_closed A :=
-show A = sequential_closure A, from subset.antisymm
-  (subset_sequential_closure A)
-  (show ∀ p, p ∈ sequential_closure A → p ∈ A, from
-    (assume p ⟨x, _, _⟩, show p ∈ A, from h x p ‹∀ n : ℕ, ((x n) ∈ A)› ‹(x ⟶ p)›))
+variables [topological_space X] [topological_space Y]
+
+/-- The sequential closure of a set `s : set X` in a topological space `X` is the set of all `a : X`
+which arise as limit of sequences in `s`. Note that the sequential closure of a set is not
+guaranteed to be sequentially closed. -/
+def seq_closure (s : set X) : set X :=
+{a | ∃ x : ℕ → X, (∀ n : ℕ, x n ∈ s) ∧ tendsto x at_top (𝓝 a)}
+
+lemma subset_seq_closure {s : set X} : s ⊆ seq_closure s :=
+λ p hp, ⟨const ℕ p, λ _, hp, tendsto_const_nhds⟩
 
 /-- The sequential closure of a set is contained in the closure of that set.
 The converse is not true. -/
-lemma sequential_closure_subset_closure (M : set α) : sequential_closure M ⊆ closure M :=
-assume p ⟨x, xM, xp⟩,
-mem_closure_of_tendsto xp (univ_mem' xM)
+lemma seq_closure_subset_closure {s : set X} : seq_closure s ⊆ closure s :=
+λ p ⟨x, xM, xp⟩, mem_closure_of_tendsto xp (univ_mem' xM)
+
+/-- A set `s` is sequentially closed if for any converging sequence `x n` of elements of `s`, the
+limit belongs to `s` as well. Note that the sequential closure of a set is not guaranteed to be
+sequentially closed. -/
+def is_seq_closed (s : set X) : Prop :=
+∀ ⦃x : ℕ → X⦄ ⦃p : X⦄, (∀ n, x n ∈ s) → tendsto x at_top (𝓝 p) → p ∈ s
+
+/-- The sequential closure of a sequentially closed set is the set itself. -/
+lemma is_seq_closed.seq_closure_eq {s : set X} (hs : is_seq_closed s) :
+  seq_closure s = s :=
+subset.antisymm (λ p ⟨x, hx, hp⟩, hs hx hp) subset_seq_closure
+
+/-- If a set is equal to its sequential closure, then it is sequentially closed. -/
+lemma is_seq_closed_of_seq_closure_eq {s : set X} (hs : seq_closure s = s) :
+  is_seq_closed s :=
+λ x p hxs hxp, hs ▸ ⟨x, hxs, hxp⟩
+
+/-- A set is sequentially closed iff it is equal to its sequential closure. -/
+lemma is_seq_closed_iff {s : set X} :
+  is_seq_closed s ↔ seq_closure s = s :=
+⟨is_seq_closed.seq_closure_eq, is_seq_closed_of_seq_closure_eq⟩
 
 /-- A set is sequentially closed if it is closed. -/
-lemma is_seq_closed_of_is_closed (M : set α) (_ : is_closed M) : is_seq_closed M :=
-suffices sequential_closure M ⊆ M, from
-  set.eq_of_subset_of_subset (subset_sequential_closure M) this,
-calc sequential_closure M ⊆ closure M : sequential_closure_subset_closure M
-  ... = M : is_closed.closure_eq ‹is_closed M›
-
-/-- The limit of a convergent sequence in a sequentially closed set is in that set.-/
-lemma mem_of_is_seq_closed {A : set α} (_ : is_seq_closed A) {x : ℕ → α}
-  (_ : ∀ n, x n ∈ A) {limit : α} (_ : (x ⟶ limit)) : limit ∈ A :=
-have limit ∈ sequential_closure A, from
-  show ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ A) ∧ (x ⟶ limit), from ⟨x, ‹∀ n, x n ∈ A›, ‹(x ⟶ limit)›⟩,
-eq.subst (eq.symm ‹is_seq_closed A›) ‹limit ∈ sequential_closure A›
-
-/-- The limit of a convergent sequence in a closed set is in that set.-/
-lemma mem_of_is_closed_sequential {A : set α} (_ : is_closed A) {x : ℕ → α}
-  (_ : ∀ n, x n ∈ A) {limit : α} (_ : x ⟶ limit) : limit ∈ A :=
-mem_of_is_seq_closed (is_seq_closed_of_is_closed A ‹is_closed A›) ‹∀ n, x n ∈ A› ‹(x ⟶ limit)›
-
-/-- A sequential space is a space in which 'sequences are enough to probe the topology'. This can be
- formalised by demanding that the sequential closure and the closure coincide. The following
- statements show that other topological properties can be deduced from sequences in sequential
- spaces. -/
-class sequential_space (α : Type*) [topological_space α] : Prop :=
-(sequential_closure_eq_closure : ∀ M : set α, sequential_closure M = closure M)
+protected lemma is_closed.is_seq_closed {s : set X} (hc : is_closed s) : is_seq_closed s :=
+λ u x hu hx, hc.mem_of_tendsto hx (eventually_of_forall hu)
+
+/-- A topological space is called a *Fréchet-Urysohn space*, if the sequential closure of any set
+is equal to its closure. Since one of the inclusions is trivial, we require only the non-trivial one
+in the definition. -/
+class frechet_urysohn_space (X : Type*) [topological_space X] : Prop :=
+(closure_subset_seq_closure : ∀ s : set X, closure s ⊆ seq_closure s)
+
+lemma seq_closure_eq_closure [frechet_urysohn_space X] (s : set X) :
+  seq_closure s = closure s :=
+seq_closure_subset_closure.antisymm $ frechet_urysohn_space.closure_subset_seq_closure s
+
+/-- In a Fréchet-Urysohn space, a point belongs to the closure of a set iff it is a limit
+of a sequence taking values in this set. -/
+lemma mem_closure_iff_seq_limit [frechet_urysohn_space X] {s : set X} {a : X} :
+  a ∈ closure s ↔ ∃ x : ℕ → X, (∀ n : ℕ, x n ∈ s) ∧ tendsto x at_top (𝓝 a) :=
+by { rw [← seq_closure_eq_closure], refl }
+
+/-- If the domain of a function `f : α → β` is a Fréchet-Urysohn space, then convergence
+is equivalent to sequential convergence. See also `filter.tendsto_iff_seq_tendsto` for a version
+that works for any pair of filters assuming that the filter in the domain is countably generated.
+
+This property is equivalent to the definition of `frechet_urysohn_space`, see
+`frechet_urysohn_space.of_seq_tendsto_imp_tendsto`. -/
+lemma tendsto_nhds_iff_seq_tendsto [frechet_urysohn_space X] {f : X → Y} {a : X} {b : Y} :
+  tendsto f (𝓝 a) (𝓝 b) ↔ ∀ u : ℕ → X, tendsto u at_top (𝓝 a) → tendsto (f ∘ u) at_top (𝓝 b) :=
+begin
+  refine ⟨λ hf u hu, hf.comp hu,
+    λ h, ((nhds_basis_closeds _).tendsto_iff (nhds_basis_closeds _)).2 _⟩,
+  rintro s ⟨hbs, hsc⟩,
+  refine ⟨closure (f ⁻¹' s), ⟨mt _ hbs, is_closed_closure⟩, λ x, mt $ λ hx, subset_closure hx⟩,
+  rw [← seq_closure_eq_closure],
+  rintro ⟨u, hus, hu⟩,
+  exact hsc.mem_of_tendsto (h u hu) (eventually_of_forall hus)
+end
+
+/-- An alternative construction for `frechet_urysohn_space`: if sequential convergence implies
+convergence, then the space is a Fréchet-Urysohn space. -/
+lemma frechet_urysohn_space.of_seq_tendsto_imp_tendsto
+  (h : ∀ (f : X → Prop) (a : X),
+    (∀ u : ℕ → X, tendsto u at_top (𝓝 a) → tendsto (f ∘ u) at_top (𝓝 (f a))) → continuous_at f a) :
+  frechet_urysohn_space X :=
+begin
+  refine ⟨λ s x hcx, _⟩,
+  specialize h (∉ s) x,
+  by_cases hx : x ∈ s, { exact subset_seq_closure hx },
+  simp_rw [(∘), continuous_at, hx, not_false_iff, nhds_true, tendsto_pure, eq_true_iff,
+    ← mem_compl_iff, eventually_mem_set, ← mem_interior_iff_mem_nhds, interior_compl] at h,
+  rw [mem_compl_iff, imp_not_comm] at h,
+  simp only [not_forall, not_eventually, mem_compl_iff, not_not] at h,
+  rcases h hcx with ⟨u, hux, hus⟩,
+  rcases extraction_of_frequently_at_top hus with ⟨φ, φ_mono, hφ⟩,
+  exact ⟨u ∘ φ, hφ, hux.comp φ_mono.tendsto_at_top⟩
+end
+
+/-- Every first-countable space is a Fréchet-Urysohn space. -/
+@[priority 100] -- see Note [lower instance priority]
+instance topological_space.first_countable_topology.frechet_urysohn_space
+  [first_countable_topology X] : frechet_urysohn_space X :=
+frechet_urysohn_space.of_seq_tendsto_imp_tendsto $ λ f a, tendsto_iff_seq_tendsto.2
+
+/-- A topological space is said to be a *sequential space* if any sequentially closed set in this
+space is closed. This condition is weaker than being a Fréchet-Urysohn space. -/
+class sequential_space (X : Type*) [topological_space X] : Prop :=
+(is_closed_of_seq : ∀ s : set X, is_seq_closed s → is_closed s)
+
+/-- Every Fréchet-Urysohn space is a sequential space. -/
+@[priority 100] -- see Note [lower instance priority]
+instance frechet_urysohn_space.to_sequential_space [frechet_urysohn_space X] :
+  sequential_space X :=
+⟨λ s hs, by rw [← closure_eq_iff_is_closed, ← seq_closure_eq_closure, hs.seq_closure_eq]⟩
+
+/-- In a sequential space, a sequentially closed set is closed. -/
+protected lemma is_seq_closed.is_closed [sequential_space X] {s : set X} (hs : is_seq_closed s) :
+  is_closed s :=
+sequential_space.is_closed_of_seq s hs
 
 /-- In a sequential space, a set is closed iff it's sequentially closed. -/
-lemma is_seq_closed_iff_is_closed [sequential_space α] {M : set α} :
+lemma is_seq_closed_iff_is_closed [sequential_space X] {M : set X} :
   is_seq_closed M ↔ is_closed M :=
-iff.intro
-  (assume _, closure_eq_iff_is_closed.mp (eq.symm
-    (calc M = sequential_closure M : by assumption
-        ... = closure M            : sequential_space.sequential_closure_eq_closure M)))
-  (is_seq_closed_of_is_closed M)
-
-/-- In a sequential space, a point belongs to the closure of a set iff it is a limit of a sequence
-taking values in this set. -/
-lemma mem_closure_iff_seq_limit [sequential_space α] {s : set α} {a : α} :
-  a ∈ closure s ↔ ∃ x : ℕ → α, (∀ n : ℕ, x n ∈ s) ∧ (x ⟶ a) :=
-by { rw ← sequential_space.sequential_closure_eq_closure, exact iff.rfl }
+⟨is_seq_closed.is_closed, is_closed.is_seq_closed⟩
 
 /-- A function between topological spaces is sequentially continuous if it commutes with limit of
  convergent sequences. -/
-def sequentially_continuous (f : α → β) : Prop :=
-∀ (x : ℕ → α), ∀ {limit : α}, (x ⟶ limit) → (f∘x ⟶ f limit)
-
-/- A continuous function is sequentially continuous. -/
-lemma continuous.to_sequentially_continuous {f : α → β} (_ : continuous f) :
-  sequentially_continuous f :=
-assume x limit (_ : x ⟶ limit),
-have tendsto f (𝓝 limit) (𝓝 (f limit)), from continuous.tendsto ‹continuous f› limit,
-show (f ∘ x) ⟶ (f limit), from tendsto.comp this ‹(x ⟶ limit)›
-
-/-- In a sequential space, continuity and sequential continuity coincide. -/
-lemma continuous_iff_sequentially_continuous {f : α → β} [sequential_space α] :
-  continuous f ↔ sequentially_continuous f :=
-iff.intro
-  (assume _, ‹continuous f›.to_sequentially_continuous)
-  (assume : sequentially_continuous f, show continuous f, from
-    suffices h : ∀ {A : set β}, is_closed A → is_seq_closed (f ⁻¹' A), from
-      continuous_iff_is_closed.mpr (assume A _, is_seq_closed_iff_is_closed.mp $ h ‹is_closed A›),
-    assume A (_ : is_closed A),
-      is_seq_closed_of_def $
-        assume (x : ℕ → α) p (_ : ∀ n, f (x n) ∈ A) (_ : x ⟶ p),
-        have (f ∘ x) ⟶ (f p), from ‹sequentially_continuous f› x ‹(x ⟶ p)›,
-        show f p ∈ A, from
-          mem_of_is_closed_sequential ‹is_closed A› ‹∀ n, f (x n) ∈ A› ‹(f∘x ⟶ f p)›)
+def seq_continuous (f : X → Y) : Prop :=
+∀ ⦃x : ℕ → X⦄ ⦃p : X⦄, tendsto x at_top (𝓝 p) → tendsto (f ∘ x) at_top (𝓝 (f p))
 
-end topological_space
+/-- The preimage of a sequentially closed set under a sequentially continuous map is sequentially
+closed. -/
+lemma is_seq_closed.preimage {f : X → Y} {s : set Y} (hs : is_seq_closed s)
+  (hf : seq_continuous f) :
+  is_seq_closed (f ⁻¹' s) :=
+λ x p hx hp, hs hx (hf hp)
 
-namespace topological_space
+/- A continuous function is sequentially continuous. -/
+protected lemma continuous.seq_continuous {f : X → Y} (hf : continuous f) :
+  seq_continuous f :=
+λ x p hx, (hf.tendsto p).comp hx
 
-namespace first_countable_topology
+/-- A sequentially continuous function defined on a sequential space is continuous. -/
+protected lemma seq_continuous.continuous [sequential_space X] {f : X → Y} (hf : seq_continuous f) :
+  continuous f :=
+continuous_iff_is_closed.mpr $ λ s hs, (hs.is_seq_closed.preimage hf).is_closed
 
-variables [topological_space α] [first_countable_topology α]
+/-- If the domain of a function is a sequential space, then continuity of this function is
+equivalent to its sequential continuity. -/
+lemma continuous_iff_seq_continuous [sequential_space X] {f : X → Y} :
+  continuous f ↔ seq_continuous f :=
+⟨continuous.seq_continuous, seq_continuous.continuous⟩
 
-/-- Every first-countable space is sequential. -/
-@[priority 100] -- see Note [lower instance priority]
-instance : sequential_space α :=
-⟨show ∀ M, sequential_closure M = closure M, from assume M,
-  suffices closure M ⊆ sequential_closure M,
-    from set.subset.antisymm (sequential_closure_subset_closure M) this,
-  -- For every p ∈ closure M, we need to construct a sequence x in M that converges to p:
-  assume (p : α) (hp : p ∈ closure M),
-  -- Since we are in a first-countable space, the neighborhood filter around `p` has a decreasing
-  -- basis `U` indexed by `ℕ`.
-  let ⟨U, hU⟩ := (𝓝 p).exists_antitone_basis in
-  -- Since `p ∈ closure M`, there is an element in each `M ∩ U i`
-  have hp : ∀ (i : ℕ), ∃ (y : α), y ∈ M ∧ y ∈ U i,
-    by simpa using (mem_closure_iff_nhds_basis hU.1).mp hp,
-  begin
-    -- The axiom of (countable) choice builds our sequence from the later fact
-    choose u hu using hp,
-    rw forall_and_distrib at hu,
-    -- It clearly takes values in `M`
-    use [u, hu.1],
-    -- and converges to `p` because the basis is decreasing.
-    apply hU.tendsto hu.2,
-  end⟩
+lemma quotient_map.sequential_space [sequential_space X] {f : X → Y} (hf : quotient_map f) :
+  sequential_space Y :=
+⟨λ s hs, hf.is_closed_preimage.mp $ (hs.preimage $ hf.continuous.seq_continuous).is_closed⟩
 
-
-end first_countable_topology
+/-- The quotient of a sequential space is a sequential space. -/
+instance [sequential_space X] {s : setoid X} : sequential_space (quotient s) :=
+quotient_map_quot_mk.sequential_space
 
 end topological_space
 
 section seq_compact
 open topological_space topological_space.first_countable_topology
-variables [topological_space α]
+variables [topological_space X]
 
 /-- A set `s` is sequentially compact if every sequence taking values in `s` has a
 converging subsequence. -/
-def is_seq_compact (s : set α) :=
-  ∀ ⦃u : ℕ → α⦄, (∀ n, u n ∈ s) →
-    ∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x)
+def is_seq_compact (s : set X) :=
+∀ ⦃x : ℕ → X⦄, (∀ n, x n ∈ s) → ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a)
 
-/-- A space `α` is sequentially compact if every sequence in `α` has a
+/-- A space `X` is sequentially compact if every sequence in `X` has a
 converging subsequence. -/
-class seq_compact_space (α : Type*) [topological_space α] : Prop :=
-(seq_compact_univ : is_seq_compact (univ : set α))
+@[mk_iff] class seq_compact_space (X : Type*) [topological_space X] : Prop :=
+(seq_compact_univ : is_seq_compact (univ : set X))
+
+export seq_compact_space (seq_compact_univ)
 
-lemma is_seq_compact.subseq_of_frequently_in {s : set α} (hs : is_seq_compact s) {u : ℕ → α}
-  (hu : ∃ᶠ n in at_top, u n ∈ s) :
-  ∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
-let ⟨ψ, hψ, huψ⟩ := extraction_of_frequently_at_top hu, ⟨x, x_in, φ, hφ, h⟩ := hs huψ in
-⟨x, x_in, ψ ∘ φ, hψ.comp hφ, h⟩
+lemma is_seq_compact.subseq_of_frequently_in {s : set X} (hs : is_seq_compact s) {x : ℕ → X}
+  (hx : ∃ᶠ n in at_top, x n ∈ s) :
+  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+let ⟨ψ, hψ, huψ⟩ := extraction_of_frequently_at_top hx, ⟨a, a_in, φ, hφ, h⟩ := hs huψ in
+⟨a, a_in, ψ ∘ φ, hψ.comp hφ, h⟩
 
-lemma seq_compact_space.tendsto_subseq [seq_compact_space α] (u : ℕ → α) :
-  ∃ x (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
-let ⟨x, _, φ, mono, h⟩ := seq_compact_space.seq_compact_univ (by simp : ∀ n, u n ∈ univ) in
-⟨x, φ, mono, h⟩
+lemma seq_compact_space.tendsto_subseq [seq_compact_space X] (x : ℕ → X) :
+  ∃ a (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+let ⟨a, _, φ, mono, h⟩ := seq_compact_univ (λ n, mem_univ (x n)) in ⟨a, φ, mono, h⟩
 
 section first_countable_topology
-variables [first_countable_topology α]
+variables [first_countable_topology X]
 open topological_space.first_countable_topology
 
-lemma is_compact.is_seq_compact {s : set α} (hs : is_compact s) : is_seq_compact s :=
-λ u u_in,
-let ⟨x, x_in, hx⟩ := @hs (map u at_top) _
-  (le_principal_iff.mpr (univ_mem' u_in : _)) in ⟨x, x_in, tendsto_subseq hx⟩
+protected lemma is_compact.is_seq_compact {s : set X} (hs : is_compact s) : is_seq_compact s :=
+λ x x_in, let ⟨a, a_in, ha⟩ := hs (tendsto_principal.mpr (eventually_of_forall x_in))
+in ⟨a, a_in, tendsto_subseq ha⟩
 
-lemma is_compact.tendsto_subseq' {s : set α} {u : ℕ → α} (hs : is_compact s)
-  (hu : ∃ᶠ n in at_top, u n ∈ s) :
-∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
-hs.is_seq_compact.subseq_of_frequently_in hu
+lemma is_compact.tendsto_subseq' {s : set X} {x : ℕ → X} (hs : is_compact s)
+  (hx : ∃ᶠ n in at_top, x n ∈ s) :
+  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+hs.is_seq_compact.subseq_of_frequently_in hx
 
-lemma is_compact.tendsto_subseq {s : set α} {u : ℕ → α} (hs : is_compact s) (hu : ∀ n, u n ∈ s) :
-∃ (x ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
-hs.is_seq_compact hu
+lemma is_compact.tendsto_subseq {s : set X} {x : ℕ → X} (hs : is_compact s) (hx : ∀ n, x n ∈ s) :
+  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+hs.is_seq_compact hx
 
 @[priority 100] -- see Note [lower instance priority]
-instance first_countable_topology.seq_compact_of_compact [compact_space α] : seq_compact_space α :=
-⟨compact_univ.is_seq_compact⟩
+instance first_countable_topology.seq_compact_of_compact [compact_space X] : seq_compact_space X :=
+⟨is_compact_univ.is_seq_compact⟩
 
-lemma compact_space.tendsto_subseq [compact_space α] (u : ℕ → α) :
-  ∃ x (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 x) :=
-seq_compact_space.tendsto_subseq u
+lemma compact_space.tendsto_subseq [compact_space X] (x : ℕ → X) :
+  ∃ a (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+seq_compact_space.tendsto_subseq x
 
 end first_countable_topology
 end seq_compact
@@ -232,164 +285,108 @@ section uniform_space_seq_compact
 open_locale uniformity
 open uniform_space prod
 
-variables [uniform_space β] {s : set β}
+variables [uniform_space X] {s : set X}
 
-lemma lebesgue_number_lemma_seq {ι : Type*} [is_countably_generated (𝓤 β)] {c : ι → set β}
-  (hs : is_seq_compact s) (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
-  ∃ V ∈ 𝓤 β, symmetric_rel V ∧ ∀ x ∈ s, ∃ i, ball x V ⊆ c i :=
-begin
-  classical,
-  obtain ⟨V, hV, Vsymm⟩ :
-    ∃ V : ℕ → set (β × β), (𝓤 β).has_antitone_basis V ∧ ∀ n, swap ⁻¹' V n = V n,
-      from uniform_space.has_seq_basis β,
-  suffices : ∃ n, ∀ x ∈ s, ∃ i, ball x (V n) ⊆ c i,
-  { cases this with n hn,
-    exact ⟨V n, hV.to_has_basis.mem_of_mem trivial, Vsymm n, hn⟩ },
-  by_contradiction H,
-  obtain ⟨x, x_in, hx⟩ : ∃ x : ℕ → β, (∀ n, x n ∈ s) ∧ ∀ n i, ¬ ball (x n) (V n) ⊆ c i,
-  { push_neg at H,
-    choose x hx using H,
-    exact ⟨x, forall_and_distrib.mp hx⟩ }, clear H,
-  obtain ⟨x₀, x₀_in, φ, φ_mono, hlim⟩ : ∃ (x₀ ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ (x ∘ φ ⟶ x₀),
-    from hs x_in, clear hs,
-  obtain ⟨i₀, x₀_in⟩ : ∃ i₀, x₀ ∈ c i₀,
-  { rcases hc₂ x₀_in with ⟨_, ⟨i₀, rfl⟩, x₀_in_c⟩,
-    exact ⟨i₀, x₀_in_c⟩ }, clear hc₂,
-  obtain ⟨n₀, hn₀⟩ : ∃ n₀, ball x₀ (V n₀) ⊆ c i₀,
-  { rcases (nhds_basis_uniformity hV.to_has_basis).mem_iff.mp
-      (is_open_iff_mem_nhds.mp (hc₁ i₀) _ x₀_in) with ⟨n₀, _, h⟩,
-    use n₀,
-    rwa ← ball_eq_of_symmetry (Vsymm n₀) at h }, clear hc₁,
-  obtain ⟨W, W_in, hWW⟩ : ∃ W ∈ 𝓤 β, W ○ W ⊆ V n₀,
-    from comp_mem_uniformity_sets (hV.to_has_basis.mem_of_mem trivial),
-  obtain ⟨N, x_φ_N_in, hVNW⟩ : ∃ N, x (φ N) ∈ ball x₀ W ∧ V (φ N) ⊆ W,
-  { obtain ⟨N₁, h₁⟩ : ∃ N₁, ∀ n ≥ N₁, x (φ n) ∈ ball x₀ W,
-      from tendsto_at_top'.mp hlim _ (mem_nhds_left x₀ W_in),
-    obtain ⟨N₂, h₂⟩ : ∃ N₂, V (φ N₂) ⊆ W,
-    { rcases hV.to_has_basis.mem_iff.mp W_in with ⟨N, _, hN⟩,
-      use N,
-      exact subset.trans (hV.antitone $ φ_mono.id_le _) hN },
-    have : φ N₂ ≤ φ (max N₁ N₂),
-      from φ_mono.le_iff_le.mpr (le_max_right _ _),
-    exact ⟨max N₁ N₂, h₁ _ (le_max_left _ _), trans (hV.antitone this) h₂⟩ },
-  suffices : ball (x (φ N)) (V (φ N)) ⊆ c i₀,
-    from hx (φ N) i₀ this,
-  calc
-    ball (x $ φ N) (V $ φ N) ⊆ ball (x $ φ N) W : preimage_mono hVNW
-                         ... ⊆ ball x₀ (V n₀)   : ball_subset_of_comp_subset x_φ_N_in hWW
-                         ... ⊆ c i₀             : hn₀,
-end
+lemma is_seq_compact.exists_tendsto_of_frequently_mem (hs : is_seq_compact s) {u : ℕ → X}
+  (hu : ∃ᶠ n in at_top, u n ∈ s) (huc : cauchy_seq u) :
+  ∃ x ∈ s, tendsto u at_top (𝓝 x) :=
+let ⟨x, hxs, φ, φ_mono, hx⟩ := hs.subseq_of_frequently_in hu
+in ⟨x, hxs, tendsto_nhds_of_cauchy_seq_of_subseq huc φ_mono.tendsto_at_top hx⟩
 
-lemma is_seq_compact.totally_bounded (h : is_seq_compact s) : totally_bounded s :=
+lemma is_seq_compact.exists_tendsto (hs : is_seq_compact s) {u : ℕ → X} (hu : ∀ n, u n ∈ s)
+  (huc : cauchy_seq u) : ∃ x ∈ s, tendsto u at_top (𝓝 x) :=
+hs.exists_tendsto_of_frequently_mem (frequently_of_forall hu) huc
+
+/-- A sequentially compact set in a uniform space is totally bounded. -/
+protected lemma is_seq_compact.totally_bounded (h : is_seq_compact s) : totally_bounded s :=
 begin
-  classical,
-  apply totally_bounded_of_forall_symm,
+  intros V V_in,
   unfold is_seq_compact at h,
   contrapose! h,
-  rcases h with ⟨V, V_in, V_symm, h⟩,
-  simp_rw [not_subset] at h,
-  have : ∀ (t : set β), finite t → ∃ a, a ∈ s ∧ a ∉ ⋃ y ∈ t, ball y V,
-  { intros t ht,
-    obtain ⟨a, a_in, H⟩ : ∃ a ∈ s, ∀ (x : β), x ∈ t → (x, a) ∉ V,
-      by simpa [ht] using h t,
-    use [a, a_in],
-    intro H',
-    obtain ⟨x, x_in, hx⟩ := mem_Union₂.mp H',
-    exact H x x_in hx },
-  cases seq_of_forall_finite_exists this with u hu, clear h this,
-  simp [forall_and_distrib] at hu,
-  cases hu with u_in hu,
-  use [u, u_in], clear u_in,
-  intros x x_in φ,
-  intros hφ huφ,
+  obtain ⟨u, u_in, hu⟩ : ∃ u : ℕ → X, (∀ n, u n ∈ s) ∧ ∀ n m, m < n → u m ∉ ball (u n) V,
+  { simp only [not_subset, mem_Union₂, not_exists, exists_prop] at h,
+    simpa only [forall_and_distrib, ball_image_iff, not_and] using seq_of_forall_finite_exists h },
+  refine ⟨u, u_in, λ x x_in φ hφ huφ, _⟩,
   obtain ⟨N, hN⟩ : ∃ N, ∀ p q, p ≥ N → q ≥ N → (u (φ p), u (φ q)) ∈ V,
     from huφ.cauchy_seq.mem_entourage V_in,
-  specialize hN N (N+1) (le_refl N) (nat.le_succ N),
-  specialize hu (φ $ N+1) (φ N) (hφ $ lt_add_one N),
-  exact hu hN,
+  exact hu (φ $ N + 1) (φ N) (hφ $ lt_add_one N) (hN (N + 1) N N.le_succ le_rfl)
 end
 
-protected lemma is_seq_compact.is_compact [is_countably_generated $ 𝓤 β] (hs : is_seq_compact s) :
-  is_compact s :=
+variables [is_countably_generated (𝓤 X)]
+
+/-- A sequentially compact set in a uniform set with countably generated uniformity filter
+is complete. -/
+protected lemma is_seq_compact.is_complete (hs : is_seq_compact s) : is_complete s :=
 begin
-  classical,
-  rw is_compact_iff_finite_subcover,
-  intros ι U Uop s_sub,
-  rcases lebesgue_number_lemma_seq hs Uop s_sub with ⟨V, V_in, Vsymm, H⟩,
-  rcases totally_bounded_iff_subset.mp hs.totally_bounded V V_in with ⟨t,t_sub, tfin,  ht⟩,
-  have : ∀ x : t, ∃ (i : ι), ball x.val V ⊆ U i,
-  { rintros ⟨x, x_in⟩,
-    exact H x (t_sub x_in) },
-  choose i hi using this,
-  haveI : fintype t := tfin.fintype,
-  use finset.image i finset.univ,
-  transitivity ⋃ y ∈ t, ball y V,
-  { intros x x_in,
-    specialize ht x_in,
-    rw mem_Union₂ at *,
-    simp_rw ball_eq_of_symmetry Vsymm,
-    exact ht },
-  { refine Union₂_mono' (λ x x_in, _),
-    exact ⟨i ⟨x, x_in⟩, finset.mem_image_of_mem _ (finset.mem_univ _), hi ⟨x, x_in⟩⟩ },
+  intros l hl hls,
+  haveI := hl.1,
+  rcases exists_antitone_basis (𝓤 X) with ⟨V, hV⟩,
+  choose W hW hWV using λ n, comp_mem_uniformity_sets (hV.mem n),
+  have hWV' : ∀ n, W n ⊆ V n, from λ n ⟨x, y⟩ hx, @hWV n (x, y) ⟨x, refl_mem_uniformity $ hW _, hx⟩,
+  obtain ⟨t, ht_anti, htl, htW, hts⟩ : ∃ t : ℕ → set X, antitone t ∧ (∀ n, t n ∈ l) ∧
+    (∀ n, t n ×ˢ t n ⊆ W n) ∧ (∀ n, t n ⊆ s),
+  { have : ∀ n, ∃ t ∈ l, t ×ˢ t ⊆ W n ∧ t ⊆ s,
+    { rw [le_principal_iff] at hls,
+      have : ∀ n, W n ∩ s ×ˢ s ∈ l ×ᶠ l := λ n, inter_mem (hl.2 (hW n)) (prod_mem_prod hls hls),
+      simpa only [l.basis_sets.prod_self.mem_iff, true_implies_iff, subset_inter_iff,
+        prod_self_subset_prod_self, and.assoc] using this },
+    choose t htl htW hts,
+    have : ∀ n, (⋂ k ≤ n, t k) ⊆ t n, from λ n, Inter₂_subset _ le_rfl,
+    exact ⟨λ n, ⋂ k ≤ n, t k, λ m n h, bInter_subset_bInter_left (λ k (hk : k ≤ m), hk.trans h),
+      λ n, (bInter_mem (finite_le_nat n)).2 (λ k hk, htl k),
+      λ n, (prod_mono (this n) (this n)).trans (htW n), λ n, (this n).trans (hts n)⟩ },
+  choose u hu using λ n, filter.nonempty_of_mem (htl n),
+  have huc : cauchy_seq u := hV.to_has_basis.cauchy_seq_iff.2
+    (λ N hN, ⟨N, λ m hm n hn, hWV' _ $ @htW N (_, _) ⟨ht_anti hm (hu _), (ht_anti hn (hu _))⟩⟩),
+  rcases hs.exists_tendsto (λ n, hts n (hu n)) huc with ⟨x, hxs, hx⟩,
+  refine ⟨x, hxs, (nhds_basis_uniformity' hV.to_has_basis).ge_iff.2 $ λ N hN, _⟩,
+  obtain ⟨n, hNn, hn⟩ : ∃ n, N ≤ n ∧ u n ∈ ball x (W N),
+    from ((eventually_ge_at_top N).and (hx $ ball_mem_nhds x (hW N))).exists,
+  refine mem_of_superset (htl n) (λ y hy, hWV N ⟨u n, _, htW N ⟨_, _⟩⟩),
+  exacts [hn, ht_anti hNn (hu n), ht_anti hNn hy]
 end
 
+/-- If `𝓤 β` is countably generated, then any sequentially compact set is compact. -/
+protected lemma is_seq_compact.is_compact (hs : is_seq_compact s) : is_compact s :=
+is_compact_iff_totally_bounded_is_complete.2 ⟨hs.totally_bounded, hs.is_complete⟩
+
 /-- A version of Bolzano-Weistrass: in a uniform space with countably generated uniformity filter
 (e.g., in a metric space), a set is compact if and only if it is sequentially compact. -/
-protected lemma uniform_space.compact_iff_seq_compact [is_countably_generated $ 𝓤 β] :
- is_compact s ↔ is_seq_compact s :=
+protected lemma uniform_space.is_compact_iff_is_seq_compact : is_compact s ↔ is_seq_compact s :=
 ⟨λ H, H.is_seq_compact, λ H, H.is_compact⟩
 
-lemma uniform_space.compact_space_iff_seq_compact_space [is_countably_generated $ 𝓤 β] :
-  compact_space β ↔ seq_compact_space β :=
-have key : is_compact (univ : set β) ↔ is_seq_compact univ := uniform_space.compact_iff_seq_compact,
-⟨λ ⟨h⟩, ⟨key.mp h⟩, λ ⟨h⟩, ⟨key.mpr h⟩⟩
+lemma uniform_space.compact_space_iff_seq_compact_space : compact_space X ↔ seq_compact_space X :=
+by simp only [← is_compact_univ_iff, seq_compact_space_iff,
+  uniform_space.is_compact_iff_is_seq_compact]
 
 end uniform_space_seq_compact
 
 section metric_seq_compact
 
-variables [metric_space β] {s : set β}
+variables [pseudo_metric_space X]
 open metric
 
-/-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
+lemma seq_compact.lebesgue_number_lemma_of_metric {ι : Sort*} {c : ι → set X}
+  {s : set X} (hs : is_seq_compact s) (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
+  ∃ δ > 0, ∀ a ∈ s, ∃ i, ball a δ ⊆ c i :=
+lebesgue_number_lemma_of_metric hs.is_compact hc₁ hc₂
+
+variables [proper_space X] {s : set X}
+
+/-- A version of **Bolzano-Weistrass**: in a proper metric space (eg. $ℝ^n$),
 every bounded sequence has a converging subsequence. This version assumes only
 that the sequence is frequently in some bounded set. -/
-lemma tendsto_subseq_of_frequently_bounded [proper_space β] (hs : bounded s)
-  {u : ℕ → β} (hu : ∃ᶠ n in at_top, u n ∈ s) :
-  ∃ b ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 b) :=
-begin
-  have hcs : is_compact (closure s) :=
-    compact_iff_closed_bounded.mpr ⟨is_closed_closure, bounded_closure_of_bounded hs⟩,
-  replace hcs : is_seq_compact (closure s),
-    from uniform_space.compact_iff_seq_compact.mp hcs,
-  have hu' : ∃ᶠ n in at_top, u n ∈ closure s,
-  { apply frequently.mono hu,
-    intro n,
-    apply subset_closure },
-  exact hcs.subseq_of_frequently_in hu',
-end
+lemma tendsto_subseq_of_frequently_bounded (hs : bounded s)
+  {x : ℕ → X} (hx : ∃ᶠ n in at_top, x n ∈ s) :
+  ∃ a ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+have hcs : is_seq_compact (closure s), from hs.is_compact_closure.is_seq_compact,
+have hu' : ∃ᶠ n in at_top, x n ∈ closure s, from hx.mono (λ n hn, subset_closure hn),
+hcs.subseq_of_frequently_in hu'
 
 /-- A version of Bolzano-Weistrass: in a proper metric space (eg. $ℝ^n$),
 every bounded sequence has a converging subsequence. -/
-lemma tendsto_subseq_of_bounded [proper_space β] (hs : bounded s)
-  {u : ℕ → β} (hu : ∀ n, u n ∈ s) :
-∃ b ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 b) :=
-tendsto_subseq_of_frequently_bounded hs $ frequently_of_forall hu
-
-lemma seq_compact.lebesgue_number_lemma_of_metric
-  {ι : Type*} {c : ι → set β} (hs : is_seq_compact s)
-  (hc₁ : ∀ i, is_open (c i)) (hc₂ : s ⊆ ⋃ i, c i) :
-  ∃ δ > 0, ∀ x ∈ s, ∃ i, ball x δ ⊆ c i :=
-begin
-  rcases lebesgue_number_lemma_seq hs hc₁ hc₂ with ⟨V, V_in, _, hV⟩,
-  rcases uniformity_basis_dist.mem_iff.mp V_in with ⟨δ, δ_pos, h⟩,
-  use [δ, δ_pos],
-  intros x x_in,
-  rcases hV x x_in with ⟨i, hi⟩,
-  use i,
-  have := ball_mono h x,
-  rw ball_eq_ball' at this,
-  exact subset.trans this hi,
-end
+lemma tendsto_subseq_of_bounded (hs : bounded s) {x : ℕ → X} (hx : ∀ n, x n ∈ s) :
+  ∃ a ∈ closure s, ∃ φ : ℕ → ℕ, strict_mono φ ∧ tendsto (x ∘ φ) at_top (𝓝 a) :=
+tendsto_subseq_of_frequently_bounded hs $ frequently_of_forall hx
 
 end metric_seq_compact
diff --git a/src/topology/sets/closeds.lean b/src/topology/sets/closeds.lean
index 0c1f1b10fced6..dbe085444079e 100644
--- a/src/topology/sets/closeds.lean
+++ b/src/topology/sets/closeds.lean
@@ -8,6 +8,9 @@ import topology.sets.opens
 /-!
 # Closed sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define a few types of closed sets in a topological space.
 
 ## Main Definitions
@@ -17,9 +20,9 @@ For a topological space `α`,
 * `clopens α`: The type of clopen sets.
 -/
 
-open set
+open order order_dual set
 
-variables {α β : Type*} [topological_space α] [topological_space β]
+variables {ι α β : Type*} [topological_space α] [topological_space β]
 
 namespace topological_space
 
@@ -43,25 +46,135 @@ lemma closed (s : closeds α) : is_closed (s : set α) := s.closed'
 
 @[simp] lemma coe_mk (s : set α) (h) : (mk s h : set α) = s := rfl
 
-instance : has_sup (closeds α) := ⟨λ s t, ⟨s ∪ t, s.closed.union t.closed⟩⟩
-instance : has_inf (closeds α) := ⟨λ s t, ⟨s ∩ t, s.closed.inter t.closed⟩⟩
-instance : has_top (closeds α) := ⟨⟨univ, is_closed_univ⟩⟩
-instance : has_bot (closeds α) := ⟨⟨∅, is_closed_empty⟩⟩
-
-instance : distrib_lattice (closeds α) :=
-set_like.coe_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)
-instance : bounded_order (closeds α) := bounded_order.lift (coe : _ → set α) (λ _ _, id) rfl rfl
+/-- The closure of a set, as an element of `closeds`. -/
+protected def closure (s : set α) : closeds α := ⟨closure s, is_closed_closure⟩
+
+lemma gc : galois_connection closeds.closure (coe : closeds α → set α) :=
+λ s U, ⟨subset_closure.trans, λ h, closure_minimal h U.closed⟩
+
+/-- The galois coinsertion between sets and opens. -/
+def gi : galois_insertion (@closeds.closure α _) coe :=
+{ choice := λ s hs, ⟨s, closure_eq_iff_is_closed.1 $ hs.antisymm subset_closure⟩,
+  gc := gc,
+  le_l_u := λ _, subset_closure,
+  choice_eq := λ s hs, set_like.coe_injective $ subset_closure.antisymm hs }
+
+instance : complete_lattice (closeds α) :=
+complete_lattice.copy (galois_insertion.lift_complete_lattice gi)
+/- le  -/ _ rfl
+/- top -/ ⟨univ, is_closed_univ⟩ rfl
+/- bot -/ ⟨∅, is_closed_empty⟩ (set_like.coe_injective closure_empty.symm)
+/- sup -/ (λ s t, ⟨s ∪ t, s.2.union t.2⟩)
+  (funext $ λ s, funext $ λ t, set_like.coe_injective (s.2.union t.2).closure_eq.symm)
+/- inf -/ (λ s t, ⟨s ∩ t, s.2.inter t.2⟩) rfl
+/- Sup -/ _ rfl
+/- Inf -/ (λ S, ⟨⋂ s ∈ S, ↑s, is_closed_bInter $ λ s _, s.2⟩)
+  (funext $ λ S, set_like.coe_injective Inf_image.symm)
 
 /-- The type of closed sets is inhabited, with default element the empty set. -/
 instance : inhabited (closeds α) := ⟨⊥⟩
 
-@[simp] lemma coe_sup (s t : closeds α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
-@[simp] lemma coe_inf (s t : closeds α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
-@[simp] lemma coe_top : (↑(⊤ : closeds α) : set α) = univ := rfl
-@[simp] lemma coe_bot : (↑(⊥ : closeds α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_sup (s t : closeds α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
+@[simp, norm_cast] lemma coe_inf (s t : closeds α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
+@[simp, norm_cast] lemma coe_top : (↑(⊤ : closeds α) : set α) = univ := rfl
+@[simp, norm_cast] lemma coe_bot : (↑(⊥ : closeds α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_Inf {S : set (closeds α)} : (↑(Inf S) : set α) = ⋂ i ∈ S, ↑i := rfl
+
+@[simp, norm_cast] lemma coe_finset_sup (f : ι → closeds α) (s : finset ι) :
+  (↑(s.sup f) : set α) = s.sup (coe ∘ f) :=
+map_finset_sup (⟨⟨coe, coe_sup⟩, coe_bot⟩ : sup_bot_hom (closeds α) (set α)) _ _
+
+@[simp, norm_cast] lemma coe_finset_inf (f : ι → closeds α) (s : finset ι) :
+  (↑(s.inf f) : set α) = s.inf (coe ∘ f) :=
+map_finset_inf (⟨⟨coe, coe_inf⟩, coe_top⟩ : inf_top_hom (closeds α) (set α)) _ _
+
+lemma infi_def {ι} (s : ι → closeds α) : (⨅ i, s i) = ⟨⋂ i, s i, is_closed_Inter $ λ i, (s i).2⟩ :=
+by { ext, simp only [infi, coe_Inf, bInter_range], refl }
+
+@[simp] lemma infi_mk {ι} (s : ι → set α) (h : ∀ i, is_closed (s i)) :
+  (⨅ i, ⟨s i, h i⟩ : closeds α) = ⟨⋂ i, s i, is_closed_Inter h⟩ :=
+by simp [infi_def]
+
+@[simp, norm_cast] lemma coe_infi {ι} (s : ι → closeds α) :
+  ((⨅ i, s i : closeds α) : set α) = ⋂ i, s i :=
+by simp [infi_def]
+
+@[simp] lemma mem_infi {ι} {x : α} {s : ι → closeds α} : x ∈ infi s ↔ ∀ i, x ∈ s i :=
+by simp [←set_like.mem_coe]
+
+@[simp] lemma mem_Inf {S : set (closeds α)} {x : α} : x ∈ Inf S ↔ ∀ s ∈ S, x ∈ s :=
+by simp_rw [Inf_eq_infi, mem_infi]
+
+instance : coframe (closeds α) :=
+{ Inf := Inf,
+  infi_sup_le_sup_Inf := λ a s,
+    (set_like.coe_injective $ by simp only [coe_sup, coe_infi, coe_Inf, set.union_Inter₂]).le,
+  ..closeds.complete_lattice }
+
+/-- The term of `closeds α` corresponding to a singleton. -/
+@[simps] def singleton [t1_space α] (x : α) : closeds α :=
+⟨{x}, is_closed_singleton⟩
 
 end closeds
 
+/-- The complement of a closed set as an open set. -/
+@[simps] def closeds.compl (s : closeds α) : opens α := ⟨sᶜ, s.2.is_open_compl⟩
+
+/-- The complement of an open set as a closed set. -/
+@[simps] def opens.compl (s : opens α) : closeds α := ⟨sᶜ, s.2.is_closed_compl⟩
+
+lemma closeds.compl_compl (s : closeds α) : s.compl.compl = s := closeds.ext (compl_compl s)
+lemma opens.compl_compl (s : opens α) : s.compl.compl = s := opens.ext (compl_compl s)
+
+lemma closeds.compl_bijective : function.bijective (@closeds.compl α _) :=
+function.bijective_iff_has_inverse.mpr ⟨opens.compl, closeds.compl_compl, opens.compl_compl⟩
+lemma opens.compl_bijective : function.bijective (@opens.compl α _) :=
+function.bijective_iff_has_inverse.mpr ⟨closeds.compl, opens.compl_compl, closeds.compl_compl⟩
+
+variables (α)
+
+/-- `closeds.compl` as an `order_iso` to the order dual of `opens α`. -/
+@[simps] def closeds.compl_order_iso : closeds α ≃o (opens α)ᵒᵈ :=
+{ to_fun := order_dual.to_dual ∘ closeds.compl,
+  inv_fun := opens.compl ∘ order_dual.of_dual,
+  left_inv := λ s, by simp [closeds.compl_compl],
+  right_inv := λ s, by simp [opens.compl_compl],
+  map_rel_iff' := λ s t, by simpa only [equiv.coe_fn_mk, function.comp_app,
+    order_dual.to_dual_le_to_dual] using compl_subset_compl }
+
+/-- `opens.compl` as an `order_iso` to the order dual of `closeds α`. -/
+@[simps] def opens.compl_order_iso : opens α ≃o (closeds α)ᵒᵈ :=
+{ to_fun := order_dual.to_dual ∘ opens.compl,
+  inv_fun := closeds.compl ∘ order_dual.of_dual,
+  left_inv := λ s, by simp [opens.compl_compl],
+  right_inv := λ s, by simp [closeds.compl_compl],
+  map_rel_iff' := λ s t, by simpa only [equiv.coe_fn_mk, function.comp_app,
+    order_dual.to_dual_le_to_dual] using compl_subset_compl }
+
+variables {α}
+
+/-- in a `t1_space`, atoms of `closeds α` are precisely the `closeds.singleton`s. -/
+lemma closeds.is_atom_iff [t1_space α] {s : closeds α} : is_atom s ↔ ∃ x, s = closeds.singleton x :=
+begin
+  have : is_atom (s : set α) ↔ is_atom s,
+  { refine closeds.gi.is_atom_iff' rfl (λ t ht, _) s,
+    obtain ⟨x, rfl⟩ := t.is_atom_iff.mp ht,
+    exact closure_singleton },
+  simpa only [← this, (s : set α).is_atom_iff, set_like.ext_iff, set.ext_iff]
+end
+
+/-- in a `t1_space`, coatoms of `opens α` are precisely complements of singletons:
+`(closeds.singleton x).compl`. -/
+lemma opens.is_coatom_iff [t1_space α] {s : opens α} :
+  is_coatom s ↔ ∃ x, s = (closeds.singleton x).compl :=
+begin
+  rw [←s.compl_compl, ←is_atom_dual_iff_is_coatom],
+  change is_atom (closeds.compl_order_iso α s.compl) ↔ _,
+  rw [(closeds.compl_order_iso α).is_atom_iff, closeds.is_atom_iff],
+  congrm ∃ x, _,
+  exact closeds.compl_bijective.injective.eq_iff.symm,
+end
+
 /-! ### Clopen sets -/
 
 /-- The type of clopen sets of a topological space. -/
diff --git a/src/topology/sets/compacts.lean b/src/topology/sets/compacts.lean
index 2e7b12d28ccb9..8dc271235107e 100644
--- a/src/topology/sets/compacts.lean
+++ b/src/topology/sets/compacts.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn, Yaël Dillies
 -/
 import topology.sets.closeds
+import topology.quasi_separated
 
 /-!
 # Compact sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define a few types of compact sets in a topological space.
 
 ## Main Definitions
@@ -22,7 +26,7 @@ For a topological space `α`,
 
 open set
 
-variables {α β : Type*} [topological_space α] [topological_space β]
+variables {α β γ : Type*} [topological_space α] [topological_space β] [topological_space γ]
 
 namespace topological_space
 
@@ -31,7 +35,7 @@ namespace topological_space
 /-- The type of compact sets of a topological space. -/
 structure compacts (α : Type*) [topological_space α] :=
 (carrier : set α)
-(compact' : is_compact carrier)
+(is_compact' : is_compact carrier)
 
 namespace compacts
 variables {α}
@@ -40,22 +44,22 @@ instance : set_like (compacts α) α :=
 { coe := compacts.carrier,
   coe_injective' := λ s t h, by { cases s, cases t, congr' } }
 
-lemma compact (s : compacts α) : is_compact (s : set α) := s.compact'
+protected lemma is_compact (s : compacts α) : is_compact (s : set α) := s.is_compact'
 
-instance (K : compacts α) : compact_space K := is_compact_iff_compact_space.1 K.compact
+instance (K : compacts α) : compact_space K := is_compact_iff_compact_space.1 K.is_compact
 
-instance : can_lift (set α) (compacts α) :=
-{ coe := coe,
-  cond := is_compact,
-  prf := λ K hK, ⟨⟨K, hK⟩, rfl⟩ }
+instance : can_lift (set α) (compacts α) coe is_compact :=
+{ prf := λ K hK, ⟨⟨K, hK⟩, rfl⟩ }
 
 @[ext] protected lemma ext {s t : compacts α} (h : (s : set α) = t) : s = t := set_like.ext' h
 
 @[simp] lemma coe_mk (s : set α) (h) : (mk s h : set α) = s := rfl
 
-instance : has_sup (compacts α) := ⟨λ s t, ⟨s ∪ t, s.compact.union t.compact⟩⟩
-instance [t2_space α] : has_inf (compacts α) := ⟨λ s t, ⟨s ∩ t, s.compact.inter t.compact⟩⟩
-instance [compact_space α] : has_top (compacts α) := ⟨⟨univ, compact_univ⟩⟩
+@[simp] lemma carrier_eq_coe (s : compacts α) : s.carrier = s := rfl
+
+instance : has_sup (compacts α) := ⟨λ s t, ⟨s ∪ t, s.is_compact.union t.is_compact⟩⟩
+instance [t2_space α] : has_inf (compacts α) := ⟨λ s t, ⟨s ∩ t, s.is_compact.inter t.is_compact⟩⟩
+instance [compact_space α] : has_top (compacts α) := ⟨⟨univ, is_compact_univ⟩⟩
 instance : has_bot (compacts α) := ⟨⟨∅, is_compact_empty⟩⟩
 
 instance : semilattice_sup (compacts α) := set_like.coe_injective.semilattice_sup _ (λ _ _, rfl)
@@ -89,20 +93,42 @@ end
 protected def map (f : α → β) (hf : continuous f) (K : compacts α) : compacts β :=
 ⟨f '' K.1, K.2.image hf⟩
 
-@[simp] lemma coe_map {f : α → β} (hf : continuous f) (s : compacts α) :
+@[simp, norm_cast] lemma coe_map {f : α → β} (hf : continuous f) (s : compacts α) :
   (s.map f hf : set β) = f '' s := rfl
 
+@[simp] lemma map_id (K : compacts α) : K.map id continuous_id = K := compacts.ext $ set.image_id _
+
+lemma map_comp (f : β → γ) (g : α → β) (hf : continuous f) (hg : continuous g) (K : compacts α) :
+  K.map (f ∘ g) (hf.comp hg) = (K.map g hg).map f hf := compacts.ext $ set.image_comp _ _ _
+
 /-- A homeomorphism induces an equivalence on compact sets, by taking the image. -/
-@[simp] protected def equiv (f : α ≃ₜ β) : compacts α ≃ compacts β :=
+@[simps] protected def equiv (f : α ≃ₜ β) : compacts α ≃ compacts β :=
 { to_fun := compacts.map f f.continuous,
   inv_fun := compacts.map _ f.symm.continuous,
   left_inv := λ s, by { ext1, simp only [coe_map, ← image_comp, f.symm_comp_self, image_id] },
   right_inv := λ s, by { ext1, simp only [coe_map, ← image_comp, f.self_comp_symm, image_id] } }
 
+@[simp] lemma equiv_refl : compacts.equiv (homeomorph.refl α) = equiv.refl _ :=
+equiv.ext map_id
+
+@[simp] lemma equiv_trans (f : α ≃ₜ β) (g : β ≃ₜ γ) :
+  compacts.equiv (f.trans g) = (compacts.equiv f).trans (compacts.equiv g) :=
+equiv.ext $ map_comp _ _ _ _
+
+@[simp] lemma equiv_symm (f : α ≃ₜ β) : compacts.equiv f.symm = (compacts.equiv f).symm :=
+rfl
+
 /-- The image of a compact set under a homeomorphism can also be expressed as a preimage. -/
-lemma equiv_to_fun_val (f : α ≃ₜ β) (K : compacts α) :
-  (compacts.equiv f K).1 = f.symm ⁻¹' K.1 :=
-congr_fun (image_eq_preimage_of_inverse f.left_inv f.right_inv) K.1
+lemma coe_equiv_apply_eq_preimage (f : α ≃ₜ β) (K : compacts α) :
+  (compacts.equiv f K : set β) = f.symm ⁻¹' (K : set α) :=
+f.to_equiv.image_eq_preimage K
+
+/-- The product of two `compacts`, as a `compacts` in the product space. -/
+protected def prod (K : compacts α) (L : compacts β) : compacts (α × β) :=
+{ carrier := K ×ˢ L,
+  is_compact' := is_compact.prod K.2 L.2 }
+
+@[simp] lemma coe_prod (K : compacts α) (L : compacts β) : (K.prod L : set (α × β)) = K ×ˢ L := rfl
 
 end compacts
 
@@ -118,17 +144,19 @@ instance : set_like (nonempty_compacts α) α :=
 { coe := λ s, s.carrier,
   coe_injective' := λ s t h, by { obtain ⟨⟨_, _⟩, _⟩ := s, obtain ⟨⟨_, _⟩, _⟩ := t, congr' } }
 
-lemma compact (s : nonempty_compacts α) : is_compact (s : set α) := s.compact'
+protected lemma is_compact (s : nonempty_compacts α) : is_compact (s : set α) := s.is_compact'
 protected lemma nonempty (s : nonempty_compacts α) : (s : set α).nonempty := s.nonempty'
 
 /-- Reinterpret a nonempty compact as a closed set. -/
-def to_closeds [t2_space α] (s : nonempty_compacts α) : closeds α := ⟨s, s.compact.is_closed⟩
+def to_closeds [t2_space α] (s : nonempty_compacts α) : closeds α := ⟨s, s.is_compact.is_closed⟩
 
 @[ext] protected lemma ext {s t : nonempty_compacts α} (h : (s : set α) = t) : s = t :=
 set_like.ext' h
 
 @[simp] lemma coe_mk (s : compacts α) (h) : (mk s h : set α) = s := rfl
 
+@[simp] lemma carrier_eq_coe (s : nonempty_compacts α) : s.carrier = s := rfl
+
 instance : has_sup (nonempty_compacts α) :=
 ⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts, s.nonempty.mono $ subset_union_left _ _⟩⟩
 instance [compact_space α] [nonempty α] : has_top (nonempty_compacts α) := ⟨⟨⊤, univ_nonempty⟩⟩
@@ -146,19 +174,28 @@ order_top.lift (coe : _ → set α) (λ _ _, id) rfl
 /-- In an inhabited space, the type of nonempty compact subsets is also inhabited, with
 default element the singleton set containing the default element. -/
 instance [inhabited α] : inhabited (nonempty_compacts α) :=
-⟨{ carrier := {default}, compact' := is_compact_singleton, nonempty' := singleton_nonempty _ }⟩
+⟨{ carrier := {default}, is_compact' := is_compact_singleton, nonempty' := singleton_nonempty _ }⟩
 
 instance to_compact_space {s : nonempty_compacts α} : compact_space s :=
-is_compact_iff_compact_space.1 s.compact
+is_compact_iff_compact_space.1 s.is_compact
 
 instance to_nonempty {s : nonempty_compacts α} : nonempty s := s.nonempty.to_subtype
 
+/-- The product of two `nonempty_compacts`, as a `nonempty_compacts` in the product space. -/
+protected def prod (K : nonempty_compacts α) (L : nonempty_compacts β) :
+  nonempty_compacts (α × β) :=
+{ nonempty' := K.nonempty.prod L.nonempty,
+  .. K.to_compacts.prod L.to_compacts }
+
+@[simp] lemma coe_prod (K : nonempty_compacts α) (L : nonempty_compacts β) :
+  (K.prod L : set (α × β)) = K ×ˢ L := rfl
+
 end nonempty_compacts
 
 /-! ### Positive compact sets -/
 
-/-- The type of compact sets nonempty interior of a topological space. See also `compacts` and
-`nonempty_compacts` -/
+/-- The type of compact sets with nonempty interior of a topological space.
+See also `compacts` and `nonempty_compacts`. -/
 structure positive_compacts (α : Type*) [topological_space α] extends compacts α :=
 (interior_nonempty' : (interior carrier).nonempty)
 
@@ -168,22 +205,28 @@ instance : set_like (positive_compacts α) α :=
 { coe := λ s, s.carrier,
   coe_injective' := λ s t h, by { obtain ⟨⟨_, _⟩, _⟩ := s, obtain ⟨⟨_, _⟩, _⟩ := t, congr' } }
 
-lemma compact (s : positive_compacts α) : is_compact (s : set α) := s.compact'
+protected lemma is_compact (s : positive_compacts α) : is_compact (s : set α) := s.is_compact'
 lemma interior_nonempty (s : positive_compacts α) : (interior (s : set α)).nonempty :=
 s.interior_nonempty'
 
+protected lemma nonempty (s : positive_compacts α) : (s : set α).nonempty :=
+s.interior_nonempty.mono interior_subset
+
 /-- Reinterpret a positive compact as a nonempty compact. -/
 def to_nonempty_compacts (s : positive_compacts α) : nonempty_compacts α :=
-⟨s.to_compacts, s.interior_nonempty.mono interior_subset⟩
+⟨s.to_compacts, s.nonempty⟩
 
 @[ext] protected lemma ext {s t : positive_compacts α} (h : (s : set α) = t) : s = t :=
 set_like.ext' h
 
 @[simp] lemma coe_mk (s : compacts α) (h) : (mk s h : set α) = s := rfl
 
+@[simp] lemma carrier_eq_coe (s : positive_compacts α) : s.carrier = s := rfl
+
 instance : has_sup (positive_compacts α) :=
 ⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts,
   s.interior_nonempty.mono $ interior_mono $ subset_union_left _ _⟩⟩
+
 instance [compact_space α] [nonempty α] : has_top (positive_compacts α) :=
 ⟨⟨⊤, interior_univ.symm.subst univ_nonempty⟩⟩
 
@@ -197,12 +240,48 @@ order_top.lift (coe : _ → set α) (λ _ _, id) rfl
 @[simp] lemma coe_top [compact_space α] [nonempty α] :
   (↑(⊤ : positive_compacts α) : set α) = univ := rfl
 
+/-- The image of a positive compact set under a continuous open map. -/
+protected def map (f : α → β) (hf : continuous f) (hf' : is_open_map f) (K : positive_compacts α) :
+  positive_compacts β :=
+{ interior_nonempty' :=
+    (K.interior_nonempty'.image _).mono (hf'.image_interior_subset K.to_compacts),
+  ..K.map f hf }
+
+@[simp, norm_cast] lemma coe_map {f : α → β} (hf : continuous f) (hf' : is_open_map f)
+  (s : positive_compacts α) :
+  (s.map f hf hf' : set β) = f '' s := rfl
+
+@[simp] lemma map_id (K : positive_compacts α) : K.map id continuous_id is_open_map.id = K :=
+positive_compacts.ext $ set.image_id _
+
+lemma map_comp (f : β → γ) (g : α → β) (hf : continuous f) (hg : continuous g)
+  (hf' : is_open_map f) (hg' : is_open_map g)
+  (K : positive_compacts α) :
+  K.map (f ∘ g) (hf.comp hg) (hf'.comp hg') = (K.map g hg hg').map f hf hf' :=
+positive_compacts.ext $ set.image_comp _ _ _
+
+lemma _root_.exists_positive_compacts_subset [locally_compact_space α] {U : set α} (ho : is_open U)
+  (hn : U.nonempty) : ∃ K : positive_compacts α, ↑K ⊆ U :=
+let ⟨x, hx⟩ := hn, ⟨K, hKc, hxK, hKU⟩ := exists_compact_subset ho hx in ⟨⟨⟨K, hKc⟩, ⟨x, hxK⟩⟩, hKU⟩
+
 instance [compact_space α] [nonempty α] : inhabited (positive_compacts α) := ⟨⊤⟩
 
 /-- In a nonempty locally compact space, there exists a compact set with nonempty interior. -/
-instance [locally_compact_space α] [nonempty α] : nonempty (positive_compacts α) :=
-let ⟨s, hs⟩ := exists_compact_subset is_open_univ $ mem_univ (classical.arbitrary α) in
-  ⟨{ carrier := s, compact' := hs.1, interior_nonempty' := ⟨_, hs.2.1⟩ }⟩
+instance nonempty' [locally_compact_space α] [nonempty α] : nonempty (positive_compacts α) :=
+nonempty_of_exists $ exists_positive_compacts_subset is_open_univ univ_nonempty
+
+/-- The product of two `positive_compacts`, as a `positive_compacts` in the product space. -/
+protected def prod (K : positive_compacts α) (L : positive_compacts β) :
+  positive_compacts (α × β) :=
+{ interior_nonempty' :=
+  begin
+    simp only [compacts.carrier_eq_coe, compacts.coe_prod, interior_prod_eq],
+    exact K.interior_nonempty.prod L.interior_nonempty,
+  end,
+  .. K.to_compacts.prod L.to_compacts }
+
+@[simp] lemma coe_prod (K : positive_compacts α) (L : positive_compacts β) :
+  (K.prod L : set (α × β)) = K ×ˢ L := rfl
 
 end positive_compacts
 
@@ -211,7 +290,7 @@ end positive_compacts
 /-- The type of compact open sets of a topological space. This is useful in non Hausdorff contexts,
 in particular spectral spaces. -/
 structure compact_opens (α : Type*) [topological_space α] extends compacts α :=
-(open' : is_open carrier)
+(is_open' : is_open carrier)
 
 namespace compact_opens
 
@@ -219,30 +298,35 @@ instance : set_like (compact_opens α) α :=
 { coe := λ s, s.carrier,
   coe_injective' := λ s t h, by { obtain ⟨⟨_, _⟩, _⟩ := s, obtain ⟨⟨_, _⟩, _⟩ := t, congr' } }
 
-lemma compact (s : compact_opens α) : is_compact (s : set α) := s.compact'
-lemma «open» (s : compact_opens α) : is_open (s : set α) := s.open'
+protected lemma is_compact (s : compact_opens α) : is_compact (s : set α) := s.is_compact'
+protected lemma is_open (s : compact_opens α) : is_open (s : set α) := s.is_open'
 
 /-- Reinterpret a compact open as an open. -/
-@[simps] def to_opens (s : compact_opens α) : opens α := ⟨s, s.open⟩
+@[simps] def to_opens (s : compact_opens α) : opens α := ⟨s, s.is_open⟩
 
 /-- Reinterpret a compact open as a clopen. -/
 @[simps] def to_clopens [t2_space α] (s : compact_opens α) : clopens α :=
-⟨s, s.open, s.compact.is_closed⟩
+⟨s, s.is_open, s.is_compact.is_closed⟩
 
 @[ext] protected lemma ext {s t : compact_opens α} (h : (s : set α) = t) : s = t := set_like.ext' h
 
 @[simp] lemma coe_mk (s : compacts α) (h) : (mk s h : set α) = s := rfl
 
 instance : has_sup (compact_opens α) :=
-⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts, s.open.union t.open⟩⟩
-instance [t2_space α] : has_inf (compact_opens α) :=
-⟨λ s t, ⟨s.to_compacts ⊓ t.to_compacts, s.open.inter t.open⟩⟩
+⟨λ s t, ⟨s.to_compacts ⊔ t.to_compacts, s.is_open.union t.is_open⟩⟩
+
+instance [quasi_separated_space α] : has_inf (compact_opens α) :=
+⟨λ U V, ⟨⟨(U : set α) ∩ (V : set α),
+  quasi_separated_space.inter_is_compact U.1.1 V.1.1 U.2 U.1.2 V.2 V.1.2⟩, U.2.inter V.2⟩⟩
+instance [quasi_separated_space α] : semilattice_inf (compact_opens α) :=
+set_like.coe_injective.semilattice_inf _ (λ _ _, rfl)
+
 instance [compact_space α] : has_top (compact_opens α) := ⟨⟨⊤, is_open_univ⟩⟩
 instance : has_bot (compact_opens α) := ⟨⟨⊥, is_open_empty⟩⟩
 instance [t2_space α] : has_sdiff (compact_opens α) :=
-⟨λ s t, ⟨⟨s \ t, s.compact.diff t.open⟩, s.open.sdiff t.compact.is_closed⟩⟩
+⟨λ s t, ⟨⟨s \ t, s.is_compact.diff t.is_open⟩, s.is_open.sdiff t.is_compact.is_closed⟩⟩
 instance [t2_space α] [compact_space α] : has_compl (compact_opens α) :=
-⟨λ s, ⟨⟨sᶜ, s.open.is_closed_compl.is_compact⟩, s.compact.is_closed.is_open_compl⟩⟩
+⟨λ s, ⟨⟨sᶜ, s.is_open.is_closed_compl.is_compact⟩, s.is_compact.is_closed.is_open_compl⟩⟩
 
 instance : semilattice_sup (compact_opens α) :=
 set_like.coe_injective.semilattice_sup _ (λ _ _, rfl)
@@ -271,10 +355,28 @@ instance : inhabited (compact_opens α) := ⟨⊥⟩
 /-- The image of a compact open under a continuous open map. -/
 @[simps] def map (f : α → β) (hf : continuous f) (hf' : is_open_map f) (s : compact_opens α) :
   compact_opens β :=
-⟨s.to_compacts.map f hf, hf' _ s.open⟩
+⟨s.to_compacts.map f hf, hf' _ s.is_open⟩
 
-@[simp] lemma coe_map {f : α → β} (hf : continuous f) (hf' : is_open_map f) (s : compact_opens α) :
-  (s.map f hf hf' : set β) = f '' s := rfl
+@[simp, norm_cast] lemma coe_map {f : α → β} (hf : continuous f) (hf' : is_open_map f)
+  (s : compact_opens α) : (s.map f hf hf' : set β) = f '' s := rfl
+
+@[simp] lemma map_id (K : compact_opens α) : K.map id continuous_id is_open_map.id = K :=
+compact_opens.ext $ set.image_id _
+
+lemma map_comp (f : β → γ) (g : α → β) (hf : continuous f) (hg : continuous g)
+  (hf' : is_open_map f) (hg' : is_open_map g)
+  (K : compact_opens α) :
+  K.map (f ∘ g) (hf.comp hg) (hf'.comp hg') = (K.map g hg hg').map f hf hf' :=
+compact_opens.ext $ set.image_comp _ _ _
+
+/-- The product of two `compact_opens`, as a `compact_opens` in the product space. -/
+protected def prod (K : compact_opens α) (L : compact_opens β) :
+  compact_opens (α × β) :=
+{ is_open' := K.is_open.prod L.is_open,
+  .. K.to_compacts.prod L.to_compacts }
+
+@[simp] lemma coe_prod (K : compact_opens α) (L : compact_opens β) :
+  (K.prod L : set (α × β)) = K ×ˢ L := rfl
 
 end compact_opens
 end topological_space
diff --git a/src/topology/sets/opens.lean b/src/topology/sets/opens.lean
index 8c33856bc9a4d..5b13c8ea4c6fb 100644
--- a/src/topology/sets/opens.lean
+++ b/src/topology/sets/opens.lean
@@ -7,97 +7,132 @@ import order.hom.complete_lattice
 import topology.bases
 import topology.homeomorph
 import topology.continuous_function.basic
+import order.compactly_generated
+import tactic.auto_cases
 
 /-!
 # Open sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 ## Summary
 
 We define the subtype of open sets in a topological space.
 
 ## Main Definitions
 
+### Bundled open sets
+
 - `opens α` is the type of open subsets of a topological space `α`.
+- `opens.is_basis` is a predicate saying that a set of `opens`s form a topological basis.
+- `opens.comap`: preimage of an open set under a continuous map as a `frame_hom`.
+- `homeomorph.opens_congr`: order-preserving equivalence between open sets in the domain and the
+  codomain of a homeomorphism.
+
+### Bundled open neighborhoods
+
 - `open_nhds_of x` is the type of open subsets of a topological space `α` containing `x : α`.
+- `open_nhds_of.comap f x U` is the preimage of open neighborhood `U` of `f x` under `f : C(α, β)`.
+
+## Main results
+
+We define order structures on both `opens α` (`complete_structure`, `frame`) and `open_nhds_of x`
+(`order_top`, `distrib_lattice`).
 -/
 
 open filter function order set
+open_locale topology
 
-variables {α β γ : Type*} [topological_space α] [topological_space β] [topological_space γ]
+variables {ι α β γ : Type*} [topological_space α] [topological_space β] [topological_space γ]
 
 namespace topological_space
+
 variable (α)
+
 /-- The type of open subsets of a topological space. -/
-def opens := {s : set α // is_open s}
+structure opens :=
+(carrier : set α)
+(is_open' : is_open carrier)
 
 variable {α}
+
 namespace opens
-instance : has_coe (opens α) (set α) := { coe := subtype.val }
 
-lemma val_eq_coe (U : opens α) : U.1 = ↑U := rfl
+instance : set_like (opens α) α :=
+{ coe := opens.carrier,
+  coe_injective' := λ ⟨_, _⟩ ⟨_, _⟩ _, by congr; assumption }
+
+instance : can_lift (set α) (opens α) coe is_open :=
+⟨λ s h, ⟨⟨s, h⟩, rfl⟩⟩
+
+lemma «forall» {p : opens α → Prop} : (∀ U, p U) ↔ ∀ (U : set α) (hU : is_open U), p ⟨U, hU⟩ :=
+⟨λ h _ _, h _, λ h ⟨U, hU⟩, h _ _⟩
+
+@[simp] lemma carrier_eq_coe (U : opens α) : U.1 = ↑U := rfl
 
 /-- the coercion `opens α → set α` applied to a pair is the same as taking the first component -/
-lemma coe_mk {α : Type*} [topological_space α] {U : set α} {hU : is_open U} :
-  ↑(⟨U, hU⟩ : opens α) = U := rfl
+@[simp] lemma coe_mk {U : set α} {hU : is_open U} : ↑(⟨U, hU⟩ : opens α) = U := rfl
 
-instance : has_subset (opens α) :=
-{ subset := λ U V, (U : set α) ⊆ V }
+@[simp] lemma mem_mk {x : α} {U : set α} {h : is_open U} :
+  @has_mem.mem _ (opens α) _ x ⟨U, h⟩ ↔ x ∈ U := iff.rfl
 
-instance : has_mem α (opens α) :=
-{ mem := λ a U, a ∈ (U : set α) }
+-- todo: make it `simp` for a `set_like`?
+@[simp] protected lemma nonempty_coe_sort {U : opens α} : nonempty U ↔ (U : set α).nonempty :=
+set.nonempty_coe_sort
 
-@[simp] lemma subset_coe {U V : opens α} : ((U : set α) ⊆ (V : set α)) = (U ⊆ V) := rfl
+@[ext] lemma ext {U V : opens α} (h : (U : set α) = V) : U = V := set_like.coe_injective h
+@[simp] lemma coe_inj {U V : opens α} : (U : set α) = V ↔ U = V := set_like.ext'_iff.symm
 
-@[simp] lemma mem_coe {x : α} {U : opens α} : (x ∈ (U : set α)) = (x ∈ U) := rfl
+protected lemma is_open (U : opens α) : is_open (U : set α) := U.is_open'
 
-@[ext] lemma ext {U V : opens α} (h : (U : set α) = V) : U = V := subtype.ext h
-@[ext] lemma ext_iff {U V : opens α} : (U : set α) = V ↔ U = V := subtype.ext_iff.symm
+@[simp] lemma mk_coe (U : opens α) : mk ↑U U.is_open = U := by { cases U, refl }
 
-instance : partial_order (opens α) := subtype.partial_order _
+/-- See Note [custom simps projection]. -/
+def simps.coe (U : opens α) : set α := U
+
+initialize_simps_projections opens (carrier → coe)
 
 /-- The interior of a set, as an element of `opens`. -/
 def interior (s : set α) : opens α := ⟨interior s, is_open_interior⟩
 
 lemma gc : galois_connection (coe : opens α → set α) interior :=
-λ U s, ⟨λ h, interior_maximal h U.property, λ h, le_trans h interior_subset⟩
-
-open order_dual (of_dual to_dual)
+λ U s, ⟨λ h, interior_maximal h U.is_open, λ h, le_trans h interior_subset⟩
 
 /-- The galois coinsertion between sets and opens. -/
-def gi : galois_coinsertion subtype.val (@interior α _) :=
-{ choice := λ s hs, ⟨s, interior_eq_iff_open.mp $ le_antisymm interior_subset hs⟩,
+def gi : galois_coinsertion coe (@interior α _) :=
+{ choice := λ s hs, ⟨s, interior_eq_iff_is_open.mp $ le_antisymm interior_subset hs⟩,
   gc := gc,
   u_l_le := λ _, interior_subset,
   choice_eq := λ s hs, le_antisymm hs interior_subset }
 
 instance : complete_lattice (opens α) :=
 complete_lattice.copy (galois_coinsertion.lift_complete_lattice gi)
-/- le  -/ (λ U V, U ⊆ V) rfl
+/- le  -/ (λ U V, (U : set α) ⊆ V) rfl
 /- top -/ ⟨univ, is_open_univ⟩ (ext interior_univ.symm)
 /- bot -/ ⟨∅, is_open_empty⟩ rfl
 /- sup -/ (λ U V, ⟨↑U ∪ ↑V, U.2.union V.2⟩) rfl
-/- inf -/ (λ U V, ⟨↑U ∩ ↑V, U.2.inter V.2⟩)
-  (funext $ λ U, funext $ λ V, ext (U.2.inter V.2).interior_eq.symm)
-/- Sup -/ _ rfl
+/- inf -/ (λ U V, ⟨↑U ∩ ↑V, U.2.inter V.2⟩) (funext₂ $ λ U V, ext (U.2.inter V.2).interior_eq.symm)
+/- Sup -/ (λ S, ⟨⋃ s ∈ S, ↑s, is_open_bUnion $ λ s _, s.2⟩) (funext $ λ S, ext Sup_image.symm)
 /- Inf -/ _ rfl
 
-lemma le_def {U V : opens α} : U ≤ V ↔ (U : set α) ≤ (V : set α) := iff.rfl
-
 @[simp] lemma mk_inf_mk {U V : set α} {hU : is_open U} {hV : is_open V} :
   (⟨U, hU⟩ ⊓ ⟨V, hV⟩ : opens α) = ⟨U ⊓ V, is_open.inter hU hV⟩ := rfl
-@[simp, norm_cast] lemma coe_inf {U V : opens α} : ((U ⊓ V : opens α) : set α) = U ∩ V := rfl
-@[simp] lemma coe_bot : ((⊥ : opens α) : set α) = ∅ := rfl
-@[simp] lemma coe_top : ((⊤ : opens α) : set α) = set.univ := rfl
-@[simp] lemma coe_Sup {S : set (opens α)} : (↑(Sup S) : set α) = ⋃ i ∈ S, ↑i := (@gc α _).l_Sup
+@[simp, norm_cast] lemma coe_inf (s t : opens α) : (↑(s ⊓ t) : set α) = s ∩ t := rfl
+@[simp, norm_cast] lemma coe_sup (s t : opens α) : (↑(s ⊔ t) : set α) = s ∪ t := rfl
+@[simp, norm_cast] lemma coe_bot : ((⊥ : opens α) : set α) = ∅ := rfl
+@[simp, norm_cast] lemma coe_top : ((⊤ : opens α) : set α) = set.univ := rfl
+@[simp, norm_cast] lemma coe_Sup {S : set (opens α)} : (↑(Sup S) : set α) = ⋃ i ∈ S, ↑i := rfl
 
-instance : has_inter (opens α) := ⟨λ U V, U ⊓ V⟩
-instance : has_union (opens α) := ⟨λ U V, U ⊔ V⟩
-instance : has_emptyc (opens α) := ⟨⊥⟩
-instance : inhabited (opens α) := ⟨∅⟩
+@[simp, norm_cast] lemma coe_finset_sup (f : ι → opens α) (s : finset ι) :
+  (↑(s.sup f) : set α) = s.sup (coe ∘ f) :=
+map_finset_sup (⟨⟨coe, coe_sup⟩, coe_bot⟩ : sup_bot_hom (opens α) (set α)) _ _
 
-@[simp] lemma inter_eq (U V : opens α) : U ∩ V = U ⊓ V := rfl
-@[simp] lemma union_eq (U V : opens α) : U ∪ V = U ⊔ V := rfl
-@[simp] lemma empty_eq : (∅ : opens α) = ⊥ := rfl
+@[simp, norm_cast] lemma coe_finset_inf (f : ι → opens α) (s : finset ι) :
+  (↑(s.inf f) : set α) = s.inf (coe ∘ f) :=
+map_finset_inf (⟨⟨coe, coe_inf⟩, coe_top⟩ : inf_top_hom (opens α) (set α)) _ _
+
+instance : inhabited (opens α) := ⟨⊥⟩
 
 lemma supr_def {ι} (s : ι → opens α) : (⨆ i, s i) = ⟨⋃ i, s i, is_open_Union $ λ i, (s i).2⟩ :=
 by { ext, simp only [supr, coe_Sup, bUnion_range], refl }
@@ -106,11 +141,12 @@ by { ext, simp only [supr, coe_Sup, bUnion_range], refl }
   (⨆ i, ⟨s i, h i⟩ : opens α) = ⟨⋃ i, s i, is_open_Union h⟩ :=
 by { rw supr_def, simp }
 
-@[simp] lemma supr_s {ι} (s : ι → opens α) : ((⨆ i, s i : opens α) : set α) = ⋃ i, s i :=
+@[simp, norm_cast] lemma coe_supr {ι} (s : ι → opens α) :
+  ((⨆ i, s i : opens α) : set α) = ⋃ i, s i :=
 by simp [supr_def]
 
 @[simp] theorem mem_supr {ι} {x : α} {s : ι → opens α} : x ∈ supr s ↔ ∃ i, x ∈ s i :=
-by { rw [←mem_coe], simp, }
+by { rw [← set_like.mem_coe], simp, }
 
 @[simp] lemma mem_Sup {Us : set (opens α)} {x : α} : x ∈ Sup Us ↔ ∃ u ∈ Us, x ∈ u :=
 by simp_rw [Sup_eq_supr, mem_supr]
@@ -118,7 +154,7 @@ by simp_rw [Sup_eq_supr, mem_supr]
 instance : frame (opens α) :=
 { Sup := Sup,
   inf_Sup_le_supr_inf := λ a s,
-    (ext $ by simp only [coe_inf, supr_s, coe_Sup, set.inter_Union₂]).le,
+    (ext $ by simp only [coe_inf, coe_supr, coe_Sup, set.inter_Union₂]).le,
   ..opens.complete_lattice }
 
 lemma open_embedding_of_le {U V : opens α} (i : U ≤ V) :
@@ -128,20 +164,28 @@ lemma open_embedding_of_le {U V : opens α} (i : U ≤ V) :
   open_range :=
   begin
     rw set.range_inclusion i,
-    exact U.property.preimage continuous_subtype_val
+    exact U.is_open.preimage continuous_subtype_val
   end, }
 
 lemma not_nonempty_iff_eq_bot (U : opens α) : ¬ set.nonempty (U : set α) ↔ U = ⊥ :=
-by rw [← subtype.coe_injective.eq_iff, opens.coe_bot, ← set.not_nonempty_iff_eq_empty]
+by rw [← coe_inj, opens.coe_bot, ← set.not_nonempty_iff_eq_empty]
 
 lemma ne_bot_iff_nonempty (U : opens α) : U ≠ ⊥ ↔ set.nonempty (U : set α) :=
 by rw [ne.def, ← opens.not_nonempty_iff_eq_bot, not_not]
 
+/-- An open set in the indiscrete topology is either empty or the whole space. -/
+lemma eq_bot_or_top {α} [t : topological_space α] (h : t = ⊤) (U : opens α) : U = ⊥ ∨ U = ⊤ :=
+begin
+  simp only [← coe_inj],
+  unfreezingI { subst h }, letI : topological_space α := ⊤,
+  exact (is_open_top_iff _).1 U.2
+end
+
 /-- A set of `opens α` is a basis if the set of corresponding sets is a topological basis. -/
 def is_basis (B : set (opens α)) : Prop := is_topological_basis ((coe : _ → set α) '' B)
 
 lemma is_basis_iff_nbhd {B : set (opens α)} :
-  is_basis B ↔ ∀ {U : opens α} {x}, x ∈ U → ∃ U' ∈ B, x ∈ U' ∧ U' ⊆ U :=
+  is_basis B ↔ ∀ {U : opens α} {x}, x ∈ U → ∃ U' ∈ B, x ∈ U' ∧ U' ≤ U :=
 begin
   split; intro h,
   { rintros ⟨sU, hU⟩ x hx,
@@ -150,7 +194,7 @@ begin
     refine ⟨V, H₁, _⟩,
     cases V, dsimp at H₂, subst H₂, exact hsV },
   { refine is_topological_basis_of_open_of_nhds _ _,
-    { rintros sU ⟨U, ⟨H₁, rfl⟩⟩, exact U.property },
+    { rintros sU ⟨U, ⟨H₁, rfl⟩⟩, exact U.2 },
     { intros x sU hx hsU,
       rcases @h (⟨sU, hsU⟩ : opens α) x hx with ⟨V, hV, H⟩,
       exact ⟨V, ⟨V, hV, rfl⟩, H⟩ } }
@@ -161,9 +205,9 @@ lemma is_basis_iff_cover {B : set (opens α)} :
 begin
   split,
   { intros hB U,
-    refine ⟨{V : opens α | V ∈ B ∧ V ⊆ U}, λ U hU, hU.left, _⟩,
+    refine ⟨{V : opens α | V ∈ B ∧ V ≤ U}, λ U hU, hU.left, _⟩,
     apply ext,
-    rw [coe_Sup, hB.open_eq_sUnion' U.prop],
+    rw [coe_Sup, hB.open_eq_sUnion' U.is_open],
     simp_rw [sUnion_eq_bUnion, Union, supr_and, supr_image],
     refl },
   { intro h,
@@ -174,11 +218,40 @@ begin
     exact ⟨U, hUs Us, xU, le_Sup Us⟩ }
 end
 
+/-- If `α` has a basis consisting of compact opens, then an open set in `α` is compact open iff
+  it is a finite union of some elements in the basis -/
+lemma is_basis.is_compact_open_iff_eq_finite_Union
+  {ι : Type*} (b : ι → opens α) (hb : is_basis (set.range b))
+  (hb' : ∀ i, is_compact (b i : set α)) (U : set α) :
+  is_compact U ∧ is_open U ↔ ∃ (s : set ι), s.finite ∧ U = ⋃ i ∈ s, b i :=
+begin
+  apply is_compact_open_iff_eq_finite_Union_of_is_topological_basis
+    (λ i : ι, (b i).1),
+  { convert hb, ext, simp },
+  { exact hb' }
+end
+
+@[simp] lemma is_compact_element_iff (s : opens α) :
+  complete_lattice.is_compact_element s ↔ is_compact (s : set α) :=
+begin
+  rw [is_compact_iff_finite_subcover, complete_lattice.is_compact_element_iff],
+  refine ⟨_, λ H ι U hU, _⟩,
+  { introv H hU hU',
+    obtain ⟨t, ht⟩ := H ι (λ i, ⟨U i, hU i⟩) (by simpa),
+    refine ⟨t, set.subset.trans ht _⟩,
+    rw [coe_finset_sup, finset.sup_eq_supr],
+    refl },
+  { obtain ⟨t, ht⟩ := H (λ i, U i) (λ i, (U i).is_open)
+      (by simpa using (show (s : set α) ⊆ ↑(supr U), from hU)),
+    refine ⟨t, set.subset.trans ht _⟩,
+    simp only [set.Union_subset_iff],
+    show ∀ i ∈ t, U i ≤ t.sup U, from λ i, finset.le_sup }
+end
+
 /-- The preimage of an open set, as an open set. -/
 def comap (f : C(α, β)) : frame_hom (opens β) (opens α) :=
 { to_fun := λ s, ⟨f ⁻¹' s, s.2.preimage f.continuous⟩,
-  map_Sup' := λ s, ext $ by simp only [coe_Sup, preimage_Union, coe_mk, mem_image, Union_exists,
-    bUnion_and', Union_Union_eq_right],
+  map_Sup' := λ s, ext $ by simp only [coe_Sup, preimage_Union, bUnion_image, coe_mk],
   map_inf' := λ a b, rfl,
   map_top' := rfl }
 
@@ -190,8 +263,6 @@ order_hom_class.mono (comap f) h
 
 @[simp] lemma coe_comap (f : C(α, β)) (U : opens β) : ↑(comap f U) = f ⁻¹' U := rfl
 
-@[simp] lemma comap_val (f : C(α, β)) (U : opens β) : (comap f U).1 = f ⁻¹' U := rfl
-
 protected lemma comap_comp (g : C(β, γ)) (f : C(α, β)) :
   comap (g.comp f) = (comap f).comp (comap g) := rfl
 
@@ -199,31 +270,90 @@ protected lemma comap_comap (g : C(β, γ)) (f : C(α, β)) (U : opens γ) :
   comap f (comap g U) = comap (g.comp f) U := rfl
 
 lemma comap_injective [t0_space β] : injective (comap : C(α, β) → frame_hom (opens β) (opens α)) :=
-λ f g h, continuous_map.ext $ λ a, indistinguishable.eq $ λ s hs, begin
-  simp_rw ←mem_preimage,
-  congr' 2,
-  have := fun_like.congr_fun h ⟨_, hs⟩,
-  exact congr_arg (coe : opens α → set α) this,
-end
+λ f g h, continuous_map.ext $ λ a, inseparable.eq $ inseparable_iff_forall_open.2 $ λ s hs,
+have comap f ⟨s, hs⟩ = comap g ⟨s, hs⟩, from fun_like.congr_fun h ⟨_, hs⟩,
+show a ∈ f ⁻¹' s ↔ a ∈ g ⁻¹' s, from set.ext_iff.1 (coe_inj.2 this) a
 
-/-- A homeomorphism induces an equivalence on open sets, by taking comaps. -/
-@[simp] protected def equiv (f : α ≃ₜ β) : opens α ≃ opens β :=
+/-- A homeomorphism induces an order-preserving equivalence on open sets, by taking comaps. -/
+@[simps apply { fully_applied := ff }]
+def _root_.homeomorph.opens_congr (f : α ≃ₜ β) : opens α ≃o opens β :=
 { to_fun := opens.comap f.symm.to_continuous_map,
   inv_fun := opens.comap f.to_continuous_map,
   left_inv := by { intro U, ext1, exact f.to_equiv.preimage_symm_preimage _ },
-  right_inv := by { intro U, ext1, exact f.to_equiv.symm_preimage_preimage _ } }
+  right_inv := by { intro U, ext1, exact f.to_equiv.symm_preimage_preimage _ },
+  map_rel_iff' := λ U V, by simp only [← set_like.coe_subset_coe];
+    exact f.symm.surjective.preimage_subset_preimage_iff }
+
+@[simp] lemma _root_.homeomorph.opens_congr_symm (f : α ≃ₜ β) :
+  f.opens_congr.symm = f.symm.opens_congr :=
+rfl
 
-/-- A homeomorphism induces an order isomorphism on open sets, by taking comaps. -/
-@[simp] protected def order_iso (f : α ≃ₜ β) : opens α ≃o opens β :=
-{ to_equiv := opens.equiv f,
-  map_rel_iff' := λ U V, f.symm.surjective.preimage_subset_preimage_iff }
+instance [finite α] : finite (opens α) := finite.of_injective _ set_like.coe_injective
 
 end opens
 
 /-- The open neighborhoods of a point. See also `opens` or `nhds`. -/
-def open_nhds_of (x : α) : Type* := { s : set α // is_open s ∧ x ∈ s }
+structure open_nhds_of (x : α) extends opens α :=
+(mem' : x ∈ carrier)
+
+namespace open_nhds_of
+
+variables {x : α}
+
+lemma to_opens_injective : injective (to_opens : open_nhds_of x → opens α)
+| ⟨_, _⟩ ⟨_, _⟩ rfl := rfl
+
+instance : set_like (open_nhds_of x) α :=
+{ coe := λ U, U.1,
+  coe_injective' := set_like.coe_injective.comp to_opens_injective }
+
+instance can_lift_set : can_lift (set α) (open_nhds_of x) coe (λ s, is_open s ∧ x ∈ s) :=
+⟨λ s hs, ⟨⟨⟨s, hs.1⟩, hs.2⟩, rfl⟩⟩
+
+protected lemma mem (U : open_nhds_of x) : x ∈ U := U.mem'
+protected lemma is_open (U : open_nhds_of x) : is_open (U : set α) := U.is_open'
+
+instance : order_top (open_nhds_of x) :=
+{ top := ⟨⊤, set.mem_univ _⟩,
+  le_top := λ _, subset_univ _ }
 
-instance open_nhds_of.inhabited {α : Type*} [topological_space α] (x : α) :
-  inhabited (open_nhds_of x) := ⟨⟨set.univ, is_open_univ, set.mem_univ _⟩⟩
+instance : inhabited (open_nhds_of x) := ⟨⊤⟩
+
+instance : has_inf (open_nhds_of x) := ⟨λ U V, ⟨U.1 ⊓ V.1, U.2, V.2⟩⟩
+
+instance : has_sup (open_nhds_of x) := ⟨λ U V, ⟨U.1 ⊔ V.1, or.inl U.2⟩⟩
+
+instance : distrib_lattice (open_nhds_of x) :=
+to_opens_injective.distrib_lattice _ (λ _ _, rfl) (λ _ _, rfl)
+
+lemma basis_nhds : (𝓝 x).has_basis (λ U : open_nhds_of x, true) coe :=
+(nhds_basis_opens x).to_has_basis (λ U hU, ⟨⟨⟨U, hU.2⟩, hU.1⟩, trivial, subset.rfl⟩)
+  (λ U _, ⟨U, ⟨⟨U.mem, U.is_open⟩, subset.rfl⟩⟩)
+
+/-- Preimage of an open neighborhood of `f x` under a continuous map `f` as a `lattice_hom`. -/
+def comap (f : C(α, β)) (x : α) : lattice_hom (open_nhds_of (f x)) (open_nhds_of x) :=
+{ to_fun := λ U, ⟨opens.comap f U.1, U.mem⟩,
+  map_sup' := λ U V, rfl,
+  map_inf' := λ U V, rfl }
+
+end open_nhds_of
 
 end topological_space
+
+namespace tactic
+
+namespace auto_cases
+
+/-- Find an `auto_cases_tac` which matches `topological_space.opens`. -/
+meta def opens_find_tac : expr → option auto_cases_tac
+| `(topological_space.opens _)     := tac_cases
+| _ := none
+
+end auto_cases
+
+/-- A version of `tactic.auto_cases` that works for `topological_space.opens`. -/
+@[hint_tactic]
+meta def auto_cases_opens : tactic string :=
+auto_cases tactic.auto_cases.opens_find_tac
+
+end tactic
diff --git a/src/topology/sets/order.lean b/src/topology/sets/order.lean
index a1a05edf4a398..b11ca9821a8d3 100644
--- a/src/topology/sets/order.lean
+++ b/src/topology/sets/order.lean
@@ -3,12 +3,15 @@ Copyright (c) 2022 Yaël Dillies. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yaël Dillies
 -/
-import order.upper_lower
+import order.upper_lower.basic
 import topology.sets.closeds
 
 /-!
 # Clopen upper sets
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the type of clopen upper sets.
 -/
 
diff --git a/src/topology/sheaves/abelian.lean b/src/topology/sheaves/abelian.lean
new file mode 100644
index 0000000000000..c63e2191cf07f
--- /dev/null
+++ b/src/topology/sheaves/abelian.lean
@@ -0,0 +1,61 @@
+/-
+Copyright (c) 2022 Jujian Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Adam Topaz, Jujian Zhang
+-/
+import category_theory.abelian.functor_category
+import category_theory.preadditive.additive_functor
+import category_theory.preadditive.functor_category
+import category_theory.abelian.transfer
+import category_theory.sites.left_exact
+
+/-!
+# Category of sheaves is abelian
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+Let `C, D` be categories and `J` be a grothendieck topology on `C`, when `D` is abelian and
+sheafification is possible in `C`, `Sheaf J D` is abelian as well (`Sheaf_is_abelian`).
+
+Hence, `presheaf_to_Sheaf` is an additive functor (`presheaf_to_Sheaf_additive`).
+
+-/
+
+noncomputable theory
+
+namespace category_theory
+
+open category_theory.limits
+
+section abelian
+
+universes w v u
+variables {C : Type (max v u)} [category.{v} C]
+variables {D : Type w} [category.{max v u} D] [abelian D]
+variables {J : grothendieck_topology C}
+
+-- This needs to be specified manually because of universe level.
+instance : abelian (Cᵒᵖ ⥤ D) := @abelian.functor_category_abelian.{v} Cᵒᵖ _ D _ _
+
+-- This also needs to be specified manually, but I don't know why.
+instance : has_finite_products (Sheaf J D) :=
+{ out := λ j, { has_limit := λ F, by apply_instance } }
+
+-- sheafification assumptions
+variables [∀ (P : Cᵒᵖ ⥤ D) (X : C) (S : J.cover X), has_multiequalizer (S.index P)]
+variables [∀ (X : C), has_colimits_of_shape (J.cover X)ᵒᵖ D]
+variables [concrete_category.{max v u} D] [preserves_limits (forget D)]
+variables [∀ (X : C), preserves_colimits_of_shape (J.cover X)ᵒᵖ (forget D)]
+variables [reflects_isomorphisms (forget D)]
+
+instance Sheaf_is_abelian [has_finite_limits D] : abelian (Sheaf J D) :=
+let adj := sheafification_adjunction J D in abelian_of_adjunction _ _ (as_iso adj.counit) adj
+
+local attribute [instance] preserves_binary_biproducts_of_preserves_binary_products
+
+instance presheaf_to_Sheaf_additive : (presheaf_to_Sheaf J D).additive :=
+(presheaf_to_Sheaf J D).additive_of_preserves_binary_biproducts
+
+end abelian
+
+end category_theory
diff --git a/src/topology/sheaves/forget.lean b/src/topology/sheaves/forget.lean
index a90ac66653eba..3fb52ea35b299 100644
--- a/src/topology/sheaves/forget.lean
+++ b/src/topology/sheaves/forget.lean
@@ -4,11 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 import category_theory.limits.preserves.shapes.products
-import topology.sheaves.sheaf
+import topology.sheaves.sheaf_condition.equalizer_products
 
 /-!
 # Checking the sheaf condition on the underlying presheaf of types.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 If `G : C ⥤ D` is a functor which reflects isomorphisms and preserves limits
 (we assume all limits exist in both `C` and `D`),
 then checking the sheaf condition for a presheaf `F : presheaf C X`
@@ -54,7 +57,7 @@ When `G` preserves limits, the sheaf condition diagram for `F` composed with `G`
 naturally isomorphic to the sheaf condition diagram for `F ⋙ G`.
 -/
 def diagram_comp_preserves_limits :
-  diagram F U ⋙ G ≅ diagram (F ⋙ G) U :=
+  diagram F U ⋙ G ≅ diagram.{v} (F ⋙ G) U :=
 begin
   fapply nat_iso.of_components,
   rintro ⟨j⟩,
@@ -82,7 +85,7 @@ When `G` preserves limits, the image under `G` of the sheaf condition fork for `
 is the sheaf condition fork for `F ⋙ G`,
 postcomposed with the inverse of the natural isomorphism `diagram_comp_preserves_limits`.
 -/
-def map_cone_fork : G.map_cone (fork F U) ≅
+def map_cone_fork : G.map_cone (fork.{v} F U) ≅
   (cones.postcompose (diagram_comp_preserves_limits G F U).inv).obj (fork (F ⋙ G) U) :=
 cones.ext (iso.refl _) (λ j,
 begin
@@ -129,11 +132,14 @@ In fact we prove a stronger version with arbitrary complete target category.
 lemma is_sheaf_iff_is_sheaf_comp :
   presheaf.is_sheaf F ↔ presheaf.is_sheaf (F ⋙ G) :=
 begin
+  rw [presheaf.is_sheaf_iff_is_sheaf_equalizer_products,
+    presheaf.is_sheaf_iff_is_sheaf_equalizer_products],
   split,
   { intros S ι U,
     -- We have that the sheaf condition fork for `F` is a limit fork,
     obtain ⟨t₁⟩ := S U,
     -- and since `G` preserves limits, the image under `G` of this fork is a limit fork too.
+    letI := preserves_smallest_limits_of_preserves_limits G,
     have t₂ := @preserves_limit.preserves _ _ _ _ _ _ _ G _ _ t₁,
     -- As we established above, that image is just the sheaf condition fork
     -- for `F ⋙ G` postcomposed with some natural isomorphism,
@@ -165,7 +171,8 @@ begin
       -- image under `G` of the equalizer cone for the sheaf condition diagram.
       let c := fork (F ⋙ G) U,
       obtain ⟨hc⟩ := S U,
-      let d := G.map_cone (equalizer.fork (left_res F U) (right_res F U)),
+      let d := G.map_cone (equalizer.fork (left_res.{v} F U) (right_res F U)),
+      letI := preserves_smallest_limits_of_preserves_limits G,
       have hd : is_limit d := preserves_limit.preserves (limit.is_limit _),
       -- Since both of these are limit cones
       -- (`c` by our hypothesis `S`, and `d` because `G` preserves limits),
diff --git a/src/topology/sheaves/functors.lean b/src/topology/sheaves/functors.lean
index 0ca023927481e..35679f3981c7e 100644
--- a/src/topology/sheaves/functors.lean
+++ b/src/topology/sheaves/functors.lean
@@ -9,6 +9,9 @@ import topology.sheaves.sheaf_condition.pairwise_intersections
 /-!
 # functors between categories of sheaves
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Show that the pushforward of a sheaf is a sheaf, and define
 the pushforward functor from the category of C-valued sheaves
 on X to that of sheaves on Y, given a continuous map between
@@ -19,15 +22,15 @@ TODO: pullback for presheaves and sheaves
 
 noncomputable theory
 
-universes v u u₁
+universes w v u
 
 open category_theory
 open category_theory.limits
 open topological_space
 
-variables {C : Type u₁} [category.{v} C]
-variables {X Y : Top.{v}} (f : X ⟶ Y)
-variables ⦃ι : Type v⦄ {U : ι → opens Y}
+variables {C : Type u} [category.{v} C]
+variables {X Y : Top.{w}} (f : X ⟶ Y)
+variables ⦃ι : Type w⦄ {U : ι → opens Y}
 
 namespace Top
 namespace presheaf.sheaf_condition_pairwise_intersections
@@ -66,13 +69,11 @@ namespace sheaf
 
 open presheaf
 
-variables [has_products C]
-
 /--
 The pushforward of a sheaf (by a continuous map) is a sheaf.
 -/
 theorem pushforward_sheaf_of_sheaf
-  {F : presheaf C X} (h : F.is_sheaf) : (f _* F).is_sheaf :=
+  {F : X.presheaf C} (h : F.is_sheaf) : (f _* F).is_sheaf :=
 by rw is_sheaf_iff_is_sheaf_pairwise_intersections at h ⊢;
    exact sheaf_condition_pairwise_intersections.pushforward_sheaf_of_sheaf f h
 
@@ -81,7 +82,7 @@ The pushforward functor.
 -/
 def pushforward (f : X ⟶ Y) : X.sheaf C ⥤ Y.sheaf C :=
 { obj := λ ℱ, ⟨f _* ℱ.1, pushforward_sheaf_of_sheaf f ℱ.2⟩,
-  map := λ _ _, pushforward_map f }
+  map := λ _ _ g, ⟨pushforward_map f g.1⟩ }
 
 end sheaf
 
diff --git a/src/topology/sheaves/limits.lean b/src/topology/sheaves/limits.lean
index b654ec19f869b..79f129cd7ce4b 100644
--- a/src/topology/sheaves/limits.lean
+++ b/src/topology/sheaves/limits.lean
@@ -3,13 +3,15 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import topology.sheaves.sheaf_condition.sites
+import topology.sheaves.sheaf
 import category_theory.sites.limits
-import category_theory.adjunction
 import category_theory.limits.functor_category
 
 /-!
 # Presheaves in `C` have limits and colimits when `C` does.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 noncomputable theory
@@ -24,30 +26,28 @@ variables {C : Type u} [category.{v} C] {J : Type v} [small_category J]
 namespace Top
 
 instance [has_limits C] (X : Top) : has_limits (presheaf C X) :=
-limits.functor_category_has_limits_of_size
+limits.functor_category_has_limits_of_size.{v v}
 
-instance [has_colimits C] (X : Top) : has_colimits (presheaf C X) :=
+instance [has_colimits C] (X : Top) : has_colimits_of_size.{v} (presheaf C X) :=
 limits.functor_category_has_colimits_of_size
 
 instance [has_limits C] (X : Top) : creates_limits (sheaf.forget C X) :=
-(@@creates_limits_of_nat_iso _ _
-  (presheaf.Sheaf_spaces_equiv_sheaf_sites_inverse_forget C X))
-  (@@category_theory.comp_creates_limits _ _ _ _ _ _
-    Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{u v v})
+Sheaf.category_theory.Sheaf_to_presheaf.category_theory.creates_limits.{u v v}
+
 
-instance [has_limits C] (X : Top) : has_limits (sheaf C X) :=
+instance [has_limits C] (X : Top) : has_limits_of_size.{v} (sheaf.{v} C X) :=
 has_limits_of_has_limits_creates_limits (sheaf.forget C X)
 
-lemma is_sheaf_of_is_limit [has_limits C] {X : Top} (F : J ⥤ presheaf C X)
+lemma is_sheaf_of_is_limit [has_limits C] {X : Top} (F : J ⥤ presheaf.{v} C X)
   (H : ∀ j, (F.obj j).is_sheaf) {c : cone F} (hc : is_limit c) : c.X.is_sheaf :=
 begin
-  let F' : J ⥤ sheaf C X := { obj := λ j, ⟨F.obj j, H j⟩, map := F.map },
+  let F' : J ⥤ sheaf C X := { obj := λ j, ⟨F.obj j, H j⟩, map := λ X Y f, ⟨F.map f⟩ },
   let e : F' ⋙ sheaf.forget C X ≅ F := nat_iso.of_components (λ _, iso.refl _) (by tidy),
   exact presheaf.is_sheaf_of_iso ((is_limit_of_preserves (sheaf.forget C X)
       (limit.is_limit F')).cone_points_iso_of_nat_iso hc e) (limit F').2
 end
 
-lemma limit_is_sheaf [has_limits C] {X : Top} (F : J ⥤ presheaf C X)
+lemma limit_is_sheaf [has_limits C] {X : Top} (F : J ⥤ presheaf.{v} C X)
   (H : ∀ j, (F.obj j).is_sheaf) : (limit F).is_sheaf :=
 is_sheaf_of_is_limit F H (limit.is_limit F)
 
diff --git a/src/topology/sheaves/local_predicate.lean b/src/topology/sheaves/local_predicate.lean
index a56463cec91ac..04659ff17fd1b 100644
--- a/src/topology/sheaves/local_predicate.lean
+++ b/src/topology/sheaves/local_predicate.lean
@@ -11,6 +11,9 @@ import topology.sheaves.sheaf_condition.unique_gluing
 /-!
 # Functions satisfying a local predicate form a sheaf.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 At this stage, in `topology/sheaves/sheaf_of_functions.lean`
 we've proved that not-necessarily-continuous functions from a topological space
 into some type (or type family) form a sheaf.
@@ -215,7 +218,7 @@ def subsheaf_to_Types (P : local_predicate T) : sheaf (Type v) X :=
 There is a canonical map from the stalk to the original fiber, given by evaluating sections.
 -/
 def stalk_to_fiber (P : local_predicate T) (x : X) :
-  (subsheaf_to_Types P).1.stalk x ⟶ T x :=
+  (subsheaf_to_Types P).presheaf.stalk x ⟶ T x :=
 begin
   refine colimit.desc _
     { X := T x, ι := { app := λ U f, _, naturality' := _ } },
@@ -224,7 +227,7 @@ begin
 end
 
 @[simp] lemma stalk_to_fiber_germ (P : local_predicate T) (U : opens X) (x : U) (f) :
-  stalk_to_fiber P x ((subsheaf_to_Types P).1.germ x f) = f.1 x :=
+  stalk_to_fiber P x ((subsheaf_to_Types P).presheaf.germ x f) = f.1 x :=
 begin
   dsimp [presheaf.germ, stalk_to_fiber],
   cases x,
@@ -243,7 +246,7 @@ lemma stalk_to_fiber_surjective (P : local_predicate T) (x : X)
 begin
   rcases w t with ⟨U, f, h, rfl⟩,
   fsplit,
-  { exact (subsheaf_to_Types P).1.germ ⟨x, U.2⟩ ⟨f, h⟩, },
+  { exact (subsheaf_to_Types P).presheaf.germ ⟨x, U.2⟩ ⟨f, h⟩, },
   { exact stalk_to_fiber_germ _ U.1 ⟨x, U.2⟩ ⟨f, h⟩, }
 end
 
@@ -261,16 +264,16 @@ begin
   -- We promise to provide all the ingredients of the proof later:
   let Q :
     ∃ (W : (open_nhds x)ᵒᵖ) (s : Π w : (unop W).1, T w) (hW : P.pred s),
-      tU = (subsheaf_to_Types P).1.germ ⟨x, (unop W).2⟩ ⟨s, hW⟩ ∧
-      tV = (subsheaf_to_Types P).1.germ ⟨x, (unop W).2⟩ ⟨s, hW⟩ := _,
+      tU = (subsheaf_to_Types P).presheaf.germ ⟨x, (unop W).2⟩ ⟨s, hW⟩ ∧
+      tV = (subsheaf_to_Types P).presheaf.germ ⟨x, (unop W).2⟩ ⟨s, hW⟩ := _,
   { choose W s hW e using Q,
     exact e.1.trans e.2.symm, },
   -- Then use induction to pick particular representatives of `tU tV : stalk x`
-  obtain ⟨U, ⟨fU, hU⟩, rfl⟩ := jointly_surjective' tU,
-  obtain ⟨V, ⟨fV, hV⟩, rfl⟩ := jointly_surjective' tV,
+  obtain ⟨U, ⟨fU, hU⟩, rfl⟩ := jointly_surjective'.{v v} tU,
+  obtain ⟨V, ⟨fV, hV⟩, rfl⟩ := jointly_surjective'.{v v} tV,
   { -- Decompose everything into its constituent parts:
     dsimp,
-    simp only [stalk_to_fiber, types.colimit.ι_desc_apply] at h,
+    simp only [stalk_to_fiber, types.colimit.ι_desc_apply'] at h,
     specialize w (unop U) (unop V) fU hU fV hV h,
     rcases w with ⟨W, iU, iV, w⟩,
     -- and put it back together again in the correct order.
diff --git a/src/topology/sheaves/locally_surjective.lean b/src/topology/sheaves/locally_surjective.lean
new file mode 100644
index 0000000000000..c71ef4918c9d0
--- /dev/null
+++ b/src/topology/sheaves/locally_surjective.lean
@@ -0,0 +1,127 @@
+/-
+Copyright (c) 2022 Sam van Gool and Jake Levinson. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Sam van Gool, Jake Levinson
+-/
+
+import topology.sheaves.presheaf
+import topology.sheaves.stalks
+import category_theory.sites.surjective
+
+/-!
+
+# Locally surjective maps of presheaves.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `X` be a topological space, `ℱ` and `𝒢` presheaves on `X`, `T : ℱ ⟶ 𝒢` a map.
+
+In this file we formulate two notions for what it means for
+`T` to be locally surjective:
+
+  1. For each open set `U`, each section `t : 𝒢(U)` is in the image of `T`
+     after passing to some open cover of `U`.
+
+  2. For each `x : X`, the map of *stalks* `Tₓ : ℱₓ ⟶ 𝒢ₓ` is surjective.
+
+We prove that these are equivalent.
+
+-/
+
+universes v u
+
+noncomputable theory
+
+open category_theory
+open topological_space
+open opposite
+
+namespace Top.presheaf
+
+section locally_surjective
+
+local attribute [instance] concrete_category.has_coe_to_fun
+local attribute [instance] concrete_category.has_coe_to_sort
+
+open_locale algebraic_geometry
+
+/-- Let `C` be a concrete category, `X` a topological space. -/
+variables {C : Type u} [category.{v} C] [concrete_category.{v} C] {X : Top.{v}}
+
+/-- Let `ℱ, 𝒢 : (opens X)ᵒᵖ ⥤ C` be `C`-valued presheaves on `X`. -/
+variables {ℱ 𝒢 : X.presheaf C}
+
+/--
+A map of presheaves `T : ℱ ⟶ 𝒢` is **locally surjective** if for any open set `U`,
+section `t` over `U`, and `x ∈ U`, there exists an open set `x ∈ V ⊆ U` and a section `s` over `V`
+such that `$T_*(s_V) = t|_V$`.
+
+See `is_locally_surjective_iff` below.
+-/
+def is_locally_surjective (T : ℱ ⟶ 𝒢) :=
+  category_theory.is_locally_surjective (opens.grothendieck_topology X) T
+
+lemma is_locally_surjective_iff (T : ℱ ⟶ 𝒢) :
+  is_locally_surjective T ↔
+    ∀ U t (x ∈ U), ∃ V (ι : V ⟶ U), (∃ s, T.app _ s = t |_ₕ ι) ∧ x ∈ V :=
+iff.rfl
+
+section surjective_on_stalks
+
+variables [limits.has_colimits C] [limits.preserves_filtered_colimits (forget C)]
+
+/-- An equivalent condition for a map of presheaves to be locally surjective
+is for all the induced maps on stalks to be surjective. -/
+lemma locally_surjective_iff_surjective_on_stalks (T : ℱ ⟶ 𝒢) :
+  is_locally_surjective T ↔
+  ∀ (x : X), function.surjective ((stalk_functor C x).map T) :=
+begin
+  split; intro hT,
+  { /- human proof:
+    Let g ∈ Γₛₜ 𝒢 x be a germ. Represent it on an open set U ⊆ X
+    as ⟨t, U⟩. By local surjectivity, pass to a smaller open set V
+    on which there exists s ∈ Γ_ ℱ V mapping to t |_ V.
+    Then the germ of s maps to g -/
+
+    -- Let g ∈ Γₛₜ 𝒢 x be a germ.
+    intros x g,
+    -- Represent it on an open set U ⊆ X as ⟨t, U⟩.
+    obtain ⟨U, hxU, t, rfl⟩ :=  𝒢.germ_exist x g,
+    -- By local surjectivity, pass to a smaller open set V
+    -- on which there exists s ∈ Γ_ ℱ V mapping to t |_ V.
+    rcases hT U t x hxU with ⟨V, ι, ⟨s, h_eq⟩, hxV⟩,
+
+    -- Then the germ of s maps to g.
+    use ℱ.germ ⟨x, hxV⟩ s,
+    convert stalk_functor_map_germ_apply V ⟨x, hxV⟩ T s,
+
+    simpa [h_eq] using germ_res_apply 𝒢 ι ⟨x,hxV⟩ t, },
+
+  { /- human proof:
+    Let U be an open set, t ∈ Γ ℱ U a section, x ∈ U a point.
+    By surjectivity on stalks, the germ of t is the image of
+    some germ f ∈ Γₛₜ ℱ x. Represent f on some open set V ⊆ X as ⟨s, V⟩.
+    Then there is some possibly smaller open set x ∈ W ⊆ V ∩ U on which
+    we have T(s) |_ W = t |_ W. -/
+    intros U t x hxU,
+    set t_x := 𝒢.germ ⟨x, hxU⟩ t with ht_x,
+    obtain ⟨s_x, hs_x : ((stalk_functor C x).map T) s_x = t_x⟩ := hT x t_x,
+    obtain ⟨V, hxV, s, rfl⟩ := ℱ.germ_exist x s_x,
+    -- rfl : ℱ.germ x s = s_x
+    have key_W := 𝒢.germ_eq x hxV hxU (T.app _ s) t
+      (by { convert hs_x,
+            symmetry,
+            convert stalk_functor_map_germ_apply _ _ _ s, }),
+    obtain ⟨W, hxW, hWV, hWU, h_eq⟩ := key_W,
+
+    refine ⟨W, hWU, ⟨ℱ.map hWV.op s, _⟩, hxW⟩,
+    convert h_eq,
+    simp only [← comp_apply, T.naturality], },
+end
+
+end surjective_on_stalks
+
+end locally_surjective
+
+end Top.presheaf
diff --git a/src/topology/sheaves/operations.lean b/src/topology/sheaves/operations.lean
new file mode 100644
index 0000000000000..c4ce3bb1979d9
--- /dev/null
+++ b/src/topology/sheaves/operations.lean
@@ -0,0 +1,121 @@
+/-
+Copyright (c) 2022 Andrew Yang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Andrew Yang
+-/
+import algebra.category.Ring.instances
+import algebra.category.Ring.filtered_colimits
+import ring_theory.localization.basic
+import topology.sheaves.stalks
+
+/-!
+
+# Operations on sheaves
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main definition
+
+- `submonoid_presheaf` : A subpresheaf with a submonoid structure on each of the components.
+- `localization_presheaf` : The localization of a presheaf of commrings at a `submonoid_presheaf`.
+- `total_quotient_presheaf` : The presheaf of total quotient rings.
+
+-/
+
+open_locale non_zero_divisors
+
+open topological_space opposite category_theory
+
+universes v u w
+
+namespace Top
+
+namespace presheaf
+
+variables {X : Top.{w}} {C : Type u} [category.{v} C] [concrete_category C]
+
+local attribute [instance] concrete_category.has_coe_to_sort
+
+/-- A subpresheaf with a submonoid structure on each of the components. -/
+structure submonoid_presheaf [∀ X : C, mul_one_class X]
+  [∀ (X Y : C), monoid_hom_class (X ⟶ Y) X Y] (F : X.presheaf C) :=
+(obj : ∀ U, submonoid (F.obj U))
+(map : ∀ {U V : (opens X)ᵒᵖ} (i : U ⟶ V), (obj U) ≤ (obj V).comap (F.map i))
+
+variables {F : X.presheaf CommRing.{w}} (G : F.submonoid_presheaf)
+
+/-- The localization of a presheaf of `CommRing`s with respect to a `submonoid_presheaf`. -/
+protected noncomputable
+def submonoid_presheaf.localization_presheaf :
+  X.presheaf CommRing :=
+{ obj := λ U, CommRing.of $ localization (G.obj U),
+  map := λ U V i, CommRing.of_hom $ is_localization.map _ (F.map i) (G.map i),
+  map_id' := λ U, begin
+    apply is_localization.ring_hom_ext (G.obj U),
+    any_goals { dsimp, apply_instance },
+    refine (is_localization.map_comp _).trans _,
+    rw F.map_id,
+    refl,
+  end,
+  map_comp' := λ U V W i j, by { refine eq.trans _ (is_localization.map_comp_map _ _).symm,
+    ext, dsimp, congr, rw F.map_comp, refl } }
+
+/-- The map into the localization presheaf. -/
+def submonoid_presheaf.to_localization_presheaf :
+  F ⟶ G.localization_presheaf :=
+{ app := λ U, CommRing.of_hom $ algebra_map (F.obj U) (localization $ G.obj U),
+  naturality' := λ U V i, (is_localization.map_comp (G.map i)).symm }
+
+instance : epi G.to_localization_presheaf :=
+@@nat_trans.epi_of_epi_app _ _ G.to_localization_presheaf (λ U, localization.epi' (G.obj U))
+
+variable (F)
+
+/-- Given a submonoid at each of the stalks, we may define a submonoid presheaf consisting of
+sections whose restriction onto each stalk falls in the given submonoid. -/
+@[simps] noncomputable
+def submonoid_presheaf_of_stalk (S : ∀ x : X, submonoid (F.stalk x)) :
+  F.submonoid_presheaf :=
+{ obj := λ U, ⨅ x : (unop U), submonoid.comap (F.germ x) (S x),
+  map := λ U V i, begin
+    intros s hs,
+    simp only [submonoid.mem_comap, submonoid.mem_infi] at ⊢ hs,
+    intro x,
+    change (F.map i.unop.op ≫ F.germ x) s ∈ _,
+    rw F.germ_res,
+    exact hs _,
+  end }
+
+noncomputable
+instance : inhabited F.submonoid_presheaf := ⟨F.submonoid_presheaf_of_stalk (λ _, ⊥)⟩
+
+/-- The localization of a presheaf of `CommRing`s at locally non-zero-divisor sections. -/
+noncomputable
+def total_quotient_presheaf : X.presheaf CommRing.{w} :=
+(F.submonoid_presheaf_of_stalk (λ x, (F.stalk x)⁰)).localization_presheaf
+
+/-- The map into the presheaf of total quotient rings -/
+@[derive epi] noncomputable
+def to_total_quotient_presheaf : F ⟶ F.total_quotient_presheaf :=
+submonoid_presheaf.to_localization_presheaf _
+
+instance (F : X.sheaf CommRing.{w}) : mono F.presheaf.to_total_quotient_presheaf :=
+begin
+  apply_with nat_trans.mono_of_mono_app { instances := ff },
+  intro U,
+  apply concrete_category.mono_of_injective,
+  apply is_localization.injective _,
+  swap 3, { exact localization.is_localization },
+  intros s hs t e,
+  apply section_ext F (unop U),
+  intro x,
+  rw map_zero,
+  apply submonoid.mem_infi.mp hs x,
+  rw [← map_mul, e, map_zero]
+end
+
+
+end presheaf
+
+end Top
diff --git a/src/topology/sheaves/presheaf.lean b/src/topology/sheaves/presheaf.lean
index f0b55bd21d3df..e4c312be03265 100644
--- a/src/topology/sheaves/presheaf.lean
+++ b/src/topology/sheaves/presheaf.lean
@@ -4,17 +4,20 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison, Mario Carneiro, Reid Barton, Andrew Yang
 -/
 import category_theory.limits.kan_extension
-import category_theory.adjunction
 import topology.category.Top.opens
+import category_theory.adjunction.opposites
 
 /-!
 # Presheaves on a topological space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We define `presheaf C X` simply as `(opens X)ᵒᵖ ⥤ C`,
 and inherit the category structure with natural transformations as morphisms.
 
 We define
-* `pushforward_obj {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : X.presheaf C) : Y.presheaf C`
+* `pushforward_obj {X Y : Top.{w}} (f : X ⟶ Y) (ℱ : X.presheaf C) : Y.presheaf C`
 with notation `f _* ℱ`
 and for `ℱ : X.presheaf C` provide the natural isomorphisms
 * `pushforward.id : (𝟙 X) _* ℱ ≅ ℱ`
@@ -26,7 +29,7 @@ We also define the functors `pushforward` and `pullback` between the categories
 `pushforward_pullback_adjunction`.
 -/
 
-universes v u
+universes w v u
 
 open category_theory
 open topological_space
@@ -37,24 +40,89 @@ variables (C : Type u) [category.{v} C]
 namespace Top
 
 /-- The category of `C`-valued presheaves on a (bundled) topological space `X`. -/
-@[derive category, nolint has_inhabited_instance]
-def presheaf (X : Top.{v}) := (opens X)ᵒᵖ ⥤ C
+@[derive category, nolint has_nonempty_instance]
+def presheaf (X : Top.{w}) : Type (max u v w) := (opens X)ᵒᵖ ⥤ C
 
 variables {C}
 
 namespace presheaf
 
+local attribute [instance] concrete_category.has_coe_to_sort concrete_category.has_coe_to_fun
+
+/-- Tag lemmas to use in `Top.presheaf.restrict_tac`.  -/
+@[user_attribute]
+meta def restrict_attr : user_attribute (tactic unit → tactic unit) unit :=
+{ name      := `sheaf_restrict,
+  descr     := "tag lemmas to use in `Top.presheaf.restrict_tac`",
+  cache_cfg :=
+  { mk_cache := λ ns, pure $ λ t, do
+    { ctx <- tactic.local_context,
+      ctx.any_of (tactic.focus1 ∘ (tactic.apply' >=> (λ _, tactic.done)) >=> (λ _, t)) <|>
+      ns.any_of (tactic.focus1 ∘ (tactic.resolve_name >=> tactic.to_expr >=> tactic.apply' >=>
+        (λ _, tactic.done)) >=> (λ _, t)) },
+    dependencies := [] } }
+
+/-- A tactic to discharge goals of type `U ≤ V` for `Top.presheaf.restrict_open` -/
+meta def restrict_tac : Π (n : ℕ), tactic unit
+| 0 := tactic.fail "`restrict_tac` failed"
+| (n + 1) := monad.join (restrict_attr.get_cache <*> pure tactic.done) <|>
+    `[apply' le_trans, mjoin (restrict_attr.get_cache <*> pure (restrict_tac n))]
+
+/-- A tactic to discharge goals of type `U ≤ V` for `Top.presheaf.restrict_open`.
+Defaults to three iterations. -/
+meta def restrict_tac' := restrict_tac 3
+
+attribute [sheaf_restrict] bot_le le_top le_refl inf_le_left inf_le_right le_sup_left le_sup_right
+
+example {X : Top} {v w x y z : opens X} (h₀ : v ≤ x) (h₁ : x ≤ z ⊓ w) (h₂ : x ≤ y ⊓ z) :
+  v ≤ y := by restrict_tac'
+
+/-- The restriction of a section along an inclusion of open sets.
+For `x : F.obj (op V)`, we provide the notation `x |_ₕ i` (`h` stands for `hom`) for `i : U ⟶ V`,
+and the notation `x |_ₗ U ⟪i⟫` (`l` stands for `le`) for `i : U ≤ V`.
+-/
+def restrict {X : Top} {C : Type*} [category C] [concrete_category C]
+  {F : X.presheaf C} {V : opens X} (x : F.obj (op V)) {U : opens X} (h : U ⟶ V) : F.obj (op U) :=
+F.map h.op x
+
+localized "infixl ` |_ₕ `: 80 := Top.presheaf.restrict" in algebraic_geometry
+
+localized "notation x ` |_ₗ `: 80 U ` ⟪` e `⟫ ` :=
+@Top.presheaf.restrict _ _ _ _ _ _ x U (@hom_of_le (opens _) _ U _ e)" in algebraic_geometry
+
+/-- The restriction of a section along an inclusion of open sets.
+For `x : F.obj (op V)`, we provide the notation `x |_ U`, where the proof `U ≤ V` is inferred by
+the tactic `Top.presheaf.restrict_tac'` -/
+abbreviation restrict_open {X : Top} {C : Type*} [category C] [concrete_category C]
+  {F : X.presheaf C} {V : opens X} (x : F.obj (op V)) (U : opens X)
+  (e : U ≤ V . Top.presheaf.restrict_tac') : F.obj (op U) :=
+x |_ₗ U ⟪e⟫
+
+localized "infixl ` |_ `: 80 := Top.presheaf.restrict_open" in algebraic_geometry
+
+@[simp]
+lemma restrict_restrict {X : Top} {C : Type*} [category C] [concrete_category C]
+  {F : X.presheaf C} {U V W : opens X} (e₁ : U ≤ V) (e₂ : V ≤ W) (x : F.obj (op W)) :
+    x |_ V |_ U = x |_ U :=
+by { delta restrict_open restrict, rw [← comp_apply, ← functor.map_comp], refl }
+
+@[simp]
+lemma map_restrict {X : Top} {C : Type*} [category C] [concrete_category C]
+  {F G : X.presheaf C} (e : F ⟶ G) {U V : opens X} (h : U ≤ V) (x : F.obj (op V)) :
+    e.app _ (x |_ U) = (e.app _ x) |_ U :=
+by { delta restrict_open restrict, rw [← comp_apply, nat_trans.naturality, comp_apply] }
+
 /-- Pushforward a presheaf on `X` along a continuous map `f : X ⟶ Y`, obtaining a presheaf
 on `Y`. -/
-def pushforward_obj {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : X.presheaf C) : Y.presheaf C :=
+def pushforward_obj {X Y : Top.{w}} (f : X ⟶ Y) (ℱ : X.presheaf C) : Y.presheaf C :=
 (opens.map f).op ⋙ ℱ
 
 infix ` _* `: 80 := pushforward_obj
 
-@[simp] lemma pushforward_obj_obj {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : X.presheaf C) (U : (opens Y)ᵒᵖ) :
+@[simp] lemma pushforward_obj_obj {X Y : Top.{w}} (f : X ⟶ Y) (ℱ : X.presheaf C) (U : (opens Y)ᵒᵖ) :
   (f _* ℱ).obj U = ℱ.obj ((opens.map f).op.obj U) := rfl
 
-@[simp] lemma pushforward_obj_map {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : X.presheaf C)
+@[simp] lemma pushforward_obj_map {X Y : Top.{w}} (f : X ⟶ Y) (ℱ : X.presheaf C)
   {U V : (opens Y)ᵒᵖ} (i : U ⟶ V) :
   (f _* ℱ).map i = ℱ.map ((opens.map f).op.map i) := rfl
 
@@ -62,39 +130,39 @@ infix ` _* `: 80 := pushforward_obj
 An equality of continuous maps induces a natural isomorphism between the pushforwards of a presheaf
 along those maps.
 -/
-def pushforward_eq {X Y : Top.{v}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) :
+def pushforward_eq {X Y : Top.{w}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) :
   f _* ℱ ≅ g _* ℱ :=
 iso_whisker_right (nat_iso.op (opens.map_iso f g h).symm) ℱ
 
-lemma pushforward_eq' {X Y : Top.{v}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) :
+lemma pushforward_eq' {X Y : Top.{w}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) :
   f _* ℱ = g _* ℱ :=
 by rw h
 
 @[simp] lemma pushforward_eq_hom_app
-  {X Y : Top.{v}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) (U) :
+  {X Y : Top.{w}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) (U) :
   (pushforward_eq h ℱ).hom.app U =
     ℱ.map (begin dsimp [functor.op], apply quiver.hom.op, apply eq_to_hom, rw h, end) :=
 by simp [pushforward_eq]
 
 lemma pushforward_eq'_hom_app
-  {X Y : Top.{v}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) (U) :
+  {X Y : Top.{w}} {f g : X ⟶ Y} (h : f = g) (ℱ : X.presheaf C) (U) :
   nat_trans.app (eq_to_hom (pushforward_eq' h ℱ)) U = ℱ.map (eq_to_hom (by rw h)) :=
-by simpa
+by simpa [eq_to_hom_map]
 
 @[simp]
-lemma pushforward_eq_rfl {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : X.presheaf C) (U) :
+lemma pushforward_eq_rfl {X Y : Top.{w}} (f : X ⟶ Y) (ℱ : X.presheaf C) (U) :
   (pushforward_eq (rfl : f = f) ℱ).hom.app (op U) = 𝟙 _ :=
 begin
   dsimp [pushforward_eq],
   simp,
 end
 
-lemma pushforward_eq_eq {X Y : Top.{v}} {f g : X ⟶ Y} (h₁ h₂ : f = g) (ℱ : X.presheaf C) :
+lemma pushforward_eq_eq {X Y : Top.{w}} {f g : X ⟶ Y} (h₁ h₂ : f = g) (ℱ : X.presheaf C) :
   ℱ.pushforward_eq h₁ = ℱ.pushforward_eq h₂ :=
 rfl
 
 namespace pushforward
-variables {X : Top.{v}} (ℱ : X.presheaf C)
+variables {X : Top.{w}} (ℱ : X.presheaf C)
 
 /-- The natural isomorphism between the pushforward of a presheaf along the identity continuous map
 and the original presheaf. -/
@@ -111,7 +179,14 @@ by { dsimp [id], simp, }
 local attribute [tidy] tactic.op_induction'
 
 @[simp, priority 990] lemma id_hom_app (U) :
-  (id ℱ).hom.app U = ℱ.map (eq_to_hom (opens.op_map_id_obj U)) := by tidy
+  (id ℱ).hom.app U = ℱ.map (eq_to_hom (opens.op_map_id_obj U)) :=
+begin
+  -- was `tidy`
+  induction U using opposite.rec,
+  cases U,
+  rw [id_hom_app'],
+  congr
+end
 
 @[simp] lemma id_inv_app' (U) (p) : (id ℱ).inv.app (op ⟨U, p⟩) = ℱ.map (𝟙 (op ⟨U, p⟩)) :=
 by { dsimp [id], simp, }
@@ -119,17 +194,17 @@ by { dsimp [id], simp, }
 /-- The natural isomorphism between
 the pushforward of a presheaf along the composition of two continuous maps and
 the corresponding pushforward of a pushforward. -/
-def comp {Y Z : Top.{v}} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g) _* ℱ ≅ g _* (f _* ℱ) :=
+def comp {Y Z : Top.{w}} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g) _* ℱ ≅ g _* (f _* ℱ) :=
 iso_whisker_right (nat_iso.op (opens.map_comp f g).symm) ℱ
 
-lemma comp_eq {Y Z : Top.{v}} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g) _* ℱ = g _* (f _* ℱ) :=
+lemma comp_eq {Y Z : Top.{w}} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g) _* ℱ = g _* (f _* ℱ) :=
 rfl
 
-@[simp] lemma comp_hom_app {Y Z : Top.{v}} (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
+@[simp] lemma comp_hom_app {Y Z : Top.{w}} (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
   (comp ℱ f g).hom.app U = 𝟙 _ :=
 by { dsimp [comp], tidy, }
 
-@[simp] lemma comp_inv_app {Y Z : Top.{v}} (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
+@[simp] lemma comp_inv_app {Y Z : Top.{w}} (f : X ⟶ Y) (g : Y ⟶ Z) (U) :
   (comp ℱ f g).inv.app U = 𝟙 _ :=
 by { dsimp [comp], tidy, }
 
@@ -139,7 +214,7 @@ end pushforward
 A morphism of presheaves gives rise to a morphisms of the pushforwards of those presheaves.
 -/
 @[simps]
-def pushforward_map {X Y : Top.{v}} (f : X ⟶ Y) {ℱ 𝒢 : X.presheaf C} (α : ℱ ⟶ 𝒢) :
+def pushforward_map {X Y : Top.{w}} (f : X ⟶ Y) {ℱ 𝒢 : X.presheaf C} (α : ℱ ⟶ 𝒢) :
   f _* ℱ ⟶ f _* 𝒢 :=
 { app := λ U, α.app _,
   naturality' := λ U V i, by { erw α.naturality, refl, } }
@@ -169,10 +244,10 @@ def pullback_map {X Y : Top.{v}} (f : X ⟶ Y) {ℱ 𝒢 : Y.presheaf C} (α : 
 def pullback_obj_obj_of_image_open {X Y : Top.{v}} (f : X ⟶ Y) (ℱ : Y.presheaf C) (U : opens X)
   (H : is_open (f '' U)) : (pullback_obj f ℱ).obj (op U) ≅ ℱ.obj (op ⟨_, H⟩) :=
 begin
-  let x : costructured_arrow (opens.map f).op (op U) :=
-  { left := op ⟨f '' U, H⟩,
-    hom := ((@hom_of_le _ _ _ ((opens.map f).obj ⟨_, H⟩) (set.image_preimage.le_u_l _)).op :
-    op ((opens.map f).obj (⟨⇑f '' ↑U, H⟩)) ⟶ op U) },
+  let x : costructured_arrow (opens.map f).op (op U) := begin
+    refine @costructured_arrow.mk _ _ _ _ _ (op (opens.mk (f '' U) H)) _ _,
+    exact ((@hom_of_le _ _ _ ((opens.map f).obj ⟨_, H⟩) (set.image_preimage.le_u_l _)).op),
+  end,
   have hx : is_terminal x :=
   { lift := λ s,
     begin
@@ -197,7 +272,7 @@ nat_iso.of_components
     ℱ.map_iso (eq_to_iso (by simp)))
   (λ U V i,
   begin
-      ext, simp [-eq_to_hom_map,-eq_to_iso_map],
+      ext, simp,
       erw colimit.pre_desc_assoc,
       erw colimit.ι_desc_assoc,
       erw colimit.ι_desc_assoc,
@@ -208,13 +283,11 @@ lemma id_inv_app (U : opens Y) :
   (id ℱ).inv.app (op U) = colimit.ι (Lan.diagram (opens.map (𝟙 Y)).op ℱ (op U))
     (@costructured_arrow.mk _ _ _ _ _ (op U) _ (eq_to_hom (by simp))) :=
 begin
-  dsimp[id], simp[-eq_to_hom_map,-eq_to_iso_map],dsimp[colimit_of_diagram_terminal],
-  delta Lan.diagram,
-  refine eq.trans _ (category.id_comp _),
-  rw ← ℱ.map_id,
-  congr,
-  any_goals { apply subsingleton.helim },
-  all_goals { simp }
+  rw [← category.id_comp ((id ℱ).inv.app (op U)), ← nat_iso.app_inv, iso.comp_inv_eq],
+  dsimp [id],
+  rw colimit.ι_desc_assoc,
+  dsimp,
+  rw [← ℱ.map_comp, ← ℱ.map_id], refl,
 end
 
 end pullback
@@ -224,19 +297,22 @@ variable (C)
 /--
 The pushforward functor.
 -/
-def pushforward {X Y : Top.{v}} (f : X ⟶ Y) : X.presheaf C ⥤ Y.presheaf C :=
+def pushforward {X Y : Top.{w}} (f : X ⟶ Y) : X.presheaf C ⥤ Y.presheaf C :=
 { obj := pushforward_obj f,
   map := @pushforward_map _ _ X Y f }
 
 @[simp]
-lemma pushforward_map_app' {X Y : Top.{v}} (f : X ⟶ Y)
+lemma pushforward_map_app' {X Y : Top.{w}} (f : X ⟶ Y)
   {ℱ 𝒢 : X.presheaf C} (α : ℱ ⟶ 𝒢) {U : (opens Y)ᵒᵖ} :
   ((pushforward C f).map α).app U = α.app (op $ (opens.map f).obj U.unop) := rfl
 
-lemma id_pushforward {X : Top.{v}} : pushforward C (𝟙 X) = 𝟭 (X.presheaf C) :=
+lemma id_pushforward {X : Top.{w}} : pushforward C (𝟙 X) = 𝟭 (X.presheaf C) :=
 begin
   apply category_theory.functor.ext,
-  { intros, ext U, have h := f.congr, erw h (opens.op_map_id_obj U), simpa },
+  { intros,
+    ext U,
+    have h := f.congr, erw h (opens.op_map_id_obj U),
+    simpa [eq_to_hom_map], },
   { intros, apply pushforward.id_eq },
 end
 
@@ -266,10 +342,10 @@ lemma to_pushforward_of_iso_app {X Y : Top} (H₁ : X ≅ Y) {ℱ : X.presheaf C
 begin
   delta to_pushforward_of_iso,
   simp only [equiv.to_fun_as_coe, nat_trans.comp_app, equivalence.equivalence_mk'_unit,
-    eq_to_hom_map, presheaf_equiv_of_iso_unit_iso_hom_app_app, equivalence.to_adjunction,
-    equivalence.equivalence_mk'_counit, presheaf_equiv_of_iso_inverse_map_app,
-    adjunction.mk_of_unit_counit_hom_equiv_apply],
-  congr
+    eq_to_hom_map, eq_to_hom_op, eq_to_hom_trans, presheaf_equiv_of_iso_unit_iso_hom_app_app,
+    equivalence.to_adjunction, equivalence.equivalence_mk'_counit,
+    presheaf_equiv_of_iso_inverse_map_app, adjunction.mk_of_unit_counit_hom_equiv_apply],
+  congr,
 end
 
 /--
@@ -297,7 +373,7 @@ on `X`. -/
 @[simps map_app]
 def pullback {X Y : Top.{v}} (f : X ⟶ Y) : Y.presheaf C ⥤ X.presheaf C := Lan (opens.map f).op
 
-@[simp] lemma pullback_obj_eq_pullback_obj {C} [category C] [has_colimits C] {X Y : Top.{v}}
+@[simp] lemma pullback_obj_eq_pullback_obj {C} [category C] [has_colimits C] {X Y : Top.{w}}
   (f : X ⟶ Y) (ℱ : Y.presheaf C) : (pullback C f).obj ℱ = pullback_obj f ℱ := rfl
 
 /-- The pullback and pushforward along a continuous map are adjoint to each other. -/
diff --git a/src/topology/sheaves/presheaf_of_functions.lean b/src/topology/sheaves/presheaf_of_functions.lean
index dc45e84c8b10d..07212f6643439 100644
--- a/src/topology/sheaves/presheaf_of_functions.lean
+++ b/src/topology/sheaves/presheaf_of_functions.lean
@@ -11,6 +11,9 @@ import topology.continuous_function.algebra
 /-!
 # Presheaves of functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct some simple examples of presheaves of functions on a topological space.
 * `presheaf_to_Types X T`, where `T : X → Type`,
   is the presheaf of dependently-typed (not-necessarily continuous) functions
@@ -41,7 +44,9 @@ There is no requirement that the functions are continuous, here.
 -/
 def presheaf_to_Types (T : X → Type v) : X.presheaf (Type v) :=
 { obj := λ U, Π x : (unop U), T x,
-  map := λ U V i g, λ (x : unop V), g (i.unop x) }
+  map := λ U V i g, λ (x : unop V), g (i.unop x),
+  map_id' := λ U, by { ext g ⟨x, hx⟩, refl },
+  map_comp' := λ U V W i j, rfl }
 
 @[simp] lemma presheaf_to_Types_obj
   {T : X → Type v} {U : (opens X)ᵒᵖ} :
@@ -65,7 +70,9 @@ There is no requirement that the functions are continuous, here.
 -- written as an equality of functions (rather than being applied to some argument).
 def presheaf_to_Type (T : Type v) : X.presheaf (Type v) :=
 { obj := λ U, (unop U) → T,
-  map := λ U V i g, g ∘ i.unop }
+  map := λ U V i g, g ∘ i.unop,
+  map_id' := λ U, by { ext g ⟨x, hx⟩, refl },
+  map_comp' := λ U V W i j, rfl }
 
 @[simp] lemma presheaf_to_Type_obj
   {T : Type v} {U : (opens X)ᵒᵖ} :
@@ -119,9 +126,14 @@ from `X : Top` to `R : TopCommRing` form a commutative ring, functorial in both
 def CommRing_yoneda : TopCommRing.{u} ⥤ (Top.{u}ᵒᵖ ⥤ CommRing.{u}) :=
 { obj := λ R,
   { obj := λ X, continuous_functions X R,
-    map := λ X Y f, continuous_functions.pullback f R },
+    map := λ X Y f, continuous_functions.pullback f R,
+    map_id' := λ X, by { ext, refl },
+    map_comp' := λ X Y Z f g, rfl },
   map := λ R S φ,
-  { app := λ X, continuous_functions.map X φ } }
+  { app := λ X, continuous_functions.map X φ,
+    naturality' := λ X Y f, rfl },
+  map_id' := λ X, by { ext, refl },
+  map_comp' := λ X Y Z f g, rfl }
 
 /--
 The presheaf (of commutative rings), consisting of functions on an open set `U ⊆ X` with
diff --git a/src/topology/sheaves/punit.lean b/src/topology/sheaves/punit.lean
new file mode 100644
index 0000000000000..67081ab48be0e
--- /dev/null
+++ b/src/topology/sheaves/punit.lean
@@ -0,0 +1,53 @@
+/-
+Copyright (c) 2022 Jujian Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jujian Zhang
+-/
+import topology.sheaves.sheaf_condition.sites
+
+/-!
+# Presheaves on punit
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Presheaves on punit satisfy sheaf condition iff its value at empty set is a terminal object.
+-/
+
+namespace Top.presheaf
+
+universes u v w
+
+open category_theory category_theory.limits Top opposite
+
+variables {C : Type u} [category.{v} C]
+
+lemma is_sheaf_of_is_terminal_of_indiscrete {X : Top.{w}} (hind : X.str = ⊤) (F : presheaf C X)
+  (it : is_terminal $ F.obj $ op ⊥) : F.is_sheaf :=
+λ c U s hs, begin
+  obtain rfl | hne := eq_or_ne U ⊥,
+  { intros _ _, rw @exists_unique_iff_exists _ ⟨λ _ _, _⟩,
+    { refine ⟨it.from _, λ U hU hs, is_terminal.hom_ext _ _ _⟩, rwa le_bot_iff.1 hU.le },
+    { apply it.hom_ext } },
+  { convert presieve.is_sheaf_for_top_sieve _, rw ←sieve.id_mem_iff_eq_top,
+    have := (U.eq_bot_or_top hind).resolve_left hne, subst this,
+    obtain he | ⟨⟨x⟩⟩ := is_empty_or_nonempty X,
+    { exact (hne $ set_like.ext'_iff.2 $ set.univ_eq_empty_iff.2 he).elim },
+    obtain ⟨U, f, hf, hm⟩ := hs x trivial,
+    obtain rfl | rfl := U.eq_bot_or_top hind,
+    { cases hm }, { convert hf } },
+end
+
+lemma is_sheaf_iff_is_terminal_of_indiscrete {X : Top.{w}} (hind : X.str = ⊤)
+  (F : presheaf C X) : F.is_sheaf ↔ nonempty (is_terminal $ F.obj $ op ⊥) :=
+⟨λ h, ⟨sheaf.is_terminal_of_empty ⟨F, h⟩⟩, λ ⟨it⟩, is_sheaf_of_is_terminal_of_indiscrete hind F it⟩
+
+lemma is_sheaf_on_punit_of_is_terminal (F : presheaf C (Top.of punit))
+  (it : is_terminal $ F.obj $ op ⊥) : F.is_sheaf :=
+is_sheaf_of_is_terminal_of_indiscrete (@subsingleton.elim (topological_space punit) _ _ _) F it
+
+lemma is_sheaf_on_punit_iff_is_terminal (F : presheaf C (Top.of punit)) :
+  F.is_sheaf ↔ nonempty (is_terminal $ F.obj $ op ⊥) :=
+⟨λ h, ⟨sheaf.is_terminal_of_empty ⟨F, h⟩⟩, λ ⟨it⟩, is_sheaf_on_punit_of_is_terminal F it⟩
+
+end Top.presheaf
diff --git a/src/topology/sheaves/sheaf.lean b/src/topology/sheaves/sheaf.lean
index a2ca6ff6b43c3..4c0ccff469017 100644
--- a/src/topology/sheaves/sheaf.lean
+++ b/src/topology/sheaves/sheaf.lean
@@ -3,41 +3,32 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import topology.sheaves.sheaf_condition.equalizer_products
-import category_theory.full_subcategory
-import category_theory.limits.punit
+import topology.sheaves.presheaf
+import category_theory.sites.sheaf
+import category_theory.sites.spaces
 
 /-!
 # Sheaves
 
-We define sheaves on a topological space, with values in an arbitrary category with products.
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-The sheaf condition for a `F : presheaf C X` requires that the morphism
-`F.obj U ⟶ ∏ F.obj (U i)` (where `U` is some open set which is the union of the `U i`)
-is the equalizer of the two morphisms
-`∏ F.obj (U i) ⟶ ∏ F.obj (U i ⊓ U j)`.
+We define sheaves on a topological space, with values in an arbitrary category.
 
-We provide the instance `category (sheaf C X)` as the full subcategory of presheaves,
-and the fully faithful functor `sheaf.forget : sheaf C X ⥤ presheaf C X`.
-
-## Equivalent conditions
-
-While the "official" definition is in terms of an equalizer diagram,
-in `src/topology/sheaves/sheaf_condition/pairwise_intersections.lean`
-and in `src/topology/sheaves/sheaf_condition/open_le_cover.lean`
-we provide two equivalent conditions (and prove they are equivalent).
+A presheaf on a topological space `X` is a sheaf presicely when it is a sheaf under the
+grothendieck topology on `opens X`, which expands out to say: For each open cover `{ Uᵢ }` of
+`U`, and a family of compatible functions `A ⟶ F(Uᵢ)` for an `A : X`, there exists an unique
+gluing `A ⟶ F(U)` compatible with the restriction.
 
-The first is that `F.obj U` is the limit point of the diagram consisting of all the `F.obj (U i)`
-and `F.obj (U i ⊓ U j)`.
-(That is, we explode the equalizer of two products out into its component pieces.)
+See the docstring of `Top.presheaf.is_sheaf` for an explanation on the design descisions and a list
+of equivalent conditions.
 
-The second is that `F.obj U` is the limit point of the diagram constisting of all the `F.obj V`,
-for those `V : opens X` such that `V ≤ U i` for some `i`.
-(This condition is particularly easy to state, and perhaps should become the "official" definition.)
+We provide the instance `category (sheaf C X)` as the full subcategory of presheaves,
+and the fully faithful functor `sheaf.forget : sheaf C X ⥤ presheaf C X`.
 
 -/
 
-universes v u
+universes w v u
 
 noncomputable theory
 
@@ -49,38 +40,68 @@ open topological_space.opens
 
 namespace Top
 
-variables {C : Type u} [category.{v} C] [has_products C]
-variables {X : Top.{v}} (F : presheaf C X) {ι : Type v} (U : ι → opens X)
+variables {C : Type u} [category.{v} C]
+variables {X : Top.{w}} (F : presheaf C X) {ι : Type v} (U : ι → opens X)
 
 namespace presheaf
 
-open sheaf_condition_equalizer_products
-
 /--
-The sheaf condition for a `F : presheaf C X` requires that the morphism
-`F.obj U ⟶ ∏ F.obj (U i)` (where `U` is some open set which is the union of the `U i`)
-is the equalizer of the two morphisms
-`∏ F.obj (U i) ⟶ ∏ F.obj (U i) ⊓ (U j)`.
+The sheaf condition has several different equivalent formulations.
+The official definition chosen here is in terms of grothendieck topologies so that the results on
+sites could be applied here easily, and this condition does not require additional constraints on
+the value category.
+The equivalent formulations of the sheaf condition on `presheaf C X` are as follows :
+
+1. `Top.presheaf.is_sheaf`: (the official definition)
+  It is a sheaf with respect to the grothendieck topology on `opens X`, which is to say:
+  For each open cover `{ Uᵢ }` of `U`, and a family of compatible functions `A ⟶ F(Uᵢ)` for an
+  `A : X`, there exists an unique gluing `A ⟶ F(U)` compatible with the restriction.
+
+2. `Top.presheaf.is_sheaf_equalizer_products`: (requires `C` to have all products)
+  For each open cover `{ Uᵢ }` of `U`, `F(U) ⟶ ∏ F(Uᵢ)` is the equalizer of the two morphisms
+  `∏ F(Uᵢ) ⟶ ∏ F(Uᵢ ∩ Uⱼ)`.
+  See `Top.presheaf.is_sheaf_iff_is_sheaf_equalizer_products`.
+
+3. `Top.presheaf.is_sheaf_opens_le_cover`:
+  For each open cover `{ Uᵢ }` of `U`, `F(U)` is the limit of the diagram consisting of arrows
+  `F(V₁) ⟶ F(V₂)` for every pair of open sets `V₁ ⊇ V₂` that are contained in some `Uᵢ`.
+  See `Top.presheaf.is_sheaf_iff_is_sheaf_opens_le_cover`.
+
+4. `Top.presheaf.is_sheaf_pairwise_intersections`:
+  For each open cover `{ Uᵢ }` of `U`, `F(U)` is the limit of the diagram consisting of arrows
+  from `F(Uᵢ)` and `F(Uⱼ)` to `F(Uᵢ ∩ Uⱼ)` for each pair `(i, j)`.
+  See `Top.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections`.
+
+The following requires `C` to be concrete and complete, and `forget C` to reflect isomorphisms and
+preserve limits. This applies to most "algebraic" categories, e.g. groups, abelian groups and rings.
+
+5. `Top.presheaf.is_sheaf_unique_gluing`:
+  (requires `C` to be concrete and complete; `forget C` to reflect isomorphisms and preserve limits)
+  For each open cover `{ Uᵢ }` of `U`, and a compatible family of elements `x : F(Uᵢ)`, there exists
+  a unique gluing `x : F(U)` that restricts to the given elements.
+  See `Top.presheaf.is_sheaf_iff_is_sheaf_unique_gluing`.
+
+6. The underlying sheaf of types is a sheaf.
+  See `Top.presheaf.is_sheaf_iff_is_sheaf_comp` and
+  `category_theory.presheaf.is_sheaf_iff_is_sheaf_forget`.
 -/
-def is_sheaf (F : presheaf C X) : Prop :=
-∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (is_limit (sheaf_condition_equalizer_products.fork F U))
+def is_sheaf (F : presheaf.{w v u} C X) : Prop :=
+presheaf.is_sheaf (opens.grothendieck_topology X) F
 
 /--
-The presheaf valued in `punit` over any topological space is a sheaf.
+The presheaf valued in `unit` over any topological space is a sheaf.
 -/
-lemma is_sheaf_punit (F : presheaf (category_theory.discrete punit) X) : F.is_sheaf :=
-λ ι U, ⟨punit_cone_is_limit⟩
+lemma is_sheaf_unit (F : presheaf (category_theory.discrete unit) X) : F.is_sheaf :=
+λ x U S hS x hx, ⟨eq_to_hom (subsingleton.elim _ _), by tidy, by tidy⟩
+
+lemma is_sheaf_iso_iff {F G : presheaf C X} (α : F ≅ G) : F.is_sheaf ↔ G.is_sheaf :=
+presheaf.is_sheaf_of_iso_iff α
 
 /--
 Transfer the sheaf condition across an isomorphism of presheaves.
 -/
 lemma is_sheaf_of_iso {F G : presheaf C X} (α : F ≅ G) (h : F.is_sheaf) : G.is_sheaf :=
-λ ι U, ⟨is_limit.of_iso_limit
-  ((is_limit.postcompose_inv_equiv _ _).symm (h U).some)
-  (sheaf_condition_equalizer_products.fork.iso_of_iso U α.symm).symm⟩
-
-lemma is_sheaf_iso_iff {F G : presheaf C X} (α : F ≅ G) : F.is_sheaf ↔ G.is_sheaf :=
-⟨(λ h, is_sheaf_of_iso α h), (λ h, is_sheaf_of_iso α.symm h)⟩
+(is_sheaf_iso_iff α).1 h
 
 end presheaf
 
@@ -91,11 +112,18 @@ A `sheaf C X` is a presheaf of objects from `C` over a (bundled) topological spa
 satisfying the sheaf condition.
 -/
 @[derive category]
-def sheaf : Type (max u v) := { F : presheaf C X // F.is_sheaf }
+def sheaf : Type (max u v w) := Sheaf (opens.grothendieck_topology X) C
+
+variables {C X}
+
+/-- The underlying presheaf of a sheaf -/
+abbreviation sheaf.presheaf (F : X.sheaf C) : Top.presheaf C X := F.1
+
+variables (C X)
 
 -- Let's construct a trivial example, to keep the inhabited linter happy.
 instance sheaf_inhabited : inhabited (sheaf (category_theory.discrete punit) X) :=
-⟨⟨functor.star _, presheaf.is_sheaf_punit _⟩⟩
+⟨⟨functor.star _, presheaf.is_sheaf_unit _⟩⟩
 
 namespace sheaf
 
@@ -104,11 +132,12 @@ The forgetful functor from sheaves to presheaves.
 -/
 @[derive [full, faithful]]
 def forget : Top.sheaf C X ⥤ Top.presheaf C X :=
-full_subcategory_inclusion presheaf.is_sheaf
+Sheaf_to_presheaf _ _
 
-@[simp] lemma id_app (F : sheaf C X) (t) : (𝟙 F : F ⟶ F).app t = 𝟙 _ := rfl
-@[simp] lemma comp_app {F G H : sheaf C X} (f : F ⟶ G) (g : G ⟶ H) (t) :
-  (f ≫ g).app t = f.app t ≫ g.app t := rfl
+-- Note: These can be proved by simp.
+lemma id_app (F : sheaf C X) (t) : (𝟙 F : F ⟶ F).1.app t = 𝟙 _ := rfl
+lemma comp_app {F G H : sheaf C X} (f : F ⟶ G) (g : G ⟶ H) (t) :
+  (f ≫ g).1.app t = f.1.app t ≫ g.1.app t := rfl
 
 end sheaf
 
diff --git a/src/topology/sheaves/sheaf_condition/equalizer_products.lean b/src/topology/sheaves/sheaf_condition/equalizer_products.lean
index 991aa7e5d3a5e..e75084455b939 100644
--- a/src/topology/sheaves/sheaf_condition/equalizer_products.lean
+++ b/src/topology/sheaves/sheaf_condition/equalizer_products.lean
@@ -3,23 +3,27 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import category_theory.full_subcategory
 import category_theory.limits.shapes.equalizers
 import category_theory.limits.shapes.products
-import tactic.elementwise
-import topology.sheaves.presheaf
+import topology.sheaves.sheaf_condition.pairwise_intersections
 
 /-!
 # The sheaf condition in terms of an equalizer of products
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Here we set up the machinery for the "usual" definition of the sheaf condition,
 e.g. as in https://stacks.math.columbia.edu/tag/0072
 in terms of an equalizer diagram where the two objects are
 `∏ F.obj (U i)` and `∏ F.obj (U i) ⊓ (U j)`.
 
+We show that this sheaf condition is equivalent to the `pairwise_intersections` sheaf condition when
+the presheaf is valued in a category with products, and thereby equivalent to the default sheaf
+condition.
 -/
 
-universes v u
+universes v' v u
 
 noncomputable theory
 
@@ -31,8 +35,8 @@ open topological_space.opens
 
 namespace Top
 
-variables {C : Type u} [category.{v} C] [has_products C]
-variables {X : Top.{v}} (F : presheaf C X) {ι : Type v} (U : ι → opens X)
+variables {C : Type u} [category.{v} C] [has_products.{v'} C]
+variables {X : Top.{v'}} (F : presheaf C X) {ι : Type v'} (U : ι → opens X)
 
 namespace presheaf
 
@@ -50,25 +54,25 @@ def pi_inters : C := ∏ (λ p : ι × ι, F.obj (op (U p.1 ⊓ U p.2)))
 The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
 are given by the restriction maps from `U i` to `U i ⊓ U j`.
 -/
-def left_res : pi_opens F U ⟶ pi_inters F U :=
+def left_res : pi_opens F U ⟶ pi_inters.{v'} F U :=
 pi.lift (λ p : ι × ι, pi.π _ p.1 ≫ F.map (inf_le_left (U p.1) (U p.2)).op)
 
 /--
 The morphism `Π F.obj (U i) ⟶ Π F.obj (U i) ⊓ (U j)` whose components
 are given by the restriction maps from `U j` to `U i ⊓ U j`.
 -/
-def right_res : pi_opens F U ⟶ pi_inters F U :=
+def right_res : pi_opens F U ⟶ pi_inters.{v'} F U :=
 pi.lift (λ p : ι × ι, pi.π _ p.2 ≫ F.map (inf_le_right (U p.1) (U p.2)).op)
 
 /--
 The morphism `F.obj U ⟶ Π F.obj (U i)` whose components
 are given by the restriction maps from `U j` to `U i ⊓ U j`.
 -/
-def res : F.obj (op (supr U)) ⟶ pi_opens F U :=
+def res : F.obj (op (supr U)) ⟶ pi_opens.{v'} F U :=
 pi.lift (λ i : ι, F.map (topological_space.opens.le_supr U i).op)
 
 @[simp, elementwise]
-lemma res_π (i : ι) : res F U ≫ limit.π _ i = F.map (opens.le_supr U i).op :=
+lemma res_π (i : ι) : res F U ≫ limit.π _ ⟨i⟩ = F.map (opens.le_supr U i).op :=
 by rw [res, limit.lift_π, fan.mk_π_app]
 
 @[elementwise]
@@ -86,8 +90,8 @@ end
 The equalizer diagram for the sheaf condition.
 -/
 @[reducible]
-def diagram : walking_parallel_pair.{v} ⥤ C :=
-parallel_pair (left_res F U) (right_res F U)
+def diagram : walking_parallel_pair ⥤ C :=
+parallel_pair (left_res.{v'} F U) (right_res F U)
 
 /--
 The restriction map `F.obj U ⟶ Π F.obj (U i)` gives a cone over the equalizer diagram
@@ -111,16 +115,16 @@ variables {F} {G : presheaf C X}
 
 /-- Isomorphic presheaves have isomorphic `pi_opens` for any cover `U`. -/
 @[simp]
-def pi_opens.iso_of_iso (α : F ≅ G) : pi_opens F U ≅ pi_opens G U :=
+def pi_opens.iso_of_iso (α : F ≅ G) : pi_opens F U ≅ pi_opens.{v'} G U :=
 pi.map_iso (λ X, α.app _)
 
 /-- Isomorphic presheaves have isomorphic `pi_inters` for any cover `U`. -/
 @[simp]
-def pi_inters.iso_of_iso (α : F ≅ G) : pi_inters F U ≅ pi_inters G U :=
+def pi_inters.iso_of_iso (α : F ≅ G) : pi_inters F U ≅ pi_inters.{v'} G U :=
 pi.map_iso (λ X, α.app _)
 
 /-- Isomorphic presheaves have isomorphic sheaf condition diagrams. -/
-def diagram.iso_of_iso (α : F ≅ G) : diagram F U ≅ diagram G U :=
+def diagram.iso_of_iso (α : F ≅ G) : diagram F U ≅ diagram.{v'} G U :=
 nat_iso.of_components
   begin rintro ⟨⟩, exact pi_opens.iso_of_iso U α, exact pi_inters.iso_of_iso U α end
   begin
@@ -147,111 +151,309 @@ begin
     simp [res, diagram.iso_of_iso], }
 end
 
-section open_embedding
-
-variables {V : Top.{v}} {j : V ⟶ X} (oe : open_embedding j)
-variables (𝒰 : ι → opens V)
+end sheaf_condition_equalizer_products
 
 /--
-Push forward a cover along an open embedding.
+The sheaf condition for a `F : presheaf C X` requires that the morphism
+`F.obj U ⟶ ∏ F.obj (U i)` (where `U` is some open set which is the union of the `U i`)
+is the equalizer of the two morphisms
+`∏ F.obj (U i) ⟶ ∏ F.obj (U i) ⊓ (U j)`.
 -/
-@[simp]
-def cover.of_open_embedding : ι → opens X := (λ i, oe.is_open_map.functor.obj (𝒰 i))
+def is_sheaf_equalizer_products (F : presheaf.{v' v u} C X) : Prop :=
+∀ ⦃ι : Type v'⦄ (U : ι → opens X), nonempty (is_limit (sheaf_condition_equalizer_products.fork F U))
 
-/--
-The isomorphism between `pi_opens` corresponding to an open embedding.
+/-!
+The remainder of this file shows that the equalizer_products sheaf condition is equivalent
+to the pariwise_intersections sheaf condition.
 -/
-@[simp]
-def pi_opens.iso_of_open_embedding :
-  pi_opens (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅ pi_opens F (cover.of_open_embedding oe 𝒰) :=
-pi.map_iso (λ X, F.map_iso (iso.refl _))
+
+namespace sheaf_condition_pairwise_intersections
+
+open category_theory.pairwise category_theory.pairwise.hom
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_functor_obj (c : cone ((diagram U).op ⋙ F)) :
+  cone (sheaf_condition_equalizer_products.diagram F U) :=
+{ X := c.X,
+  π :=
+  { app := λ Z,
+      walking_parallel_pair.cases_on Z
+        (pi.lift (λ (i : ι), c.π.app (op (single i))))
+        (pi.lift (λ (b : ι × ι), c.π.app (op (pair b.1 b.2)))),
+    naturality' := λ Y Z f,
+    begin
+      cases Y; cases Z; cases f,
+      { ext i, dsimp,
+        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
+          category.assoc],
+        dsimp,
+        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
+      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.left_res],
+        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
+          category.assoc],
+        have h := c.π.naturality (quiver.hom.op (hom.left i j)),
+        dsimp at h,
+        simpa using h, },
+      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.right_res],
+        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
+          category.assoc],
+        have h := c.π.naturality (quiver.hom.op (hom.right i j)),
+        dsimp at h,
+        simpa using h, },
+      { ext i, dsimp,
+        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
+          category.assoc],
+        dsimp,
+        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
+    end, }, }
+
+section
+local attribute [tidy] tactic.case_bash
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_functor :
+  limits.cone ((diagram U).op ⋙ F) ⥤
+    limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
+{ obj := λ c, cone_equiv_functor_obj F U c,
+  map := λ c c' f,
+  { hom := f.hom,
+    w' := λ j, begin
+      cases j;
+      { ext, simp only [limits.fan.mk_π_app, limits.cone_morphism.w,
+        limits.limit.lift_π, category.assoc, cone_equiv_functor_obj_π_app], },
+    end }, }.
+
+end
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_inverse_obj
+  (c : limits.cone (sheaf_condition_equalizer_products.diagram F U)) :
+  limits.cone ((diagram U).op ⋙ F) :=
+{ X := c.X,
+  π :=
+  { app :=
+    begin
+      intro x,
+      induction x using opposite.rec,
+      rcases x with (⟨i⟩|⟨i,j⟩),
+      { exact c.π.app (walking_parallel_pair.zero) ≫ pi.π _ i, },
+      { exact c.π.app (walking_parallel_pair.one) ≫ pi.π _ (i, j), }
+    end,
+    naturality' :=
+    begin
+      intros x y f,
+      induction x using opposite.rec,
+      induction y using opposite.rec,
+      have ef : f = f.unop.op := rfl,
+      revert ef,
+      generalize : f.unop = f',
+      rintro rfl,
+      rcases x with ⟨i⟩|⟨⟩; rcases y with ⟨⟩|⟨j,j⟩; rcases f' with ⟨⟩,
+      { dsimp, erw [F.map_id], simp, },
+      { dsimp, simp only [category.id_comp, category.assoc],
+        have h := c.π.naturality (walking_parallel_pair_hom.left),
+        dsimp [sheaf_condition_equalizer_products.left_res] at h,
+        simp only [category.id_comp] at h,
+        have h' := h =≫ pi.π _ (i, j),
+        rw h',
+        simp only [category.assoc, limit.lift_π, fan.mk_π_app],
+        refl, },
+      { dsimp, simp only [category.id_comp, category.assoc],
+        have h := c.π.naturality (walking_parallel_pair_hom.right),
+        dsimp [sheaf_condition_equalizer_products.right_res] at h,
+        simp only [category.id_comp] at h,
+        have h' := h =≫ pi.π _ (j, i),
+        rw h',
+        simp,
+        refl, },
+      { dsimp, erw [F.map_id], simp, },
+    end, }, }
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_inverse :
+  limits.cone (sheaf_condition_equalizer_products.diagram F U) ⥤
+    limits.cone ((diagram U).op ⋙ F) :=
+{ obj := λ c, cone_equiv_inverse_obj F U c,
+  map := λ c c' f,
+  { hom := f.hom,
+    w' :=
+    begin
+      intro x,
+      induction x using opposite.rec,
+      rcases x with (⟨i⟩|⟨i,j⟩),
+      { dsimp,
+        dunfold fork.ι,
+        rw [←(f.w walking_parallel_pair.zero), category.assoc], },
+      { dsimp,
+        rw [←(f.w walking_parallel_pair.one), category.assoc], },
+    end }, }.
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_unit_iso_app
+  (c : cone ((diagram U).op ⋙ F)) :
+  (𝟭 (cone ((diagram U).op ⋙ F))).obj c ≅
+    (cone_equiv_functor F U ⋙ cone_equiv_inverse F U).obj c :=
+{ hom :=
+  { hom := 𝟙 _,
+    w' := λ j, begin
+      induction j using opposite.rec, rcases j;
+      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
+    end, },
+  inv :=
+  { hom := 𝟙 _,
+    w' := λ j, begin
+      induction j using opposite.rec, rcases j;
+      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
+    end },
+  hom_inv_id' := begin
+    ext,
+    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
+  end,
+  inv_hom_id' := begin
+    ext,
+    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
+  end, }
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_unit_iso :
+  𝟭 (limits.cone ((diagram U).op ⋙ F)) ≅
+    cone_equiv_functor F U ⋙ cone_equiv_inverse F U :=
+nat_iso.of_components (cone_equiv_unit_iso_app F U) (by tidy)
+
+/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+@[simps]
+def cone_equiv_counit_iso :
+  cone_equiv_inverse F U ⋙ cone_equiv_functor F U ≅
+    𝟭 (limits.cone (sheaf_condition_equalizer_products.diagram F U)) :=
+nat_iso.of_components (λ c,
+{ hom :=
+  { hom := 𝟙 _,
+    w' :=
+    begin
+      rintro ⟨_|_⟩,
+      { ext ⟨j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
+      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
+    end },
+  inv :=
+  { hom := 𝟙 _,
+    w' :=
+    begin
+      rintro ⟨_|_⟩,
+      { ext ⟨j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
+      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
+    end, },
+  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
+  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, })
+(λ c d f, by { ext, dsimp, simp only [category.comp_id, category.id_comp], })
 
 /--
-The isomorphism between `pi_inters` corresponding to an open embedding.
+Cones over `diagram U ⋙ F` are the same as a cones over the usual sheaf condition equalizer diagram.
 -/
-@[simp]
-def pi_inters.iso_of_open_embedding :
-  pi_inters (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅ pi_inters F (cover.of_open_embedding oe 𝒰) :=
-pi.map_iso (λ X, F.map_iso
-  begin
-    dsimp [is_open_map.functor],
-    exact iso.op
-    { hom := hom_of_le (by
-      { simp only [oe.to_embedding.inj, set.image_inter],
-        exact le_rfl, }),
-      inv := hom_of_le (by
-      { simp only [oe.to_embedding.inj, set.image_inter],
-        exact le_rfl, }), },
-  end)
-
-/-- The isomorphism of sheaf condition diagrams corresponding to an open embedding. -/
-def diagram.iso_of_open_embedding :
-  diagram (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅ diagram F (cover.of_open_embedding oe 𝒰) :=
-nat_iso.of_components
-  begin
-    rintro ⟨⟩,
-    exact pi_opens.iso_of_open_embedding oe 𝒰,
-    exact pi_inters.iso_of_open_embedding oe 𝒰
-  end
-  begin
-    rintro ⟨⟩ ⟨⟩ ⟨⟩,
-    { simp, },
-    { ext,
-      dsimp [left_res, is_open_map.functor],
-      simp only [limit.lift_π, cones.postcompose_obj_π, iso.op_hom, discrete.nat_iso_hom_app,
-        functor.map_iso_refl, functor.map_iso_hom, lim_map_π_assoc, limit.lift_map, fan.mk_π_app,
-        nat_trans.comp_app, category.assoc],
-      dsimp,
-      rw [category.id_comp, ←F.map_comp],
-      refl, },
-    { ext,
-      dsimp [right_res, is_open_map.functor],
-      simp only [limit.lift_π, cones.postcompose_obj_π, iso.op_hom, discrete.nat_iso_hom_app,
-        functor.map_iso_refl, functor.map_iso_hom, lim_map_π_assoc, limit.lift_map, fan.mk_π_app,
-        nat_trans.comp_app, category.assoc],
-      dsimp,
-      rw [category.id_comp, ←F.map_comp],
-      refl, },
-    { simp, },
-  end.
+@[simps]
+def cone_equiv :
+  limits.cone ((diagram U).op ⋙ F) ≌ limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
+{ functor := cone_equiv_functor F U,
+  inverse := cone_equiv_inverse F U,
+  unit_iso := cone_equiv_unit_iso F U,
+  counit_iso := cone_equiv_counit_iso F U, }
+
+local attribute [reducible]
+  sheaf_condition_equalizer_products.res
+  sheaf_condition_equalizer_products.left_res
 
 /--
-If `F : presheaf C X` is a presheaf, and `oe : U ⟶ X` is an open embedding,
-then the sheaf condition fork for a cover `𝒰` in `U` for the composition of `oe` and `F` is
-isomorphic to sheaf condition fork for `oe '' 𝒰`, precomposed with the isomorphism
-of indexing diagrams `diagram.iso_of_open_embedding`.
-
-We use this to show that the restriction of sheaf along an open embedding is still a sheaf.
+If `sheaf_condition_equalizer_products.fork` is an equalizer,
+then `F.map_cone (cone U)` is a limit cone.
 -/
-def fork.iso_of_open_embedding :
-  fork (oe.is_open_map.functor.op ⋙ F) 𝒰 ≅
-    (cones.postcompose (diagram.iso_of_open_embedding oe 𝒰).inv).obj
-      (fork F (cover.of_open_embedding oe 𝒰)) :=
-begin
-  fapply fork.ext,
-  { dsimp [is_open_map.functor],
-    exact
-    F.map_iso (iso.op
-    { hom := hom_of_le
-      (by simp only [supr_s, supr_mk, le_def, subtype.coe_mk, set.le_eq_subset, set.image_Union]),
-      inv := hom_of_le
-      (by simp only [supr_s, supr_mk, le_def, subtype.coe_mk, set.le_eq_subset,
-                     set.image_Union]) }), },
-  { ext,
-    dunfold fork.ι, -- Ugh, it is unpleasant that we need this.
-    simp only [res, diagram.iso_of_open_embedding, discrete.nat_iso_inv_app, functor.map_iso_inv,
-      limit.lift_π, cones.postcompose_obj_π, functor.comp_map,
-      fork_π_app_walking_parallel_pair_zero, pi_opens.iso_of_open_embedding,
-      nat_iso.of_components.inv_app, functor.map_iso_refl, functor.op_map, limit.lift_map,
-      fan.mk_π_app, nat_trans.comp_app, quiver.hom.unop_op, category.assoc, lim_map_eq_lim_map],
-    dsimp,
-    rw [category.comp_id, ←F.map_comp],
-    refl, },
-end
+def is_limit_map_cone_of_is_limit_sheaf_condition_fork
+  (P : is_limit (sheaf_condition_equalizer_products.fork F U)) :
+  is_limit (F.map_cone (cocone U).op) :=
+is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U).symm).symm P)
+{ hom :=
+  { hom := 𝟙 _,
+    w' :=
+    begin
+      intro x,
+      induction x using opposite.rec,
+      rcases x with ⟨⟩,
+      { dsimp, simp, refl, },
+      { dsimp,
+        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
+          category.assoc],
+        rw ←F.map_comp,
+        refl, }
+    end },
+  inv :=
+  { hom := 𝟙 _,
+    w' :=
+    begin
+      intro x,
+      induction x using opposite.rec,
+      rcases x with ⟨⟩,
+      { dsimp, simp, refl, },
+      { dsimp,
+        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
+          category.assoc],
+        rw ←F.map_comp,
+        refl, }
+    end },
+  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
+  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }
 
-end open_embedding
+/--
+If `F.map_cone (cone U)` is a limit cone,
+then `sheaf_condition_equalizer_products.fork` is an equalizer.
+-/
+def is_limit_sheaf_condition_fork_of_is_limit_map_cone
+  (Q : is_limit (F.map_cone (cocone U).op)) :
+  is_limit (sheaf_condition_equalizer_products.fork F U) :=
+is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U)).symm Q)
+{ hom :=
+  { hom := 𝟙 _,
+    w' :=
+    begin
+      rintro ⟨⟩,
+      { dsimp, simp, refl, },
+      { dsimp, ext ⟨i, j⟩,
+        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
+          category.assoc],
+        rw ←F.map_comp,
+        refl, }
+    end },
+  inv :=
+  { hom := 𝟙 _,
+    w' :=
+    begin
+      rintro ⟨⟩,
+      { dsimp, simp, refl, },
+      { dsimp, ext ⟨i, j⟩,
+        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
+          category.assoc],
+        rw ←F.map_comp,
+        refl, }
+    end },
+  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
+  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }
+
+end sheaf_condition_pairwise_intersections
+
+open sheaf_condition_pairwise_intersections
 
-end sheaf_condition_equalizer_products
+/--
+The sheaf condition in terms of an equalizer diagram is equivalent
+to the default sheaf condition.
+-/
+lemma is_sheaf_iff_is_sheaf_equalizer_products (F : presheaf C X) :
+  F.is_sheaf ↔ F.is_sheaf_equalizer_products :=
+(is_sheaf_iff_is_sheaf_pairwise_intersections F).trans $
+iff.intro (λ h ι U, ⟨is_limit_sheaf_condition_fork_of_is_limit_map_cone F U (h U).some⟩)
+  (λ h ι U, ⟨is_limit_map_cone_of_is_limit_sheaf_condition_fork F U (h U).some⟩)
 
 end presheaf
 
diff --git a/src/topology/sheaves/sheaf_condition/opens_le_cover.lean b/src/topology/sheaves/sheaf_condition/opens_le_cover.lean
index 56b72565bbddd..c74bb17306eea 100644
--- a/src/topology/sheaves/sheaf_condition/opens_le_cover.lean
+++ b/src/topology/sheaves/sheaf_condition/opens_le_cover.lean
@@ -3,13 +3,14 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
-import topology.sheaves.presheaf
-import category_theory.limits.final
-import topology.sheaves.sheaf_condition.pairwise_intersections
+import topology.sheaves.sheaf_condition.sites
 
 /-!
 # Another version of the sheaf condition.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a family of open sets `U : ι → opens X` we can form the subcategory
 `{ V : opens X // ∃ i, V ≤ U i }`, which has `supr U` as a cocone.
 
@@ -21,24 +22,27 @@ because we don't need to do any case bashing
 (depending on whether we're looking at single or double intersections,
 or equivalently whether we're looking at the first or second object in an equalizer diagram).
 
+## Main statement
+
+`Top.presheaf.is_sheaf_iff_is_sheaf_opens_le_cover`: for a presheaf on a topological space,
+the sheaf condition in terms of Grothendieck topology is equivalent to the `opens_le_cover`
+sheaf condition. This result will be used to further connect to other sheaf conditions on spaces,
+like `pairwise_intersections` and `equalizer_products`.
+
 ## References
 * This is the definition Lurie uses in [Spectral Algebraic Geometry][LurieSAG].
 -/
 
-universes v u
+universes w v u
 
 noncomputable theory
 
-open category_theory
-open category_theory.limits
-open topological_space
-open opposite
-open topological_space.opens
+open category_theory category_theory.limits topological_space topological_space.opens opposite
 
 namespace Top
 
 variables {C : Type u} [category.{v} C]
-variables {X : Top.{v}} (F : presheaf C X) {ι : Type v} (U : ι → opens X)
+variables {X : Top.{w}} (F : presheaf C X) {ι : Type w} (U : ι → opens X)
 
 namespace presheaf
 
@@ -47,13 +51,12 @@ namespace sheaf_condition
 /--
 The category of open sets contained in some element of the cover.
 -/
-def opens_le_cover : Type v := { V : opens X // ∃ i, V ≤ U i }
+@[derive category]
+def opens_le_cover : Type w := full_subcategory (λ (V : opens X), ∃ i, V ≤ U i)
 
 instance [inhabited ι] : inhabited (opens_le_cover U) :=
 ⟨⟨⊥, default, bot_le⟩⟩
 
-instance : category (opens_le_cover U) := category_theory.full_subcategory _
-
 namespace opens_le_cover
 
 variables {U}
@@ -66,7 +69,7 @@ def index (V : opens_le_cover U) : ι := V.property.some
 /--
 The morphism from `V` to `U i` for some `i`.
 -/
-def hom_to_index (V : opens_le_cover U) : V.val ⟶ U (index V) :=
+def hom_to_index (V : opens_le_cover U) : V.obj ⟶ U (index V) :=
 (V.property.some_spec).hom
 
 end opens_le_cover
@@ -94,145 +97,7 @@ A presheaf is a sheaf if `F` sends the cone `(opens_le_cover_cocone U).op` to a
 mapping down to any `V` which is contained in some `U i`.)
 -/
 def is_sheaf_opens_le_cover : Prop :=
-∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (is_limit (F.map_cone (opens_le_cover_cocone U).op))
-
-namespace sheaf_condition
-
-open category_theory.pairwise
-
-/--
-Implementation detail:
-the object level of `pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U`
--/
-@[simp]
-def pairwise_to_opens_le_cover_obj : pairwise ι → opens_le_cover U
-| (single i) := ⟨U i, ⟨i, le_rfl⟩⟩
-| (pair i j) := ⟨U i ⊓ U j, ⟨i, inf_le_left⟩⟩
-
-open category_theory.pairwise.hom
-
-/--
-Implementation detail:
-the morphism level of `pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U`
--/
-def pairwise_to_opens_le_cover_map :
-  Π {V W : pairwise ι},
-    (V ⟶ W) → (pairwise_to_opens_le_cover_obj U V ⟶ pairwise_to_opens_le_cover_obj U W)
-| _ _ (id_single i) := 𝟙 _
-| _ _ (id_pair i j) := 𝟙 _
-| _ _ (left i j) := hom_of_le inf_le_left
-| _ _ (right i j) := hom_of_le inf_le_right
-
-/--
-The category of single and double intersections of the `U i` maps into the category
-of open sets below some `U i`.
--/
-@[simps]
-def pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U :=
-{ obj := pairwise_to_opens_le_cover_obj U,
-  map := λ V W i, pairwise_to_opens_le_cover_map U i, }
-
-instance (V : opens_le_cover U) :
-  nonempty (structured_arrow V (pairwise_to_opens_le_cover U)) :=
-⟨{ right := single (V.index), hom := V.hom_to_index }⟩
-
-/--
-The diagram consisting of the `U i` and `U i ⊓ U j` is cofinal in the diagram
-of all opens contained in some `U i`.
--/
--- This is a case bash: for each pair of types of objects in `pairwise ι`,
--- we have to explicitly construct a zigzag.
-instance : functor.final (pairwise_to_opens_le_cover U) :=
-⟨λ V, is_connected_of_zigzag $ λ A B, begin
-  rcases A with ⟨⟨⟩, ⟨i⟩|⟨i,j⟩, a⟩;
-  rcases B with ⟨⟨⟩, ⟨i'⟩|⟨i',j'⟩, b⟩;
-  dsimp at *,
-  { refine ⟨[
-    { left := punit.star, right := pair i i',
-      hom := (le_inf a.le b.le).hom, }, _], _, rfl⟩,
-    exact
-      list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
-        (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩) list.chain.nil) },
-  { refine ⟨[
-    { left := punit.star, right := pair i' i,
-      hom := (le_inf (b.le.trans inf_le_left) a.le).hom, },
-    { left := punit.star, right := single i',
-      hom := (b.le.trans inf_le_left).hom, }, _], _, rfl⟩,
-    exact
-      list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := right i' i, }⟩)
-        (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i' i, }⟩)
-          (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i' j', }⟩) list.chain.nil)) },
-  { refine ⟨[
-    { left := punit.star, right := single i,
-      hom := (a.le.trans inf_le_left).hom, },
-    { left := punit.star, right := pair i i', hom :=
-      (le_inf (a.le.trans inf_le_left) b.le).hom, }, _], _, rfl⟩,
-    exact
-      list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i j, }⟩)
-        (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
-          (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩) list.chain.nil)) },
-  { refine ⟨[
-    { left := punit.star, right := single i,
-      hom := (a.le.trans inf_le_left).hom, },
-    { left := punit.star, right := pair i i',
-      hom := (le_inf (a.le.trans inf_le_left) (b.le.trans inf_le_left)).hom, },
-    { left := punit.star, right := single i',
-      hom := (b.le.trans inf_le_left).hom, }, _], _, rfl⟩,
-    exact
-      list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i j, }⟩)
-      (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
-      (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩)
-      (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i' j', }⟩) list.chain.nil))), },
-end⟩
-
-/--
-The diagram in `opens X` indexed by pairwise intersections from `U` is isomorphic
-(in fact, equal) to the diagram factored through `opens_le_cover U`.
--/
-def pairwise_diagram_iso :
-  pairwise.diagram U ≅
-  pairwise_to_opens_le_cover U ⋙ full_subcategory_inclusion _ :=
-{ hom := { app := begin rintro (i|⟨i,j⟩); exact 𝟙 _, end, },
-  inv := { app := begin rintro (i|⟨i,j⟩); exact 𝟙 _, end, }, }
-
-/--
-The cocone `pairwise.cocone U` with cocone point `supr U` over `pairwise.diagram U` is isomorphic
-to the cocone `opens_le_cover_cocone U` (with the same cocone point)
-after appropriate whiskering and postcomposition.
--/
-def pairwise_cocone_iso :
-  (pairwise.cocone U).op ≅
-  (cones.postcompose_equivalence (nat_iso.op (pairwise_diagram_iso U : _) : _)).functor.obj
-    ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op) :=
-cones.ext (iso.refl _) (by tidy)
-
-end sheaf_condition
-
-open sheaf_condition
-
-/--
-The sheaf condition
-in terms of a limit diagram over all `{ V : opens X // ∃ i, V ≤ U i }`
-is equivalent to the reformulation
-in terms of a limit diagram over `U i` and `U i ⊓ U j`.
--/
-lemma is_sheaf_opens_le_cover_iff_is_sheaf_pairwise_intersections (F : presheaf C X) :
-  F.is_sheaf_opens_le_cover ↔ F.is_sheaf_pairwise_intersections :=
-forall₂_congr $ λ ι U, equiv.nonempty_congr $
-  calc is_limit (F.map_cone (opens_le_cover_cocone U).op)
-    ≃ is_limit ((F.map_cone (opens_le_cover_cocone U).op).whisker (pairwise_to_opens_le_cover U).op)
-        : (functor.initial.is_limit_whisker_equiv (pairwise_to_opens_le_cover U).op _).symm
-... ≃ is_limit (F.map_cone ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op))
-        : is_limit.equiv_iso_limit F.map_cone_whisker.symm
-... ≃ is_limit ((cones.postcompose_equivalence _).functor.obj
-          (F.map_cone ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op)))
-        : (is_limit.postcompose_hom_equiv _ _).symm
-... ≃ is_limit (F.map_cone ((cones.postcompose_equivalence _).functor.obj
-          ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op)))
-        : is_limit.equiv_iso_limit (functor.map_cone_postcompose_equivalence_functor _).symm
-... ≃ is_limit (F.map_cone (pairwise.cocone U).op)
-        : is_limit.equiv_iso_limit
-            ((cones.functoriality _ _).map_iso (pairwise_cocone_iso U : _).symm)
+∀ ⦃ι : Type w⦄ (U : ι → opens X), nonempty (is_limit (F.map_cone (opens_le_cover_cocone U).op))
 
 section
 
@@ -244,7 +109,7 @@ variables {Y : opens X} (hY : Y = supr U)
     in the sieve. This full subcategory is equivalent to `opens_le_cover U`, the (poset)
     category of opens contained in some `U i`. -/
 @[simps] def generate_equivalence_opens_le :
-  {f : over Y // (sieve.generate (presieve_of_covering_aux U Y)).arrows f.hom} ≌
+  full_subcategory (λ (f : over Y), (sieve.generate (presieve_of_covering_aux U Y)).arrows f.hom) ≌
   opens_le_cover U :=
 { functor :=
   { obj := λ f, ⟨f.1.left, let ⟨_,h,_,⟨i,hY⟩,_⟩ := f.2 in ⟨i, hY ▸ h.le⟩⟩,
@@ -262,17 +127,16 @@ variables {Y : opens X} (hY : Y = supr U)
     associated to the sieve generated by the presieve associated to `U` with indexing
     category changed using the above equivalence. -/
 @[simps] def whisker_iso_map_generate_cocone :
-  cone.whisker (generate_equivalence_opens_le U hY).op.functor
-    (F.map_cone (opens_le_cover_cocone U).op) ≅
-  F.map_cone (sieve.generate (presieve_of_covering_aux U Y)).arrows.cocone.op :=
+  (F.map_cone (opens_le_cover_cocone U).op).whisker (generate_equivalence_opens_le U hY).op.functor
+    ≅ F.map_cone (sieve.generate (presieve_of_covering_aux U Y)).arrows.cocone.op :=
 { hom :=
   { hom := F.map (eq_to_hom (congr_arg op hY.symm)),
     w' := λ j, by { erw ← F.map_comp, congr } },
   inv :=
   { hom := F.map (eq_to_hom (congr_arg op hY)),
     w' := λ j, by { erw ← F.map_comp, congr } },
-  hom_inv_id' := by { ext, simp },
-  inv_hom_id' := by { ext, simp } }
+  hom_inv_id' := by { ext, simp [eq_to_hom_map], },
+  inv_hom_id' := by { ext, simp [eq_to_hom_map], } }
 
 /-- Given a presheaf `F` on the topological space `X` and a family of opens `U` of `X`,
     the natural cone associated to `F` and `U` used in the definition of
@@ -305,10 +169,11 @@ end
     it satisfies the `is_sheaf_opens_le_cover` sheaf condition. The latter is not the
     official definition of sheaves on spaces, but has the advantage that it does not
     require `has_products C`. -/
-lemma is_sheaf_sites_iff_is_sheaf_opens_le_cover :
-  category_theory.presheaf.is_sheaf (opens.grothendieck_topology X) F ↔ F.is_sheaf_opens_le_cover :=
+lemma is_sheaf_iff_is_sheaf_opens_le_cover :
+  F.is_sheaf ↔ F.is_sheaf_opens_le_cover :=
 begin
-  rw presheaf.is_sheaf_iff_is_limit, split,
+  refine (presheaf.is_sheaf_iff_is_limit _ _).trans _,
+  split,
   { intros h ι U, rw (is_limit_opens_le_equiv_generate₁ F U rfl).nonempty_congr,
     apply h, apply presieve_of_covering.mem_grothendieck_topology },
   { intros h Y S, rw ← sieve.generate_sieve S, intro hS,
@@ -317,18 +182,6 @@ end
 
 end
 
-variable [has_products C]
-
-/--
-The sheaf condition in terms of an equalizer diagram is equivalent
-to the reformulation in terms of a limit diagram over all `{ V : opens X // ∃ i, V ≤ U i }`.
--/
-lemma is_sheaf_iff_is_sheaf_opens_le_cover (F : presheaf C X) :
-  F.is_sheaf ↔ F.is_sheaf_opens_le_cover :=
-iff.trans
-  (is_sheaf_iff_is_sheaf_pairwise_intersections F)
-  (is_sheaf_opens_le_cover_iff_is_sheaf_pairwise_intersections F).symm
-
 end presheaf
 
 end Top
diff --git a/src/topology/sheaves/sheaf_condition/pairwise_intersections.lean b/src/topology/sheaves/sheaf_condition/pairwise_intersections.lean
index 3e3af1f912d78..93c0cf1430110 100644
--- a/src/topology/sheaves/sheaf_condition/pairwise_intersections.lean
+++ b/src/topology/sheaves/sheaf_condition/pairwise_intersections.lean
@@ -4,14 +4,19 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 
-import topology.sheaves.sheaf_condition.sites
+import topology.sheaves.sheaf_condition.opens_le_cover
+import category_theory.limits.final
 import category_theory.limits.preserves.basic
 import category_theory.category.pairwise
 import category_theory.limits.constructions.binary_products
+import algebra.category.Ring.constructions
 
 /-!
 # Equivalent formulations of the sheaf condition
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We give an equivalent formulation of the sheaf condition.
 
 Given any indexed type `ι`, we define `overlap ι`,
@@ -29,23 +34,22 @@ A presheaf `F : presheaf C X` is a sheaf precisely if it preserves this limit.
 We express this in two equivalent ways, as
 * `is_limit (F.map_cone (cone U))`, or
 * `preserves_limit (diagram U) F`
+
+We show that this sheaf condition is equivalent to the `opens_le_cover` sheaf condition, and
+thereby also equivalent to the default sheaf condition.
 -/
 
 noncomputable theory
 
-universes v u
+universes w v u
 
-open topological_space
-open Top
-open opposite
-open category_theory
-open category_theory.limits
+open topological_space Top opposite category_theory category_theory.limits
 
-namespace Top.presheaf
+variables {C : Type u} [category.{v} C] {X : Top.{w}}
 
-variables {X : Top.{v}}
+namespace Top.presheaf
 
-variables {C : Type u} [category.{v} C]
+section
 
 /--
 An alternative formulation of the sheaf condition
@@ -56,7 +60,7 @@ A presheaf is a sheaf if `F` sends the cone `(pairwise.cocone U).op` to a limit
 (Recall `pairwise.cocone U` has cone point `supr U`, mapping down to the `U i` and the `U i ⊓ U j`.)
 -/
 def is_sheaf_pairwise_intersections (F : presheaf C X) : Prop :=
-∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (is_limit (F.map_cone (pairwise.cocone U).op))
+∀ ⦃ι : Type w⦄ (U : ι → opens X), nonempty (is_limit (F.map_cone (pairwise.cocone U).op))
 
 /--
 An alternative formulation of the sheaf condition
@@ -68,316 +72,167 @@ A presheaf is a sheaf if `F` preserves the limit of `pairwise.diagram U`.
 `U i ⊓ U j` mapping into the open sets `U i`. This diagram has limit `supr U`.)
 -/
 def is_sheaf_preserves_limit_pairwise_intersections (F : presheaf C X) : Prop :=
-∀ ⦃ι : Type v⦄ (U : ι → opens X), nonempty (preserves_limit (pairwise.diagram U).op F)
-
-/-!
-The remainder of this file shows that these conditions are equivalent
-to the usual sheaf condition.
--/
+∀ ⦃ι : Type w⦄ (U : ι → opens X), nonempty (preserves_limit (pairwise.diagram U).op F)
 
-variables [has_products C]
+end
 
-namespace sheaf_condition_pairwise_intersections
+namespace sheaf_condition
 
-open category_theory.pairwise category_theory.pairwise.hom
-open sheaf_condition_equalizer_products
+variables {ι : Type w} (U : ι → opens X)
 
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
-@[simps]
-def cone_equiv_functor_obj (F : presheaf C X)
-  ⦃ι : Type v⦄ (U : ι → opens ↥X) (c : limits.cone ((diagram U).op ⋙ F)) :
-  limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
-{ X := c.X,
-  π :=
-  { app := λ Z,
-      walking_parallel_pair.cases_on Z
-        (pi.lift (λ (i : ι), c.π.app (op (single i))))
-        (pi.lift (λ (b : ι × ι), c.π.app (op (pair b.1 b.2)))),
-    naturality' := λ Y Z f,
-    begin
-      cases Y; cases Z; cases f,
-      { ext i, dsimp,
-        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
-          category.assoc],
-        dsimp,
-        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
-      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.left_res],
-        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
-          category.assoc],
-        have h := c.π.naturality (quiver.hom.op (hom.left i j)),
-        dsimp at h,
-        simpa using h, },
-      { ext ⟨i, j⟩, dsimp [sheaf_condition_equalizer_products.right_res],
-        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
-          category.assoc],
-        have h := c.π.naturality (quiver.hom.op (hom.right i j)),
-        dsimp at h,
-        simpa using h, },
-      { ext i, dsimp,
-        simp only [limit.lift_π, category.id_comp, fan.mk_π_app, category_theory.functor.map_id,
-          category.assoc],
-        dsimp,
-        simp only [limit.lift_π, category.id_comp, fan.mk_π_app], },
-    end, }, }
+open category_theory.pairwise
 
-section
-local attribute [tidy] tactic.case_bash
+/--
+Implementation detail:
+the object level of `pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U`
+-/
+@[simp]
+def pairwise_to_opens_le_cover_obj : pairwise ι → opens_le_cover U
+| (single i) := ⟨U i, ⟨i, le_rfl⟩⟩
+| (pair i j) := ⟨U i ⊓ U j, ⟨i, inf_le_left⟩⟩
 
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
-@[simps]
-def cone_equiv_functor (F : presheaf C X)
-  ⦃ι : Type v⦄ (U : ι → opens ↥X) :
-  limits.cone ((diagram U).op ⋙ F) ⥤
-    limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
-{ obj := λ c, cone_equiv_functor_obj F U c,
-  map := λ c c' f,
-  { hom := f.hom,
-    w' := λ j, begin
-      cases j;
-      { ext, simp only [limits.fan.mk_π_app, limits.cone_morphism.w,
-        limits.limit.lift_π, category.assoc, cone_equiv_functor_obj_π_app], },
-    end }, }.
+open category_theory.pairwise.hom
 
-end
+/--
+Implementation detail:
+the morphism level of `pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U`
+-/
+def pairwise_to_opens_le_cover_map :
+  Π {V W : pairwise ι},
+    (V ⟶ W) → (pairwise_to_opens_le_cover_obj U V ⟶ pairwise_to_opens_le_cover_obj U W)
+| _ _ (id_single i) := 𝟙 _
+| _ _ (id_pair i j) := 𝟙 _
+| _ _ (left i j) := hom_of_le inf_le_left
+| _ _ (right i j) := hom_of_le inf_le_right
 
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
-@[simps]
-def cone_equiv_inverse_obj (F : presheaf C X)
-  ⦃ι : Type v⦄ (U : ι → opens ↥X)
-  (c : limits.cone (sheaf_condition_equalizer_products.diagram F U)) :
-  limits.cone ((diagram U).op ⋙ F) :=
-{ X := c.X,
-  π :=
-  { app :=
-    begin
-      intro x,
-      induction x using opposite.rec,
-      rcases x with (⟨i⟩|⟨i,j⟩),
-      { exact c.π.app (walking_parallel_pair.zero) ≫ pi.π _ i, },
-      { exact c.π.app (walking_parallel_pair.one) ≫ pi.π _ (i, j), }
-    end,
-    naturality' :=
-    begin
-      intros x y f,
-      induction x using opposite.rec,
-      induction y using opposite.rec,
-      have ef : f = f.unop.op := rfl,
-      revert ef,
-      generalize : f.unop = f',
-      rintro rfl,
-      rcases x with ⟨i⟩|⟨⟩; rcases y with ⟨⟩|⟨j,j⟩; rcases f' with ⟨⟩,
-      { dsimp, erw [F.map_id], simp, },
-      { dsimp, simp only [category.id_comp, category.assoc],
-        have h := c.π.naturality (walking_parallel_pair_hom.left),
-        dsimp [sheaf_condition_equalizer_products.left_res] at h,
-        simp only [category.id_comp] at h,
-        have h' := h =≫ pi.π _ (i, j),
-        rw h',
-        simp only [category.assoc, limit.lift_π, fan.mk_π_app],
-        refl, },
-      { dsimp, simp only [category.id_comp, category.assoc],
-        have h := c.π.naturality (walking_parallel_pair_hom.right),
-        dsimp [sheaf_condition_equalizer_products.right_res] at h,
-        simp only [category.id_comp] at h,
-        have h' := h =≫ pi.π _ (j, i),
-        rw h',
-        simp,
-        refl, },
-      { dsimp, erw [F.map_id], simp, },
-    end, }, }
-
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
-@[simps]
-def cone_equiv_inverse (F : presheaf C X)
-  ⦃ι : Type v⦄ (U : ι → opens ↥X) :
-  limits.cone (sheaf_condition_equalizer_products.diagram F U) ⥤
-    limits.cone ((diagram U).op ⋙ F) :=
-{ obj := λ c, cone_equiv_inverse_obj F U c,
-  map := λ c c' f,
-  { hom := f.hom,
-    w' :=
-    begin
-      intro x,
-      induction x using opposite.rec,
-      rcases x with (⟨i⟩|⟨i,j⟩),
-      { dsimp,
-        dunfold fork.ι,
-        rw [←(f.w walking_parallel_pair.zero), category.assoc], },
-      { dsimp,
-        rw [←(f.w walking_parallel_pair.one), category.assoc], },
-    end }, }.
-
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
-@[simps]
-def cone_equiv_unit_iso_app (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens ↥X)
-  (c : cone ((diagram U).op ⋙ F)) :
-  (𝟭 (cone ((diagram U).op ⋙ F))).obj c ≅
-    (cone_equiv_functor F U ⋙ cone_equiv_inverse F U).obj c :=
-{ hom :=
-  { hom := 𝟙 _,
-    w' := λ j, begin
-      induction j using opposite.rec, rcases j;
-      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
-    end, },
-  inv :=
-  { hom := 𝟙 _,
-    w' := λ j, begin
-      induction j using opposite.rec, rcases j;
-      { dsimp, simp only [limits.fan.mk_π_app, category.id_comp, limits.limit.lift_π], }
-    end },
-  hom_inv_id' := begin
-    ext,
-    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
-  end,
-  inv_hom_id' := begin
-    ext,
-    simp only [category.comp_id, limits.cone.category_comp_hom, limits.cone.category_id_hom],
-  end, }
-
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
+/--
+The category of single and double intersections of the `U i` maps into the category
+of open sets below some `U i`.
+-/
 @[simps]
-def cone_equiv_unit_iso (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X) :
-  𝟭 (limits.cone ((diagram U).op ⋙ F)) ≅
-    cone_equiv_functor F U ⋙ cone_equiv_inverse F U :=
-nat_iso.of_components (cone_equiv_unit_iso_app F U) (by tidy)
+def pairwise_to_opens_le_cover : pairwise ι ⥤ opens_le_cover U :=
+{ obj := pairwise_to_opens_le_cover_obj U,
+  map := λ V W i, pairwise_to_opens_le_cover_map U i, }
 
-/-- Implementation of `sheaf_condition_pairwise_intersections.cone_equiv`. -/
-@[simps]
-def cone_equiv_counit_iso (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X) :
-  cone_equiv_inverse F U ⋙ cone_equiv_functor F U ≅
-    𝟭 (limits.cone (sheaf_condition_equalizer_products.diagram F U)) :=
-nat_iso.of_components (λ c,
-{ hom :=
-  { hom := 𝟙 _,
-    w' :=
-    begin
-      rintro ⟨_|_⟩,
-      { ext, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
-      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
-    end },
-  inv :=
-  { hom := 𝟙 _,
-    w' :=
-    begin
-      rintro ⟨_|_⟩,
-      { ext, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
-      { ext ⟨i,j⟩, dsimp, simp only [category.id_comp, limits.fan.mk_π_app, limits.limit.lift_π], },
-    end, },
-  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
-  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, })
-(λ c d f, by { ext, dsimp, simp only [category.comp_id, category.id_comp], })
+instance (V : opens_le_cover U) :
+  nonempty (structured_arrow V (pairwise_to_opens_le_cover U)) :=
+⟨@structured_arrow.mk _ _ _ _ _ (single (V.index)) _ (by exact V.hom_to_index)⟩
 
 /--
-Cones over `diagram U ⋙ F` are the same as a cones over the usual sheaf condition equalizer diagram.
+The diagram consisting of the `U i` and `U i ⊓ U j` is cofinal in the diagram
+of all opens contained in some `U i`.
 -/
-@[simps]
-def cone_equiv (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X) :
-  limits.cone ((diagram U).op ⋙ F) ≌ limits.cone (sheaf_condition_equalizer_products.diagram F U) :=
-{ functor := cone_equiv_functor F U,
-  inverse := cone_equiv_inverse F U,
-  unit_iso := cone_equiv_unit_iso F U,
-  counit_iso := cone_equiv_counit_iso F U, }
+-- This is a case bash: for each pair of types of objects in `pairwise ι`,
+-- we have to explicitly construct a zigzag.
+instance : functor.final (pairwise_to_opens_le_cover U) :=
+⟨λ V, is_connected_of_zigzag $ λ A B, begin
+  rcases A with ⟨⟨⟨⟩⟩, ⟨i⟩|⟨i,j⟩, a⟩;
+  rcases B with ⟨⟨⟨⟩⟩, ⟨i'⟩|⟨i',j'⟩, b⟩;
+  dsimp at *,
+  { refine ⟨[
+    { left := ⟨⟨⟩⟩, right := pair i i',
+      hom := (le_inf a.le b.le).hom, }, _], _, rfl⟩,
+    exact
+      list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
+        (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩) list.chain.nil) },
+  { refine ⟨[
+    { left := ⟨⟨⟩⟩, right := pair i' i,
+      hom := (le_inf (b.le.trans inf_le_left) a.le).hom, },
+    { left := ⟨⟨⟩⟩, right := single i',
+      hom := (b.le.trans inf_le_left).hom, }, _], _, rfl⟩,
+    exact
+      list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := right i' i, }⟩)
+        (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i' i, }⟩)
+          (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i' j', }⟩) list.chain.nil)) },
+  { refine ⟨[
+    { left := ⟨⟨⟩⟩, right := single i,
+      hom := (a.le.trans inf_le_left).hom, },
+    { left := ⟨⟨⟩⟩, right := pair i i', hom :=
+      (le_inf (a.le.trans inf_le_left) b.le).hom, }, _], _, rfl⟩,
+    exact
+      list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i j, }⟩)
+        (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
+          (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩) list.chain.nil)) },
+  { refine ⟨[
+    { left := ⟨⟨⟩⟩, right := single i,
+      hom := (a.le.trans inf_le_left).hom, },
+    { left := ⟨⟨⟩⟩, right := pair i i',
+      hom := (le_inf (a.le.trans inf_le_left) (b.le.trans inf_le_left)).hom, },
+    { left := ⟨⟨⟩⟩, right := single i',
+      hom := (b.le.trans inf_le_left).hom, }, _], _, rfl⟩,
+    exact
+      list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := left i j, }⟩)
+      (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i i', }⟩)
+      (list.chain.cons (or.inl ⟨{ left := 𝟙 _, right := right i i', }⟩)
+      (list.chain.cons (or.inr ⟨{ left := 𝟙 _, right := left i' j', }⟩) list.chain.nil))), },
+end⟩
 
-local attribute [reducible]
-  sheaf_condition_equalizer_products.res
-  sheaf_condition_equalizer_products.left_res
+/--
+The diagram in `opens X` indexed by pairwise intersections from `U` is isomorphic
+(in fact, equal) to the diagram factored through `opens_le_cover U`.
+-/
+def pairwise_diagram_iso :
+  pairwise.diagram U ≅
+  pairwise_to_opens_le_cover U ⋙ full_subcategory_inclusion _ :=
+{ hom := { app := begin rintro (i|⟨i,j⟩); exact 𝟙 _, end, },
+  inv := { app := begin rintro (i|⟨i,j⟩); exact 𝟙 _, end, }, }
 
 /--
-If `sheaf_condition_equalizer_products.fork` is an equalizer,
-then `F.map_cone (cone U)` is a limit cone.
+The cocone `pairwise.cocone U` with cocone point `supr U` over `pairwise.diagram U` is isomorphic
+to the cocone `opens_le_cover_cocone U` (with the same cocone point)
+after appropriate whiskering and postcomposition.
 -/
-def is_limit_map_cone_of_is_limit_sheaf_condition_fork
-  (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X)
-  (P : is_limit (sheaf_condition_equalizer_products.fork F U)) :
-  is_limit (F.map_cone (cocone U).op) :=
-is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U).symm).symm P)
-{ hom :=
-  { hom := 𝟙 _,
-    w' :=
-    begin
-      intro x,
-      induction x using opposite.rec,
-      rcases x with ⟨⟩,
-      { dsimp, simp, refl, },
-      { dsimp,
-        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
-          category.assoc],
-        rw ←F.map_comp,
-        refl, }
-    end },
-  inv :=
-  { hom := 𝟙 _,
-    w' :=
-    begin
-      intro x,
-      induction x using opposite.rec,
-      rcases x with ⟨⟩,
-      { dsimp, simp, refl, },
-      { dsimp,
-        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
-          category.assoc],
-        rw ←F.map_comp,
-        refl, }
-    end },
-  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
-  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }
+def pairwise_cocone_iso :
+  (pairwise.cocone U).op ≅
+  (cones.postcompose_equivalence (nat_iso.op (pairwise_diagram_iso U : _) : _)).functor.obj
+    ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op) :=
+cones.ext (iso.refl _) (by tidy)
+
+end sheaf_condition
+
+open sheaf_condition
+
+variable (F : presheaf C X)
 
 /--
-If `F.map_cone (cone U)` is a limit cone,
-then `sheaf_condition_equalizer_products.fork` is an equalizer.
+The sheaf condition
+in terms of a limit diagram over all `{ V : opens X // ∃ i, V ≤ U i }`
+is equivalent to the reformulation
+in terms of a limit diagram over `U i` and `U i ⊓ U j`.
 -/
-def is_limit_sheaf_condition_fork_of_is_limit_map_cone
-  (F : presheaf C X) ⦃ι : Type v⦄ (U : ι → opens X)
-  (Q : is_limit (F.map_cone (cocone U).op)) :
-  is_limit (sheaf_condition_equalizer_products.fork F U) :=
-is_limit.of_iso_limit ((is_limit.of_cone_equiv (cone_equiv F U)).symm Q)
-{ hom :=
-  { hom := 𝟙 _,
-    w' :=
-    begin
-      rintro ⟨⟩,
-      { dsimp, simp, refl, },
-      { dsimp, ext ⟨i, j⟩,
-        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
-          category.assoc],
-        rw ←F.map_comp,
-        refl, }
-    end },
-  inv :=
-  { hom := 𝟙 _,
-    w' :=
-    begin
-      rintro ⟨⟩,
-      { dsimp, simp, refl, },
-      { dsimp, ext ⟨i, j⟩,
-        simp only [limit.lift_π, limit.lift_π_assoc, category.id_comp, fan.mk_π_app,
-          category.assoc],
-        rw ←F.map_comp,
-        refl, }
-    end },
-  hom_inv_id' := by { ext, dsimp, simp only [category.comp_id], },
-  inv_hom_id' := by { ext, dsimp, simp only [category.comp_id], }, }
-
-
-end sheaf_condition_pairwise_intersections
-
-open sheaf_condition_pairwise_intersections
+lemma is_sheaf_opens_le_cover_iff_is_sheaf_pairwise_intersections :
+  F.is_sheaf_opens_le_cover ↔ F.is_sheaf_pairwise_intersections :=
+forall₂_congr $ λ ι U, equiv.nonempty_congr $
+  calc is_limit (F.map_cone (opens_le_cover_cocone U).op)
+    ≃ is_limit ((F.map_cone (opens_le_cover_cocone U).op).whisker (pairwise_to_opens_le_cover U).op)
+        : (functor.initial.is_limit_whisker_equiv (pairwise_to_opens_le_cover U).op _).symm
+... ≃ is_limit (F.map_cone ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op))
+        : is_limit.equiv_iso_limit F.map_cone_whisker.symm
+... ≃ is_limit ((cones.postcompose_equivalence _).functor.obj
+          (F.map_cone ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op)))
+        : (is_limit.postcompose_hom_equiv _ _).symm
+... ≃ is_limit (F.map_cone ((cones.postcompose_equivalence _).functor.obj
+          ((opens_le_cover_cocone U).op.whisker (pairwise_to_opens_le_cover U).op)))
+        : is_limit.equiv_iso_limit (functor.map_cone_postcompose_equivalence_functor _).symm
+... ≃ is_limit (F.map_cone (pairwise.cocone U).op)
+        : is_limit.equiv_iso_limit
+            ((cones.functoriality _ _).map_iso (pairwise_cocone_iso U : _).symm)
 
 /--
 The sheaf condition in terms of an equalizer diagram is equivalent
 to the reformulation in terms of a limit diagram over `U i` and `U i ⊓ U j`.
 -/
-lemma is_sheaf_iff_is_sheaf_pairwise_intersections (F : presheaf C X) :
+lemma is_sheaf_iff_is_sheaf_pairwise_intersections :
   F.is_sheaf ↔ F.is_sheaf_pairwise_intersections :=
-iff.intro (λ h ι U, ⟨is_limit_map_cone_of_is_limit_sheaf_condition_fork F U (h U).some⟩)
-  (λ h ι U, ⟨is_limit_sheaf_condition_fork_of_is_limit_map_cone F U (h U).some⟩)
+by rw [is_sheaf_iff_is_sheaf_opens_le_cover,
+  is_sheaf_opens_le_cover_iff_is_sheaf_pairwise_intersections]
 
 /--
 The sheaf condition in terms of an equalizer diagram is equivalent
 to the reformulation in terms of the presheaf preserving the limit of the diagram
 consisting of the `U i` and `U i ⊓ U j`.
 -/
-lemma is_sheaf_iff_is_sheaf_preserves_limit_pairwise_intersections (F : presheaf C X) :
+lemma is_sheaf_iff_is_sheaf_preserves_limit_pairwise_intersections :
   F.is_sheaf ↔ F.is_sheaf_preserves_limit_pairwise_intersections :=
 begin
   rw is_sheaf_iff_is_sheaf_pairwise_intersections,
@@ -393,38 +248,41 @@ end Top.presheaf
 
 namespace Top.sheaf
 
-variables {X : Top.{v}} {C : Type u} [category.{v} C] [has_products C]
 variables (F : X.sheaf C) (U V : opens X)
 open category_theory.limits
 
-/-- For a sheaf `F`, `F(U ∪ V)` is the pullback of `F(U) ⟶ F(U ∩ V)` and `F(V) ⟶ F(U ∩ V)`.
+/-- For a sheaf `F`, `F(U ⊔ V)` is the pullback of `F(U) ⟶ F(U ⊓ V)` and `F(V) ⟶ F(U ⊓ V)`.
 This is the pullback cone. -/
 def inter_union_pullback_cone : pullback_cone
-  (F.1.map (hom_of_le inf_le_left : U ∩ V ⟶ _).op) (F.1.map (hom_of_le inf_le_right).op) :=
+  (F.1.map (hom_of_le inf_le_left : U ⊓ V ⟶ _).op) (F.1.map (hom_of_le inf_le_right).op) :=
 pullback_cone.mk (F.1.map (hom_of_le le_sup_left).op) (F.1.map (hom_of_le le_sup_right).op)
   (by { rw [← F.1.map_comp, ← F.1.map_comp], congr })
 
 @[simp] lemma inter_union_pullback_cone_X :
-  (inter_union_pullback_cone F U V).X = F.1.obj (op $ U ∪ V) := rfl
+  (inter_union_pullback_cone F U V).X = F.1.obj (op $ U ⊔ V) := rfl
 @[simp] lemma inter_union_pullback_cone_fst :
   (inter_union_pullback_cone F U V).fst = F.1.map (hom_of_le le_sup_left).op := rfl
 @[simp] lemma inter_union_pullback_cone_snd :
   (inter_union_pullback_cone F U V).snd = F.1.map (hom_of_le le_sup_right).op := rfl
 
 variable (s : pullback_cone
-  (F.1.map (hom_of_le inf_le_left : U ∩ V ⟶ _).op) (F.1.map (hom_of_le inf_le_right).op))
+  (F.1.map (hom_of_le inf_le_left : U ⊓ V ⟶ _).op) (F.1.map (hom_of_le inf_le_right).op))
 
 /-- (Implementation).
-Every cone over `F(U) ⟶ F(U ∩ V)` and `F(V) ⟶ F(U ∩ V)` factors through `F(U ∪ V)`. -/
-def inter_union_pullback_cone_lift : s.X ⟶ F.1.obj (op (U ∪ V)) :=
+Every cone over `F(U) ⟶ F(U ⊓ V)` and `F(V) ⟶ F(U ⊓ V)` factors through `F(U ⊔ V)`.
+-/
+def inter_union_pullback_cone_lift : s.X ⟶ F.1.obj (op (U ⊔ V)) :=
 begin
-  let ι : walking_pair → opens X := λ j, walking_pair.cases_on j U V,
-  have hι : U ∪ V = supr ι,
-  { ext, split,
+  let ι : ulift.{w} walking_pair → opens X := λ j, walking_pair.cases_on j.down U V,
+  have hι : U ⊔ V = supr ι,
+  { ext,
+    rw [opens.coe_supr, set.mem_Union],
+    split,
     { rintros (h|h),
-    exacts [⟨_,⟨_,⟨walking_pair.left,rfl⟩,rfl⟩,h⟩, ⟨_,⟨_,⟨walking_pair.right,rfl⟩,rfl⟩,h⟩] },
-    { rintros ⟨_,⟨_,⟨⟨⟩,⟨⟩⟩,⟨⟩⟩,z⟩, exacts [or.inl z, or.inr z] } },
-  refine (F.1.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 ι).some.lift
+      exacts [⟨⟨walking_pair.left⟩, h⟩, ⟨⟨walking_pair.right⟩, h⟩] },
+    { rintro ⟨⟨_ | _⟩, h⟩,
+      exacts [or.inl h, or.inr h] } },
+  refine (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 ι).some.lift
     ⟨s.X, { app := _, naturality' := _ }⟩ ≫ F.1.map (eq_to_hom hι).op,
   { apply opposite.rec,
     rintro ((_|_)|(_|_)),
@@ -434,40 +292,42 @@ begin
   induction i using opposite.rec,
   induction j using opposite.rec,
   let g : j ⟶ i := f.unop, have : f = g.op := rfl, clear_value g, subst this,
-  rcases i with ((_|_)|(_|_)); rcases j with ((_|_)|(_|_)); rcases g; dsimp;
+  rcases i with (⟨⟨(_|_)⟩⟩|⟨⟨(_|_)⟩,⟨_⟩⟩); rcases j with (⟨⟨(_|_)⟩⟩|⟨⟨(_|_)⟩,⟨_⟩⟩); rcases g; dsimp;
     simp only [category.id_comp, s.condition, category_theory.functor.map_id, category.comp_id],
-  { rw [← cancel_mono (F.1.map (eq_to_hom $ inf_comm : U ∩ V ⟶ _).op), category.assoc,
+  { rw [← cancel_mono (F.1.map (eq_to_hom $ inf_comm : U ⊓ V ⟶ _).op), category.assoc,
       category.assoc],
     erw [← F.1.map_comp, ← F.1.map_comp],
     convert s.condition.symm },
-  { convert s.condition }
 end
 
 lemma inter_union_pullback_cone_lift_left :
   inter_union_pullback_cone_lift F U V s ≫ F.1.map (hom_of_le le_sup_left).op = s.fst :=
 begin
   erw [category.assoc, ←F.1.map_comp],
-  exact (F.1.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 _).some.fac _
-    (op $ pairwise.single walking_pair.left)
+  exact (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 _).some.fac _
+    (op $ pairwise.single (ulift.up walking_pair.left))
 end
 
 lemma inter_union_pullback_cone_lift_right :
   inter_union_pullback_cone_lift F U V s ≫ F.1.map (hom_of_le le_sup_right).op = s.snd :=
 begin
   erw [category.assoc, ←F.1.map_comp],
-  exact (F.1.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 _).some.fac _
-    (op $ pairwise.single walking_pair.right)
+  exact (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 _).some.fac _
+    (op $ pairwise.single (ulift.up walking_pair.right))
 end
 
-/-- For a sheaf `F`, `F(U ∪ V)` is the pullback of `F(U) ⟶ F(U ∩ V)` and `F(V) ⟶ F(U ∩ V)`. -/
+/-- For a sheaf `F`, `F(U ⊔ V)` is the pullback of `F(U) ⟶ F(U ⊓ V)` and `F(V) ⟶ F(U ⊓ V)`. -/
 def is_limit_pullback_cone : is_limit (inter_union_pullback_cone F U V) :=
 begin
-  let ι : walking_pair → opens X := λ j, walking_pair.cases_on j U V,
-  have hι : U ∪ V = supr ι,
-  { ext, split,
+  let ι : ulift.{w} walking_pair → opens X := λ ⟨j⟩, walking_pair.cases_on j U V,
+  have hι : U ⊔ V = supr ι,
+  { ext,
+    rw [opens.coe_supr, set.mem_Union],
+    split,
     { rintros (h|h),
-    exacts [⟨_,⟨_,⟨walking_pair.left,rfl⟩,rfl⟩,h⟩, ⟨_,⟨_,⟨walking_pair.right,rfl⟩,rfl⟩,h⟩] },
-    { rintros ⟨_,⟨_,⟨⟨⟩,⟨⟩⟩,⟨⟩⟩,z⟩, exacts [or.inl z, or.inr z] } },
+      exacts [⟨⟨walking_pair.left⟩, h⟩, ⟨⟨walking_pair.right⟩, h⟩] },
+    { rintro ⟨⟨_ | _⟩, h⟩,
+      exacts [or.inl h, or.inr h] } },
   apply pullback_cone.is_limit_aux',
   intro s,
   use inter_union_pullback_cone_lift F U V s,
@@ -476,7 +336,7 @@ begin
   { apply inter_union_pullback_cone_lift_right },
   { intros m h₁ h₂,
     rw ← cancel_mono (F.1.map (eq_to_hom hι.symm).op),
-    apply (F.1.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 ι).some.hom_ext,
+    apply (F.presheaf.is_sheaf_iff_is_sheaf_pairwise_intersections.mp F.2 ι).some.hom_ext,
     apply opposite.rec,
     rintro ((_|_)|(_|_)); rw [category.assoc, category.assoc],
     { erw ← F.1.map_comp,
@@ -497,11 +357,41 @@ begin
       apply inter_union_pullback_cone_lift_right } }
 end
 
-/-- If `U, V` are disjoint, then `F(U ∪ V) = F(U) × F(V)`. -/
-def is_product_of_disjoint (h : U ∩ V = ⊥) : is_limit
+/-- If `U, V` are disjoint, then `F(U ⊔ V) = F(U) × F(V)`. -/
+def is_product_of_disjoint (h : U ⊓ V = ⊥) : is_limit
     (binary_fan.mk (F.1.map (hom_of_le le_sup_left : _ ⟶ U ⊔ V).op)
       (F.1.map (hom_of_le le_sup_right : _ ⟶ U ⊔ V).op)) :=
 is_product_of_is_terminal_is_pullback _ _ _ _
   (F.is_terminal_of_eq_empty h) (is_limit_pullback_cone F U V)
 
+/-- `F(U ⊔ V)` is isomorphic to the `eq_locus` of the two maps `F(U) × F(V) ⟶ F(U ⊓ V)`. -/
+def obj_sup_iso_prod_eq_locus {X : Top} (F : X.sheaf CommRing)
+  (U V : opens X) :
+  F.1.obj (op $ U ⊔ V) ≅ CommRing.of (ring_hom.eq_locus _ _) :=
+(F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso (CommRing.pullback_cone_is_limit _ _)
+
+lemma obj_sup_iso_prod_eq_locus_hom_fst {X : Top} (F : X.sheaf CommRing)
+  (U V : opens X) (x) :
+  ((F.obj_sup_iso_prod_eq_locus U V).hom x).1.fst = F.1.map (hom_of_le le_sup_left).op x :=
+concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_hom_comp
+  (CommRing.pullback_cone_is_limit _ _) walking_cospan.left) x
+
+lemma obj_sup_iso_prod_eq_locus_hom_snd {X : Top} (F : X.sheaf CommRing)
+  (U V : opens X) (x) :
+  ((F.obj_sup_iso_prod_eq_locus U V).hom x).1.snd = F.1.map (hom_of_le le_sup_right).op x :=
+concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_hom_comp
+  (CommRing.pullback_cone_is_limit _ _) walking_cospan.right) x
+
+lemma obj_sup_iso_prod_eq_locus_inv_fst {X : Top} (F : X.sheaf CommRing)
+  (U V : opens X) (x) :
+  F.1.map (hom_of_le le_sup_left).op ((F.obj_sup_iso_prod_eq_locus U V).inv x) = x.1.1 :=
+concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_inv_comp
+  (CommRing.pullback_cone_is_limit _ _) walking_cospan.left) x
+
+lemma obj_sup_iso_prod_eq_locus_inv_snd {X : Top} (F : X.sheaf CommRing)
+  (U V : opens X) (x) :
+  F.1.map (hom_of_le le_sup_right).op ((F.obj_sup_iso_prod_eq_locus U V).inv x) = x.1.2 :=
+concrete_category.congr_hom ((F.is_limit_pullback_cone U V).cone_point_unique_up_to_iso_inv_comp
+  (CommRing.pullback_cone_is_limit _ _) walking_cospan.right) x
+
 end Top.sheaf
diff --git a/src/topology/sheaves/sheaf_condition/sites.lean b/src/topology/sheaves/sheaf_condition/sites.lean
index e5d79effb61c5..d6692f330c357 100644
--- a/src/topology/sheaves/sheaf_condition/sites.lean
+++ b/src/topology/sheaves/sheaf_condition/sites.lean
@@ -10,40 +10,30 @@ import category_theory.sites.dense_subsite
 
 /-!
 
-# The sheaf condition in terms of sites.
-
-The theory of sheaves on sites is developed independently from sheaves on spaces in
-`category_theory/sites`. In this file, we connect the two theories: We show that for a topological
-space `X`, a presheaf `F : (opens X)ᵒᵖ ⥤ C` is a sheaf on the site `opens X` if and only if it is
-a sheaf on `X` in the usual sense.
-
-Recall that a presheaf `F : (opens X)ᵒᵖ ⥤ C` is called a *sheaf* on the space `X`, if for every
-family of opens `U : ι → opens X`, the object `F.obj (op (supr U))` is the limit of some fork
-diagram. On the other hand, `F` is called a *sheaf* on the site `opens X`, if for every open set
-`U : opens X` and every presieve `R : presieve U`, the object `F.obj (op U)` is the limit of a
-very similar fork diagram. In this file, we will construct the two functions `covering_of_presieve`
-and `presieve_of_covering`, which translate between the two concepts. We then prove a bunch of
-naturality lemmas relating the two fork diagrams to each other.
-
-## Main statements
-* `is_sheaf_sites_iff_is_sheaf_spaces`. A presheaf `F : (opens X)ᵒᵖ ⥤ C` is a sheaf on the site
-  `opens X` if and only if it is a sheaf on the space `X`.
-* `Sheaf_sites_eq_sheaf_spaces`. The type of sheaves on the site `opens X` is *equal* to the type
-  of sheaves on the space `X`.
+# Coverings and sieves; from sheaves on sites and sheaves on spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file, we connect coverings in a topological space to sieves in the associated Grothendieck
+topology, in preparation of connecting the sheaf condition on sites to the various sheaf conditions
+on spaces.
+
+We also specialize results about sheaves on sites to sheaves on spaces; we show that the inclusion
+functor from a topological basis to `topological_space.opens` is cover_dense, that open maps
+induce cover_preserving functors, and that open embeddings induce compatible_preserving functors.
 
 -/
 
 noncomputable theory
 
-universes u v w
+universes w v u
 
-namespace Top.presheaf
+open category_theory topological_space
 
-open category_theory topological_space Top category_theory.limits opposite
-open Top.presheaf.sheaf_condition_equalizer_products
+namespace Top.presheaf
 
-variables {C : Type u} [category.{v} C] [has_products C]
-variables {X : Top.{v}} (F : presheaf C X)
+variables {X : Top.{w}}
 
 /--
 Given a presieve `R` on `U`, we obtain a covering family of open sets in `X`, by taking as index
@@ -60,21 +50,6 @@ namespace covering_of_presieve
 
 variables (U : opens X) (R : presieve U)
 
-/-!
-In this section, we will relate two different fork diagrams to each other.
-
-The first one is the defining fork diagram for the sheaf condition in terms of sites, applied to
-the presieve `R`. It will henceforth be called the _sites diagram_. Its objects are called
-`presheaf.first_obj` and `presheaf.second_obj` and its morphisms are `presheaf.first_map` and
-`presheaf.second_obj`. The fork map into this diagram is called `presheaf.fork_map`.
-
-The second one is the defining fork diagram for the sheaf condition in terms of spaces, applied to
-the family of opens `covering_of_presieve U R`. It will henceforth be called the _spaces diagram_.
-Its objects are called `pi_opens` and `pi_inters` and its morphisms are `left_res` and `right_res`.
-The fork map into this diagram is called `res`.
-
--/
-
 /--
 If `R` is a presieve in the grothendieck topology on `opens X`, the covering family associated to
 `R` really is _covering_, i.e. the union of all open sets equals `U`.
@@ -87,161 +62,13 @@ begin
     intro f,
     exact f.2.1.le, },
   intros x hxU,
-  rw [opens.mem_coe, opens.mem_supr],
+  rw [opens.mem_supr],
   obtain ⟨V, iVU, ⟨W, iVW, iWU, hiWU, -⟩, hxV⟩ := hR x hxU,
   exact ⟨⟨W, ⟨iWU, hiWU⟩⟩, iVW.le hxV⟩,
 end
 
-/--
-The first object in the sites diagram is isomorphic to the first object in the spaces diagram.
-Actually, they are even definitionally equal, but it is convenient to give this isomorphism a name.
--/
-def first_obj_iso_pi_opens : presheaf.first_obj R F ≅ pi_opens F (covering_of_presieve U R) :=
-eq_to_iso rfl
-
-/--
-The isomorphism `first_obj_iso_pi_opens` is compatible with canonical projections out of the
-product.
--/
-lemma first_obj_iso_pi_opens_π (f : Σ V, {f : V ⟶ U // R f}) :
-  (first_obj_iso_pi_opens F U R).hom ≫ pi.π _ f = pi.π _ f :=
-category.id_comp _
-
-/--
-The second object in the sites diagram is isomorphic to the second object in the spaces diagram.
--/
-def second_obj_iso_pi_inters :
-  presheaf.second_obj R F ≅ pi_inters F (covering_of_presieve U R) :=
-has_limit.iso_of_nat_iso $ discrete.nat_iso $ λ i,
-  F.map_iso (eq_to_iso (complete_lattice.pullback_eq_inf _ _).symm).op
-
-/--
-The isomorphism `second_obj_iso_pi_inters` is compatible with canonical projections out of the
-product. Here, we have to insert an `eq_to_hom` arrow to pass from
-`F.obj (op (pullback f.2.1 g.2.1))` to `F.obj (op (f.1 ⊓ g.1))`.
--/
-lemma second_obj_iso_pi_inters_π (f g : Σ V, {f : V ⟶ U // R f}) :
-  (second_obj_iso_pi_inters F U R).hom ≫ pi.π _ (f, g) =
-  pi.π _ (f, g) ≫ F.map (eq_to_hom (complete_lattice.pullback_eq_inf f.2.1 g.2.1).symm).op :=
-begin
-  dunfold second_obj_iso_pi_inters,
-  rw has_limit.iso_of_nat_iso_hom_π,
-  refl,
-end
-
-/--
-Composing the fork map of the sites diagram with the isomorphism `first_obj_iso_pi_opens` is the
-same as the fork map of the spaces diagram (modulo an `eq_to_hom` arrow).
--/
-lemma fork_map_comp_first_obj_iso_pi_opens_eq
-  (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
-  presheaf.fork_map R F ≫ (first_obj_iso_pi_opens F U R).hom =
-  F.map (eq_to_hom (supr_eq_of_mem_grothendieck U R hR)).op ≫ res F (covering_of_presieve U R) :=
-begin
-  ext f,
-  rw [category.assoc, category.assoc],
-  rw first_obj_iso_pi_opens_π,
-  dunfold presheaf.fork_map res,
-  rw [limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app, ← F.map_comp],
-  congr,
-end
-
-/--
-First naturality condition. Under the isomorphisms `first_obj_iso_pi_opens` and
-`second_obj_iso_pi_inters`, the map `presheaf.first_map` corresponds to `left_res`.
--/
-lemma first_obj_iso_comp_left_res_eq :
-  presheaf.first_map R F ≫ (second_obj_iso_pi_inters F U R).hom =
-  (first_obj_iso_pi_opens F U R).hom ≫ left_res F (covering_of_presieve U R) :=
-begin
-  ext ⟨f, g⟩,
-  rw [category.assoc, category.assoc, second_obj_iso_pi_inters_π],
-  dunfold left_res presheaf.first_map,
-  rw [limit.lift_π, fan.mk_π_app, limit.lift_π_assoc, fan.mk_π_app, ← category.assoc],
-  erw [first_obj_iso_pi_opens_π, category.assoc, ← F.map_comp],
-  refl,
-end
-
-/--
-Second naturality condition. Under the isomorphisms `first_obj_iso_pi_opens` and
-`second_obj_iso_pi_inters`, the map `presheaf.second_map` corresponds to `right_res`.
--/
-lemma first_obj_iso_comp_right_res_eq :
-  presheaf.second_map R F ≫ (second_obj_iso_pi_inters F U R).hom =
-  (first_obj_iso_pi_opens F U R).hom ≫ right_res F (covering_of_presieve U R) :=
-begin
-  ext ⟨f, g⟩,
-  dunfold right_res presheaf.second_map,
-  rw [category.assoc, category.assoc, second_obj_iso_pi_inters_π, limit.lift_π, fan.mk_π_app,
-    limit.lift_π_assoc, fan.mk_π_app, ← category.assoc, first_obj_iso_pi_opens_π, category.assoc,
-    ← F.map_comp],
-  refl,
-end
-
-/-- The natural isomorphism between the sites diagram and the spaces diagram. -/
-@[simps]
-def diagram_nat_iso : parallel_pair (presheaf.first_map R F) (presheaf.second_map R F) ≅
-  diagram F (covering_of_presieve U R) :=
-nat_iso.of_components
-  (λ i, walking_parallel_pair.cases_on i
-    (first_obj_iso_pi_opens F U R)
-    (second_obj_iso_pi_inters F U R)) $
-begin
-  intros i j f,
-  cases i,
-  { cases j,
-    { cases f, simp },
-    { cases f,
-      { exact first_obj_iso_comp_left_res_eq F U R, },
-      { exact first_obj_iso_comp_right_res_eq F U R, } } },
-  { cases j,
-    { cases f, },
-    { cases f, simp } },
-end
-
-/--
-Postcomposing the given fork of the _sites_ diagram with the natural isomorphism between the
-diagrams gives us a fork of the _spaces_ diagram. We construct a morphism from this fork to the
-given fork of the _spaces_ diagram. This is shown to be an isomorphism below.
--/
-@[simps]
-def postcompose_diagram_fork_hom (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
-  (cones.postcompose (diagram_nat_iso F U R).hom).obj (fork.of_ι _ (presheaf.w R F)) ⟶
-  fork F (covering_of_presieve U R) :=
-fork.mk_hom (F.map (eq_to_hom (supr_eq_of_mem_grothendieck U R hR)).op)
-  (fork_map_comp_first_obj_iso_pi_opens_eq F U R hR).symm
-
-instance is_iso_postcompose_diagram_fork_hom_hom
-  (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
-  is_iso (postcompose_diagram_fork_hom F U R hR).hom :=
-begin rw postcompose_diagram_fork_hom_hom, apply eq_to_hom.is_iso, end
-
-instance is_iso_postcompose_diagram_fork_hom
-  (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
-  is_iso (postcompose_diagram_fork_hom F U R hR) :=
-cones.cone_iso_of_hom_iso _
-
-/-- See `postcompose_diagram_fork_hom`. -/
-def postcompose_diagram_fork_iso (hR : sieve.generate R ∈ opens.grothendieck_topology X U) :
-  (cones.postcompose (diagram_nat_iso F U R).hom).obj (fork.of_ι _ (presheaf.w R F)) ≅
-  fork F (covering_of_presieve U R) :=
-as_iso (postcompose_diagram_fork_hom F U R hR)
-
 end covering_of_presieve
 
-lemma is_sheaf_sites_of_is_sheaf_spaces (Fsh : F.is_sheaf) :
-  presheaf.is_sheaf (opens.grothendieck_topology X) F :=
-begin
-  rw presheaf.is_sheaf_iff_is_sheaf',
-  intros U R hR,
-  refine ⟨_⟩,
-  apply (is_limit.of_cone_equiv (cones.postcompose_equivalence
-    (covering_of_presieve.diagram_nat_iso F U R : _))).to_fun,
-  apply (is_limit.equiv_iso_limit
-    (covering_of_presieve.postcompose_diagram_fork_iso F U R hR)).inv_fun,
-  exact (Fsh (covering_of_presieve U R)).some,
-end
-
 /--
 Given a family of opens `U : ι → opens X` and any open `Y : opens X`, we obtain a presieve
 on `Y` by declaring that a morphism `f : V ⟶ Y` is a member of the presieve if and only if
@@ -264,21 +91,6 @@ by { ext Z f, exact ⟨λ ⟨⟨_,_,h⟩,rfl⟩, by convert h, λ h, ⟨⟨Z,f,h
 
 namespace presieve_of_covering
 
-/-!
-In this section, we will relate two different fork diagrams to each other.
-
-The first one is the defining fork diagram for the sheaf condition in terms of spaces, applied to
-the family of opens `U`. It will henceforth be called the _spaces diagram_. Its objects are called
-`pi_opens` and `pi_inters` and its morphisms are `left_res` and `right_res`. The fork map into this
-diagram is called `res`.
-
-The second one is the defining fork diagram for the sheaf condition in terms of sites, applied to
-the presieve `presieve_of_covering U`. It will henceforth be called the _sites diagram_. Its objects
-are called `presheaf.first_obj` and `presheaf.second_obj` and its morphisms are `presheaf.first_map`
-and `presheaf.second_obj`. The fork map into this diagram is called `presheaf.fork_map`.
-
--/
-
 variables {ι : Type v} (U : ι → opens X)
 
 /--
@@ -308,198 +120,12 @@ def index_of_hom (f : Σ V, {f : V ⟶ supr U // presieve_of_covering U f}) : ι
 lemma index_of_hom_spec (f : Σ V, {f : V ⟶ supr U // presieve_of_covering U f}) :
   f.1 = U (index_of_hom U f) := f.2.2.some_spec
 
-/--
-The canonical morphism from the first object in the sites diagram to the first object in the
-spaces diagram. Note that this is *not* an isomorphism, as the product `pi_opens F U` may contain
-duplicate factors, i.e. `U : ι → opens X` may not be injective.
--/
-def first_obj_to_pi_opens : presheaf.first_obj (presieve_of_covering U) F ⟶ pi_opens F U :=
-pi.lift (λ i, pi.π _ (hom_of_index U i))
-
-/--
-The canonical morphism from the first object in the spaces diagram to the first object in the
-sites diagram. Note that this is *not* an isomorphism, as the product `pi_opens F U` may contain
-duplicate factors, i.e. `U : ι → opens X` may not be injective.
--/
-def pi_opens_to_first_obj : pi_opens F U ⟶
-  presheaf.first_obj.{v v u} (presieve_of_covering U) F :=
-pi.lift (λ f, pi.π _ (index_of_hom U f) ≫ F.map (eq_to_hom (index_of_hom_spec U f)).op)
-
-/--
-Even though `first_obj_to_pi_opens` and `pi_opens_to_first_obj` are not inverse to each other,
-applying them both after a fork map `s.ι` does nothing. The intuition here is that a compatible
-family `s : Π i : ι, F.obj (op (U i))` does not care about duplicate open sets:
-If `U i = U j` the compatible family coincides on the intersection `U i ⊓ U j = U i = U j`,
-hence `s i = s j` (module an `eq_to_hom` arrow).
--/
-lemma fork_ι_comp_pi_opens_to_first_obj_to_pi_opens_eq
-  (s : limits.fork (left_res F U) (right_res F U)) :
-  s.ι ≫ pi_opens_to_first_obj F U ≫ first_obj_to_pi_opens F U = s.ι :=
-begin
-  ext j,
-  dunfold first_obj_to_pi_opens pi_opens_to_first_obj,
-  rw [category.assoc, category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app],
-  -- The issue here is that `index_of_hom U (hom_of_index U j)` need not be equal to `j`.
-  -- But `U j = U (index_of_hom U (hom_of_index U j))` and hence we obtain the following
-  -- `eq_to_hom` arrow:
-  have i_eq : U j ⟶ U j ⊓ U (index_of_hom U (hom_of_index U j)),
-  { apply eq_to_hom, rw ← index_of_hom_spec U, exact inf_idem.symm, },
-  -- Since `s` is a fork, we know that `s.ι ≫ left_res F U = s.ι ≫ right_res F U`.
-  -- We compose both sides of this equality with the canonical projection at the index pair
-  -- `(j, index_of_hom U (hom_of_index U j)` and the restriction along `i_eq`.
-  have := congr_arg (λ f, f ≫
-    pi.π (λ p : ι × ι, F.obj (op (U p.1 ⊓ U p.2))) (j, index_of_hom U (hom_of_index U j)) ≫
-    F.map i_eq.op) s.condition,
-  dsimp at this,
-  rw [category.assoc, category.assoc] at this,
-  symmetry,
-  -- We claim that this is equality is our goal
-  convert this using 2,
-  { dunfold left_res,
-    rw [limit.lift_π_assoc, fan.mk_π_app, category.assoc, ← F.map_comp],
-    erw F.map_id,
-    rw category.comp_id },
-  { dunfold right_res,
-    rw [limit.lift_π_assoc, fan.mk_π_app, category.assoc, ← F.map_comp],
-    congr, }
-end
-
-/--
-The canonical morphism from the second object of the spaces diagram to the second object of the
-sites diagram.
--/
-def pi_inters_to_second_obj : pi_inters F U ⟶
-  presheaf.second_obj.{v v u} (presieve_of_covering U) F :=
-pi.lift (λ f, pi.π _ (index_of_hom U f.fst, index_of_hom U f.snd) ≫
-  F.map (eq_to_hom
-    (by rw [complete_lattice.pullback_eq_inf, ← index_of_hom_spec U, ← index_of_hom_spec U])).op)
-
-lemma pi_opens_to_first_obj_comp_fist_map_eq :
-  pi_opens_to_first_obj F U ≫ presheaf.first_map (presieve_of_covering U) F =
-  left_res F U ≫ pi_inters_to_second_obj F U :=
-begin
-  ext ⟨f, g⟩,
-  dunfold pi_opens_to_first_obj presheaf.first_map left_res pi_inters_to_second_obj,
-  rw [category.assoc, category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
-    ← category.assoc, ← category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
-    category.assoc, category.assoc, ← F.map_comp, ← F.map_comp],
-  refl,
-end
-
-lemma pi_opens_to_first_obj_comp_second_map_eq :
-  pi_opens_to_first_obj F U ≫ presheaf.second_map (presieve_of_covering U) F =
-  right_res F U ≫ pi_inters_to_second_obj F U :=
-begin
-  ext ⟨f, g⟩,
-  dunfold pi_opens_to_first_obj presheaf.second_map right_res pi_inters_to_second_obj,
-  rw [category.assoc, category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
-    ← category.assoc, ← category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
-    category.assoc, category.assoc, ← F.map_comp, ← F.map_comp],
-  refl,
-end
-
-lemma fork_map_comp_first_map_to_pi_opens_eq :
-  presheaf.fork_map (presieve_of_covering U) F ≫ first_obj_to_pi_opens F U = res F U :=
-begin
-  ext i,
-  dsimp [presheaf.fork_map, first_obj_to_pi_opens, res],
-  rw [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app,
-    limit.lift_π, fan.mk_π_app],
-  refl,
-end
-
-lemma res_comp_pi_opens_to_first_obj_eq :
-  res F U ≫ pi_opens_to_first_obj F U = presheaf.fork_map (presieve_of_covering U) F :=
-begin
-  ext f,
-  dunfold res pi_opens_to_first_obj presheaf.fork_map,
-  rw [category.assoc, limit.lift_π, fan.mk_π_app, limit.lift_π, fan.mk_π_app, ← category.assoc,
-    limit.lift_π, fan.mk_π_app, ← F.map_comp],
-  congr,
-end
-
 end presieve_of_covering
 
-open presieve_of_covering
-
-lemma is_sheaf_spaces_of_is_sheaf_sites
-  (Fsh : presheaf.is_sheaf (opens.grothendieck_topology X) F) :
-  F.is_sheaf :=
-begin
-  intros ι U,
-  rw presheaf.is_sheaf_iff_is_sheaf' at Fsh,
-  -- We know that the sites diagram for `presieve_of_covering U` is a limit fork
-  obtain ⟨h_limit⟩ := Fsh (supr U) (presieve_of_covering U)
-    (presieve_of_covering.mem_grothendieck_topology U),
-  refine ⟨fork.is_limit.mk' _ _⟩,
-  -- Here, we are given an arbitrary fork of the spaces diagram and need to show that it factors
-  -- uniquely through our limit fork.
-  intro s,
-  -- Composing `s.ι` with `pi_opens_to_first_obj F U` gives a fork of the sites diagram, which
-  -- must factor through `presheaf.fork_map`.
-  obtain ⟨l, hl⟩ := fork.is_limit.lift' h_limit (s.ι ≫ pi_opens_to_first_obj F U) _,
-  swap,
-  { rw [category.assoc, category.assoc, pi_opens_to_first_obj_comp_fist_map_eq,
-    pi_opens_to_first_obj_comp_second_map_eq, ← category.assoc, ← category.assoc, s.condition] },
-  -- We claim that `l` also gives a factorization of `s.ι`
-  refine ⟨l, _, _⟩,
-  { rw [← fork_ι_comp_pi_opens_to_first_obj_to_pi_opens_eq F U s, ← category.assoc, ← hl,
-    category.assoc, fork.ι_of_ι, fork_map_comp_first_map_to_pi_opens_eq], refl },
-  { intros m hm,
-    apply fork.is_limit.hom_ext h_limit,
-    rw [hl, fork.ι_of_ι],
-    simp_rw ← res_comp_pi_opens_to_first_obj_eq,
-    erw [← category.assoc, hm], },
-end
-
-lemma is_sheaf_sites_iff_is_sheaf_spaces :
-  presheaf.is_sheaf (opens.grothendieck_topology X) F ↔ F.is_sheaf :=
-iff.intro (is_sheaf_spaces_of_is_sheaf_sites F) (is_sheaf_sites_of_is_sheaf_spaces F)
-
-variables (C X)
-
-/-- Turn a sheaf on the site `opens X` into a sheaf on the space `X`. -/
-@[simps]
-def Sheaf_sites_to_sheaf_spaces : Sheaf (opens.grothendieck_topology X) C ⥤ sheaf C X :=
-{ obj := λ F, ⟨F.1, is_sheaf_spaces_of_is_sheaf_sites F.1 F.2⟩,
-  map := λ F G f, f.val }
-
-/-- Turn a sheaf on the space `X` into a sheaf on the site `opens X`. -/
-@[simps]
-def Sheaf_spaces_to_sheaf_sites : sheaf C X ⥤ Sheaf (opens.grothendieck_topology X) C :=
-{ obj := λ F, ⟨F.1, is_sheaf_sites_of_is_sheaf_spaces F.1 F.2⟩,
-  map := λ F G f, ⟨f⟩ }
-
-/--
-The equivalence of categories between sheaves on the site `opens X` and sheaves on the space `X`.
--/
-@[simps]
-def Sheaf_spaces_equiv_sheaf_sites : Sheaf (opens.grothendieck_topology X) C ≌ sheaf C X :=
-{ functor := Sheaf_sites_to_sheaf_spaces C X,
-  inverse := Sheaf_spaces_to_sheaf_sites C X,
-  unit_iso := nat_iso.of_components (λ t, ⟨⟨𝟙 _⟩, ⟨𝟙 _⟩, by { ext1, simp }, by { ext1, simp }⟩) $
-    by { intros, ext1, dsimp, simp },
-  counit_iso := nat_iso.of_components (λ t, ⟨𝟙 _, 𝟙 _, by { ext, simp }, by { ext, simp }⟩) $
-    by { intros, ext, dsimp, simp } }
-
-/-- The two forgetful functors are isomorphic via `Sheaf_spaces_equiv_sheaf_sites`. -/
-def Sheaf_spaces_equiv_sheaf_sites_functor_forget :
-  (Sheaf_spaces_equiv_sheaf_sites C X).functor ⋙ sheaf.forget C X ≅ Sheaf_to_presheaf _ _ :=
-nat_iso.of_components (λ F, (iso.refl F.1))
-  (λ F G f, by { erw [category.comp_id, category.id_comp], refl })
-
-/-- The two forgetful functors are isomorphic via `Sheaf_spaces_equiv_sheaf_sites`. -/
-def Sheaf_spaces_equiv_sheaf_sites_inverse_forget :
-  (Sheaf_spaces_equiv_sheaf_sites C X).inverse ⋙ Sheaf_to_presheaf _ _ ≅ sheaf.forget C X :=
-nat_iso.of_components (λ F, (iso.refl F.1))
-  (λ F G f, by { erw [category.comp_id, category.id_comp], refl })
-
 end Top.presheaf
 
 namespace Top.opens
 
-open category_theory topological_space
-
 variables {X : Top} {ι : Type*}
 
 lemma cover_dense_iff_is_basis [category ι] (B : ι ⥤ opens X) :
@@ -518,20 +144,53 @@ lemma cover_dense_induced_functor {B : ι → opens X} (h : opens.is_basis (set.
 
 end Top.opens
 
+section open_embedding
+
+open Top.presheaf opposite
+
+variables {C : Type u} [category.{v} C]
+variables {X Y : Top.{w}} {f : X ⟶ Y} {F : Y.presheaf C}
+
+lemma open_embedding.compatible_preserving (hf : open_embedding f) :
+  compatible_preserving (opens.grothendieck_topology Y) hf.is_open_map.functor :=
+begin
+  haveI : mono f := (Top.mono_iff_injective f).mpr hf.inj,
+  apply compatible_preserving_of_downwards_closed,
+  intros U V i,
+  refine ⟨(opens.map f).obj V, eq_to_iso $ opens.ext $ set.image_preimage_eq_of_subset $ λ x h, _⟩,
+  obtain ⟨_, _, rfl⟩ := i.le h,
+  exact ⟨_, rfl⟩
+end
+
+lemma is_open_map.cover_preserving (hf : is_open_map f) :
+  cover_preserving (opens.grothendieck_topology X) (opens.grothendieck_topology Y) hf.functor :=
+begin
+  constructor,
+  rintros U S hU _ ⟨x, hx, rfl⟩,
+  obtain ⟨V, i, hV, hxV⟩ := hU x hx,
+  exact ⟨_, hf.functor.map i, ⟨_, i, 𝟙 _, hV, rfl⟩, set.mem_image_of_mem f hxV⟩
+end
+
+lemma Top.presheaf.is_sheaf_of_open_embedding (h : open_embedding f)
+  (hF : F.is_sheaf) : is_sheaf (h.is_open_map.functor.op ⋙ F) :=
+pullback_is_sheaf_of_cover_preserving h.compatible_preserving h.is_open_map.cover_preserving ⟨_, hF⟩
+
+end open_embedding
+
 namespace Top.sheaf
 
-open category_theory topological_space Top opposite
+open Top opposite
 
-variables {C : Type u} [category.{v} C] [limits.has_products C]
-variables {X : Top.{v}} {ι : Type*} {B : ι → opens X}
-variables (F : presheaf C X) (F' : sheaf C X) (h : opens.is_basis (set.range B))
+variables {C : Type u} [category.{v} C]
+variables {X : Top.{w}} {ι : Type*} {B : ι → opens X}
+variables (F : X.presheaf C) (F' : sheaf C X) (h : opens.is_basis (set.range B))
 
 /-- The empty component of a sheaf is terminal -/
-def is_terminal_of_empty (F : sheaf C X) : limits.is_terminal (F.val.obj (op ∅)) :=
-((presheaf.Sheaf_spaces_to_sheaf_sites C X).obj F).is_terminal_of_bot_cover ∅ (by tidy)
+def is_terminal_of_empty (F : sheaf C X) : limits.is_terminal (F.val.obj (op ⊥)) :=
+F.is_terminal_of_bot_cover ⊥ (by tidy)
 
 /-- A variant of `is_terminal_of_empty` that is easier to `apply`. -/
-def is_terminal_of_eq_empty (F : X.sheaf C) {U : opens X} (h : U = ∅) :
+def is_terminal_of_eq_empty (F : X.sheaf C) {U : opens X} (h : U = ⊥) :
   limits.is_terminal (F.val.obj (op U)) :=
 by convert F.is_terminal_of_empty
 
@@ -542,7 +201,7 @@ by convert F.is_terminal_of_empty
 def restrict_hom_equiv_hom :
   ((induced_functor B).op ⋙ F ⟶ (induced_functor B).op ⋙ F'.1) ≃ (F ⟶ F'.1) :=
 @cover_dense.restrict_hom_equiv_hom _ _ _ _ _ _ _ _ (opens.cover_dense_induced_functor h)
-  _ F ((presheaf.Sheaf_spaces_to_sheaf_sites C X).obj F')
+  _ F F'
 
 @[simp] lemma extend_hom_app (α : ((induced_functor B).op ⋙ F ⟶ (induced_functor B).op ⋙ F'.1))
   (i : ι) : (restrict_hom_equiv_hom F F' h α).app (op (B i)) = α.app (op i) :=
diff --git a/src/topology/sheaves/sheaf_condition/unique_gluing.lean b/src/topology/sheaves/sheaf_condition/unique_gluing.lean
index 4a65ecc97588b..2cbe750fc2433 100644
--- a/src/topology/sheaves/sheaf_condition/unique_gluing.lean
+++ b/src/topology/sheaves/sheaf_condition/unique_gluing.lean
@@ -11,6 +11,9 @@ import category_theory.types
 /-!
 # The sheaf condition in terms of unique gluings
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We provide an alternative formulation of the sheaf condition in terms of unique gluings.
 
 We work with sheaves valued in a concrete category `C` admitting all limits, whose forgetful
@@ -97,7 +100,7 @@ For presheaves of types, terms of `pi_opens F U` are just families of sections.
 def pi_opens_iso_sections_family : pi_opens F U ≅ Π i : ι, F.obj (op (U i)) :=
 limits.is_limit.cone_point_unique_up_to_iso
   (limit.is_limit (discrete.functor (λ i : ι, F.obj (op (U i)))))
-  ((types.product_limit_cone (λ i : ι, F.obj (op (U i)))).is_limit)
+  ((types.product_limit_cone.{v v} (λ i : ι, F.obj (op (U i)))).is_limit)
 
 /--
 Under the isomorphism `pi_opens_iso_sections_family`, compatibility of sections is the same
@@ -109,8 +112,8 @@ lemma compatible_iff_left_res_eq_right_res (sf : pi_opens F U) :
 begin
   split ; intros h,
   { ext ⟨i, j⟩,
-    rw [left_res, types.limit.lift_π_apply, fan.mk_π_app,
-        right_res, types.limit.lift_π_apply, fan.mk_π_app],
+    rw [left_res, types.limit.lift_π_apply', fan.mk_π_app,
+        right_res, types.limit.lift_π_apply', fan.mk_π_app],
     exact h i j, },
   { intros i j,
     convert congr_arg (limits.pi.π (λ p : ι × ι, F.obj (op (U p.1 ⊓ U p.2))) (i,j)) h,
@@ -128,8 +131,8 @@ lemma is_gluing_iff_eq_res (sf : pi_opens F U) (s : F.obj (op (supr U))):
   is_gluing F U ((pi_opens_iso_sections_family F U).hom sf) s ↔ res F U s = sf :=
 begin
   split ; intros h,
-  { ext i,
-    rw [res, types.limit.lift_π_apply, fan.mk_π_app],
+  { ext ⟨i⟩,
+    rw [res, types.limit.lift_π_apply', fan.mk_π_app],
     exact h i, },
   { intro i,
     convert congr_arg (limits.pi.π (λ i : ι, F.obj (op (U i))) i) h,
@@ -144,6 +147,7 @@ in terms of unique gluings.
 lemma is_sheaf_of_is_sheaf_unique_gluing_types (Fsh : F.is_sheaf_unique_gluing) :
   F.is_sheaf :=
 begin
+  rw is_sheaf_iff_is_sheaf_equalizer_products,
   intros ι U,
   refine ⟨fork.is_limit.mk' _ _⟩,
   intro s,
@@ -155,7 +159,7 @@ begin
   choose m m_spec m_uniq using
     λ x : s.X, Fsh U ((pi_opens_iso_sections_family F U).hom (s.ι x)) (h_compatible x),
   refine ⟨m, _, _⟩,
-  { ext i x,
+  { ext ⟨i⟩ x,
     simp [res],
     exact m_spec x i, },
   { intros l hl,
@@ -172,6 +176,7 @@ The sheaf condition in terms of unique gluings can be obtained from the usual
 lemma is_sheaf_unique_gluing_of_is_sheaf_types (Fsh : F.is_sheaf) :
   F.is_sheaf_unique_gluing :=
 begin
+  rw is_sheaf_iff_is_sheaf_equalizer_products at Fsh,
   intros ι U sf hsf,
   let sf' := (pi_opens_iso_sections_family F U).inv sf,
   have hsf' : left_res F U sf' = right_res F U sf',
@@ -241,7 +246,7 @@ A more convenient way of obtaining a unique gluing of sections for a sheaf.
 lemma exists_unique_gluing (sf : Π i : ι, F.1.obj (op (U i)))
   (h : is_compatible F.1 U sf ) :
   ∃! s : F.1.obj (op (supr U)), is_gluing F.1 U sf s :=
-(is_sheaf_iff_is_sheaf_unique_gluing F.1).mp F.property U sf h
+(is_sheaf_iff_is_sheaf_unique_gluing F.1).mp F.cond U sf h
 
 /--
 In this version of the lemma, the inclusion homs `iUV` can be specified directly by the user,
@@ -299,6 +304,21 @@ begin
   convert h i,
 end
 
+lemma eq_of_locally_eq₂ {U₁ U₂ V : opens X}
+  (i₁ : U₁ ⟶ V) (i₂ : U₂ ⟶ V) (hcover : V ≤ U₁ ⊔ U₂)
+  (s t : F.1.obj (op V))
+  (h₁ : F.1.map i₁.op s = F.1.map i₁.op t)
+  (h₂ : F.1.map i₂.op s = F.1.map i₂.op t) : s = t :=
+begin
+  classical,
+  fapply F.eq_of_locally_eq' (λ t : ulift bool, if t.1 then U₁ else U₂),
+  { exact λ i, if h : i.1 then (eq_to_hom (if_pos h)) ≫ i₁ else (eq_to_hom (if_neg h)) ≫ i₂ },
+  { refine le_trans hcover _, rw sup_le_iff, split,
+    { convert le_supr (λ t : ulift bool, if t.1 then U₁ else U₂) (ulift.up true) },
+    { convert le_supr (λ t : ulift bool, if t.1 then U₁ else U₂) (ulift.up false) } },
+  { rintro ⟨_|_⟩; simp [h₁, h₂] }
+end
+
 end
 
 end sheaf
diff --git a/src/topology/sheaves/sheaf_of_functions.lean b/src/topology/sheaves/sheaf_of_functions.lean
index 8983925386537..8b3e8bcc0e660 100644
--- a/src/topology/sheaves/sheaf_of_functions.lean
+++ b/src/topology/sheaves/sheaf_of_functions.lean
@@ -3,13 +3,15 @@ Copyright (c) 2020 Scott Morrison. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johan Commelin, Scott Morrison
 -/
-import category_theory.limits.shapes.types
 import topology.sheaves.presheaf_of_functions
 import topology.sheaves.sheaf_condition.unique_gluing
 
 /-!
 # Sheaf conditions for presheaves of (continuous) functions.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We show that
 * `Top.presheaf.to_Type_is_sheaf`: not-necessarily-continuous functions into a type form a sheaf
 * `Top.presheaf.to_Types_is_sheaf`: in fact, these may be dependent functions into a type family
diff --git a/src/topology/sheaves/sheafify.lean b/src/topology/sheaves/sheafify.lean
index acc3b40344654..7adc5d90beb87 100644
--- a/src/topology/sheaves/sheafify.lean
+++ b/src/topology/sheaves/sheafify.lean
@@ -9,6 +9,9 @@ import topology.sheaves.stalks
 /-!
 # Sheafification of `Type` valued presheaves
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We construct the sheafification of a `Type` valued presheaf,
 as the subsheaf of dependent functions into the stalks
 consisting of functions which are locally germs.
@@ -76,7 +79,7 @@ def to_sheafify : F ⟶ F.sheafify.1 :=
 The natural morphism from the stalk of the sheafification to the original stalk.
 In `sheafify_stalk_iso` we show this is an isomorphism.
 -/
-def stalk_to_fiber (x : X) : F.sheafify.1.stalk x ⟶ F.stalk x :=
+def stalk_to_fiber (x : X) : F.sheafify.presheaf.stalk x ⟶ F.stalk x :=
 stalk_to_fiber (sheafify.is_locally_germ F) x
 
 lemma stalk_to_fiber_surjective (x : X) : function.surjective (F.stalk_to_fiber x) :=
@@ -104,9 +107,9 @@ begin
   dsimp at e',
   use ⟨W ⊓ (U' ⊓ V'), ⟨mW, mU, mV⟩⟩,
   refine ⟨_, _, _⟩,
-  { change W ⊓ (U' ⊓ V') ⟶ U.val,
+  { change W ⊓ (U' ⊓ V') ⟶ U.obj,
     exact (opens.inf_le_right _ _) ≫ (opens.inf_le_left _ _) ≫ iU, },
-  { change W ⊓ (U' ⊓ V') ⟶ V.val,
+  { change W ⊓ (U' ⊓ V') ⟶ V.obj,
     exact (opens.inf_le_right _ _) ≫ (opens.inf_le_right _ _) ≫ iV, },
   { intro w,
     dsimp,
@@ -121,7 +124,7 @@ end
 /--
 The isomorphism betweeen a stalk of the sheafification and the original stalk.
 -/
-def sheafify_stalk_iso (x : X) : F.sheafify.1.stalk x ≅ F.stalk x :=
+def sheafify_stalk_iso (x : X) : F.sheafify.presheaf.stalk x ≅ F.stalk x :=
 (equiv.of_bijective _ ⟨stalk_to_fiber_injective _ _, stalk_to_fiber_surjective _ _⟩).to_iso
 
 -- PROJECT functoriality, and that sheafification is the left adjoint of the forgetful functor.
diff --git a/src/topology/sheaves/skyscraper.lean b/src/topology/sheaves/skyscraper.lean
new file mode 100644
index 0000000000000..08b19fe467af6
--- /dev/null
+++ b/src/topology/sheaves/skyscraper.lean
@@ -0,0 +1,387 @@
+/-
+Copyright (c) 2022 Jujian Zhang. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Jujian Zhang, Junyan Xu
+-/
+import topology.sheaves.punit
+import topology.sheaves.stalks
+import topology.sheaves.functors
+
+/-!
+# Skyscraper (pre)sheaves
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+A skyscraper (pre)sheaf `𝓕 : (pre)sheaf C X` is the (pre)sheaf with value `A` at point `p₀` that is
+supported only at open sets contain `p₀`, i.e. `𝓕(U) = A` if `p₀ ∈ U` and `𝓕(U) = *` if `p₀ ∉ U`
+where `*` is a terminal object of `C`. In terms of stalks, `𝓕` is supported at all specializations
+of `p₀`, i.e. if `p₀ ⤳ x` then `𝓕ₓ ≅ A` and if `¬ p₀ ⤳ x` then `𝓕ₓ ≅ *`.
+
+## Main definitions
+
+* `skyscraper_presheaf`: `skyscraper_presheaf p₀ A` is the skyscraper presheaf at point `p₀` with
+  value `A`.
+* `skyscraper_sheaf`: the skyscraper presheaf satisfies the sheaf condition.
+
+## Main statements
+
+* `skyscraper_presheaf_stalk_of_specializes`: if `y ∈ closure {p₀}` then the stalk of
+  `skyscraper_presheaf p₀ A` at `y` is `A`.
+* `skyscraper_presheaf_stalk_of_not_specializes`: if `y ∉ closure {p₀}` then the stalk of
+  `skyscraper_presheaf p₀ A` at `y` is `*` the terminal object.
+
+TODO: generalize universe level when calculating stalks, after generalizing universe level of stalk.
+-/
+
+noncomputable theory
+
+open topological_space Top category_theory category_theory.limits opposite
+
+universes u v w
+
+variables {X : Top.{u}} (p₀ : X) [Π (U : opens X), decidable (p₀ ∈ U)]
+
+section
+
+variables {C : Type v} [category.{w} C] [has_terminal C] (A : C)
+
+/--
+A skyscraper presheaf is a presheaf supported at a single point: if `p₀ ∈ X` is a specified
+point, then the skyscraper presheaf `𝓕` with value `A` is defined by `U ↦ A` if `p₀ ∈ U` and
+`U ↦ *` if `p₀ ∉ A` where `*` is some terminal object.
+-/
+@[simps] def skyscraper_presheaf : presheaf C X :=
+{ obj := λ U, if p₀ ∈ unop U then A else terminal C,
+  map := λ U V i, if h : p₀ ∈ unop V
+    then eq_to_hom $ by erw [if_pos h, if_pos (le_of_hom i.unop h)]
+    else ((if_neg h).symm.rec terminal_is_terminal).from _,
+  map_id' := λ U, (em (p₀ ∈ U.unop)).elim (λ h, dif_pos h)
+    (λ h, ((if_neg h).symm.rec terminal_is_terminal).hom_ext _ _),
+  map_comp' := λ U V W iVU iWV,
+  begin
+    by_cases hW : p₀ ∈ unop W,
+    { have hV : p₀ ∈ unop V := le_of_hom iWV.unop hW,
+      simp only [dif_pos hW, dif_pos hV, eq_to_hom_trans] },
+    { rw [dif_neg hW], apply ((if_neg hW).symm.rec terminal_is_terminal).hom_ext }
+  end }
+
+lemma skyscraper_presheaf_eq_pushforward
+  [hd : Π (U : opens (Top.of punit.{u+1})), decidable (punit.star ∈ U)] :
+  skyscraper_presheaf p₀ A =
+  continuous_map.const (Top.of punit) p₀ _* skyscraper_presheaf punit.star A :=
+by convert_to @skyscraper_presheaf X p₀
+  (λ U, hd $ (opens.map $ continuous_map.const _ p₀).obj U) C _ _ A = _; congr <|> refl
+
+/--
+Taking skyscraper presheaf at a point is functorial: `c ↦ skyscraper p₀ c` defines a functor by
+sending every `f : a ⟶ b` to the natural transformation `α` defined as: `α(U) = f : a ⟶ b` if
+`p₀ ∈ U` and the unique morphism to a terminal object in `C` if `p₀ ∉ U`.
+-/
+@[simps] def skyscraper_presheaf_functor.map' {a b : C} (f : a ⟶ b) :
+  skyscraper_presheaf p₀ a ⟶ skyscraper_presheaf p₀ b :=
+{ app := λ U, if h : p₀ ∈ U.unop
+    then eq_to_hom (if_pos h) ≫ f ≫ eq_to_hom (if_pos h).symm
+    else ((if_neg h).symm.rec terminal_is_terminal).from _,
+  naturality' := λ U V i,
+  begin
+    simp only [skyscraper_presheaf_map], by_cases hV : p₀ ∈ V.unop,
+    { have hU : p₀ ∈ U.unop := le_of_hom i.unop hV, split_ifs,
+      simpa only [eq_to_hom_trans_assoc, category.assoc, eq_to_hom_trans], },
+    { apply ((if_neg hV).symm.rec terminal_is_terminal).hom_ext, },
+  end }
+
+lemma skyscraper_presheaf_functor.map'_id {a : C} :
+  skyscraper_presheaf_functor.map' p₀ (𝟙 a) = 𝟙 _ :=
+begin
+  ext1, ext1, simp only [skyscraper_presheaf_functor.map'_app, nat_trans.id_app], split_ifs,
+  { simp only [category.id_comp, category.comp_id, eq_to_hom_trans, eq_to_hom_refl], },
+  { apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext, },
+end
+
+lemma skyscraper_presheaf_functor.map'_comp {a b c : C} (f : a ⟶ b) (g : b ⟶ c) :
+  skyscraper_presheaf_functor.map' p₀ (f ≫ g) =
+  skyscraper_presheaf_functor.map' p₀ f ≫ skyscraper_presheaf_functor.map' p₀ g :=
+begin
+  ext1, ext1, simp only [skyscraper_presheaf_functor.map'_app, nat_trans.comp_app], split_ifs,
+  { simp only [category.assoc, eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp], },
+  { apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext, },
+end
+
+/--
+Taking skyscraper presheaf at a point is functorial: `c ↦ skyscraper p₀ c` defines a functor by
+sending every `f : a ⟶ b` to the natural transformation `α` defined as: `α(U) = f : a ⟶ b` if
+`p₀ ∈ U` and the unique morphism to a terminal object in `C` if `p₀ ∉ U`.
+-/
+@[simps] def skyscraper_presheaf_functor : C ⥤ presheaf C X :=
+{ obj := skyscraper_presheaf p₀,
+  map := λ _ _, skyscraper_presheaf_functor.map' p₀,
+  map_id' := λ _, skyscraper_presheaf_functor.map'_id p₀,
+  map_comp' := λ _ _ _, skyscraper_presheaf_functor.map'_comp p₀ }
+
+end
+
+section
+
+-- In this section, we calculate the stalks for skyscraper presheaves.
+-- We need to restrict universe level.
+
+variables {C : Type v} [category.{u} C] (A : C) [has_terminal C]
+
+/--
+The cocone at `A` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∈ closure {p₀}`
+-/
+@[simps] def skyscraper_presheaf_cocone_of_specializes {y : X} (h : p₀ ⤳ y) :
+  cocone ((open_nhds.inclusion y).op ⋙ skyscraper_presheaf p₀ A) :=
+{ X := A,
+  ι := { app := λ U, eq_to_hom $ if_pos $ h.mem_open U.unop.1.2 U.unop.2,
+    naturality' := λ U V inc, begin
+      change dite _ _ _ ≫ _ = _, rw dif_pos,
+      { erw [category.comp_id, eq_to_hom_trans], refl },
+      { exact h.mem_open V.unop.1.2 V.unop.2 },
+    end } }
+
+/--
+The cocone at `A` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∈ closure {p₀}` is a
+colimit
+-/
+noncomputable def skyscraper_presheaf_cocone_is_colimit_of_specializes
+  {y : X} (h : p₀ ⤳ y) : is_colimit (skyscraper_presheaf_cocone_of_specializes p₀ A h) :=
+{ desc := λ c, eq_to_hom (if_pos trivial).symm ≫ c.ι.app (op ⊤),
+  fac' := λ c U, begin
+    rw ← c.w (hom_of_le $ (le_top : unop U ≤ _)).op,
+    change _ ≫ _ ≫ dite _ _ _ ≫ _ = _,
+    rw dif_pos,
+    { simpa only [skyscraper_presheaf_cocone_of_specializes_ι_app,
+        eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp] },
+    { exact h.mem_open U.unop.1.2 U.unop.2 },
+  end,
+  uniq' := λ c f h, by rw [← h, skyscraper_presheaf_cocone_of_specializes_ι_app,
+    eq_to_hom_trans_assoc, eq_to_hom_refl, category.id_comp] }
+
+/--
+If `y ∈ closure {p₀}`, then the stalk of `skyscraper_presheaf p₀ A` at `y` is `A`.
+-/
+noncomputable def skyscraper_presheaf_stalk_of_specializes [has_colimits C]
+  {y : X} (h : p₀ ⤳ y) : (skyscraper_presheaf p₀ A).stalk y ≅ A :=
+colimit.iso_colimit_cocone ⟨_, skyscraper_presheaf_cocone_is_colimit_of_specializes p₀ A h⟩
+
+/--
+The cocone at `*` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∉ closure {p₀}`
+-/
+@[simps] def skyscraper_presheaf_cocone (y : X) :
+  cocone ((open_nhds.inclusion y).op ⋙ skyscraper_presheaf p₀ A) :=
+{ X := terminal C,
+  ι :=
+  { app := λ U, terminal.from _,
+    naturality' := λ U V inc, terminal_is_terminal.hom_ext _ _ } }
+
+/--
+The cocone at `*` for the stalk functor of `skyscraper_presheaf p₀ A` when `y ∉ closure {p₀}` is a
+colimit
+-/
+noncomputable def skyscraper_presheaf_cocone_is_colimit_of_not_specializes
+  {y : X} (h : ¬p₀ ⤳ y) : is_colimit (skyscraper_presheaf_cocone p₀ A y) :=
+let h1 : ∃ (U : open_nhds y), p₀ ∉ U.1 :=
+  let ⟨U, ho, h₀, hy⟩ := not_specializes_iff_exists_open.mp h in ⟨⟨⟨U, ho⟩, h₀⟩, hy⟩ in
+{ desc := λ c, eq_to_hom (if_neg h1.some_spec).symm ≫ c.ι.app (op h1.some),
+  fac' := λ c U, begin
+    change _ = c.ι.app (op U.unop),
+    simp only [← c.w (hom_of_le $ @inf_le_left _ _ h1.some U.unop).op,
+      ← c.w (hom_of_le $ @inf_le_right _ _ h1.some U.unop).op, ← category.assoc],
+    congr' 1,
+    refine ((if_neg _).symm.rec terminal_is_terminal).hom_ext _ _,
+    exact λ h, h1.some_spec h.1,
+  end,
+  uniq' := λ c f H, begin
+    rw [← category.id_comp f, ← H, ← category.assoc],
+    congr' 1, apply terminal_is_terminal.hom_ext,
+  end }
+
+/--
+If `y ∉ closure {p₀}`, then the stalk of `skyscraper_presheaf p₀ A` at `y` is isomorphic to a
+terminal object.
+-/
+noncomputable def skyscraper_presheaf_stalk_of_not_specializes [has_colimits C]
+  {y : X} (h : ¬p₀ ⤳ y) : (skyscraper_presheaf p₀ A).stalk y ≅ terminal C :=
+colimit.iso_colimit_cocone ⟨_, skyscraper_presheaf_cocone_is_colimit_of_not_specializes _ A h⟩
+
+/--
+If `y ∉ closure {p₀}`, then the stalk of `skyscraper_presheaf p₀ A` at `y` is a terminal object
+-/
+def skyscraper_presheaf_stalk_of_not_specializes_is_terminal
+  [has_colimits C] {y : X} (h : ¬p₀ ⤳ y) : is_terminal ((skyscraper_presheaf p₀ A).stalk y) :=
+is_terminal.of_iso terminal_is_terminal $ (skyscraper_presheaf_stalk_of_not_specializes _ _ h).symm
+
+lemma skyscraper_presheaf_is_sheaf : (skyscraper_presheaf p₀ A).is_sheaf :=
+by classical; exact (presheaf.is_sheaf_iso_iff
+  (eq_to_iso $ skyscraper_presheaf_eq_pushforward p₀ A)).mpr
+  (sheaf.pushforward_sheaf_of_sheaf _ (presheaf.is_sheaf_on_punit_of_is_terminal _
+  (by { dsimp, rw if_neg, exact terminal_is_terminal, exact set.not_mem_empty punit.star })))
+
+/--
+The skyscraper presheaf supported at `p₀` with value `A` is the sheaf that assigns `A` to all opens
+`U` that contain `p₀` and assigns `*` otherwise.
+-/
+def skyscraper_sheaf : sheaf C X :=
+⟨skyscraper_presheaf p₀ A, skyscraper_presheaf_is_sheaf _ _⟩
+
+/--
+Taking skyscraper sheaf at a point is functorial: `c ↦ skyscraper p₀ c` defines a functor by
+sending every `f : a ⟶ b` to the natural transformation `α` defined as: `α(U) = f : a ⟶ b` if
+`p₀ ∈ U` and the unique morphism to a terminal object in `C` if `p₀ ∉ U`.
+-/
+def skyscraper_sheaf_functor : C ⥤ sheaf C X :=
+{ obj := λ c, skyscraper_sheaf p₀ c,
+  map := λ a b f, Sheaf.hom.mk $ (skyscraper_presheaf_functor p₀).map f,
+  map_id' := λ c, Sheaf.hom.ext _ _ $ (skyscraper_presheaf_functor p₀).map_id _,
+  map_comp' := λ _ _ _ f g, Sheaf.hom.ext _ _ $ (skyscraper_presheaf_functor p₀).map_comp _ _ }
+
+namespace stalk_skyscraper_presheaf_adjunction_auxs
+
+variables [has_colimits C]
+
+/--
+If `f : 𝓕.stalk p₀ ⟶ c`, then a natural transformation `𝓕 ⟶ skyscraper_presheaf p₀ c` can be
+defined by: `𝓕.germ p₀ ≫ f : 𝓕(U) ⟶ c` if `p₀ ∈ U` and the unique morphism to a terminal object
+if `p₀ ∉ U`.
+-/
+@[simps] def to_skyscraper_presheaf {𝓕 : presheaf C X} {c : C} (f : 𝓕.stalk p₀ ⟶ c) :
+  𝓕 ⟶ skyscraper_presheaf p₀ c :=
+{ app := λ U, if h : p₀ ∈ U.unop
+    then 𝓕.germ ⟨p₀, h⟩ ≫ f ≫ eq_to_hom (if_pos h).symm
+    else ((if_neg h).symm.rec terminal_is_terminal).from _,
+  naturality' := λ U V inc,
+  begin
+    dsimp, by_cases hV : p₀ ∈ V.unop,
+    { have hU : p₀ ∈ U.unop := le_of_hom inc.unop hV, split_ifs,
+      erw [←category.assoc, 𝓕.germ_res inc.unop, category.assoc, category.assoc, eq_to_hom_trans],
+      refl, },
+    { split_ifs, apply ((if_neg hV).symm.rec terminal_is_terminal).hom_ext },
+  end }
+
+/--
+If `f : 𝓕 ⟶ skyscraper_presheaf p₀ c` is a natural transformation, then there is a morphism
+`𝓕.stalk p₀ ⟶ c` defined as the morphism from colimit to cocone at `c`.
+-/
+def from_stalk {𝓕 : presheaf C X} {c : C} (f : 𝓕 ⟶ skyscraper_presheaf p₀ c) :
+  𝓕.stalk p₀ ⟶ c :=
+let χ : cocone ((open_nhds.inclusion p₀).op ⋙ 𝓕) := cocone.mk c $
+{ app := λ U, f.app (op U.unop.1) ≫ eq_to_hom (if_pos U.unop.2),
+  naturality' := λ U V inc,
+  begin
+    dsimp, erw [category.comp_id, ←category.assoc, comp_eq_to_hom_iff, category.assoc,
+      eq_to_hom_trans, f.naturality, skyscraper_presheaf_map],
+    have hV : p₀ ∈ (open_nhds.inclusion p₀).obj V.unop := V.unop.2, split_ifs,
+    simpa only [comp_eq_to_hom_iff, category.assoc, eq_to_hom_trans, eq_to_hom_refl,
+      category.comp_id],
+  end } in colimit.desc _ χ
+
+lemma to_skyscraper_from_stalk {𝓕 : presheaf C X} {c : C} (f : 𝓕 ⟶ skyscraper_presheaf p₀ c) :
+  to_skyscraper_presheaf p₀ (from_stalk _ f) = f :=
+nat_trans.ext _ _ $ funext $ λ U, (em (p₀ ∈ U.unop)).elim
+(λ h, by { dsimp, split_ifs, erw [←category.assoc, colimit.ι_desc, category.assoc,
+  eq_to_hom_trans, eq_to_hom_refl, category.comp_id], refl }) $
+λ h, by { dsimp, split_ifs, apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext }
+
+lemma from_stalk_to_skyscraper {𝓕 : presheaf C X} {c : C} (f : 𝓕.stalk p₀ ⟶ c) :
+  from_stalk p₀ (to_skyscraper_presheaf _ f) = f :=
+colimit.hom_ext $ λ U, by { erw [colimit.ι_desc], dsimp, rw dif_pos U.unop.2, rw [category.assoc,
+  category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id, presheaf.germ], congr' 3,
+  apply_fun opposite.unop using unop_injective, rw [unop_op], ext, refl }
+
+/--
+The unit in `presheaf.stalk ⊣ skyscraper_presheaf_functor`
+-/
+@[simps] protected def unit :
+  𝟭 (presheaf C X) ⟶ presheaf.stalk_functor C p₀ ⋙ skyscraper_presheaf_functor p₀ :=
+{ app := λ 𝓕, to_skyscraper_presheaf _ $ 𝟙 _,
+  naturality' := λ 𝓕 𝓖 f,
+  begin
+    ext U, dsimp, split_ifs,
+    { simp only [category.id_comp, ←category.assoc], rw [comp_eq_to_hom_iff],
+      simp only [category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id],
+      erw [colimit.ι_map], refl, },
+    { apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext, },
+  end }
+
+/--
+The counit in `presheaf.stalk ⊣ skyscraper_presheaf_functor`
+-/
+@[simps] protected def counit :
+  (skyscraper_presheaf_functor p₀ ⋙ (presheaf.stalk_functor C p₀ : presheaf C X ⥤ C)) ⟶ 𝟭 C :=
+{ app := λ c, (skyscraper_presheaf_stalk_of_specializes p₀ c specializes_rfl).hom,
+  naturality' := λ x y f, colimit.hom_ext $ λ U,
+  begin
+    erw [←category.assoc, colimit.ι_map, colimit.iso_colimit_cocone_ι_hom_assoc,
+      skyscraper_presheaf_cocone_of_specializes_ι_app, category.assoc, colimit.ι_desc,
+      whiskering_left_obj_map, whisker_left_app, skyscraper_presheaf_functor.map'_app,
+      dif_pos U.unop.2, skyscraper_presheaf_cocone_of_specializes_ι_app, comp_eq_to_hom_iff,
+      category.assoc, eq_to_hom_comp_iff, ←category.assoc, eq_to_hom_trans, eq_to_hom_refl,
+      category.id_comp, comp_eq_to_hom_iff, category.assoc, eq_to_hom_trans, eq_to_hom_refl,
+      category.comp_id, category_theory.functor.id_map],
+  end }
+
+end stalk_skyscraper_presheaf_adjunction_auxs
+
+section
+
+open stalk_skyscraper_presheaf_adjunction_auxs
+
+/--
+`skyscraper_presheaf_functor` is the right adjoint of `presheaf.stalk_functor`
+-/
+def skyscraper_presheaf_stalk_adjunction [has_colimits C] :
+  (presheaf.stalk_functor C p₀ : presheaf C X ⥤ C) ⊣ skyscraper_presheaf_functor p₀ :=
+{ hom_equiv := λ c 𝓕,
+  { to_fun := to_skyscraper_presheaf _,
+    inv_fun := from_stalk _,
+    left_inv := from_stalk_to_skyscraper _,
+    right_inv := to_skyscraper_from_stalk _ },
+  unit := stalk_skyscraper_presheaf_adjunction_auxs.unit _,
+  counit := stalk_skyscraper_presheaf_adjunction_auxs.counit _,
+  hom_equiv_unit' := λ 𝓕 c α,
+  begin
+    ext U, simp only [equiv.coe_fn_mk, to_skyscraper_presheaf_app, nat_trans.comp_app,
+      skyscraper_presheaf_functor.map'_app, skyscraper_presheaf_functor_map, unit_app], split_ifs,
+    { erw [category.id_comp, ←category.assoc, comp_eq_to_hom_iff, category.assoc, category.assoc,
+        category.assoc,  category.assoc, eq_to_hom_trans, eq_to_hom_refl, category.comp_id,
+        ←category.assoc _ _ α, eq_to_hom_trans, eq_to_hom_refl, category.id_comp], },
+    { apply ((if_neg h).symm.rec terminal_is_terminal).hom_ext }
+  end,
+  hom_equiv_counit' := λ 𝓕 c α,
+  begin
+    ext U, simp only [equiv.coe_fn_symm_mk, counit_app],
+    erw [colimit.ι_desc, ←category.assoc, colimit.ι_map, whisker_left_app, category.assoc,
+      colimit.ι_desc], refl,
+  end }
+
+instance [has_colimits C] : is_right_adjoint (skyscraper_presheaf_functor p₀ : C ⥤ presheaf C X) :=
+⟨_, skyscraper_presheaf_stalk_adjunction _⟩
+
+instance [has_colimits C] : is_left_adjoint (presheaf.stalk_functor C p₀) :=
+⟨_, skyscraper_presheaf_stalk_adjunction _⟩
+
+/--
+Taking stalks of a sheaf is the left adjoint functor to `skyscraper_sheaf_functor`
+-/
+def stalk_skyscraper_sheaf_adjunction [has_colimits C] :
+  sheaf.forget C X ⋙ presheaf.stalk_functor _ p₀ ⊣ skyscraper_sheaf_functor p₀ :=
+{ hom_equiv := λ 𝓕 c,
+  ⟨λ f, ⟨to_skyscraper_presheaf p₀ f⟩, λ g, from_stalk p₀ g.1, from_stalk_to_skyscraper p₀,
+   λ g, by { ext1, apply to_skyscraper_from_stalk }⟩,
+  unit :=
+  { app := λ 𝓕, ⟨(stalk_skyscraper_presheaf_adjunction_auxs.unit p₀).app 𝓕.1⟩,
+    naturality' := λ 𝓐 𝓑 ⟨f⟩,
+      by { ext1, apply (stalk_skyscraper_presheaf_adjunction_auxs.unit p₀).naturality } },
+  counit := stalk_skyscraper_presheaf_adjunction_auxs.counit p₀,
+  hom_equiv_unit' := λ 𝓐 c f,
+    by { ext1, exact (skyscraper_presheaf_stalk_adjunction p₀).hom_equiv_unit },
+  hom_equiv_counit' := λ 𝓐 c f, (skyscraper_presheaf_stalk_adjunction p₀).hom_equiv_counit }
+
+instance [has_colimits C] : is_right_adjoint (skyscraper_sheaf_functor p₀ : C ⥤ sheaf C X) :=
+⟨_, stalk_skyscraper_sheaf_adjunction _⟩
+
+end
+
+end
diff --git a/src/topology/sheaves/stalks.lean b/src/topology/sheaves/stalks.lean
index 620748c163de1..ea3a7426b187a 100644
--- a/src/topology/sheaves/stalks.lean
+++ b/src/topology/sheaves/stalks.lean
@@ -6,22 +6,23 @@ Authors: Scott Morrison, Justus Springer
 import topology.category.Top.open_nhds
 import topology.sheaves.presheaf
 import topology.sheaves.sheaf_condition.unique_gluing
+import category_theory.adjunction.evaluation
 import category_theory.limits.types
 import category_theory.limits.preserves.filtered
 import category_theory.limits.final
-import topology.sober
 import tactic.elementwise
-import algebra.category.Ring
+import algebra.category.Ring.colimits
+import category_theory.sites.pushforward
 
 /-!
 # Stalks
 
-For a presheaf `F` on a topological space `X`, valued in some category `C`, the *stalk* of `F`
-at the point `x : X` is defined as the colimit of the following functor
-
-(nhds x)ᵒᵖ ⥤ (opens X)ᵒᵖ ⥤ C
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 
-where the functor on the left is the inclusion of categories and the functor on the right is `F`.
+For a presheaf `F` on a topological space `X`, valued in some category `C`, the *stalk* of `F`
+at the point `x : X` is defined as the colimit of the composition of the inclusion of categories
+`(nhds x)ᵒᵖ ⥤ (opens X)ᵒᵖ` and the functor `F : (opens X)ᵒᵖ ⥤ C`.
 For an open neighborhood `U` of `x`, we define the map `F.germ x : F.obj (op U) ⟶ F.stalk x` as the
 canonical morphism into this colimit.
 
@@ -158,7 +159,7 @@ begin
   dsimp [stalk_pushforward, stalk_functor],
   ext1,
   tactic.op_induction',
-  cases j, cases j_val,
+  rcases j with ⟨⟨_, _⟩, _⟩,
   rw [colimit.ι_map_assoc, colimit.ι_map, colimit.ι_pre, whisker_left_app, whisker_right_app,
        pushforward.id_hom_app, eq_to_hom_map, eq_to_hom_refl],
   dsimp,
@@ -175,8 +176,7 @@ begin
   dsimp [stalk_pushforward, stalk_functor],
   ext U,
   induction U using opposite.rec,
-  cases U,
-  cases U_val,
+  rcases U with ⟨⟨_, _⟩, _⟩,
   simp only [colimit.ι_map_assoc, colimit.ι_pre_assoc,
              whisker_right_app, category.assoc],
   dsimp,
@@ -197,7 +197,7 @@ lemma stalk_pushforward_iso_of_open_embedding {f : X ⟶ Y} (hf : open_embedding
      { intro U,
        refine F.map_iso (eq_to_iso _),
        dsimp only [functor.op],
-       exact congr_arg op (subtype.eq $ set.preimage_image_eq (unop U).1.1 hf.inj) },
+       exact congr_arg op (opens.ext $ set.preimage_image_eq (unop U).1.1 hf.inj) },
      { intros U V i, erw [← F.map_comp, ← F.map_comp], congr } },
    { ext U,
      rw ← iso.comp_inv_eq,
@@ -260,7 +260,7 @@ def stalk_pullback_iso (f : X ⟶ Y) (F : Y.presheaf C) (x : X) :
     delta stalk_pullback_hom stalk_pullback_inv stalk_functor presheaf.pullback stalk_pushforward,
     ext U j,
     induction U using opposite.rec,
-    cases U, cases j, cases j_right,
+    cases U, cases j, rcases j_right with ⟨⟨⟩⟩,
     erw [colimit.map_desc, colimit.map_desc, colimit.ι_desc_assoc,
       colimit.ι_desc_assoc, colimit.ι_desc, category.comp_id],
     simp only [cocone.whisker_ι, colimit.cocone_ι, open_nhds.inclusion_map_iso_inv,
@@ -276,7 +276,7 @@ def stalk_pullback_iso (f : X ⟶ Y) (F : Y.presheaf C) (x : X) :
     congr,
     simp only [category.assoc, costructured_arrow.map_mk],
     delta costructured_arrow.mk,
-    congr
+    congr,
   end }
 
 end stalk_pullback
@@ -303,12 +303,25 @@ end
 @[simp, reassoc, elementwise]
 lemma germ_stalk_specializes (F : X.presheaf C) {U : opens X} {y : U} {x : X} (h : x ⤳ y) :
   F.germ y ≫ F.stalk_specializes h =
-    F.germ ⟨x, specializes_iff_forall_open.mp h _ U.2 y.prop⟩ := colimit.ι_desc _ _
+    F.germ (⟨x, h.mem_open U.is_open y.prop⟩ : U) := colimit.ι_desc _ _
 
 @[simp, reassoc, elementwise]
 lemma germ_stalk_specializes' (F : X.presheaf C) {U : opens X} {x y : X} (h : x ⤳ y) (hy : y ∈ U) :
   F.germ ⟨y, hy⟩ ≫ F.stalk_specializes h =
-    F.germ ⟨x, specializes_iff_forall_open.mp h _ U.2 hy⟩ := colimit.ι_desc _ _
+    F.germ ⟨x, h.mem_open U.is_open hy⟩ := colimit.ι_desc _ _
+
+@[simp]
+lemma stalk_specializes_refl {C : Type*} [category C] [limits.has_colimits C]
+  {X : Top} (F : X.presheaf C) (x : X) :
+  F.stalk_specializes (specializes_refl x) = 𝟙 _ :=
+F.stalk_hom_ext $ λ _ _, by { dsimp, simpa }
+
+@[simp, reassoc, elementwise]
+lemma stalk_specializes_comp {C : Type*} [category C] [limits.has_colimits C]
+  {X : Top} (F : X.presheaf C)
+  {x y z : X} (h : x ⤳ y) (h' : y ⤳ z) :
+  F.stalk_specializes h' ≫ F.stalk_specializes h = F.stalk_specializes (h.trans h') :=
+F.stalk_hom_ext $ λ _ _, by simp
 
 @[simp, reassoc, elementwise]
 lemma stalk_specializes_stalk_functor_map {F G : X.presheaf C} (f : F ⟶ G) {x y : X} (h : x ⤳ y) :
@@ -318,10 +331,17 @@ by { ext, delta stalk_functor, simpa [stalk_specializes] }
 
 @[simp, reassoc, elementwise]
 lemma stalk_specializes_stalk_pushforward (f : X ⟶ Y) (F : X.presheaf C) {x y : X} (h : x ⤳ y) :
-  (f _* F).stalk_specializes (f.map_specialization h) ≫ F.stalk_pushforward _ f x =
+  (f _* F).stalk_specializes (f.map_specializes h) ≫ F.stalk_pushforward _ f x =
     F.stalk_pushforward _ f y ≫ F.stalk_specializes h :=
 by { ext, delta stalk_pushforward, simpa [stalk_specializes] }
 
+/-- The stalks are isomorphic on inseparable points -/
+@[simps]
+def stalk_congr {X : Top} {C : Type*} [category C] [has_colimits C]
+  (F : X.presheaf C) {x y : X}
+  (e : inseparable x y) : F.stalk x ≅ F.stalk y :=
+⟨F.stalk_specializes e.ge, F.stalk_specializes e.le, by simp, by simp⟩
+
 end stalk_specializes
 
 section concrete
@@ -348,7 +368,7 @@ every element of the stalk is the germ of a section.
 lemma germ_exist (F : X.presheaf C) (x : X) (t : stalk F x) :
   ∃ (U : opens X) (m : x ∈ U) (s : F.obj (op U)), F.germ ⟨x, m⟩ s = t :=
 begin
-  obtain ⟨U, s, e⟩ := types.jointly_surjective _
+  obtain ⟨U, s, e⟩ := types.jointly_surjective.{v v} _
     (is_colimit_of_preserves (forget C) (colimit.is_colimit _)) t,
   revert s e,
   rw [(show U = op (unop U), from rfl)],
@@ -363,7 +383,7 @@ lemma germ_eq (F : X.presheaf C) {U V : opens X} (x : X) (mU : x ∈ U) (mV : x
   (h : germ F ⟨x, mU⟩ s = germ F ⟨x, mV⟩ t) :
   ∃ (W : opens X) (m : x ∈ W) (iU : W ⟶ U) (iV : W ⟶ V), F.map iU.op s = F.map iV.op t :=
 begin
-  obtain ⟨W, iU, iV, e⟩ := (types.filtered_colimit.is_colimit_eq_iff _
+  obtain ⟨W, iU, iV, e⟩ := (types.filtered_colimit.is_colimit_eq_iff.{v v} _
     (is_colimit_of_preserves _ (colimit.is_colimit ((open_nhds.inclusion x).op ⋙ F)))).mp h,
   exact ⟨(unop W).1, (unop W).2, iU.unop, iV.unop, e⟩,
 end
@@ -391,17 +411,17 @@ Let `F` be a sheaf valued in a concrete category, whose forgetful functor reflec
 preserves limits and filtered colimits. Then two sections who agree on every stalk must be equal.
 -/
 lemma section_ext (F : sheaf C X) (U : opens X) (s t : F.1.obj (op U))
-  (h : ∀ x : U, F.1.germ x s = F.1.germ x t) :
+  (h : ∀ x : U, F.presheaf.germ x s = F.presheaf.germ x t) :
   s = t :=
 begin
   -- We use `germ_eq` and the axiom of choice, to pick for every point `x` a neighbourhood
   -- `V x`, such that the restrictions of `s` and `t` to `V x` coincide.
-  choose V m i₁ i₂ heq using λ x : U, F.1.germ_eq x.1 x.2 x.2 s t (h x),
+  choose V m i₁ i₂ heq using λ x : U, F.presheaf.germ_eq x.1 x.2 x.2 s t (h x),
   -- Since `F` is a sheaf, we can prove the equality locally, if we can show that these
   -- neighborhoods form a cover of `U`.
   apply F.eq_of_locally_eq' V U i₁,
   { intros x hxU,
-    rw [opens.mem_coe, opens.mem_supr],
+    rw [opens.mem_supr],
     exact ⟨⟨x, hxU⟩, m ⟨x, hxU⟩⟩ },
   { intro x,
     rw [heq, subsingleton.elim (i₁ x) (i₂ x)] }
@@ -425,15 +445,38 @@ lemma app_injective_iff_stalk_functor_map_injective {F : sheaf C X}
 ⟨λ h U, app_injective_of_stalk_functor_map_injective f U (λ x, h x.1),
   stalk_functor_map_injective_of_app_injective f⟩
 
+instance stalk_functor_preserves_mono (x : X) :
+  functor.preserves_monomorphisms (sheaf.forget C X ⋙ stalk_functor C x) :=
+⟨λ 𝓐 𝓑 f m, concrete_category.mono_of_injective _ $
+  (app_injective_iff_stalk_functor_map_injective f.1).mpr
+    (λ c, (@@concrete_category.mono_iff_injective_of_preserves_pullback _ _ (f.1.app (op c)) _).mp
+      ((nat_trans.mono_iff_mono_app _ f.1).mp
+        (@@category_theory.presheaf_mono_of_mono _ _ _ _ _ _ _ _ _ _ _ m) $ op c)) x⟩
+
+lemma stalk_mono_of_mono {F G : sheaf C X} (f : F ⟶ G) [mono f] :
+  Π x, mono $ (stalk_functor C x).map f.1 :=
+λ x, by convert functor.map_mono (sheaf.forget.{v} C X ⋙ stalk_functor C x) f
+
+lemma mono_of_stalk_mono {F G : sheaf C X} (f : F ⟶ G)
+  [Π x, mono $ (stalk_functor C x).map f.1] : mono f :=
+(Sheaf.hom.mono_iff_presheaf_mono _ _ _).mpr $ (nat_trans.mono_iff_mono_app _ _).mpr $ λ U,
+  (concrete_category.mono_iff_injective_of_preserves_pullback _).mpr $
+  app_injective_of_stalk_functor_map_injective f.1 U.unop $ λ ⟨x, hx⟩,
+  (concrete_category.mono_iff_injective_of_preserves_pullback _).mp $ infer_instance
+
+lemma mono_iff_stalk_mono {F G : sheaf C X} (f : F ⟶ G) :
+  mono f ↔ ∀ x, mono ((stalk_functor C x).map f.1) :=
+⟨by { introI m, exact stalk_mono_of_mono _ }, by { introI m, exact mono_of_stalk_mono _ }⟩
+
 /-- For surjectivity, we are given an arbitrary section `t` and need to find a preimage for it.
 We claim that it suffices to find preimages *locally*. That is, for each `x : U` we construct
 a neighborhood `V ≤ U` and a section `s : F.obj (op V))` such that `f.app (op V) s` and `t`
 agree on `V`. -/
 lemma app_surjective_of_injective_of_locally_surjective {F G : sheaf C X} (f : F ⟶ G)
-  (U : opens X) (hinj : ∀ x : U, function.injective ((stalk_functor C x.1).map f))
+  (U : opens X) (hinj : ∀ x : U, function.injective ((stalk_functor C x.1).map f.1))
   (hsurj : ∀ (t) (x : U), ∃ (V : opens X) (m : x.1 ∈ V) (iVU : V ⟶ U) (s : F.1.obj (op V)),
-    f.app (op V) s = G.1.map iVU.op t) :
-  function.surjective (f.app (op U)) :=
+    f.1.app (op V) s = G.1.map iVU.op t) :
+  function.surjective (f.1.app (op U)) :=
 begin
   intro t,
   -- We use the axiom of choice to pick around each point `x` an open neighborhood `V` and a
@@ -442,14 +485,14 @@ begin
   -- These neighborhoods clearly cover all of `U`.
   have V_cover : U ≤ supr V,
   { intros x hxU,
-    rw [opens.mem_coe, opens.mem_supr],
+    rw [opens.mem_supr],
     exact ⟨⟨x, hxU⟩, mV ⟨x, hxU⟩⟩ },
   -- Since `F` is a sheaf, we can glue all the local preimages together to get a global preimage.
   obtain ⟨s, s_spec, -⟩ := F.exists_unique_gluing' V U iVU V_cover sf _,
   { use s,
     apply G.eq_of_locally_eq' V U iVU V_cover,
     intro x,
-    rw [← comp_apply, ← f.naturality, comp_apply, s_spec, heq] },
+    rw [← comp_apply, ← f.1.naturality, comp_apply, s_spec, heq] },
   { intros x y,
     -- What's left to show here is that the secions `sf` are compatible, i.e. they agree on
     -- the intersections `V x ⊓ V y`. We prove this by showing that all germs are equal.
@@ -459,48 +502,48 @@ begin
     apply (hinj ⟨z, (iVU x).le ((inf_le_left : V x ⊓ V y ≤ V x) z.2)⟩),
     dsimp only,
     erw [stalk_functor_map_germ_apply, stalk_functor_map_germ_apply],
-    simp_rw [← comp_apply, f.naturality, comp_apply, heq, ← comp_apply, ← G.1.map_comp],
+    simp_rw [← comp_apply, f.1.naturality, comp_apply, heq, ← comp_apply, ← G.1.map_comp],
     refl }
 end
 
 lemma app_surjective_of_stalk_functor_map_bijective {F G : sheaf C X} (f : F ⟶ G)
-  (U : opens X) (h : ∀ x : U, function.bijective ((stalk_functor C x.val).map f)) :
-  function.surjective (f.app (op U)) :=
+  (U : opens X) (h : ∀ x : U, function.bijective ((stalk_functor C x.val).map f.1)) :
+  function.surjective (f.1.app (op U)) :=
 begin
   refine app_surjective_of_injective_of_locally_surjective f U (λ x, (h x).1) (λ t x, _),
   -- Now we need to prove our initial claim: That we can find preimages of `t` locally.
   -- Since `f` is surjective on stalks, we can find a preimage `s₀` of the germ of `t` at `x`
-  obtain ⟨s₀,hs₀⟩ := (h x).2 (G.1.germ x t),
+  obtain ⟨s₀,hs₀⟩ := (h x).2 (G.presheaf.germ x t),
   -- ... and this preimage must come from some section `s₁` defined on some open neighborhood `V₁`
-  obtain ⟨V₁,hxV₁,s₁,hs₁⟩ := F.1.germ_exist x.1 s₀,
+  obtain ⟨V₁,hxV₁,s₁,hs₁⟩ := F.presheaf.germ_exist x.1 s₀,
   subst hs₁, rename hs₀ hs₁,
-  erw stalk_functor_map_germ_apply V₁ ⟨x.1,hxV₁⟩ f s₁ at hs₁,
+  erw stalk_functor_map_germ_apply V₁ ⟨x.1,hxV₁⟩ f.1 s₁ at hs₁,
   -- Now, the germ of `f.app (op V₁) s₁` equals the germ of `t`, hence they must coincide on
   -- some open neighborhood `V₂`.
-  obtain ⟨V₂, hxV₂, iV₂V₁, iV₂U, heq⟩ := G.1.germ_eq x.1 hxV₁ x.2 _ _ hs₁,
+  obtain ⟨V₂, hxV₂, iV₂V₁, iV₂U, heq⟩ := G.presheaf.germ_eq x.1 hxV₁ x.2 _ _ hs₁,
   -- The restriction of `s₁` to that neighborhood is our desired local preimage.
   use [V₂, hxV₂, iV₂U, F.1.map iV₂V₁.op s₁],
-  rw [← comp_apply, f.naturality, comp_apply, heq],
+  rw [← comp_apply, f.1.naturality, comp_apply, heq],
 end
 
 lemma app_bijective_of_stalk_functor_map_bijective {F G : sheaf C X} (f : F ⟶ G)
-   (U : opens X) (h : ∀ x : U, function.bijective ((stalk_functor C x.val).map f)) :
-  function.bijective (f.app (op U)) :=
-⟨app_injective_of_stalk_functor_map_injective f U (λ x, (h x).1),
+   (U : opens X) (h : ∀ x : U, function.bijective ((stalk_functor C x.val).map f.1)) :
+  function.bijective (f.1.app (op U)) :=
+⟨app_injective_of_stalk_functor_map_injective f.1 U (λ x, (h x).1),
   app_surjective_of_stalk_functor_map_bijective f U h⟩
 
 lemma app_is_iso_of_stalk_functor_map_iso {F G : sheaf C X} (f : F ⟶ G) (U : opens X)
-  [∀ x : U, is_iso ((stalk_functor C x.val).map f)] : is_iso (f.app (op U)) :=
+  [∀ x : U, is_iso ((stalk_functor C x.val).map f.1)] : is_iso (f.1.app (op U)) :=
 begin
   -- Since the forgetful functor of `C` reflects isomorphisms, it suffices to see that the
   -- underlying map between types is an isomorphism, i.e. bijective.
-  suffices : is_iso ((forget C).map (f.app (op U))),
-  { exactI is_iso_of_reflects_iso (f.app (op U)) (forget C) },
+  suffices : is_iso ((forget C).map (f.1.app (op U))),
+  { exactI is_iso_of_reflects_iso (f.1.app (op U)) (forget C) },
   rw is_iso_iff_bijective,
   apply app_bijective_of_stalk_functor_map_bijective,
   intro x,
   apply (is_iso_iff_bijective _).mp,
-  exact functor.map_is_iso (forget C) ((stalk_functor C x.1).map f)
+  exact functor.map_is_iso (forget C) ((stalk_functor C x.1).map f.1)
 end
 
 /--
@@ -510,15 +553,15 @@ isomorphisms, preserves limits and filtered colimits. Then if the stalk maps of
 -/
 -- Making this an instance would cause a loop in typeclass resolution with `functor.map_is_iso`
 lemma is_iso_of_stalk_functor_map_iso {F G : sheaf C X} (f : F ⟶ G)
-  [∀ x : X, is_iso ((stalk_functor C x).map f)] : is_iso f :=
+  [∀ x : X, is_iso ((stalk_functor C x).map f.1)] : is_iso f :=
 begin
   -- Since the inclusion functor from sheaves to presheaves is fully faithful, it suffices to
   -- show that `f`, as a morphism between _presheaves_, is an isomorphism.
   suffices : is_iso ((sheaf.forget C X).map f),
   { exactI is_iso_of_fully_faithful (sheaf.forget C X) f },
   -- We show that all components of `f` are isomorphisms.
-  suffices : ∀ U : (opens X)ᵒᵖ, is_iso (f.app U),
-  { exact @nat_iso.is_iso_of_is_iso_app _ _ _ _ F.1 G.1 f this, },
+  suffices : ∀ U : (opens X)ᵒᵖ, is_iso (f.1.app U),
+  { exact @nat_iso.is_iso_of_is_iso_app _ _ _ _ F.1 G.1 f.1 this, },
   intro U, induction U using opposite.rec,
   apply app_is_iso_of_stalk_functor_map_iso
 end
@@ -529,11 +572,11 @@ isomorphisms, preserves limits and filtered colimits. Then a morphism `f : F ⟶
 isomorphism if and only if all of its stalk maps are isomorphisms.
 -/
 lemma is_iso_iff_stalk_functor_map_iso {F G : sheaf C X} (f : F ⟶ G) :
-  is_iso f ↔ ∀ x : X, is_iso ((stalk_functor C x).map f) :=
+  is_iso f ↔ ∀ x : X, is_iso ((stalk_functor C x).map f.1) :=
 begin
   split,
   { intros h x, resetI,
-    exact @functor.map_is_iso _ _ _ _ _ _ (stalk_functor C x) f
+    exact @functor.map_is_iso _ _ _ _ _ _ (stalk_functor C x) f.1
       ((sheaf.forget C X).map_is_iso f) },
   { intro h,
     exactI is_iso_of_stalk_functor_map_iso f }
diff --git a/src/topology/shrinking_lemma.lean b/src/topology/shrinking_lemma.lean
index 31c7f0514b6d4..0212e4856a501 100644
--- a/src/topology/shrinking_lemma.lean
+++ b/src/topology/shrinking_lemma.lean
@@ -8,6 +8,9 @@ import topology.separation
 /-!
 # The shrinking lemma
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove a few versions of the shrinking lemma. The lemma says that in a normal
 topological space a point finite open covering can be “shrunk”: for a point finite open covering
 `u : ι → set X` there exists a refinement `v : ι → set X` such that `closure (v i) ⊆ u i`.
@@ -45,7 +48,7 @@ namespace shrinking_lemma
 This type is equipped with the folowing partial order: `v ≤ v'` if `v.carrier ⊆ v'.carrier`
 and `v i = v' i` for `i ∈ v.carrier`. We will use Zorn's lemma to prove that this type has
 a maximal element, then show that the maximal element must have `carrier = univ`. -/
-@[nolint has_inhabited_instance] -- the trivial refinement needs `u` to be a covering
+@[nolint has_nonempty_instance] -- the trivial refinement needs `u` to be a covering
 structure partial_refinement (u : ι → set X) (s : set X) :=
 (to_fun : ι → set X)
 (carrier : set ι)
@@ -94,7 +97,8 @@ lemma apply_eq_of_chain {c : set (partial_refinement u s)} (hc : is_chain (≤)
   (h₁ : v₁ ∈ c) (h₂ : v₂ ∈ c) {i} (hi₁ : i ∈ v₁.carrier) (hi₂ : i ∈ v₂.carrier) :
   v₁ i = v₂ i :=
 begin
-  wlog hle : v₁ ≤ v₂ := hc.total h₁ h₂ using [v₁ v₂, v₂ v₁],
+  wlog hle : v₁ ≤ v₂,
+  { cases hc.total h₁ h₂; [skip, symmetry]; apply_assumption; assumption' },
   exact hle.2 _ hi₁,
 end
 
@@ -134,7 +138,7 @@ apply_eq_of_chain hc (find_mem _ _) hv
 
 /-- Least upper bound of a nonempty chain of partial refinements. -/
 def chain_Sup (c : set (partial_refinement u s)) (hc : is_chain (≤) c)
-  (ne : c.nonempty) (hfin : ∀ x ∈ s, finite {i | x ∈ u i}) (hU : s ⊆ ⋃ i, u i) :
+  (ne : c.nonempty) (hfin : ∀ x ∈ s, {i | x ∈ u i}.finite) (hU : s ⊆ ⋃ i, u i) :
   partial_refinement u s :=
 begin
   refine ⟨λ i, find c ne i i, chain_Sup_carrier c,
@@ -160,7 +164,7 @@ end
 
 /-- `chain_Sup hu c hc ne hfin hU` is an upper bound of the chain `c`. -/
 lemma le_chain_Sup {c : set (partial_refinement u s)} (hc : is_chain (≤) c)
-  (ne : c.nonempty) (hfin : ∀ x ∈ s, finite {i | x ∈ u i}) (hU : s ⊆ ⋃ i, u i)
+  (ne : c.nonempty) (hfin : ∀ x ∈ s, {i | x ∈ u i}.finite) (hU : s ⊆ ⋃ i, u i)
   {v} (hv : v ∈ c) :
   v ≤ chain_Sup c hc ne hfin hU :=
 ⟨λ i hi, mem_bUnion hv hi, λ i hi, (find_apply_of_mem hc _ hv hi).symm⟩
@@ -171,7 +175,7 @@ lemma exists_gt (v : partial_refinement u s) (hs : is_closed s) (i : ι) (hi : i
   ∃ v' : partial_refinement u s, v < v' :=
 begin
   have I : s ∩ (⋂ j ≠ i, (v j)ᶜ) ⊆ v i,
-  { simp only [subset_def, mem_inter_eq, mem_Inter, and_imp],
+  { simp only [subset_def, mem_inter_iff, mem_Inter, and_imp],
     intros x hxs H,
     rcases mem_Union.1 (v.subset_Union hxs) with ⟨j, hj⟩,
     exact (em (j = i)).elim (λ h, h ▸ hj) (λ h, (H j h hj).elim) },
@@ -207,7 +211,7 @@ variables {u : ι → set X} {s : set X}
 to a new open cover so that the closure of each new open set is contained in the corresponding
 original open set. -/
 lemma exists_subset_Union_closure_subset (hs : is_closed s) (uo : ∀ i, is_open (u i))
-  (uf : ∀ x ∈ s, finite {i | x ∈ u i}) (us : s ⊆ ⋃ i, u i) :
+  (uf : ∀ x ∈ s, {i | x ∈ u i}.finite) (us : s ⊆ ⋃ i, u i) :
   ∃ v : ι → set X, s ⊆ Union v ∧ (∀ i, is_open (v i)) ∧ ∀ i, closure (v i) ⊆ u i :=
 begin
   classical,
@@ -228,7 +232,7 @@ end
 to a new closed cover so that each new closed set is contained in the corresponding original open
 set. See also `exists_subset_Union_closure_subset` for a stronger statement. -/
 lemma exists_subset_Union_closed_subset (hs : is_closed s) (uo : ∀ i, is_open (u i))
-  (uf : ∀ x ∈ s, finite {i | x ∈ u i}) (us : s ⊆ ⋃ i, u i) :
+  (uf : ∀ x ∈ s, {i | x ∈ u i}.finite) (us : s ⊆ ⋃ i, u i) :
   ∃ v : ι → set X, s ⊆ Union v ∧ (∀ i, is_closed (v i)) ∧ ∀ i, v i ⊆ u i :=
 let ⟨v, hsv, hvo, hv⟩ := exists_subset_Union_closure_subset hs uo uf us
 in ⟨λ i, closure (v i), subset.trans hsv (Union_mono $ λ i, subset_closure),
@@ -237,7 +241,7 @@ in ⟨λ i, closure (v i), subset.trans hsv (Union_mono $ λ i, subset_closure),
 /-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
 to a new open cover so that the closure of each new open set is contained in the corresponding
 original open set. -/
-lemma exists_Union_eq_closure_subset (uo : ∀ i, is_open (u i)) (uf : ∀ x, finite {i | x ∈ u i})
+lemma exists_Union_eq_closure_subset (uo : ∀ i, is_open (u i)) (uf : ∀ x, {i | x ∈ u i}.finite)
   (uU : (⋃ i, u i) = univ) :
   ∃ v : ι → set X, Union v = univ ∧ (∀ i, is_open (v i)) ∧ ∀ i, closure (v i) ⊆ u i :=
 let ⟨v, vU, hv⟩ := exists_subset_Union_closure_subset is_closed_univ uo (λ x _, uf x) uU.ge
@@ -246,7 +250,7 @@ in ⟨v, univ_subset_iff.1 vU, hv⟩
 /-- Shrinking lemma. A point-finite open cover of a closed subset of a normal space can be "shrunk"
 to a new closed cover so that each of the new closed sets is contained in the corresponding
 original open set. See also `exists_Union_eq_closure_subset` for a stronger statement. -/
-lemma exists_Union_eq_closed_subset (uo : ∀ i, is_open (u i)) (uf : ∀ x, finite {i | x ∈ u i})
+lemma exists_Union_eq_closed_subset (uo : ∀ i, is_open (u i)) (uf : ∀ x, {i | x ∈ u i}.finite)
   (uU : (⋃ i, u i) = univ) :
   ∃ v : ι → set X, Union v = univ ∧ (∀ i, is_closed (v i)) ∧ ∀ i, v i ⊆ u i :=
 let ⟨v, vU, hv⟩ := exists_subset_Union_closed_subset is_closed_univ uo (λ x _, uf x) uU.ge
diff --git a/src/topology/sober.lean b/src/topology/sober.lean
index b08a4f9582aa5..853321809143a 100644
--- a/src/topology/sober.lean
+++ b/src/topology/sober.lean
@@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Andrew Yang
 -/
 import topology.separation
-import topology.continuous_function.basic
 
 /-!
 # Sober spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A quasi-sober space is a topological space where every
 irreducible closed subset has a generic point.
 A sober space is a quasi-sober space where every irreducible closed subset
@@ -17,99 +19,14 @@ stated via `[quasi_sober α] [t0_space α]`.
 
 ## Main definition
 
-* `specializes` : `specializes x y` (`x ⤳ y`) means that `x` specializes to `y`, i.e.
-  `y` is in the closure of `x`.
-* `specialization_preorder` : specialization gives a preorder on a topological space.
-* `specialization_order` : specialization gives a partial order on a T0 space.
 * `is_generic_point` : `x` is the generic point of `S` if `S` is the closure of `x`.
 * `quasi_sober` : A space is quasi-sober if every irreducible closed subset has a generic point.
 
 -/
 
-variables {α β : Type*} [topological_space α] [topological_space β]
-
-section specialize_order
-
-/-- `x` specializes to `y` if `y` is in the closure of `x`. The notation used is `x ⤳ y`. -/
-def specializes (x y : α) : Prop := y ∈ closure ({x} : set α)
-
-infix ` ⤳ `:300 := specializes
-
-lemma specializes_def (x y : α) : x ⤳ y ↔ y ∈ closure ({x} : set α) := iff.rfl
-
-lemma specializes_iff_closure_subset {x y : α} :
-  x ⤳ y ↔ closure ({y} : set α) ⊆ closure ({x} : set α) :=
-is_closed_closure.mem_iff_closure_subset
-
-lemma specializes_rfl {x : α} : x ⤳ x := subset_closure (set.mem_singleton x)
-
-lemma specializes_refl (x : α) : x ⤳ x := specializes_rfl
-
-lemma specializes.trans {x y z : α} : x ⤳ y → y ⤳ z → x ⤳ z :=
-by { simp_rw specializes_iff_closure_subset, exact λ a b, b.trans a }
-
-lemma specializes_iff_forall_closed {x y : α} :
-  x ⤳ y ↔ ∀ (Z : set α) (h : is_closed Z), x ∈ Z → y ∈ Z :=
-begin
-  split,
-  { intros h Z hZ,
-    rw [hZ.mem_iff_closure_subset, hZ.mem_iff_closure_subset],
-    exact (specializes_iff_closure_subset.mp h).trans },
-  { intro h, exact h _ is_closed_closure (subset_closure $ set.mem_singleton x) }
-end
-
-lemma specializes_iff_forall_open {x y : α} :
-  x ⤳ y ↔ ∀ (U : set α) (h : is_open U), y ∈ U → x ∈ U :=
-begin
-  rw specializes_iff_forall_closed,
-  exact ⟨λ h U hU, not_imp_not.mp (h _ (is_closed_compl_iff.mpr hU)),
-    λ h U hU, not_imp_not.mp (h _ (is_open_compl_iff.mpr hU))⟩,
-end
-
-lemma indistinguishable_iff_specializes_and (x y : α) :
-  indistinguishable x y ↔ x ⤳ y ∧ y ⤳ x :=
-(indistinguishable_iff_closure x y).trans (and_comm _ _)
-
-lemma specializes_antisymm [t0_space α] (x y : α) : x ⤳ y → y ⤳ x → x = y :=
-λ h₁ h₂, ((indistinguishable_iff_specializes_and _ _).mpr ⟨h₁, h₂⟩).eq
-
-lemma specializes.map {x y : α} (h : x ⤳ y) {f : α → β} (hf : continuous f) : f x ⤳ f y :=
-begin
-  rw [specializes_def, ← set.image_singleton],
-  exact image_closure_subset_closure_image hf ⟨_, h, rfl⟩,
-end
-
-lemma continuous_map.map_specialization {x y : α} (h : x ⤳ y) (f : C(α, β)) : f x ⤳ f y :=
-h.map f.2
-
-lemma specializes.eq [t1_space α] {x y : α} (h : x ⤳ y) : x = y :=
-(set.mem_singleton_iff.mp
-  ((specializes_iff_forall_closed.mp h) _ (t1_space.t1 _) (set.mem_singleton _))).symm
-
-@[simp] lemma specializes_iff_eq [t1_space α] {x y : α} : x ⤳ y ↔ x = y :=
-⟨specializes.eq, λ h, h ▸ specializes_refl _⟩
-
-variable (α)
-
-/-- Specialization forms a preorder on the topological space. -/
-def specialization_preorder : preorder α :=
-{ le := λ x y, y ⤳ x,
-  le_refl := λ x, specializes_refl x,
-  le_trans := λ _ _ _ h₁ h₂, specializes.trans h₂ h₁ }
-
-local attribute [instance] specialization_preorder
-
-/-- Specialization forms a partial order on a t0 topological space. -/
-def specialization_order [t0_space α] : partial_order α :=
-{ le_antisymm := λ _ _ h₁ h₂, specializes_antisymm _ _ h₂ h₁,
-  .. specialization_preorder α }
+open set
 
-variable {α}
-
-lemma specialization_order.monotone_of_continuous (f : α → β) (hf : continuous f) : monotone f :=
-λ x y h, specializes.map h hf
-
-end specialize_order
+variables {α β : Type*} [topological_space α] [topological_space β]
 
 section generic_point
 
@@ -124,61 +41,59 @@ lemma is_generic_point.def {x : α} {S : set α} (h : is_generic_point x S) :
 
 lemma is_generic_point_closure {x : α} : is_generic_point x (closure ({x} : set α)) := refl _
 
-variables {x : α} {S : set α} (h : is_generic_point x S)
+variables {x y : α} {S U Z : set α}
+
+lemma is_generic_point_iff_specializes :
+  is_generic_point x S ↔ ∀ y, x ⤳ y ↔ y ∈ S :=
+by simp only [specializes_iff_mem_closure, is_generic_point, set.ext_iff]
 
-include h
+namespace is_generic_point
 
-lemma is_generic_point.specializes {y : α} (h' : y ∈ S) :
-  x ⤳ y := by rwa ← h.def at h'
+lemma specializes_iff_mem (h : is_generic_point x S) : x ⤳ y ↔ y ∈ S :=
+is_generic_point_iff_specializes.1 h y
 
-lemma is_generic_point.mem : x ∈ S :=
-h.def ▸ subset_closure (set.mem_singleton x)
+lemma specializes (h : is_generic_point x S) (h' : y ∈ S) : x ⤳ y :=
+h.specializes_iff_mem.2 h'
 
-lemma is_generic_point.is_closed : is_closed S :=
+lemma mem (h : is_generic_point x S) : x ∈ S :=
+h.specializes_iff_mem.1 specializes_rfl
+
+protected lemma is_closed (h : is_generic_point x S) : is_closed S :=
 h.def ▸ is_closed_closure
 
-lemma is_generic_point.is_irreducible : is_irreducible S :=
+protected lemma is_irreducible (h : is_generic_point x S) : is_irreducible S :=
 h.def ▸ is_irreducible_singleton.closure
 
-lemma is_generic_point.eq [t0_space α] {y : α} (h' : is_generic_point y S) : x = y :=
-specializes_antisymm _ _ (h.specializes h'.mem) (h'.specializes h.mem)
+/-- In a T₀ space, each set has at most one generic point. -/
+protected lemma eq [t0_space α] (h : is_generic_point x S) (h' : is_generic_point y S) : x = y :=
+((h.specializes h'.mem).antisymm (h'.specializes h.mem)).eq
 
-lemma is_generic_point.mem_open_set_iff
-  {U : set α} (hU : is_open U) : x ∈ U ↔ (S ∩ U).nonempty :=
-⟨λ h', ⟨x, h.mem, h'⟩,
-    λ h', specializes_iff_forall_open.mp (h.specializes h'.some_spec.1) U hU h'.some_spec.2⟩
+lemma mem_open_set_iff (h : is_generic_point x S) (hU : is_open U) :
+  x ∈ U ↔ (S ∩ U).nonempty :=
+⟨λ h', ⟨x, h.mem, h'⟩, λ ⟨y, hyS, hyU⟩, (h.specializes hyS).mem_open hU hyU⟩
 
-lemma is_generic_point.disjoint_iff
-  {U : set α} (hU : is_open U) : disjoint S U ↔ x ∉ U :=
-by rw [h.mem_open_set_iff hU, ← set.ne_empty_iff_nonempty, not_not, set.disjoint_iff_inter_eq_empty]
+lemma disjoint_iff (h : is_generic_point x S) (hU : is_open U) : disjoint S U ↔ x ∉ U :=
+by rw [h.mem_open_set_iff hU, ← not_disjoint_iff_nonempty_inter, not_not]
 
-lemma is_generic_point.mem_closed_set_iff
-  {Z : set α} (hZ : is_closed Z) : x ∈ Z ↔ S ⊆ Z :=
-by rw [← is_generic_point_def.mp h, hZ.closure_subset_iff, set.singleton_subset_iff]
+lemma mem_closed_set_iff (h : is_generic_point x S) (hZ : is_closed Z) :
+  x ∈ Z ↔ S ⊆ Z :=
+by rw [← h.def, hZ.closure_subset_iff, singleton_subset_iff]
 
-lemma is_generic_point.image {f : α → β} (hf : continuous f) :
+protected lemma image (h : is_generic_point x S) {f : α → β} (hf : continuous f) :
   is_generic_point (f x) (closure (f '' S)) :=
 begin
-  rw [is_generic_point_def, ← is_generic_point_def.mp h],
-  apply le_antisymm,
-  { exact closure_mono
-      (set.singleton_subset_iff.mpr ⟨_, subset_closure $ set.mem_singleton x, rfl⟩) },
-  { convert is_closed_closure.closure_subset_iff.mpr (image_closure_subset_closure_image hf),
-    rw set.image_singleton }
+  rw [is_generic_point_def, ← h.def, ← image_singleton],
+  exact subset.antisymm (closure_mono (image_subset _ subset_closure))
+    (closure_minimal (image_closure_subset_closure_image hf) is_closed_closure)
 end
 
-omit h
+end is_generic_point
 
-lemma is_generic_point_iff_forall_closed {x : α} {S : set α} (hS : is_closed S) (hxS : x ∈ S) :
-  is_generic_point x S ↔ ∀ (Z : set α) (hZ : is_closed Z) (hxZ : x ∈ Z), S ⊆ Z :=
-begin
-  split,
-  { intros h Z hZ hxZ, exact (h.mem_closed_set_iff hZ).mp hxZ },
-  { intro h,
-    apply le_antisymm,
-    { rwa [set.le_eq_subset, hS.closure_subset_iff, set.singleton_subset_iff] },
-    { exact h _ is_closed_closure (subset_closure $ set.mem_singleton x) } }
-end
+lemma is_generic_point_iff_forall_closed (hS : is_closed S) (hxS : x ∈ S) :
+  is_generic_point x S ↔ ∀ Z : set α, is_closed Z → x ∈ Z → S ⊆ Z :=
+have closure {x} ⊆ S, from closure_minimal (singleton_subset_iff.2 hxS) hS,
+by simp_rw [is_generic_point, subset_antisymm_iff, this, true_and, closure, subset_sInter_iff,
+  mem_set_of_eq, and_imp, singleton_subset_iff]
 
 end generic_point
 
@@ -273,7 +188,7 @@ begin
     set.image_singleton, (show _ = _, from hx)],
   apply set.image_injective.mpr hf.inj,
   ext z,
-  simp only [set.image_preimage_eq_inter_range, set.mem_inter_eq, and.congr_left_iff],
+  simp only [set.image_preimage_eq_inter_range, set.mem_inter_iff, and.congr_left_iff],
   exact λ hy, ⟨λ h, hT.closure_eq ▸ closure_mono (set.inter_subset_left _ _) h,
     λ h, subset_closure ⟨h, hy⟩⟩
 end
@@ -310,7 +225,7 @@ instance t2_space.quasi_sober [t2_space α] : quasi_sober α :=
 begin
   constructor,
   rintro S h -,
-  obtain ⟨x, rfl⟩ := (is_irreducible_iff_singleton S).mp h,
+  obtain ⟨x, rfl⟩ := is_irreducible_iff_singleton.mp h,
   exact ⟨x, closure_singleton⟩
 end
 
diff --git a/src/topology/spectral/hom.lean b/src/topology/spectral/hom.lean
index 60fc940ec9401..45962b21f8052 100644
--- a/src/topology/spectral/hom.lean
+++ b/src/topology/spectral/hom.lean
@@ -8,6 +8,9 @@ import topology.continuous_function.basic
 /-!
 # Spectral maps
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file defines spectral maps. A map is spectral when it's continuous and the preimage of a
 compact open set is compact open.
 
@@ -32,11 +35,11 @@ variables [topological_space α] [topological_space β] [topological_space γ] {
 /-- A function between topological spaces is spectral if it is continuous and the preimage of every
 compact open set is compact open. -/
 structure is_spectral_map (f : α → β) extends continuous f : Prop :=
-(compact_preimage_of_open ⦃s : set β⦄ : is_open s → is_compact s → is_compact (f ⁻¹' s))
+(is_compact_preimage_of_is_open ⦃s : set β⦄ : is_open s → is_compact s → is_compact (f ⁻¹' s))
 
-lemma is_compact.preimage_of_open (hf : is_spectral_map f) (h₀ : is_compact s) (h₁ : is_open s) :
+lemma is_compact.preimage_of_is_open (hf : is_spectral_map f) (h₀ : is_compact s) (h₁ : is_open s) :
   is_compact (f ⁻¹' s) :=
-hf.compact_preimage_of_open h₁ h₀
+hf.is_compact_preimage_of_is_open h₁ h₀
 
 lemma is_spectral_map.continuous {f : α → β} (hf : is_spectral_map f) : continuous f :=
 hf.to_continuous
@@ -47,7 +50,7 @@ lemma is_spectral_map.comp {f : β → γ} {g : α → β} (hf : is_spectral_map
   (hg : is_spectral_map g) :
   is_spectral_map (f ∘ g) :=
 ⟨hf.continuous.comp hg.continuous,
-  λ s hs₀ hs₁, (hs₁.preimage_of_open hf hs₀).preimage_of_open hg (hs₀.preimage hf.continuous)⟩
+  λ s hs₀ hs₁, (hs₁.preimage_of_is_open hf hs₀).preimage_of_is_open hg (hs₀.preimage hf.continuous)⟩
 
 end unbundled
 
@@ -56,6 +59,9 @@ structure spectral_map (α β : Type*) [topological_space α] [topological_space
 (to_fun : α → β)
 (spectral' : is_spectral_map to_fun)
 
+section
+set_option old_structure_cmd true
+
 /-- `spectral_map_class F α β` states that `F` is a type of spectral maps.
 
 You should extend this class when you extend `spectral_map`. -/
@@ -64,6 +70,8 @@ class spectral_map_class (F : Type*) (α β : out_param $ Type*) [topological_sp
   extends fun_like F α (λ _, β) :=
 (map_spectral (f : F) : is_spectral_map f)
 
+end
+
 export spectral_map_class (map_spectral)
 
 attribute [simp] map_spectral
@@ -72,7 +80,8 @@ attribute [simp] map_spectral
 instance spectral_map_class.to_continuous_map_class [topological_space α] [topological_space β]
   [spectral_map_class F α β] :
   continuous_map_class F α β :=
-⟨λ f, (map_spectral f).continuous⟩
+{ map_continuous := λ f, (map_spectral f).continuous,
+  ..‹spectral_map_class F α β› }
 
 instance [topological_space α] [topological_space β] [spectral_map_class F α β] :
   has_coe_t F (spectral_map α β) :=
@@ -104,6 +113,9 @@ equalities. -/
 protected def copy (f : spectral_map α β) (f' : α → β) (h : f' = f) : spectral_map α β :=
 ⟨f', h.symm.subst f.spectral'⟩
 
+@[simp] lemma coe_copy (f : spectral_map α β) (f' : α → β) (h : f' = f) : ⇑(f.copy f' h) = f' := rfl
+lemma copy_eq (f : spectral_map α β) (f' : α → β) (h : f' = f) : f.copy f' h = f := fun_like.ext' h
+
 variables (α)
 
 /-- `id` as a `spectral_map`. -/
diff --git a/src/topology/stone_cech.lean b/src/topology/stone_cech.lean
index 4f93bb4abf2a2..d8f7cc15fb3bc 100644
--- a/src/topology/stone_cech.lean
+++ b/src/topology/stone_cech.lean
@@ -8,6 +8,9 @@ import topology.dense_embedding
 
 /-! # Stone-Čech compactification
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Construction of the Stone-Čech compactification using ultrafilters.
 
 Parts of the formalization are based on "Ultrafilters and Topology"
@@ -17,7 +20,7 @@ by Marius Stekelenburg, particularly section 5.
 noncomputable theory
 
 open filter set
-open_locale topological_space
+open_locale topology
 
 universes u v
 
@@ -176,7 +179,7 @@ variables  [compact_space γ]
 lemma continuous_ultrafilter_extend (f : α → γ) : continuous (ultrafilter.extend f) :=
 have ∀ (b : ultrafilter α), ∃ c, tendsto f (comap pure (𝓝 b)) (𝓝 c) := assume b,
   -- b.map f is an ultrafilter on γ, which is compact, so it converges to some c in γ.
-  let ⟨c, _, h⟩ := compact_univ.ultrafilter_le_nhds (b.map f)
+  let ⟨c, _, h⟩ := is_compact_univ.ultrafilter_le_nhds (b.map f)
     (by rw [le_principal_iff]; exact univ_mem) in
   ⟨c, le_trans (map_mono (ultrafilter_comap_pure_nhds _)) h⟩,
 begin
diff --git a/src/topology/subset_properties.lean b/src/topology/subset_properties.lean
index 4a642f95dfc9e..97d583e2dacd9 100644
--- a/src/topology/subset_properties.lean
+++ b/src/topology/subset_properties.lean
@@ -7,12 +7,17 @@ import order.filter.pi
 import topology.bases
 import data.finset.order
 import data.set.accumulate
-import tactic.tfae
+import data.set.bool_indicator
 import topology.bornology.basic
+import topology.locally_finite
+import order.minimal
 
 /-!
 # Properties of subsets of topological spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define various properties of subsets of a topological space, and some classes on
 topological spaces.
 
@@ -48,7 +53,7 @@ https://ncatlab.org/nlab/show/too+simple+to+be+simple#relationship_to_biased_def
 -/
 
 open set filter classical topological_space
-open_locale classical topological_space filter
+open_locale classical topology filter
 
 universes u v
 variables {α : Type u} {β : Type v}  {ι : Type*} {π : ι → Type*}
@@ -122,7 +127,7 @@ lemma is_compact.diff (hs : is_compact s) (ht : is_open t) : is_compact (s \ t)
 hs.inter_right (is_closed_compl_iff.mpr ht)
 
 /-- A closed subset of a compact set is a compact set. -/
-lemma compact_of_is_closed_subset (hs : is_compact s) (ht : is_closed t) (h : t ⊆ s) :
+lemma is_compact_of_is_closed_subset (hs : is_compact s) (ht : is_closed t) (h : t ⊆ s) :
   is_compact t :=
 inter_eq_self_of_subset_right h ▸ hs.inter_right ht
 
@@ -204,6 +209,40 @@ let ⟨t, ht⟩ := hs.elim_nhds_subcover' (λ x _, U x) hU
 in ⟨t.image coe, λ x hx, let ⟨y, hyt, hyx⟩ := finset.mem_image.1 hx in hyx ▸ y.2,
   by rwa finset.set_bUnion_finset_image⟩
 
+/-- The neighborhood filter of a compact set is disjoint with a filter `l` if and only if the
+neighborhood filter of each point of this set is disjoint with `l`. -/
+lemma is_compact.disjoint_nhds_set_left {l : filter α} (hs : is_compact s) :
+  disjoint (𝓝ˢ s) l ↔ ∀ x ∈ s, disjoint (𝓝 x) l :=
+begin
+  refine ⟨λ h x hx, h.mono_left $ nhds_le_nhds_set hx, λ H, _⟩,
+  choose! U hxU hUl using λ x hx, (nhds_basis_opens x).disjoint_iff_left.1 (H x hx),
+  choose hxU hUo using hxU,
+  rcases hs.elim_nhds_subcover U (λ x hx, (hUo x hx).mem_nhds (hxU x hx)) with ⟨t, hts, hst⟩,
+  refine (has_basis_nhds_set _).disjoint_iff_left.2
+    ⟨⋃ x ∈ t, U x, ⟨is_open_bUnion $ λ x hx, hUo x (hts x hx), hst⟩, _⟩,
+  rw [compl_Union₂, bInter_finset_mem],
+  exact λ x hx, hUl x (hts x hx)
+end
+
+/-- A filter `l` is disjoint with the neighborhood filter of a compact set if and only if it is
+disjoint with the neighborhood filter of each point of this set. -/
+lemma is_compact.disjoint_nhds_set_right {l : filter α} (hs : is_compact s) :
+  disjoint l (𝓝ˢ s) ↔ ∀ x ∈ s, disjoint l (𝓝 x) :=
+by simpa only [disjoint.comm] using hs.disjoint_nhds_set_left
+
+/-- For every directed family of closed sets whose intersection avoids a compact set,
+there exists a single element of the family which itself avoids this compact set. -/
+lemma is_compact.elim_directed_family_closed {ι : Type v} [hι : nonempty ι] (hs : is_compact s)
+  (Z : ι → set α) (hZc : ∀ i, is_closed (Z i)) (hsZ : s ∩ (⋂ i, Z i) = ∅) (hdZ : directed (⊇) Z) :
+  ∃ i : ι, s ∩ Z i = ∅ :=
+let ⟨t, ht⟩ := hs.elim_directed_cover (compl ∘ Z) (λ i, (hZc i).is_open_compl)
+  (by simpa only [subset_def, not_forall, eq_empty_iff_forall_not_mem, mem_Union,
+    exists_prop, mem_inter_iff, not_and, iff_self, mem_Inter, mem_compl_iff] using hsZ)
+  (hdZ.mono_comp _ $ λ _ _, compl_subset_compl.mpr)
+    in
+⟨t, by simpa only [subset_def, not_forall, eq_empty_iff_forall_not_mem, mem_Union,
+    exists_prop, mem_inter_iff, not_and, iff_self, mem_Inter, mem_compl_iff] using ht⟩
+
 /-- For every family of closed sets whose intersection avoids a compact set,
 there exists a finite subfamily whose intersection avoids this compact set. -/
 lemma is_compact.elim_finite_subfamily_closed {s : set α} {ι : Type v} (hs : is_compact s)
@@ -211,16 +250,16 @@ lemma is_compact.elim_finite_subfamily_closed {s : set α} {ι : Type v} (hs : i
   ∃ t : finset ι, s ∩ (⋂ i ∈ t, Z i) = ∅ :=
 let ⟨t, ht⟩ := hs.elim_finite_subcover (λ i, (Z i)ᶜ) (λ i, (hZc i).is_open_compl)
   (by simpa only [subset_def, not_forall, eq_empty_iff_forall_not_mem, mem_Union,
-    exists_prop, mem_inter_eq, not_and, iff_self, mem_Inter, mem_compl_eq] using hsZ)
+    exists_prop, mem_inter_iff, not_and, iff_self, mem_Inter, mem_compl_iff] using hsZ)
     in
 ⟨t, by simpa only [subset_def, not_forall, eq_empty_iff_forall_not_mem, mem_Union,
-    exists_prop, mem_inter_eq, not_and, iff_self, mem_Inter, mem_compl_eq] using ht⟩
+    exists_prop, mem_inter_iff, not_and, iff_self, mem_Inter, mem_compl_iff] using ht⟩
 
 /-- If `s` is a compact set in a topological space `α` and `f : ι → set α` is a locally finite
 family of sets, then `f i ∩ s` is nonempty only for a finitely many `i`. -/
 lemma locally_finite.finite_nonempty_inter_compact {ι : Type*} {f : ι → set α}
   (hf : locally_finite f) {s : set α} (hs : is_compact s) :
-  finite {i | (f i ∩ s).nonempty} :=
+  {i | (f i ∩ s).nonempty}.finite :=
 begin
   choose U hxU hUf using hf,
   rcases hs.elim_nhds_subcover U (λ x _, hxU x) with ⟨t, -, hsU⟩,
@@ -236,7 +275,7 @@ lemma is_compact.inter_Inter_nonempty {s : set α} {ι : Type v} (hs : is_compac
   (Z : ι → set α) (hZc : ∀ i, is_closed (Z i)) (hsZ : ∀ t : finset ι, (s ∩ ⋂ i ∈ t, Z i).nonempty) :
   (s ∩ ⋂ i, Z i).nonempty :=
 begin
-  simp only [← ne_empty_iff_nonempty] at hsZ ⊢,
+  simp only [nonempty_iff_ne_empty] at hsZ ⊢,
   apply mt (hs.elim_finite_subfamily_closed Z hZc), push_neg, exact hsZ
 end
 
@@ -247,25 +286,16 @@ lemma is_compact.nonempty_Inter_of_directed_nonempty_compact_closed
   (hZn : ∀ i, (Z i).nonempty) (hZc : ∀ i, is_compact (Z i)) (hZcl : ∀ i, is_closed (Z i)) :
   (⋂ i, Z i).nonempty :=
 begin
-  apply hι.elim,
-  intro i₀,
-  let Z' := λ i, Z i ∩ Z i₀,
-  suffices : (⋂ i, Z' i).nonempty,
-  { exact this.mono (Inter_mono $ λ i, inter_subset_left (Z i) (Z i₀)) },
-  rw ← ne_empty_iff_nonempty,
-  intro H,
-  obtain ⟨t, ht⟩ : ∃ (t : finset ι), ((Z i₀) ∩ ⋂ (i ∈ t), Z' i) = ∅,
-    from (hZc i₀).elim_finite_subfamily_closed Z'
-      (assume i, is_closed.inter (hZcl i) (hZcl i₀)) (by rw [H, inter_empty]),
-  obtain ⟨i₁, hi₁⟩ : ∃ i₁ : ι, Z i₁ ⊆ Z i₀ ∧ ∀ i ∈ t, Z i₁ ⊆ Z' i,
-  { rcases directed.finset_le hZd t with ⟨i, hi⟩,
-    rcases hZd i i₀ with ⟨i₁, hi₁, hi₁₀⟩,
-    use [i₁, hi₁₀],
-    intros j hj,
-    exact subset_inter (subset.trans hi₁ (hi j hj)) hi₁₀ },
-  suffices : ((Z i₀) ∩ ⋂ (i ∈ t), Z' i).nonempty,
-  { rw ← ne_empty_iff_nonempty at this, contradiction },
-  exact (hZn i₁).mono (subset_inter hi₁.left $ subset_Inter₂ hi₁.right),
+  let i₀ := hι.some,
+  suffices : (Z i₀ ∩ ⋂ i, Z i).nonempty,
+    by rwa inter_eq_right_iff_subset.mpr (Inter_subset _ i₀) at this,
+  simp only [nonempty_iff_ne_empty] at hZn ⊢,
+  apply mt ((hZc i₀).elim_directed_family_closed Z hZcl),
+  push_neg,
+  simp only [← nonempty_iff_ne_empty] at hZn ⊢,
+  refine ⟨hZd, λ i, _⟩,
+  rcases hZd i₀ i with ⟨j, hji₀, hji⟩,
+  exact (hZn j).mono (subset_inter hji₀ hji)
 end
 
 /-- Cantor's intersection theorem for sequences indexed by `ℕ`:
@@ -277,13 +307,14 @@ lemma is_compact.nonempty_Inter_of_sequence_nonempty_compact_closed
 have Zmono : antitone Z := antitone_nat_of_succ_le hZd,
 have hZd : directed (⊇) Z, from directed_of_sup Zmono,
 have ∀ i, Z i ⊆ Z 0, from assume i, Zmono $ zero_le i,
-have hZc : ∀ i, is_compact (Z i), from assume i, compact_of_is_closed_subset hZ0 (hZcl i) (this i),
+have hZc : ∀ i, is_compact (Z i),
+  from assume i, is_compact_of_is_closed_subset hZ0 (hZcl i) (this i),
 is_compact.nonempty_Inter_of_directed_nonempty_compact_closed Z hZd hZn hZc hZcl
 
 /-- For every open cover of a compact set, there exists a finite subcover. -/
 lemma is_compact.elim_finite_subcover_image {b : set ι} {c : ι → set α}
   (hs : is_compact s) (hc₁ : ∀ i ∈ b, is_open (c i)) (hc₂ : s ⊆ ⋃ i ∈ b, c i) :
-  ∃ b' ⊆ b, finite b' ∧ s ⊆ ⋃ i ∈ b', c i :=
+  ∃ b' ⊆ b, set.finite b' ∧ s ⊆ ⋃ i ∈ b', c i :=
 begin
   rcases hs.elim_finite_subcover (λ i, c i : b → set α) _ _ with ⟨d, hd⟩;
     [skip, simpa using hc₁, simpa using hc₂],
@@ -333,10 +364,10 @@ is_compact_of_finite_subfamily_closed $
   assume ι Z hZc hsZ,
   let ⟨t, ht⟩ := h (λ i, (Z i)ᶜ) (assume i, is_open_compl_iff.mpr $ hZc i)
     (by simpa only [subset_def, not_forall, eq_empty_iff_forall_not_mem, mem_Union,
-      exists_prop, mem_inter_eq, not_and, iff_self, mem_Inter, mem_compl_eq] using hsZ)
+      exists_prop, mem_inter_iff, not_and, iff_self, mem_Inter, mem_compl_iff] using hsZ)
       in
   ⟨t, by simpa only [subset_def, not_forall, eq_empty_iff_forall_not_mem, mem_Union,
-      exists_prop, mem_inter_eq, not_and, iff_self, mem_Inter, mem_compl_eq] using ht⟩
+      exists_prop, mem_inter_iff, not_and, iff_self, mem_Inter, mem_compl_iff] using ht⟩
 
 /-- A set `s` is compact if and only if
 for every open cover of `s`, there exists a finite subcover. -/
@@ -387,7 +418,7 @@ lemma is_compact_singleton {a : α} : is_compact ({a} : set α) :=
 lemma set.subsingleton.is_compact {s : set α} (hs : s.subsingleton) : is_compact s :=
 subsingleton.induction_on hs is_compact_empty $ λ x, is_compact_singleton
 
-lemma set.finite.compact_bUnion {s : set ι} {f : ι → set α} (hs : finite s)
+lemma set.finite.is_compact_bUnion {s : set ι} {f : ι → set α} (hs : s.finite)
   (hf : ∀ i ∈ s, is_compact (f i)) :
   is_compact (⋃ i ∈ s, f i) :=
 is_compact_of_finite_subcover $ assume ι U hUo hsU,
@@ -405,20 +436,20 @@ is_compact_of_finite_subcover $ assume ι U hUo hsU,
       assume j hj, finset.mem_bUnion.mpr ⟨_, finset.mem_univ _, hj⟩,
   ⟨t, this⟩
 
-lemma finset.compact_bUnion (s : finset ι) {f : ι → set α} (hf : ∀ i ∈ s, is_compact (f i)) :
+lemma finset.is_compact_bUnion (s : finset ι) {f : ι → set α} (hf : ∀ i ∈ s, is_compact (f i)) :
   is_compact (⋃ i ∈ s, f i) :=
-s.finite_to_set.compact_bUnion hf
+s.finite_to_set.is_compact_bUnion hf
 
-lemma compact_accumulate {K : ℕ → set α} (hK : ∀ n, is_compact (K n)) (n : ℕ) :
+lemma is_compact_accumulate {K : ℕ → set α} (hK : ∀ n, is_compact (K n)) (n : ℕ) :
   is_compact (accumulate K n) :=
-(finite_le_nat n).compact_bUnion $ λ k _, hK k
+(finite_le_nat n).is_compact_bUnion $ λ k _, hK k
 
-lemma compact_Union {f : ι → set α} [fintype ι]
-  (h : ∀ i, is_compact (f i)) : is_compact (⋃ i, f i) :=
-by rw ← bUnion_univ; exact finite_univ.compact_bUnion (λ i _, h i)
+lemma is_compact_Union {f : ι → set α} [finite ι] (h : ∀ i, is_compact (f i)) :
+  is_compact (⋃ i, f i) :=
+by rw ← bUnion_univ; exact finite_univ.is_compact_bUnion (λ i _, h i)
 
-lemma set.finite.is_compact (hs : finite s) : is_compact s :=
-bUnion_of_singleton s ▸ hs.compact_bUnion (λ _ _, is_compact_singleton)
+lemma set.finite.is_compact (hs : s.finite) : is_compact s :=
+bUnion_of_singleton s ▸ hs.is_compact_bUnion (λ _ _, is_compact_singleton)
 
 lemma is_compact.finite_of_discrete [discrete_topology α] {s : set α} (hs : is_compact s) :
   s.finite :=
@@ -433,7 +464,7 @@ lemma is_compact_iff_finite [discrete_topology α] {s : set α} : is_compact s 
 ⟨λ h, h.finite_of_discrete, λ h, h.is_compact⟩
 
 lemma is_compact.union (hs : is_compact s) (ht : is_compact t) : is_compact (s ∪ t) :=
-by rw union_eq_Union; exact compact_Union (λ b, by cases b; assumption)
+by rw union_eq_Union; exact is_compact_Union (λ b, by cases b; assumption)
 
 lemma is_compact.insert (hs : is_compact s) (a) : is_compact (insert a s) :=
 is_compact_singleton.union hs
@@ -441,14 +472,14 @@ is_compact_singleton.union hs
 /-- If `V : ι → set α` is a decreasing family of closed compact sets then any neighborhood of
 `⋂ i, V i` contains some `V i`. We assume each `V i` is compact *and* closed because `α` is
 not assumed to be Hausdorff. See `exists_subset_nhd_of_compact` for version assuming this. -/
-lemma exists_subset_nhd_of_compact' {ι : Type*} [nonempty ι] {V : ι → set α} (hV : directed (⊇) V)
+lemma exists_subset_nhds_of_is_compact' {ι : Type*} [nonempty ι]
+  {V : ι → set α} (hV : directed (⊇) V)
   (hV_cpct : ∀ i, is_compact (V i)) (hV_closed : ∀ i, is_closed (V i))
   {U : set α} (hU : ∀ x ∈ ⋂ i, V i, U ∈ 𝓝 x) : ∃ i, V i ⊆ U :=
 begin
   obtain ⟨W, hsubW, W_op, hWU⟩ := exists_open_set_nhds hU,
-  suffices : ∃ i, V i ⊆ W,
-  { rcases this with ⟨i, hi⟩,
-    refine ⟨i, set.subset.trans hi hWU⟩ },
+  rsuffices ⟨i, hi⟩ : ∃ i, V i ⊆ W,
+  { exact ⟨i, hi.trans hWU⟩ },
   by_contra' H,
   replace H : ∀ i, (V i ∩ Wᶜ).nonempty := λ i, set.inter_compl_nonempty_iff.mpr (H i),
   have : (⋂ i, V i ∩ Wᶜ).nonempty,
@@ -456,11 +487,44 @@ begin
       (λ i, (hV_cpct i).inter_right W_op.is_closed_compl)
       (λ i, (hV_closed i).inter W_op.is_closed_compl),
     rcases hV i j with ⟨k, hki, hkj⟩,
-    refine ⟨k, ⟨λ x, _, λ x, _⟩⟩ ; simp only [and_imp, mem_inter_eq, mem_compl_eq] ; tauto },
+    refine ⟨k, ⟨λ x, _, λ x, _⟩⟩ ; simp only [and_imp, mem_inter_iff, mem_compl_iff] ; tauto },
   have : ¬ (⋂ (i : ι), V i) ⊆ W, by simpa [← Inter_inter, inter_compl_nonempty_iff],
   contradiction
 end
 
+/-- If `α` has a basis consisting of compact opens, then an open set in `α` is compact open iff
+  it is a finite union of some elements in the basis -/
+lemma is_compact_open_iff_eq_finite_Union_of_is_topological_basis (b : ι → set α)
+  (hb : is_topological_basis (set.range b))
+  (hb' : ∀ i, is_compact (b i)) (U : set α) :
+  is_compact U ∧ is_open U ↔ ∃ (s : set ι), s.finite ∧ U = ⋃ i ∈ s, b i :=
+begin
+  classical,
+  split,
+  { rintro ⟨h₁, h₂⟩,
+    obtain ⟨β, f, e, hf⟩ := hb.open_eq_Union h₂,
+    choose f' hf' using hf,
+    have : b ∘ f' = f := funext hf', subst this,
+    obtain ⟨t, ht⟩ := h₁.elim_finite_subcover (b ∘ f')
+      (λ i, hb.is_open (set.mem_range_self _)) (by rw e),
+    refine ⟨t.image f', set.finite.intro infer_instance, le_antisymm _ _⟩,
+    { refine set.subset.trans ht _,
+      simp only [set.Union_subset_iff, coe_coe],
+      intros i hi,
+      erw ← set.Union_subtype (λ x : ι, x ∈ t.image f') (λ i, b i.1),
+      exact set.subset_Union (λ i : t.image f', b i) ⟨_, finset.mem_image_of_mem _ hi⟩ },
+    { apply set.Union₂_subset,
+      rintro i hi,
+      obtain ⟨j, hj, rfl⟩ := finset.mem_image.mp hi,
+      rw e,
+      exact set.subset_Union (b ∘ f') j } },
+  { rintro ⟨s, hs, rfl⟩,
+    split,
+    { exact hs.is_compact_bUnion (λ i _, hb' i) },
+    { apply is_open_bUnion, intros i hi, exact hb.is_open (set.mem_range_self _) } },
+end
+
+
 namespace filter
 
 /-- `filter.cocompact` is the filter generated by complements to compact sets. -/
@@ -505,8 +569,8 @@ begin
   have : f '' K ∈ l,
   { filter_upwards [htl, le_principal_iff.1 hle] with y hyt hyf,
     rcases hyf with (rfl|⟨x, rfl⟩),
-    exacts [(hd ⟨mem_of_mem_nhds hsb, hyt⟩).elim,
-      mem_image_of_mem _ (not_not.1 $ λ hxK, hd ⟨hKs hxK, hyt⟩)] },
+    exacts [(hd.le_bot ⟨mem_of_mem_nhds hsb, hyt⟩).elim,
+      mem_image_of_mem _ (not_not.1 $ λ hxK, hd.le_bot ⟨hKs hxK, hyt⟩)] },
   rcases hKc.image hfc (le_principal_iff.2 this) with ⟨y, hy, hyl⟩,
   exact ⟨y, or.inr $ image_subset_range _ _ hy, hyl⟩
 end
@@ -515,7 +579,7 @@ lemma tendsto.is_compact_insert_range_of_cofinite {f : ι → α} {a}
   (hf : tendsto f cofinite (𝓝 a)) :
   is_compact (insert a (range f)) :=
 begin
-  letI : topological_space ι := ⊥, haveI : discrete_topology ι := ⟨rfl⟩,
+  letI : topological_space ι := ⊥, haveI := discrete_topology_bot ι,
   rw ← cocompact_eq_cofinite at hf,
   exact hf.is_compact_insert_range_of_cocompact continuous_of_discrete_topology
 end
@@ -646,7 +710,7 @@ end tube_lemma
 /-- Type class for compact spaces. Separation is sometimes included in the definition, especially
 in the French literature, but we do not include it here. -/
 class compact_space (α : Type*) [topological_space α] : Prop :=
-(compact_univ : is_compact (univ : set α))
+(is_compact_univ : is_compact (univ : set α))
 
 @[priority 10] -- see Note [lower instance priority]
 instance subsingleton.compact_space [subsingleton α] : compact_space α :=
@@ -654,17 +718,17 @@ instance subsingleton.compact_space [subsingleton α] : compact_space α :=
 
 lemma is_compact_univ_iff : is_compact (univ : set α) ↔ compact_space α := ⟨λ h, ⟨h⟩, λ h, h.1⟩
 
-lemma compact_univ [h : compact_space α] : is_compact (univ : set α) := h.compact_univ
+lemma is_compact_univ [h : compact_space α] : is_compact (univ : set α) := h.is_compact_univ
 
 lemma cluster_point_of_compact [compact_space α] (f : filter α) [ne_bot f] :
   ∃ x, cluster_pt x f :=
-by simpa using compact_univ (show f ≤ 𝓟 univ, by simp)
+by simpa using is_compact_univ (show f ≤ 𝓟 univ, by simp)
 
 lemma compact_space.elim_nhds_subcover [compact_space α]
   (U : α → set α) (hU : ∀ x, U x ∈ 𝓝 x) :
   ∃ t : finset α, (⋃ x ∈ t, U x) = ⊤ :=
 begin
-  obtain ⟨t, -, s⟩ := is_compact.elim_nhds_subcover compact_univ U (λ x m, hU x),
+  obtain ⟨t, -, s⟩ := is_compact.elim_nhds_subcover is_compact_univ U (λ x m, hU x),
   exact ⟨t, by { rw eq_top_iff, exact s }⟩,
 end
 
@@ -672,7 +736,7 @@ theorem compact_space_of_finite_subfamily_closed
   (h : Π {ι : Type u} (Z : ι → (set α)), (∀ i, is_closed (Z i)) →
     (⋂ i, Z i) = ∅ → ∃ (t : finset ι), (⋂ i ∈ t, Z i) = ∅) :
   compact_space α :=
-{ compact_univ :=
+{ is_compact_univ :=
   begin
     apply is_compact_of_finite_subfamily_closed,
     intros ι Z, specialize h Z,
@@ -681,7 +745,7 @@ theorem compact_space_of_finite_subfamily_closed
 
 lemma is_closed.is_compact [compact_space α] {s : set α} (h : is_closed s) :
   is_compact s :=
-compact_of_is_closed_subset compact_univ h (subset_univ _)
+is_compact_of_is_closed_subset is_compact_univ h (subset_univ _)
 
 /-- `α` is a noncompact topological space if it not a compact space. -/
 class noncompact_space (α : Type*) [topological_space α] : Prop :=
@@ -701,7 +765,7 @@ end
 
 @[simp]
 lemma filter.cocompact_eq_bot [compact_space α] : filter.cocompact α = ⊥ :=
-filter.has_basis_cocompact.eq_bot_iff.mpr ⟨set.univ, compact_univ, set.compl_univ⟩
+filter.has_basis_cocompact.eq_bot_iff.mpr ⟨set.univ, is_compact_univ, set.compl_univ⟩
 
 instance [noncompact_space α] : ne_bot (filter.coclosed_compact α) :=
 ne_bot_of_le filter.cocompact_le_coclosed_compact
@@ -718,15 +782,23 @@ lemma not_compact_space_iff : ¬compact_space α ↔ noncompact_space α :=
 instance : noncompact_space ℤ :=
 noncompact_space_of_ne_bot $ by simp only [filter.cocompact_eq_cofinite, filter.cofinite_ne_bot]
 
+-- Note: We can't make this into an instance because it loops with `finite.compact_space`.
 /-- A compact discrete space is finite. -/
-noncomputable
-def fintype_of_compact_of_discrete [compact_space α] [discrete_topology α] :
-  fintype α :=
-fintype_of_univ_finite $ compact_univ.finite_of_discrete
+lemma finite_of_compact_of_discrete [compact_space α] [discrete_topology α] : finite α :=
+finite.of_finite_univ $ is_compact_univ.finite_of_discrete
+
+lemma exists_nhds_ne_ne_bot (α : Type*) [topological_space α] [compact_space α] [infinite α] :
+  ∃ z : α, (𝓝[≠] z).ne_bot :=
+begin
+  by_contra' H,
+  simp_rw not_ne_bot at H,
+  haveI := discrete_topology_iff_nhds_ne.mpr H,
+  exact infinite.not_finite (finite_of_compact_of_discrete : finite α),
+end
 
 lemma finite_cover_nhds_interior [compact_space α] {U : α → set α} (hU : ∀ x, U x ∈ 𝓝 x) :
   ∃ t : finset α, (⋃ x ∈ t, interior (U x)) = univ :=
-let ⟨t, ht⟩ := compact_univ.elim_finite_subcover (λ x, interior (U x)) (λ x, is_open_interior)
+let ⟨t, ht⟩ := is_compact_univ.elim_finite_subcover (λ x, interior (U x)) (λ x, is_open_interior)
   (λ x _, mem_Union.2 ⟨x, mem_interior_iff_mem_nhds.2 (hU x)⟩)
 in ⟨t, univ_subset_iff.1 ht⟩
 
@@ -739,14 +811,14 @@ let ⟨t, ht⟩ := finite_cover_nhds_interior hU in ⟨t, univ_subset_iff.1 $ ht
 many nonempty elements. -/
 lemma locally_finite.finite_nonempty_of_compact {ι : Type*} [compact_space α] {f : ι → set α}
   (hf : locally_finite f) :
-  finite {i | (f i).nonempty} :=
-by simpa only [inter_univ]  using hf.finite_nonempty_inter_compact compact_univ
+  {i | (f i).nonempty}.finite :=
+by simpa only [inter_univ]  using hf.finite_nonempty_inter_compact is_compact_univ
 
 /-- If `α` is a compact space, then a locally finite family of nonempty sets of `α` can have only
 finitely many elements, `set.finite` version. -/
 lemma locally_finite.finite_of_compact {ι : Type*} [compact_space α] {f : ι → set α}
   (hf : locally_finite f) (hne : ∀ i, (f i).nonempty) :
-  finite (univ : set ι) :=
+  (univ : set ι).finite :=
 by simpa only [hne] using hf.finite_nonempty_of_compact
 
 /-- If `α` is a compact space, then a locally finite family of nonempty sets of `α` can have only
@@ -754,7 +826,7 @@ finitely many elements, `fintype` version. -/
 noncomputable def locally_finite.fintype_of_compact {ι : Type*} [compact_space α] {f : ι → set α}
   (hf : locally_finite f) (hne : ∀ i, (f i).nonempty) :
   fintype ι :=
-fintype_of_univ_finite (hf.finite_of_compact hne)
+fintype_of_finite_univ (hf.finite_of_compact hne)
 
 /-- The comap of the cocompact filter on `β` by a continuous function `f : α → β` is less than or
 equal to the cocompact filter on `α`.
@@ -770,7 +842,10 @@ end
 
 lemma is_compact_range [compact_space α] {f : α → β} (hf : continuous f) :
   is_compact (range f) :=
-by rw ← image_univ; exact compact_univ.image hf
+by rw ← image_univ; exact is_compact_univ.image hf
+
+lemma is_compact_diagonal [compact_space α] : is_compact (diagonal α) :=
+@range_diag α ▸ is_compact_range (continuous_id.prod_mk continuous_id)
 
 /-- If X is is_compact then pr₂ : X × Y → Y is a closed map -/
 theorem is_closed_proj_of_is_compact
@@ -783,14 +858,13 @@ begin
   assume C (hC : is_closed C),
   rw is_closed_iff_cluster_pt at hC ⊢,
   assume y (y_closure : cluster_pt y $ 𝓟 (πY '' C)),
-  have : ne_bot (map πX (comap πY (𝓝 y) ⊓ 𝓟 C)),
+  haveI : ne_bot (map πX (comap πY (𝓝 y) ⊓ 𝓟 C)),
   { suffices : ne_bot (map πY (comap πY (𝓝 y) ⊓ 𝓟 C)),
       by simpa only [map_ne_bot_iff],
     convert y_closure,
     calc map πY (comap πY (𝓝 y) ⊓ 𝓟 C) =
        𝓝 y ⊓ map πY (𝓟 C) : filter.push_pull' _ _ _
       ... = 𝓝 y ⊓ 𝓟 (πY '' C) : by rw map_principal },
-  resetI,
   obtain ⟨x, hx⟩ : ∃ x, cluster_pt x (map πX (comap πY (𝓝 y) ⊓ 𝓟 C)),
     from cluster_point_of_compact _,
   refine ⟨⟨x, y⟩, _, by simp [πY]⟩,
@@ -804,10 +878,10 @@ begin
   ... = 𝓝 x ⊓ map πX (comap πY (𝓝 y) ⊓ 𝓟 C)            : by rw inf_comm
 end
 
-lemma exists_subset_nhd_of_compact_space [compact_space α] {ι : Type*} [nonempty ι]
+lemma exists_subset_nhds_of_compact_space [compact_space α] {ι : Type*} [nonempty ι]
   {V : ι → set α} (hV : directed (⊇) V) (hV_closed : ∀ i, is_closed (V i))
   {U : set α} (hU : ∀ x ∈ ⋂ i, V i, U ∈ 𝓝 x) : ∃ i, V i ⊆ U :=
-exists_subset_nhd_of_compact' hV (λ i, (hV_closed i).is_compact) hV_closed hU
+exists_subset_nhds_of_is_compact' hV (λ i, (hV_closed i).is_compact) hV_closed hU
 
 /-- If `f : α → β` is an `inducing` map, then the image `f '' s` of a set `s` is compact if and only
 if the set `s` is closed. -/
@@ -847,15 +921,26 @@ lemma closed_embedding.tendsto_cocompact
 filter.has_basis_cocompact.tendsto_right_iff.mpr $ λ K hK,
   (hf.is_compact_preimage hK).compl_mem_cocompact
 
-lemma compact_iff_compact_in_subtype {p : α → Prop} {s : set {a // p a}} :
+lemma is_compact_iff_is_compact_in_subtype {p : α → Prop} {s : set {a // p a}} :
   is_compact s ↔ is_compact ((coe : _ → α) '' s) :=
 embedding_subtype_coe.is_compact_iff_is_compact_image
 
 lemma is_compact_iff_is_compact_univ {s : set α} : is_compact s ↔ is_compact (univ : set s) :=
-by rw [compact_iff_compact_in_subtype, image_univ, subtype.range_coe]; refl
+by rw [is_compact_iff_is_compact_in_subtype, image_univ, subtype.range_coe]; refl
 
 lemma is_compact_iff_compact_space {s : set α} : is_compact s ↔ compact_space s :=
-is_compact_iff_is_compact_univ.trans ⟨λ h, ⟨h⟩, @compact_space.compact_univ _ _⟩
+is_compact_iff_is_compact_univ.trans ⟨λ h, ⟨h⟩, @compact_space.is_compact_univ _ _⟩
+
+lemma is_compact.finite {s : set α} (hs : is_compact s) (hs' : discrete_topology s) : s.finite :=
+finite_coe_iff.mp (@finite_of_compact_of_discrete _ _ (is_compact_iff_compact_space.mp hs) hs')
+
+lemma exists_nhds_ne_inf_principal_ne_bot {s : set α} (hs : is_compact s) (hs' : s.infinite) :
+  ∃ z ∈ s, (𝓝[≠] z ⊓ 𝓟 s).ne_bot :=
+begin
+  by_contra' H,
+  simp_rw not_ne_bot at H,
+  exact hs' (hs.finite $ discrete_topology_subtype_iff.mpr H),
+end
 
 protected lemma closed_embedding.noncompact_space [noncompact_space α] {f : α → β}
   (hf : closed_embedding f) : noncompact_space β :=
@@ -882,12 +967,12 @@ begin
 end
 
 /-- Finite topological spaces are compact. -/
-@[priority 100] instance fintype.compact_space [fintype α] : compact_space α :=
-{ compact_univ := finite_univ.is_compact }
+@[priority 100] instance finite.compact_space [finite α] : compact_space α :=
+{ is_compact_univ := finite_univ.is_compact }
 
 /-- The product of two compact spaces is compact. -/
 instance [compact_space α] [compact_space β] : compact_space (α × β) :=
-⟨by { rw ← univ_prod_univ, exact compact_univ.prod compact_univ }⟩
+⟨by { rw ← univ_prod_univ, exact is_compact_univ.prod is_compact_univ }⟩
 
 /-- The disjoint union of two compact spaces is compact. -/
 instance [compact_space α] [compact_space β] : compact_space (α ⊕ β) :=
@@ -896,12 +981,12 @@ instance [compact_space α] [compact_space β] : compact_space (α ⊕ β) :=
   exact (is_compact_range continuous_inl).union (is_compact_range continuous_inr)
 end⟩
 
-instance [fintype ι] [Π i, topological_space (π i)] [∀ i, compact_space (π i)] :
+instance [finite ι] [Π i, topological_space (π i)] [∀ i, compact_space (π i)] :
   compact_space (Σ i, π i) :=
 begin
   refine ⟨_⟩,
   rw sigma.univ,
-  exact compact_Union (λ i, is_compact_range continuous_sigma_mk),
+  exact is_compact_Union (λ i, is_compact_range continuous_sigma_mk),
 end
 
 /-- The coproduct of the cocompact filters on two topological spaces is the cocompact filter on
@@ -918,7 +1003,7 @@ begin
     rw compl_subset_comm at ⊢ hAt hBt',
     refine subset.trans _ (set.prod_mono hAt hBt'),
     intros x,
-    simp only [compl_union, mem_inter_eq, mem_prod, mem_preimage, mem_compl_eq],
+    simp only [compl_union, mem_inter_iff, mem_prod, mem_preimage, mem_compl_iff],
     tauto },
   { rintros ⟨t, ht, htS⟩,
     refine ⟨⟨(prod.fst '' t)ᶜ, _, _⟩, ⟨(prod.snd '' t)ᶜ, _, _⟩⟩,
@@ -967,7 +1052,9 @@ lemma is_compact_univ_pi {s : Π i, set (π i)} (h : ∀ i, is_compact (s i)) :
 by { convert is_compact_pi_infinite h, simp only [← mem_univ_pi, set_of_mem_eq] }
 
 instance pi.compact_space [∀ i, compact_space (π i)] : compact_space (Πi, π i) :=
-⟨by { rw [← pi_univ univ], exact is_compact_univ_pi (λ i, compact_univ) }⟩
+⟨by { rw [← pi_univ univ], exact is_compact_univ_pi (λ i, is_compact_univ) }⟩
+
+instance function.compact_space [compact_space β] : compact_space (ι → β) := pi.compact_space
 
 /-- **Tychonoff's theorem** formulated in terms of filters: `filter.cocompact` on an indexed product
 type `Π d, κ d` the `filter.Coprod` of filters `filter.cocompact` on `κ d`. -/
@@ -1012,12 +1099,52 @@ lemma locally_compact_space_of_has_basis {ι : α → Type*} {p : Π x, ι x →
   locally_compact_space α :=
 ⟨λ x t ht, let ⟨i, hp, ht⟩ := (h x).mem_iff.1 ht in ⟨s x i, (h x).mem_of_mem hp, ht, hc x i hp⟩⟩
 
-instance locally_compact_space.prod (α : Type*) (β : Type*) [topological_space α]
+instance prod.locally_compact_space (α : Type*) (β : Type*) [topological_space α]
   [topological_space β] [locally_compact_space α] [locally_compact_space β] :
   locally_compact_space (α × β) :=
 have _ := λ x : α × β, (compact_basis_nhds x.1).prod_nhds' (compact_basis_nhds x.2),
 locally_compact_space_of_has_basis this $ λ x s ⟨⟨_, h₁⟩, _, h₂⟩, h₁.prod h₂
 
+section pi
+
+variables [Π i, topological_space (π i)] [∀ i, locally_compact_space (π i)]
+
+/--In general it suffices that all but finitely many of the spaces are compact,
+  but that's not straightforward to state and use. -/
+instance pi.locally_compact_space_of_finite [finite ι] : locally_compact_space (Π i, π i) :=
+⟨λ t n hn, begin
+  rw [nhds_pi, filter.mem_pi] at hn,
+  obtain ⟨s, hs, n', hn', hsub⟩ := hn,
+  choose n'' hn'' hsub' hc using λ i, locally_compact_space.local_compact_nhds (t i) (n' i) (hn' i),
+  refine ⟨(set.univ : set ι).pi n'', _, subset_trans (λ _ h, _) hsub, is_compact_univ_pi hc⟩,
+  { exact (set_pi_mem_nhds_iff (@set.finite_univ ι _) _).mpr (λ i hi, hn'' i), },
+  { exact λ i hi, hsub' i (h i trivial), },
+end⟩
+
+/-- For spaces that are not Hausdorff. -/
+instance pi.locally_compact_space [∀ i, compact_space (π i)] : locally_compact_space (Π i, π i) :=
+⟨λ t n hn, begin
+  rw [nhds_pi, filter.mem_pi] at hn,
+  obtain ⟨s, hs, n', hn', hsub⟩ := hn,
+  choose n'' hn'' hsub' hc using λ i, locally_compact_space.local_compact_nhds (t i) (n' i) (hn' i),
+  refine ⟨s.pi n'', _, subset_trans (λ _, _) hsub, _⟩,
+  { exact (set_pi_mem_nhds_iff hs _).mpr (λ i _, hn'' i), },
+  { exact forall₂_imp (λ i hi hi', hsub' i hi'), },
+  { rw ← set.univ_pi_ite,
+    refine is_compact_univ_pi (λ i, _),
+    by_cases i ∈ s,
+    { rw if_pos h, exact hc i, },
+    { rw if_neg h, exact compact_space.is_compact_univ, } },
+end⟩
+
+instance function.locally_compact_space_of_finite [finite ι] [locally_compact_space β] :
+  locally_compact_space (ι → β) := pi.locally_compact_space_of_finite
+
+instance function.locally_compact_space [locally_compact_space β] [compact_space β] :
+  locally_compact_space (ι → β) := pi.locally_compact_space
+
+end pi
+
 /-- A reformulation of the definition of locally compact space: In a locally compact space,
   every open set containing `x` has a compact subset containing `x` in its interior. -/
 lemma exists_compact_subset [locally_compact_space α] {x : α} {U : set α}
@@ -1033,19 +1160,24 @@ lemma exists_compact_mem_nhds [locally_compact_space α] (x : α) :
 let ⟨K, hKc, hx, H⟩ := exists_compact_subset is_open_univ (mem_univ x)
 in ⟨K, hKc, mem_interior_iff_mem_nhds.1 hx⟩
 
+/-- In a locally compact space, for every containement `K ⊆ U` of a compact set `K` in an open
+  set `U`, there is a compact neighborhood `L` such that `K ⊆ L ⊆ U`: equivalently, there is a
+  compact `L` such that `K ⊆ interior L` and `L ⊆ U`. -/
+lemma exists_compact_between [hα : locally_compact_space α] {K U : set α} (hK : is_compact K)
+  (hU : is_open U) (h_KU : K ⊆ U) : ∃ L, is_compact L ∧ K ⊆ interior L ∧ L ⊆ U :=
+begin
+  choose V hVc hxV hKV using λ x : K, exists_compact_subset hU (h_KU x.2),
+  have : K ⊆ ⋃ x, interior (V x), from λ x hx, mem_Union.2 ⟨⟨x, hx⟩, hxV _⟩,
+  rcases hK.elim_finite_subcover _ (λ x, @is_open_interior α _ (V x)) this with ⟨t, ht⟩,
+  refine ⟨_, t.is_compact_bUnion (λ x _, hVc x), λ x hx, _, set.Union₂_subset (λ i _, hKV i)⟩,
+  rcases mem_Union₂.1 (ht hx) with ⟨y, hyt, hy⟩,
+  exact interior_mono (subset_bUnion_of_mem hyt) hy,
+end
+
 /-- In a locally compact space, every compact set is contained in the interior of a compact set. -/
 lemma exists_compact_superset [locally_compact_space α] {K : set α} (hK : is_compact K) :
   ∃ K', is_compact K' ∧ K ⊆ interior K' :=
-begin
-  choose U hUc hxU using λ x : K, exists_compact_mem_nhds (x : α),
-  have : K ⊆ ⋃ x, interior (U x),
-    from λ x hx, mem_Union.2 ⟨⟨x, hx⟩, mem_interior_iff_mem_nhds.2 (hxU _)⟩,
-  rcases hK.elim_finite_subcover _ _ this with ⟨t, ht⟩,
-  { refine ⟨_, t.compact_bUnion (λ x _, hUc x), λ x hx, _⟩,
-    rcases mem_Union₂.1 (ht hx) with ⟨y, hyt, hy⟩,
-    exact interior_mono (subset_bUnion_of_mem hyt) hy },
-  { exact λ _, is_open_interior }
-end
+let ⟨L, hLc, hKL, _⟩ := exists_compact_between hK is_open_univ K.subset_univ in ⟨L, hLc, hKL⟩
 
 protected lemma closed_embedding.locally_compact_space [locally_compact_space β] {f : α → β}
   (hf : closed_embedding f) : locally_compact_space α :=
@@ -1081,7 +1213,7 @@ hs.open_embedding_subtype_coe.locally_compact_space
 lemma ultrafilter.le_nhds_Lim [compact_space α] (F : ultrafilter α) :
   ↑F ≤ 𝓝 (@Lim _ _ (F : filter α).nonempty_of_ne_bot F) :=
 begin
-  rcases compact_univ.ultrafilter_le_nhds F (by simp) with ⟨x, -, h⟩,
+  rcases is_compact_univ.ultrafilter_le_nhds F (by simp) with ⟨x, -, h⟩,
   exact le_nhds_Lim ⟨x,h⟩,
 end
 
@@ -1103,9 +1235,8 @@ begin
       { exact is_open_sUnion (λ _ h, (hc h).2.1) },
       { convert_to (⋂(U : {U // U ∈ c}), U.1ᶜ).nonempty,
         { ext,
-          simp only [not_exists, exists_prop, not_and, set.mem_Inter, subtype.forall,
-            set.mem_set_of_eq, set.mem_compl_eq, subtype.val_eq_coe],
-          refl, },
+          simp only [not_exists, exists_prop, not_and, set.mem_Inter, subtype.forall, mem_set_of_eq,
+            mem_compl_iff, mem_sUnion] },
         apply is_compact.nonempty_Inter_of_directed_nonempty_compact_closed,
         { rintros ⟨U, hU⟩ ⟨U', hU'⟩,
           obtain ⟨V, hVc, hVU, hVU'⟩ := hz.directed_on U hU U' hU',
@@ -1135,9 +1266,9 @@ class sigma_compact_space (α : Type*) [topological_space α] : Prop :=
 
 @[priority 200] -- see Note [lower instance priority]
 instance compact_space.sigma_compact [compact_space α] : sigma_compact_space α :=
-⟨⟨λ _, univ, λ _, compact_univ, Union_const _⟩⟩
+⟨⟨λ _, univ, λ _, is_compact_univ, Union_const _⟩⟩
 
-lemma sigma_compact_space.of_countable (S : set (set α)) (Hc : countable S)
+lemma sigma_compact_space.of_countable (S : set (set α)) (Hc : S.countable)
   (Hcomp : ∀ s ∈ S, is_compact s) (HU : ⋃₀ S = univ) : sigma_compact_space α :=
 ⟨(exists_seq_cover_iff_countable ⟨_, is_compact_empty⟩).2 ⟨S, Hc, Hcomp, HU⟩⟩
 
@@ -1159,7 +1290,7 @@ def compact_covering : ℕ → set α :=
 accumulate exists_compact_covering.some
 
 lemma is_compact_compact_covering (n : ℕ) : is_compact (compact_covering α n) :=
-compact_accumulate (classical.some_spec sigma_compact_space.exists_compact_covering).1 n
+is_compact_accumulate (classical.some_spec sigma_compact_space.exists_compact_covering).1 n
 
 lemma Union_compact_covering : (⋃ n, compact_covering α n) = univ :=
 begin
@@ -1176,11 +1307,58 @@ variable {α}
 lemma exists_mem_compact_covering (x : α) : ∃ n, x ∈ compact_covering α n :=
 Union_eq_univ_iff.mp (Union_compact_covering α) x
 
+instance [sigma_compact_space β] : sigma_compact_space (α × β) :=
+⟨⟨λ n, compact_covering α n ×ˢ compact_covering β n,
+  λ _, (is_compact_compact_covering _ _).prod (is_compact_compact_covering _ _),
+  by simp only [Union_prod_of_monotone (compact_covering_subset α) (compact_covering_subset β),
+    Union_compact_covering, univ_prod_univ]⟩⟩
+
+instance [finite ι] [Π i, topological_space (π i)] [Π i, sigma_compact_space (π i)] :
+  sigma_compact_space (Π i, π i) :=
+begin
+  refine ⟨⟨λ n, set.pi univ (λ i, compact_covering (π i) n),
+    λ n, is_compact_univ_pi $ λ i, is_compact_compact_covering _ _, _⟩⟩,
+  rw [Union_univ_pi_of_monotone],
+  { simp only [Union_compact_covering, pi_univ] },
+  { exact λ i, compact_covering_subset (π i) }
+end
+
+instance [sigma_compact_space β] : sigma_compact_space (α ⊕ β) :=
+⟨⟨λ n, sum.inl '' compact_covering α n ∪ sum.inr '' compact_covering β n,
+  λ n, ((is_compact_compact_covering α n).image continuous_inl).union
+    ((is_compact_compact_covering β n).image continuous_inr),
+  by simp only [Union_union_distrib, ← image_Union, Union_compact_covering, image_univ,
+    range_inl_union_range_inr]⟩⟩
+
+instance [countable ι] [Π i, topological_space (π i)] [Π i, sigma_compact_space (π i)] :
+  sigma_compact_space (Σ i, π i) :=
+begin
+  casesI is_empty_or_nonempty ι,
+  { apply_instance },
+  { rcases exists_surjective_nat ι with ⟨f, hf⟩,
+    refine ⟨⟨λ n, ⋃ k ≤ n, sigma.mk (f k) '' compact_covering (π (f k)) n, λ n, _, _⟩⟩,
+    { refine (finite_le_nat _).is_compact_bUnion (λ k _, _),
+      exact (is_compact_compact_covering _ _).image continuous_sigma_mk },
+    { simp only [Union_eq_univ_iff, sigma.forall, mem_Union, hf.forall],
+      intros k y,
+      rcases exists_mem_compact_covering y with ⟨n, hn⟩,
+      refine ⟨max k n, k, le_max_left _ _, mem_image_of_mem _ _⟩,
+      exact compact_covering_subset _ (le_max_right _ _) hn } }
+end
+
+protected theorem closed_embedding.sigma_compact_space {e : β → α} (he : closed_embedding e) :
+  sigma_compact_space β :=
+⟨⟨λ n, e ⁻¹' compact_covering α n, λ n, he.is_compact_preimage (is_compact_compact_covering _ _),
+  by rw [← preimage_Union, Union_compact_covering, preimage_univ]⟩⟩
+
+instance [sigma_compact_space β] : sigma_compact_space (ulift.{u} β) :=
+  ulift.closed_embedding_down.sigma_compact_space
+
 /-- If `α` is a `σ`-compact space, then a locally finite family of nonempty sets of `α` can have
 only countably many elements, `set.countable` version. -/
 protected lemma locally_finite.countable_univ {ι : Type*} {f : ι → set α} (hf : locally_finite f)
   (hne : ∀ i, (f i).nonempty) :
-  countable (univ : set ι) :=
+  (univ : set ι).countable :=
 begin
   have := λ n, hf.finite_nonempty_inter_compact (is_compact_compact_covering α n),
   refine (countable_Union (λ n, (this n).countable)).mono (λ i hi, _),
@@ -1199,7 +1377,7 @@ protected noncomputable def locally_finite.encodable {ι : Type*} {f : ι → se
 `x` of a closed set `s` to a neighborhood of `x` within `s`, then for some countable set `t ⊆ s`,
 the neighborhoods `f x`, `x ∈ t`, cover the whole set `s`. -/
 lemma countable_cover_nhds_within_of_sigma_compact {f : α → set α} {s : set α} (hs : is_closed s)
-  (hf : ∀ x ∈ s, f x ∈ 𝓝[s] x) : ∃ t ⊆ s, countable t ∧ s ⊆ ⋃ x ∈ t, f x :=
+  (hf : ∀ x ∈ s, f x ∈ 𝓝[s] x) : ∃ t ⊆ s, t.countable ∧ s ⊆ ⋃ x ∈ t, f x :=
 begin
   simp only [nhds_within, mem_inf_principal] at hf,
   choose t ht hsub using λ n, ((is_compact_compact_covering α n).inter_right hs).elim_nhds_subcover
@@ -1215,7 +1393,7 @@ end
 point `x` to a neighborhood of `x`, then for some countable set `s`, the neighborhoods `f x`,
 `x ∈ s`, cover the whole space. -/
 lemma countable_cover_nhds_of_sigma_compact {f : α → set α}
-  (hf : ∀ x, f x ∈ 𝓝 x) : ∃ s : set α, countable s ∧ (⋃ x ∈ s, f x) = univ :=
+  (hf : ∀ x, f x ∈ 𝓝 x) : ∃ s : set α, s.countable ∧ (⋃ x ∈ s, f x) = univ :=
 begin
   simp only [← nhds_within_univ] at hf,
   rcases countable_cover_nhds_within_of_sigma_compact is_closed_univ (λ x _, hf x)
@@ -1319,7 +1497,7 @@ protected lemma is_clopen.is_closed (hs : is_clopen s) : is_closed s := hs.2
 
 lemma is_clopen_iff_frontier_eq_empty {s : set α} : is_clopen s ↔ frontier s = ∅ :=
 begin
-  rw [is_clopen, ← closure_eq_iff_is_closed, ← interior_eq_iff_open, frontier, diff_eq_empty],
+  rw [is_clopen, ← closure_eq_iff_is_closed, ← interior_eq_iff_is_open, frontier, diff_eq_empty],
   refine ⟨λ h, (h.2.trans h.1.symm).subset, λ h, _⟩,
   exact ⟨interior_subset.antisymm (subset_closure.trans h),
     (h.trans interior_subset).antisymm subset_closure⟩
@@ -1348,28 +1526,41 @@ theorem is_clopen.compl {s : set α} (hs : is_clopen s) : is_clopen sᶜ :=
 theorem is_clopen.diff {s t : set α} (hs : is_clopen s) (ht : is_clopen t) : is_clopen (s \ t) :=
 hs.inter ht.compl
 
-lemma is_clopen_Union {β : Type*} [fintype β] {s : β → set α}
-  (h : ∀ i, is_clopen (s i)) : is_clopen (⋃ i, s i) :=
+lemma is_clopen.prod {s : set α} {t : set β} (hs : is_clopen s) (ht : is_clopen t) :
+  is_clopen (s ×ˢ t) :=
+⟨hs.1.prod ht.1, hs.2.prod ht.2⟩
+
+lemma is_clopen_Union {β : Type*} [finite β] {s : β → set α} (h : ∀ i, is_clopen (s i)) :
+  is_clopen (⋃ i, s i) :=
 ⟨is_open_Union (forall_and_distrib.1 h).1, is_closed_Union (forall_and_distrib.1 h).2⟩
 
-lemma is_clopen_bUnion {β : Type*} {s : finset β} {f : β → set α} (h : ∀ i ∈ s, is_clopen $ f i) :
+lemma is_clopen_bUnion {β : Type*} {s : set β} {f : β → set α} (hs : s.finite)
+  (h : ∀ i ∈ s, is_clopen $ f i) :
   is_clopen (⋃ i ∈ s, f i) :=
-begin
-  refine ⟨is_open_bUnion (λ i hi, (h i hi).1), _⟩,
-  show is_closed (⋃ (i : β) (H : i ∈ (s : set β)), f i),
-  rw bUnion_eq_Union,
-  exact is_closed_Union (λ ⟨i, hi⟩,(h i hi).2)
-end
+⟨is_open_bUnion (λ i hi, (h i hi).1), is_closed_bUnion hs (λ i hi, (h i hi).2)⟩
+
+lemma is_clopen_bUnion_finset {β : Type*} {s : finset β} {f : β → set α}
+  (h : ∀ i ∈ s, is_clopen $ f i) :
+  is_clopen (⋃ i ∈ s, f i) :=
+is_clopen_bUnion s.finite_to_set h
 
-lemma is_clopen_Inter {β : Type*} [fintype β] {s : β → set α}
-  (h : ∀ i, is_clopen (s i)) : is_clopen (⋂ i, s i) :=
+lemma is_clopen_Inter {β : Type*} [finite β] {s : β → set α} (h : ∀ i, is_clopen (s i)) :
+  is_clopen (⋂ i, s i) :=
 ⟨(is_open_Inter (forall_and_distrib.1 h).1), (is_closed_Inter (forall_and_distrib.1 h).2)⟩
 
-lemma is_clopen_bInter {β : Type*} {s : finset β} {f : β → set α} (h : ∀ i ∈ s, is_clopen (f i)) :
+lemma is_clopen_bInter {β : Type*} {s : set β} (hs : s.finite) {f : β → set α}
+  (h : ∀ i ∈ s, is_clopen (f i)) :
+  is_clopen (⋂ i ∈ s, f i) :=
+⟨is_open_bInter hs (λ i hi, (h i hi).1), is_closed_bInter (λ i hi, (h i hi).2)⟩
+
+lemma is_clopen_bInter_finset {β : Type*} {s : finset β} {f : β → set α}
+  (h : ∀ i ∈ s, is_clopen (f i)) :
   is_clopen (⋂ i ∈ s, f i) :=
-⟨ is_open_bInter ⟨finset_coe.fintype s⟩ (λ i hi, (h i hi).1),
-  by {show is_closed (⋂ (i : β) (H : i ∈ (↑s : set β)), f i), rw bInter_eq_Inter,
-    apply is_closed_Inter, rintro ⟨i, hi⟩, exact (h i hi).2}⟩
+is_clopen_bInter s.finite_to_set h
+
+lemma is_clopen.preimage {s : set β} (h : is_clopen s) {f : α → β} (hf : continuous f) :
+  is_clopen (f ⁻¹' s) :=
+⟨h.1.preimage hf, h.2.preimage hf⟩
 
 lemma continuous_on.preimage_clopen_of_clopen
   {f : α → β} {s : set α} {t : set β} (hf : continuous_on f s) (hs : is_clopen s)
@@ -1379,15 +1570,14 @@ lemma continuous_on.preimage_clopen_of_clopen
 
 /-- The intersection of a disjoint covering by two open sets of a clopen set will be clopen. -/
 theorem is_clopen_inter_of_disjoint_cover_clopen {Z a b : set α} (h : is_clopen Z)
-  (cover : Z ⊆ a ∪ b) (ha : is_open a) (hb : is_open b) (hab : a ∩ b = ∅) : is_clopen (Z ∩ a) :=
+  (cover : Z ⊆ a ∪ b) (ha : is_open a) (hb : is_open b) (hab : disjoint a b) : is_clopen (Z ∩ a) :=
 begin
   refine ⟨is_open.inter h.1 ha, _⟩,
   have : is_closed (Z ∩ bᶜ) := is_closed.inter h.2 (is_closed_compl_iff.2 hb),
   convert this using 1,
-  apply subset.antisymm,
-  { exact inter_subset_inter_right Z (subset_compl_iff_disjoint.2 hab) },
-  { rintros x ⟨hx₁, hx₂⟩,
-    exact ⟨hx₁, by simpa [not_mem_of_mem_compl hx₂] using cover hx₁⟩ }
+  refine (inter_subset_inter_right Z hab.subset_compl_right).antisymm _,
+  rintro x ⟨hx₁, hx₂⟩,
+  exact ⟨hx₁, by simpa [not_mem_of_mem_compl hx₂] using cover hx₁⟩,
 end
 
 @[simp] lemma is_clopen_discrete [discrete_topology α] (x : set α) : is_clopen x :=
@@ -1401,6 +1591,28 @@ protected lemma quotient_map.is_clopen_preimage {f : α → β}
   (hf : quotient_map f) {s : set β} : is_clopen (f ⁻¹' s) ↔ is_clopen s :=
 and_congr hf.is_open_preimage hf.is_closed_preimage
 
+variables {X : Type*} [topological_space X]
+
+lemma continuous_bool_indicator_iff_clopen (U : set X) :
+  continuous U.bool_indicator ↔ is_clopen U :=
+begin
+  split,
+  { intros hc,
+    rw ← U.preimage_bool_indicator_tt,
+    exact
+      ⟨hc.is_open_preimage _ trivial, continuous_iff_is_closed.mp hc _ (is_closed_discrete _)⟩ },
+  { refine λ hU, ⟨λ s hs, _⟩,
+    rcases U.preimage_bool_indicator s with (h|h|h|h) ; rw h,
+    exacts [is_open_univ, hU.1, hU.2.is_open_compl, is_open_empty] },
+end
+
+lemma continuous_on_indicator_iff_clopen (s U : set X) :
+  continuous_on U.bool_indicator s ↔ is_clopen ((coe : s → X) ⁻¹' U) :=
+begin
+  rw [continuous_on_iff_continuous_restrict, ← continuous_bool_indicator_iff_clopen],
+  refl
+end
+
 end clopen
 
 section preirreducible
@@ -1431,17 +1643,17 @@ lemma set.subsingleton.is_preirreducible {s : set α} (hs : s.subsingleton) :
 theorem is_irreducible_singleton {x} : is_irreducible ({x} : set α) :=
 ⟨singleton_nonempty x, subsingleton_singleton.is_preirreducible⟩
 
-theorem is_preirreducible.closure {s : set α} (H : is_preirreducible s) :
-  is_preirreducible (closure s) :=
-λ u v hu hv ⟨y, hycs, hyu⟩ ⟨z, hzcs, hzv⟩,
-let ⟨p, hpu, hps⟩ := mem_closure_iff.1 hycs u hu hyu in
-let ⟨q, hqv, hqs⟩ := mem_closure_iff.1 hzcs v hv hzv in
-let ⟨r, hrs, hruv⟩ := H u v hu hv ⟨p, hps, hpu⟩ ⟨q, hqs, hqv⟩ in
-⟨r, subset_closure hrs, hruv⟩
+theorem is_preirreducible_iff_closure {s : set α} :
+  is_preirreducible (closure s) ↔ is_preirreducible s :=
+forall₄_congr $ λ u v hu hv,
+  by { iterate 3 { rw closure_inter_open_nonempty_iff }, exacts [hu.inter hv, hv, hu] }
+
+theorem is_irreducible_iff_closure {s : set α} :
+  is_irreducible (closure s) ↔ is_irreducible s :=
+and_congr closure_nonempty_iff is_preirreducible_iff_closure
 
-lemma is_irreducible.closure {s : set α} (h : is_irreducible s) :
-  is_irreducible (closure s) :=
-⟨h.nonempty.closure, h.is_preirreducible.closure⟩
+alias is_preirreducible_iff_closure ↔ _ is_preirreducible.closure
+alias is_irreducible_iff_closure ↔ _ is_irreducible.closure
 
 theorem exists_preirreducible (s : set α) (H : is_preirreducible s) :
   ∃ t : set α, is_preirreducible t ∧ s ⊆ t ∧ ∀ u, is_preirreducible u → t ⊆ u → u = t :=
@@ -1460,6 +1672,29 @@ let ⟨m, hm, hsm, hmm⟩ := zorn_subset_nonempty {t : set α | is_preirreducibl
     λ x hxc, subset_sUnion_of_mem hxc⟩) s H in
 ⟨m, hm, hsm, λ u hu hmu, hmm _ hu hmu⟩
 
+/-- The set of irreducible components of a topological space. -/
+def irreducible_components (α : Type*) [topological_space α] : set (set α) :=
+maximals (≤) { s : set α | is_irreducible s }
+
+lemma is_closed_of_mem_irreducible_components (s ∈ irreducible_components α) :
+  is_closed s :=
+begin
+  rw [← closure_eq_iff_is_closed, eq_comm],
+  exact subset_closure.antisymm (H.2 H.1.closure subset_closure),
+end
+
+lemma irreducible_components_eq_maximals_closed (α : Type*) [topological_space α] :
+  irreducible_components α = maximals (≤) { s : set α | is_closed s ∧ is_irreducible s } :=
+begin
+  ext s,
+  split,
+  { intro H, exact ⟨⟨is_closed_of_mem_irreducible_components _ H, H.1⟩, λ x h e, H.2 h.2 e⟩ },
+  { intro H, refine ⟨H.1.2, λ x h e, _⟩,
+    have : closure x ≤ s,
+    { exact H.2 ⟨is_closed_closure, h.closure⟩ (e.trans subset_closure) },
+    exact le_trans subset_closure this }
+end
+
 /-- A maximal irreducible set that contains a given point. -/
 def irreducible_component (x : α) : set α :=
 classical.some (exists_preirreducible {x} is_irreducible_singleton.is_preirreducible)
@@ -1479,11 +1714,13 @@ theorem eq_irreducible_component {x : α} :
   ∀ {s : set α}, is_preirreducible s → irreducible_component x ⊆ s → s = irreducible_component x :=
 (irreducible_component_property x).2.2
 
+lemma irreducible_component_mem_irreducible_components (x : α) :
+  irreducible_component x ∈ irreducible_components α :=
+⟨is_irreducible_irreducible_component, λ s h₁ h₂,(eq_irreducible_component h₁.2 h₂).le⟩
+
 theorem is_closed_irreducible_component {x : α} :
   is_closed (irreducible_component x) :=
-closure_eq_iff_is_closed.1 $ eq_irreducible_component
-  is_irreducible_irreducible_component.is_preirreducible.closure
-  subset_closure
+is_closed_of_mem_irreducible_components _ (irreducible_component_mem_irreducible_components x)
 
 /-- A preirreducible space is one where there is no non-trivial pair of disjoint opens. -/
 class preirreducible_space (α : Type u) [topological_space α] : Prop :=
@@ -1511,6 +1748,11 @@ theorem nonempty_preirreducible_inter [preirreducible_space α] {s t : set α} :
 by simpa only [univ_inter, univ_subset_iff] using
   @preirreducible_space.is_preirreducible_univ α _ _ s t
 
+/-- In a (pre)irreducible space, a nonempty open set is dense. -/
+protected theorem is_open.dense [preirreducible_space α] {s : set α} (ho : is_open s)
+  (hne : s.nonempty) : dense s :=
+dense_iff_inter_open.2 $ λ t hto htne, nonempty_preirreducible_inter hto ho htne hne
+
 theorem is_preirreducible.image {s : set α} (H : is_preirreducible s)
   (f : α → β) (hf : continuous_on f s) : is_preirreducible (f '' s) :=
 begin
@@ -1532,7 +1774,7 @@ end
 
 theorem is_irreducible.image {s : set α} (H : is_irreducible s)
   (f : α → β) (hf : continuous_on f s) : is_irreducible (f '' s) :=
-⟨nonempty_image_iff.mpr H.nonempty, H.is_preirreducible.image f hf⟩
+⟨H.nonempty.image _, H.is_preirreducible.image f hf⟩
 
 lemma subtype.preirreducible_space {s : set α} (h : is_preirreducible s) :
   preirreducible_space s :=
@@ -1554,6 +1796,17 @@ lemma subtype.irreducible_space {s : set α} (h : is_irreducible s) :
   (subtype.preirreducible_space h.is_preirreducible).is_preirreducible_univ,
   to_nonempty := h.nonempty.to_subtype }
 
+/-- An infinite type with cofinite topology is an irreducible topological space. -/
+@[priority 100] instance {α} [infinite α] : irreducible_space (cofinite_topology α) :=
+{ is_preirreducible_univ := λ u v,
+    begin
+      haveI : infinite (cofinite_topology α) := ‹_›,
+      simp only [cofinite_topology.is_open_iff, univ_inter],
+      intros hu hv hu' hv',
+      simpa only [compl_union, compl_compl] using ((hu hu').union (hv hv')).infinite_compl.nonempty
+    end,
+  to_nonempty := (infer_instance : nonempty α) }
+
 /-- A set `s` is irreducible if and only if
 for every finite collection of open sets all of whose members intersect `s`,
 `s` also intersects the intersection of the entire collection
diff --git a/src/topology/support.lean b/src/topology/support.lean
index 708e55ebc648f..e52a6225b8039 100644
--- a/src/topology/support.lean
+++ b/src/topology/support.lean
@@ -9,6 +9,9 @@ import topology.separation
 /-!
 # The topological support of a function
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we define the topological support of a function `f`, `tsupport f`,
 as the closure of the support of `f`.
 
@@ -28,7 +31,7 @@ Furthermore, we say that `f` has compact support if the topological support of `
 -/
 
 open function set filter
-open_locale topological_space
+open_locale topology
 
 variables {X α α' β γ δ M E R : Type*}
 
@@ -56,7 +59,7 @@ lemma mul_tsupport_eq_empty_iff {f : X → α} : mul_tsupport f = ∅ ↔ f = 1
 by rw [mul_tsupport, closure_empty_iff, mul_support_eq_empty_iff]
 
 @[to_additive]
-lemma image_eq_zero_of_nmem_mul_tsupport {f : X → α} {x : X} (hx : x ∉ mul_tsupport f) : f x = 1 :=
+lemma image_eq_one_of_nmem_mul_tsupport {f : X → α} {x : X} (hx : x ∉ mul_tsupport f) : f x = 1 :=
 mul_support_subset_iff'.mp (subset_mul_tsupport f) x hx
 
 @[to_additive]
@@ -70,8 +73,21 @@ lemma range_eq_image_mul_tsupport_or (f : X → α) :
   range f = f '' mul_tsupport f ∨ range f = insert 1 (f '' mul_tsupport f) :=
 (wcovby_insert _ _).eq_or_eq (image_subset_range _ _) (range_subset_insert_image_mul_tsupport f)
 
+lemma tsupport_mul_subset_left {α : Type*} [mul_zero_class α] {f g : X → α} :
+  tsupport (λ x, f x * g x) ⊆ tsupport f :=
+closure_mono (support_mul_subset_left _ _)
+
+lemma tsupport_mul_subset_right {α : Type*} [mul_zero_class α] {f g : X → α} :
+  tsupport (λ x, f x * g x) ⊆ tsupport g :=
+closure_mono (support_mul_subset_right _ _)
+
 end one
 
+lemma tsupport_smul_subset_left {M α} [topological_space X] [has_zero M] [has_zero α]
+  [smul_with_zero M α] (f : X → M) (g : X → α) :
+  tsupport (λ x, f x • g x) ⊆ tsupport f :=
+closure_mono $ support_smul_subset_left f g
+
 section
 
 variables [topological_space α] [topological_space α']
@@ -79,10 +95,15 @@ variables [has_one β] [has_one γ] [has_one δ]
 variables {g : β → γ} {f : α → β} {f₂ : α → γ} {m : β → γ → δ} {x : α}
 
 @[to_additive]
-lemma not_mem_closure_mul_support_iff_eventually_eq : x ∉ mul_tsupport f ↔ f =ᶠ[𝓝 x] 1 :=
+lemma not_mem_mul_tsupport_iff_eventually_eq : x ∉ mul_tsupport f ↔ f =ᶠ[𝓝 x] 1 :=
 by simp_rw [mul_tsupport, mem_closure_iff_nhds, not_forall, not_nonempty_iff_eq_empty,
     ← disjoint_iff_inter_eq_empty, disjoint_mul_support_iff, eventually_eq_iff_exists_mem]
 
+@[to_additive] lemma continuous_of_mul_tsupport [topological_space β] {f : α → β}
+  (hf : ∀ x ∈ mul_tsupport f, continuous_at f x) : continuous f :=
+continuous_iff_continuous_at.2 $ λ x, (em _).elim (hf x) $ λ hx,
+  (@continuous_at_const _ _ _ _ _ 1).congr (not_mem_mul_tsupport_iff_eventually_eq.mp hx).symm
+
 /-- A function `f` *has compact multiplicative support* or is *compactly supported* if the closure
 of the multiplicative support of `f` is compact. In a T₂ space this is equivalent to `f` being equal
 to `1` outside a compact set. -/
@@ -120,7 +141,7 @@ lemma has_compact_mul_support_iff_eventually_eq :
 ⟨ λ h, mem_coclosed_compact.mpr ⟨mul_tsupport f, is_closed_mul_tsupport _, h,
     λ x, not_imp_comm.mpr $ λ hx, subset_mul_tsupport f hx⟩,
   λ h, let ⟨C, hC⟩ := mem_coclosed_compact'.mp h in
-    compact_of_is_closed_subset hC.2.1 (is_closed_mul_tsupport _) (closure_minimal hC.2.2 hC.1)⟩
+    is_compact_of_is_closed_subset hC.2.1 (is_closed_mul_tsupport _) (closure_minimal hC.2.2 hC.1)⟩
 
 @[to_additive]
 lemma has_compact_mul_support.is_compact_range [topological_space β]
@@ -133,7 +154,7 @@ end
 @[to_additive]
 lemma has_compact_mul_support.mono' {f' : α → γ} (hf : has_compact_mul_support f)
   (hff' : mul_support f' ⊆ mul_tsupport f) : has_compact_mul_support f' :=
-compact_of_is_closed_subset hf is_closed_closure $ closure_minimal hff' is_closed_closure
+is_compact_of_is_closed_subset hf is_closed_closure $ closure_minimal hff' is_closed_closure
 
 @[to_additive]
 lemma has_compact_mul_support.mono {f' : α → γ} (hf : has_compact_mul_support f)
@@ -155,7 +176,7 @@ lemma has_compact_mul_support.comp_closed_embedding (hf : has_compact_mul_suppor
   {g : α' → α} (hg : closed_embedding g) : has_compact_mul_support (f ∘ g) :=
 begin
   rw [has_compact_mul_support_def, function.mul_support_comp_eq_preimage],
-  refine compact_of_is_closed_subset (hg.is_compact_preimage hf) is_closed_closure _,
+  refine is_compact_of_is_closed_subset (hg.is_compact_preimage hf) is_closed_closure _,
   rw [hg.to_embedding.closure_eq_preimage_closure_image],
   exact preimage_mono (closure_mono $ image_preimage_subset _ _)
 end
@@ -210,7 +231,7 @@ end
 lemma has_compact_support.smul_left' (hf : has_compact_support f') : has_compact_support (f • f') :=
 begin
   rw [has_compact_support_iff_eventually_eq] at hf ⊢,
-  refine hf.mono (λ x hx, by simp_rw [pi.smul_apply', hx, pi.zero_apply, smul_zero'])
+  refine hf.mono (λ x hx, by simp_rw [pi.smul_apply', hx, pi.zero_apply, smul_zero])
 end
 
 end smul_with_zero
diff --git a/src/topology/tactic.lean b/src/topology/tactic.lean
index 9339cd4426749..2836094187eb9 100644
--- a/src/topology/tactic.lean
+++ b/src/topology/tactic.lean
@@ -11,6 +11,9 @@ import topology.basic
 /-!
 # Tactics for topology
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Currently we have one domain-specific tactic for topology: `continuity`.
 
 -/
diff --git a/src/topology/tietze_extension.lean b/src/topology/tietze_extension.lean
index 7fda729bf52a9..5364e367cb487 100644
--- a/src/topology/tietze_extension.lean
+++ b/src/topology/tietze_extension.lean
@@ -3,13 +3,17 @@ Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Yury G. Kudryashov
 -/
-import data.set.intervals.monotone
+import analysis.specific_limits.basic
+import data.set.intervals.iso_Ioo
 import topology.algebra.order.monotone_continuity
 import topology.urysohns_bounded
 
 /-!
 # Tietze extension theorem
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove a few version of the Tietze extension theorem. The theorem says that a
 continuous function `s → ℝ` defined on a closed set in a normal topological space `Y` can be
 extended to a continuous function on the whole space. Moreover, if all values of the original
@@ -34,55 +38,55 @@ Tietze extension theorem, Urysohn's lemma, normal topological space
 variables {X Y : Type*} [topological_space X] [topological_space Y] [normal_space Y]
 
 open metric set filter
-open_locale bounded_continuous_function topological_space
+open_locale bounded_continuous_function topology
 noncomputable theory
 
 namespace bounded_continuous_function
 
 /-- One step in the proof of the Tietze extension theorem. If `e : C(X, Y)` is a closed embedding
 of a topological space into a normal topological space and `f : X →ᵇ ℝ` is a bounded continuous
-function, then there exists a bounded continuous function `g : Y →ᵇ ℝ` of the norm `∥g∥ ≤ ∥f∥ / 3`
-such that the distance between `g ∘ e` and `f` is at most `(2 / 3) * ∥f∥`. -/
+function, then there exists a bounded continuous function `g : Y →ᵇ ℝ` of the norm `‖g‖ ≤ ‖f‖ / 3`
+such that the distance between `g ∘ e` and `f` is at most `(2 / 3) * ‖f‖`. -/
 lemma tietze_extension_step (f : X →ᵇ ℝ) (e : C(X, Y)) (he : closed_embedding e) :
-  ∃ g : Y →ᵇ ℝ, ∥g∥ ≤ ∥f∥ / 3 ∧ dist (g.comp_continuous e) f ≤ (2 / 3) * ∥f∥ :=
+  ∃ g : Y →ᵇ ℝ, ‖g‖ ≤ ‖f‖ / 3 ∧ dist (g.comp_continuous e) f ≤ (2 / 3) * ‖f‖ :=
 begin
   have h3 : (0 : ℝ) < 3 := by norm_num1,
   have h23 : 0 < (2 / 3 : ℝ) := by norm_num1,
   -- In the trivial case `f = 0`, we take `g = 0`
   rcases eq_or_ne f 0 with (rfl|hf), { use 0, simp },
-  replace hf : 0 < ∥f∥ := norm_pos_iff.2 hf,
-  /- Otherwise, the closed sets `e '' (f ⁻¹' (Iic (-∥f∥ / 3)))` and `e '' (f ⁻¹' (Ici (∥f∥ / 3)))`
-  are disjoint, hence by Urysohn's lemma there exists a function `g` that is equal to `-∥f∥ / 3`
-  on the former set and is equal to `∥f∥ / 3` on the latter set. This function `g` satisfies the
+  replace hf : 0 < ‖f‖ := norm_pos_iff.2 hf,
+  /- Otherwise, the closed sets `e '' (f ⁻¹' (Iic (-‖f‖ / 3)))` and `e '' (f ⁻¹' (Ici (‖f‖ / 3)))`
+  are disjoint, hence by Urysohn's lemma there exists a function `g` that is equal to `-‖f‖ / 3`
+  on the former set and is equal to `‖f‖ / 3` on the latter set. This function `g` satisfies the
   assertions of the lemma. -/
-  have hf3 : -∥f∥ / 3 < ∥f∥ / 3, from (div_lt_div_right h3).2 (left.neg_lt_self hf),
-  have hc₁ : is_closed (e '' (f ⁻¹' (Iic (-∥f∥ / 3)))),
+  have hf3 : -‖f‖ / 3 < ‖f‖ / 3, from (div_lt_div_right h3).2 (left.neg_lt_self hf),
+  have hc₁ : is_closed (e '' (f ⁻¹' (Iic (-‖f‖ / 3)))),
     from he.is_closed_map _ (is_closed_Iic.preimage f.continuous),
-  have hc₂ : is_closed (e '' (f ⁻¹' (Ici (∥f∥ / 3)))),
+  have hc₂ : is_closed (e '' (f ⁻¹' (Ici (‖f‖ / 3)))),
     from he.is_closed_map _ (is_closed_Ici.preimage f.continuous),
-  have hd : disjoint (e '' (f ⁻¹' (Iic (-∥f∥ / 3)))) (e '' (f ⁻¹' (Ici (∥f∥ / 3)))),
-  { refine disjoint_image_of_injective he.inj (disjoint_preimage _ _),
+  have hd : disjoint (e '' (f ⁻¹' (Iic (-‖f‖ / 3)))) (e '' (f ⁻¹' (Ici (‖f‖ / 3)))),
+  { refine disjoint_image_of_injective he.inj (disjoint.preimage _ _),
     rwa [Iic_disjoint_Ici, not_le] },
   rcases exists_bounded_mem_Icc_of_closed_of_le hc₁ hc₂ hd hf3.le with ⟨g, hg₁, hg₂, hgf⟩,
   refine ⟨g, _, _⟩,
   { refine (norm_le $ div_nonneg hf.le h3.le).mpr (λ y, _),
-    simpa [real.norm_eq_abs, abs_le, neg_div] using hgf y },
+    simpa [abs_le, neg_div] using hgf y },
   { refine (dist_le $ mul_nonneg h23.le hf.le).mpr (λ x, _),
-    have hfx : -∥f∥ ≤ f x ∧ f x ≤ ∥f∥,
+    have hfx : -‖f‖ ≤ f x ∧ f x ≤ ‖f‖,
       by simpa only [real.norm_eq_abs, abs_le] using f.norm_coe_le_norm x,
-    cases le_total (f x) (-∥f∥ / 3) with hle₁ hle₁,
-    { calc |g (e x) - f x| = -∥f∥ / 3 - f x:
+    cases le_total (f x) (-‖f‖ / 3) with hle₁ hle₁,
+    { calc |g (e x) - f x| = -‖f‖ / 3 - f x:
         by rw [hg₁ (mem_image_of_mem _ hle₁), abs_of_nonneg (sub_nonneg.2 hle₁)]
-      ... ≤ (2 / 3) * ∥f∥ : by linarith },
-    { cases le_total (f x) (∥f∥ / 3) with hle₂ hle₂,
+      ... ≤ (2 / 3) * ‖f‖ : by linarith },
+    { cases le_total (f x) (‖f‖ / 3) with hle₂ hle₂,
       { simp only [neg_div] at *,
         calc dist (g (e x)) (f x) ≤ |g (e x)| + |f x| : dist_le_norm_add_norm _ _
-        ... ≤ ∥f∥ / 3 + ∥f∥ / 3 :
+        ... ≤ ‖f‖ / 3 + ‖f‖ / 3 :
           add_le_add (abs_le.2 $ hgf _) (abs_le.2 ⟨hle₁, hle₂⟩)
-        ... = (2 / 3) * ∥f∥ : by linarith },
-      { calc |g (e x) - f x| = f x - ∥f∥ / 3 :
+        ... = (2 / 3) * ‖f‖ : by linarith },
+      { calc |g (e x) - f x| = f x - ‖f‖ / 3 :
           by rw [hg₂ (mem_image_of_mem _ hle₂), abs_sub_comm, abs_of_nonneg (sub_nonneg.2 hle₂)]
-        ... ≤ (2 / 3) * ∥f∥ : by linarith } } }
+        ... ≤ (2 / 3) * ‖f‖ : by linarith } } }
 end
 
 /-- **Tietze extension theorem** for real-valued bounded continuous maps, a version with a closed
@@ -91,7 +95,7 @@ into a normal topological space and `f : X →ᵇ ℝ` is a bounded continuous f
 a bounded continuous function `g : Y →ᵇ ℝ` of the same norm such that `g ∘ e = f`. -/
 lemma exists_extension_norm_eq_of_closed_embedding' (f : X →ᵇ ℝ) (e : C(X, Y))
   (he : closed_embedding e) :
-  ∃ g : Y →ᵇ ℝ, ∥g∥ = ∥f∥ ∧ g.comp_continuous e = f :=
+  ∃ g : Y →ᵇ ℝ, ‖g‖ = ‖f‖ ∧ g.comp_continuous e = f :=
 begin
   /- For the proof, we iterate `tietze_extension_step`. Each time we apply it to the difference
   between the previous approximation and `f`. -/
@@ -100,29 +104,29 @@ begin
   have g0 : g 0 = 0 := rfl,
   have g_succ : ∀ n, g (n + 1) = g n + F (f - (g n).comp_continuous e),
     from λ n, function.iterate_succ_apply' _ _ _,
-  have hgf : ∀ n, dist ((g n).comp_continuous e) f ≤ (2 / 3) ^ n * ∥f∥,
+  have hgf : ∀ n, dist ((g n).comp_continuous e) f ≤ (2 / 3) ^ n * ‖f‖,
   { intro n, induction n with n ihn,
     { simp [g0] },
     { rw [g_succ n, add_comp_continuous, ← dist_sub_right, add_sub_cancel', pow_succ, mul_assoc],
       refine (hF_dist _).trans (mul_le_mul_of_nonneg_left _ (by norm_num1)),
       rwa ← dist_eq_norm' } },
-  have hg_dist : ∀ n, dist (g n) (g (n + 1)) ≤ 1 / 3 * ∥f∥ * (2 / 3) ^ n,
+  have hg_dist : ∀ n, dist (g n) (g (n + 1)) ≤ 1 / 3 * ‖f‖ * (2 / 3) ^ n,
   { intro n,
-    calc dist (g n) (g (n + 1)) = ∥F (f - (g n).comp_continuous e)∥ :
+    calc dist (g n) (g (n + 1)) = ‖F (f - (g n).comp_continuous e)‖ :
       by rw [g_succ, dist_eq_norm', add_sub_cancel']
-    ... ≤ ∥f - (g n).comp_continuous e∥ / 3 : hF_norm _
+    ... ≤ ‖f - (g n).comp_continuous e‖ / 3 : hF_norm _
     ... = (1 / 3) * dist ((g n).comp_continuous e) f :
       by rw [dist_eq_norm', one_div, div_eq_inv_mul]
-    ... ≤ (1 / 3) * ((2 / 3) ^ n * ∥f∥) :
+    ... ≤ (1 / 3) * ((2 / 3) ^ n * ‖f‖) :
       mul_le_mul_of_nonneg_left (hgf n) (by norm_num1)
-    ... = 1 / 3 * ∥f∥ * (2 / 3) ^ n : by ac_refl },
+    ... = 1 / 3 * ‖f‖ * (2 / 3) ^ n : by ac_refl },
   have hg_cau : cauchy_seq g, from cauchy_seq_of_le_geometric _ _ (by norm_num1) hg_dist,
   have : tendsto (λ n, (g n).comp_continuous e) at_top (𝓝 $ (lim at_top g).comp_continuous e),
     from ((continuous_comp_continuous e).tendsto _).comp hg_cau.tendsto_lim,
   have hge : (lim at_top g).comp_continuous e = f,
   { refine tendsto_nhds_unique this (tendsto_iff_dist_tendsto_zero.2 _),
     refine squeeze_zero (λ _, dist_nonneg) hgf _,
-    rw ← zero_mul (∥f∥),
+    rw ← zero_mul (‖f‖),
     refine (tendsto_pow_at_top_nhds_0_of_lt_1 _ _).mul tendsto_const_nhds; norm_num1 },
   refine ⟨lim at_top g, le_antisymm _ _, hge⟩,
   { rw [← dist_zero_left, ← g0],
@@ -138,7 +142,7 @@ into a normal topological space and `f : X →ᵇ ℝ` is a bounded continuous f
 a bounded continuous function `g : Y →ᵇ ℝ` of the same norm such that `g ∘ e = f`. -/
 lemma exists_extension_norm_eq_of_closed_embedding (f : X →ᵇ ℝ) {e : X → Y}
   (he : closed_embedding e) :
-  ∃ g : Y →ᵇ ℝ, ∥g∥ = ∥f∥ ∧ g ∘ e = f :=
+  ∃ g : Y →ᵇ ℝ, ‖g‖ = ‖f‖ ∧ g ∘ e = f :=
 begin
   rcases exists_extension_norm_eq_of_closed_embedding' f ⟨e, he.continuous⟩ he with ⟨g, hg, rfl⟩,
   exact ⟨g, hg, rfl⟩
@@ -149,7 +153,7 @@ set. If `f` is a bounded continuous real-valued function defined on a closed set
 topological space, then it can be extended to a bounded continuous function of the same norm defined
 on the whole space. -/
 lemma exists_norm_eq_restrict_eq_of_closed {s : set Y} (f : s →ᵇ ℝ) (hs : is_closed s) :
-  ∃ g : Y →ᵇ ℝ, ∥g∥ = ∥f∥ ∧ g.restrict s = f :=
+  ∃ g : Y →ᵇ ℝ, ‖g‖ = ‖f‖ ∧ g.restrict s = f :=
 exists_extension_norm_eq_of_closed_embedding' f ((continuous_map.id _).restrict s)
   (closed_embedding_subtype_coe hs)
 
@@ -168,7 +172,7 @@ begin
   rcases exists_extension_norm_eq_of_closed_embedding (f - const X ((a + b) / 2)) he
     with ⟨g, hgf, hge⟩,
   refine ⟨const Y ((a + b) / 2) + g, λ y, _, _⟩,
-  { suffices : ∥f - const X ((a + b) / 2)∥ ≤ (b - a) / 2,
+  { suffices : ‖f - const X ((a + b) / 2)‖ ≤ (b - a) / 2,
       by simpa [real.Icc_eq_closed_ball, add_mem_closed_ball_iff_norm]
         using (norm_coe_le_norm g y).trans (hgf.trans_le this),
     refine (norm_le $ div_nonneg (sub_nonneg.2 hle) zero_le_two).2 (λ x, _),
@@ -219,8 +223,9 @@ begin
     function `dg : Y → ℝ` such that `dg ∘ e = 0`, `dg y = 0` whenever `c ≤ g y`, `dg y = c - a`
     whenever `g y = a`, and `0 ≤ dg y ≤ c - a` for all `y`.  -/
     have hd : disjoint (range e ∪ g ⁻¹' (Ici c)) (g ⁻¹' {a}),
-    { refine disjoint_union_left.2 ⟨_, disjoint_preimage _ _⟩,
-      { rintro _ ⟨⟨x, rfl⟩, rfl : g (e x) = a⟩,
+    { refine disjoint_union_left.2 ⟨_, disjoint.preimage _ _⟩,
+      { rw set.disjoint_left,
+        rintro _ ⟨x, rfl⟩ (rfl : g (e x) = a),
         exact ha' ⟨x, (congr_fun hgf x).symm⟩ },
       { exact set.disjoint_singleton_right.2 hac.not_le } },
     rcases exists_bounded_mem_Icc_of_closed_of_le
@@ -248,8 +253,9 @@ begin
   rcases em (∃ x, f x = b) with ⟨x, rfl⟩|hb',
   { exact ⟨g, λ y, ⟨xl y, x, hxl y, hgb y⟩, hgf⟩ },
   have hd : disjoint (range e ∪ g ⁻¹' (Iic c)) (g ⁻¹' {b}),
-  { refine disjoint_union_left.2 ⟨_, disjoint_preimage _ _⟩,
-    { rintro _ ⟨⟨x, rfl⟩, rfl : g (e x) = b⟩,
+  { refine disjoint_union_left.2 ⟨_, disjoint.preimage _ _⟩,
+    { rw set.disjoint_left,
+      rintro _ ⟨x, rfl⟩ (rfl : g (e x) = b),
       exact hb' ⟨x, (congr_fun hgf x).symm⟩ },
     { exact set.disjoint_singleton_right.2 hcb.not_le } },
   rcases exists_bounded_mem_Icc_of_closed_of_le
@@ -348,7 +354,7 @@ begin
   rcases F.exists_extension_forall_mem_of_closed_embedding hFt (hne.image _) he
     with ⟨G, hG, hGF⟩,
   set g : C(Y, ℝ) := ⟨h.symm ∘ cod_restrict G _ (λ y, ht_sub (hG y)), h.symm.continuous.comp $
-    continuous_subtype_mk _ G.continuous⟩,
+    G.continuous.subtype_mk _⟩,
   have hgG : ∀ {y a}, g y = a ↔ G y = h a,
     from λ y a, h.to_equiv.symm_apply_eq.trans subtype.ext_iff,
   refine ⟨g, λ y, _, _⟩,
diff --git a/src/topology/uniform_space/absolute_value.lean b/src/topology/uniform_space/absolute_value.lean
index 42e7a80431858..e4640629275f9 100644
--- a/src/topology/uniform_space/absolute_value.lean
+++ b/src/topology/uniform_space/absolute_value.lean
@@ -9,6 +9,9 @@ import topology.uniform_space.basic
 /-!
 # Uniform structure induced by an absolute value
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 We build a uniform space structure on a commutative ring `R` equipped with an absolute value into
 a linear ordered field `𝕜`. Of course in the case `R` is `ℚ`, `ℝ` or `ℂ` and
 `𝕜 = ℝ`, we get the same thing as the metric space construction, and the general construction
@@ -30,46 +33,21 @@ absolute value, uniform spaces
 -/
 
 open set function filter uniform_space
-open_locale filter
+open_locale filter topology
 
-namespace is_absolute_value
-variables {𝕜 : Type*} [linear_ordered_field 𝕜]
-variables {R : Type*} [comm_ring R] (abv : R → 𝕜) [is_absolute_value abv]
+namespace absolute_value
 
-/-- The uniformity coming from an absolute value. -/
-def uniform_space_core : uniform_space.core R :=
-{ uniformity := (⨅ ε>0, 𝓟 {p:R×R | abv (p.2 - p.1) < ε}),
-  refl := le_infi $ assume ε, le_infi $ assume ε_pos, principal_mono.2
-    (λ ⟨x, y⟩ h, by simpa [show x = y, from h, abv_zero abv]),
-  symm := tendsto_infi.2 $ assume ε, tendsto_infi.2 $ assume h,
-    tendsto_infi' ε $ tendsto_infi' h $ tendsto_principal_principal.2 $ λ ⟨x, y⟩ h,
-      have h : abv (y - x) < ε, by simpa [-sub_eq_add_neg] using h,
-      by rwa abv_sub abv at h,
-  comp := le_infi $ assume ε, le_infi $ assume h, lift'_le
-    (mem_infi_of_mem (ε / 2) $ mem_infi_of_mem (div_pos h zero_lt_two) (subset.refl _)) $
-    have ∀ (a b c : R), abv (c-a) < ε / 2 → abv (b-c) < ε / 2 → abv (b-a) < ε,
-      from assume a b c hac hcb,
-       calc abv (b - a) ≤ _ : abv_sub_le abv b c a
-        ... = abv (c - a) + abv (b - c) : add_comm _ _
-        ... < ε / 2 + ε / 2 : add_lt_add hac hcb
-        ... = ε : by rw [div_add_div_same, add_self_div_two],
-    by simpa [comp_rel] }
+variables {𝕜 : Type*} [linear_ordered_field 𝕜]
+variables {R : Type*} [comm_ring R] (abv : absolute_value R 𝕜)
 
-/-- The uniform structure coming from an absolute value. -/
-def uniform_space : uniform_space R :=
-uniform_space.of_core (uniform_space_core abv)
+/-- The uniform space structure coming from an absolute value. -/
+protected def uniform_space : uniform_space R :=
+uniform_space.of_fun (λ x y, abv (y - x)) (by simp) (λ x y, abv.map_sub y x)
+  (λ x y z, (abv.sub_le _ _ _).trans_eq (add_comm _ _)) $
+  λ ε ε0, ⟨ε / 2, half_pos ε0, λ _ h₁ _ h₂, (add_lt_add h₁ h₂).trans_eq (add_halves ε)⟩
 
-theorem mem_uniformity {s : set (R×R)} :
-  s ∈ (uniform_space_core abv).uniformity ↔
-  (∃ε>0, ∀{a b:R}, abv (b - a) < ε → (a, b) ∈ s) :=
-begin
-  suffices : s ∈ (⨅ ε: {ε : 𝕜 // ε > 0}, 𝓟 {p:R×R | abv (p.2 - p.1) < ε.val}) ↔ _,
-  { rw infi_subtype at this,
-    exact this },
-  rw mem_infi_of_directed,
-  { simp [subset_def] },
-  { rintros ⟨r, hr⟩ ⟨p, hp⟩,
-    exact ⟨⟨min r p, lt_min hr hp⟩, by simp [lt_min_iff, (≥)] {contextual := tt}⟩, },
-end
+theorem has_basis_uniformity :
+  𝓤[abv.uniform_space].has_basis (λ ε : 𝕜, 0 < ε) (λ ε, {p : R × R | abv (p.2 - p.1) < ε}) :=
+uniform_space.has_basis_of_fun (exists_gt _) _ _ _ _ _
 
-end is_absolute_value
+end absolute_value
diff --git a/src/topology/uniform_space/abstract_completion.lean b/src/topology/uniform_space/abstract_completion.lean
index 6c5960557923b..c419423a9b3db 100644
--- a/src/topology/uniform_space/abstract_completion.lean
+++ b/src/topology/uniform_space/abstract_completion.lean
@@ -4,10 +4,14 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Patrick Massot
 -/
 import topology.uniform_space.uniform_embedding
+import topology.uniform_space.equiv
 
 /-!
 # Abstract theory of Hausdorff completions of uniform spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file characterizes Hausdorff completions of a uniform space α as complete Hausdorff spaces
 equipped with a map from α which has dense image and induce the original uniform structure on α.
 Assuming these properties we "extend" uniformly continuous maps from α to complete Hausdorff spaces
@@ -34,7 +38,7 @@ derived from the predicate is more universe polymorphic.
 ## References
 
 We don't know any traditional text discussing this. Real world mathematics simply silently
-identify the results of any two constructions that lead to something one could reasonnably
+identify the results of any two constructions that lead to something one could reasonably
 call a completion.
 
 ## Tags
@@ -67,6 +71,10 @@ variables {α : Type*} [uniform_space α] (pkg : abstract_completion α)
 local notation `hatα` := pkg.space
 local notation `ι` := pkg.coe
 
+/-- If `α` is complete, then it is an abstract completion of itself. -/
+def of_complete [separated_space α] [complete_space α] : abstract_completion α :=
+mk α id infer_instance infer_instance infer_instance uniform_inducing_id dense_range_id
+
 lemma closure_range : closure (range ι) = univ :=
 pkg.dense.closure_range
 
@@ -222,12 +230,14 @@ begin
   refl
 end
 
-/-- The bijection between two completions of the same uniform space. -/
-def compare_equiv : pkg.space ≃ pkg'.space :=
+/-- The uniform bijection between two completions of the same uniform space. -/
+def compare_equiv : pkg.space ≃ᵤ pkg'.space :=
 { to_fun := pkg.compare pkg',
   inv_fun := pkg'.compare pkg,
   left_inv := congr_fun (pkg'.inverse_compare pkg),
-  right_inv := congr_fun (pkg.inverse_compare pkg') }
+  right_inv := congr_fun (pkg.inverse_compare pkg'),
+  uniform_continuous_to_fun := uniform_continuous_compare _ _,
+  uniform_continuous_inv_fun := uniform_continuous_compare _ _, }
 
 lemma uniform_continuous_compare_equiv : uniform_continuous (pkg.compare_equiv pkg') :=
 pkg.uniform_continuous_compare pkg'
@@ -253,8 +263,6 @@ protected def prod : abstract_completion (α × β) :=
   dense := pkg.dense.prod_map pkg'.dense }
 end prod
 
-
-
 section extension₂
 variables (pkg' : abstract_completion β)
 local notation `hatβ` := pkg'.space
@@ -299,7 +307,7 @@ variables {γ : Type*} [uniform_space γ] (pkg'' : abstract_completion γ)
 local notation `hatγ` := pkg''.space
 local notation `ι''` := pkg''.coe
 
-local notation f `∘₂` g := bicompr f g
+local notation f ` ∘₂ ` g := bicompr f g
 
 /-- Lift two variable maps to completions. -/
 protected def map₂ (f : α → β → γ) : hatα → hatβ → hatγ :=
diff --git a/src/topology/uniform_space/basic.lean b/src/topology/uniform_space/basic.lean
index dab3dfc966d1e..4e0e68db78e0c 100644
--- a/src/topology/uniform_space/basic.lean
+++ b/src/topology/uniform_space/basic.lean
@@ -3,11 +3,16 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
 -/
-import order.filter.lift
+import order.filter.small_sets
 import topology.subset_properties
+import topology.nhds_set
+
 /-!
 # Uniform spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Uniform spaces are a generalization of metric spaces and topological groups. Many concepts directly
 generalize to uniform spaces, e.g.
 
@@ -110,7 +115,7 @@ But it makes a more systematic use of the filter library.
 -/
 
 open set filter classical
-open_locale classical topological_space filter
+open_locale classical topology filter
 
 set_option eqn_compiler.zeta true
 
@@ -132,7 +137,7 @@ by simp [subset_def]; exact forall_congr (λ a, by simp)
 /-- The composition of relations -/
 def comp_rel {α : Type u} (r₁ r₂ : set (α×α)) := {p : α × α | ∃z:α, (p.1, z) ∈ r₁ ∧ (z, p.2) ∈ r₂}
 
-localized "infix ` ○ `:55 := comp_rel" in uniformity
+localized "infix (name := uniformity.comp_rel) ` ○ `:55 := comp_rel" in uniformity
 
 @[simp] theorem mem_comp_rel {r₁ r₂ : set (α×α)}
   {x y : α} : (x, y) ∈ r₁ ○ r₂ ↔ ∃ z, (x, z) ∈ r₁ ∧ (z, y) ∈ r₂ := iff.rfl
@@ -140,7 +145,7 @@ localized "infix ` ○ `:55 := comp_rel" in uniformity
 @[simp] theorem swap_id_rel : prod.swap '' id_rel = @id_rel α :=
 set.ext $ assume ⟨a, b⟩, by simp [image_swap_eq_preimage_swap]; exact eq_comm
 
-theorem monotone_comp_rel [preorder β] {f g : β → set (α×α)}
+theorem monotone.comp_rel [preorder β] {f g : β → set (α×α)}
   (hf : monotone f) (hg : monotone g) : monotone (λx, (f x) ○ (g x)) :=
 assume a b h p ⟨z, h₁, h₂⟩, ⟨z, hf h h₁, hg h h₂⟩
 
@@ -159,8 +164,21 @@ lemma comp_rel_assoc {r s t : set (α×α)} :
   (r ○ s) ○ t = r ○ (s ○ t) :=
 by ext p; cases p; simp only [mem_comp_rel]; tauto
 
-lemma subset_comp_self {α : Type*} {s : set (α × α)} (h : id_rel ⊆ s) : s ⊆ s ○ s :=
-λ ⟨x, y⟩ xy_in, ⟨x, h (by rw mem_id_rel), xy_in⟩
+lemma left_subset_comp_rel {s t : set (α × α)} (h : id_rel ⊆ t) : s ⊆ s ○ t :=
+λ ⟨x, y⟩ xy_in, ⟨y, xy_in, h $ by exact rfl⟩
+
+lemma right_subset_comp_rel {s t : set (α × α)} (h : id_rel ⊆ s) : t ⊆ s ○ t :=
+λ ⟨x, y⟩ xy_in, ⟨x, h $ by exact rfl, xy_in⟩
+
+lemma subset_comp_self {s : set (α × α)} (h : id_rel ⊆ s) : s ⊆ s ○ s :=
+left_subset_comp_rel h
+
+lemma subset_iterate_comp_rel {s t : set (α × α)} (h : id_rel ⊆ s) (n : ℕ) :
+  t ⊆ (((○) s) ^[n] t) :=
+begin
+  induction n with n ihn generalizing t,
+  exacts [subset.rfl, (right_subset_comp_rel h).trans ihn]
+end
 
 /-- The relation is invariant under swapping factors. -/
 def symmetric_rel (V : set (α × α)) : Prop := prod.swap ⁻¹' V = V
@@ -178,12 +196,15 @@ sep_subset _ _
 lemma symmetrize_mono {V W: set (α × α)} (h : V ⊆ W) : symmetrize_rel V ⊆ symmetrize_rel W :=
 inter_subset_inter h $ preimage_mono h
 
-lemma symmetric_rel_inter {U V : set (α × α)} (hU : symmetric_rel U) (hV : symmetric_rel V) :
-symmetric_rel (U ∩ V) :=
-begin
-  unfold symmetric_rel at *,
-  rw [preimage_inter, hU, hV],
-end
+lemma symmetric_rel.mk_mem_comm {V : set (α × α)} (hV : symmetric_rel V) {x y : α} :
+  (x, y) ∈ V ↔ (y, x) ∈ V :=
+set.ext_iff.1 hV (y, x)
+
+lemma symmetric_rel.eq {U : set (α × α)} (hU : symmetric_rel U) : prod.swap ⁻¹' U = U := hU
+
+lemma symmetric_rel.inter {U V : set (α × α)} (hU : symmetric_rel U) (hV : symmetric_rel V) :
+  symmetric_rel (U ∩ V) :=
+by rw [symmetric_rel, preimage_inter, hU.eq, hV.eq]
 
 /-- This core description of a uniform space is outside of the type class hierarchy. It is useful
   for constructions of uniform spaces, when the topology is derived from the uniform space. -/
@@ -200,12 +221,7 @@ def uniform_space.core.mk' {α : Type u} (U : filter (α × α))
   (symm : ∀ r ∈ U, prod.swap ⁻¹' r ∈ U)
   (comp : ∀ r ∈ U, ∃ t ∈ U, t ○ t ⊆ r) : uniform_space.core α :=
 ⟨U, λ r ru, id_rel_subset.2 (refl _ ru), symm,
-  begin
-    intros r ru,
-    rw [mem_lift'_sets],
-    exact comp _ ru,
-    apply monotone_comp_rel; exact monotone_id,
-  end⟩
+  λ r ru, let ⟨s, hs, hsr⟩ := comp _ ru in mem_of_superset (mem_lift' hs) hsr⟩
 
 /-- Defining an `uniform_space.core` from a filter basis satisfying some uniformity-like axioms. -/
 def uniform_space.core.mk_of_basis {α : Type u} (B : filter_basis (α × α))
@@ -215,7 +231,7 @@ def uniform_space.core.mk_of_basis {α : Type u} (B : filter_basis (α × α))
 { uniformity := B.filter,
   refl := B.has_basis.ge_iff.mpr (λ r ru, id_rel_subset.2 $ refl _ ru),
   symm := (B.has_basis.tendsto_iff B.has_basis).mpr symm,
-  comp := (has_basis.le_basis_iff (B.has_basis.lift' (monotone_comp_rel monotone_id monotone_id))
+  comp := (has_basis.le_basis_iff (B.has_basis.lift' (monotone_id.comp_rel monotone_id))
     B.has_basis).mpr comp }
 
 /-- A uniform space generates a topological space -/
@@ -230,7 +246,7 @@ def uniform_space.core.to_topological_space {α : Type u} (u : uniform_space.cor
 
 lemma uniform_space.core_eq :
   ∀{u₁ u₂ : uniform_space.core α}, u₁.uniformity = u₂.uniformity → u₁ = u₂
-| ⟨u₁, _, _, _⟩  ⟨u₂, _, _, _⟩ h := by { congr, exact h }
+| ⟨u₁, _, _, _⟩  ⟨u₂, _, _, _⟩ rfl := by congr
 
 -- the topological structure is embedded in the uniform structure
 -- to avoid instance diamond issues. See Note [forgetful inheritance].
@@ -243,12 +259,13 @@ lemma uniform_space.core_eq :
   A metric space has a natural uniformity, and a uniform space has a natural topology.
   A topological group also has a natural uniformity, even when it is not metrizable. -/
 class uniform_space (α : Type u) extends topological_space α, uniform_space.core α :=
-(is_open_uniformity : ∀s, is_open s ↔ (∀x∈s, { p : α × α | p.1 = x → p.2 ∈ s } ∈ uniformity))
+(is_open_uniformity : ∀s, @_root_.is_open _ to_topological_space s ↔
+  (∀x∈s, { p : α × α | p.1 = x → p.2 ∈ s } ∈ uniformity))
 
 /-- Alternative constructor for `uniform_space α` when a topology is already given. -/
 @[pattern] def uniform_space.mk' {α} (t : topological_space α)
   (c : uniform_space.core α)
-  (is_open_uniformity : ∀s:set α, t.is_open s ↔
+  (is_open_uniformity : ∀s:set α, is_open s ↔
     (∀x∈s, { p : α × α | p.1 = x → p.2 ∈ s } ∈ c.uniformity)) :
   uniform_space α := ⟨c, is_open_uniformity⟩
 
@@ -268,11 +285,17 @@ def uniform_space.of_core_eq {α : Type u} (u : uniform_space.core α) (t : topo
 
 lemma uniform_space.to_core_to_topological_space (u : uniform_space α) :
   u.to_core.to_topological_space = u.to_topological_space :=
-topological_space_eq $ funext $ assume s,
-  by rw [uniform_space.core.to_topological_space, uniform_space.is_open_uniformity]
+topological_space_eq $ funext $ λ s, by rw [uniform_space.is_open_uniformity, is_open_mk]
+
+/-- The uniformity is a filter on α × α (inferred from an ambient uniform space
+  structure on α). -/
+def uniformity (α : Type u) [uniform_space α] : filter (α × α) :=
+  (@uniform_space.to_core α _).uniformity
+
+localized "notation (name := uniformity_of) `𝓤[` u `]` := @uniformity hole! u" in topology
 
 @[ext]
-lemma uniform_space_eq : ∀{u₁ u₂ : uniform_space α}, u₁.uniformity = u₂.uniformity → u₁ = u₂
+lemma uniform_space_eq : ∀ {u₁ u₂ : uniform_space α}, 𝓤[u₁] = 𝓤[u₂] → u₁ = u₂
 | (uniform_space.mk' t₁ u₁ o₁)  (uniform_space.mk' t₂ u₂ o₂) h :=
   have u₁ = u₂, from uniform_space.core_eq h,
   have t₁ = t₂, from topological_space_eq $ funext $ assume s, by rw [o₁, o₂]; simp [this],
@@ -293,15 +316,36 @@ lemma uniform_space.replace_topology_eq {α : Type*} [i : topological_space α]
   (h : i = u.to_topological_space) : u.replace_topology h = u :=
 u.of_core_eq_to_core _ _
 
+/-- Define a `uniform_space` using a "distance" function. The function can be, e.g., the distance in
+a (usual or extended) metric space or an absolute value on a ring. -/
+def uniform_space.of_fun {α β : Type*} [ordered_add_comm_monoid β]
+  (d : α → α → β) (refl : ∀ x, d x x = 0) (symm : ∀ x y, d x y = d y x)
+  (triangle : ∀ x y z, d x z ≤ d x y + d y z)
+  (half : ∀ ε > (0 : β), ∃ δ > (0 : β), ∀ x < δ, ∀ y < δ, x + y < ε) :
+  uniform_space α :=
+uniform_space.of_core
+  { uniformity := ⨅ r > 0, 𝓟 { x | d x.1 x.2 < r },
+    refl := le_infi₂ $ λ r hr, principal_mono.2 $ id_rel_subset.2 $ λ x, by simpa [refl],
+    symm := tendsto_infi_infi $ λ r, tendsto_infi_infi $ λ _, tendsto_principal_principal.2 $
+      λ x hx, by rwa [mem_set_of, symm],
+    comp := le_infi₂ $ λ r hr, let ⟨δ, h0, hδr⟩ := half r hr in le_principal_iff.2 $ mem_of_superset
+      (mem_lift' $ mem_infi_of_mem δ $ mem_infi_of_mem h0 $ mem_principal_self _) $
+      λ ⟨x, z⟩ ⟨y, h₁, h₂⟩, (triangle _ _ _).trans_lt (hδr _ h₁ _ h₂) }
+
+lemma uniform_space.has_basis_of_fun {α β : Type*} [linear_ordered_add_comm_monoid β]
+  (h₀ : ∃ x : β, 0 < x) (d : α → α → β) (refl : ∀ x, d x x = 0) (symm : ∀ x y, d x y = d y x)
+  (triangle : ∀ x y z, d x z ≤ d x y + d y z)
+  (half : ∀ ε > (0 : β), ∃ δ > (0 : β), ∀ x < δ, ∀ y < δ, x + y < ε) :
+  𝓤[uniform_space.of_fun d refl symm triangle half].has_basis ((<) (0 : β))
+    (λ ε, { x | d x.1 x.2 < ε }) :=
+has_basis_binfi_principal'
+  (λ ε₁ h₁ ε₂ h₂, ⟨min ε₁ ε₂, lt_min h₁ h₂, λ _x hx, lt_of_lt_of_le hx (min_le_left _ _),
+    λ _x hx, lt_of_lt_of_le hx (min_le_right _ _)⟩) h₀
+
 section uniform_space
 variables [uniform_space α]
 
-/-- The uniformity is a filter on α × α (inferred from an ambient uniform space
-  structure on α). -/
-def uniformity (α : Type u) [uniform_space α] : filter (α × α) :=
-  (@uniform_space.to_core α _).uniformity
-
-localized "notation `𝓤` := uniformity" in uniformity
+localized "notation (name := uniformity) `𝓤` := uniformity" in uniformity
 
 lemma is_open_uniformity {s : set α} :
   is_open s ↔ (∀x∈s, { p : α × α | p.1 = x → p.2 ∈ s } ∈ 𝓤 α) :=
@@ -311,11 +355,7 @@ lemma refl_le_uniformity : 𝓟 id_rel ≤ 𝓤 α :=
 (@uniform_space.to_core α _).refl
 
 instance uniformity.ne_bot [nonempty α] : ne_bot (𝓤 α) :=
-begin
-  inhabit α,
-  refine (principal_ne_bot_iff.2 _).mono refl_le_uniformity,
-  exact ⟨(default, default), rfl⟩
-end
+diagonal_nonempty.principal_ne_bot.mono refl_le_uniformity
 
 lemma refl_mem_uniformity {x : α} {s : set (α × α)} (h : s ∈ 𝓤 α) :
   (x, x) ∈ s :=
@@ -323,7 +363,7 @@ refl_le_uniformity h rfl
 
 lemma mem_uniformity_of_eq {x y : α} {s : set (α × α)} (h : s ∈ 𝓤 α) (hx : x = y) :
   (x, y) ∈ s :=
-hx ▸ refl_mem_uniformity h
+refl_le_uniformity h hx
 
 lemma symm_le_uniformity : map (@prod.swap α α) (𝓤 _) ≤ (𝓤 _) :=
 (@uniform_space.to_core α _).symm
@@ -338,14 +378,35 @@ lemma comp_mem_uniformity_sets {s : set (α × α)} (hs : s ∈ 𝓤 α) :
   ∃ t ∈ 𝓤 α, t ○ t ⊆ s :=
 have s ∈ (𝓤 α).lift' (λt:set (α×α), t ○ t),
   from comp_le_uniformity hs,
-(mem_lift'_sets $ monotone_comp_rel monotone_id monotone_id).mp this
+(mem_lift'_sets $ monotone_id.comp_rel monotone_id).mp this
+
+/-- If `s ∈ 𝓤 α`, then for any natural `n`, for a subset `t` of a sufficiently small set in `𝓤 α`,
+we have `t ○ t ○ ... ○ t ⊆ s` (`n` compositions). -/
+lemma eventually_uniformity_iterate_comp_subset {s : set (α × α)} (hs : s ∈ 𝓤 α) (n : ℕ) :
+  ∀ᶠ t in (𝓤 α).small_sets, ((○) t) ^[n] t ⊆ s :=
+begin
+  suffices : ∀ᶠ t in (𝓤 α).small_sets, t ⊆ s ∧ (((○) t) ^[n] t ⊆ s),
+    from (eventually_and.1 this).2,
+  induction n with n ihn generalizing s, { simpa },
+  rcases comp_mem_uniformity_sets hs with ⟨t, htU, hts⟩,
+  refine (ihn htU).mono (λ U hU, _),
+  rw [function.iterate_succ_apply'],
+  exact ⟨hU.1.trans $ (subset_comp_self $ refl_le_uniformity htU).trans hts,
+    (comp_rel_mono hU.1 hU.2).trans hts⟩
+end
+
+/-- If `s ∈ 𝓤 α`, then for any natural `n`, for a subset `t` of a sufficiently small set in `𝓤 α`,
+we have `t ○ t ⊆ s`. -/
+lemma eventually_uniformity_comp_subset {s : set (α × α)} (hs : s ∈ 𝓤 α) :
+  ∀ᶠ t in (𝓤 α).small_sets, t ○ t ⊆ s :=
+eventually_uniformity_iterate_comp_subset hs 1
 
 /-- Relation `λ f g, tendsto (λ x, (f x, g x)) l (𝓤 α)` is transitive. -/
 lemma filter.tendsto.uniformity_trans {l : filter β} {f₁ f₂ f₃ : β → α}
   (h₁₂ : tendsto (λ x, (f₁ x, f₂ x)) l (𝓤 α)) (h₂₃ : tendsto (λ x, (f₂ x, f₃ x)) l (𝓤 α)) :
   tendsto (λ x, (f₁ x, f₃ x)) l (𝓤 α) :=
 begin
-  refine le_trans (le_lift' $ λ s hs, mem_map.2 _) comp_le_uniformity,
+  refine le_trans (le_lift'.2 $ λ s hs, mem_map.2 _) comp_le_uniformity,
   filter_upwards [h₁₂ hs, h₂₃ hs] with x hx₁₂ hx₂₃ using ⟨_, hx₁₂, hx₂₃⟩,
 end
 
@@ -372,7 +433,7 @@ lemma comp_symm_of_uniformity {s : set (α × α)} (hs : s ∈ 𝓤 α) :
   ∃ t ∈ 𝓤 α, (∀{a b}, (a, b) ∈ t → (b, a) ∈ t) ∧ t ○ t ⊆ s :=
 let ⟨t, ht₁, ht₂⟩ := comp_mem_uniformity_sets hs in
 let ⟨t', ht', ht'₁, ht'₂⟩ := symm_of_uniformity ht₁ in
-⟨t', ht', ht'₁, subset.trans (monotone_comp_rel monotone_id monotone_id ht'₂) ht₂⟩
+⟨t', ht', ht'₁, subset.trans (monotone_id.comp_rel monotone_id ht'₂) ht₂⟩
 
 lemma uniformity_le_symm : 𝓤 α ≤ (@prod.swap α α) <$> 𝓤 α :=
 by rw [map_swap_eq_comap_swap];
@@ -391,6 +452,12 @@ begin
   exact image_mem_map h,
 end
 
+/-- Symmetric entourages form a basis of `𝓤 α` -/
+lemma uniform_space.has_basis_symmetric :
+  (𝓤 α).has_basis (λ s : set (α × α), s ∈ 𝓤 α ∧ symmetric_rel s) id :=
+has_basis_self.2 $ λ t t_in, ⟨symmetrize_rel t, symmetrize_mem_uniformity t_in,
+  symmetric_symmetrize_rel t, symmetrize_rel_subset_self t⟩
+
 theorem uniformity_lift_le_swap {g : set (α×α) → filter β} {f : filter β} (hg : monotone g)
   (h : (𝓤 α).lift (λs, g (preimage prod.swap s)) ≤ f) : (𝓤 α).lift g ≤ f :=
 calc (𝓤 α).lift g ≤ (filter.map (@prod.swap α α) $ 𝓤 α).lift g :
@@ -404,7 +471,7 @@ calc (𝓤 α).lift (λs, f (s ○ s)) =
     ((𝓤 α).lift' (λs:set (α×α), s ○ s)).lift f :
   begin
     rw [lift_lift'_assoc],
-    exact monotone_comp_rel monotone_id monotone_id,
+    exact monotone_id.comp_rel monotone_id,
     exact h
   end
   ... ≤ (𝓤 α).lift f : lift_mono comp_le_uniformity le_rfl
@@ -415,16 +482,16 @@ calc (𝓤 α).lift' (λd, d ○ (d ○ d)) =
   (𝓤 α).lift (λs, (𝓤 α).lift' (λt:set(α×α), s ○ (t ○ t))) :
   begin
     rw [lift_lift'_same_eq_lift'],
-    exact (assume x, monotone_comp_rel monotone_const $ monotone_comp_rel monotone_id monotone_id),
-    exact (assume x, monotone_comp_rel monotone_id monotone_const),
+    exact (assume x, monotone_const.comp_rel $ monotone_id.comp_rel monotone_id),
+    exact (assume x, monotone_id.comp_rel monotone_const),
   end
   ... ≤ (𝓤 α).lift (λs, (𝓤 α).lift' (λt:set(α×α), s ○ t)) :
     lift_mono' $ assume s hs, @uniformity_lift_le_comp α _ _ (𝓟 ∘ (○) s) $
-      monotone_principal.comp (monotone_comp_rel monotone_const monotone_id)
+      monotone_principal.comp (monotone_const.comp_rel monotone_id)
   ... = (𝓤 α).lift' (λs:set(α×α), s ○ s) :
     lift_lift'_same_eq_lift'
-      (assume s, monotone_comp_rel monotone_const monotone_id)
-      (assume s, monotone_comp_rel monotone_id monotone_const)
+      (assume s, monotone_const.comp_rel monotone_id)
+      (assume s, monotone_id.comp_rel monotone_const)
   ... ≤ (𝓤 α) : comp_le_uniformity
 
 /-- See also `comp_open_symm_mem_uniformity_sets`. -/
@@ -480,7 +547,10 @@ lemma ball_subset_of_comp_subset {V W : set (β × β)} {x y} (h : x ∈ ball y
 λ z z_in, h' (mem_ball_comp h z_in)
 
 lemma ball_mono {V W : set (β × β)} (h : V ⊆ W) (x : β) : ball x V ⊆ ball x W :=
-by tauto
+preimage_mono h
+
+lemma ball_inter (x : β) (V W : set (β × β)) : ball x (V ∩ W) = ball x V ∩ ball x W :=
+preimage_inter
 
 lemma ball_inter_left (x : β) (V W : set (β × β)) : ball x (V ∩ W) ⊆ ball x V :=
 ball_mono (inter_subset_left V W) x
@@ -543,15 +613,8 @@ lemma mem_nhds_uniformity_iff_left {x : α} {s : set α} :
   s ∈ 𝓝 x ↔ {p : α × α | p.2 = x → p.1 ∈ s} ∈ 𝓤 α :=
 by { rw [uniformity_eq_symm, mem_nhds_uniformity_iff_right], refl }
 
-lemma nhds_eq_comap_uniformity_aux  {α : Type u} {x : α} {s : set α} {F : filter (α × α)} :
-  {p : α × α | p.fst = x → p.snd ∈ s} ∈ F ↔ s ∈ comap (prod.mk x) F :=
-by rw mem_comap ; from iff.intro
-  (assume hs, ⟨_, hs, assume x hx, hx rfl⟩)
-  (assume ⟨t, h, ht⟩, F.sets_of_superset h $
-    assume ⟨p₁, p₂⟩ hp (h : p₁ = x), ht $ by simp [h.symm, hp])
-
 lemma nhds_eq_comap_uniformity {x : α} : 𝓝 x = (𝓤 α).comap (prod.mk x) :=
-by { ext s, rw [mem_nhds_uniformity_iff_right], exact nhds_eq_comap_uniformity_aux }
+by { ext s, rw [mem_nhds_uniformity_iff_right, mem_comap_prod_mk] }
 
 /-- See also `is_open_iff_open_ball_subset`. -/
 lemma is_open_iff_ball_subset {s : set α} : is_open s ↔ ∀ x ∈ s, ∃ V ∈ 𝓤 α, ball x V ⊆ s :=
@@ -573,6 +636,9 @@ begin
   exact nhds_basis_uniformity' h
 end
 
+lemma nhds_eq_comap_uniformity' {x : α} : 𝓝 x = (𝓤 α).comap (λ y, (y, x)) :=
+(nhds_basis_uniformity (𝓤 α).basis_sets).eq_of_same_basis $ (𝓤 α).basis_sets.comap _
+
 lemma uniform_space.mem_nhds_iff {x : α} {s : set α} : s ∈ 𝓝 x ↔ ∃ V ∈ 𝓤 α, ball x V ⊆ s :=
 begin
   rw [nhds_eq_comap_uniformity, mem_comap],
@@ -615,15 +681,18 @@ lemma uniform_space.has_basis_nhds_prod (x y : α) :
   has_basis (𝓝 (x, y)) (λ s, s ∈ 𝓤 α ∧ symmetric_rel s) $ λ s, ball x s ×ˢ ball y s :=
 begin
   rw nhds_prod_eq,
-  apply (has_basis_nhds x).prod' (has_basis_nhds y),
+  apply (has_basis_nhds x).prod_same_index (has_basis_nhds y),
   rintro U V ⟨U_in, U_symm⟩ ⟨V_in, V_symm⟩,
-  exact ⟨U ∩ V, ⟨(𝓤 α).inter_sets U_in V_in, symmetric_rel_inter U_symm V_symm⟩,
+  exact ⟨U ∩ V, ⟨(𝓤 α).inter_sets U_in V_in, U_symm.inter V_symm⟩,
          ball_inter_left x U V, ball_inter_right y U V⟩,
 end
 
 lemma nhds_eq_uniformity {x : α} : 𝓝 x = (𝓤 α).lift' (ball x) :=
 (nhds_basis_uniformity' (𝓤 α).basis_sets).eq_binfi
 
+lemma nhds_eq_uniformity' {x : α} : 𝓝 x = (𝓤 α).lift' (λ s, {y | (y, x) ∈ s}) :=
+(nhds_basis_uniformity (𝓤 α).basis_sets).eq_binfi
+
 lemma mem_nhds_left (x : α) {s : set (α×α)} (h : s ∈ 𝓤 α) :
   {y : α | (x, y) ∈ s} ∈ 𝓝 x :=
 ball_mem_nhds x h
@@ -632,6 +701,63 @@ lemma mem_nhds_right (y : α) {s : set (α×α)} (h : s ∈ 𝓤 α) :
   {x : α | (x, y) ∈ s} ∈ 𝓝 y :=
 mem_nhds_left _ (symm_le_uniformity h)
 
+lemma exists_mem_nhds_ball_subset_of_mem_nhds {a : α} {U : set α} (h : U ∈ 𝓝 a) :
+  ∃ (V ∈ 𝓝 a) (t ∈ 𝓤 α), ∀ a' ∈ V, uniform_space.ball a' t ⊆ U :=
+let ⟨t, ht, htU⟩ := comp_mem_uniformity_sets (mem_nhds_uniformity_iff_right.1 h) in
+⟨_, mem_nhds_left a ht, t, ht, λ a₁ h₁ a₂ h₂, @htU (a, a₂) ⟨a₁, h₁, h₂⟩ rfl⟩
+
+lemma is_compact.nhds_set_basis_uniformity {p : ι → Prop} {s : ι → set (α × α)}
+  (hU : (𝓤 α).has_basis p s) {K : set α} (hK : is_compact K) :
+  (𝓝ˢ K).has_basis p (λ i, ⋃ x ∈ K, ball x (s i)) :=
+begin
+  refine ⟨λ U, _⟩,
+  simp only [mem_nhds_set_iff_forall, (nhds_basis_uniformity' hU).mem_iff, Union₂_subset_iff],
+  refine ⟨λ H, _, λ ⟨i, hpi, hi⟩ x hx, ⟨i, hpi, hi x hx⟩⟩,
+  replace H : ∀ x ∈ K, ∃ i : {i // p i}, ball x (s i ○ s i) ⊆ U,
+  { intros x hx,
+    rcases H x hx with ⟨i, hpi, hi⟩,
+    rcases comp_mem_uniformity_sets (hU.mem_of_mem hpi) with ⟨t, ht_mem, ht⟩,
+    rcases hU.mem_iff.1 ht_mem with ⟨j, hpj, hj⟩,
+    exact ⟨⟨j, hpj⟩, subset.trans (ball_mono ((comp_rel_mono hj hj).trans ht) _) hi⟩ },
+  haveI : nonempty {a // p a}, from nonempty_subtype.2 hU.ex_mem,
+  choose! I hI using H,
+  rcases hK.elim_nhds_subcover (λ x, ball x $ s (I x))
+    (λ x hx, ball_mem_nhds _ $ hU.mem_of_mem (I x).2) with ⟨t, htK, ht⟩,
+  obtain ⟨i, hpi, hi⟩ : ∃ i (hpi : p i), s i ⊆ ⋂ x ∈ t, s (I x),
+    from hU.mem_iff.1 ((bInter_finset_mem t).2 (λ x hx, hU.mem_of_mem (I x).2)),
+  rw [subset_Inter₂_iff] at hi,
+  refine ⟨i, hpi, λ x hx, _⟩,
+  rcases mem_Union₂.1 (ht hx) with ⟨z, hzt : z ∈ t, hzx : x ∈ ball z (s (I z))⟩,
+  calc ball x (s i) ⊆ ball z (s (I z) ○ s (I z)) : λ y hy, ⟨x, hzx, hi z hzt hy⟩
+                ... ⊆ U                          : hI z (htK z hzt),
+end
+
+lemma disjoint.exists_uniform_thickening {A B : set α}
+  (hA : is_compact A) (hB : is_closed B) (h : disjoint A B) :
+  ∃ V ∈ 𝓤 α, disjoint (⋃ x ∈ A, ball x V) (⋃ x ∈ B, ball x V) :=
+begin
+  have : Bᶜ ∈ 𝓝ˢ A := hB.is_open_compl.mem_nhds_set.mpr h.le_compl_right,
+  rw (hA.nhds_set_basis_uniformity (filter.basis_sets _)).mem_iff at this,
+  rcases this with ⟨U, hU, hUAB⟩,
+  rcases comp_symm_mem_uniformity_sets hU with ⟨V, hV, hVsymm, hVU⟩,
+  refine ⟨V, hV, set.disjoint_left.mpr $ λ x, _⟩,
+  simp only [mem_Union₂],
+  rintro ⟨a, ha, hxa⟩ ⟨b, hb, hxb⟩,
+  rw mem_ball_symmetry hVsymm at hxa hxb,
+  exact hUAB (mem_Union₂_of_mem ha $ hVU $ mem_comp_of_mem_ball hVsymm hxa hxb) hb
+end
+
+lemma disjoint.exists_uniform_thickening_of_basis {p : ι → Prop} {s : ι → set (α × α)}
+  (hU : (𝓤 α).has_basis p s) {A B : set α}
+  (hA : is_compact A) (hB : is_closed B) (h : disjoint A B) :
+  ∃ i, p i ∧ disjoint (⋃ x ∈ A, ball x (s i)) (⋃ x ∈ B, ball x (s i)) :=
+begin
+  rcases h.exists_uniform_thickening hA hB with ⟨V, hV, hVAB⟩,
+  rcases hU.mem_iff.1 hV with ⟨i, hi, hiV⟩,
+  exact ⟨i, hi, hVAB.mono
+    (Union₂_mono $ λ a _, ball_mono hiV a) (Union₂_mono $ λ b _, ball_mono hiV b)⟩,
+end
+
 lemma tendsto_right_nhds_uniformity {a : α} : tendsto (λa', (a', a)) (𝓝 a) (𝓤 α) :=
 assume s, mem_nhds_right a
 
@@ -639,37 +765,20 @@ lemma tendsto_left_nhds_uniformity {a : α} : tendsto (λa', (a, a')) (𝓝 a) (
 assume s, mem_nhds_left a
 
 lemma lift_nhds_left {x : α} {g : set α → filter β} (hg : monotone g) :
-  (𝓝 x).lift g = (𝓤 α).lift (λs:set (α×α), g {y | (x, y) ∈ s}) :=
-eq.trans
-  begin
-    rw [nhds_eq_uniformity],
-    exact (filter.lift_assoc $ monotone_principal.comp $ monotone_preimage.comp monotone_preimage )
-  end
-  (congr_arg _ $ funext $ assume s, filter.lift_principal hg)
+  (𝓝 x).lift g = (𝓤 α).lift (λs:set (α×α), g (ball x s)) :=
+by { rw [nhds_eq_comap_uniformity, comap_lift_eq2 hg], refl }
 
 lemma lift_nhds_right {x : α} {g : set α → filter β} (hg : monotone g) :
   (𝓝 x).lift g = (𝓤 α).lift (λs:set (α×α), g {y | (y, x) ∈ s}) :=
-calc (𝓝 x).lift g = (𝓤 α).lift (λs:set (α×α), g {y | (x, y) ∈ s}) : lift_nhds_left hg
-  ... = ((@prod.swap α α) <$> (𝓤 α)).lift (λs:set (α×α), g {y | (x, y) ∈ s}) :
-    by rw [←uniformity_eq_symm]
-  ... = (𝓤 α).lift (λs:set (α×α), g {y | (x, y) ∈ image prod.swap s}) :
-    map_lift_eq2 $ hg.comp monotone_preimage
-  ... = _ : by simp [image_swap_eq_preimage_swap]
+by { rw [nhds_eq_comap_uniformity', comap_lift_eq2 hg], refl }
 
 lemma nhds_nhds_eq_uniformity_uniformity_prod {a b : α} :
   𝓝 a ×ᶠ 𝓝 b =
   (𝓤 α).lift (λs:set (α×α), (𝓤 α).lift' (λt:set (α×α),
     {y : α | (y, a) ∈ s} ×ˢ {y : α | (b, y) ∈ t})) :=
 begin
-  rw [prod_def],
-  show (𝓝 a).lift (λs:set α, (𝓝 b).lift (λt:set α, 𝓟 (s ×ˢ t))) = _,
-  rw [lift_nhds_right],
-  apply congr_arg, funext s,
-  rw [lift_nhds_left],
-  refl,
-  exact monotone_principal.comp (monotone_prod monotone_const monotone_id),
-  exact (monotone_lift' monotone_const $ monotone_lam $
-    assume x, monotone_prod monotone_id monotone_const)
+  rw [nhds_eq_uniformity', nhds_eq_uniformity, prod_lift'_lift'],
+  exacts [rfl, monotone_preimage, monotone_preimage]
 end
 
 lemma nhds_eq_uniformity_prod {a b : α} :
@@ -677,8 +786,8 @@ lemma nhds_eq_uniformity_prod {a b : α} :
   (𝓤 α).lift' (λs:set (α×α), {y : α | (y, a) ∈ s} ×ˢ {y : α | (b, y) ∈ s}) :=
 begin
   rw [nhds_prod_eq, nhds_nhds_eq_uniformity_uniformity_prod, lift_lift'_same_eq_lift'],
-  { intro s, exact monotone_prod monotone_const monotone_preimage },
-  { intro t, exact monotone_prod monotone_preimage monotone_const }
+  { intro s, exact monotone_const.set_prod monotone_preimage },
+  { intro t, exact monotone_preimage.set_prod monotone_const }
 end
 
 lemma nhdset_of_mem_uniformity {d : set (α×α)} (s : set (α×α)) (hd : d ∈ 𝓤 α) :
@@ -690,7 +799,7 @@ have ∀p ∈ s, ∃t ⊆ cl_d, is_open t ∧ p ∈ t, from
   begin
     rw [nhds_eq_uniformity_prod, mem_lift'_sets],
     exact ⟨d, hd, assume ⟨a, b⟩ ⟨ha, hb⟩, ⟨x, y, ha, hp, hb⟩⟩,
-    exact monotone_prod monotone_preimage monotone_preimage
+    exact monotone_preimage.set_prod monotone_preimage
   end,
 have ∃t:(Π(p:α×α) (h:p ∈ s), set (α×α)),
     ∀p, ∀h:p ∈ s, t p h ⊆ cl_d ∧ is_open (t p h) ∧ p ∈ t p h,
@@ -720,6 +829,10 @@ end
 lemma supr_nhds_le_uniformity : (⨆ x : α, 𝓝 (x, x)) ≤ 𝓤 α :=
 supr_le nhds_le_uniformity
 
+/-- Entourages are neighborhoods of the diagonal. -/
+lemma nhds_set_diagonal_le_uniformity : 𝓝ˢ (diagonal α) ≤ 𝓤 α :=
+(nhds_set_diagonal α).trans_le supr_nhds_le_uniformity
+
 /-!
 ### Closure and interior in uniform spaces
 -/
@@ -728,12 +841,9 @@ lemma closure_eq_uniformity (s : set $ α × α) :
   closure s = ⋂ V ∈ {V | V ∈ 𝓤 α ∧ symmetric_rel V}, V ○ s ○ V :=
 begin
   ext ⟨x, y⟩,
-  simp_rw [mem_closure_iff_nhds_basis (uniform_space.has_basis_nhds_prod x y),
-           mem_Inter, mem_set_of_eq],
-  refine forall₂_congr (λ V, _),
-  rintros ⟨V_in, V_symm⟩,
-  simp_rw [mem_comp_comp V_symm, inter_comm, exists_prop],
-  exact iff.rfl,
+  simp only [mem_closure_iff_nhds_basis (uniform_space.has_basis_nhds_prod x y), mem_Inter,
+    mem_set_of_eq, and_imp, mem_comp_comp, exists_prop, ← mem_inter_iff, inter_comm, set.nonempty]
+    { contextual := tt }
 end
 
 lemma uniformity_has_basis_closed : has_basis (𝓤 α) (λ V : set (α × α), V ∈ 𝓤 α ∧ is_closed V) id :=
@@ -748,66 +858,34 @@ begin
   exact ⟨w_in, w_symm⟩
 end
 
+lemma uniformity_eq_uniformity_closure : 𝓤 α = (𝓤 α).lift' closure :=
+eq.symm $ uniformity_has_basis_closed.lift'_closure_eq_self $ λ _, and.right
+
+lemma filter.has_basis.uniformity_closure {p : ι → Prop} {U : ι → set (α × α)}
+  (h : (𝓤 α).has_basis p U) : (𝓤 α).has_basis p (λ i, closure (U i)) :=
+(@uniformity_eq_uniformity_closure α _).symm ▸ h.lift'_closure
+
 /-- Closed entourages form a basis of the uniformity filter. -/
 lemma uniformity_has_basis_closure : has_basis (𝓤 α) (λ V : set (α × α), V ∈ 𝓤 α) closure :=
-⟨begin
-  intro t,
-  rw uniformity_has_basis_closed.mem_iff,
-  split,
-  { rintros ⟨r, ⟨r_in, r_closed⟩, r_sub⟩,
-    use [r, r_in],
-    convert r_sub,
-    rw r_closed.closure_eq,
-    refl },
-  { rintros ⟨r, r_in, r_sub⟩,
-    exact ⟨closure r, ⟨mem_of_superset r_in subset_closure, is_closed_closure⟩, r_sub⟩ }
-end⟩
+(𝓤 α).basis_sets.uniformity_closure
 
 lemma closure_eq_inter_uniformity {t : set (α×α)} :
   closure t = (⋂ d ∈ 𝓤 α, d ○ (t ○ d)) :=
-set.ext $ assume ⟨a, b⟩,
-calc (a, b) ∈ closure t ↔ (𝓝 (a, b) ⊓ 𝓟 t ≠ ⊥) : mem_closure_iff_nhds_ne_bot
-  ... ↔ (((@prod.swap α α) <$> 𝓤 α).lift'
-      (λ (s : set (α × α)), {x : α | (x, a) ∈ s} ×ˢ {y : α | (b, y) ∈ s}) ⊓ 𝓟 t ≠ ⊥) :
-    by rw [←uniformity_eq_symm, nhds_eq_uniformity_prod]
-  ... ↔ ((map (@prod.swap α α) (𝓤 α)).lift'
-      (λ (s : set (α × α)), {x : α | (x, a) ∈ s} ×ˢ {y : α | (b, y) ∈ s}) ⊓ 𝓟 t ≠ ⊥) :
-    by refl
-  ... ↔ ((𝓤 α).lift'
-      (λ (s : set (α × α)), {y : α | (a, y) ∈ s} ×ˢ {x : α | (x, b) ∈ s}) ⊓ 𝓟 t ≠ ⊥) :
-  begin
-    rw [map_lift'_eq2],
-    simp [image_swap_eq_preimage_swap, function.comp],
-    exact monotone_prod monotone_preimage monotone_preimage
-  end
-  ... ↔ (∀s ∈ 𝓤 α, ({y : α | (a, y) ∈ s} ×ˢ {x : α | (x, b) ∈ s} ∩ t).nonempty) :
-  begin
-    rw [lift'_inf_principal_eq, ← ne_bot_iff, lift'_ne_bot_iff],
-    exact (monotone_prod monotone_preimage monotone_preimage).inter monotone_const
-  end
-  ... ↔ (∀ s ∈ 𝓤 α, (a, b) ∈ s ○ (t ○ s)) :
-    forall₂_congr $ λ s hs,
-    ⟨assume ⟨⟨x, y⟩, ⟨⟨hx, hy⟩, hxyt⟩⟩, ⟨x, hx, y, hxyt, hy⟩,
-      assume ⟨x, hx, y, hxyt, hy⟩, ⟨⟨x, y⟩, ⟨⟨hx, hy⟩, hxyt⟩⟩⟩
-  ... ↔ _ : by simp
-
-lemma uniformity_eq_uniformity_closure : 𝓤 α = (𝓤 α).lift' closure :=
-le_antisymm
-  (le_infi $ assume s, le_infi $ assume hs, by simp; filter_upwards [hs] using subset_closure)
-  (calc (𝓤 α).lift' closure ≤ (𝓤 α).lift' (λd, d ○ (d ○ d)) :
-      lift'_mono' (by intros s hs; rw [closure_eq_inter_uniformity]; exact bInter_subset_of_mem hs)
-    ... ≤ (𝓤 α) : comp_le_uniformity3)
+calc closure t = ⋂ V (hV : V ∈ 𝓤 α ∧ symmetric_rel V), V ○ t ○ V : closure_eq_uniformity t
+... = ⋂ V ∈ 𝓤 α, V ○ t ○ V : eq.symm $ uniform_space.has_basis_symmetric.bInter_mem $
+  λ V₁ V₂ hV, comp_rel_mono (comp_rel_mono hV subset.rfl) hV
+... = ⋂ V ∈ 𝓤 α, V ○ (t ○ V) : by simp only [comp_rel_assoc]
 
 lemma uniformity_eq_uniformity_interior : 𝓤 α = (𝓤 α).lift' interior :=
 le_antisymm
   (le_infi $ assume d, le_infi $ assume hd,
     let ⟨s, hs, hs_comp⟩ := (mem_lift'_sets $
-      monotone_comp_rel monotone_id $ monotone_comp_rel monotone_id monotone_id).mp
+      monotone_id.comp_rel $ monotone_id.comp_rel monotone_id).mp
         (comp_le_uniformity3 hd) in
     let ⟨t, ht, hst, ht_comp⟩ := nhdset_of_mem_uniformity s hs in
     have s ⊆ interior d, from
       calc s ⊆ t : hst
-       ... ⊆ interior d : (subset_interior_iff_subset_of_open ht).mpr $
+       ... ⊆ interior d : ht.subset_interior_iff.mpr $
         λ x (hx : x ∈ t), let ⟨x, y, h₁, h₂, h₃⟩ := ht_comp hx in hs_comp ⟨x, h₁, y, h₂, h₃⟩,
     have interior d ∈ 𝓤 α, by filter_upwards [hs] using this,
     by simp [this])
@@ -857,12 +935,6 @@ lemma filter.has_basis.mem_uniformity_iff {p : β → Prop} {s : β → set (α
   t ∈ 𝓤 α ↔ ∃ i (hi : p i), ∀ a b, (a, b) ∈ s i → (a, b) ∈ t :=
 h.mem_iff.trans $ by simp only [prod.forall, subset_def]
 
-/-- Symmetric entourages form a basis of `𝓤 α` -/
-lemma uniform_space.has_basis_symmetric :
-  (𝓤 α).has_basis (λ s : set (α × α), s ∈ 𝓤 α ∧ symmetric_rel s) id :=
-has_basis_self.2 $ λ t t_in, ⟨symmetrize_rel t, symmetrize_mem_uniformity t_in,
-  symmetric_symmetrize_rel t, symmetrize_rel_subset_self t⟩
-
 /-- Open elements `s : set (α × α)` of `𝓤 α` such that `(x, y) ∈ s ↔ (y, x) ∈ s` form a basis
 of `𝓤 α`. -/
 lemma uniformity_has_basis_open_symmetric :
@@ -944,19 +1016,19 @@ lemma uniform_continuous.comp [uniform_space β] [uniform_space γ] {g : β →
   (hg : uniform_continuous g) (hf : uniform_continuous f) : uniform_continuous (g ∘ f) :=
 hg.comp hf
 
-lemma filter.has_basis.uniform_continuous_iff [uniform_space β] {p : γ → Prop} {s : γ → set (α×α)}
-  (ha : (𝓤 α).has_basis p s) {q : δ → Prop} {t : δ → set (β×β)} (hb : (𝓤 β).has_basis q t)
-  {f : α → β} :
+lemma filter.has_basis.uniform_continuous_iff {ι'} [uniform_space β] {p : ι → Prop}
+  {s : ι → set (α×α)} (ha : (𝓤 α).has_basis p s) {q : ι' → Prop} {t : ι' → set (β×β)}
+  (hb : (𝓤 β).has_basis q t) {f : α → β} :
   uniform_continuous f ↔ ∀ i (hi : q i), ∃ j (hj : p j), ∀ x y, (x, y) ∈ s j → (f x, f y) ∈ t i :=
 (ha.tendsto_iff hb).trans $ by simp only [prod.forall]
 
-lemma filter.has_basis.uniform_continuous_on_iff [uniform_space β] {p : γ → Prop}
-  {s : γ → set (α×α)} (ha : (𝓤 α).has_basis p s) {q : δ → Prop} {t : δ → set (β×β)}
+lemma filter.has_basis.uniform_continuous_on_iff {ι'} [uniform_space β] {p : ι → Prop}
+  {s : ι → set (α×α)} (ha : (𝓤 α).has_basis p s) {q : ι' → Prop} {t : ι' → set (β×β)}
   (hb : (𝓤 β).has_basis q t) {f : α → β} {S : set α} :
   uniform_continuous_on f S ↔
     ∀ i (hi : q i), ∃ j (hj : p j), ∀ x y ∈ S, (x, y) ∈ s j → (f x, f y) ∈ t i :=
 ((ha.inf_principal (S ×ˢ S)).tendsto_iff hb).trans $
-by simp [prod.forall, set.inter_comm (s _), ball_mem_comm]
+by simp_rw [prod.forall, set.inter_comm (s _), ball_mem_comm, mem_inter_iff, mem_prod, and_imp]
 
 end uniform_space
 
@@ -972,7 +1044,7 @@ instance : partial_order (uniform_space α) :=
 
 instance : has_Inf (uniform_space α) :=
 ⟨assume s, uniform_space.of_core
-{ uniformity := (⨅u∈s, @uniformity α u),
+{ uniformity := (⨅u∈s, 𝓤[u]),
   refl       := le_infi $ assume u, le_infi $ assume hu, u.refl,
   symm       := le_infi $ assume u, le_infi $ assume hu,
     le_trans (map_mono $ infi_le_of_le _ $ infi_le _ hu) u.symm,
@@ -981,13 +1053,11 @@ instance : has_Inf (uniform_space α) :=
 
 private lemma Inf_le {tt : set (uniform_space α)} {t : uniform_space α} (h : t ∈ tt) :
   Inf tt ≤ t :=
-show (⨅u∈tt, @uniformity α u) ≤ t.uniformity,
-  from infi_le_of_le t $ infi_le _ h
+show (⨅ u ∈ tt, 𝓤[u]) ≤ 𝓤[t], from infi₂_le t h
 
 private lemma le_Inf {tt : set (uniform_space α)} {t : uniform_space α} (h : ∀t'∈tt, t ≤ t') :
   t ≤ Inf tt :=
-show t.uniformity ≤ (⨅u∈tt, @uniformity α u),
-  from le_infi $ assume t', le_infi $ assume ht', h t' ht'
+show 𝓤[t] ≤ (⨅ u ∈ tt, 𝓤[u]), from le_infi₂ h
 
 instance : has_top (uniform_space α) :=
 ⟨uniform_space.of_core { uniformity := ⊤, refl := le_top, symm := le_top, comp := le_top }⟩
@@ -996,25 +1066,31 @@ instance : has_bot (uniform_space α) :=
 ⟨{ to_topological_space := ⊥,
   uniformity  := 𝓟 id_rel,
   refl        := le_rfl,
-  symm        := by simp [tendsto]; apply subset.refl,
-  comp        :=
-  begin
-    rw [lift'_principal], {simp},
-    exact monotone_comp_rel monotone_id monotone_id
-  end,
+  symm        := by simp [tendsto],
+  comp        := lift'_le (mem_principal_self _) $ principal_mono.2 id_comp_rel.subset,
   is_open_uniformity :=
     assume s, by simp [is_open_fold, subset_def, id_rel] {contextual := tt } } ⟩
 
+instance : has_inf (uniform_space α) :=
+⟨λ u₁ u₂,
+  @uniform_space.replace_topology _
+    (u₁.to_topological_space ⊓ u₂.to_topological_space) (uniform_space.of_core
+    { uniformity  := u₁.uniformity ⊓ u₂.uniformity,
+      refl        := le_inf u₁.refl u₂.refl,
+      symm        := u₁.symm.inf u₂.symm,
+      comp        := (lift'_inf_le _ _ _).trans $ inf_le_inf u₁.comp u₂.comp }) $
+    eq_of_nhds_eq_nhds $ λ a,
+      by simpa only [nhds_inf, nhds_eq_comap_uniformity] using comap_inf.symm⟩
+
 instance : complete_lattice (uniform_space α) :=
 { sup           := λa b, Inf {x | a ≤ x ∧ b ≤ x},
   le_sup_left   := λ a b, le_Inf (λ _ ⟨h, _⟩, h),
   le_sup_right  := λ a b, le_Inf (λ _ ⟨_, h⟩, h),
   sup_le        := λ a b c h₁ h₂, Inf_le ⟨h₁, h₂⟩,
-  inf           := λ a b, Inf {a, b},
-  le_inf        := λ a b c h₁ h₂, le_Inf (λ u h,
-                     by { cases h, exact h.symm ▸ h₁, exact (mem_singleton_iff.1 h).symm ▸ h₂ }),
-  inf_le_left   := λ a b, Inf_le (by simp),
-  inf_le_right  := λ a b, Inf_le (by simp),
+  inf           := (⊓),
+  le_inf        := λ a b c h₁ h₂, show a.uniformity ≤ _, from le_inf h₁ h₂,
+  inf_le_left   := λ a b, show _ ≤ a.uniformity, from inf_le_left,
+  inf_le_right  := λ a b, show _ ≤ b.uniformity, from inf_le_right,
   top           := ⊤,
   le_top        := λ a, show a.uniformity ≤ ⊤, from le_top,
   bot           := ⊥,
@@ -1027,26 +1103,10 @@ instance : complete_lattice (uniform_space α) :=
   Inf_le        := λ s a ha, Inf_le ha,
   ..uniform_space.partial_order }
 
-lemma infi_uniformity {ι : Sort*} {u : ι → uniform_space α} :
-  (infi u).uniformity = (⨅i, (u i).uniformity) :=
-show (⨅a (h : ∃i:ι, u i = a), a.uniformity) = _, from
-le_antisymm
-  (le_infi $ assume i, infi_le_of_le (u i) $ infi_le _ ⟨i, rfl⟩)
-  (le_infi $ assume a, le_infi $ assume ⟨i, (ha : u i = a)⟩, ha ▸ infi_le _ _)
+lemma infi_uniformity {ι : Sort*} {u : ι → uniform_space α} : 𝓤[infi u] = (⨅i, 𝓤[u i]) :=
+infi_range
 
-lemma infi_uniformity' {ι : Sort*} {u : ι → uniform_space α} :
-  @uniformity α (infi u) = (⨅i, @uniformity α (u i)) :=
-infi_uniformity
-
-lemma inf_uniformity {u v : uniform_space α} :
-  (u ⊓ v).uniformity = u.uniformity ⊓ v.uniformity :=
-have (u ⊓ v) = (⨅i (h : i = u ∨ i = v), i), by simp [infi_or, infi_inf_eq],
-calc (u ⊓ v).uniformity = ((⨅i (h : i = u ∨ i = v), i) : uniform_space α).uniformity : by rw [this]
-  ... = _ : by simp [infi_uniformity, infi_or, infi_inf_eq]
-
-lemma inf_uniformity' {u v : uniform_space α} :
-  @uniformity α (u ⊓ v) = @uniformity α u ⊓ @uniformity α v :=
-inf_uniformity
+lemma inf_uniformity {u v : uniform_space α} : 𝓤[u ⊓ v] = 𝓤[u] ⊓ 𝓤[v] := rfl
 
 instance inhabited_uniform_space : inhabited (uniform_space α) := ⟨⊥⟩
 instance inhabited_uniform_space_core : inhabited (uniform_space.core α) :=
@@ -1055,7 +1115,7 @@ instance inhabited_uniform_space_core : inhabited (uniform_space.core α) :=
 /-- Given `f : α → β` and a uniformity `u` on `β`, the inverse image of `u` under `f`
   is the inverse image in the filter sense of the induced function `α × α → β × β`. -/
 def uniform_space.comap (f : α → β) (u : uniform_space β) : uniform_space α :=
-{ uniformity := u.uniformity.comap (λp:α×α, (f p.1, f p.2)),
+{ uniformity := 𝓤[u].comap (λp:α×α, (f p.1, f p.2)),
   to_topological_space := u.to_topological_space.induced f,
   refl := le_trans (by simp; exact assume ⟨a, b⟩ (h : a = b), h ▸ rfl) (comap_mono u.refl),
   symm := by simp [tendsto_comap_iff, prod.swap, (∘)];
@@ -1064,33 +1124,44 @@ def uniform_space.comap (f : α → β) (u : uniform_space β) : uniform_space 
     begin
       rw [comap_lift'_eq, comap_lift'_eq2],
       exact (lift'_mono' $ assume s hs ⟨a₁, a₂⟩ ⟨x, h₁, h₂⟩, ⟨f x, h₁, h₂⟩),
-      repeat { exact monotone_comp_rel monotone_id monotone_id }
+      exact monotone_id.comp_rel monotone_id
     end
     (comap_mono u.comp),
-  is_open_uniformity := λ s, begin
-    change (@is_open α (u.to_topological_space.induced f) s ↔ _),
-    simp [is_open_iff_nhds, nhds_induced, mem_nhds_uniformity_iff_right, filter.comap, and_comm],
-    refine ball_congr (λ x hx, ⟨_, _⟩),
-    { rintro ⟨t, hts, ht⟩, refine ⟨_, ht, _⟩,
-      rintro ⟨x₁, x₂⟩ h rfl, exact hts (h rfl) },
-    { rintro ⟨t, ht, hts⟩,
-      exact ⟨{y | (f x, y) ∈ t}, λ y hy, @hts (x, y) hy rfl,
-        mem_nhds_uniformity_iff_right.1 $ mem_nhds_left _ ht⟩ }
-  end }
-
-lemma uniformity_comap [uniform_space α] [uniform_space β] {f : α → β}
-  (h : ‹uniform_space α› = uniform_space.comap f ‹uniform_space β›) :
-  𝓤 α = comap (prod.map f f) (𝓤 β) :=
-by { rw h, refl }
-
-lemma uniform_space_comap_id {α : Type*} : uniform_space.comap (id : α → α) = id :=
-by ext u ; dsimp [uniform_space.comap] ; rw [prod.id_prod, filter.comap_id]
+  is_open_uniformity := λ s, by simp only [is_open_fold, is_open_induced, is_open_iff_mem_nhds,
+    nhds_induced, nhds_eq_comap_uniformity, comap_comap, ← mem_comap_prod_mk, ← uniformity] }
+
+lemma uniformity_comap [uniform_space β] (f : α → β) :
+  𝓤[uniform_space.comap f ‹_›] = comap (prod.map f f) (𝓤 β) :=
+rfl
+
+@[simp] lemma uniform_space_comap_id {α : Type*} : uniform_space.comap (id : α → α) = id :=
+by { ext : 2, rw [uniformity_comap, prod.map_id, comap_id] }
 
 lemma uniform_space.comap_comap {α β γ} [uγ : uniform_space γ] {f : α → β} {g : β → γ} :
   uniform_space.comap (g ∘ f) uγ = uniform_space.comap f (uniform_space.comap g uγ) :=
-by ext ; dsimp [uniform_space.comap] ; rw filter.comap_comap
+by { ext1, simp only [uniformity_comap, comap_comap, prod.map_comp_map] }
+
+lemma uniform_space.comap_inf {α γ} {u₁ u₂ : uniform_space γ} {f : α → γ} :
+  (u₁ ⊓ u₂).comap f = u₁.comap f ⊓ u₂.comap f :=
+uniform_space_eq comap_inf
+
+lemma uniform_space.comap_infi {ι α γ} {u : ι → uniform_space γ} {f : α → γ} :
+  (⨅ i, u i).comap f = ⨅ i, (u i).comap f :=
+begin
+  ext : 1,
+  simp [uniformity_comap, infi_uniformity]
+end
 
-lemma uniform_continuous_iff {α β} [uα : uniform_space α] [uβ : uniform_space β] {f : α → β} :
+lemma uniform_space.comap_mono {α γ} {f : α → γ} :
+  monotone (λ u : uniform_space γ, u.comap f) :=
+begin
+  intros u₁ u₂ hu,
+  change (𝓤 _) ≤ (𝓤 _),
+  rw uniformity_comap,
+  exact comap_mono hu
+end
+
+lemma uniform_continuous_iff {α β} {uα : uniform_space α} {uβ : uniform_space β} {f : α → β} :
   uniform_continuous f ↔ uα ≤ uβ.comap f :=
 filter.map_le_iff_le_comap
 
@@ -1135,14 +1206,9 @@ top_unique $ assume s hs, s.eq_empty_or_nonempty.elim
 lemma to_topological_space_infi {ι : Sort*} {u : ι → uniform_space α} :
   (infi u).to_topological_space = ⨅i, (u i).to_topological_space :=
 begin
-  casesI is_empty_or_nonempty ι,
-  { rw [infi_of_empty, infi_of_empty, to_topological_space_top] },
-  { refine (eq_of_nhds_eq_nhds $ assume a, _),
-    rw [nhds_infi, nhds_eq_uniformity],
-    change (infi u).uniformity.lift' (preimage $ prod.mk a) = _,
-    rw [infi_uniformity, lift'_infi],
-    { simp only [nhds_eq_uniformity], refl },
-    { exact assume a b, rfl } },
+  refine (eq_of_nhds_eq_nhds $ assume a, _),
+  simp only [nhds_infi, nhds_eq_uniformity, infi_uniformity],
+  exact lift'_infi_of_map_univ (ball_inter _) preimage_univ
 end
 
 lemma to_topological_space_Inf {s : set (uniform_space α)} :
@@ -1154,7 +1220,54 @@ end
 
 lemma to_topological_space_inf {u v : uniform_space α} :
   (u ⊓ v).to_topological_space = u.to_topological_space ⊓ v.to_topological_space :=
-by rw [to_topological_space_Inf, infi_pair]
+rfl
+
+/-- Uniform space structure on `ulift α`. -/
+instance ulift.uniform_space [uniform_space α] : uniform_space (ulift α) :=
+uniform_space.comap ulift.down ‹_›
+
+section uniform_continuous_infi
+
+lemma uniform_continuous_inf_rng {f : α → β} {u₁ : uniform_space α} {u₂ u₃ : uniform_space β}
+  (h₁ : @@uniform_continuous u₁ u₂ f) (h₂ : @@uniform_continuous u₁ u₃ f) :
+  @@uniform_continuous u₁ (u₂ ⊓ u₃) f :=
+tendsto_inf.mpr ⟨h₁, h₂⟩
+
+lemma uniform_continuous_inf_dom_left {f : α → β} {u₁ u₂ : uniform_space α} {u₃ : uniform_space β}
+  (hf : @@uniform_continuous u₁ u₃ f) : @@uniform_continuous (u₁ ⊓ u₂) u₃ f :=
+tendsto_inf_left hf
+
+lemma uniform_continuous_inf_dom_right {f : α → β} {u₁ u₂ : uniform_space α} {u₃ : uniform_space β}
+  (hf : @@uniform_continuous u₂ u₃ f) : @@uniform_continuous (u₁ ⊓ u₂) u₃ f :=
+tendsto_inf_right hf
+
+lemma uniform_continuous_Inf_dom {f : α → β} {u₁ : set (uniform_space α)} {u₂ : uniform_space β}
+  {u : uniform_space α} (h₁ : u ∈ u₁) (hf : @@uniform_continuous u u₂ f) :
+  @@uniform_continuous (Inf u₁) u₂ f :=
+begin
+  rw [uniform_continuous, Inf_eq_infi', infi_uniformity],
+  exact tendsto_infi' ⟨u, h₁⟩ hf
+end
+
+lemma uniform_continuous_Inf_rng {f : α → β} {u₁ : uniform_space α} {u₂ : set (uniform_space β)}
+  (h : ∀u∈u₂, @@uniform_continuous u₁ u f) : @@uniform_continuous u₁ (Inf u₂) f :=
+begin
+  rw [uniform_continuous, Inf_eq_infi', infi_uniformity],
+  exact tendsto_infi.mpr (λ ⟨u, hu⟩, h u hu)
+end
+
+lemma uniform_continuous_infi_dom {f : α → β} {u₁ : ι → uniform_space α} {u₂ : uniform_space β}
+  {i : ι} (hf : @@uniform_continuous (u₁ i) u₂ f) : @@uniform_continuous (infi u₁) u₂ f :=
+begin
+  rw [uniform_continuous, infi_uniformity],
+  exact tendsto_infi' i hf
+end
+
+lemma uniform_continuous_infi_rng {f : α → β} {u₁ : uniform_space α} {u₂ : ι → uniform_space β}
+  (h : ∀i, @@uniform_continuous u₁ (u₂ i) f) : @@uniform_continuous u₁ (infi u₂) f :=
+by rwa [uniform_continuous, infi_uniformity, tendsto_infi]
+
+end uniform_continuous_infi
 
 /-- A uniform space with the discrete uniformity has the discrete topology. -/
 lemma discrete_topology_of_discrete_uniformity [hα : uniform_space α]
@@ -1168,6 +1281,31 @@ instance : uniform_space bool := ⊥
 instance : uniform_space ℕ := ⊥
 instance : uniform_space ℤ := ⊥
 
+section
+variables [uniform_space α]
+
+open additive multiplicative
+
+instance : uniform_space (additive α) := ‹uniform_space α›
+instance : uniform_space (multiplicative α) := ‹uniform_space α›
+
+lemma uniform_continuous_of_mul : uniform_continuous (of_mul : α → additive α) :=
+uniform_continuous_id
+lemma uniform_continuous_to_mul : uniform_continuous (to_mul : additive α → α) :=
+uniform_continuous_id
+lemma uniform_continuous_of_add : uniform_continuous (of_add : α → multiplicative α) :=
+uniform_continuous_id
+lemma uniform_continuous_to_add : uniform_continuous (to_add : multiplicative α → α) :=
+uniform_continuous_id
+
+lemma uniformity_additive : 𝓤 (additive α) = (𝓤 α).map (prod.map of_mul of_mul) :=
+by { convert map_id.symm, exact prod.map_id }
+
+lemma uniformity_multiplicative : 𝓤 (multiplicative α) = (𝓤 α).map (prod.map of_add of_add) :=
+by { convert map_id.symm, exact prod.map_id }
+
+end
+
 instance {p : α → Prop} [t : uniform_space α] : uniform_space (subtype p) :=
 uniform_space.comap subtype.val t
 
@@ -1175,11 +1313,19 @@ lemma uniformity_subtype {p : α → Prop} [t : uniform_space α] :
   𝓤 (subtype p) = comap (λq:subtype p × subtype p, (q.1.1, q.2.1)) (𝓤 α) :=
 rfl
 
+lemma uniformity_set_coe {s : set α} [t : uniform_space α] :
+  𝓤 s = comap (prod.map (coe : s → α) (coe : s → α)) (𝓤 α) :=
+rfl
+
 lemma uniform_continuous_subtype_val {p : α → Prop} [uniform_space α] :
   uniform_continuous (subtype.val : {a : α // p a} → α) :=
 uniform_continuous_comap
 
-lemma uniform_continuous_subtype_mk {p : α → Prop} [uniform_space α] [uniform_space β]
+lemma uniform_continuous_subtype_coe {p : α → Prop} [uniform_space α] :
+  uniform_continuous (coe : {a : α // p a} → α) :=
+uniform_continuous_subtype_val
+
+lemma uniform_continuous.subtype_mk {p : α → Prop} [uniform_space α] [uniform_space β]
   {f : β → α} (hf : uniform_continuous f) (h : ∀x, p (f x)) :
   uniform_continuous (λx, ⟨f x, h x⟩ : β → subtype p) :=
 uniform_continuous_comap' hf
@@ -1189,11 +1335,9 @@ lemma uniform_continuous_on_iff_restrict [uniform_space α] [uniform_space β] {
   uniform_continuous_on f s ↔ uniform_continuous (s.restrict f) :=
 begin
   unfold uniform_continuous_on set.restrict uniform_continuous tendsto,
-  rw [show (λ x : s × s, (f x.1, f x.2)) = prod.map f f ∘ coe, by ext x; cases x; refl,
-      uniformity_comap rfl,
-      show prod.map subtype.val subtype.val = (coe : s × s → α × α), by ext x; cases x; refl],
-  conv in (map _ (comap _ _)) { rw ← filter.map_map },
-  rw subtype_coe_map_comap_prod, refl,
+  conv_rhs { rw [show (λ x : s × s, (f x.1, f x.2)) = prod.map f f ∘ prod.map coe coe, from rfl,
+    uniformity_set_coe, ← map_map, map_comap, range_prod_map, subtype.range_coe] },
+  refl
 end
 
 lemma tendsto_of_uniform_continuous_subtype
@@ -1241,56 +1385,48 @@ section prod
 /- a similar product space is possible on the function space (uniformity of pointwise convergence),
   but we want to have the uniformity of uniform convergence on function spaces -/
 instance [u₁ : uniform_space α] [u₂ : uniform_space β] : uniform_space (α × β) :=
-uniform_space.of_core_eq
-  (u₁.comap prod.fst ⊓ u₂.comap prod.snd).to_core
-  prod.topological_space
-  (calc prod.topological_space = (u₁.comap prod.fst ⊓ u₂.comap prod.snd).to_topological_space :
-      by rw [to_topological_space_inf, to_topological_space_comap, to_topological_space_comap]; refl
-    ... = _ : by rw [uniform_space.to_core_to_topological_space])
+u₁.comap prod.fst ⊓ u₂.comap prod.snd
+
+-- check the above produces no diamond
+example [u₁ : uniform_space α] [u₂ : uniform_space β] :
+  (prod.topological_space : topological_space (α × β)) = uniform_space.to_topological_space :=
+rfl
 
 theorem uniformity_prod [uniform_space α] [uniform_space β] : 𝓤 (α × β) =
   (𝓤 α).comap (λp:(α × β) × α × β, (p.1.1, p.2.1)) ⊓
   (𝓤 β).comap (λp:(α × β) × α × β, (p.1.2, p.2.2)) :=
-inf_uniformity
+rfl
+
+lemma uniformity_prod_eq_comap_prod [uniform_space α] [uniform_space β] :
+  𝓤 (α × β) = comap (λ p : (α × β) × (α × β), ((p.1.1, p.2.1), (p.1.2, p.2.2))) (𝓤 α ×ᶠ 𝓤 β) :=
+by rw [uniformity_prod, filter.prod, comap_inf, comap_comap, comap_comap]
 
 lemma uniformity_prod_eq_prod [uniform_space α] [uniform_space β] :
-  𝓤 (α×β) =
-    map (λp:(α×α)×(β×β), ((p.1.1, p.2.1), (p.1.2, p.2.2))) (𝓤 α ×ᶠ 𝓤 β) :=
-have map (λp:(α×α)×(β×β), ((p.1.1, p.2.1), (p.1.2, p.2.2))) =
-  comap (λp:(α×β)×(α×β), ((p.1.1, p.2.1), (p.1.2, p.2.2))),
-  from funext $ assume f, map_eq_comap_of_inverse
-    (funext $ assume ⟨⟨_, _⟩, ⟨_, _⟩⟩, rfl) (funext $ assume ⟨⟨_, _⟩, ⟨_, _⟩⟩, rfl),
-by rw [this, uniformity_prod, filter.prod, comap_inf, comap_comap, comap_comap]
-
-lemma mem_map_iff_exists_image' {α : Type*} {β : Type*} {f : filter α} {m : α → β} {t : set β} :
-  t ∈ (map m f).sets ↔ (∃s∈f, m '' s ⊆ t) :=
-mem_map_iff_exists_image
-
-lemma mem_uniformity_of_uniform_continuous_invariant [uniform_space α] {s:set (α×α)} {f : α → α → α}
-  (hf : uniform_continuous (λp:α×α, f p.1 p.2)) (hs : s ∈ 𝓤 α) :
-  ∃u∈𝓤 α, ∀a b c, (a, b) ∈ u → (f a c, f b c) ∈ s :=
+  𝓤 (α × β) = map (λ p : (α × α) × (β × β), ((p.1.1, p.2.1), (p.1.2, p.2.2))) (𝓤 α ×ᶠ 𝓤 β) :=
+by rw [map_swap4_eq_comap, uniformity_prod_eq_comap_prod]
+
+lemma mem_uniformity_of_uniform_continuous_invariant [uniform_space α] [uniform_space β]
+  {s : set (β × β)} {f : α → α → β} (hf : uniform_continuous (λ p : α × α, f p.1 p.2))
+  (hs : s ∈ 𝓤 β) :
+  ∃ u ∈ 𝓤 α, ∀ a b c, (a, b) ∈ u → (f a c, f b c) ∈ s :=
 begin
   rw [uniform_continuous, uniformity_prod_eq_prod, tendsto_map'_iff, (∘)] at hf,
-  rcases mem_map_iff_exists_image'.1 (hf hs) with ⟨t, ht, hts⟩, clear hf,
-  rcases mem_prod_iff.1 ht with ⟨u, hu, v, hv, huvt⟩, clear ht,
-  refine ⟨u, hu, assume a b c hab, hts $ (mem_image _ _ _).2 ⟨⟨⟨a, b⟩, ⟨c, c⟩⟩, huvt ⟨_, _⟩, _⟩⟩,
-  exact hab,
-  exact refl_mem_uniformity hv,
-  refl
+  rcases mem_prod_iff.1 (mem_map.1 $ hf hs) with ⟨u, hu, v, hv, huvt⟩,
+  exact ⟨u, hu, λ a b c hab, @huvt ((_, _), (_, _)) ⟨hab, refl_mem_uniformity hv⟩⟩
 end
 
 lemma mem_uniform_prod [t₁ : uniform_space α] [t₂ : uniform_space β] {a : set (α × α)}
   {b : set (β × β)} (ha : a ∈ 𝓤 α) (hb : b ∈ 𝓤 β) :
-  {p:(α×β)×(α×β) | (p.1.1, p.2.1) ∈ a ∧ (p.1.2, p.2.2) ∈ b } ∈ (@uniformity (α × β) _) :=
+  {p:(α×β)×(α×β) | (p.1.1, p.2.1) ∈ a ∧ (p.1.2, p.2.2) ∈ b } ∈ 𝓤 (α × β) :=
 by rw [uniformity_prod]; exact inter_mem_inf (preimage_mem_comap ha) (preimage_mem_comap hb)
 
 lemma tendsto_prod_uniformity_fst [uniform_space α] [uniform_space β] :
   tendsto (λp:(α×β)×(α×β), (p.1.1, p.2.1)) (𝓤 (α × β)) (𝓤 α) :=
-le_trans (map_mono (@inf_le_left (uniform_space (α×β)) _ _ _)) map_comap_le
+le_trans (map_mono inf_le_left) map_comap_le
 
 lemma tendsto_prod_uniformity_snd [uniform_space α] [uniform_space β] :
   tendsto (λp:(α×β)×(α×β), (p.1.2, p.2.2)) (𝓤 (α × β)) (𝓤 β) :=
-le_trans (map_mono (@inf_le_right (uniform_space (α×β)) _ _ _)) map_comap_le
+le_trans (map_mono inf_le_right) map_comap_le
 
 lemma uniform_continuous_fst [uniform_space α] [uniform_space β] :
   uniform_continuous (λp:α×β, p.1) :=
@@ -1324,6 +1460,51 @@ lemma to_topological_space_prod {α} {β} [u : uniform_space α] [v : uniform_sp
   @uniform_space.to_topological_space (α × β) prod.uniform_space =
     @prod.topological_space α β u.to_topological_space v.to_topological_space := rfl
 
+/-- A version of `uniform_continuous_inf_dom_left` for binary functions -/
+lemma uniform_continuous_inf_dom_left₂ {α β γ} {f : α → β → γ}
+  {ua1 ua2 : uniform_space α} {ub1 ub2 : uniform_space β} {uc1 : uniform_space γ}
+  (h : by haveI := ua1; haveI := ub1; exact uniform_continuous (λ p : α × β, f p.1 p.2)) :
+  by haveI := ua1 ⊓ ua2; haveI := ub1 ⊓ ub2; exact uniform_continuous (λ p : α × β, f p.1 p.2) :=
+begin
+  -- proof essentially copied from ``continuous_inf_dom_left₂`
+  have ha := @uniform_continuous_inf_dom_left _ _ id ua1 ua2 ua1 (@uniform_continuous_id _ (id _)),
+  have hb := @uniform_continuous_inf_dom_left _ _ id ub1 ub2 ub1 (@uniform_continuous_id _ (id _)),
+  have h_unif_cont_id := @uniform_continuous.prod_map _ _ _ _ (
+    ua1 ⊓ ua2) (ub1 ⊓ ub2) ua1 ub1 _ _ ha hb,
+  exact @uniform_continuous.comp _ _ _ (id _) (id _) _ _ _ h h_unif_cont_id,
+end
+
+/-- A version of `uniform_continuous_inf_dom_right` for binary functions -/
+lemma uniform_continuous_inf_dom_right₂ {α β γ} {f : α → β → γ}
+  {ua1 ua2 : uniform_space α} {ub1 ub2 : uniform_space β} {uc1 : uniform_space γ}
+  (h : by haveI := ua2; haveI := ub2; exact uniform_continuous (λ p : α × β, f p.1 p.2)) :
+  by haveI := ua1 ⊓ ua2; haveI := ub1 ⊓ ub2; exact uniform_continuous (λ p : α × β, f p.1 p.2) :=
+begin
+  -- proof essentially copied from ``continuous_inf_dom_right₂`
+  have ha := @uniform_continuous_inf_dom_right _ _ id ua1 ua2 ua2 (@uniform_continuous_id _ (id _)),
+  have hb := @uniform_continuous_inf_dom_right _ _ id ub1 ub2 ub2 (@uniform_continuous_id _ (id _)),
+  have h_unif_cont_id := @uniform_continuous.prod_map _ _ _ _
+    (ua1 ⊓ ua2) (ub1 ⊓ ub2) ua2 ub2  _ _ ha hb,
+  exact @uniform_continuous.comp _ _ _ (id _) (id _) _ _ _ h h_unif_cont_id,
+end
+
+/-- A version of `uniform_continuous_Inf_dom` for binary functions -/
+lemma uniform_continuous_Inf_dom₂ {α β γ} {f : α → β → γ}
+  {uas : set (uniform_space α)} {ubs : set (uniform_space β)}
+  {ua : uniform_space α} {ub : uniform_space β} {uc : uniform_space γ}
+  (ha : ua ∈ uas) (hb : ub ∈ ubs)
+  (hf : uniform_continuous (λ p : α × β, f p.1 p.2)):
+  by haveI := Inf uas; haveI := Inf ubs;
+    exact @uniform_continuous _ _ _ uc (λ p : α × β, f p.1 p.2) :=
+begin
+  -- proof essentially copied from ``continuous_Inf_dom`
+  let t : uniform_space (α × β) := prod.uniform_space,
+  have ha := uniform_continuous_Inf_dom ha uniform_continuous_id,
+  have hb := uniform_continuous_Inf_dom hb uniform_continuous_id,
+  have h_unif_cont_id := @uniform_continuous.prod_map _ _ _ _ (Inf uas) (Inf ubs) ua ub _ _ ha hb,
+  exact @uniform_continuous.comp _ _ _ (id _) (id _) _ _ _ hf h_unif_cont_id,
+end
+
 end prod
 
 section
@@ -1331,7 +1512,7 @@ open uniform_space function
 variables {δ' : Type*} [uniform_space α] [uniform_space β] [uniform_space γ] [uniform_space δ]
   [uniform_space δ']
 
-local notation f `∘₂` g := function.bicompr f g
+local notation f ` ∘₂ ` g := function.bicompr f g
 
 /-- Uniform continuity for functions of two variables. -/
 def uniform_continuous₂ (f : α → β → γ) := uniform_continuous (uncurry f)
@@ -1447,9 +1628,6 @@ end sum
 
 end constructions
 
--- For a version of the Lebesgue number lemma assuming only a sequentially compact space,
--- see topology/sequences.lean
-
 /-- Let `c : ι → set α` be an open cover of a compact set `s`. Then there exists an entourage
 `n` such that for each `x ∈ s` its `n`-neighborhood is contained in some `c i`. -/
 lemma lebesgue_number_lemma {α : Type u} [uniform_space α] {s : set α} {ι} {c : ι → set α}
@@ -1463,8 +1641,8 @@ begin
     rcases comp_mem_uniformity_sets hm with ⟨m', hm', mm'⟩,
     apply (𝓤 α).sets_of_superset hm',
     rintros ⟨x, y⟩ hp rfl,
-    refine ⟨i, m', hm', λ z hz, h (monotone_comp_rel monotone_id monotone_const mm' _)⟩,
-    dsimp at hz ⊢, rw comp_rel_assoc,
+    refine ⟨i, m', hm', λ z hz, h (monotone_id.comp_rel monotone_const mm' _)⟩,
+    dsimp [-mem_comp_rel] at hz ⊢, rw comp_rel_assoc,
     exact ⟨y, hp, hz⟩ },
   have hu₂ : s ⊆ ⋃ n ∈ 𝓤 α, u n,
   { intros x hx,
@@ -1533,13 +1711,11 @@ variables [uniform_space α]
 
 theorem tendsto_nhds_right {f : filter β} {u : β → α} {a : α} :
   tendsto u f (𝓝 a) ↔ tendsto (λ x, (a, u x)) f (𝓤 α)  :=
-⟨λ H, tendsto_left_nhds_uniformity.comp H,
-λ H s hs, by simpa [mem_of_mem_nhds hs] using H (mem_nhds_uniformity_iff_right.1 hs)⟩
+by rw [nhds_eq_comap_uniformity, tendsto_comap_iff]
 
 theorem tendsto_nhds_left {f : filter β} {u : β → α} {a : α} :
   tendsto u f (𝓝 a) ↔ tendsto (λ x, (u x, a)) f (𝓤 α)  :=
-⟨λ H, tendsto_right_nhds_uniformity.comp H,
-λ H s hs, by simpa [mem_of_mem_nhds hs] using H (mem_nhds_uniformity_iff_left.1 hs)⟩
+by rw [nhds_eq_comap_uniformity', tendsto_comap_iff]
 
 theorem continuous_at_iff'_right [topological_space β] {f : β → α} {b : β} :
   continuous_at f b ↔ tendsto (λ x, (f b, f x)) (𝓝 b) (𝓤 α) :=
diff --git a/src/topology/uniform_space/cauchy.lean b/src/topology/uniform_space/cauchy.lean
index 5d8a70689d356..f3eb455fbe77b 100644
--- a/src/topology/uniform_space/cauchy.lean
+++ b/src/topology/uniform_space/cauchy.lean
@@ -3,15 +3,19 @@ Copyright (c) 2017 Johannes Hölzl. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Johannes Hölzl, Mario Carneiro
 -/
+import topology.algebra.constructions
 import topology.bases
 import topology.uniform_space.basic
 /-!
 # Theory of Cauchy filters in uniform spaces. Complete uniform spaces. Totally bounded subsets.
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 universes u v
 
 open filter topological_space set classical uniform_space function
-open_locale classical uniformity topological_space filter
+open_locale classical uniformity topology filter
 
 variables {α : Type u} {β : Type v} [uniform_space α]
 
@@ -365,10 +369,14 @@ instance complete_space.prod [uniform_space β] [complete_space α] [complete_sp
     let ⟨x1, hx1⟩ := complete_space.complete $ hf.map uniform_continuous_fst in
     let ⟨x2, hx2⟩ := complete_space.complete $ hf.map uniform_continuous_snd in
     ⟨(x1, x2), by rw [nhds_prod_eq, filter.prod_def];
-      from filter.le_lift (λ s hs, filter.le_lift' $ λ t ht,
-        have H1 : prod.fst ⁻¹' s ∈ f.sets := hx1 hs,
-        have H2 : prod.snd ⁻¹' t ∈ f.sets := hx2 ht,
-        filter.inter_mem H1 H2)⟩ }
+      from filter.le_lift.2 (λ s hs, filter.le_lift'.2 $ λ t ht,
+        inter_mem (hx1 hs) (hx2 ht))⟩ }
+
+@[to_additive]
+instance complete_space.mul_opposite [complete_space α] : complete_space αᵐᵒᵖ :=
+{ complete := λ f hf, mul_opposite.op_surjective.exists.mpr $
+    let ⟨x, hx⟩ := complete_space.complete (hf.map mul_opposite.uniform_continuous_unop) in
+    ⟨x, (map_le_iff_le_comap.mp hx).trans_eq $ mul_opposite.comap_unop_nhds _⟩}
 
 /--If `univ` is complete, the space is a complete space -/
 lemma complete_space_of_is_complete_univ (h : is_complete (univ : set α)) : complete_space α :=
@@ -418,11 +426,11 @@ lemma is_closed.is_complete [complete_space α] {s : set α}
 /-- A set `s` is totally bounded if for every entourage `d` there is a finite
   set of points `t` such that every element of `s` is `d`-near to some element of `t`. -/
 def totally_bounded (s : set α) : Prop :=
-∀d ∈ 𝓤 α, ∃t : set α, finite t ∧ s ⊆ (⋃ y ∈ t, {x | (x, y) ∈ d})
+∀d ∈ 𝓤 α, ∃t : set α, t.finite ∧ s ⊆ (⋃ y ∈ t, {x | (x, y) ∈ d})
 
 theorem totally_bounded.exists_subset {s : set α} (hs : totally_bounded s) {U : set (α × α)}
   (hU : U ∈ 𝓤 α) :
-  ∃ t ⊆ s, finite t ∧ s ⊆ ⋃ y ∈ t, {x | (x, y) ∈ U} :=
+  ∃ t ⊆ s, set.finite t ∧ s ⊆ ⋃ y ∈ t, {x | (x, y) ∈ U} :=
 begin
   rcases comp_symm_of_uniformity hU with ⟨r, hr, rs, rU⟩,
   rcases hs r hr with ⟨k, fk, ks⟩,
@@ -440,16 +448,16 @@ begin
 end
 
 theorem totally_bounded_iff_subset {s : set α} : totally_bounded s ↔
-  ∀d ∈ 𝓤 α, ∃t ⊆ s, finite t ∧ s ⊆ (⋃y∈t, {x | (x,y) ∈ d}) :=
+  ∀d ∈ 𝓤 α, ∃t ⊆ s, set.finite t ∧ s ⊆ (⋃y∈t, {x | (x,y) ∈ d}) :=
 ⟨λ H d hd, H.exists_subset hd, λ H d hd, let ⟨t, _, ht⟩ := H d hd in ⟨t, ht⟩⟩
 
 lemma filter.has_basis.totally_bounded_iff {ι} {p : ι → Prop} {U : ι → set (α × α)}
   (H : (𝓤 α).has_basis p U) {s : set α} :
-  totally_bounded s ↔ ∀ i, p i → ∃ t : set α, finite t ∧ s ⊆ ⋃ y ∈ t, {x | (x, y) ∈ U i} :=
+  totally_bounded s ↔ ∀ i, p i → ∃ t : set α, set.finite t ∧ s ⊆ ⋃ y ∈ t, {x | (x, y) ∈ U i} :=
 H.forall_iff $ λ U V hUV h, h.imp $ λ t ht, ⟨ht.1, ht.2.trans $ Union₂_mono $ λ x hx y hy, hUV hy⟩
 
 lemma totally_bounded_of_forall_symm {s : set α}
-  (h : ∀ V ∈ 𝓤 α, symmetric_rel V → ∃ t : set α, finite t ∧ s ⊆ ⋃ y ∈ t, ball y V) :
+  (h : ∀ V ∈ 𝓤 α, symmetric_rel V → ∃ t : set α, set.finite t ∧ s ⊆ ⋃ y ∈ t, ball y V) :
   totally_bounded s :=
 uniform_space.has_basis_symmetric.totally_bounded_iff.2 $ λ V hV,
   by simpa only [ball_eq_of_symmetry hV.2] using h V hV.1 hV.2
@@ -536,7 +544,7 @@ begin
   exact ⟨ultrafilter.of f, ultrafilter.of_le f, H _ ((ultrafilter.of_le f).trans hfs)⟩
 end
 
-lemma compact_iff_totally_bounded_complete {s : set α} :
+lemma is_compact_iff_totally_bounded_is_complete {s : set α} :
   is_compact s ↔ totally_bounded s ∧ is_complete s :=
 ⟨λ hs, ⟨totally_bounded_iff_ultrafilter.2 (λ f hf,
     let ⟨x, xs, fx⟩ := is_compact_iff_ultrafilter_le_nhds.1 hs f hf in cauchy_nhds.mono fx),
@@ -547,18 +555,32 @@ lemma compact_iff_totally_bounded_complete {s : set α} :
    (λf hf, hc _ (totally_bounded_iff_ultrafilter.1 ht f hf) hf)⟩
 
 protected lemma is_compact.totally_bounded {s : set α} (h : is_compact s) : totally_bounded s :=
-(compact_iff_totally_bounded_complete.1 h).1
+(is_compact_iff_totally_bounded_is_complete.1 h).1
 
 protected lemma is_compact.is_complete {s : set α} (h : is_compact s) : is_complete s :=
-(compact_iff_totally_bounded_complete.1 h).2
+(is_compact_iff_totally_bounded_is_complete.1 h).2
 
 @[priority 100] -- see Note [lower instance priority]
 instance complete_of_compact {α : Type u} [uniform_space α] [compact_space α] : complete_space α :=
-⟨λf hf, by simpa using (compact_iff_totally_bounded_complete.1 compact_univ).2 f hf⟩
+⟨λf hf, by simpa using (is_compact_iff_totally_bounded_is_complete.1 is_compact_univ).2 f hf⟩
 
-lemma compact_of_totally_bounded_is_closed [complete_space α] {s : set α}
+lemma is_compact_of_totally_bounded_is_closed [complete_space α] {s : set α}
   (ht : totally_bounded s) (hc : is_closed s) : is_compact s :=
-(@compact_iff_totally_bounded_complete α _ s).2 ⟨ht, hc.is_complete⟩
+(@is_compact_iff_totally_bounded_is_complete α _ s).2 ⟨ht, hc.is_complete⟩
+
+/-- Every Cauchy sequence over `ℕ` is totally bounded. -/
+lemma cauchy_seq.totally_bounded_range {s : ℕ → α} (hs : cauchy_seq s) :
+  totally_bounded (range s) :=
+begin
+  refine totally_bounded_iff_subset.2 (λ a ha, _),
+  cases cauchy_seq_iff.1 hs a ha with n hn,
+  refine ⟨s '' {k | k ≤ n}, image_subset_range _ _, (finite_le_nat _).image _, _⟩,
+  rw [range_subset_iff, bUnion_image],
+  intro m,
+  rw [mem_Union₂],
+  cases le_total m n with hm hm,
+  exacts [⟨m, hm, refl_mem_uniformity ha⟩, ⟨n, le_refl n, hn m hm n le_rfl⟩]
+end
 
 /-!
 ### Sequentially complete space
diff --git a/src/topology/uniform_space/compact.lean b/src/topology/uniform_space/compact.lean
new file mode 100644
index 0000000000000..770d6f888a220
--- /dev/null
+++ b/src/topology/uniform_space/compact.lean
@@ -0,0 +1,271 @@
+/-
+Copyright (c) 2020 Patrick Massot. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Patrick Massot, Yury Kudryashov
+-/
+import topology.uniform_space.uniform_convergence
+import topology.uniform_space.equicontinuity
+import topology.separation
+import topology.support
+
+/-!
+# Compact separated uniform spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+## Main statements
+
+* `compact_space_uniformity`: On a compact uniform space, the topology determines the
+  uniform structure, entourages are exactly the neighborhoods of the diagonal.
+
+* `uniform_space_of_compact_t2`: every compact T2 topological structure is induced by a uniform
+  structure. This uniform structure is described in the previous item.
+
+* **Heine-Cantor** theorem: continuous functions on compact uniform spaces with values in uniform
+  spaces are automatically uniformly continuous. There are several variations, the main one is
+  `compact_space.uniform_continuous_of_continuous`.
+
+## Implementation notes
+
+The construction `uniform_space_of_compact_t2` is not declared as an instance, as it would badly
+loop.
+
+## tags
+
+uniform space, uniform continuity, compact space
+-/
+
+open_locale classical uniformity topology filter
+open filter uniform_space set
+
+variables {α β γ : Type*} [uniform_space α] [uniform_space β]
+
+/-!
+### Uniformity on compact spaces
+-/
+
+/-- On a compact uniform space, the topology determines the uniform structure, entourages are
+exactly the neighborhoods of the diagonal. -/
+lemma nhds_set_diagonal_eq_uniformity [compact_space α] : 𝓝ˢ (diagonal α) = 𝓤 α :=
+begin
+  refine nhds_set_diagonal_le_uniformity.antisymm _,
+  have : (𝓤 (α × α)).has_basis (λ U, U ∈ 𝓤 α)
+    (λ U, (λ p : (α × α) × α × α, ((p.1.1, p.2.1), p.1.2, p.2.2)) ⁻¹' U ×ˢ U),
+  { rw [uniformity_prod_eq_comap_prod],
+    exact (𝓤 α).basis_sets.prod_self.comap _ },
+  refine (is_compact_diagonal.nhds_set_basis_uniformity this).ge_iff.2 (λ U hU, _),
+  exact mem_of_superset hU (λ ⟨x, y⟩ hxy, mem_Union₂.2 ⟨(x, x), rfl, refl_mem_uniformity hU, hxy⟩)
+end
+
+/-- On a compact uniform space, the topology determines the uniform structure, entourages are
+exactly the neighborhoods of the diagonal. -/
+lemma compact_space_uniformity [compact_space α] : 𝓤 α = ⨆ x, 𝓝 (x, x) :=
+nhds_set_diagonal_eq_uniformity.symm.trans (nhds_set_diagonal _)
+
+lemma unique_uniformity_of_compact [t : topological_space γ] [compact_space γ]
+  {u u' : uniform_space γ} (h : u.to_topological_space = t) (h' : u'.to_topological_space = t) :
+  u = u' :=
+begin
+  apply uniform_space_eq,
+  change uniformity _ = uniformity _,
+  haveI : @compact_space γ u.to_topological_space, { rwa h },
+  haveI : @compact_space γ u'.to_topological_space, { rwa h' },
+  rw [compact_space_uniformity, compact_space_uniformity, h, h']
+end
+
+/-- The unique uniform structure inducing a given compact topological structure. -/
+def uniform_space_of_compact_t2 [topological_space γ] [compact_space γ] [t2_space γ] :
+  uniform_space γ :=
+{ uniformity := 𝓝ˢ (diagonal γ),
+  refl := principal_le_nhds_set,
+  symm := continuous_swap.tendsto_nhds_set $ λ x, eq.symm,
+  comp := begin
+    /-
+    This is the difficult part of the proof. We need to prove that, for each neighborhood `W`
+    of the diagonal `Δ`, there exists a smaller neighborhood `V` such that `V ○ V ⊆ W`.
+    -/
+    set 𝓝Δ := 𝓝ˢ (diagonal γ), -- The filter of neighborhoods of Δ
+    set F := 𝓝Δ.lift' (λ (s : set (γ × γ)), s ○ s), -- Compositions of neighborhoods of Δ
+    -- If this weren't true, then there would be V ∈ 𝓝Δ such that F ⊓ 𝓟 Vᶜ ≠ ⊥
+    rw le_iff_forall_inf_principal_compl,
+    intros V V_in,
+    by_contra H,
+    haveI : ne_bot (F ⊓ 𝓟 Vᶜ) := ⟨H⟩,
+    -- Hence compactness would give us a cluster point (x, y) for F ⊓ 𝓟 Vᶜ
+    obtain ⟨⟨x, y⟩, hxy⟩ : ∃ (p : γ × γ), cluster_pt p (F ⊓ 𝓟 Vᶜ) := cluster_point_of_compact _,
+    -- In particular (x, y) is a cluster point of 𝓟 Vᶜ, hence is not in the interior of V,
+    -- and a fortiori not in Δ, so x ≠ y
+    have clV : cluster_pt (x, y) (𝓟 $ Vᶜ) := hxy.of_inf_right,
+    have : (x, y) ∉ interior V,
+    { have : (x, y) ∈ closure (Vᶜ), by rwa mem_closure_iff_cluster_pt,
+      rwa closure_compl at this },
+    have diag_subset : diagonal γ ⊆ interior V,
+      from subset_interior_iff_mem_nhds_set.2 V_in,
+    have x_ne_y : x ≠ y,
+      from mt (@diag_subset (x, y)) this,
+    -- Since γ is compact and Hausdorff, it is normal, hence T₃.
+    haveI : normal_space γ := normal_of_compact_t2,
+    -- So there are closed neighboords V₁ and V₂ of x and y contained in disjoint open neighborhoods
+    -- U₁ and U₂.
+    obtain
+      ⟨U₁, U₁_in, V₁, V₁_in, U₂, U₂_in₂, V₂, V₂_in, V₁_cl, V₂_cl, U₁_op, U₂_op, VU₁, VU₂, hU₁₂⟩ :=
+       disjoint_nested_nhds x_ne_y,
+    -- We set U₃ := (V₁ ∪ V₂)ᶜ so that W := U₁ ×ˢ U₁ ∪ U₂ ×ˢ U₂ ∪ U₃ ×ˢ U₃ is an open
+    -- neighborhood of Δ.
+    let U₃ := (V₁ ∪ V₂)ᶜ,
+    have U₃_op : is_open U₃ := (V₁_cl.union V₂_cl).is_open_compl,
+    let W := U₁ ×ˢ U₁ ∪ U₂ ×ˢ U₂ ∪ U₃ ×ˢ U₃,
+    have W_in : W ∈ 𝓝Δ,
+    { rw [mem_nhds_set_iff_forall],
+      rintros ⟨z, z'⟩ (rfl : z = z'),
+      refine is_open.mem_nhds _ _,
+      { apply_rules [is_open.union, is_open.prod] },
+      { simp only [mem_union, mem_prod, and_self],
+        exact (em _).imp_left (λ h, union_subset_union VU₁ VU₂ h) } },
+    -- So W ○ W ∈ F by definition of F
+    have : W ○ W ∈ F, by simpa only using mem_lift' W_in,
+    -- And V₁ ×ˢ V₂ ∈ 𝓝 (x, y)
+    have hV₁₂ : V₁ ×ˢ V₂ ∈ 𝓝 (x, y) := prod_mem_nhds V₁_in V₂_in,
+    -- But (x, y) is also a cluster point of F so (V₁ ×ˢ V₂) ∩ (W ○ W) ≠ ∅
+    -- However the construction of W implies (V₁ ×ˢ V₂) ∩ (W ○ W) = ∅.
+    -- Indeed assume for contradiction there is some (u, v) in the intersection.
+    obtain ⟨⟨u, v⟩, ⟨u_in, v_in⟩, w, huw, hwv⟩ := cluster_pt_iff.mp (hxy.of_inf_left) hV₁₂ this,
+    -- So u ∈ V₁, v ∈ V₂, and there exists some w such that (u, w) ∈ W and (w ,v) ∈ W.
+    -- Because u is in V₁ which is disjoint from U₂ and U₃, (u, w) ∈ W forces (u, w) ∈ U₁ ×ˢ U₁.
+    have uw_in : (u, w) ∈ U₁ ×ˢ U₁ := (huw.resolve_right $ λ h, (h.1 $ or.inl u_in)).resolve_right
+      (λ h, hU₁₂.le_bot ⟨VU₁ u_in, h.1⟩),
+    -- Similarly, because v ∈ V₂, (w ,v) ∈ W forces (w, v) ∈ U₂ ×ˢ U₂.
+    have wv_in : (w, v) ∈ U₂ ×ˢ U₂ := (hwv.resolve_right $ λ h, (h.2 $ or.inr v_in)).resolve_left
+      (λ h, hU₁₂.le_bot ⟨h.2, VU₂ v_in⟩),
+    -- Hence w ∈ U₁ ∩ U₂ which is empty.
+    -- So we have a contradiction
+    exact hU₁₂.le_bot ⟨uw_in.2, wv_in.1⟩,
+  end,
+  is_open_uniformity := begin
+    -- Here we need to prove the topology induced by the constructed uniformity is the
+    -- topology we started with.
+    suffices : ∀ x : γ, filter.comap (prod.mk x) (𝓝ˢ (diagonal γ)) = 𝓝 x,
+    { intros s,
+      simp_rw [is_open_fold, is_open_iff_mem_nhds, ← mem_comap_prod_mk, this] },
+    intros x,
+    simp_rw [nhds_set_diagonal, comap_supr, nhds_prod_eq, comap_prod, (∘), comap_id'],
+    rw [supr_split_single _ x, comap_const_of_mem (λ V, mem_of_mem_nhds)],
+    suffices : ∀ y ≠ x, comap (λ (y : γ), x) (𝓝 y) ⊓ 𝓝 y ≤ 𝓝 x,
+      by simpa,
+    intros y hxy,
+    simp [comap_const_of_not_mem (compl_singleton_mem_nhds hxy) (not_not.2 rfl)]
+  end }
+
+/-!
+### Heine-Cantor theorem
+-/
+
+/-- Heine-Cantor: a continuous function on a compact uniform space is uniformly
+continuous. -/
+lemma compact_space.uniform_continuous_of_continuous [compact_space α]
+  {f : α → β} (h : continuous f) : uniform_continuous f :=
+have tendsto (prod.map f f) (𝓝ˢ (diagonal α)) (𝓝ˢ (diagonal β)),
+  from (h.prod_map h).tendsto_nhds_set maps_to_prod_map_diagonal,
+(this.mono_left nhds_set_diagonal_eq_uniformity.ge).mono_right nhds_set_diagonal_le_uniformity
+
+/-- Heine-Cantor: a continuous function on a compact set of a uniform space is uniformly
+continuous. -/
+lemma is_compact.uniform_continuous_on_of_continuous {s : set α} {f : α → β}
+  (hs : is_compact s) (hf : continuous_on f s) : uniform_continuous_on f s :=
+begin
+  rw uniform_continuous_on_iff_restrict,
+  rw is_compact_iff_compact_space at hs,
+  rw continuous_on_iff_continuous_restrict at hf,
+  resetI,
+  exact compact_space.uniform_continuous_of_continuous hf,
+end
+
+/-- If `s` is compact and `f` is continuous at all points of `s`, then `f` is
+"uniformly continuous at the set `s`", i.e. `f x` is close to `f y` whenever `x ∈ s` and `y` is
+close to `x` (even if `y` is not itself in `s`, so this is a stronger assertion than
+`uniform_continuous_on s`). -/
+lemma is_compact.uniform_continuous_at_of_continuous_at {r : set (β × β)} {s : set α}
+  (hs : is_compact s) (f : α → β) (hf : ∀ a ∈ s, continuous_at f a) (hr : r ∈ 𝓤 β) :
+  {x : α × α | x.1 ∈ s → (f x.1, f x.2) ∈ r} ∈ 𝓤 α :=
+begin
+  obtain ⟨t, ht, htsymm, htr⟩ := comp_symm_mem_uniformity_sets hr,
+  choose U hU T hT hb using λ a ha, exists_mem_nhds_ball_subset_of_mem_nhds
+    ((hf a ha).preimage_mem_nhds $ mem_nhds_left _ ht),
+  obtain ⟨fs, hsU⟩ := hs.elim_nhds_subcover' U hU,
+  apply mem_of_superset ((bInter_finset_mem fs).2 $ λ a _, hT a a.2),
+  rintro ⟨a₁, a₂⟩ h h₁,
+  obtain ⟨a, ha, haU⟩ := set.mem_Union₂.1 (hsU h₁),
+  apply htr,
+  refine ⟨f a, htsymm.mk_mem_comm.1 (hb _ _ _ haU _), hb _ _ _ haU _⟩,
+  exacts [mem_ball_self _ (hT a a.2), mem_Inter₂.1 h a ha],
+end
+
+lemma continuous.uniform_continuous_of_tendsto_cocompact {f : α → β} {x : β}
+  (h_cont : continuous f) (hx : tendsto f (cocompact α) (𝓝 x)) : uniform_continuous f :=
+uniform_continuous_def.2 $ λ r hr, begin
+  obtain ⟨t, ht, htsymm, htr⟩ := comp_symm_mem_uniformity_sets hr,
+  obtain ⟨s, hs, hst⟩ := mem_cocompact.1 (hx $ mem_nhds_left _ ht),
+  apply mem_of_superset (symmetrize_mem_uniformity $ hs.uniform_continuous_at_of_continuous_at
+    f (λ _ _, h_cont.continuous_at) $ symmetrize_mem_uniformity hr),
+  rintro ⟨b₁, b₂⟩ h,
+  by_cases h₁ : b₁ ∈ s, { exact (h.1 h₁).1 },
+  by_cases h₂ : b₂ ∈ s, { exact (h.2 h₂).2 },
+  apply htr,
+  exact ⟨x, htsymm.mk_mem_comm.1 (hst h₁), hst h₂⟩,
+end
+
+/-- If `f` has compact multiplicative support, then `f` tends to 1 at infinity. -/
+@[to_additive "If `f` has compact support, then `f` tends to zero at infinity."]
+lemma has_compact_mul_support.is_one_at_infty {f : α → γ} [topological_space γ] [has_one γ]
+  (h : has_compact_mul_support f) : tendsto f (cocompact α) (𝓝 1) :=
+begin
+  -- porting note: move to src/topology/support.lean once the port is over
+  intros N hN,
+  rw [mem_map, mem_cocompact'],
+  refine ⟨mul_tsupport f, h.is_compact, _⟩,
+  rw compl_subset_comm,
+  intros v hv,
+  rw [mem_preimage, image_eq_one_of_nmem_mul_tsupport hv],
+  exact mem_of_mem_nhds hN,
+end
+
+@[to_additive]
+lemma has_compact_mul_support.uniform_continuous_of_continuous {f : α → β} [has_one β]
+  (h1 : has_compact_mul_support f) (h2 : continuous f) : uniform_continuous f :=
+h2.uniform_continuous_of_tendsto_cocompact h1.is_one_at_infty
+
+/-- A family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is locally compact,
+`β` is compact and `f` is continuous on `U × (univ : set β)` for some neighborhood `U` of `x`. -/
+lemma continuous_on.tendsto_uniformly [locally_compact_space α] [compact_space β]
+  [uniform_space γ] {f : α → β → γ} {x : α} {U : set α}
+  (hxU : U ∈ 𝓝 x) (h : continuous_on ↿f (U ×ˢ univ)) :
+  tendsto_uniformly f (f x) (𝓝 x) :=
+begin
+  rcases locally_compact_space.local_compact_nhds _ _ hxU with ⟨K, hxK, hKU, hK⟩,
+  have : uniform_continuous_on ↿f (K ×ˢ univ),
+    from is_compact.uniform_continuous_on_of_continuous (hK.prod is_compact_univ)
+      (h.mono $ prod_mono hKU subset.rfl),
+  exact this.tendsto_uniformly hxK
+end
+
+/-- A continuous family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is
+locally compact and `β` is compact. -/
+lemma continuous.tendsto_uniformly [locally_compact_space α] [compact_space β] [uniform_space γ]
+  (f : α → β → γ) (h : continuous ↿f) (x : α) : tendsto_uniformly f (f x) (𝓝 x) :=
+h.continuous_on.tendsto_uniformly univ_mem
+
+section uniform_convergence
+
+/-- An equicontinuous family of functions defined on a compact uniform space is automatically
+uniformly equicontinuous. -/
+lemma compact_space.uniform_equicontinuous_of_equicontinuous {ι : Type*} {F : ι → β → α}
+  [compact_space β] (h : equicontinuous F) :
+  uniform_equicontinuous F :=
+begin
+  rw equicontinuous_iff_continuous at h,
+  rw uniform_equicontinuous_iff_uniform_continuous,
+  exact compact_space.uniform_continuous_of_continuous h
+end
+
+end uniform_convergence
diff --git a/src/topology/uniform_space/compact_convergence.lean b/src/topology/uniform_space/compact_convergence.lean
index c0b948237b5ed..f10663527d9b2 100644
--- a/src/topology/uniform_space/compact_convergence.lean
+++ b/src/topology/uniform_space/compact_convergence.lean
@@ -9,6 +9,9 @@ import topology.uniform_space.uniform_convergence
 /-!
 # Compact convergence (uniform convergence on compact sets)
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Given a topological space `α` and a uniform space `β` (e.g., a metric space or a topological group),
 the space of continuous maps `C(α, β)` carries a natural uniform space structure. We define this
 uniform space structure in this file and also prove the following properties of the topology it
@@ -76,7 +79,7 @@ of the uniform space structure on `C(α, β)` definitionally equal to the compac
 
 universes u₁ u₂ u₃
 
-open_locale filter uniformity topological_space
+open_locale filter uniformity topology
 open uniform_space set filter
 
 variables {α : Type u₁} {β : Type u₂} [topological_space α] [uniform_space β]
@@ -196,7 +199,7 @@ lemma compact_conv_nhd_subset_compact_open (hK : is_compact K) {U : set β} (hU
 begin
   obtain ⟨V, hV₁, hV₂, hV₃⟩ := lebesgue_number_of_compact_open (hK.image f.continuous) hU hf,
   refine ⟨V, hV₁, hV₂, _⟩,
-  rintros g hg - ⟨x, hx, rfl⟩,
+  rintros g hg _ ⟨x, hx, rfl⟩,
   exact hV₃ (f x) ⟨x, hx, rfl⟩ (hg x hx),
 end
 
@@ -264,8 +267,8 @@ begin
     haveI := hι,
     exact ⟨⋂ i, compact_open.gen (C i) (U i), h₂.trans hXf,
       is_open_Inter (λ i, continuous_map.is_open_gen (hC i) (hU i)), h₁⟩, },
-  { simp only [le_generate_from_iff_subset_is_open, and_imp, exists_prop, forall_exists_index,
-      set_of_subset_set_of],
+  { simp only [topological_space.le_generate_from_iff_subset_is_open, and_imp, exists_prop,
+      forall_exists_index, set_of_subset_set_of],
     rintros - K hK U hU rfl f hf,
     obtain ⟨V, hV, hV', hVf⟩ := compact_conv_nhd_subset_compact_open f hK hU hf,
     exact filter.mem_of_superset (filter_basis.mem_filter_of_mem _ ⟨⟨K, V⟩, ⟨hK, hV⟩, rfl⟩) hVf, },
@@ -285,7 +288,7 @@ begin
   rintros ⟨K₁, V₁⟩ ⟨hK₁, hV₁⟩ ⟨K₂, V₂⟩ ⟨hK₂, hV₂⟩,
   refine ⟨⟨K₁ ∪ K₂, V₁ ∩ V₂⟩, ⟨hK₁.union hK₂, filter.inter_mem hV₁ hV₂⟩, _⟩,
   simp only [le_eq_subset, prod.forall, set_of_subset_set_of, ge_iff_le, order.preimage,
-      ← forall_and_distrib, mem_inter_eq, mem_union_eq],
+      ← forall_and_distrib, mem_inter_iff, mem_union],
   exact λ f g, forall_imp (λ x, by tauto!),
 end
 
@@ -414,7 +417,7 @@ lemma has_basis_compact_convergence_uniformity_of_compact :
             (λ V, { fg : C(α, β) × C(α, β) | ∀ x, (fg.1 x, fg.2 x) ∈ V }) :=
 has_basis_compact_convergence_uniformity.to_has_basis
   (λ p hp, ⟨p.2, hp.2, λ fg hfg x hx, hfg x⟩)
-  (λ V hV, ⟨⟨univ, V⟩, ⟨compact_univ, hV⟩, λ fg hfg x, hfg x (mem_univ x)⟩)
+  (λ V hV, ⟨⟨univ, V⟩, ⟨is_compact_univ, hV⟩, λ fg hfg x, hfg x (mem_univ x)⟩)
 
 /-- Convergence in the compact-open topology is the same as uniform convergence for sequences of
 continuous functions on a compact space. -/
@@ -422,7 +425,7 @@ lemma tendsto_iff_tendsto_uniformly :
   tendsto F p (𝓝 f) ↔ tendsto_uniformly (λ i a, F i a) f p :=
 begin
   rw [tendsto_iff_forall_compact_tendsto_uniformly_on, ← tendsto_uniformly_on_univ],
-  exact ⟨λ h, h univ compact_univ, λ h K hK, h.mono (subset_univ K)⟩,
+  exact ⟨λ h, h univ is_compact_univ, λ h K hK, h.mono (subset_univ K)⟩,
 end
 
 end compact_domain
diff --git a/src/topology/uniform_space/compact_separated.lean b/src/topology/uniform_space/compact_separated.lean
deleted file mode 100644
index 3682251092133..0000000000000
--- a/src/topology/uniform_space/compact_separated.lean
+++ /dev/null
@@ -1,251 +0,0 @@
-/-
-Copyright (c) 2020 Patrick Massot. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Patrick Massot
--/
-import topology.uniform_space.separation
-import topology.uniform_space.uniform_convergence
-/-!
-# Compact separated uniform spaces
-
-## Main statements
-
-* `compact_space_uniformity`: On a separated compact uniform space, the topology determines the
-  uniform structure, entourages are exactly the neighborhoods of the diagonal.
-* `uniform_space_of_compact_t2`: every compact T2 topological structure is induced by a uniform
-  structure. This uniform structure is described in the previous item.
-* Heine-Cantor theorem: continuous functions on compact separated uniform spaces with values in
-  uniform spaces are automatically uniformly continuous. There are several variations, the main one
-  is `compact_space.uniform_continuous_of_continuous`.
-
-## Implementation notes
-
-The construction `uniform_space_of_compact_t2` is not declared as an instance, as it would badly
-loop.
-
-## tags
-
-uniform space, uniform continuity, compact space
--/
-
-open_locale classical uniformity topological_space filter
-open filter uniform_space set
-
-variables {α β γ : Type*} [uniform_space α] [uniform_space β]
-
-
-/-!
-### Uniformity on compact separated spaces
--/
-
-/-- On a separated compact uniform space, the topology determines the uniform structure, entourages
-are exactly the neighborhoods of the diagonal. -/
-lemma compact_space_uniformity [compact_space α] [separated_space α] : 𝓤 α = ⨆ x : α, 𝓝 (x, x) :=
-begin
-  symmetry, refine le_antisymm supr_nhds_le_uniformity _,
-  by_contra H,
-  obtain ⟨V, hV, h⟩ : ∃ V : set (α × α), (∀ x : α, V ∈ 𝓝 (x, x)) ∧ 𝓤 α ⊓ 𝓟 Vᶜ ≠ ⊥,
-  { simpa [le_iff_forall_inf_principal_compl] using H },
-  let F := 𝓤 α ⊓ 𝓟 Vᶜ,
-  haveI : ne_bot F := ⟨h⟩,
-  obtain ⟨⟨x, y⟩, hx⟩ : ∃ (p : α × α), cluster_pt p F :=
-    cluster_point_of_compact F,
-  have : cluster_pt (x, y) (𝓤 α) :=
-    hx.of_inf_left,
-  obtain rfl : x = y := eq_of_uniformity_inf_nhds this,
-  have : cluster_pt (x, x) (𝓟 Vᶜ) :=
-   hx.of_inf_right,
-  have : (x, x) ∉ interior V,
-  { have : (x, x) ∈ closure Vᶜ, by rwa mem_closure_iff_cluster_pt,
-    rwa closure_compl at this },
-  have : (x, x) ∈ interior V,
-  { rw mem_interior_iff_mem_nhds,
-    exact hV x },
-  contradiction
-end
-
-lemma unique_uniformity_of_compact_t2 [t : topological_space γ] [compact_space γ]
-[t2_space γ] {u u' : uniform_space γ}
-(h : u.to_topological_space = t) (h' : u'.to_topological_space = t) : u = u' :=
-begin
-  apply uniform_space_eq,
-  change uniformity _ = uniformity _,
-  haveI : @compact_space γ u.to_topological_space, { rw h ; assumption },
-  haveI : @compact_space γ u'.to_topological_space, { rw h' ; assumption },
-  haveI : @separated_space γ u, { rwa [separated_iff_t2, h] },
-  haveI : @separated_space γ u', { rwa [separated_iff_t2, h'] },
-  rw [compact_space_uniformity, compact_space_uniformity, h, h']
-end
-
-/-- The unique uniform structure inducing a given compact Hausdorff topological structure. -/
-def uniform_space_of_compact_t2 [topological_space γ] [compact_space γ] [t2_space γ] :
-  uniform_space γ :=
-{ uniformity := ⨆ x, 𝓝 (x, x),
-  refl := begin
-    simp_rw [filter.principal_le_iff, mem_supr],
-    rintros V V_in ⟨x, _⟩ ⟨⟩,
-    exact mem_of_mem_nhds (V_in x),
-  end,
-  symm := begin
-    refine le_of_eq _,
-    rw map_supr,
-    congr' with x : 1,
-    erw [nhds_prod_eq, ← prod_comm],
-  end,
-  comp := begin
-    /-
-    This is the difficult part of the proof. We need to prove that, for each neighborhood W
-    of the diagonal Δ, W ○ W is still a neighborhood of the diagonal.
-    -/
-    set 𝓝Δ := ⨆ x : γ, 𝓝 (x, x), -- The filter of neighborhoods of Δ
-    set F := 𝓝Δ.lift' (λ (s : set (γ × γ)), s ○ s), -- Compositions of neighborhoods of Δ
-    -- If this weren't true, then there would be V ∈ 𝓝Δ such that F ⊓ 𝓟 Vᶜ ≠ ⊥
-    rw le_iff_forall_inf_principal_compl,
-    intros V V_in,
-    by_contra H,
-    haveI : ne_bot (F ⊓ 𝓟 Vᶜ) := ⟨H⟩,
-    -- Hence compactness would give us a cluster point (x, y) for F ⊓ 𝓟 Vᶜ
-    obtain ⟨⟨x, y⟩, hxy⟩ : ∃ (p : γ × γ), cluster_pt p (F ⊓ 𝓟 Vᶜ) := cluster_point_of_compact _,
-    -- In particular (x, y) is a cluster point of 𝓟 Vᶜ, hence is not in the interior of V,
-    -- and a fortiori not in Δ, so x ≠ y
-    have clV : cluster_pt (x, y) (𝓟 $ Vᶜ) := hxy.of_inf_right,
-    have : (x, y) ∉ interior V,
-    { have : (x, y) ∈ closure (Vᶜ), by rwa mem_closure_iff_cluster_pt,
-      rwa closure_compl at this },
-    have diag_subset : diagonal γ ⊆ interior V,
-    { rw subset_interior_iff_nhds,
-      rintros ⟨x, x⟩ ⟨⟩,
-      exact (mem_supr.mp V_in : _) x },
-    have x_ne_y : x ≠ y,
-    { intro h,
-      apply this,
-      apply diag_subset,
-      simp [h] },
-    -- Since γ is compact and Hausdorff, it is normal, hence regular.
-    haveI : normal_space γ := normal_of_compact_t2,
-    -- So there are closed neighboords V₁ and V₂ of x and y contained in disjoint open neighborhoods
-    -- U₁ and U₂.
-    obtain
-      ⟨U₁, U₁_in, V₁, V₁_in, U₂, U₂_in₂, V₂, V₂_in, V₁_cl, V₂_cl, U₁_op, U₂_op, VU₁, VU₂, hU₁₂⟩ :
-        ∃ (U₁ V₁ ∈ 𝓝 x) (U₂ V₂ ∈ 𝓝 y),
-          is_closed V₁ ∧ is_closed V₂ ∧ is_open U₁ ∧ is_open U₂ ∧ V₁ ⊆ U₁ ∧ V₂ ⊆ U₂ ∧ U₁ ∩ U₂ = ∅ :=
-       disjoint_nested_nhds x_ne_y,
-    -- We set U₃ := (V₁ ∪ V₂)ᶜ so that W := U₁ ×ˢ U₁ ∪ U₂ ×ˢ U₂ ∪ U₃ ×ˢ U₃ is an open
-    -- neighborhood of Δ.
-    let U₃ := (V₁ ∪ V₂)ᶜ,
-    have U₃_op : is_open U₃ :=
-      is_open_compl_iff.mpr (is_closed.union V₁_cl V₂_cl),
-    let W := U₁ ×ˢ U₁ ∪ U₂ ×ˢ U₂ ∪ U₃ ×ˢ U₃,
-    have W_in : W ∈ 𝓝Δ,
-    { rw mem_supr,
-      intros x,
-      apply is_open.mem_nhds (is_open.union (is_open.union _ _) _),
-      { by_cases hx : x ∈ V₁ ∪ V₂,
-        { left,
-          cases hx with hx hx ; [left, right] ; split ; tauto },
-        { right,
-          rw mem_prod,
-          tauto }, },
-      all_goals { simp only [is_open.prod, *] } },
-    -- So W ○ W ∈ F by definition of F
-    have : W ○ W ∈ F, by simpa only using mem_lift' W_in,
-    -- And V₁ ×ˢ V₂ ∈ 𝓝 (x, y)
-    have hV₁₂ : V₁ ×ˢ V₂ ∈ 𝓝 (x, y) := prod_is_open.mem_nhds V₁_in V₂_in,
-    -- But (x, y) is also a cluster point of F so (V₁ ×ˢ V₂) ∩ (W ○ W) ≠ ∅
-    have clF : cluster_pt (x, y) F := hxy.of_inf_left,
-    obtain ⟨p, p_in⟩ : ∃ p, p ∈ (V₁ ×ˢ V₂) ∩ (W ○ W) :=
-      cluster_pt_iff.mp clF hV₁₂ this,
-    -- However the construction of W implies (V₁ ×ˢ V₂) ∩ (W ○ W) = ∅.
-    -- Indeed assume for contradiction there is some (u, v) in the intersection.
-    -- So u ∈ V₁, v ∈ V₂, and there exists some w such that (u, w) ∈ W and (w ,v) ∈ W.
-    -- Because u is in V₁ which is disjoint from U₂ and U₃, (u, w) ∈ W forces (u, w) ∈ U₁ ×ˢ U₁.
-    -- Similarly, because v ∈ V₂, (w ,v) ∈ W forces (w, v) ∈ U₂ ×ˢ U₂.
-    -- Hence w ∈ U₁ ∩ U₂ which is empty.
-    have inter_empty : (V₁ ×ˢ V₂) ∩ (W ○ W) = ∅,
-    { rw eq_empty_iff_forall_not_mem,
-      rintros ⟨u, v⟩ ⟨⟨u_in, v_in⟩, w, huw, hwv⟩,
-      have uw_in : (u, w) ∈ U₁ ×ˢ U₁ :=
-        set.mem_prod.2 ((huw.resolve_right (λ h, (h.1 $ or.inl u_in))).resolve_right
-        (λ h, have u ∈ U₁ ∩ U₂, from ⟨VU₁ u_in, h.1⟩, by rwa hU₁₂ at this)),
-      have wv_in : (w, v) ∈ U₂ ×ˢ U₂ :=
-        set.mem_prod.2 ((hwv.resolve_right (λ h, (h.2 $ or.inr v_in))).resolve_left
-        (λ h, have v ∈ U₁ ∩ U₂, from ⟨h.2, VU₂ v_in⟩, by rwa hU₁₂ at this)),
-      have : w ∈ U₁ ∩ U₂ := ⟨uw_in.2, wv_in.1⟩,
-      rwa hU₁₂ at this },
-    -- So we have a contradiction
-    rwa inter_empty at p_in,
-  end,
-  is_open_uniformity := begin
-    -- Here we need to prove the topology induced by the constructed uniformity is the
-    -- topology we started with.
-    suffices : ∀ x : γ, filter.comap (prod.mk x) (⨆ y, 𝓝 (y ,y)) = 𝓝 x,
-    { intros s,
-      change is_open s ↔ _,
-      simp_rw [is_open_iff_mem_nhds, nhds_eq_comap_uniformity_aux, this] },
-    intros x,
-    simp_rw [comap_supr, nhds_prod_eq, comap_prod,
-             show prod.fst ∘ prod.mk x = λ y : γ, x, by ext ; simp,
-             show prod.snd ∘ (prod.mk x) = (id : γ → γ), by ext ; refl, comap_id],
-    rw [supr_split_single _ x, comap_const_of_mem (λ V, mem_of_mem_nhds)],
-    suffices : ∀ y ≠ x, comap (λ (y : γ), x) (𝓝 y) ⊓ 𝓝 y ≤ 𝓝 x,
-      by simpa,
-    intros y hxy,
-    simp [comap_const_of_not_mem (compl_singleton_mem_nhds hxy) (by simp)],
-  end }
-
-/-!
-### Heine-Cantor theorem
--/
-
-/-- Heine-Cantor: a continuous function on a compact separated uniform space is uniformly
-continuous. -/
-lemma compact_space.uniform_continuous_of_continuous [compact_space α] [separated_space α]
-  {f : α → β} (h : continuous f) : uniform_continuous f :=
-calc
-map (prod.map f f) (𝓤 α) = map (prod.map f f) (⨆ x, 𝓝 (x, x))  : by rw compact_space_uniformity
-                     ... =  ⨆ x, map (prod.map f f) (𝓝 (x, x)) : by rw map_supr
-                     ... ≤ ⨆ x, 𝓝 (f x, f x)     : supr_mono (λ x, (h.prod_map h).continuous_at)
-                     ... ≤ ⨆ y, 𝓝 (y, y)         : supr_comp_le (λ y, 𝓝 (y, y)) f
-                     ... ≤ 𝓤 β                   : supr_nhds_le_uniformity
-
-/-- Heine-Cantor: a continuous function on a compact separated set of a uniform space is
-uniformly continuous. -/
-lemma is_compact.uniform_continuous_on_of_continuous' {s : set α} {f : α → β}
-  (hs : is_compact s) (hs' : is_separated s) (hf : continuous_on f s) : uniform_continuous_on f s :=
-begin
-  rw uniform_continuous_on_iff_restrict,
-  rw is_separated_iff_induced at hs',
-  rw is_compact_iff_compact_space at hs,
-  rw continuous_on_iff_continuous_restrict at hf,
-  resetI,
-  exact compact_space.uniform_continuous_of_continuous hf,
-end
-
-/-- Heine-Cantor: a continuous function on a compact set of a separated uniform space
-is uniformly continuous. -/
-lemma is_compact.uniform_continuous_on_of_continuous [separated_space α] {s : set α} {f : α → β}
-  (hs : is_compact s) (hf : continuous_on f s) : uniform_continuous_on f s :=
-hs.uniform_continuous_on_of_continuous' (is_separated_of_separated_space s) hf
-
-/-- A family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is locally compact,
-`β` is compact and separated and `f` is continuous on `U × (univ : set β)` for some separated
-neighborhood `U` of `x`. -/
-lemma continuous_on.tendsto_uniformly [locally_compact_space α] [compact_space β]
-  [separated_space β] [uniform_space γ] {f : α → β → γ} {x : α} {U : set α}
-  (hxU : U ∈ 𝓝 x) (hU : is_separated U) (h : continuous_on ↿f (U ×ˢ (univ : set β))) :
-  tendsto_uniformly f (f x) (𝓝 x) :=
-begin
-  rcases locally_compact_space.local_compact_nhds _ _ hxU with ⟨K, hxK, hKU, hK⟩,
-  have : uniform_continuous_on ↿f (K ×ˢ (univ : set β)),
-  { refine is_compact.uniform_continuous_on_of_continuous' (hK.prod compact_univ) _
-      (h.mono $ prod_mono hKU subset.rfl),
-    exact (hU.mono hKU).prod (is_separated_of_separated_space _) },
-  exact this.tendsto_uniformly hxK
-end
-
-/-- A continuous family of functions `α → β → γ` tends uniformly to its value at `x` if `α` is
-locally compact and `β` is compact and separated. -/
-lemma continuous.tendsto_uniformly [separated_space α] [locally_compact_space α]
-  [compact_space β] [separated_space β] [uniform_space γ]
-  (f : α → β → γ) (h : continuous ↿f) (x : α) : tendsto_uniformly f (f x) (𝓝 x) :=
-h.continuous_on.tendsto_uniformly univ_mem $ is_separated_of_separated_space _
diff --git a/src/topology/uniform_space/compare_reals.lean b/src/topology/uniform_space/compare_reals.lean
index 6570bd5fc763d..ded30248ad255 100644
--- a/src/topology/uniform_space/compare_reals.lean
+++ b/src/topology/uniform_space/compare_reals.lean
@@ -11,6 +11,9 @@ import topology.uniform_space.completion
 /-!
 # Comparison of Cauchy reals and Bourbaki reals
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In `data.real.basic` real numbers are defined using the so called Cauchy construction (although
 it is due to Georg Cantor). More precisely, this construction applies to commutative rings equipped
 with an absolute value with values in a linear ordered field.
@@ -55,28 +58,16 @@ open set function filter cau_seq uniform_space
 /-- The metric space uniform structure on ℚ (which presupposes the existence
 of real numbers) agrees with the one coming directly from (abs : ℚ → ℚ). -/
 lemma rat.uniform_space_eq :
-  is_absolute_value.uniform_space (abs : ℚ → ℚ) = metric_space.to_uniform_space' :=
+  (absolute_value.abs : absolute_value ℚ ℚ).uniform_space = pseudo_metric_space.to_uniform_space :=
 begin
   ext s,
-  erw [metric.mem_uniformity_dist, is_absolute_value.mem_uniformity],
-  split ; rintro ⟨ε, ε_pos, h⟩,
-  { use [ε, by exact_mod_cast ε_pos],
-    intros a b hab,
-    apply h,
-    rw [rat.dist_eq, abs_sub_comm] at hab,
-    exact_mod_cast hab },
-  { obtain ⟨ε', h', h''⟩ : ∃ ε' : ℚ, 0 < ε' ∧ (ε' : ℝ) < ε, from exists_pos_rat_lt ε_pos,
-    use [ε', h'],
-    intros a b hab,
-    apply h,
-    rw [rat.dist_eq, abs_sub_comm],
-    refine lt_trans _ h'',
-    exact_mod_cast hab }
+  rw [(absolute_value.has_basis_uniformity _).mem_iff, metric.uniformity_basis_dist_rat.mem_iff],
+  simp only [rat.dist_eq, absolute_value.abs_apply, ← rat.cast_sub, ← rat.cast_abs, rat.cast_lt,
+    abs_sub_comm]
 end
 
 /-- Cauchy reals packaged as a completion of ℚ using the absolute value route. -/
-noncomputable
-def rational_cau_seq_pkg : @abstract_completion ℚ $ is_absolute_value.uniform_space (abs : ℚ → ℚ) :=
+def rational_cau_seq_pkg : @abstract_completion ℚ $ (@absolute_value.abs ℚ _).uniform_space :=
 { space := ℝ,
   coe := (coe : ℚ → ℝ),
   uniform_struct := by apply_instance,
@@ -93,7 +84,7 @@ but they are not definitionaly equal, so it would confuse the type class system
 also human readers). -/
 @[derive comm_ring, derive inhabited] def Q := ℚ
 
-instance : uniform_space Q := is_absolute_value.uniform_space (abs : ℚ → ℚ)
+instance : uniform_space Q := (@absolute_value.abs ℚ _).uniform_space 
 
 /-- Real numbers constructed as in Bourbaki. -/
 @[derive inhabited]
@@ -104,8 +95,8 @@ instance bourbaki.uniform_space: uniform_space Bourbakiℝ := completion.uniform
 /-- Bourbaki reals packaged as a completion of Q using the general theory. -/
 def Bourbaki_pkg : abstract_completion Q := completion.cpkg
 
-/-- The equivalence between Bourbaki and Cauchy reals-/
-noncomputable def compare_equiv : Bourbakiℝ ≃ ℝ :=
+/-- The uniform bijection between Bourbaki and Cauchy reals. -/
+noncomputable def compare_equiv : Bourbakiℝ ≃ᵤ ℝ :=
 Bourbaki_pkg.compare_equiv rational_cau_seq_pkg
 
 lemma compare_uc : uniform_continuous (compare_equiv) :=
diff --git a/src/topology/uniform_space/complete_separated.lean b/src/topology/uniform_space/complete_separated.lean
index 47c05bccd5af3..8e5295cc88668 100644
--- a/src/topology/uniform_space/complete_separated.lean
+++ b/src/topology/uniform_space/complete_separated.lean
@@ -10,11 +10,14 @@ import topology.dense_embedding
 /-!
 # Theory of complete separated uniform spaces.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file is for elementary lemmas that depend on both Cauchy filters and separation.
 -/
 
 open filter
-open_locale topological_space filter
+open_locale topology filter
 
 variables {α : Type*}
 
diff --git a/src/topology/uniform_space/completion.lean b/src/topology/uniform_space/completion.lean
index 4979d8ce94ef2..32df076ed4101 100644
--- a/src/topology/uniform_space/completion.lean
+++ b/src/topology/uniform_space/completion.lean
@@ -8,6 +8,9 @@ import topology.uniform_space.abstract_completion
 /-!
 # Hausdorff completions of uniform spaces
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 The goal is to construct a left-adjoint to the inclusion of complete Hausdorff uniform spaces
 into all uniform spaces. Any uniform space `α` gets a completion `completion α` and a morphism
 (ie. uniformly continuous map) `coe : α → completion α` which solves the universal
@@ -44,7 +47,7 @@ noncomputable theory
 open filter set
 universes u v w x
 
-open_locale uniformity classical topological_space filter
+open_locale uniformity classical topology filter
 
 /-- Space of Cauchy filters
 
@@ -61,24 +64,25 @@ parameters {α : Type u} [uniform_space α]
 variables {β : Type v} {γ : Type w}
 variables [uniform_space β] [uniform_space γ]
 
+/-- The pairs of Cauchy filters generated by a set. -/
 def gen (s : set (α × α)) : set (Cauchy α × Cauchy α) :=
 {p | s ∈ p.1.val ×ᶠ p.2.val }
 
 lemma monotone_gen : monotone gen :=
-monotone_set_of $ assume p, @monotone_mem (α×α) (p.1.val ×ᶠ p.2.val)
+monotone_set_of $ assume p, @filter.monotone_mem _ (p.1.val ×ᶠ p.2.val)
 
 private lemma symm_gen : map prod.swap ((𝓤 α).lift' gen) ≤ (𝓤 α).lift' gen :=
 calc map prod.swap ((𝓤 α).lift' gen) =
   (𝓤 α).lift' (λs:set (α×α), {p | s ∈ p.2.val ×ᶠ p.1.val }) :
   begin
     delta gen,
-    simp [map_lift'_eq, monotone_set_of, monotone_mem,
+    simp [map_lift'_eq, monotone_set_of, filter.monotone_mem,
           function.comp, image_swap_eq_preimage_swap, -subtype.val_eq_coe]
   end
   ... ≤ (𝓤 α).lift' gen :
     uniformity_lift_le_swap
       (monotone_principal.comp (monotone_set_of $ assume p,
-        @monotone_mem (α×α) (p.2.val ×ᶠ  p.1.val)))
+        @filter.monotone_mem _ (p.2.val ×ᶠ p.1.val)))
       begin
         have h := λ(p:Cauchy α×Cauchy α), @filter.prod_comm _ _ (p.2.val) (p.1.val),
         simp [function.comp, h, -subtype.val_eq_coe, mem_map'],
@@ -110,14 +114,14 @@ calc ((𝓤 α).lift' gen).lift' (λs, comp_rel s s) =
   begin
     rw [lift'_lift'_assoc],
     exact monotone_gen,
-    exact (monotone_comp_rel monotone_id monotone_id)
+    exact monotone_id.comp_rel monotone_id
   end
   ... ≤ (𝓤 α).lift' (λs, gen $ comp_rel s s) :
     lift'_mono' $ assume s hs, comp_rel_gen_gen_subset_gen_comp_rel
   ... = ((𝓤 α).lift' $ λs:set(α×α), comp_rel s s).lift' gen :
   begin
     rw [lift'_lift'_assoc],
-    exact (monotone_comp_rel monotone_id monotone_id),
+    exact monotone_id.comp_rel monotone_id,
     exact monotone_gen
   end
   ... ≤ (𝓤 α).lift' gen : lift'_mono comp_le_uniformity le_rfl
@@ -125,7 +129,7 @@ calc ((𝓤 α).lift' gen).lift' (λs, comp_rel s s) =
 instance : uniform_space (Cauchy α) :=
 uniform_space.of_core
 { uniformity  := (𝓤 α).lift' gen,
-  refl        := principal_le_lift' $ assume s hs ⟨a, b⟩ (a_eq_b : a = b),
+  refl        := principal_le_lift'.2 $ λ s hs ⟨a, b⟩ (a_eq_b : a = b),
     a_eq_b ▸ a.property.right hs,
   symm        := symm_gen,
   comp        := comp_gen }
@@ -149,7 +153,7 @@ lemma uniform_inducing_pure_cauchy : uniform_inducing (pure_cauchy : α → Cauc
     calc comap (λ (x : α × α), (pure_cauchy (x.fst), pure_cauchy (x.snd))) ((𝓤 α).lift' gen)
           = (𝓤 α).lift'
               (preimage (λ (x : α × α), (pure_cauchy (x.fst), pure_cauchy (x.snd))) ∘ gen) :
-        comap_lift'_eq monotone_gen
+        comap_lift'_eq
       ... = 𝓤 α : by simp [this]⟩
 
 lemma uniform_embedding_pure_cauchy : uniform_embedding (pure_cauchy : α → Cauchy α) :=
@@ -207,7 +211,7 @@ complete_space_extension
   assume f hf,
   let f' : Cauchy α := ⟨f, hf⟩ in
   have map pure_cauchy f ≤ (𝓤 $ Cauchy α).lift' (preimage (prod.mk f')),
-    from le_lift' $ assume s hs,
+    from le_lift'.2 $ assume s hs,
     let ⟨t, ht₁, (ht₂ : gen t ⊆ s)⟩ := (mem_lift'_sets monotone_gen).mp hs in
     let ⟨t', ht', (h : t' ×ˢ t' ⊆ t)⟩ := mem_prod_same_iff.mp (hf.right ht₁) in
     have t' ⊆ { y : α | (f', pure_cauchy y) ∈ gen t },
@@ -224,11 +228,13 @@ h.rec_on $ assume a, nonempty.intro $ Cauchy.pure_cauchy a
 
 section extend
 
-def extend (f : α → β) : (Cauchy α → β) :=
+/-- Extend a uniformly continuous function `α → β` to a function `Cauchy α → β`. Outputs junk when
+`f` is not uniformly continuous. -/
+def extend (f : α → β) : Cauchy α → β :=
 if uniform_continuous f then
   dense_inducing_pure_cauchy.extend f
 else
-  λ x, f (classical.inhabited_of_nonempty $ nonempty_Cauchy_iff.1 ⟨x⟩).default
+  λ x, f (nonempty_Cauchy_iff.1 ⟨x⟩).some
 
 section separated_space
 variables [separated_space β]
@@ -338,7 +344,7 @@ instance : complete_space (completion α) := uniform_space.complete_space_separa
 
 instance : separated_space (completion α) := uniform_space.separated_separation
 
-instance : regular_space (completion α) := separated_regular
+instance : t3_space (completion α) := separated_t3
 
 /-- Automatic coercion from `α` to its completion. Not always injective. -/
 instance : has_coe_t α (completion α) := ⟨quotient.mk ∘ pure_cauchy⟩ -- note [use has_coe_t]
@@ -366,6 +372,7 @@ dense_range_pure_cauchy.quotient
 
 variables (α)
 
+/-- The Haudorff completion as an abstract completion. -/
 def cpkg {α : Type*} [uniform_space α] : abstract_completion α :=
 { space := completion α,
   coe := coe,
@@ -403,6 +410,11 @@ lemma dense_inducing_coe : dense_inducing (coe : α → completion α) :=
 { dense := dense_range_coe,
   ..(uniform_inducing_coe α).inducing }
 
+/-- The uniform bijection between a complete space and its uniform completion. -/
+def uniform_completion.complete_equiv_self [complete_space α] [separated_space α]:
+  completion α ≃ᵤ α :=
+abstract_completion.compare_equiv completion.cpkg abstract_completion.of_complete
+
 open topological_space
 
 instance separable_space_completion [separable_space α] : separable_space (completion α) :=
@@ -528,6 +540,8 @@ end map
 completion of its separation quotient -/
 section separation_quotient_completion
 
+/-- The isomorphism between the completion of a uniform space and the completion of its separation
+quotient. -/
 def completion_separation_quotient_equiv (α : Type u) [uniform_space α] :
   completion (separation_quotient α) ≃ completion α :=
 begin
@@ -563,6 +577,7 @@ section extension₂
 variables (f : α → β → γ)
 open function
 
+/-- Extend a two variable map to the Hausdorff completions. -/
 protected def extension₂ (f : α → β → γ) : completion α → completion β → γ :=
 cpkg.extend₂ cpkg f
 
@@ -585,6 +600,7 @@ end extension₂
 section map₂
 open function
 
+/-- Lift a two variable map to the Hausdorff completions. -/
 protected def map₂ (f : α → β → γ) : completion α → completion β → completion γ :=
 cpkg.map₂ cpkg cpkg f
 
diff --git a/src/topology/uniform_space/equicontinuity.lean b/src/topology/uniform_space/equicontinuity.lean
new file mode 100644
index 0000000000000..fd356ae43e4ba
--- /dev/null
+++ b/src/topology/uniform_space/equicontinuity.lean
@@ -0,0 +1,428 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Anatole Dedecker
+-/
+import topology.uniform_space.uniform_convergence_topology
+
+/-!
+# Equicontinuity of a family of functions
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+Let `X` be a topological space and `α` a `uniform_space`. A family of functions `F : ι → X → α`
+is said to be *equicontinuous at a point `x₀ : X`* when, for any entourage `U` in `α`, there is a
+neighborhood `V` of `x₀` such that, for all `x ∈ V`, and *for all `i`*, `F i x` is `U`-close to
+`F i x₀`. In other words, one has `∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U`.
+For maps between metric spaces, this corresponds to
+`∀ ε > 0, ∃ δ > 0, ∀ x, ∀ i, dist x₀ x < δ → dist (F i x₀) (F i x) < ε`.
+
+`F` is said to be *equicontinuous* if it is equicontinuous at each point.
+
+A closely related concept is that of ***uniform*** *equicontinuity* of a family of functions
+`F : ι → β → α` between uniform spaces, which means that, for any entourage `U` in `α`, there is an
+entourage `V` in `β` such that, if `x` and `y` are `V`-close, then *for all `i`*, `F i x` and
+`F i y` are `U`-close. In other words, one has
+`∀ U ∈ 𝓤 α, ∀ᶠ xy in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U`.
+For maps between metric spaces, this corresponds to
+`∀ ε > 0, ∃ δ > 0, ∀ x y, ∀ i, dist x y < δ → dist (F i x₀) (F i x) < ε`.
+
+## Main definitions
+
+* `equicontinuous_at`: equicontinuity of a family of functions at a point
+* `equicontinuous`: equicontinuity of a family of functions on the whole domain
+* `uniform_equicontinuous`: uniform equicontinuity of a family of functions on the whole domain
+
+## Main statements
+
+* `equicontinuous_iff_continuous`: equicontinuity can be expressed as a simple continuity
+  condition between well-chosen function spaces. This is really useful for building up the theory.
+* `equicontinuous.closure`: if a set of functions is equicontinuous, its closure
+  *for the topology of uniform convergence* is also equicontinuous.
+
+## Notations
+
+Throughout this file, we use :
+- `ι`, `κ` for indexing types
+- `X`, `Y`, `Z` for topological spaces
+- `α`, `β`, `γ` for uniform spaces
+
+## Implementation details
+
+We choose to express equicontinuity as a properties of indexed families of functions rather
+than sets of functions for the following reasons:
+- it is really easy to express equicontinuity of `H : set (X → α)` using our setup: it is just
+  equicontinuity of the family `coe : ↥H → (X → α)`. On the other hand, going the other way around
+  would require working with the range of the family, which is always annoying because it
+  introduces useless existentials.
+- in most applications, one doesn't work with bare functions but with a more specific hom type
+  `hom`. Equicontinuity of a set `H : set hom` would then have to be expressed as equicontinuity
+  of `coe_fn '' H`, which is super annoying to work with. This is much simpler with families,
+  because equicontinuity of a family `𝓕 : ι → hom` would simply be expressed as equicontinuity
+  of `coe_fn ∘ 𝓕`, which doesn't introduce any nasty existentials.
+
+To simplify statements, we do provide abbreviations `set.equicontinuous_at`, `set.equicontinuous`
+and `set.uniform_equicontinuous` asserting the corresponding fact about the family
+`coe : ↥H → (X → α)` where `H : set (X → α)`. Note however that these won't work for sets of hom
+types, and in that case one should go back to the family definition rather than using `set.image`.
+
+Since we have no use case for it yet, we don't introduce any relative version
+(i.e no `equicontinuous_within_at` or `equicontinuous_on`), but this is more of a conservative
+position than a design decision, so anyone needing relative versions should feel free to add them,
+and that should hopefully be a straightforward task.
+
+## References
+
+* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]
+
+## Tags
+
+equicontinuity, uniform convergence, ascoli
+-/
+
+section
+
+open uniform_space filter set
+open_locale uniformity topology uniform_convergence
+
+variables {ι κ X Y Z α β γ 𝓕 : Type*} [topological_space X] [topological_space Y]
+  [topological_space Z] [uniform_space α] [uniform_space β] [uniform_space γ]
+
+/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
+*equicontinuous at `x₀ : X`* if, for all entourage `U ∈ 𝓤 α`, there is a neighborhood `V` of `x₀`
+such that, for all `x ∈ V` and for all `i : ι`, `F i x` is `U`-close to `F i x₀`. -/
+def equicontinuous_at (F : ι → X → α) (x₀ : X) : Prop :=
+∀ U ∈ 𝓤 α, ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ U
+
+/-- We say that a set `H : set (X → α)` of functions is equicontinuous at a point if the family
+`coe : ↥H → (X → α)` is equicontinuous at that point. -/
+protected abbreviation set.equicontinuous_at (H : set $ X → α) (x₀ : X) : Prop :=
+equicontinuous_at (coe : H → X → α) x₀
+
+/-- A family `F : ι → X → α` of functions from a topological space to a uniform space is
+*equicontinuous* on all of `X` if it is equicontinuous at each point of `X`. -/
+def equicontinuous (F : ι → X → α) : Prop :=
+∀ x₀, equicontinuous_at F x₀
+
+/-- We say that a set `H : set (X → α)` of functions is equicontinuous if the family
+`coe : ↥H → (X → α)` is equicontinuous. -/
+protected abbreviation set.equicontinuous (H : set $ X → α) : Prop :=
+equicontinuous (coe : H → X → α)
+
+/-- A family `F : ι → β → α` of functions between uniform spaces is *uniformly equicontinuous* if,
+for all entourage `U ∈ 𝓤 α`, there is an entourage `V ∈ 𝓤 β` such that, whenever `x` and `y` are
+`V`-close, we have that, *for all `i : ι`*, `F i x` is `U`-close to `F i x₀`. -/
+def uniform_equicontinuous (F : ι → β → α) : Prop :=
+∀ U ∈ 𝓤 α, ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ U
+
+/-- We say that a set `H : set (X → α)` of functions is uniformly equicontinuous if the family
+`coe : ↥H → (X → α)` is uniformly equicontinuous. -/
+protected abbreviation set.uniform_equicontinuous (H : set $ β → α) : Prop :=
+uniform_equicontinuous (coe : H → β → α)
+
+/-- Reformulation of equicontinuity at `x₀` comparing two variables near `x₀` instead of comparing
+only one with `x₀`. -/
+lemma equicontinuous_at_iff_pair {F : ι → X → α} {x₀ : X} : equicontinuous_at F x₀ ↔
+  ∀ U ∈ 𝓤 α, ∃ V ∈ 𝓝 x₀, ∀ (x y ∈ V) i, (F i x, F i y) ∈ U :=
+begin
+  split; intros H U hU,
+  { rcases comp_symm_mem_uniformity_sets hU with ⟨V, hV, hVsymm, hVU⟩,
+    refine ⟨_, H V hV, λ x hx y hy i, hVU (prod_mk_mem_comp_rel _ (hy i))⟩,
+    exact hVsymm.mk_mem_comm.mp (hx i) },
+  { rcases H U hU with ⟨V, hV, hVU⟩,
+    filter_upwards [hV] using λ x hx i, (hVU x₀ (mem_of_mem_nhds hV) x hx i) }
+end
+
+/-- Uniform equicontinuity implies equicontinuity. -/
+lemma uniform_equicontinuous.equicontinuous {F : ι → β → α} (h : uniform_equicontinuous F) :
+  equicontinuous F :=
+λ x₀ U hU, mem_of_superset (ball_mem_nhds x₀ (h U hU)) (λ x hx i, hx i)
+
+/-- Each function of a family equicontinuous at `x₀` is continuous at `x₀`. -/
+lemma equicontinuous_at.continuous_at {F : ι → X → α} {x₀ : X} (h : equicontinuous_at F x₀)
+  (i : ι) : continuous_at (F i) x₀ :=
+begin
+  intros U hU,
+  rw uniform_space.mem_nhds_iff at hU,
+  rcases hU with ⟨V, hV₁, hV₂⟩,
+  exact mem_map.mpr (mem_of_superset (h V hV₁) (λ x hx, hV₂ (hx i)))
+end
+
+protected lemma set.equicontinuous_at.continuous_at_of_mem {H : set $ X → α} {x₀ : X}
+  (h : H.equicontinuous_at x₀) {f : X → α} (hf : f ∈ H) : continuous_at f x₀ :=
+h.continuous_at ⟨f, hf⟩
+
+/-- Each function of an equicontinuous family is continuous. -/
+lemma equicontinuous.continuous {F : ι → X → α} (h : equicontinuous F) (i : ι) :
+  continuous (F i) :=
+continuous_iff_continuous_at.mpr (λ x, (h x).continuous_at i)
+
+protected lemma set.equicontinuous.continuous_of_mem {H : set $ X → α} (h : H.equicontinuous)
+  {f : X → α} (hf : f ∈ H) : continuous f :=
+h.continuous ⟨f, hf⟩
+
+/-- Each function of a uniformly equicontinuous family is uniformly continuous. -/
+lemma uniform_equicontinuous.uniform_continuous {F : ι → β → α} (h : uniform_equicontinuous F)
+  (i : ι) : uniform_continuous (F i) :=
+λ U hU, mem_map.mpr (mem_of_superset (h U hU) $ λ xy hxy, (hxy i))
+
+protected lemma set.uniform_equicontinuous.uniform_continuous_of_mem {H : set $ β → α}
+  (h : H.uniform_equicontinuous) {f : β → α} (hf : f ∈ H) : uniform_continuous f :=
+h.uniform_continuous ⟨f, hf⟩
+
+/-- Taking sub-families preserves equicontinuity at a point. -/
+lemma equicontinuous_at.comp {F : ι → X → α} {x₀ : X} (h : equicontinuous_at F x₀) (u : κ → ι) :
+  equicontinuous_at (F ∘ u) x₀ :=
+λ U hU, (h U hU).mono (λ x H k, H (u k))
+
+protected lemma set.equicontinuous_at.mono {H H' : set $ X → α} {x₀ : X}
+  (h : H.equicontinuous_at x₀) (hH : H' ⊆ H) : H'.equicontinuous_at x₀ :=
+h.comp (inclusion hH)
+
+/-- Taking sub-families preserves equicontinuity. -/
+lemma equicontinuous.comp {F : ι → X → α} (h : equicontinuous F) (u : κ → ι) :
+  equicontinuous (F ∘ u) :=
+λ x, (h x).comp u
+
+protected lemma set.equicontinuous.mono {H H' : set $ X → α}
+  (h : H.equicontinuous) (hH : H' ⊆ H) : H'.equicontinuous :=
+h.comp (inclusion hH)
+
+/-- Taking sub-families preserves uniform equicontinuity. -/
+lemma uniform_equicontinuous.comp {F : ι → β → α} (h : uniform_equicontinuous F) (u : κ → ι) :
+  uniform_equicontinuous (F ∘ u) :=
+λ U hU, (h U hU).mono (λ x H k, H (u k))
+
+protected lemma set.uniform_equicontinuous.mono {H H' : set $ β → α}
+  (h : H.uniform_equicontinuous) (hH : H' ⊆ H) : H'.uniform_equicontinuous :=
+h.comp (inclusion hH)
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff `range 𝓕` is equicontinuous at `x₀`,
+i.e the family `coe : range F → X → α` is equicontinuous at `x₀`. -/
+lemma equicontinuous_at_iff_range {F : ι → X → α} {x₀ : X} :
+  equicontinuous_at F x₀ ↔ equicontinuous_at (coe : range F → X → α) x₀ :=
+⟨λ h, by rw ← comp_range_splitting F; exact h.comp _, λ h, h.comp (range_factorization F)⟩
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous iff `range 𝓕` is equicontinuous,
+i.e the family `coe : range F → X → α` is equicontinuous. -/
+lemma equicontinuous_iff_range {F : ι → X → α} :
+  equicontinuous F ↔ equicontinuous (coe : range F → X → α) :=
+forall_congr (λ x₀, equicontinuous_at_iff_range)
+
+/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff `range 𝓕` is uniformly equicontinuous,
+i.e the family `coe : range F → β → α` is uniformly equicontinuous. -/
+lemma uniform_equicontinuous_at_iff_range {F : ι → β → α} :
+  uniform_equicontinuous F ↔ uniform_equicontinuous (coe : range F → β → α) :=
+⟨λ h, by rw ← comp_range_splitting F; exact h.comp _, λ h, h.comp (range_factorization F)⟩
+
+section
+
+open uniform_fun
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous at `x₀` iff the function `swap 𝓕 : X → ι → α` is
+continuous at `x₀` *when `ι → α` is equipped with the topology of uniform convergence*. This is
+very useful for developping the equicontinuity API, but it should not be used directly for other
+purposes. -/
+lemma equicontinuous_at_iff_continuous_at {F : ι → X → α} {x₀ : X} :
+  equicontinuous_at F x₀ ↔ continuous_at (of_fun ∘ function.swap F : X → ι →ᵤ α) x₀ :=
+by rw [continuous_at, (uniform_fun.has_basis_nhds ι α _).tendsto_right_iff]; refl
+
+/-- A family `𝓕 : ι → X → α` is equicontinuous iff the function `swap 𝓕 : X → ι → α` is
+continuous *when `ι → α` is equipped with the topology of uniform convergence*. This is
+very useful for developping the equicontinuity API, but it should not be used directly for other
+purposes. -/
+lemma equicontinuous_iff_continuous {F : ι → X → α} :
+  equicontinuous F ↔ continuous (of_fun ∘ function.swap F : X → ι →ᵤ α) :=
+by simp_rw [equicontinuous, continuous_iff_continuous_at, equicontinuous_at_iff_continuous_at]
+
+/-- A family `𝓕 : ι → β → α` is uniformly equicontinuous iff the function `swap 𝓕 : β → ι → α` is
+uniformly continuous *when `ι → α` is equipped with the uniform structure of uniform convergence*.
+This is very useful for developping the equicontinuity API, but it should not be used directly
+for other purposes. -/
+lemma uniform_equicontinuous_iff_uniform_continuous {F : ι → β → α} :
+  uniform_equicontinuous F ↔ uniform_continuous (of_fun ∘ function.swap F : β → ι →ᵤ α) :=
+by rw [uniform_continuous, (uniform_fun.has_basis_uniformity ι α).tendsto_right_iff]; refl
+
+lemma filter.has_basis.equicontinuous_at_iff_left {κ : Type*} {p : κ → Prop} {s : κ → set X}
+  {F : ι → X → α} {x₀ : X} (hX : (𝓝 x₀).has_basis p s) : equicontinuous_at F x₀ ↔
+  ∀ U ∈ 𝓤 α, ∃ k (_ : p k), ∀ x ∈ s k, ∀ i, (F i x₀, F i x) ∈ U :=
+begin
+  rw [equicontinuous_at_iff_continuous_at, continuous_at,
+      hX.tendsto_iff (uniform_fun.has_basis_nhds ι α _)],
+  refl
+end
+
+lemma filter.has_basis.equicontinuous_at_iff_right {κ : Type*} {p : κ → Prop} {s : κ → set (α × α)}
+  {F : ι → X → α} {x₀ : X} (hα : (𝓤 α).has_basis p s) : equicontinuous_at F x₀ ↔
+  ∀ k, p k → ∀ᶠ x in 𝓝 x₀, ∀ i, (F i x₀, F i x) ∈ s k :=
+begin
+  rw [equicontinuous_at_iff_continuous_at, continuous_at,
+      (uniform_fun.has_basis_nhds_of_basis ι α _ hα).tendsto_right_iff],
+  refl
+end
+
+lemma filter.has_basis.equicontinuous_at_iff {κ₁ κ₂ : Type*} {p₁ : κ₁ → Prop} {s₁ : κ₁ → set X}
+  {p₂ : κ₂ → Prop} {s₂ : κ₂ → set (α × α)} {F : ι → X → α} {x₀ : X}
+  (hX : (𝓝 x₀).has_basis p₁ s₁) (hα : (𝓤 α).has_basis p₂ s₂) : equicontinuous_at F x₀ ↔
+  ∀ k₂, p₂ k₂ → ∃ k₁ (_ : p₁ k₁), ∀ x ∈ s₁ k₁, ∀ i, (F i x₀, F i x) ∈ s₂ k₂ :=
+begin
+  rw [equicontinuous_at_iff_continuous_at, continuous_at,
+      hX.tendsto_iff (uniform_fun.has_basis_nhds_of_basis ι α _ hα)],
+  refl
+end
+
+lemma filter.has_basis.uniform_equicontinuous_iff_left {κ : Type*} {p : κ → Prop}
+  {s : κ → set (β × β)} {F : ι → β → α} (hβ : (𝓤 β).has_basis p s) : uniform_equicontinuous F ↔
+  ∀ U ∈ 𝓤 α, ∃ k (_ : p k), ∀ x y, (x, y) ∈ s k → ∀ i, (F i x, F i y) ∈ U :=
+begin
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
+      hβ.tendsto_iff (uniform_fun.has_basis_uniformity ι α)],
+  simp_rw [prod.forall],
+  refl
+end
+
+lemma filter.has_basis.uniform_equicontinuous_iff_right {κ : Type*} {p : κ → Prop}
+  {s : κ → set (α × α)} {F : ι → β → α} (hα : (𝓤 α).has_basis p s) : uniform_equicontinuous F ↔
+  ∀ k, p k → ∀ᶠ (xy : β × β) in 𝓤 β, ∀ i, (F i xy.1, F i xy.2) ∈ s k :=
+begin
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
+      (uniform_fun.has_basis_uniformity_of_basis ι α hα).tendsto_right_iff],
+  refl
+end
+
+lemma filter.has_basis.uniform_equicontinuous_iff {κ₁ κ₂ : Type*} {p₁ : κ₁ → Prop}
+  {s₁ : κ₁ → set (β × β)} {p₂ : κ₂ → Prop} {s₂ : κ₂ → set (α × α)} {F : ι → β → α}
+  (hβ : (𝓤 β).has_basis p₁ s₁) (hα : (𝓤 α).has_basis p₂ s₂) : uniform_equicontinuous F ↔
+  ∀ k₂, p₂ k₂ → ∃ k₁ (_ : p₁ k₁), ∀ x y, (x, y) ∈ s₁ k₁ → ∀ i, (F i x, F i y) ∈ s₂ k₂ :=
+begin
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_continuous,
+      hβ.tendsto_iff (uniform_fun.has_basis_uniformity_of_basis ι α hα)],
+  simp_rw [prod.forall],
+  refl
+end
+
+/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous at a point
+`x₀ : X` iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is
+equicontinuous at `x₀`. -/
+lemma uniform_inducing.equicontinuous_at_iff {F : ι → X → α} {x₀ : X} {u : α → β}
+  (hu : uniform_inducing u) :
+  equicontinuous_at F x₀ ↔ equicontinuous_at (((∘) u) ∘ F) x₀ :=
+begin
+  have := (uniform_fun.postcomp_uniform_inducing hu).inducing,
+  rw [equicontinuous_at_iff_continuous_at, equicontinuous_at_iff_continuous_at,
+      this.continuous_at_iff],
+  refl
+end
+
+/-- Given `u : α → β` a uniform inducing map, a family `𝓕 : ι → X → α` is equicontinuous iff the
+family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is equicontinuous. -/
+lemma uniform_inducing.equicontinuous_iff {F : ι → X → α} {u : α → β}
+  (hu : uniform_inducing u) :
+  equicontinuous F ↔ equicontinuous (((∘) u) ∘ F) :=
+begin
+  congrm (∀ x, (_ : Prop)),
+  rw hu.equicontinuous_at_iff
+end
+
+/-- Given `u : α → γ` a uniform inducing map, a family `𝓕 : ι → β → α` is uniformly equicontinuous
+iff the family `𝓕'`, obtained by precomposing each function of `𝓕` by `u`, is uniformly
+equicontinuous. -/
+lemma uniform_inducing.uniform_equicontinuous_iff {F : ι → β → α} {u : α → γ}
+  (hu : uniform_inducing u) :
+  uniform_equicontinuous F ↔ uniform_equicontinuous (((∘) u) ∘ F) :=
+begin
+  have := uniform_fun.postcomp_uniform_inducing hu,
+  rw [uniform_equicontinuous_iff_uniform_continuous, uniform_equicontinuous_iff_uniform_continuous,
+      this.uniform_continuous_iff],
+  refl
+end
+
+/-- A version of `equicontinuous_at.closure` applicable to subsets of types which embed continuously
+into `X → α` with the product topology. It turns out we don't need any other condition on the
+embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
+the coercion is injective. -/
+lemma equicontinuous_at.closure' {A : set Y} {u : Y → X → α} {x₀ : X}
+  (hA : equicontinuous_at (u ∘ coe : A → X → α) x₀) (hu : continuous u) :
+  equicontinuous_at (u ∘ coe : closure A → X → α) x₀ :=
+begin
+  intros U hU,
+  rcases mem_uniformity_is_closed hU with ⟨V, hV, hVclosed, hVU⟩,
+  filter_upwards [hA V hV] with x hx,
+  rw set_coe.forall at *,
+  change A ⊆ (λ f, (u f x₀, u f x)) ⁻¹' V at hx,
+  refine (closure_minimal hx $ hVclosed.preimage $ _).trans (preimage_mono hVU),
+  exact continuous.prod_mk ((continuous_apply x₀).comp hu) ((continuous_apply x).comp hu)
+end
+
+/-- If a set of functions is equicontinuous at some `x₀`, its closure for the product topology is
+also equicontinuous at `x₀`. -/
+lemma equicontinuous_at.closure {A : set $ X → α} {x₀ : X} (hA : A.equicontinuous_at x₀) :
+  (closure A).equicontinuous_at x₀ :=
+@equicontinuous_at.closure' _ _ _ _ _ _ _ id _ hA continuous_id
+
+/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
+family `𝓕` is equicontinuous at some `x₀ : X`, then the limit is continuous at `x₀`. -/
+lemma filter.tendsto.continuous_at_of_equicontinuous_at {l : filter ι} [l.ne_bot] {F : ι → X → α}
+  {f : X → α} {x₀ : X} (h₁ : tendsto F l (𝓝 f)) (h₂ : equicontinuous_at F x₀) :
+  continuous_at f x₀ :=
+(equicontinuous_at_iff_range.mp h₂).closure.continuous_at
+  ⟨f, mem_closure_of_tendsto h₁ $ eventually_of_forall mem_range_self⟩
+
+/-- A version of `equicontinuous.closure` applicable to subsets of types which embed continuously
+into `X → α` with the product topology. It turns out we don't need any other condition on the
+embedding than continuity, but in practice this will mostly be applied to `fun_like` types where
+the coercion is injective. -/
+lemma equicontinuous.closure' {A : set Y} {u : Y → X → α}
+  (hA : equicontinuous (u ∘ coe : A → X → α)) (hu : continuous u) :
+  equicontinuous (u ∘ coe : closure A → X → α) :=
+λ x, (hA x).closure' hu
+
+/-- If a set of functions is equicontinuous, its closure for the product topology is also
+equicontinuous. -/
+lemma equicontinuous.closure {A : set $ X → α} (hA : A.equicontinuous) :
+  (closure A).equicontinuous :=
+λ x, (hA x).closure
+
+/-- If `𝓕 : ι → X → α` tends to `f : X → α` *pointwise* along some nontrivial filter, and if the
+family `𝓕` is equicontinuous, then the limit is continuous. -/
+lemma filter.tendsto.continuous_of_equicontinuous_at {l : filter ι} [l.ne_bot] {F : ι → X → α}
+  {f : X → α} (h₁ : tendsto F l (𝓝 f)) (h₂ : equicontinuous F) :
+  continuous f :=
+continuous_iff_continuous_at.mpr (λ x, h₁.continuous_at_of_equicontinuous_at (h₂ x))
+
+/-- A version of `uniform_equicontinuous.closure` applicable to subsets of types which embed
+continuously into `β → α` with the product topology. It turns out we don't need any other condition
+on the embedding than continuity, but in practice this will mostly be applied to `fun_like` types
+where the coercion is injective. -/
+lemma uniform_equicontinuous.closure' {A : set Y} {u : Y → β → α}
+  (hA : uniform_equicontinuous (u ∘ coe : A → β → α)) (hu : continuous u) :
+  uniform_equicontinuous (u ∘ coe : closure A → β → α) :=
+begin
+  intros U hU,
+  rcases mem_uniformity_is_closed hU with ⟨V, hV, hVclosed, hVU⟩,
+  filter_upwards [hA V hV],
+  rintros ⟨x, y⟩ hxy,
+  rw set_coe.forall at *,
+  change A ⊆ (λ f, (u f x, u f y)) ⁻¹' V at hxy,
+  refine (closure_minimal hxy $ hVclosed.preimage $ _).trans (preimage_mono hVU),
+  exact continuous.prod_mk ((continuous_apply x).comp hu) ((continuous_apply y).comp hu)
+end
+
+/-- If a set of functions is uniformly equicontinuous, its closure for the product topology is also
+uniformly equicontinuous. -/
+lemma uniform_equicontinuous.closure {A : set $ β → α} (hA : A.uniform_equicontinuous) :
+  (closure A).uniform_equicontinuous :=
+@uniform_equicontinuous.closure' _ _ _ _ _ _ _ id hA continuous_id
+
+/-- If `𝓕 : ι → β → α` tends to `f : β → α` *pointwise* along some nontrivial filter, and if the
+family `𝓕` is uniformly equicontinuous, then the limit is uniformly continuous. -/
+lemma filter.tendsto.uniform_continuous_of_uniform_equicontinuous {l : filter ι} [l.ne_bot]
+  {F : ι → β → α} {f : β → α} (h₁ : tendsto F l (𝓝 f)) (h₂ : uniform_equicontinuous F) :
+  uniform_continuous f :=
+(uniform_equicontinuous_at_iff_range.mp h₂).closure.uniform_continuous
+  ⟨f, mem_closure_of_tendsto h₁ $ eventually_of_forall mem_range_self⟩
+
+end
+
+end
diff --git a/src/topology/uniform_space/equiv.lean b/src/topology/uniform_space/equiv.lean
new file mode 100644
index 0000000000000..7103f02e8ca90
--- /dev/null
+++ b/src/topology/uniform_space/equiv.lean
@@ -0,0 +1,281 @@
+/-
+Copyright (c) 2022 Anatole Dedecker. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton,
+Anatole Dedecker
+-/
+import topology.homeomorph
+import topology.uniform_space.uniform_embedding
+import topology.uniform_space.pi
+
+/-!
+# Uniform isomorphisms
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file defines uniform isomorphisms between two uniform spaces. They are bijections with both
+directions uniformly continuous. We denote uniform isomorphisms with the notation `≃ᵤ`.
+
+# Main definitions
+
+* `uniform_equiv α β`: The type of uniform isomorphisms from `α` to `β`.
+  This type can be denoted using the following notation: `α ≃ᵤ β`.
+
+-/
+
+open set filter
+open_locale
+
+universes u v
+variables {α : Type u} {β : Type*} {γ : Type*} {δ : Type*}
+
+/-- Uniform isomorphism between `α` and `β` -/
+@[nolint has_nonempty_instance] -- not all spaces are homeomorphic to each other
+structure uniform_equiv (α : Type*) (β : Type*) [uniform_space α] [uniform_space β]
+  extends α ≃ β :=
+(uniform_continuous_to_fun  : uniform_continuous to_fun)
+(uniform_continuous_inv_fun : uniform_continuous inv_fun)
+
+infix ` ≃ᵤ `:25 := uniform_equiv
+
+namespace uniform_equiv
+variables [uniform_space α] [uniform_space β] [uniform_space γ] [uniform_space δ]
+
+instance : has_coe_to_fun (α ≃ᵤ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩
+
+@[simp] lemma uniform_equiv_mk_coe (a : equiv α β) (b c) :
+  ((uniform_equiv.mk a b c) : α → β) = a :=
+rfl
+
+/-- Inverse of a uniform isomorphism. -/
+protected def symm (h : α ≃ᵤ β) : β ≃ᵤ α :=
+{ uniform_continuous_to_fun  := h.uniform_continuous_inv_fun,
+  uniform_continuous_inv_fun := h.uniform_continuous_to_fun,
+  to_equiv := h.to_equiv.symm }
+
+/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
+  because it is a composition of multiple projections. -/
+def simps.apply (h : α ≃ᵤ β) : α → β := h
+/-- See Note [custom simps projection] -/
+def simps.symm_apply (h : α ≃ᵤ β) : β → α := h.symm
+
+initialize_simps_projections uniform_equiv
+  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)
+
+@[simp] lemma coe_to_equiv (h : α ≃ᵤ β) : ⇑h.to_equiv = h := rfl
+@[simp] lemma coe_symm_to_equiv (h : α ≃ᵤ β) : ⇑h.to_equiv.symm = h.symm := rfl
+
+lemma to_equiv_injective : function.injective (to_equiv : α ≃ᵤ β → α ≃ β)
+| ⟨e, h₁, h₂⟩ ⟨e', h₁', h₂'⟩ rfl := rfl
+
+@[ext] lemma ext {h h' : α ≃ᵤ β} (H : ∀ x, h x = h' x) : h = h' :=
+to_equiv_injective $ equiv.ext H
+
+/-- Identity map as a uniform isomorphism. -/
+@[simps apply {fully_applied := ff}]
+protected def refl (α : Type*) [uniform_space α] : α ≃ᵤ α :=
+{ uniform_continuous_to_fun := uniform_continuous_id,
+  uniform_continuous_inv_fun := uniform_continuous_id,
+  to_equiv := equiv.refl α }
+
+/-- Composition of two uniform isomorphisms. -/
+protected def trans (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) : α ≃ᵤ γ :=
+{ uniform_continuous_to_fun  := h₂.uniform_continuous_to_fun.comp h₁.uniform_continuous_to_fun,
+  uniform_continuous_inv_fun := h₁.uniform_continuous_inv_fun.comp h₂.uniform_continuous_inv_fun,
+  to_equiv := equiv.trans h₁.to_equiv h₂.to_equiv }
+
+@[simp] lemma trans_apply (h₁ : α ≃ᵤ β) (h₂ : β ≃ᵤ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) := rfl
+
+@[simp] lemma uniform_equiv_mk_coe_symm (a : equiv α β) (b c) :
+  ((uniform_equiv.mk a b c).symm : β → α) = a.symm :=
+rfl
+
+@[simp] lemma refl_symm : (uniform_equiv.refl α).symm = uniform_equiv.refl α := rfl
+
+protected lemma uniform_continuous (h : α ≃ᵤ β) : uniform_continuous h :=
+h.uniform_continuous_to_fun
+
+@[continuity]
+protected lemma continuous (h : α ≃ᵤ β) : continuous h :=
+h.uniform_continuous.continuous
+
+protected lemma uniform_continuous_symm (h : α ≃ᵤ β) : uniform_continuous (h.symm) :=
+h.uniform_continuous_inv_fun
+
+@[continuity] -- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
+protected lemma continuous_symm (h : α ≃ᵤ β) : continuous (h.symm) :=
+h.uniform_continuous_symm.continuous
+
+/-- A uniform isomorphism as a homeomorphism. -/
+@[simps]
+protected def to_homeomorph (e : α ≃ᵤ β) : α ≃ₜ β :=
+{ continuous_to_fun := e.continuous,
+  continuous_inv_fun := e.continuous_symm,
+  .. e.to_equiv }
+
+@[simp] lemma apply_symm_apply (h : α ≃ᵤ β) (x : β) : h (h.symm x) = x :=
+h.to_equiv.apply_symm_apply x
+
+@[simp] lemma symm_apply_apply (h : α ≃ᵤ β) (x : α) : h.symm (h x) = x :=
+h.to_equiv.symm_apply_apply x
+
+protected lemma bijective (h : α ≃ᵤ β) : function.bijective h := h.to_equiv.bijective
+protected lemma injective (h : α ≃ᵤ β) : function.injective h := h.to_equiv.injective
+protected lemma surjective (h : α ≃ᵤ β) : function.surjective h := h.to_equiv.surjective
+
+/-- Change the uniform equiv `f` to make the inverse function definitionally equal to `g`. -/
+def change_inv (f : α ≃ᵤ β) (g : β → α) (hg : function.right_inverse g f) : α ≃ᵤ β :=
+have g = f.symm, from funext (λ x, calc g x = f.symm (f (g x)) : (f.left_inv (g x)).symm
+                                        ... = f.symm x : by rw hg x),
+{ to_fun := f,
+  inv_fun := g,
+  left_inv := by convert f.left_inv,
+  right_inv := by convert f.right_inv,
+  uniform_continuous_to_fun := f.uniform_continuous,
+  uniform_continuous_inv_fun := by convert f.symm.uniform_continuous }
+
+@[simp] lemma symm_comp_self (h : α ≃ᵤ β) : ⇑h.symm ∘ ⇑h = id :=
+funext h.symm_apply_apply
+
+@[simp] lemma self_comp_symm (h : α ≃ᵤ β) : ⇑h ∘ ⇑h.symm = id :=
+funext h.apply_symm_apply
+
+@[simp] lemma range_coe (h : α ≃ᵤ β) : range h = univ :=
+h.surjective.range_eq
+
+lemma image_symm (h : α ≃ᵤ β) : image h.symm = preimage h :=
+funext h.symm.to_equiv.image_eq_preimage
+
+lemma preimage_symm (h : α ≃ᵤ β) : preimage h.symm = image h :=
+(funext h.to_equiv.image_eq_preimage).symm
+
+@[simp] lemma image_preimage (h : α ≃ᵤ β) (s : set β) : h '' (h ⁻¹' s) = s :=
+h.to_equiv.image_preimage s
+
+@[simp] lemma preimage_image (h : α ≃ᵤ β) (s : set α) : h ⁻¹' (h '' s) = s :=
+h.to_equiv.preimage_image s
+
+protected lemma uniform_inducing (h : α ≃ᵤ β) : uniform_inducing h :=
+uniform_inducing_of_compose h.uniform_continuous h.symm.uniform_continuous $
+  by simp only [symm_comp_self, uniform_inducing_id]
+
+lemma comap_eq (h : α ≃ᵤ β) : uniform_space.comap h ‹_› = ‹_› :=
+by ext : 1; exact h.uniform_inducing.comap_uniformity
+
+protected lemma uniform_embedding (h : α ≃ᵤ β) : uniform_embedding h :=
+⟨h.uniform_inducing, h.injective⟩
+
+/-- Uniform equiv given a uniform embedding. -/
+noncomputable def of_uniform_embedding (f : α → β) (hf : uniform_embedding f) :
+  α ≃ᵤ (set.range f) :=
+{ uniform_continuous_to_fun := hf.to_uniform_inducing.uniform_continuous.subtype_mk _,
+  uniform_continuous_inv_fun :=
+    by simp [hf.to_uniform_inducing.uniform_continuous_iff, uniform_continuous_subtype_coe],
+  to_equiv := equiv.of_injective f hf.inj }
+
+/-- If two sets are equal, then they are uniformly equivalent. -/
+def set_congr {s t : set α} (h : s = t) : s ≃ᵤ t :=
+{ uniform_continuous_to_fun := uniform_continuous_subtype_val.subtype_mk _,
+  uniform_continuous_inv_fun := uniform_continuous_subtype_val.subtype_mk _,
+  to_equiv := equiv.set_congr h }
+
+/-- Product of two uniform isomorphisms. -/
+def prod_congr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) : α × γ ≃ᵤ β × δ :=
+{ uniform_continuous_to_fun  := (h₁.uniform_continuous.comp uniform_continuous_fst).prod_mk
+    (h₂.uniform_continuous.comp uniform_continuous_snd),
+  uniform_continuous_inv_fun := (h₁.symm.uniform_continuous.comp uniform_continuous_fst).prod_mk
+    (h₂.symm.uniform_continuous.comp uniform_continuous_snd),
+  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }
+
+@[simp] lemma prod_congr_symm (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
+  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl
+
+@[simp] lemma coe_prod_congr (h₁ : α ≃ᵤ β) (h₂ : γ ≃ᵤ δ) :
+  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl
+
+section
+variables (α β γ)
+
+/-- `α × β` is uniformly isomorphic to `β × α`. -/
+def prod_comm : α × β ≃ᵤ β × α :=
+{ uniform_continuous_to_fun  := uniform_continuous_snd.prod_mk uniform_continuous_fst,
+  uniform_continuous_inv_fun := uniform_continuous_snd.prod_mk uniform_continuous_fst,
+  to_equiv := equiv.prod_comm α β }
+
+@[simp] lemma prod_comm_symm : (prod_comm α β).symm = prod_comm β α := rfl
+@[simp] lemma coe_prod_comm : ⇑(prod_comm α β) = prod.swap := rfl
+
+/-- `(α × β) × γ` is uniformly isomorphic to `α × (β × γ)`. -/
+def prod_assoc : (α × β) × γ ≃ᵤ α × (β × γ) :=
+{ uniform_continuous_to_fun  := (uniform_continuous_fst.comp uniform_continuous_fst).prod_mk
+    ((uniform_continuous_snd.comp uniform_continuous_fst).prod_mk uniform_continuous_snd),
+  uniform_continuous_inv_fun := (uniform_continuous_fst.prod_mk
+    (uniform_continuous_fst.comp uniform_continuous_snd)).prod_mk
+    (uniform_continuous_snd.comp uniform_continuous_snd),
+  to_equiv := equiv.prod_assoc α β γ }
+
+/-- `α × {*}` is uniformly isomorphic to `α`. -/
+@[simps apply {fully_applied := ff}]
+def prod_punit : α × punit ≃ᵤ α :=
+{ to_equiv := equiv.prod_punit α,
+  uniform_continuous_to_fun := uniform_continuous_fst,
+  uniform_continuous_inv_fun := uniform_continuous_id.prod_mk uniform_continuous_const }
+
+/-- `{*} × α` is uniformly isomorphic to `α`. -/
+def punit_prod : punit × α ≃ᵤ α :=
+(prod_comm _ _).trans (prod_punit _)
+
+@[simp] lemma coe_punit_prod : ⇑(punit_prod α) = prod.snd := rfl
+
+/-- Uniform equivalence between `ulift α` and `α`. -/
+def ulift : ulift.{v u} α ≃ᵤ α :=
+{ uniform_continuous_to_fun := uniform_continuous_comap,
+  uniform_continuous_inv_fun := begin
+    have hf : uniform_inducing (@equiv.ulift.{v u} α).to_fun, from ⟨rfl⟩,
+    simp_rw [hf.uniform_continuous_iff],
+    exact uniform_continuous_id,
+  end,
+  .. equiv.ulift }
+
+end
+
+/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
+@[simps { fully_applied := ff }]
+def fun_unique (ι α : Type*) [unique ι] [uniform_space α] : (ι → α) ≃ᵤ α :=
+{ to_equiv := equiv.fun_unique ι α,
+  uniform_continuous_to_fun := Pi.uniform_continuous_proj _ _,
+  uniform_continuous_inv_fun := uniform_continuous_pi.mpr (λ _, uniform_continuous_id) }
+
+/-- Uniform isomorphism between dependent functions `Π i : fin 2, α i` and `α 0 × α 1`. -/
+@[simps { fully_applied := ff }]
+def pi_fin_two (α : fin 2 → Type u) [Π i, uniform_space (α i)] : (Π i, α i) ≃ᵤ α 0 × α 1 :=
+{ to_equiv := pi_fin_two_equiv α,
+  uniform_continuous_to_fun :=
+    (Pi.uniform_continuous_proj _ 0).prod_mk (Pi.uniform_continuous_proj _ 1),
+  uniform_continuous_inv_fun := uniform_continuous_pi.mpr $
+    fin.forall_fin_two.2 ⟨uniform_continuous_fst, uniform_continuous_snd⟩ }
+
+/-- Uniform isomorphism between `α² = fin 2 → α` and `α × α`. -/
+@[simps { fully_applied := ff }] def fin_two_arrow : (fin 2 → α) ≃ᵤ α × α :=
+{ to_equiv := fin_two_arrow_equiv α, .. pi_fin_two (λ _, α) }
+
+/--
+A subset of a uniform space is uniformly isomorphic to its image under a uniform isomorphism.
+-/
+def image (e : α ≃ᵤ β) (s : set α) : s ≃ᵤ e '' s :=
+{ uniform_continuous_to_fun :=
+    (e.uniform_continuous.comp uniform_continuous_subtype_val).subtype_mk _,
+  uniform_continuous_inv_fun :=
+    (e.symm.uniform_continuous.comp uniform_continuous_subtype_val).subtype_mk _,
+  to_equiv := e.to_equiv.image s }
+
+end uniform_equiv
+
+/-- A uniform inducing equiv between uniform spaces is a uniform isomorphism. -/
+@[simps] def equiv.to_uniform_equiv_of_uniform_inducing [uniform_space α] [uniform_space β]
+  (f : α ≃ β) (hf : uniform_inducing f) :
+  α ≃ᵤ β :=
+{ uniform_continuous_to_fun := hf.uniform_continuous,
+  uniform_continuous_inv_fun := hf.uniform_continuous_iff.2 $ by simpa using uniform_continuous_id,
+  .. f }
diff --git a/src/topology/uniform_space/matrix.lean b/src/topology/uniform_space/matrix.lean
index a39badbdaf63a..476be2d9ca9d3 100644
--- a/src/topology/uniform_space/matrix.lean
+++ b/src/topology/uniform_space/matrix.lean
@@ -8,9 +8,12 @@ import data.matrix.basic
 
 /-!
 # Uniform space structure on matrices
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
-open_locale uniformity topological_space
+open_locale uniformity topology
 
 variables (m n 𝕜 : Type*) [uniform_space 𝕜]
 
diff --git a/src/topology/uniform_space/pi.lean b/src/topology/uniform_space/pi.lean
index 7b0bedb535794..7f7880e29dad1 100644
--- a/src/topology/uniform_space/pi.lean
+++ b/src/topology/uniform_space/pi.lean
@@ -8,11 +8,14 @@ import topology.uniform_space.separation
 
 /-!
 # Indexed product of uniform spaces
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
 -/
 
 noncomputable theory
 
-open_locale uniformity topological_space
+open_locale uniformity topology
 
 section
 open filter uniform_space
diff --git a/src/topology/uniform_space/separation.lean b/src/topology/uniform_space/separation.lean
index 3f217a1320fd8..32fda3d944457 100644
--- a/src/topology/uniform_space/separation.lean
+++ b/src/topology/uniform_space/separation.lean
@@ -5,18 +5,20 @@ Authors: Johannes Hölzl, Patrick Massot
 -/
 
 import tactic.apply_fun
-import data.set.pairwise
 import topology.uniform_space.basic
 import topology.separation
 
 /-!
 # Hausdorff properties of uniform spaces. Separation quotient.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This file studies uniform spaces whose underlying topological spaces are separated
 (also known as Hausdorff or T₂).
 This turns out to be equivalent to asking that the intersection of all entourages
 is the diagonal only. This condition actually implies the stronger separation property
-that the space is regular (T₃), hence those conditions are equivalent for topologies coming from
+that the space is T₃, hence those conditions are equivalent for topologies coming from
 a uniform structure.
 
 More generally, the intersection `𝓢 X` of all entourages of `X`, which has type `set (X × X)` is an
@@ -37,7 +39,6 @@ is equivalent to asking that the uniform structure induced on `s` is separated.
 
 * `separation_relation X : set (X × X)`: the separation relation
 * `separated_space X`: a predicate class asserting that `X` is separated
-* `is_separated s`: a predicate asserting that `s : set X` is separated
 * `separation_quotient X`: the maximal separated quotient of `X`.
 * `separation_quotient.lift f`: factors a map `f : X → Y` through the separation quotient of `X`.
 * `separation_quotient.map f`: turns a map `f : X → Y` into a map between the separation quotients
@@ -68,7 +69,7 @@ uniformly continuous).
 -/
 
 open filter topological_space set classical function uniform_space
-open_locale classical topological_space uniformity filter
+open_locale classical topology uniformity filter
 noncomputable theory
 set_option eqn_compiler.zeta true
 
@@ -81,13 +82,19 @@ variables [uniform_space α] [uniform_space β] [uniform_space γ]
 ### Separated uniform spaces
 -/
 
+@[priority 100]
+instance uniform_space.to_regular_space : regular_space α :=
+regular_space.of_basis
+  (λ a, by { rw [nhds_eq_comap_uniformity], exact uniformity_has_basis_closed.comap _ })
+  (λ a V hV, hV.2.preimage $ continuous_const.prod_mk continuous_id)
+
 /-- The separation relation is the intersection of all entourages.
   Two points which are related by the separation relation are "indistinguishable"
   according to the uniform structure. -/
 protected def separation_rel (α : Type u) [u : uniform_space α] :=
 ⋂₀ (𝓤 α).sets
 
-localized "notation `𝓢` := separation_rel" in uniformity
+localized "notation (name := separation_rel) `𝓢` := separation_rel" in uniformity
 
 lemma separated_equiv : equivalence (λx y, (x, y) ∈ 𝓢 α) :=
 ⟨assume x, assume s, refl_mem_uniformity,
@@ -101,6 +108,18 @@ lemma separated_equiv : equivalence (λx y, (x, y) ∈ 𝓢 α) :=
     h_ts $ show (x, z) ∈ comp_rel t t,
       from ⟨y, hxy t ht, hyz t ht⟩⟩
 
+lemma filter.has_basis.mem_separation_rel {ι : Sort*} {p : ι → Prop} {s : ι → set (α × α)}
+  (h : (𝓤 α).has_basis p s) {a : α × α} :
+  a ∈ 𝓢 α ↔ ∀ i, p i → a ∈ s i :=
+h.forall_mem_mem
+
+theorem separation_rel_iff_specializes {a b : α} : (a, b) ∈ 𝓢 α ↔ a ⤳ b :=
+by simp only [(𝓤 α).basis_sets.mem_separation_rel, id, mem_set_of_eq,
+  (nhds_basis_uniformity (𝓤 α).basis_sets).specializes_iff]
+
+theorem separation_rel_iff_inseparable {a b : α} : (a, b) ∈ 𝓢 α ↔ inseparable a b :=
+  separation_rel_iff_specializes.trans specializes_iff_inseparable
+
 /-- A uniform space is separated if its separation relation is trivial (each point
 is related only to itself). -/
 class separated_space (α : Type u) [uniform_space α] : Prop := (out : 𝓢 α = id_rel)
@@ -131,6 +150,11 @@ lemma eq_of_forall_symmetric {α : Type*} [uniform_space α] [separated_space α
   (h : ∀ {V}, V ∈ 𝓤 α → symmetric_rel V → (x, y) ∈ V) : x = y :=
 eq_of_uniformity_basis has_basis_symmetric (by simpa [and_imp] using λ _, h)
 
+lemma eq_of_cluster_pt_uniformity [separated_space α] {x y : α} (h : cluster_pt (x, y) (𝓤 α)) :
+  x = y :=
+eq_of_uniformity_basis uniformity_has_basis_closed $ λ V ⟨hV, hVc⟩,
+  is_closed_iff_cluster_pt.1 hVc _ $ h.mono $ le_principal_iff.2 hV
+
 lemma id_rel_sub_separation_relation (α : Type*) [uniform_space α] : id_rel ⊆ 𝓢 α :=
 begin
   unfold separation_rel,
@@ -144,8 +168,9 @@ lemma separation_rel_comap  {f : α → β}
   (h : ‹uniform_space α› = uniform_space.comap f ‹uniform_space β›) :
   𝓢 α = (prod.map f f) ⁻¹' 𝓢 β :=
 begin
+  unfreezingI { subst h },
   dsimp [separation_rel],
-  simp_rw [uniformity_comap h, (filter.comap_has_basis (prod.map f f) (𝓤 β)).sInter_sets,
+  simp_rw [uniformity_comap, (filter.comap_has_basis (prod.map f f) (𝓤 β)).sInter_sets,
       ← preimage_Inter, sInter_eq_bInter],
   refl,
 end
@@ -176,36 +201,15 @@ begin
     intros x y hxy,
     rcases t2_separation hxy with ⟨u, v, uo, vo, hx, hy, h⟩,
     rcases is_open_iff_ball_subset.1 uo x hx with ⟨r, hrU, hr⟩,
-    exact ⟨r, hrU, λ H, disjoint_iff.2 h ⟨hr H, hy⟩⟩ }
+    exact ⟨r, hrU, λ H, h.le_bot ⟨hr H, hy⟩⟩ }
 end
 
 @[priority 100] -- see Note [lower instance priority]
-instance separated_regular [separated_space α] : regular_space α :=
-{ t0 := by { haveI := separated_iff_t2.mp ‹_›, exact t1_space.t0_space.t0 },
-  regular := λs a hs ha,
-    have sᶜ ∈ 𝓝 a,
-      from is_open.mem_nhds hs.is_open_compl ha,
-    have {p : α × α | p.1 = a → p.2 ∈ sᶜ} ∈ 𝓤 α,
-      from mem_nhds_uniformity_iff_right.mp this,
-    let ⟨d, hd, h⟩ := comp_mem_uniformity_sets this in
-    let e := {y:α| (a, y) ∈ d} in
-    have hae : a ∈ closure e, from subset_closure $ refl_mem_uniformity hd,
-    have closure e ×ˢ closure e ⊆ comp_rel d (comp_rel (e ×ˢ e) d),
-    begin
-      rw [←closure_prod_eq, closure_eq_inter_uniformity],
-      change (⨅d' ∈ 𝓤 α, _) ≤ comp_rel d (comp_rel _ d),
-      exact (infi_le_of_le d $ infi_le_of_le hd $ le_rfl)
-    end,
-    have e_subset : closure e ⊆ sᶜ,
-      from assume a' ha',
-        let ⟨x, (hx : (a, x) ∈ d), y, ⟨hx₁, hx₂⟩, (hy : (y, _) ∈ d)⟩ := @this ⟨a, a'⟩ ⟨hae, ha'⟩ in
-        have (a, a') ∈ comp_rel d d, from ⟨y, hx₂, hy⟩,
-        h this rfl,
-    have closure e ∈ 𝓝 a, from (𝓝 a).sets_of_superset (mem_nhds_left a hd) subset_closure,
-    have 𝓝 a ⊓ 𝓟 (closure e)ᶜ = ⊥,
-      from (is_compl_principal (closure e)).inf_right_eq_bot_iff.2 (le_principal_iff.2 this),
-    ⟨(closure e)ᶜ, is_closed_closure.is_open_compl, assume x h₁ h₂, @e_subset x h₂ h₁, this⟩,
-    ..@t2_space.t1_space _ _ (separated_iff_t2.mp ‹_›) }
+instance separated_t3 [separated_space α] : t3_space α :=
+by { haveI := separated_iff_t2.mp ‹_›, exact ⟨⟩ }
+
+instance subtype.separated_space [separated_space α] (s : set α) : separated_space s :=
+separated_iff_t2.mpr subtype.t2_space
 
 lemma is_closed_of_spaced_out [separated_space α] {V₀ : set (α × α)} (V₀_in : V₀ ∈ 𝓤 α)
   {s : set α} (hs : s.pairwise (λ x y, (x, y) ∉ V₀)) : is_closed s :=
@@ -228,88 +232,8 @@ end
 lemma is_closed_range_of_spaced_out {ι} [separated_space α] {V₀ : set (α × α)} (V₀_in : V₀ ∈ 𝓤 α)
   {f : ι → α} (hf : pairwise (λ x y, (f x, f y) ∉ V₀)) : is_closed (range f) :=
 is_closed_of_spaced_out V₀_in $
-  by { rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ h, exact hf x y (ne_of_apply_ne f h) }
-
-/-!
-### Separated sets
--/
-
-/-- A set `s` in a uniform space `α` is separated if the separation relation `𝓢 α`
-induces the trivial relation on `s`. -/
-def is_separated (s : set α) : Prop := ∀ x y ∈ s, (x, y) ∈ 𝓢 α → x = y
-
-lemma is_separated_def (s : set α) : is_separated s ↔ ∀ x y ∈ s, (x, y) ∈ 𝓢 α → x = y :=
-iff.rfl
-
-lemma is_separated_def' (s : set α) : is_separated s ↔ (s ×ˢ s) ∩ 𝓢 α ⊆ id_rel :=
-begin
-  rw is_separated_def,
-  split,
-  { rintros h ⟨x, y⟩ ⟨⟨x_in, y_in⟩, H⟩,
-    simp [h x x_in y y_in H] },
-  { intros h x x_in y y_in xy_in,
-    rw ← mem_id_rel,
-    exact h ⟨mk_mem_prod x_in y_in, xy_in⟩ }
-end
-
-lemma is_separated.mono {s t : set α} (hs : is_separated s) (hts : t ⊆ s) : is_separated t :=
-λ x hx y hy, hs x (hts hx) y (hts hy)
+  by { rintro _ ⟨x, rfl⟩ _ ⟨y, rfl⟩ h, exact hf (ne_of_apply_ne f h) }
 
-lemma univ_separated_iff : is_separated (univ : set α) ↔ separated_space α :=
-begin
-  simp only [is_separated, mem_univ, true_implies_iff, separated_space_iff],
-  split,
-  { intro h,
-    exact subset.antisymm (λ ⟨x, y⟩ xy_in, h x y xy_in) (id_rel_sub_separation_relation α), },
-  { intros h x y xy_in,
-    rwa h at xy_in },
-end
-
-lemma is_separated_of_separated_space [separated_space α] (s : set α) : is_separated s :=
-begin
-  rw [is_separated, separated_space.out],
-  tauto,
-end
-
-lemma is_separated_iff_induced {s : set α} : is_separated s ↔ separated_space s :=
-begin
-  rw separated_space_iff,
-  change _ ↔ 𝓢 {x // x ∈ s} = _,
-  rw [separation_rel_comap rfl, is_separated_def'],
-  split; intro h,
-  { ext ⟨⟨x, x_in⟩, ⟨y, y_in⟩⟩,
-    suffices : (x, y) ∈ 𝓢 α ↔ x = y, by simpa only [mem_id_rel],
-    refine ⟨λ H, h ⟨mk_mem_prod x_in y_in, H⟩, _⟩,
-    rintro rfl,
-    exact id_rel_sub_separation_relation α rfl },
-  { rintros ⟨x, y⟩ ⟨⟨x_in, y_in⟩, hS⟩,
-    have A : (⟨⟨x, x_in⟩, ⟨y, y_in⟩⟩ : ↥s × ↥s) ∈ prod.map (coe : s → α) (coe : s → α) ⁻¹' 𝓢 α,
-      from hS,
-    simpa using h.subset A }
-end
-
-lemma eq_of_uniformity_inf_nhds_of_is_separated {s : set α} (hs : is_separated s) :
-  ∀ {x y : α}, x ∈ s → y ∈ s → cluster_pt (x, y) (𝓤 α) → x = y :=
-begin
-  intros x y x_in y_in H,
-  have : ∀ V ∈ 𝓤 α, (x, y) ∈ closure V,
-  { intros V V_in,
-    rw mem_closure_iff_cluster_pt,
-    have : 𝓤 α ≤ 𝓟 V, by rwa le_principal_iff,
-    exact H.mono this },
-  apply hs x x_in y y_in,
-  simpa [separation_rel_eq_inter_closure],
-end
-
-lemma eq_of_uniformity_inf_nhds [separated_space α] :
-  ∀ {x y : α}, cluster_pt (x, y) (𝓤 α) → x = y :=
-begin
-  have : is_separated (univ : set α),
-  { rw univ_separated_iff,
-    assumption },
-  introv,
-  simpa using eq_of_uniformity_inf_nhds_of_is_separated this,
-end
 
 /-!
 ### Separation quotient
@@ -331,7 +255,7 @@ instance separation_setoid.uniform_space {α : Type u} [u : uniform_space α] :
     by simp [prod.swap, (∘)]; exact tendsto_map.comp tendsto_swap_uniformity,
   comp := calc (map (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) u.uniformity).lift' (λs, comp_rel s s) =
           u.uniformity.lift' ((λs, comp_rel s s) ∘ image (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧))) :
-      map_lift'_eq2 $ monotone_comp_rel monotone_id monotone_id
+      map_lift'_eq2 $ monotone_id.comp_rel monotone_id
     ... ≤ u.uniformity.lift' (image (λ (p : α × α), (⟦p.fst⟧, ⟦p.snd⟧)) ∘
             (λs:set (α×α), comp_rel s (comp_rel s s))) :
       lift'_mono' $ assume s hs ⟨a, b⟩ ⟨c, ⟨⟨a₁, a₂⟩, ha, a_eq⟩, ⟨⟨b₁, b₂⟩, hb, b_eq⟩⟩,
@@ -346,7 +270,7 @@ instance separation_setoid.uniform_space {α : Type u} [u : uniform_space α] :
     ... = map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧))
             (u.uniformity.lift' (λs:set (α×α), comp_rel s (comp_rel s s))) :
       by rw [map_lift'_eq];
-        exact monotone_comp_rel monotone_id (monotone_comp_rel monotone_id monotone_id)
+        exact monotone_id.comp_rel (monotone_id.comp_rel monotone_id)
     ... ≤ map (λp:(α×α), (⟦p.1⟧, ⟦p.2⟧)) u.uniformity :
       map_mono comp_le_uniformity3,
   is_open_uniformity := assume s,
@@ -363,7 +287,8 @@ instance separation_setoid.uniform_space {α : Type u} [u : uniform_space α] :
         u.uniformity.sets_of_superset ht $ assume ⟨a₁, a₂⟩ h₁ h₂, hts (ht' $ setoid.symm h₂) h₁,
         assume h, u.uniformity.sets_of_superset h $ by simp {contextual := tt}⟩,
     begin
-      simp [topological_space.coinduced, u.is_open_uniformity, uniformity, forall_quotient_iff],
+      simp only [is_open_coinduced, is_open_uniformity, uniformity, forall_quotient_iff,
+        mem_preimage, mem_map, preimage_set_of_eq, quotient.eq],
       exact ⟨λh a ha, (this a ha).mp $ h a ha, λh a ha, (this a ha).mpr $ h a ha⟩
     end }
 
@@ -435,11 +360,6 @@ lemma eq_of_separated_of_uniform_continuous [separated_space β] {f : α → β}
   (H : uniform_continuous f) (h : x ≈ y) : f x = f y :=
 separated_def.1 (by apply_instance) _ _ $ separated_of_uniform_continuous H h
 
-lemma _root_.is_separated.eq_of_uniform_continuous {f : α → β} {x y : α} {s : set β}
-  (hs : is_separated s) (hxs : f x ∈ s) (hys : f y ∈ s) (H : uniform_continuous f) (h : x ≈ y) :
-  f x = f y :=
-(is_separated_def _).mp hs _ hxs _ hys $ λ _ h', h _ (H h')
-
 /-- The maximal separated quotient of a uniform space `α`. -/
 def separation_quotient (α : Type*) [uniform_space α] := quotient (separation_setoid α)
 
@@ -449,6 +369,9 @@ instance : separated_space (separation_quotient α) := uniform_space.separated_s
 instance [inhabited α] : inhabited (separation_quotient α) :=
 quotient.inhabited (separation_setoid α)
 
+lemma mk_eq_mk {x y : α} : (⟦x⟧ : separation_quotient α) = ⟦y⟧ ↔ inseparable x y :=
+quotient.eq'.trans separation_rel_iff_inseparable
+
 /-- Factoring functions to a separated space through the separation quotient. -/
 def lift [separated_space β] (f : α → β) : (separation_quotient α → β) :=
 if h : uniform_continuous f then
@@ -514,10 +437,4 @@ separated_def.2 $ assume x y H, prod.ext
   (eq_of_separated_of_uniform_continuous uniform_continuous_fst H)
   (eq_of_separated_of_uniform_continuous uniform_continuous_snd H)
 
-lemma _root_.is_separated.prod {s : set α} {t : set β} (hs : is_separated s) (ht : is_separated t) :
-  is_separated (s ×ˢ t) :=
-(is_separated_def _).mpr $ λ x hx y hy H, prod.ext
-  (hs.eq_of_uniform_continuous hx.1 hy.1 uniform_continuous_fst H)
-  (ht.eq_of_uniform_continuous hx.2 hy.2 uniform_continuous_snd H)
-
 end uniform_space
diff --git a/src/topology/uniform_space/uniform_convergence.lean b/src/topology/uniform_space/uniform_convergence.lean
index 2ebb87eab295c..04ea04de1256c 100644
--- a/src/topology/uniform_space/uniform_convergence.lean
+++ b/src/topology/uniform_space/uniform_convergence.lean
@@ -3,11 +3,16 @@ Copyright (c) 2020 Sébastien Gouëzel. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Sébastien Gouëzel
 -/
+import topology.separation
 import topology.uniform_space.basic
+import topology.uniform_space.cauchy
 
 /-!
 # Uniform convergence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 A sequence of functions `Fₙ` (with values in a metric space) converges uniformly on a set `s` to a
 function `f` if, for all `ε > 0`, for all large enough `n`, one has for all `y ∈ s` the inequality
 `dist (f y, Fₙ y) < ε`. Under uniform convergence, many properties of the `Fₙ` pass to the limit,
@@ -36,8 +41,18 @@ We also define notions where the convergence is locally uniform, called
 `tendsto_locally_uniformly_on F f p s` and `tendsto_locally_uniformly F f p`. The previous theorems
 all have corresponding versions under locally uniform convergence.
 
+Finally, we introduce the notion of a uniform Cauchy sequence, which is to uniform
+convergence what a Cauchy sequence is to the usual notion of convergence.
+
 ## Implementation notes
 
+We derive most of our initial results from an auxiliary definition `tendsto_uniformly_on_filter`.
+This definition in and of itself can sometimes be useful, e.g., when studying the local behavior
+of the `Fₙ` near a point, which would typically look like `tendsto_uniformly_on_filter F f p (𝓝 x)`.
+Still, while this may be the "correct" definition (see
+`tendsto_uniformly_on_iff_tendsto_uniformly_on_filter`), it is somewhat unwieldy to work with in
+practice. Thus, we provide the more traditional definition in `tendsto_uniformly_on`.
+
 Most results hold under weaker assumptions of locally uniform approximation. In a first section,
 we prove the results under these weaker assumptions. Then, we derive the results on uniform
 convergence from them.
@@ -48,13 +63,14 @@ Uniform limit, uniform convergence, tends uniformly to
  -/
 
 noncomputable theory
-open_locale topological_space classical uniformity filter
+open_locale topology classical uniformity filter
 
 open set filter
 
 universes u v w
 variables {α β γ ι : Type*} [uniform_space β]
-variables {F : ι → α → β} {f : α → β} {s s' : set α} {x : α} {p : filter ι} {g : ι → α}
+variables {F : ι → α → β} {f : α → β} {s s' : set α} {x : α} {p : filter ι} {p' : filter α}
+  {g : ι → α}
 
 /-!
 ### Different notions of uniform convergence
@@ -62,11 +78,39 @@ variables {F : ι → α → β} {f : α → β} {s s' : set α} {x : α} {p : f
 We define uniform convergence and locally uniform convergence, on a set or in the whole space.
 -/
 
+/-- A sequence of functions `Fₙ` converges uniformly on a filter `p'` to a limiting function `f`
+with respect to the filter `p` if, for any entourage of the diagonal `u`, one has
+`p ×ᶠ p'`-eventually `(f x, Fₙ x) ∈ u`. -/
+def tendsto_uniformly_on_filter (F : ι → α → β) (f : α → β) (p : filter ι) (p' : filter α) :=
+∀ u ∈ 𝓤 β, ∀ᶠ (n : ι × α) in (p ×ᶠ p'), (f n.snd, F n.fst n.snd) ∈ u
+
+/--
+A sequence of functions `Fₙ` converges uniformly on a filter `p'` to a limiting function `f` w.r.t.
+filter `p` iff the function `(n, x) ↦ (f x, Fₙ x)` converges along `p ×ᶠ p'` to the uniformity.
+In other words: one knows nothing about the behavior of `x` in this limit besides it being in `p'`.
+-/
+lemma tendsto_uniformly_on_filter_iff_tendsto :
+  tendsto_uniformly_on_filter F f p p' ↔
+  tendsto (λ q : ι × α, (f q.2, F q.1 q.2)) (p ×ᶠ p') (𝓤 β) :=
+forall₂_congr $ λ u u_in, by simp [mem_map, filter.eventually, mem_prod_iff, preimage]
+
 /-- A sequence of functions `Fₙ` converges uniformly on a set `s` to a limiting function `f` with
 respect to the filter `p` if, for any entourage of the diagonal `u`, one has `p`-eventually
 `(f x, Fₙ x) ∈ u` for all `x ∈ s`. -/
 def tendsto_uniformly_on (F : ι → α → β) (f : α → β) (p : filter ι) (s : set α) :=
-∀ u ∈ 𝓤 β, ∀ᶠ n in p, ∀ x ∈ s, (f x, F n x) ∈ u
+∀ u ∈ 𝓤 β, ∀ᶠ n in p, ∀ (x : α), x ∈ s → (f x, F n x) ∈ u
+
+lemma tendsto_uniformly_on_iff_tendsto_uniformly_on_filter :
+  tendsto_uniformly_on F f p s ↔ tendsto_uniformly_on_filter F f p (𝓟 s) :=
+begin
+  simp only [tendsto_uniformly_on, tendsto_uniformly_on_filter],
+  apply forall₂_congr,
+  simp_rw [eventually_prod_principal_iff],
+  simp,
+end
+
+alias tendsto_uniformly_on_iff_tendsto_uniformly_on_filter ↔
+  tendsto_uniformly_on.tendsto_uniformly_on_filter tendsto_uniformly_on_filter.tendsto_uniformly_on
 
 /--
 A sequence of functions `Fₙ` converges uniformly on a set `s` to a limiting function `f` w.r.t.
@@ -75,17 +119,35 @@ In other words: one knows nothing about the behavior of `x` in this limit beside
 -/
 lemma tendsto_uniformly_on_iff_tendsto {F : ι → α → β} {f : α → β} {p : filter ι} {s : set α} :
   tendsto_uniformly_on F f p s ↔ tendsto (λ q : ι × α, (f q.2, F q.1 q.2)) (p ×ᶠ 𝓟 s) (𝓤 β) :=
-forall₂_congr $ λ u u_in, by simp [mem_map, filter.eventually, mem_prod_principal]
+by simp [tendsto_uniformly_on_iff_tendsto_uniformly_on_filter,
+  tendsto_uniformly_on_filter_iff_tendsto]
 
 /-- A sequence of functions `Fₙ` converges uniformly to a limiting function `f` with respect to a
 filter `p` if, for any entourage of the diagonal `u`, one has `p`-eventually
 `(f x, Fₙ x) ∈ u` for all `x`. -/
 def tendsto_uniformly (F : ι → α → β) (f : α → β) (p : filter ι) :=
-∀ u ∈ 𝓤 β, ∀ᶠ n in p, ∀ x, (f x, F n x) ∈ u
+∀ u ∈ 𝓤 β, ∀ᶠ n in p, ∀ (x : α), (f x, F n x) ∈ u
+
+lemma tendsto_uniformly_iff_tendsto_uniformly_on_filter :
+  tendsto_uniformly F f p ↔ tendsto_uniformly_on_filter F f p ⊤ :=
+begin
+  simp only [tendsto_uniformly, tendsto_uniformly_on_filter],
+  apply forall₂_congr,
+  simp_rw [← principal_univ, eventually_prod_principal_iff],
+  simp,
+end
+
+lemma tendsto_uniformly.tendsto_uniformly_on_filter
+  (h : tendsto_uniformly F f p) : tendsto_uniformly_on_filter F f p ⊤ :=
+by rwa ← tendsto_uniformly_iff_tendsto_uniformly_on_filter
 
 lemma tendsto_uniformly_on_iff_tendsto_uniformly_comp_coe :
   tendsto_uniformly_on F f p s ↔ tendsto_uniformly (λ i (x : s), F i x) (f ∘ coe) p :=
-forall₂_congr $ λ V hV, by simp
+begin
+  apply forall₂_congr,
+  intros u hu,
+  simp,
+end
 
 /--
 A sequence of functions `Fₙ` converges uniformly to a limiting function `f` w.r.t.
@@ -94,57 +156,152 @@ In other words: one knows nothing about the behavior of `x` in this limit.
 -/
 lemma tendsto_uniformly_iff_tendsto {F : ι → α → β} {f : α → β} {p : filter ι} :
   tendsto_uniformly F f p ↔ tendsto (λ q : ι × α, (f q.2, F q.1 q.2)) (p ×ᶠ ⊤) (𝓤 β) :=
-forall₂_congr $ λ u u_in, by simp [mem_map, filter.eventually, mem_prod_top]
+by simp [tendsto_uniformly_iff_tendsto_uniformly_on_filter, tendsto_uniformly_on_filter_iff_tendsto]
+
+/-- Uniform converence implies pointwise convergence. -/
+lemma tendsto_uniformly_on_filter.tendsto_at (h : tendsto_uniformly_on_filter F f p p')
+  (hx : 𝓟 {x} ≤ p') : tendsto (λ n, F n x) p $ 𝓝 (f x) :=
+begin
+  refine uniform.tendsto_nhds_right.mpr (λ u hu, mem_map.mpr _),
+  filter_upwards [(h u hu).curry],
+  intros i h,
+  simpa using (h.filter_mono hx),
+end
+
+/-- Uniform converence implies pointwise convergence. -/
+lemma tendsto_uniformly_on.tendsto_at (h : tendsto_uniformly_on F f p s) {x : α} (hx : x ∈ s) :
+  tendsto (λ n, F n x) p $ 𝓝 (f x) :=
+h.tendsto_uniformly_on_filter.tendsto_at
+  (le_principal_iff.mpr $ mem_principal.mpr $ singleton_subset_iff.mpr $ hx)
 
 /-- Uniform converence implies pointwise convergence. -/
 lemma tendsto_uniformly.tendsto_at (h : tendsto_uniformly F f p) (x : α) :
   tendsto (λ n, F n x) p $ 𝓝 (f x) :=
-uniform.tendsto_nhds_right.mpr $ λ u hu, mem_map.mpr $ by { filter_upwards [h u hu], tauto, }
+h.tendsto_uniformly_on_filter.tendsto_at le_top
 
 lemma tendsto_uniformly_on_univ :
   tendsto_uniformly_on F f p univ ↔ tendsto_uniformly F f p :=
 by simp [tendsto_uniformly_on, tendsto_uniformly]
 
+lemma tendsto_uniformly_on_filter.mono_left {p'' : filter ι}
+  (h : tendsto_uniformly_on_filter F f p p') (hp : p'' ≤ p) :
+  tendsto_uniformly_on_filter F f p'' p' :=
+λ u hu, (h u hu).filter_mono (p'.prod_mono_left hp)
+
+lemma tendsto_uniformly_on_filter.mono_right {p'' : filter α}
+  (h : tendsto_uniformly_on_filter F f p p') (hp : p'' ≤ p') :
+  tendsto_uniformly_on_filter F f p p'' :=
+λ u hu, (h u hu).filter_mono (p.prod_mono_right hp)
+
 lemma tendsto_uniformly_on.mono {s' : set α}
   (h : tendsto_uniformly_on F f p s) (h' : s' ⊆ s) : tendsto_uniformly_on F f p s' :=
-λ u hu, (h u hu).mono (λ n hn x hx, hn x (h' hx))
+tendsto_uniformly_on_iff_tendsto_uniformly_on_filter.mpr
+  (h.tendsto_uniformly_on_filter.mono_right (le_principal_iff.mpr $ mem_principal.mpr h'))
+
+lemma tendsto_uniformly_on_filter.congr {F' : ι → α → β}
+  (hf : tendsto_uniformly_on_filter F f p p')
+  (hff' : ∀ᶠ (n : ι × α) in (p ×ᶠ p'), F n.fst n.snd = F' n.fst n.snd) :
+  tendsto_uniformly_on_filter F' f p p' :=
+begin
+  refine (λ u hu, ((hf u hu).and hff').mono (λ n h, _)),
+  rw ← h.right,
+  exact h.left,
+end
+
+lemma tendsto_uniformly_on.congr {F' : ι → α → β}
+  (hf : tendsto_uniformly_on F f p s) (hff' : ∀ᶠ n in p, set.eq_on (F n) (F' n) s) :
+  tendsto_uniformly_on F' f p s :=
+begin
+  rw tendsto_uniformly_on_iff_tendsto_uniformly_on_filter at hf ⊢,
+  refine hf.congr _,
+  rw eventually_iff at hff' ⊢,
+  simp only [set.eq_on] at hff',
+  simp only [mem_prod_principal, hff', mem_set_of_eq],
+end
+
+lemma tendsto_uniformly_on.congr_right {g : α → β}
+  (hf : tendsto_uniformly_on F f p s) (hfg : eq_on f g s) :
+  tendsto_uniformly_on F g p s :=
+λ u hu, by filter_upwards [hf u hu] with i hi a ha using hfg ha ▸ hi a ha
 
 protected lemma tendsto_uniformly.tendsto_uniformly_on
   (h : tendsto_uniformly F f p) : tendsto_uniformly_on F f p s :=
 (tendsto_uniformly_on_univ.2 h).mono (subset_univ s)
 
+/-- Composing on the right by a function preserves uniform convergence on a filter -/
+lemma tendsto_uniformly_on_filter.comp (h : tendsto_uniformly_on_filter F f p p') (g : γ → α) :
+  tendsto_uniformly_on_filter (λ n, F n ∘ g) (f ∘ g) p (p'.comap g) :=
+begin
+  intros u hu,
+  obtain ⟨pa, hpa, pb, hpb, hpapb⟩ := eventually_prod_iff.mp (h u hu),
+  rw eventually_prod_iff,
+  simp_rw eventually_comap,
+  exact ⟨pa, hpa, pb ∘ g, ⟨hpb.mono (λ x hx y hy, by simp only [hx, hy, function.comp_app]),
+    λ x hx y hy, hpapb hx hy⟩⟩,
+end
+
 /-- Composing on the right by a function preserves uniform convergence on a set -/
 lemma tendsto_uniformly_on.comp (h : tendsto_uniformly_on F f p s) (g : γ → α) :
   tendsto_uniformly_on (λ n, F n ∘ g) (f ∘ g) p (g ⁻¹' s) :=
-λ u hu, (h u hu).mono (λ i hi, λ a, hi (g a))
+begin
+  rw tendsto_uniformly_on_iff_tendsto_uniformly_on_filter at h ⊢,
+  simpa [tendsto_uniformly_on, comap_principal] using (tendsto_uniformly_on_filter.comp h g),
+end
 
 /-- Composing on the right by a function preserves uniform convergence -/
 lemma tendsto_uniformly.comp (h : tendsto_uniformly F f p) (g : γ → α) :
   tendsto_uniformly (λ n, F n ∘ g) (f ∘ g) p :=
-λ u hu, (h u hu).mono (λ i hi, λ a, hi (g a))
+begin
+  rw tendsto_uniformly_iff_tendsto_uniformly_on_filter at h ⊢,
+  simpa [principal_univ, comap_principal] using (h.comp g),
+end
+
+/-- Composing on the left by a uniformly continuous function preserves
+  uniform convergence on a filter -/
+lemma uniform_continuous.comp_tendsto_uniformly_on_filter [uniform_space γ] {g : β → γ}
+  (hg : uniform_continuous g) (h : tendsto_uniformly_on_filter F f p p') :
+  tendsto_uniformly_on_filter (λ i, g ∘ (F i)) (g ∘ f) p p' :=
+λ u hu, h _ (hg hu)
 
 /-- Composing on the left by a uniformly continuous function preserves
   uniform convergence on a set -/
-lemma tendsto_uniformly_on.comp' [uniform_space γ] {g : β → γ} (h : tendsto_uniformly_on F f p s)
-  (hg : uniform_continuous g) : tendsto_uniformly_on (λ i, g ∘ (F i)) (g ∘ f) p s :=
+lemma uniform_continuous.comp_tendsto_uniformly_on [uniform_space γ] {g : β → γ}
+  (hg : uniform_continuous g) (h : tendsto_uniformly_on F f p s) :
+  tendsto_uniformly_on (λ i, g ∘ (F i)) (g ∘ f) p s :=
 λ u hu, h _ (hg hu)
 
 /-- Composing on the left by a uniformly continuous function preserves uniform convergence -/
-lemma tendsto_uniformly.comp' [uniform_space γ] {g : β → γ} (h : tendsto_uniformly F f p)
-  (hg : uniform_continuous g) : tendsto_uniformly (λ i, g ∘ (F i)) (g ∘ f) p :=
+lemma uniform_continuous.comp_tendsto_uniformly [uniform_space γ] {g : β → γ}
+  (hg : uniform_continuous g) (h : tendsto_uniformly F f p) :
+  tendsto_uniformly (λ i, g ∘ (F i)) (g ∘ f) p :=
 λ u hu, h _ (hg hu)
 
+lemma tendsto_uniformly_on_filter.prod_map {ι' α' β' : Type*} [uniform_space β']
+  {F' : ι' → α' → β'} {f' : α' → β'} {q : filter ι'} {q' : filter α'}
+  (h : tendsto_uniformly_on_filter F f p p') (h' : tendsto_uniformly_on_filter F' f' q q') :
+  tendsto_uniformly_on_filter (λ (i : ι × ι'), prod.map (F i.1) (F' i.2))
+    (prod.map f f') (p.prod q) (p'.prod q') :=
+begin
+  intros u hu,
+  rw [uniformity_prod_eq_prod, mem_map, mem_prod_iff] at hu,
+  obtain ⟨v, hv, w, hw, hvw⟩ := hu,
+  apply (tendsto_swap4_prod.eventually ((h v hv).prod_mk (h' w hw))).mono,
+  simp only [prod_map, and_imp, prod.forall],
+  intros n n' x hxv hxw,
+  have hout : ((f x.fst, F n x.fst), (f' x.snd, F' n' x.snd)) ∈
+    {x : (β × β) × β' × β' | ((x.fst.fst, x.snd.fst), x.fst.snd, x.snd.snd) ∈ u},
+  { exact mem_of_mem_of_subset (set.mem_prod.mpr ⟨hxv, hxw⟩) hvw, },
+  exact hout,
+end
+
 lemma tendsto_uniformly_on.prod_map {ι' α' β' : Type*} [uniform_space β']
   {F' : ι' → α' → β'} {f' : α' → β'} {p' : filter ι'} {s' : set α'}
   (h : tendsto_uniformly_on F f p s) (h' : tendsto_uniformly_on F' f' p' s') :
   tendsto_uniformly_on (λ (i : ι × ι'), prod.map (F i.1) (F' i.2))
     (prod.map f f') (p.prod p') (s ×ˢ s') :=
 begin
-  intros u hu,
-  rw [uniformity_prod_eq_prod, mem_map, mem_prod_iff] at hu,
-  obtain ⟨v, hv, w, hw, hvw⟩ := hu,
-  exact mem_prod_iff.mpr ⟨_, h v hv, _, h' w hw,
-    λ i hi a ha, hvw (show (_, _) ∈ v ×ˢ w, from ⟨hi.1 a.1 ha.1, hi.2 a.2 ha.2⟩)⟩,
+  rw tendsto_uniformly_on_iff_tendsto_uniformly_on_filter at h h' ⊢,
+  simpa only [prod_principal_principal] using (h.prod_map h'),
 end
 
 lemma tendsto_uniformly.prod_map {ι' α' β' : Type*} [uniform_space β'] {F' : ι' → α' → β'}
@@ -155,6 +312,13 @@ begin
   exact h.prod_map h',
 end
 
+lemma tendsto_uniformly_on_filter.prod {ι' β' : Type*} [uniform_space β']
+  {F' : ι' → α → β'} {f' : α → β'} {q : filter ι'}
+  (h : tendsto_uniformly_on_filter F f p p') (h' : tendsto_uniformly_on_filter F' f' q p') :
+  tendsto_uniformly_on_filter (λ (i : ι × ι') a, (F i.1 a, F' i.2 a))
+    (λ a, (f a, f' a)) (p.prod q) p' :=
+λ u hu, ((h.prod_map h') u hu).diag_of_prod_right
+
 lemma tendsto_uniformly_on.prod {ι' β' : Type*} [uniform_space β'] {F' : ι' → α → β'} {f' : α → β'}
   {p' : filter ι'} (h : tendsto_uniformly_on F f p s) (h' : tendsto_uniformly_on F' f' p' s) :
   tendsto_uniformly_on (λ (i : ι × ι') a, (F i.1 a, F' i.2 a)) (λ a, (f a, f' a)) (p.prod p') s :=
@@ -165,16 +329,63 @@ lemma tendsto_uniformly.prod {ι' β' : Type*} [uniform_space β'] {F' : ι' →
   tendsto_uniformly (λ (i : ι × ι') a, (F i.1 a, F' i.2 a)) (λ a, (f a, f' a)) (p.prod p') :=
 (h.prod_map h').comp (λ a, (a, a))
 
+/-- Uniform convergence on a filter `p'` to a constant function is equivalent to convergence in
+`p ×ᶠ p'`. -/
+lemma tendsto_prod_filter_iff {c : β} :
+  tendsto ↿F (p ×ᶠ p') (𝓝 c) ↔ tendsto_uniformly_on_filter F (λ _, c) p p' :=
+begin
+  simp_rw [tendsto, nhds_eq_comap_uniformity, map_le_iff_le_comap.symm, map_map, le_def, mem_map],
+  exact forall₂_congr (λ u hu, by simpa [eventually_iff]),
+end
+
+/-- Uniform convergence on a set `s` to a constant function is equivalent to convergence in
+`p ×ᶠ 𝓟 s`. -/
+lemma tendsto_prod_principal_iff {c : β} :
+  tendsto ↿F (p ×ᶠ 𝓟 s) (𝓝 c) ↔ tendsto_uniformly_on F (λ _, c) p s :=
+begin
+  rw tendsto_uniformly_on_iff_tendsto_uniformly_on_filter,
+  exact tendsto_prod_filter_iff,
+end
+
 /-- Uniform convergence to a constant function is equivalent to convergence in `p ×ᶠ ⊤`. -/
 lemma tendsto_prod_top_iff {c : β} : tendsto ↿F (p ×ᶠ ⊤) (𝓝 c) ↔ tendsto_uniformly F (λ _, c) p :=
-let j : β → β × β := prod.mk c in
-calc tendsto ↿F (p ×ᶠ ⊤) (𝓝 c)
-    ↔ map ↿F (p ×ᶠ ⊤) ≤ (𝓝 c) : iff.rfl
-... ↔ map ↿F (p ×ᶠ ⊤) ≤ comap j (𝓤 β) : by rw nhds_eq_comap_uniformity
-... ↔ map j (map ↿F (p ×ᶠ ⊤)) ≤ 𝓤 β : map_le_iff_le_comap.symm
-... ↔ map (j ∘ ↿F) (p ×ᶠ ⊤) ≤ 𝓤 β : by rw map_map
-... ↔ ∀ V ∈ 𝓤 β, {x | (c, ↿F x) ∈ V} ∈ p ×ᶠ (⊤ : filter α) : iff.rfl
-... ↔ ∀ V ∈ 𝓤 β, {i | ∀ a, (c, F i a) ∈ V} ∈ p : by simpa [mem_prod_top]
+begin
+  rw tendsto_uniformly_iff_tendsto_uniformly_on_filter,
+  exact tendsto_prod_filter_iff,
+end
+
+/-- Uniform convergence on the empty set is vacuously true -/
+lemma tendsto_uniformly_on_empty :
+  tendsto_uniformly_on F f p ∅ :=
+λ u hu, by simp
+
+/-- Uniform convergence on a singleton is equivalent to regular convergence -/
+lemma tendsto_uniformly_on_singleton_iff_tendsto :
+  tendsto_uniformly_on F f p {x} ↔ tendsto (λ n : ι, F n x) p (𝓝 (f x)) :=
+begin
+  simp_rw [tendsto_uniformly_on_iff_tendsto, uniform.tendsto_nhds_right, tendsto_def],
+  exact forall₂_congr (λ u hu, by simp [mem_prod_principal, preimage]),
+end
+
+/-- If a sequence `g` converges to some `b`, then the sequence of constant functions
+`λ n, λ a, g n` converges to the constant function `λ a, b` on any set `s` -/
+lemma filter.tendsto.tendsto_uniformly_on_filter_const
+  {g : ι → β} {b : β} (hg : tendsto g p (𝓝 b)) (p' : filter α) :
+  tendsto_uniformly_on_filter (λ n : ι, λ a : α, g n) (λ a : α, b) p p' :=
+begin
+  rw tendsto_uniformly_on_filter_iff_tendsto,
+  rw uniform.tendsto_nhds_right at hg,
+  exact (hg.comp (tendsto_fst.comp ((@tendsto_id ι p).prod_map (@tendsto_id α p')))).congr
+    (λ x, by simp),
+end
+
+/-- If a sequence `g` converges to some `b`, then the sequence of constant functions
+`λ n, λ a, g n` converges to the constant function `λ a, b` on any set `s` -/
+lemma filter.tendsto.tendsto_uniformly_on_const
+  {g : ι → β} {b : β} (hg : tendsto g p (𝓝 b)) (s : set α) :
+  tendsto_uniformly_on (λ n : ι, λ a : α, g n) (λ a : α, b) p s :=
+tendsto_uniformly_on_iff_tendsto_uniformly_on_filter.mpr
+  (hg.tendsto_uniformly_on_filter_const (𝓟 s))
 
 lemma uniform_continuous_on.tendsto_uniformly [uniform_space α] [uniform_space γ]
   {x : α} {U : set α} (hU : U ∈ 𝓝 x)
@@ -200,6 +411,188 @@ lemma uniform_continuous₂.tendsto_uniformly [uniform_space α] [uniform_space
 uniform_continuous_on.tendsto_uniformly univ_mem $
   by rwa [univ_prod_univ, uniform_continuous_on_univ]
 
+/-- A sequence is uniformly Cauchy if eventually all of its pairwise differences are
+uniformly bounded -/
+def uniform_cauchy_seq_on_filter
+  (F : ι → α → β) (p : filter ι) (p' : filter α) : Prop :=
+  ∀ u : set (β × β), u ∈ 𝓤 β → ∀ᶠ (m : (ι × ι) × α) in ((p ×ᶠ p) ×ᶠ p'),
+    (F m.fst.fst m.snd, F m.fst.snd m.snd) ∈ u
+
+/-- A sequence is uniformly Cauchy if eventually all of its pairwise differences are
+uniformly bounded -/
+def uniform_cauchy_seq_on
+  (F : ι → α → β) (p : filter ι) (s : set α) : Prop :=
+  ∀ u : set (β × β), u ∈ 𝓤 β → ∀ᶠ (m : ι × ι) in (p ×ᶠ p), ∀ (x : α), x ∈ s →
+    (F m.fst x, F m.snd x) ∈ u
+
+lemma uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter :
+  uniform_cauchy_seq_on F p s ↔ uniform_cauchy_seq_on_filter F p (𝓟 s) :=
+begin
+  simp only [uniform_cauchy_seq_on, uniform_cauchy_seq_on_filter],
+  refine forall₂_congr (λ u hu, _),
+  rw eventually_prod_principal_iff,
+end
+
+lemma uniform_cauchy_seq_on.uniform_cauchy_seq_on_filter (hF : uniform_cauchy_seq_on F p s) :
+  uniform_cauchy_seq_on_filter F p (𝓟 s) :=
+by rwa ←uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter
+
+/-- A sequence that converges uniformly is also uniformly Cauchy -/
+lemma tendsto_uniformly_on_filter.uniform_cauchy_seq_on_filter
+  (hF : tendsto_uniformly_on_filter F f p p') :
+  uniform_cauchy_seq_on_filter F p p' :=
+begin
+  intros u hu,
+  rcases comp_symm_of_uniformity hu with ⟨t, ht, htsymm, htmem⟩,
+  have := tendsto_swap4_prod.eventually ((hF t ht).prod_mk (hF t ht)),
+  apply this.diag_of_prod_right.mono,
+  simp only [and_imp, prod.forall],
+  intros n1 n2 x hl hr,
+  exact set.mem_of_mem_of_subset (prod_mk_mem_comp_rel (htsymm hl) hr) htmem,
+end
+
+/-- A sequence that converges uniformly is also uniformly Cauchy -/
+lemma tendsto_uniformly_on.uniform_cauchy_seq_on (hF : tendsto_uniformly_on F f p s) :
+  uniform_cauchy_seq_on F p s :=
+uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter.mpr
+  hF.tendsto_uniformly_on_filter.uniform_cauchy_seq_on_filter
+
+/-- A uniformly Cauchy sequence converges uniformly to its limit -/
+lemma uniform_cauchy_seq_on_filter.tendsto_uniformly_on_filter_of_tendsto [ne_bot p]
+  (hF : uniform_cauchy_seq_on_filter F p p')
+  (hF' : ∀ᶠ (x : α) in p', tendsto (λ n, F n x) p (𝓝 (f x))) :
+  tendsto_uniformly_on_filter F f p p' :=
+begin
+  -- Proof idea: |f_n(x) - f(x)| ≤ |f_n(x) - f_m(x)| + |f_m(x) - f(x)|. We choose `n`
+  -- so that |f_n(x) - f_m(x)| is uniformly small across `s` whenever `m ≥ n`. Then for
+  -- a fixed `x`, we choose `m` sufficiently large such that |f_m(x) - f(x)| is small.
+  intros u hu,
+  rcases comp_symm_of_uniformity hu with ⟨t, ht, htsymm, htmem⟩,
+
+  -- We will choose n, x, and m simultaneously. n and x come from hF. m comes from hF'
+  -- But we need to promote hF' to the full product filter to use it
+  have hmc : ∀ᶠ (x : (ι × ι) × α) in p ×ᶠ p ×ᶠ p', tendsto (λ (n : ι), F n x.snd) p (𝓝 (f x.snd)),
+  { rw eventually_prod_iff,
+    refine ⟨(λ x, true), by simp, _, hF', by simp⟩, },
+
+  -- To apply filter operations we'll need to do some order manipulation
+  rw filter.eventually_swap_iff,
+  have := tendsto_prod_assoc.eventually (tendsto_prod_swap.eventually ((hF t ht).and hmc)),
+  apply this.curry.mono,
+  simp only [equiv.prod_assoc_apply, eventually_and, eventually_const, prod.snd_swap,
+    prod.fst_swap, and_imp, prod.forall],
+
+  -- Complete the proof
+  intros x n hx hm',
+  refine set.mem_of_mem_of_subset (mem_comp_rel.mpr _) htmem,
+  rw uniform.tendsto_nhds_right at hm',
+  have := hx.and (hm' ht),
+  obtain ⟨m, hm⟩ := this.exists,
+  exact ⟨F m x, ⟨hm.2, htsymm hm.1⟩⟩,
+end
+
+/-- A uniformly Cauchy sequence converges uniformly to its limit -/
+lemma uniform_cauchy_seq_on.tendsto_uniformly_on_of_tendsto [ne_bot p]
+  (hF : uniform_cauchy_seq_on F p s) (hF' : ∀ x : α, x ∈ s → tendsto (λ n, F n x) p (𝓝 (f x))) :
+  tendsto_uniformly_on F f p s :=
+tendsto_uniformly_on_iff_tendsto_uniformly_on_filter.mpr
+  (hF.uniform_cauchy_seq_on_filter.tendsto_uniformly_on_filter_of_tendsto hF')
+
+lemma uniform_cauchy_seq_on_filter.mono_left {p'' : filter ι}
+  (hf : uniform_cauchy_seq_on_filter F p p') (hp : p'' ≤ p) :
+  uniform_cauchy_seq_on_filter F p'' p' :=
+begin
+  intros u hu,
+  have := (hf u hu).filter_mono (p'.prod_mono_left (filter.prod_mono hp hp)),
+  exact this.mono (by simp),
+end
+
+lemma uniform_cauchy_seq_on_filter.mono_right {p'' : filter α}
+  (hf : uniform_cauchy_seq_on_filter F p p') (hp : p'' ≤ p') :
+  uniform_cauchy_seq_on_filter F p p'' :=
+begin
+  intros u hu,
+  have := (hf u hu).filter_mono ((p ×ᶠ p).prod_mono_right hp),
+  exact this.mono (by simp),
+end
+
+lemma uniform_cauchy_seq_on.mono {s' : set α} (hf : uniform_cauchy_seq_on F p s) (hss' : s' ⊆ s) :
+  uniform_cauchy_seq_on F p s' :=
+begin
+  rw uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter at hf ⊢,
+  exact hf.mono_right (le_principal_iff.mpr $mem_principal.mpr hss'),
+end
+
+/-- Composing on the right by a function preserves uniform Cauchy sequences -/
+lemma uniform_cauchy_seq_on_filter.comp {γ : Type*} (hf : uniform_cauchy_seq_on_filter F p p')
+  (g : γ → α) :
+  uniform_cauchy_seq_on_filter (λ n, F n ∘ g) p (p'.comap g) :=
+begin
+  intros u hu,
+  obtain ⟨pa, hpa, pb, hpb, hpapb⟩ := eventually_prod_iff.mp (hf u hu),
+  rw eventually_prod_iff,
+  refine ⟨pa, hpa, pb ∘ g, _, λ x hx y hy, hpapb hx hy⟩,
+  exact eventually_comap.mpr (hpb.mono (λ x hx y hy, by simp only [hx, hy, function.comp_app])),
+end
+
+/-- Composing on the right by a function preserves uniform Cauchy sequences -/
+lemma uniform_cauchy_seq_on.comp {γ : Type*} (hf : uniform_cauchy_seq_on F p s) (g : γ → α) :
+  uniform_cauchy_seq_on (λ n, F n ∘ g) p (g ⁻¹' s) :=
+begin
+  rw uniform_cauchy_seq_on_iff_uniform_cauchy_seq_on_filter at hf ⊢,
+  simpa only [uniform_cauchy_seq_on, comap_principal] using (hf.comp g),
+end
+
+/-- Composing on the left by a uniformly continuous function preserves
+uniform Cauchy sequences -/
+lemma uniform_continuous.comp_uniform_cauchy_seq_on [uniform_space γ] {g : β → γ}
+  (hg : uniform_continuous g) (hf : uniform_cauchy_seq_on F p s) :
+  uniform_cauchy_seq_on (λ n, g ∘ (F n)) p s :=
+λ u hu, hf _ (hg hu)
+
+lemma uniform_cauchy_seq_on.prod_map {ι' α' β' : Type*} [uniform_space β']
+  {F' : ι' → α' → β'} {p' : filter ι'} {s' : set α'}
+  (h : uniform_cauchy_seq_on F p s) (h' : uniform_cauchy_seq_on F' p' s') :
+  uniform_cauchy_seq_on (λ (i : ι × ι'), prod.map (F i.1) (F' i.2))
+    (p.prod p') (s ×ˢ s') :=
+begin
+  intros u hu,
+  rw [uniformity_prod_eq_prod, mem_map, mem_prod_iff] at hu,
+  obtain ⟨v, hv, w, hw, hvw⟩ := hu,
+  simp_rw [mem_prod, prod_map, and_imp, prod.forall],
+  rw [← set.image_subset_iff] at hvw,
+  apply (tendsto_swap4_prod.eventually ((h v hv).prod_mk (h' w hw))).mono,
+  intros x hx a b ha hb,
+  refine hvw ⟨_, mk_mem_prod (hx.1 a ha) (hx.2 b hb), rfl⟩,
+end
+
+lemma uniform_cauchy_seq_on.prod {ι' β' : Type*} [uniform_space β'] {F' : ι' → α → β'}
+  {p' : filter ι'}
+  (h : uniform_cauchy_seq_on F p s) (h' : uniform_cauchy_seq_on F' p' s) :
+  uniform_cauchy_seq_on (λ (i : ι × ι') a, (F i.fst a, F' i.snd a)) (p ×ᶠ p') s :=
+(congr_arg _ s.inter_self).mp ((h.prod_map h').comp (λ a, (a, a)))
+
+lemma uniform_cauchy_seq_on.prod' {β' : Type*} [uniform_space β'] {F' : ι → α → β'}
+  (h : uniform_cauchy_seq_on F p s) (h' : uniform_cauchy_seq_on F' p s) :
+  uniform_cauchy_seq_on (λ (i : ι) a, (F i a, F' i a)) p s :=
+begin
+  intros u hu,
+  have hh : tendsto (λ x : ι, (x, x)) p (p ×ᶠ p), { exact tendsto_diag, },
+  exact (hh.prod_map hh).eventually ((h.prod h') u hu),
+end
+
+/-- If a sequence of functions is uniformly Cauchy on a set, then the values at each point form
+a Cauchy sequence. -/
+lemma uniform_cauchy_seq_on.cauchy_map [hp : ne_bot p]
+  (hf : uniform_cauchy_seq_on F p s) (hx : x ∈ s) :
+  cauchy (map (λ i, F i x) p) :=
+begin
+  simp only [cauchy_map_iff, hp, true_and],
+  assume u hu,
+  rw mem_map,
+  filter_upwards [hf u hu] with p hp using hp x hx,
+end
+
 section seq_tendsto
 
 lemma tendsto_uniformly_on_of_seq_tendsto_uniformly_on {l : filter ι} [l.is_countably_generated]
@@ -297,11 +690,11 @@ end
 
 protected lemma tendsto_uniformly_on.tendsto_locally_uniformly_on
   (h : tendsto_uniformly_on F f p s) : tendsto_locally_uniformly_on F f p s :=
-λ u hu x hx, ⟨s, self_mem_nhds_within, h u hu⟩
+λ u hu x hx,⟨s, self_mem_nhds_within, by simpa using (h u hu)⟩
 
 protected lemma tendsto_uniformly.tendsto_locally_uniformly
   (h : tendsto_uniformly F f p) : tendsto_locally_uniformly F f p :=
-λ u hu x, ⟨univ, univ_mem, by simpa using h u hu⟩
+λ u hu x, ⟨univ, univ_mem, by simpa using (h u hu)⟩
 
 lemma tendsto_locally_uniformly_on.mono (h : tendsto_locally_uniformly_on F f p s) (h' : s' ⊆ s) :
   tendsto_locally_uniformly_on F f p s' :=
@@ -311,6 +704,32 @@ begin
   exact ⟨t, nhds_within_mono x h' ht, H.mono (λ n, id)⟩
 end
 
+lemma tendsto_locally_uniformly_on_Union {S : γ → set α} (hS : ∀ i, is_open (S i))
+  (h : ∀ i, tendsto_locally_uniformly_on F f p (S i)) :
+  tendsto_locally_uniformly_on F f p (⋃ i, S i) :=
+begin
+  rintro v hv x ⟨_, ⟨i, rfl⟩, hi : x ∈ S i⟩,
+  obtain ⟨t, ht, ht'⟩ := h i v hv x hi,
+  refine ⟨t, _, ht'⟩,
+  rw (hS _).nhds_within_eq hi at ht,
+  exact mem_nhds_within_of_mem_nhds ht,
+end
+
+lemma tendsto_locally_uniformly_on_bUnion {s : set γ} {S : γ → set α}
+  (hS : ∀ i ∈ s, is_open (S i)) (h : ∀ i ∈ s, tendsto_locally_uniformly_on F f p (S i)) :
+  tendsto_locally_uniformly_on F f p (⋃ i ∈ s, S i) :=
+by { rw bUnion_eq_Union, exact tendsto_locally_uniformly_on_Union (λ i, hS _ i.2) (λ i, h _ i.2) }
+
+lemma tendsto_locally_uniformly_on_sUnion (S : set (set α)) (hS : ∀ s ∈ S, is_open s)
+  (h : ∀ s ∈ S, tendsto_locally_uniformly_on F f p s) :
+  tendsto_locally_uniformly_on F f p (⋃₀ S) :=
+by { rw sUnion_eq_bUnion, exact tendsto_locally_uniformly_on_bUnion hS h }
+
+lemma tendsto_locally_uniformly_on.union {s₁ s₂ : set α} (hs₁ : is_open s₁) (hs₂ : is_open s₂)
+  (h₁ : tendsto_locally_uniformly_on F f p s₁) (h₂ : tendsto_locally_uniformly_on F f p s₂) :
+  tendsto_locally_uniformly_on F f p (s₁ ∪ s₂) :=
+by { rw ←sUnion_pair, refine tendsto_locally_uniformly_on_sUnion _ _ _; simp [*] }
+
 lemma tendsto_locally_uniformly_on_univ :
   tendsto_locally_uniformly_on F f p univ ↔ tendsto_locally_uniformly F f p :=
 by simp [tendsto_locally_uniformly_on, tendsto_locally_uniformly, nhds_within_univ]
@@ -325,7 +744,7 @@ lemma tendsto_locally_uniformly_iff_tendsto_uniformly_of_compact_space [compact_
 begin
   refine ⟨λ h V hV, _, tendsto_uniformly.tendsto_locally_uniformly⟩,
   choose U hU using h V hV,
-  obtain ⟨t, ht⟩ := compact_univ.elim_nhds_subcover' (λ k hk, U k) (λ k hk, (hU k).1),
+  obtain ⟨t, ht⟩ := is_compact_univ.elim_nhds_subcover' (λ k hk, U k) (λ k hk, (hU k).1),
   replace hU := λ (x : t), (hU x).2,
   rw ← eventually_all at hU,
   refine hU.mono (λ i hi x, _),
@@ -367,6 +786,85 @@ begin
   exact h.comp _ (maps_to_univ _ _) cg
 end
 
+lemma tendsto_locally_uniformly_on_tfae [locally_compact_space α]
+  (G : ι → α → β) (g : α → β) (p : filter ι) (hs : is_open s) :
+  tfae [(tendsto_locally_uniformly_on G g p s),
+    (∀ K ⊆ s, is_compact K → tendsto_uniformly_on G g p K),
+    (∀ x ∈ s, ∃ v ∈ 𝓝[s] x, tendsto_uniformly_on G g p v)] :=
+begin
+  tfae_have : 1 → 2,
+  { rintro h K hK1 hK2,
+    exact (tendsto_locally_uniformly_on_iff_tendsto_uniformly_on_of_compact hK2).mp (h.mono hK1) },
+  tfae_have : 2 → 3,
+  { rintro h x hx,
+    obtain ⟨K, ⟨hK1, hK2⟩, hK3⟩ := (compact_basis_nhds x).mem_iff.mp (hs.mem_nhds hx),
+    refine ⟨K, nhds_within_le_nhds hK1, h K hK3 hK2⟩ },
+  tfae_have : 3 → 1,
+  { rintro h u hu x hx,
+    obtain ⟨v, hv1, hv2⟩ := h x hx,
+    exact ⟨v, hv1, hv2 u hu⟩ },
+  tfae_finish
+end
+
+lemma tendsto_locally_uniformly_on_iff_forall_is_compact [locally_compact_space α]
+  (hs : is_open s) :
+  tendsto_locally_uniformly_on F f p s ↔
+  ∀ K ⊆ s, is_compact K → tendsto_uniformly_on F f p K :=
+(tendsto_locally_uniformly_on_tfae F f p hs).out 0 1
+
+lemma tendsto_locally_uniformly_on_iff_filter :
+  tendsto_locally_uniformly_on F f p s ↔
+  ∀ x ∈ s, tendsto_uniformly_on_filter F f p (𝓝[s] x) :=
+begin
+  simp only [tendsto_uniformly_on_filter, eventually_prod_iff],
+  split,
+  { rintro h x hx u hu,
+    obtain ⟨s, hs1, hs2⟩ := h u hu x hx,
+    exact ⟨_, hs2, _, eventually_of_mem hs1 (λ x, id), λ i hi y hy, hi y hy⟩ },
+  { rintro h u hu x hx,
+    obtain ⟨pa, hpa, pb, hpb, h⟩ := h x hx u hu,
+    refine ⟨pb, hpb, eventually_of_mem hpa (λ i hi y hy, h hi hy)⟩ }
+end
+
+lemma tendsto_locally_uniformly_iff_filter :
+  tendsto_locally_uniformly F f p ↔
+  ∀ x, tendsto_uniformly_on_filter F f p (𝓝 x) :=
+by simpa [← tendsto_locally_uniformly_on_univ, ← nhds_within_univ] using
+    @tendsto_locally_uniformly_on_iff_filter _ _ _ _ F f univ p _
+
+lemma tendsto_locally_uniformly_on.tendsto_at (hf : tendsto_locally_uniformly_on F f p s)
+  {a : α} (ha : a ∈ s) :
+  tendsto (λ i, F i a) p (𝓝 (f a)) :=
+begin
+  refine ((tendsto_locally_uniformly_on_iff_filter.mp hf) a ha).tendsto_at _,
+  simpa only [filter.principal_singleton] using pure_le_nhds_within ha
+end
+
+lemma tendsto_locally_uniformly_on.unique [p.ne_bot] [t2_space β] {g : α → β}
+  (hf : tendsto_locally_uniformly_on F f p s) (hg : tendsto_locally_uniformly_on F g p s) :
+  s.eq_on f g :=
+λ a ha, tendsto_nhds_unique (hf.tendsto_at ha) (hg.tendsto_at ha)
+
+lemma tendsto_locally_uniformly_on.congr {G : ι → α → β}
+  (hf : tendsto_locally_uniformly_on F f p s) (hg : ∀ n, s.eq_on (F n) (G n)) :
+  tendsto_locally_uniformly_on G f p s :=
+begin
+  rintro u hu x hx,
+  obtain ⟨t, ht, h⟩ := hf u hu x hx,
+  refine ⟨s ∩ t, inter_mem self_mem_nhds_within ht, _⟩,
+  filter_upwards [h] with i hi y hy using hg i hy.1 ▸ hi y hy.2
+end
+
+lemma tendsto_locally_uniformly_on.congr_right {g : α → β}
+  (hf : tendsto_locally_uniformly_on F f p s) (hg : s.eq_on f g) :
+  tendsto_locally_uniformly_on F g p s :=
+begin
+  rintro u hu x hx,
+  obtain ⟨t, ht, h⟩ := hf u hu x hx,
+  refine ⟨s ∩ t, inter_mem self_mem_nhds_within ht, _⟩,
+  filter_upwards [h] with i hi y hy using hg hy.1 ▸ hi y hy.2
+end
+
 /-!
 ### Uniform approximation
 
@@ -522,7 +1020,8 @@ tends to `f x` if `f` is continuous at `x` within `s`. -/
 lemma tendsto_uniformly_on.tendsto_comp (h : tendsto_uniformly_on F f p s)
   (hf : continuous_within_at f s x) (hg : tendsto g p (𝓝[s] x)) :
   tendsto (λ n, F n (g n)) p (𝓝 (f x)) :=
-tendsto_comp_of_locally_uniform_limit_within hf hg (λ u hu, ⟨s, self_mem_nhds_within, h u hu⟩)
+tendsto_comp_of_locally_uniform_limit_within hf hg (λ u hu,
+  ⟨s, self_mem_nhds_within, h u hu⟩)
 
 /-- If `Fₙ` tends locally uniformly to `f`, and `gₙ` tends to `x`, then `Fₙ gₙ` tends to `f x`. -/
 lemma tendsto_locally_uniformly.tendsto_comp (h : tendsto_locally_uniformly F f p)
diff --git a/src/topology/uniform_space/uniform_convergence_topology.lean b/src/topology/uniform_space/uniform_convergence_topology.lean
index cdcad276b1c94..b7309d6fb990e 100644
--- a/src/topology/uniform_space/uniform_convergence_topology.lean
+++ b/src/topology/uniform_space/uniform_convergence_topology.lean
@@ -5,255 +5,901 @@ Authors: Anatole Dedecker
 -/
 import topology.uniform_space.uniform_convergence
 import topology.uniform_space.pi
+import topology.uniform_space.equiv
 
 /-!
 # Topology and uniform structure of uniform convergence
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 This files endows `α → β` with the topologies / uniform structures of
-- uniform convergence on `α` (in the `uniform_convergence` namespace)
-- uniform convergence on a specified family `𝔖` of sets of `α`
-  (in the `uniform_convergence_on` namespace), also called `𝔖`-convergence
+- uniform convergence on `α`
+- uniform convergence on a specified family `𝔖` of sets of `α`, also called `𝔖`-convergence
+
+Since `α → β` is already endowed with the topologies and uniform structures of pointwise
+convergence, we introduce type aliases `uniform_fun α β` (denoted `α →ᵤ β`) and
+`uniform_on_fun α β 𝔖` (denoted `α →ᵤ[𝔖] β`) and we actually endow *these* with the structures
+of uniform and `𝔖`-convergence respectively.
 
 Usual examples of the second construction include :
 - the topology of compact convergence, when `𝔖` is the set of compacts of `α`
-- the strong topology on the dual of a TVS `E`, when `𝔖` is the set of Von Neuman bounded subsets
-  of `E`
+- the strong topology on the dual of a topological vector space (TVS) `E`, when `𝔖` is the set of
+  Von Neuman bounded subsets of `E`
 - the weak-* topology on the dual of a TVS `E`, when `𝔖` is the set of singletons of `E`.
 
+This file contains a lot of technical facts, so it is heavily commented, proofs included!
+
 ## Main definitions
 
-* `uniform_convergence.gen` : basis sets for the uniformity of uniform convergence
-* `uniform_convergence.uniform_space` : uniform structure of uniform convergence
-* `uniform_convergence_on.uniform_space` : uniform structure of 𝔖-convergence
+* `uniform_fun.gen`: basis sets for the uniformity of uniform convergence. These are sets
+  of the form `S(V) := {(f, g) | ∀ x : α, (f x, g x) ∈ V}` for some `V : set (β × β)`
+* `uniform_fun.uniform_space`: uniform structure of uniform convergence. This is the
+  `uniform_space` on `α →ᵤ β` whose uniformity is generated by the sets `S(V)` for `V ∈ 𝓤 β`.
+  We will denote this uniform space as `𝒰(α, β, uβ)`, both in the comments and as a local notation
+  in the Lean code, where `uβ` is the uniform space structure on `β`.
+  This is declared as an instance on `α →ᵤ β`.
+* `uniform_on_fun.uniform_space`: uniform structure of `𝔖`-convergence, where
+  `𝔖 : set (set α)`. This is the infimum, for `S ∈ 𝔖`, of the pullback of `𝒰 S β` by the map of
+  restriction to `S`. We will denote it `𝒱(α, β, 𝔖, uβ)`, where `uβ` is the uniform space structure
+  on `β`.
+  This is declared as an instance on `α →ᵤ[𝔖] β`.
 
 ## Main statements
 
-* `uniform_convergence.uniform_continuous_eval` : evaluation is uniformly continuous
-* `uniform_convergence.t2_space` : the topology of uniform convergence on `α → β` is T2 if
-  `β` is T2.
-* `uniform_convergence.tendsto_iff_tendsto_uniformly` : `uniform_convergence.uniform_space` is
-  indeed the uniform structure of uniform convergence
-
-* `uniform_convergence_on.uniform_continuous_eval_of_mem` : evaluation at a point contained in a
-  set of `𝔖` is uniformly continuous
-* `uniform_convergence.t2_space` : the topology of `𝔖`-convergence on `α → β` is T2 if
-  `β` is T2 and `𝔖` covers `α`
-* `uniform_convergence_on.tendsto_iff_tendsto_uniformly_on` :
-  `uniform_convergence_on.uniform_space` is indeed the uniform structure of `𝔖`-convergence
-
-## Implementation details
+### Basic properties
 
-We do not declare these structures as instances, since they would conflict with `Pi.uniform_space`.
+* `uniform_fun.uniform_continuous_eval`: evaluation is uniformly continuous on `α →ᵤ β`.
+* `uniform_fun.t2_space`: the topology of uniform convergence on `α →ᵤ β` is T₂ if
+  `β` is T₂.
+* `uniform_fun.tendsto_iff_tendsto_uniformly`: `𝒰(α, β, uβ)` is
+  indeed the uniform structure of uniform convergence
+* `uniform_on_fun.uniform_continuous_eval_of_mem`: evaluation at a point contained in a
+  set of `𝔖` is uniformly continuous on `α →ᵤ[𝔖] β`
+* `uniform_on_fun.t2_space_of_covering`: the topology of `𝔖`-convergence on `α →ᵤ[𝔖] β` is T₂ if
+  `β` is T₂ and `𝔖` covers `α`
+* `uniform_on_fun.tendsto_iff_tendsto_uniformly_on`:
+  `𝒱(α, β, 𝔖 uβ)` is indeed the uniform structure of `𝔖`-convergence
+
+### Functoriality and compatibility with product of uniform spaces
+
+In order to avoid the need for filter bases as much as possible when using these definitions,
+we develop an extensive API for manipulating these structures abstractly. As usual in the topology
+section of mathlib, we first state results about the complete lattices of `uniform_space`s on
+fixed types, and then we use these to deduce categorical-like results about maps between two
+uniform spaces.
+
+We only describe these in the harder case of `𝔖`-convergence, as the names of the corresponding
+results for uniform convergence can easily be guessed.
+
+#### Order statements
+
+* `uniform_on_fun.mono`: let `u₁`, `u₂` be two uniform structures on `γ` and
+  `𝔖₁ 𝔖₂ : set (set α)`. If `u₁ ≤ u₂` and `𝔖₂ ⊆ 𝔖₁` then `𝒱(α, γ, 𝔖₁, u₁) ≤ 𝒱(α, γ, 𝔖₂, u₂)`.
+* `uniform_on_fun.infi_eq`: if `u` is a family of uniform structures on `γ`, then
+  `𝒱(α, γ, 𝔖, (⨅ i, u i)) = ⨅ i, 𝒱(α, γ, 𝔖, u i)`.
+* `uniform_on_fun.comap_eq`: if `u` is a uniform structures on `β` and `f : γ → β`, then
+  `𝒱(α, γ, 𝔖, comap f u) = comap (λ g, f ∘ g) 𝒱(α, γ, 𝔖, u₁)`.
+
+An interesting note about these statements is that they are proved without ever unfolding the basis
+definition of the uniform structure of uniform convergence! Instead, we build a
+(not very interesting) Galois connection `uniform_convergence.gc` and then rely on the Galois
+connection API to do most of the work.
+
+#### Morphism statements (unbundled)
+
+* `uniform_on_fun.postcomp_uniform_continuous`: if `f : γ → β` is uniformly
+  continuous, then `(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is uniformly continuous.
+* `uniform_on_fun.postcomp_uniform_inducing`: if `f : γ → β` is a uniform
+  inducing, then `(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is a uniform inducing.
+* `uniform_on_fun.precomp_uniform_continuous`: let `f : γ → α`, `𝔖 : set (set α)`,
+  `𝔗 : set (set γ)`, and assume that `∀ T ∈ 𝔗, f '' T ∈ 𝔖`. Then, the function
+  `(λ g, g ∘ f) : (α →ᵤ[𝔖] β) → (γ →ᵤ[𝔗] β)` is uniformly continuous.
+
+#### Isomorphism statements (bundled)
+
+* `uniform_on_fun.congr_right`: turn a uniform isomorphism `γ ≃ᵤ β` into a uniform isomorphism
+  `(α →ᵤ[𝔖] γ) ≃ᵤ (α →ᵤ[𝔖] β)` by post-composing.
+* `uniform_on_fun.congr_left`: turn a bijection `e : γ ≃ α` such that we have both
+  `∀ T ∈ 𝔗, e '' T ∈ 𝔖` and `∀ S ∈ 𝔖, e ⁻¹' S ∈ 𝔗` into a uniform isomorphism
+  `(γ →ᵤ[𝔗] β) ≃ᵤ (α →ᵤ[𝔖] β)` by pre-composing.
+* `uniform_on_fun.uniform_equiv_Pi_comm`: the natural bijection between `α → Π i, δ i`
+  and `Π i, α → δ i`, upgraded to a uniform isomorphism between `α →ᵤ[𝔖] (Π i, δ i)` and
+  `Π i, α →ᵤ[𝔖] δ i`.
+
+#### Important use cases
+
+* If `G` is a uniform group, then `α →ᵤ[𝔖] G` is a uniform group: since `(/) : G × G → G` is
+  uniformly continuous, `uniform_convergence_on.postcomp_uniform_continuous` tells us that
+  `((/) ∘ —) : (α →ᵤ[𝔖] G × G) → (α →ᵤ[𝔖] G)` is uniformly continuous. By precomposing with
+  `uniform_convergence_on.uniform_equiv_prod_arrow`, this gives that
+  `(/) : (α →ᵤ[𝔖] G) × (α →ᵤ[𝔖] G) → (α →ᵤ[𝔖] G)` is also uniformly continuous
+* The transpose of a continuous linear map is continuous for the strong topologies: since
+  continuous linear maps are uniformly continuous and map bounded sets to bounded sets,
+  this is just a special case of `uniform_convergence_on.precomp_uniform_continuous`.
 
 ## TODO
 
 * Show that the uniform structure of `𝔖`-convergence is exactly the structure of `𝔖'`-convergence,
-  where `𝔖'` is the bornology generated by `𝔖`.
-* Add a type synonym for `α → β` endowed with the structures of uniform convergence
+  where `𝔖'` is the ***noncovering*** bornology (i.e ***not*** what `bornology` currently refers
+  to in mathlib) generated by `𝔖`.
 
 ## References
 
-* [N. Bourbaki, *General Topology*][bourbaki1966]
+* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]
 
 ## Tags
 
 uniform convergence
 -/
 
-
 noncomputable theory
-open_locale topological_space classical uniformity filter
-
-local attribute [-instance] Pi.uniform_space
+open_locale topology classical uniformity filter
 
 open set filter
 
-namespace uniform_convergence
+section type_alias
 
-variables (α β : Type*) {γ ι : Type*}
-variables {F : ι → α → β} {f : α → β} {s s' : set α} {x : α} {p : filter ι} {g : ι → α}
+/-- The type of functions from `α` to `β` equipped with the uniform structure and topology of
+uniform convergence. We denote it `α →ᵤ β`. -/
+def uniform_fun (α β : Type*) := α → β
 
-/-- Basis sets for the uniformity of uniform convergence -/
-protected def gen (V : set (β × β)) : set ((α → β) × (α → β)) :=
-  {uv : (α → β) × (α → β) | ∀ x, (uv.1 x, uv.2 x) ∈ V}
+/-- The type of functions from `α` to `β` equipped with the uniform structure and topology of
+uniform convergence on some family `𝔖` of subsets of `α`. We denote it `α →ᵤ[𝔖] β`. -/
+@[nolint unused_arguments]
+def uniform_on_fun (α β : Type*) (𝔖 : set (set α)) := α → β
 
-variables [uniform_space β]
+localized "notation α ` →ᵤ `:25 β:0 := uniform_fun α β" in uniform_convergence
+localized "notation α ` →ᵤ[`:25 𝔖 `] `:0 β:0 := uniform_on_fun α β 𝔖" in uniform_convergence
+localized "notation `λᵘ` binders `, ` r:(scoped p, uniform_fun.of_fun p) := r"
+  in uniform_convergence
+localized "notation `λᵘ[` 𝔖 `] ` binders `, ` r:(scoped p, uniform_fun.of_fun p) := r"
+  in uniform_convergence
+
+instance {α β} [nonempty β] : nonempty (α →ᵤ β) := pi.nonempty
+instance {α β 𝔖} [nonempty β] : nonempty (α →ᵤ[𝔖] β) := pi.nonempty
 
-protected lemma is_basis_gen :
-  is_basis (λ V : set (β × β), V ∈ 𝓤 β) (uniform_convergence.gen α β) :=
+/-- Reinterpret `f : α → β` as an element of `α →ᵤ β`. -/
+def uniform_fun.of_fun {α β} : (α → β) ≃ (α →ᵤ β) := ⟨λ x, x, λ x, x, λ x, rfl, λ x, rfl⟩
+
+/-- Reinterpret `f : α → β` as an element of `α →ᵤ[𝔖] β`. -/
+def uniform_on_fun.of_fun {α β} (𝔖) : (α → β) ≃ (α →ᵤ[𝔖] β) := ⟨λ x, x, λ x, x, λ x, rfl, λ x, rfl⟩
+
+/-- Reinterpret `f : α →ᵤ β` as an element of `α → β`. -/
+def uniform_fun.to_fun {α β} : (α →ᵤ β) ≃ (α → β) := uniform_fun.of_fun.symm
+
+/-- Reinterpret `f : α →ᵤ[𝔖] β` as an element of `α → β`. -/
+def uniform_on_fun.to_fun {α β} (𝔖) : (α →ᵤ[𝔖] β) ≃ (α → β) := (uniform_on_fun.of_fun 𝔖).symm
+
+-- Note: we don't declare a `has_coe_to_fun` instance because Lean wouldn't insert it when writing
+-- `f x` (because of definitional equality with `α → β`).
+
+end type_alias
+
+open_locale uniform_convergence
+
+namespace uniform_fun
+
+variables (α β : Type*) {γ ι : Type*}
+variables {s s' : set α} {x : α} {p : filter ι} {g : ι → α}
+
+/-- Basis sets for the uniformity of uniform convergence: `gen α β V` is the set of pairs `(f, g)`
+of functions `α →ᵤ β` such that `∀ x, (f x, g x) ∈ V`. -/
+protected def gen (V : set (β × β)) : set ((α →ᵤ β) × (α →ᵤ β)) :=
+  {uv : (α →ᵤ β) × (α →ᵤ β) | ∀ x, (uv.1 x, uv.2 x) ∈ V}
+
+/-- If `𝓕` is a filter on `β × β`, then the set of all `uniform_convergence.gen α β V` for
+`V ∈ 𝓕` is a filter basis on `(α →ᵤ β) × (α →ᵤ β)`. This will only be applied to `𝓕 = 𝓤 β` when
+`β` is equipped with a `uniform_space` structure, but it is useful to define it for any filter in
+order to be able to state that it has a lower adjoint (see `uniform_convergence.gc`). -/
+protected lemma is_basis_gen (𝓑 : filter $ β × β) :
+  is_basis (λ V : set (β × β), V ∈ 𝓑) (uniform_fun.gen α β) :=
 ⟨⟨univ, univ_mem⟩, λ U V hU hV, ⟨U ∩ V, inter_mem hU hV, λ uv huv,
   ⟨λ x, (huv x).left, λ x, (huv x).right⟩⟩⟩
 
-/-- Filter basis for the uniformity of uniform convergence -/
-protected def uniformity_basis : filter_basis ((α → β) × (α → β)) :=
-(uniform_convergence.is_basis_gen α β).filter_basis
+/-- For `𝓕 : filter (β × β)`, this is the set of all `uniform_convergence.gen α β V` for
+`V ∈ 𝓕` as a bundled `filter_basis` over `(α →ᵤ β) × (α →ᵤ β)`. This will only be applied to
+`𝓕 = 𝓤 β` when `β` is equipped with a `uniform_space` structure, but it is useful to define it for
+any filter in order to be able to state that it has a lower adjoint
+(see `uniform_convergence.gc`). -/
+protected def basis (𝓕 : filter $ β × β) : filter_basis ((α →ᵤ β) × (α →ᵤ β)) :=
+(uniform_fun.is_basis_gen α β 𝓕).filter_basis
+
+/-- For `𝓕 : filter (β × β)`, this is the filter generated by the filter basis
+`uniform_convergence.basis α β 𝓕`. For `𝓕 = 𝓤 β`, this will be the uniformity of uniform
+convergence on `α`. -/
+protected def filter (𝓕 : filter $ β × β) : filter ((α →ᵤ β) × (α →ᵤ β)) :=
+(uniform_fun.basis α β 𝓕).filter
+
+local notation `Φ` :=
+λ (α β : Type*) (uvx : ((α →ᵤ β) × (α →ᵤ β)) × α), (uvx.1.1 uvx.2, uvx.1.2 uvx.2)
+
+/- This is a lower adjoint to `uniform_convergence.filter` (see `uniform_convergence.gc`).
+The exact definition of the lower adjoint `l` is not interesting; we will only use that it exists
+(in `uniform_convergence.mono` and `uniform_convergence.infi_eq`) and that
+`l (filter.map (prod.map f f) 𝓕) = filter.map (prod.map ((∘) f) ((∘) f)) (l 𝓕)` for each
+`𝓕 : filter (γ × γ)` and `f : γ → α` (in `uniform_convergence.comap_eq`). -/
+local notation `lower_adjoint` :=
+λ 𝓐, map (Φ α β) (𝓐 ×ᶠ ⊤)
+
+/-- The function `uniform_convergence.filter α β : filter (β × β) → filter ((α →ᵤ β) × (α →ᵤ β))`
+has a lower adjoint `l` (in the sense of `galois_connection`). The exact definition of `l` is not
+interesting; we will only use that it exists (in `uniform_convergence.mono` and
+`uniform_convergence.infi_eq`) and that
+`l (filter.map (prod.map f f) 𝓕) = filter.map (prod.map ((∘) f) ((∘) f)) (l 𝓕)` for each
+`𝓕 : filter (γ × γ)` and `f : γ → α` (in `uniform_convergence.comap_eq`). -/
+protected lemma gc : galois_connection lower_adjoint
+  (λ 𝓕, uniform_fun.filter α β 𝓕) :=
+begin
+  intros 𝓐 𝓕,
+  symmetry,
+  calc 𝓐 ≤ uniform_fun.filter α β 𝓕
+      ↔ (uniform_fun.basis α β 𝓕).sets ⊆ 𝓐.sets :
+        by rw [uniform_fun.filter, ← filter_basis.generate, sets_iff_generate]
+  ... ↔ ∀ U ∈ 𝓕, uniform_fun.gen α β U ∈ 𝓐 : image_subset_iff
+  ... ↔ ∀ U ∈ 𝓕, {uv | ∀ x, (uv, x) ∈
+          {t : ((α →ᵤ β) × (α →ᵤ β)) × α | (t.1.1 t.2, t.1.2 t.2) ∈ U}} ∈ 𝓐 : iff.rfl
+  ... ↔ ∀ U ∈ 𝓕, {uvx : ((α →ᵤ β) × (α →ᵤ β)) × α | (uvx.1.1 uvx.2, uvx.1.2 uvx.2) ∈ U} ∈
+          𝓐 ×ᶠ (⊤ : filter α) : forall₂_congr (λ U hU, mem_prod_top.symm)
+  ... ↔ lower_adjoint 𝓐 ≤ 𝓕 : iff.rfl,
+end
+
+variables [uniform_space β]
 
-/-- Core of the uniform structure of uniform convergence -/
-protected def uniform_core : uniform_space.core (α → β) :=
-uniform_space.core.mk_of_basis (uniform_convergence.uniformity_basis α β)
+/-- Core of the uniform structure of uniform convergence. -/
+protected def uniform_core : uniform_space.core (α →ᵤ β) :=
+uniform_space.core.mk_of_basis (uniform_fun.basis α β (𝓤 β))
   (λ U ⟨V, hV, hVU⟩ f, hVU ▸ λ x, refl_mem_uniformity hV)
-  (λ U ⟨V, hV, hVU⟩, hVU ▸ ⟨uniform_convergence.gen α β (prod.swap ⁻¹' V),
+  (λ U ⟨V, hV, hVU⟩, hVU ▸ ⟨uniform_fun.gen α β (prod.swap ⁻¹' V),
     ⟨prod.swap ⁻¹' V, tendsto_swap_uniformity hV, rfl⟩, λ uv huv x, huv x⟩)
   (λ U ⟨V, hV, hVU⟩, hVU ▸ let ⟨W, hW, hWV⟩ := comp_mem_uniformity_sets hV in
-    ⟨uniform_convergence.gen α β W, ⟨W, hW, rfl⟩, λ uv ⟨w, huw, hwv⟩ x, hWV
+    ⟨uniform_fun.gen α β W, ⟨W, hW, rfl⟩, λ uv ⟨w, huw, hwv⟩ x, hWV
       ⟨w x, by exact ⟨huw x, hwv x⟩⟩⟩)
 
-/-- Uniform structure of uniform convergence -/
-protected def uniform_space : uniform_space (α → β) :=
-uniform_space.of_core (uniform_convergence.uniform_core α β)
+/-- Uniform structure of uniform convergence, declared as an instance on `α →ᵤ β`.
+We will denote it `𝒰(α, β, uβ)` in the rest of this file. -/
+instance : uniform_space (α →ᵤ β) :=
+uniform_space.of_core (uniform_fun.uniform_core α β)
 
-protected lemma has_basis_uniformity :
-  (@uniformity (α → β) (uniform_convergence.uniform_space α β)).has_basis (λ V, V ∈ 𝓤 β)
-  (uniform_convergence.gen α β) :=
-(uniform_convergence.is_basis_gen α β).has_basis
+/-- Topology of uniform convergence, declared as an instance on `α →ᵤ β`. -/
+instance : topological_space (α →ᵤ β) := infer_instance
 
-/-- Topology of uniform convergence -/
-protected def topological_space : topological_space (α → β) :=
-(uniform_convergence.uniform_space α β).to_topological_space
+local notation `𝒰(`α`, `β`, `u`)` := @uniform_fun.uniform_space α β u
 
-protected lemma has_basis_nhds :
-  (@nhds (α → β) (uniform_convergence.topological_space α β) f).has_basis (λ V, V ∈ 𝓤 β)
-  (λ V, {g | (g, f) ∈ uniform_convergence.gen α β V}) :=
-begin
-  letI : uniform_space (α → β) := uniform_convergence.uniform_space α β,
-  exact nhds_basis_uniformity (uniform_convergence.has_basis_uniformity α β)
-end
+/-- By definition, the uniformity of `α →ᵤ β` admits the family `{(f, g) | ∀ x, (f x, g x) ∈ V}`
+for `V ∈ 𝓤 β` as a filter basis. -/
+protected lemma has_basis_uniformity :
+  (𝓤 (α →ᵤ β)).has_basis (λ V, V ∈ 𝓤 β)
+  (uniform_fun.gen α β) :=
+(uniform_fun.is_basis_gen α β (𝓤 β)).has_basis
+
+/-- The uniformity of `α →ᵤ β` admits the family `{(f, g) | ∀ x, (f x, g x) ∈ V}` for `V ∈ 𝓑` as
+a filter basis, for any basis `𝓑` of `𝓤 β` (in the case `𝓑 = (𝓤 β).as_basis` this is true by
+definition). -/
+protected lemma has_basis_uniformity_of_basis {ι : Sort*} {p : ι → Prop} {s : ι → set (β × β)}
+  (h : (𝓤 β).has_basis p s) :
+  (𝓤 (α →ᵤ β)).has_basis p (uniform_fun.gen α β ∘ s) :=
+(uniform_fun.has_basis_uniformity α β).to_has_basis
+  (λ U hU, let ⟨i, hi, hiU⟩ := h.mem_iff.mp hU in ⟨i, hi, λ uv huv x, hiU (huv x)⟩)
+  (λ i hi, ⟨s i, h.mem_of_mem hi, subset_refl _⟩)
+
+/-- For `f : α →ᵤ β`, `𝓝 f` admits the family `{g | ∀ x, (f x, g x) ∈ V}` for `V ∈ 𝓑` as a filter
+basis, for any basis `𝓑` of `𝓤 β`. -/
+protected lemma has_basis_nhds_of_basis (f) {p : ι → Prop} {s : ι → set (β × β)}
+  (h : has_basis (𝓤 β) p s) :
+  (𝓝 f).has_basis p (λ i, {g | (f, g) ∈ uniform_fun.gen α β (s i)}) :=
+nhds_basis_uniformity' (uniform_fun.has_basis_uniformity_of_basis α β h)
+
+/-- For `f : α →ᵤ β`, `𝓝 f` admits the family `{g | ∀ x, (f x, g x) ∈ V}` for `V ∈ 𝓤 β` as a
+filter basis. -/
+protected lemma has_basis_nhds (f) :
+  (𝓝 f).has_basis (λ V, V ∈ 𝓤 β) (λ V, {g | (f, g) ∈ uniform_fun.gen α β V}) :=
+uniform_fun.has_basis_nhds_of_basis α β f (filter.basis_sets _)
 
 variables {α}
 
-lemma uniform_continuous_eval (x : α) : @uniform_continuous _ _
-  (uniform_convergence.uniform_space α β) _ (function.eval x) :=
+/-- Evaluation at a fixed point is uniformly continuous on `α →ᵤ β`. -/
+lemma uniform_continuous_eval (x : α) :
+  uniform_continuous (function.eval x ∘ to_fun : (α →ᵤ β) → β) :=
 begin
   change _ ≤ _,
   rw [map_le_iff_le_comap,
-      (uniform_convergence.has_basis_uniformity α β).le_basis_iff ((𝓤 _).basis_sets.comap _)],
+      (uniform_fun.has_basis_uniformity α β).le_basis_iff ((𝓤 _).basis_sets.comap _)],
   exact λ U hU, ⟨U, hU, λ uv huv, huv x⟩
 end
 
 variables {β}
 
-lemma t2_space [t2_space β] : @t2_space _ (uniform_convergence.topological_space α β) :=
+/-- If `u₁` and `u₂` are two uniform structures on `γ` and `u₁ ≤ u₂`, then
+`𝒰(α, γ, u₁) ≤ 𝒰(α, γ, u₂)`. -/
+protected lemma mono : monotone (@uniform_fun.uniform_space α γ) :=
+λ u₁ u₂ hu, (uniform_fun.gc α γ).monotone_u hu
+
+/-- If `u` is a family of uniform structures on `γ`, then
+`𝒰(α, γ, (⨅ i, u i)) = ⨅ i, 𝒰(α, γ, u i)`. -/
+protected lemma infi_eq {u : ι → uniform_space γ} :
+  (𝒰(α, γ, ⨅ i, u i)) = ⨅ i, 𝒰(α, γ, u i) :=
+begin
+  -- This follows directly from the fact that the upper adjoint in a Galois connection maps
+  -- infimas to infimas.
+  ext : 1,
+  change uniform_fun.filter α γ (𝓤[⨅ i, u i]) = 𝓤[⨅ i, 𝒰(α, γ, u i)],
+  rw [infi_uniformity, infi_uniformity],
+  exact (uniform_fun.gc α γ).u_infi
+end
+
+/-- If `u₁` and `u₂` are two uniform structures on `γ`, then
+`𝒰(α, γ, u₁ ⊓ u₂) = 𝒰(α, γ, u₁) ⊓ 𝒰(α, γ, u₂)`. -/
+protected lemma inf_eq {u₁ u₂ : uniform_space γ} :
+  (𝒰(α, γ, u₁ ⊓ u₂)) = (𝒰(α, γ, u₁)) ⊓ (𝒰(α, γ, u₂)) :=
+begin
+  -- This follows directly from the fact that the upper adjoint in a Galois connection maps
+  -- infimas to infimas.
+  rw [inf_eq_infi, inf_eq_infi, uniform_fun.infi_eq],
+  refine infi_congr (λ i, _),
+  cases i; refl
+end
+
+/-- If `u` is a uniform structures on `β` and `f : γ → β`, then
+`𝒰(α, γ, comap f u) = comap (λ g, f ∘ g) 𝒰(α, γ, u₁)`. -/
+protected lemma comap_eq {f : γ → β} :
+  (𝒰(α, γ, ‹uniform_space β›.comap f)) = (𝒰(α, β, _)).comap ((∘) f) :=
+begin
+  letI : uniform_space γ := ‹uniform_space β›.comap f,
+  ext : 1,
+  change (uniform_fun.filter α γ ((𝓤 β).comap _)) =
+    (uniform_fun.filter α β ((𝓤 β))).comap _,
+  -- We have the following four Galois connection which form a square diagram, and we want
+  -- to show that the square of upper adjoints is commutative. The trick then is to use
+  -- `galois_connection.u_comm_of_l_comm` to reduce it to commutativity of the lower adjoints,
+  -- which is way easier to prove.
+  have h₁ := filter.gc_map_comap (prod.map ((∘) f) ((∘) f)),
+  have h₂ := filter.gc_map_comap (prod.map f f),
+  have h₃ := uniform_fun.gc α β,
+  have h₄ := uniform_fun.gc α γ,
+  refine galois_connection.u_comm_of_l_comm h₁ h₂ h₃ h₄ (λ 𝓐, _),
+  have : prod.map f f ∘ (Φ α γ) =
+    (Φ α β) ∘ prod.map (prod.map ((∘) f) ((∘) f)) id,
+  { ext; refl },
+  rw [map_comm this, ← prod_map_map_eq'],
+  refl
+end
+
+/-- Post-composition by a uniformly continuous function is uniformly continuous on `α →ᵤ β`.
+
+More precisely, if `f : γ → β` is uniformly continuous, then `(λ g, f ∘ g) : (α →ᵤ γ) → (α →ᵤ β)`
+is uniformly continuous. -/
+protected lemma postcomp_uniform_continuous [uniform_space γ] {f : γ → β}
+  (hf : uniform_continuous f):
+  uniform_continuous (of_fun ∘ ((∘) f) ∘ to_fun : (α →ᵤ γ) → (α →ᵤ β)) :=
+-- This is a direct consequence of `uniform_convergence.comap_eq`
+uniform_continuous_iff.mpr $
+calc 𝒰(α, γ, _)
+    ≤ 𝒰(α, γ, ‹uniform_space β›.comap f) :
+      uniform_fun.mono (uniform_continuous_iff.mp hf)
+... = (𝒰(α, β, _)).comap ((∘) f) :
+      uniform_fun.comap_eq
+
+/-- Post-composition by a uniform inducing is a uniform inducing for the
+uniform structures of uniform convergence.
+
+More precisely, if `f : γ → β` is a uniform inducing, then `(λ g, f ∘ g) : (α →ᵤ γ) → (α →ᵤ β)` is
+a uniform inducing. -/
+protected lemma postcomp_uniform_inducing [uniform_space γ] {f : γ → β}
+  (hf : uniform_inducing f):
+  uniform_inducing (of_fun ∘ ((∘) f) ∘ to_fun : (α →ᵤ γ) → (α →ᵤ β)) :=
+-- This is a direct consequence of `uniform_convergence.comap_eq`
+begin
+  split,
+  replace hf : (𝓤 β).comap (prod.map f f) = _ := hf.comap_uniformity,
+  change comap (prod.map (of_fun ∘ (∘) f ∘ to_fun) (of_fun ∘ (∘) f ∘ to_fun)) _ = _,
+  rw [← uniformity_comap] at ⊢ hf,
+  congr,
+  rw [← uniform_space_eq hf, uniform_fun.comap_eq],
+  refl
+end
+
+/-- Turn a uniform isomorphism `γ ≃ᵤ β` into a uniform isomorphism `(α →ᵤ γ) ≃ᵤ (α →ᵤ β)` by
+post-composing. -/
+protected def congr_right [uniform_space γ] (e : γ ≃ᵤ β) :
+  (α →ᵤ γ) ≃ᵤ (α →ᵤ β) :=
+{ uniform_continuous_to_fun :=
+    uniform_fun.postcomp_uniform_continuous e.uniform_continuous,
+  uniform_continuous_inv_fun :=
+    uniform_fun.postcomp_uniform_continuous e.symm.uniform_continuous,
+  .. equiv.Pi_congr_right (λ a, e.to_equiv) }
+
+/-- Pre-composition by a any function is uniformly continuous for the uniform structures of
+uniform convergence.
+
+More precisely, for any `f : γ → α`, the function `(λ g, g ∘ f) : (α →ᵤ β) → (γ →ᵤ β)` is uniformly
+continuous. -/
+protected lemma precomp_uniform_continuous {f : γ → α} :
+  uniform_continuous (λ g : α →ᵤ β, of_fun (g ∘ f)) :=
+begin
+  -- Here we simply go back to filter bases.
+  rw uniform_continuous_iff,
+  change 𝓤 (α →ᵤ β) ≤ (𝓤 (γ →ᵤ β)).comap (prod.map (λ g : α →ᵤ β, g ∘ f) (λ g : α →ᵤ β, g ∘ f)),
+  rw (uniform_fun.has_basis_uniformity α β).le_basis_iff
+    ((uniform_fun.has_basis_uniformity γ β).comap _),
+  exact λ U hU, ⟨U, hU, λ uv huv x, huv (f x)⟩
+end
+
+/-- Turn a bijection `γ ≃ α` into a uniform isomorphism
+`(γ →ᵤ β) ≃ᵤ (α →ᵤ β)` by pre-composing. -/
+protected def congr_left (e : γ ≃ α) :
+  (γ →ᵤ β) ≃ᵤ (α →ᵤ β) :=
+{ uniform_continuous_to_fun :=
+    uniform_fun.precomp_uniform_continuous,
+  uniform_continuous_inv_fun :=
+    uniform_fun.precomp_uniform_continuous,
+  .. equiv.arrow_congr e (equiv.refl _) }
+
+/-- The topology of uniform convergence is T₂. -/
+instance [t2_space β] : t2_space (α →ᵤ β) :=
 { t2 :=
   begin
-    letI : uniform_space (α → β) := uniform_convergence.uniform_space α β,
-    letI : topological_space (α → β) := uniform_convergence.topological_space α β,
     intros f g h,
     obtain ⟨x, hx⟩ := not_forall.mp (mt funext h),
     exact separated_by_continuous (uniform_continuous_eval β x).continuous hx
   end }
 
-protected lemma le_Pi : uniform_convergence.uniform_space α β ≤ Pi.uniform_space (λ _, β) :=
+/-- The natural map `uniform_fun.to_fun` from `α →ᵤ β` to `α → β` is uniformly continuous.
+
+In other words, the uniform structure of uniform convergence is finer than that of pointwise
+convergence, aka the product uniform structure. -/
+protected lemma uniform_continuous_to_fun : uniform_continuous (to_fun : (α →ᵤ β) → α → β) :=
 begin
-  rw [le_iff_uniform_continuous_id, uniform_continuous_pi],
+  -- By definition of the product uniform structure, this is just `uniform_continuous_eval`.
+  rw uniform_continuous_pi,
   intros x,
   exact uniform_continuous_eval β x
 end
 
-protected lemma tendsto_iff_tendsto_uniformly :
-  tendsto F p (@nhds _ (uniform_convergence.topological_space α β) f) ↔
-  tendsto_uniformly F f p :=
+/-- The topology of uniform convergence indeed gives the same notion of convergence as
+`tendsto_uniformly`. -/
+protected lemma tendsto_iff_tendsto_uniformly {F : ι → α →ᵤ β} {f : α →ᵤ β} :
+  tendsto F p (𝓝 f) ↔ tendsto_uniformly F f p :=
 begin
-  letI : uniform_space (α → β) := uniform_convergence.uniform_space α β,
-  rw [(uniform_convergence.has_basis_nhds α β).tendsto_right_iff, tendsto_uniformly],
-  split;
-  { intros h U hU,
-    filter_upwards [h (prod.swap ⁻¹' U) (tendsto_swap_uniformity hU)],
-    exact λ n, id }
+  rw [(uniform_fun.has_basis_nhds α β f).tendsto_right_iff, tendsto_uniformly],
+  exact iff.rfl,
 end
 
-variable {α}
+/-- The natural bijection between `α → β × γ` and `(α → β) × (α → γ)`, upgraded to a uniform
+isomorphism between `α →ᵤ β × γ` and `(α →ᵤ β) × (α →ᵤ γ)`. -/
+protected def uniform_equiv_prod_arrow [uniform_space γ] :
+  (α →ᵤ β × γ) ≃ᵤ ((α →ᵤ β) × (α →ᵤ γ)) :=
+-- Denote `φ` this bijection. We want to show that
+-- `comap φ (𝒰(α, β, uβ) × 𝒰(α, γ, uγ)) = 𝒰(α, β × γ, uβ × uγ)`.
+-- But `uβ × uγ` is defined as `comap fst uβ ⊓ comap snd uγ`, so we just have to apply
+-- `uniform_convergence.inf_eq` and `uniform_convergence.comap_eq`, which leaves us to check
+-- that some square commutes.
+(equiv.arrow_prod_equiv_prod_arrow _ _ _).to_uniform_equiv_of_uniform_inducing
+begin
+  split,
+  change comap (prod.map (equiv.arrow_prod_equiv_prod_arrow _ _ _)
+    (equiv.arrow_prod_equiv_prod_arrow _ _ _)) _ = _,
+  rw ← uniformity_comap,
+  congr,
+  rw [prod.uniform_space, prod.uniform_space, uniform_space.comap_inf, uniform_fun.inf_eq],
+  congr;
+  rw [← uniform_space.comap_comap, uniform_fun.comap_eq];
+  refl -- the relevant diagram commutes by definition
+end
+
+variables (α) (δ : ι → Type*) [Π i, uniform_space (δ i)]
+
+/-- The natural bijection between `α → Π i, δ i` and `Π i, α → δ i`, upgraded to a uniform
+isomorphism between `α →ᵤ (Π i, δ i)` and `Π i, α →ᵤ δ i`. -/
+protected def uniform_equiv_Pi_comm : uniform_equiv (α →ᵤ Π i, δ i) (Π i, α →ᵤ δ i) :=
+-- Denote `φ` this bijection. We want to show that
+-- `comap φ (Π i, 𝒰(α, δ i, uδ i)) = 𝒰(α, (Π i, δ i), (Π i, uδ i))`.
+-- But `Π i, uδ i` is defined as `⨅ i, comap (eval i) (uδ i)`, so we just have to apply
+-- `uniform_convergence.infi_eq` and `uniform_convergence.comap_eq`, which leaves us to check
+-- that some square commutes.
+@equiv.to_uniform_equiv_of_uniform_inducing _ _
+  (𝒰(α, Π i, δ i, Pi.uniform_space δ))
+  (@Pi.uniform_space ι (λ i, α → δ i) (λ i, 𝒰(α, δ i, _)))
+  (equiv.Pi_comm _)
+begin
+  split,
+  change comap (prod.map function.swap function.swap) _ = _,
+  rw ← uniformity_comap,
+  congr,
+  rw [Pi.uniform_space, uniform_space.of_core_eq_to_core, Pi.uniform_space,
+      uniform_space.of_core_eq_to_core, uniform_space.comap_infi, uniform_fun.infi_eq],
+  refine infi_congr (λ i, _),
+  rw [← uniform_space.comap_comap, uniform_fun.comap_eq]
+  -- Like in the previous lemma, the diagram actually commutes by definition
+end
+
+end uniform_fun
 
-end uniform_convergence
+namespace uniform_on_fun
 
-namespace uniform_convergence_on
+variables {α β : Type*} {γ ι : Type*}
+variables {s s' : set α} {x : α} {p : filter ι} {g : ι → α}
 
-variables (α β : Type*) {γ ι : Type*} [uniform_space β] (𝔖 : set (set α))
-variables {F : ι → α → β} {f : α → β} {s s' : set α} {x : α} {p : filter ι} {g : ι → α}
+local notation `𝒰(`α`, `β`, `u`)` := @uniform_fun.uniform_space α β u
 
-/-- Uniform structure of uniform convergence on the sets of `𝔖`. -/
-protected def uniform_space : uniform_space (α → β) :=
-⨅ (s : set α) (hs : s ∈ 𝔖), uniform_space.comap (λ f, s.restrict f)
-  (uniform_convergence.uniform_space s β)
+/-- Basis sets for the uniformity of `𝔖`-convergence: for `S : set α` and `V : set (β × β)`,
+`gen 𝔖 S V` is the set of pairs `(f, g)` of functions `α →ᵤ[𝔖] β` such that
+`∀ x ∈ S, (f x, g x) ∈ V`. Note that the family `𝔖 : set (set α)` is only used to specify which
+type alias of `α → β` to use here. -/
+protected def gen (𝔖) (S : set α) (V : set (β × β)) : set ((α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] β)) :=
+  {uv : (α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] β) | ∀ x ∈ S, (uv.1 x, uv.2 x) ∈ V}
 
-/-- Topology of uniform convergence on the sets of `𝔖`. -/
-protected def topological_space : topological_space (α → β) :=
-(uniform_convergence_on.uniform_space α β 𝔖).to_topological_space
+/-- For `S : set α` and `V : set (β × β)`, we have
+`uniform_on_fun.gen 𝔖 S V = (S.restrict × S.restrict) ⁻¹' (uniform_fun.gen S β V)`.
+This is the crucial fact for proving that the family `uniform_on_fun.gen S V` for `S ∈ 𝔖` and
+`V ∈ 𝓤 β` is indeed a basis for the uniformity `α →ᵤ[𝔖] β` endowed with `𝒱(α, β, 𝔖, uβ)`
+the uniform structure of `𝔖`-convergence, as defined in `uniform_on_fun.uniform_space`. -/
+protected lemma gen_eq_preimage_restrict {𝔖} (S : set α) (V : set (β × β)) :
+  uniform_on_fun.gen 𝔖 S V =
+  (prod.map S.restrict S.restrict) ⁻¹' (uniform_fun.gen S β V) :=
+begin
+  ext uv,
+  exact ⟨λ h ⟨x, hx⟩, h x hx, λ h x hx, h ⟨x, hx⟩⟩
+end
 
+/-- `uniform_on_fun.gen` is antitone in the first argument and monotone in the second. -/
+protected lemma gen_mono {𝔖} {S S' : set α} {V V' : set (β × β)} (hS : S' ⊆ S) (hV : V ⊆ V') :
+  uniform_on_fun.gen 𝔖 S V ⊆ uniform_on_fun.gen 𝔖 S' V' :=
+λ uv h x hx, hV (h x $ hS hx)
+
+/-- If `𝔖 : set (set α)` is nonempty and directed and `𝓑` is a filter basis on `β × β`, then the
+family `uniform_on_fun.gen 𝔖 S V` for `S ∈ 𝔖` and `V ∈ 𝓑` is a filter basis on
+`(α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] β)`.
+We will show in `has_basis_uniformity_of_basis` that, if `𝓑` is a basis for `𝓤 β`, then the
+corresponding filter is the uniformity of `α →ᵤ[𝔖] β`. -/
+protected lemma is_basis_gen (𝔖 : set (set α)) (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖)
+  (𝓑 : filter_basis $ β × β) :
+  is_basis (λ SV : set α × set (β × β), SV.1 ∈ 𝔖 ∧ SV.2 ∈ 𝓑)
+    (λ SV, uniform_on_fun.gen 𝔖 SV.1 SV.2) :=
+⟨h.prod 𝓑.nonempty, λ U₁V₁ U₂V₂ h₁ h₂,
+  let ⟨U₃, hU₃, hU₁₃, hU₂₃⟩ := h' U₁V₁.1 h₁.1 U₂V₂.1 h₂.1 in
+  let ⟨V₃, hV₃, hV₁₂₃⟩ := 𝓑.inter_sets h₁.2 h₂.2 in ⟨⟨U₃, V₃⟩, ⟨⟨hU₃, hV₃⟩, λ uv huv,
+    ⟨(λ x hx, (hV₁₂₃ $ huv x $ hU₁₃ hx).1), (λ x hx, (hV₁₂₃ $ huv x $ hU₂₃ hx).2)⟩⟩⟩⟩
+
+variables (α β) [uniform_space β] (𝔖 : set (set α))
+
+/-- Uniform structure of `𝔖`-convergence, i.e uniform convergence on the elements of `𝔖`,
+declared as an instance on `α →ᵤ[𝔖] β`. It is defined as the infimum, for `S ∈ 𝔖`, of the pullback
+by `S.restrict`, the map of restriction to `S`, of the uniform structure `𝒰(s, β, uβ)` on
+`↥S →ᵤ β`. We will denote it `𝒱(α, β, 𝔖, uβ)`, where `uβ` is the uniform structure on `β`. -/
+instance : uniform_space (α →ᵤ[𝔖] β) :=
+⨅ (s : set α) (hs : s ∈ 𝔖), uniform_space.comap s.restrict
+  (𝒰(s, β, _))
+
+local notation `𝒱(`α`, `β`, `𝔖`, `u`)` := @uniform_on_fun.uniform_space α β u 𝔖
+
+/-- Topology of `𝔖`-convergence, i.e uniform convergence on the elements of `𝔖`, declared as an
+instance on `α →ᵤ[𝔖] β`. -/
+instance : topological_space (α →ᵤ[𝔖] β) :=
+(𝒱(α, β, 𝔖, _)).to_topological_space
+
+/-- The topology of `𝔖`-convergence is the infimum, for `S ∈ 𝔖`, of topology induced by the map
+of `S.restrict : (α →ᵤ[𝔖] β) → (↥S →ᵤ β)` of restriction to `S`, where `↥S →ᵤ β` is endowed with
+the topology of uniform convergence. -/
 protected lemma topological_space_eq :
-  uniform_convergence_on.topological_space α β 𝔖 = ⨅ (s : set α) (hs : s ∈ 𝔖),
-  topological_space.induced (λ f, s.restrict f) (uniform_convergence.topological_space s β) :=
+  uniform_on_fun.topological_space α β 𝔖 = ⨅ (s : set α) (hs : s ∈ 𝔖),
+  topological_space.induced s.restrict (uniform_fun.topological_space s β) :=
 begin
-  simp only [uniform_convergence_on.topological_space, to_topological_space_infi,
+  simp only [uniform_on_fun.topological_space, to_topological_space_infi,
     to_topological_space_infi, to_topological_space_comap],
   refl
 end
 
+protected lemma has_basis_uniformity_of_basis_aux₁ {p : ι → Prop} {s : ι → set (β × β)}
+  (hb : has_basis (𝓤 β) p s) (S : set α) :
+  (@uniformity (α →ᵤ[𝔖] β) ((uniform_fun.uniform_space S β).comap S.restrict)).has_basis
+  p (λ i, uniform_on_fun.gen 𝔖 S (s i)) :=
+begin
+  simp_rw [uniform_on_fun.gen_eq_preimage_restrict, uniformity_comap],
+  exact (uniform_fun.has_basis_uniformity_of_basis S β hb).comap _
+end
+
+protected lemma has_basis_uniformity_of_basis_aux₂ (h : directed_on (⊆) 𝔖) {p : ι → Prop}
+  {s : ι → set (β × β)} (hb : has_basis (𝓤 β) p s) :
+  directed_on ((λ s : set α, (uniform_fun.uniform_space s β).comap
+    (s.restrict : (α →ᵤ β) → s →ᵤ β)) ⁻¹'o ge) 𝔖 :=
+h.mono $ λ s t hst,
+  ((uniform_on_fun.has_basis_uniformity_of_basis_aux₁ α β 𝔖 hb _).le_basis_iff
+    (uniform_on_fun.has_basis_uniformity_of_basis_aux₁ α β 𝔖 hb _)).mpr
+  (λ V hV, ⟨V, hV, uniform_on_fun.gen_mono hst subset_rfl⟩)
+
+/-- If `𝔖 : set (set α)` is nonempty and directed and `𝓑` is a filter basis of `𝓤 β`, then the
+uniformity of `α →ᵤ[𝔖] β` admits the family `{(f, g) | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and
+`V ∈ 𝓑` as a filter basis. -/
+protected lemma has_basis_uniformity_of_basis (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖)
+  {p : ι → Prop} {s : ι → set (β × β)} (hb : has_basis (𝓤 β) p s) :
+  (𝓤 (α →ᵤ[𝔖] β)).has_basis
+    (λ Si : set α × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
+    (λ Si, uniform_on_fun.gen 𝔖 Si.1 (s Si.2)) :=
+begin
+  simp only [infi_uniformity],
+  exact has_basis_binfi_of_directed h (λ S, (uniform_on_fun.gen 𝔖 S) ∘ s) _
+    (λ S hS, uniform_on_fun.has_basis_uniformity_of_basis_aux₁ α β 𝔖 hb S)
+    (uniform_on_fun.has_basis_uniformity_of_basis_aux₂ α β 𝔖 h' hb)
+end
+
+/-- If `𝔖 : set (set α)` is nonempty and directed, then the uniformity of `α →ᵤ[𝔖] β` admits the
+family `{(f, g) | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and `V ∈ 𝓤 β` as a filter basis. -/
+protected lemma has_basis_uniformity (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖) :
+  (𝓤 (α →ᵤ[𝔖] β)).has_basis
+    (λ SV : set α × set (β × β), SV.1 ∈ 𝔖 ∧ SV.2 ∈ 𝓤 β)
+    (λ SV, uniform_on_fun.gen 𝔖 SV.1 SV.2) :=
+uniform_on_fun.has_basis_uniformity_of_basis α β 𝔖 h h' (𝓤 β).basis_sets
+
+/-- For `f : α →ᵤ[𝔖] β`, where `𝔖 : set (set α)` is nonempty and directed, `𝓝 f` admits the
+family `{g | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and `V ∈ 𝓑` as a filter basis, for any basis
+`𝓑` of `𝓤 β`. -/
+protected lemma has_basis_nhds_of_basis (f : α →ᵤ[𝔖] β) (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖)
+  {p : ι → Prop} {s : ι → set (β × β)} (hb : has_basis (𝓤 β) p s) :
+  (𝓝 f).has_basis
+    (λ Si : set α × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
+    (λ Si, {g | (g, f) ∈ uniform_on_fun.gen 𝔖 Si.1 (s Si.2)}) :=
+begin
+  letI : uniform_space (α → β) := uniform_on_fun.uniform_space α β 𝔖,
+  exact nhds_basis_uniformity (uniform_on_fun.has_basis_uniformity_of_basis α β 𝔖 h h' hb)
+end
+
+/-- For `f : α →ᵤ[𝔖] β`, where `𝔖 : set (set α)` is nonempty and directed, `𝓝 f` admits the
+family `{g | ∀ x ∈ S, (f x, g x) ∈ V}` for `S ∈ 𝔖` and `V ∈ 𝓤 β` as a filter basis. -/
+protected lemma has_basis_nhds (f : α →ᵤ[𝔖] β) (h : 𝔖.nonempty) (h' : directed_on (⊆) 𝔖) :
+  (𝓝 f).has_basis
+    (λ SV : set α × set (β × β), SV.1 ∈ 𝔖 ∧ SV.2 ∈ 𝓤 β)
+    (λ SV, {g | (g, f) ∈ uniform_on_fun.gen 𝔖 SV.1 SV.2}) :=
+uniform_on_fun.has_basis_nhds_of_basis α β 𝔖 f h h' (filter.basis_sets _)
+
+/-- If `S ∈ 𝔖`, then the restriction to `S` is a uniformly continuous map from `α →ᵤ[𝔖] β` to
+`↥S →ᵤ β`. -/
 protected lemma uniform_continuous_restrict (h : s ∈ 𝔖) :
-  @uniform_continuous _ _ (uniform_convergence_on.uniform_space α β 𝔖)
-  (uniform_convergence.uniform_space s β) s.restrict :=
+  uniform_continuous (uniform_fun.of_fun ∘ (s.restrict : (α → β) → (s → β)) ∘ (to_fun 𝔖)) :=
 begin
   change _ ≤ _,
-  rw [uniform_convergence_on.uniform_space, map_le_iff_le_comap, uniformity, infi_uniformity],
-  refine infi_le_of_le s _,
-  rw infi_uniformity,
-  exact infi_le _ h,
+  simp only [uniform_on_fun.uniform_space, map_le_iff_le_comap, infi_uniformity],
+  exact infi₂_le s h
 end
 
-protected lemma uniform_space_antitone : antitone (uniform_convergence_on.uniform_space α β) :=
-λ 𝔖₁ 𝔖₂ h₁₂, infi_le_infi_of_subset h₁₂
-
 variables {α}
 
+/-- Let `u₁`, `u₂` be two uniform structures on `γ` and `𝔖₁ 𝔖₂ : set (set α)`. If `u₁ ≤ u₂` and
+`𝔖₂ ⊆ 𝔖₁` then `𝒱(α, γ, 𝔖₁, u₁) ≤ 𝒱(α, γ, 𝔖₂, u₂)`. -/
+protected lemma mono ⦃u₁ u₂ : uniform_space γ⦄ (hu : u₁ ≤ u₂) ⦃𝔖₁ 𝔖₂ : set (set α)⦄
+  (h𝔖 : 𝔖₂ ⊆ 𝔖₁) :
+  𝒱(α, γ, 𝔖₁, u₁) ≤ 𝒱(α, γ, 𝔖₂, u₂) :=
+calc 𝒱(α, γ, 𝔖₁, u₁)
+    ≤ 𝒱(α, γ, 𝔖₂, u₁) : infi_le_infi_of_subset h𝔖
+... ≤ 𝒱(α, γ, 𝔖₂, u₂) : infi₂_mono
+        (λ i hi, uniform_space.comap_mono $ uniform_fun.mono hu)
+
+/-- If `x : α` is in some `S ∈ 𝔖`, then evaluation at `x` is uniformly continuous on
+`α →ᵤ[𝔖] β`. -/
 lemma uniform_continuous_eval_of_mem {x : α} (hxs : x ∈ s) (hs : s ∈ 𝔖) :
-  @uniform_continuous _ _ (uniform_convergence_on.uniform_space α β 𝔖) _ (function.eval x) :=
+  uniform_continuous ((function.eval x : (α → β) → β) ∘ to_fun 𝔖) :=
+(uniform_fun.uniform_continuous_eval β (⟨x, hxs⟩ : s)).comp
+  (uniform_on_fun.uniform_continuous_restrict α β 𝔖 hs)
+
+variables {β} {𝔖}
+
+/-- If `u` is a family of uniform structures on `γ`, then
+`𝒱(α, γ, 𝔖, (⨅ i, u i)) = ⨅ i, 𝒱(α, γ, 𝔖, u i)`. -/
+protected lemma infi_eq {u : ι → uniform_space γ} :
+  𝒱(α, γ, 𝔖, ⨅ i, u i) =
+  ⨅ i, 𝒱(α, γ, 𝔖, u i) :=
 begin
-  change _ ≤ _,
-  rw [map_le_iff_le_comap, ((𝓤 _).basis_sets.comap _).ge_iff,
-      uniform_convergence_on.uniform_space, infi_uniformity'],
-  intros U hU,
-  refine mem_infi_of_mem s _,
-  rw infi_uniformity',
-  exact mem_infi_of_mem hs (mem_comap.mpr
-    ⟨ uniform_convergence.gen s β U,
-      (uniform_convergence.has_basis_uniformity s β).mem_of_mem hU,
-      λ uv huv, huv ⟨x, hxs⟩ ⟩)
+  simp_rw [uniform_on_fun.uniform_space, uniform_fun.infi_eq, uniform_space.comap_infi],
+  rw infi_comm,
+  exact infi_congr (λ s, infi_comm)
 end
 
-variables {β}
+/-- If `u₁` and `u₂` are two uniform structures on `γ`, then
+`𝒱(α, γ, 𝔖, u₁ ⊓ u₂) = 𝒱(α, γ, 𝔖, u₁) ⊓ 𝒱(α, γ, 𝔖, u₂)`. -/
+protected lemma inf_eq {u₁ u₂ : uniform_space γ} :
+  𝒱(α, γ, 𝔖, u₁ ⊓ u₂) =
+  𝒱(α, γ, 𝔖, u₁) ⊓
+  𝒱(α, γ, 𝔖, u₂) :=
+begin
+  rw [inf_eq_infi, inf_eq_infi, uniform_on_fun.infi_eq],
+  refine infi_congr (λ i, _),
+  cases i; refl
+end
+
+/-- If `u` is a uniform structures on `β` and `f : γ → β`, then
+`𝒱(α, γ, 𝔖, comap f u) = comap (λ g, f ∘ g) 𝒱(α, γ, 𝔖, u₁)`. -/
+protected lemma comap_eq {f : γ → β} :
+  𝒱(α, γ, 𝔖, ‹uniform_space β›.comap f) =
+  𝒱(α, β, 𝔖, _).comap ((∘) f) :=
+begin
+  -- We reduce this to `uniform_convergence.comap_eq` using the fact that `comap` distributes
+  -- on `infi`.
+  simp_rw [uniform_on_fun.uniform_space, uniform_space.comap_infi,
+            uniform_fun.comap_eq, ← uniform_space.comap_comap],
+  refl -- by definition, `∀ S ∈ 𝔖, (f ∘ —) ∘ S.restrict = S.restrict ∘ (f ∘ —)`.
+end
+
+/-- Post-composition by a uniformly continuous function is uniformly continuous for the
+uniform structures of `𝔖`-convergence.
+
+More precisely, if `f : γ → β` is uniformly continuous, then
+`(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is uniformly continuous. -/
+protected lemma postcomp_uniform_continuous [uniform_space γ] {f : γ → β}
+  (hf : uniform_continuous f):
+  uniform_continuous (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖) :=
+begin
+  -- This is a direct consequence of `uniform_convergence.comap_eq`
+  rw uniform_continuous_iff,
+  calc 𝒱(α, γ, 𝔖, _)
+      ≤ 𝒱(α, γ, 𝔖, ‹uniform_space β›.comap f) :
+        uniform_on_fun.mono (uniform_continuous_iff.mp hf) (subset_rfl)
+  ... = 𝒱(α, β, 𝔖, _).comap ((∘) f) :
+        uniform_on_fun.comap_eq
+end
+
+/-- Post-composition by a uniform inducing is a uniform inducing for the
+uniform structures of `𝔖`-convergence.
 
+More precisely, if `f : γ → β` is a uniform inducing, then
+`(λ g, f ∘ g) : (α →ᵤ[𝔖] γ) → (α →ᵤ[𝔖] β)` is a uniform inducing. -/
+protected lemma postcomp_uniform_inducing [uniform_space γ] {f : γ → β}
+  (hf : uniform_inducing f):
+  uniform_inducing (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖) :=
+-- This is a direct consequence of `uniform_convergence.comap_eq`
+begin
+  split,
+  replace hf : (𝓤 β).comap (prod.map f f) = _ := hf.comap_uniformity,
+  change comap (prod.map (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖) (of_fun 𝔖 ∘ (∘) f ∘ to_fun 𝔖)) _ = _,
+  rw [← uniformity_comap] at ⊢ hf,
+  congr,
+  rw [← uniform_space_eq hf, uniform_on_fun.comap_eq],
+  refl
+end
+
+/-- Turn a uniform isomorphism `γ ≃ᵤ β` into a uniform isomorphism `(α →ᵤ[𝔖] γ) ≃ᵤ (α →ᵤ[𝔖] β)`
+by post-composing. -/
+protected def congr_right [uniform_space γ] (e : γ ≃ᵤ β) :
+  (α →ᵤ[𝔖] γ) ≃ᵤ (α →ᵤ[𝔖] β) :=
+{ uniform_continuous_to_fun :=
+    uniform_on_fun.postcomp_uniform_continuous e.uniform_continuous,
+  uniform_continuous_inv_fun :=
+    uniform_on_fun.postcomp_uniform_continuous e.symm.uniform_continuous,
+  .. equiv.Pi_congr_right (λ a, e.to_equiv) }
+
+/-- Let `f : γ → α`, `𝔖 : set (set α)`, `𝔗 : set (set γ)`, and assume that `∀ T ∈ 𝔗, f '' T ∈ 𝔖`.
+Then, the function `(λ g, g ∘ f) : (α →ᵤ[𝔖] β) → (γ →ᵤ[𝔗] β)` is uniformly continuous.
+
+Note that one can easily see that assuming `∀ T ∈ 𝔗, ∃ S ∈ 𝔖, f '' T ⊆ S` would work too, but
+we will get this for free when we prove that `𝒱(α, β, 𝔖, uβ) = 𝒱(α, β, 𝔖', uβ)` where `𝔖'` is the
+***noncovering*** bornology generated by `𝔖`. -/
+protected lemma precomp_uniform_continuous {𝔗 : set (set γ)} {f : γ → α}
+  (hf : 𝔗 ⊆ (image f) ⁻¹' 𝔖) :
+  uniform_continuous (λ g : α →ᵤ[𝔖] β, of_fun 𝔗 (g ∘ f)) :=
+begin
+  -- Since `comap` distributes on `infi`, it suffices to prove that
+  -- `⨅ s ∈ 𝔖, comap s.restrict 𝒰(↥s, β, uβ) ≤ ⨅ t ∈ 𝔗, comap (t.restrict ∘ (— ∘ f)) 𝒰(↥t, β, uβ)`.
+  simp_rw [uniform_continuous_iff, uniform_on_fun.uniform_space, uniform_space.comap_infi,
+            ← uniform_space.comap_comap],
+  -- For any `t ∈ 𝔗`, note `s := f '' t ∈ 𝔖`.
+  -- We will show that `comap s.restrict 𝒰(↥s, β, uβ) ≤ comap (t.restrict ∘ (— ∘ f)) 𝒰(↥t, β, uβ)`.
+  refine le_infi₂ (λ t ht, infi_le_of_le (f '' t) $ infi_le_of_le (hf ht) _),
+  -- Let `f'` be the map from `t` to `f '' t` induced by `f`.
+  let f' : t → f '' t := (maps_to_image f t).restrict f t (f '' t),
+  -- By definition `t.restrict ∘ (— ∘ f) = (— ∘ f') ∘ (f '' t).restrict`.
+  have : t.restrict ∘ (λ g : α →ᵤ[𝔖] β, of_fun 𝔗 (g ∘ f)) =
+    (λ g : (f '' t) → β, g ∘ f') ∘ (f '' t).restrict := rfl,
+  -- Thus, we have to show `comap (f '' t).restrict 𝒰(↥(f '' t), β, uβ) ≤`
+  -- `comap (f '' t).restrict (comap (— ∘ f') 𝒰(↥t, β, uβ))`.
+  rw [this, @uniform_space.comap_comap (α →ᵤ[𝔖] β) ((f '' t) →ᵤ β)],
+  -- But this is exactly monotonicity of `comap` applied to
+  -- `uniform_convergence.precomp_continuous`.
+  refine uniform_space.comap_mono _,
+  rw ← uniform_continuous_iff,
+  exact uniform_fun.precomp_uniform_continuous
+end
+
+/-- Turn a bijection `e : γ ≃ α` such that we have both `∀ T ∈ 𝔗, e '' T ∈ 𝔖` and
+`∀ S ∈ 𝔖, e ⁻¹' S ∈ 𝔗` into a uniform isomorphism `(γ →ᵤ[𝔗] β) ≃ᵤ (α →ᵤ[𝔖] β)` by pre-composing. -/
+protected def congr_left {𝔗 : set (set γ)} (e : γ ≃ α)
+  (he : 𝔗 ⊆ (image e) ⁻¹' 𝔖) (he' : 𝔖 ⊆ (preimage e) ⁻¹' 𝔗) :
+  (γ →ᵤ[𝔗] β) ≃ᵤ (α →ᵤ[𝔖] β) :=
+{ uniform_continuous_to_fun :=
+    uniform_on_fun.precomp_uniform_continuous
+    begin
+      intros s hs,
+      change e.symm '' s ∈ 𝔗,
+      rw ← preimage_equiv_eq_image_symm,
+      exact he' hs
+    end,
+  uniform_continuous_inv_fun :=
+    uniform_on_fun.precomp_uniform_continuous he,
+  .. equiv.arrow_congr e (equiv.refl _) }
+
+/-- If `𝔖` covers `α`, then the topology of `𝔖`-convergence is T₂. -/
 lemma t2_space_of_covering [t2_space β] (h : ⋃₀ 𝔖 = univ) :
-  @t2_space _ (uniform_convergence_on.topological_space α β 𝔖) :=
+  t2_space (α →ᵤ[𝔖] β) :=
 { t2 :=
   begin
-    letI : uniform_space (α → β) := uniform_convergence_on.uniform_space α β 𝔖,
-    letI : topological_space (α → β) := uniform_convergence_on.topological_space α β 𝔖,
     intros f g hfg,
     obtain ⟨x, hx⟩ := not_forall.mp (mt funext hfg),
     obtain ⟨s, hs, hxs⟩ : ∃ s ∈ 𝔖, x ∈ s := mem_sUnion.mp (h.symm ▸ true.intro),
     exact separated_by_continuous (uniform_continuous_eval_of_mem β 𝔖 hxs hs).continuous hx
   end }
 
-protected lemma le_Pi_of_covering (h : ⋃₀ 𝔖 = univ) :
-  uniform_convergence_on.uniform_space α β 𝔖 ≤ Pi.uniform_space (λ _, β) :=
+/-- If `𝔖` covers `α`, the natural map `uniform_on_fun.to_fun` from `α →ᵤ[𝔖] β` to `α → β` is
+uniformly continuous.
+
+In other words, if `𝔖` covers `α`, then the uniform structure of `𝔖`-convergence is finer than
+that of pointwise convergence. -/
+protected lemma uniform_continuous_to_fun (h : ⋃₀ 𝔖 = univ) :
+  uniform_continuous (to_fun 𝔖 : (α →ᵤ[𝔖] β) → α → β) :=
 begin
-  rw [le_iff_uniform_continuous_id, uniform_continuous_pi],
+  rw uniform_continuous_pi,
   intros x,
-  obtain ⟨s, hs, hxs⟩ : ∃ s ∈ 𝔖, x ∈ s := mem_sUnion.mp (h.symm ▸ true.intro),
+  obtain ⟨s : set α, hs : s ∈ 𝔖, hxs :  x ∈ s⟩ := sUnion_eq_univ_iff.mp h x,
   exact uniform_continuous_eval_of_mem β 𝔖 hxs hs
 end
 
-protected lemma tendsto_iff_tendsto_uniformly_on :
-  tendsto F p (@nhds _ (uniform_convergence_on.topological_space α β 𝔖) f) ↔
+/-- Convergence in the topology of `𝔖`-convergence means uniform convergence on `S` (in the sense
+of `tendsto_uniformly_on`) for all `S ∈ 𝔖`. -/
+protected lemma tendsto_iff_tendsto_uniformly_on {F : ι → α →ᵤ[𝔖] β} {f : α →ᵤ[𝔖] β} :
+  tendsto F p (𝓝 f) ↔
   ∀ s ∈ 𝔖, tendsto_uniformly_on F f p s :=
 begin
-  letI : uniform_space (α → β) := uniform_convergence_on.uniform_space α β 𝔖,
-  rw [uniform_convergence_on.topological_space_eq, nhds_infi, tendsto_infi],
+  rw [uniform_on_fun.topological_space_eq, nhds_infi, tendsto_infi],
   refine forall_congr (λ s, _),
   rw [nhds_infi, tendsto_infi],
   refine forall_congr (λ hs, _),
   rw [nhds_induced, tendsto_comap_iff, tendsto_uniformly_on_iff_tendsto_uniformly_comp_coe,
-      uniform_convergence.tendsto_iff_tendsto_uniformly],
+      uniform_fun.tendsto_iff_tendsto_uniformly],
   refl
 end
 
-end uniform_convergence_on
+/-- The natural bijection between `α → β × γ` and `(α → β) × (α → γ)`, upgraded to a uniform
+isomorphism between `α →ᵤ[𝔖] β × γ` and `(α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] γ)`. -/
+protected def uniform_equiv_prod_arrow [uniform_space γ] :
+  (α →ᵤ[𝔖] β × γ) ≃ᵤ ((α →ᵤ[𝔖] β) × (α →ᵤ[𝔖] γ)) :=
+-- Denote `φ` this bijection. We want to show that
+-- `comap φ (𝒱(α, β, 𝔖, uβ) × 𝒱(α, γ, 𝔖, uγ)) = 𝒱(α, β × γ, 𝔖, uβ × uγ)`.
+-- But `uβ × uγ` is defined as `comap fst uβ ⊓ comap snd uγ`, so we just have to apply
+-- `uniform_convergence_on.inf_eq` and `uniform_convergence_on.comap_eq`, which leaves us to check
+-- that some square commutes.
+-- We could also deduce this from `uniform_convergence.uniform_equiv_prod_arrow`, but it turns out
+-- to be more annoying.
+((uniform_on_fun.of_fun 𝔖).symm.trans $ (equiv.arrow_prod_equiv_prod_arrow _ _ _).trans $
+  (uniform_on_fun.of_fun 𝔖).prod_congr (uniform_on_fun.of_fun 𝔖))
+  .to_uniform_equiv_of_uniform_inducing
+begin
+  split,
+  rw [uniformity_prod, comap_inf, comap_comap, comap_comap, uniform_on_fun.inf_eq, inf_uniformity,
+    uniform_on_fun.comap_eq, uniform_on_fun.comap_eq, uniformity_comap, uniformity_comap],
+  refl -- the relevant diagram commutes by definition
+end
+
+variables (𝔖) (δ : ι → Type*) [Π i, uniform_space (δ i)]
+
+/-- The natural bijection between `α → Π i, δ i` and `Π i, α → δ i`, upgraded to a uniform
+isomorphism between `α →ᵤ[𝔖] (Π i, δ i)` and `Π i, α →ᵤ[𝔖] δ i`. -/
+protected def uniform_equiv_Pi_comm :
+  (α →ᵤ[𝔖] Π i, δ i) ≃ᵤ (Π i, α →ᵤ[𝔖] δ i)  :=
+-- Denote `φ` this bijection. We want to show that
+-- `comap φ (Π i, 𝒱(α, δ i, 𝔖, uδ i)) = 𝒱(α, (Π i, δ i), 𝔖, (Π i, uδ i))`.
+-- But `Π i, uδ i` is defined as `⨅ i, comap (eval i) (uδ i)`, so we just have to apply
+-- `uniform_convergence_on.infi_eq` and `uniform_convergence_on.comap_eq`, which leaves us to check
+-- that some square commutes.
+-- We could also deduce this from `uniform_convergence.uniform_equiv_Pi_comm`, but it turns out
+-- to be more annoying.
+(equiv.Pi_comm _).to_uniform_equiv_of_uniform_inducing
+begin
+  split,
+  change comap (prod.map function.swap function.swap) _ = _,
+  rw ← uniformity_comap,
+  congr,
+  rw [Pi.uniform_space, uniform_space.of_core_eq_to_core, Pi.uniform_space,
+      uniform_space.of_core_eq_to_core, uniform_space.comap_infi, uniform_on_fun.infi_eq],
+  refine infi_congr (λ i, _),
+  rw [← uniform_space.comap_comap, uniform_on_fun.comap_eq]
+  -- Like in the previous lemma, the diagram actually commutes by definition
+end
+
+end uniform_on_fun
diff --git a/src/topology/uniform_space/uniform_embedding.lean b/src/topology/uniform_space/uniform_embedding.lean
index 7764ede6e6918..863c6714f2b13 100644
--- a/src/topology/uniform_space/uniform_embedding.lean
+++ b/src/topology/uniform_space/uniform_embedding.lean
@@ -10,43 +10,130 @@ import topology.dense_embedding
 /-!
 # Uniform embeddings of uniform spaces.
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Extension of uniform continuous functions.
 -/
 
-open filter topological_space set classical
-open_locale classical uniformity topological_space filter
+open filter topological_space set function classical
+open_locale classical uniformity topology filter
 
 section
 variables {α : Type*} {β : Type*} {γ : Type*}
           [uniform_space α] [uniform_space β] [uniform_space γ]
-universe u
+universes u v
+
+/-!
+### Uniform inducing maps
+-/
 
 /-- A map `f : α → β` between uniform spaces is called *uniform inducing* if the uniformity filter
 on `α` is the pullback of the uniformity filter on `β` under `prod.map f f`. If `α` is a separated
 space, then this implies that `f` is injective, hence it is a `uniform_embedding`. -/
+@[mk_iff]
 structure uniform_inducing (f : α → β) : Prop :=
 (comap_uniformity : comap (λx:α×α, (f x.1, f x.2)) (𝓤 β) = 𝓤 α)
 
+protected lemma uniform_inducing.comap_uniform_space {f : α → β} (hf : uniform_inducing f) :
+  ‹uniform_space β›.comap f = ‹uniform_space α› :=
+uniform_space_eq hf.1
+
+lemma uniform_inducing_iff' {f : α → β} :
+  uniform_inducing f ↔ uniform_continuous f ∧ comap (prod.map f f) (𝓤 β) ≤ 𝓤 α :=
+by rw [uniform_inducing_iff, uniform_continuous, tendsto_iff_comap, le_antisymm_iff, and_comm]; refl
+
+protected lemma filter.has_basis.uniform_inducing_iff {ι ι'} {p : ι → Prop} {p' : ι' → Prop} {s s'}
+  (h : (𝓤 α).has_basis p s) (h' : (𝓤 β).has_basis p' s') {f : α → β} :
+  uniform_inducing f ↔
+    (∀ i, p' i → ∃ j, p j ∧ ∀ x y, (x, y) ∈ s j → (f x, f y) ∈ s' i) ∧
+      (∀ j, p j → ∃ i, p' i ∧ ∀ x y, (f x, f y) ∈ s' i → (x, y) ∈ s j) :=
+by simp [uniform_inducing_iff', h.uniform_continuous_iff h', (h'.comap _).le_basis_iff h,
+  subset_def]
+
 lemma uniform_inducing.mk' {f : α → β} (h : ∀ s, s ∈ 𝓤 α ↔
     ∃ t ∈ 𝓤 β, ∀ x y : α, (f x, f y) ∈ t → (x, y) ∈ s) : uniform_inducing f :=
 ⟨by simp [eq_comm, filter.ext_iff, subset_def, h]⟩
 
+lemma uniform_inducing_id : uniform_inducing (@id α) :=
+⟨by rw [← prod.map_def, prod.map_id, comap_id]⟩
+
 lemma uniform_inducing.comp {g : β → γ} (hg : uniform_inducing g)
   {f : α → β} (hf : uniform_inducing f) : uniform_inducing (g ∘ f) :=
-⟨ by rw [show (λ (x : α × α), ((g ∘ f) x.1, (g ∘ f) x.2)) =
-         (λ y : β × β, (g y.1, g y.2)) ∘ (λ x : α × α, (f x.1, f x.2)), by ext ; simp,
-        ← filter.comap_comap, hg.1, hf.1]⟩
+⟨by rw [← hf.1, ← hg.1, comap_comap]⟩
 
 lemma uniform_inducing.basis_uniformity {f : α → β} (hf : uniform_inducing f)
   {ι : Sort*} {p : ι → Prop} {s : ι → set (β × β)} (H : (𝓤 β).has_basis p s) :
   (𝓤 α).has_basis p (λ i, prod.map f f ⁻¹' s i) :=
 hf.1 ▸ H.comap _
 
+lemma uniform_inducing.cauchy_map_iff {f : α → β} (hf : uniform_inducing f) {F : filter α} :
+  cauchy (map f F) ↔ cauchy F :=
+by simp only [cauchy, map_ne_bot_iff, prod_map_map_eq, map_le_iff_le_comap, ← hf.comap_uniformity]
+
+lemma uniform_inducing_of_compose {f : α → β} {g : β → γ} (hf : uniform_continuous f)
+  (hg : uniform_continuous g) (hgf : uniform_inducing (g ∘ f)) : uniform_inducing f :=
+begin
+  refine ⟨le_antisymm _ hf.le_comap⟩,
+  rw [← hgf.1, ← prod.map_def, ← prod.map_def, ← prod.map_comp_map f f g g,
+      ← @comap_comap _ _ _ _ (prod.map f f)],
+  exact comap_mono hg.le_comap
+end
+
+lemma uniform_inducing.uniform_continuous {f : α → β}
+  (hf : uniform_inducing f) : uniform_continuous f :=
+(uniform_inducing_iff'.1 hf).1
+
+lemma uniform_inducing.uniform_continuous_iff {f : α → β} {g : β → γ} (hg : uniform_inducing g) :
+  uniform_continuous f ↔ uniform_continuous (g ∘ f) :=
+by { dsimp only [uniform_continuous, tendsto],
+  rw [← hg.comap_uniformity, ← map_le_iff_le_comap, filter.map_map] }
+
+protected lemma uniform_inducing.inducing {f : α → β} (h : uniform_inducing f) : inducing f :=
+begin
+  unfreezingI { obtain rfl := h.comap_uniform_space },
+  letI := uniform_space.comap f _,
+  exact ⟨rfl⟩
+end
+
+lemma uniform_inducing.prod {α' : Type*} {β' : Type*} [uniform_space α'] [uniform_space β']
+  {e₁ : α → α'} {e₂ : β → β'} (h₁ : uniform_inducing e₁) (h₂ : uniform_inducing e₂) :
+  uniform_inducing (λp:α×β, (e₁ p.1, e₂ p.2)) :=
+⟨by simp [(∘), uniformity_prod, h₁.comap_uniformity.symm, h₂.comap_uniformity.symm,
+           comap_inf, comap_comap]⟩
+
+lemma uniform_inducing.dense_inducing {f : α → β} (h : uniform_inducing f) (hd : dense_range f) :
+  dense_inducing f :=
+{ dense   := hd,
+  induced := h.inducing.induced }
+
+protected lemma uniform_inducing.injective [t0_space α] {f : α → β} (h : uniform_inducing f) :
+  injective f :=
+h.inducing.injective
+
 /-- A map `f : α → β` between uniform spaces is a *uniform embedding* if it is uniform inducing and
 injective. If `α` is a separated space, then the latter assumption follows from the former. -/
+@[mk_iff]
 structure uniform_embedding (f : α → β) extends uniform_inducing f : Prop :=
 (inj : function.injective f)
 
+theorem uniform_embedding_iff' {f : α → β} :
+  uniform_embedding f ↔ injective f ∧ uniform_continuous f ∧ comap (prod.map f f) (𝓤 β) ≤ 𝓤 α :=
+by rw [uniform_embedding_iff, and_comm, uniform_inducing_iff']
+
+theorem filter.has_basis.uniform_embedding_iff' {ι ι'} {p : ι → Prop} {p' : ι' → Prop} {s s'}
+  (h : (𝓤 α).has_basis p s) (h' : (𝓤 β).has_basis p' s') {f : α → β} :
+  uniform_embedding f ↔ injective f ∧
+    (∀ i, p' i → ∃ j, p j ∧ ∀ x y, (x, y) ∈ s j → (f x, f y) ∈ s' i) ∧
+      (∀ j, p j → ∃ i, p' i ∧ ∀ x y, (f x, f y) ∈ s' i → (x, y) ∈ s j) :=
+by rw [uniform_embedding_iff, and_comm, h.uniform_inducing_iff h']
+
+theorem filter.has_basis.uniform_embedding_iff {ι ι'} {p : ι → Prop} {p' : ι' → Prop} {s s'}
+  (h : (𝓤 α).has_basis p s) (h' : (𝓤 β).has_basis p' s') {f : α → β} :
+  uniform_embedding f ↔ injective f ∧ uniform_continuous f ∧
+      (∀ j, p j → ∃ i, p' i ∧ ∀ x y, (f x, f y) ∈ s' i → (x, y) ∈ s j) :=
+by simp only [h.uniform_embedding_iff' h', h.uniform_continuous_iff h', exists_prop]
+
 lemma uniform_embedding_subtype_val {p : α → Prop} :
   uniform_embedding (subtype.val : subtype p → α) :=
 { comap_uniformity := rfl,
@@ -67,79 +154,38 @@ lemma uniform_embedding.comp {g : β → γ} (hg : uniform_embedding g)
 { inj := hg.inj.comp hf.inj,
   ..hg.to_uniform_inducing.comp hf.to_uniform_inducing }
 
-theorem uniform_embedding_def {f : α → β} :
-  uniform_embedding f ↔ function.injective f ∧ ∀ s, s ∈ 𝓤 α ↔
-    ∃ t ∈ 𝓤 β, ∀ x y : α, (f x, f y) ∈ t → (x, y) ∈ s :=
-begin
-  split,
-  { rintro ⟨⟨h⟩, h'⟩,
-    rw [eq_comm, filter.ext_iff] at h,
-    simp [*, subset_def] },
-  { rintro ⟨h, h'⟩,
-    refine uniform_embedding.mk ⟨_⟩ h,
-    rw [eq_comm, filter.ext_iff],
-    simp [*, subset_def] }
-end
-
-theorem uniform_embedding_def' {f : α → β} :
-  uniform_embedding f ↔ function.injective f ∧ uniform_continuous f ∧
-    ∀ s, s ∈ 𝓤 α →
-      ∃ t ∈ 𝓤 β, ∀ x y : α, (f x, f y) ∈ t → (x, y) ∈ s :=
-by simp only [uniform_embedding_def, uniform_continuous_def]; exact
-⟨λ ⟨I, H⟩, ⟨I, λ s su, (H _).2 ⟨s, su, λ x y, id⟩, λ s, (H s).1⟩,
- λ ⟨I, H₁, H₂⟩, ⟨I, λ s, ⟨H₂ s,
-   λ ⟨t, tu, h⟩, mem_of_superset (H₁ t tu) (λ ⟨a, b⟩, h a b)⟩⟩⟩
-
 lemma equiv.uniform_embedding {α β : Type*} [uniform_space α] [uniform_space β] (f : α ≃ β)
   (h₁ : uniform_continuous f) (h₂ : uniform_continuous f.symm) : uniform_embedding f :=
-{ comap_uniformity :=
-  begin
-    refine le_antisymm _ _,
-    { change comap (f.prod_congr f) _ ≤ _,
-      rw ← map_equiv_symm (f.prod_congr f),
-      exact h₂ },
-    { rw ← map_le_iff_le_comap,
-      exact h₁ }
-  end,
-  inj := f.injective }
+uniform_embedding_iff'.2 ⟨f.injective, h₁, by rwa [← equiv.prod_congr_apply, ← map_equiv_symm]⟩
 
 theorem uniform_embedding_inl : uniform_embedding (sum.inl : α → α ⊕ β) :=
 begin
-  apply uniform_embedding_def.2 ⟨sum.inl_injective, λ s, ⟨_, _⟩⟩,
-  { assume hs,
-    refine ⟨(λ p : α × α, (sum.inl p.1, sum.inl p.2)) '' s ∪
-      (λ p : β × β, (sum.inr p.1, sum.inr p.2)) '' univ, _, _⟩,
-    { exact union_mem_uniformity_sum hs univ_mem },
-    { simp } },
-  { rintros ⟨t, ht, h't⟩,
-    simp only [sum.uniformity, mem_sup, mem_map] at ht,
-    apply filter.mem_of_superset ht.1,
-    rintros ⟨x, y⟩ hx,
-    exact h't _ _ hx }
+  refine ⟨⟨_⟩, sum.inl_injective⟩,
+  rw [sum.uniformity, comap_sup, comap_map, comap_eq_bot_iff_compl_range.2 _, sup_bot_eq],
+  { refine mem_map.2 (univ_mem' _),
+    simp },
+  { exact sum.inl_injective.prod_map sum.inl_injective }
 end
 
 theorem uniform_embedding_inr : uniform_embedding (sum.inr : β → α ⊕ β) :=
 begin
-  apply uniform_embedding_def.2 ⟨sum.inr_injective, λ s, ⟨_, _⟩⟩,
-  { assume hs,
-    refine ⟨(λ p : α × α, (sum.inl p.1, sum.inl p.2)) '' univ ∪
-      (λ p : β × β, (sum.inr p.1, sum.inr p.2)) '' s, _, _⟩,
-    { exact union_mem_uniformity_sum univ_mem hs },
-    { simp } },
-  { rintros ⟨t, ht, h't⟩,
-    simp only [sum.uniformity, mem_sup, mem_map] at ht,
-    apply filter.mem_of_superset ht.2,
-    rintros ⟨x, y⟩ hx,
-    exact h't _ _ hx }
+  refine ⟨⟨_⟩, sum.inr_injective⟩,
+  rw [sum.uniformity, comap_sup, comap_eq_bot_iff_compl_range.2 _, comap_map, bot_sup_eq],
+  { exact sum.inr_injective.prod_map sum.inr_injective },
+  { refine mem_map.2 (univ_mem' _),
+    simp },
 end
 
 /-- If the domain of a `uniform_inducing` map `f` is a `separated_space`, then `f` is injective,
 hence it is a `uniform_embedding`. -/
-protected theorem uniform_inducing.uniform_embedding [separated_space α] {f : α → β}
+protected theorem uniform_inducing.uniform_embedding [t0_space α] {f : α → β}
   (hf : uniform_inducing f) :
   uniform_embedding f :=
-⟨hf, λ x y h, eq_of_uniformity_basis (hf.basis_uniformity (𝓤 β).basis_sets) $
-  λ s hs, mem_preimage.2 $ mem_uniformity_of_eq hs h⟩
+⟨hf, hf.injective⟩
+
+theorem uniform_embedding_iff_uniform_inducing [t0_space α] {f : α → β} :
+  uniform_embedding f ↔ uniform_inducing f :=
+⟨uniform_embedding.to_uniform_inducing, uniform_inducing.uniform_embedding⟩
 
 /-- If a map `f : α → β` sends any two distinct points to point that are **not** related by a fixed
 `s ∈ 𝓤 β`, then `f` is uniform inducing with respect to the discrete uniformity on `α`:
@@ -153,7 +199,7 @@ begin
   calc comap (prod.map f f) (𝓤 β) ≤ comap (prod.map f f) (𝓟 s) : comap_mono (le_principal_iff.2 hs)
   ... = 𝓟 (prod.map f f ⁻¹' s) : comap_principal
   ... ≤ 𝓟 id_rel : principal_mono.2 _,
-  rintro ⟨x, y⟩, simpa [not_imp_not] using hf x y
+  rintro ⟨x, y⟩, simpa [not_imp_not] using @hf x y
 end
 
 /-- If a map `f : α → β` sends any two distinct points to point that are **not** related by a fixed
@@ -162,39 +208,12 @@ lemma uniform_embedding_of_spaced_out {α} {f : α → β} {s : set (β × β)}
   (hf : pairwise (λ x y, (f x, f y) ∉ s)) :
   @uniform_embedding α β ⊥ ‹_› f :=
 begin
-  letI : uniform_space α := ⊥, haveI : separated_space α := separated_iff_t2.2 infer_instance,
+  letI : uniform_space α := ⊥, haveI := discrete_topology_bot α,
+  haveI : separated_space α := separated_iff_t2.2 infer_instance,
   exact uniform_inducing.uniform_embedding ⟨comap_uniformity_of_spaced_out hs hf⟩
 end
 
-lemma uniform_inducing.uniform_continuous {f : α → β}
-  (hf : uniform_inducing f) : uniform_continuous f :=
-by simp [uniform_continuous, hf.comap_uniformity.symm, tendsto_comap]
-
-lemma uniform_inducing.uniform_continuous_iff {f : α → β} {g : β → γ} (hg : uniform_inducing g) :
-  uniform_continuous f ↔ uniform_continuous (g ∘ f) :=
-by { dsimp only [uniform_continuous, tendsto],
-  rw [← hg.comap_uniformity, ← map_le_iff_le_comap, filter.map_map] }
-
-lemma uniform_inducing.inducing {f : α → β} (h : uniform_inducing f) : inducing f :=
-begin
-  refine ⟨eq_of_nhds_eq_nhds $ assume a, _ ⟩,
-  rw [nhds_induced, nhds_eq_uniformity, nhds_eq_uniformity, ← h.comap_uniformity,
-    comap_lift'_eq, comap_lift'_eq2];
-    { refl <|> exact monotone_preimage }
-end
-
-lemma uniform_inducing.prod {α' : Type*} {β' : Type*} [uniform_space α'] [uniform_space β']
-  {e₁ : α → α'} {e₂ : β → β'} (h₁ : uniform_inducing e₁) (h₂ : uniform_inducing e₂) :
-  uniform_inducing (λp:α×β, (e₁ p.1, e₂ p.2)) :=
-⟨by simp [(∘), uniformity_prod, h₁.comap_uniformity.symm, h₂.comap_uniformity.symm,
-           comap_inf, comap_comap]⟩
-
-lemma uniform_inducing.dense_inducing {f : α → β} (h : uniform_inducing f) (hd : dense_range f) :
-  dense_inducing f :=
-{ dense   := hd,
-  induced := h.inducing.induced }
-
-lemma uniform_embedding.embedding {f : α → β} (h : uniform_embedding f) : embedding f :=
+protected lemma uniform_embedding.embedding {f : α → β} (h : uniform_embedding f) : embedding f :=
 { induced := h.to_uniform_inducing.inducing.induced,
   inj := h.inj }
 
@@ -217,7 +236,7 @@ end
 lemma closure_image_mem_nhds_of_uniform_inducing
   {s : set (α×α)} {e : α → β} (b : β)
   (he₁ : uniform_inducing e) (he₂ : dense_inducing e) (hs : s ∈ 𝓤 α) :
-  ∃a, closure (e '' {a' | (a, a') ∈ s}) ∈ 𝓝 b :=
+  ∃ a, closure (e '' {a' | (a, a') ∈ s}) ∈ 𝓝 b :=
 have s ∈ comap (λp:α×α, (e p.1, e p.2)) (𝓤 β),
   from he₁.comap_uniformity.symm ▸ hs,
 let ⟨t₁, ht₁u, ht₁⟩ := this in
@@ -319,6 +338,13 @@ lemma is_closed.complete_space_coe [complete_space α] {s : set α} (hs : is_clo
   complete_space s :=
 hs.is_complete.complete_space_coe
 
+/-- The lift of a complete space to another universe is still complete. -/
+instance ulift.complete_space [h : complete_space α] : complete_space (ulift α) :=
+begin
+  have : uniform_embedding (@equiv.ulift α), from ⟨⟨rfl⟩, ulift.down_injective⟩,
+  exact (complete_space_congr this).2 h,
+end
+
 lemma complete_space_extension {m : β → α} (hm : uniform_inducing m) (dense : dense_range m)
   (h : ∀f:filter β, cauchy f → ∃x:α, map m f ≤ 𝓝 x) : complete_space α :=
 ⟨assume (f : filter α), assume hf : cauchy f,
@@ -401,16 +427,9 @@ end
 instance complete_space.sum [complete_space α] [complete_space β] :
   complete_space (α ⊕ β) :=
 begin
-  rw complete_space_iff_is_complete_univ,
-  have A : is_complete (range (sum.inl : α → α ⊕ β)) :=
-    uniform_embedding_inl.to_uniform_inducing.is_complete_range,
-  have B : is_complete (range (sum.inr : β → α ⊕ β)) :=
-    uniform_embedding_inr.to_uniform_inducing.is_complete_range,
-  convert A.union B,
-  apply (eq_univ_of_forall (λ x, _)).symm,
-  cases x,
-  { left, exact mem_range_self _ },
-  { right, exact mem_range_self _ }
+  rw [complete_space_iff_is_complete_univ, ← range_inl_union_range_inr],
+  exact uniform_embedding_inl.to_uniform_inducing.is_complete_range.union
+    uniform_embedding_inr.to_uniform_inducing.is_complete_range
 end
 
 end
@@ -495,7 +514,7 @@ by simpa only [dense_inducing.extend] using tendsto_nhds_lim (uniformly_extend_e
 lemma uniform_continuous_uniformly_extend [cγ : complete_space γ] : uniform_continuous ψ :=
 assume d hd,
 let ⟨s, hs, hs_comp⟩ := (mem_lift'_sets $
-  monotone_comp_rel monotone_id $ monotone_comp_rel monotone_id monotone_id).mp
+  monotone_id.comp_rel $ monotone_id.comp_rel monotone_id).mp
     (comp_le_uniformity3 hd) in
 have h_pnt : ∀{a m}, m ∈ 𝓝 a → ∃c, c ∈ f '' preimage e m ∧ (c, ψ a) ∈ s ∧ (ψ a, c) ∈ s,
   from assume a m hm,
diff --git a/src/topology/unit_interval.lean b/src/topology/unit_interval.lean
index 7a858b6b679e0..0990b7e7a59dd 100644
--- a/src/topology/unit_interval.lean
+++ b/src/topology/unit_interval.lean
@@ -6,10 +6,14 @@ Authors: Patrick Massot, Scott Morrison
 import topology.instances.real
 import topology.algebra.field
 import data.set.intervals.proj_Icc
+import data.set.intervals.instances
 
 /-!
 # The unit interval, as a topological space
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 Use `open_locale unit_interval` to turn on the notation `I := set.Icc (0 : ℝ) (1 : ℝ)`.
 
 We provide basic instances, as well as a custom tactic for discharging
@@ -18,15 +22,15 @@ We provide basic instances, as well as a custom tactic for discharging
 -/
 
 noncomputable theory
-open_locale classical topological_space filter
-open set int
+open_locale classical topology filter
+open set int set.Icc
 
 /-! ### The unit interval -/
 
 /-- The unit interval `[0,1]` in ℝ. -/
 abbreviation unit_interval : set ℝ := set.Icc 0 1
 
-localized "notation `I` := unit_interval" in unit_interval
+localized "notation (name := unit_interval) `I` := unit_interval" in unit_interval
 
 namespace unit_interval
 
@@ -50,25 +54,11 @@ end
 
 instance has_zero : has_zero I := ⟨⟨0, zero_mem⟩⟩
 
-@[simp, norm_cast] lemma coe_zero : ((0 : I) : ℝ) = 0 := rfl
-
-@[simp] lemma mk_zero (h : (0 : ℝ) ∈ Icc (0 : ℝ) 1) : (⟨0, h⟩ : I) = 0 := rfl
-
-@[simp, norm_cast] lemma coe_eq_zero {x : I} : (x : ℝ) = 0 ↔ x = 0 :=
-by { symmetry, exact subtype.ext_iff }
-
 instance has_one : has_one I := ⟨⟨1, by split ; norm_num⟩⟩
 
-@[simp, norm_cast] lemma coe_one : ((1 : I) : ℝ) = 1 := rfl
-
 lemma coe_ne_zero {x : I} : (x : ℝ) ≠ 0 ↔ x ≠ 0 :=
 not_iff_not.mpr coe_eq_zero
 
-@[simp] lemma mk_one (h : (1 : ℝ) ∈ Icc (0 : ℝ) 1) : (⟨1, h⟩ : I) = 1 := rfl
-
-@[simp, norm_cast] lemma coe_eq_one {x : I} : (x : ℝ) = 1 ↔ x = 1 :=
-by { symmetry, exact subtype.ext_iff }
-
 lemma coe_ne_one {x : I} : (x : ℝ) ≠ 1 ↔ x ≠ 1 :=
 not_iff_not.mpr coe_eq_one
 
@@ -76,8 +66,6 @@ instance : nonempty I := ⟨0⟩
 
 instance : has_mul I := ⟨λ x y, ⟨x * y, mul_mem x.2 y.2⟩⟩
 
-@[simp, norm_cast] lemma coe_mul {x y : I} : ((x * y : I) : ℝ) = x * y := rfl
-
 -- todo: we could set up a `linear_ordered_comm_monoid_with_zero I` instance
 
 lemma mul_le_left {x y : I} : x * y ≤ x :=
@@ -89,7 +77,7 @@ subtype.coe_le_coe.mp $ (mul_le_mul_of_nonneg_right x.2.2 y.2.1).trans_eq $ one_
 /-- Unit interval central symmetry. -/
 def symm : I → I := λ t, ⟨1 - t, mem_iff_one_sub_mem.mp t.prop⟩
 
-localized "notation `σ` := unit_interval.symm" in unit_interval
+localized "notation (name := unit_interval.symm) `σ` := unit_interval.symm" in unit_interval
 
 @[simp] lemma symm_zero : σ 0 = 1 :=
 subtype.ext $ by simp [symm]
@@ -116,6 +104,8 @@ lemma nonneg (x : I) : 0 ≤ (x : ℝ) := x.2.1
 lemma one_minus_nonneg (x : I) : 0 ≤ 1 - (x : ℝ) := by simpa using x.2.2
 lemma le_one (x : I) : (x : ℝ) ≤ 1 := x.2.2
 lemma one_minus_le_one (x : I) : 1 - (x : ℝ) ≤ 1 := by simpa using x.2.1
+lemma add_pos {t : I} {x : ℝ} (hx : 0 < x) : 0 < (x + t : ℝ) :=
+add_pos_of_pos_of_nonneg hx $ nonneg _
 
 /-- like `unit_interval.nonneg`, but with the inequality in `I`. -/
 lemma nonneg' {t : I} : 0 ≤ t := t.2.1
@@ -125,7 +115,7 @@ lemma le_one' {t : I} : t ≤ 1 := t.2.2
 lemma mul_pos_mem_iff {a t : ℝ} (ha : 0 < a) : a * t ∈ I ↔ t ∈ set.Icc (0 : ℝ) (1/a) :=
 begin
   split; rintros ⟨h₁, h₂⟩; split,
-  { exact nonneg_of_mul_nonneg_left h₁ ha },
+  { exact nonneg_of_mul_nonneg_right h₁ ha },
   { rwa [le_div_iff ha, mul_comm] },
   { exact mul_nonneg ha.le h₁ },
   { rwa [le_div_iff ha, mul_comm] at h₂ }
diff --git a/src/topology/urysohns_bounded.lean b/src/topology/urysohns_bounded.lean
index 1d497be696a06..c0ae5baa0a4f5 100644
--- a/src/topology/urysohns_bounded.lean
+++ b/src/topology/urysohns_bounded.lean
@@ -9,6 +9,9 @@ import topology.continuous_function.bounded
 /-!
 # Urysohn's lemma for bounded continuous functions
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we reformulate Urysohn's lemma `exists_continuous_zero_one_of_closed` in terms of
 bounded continuous functions `X →ᵇ ℝ`. These lemmas live in a separate file because
 `topology.continuous_function.bounded` imports too many other files.
diff --git a/src/topology/urysohns_lemma.lean b/src/topology/urysohns_lemma.lean
index fee103e9d2dd1..86952bc44ec7b 100644
--- a/src/topology/urysohns_lemma.lean
+++ b/src/topology/urysohns_lemma.lean
@@ -10,6 +10,9 @@ import topology.continuous_function.basic
 /-!
 # Urysohn's lemma
 
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
 In this file we prove Urysohn's lemma `exists_continuous_zero_one_of_closed`: for any two disjoint
 closed sets `s` and `t` in a normal topological space `X` there exists a continuous function
 `f : X → ℝ` such that
@@ -71,7 +74,7 @@ Urysohn's lemma, normal topological space
 variables {X : Type*} [topological_space X]
 
 open set filter topological_space
-open_locale topological_space filter
+open_locale topology filter
 
 namespace urysohns
 
@@ -268,7 +271,7 @@ begin
       refine (div_le_div_of_le_of_nonneg
         (add_le_add (div_le_div_of_le_of_nonneg hydl zero_le_two) hydr) zero_le_two).trans_eq _,
       generalize : (3 / 4 : ℝ) ^ n = r,
-      field_simp [(@zero_lt_two ℝ _ _).ne'], ring } }
+      field_simp [(two_ne_zero' ℝ)], ring } }
 end
 
 end CU
@@ -289,7 +292,7 @@ lemma exists_continuous_zero_one_of_closed {s t : set X} (hs : is_closed s) (ht
   ∃ f : C(X, ℝ), eq_on f 0 s ∧ eq_on f 1 t ∧ ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
 begin
   -- The actual proof is in the code above. Here we just repack it into the expected format.
-  set c : urysohns.CU X := ⟨s, tᶜ, hs, ht.is_open_compl, λ _, disjoint_left.1 hd⟩,
+  set c : urysohns.CU X := ⟨s, tᶜ, hs, ht.is_open_compl, disjoint_left.1 hd⟩,
   exact ⟨⟨c.lim, c.continuous_lim⟩, c.lim_of_mem_C,
     λ x hx, c.lim_of_nmem_U _ (λ h, h hx), c.lim_mem_Icc⟩
 end
diff --git a/src/topology/vector_bundle.lean b/src/topology/vector_bundle.lean
deleted file mode 100644
index 9a62e373990ca..0000000000000
--- a/src/topology/vector_bundle.lean
+++ /dev/null
@@ -1,1015 +0,0 @@
-/-
-Copyright © 2020 Nicolò Cavalleri. All rights reserved.
-Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Nicolò Cavalleri, Sebastien Gouezel, Heather Macbeth, Patrick Massot
--/
-
-import analysis.normed_space.bounded_linear_maps
-import topology.fiber_bundle
-
-/-!
-# Topological vector bundles
-
-In this file we define topological vector bundles.
-
-Let `B` be the base space. In our formalism, a topological vector bundle is by definition the type
-`bundle.total_space E` where `E : B → Type*` is a function associating to
-`x : B` the fiber over `x`. This type `bundle.total_space E` is just a type synonym for
-`Σ (x : B), E x`, with the interest that one can put another topology than on `Σ (x : B), E x`
-which has the disjoint union topology.
-
-To have a topological vector bundle structure on `bundle.total_space E`, one should
-additionally have the following data:
-
-* `F` should be a normed space over a normed field `R`;
-* There should be a topology on `bundle.total_space E`, for which the projection to `B` is
-a topological fiber bundle with fiber `F` (in particular, each fiber `E x` is homeomorphic to `F`);
-* For each `x`, the fiber `E x` should be a topological vector space over `R`, and the injection
-from `E x` to `bundle.total_space F E` should be an embedding;
-* There should be a distinguished set of bundle trivializations (which are continuous linear equivs
-in the fibres), the "trivialization atlas"
-* There should be a choice of bundle trivialization at each point, which belongs to this atlas.
-
-If all these conditions are satisfied, and if moreover for any two trivializations `e`, `e'` in the
-atlas the transition function considered as a map from `B` into `F →L[R] F` is continuous on
-`e.base_set ∩ e'.base_set` with respect to the operator norm topology on `F →L[R] F`, we register
-the typeclass `topological_vector_bundle R F E`.
-
-If `E₁ : B → Type*` and `E₂ : B → Type*` define two topological vector bundles over `R` with fiber
-models `F₁` and `F₂`, denote by `E₁ ×ᵇ E₂` the sigma type of direct sums, with fiber
-`E x := (E₁ x × E₂ x)`. We can endow `bundle.total_space (E₁ ×ᵇ E₂)` with a topological vector
-bundle structure, `bundle.prod.topological_vector_bundle`.
-
-A similar construction (which is yet to be formalized) can be done for the vector bundle of
-continuous linear maps from `E₁ x` to `E₂ x` with fiber a type synonym
-`vector_bundle_continuous_linear_map R F₁ E₁ F₂ E₂ x := (E₁ x →L[R] E₂ x)` (and with the
-topology inherited from the norm-topology on `F₁ →L[R] F₂`, without the need to define the strong
-topology on continuous linear maps between general topological vector spaces).  Likewise for tensor
-products of topological vector bundles, exterior algebras, and so on, where the topology can be
-defined using a norm on the fiber model if this helps.
-
-## Tags
-Vector bundle
--/
-
-noncomputable theory
-
-open bundle set
-
-variables (R : Type*) {B : Type*} (F : Type*) (E : B → Type*)
-
-section topological_vector_space
-variables [semiring R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
-  [topological_space F] [add_comm_monoid F] [module R F] [topological_space B]
-
-/-- Local pretrivialization for vector prebundles. -/
-@[nolint has_inhabited_instance]
-structure topological_vector_bundle.pretrivialization extends to_fiber_bundle_pretrivialization :
-  topological_fiber_bundle.pretrivialization F (proj E) :=
-(linear : ∀ x ∈ base_set, is_linear_map R (λ y : (E x), (to_fun y).2))
-
-instance : has_coe_to_fun (topological_vector_bundle.pretrivialization R F E) _ := ⟨λ e, e.to_fun⟩
-
-instance : has_coe (topological_vector_bundle.pretrivialization R F E)
-  (topological_fiber_bundle.pretrivialization F (proj E)) :=
-⟨topological_vector_bundle.pretrivialization.to_fiber_bundle_pretrivialization⟩
-
-variable [topological_space (total_space E)]
-
-/-- Local trivialization for vector bundles. -/
-@[nolint has_inhabited_instance]
-structure topological_vector_bundle.trivialization extends to_fiber_bundle_trivialization :
-  topological_fiber_bundle.trivialization F (proj E) :=
-(linear : ∀ x ∈ base_set, is_linear_map R (λ y : (E x), (to_fun y).2))
-
-open topological_vector_bundle
-
-instance : has_coe_to_fun (trivialization R F E) (λ _, total_space E → B × F) := ⟨λ e, e.to_fun⟩
-
-instance : has_coe (trivialization R F E) (topological_fiber_bundle.trivialization F (proj E)) :=
-⟨topological_vector_bundle.trivialization.to_fiber_bundle_trivialization⟩
-
-namespace topological_vector_bundle
-
-variables {R F E}
-
-/-- Natural identification as `topological_vector_bundle.pretrivialization`. -/
-def trivialization.to_pretrivialization (e : trivialization R F E) :
-  topological_vector_bundle.pretrivialization R F E := { ..e }
-
-lemma trivialization.mem_source (e : trivialization R F E)
-  {x : total_space E} : x ∈ e.source ↔ proj E x ∈ e.base_set :=
-topological_fiber_bundle.trivialization.mem_source e
-
-@[simp, mfld_simps] lemma trivialization.coe_coe (e : trivialization R F E) :
-  ⇑e.to_local_homeomorph = e := rfl
-
-@[simp, mfld_simps] lemma trivialization.coe_fst (e : trivialization R F E) {x : total_space E}
-  (ex : x ∈ e.source) : (e x).1 = (proj E) x := e.proj_to_fun x ex
-
-end topological_vector_bundle
-
-end topological_vector_space
-
-section
-open topological_vector_bundle
-
-variables (B)
-variables [nondiscrete_normed_field R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
-  [normed_group F] [normed_space R F] [topological_space B]
-  [topological_space (total_space E)] [∀ x, topological_space (E x)]
-
-/-- The valid transition functions for a topological vector bundle over `B` modelled on
-a normed space `F`: a transition function must be a local homeomorphism of `B × F` with source and
-target both `s ×ˢ univ`, which on this set is of the form `λ (b, v), (b, ε b v)` for some continuous
-map `ε` from `s` to `F ≃L[R] F`.  Here continuity is with respect to the operator norm on
-`F →L[R] F`. -/
-def continuous_transitions (e : local_equiv (B × F) (B × F)) : Prop :=
-∃ s : set B, e.source = s ×ˢ (univ : set F) ∧ e.target = s ×ˢ (univ : set F)
-    ∧ ∃ ε : B → (F ≃L[R] F), continuous_on (λ b, (ε b : F →L[R] F)) s
-      ∧ ∀ b ∈ s, ∀ v : F, e (b, v) = (b, ε b v)
-
-variables {B}
-
-/-- The space `total_space E` (for `E : B → Type*` such that each `E x` is a topological vector
-space) has a topological vector space structure with fiber `F` (denoted with
-`topological_vector_bundle R F E`) if around every point there is a fiber bundle trivialization
-which is linear in the fibers. -/
-class topological_vector_bundle :=
-(total_space_mk_inducing [] : ∀ (b : B), inducing (total_space_mk E b))
-(trivialization_atlas [] : set (trivialization R F E))
-(trivialization_at [] : B → trivialization R F E)
-(mem_base_set_trivialization_at [] : ∀ b : B, b ∈ (trivialization_at b).base_set)
-(trivialization_mem_atlas [] : ∀ b : B, trivialization_at b ∈ trivialization_atlas)
-(continuous_coord_change : ∀ e e' ∈ trivialization_atlas,
-  continuous_transitions R B F (e.to_local_equiv.symm.trans e'.to_local_equiv : _))
-
-export topological_vector_bundle (trivialization_atlas trivialization_at
-  mem_base_set_trivialization_at trivialization_mem_atlas)
-
-variable [topological_vector_bundle R F E]
-
-namespace topological_vector_bundle
-
-@[simp, mfld_simps] lemma mem_source_trivialization_at (z : total_space E) :
-  z ∈ (trivialization_at R F E z.1).source :=
-by { rw topological_fiber_bundle.trivialization.mem_source, apply mem_base_set_trivialization_at }
-
-variables {R F E}
-
-/-- The co-ordinate change (transition function) between two trivializations of a vector bundle
-over `B` modelled on `F`: this is a function from `B` to `F ≃L[R] F` (of course, only meaningful
-on the intersection of the domains of definition of the two trivializations). -/
-def coord_change {e e' : trivialization R F E} (he : e ∈ trivialization_atlas R F E)
-  (he' : e' ∈ trivialization_atlas R F E) :
-  B → F ≃L[R] F :=
-(topological_vector_bundle.continuous_coord_change e he e' he').some_spec.2.2.some
-
-lemma continuous_on_coord_change {e e' : trivialization R F E} (he : e ∈ trivialization_atlas R F E)
-  (he' : e' ∈ trivialization_atlas R F E) :
-  continuous_on (λ b, (coord_change he he' b : F →L[R] F)) (e.base_set ∩ e'.base_set) :=
-begin
-  let s := (continuous_coord_change e he e' he').some,
-  let hs := (continuous_coord_change e he e' he').some_spec.1,
-  have hs : s = e.base_set ∩ e'.base_set,
-  { have : s ×ˢ (univ : set F) = (e.base_set ∩ e'.base_set) ×ˢ (univ : set F) :=
-      hs.symm.trans (topological_fiber_bundle.trivialization.symm_trans_source_eq e e'),
-    have hF : (univ : set F).nonempty := univ_nonempty,
-      rwa prod_eq_iff_eq hF at this },
-  rw ← hs,
-  exact (continuous_coord_change e he e' he').some_spec.2.2.some_spec.1
-end
-
-lemma trans_eq_coord_change {e e' : trivialization R F E} (he : e ∈ trivialization_atlas R F E)
-  (he' : e' ∈ trivialization_atlas R F E) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
-  e' (e.to_local_homeomorph.symm (b, v)) = (b, coord_change he he' b v) :=
-begin
-  let s := (continuous_coord_change e he e' he').some,
-  let hs := (continuous_coord_change e he e' he').some_spec.1,
-  have hs : s = e.base_set ∩ e'.base_set,
-  { have : s ×ˢ (univ : set F) = (e.base_set ∩ e'.base_set) ×ˢ (univ : set F) :=
-      hs.symm.trans (topological_fiber_bundle.trivialization.symm_trans_source_eq e e'),
-    have hF : (univ : set F).nonempty := univ_nonempty,
-      rwa prod_eq_iff_eq hF at this },
-  rw ← hs at hb,
-  exact (continuous_coord_change e he e' he').some_spec.2.2.some_spec.2 b hb v
-end
-
-attribute [irreducible] coord_change
-
-namespace trivialization
-
-/-- In a topological vector bundle, a trivialization in the fiber (which is a priori only linear)
-is in fact a continuous linear equiv between the fibers and the model fiber. -/
-def continuous_linear_equiv_at (e : trivialization R F E) (b : B)
-  (hb : b ∈ e.base_set) : E b ≃L[R] F :=
-{ to_fun := λ y, (e ⟨b, y⟩).2,
-  inv_fun := λ z, begin
-    have : ((e.to_local_homeomorph.symm) (b, z)).fst = b :=
-      topological_fiber_bundle.trivialization.proj_symm_apply' _ hb,
-    have C : E ((e.to_local_homeomorph.symm) (b, z)).fst = E b, by rw this,
-    exact cast C (e.to_local_homeomorph.symm (b, z)).2
-  end,
-  left_inv := begin
-    assume v,
-    rw [← heq_iff_eq],
-    apply (cast_heq _ _).trans,
-    have A : (b, (e ⟨b, v⟩).snd) = e ⟨b, v⟩,
-    { refine prod.ext _ rfl,
-      symmetry,
-      exact topological_fiber_bundle.trivialization.coe_fst' _ hb },
-    have B : e.to_local_homeomorph.symm (e ⟨b, v⟩) = ⟨b, v⟩,
-    { apply local_homeomorph.left_inv_on,
-      rw topological_fiber_bundle.trivialization.mem_source,
-      exact hb },
-    rw [A, B],
-  end,
-  right_inv := begin
-    assume v,
-    have B : e (e.to_local_homeomorph.symm (b, v)) = (b, v),
-    { apply local_homeomorph.right_inv_on,
-      rw topological_fiber_bundle.trivialization.mem_target,
-      exact hb },
-    have C : (e (e.to_local_homeomorph.symm (b, v))).2 = v, by rw [B],
-    conv_rhs { rw ← C },
-    dsimp,
-    congr,
-    ext,
-    { exact (topological_fiber_bundle.trivialization.proj_symm_apply' _ hb).symm },
-    { exact (cast_heq _ _).trans (by refl) },
-  end,
-  map_add' := λ v w, (e.linear _ hb).map_add v w,
-  map_smul' := λ c v, (e.linear _ hb).map_smul c v,
-  continuous_to_fun := begin
-    refine continuous_snd.comp _,
-    apply continuous_on.comp_continuous e.to_local_homeomorph.continuous_on
-      (topological_vector_bundle.total_space_mk_inducing R F E b).continuous (λ x, _),
-    rw topological_fiber_bundle.trivialization.mem_source,
-    exact hb,
-  end,
-  continuous_inv_fun := begin
-    rw (topological_vector_bundle.total_space_mk_inducing R F E b).continuous_iff,
-    dsimp,
-    have : continuous (λ (z : F), e.to_fiber_bundle_trivialization.to_local_homeomorph.symm (b, z)),
-    { apply e.to_local_homeomorph.symm.continuous_on.comp_continuous
-        (continuous_const.prod_mk continuous_id') (λ z, _),
-      simp only [topological_fiber_bundle.trivialization.mem_target, hb, local_equiv.symm_source,
-        local_homeomorph.symm_to_local_equiv] },
-    convert this,
-    ext z,
-    { exact (topological_fiber_bundle.trivialization.proj_symm_apply' _ hb).symm },
-    { exact cast_heq _ _ },
-  end }
-
-@[simp] lemma continuous_linear_equiv_at_apply (e : trivialization R F E) (b : B)
-  (hb : b ∈ e.base_set) (y : E b) : e.continuous_linear_equiv_at b hb y = (e ⟨b, y⟩).2 := rfl
-
-@[simp] lemma continuous_linear_equiv_at_apply' (e : trivialization R F E)
-  (x : total_space E) (hx : x ∈ e.source) :
-  e.continuous_linear_equiv_at (proj E x) (e.mem_source.1 hx) x.2 = (e x).2 := by { cases x, refl }
-
-lemma apply_eq_prod_continuous_linear_equiv_at (e : trivialization R F E) (b : B)
-  (hb : b ∈ e.base_set) (z : E b) :
-  e.to_local_homeomorph ⟨b, z⟩ = (b, e.continuous_linear_equiv_at b hb z) :=
-begin
-  ext,
-  { convert e.coe_fst _,
-    rw e.source_eq,
-    exact hb },
-  { simp }
-end
-
-lemma symm_apply_eq_mk_continuous_linear_equiv_at_symm (e : trivialization R F E) (b : B)
-  (hb : b ∈ e.base_set) (z : F) :
-  e.to_local_homeomorph.symm ⟨b, z⟩
-  = total_space_mk E b ((e.continuous_linear_equiv_at b hb).symm z) :=
-begin
-  have h : (b, z) ∈ e.to_local_homeomorph.target,
-  { rw e.target_eq,
-    exact ⟨hb, mem_univ _⟩ },
-  apply e.to_local_homeomorph.inj_on (e.to_local_homeomorph.map_target h),
-  { simp [e.source_eq, hb] },
-  simp [-continuous_linear_equiv_at_apply, e.apply_eq_prod_continuous_linear_equiv_at b hb,
-    e.to_local_homeomorph.right_inv h],
-end
-
-lemma comp_continuous_linear_equiv_at_eq_coord_change {e e' : trivialization R F E}
-  (he : e ∈ trivialization_atlas R F E) (he' : e' ∈ trivialization_atlas R F E) {b : B}
-  (hb : b ∈ e.base_set ∩ e'.base_set) :
-  (e.continuous_linear_equiv_at b hb.1).symm.trans (e'.continuous_linear_equiv_at b hb.2)
-  = coord_change he he' b :=
-begin
-  ext v,
-  suffices :
-    (b, e'.continuous_linear_equiv_at b hb.2 ((e.continuous_linear_equiv_at b hb.1).symm v))
-    = (b, coord_change he he' b v),
-  { simpa using this },
-  rw [← trans_eq_coord_change he he' hb, ← apply_eq_prod_continuous_linear_equiv_at,
-    symm_apply_eq_mk_continuous_linear_equiv_at_symm],
-  refl,
-end
-
-end trivialization
-
-section
-local attribute [reducible] bundle.trivial
-
-instance {B : Type*} {F : Type*} [add_comm_monoid F] (b : B) :
-  add_comm_monoid (bundle.trivial B F b) := ‹add_comm_monoid F›
-
-instance {B : Type*} {F : Type*} [add_comm_group F] (b : B) :
-  add_comm_group (bundle.trivial B F b) := ‹add_comm_group F›
-
-instance {B : Type*} {F : Type*} [add_comm_monoid F] [module R F] (b : B) :
-  module R (bundle.trivial B F b) := ‹module R F›
-
-end
-
-variables (R B F)
-/-- Local trivialization for trivial bundle. -/
-def trivial_topological_vector_bundle.trivialization : trivialization R F (bundle.trivial B F) :=
-{ to_fun := λ x, (x.fst, x.snd),
-  inv_fun := λ y, ⟨y.fst, y.snd⟩,
-  source := univ,
-  target := univ,
-  map_source' := λ x h, mem_univ (x.fst, x.snd),
-  map_target' :=λ y h,  mem_univ ⟨y.fst, y.snd⟩,
-  left_inv' := λ x h, sigma.eq rfl rfl,
-  right_inv' := λ x h, prod.ext rfl rfl,
-  open_source := is_open_univ,
-  open_target := is_open_univ,
-  continuous_to_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
-    simp only [prod.topological_space, induced_inf, induced_compose], exact le_rfl, },
-  continuous_inv_fun := by { rw [←continuous_iff_continuous_on_univ, continuous_iff_le_induced],
-    simp only [bundle.total_space.topological_space, induced_inf, induced_compose],
-    exact le_rfl, },
-  base_set := univ,
-  open_base_set := is_open_univ,
-  source_eq := rfl,
-  target_eq := by simp only [univ_prod_univ],
-  proj_to_fun := λ y hy, rfl,
-  linear := λ x hx, ⟨λ y z, rfl, λ c y, rfl⟩ }
-
-@[simp]
-lemma trivial_topological_vector_bundle.trivialization_source :
-  (trivial_topological_vector_bundle.trivialization R B F).source = univ := rfl
-
-@[simp]
-lemma trivial_topological_vector_bundle.trivialization_target :
-  (trivial_topological_vector_bundle.trivialization R B F).target = univ := rfl
-
-instance trivial_bundle.topological_vector_bundle :
-  topological_vector_bundle R F (bundle.trivial B F) :=
-{ trivialization_atlas := {trivial_topological_vector_bundle.trivialization R B F},
-  trivialization_at := λ x, trivial_topological_vector_bundle.trivialization R B F,
-  mem_base_set_trivialization_at := mem_univ,
-  trivialization_mem_atlas := λ x, mem_singleton _,
-  total_space_mk_inducing := λ b, ⟨begin
-    have : (λ (x : trivial B F b), x) = @id F, by { ext x, refl },
-    simp only [total_space.topological_space, induced_inf, induced_compose, function.comp, proj,
-      induced_const, top_inf_eq, trivial.proj_snd, id.def, trivial.topological_space, this,
-      induced_id],
-  end⟩,
-  continuous_coord_change := begin
-    intros e he e' he',
-    rw [mem_singleton_iff.mp he, mem_singleton_iff.mp he'],
-    exact ⟨univ, by simp, by simp, λb, continuous_linear_equiv.refl R F,
-           continuous_const.continuous_on, λ b hb v, rfl⟩
-  end }
-
-variables {R B F}
-
-/- Not registered as an instance because of a metavariable. -/
-lemma is_topological_vector_bundle_is_topological_fiber_bundle :
-  is_topological_fiber_bundle F (proj E) :=
-λ x, ⟨(trivialization_at R F E x).to_fiber_bundle_trivialization,
-  mem_base_set_trivialization_at R F E x⟩
-
-variables (R B F)
-include R F
-@[continuity] lemma continuous_proj : continuous (proj E) :=
-begin
-  apply @is_topological_fiber_bundle.continuous_proj B F,
-  apply @is_topological_vector_bundle_is_topological_fiber_bundle R,
-end
-
-end topological_vector_bundle
-
-/-! ### Constructing topological vector bundles -/
-
-variables (B)
-
-/-- Analogous construction of `topological_fiber_bundle_core` for vector bundles. This
-construction gives a way to construct vector bundles from a structure registering how
-trivialization changes act on fibers. -/
-structure topological_vector_bundle_core (ι : Type*) :=
-(base_set          : ι → set B)
-(is_open_base_set  : ∀ i, is_open (base_set i))
-(index_at          : B → ι)
-(mem_base_set_at   : ∀ x, x ∈ base_set (index_at x))
-(coord_change      : ι → ι → B → (F →L[R] F))
-(coord_change_self : ∀ i, ∀ x ∈ base_set i, ∀ v, coord_change i i x v = v)
-(coord_change_continuous : ∀ i j, continuous_on (coord_change i j) (base_set i ∩ base_set j))
-(coord_change_comp : ∀ i j k, ∀ x ∈ (base_set i) ∩ (base_set j) ∩ (base_set k), ∀ v,
-  (coord_change j k x) (coord_change i j x v) = coord_change i k x v)
-
-/-- The trivial topological vector bundle core, in which all the changes of coordinates are the
-identity. -/
-def trivial_topological_vector_bundle_core (ι : Type*) [inhabited ι] :
-  topological_vector_bundle_core R B F ι :=
-{ base_set := λ ι, univ,
-  is_open_base_set := λ i, is_open_univ,
-  index_at := λ x, default,
-  mem_base_set_at := λ x, mem_univ x,
-  coord_change := λ i j x, continuous_linear_map.id R F,
-  coord_change_self := λ i x hx v, rfl,
-  coord_change_comp := λ i j k x hx v, rfl,
-  coord_change_continuous := λ i j, continuous_on_const, }
-
-instance (ι : Type*) [inhabited ι] : inhabited (topological_vector_bundle_core R B F ι) :=
-⟨trivial_topological_vector_bundle_core R B F ι⟩
-
-namespace topological_vector_bundle_core
-
-variables {R B F} {ι : Type*} (Z : topological_vector_bundle_core R B F ι)
-
-/-- Natural identification to a `topological_fiber_bundle_core`. -/
-def to_topological_vector_bundle_core : topological_fiber_bundle_core ι B F :=
-{ coord_change := λ i j b, Z.coord_change i j b,
-  coord_change_continuous := λ i j, is_bounded_bilinear_map_apply.continuous.comp_continuous_on
-      ((Z.coord_change_continuous i j).prod_map continuous_on_id),
-  ..Z }
-
-instance to_topological_vector_bundle_core_coe : has_coe (topological_vector_bundle_core R B F ι)
-  (topological_fiber_bundle_core ι B F) := ⟨to_topological_vector_bundle_core⟩
-
-include Z
-
-lemma coord_change_linear_comp (i j k : ι): ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j) ∩ (Z.base_set k),
-  (Z.coord_change j k x).comp (Z.coord_change i j x) = Z.coord_change i k x :=
-λ x hx, by { ext v, exact Z.coord_change_comp i j k x hx v }
-
-/-- The index set of a topological vector bundle core, as a convenience function for dot notation -/
-@[nolint unused_arguments has_inhabited_instance]
-def index := ι
-
-/-- The base space of a topological vector bundle core, as a convenience function for dot notation-/
-@[nolint unused_arguments, reducible]
-def base := B
-
-/-- The fiber of a topological vector bundle core, as a convenience function for dot notation and
-typeclass inference -/
-@[nolint unused_arguments has_inhabited_instance]
-def fiber (x : B) := F
-
-section fiber_instances
-
-local attribute [reducible] fiber --just to record instances
-
-instance topological_space_fiber (x : B) : topological_space (Z.fiber x) := by apply_instance
-instance add_comm_monoid_fiber : ∀ (x : B), add_comm_monoid (Z.fiber x) := λ x, by apply_instance
-instance module_fiber : ∀ (x : B), module R (Z.fiber x) := λ x, by apply_instance
-
-variable [add_comm_group F]
-
-instance add_comm_group_fiber : ∀ (x : B), add_comm_group (Z.fiber x) := λ x, by apply_instance
-
-end fiber_instances
-
-/-- The projection from the total space of a topological fiber bundle core, on its base. -/
-@[reducible, simp, mfld_simps] def proj : total_space Z.fiber → B := bundle.proj Z.fiber
-
-/-- The total space of the topological vector bundle, as a convenience function for dot notation.
-It is by definition equal to `bundle.total_space Z.fiber`, a.k.a. `Σ x, Z.fiber x` but with a
-different name for typeclass inference. -/
-@[nolint unused_arguments, reducible]
-def total_space := bundle.total_space Z.fiber
-
-/-- Local homeomorphism version of the trivialization change. -/
-def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
-topological_fiber_bundle_core.triv_change ↑Z i j
-
-@[simp, mfld_simps] lemma mem_triv_change_source (i j : ι) (p : B × F) :
-  p ∈ (Z.triv_change i j).source ↔ p.1 ∈ Z.base_set i ∩ Z.base_set j :=
-topological_fiber_bundle_core.mem_triv_change_source ↑Z i j p
-
-variable (ι)
-
-/-- Topological structure on the total space of a topological bundle created from core, designed so
-that all the local trivialization are continuous. -/
-instance to_topological_space : topological_space (Z.total_space) :=
-topological_fiber_bundle_core.to_topological_space ι ↑Z
-
-variables {ι} (b : B) (a : F)
-
-@[simp, mfld_simps] lemma coe_coord_change (i j : ι) :
-  topological_fiber_bundle_core.coord_change ↑Z i j b = Z.coord_change i j b := rfl
-
-/-- Extended version of the local trivialization of a fiber bundle constructed from core,
-registering additionally in its type that it is a local bundle trivialization. -/
-def local_triv (i : ι) : topological_vector_bundle.trivialization R F Z.fiber :=
-{ linear := λ x hx,
-  { map_add := λ v w, by simp only [continuous_linear_map.map_add] with mfld_simps,
-    map_smul := λ r v, by simp only [continuous_linear_map.map_smul] with mfld_simps},
-  ..topological_fiber_bundle_core.local_triv ↑Z i }
-
-variable (i : ι)
-
-@[simp, mfld_simps] lemma mem_local_triv_source (p : Z.total_space) :
-  p ∈ (Z.local_triv i).source ↔ p.1 ∈ Z.base_set i := iff.rfl
-
-@[simp, mfld_simps] lemma base_set_at : Z.base_set i = (Z.local_triv i).base_set := rfl
-
-@[simp, mfld_simps] lemma local_triv_apply (p : Z.total_space) :
-  (Z.local_triv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl
-
-@[simp, mfld_simps] lemma mem_local_triv_target (p : B × F) :
-  p ∈ (Z.local_triv i).target ↔ p.1 ∈ (Z.local_triv i).base_set :=
-topological_fiber_bundle_core.mem_local_triv_target Z i p
-
-@[simp, mfld_simps] lemma local_triv_symm_fst (p : B × F) :
-  (Z.local_triv i).to_local_homeomorph.symm p =
-    ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩ := rfl
-
-/-- Preferred local trivialization of a vector bundle constructed from core, at a given point, as
-a bundle trivialization -/
-def local_triv_at (b : B) : topological_vector_bundle.trivialization R F Z.fiber :=
-Z.local_triv (Z.index_at b)
-
-@[simp, mfld_simps] lemma local_triv_at_def :
-  Z.local_triv (Z.index_at b) = Z.local_triv_at b := rfl
-
-@[simp, mfld_simps] lemma mem_source_at : (⟨b, a⟩ : Z.total_space) ∈ (Z.local_triv_at b).source :=
-by { rw [local_triv_at, mem_local_triv_source], exact Z.mem_base_set_at b }
-
-@[simp, mfld_simps] lemma local_triv_at_apply : ((Z.local_triv_at b) ⟨b, a⟩) = ⟨b, a⟩ :=
-topological_fiber_bundle_core.local_triv_at_apply Z b a
-
-@[simp, mfld_simps] lemma mem_local_triv_at_base_set :
-  b ∈ (Z.local_triv_at b).base_set :=
-topological_fiber_bundle_core.mem_local_triv_at_base_set Z b
-
-instance : topological_vector_bundle R F Z.fiber :=
-{ total_space_mk_inducing := λ b, ⟨ begin refine le_antisymm _ (λ s h, _),
-    { rw ←continuous_iff_le_induced,
-      exact topological_fiber_bundle_core.continuous_total_space_mk ↑Z b, },
-    { refine is_open_induced_iff.mpr ⟨(Z.local_triv_at b).source ∩ (Z.local_triv_at b) ⁻¹'
-        ((Z.local_triv_at b).base_set ×ˢ s), (continuous_on_open_iff
-        (Z.local_triv_at b).open_source).mp (Z.local_triv_at b).continuous_to_fun _
-        ((Z.local_triv_at b).open_base_set.prod h), _⟩,
-      rw [preimage_inter, ←preimage_comp, function.comp],
-      simp only [total_space_mk],
-      refine ext_iff.mpr (λ a, ⟨λ ha, _, λ ha, ⟨Z.mem_base_set_at b, _⟩⟩),
-      { simp only [mem_prod, mem_preimage, mem_inter_eq, local_triv_at_apply] at ha,
-        exact ha.2.2, },
-      { simp only [mem_prod, mem_preimage, mem_inter_eq, local_triv_at_apply],
-        exact ⟨Z.mem_base_set_at b, ha⟩, } } end⟩,
-  trivialization_atlas := set.range Z.local_triv,
-  trivialization_at := Z.local_triv_at,
-  mem_base_set_trivialization_at := Z.mem_base_set_at,
-  trivialization_mem_atlas := λ b, ⟨Z.index_at b, rfl⟩,
-  continuous_coord_change := begin
-    classical,
-    rintros _ ⟨i, rfl⟩ _ ⟨i', rfl⟩,
-    refine ⟨Z.base_set i ∩ Z.base_set i', _, _,
-      λ b, if h : b ∈ Z.base_set i ∩ Z.base_set i' then continuous_linear_equiv.equiv_of_inverse
-        (Z.coord_change i i' b) (Z.coord_change i' i b) _ _ else continuous_linear_equiv.refl R F,
-      _, _⟩,
-    { ext ⟨b, f⟩,
-      simp },
-    { ext ⟨b, f⟩,
-      simp [and_comm] },
-    { intro f,
-      rw [Z.coord_change_comp _ _ _ _ ⟨h, h.1⟩, Z.coord_change_self _ _ h.1] },
-    { intro f,
-      rw [Z.coord_change_comp _ _ _ _ ⟨⟨h.2, h.1⟩, h.2⟩, Z.coord_change_self _ _ h.2] },
-    { apply continuous_on.congr (Z.coord_change_continuous i i'),
-      intros b hb,
-      simp [hb],
-      ext v,
-      refl },
-    { intros b hb v,
-      have : b ∈ Z.base_set i ∩ Z.base_set (Z.index_at b) ∩ Z.base_set i',
-      { simp only [base_set_at, local_triv_at_def, mem_inter_eq, mem_local_triv_at_base_set] at *,
-        tauto },
-      simp [hb, Z.coord_change_comp _ _ _ _ this] }
-  end }
-
-/-- The projection on the base of a topological vector bundle created from core is continuous -/
-@[continuity] lemma continuous_proj : continuous Z.proj :=
-topological_fiber_bundle_core.continuous_proj Z
-
-/-- The projection on the base of a topological vector bundle created from core is an open map -/
-lemma is_open_map_proj : is_open_map Z.proj :=
-topological_fiber_bundle_core.is_open_map_proj Z
-
-end topological_vector_bundle_core
-
-end
-
-/-! ### Topological vector prebundle -/
-
-section
-variables [nondiscrete_normed_field R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
-  [normed_group F] [normed_space R F] [topological_space B]
-  [∀ x, topological_space (E x)]
-
-open topological_space
-
-/-- This structure permits to define a vector bundle when trivializations are given as local
-equivalences but there is not yet a topology on the total space. The total space is hence given a
-topology in such a way that there is a fiber bundle structure for which the local equivalences
-are also local homeomorphisms and hence vector bundle trivializations. -/
-@[nolint has_inhabited_instance]
-structure topological_vector_prebundle :=
-(pretrivialization_atlas : set (topological_vector_bundle.pretrivialization R F E))
-(pretrivialization_at : B → topological_vector_bundle.pretrivialization R F E)
-(mem_base_pretrivialization_at : ∀ x : B, x ∈ (pretrivialization_at x).base_set)
-(pretrivialization_mem_atlas : ∀ x : B, pretrivialization_at x ∈ pretrivialization_atlas)
-(continuous_coord_change : ∀ e e' ∈ pretrivialization_atlas,
-  continuous_transitions R B F (e'.to_local_equiv.symm.trans e.to_local_equiv : _))
-(total_space_mk_inducing : ∀ (b : B), inducing ((pretrivialization_at b) ∘ (total_space_mk E b)))
-
-namespace topological_vector_prebundle
-
-variables {R E F}
-
-/-- Natural identification of `topological_vector_prebundle` as a `topological_fiber_prebundle`. -/
-def to_topological_fiber_prebundle (a : topological_vector_prebundle R F E) :
-  topological_fiber_prebundle F (proj E) :=
-{ pretrivialization_atlas :=
-    pretrivialization.to_fiber_bundle_pretrivialization '' a.pretrivialization_atlas,
-  pretrivialization_at := λ x, (a.pretrivialization_at x).to_fiber_bundle_pretrivialization,
-  pretrivialization_mem_atlas := λ x, ⟨_, a.pretrivialization_mem_atlas x, rfl⟩,
-  continuous_triv_change := begin
-    rintros _ ⟨e, he, rfl⟩ _ ⟨e', he', rfl⟩,
-    obtain ⟨s, hs, hs', ε, hε, heε⟩ := a.continuous_coord_change e he e' he',
-    have H : e'.to_fiber_bundle_pretrivialization.to_local_equiv.target ∩
-      (e'.to_fiber_bundle_pretrivialization.to_local_equiv.symm) ⁻¹'
-      e.to_fiber_bundle_pretrivialization.to_local_equiv.source = s ×ˢ (univ : set F),
-    { simpa using hs },
-    rw H,
-    have : continuous_on (λ p : B × F, (p.1, (ε p.1) p.2)) (s ×ˢ (univ : set F)),
-    { apply continuous_on_fst.prod,
-      exact is_bounded_bilinear_map_apply.continuous.comp_continuous_on
-        (hε.prod_map continuous_on_id) },
-    apply this.congr,
-    rintros ⟨b, f⟩ ⟨hb : b ∈ s, -⟩,
-    exact heε _ hb _,
-  end,
-  .. a }
-
-/-- Topology on the total space that will make the prebundle into a bundle. -/
-def total_space_topology (a : topological_vector_prebundle R F E) :
-  topological_space (total_space E) :=
-a.to_topological_fiber_prebundle.total_space_topology
-
-/-- Promotion from a `topologial_vector_prebundle.trivialization` to a
-  `topological_vector_bundle.trivialization`. -/
-def trivialization_of_mem_pretrivialization_atlas (a : topological_vector_prebundle R F E)
-  {e : topological_vector_bundle.pretrivialization R F E} (he : e ∈ a.pretrivialization_atlas) :
-  @topological_vector_bundle.trivialization R _ F E _ _ _ _ _ _ _ a.total_space_topology :=
-begin
-  letI := a.total_space_topology,
-  exact { linear := e.linear,
-  ..a.to_topological_fiber_prebundle.trivialization_of_mem_pretrivialization_atlas ⟨e, he, rfl⟩ }
-end
-
-variable (a : topological_vector_prebundle R F E)
-
-lemma mem_trivialization_at_source (b : B) (x : E b) :
-  total_space_mk E b x ∈ (a.pretrivialization_at b).source :=
-begin
-  simp only [(a.pretrivialization_at b).source_eq, mem_preimage, proj],
-  exact a.mem_base_pretrivialization_at b,
-end
-
-@[simp] lemma total_space_mk_preimage_source (b : B) :
-  (total_space_mk E b) ⁻¹' (a.pretrivialization_at b).source = univ :=
-begin
-  apply eq_univ_of_univ_subset,
-  rw [(a.pretrivialization_at b).source_eq, ←preimage_comp, function.comp],
-  simp only [proj],
-  rw preimage_const_of_mem _,
-  exact a.mem_base_pretrivialization_at b,
-end
-
-@[continuity] lemma continuous_total_space_mk (b : B) :
-  @continuous _ _ _ a.total_space_topology (total_space_mk E b) :=
-begin
-  letI := a.total_space_topology,
-  let e := a.trivialization_of_mem_pretrivialization_atlas (a.pretrivialization_mem_atlas b),
-  rw e.to_local_homeomorph.continuous_iff_continuous_comp_left
-    (a.total_space_mk_preimage_source b),
-  exact continuous_iff_le_induced.mpr (le_antisymm_iff.mp (a.total_space_mk_inducing b).induced).1,
-end
-
-lemma inducing_total_space_mk_of_inducing_comp (b : B)
-  (h : inducing ((a.pretrivialization_at b) ∘ (total_space_mk E b))) :
-  @inducing _ _ _ a.total_space_topology (total_space_mk E b) :=
-begin
-  letI := a.total_space_topology,
-  rw ←restrict_comp_cod_restrict (a.mem_trivialization_at_source b) at h,
-  apply inducing.of_cod_restrict (a.mem_trivialization_at_source b),
-  refine inducing_of_inducing_compose _ (continuous_on_iff_continuous_restrict.mp
-    (a.trivialization_of_mem_pretrivialization_atlas
-    (a.pretrivialization_mem_atlas b)).continuous_to_fun) h,
-  exact (a.continuous_total_space_mk b).cod_restrict (a.mem_trivialization_at_source b),
-end
-
-/-- Make a `topological_vector_bundle` from a `topological_vector_prebundle`.  Concretely this means
-that, given a `topological_vector_prebundle` structure for a sigma-type `E` -- which consists of a
-number of "pretrivializations" identifying parts of `E` with product spaces `U × F` -- one
-establishes that for the topology constructed on the sigma-type using
-`topological_vector_prebundle.total_space_topology`, these "pretrivializations" are actually
-"trivializations" (i.e., homeomorphisms with respect to the constructed topology). -/
-def to_topological_vector_bundle :
-  @topological_vector_bundle R _ F E _ _ _ _ _ _ a.total_space_topology _ :=
-{ total_space_mk_inducing := λ b, a.inducing_total_space_mk_of_inducing_comp b
-    (a.total_space_mk_inducing b),
-  trivialization_atlas := {e | ∃ e₀ (he₀ : e₀ ∈ a.pretrivialization_atlas),
-    e = a.trivialization_of_mem_pretrivialization_atlas he₀},
-  trivialization_at := λ x, a.trivialization_of_mem_pretrivialization_atlas
-    (a.pretrivialization_mem_atlas x),
-  mem_base_set_trivialization_at := a.mem_base_pretrivialization_at,
-  trivialization_mem_atlas := λ x, ⟨_, a.pretrivialization_mem_atlas x, rfl⟩,
-  continuous_coord_change := begin
-    rintros _ ⟨e, he, rfl⟩ _ ⟨e', he', rfl⟩,
-    exact a.continuous_coord_change e' he' e he,
-  end }
-
-end topological_vector_prebundle
-
-end
-
-/-! ### Direct sum of two vector bundles over the same base -/
-
-namespace topological_vector_bundle
-
-section defs
-variables (E₁ : B → Type*) (E₂ : B → Type*)
-variables [topological_space (total_space E₁)] [topological_space (total_space E₂)]
-
-/-- Equip the total space of the fibrewise product of two topological vector bundles `E₁`, `E₂` with
-the induced topology from the diagonal embedding into `(total_space E₁) × (total_space E₂)`. -/
-instance prod.topological_space :
-  topological_space (total_space (E₁ ×ᵇ E₂)) :=
-topological_space.induced
-  (λ p, ((⟨p.1, p.2.1⟩ : total_space E₁), (⟨p.1, p.2.2⟩ : total_space E₂)))
-  (by apply_instance : topological_space ((total_space E₁) × (total_space E₂)))
-
-/-- The diagonal map from the total space of the fibrewise product of two topological vector bundles
-`E₁`, `E₂` into `(total_space E₁) × (total_space E₂)` is `inducing`. -/
-lemma prod.inducing_diag : inducing
-  (λ p, (⟨p.1, p.2.1⟩, ⟨p.1, p.2.2⟩) :
-    total_space (E₁ ×ᵇ E₂) → (total_space E₁) × (total_space E₂)) :=
-⟨rfl⟩
-
-end defs
-
-variables [nondiscrete_normed_field R] [topological_space B]
-
-variables (F₁ : Type*) [normed_group F₁] [normed_space R F₁]
-  (E₁ : B → Type*) [topological_space (total_space E₁)]
-  [Π x, add_comm_monoid (E₁ x)] [Π x, module R (E₁ x)]
-
-variables (F₂ : Type*) [normed_group F₂] [normed_space R F₂]
-  (E₂ : B → Type*) [topological_space (total_space E₂)]
-  [Π x, add_comm_monoid (E₂ x)] [Π x, module R (E₂ x)]
-
-namespace trivialization
-variables (e₁ : trivialization R F₁ E₁) (e₂ : trivialization R F₂ E₂)
-include e₁ e₂
-variables {R F₁ E₁ F₂ E₂}
-
-/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`, the forward
-function for the construction `topological_vector_bundle.trivialization.prod`, the induced
-trivialization for the direct sum of `E₁` and `E₂`. -/
-def prod.to_fun' : total_space (E₁ ×ᵇ E₂) → B × (F₁ × F₂) :=
-λ ⟨x, v₁, v₂⟩, ⟨x, (e₁ ⟨x, v₁⟩).2, (e₂ ⟨x, v₂⟩).2⟩
-
-variables {e₁ e₂}
-
-lemma prod.continuous_to_fun :
-  continuous_on (prod.to_fun' e₁ e₂) (proj (E₁ ×ᵇ E₂) ⁻¹' (e₁.base_set ∩ e₂.base_set)) :=
-begin
-  let f₁ : total_space (E₁ ×ᵇ E₂) → total_space E₁ × total_space E₂ :=
-    λ p, ((⟨p.1, p.2.1⟩ : total_space E₁), (⟨p.1, p.2.2⟩ : total_space E₂)),
-  let f₂ : total_space E₁ × total_space E₂ → (B × F₁) × (B × F₂) := λ p, ⟨e₁ p.1, e₂ p.2⟩,
-  let f₃ : (B × F₁) × (B × F₂) → B × F₁ × F₂ := λ p, ⟨p.1.1, p.1.2, p.2.2⟩,
-  have hf₁ : continuous f₁ := (prod.inducing_diag E₁ E₂).continuous,
-  have hf₂ : continuous_on f₂ (e₁.source ×ˢ e₂.source) :=
-    e₁.to_local_homeomorph.continuous_on.prod_map e₂.to_local_homeomorph.continuous_on,
-  have hf₃ : continuous f₃ :=
-    (continuous_fst.comp continuous_fst).prod_mk (continuous_snd.prod_map continuous_snd),
-  refine ((hf₃.comp_continuous_on hf₂).comp hf₁.continuous_on _).congr _,
-  { rw [e₁.source_eq, e₂.source_eq],
-    exact maps_to_preimage _ _ },
-  rintros ⟨b, v₁, v₂⟩ ⟨hb₁, hb₂⟩,
-  simp only [prod.to_fun', prod.mk.inj_iff, eq_self_iff_true, and_true],
-  rw e₁.coe_fst,
-  rw [e₁.source_eq, mem_preimage],
-  exact hb₁,
-end
-
-variables (e₁ e₂)
-
-variables [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
-  [topological_vector_bundle R F₁ E₁] [topological_vector_bundle R F₂ E₂]
-
-/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`, the inverse
-function for the construction `topological_vector_bundle.trivialization.prod`, the induced
-trivialization for the direct sum of `E₁` and `E₂`. -/
-def prod.inv_fun' (p : B × (F₁ × F₂)) : total_space (E₁ ×ᵇ E₂) :=
-begin
-  obtain ⟨x, w₁, w₂⟩ := p,
-  refine ⟨x, _, _⟩,
-  { by_cases h : x ∈ e₁.base_set,
-    { exact (e₁.continuous_linear_equiv_at x h).symm w₁ },
-    { exact 0 } },
-  { by_cases h : x ∈ e₂.base_set,
-    { exact (e₂.continuous_linear_equiv_at x h).symm w₂ },
-    { exact 0 } },
-end
-
-variables {e₁ e₂}
-
-lemma prod.inv_fun'_apply {x : B} (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set)
-  (w₁ : F₁) (w₂ : F₂) :
-  prod.inv_fun' e₁ e₂ ⟨x, w₁, w₂⟩
-  = ⟨x, ((e₁.continuous_linear_equiv_at x hx₁).symm w₁,
-    (e₂.continuous_linear_equiv_at x hx₂).symm w₂)⟩ :=
-begin
-  dsimp [prod.inv_fun'],
-  rw [dif_pos, dif_pos],
-end
-
-lemma prod.left_inv {x : total_space (E₁ ×ᵇ E₂)}
-  (h : x ∈ proj (E₁ ×ᵇ E₂) ⁻¹' (e₁.base_set ∩ e₂.base_set)) :
-  prod.inv_fun' e₁ e₂ (prod.to_fun' e₁ e₂ x) = x :=
-begin
-  obtain ⟨x, v₁, v₂⟩ := x,
-  simp only [prod.to_fun', prod.inv_fun', sigma.mk.inj_iff, true_and, eq_self_iff_true,
-    prod.mk.inj_iff, heq_iff_eq],
-  split,
-  { rw [dif_pos, ← e₁.continuous_linear_equiv_at_apply x h.1,
-      continuous_linear_equiv.symm_apply_apply] },
-  { rw [dif_pos, ← e₂.continuous_linear_equiv_at_apply x h.2,
-      continuous_linear_equiv.symm_apply_apply] },
-end
-
-lemma prod.right_inv {x : B × F₁ × F₂}
-  (h : x ∈ (e₁.base_set ∩ e₂.base_set) ×ˢ (univ : set (F₁ × F₂))) :
-  prod.to_fun' e₁ e₂ (prod.inv_fun' e₁ e₂ x) = x :=
-begin
-  obtain ⟨x, w₁, w₂⟩ := x,
-  obtain ⟨h, -⟩ := h,
-  dsimp only [prod.to_fun', prod.inv_fun'],
-  simp only [prod.mk.inj_iff, eq_self_iff_true, true_and],
-  split,
-  { rw [dif_pos, ← e₁.continuous_linear_equiv_at_apply x h.1,
-      continuous_linear_equiv.apply_symm_apply] },
-  { rw [dif_pos, ← e₂.continuous_linear_equiv_at_apply x h.2,
-      continuous_linear_equiv.apply_symm_apply] },
-end
-
-lemma prod.continuous_inv_fun :
-  continuous_on (prod.inv_fun' e₁ e₂) ((e₁.base_set ∩ e₂.base_set) ×ˢ (univ : set (F₁ × F₂))) :=
-begin
-  rw (prod.inducing_diag E₁ E₂).continuous_on_iff,
-  suffices : continuous_on (λ p : B × F₁ × F₂,
-    (e₁.to_local_homeomorph.symm ⟨p.1, p.2.1⟩, e₂.to_local_homeomorph.symm ⟨p.1, p.2.2⟩))
-    ((e₁.base_set ∩ e₂.base_set) ×ˢ (univ : set (F₁ × F₂))),
-  { refine this.congr _,
-    rintros ⟨b, v₁, v₂⟩ ⟨⟨h₁, h₂⟩, _⟩,
-    dsimp at ⊢ h₁ h₂,
-    rw [prod.inv_fun'_apply h₁ h₂, e₁.symm_apply_eq_mk_continuous_linear_equiv_at_symm b h₁,
-      e₂.symm_apply_eq_mk_continuous_linear_equiv_at_symm b h₂] },
-  have H₁ : continuous (λ p : B × F₁ × F₂, ((p.1, p.2.1), (p.1, p.2.2))) :=
-    (continuous_id.prod_map continuous_fst).prod_mk (continuous_id.prod_map continuous_snd),
-  have H₂ := e₁.to_local_homeomorph.symm.continuous_on.prod_map
-    e₂.to_local_homeomorph.symm.continuous_on,
-  refine H₂.comp H₁.continuous_on (λ x h, ⟨_, _⟩),
-  { dsimp,
-    rw e₁.target_eq,
-    exact ⟨h.1.1, mem_univ _⟩ },
-  { dsimp,
-    rw e₂.target_eq,
-    exact ⟨h.1.2, mem_univ _⟩ }
-end
-
-variables (e₁ e₂)
-
-/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`, the induced
-trivialization for the direct sum of `E₁` and `E₂`, whose base set is `e₁.base_set ∩ e₂.base_set`.
--/
-def prod : trivialization R (F₁ × F₂) (E₁ ×ᵇ E₂) :=
-{ to_fun := prod.to_fun' e₁ e₂,
-  inv_fun := prod.inv_fun' e₁ e₂,
-  source := (proj (λ x, E₁ x × E₂ x)) ⁻¹' (e₁.base_set ∩ e₂.base_set),
-  target := (e₁.base_set ∩ e₂.base_set) ×ˢ (set.univ : set (F₁ × F₂)),
-  map_source' := λ ⟨x, v₁, v₂⟩ h, ⟨h, set.mem_univ _⟩,
-  map_target' := λ ⟨x, w₁, w₂⟩ h, h.1,
-  left_inv' := λ x, prod.left_inv,
-  right_inv' := λ x, prod.right_inv,
-  open_source := begin
-    refine (e₁.open_base_set.inter e₂.open_base_set).preimage _,
-    have : continuous (proj E₁) := continuous_proj R B F₁,
-    exact this.comp (continuous_fst.comp (prod.inducing_diag E₁ E₂).continuous),
-  end,
-  open_target := (e₁.open_base_set.inter e₂.open_base_set).prod is_open_univ,
-  continuous_to_fun := prod.continuous_to_fun,
-  continuous_inv_fun := prod.continuous_inv_fun,
-  base_set := e₁.base_set ∩ e₂.base_set,
-  open_base_set := e₁.open_base_set.inter e₂.open_base_set,
-  source_eq := rfl,
-  target_eq := rfl,
-  proj_to_fun := λ ⟨x, v₁, v₂⟩ h, rfl,
-  linear := λ x ⟨h₁, h₂⟩,
-  { map_add := λ ⟨v₁, v₂⟩ ⟨v₁', v₂'⟩,
-      congr_arg2 prod.mk ((e₁.linear x h₁).map_add v₁ v₁') ((e₂.linear x h₂).map_add v₂ v₂'),
-    map_smul := λ c ⟨v₁, v₂⟩,
-      congr_arg2 prod.mk ((e₁.linear x h₁).map_smul c v₁) ((e₂.linear x h₂).map_smul c v₂), } }
-
-@[simp] lemma base_set_prod : (prod e₁ e₂).base_set = e₁.base_set ∩ e₂.base_set :=
-rfl
-
-variables {e₁ e₂}
-
-lemma prod_apply {x : B} (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set) (v₁ : E₁ x)
-  (v₂ : E₂ x) :
-  prod e₁ e₂ ⟨x, (v₁, v₂)⟩
-  = ⟨x, e₁.continuous_linear_equiv_at x hx₁ v₁, e₂.continuous_linear_equiv_at x hx₂ v₂⟩ :=
-rfl
-
-lemma prod_symm_apply {x : B} (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set) (w₁ : F₁) (w₂ : F₂) :
-  (prod e₁ e₂).to_local_equiv.symm (x, (w₁, w₂))
-  = ⟨x, ((e₁.continuous_linear_equiv_at x hx₁).symm w₁,
-      (e₂.continuous_linear_equiv_at x hx₂).symm w₂)⟩ :=
-prod.inv_fun'_apply hx₁ hx₂ w₁ w₂
-
-end trivialization
-
-open trivialization
-
-variables [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
-  [topological_vector_bundle R F₁ E₁] [topological_vector_bundle R F₂ E₂]
-
-/-- The product of two vector bundles is a vector bundle. -/
-instance _root_.bundle.prod.topological_vector_bundle :
-  topological_vector_bundle R (F₁ × F₂) (E₁ ×ᵇ E₂) :=
-{ total_space_mk_inducing := λ b,
-  begin
-    rw (prod.inducing_diag E₁ E₂).inducing_iff,
-    exact (total_space_mk_inducing R F₁ E₁ b).prod_mk (total_space_mk_inducing R F₂ E₂ b),
-  end,
-  trivialization_atlas := (λ (p : trivialization R F₁ E₁ × trivialization R F₂ E₂), p.1.prod p.2) ''
-    (trivialization_atlas R F₁ E₁ ×ˢ trivialization_atlas R F₂ E₂),
-  trivialization_at := λ b, (trivialization_at R F₁ E₁ b).prod (trivialization_at R F₂ E₂ b),
-  mem_base_set_trivialization_at :=
-    λ b, ⟨mem_base_set_trivialization_at R F₁ E₁ b, mem_base_set_trivialization_at R F₂ E₂ b⟩,
-  trivialization_mem_atlas := λ b,
-    ⟨(_, _), ⟨trivialization_mem_atlas R F₁ E₁ b, trivialization_mem_atlas R F₂ E₂ b⟩, rfl⟩,
-  continuous_coord_change := begin
-    rintros _ ⟨⟨e₁, e₂⟩, ⟨he₁, he₂⟩, rfl⟩ _ ⟨⟨e'₁, e'₂⟩, ⟨he'₁, he'₂⟩, rfl⟩,
-    let s := e₁.base_set ∩ e'₁.base_set,
-    let t := e₂.base_set ∩ e'₂.base_set,
-    let ε := coord_change he₁ he'₁,
-    let η := coord_change he₂ he'₂,
-    have fact : (s ∩ t) ×ˢ (univ : set $ F₁ × F₂) =
-        (e₁.base_set ∩ e₂.base_set ∩  (e'₁.base_set ∩ e'₂.base_set)) ×ˢ (univ : set $ F₁ × F₂),
-      by mfld_set_tac,
-    refine ⟨s ∩ t, _, _, λ b, (ε b).prod (η b), _, _⟩,
-    { rw fact,
-      apply topological_fiber_bundle.trivialization.symm_trans_source_eq },
-    { rw fact,
-      apply topological_fiber_bundle.trivialization.symm_trans_target_eq },
-    { have hε := (continuous_on_coord_change he₁ he'₁).mono (inter_subset_left s t),
-      have hη := (continuous_on_coord_change he₂ he'₂).mono (inter_subset_right s t),
-      exact hε.prod_map_equivL R hη },
-    { rintros b ⟨hbs, hbt⟩ ⟨u, v⟩,
-      have h : (e₁.prod e₂).to_local_homeomorph.symm _ = _ := prod_symm_apply hbs.1 hbt.1 u v,
-      simp only [ε, η, h, prod_apply hbs.2 hbt.2,
-        ← comp_continuous_linear_equiv_at_eq_coord_change he₁ he'₁ hbs,
-        ← comp_continuous_linear_equiv_at_eq_coord_change he₂ he'₂ hbt,
-        eq_self_iff_true, function.comp_app, local_equiv.coe_trans, local_homeomorph.coe_coe,
-        local_homeomorph.coe_coe_symm, prod.mk.inj_iff,
-        topological_vector_bundle.trivialization.coe_coe, true_and,
-        continuous_linear_equiv.prod_apply, continuous_linear_equiv.trans_apply] },
-  end }
-
-variables {R F₁ E₁ F₂ E₂}
-
-@[simp] lemma trivialization.continuous_linear_equiv_at_prod {e₁ : trivialization R F₁ E₁}
-  {e₂ : trivialization R F₂ E₂} {x : B} (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set) :
-  (e₁.prod e₂).continuous_linear_equiv_at x ⟨hx₁, hx₂⟩
-  = (e₁.continuous_linear_equiv_at x hx₁).prod (e₂.continuous_linear_equiv_at x hx₂) :=
-begin
-  ext1,
-  funext v,
-  obtain ⟨v₁, v₂⟩ := v,
-  rw [(e₁.prod e₂).continuous_linear_equiv_at_apply, trivialization.prod],
-  exact congr_arg prod.snd (prod_apply hx₁ hx₂ v₁ v₂),
-end
-
-end topological_vector_bundle
diff --git a/src/topology/vector_bundle/basic.lean b/src/topology/vector_bundle/basic.lean
new file mode 100644
index 0000000000000..5a703818a8660
--- /dev/null
+++ b/src/topology/vector_bundle/basic.lean
@@ -0,0 +1,945 @@
+/-
+Copyright © 2020 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Sebastien Gouezel, Heather Macbeth, Patrick Massot, Floris van Doorn
+-/
+
+import analysis.normed_space.bounded_linear_maps
+import topology.fiber_bundle.basic
+
+/-!
+# Vector bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+In this file we define (topological) vector bundles.
+
+Let `B` be the base space, let `F` be a normed space over a normed field `R`, and let
+`E : B → Type*` be a `fiber_bundle` with fiber `F`, in which, for each `x`, the fiber `E x` is a
+topological vector space over `R`.
+
+To have a vector bundle structure on `bundle.total_space F E`, one should additionally have the
+following properties:
+
+* The bundle trivializations in the trivialization atlas should be continuous linear equivs in the
+fibers;
+* For any two trivializations `e`, `e'` in the atlas the transition function considered as a map
+from `B` into `F →L[R] F` is continuous on `e.base_set ∩ e'.base_set` with respect to the operator
+norm topology on `F →L[R] F`.
+
+If these conditions are satisfied, we register the typeclass `vector_bundle R F E`.
+
+We define constructions on vector bundles like pullbacks and direct sums in other files.
+
+## Main Definitions
+
+* `trivialization.is_linear`: a class stating that a trivialization is fiberwise linear on its base
+  set.
+* `trivialization.linear_equiv_at` and `trivialization.continuous_linear_map_at` are the
+  (continuous) linear fiberwise equivalences a trivialization induces.
+* They have forward maps `trivialization.linear_map_at` / `trivialization.continuous_linear_map_at`
+  and inverses `trivialization.symmₗ` / `trivialization.symmL`. Note that these are all defined
+  everywhere, since they are extended using the zero function.
+* `trivialization.coord_changeL` is the coordinate change induced by two trivializations. It only
+  makes sense on the intersection of their base sets, but is extended outside it using the identity.
+* Given a continuous (semi)linear map between `E x` and `E' y` where `E` and `E'` are bundles over
+  possibly different base sets, `continuous_linear_map.in_coordinates` turns this into a continuous
+  (semi)linear map between the chosen fibers of those bundles.
+
+## Implementation notes
+
+The implementation choices in the vector bundle definition are discussed in the "Implementation
+notes" section of `topology.fiber_bundle.basic`.
+
+## Tags
+Vector bundle
+-/
+
+noncomputable theory
+
+open bundle set
+open_locale classical bundle
+
+variables (R : Type*) {B : Type*} (F : Type*) (E : B → Type*)
+
+section topological_vector_space
+variables {B F E} [semiring R]
+  [topological_space F]  [topological_space B]
+
+/-- A mixin class for `pretrivialization`, stating that a pretrivialization is fiberwise linear with
+respect to given module structures on its fibers and the model fiber. -/
+protected class pretrivialization.is_linear [add_comm_monoid F] [module R F]
+  [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)] (e : pretrivialization F (π F E)) :
+  Prop :=
+(linear : ∀ b ∈ e.base_set, is_linear_map R (λ x : E b, (e ⟨b, x⟩).2))
+
+namespace pretrivialization
+
+variables {F E} (e : pretrivialization F (π F E)) {x : total_space F E} {b : B} {y : E b}
+
+lemma linear [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
+  [e.is_linear R] {b : B} (hb : b ∈ e.base_set) :
+  is_linear_map R (λ x : E b, (e ⟨b, x⟩).2) :=
+pretrivialization.is_linear.linear b hb
+
+variables [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
+
+/-- A fiberwise linear inverse to `e`. -/
+@[simps] protected def symmₗ (e : pretrivialization F (π F E)) [e.is_linear R] (b : B) :
+  F →ₗ[R] E b :=
+begin
+  refine is_linear_map.mk' (e.symm b) _,
+  by_cases hb : b ∈ e.base_set,
+  { exact (((e.linear R hb).mk' _).inverse (e.symm b) (e.symm_apply_apply_mk hb)
+      (λ v, congr_arg prod.snd $ e.apply_mk_symm hb v)).is_linear },
+  { rw [e.coe_symm_of_not_mem hb], exact (0 : F →ₗ[R] E b).is_linear }
+end
+
+/-- A pretrivialization for a vector bundle defines linear equivalences between the
+fibers and the model space. -/
+@[simps {fully_applied := ff}] def linear_equiv_at (e : pretrivialization F (π F E)) [e.is_linear R]
+  (b : B) (hb : b ∈ e.base_set) :
+  E b ≃ₗ[R] F :=
+{ to_fun := λ y, (e ⟨b, y⟩).2,
+  inv_fun := e.symm b,
+  left_inv := e.symm_apply_apply_mk hb,
+  right_inv := λ v, by simp_rw [e.apply_mk_symm hb v],
+  map_add' := λ v w, (e.linear R hb).map_add v w,
+  map_smul' := λ c v, (e.linear R hb).map_smul c v }
+
+/-- A fiberwise linear map equal to `e` on `e.base_set`. -/
+protected def linear_map_at (e : pretrivialization F (π F E)) [e.is_linear R] (b : B) :
+  E b →ₗ[R] F :=
+if hb : b ∈ e.base_set then e.linear_equiv_at R b hb else 0
+
+variables {R}
+
+lemma coe_linear_map_at (e : pretrivialization F (π F E)) [e.is_linear R] (b : B) :
+  ⇑(e.linear_map_at R b) = λ y, if b ∈ e.base_set then (e ⟨b, y⟩).2 else 0 :=
+by { rw [pretrivialization.linear_map_at], split_ifs; refl }
+
+lemma coe_linear_map_at_of_mem (e : pretrivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) :
+  ⇑(e.linear_map_at R b) = λ y, (e ⟨b, y⟩).2 :=
+by simp_rw [coe_linear_map_at, if_pos hb]
+
+lemma linear_map_at_apply (e : pretrivialization F (π F E)) [e.is_linear R] {b : B} (y : E b) :
+  e.linear_map_at R b y = if b ∈ e.base_set then (e ⟨b, y⟩).2 else 0 :=
+by rw [coe_linear_map_at]
+
+lemma linear_map_at_def_of_mem (e : pretrivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) :
+  e.linear_map_at R b = e.linear_equiv_at R b hb :=
+dif_pos hb
+
+lemma linear_map_at_def_of_not_mem (e : pretrivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∉ e.base_set) :
+  e.linear_map_at R b = 0 :=
+dif_neg hb
+
+lemma linear_map_at_eq_zero (e : pretrivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∉ e.base_set) :
+  e.linear_map_at R b = 0 :=
+dif_neg hb
+
+lemma symmₗ_linear_map_at (e : pretrivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) (y : E b) :
+  e.symmₗ R b (e.linear_map_at R b y) = y :=
+by { rw [e.linear_map_at_def_of_mem hb], exact (e.linear_equiv_at R b hb).left_inv y }
+
+lemma linear_map_at_symmₗ (e : pretrivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) (y : F) :
+  e.linear_map_at R b (e.symmₗ R b y) = y :=
+by { rw [e.linear_map_at_def_of_mem hb], exact (e.linear_equiv_at R b hb).right_inv y }
+
+end pretrivialization
+
+variables (R) [topological_space (total_space F E)]
+
+/-- A mixin class for `trivialization`, stating that a trivialization is fiberwise linear with
+respect to given module structures on its fibers and the model fiber. -/
+protected class trivialization.is_linear [add_comm_monoid F] [module R F]
+  [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)] (e : trivialization F (π F E)) : Prop :=
+(linear : ∀ b ∈ e.base_set, is_linear_map R (λ x : E b, (e ⟨b, x⟩).2))
+
+namespace trivialization
+
+variables (e : trivialization F (π F E)) {x : total_space F E} {b : B} {y : E b}
+
+protected lemma linear [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)]
+  [∀ x, module R (E x)] [e.is_linear R] {b : B} (hb : b ∈ e.base_set) :
+  is_linear_map R (λ y : E b, (e ⟨b, y⟩).2) :=
+trivialization.is_linear.linear b hb
+
+instance to_pretrivialization.is_linear [add_comm_monoid F] [module R F]
+  [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)] [e.is_linear R] :
+  e.to_pretrivialization.is_linear R :=
+{ ..(‹_› : e.is_linear R) }
+
+variables [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
+
+/-- A trivialization for a vector bundle defines linear equivalences between the
+fibers and the model space. -/
+def linear_equiv_at (e : trivialization F (π F E)) [e.is_linear R] (b : B) (hb : b ∈ e.base_set) :
+  E b ≃ₗ[R] F :=
+e.to_pretrivialization.linear_equiv_at R b hb
+
+variables {R}
+
+@[simp]
+lemma linear_equiv_at_apply (e : trivialization F (π F E)) [e.is_linear R] (b : B)
+  (hb : b ∈ e.base_set) (v : E b) :
+  e.linear_equiv_at R b hb v = (e ⟨b, v⟩).2 := rfl
+
+@[simp]
+lemma linear_equiv_at_symm_apply (e : trivialization F (π F E)) [e.is_linear R] (b : B)
+  (hb : b ∈ e.base_set) (v : F) :
+  (e.linear_equiv_at R b hb).symm v = e.symm b v := rfl
+
+variables (R)
+
+/-- A fiberwise linear inverse to `e`. -/
+protected def symmₗ (e : trivialization F (π F E)) [e.is_linear R] (b : B) : F →ₗ[R] E b :=
+e.to_pretrivialization.symmₗ R b
+
+variables {R}
+
+lemma coe_symmₗ (e : trivialization F (π F E)) [e.is_linear R] (b : B) :
+  ⇑(e.symmₗ R b) = e.symm b :=
+rfl
+
+variables (R)
+
+/-- A fiberwise linear map equal to `e` on `e.base_set`. -/
+protected def linear_map_at (e : trivialization F (π F E)) [e.is_linear R] (b : B) : E b →ₗ[R] F :=
+e.to_pretrivialization.linear_map_at R b
+
+variables {R}
+
+lemma coe_linear_map_at (e : trivialization F (π F E)) [e.is_linear R] (b : B) :
+  ⇑(e.linear_map_at R b) = λ y, if b ∈ e.base_set then (e ⟨b, y⟩).2 else 0 :=
+e.to_pretrivialization.coe_linear_map_at b
+
+lemma coe_linear_map_at_of_mem (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) :
+  ⇑(e.linear_map_at R b) = λ y, (e ⟨b, y⟩).2 :=
+by simp_rw [coe_linear_map_at, if_pos hb]
+
+lemma linear_map_at_apply (e : trivialization F (π F E)) [e.is_linear R] {b : B} (y : E b) :
+  e.linear_map_at R b y = if b ∈ e.base_set then (e ⟨b, y⟩).2 else 0 :=
+by rw [coe_linear_map_at]
+
+lemma linear_map_at_def_of_mem (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) :
+  e.linear_map_at R b = e.linear_equiv_at R b hb :=
+dif_pos hb
+
+lemma linear_map_at_def_of_not_mem (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∉ e.base_set) :
+  e.linear_map_at R b = 0 :=
+dif_neg hb
+
+lemma symmₗ_linear_map_at (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) (y : E b) :
+  e.symmₗ R b (e.linear_map_at R b y) = y :=
+e.to_pretrivialization.symmₗ_linear_map_at hb y
+
+lemma linear_map_at_symmₗ (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) (y : F) :
+  e.linear_map_at R b (e.symmₗ R b y) = y :=
+e.to_pretrivialization.linear_map_at_symmₗ hb y
+
+variables (R)
+
+/-- A coordinate change function between two trivializations, as a continuous linear equivalence.
+  Defined to be the identity when `b` does not lie in the base set of both trivializations. -/
+def coord_changeL (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R] (b : B) :
+  F ≃L[R] F :=
+{ continuous_to_fun := begin
+    by_cases hb : b ∈ e.base_set ∩ e'.base_set,
+    { simp_rw [dif_pos hb],
+      refine (e'.continuous_on.comp_continuous _ _).snd,
+      exact e.continuous_on_symm.comp_continuous (continuous.prod.mk b)
+        (λ y, mk_mem_prod hb.1 (mem_univ y)),
+      exact (λ y, e'.mem_source.mpr hb.2) },
+    { rw [dif_neg hb], exact continuous_id }
+  end,
+  continuous_inv_fun := begin
+    by_cases hb : b ∈ e.base_set ∩ e'.base_set,
+    { simp_rw [dif_pos hb],
+      refine (e.continuous_on.comp_continuous _ _).snd,
+      exact e'.continuous_on_symm.comp_continuous (continuous.prod.mk b)
+        (λ y, mk_mem_prod hb.2 (mem_univ y)),
+      exact (λ y, e.mem_source.mpr hb.1) },
+    { rw [dif_neg hb], exact continuous_id }
+  end,
+  .. if hb : b ∈ e.base_set ∩ e'.base_set then
+     (e.linear_equiv_at R b (hb.1 : _)).symm.trans (e'.linear_equiv_at R b hb.2)
+    else linear_equiv.refl R F }
+
+variables {R}
+
+lemma coe_coord_changeL (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R] {b : B}
+  (hb : b ∈ e.base_set ∩ e'.base_set) :
+  ⇑(coord_changeL R e e' b)
+  = (e.linear_equiv_at R b hb.1).symm.trans (e'.linear_equiv_at R b hb.2) :=
+congr_arg linear_equiv.to_fun (dif_pos hb)
+
+lemma coe_coord_changeL' (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R] {b : B}
+  (hb : b ∈ e.base_set ∩ e'.base_set) :
+  (coord_changeL R e e' b).to_linear_equiv
+  = (e.linear_equiv_at R b hb.1).symm.trans (e'.linear_equiv_at R b hb.2) :=
+linear_equiv.coe_injective (coe_coord_changeL _ _ _)
+
+lemma symm_coord_changeL (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R] {b : B}
+  (hb : b ∈ e'.base_set ∩ e.base_set) :
+  (e.coord_changeL R e' b).symm = e'.coord_changeL R e b :=
+begin
+  apply continuous_linear_equiv.to_linear_equiv_injective,
+  rw [coe_coord_changeL' e' e hb, (coord_changeL R e e' b).symm_to_linear_equiv,
+    coe_coord_changeL' e e' hb.symm, linear_equiv.trans_symm, linear_equiv.symm_symm],
+end
+
+lemma coord_changeL_apply (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R] {b : B}
+  (hb : b ∈ e.base_set ∩ e'.base_set) (y : F) :
+  coord_changeL R e e' b y = (e' ⟨b, e.symm b y⟩).2 :=
+congr_arg (λ f, linear_equiv.to_fun f y) (dif_pos hb)
+
+lemma mk_coord_changeL (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R] {b : B}
+  (hb : b ∈ e.base_set ∩ e'.base_set) (y : F) :
+  (b, coord_changeL R e e' b y) = e' ⟨b, e.symm b y⟩ :=
+begin
+  ext,
+  { rw [e.mk_symm hb.1 y, e'.coe_fst', e.proj_symm_apply' hb.1],
+    rw [e.proj_symm_apply' hb.1], exact hb.2 },
+  { exact e.coord_changeL_apply e' hb y }
+end
+
+lemma apply_symm_apply_eq_coord_changeL (e e' : trivialization F (π F E)) [e.is_linear R]
+  [e'.is_linear R] {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
+  e' (e.to_local_homeomorph.symm (b, v)) = (b, e.coord_changeL R e' b v) :=
+by rw [e.mk_coord_changeL e' hb, e.mk_symm hb.1]
+
+/-- A version of `coord_change_apply` that fully unfolds `coord_change`. The right-hand side is
+ugly, but has good definitional properties for specifically defined trivializations. -/
+lemma coord_changeL_apply' (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R]
+  {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (y : F) :
+  coord_changeL R e e' b y = (e' (e.to_local_homeomorph.symm (b, y))).2 :=
+by rw [e.coord_changeL_apply e' hb, e.mk_symm hb.1]
+
+lemma coord_changeL_symm_apply (e e' : trivialization F (π F E)) [e.is_linear R] [e'.is_linear R]
+  {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) :
+  ⇑(coord_changeL R e e' b).symm
+  = (e'.linear_equiv_at R b hb.2).symm.trans (e.linear_equiv_at R b hb.1) :=
+congr_arg linear_equiv.inv_fun (dif_pos hb)
+
+end trivialization
+
+end topological_vector_space
+
+section
+
+namespace bundle
+
+/-- The zero section of a vector bundle -/
+def zero_section [∀ x, has_zero (E x)] : B → total_space F E :=
+λ x, ⟨x, 0⟩
+
+@[simp, mfld_simps]
+lemma zero_section_proj [∀ x, has_zero (E x)] (x : B) : (zero_section F E x).proj = x := rfl
+@[simp, mfld_simps]
+lemma zero_section_snd [∀ x, has_zero (E x)] (x : B) : (zero_section F E x).2 = 0 := rfl
+
+end bundle
+open bundle
+
+variables [nontrivially_normed_field R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
+  [normed_add_comm_group F] [normed_space R F] [topological_space B]
+  [topological_space (total_space F E)] [∀ x, topological_space (E x)] [fiber_bundle F E]
+
+/-- The space `total_space F E` (for `E : B → Type*` such that each `E x` is a topological vector
+space) has a topological vector space structure with fiber `F` (denoted with
+`vector_bundle R F E`) if around every point there is a fiber bundle trivialization
+which is linear in the fibers. -/
+class vector_bundle : Prop :=
+(trivialization_linear' : ∀ (e : trivialization F (π F E)) [mem_trivialization_atlas e],
+  e.is_linear R)
+(continuous_on_coord_change' [] : ∀ (e e' : trivialization F (π F E)) [mem_trivialization_atlas e]
+  [mem_trivialization_atlas e'],
+  continuous_on
+  (λ b, by exactI trivialization.coord_changeL R e e' b : B → F →L[R] F) (e.base_set ∩ e'.base_set))
+
+variables {F E}
+
+@[priority 100]
+instance trivialization_linear [vector_bundle R F E] (e : trivialization F (π F E))
+  [mem_trivialization_atlas e] :
+  e.is_linear R :=
+vector_bundle.trivialization_linear' e
+
+lemma continuous_on_coord_change [vector_bundle R F E] (e e' : trivialization F (π F E))
+  [he : mem_trivialization_atlas e]
+  [he' : mem_trivialization_atlas e'] :
+  continuous_on
+  (λ b, trivialization.coord_changeL R e e' b : B → F →L[R] F) (e.base_set ∩ e'.base_set) :=
+vector_bundle.continuous_on_coord_change' R e e'
+
+namespace trivialization
+
+/-- Forward map of `continuous_linear_equiv_at` (only propositionally equal),
+  defined everywhere (`0` outside domain). -/
+@[simps apply {fully_applied := ff}]
+def continuous_linear_map_at (e : trivialization F (π F E)) [e.is_linear R] (b : B) :
+  E b →L[R] F :=
+{ to_fun := e.linear_map_at R b, -- given explicitly to help `simps`
+  cont := begin
+    dsimp,
+    rw [e.coe_linear_map_at b],
+    refine continuous_if_const _ (λ hb, _) (λ _, continuous_zero),
+    exact continuous_snd.comp (e.continuous_on.comp_continuous
+      (fiber_bundle.total_space_mk_inducing F E b).continuous
+      (λ x, e.mem_source.mpr hb))
+  end,
+  .. e.linear_map_at R b }
+
+/-- Backwards map of `continuous_linear_equiv_at`, defined everywhere. -/
+@[simps apply {fully_applied := ff}]
+def symmL (e : trivialization F (π F E)) [e.is_linear R] (b : B) : F →L[R] E b :=
+{ to_fun := e.symm b, -- given explicitly to help `simps`
+  cont := begin
+    by_cases hb : b ∈ e.base_set,
+    { rw (fiber_bundle.total_space_mk_inducing F E b).continuous_iff,
+      exact e.continuous_on_symm.comp_continuous (continuous_const.prod_mk continuous_id)
+        (λ x, mk_mem_prod hb (mem_univ x)) },
+    { refine continuous_zero.congr (λ x, (e.symm_apply_of_not_mem hb x).symm) },
+  end,
+  .. e.symmₗ R b }
+
+variables {R}
+
+lemma symmL_continuous_linear_map_at (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) (y : E b) :
+  e.symmL R b (e.continuous_linear_map_at R b y) = y :=
+e.symmₗ_linear_map_at hb y
+
+lemma continuous_linear_map_at_symmL (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) (y : F) :
+  e.continuous_linear_map_at R b (e.symmL R b y) = y :=
+e.linear_map_at_symmₗ hb y
+
+variables (R)
+
+/-- In a vector bundle, a trivialization in the fiber (which is a priori only linear)
+is in fact a continuous linear equiv between the fibers and the model fiber. -/
+@[simps apply symm_apply {fully_applied := ff}]
+def continuous_linear_equiv_at (e : trivialization F (π F E)) [e.is_linear R] (b : B)
+  (hb : b ∈ e.base_set) : E b ≃L[R] F :=
+{ to_fun := λ y, (e ⟨b, y⟩).2, -- given explicitly to help `simps`
+  inv_fun := e.symm b, -- given explicitly to help `simps`
+  continuous_to_fun := continuous_snd.comp (e.continuous_on.comp_continuous
+    (fiber_bundle.total_space_mk_inducing F E b).continuous
+    (λ x, e.mem_source.mpr hb)),
+  continuous_inv_fun := (e.symmL R b).continuous,
+  .. e.to_pretrivialization.linear_equiv_at R b hb }
+
+variables {R}
+
+lemma coe_continuous_linear_equiv_at_eq (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) :
+  (e.continuous_linear_equiv_at R b hb : E b → F) = e.continuous_linear_map_at R b :=
+(e.coe_linear_map_at_of_mem hb).symm
+
+lemma symm_continuous_linear_equiv_at_eq (e : trivialization F (π F E)) [e.is_linear R] {b : B}
+  (hb : b ∈ e.base_set) :
+  ((e.continuous_linear_equiv_at R b hb).symm : F → E b) = e.symmL R b :=
+rfl
+
+@[simp] lemma continuous_linear_equiv_at_apply' (e : trivialization F (π F E)) [e.is_linear R]
+  (x : total_space F E) (hx : x ∈ e.source) :
+  e.continuous_linear_equiv_at R x.proj (e.mem_source.1 hx) x.2 = (e x).2 := by { cases x, refl }
+
+variables (R)
+
+lemma apply_eq_prod_continuous_linear_equiv_at (e : trivialization F (π F E)) [e.is_linear R]
+  (b : B) (hb : b ∈ e.base_set) (z : E b) :
+  e ⟨b, z⟩ = (b, e.continuous_linear_equiv_at R b hb z) :=
+begin
+  ext,
+  { refine e.coe_fst _,
+    rw e.source_eq,
+    exact hb },
+  { simp only [coe_coe, continuous_linear_equiv_at_apply] }
+end
+
+protected lemma zero_section (e : trivialization F (π F E)) [e.is_linear R]
+  {x : B} (hx : x ∈ e.base_set) : e (zero_section F E x) = (x, 0) :=
+by simp_rw [zero_section, e.apply_eq_prod_continuous_linear_equiv_at R x hx 0,
+  map_zero]
+
+variables {R}
+
+lemma symm_apply_eq_mk_continuous_linear_equiv_at_symm (e : trivialization F (π F E))
+  [e.is_linear R] (b : B) (hb : b ∈ e.base_set) (z : F) :
+  e.to_local_homeomorph.symm ⟨b, z⟩
+  = ⟨b, (e.continuous_linear_equiv_at R b hb).symm z⟩ :=
+begin
+  have h : (b, z) ∈ e.target,
+  { rw e.target_eq,
+    exact ⟨hb, mem_univ _⟩ },
+  apply e.inj_on (e.map_target h),
+  { simp only [e.source_eq, hb, mem_preimage] },
+  simp_rw [e.right_inv h, coe_coe, e.apply_eq_prod_continuous_linear_equiv_at R b hb,
+    continuous_linear_equiv.apply_symm_apply],
+end
+
+lemma comp_continuous_linear_equiv_at_eq_coord_change (e e' : trivialization F (π F E))
+  [e.is_linear R] [e'.is_linear R] {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) :
+  (e.continuous_linear_equiv_at R b hb.1).symm.trans (e'.continuous_linear_equiv_at R b hb.2)
+  = coord_changeL R e e' b :=
+by { ext v, rw [coord_changeL_apply e e' hb], refl }
+
+end trivialization
+
+include R F
+
+/-! ### Constructing vector bundles -/
+
+variables (R B F)
+
+/-- Analogous construction of `fiber_bundle_core` for vector bundles. This
+construction gives a way to construct vector bundles from a structure registering how
+trivialization changes act on fibers. -/
+structure vector_bundle_core (ι : Type*) :=
+(base_set          : ι → set B)
+(is_open_base_set  : ∀ i, is_open (base_set i))
+(index_at          : B → ι)
+(mem_base_set_at   : ∀ x, x ∈ base_set (index_at x))
+(coord_change      : ι → ι → B → (F →L[R] F))
+(coord_change_self : ∀ i, ∀ x ∈ base_set i, ∀ v, coord_change i i x v = v)
+(continuous_on_coord_change : ∀ i j, continuous_on (coord_change i j) (base_set i ∩ base_set j))
+(coord_change_comp : ∀ i j k, ∀ x ∈ (base_set i) ∩ (base_set j) ∩ (base_set k), ∀ v,
+  (coord_change j k x) (coord_change i j x v) = coord_change i k x v)
+
+/-- The trivial vector bundle core, in which all the changes of coordinates are the
+identity. -/
+def trivial_vector_bundle_core (ι : Type*) [inhabited ι] :
+  vector_bundle_core R B F ι :=
+{ base_set := λ ι, univ,
+  is_open_base_set := λ i, is_open_univ,
+  index_at := default,
+  mem_base_set_at := λ x, mem_univ x,
+  coord_change := λ i j x, continuous_linear_map.id R F,
+  coord_change_self := λ i x hx v, rfl,
+  coord_change_comp := λ i j k x hx v, rfl,
+  continuous_on_coord_change := λ i j, continuous_on_const }
+
+instance (ι : Type*) [inhabited ι] : inhabited (vector_bundle_core R B F ι) :=
+⟨trivial_vector_bundle_core R B F ι⟩
+
+namespace vector_bundle_core
+
+variables {R B F} {ι : Type*} (Z : vector_bundle_core R B F ι)
+
+/-- Natural identification to a `fiber_bundle_core`. -/
+@[simps (mfld_cfg)] def to_fiber_bundle_core : fiber_bundle_core ι B F :=
+{ coord_change := λ i j b, Z.coord_change i j b,
+  continuous_on_coord_change := λ i j, is_bounded_bilinear_map_apply.continuous.comp_continuous_on
+      ((Z.continuous_on_coord_change i j).prod_map continuous_on_id),
+  ..Z }
+
+instance to_fiber_bundle_core_coe : has_coe (vector_bundle_core R B F ι)
+  (fiber_bundle_core ι B F) := ⟨to_fiber_bundle_core⟩
+
+include Z
+
+lemma coord_change_linear_comp (i j k : ι): ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j) ∩ (Z.base_set k),
+  (Z.coord_change j k x).comp (Z.coord_change i j x) = Z.coord_change i k x :=
+λ x hx, by { ext v, exact Z.coord_change_comp i j k x hx v }
+
+/-- The index set of a vector bundle core, as a convenience function for dot notation -/
+@[nolint unused_arguments has_nonempty_instance]
+def index := ι
+
+/-- The base space of a vector bundle core, as a convenience function for dot notation-/
+@[nolint unused_arguments, reducible]
+def base := B
+
+/-- The fiber of a vector bundle core, as a convenience function for dot notation and
+typeclass inference -/
+@[nolint unused_arguments has_nonempty_instance]
+def fiber : B → Type* := Z.to_fiber_bundle_core.fiber
+
+instance topological_space_fiber (x : B) : topological_space (Z.fiber x) :=
+by delta_instance vector_bundle_core.fiber
+instance add_comm_monoid_fiber : ∀ (x : B), add_comm_monoid (Z.fiber x) :=
+by dsimp [vector_bundle_core.fiber]; delta_instance fiber_bundle_core.fiber
+instance module_fiber : ∀ (x : B), module R (Z.fiber x) :=
+by dsimp [vector_bundle_core.fiber];  delta_instance fiber_bundle_core.fiber
+instance add_comm_group_fiber [add_comm_group F] : ∀ (x : B), add_comm_group (Z.fiber x) :=
+by dsimp [vector_bundle_core.fiber];  delta_instance fiber_bundle_core.fiber
+
+/-- The projection from the total space of a fiber bundle core, on its base. -/
+@[reducible, simp, mfld_simps] protected def proj : total_space F Z.fiber → B := total_space.proj
+
+/-- The total space of the vector bundle, as a convenience function for dot notation.
+It is by definition equal to `bundle.total_space Z.fiber`. -/
+@[nolint unused_arguments, reducible]
+protected def total_space := bundle.total_space F Z.fiber
+
+/-- Local homeomorphism version of the trivialization change. -/
+def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
+fiber_bundle_core.triv_change ↑Z i j
+
+@[simp, mfld_simps] lemma mem_triv_change_source (i j : ι) (p : B × F) :
+  p ∈ (Z.triv_change i j).source ↔ p.1 ∈ Z.base_set i ∩ Z.base_set j :=
+fiber_bundle_core.mem_triv_change_source ↑Z i j p
+
+/-- Topological structure on the total space of a vector bundle created from core, designed so
+that all the local trivialization are continuous. -/
+instance to_topological_space : topological_space Z.total_space :=
+Z.to_fiber_bundle_core.to_topological_space
+
+variables (b : B) (a : F)
+
+@[simp, mfld_simps] lemma coe_coord_change (i j : ι) :
+  Z.to_fiber_bundle_core.coord_change i j b = Z.coord_change i j b := rfl
+
+/-- One of the standard local trivializations of a vector bundle constructed from core, taken by
+considering this in particular as a fiber bundle constructed from core. -/
+def local_triv (i : ι) : trivialization F (π F Z.fiber) :=
+by dsimp [vector_bundle_core.total_space, vector_bundle_core.fiber];
+  exact Z.to_fiber_bundle_core.local_triv i
+
+/-- The standard local trivializations of a vector bundle constructed from core are linear. -/
+instance local_triv.is_linear (i : ι) : (Z.local_triv i).is_linear R :=
+{ linear := λ x hx, by dsimp [vector_bundle_core.local_triv]; exact
+  { map_add := λ v w, by simp only [continuous_linear_map.map_add] with mfld_simps,
+    map_smul := λ r v, by simp only [continuous_linear_map.map_smul] with mfld_simps} }
+
+variables (i j : ι)
+
+@[simp, mfld_simps] lemma mem_local_triv_source (p : Z.total_space) :
+  p ∈ (Z.local_triv i).source ↔ p.1 ∈ Z.base_set i :=
+by dsimp [vector_bundle_core.fiber]; exact iff.rfl
+
+@[simp, mfld_simps] lemma base_set_at : Z.base_set i = (Z.local_triv i).base_set := rfl
+
+@[simp, mfld_simps] lemma local_triv_apply (p : Z.total_space) :
+  (Z.local_triv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl
+
+@[simp, mfld_simps] lemma mem_local_triv_target (p : B × F) :
+  p ∈ (Z.local_triv i).target ↔ p.1 ∈ (Z.local_triv i).base_set :=
+Z.to_fiber_bundle_core.mem_local_triv_target i p
+
+@[simp, mfld_simps] lemma local_triv_symm_fst (p : B × F) :
+  (Z.local_triv i).to_local_homeomorph.symm p =
+    ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩ := rfl
+
+@[simp, mfld_simps] lemma local_triv_symm_apply {b : B} (hb : b ∈ Z.base_set i) (v : F) :
+  (Z.local_triv i).symm b v = Z.coord_change i (Z.index_at b) b v :=
+by apply (Z.local_triv i).symm_apply hb v
+
+@[simp, mfld_simps] lemma local_triv_coord_change_eq {b : B} (hb : b ∈ Z.base_set i ∩ Z.base_set j)
+  (v : F) :
+  (Z.local_triv i).coord_changeL R (Z.local_triv j) b v = Z.coord_change i j b v :=
+begin
+  rw [trivialization.coord_changeL_apply', local_triv_symm_fst, local_triv_apply,
+    coord_change_comp],
+  exacts [⟨⟨hb.1, Z.mem_base_set_at b⟩, hb.2⟩, hb]
+end
+
+/-- Preferred local trivialization of a vector bundle constructed from core, at a given point, as
+a bundle trivialization -/
+def local_triv_at (b : B) : trivialization F (π F Z.fiber) :=
+Z.local_triv (Z.index_at b)
+
+@[simp, mfld_simps] lemma local_triv_at_def :
+  Z.local_triv (Z.index_at b) = Z.local_triv_at b := rfl
+
+@[simp, mfld_simps] lemma mem_source_at : (⟨b, a⟩ : Z.total_space) ∈ (Z.local_triv_at b).source :=
+by { rw [local_triv_at, mem_local_triv_source], exact Z.mem_base_set_at b }
+
+@[simp, mfld_simps] lemma local_triv_at_apply (p : Z.total_space) :
+  ((Z.local_triv_at p.1) p) = ⟨p.1, p.2⟩ :=
+fiber_bundle_core.local_triv_at_apply Z p
+
+@[simp, mfld_simps] lemma local_triv_at_apply_mk (b : B) (a : F) :
+  ((Z.local_triv_at b) ⟨b, a⟩) = ⟨b, a⟩ :=
+Z.local_triv_at_apply _
+
+@[simp, mfld_simps] lemma mem_local_triv_at_base_set :
+  b ∈ (Z.local_triv_at b).base_set :=
+fiber_bundle_core.mem_local_triv_at_base_set Z b
+
+instance fiber_bundle : fiber_bundle F Z.fiber := Z.to_fiber_bundle_core.fiber_bundle
+
+instance vector_bundle : vector_bundle R F Z.fiber :=
+{ trivialization_linear' := begin
+    rintros _ ⟨i, rfl⟩,
+    apply local_triv.is_linear,
+  end,
+  continuous_on_coord_change' := begin
+    rintros _ _ ⟨i, rfl⟩ ⟨i', rfl⟩,
+    refine (Z.continuous_on_coord_change i i').congr (λ b hb, _),
+    ext v,
+    exact Z.local_triv_coord_change_eq i i' hb v,
+  end }
+
+/-- The projection on the base of a vector bundle created from core is continuous -/
+@[continuity] lemma continuous_proj : continuous Z.proj :=
+fiber_bundle_core.continuous_proj Z
+
+/-- The projection on the base of a vector bundle created from core is an open map -/
+lemma is_open_map_proj : is_open_map Z.proj :=
+fiber_bundle_core.is_open_map_proj Z
+
+variables {i j}
+
+@[simp, mfld_simps] lemma local_triv_continuous_linear_map_at {b : B} (hb : b ∈ Z.base_set i) :
+  (Z.local_triv i).continuous_linear_map_at R b = Z.coord_change (Z.index_at b) i b :=
+begin
+  ext1 v,
+  rw [(Z.local_triv i).continuous_linear_map_at_apply R, (Z.local_triv i).coe_linear_map_at_of_mem],
+  exacts [rfl, hb]
+end
+
+@[simp, mfld_simps] lemma trivialization_at_continuous_linear_map_at {b₀ b : B}
+  (hb : b ∈ (trivialization_at F Z.fiber b₀).base_set) :
+  (trivialization_at F Z.fiber b₀).continuous_linear_map_at R b =
+  Z.coord_change (Z.index_at b) (Z.index_at b₀) b :=
+Z.local_triv_continuous_linear_map_at hb
+
+@[simp, mfld_simps] lemma local_triv_symmL {b : B} (hb : b ∈ Z.base_set i) :
+  (Z.local_triv i).symmL R b = Z.coord_change i (Z.index_at b) b :=
+by { ext1 v, rw [(Z.local_triv i).symmL_apply R, (Z.local_triv i).symm_apply], exacts [rfl, hb] }
+
+@[simp, mfld_simps] lemma trivialization_at_symmL {b₀ b : B}
+  (hb : b ∈ (trivialization_at F Z.fiber b₀).base_set) :
+  (trivialization_at F Z.fiber b₀).symmL R b = Z.coord_change (Z.index_at b₀) (Z.index_at b) b :=
+Z.local_triv_symmL hb
+
+@[simp, mfld_simps] lemma trivialization_at_coord_change_eq {b₀ b₁ b : B}
+  (hb : b ∈ (trivialization_at F Z.fiber b₀).base_set ∩ (trivialization_at F Z.fiber b₁).base_set)
+  (v : F) :
+  (trivialization_at F Z.fiber b₀).coord_changeL R (trivialization_at F Z.fiber b₁) b v =
+  Z.coord_change (Z.index_at b₀) (Z.index_at b₁) b v :=
+Z.local_triv_coord_change_eq _ _ hb v
+
+end vector_bundle_core
+
+end
+
+/-! ### Vector prebundle -/
+
+section
+variables [nontrivially_normed_field R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
+  [normed_add_comm_group F] [normed_space R F] [topological_space B] [∀ x, topological_space (E x)]
+
+open topological_space
+
+open vector_bundle
+/-- This structure permits to define a vector bundle when trivializations are given as local
+equivalences but there is not yet a topology on the total space or the fibers.
+The total space is hence given a topology in such a way that there is a fiber bundle structure for
+which the local equivalences are also local homeomorphisms and hence vector bundle trivializations.
+The topology on the fibers is induced from the one on the total space.
+
+The field `exists_coord_change` is stated as an existential statement (instead of 3 separate
+fields), since it depends on propositional information (namely `e e' ∈ pretrivialization_atlas`).
+This makes it inconvenient to explicitly define a `coord_change` function when constructing a
+`vector_prebundle`. -/
+@[nolint has_nonempty_instance]
+structure vector_prebundle :=
+(pretrivialization_atlas : set (pretrivialization F (π F E)))
+(pretrivialization_linear' : ∀ (e : pretrivialization F (π F E)) (he : e ∈ pretrivialization_atlas),
+  e.is_linear R)
+(pretrivialization_at : B → pretrivialization F (π F E))
+(mem_base_pretrivialization_at : ∀ x : B, x ∈ (pretrivialization_at x).base_set)
+(pretrivialization_mem_atlas : ∀ x : B, pretrivialization_at x ∈ pretrivialization_atlas)
+(exists_coord_change : ∀ (e e' ∈ pretrivialization_atlas), ∃ f : B → F →L[R] F,
+  continuous_on f (e.base_set ∩ e'.base_set) ∧
+  ∀ (b : B) (hb : b ∈ e.base_set ∩ e'.base_set) (v : F),
+    f b v = (e' ⟨b, e.symm b v⟩).2)
+(total_space_mk_inducing : ∀ (b : B), inducing ((pretrivialization_at b) ∘ (total_space.mk b)))
+
+namespace vector_prebundle
+
+variables {R E F}
+
+/-- A randomly chosen coordinate change on a `vector_prebundle`, given by
+  the field `exists_coord_change`. -/
+def coord_change (a : vector_prebundle R F E)
+  {e e' : pretrivialization F (π F E)} (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) (b : B) : F →L[R] F :=
+classical.some (a.exists_coord_change e he e' he') b
+
+lemma continuous_on_coord_change (a : vector_prebundle R F E)
+  {e e' : pretrivialization F (π F E)} (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) :
+  continuous_on (a.coord_change he he') (e.base_set ∩ e'.base_set) :=
+(classical.some_spec (a.exists_coord_change e he e' he')).1
+
+lemma coord_change_apply (a : vector_prebundle R F E)
+  {e e' : pretrivialization F (π F E)} (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
+  a.coord_change he he' b v = (e' ⟨b, e.symm b v⟩).2 :=
+(classical.some_spec (a.exists_coord_change e he e' he')).2 b hb v
+
+lemma mk_coord_change (a : vector_prebundle R F E)
+  {e e' : pretrivialization F (π F E)} (he : e ∈ a.pretrivialization_atlas)
+  (he' : e' ∈ a.pretrivialization_atlas) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
+  (b, a.coord_change he he' b v) = e' ⟨b, e.symm b v⟩ :=
+begin
+  ext,
+  { rw [e.mk_symm hb.1 v, e'.coe_fst', e.proj_symm_apply' hb.1],
+    rw [e.proj_symm_apply' hb.1], exact hb.2 },
+  { exact a.coord_change_apply he he' hb v }
+end
+
+/-- Natural identification of `vector_prebundle` as a `fiber_prebundle`. -/
+def to_fiber_prebundle (a : vector_prebundle R F E) :
+  fiber_prebundle F E :=
+{ continuous_triv_change := begin
+    intros e he e' he',
+    have := is_bounded_bilinear_map_apply.continuous.comp_continuous_on
+      ((a.continuous_on_coord_change he' he).prod_map continuous_on_id),
+    have H : e'.to_local_equiv.target ∩ e'.to_local_equiv.symm ⁻¹'
+      e.to_local_equiv.source =(e'.base_set ∩ e.base_set) ×ˢ univ,
+    { rw [e'.target_eq, e.source_eq],
+      ext ⟨b, f⟩,
+      simp only [-total_space.proj, and.congr_right_iff, e'.proj_symm_apply', iff_self,
+        implies_true_iff] with mfld_simps {contextual := tt} },
+    rw [H],
+    refine (continuous_on_fst.prod this).congr _,
+    rintros ⟨b, f⟩ ⟨hb, -⟩,
+    dsimp only [function.comp, prod.map],
+    rw [a.mk_coord_change _ _ hb, e'.mk_symm hb.1],
+    refl,
+  end,
+  .. a }
+
+/-- Topology on the total space that will make the prebundle into a bundle. -/
+def total_space_topology (a : vector_prebundle R F E) :
+  topological_space (total_space F E) :=
+a.to_fiber_prebundle.total_space_topology
+
+/-- Promotion from a `trivialization` in the `pretrivialization_atlas` of a
+`vector_prebundle` to a `trivialization`. -/
+def trivialization_of_mem_pretrivialization_atlas (a : vector_prebundle R F E)
+  {e : pretrivialization F (π F E)} (he : e ∈ a.pretrivialization_atlas) :
+  @trivialization B F _ _ _ a.total_space_topology (π F E) :=
+a.to_fiber_prebundle.trivialization_of_mem_pretrivialization_atlas he
+
+lemma linear_of_mem_pretrivialization_atlas (a : vector_prebundle R F E)
+  {e : pretrivialization F (π F E)} (he : e ∈ a.pretrivialization_atlas) :
+  @trivialization.is_linear R B F _ _ _ _ a.total_space_topology _ _ _ _
+    (trivialization_of_mem_pretrivialization_atlas a he) :=
+{ linear := (a.pretrivialization_linear' e he).linear }
+
+variable (a : vector_prebundle R F E)
+
+lemma mem_trivialization_at_source (b : B) (x : E b) :
+  total_space.mk b x ∈ (a.pretrivialization_at b).source :=
+a.to_fiber_prebundle.mem_trivialization_at_source b x
+
+@[simp] lemma total_space_mk_preimage_source (b : B) :
+  (total_space.mk b) ⁻¹' (a.pretrivialization_at b).source = univ :=
+a.to_fiber_prebundle.total_space_mk_preimage_source b
+
+@[continuity] lemma continuous_total_space_mk (b : B) :
+  @continuous _ _ _ a.total_space_topology (total_space.mk b) :=
+a.to_fiber_prebundle.continuous_total_space_mk b
+
+/-- Make a `fiber_bundle` from a `vector_prebundle`; auxiliary construction for
+`vector_prebundle.vector_bundle`. -/
+def to_fiber_bundle : @fiber_bundle B F _ _ _ a.total_space_topology _ :=
+a.to_fiber_prebundle.to_fiber_bundle
+
+/-- Make a `vector_bundle` from a `vector_prebundle`.  Concretely this means
+that, given a `vector_prebundle` structure for a sigma-type `E` -- which consists of a
+number of "pretrivializations" identifying parts of `E` with product spaces `U × F` -- one
+establishes that for the topology constructed on the sigma-type using
+`vector_prebundle.total_space_topology`, these "pretrivializations" are actually
+"trivializations" (i.e., homeomorphisms with respect to the constructed topology). -/
+lemma to_vector_bundle :
+  @vector_bundle R _ F E _ _ _ _ _ _ a.total_space_topology _ a.to_fiber_bundle :=
+{ trivialization_linear' := begin
+    rintros _ ⟨e, he, rfl⟩,
+    apply linear_of_mem_pretrivialization_atlas,
+  end,
+  continuous_on_coord_change' := begin
+    rintros _ _ ⟨e, he, rfl⟩ ⟨e', he', rfl⟩,
+    refine (a.continuous_on_coord_change he he').congr _,
+    intros b hb,
+    ext v,
+    rw [a.coord_change_apply he he' hb v, continuous_linear_equiv.coe_coe,
+      trivialization.coord_changeL_apply],
+    exacts [rfl, hb]
+  end }
+
+end vector_prebundle
+
+namespace continuous_linear_map
+variables {𝕜₁ 𝕜₂ : Type*} [nontrivially_normed_field 𝕜₁] [nontrivially_normed_field 𝕜₂]
+variables {σ : 𝕜₁ →+* 𝕜₂}
+variables {B' : Type*} [topological_space B']
+
+variables [normed_space 𝕜₁ F] [Π x, module 𝕜₁ (E x)] [topological_space (total_space F E)]
+variables {F' : Type*} [normed_add_comm_group F'] [normed_space 𝕜₂ F']
+  {E' : B' → Type*} [Π x, add_comm_monoid (E' x)] [Π x, module 𝕜₂ (E' x)]
+  [topological_space (total_space F' E')]
+variables [fiber_bundle F E] [vector_bundle 𝕜₁ F E]
+variables [Π x, topological_space (E' x)] [fiber_bundle F' E'] [vector_bundle 𝕜₂ F' E']
+variables (F E F' E')
+
+/-- When `ϕ` is a continuous (semi)linear map between the fibers `E x` and `E' y` of two vector
+bundles `E` and `E'`, `continuous_linear_map.in_coordinates F E F' E' x₀ x y₀ y ϕ` is a coordinate
+change of this continuous linear map w.r.t. the chart around `x₀` and the chart around `y₀`.
+
+It is defined by composing `ϕ` with appropriate coordinate changes given by the vector bundles
+`E` and `E'`.
+We use the operations `trivialization.continuous_linear_map_at` and `trivialization.symmL` in the
+definition, instead of `trivialization.continuous_linear_equiv_at`, so that
+`continuous_linear_map.in_coordinates` is defined everywhere (but see
+`continuous_linear_map.in_coordinates_eq`).
+
+This is the (second component of the) underlying function of a trivialization of the hom-bundle
+(see `hom_trivialization_at_apply`). However, note that `continuous_linear_map.in_coordinates` is
+defined even when `x` and `y` live in different base sets.
+Therefore, it is is also convenient when working with the hom-bundle between pulled back bundles.
+-/
+def in_coordinates (x₀ x : B) (y₀ y : B') (ϕ : E x →SL[σ] E' y) : F →SL[σ] F' :=
+((trivialization_at F' E' y₀).continuous_linear_map_at 𝕜₂ y).comp $ ϕ.comp $
+(trivialization_at F E x₀).symmL 𝕜₁ x
+
+variables {F F'}
+
+/-- rewrite `in_coordinates` using continuous linear equivalences. -/
+lemma in_coordinates_eq (x₀ x : B) (y₀ y : B') (ϕ : E x →SL[σ] E' y)
+  (hx : x ∈ (trivialization_at F E x₀).base_set)
+  (hy : y ∈ (trivialization_at F' E' y₀).base_set) :
+  in_coordinates F E F' E' x₀ x y₀ y ϕ =
+  ((trivialization_at F' E' y₀).continuous_linear_equiv_at 𝕜₂ y hy : E' y →L[𝕜₂] F').comp (ϕ.comp $
+  (((trivialization_at F E x₀).continuous_linear_equiv_at 𝕜₁ x hx).symm : F →L[𝕜₁] E x)) :=
+begin
+  ext,
+  simp_rw [in_coordinates, continuous_linear_map.coe_comp', continuous_linear_equiv.coe_coe,
+    trivialization.coe_continuous_linear_equiv_at_eq,
+    trivialization.symm_continuous_linear_equiv_at_eq]
+end
+
+/-- rewrite `in_coordinates` in a `vector_bundle_core`. -/
+protected lemma vector_bundle_core.in_coordinates_eq {ι ι'} (Z : vector_bundle_core 𝕜₁ B F ι)
+  (Z' : vector_bundle_core 𝕜₂ B' F' ι')
+  {x₀ x : B} {y₀ y : B'} (ϕ : F →SL[σ] F')
+  (hx : x ∈ Z.base_set (Z.index_at x₀))
+  (hy : y ∈ Z'.base_set (Z'.index_at y₀)) :
+    in_coordinates F Z.fiber F' Z'.fiber x₀ x y₀ y ϕ =
+    (Z'.coord_change (Z'.index_at y) (Z'.index_at y₀) y).comp (ϕ.comp $
+    Z.coord_change (Z.index_at x₀) (Z.index_at x) x) :=
+by simp_rw [in_coordinates, Z'.trivialization_at_continuous_linear_map_at hy,
+  Z.trivialization_at_symmL hx]
+
+end continuous_linear_map
+end
diff --git a/src/topology/vector_bundle/constructions.lean b/src/topology/vector_bundle/constructions.lean
new file mode 100644
index 0000000000000..210ae668d9ec6
--- /dev/null
+++ b/src/topology/vector_bundle/constructions.lean
@@ -0,0 +1,200 @@
+/-
+Copyright © 2022 Nicolò Cavalleri. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Nicolò Cavalleri, Sébastien Gouëzel, Heather Macbeth, Floris van Doorn
+-/
+import topology.fiber_bundle.constructions
+import topology.vector_bundle.basic
+
+/-!
+# Standard constructions on vector bundles
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+This file contains several standard constructions on vector bundles:
+
+* `bundle.trivial.vector_bundle 𝕜 B F`: the trivial vector bundle with scalar field `𝕜` and model
+  fiber `F` over the base `B`
+
+* `vector_bundle.prod`: for vector bundles `E₁` and `E₂` with scalar field `𝕜` over a common base,
+  a vector bundle structure on their direct sum `E₁ ×ᵇ E₂` (the notation stands for
+  `λ x, E₁ x × E₂ x`).
+
+* `vector_bundle.pullback`: for a vector bundle `E` over `B`, a vector bundle structure on its
+  pullback `f *ᵖ E` by a map `f : B' → B` (the notation is a type synonym for `E ∘ f`).
+
+## Tags
+Vector bundle, direct sum, pullback
+-/
+
+noncomputable theory
+
+open bundle set fiber_bundle
+open_locale classical bundle
+
+/-! ### The trivial vector bundle -/
+
+namespace bundle.trivial
+variables (𝕜 : Type*) (B : Type*) (F : Type*)
+  [nontrivially_normed_field 𝕜] [normed_add_comm_group F] [normed_space 𝕜 F] [topological_space B]
+
+instance trivialization.is_linear : (trivialization B F).is_linear 𝕜 :=
+{ linear := λ x hx, ⟨λ y z, rfl, λ c y, rfl⟩ }
+
+variables {𝕜}
+
+lemma trivialization.coord_changeL (b : B) :
+  (trivialization B F).coord_changeL 𝕜 (trivialization B F) b = continuous_linear_equiv.refl 𝕜 F :=
+begin
+  ext v,
+  rw [trivialization.coord_changeL_apply'],
+  exacts [rfl, ⟨mem_univ _, mem_univ _⟩]
+end
+
+variables (𝕜)
+
+instance vector_bundle : vector_bundle 𝕜 F (bundle.trivial B F) :=
+{ trivialization_linear' := begin
+    introsI e he,
+    rw eq_trivialization B F e,
+    apply_instance
+  end,
+  continuous_on_coord_change' := begin
+    introsI e e' he he',
+    unfreezingI { obtain rfl := eq_trivialization B F e },
+    unfreezingI { obtain rfl := eq_trivialization B F e' },
+    simp_rw trivialization.coord_changeL,
+    exact continuous_const.continuous_on
+  end }
+
+end bundle.trivial
+
+/-! ### Direct sum of two vector bundles -/
+
+section
+variables (𝕜 : Type*) {B : Type*} [nontrivially_normed_field 𝕜] [topological_space B]
+  (F₁ : Type*) [normed_add_comm_group F₁] [normed_space 𝕜 F₁]
+  (E₁ : B → Type*) [topological_space (total_space F₁ E₁)]
+  (F₂ : Type*) [normed_add_comm_group F₂] [normed_space 𝕜 F₂]
+  (E₂ : B → Type*) [topological_space (total_space F₂ E₂)]
+
+namespace trivialization
+variables {F₁ E₁ F₂ E₂}
+  [Π x, add_comm_monoid (E₁ x)] [Π x, module 𝕜 (E₁ x)]
+  [Π x, add_comm_monoid (E₂ x)] [Π x, module 𝕜 (E₂ x)]
+  (e₁ e₁' : trivialization F₁ (π F₁ E₁)) (e₂ e₂' : trivialization F₂ (π F₂ E₂))
+
+instance prod.is_linear [e₁.is_linear 𝕜] [e₂.is_linear 𝕜] : (e₁.prod e₂).is_linear 𝕜 :=
+{ linear := λ x ⟨h₁, h₂⟩, (((e₁.linear 𝕜 h₁).mk' _).prod_map ((e₂.linear 𝕜 h₂).mk' _)).is_linear }
+
+@[simp]
+lemma coord_changeL_prod [e₁.is_linear 𝕜] [e₁'.is_linear 𝕜] [e₂.is_linear 𝕜] [e₂'.is_linear 𝕜] ⦃b⦄
+  (hb : b ∈ ((e₁.prod e₂).base_set ∩ (e₁'.prod e₂').base_set)) :
+  ((e₁.prod e₂).coord_changeL 𝕜 (e₁'.prod e₂') b : F₁ × F₂ →L[𝕜] F₁ × F₂) =
+  (e₁.coord_changeL 𝕜 e₁' b : F₁ →L[𝕜] F₁).prod_map (e₂.coord_changeL 𝕜 e₂' b) :=
+begin
+  rw [continuous_linear_map.ext_iff, continuous_linear_map.coe_prod_map'],
+  rintro ⟨v₁, v₂⟩,
+  show (e₁.prod e₂).coord_changeL 𝕜 (e₁'.prod e₂') b (v₁, v₂) =
+    (e₁.coord_changeL 𝕜 e₁' b v₁, e₂.coord_changeL 𝕜 e₂' b v₂),
+  rw [e₁.coord_changeL_apply e₁', e₂.coord_changeL_apply e₂', (e₁.prod e₂).coord_changeL_apply'],
+  exacts [rfl, hb, ⟨hb.1.2, hb.2.2⟩, ⟨hb.1.1, hb.2.1⟩]
+end
+
+variables {e₁ e₂} [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
+  [fiber_bundle F₁ E₁] [fiber_bundle F₂ E₂]
+
+lemma prod_apply [e₁.is_linear 𝕜] [e₂.is_linear 𝕜] {x : B} (hx₁ : x ∈ e₁.base_set)
+  (hx₂ : x ∈ e₂.base_set) (v₁ : E₁ x) (v₂ : E₂ x) :
+  prod e₁ e₂ ⟨x, (v₁, v₂)⟩
+  = ⟨x, e₁.continuous_linear_equiv_at 𝕜 x hx₁ v₁, e₂.continuous_linear_equiv_at 𝕜 x hx₂ v₂⟩ :=
+rfl
+
+end trivialization
+
+open trivialization
+
+variables [Π x, add_comm_monoid (E₁ x)] [Π x, module 𝕜 (E₁ x)]
+  [Π x, add_comm_monoid (E₂ x)] [Π x, module 𝕜 (E₂ x)]
+  [Π x : B, topological_space (E₁ x)] [Π x : B, topological_space (E₂ x)]
+  [fiber_bundle F₁ E₁] [fiber_bundle F₂ E₂]
+
+/-- The product of two vector bundles is a vector bundle. -/
+instance vector_bundle.prod  [vector_bundle 𝕜 F₁ E₁] [vector_bundle 𝕜 F₂ E₂] :
+  vector_bundle 𝕜 (F₁ × F₂) (E₁ ×ᵇ E₂) :=
+{ trivialization_linear' := begin
+    rintros _ ⟨e₁, e₂, he₁, he₂, rfl⟩, resetI,
+    apply_instance
+  end,
+  continuous_on_coord_change' := begin
+    rintros _ _ ⟨e₁, e₂, he₁, he₂, rfl⟩ ⟨e₁', e₂', he₁', he₂', rfl⟩, resetI,
+    refine (((continuous_on_coord_change 𝕜 e₁ e₁').mono _).prod_mapL 𝕜
+      ((continuous_on_coord_change 𝕜 e₂ e₂').mono _)).congr _;
+    dsimp only [base_set_prod] with mfld_simps,
+    { mfld_set_tac },
+    { mfld_set_tac },
+    { rintro b hb,
+      rw [continuous_linear_map.ext_iff],
+      rintro ⟨v₁, v₂⟩,
+      show (e₁.prod e₂).coord_changeL 𝕜 (e₁'.prod e₂') b (v₁, v₂) =
+        (e₁.coord_changeL 𝕜 e₁' b v₁, e₂.coord_changeL 𝕜 e₂' b v₂),
+      rw [e₁.coord_changeL_apply e₁', e₂.coord_changeL_apply e₂',
+        (e₁.prod e₂).coord_changeL_apply'],
+      exacts [rfl, hb, ⟨hb.1.2, hb.2.2⟩, ⟨hb.1.1, hb.2.1⟩] }
+  end }
+
+variables {𝕜 F₁ E₁ F₂ E₂}
+
+@[simp] lemma trivialization.continuous_linear_equiv_at_prod {e₁ : trivialization F₁ (π F₁ E₁)}
+  {e₂ : trivialization F₂ (π F₂ E₂)} [e₁.is_linear 𝕜] [e₂.is_linear 𝕜] {x : B}
+  (hx₁ : x ∈ e₁.base_set) (hx₂ : x ∈ e₂.base_set) :
+  (e₁.prod e₂).continuous_linear_equiv_at 𝕜 x ⟨hx₁, hx₂⟩
+  = (e₁.continuous_linear_equiv_at 𝕜 x hx₁).prod (e₂.continuous_linear_equiv_at 𝕜 x hx₂) :=
+begin
+  ext1,
+  funext v,
+  obtain ⟨v₁, v₂⟩ := v,
+  rw [(e₁.prod e₂).continuous_linear_equiv_at_apply 𝕜, trivialization.prod],
+  exact (congr_arg prod.snd (prod_apply 𝕜 hx₁ hx₂ v₁ v₂) : _)
+end
+
+end
+
+/-! ### Pullbacks of vector bundles -/
+
+section
+variables (R 𝕜 : Type*) {B : Type*} (F : Type*) (E : B → Type*) {B' : Type*} (f : B' → B)
+
+instance [∀ (x : B), add_comm_monoid (E x)] : ∀ (x : B'), add_comm_monoid ((f *ᵖ E) x) :=
+by delta_instance bundle.pullback
+instance [semiring R] [∀ (x : B), add_comm_monoid (E x)] [∀ x, module R (E x)] :
+  ∀ (x : B'), module R ((f *ᵖ E) x) :=
+by delta_instance bundle.pullback
+
+variables {E F} [topological_space B'] [topological_space (total_space F E)]
+  [nontrivially_normed_field 𝕜] [normed_add_comm_group F] [normed_space 𝕜 F] [topological_space B]
+  [∀ x, add_comm_monoid (E x)] [∀ x, module 𝕜 (E x)]
+  {K : Type*} [continuous_map_class K B' B]
+
+instance trivialization.pullback_linear (e : trivialization F (π F E)) [e.is_linear 𝕜] (f : K) :
+  (@trivialization.pullback _ _ _ B' _ _ _ _ _ _ _ e f).is_linear 𝕜 :=
+{ linear := λ x h, e.linear 𝕜 h }
+
+instance vector_bundle.pullback [∀ x, topological_space (E x)]
+  [fiber_bundle F E] [vector_bundle 𝕜 F E] (f : K) : vector_bundle 𝕜 F ((f : B' → B) *ᵖ E) :=
+{ trivialization_linear' := begin
+    rintro _ ⟨e, he, rfl⟩, resetI,
+    apply_instance,
+  end,
+  continuous_on_coord_change' := begin
+    rintro _ _ ⟨e, he, rfl⟩ ⟨e', he', rfl⟩, resetI,
+    refine ((continuous_on_coord_change 𝕜 e e').comp (map_continuous f).continuous_on
+      (λ b hb, hb)).congr _,
+    rintro b (hb : f b ∈ e.base_set ∩ e'.base_set), ext v,
+    show ((e.pullback f).coord_changeL 𝕜 (e'.pullback f) b) v = (e.coord_changeL 𝕜 e' (f b)) v,
+    rw [e.coord_changeL_apply e' hb, (e.pullback f).coord_changeL_apply' _],
+    exacts [rfl, hb]
+  end }
+
+end
diff --git a/src/topology/vector_bundle/hom.lean b/src/topology/vector_bundle/hom.lean
new file mode 100644
index 0000000000000..96ea682a0be2b
--- /dev/null
+++ b/src/topology/vector_bundle/hom.lean
@@ -0,0 +1,341 @@
+/-
+Copyright © 2022 Heather Macbeth. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Heather Macbeth, Floris van Doorn
+-/
+
+import topology.vector_bundle.basic
+import analysis.normed_space.operator_norm
+
+/-!
+# The vector bundle of continuous (semi)linear maps
+
+> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
+> Any changes to this file require a corresponding PR to mathlib4.
+
+We define the (topological) vector bundle of continuous (semi)linear maps between two vector bundles
+over the same base.
+
+Given bundles `E₁ E₂ : B → Type*`, normed spaces `F₁` and `F₂`, and a ring-homomorphism `σ` between
+their respective scalar fields, we define `bundle.continuous_linear_map σ F₁ E₁ F₂ E₂ x` to be a
+type synonym for `λ x, E₁ x →SL[σ] E₂ x`. If the `E₁` and `E₂` are vector bundles with model fibers
+`F₁` and `F₂`, then this will be a vector bundle with fiber `F₁ →SL[σ] F₂`.
+
+The topology on the total space is constructed from the trivializations for `E₁` and `E₂` and the
+norm-topology on the model fiber `F₁ →SL[𝕜] F₂` using the `vector_prebundle` construction.  This is
+a bit awkward because it introduces a dependence on the normed space structure of the model fibers,
+rather than just their topological vector space structure; it is not clear whether this is
+necessary.
+
+Similar constructions should be possible (but are yet to be formalized) for tensor products of
+topological vector bundles, exterior algebras, and so on, where again the topology can be defined
+using a norm on the fiber model if this helps.
+
+## Main Definitions
+
+* `bundle.continuous_linear_map.vector_bundle`: continuous semilinear maps between
+  vector bundles form a vector bundle.
+
+-/
+
+noncomputable theory
+
+open_locale bundle
+open bundle set continuous_linear_map
+
+variables {𝕜₁ : Type*} [nontrivially_normed_field 𝕜₁] {𝕜₂ : Type*} [nontrivially_normed_field 𝕜₂]
+  (σ : 𝕜₁ →+* 𝕜₂) [iσ : ring_hom_isometric σ]
+
+variables {B : Type*}
+
+variables {F₁ : Type*} [normed_add_comm_group F₁] [normed_space 𝕜₁ F₁]
+  (E₁ : B → Type*) [Π x, add_comm_group (E₁ x)] [Π x, module 𝕜₁ (E₁ x)]
+  [topological_space (total_space F₁ E₁)]
+variables {F₂ : Type*} [normed_add_comm_group F₂] [normed_space 𝕜₂ F₂]
+  (E₂ : B → Type*) [Π x, add_comm_group (E₂ x)] [Π x, module 𝕜₂ (E₂ x)]
+  [topological_space (total_space F₂ E₂)]
+
+/-- A reducible type synonym for the bundle of continuous (semi)linear maps. For some reason, it
+helps with instance search.
+
+Porting note: after the port is done, we may want to remove this definition.
+-/
+@[reducible]
+protected def bundle.continuous_linear_map [∀ x, topological_space (E₁ x)]
+  [∀ x, topological_space (E₂ x)] : Π x : B, Type* :=
+λ x, E₁ x →SL[σ] E₂ x
+
+-- Porting note: possibly remove after the port
+instance bundle.continuous_linear_map.module [∀ x, topological_space (E₁ x)]
+  [∀ x, topological_space (E₂ x)] [∀ x, topological_add_group (E₂ x)]
+  [∀ x, has_continuous_const_smul 𝕜₂ (E₂ x)] :
+  ∀ x, module 𝕜₂ (bundle.continuous_linear_map σ E₁ E₂ x) :=
+λ _, infer_instance
+
+variables {E₁ E₂}
+
+variables [topological_space B] (e₁ e₁' : trivialization F₁ (π F₁ E₁))
+  (e₂ e₂' : trivialization F₂ (π F₂ E₂))
+
+namespace pretrivialization
+
+/-- Assume `eᵢ` and `eᵢ'` are trivializations of the bundles `Eᵢ` over base `B` with fiber `Fᵢ`
+(`i ∈ {1,2}`), then `continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂'` is the coordinate change
+function between the two induced (pre)trivializations
+`pretrivialization.continuous_linear_map σ e₁ e₂` and
+`pretrivialization.continuous_linear_map σ e₁' e₂'` of `bundle.continuous_linear_map`. -/
+def continuous_linear_map_coord_change
+  [e₁.is_linear 𝕜₁] [e₁'.is_linear 𝕜₁] [e₂.is_linear 𝕜₂] [e₂'.is_linear 𝕜₂] (b : B) :
+  (F₁ →SL[σ] F₂) →L[𝕜₂] F₁ →SL[σ] F₂ :=
+((e₁'.coord_changeL 𝕜₁ e₁ b).symm.arrow_congrSL (e₂.coord_changeL 𝕜₂ e₂' b) :
+  (F₁ →SL[σ] F₂) ≃L[𝕜₂] F₁ →SL[σ] F₂)
+
+variables {σ e₁ e₁' e₂ e₂'}
+variables [Π x, topological_space (E₁ x)] [fiber_bundle F₁ E₁]
+variables [Π x, topological_space (E₂ x)] [ita : Π x, topological_add_group (E₂ x)]
+  [fiber_bundle F₂ E₂]
+
+include iσ
+
+lemma continuous_on_continuous_linear_map_coord_change
+  [vector_bundle 𝕜₁ F₁ E₁] [vector_bundle 𝕜₂ F₂ E₂]
+  [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₁']
+  [mem_trivialization_atlas e₂] [mem_trivialization_atlas e₂'] :
+  continuous_on (continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂')
+    ((e₁.base_set ∩ e₂.base_set) ∩ (e₁'.base_set ∩ e₂'.base_set)) :=
+begin
+  have h₁ := (compSL F₁ F₂ F₂ σ (ring_hom.id 𝕜₂)).continuous,
+  have h₂ := (continuous_linear_map.flip (compSL F₁ F₁ F₂ (ring_hom.id 𝕜₁) σ)).continuous,
+  have h₃ := (continuous_on_coord_change 𝕜₁ e₁' e₁),
+  have h₄ := (continuous_on_coord_change 𝕜₂ e₂ e₂'),
+  refine ((h₁.comp_continuous_on (h₄.mono _)).clm_comp (h₂.comp_continuous_on (h₃.mono _))).congr _,
+  { mfld_set_tac },
+  { mfld_set_tac },
+  { intros b hb, ext L v,
+    simp only [continuous_linear_map_coord_change, continuous_linear_equiv.coe_coe,
+      continuous_linear_equiv.arrow_congrSL_apply,
+      comp_apply, function.comp, compSL_apply, flip_apply, continuous_linear_equiv.symm_symm] },
+end
+
+omit iσ
+
+variables (σ e₁ e₁' e₂ e₂')
+  [e₁.is_linear 𝕜₁] [e₁'.is_linear 𝕜₁] [e₂.is_linear 𝕜₂] [e₂'.is_linear 𝕜₂]
+
+/-- Given trivializations `e₁`, `e₂` for vector bundles `E₁`, `E₂` over a base `B`,
+`pretrivialization.continuous_linear_map σ e₁ e₂` is the induced pretrivialization for the
+continuous `σ`-semilinear maps from `E₁` to `E₂`. That is, the map which will later become a
+trivialization, after the bundle of continuous semilinear maps is equipped with the right
+topological vector bundle structure. -/
+def continuous_linear_map :
+  pretrivialization (F₁ →SL[σ] F₂) (π (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂)) :=
+{ to_fun := λ p, ⟨p.1, continuous_linear_map.comp (e₂.continuous_linear_map_at 𝕜₂ p.1)
+    (p.2.comp (e₁.symmL 𝕜₁ p.1 : F₁ →L[𝕜₁] E₁ p.1) : F₁ →SL[σ] E₂ p.1)⟩,
+  inv_fun := λ p, ⟨p.1, continuous_linear_map.comp (e₂.symmL 𝕜₂ p.1)
+    (p.2.comp (e₁.continuous_linear_map_at 𝕜₁ p.1 : E₁ p.1 →L[𝕜₁] F₁) : E₁ p.1 →SL[σ] F₂)⟩,
+  source := (bundle.total_space.proj) ⁻¹' (e₁.base_set ∩ e₂.base_set),
+  target := (e₁.base_set ∩ e₂.base_set) ×ˢ set.univ,
+  map_source' := λ ⟨x, L⟩ h, ⟨h, set.mem_univ _⟩,
+  map_target' := λ ⟨x, f⟩ h, h.1,
+  left_inv' := λ ⟨x, L⟩ ⟨h₁, h₂⟩,
+  begin
+    simp_rw [sigma.mk.inj_iff, eq_self_iff_true, heq_iff_eq, true_and],
+    ext v,
+    simp only [comp_apply, trivialization.symmL_continuous_linear_map_at, h₁, h₂]
+  end,
+  right_inv' := λ ⟨x, f⟩ ⟨⟨h₁, h₂⟩, _⟩,
+  begin
+    simp_rw [prod.mk.inj_iff, eq_self_iff_true, true_and],
+    ext v,
+    simp only [comp_apply, trivialization.continuous_linear_map_at_symmL, h₁, h₂]
+  end,
+  open_target := (e₁.open_base_set.inter e₂.open_base_set).prod is_open_univ,
+  base_set := e₁.base_set ∩ e₂.base_set,
+  open_base_set := e₁.open_base_set.inter e₂.open_base_set,
+  source_eq := rfl,
+  target_eq := rfl,
+  proj_to_fun := λ ⟨x, f⟩ h, rfl }
+
+include ita
+
+-- porting note: todo: see if Lean 4 can generate this instance without a hint
+instance continuous_linear_map.is_linear
+  [Π x, has_continuous_add (E₂ x)] [Π x, has_continuous_smul 𝕜₂ (E₂ x)] :
+  (pretrivialization.continuous_linear_map σ e₁ e₂).is_linear 𝕜₂ :=
+{ linear := λ x h,
+  { map_add := λ L L',
+    show (e₂.continuous_linear_map_at 𝕜₂ x).comp ((L + L').comp (e₁.symmL 𝕜₁ x)) = _,
+    begin
+      simp_rw [add_comp, comp_add],
+      refl
+    end,
+    map_smul := λ c L,
+    show (e₂.continuous_linear_map_at 𝕜₂ x).comp ((c • L).comp (e₁.symmL 𝕜₁ x)) = _,
+    begin
+      simp_rw [smul_comp, comp_smulₛₗ, ring_hom.id_apply],
+      refl
+    end, } }
+
+omit ita
+
+lemma continuous_linear_map_apply
+  (p : total_space (F₁ →SL[σ] F₂) (λ x, E₁ x →SL[σ] E₂ x)) :
+  (continuous_linear_map σ e₁ e₂) p =
+  ⟨p.1, continuous_linear_map.comp (e₂.continuous_linear_map_at 𝕜₂ p.1)
+    (p.2.comp (e₁.symmL 𝕜₁ p.1 : F₁ →L[𝕜₁] E₁ p.1) : F₁ →SL[σ] E₂ p.1)⟩ :=
+rfl
+
+lemma continuous_linear_map_symm_apply (p : B × (F₁ →SL[σ] F₂)) :
+  (continuous_linear_map σ e₁ e₂).to_local_equiv.symm p =
+  ⟨p.1, continuous_linear_map.comp (e₂.symmL 𝕜₂ p.1)
+    (p.2.comp (e₁.continuous_linear_map_at 𝕜₁ p.1 : E₁ p.1 →L[𝕜₁] F₁) : E₁ p.1 →SL[σ] F₂)⟩ :=
+rfl
+
+include ita
+
+lemma continuous_linear_map_symm_apply' {b : B} (hb : b ∈ e₁.base_set ∩ e₂.base_set)
+  (L : F₁ →SL[σ] F₂) :
+  (continuous_linear_map σ e₁ e₂).symm b L =
+  (e₂.symmL 𝕜₂ b).comp (L.comp $ e₁.continuous_linear_map_at 𝕜₁ b) :=
+begin
+  rw [symm_apply], refl, exact hb
+end
+
+lemma continuous_linear_map_coord_change_apply (b : B)
+  (hb : b ∈ (e₁.base_set ∩ e₂.base_set) ∩ (e₁'.base_set ∩ e₂'.base_set)) (L : F₁ →SL[σ] F₂) :
+  continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂' b L =
+  (continuous_linear_map σ e₁' e₂' ⟨b, ((continuous_linear_map σ e₁ e₂).symm b L)⟩).2 :=
+begin
+  ext v,
+  simp_rw [continuous_linear_map_coord_change, continuous_linear_equiv.coe_coe,
+    continuous_linear_equiv.arrow_congrSL_apply,
+    continuous_linear_map_apply, continuous_linear_map_symm_apply' σ e₁ e₂ hb.1,
+    comp_apply, continuous_linear_equiv.coe_coe, continuous_linear_equiv.symm_symm,
+    trivialization.continuous_linear_map_at_apply, trivialization.symmL_apply],
+  rw [e₂.coord_changeL_apply e₂', e₁'.coord_changeL_apply e₁, e₁.coe_linear_map_at_of_mem hb.1.1,
+    e₂'.coe_linear_map_at_of_mem hb.2.2],
+  exacts [⟨hb.2.1, hb.1.1⟩, ⟨hb.1.2, hb.2.2⟩]
+end
+
+end pretrivialization
+
+open pretrivialization
+variables (F₁ E₁ F₂ E₂)
+variables [Π x : B, topological_space (E₁ x)] [fiber_bundle F₁ E₁] [vector_bundle 𝕜₁ F₁ E₁]
+variables [Π x : B, topological_space (E₂ x)] [fiber_bundle F₂ E₂] [vector_bundle 𝕜₂ F₂ E₂]
+variables [Π x, topological_add_group (E₂ x)] [Π x, has_continuous_smul 𝕜₂ (E₂ x)]
+
+include iσ
+
+/-- The continuous `σ`-semilinear maps between two topological vector bundles form a
+`vector_prebundle` (this is an auxiliary construction for the
+`vector_bundle` instance, in which the pretrivializations are collated but no topology
+on the total space is yet provided). -/
+def _root_.bundle.continuous_linear_map.vector_prebundle :
+  vector_prebundle 𝕜₂ (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂) :=
+{ pretrivialization_atlas :=
+    {e |  ∃ (e₁ : trivialization F₁ (π F₁ E₁)) (e₂ : trivialization F₂ (π F₂ E₂))
+    [mem_trivialization_atlas e₁] [mem_trivialization_atlas e₂], by exactI
+    e = pretrivialization.continuous_linear_map σ e₁ e₂},
+  pretrivialization_linear' := begin
+    rintro _ ⟨e₁, he₁, e₂, he₂, rfl⟩,
+    apply_instance
+  end,
+  pretrivialization_at := λ x, pretrivialization.continuous_linear_map σ
+    (trivialization_at F₁ E₁ x) (trivialization_at F₂ E₂ x),
+  mem_base_pretrivialization_at := λ x,
+    ⟨mem_base_set_trivialization_at F₁ E₁ x, mem_base_set_trivialization_at F₂ E₂ x⟩,
+  pretrivialization_mem_atlas := λ x,
+    ⟨trivialization_at F₁ E₁ x, trivialization_at F₂ E₂ x, _, _, rfl⟩,
+  exists_coord_change := by { rintro _ ⟨e₁, e₂, he₁, he₂, rfl⟩ _ ⟨e₁', e₂', he₁', he₂', rfl⟩,
+    resetI,
+    exact ⟨continuous_linear_map_coord_change σ e₁ e₁' e₂ e₂',
+    continuous_on_continuous_linear_map_coord_change,
+    continuous_linear_map_coord_change_apply σ e₁ e₁' e₂ e₂'⟩ },
+  total_space_mk_inducing :=
+  begin
+    intros b,
+    let L₁ : E₁ b ≃L[𝕜₁] F₁ := (trivialization_at F₁ E₁ b).continuous_linear_equiv_at 𝕜₁ b
+      (mem_base_set_trivialization_at _ _ _),
+    let L₂ : E₂ b ≃L[𝕜₂] F₂ := (trivialization_at F₂ E₂ b).continuous_linear_equiv_at 𝕜₂ b
+      (mem_base_set_trivialization_at _ _ _),
+    let φ : (E₁ b →SL[σ] E₂ b) ≃L[𝕜₂] (F₁ →SL[σ] F₂) := L₁.arrow_congrSL L₂,
+    have : inducing (λ x, (b, φ x)) := inducing_const_prod.mpr φ.to_homeomorph.inducing,
+    convert this,
+    ext f,
+    { refl },
+    ext x,
+    dsimp [φ, pretrivialization.continuous_linear_map_apply],
+    rw [trivialization.linear_map_at_def_of_mem _ (mem_base_set_trivialization_at _ _ _)],
+    refl
+  end }
+
+/-- Topology on the total space of the continuous `σ`-semilinear_maps between two "normable" vector
+bundles over the same base. -/
+instance bundle.continuous_linear_map.topological_space_total_space :
+  topological_space (total_space (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂)) :=
+(bundle.continuous_linear_map.vector_prebundle
+  σ F₁ E₁ F₂ E₂).total_space_topology
+
+/-- The continuous `σ`-semilinear_maps between two vector bundles form a fiber bundle. -/
+instance _root_.bundle.continuous_linear_map.fiber_bundle :
+  fiber_bundle (F₁ →SL[σ] F₂) (λ x, E₁ x →SL[σ] E₂ x) :=
+(bundle.continuous_linear_map.vector_prebundle
+  σ F₁ E₁ F₂ E₂).to_fiber_bundle
+
+/-- The continuous `σ`-semilinear_maps between two vector bundles form a vector bundle. -/
+instance _root_.bundle.continuous_linear_map.vector_bundle :
+  vector_bundle 𝕜₂ (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂) :=
+(bundle.continuous_linear_map.vector_prebundle
+  σ F₁ E₁ F₂ E₂).to_vector_bundle
+
+variables (e₁ e₂) [he₁ : mem_trivialization_atlas e₁] [he₂ : mem_trivialization_atlas e₂]
+  {F₁ E₁ F₂ E₂}
+
+include he₁ he₂
+
+/-- Given trivializations `e₁`, `e₂` in the atlas for vector bundles `E₁`, `E₂` over a base `B`,
+the induced trivialization for the continuous `σ`-semilinear maps from `E₁` to `E₂`,
+whose base set is `e₁.base_set ∩ e₂.base_set`. -/
+def trivialization.continuous_linear_map :
+  trivialization (F₁ →SL[σ] F₂) (π (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂)) :=
+vector_prebundle.trivialization_of_mem_pretrivialization_atlas _ ⟨e₁, e₂, he₁, he₂, rfl⟩
+
+instance _root_.bundle.continuous_linear_map.mem_trivialization_atlas :
+  mem_trivialization_atlas (e₁.continuous_linear_map σ e₂ :
+    trivialization (F₁ →SL[σ] F₂) (π (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂))) :=
+{ out := ⟨_, ⟨e₁, e₂, by apply_instance, by apply_instance, rfl⟩, rfl⟩ }
+
+variables {e₁ e₂}
+
+@[simp] lemma trivialization.base_set_continuous_linear_map :
+  (e₁.continuous_linear_map σ e₂).base_set = e₁.base_set ∩ e₂.base_set :=
+rfl
+
+lemma trivialization.continuous_linear_map_apply
+  (p : total_space (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂)) :
+  e₁.continuous_linear_map σ e₂ p =
+  ⟨p.1, (e₂.continuous_linear_map_at 𝕜₂ p.1 : _ →L[𝕜₂] _).comp
+    (p.2.comp (e₁.symmL 𝕜₁ p.1 : F₁ →L[𝕜₁] E₁ p.1) : F₁ →SL[σ] E₂ p.1)⟩ :=
+rfl
+
+omit he₁ he₂
+
+lemma hom_trivialization_at_apply (x₀ : B)
+  (x : total_space (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂)) :
+  trivialization_at (F₁ →SL[σ] F₂) (λ x, E₁ x →SL[σ] E₂ x) x₀ x =
+  ⟨x.1, in_coordinates F₁ E₁ F₂ E₂ x₀ x.1 x₀ x.1 x.2⟩ :=
+rfl
+
+@[simp, mfld_simps]
+lemma hom_trivialization_at_source (x₀ : B) :
+  (trivialization_at (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂) x₀).source =
+  π (F₁ →SL[σ] F₂) (bundle.continuous_linear_map σ E₁ E₂) ⁻¹'
+    ((trivialization_at F₁ E₁ x₀).base_set ∩ (trivialization_at F₂ E₂ x₀).base_set) :=
+rfl
+
+@[simp, mfld_simps]
+lemma hom_trivialization_at_target (x₀ : B) :
+  (trivialization_at (F₁ →SL[σ] F₂) (λ x, E₁ x →SL[σ] E₂ x) x₀).target =
+  ((trivialization_at F₁ E₁ x₀).base_set ∩ (trivialization_at F₂ E₂ x₀).base_set) ×ˢ set.univ :=
+rfl
diff --git a/test/abel.lean b/test/abel.lean
index 5cb28d799f150..db60f0c98840b 100644
--- a/test/abel.lean
+++ b/test/abel.lean
@@ -1,4 +1,5 @@
 import tactic.abel
+import algebra.group.pi
 variables {α : Type*} {a b : α}
 
 example [add_comm_monoid α] : a + (b + a) = a + a + b := by abel
@@ -11,6 +12,16 @@ example [add_comm_group α] (a : α) : 0 + a = a := by abel1
 example [add_comm_group α] (n : ℕ) (a : α) : n • a = n • a := by abel1
 example [add_comm_group α] (n : ℕ) (a : α) : 0 + n • a = n • a := by abel1
 
+-- instances do not have to syntactically be
+-- `add_monoid.has_smul_nat` or `sub_neg_monoid.has_smul_int`
+example [add_comm_monoid α] (x : ℕ → α) : ((2 : ℕ) • x) = x + x := by abel1
+example [add_comm_group α] (x : ℕ → α) : ((2 : ℕ) • x) = x + x := by abel1
+example [add_comm_group α] (x : ℕ → α) : ((2 : ℤ) • x) = x + x := by abel1
+
+-- even if there's an instance we don't recognize, we treat it as an atom
+example [add_comm_group α] [has_smul ℕ α] (x : ℕ → α) :
+  ((2 : ℕ) • x) + ((2 : ℕ) • x) = (2 : ℤ) • ((2 : ℕ) • x) := by abel1
+
 -- `abel!` should see through terms that are definitionally equal,
 def id' (x : α) := x
 example [add_comm_group α] : a + b - b - id' a = 0 :=
diff --git a/test/apply_fun.lean b/test/apply_fun.lean
index cd5442c44782f..581be9190a81f 100644
--- a/test/apply_fun.lean
+++ b/test/apply_fun.lean
@@ -11,6 +11,14 @@ begin
   exact H h
 end
 
+example (x : ℤ) (h : x = 1) : 1 = 1 :=
+begin
+  revert h,
+  refine (λ h, _),
+  apply_fun (λ p, p) at h,
+  refl,
+end
+
 example (f : ℕ → ℕ) (a b : ℕ) (monof : monotone f) (h : a ≤ b) : f a ≤ f b :=
 begin
   apply_fun f at h,
diff --git a/test/apply_rules.lean b/test/apply_rules.lean
index ca0595b9b710e..5bfeab875b812 100644
--- a/test/apply_rules.lean
+++ b/test/apply_rules.lean
@@ -1,5 +1,5 @@
-
-import data.nat.basic
+import data.int.order.basic
+import data.nat.pow
 
 open nat
 
@@ -49,3 +49,12 @@ axiom p_rules : P 0
 
 example : P 0 := by success_if_fail {apply_rules with p_rules}; apply_rules [p_rules]
 example : P 10 := by apply_rules with p_rules 60
+
+attribute [p_rules] pow_lt_pow_of_lt_left
+
+open nat
+
+-- This tests for the following bug:
+-- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/namespace.20affects.20behaviour.20of.20.60apply_list_expr.60
+example {x y : ℤ} (n : ℕ) (h1 : x < y) (h2 : 0 ≤ x) (h3 : 0 < n) : x ^ n < y ^ n :=
+by apply_rules with p_rules
diff --git a/test/assert_exists/test1.lean b/test/assert_exists/test1.lean
new file mode 100644
index 0000000000000..aa2cfcc31bbe1
--- /dev/null
+++ b/test/assert_exists/test1.lean
@@ -0,0 +1,8 @@
+import tactic.assert_exists
+import logic.nontrivial
+
+assert_exists nat
+assert_not_exists rat
+
+assert_instance monad option
+assert_no_instance nontrivial nat
diff --git a/test/assert_exists/test2.lean b/test/assert_exists/test2.lean
new file mode 100644
index 0000000000000..1e3453a11c3d9
--- /dev/null
+++ b/test/assert_exists/test2.lean
@@ -0,0 +1,9 @@
+import tactic.assert_exists
+import algebra.order.ring.defs
+import data.int.basic
+
+assert_exists int
+assert_not_exists rat
+
+assert_instance ring ℤ
+assert_no_instance ordered_ring ℤ
diff --git a/test/assert_exists/test_linter.lean b/test/assert_exists/test_linter.lean
new file mode 100644
index 0000000000000..3634b88061c4e
--- /dev/null
+++ b/test/assert_exists/test_linter.lean
@@ -0,0 +1,28 @@
+import tactic.assert_exists
+import tactic.lint
+
+/-! ### Test `assert_not_exists` -/
+
+assert_not_exists foo
+
+def foo : nat := 1
+
+assert_not_exists bar
+
+run_cmd do
+  (_, s) ← lint tt lint_verbosity.medium [`assert_not_exists.linter] tt,
+  guard $ "/- `bar` does not ever exist -/\n".is_suffix_of s.to_string
+
+/-! ### Test `assert_no_instance` -/
+
+class some_class (t : Type*).
+
+assert_no_instance (some_class ℕ)
+
+instance : some_class ℕ := {}
+
+assert_no_instance (some_class ℤ)
+
+run_cmd do
+  (_, s) ← lint tt lint_verbosity.medium [`assert_no_instance.linter] tt,
+  guard $ "/- No instance of `some_class ℤ` -/\n".is_suffix_of s.to_string
diff --git a/test/back_chaining.lean b/test/back_chaining.lean
index 9233e1779c357..ded29a68c6a59 100644
--- a/test/back_chaining.lean
+++ b/test/back_chaining.lean
@@ -2,6 +2,10 @@ open tactic
 
 variables {α : Type*}
 
+instance : has_subset (set α) := ⟨λ s t, ∀ ⦃x⦄, x ∈ s → x ∈ t⟩
+instance : has_union (set α) := ⟨λ s t, {a | a ∈ s ∨ a ∈ t}⟩
+instance : has_inter (set α) := ⟨λ s t, {a | a ∈ s ∧ a ∈ t}⟩
+
 -- TODO: write a tactic to unfold specific instances of generic notation?
 theorem subset_def {s t : set α} : (s ⊆ t) = ∀ x, x ∈ s → x ∈ t := rfl
 theorem union_def {s₁ s₂ : set α} : s₁ ∪ s₂ = {a | a ∈ s₁ ∨ a ∈ s₂} := rfl
diff --git a/test/calc.lean b/test/calc.lean
index a527971d154fd..7220fa8fb49c7 100644
--- a/test/calc.lean
+++ b/test/calc.lean
@@ -8,7 +8,7 @@ section is_equivalent
 
 open_locale asymptotics
 
-example {l : filter α} {u v w : α → β} [normed_group β]
+example {l : filter α} {u v w : α → β} [normed_add_comm_group β]
   (huv : u ~[l] v) (hvw : v ~[l] w) : u ~[l] w :=
 calc u ~[l] v : huv
    ... ~[l] w : hvw
diff --git a/test/compute_degree.lean b/test/compute_degree.lean
new file mode 100644
index 0000000000000..c62448030fc25
--- /dev/null
+++ b/test/compute_degree.lean
@@ -0,0 +1,92 @@
+import tactic.compute_degree
+
+open polynomial
+open_locale polynomial
+
+variables {R : Type*} [semiring R] {a b c d e : R}
+
+example {R : Type*} [ring R] (h : ∀ {p q : R[X]}, p.nat_degree ≤ 0 → (p * q).nat_degree = 0) :
+  nat_degree (- 1 * 1 : R[X]) = 0 :=
+begin
+  apply h _,
+  compute_degree_le,
+end
+
+example {p : R[X]} {n : ℕ} {p0 : p.nat_degree = 0} :
+ (p ^ n).nat_degree ≤ 0 :=
+by compute_degree_le
+
+example {p : R[X]} {n : ℕ} {p0 : p.nat_degree = 0} :
+ (p ^ n).nat_degree ≤ 0 :=
+by cases n; compute_degree_le
+
+example {p q r : R[X]} {a b c d e f m n : ℕ} {p0 : p.nat_degree = a} {q0 : q.nat_degree = b}
+  {r0 : r.nat_degree = c} :
+  (((q ^ e * p ^ d) ^ m * r ^ f) ^ n).nat_degree ≤ ((b * e + a * d) * m + c * f) * n :=
+begin
+  compute_degree_le,
+  rw [p0, q0, r0],
+end
+
+example {F} [ring F] {p : F[X]} (p0 : p.nat_degree ≤ 0) :
+  p.nat_degree ≤ 0 :=
+begin
+  success_if_fail_with_msg {compute_degree_le} "Goal did not change",
+  exact p0,
+end
+
+example {F} [ring F] {p q : F[X]} (h : p.nat_degree + 1 ≤ q.nat_degree) :
+  (- p * X).nat_degree ≤ q.nat_degree :=
+by compute_degree_le
+
+example {F} [ring F] {a : F} {n : ℕ} (h : n ≤ 10) :
+  nat_degree (X ^ n - C a * X ^ 10 : F[X]) ≤ 10 :=
+by compute_degree_le
+
+example {F} [ring F] {a : F} {n : ℕ} (h : n ≤ 10) :
+  nat_degree (X ^ n + C a * X ^ 10 : F[X]) ≤ 10 :=
+by compute_degree_le
+
+example (n : ℕ) (h : 1 + n < 11) :
+  degree (5 * X ^ n + (X * monomial n 1 + X * X) + C a + C a * X ^ 10) ≤ 10 :=
+begin
+  compute_degree_le,
+  { exact nat.lt_succ_iff.mp h },
+  { exact nat.lt_succ_iff.mp ((lt_one_add n).trans h) },
+end
+
+example {n : ℕ} (h : 1 + n < 11) :
+  degree (X + (X * monomial 2 1 + X * X) ^ 2) ≤ 10 :=
+by compute_degree_le
+
+example {m s: ℕ} (ms : m ≤ s) (s1 : 1 ≤ s) : nat_degree (C a * X ^ m + X + 5) ≤ s :=
+by compute_degree_le; assumption
+
+example : nat_degree (7 * X : R[X]) ≤ 1 :=
+by compute_degree_le
+
+example : (1 : R[X]).nat_degree ≤ 0 :=
+by compute_degree_le
+
+example : nat_degree (monomial 5 c * monomial 1 c + monomial 7 d +
+  C a * X ^ 0 + C b * X ^ 5 + C c * X ^ 2 + X ^ 10 + C e * X) ≤ 10 :=
+by compute_degree_le
+
+example {n : ℕ} : nat_degree (0 * (X ^ 0 + X ^ n) * monomial 5 c * monomial 6 c) ≤ 9 :=
+begin
+  success_if_fail_with_msg {compute_degree_le}
+    "the given polynomial has a term of expected degree
+at least '11'",
+  rw [zero_mul, zero_mul, zero_mul, nat_degree_zero],
+  exact nat.zero_le _
+end
+
+example : nat_degree (monomial 0 c * (monomial 0 c * C 1) + monomial 0 d + C 1 + C a * X ^ 0) ≤ 0 :=
+by compute_degree_le
+
+example {F} [ring F] {n m : ℕ} (n4 : n ≤ 4) (m4 : m ≤ 4) {a : F} :
+  nat_degree (C a * X ^ n + X ^ m + bit1 1 : F[X]) ≤ 4 :=
+by compute_degree_le; assumption
+
+example {F} [ring F] : nat_degree (X ^ 4 + bit1 1 : F[X]) ≤ 4 :=
+by compute_degree_le
diff --git a/test/congrm.lean b/test/congrm.lean
new file mode 100644
index 0000000000000..57a20017a9c42
--- /dev/null
+++ b/test/congrm.lean
@@ -0,0 +1,165 @@
+import tactic.congrm
+
+variables {X : Type*} [has_add X] [has_mul X] (a b c d : X) (f : X → X)
+
+example (H : a = b) : f a + f a = f b + f b :=
+by congrm f _ + f _; exact H
+
+example {g : X → X} (H : a = b) (H' : c + f a = c + f d) (H'' : f d = f b) :
+  f (g a) * (f d + (c + f a)) = f (g b) * (f b + (c + f d)) :=
+begin
+  congrm f (g _) * (_ + _),
+  { exact H },
+  { exact H'' },
+  { exact H' },
+end
+
+example (H' : c + (f a) = c + (f d)) (H'' : f d = f b) :
+  f (f a) * (f d + (c + f a)) = f (f a) * (f b + (c + f d)) :=
+begin
+  congrm f (f _) * (_ + _),
+  { exact H'' },
+  { exact H' },
+end
+
+example (H' : c + (f a) = c + (f d)) (H'' : f d = f b) :
+  f (f a) * (f d + (c + f a)) = f (f a) * (f b + (c + f d)) :=
+begin
+  congrm f (f _) * (_ + _),
+  { exact H'' },
+  { exact H' },
+end
+
+example {p q} [decidable p] [decidable q] (h : p ↔ q) :
+  ite p 0 1 = ite q 0 1 :=
+begin
+  congrm ite _ 0 1,
+  exact h,
+end
+
+example {p q} [decidable p] [decidable q] (h : p ↔ q) :
+  ite p 0 1 = ite q 0 1 :=
+begin
+  congrm ite _ 0 1,
+  exact h,
+end
+
+example {a b : ℕ} (h : a = b) : (λ y : ℕ, ∀ z, a + a = z) = (λ x, ∀ z, b + a = z) :=
+begin
+  congrm λ x, ∀ w, _ + a = w,
+  exact h,
+end
+
+example (h : 5 = 3) : (⟨5 + 1, dec_trivial⟩ : fin 10) = ⟨3 + 1, dec_trivial⟩ :=
+begin
+  congrm ⟨_ + 1, _⟩,
+  exact h,
+end
+
+example : true ∧ false ↔ (true ∧ true) ∧ false :=
+begin
+  congrm _ ∧ _,
+  exact (true_and true).symm,
+end
+
+example {f g : ℕ → ℕ → ℕ} (h : f = g) : (λ i j, f i j) = (λ i j, g i j) :=
+begin
+  congrm λ i j, _,
+  guard_target f i j = g i j,
+  rw h,
+end
+
+example : true ∧ false ↔ (true ∧ true) ∧ false :=
+begin
+  congrm _₂ _ _,
+  exact (true_and true).symm,
+end
+
+example {g : X → X} (H : a = b) (H' : c + f a = c + f d) (H'' : f d = f b) :
+  f (g a) * (f d + (c + f a)) = f (g b) * (f b + (c + f d)) :=
+begin
+  congrm _₂ (f (_₁ _)) (_₂ _ _),
+  { exact H },
+  { exact H'' },
+  { exact H' },
+end
+
+example {A B C D E : Type*} [has_add A] [has_mul C] {a1 a2 a3 : A} (b1 b2 : B) {c1 c2 c3 : C}
+  (d1 d2 : D) (r : A → B → C → D → E)
+  (a23 : a2 = a3) (b12 : b1 = b2) (c23 : c2 = c3) (d12 : d1 = d2) :
+  r (a1 + a2) b1 (c1 * c2) d1 = r (a1 + a3) b2 (c1 * c3) d2 :=
+by congrm _₄ (_₂ _ _) _ (_₂ _ _) _; assumption
+
+example {A B C D : Type*} [has_add A] [has_mul C] {a1 a2 a3 : A} (b1 b2 : B) {c1 c2 c3 : C}
+  (r : A → B → C → D)
+  (a23 : a2 = a3) (b12 : b1 = b2) (c23 : c2 = c3) :
+  r (a1 + a2) b1 (c1 * c2) = r (a1 + a3) b2 (c1 * c3) :=
+by congrm _₃ (_₂ _ _) _ (_₂ _ _); assumption
+
+example {A : Type*} (s : A → ℕ) {a1 a3 : ℕ} {a4 a5 : A} (a45 : a4 = a5) :
+  (a1 + (s a4)) * a3 = (a1 + (s a5)) * a3 :=
+begin
+  congrm _₂ (_ + (_₁ _)) _,
+  exact a45,
+end
+
+example {A B C : Type*} [has_add A] [has_mul B] {a1 a2 a3 : A} (b1 b2 b3 : B)
+  (r : A → B → C) (a23 : a2 = a3) (b13 : b1 = b3) :
+  r (a1 + a2) (b1 * b2) = r (a1 + a3) (b3 * b2) :=
+by congrm _₂ (_₂ _ _) (_₂ _ _); assumption
+
+example {A B C : Type*} (r : A → B) (s : B → C) (a b : A) (ab : a = b) :
+  s (r a) = s (r b) :=
+begin
+  congrm _₁ (_₁ _),
+  exact ab,
+end
+
+open tactic
+
+example {A : Type} [has_add A] (a b c d e f : A) (r : A → A → A → A) (s : A → A)
+  (bd : b = d) (af : a = f) (bc : b = c) (ae : a = e) :
+  r b (a + s b) a = r d (f + s c) e :=
+begin
+  congrm _₃ _ (_ + (_₁ _)) _,
+  exact bd,
+  exact af,
+  exact bc,
+  exact ae,
+end
+
+example {A : Type} [has_add A] (a b c d : A) (r : A → A → A) (s : A → A) (bd : b = d) (bc : b = c) :
+  r b (a + s b) = r d (a + s c) :=
+begin
+  congrm _₂ _ (_₂ _ (s _)),  exact bd, exact bc,
+/-  any one of these alternatives to the line above proves the goal
+  congrm _₂ _ (_₂ _ (_₁ _)), exact bd, exact bc,
+  congrm _₂ _ (_ + (_₁ _)),  exact bd, exact bc,
+  congrm _₂ _ (_ + (s _)),   exact bd, exact bc,
+  congrm r _ (_₂ _ (s _)),   exact bd, exact bc,
+  congrm r _ (_₂ _ (_₁ _)),  exact bd, exact bc,
+  congrm r _ (_ + (s _)),    exact bd, exact bc,
+  congrm r _ (_ + (_₁ _)),   exact bd, exact bc,
+-/
+end
+
+example {W X Y Z : Type*} (w w' : W) (y y' : Y) (r : X → Y → Z) (s : W → X)
+  (hw : w = w') (hy : y = y') :
+  r (s w) y = r (s w') y' :=
+by congrm _₂ (_₁ _) _; assumption
+
+example {W X Y : Type*} (w w' : W) (y y' : Y) (r : X → Y → ℕ) (s : W → X)
+  (hw : w = w') (hy : y = y') :
+  (2 + 2) + r (s w) y = 2 * 2 + r (s w') y' :=
+by congrm _₂ (_₂ _ _) (_₂ (_₁ _) _); assumption
+
+example (h1 : 5 = 1) (h2 : 7 = 3) : nat.succ 5 + nat.pred 7 = nat.pred 3 * nat.succ 1 :=
+begin
+  congrm _₂ (_₁ _) (_₁ _);
+ -- the main goal becomes `3.succ + 1.pred = 3.pred * 1.succ` and `refl` closes it!
+  exact h1 <|> exact h2,
+end
+
+example {a b c d e f g h : ℕ} (ae : a = e) (bf : b = f) (cg : c = g)  (dh : d = h) :
+  (a + b) * (c - d.succ) = (e + f) * (g - h.succ) :=
+by congrm _₂ (_₂ _ _) (_₂ _ (_₁ _)); assumption
diff --git a/test/continuity.lean b/test/continuity.lean
index 6801d76bd80ae..ff2a2633c2acf 100644
--- a/test/continuity.lean
+++ b/test/continuity.lean
@@ -39,3 +39,14 @@ by guard_proof_term { continuity }
 -- ⊢ continuous complex.exp
 -- ⊢ continuous coe
 -- ⊢ continuous (λ (x : ℝ), ↑x)
+
+
+/-! Some tests of the `comp_of_eq` lemmas -/
+
+example {α β : Type*} [topological_space α] [topological_space β] {x₀ : α} (f : α → α → β)
+  (hf : continuous_at (function.uncurry f) (x₀, x₀)) :
+  continuous_at (λ x, f x x) x₀ :=
+begin
+  success_if_fail { exact hf.comp x (continuous_at_id.prod continuous_at_id) },
+  exact hf.comp_of_eq (continuous_at_id.prod continuous_at_id) rfl
+end
diff --git a/test/conv/apply_congr.lean b/test/conv/apply_congr.lean
index ed8b88f801226..053f9837ef1bb 100644
--- a/test/conv/apply_congr.lean
+++ b/test/conv/apply_congr.lean
@@ -4,8 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Lucas Allen, Scott Morrison
 -/
 
-import algebra.big_operators.basic
-import data.finsupp.basic
+import algebra.big_operators.finsupp
 import tactic.converter.apply_congr
 import tactic.interactive
 
diff --git a/test/convert.lean b/test/convert.lean
index 0e8f4ae2cf95b..d0d2b2d8d7120 100644
--- a/test/convert.lean
+++ b/test/convert.lean
@@ -3,7 +3,7 @@ Copyright (c) 2018 Simon Hudon. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Simon Hudon
 -/
-import data.set.basic
+import data.set.image
 import tactic.interactive
 
 open set
diff --git a/test/cycle.lean b/test/cycle.lean
index 90b5222aa9fb7..bc3424ef5b4bb 100644
--- a/test/cycle.lean
+++ b/test/cycle.lean
@@ -1,5 +1,5 @@
 import data.list.cycle
 
 run_cmd guard ("c[1, 4, 3, 2]" = repr (↑[1, 4, 3, 2] : cycle ℕ))
-run_cmd guard ("c[1, 4, 3, 2]" = repr (↑[2, 1, 4, 3] : cycle ℕ))
-run_cmd guard ("c[-1, 2, 1, 4]" = repr (↑[(2 : ℤ), 1, 4, -1] : cycle ℤ))
+run_cmd guard ("c[2, 1, 4, 3]" = repr (↑[2, 1, 4, 3] : cycle ℕ))
+run_cmd guard ("c[2, 1, 4, -1]" = repr (↑[(2 : ℤ), 1, 4, -1] : cycle ℤ))
diff --git a/test/delta_instance.lean b/test/delta_instance.lean
index 41110f7e75785..32a1bb7538793 100644
--- a/test/delta_instance.lean
+++ b/test/delta_instance.lean
@@ -3,7 +3,7 @@ Copyright (c) 2019 Robert Y. Lewis. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Robert Y. Lewis
 -/
-import data.set
+import data.set.basic
 import algebra.category.Mon.basic
 
 def X : Type := set ℕ
diff --git a/test/derive_fintype.lean b/test/derive_fintype.lean
index f71e0b8fae307..d7689c7101080 100644
--- a/test/derive_fintype.lean
+++ b/test/derive_fintype.lean
@@ -4,6 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 import tactic.derive_fintype
+import data.fintype.pi
+import data.fintype.prod
+import data.fintype.sigma
 
 @[derive fintype]
 inductive alphabet
diff --git a/test/equiv.lean b/test/equiv.lean
index a9b11aa92041b..07da7917028c4 100644
--- a/test/equiv.lean
+++ b/test/equiv.lean
@@ -1,5 +1,5 @@
 import data.set.finite
-import data.finset.basic
+import data.finset.image
 
 def s : finset (fin 3) := {0, 1}
 
diff --git a/test/equiv_rw.lean b/test/equiv_rw.lean
index a39015992dc92..ae548862f1509 100644
--- a/test/equiv_rw.lean
+++ b/test/equiv_rw.lean
@@ -276,9 +276,9 @@ end
 -- The constructions and proofs here are written as uniformly as possible.
 -- This example is the blueprint for the `transport` tactic.
 
-mk_simp_attribute transport_simps "simps useful inside `transport`"
+mk_simp_attribute transport_simps' "simps useful inside `transport`"
 
-attribute [transport_simps]
+attribute [transport_simps']
   eq_rec_constant
   cast_eq
   equiv.to_fun_as_coe
@@ -291,7 +291,7 @@ begin
   refine_struct { .. },
   { have mul := S.mul, equiv_rw e at mul, exact mul, },
   { try { unfold_projs },
-    simp only with transport_simps,
+    simp only with transport_simps',
     have mul_assoc := S.mul_assoc,
     equiv_rw e at mul_assoc,
     solve_by_elim, },
diff --git a/test/expand_exists.lean b/test/expand_exists.lean
new file mode 100644
index 0000000000000..852e8fd132dfd
--- /dev/null
+++ b/test/expand_exists.lean
@@ -0,0 +1,41 @@
+/-
+Copyright (c) 2022 Ian Wood. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Ian Wood
+-/
+import tactic.basic
+import tactic.expand_exists
+
+@[expand_exists nat_greater nat_greater_spec]
+lemma nat_greater_exists (n : ℕ) : ∃ m : ℕ, n < m := ⟨n + 1, by fconstructor⟩
+
+noncomputable def nat_greater_res : ℕ → ℕ := nat_greater
+lemma nat_greater_spec_res : ∀ (n : ℕ), n < nat_greater n := nat_greater_spec
+
+@[expand_exists dependent_type dependent_type_val dependent_type_spec]
+lemma dependent_type_exists {α : Type*} (a : α) : ∃ {β : Type} (b : β), (a, b) = (a, b) :=
+⟨unit, (), rfl⟩
+
+def dependent_type_res {α : Type*} (a : α) : Type := dependent_type a
+noncomputable def dependent_type_val_res {α : Type*} (a : α) : dependent_type a :=
+dependent_type_val a
+lemma dependent_type_spec_res
+{α : Type*} (a : α) : (a, dependent_type_val a) = (a, dependent_type_val a) := dependent_type_spec a
+
+@[expand_exists nat_greater_nosplit nat_greater_nosplit_spec,
+  expand_exists nat_greater_split nat_greater_split_lt nat_greater_split_neq]
+lemma nat_greater_exists₂ (n : ℕ) : ∃ m : ℕ, n < m ∧ m ≠ 0 := begin
+  use n + 1,
+  split,
+  fconstructor,
+  finish,
+end
+
+noncomputable def nat_greater_nosplit_res : ℕ → ℕ := nat_greater_nosplit
+noncomputable def nat_greater_split_res : ℕ → ℕ := nat_greater_split
+
+lemma nat_greater_nosplit_spec_res :
+∀ (n : ℕ), n < nat_greater_nosplit n ∧ nat_greater_nosplit n ≠ 0 := nat_greater_nosplit_spec
+
+lemma nat_greater_split_spec_lt_res : ∀ (n : ℕ), n < nat_greater_nosplit n := nat_greater_split_lt
+lemma nat_greater_split_spec_neq_res : ∀ (n : ℕ), nat_greater_nosplit n ≠ 0 := nat_greater_split_neq
diff --git a/test/field_simp.lean b/test/field_simp.lean
new file mode 100644
index 0000000000000..cbe7c11dc5a4e
--- /dev/null
+++ b/test/field_simp.lean
@@ -0,0 +1,51 @@
+import algebra.ring.basic
+import tactic.field_simp
+import tactic.ring
+
+/-!
+## `field_simp` tests.
+
+Check that `field_simp` works for units of a ring.
+-/
+
+variables {R : Type*} [comm_ring R] (a b c d e f g : R) (u₁ u₂ : Rˣ)
+
+/--
+Check that `divp_add_divp_same` takes priority over `divp_add_divp`.
+-/
+example : a /ₚ u₁ + b /ₚ u₁ = (a + b) /ₚ u₁ :=
+by field_simp
+
+/--
+Check that `divp_sub_divp_same` takes priority over `divp_sub_divp`.
+-/
+example : a /ₚ u₁ - b /ₚ u₁ = (a - b) /ₚ u₁ :=
+by field_simp
+
+/--
+Combining `eq_divp_iff_mul_eq` and `divp_eq_iff_mul_eq`.
+-/
+example : a /ₚ u₁ = b /ₚ u₂ ↔ a * u₂ = b * u₁ :=
+by field_simp
+
+/--
+Making sure inverses of units are rewritten properly.
+-/
+example : ↑u₁⁻¹ = 1 /ₚ u₁ :=
+by field_simp
+
+/--
+Checking arithmetic expressions.
+-/
+example : (f - (e + c * -(a /ₚ u₁) * b + d) - g) =
+  (f * u₁ - (e * u₁ + c * (-a) * b + d * u₁) - g * u₁) /ₚ u₁ :=
+by field_simp
+
+/--
+Division of units.
+-/
+example : a /ₚ (u₁ / u₂) = a * u₂ /ₚ u₁ :=
+by field_simp
+
+example : a /ₚ u₁ /ₚ u₂ = a /ₚ (u₂ * u₁) :=
+by field_simp
diff --git a/test/fin_cases.lean b/test/fin_cases.lean
index 043d4585cc8e2..eaadb04f31273 100644
--- a/test/fin_cases.lean
+++ b/test/fin_cases.lean
@@ -105,21 +105,18 @@ end
 In some circumstances involving `let`,
 the temporary hypothesis that `fin_cases` creates does not get deleted.
 We test that this is correctly named and that the name can be changed.
-
-Note: after `fin_cases`, we have `this : (a : fin 3) = (0 : fin (2 + 1))`
-for some reason. I don't know why, and it complicates the test.
 -/
 example (f : ℕ → fin 3) : true :=
 begin
   let a := f 3,
   fin_cases a,
   guard_hyp a := f 3,
-  guard_hyp this : a = (0 : fin (2 + 1)),
+  guard_hyp this : a = (0 : fin 3),
   trivial, trivial,
 
   let b := f 2,
   fin_cases b using what,
-  guard_hyp what : b = (0 : fin (2 + 1)),
+  guard_hyp what : b = (0 : fin 3),
 
   all_goals {trivial}
 end
diff --git a/test/finish4.lean b/test/finish4.lean
index 3bc84021728a6..8b75d9f0a874b 100644
--- a/test/finish4.lean
+++ b/test/finish4.lean
@@ -7,7 +7,7 @@ Tests for `finish using [...]`
 -/
 
 import tactic.finish
-import algebra.order.ring
+import algebra.order.ring.defs
 
 section list_rev
 open list
diff --git a/test/free_algebra.lean b/test/free_algebra.lean
index 4e3b18edf7702..b8bdac6c6853f 100644
--- a/test/free_algebra.lean
+++ b/test/free_algebra.lean
@@ -5,7 +5,7 @@ Authors: Eric Wieser
 -/
 
 import linear_algebra.exterior_algebra.basic
-import linear_algebra.clifford_algebra
+import linear_algebra.clifford_algebra.basic
 
 /-!
 Tests that the ring instances for `free_algebra` and derived quotient types actually work.
@@ -31,7 +31,7 @@ end free
 
 section exterior
 
-variables [comm_ring S] [add_comm_monoid M] [module S M]
+variables [comm_ring S] [add_comm_group M] [module S M]
 
 example : (1 : exterior_algebra S M) - (1 : exterior_algebra S M) = 0 := by rw sub_self
 
diff --git a/test/gmonoid.lean b/test/gmonoid.lean
new file mode 100644
index 0000000000000..0c6c7a8b25eb1
--- /dev/null
+++ b/test/gmonoid.lean
@@ -0,0 +1,30 @@
+/-
+Copyright (c) 2021 Eric Wieser. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Eric Wieser
+-/
+import algebra.direct_sum.ring
+import data.fin.tuple.basic
+
+/-! # Tuples `fin n → α` form a graded monoid with `*` as `fin.append`
+
+Defining multiplication as concatenation isn't particularly canonical, so we do not provide
+this in mathlib. We could safely provide this instance on a type alias, but for now we just put
+this in `tests` to verify that this definition is possible. -/
+
+namespace fin
+
+variables {α : Type*} {α' : Type*} {na nb nc : ℕ}
+
+example {α : Type*} : graded_monoid.gmonoid (λ n, fin n → α) :=
+{ mul := λ i j, fin.append,
+  one := fin.elim0,
+  one_mul := λ b, sigma_eq_of_eq_comp_cast _ (elim0'_append _),
+  mul_one := λ a, sigma_eq_of_eq_comp_cast _ (append_elim0' _),
+  mul_assoc := λ a b c,
+    sigma_eq_of_eq_comp_cast (add_assoc _ _ _) $ (append_assoc a.2 b.2 c.2).trans rfl,
+  gnpow := λ n i a, repeat n a,
+  gnpow_zero' := λ a, sigma_eq_of_eq_comp_cast _ (repeat_zero _),
+  gnpow_succ' := λ a n, sigma_eq_of_eq_comp_cast _ (repeat_succ _ _) }
+
+end fin
diff --git a/test/has_scalar_comp_loop.lean b/test/has_scalar_comp_loop.lean
index 3690a20bb990a..a853931895990 100644
--- a/test/has_scalar_comp_loop.lean
+++ b/test/has_scalar_comp_loop.lean
@@ -2,34 +2,34 @@ import group_theory.group_action.basic
 
 variables (R M S : Type*)
 
-/-- Some arbitrary type depending on `has_scalar R M` -/
-@[irreducible, nolint has_inhabited_instance unused_arguments]
-def foo [has_scalar R M] : Type* := ℕ
+/-- Some arbitrary type depending on `has_smul R M` -/
+@[irreducible, nolint has_nonempty_instance unused_arguments]
+def foo [has_smul R M] : Type* := ℕ
 
-variables [has_scalar R M] [has_scalar S R] [has_scalar S M]
+variables [has_smul R M] [has_smul S R] [has_smul S M]
 
-/-- This instance is incompatible with `has_scalar.comp.is_scalar_tower`.
+/-- This instance is incompatible with `has_smul.comp.is_scalar_tower`.
 However, all its parameters are (instance) implicits or irreducible defs, so it
 should not be dangerous. -/
 @[nolint unused_arguments]
-instance foo.has_scalar [is_scalar_tower S R M] : has_scalar S (foo R M) :=
+instance foo.has_smul [is_scalar_tower S R M] : has_smul S (foo R M) :=
 ⟨λ _ _, by { unfold foo, exact 37 }⟩
 
 -- If there is no `is_scalar_tower S R M` parameter, this should fail quickly,
 -- not loop forever.
-example : has_scalar S (foo R M) :=
+example : has_smul S (foo R M) :=
 begin
   tactic.success_if_fail_with_msg tactic.interactive.apply_instance
     "tactic.mk_instance failed to generate instance for
-  has_scalar S (foo R M)",
+  has_smul S (foo R M)",
   unfold foo,
   exact ⟨λ _ _, 37⟩
 end
 
 /-
-local attribute [instance] has_scalar.comp.is_scalar_tower
--- When `has_scalar.comp.is_scalar_tower` is an instance, this recurses indefinitely.
-example : has_scalar S (foo R M) :=
+local attribute [instance] has_smul.comp.is_scalar_tower
+-- When `has_smul.comp.is_scalar_tower` is an instance, this recurses indefinitely.
+example : has_smul S (foo R M) :=
 begin
   tactic.success_if_fail_with_msg tactic.interactive.apply_instance
     "maximum class-instance resolution depth has been reached (the limit can be increased by setting option 'class.instance_max_depth') (the class-instance resolution trace can be visualized by setting option 'trace.class_instances')",
diff --git a/test/import_order_timeout.lean b/test/import_order_timeout.lean
index ab34e9eb13a25..b3ebf8c1725d9 100644
--- a/test/import_order_timeout.lean
+++ b/test/import_order_timeout.lean
@@ -5,7 +5,7 @@ import deprecated.subring
 -- This was not the cases on commit `df4500242eb6aa6ee20b315b185b0f97a9b359c5`.
 -- You would get a timeout.
 
-import algebra.module.submodule
+import algebra.module.submodule.basic
 
 variables {R M N P Q : Type*} [comm_ring R]
 variables [add_comm_group M] [module R M]
diff --git a/test/induction.lean b/test/induction.lean
index 8cbb43218df8c..91c7afa2411f1 100644
--- a/test/induction.lean
+++ b/test/induction.lean
@@ -1,3 +1,5 @@
+import data.list.basic
+import topology.basic
 import tactic.induction
 import tactic.linarith
 
@@ -1080,8 +1082,8 @@ begin
     exact small_step.while, }
 end
 
-infixr ` ⇒ ` := small_step
-infixr ` ⇒* ` : 100 := star small_step
+infixr (name := small_step) ` ⇒ ` := small_step
+infixr (name := small_step.star) ` ⇒* ` : 100 := star small_step
 
 
 /- More lemmas about big-step and small-step semantics. These are taken from the
diff --git a/test/instance_diamonds.lean b/test/instance_diamonds.lean
index 981910ae27a2d..8cdfb34b3d0d4 100644
--- a/test/instance_diamonds.lean
+++ b/test/instance_diamonds.lean
@@ -10,31 +10,74 @@ import group_theory.group_action.prod
 import group_theory.group_action.units
 import data.complex.module
 import ring_theory.algebraic
+import data.zmod.basic
+import ring_theory.tensor_product
 
 /-! # Tests that instances do not form diamonds -/
 
 /-! ## Scalar action instances -/
-section has_scalar
+section has_smul
 open_locale polynomial
 
 example :
-  (sub_neg_monoid.has_scalar_int : has_scalar ℤ ℂ) = (complex.has_scalar : has_scalar ℤ ℂ) :=
+  (sub_neg_monoid.has_smul_int : has_smul ℤ ℂ) = (complex.has_smul : has_smul ℤ ℂ) :=
 rfl
 
 example : restrict_scalars.module ℝ ℂ ℂ = complex.module := rfl
 example : restrict_scalars.algebra ℝ ℂ ℂ = complex.algebra := rfl
 
 example (α β : Type*) [add_monoid α] [add_monoid β] :
-  (prod.has_scalar : has_scalar ℕ (α × β)) = add_monoid.has_scalar_nat := rfl
+  (prod.has_smul : has_smul ℕ (α × β)) = add_monoid.has_smul_nat := rfl
 
 example (α β : Type*) [sub_neg_monoid α] [sub_neg_monoid β] :
-  (prod.has_scalar : has_scalar ℤ (α × β)) = sub_neg_monoid.has_scalar_int := rfl
+  (prod.has_smul : has_smul ℤ (α × β)) = sub_neg_monoid.has_smul_int := rfl
 
 example (α : Type*) (β : α → Type*) [Π a, add_monoid (β a)] :
-  (pi.has_scalar : has_scalar ℕ (Π a, β a)) = add_monoid.has_scalar_nat := rfl
+  (pi.has_smul : has_smul ℕ (Π a, β a)) = add_monoid.has_smul_nat := rfl
 
 example (α : Type*) (β : α → Type*) [Π a, sub_neg_monoid (β a)] :
-  (pi.has_scalar : has_scalar ℤ (Π a, β a)) = sub_neg_monoid.has_scalar_int := rfl
+  (pi.has_smul : has_smul ℤ (Π a, β a)) = sub_neg_monoid.has_smul_int := rfl
+
+namespace tensor_product
+
+open_locale tensor_product
+open complex
+
+/-! The `example` below times out. TODO Fix it!
+
+/- `tensor_product.algebra.module` forms a diamond with `has_mul.to_has_smul` and
+`algebra.tensor_product.tensor_product.semiring`. Given a commutative semiring `A` over a
+commutative semiring `R`, we get two mathematically different scalar actions of `A ⊗[R] A` on
+itself. -/
+def f : ℂ ⊗[ℝ] ℂ →ₗ[ℝ] ℝ :=
+tensor_product.lift
+{ to_fun    := λ z, z.re • re_lm,
+  map_add'  := λ z w, by simp [add_smul],
+  map_smul' := λ r z, by simp [mul_smul], }
+
+@[simp] lemma f_apply (z w : ℂ) : f (z ⊗ₜ[ℝ] w) = z.re * w.re := by simp [f]
+
+/- `tensor_product.algebra.module` forms a diamond with `has_mul.to_has_smul` and
+`algebra.tensor_product.tensor_product.semiring`. Given a commutative semiring `A` over a
+commutative semiring `R`, we get two mathematically different scalar actions of `A ⊗[R] A` on
+itself. -/
+example :
+  has_mul.to_has_smul (ℂ ⊗[ℝ] ℂ) ≠
+  (@tensor_product.algebra.module ℝ ℂ ℂ (ℂ ⊗[ℝ] ℂ) _ _ _ _ _ _ _ _ _ _ _ _).to_has_smul :=
+begin
+  have contra : I ⊗ₜ[ℝ] I ≠ (-1) ⊗ₜ[ℝ] 1 := λ c, by simpa using congr_arg f c,
+  contrapose! contra,
+  rw has_smul.ext_iff at contra,
+  replace contra := congr_fun (congr_fun contra (1 ⊗ₜ I)) (I ⊗ₜ 1),
+  rw @tensor_product.algebra.smul_def ℝ ℂ ℂ (ℂ ⊗[ℝ] ℂ) _ _ _ _ _ _ _ _ _ _ _ _
+    (1 : ℂ) I (I ⊗ₜ[ℝ] (1 : ℂ)) at contra,
+  simpa only [algebra.id.smul_eq_mul, algebra.tensor_product.tmul_mul_tmul, one_mul, mul_one,
+    one_smul, tensor_product.smul_tmul', I_mul_I] using contra,
+end
+
+-/
+
+end tensor_product
 
 section units
 
@@ -60,22 +103,22 @@ rfl -- fails
 
 end units
 
-end has_scalar
+end has_smul
 
 /-! ## `with_top` (Type with point at infinity) instances -/
 section with_top
 
-example (R : Type*) [h : ordered_semiring R] :
+example (R : Type*) [h : strict_ordered_semiring R] :
   (@with_top.add_comm_monoid R
     (@non_unital_non_assoc_semiring.to_add_comm_monoid R
       (@non_assoc_semiring.to_non_unital_non_assoc_semiring R
         (@semiring.to_non_assoc_semiring R
-          (@ordered_semiring.to_semiring R h)))))
+          (@strict_ordered_semiring.to_semiring R h)))))
         =
   (@ordered_add_comm_monoid.to_add_comm_monoid (with_top R)
     (@with_top.ordered_add_comm_monoid R
       (@ordered_cancel_add_comm_monoid.to_ordered_add_comm_monoid R
-        (@ordered_semiring.to_ordered_cancel_add_comm_monoid R h)))) :=
+        (@strict_ordered_semiring.to_ordered_cancel_add_comm_monoid R h)))) :=
 rfl
 
 end with_top
@@ -107,13 +150,13 @@ end multiplicative
 section finsupp
 open finsupp
 
-/-- `finsupp.comap_has_scalar` can form a non-equal diamond with `finsupp.has_scalar` -/
+/-- `finsupp.comap_has_smul` can form a non-equal diamond with `finsupp.smul_zero_class` -/
 example {k : Type*} [semiring k] [nontrivial k] :
-  (finsupp.comap_has_scalar : has_scalar k (k →₀ k)) ≠ finsupp.has_scalar :=
+  (finsupp.comap_has_smul : has_smul k (k →₀ k)) ≠ finsupp.smul_zero_class.to_has_smul :=
 begin
   obtain ⟨u : k, hu⟩ := exists_ne (1 : k),
   intro h,
-  simp only [has_scalar.ext_iff, function.funext_iff, finsupp.ext_iff] at h,
+  simp only [has_smul.ext_iff, function.funext_iff, finsupp.ext_iff] at h,
   replace h := h u (finsupp.single 1 1) u,
   classical,
   rw [comap_smul_single, smul_apply, smul_eq_mul, mul_one, single_eq_same,
@@ -121,15 +164,15 @@ begin
   exact one_ne_zero h,
 end
 
-/-- `finsupp.comap_has_scalar` can form a non-equal diamond with `finsupp.has_scalar` even when
+/-- `finsupp.comap_has_smul` can form a non-equal diamond with `finsupp.smul_zero_class` even when
 the domain is a group. -/
 example {k : Type*} [semiring k] [nontrivial kˣ] :
-  (finsupp.comap_has_scalar : has_scalar kˣ (kˣ →₀ k)) ≠ finsupp.has_scalar :=
+  (finsupp.comap_has_smul : has_smul kˣ (kˣ →₀ k)) ≠ finsupp.smul_zero_class.to_has_smul :=
 begin
   obtain ⟨u : kˣ, hu⟩ := exists_ne (1 : kˣ),
   haveI : nontrivial k := ⟨⟨u, 1, units.ext.ne hu⟩⟩,
   intro h,
-  simp only [has_scalar.ext_iff, function.funext_iff, finsupp.ext_iff] at h,
+  simp only [has_smul.ext_iff, function.funext_iff, finsupp.ext_iff] at h,
   replace h := h u (finsupp.single 1 1) u,
   classical,
   rw [comap_smul_single, smul_apply, units.smul_def, smul_eq_mul, mul_one, single_eq_same,
@@ -146,27 +189,61 @@ variables (R A : Type*)
 open_locale polynomial
 open polynomial
 
-/-- `polynomial.has_scalar_pi` forms a diamond with `pi.has_scalar`. -/
+/-- `polynomial.has_smul_pi` forms a diamond with `pi.has_smul`. -/
 example [semiring R] [nontrivial R] :
-  polynomial.has_scalar_pi _ _ ≠ (pi.has_scalar : has_scalar R[X] (R → R[X])) :=
+  polynomial.has_smul_pi _ _ ≠ (pi.has_smul : has_smul R[X] (R → R[X])) :=
 begin
   intro h,
-  simp_rw [has_scalar.ext_iff, function.funext_iff, polynomial.ext_iff] at h,
+  simp_rw [has_smul.ext_iff, function.funext_iff, polynomial.ext_iff] at h,
   simpa using h X 1 1 0,
 end
 
-/-- `polynomial.has_scalar_pi'` forms a diamond with `pi.has_scalar`. -/
+/-- `polynomial.has_smul_pi'` forms a diamond with `pi.has_smul`. -/
 example [comm_semiring R] [nontrivial R] :
-  polynomial.has_scalar_pi' _ _ _ ≠ (pi.has_scalar : has_scalar R[X] (R → R[X])) :=
+  polynomial.has_smul_pi' _ _ _ ≠ (pi.has_smul : has_smul R[X] (R → R[X])) :=
 begin
   intro h,
-  simp_rw [has_scalar.ext_iff, function.funext_iff, polynomial.ext_iff] at h,
+  simp_rw [has_smul.ext_iff, function.funext_iff, polynomial.ext_iff] at h,
   simpa using h X 1 1 0,
 end
 
-/-- `polynomial.has_scalar_pi'` is consistent with `polynomial.has_scalar_pi`. -/
+/-- `polynomial.has_smul_pi'` is consistent with `polynomial.has_smul_pi`. -/
 example [comm_semiring R] [nontrivial R] :
-  polynomial.has_scalar_pi' _ _ _ = (polynomial.has_scalar_pi _ _ : has_scalar R[X] (R → R[X])) :=
+  polynomial.has_smul_pi' _ _ _ = (polynomial.has_smul_pi _ _ : has_smul R[X] (R → R[X])) :=
 rfl
 
+/-- `polynomial.algebra_of_algebra` is consistent with `algebra_nat`. -/
+example [semiring R] : (polynomial.algebra_of_algebra : algebra ℕ R[X]) = algebra_nat := rfl
+
+/-- `polynomial.algebra_of_algebra` is consistent with `algebra_int`. -/
+example [ring R] : (polynomial.algebra_of_algebra : algebra ℤ R[X]) = algebra_int _ := rfl
+
 end polynomial
+
+/-! ## `subtype` instances -/
+section subtype
+
+-- this diamond is the reason that `fintype.to_locally_finite_order` is not an instance
+example {α} [preorder α] [locally_finite_order α] [fintype α] [@decidable_rel α (<)]
+  [@decidable_rel α (≤)] (p : α → Prop) [decidable_pred p] :
+  subtype.locally_finite_order p = fintype.to_locally_finite_order :=
+begin
+  success_if_fail { refl, },
+  exact subsingleton.elim _ _
+end
+
+end subtype
+
+/-! ## `zmod` instances -/
+section zmod
+
+variables {p : ℕ} [fact p.prime]
+
+example : @euclidean_domain.to_comm_ring _ (@field.to_euclidean_domain _ (zmod.field p)) =
+  zmod.comm_ring p :=
+rfl
+
+example (n : ℕ) : zmod.comm_ring (n + 1) = fin.comm_ring (n + 1) := rfl
+example : zmod.comm_ring 0 = int.comm_ring := rfl
+
+end zmod
diff --git a/test/integration.lean b/test/integration.lean
index 1bcdadde7aed5..ac763e3ca7fc6 100644
--- a/test/integration.lean
+++ b/test/integration.lean
@@ -31,7 +31,7 @@ example : ∫ x in 0..π, 2 * sin x = 4 := by norm_num
 example : ∫ x in 0..π/2, cos x / 2 = 1 / 2 := by simp
 example : ∫ x : ℝ in 0..1, 1 / (1 + x ^ 2) = π / 4 := by simp
 example : ∫ x in 0..2*π, sin x ^ 2 = π := by simp [mul_div_cancel_left]
-example : ∫ x in 0..π/2, cos x ^ 2 / 2 = π / 8 := by norm_num [div_div_eq_div_mul]
+example : ∫ x in 0..π/2, cos x ^ 2 / 2 = π / 8 := by norm_num [div_div]
 example : ∫ x in 0..π, cos x ^ 2 - sin x ^ 2 = 0 := by simp [integral_cos_sq_sub_sin_sq]
 example : ∫ x in 0..π/2, sin x ^ 3 = 2 / 3 := by norm_num
 example : ∫ x in 0..π/2, cos x ^ 3 = 2 / 3 := by norm_num
@@ -54,7 +54,7 @@ example : ∫ x : ℝ in 0..1, exp x + 9 * x^8 + x^3 - x/2 + (1 + x^2)⁻¹ = ex
 example : ∫ x in 0..2, -exp (-x) = exp (-2) - 1 := by norm_num
 example : ∫ x in 1..2, exp (5*x - 5) = 1/5 * (exp 5 - 1) := by norm_num
 example : ∫ x in 0..π, cos (x/2) = 2 := by norm_num
-example : ∫ x in 0..π/4, sin (2*x) = 1/2 := by norm_num [mul_div_comm, mul_one_div]
+example : ∫ x in 0..π/4, sin (2*x) = 1/2 := by norm_num [mul_div_left_comm, mul_one_div]
 example (ω φ : ℝ) : ω * ∫ θ in 0..π, sin (ω*θ + φ) = cos φ - cos (ω*π + φ) := by simp
 
 /- some examples may require a bit of algebraic massaging -/
diff --git a/test/interval_cases.lean b/test/interval_cases.lean
index 760ee945abfb6..5c9f6074378f2 100644
--- a/test/interval_cases.lean
+++ b/test/interval_cases.lean
@@ -127,6 +127,22 @@ begin
   { right, exact hrv }
 end
 
+/- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/interval_cases.20bug -/
+example {x : ℕ} (hx2 : x < 2) (h : false) : false :=
+begin
+  have : x ≤ 1,
+  interval_cases x,
+  exact zero_le_one,  -- this solves the side-goal left by `interval_cases`, closing the `have`
+  exact h,
+end
+
+example : ∀ y, y ≤ 3 → true :=
+begin
+  refine λ y hy, _,
+  interval_cases y,
+  all_goals { trivial },
+end
+
 /-
 Sadly, this one doesn't work, reporting:
   `deep recursion was detected at 'expression equality test'`
diff --git a/test/json.lean b/test/json.lean
new file mode 100644
index 0000000000000..0793c113b2aa7
--- /dev/null
+++ b/test/json.lean
@@ -0,0 +1,101 @@
+import data.json
+
+run_cmd do
+  let j := json.of_int 2,
+  z ← of_json native.float j,
+  guard (z = 2)
+
+run_cmd do
+  j ← json.parse "2.0",
+  tactic.success_if_fail_with_msg (of_json ℤ j) "number must be integral"
+
+run_cmd do
+  let j := json.of_int (-1),
+  tactic.success_if_fail_with_msg (of_json ℕ j) "must be non-negative"
+
+run_cmd do
+  let j := json.of_int 1,
+  v ← of_json {x // x ≠ some 2} j,
+  guard (v = ⟨some 1, dec_trivial⟩),
+  v ← of_json (option {x // x ≠ 2}) j,
+  guard (v = some ⟨1, dec_trivial⟩)
+
+run_cmd do
+  let j := json.null,
+  v ← of_json {x // x ≠ some 2} j,
+  guard (v = ⟨none, dec_trivial⟩),
+  v ← of_json (option {x // x ≠ 2}) j,
+  guard (v = none)
+
+@[derive [decidable_eq, non_null_json_serializable]]
+structure my_type (yval : bool) :=
+(x : nat)
+(f : fin x)
+(y : bool)
+(h : y = yval)
+
+run_cmd do
+  let actual := to_json (my_type.mk 37 2 tt rfl),
+  let expected := json.object [("x", json.of_int 37), ("f", json.of_int 2), ("y", json.of_bool tt)],
+  guard (actual = expected)
+
+run_cmd do
+  some j ← pure (json.parse "{\"x\":37,\"f\":2,\"y\":true}"),
+  x ← of_json (my_type tt) j,
+  guard (x = ⟨37, 2, tt, rfl⟩)
+
+run_cmd do
+  some j ← pure (json.parse "{\"x\":37,\"f\":2,\"y\":true,\"z\":true}"),
+  tactic.success_if_fail_with_msg (of_json (my_type tt) j) "unexpected fields [z]"
+
+run_cmd do
+  some j ← pure (json.parse "{\"x\":37}"),
+  tactic.success_if_fail_with_msg (of_json (my_type tt) j) "field f is required"
+
+run_cmd do
+  let j := json.object [("x", to_json 37), ("x", to_json 37)],
+  tactic.success_if_fail_with_msg (of_json (my_type tt) j) "duplicate x field"
+
+run_cmd do
+  let j := json.null,
+  tactic.success_if_fail_with_msg (of_json (my_type tt) j) "object expected, got null"
+
+run_cmd do
+  some j ← pure (json.parse "{\"x\":37,\"f\":2,\"y\":false}"),
+  tactic.success_if_fail_with_msg (of_json (my_type tt) j) "condition does not hold"
+
+@[derive [decidable_eq, non_null_json_serializable]]
+structure no_fields (n : ℕ) : Type
+
+run_cmd do
+  let actual := to_json (@no_fields.mk 37),
+  let expected := json.object [],
+  guard (actual = expected)
+
+run_cmd do
+  some j ← pure (json.parse "{}"),
+  of_json (@no_fields 37) j
+
+@[derive [decidable_eq, non_null_json_serializable]]
+structure has_default : Type :=
+(x : ℕ := 2)
+(y : fin x.succ := 3 * fin.of_nat x)
+(z : ℕ := 3)
+
+run_cmd do
+  e ← of_json has_default (json.object []),
+  guard (e = {})
+
+run_cmd do
+  let actual := to_json (has_default.mk 2 1 3),
+  let expected := json.object [("x", json.of_int 2), ("y", json.of_int 1), ("z", json.of_int 3)],
+  guard (actual = expected)
+
+run_cmd do
+  some j ← pure (json.parse "{\"x\":1,\"z\":3}"),
+  of_json has_default j
+
+run_cmd do
+  some j ← pure (json.parse "{\"y\":2}"),
+  v ← of_json has_default j,
+  guard (v = {y := 2})
diff --git a/test/library_search/filter.lean b/test/library_search/filter.lean
index 97f2cd00903b5..637aeac5ce371 100644
--- a/test/library_search/filter.lean
+++ b/test/library_search/filter.lean
@@ -5,9 +5,21 @@ open filter
 /- Turn off trace messages so they don't pollute the test build: -/
 set_option trace.silence_library_search true
 
+-- The following fails with a deterministic timeout.
+-- example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
+--   (hf : tendsto f A B) (hg : tendsto g B C) : map (g ∘ f) A = map g (map f A) :=
+-- by library_search
+
 example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
-  (hf : tendsto f A B) (hg : tendsto g B C) : tendsto (g ∘ f) A C :=
+  (hf : tendsto f A B) (hg : tendsto g B C) : map g (map f A) ≤ C :=
 calc
-map (g ∘ f) A = map g (map f A) : by library_search
-          ... ≤ map g B         : by library_search!
+map g (map f A) ≤ map g B       : by library_search!
           ... ≤ C               : by library_search!
+
+-- this was the original version of the test, as of Dec 2022 it times out
+-- example {α β γ : Type*} {A : filter α} {B : filter β} {C : filter γ} {f : α → β} {g : β → γ}
+--   (hf : tendsto f A B) (hg : tendsto g B C) : tendsto (g ∘ f) A C :=
+-- calc
+-- map (g ∘ f) A = map g (map f A) : by library_search
+--           ... ≤ map g B         : by library_search!
+--           ... ≤ C               : by library_search!
diff --git a/test/library_search/nat.lean b/test/library_search/nat.lean
index 2f88dfda03f36..784bf45f9b330 100644
--- a/test/library_search/nat.lean
+++ b/test/library_search/nat.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 import tactic.suggest
-import data.nat.basic
+import data.nat.order.basic
 
 namespace test.library_search
 
diff --git a/test/library_search/ordered_ring.lean b/test/library_search/ordered_ring.lean
index db8005ccb4005..9170a25d5a9a2 100644
--- a/test/library_search/ordered_ring.lean
+++ b/test/library_search/ordered_ring.lean
@@ -4,8 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Scott Morrison
 -/
 import tactic.basic
-import data.nat.basic
-import algebra.order.ring
+import data.nat.order.basic
+import algebra.order.ring.defs
 
 /- Turn off trace messages so they don't pollute the test build: -/
 set_option trace.silence_library_search true
diff --git a/test/library_search/ring_theory.lean b/test/library_search/ring_theory.lean
index 11c3534b0b6e2..b483f4a48a992 100644
--- a/test/library_search/ring_theory.lean
+++ b/test/library_search/ring_theory.lean
@@ -5,7 +5,7 @@ Authors: Scott Morrison
 -/
 import tactic.suggest
 import ring_theory.principal_ideal_domain
-import ring_theory.polynomial
+import ring_theory.polynomial.basic
 
 open_locale polynomial
 /- Turn off trace messages so they don't pollute the test build: -/
diff --git a/test/lift.lean b/test/lift.lean
index 2ff6db4df82ea..b48d2b0a69e93 100644
--- a/test/lift.lean
+++ b/test/lift.lean
@@ -1,8 +1,7 @@
-import data.int.basic
+import data.set.basic
 import tactic.lift
 
 /-! Some tests of the `lift` tactic. -/
-
 example (n m k x z u : ℤ) (hn : 0 < n) (hk : 0 ≤ k + n) (hu : 0 ≤ u)
   (h : k + n = 2 + x) (f : false) :
   k + n = m + x :=
@@ -10,15 +9,15 @@ begin
   lift n to ℕ using le_of_lt hn,
     guard_target (k + ↑n = m + x), guard_hyp hn : (0 : ℤ) < ↑n,
   lift m to ℕ,
-    guard_target (k + ↑n = ↑m + x), tactic.swap, guard_target (0 ≤ m), tactic.swap,
+    guard_target (0 ≤ m), tactic.swap, guard_target (k + ↑n = ↑m + x),
     tactic.num_goals >>= λ n, guard (n = 2),
   lift (k + n) to ℕ using hk with l hl,
     guard_hyp l : ℕ, guard_hyp hl : ↑l = k + ↑n, guard_target (↑l = ↑m + x),
     tactic.success_if_fail (tactic.get_local `hk),
   lift x to ℕ with y hy,
-    guard_hyp y : ℕ, guard_hyp hy : ↑y = x, guard_target (↑l = ↑m + x),
+    tactic.swap, guard_hyp y : ℕ, guard_hyp hy : ↑y = x, guard_target (↑l = ↑m + x), tactic.swap,
   lift z to ℕ with w,
-    guard_hyp w : ℕ, tactic.success_if_fail (tactic.get_local `z),
+    tactic.swap, guard_hyp w : ℕ, tactic.success_if_fail (tactic.get_local `z), tactic.swap,
   lift u to ℕ using hu with u rfl hu,
     guard_hyp hu : (0 : ℤ) ≤ ↑u,
 
@@ -31,7 +30,7 @@ begin
   lift f to α → ℕ using hf,
     guard_target ((0:ℤ) ≤ 2 * (λ i : α, (f i : ℤ)) a),
     guard_hyp hf' : ∀ a, ((λ i : α, (f i:ℤ)) a) < 1,
-  exact int.coe_nat_nonneg _
+  constructor,
 end
 
 -- fail gracefully when the lifted variable is a local definition
@@ -44,19 +43,16 @@ begin
   refl
 end
 
-instance can_lift_unit : can_lift unit unit :=
-⟨id, λ x, true, λ x _, ⟨x, rfl⟩⟩
-
-/- test whether new instances of `can_lift` are added as simp lemmas -/
-run_cmd do l ← can_lift_attr.get_cache, guard (`can_lift_unit ∈ l)
+instance can_lift_unit : can_lift unit unit id (λ _, true) := ⟨λ x _, ⟨x, rfl⟩⟩
 
 /- test error messages -/
 example (n : ℤ) (hn : 0 < n) : true :=
 begin
-  success_if_fail_with_msg {lift n to ℕ using hn} "lift tactic failed.
-invalid type ascription, term has type\n  0 < n\nbut is expected to have type\n  0 ≤ n",
+  success_if_fail_with_msg {lift n to ℕ using hn} ("lift tactic failed.\n" ++
+    "invalid type ascription, term has type\n  0 < n\nbut is expected to have type\n  0 ≤ n"),
   success_if_fail_with_msg {lift (n : option ℤ) to ℕ}
-    "Failed to find a lift from option ℤ to ℕ. Provide an instance of\n  can_lift (option ℤ) ℕ",
+    ("Failed to find a lift from option ℤ to ℕ. " ++
+    "Provide an instance of\n  can_lift (option ℤ) ℕ ?m_1 ?m_2"),
   trivial
 end
 
@@ -67,15 +63,8 @@ begin
   exact 0
 end
 
-instance can_lift_subtype (R : Type*) (P : R → Prop) : can_lift R {x // P x} :=
-{ coe := coe,
-  cond := λ x, P x,
-  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }
-
-instance can_lift_set (R : Type*) (s : set R) : can_lift R s :=
-{ coe := coe,
-  cond := λ x, x ∈ s,
-  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }
+instance can_lift_set (R : Type*) (s : set R) : can_lift R s coe (λ x, x ∈ s) :=
+{ prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }
 
 example {R : Type*} {P : R → Prop} (x : R) (hx : P x) : true :=
 by { lift x to {x // P x} using hx with y, trivial }
@@ -85,7 +74,7 @@ example {R : Type*} {s : set R} (x : R) (hx : x ∈ s) : true :=
 by { lift x to s using hx with y, trivial }
 
 example (n : ℤ) (hn : 0 ≤ n) : true :=
-by { lift n to ℕ, trivial, exact hn }
+by { lift n to ℕ, exact hn, trivial }
 
 example (n : ℤ) (hn : 0 ≤ n) : true :=
 by { lift n to ℕ using hn, trivial }
diff --git a/test/linarith.lean b/test/linarith.lean
index dc364a18a313e..365273aecad63 100644
--- a/test/linarith.lean
+++ b/test/linarith.lean
@@ -1,5 +1,14 @@
 import tactic.linarith
 
+example : ∀ (y : ℕ), y ≤ 37 → y < 40 :=
+begin
+  refine λ y hy, _,
+  -- The type of `hy` is a (solved but not instantiated) metavariable
+  do { tactic.get_local `hy >>= tactic.infer_type >>= guardb ∘ expr.is_mvar },
+  -- But linarith should still work
+  linarith
+end
+
 example {α : Type} (_inst : Π (a : Prop), decidable a)
   [linear_ordered_field α]
   {a b c : α}
@@ -206,6 +215,25 @@ begin
   nlinarith
 end
 
+example (a b c z : ℚ) (_ : a ≤ z) (E0 : b ≤ c) (E1 : c ≤ a) (E2 : 0 ≤ c) : b ≤ a + c := by linarith
+
+example (u v x y A B : ℚ)
+(a_7 : 0 < A - u)
+(a_8 : 0 < A - v) :
+(0 ≤ A * (1 - A))
+→ (0 ≤ A * (B - 1))
+→ (0 < A * (A - u))
+→ (0 ≤ (B - 1) * (A - u))
+→ (0 ≤ (B - 1) * (A - v))
+→ (0 ≤ (B - x) * v)
+→ (0 ≤ (B - y) * u)
+→ (0 ≤ u * (A - v))
+→ u * y + v * x + u * v < 3 * A * B :=
+begin
+  intros,
+  linarith
+end
+
 example (u v x y A B : ℚ)
 (a : 0 < A)
 (a_1 : 0 <= 1 - A)
@@ -298,11 +326,11 @@ example (u v x y A B : ℚ)
 -> (0 < (A - v) * (A - u))
 -> (0 < (A - v) * (A - v))
 ->
- u * y + v * x + u * v < 3 * A * B :=
- begin
+  u * y + v * x + u * v < 3 * A * B :=
+begin
   intros,
   linarith
- end
+end
 
 example (A B : ℚ) : (0 < A) → (1 ≤ B) → (0 < A / 8 * B) :=
 begin
diff --git a/test/linear_combination.lean b/test/linear_combination.lean
index 5c47c08098d9f..c1f0921b46dee 100644
--- a/test/linear_combination.lean
+++ b/test/linear_combination.lean
@@ -6,144 +6,158 @@ import data.real.basic
 
 example (x y : ℤ) (h1 : 3*x + 2*y = 10):
   3*x + 2*y = 10 :=
-by linear_combination (h1, 1)
+by linear_combination 1*h1
 
 example (x y : ℤ) (h1 : 3*x + 2*y = 10):
   3*x + 2*y = 10 :=
-by linear_combination h1
+by linear_combination (h1)
 
 example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
   2*x + 4 = -6 :=
-by linear_combination (h1, 2)
+by linear_combination 2*h1
 
 example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
   x*y = -2*y + 1 :=
-by linear_combination (h1, 1) (h2, -2)
+by linear_combination 1*h1 - 2*h2
 
 example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
   x*y = -2*y + 1 :=
-by linear_combination (h2, -2) h1
+by linear_combination -2*h2 + h1
 
 example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
   2*x + 4 - y = -16 :=
-by linear_combination (h1, 2) (h2, -1)
+by linear_combination 2*h1 + -1*h2
 
 example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
   -y + 2*x + 4 = -16 :=
-by linear_combination (h2, -1) (h1, 2)
+by linear_combination -h2 + 2*h1
 
 example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
   11*y = -11 :=
-by linear_combination (h1, -2) (h2, 3)
+by linear_combination -2*h1 + 3*h2
 
 example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
   -11*y = 11 :=
-by linear_combination (h1, 2) (h2, -3)
+by linear_combination 2*h1 - 3*h2
 
 example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
   -11*y = 11 + 1 - 1 :=
-by linear_combination (h1, 2) (h2, -3)
+by linear_combination 2*h1 + -3*h2
 
 example (x y : ℤ) (h1 : 10 = 3*x + 2*y) (h2 : 3 = 2*x + 5*y) :
   11 + 1 - 1 = -11*y :=
-by linear_combination (h1, 2) (h2, -3)
+by linear_combination 2*h1 - 3*h2
 
 
 /-! ### More complicated cases with two equations -/
 
 example (x y : ℤ) (h1 : x + 2 = -3) (h2 : y = 10) :
   -y + 2*x + 4 = -16 :=
-by linear_combination (h1, 2) (h2, -1)
+by linear_combination 2*h1 - h2
 
 example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
   -11*y + 1 = 11 + 1 :=
-by linear_combination (h1, 2) (h2, -3)
+by linear_combination 2*h1 - 3*h2
 
 example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
   b = 2 / 3 :=
-by linear_combination (ha, 1/6) (hab, 1/3)
+by linear_combination ha/6 + hab/3
 
 
 /-! ### Cases with more than 2 equations -/
 
 example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
   b = 2 / 3 :=
-by linear_combination (ha, 1/6) (hab, 1/3) (hignore, 0)
+by linear_combination 1/6 * ha + 1/3 * hab + 0 * hignore
 
 example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
     (hc : x + 2*y + z = 2) :
   -3*x - 3*y - 4*z = 2 :=
-by linear_combination (ha, 1) (hb, -1) (hc, -2)
+by linear_combination ha - hb - 2*hc
 
 example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
     (hc : x + 2*y + z = 2) :
   6*x = -10 :=
-by linear_combination (ha, 1) (hb, 4) (hc, -3)
+by linear_combination 1*ha + 4*hb - 3*hc
 
 example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
     (hc : x + 2*y + z = 2) :
   10 = 6*-x :=
-by linear_combination (ha, 1) (hb, 4) (hc, -3)
+by linear_combination ha + 4*hb - 3*hc
 
 example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
     (h3 : x + y + 5*z + 5*w = 3) :
   x + 2.2*y + 2*z - 5*w = -8.5 :=
-by linear_combination (h1, 2) (h2, 1) (h3, -2)
+by linear_combination 2*h1 + 1*h2 - 2*h3
 
 example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
     (h3 : x + y + 5*z + 5*w = 3) :
   x + 2.2*y + 2*z - 5*w = -8.5 :=
-by linear_combination (h1, 2) h2 (h3, -2)
+by linear_combination 2*h1 + h2 - 2*h3
 
 example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
   2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
-by linear_combination (h1, 2) (h2, -1) (h3, 3) (h4, -3)
+by linear_combination 2*h1 -1*h2 +3*h3 -3*h4
 
 example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
   6 - 3*c + 3*a + 3*d = 2*b - d + 12 - 3*a :=
-by linear_combination (h2, 2) (h3, -1) (h1, 3) (h4, -3)
+by linear_combination 2*h2 -h3 +3*h1 -3*h4
 
 
+/-! ### Cases with non-hypothesis inputs -/
+
+constants (qc : ℚ) (hqc : qc = 2*qc)
+
+example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
+by linear_combination 3 * h a b + hqc
+
+constant bad (q : ℚ) : q = 0
+
+example (a b : ℚ) : a + b^3 = 0 :=
+by linear_combination bad a + b * bad (b*b)
+
 /-! ### Cases with arbitrary coefficients -/
 
 example (a b : ℤ) (h : a = b) :
   a * a = a * b :=
-by linear_combination (h, a)
+by linear_combination a*h
 
 example (a b c : ℤ) (h : a = b) :
   a * c = b * c :=
-by linear_combination (h, c)
+by linear_combination c*h
 
 example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
   c * a + b = c * b + 1 :=
-by linear_combination (h1, c) (h2, 1)
+by linear_combination c*h1 + h2
 
 example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
   x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
-by linear_combination (h1, x*y) (h2, 2)
+by linear_combination x*y*h1 + 2*h2
 
 example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
   c * (a*f - b*e) = 0 :=
-by linear_combination (h1, e) (h2, a)
+by linear_combination e*h1 + a*h2
 
+example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
+by linear_combination (x + 2*y)*hzw
 
 /-! ### Cases that explicitly use a linear_combination_config -/
 
 example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
   -11*y + 1 = 11 + 1 :=
-by linear_combination (h1, 2) (h2, -3) {normalization_tactic := `[ring]}
+by linear_combination 2*h1 -3*h2 with {normalization_tactic := `[ring]}
 
 example (x y : ℚ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
   -11*y + 1 = 11 + 1 :=
-by linear_combination (h1, 2) (h2, -3) {normalization_tactic := `[ring1]}
+by linear_combination 2*h1 + -3*h2 with {normalization_tactic := `[ring1]}
 
 example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
   b = 2 / 3 :=
-by linear_combination (ha, 1/6) (hab, 1/3) {normalization_tactic := `[ring_nf]}
+by linear_combination 1/6*ha + 1/3*hab with {normalization_tactic := `[ring_nf]}
 
 example (x y : ℤ) (h1 : 3*x + 2*y = 10):
   3*x + 2*y = 10 :=
-by linear_combination (h1, 1) {normalization_tactic := `[simp]}
+by linear_combination h1 with {normalization_tactic := `[simp]}
 
 
 /-! ### Cases that have linear_combination skip normalization -/
@@ -152,14 +166,14 @@ by linear_combination (h1, 1) {normalization_tactic := `[simp]}
 example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) :
   b = 2 / 3 :=
 begin
-  linear_combination (ha, 1/6) (hab, 1/3) {normalize := ff},
+  linear_combination 1/6*ha + 1/3*hab with {normalize := ff},
   linarith
 end
 
 example (x y : ℤ) (h1 : x = -3) (h2 : y = 10) :
   2*x = -6 :=
 begin
-  linear_combination (h1, 2) {normalize := ff},
+  linear_combination 2*h1 with {normalize := ff},
   simp,
   norm_cast
 end
@@ -167,42 +181,78 @@ end
 
 /-! ### Cases without any arguments provided -/
 
--- the corner case is "just apply the normalization procedure"
+-- the corner case is "just apply the normalization procedure".
+-- an empty `linear_combination` at the end of a declaration is a bad edge case for the parser.
 example {x y z w : ℤ} (h₁ : 3 * x = 4 + y) (h₂ : x + 2 * y = 1) : z + w = w + z :=
 by linear_combination
 
+.
+
 -- this interacts as expected with options
 example {x y z w : ℤ} (h₁ : 3 * x = 4 + y) (h₂ : x + 2 * y = 1) : z + w = w + z :=
 begin
-  linear_combination {normalize := ff},
-  guard_target' z + w - (w + z) = 0 - 0,
+  linear_combination with {normalize := ff},
+  guard_target' z + w - (w + z) - (0 - 0) = 0,
   simp [add_comm]
 end
 
 example {x y z w : ℤ} (h₁ : 3 * x = 4 + y) (h₂ : x + 2 * y = 1) : z + w = w + z :=
-by linear_combination {normalization_tactic := `[simp [add_comm]]}
+by linear_combination with {normalization_tactic := `[simp [add_comm]]}
 
-/-! ### Cases that should fail -/
+/-! ### Cases with exponent -/
 
--- This should fail because there are no hypotheses given
-example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
-  x*y = -2*y + 1 :=
+example (x y z : ℚ) (h : x = y) (h2 : x * y = 0) : x + y*z = 0 :=
+by linear_combination (-y * z ^ 2 + x) * h + (z ^ 2 + 2 * z + 1) * h2 with {exponent := 2}
+
+example (x y z : ℚ) (h : x = y) (h2 : x * y = 0) : y*z = -x :=
 begin
-  success_if_fail {linear_combination},
-  linear_combination (h1, 1) (h2, -2)
+  linear_combination (-y * z ^ 2 + x) * h + (z ^ 2 + 2 * z + 1) * h2
+    with {exponent := 2, normalize := ff},
+  ring
+end
+
+example (K : Type)
+  [field K]
+  [char_zero K]
+  {x y z : K}
+  (h₂ : y ^ 3 + x * (3 * z ^ 2) = 0)
+  (h₁ : x ^ 3 + z * (3 * y ^ 2) = 0)
+  (h₀ : y * (3 * x ^ 2) + z ^ 3 = 0)
+  (h : x ^ 3 * y + y ^ 3 * z + z ^ 3 * x = 0) :
+  x = 0 :=
+by linear_combination 2 * y * z ^ 2 * h₂ / 7 + (x ^ 3  - y ^ 2 * z / 7) * h₁ -
+  x * y * z * h₀ + y * z * h / 7 with {exponent := 6}
+
+
+/-! ### Cases where the goal is not closed -/
+
+example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
+  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
+begin
+  linear_combination x*y*h1 + h2,
+  guard_target' (x * 3 - 7 = 0),
+  linear_combination h2
+end
+
+example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
+  6 - 3*c + 3*a + 3*d = 2*b - d + 12 - 3*a :=
+begin
+  linear_combination 2*h2,
+  linear_combination -h3,
+  linear_combination 3*h1,
+  linear_combination -3*h4,
 end
 
--- This should fail because the second coefficient has a different type than
---   the equations it is being combined with.  This was a design choice for the
---   sake of simplicity, but the tactic could potentially be modified to allow
---   this behavior.
 example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
-  x*y + 2*x = 1 :=
+  x*y = -2*y + 1 :=
 begin
-  success_if_fail {linear_combination (h1, 1) (h2, (0 : ℝ))},
-  linear_combination (h1, 1)
+  linear_combination,
+  linear_combination h1 - 2 * h2,
 end
 
+/-! ### Cases that should fail -/
+
+
 -- This should fail because the second coefficient has a different type than
 --   the equations it is being combined with.  This was a design choice for the
 --   sake of simplicity, but the tactic could potentially be modified to allow
@@ -210,18 +260,14 @@ end
 example (x y : ℤ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
   x*y + 2*x = 1 :=
 begin
-  success_if_fail {linear_combination (h1, 1) (h2, (0 : ℕ))},
-  linear_combination (h1, 1)
+  success_if_fail_with_msg {linear_combination h1 + (0 : ℝ) * h2}
+    "invalid type ascription, term has type
+  ℝ
+but is expected to have type
+  ℤ",
+  linear_combination h1
 end
 
--- This should fail because the coefficients are incorrect.  They should instead
---   be -2 and 3, respectively.
-example (x y : ℤ) (h1 : 3*x + 2*y = 10) (h2 : 2*x + 5*y = 3) :
-  11*y = -11 :=
-begin
-  success_if_fail {linear_combination (h1, 2) (h2, -3)},
-  linear_combination (h1, -2) (h2, 3)
-end
 
 -- This fails because the linear_combination tactic requires the equations
 --   and coefficients to use a type that fulfills the add_group condition,
@@ -229,13 +275,13 @@ end
 example (a b : ℕ) (h1 : a = 3) :
   a = 3 :=
 begin
-  success_if_fail {linear_combination (h1, (1 : ℕ))},
+  success_if_fail {linear_combination h1},
   exact h1
 end
 
 example (a b : ℤ) (x y : ℝ) (hab : a = b) (hxy : x = y) : 2*x = 2*y :=
 begin
-  success_if_fail_with_msg {linear_combination (hab, 2)}
+  success_if_fail_with_msg {linear_combination 2*hab}
     "hab is an equality between terms of type ℤ, but is expected to be between terms of type ℝ",
-  linear_combination (hxy, 2)
+  linear_combination 2*hxy
 end
diff --git a/test/lint_coe_t.lean b/test/lint_coe_t.lean
index 49c51e08fb61b..0a809d2f6e350 100644
--- a/test/lint_coe_t.lean
+++ b/test/lint_coe_t.lean
@@ -27,7 +27,7 @@ skip
 -- bad, because it introduces a metavariable
 section
 local attribute [instance]
-def int_to_a {α} [inhabited α] : has_coe ℤ α := ⟨λ _, default⟩
+def int_to_a {α} [inhabited α] : has_coe ℤ α := ⟨default⟩
 
 run_cmd do
 decl ← get_decl ``int_to_a,
diff --git a/test/lint_to_additive_doc.lean b/test/lint_to_additive_doc.lean
index 51e9f6175b14e..af91fa8ad2e1b 100644
--- a/test/lint_to_additive_doc.lean
+++ b/test/lint_to_additive_doc.lean
@@ -1,4 +1,4 @@
-import algebra.group.to_additive
+import tactic.to_additive
 import tactic.alias
 
 /-- Test assertion helpers -/
diff --git a/test/list_summands.lean b/test/list_summands.lean
new file mode 100644
index 0000000000000..61448f23945b8
--- /dev/null
+++ b/test/list_summands.lean
@@ -0,0 +1,22 @@
+import tactic.core
+import data.matrix.basic
+
+section tactic
+open tactic
+
+#eval show tactic unit, from do
+  ops ← list_binary_operands `(@has_add.add ℕ _) `(3 + (4 * 5 + 6) + 7 / 3),
+  guard $ ops = [`(3), `(4*5), `(6), `(7/3)]
+
+#eval show tactic unit, from do
+  ops ← list_binary_operands `(@list.append ℕ) `([1, 2] ++ [3, 4] ++ (1 :: [])),
+  guard $ ops = [`([1, 2]), `([3, 4]), `([1])]
+
+-- matches should not care about the paths taken to find a typeclass
+#eval show tactic unit, from do
+  ops ← list_binary_operands `(@has_add.add ℕ _)
+    `(@has_add.add _ (add_zero_class.to_has_add _) 1 $
+        @has_add.add _ (add_semigroup.to_has_add _) 2 3),
+  guard $ ops = [`(1), `(2), `(3)]
+
+end tactic
diff --git a/test/localized/localized.lean b/test/localized/localized.lean
index 70c188719f12b..6d7e4030ebc25 100644
--- a/test/localized/localized.lean
+++ b/test/localized/localized.lean
@@ -1,5 +1,5 @@
 import tactic.localized
-import algebra.group_power
+import algebra.group_power.lemmas
 
 open tactic
 local infix ` ⊹ `:59 := nat.mul
@@ -10,9 +10,9 @@ example : 2 ↓ 3 = 8 := rfl
 example : 2 ⊖ 3 = 8 := rfl
 example {n m : ℕ} (h : n < m) : n ≤ m := by { success_if_fail { simp [h] }, exact le_of_lt h }
 section
-localized "infix ` ⊹ `:59 := nat.add" in nat
-localized "infix ` ↓ `:59 := nat.mul" in nat
-localized "infix ` ⊖ `:59 := nat.mul" in nat.mul
+localized "infix (name := plus) ` ⊹ `:59 := nat.add" in nat
+localized "infix (name := down) ` ↓ `:59 := nat.mul" in nat
+localized "infix (name := minus) ` ⊖ `:59 := nat.mul" in nat.mul
 localized "attribute [simp] le_of_lt" in le
 example : 2 ⊹ 3 = 5 := rfl
 example : 2 ↓ 3 = 6 := rfl
diff --git a/test/matrix.lean b/test/matrix.lean
index 84343f9a2bf24..96416488c0858 100644
--- a/test/matrix.lean
+++ b/test/matrix.lean
@@ -9,24 +9,57 @@ namespace matrix
 
 open_locale matrix
 
+/-! Test that the dimensions are inferred correctly, even for empty matrices -/
+section dimensions
+
+set_option pp.universes true
+set_option pp.all true
+
+meta def get_dims (e : pexpr) : tactic (expr × expr) :=
+do
+  elem_t ← tactic.mk_meta_var (expr.sort level.zero.succ),
+  e ← tactic.to_expr ``(%%e : matrix _ _ %%elem_t) tt ff,
+  t ← tactic.infer_type e,
+  `(matrix.{0 0 0} (fin %%m) (fin %%n) %%elem_t) ← tactic.infer_type e,
+  return (m, n)
+
+-- we test equality of expressions here to ensure that we have `2` and not `1.succ` in the type
+run_cmd do d ← get_dims ``(!![]),        guard $ d = (`(0), `(0))
+run_cmd do d ← get_dims ``(!![;]),       guard $ d = (`(1), `(0))
+run_cmd do d ← get_dims ``(!![;;]),      guard $ d = (`(2), `(0))
+run_cmd do d ← get_dims ``(!![,]),       guard $ d = (`(0), `(1))
+run_cmd do d ← get_dims ``(!![,,]),      guard $ d = (`(0), `(2))
+run_cmd do d ← get_dims ``(!![1]),       guard $ d = (`(1), `(1))
+run_cmd do d ← get_dims ``(!![1,]),      guard $ d = (`(1), `(1))
+run_cmd do d ← get_dims ``(!![1;]),      guard $ d = (`(1), `(1))
+run_cmd do d ← get_dims ``(!![1,2;3,4]), guard $ d = (`(2), `(2))
+
+end dimensions
+
+run_cmd guard $ (!![1;2])       = of ![![1], ![2]]
+run_cmd guard $ (!![1,3])       = of ![![1,3]]
+run_cmd guard $ (!![1,2;3,4])   = of ![![1,2], ![3,4]]
+run_cmd guard $ (!![1,2;3,4;])  = of ![![1,2], ![3,4]]
+run_cmd guard $ (!![1,2,;3,4,]) = of ![![1,2], ![3,4]]
+
 example {a a' b b' c c' d d' : α} :
-  ![![a, b], ![c, d]] + ![![a', b'], ![c', d']] = ![![a + a', b + b'], ![c + c', d + d']] :=
+  !![a, b; c, d] + !![a', b'; c', d'] = !![a + a', b + b'; c + c', d + d'] :=
 by simp
 
 example {a a' b b' c c' d d' : β} :
-  ![![a, b], ![c, d]] - ![![a', b'], ![c', d']] = ![![a - a', b - b'], ![c - c', d - d']] :=
+  !![a, b; c, d] - !![a', b'; c', d'] = !![a - a', b - b'; c - c', d - d'] :=
 by simp
 
 example {a a' b b' c c' d d' : α} :
-  ![![a, b], ![c, d]] ⬝ ![![a', b'], ![c', d']] =
-    ![![a * a' + b * c', a * b' + b * d'], ![c * a' + d * c', c * b' + d * d']] :=
-by simp
+  !![a, b; c, d] ⬝ !![a', b'; c', d'] =
+    !![a * a' + b * c', a * b' + b * d'; c * a' + d * c', c * b' + d * d'] :=
+by simp [-equiv.perm.coe_subsingleton]
 
 example {a b c d x y : α} :
-  mul_vec ![![a, b], ![c, d]] ![x, y] = ![a * x + b * y, c * x + d * y] :=
+  mul_vec !![a, b; c, d] ![x, y] = ![a * x + b * y, c * x + d * y] :=
 by simp
 
-example {a b c d : α} : minor ![![a, b], ![c, d]] ![1, 0] ![0] = ![![c], ![a]] :=
+example {a b c d : α} : submatrix !![a, b; c, d] ![1, 0] ![0] = !![c; a] :=
 by { ext, simp }
 
 example {a b c : α} : ![a, b, c] 0 = a := by simp
@@ -58,27 +91,27 @@ example {a b c d e f g h : α} : ![a, b, c, d, e, f, g, h] 37 = f := by simp
 example {a b c d e f g h : α} : ![a, b, c, d, e, f, g, h] 99 = d := by simp
 
 example {α : Type*} [comm_ring α] {a b c d : α} :
-  matrix.det ![![a, b], ![c, d]] = a * d - b * c :=
+  matrix.det !![a, b; c, d] = a * d - b * c :=
 begin
   simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
   /-
   Try this: simp only [det_succ_row_zero, fin.sum_univ_succ, neg_mul, mul_one,
-  fin.default_eq_zero, fin.coe_zero, one_mul, cons_val_one, fin.coe_succ, univ_unique, minor_apply,
-  pow_one, fin.zero_succ_above, fin.succ_succ_above_zero,  finset.sum_singleton, cons_val_zero,
-  cons_val_succ, det_fin_zero, pow_zero]
+  fin.default_eq_zero, fin.coe_zero, one_mul, cons_val_one, fin.coe_succ, univ_unique,
+  submatrix_apply, pow_one, fin.zero_succ_above, fin.succ_succ_above_zero,  finset.sum_singleton,
+  cons_val_zero, cons_val_succ, det_fin_zero, pow_zero]
   -/
   ring
 end
 
 example {α : Type*} [comm_ring α] {a b c d e f g h i : α} :
-        matrix.det ![![a, b, c], ![d, e, f], ![g, h, i]] =
-          a * e * i - a * f * h - b * d * i + b * f * g + c * d * h - c * e * g :=
+  matrix.det !![a, b, c; d, e, f; g, h, i] =
+    a * e * i - a * f * h - b * d * i + b * f * g + c * d * h - c * e * g :=
 begin
   simp [matrix.det_succ_row_zero, fin.sum_univ_succ],
   /-
   Try this: simp only [det_succ_row_zero, fin.sum_univ_succ, neg_mul, cons_append,
   mul_one, fin.default_eq_zero, fin.coe_zero, cons_vec_bit0_eq_alt0, one_mul, cons_val_one,
-  cons_vec_alt0, fin.succ_succ_above_one, fin.coe_succ, univ_unique, minor_apply, pow_one,
+  cons_vec_alt0, fin.succ_succ_above_one, fin.coe_succ, univ_unique, submatrix_apply, pow_one,
   fin.zero_succ_above, fin.succ_zero_eq_one, fin.succ_succ_above_zero, nat.neg_one_sq,
   finset.sum_singleton, cons_val_zero, cons_val_succ, det_fin_zero, head_cons, pow_zero]
    -/
diff --git a/test/matrix_reflection.lean b/test/matrix_reflection.lean
new file mode 100644
index 0000000000000..a734b8979715a
--- /dev/null
+++ b/test/matrix_reflection.lean
@@ -0,0 +1,40 @@
+import data.matrix.auto
+import data.matrix.reflection
+
+variables {α: Type*}
+
+open_locale matrix
+open matrix
+
+-- This one is too long for the docstring, but is nice to have tested
+example [add_comm_monoid α] [has_mul α]
+  (a₁₁ a₁₂ a₁₃ a₂₁ a₂₂ a₂₃ a₃₁ a₃₂ a₃₃ b₁₁ b₁₂ b₁₃ b₂₁ b₂₂ b₂₃ b₃₁ b₃₂ b₃₃ : α) :
+  !![a₁₁, a₁₂, a₁₃;
+     a₂₁, a₂₂, a₂₃;
+     a₃₁, a₃₂, a₃₃] ⬝ !![b₁₁, b₁₂, b₁₃;
+                        b₂₁, b₂₂, b₂₃;
+                        b₃₁, b₃₂, b₃₃] =
+  !![a₁₁*b₁₁ + a₁₂*b₂₁ + a₁₃*b₃₁, a₁₁*b₁₂ + a₁₂*b₂₂ + a₁₃*b₃₂, a₁₁*b₁₃ + a₁₂*b₂₃ + a₁₃*b₃₃;
+     a₂₁*b₁₁ + a₂₂*b₂₁ + a₂₃*b₃₁, a₂₁*b₁₂ + a₂₂*b₂₂ + a₂₃*b₃₂, a₂₁*b₁₃ + a₂₂*b₂₃ + a₂₃*b₃₃;
+     a₃₁*b₁₁ + a₃₂*b₂₁ + a₃₃*b₃₁, a₃₁*b₁₂ + a₃₂*b₂₂ + a₃₃*b₃₂, a₃₁*b₁₃ + a₃₂*b₂₃ + a₃₃*b₃₃] :=
+(matrix.mulᵣ_eq _ _).symm
+
+
+example {α} [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) :
+  !![a₁₁, a₁₂;
+     a₂₁, a₂₂] ⬝ !![b₁₁, b₁₂;
+                    b₂₁, b₂₂] = !![a₁₁ * b₁₁ + a₁₂ * b₂₁, a₁₁ * b₁₂ + a₁₂ * b₂₂;
+                                   a₂₁ * b₁₁ + a₂₂ * b₂₁, a₂₁ * b₁₂ + a₂₂ * b₂₂] :=
+begin
+  rw of_mul_of_fin,
+end
+
+example {α} [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) :
+  !![a₁₁, a₁₂] ⬝ !![b₁₁, b₁₂;
+                    b₂₁, b₂₂] = !![a₁₁ * b₁₁ + a₁₂ * b₂₁, a₁₁ * b₁₂ + a₁₂ * b₂₂;] :=
+begin
+  -- if we really need it, we can get the proof directly like this
+  of_mul_of_fin.prove 1 2 2 >>= function.uncurry (tactic.assertv `h),
+  specialize @h α _ _,
+  rw of_mul_of_fin
+end
diff --git a/test/measurability.lean b/test/measurability.lean
index 525967930bcd0..aa16b6306a79e 100644
--- a/test/measurability.lean
+++ b/test/measurability.lean
@@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Rémy Degenne
 -/
 import measure_theory.tactic
-import measure_theory.function.special_functions
+import measure_theory.function.special_functions.inner
+import measure_theory.function.special_functions.basic
 
 open_locale big_operators ennreal
 
@@ -44,6 +45,12 @@ example (hf : measurable f) (hs₁ : measurable_set s₁) (ht₂ : measurable_se
   measurable_set ((f ⁻¹' t₂) ∩ s₁) :=
 by measurability
 
+/-- `ℝ` is a good test case because it verifies many assumptions, hence many lemmas apply and we
+are more likely to detect a bad lemma. In a previous version of the tactic, `measurability` got
+stuck trying to apply `set.finite.measurable_set` here. -/
+example {a b : ℝ} : measurable_set (set.Icc a b) :=
+by measurability
+
 -- Tests on functions
 
 example [has_mul β] [has_measurable_mul₂ β] (hf : measurable f) (c : β) :
@@ -69,7 +76,7 @@ example [add_comm_monoid β] [has_measurable_add₂ β] {s : finset ℕ} {F : 
 by measurability
 
 -- even with many assumptions, the tactic is not trapped by a bad lemma
-example [topological_space α] [borel_space α] [normed_group β] [borel_space β]
+example [topological_space α] [borel_space α] [normed_add_comm_group β] [borel_space β]
   [has_measurable_add₂ β] [has_measurable_sub₂ β] {s : finset ℕ} {F : ℕ → α → β}
   (hF : ∀ i, measurable (F i)) :
   ae_measurable (∑ i in s, (λ x, F (i+1) x - F i x)) μ :=
@@ -77,3 +84,8 @@ by measurability
 
 example : measurable (λ x : ℝ, real.exp (2 * inner x 3)) :=
 by measurability
+
+/-- An older version of the tactic failed in the presence of a negated hypothesis due to an
+internal call to `apply_assumption`. -/
+example {ι : Type*} (i k : ι) (hik : i ≠ k) : measurable (id : α → α) :=
+by measurability
diff --git a/test/mk_iff_of_inductive.lean b/test/mk_iff_of_inductive.lean
index 0b8b1b6ffc908..f8bafe42a7c89 100644
--- a/test/mk_iff_of_inductive.lean
+++ b/test/mk_iff_of_inductive.lean
@@ -1,4 +1,3 @@
-import data.list
 import data.list.perm
 import data.multiset.basic
 
diff --git a/test/monotonicity.lean b/test/monotonicity.lean
index afde3d080330e..411625aed3dc9 100644
--- a/test/monotonicity.lean
+++ b/test/monotonicity.lean
@@ -5,9 +5,10 @@ Authors: Simon Hudon
 -/
 import tactic.monotonicity
 import tactic.norm_num
-import algebra.order.ring
-import measure_theory.measure.lebesgue
+import algebra.order.ring.defs
 import measure_theory.function.locally_integrable
+import measure_theory.integral.bochner
+import measure_theory.measure.lebesgue.basic
 import data.list.defs
 
 open list tactic tactic.interactive set
@@ -38,6 +39,14 @@ begin
   { ac_mono },
 end
 
+example (x y z k : ℕ)
+  (h : 3 ≤ (4 : ℕ))
+  (h' : z ≤ y)
+: (k + 3 + x) - y ≤ (k + 4 + x) - z :=
+begin
+  mono, norm_num
+end
+
 example (x y z k : ℤ)
   (h : 3 ≤ (4 : ℤ))
   (h' : z ≤ y)
@@ -46,6 +55,16 @@ begin
   mono, norm_num
 end
 
+example (x y z a b : ℕ)
+  (h : a ≤ (b : ℕ))
+  (h' : z ≤ y)
+: (1 + a + x) - y ≤ (1 + b + x) - z :=
+begin
+  transitivity (1 + a + x - z),
+  { mono, },
+  { mono, mono, mono },
+end
+
 example (x y z a b : ℤ)
   (h : a ≤ (b : ℤ))
   (h' : z ≤ y)
@@ -424,9 +443,9 @@ end
 example : ∫ x in Icc 0 1, real.exp x ≤ ∫ x in Icc 0 1, real.exp (x+1) :=
 begin
   mono,
-  { exact real.continuous_exp.locally_integrable is_compact_Icc },
-  { exact (real.continuous_exp.comp $ continuous_add_right 1).locally_integrable
-      is_compact_Icc },
+  { exact real.continuous_exp.locally_integrable.integrable_on_is_compact is_compact_Icc },
+  { exact (real.continuous_exp.comp $ continuous_add_right 1)
+      .locally_integrable.integrable_on_is_compact is_compact_Icc },
   intro x,
   dsimp only,
   mono,
diff --git a/test/move_add.lean b/test/move_add.lean
new file mode 100644
index 0000000000000..fa37e265409df
--- /dev/null
+++ b/test/move_add.lean
@@ -0,0 +1,108 @@
+import tactic.move_add
+import data.list.of_fn
+import algebra.group.pi
+
+variables {R : Type*} [add_comm_semigroup R] {a b c d e f g h : R}
+
+example (e f g : R) (h : a + b + c = d) : b + (a + c) = d :=
+begin
+  success_if_fail_with_msg {move_add [d] at *} "'d' is an unused variable",
+  move_add at *,
+  success_if_fail_with_msg {move_add at *} "nothing changed",
+  success_if_fail_with_msg {move_add [a, e, f, g] at h a b c ⊢}
+    "'[a, b, c]' did not change\n'[e, f, g]' are unused variables",
+  success_if_fail_with_msg {move_add [a, e, f, g] at h ⊢} "'[e, f, g]' are unused variables",
+  success_if_fail_with_msg {move_add at ⊢ h} "Goal did not change\n'[h]' did not change",
+  move_add ← a at *,  -- `move_add` closes the goal, since, after rearranging, it tries `assumption`
+end
+
+example {R : Type*} [comm_semigroup R] (a b c d e f g : R) (h : a * b * c = d) : b * (a * c) = d :=
+begin
+  success_if_fail_with_msg {move_mul [d] at *} "'d' is an unused variable",
+  move_mul at *,
+  success_if_fail_with_msg {move_mul at *} "nothing changed",
+  success_if_fail_with_msg {move_mul [a, e, f, g] at h a b c ⊢}
+    "'[a, b, c]' did not change\n'[e, f, g]' are unused variables",
+  success_if_fail_with_msg {move_mul [a, e, f, g] at h ⊢} "'[e, f, g]' are unused variables",
+  success_if_fail_with_msg {move_mul at ⊢ h} "Goal did not change\n'[h]' did not change",
+  success_if_fail_with_msg {move_mul at ⊢} "Goal did not change",
+  move_mul ← a at *,  -- `move_mul` closes the goal, since, after rearranging, it tries `assumption`
+end
+
+example : let k := c + (a + b) in k = a + b + c :=
+begin
+  move_add [← a, c],
+  simp only,
+end
+
+example (n : ℕ) : list.of_fn (λ i : fin (n + 3), (i : ℕ)) = list.of_fn (λ i : fin (3 + n), i) :=
+begin
+  move_add [←n],
+end
+
+example (a b : ℕ) : a + max a b = max b a + a :=
+begin
+  move_oper [max] ← a at *,
+  move_oper [(+)] a at *,
+end
+
+example (h : b + a = b + c + a) : a + b = a + b + c :=
+by move_add [a]
+
+example {R : Type*} [comm_semigroup R] {a b : R} :
+  ∀ x : R, ∃ y : R, a * x * b * y = x * y * b * a :=
+by { move_mul [a, b], exact λ x, ⟨x, rfl⟩ }
+
+example {R : Type*} [has_add R] [comm_semigroup R] {a b c d e f g : R} :
+  a * (b * c * a) * ((d * e) * e) * f * g = (c * b * a) * (e * (e * d)) * g * f * a :=
+by move_mul [a, a, b, c, d, e, f]
+
+example [has_mul R] [has_neg R] : a + (b + c + a) * (- (d + e) + e) + f + g =
+  (c + b + a) * (e + - (e + d)) + g + f + a :=
+by move_add [b, d, g, f, a, e]
+
+example (h : d + b + a = b + a → d + c + a = c + a) : a + d + b = b + a → d + c + a = a + c :=
+by move_add [a]
+
+example [decidable_eq R] : if b + a = c + a then a + b = c + a else a + b ≠ c + a :=
+begin
+  move_add [← a],
+  split_ifs; exact h,
+end
+
+example (r : R → R → Prop) (h : r (a + b) (c + b + a)) : r (a + b) (a + b + c) :=
+by move_add [a, b, c] at h
+
+example (h : a + c + b = a + d + b) : c + b + a = b + a + d :=
+by move_add [← a, b]  -- Goal before `exact h`: `a + c + b = a + d + b`
+
+example [has_mul R] (h : a * c + c + b * c = a * d + d + b * d) :
+  c + b * c + a * c = a * d + d + b * d :=
+begin
+  -- the first input `_ * c` unifies with `b * c` and moves to the right
+  -- the second input `_ * c` unifies with `a * c` and moves to the left
+  move_add [_ * c, ← _ * c], -- Goal before `exact h`: `a * c + c + b * c = a * d + d + b * d`
+end
+
+variables [has_mul R] [has_one R] {X r s t u : R} (C D E : R → R)
+
+example (he : E (C r * D X + D X * h + 7 + 42 + f) = C r * D X + h * D X + 7 + 42 + g) :
+  E (7 + f + (C r * D X + 42) + D X * h) = C r * D X + h * D X + g + 7 + 42 :=
+begin
+  -- move `7, 42, f, g` to the right of their respective sides
+  move_add [(7 : R), (42 : R), f, g],
+end
+
+example : true :=
+begin
+  letI iacs : ∀ i, add_comm_semigroup (fin i → ℕ) := λ i, by apply_instance,
+  letI ia : ∀ i, has_add (fin i → ℕ) := λ i,
+    @add_semigroup.to_has_add _
+    (@add_comm_semigroup.to_add_semigroup _ (iacs i)),
+  -- move_add should work if there are unified metavariables
+  have : ∀ (a b : fin _ → ℕ), @has_add.add _ (ia _) a b = @has_add.add _ (ia _) b a,
+  { intros a b,
+    move_add [a] },
+  trivial, -- close the outer goal
+  exact 37 -- resolve the metavariable
+end
diff --git a/test/noncomm_ring.lean b/test/noncomm_ring.lean
index ccd4677adcb40..8fcb1ce3d0545 100644
--- a/test/noncomm_ring.lean
+++ b/test/noncomm_ring.lean
@@ -1,7 +1,7 @@
 import tactic.noncomm_ring
 
-local notation `⁅`a`,` b`⁆` := a * b - b * a
-local infix ` ⚬ `:70 := λ a b, a * b + b * a
+local notation (name := commutator) `⁅`a`, `b`⁆` := a * b - b * a
+local infix (name := op) ` ⚬ `:70 := λ a b, a * b + b * a
 
 variables {R : Type*} [ring R]
 variables (a b c : R)
diff --git a/test/nontriviality.lean b/test/nontriviality.lean
index 56a4d23f76ff6..2330c02f6956f 100644
--- a/test/nontriviality.lean
+++ b/test/nontriviality.lean
@@ -1,6 +1,7 @@
 import logic.nontrivial
-import algebra.order.ring
+import algebra.order.ring.defs
 import data.nat.basic
+import data.set.basic
 
 /-! ### Test `nontriviality` with inequality hypotheses -/
 
diff --git a/test/norm_cast.lean b/test/norm_cast.lean
index 21394be48e5c5..454cdebb5c0fa 100644
--- a/test/norm_cast.lean
+++ b/test/norm_cast.lean
@@ -98,7 +98,7 @@ end
 example (k : ℕ) {x y : ℕ} (h : ((x + y + k : ℕ) : ℤ) = 0) : x + y + k = 0 :=
 begin
   push_cast at h,
-  guard_hyp h : (x : ℤ) + y + k = 0,
+  guard_hyp_mod_implicit h : (x : ℤ) + y + k = 0,
   assumption_mod_cast
 end
 
@@ -119,7 +119,7 @@ lemma half_lt_self_bis {a : ℝ≥0∞} (hz : a ≠ 0) (ht : a ≠ ⊤) : a / 2
 begin
   lift a to nnreal using ht,
   have h : (2 : ℝ≥0∞) = ((2 : nnreal) : ℝ≥0∞), from rfl,
-  have h' : (2 : nnreal) ≠ 0, from _root_.two_ne_zero',
+  have h' : (2 : nnreal) ≠ 0, from two_ne_zero' _,
   rw [h, ← coe_div h', coe_lt_coe], -- `norm_cast` fails to apply `coe_div`
   norm_cast at hz,
   exact nnreal.half_lt_self hz
@@ -133,3 +133,5 @@ begin
  assumption_mod_cast,
  assumption_mod_cast,
 end
+
+example (n : ℤ) (h : n = -1) : (n : ℝ) = -1 := by exact_mod_cast h
diff --git a/test/norm_cast_int.lean b/test/norm_cast_int.lean
index cde611b00b8c2..a9808d7cfff84 100644
--- a/test/norm_cast_int.lean
+++ b/test/norm_cast_int.lean
@@ -1,5 +1,5 @@
 import tactic.norm_cast
-import data.int.cast
+import data.int.basic
 
 set_option pp.numerals false
 set_option pp.notation false
diff --git a/test/norm_cast_lemma_order.lean b/test/norm_cast_lemma_order.lean
index ad6d80b3e46cd..ca350f1f62571 100644
--- a/test/norm_cast_lemma_order.lean
+++ b/test/norm_cast_lemma_order.lean
@@ -1,9 +1,8 @@
-import data.nat.cast
+import data.nat.cast.defs
 import tactic.norm_cast
 
 constant ℝ : Type
-@[instance] constant real.add_monoid : add_monoid ℝ
-@[instance] constant real.has_one : has_one ℝ
+@[instance] constant real.add_monoid_with_one : add_monoid_with_one ℝ
 
 -- set_option trace.simplify.rewrite true
 set_option pp.notation false
diff --git a/test/norm_cast_sum_lambda.lean b/test/norm_cast_sum_lambda.lean
index 4f88f9f0d1cb4..c9ed874f0e925 100644
--- a/test/norm_cast_sum_lambda.lean
+++ b/test/norm_cast_sum_lambda.lean
@@ -11,9 +11,5 @@ run_cmd do
 l ← norm_cast.make_guess ``coe_series,
 guard $ l = norm_cast.label.move
 
-example (f : ℕ → ℕ) (h : (0 : ℕ) ≤ series (λ x, f x)) : (0 : ℤ) ≤ series (λ x, f x) :=
-begin
-  norm_cast,
-  guard_target (0 : ℕ) ≤ series (λ x, f x),
-  exact h
-end
+example (f : ℕ → ℕ) : (0 : ℤ) ≤ series (λ x, f x) :=
+by norm_cast
diff --git a/test/norm_fin.lean b/test/norm_fin.lean
index 9888495cf6f4a..2651c4ce3dd0e 100644
--- a/test/norm_fin.lean
+++ b/test/norm_fin.lean
@@ -28,7 +28,7 @@ example : equiv.swap (0 : fin 3) 1 (fin.succ 1) = 2 :=
 begin
   success_if_fail {guard_target ((equiv.swap (0 : fin 3) 1) 2 = 2)},
   norm_fin,
-  guard_target (equiv.swap (0 : fin 3) 1 2 = 2),
+  guard_target_mod_implicit (equiv.swap (0 : fin 3) 1 2 = 2),
   exact equiv.swap_apply_of_ne_of_ne dec_trivial dec_trivial
 end
 example : equiv.swap (0 : fin (1 + 2)) (1 : fin (nat.succ (1 + 1))) (fin.succ 1) = 2 :=
diff --git a/test/norm_num.lean b/test/norm_num.lean
index 0624fd511fcb7..97dba721cd51b 100644
--- a/test/norm_num.lean
+++ b/test/norm_num.lean
@@ -5,6 +5,7 @@ Authors: Simon Hudon, Mario Carneiro
 -/
 
 import tactic.norm_num
+import algebra.ring.pi
 
 /-!
 # Tests for `norm_num` extensions
@@ -36,6 +37,7 @@ example : ((1:real) / 2)⁻¹ = 2 := by norm_num
 example : 2 ^ 17 - 1 = 131071 :=
 by {norm_num, tactic.try_for 200 (tactic.result >>= tactic.type_check)}
 example : (3 : real) ^ (-2 : ℤ) = 1/9 := by norm_num
+example : (3 : real) ^ (-2 : ℤ) = 1/9 := by norm_num1
 example : (-3 : real) ^ (0 : ℤ) = 1 := by norm_num
 example : (-3 : real) ^ (-1 : ℤ) = -1/3 := by norm_num
 example : (-3 : real) ^ (2 : ℤ) = 9 := by norm_num
@@ -43,6 +45,7 @@ example : (-3 : real) ^ (2 : ℤ) = 9 := by norm_num
 example : (1:complex) ≠ 2 := by norm_num
 example : (1:complex) / 3 ≠ 2 / 7 := by norm_num
 
+example : (1:real) ≠ 2 := by norm_num
 example {α} [semiring α] [char_zero α] : (1:α) ≠ 2 := by norm_num
 example {α} [ring α] [char_zero α] : (-1:α) ≠ 2 := by norm_num
 example {α} [division_ring α] [char_zero α] : (-1:α) ≠ 2 := by norm_num
@@ -55,6 +58,9 @@ example : (0 + 1) / 2 < 0 + 1 := by norm_num
 example : nat.succ (nat.succ (2 ^ 3)) = 10 := by norm_num
 example : 10 = (-1 : ℤ) % 11 := by norm_num
 example : (12321 - 2 : ℤ) = 12319 := by norm_num
+example : (63:ℚ) ≥ 5 := by norm_num
+
+example : nat.zero.succ.succ.succ.succ.succ.succ % 4 = 2 := by norm_num1
 
 example (x : ℤ) (h : 1000 + 2000 < x) : 100 * 30 < x :=
 by norm_num at *; try_for 100 {exact h}
@@ -295,3 +301,37 @@ example : ((3 / ((- 28 * 45) * (19 + ((- (- 88 - (- (- 1 + 90) + 8)) + 87) * 48)
 example : ((- - (28 + 48) / 75) + ((- 59 - 14) - 0)) = (-5399/75 : α) := by norm_num
 example : (- ((- (((66 - 86) - 36) / 94) - 3) / - - (77 / (56 - - - 79))) + 87) =
   (312254/3619 : α) := by norm_num
+
+example : 2 ^ 13 - 1 = int.of_nat 8191 := by norm_num
+
+example : 1 + 1 = 2 := by success_if_fail { norm_num [this_doesnt_exist] }; refl
+
+-- `^` and `•` do not have to match `monoid.has_pow` and `add_monoid.has_smul` syntactically
+example {α} [ring α] : (2 ^ 3 : ℕ → α) = 8 := by norm_num
+example {α} [ring α] : (2 • 3 : ℕ → α) = 6 := by norm_num
+
+/-! Test the behaviour of removing one `norm_num` extension tactic. -/
+section remove_extension
+
+-- turn off the `norm_num` extension which deals with `/`, `%`, `∣`
+local attribute [-norm_num] norm_num.eval_nat_int_ext
+
+example : (5 / 2:ℕ) = 2 := by  success_if_fail { solve1 { norm_num } }; refl
+
+example : 10 = (-1 : ℤ) % 11 := by success_if_fail { solve1 { norm_num } }; refl
+
+example (h : (5 : ℤ) ∣ 2) : false :=
+begin
+  success_if_fail { norm_num at h },
+  have : (2:ℤ) ≠ 0 := by norm_num,
+  exact this (int.mod_eq_zero_of_dvd h),
+end
+
+example : 2^4-1 ∣ 2^16-1 :=
+begin
+  success_if_fail { solve1 { norm_num } },
+  use 4369,
+  norm_num,
+end
+
+end remove_extension
diff --git a/test/norm_num_ext.lean b/test/norm_num_ext.lean
index 60661de13abe6..5f75b9d9e5751 100644
--- a/test/norm_num_ext.lean
+++ b/test/norm_num_ext.lean
@@ -4,11 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Mario Carneiro
 -/
 import algebra.big_operators.norm_num
-import algebra.squarefree
+import data.nat.squarefree
 import data.int.gcd
 import data.nat.fib
 import data.nat.prime
 import data.nat.sqrt_norm_num
+import analysis.special_functions.pow.real
+import number_theory.legendre_symbol.norm_num
 
 /-!
 # Tests for `norm_num` extensions
@@ -241,6 +243,29 @@ example : squarefree 10 := by norm_num
 example : squarefree (2*3*5*17) := by norm_num
 example : ¬ squarefree (2*3*5*5*17) := by norm_num
 example : squarefree 251 := by norm_num
+example : squarefree (3 : ℤ) :=
+begin
+  -- `norm_num` should fail on this example, instead of producing an incorrect proof.
+  success_if_fail { norm_num },
+  exact irreducible.squarefree (prime.irreducible
+    (int.prime_iff_nat_abs_prime.mpr (by norm_num)))
+end
+example : @squarefree ℕ multiplicative.monoid 1 :=
+begin
+  -- `norm_num` should fail on this example, instead of producing an incorrect proof.
+  success_if_fail { norm_num },
+  -- the statement was deliberately wacky, let's fix it
+  change squarefree (multiplicative.of_add 1 : multiplicative ℕ),
+  rintros x ⟨dx, hd⟩,
+  revert x dx,
+  rw multiplicative.of_add.surjective.forall₂,
+  intros x dx h,
+  simp_rw [←of_add_add, multiplicative.of_add.injective.eq_iff] at h,
+  cases x,
+  { simp [is_unit_one], exact is_unit_one },
+  { simp only [nat.succ_add, nat.add_succ] at h,
+    cases h },
+end
 
 example : nat.fib 0 = 0 := by norm_num
 example : nat.fib 1 = 1 := by norm_num
@@ -257,6 +282,10 @@ example : nat.fib 37 = 24157817 := by norm_num
 example : nat.fib 64 = 10610209857723 := by norm_num
 example : nat.fib 100 + nat.fib 101 = nat.fib 102 := by norm_num
 
+example : (2 : ℝ) ^ (3 : ℝ) = 8 := by norm_num
+example : (1 : ℝ) ^ (20 : ℝ) = 1 := by norm_num
+example : (2 : ℝ) ^ (-3 : ℝ) = 1/8 := by norm_num
+
 section big_operators
 
 variables {α : Type*} [comm_ring α]
@@ -267,12 +296,14 @@ open_locale big_operators
 example : ([1, 2, 1, 3]).sum = 7 := by norm_num [-list.sum_cons]
 example : (([1, 2, 1, 3] : list ℚ).map (λ i, i^2)).sum = 15 := by norm_num [-list.map]
 example : (list.range 10).sum = 45 := by norm_num [-list.range_succ]
+example : (list.fin_range 10).sum = 45 := by norm_num [-list.fin_range_succ_eq_map]
 
 -- Multisets:
 example : (1 ::ₘ 2 ::ₘ 1 ::ₘ 3 ::ₘ {}).sum = 7 := by norm_num [-multiset.sum_cons]
 example : ((1 ::ₘ 2 ::ₘ 1 ::ₘ 3 ::ₘ {}).map (λ i, i^2)).sum = 15 := by norm_num [-multiset.map_cons]
 example : (({1, 2, 1, 3} : multiset ℚ).map (λ i, i^2)).sum = 15 := by norm_num [-multiset.map_cons]
 example : (multiset.range 10).sum = 45 := by norm_num [-multiset.map_cons, -multiset.range_succ]
+example : (↑[1, 2, 1, 3] : multiset ℕ).sum = 7 := by norm_num
 
 -- Finsets:
 example (f : fin 0 → α) : ∑ i : fin 0, f i = 0 := by norm_num
@@ -283,12 +314,42 @@ example (f : ℕ → α) : ∑ i in {0, 1, 2}, f i = f 0 + f 1 + f 2 := by norm_
 example (f : ℕ → α) : ∑ i in {0, 2, 2, 3, 1, 0}, f i = f 0 + f 1 + f 2 + f 3 := by norm_num; ring
 example (f : ℕ → α) : ∑ i in {0, 2, 2 - 3, 3 - 1, 1, 0}, f i = f 0 + f 1 + f 2 := by norm_num; ring
 example : (∑ i in finset.range 10, (i^2 : ℕ)) = 285 := by norm_num
+example : (∑ i in finset.Icc 5 10, (i^2 : ℕ)) = 355 := by norm_num
+example : (∑ i in finset.Ico 5 10, (i^2 : ℕ)) = 255 := by norm_num
+example : (∑ i in finset.Ioc 5 10, (i^2 : ℕ)) = 330 := by norm_num
+example : (∑ i in finset.Ioo 5 10, (i^2 : ℕ)) = 230 := by norm_num
+example : (∑ i : ℤ in finset.Ioo (-5) 5, i^2) = 60 := by norm_num
+example (f : ℕ → α) : ∑ i in finset.mk {0, 1, 2} dec_trivial, f i = f 0 + f 1 + f 2 :=
+  by norm_num; ring
 
 -- Combined with other `norm_num` extensions:
 example : ∏ i in finset.range 9, nat.sqrt (i + 1) = 96 := by norm_num
 example : ∏ i in {1, 4, 9, 16}, nat.sqrt i = 24 := by norm_num
+example : ∏ i in finset.Icc 0 8, nat.sqrt (i + 1) = 96 := by norm_num
 
 -- Nested operations:
 example : ∑ i : fin 2, ∑ j : fin 2, ![![0, 1], ![2, 3]] i j = 6 := by norm_num
 
 end big_operators
+
+section jacobi
+
+-- Jacobi and Legendre symbols
+
+open_locale number_theory_symbols
+
+example : J(123 | 335) = -1 := by norm_num
+example : J(-2345 | 6789) = -1 := by norm_num
+example : J(-1 | 1655801) = 1 := by norm_num
+example : J(-102334155 | 165580141) = -1 := by norm_num
+
+example : J(58378362899022564339483801989973056405585914719065 |
+            53974350278769849773003214636618718468638750007307) = -1 := by norm_num
+
+example : J(3 + 4 | 3 * 5) = -1 := by norm_num
+example : J(J(-1 | 7) | 11) = -1 := by norm_num
+
+instance prime_1000003 : fact (nat.prime 1000003) := ⟨by norm_num⟩
+example : legendre_sym 1000003 7 = -1 := by norm_num
+
+end jacobi
diff --git a/test/norm_swap.lean b/test/norm_swap.lean
index 48bde1f14e306..b89621b1b9ce5 100644
--- a/test/norm_swap.lean
+++ b/test/norm_swap.lean
@@ -1,4 +1,4 @@
-import logic.equiv.basic
+import logic.equiv.defs
 import tactic.norm_swap
 
 
@@ -20,12 +20,12 @@ if `norm_swap.eval` is behaving properly.
 example : true := by do
   let l : list ℕ := [0, 1, 2, 3],
   let l' : list ((ℕ × ℕ) × ℕ) := (do a ← l, b ← l, c ← l, pure ((a, b), c)),
-  (lhs : list expr) ← mmap (λ (tup : (ℕ × ℕ) × ℕ),
-    to_expr ``(equiv.swap %%tup.fst.fst %%tup.fst.snd %%tup.snd)) l',
-  (rhs : list expr) ← mmap (λ (tup : (ℕ × ℕ) × ℕ),
-    if tup.snd = tup.fst.fst then to_expr ``(%%tup.fst.snd)
-    else if tup.snd = tup.fst.snd then to_expr ``(%%tup.fst.fst)
-    else to_expr ``(%%tup.snd)) l',
+  let lhs : list expr := l'.map (λ (tup : (ℕ × ℕ) × ℕ),
+    `(equiv.swap tup.fst.fst tup.fst.snd tup.snd).to_expr),
+  let rhs : list expr := l'.map (λ (tup : (ℕ × ℕ) × ℕ),
+    if tup.snd = tup.fst.fst then `(tup.fst.snd)
+    else if tup.snd = tup.fst.snd then `(tup.fst.fst)
+    else `(tup.snd)),
   let eqs : list expr := list.zip_with (λ L R, `(@eq.{1} ℕ %%L %%R)) lhs rhs,
   g ← get_goals,
   gls ← mmap mk_meta_var eqs,
diff --git a/test/pointwise_nsmul.lean b/test/pointwise_nsmul.lean
new file mode 100644
index 0000000000000..d4d6769fbd28e
--- /dev/null
+++ b/test/pointwise_nsmul.lean
@@ -0,0 +1,34 @@
+/-
+Copyright (c) 2022 Yaël Dillies. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Authors: Yaël Dillies
+-/
+import data.finset.pointwise
+import order.filter.pointwise
+
+/-!
+# Ensuring priority of the `ℕ` and `ℤ` actions over pointwise ones
+
+See Note [pointwise nat action].
+-/
+
+open_locale pointwise
+
+variables {α β : Type*} [add_group α] [decidable_eq α] [group β] [decidable_eq β]
+
+-- It is ok for the proofs to stop being `rfl`, but these statements should remain true
+example (s : set α) (n : ℕ) : n • s = nsmul_rec n s := rfl
+example (s : set α) (n : ℤ) : n • s = zsmul_rec n s := rfl
+example (s : set β) (n : ℕ) : s ^ n = npow_rec n s := rfl
+example (s : set β) (n : ℤ) : s ^ n = zpow_rec n s := rfl
+example (s : finset α) (n : ℕ) : n • s = nsmul_rec n s := rfl
+example (s : finset α) (n : ℤ) : n • s = zsmul_rec n s := rfl
+example (s : finset β) (n : ℕ) : s ^ n = npow_rec n s := rfl
+example (s : finset β) (n : ℤ) : s ^ n = zpow_rec n s := rfl
+example (s : filter α) (n : ℕ) : n • s = nsmul_rec n s := rfl
+example (s : filter α) (n : ℤ) : n • s = zsmul_rec n s := rfl
+example (s : filter β) (n : ℕ) : s ^ n = npow_rec n s := rfl
+example (s : filter β) (n : ℤ) : s ^ n = zpow_rec n s := rfl
+
+example : 2 • ({2, 3} : finset ℕ) = {4, 5, 6} := rfl
+example : ({2, 3}^2 : finset ℕ) = {4, 6, 9} := rfl
diff --git a/test/polyrith.lean b/test/polyrith.lean
new file mode 100644
index 0000000000000..c3b71514e1e42
--- /dev/null
+++ b/test/polyrith.lean
@@ -0,0 +1,715 @@
+/-
+Copyright (c) 2022 Dhruv Bhatia. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author(s): Dhruv Bhatia, Robert Y. Lewis
+-/
+
+import tactic.polyrith
+import data.real.basic
+
+/-!
+
+Each call to `polyrith` makes a call to the SageCell web API at
+. To avoid making many API calls from CI,
+we only test this communication in a few tests.
+
+A full test suite is provided at the bottom of the file.
+
+-/
+
+/-!
+## Set up testing infrastructre
+-/
+
+section tactic
+open polyrith tactic
+/--
+For testing purposes, this behaves like `tactic.polyrith`, but takes an extra argument
+representing the expected output from a call to Sage.
+Allows for testing without actually making API calls.
+-/
+meta def tactic.test_polyrith (only_on : bool) (hyps : list pexpr)
+  (sage_out : json) (expected_args : list string) (expected_out : string) :
+  tactic unit := do
+  (eq_names, m, R, args) ← create_args only_on hyps,
+  guard (args = expected_args) <|>
+    fail!"expected arguments to Sage: {expected_args}\nbut produced: {args}",
+  out ← to_string <$> process_output eq_names m R sage_out,
+  guard (out = expected_out) <|>
+    fail!"expected final output: {expected_out}\nbut produced: {out}"
+
+meta def format_string_list (input : list string) : format :=
+"[" ++ (format.join $ (input.map (λ s, ("\"" : format) ++ format.of_string s ++ "\"")).intersperse ("," ++ format.line)) ++ "]"
+
+setup_tactic_parser
+
+meta def tactic.interactive.test_polyrith (restr : parse (tk "only")?)
+  (hyps : parse pexpr_list?)
+  (sage_out : string) (expected_args : list string) (expected_out : string) : tactic unit := do
+  some sage_out ← return $ json.parse sage_out,
+  tactic.test_polyrith restr.is_some (hyps.get_or_else []) sage_out expected_args expected_out
+
+meta def tactic.interactive.test_sage_output (restr : parse (tk "only")?)
+  (hyps : parse pexpr_list?) (expected_out : string) : tactic unit := do
+  expected_json ← json.parse expected_out,
+  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
+  (eq_names, m, R, args) ← create_args restr.is_some (hyps.get_or_else []),
+  sage_out ← sage_output args,
+  guard (sage_out = expected_json) <|>
+    fail!"Expected output from Sage: {expected_out}\nbut produced: {sage_out}"
+
+/--
+A convenience function. Given a working test, prints the code for a call to `test_sage_output`.
+-/
+meta def tactic.interactive.create_sage_output_test (restr : parse (tk "only")?)
+  (hyps : parse pexpr_list?) : tactic unit := do
+  let hyps := (hyps.get_or_else []),
+  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
+  (eq_names, m, R, args) ← create_args restr.is_some hyps,
+  sage_out ← to_string <$> sage_output args,
+  let sage_out := sage_out.fold "" (λ s c, s ++ (if c = '"' then "\\\"" else to_string c)),
+  let onl := if restr.is_some then "only " else "",
+  let hyps := if hyps = [] then "" else to_string hyps,
+  trace!"test_sage_output {onl}{hyps} \"{sage_out}\""
+
+/--
+A convenience function. Given a working test, prints the code for a call to `test_polyrith`.
+-/
+meta def tactic.interactive.create_polyrith_test (restr : parse (tk "only")?)
+  (hyps : parse pexpr_list?) : tactic unit := do
+  let hyps := (hyps.get_or_else []),
+  sleep 10, -- otherwise can lead to weird errors when actively editing code with polyrith calls
+  (eq_names, m, R, args) ← create_args restr.is_some hyps,
+  sage_out ← sage_output args,
+  out ← to_string <$> process_output eq_names m R sage_out,
+  let out := out.fold "" (λ s c, s ++ (if c = '"' then "\\\"" else to_string c)),
+  let sage_out := (to_string sage_out).fold ""
+    (λ s c, s ++ (if c = '"' then "\\\"" else to_string c)),
+  let argstring := format_string_list args,
+  let onl := if restr.is_some then "only " else "",
+  let hyps := if hyps = [] then "" else to_string hyps,
+  let trf := format.nest 2 $ format!"test_polyrith {onl}{hyps} \n\"{sage_out}\"\n{argstring}\n\"{out}\"",
+  trace!"Try this: {trf}"
+
+
+end tactic
+
+/-!
+## SageCell communcation tests
+-/
+
+example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
+  x*y = -2*y + 1 :=
+begin
+  test_sage_output "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}",
+  linear_combination h1 - 2 * h2
+end
+
+example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
+    (h3 : x + y + 5*z + 5*w = 3) :
+  x + 2.2*y + 2*z - 5*w = -8.5 :=
+begin
+  test_sage_output "{\"data\":[\"(poly.const 2/1)\",\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}",
+  linear_combination 2 * h1 + h2 - 2 * h3
+end
+
+
+
+/-! ### Standard Cases over ℤ, ℚ, and ℝ -/
+
+example (x y : ℤ) (h1 : 3*x + 2*y = 10):
+  3*x + 2*y = 10 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "2",
+  "[(((3 * var0) + (2 * var1)) - 10)]",
+  "(((3 * var0) + (2 * var1)) - 10)"]
+  "linear_combination h1"
+
+example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
+  x*y = -2*y + 1 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "2",
+  "[(((var0 * var1) + (2 * var0)) - 1), (var0 - var1)]",
+  "((var0 * var1) - ((-2 * var1) + 1))"]
+  "linear_combination h1 - 2 * h2"
+
+example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
+  -y + 2*x + 4 = -16 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 2/1)\",\"(poly.const -1/1)\"],\"success\":true}"
+  ["ff",
+  "real",
+  "2",
+  "[((var1 + 2) - -3), (var0 - 10)]",
+  "(((-var0 + (2 * var1)) + 4) - -16)"]
+  "linear_combination 2 * h1 - h2"
+
+example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
+    (hc : x + 2*y + z = 2) :
+  -3*x - 3*y - 4*z = 2 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -1/1)\",\"(poly.const -2/1)\"],\"success\":true}"
+  ["ff",
+  "real",
+  "3",
+  "[(((var0 + (2 * var1)) - var2) - 4), ((((2 * var0) + var1) + var2) - -2), (((var0 + (2 * var1)) + var2) - 2)]",
+  "((((-3 * var0) - (3 * var1)) - (4 * var2)) - 2)"]
+  "linear_combination ha - hb - 2 * hc"
+
+example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
+    (h3 : x + y + 5*z + 5*w = 3) :
+  x + 2.2*y + 2*z - 5*w = -8.5 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 2/1)\",\"(poly.const 1/1)\",\"(poly.const -2/1)\"],\"success\":true}"
+  ["ff",
+  "real",
+  "4",
+  "[(((var0 + (21/10 * var1)) + (2 * var2)) - 2), (((var0 + (8 * var2)) + (5 * var3)) - -13/2), ((((var0 + var1) + (5 * var2)) + (5 * var3)) - 3)]",
+  "((((var0 + (11/5 * var1)) + (2 * var2)) - (5 * var3)) - -17/2)"]
+  "linear_combination 2 * h1 + h2 - 2 * h3"
+
+example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
+  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 2/1)\",\"(poly.const -1/1)\",\"(poly.const 3/1)\",\"(poly.const -3/1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "4",
+  "[(var0 - 4), (3 - var3), ((var1 * 3) - var2), (-var2 - var0)]",
+  "(((((2 * var0) - 3) + (9 * var1)) + (3 * var2)) - (((8 - var3) + (3 * var2)) - (3 * var0)))"]
+  "linear_combination 2 * h1 - h2 + 3 * h3 - 3 * h4"
+
+/-! ### Case with ambiguous identifiers-/
+
+example («def evil» y : ℤ) (h1 : 3*«def evil» + 2*y = 10):
+  3*«def evil» + 2*y = 10 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "2",
+  "[(((3 * var0) + (2 * var1)) - 10)]",
+  "(((3 * var0) + (2 * var1)) - 10)"]
+  "linear_combination h1"
+
+example («¥» y : ℤ) (h1 : 3*«¥» + 2*y = 10):
+  «¥» * (3*«¥» + 2*y) = 10 * «¥» :=
+by test_polyrith
+  "{\"data\":[\"(poly.var 0)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "2",
+  "[(((3 * var0) + (2 * var1)) - 10)]",
+  "((var0 * ((3 * var0) + (2 * var1))) - (10 * var0))"]
+  "linear_combination «¥» * h1"
+
+/-! ### Cases with arbitrary coefficients -/
+
+example (a b : ℤ) (h : a = b) :
+  a * a = a * b :=
+by test_polyrith
+  "{\"data\":[\"(poly.var 0)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "2",
+  "[(var0 - var1)]",
+  "((var0 * var0) - (var0 * var1))"]
+  "linear_combination a * h"
+
+example (a b c : ℤ) (h : a = b) :
+  a * c = b * c :=
+by test_polyrith
+  "{\"data\":[\"(poly.var 1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "3",
+  "[(var0 - var2)]",
+  "((var0 * var1) - (var2 * var1))"]
+  "linear_combination c * h"
+
+example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
+  c * a + b = c * b + 1 :=
+by test_polyrith
+  "{\"data\":[\"(poly.var 0)\",\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "3",
+  "[(var1 - var2), (var2 - 1)]",
+  "(((var0 * var1) + var2) - ((var0 * var2) + 1))"]
+  "linear_combination c * h1 + h2"
+
+example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
+  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
+by test_polyrith
+  "{\"data\":[\"(poly.mul (poly.var 0) (poly.var 1))\",\"(poly.const 2/1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "2",
+  "[((var0 + var1) - 3), ((3 * var0) - 7)]",
+  "(((((var0 * var0) * var1) + ((var1 * var0) * var1)) + (6 * var0)) - (((3 * var0) * var1) + 14))"]
+  "linear_combination x * y * h1 + 2 * h2"
+
+example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
+by test_polyrith
+  "{\"data\":[\"(poly.add (poly.var 0) (poly.mul (poly.const 2/1) (poly.var 2)))\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "4",
+  "[(var1 - var3)]",
+  "(((var0 * var1) + ((2 * var2) * var1)) - ((var0 * var3) + ((2 * var2) * var3)))"]
+  "linear_combination (x + 2 * y) * hzw"
+
+/-! ### Cases with non-hypothesis inputs/input restrictions -/
+
+example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
+  b = 2 / 3 :=
+by test_polyrith only [ha, hab]
+  "{\"data\":[\"(poly.const 1/6)\",\"(poly.const 1/3)\"],\"success\":true}"
+  ["ff",
+  "real",
+  "2",
+  "[((2 * var1) - 4), ((2 * var0) - (var1 - var0))]",
+  "(var0 - 2/3)"]
+  "linear_combination ha / 6 + hab / 3"
+
+constant term : ∀ a b : ℚ, a + b = 0
+
+example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
+by test_polyrith only [term c d, h]
+  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "4",
+  "[((var2 + var3) - 0), ((var0 + var1) - 0)]",
+  "((((var0 + var1) + var2) + var3) - 0)"]
+  "linear_combination term c d + h"
+
+constants (qc : ℚ) (hqc : qc = 2*qc)
+
+example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
+by test_polyrith [h a b, hqc]
+  "{\"data\":[\"(poly.const 3/1)\",\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "3",
+  "[(var0 - var2), (var1 - (2 * var1))]",
+  "(((3 * var0) + var1) - ((3 * var2) + (2 * var1)))"]
+  "linear_combination 3 * h a b + hqc"
+
+constant bad (q : ℚ) : q = 0
+
+example (a b : ℚ) : a + b^3 = 0 :=
+by test_polyrith [bad a, bad (b^2)]
+  "{\"data\":[\"(poly.const 1/1)\",\"(poly.var 1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "2",
+  "[(var0 - 0), ((var1 ^ 2) - 0)]",
+  "((var0 + (var1 ^ 3)) - 0)"]
+  "linear_combination bad a + b * bad (b ^ 2)"
+
+/-! ### Case over arbitrary field/ring -/
+
+example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
+  c * (a*f - b*e) = 0 :=
+by test_polyrith
+  "{\"data\":[\"(poly.var 4)\",\"(poly.var 1)\"],\"success\":true}"
+  ["ff",
+  "α",
+  "6",
+  "[((var1 * var5) - (var3 * var0)), ((var0 * var2) - (var4 * var5))]",
+  "((var0 * ((var1 * var2) - (var3 * var4))) - 0)"]
+  "linear_combination e * h1 + a * h2"
+
+example {K : Type*} [field K] [invertible 2] [invertible 3]
+  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
+  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
+  x ^ 3 + 3 * p * x - 2 * q =
+    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
+begin
+  have hs_nonzero : s ≠ 0,
+  { contrapose! hp_nonzero with hs_nonzero,
+    test_polyrith
+  "{\"data\":[\"(poly.const 0/1)\",\"(poly.const 0/1)\",\"(poly.const -1/1)\",\"(poly.const 0/1)\",\"(poly.var 4)\"],\"success\":true}"
+  ["ff",
+  "K",
+  "6",
+  "[((var1 ^ 2) - ((var2 ^ 2) + (var0 ^ 3))), ((var3 ^ 3) - (var2 + var1)), ((var4 * var3) - var0), (((1 + var5) + (var5 ^ 2)) - 0), (var3 - 0)]",
+  "(var0 - 0)"]
+  "linear_combination -ht + t * hs_nonzero"},
+  have H' : 2 * q = s ^ 3 - t ^ 3,
+  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
+    test_polyrith
+  "{\"data\":[\"(poly.const -1/1)\",\"(poly.sub (poly.add (poly.neg (poly.pow (poly.var 1) 3)) (poly.var 0)) (poly.var 3))\",\"(poly.add (poly.add (poly.mul (poly.pow (poly.var 1) 2) (poly.pow (poly.var 2) 2)) (poly.mul (poly.mul (poly.var 1) (poly.var 2)) (poly.var 4))) (poly.pow (poly.var 4) 2))\",\"(poly.const 0/1)\"],\"success\":true}"
+  ["ff",
+  "K",
+  "6",
+  "[((var3 ^ 2) - ((var0 ^ 2) + (var4 ^ 3))), ((var1 ^ 3) - (var0 + var3)), ((var2 * var1) - var4), (((1 + var5) + (var5 ^ 2)) - 0)]",
+  "(((2 * var0) * (var1 ^ 3)) - (((var1 ^ 3) - (var2 ^ 3)) * (var1 ^ 3)))"]
+  "linear_combination -hr + (-s ^ 3 + q - r) * hs3 + (s ^ 2 * t ^ 2 + s * t * p + p ^ 2) * ht"},
+  test_polyrith
+  "{\"data\":[\"(poly.const 0/1)\",\"(poly.const 0/1)\",\"(poly.add (poly.add (poly.sub (poly.add (poly.add (poly.sub (poly.add (poly.sub (poly.mul (poly.var 0) (poly.pow (poly.var 5) 4)) (poly.mul (poly.var 3) (poly.pow (poly.var 5) 4))) (poly.mul (poly.var 4) (poly.pow (poly.var 5) 4))) (poly.mul (poly.var 3) (poly.pow (poly.var 5) 3))) (poly.mul (poly.var 4) (poly.pow (poly.var 5) 3))) (poly.mul (poly.mul (poly.const 3/1) (poly.var 0)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.var 3) (poly.pow (poly.var 5) 2))) (poly.mul (poly.var 4) (poly.pow (poly.var 5) 2))) (poly.mul (poly.mul (poly.const 2/1) (poly.var 0)) (poly.var 5)))\",\"(poly.add (poly.sub (poly.add (poly.sub (poly.sub (poly.add (poly.add (poly.sub (poly.add (poly.sub (poly.sub (poly.add (poly.neg (poly.mul (poly.mul (poly.var 0) (poly.pow (poly.var 3) 2)) (poly.var 5))) (poly.mul (poly.pow (poly.var 3) 3) (poly.var 5))) (poly.mul (poly.mul (poly.var 0) (poly.pow (poly.var 4) 2)) (poly.var 5))) (poly.mul (poly.pow (poly.var 4) 3) (poly.var 5))) (poly.mul (poly.mul (poly.var 0) (poly.var 1)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.mul (poly.var 1) (poly.var 3)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.mul (poly.var 1) (poly.var 4)) (poly.pow (poly.var 5) 2))) (poly.mul (poly.pow (poly.var 0) 2) (poly.var 3))) (poly.pow (poly.var 3) 3)) (poly.mul (poly.pow (poly.var 0) 2) (poly.var 4))) (poly.pow (poly.var 4) 3)) (poly.mul (poly.mul (poly.var 0) (poly.var 1)) (poly.var 5))) (poly.mul (poly.mul (poly.const 3/1) (poly.var 0)) (poly.var 1)))\",\"(poly.const -1/1)\"],\"success\":true}"
+  ["ff",
+  "K",
+  "7",
+  "[((var6 ^ 2) - ((var2 ^ 2) + (var1 ^ 3))), ((var3 ^ 3) - (var2 + var6)), ((var4 * var3) - var1), (((1 + var5) + (var5 ^ 2)) - 0), ((2 * var2) - ((var3 ^ 3) - (var4 ^ 3)))]",
+  "((((var0 ^ 3) + ((3 * var1) * var0)) - (2 * var2)) - (((var0 - (var3 - var4)) * (var0 - ((var3 * var5) - (var4 * (var5 ^ 2))))) * (var0 - ((var3 * (var5 ^ 2)) - (var4 * var5)))))"]
+  "linear_combination (x * ω ^ 4 - s * ω ^ 4 + t * ω ^ 4 - s * ω ^ 3 + t * ω ^ 3 + 3 * x * ω ^ 2 - s * ω ^ 2 +
+      t * ω ^ 2 +
+    2 * x * ω) * ht + (-(x * s ^ 2 * ω) + s ^ 3 * ω - x * t ^ 2 * ω - t ^ 3 * ω + x * p * ω ^ 2 - p * s * ω ^ 2 +
+                p * t * ω ^ 2 +
+              x ^ 2 * s -
+            s ^ 3 -
+          x ^ 2 * t +
+        t ^ 3 -
+      x * p * ω +
+    3 * x * p) * H - H'"
+end
+
+
+/-! ## Degenerate cases -/
+
+example {K : Type*} [field K] [char_zero K] {s : K} (hs : 3 * s + 1 = 4) : s = 1 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/3)\"],\"success\":true}"
+  ["ff",
+  "K",
+  "1",
+  "[(((3 * var0) + 1) - 4)]",
+  "(var0 - 1)"]
+  "linear_combination hs / 3"
+
+example {x : ℤ} (h1 : x + 4 = 2) : x = -2 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "1",
+  "[((var0 + 4) - 2)]",
+  "(var0 - -2)"]
+  "linear_combination h1"
+
+example {w : ℚ} (h1 : 3 * w + 1 = 4) : w = 1 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/3)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "1",
+  "[(((3 * var0) + 1) - 4)]",
+  "(var0 - 1)"]
+  "linear_combination h1 / 3"
+
+example {x : ℤ} (h1 : 2 * x + 3 = x) : x = -3 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "1",
+  "[(((2 * var0) + 3) - var0)]",
+  "(var0 - -3)"]
+  "linear_combination h1"
+
+example {c : ℚ} (h1 : 4 * c + 1 = 3 * c - 2) : c = -3 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\"],\"success\":true}"
+  ["ff",
+  "rat",
+  "1",
+  "[(((4 * var0) + 1) - ((3 * var0) - 2))]",
+  "(var0 - -3)"]
+  "linear_combination h1"
+
+example (z : ℤ) (h1 : z + 1 = 2) (h2 : z + 2 = 2) : (1 : ℤ) = 2 :=
+by test_polyrith
+  "{\"data\":[\"(poly.const 1/1)\",\"(poly.const -1/1)\"],\"success\":true}"
+  ["ff",
+  "int",
+  "1",
+  "[((var0 + 1) - 2), ((var0 + 2) - 2)]",
+  "(1 - 2)"]
+  "linear_combination h1 - h2"
+
+
+-- We comment the following tests so that we don't overwhelm the SageCell API.
+
+
+
+
+
+/-
+
+/-! ### Standard Cases over ℤ, ℚ, and ℝ -/
+
+example (x y : ℤ) (h1 : 3*x + 2*y = 10):
+  3*x + 2*y = 10 :=
+by polyrith
+
+example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
+  x*y = -2*y + 1 :=
+by polyrith
+
+example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
+  -y + 2*x + 4 = -16 :=
+by polyrith
+
+example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
+    (hc : x + 2*y + z = 2) :
+  -3*x - 3*y - 4*z = 2 :=
+by polyrith
+
+example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
+    (h3 : x + y + 5*z + 5*w = 3) :
+  x + 2.2*y + 2*z - 5*w = -8.5 :=
+by polyrith
+
+example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
+  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
+by polyrith
+
+/-! ### Case with ambiguous identifiers-/
+
+example («def evil» y : ℤ) (h1 : 3*«def evil» + 2*y = 10):
+  3*«def evil» + 2*y = 10 :=
+by polyrith
+
+example («¥» y : ℤ) (h1 : 3*«¥» + 2*y = 10):
+  «¥» * (3*«¥» + 2*y) = 10 * «¥» :=
+by polyrith
+
+/-! ### Cases with arbitrary coefficients -/
+
+example (a b : ℤ) (h : a = b) :
+  a * a = a * b :=
+by polyrith
+
+example (a b c : ℤ) (h : a = b) :
+  a * c = b * c :=
+by polyrith
+
+example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
+  c * a + b = c * b + 1 :=
+by polyrith
+
+example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
+  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
+by polyrith
+
+example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
+by polyrith
+
+
+/-! ### Cases with non-hypothesis inputs/input restrictions -/
+
+example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
+  b = 2 / 3 :=
+by polyrith only [ha, hab]
+
+-- constant term : ∀ a b : ℚ, a + b = 0
+
+example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
+by polyrith only [term c d, h]
+
+-- constants (qc : ℚ) (hqc : qc = 2*qc)
+
+example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
+by polyrith [h a b, hqc]
+
+-- constant bad (q : ℚ) : q = 0
+
+example (a b : ℚ) : a + b^3 = 0 :=
+by polyrith [bad a, bad (b^2)]
+
+/-! ### Case over arbitrary field/ring -/
+
+example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
+  c * (a*f - b*e) = 0 :=
+by polyrith
+
+example {K : Type*} [field K] [invertible 2] [invertible 3]
+  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
+  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
+  x ^ 3 + 3 * p * x - 2 * q =
+    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
+begin
+  have hs_nonzero : s ≠ 0,
+  { contrapose! hp_nonzero with hs_nonzero,
+    polyrith,
+     },
+  have H' : 2 * q = s ^ 3 - t ^ 3,
+  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
+    polyrith,},
+  polyrith,
+end
+
+/-!
+### With trace enabled
+Here, the tactic will trace the command that gets sent to sage,
+and so the tactic will not prove the goal. `linear_combination`
+is called manually to prevent errors.
+-/
+
+set_option trace.polyrith true
+
+example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
+  -y + 2*x + 4 = -16 :=
+begin
+  polyrith,
+  linear_combination 2 * h1 - h2,
+end
+
+example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
+  c * a + b = c * b + 1 :=
+begin
+  polyrith,
+  linear_combination c * h1 + h2,
+end
+
+example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
+begin
+  polyrith only [term c d, h],
+  linear_combination term c d + h,
+end
+
+example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
+begin
+  polyrith [h a b, hqc],
+  linear_combination 3 * h a b + hqc,
+end
+-/
+
+
+-- the following can be uncommented to regenerate the tests above.
+
+/-
+
+
+/-! ### Standard Cases over ℤ, ℚ, and ℝ -/
+
+example (x y : ℤ) (h1 : 3*x + 2*y = 10):
+  3*x + 2*y = 10 :=
+by create_polyrith_test
+
+example (x y : ℚ) (h1 : x*y + 2*x = 1) (h2 : x = y) :
+  x*y = -2*y + 1 :=
+by create_polyrith_test
+
+example (x y : ℝ) (h1 : x + 2 = -3) (h2 : y = 10) :
+  -y + 2*x + 4 = -16 :=
+by create_polyrith_test
+
+example (x y z : ℝ) (ha : x + 2*y - z = 4) (hb : 2*x + y + z = -2)
+    (hc : x + 2*y + z = 2) :
+  -3*x - 3*y - 4*z = 2 :=
+by create_polyrith_test
+
+example (w x y z : ℝ) (h1 : x + 2.1*y + 2*z = 2) (h2 : x + 8*z + 5*w = -6.5)
+    (h3 : x + y + 5*z + 5*w = 3) :
+  x + 2.2*y + 2*z - 5*w = -8.5 :=
+by create_polyrith_test
+
+example (a b c d : ℚ) (h1 : a = 4) (h2 : 3 = b) (h3 : c*3 = d) (h4 : -d = a) :
+  2*a - 3 + 9*c + 3*d = 8 - b + 3*d - 3*a :=
+by create_polyrith_test
+
+/-! ### Case with ambiguous identifiers-/
+
+example («def evil» y : ℤ) (h1 : 3*«def evil» + 2*y = 10):
+  3*«def evil» + 2*y = 10 :=
+by create_polyrith_test
+
+example («¥» y : ℤ) (h1 : 3*«¥» + 2*y = 10):
+  «¥» * (3*«¥» + 2*y) = 10 * «¥» :=
+by create_polyrith_test
+
+/-! ### Cases with arbitrary coefficients -/
+
+example (a b : ℤ) (h : a = b) :
+  a * a = a * b :=
+by create_polyrith_test
+
+example (a b c : ℤ) (h : a = b) :
+  a * c = b * c :=
+by create_polyrith_test
+
+example (a b c : ℤ) (h1 : a = b) (h2 : b = 1) :
+  c * a + b = c * b + 1 :=
+by create_polyrith_test
+
+example (x y : ℚ) (h1 : x + y = 3) (h2 : 3*x = 7) :
+  x*x*y + y*x*y + 6*x = 3*x*y + 14 :=
+by create_polyrith_test
+
+example (x y z w : ℚ) (hzw : z = w) : x*z + 2*y*z = x*w + 2*y*w :=
+by create_polyrith_test
+
+/-! ### Cases with non-hypothesis inputs/input restrictions -/
+
+example (a b : ℝ) (ha : 2*a = 4) (hab : 2*b = a - b) (hignore : 3 = a + b) :
+  b = 2 / 3 :=
+by create_polyrith_test only [ha, hab]
+
+constant term : ∀ a b : ℚ, a + b = 0
+
+example (a b c d : ℚ) (h : a + b = 0) (h2: b + c = 0): a + b + c + d = 0 :=
+by create_polyrith_test only [term c d, h]
+
+constants (qc : ℚ) (hqc : qc = 2*qc)
+
+example (a b : ℚ) (h : ∀ p q : ℚ, p = q) : 3*a + qc = 3*b + 2*qc :=
+by create_polyrith_test [h a b, hqc]
+
+constant bad (q : ℚ) : q = 0
+
+example (a b : ℚ) : a + b^3 = 0 :=
+by create_polyrith_test [bad a, bad (b^2)]
+
+/-! ### Case over arbitrary field/ring -/
+
+example {α} [h : comm_ring α] {a b c d e f : α} (h1 : a*d = b*c) (h2 : c*f = e*d) :
+  c * (a*f - b*e) = 0 :=
+by create_polyrith_test
+
+example {K : Type*} [field K] [invertible 2] [invertible 3]
+  {ω p q r s t x: K} (hp_nonzero : p ≠ 0) (hr : r ^ 2 = q ^ 2 + p ^ 3) (hs3 : s ^ 3 = q + r)
+  (ht : t * s = p) (x : K) (H : 1 + ω + ω ^ 2 = 0) :
+  x ^ 3 + 3 * p * x - 2 * q =
+    (x - (s - t)) * (x - (s * ω - t * ω ^ 2)) * (x - (s * ω ^ 2 - t * ω)) :=
+begin
+  have hs_nonzero : s ≠ 0,
+  { contrapose! hp_nonzero with hs_nonzero,
+    create_polyrith_test },
+  have H' : 2 * q = s ^ 3 - t ^ 3,
+  { rw ← mul_left_inj' (pow_ne_zero 3 hs_nonzero),
+    create_polyrith_test },
+  create_polyrith_test
+end
+
+
+/-! ## Degenerate cases -/
+
+example {K : Type*} [field K] [char_zero K] {s : K} (hs : 3 * s + 1 = 4) : s = 1 :=
+by create_polyrith_test
+
+example {x : ℤ} (h1 : x + 4 = 2) : x = -2 :=
+by create_polyrith_test
+
+example {w : ℚ} (h1 : 3 * w + 1 = 4) : w = 1 :=
+by create_polyrith_test
+
+example {x : ℤ} (h1 : 2 * x + 3 = x) : x = -3 :=
+by create_polyrith_test
+
+example {c : ℚ} (h1 : 4 * c + 1 = 3 * c - 2) : c = -3 :=
+by create_polyrith_test
+
+example (z : ℤ) (h1 : z + 1 = 2) (h2 : z + 2 = 2) : (1 : ℤ) = 2 :=
+by create_polyrith_test
+
+
+-/
diff --git a/test/positivity.lean b/test/positivity.lean
new file mode 100644
index 0000000000000..007d449a37bf3
--- /dev/null
+++ b/test/positivity.lean
@@ -0,0 +1,303 @@
+import algebra.order.interval
+import algebra.order.smul
+import analysis.normed.group.basic
+import analysis.special_functions.pow.nnreal
+import combinatorics.simple_graph.density
+import data.complex.exponential
+import data.rat.nnrat
+import data.real.ereal
+import data.real.hyperreal
+import data.real.sqrt
+import tactic.positivity
+
+/-! # Tests for the `positivity` tactic
+
+This tactic proves goals of the form `0 ≤ a` and `0 < a`.
+-/
+
+open function
+open_locale ennreal nat nnrat nnreal
+
+universe u
+variables {ι α β : Type*}
+
+/- ## Numeric goals -/
+
+example : 0 ≤ 0 := by positivity
+
+example : 0 ≤ 3 := by positivity
+
+example : 0 < 3 := by positivity
+
+/- ## Goals working directly from a hypothesis -/
+
+example {a : ℤ} (ha : 0 < a) : 0 < a := by positivity
+example {a : ℤ} (ha : 0 < a) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : 0 < a) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : 0 ≤ a) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : a ≠ 0) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : a = 0) : 0 ≤ a := by positivity
+
+/- ### Reversing hypotheses -/
+
+example {a : ℤ} (ha : a > 0) : 0 < a := by positivity
+example {a : ℤ} (ha : a > 0) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : a > 0) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : a ≥ 0) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : 0 ≠ a) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : 0 < a) : a > 0 := by positivity
+example {a : ℤ} (ha : 0 < a) : a ≥ 0 := by positivity
+example {a : ℤ} (ha : 0 < a) : 0 ≠ a := by positivity
+example {a : ℤ} (ha : 0 ≤ a) : a ≥ 0 := by positivity
+example {a : ℤ} (ha : a ≠ 0) : 0 ≠ a := by positivity
+example {a : ℤ} (ha : a = 0) : a ≥ 0 := by positivity
+example {a : ℤ} (ha : 0 = a) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : 0 = a) : a ≥ 0 := by positivity
+
+/- ### Calling `norm_num` -/
+
+example {a : ℤ} (ha : 3 = a) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : 3 = a) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : 3 = a) : 0 < a := by positivity
+example {a : ℤ} (ha : a = -1) : a ≠ 0 := by positivity
+
+example {a : ℤ} (ha : 3 ≤ a) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : 3 ≤ a) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : 3 ≤ a) : 0 < a := by positivity
+
+example {a : ℤ} (ha : 3 < a) : 0 ≤ a := by positivity
+example {a : ℤ} (ha : 3 < a) : a ≠ 0 := by positivity
+example {a : ℤ} (ha : 3 < a) : 0 < a := by positivity
+
+example {a b : ℤ} (h : 0 ≤ a + b) : 0 ≤ a + b := by positivity
+
+example {a : ℤ} (hlt : 0 ≤ a) (hne : a ≠ 0) : 0 < a := by positivity
+
+/- ## Tests of the @[positivity] plugin tactics (addition, multiplication, division) -/
+
+example [nonempty ι] [has_zero α] {a : α} (ha : a ≠ 0) : const ι a ≠ 0 := by positivity
+example [has_zero α] [preorder α] {a : α} (ha : 0 < a) : 0 ≤ const ι a := by positivity
+example [has_zero α] [preorder α] {a : α} (ha : 0 ≤ a) : 0 ≤ const ι a := by positivity
+example [nonempty ι] [has_zero α] [preorder α] {a : α} (ha : 0 < a) : 0 < const ι a := by positivity
+
+section ite
+variables {p : Prop} [decidable p] {a b : ℤ}
+
+example (ha : 0 < a) (hb : 0 < b) : 0 < ite p a b := by positivity
+example (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ ite p a b := by positivity
+example (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ ite p a b := by positivity
+example (ha : 0 < a) (hb : b ≠ 0) : ite p a b ≠ 0 := by positivity
+example (ha : a ≠ 0) (hb : 0 < b) : ite p a b ≠ 0 := by positivity
+example (ha : a ≠ 0) (hb : b ≠ 0) : ite p a b ≠ 0 := by positivity
+
+end ite
+
+example {a b : ℚ} (ha : 0 < a) (hb : 0 < b) : 0 < min a b := by positivity
+example {a b : ℚ} (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ min a b := by positivity
+example {a b : ℚ} (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ min a b := by positivity
+example {a b : ℚ} (ha : 0 < a) (hb : b ≠ 0) : min a b ≠ 0 := by positivity
+example {a b : ℚ} (ha : a ≠ 0) (hb : 0 < b) : min a b ≠ 0 := by positivity
+example {a b : ℚ} (ha : a ≠ 0) (hb : b ≠ 0) : min a b ≠ 0 := by positivity
+
+example {a b : ℚ} (ha : 0 < a) (hb : 0 < b) : 0 < a * b := by positivity
+example {a b : ℚ} (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a * b := by positivity
+example {a b : ℚ} (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a * b := by positivity
+example {a b : ℚ} (ha : 0 < a) (hb : b ≠ 0) : a * b ≠ 0 := by positivity
+example {a b : ℚ} (ha : a ≠ 0) (hb : 0 < b) : a * b ≠ 0 := by positivity
+example {a b : ℚ} (ha : a ≠ 0) (hb : b ≠ 0) : a * b ≠ 0 := by positivity
+
+example {a b : ℚ} (ha : 0 < a) (hb : 0 < b) : 0 < a / b := by positivity
+example {a b : ℚ} (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a / b := by positivity
+example {a b : ℚ} (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a / b := by positivity
+example {a b : ℚ} (ha : 0 < a) (hb : b ≠ 0) : a / b ≠ 0 := by positivity
+example {a b : ℚ} (ha : a ≠ 0) (hb : 0 < b) : a / b ≠ 0 := by positivity
+example {a b : ℚ} (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 := by positivity
+
+example {a : ℚ} (ha : 0 < a) : 0 < a⁻¹ := by positivity
+example {a : ℚ} (ha : 0 ≤ a) : 0 ≤ a⁻¹ := by positivity
+example {a : ℚ} (ha : a ≠ 0) : a⁻¹ ≠ 0 := by positivity
+
+example {a : ℚ} (n : ℕ) (ha : 0 < a) : 0 < a ^ n := by positivity
+example {a : ℚ} (n : ℕ) (ha : 0 ≤ a) : 0 ≤ a ^ n := by positivity
+example {a : ℚ} (n : ℕ) (ha : a ≠ 0) : a ^ n ≠ 0 := by positivity
+example {a : ℚ} (n : ℕ) : 0 ≤ a ^ bit0 n := by positivity
+example {a : ℚ} (n : ℕ) (ha : a ≠ 0) : 0 < a ^ bit0 n := by positivity
+
+example {a : ℚ} (ha : 0 < a) : 0 < |a| := by positivity
+example {a : ℚ} (ha : a ≠ 0) : 0 < |a| := by positivity
+example (a : ℚ) : 0 ≤ |a| := by positivity
+
+example {a : ℤ} {b : ℚ} (ha : 0 < a) (hb : 0 < b) : 0 < a • b := by positivity
+example {a : ℤ} {b : ℚ} (ha : 0 < a) (hb : 0 ≤ b) : 0 ≤ a • b := by positivity
+example {a : ℤ} {b : ℚ} (ha : 0 ≤ a) (hb : 0 < b) : 0 ≤ a • b := by positivity
+example {a : ℤ} {b : ℚ} (ha : 0 < a) (hb : b ≠ 0) : a • b ≠ 0 := by positivity
+example {a : ℤ} {b : ℚ} (ha : a ≠ 0) (hb : 0 < b) : a • b ≠ 0 := by positivity
+example {a : ℤ} {b : ℚ} (ha : a ≠ 0) (hb : b ≠ 0) : a • b ≠ 0 := by positivity
+
+example {a : ℤ} (ha : 3 < a) : 0 ≤ a + a := by positivity
+
+example {a b : ℤ} (ha : 3 < a) (hb : 4 ≤ b) : 0 ≤ 3 + a + b + b + 14 := by positivity
+
+example {H : Type*} [linear_ordered_add_comm_group H] {a b : H} (ha : 0 < a) (hb : 0 ≤ b) :
+  0 ≤ a + a + b :=
+by positivity
+
+example {a : ℤ} (ha : 3 < a) : 0 < a + a := by positivity
+
+example {a b : ℚ} (ha : 3 < a) (hb : 4 ≤ b) : 0 < 3 + a * b / 7 + b + 7 + 14 := by positivity
+
+example {a b : ℤ} (ha : 3 < a) (hb : 4 ≤ b) : 0 < 3 + a * b / 7 + b + 7 + 14 := by positivity
+
+example {a : ℤ} (ha : 0 < a) : 0 < a / a := by positivity
+
+/-! ### Exponentiation -/
+
+example [ordered_semiring α] [nontrivial α] (a : α) : 0 < a ^ 0 := by positivity
+example [linear_ordered_ring α] (a : α) (n : ℕ) : 0 ≤ a ^ bit0 n := by positivity
+example [ordered_semiring α] {a : α} {n : ℕ} (ha : 0 ≤ a) : 0 ≤ a ^ n := by positivity
+example [strict_ordered_semiring α] {a : α} {n : ℕ} (ha : 0 < a) : 0 < a ^ n := by positivity
+example [canonically_ordered_comm_semiring α] {a : α} (ha : 0 < a) (n : ℕ) : 0 < a ^ n :=
+by positivity
+
+example [linear_ordered_semifield α] (a : α) : 0 < a ^ (0 : ℤ) := by positivity
+example [linear_ordered_field α] (a : α) (n : ℤ) : 0 ≤ a ^ bit0 n := by positivity
+example [linear_ordered_semifield α] {a : α} {n : ℤ} (ha : 0 ≤ a) : 0 ≤ a ^ n := by positivity
+example [linear_ordered_semifield α] {a : α} {n : ℤ} (ha : 0 < a) : 0 < a ^ n := by positivity
+
+example {a b : cardinal.{u}} (ha : 0 < a) : 0 < a ^ b := by positivity
+example {a b : ordinal.{u}} (ha : 0 < a) : 0 < a ^ b := by positivity
+
+example {a b : ℝ} (ha : 0 ≤ a) : 0 ≤ a ^ b := by positivity
+example {a b : ℝ} (ha : 0 < a) : 0 < a ^ b := by positivity
+example {a : ℝ≥0} {b : ℝ} (ha : 0 < a) : 0 < a ^ b := by positivity
+example {a : ℝ≥0∞} {b : ℝ} (ha : 0 < a) (hb : 0 ≤ b) : 0 < a ^ b := by positivity
+example {a : ℝ≥0∞} {b : ℝ} (ha : 0 < a) (hb : 0 < b) : 0 < a ^ b := by positivity
+
+example {a : ℝ} (ha : 0 < a) : 0 ≤ ⌊a⌋ := by positivity
+example {a : ℝ} (ha : 0 ≤ a) : 0 ≤ ⌊a⌋ := by positivity
+
+example {a : ℝ} (ha : 0 < a) : 0 < ⌈a⌉₊ := by positivity
+example {a : ℝ} (ha : 0 < a) : 0 < ⌈a⌉ := by positivity
+example {a : ℝ} (ha : 0 ≤ a) : 0 ≤ ⌈a⌉ := by positivity
+
+example {a : ℤ} (ha : 3 < a) : 0 ≤ a ^ 2 + a := by positivity
+
+example {a : ℤ} (ha : 3 < a) : 0 ≤ a ^ 3 + a := by positivity
+
+example {a : ℤ} (ha : 3 < a) : 0 < a ^ 2 + a := by positivity
+
+example {a b : ℤ} (ha : 3 < a) (hb : b ≥ 4) : 0 ≤ 3 * a ^ 2 * b + b * 7 + 14 := by positivity
+
+example {a b : ℤ} (ha : 3 < a) (hb : b ≥ 4) : 0 < 3 * a ^ 2 * b + b * 7 + 14 := by positivity
+
+example {a : ℤ} : 0 ≤ |a| := by positivity
+
+example {a : ℤ} : 0 < |a| + 3 := by positivity
+
+example {n : ℤ} (hn : 0 < n) : 0 < n.nat_abs := by positivity
+example {n : ℤ} (hn : n ≠ 0) : 0 < n.nat_abs := by positivity
+
+example {a : ℤ} (ha : 1 < a) : 0 < |(3:ℤ) + a| := by positivity
+
+example {a : ℝ} (ha : 0 ≤ a) : 0 ≤ real.sqrt a := by positivity
+
+example {a : ℝ} (ha : 0 ≤ a) : 0 < real.sqrt (a + 3) := by positivity
+
+example {a b : ℤ} (ha : 3 < a) : 0 ≤ min a (b ^ 2) := by positivity
+
+-- test that the tactic can ignore arithmetic operations whose associated extension tactic requires
+-- more typeclass assumptions than are available
+example {R : Type*} [has_zero R] [has_div R] [linear_order R] {a b c : R} (h1 : 0 < a) (h2 : 0 < b)
+  (h3 : 0 < c) :
+  0 < max (a / b) c :=
+by positivity
+
+example : 0 ≤ max 3 4 := by positivity
+
+example {b : ℤ} : 0 ≤ max (-3) (b ^ 2) := by positivity
+
+example {b : ℤ} : 0 ≤ max (b ^ 2) 0 := by positivity
+
+example : 0 ≤ max (0:ℤ) (-3) := by positivity
+
+example : 0 ≤ max (-3 : ℤ) 5 := by positivity
+
+example [ordered_semiring α] [ordered_add_comm_monoid β] [smul_with_zero α β]
+  [ordered_smul α β] {a : α} (ha : 0 < a) {b : β} (hb : 0 < b) : 0 ≤ a • b := by positivity
+
+example (n : ℕ) : 0 < n.succ := by positivity
+example (n : ℕ) : 0 < n! := by positivity
+example (n k : ℕ) : 0 < n.asc_factorial k := by positivity
+
+example {α : Type*} (s : finset α) (hs : s.nonempty) : 0 < s.card := by positivity
+example {α : Type*} [fintype α] [nonempty α] : 0 < fintype.card α := by positivity
+
+example {r : ℝ} : 0 < real.exp r := by positivity
+
+example [ordered_add_comm_group α] (s : nonempty_interval α) : 0 ≤ s.length := by positivity
+example [ordered_add_comm_group α] (s : interval α) : 0 ≤ s.length := by positivity
+
+example {V : Type*} [normed_add_comm_group V] (x : V) : 0 ≤ ‖x‖ := by positivity
+
+example [metric_space α] (x y : α) : 0 ≤ dist x y := by positivity
+example [metric_space α] {s : set α} : 0 ≤ metric.diam s := by positivity
+
+example {E : Type*} [add_group E] {p : add_group_seminorm E} {x : E} : 0 ≤ p x := by positivity
+example {E : Type*} [group E] {p : group_seminorm E} {x : E} : 0 ≤ p x := by positivity
+
+example {r : α → β → Prop} [Π a, decidable_pred (r a)] {s : finset α} {t : finset β} :
+  0 ≤ rel.edge_density r s t := by positivity
+example {G : simple_graph α} [decidable_rel G.adj] {s t : finset α} :
+  0 ≤ G.edge_density s t := by positivity
+
+/- ### Canonical orders -/
+
+example {a : ℕ} : 0 ≤ a := by positivity
+example {a : ℚ≥0} : 0 ≤ a := by positivity
+example {a : ℝ≥0} : 0 ≤ a := by positivity
+example {a : ℝ≥0∞} : 0 ≤ a := by positivity
+
+/- ### Coercions -/
+
+example {a : ℕ} : (0 : ℤ) ≤ a := by positivity
+example {a : ℕ} : (0 : ℚ) ≤ a := by positivity
+example {a : ℕ} (ha : 0 < a) : (0 : ℤ) < a := by positivity
+example {a : ℕ} (ha : 0 < a) : (0 : ℚ) < a := by positivity
+example {a : ℤ} (ha : a ≠ 0) : (a : ℚ) ≠ 0 := by positivity
+example {a : ℤ} (ha : 0 ≤ a) : (0 : ℚ) ≤ a := by positivity
+example {a : ℤ} (ha : 0 < a) : (0 : ℚ) < a := by positivity
+example {a : ℚ} (ha : a ≠ 0) : (a : ℝ) ≠ 0 := by positivity
+example {a : ℚ} (ha : 0 ≤ a) : (0 : ℝ) ≤ a := by positivity
+example {a : ℚ} (ha : 0 < a) : (0 : ℝ) < a := by positivity
+example {r : ℝ≥0} : (0 : ℝ) ≤ r := by positivity
+example {r : ℝ≥0} (hr : 0 < r) : (0 : ℝ) < r := by positivity
+example {r : ℝ≥0} (hr : 0 < r) : (0 : ℝ≥0∞) < r := by positivity
+-- example {r : ℝ≥0} : (0 : ereal) ≤ r := by positivity -- TODO: Handle `coe_trans`
+-- example {r : ℝ≥0} (hr : 0 < r) : (0 : ereal) < r := by positivity
+example {r : ℝ} (hr : 0 ≤ r) : (0 : ereal) ≤ r := by positivity
+example {r : ℝ} (hr : 0 < r) : (0 : ereal) < r := by positivity
+example {r : ℝ} (hr : 0 ≤ r) : (0 : hyperreal) ≤ r := by positivity
+example {r : ℝ} (hr : 0 < r) : (0 : hyperreal) < r := by positivity
+example {r : ℝ≥0∞} : (0 : ereal) ≤ r := by positivity
+example {r : ℝ≥0∞} (hr : 0 < r) : (0 : ereal) < r := by positivity
+
+example {α : Type*} [ordered_ring α] {n : ℤ} : 0 ≤ ((n ^ 2 : ℤ) : α) := by positivity
+example {r : ℝ≥0} : 0 ≤ ((r : ℝ) : ereal) := by positivity
+example {r : ℝ≥0} : 0 < ((r + 1 : ℝ) : ereal) := by positivity
+
+/- ## Tests that the tactic is agnostic on reversed inequalities -/
+
+example {a : ℤ} (ha : a > 0) : 0 ≤ a := by positivity
+
+example {a : ℤ} (ha : 0 < a) : a ≥ 0 := by positivity
+
+example {a : ℤ} (ha : a > 0) : a ≥ 0 := by positivity
+
+/-
+## Test for meta-variable instantiation
+
+Reported on
+https://leanprover.zulipchat.com/#narrow/stream/239415-metaprogramming-.2F-tactics/topic/New.20tactic.3A.20.60positivity.60/near/300639970
+-/
+
+example : 0 ≤ 0 := by { apply le_trans _ le_rfl, positivity }
diff --git a/test/print_sorry.lean b/test/print_sorry.lean
new file mode 100644
index 0000000000000..790b9f0f4da29
--- /dev/null
+++ b/test/print_sorry.lean
@@ -0,0 +1,22 @@
+import tactic.print_sorry
+
+axiom my_sorry : false -- we avoid using noisy code in the test folder, so we use an axiom instead
+def foo1 : false := my_sorry
+def foo2 : false ∧ false := ⟨my_sorry, foo1⟩
+def foo3 : false ∧ false := ⟨foo2.1, my_sorry⟩
+def foo4 : true := trivial
+def foo5 : true ∧ false := ⟨foo4, foo3.2⟩
+
+meta def metafoo : ℕ → empty := metafoo
+
+open tactic
+
+#eval show tactic unit, from do
+  env ← get_env,
+  data ← find_all_exprs env (λ e, e.const_name = `my_sorry) (λ _, ff) `foo5,
+  guard $ data.map (λ x, x.1) = [`foo5, `foo3, `foo2, `foo1],
+  guard $ data.map (λ x, x.2.1) = [ff, tt, tt, tt],
+  guard $ data.map (λ x, x.2.2.to_list) = [[`foo3], [`foo2], [`foo1], []],
+  -- make sure it doesn't loop on self-referencing meta expressions
+  find_all_exprs env (λ e, e.const_name = `my_sorry) (λ _, ff) `metafoo,
+  skip
diff --git a/test/push_neg.lean b/test/push_neg.lean
index 887ab382dd276..1f57e7e109bcd 100644
--- a/test/push_neg.lean
+++ b/test/push_neg.lean
@@ -1,5 +1,6 @@
 import tactic.push_neg
-import data.int.basic
+import data.int.order.basic
+import data.nat.basic
 
 example (h : ∃ p: ℕ, ¬ ∀ n : ℕ, n > p) (h' : ∃ p: ℕ, ¬ ∃ n : ℕ, n < p) : ¬ ∀ n : ℕ, n = 0 :=
 begin
@@ -89,3 +90,23 @@ begin
       guard (ht = h1t) ),
   exact hf
 end
+
+/-! Test the option `trace.push_neg.use_distrib` for changing the normal form of `¬(P ∧ Q)`. -/
+
+section
+
+example (a b : ℤ) (h : ¬ (∃ x, (a < x ∧ x < b))) : ∀ x, a < x → b ≤ x :=
+begin
+  push_neg at h,
+  exact h,
+end
+
+set_option trace.push_neg.use_distrib true
+
+example (a b : ℤ) (h : ¬ (∃ x, (a < x ∧ x < b))) : ∀ x, x ≤ a ∨ b ≤ x :=
+begin
+  push_neg at h,
+  exact h,
+end
+
+end
diff --git a/test/qify.lean b/test/qify.lean
new file mode 100644
index 0000000000000..733cacf73dcb7
--- /dev/null
+++ b/test/qify.lean
@@ -0,0 +1,23 @@
+import tactic.qify
+
+example (a b : ℕ) : (a : ℚ) ≤ b ↔ a ≤ b := by qify ; refl
+example (a b : ℕ) : (a : ℚ) < b ↔ a < b := by qify ; refl
+example (a b : ℕ) : (a : ℚ) = b ↔ a = b := by qify ; refl
+example (a b : ℕ) : (a : ℚ) ≠ b ↔ a ≠ b := by qify ; refl
+
+example (a b : ℤ) : (a : ℚ) ≤ b ↔ a ≤ b := by qify ; refl
+example (a b : ℤ) : (a : ℚ) < b ↔ a < b := by qify ; refl
+example (a b : ℤ) : (a : ℚ) = b ↔ a = b := by qify ; refl
+example (a b : ℤ) : (a : ℚ) ≠ b ↔ a ≠ b := by qify ; refl
+
+example (a b c : ℕ) (h : a - b = c) (hab : b ≤ a) : a = c + b :=
+begin
+  qify [hab] at h ⊢, -- `zify` does the same thing here.
+  exact sub_eq_iff_eq_add.1 h,
+end
+
+example (a b c : ℤ) (h : a / b = c) (hab : b ∣ a) (hb : b ≠ 0) : a = c * b :=
+begin
+  qify [hab] at h hb ⊢,
+  exact (div_eq_iff hb).1 h,
+end
diff --git a/test/rat.lean b/test/rat.lean
index 737f416d316fa..d3bf008447d81 100644
--- a/test/rat.lean
+++ b/test/rat.lean
@@ -1,3 +1,4 @@
+import data.rat.basic
 import data.rat.meta_defs
 
 run_cmd let q : ℚ := 3/15 in
@@ -9,4 +10,4 @@ attribute [instance] h
 
 run_cmd guard $ expr.eval_rat `(1/3 - 100/6 : α) = some (-49/3)
 
-run_cmd guard $ (expr.eval_rat ∘ rat.reflect) (-(5/3) : ℚ) = some (-5/3)
+run_cmd guard $ (expr.eval_rat $ rat.reflect (-(5/3) : ℚ)) = some (-5/3)
diff --git a/test/rcases.lean b/test/rcases.lean
index 9d4e3764ddc22..600e64a8d4e40 100644
--- a/test/rcases.lean
+++ b/test/rcases.lean
@@ -6,6 +6,8 @@ Authors: Simon Hudon
 
 import tactic.rcases
 
+instance {α} : has_inter (set α) := ⟨λ s t, {a | a ∈ s ∧ a ∈ t}⟩
+
 universe u
 variables {α β γ : Type u}
 
@@ -187,6 +189,38 @@ example : bool → false → true
 | ff := by rintro ⟨⟩
 | tt := by rintro ⟨⟩
 
+example : true :=
+begin
+  obtain h : true,
+  { trivial },
+  exact h
+end
+
+example {a b} (h : a ∧ b) : a ∧ b :=
+begin
+  rcases h with t,
+  exact t
+end
+
+structure baz {α : Type*} (f : α → α) : Prop := [inst : nonempty α] (h : f ∘ f = id)
+example {α} (f : α → α) (h : baz f) : true := by { rcases h with ⟨_⟩; trivial }
+example {α} (f : α → α) (h : baz f) : true := by { rcases h with @⟨_, _⟩; trivial }
+
+inductive test : nat → Prop
+| a (n) : test (2 + n)
+| b {n} : n > 5 → test (n * n)
+
+example {n} (h : test n) : n = n :=
+begin
+  have : true,
+  { rcases h with a | b,
+    { guard_hyp a : nat, trivial },
+    { guard_hyp b : ‹nat› > 5, trivial } },
+  { rcases h with a | @⟨n, b⟩,
+    { guard_hyp a : nat, trivial },
+    { guard_hyp b : n > 5, trivial } },
+end
+
 open tactic
 meta def test_rcases_hint (s : string) (num_goals : ℕ) (depth := 5) : tactic unit :=
 do change `(true),
@@ -221,7 +255,118 @@ inductive foo (α : Type) : ℕ → Type
 
 example {α} (h : foo α 0) : true := by test_rcases_hint "_ | ⟨_, h_ᾰ⟩" 2
 example {α} (h : foo α 1) : true := by test_rcases_hint "_ | ⟨_, h_ᾰ⟩" 1
-example {α n} (h : foo α n) : true := by test_rcases_hint "_ | ⟨n, h_ᾰ⟩" 2 1
+example {α n} (h : foo α n) : true := by test_rcases_hint "_ | h_ᾰ" 2 1
 
 example {α} (V : set α) (h : ∃ p, p ∈ (V.foo V) ∩ (V.foo V)) :=
 by test_rcases_hint "⟨⟨h_w_fst, h_w_snd⟩, ⟨⟩⟩" 0
+
+section rsuffices
+
+/-- These next few are duplicated from `rcases/obtain` tests, with the goal order swapped. -/
+
+example : true :=
+begin
+  rsuffices ⟨n : ℕ, h : n = n, -⟩ : ∃ n : ℕ, n = n ∧ true,
+  { guard_hyp n : ℕ,
+    guard_hyp h : n = n,
+    success_if_fail {assumption},
+    trivial },
+  { existsi 0, simp },
+end
+
+example : true :=
+begin
+  rsuffices : ∃ n : ℕ, n = n ∧ true,
+  { trivial },
+  { existsi 0, simp },
+end
+
+example : true :=
+begin
+  rsuffices (h : true) | ⟨⟨⟩⟩ : true ∨ false,
+  { guard_hyp h : true,
+    trivial },
+  { left, trivial },
+end
+
+example : true :=
+begin
+  success_if_fail {rsuffices ⟨h, h2⟩},
+  trivial
+end
+
+example (x y : α × β) : true :=
+begin
+  rsuffices ⟨⟨a, b⟩, c, d⟩ : (α × β) × (α × β),
+  { guard_hyp a : α,
+    guard_hyp b : β,
+    guard_hyp c : α,
+    guard_hyp d : β,
+    trivial },
+  { exact ⟨x, y⟩ }
+end
+
+-- This test demonstrates why `swap` is not used in the implementation of `rsuffices`:
+-- it would make the _second_ goal the one requiring ⟨x, y⟩, not the last one.
+example (x y : α ⊕ β) : true :=
+begin
+  rsuffices ⟨a|b, c|d⟩ : (α ⊕ β) × (α ⊕ β),
+  { guard_hyp a : α, guard_hyp c : α, trivial },
+  { guard_hyp a : α, guard_hyp d : β, trivial },
+  { guard_hyp b : β, guard_hyp c : α, trivial },
+  { guard_hyp b : β, guard_hyp d : β, trivial },
+  exact ⟨x, y⟩,
+end
+
+example {α} (V : set α) (w : true → ∃ p, p ∈ (V.foo V) ∩ (V.foo V)) : true :=
+begin
+  rsuffices ⟨a, h⟩ : ∃ p, p ∈ (V.foo V) ∩ (V.foo V),
+  { trivial },
+  { exact w trivial },
+end
+
+-- Now some tests that ensure that things stay in the correct order.
+
+-- This test demonstrates why `focus1` is required in the definition of `rsuffices`; otherwise
+-- the `∃ ...` goal would get put _after_ the `true` goal.
+example : nonempty ℕ ∧ true :=
+begin
+  split,
+  rsuffices ⟨n : ℕ, hn⟩ : ∃ n, _,
+  { exact ⟨n⟩ },
+  { exact true },
+  { exact ⟨0, trivial⟩ },
+  { trivial },
+end
+
+section instances
+
+example (h : Π {α}, inhabited α) : inhabited (α ⊕ β) :=
+begin
+  rsufficesI (ha | hb) : inhabited α ⊕ inhabited β,
+  { exact ⟨sum.inl default⟩ },
+  { exact ⟨sum.inr default⟩ },
+  { exact sum.inl h }
+end
+
+include β
+-- this test demonstrates that the `resetI` also applies onto the goal.
+example (h : Π {α}, inhabited α) : inhabited α :=
+begin
+  have : inhabited β := h,
+  rsufficesI t : β,
+  { exact h },
+  { exact default }
+end
+
+example (h : Π {α}, inhabited α) : β :=
+begin
+  rsufficesI ht : inhabited β,
+  { guard_hyp ht : inhabited β,
+    exact default },
+  { exact h }
+end
+
+end instances
+
+end rsuffices
diff --git a/test/real.lean b/test/real.lean
new file mode 100644
index 0000000000000..d01323b77f70c
--- /dev/null
+++ b/test/real.lean
@@ -0,0 +1,11 @@
+import data.real.basic
+
+meta def test_repr (r : ℝ) (s : string) : tactic unit :=
+guard (repr r = s) <|> fail!"got {repr r}"
+
+run_cmd test_repr 0 "real.of_cauchy (sorry /- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ... -/)"
+run_cmd test_repr 1 "real.of_cauchy (sorry /- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ... -/)"
+run_cmd test_repr (37 : ℕ) "real.of_cauchy (sorry /- 37, 37, 37, 37, 37, 37, 37, 37, 37, 37, ... -/)"
+run_cmd test_repr (2 + 3) "real.of_cauchy (sorry /- 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, ... -/)"
+run_cmd test_repr ⟨cau_seq.completion.mk $ ⟨λ n, 2^(-n:ℤ), sorry⟩⟩
+                  "real.of_cauchy (sorry /- 1, 1/2, 1/4, 1/8, 1/16, 1/32, 1/64, 1/128, 1/256, 1/512, ... -/)"
diff --git a/test/rewrite_search/rewrite_search.lean b/test/rewrite_search/rewrite_search.lean
index 4c3c4ccf547d2..e11a4f34597b8 100644
--- a/test/rewrite_search/rewrite_search.lean
+++ b/test/rewrite_search/rewrite_search.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Kevin Lacker, Keeley Hoek, Scott Morrison
 -/
 import tactic.rewrite_search
-import data.rat.basic
+import data.rat.defs
 import data.real.basic
 
 /-
diff --git a/test/ring.lean b/test/ring.lean
index 04cef1e5ad9fa..f0d15a8954313 100644
--- a/test/ring.lean
+++ b/test/ring.lean
@@ -36,6 +36,19 @@ begin
   ring
 end
 
+example {A : ℤ} (f : ℤ → ℤ) : f 0 = f (A - A) := by ring_nf
+example {A : ℤ} (f : ℤ → ℤ) : f 0 = f (A + -A) := by ring_nf
+
+example {a b c : ℝ} (h : 0 < a ^ 4 + b ^ 4 + c ^ 4) :
+  a ^ 4 / (a ^ 4 + b ^ 4 + c ^ 4) +
+  b ^ 4 / (b ^ 4 + c ^ 4 + a ^ 4) +
+  c ^ 4 / (c ^ 4 + a ^ 4 + b ^ 4)
+  = 1 :=
+begin
+  ring_nf at ⊢ h,
+  field_simp [h.ne'],
+end
+
 example (a b c d x y : ℚ) (hx : x ≠ 0) (hy : y ≠ 0) :
   a + b / x - c / x^2 + d / x^3 = a + x⁻¹ * (y * b / y + (d / x - c) / x) :=
 begin
@@ -76,3 +89,16 @@ by transitivity; [exact h, ring]
 
 -- `ring_nf` should descend into the subexpressions `x * -a` and `-a * x`:
 example {a x : ℚ} : x * -a = - a * x := by ring_nf
+
+example (f : ℤ → ℤ) (a b : ℤ) : f (2 * a + b) + b = b + f (b + a + a) :=
+begin
+  success_if_fail {{ ring_nf {recursive := ff} }},
+  ring_nf
+end
+
+-- instances do not have to syntactically be `monoid.has_pow`
+example {R} [comm_semiring R] (x : ℕ → R) : x ^ 2 = x * x := by ring
+
+-- even if there's an instance we don't recognize, we treat it as an atom
+example {R} [field R] (x : ℕ → R) :
+  (x ^ (2 : ℤ)) ^ 2 = (x ^ (2 : ℤ)) * (x ^ (2 : ℤ)) := by ring
diff --git a/test/ring_exp.lean b/test/ring_exp.lean
index 04905ce9685f8..e2a9036b53ba7 100644
--- a/test/ring_exp.lean
+++ b/test/ring_exp.lean
@@ -1,6 +1,7 @@
 import tactic.ring_exp
 import tactic.zify
 import algebra.group_with_zero.power
+import algebra.ring.pi
 import tactic.field_simp
 
 universes u
@@ -75,6 +76,13 @@ example (a b : ℚ) : (a * b) ^ 1000000 = (b * a) ^ 1000000 := by ring_exp
 example (n : ℕ) : 2 ^ (n + 1 + 1)  = 2 * 2 ^ (n + 1) :=
 by ring_exp_eq
 
+-- power does not have to be a syntactic match to `monoid.has_pow`
+example {α} [comm_ring α] (x : ℕ → α) : (x ^ 2 * x) = x ^ 3 := by ring_exp
+
+-- Powers in the exponent get evaluated correctly.
+example (X : ℤ) : (X^5 + 1) * (X^2^3 + X) = X^13 + X^8 + X^6 + X :=
+by ring_exp
+
 end exponentiation
 
 section power_of_sum
diff --git a/test/set.lean b/test/set.lean
index e264d10707547..bbeebd5240130 100644
--- a/test/set.lean
+++ b/test/set.lean
@@ -36,3 +36,18 @@ begin
   set b : T := u, -- the type `T` can't be fully elaborated without the body but this is fine
   trivial
 end
+
+section lean_555 -- https://github.com/leanprover-community/mathlib/pull/14488
+
+inductive foo | bar
+
+instance : has_coe_to_sort foo _ :=
+⟨λ _, unit⟩
+
+example : true :=
+begin
+  set x : foo.bar := (),
+  trivial,
+end
+
+end lean_555
diff --git a/test/simp_command.lean b/test/simp_command.lean
index 6601174e96c32..83d2a5d2c877f 100644
--- a/test/simp_command.lean
+++ b/test/simp_command.lean
@@ -1,5 +1,6 @@
 import tactic.simp_command
 import analysis.special_functions.trigonometric.deriv
+import analysis.calculus.deriv.inv
 
 /- Turn off trace messages only if the statements are simplified to true: -/
 set_option trace.silence_simp_if_true true
diff --git a/test/simp_result.lean b/test/simp_result.lean
index 1b04491e4b0d8..42fd22cf8b083 100644
--- a/test/simp_result.lean
+++ b/test/simp_result.lean
@@ -1,4 +1,4 @@
-import logic.equiv.basic
+import logic.equiv.defs
 import tactic.simp_result
 
 open tactic
diff --git a/test/simp_rw.lean b/test/simp_rw.lean
index 5e874625d60c0..a4194e91e106b 100644
--- a/test/simp_rw.lean
+++ b/test/simp_rw.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Anne Baanen
 -/
 import data.nat.basic
-import data.set.basic
+import data.set.image
 import tactic.simp_rw
 
 /-!
diff --git a/test/simps.lean b/test/simps.lean
index 4acea987d25b8..665f3c16082e3 100644
--- a/test/simps.lean
+++ b/test/simps.lean
@@ -9,14 +9,13 @@ universes v u w
 
 open function tactic expr
 
-
-structure equiv (α : Sort*) (β : Sort*) :=
+structure equiv' (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 (left_inv  : left_inverse inv_fun to_fun)
 (right_inv : right_inverse inv_fun to_fun)
 
-local infix ` ≃ `:25 := equiv
+local infix (name := equiv') ` ≃ `:25 := equiv'
 
 /- Since `prod` and `pprod` are a special case for `@[simps]`, we define a new structure to test
   the basic functionality.-/
@@ -35,7 +34,9 @@ run_cmd do
   e.get `foo.rfl_to_fun,
   e.get `foo.rfl_inv_fun,
   success_if_fail (e.get `foo.rfl_left_inv),
-  success_if_fail (e.get `foo.rfl_right_inv)
+  success_if_fail (e.get `foo.rfl_right_inv),
+  p ← simps_aux.get_param `foo.rfl,
+  guard $ p = [`foo.rfl_to_fun, `foo.rfl_inv_fun]
 
 example (n : ℕ) : foo.rfl.to_fun n = n := by rw [foo.rfl_to_fun, id]
 example (n : ℕ) : foo.rfl.inv_fun n = n := by rw [foo.rfl_inv_fun]
@@ -87,7 +88,7 @@ end
 end foo
 
 /- we reduce the type when applying [simps] -/
-def my_equiv := equiv
+def my_equiv := equiv'
 @[simps] def baz : my_equiv ℕ ℕ := ⟨id, λ x, x, λ x, rfl, λ x, rfl⟩
 
 /- test name clashes -/
@@ -147,7 +148,7 @@ def refl_with_data {α} : equiv_plus_data α α :=
 def refl_with_data' {α} : equiv_plus_data α α :=
 { P := λ f, f = id,
   data := rfl,
-  to_equiv := foo.rfl }
+  to_equiv' := foo.rfl }
 
 /- test whether eta expansions are reduced correctly -/
 @[simps]
@@ -167,8 +168,8 @@ def test_sneaky {α} : automorphism_plus_data α :=
 
 run_cmd do
   e ← get_env,
-  e.get `refl_with_data_to_equiv,
-  e.get `refl_with_data'_to_equiv,
+  e.get `refl_with_data_to_equiv',
+  e.get `refl_with_data'_to_equiv',
   e.get `test_extra,
   e.get `test_sneaky_extra_fst,
   success_if_fail (e.get `refl_with_data_to_equiv_to_fun),
@@ -257,7 +258,9 @@ Note: these projection names might not correspond to the projection names of the
   success_if_fail_with_msg (simps_tac `specify.specify5 {} ["snd_snd"])
     "Invalid simp lemma specify.specify5_snd_snd.
 The given definition is not a constructor application:
-  classical.choice specify.specify5._proof_1"
+  classical.choice specify.specify5._proof_1",
+    p ← simps_aux.get_param `specify.specify4,
+    guard $ p = [`specify.specify4_snd, `specify.specify4_snd_snd]
 
 
 /- We also eta-reduce if we explicitly specify the projection. -/
@@ -270,15 +273,15 @@ run_cmd do
   skip
 
 /- check simp_rhs option -/
-@[simps {simp_rhs := tt}] def equiv.trans {α β γ} (f : α ≃ β) (g : β ≃ γ) : α ≃ γ :=
+@[simps {simp_rhs := tt}] def equiv'.trans {α β γ} (f : α ≃ β) (g : β ≃ γ) : α ≃ γ :=
 ⟨g.to_fun ∘ f.to_fun, f.inv_fun ∘ g.inv_fun,
-  by { intro x, simp [equiv.left_inv _ _] }, by { intro x, simp [equiv.right_inv _ _] }⟩
+  by { intro x, simp [equiv'.left_inv _ _] }, by { intro x, simp [equiv'.right_inv _ _] }⟩
 
 
 example {α β γ : Type} (f : α ≃ β) (g : β ≃ γ) (x : α) :
   (f.trans g).to_fun x = (f.trans g).to_fun x :=
 begin
-  dsimp only [equiv.trans_to_fun],
+  dsimp only [equiv'.trans_to_fun],
   guard_target g.to_fun (f.to_fun x) = g.to_fun (f.to_fun x),
   refl,
 end
@@ -287,8 +290,8 @@ local attribute [simp] nat.zero_add nat.one_mul nat.mul_one
 @[simps {simp_rhs := tt}] def my_nat_equiv : ℕ ≃ ℕ :=
 ⟨λ n, 0 + n, λ n, 1 * n * 1, by { intro n, simp }, by { intro n, simp }⟩
 
-run_cmd success_if_fail (has_attribute `_refl_lemma `my_nat_equiv_to_fun) >>
-  has_attribute `_refl_lemma `equiv.trans_to_fun
+run_cmd success_if_fail (has_attribute `_refl_lemma `my_nat_equiv'_to_fun) >>
+  has_attribute `_refl_lemma `equiv'.trans_to_fun
 
 example (n : ℕ) : my_nat_equiv.to_fun (my_nat_equiv.to_fun $ my_nat_equiv.inv_fun n) = n :=
 by { success_if_fail { refl }, simp only [my_nat_equiv_to_fun, my_nat_equiv_inv_fun] }
@@ -422,7 +425,7 @@ example {α β} [semigroup α] [semigroup β] (x y : α × β) : (x * y).1 = x.1
 structure Semigroup :=
   (G : Type*)
   (op : G → G → G)
-  (infix * := op)
+  (infix (name := op) ` * ` := op)
   (op_assoc : ∀ (x y z : G), (x * y) * z = x * (y * z))
 
 namespace Group
@@ -482,7 +485,7 @@ structure equiv (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := manual_coercion.equiv
+local infix (name := equiv) ` ≃ `:25 := manual_coercion.equiv
 
 variables {α β γ : Sort*}
 
@@ -508,14 +511,15 @@ structure equiv (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := faulty_manual_coercion.equiv
+local infix (name := equiv) ` ≃ `:25 := faulty_manual_coercion.equiv
 
 variables {α β γ : Sort*}
 
 /-- See Note [custom simps projection] -/
 noncomputable def equiv.simps.inv_fun (e : α ≃ β) : β → α := classical.choice ⟨e.inv_fun⟩
 
-run_cmd do e ← get_env, success_if_fail_with_msg (simps_get_raw_projections e `faulty_manual_coercion.equiv)
+run_cmd do e ← get_env, success_if_fail_with_msg
+  (simps_get_raw_projections e `faulty_manual_coercion.equiv)
 "Invalid custom projection:
   λ {α : Sort u_1} {β : Sort u_2} (e : α ≃ β), classical.choice _
 Expression is not definitionally equal to
@@ -531,7 +535,7 @@ structure equiv (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := manual_initialize.equiv
+local infix (name := equiv) ` ≃ `:25 := manual_initialize.equiv
 
 instance : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨equiv.to_fun⟩
 
@@ -559,7 +563,7 @@ structure equiv (α : Sort u) (β : Sort v) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := faulty_universes.equiv
+local infix (name := equiv) ` ≃ `:25 := faulty_universes.equiv
 
 instance : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨equiv.to_fun⟩
 
@@ -589,7 +593,7 @@ structure equiv (α : Sort u) (β : Sort v) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := manual_universes.equiv
+local infix (name := equiv) ` ≃ `:25 := manual_universes.equiv
 
 instance : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨equiv.to_fun⟩
 
@@ -610,7 +614,7 @@ structure equiv (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := manual_projection_names.equiv
+local infix (name := equiv) ` ≃ `:25 := manual_projection_names.equiv
 
 variables {α β γ : Sort*}
 
@@ -650,7 +654,7 @@ structure equiv (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := prefix_projection_names.equiv
+local infix (name := equiv) ` ≃ `:25 := prefix_projection_names.equiv
 
 variables {α β γ : Sort*}
 
@@ -727,7 +731,7 @@ structure equiv (α : Sort*) (β : Sort*) :=
 (to_fun    : α → β)
 (inv_fun   : β → α)
 
-local infix ` ≃ `:25 := nested_non_fully_applied.equiv
+local infix (name := equiv) ` ≃ `:25 := nested_non_fully_applied.equiv
 
 variables {α β γ : Sort*}
 
@@ -877,19 +881,19 @@ end
 
 section comp_projs
 
-instance {α β} : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨equiv.to_fun⟩
+instance {α β} : has_coe_to_fun (α ≃ β) (λ _, α → β) := ⟨equiv'.to_fun⟩
 
-@[simps] protected def equiv.symm {α β} (f : α ≃ β) : β ≃ α :=
+@[simps] protected def equiv'.symm {α β} (f : α ≃ β) : β ≃ α :=
 ⟨f.inv_fun, f, f.right_inv, f.left_inv⟩
 
-structure decorated_equiv (α : Sort*) (β : Sort*) extends equiv α β :=
+structure decorated_equiv (α : Sort*) (β : Sort*) extends equiv' α β :=
 (P_to_fun    : function.injective to_fun )
 (P_inv_fun   : function.injective inv_fun)
 
-instance {α β} : has_coe_to_fun (decorated_equiv α β) (λ _, α → β) := ⟨λ f, f.to_equiv⟩
+instance {α β} : has_coe_to_fun (decorated_equiv α β) (λ _, α → β) := ⟨λ f, f.to_equiv'⟩
 
 def decorated_equiv.symm {α β : Sort*} (e : decorated_equiv α β) : decorated_equiv β α :=
-{ to_equiv := e.to_equiv.symm,
+{ to_equiv' := e.to_equiv'.symm,
   P_to_fun := e.P_inv_fun,
   P_inv_fun := e.P_to_fun }
 
@@ -897,7 +901,7 @@ def decorated_equiv.simps.apply {α β : Sort*} (e : decorated_equiv α β) : α
 def decorated_equiv.simps.symm_apply {α β : Sort*} (e : decorated_equiv α β) : β → α := e.symm
 
 initialize_simps_projections decorated_equiv
-  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)
+  (to_equiv'_to_fun → apply, to_equiv'_inv_fun → symm_apply, -to_equiv')
 
 @[simps] def foo (α : Type) : decorated_equiv α α :=
 { to_fun    := λ x, x,
@@ -910,11 +914,11 @@ initialize_simps_projections decorated_equiv
 example {α : Type} (x : α) : (foo α).symm x = x :=
 by { dsimp, guard_target (x = x), refl }
 
-@[simps to_equiv apply symm_apply] def foo2 (α : Type) : decorated_equiv α α :=
+@[simps to_equiv' apply symm_apply] def foo2 (α : Type) : decorated_equiv α α :=
 { P_to_fun  := λ x y h, h,
   P_inv_fun := λ x y h, h, ..foo.rfl }
 
-example {α : Type} (x : α) : (foo2 α).to_equiv x = x :=
+example {α : Type} (x : α) : (foo2 α).to_equiv' x = x :=
 by { dsimp, guard_target (foo.rfl x = x), refl }
 
 example {α : Type} (x : α) : foo2 α x = x :=
@@ -938,8 +942,8 @@ def further_decorated_equiv.simps.symm_apply {α β : Sort*} (e : further_decora
   β → α := e.symm
 
 initialize_simps_projections further_decorated_equiv
-  (to_decorated_equiv_to_equiv_to_fun → apply, to_decorated_equiv_to_equiv_inv_fun → symm_apply,
-  -to_decorated_equiv, to_decorated_equiv_to_equiv → to_equiv, -to_equiv)
+  (to_decorated_equiv_to_equiv'_to_fun → apply, to_decorated_equiv_to_equiv'_inv_fun → symm_apply,
+  -to_decorated_equiv, to_decorated_equiv_to_equiv' → to_equiv', -to_equiv')
 
 @[simps] def ffoo (α : Type) : further_decorated_equiv α α :=
 { to_fun    := λ x, x,
@@ -957,7 +961,7 @@ by { dsimp, guard_target (x = x), refl }
 @[simps] def ffoo3 (α : Type) : further_decorated_equiv α α :=
 { Q_to_fun  := λ y, ⟨y, rfl⟩, Q_inv_fun  := λ y, ⟨y, rfl⟩, .. foo α }
 
-@[simps apply to_equiv_to_fun to_decorated_equiv_apply]
+@[simps apply to_equiv'_to_fun to_decorated_equiv_apply]
 def ffoo4 (α : Type) : further_decorated_equiv α α :=
 { Q_to_fun  := λ y, ⟨y, rfl⟩, Q_inv_fun  := λ y, ⟨y, rfl⟩, to_decorated_equiv := foo α }
 
@@ -974,8 +978,8 @@ def one_more.simps.apply {α β : Sort*} (e : one_more α β) : α → β := e
 def one_more.simps.symm_apply {α β : Sort*} (e : one_more α β) : β → α := e.symm
 
 initialize_simps_projections one_more
-  (to_further_decorated_equiv_to_decorated_equiv_to_equiv_to_fun → apply,
-   to_further_decorated_equiv_to_decorated_equiv_to_equiv_inv_fun → symm_apply,
+  (to_further_decorated_equiv_to_decorated_equiv_to_equiv'_to_fun → apply,
+   to_further_decorated_equiv_to_decorated_equiv_to_equiv'_inv_fun → symm_apply,
   -to_further_decorated_equiv, to_further_decorated_equiv_to_decorated_equiv → to_dequiv,
   -to_dequiv)
 
@@ -1016,7 +1020,7 @@ something2.mul x y
 
 initialize_simps_projections something2 (mul → mul', mul_to_fun_to_fun → mul, -mul')
 
-attribute [ext] equiv
+attribute [ext] equiv'
 
 @[simps]
 def thing (h : bool ≃ (bool ≃ bool)) : something2 (λ x : ℕ, bool) :=
diff --git a/test/slim_check.lean b/test/slim_check.lean
index 7e50cd1a8a419..fbe094f1b7ac9 100644
--- a/test/slim_check.lean
+++ b/test/slim_check.lean
@@ -403,6 +403,7 @@ begin
 Found problems!
 
 f := [0 ↦ 1, _ ↦ 0]
+issue: finsupp.single 0 1 = 0 does not hold
 (2 shrinks)
 -------------------
 ",
diff --git a/test/solve_by_elim.lean b/test/solve_by_elim.lean
index 17843c93777a8..5748f042c912a 100644
--- a/test/solve_by_elim.lean
+++ b/test/solve_by_elim.lean
@@ -171,3 +171,7 @@ begin
   rintro ⟨n, hf | hg⟩,
   solve_by_elim* [or.inl, or.inr, Exists.intro] { max_depth := 20 },
 end
+
+-- Check that no list of arguments is needed when using a config object
+example (a : ℤ) (h : a = 2) : a = 2 :=
+by apply_assumption {use_exfalso := ff}
diff --git a/test/squeeze.lean b/test/squeeze.lean
index a6ce4fb352976..f2b9d01add632 100644
--- a/test/squeeze.lean
+++ b/test/squeeze.lean
@@ -1,5 +1,5 @@
 import data.nat.basic
-import data.pnat.basic
+import data.pnat.defs
 import tactic.squeeze
 
 namespace tactic
diff --git a/test/tauto.lean b/test/tauto.lean
index 14434287cd890..23c8e69030152 100644
--- a/test/tauto.lean
+++ b/test/tauto.lean
@@ -100,3 +100,11 @@ begin
 end
 
 end closer
+
+/-  Zulip discussion:
+https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/tauto!.20fails.20on.20ne
+-/
+example {x y : ℕ} (h : ¬x ≠ y) : x = y :=
+begin
+  tauto!,
+end
diff --git a/test/to_additive.lean b/test/to_additive.lean
index 7ab9e3acb9eab..d7a69eae9c89b 100644
--- a/test/to_additive.lean
+++ b/test/to_additive.lean
@@ -1,4 +1,4 @@
-import algebra.group.to_additive
+import tactic.to_additive
 import algebra.group.units
 import tactic
 
@@ -10,19 +10,19 @@ def foo0 {α} [has_mul α] [has_one α] (x y : α) : α := x * y * 1
 class {u v} my_has_pow (α : Type u) (β : Type v) :=
 (pow : α → β → α)
 
-class my_has_scalar (M : Type*) (α : Type*) := (smul : M → α → α)
+class my_has_smul (M : Type*) (α : Type*) := (smul : M → α → α)
 
 attribute [to_additive_reorder 1] my_has_pow
 attribute [to_additive_reorder 1 4] my_has_pow.pow
-attribute [to_additive test.my_has_scalar] my_has_pow
-attribute [to_additive test.my_has_scalar.smul] my_has_pow.pow
+attribute [to_additive test.my_has_smul] my_has_pow
+attribute [to_additive test.my_has_smul.smul] my_has_pow.pow
 
 -- set_option pp.universes true
 -- set_option pp.implicit true
 -- set_option pp.notation false
 
 @[priority 10000]
-local infix ` ^ `:80 := my_has_pow.pow
+local infix (name := pow) ` ^ `:80 := my_has_pow.pow
 
 @[to_additive bar1]
 def foo1 {α} [my_has_pow α ℕ] (x : α) (n : ℕ) : α := @my_has_pow.pow α ℕ _ x n
diff --git a/test/transport/basic.lean b/test/transport/basic.lean
index 6124edaea64dc..2843265b77492 100644
--- a/test/transport/basic.lean
+++ b/test/transport/basic.lean
@@ -5,7 +5,12 @@ import algebra.lie.basic
 -- We verify that `transport` can move a `semiring` across an equivalence.
 -- Note that we've never even mentioned the idea of addition or multiplication to `transport`.
 def semiring.map {α : Type} [semiring α] {β : Type} (e : α ≃ β) : semiring β :=
-by transport using e
+begin
+  transport using e,
+  -- TODO
+  { simp *, refl }, -- nat_cast_zero
+  { intros, simp *, show _ = e _, simp, refl, }, -- nat_cast_succ
+end
 
 -- Indeed, it can equally well move a `semilattice_sup`.
 def sup.map {α : Type} [semilattice_sup α] {β : Type} (e : α ≃ β) : semilattice_sup β :=
diff --git a/test/traversable.lean b/test/traversable.lean
index 6adc03f87b411..9751f19392291 100644
--- a/test/traversable.lean
+++ b/test/traversable.lean
@@ -46,6 +46,11 @@ inductive my_tree (α : Type)
 | leaf : my_tree
 | node : my_tree → my_tree → α → my_tree
 
+@[derive [traversable,is_lawful_traversable]]
+inductive my_tree' (α : Type)
+| leaf : my_tree'
+| node : my_tree' → α → my_tree' → my_tree'
+
 section
 open my_tree (hiding traverse)
 
diff --git a/test/units.lean b/test/units.lean
new file mode 100644
index 0000000000000..8ce1f48f292e1
--- /dev/null
+++ b/test/units.lean
@@ -0,0 +1,9 @@
+import algebra.ring.units
+
+/--
+Test division of units in a commutative ring.
+Used to cause `simp` (i.e. instance resolution) to time out.
+-/
+example (R : Type*) [comm_ring R] (a b : Rˣ) : a * (b / a) = b :=
+by simp
+-- Or: `rw mul_div_cancel'_right`
diff --git a/test/vec_notation.lean b/test/vec_notation.lean
new file mode 100644
index 0000000000000..249dce6f4147b
--- /dev/null
+++ b/test/vec_notation.lean
@@ -0,0 +1,26 @@
+import data.fin.vec_notation
+
+/-! These tests are testing `pi_fin.reflect` and fail with
+`local attribute [-instance] pi_fin.reflect` -/
+
+#eval do
+  let x : fin 0 → ℕ := ![],
+  tactic.is_def_eq `(x) `(![] : fin 0 → ℕ)
+
+#eval do
+  let x := ![1, 2, 3],
+  tactic.is_def_eq `(x) `(![1, 2, 3])
+
+#eval do
+  let x := ![ulift.up.{3} 1, ulift.up.{3} 2],
+  tactic.is_def_eq (reflect x) `(![ulift.up.{3} 1, ulift.up.{3} 2])
+
+#eval do
+  let x := ![![1, 2], ![3, 4]],
+  tactic.is_def_eq `(x) `(![![1, 2], ![3, 4]])
+
+/-! These tests are testing `pi_fin.has_repr` -/
+
+#eval show tactic unit, from guard (repr (![] : _ → ℕ) = "![]")
+#eval show tactic unit, from guard (repr ![1, 2, 3] = "![1, 2, 3]")
+#eval show tactic unit, from guard (repr ![![1, 2], ![3, 4]] = "![![1, 2], ![3, 4]]")
diff --git a/test/wlog.lean b/test/wlog.lean
index 71a3917b6bcbf..f93d507f48a51 100644
--- a/test/wlog.lean
+++ b/test/wlog.lean
@@ -1,131 +1,46 @@
 /-
 Copyright (c) 2018 Simon Hudon. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
-Authors: Simon Hudon
+Authors: Simon Hudon, Johan Commelin
 -/
 import tactic.wlog
 
 section wlog
 
-example {x y : ℕ} (a : x = 1) : true :=
-begin
-  suffices : false, trivial,
-  wlog h : x = y,
-  { guard_target x = y ∨ y = x,
-    admit },
-  { guard_hyp h : x = y,
-    guard_hyp a : x = 1,
-    admit }
-end
-
 example {x y : ℕ} : true :=
 begin
-  suffices : false, trivial,
   wlog h : x ≤ y,
+  { guard_hyp h : ¬x ≤ y,
+    guard_hyp this : ∀ {x y : ℕ}, x ≤ y → true, -- `wlog` generalizes by default
+    guard_target true,
+    trivial },
   { guard_hyp h : x ≤ y,
-    guard_target false,
-    admit }
-end
-
-example {x y z : ℕ} : true :=
-begin
-  suffices : false, trivial,
-  wlog : x ≤ y + z using x y,
-  { guard_target x ≤ y + z ∨ y ≤ x + z,
-    admit },
-  { guard_hyp case : x ≤ y + z,
-    guard_target false,
-    admit },
-end
-
-example {x : ℕ} (S₀ S₁ : set ℕ) (P : ℕ → Prop)
-  (h : x ∈ S₀ ∪ S₁) : true :=
-begin
-  suffices : false, trivial,
-  wlog h' : x ∈ S₀ using S₀ S₁,
-  { guard_target x ∈ S₀ ∨ x ∈ S₁,
-    admit },
-  { guard_hyp h  : x ∈ S₀ ∪ S₁,
-    guard_hyp h' : x ∈ S₀,
-    admit }
-end
-
-example {n m i : ℕ} {p : ℕ → ℕ → ℕ → Prop} : true :=
-begin
-  suffices : false, trivial,
-  wlog : p n m i using [n m i, n i m, i n m],
-  { guard_target p n m i ∨ p n i m ∨ p i n m,
-    admit },
-  { guard_hyp case : p n m i,
-    admit }
+    guard_target true,
+    trivial },
 end
 
-example {n m i : ℕ} {p : ℕ → Prop} : true :=
-begin
-  suffices : false, trivial,
-  wlog : p n using [n m i, m n i, i n m],
-  { guard_target p n ∨ p m ∨ p i,
-    admit },
-  { guard_hyp case : p n,
-    admit }
-end
-
-example {n m i : ℕ} {p : ℕ → ℕ → Prop} {q : ℕ → ℕ → ℕ → Prop} : true :=
-begin
-  suffices : q n m i, trivial,
-  have h : p n i ∨ p i m ∨ p m i, from sorry,
-  wlog : p n i := h using n m i,
-  { guard_hyp h : p n i,
-    guard_target q n m i,
-    admit },
-  { guard_hyp h : p i m,
-    guard_hyp this : q i m n,
-    guard_target q n m i,
-    admit },
-  { guard_hyp h : p m i,
-    guard_hyp this : q m i n,
-    guard_target q n m i,
-    admit },
-end
-
-example (X : Type) (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
-begin
-  ext x,
-  split,
-  { intro hyp,
-    cases hyp,
-    wlog x_in : x ∈ B using B C,
-    { assumption },
-    { exact or.inl ⟨hyp_left, x_in⟩ } },
-  { intro hyp,
-    wlog x_in : x ∈ A ∩ B using B C,
-    { assumption },
-    { exact ⟨x_in.left, or.inl x_in.right⟩ } }
-end
-
-example (X : Type) (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
+example {x y : ℕ} : true :=
 begin
-  ext x,
-  split,
-  { intro hyp,
-    wlog x_in : x ∈ B := hyp.2 using B C,
-    { exact or.inl ⟨hyp.1, x_in⟩ } },
-  { intro hyp,
-    wlog x_in : x ∈ A ∩ B := hyp using B C,
-    { exact ⟨x_in.left, or.inl x_in.right⟩ } }
+  wlog h : x ≤ y generalizing x,
+  { guard_hyp h : ¬x ≤ y,
+    guard_hyp this : ∀ {x : ℕ}, x ≤ y → true, -- only `x` was generalized
+    guard_target true,
+    trivial },
+  { guard_hyp h : x ≤ y,
+    guard_target true,
+    trivial },
 end
 
-example (X : Type) (A B C : set X) : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
+example {x y z : ℕ} : true :=
 begin
-  ext x,
-  split,
-  { intro hyp,
-    cases hyp,
-    wlog x_in : x ∈ B := hyp_right using B C,
-    { exact or.inl ⟨hyp_left, x_in⟩ }, },
-  { intro hyp,
-    wlog x_in : x ∈ A ∩ B := hyp using B C,
-    { exact ⟨x_in.left, or.inl x_in.right⟩ } }
+  wlog h : x ≤ y + z with H,
+  { guard_hyp h : ¬ x ≤ y + z,
+    guard_hyp H : ∀ {x y z : ℕ}, x ≤ y + z → true, -- wlog-claim is named `H` instead of `this`
+    guard_target true,
+    trivial },
+  { guard_hyp h : x ≤ y + z,
+    guard_target true,
+    trivial },
 end
 
 end wlog
diff --git a/test/zify.lean b/test/zify.lean
index e3d80696f2c10..761f59fcc1d73 100644
--- a/test/zify.lean
+++ b/test/zify.lean
@@ -3,8 +3,8 @@ import tactic.zify
 example (a b c x y z : ℕ) (h : ¬ x*y*z < 0) (h2 : (c : ℤ) < a + 3 * b) : a + 3*b > c :=
 begin
   zify at h ⊢,
-  guard_hyp h : ¬↑x * ↑y * ↑z < (0 : ℤ),
-  guard_target ↑c < (↑a : ℤ) + 3 * ↑b,
+  guard_hyp_mod_implicit h : ¬↑x * ↑y * ↑z < (0 : ℤ),
+  guard_target_mod_implicit ↑c < (↑a : ℤ) + 3 * ↑b,
   exact h2
 end
 
@@ -26,13 +26,13 @@ end
 example (a b c : ℕ) (h : a - b < c) (hab : b ≤ a) : true :=
 begin
   zify [hab] at h,
-  guard_hyp h : (a : ℤ) - b < c,
+  guard_hyp_mod_implicit h : (a : ℤ) - b < c,
   trivial
 end
 
 example (a b c : ℕ) (h : a + b ≠ c) : true :=
 begin
   zify at h,
-  guard_hyp h : (a : ℤ) + b ≠ c,
+  guard_hyp_mod_implicit h : (a : ℤ) + b ≠ c,
   trivial
 end